metafor/0000755000176200001440000000000014505073402011707 5ustar liggesusersmetafor/NAMESPACE0000644000176200001440000000770214467660011013141 0ustar liggesusersexportPattern("^[^\\.]") import(stats) import(utils) import(graphics) import(grDevices) import(methods) import(Matrix) importFrom(nlme, ranef) export(ranef) import(mathjaxr) import(metadat) import(numDeriv) S3method("[", list.rma) S3method("$<-", list.rma) S3method("[", escalc) S3method("$<-", escalc) S3method(addpoly, default) S3method(addpoly, predict.rma) S3method(addpoly, rma) S3method(aggregate, escalc) S3method(AIC, rma) S3method(anova, rma) S3method(as.data.frame, anova.rma) S3method(as.data.frame, confint.rma) S3method(as.data.frame, vif.rma) S3method(as.data.frame, list.anova.rma) S3method(as.data.frame, list.confint.rma) S3method(as.data.frame, list.rma) S3method(as.matrix, list.rma) S3method(baujat, rma) S3method(BIC, rma) S3method(blup, rma.uni) S3method(cbind, escalc) S3method(coef, matreg) S3method(coef, rma) S3method(coef, summary.rma) S3method(coef, permutest.rma.uni) S3method(confint, rma.glmm) S3method(confint, rma.mh) S3method(confint, rma.mv) S3method(confint, rma.peto) S3method(confint, rma.uni) S3method(confint, rma.uni.selmodel) S3method(confint, rma.ls) S3method(cooks.distance, rma.mv) S3method(cooks.distance, rma.uni) S3method(cumul, rma.mh) S3method(cumul, rma.peto) S3method(cumul, rma.uni) S3method(deviance, rma) S3method(df.residual, rma) S3method(dfbetas, rma.mv) S3method(dfbetas, rma.uni) S3method(fitstats, rma) S3method(fitted, rma) S3method(forest, default) S3method(forest, rma) S3method(forest, cumul.rma) S3method(formula, rma) S3method(funnel, default) S3method(funnel, rma) S3method(gosh, rma) S3method(hatvalues, rma.mv) S3method(hatvalues, rma.uni) S3method(hc, rma.uni) S3method(influence, rma.uni) S3method(labbe, rma) S3method(leave1out, rma.mh) S3method(leave1out, rma.peto) S3method(leave1out, rma.uni) S3method(logLik, rma) S3method(regplot, rma) S3method(model.matrix, rma) S3method(nobs, rma) S3method(permutest, rma.uni) S3method(permutest, rma.ls) S3method(plot, cumul.rma) S3method(plot, gosh.rma) S3method(plot, infl.rma.uni) S3method(plot, permutest.rma.uni) S3method(plot, profile.rma) S3method(plot, vif.rma) S3method(plot, rma.glmm) S3method(plot, rma.mh) S3method(plot, rma.peto) S3method(plot, rma.uni) S3method(plot, rma.uni.selmodel) S3method(points, regplot) S3method(predict, rma) S3method(predict, rma.ls) S3method(print, anova.rma) S3method(print, confint.rma) S3method(print, vif.rma) S3method(print, list.anova.rma) S3method(print, list.confint.rma) S3method(print, escalc) S3method(print, fsn) S3method(print, gosh.rma) S3method(print, infl.rma.uni) S3method(print, list.rma) S3method(head, list.rma) S3method(tail, list.rma) S3method(print, hc.rma.uni) S3method(print, matreg) S3method(print, permutest.rma.uni) S3method(print, profile.rma) S3method(print, ranktest) S3method(print, regtest) S3method(print, rma.glmm) S3method(print, rma.mh) S3method(print, rma.mv) S3method(print, rma.peto) S3method(print, rma.uni) S3method(print, summary.matreg) S3method(print, summary.rma) S3method(print, tes) S3method(profile, rma.mv) S3method(profile, rma.uni) S3method(profile, rma.uni.selmodel) S3method(profile, rma.ls) S3method(qqnorm, rma.glmm) S3method(qqnorm, rma.mh) S3method(qqnorm, rma.mv) S3method(qqnorm, rma.peto) S3method(qqnorm, rma.uni) S3method(radial, rma) S3method(ranef, rma.mv) S3method(ranef, rma.uni) S3method(rbind, escalc) S3method(reporter, rma.uni) S3method(residuals, rma) S3method(robust, rma.mv) S3method(robust, rma.uni) S3method(selmodel, rma.uni) S3method(rstandard, rma.mh) S3method(rstandard, rma.mv) S3method(rstandard, rma.peto) S3method(rstandard, rma.uni) S3method(rstudent, rma.mh) S3method(rstudent, rma.mv) S3method(rstudent, rma.peto) S3method(rstudent, rma.uni) S3method(simulate, rma) S3method(summary, escalc) S3method(summary, matreg) S3method(summary, rma) S3method(trimfill, rma.uni) S3method(update, rma) S3method(vif, rma) S3method(vcov, matreg) S3method(vcov, rma) S3method(weights, rma.glmm) S3method(weights, rma.mh) S3method(weights, rma.mv) S3method(weights, rma.peto) S3method(weights, rma.uni) metafor/README.md0000644000176200001440000003035714505063263013202 0ustar liggesusersmetafor: A Meta-Analysis Package for R ====================================== [![License: GPL (>=2)](https://img.shields.io/badge/license-GPL-blue)](https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html) [![R build status](https://github.com/wviechtb/metafor/workflows/R-CMD-check/badge.svg)](https://github.com/wviechtb/metafor/actions) [![Code Coverage](https://codecov.io/gh/wviechtb/metafor/branch/master/graph/badge.svg)](https://app.codecov.io/gh/wviechtb/metafor) [![CRAN Version](https://www.r-pkg.org/badges/version/metafor)](https://cran.r-project.org/package=metafor) [![devel Version](https://img.shields.io/badge/devel-4.4--0-brightgreen.svg)](https://www.metafor-project.org/doku.php/installation#development_version) [![Monthly Downloads](https://cranlogs.r-pkg.org/badges/metafor)](https://cranlogs.r-pkg.org/badges/metafor) [![Total Downloads](https://cranlogs.r-pkg.org/badges/grand-total/metafor)](https://cranlogs.r-pkg.org/badges/grand-total/metafor) ## Description The `metafor` package is a comprehensive collection of functions for conducting meta-analyses in R. The package includes functions to calculate various effect sizes or outcome measures, fit equal-, fixed-, random-, and mixed-effects models to such data, carry out moderator and meta-regression analyses, and create various types of meta-analytical plots (e.g., forest, funnel, radial, L'Abbé, Baujat, bubble, and GOSH plots). For meta-analyses of binomial and person-time data, the package also provides functions that implement specialized methods, including the Mantel-Haenszel method, Peto's method, and a variety of suitable generalized linear (mixed-effects) models (i.e., mixed-effects logistic and Poisson regression models). Finally, the package provides functionality for fitting meta-analytic multivariate/multilevel models that account for non-independent sampling errors and/or true effects (e.g., due to the inclusion of multiple treatment studies, multiple endpoints, or other forms of clustering). Network meta-analyses and meta-analyses accounting for known correlation structures (e.g., due to phylogenetic relatedness) can also be conducted. ## Package Website The `metafor` package website can be found at [https://www.metafor-project.org](https://www.metafor-project.org). On the website, you can find: * some [news](https://www.metafor-project.org/doku.php/news:news) concerning the package and/or its development, * a more detailed description of the [package features](https://www.metafor-project.org/doku.php/features), * a log of the [package updates](https://www.metafor-project.org/doku.php/updates) that have been made over the years, * a [to-do list](https://www.metafor-project.org/doku.php/todo) and a description of planned features to be implemented in the future, * information on how to [download and install](https://www.metafor-project.org/doku.php/installation) the package, * information on how to obtain [documentation and help](https://www.metafor-project.org/doku.php/help) with using the package, * some [analysis examples](https://www.metafor-project.org/doku.php/analyses) that illustrate various models, methods, and techniques, * a little showcase of [plots and figures](https://www.metafor-project.org/doku.php/plots) that can be created with the package, * some [tips and notes](https://www.metafor-project.org/doku.php/tips) that may be useful when working with the package, * a list of people that have in some shape or form [contributed](https://www.metafor-project.org/doku.php/contributors) to the development of the package, * a [frequently asked questions](https://www.metafor-project.org/doku.php/faq) section, and * some [links](https://www.metafor-project.org/doku.php/links) to other websites related to software for meta-analysis. ## Documentation A good starting place for those interested in using the `metafor` package is the following paper: Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. *Journal of Statistical Software, 36*(3), 1-48. [https://doi.org/10.18637/jss.v036.i03](https://doi.org/10.18637/jss.v036.i03) In addition to reading the paper, carefully read the [package intro](https://wviechtb.github.io/metafor/reference/metafor-package.html) and then the help pages for the [`escalc`](https://wviechtb.github.io/metafor/reference/escalc.html) and the [`rma.uni`](https://wviechtb.github.io/metafor/reference/rma.uni.html) functions (or the [`rma.mh`](https://wviechtb.github.io/metafor/reference/rma.mh.html), [`rma.peto`](https://wviechtb.github.io/metafor/reference/rma.peto.html), [`rma.glmm`](https://wviechtb.github.io/metafor/reference/rma.glmm.html), [`rma.mv`](https://wviechtb.github.io/metafor/reference/rma.mv.html) functions if you intend to use these methods). The help pages for these functions provide links to many additional functions, which can be used after fitting a model. You can also read the entire documentation online at [https://wviechtb.github.io/metafor/](https://wviechtb.github.io/metafor/) (where it is nicely formatted, equations are shown correctly, and the output from all examples is provided). ## Installation The current official (i.e., [CRAN](https://cran.r-project.org/package=metafor)) release can be installed within R with: ```r install.packages("metafor") ``` The development version of the package can be installed with: ```r install.packages("remotes") remotes::install_github("wviechtb/metafor") ``` This builds the package from source based on the current version on [GitHub](https://github.com/wviechtb/metafor). ## Example ```r # load metafor package library(metafor) # examine the BCG vaccine dataset dat.bcg ``` ``` ## trial author year tpos tneg cpos cneg ablat alloc ## 1 1 Aronson 1948 4 119 11 128 44 random ## 2 2 Ferguson & Simes 1949 6 300 29 274 55 random ## 3 3 Rosenthal et al 1960 3 228 11 209 42 random ## 4 4 Hart & Sutherland 1977 62 13536 248 12619 52 random ## 5 5 Frimodt-Moller et al 1973 33 5036 47 5761 13 alternate ## 6 6 Stein & Aronson 1953 180 1361 372 1079 44 alternate ## 7 7 Vandiviere et al 1973 8 2537 10 619 19 random ## 8 8 TPT Madras 1980 505 87886 499 87892 13 random ## 9 9 Coetzee & Berjak 1968 29 7470 45 7232 27 random ## 10 10 Rosenthal et al 1961 17 1699 65 1600 42 systematic ## 11 11 Comstock et al 1974 186 50448 141 27197 18 systematic ## 12 12 Comstock & Webster 1969 5 2493 3 2338 33 systematic ## 13 13 Comstock et al 1976 27 16886 29 17825 33 systematic ``` ```r # tpos - number of TB positive cases in the treated (vaccinated) group # tneg - number of TB negative cases in the treated (vaccinated) group # cpos - number of TB positive cases in the control (non-vaccinated) group # cneg - number of TB negative cases in the control (non-vaccinated) group # # these variables denote the values in 2x2 tables of the form: # # TB+ TB- # +------+------+ # treated | tpos | tneg | # +------+------+ # control | cpos | cneg | # +------+------+ # # year - publication year of the study # ablat - absolute latitude of the study location (in degrees) # alloc - method of treatment allocation (random, alternate, or systematic assignment) # calculate log risk ratios and corresponding sampling variances for the BCG vaccine dataset dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, slab=paste(author, year, sep=", ")) # also add study labels dat ``` ``` ## trial author year tpos tneg cpos cneg ablat alloc yi vi ## 1 1 Aronson 1948 4 119 11 128 44 random -0.8893 0.3256 ## 2 2 Ferguson & Simes 1949 6 300 29 274 55 random -1.5854 0.1946 ## 3 3 Rosenthal et al 1960 3 228 11 209 42 random -1.3481 0.4154 ## 4 4 Hart & Sutherland 1977 62 13536 248 12619 52 random -1.4416 0.0200 ## 5 5 Frimodt-Moller et al 1973 33 5036 47 5761 13 alternate -0.2175 0.0512 ## 6 6 Stein & Aronson 1953 180 1361 372 1079 44 alternate -0.7861 0.0069 ## 7 7 Vandiviere et al 1973 8 2537 10 619 19 random -1.6209 0.2230 ## 8 8 TPT Madras 1980 505 87886 499 87892 13 random 0.0120 0.0040 ## 9 9 Coetzee & Berjak 1968 29 7470 45 7232 27 random -0.4694 0.0564 ## 10 10 Rosenthal et al 1961 17 1699 65 1600 42 systematic -1.3713 0.0730 ## 11 11 Comstock et al 1974 186 50448 141 27197 18 systematic -0.3394 0.0124 ## 12 12 Comstock & Webster 1969 5 2493 3 2338 33 systematic 0.4459 0.5325 ## 13 13 Comstock et al 1976 27 16886 29 17825 33 systematic -0.0173 0.0714 ``` ```r # fit random-effects model res <- rma(yi, vi, data=dat, test="knha") res ``` ``` ## Random-Effects Model (k = 13; tau^2 estimator: REML) ## ## tau^2 (estimated amount of total heterogeneity): 0.3132 (SE = 0.1664) ## tau (square root of estimated tau^2 value): 0.5597 ## I^2 (total heterogeneity / total variability): 92.22% ## H^2 (total variability / sampling variability): 12.86 ## ## Test for Heterogeneity: ## Q(df = 12) = 152.2330, p-val < .0001 ## ## Model Results: ## ## estimate se tval df pval ci.lb ci.ub ## -0.7145 0.1808 -3.9522 12 0.0019 -1.1084 -0.3206 ** ## ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ``` ```r # predicted pooled risk ratio (with 95% confidence/prediction intervals) predict(res, transf=exp, digits=2) ``` ``` ## pred ci.lb ci.ub pi.lb pi.ub ## 0.49 0.33 0.73 0.14 1.76 ``` ```r # forest plot forest(res, atransf=exp, at=log(c(.05, .25, 1, 4)), xlim=c(-16,6), ilab=cbind(tpos, tneg, cpos, cneg), ilab.xpos=c(-9.5,-8,-6,-4.5), header="Author(s) and Year", shade="zebra") text(c(-9.5,-8,-6,-4.5), 15, c("TB+", "TB-", "TB+", "TB-"), font=2) text(c(-8.75,-5.25), 16, c("Vaccinated", "Control"), font=2) ``` ![](man/figures/ex_forest_plot.png){ width=40% } ```r # funnel plot funnel(res, ylim=c(0,0.8), las=1) ``` ![](man/figures/ex_funnel_plot.png){ width=40% } ```r # regression test for funnel plot asymmetry regtest(res) ``` ``` ## Regression Test for Funnel Plot Asymmetry ## ## Model: mixed-effects meta-regression model ## Predictor: standard error ## ## Test for Funnel Plot Asymmetry: t = -0.7812, df = 11, p = 0.4512 ## Limit Estimate (as sei -> 0): b = -0.5104 (CI: -1.2123, 0.1915) ``` ```r # mixed-effects meta-regression model with absolute latitude as moderator res <- rma(yi, vi, mods = ~ ablat, data=dat, test="knha") res ``` ``` ## Mixed-Effects Model (k = 13; tau^2 estimator: REML) ## ## tau^2 (estimated amount of residual heterogeneity): 0.0764 (SE = 0.0591) ## tau (square root of estimated tau^2 value): 0.2763 ## I^2 (residual heterogeneity / unaccounted variability): 68.39% ## H^2 (unaccounted variability / sampling variability): 3.16 ## R^2 (amount of heterogeneity accounted for): 75.62% ## ## Test for Residual Heterogeneity: ## QE(df = 11) = 30.7331, p-val = 0.0012 ## ## Test of Moderators (coefficient 2): ## F(df1 = 1, df2 = 11) = 12.5905, p-val = 0.0046 ## ## Model Results: ## ## estimate se tval df pval ci.lb ci.ub ## intrcpt 0.2515 0.2839 0.8857 11 0.3948 -0.3735 0.8764 ## ablat -0.0291 0.0082 -3.5483 11 0.0046 -0.0472 -0.0111 ** ## ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ``` ```r # bubble plot (with points outside of the prediction interval labeled) regplot(res, mod="ablat", pi=TRUE, xlab="Absolute Latitude", xlim=c(0,60), predlim=c(0,60), transf=exp, refline=1, legend=TRUE, label="piout", labsize=0.9, bty="l", las=1, digits=1) ``` ![](man/figures/ex_bubble_plot.png){ width=40% } ## Meta The metafor package was written by [Wolfgang Viechtbauer](https://www.wvbauer.com/). It is licensed under the [GNU General Public License](https://www.gnu.org/licenses/old-licenses/gpl-2.0.txt). For citation info, type `citation(package='metafor')` in R. To report any issues or bugs or to suggest enhancements to the package, please go [here](https://github.com/wviechtb/metafor/issues). metafor/man/0000755000176200001440000000000014505063152012463 5ustar liggesusersmetafor/man/plot.permutest.rma.uni.Rd0000644000176200001440000001613214505063152017332 0ustar liggesusers\name{plot.permutest.rma.uni} \alias{plot.permutest.rma.uni} \title{Plot Method for 'permutest.rma.uni' Objects} \description{ Function to plot objects of class \code{"permutest.rma.uni"}. } \usage{ \method{plot}{permutest.rma.uni}(x, beta, alpha, QM=FALSE, QS=FALSE, breaks="Scott", freq=FALSE, col, border, col.out, col.ref, col.density, trim=0, adjust=1, lwd=c(2,0,0,4), layout, legend=FALSE, \dots) } \arguments{ \item{x}{an object of class \code{"permutest.rma.uni"} obtained with \code{\link{permutest}}.} \item{beta}{optional vector of indices to specify which (location) coefficients should be plotted.} \item{alpha}{optional vector of indices to specify which scale coefficients should be plotted. Only relevant for location-scale models (see \code{\link{rma.uni}}).} \item{QM}{logical to specify whether the permutation distribution of the omnibus test of the (location) coefficients should be plotted (the default is \code{FALSE}).} \item{QS}{logical to specify whether the permutation distribution of the omnibus test of the scale coefficients should be plotted (the default is \code{FALSE}). Only relevant for location-scale models (see \code{\link{rma.uni}}).} \item{breaks}{argument to be passed on to the corresponding argument of \code{\link{hist}} to set (the method for determining) the (number of) breakpoints.} \item{freq}{logical to indicate whether frequencies or probability densities should be plotted (the default is \code{FALSE} to plot densities).} \item{col}{optional character string to specify the color of the histogram bars.} \item{border}{optional character string to specify the color of the borders around the bars.} \item{col.out}{optional character string to specify the color of the bars that are more extreme than the observed test statistic (the default is a semi-transparent shade of red).} \item{col.ref}{optional character string to specify the color of the theoretical reference/null distribution that is superimposed on top of the histogram (the default is a dark shade of gray).} \item{col.density}{optional character string to specify the color of the kernel density estimate of the permutation distribution that is superimposed on top of the histogram (the default is blue).} \item{trim}{the fraction (up to 0.5) of observations to be trimmed from the tails of each permutation distribution before its histogram is plotted.} \item{adjust}{numeric value to be passed on to the corresponding argument of \code{\link{density}} (for adjusting the bandwidth of the kernel density estimate).} \item{lwd}{numeric vector to specify the width of the vertical lines corresponding to the value of the observed test statistic, of the theoretical reference/null distribution, of the density estimate, and of the vertical line at 0 (note: by default, the theoretical reference/null distribution and the density estimate both have a line width of 0 and are therefore not plotted).} \item{layout}{optional vector of two numbers to specify the number of rows and columns for the layout of the figure.} \item{legend}{logical to indicate whether a legend should be added to the plot (the default is \code{FALSE}). Can also be a keyword to indicate the position of the legend (see \code{\link{legend}}).} \item{\dots}{other arguments.} } \details{ The function plots the permutation distribution of each model coefficient as a histogram. For models with moderators, one can choose via argument \code{beta} which coefficients to plot (by default, all permutation distributions except that of the intercept are plotted). One can also choose to plot the permutation distribution of the omnibus test of the model coefficients (by setting \code{QM=TRUE}). Arguments \code{breaks}, \code{freq}, \code{col}, and \code{border} are passed on to the \code{\link{hist}} function for the plotting. Argument \code{trim} can be used to trim away a certain fraction of observations from the tails of each permutation distribution before its histogram is plotted. By setting this to a value above 0, one can quickly remove some of the extreme values that might lead to the bulk of the distribution getting squished together at the center (typically, a small value such as \code{trim=0.01} is sufficient for this purpose). The observed test statistic is indicated as a vertical dashed line (in both tails for a two-sided test). Argument \code{col.out} is used to specify the color for the bars in the histogram that are more extreme than the observed test statistic. The p-value of a permutation test corresponds to the area of these bars. One can superimpose the theoretical reference/null distribution on top of the histogram (i.e., the distribution as assumed by the model). The p-value for the standard (i.e., non-permutation) test is the area that is more extreme than the observed test statistic under this reference/null distribution. A kernel density estimate of the permutation distribution can also be superimposed on top of the histogram (as a smoothed representation of the permutation distribution). Note that the theoretical reference/null distribution and the kernel density estimate of the permutation distribution are only shown when setting the line width for these elements greater than 0 via the \code{lwd} argument (e.g., \code{lwd=c(2,2,2,4)}). For location-scale models (see \code{\link{rma.uni}} for details), one can also use arguments \code{alpha} and \code{QS} to specify which scale coefficients to plot and whether to also plot the permutation distribution of the omnibus test of the scale coefficients (by setting \code{QS=TRUE}). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link[=permutest.rma.uni]{permutest}} for the function to create \code{permutest.rma.uni} objects. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### random-effects model res <- rma(yi, vi, data=dat) res \dontrun{ ### permutation test (exact) permres <- permutest(res, exact=TRUE) permres ### plot of the permutation distribution ### dashed horizontal line: the observed value of the test statistic (in both tails) ### black curve: standard normal density (theoretical reference/null distribution) ### blue curve: kernel density estimate of the permutation distribution plot(permres, lwd=c(2,3,3,4)) ### mixed-effects model with two moderators (absolute latitude and publication year) res <- rma(yi, vi, mods = ~ ablat + year, data=dat) res ### permutation test (approximate) set.seed(1234) # for reproducibility permres <- permutest(res, iter=10000) permres ### plot of the permutation distribution for absolute latitude ### note: the tail area under the permutation distribution is larger ### than under a standard normal density (hence, the larger p-value) plot(permres, beta=2, lwd=c(2,3,3,4), xlim=c(-5,5)) } } \keyword{hplot} metafor/man/methods.list.rma.Rd0000644000176200001440000000342414505063152016150 0ustar liggesusers\name{methods.list.rma} \alias{methods.list.rma} \alias{as.data.frame.list.rma} \alias{as.matrix.list.rma} \alias{[.list.rma} \alias{head.list.rma} \alias{tail.list.rma} \alias{$<-.list.rma} \title{Methods for 'list.rma' Objects} \description{ Methods for objects of class \code{"list.rma"}. } \usage{ \method{as.data.frame}{list.rma}(x, \dots) \method{as.matrix}{list.rma}(x, \dots) \method{[}{list.rma}(x, i, \dots) \method{head}{list.rma}(x, n=6L, \dots) \method{tail}{list.rma}(x, n=6L, \dots) \method{$}{list.rma}(x, name) <- value } \arguments{ \item{x}{an object of class \code{"list.rma"}.} \item{\dots}{other arguments.} } \note{ For the \code{`[`} method, any variables specified as part of the \code{i} argument will be searched for within object \code{x} first (see \sQuote{Examples}). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \examples{ ### copy data into 'dat' and examine data dat <- dat.viechtbauer2021 ### calculate log odds ratios and corresponding sampling variances dat <- escalc(measure="OR", ai=xTi, n1i=nTi, ci=xCi, n2i=nCi, add=1/2, to="all", data=dat) ### fit mixed-effects meta-regression model res <- rma(yi, vi, mods = ~ dose, data=dat) ### get studentized residuals sav <- rstudent(res) sav ### studies with studentized residuals larger than +-1.96 sav[abs(sav$z) > 1.96,] ### variables specified are automatically searched for within the object itself sav[abs(z) > 1.96,] ### note: this behavior is specific to 'rma.list' objects; this doesn't work for regular data frames } \keyword{internal} metafor/man/regplot.Rd0000644000176200001440000003763014505063152014437 0ustar liggesusers\name{regplot} \alias{regplot} \alias{regplot.rma} \alias{points.regplot} \title{Scatter Plots / Bubble Plots} \description{ Function to create scatter plots / bubble plots based on meta-regression models. \loadmathjax } \usage{ regplot(x, \dots) \method{regplot}{rma}(x, mod, pred=TRUE, ci=TRUE, pi=FALSE, shade=TRUE, xlim, ylim, predlim, olim, xlab, ylab, at, digits=2L, transf, atransf, targs, level=x$level, pch, psize, plim=c(0.5,3), col, bg, slab, grid=FALSE, refline, label=FALSE, offset=c(1,1), labsize=1, lcol, lwd, lty, legend=FALSE, xvals, \dots) \method{points}{regplot}(x, \dots) } \arguments{ \item{x}{an object of class \code{"rma.uni"}, \code{"rma.mv"}, or \code{"rma.glmm"} including one or multiple moderators (or an object of class \code{"regplot"} for \code{points}).} \item{mod}{either a scalar to specify the position of the moderator variable in the model or a character string to specify the name of the moderator variable.} \item{pred}{logical to indicate whether the (marginal) regression line based on the moderator should be added to the plot (the default is \code{TRUE}). Can also be an object from \code{\link[=predict.rma]{predict}}. See \sQuote{Details}.} \item{ci}{logical to indicate whether the corresponding confidence interval bounds should be added to the plot (the default is \code{TRUE}).} \item{pi}{logical to indicate whether the corresponding prediction interval bounds should be added to the plot (the default is \code{FALSE}).} \item{shade}{logical to indicate whether the confidence/prediction interval regions should be shaded (the default is \code{TRUE}). Can also be a two-element character vector to specify the colors for shading the confidence and prediction interval regions (if shading only the former, a single color can also be specified).} \item{xlim}{x-axis limits. If unspecified, the function sets the x-axis limits to some sensible values.} \item{ylim}{y-axis limits. If unspecified, the function sets the y-axis limits to some sensible values.} \item{predlim}{optional argument to specify the limits of the (marginal) regression line. If unspecified, the limits are based on the range of the moderator variable.} \item{olim}{optional argument to specify observation/outcome limits. If unspecified, no limits are used.} \item{xlab}{title for the x-axis. If unspecified, the function sets an appropriate axis title.} \item{ylab}{title for the y-axis. If unspecified, the function sets an appropriate axis title.} \item{at}{position of the y-axis tick marks and corresponding labels. If unspecified, the function sets the tick mark positions/labels to some sensible values.} \item{digits}{integer to specify the number of decimal places to which the tick mark labels of the y-axis should be rounded. When specifying an integer (e.g., \code{2L}), trailing zeros after the decimal mark are dropped for the y-axis labels. When specifying a numeric value (e.g., \code{2}), trailing zeros are retained.} \item{transf}{optional argument to specify a function to transform the observed outcomes, predicted values, and confidence/prediction interval bounds (e.g., \code{transf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{atransf}{optional argument to specify a function to transform the y-axis labels (e.g., \code{atransf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{targs}{optional arguments needed by the function specified via \code{transf} or \code{atransf}.} \item{level}{numeric value between 0 and 100 to specify the confidence/prediction interval level (see \link[=misc-options]{here} for details). The default is to take the value from the object.} \item{pch}{plotting symbol to use for the observed outcomes. By default, an open circle is used. Can also be a vector of values. See \code{\link{points}} for other options.} \item{psize}{optional numeric value to specify the point sizes for the observed outcomes. If unspecified, the point sizes are a function of the model weights. Can also be a vector of values. Can also be a character string (either \code{"seinv"} or \code{"vinv"}) to make the point sizes proportional to the inverse standard errors or inverse sampling variances.} \item{plim}{numeric vector of length 2 to scale the point sizes (ignored when a numeric value or vector is specified for \code{psize}). See \sQuote{Details}.} \item{col}{character string to specify the (border) color of the points. Can also be a vector.} \item{bg}{character string to specify the background color of open plot symbols. Can also be a vector.} \item{slab}{optional vector with labels for the \mjseqn{k} studies. If unspecified, the function tries to extract study labels from \code{x}.} \item{grid}{logical to specify whether a grid should be added to the plot. Can also be a color name for the grid.} \item{refline}{optional numeric value to specify the location of a horizontal reference line that should be added to the plot.} \item{label}{argument to control the labeling of the points (the default is \code{FALSE}). See \sQuote{Details}.} \item{offset}{argument to control the distance between the points and the corresponding labels. See \sQuote{Details}.} \item{labsize}{numeric value to control the size of the labels.} \item{lcol}{optional vector of (up to) four elements to specify the color of the regression line, of the confidence interval bounds, of the prediction interval bounds, and of the horizontal reference line.} \item{lty}{optional vector of (up to) four elements to specify the line type of the regression line, of the confidence interval bounds, of the prediction interval bounds, and of the horizontal reference line.} \item{lwd}{optional vector of (up to) four elements to specify the line width of the regression line, of the confidence interval bounds, of the prediction interval bounds, and of the horizontal reference line.} \item{legend}{logical to indicate whether a legend should be added to the plot (the default is \code{FALSE}). Can also be a keyword to indicate the position of the legend (see \code{\link{legend}}).} \item{xvals}{optional numeric vector to specify the values of the moderator for which predicted values should be computed. Needs to be specified when passing an object from \code{\link[=predict.rma]{predict}} to the \code{pred} argument. See \sQuote{Details}.} \item{\dots}{other arguments.} } \details{ The function draws a scatter plot of the values of a moderator variable in a meta-regression model (on the x-axis) against the observed effect sizes or outcomes (on the y-axis). The regression line from the model (with corresponding confidence interval bounds) is added to the plot by default. These types of plots are also often referred to as \sQuote{bubble plots} as the points are typically drawn in different sizes to reflect their precision or weight in the model. If the model includes multiple moderators, one must specify via argument \code{mod} either the position (as a number) or the name (as a string) of the moderator variable to place on the x-axis. The regression line then reflects the \sQuote{marginal} relationship between the chosen moderator and the effect sizes or outcomes (i.e., all other moderators except the one being plotted are held constant at their means). By default (i.e., when \code{psize} is not specified), the size of the points is a function of the square root of the model weights. This way, their area is proportional to the weights. However, the point sizes are rescaled so that the smallest point size is \code{plim[1]} and the largest point size is \code{plim[2]}. As a result, their relative sizes (i.e., areas) no longer exactly correspond to their relative weights. If exactly relative point sizes are desired, one can set \code{plim[2]} to \code{NA}, in which case the points are rescaled so that the smallest point size corresponds to \code{plim[1]} and all other points are scaled accordingly. As a result, the largest point may be very large. Alternatively, one can set \code{plim[1]} to \code{NA}, in which case the points are rescaled so that the largest point size corresponds to \code{plim[2]} and all other points are scaled accordingly. As a result, the smallest point may be very small. To avoid the latter, one can also set \code{plim[3]}, which enforces a minimal point size. One can also set \code{psize} to a scalar (e.g., \code{psize=1}) to avoid that the points are drawn in different sizes. One can also specify the point sizes manually by passing a vector of the appropriate length to \code{psize}. Finally, one can also set \code{psize} to either \code{"seinv"} or \code{"vinv"} to make the point sizes proportional to the inverse standard errors or inverse sampling variances. With the \code{label} argument, one can control whether points in the plot will be labeled. If \code{label="all"} (or \code{label=TRUE}), all points in the plot will be labeled. If \code{label="ciout"} or \code{label="piout"}, points falling outside of the confidence/prediction interval will be labeled. Alternatively, one can set this argument to a logical or numeric vector to specify which points should be labeled. The labels are placed above the points when they fall above the regression line and otherwise below. With the \code{offset} argument, one can adjust the distance between the labels and the corresponding points. This can either be a single numeric value, which is used as a multiplicative factor for the point sizes (so that the distance between labels and points is larger for larger points) or a numeric vector with two values, where the first is used as an additive factor independent of the point sizes and the second again as a multiplicative factor for the point sizes. The values are given as percentages of the y-axis range. It may take some trial and error to find two values for the \code{offset} argument so that the labels are placed right next to the boundary of the points. With \code{labsize}, one can control the size of the labels. One can also pass an object from \code{\link[=predict.rma]{predict}} to the \code{pred} argument. This can be useful when the meta-regression model reflects a more complex relationship between the moderator variable and the effect sizes or outcomes (e.g., when using polynomials or splines) or when the model involves interactions. In this case, one also needs to specify the \code{xvals} argument. See \sQuote{Examples}. } \note{ For certain types of models, it may not be possible to draw the prediction interval bounds (if this is the case, a warning will be issued). Argument \code{slab} and when specifying vectors for arguments \code{pch}, \code{psize}, \code{col}, \code{bg}, and/or \code{label} (for a logical vector), the variables specified are assumed to be of the same length as the data passed to the model fitting function (and if the \code{data} argument was used in the original model fit, then the variables will be searched for within this data frame first). Any subsetting and removal of studies with missing values is automatically applied to the variables specified via these arguments. If the outcome measure used for creating the plot is bounded (e.g., correlations are bounded between -1 and +1, proportions are bounded between 0 and 1), one can use the \code{olim} argument to enforce those limits (the observed outcomes and confidence/prediction intervals cannot exceed those bounds then). } \value{ An object of class \code{"regplot"} with components: \item{slab}{the study labels} \item{ids}{the study ids} \item{xi}{the x-axis coordinates of the points that were plotted.} \item{yi}{the y-axis coordinates of the points that were plotted.} \item{pch}{the plotting symbols of the points that were plotted.} \item{psize}{the point sizes of the points that were plotted.} \item{col}{the colors of the points that were plotted.} \item{bg}{the background colors of the points that were plotted.} \item{label}{logical vector indicating whether a point was labeled.} Note that the object is returned invisibly. Using \code{points.regplot}, one can redraw the points (and labels) in case one wants to superimpose the points on top of any elements that were added manually to the plot (see \sQuote{Examples}). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Thompson, S. G., & Higgins, J. P. T. (2002). How should meta-regression analyses be undertaken and interpreted? \emph{Statistics in Medicine}, \bold{21}(11), 1559--1573. \verb{https://doi.org/10.1002/sim.1187} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models for which scatter plots / bubble plots can be drawn. } \examples{ ### copy BCG vaccine data into 'dat' dat <- dat.bcg ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) ############################################################################ ### fit mixed-effects model with absolute latitude as a moderator res <- rma(yi, vi, mods = ~ ablat, data=dat) res ### draw plot regplot(res, mod="ablat", xlab="Absolute Latitude") ### adjust x-axis limits and back-transform to risk ratios regplot(res, mod="ablat", xlab="Absolute Latitude", xlim=c(0,60), transf=exp) ### also extend the prediction limits for the regression line regplot(res, mod="ablat", xlab="Absolute Latitude", xlim=c(0,60), predlim=c(0,60), transf=exp) ### add the prediction interval to the plot, add a reference line at 1, and add a legend regplot(res, mod="ablat", pi=TRUE, xlab="Absolute Latitude", xlim=c(0,60), predlim=c(0,60), transf=exp, refline=1, legend=TRUE) ### label points outside of the prediction interval regplot(res, mod="ablat", pi=TRUE, xlab="Absolute Latitude", xlim=c(0,60), predlim=c(0,60), transf=exp, refline=1, legend=TRUE, label="piout", labsize=0.8) ############################################################################ ### fit mixed-effects model with absolute latitude and publication year as moderators res <- rma(yi, vi, mods = ~ ablat + year, data=dat) res ### plot the marginal relationships regplot(res, mod="ablat", xlab="Absolute Latitude") regplot(res, mod="year", xlab="Publication Year") ############################################################################ ### fit a quadratic polynomial meta-regression model res <- rma(yi, vi, mods = ~ ablat + I(ablat^2), data=dat) res ### compute predicted values using predict() xs <- seq(0,60,length=601) tmp <- predict(res, newmods=cbind(xs, xs^2)) ### can now pass these results to the 'pred' argument (and have to specify xvals accordingly) regplot(res, mod="ablat", pred=tmp, xlab="Absolute Latitude", xlim=c(0,60), xvals=xs) ### back-transform to risk ratios and add reference line regplot(res, mod="ablat", pred=tmp, xlab="Absolute Latitude", xlim=c(0,60), xvals=xs, transf=exp, refline=1) ############################################################################ ### fit a model with an interaction between a quantitative and a categorical predictor ### (note: just for illustration purposes; this model is too complex for this dataset) res <- rma(yi, vi, mods = ~ ablat * alloc, data=dat) res ### draw bubble plot but do not add regression line or CI tmp <- regplot(res, mod="ablat", xlab="Absolute Latitude", xlim=c(0,60), pred=FALSE, ci=FALSE) ### add regression lines for the three alloc levels xs <- seq(0, 60, length=100) preds <- predict(res, newmods=cbind(xs, 0, 0, 0, 0)) lines(xs, preds$pred, lwd=3) preds <- predict(res, newmods=cbind(xs, 1, 0, xs, 0)) lines(xs, preds$pred, lwd=3) preds <- predict(res, newmods=cbind(xs, 0, 1, 0, xs)) lines(xs, preds$pred, lwd=3) ### add points back to the plot (so they are on top of the lines) points(tmp) } \keyword{hplot} metafor/man/methods.anova.rma.Rd0000644000176200001440000000306714505063152016304 0ustar liggesusers\name{methods.anova.rma} \alias{methods.anova.rma} \alias{as.data.frame.anova.rma} \alias{as.data.frame.list.anova.rma} \title{Methods for 'anova.rma' Objects} \description{ Methods for objects of class \code{"anova.rma"} and \code{"list.anova.rma"}. } \usage{ \method{as.data.frame}{anova.rma}(x, \dots) \method{as.data.frame}{list.anova.rma}(x, \dots) } \arguments{ \item{x}{an object of class \code{"anova.rma"} or \code{"list.anova.rma"}.} \item{\dots}{other arguments.} } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \examples{ ### copy data into 'dat' dat <- dat.bcg ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) ### fit mixed-effects meta-regression model res <- rma(yi, vi, mods = ~ alloc + ablat, data=dat) ### test the allocation factor sav <- anova(res, btt="alloc") sav ### turn object into a regular data frame as.data.frame(sav) ### test the contrast between levels random and systematic sav <- anova(res, X=c(0,1,-1,0)) sav ### turn object into a regular data frame as.data.frame(sav) ### fit random-effects model res0 <- rma(yi, vi, data=dat) ### LRT comparing the two models sav <- anova(res, res0, refit=TRUE) sav ### turn object into a regular data frame as.data.frame(sav) } \keyword{internal} metafor/man/labbe.Rd0000644000176200001440000001630714505063152014026 0ustar liggesusers\name{labbe} \alias{labbe} \alias{labbe.rma} \title{L'Abbe Plots for 'rma' Objects} \description{ Function to create \enc{L'Abbé}{L'Abbe} plots for objects of class \code{"rma"}. \loadmathjax } \usage{ labbe(x, \dots) \method{labbe}{rma}(x, xlim, ylim, xlab, ylab, add=x$add, to=x$to, transf, targs, pch=21, psize, plim=c(0.5,3.5), col, bg, grid=FALSE, lty, \dots) } \arguments{ \item{x}{an object of class \code{"rma"}.} \item{xlim}{x-axis limits. If unspecified, the function sets the x-axis limits to some sensible values.} \item{ylim}{y-axis limits. If unspecified, the function sets the y-axis limits to some sensible values.} \item{xlab}{title for the x-axis. If unspecified, the function sets an appropriate axis title.} \item{ylab}{title for the y-axis. If unspecified, the function sets an appropriate axis title.} \item{add}{See the documentation of the \code{\link{escalc}} function for more details.} \item{to}{See the documentation of the \code{\link{escalc}} function for more details.} \item{transf}{optional argument to specify a function to transform the outcomes (e.g., \code{transf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{targs}{optional arguments needed by the function specified under \code{transf}.} \item{pch}{plotting symbol to use for the outcomes. By default, an open circle is used. Can also be a vector of values. See \code{\link{points}} for other options.} \item{psize}{optional numeric vector to specify the point sizes for the outcomes. If unspecified, the point sizes are a function of the precision of the outcomes. Can also be a vector of values.} \item{plim}{numeric vector of length 2 to scale the point sizes (ignored when \code{psize} is specified). See \sQuote{Details}.} \item{col}{optional character string to specify the (border) color of the points. Can also be a vector.} \item{bg}{optional character string to specify the background color of open plot symbols. Can also be a vector. Set to \code{NA} to make the plotting symbols transparent.} \item{grid}{logical to specify whether a grid should be added to the plot. Can also be a color name.} \item{lty}{optional character vector to specify the line type for the diagonal reference line of no effect and the line that indicates the estimated effect based on the fitted model. If unspecified, the function sets this to \code{c("solid","dashed")} by default (use \code{"blank"} to suppress a line).} \item{\dots}{other arguments.} } \details{ The model specified via \code{x} must be a model without moderators (i.e., either an equal- or a random-effects model) fitted with either the \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, or \code{\link{rma.glmm}} functions. Moreover, the model must have been fitted with \code{measure} set equal to \code{"RD"} (for risk differences), \code{"RR"} (for risk ratios), \code{"OR"} (for odds ratios), \code{"AS"} (for arcsine square root transformed risk differences), \code{"IRR"} (for incidence rate ratios), \code{"IRD"} (for incidence rate differences), or \code{"IRSD"} (for square root transformed incidence rate differences). The function calculates the arm-level outcomes for the two groups (e.g., treatment and control) and plots them against each other. In particular, the function plots the raw proportions of the two groups against each other when analyzing risk differences, the log of the proportions when analyzing (log) risk ratios, the log odds when analyzing (log) odds ratios, the arcsine square root transformed proportions when analyzing arcsine square root transformed risk differences, the raw incidence rates when analyzing incidence rate differences, the log of the incidence rates when analyzing (log) incidence rate ratios, and the square root transformed incidence rates when analyzing square root transformed incidence rate differences. The \code{transf} argument can be used to transform these values (e.g., \code{transf=exp} to transform the log of the proportions back to raw proportions; see also \link{transf}). As described under the documentation for the \code{\link{escalc}} function, zero cells can lead to problems when calculating particular outcomes. Adding a small constant to the cells of the \mjeqn{2 \times 2}{2x2} tables is a common solution to this problem. By default, the functions adopts the same method for handling zero cells as was used when fitting the model. By default (i.e., when \code{psize} is not specified), the point sizes are a function of the precision (i.e., inverse standard errors) of the outcomes. This way, more precise estimates are visually more prominent in the plot. By making the point sizes a function of the inverse standard errors of the estimates, their areas are proportional to the inverse sampling variances, which corresponds to the weights they would receive in an equal-effects model. However, the point sizes are rescaled so that the smallest point size is \code{plim[1]} and the largest point size is \code{plim[2]}. As a result, their relative sizes (i.e., areas) no longer exactly correspond to their relative weights in such a model. If exactly relative point sizes are desired, one can set \code{plim[2]} to \code{NA}, in which case the points are rescaled so that the smallest point size corresponds to \code{plim[1]} and all other points are scaled accordingly. As a result, the largest point may be very large. Alternatively, one can set \code{plim[1]} to \code{NA}, in which case the points are rescaled so that the largest point size corresponds to \code{plim[2]} and all other points are scaled accordingly. The solid line corresponds to identical outcomes in the two groups (i.e., the absence of a difference between the two groups). The dashed line indicates the estimated effect based on the fitted model. } \value{ A data frame with components: \item{x}{the x-axis coordinates of the points that were plotted.} \item{y}{the y-axis coordinates of the points that were plotted.} \item{cex}{the point sizes.} \item{pch}{the plotting symbols.} \item{col}{the point colors.} \item{bg}{the background colors.} \item{ids}{the study id numbers.} \item{slab}{the study labels.} Note that the data frame is returned invisibly. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ \enc{L'Abbé}{L'Abbe}, K. A., Detsky, A. S., & O'Rourke, K. (1987). Meta-analysis in clinical research. \emph{Annals of Internal Medicine}, \bold{107}(2), 224--233. \verb{https://doi.org/10.7326/0003-4819-107-2-224} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, and \code{\link{rma.glmm}} for functions to fit models for which \enc{L'Abbé}{L'Abbe} plots can be drawn. } \examples{ ### meta-analysis of the log risk ratios using a random-effects model res <- rma(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### default plot labbe(res) ### funnel plot with risk values on the x- and y-axis and add grid labbe(res, transf=exp, grid=TRUE) } \keyword{hplot} metafor/man/plot.gosh.rma.Rd0000644000176200001440000001205114505063152015444 0ustar liggesusers\name{plot.gosh.rma} \alias{plot.gosh.rma} \title{Plot Method for 'gosh.rma' Objects} \description{ Function to plot objects of class \code{"gosh.rma"}. } \usage{ \method{plot}{gosh.rma}(x, het="I2", pch=16, cex, out, col, alpha, border, xlim, ylim, xhist=TRUE, yhist=TRUE, hh=0.3, breaks, adjust, lwd, labels, \dots) } \arguments{ \item{x}{an object of class \code{"gosh.rma"} obtained with \code{\link{gosh}}.} \item{het}{character string to specify the heterogeneity measure to plot. Either \code{"I2"}, \code{"H2"}, \code{"QE"}, or \code{"tau2"} (the last only for random/mixed-effects models).} \item{pch}{plotting symbol to use. By default, a borderless filled circle is used. See \code{\link{points}} for other options.} \item{cex}{symbol expansion factor.} \item{out}{optional integer to specify the number of a study that may be a potential outlier. If specified, subsets containing the specified study are drawn in a different color than those not containing the study.} \item{col}{optional character string to specify the color of the points (if unspecified, points are drawn in black). When \code{out} is used, two colors should be specified (if unspecified, red is used for subsets containing the specified study and blue otherwise).} \item{alpha}{optional alpha transparency value for the points (0 means fully transparent and 1 means opaque). If unspecified, the function sets this to a sensible value.} \item{border}{optional character string to specify the color of the borders of the histogram bars. Set to \code{FALSE} to omit the borders.} \item{xlim}{x-axis limits. If unspecified, the function sets the x-axis limits to some sensible values.} \item{ylim}{y-axis limits. If unspecified, the function sets the y-axis limits to some sensible values.} \item{xhist}{logical to specify whether a histogram should be drawn for the x-axis (the default is \code{TRUE}).} \item{yhist}{logical to specify whether a histogram should be drawn for the y-axis (the default is \code{TRUE}).} \item{hh}{numeric value (or vector of two values) to adjust the height of the histogram(s). Must be between 0 and 1, but should not be too close to 0 or 1, as otherwise the plot cannot be drawn.} \item{breaks}{optional argument passed on to \code{\link{hist}} for choosing the (number of) breakpoints of the histogram(s).} \item{adjust}{optional argument passed on to \code{\link{density}} for adjusting the bandwidth of the kernel density estimate(s) (values larger than 1 result in more smoothing).} \item{lwd}{optional numeric value to specify the line width of the estimated densities. Set to \code{0} to omit the line(s).} \item{labels}{optional argument to specify the x-axis and y-axis labels (or passed on to \code{\link{pairs}} to specify the names of the variables in the scatter plot matrix).} \item{\dots}{other arguments.} } \details{ For models without moderators, the function draws a scatter plot of the model estimates on the x-axis against the chosen measure of heterogeneity on the y-axis. Histograms of the respective distributions (with kernel density estimates superimposed) are shown in the margins (when \code{xhist=TRUE} and \code{yhist=TRUE}). For models with moderators, the function draws a scatter plot matrix (with the \code{\link{pairs}} function) of the chosen measure of heterogeneity and each of the model coefficients. Histograms of the variables plotted are shown along the diagonal, with kernel density estimates of the distributions superimposed. Arguments \code{xlim}, \code{ylim}, \code{xhist}, and \code{yhist} are then ignored, while argument \code{hh} can be used to compress/stretch the height of the distributions shown along the diagonal. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Olkin, I., Dahabreh, I. J., & Trikalinos, T. A. (2012). GOSH - a graphical display of study heterogeneity. \emph{Research Synthesis Methods}, \bold{3}(3), 214--223. \verb{https://doi.org/10.1002/jrsm.1053} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W. (2021). Model checking in meta-analysis. In C. H. Schmid, T. Stijnen, & I. R. White (Eds.), \emph{Handbook of meta-analysis} (pp. 219--254). Boca Raton, FL: CRC Press. \verb{https://doi.org/10.1201/9781315119403} } \seealso{ \code{\link{gosh}} for the function to create the input to a GOSH plot. } \examples{ ### calculate log odds ratios and corresponding sampling variances dat <- escalc(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat.egger2001) ### meta-analysis of all trials including ISIS-4 using an equal-effects model res <- rma(yi, vi, data=dat, method="EE") ### fit FE model to all possible subsets (65535 models) \dontrun{ sav <- gosh(res, progbar=FALSE) ### create GOSH plot ### red points for subsets that include and blue points ### for subsets that exclude study 16 (the ISIS-4 trial) plot(sav, out=16, breaks=100) } } \keyword{hplot} metafor/man/replmiss.Rd0000644000176200001440000000147314505063152014615 0ustar liggesusers\name{replmiss} \alias{replmiss} \title{Replace Missing Values in a Vector} \description{ Function to replace missing (\code{NA}) values in a vector. } \usage{ replmiss(x, y, data) } \arguments{ \item{x}{vector that may include one or more missing values.} \item{y}{either a scalar or a vector of the same length as \code{x} with the value(s) to replace missing values with.} \item{data}{optional data frame containing the variables given to the arguments above.} } \value{ Vector \code{x} with the missing values replaced based on the scalar or vector \code{y}. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \examples{ x <- c(4,2,7,NA,1,NA,5) x <- replmiss(x,0) x x <- c(4,2,7,NA,1,NA,5) y <- c(2,3,6,5,8,1,2) x <- replmiss(x,y) x } \keyword{manip} metafor/man/print.permutest.rma.uni.Rd0000644000176200001440000000405514505063152017511 0ustar liggesusers\name{print.permutest.rma.uni} \alias{print.permutest.rma.uni} \title{Print Method for 'permutest.rma.uni' Objects} \description{ Function to print objects of class \code{"permutest.rma.uni"}. } \usage{ \method{print}{permutest.rma.uni}(x, digits=x$digits, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, \dots) } \arguments{ \item{x}{an object of class \code{"permutest.rma.uni"} obtained with \code{\link[=permutest.rma.uni]{permutest}}.} \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} \item{signif.stars}{logical to specify whether p-values should be encoded visually with \sQuote{significance stars}. Defaults to the \code{show.signif.stars} slot of \code{\link{options}}.} \item{signif.legend}{logical to specify whether the legend for the \sQuote{significance stars} should be printed. Defaults to the value for \code{signif.stars}.} \item{\dots}{other arguments.} } \details{ The output includes: \itemize{ \item the results of the omnibus test of moderators. Suppressed if the model includes only one coefficient (e.g., only an intercept, like in the equal- and random-effects models). The p-value is based on the permutation test. \item a table with the estimated coefficients, corresponding standard errors, test statistics, p-values, and confidence interval bounds. The p-values are based on permutation tests. If \code{permci} was set to \code{TRUE}, then the permutation-based CI bounds are shown. } } \value{ The function does not return an object. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link[=permutest.rma.uni]{permutest}} for the function to create \code{permutest.rma.uni} objects. } \keyword{print} metafor/man/rcalc.Rd0000644000176200001440000002225514505063152014044 0ustar liggesusers\name{rcalc} \alias{rcalc} \title{Calculate the Variance-Covariance of Dependent Correlation Coefficients} \description{ Function to calculate the variance-covariance matrix of correlation coefficients computed based on the same sample of subjects. \loadmathjax } \usage{ rcalc(x, ni, data, rtoz=FALSE, nfun="min", sparse=FALSE, \dots) } \arguments{ \item{x}{a formula of the form \code{ri ~ var1 + var2 | study}. Can also be a correlation matrix or list thereof. See \sQuote{Details}.} \item{ni}{vector to specify the sample sizes based on which the correlations were computed.} \item{data}{data frame containing the variables specified via the formula (and the sample sizes).} \item{rtoz}{logical to specify whether to transform the correlations via Fisher's r-to-z transformation (the default is \code{FALSE}).} \item{nfun}{a character string to specify how the \sQuote{common} sample size within each study should be computed. Possible options are \code{"min"} (for the minimum), \code{"harmonic"} (for the harmonic mean), or \code{"mean"} (for the arithmetic mean). Can also be a function. See \sQuote{Details}.} \item{sparse}{logical to specify whether the variance-covariance matrix should be returned as a sparse matrix (the default is \code{FALSE}).} \item{\dots}{other arguments.} } \details{ A meta-analysis of correlation coefficients may involve multiple correlation coefficients extracted from the same study. When these correlations are computed based on the same sample of subjects, then they are typically not independent. The \code{rcalc} function can be used to create a dataset with the correlation coefficients (possibly transformed with Fisher's r-to-z transformation) and the corresponding variance-covariance matrix. The dataset and variance-covariance matrix can then be further meta-analyzed using the \code{\link{rma.mv}} function. When computing the covariance between two correlation coefficients, we can distinguish two cases: \enumerate{ \item In the first case, one of the variables involved in the two correlation coefficients is the same. For example, in \mjseqn{r_{12}} and \mjseqn{r_{13}}, variable 1 is common to both correlation coefficients. This is sometimes called the (partially) \sQuote{overlapping} case. The covariance between the two correlation coefficients, \mjeqn{\mbox{Cov}[r_{12}, r_{13}]}{Cov[r_{12}, r_{13}]}, then depends on the degree of correlation between variables 2 and 3 (i.e., \mjseqn{r_{23}}). \item In the second case, none of the variables are common to both correlation coefficients. For example, this would be the case if we have correlations \mjseqn{r_{12}} and \mjseqn{r_{34}} based on 4 variables. This is sometimes called the \sQuote{non-overlapping} case. The covariance between the two correlation coefficients, \mjeqn{\mbox{Cov}[r_{12}, r_{34}]}{Cov[r_{12}, r_{34}]}, then depends on \mjseqn{r_{13}}, \mjseqn{r_{14}}, \mjseqn{r_{23}}, and \mjseqn{r_{24}}. } Equations to compute these covariances can be found, for example, in Steiger (1980) and Olkin and Finn (1990). To use the \code{rcalc} function, one needs to construct a data frame that contains a study identifier (say \code{study}), two variable identifiers (say \code{var1} and \code{var2}), the corresponding correlation coefficients (say \code{ri}), and the sample sizes based on which the correlation coefficients were computed (say \code{ni}). Then the first argument should be a formula of the form \code{ri ~ var1 + var2 | study}, argument \code{ni} is set equal to the variable name containing the sample sizes, and the data frame containing these variables is specified via the \code{data} argument. When using the function for a single study, one can leave out the study identifier from the formula. When argument \code{rtoz} is set to \code{TRUE}, then the correlations are transformed with Fisher's r-to-z transformation (Fisher, 1921) and the variance-covariance matrix is computed for the transformed values. In some cases, the sample size may not be identical within a study (e.g., \mjseqn{r_{12}} may have been computed based on 120 subjects while \mjseqn{r_{13}} was computed based on 118 subjects due to 2 missing values in variable 3). For constructing the variance-covariance matrix, we need to assume a \sQuote{common} sample size for all correlation coefficients within the study. Argument \code{nfun} provides some options for how the common sample size should be computed. Possible options are \code{"min"} (for using the minimum sample size within a study as the common sample size), \code{"harmonic"} (for using the harmonic mean), or \code{"mean"} (for using the arithmetic mean). The default is \code{"min"}, which is a conservative choice (i.e., it will overestimate the sampling variances of coefficients that were computed based on a sample size that was actually larger than the minimum sample size). One can also specify a function via the \code{nfun} argument (which should take a numeric vector as input and return a single value). Instead of specifying a formula, one can also pass a correlation matrix to the function via argument \code{x}. Argument \code{ni} then specifies the (common) sample size based on which the elements in the correlation matrix were computed. One can also pass a list of correlation matrices via argument \code{x}, in which case argument \code{ni} should be a vector of sample sizes of the same length as \code{x}. } \value{ A list containing the following components: \item{dat}{a data frame with the study identifier, the two variable identifiers, a variable pair identifier, the correlation coefficients (possibly transformed with Fisher's r-to-z transformation), and the (common) sample sizes.} \item{V}{corresponding variance-covariance matrix (given as a sparse matrix when \code{sparse=TRUE}).} Note that a particular covariance can only be computed when all of the correlation coefficients involved in the covariance equation are included in the dataset. If one or more coefficients needed for the computation are missing, then the resulting covariance will also be missing (i.e., \code{NA}). } \note{ For raw correlation coefficients, the variance-covariance matrix is computed with \mjseqn{n-1} in the denominator (instead of \mjseqn{n} as suggested in Steiger, 1980, and Olkin & Finn, 1990). This is more consistent with the usual equation for computing the sampling variance of a correlation coefficient (which also typically uses \mjseqn{n-1} in the denominator). For raw and r-to-z transformed coefficients, the variance-covariance matrix will only be computed when the (common) sample size for a study is at least 5. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Fisher, R. A. (1921). On the \dQuote{probable error} of a coefficient of correlation deduced from a small sample. \emph{Metron}, \bold{1}, 1--32. \verb{http://hdl.handle.net/2440/15169} Olkin, I., & Finn, J. D. (1990). Testing correlated correlations. \emph{Psychological Bulletin}, \bold{108}(2), 330--333. \verb{https://doi.org/10.1037/0033-2909.108.2.330} Steiger, J. H. (1980). Tests for comparing elements of a correlation matrix. \emph{Psychological Bulletin}, \bold{87}(2), 245--251. \verb{https://doi.org/10.1037/0033-2909.87.2.245} } \seealso{ \code{\link{rma.mv}} for a model fitting function that can be used to meta-analyze dependent correlation coefficients. \code{\link[metadat]{dat.craft2003}} for an illustrative example. } \examples{ ############################################################################ ### copy data into 'dat' and examine the first 12 rows dat <- dat.craft2003 head(dat, 12) ### construct dataset and var-cov matrix of the correlations tmp <- rcalc(ri ~ var1 + var2 | study, ni=ni, data=dat) V <- tmp$V dat <- tmp$dat ### examine data and var-cov matrix for study 1 dat[dat$study == 1,] blsplit(V, dat$study, round, 4)$`1` ### examine data and var-cov matrix for study 6 dat[dat$study == 6,] blsplit(V, dat$study, round, 4)$`6` ### examine data and var-cov matrix for study 17 dat[dat$study == 17,] blsplit(V, dat$study, round, 4)$`17` ############################################################################ ### copy data into 'dat' and examine the first 12 rows dat <- dat.craft2003 head(dat, 12) ### restructure data from study 1 into a correlation matrix R1 <- diag(4) R1[lower.tri(R1)] <- dat$ri[dat$study == 1] R1[upper.tri(R1)] <- t(R1)[upper.tri(R1)] rownames(R1) <- colnames(R1) <- c("perf", "acog", "asom", "conf") R1 ### restructure data from study 3 into a correlation matrix R3 <- diag(4) R3[lower.tri(R3)] <- dat$ri[dat$study == 3] R3[upper.tri(R3)] <- t(R3)[upper.tri(R3)] rownames(R3) <- colnames(R3) <- c("perf", "acog", "asom", "conf") R3 ### an example where a correlation matrix is passed to rcalc() rcalc(R1, ni=142) ### an example where a list of correlation matrices is passed to rcalc() tmp <- rcalc(list("1"=R1,"3"=R3), ni=c(142,37)) V <- tmp$V dat <- tmp$dat ### examine data and var-cov matrix for study 1 dat[dat$id == 1,] blsplit(V, dat$id, round, 4)$`1` ### examine data and var-cov matrix for study 3 dat[dat$id == 3,] blsplit(V, dat$id, round, 4)$`3` ############################################################################ } \keyword{datagen} metafor/man/gosh.Rd0000644000176200001440000001513114505063152013713 0ustar liggesusers\name{gosh} \alias{gosh} \alias{gosh.rma} \title{GOSH Plots for 'rma' Objects} \description{ Function to create GOSH plots for objects of class \code{"rma"}. \loadmathjax } \usage{ gosh(x, \dots) \method{gosh}{rma}(x, subsets, progbar=TRUE, parallel="no", ncpus=1, cl, \dots) } \arguments{ \item{x}{an object of class \code{"rma"}.} \item{subsets}{optional integer to specify the number of subsets.} \item{progbar}{logical to specify whether a progress bar should be shown (the default is \code{TRUE}).} \item{parallel}{character string to specify whether parallel processing should be used (the default is \code{"no"}). For parallel processing, set to either \code{"snow"} or \code{"multicore"}. See \sQuote{Note}.} \item{ncpus}{integer to specify the number of processes to use in the parallel processing.} \item{cl}{optional cluster to use if \code{parallel="snow"}. If unspecified, a cluster on the local machine is created for the duration of the call.} \item{\dots}{other arguments.} } \details{ The model specified via \code{x} must be a model fitted with either the \code{\link{rma.uni}}, \code{\link{rma.mh}}, or \code{\link{rma.peto}} functions. Olkin et al. (2012) proposed the GOSH (graphical display of study heterogeneity) plot, which is based on examining the results of an equal-effects model in all possible subsets of size \mjseqn{1, \ldots, k} of the \mjseqn{k} studies included in a meta-analysis. In a homogeneous set of studies, the model estimates obtained this way should form a roughly symmetric, contiguous, and unimodal distribution. On the other hand, when the distribution is multimodal, then this suggests the presence of heterogeneity, possibly due to outliers and/or distinct subgroupings of studies. Plotting the estimates against some measure of heterogeneity (e.g., \mjseqn{I^2}, \mjseqn{H^2}, or the \mjseqn{Q}-statistic) can also help to reveal subclusters, which are indicative of heterogeneity. The same type of plot can be produced by first fitting an equal-effects model with either the \code{\link{rma.uni}} (using \code{method="EE"}), \code{\link{rma.mh}}, or \code{\link{rma.peto}} functions and then passing the fitted model object to the \code{gosh} function and then plotting the results. For models fitted with the \code{\link{rma.uni}} function (which may be random-effects or mixed-effects meta-regressions models), the idea underlying this type of plot can be generalized (Viechtbauer, 2021) by examining the distribution of all model coefficients, plotting them against each other, and against some measure of (residual) heterogeneity (including the estimate of \mjseqn{\tau^2}). Note that for models without moderators, application of the method requires fitting a total of \mjseqn{2^k - 1} models, which could be an excessively large number when \mjseqn{k} is large. For example, for \mjseqn{k=10}, there are only 1023 possible subsets, but for \mjseqn{k=20}, this number already grows to 1,048,575. For even larger \mjseqn{k}, it may become computationally infeasible to consider all possible subsets. Instead, we can then examine (a sufficiently large number of) random subsets. By default, if the number of possible subsets is \mjseqn{\le 10^6}, the function will consider all possible subsets and otherwise \mjseqn{10^6} random subsets. One can use the \code{subsets} argument to specify a different number of subsets to consider. If \code{subsets} is specified and it is actually larger than the number of possible subsets, then the function automatically only considers the possible subsets and does not use random subsets. When \code{x} is an equal-effects model or a random-effects model fitted using \code{method="DL"}, provisions have been made to speed up the model fitting to the various subsets. For random-effects models using some other estimator of \mjseqn{\tau^2} (especially an iterative one like \code{method="REML"}), the computations will be considerably slower. } \value{ An object of class \code{"gosh.rma"}. The object is a list containing the following components: \item{res}{a data frame with the results for each subset (various heterogeneity statistics and the model coefficient(s)).} \item{incl}{a matrix indicating which studies were included in which subset.} \item{\dots}{some additional elements/values.} The results can be printed with the \code{\link[=print.gosh.rma]{print}} function and plotted with the \code{\link[=plot.gosh.rma]{plot}} function. } \note{ On machines with multiple cores, one can try to speed things up by delegating the model fitting to separate worker processes, that is, by setting \code{parallel="snow"} or \code{parallel="multicore"} and \code{ncpus} to some value larger than 1. Parallel processing makes use of the \code{\link[parallel]{parallel}} package, using the \code{\link[parallel]{makePSOCKcluster}} and \code{\link[parallel]{parLapply}} functions when \code{parallel="snow"} or using \code{\link[parallel]{mclapply}} when \code{parallel="multicore"} (the latter only works on Unix/Linux-alikes). With \code{parallel::detectCores()}, one can check on the number of available cores on the local machine. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Olkin, I., Dahabreh, I. J., & Trikalinos, T. A. (2012). GOSH - a graphical display of study heterogeneity. \emph{Research Synthesis Methods}, \bold{3}(3), 214--223. \verb{https://doi.org/10.1002/jrsm.1053} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W. (2021). Model checking in meta-analysis. In C. H. Schmid, T. Stijnen, & I. R. White (Eds.), \emph{Handbook of meta-analysis} (pp. 219--254). Boca Raton, FL: CRC Press. \verb{https://doi.org/10.1201/9781315119403} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, and \code{\link{rma.peto}} for functions to fit models for which GOSH plots can be drawn. \code{\link[=influence.rma.uni]{influence}} for other model diagnostics. } \examples{ ### calculate log odds ratios and corresponding sampling variances dat <- escalc(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat.egger2001) ### meta-analysis of all trials including ISIS-4 using an equal-effects model res <- rma(yi, vi, data=dat, method="EE") ### fit FE model to all possible subsets (65535 models) \dontrun{ sav <- gosh(res, progbar=FALSE) sav ### create GOSH plot ### red points for subsets that include and blue points ### for subsets that exclude study 16 (the ISIS-4 trial) plot(sav, out=16, breaks=100) } } \keyword{methods} metafor/man/permutest.Rd0000644000176200001440000003303414505063152015005 0ustar liggesusers\name{permutest} \alias{permutest} \alias{permutest.rma.uni} \alias{permutest.rma.ls} \title{Permutation Tests for 'rma.uni' Objects} \description{ Function to carry out permutation tests for objects of class \code{"rma.uni"} and \code{"rma.ls"}. \loadmathjax } \usage{ permutest(x, \dots) \method{permutest}{rma.uni}(x, exact=FALSE, iter=1000, permci=FALSE, progbar=TRUE, digits, control, \dots) \method{permutest}{rma.ls}(x, exact=FALSE, iter=1000, progbar=TRUE, digits, control, \dots) } \arguments{ \item{x}{an object of class \code{"rma.uni"} or \code{"rma.ls"}.} \item{exact}{logical to specify whether an exact permutation test should be carried out (the default is \code{FALSE}). See \sQuote{Details}.} \item{iter}{integer to specify the number of iterations for the permutation test when not doing an exact test (the default is \code{1000}).} \item{permci}{logical to specify whether permutation-based confidence intervals (CIs) should also be constructed (the default is \code{FALSE}). Can also be a vector of indices to specify for which coefficients a permutation-based CI should be obtained.} \item{progbar}{logical to specify whether a progress bar should be shown (the default is \code{TRUE}).} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} \item{control}{list of control values for numerical comparisons (\code{comptol}) and for \code{\link{uniroot}} (i.e., \code{tol} and \code{maxiter}). The latter is only relevant when \code{permci=TRUE}. See \sQuote{Note}.} \item{\dots}{other arguments.} } \details{ For models without moderators, the permutation test is carried out by permuting the signs of the observed effect sizes or outcomes. The (two-sided) p-value of the permutation test is then equal to the proportion of times that the absolute value of the test statistic under the permuted data is as extreme or more extreme than under the actually observed data. See Follmann and Proschan (1999) for more details. For models with moderators, the permutation test is carried out by permuting the rows of the model matrix (i.e., \mjseqn{X}). The (two-sided) p-value for a particular model coefficient is then equal to the proportion of times that the absolute value of the test statistic for the coefficient under the permuted data is as extreme or more extreme than under the actually observed data. Similarly, for the omnibus test, the p-value is the proportion of times that the test statistic for the omnibus test is as extreme or more extreme than the actually observed one. See Higgins and Thompson (2004) and Viechtbauer et al. (2015) for more details. \subsection{Exact versus Approximate Permutation Tests}{ If \code{exact=TRUE}, the function will try to carry out an exact permutation test. An exact permutation test requires fitting the model to each possible permutation. However, the number of possible permutations increases rapidly with the number of outcomes/studies (i.e., \mjseqn{k}). For models without moderators, there are \mjseqn{2^k} possible permutations of the signs. Therefore, for \mjseqn{k=5}, there are 32 possible permutations, for \mjseqn{k=10}, there are already 1024, and for \mjseqn{k=20}, there are over one million such permutations. For models with moderators, the increase in the number of possible permutations may be even more severe. The total number of possible permutations of the model matrix is \mjseqn{k!}. Therefore, for \mjseqn{k=5}, there are 120 possible permutations, for \mjseqn{k=10}, there are 3,628,800, and for \mjseqn{k=20}, there are over \mjeqn{10^{18}}{10^18} permutations of the model matrix. Therefore, going through all possible permutations may become infeasible. Instead of using an exact permutation test, one can set \code{exact=FALSE} (which is also the default). In that case, the function approximates the exact permutation-based p-value(s) by going through a smaller number (as specified by the \code{iter} argument) of \emph{random} permutations. Therefore, running the function twice on the same data can yield (slightly) different p-values. Setting \code{iter} sufficiently large ensures that the results become stable. For full reproducibility, one can also set the seed of the random number generator before running the function (see \sQuote{Examples}). Note that if \code{exact=FALSE} and \code{iter} is actually larger than the number of iterations required for an exact permutation test, then an exact test will automatically be carried out. For models with moderators, the exact permutation test actually only requires fitting the model to each \emph{unique} permutation of the model matrix. The number of unique permutations will be smaller than \mjseqn{k!} when the model matrix contains recurring rows. This may be the case when only including categorical moderators (i.e., factors) in the model or when any quantitative moderators included in the model can only take on a small number of unique values. When \code{exact=TRUE}, the function therefore uses an algorithm to restrict the test to only the unique permutations of the model matrix, which may make the use of the exact test feasible even when \mjseqn{k} is large. One can also set \code{exact="i"} in which case the function just returns the number of iterations required for an exact permutation test. When using random permutations, the function ensures that the very first permutation will always correspond to the original data. This avoids p-values equal to 0. } \subsection{Permutation-Based Confidence Intervals}{ When \code{permci=TRUE}, the function also tries to obtain permutation-based confidence intervals (CIs) of the model coefficient(s). This is done by shifting the observed effect sizes or outcomes by some amount and finding the most extreme values for this amount for which the permutation-based test would just lead to non-rejection. The calculation of such CIs is computationally expensive and may take a long time to complete. For models with moderators, one can also set \code{permci} to a vector of indices to specify for which coefficient(s) a permutation-based CI should be obtained. When the algorithm fails to determine a particular CI bound, it will be shown as \code{NA} in the output. } \subsection{Permutation Tests for Location-Scale Models}{ The function also works with location-scale models (see \code{\link{rma.uni}} for details on such models). Permutation tests will then be carried out for both the location and scale parts of the model. However, note that permutation-based CIs are not available for location-scale models. } } \value{ An object of class \code{"permutest.rma.uni"}. The object is a list containing the following components: \item{pval}{p-value(s) based on the permutation test.} \item{QMp}{p-value for the omnibus test of moderators based on the permutation test.} \item{zval.perm}{values of the test statistics of the coefficients under the various permutations.} \item{b.perm}{the model coefficients under the various permutations.} \item{QM.perm}{the test statistic of the omnibus test of moderators under the various permutations.} \item{ci.lb}{lower bound of the confidence intervals for the coefficients (permutation-based when \code{permci=TRUE}).} \item{ci.ub}{upper bound of the confidence intervals for the coefficients (permutation-based when \code{permci=TRUE}).} \item{\dots}{some additional elements/values are passed on.} The results are formatted and printed with the \code{\link[=print.permutest.rma.uni]{print}} function. One can also use \code{\link[=coef.permutest.rma.uni]{coef}} to obtain the table with the model coefficients, corresponding standard errors, test statistics, p-values, and confidence interval bounds. The permutation distribution(s) can be plotted with the \code{\link[=plot.permutest.rma.uni]{plot}} function. } \note{ The p-values obtained with permutation tests cannot reach conventional levels of statistical significance (i.e., \mjseqn{p \le .05}) when \mjseqn{k} is very small. In particular, for models without moderators, the smallest possible (two-sided) p-value is .0625 when \mjseqn{k=5} and .03125 when \mjseqn{k=6}. Therefore, the permutation test is only able to reject the null hypothesis at \mjseqn{\alpha=.05} when \mjseqn{k} is at least equal to 6. For models with moderators, the smallest possible (two-sided) p-value for a particular model coefficient is .0833 when \mjseqn{k=4} and .0167 when \mjseqn{k=5} (assuming that each row in the model matrix is unique). Therefore, the permutation test is only able to reject the null hypothesis at \mjseqn{\alpha=.05} when \mjseqn{k} is at least equal to 5. Consequently, permutation-based CIs can also only be obtained when \mjseqn{k} is sufficiently large. When the number of permutations required for the exact test is so large as to be essentially indistinguishable from infinity (e.g., \code{factorial(200)}), the function will terminate with an error. Determining whether a test statistic under the permuted data is as extreme or more extreme than under the actually observed data requires making \code{>=} or \code{<=} comparisons. To avoid problems due to the finite precision with which computers generally represent numbers (see \href{https://cran.r-project.org/doc/FAQ/R-FAQ.html#Why-doesn_0027t-R-think-these-numbers-are-equal_003f}{this} FAQ for details), the function uses a numerical tolerance (\code{control} argument \code{comptol}, which is set equal to \code{.Machine$double.eps^0.5} by default) when making such comparisons (e.g., instead of \code{sqrt(3)^2 >= 3}, which may evaluate to \code{FALSE}, we use \code{sqrt(3)^2 >= 3 - .Machine$double.eps^0.5}, which should evaluate to \code{TRUE}). When obtaining permutation-based CIs, the function makes use of \code{\link{uniroot}}. By default, the desired accuracy is set equal to \code{.Machine$double.eps^0.25} and the maximum number of iterations to \code{100}. The desired accuracy and the maximum number of iterations can be adjusted with the \code{control} argument (i.e., \code{control=list(tol=value, maxiter=value)}). Also, the interval searched for the CI bounds may be too narrow, leading to \code{NA} for a bound. In this case, one can try setting \code{control=list(distfac=value)} with a value larger than 1 to extend the interval (the value indicating a multiplicative factor by which to extend the width of the interval searched) or \code{control=list(extendInt="yes")} to allow \code{\link{uniroot}} to extend the interval dynamically (in which case it can happen that a bound may try to drift towards \mjeqn{\pm \infty}{± infinity}). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Follmann, D. A., & Proschan, M. A. (1999). Valid inference in random effects meta-analysis. \emph{Biometrics}, \bold{55}(3), 732--737. \verb{https://doi.org/10.1111/j.0006-341x.1999.00732.x} Good, P. I. (2009). \emph{Permutation, parametric, and bootstrap tests of hypotheses} (3rd ed.). New York: Springer. Higgins, J. P. T., & Thompson, S. G. (2004). Controlling the risk of spurious findings from meta-regression. \emph{Statistics in Medicine}, \bold{23}(11), 1663--1682. \verb{https://doi.org/10.1002/sim.1752} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W., \enc{López-López}{Lopez-Lopez}, J. A., \enc{Sánchez-Meca}{Sanchez-Meca}, J., & \enc{Marín-Martínez}{Marin-Martinez}, F. (2015). A comparison of procedures to test for moderators in mixed-effects meta-regression models. \emph{Psychological Methods}, \bold{20}(3), 360--374. \verb{https://doi.org/10.1037/met0000023} Viechtbauer, W., & \enc{López-López}{Lopez-Lopez}, J. A. (2022). Location-scale models for meta-analysis. \emph{Research Synthesis Methods}. \bold{13}(6), 697--715. \verb{https://doi.org/10.1002/jrsm.1562} } \seealso{ \code{\link{rma.uni}} for the function to fit models for which permutation tests can be conducted. \code{\link[=print.permutest.rma.uni]{print}} and \code{\link[=plot.permutest.rma.uni]{plot}} for the print and plot methods and \code{\link[=coef.permutest.rma.uni]{coef}} for a method to extract the model results table. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### random-effects model res <- rma(yi, vi, data=dat) res \dontrun{ ### permutation test (approximate and exact) set.seed(1234) # for reproducibility permutest(res) permutest(res, exact=TRUE) } ### mixed-effects model with two moderators (absolute latitude and publication year) res <- rma(yi, vi, mods = ~ ablat + year, data=dat) res ### number of iterations required for an exact permutation test permutest(res, exact="i") \dontrun{ ### permutation test (approximate only; exact not feasible) set.seed(1234) # for reproducibility permres <- permutest(res, iter=10000) permres ### plot of the permutation distribution for absolute latitude ### dashed horizontal line: the observed value of the test statistic (in both tails) ### black curve: standard normal density (theoretical reference/null distribution) ### blue curve: kernel density estimate of the permutation distribution ### note: the tail area under the permutation distribution is larger ### than under a standard normal density (hence, the larger p-value) plot(permres, beta=2, lwd=c(2,3,3,4), xlim=c(-5,5)) } } \keyword{models} metafor/man/conv.fivenum.Rd0000644000176200001440000004577614505063152015412 0ustar liggesusers\name{conv.fivenum} \alias{conv.fivenum} \title{Estimate Means and Standard Deviations from Five-Number Summary Values} \description{ Function to estimate means and standard deviations from five-number summary values. } \usage{ conv.fivenum(min, q1, median, q3, max, n, data, include, method="default", dist="norm", transf=TRUE, test=TRUE, var.names=c("mean","sd"), append=TRUE, replace="ifna", \dots) } \arguments{ \item{min}{vector with the minimum values.} \item{q1}{vector with the lower/first quartile values.} \item{median}{vector with the median values.} \item{q3}{vector with the upper/third quartile values.} \item{max}{vector with the maximum values.} \item{n}{vector with the sample sizes.} \item{data}{optional data frame containing the variables given to the arguments above.} \item{include}{optional (logical or numeric) vector to specify the subset of studies for which means and standard deviations should be estimated.} \item{method}{character string indicating the method to use. Either \code{"default"} (same as \code{"luo/wan/shi"} which is the current default), \code{"qe"}, \code{"bc"}, \code{"mln"}, or \code{"blue"}. Can be abbreviated. See \sQuote{Details}.} \item{dist}{character string indicating the distribution assumed for the underlying data (either \code{"norm"} for a normal distribution or \code{"lnorm"} for a log-normal distribution). Can also be a string vector if different distributions are assumed for different studies. Only relevant when \code{method="default"}.} \item{transf}{logical to specify whether the estimated means and standard deviations of the log-transformed data should be back-transformed as described by Shi et al. (2020b) (the default is \code{TRUE}). Only relevant when \code{dist="lnorm"} and when \code{method="default"}.} \item{test}{logical to specify whether a study should be excluded from the estimation if the test for skewness is significant (the default is \code{TRUE}, but whether this is applicable depends on the method; see \sQuote{Details}).} \item{var.names}{character vector with two elements to specify the name of the variable for the estimated means and the name of the variable for the estimated standard deviations (the defaults are \code{"mean"} and \code{"sd"}).} \item{append}{logical to specify whether the data frame provided via the \code{data} argument should be returned together with the estimated values (the default is \code{TRUE}).} \item{replace}{character string or logical to specify how values in \code{var.names} should be replaced (only relevant when using the \code{data} argument and if variables in \code{var.names} already exist in the data frame). See the \sQuote{Value} section for more details.} \item{\dots}{other arguments.} } \details{ Various effect size measures require means and standard deviations (SDs) as input (e.g., raw or standardized mean differences, ratios of means / response ratios; see \code{\link{escalc}} for further details). For some studies, authors may not report means and SDs, but other statistics, such as the so-called \sQuote{five-number summary}, consisting of the minimum, lower/first quartile, median, upper/third quartile, and the maximum of the sample values (plus the sample sizes). Occasionally, only a subset of these values are reported. The present function can be used to estimate means and standard deviations from five-number summary values based on various methods described in the literature (Bland, 2015; Cai et al. 2021; Hozo et al., 2005; Luo et al., 2016; McGrath et al., 2020; Shi et al., 2020a; Walter & Yao, 2007; Wan et al., 2014; Yang et al., 2022). When \code{method="default"} (which is the same as \code{"luo/wan/shi"}), the following methods are used: \subsection{Case 1: Min, Median, Max}{ In case only the minimum, median, and maximum is available for a study (plus the sample size), then the function uses the method by Luo et al. (2016), equation (7), to estimate the mean and the method by Wan et al. (2014), equation (9), to estimate the SD. } \subsection{Case 2: Q1, Median, Q3}{ In case only the lower/first quartile, median, and upper/third quartile is available for a study (plus the sample size), then the function uses the method by Luo et al. (2016), equation (11), to estimate the mean and the method by Wan et al. (2014), equation (16), to estimate the SD. } \subsection{Case 3: Min, Q1, Median, Q3, Max}{ In case the full five-number summary is available for a study (plus the sample size), then the function uses the method by Luo et al. (2016), equation (15), to estimate the mean and the method by Shi et al. (2020a), equation (10), to estimate the SD. } --------- The median is not actually needed in the methods by Wan et al. (2014) and Shi et al. (2020a) and hence it is possible to estimate the SD even if the median is unavailable (this can be useful if a study reports the mean directly, but instead of the SD, it reports the minimum/maximum and/or first/third quartile values). Note that the sample size must be at least 5 to apply these methods. Studies where the sample size is smaller are not included in the estimation. The function also checks that \code{min <= q1 <= median <= q3 <= max} and throws an error if any studies are found where this is not the case. \subsection{Test for Skewness}{ The methods described above were derived under the assumption that the data are normally distributed. Testing this assumption would require access to the raw data, but based on the three cases above, Shi et al. (2023) derived tests for skewness that only require the reported quantile values and the sample sizes. These tests are automatically carried out. When \code{test=TRUE} (which is the default), a study is automatically excluded from the estimation if the test is significant. If all studies should be included, set \code{test=FALSE}, but note that the accuracy of the methods will tend to be poorer when the data come from an apparently skewed (and hence non-normal) distribution. } \subsection{Log-Normal Distribution}{ When setting \code{dist="lnorm"}, the raw data are assumed to follow a log-normal distribution. In this case, the methods as described by Shi et al. (2020b) are used to estimate the mean and SD of the log transformed data for the three cases above. When \code{transf=TRUE} (the default), the estimated mean and SD of the log transformed data are back-transformed to the estimated mean and SD of the raw data (using the bias-corrected back-transformation as described by Shi et al., 2020b). Note that the test for skewness is also carried out when \code{dist="lnorm"}, but now testing if the log transformed data exhibit skewness. } \subsection{Alternative Methods}{ As an alternative to the methods above, one can make use of the methods implemented in the \href{https://cran.r-project.org/package=estmeansd}{estmeansd} package to estimate means and SDs based on the three cases above. Available are the quantile estimation method (\code{method="qe"}; using the \code{\link[estmeansd]{qe.mean.sd}} function; McGrath et al., 2020), the Box-Cox method (\code{method="bc"}; using the \code{\link[estmeansd]{bc.mean.sd}} function; McGrath et al., 2020), and the method for unknown non-normal distributions (\code{method="mln"}; using the \code{\link[estmeansd]{mln.mean.sd}} function; Cai et al. 2021). The advantage of these methods is that they do not assume that the data underlying the reported values are normally distributed (and hence the \code{test} argument is ignored), but they can only be used when the values are positive (except for the quantile estimation method, which can also be used when one or more of the values are negative, but in this case the method does assume that the data are normally distributed and hence the test for skewness is applied when \code{test=TRUE}). Note that all of these methods may struggle to provide sensible estimates when some of the values are equal to each other (which can happen when the data include a lot of ties and/or the reported values are rounded). Also, the Box-Cox method and the method for unknown non-normal distributions involve simulated data and hence results will slightly change on repeated runs. Setting the seed of the random number generator (with \code{\link{set.seed}}) ensures reproducibility. Finally, by setting \code{method="blue"}, one can make use of the \code{\link[metaBLUE]{BLUE_s}} function from the \href{https://cran.r-project.org/package=metaBLUE}{metaBLUE} package to estimate means and SDs based on the three cases above (Yang et al., 2022). The method assumes that the underlying data are normally distributed (and hence the test for skewness is applied when \code{test=TRUE}). } } \value{ If the \code{data} argument was not specified or \code{append=FALSE}, a data frame with two variables called \code{var.names[1]} (by default \code{"mean"}) and \code{var.names[2]} (by default \code{"sd"}) with the estimated means and SDs. If \code{data} was specified and \code{append=TRUE}, then the original data frame is returned. If \code{var.names[1]} is a variable in \code{data} and \code{replace="ifna"} (or \code{replace=FALSE}), then only missing values in this variable are replaced with the estimated means (where possible) and otherwise a new variable called \code{var.names[1]} is added to the data frame. Similarly, if \code{var.names[2]} is a variable in \code{data} and \code{replace="ifna"} (or \code{replace=FALSE}), then only missing values in this variable are replaced with the estimated SDs (where possible) and otherwise a new variable called \code{var.names[2]} is added to the data frame. If \code{replace="all"} (or \code{replace=TRUE}), then all values in \code{var.names[1]} and \code{var.names[2]} where an estimated mean and SD can be computed are replaced, even for cases where the value in \code{var.names[1]} and \code{var.names[2]} is not missing. When missing values in \code{var.names[1]} are replaced, an attribute called \code{"est"} is added to the variable, which is a logical vector that is \code{TRUE} for values that were estimated. The same is done when missing values in \code{var.names[2]} are replaced. Attributes called \code{"tval"}, \code{"crit"}, \code{"sig"}, and \code{"dist"} are also added to \code{var.names[1]} corresponding to the test statistic and critical value for the test for skewness, whether the test was significant, and the assumed distribution (for the quantile estimation method, this is the distribution that provides the best fit to the given values). } \note{ \bold{A word of caution:} Under the given distributional assumptions, the estimated means and SDs are approximately unbiased and hence so are any effect size measures computed based on them (assuming a measure is unbiased to begin with when computed with directly reported means and SDs). However, the estimated means and SDs are less precise (i.e., are more variable) than directly reported means and SDs (especially under case 1) and hence computing the sampling variance of a measure with equations that assume that directly reported means and SDs are available will tend to underestimate the actual sampling variance of the measure, giving too much weight to estimates computed based on estimated means and SDs (see also McGrath et al., 2023). It would therefore be prudent to treat effect size estimates computed from estimated means and SDs with caution (e.g., by examining in a moderator analysis whether there are systematic differences between studies directly reporting means and SDs and those where the means and SDs needed to be estimated and/or as part of a sensitivity analysis). McGrath et al. (2023) also suggest to use bootstrapping to estimate the sampling variance of effect size measures computed based on estimated means and SDs. See also the \href{https://cran.r-project.org/package=metamedian}{metamedian} package for this purpose. Also note that the development of methods for estimating means and SDs based on five-number summary values is an active area of research. Currently, when \code{method="default"}, then this is identical to \code{method="luo/wan/shi"}, but this might change in the future. For reproducibility, it is therefore recommended to explicitly set \code{method="luo/wan/shi"} (or one of the other methods) when running this function. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Bland, M. (2015). Estimating mean and standard deviation from the sample size, three quartiles, minimum, and maximum. \emph{International Journal of Statistics in Medical Research}, \bold{4}(1), 57--64. \verb{https://doi.org/10.6000/1929-6029.2015.04.01.6} Cai, S., Zhou, J., & Pan, J. (2021). Estimating the sample mean and standard deviation from order statistics and sample size in meta-analysis. \emph{Statistical Methods in Medical Research}, \bold{30}(12), 2701--2719. \verb{https://doi.org/10.1177/09622802211047348} Hozo, S. P., Djulbegovic, B. & Hozo, I. (2005). Estimating the mean and variance from the median, range, and the size of a sample. \emph{BMC Medical Research Methodology}, \bold{5}, 13. \verb{https://doi.org/10.1186/1471-2288-5-13} Luo, D., Wan, X., Liu, J. & Tong, T. (2016). Optimally estimating the sample mean from the sample size, median, mid-range, and/or mid-quartile range. \emph{Statistical Methods in Medical Research}, \bold{27}(6), 1785--1805. \verb{https://doi.org/10.1177/0962280216669183} McGrath, S., Zhao, X., Steele, R., Thombs, B. D., Benedetti, A., & the DEPRESsion Screening Data (DEPRESSD) Collaboration (2020). Estimating the sample mean and standard deviation from commonly reported quantiles in meta-analysis. \emph{Statistical Methods in Medical Research}, \bold{29}(9), 2520--2537. \verb{https://doi.org/10.1177/0962280219889080} McGrath, S., Katzenschlager, S., Zimmer, A. J., Seitel, A., Steele, R., & Benedetti, A. (2023). Standard error estimation in meta-analysis of studies reporting medians. \emph{Statistical Methods in Medical Research}, \bold{32}(2), 373--388. \verb{https://doi.org/10.1177/09622802221139233} Shi, J., Luo, D., Weng, H., Zeng, X.-T., Lin, L., Chu, H. & Tong, T. (2020a). Optimally estimating the sample standard deviation from the five-number summary. \emph{Research Synthesis Methods}, \bold{11}(5), 641--654. \verb{https://doi.org/https://doi.org/10.1002/jrsm.1429} Shi, J., Tong, T., Wang, Y. & Genton, M. G. (2020b). Estimating the mean and variance from the five-number summary of a log-normal distribution. Statistics and Its Interface, 13(4), 519-531. https://doi.org/10.4310/sii.2020.v13.n4.a9 Shi, J., Luo, D., Wan, X., Liu, Y., Liu, J., Bian, Z. & Tong, T. (2023). Detecting the skewness of data from the five-number summary and its application in meta-analysis. \emph{Statistical Methods in Medical Research}. \verb{https://doi.org/10.1177/09622802231172043} Walter, S. D. & Yao, X. (2007). Effect sizes can be calculated for studies reporting ranges for outcome variables in systematic reviews. \emph{Journal of Clinical Epidemiology}, \bold{60}(8), 849-852. \verb{https://doi.org/10.1016/j.jclinepi.2006.11.003} Wan, X., Wang, W., Liu, J. & Tong, T. (2014). Estimating the sample mean and standard deviation from the sample size, median, range and/or interquartile range. \emph{BMC Medical Research Methodology}, \bold{14}, 135. \verb{https://doi.org/10.1186/1471-2288-14-135} Yang, X., Hutson, A. D., & Wang, D. (2022). A generalized BLUE approach for combining location and scale information in a meta-analysis. \emph{Journal of Applied Statistics}, \bold{49}(15), 3846--3867. \verb{https://doi.org/10.1080/02664763.2021.1967890} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{escalc}} for a function to compute various effect size measures based on means and standard deviations. } \examples{ # example data frame dat <- data.frame(case=c(1:3,NA), min=c(2,NA,2,NA), q1=c(NA,4,4,NA), median=c(6,6,6,NA), q3=c(NA,10,10,NA), max=c(14,NA,14,NA), mean=c(NA,NA,NA,7.0), sd=c(NA,NA,NA,4.2), n=c(20,20,20,20)) dat # note that study 4 provides the mean and SD directly, while studies 1-3 provide five-number # summary values or a subset thereof (corresponding to cases 1-3 above) # estimate means/SDs (note: existing values in 'mean' and 'sd' are not touched) dat <- conv.fivenum(min=min, q1=q1, median=median, q3=q3, max=max, n=n, data=dat) dat # check attributes (none of the tests are significant, so means/SDs are estimated for studies 1-3) dfround(data.frame(attributes(dat$mean)), digits=3) # calculate the log transformed coefficient of variation and corresponding sampling variance dat <- escalc(measure="CVLN", mi=mean, sdi=sd, ni=n, data=dat) dat # fit equal-effects model to the estimates res <- rma(yi, vi, data=dat, method="EE") res # estimated coefficient of variation (with 95% CI) predict(res, transf=exp, digits=2) ############################################################################ # example data frame dat <- data.frame(case=c(1:3,NA), min=c(2,NA,2,NA), q1=c(NA,4,4,NA), median=c(6,6,6,NA), q3=c(NA,10,10,NA), max=c(14,NA,14,NA), mean=c(NA,NA,NA,7.0), sd=c(NA,NA,NA,4.2), n=c(20,20,20,20)) dat # try out different methods conv.fivenum(min=min, q1=q1, median=median, q3=q3, max=max, n=n, data=dat) set.seed(1234) conv.fivenum(min=min, q1=q1, median=median, q3=q3, max=max, n=n, data=dat, method="qe") conv.fivenum(min=min, q1=q1, median=median, q3=q3, max=max, n=n, data=dat, method="bc") conv.fivenum(min=min, q1=q1, median=median, q3=q3, max=max, n=n, data=dat, method="mln") conv.fivenum(min=min, q1=q1, median=median, q3=q3, max=max, n=n, data=dat, method="blue") ############################################################################ # example data frame dat <- data.frame(case=c(1:3,NA), min=c(2,NA,2,NA), q1=c(NA,4,4,NA), median=c(6,6,6,NA), q3=c(NA,10,14,NA), max=c(14,NA,20,NA), mean=c(NA,NA,NA,7.0), sd=c(NA,NA,NA,4.2), n=c(20,20,20,20)) dat # for study 3, the third quartile and maximum value suggest that the data have # a right skewed distribution (they are much further away from the median than # the minimum and first quartile) # estimate means/SDs dat <- conv.fivenum(min=min, q1=q1, median=median, q3=q3, max=max, n=n, data=dat) dat # note that the mean and SD are not estimated for study 3; this is because the # test for skewness is significant for this study dfround(data.frame(attributes(dat$mean)), digits=3) # estimate means/SDs, but assume that the data for study 3 come from a log-normal distribution # and back-transform the estimated mean/SD of the log-transformed data back to the raw data dat <- conv.fivenum(min=min, q1=q1, median=median, q3=q3, max=max, n=n, data=dat, dist=c("norm","norm","lnorm","norm"), replace="all") dat # this works now because the test for skewness of the log-transformed data is not significant dfround(data.frame(attributes(dat$mean)), digits=3) } \keyword{manip} metafor/man/escalc.Rd0000644000176200001440000024060514505063152014213 0ustar liggesusers\name{escalc} \alias{escalc} \title{Calculate Effect Sizes and Outcome Measures} \description{ Function to calculate various effect sizes or outcome measures (and the corresponding sampling variances) that are commonly used in meta-analyses. \loadmathjax } \usage{ escalc(measure, ai, bi, ci, di, n1i, n2i, x1i, x2i, t1i, t2i, m1i, m2i, sd1i, sd2i, xi, mi, ri, ti, fi, pi, sdi, r2i, ni, yi, vi, sei, data, slab, subset, include, add=1/2, to="only0", drop00=FALSE, vtype="LS", var.names=c("yi","vi"), add.measure=FALSE, append=TRUE, replace=TRUE, digits, \dots) } \arguments{ \item{measure}{a character string to specify which effect size or outcome measure should be calculated. See \sQuote{Details} for possible options and how the data needed to compute the selected effect size or outcome measure should then be specified (i.e., which of the following arguments need to be used).} \item{ai}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (upper left cell).} \item{bi}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (upper right cell).} \item{ci}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (lower left cell).} \item{di}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (lower right cell).} \item{n1i}{vector with the group sizes or row totals (first group/row).} \item{n2i}{vector with the group sizes or row totals (second group/row).} \item{x1i}{vector with the number of events (first group).} \item{x2i}{vector with the number of events (second group).} \item{t1i}{vector with the total person-times (first group).} \item{t2i}{vector with the total person-times (second group).} \item{m1i}{vector with the means (first group or time point).} \item{m2i}{vector with the means (second group or time point).} \item{sd1i}{vector with the standard deviations (first group or time point).} \item{sd2i}{vector with the standard deviations (second group or time point).} \item{xi}{vector with the frequencies of the event of interest.} \item{mi}{vector with the frequencies of the complement of the event of interest or the group means.} \item{ri}{vector with the raw correlation coefficients.} \item{ti}{vector with the total person-times or t-test statistics.} \item{fi}{vector with the F-test statistics.} \item{pi}{vector with the (signed) p-values.} \item{sdi}{vector with the standard deviations.} \item{r2i}{vector with the \mjseqn{R^2} values.} \item{ni}{vector with the sample/group sizes.} \item{yi}{vector with the observed effect sizes or outcomes.} \item{vi}{vector with the corresponding sampling variances.} \item{sei}{vector with the corresponding standard errors.} \item{data}{optional data frame containing the variables given to the arguments above.} \item{slab}{optional vector with labels for the studies.} \item{subset}{optional (logical or numeric) vector to specify the subset of studies that will be included in the data frame returned by the function.} \item{include}{optional (logical or numeric) vector to specify the subset of studies for which the measure should be calculated. See the \sQuote{Value} section for more details.} \item{add}{a non-negative number to specify the amount to add to zero cells, counts, or frequencies. See \sQuote{Details}.} \item{to}{a character string to specify when the values under \code{add} should be added (either \code{"all"}, \code{"only0"}, \code{"if0all"}, or \code{"none"}). See \sQuote{Details}.} \item{drop00}{logical to specify whether studies with no cases/events (or only cases) in both groups should be dropped when calculating the observed effect sizes or outcomes. See \sQuote{Details}.} \item{vtype}{a character string to specify the type of sampling variances to calculate. See \sQuote{Details}.} \item{var.names}{character vector with two elements to specify the name of the variable for the observed effect sizes or outcomes and the name of the variable for the corresponding sampling variances (the defaults are \code{"yi"} and \code{"vi"}).} \item{add.measure}{logical to specify whether a variable should be added to the data frame (with default name \code{"measure"}) that indicates the type of outcome measure computed. When using this option, \code{var.names} can have a third element to change this variable name.} \item{append}{logical to specify whether the data frame provided via the \code{data} argument should be returned together with the observed effect sizes or outcomes and corresponding sampling variances (the default is \code{TRUE}).} \item{replace}{logical to specify whether existing values for \code{yi} and \code{vi} in the data frame should be replaced. Only relevant when \code{append=TRUE} and the data frame already contains the \code{yi} and \code{vi} variables. If \code{replace=TRUE} (the default), all of the existing values will be overwritten. If \code{replace=FALSE}, only \code{NA} values will be replaced. See the \sQuote{Value} section for more details.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is 4. Note that the values are stored without rounding in the returned object. See also \link[=misc-options]{here} for further details on how to control the number of digits in the output.} \item{\dots}{other arguments.} } \details{ Before a meta-analysis can be conducted, the relevant results from each study must be quantified in such a way that the resulting values can be further aggregated and compared. Depending on (a) the goals of the meta-analysis, (b) the design and types of studies included, and (c) the information provided therein, one of the various effect sizes or outcome measures described below may be appropriate for the meta-analysis and can be computed with the \code{escalc} function. The \code{measure} argument is a character string to specify the outcome measure that should be calculated (see below for the various options), arguments \code{ai} through \code{ni} are then used to specify the information needed to calculate the various measures (depending on the chosen outcome measure, different arguments need to be specified), and \code{data} can be used to specify a data frame containing the variables given to the previous arguments. The \code{add}, \code{to}, and \code{drop00} arguments may be needed when dealing with frequency or count data that may need special handling when some of the frequencies or counts are equal to zero (see below for details). Finally, the \code{vtype} argument is used to specify how the sampling variances should be estimated (again, see below for details). To provide a structure to the various effect sizes or outcome measures that can be calculated with the \code{escalc} function, we can distinguish between measures that are used to: \tabular{lll}{ \ics \tab (1) \tab contrast two independent (either experimentally created or naturally occurring) groups, \cr \ics \tab (2) \tab describe the direction and strength of the association between two variables, \cr \ics \tab (3) \tab summarize some characteristic or attribute of individual groups, or \cr \ics \tab (4) \tab quantify change within a single group or the difference between two matched/paired samples.} Furthermore, where appropriate, we can further distinguish between measures that are applicable when the characteristic, response, or dependent variable assessed within the individual studies is: \tabular{lll}{ \ics \tab (a) \tab a quantitative variable (e.g., amount of depression as assessed by a rating scale), \cr \ics \tab (b) \tab a dichotomous (binary) variable (e.g., remission versus no remission), \cr \ics \tab (c) \tab a count of events per time unit (e.g., number of migraines per year), or \cr \ics \tab (d) \tab a mix of the types above.} Below, these number and letter codes are used (also in combination) to make it easier to quickly find a measure suitable for a particular meta-analysis (e.g., search for \code{(1b)} to find measures that describe the difference between two groups with respect to a dichotomous variable or \code{(2a)} for measures that quantify the association between two quantitative variables). \subsection{(1) Outcome Measures for Two-Group Comparisons}{ In many meta-analyses, the goal is to synthesize the results from studies that compare or contrast two groups. The groups may be experimentally defined (e.g., a treatment and a control group created via random assignment) or may occur naturally (e.g., men and women, employees working under high- versus low-stress conditions, people/animals/plants exposed to some environmental risk factor versus those not exposed). \subsection{(1a) Measures for Quantitative Variables}{ When the response or dependent variable assessed within the individual studies is measured on a quantitative scale, it is customary to report certain summary statistics, such as the mean and standard deviation of the observations within the two groups (in case medians, min/max values, and quartiles are reported, see \code{\link{conv.fivenum}} for a function that can be used to estimate means and standard deviations from such statistics). The data layout for a study comparing two groups with respect to such a variable is then of the form: \tabular{lcccccc}{ \tab \ics \tab mean \tab \ics \tab standard deviation \tab \ics \tab group size \cr group 1 \tab \ics \tab \code{m1i} \tab \ics \tab \code{sd1i} \tab \ics \tab \code{n1i} \cr group 2 \tab \ics \tab \code{m2i} \tab \ics \tab \code{sd2i} \tab \ics \tab \code{n2i}} where \code{m1i} and \code{m2i} are the observed means of the two groups, \code{sd1i} and \code{sd2i} are the observed standard deviations, and \code{n1i} and \code{n2i} denote the number of individuals in each group. The raw mean difference, the standardized mean difference, and the (log transformed) ratio of means (also called the log \sQuote{response ratio}) are useful outcome measures when meta-analyzing studies of this type. The options for the \code{measure} argument are then: \itemize{ \item \code{"MD"} for the \emph{raw mean difference} (e.g., Borenstein, 2009), \item \code{"SMD"} for the \emph{standardized mean difference} (Hedges, 1981), \item \code{"SMDH"} for the \emph{standardized mean difference} with heteroscedastic population variances in the two groups (Bonett, 2008, 2009), \item \code{"SMD1"} for the \emph{standardized mean difference} where the mean difference is divided by the standard deviation of the second group (and \code{"SMD1H"} for the same but with heteroscedastic population variances), \item \code{"ROM"} for the \emph{log transformed ratio of means} (Hedges et al., 1999; Lajeunesse, 2011). } The raw mean difference is simply \code{(m1i - m2i)}, while the standardized mean difference is computed with \code{(m1i - m2i) / sdpi}. For \code{measure="SMD"}, \code{sdpi = sqrt(((n1i-1)*sd1i^2 + (n2i-1)*sd2i^2) / (n1i+n2i-2))} is the pooled standard deviation of the two groups. For \code{measure="SMDH"}, \code{sdpi = sqrt((sd1i^2 + sd2i^2) / 2)} is the square root of the average variance. Finally, for \code{measure="SMD1"} and \code{measure="SMD1H"}, we simply use \code{sdpi = sd2i} (note: for \code{measure="SMD1"}, only \code{sd2i} needs to be specified and \code{sd1i} is ignored). For \code{measure="SMD"}, the positive bias in the standardized mean difference (i.e., in a Cohen's d value) is automatically corrected for within the function, yielding Hedges' g (Hedges, 1981). Similarly, the same bias correction is applied for \code{measure="SMDH"} (Bonett, 2009), \code{measure="SMD1"} (Hedges, 1981), and \code{measure="SMD1H"}. For \code{measure="ROM"}, the log is taken of the ratio of means (i.e., \code{log(m1i/m2i)}), which makes this outcome measure symmetric around 0 and results in a sampling distribution that is closer to normality. Hence, this measure cannot be computed when \code{m1i} and \code{m2i} have opposite signs (in fact, this measure is only meant to be used for ratio scale measurements, where both means should be positive anyway). For \code{measure="SMD"}, if the means and standard deviations are unknown for some studies, but the standardized mean differences (Cohen's d values) are directly available (e.g., if they are reported in those studies), then these can be specified via argument \code{di}. Also, if the t-statistics from an independent samples (Student's) t-test are available for some studies, one can specify those values via argument \code{ti}, which are then transformed into the corresponding standardized mean differences within the function (the sign of the t-statistics is then taken to be the sign of the standardized mean differences). If only the (two-sided) p-values corresponding to the t-tests are known, one can specify those values via argument \code{pi} (which are then transformed into the t-statistics and then further into the standardized mean differences). However, since a two-sided p-value does not carry information about the sign of the test statistic (and hence neither about the standardized mean difference), the sign of the p-values (which can be negative) is used as the sign of the standardized mean differences (e.g., \code{escalc(measure="SMD", pi=-0.018, n1i=20, n2i=20)} yields a negative standardized mean difference of \code{-0.7664}). See \href{https://www.metafor-project.org/doku.php/tips:assembling_data_smd}{here} for a more detailed illustration of using the \code{ti} and \code{pi} arguments. For \code{measure="MD"}, one can choose between \code{vtype="LS"} (the default) and \code{vtype="HO"}. The former computes the sampling variances without assuming homoscedasticity (i.e., that the true variances of the measurements are the same in group 1 and group 2 within each study), while the latter assumes homoscedasticity (equations 12.5 and 12.3 in Borenstein, 2009, respectively). For \code{measure="SMD"}, one can choose between \code{vtype="LS"} (the default) for the usual large-sample approximation to compute the sampling variances (equation 8 in Hedges, 1982), \code{vtype="UB"} to compute unbiased estimates of the sampling variances (equation 9 in Hedges, 1983), \code{vtype="LS2"} to compute the sampling variances as described in Borenstein (2009; equation 12.17), and \code{vtype="AV"} to compute the sampling variances with the usual large-sample approximation but plugging the sample-size weighted average of the Hedges' g values into the equation. The same choices also apply to \code{measure="SMD1"}. For \code{measure="ROM"}, one can choose between \code{vtype="LS"} (the default) for the usual large-sample approximation to compute the sampling variances (equation 1 in Hedges et al., 1999), \code{vtype="HO"} to compute the sampling variances assuming homoscedasticity (the unnumbered equation after equation 1 in Hedges et al., 1999), \code{vtype="AV"} to compute the sampling variances assuming homoscedasticity of the coefficient of variation within each group across studies, and \code{vtype="AVHO"} to compute the sampling variances assuming homoscedasticity of the coefficient of variation for both groups across studies (for why the latter two options are interesting, see Nakagawa et al., 2023). Datasets corresponding to data of this type are provided in \code{\link[metadat]{dat.normand1999}}, \code{\link[metadat]{dat.curtis1998}}, and \code{\link[metadat]{dat.gibson2002}}. Interest may also be focused on differences between the two groups with respect to their variability. Here, the (log transformed) ratio of the coefficient of variation of the two groups (also called the coefficient of variation ratio) can be a useful measure (Nakagawa et al., 2015). If focus is solely on the variability of the measurements within the two groups, then the (log transformed) ratio of the standard deviations (also called the variability ratio) can be used (Nakagawa et al., 2015). For the latter, one only needs to specify \code{sd1i}, \code{sd2i}, \code{n1i}, and \code{n2i}. The options for the \code{measure} argument are: \itemize{ \item \code{"CVR"} for the \emph{log transformed coefficient of variation ratio}, \item \code{"VR"} for the \emph{log transformed variability ratio}. } Measure \code{"CVR"} is computed with \code{log(sd1i/m1i)-log(sd2i/m2i)}, while \code{"VR"} is simply \code{log(sd1i/sd2i)}, but note that a slight bias correction is applied for both of these measures (Nakagawa et al., 2015). Also, the sampling variance for \code{measure="CVR"} is computed as given by equation 12 in Nakagawa et al. (2015), but without the \sQuote{\mjseqn{-2 \rho \ldots}} terms, since for normally distributed data (which we assume here) the mean and variance (and transformations thereof) are independent. } \subsection{(1b) Measures for Dichotomous Variables}{ In various fields of research (such as the health and medical sciences), the response variable measured within the individual studies is often dichotomous (binary), so that the data from a study comparing two different groups can be expressed in terms of a \mjeqn{2 \times 2}{2x2} table, such as: \tabular{lcccccc}{ \tab \ics \tab outcome 1 \tab \ics \tab outcome 2 \tab \ics \tab total \cr group 1 \tab \ics \tab \code{ai} \tab \ics \tab \code{bi} \tab \ics \tab \code{n1i} \cr group 2 \tab \ics \tab \code{ci} \tab \ics \tab \code{di} \tab \ics \tab \code{n2i}} where \code{ai}, \code{bi}, \code{ci}, and \code{di} denote the cell frequencies (i.e., the number of individuals falling into a particular category) and \code{n1i} and \code{n2i} are the row totals (i.e., the group sizes). For example, in a set of randomized clinical trials, group 1 and group 2 may refer to the treatment and placebo/control group, respectively, with outcome 1 denoting some event of interest (e.g., death, complications, failure to improve under the treatment) and outcome 2 its complement. Similarly, in a set of cohort studies, group 1 and group 2 may denote those who engage in and those who do not engage in a potentially harmful behavior (e.g., smoking), with outcome 1 denoting the development of a particular disease (e.g., lung cancer) during the follow-up period. Finally, in a set of case-control studies, group 1 and group 2 may refer to those with the disease (i.e., cases) and those free of the disease (i.e., controls), with outcome 1 denoting, for example, exposure to some environmental risk factor in the past and outcome 2 non-exposure. Note that in all of these examples, the stratified sampling scheme fixes the row totals (i.e., the group sizes) by design. A meta-analysis of studies reporting results in terms of \mjeqn{2 \times 2}{2x2} tables can be based on one of several different outcome measures, including the risk ratio (also called the relative risk), the odds ratio, the risk difference, and the arcsine square root transformed risk difference (e.g., Fleiss & Berlin, 2009, \enc{Rücker}{Ruecker} et al., 2009). For any of these outcome measures, one needs to specify the cell frequencies via the \code{ai}, \code{bi}, \code{ci}, and \code{di} arguments (or alternatively, one can use the \code{ai}, \code{ci}, \code{n1i}, and \code{n2i} arguments). The options for the \code{measure} argument are then: \itemize{ \item \code{"RR"} for the \emph{log risk ratio}, \item \code{"OR"} for the \emph{log odds ratio}, \item \code{"RD"} for the \emph{risk difference}, \item \code{"AS"} for the \emph{arcsine square root transformed risk difference} (\enc{Rücker}{Ruecker} et al., 2009), \item \code{"PETO"} for the \emph{log odds ratio} estimated with Peto's method (Yusuf et al., 1985). } Note that the log is taken of the risk ratio and the odds ratio, which makes these outcome measures symmetric around 0 and results in corresponding sampling distributions that are closer to normality. Also, when multiplied by 2, the arcsine square root transformed risk difference is actually identical to Cohen's h (Cohen, 1988). Cell entries with a zero count can be problematic, especially for the risk ratio and the odds ratio. Adding a small constant to the cells of the \mjeqn{2 \times 2}{2x2} tables is a common solution to this problem. When \code{to="only0"} (the default), the value of \code{add} (the default is \code{1/2}; but see \sQuote{Note}) is added to each cell of those \mjeqn{2 \times 2}{2x2} tables with at least one cell equal to 0. When \code{to="all"}, the value of \code{add} is added to each cell of all \mjeqn{2 \times 2}{2x2} tables. When \code{to="if0all"}, the value of \code{add} is added to each cell of all \mjeqn{2 \times 2}{2x2} tables, but only when there is at least one \mjeqn{2 \times 2}{2x2} table with a zero cell. Setting \code{to="none"} or \code{add=0} has the same effect: No adjustment to the observed table frequencies is made. Depending on the outcome measure and the data, this may lead to division by zero (when this occurs, the resulting value is recoded to \code{NA}). Also, studies where \code{ai=ci=0} or \code{bi=di=0} may be considered to be uninformative about the size of the effect and dropping such studies has sometimes been recommended (Higgins et al., 2019). This can be done by setting \code{drop00=TRUE}. The values for such studies will then be set to \code{NA} (i.e., missing). Datasets corresponding to data of this type are provided in \code{\link[metadat]{dat.bcg}}, \code{\link[metadat]{dat.collins1985a}}, \code{\link[metadat]{dat.collins1985b}}, \code{\link[metadat]{dat.egger2001}}, \code{\link[metadat]{dat.hine1989}}, \code{\link[metadat]{dat.laopaiboon2015}}, \code{\link[metadat]{dat.lee2004}}, \code{\link[metadat]{dat.li2007}}, \code{\link[metadat]{dat.linde2005}}, \code{\link[metadat]{dat.nielweise2007}}, and \code{\link[metadat]{dat.yusuf1985}}. If the \mjeqn{2 \times 2}{2x2} table is not available (or cannot be reconstructed, for example with the \code{\link{conv.2x2}} function) for a study, but the odds ratio and the corresponding confidence interval is reported, one can easily transform these values into the corresponding log odds ratio and sampling variance (and combine such a study with those that do report \mjeqn{2 \times 2}{2x2} table data). See \href{https://www.metafor-project.org/doku.php/tips:assembling_data_or}{here} for an illustration/discussion of this. } \subsection{(1c) Measures for Event Counts}{ In medical and epidemiological studies comparing two different groups (e.g., treated versus untreated patients, exposed versus unexposed individuals), results are sometimes reported in terms of event counts (i.e., the number of events, such as strokes or myocardial infarctions) over a certain period of time. Data of this type are also referred to as \sQuote{person-time data}. Assume that the studies report data in the form: \tabular{lcccc}{ \tab \ics \tab number of events \tab \ics \tab total person-time \cr group 1 \tab \ics \tab \code{x1i} \tab \ics \tab \code{t1i} \cr group 2 \tab \ics \tab \code{x2i} \tab \ics \tab \code{t2i}} where \code{x1i} and \code{x2i} denote the number of events in the first and the second group, respectively, and \code{t1i} and \code{t2i} the corresponding total person-times at risk. Often, the person-time is measured in years, so that \code{t1i} and \code{t2i} denote the total number of follow-up years in the two groups. This form of data is fundamentally different from what was described in the previous section, since the total follow-up time may differ even for groups of the same size and the individuals studied may experience the event of interest multiple times. Hence, different outcome measures than the ones described in the previous section need to be considered when data are reported in this format. These include the incidence rate ratio, the incidence rate difference, and the square root transformed incidence rate difference (Bagos & Nikolopoulos, 2009; Rothman et al., 2008). For any of these outcome measures, one needs to specify the total number of events via the \code{x1i} and \code{x2i} arguments and the corresponding total person-time values via the \code{t1i} and \code{t2i} arguments. The options for the \code{measure} argument are then: \itemize{ \item \code{"IRR"} for the \emph{log incidence rate ratio}, \item \code{"IRD"} for the \emph{incidence rate difference}, \item \code{"IRSD"} for the \emph{square root transformed incidence rate difference}. } Note that the log is taken of the incidence rate ratio, which makes this outcome measure symmetric around 0 and results in a sampling distribution that is closer to normality. Studies with zero events in one or both groups can be problematic, especially for the incidence rate ratio. Adding a small constant to the number of events is a common solution to this problem. When \code{to="only0"} (the default), the value of \code{add} (the default is \code{1/2}; but see \sQuote{Note}) is added to \code{x1i} and \code{x2i} only in the studies that have zero events in one or both groups. When \code{to="all"}, the value of \code{add} is added to \code{x1i} and \code{x2i} in all studies. When \code{to="if0all"}, the value of \code{add} is added to \code{x1i} and \code{x2i} in all studies, but only when there is at least one study with zero events in one or both groups. Setting \code{to="none"} or \code{add=0} has the same effect: No adjustment to the observed number of events is made. Depending on the outcome measure and the data, this may lead to division by zero (when this occurs, the resulting value is recoded to \code{NA}). Like for \mjeqn{2 \times 2}{2x2} table data, studies where \code{x1i=x2i=0} may be considered to be uninformative about the size of the effect and dropping such studies has sometimes been recommended. This can be done by setting \code{drop00=TRUE}. The values for such studies will then be set to \code{NA}. Datasets corresponding to data of this type are provided in \code{\link[metadat]{dat.hart1999}} and \code{\link[metadat]{dat.nielweise2008}}. } \subsection{(1d) Transforming SMDs to ORs and Vice-Versa}{ In some meta-analyses, one may encounter studies that contrast two groups with respect to a quantitative response variable (case 1a above) and other studies that contrast the same two groups with respect to a dichotomous variable (case 2b above). If both types of studies are to be combined in the same analysis, one needs to compute the same outcome measure across all studies. For this, one may need to transform standardized mean differences into log odds ratios (e.g., Cox & Snell, 1989; Chinn, 2000; Hasselblad & Hedges, 1995; \enc{Sánchez-Meca}{Sanchez-Meca} et al., 2003). Here, the data need to be specified as described under (1a) and the options for the \code{measure} argument are then: \itemize{ \item \code{"D2ORN"} for the \emph{transformed standardized mean difference} assuming normal distributions, \item \code{"D2ORL"} for the \emph{transformed standardized mean difference} assuming logistic distributions. } Both of these transformations provide an estimate of the log odds ratio, the first assuming that the responses within the two groups are normally distributed, while the second assumes that the responses follow logistic distributions. Alternatively, assuming that the dichotomous outcome in a \mjeqn{2 \times 2}{2x2} table is actually a dichotomized version of the responses on an underlying quantitative scale, it is also possible to estimate the standardized mean difference based on \mjeqn{2 \times 2}{2x2} table data, using either the probit transformed risk difference or a transformation of the odds ratio (e.g., Cox & Snell, 1989; Chinn, 2000; Hasselblad & Hedges, 1995; \enc{Sánchez-Meca}{Sanchez-Meca} et al., 2003). Here, the data need to be specified as described under (1b) and the options for the \code{measure} argument are then: \itemize{ \item \code{"PBIT"} for the \emph{probit transformed risk difference}, \item \code{"OR2DN"} for the \emph{transformed odds ratio} assuming normal distributions, \item \code{"OR2DL"} for the \emph{transformed odds ratio} assuming logistic distributions. } All of these transformations provide an estimate of the standardized mean difference, the first two assuming that the responses on the underlying quantitative scale are normally distributed, while the third assumes that the responses follow logistic distributions. A dataset illustrating the combined analysis of standardized mean differences and probit transformed risk differences is provided in \code{\link[metadat]{dat.gibson2002}}. } } \subsection{(2) Outcome Measures for Variable Association}{ Meta-analyses are often used to synthesize studies that examine the direction and strength of the association between two variables measured concurrently and/or without manipulation by experimenters. In this section, a variety of outcome measures will be discussed that may be suitable for a meta-analysis with this purpose. We can distinguish between measures that are applicable when both variables are measured on quantitative scales, when both variables measured are dichotomous, and when the two variables are of mixed types. \subsection{(2a) Measures for Two Quantitative Variables}{ The (Pearson or product-moment) correlation coefficient quantifies the direction and strength of the (linear) relationship between two quantitative variables and is therefore frequently used as the outcome measure for meta-analyses. Two alternative measures are a bias-corrected version of the correlation coefficient and Fisher's r-to-z transformed correlation coefficient. For these measures, one needs to specify \code{ri}, the vector with the raw correlation coefficients, and \code{ni}, the corresponding sample sizes. The options for the \code{measure} argument are then: \itemize{ \item \code{"COR"} for the \emph{raw correlation coefficient}, \item \code{"UCOR"} for the \emph{raw correlation coefficient} corrected for its slight negative bias (based on equation 2.3 in Olkin & Pratt, 1958), \item \code{"ZCOR"} for \emph{Fisher's r-to-z transformed correlation coefficient} (Fisher, 1921). } If the correlation coefficient is unknown for some studies, but the t-statistics \mjseqn{t_i = r_i \sqrt{n_i - 2} / \sqrt{1 - r_i^2}} are available for those studies (for the standard t-test of \mjeqn{\mbox{H}_0{:}\; \rho_i = 0}{H_0: \rho_i = 0}), one can specify those values via argument \code{ti}, which are then transformed into the corresponding correlation coefficients within the function (the sign of the t-statistics is then taken to be the sign of the correlations). If only the (two-sided) p-values corresponding to the t-tests are known, one can specify those values via argument \code{pi}. However, since a two-sided p-value does not carry information about the sign of the test statistic (and hence neither about the correlation), the sign of the p-values (which can be negative) is used as the sign of the correlation coefficients (e.g., \code{escalc(measure="COR", pi=-0.07, ni=30)} yields a negative correlation of \code{-0.3354}). For \code{measure="COR"} and \code{measure="UCOR"}, one can choose between \code{vtype="LS"} (the default) for the usual large-sample approximation to compute the sampling variances (i.e., plugging the (biased-corrected) correlation coefficients into equation 12.27 in Borenstein, 2009), \code{vtype="UB"} to compute unbiased estimates of the sampling variances (see Hedges, 1989, but using the exact equation instead of the approximation), and \code{vtype="AV"} to compute the sampling variances with the usual large-sample approximation but plugging the sample-size weighted average of the (bias-corrected) correlation coefficients into the equation. Datasets corresponding to data of this type are provided in \code{\link[metadat]{dat.mcdaniel1994}} and \code{\link[metadat]{dat.molloy2014}}. For meta-analyses involving multiple (dependent) correlation coefficients extracted from the same sample, see also the \code{\link{rcalc}} function. } \subsection{(2b) Measures for Two Dichotomous Variables}{ When the goal of a meta-analysis is to examine the relationship between two dichotomous variables, the data for each study can again be presented in the form of a \mjeqn{2 \times 2}{2x2} table, except that there may not be a clear distinction between the grouping variable and the outcome variable. Moreover, the table may be a result of cross-sectional (i.e., multinomial) sampling, where none of the table margins (except the total sample size) are fixed by the study design. In particular, assume that the data of interest for a particular study are of the form: \tabular{lcccccc}{ \tab \ics \tab variable 2, outcome + \tab \ics \tab variable 2, outcome - \tab \ics \tab total \cr variable 1, outcome + \tab \ics \tab \code{ai} \tab \ics \tab \code{bi} \tab \ics \tab \code{n1i} \cr variable 1, outcome - \tab \ics \tab \code{ci} \tab \ics \tab \code{di} \tab \ics \tab \code{n2i}} where \code{ai}, \code{bi}, \code{ci}, and \code{di} denote the cell frequencies (i.e., the number of individuals falling into a particular category) and \code{n1i} and \code{n2i} are the row totals. The phi coefficient and the odds ratio are commonly used measures of association for \mjeqn{2 \times 2}{2x2} table data (e.g., Fleiss & Berlin, 2009). The latter is particularly advantageous, as it is directly comparable to values obtained from stratified sampling (as described earlier). Yule's Q and Yule's Y (Yule, 1912) are additional measures of association for \mjeqn{2 \times 2}{2x2} table data (although they are not typically used in meta-analyses). Finally, assuming that the two dichotomous variables are actually dichotomized versions of the responses on two underlying quantitative scales (and assuming that the two variables follow a bivariate normal distribution), it is also possible to estimate the correlation between the two quantitative variables using the tetrachoric correlation coefficient (Pearson, 1900; Kirk, 1973). For any of these outcome measures, one needs to specify the cell frequencies via the \code{ai}, \code{bi}, \code{ci}, and \code{di} arguments (or alternatively, one can use the \code{ai}, \code{ci}, \code{n1i}, and \code{n2i} arguments). The options for the \code{measure} argument are then: \itemize{ \item \code{"OR"} for the \emph{log odds ratio}, \item \code{"PHI"} for the \emph{phi coefficient}, \item \code{"YUQ"} for \emph{Yule's Q} (Yule, 1912), \item \code{"YUY"} for \emph{Yule's Y} (Yule, 1912), \item \code{"RTET"} for the \emph{tetrachoric correlation coefficient}. } There are also measures \code{"ZPHI"} and \code{"ZTET"} for applying Fisher's r-to-z transformation to these measures. This may be useful when combining these with other types of correlation coefficients that were r-to-z transformed. However, note that the r-to-z transformation is \emph{not} a variance-stabilizing transformation for these measures. Tables with one or more zero counts are handled as described earlier. For \code{measure="PHI"}, one must indicate via \code{vtype="ST"} or \code{vtype="CS"} whether the data for the studies were obtained using stratified or cross-sectional (i.e., multinomial) sampling, respectively (it is also possible to specify an entire vector for the \code{vtype} argument in case the sampling scheme differed for the various studies). A dataset corresponding to data of this type is provided in \code{\link[metadat]{dat.bourassa1996}}. } \subsection{(2d) Measures for Mixed Variable Types}{ We can also consider outcome measures that can be used to describe the relationship between two variables, where one variable is dichotomous and the other variable measures some quantitative characteristic. In that case, it is likely that study authors again report summary statistics, such as the mean and standard deviation of the measurements within the two groups (defined by the dichotomous variable). Based on this information, one can compute the point-biserial correlation coefficient (Tate, 1954) as a measure of association between the two variables. If the dichotomous variable is actually a dichotomized version of the responses on an underlying quantitative scale (and assuming that the two variables follow a bivariate normal distribution), it is also possible to estimate the correlation between the two variables using the biserial correlation coefficient (Pearson, 1909; Soper, 1914; Jacobs & Viechtbauer, 2017). Here, one again needs to specify \code{m1i} and \code{m2i} for the observed means of the two groups, \code{sd1i} and \code{sd2i} for the observed standard deviations, and \code{n1i} and \code{n2i} for the number of individuals in each group. The options for the \code{measure} argument are then: \itemize{ \item \code{"RPB"} for the \emph{point-biserial correlation coefficient}, \item \code{"RBIS"} for the \emph{biserial correlation coefficient}. } There are also measures \code{"ZPB"} and \code{"ZBIS"} for applying Fisher's r-to-z transformation to these measures. This may be useful when combining these with other types of correlation coefficients that were r-to-z transformed. However, note that the r-to-z transformation is \emph{not} a variance-stabilizing transformation for these measures. If the means and standard deviations are unknown for some studies, one can also use argument \code{di}, \code{ti}, or \code{pi} to specify standardized mean differences (Cohen's d values), t-statistics from an independent samples t-test, or (signed) p-values for the t-test, respectively, as described earlier under (1a) (together with the group sizes, these are sufficient statistics for computing the (point-)biserial correlation coefficients). For \code{measure="RPB"}, one must indicate via \code{vtype="ST"} or \code{vtype="CS"} whether the data for the studies were obtained using stratified or cross-sectional (i.e., multinomial) sampling, respectively (it is also possible to specify an entire vector for the \code{vtype} argument in case the sampling scheme differed for the various studies). } } \subsection{(3) Outcome Measures for Individual Groups}{ In this section, outcome measures will be described which may be useful when the goal of a meta-analysis is to synthesize studies that characterize some property of individual groups. We will again distinguish between measures that are applicable when the characteristic assessed is a quantitative variable, a dichotomous variable, or when the characteristic represents an event count. \subsection{(3a) Measures for Quantitative Variables}{ The goal of a meta-analysis may be to characterize individual groups, where the response, characteristic, or dependent variable assessed in the individual studies is measured on some quantitative scale. In the simplest case, the raw mean for the quantitative variable is reported for each group, which then becomes the observed outcome for the meta-analysis. Here, one needs to specify \code{mi}, \code{sdi}, and \code{ni} for the observed means, the observed standard deviations, and the sample sizes, respectively. For ratio scale measurements, the log transformed mean or the log transformed coefficient of variation (with bias correction) may also be of interest (Nakagawa et al., 2015). If focus is solely on the variability of the measurements, then the log transformed standard deviation (with bias correction) is a useful measure (Nakagawa et al., 2015; Raudenbush & Bryk, 1987). Here, one only needs to specify \code{sdi} and \code{ni}. The options for the \code{measure} argument are: \itemize{ \item \code{"MN"} for the \emph{raw mean}, \item \code{"MNLN"} for the \emph{log transformed mean}, \item \code{"CVLN"} for the \emph{log transformed coefficient of variation}, \item \code{"SDLN"} for the \emph{log transformed standard deviation}. } Note that \code{sdi} is used to specify the standard deviations of the observed values of the response, characteristic, or dependent variable and not the standard errors of the means. Also, the sampling variance for \code{measure="CVLN"} is computed as given by equation 27 in Nakagawa et al. (2015), but without the \sQuote{\mjseqn{-2 \rho \ldots}} term, since for normally distributed data (which we assume here) the mean and variance (and transformations thereof) are independent. } \subsection{(3b) Measures for Dichotomous Variables}{ A meta-analysis may also be conducted to aggregate studies that provide data about individual groups with respect to a dichotomous dependent variable. Here, one needs to specify \code{xi} and \code{ni}, denoting the number of individuals experiencing the event of interest and the total number of individuals within each study, respectively. Instead of specifying \code{ni}, one can use \code{mi} to specify the number of individuals that do not experience the event of interest (i.e., \code{mi=ni-xi}). The options for the \code{measure} argument are then: \itemize{ \item \code{"PR"} for the \emph{raw proportion}, \item \code{"PLN"} for the \emph{log transformed proportion}, \item \code{"PLO"} for the \emph{logit transformed proportion} (i.e., log odds), \item \code{"PAS"} for the \emph{arcsine square root transformed proportion} (i.e., the angular transformation), \item \code{"PFT"} for the \emph{Freeman-Tukey double arcsine transformed proportion} (Freeman & Tukey, 1950). } Zero cell entries can be problematic for certain outcome measures. When \code{to="only0"} (the default), the value of \code{add} (the default is \code{1/2}; but see \sQuote{Note}) is added to \code{xi} and \code{mi} only for studies where \code{xi} or \code{mi} is equal to 0. When \code{to="all"}, the value of \code{add} is added to \code{xi} and \code{mi} in all studies. When \code{to="if0all"}, the value of \code{add} is added in all studies, but only when there is at least one study with a zero value for \code{xi} or \code{mi}. Setting \code{to="none"} or \code{add=0} has the same effect: No adjustment to the observed values is made. Depending on the outcome measure and the data, this may lead to division by zero (when this occurs, the resulting value is recoded to \code{NA}). Datasets corresponding to data of this type are provided in \code{\link[metadat]{dat.pritz1997}} and \code{\link[metadat]{dat.debruin2009}}. } \subsection{(3c) Measures for Event Counts}{ Various measures can be used to characterize individual groups when the dependent variable assessed is an event count. Here, one needs to specify \code{xi} and \code{ti}, denoting the number of events that occurred and the total person-times at risk, respectively. The options for the \code{measure} argument are then: \itemize{ \item \code{"IR"} for the \emph{raw incidence rate}, \item \code{"IRLN"} for the \emph{log transformed incidence rate}, \item \code{"IRS"} for the \emph{square root transformed incidence rate}, \item \code{"IRFT"} for the \emph{Freeman-Tukey transformed incidence rate} (Freeman & Tukey, 1950). } Measures \code{"IR"} and \code{"IRLN"} can also be used when meta-analyzing standardized incidence ratios (SIRs), where the observed number of events is divided by the expected number of events. In this case, arguments \code{xi} and \code{ti} are used to specify the observed and expected number of events in the studies. Since SIRs are not symmetric around 1, it is usually more appropriate to meta-analyze the log transformed SIRs (i.e., using measure \code{"IRLN"}), which are symmetric around 0. Studies with zero events can be problematic, especially for the log transformed incidence rate. Adding a small constant to the number of events is a common solution to this problem. When \code{to="only0"} (the default), the value of \code{add} (the default is \code{1/2}; but see \sQuote{Note}) is added to \code{xi} only in the studies that have zero events. When \code{to="all"}, the value of \code{add} is added to \code{xi} in all studies. When \code{to="if0all"}, the value of \code{add} is added to \code{xi} in all studies, but only when there is at least one study with zero events. Setting \code{to="none"} or \code{add=0} has the same effect: No adjustment to the observed number of events is made. Depending on the outcome measure and the data, this may lead to division by zero (when this occurs, the resulting value is recoded to \code{NA}). } } \subsection{(4) Outcome Measures for Change or Matched Pairs}{ The purpose of a meta-analysis may be to assess the amount of change within individual groups (e.g., before and after a treatment or under two different treatments) or when dealing with matched pairs designs. \subsection{(4a) Measures for Quantitative Variables}{ When the response or dependent variable assessed in the individual studies is measured on some quantitative scale, the raw mean change, standardized versions thereof, or the (log transformed) ratio of means (log response ratio) can be used as outcome measures (Becker, 1988; Gibbons et al., 1993; Lajeunesse, 2011; Morris, 2000). Here, one needs to specify \code{m1i} and \code{m2i}, the observed means at the two measurement occasions, \code{sd1i} and \code{sd2i} for the corresponding observed standard deviations, \code{ri} for the correlation between the measurements at the two measurement occasions, and \code{ni} for the sample size. The options for the \code{measure} argument are then: \itemize{ \item \code{"MC"} for the \emph{raw mean change}, \item \code{"SMCC"} for the \emph{standardized mean change} using change score standardization (Gibbons et al., 1993), \item \code{"SMCR"} for the \emph{standardized mean change} using raw score standardization (Becker, 1988), \item \code{"SMCRH"} for the \emph{standardized mean change} using raw score standardization with heteroscedastic population variances at the two measurement occasions (Bonett, 2008), \item \code{"ROMC"} for the \emph{log transformed ratio of means} (Lajeunesse, 2011). } Note that \code{"MC"} is simply \code{m1i-m2i} and \code{"SMCC"}, \code{"SMCR"}, and \code{"SMCRH"} are standardized versions thereof (e.g., \code{"SMCR"} is computed as \code{(m1i-m2i)/sd1i}). See also Morris and DeShon (2002) for a thorough discussion of the difference between the \code{"SMCC"} and \code{"SMCR"} change score measures. All of these measures are also applicable for matched pairs designs (subscripts 1 and 2 then simply denote the first and second group that are formed by the matching). In practice, one often has a mix of information available from the individual studies to compute these measures. In particular, if \code{m1i} and \code{m2i} are unknown, but the raw mean change is directly reported in a particular study, then one can set \code{m1i} to that value and \code{m2i} to 0 (making sure that the raw mean change was computed as \code{m1i-m2i} within that study and not the other way around). Also, for measures \code{"MC"} and \code{"SMCC"}, if \code{sd1i}, \code{sd2i}, and \code{ri} are unknown, but the standard deviation of the change scores is directly reported, then one can set \code{sd1i} to that value and both \code{sd2i} and \code{ri} to 0. For measure \code{"SMCR"}, argument \code{sd2i} is actually not needed, as the standardization is only based on \code{sd1i} (Becker, 1988; Morris, 2000), which is usually the pre-test standard deviation (if the post-test standard deviation should be used, then set \code{sd1i} to that). Finally, for \code{measure="SMCC"}, one can also directly specify standardized mean change values via argument \code{di} or the t-statistics from a paired samples t-test or the corresponding (two-sided) p-values via argument \code{ti} or \code{pi}, respectively (which are then transformed into the corresponding standardized mean change values within the function). The sign of the p-values (which can be negative) is used as the sign of the standardized mean change values (e.g., \code{escalc(measure="SMCC", pi=-0.018, ni=50)} yields a negative standardized mean change value of \code{-0.3408}). Finally, interest may also be focused on differences in the variability of the measurements at the two measurement occasions (or between the two matched groups). Here, the (log transformed) ratio of the coefficient of variation (also called the coefficient of variation ratio) can be a useful measure (Nakagawa et al., 2015). If focus is solely on the variability of the measurements, then the (log transformed) ratio of the standard deviations (also called the variability ratio) can be used (Nakagawa et al., 2015). For the latter, one only needs to specify \code{sd1i}, \code{sd2i}, \code{ni}, and \code{ri}. The options for the \code{measure} argument are: \itemize{ \item \code{"CVRC"} for the \emph{log transformed coefficient of variation ratio}, \item \code{"VRC"} for the \emph{log transformed variability ratio}. } The definitions of these measures are the same as given in Nakagawa et al. (2015) but are here computed for two sets of dependent measurements. Hence, the computation of the sampling variances are adjusted to take the correlation between the measurements into consideration. } \subsection{(4b) Measures for Dichotomous Variables}{ The data for a study examining change in a dichotomous variable gives rise to a paired \mjeqn{2 \times 2}{2x2} table, which is of the form: \tabular{lcccc}{ \ics \tab \tab trt 2 outcome 1 \tab \ics \tab trt 2 outcome 2 \cr trt 1 outcome 1 \ics \tab \tab \code{ai} \tab \ics \tab \code{bi} \cr trt 1 outcome 2 \ics \tab \tab \code{ci} \tab \ics \tab \code{di}} where \code{ai}, \code{bi}, \code{ci}, and \code{di} denote the cell frequencies. Note that \sQuote{trt1} and \sQuote{trt2} may be applied to a single group of subjects or to matched pairs of subjects. Also, \sQuote{trt1} and \sQuote{trt2} might refer to two different time points (e.g., before and after a treatment). In any case, the data from such a study can be rearranged into a marginal table of the form: \tabular{lcccc}{ \tab \ics \tab outcome 1 \tab \ics \tab outcome 2 \cr trt 1 \tab \ics \tab \code{ai+bi} \tab \ics \tab \code{ci+di} \cr trt 2 \tab \ics \tab \code{ai+ci} \tab \ics \tab \code{bi+di}} which is of the same form as a \mjeqn{2 \times 2}{2x2} table that would arise in a study comparing/contrasting two independent groups. The options for the \code{measure} argument that will compute outcome measures based on the marginal table are: \itemize{ \item \code{"MPRR"} for the matched pairs \emph{marginal log risk ratio}, \item \code{"MPOR"} for the matched pairs \emph{marginal log odds ratio}, \item \code{"MPRD"} for the matched pairs \emph{marginal risk difference}. } See Becker and Balagtas (1993), Curtin et al. (2002), Elbourne et al. (2002), Fagerland et al. (2014), May and Johnson (1997), Newcombe (1998), Stedman et al. (2011), and Zou (2007) for discussions of these measures. The options for the \code{measure} argument that will compute outcome measures based on the paired table are: \itemize{ \item \code{"MPORC"} for the \emph{conditional log odds ratio}, \item \code{"MPPETO"} for the \emph{conditional log odds ratio} estimated with Peto's method. } See Curtin et al. (2002) and Zou (2007) for discussions of these measures. If only marginal tables are available, then another possibility is to compute the marginal log odds ratios based on these table directly. However, for the correct computation of the sampling variances, the correlations (phi coefficients) from the paired tables must be known (or \sQuote{guestimated}). To use this approach, set \code{measure="MPORM"} and use argument \code{ri} to specify the correlation coefficients. Instead of specifying \code{ri}, one can use argument \code{pi} to specify the proportions (or \sQuote{guestimates} thereof) of individuals (or pairs) that experienced the outcome of interest (i.e., \sQuote{outcome1} in the paired \mjeqn{2 \times 2}{2x2} table) under both treatments (i.e., \code{ai / (ai + bi + ci + di)}). Based on these proportions, the correlation coefficients are then back-calculated and used to calculate the correct sampling variances. Note that the values in the marginal tables put constraints on the possible values for \code{ri} and \code{pi}. If a specified value for \code{ri} or \code{pi} is not feasible under a given table, the corresponding sampling variance will be \code{NA}. } } \subsection{(5) Other Outcome Measures for Meta-Analyses}{ Other outcome measures are sometimes used for meta-analyses that do not directly fall into the categories above. These are described in this section. \subsection{Cronbach's alpha and Transformations Thereof}{ Meta-analytic methods can also be used to aggregate Cronbach's alpha values from multiple studies. This is usually referred to as a \sQuote{reliability generalization meta-analysis} (Vacha-Haase, 1998). Here, one needs to specify \code{ai}, \code{mi}, and \code{ni} for the observed alpha values, the number of items/replications/parts of the measurement instrument, and the sample sizes, respectively. One can either directly analyze the raw Cronbach's alpha values or transformations thereof (Bonett, 2002, 2010; Hakstian & Whalen, 1976). The options for the \code{measure} argument are then: \itemize{ \item \code{"ARAW"} for \emph{raw alpha} values, \item \code{"AHW"} for \emph{transformed alpha values} (Hakstian & Whalen, 1976), \item \code{"ABT"} for \emph{transformed alpha values} (Bonett, 2002). } Note that the transformations implemented here are slightly different from the ones described by Hakstian and Whalen (1976) and Bonett (2002). In particular, for \code{"AHW"}, the transformation \mjeqn{1-(1-\alpha_i)^{1/3}}{1-(1-\alpha_i)^(1/3)} is used, while for \code{"ABT"}, the transformation \mjeqn{-\ln(1-\alpha_i)}{-ln(1-\alpha_i)} is used. This ensures that the transformed values are monotonically increasing functions of \mjseqn{\alpha_i}. A dataset corresponding to data of this type is provided in \code{\link[metadat]{dat.bonett2010}}. } \subsection{Partial and Semi-Partial Correlations}{ Aloe and Becker (2012), Aloe and Thompson (2013), and Aloe (2014) describe the use of partial and semi-partial correlation coefficients for meta-analyzing the results from regression models (when the focus is on a common regression coefficient of interest across studies). To compute these measures, one needs to specify \code{ti} for the test statistics (i.e., t-tests) of the \sQuote{focal} regression coefficient of interest, \code{ni} for the sample sizes of the studies, \code{mi} for the total number of predictors in the regression models (counting the focal predictor of interest), and \code{r2i} for the \mjseqn{R^2} values of the regression models (the latter is only needed when \code{measure="SPCOR"} or \code{measure="ZSPCOR"}). The options for the \code{measure} argument are then: \itemize{ \item \code{"PCOR"} for the \emph{partial correlation coefficient}, \item \code{"ZPCOR"} for \emph{Fisher's r-to-z transformed partial correlation coefficient}, \item \code{"SPCOR"} for the \emph{semi-partial correlation coefficient}, \item \code{"ZSPCOR"} for \emph{Fisher's r-to-z transformed semi-partial correlation coefficient}. } Note that the signs of the (semi-)partial correlation coefficients is determined based on the signs of the values specified via the \code{ti} argument. Also, while the Fisher transformation can be applied to both measures, it is only a variance-stabilizing transformation for partial correlation coefficients. If the test statistic (i.e., t-test) of the regression coefficient of interest is unknown for some studies, but the (two-sided) p-values corresponding to the t-tests are known, one can specify those values via argument \code{pi}. However, since a two-sided p-value does not carry information about the sign of the test statistic (and hence neither about the correlation), the sign of the p-values (which can be negative) is used as the sign of the correlation coefficients (e.g., \code{escalc(measure="PCOR", pi=-0.07, mi=5, ni=30)} yields a negative partial correlation of \code{-0.3610}). In the rare case that the (semi-)partial correlations are known for some of the studies, then these can be directly specified via the \code{ri} argument. This can be useful, for example, when \mjseqn{\eta^2_p} (i.e., partial eta squared) is known for the regression coefficient of interest, since the square root thereof is identical to the absolute value of the partial correlation (although the correct sign then still needs to be reconstructed based on other information). A dataset corresponding to data of this type is provided in \code{\link[metadat]{dat.aloe2013}}. } \subsection{Coefficients of Determination}{ One can in principle also meta-analyze coefficients of determination (i.e., \mjseqn{R^2} values / R-squared values) obtained from a series of linear regression models (however, see the caveats mentioned below). For this, one needs to specify \code{r2i} for the \mjseqn{R^2} values of the regression models, \code{ni} for the sample sizes of the studies, and \code{mi} for the number of predictors in the regression models. The options for the \code{measure} argument are then: \itemize{ \item \code{"R2"} for the \emph{raw coefficient of determination}, \item \code{"ZR2"} for the \emph{r-to-z transformed coefficient of determination}. } If the \mjseqn{R^2} values are unknown for some studies, but the F-statistics (for the omnibus test of the regression coefficients) are available, one can specify those values via argument \code{fi}, which are then transformed into the corresponding \mjseqn{R^2} values within the function. If only the p-values corresponding to the F-tests are known, one can specify those values via argument \code{pi} (which are then transformed into the F-statistics and then further into the \mjseqn{R^2} values). For \code{measure="R2"}, one can choose to compute the sampling variances with \code{vtype="LS"} (the default) for the large-sample approximation given by equation 27.88 in Kendall and Stuart (1979), \code{vtype="LS2"} for the large-sample approximation given by equation 27.87, or \code{vtype="AV"} and \code{vtype="AV2"} which use the same approximations but plugging the sample-size weighted average of the \mjseqn{R^2} values into the equations. For \code{measure="ZR2"}, the variance-stabilizing transformation \mjeqn{z_i = \frac{1}{2} \log \left[\frac{1+\sqrt{R_i^2}}{1-\sqrt{R_i^2}}\right]}{z_i = 1/2 log[(1+\sqrt(R_i^2))/(1-\sqrt(R_i^2))]} is used (see Olkin & Finn, 1995, but with the additional \mjseqn{\frac{1}{2}} factor), which uses \mjseqn{1/n_i} as the large-sample approximation to the sampling variances. The equations used for these measures were derived under the assumption that the values of the outcome variable and the predictors were sampled from a multivariate normal distribution within each study and that the sample sizes of the studies are large. Moreover, the equations assume that the true \mjseqn{R^2} values are all non-zero. Similarly, given that observed \mjseqn{R^2} values cannot be negative, there is no possibility for values to cancel each other out and hence it is guaranteed that the pooled estimate is positive. Hence, a meta-analysis of \mjseqn{R^2} values cannot be used to test if the pooled estimate is significantly different from zero (it is by construction as long as the number of studies is sufficiently large). } \subsection{Relative Excess Heterozygosity}{ Ziegler et al. (2011) describe the use of meta-analytic methods to examine deviations from the Hardy-Weinberg equilibrium across multiple studies. The relative excess heterozygosity (REH) is the proposed measure for such a meta-analysis, which can be computed by setting \code{measure="REH"}. Here, one needs to specify \code{ai} for the number of individuals with homozygous dominant alleles, \code{bi} for the number of individuals with heterozygous alleles, and \code{ci} for the number of individuals with homozygous recessives alleles. Note that the log is taken of the REH values, which makes this outcome measure symmetric around 0 and results in a sampling distribution that is closer to normality. A dataset corresponding to data of this type is provided in \code{\link[metadat]{dat.frank2008}}. } } \subsection{(6) Converting a Data Frame to an 'escalc' Object}{ The function can also be used to convert a regular data frame to an \sQuote{escalc} object. One simply sets the \code{measure} argument to one of the options described above (or to \code{measure="GEN"} for a generic outcome measure not further specified) and passes the observed effect sizes or outcomes via the \code{yi} argument and the corresponding sampling variances via the \code{vi} argument (or the standard errors via the \code{sei} argument) to the function. } } \value{ An object of class \code{c("escalc","data.frame")}. The object is a data frame containing the following components: \item{yi}{vector with the observed effect sizes or outcomes.} \item{vi}{vector with the corresponding sampling variances.} If a data frame was specified via the \code{data} argument and \code{append=TRUE}, then variables \code{yi} and \code{vi} are appended to this data frame. Note that the \code{var.names} argument actually specifies the names of these two variables (\code{"yi"} and \code{"vi"} are the defaults). If the data frame already contains two variables with names as specified by the \code{var.names} argument, the values for these two variables will be overwritten when \code{replace=TRUE} (which is the default). By setting \code{replace=FALSE}, only values that are \code{NA} will be replaced. The \code{subset} argument can be used to select the studies that will be included in the data frame returned by the function. On the other hand, the \code{include} argument simply selects for which studies the measure will be computed (if it shouldn't be computed for all of them). The object is formatted and printed with the \code{\link[=print.escalc]{print}} function. The \code{\link[=summary.escalc]{summary}} function can be used to obtain confidence intervals for the individual outcomes. See \code{\link{methods.escalc}} for some additional method functions for \code{"escalc"} objects. With the \code{\link[=aggregate.escalc]{aggregate}} function, one can aggregate multiple effect sizes or outcomes belonging to the same study (or some other clustering variable) into a single combined effect size or outcome. } \note{ The variable names specified under \code{var.names} should be syntactically valid variable names. If necessary, they are adjusted so that they are. Although the default value for \code{add} is \code{1/2}, for certain measures the use of such a bias correction makes little sense and for these measures, the function internally sets \code{add=0}. This applies to the following measures: \code{"AS"}, \code{"PHI"}, \code{"ZPHI"}, \code{"RTET"}, \code{"ZTET"}, \code{"IRSD"}, \code{"PAS"}, \code{"PFT"}, \code{"IRS"}, and \code{"IRFT"}. One can still force the use of the bias correction by explicitly setting the \code{add} argument to some non-zero value when calling the function. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Aloe, A. M. (2014). An empirical investigation of partial effect sizes in meta-analysis of correlational data. \emph{Journal of General Psychology}, \bold{141}(1), 47--64. \verb{https://doi.org/10.1080/00221309.2013.853021} Aloe, A. M., & Becker, B. J. (2012). An effect size for regression predictors in meta-analysis. \emph{Journal of Educational and Behavioral Statistics}, \bold{37}(2), 278--297. \verb{https://doi.org/10.3102/1076998610396901} Aloe, A. M., & Thompson, C. G. (2013). The synthesis of partial effect sizes. \emph{Journal of the Society for Social Work and Research}, \bold{4}(4), 390--405. \verb{https://doi.org/10.5243/jsswr.2013.24} Bagos, P. G., & Nikolopoulos, G. K. (2009). Mixed-effects Poisson regression models for meta-analysis of follow-up studies with constant or varying durations. \emph{The International Journal of Biostatistics}, \bold{5}(1). \verb{https://doi.org/10.2202/1557-4679.1168} Becker, B. J. (1988). Synthesizing standardized mean-change measures. \emph{British Journal of Mathematical and Statistical Psychology}, \bold{41}(2), 257--278. \verb{https://doi.org/10.1111/j.2044-8317.1988.tb00901.x} Becker, M. P., & Balagtas, C. C. (1993). Marginal modeling of binary cross-over data. \emph{Biometrics}, \bold{49}(4), 997--1009. \verb{https://doi.org/10.2307/2532242} Bonett, D. G. (2002). Sample size requirements for testing and estimating coefficient alpha. \emph{Journal of Educational and Behavioral Statistics}, \bold{27}(4), 335--340. \verb{https://doi.org/10.3102/10769986027004335} Bonett, D. G. (2008). Confidence intervals for standardized linear contrasts of means. \emph{Psychological Methods}, \bold{13}(2), 99--109. \verb{https://doi.org/10.1037/1082-989X.13.2.99} Bonett, D. G. (2009). Meta-analytic interval estimation for standardized and unstandardized mean differences. \emph{Psychological Methods}, \bold{14}(3), 225--238. \verb{https://doi.org/10.1037/a0016619} Bonett, D. G. (2010). Varying coefficient meta-analytic methods for alpha reliability. \emph{Psychological Methods}, \bold{15}(4), 368--385. \verb{https://doi.org/10.1037/a0020142} Borenstein, M. (2009). Effect sizes for continuous data. In H. Cooper, L. V. Hedges, & J. C. Valentine (Eds.), \emph{The handbook of research synthesis and meta-analysis} (2nd ed., pp. 221--235). New York: Russell Sage Foundation. Chinn, S. (2000). A simple method for converting an odds ratio to effect size for use in meta-analysis. \emph{Statistics in Medicine}, \bold{19}(22), 3127--3131. \verb{https://doi.org/10.1002/1097-0258(20001130)19:22<3127::aid-sim784>3.0.co;2-m} Cohen, J. (1988). \emph{Statistical power analysis for the behavioral sciences} (2nd ed.). Hillsdale, NJ: Lawrence Erlbaum Associates. Cox, D. R., & Snell, E. J. (1989). \emph{Analysis of binary data} (2nd ed.). London: Chapman & Hall. Curtin, F., Elbourne, D., & Altman, D. G. (2002). Meta-analysis combining parallel and cross-over clinical trials. II: Binary outcomes. \emph{Statistics in Medicine}, \bold{21}(15), 2145--2159. \verb{https://doi.org/10.1002/sim.1206} Elbourne, D. R., Altman, D. G., Higgins, J. P. T., Curtin, F., Worthington, H. V., & Vail, A. (2002). Meta-analyses involving cross-over trials: Methodological issues. \emph{International Journal of Epidemiology}, \bold{31}(1), 140--149. \verb{https://doi.org/10.1093/ije/31.1.140} Fagerland, M. W., Lydersen, S., & Laake, P. (2014). Recommended tests and confidence intervals for paired binomial proportions. \emph{Statistics in Medicine}, \bold{33}(16), 2850--2875. \verb{https://doi.org/10.1002/sim.6148} Fisher, R. A. (1921). On the \dQuote{probable error} of a coefficient of correlation deduced from a small sample. \emph{Metron}, \bold{1}, 1--32. \verb{http://hdl.handle.net/2440/15169} Fleiss, J. L., & Berlin, J. (2009). Effect sizes for dichotomous data. In H. Cooper, L. V. Hedges, & J. C. Valentine (Eds.), \emph{The handbook of research synthesis and meta-analysis} (2nd ed., pp. 237--253). New York: Russell Sage Foundation. Freeman, M. F., & Tukey, J. W. (1950). Transformations related to the angular and the square root. \emph{Annals of Mathematical Statistics}, \bold{21}(4), 607--611. \verb{https://doi.org/10.1214/aoms/1177729756} Gibbons, R. D., Hedeker, D. R., & Davis, J. M. (1993). Estimation of effect size from a series of experiments involving paired comparisons. \emph{Journal of Educational Statistics}, \bold{18}(3), 271--279. \verb{https://doi.org/10.3102/10769986018003271} Hakstian, A. R., & Whalen, T. E. (1976). A k-sample significance test for independent alpha coefficients. \emph{Psychometrika}, \bold{41}(2), 219--231. \verb{https://doi.org/10.1007/BF02291840} Hasselblad, V., & Hedges, L. V. (1995). Meta-analysis of screening and diagnostic tests. Psychological Bulletin, 117(1), 167-178. \verb{https://doi.org/10.1037/0033-2909.117.1.167} Hedges, L. V. (1981). Distribution theory for Glass's estimator of effect size and related estimators. \emph{Journal of Educational Statistics}, \bold{6}(2), 107--128. \verb{https://doi.org/10.3102/10769986006002107} Hedges, L. V. (1982). Estimation of effect size from a series of independent experiments. \emph{Psychological Bulletin}, \bold{92}(2), 490--499. \verb{https://doi.org/10.1037/0033-2909.92.2.490} Hedges, L. V. (1983). A random effects model for effect sizes. \emph{Psychological Bulletin}, \bold{93}(2), 388--395. \verb{https://doi.org/10.1037/0033-2909.93.2.388} Hedges, L. V. (1989). An unbiased correction for sampling error in validity generalization studies. \emph{Journal of Applied Psychology}, \bold{74}(3), 469--477. \verb{https://doi.org/10.1037/0021-9010.74.3.469} Hedges, L. V., Gurevitch, J., & Curtis, P. S. (1999). The meta-analysis of response ratios in experimental ecology. \emph{Ecology}, \bold{80}(4), 1150--1156. \verb{https://doi.org/10.1890/0012-9658(1999)080[1150:TMAORR]2.0.CO;2} Higgins, J. P. T., Thomas, J., Chandler, J., Cumpston, M., Li, T., Page, M. J., & Welch, V. A. (Eds.) (2019). \emph{Cochrane handbook for systematic reviews of interventions} (2nd ed.). Chichester, UK: Wiley. \verb{https://training.cochrane.org/handbook} Jacobs, P., & Viechtbauer, W. (2017). Estimation of the biserial correlation and its sampling variance for use in meta-analysis. \emph{Research Synthesis Methods}, \bold{8}(2), 161--180. \verb{https://doi.org/10.1002/jrsm.1218} Kendall, M., & Stuart, A. (1979). \emph{Kendall's advanced theory of statistics, Vol. 2: Inference and relationship} (4th ed.). New York: Macmillan. Kirk, D. B. (1973). On the numerical approximation of the bivariate normal (tetrachoric) correlation coefficient. \emph{Psychometrika}, \bold{38}(2), 259--268. \verb{https://doi.org/10.1007/BF02291118} Lajeunesse, M. J. (2011). On the meta-analysis of response ratios for studies with correlated and multi-group designs. \emph{Ecology}, \bold{92}(11), 2049--2055. \verb{https://doi.org/10.1890/11-0423.1} May, W. L., & Johnson, W. D. (1997). Confidence intervals for differences in correlated binary proportions. \emph{Statistics in Medicine}, \bold{16}(18), 2127--2136. \verb{https://doi.org/10.1002/(SICI)1097-0258(19970930)16:18<2127::AID-SIM633>3.0.CO;2-W} Morris, S. B. (2000). Distribution of the standardized mean change effect size for meta-analysis on repeated measures. \emph{British Journal of Mathematical and Statistical Psychology}, \bold{53}(1), 17--29. \verb{https://doi.org/10.1348/000711000159150} Morris, S. B., & DeShon, R. P. (2002). Combining effect size estimates in meta-analysis with repeated measures and independent-groups designs. \emph{Psychological Methods}, \bold{7}(1), 105--125. \verb{https://doi.org/10.1037/1082-989x.7.1.105} Nakagawa, S., Poulin, R., Mengersen, K., Reinhold, K., Engqvist, L., Lagisz, M., & Senior, A. M. (2015). Meta-analysis of variation: Ecological and evolutionary applications and beyond. \emph{Methods in Ecology and Evolution}, \bold{6}(2), 143--152. \verb{https://doi.org/10.1111/2041-210x.12309} Nakagawa, S., Noble, D. W. A., Lagisz, M., Spake, R., Viechtbauer, W., & Senior, A. M. (2023). A robust and readily implementable method for the meta-analysis of response ratios with and without missing standard deviations. \emph{Ecology Letters}, \bold{26}(2), 232--244. \verb{https://doi.org/10.1111/ele.14144} Newcombe, R. G. (1998). Improved confidence intervals for the difference between binomial proportions based on paired data. \emph{Statistics in Medicine}, \bold{17}(22), 2635--2650. \verb{https://doi.org/10.1002/(SICI)1097-0258(19981130)17:22<2635::AID-SIM954>3.0.CO;2-C} Olkin, I., & Finn, J. D. (1995). Correlations redux. \emph{Psychological Bulletin}, \bold{118}(1), 155--164. \verb{https://doi.org/10.1037/0033-2909.118.1.155} Olkin, I., & Pratt, J. W. (1958). Unbiased estimation of certain correlation coefficients. \emph{Annals of Mathematical Statistics}, \bold{29}(1), 201--211. \verb{https://doi.org/10.1214/aoms/1177706717} Pearson, K. (1900). Mathematical contributions to the theory of evolution. VII. On the correlation of characters not quantitatively measurable. \emph{Philosophical Transactions of the Royal Society of London, Series A}, \bold{195}, 1--47. \verb{https://doi.org/10.1098/rsta.1900.0022} Pearson, K. (1909). On a new method of determining correlation between a measured character A, and a character B, of which only the percentage of cases wherein B exceeds (or falls short of) a given intensity is recorded for each grade of A. \emph{Biometrika}, \bold{7}(1/2), 96--105. \verb{https://doi.org/10.1093/biomet/7.1-2.96} Raudenbush, S. W., & Bryk, A. S. (1987). Examining correlates of diversity. \emph{Journal of Educational Statistics}, \bold{12}(3), 241--269. \verb{https://doi.org/10.3102/10769986012003241} Rothman, K. J., Greenland, S., & Lash, T. L. (2008). \emph{Modern epidemiology} (3rd ed.). Philadelphia: Lippincott Williams & Wilkins. \enc{Rücker}{Ruecker}, G., Schwarzer, G., Carpenter, J., & Olkin, I. (2009). Why add anything to nothing? The arcsine difference as a measure of treatment effect in meta-analysis with zero cells. \emph{Statistics in Medicine}, \bold{28}(5), 721--738. \verb{https://doi.org/10.1002/sim.3511} \enc{Sánchez-Meca}{Sanchez-Meca}, J., \enc{Marín-Martínez}{Marin-Martinez}, F., & \enc{Chacón-Moscoso}{Chacon-Moscoso}, S. (2003). Effect-size indices for dichotomized outcomes in meta-analysis. \emph{Psychological Methods}, \bold{8}(4), 448--467. \verb{https://doi.org/10.1037/1082-989X.8.4.448} Soper, H. E. (1914). On the probable error of the bi-serial expression for the correlation coefficient. \emph{Biometrika}, \bold{10}(2/3), 384--390. \verb{https://doi.org/10.1093/biomet/10.2-3.384} Stedman, M. R., Curtin, F., Elbourne, D. R., Kesselheim, A. S., & Brookhart, M. A. (2011). Meta-analyses involving cross-over trials: Methodological issues. \emph{International Journal of Epidemiology}, \bold{40}(6), 1732--1734. \verb{https://doi.org/10.1093/ije/dyp345} Tate, R. F. (1954). Correlation between a discrete and a continuous variable: Point-biserial correlation. \emph{Annals of Mathematical Statistics}, \bold{25}(3), 603--607. \verb{https://doi.org/10.1214/aoms/1177728730} Vacha-Haase, T. (1998). Reliability generalization: Exploring variance in measurement error affecting score reliability across studies. \emph{Educational and Psychological Measurement}, \bold{58}(1), 6--20. \verb{https://doi.org/10.1177/0013164498058001002} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Yule, G. U. (1912). On the methods of measuring association between two attributes. \emph{Journal of the Royal Statistical Society}, \bold{75}(6), 579--652. \verb{https://doi.org/10.2307/2340126} Yusuf, S., Peto, R., Lewis, J., Collins, R., & Sleight, P. (1985). Beta blockade during and after myocardial infarction: An overview of the randomized trials. \emph{Progress in Cardiovascular Disease}, \bold{27}(5), 335--371. \verb{https://doi.org/10.1016/s0033-0620(85)80003-7} Ziegler, A., Steen, K. V. & Wellek, S. (2011). Investigating Hardy-Weinberg equilibrium in case-control or cohort studies or meta-analysis. \emph{Breast Cancer Research and Treatment}, \bold{128}(1), 197--201. \verb{https://doi.org/10.1007/s10549-010-1295-z} Zou, G. Y. (2007). One relative risk versus two odds ratios: Implications for meta-analyses involving paired and unpaired binary data. \emph{Clinical Trials}, \bold{4}(1), 25--31. \verb{https://doi.org/10.1177/1740774506075667} } \seealso{ \code{\link[=print.escalc]{print}} and \code{\link[=summary.escalc]{summary}} for the print and summary methods. \code{\link{conv.2x2}} for a function to reconstruct the cell frequencies of \mjeqn{2 \times 2}{2x2} tables based on other summary statistics. \code{\link{conv.fivenum}} for a function to convert five-number summary values to means and standard deviations (needed to compute various effect size measures, such as raw or standardized mean differences and ratios of means / response ratios). \code{\link{conv.wald}} for a function to convert Wald-type confidence intervals and test statistics to sampling variances. \code{\link{conv.delta}} for a function to transform observed effect sizes or outcomes and their sampling variances using the delta method. \code{\link{vcalc}} for a function to construct or approximate the variance-covariance matrix of dependent effect sizes or outcomes. \code{\link{rcalc}} for a function to construct the variance-covariance matrix of dependent correlation coefficients. \code{\link{rma.uni}} and \code{\link{rma.mv}} for model fitting functions that can take the calculated effect sizes or outcomes (and the corresponding sampling variances) as input. \code{\link{rma.mh}}, \code{\link{rma.peto}}, and \code{\link{rma.glmm}} for model fitting functions that take similar inputs. } \examples{ ############################################################################ ### data from the meta-analysis by Coliditz et al. (1994) on the efficacy of ### BCG vaccine in the prevention of tuberculosis dat.bcg dat.bcg ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) dat ### suppose that for a particular study, yi and vi are known (i.e., have ### already been calculated) but the 2x2 table counts are not known; with ### replace=FALSE, the yi and vi values for that study are not replaced dat[1:12,10:11] <- NA dat[13,4:7] <- NA dat dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, replace=FALSE) dat ### illustrate difference between 'subset' and 'include' arguments escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, subset=1:6) escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, include=1:6) ### illustrate the 'var.names' argument escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, var.names=c("lnrr","var")) ### illustrate the 'slab' argument dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, slab=paste0(author, ", ", year)) dat ### note: the output looks the same but the study labels are stored as an attribute with the ### effect size estimates (together with the total sample size of the studies and the chosen ### effect size measure) dat$yi ### this information can then be used by other functions; for example in a forest plot forest(dat$yi, dat$vi, header=TRUE, top=2) ############################################################################ ### convert a regular data frame to an 'escalc' object ### dataset from Lipsey & Wilson (2001), Table 7.1, page 130 dat <- data.frame(id = c(100, 308, 1596, 2479, 9021, 9028, 161, 172, 537, 7049), yi = c(-0.33, 0.32, 0.39, 0.31, 0.17, 0.64, -0.33, 0.15, -0.02, 0.00), vi = c(0.084, 0.035, 0.017, 0.034, 0.072, 0.117, 0.102, 0.093, 0.012, 0.067), random = c(0, 0, 0, 0, 0, 0, 1, 1, 1, 1), intensity = c(7, 3, 7, 5, 7, 7, 4, 4, 5, 6)) dat dat <- escalc(measure="SMD", yi=yi, vi=vi, data=dat, slab=paste("Study ID:", id), digits=3) dat ############################################################################ } \keyword{datagen} metafor/man/coef.permutest.rma.uni.Rd0000644000176200001440000000404714505063152017272 0ustar liggesusers\name{coef.permutest.rma.uni} \alias{coef.permutest.rma.uni} \title{Extract the Model Coefficient Table from 'permutest.rma.uni' Objects} \description{ Function to extract the estimated model coefficients, corresponding standard errors, test statistics, p-values (based on the permutation tests), and confidence interval bounds from objects of class \code{"permutest.rma.uni"}. } \usage{ \method{coef}{permutest.rma.uni}(object, \dots) } \arguments{ \item{object}{an object of class \code{"permutest.rma.uni"}.} \item{\dots}{other arguments.} } \value{ A data frame with the following elements: \item{estimate}{estimated model coefficient(s).} \item{se}{corresponding standard error(s).} \item{zval}{corresponding test statistic(s).} \item{pval}{p-value(s) based on the permutation test(s).} \item{ci.lb}{lower bound of the (permutation-based) confidence interval(s).} \item{ci.ub}{upper bound of the (permutation-based) confidence interval(s).} When the model was fitted with \code{test="t"} or \code{test="knha"}, then \code{zval} is called \code{tval} in the data frame that is returned by the function. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link[=permutest.rma.uni]{permutest}} for the function to conduct permutation tests and \code{\link{rma.uni}} for the function to fit models for which permutation tests can be conducted. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit mixed-effects model with absolute latitude and publication year as moderators res <- rma(yi, vi, mods = ~ ablat + year, data=dat) ### carry out permutation test \dontrun{ set.seed(1234) # for reproducibility sav <- permutest(res) coef(sav) } } \keyword{models} metafor/man/rma.glmm.Rd0000644000176200001440000010507114505063152014470 0ustar liggesusers\name{rma.glmm} \alias{rma.glmm} \title{Meta-Analysis via Generalized Linear (Mixed-Effects) Models} \description{ Function to fit meta-analytic equal-, fixed-, and random-effects models and (mixed-effects) meta-regression models using a generalized linear (mixed-effects) model framework. See below and the introduction to the \pkg{\link{metafor-package}} for more details on these models. \loadmathjax } \usage{ rma.glmm(ai, bi, ci, di, n1i, n2i, x1i, x2i, t1i, t2i, xi, mi, ti, ni, mods, measure, intercept=TRUE, data, slab, subset, add=1/2, to="only0", drop00=TRUE, vtype="LS", model="UM.FS", method="ML", coding=1/2, cor=FALSE, test="z", level=95, btt, nAGQ=7, verbose=FALSE, digits, control, \dots) } \arguments{ \item{ai}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{bi}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{ci}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{di}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{n1i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{n2i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{x1i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{x2i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{t1i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{t2i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{xi}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{mi}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{ti}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{ni}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{mods}{optional argument to include one or more moderators in the model. A single moderator can be given as a vector of length \mjseqn{k} specifying the values of the moderator. Multiple moderators are specified by giving a matrix with \mjseqn{k} rows and as many columns as there are moderator variables. Alternatively, a model \code{\link{formula}} can be used to specify the model. See \sQuote{Details}.} \item{measure}{character string to specify the outcome measure to use for the meta-analysis. Possible options are \code{"OR"} for the (log transformed) odds ratio, \code{"IRR"} for the (log transformed) incidence rate ratio, \code{"PLO"} for the (logit transformed) proportion, or \code{"IRLN"} for the (log transformed) incidence rate.} \item{intercept}{logical to specify whether an intercept should be added to the model (the default is \code{TRUE}).} \item{data}{optional data frame containing the data supplied to the function.} \item{slab}{optional vector with labels for the \mjseqn{k} studies.} \item{subset}{optional (logical or numeric) vector to specify the subset of studies that should be used for the analysis.} \item{add}{non-negative number to specify the amount to add to zero cells, counts, or frequencies when calculating the observed effect sizes or outcomes of the individual studies. See below and the documentation of the \code{\link{escalc}} function for more details.} \item{to}{character string to specify when the values under \code{add} should be added (either \code{"only0"}, \code{"all"}, \code{"if0all"}, or \code{"none"}). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{drop00}{logical to specify whether studies with no cases/events (or only cases) in both groups should be dropped. See the documentation of the \code{\link{escalc}} function for more details.} \item{vtype}{character string to specify the type of sampling variances to calculate when calculating the observed effect sizes or outcomes. See the documentation of the \code{\link{escalc}} function for more details.} \item{model}{character string to specify the general model type for the analysis. Either \code{"UM.FS"} (the default), \code{"UM.RS"}, \code{"CM.EL"}, or \code{"CM.AL"}. See \sQuote{Details}.} \item{method}{character string to specify whether an equal- or a random-effects model should be fitted. An equal-effects model is fitted when using \code{method="EE"}. A random-effects model is fitted by setting \code{method="ML"} (the default). See \sQuote{Details}.} \item{coding}{numeric scalar to indicate how the group variable should be coded in the random effects structure for random/mixed-effects models (the default is \code{1/2}). See \sQuote{Note}.} \item{cor}{logical to indicate whether the random study effects should be allowed to be correlated with the random group effects for random/mixed-effects models when \code{model="UM.RS"} (the default is \code{FALSE}). See \sQuote{Note}.} \item{test}{character string to specify how test statistics and confidence intervals for the fixed effects should be computed. By default (\code{test="z"}), Wald-type tests and CIs are obtained, which are based on a standard normal distribution. When \code{test="t"}, a t-distribution is used instead. See \sQuote{Details} and also \link[=misc-recs]{here} for some recommended practices.} \item{level}{numeric value between 0 and 100 to specify the confidence interval level (the default is 95; see \link[=misc-options]{here} for details).} \item{btt}{optional vector of indices to specify which coefficients to include in the omnibus test of moderators. Can also be a string to \code{\link{grep}} for. See \sQuote{Details}.} \item{nAGQ}{positive integer to specify the number of points per axis for evaluating the adaptive Gauss-Hermite approximation to the log-likelihood. The default is 7. Setting this to 1 corresponds to the Laplacian approximation. See \sQuote{Note}.} \item{verbose}{logical to specify whether output should be generated on the progress of the model fitting (the default is \code{FALSE}). Can also be an integer. Values > 1 generate more verbose output. See \sQuote{Note}.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is 4. See also \link[=misc-options]{here} for further details on how to control the number of digits in the output.} \item{control}{optional list of control values for the estimation algorithms. If unspecified, default values are defined inside the function. See \sQuote{Note}.} \item{\dots}{additional arguments.} } \details{ \subsection{Specifying the Data}{ The function can be used in combination with the following effect sizes or outcome measures: \itemize{ \item \code{measure="OR"} for (log transformed) odds ratios, \item \code{measure="IRR"} for (log transformed) incidence rate ratios, \item \code{measure="PLO"} for (logit transformed) proportions (i.e., log odds), \item \code{measure="IRLN"} for (log transformed) incidence rates. } The \code{\link{escalc}} function describes the data/arguments that should be specified/used for these measures. } \subsection{Specifying the Model}{ A variety of model types are available when analyzing \mjeqn{2 \times 2}{2x2} table data (i.e., when \code{measure="OR"}) or two-group event count data (i.e., when \code{measure="IRR"}): \itemize{ \item \code{model="UM.FS"} for an unconditional generalized linear mixed-effects model with fixed study effects, \item \code{model="UM.RS"} for an unconditional generalized linear mixed-effects model with random study effects, \item \code{model="CM.AL"} for a conditional generalized linear mixed-effects model (approximate likelihood), \item \code{model="CM.EL"} for a conditional generalized linear mixed-effects model (exact likelihood). } For \code{measure="OR"}, models \code{"UM.FS"} and \code{"UM.RS"} are essentially (mixed-effects) logistic regression models, while for \code{measure="IRR"}, these models are (mixed-effects) Poisson regression models. The difference between \code{"UM.FS"} and \code{"UM.RS"} is how study level variability (i.e., differences in outcomes across studies irrespective of group membership) is modeled. One can choose between using fixed study effects (which means that \mjseqn{k} dummy variables are added to the model) or random study effects (which means that random effects corresponding to the levels of the study factor are added to the model). The conditional model (\code{model="CM.EL"}) avoids having to model study level variability by conditioning on the total numbers of cases/events in each study. For \code{measure="OR"}, this leads to a non-central hypergeometric distribution for the data within each study and the corresponding model is then a (mixed-effects) conditional logistic model. Fitting this model can be difficult and computationally expensive. When the number of cases in each study is small relative to the group sizes, one can approximate the exact likelihood by a binomial distribution, which leads to a regular (mixed-effects) logistic regression model (\code{model="CM.AL"}). For \code{measure="IRR"}, the conditional model leads directly to a binomial distribution for the data within each study and the resulting model is again a (mixed-effects) logistic regression model (no approximate likelihood model is needed here). When analyzing proportions (i.e., \code{measure="PLO"}) or incidence rates (i.e., \code{measure="IRLN"}) of individual groups, the model type is always a (mixed-effects) logistic or Poisson regression model, respectively (i.e., the \code{model} argument is not relevant here). Aside from choosing the general model type, one has to decide whether to fit an equal- or a random-effects model to the data. An \emph{equal-effects model} is fitted by setting \code{method="EE"}. A \emph{random-effects model} is fitted by setting \code{method="ML"} (the default). Note that random-effects models with dichotomous data are often referred to as \sQuote{binomial-normal} models in the meta-analytic literature. Analogously, for event count data, such models could be referred to as \sQuote{Poisson-normal} models. One or more moderators can be included in a model via the \code{mods} argument. A single moderator can be given as a (row or column) vector of length \mjseqn{k} specifying the values of the moderator. Multiple moderators are specified by giving an appropriate model matrix (i.e., \mjseqn{X}) with \mjseqn{k} rows and as many columns as there are moderator variables (e.g., \code{mods = cbind(mod1, mod2, mod3)}, where \code{mod1}, \code{mod2}, and \code{mod3} correspond to the names of the variables for three moderator variables). The intercept is added to the model matrix by default unless \code{intercept=FALSE}. Alternatively, one can use standard \code{\link{formula}} syntax to specify the model. In this case, the \code{mods} argument should be set equal to a one-sided formula of the form \code{mods = ~ model} (e.g., \code{mods = ~ mod1 + mod2 + mod3}). Interactions, polynomial terms, and factors can be easily added to the model in this manner. When specifying a model formula via the \code{mods} argument, the \code{intercept} argument is ignored. Instead, the inclusion/exclusion of the intercept is controlled by the specified formula (e.g., \code{mods = ~ mod1 + mod2 + mod3 - 1} would lead to the removal of the intercept). } \subsection{Equal-, Saturated-, and Random/Mixed-Effects Models}{ When fitting a particular model, actually up to three different models are fitted within the function: \itemize{ \item the equal-effects model (i.e., where \mjseqn{\tau^2} is set to 0), \item the saturated model (i.e., the model with a deviance of 0), and \item the random/mixed-effects model (i.e., where \mjseqn{\tau^2} is estimated) (only if \code{method="ML"}). } The saturated model is obtained by adding as many dummy variables to the model as needed so that the model deviance is equal to zero. Even when \code{method="ML"}, the equal- and saturated models are also fitted, as they are used to compute the test statistics for the Wald-type and likelihood ratio tests for (residual) heterogeneity (see below). } \subsection{Omnibus Test of Moderators}{ For models including moderators, an omnibus test of all model coefficients is conducted that excludes the intercept (the first coefficient) if it is included in the model. If no intercept is included in the model, then the omnibus test includes all of the coefficients in the model including the first. Alternatively, one can manually specify the indices of the coefficients to test via the \code{btt} (\sQuote{betas to test}) argument (i.e., to test \mjseqn{\mbox{H}_0{:}\; \beta_{j \in \texttt{btt}} = 0}, where \mjseqn{\beta_{j \in \texttt{btt}}} is the set of coefficients to be tested). For example, with \code{btt=c(3,4)}, only the third and fourth coefficients from the model are included in the test (if an intercept is included in the model, then it corresponds to the first coefficient in the model). Instead of specifying the coefficient numbers, one can specify a string for \code{btt}. In that case, \code{\link{grep}} will be used to search for all coefficient names that match the string. The omnibus test is called the \mjseqn{Q_M}-test and follows asymptotically a chi-square distribution with \mjseqn{m} degrees of freedom (with \mjseqn{m} denoting the number of coefficients tested) under the null hypothesis (that the true value of all coefficients tested is equal to 0). } \subsection{Categorical Moderators}{ Categorical moderator variables can be included in the model via the \code{mods} argument in the same way that appropriately (dummy) coded categorical variables can be included in linear models. One can either do the dummy coding manually or use a model formula together with the \code{\link{factor}} function to automate the coding (note that string/character variables in a model formula are automatically converted to factors). } \subsection{Tests and Confidence Intervals}{ By default, tests of individual coefficients in the model (and the corresponding confidence intervals) are based on a standard normal distribution, while the omnibus test is based on a chi-square distribution (see above). As an alternative, one can set \code{test="t"}, in which case tests of individual coefficients and confidence intervals are based on a t-distribution with \mjseqn{k-p} degrees of freedom, while the omnibus test then uses an F-distribution with \mjseqn{m} and \mjseqn{k-p} degrees of freedom (with \mjseqn{k} denoting the total number of estimates included in the analysis and \mjseqn{p} the total number of model coefficients including the intercept if it is present). Note that \code{test="t"} is not the same as \code{test="knha"} in \code{\link{rma.uni}}, as no adjustment to the standard errors of the estimated coefficients is made. } \subsection{Tests for (Residual) Heterogeneity}{ Two different tests for (residual) heterogeneity are automatically carried out by the function. The first is a Wald-type test, which tests the coefficients corresponding to the dummy variables added in the saturated model for significance. The second is a likelihood ratio test, which tests the same set of coefficients, but does so by computing \mjseqn{-2} times the difference in the log-likelihoods of the equal-effects and the saturated models. These two tests are not identical for the types of models fitted by the \code{rma.glmm} function and may even lead to conflicting conclusions. } \subsection{Observed Effect Sizes or Outcomes of the Individual Studies}{ The various models do not require the calculation of the observed effect sizes or outcomes of the individual studies (e.g., the observed log odds ratios of the \mjseqn{k} studies) and directly make use of the cell/event counts. Zero cells/events are not a problem (except in extreme cases, such as when one of the two outcomes never occurs or when there are no events in any of the studies). Therefore, it is unnecessary to add some constant to the cell/event counts when there are zero cells/events. However, for plotting and various other functions, it is necessary to calculate the observed effect sizes or outcomes for the \mjseqn{k} studies. Here, zero cells/events can be problematic, so adding a constant value to the cell/event counts ensures that all \mjseqn{k} values can be calculated. The \code{add} and \code{to} arguments are used to specify what value should be added to the cell/event counts and under what circumstances when calculating the observed effect sizes or outcomes. The documentation of the \code{\link{escalc}} function explains how the \code{add} and \code{to} arguments work. Note that \code{drop00} is set to \code{TRUE} by default, since studies where \code{ai=ci=0} or \code{bi=di=0} or studies where \code{x1i=x2i=0} are uninformative about the size of the effect. } } \value{ An object of class \code{c("rma.glmm","rma")}. The object is a list containing the following components: \item{beta}{estimated coefficients of the model.} \item{se}{standard errors of the coefficients.} \item{zval}{test statistics of the coefficients.} \item{pval}{corresponding p-values.} \item{ci.lb}{lower bound of the confidence intervals for the coefficients.} \item{ci.ub}{upper bound of the confidence intervals for the coefficients.} \item{vb}{variance-covariance matrix of the estimated coefficients.} \item{tau2}{estimated amount of (residual) heterogeneity. Always \code{0} when \code{method="EE"}.} \item{sigma2}{estimated amount of study level variability (only for \code{model="UM.RS"}).} \item{k}{number of studies included in the analysis.} \item{p}{number of coefficients in the model (including the intercept).} \item{m}{number of coefficients included in the omnibus test of moderators.} \item{QE.Wld}{Wald-type test statistic of the test for (residual) heterogeneity.} \item{QEp.Wld}{corresponding p-value.} \item{QE.LRT}{likelihood ratio test statistic of the test for (residual) heterogeneity.} \item{QEp.LRT}{corresponding p-value.} \item{QM}{test statistic of the omnibus test of moderators.} \item{QMp}{corresponding p-value.} \item{I2}{value of \mjseqn{I^2}.} \item{H2}{value of \mjseqn{H^2}.} \item{int.only}{logical that indicates whether the model is an intercept-only model.} \item{yi, vi, X}{the vector of outcomes, the corresponding sampling variances, and the model matrix.} \item{fit.stats}{a list with the log-likelihood, deviance, AIC, BIC, and AICc values.} \item{\dots}{some additional elements/values.} } \section{Methods}{ The results of the fitted model are formatted and printed with the \code{\link[=print.rma.glmm]{print}} function. If fit statistics should also be given, use \code{\link[=summary.rma]{summary}} (or use the \code{\link[=fitstats.rma]{fitstats}} function to extract them). } \note{ When \code{measure="OR"} or \code{measure="IRR"}, \code{model="UM.FS"} or \code{model="UM.RS"}, and \code{method="ML"}, one has to choose a coding scheme for the group variable in the random effects structure. When \code{coding=1/2} (the default), the two groups are coded with \code{+1/2} and \code{-1/2} (i.e., contrast coding), which is invariant under group label switching. When \code{coding=1}, the first group is coded with \code{1} and the second group with \code{0}. Finally, when \code{coding=0}, the first group is coded with \code{0} and the second group with \code{1}. Note that these coding schemes are not invariant under group label switching. When \code{model="UM.RS"} and \code{method="ML"}, one has to decide whether the random study effects are allowed to be correlated with the random group effects. By default (i.e., when \code{cor=FALSE}), no such correlation is allowed (which is typically an appropriate assumption when \code{coding=1/2}). When using a different coding scheme for the group variable (i.e., \code{coding=1} or \code{coding=0}), allowing the random study and group effects to be correlated (i.e., using \code{cor=TRUE}) is usually recommended. Fitting the various types of models requires several different iterative algorithms: \itemize{ \item For \code{model="UM.FS"} and \code{model="CM.AL"}, iteratively reweighted least squares (IWLS) as implemented in the \code{\link{glm}} function is used for fitting the equal-effects and the saturated models. For \code{method="ML"}, adaptive Gauss-Hermite quadrature as implemented in the \code{\link[lme4]{glmer}} function is used. The same applies when \code{model="CM.EL"} is used in combination with \code{measure="IRR"} or when \code{measure="PLO"} or \code{measure="IRLN"} (regardless of the model type). \item For \code{model="UM.RS"}, adaptive Gauss-Hermite quadrature as implemented in the \code{\link[lme4]{glmer}} function is used to fit all of the models. \item For \code{model="CM.EL"} and \code{measure="OR"}, the quasi-Newton method optimizer as implemented in the \code{\link{nlminb}} function is used by default for fitting the equal-effects and the saturated models. For \code{method="ML"}, the same algorithm is used, together with adaptive quadrature as implemented in the \code{\link{integrate}} function (for the integration over the density of the non-central hypergeometric distribution). Standard errors of the parameter estimates are obtained by inverting the Hessian, which is numerically approximated using the \code{\link[numDeriv]{hessian}} function from the \code{numDeriv} package. One can also set \code{control=list(hesspack="pracma")} in which case the \code{\link[pracma]{hessian}} function from the \code{pracma} package is used instead for approximating the Hessian. When \mjseqn{\tau^2} is estimated to be smaller than \mjeqn{10^{-4}}{10^(-4)}, then \mjseqn{\tau^2} is effectively treated as zero for computing the standard errors (which helps to avoid numerical problems in approximating the Hessian). This cutoff can be adjusted via the \code{tau2tol} control argument (e.g., \code{control=list(tau2tol=0)} to switch off this behavior). One can also chose a different optimizer from \code{\link{optim}} via the \code{control} argument (e.g., \code{control=list(optimizer="BFGS")} or \code{control=list(optimizer="Nelder-Mead")}). Besides \code{\link{nlminb}} and one of the methods from \code{\link{optim}}, one can also choose one of the optimizers from the \code{minqa} package (i.e., \code{\link[minqa]{uobyqa}}, \code{\link[minqa]{newuoa}}, or \code{\link[minqa]{bobyqa}}), one of the (derivative-free) algorithms from the \code{\link[nloptr]{nloptr}} package, the Newton-type algorithm implemented in \code{\link{nlm}}, the various algorithms implemented in the \code{dfoptim} package (\code{\link[dfoptim]{hjk}} for the Hooke-Jeeves, \code{\link[dfoptim]{nmk}} for the Nelder-Mead, and \code{\link[dfoptim]{mads}} for the Mesh Adaptive Direct Searches algorithm), the quasi-Newton type optimizers \code{\link[ucminf]{ucminf}} and \code{\link[lbfgsb3c]{lbfgsb3c}} and the subspace-searching simplex algorithm \code{\link[subplex]{subplex}} from the packages of the same name, the Barzilai-Borwein gradient decent method implemented in \code{\link[BB]{BBoptim}}, the \code{\link[Rcgmin]{Rcgmin}} and \code{\link[Rvmmin]{Rvmmin}} optimizers, or the parallelized version of the L-BFGS-B algorithm implemented in \code{\link[optimParallel]{optimParallel}} from the package of the same name. The optimizer name must be given as a character string (i.e., in quotes). Additional control parameters can be specified via the \code{optCtrl} elements of the \code{control} argument (e.g., \code{control=list(optCtrl=list(iter.max=1000, rel.tol=1e-8))}). For \code{\link[nloptr]{nloptr}}, the default is to use the BOBYQA implementation from that package with a relative convergence criterion of \code{1e-8} on the function value (i.e., log-likelihood), but this can be changed via the \code{algorithm} and \code{ftop_rel} arguments (e.g., \code{control=list(optimizer="nloptr", optCtrl=list(algorithm="NLOPT_LN_SBPLX", ftol_rel=1e-6))}). For \code{\link[optimParallel]{optimParallel}}, the control argument \code{ncpus} can be used to specify the number of cores to use for the parallelization (e.g., \code{control=list(optimizer="optimParallel", ncpus=2)}). With \code{parallel::detectCores()}, one can check on the number of available cores on the local machine. } When \code{model="CM.EL"} and \code{measure="OR"}, actually \code{model="CM.AL"} is used first to obtain starting values for \code{\link{optim}}, so either 4 (if \code{method="EE"}) or 6 (if \code{method="ML"}) models need to be fitted in total. Various additional control parameters can be adjusted via the \code{control} argument: \itemize{ \item \code{glmCtrl} is a list of named arguments to be passed on to the \code{control} argument of the \code{\link{glm}} function, \item \code{glmerCtrl} is a list of named arguments to be passed on to the \code{control} argument of the \code{\link[lme4]{glmer}} function, \item \code{intCtrl} is a list of named arguments (i.e., \code{rel.tol} and \code{subdivisions}) to be passed on to the \code{\link{integrate}} function, and \item \code{hessianCtrl} is a list of named arguments to be passed on to the \code{method.args} argument of the \code{\link[numDeriv]{hessian}} function. Most important is the \code{r} argument, which is set to 16 by default (i.e., \code{control=list(hessianCtrl=list(r=16))}). If the Hessian cannot be inverted, it may be necessary to adjust the \code{r} argument to a different number (e.g., try \code{r=4}, \code{r=6}, or \code{r=8}). } Also, for \code{\link[lme4]{glmer}}, the \code{nAGQ} argument is used to specify the number of quadrature points. The default value is 7, which should provide sufficient accuracy in the evaluation of the log-likelihood in most cases, but at the expense of speed. Setting this to 1 corresponds to the Laplacian approximation (which is faster, but less accurate). Note that \code{\link[lme4]{glmer}} does not allow values of \code{nAGQ > 1} when \code{model="UM.RS"} and \code{method="ML"}, so this value is automatically set to 1 for this model. Instead of \code{\link[lme4]{glmer}}, one can also choose to use \code{\link[GLMMadaptive]{mixed_model}} from the \code{GLMMadaptive} package or \code{\link[glmmTMB]{glmmTMB}} from the \code{glmmTMB} package for the model fitting. This is done by setting \code{control=list(package="GLMMadaptive")} or \code{control=list(package="glmmTMB")}, respectively. Information on the progress of the various algorithms can be obtained by setting \code{verbose=TRUE}. Since fitting the various models can be computationally expensive, this option is useful to determine how the model fitting is progressing. One can also set \code{verbose} to an integer (\code{verbose=2} yields even more information and \code{verbose=3} also sets \code{option(warn=1)} temporarily). For \code{model="CM.EL"} and \code{measure="OR"}, optimization involves repeated calculation of the density of the non-central hypergeometric distribution. When \code{method="ML"}, this also requires integration over the same density. This is currently implemented in a rather brute-force manner and may not be numerically stable, especially when models with moderators are fitted. Stability can be improved by scaling the moderators in a similar manner (i.e., don't use a moderator that is coded 0 and 1, while another uses values in the 1000s). For models with an intercept and moderators, the function actually rescales (non-dummy) variables to z-scores during the model fitting (results are given after back-scaling, so this should be transparent to the user). For models without an intercept, this is not done, so sensitivity analyses are highly recommended here (to ensure that the results do not depend on the scaling of the moderators). Also, if a warning is issued that the standard errors of the fixed effects are unusually small, one should try sensitivity analyses with different optimizers and/or adjusted settings for the \code{hessianCtrl} and \code{tau2tol} control arguments. Finally, there is also (experimental!) support for the following measures: \itemize{ \item \code{measure="RR"} for log transformed risk ratios, \item \code{measure="RD"} for raw risk differences, \item \code{measure="PLN"} for log transformed proportions, \item \code{measure="PR"} for raw proportions, } (the first two only for models \code{"UM.FS"} and \code{"UM.RS"}) by using log and identity links for the binomial models. However, model fitting with these measures will often lead to numerical problems. Via the (undocumented) \code{link} argument, one can also directly adjust the link function that is used (by default, measures \code{"OR"} and \code{"PLO"} use a \code{"logit"} link, measures \code{"RR"} and \code{"PLN"} use a \code{"log"} link, measures \code{"RD"} and \code{"PR"} use an \code{"identity"} link, and measures \code{"IRR"} and \code{"IRLN"} use a \code{"log"} link). See \code{\link{family}} for alternative options. Changing these defaults is only recommended for users familiar with the consequences and the interpretation of the resulting estimates (when misused, the results could be meaningless). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} Code for computing the density of the non-central hypergeometric distribution comes from the \href{https://cran.r-project.org/package=MCMCpack}{MCMCpack} package, which in turn is based on Liao and Rosen (2001). } \references{ Agresti, A. (2002). \emph{Categorical data analysis} (2nd. ed). Hoboken, NJ: Wiley. Bagos, P. G., & Nikolopoulos, G. K. (2009). Mixed-effects Poisson regression models for meta-analysis of follow-up studies with constant or varying durations. \emph{The International Journal of Biostatistics}, \bold{5}(1). \verb{https://doi.org/10.2202/1557-4679.1168} van Houwelingen, H. C., Zwinderman, K. H., & Stijnen, T. (1993). A bivariate approach to meta-analysis. \emph{Statistics in Medicine}, \bold{12}(24), 2273--2284. \verb{https://doi.org/10.1002/sim.4780122405} Jackson, D., Law, M., Stijnen, T., Viechtbauer, W., & White, I. R. (2018). A comparison of seven random-effects models for meta-analyses that estimate the summary odds ratio. \emph{Statistics in Medicine}, \bold{37}(7), 1059-1085. \verb{https://doi.org/10.1002/sim.7588} Liao, J. G., & Rosen, O. (2001). Fast and stable algorithms for computing and sampling from the noncentral hypergeometric distribution. \emph{American Statistician}, \bold{55}(4), 366--369. \verb{https://doi.org/10.1198/000313001753272547} Simmonds, M. C., & Higgins, J. P. T. (2016). A general framework for the use of logistic regression models in meta-analysis. \emph{Statistical Methods in Medical Research}, \bold{25}(6), 2858--2877. \verb{https://doi.org/10.1177/0962280214534409} Stijnen, T., Hamza, T. H., & Ozdemir, P. (2010). Random effects meta-analysis of event outcome in the framework of the generalized linear mixed model with applications in sparse data. \emph{Statistics in Medicine}, \bold{29}(29), 3046--3067. \verb{https://doi.org/10.1002/sim.4040} Turner, R. M., Omar, R. Z., Yang, M., Goldstein, H., & Thompson, S. G. (2000). A multilevel model framework for meta-analysis of clinical trials with binary outcomes. \emph{Statistics in Medicine}, \bold{19}(24), 3417--3432. \verb{https://doi.org/10.1002/1097-0258(20001230)19:24<3417::aid-sim614>3.0.co;2-l} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, and \code{\link{rma.mv}} for other model fitting functions. \code{\link[metadat]{dat.nielweise2007}}, \code{\link[metadat]{dat.nielweise2008}}, \code{\link[metadat]{dat.collins1985a}}, and \code{\link[metadat]{dat.pritz1997}} for further examples of the use of the \code{rma.glmm} function. For rare event data, see also the \href{https://cran.r-project.org/package=rema}{rema} package for a version of the conditional logistic model that uses a permutation approach for making inferences. } \examples{ ############################################################################ ### random-effects model using rma.uni() (standard RE model analysis) rma(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, method="ML") ### random-effects models using rma.glmm() (requires 'lme4' package) \dontrun{ ### unconditional model with fixed study effects (the default) rma.glmm(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, model="UM.FS") ### unconditional model with random study effects rma.glmm(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, model="UM.RS") ### conditional model with approximate likelihood rma.glmm(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, model="CM.AL") ### conditional model with exact likelihood ### note: fitting this model may take a bit of time, so be patient rma.glmm(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, model="CM.EL") } ############################################################################ ### try some alternative measures \dontrun{ rma.glmm(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) rma.glmm(measure="RD", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) } ############################################################################ ### meta-analysis of proportions \dontrun{ dat <- dat.debruin2009 ### binomial-normal model (with logit link) = mixed-effects logistic model res <- rma.glmm(measure="PLO", xi=xi, ni=ni, data=dat) predict(res, transf=transf.ilogit) ### binomial-normal model with measure="PLN" (uses a log link) res <- rma.glmm(measure="PLN", xi=xi, ni=ni, data=dat) predict(res, transf=exp) ### binomial-normal model with measure="PR" (uses an identity link) res <- rma.glmm(measure="PR", xi=xi, ni=ni, data=dat) predict(res) ### binomial-normal model (with probit link) = mixed-effects probit model res <- rma.glmm(measure="PLO", xi=xi, ni=ni, data=dat, link="probit") predict(res, transf=pnorm) ### further link functions that one could consider here res <- rma.glmm(measure="PLO", xi=xi, ni=ni, data=dat, link="cauchit") predict(res, transf=pcauchy) res <- rma.glmm(measure="PLO", xi=xi, ni=ni, data=dat, link="cloglog") predict(res, transf=\(x) 1-exp(-exp(x))) } ############################################################################ } \keyword{models} metafor/man/vcov.rma.Rd0000644000176200001440000000551314505063152014511 0ustar liggesusers\name{vcov.rma} \alias{vcov} \alias{vcov.rma} \title{Extract Various Types of Variance-Covariance Matrices from 'rma' Objects} \description{ Function to extract various types of variance-covariance matrices from objects of class \code{"rma"}. By default, the variance-covariance matrix of the fixed effects is returned. \loadmathjax } \usage{ \method{vcov}{rma}(object, type="fixed", \dots) } \arguments{ \item{object}{an object of class \code{"rma"}.} \item{type}{character string to specify the type of variance-covariance matrix to return: \code{type="fixed"} returns the variance-covariance matrix of the fixed effects (the default), \code{type="obs"} returns the marginal variance-covariance matrix of the observed effect sizes or outcomes, \code{type="fitted"} returns the variance-covariance matrix of the fitted values, \code{type="resid"} returns the variance-covariance matrix of the residuals.} \item{\dots}{other arguments.} } \details{ Note that \code{type="obs"} currently only works for object of class \code{"rma.uni"} and \code{"rma.mv"}. For objects of class \code{"rma.uni"}, the marginal variance-covariance matrix of the observed effect sizes or outcomes is just a diagonal matrix with \mjeqn{\hat{\tau}^2 + v_i}{\tau^2 + v_i} along the diagonal, where \mjeqn{\hat{\tau}^2}{\tau^2} is the estimated amount of (residual) heterogeneity (set to 0 in equal-effects models) and \mjseqn{v_i} is the sampling variance of the \mjeqn{i\textrm{th}}{ith} study. For objects of class \code{"rma.mv"}, the structure can be more complex and depends on the random effects included in the model. } \value{ A matrix corresponding to the requested variance-covariance matrix. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models for which the various types of variance-covariance matrices can be extracted. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit mixed-effects model with absolute latitude and publication year as moderators res <- rma(yi, vi, mods = ~ ablat + year, data=dat) ### var-cov matrix of the fixed effects (i.e., the model coefficients) vcov(res) ### marginal var-cov matrix of the observed log risk ratios round(vcov(res, type="obs"), 3) ### var-cov matrix of the fitted values round(vcov(res, type="fitted"), 3) ### var-cov matrix of the residuals round(vcov(res, type="resid"), 3) } \keyword{models} metafor/man/funnel.Rd0000644000176200001440000004305114505063152014244 0ustar liggesusers\name{funnel} \alias{funnel} \alias{funnel.rma} \alias{funnel.default} \title{Funnel Plots} \description{ Function to create funnel plots. \loadmathjax } \usage{ funnel(x, \dots) \method{funnel}{rma}(x, yaxis="sei", xlim, ylim, xlab, ylab, slab, steps=5, at, atransf, targs, digits, level=x$level, addtau2=FALSE, type="rstandard", back, shade, hlines, refline, lty=3, pch, pch.fill, col, bg, label=FALSE, offset=0.4, legend=FALSE, \dots) \method{funnel}{default}(x, vi, sei, ni, subset, yaxis="sei", xlim, ylim, xlab, ylab, slab, steps=5, at, atransf, targs, digits, level=95, back, shade, hlines, refline=0, lty=3, pch, col, bg, label=FALSE, offset=0.4, legend=FALSE, \dots) } \arguments{ \item{x}{an object of class \code{"rma"} or a vector with the observed effect sizes or outcomes.} \item{vi}{vector with the corresponding sampling variances (needed if \code{x} is a vector with the observed effect sizes or outcomes).} \item{sei}{vector with the corresponding standard errors (note: only one of the two, \code{vi} or \code{sei}, needs to be specified).} \item{ni}{vector with the corresponding sample sizes. Only relevant when passing a vector via \code{x}.} \item{subset}{optional (logical or numeric) vector to specify the subset of studies that should be included in the plot. Only relevant when passing a vector via \code{x}.} \item{yaxis}{either \code{"sei"}, \code{"vi"}, \code{"seinv"}, \code{"vinv"}, \code{"ni"}, \code{"ninv"}, \code{"sqrtni"}, \code{"sqrtninv"}, \code{"lni"}, or \code{"wi"} to indicate what values should be placed on the y-axis. See \sQuote{Details}.} \item{xlim}{x-axis limits. If unspecified, the function sets the x-axis limits to some sensible values.} \item{ylim}{y-axis limits. If unspecified, the function sets the y-axis limits to some sensible values.} \item{xlab}{title for the x-axis. If unspecified, the function sets an appropriate axis title.} \item{ylab}{title for the y-axis. If unspecified, the function sets an appropriate axis title.} \item{slab}{optional vector with labels for the \mjseqn{k} studies. If unspecified, the function tries to extract study labels from \code{x}.} \item{steps}{the number of tick marks for the y-axis (the default is 5).} \item{at}{position of the x-axis tick marks and corresponding labels. If unspecified, the function sets the tick mark positions/labels to some sensible values.} \item{atransf}{optional argument to specify a function to transform the x-axis labels (e.g., \code{atransf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{targs}{optional arguments needed by the function specified via \code{atransf}.} \item{digits}{optional integer to specify the number of decimal places to which the tick mark labels of the x- and y-axis should be rounded. Can also be a vector of two integers, the first to specify the number of decimal places for the x-axis, the second for the y-axis labels (e.g., \code{digits=c(2,3)}). If unspecified, the function tries to set the argument to some sensible values.} \item{level}{numeric value between 0 and 100 to specify the level of the pseudo confidence interval region (see \link[=misc-options]{here} for details). For \code{"rma"} objects, the default is to take the value from the object. May also be a vector of values to obtain multiple regions. See \sQuote{Examples}.} \item{addtau2}{logical to indicate whether the amount of heterogeneity should be accounted for when drawing the pseudo confidence interval region (the default is \code{FALSE}). Ignored when \code{x} is a meta-regression model and residuals are plotted. See \sQuote{Details}.} \item{type}{either \code{"rstandard"} (default) or \code{"rstudent"} to specify whether the usual or deleted residuals should be used in creating the funnel plot when \code{x} is a meta-regression model. See \sQuote{Details}.} \item{back}{optional character string to specify the color of the plotting region background.} \item{shade}{optional character string to specify the color of the pseudo confidence interval region. When \code{level} is a vector of values, different shading colors can be specified for each region.} \item{hlines}{optional character string to specify the color of the horizontal reference lines.} \item{refline}{numeric value to specify the location of the vertical \sQuote{reference} line and where the pseudo confidence interval should be centered. If unspecified, the reference line is drawn at the equal- or random-effects model estimate and at zero for meta-regression models (in which case the residuals are plotted) or when directly plotting observed outcomes.} \item{lty}{line type for the pseudo confidence interval region and the reference line. The default is to draw dotted lines (see \code{\link{par}} for other options). Can also be a vector to specify the two line types separately.} \item{pch}{plotting symbol to use for the observed outcomes. By default, a filled circle is used. Can also be a vector of values. See \code{\link{points}} for other options.} \item{pch.fill}{plotting symbol to use for the outcomes filled in by the trim and fill method. By default, an open circle is used. Only relevant when plotting an object created by the \code{\link{trimfill}} function.} \item{col}{optional character string to specify the (border) color of the points. Can also be a vector.} \item{bg}{optional character string to specify the background color of open plot symbols. Can also be a vector.} \item{label}{argument to control the labeling of the points (the default is \code{FALSE}). See \sQuote{Details}.} \item{offset}{argument to control the distance between the points and the corresponding labels.} \item{legend}{logical to indicate whether a legend should be added to the plot (the default is \code{FALSE}). See \sQuote{Details}.} \item{\dots}{other arguments.} } \details{ For equal- and random-effects models (i.e., models not involving moderators), the plot shows the observed effect sizes or outcomes on the x-axis against the corresponding standard errors (i.e., the square root of the sampling variances) on the y-axis. A vertical line indicates the estimate based on the model. A pseudo confidence interval region is drawn around this value with bounds equal to \mjeqn{\pm 1.96 \mbox{SE}}{±1.96*SE}, where \mjeqn{\mbox{SE}}{SE} is the standard error value from the y-axis (assuming \code{level=95}). If \code{addtau2=TRUE} (only for models of class \code{"rma.uni"}), then the bounds of the pseudo confidence interval region are equal to \mjeqn{\pm 1.96 \sqrt{\mbox{SE}^2 + \hat{\tau}^2}}{±1.96*\sqrt(SE^2 + \tau^2)}, where \mjeqn{\hat{\tau}^2}{\tau^2} is the amount of heterogeneity as estimated by the model. For (mixed-effects) meta-regression models (i.e., models involving moderators), the plot shows the residuals on the x-axis against their corresponding standard errors. Either the usual or deleted residuals can be used for that purpose (set via the \code{type} argument). See \code{\link[=residuals.rma]{residuals}} for more details on the different types of residuals. With the \code{atransf} argument, the labels on the x-axis can be transformed with some suitable function. For example, when plotting log odds ratios, one could use \code{transf=exp} to obtain a funnel plot with the values on the x-axis corresponding to the odds ratios. See also \link{transf} for some other useful transformation functions in the context of a meta-analysis. Instead of placing the standard errors on the y-axis, several other options are available by setting the \code{yaxis} argument to: \itemize{ \item \code{yaxis="vi"} for the sampling variances, \item \code{yaxis="seinv"} for the inverse of the standard errors, \item \code{yaxis="vinv"} for the inverse of the sampling variances, \item \code{yaxis="ni"} for the sample sizes, \item \code{yaxis="ninv"} for the inverse of the sample sizes, \item \code{yaxis="sqrtni"} for the square root of the sample sizes, \item \code{yaxis="sqrtninv"} for the inverse square root of the sample sizes, \item \code{yaxis="lni"} for the log of the sample sizes, \item \code{yaxis="wi"} for the weights. } However, only when \code{yaxis="sei"} (the default) will the pseudo confidence region have the expected (upside-down) funnel shape with straight lines. Also, when placing (a function of) the sample sizes on the y-axis or the weights, then the pseudo confidence region cannot be drawn. See Sterne and Egger (2001) for more details on the choice of the y-axis. If the object passed to the function comes from the \code{\link{trimfill}} function, the studies that are filled in by the trim and fill method are also added to the funnel plot. The symbol to use for plotting the filled in studies can be specified via the \code{pch.fill} argument. Arguments \code{col} and \code{bg} can then be of length 2 to specify the (border) color and background color of the observed and filled in studies. One can also directly pass a vector with the observed effect sizes or outcomes (via \code{x}) and the corresponding sampling variances (via \code{vi}), standard errors (via \code{sei}), and/or sample sizes (via \code{ni}) to the function. By default, the vertical reference line is then drawn at zero. The arguments \code{back}, \code{shade}, and \code{hlines} can be set to \code{NULL} to suppress the shading and the horizontal reference line. One can also suppress the funnel by setting \code{refline} to \code{NULL}. With the \code{label} argument, one can control whether points in the plot will be labeled. If \code{label="all"} (or \code{label=TRUE}), all points in the plot will be labeled. If \code{label="out"}, points falling outside of the pseudo confidence region will be labeled. Finally, one can also set this argument to a numeric value (between 1 and \mjseqn{k}) to specify how many of the most extreme points should be labeled (e.g., with \code{label=1} only the most extreme point are labeled, while with \code{label=3}, the most extreme, and the second and third most extreme points are labeled). With the \code{offset} argument, one can adjust the distance between the labels and the corresponding points. By setting the \code{legend} argument to \code{TRUE}, a legend is added to the plot. One can also specify a keyword for this argument to indicate the position of the legend (e.g., \code{legend="topleft"}; see \code{\link{legend}} for options). Finally, this argument can also be a list, with elements \code{x}, \code{y}, \code{inset}, \code{bty}, and \code{bg}, which are passed on as the corresponding arguments to the \code{\link{legend}} function for even more control (elements not specified are set to defaults). The list can also include elements \code{studies} (a logical to indicate whether to include \sQuote{Studies} in the legend; default is \code{TRUE}) and \code{show} (either \code{"pvals"} to show the p-values corresponding to the shade regions, \code{"cis"} to show the confidence interval levels corresponding to the shade regions, or \code{NA} to show neither; default is \code{"pvals"}). } \note{ Placing (a function of) the sample sizes on the y-axis (i.e., using \code{yaxis="ni"}, \code{yaxis="ninv"}, \code{yaxis="sqrtni"}, \code{yaxis="sqrtninv"}, or \code{yaxis="lni"}) is only possible when information about the sample sizes is actually stored within the object passed to the \code{funnel} function. That should automatically be the case when the observed effect sizes or outcomes were computed with the \code{\link{escalc}} function or when the observed effect sizes or outcomes were computed within the model fitting function. On the other hand, this will not be the case when \code{\link{rma.uni}} was used together with the \code{yi} and \code{vi} arguments and the \code{yi} and \code{vi} values were \emph{not} computed with \code{\link{escalc}}. In that case, it is still possible to pass information about the sample sizes to the \code{\link{rma.uni}} function (e.g., use \code{rma.uni(yi, vi, ni=ni, data=dat)}, where data frame \code{dat} includes a variable called \code{ni} with the sample sizes). When using unweighted estimation, using \code{yaxis="wi"} will place all points on a horizontal line. When directly passing a vector with the observed effect sizes or outcomes to the function, \code{yaxis="wi"} is equivalent to \code{yaxis="vinv"}, except that the weights are expressed in percent. Argument \code{slab} and when specifying vectors for arguments \code{pch}, \code{col}, and/or \code{bg} and \code{x} is an object of class \code{"rma"}, the variables specified are assumed to be of the same length as the data passed to the model fitting function (and if the \code{data} argument was used in the original model fit, then the variables will be searched for within this data frame first). Any subsetting and removal of studies with missing values is automatically applied to the variables specified via these arguments. } \value{ A data frame with components: \item{x}{the x-axis coordinates of the points that were plotted.} \item{y}{the y-axis coordinates of the points that were plotted.} \item{slab}{the study labels.} Note that the data frame is returned invisibly. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Light, R. J., & Pillemer, D. B. (1984). \emph{Summing up: The science of reviewing research}. Cambridge, MA: Harvard University Press. Peters, J. L., Sutton, A. J., Jones, D. R., Abrams, K. R., & Rushton, L. (2008). Contour-enhanced meta-analysis funnel plots help distinguish publication bias from other causes of asymmetry. \emph{Journal of Clinical Epidemiology}, \bold{61}(10), 991--996. \verb{https://doi.org/10.1016/j.jclinepi.2007.11.010} Sterne, J. A. C., & Egger, M. (2001). Funnel plots for detecting bias in meta-analysis: Guidelines on choice of axis. \emph{Journal of Clinical Epidemiology}, \bold{54}(10), 1046--1055. \verb{https://doi.org/10.1016/s0895-4356(01)00377-8} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models for which funnel plots can be drawn. \code{\link{trimfill}} for the trim and fill method, \code{\link{regtest}} for the regression test, and \code{\link{ranktest}} for the rank correlation test. } \examples{ ### copy BCG vaccine data into 'dat' dat <- dat.bcg ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) ### fit random-effects model res <- rma(yi, vi, data=dat, slab=paste(author, year, sep=", ")) ### draw a standard funnel plot funnel(res) ### show risk ratio values on x-axis (log scale) funnel(res, atransf=exp) ### label points outside of the pseudo confidence interval region funnel(res, atransf=exp, label="out") ### passing log risk ratios and sampling variances directly to the function ### note: same plot, except that the reference line is centered at zero funnel(dat$yi, dat$vi) ### the with() function can be used to avoid having to retype dat$... over and over with(dat, funnel(yi, vi)) ### can accomplish the same thing by setting refline=0 funnel(res, refline=0) ### adjust the position of the x-axis labels, number of digits, and y-axis limits funnel(res, atransf=exp, at=log(c(.125, .25, .5, 1, 2)), digits=3L, ylim=c(0,.8)) ### contour-enhanced funnel plot centered at 0 (see Peters et al., 2008) funnel(res, level=c(90, 95, 99), shade=c("white", "gray55", "gray75"), refline=0, legend=TRUE) ### same, but show risk ratio values on the x-axis and some further adjustments funnel(res, level=c(90, 95, 99), shade=c("white", "gray55", "gray75"), digits=3L, ylim=c(0,.8), atransf=exp, at=log(c(.125, .25, .5, 1, 2, 4, 8)), refline=0, legend=TRUE) ### same, but show confidence interval levels in the legend funnel(res, level=c(90, 95, 99), shade=c("white", "gray55", "gray75"), digits=3L, ylim=c(0,.8), atransf=exp, at=log(c(.125, .25, .5, 1, 2, 4, 8)), refline=0, legend=list(show="cis")) ### illustrate the use of vectors for 'pch' and 'col' res <- rma(yi, vi, data=dat, subset=2:10) funnel(res, pch=ifelse(yi > -1, 19, 21), col=ifelse(sqrt(vi) > .3, "red", "blue")) ### can add a second funnel via (undocumented) argument refline2 funnel(res, atransf=exp, at=log(c(.125, .25, .5, 1, 2, 4)), digits=3L, ylim=c(0,.8), refline2=0) ### mixed-effects model with absolute latitude in the model res <- rma(yi, vi, mods = ~ ablat, data=dat) ### funnel plot of the residuals funnel(res) ### simulate a large meta-analytic dataset (correlations with rho = 0.2) ### with no heterogeneity or publication bias; then try out different ### versions of the funnel plot gencor <- function(rhoi, ni) { x1 <- rnorm(ni, mean=0, sd=1) x2 <- rnorm(ni, mean=0, sd=1) x3 <- rhoi*x1 + sqrt(1-rhoi^2)*x2 cor(x1, x3) } set.seed(1234) k <- 200 # number of studies to simulate ni <- round(rchisq(k, df=2) * 20 + 20) # simulate sample sizes (skewed distribution) ri <- mapply(gencor, rep(0.2,k), ni) # simulate correlations res <- rma(measure="ZCOR", ri=ri, ni=ni, method="EE") # use r-to-z transformed correlations funnel(res, yaxis="sei") funnel(res, yaxis="vi") funnel(res, yaxis="seinv") funnel(res, yaxis="vinv") funnel(res, yaxis="ni") funnel(res, yaxis="ninv") funnel(res, yaxis="sqrtni") funnel(res, yaxis="sqrtninv") funnel(res, yaxis="lni") funnel(res, yaxis="wi") } \keyword{hplot} metafor/man/methods.confint.rma.Rd0000644000176200001440000000335614505063152016641 0ustar liggesusers\name{methods.confint.rma} \alias{methods.confint.rma} \alias{as.data.frame.confint.rma} \alias{as.data.frame.list.confint.rma} \title{Methods for 'confint.rma' Objects} \description{ Methods for objects of class \code{"confint.rma"} and \code{"list.confint.rma"}. } \usage{ \method{as.data.frame}{confint.rma}(x, \dots) \method{as.data.frame}{list.confint.rma}(x, \dots) } \arguments{ \item{x}{an object of class \code{"confint.rma"} or \code{"list.confint.rma"}.} \item{\dots}{other arguments.} } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \examples{ ### copy data into 'dat' dat <- dat.bcg ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) ### fit random-effects model res <- rma(yi, vi, data=dat) ### get 95% CI for tau^2, tau, I^2, and H^2 sav <- confint(res) sav ### turn object into a regular data frame as.data.frame(sav) ############################################################################ ### copy data into 'dat' dat <- dat.berkey1998 ### construct block diagonal var-cov matrix of the observed outcomes based on variables v1i and v2i V <- vcalc(vi=1, cluster=author, rvars=c(v1i, v2i), data=dat) ### fit multivariate model res <- rma.mv(yi, V, mods = ~ outcome - 1, random = ~ outcome | trial, struct="UN", data=dat) ### get 95% CI for variance components and correlation sav <- confint(res) sav ### turn object into a regular data frame as.data.frame(sav) } \keyword{internal} metafor/man/rma.peto.Rd0000644000176200001440000002667514505063152014517 0ustar liggesusers\name{rma.peto} \alias{rma.peto} \title{Meta-Analysis via Peto's Method} \description{ Function to fit equal-effects models to \mjeqn{2 \times 2}{2x2} table data via Peto's method. See below and the introduction to the \pkg{\link{metafor-package}} for more details on these models. \loadmathjax } \usage{ rma.peto(ai, bi, ci, di, n1i, n2i, data, slab, subset, add=1/2, to="only0", drop00=TRUE, level=95, verbose=FALSE, digits, \dots) } \arguments{ \item{ai}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (upper left cell). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{bi}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (upper right cell). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{ci}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (lower left cell). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{di}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (lower right cell). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{n1i}{vector with the group sizes or row totals (first group). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{n2i}{vector with the group sizes or row totals (second group). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{data}{optional data frame containing the data supplied to the function.} \item{slab}{optional vector with labels for the \mjseqn{k} studies.} \item{subset}{optional (logical or numeric) vector to specify the subset of studies that should be used for the analysis.} \item{add}{non-negative number to specify the amount to add to zero cells when calculating the observed effect sizes of the individual studies. Can also be a vector of two numbers, where the first number is used in the calculation of the observed effect sizes and the second number is used when applying Peto's method. See below and the documentation of the \code{\link{escalc}} function for more details.} \item{to}{character string to specify when the values under \code{add} should be added (either \code{"only0"}, \code{"all"}, \code{"if0all"}, or \code{"none"}). Can also be a character vector, where the first string again applies when calculating the observed effect sizes or outcomes and the second string when applying Peto's method. See below and the documentation of the \code{\link{escalc}} function for more details.} \item{drop00}{logical to specify whether studies with no cases (or only cases) in both groups should be dropped when calculating the observed effect sizes or outcomes (the outcomes for such studies are set to \code{NA}). Can also be a vector of two logicals, where the first applies to the calculation of the observed effect sizes or outcomes and the second when applying Peto's method. See below and the documentation of the \code{\link{escalc}} function for more details.} \item{level}{numeric value between 0 and 100 to specify the confidence interval level (the default is 95; see \link[=misc-options]{here} for details).} \item{verbose}{logical to specify whether output should be generated on the progress of the model fitting (the default is \code{FALSE}).} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is 4. See also \link[=misc-options]{here} for further details on how to control the number of digits in the output.} \item{\dots}{additional arguments.} } \details{ \subsection{Specifying the Data}{ The studies are assumed to provide data in terms of \mjeqn{2 \times 2}{2x2} tables of the form: \tabular{lcccccc}{ \tab \ics \tab outcome 1 \tab \ics \tab outcome 2 \tab \ics \tab total \cr group 1 \tab \ics \tab \code{ai} \tab \ics \tab \code{bi} \tab \ics \tab \code{n1i} \cr group 2 \tab \ics \tab \code{ci} \tab \ics \tab \code{di} \tab \ics \tab \code{n2i}} where \code{ai}, \code{bi}, \code{ci}, and \code{di} denote the cell frequencies and \code{n1i} and \code{n2i} the row totals. For example, in a set of randomized clinical trials (RCTs) or cohort studies, group 1 and group 2 may refer to the treatment/exposed and placebo/control/non-exposed group, respectively, with outcome 1 denoting some event of interest (e.g., death) and outcome 2 its complement. In a set of case-control studies, group 1 and group 2 may refer to the group of cases and the group of controls, with outcome 1 denoting, for example, exposure to some risk factor and outcome 2 non-exposure. } \subsection{Peto's Method}{ An approach for aggregating data of this type was suggested by Peto (see Yusuf et al., 1985). The method provides a weighted estimate of the (log) odds ratio under an equal-effects model. The method is particularly advantageous when the event of interest is rare, but it should only be used when the group sizes within the individual studies are not too dissimilar and the effect sizes are generally small (Greenland & Salvan, 1990; Sweeting et al., 2004; Bradburn et al., 2007). Note that the printed results are given both in terms of the log and the raw units (for easier interpretation). } \subsection{Observed Effect Sizes or Outcomes of the Individual Studies}{ Peto's method itself does not require the calculation of the observed log odds ratios of the individual studies and directly makes use of the cell frequencies in the \mjeqn{2 \times 2}{2x2} tables. Zero cells are not a problem (except in extreme cases, such as when one of the two outcomes never occurs in any of the tables). Therefore, it is unnecessary to add some constant to the cell counts when there are zero cells. However, for plotting and various other functions, it is necessary to calculate the observed log odds ratios for the \mjseqn{k} studies. Here, zero cells can be problematic, so adding a constant value to the cell counts ensures that all \mjseqn{k} values can be calculated. The \code{add} and \code{to} arguments are used to specify what value should be added to the cell frequencies and under what circumstances when calculating the observed log odds ratios and when applying Peto's method. Similarly, the \code{drop00} argument is used to specify how studies with no cases (or only cases) in both groups should be handled. The documentation of the \code{\link{escalc}} function explains how the \code{add}, \code{to}, and \code{drop00} arguments work. If only a single value for these arguments is specified (as per default), then these values are used when calculating the observed log odds ratios and no adjustment to the cell counts is made when applying Peto's method. Alternatively, when specifying two values for these arguments, the first value applies when calculating the observed log odds ratios and the second value when applying Peto's method. Note that \code{drop00} is set to \code{TRUE} by default. Therefore, the observed log odds ratios for studies where \code{ai=ci=0} or \code{bi=di=0} are set to \code{NA}. When applying Peto's method, such studies are not explicitly dropped (unless the second value of \code{drop00} argument is also set to \code{TRUE}), but this is practically not necessary, as they do not actually influence the results (assuming no adjustment to the cell counts are made when applying Peto's method). } } \value{ An object of class \code{c("rma.peto","rma")}. The object is a list containing the following components: \item{beta}{aggregated log odds ratio.} \item{se}{standard error of the aggregated value.} \item{zval}{test statistics of the aggregated value.} \item{pval}{corresponding p-value.} \item{ci.lb}{lower bound of the confidence interval.} \item{ci.ub}{upper bound of the confidence interval.} \item{QE}{test statistic of the test for heterogeneity.} \item{QEp}{corresponding p-value.} \item{k}{number of studies included in the analysis.} \item{yi, vi}{the vector of individual log odds ratios and corresponding sampling variances.} \item{fit.stats}{a list with the log-likelihood, deviance, AIC, BIC, and AICc values under the unrestricted and restricted likelihood.} \item{\dots}{some additional elements/values.} } \section{Methods}{ The results of the fitted model are formatted and printed with the \code{\link[=print.rma.peto]{print}} function. If fit statistics should also be given, use \code{\link[=summary.rma]{summary}} (or use the \code{\link[=fitstats.rma]{fitstats}} function to extract them). The \code{\link[=residuals.rma]{residuals}}, \code{\link[=rstandard.rma.peto]{rstandard}}, and \code{\link[=rstudent.rma.peto]{rstudent}} functions extract raw and standardized residuals. Leave-one-out diagnostics can be obtained with \code{\link[=leave1out.rma.peto]{leave1out}}. Forest, funnel, radial, \enc{L'Abbé}{L'Abbe}, and Baujat plots can be obtained with \code{\link[=forest.rma]{forest}}, \code{\link[=funnel.rma]{funnel}}, \code{\link[=radial.rma]{radial}}, \code{\link[=labbe.rma]{labbe}}, and \code{\link[=baujat.rma]{baujat}}. The \code{\link[=qqnorm.rma.peto]{qqnorm}} function provides normal QQ plots of the standardized residuals. One can also just call \code{\link[=plot.rma.peto]{plot}} on the fitted model object to obtain various plots at once. A cumulative meta-analysis (i.e., adding one observation at a time) can be obtained with \code{\link[=cumul.rma.peto]{cumul}}. Other extractor functions include \code{\link[=coef.rma]{coef}}, \code{\link[=vcov.rma]{vcov}}, \code{\link[=logLik.rma]{logLik}}, \code{\link[=deviance.rma]{deviance}}, \code{\link[=AIC.rma]{AIC}}, and \code{\link[=BIC.rma]{BIC}}. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Bradburn, M. J., Deeks, J. J., Berlin, J. A., & Localio, A. R. (2007). Much ado about nothing: A comparison of the performance of meta-analytical methods with rare events. \emph{Statistics in Medicine}, \bold{26}(1), 53--77. \verb{https://doi.org/10.1002/sim.2528} Greenland, S., & Salvan, A. (1990). Bias in the one-step method for pooling study results. \emph{Statistics in Medicine}, \bold{9}(3), 247--252. \verb{https://doi.org/10.1002/sim.4780090307} Sweeting, M. J., Sutton, A. J., & Lambert, P. C. (2004). What to add to nothing? Use and avoidance of continuity corrections in meta-analysis of sparse data. \emph{Statistics in Medicine}, \bold{23}(9), 1351--1375. \verb{https://doi.org/10.1002/sim.1761} Yusuf, S., Peto, R., Lewis, J., Collins, R., & Sleight, P. (1985). Beta blockade during and after myocardial infarction: An overview of the randomized trials. \emph{Progress in Cardiovascular Disease}, \bold{27}(5), 335--371. \verb{https://doi.org/10.1016/s0033-0620(85)80003-7} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.glmm}}, \code{\link{rma.mh}}, and \code{\link{rma.mv}} for other model fitting functions. \code{\link[metadat]{dat.collins1985a}}, \code{\link[metadat]{dat.collins1985b}}, and \code{\link[metadat]{dat.yusuf1985}} for further examples of the use of the \code{rma.peto} function. } \examples{ ### meta-analysis of the (log) odds ratios using Peto's method rma.peto(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) } \keyword{models} metafor/man/model.matrix.rma.Rd0000644000176200001440000000264014505063152016135 0ustar liggesusers\name{model.matrix.rma} \alias{model.matrix} \alias{model.matrix.rma} \title{Extract the Model Matrix from 'rma' Objects} \description{ Function to extract the model matrix from objects of class \code{"rma"}. } \usage{ \method{model.matrix}{rma}(object, asdf, \dots) } \arguments{ \item{object}{an object of class \code{"rma"}.} \item{asdf}{logical to specify whether the model matrix should be turned into a data frame (the default is \code{FALSE}).} \item{\dots}{other arguments.} } \value{ The model matrix. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models for which a model matrix can be extracted. \code{\link[=fitted.rma]{fitted}} for a function to extract the fitted values. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit mixed-effects model with absolute latitude and publication year as moderators res <- rma(yi, vi, mods = ~ ablat + year, data=dat) ### extract the model matrix model.matrix(res) } \keyword{models} metafor/man/print.fsn.Rd0000644000176200001440000000200214505063152014665 0ustar liggesusers\name{print.fsn} \alias{print.fsn} \title{Print Method for 'fsn' Objects} \description{ Function to print objects of class \code{"fsn"}. } \usage{ \method{print}{fsn}(x, digits=x$digits, \dots) } \arguments{ \item{x}{an object of class \code{"fsn"} obtained with \code{\link{fsn}}.} \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} \item{\dots}{other arguments.} } \details{ The output shows the results from the fail-safe N calculation. } \value{ The function does not return an object. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{fsn}} for the function to create \code{fsn} objects. } \keyword{print} metafor/man/print.gosh.rma.Rd0000644000176200001440000000241514505063152015625 0ustar liggesusers\name{print.gosh.rma} \alias{print.gosh.rma} \title{Print Method for 'gosh.rma' Objects} \description{ Function to print objects of class \code{"gosh.rma"}. } \usage{ \method{print}{gosh.rma}(x, digits=x$digits, \dots) } \arguments{ \item{x}{an object of class \code{"gosh.rma"} obtained with \code{\link{gosh}}.} \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} \item{\dots}{other arguments.} } \details{ The output shows how many model fits were attempted, how many succeeded, and summary statistics (i.e., the mean, minimum, first quartile, median, third quartile, and maximum) for the various measures of (residual) heterogeneity and the model coefficient(s) computed across all of the subsets. } \value{ The function does not return an object. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{gosh}} for the function to create \code{gosh.rma} objects. } \keyword{print} metafor/man/ranef.Rd0000644000176200001440000001204114505063152014043 0ustar liggesusers\name{ranef} \alias{ranef} \alias{ranef.rma.uni} \alias{ranef.rma.mv} \title{Best Linear Unbiased Predictions for 'rma.uni' and 'rma.mv' Objects} \description{ Functions to compute best linear unbiased predictions (BLUPs) of the random effects for objects of class \code{"rma.uni"} and \code{"rma.mv"}. Corresponding standard errors and prediction interval bounds are also provided. \loadmathjax } \usage{ \method{ranef}{rma.uni}(object, level, digits, transf, targs, \dots) \method{ranef}{rma.mv}(object, level, digits, transf, targs, verbose=FALSE, \dots) } \arguments{ \item{object}{an object of class \code{"rma.uni"} or \code{"rma.mv"}.} \item{level}{numeric value between 0 and 100 to specify the prediction interval level (see \link[=misc-options]{here} for details). If unspecified, the default is to take the value from the object.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} \item{transf}{optional argument to specify a function to transform the predicted values and interval bounds (e.g., \code{transf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{targs}{optional arguments needed by the function specified under \code{transf}.} \item{verbose}{logical to specify whether output should be generated on the progress of the computations (the default is \code{FALSE}).} \item{\dots}{other arguments.} } \value{ For objects of class \code{"rma.uni"}, an object of class \code{"list.rma"}. The object is a list containing the following components: \item{pred}{predicted values.} \item{se}{corresponding standard errors.} \item{pi.lb}{lower bound of the prediction intervals.} \item{pi.ub}{upper bound of the prediction intervals.} \item{\dots}{some additional elements/values.} The object is formatted and printed with the \code{\link[=print.list.rma]{print}} function. To format the results as a data frame, one can use the \code{\link[=as.data.frame.list.rma]{as.data.frame}} function. For objects of class \code{"rma.mv"}, a list of data frames with the same components as described above. } \note{ For best linear unbiased predictions that combine the fitted values based on the fixed effects and the estimated contributions of the random effects, see \code{\link[=blup.rma.uni]{blup}}. For predicted/fitted values that are based only on the fixed effects of the model, see \code{\link[=fitted.rma]{fitted}} and \code{\link[=predict.rma]{predict}}. Equal-effects models do not contain random study effects. The BLUPs for these models will therefore be 0. When using the \code{transf} argument, the transformation is applied to the predicted values and the corresponding interval bounds. The standard errors are then set equal to \code{NA} and are omitted from the printed output. By default, a standard normal distribution is used to construct the prediction intervals. When the model was fitted with \code{test="t"} or \code{test="knha"}, then a t-distribution with \mjseqn{k-p} degrees of freedom is used. To be precise, it should be noted that the function actually computes empirical BLUPs (eBLUPs), since the predicted values are a function of the estimated variance component(s). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Kackar, R. N., & Harville, D. A. (1981). Unbiasedness of two-stage estimation and prediction procedures for mixed linear models. Communications in Statistics, Theory and Methods, \bold{10}(13), 1249--1261. \verb{https://doi.org/10.1080/03610928108828108} Raudenbush, S. W., & Bryk, A. S. (1985). Empirical Bayes meta-analysis. \emph{Journal of Educational Statistics}, \bold{10}(2), 75--98. \verb{https://doi.org/10.3102/10769986010002075} Robinson, G. K. (1991). That BLUP is a good thing: The estimation of random effects. \emph{Statistical Science}, \bold{6}(1), 15--32. \verb{https://doi.org/10.1214/ss/1177011926} Searle, S. R., Casella, G., & McCulloch, C. E. (1992). \emph{Variance components}. Hoboken, NJ: Wiley. Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}} and \code{\link{rma.mv}} for functions to fit models for which BLUPs of the random effects can be computed. \code{\link[=predict.rma]{predict}} and \code{\link[=fitted.rma]{fitted}} for functions to compute the predicted/fitted values based only on the fixed effects and \code{\link[=blup.rma.uni]{blup}} for a function to compute BLUPs that combine the fitted values and predicted random effects. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### meta-analysis of the log risk ratios using a random-effects model res <- rma(yi, vi, data=dat) ### BLUPs of the random effects ranef(res) } \keyword{models} metafor/man/print.regtest.rma.Rd0000644000176200001440000000347114505063152016345 0ustar liggesusers\name{print.regtest} \alias{print.regtest} \title{Print Method for 'regtest' Objects} \description{ Function to print objects of class \code{"regtest"}. } \usage{ \method{print}{regtest}(x, digits=x$digits, ret.fit=x$ret.fit, \dots) } \arguments{ \item{x}{an object of class \code{"regtest"} obtained with \code{\link{regtest}}.} \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} \item{ret.fit}{logical to specify whether the full results from the fitted model should also be returned. If unspecified, the default is to take the value from the object.} \item{\dots}{other arguments.} } \details{ The output includes: \itemize{ \item the model used for the regression test \item the predictor used for the regression test \item the results from the fitted model (only when \code{ret.fit=TRUE}) \item the test statistic of the test that the predictor is unreleated to the outcomes \item the degrees of freedom of the test statistic (only if the test statistic follows a t-distribution) \item the corresponding p-value \item the \sQuote{limit estimate} and its corresponding CI (only for predictors \code{"sei"} \code{"vi"}, \code{"ninv"}, or \code{"sqrtninv"} and when the model does not contain any additional moderators) } } \value{ The function does not return an object. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{regtest}} for the function to create \code{regtest} objects. } \keyword{print} metafor/man/simulate.rma.Rd0000644000176200001440000000535714505063152015365 0ustar liggesusers\name{simulate.rma} \alias{simulate} \alias{simulate.rma} \title{Simulate Method for 'rma' Objects} \description{ Function to simulate effect sizes or outcomes based on \code{"rma"} model objects. } \usage{ \method{simulate}{rma}(object, nsim=1, seed=NULL, olim, \dots) } \arguments{ \item{object}{an object of class \code{"rma"}.} \item{nsim}{number of response vectors to simulate (defaults to 1).} \item{seed}{an object to specify if and how the random number generator should be initialized (\sQuote{seeded}). Either \code{NULL} or an integer that will be used in a call to \code{set.seed} before simulating the response vectors. If set, the value is saved as the \code{"seed"} attribute of the returned value. The default, \code{NULL} will not change the random generator state, and return \code{\link{.Random.seed}} as the \code{"seed"} attribute; see \sQuote{Value}.} \item{olim}{optional argument to specify observation/outcome limits for the simulated values. If unspecified, no limits are used.} \item{\dots}{other arguments.} } \details{ The model specified via \code{object} must be a model fitted with either the \code{\link{rma.uni}} or \code{\link{rma.mv}} functions. } \value{ A data frame with \code{nsim} columns with the simulated effect sizes or outcomes. The data frame comes with an attribute \code{"seed"}. If argument \code{seed} is \code{NULL}, the attribute is the value of \code{\link{.Random.seed}} before the simulation was started; otherwise it is the value of the \code{seed} argument with a \code{"kind"} attribute with value \code{as.list(RNGkind())}. } \note{ If the outcome measure used for the analysis is bounded (e.g., correlations are bounded between -1 and +1, proportions are bounded between 0 and 1), one can use the \code{olim} argument to enforce those observation/outcome limits when simulating values (simulated values cannot exceed those bounds then). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}} and \code{\link{rma.mv}} for functions to fit models for which simulated effect sizes or outcomes can be generated. } \examples{ ### copy BCG vaccine data into 'dat' dat <- dat.bcg ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) dat ### fit random-effects model res <- rma(yi, vi, data=dat) res ### simulate 5 sets of new outcomes based on the fitted model newdat <- simulate(res, nsim=5, seed=1234) newdat } \keyword{datagen} metafor/man/methods.escalc.Rd0000644000176200001440000000264614505063152015656 0ustar liggesusers\name{methods.escalc} \alias{methods.escalc} \alias{[.escalc} \alias{$<-.escalc} \alias{cbind.escalc} \alias{rbind.escalc} \title{Methods for 'escalc' Objects} \description{ Methods for objects of class \code{"escalc"}. } \usage{ \method{[}{escalc}(x, i, \dots) \method{$}{escalc}(x, name) <- value \method{cbind}{escalc}(\dots, deparse.level=1) \method{rbind}{escalc}(\dots, deparse.level=1) } \arguments{ \item{x}{an object of class \code{"escalc"}.} \item{\dots}{other arguments.} } \note{ For the \code{`[`} method, any variables specified as part of the \code{i} argument will be searched for within object \code{x} first (see \sQuote{Examples}). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### select rows where variable 'alloc' is equal to 'random' dat[dat$alloc == "random",] ### variables specified are automatically searched for within the object itself dat[alloc == "random",] ### note: this behavior is specific to 'escalc' objects; this doesn't work for regular data frames } \keyword{internal} metafor/man/hc.Rd0000644000176200001440000001112714505063152013346 0ustar liggesusers\name{hc} \alias{hc} \alias{hc.rma.uni} \title{Meta-Analysis based on the Method by Henmi and Copas (2010)} \description{ Function to obtain an estimate of the average true outcome and corresponding confidence interval under a random-effects model using the method described by Henmi and Copas (2010). } \usage{ hc(object, \dots) \method{hc}{rma.uni}(object, digits, transf, targs, control, \dots) } \arguments{ \item{object}{an object of class \code{"rma.uni"}.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} \item{transf}{optional argument to specify a function to transform the estimate and the corresponding interval bounds (e.g., \code{transf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{targs}{optional arguments needed by the function specified under \code{transf}.} \item{control}{list of control values for the iterative algorithm. If unspecified, default values are used. See \sQuote{Note}.} \item{\dots}{other arguments.} } \details{ The model specified via \code{object} must be a model without moderators (i.e., either an equal- or a random-effects model). When using the usual method for fitting a random-effects model (i.e., weighted estimation with inverse-variance weights), the weights assigned to smaller and larger studies become more uniform as the amount of heterogeneity increases. As a consequence, the estimated average outcome could become increasingly biased under certain forms of publication bias (where smaller studies on one side of the funnel plot are missing). The method by Henmi and Copas (2010) counteracts this problem by providing an estimate of the average true outcome that is based on inverse-variance weights as used under an equal-effects model, which are not affected by the amount of heterogeneity. The amount of heterogeneity is still estimated (with the DerSimonian-Laird estimator) and incorporated into the standard error of the estimated average outcome and the corresponding confidence interval. Currently, there is only a method for handling objects of class \code{"rma.uni"} with the \code{hc} function. It therefore provides a method for conducting a sensitivity analysis after the model has been fitted with the \code{\link{rma.uni}} function. } \value{ An object of class \code{"hc.rma.uni"}. The object is a list containing the following components: \item{beta}{estimated average true outcome.} \item{se}{corresponding standard error.} \item{ci.lb}{lower bound of the confidence intervals for the average true outcome.} \item{ci.ub}{upper bound of the confidence intervals for the average true outcome.} \item{\dots}{some additional elements/values.} The results are formatted and printed with the \code{\link[=print.hc.rma.uni]{print}} function. } \note{ The method makes use of the \code{\link{uniroot}} function. By default, the desired accuracy is set equal to \code{.Machine$double.eps^0.25} and the maximum number of iterations to \code{1000}. The desired accuracy (\code{tol}) and the maximum number of iterations (\code{maxiter}) can be adjusted with the \code{control} argument (i.e., \code{control=list(tol=value, maxiter=value)}). } \author{ Original code by Henmi and Copas (2010). Corrected for typos by Michael Dewey (\email{lists@dewey.myzen.co.uk}). Incorporated into the package with some small adjustments for consistency with the other functions in the package by Wolfgang Viechtbauer (\email{wvb@metafor-project.org}). } \references{ Henmi, M., & Copas, J. B. (2010). Confidence intervals for random effects meta-analysis and robustness to publication bias. \emph{Statistics in Medicine}, \bold{29}(29), 2969--2983. \verb{https://doi.org/10.1002/sim.4029} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}} for the function to fit \code{rma.uni} models. } \examples{ ### calculate log odds ratios and corresponding sampling variances dat <- escalc(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat.lee2004) dat ### meta-analysis based on log odds ratios res <- rma(yi, vi, data=dat) res ### funnel plot as in Henmi and Copas (2010) funnel(res, yaxis="seinv", refline=0, xlim=c(-3,3), ylim=c(.5,3.5), steps=7, digits=1, back="white") ### use method by Henmi and Copas (2010) as a sensitivity analysis hc(res) ### back-transform results to odds ratio scale hc(res, transf=exp) } \keyword{htest} metafor/man/to.long.Rd0000644000176200001440000001771714505063152014347 0ustar liggesusers\name{to.long} \alias{to.long} \title{Convert Data from Vector to Long Format} \description{ Function to convert summary data in vector format to the corresponding long format. \loadmathjax } \usage{ to.long(measure, ai, bi, ci, di, n1i, n2i, x1i, x2i, t1i, t2i, m1i, m2i, sd1i, sd2i, xi, mi, ri, ti, sdi, ni, data, slab, subset, add=1/2, to="none", drop00=FALSE, vlong=FALSE, append=TRUE, var.names) } \arguments{ \item{measure}{a character string to specify the effect size or outcome measure corresponding to the summary data supplied. See \sQuote{Details} and the documentation of the \code{\link{escalc}} function for possible options.} \item{ai}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (upper left cell).} \item{bi}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (upper right cell).} \item{ci}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (lower left cell).} \item{di}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (lower right cell).} \item{n1i}{vector with the group sizes or row totals (first group/row).} \item{n2i}{vector with the group sizes or row totals (second group/row).} \item{x1i}{vector with the number of events (first group).} \item{x2i}{vector with the number of events (second group).} \item{t1i}{vector with the total person-times (first group).} \item{t2i}{vector with the total person-times (second group).} \item{m1i}{vector with the means (first group or time point).} \item{m2i}{vector with the means (second group or time point).} \item{sd1i}{vector with the standard deviations (first group or time point).} \item{sd2i}{vector with the standard deviations (second group or time point).} \item{xi}{vector with the frequencies of the event of interest.} \item{mi}{vector with the frequencies of the complement of the event of interest or the group means.} \item{ri}{vector with the raw correlation coefficients.} \item{ti}{vector with the total person-times.} \item{sdi}{vector with the standard deviations.} \item{ni}{vector with the sample/group sizes.} \item{data}{optional data frame containing the variables given to the arguments above.} \item{slab}{optional vector with labels for the studies.} \item{subset}{optional (logical or numeric) vector to specify the subset of studies that should included in the data frame returned by the function.} \item{add}{see the documentation of the \code{\link{escalc}} function.} \item{to}{see the documentation of the \code{\link{escalc}} function.} \item{drop00}{see the documentation of the \code{\link{escalc}} function.} \item{vlong}{optional logical whether a very long format should be used (only relevant for \mjeqn{2 \times 2}{2x2} or \mjeqn{1 \times 2}{1x2} table data).} \item{append}{logical to specify whether the data frame specified via the \code{data} argument (if one has been specified) should be returned together with the long format data (the default is \code{TRUE}). Can also be a character or numeric vector to indicate which variables from \code{data} to append.} \item{var.names}{optional character vector with variable names (the length depends on the data type). If unspecified, the function sets appropriate variable names by default.} } \details{ The \code{\link{escalc}} function describes a wide variety of effect sizes or outcome measures that can be computed for a meta-analysis. The summary data used to compute those measures are typically contained in vectors, each element corresponding to a study. The \code{to.long} function takes this information and constructs a long format dataset from these data. For example, in various fields (such as the health and medical sciences), the response variable measured is often dichotomous (binary), so that the data from a study comparing two different groups can be expressed in terms of a \mjeqn{2 \times 2}{2x2} table, such as: \tabular{lcccccc}{ \tab \ics \tab outcome 1 \tab \ics \tab outcome 2 \tab \ics \tab total \cr group 1 \tab \ics \tab \code{ai} \tab \ics \tab \code{bi} \tab \ics \tab \code{n1i} \cr group 2 \tab \ics \tab \code{ci} \tab \ics \tab \code{di} \tab \ics \tab \code{n2i}} where \code{ai}, \code{bi}, \code{ci}, and \code{di} denote the cell frequencies (i.e., the number of individuals falling into a particular category) and \code{n1i} and \code{n2i} the row totals (i.e., the group sizes). The cell frequencies in \mjseqn{k} such \mjeqn{2 \times 2}{2x2} tables can be specified via the \code{ai}, \code{bi}, \code{ci}, and \code{di} arguments (or alternatively, via the \code{ai}, \code{ci}, \code{n1i}, and \code{n2i} arguments). The function then creates the corresponding long format dataset. The \code{measure} argument should then be set equal to one of the outcome measures that can be computed based on this type of data, such as \code{"RR"}, \code{"OR"}, \code{"RD"} (it is not relevant which specific measure is chosen, as long as it corresponds to the specified summary data). See the documentation of the \code{\link{escalc}} function for more details on the types of data formats available. The long format for data of this type consists of two rows per study, a factor indicating the study (default name \code{study}), a dummy variable indicating the group (default name \code{group}, coded as 1 and 2), and two variables indicating the number of individuals experiencing outcome 1 or outcome 2 (default names \code{out1} and \code{out2}). Alternatively, if \code{vlong=TRUE}, then the long format consists of four rows per study, a factor indicating the study (default name \code{study}), a dummy variable indicating the group (default name \code{group}, coded as 1 and 2), a dummy variable indicating the outcome (default name \code{outcome}, coded as 1 and 2), and a variable indicating the frequency of the respective outcome (default name \code{freq}). The default variable names can be changed via the \code{var.names} argument (must be of the appropriate length, depending on the data type). The examples below illustrate the use of this function. } \value{ A data frame with either \mjseqn{k}, \mjeqn{2 \times k}{2*k}, or \mjeqn{4 \times k}{4*k} rows and an appropriate number of columns (depending on the data type) with the data in long format. If \code{append=TRUE} and a data frame was specified via the \code{data} argument, then the data in long format are appended to the original data frame (with rows repeated an appropriate number of times). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{escalc}} for a function to compute observed effect sizes or outcomes (and corresponding sampling variances) based on similar inputs. \code{\link{to.table}} for a function to turn similar inputs into tabular form. } \examples{ ### convert data to long format dat.bcg dat.long <- to.long(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) dat.long ### extra long format dat <- to.long(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, vlong=TRUE) dat ### select variables to append dat.long <- to.long(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, append=c("author","year")) dat.long dat.long <- to.long(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, append=2:3) dat.long ### convert data to long format dat.long <- to.long(measure="IRR", x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, data=dat.hart1999, var.names=c("id", "group", "events", "ptime")) dat.long ### convert data to long format dat.long <- to.long(measure="MD", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat.normand1999, var.names=c("id", "group", "mean", "sd", "n")) dat.long } \keyword{manip} metafor/man/plot.rma.uni.selmodel.Rd0000644000176200001440000001200014505063152017074 0ustar liggesusers\name{plot.rma.uni.selmodel} \alias{plot.rma.uni.selmodel} \title{Plot Method for 'plot.rma.uni.selmodel' Objects} \description{ Function to plot objects of class \code{"plot.rma.uni.selmodel"}. \loadmathjax } \usage{ \method{plot}{rma.uni.selmodel}(x, xlim, ylim, n=1000, prec="max", scale=FALSE, ci=FALSE, reps=1000, shade=TRUE, rug=TRUE, add=FALSE, lty=c("solid","dotted"), lwd=c(2,1), \dots) } \arguments{ \item{x}{an object of class \code{"rma.uni.selmodel"} obtained with \code{\link{selmodel}}.} \item{xlim}{x-axis limits. Essentially the range of p-values for which the selection function should be drawn. If unspecified, the function sets the limits automatically.} \item{ylim}{y-axis limits. If unspecified, the function sets the limits automatically.} \item{n}{numeric value to specify for how many p-values within the x-axis limits the function value should be computed (the default is 1000).} \item{prec}{either a character string (with options \code{"max"}, \code{"min"}, \code{"mean"}, or \code{"median"}) or a numeric value. See \sQuote{Details}.} \item{scale}{logical to specify whether the function values should be rescaled to a 0 to 1 range (the default is \code{FALSE}).} \item{ci}{logical to specify whether a confidence interval should be drawn around the selection function (the default is \code{FALSE}). Can also be a string (with options \code{"boot"} or \code{"wald"}). See \sQuote{Details}.} \item{reps}{numeric value to specify the number of bootstrap samples to draw for generating the confidence interval bounds (the default is 1000).} \item{shade}{logical to indicate whether the confidence interval region should be shaded (the default is \code{TRUE}). Can also be a character vector to specify the color for the shading.} \item{rug}{logical to specify whether the observed p-values should be added as tick marks on the x-axis (the default is \code{TRUE}).} \item{add}{logical to specify whether the function should be added to an existing plot (the default is \code{FALSE}).} \item{lty}{the line types for the selection function and the confidence interval bounds.} \item{lwd}{the line widths for the selection function and the confidence interval bounds.} \item{\dots}{other arguments.} } \details{ The function can be used to draw the estimated selection function based on objects of class \code{"plot.rma.uni.selmodel"}. When the selection function incorporates a measure of precision (which, strictly speaking, is really a measure of imprecision), one can specify for which level of precision the selection function should be drawn. When \code{prec="max"}, then the function is drawn for the \emph{least} precise study (maximum imprecision), when \code{prec="min"}, then the function is drawn for the \emph{most} precise study (minimum imprecision), while \code{prec="mean"} and \code{prec="median"} will show the function for the mean and median level of imprecision, respectively. Alternatively, one can specify a numeric value for argument \code{prec} to specify the precision value (where \code{prec="max"} corresponds to \code{prec=1} and higher levels of precision to \code{prec} values below 1). When \code{ci=TRUE} (or equivalently, \code{ci="boot"}), a confidence interval is drawn around the selection function. The bounds of this interval are generated using parametric bootstrapping, with argument \code{reps} controlling the number of bootstrap samples to draw for generating the confidence interval bounds. When both \code{n} and \code{reps} are large, constructing the confidence interval can take some time. For models where the selection function involves a single \mjseqn{\delta} parameter, one can also set \code{ci="wald"}, in which case the confidence interval will be constructed based on the Wald-type CI of the \mjseqn{\delta} parameter (doing so is much quicker than using parametric bootstrapping). This option is also available for step function models (even if they involve multiple \mjseqn{\delta} parameters). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{selmodel}} for the function to fit models for which the estimated selection function can be drawn. } \examples{ ### copy data into 'dat' and examine data dat <- dat.hackshaw1998 ### fit random-effects model using the log odds ratios res <- rma(yi, vi, data=dat, method="ML") res ### fit step selection model sel1 <- selmodel(res, type="stepfun", steps=c(0.05, 0.10, 0.50, 1.00)) ### plot selection function plot(sel1, scale=TRUE) ### fit negative exponential selection model sel2 <- selmodel(res, type="negexp") ### add selection function to the existing plot plot(sel2, add=TRUE, col="blue") ### plot selection function with CI plot(sel1, ci="wald") ### plot selection function with CI plot(sel2, ci="wald") } \keyword{hplot} metafor/man/vec2mat.Rd0000644000176200001440000000261014505063152014312 0ustar liggesusers\name{vec2mat} \alias{vec2mat} \title{Convert a Vector into a Square Matrix} \description{ Function to convert a vector into a square matrix by filling up the lower triangular part of the matrix. } \usage{ vec2mat(x, diag=FALSE, corr=!diag, dimnames) } \arguments{ \item{x}{a vector of the correct length.} \item{diag}{logical to specify whether the vector also contains the diagonal values of the lower triangular part of the matrix (the default is \code{FALSE}).} \item{corr}{logical to specify whether the diagonal of the matrix should be replaced with 1's (the default is to do this when \code{diag=FALSE}).} \item{dimnames}{optional vector of the correct length with the dimension names of the matrix.} } \details{ The values in \code{x} are filled into the lower triangular part of a square matrix with the appropriate dimensions (which are determined based on the length of \code{x}). If \code{diag=TRUE}, then \code{x} is assumed to also contain the diagonal values of the lower triangular part of the matrix. If \code{corr=TRUE}, then the diagonal of the matrix is replaced with 1's. } \value{ A matrix. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \examples{ vec2mat(1:6, corr=FALSE) vec2mat(seq(0.2, 0.7, by=0.1), corr=TRUE) vec2mat(1:10, diag=TRUE) vec2mat(1:6, corr=FALSE, dimnames=c("A","B","C","D")) } \keyword{manip} metafor/man/formula.rma.Rd0000644000176200001440000000304514505063152015177 0ustar liggesusers\name{formula.rma} \alias{formula} \alias{formula.rma} \title{Extract the Model Formula from 'rma' Objects} \description{ Function to extract the model formula from objects of class \code{"rma"}. } \usage{ \method{formula}{rma}(x, type="mods", \dots) } \arguments{ \item{x}{an object of class \code{"rma"}.} \item{type}{the formula which should be returned; either \code{"mods"} (default), \code{"yi"} (in case argument \code{yi} was used to specify a formula), or \code{"scale"} (only for location-scale models).} \item{\dots}{other arguments.} } \value{ The requested formula. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models for which a model formula can be extracted. } \examples{ ### copy BCG vaccine data into 'dat' dat <- dat.bcg ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, slab=paste(author, ", ", year, sep="")) ### mixed-effects meta-regression model res <- rma(yi, vi, mods = ~ ablat + alloc, data=dat) formula(res, type="mods") ### specify moderators via 'yi' argument res <- rma(yi ~ ablat + alloc, vi, data=dat) formula(res, type="yi") } \keyword{models} metafor/man/misc-options.Rd0000644000176200001440000003472314505063152015407 0ustar liggesusers\name{misc-options} \alias{misc-options} \alias{misc_options} \title{Miscellaneous Options and Features} \description{ This page documents some miscellaneous options and features that do not fit very well elsewhere. \loadmathjax } \details{ \subsection{Specifying the Confidence Level}{ Several functions in the \pkg{metafor} package have a \code{level} argument for specifying the confidence level when calculating confidence (and prediction) intervals. The default is to use a 95\% level throughout the package by convention. Note that values \mjseqn{>=1} are treated as coverage percentages, values between 0.5 and 1 as coverage proportions, and values below 0.5 as (two-sided) alpha values, so \code{level=95} is the same as \code{level=.95} and \code{level=.05} (but \code{level=0} is always treated as a 0\% confidence level). } \subsection{Controlling the Number of Digits in the Output}{ Many functions in the \pkg{metafor} package have a \code{digits} argument, which can be used to control the number of digits that are displayed in the output when printing numeric values. For more control over the displayed output, one can set this argument to a named vector of the form: \preformatted{digits=c(est=2, se=3, test=2, pval=3, ci=2, var=3, sevar=3, fit=3, het=3)} where the elements control the displayed number of digits for various aspects of the output, namely: \itemize{ \item \code{est} for estimates (e.g., effect sizes, model coefficients, predicted values), \item \code{se} for standard errors, \item \code{test} for test statistics, \item \code{pval} for p-values, \item \code{ci} for confidence/prediction interval bounds, \item \code{var} for sampling variances and variance components, \item \code{sevar} for standard errors thereof, \item \code{fit} for fit statistics, \item \code{het} for heterogeneity statistics. } Instead of setting this argument in each function call, one can use \code{setmfopt(digits = ...)} to set the desired number of digits for the various elements (see \code{\link{mfopt}} for getting and setting package options). For example, \code{setmfopt(digits = c(est=2, se=3, test=2, pval=3, ci=2, var=3, sevar=3, fit=3, het=3))} could be a sensible choice when analyzing various types of standardized effect size measures. } \subsection{Styled Output with the crayon Package}{ The \href{https://cran.r-project.org/package=crayon}{crayon} package provides a way to create colored output. The \pkg{metafor} package is designed to automatically make use of this feature when the \code{crayon} package is installed (\code{install.packages("crayon")}) and loaded (\code{library(crayon)}). Note that this only works on terminals that support \sQuote{ANSI} color/highlight codes (e.g., not under RGui on Windows or R.app on macOS, but the RStudio console and all modern terminals should support this). The default color theme that is used is quite plain, but should work with a light or dark colored background. One can modify the color theme with \code{setmfopt(style = ...)}, where \code{...} is a list whose elements specify the styles for various parts of the output (see below for some examples and the documentation of the \code{crayon} package for the syntax to specify styles). The following elements are recognized: \itemize{ \item \code{header} for the header of tables (underlined by default), \item \code{body1} for odd numbered rows in the body of tables, \item \code{body2} for even numbered rows in the body of tables, \item \code{na} for missing values in tables, \item \code{section} for section headers (bold by default), \item \code{text} for descriptive text in the output, \item \code{result} for the corresponding result(s), \item \code{stop} for errors (bold red by default), \item \code{warning} for warnings (yellow by default), \item \code{message} for messages (green by default), \item \code{verbose} for the text in verbose output (cyan by default), \item \code{legend} for legends (gray by default). } Elements not specified are styled according to their defaults. For example, one could use: \preformatted{setmfopt(style = list(header = combine_styles("gray20", "underline"), body1 = make_style("gray40"), body2 = make_style("gray40"), na = bold, section = combine_styles("gray15", "bold"), text = make_style("gray50"), result = make_style("gray30"), legend = make_style("gray70")))} or \preformatted{setmfopt(style = list(header = combine_styles("gray80", "underline"), body1 = make_style("gray60"), body2 = make_style("gray60"), na = bold, section = combine_styles("gray85", "bold"), text = make_style("gray50"), result = make_style("gray70"), legend = make_style("gray30")))} for a light or dark colored background, respectively. A slightly more colorful theme could be: \preformatted{setmfopt(style = list(header = combine_styles("snow", make_style("royalblue4", bg=TRUE)), body1 = combine_styles("gray10", make_style("gray95", bg=TRUE)), body2 = combine_styles("gray10", make_style("gray85", bg=TRUE)), na = combine_styles("orange4", "bold"), section = combine_styles("black", "bold", make_style("gray90", bg=TRUE)), text = make_style("gray40"), result = make_style("blue"), legend = make_style("gray70")))} or \preformatted{setmfopt(style = list(header = combine_styles("snow", make_style("royalblue4", bg=TRUE)), body1 = combine_styles("gray90", make_style("gray10", bg=TRUE)), body2 = combine_styles("gray90", make_style("gray15", bg=TRUE)), na = combine_styles("orange1", "bold"), section = combine_styles("snow", "bold", make_style("gray10", bg=TRUE)), text = make_style("gray60"), result = make_style("steelblue1"), legend = make_style("gray30")))} for a light and dark colored background, respectively. The following code snippet includes all output elements (except for an error) and can be used to test out a chosen color theme: \preformatted{# calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) dat$yi[1] <- NA # set one estimate to missing so we get a warning below dat # fit random-effects model res <- rma(yi, vi, mods = ~ ablat, data=dat, verbose=3) summary(res)} \if{html}{For example, using the color scheme above (for a light colored background), the output should look like this: \figure{crayon1.png}{options: width=800} \figure{crayon2.png}{options: width=800}} Note that support for 256 different colors and text formatting (such as underlined and bold text) differs across terminals. } \subsection{Removing Empty Lines Before and After the Output}{ When printing output, an empty line is usually added before and after the output. For more compact output, this can be suppressed with \code{setmfopt(space=FALSE)} (see \code{\link{mfopt}} for getting and setting package options). For example, running the following code: \preformatted{# calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) # fit a random-effects model res <- rma(yi, vi, data=dat) res setmfopt(space=FALSE) res} shows the difference. } \subsection{Dark Mode for Plots}{ By default, plots created in \R have a white background and use black (and other darker colors) as the plotting color. Figures created with the \pkg{metafor} package also adhere to this standard. However, all plotting functions in the package are designed in such a way that switching to a dark background is easily possible. For this, one should set the canvas/figure background to a dark color (e.g., \code{"black"} or \code{"gray10"}) and the foreground color to some bright color (e.g., \code{"gray90"}, \code{"gray95"}, or \code{"white"}). The following code will accomplish this: \preformatted{bg <- "gray10" fg <- "gray95" dev.new(canvas=bg) par(fg=fg, bg=bg, col=fg, col.axis=fg, col.lab=fg, col.main=fg, col.sub=fg)} Figures that make use of additional colors for various plot elements will by default then use colors that are compatible with the chosen background. For example, the following two figures illustrate the difference between the two styles: \if{html}{ \figure{plots-light.png}{options: width=800} \figure{plots-dark.png}{options: width=800}} \if{latex}{ \figure{plots-light.pdf}{options: width=5.5in} \figure{plots-dark.pdf}{options: width=5.5in}} By setting \code{setmfopt(theme="dark")} (see \code{\link{mfopt}} for getting and setting package options), all plots created by the package will automatically use a dark mode. RStudio users can also set \code{setmfopt(theme="auto")}, in which case plotting colors are chosen depending on the RStudio theme used (for some themes, setting this to \code{"auto2"} might be aesthetically more pleasing). } \subsection{Version Check}{ When loading the \pkg{metafor} package in an \code{\link{interactive}} session, an automatic check is carried out to compare the version number of the installed package with the one available on \href{https://cran.r-project.org/package=metafor}{CRAN}. If the installed version is older than the one available on CRAN, the user is notified that a new version is available. This check can be suppressed by setting the environment variable \env{METAFOR_VERSION_CHECK} to \code{FALSE} (e.g., with \code{Sys.setenv(METAFOR_VERSION_CHECK=FALSE)}) or with \code{options(metafor=list(check=FALSE))} before loading the package (see \code{\link{mfopt}} for getting and setting package options). By setting the environment variable to \code{"devel"} (e.g., with \code{Sys.setenv(METAFOR_VERSION_CHECK="devel")}) or with \code{options(metafor=list(check="devel"))}, the version check is run against the \sQuote{development version} of the package available on \href{https://github.com/wviechtb/metafor}{GitHub}. } \subsection{Model Fitting / Processing Time}{ The various model fitting functions (i.e., \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, \code{\link{rma.mv}}, and \code{\link{selmodel}}) and various other functions (e.g., \code{\link[=confint.rma.mv]{confint}}, \code{\link{cumul}}, \code{\link{leave1out}}, \code{\link[=profile.rma.mv]{profile}}, \code{\link[=residuals.rma]{rstudent}}) automatically keep track of the model fitting / processing time. This information is stored as element \code{time} (in seconds) in the object that is returned. One can also use argument \code{time=TRUE} to nicely print this information. For example: \preformatted{# fit multilevel mixed-effects meta-regression model and print the processing time res <- rma.mv(yi, vi, mods = ~ condition, random = list(~ 1 | article/experiment/sample/id, ~ 1 | pairing), data=dat.mccurdy2020, sparse=TRUE, digits=3, time=TRUE) # extract the processing time (should take somewhere around 10-20 seconds on a modern CPU) res$time} } \subsection{Model Object Sizes}{ The objects returned by model fitting functions like \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} contain information that is needed by some of the method functions that can be applied to such objects, but that can lead to objects that are relatively large in size. As an example, the model objects that are created as part of the example code for \code{\link{dat.moura2021}} are approximately 120MB in size. To reduce the object size, one can make use of the (undocumented) argument \code{outlist}. When setting \code{outlist="minimal"}, the resulting object contains only the minimal information needed to print the object (which results in an object that is around 13KB in size). Alternatively, one can set \code{outlist} to a string that specifies what objects that are created within the model fitting function should be returned (and under which name). For example, \code{outlist="coef=beta, vcov=vb"} would indicate that only the model coefficient(s) (with name \code{coef}) and the corresponding variance-covariance matrix (with name \code{vcov}) should be returned (the resulting object then is only around 2KB in size). Note that this requires knowledge of how objects within the model fitting function are named, so inspection of the source code of a function will then be necessary. Also, there is no guarantee that method functions will still work when including only a subset of the information that is typically stored in model objects. } \subsection{Load Balancing}{ Several functions in the \pkg{metafor} package can make use of parallel processing (e.g., \code{\link[=profile.rma.mv]{profile}}) to speed up intensive computations on machines with multiple cores. When using \code{parallel="snow"}, the default is to use the \code{\link[parallel]{parLapply}} function from the \code{\link[parallel]{parallel}} package for this purpose. In some cases (especially when the parallelized computations take up quite variable amounts of time to complete), using \sQuote{load balancing} may help to speed things up further (by using the \code{\link[parallel]{parLapplyLB}} function). This can be enabled with \code{pbapply::pboptions(use_lb=TRUE)} before running the function that makes use of parallel processing. Whether this really does speed things up depends on many factors and is hard to predict. } } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \keyword{documentation} \keyword{misc} metafor/man/addpoly.default.Rd0000644000176200001440000001323714505063152016037 0ustar liggesusers\name{addpoly.default} \alias{addpoly.default} \title{Add Polygons to Forest Plots (Default Method)} \description{ Function to add one or more polygons to a forest plot. } \usage{ \method{addpoly}{default}(x, vi, sei, ci.lb, ci.ub, pi.lb, pi.ub, rows=-1, level, annotate, digits, width, mlab, transf, atransf, targs, efac, col, border, lty, fonts, cex, constarea=FALSE, \dots) } \arguments{ \item{x}{vector with the values at which the polygons should be drawn.} \item{vi}{vector with the corresponding variances.} \item{sei}{vector with the corresponding standard errors (note: only one of the two, \code{vi} or \code{sei}, needs to be specified).} \item{ci.lb}{vector with the corresponding lower confidence interval bounds. Not needed if \code{vi} or \code{sei} is specified. See \sQuote{Details}.} \item{ci.ub}{vector with the corresponding upper confidence interval bounds. Not needed if \code{vi} or \code{sei} is specified. See \sQuote{Details}.} \item{pi.lb}{optional vector with the corresponding lower prediction interval bounds.} \item{pi.ub}{optional vector with the corresponding upper prediction interval bounds.} \item{rows}{vector to specify the rows (or more generally, the horizontal positions) for plotting the polygons (defaults is \code{-1}). Can also be a single value to specify the row (horizontal position) of the first polygon (the remaining polygons are then plotted below this starting row).} \item{level}{optional numeric value between 0 and 100 to specify the confidence interval level (see \link[=misc-options]{here} for details).} \item{annotate}{optional logical to specify whether annotations should be added to the plot for the polygons that are drawn.} \item{digits}{optional integer to specify the number of decimal places to which the annotations should be rounded.} \item{width}{optional integer to manually adjust the width of the columns for the annotations.} \item{mlab}{optional character vector with the same length as \code{x} giving labels for the polygons that are drawn.} \item{transf}{optional argument to specify a function to transform the \code{x} values and confidence interval bounds (e.g., \code{transf=exp}; see also \link{transf}).} \item{atransf}{optional argument to specify a function to transform the annotations (e.g., \code{atransf=exp}; see also \link{transf}).} \item{targs}{optional arguments needed by the function specified via \code{transf} or \code{atransf}.} \item{efac}{optional vertical expansion factor for the polygons.} \item{col}{optional character string to specify the color of the polygons.} \item{border}{optional character string to specify the border color of the polygons.} \item{lty}{optional character string to specify the line type for the prediction interval.} \item{fonts}{optional character string to specify the font for the labels and annotations.} \item{cex}{optional symbol expansion factor.} \item{constarea}{logical to specify whether the height of the polygons (when adding multiple) should be adjusted so that the area of the polygons is constant (the default is \code{FALSE}).} \item{\dots}{other arguments.} } \details{ The function can be used to add one or more polygons to an existing forest plot created with the \code{\link{forest}} function. For example, summary estimates based on a model involving moderators can be added to the plot this way (see \sQuote{Examples}). To use the function, one should specify the values at which the polygons should be drawn (via the \code{x} argument) together with the corresponding variances (via the \code{vi} argument) or with the corresponding standard errors (via the \code{sei} argument). Alternatively, one can specify the values at which the polygons should be drawn together with the corresponding confidence interval bounds (via the \code{ci.lb} and \code{ci.ub} arguments). Optionally, one can also specify the bounds of the corresponding prediction interval bounds via the \code{pi.lb} and \code{pi.ub} arguments. If unspecified, arguments \code{level}, \code{annotate}, \code{digits}, \code{width}, \code{transf}, \code{atransf}, \code{targs}, \code{efac} (only if the forest plot was created with \code{\link{forest.rma}}), \code{fonts}, \code{cex}, \code{annosym}, and \code{textpos} are automatically set equal to the same values that were used when creating the forest plot. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{forest}} for functions to draw forest plots to which polygons can be added. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit mixed-effects model with absolute latitude as a moderator res <- rma(yi, vi, mods = ~ ablat, slab=paste(author, year, sep=", "), data=dat) ### forest plot of the observed risk ratios forest(res, addfit=FALSE, atransf=exp, xlim=c(-9,5), ylim=c(-4.5,15), cex=0.9, order=ablat, ilab=ablat, ilab.xpos=-4.5, header="Author(s) and Year", top=2) ### predicted average log risk ratios for 10, 30, and 50 degrees absolute latitude x <- predict(res, newmods=c(10, 30, 50)) ### add predicted average risk ratios to forest plot addpoly(x$pred, sei=x$se, rows=-2, mlab=c("- at 10 Degrees", "- at 30 Degrees", "- at 50 Degrees")) abline(h=0) text(-9, -1, "Model-Based Estimates:", pos=4, cex=0.9) text(-4.5, res$k+2, "Latitude", cex=0.9, font=2) } \keyword{aplot} metafor/man/print.hc.rma.uni.Rd0000644000176200001440000000324414505063152016052 0ustar liggesusers\name{print.hc.rma.uni} \alias{print.hc.rma.uni} \title{Print Method for 'hc.rma.uni' Objects} \description{ Function to print objects of class \code{"hc.rma.uni"}. \loadmathjax } \usage{ \method{print}{hc.rma.uni}(x, digits=x$digits, \dots) } \arguments{ \item{x}{an object of class \code{"hc.rma.uni"} obtained with \code{\link[=hc.rma.uni]{hc}}.} \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} \item{\dots}{other arguments.} } \details{ The output is a data frame with two rows, the first (labeled \code{rma}) corresponding to the results based on the usual estimation method, the second (labeled \code{hc}) corresponding to the results based on the method by Henmi and Copas (2010). The data frame includes the following variables: \itemize{ \item the method used to estimate \mjseqn{\tau^2} (always \code{DL} for \code{hc}) \item the estimated amount of heterogeneity \item the estimated average true outcome \item the corresponding standard error (\code{NA} when \code{transf} argument has been used) \item the lower and upper confidence interval bounds } } \value{ The function returns the data frame invisibly. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link[=hc.rma.uni]{hc}} for the function to create \code{hc.rma.uni} objects. } \keyword{print} metafor/man/aggregate.escalc.Rd0000644000176200001440000003217414505063152016140 0ustar liggesusers\name{aggregate.escalc} \alias{aggregate} \alias{aggregate.escalc} \title{Aggregate Multiple Effect Sizes or Outcomes Within Studies} \description{ Function to aggregate multiple effect sizes or outcomes belonging to the same study (or to the same level of some other clustering variable) into a single combined effect size or outcome. \loadmathjax } \usage{ \method{aggregate}{escalc}(x, cluster, time, obs, V, struct="CS", rho, phi, weighted=TRUE, checkpd=TRUE, fun, na.rm=TRUE, addk=FALSE, subset, select, digits, var.names, \dots) } \arguments{ \item{x}{an object of class \code{"escalc"}.} \item{cluster}{vector to specify the clustering variable (e.g., study).} \item{time}{optional vector to specify the time points (only relevant when \code{struct="CAR"}, \code{"CS+CAR"}, or \code{"CS*CAR"}).} \item{obs}{optional vector to distinguish different observed effect sizes or outcomes measured at the same time point (only relevant when \code{struct="CS*CAR"}).} \item{V}{optional argument to specify the variance-covariance matrix of the sampling errors. If unspecified, argument \code{struct} is used to specify the variance-covariance structure.} \item{struct}{character string to specify the variance-covariance structure of the sampling errors within the same cluster (either \code{"ID"}, \code{"CS"}, \code{"CAR"}, \code{"CS+CAR"}, or \code{"CS*CAR"}). See \sQuote{Details}.} \item{rho}{value of the correlation of the sampling errors within clusters (when \code{struct="CS"}, \code{"CS+CAR"}, or \code{"CS*CAR"}). Can also be a vector with the value of the correlation for each cluster.} \item{phi}{value of the autocorrelation of the sampling errors within clusters (when \code{struct="CAR"}, \code{"CS+CAR"}, or \code{"CS*CAR"}). Can also be a vector with the value of the autocorrelation for each cluster.} \item{weighted}{logical to specify whether estimates within clusters should be aggregated using inverse-variance weighting (the default is \code{TRUE}). If set to \code{FALSE}, unweighted averages are computed.} \item{checkpd}{logical to specify whether to check that the variance-covariance matrices of the sampling errors within clusters are positive definite (the default is \code{TRUE}).} \item{fun}{optional list with three functions for aggregating other variables besides the effect sizes or outcomes within clusters (for numeric/integer variables, for logicals, and for all other types, respectively).} \item{na.rm}{logical to specify whether \code{NA} values should be removed before aggregating values within clusters (the default is \code{TRUE}). Can also be a vector with two logicals (the first pertaining to the effect sizes or outcomes, the second to all other variables).} \item{addk}{logical to specify whether to add the cluster size as a new variable (called \code{ki}) to the dataset (the default is \code{FALSE}).} \item{subset}{optional (logical or numeric) vector to specify the subset of rows to include when aggregating the effect sizes or outcomes.} \item{select}{optional vector to specify the names of the variables to include in the aggregated dataset.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} \item{var.names}{optional character vector with two elements to specify the name of the variable that contains the observed effect sizes or outcomes and the name of the variable with the corresponding sampling variances (when unspecified, the function attempts to set these automatically based on the object).} \item{\dots}{other arguments.} } \details{ In many meta-analyses, multiple effect sizes or outcomes can be extracted from the same study. Ideally, such structures should be analyzed using an appropriate multilevel/multivariate model as can be fitted with the \code{\link{rma.mv}} function. However, there may occasionally be reasons for aggregating multiple effect sizes or outcomes belonging to the same study (or to the same level of some other clustering variable) into a single combined effect size or outcome. The present function can be used for this purpose. The input must be an object of class \code{"escalc"}. The error \sQuote{\code{Error in match.fun(FUN): argument "FUN" is missing, with no default}} indicates that a regular data frame was passed to the function, but this does not work. One can turn a regular data frame (containing the effect sizes or outcomes and the corresponding sampling variances) into an \code{"escalc"} object with the \code{\link{escalc}} function. See the \sQuote{Examples} below for an illustration of this. The \code{cluster} variable is used to specify which estimates/outcomes belong to the same study/cluster. In the simplest case, the estimates/outcomes within clusters (or, to be precise, their sampling errors) are assumed to be independent. This is usually a safe assumption as long as each study participant (or whatever the study units are) only contributes data to a single estimate/outcome. For example, if a study provides effect size estimates for male and female subjects separately, then the sampling errors can usually be assumed to be independent. In this case, one can set \code{struct="ID"} and multiple estimates/outcomes within the same cluster are combined using standard inverse-variance weighting (i.e., using weighted least squares) under the assumption of independence. In other cases, the estimates/outcomes within clusters cannot be assumed to be independent. For example, if multiple effect size estimates are computed for the same group of subjects (e.g., based on different scales to measure some construct of interest), then the estimates are likely to be correlated. If the actual correlation between the estimates is unknown, one can often still make an educated guess and set argument \code{rho} to this value, which is then assumed to be the same for all pairs of estimates within clusters when \code{struct="CS"} (for a compound symmetric structure). Multiple estimates/outcomes within the same cluster are then combined using inverse-variance weighting taking their correlation into consideration (i.e., using generalized least squares). One can also specify a different value of \code{rho} for each cluster by passing a vector (of the same length as the number of clusters) to this argument. If multiple effect size estimates are computed for the same group of subjects at different time points, then it may be more sensible to assume that the correlation between estimates decreases as a function of the distance between the time points. If so, one can specify \code{struct="CAR"} (for a continuous-time autoregressive structure), set \code{phi} to the autocorrelation (for two estimates one time-unit apart), and use argument \code{time} to specify the actual time points corresponding to the estimates. The correlation between two estimates, \mjeqn{y_{it}}{y_it} and \mjeqn{y_{it'}}{y_it'}, in the \mjeqn{i\textrm{th}}{ith} cluster, with time points \mjeqn{\textrm{time}_{it}}{time_it} and \mjeqn{\textrm{time}_{it'}}{time_it'}, is then given by \mjeqn{\phi^{|\textrm{time}_{it} - \textrm{time}_{it'}|}}{\phi^|time_it - time_it'|}. One can also specify a different value of \code{phi} for each cluster by passing a vector (of the same length as the number of clusters) to this argument. One can also combine the compound symmetric and autoregressive structures if there are multiple time points and multiple observed effect sizes or outcomes at these time points. One option is \code{struct="CS+CAR"}. In this case, one must specify the \code{time} argument and both \code{rho} and \code{phi}. The correlation between two estimates, \mjeqn{y_{it}}{y_it} and \mjeqn{y_{it'}}{y_it'}, in the \mjeqn{i\textrm{th}}{ith} cluster, with time points \mjeqn{\textrm{time}_{it}}{time_it} and \mjeqn{\textrm{time}_{it'}}{time_it'}, is then given by \mjeqn{\rho + (1 - \rho) \phi^{|\textrm{time}_{it} - \textrm{time}_{it'}|}}{\rho + (1 - \rho) * \phi^|time_it - time_it'|}. Alternatively, one can specify \code{struct="CS*CAR"}. In this case, one must specify both the \code{time} and \code{obs} arguments and both \code{rho} and \code{phi}. The correlation between two estimates, \mjeqn{y_{ijt}}{y_ijt} and \mjeqn{y_{ijt'}}{y_ijt'}, with the same value for \code{obs} but different values for \code{time}, is then given by \mjeqn{\phi^{|\textrm{time}_{ijt} - \textrm{time}_{ijt'}|}}{\phi^|time_ijt - time_ijt'|}, the correlation between two estimates, \mjeqn{y_{ijt}}{y_ijt} and \mjeqn{y_{ij't}}{y_ij't}, with different values for \code{obs} but the same value for \code{time}, is then given by \mjseqn{\rho}, and the correlation between two estimates, \mjeqn{y_{ijt}}{y_ijt} and \mjeqn{y_{ij't'}}{y_ij't}, with different values for \code{obs} and different values for \code{time}, is then given by \mjeqn{\rho \times \phi^{|\textrm{time}_{ijt} - \textrm{time}_{ijt'}|}}{\rho * \phi^|time_ijt - time_ijt'|}. Finally, if one actually knows the correlation (and hence the covariance) between each pair of estimates (or has an approximation thereof), one can also specify the entire variance-covariance matrix of the estimates (or more precisely, their sampling errors) via the \code{V} argument (in this case, arguments \code{struct}, \code{time}, \code{obs}, \code{rho}, and \code{phi} are ignored). Note that the \code{\link{vcalc}} function can be used to construct such a \code{V} matrix and provides even more flexibility for specifying various types of dependencies. See the \sQuote{Examples} below for an illustration of this. Instead of using inverse-variance weighting (i.e., weighted/generalized least squares) to combine the estimates within clusters, one can set \code{weighted=FALSE} in which case the estimates are averaged within clusters without any weighting (although the correlations between estimates as specified are still taken into consideration). Other variables (besides the estimates) will also be aggregated to the cluster level. By default, numeric/integer type variables are averaged, logicals are also averaged (yielding the proportion of \code{TRUE} values), and for all other types of variables (e.g., character variables or factors) the most frequent category/level is returned. One can also specify a list of three functions via the \code{fun} argument for aggregating variables belonging to these three types. Argument \code{na.rm} controls how missing values should be handled. By default, any missing estimates are first removed before aggregating the non-missing values within each cluster. The same applies when aggregating the other variables. One can also specify a vector with two logicals for the \code{na.rm} argument to control how missing values should be handled when aggregating the estimates and when aggregating all other variables. } \value{ An object of class \code{c("escalc","data.frame")} that contains the (selected) variables aggregated to the cluster level. The object is formatted and printed with the \code{\link[=print.escalc]{print}} function. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{escalc}} for a function to create \code{escalc} objects. } \examples{ ### copy data into 'dat' and examine data dat <- dat.konstantopoulos2011 head(dat, 11) ### aggregate estimates to the district level, assuming independent sampling ### errors for multiples studies/schools within the same district agg <- aggregate(dat, cluster=district, struct="ID", addk=TRUE) agg ### copy data into 'dat' and examine data dat <- dat.assink2016 head(dat, 19) ### note: 'dat' is an 'escalc' object class(dat) ### turn 'dat' into a regular data frame dat <- as.data.frame(dat) class(dat) ### turn data frame into an 'escalc' object dat <- escalc(measure="SMD", yi=yi, vi=vi, data=dat) class(dat) ### aggregate the estimates to the study level, assuming a CS structure for ### the sampling errors within studies with a correlation of 0.6 agg <- aggregate(dat, cluster=study, rho=0.6) agg ### use vcalc() and then the V argument V <- vcalc(vi, cluster=study, obs=esid, data=dat, rho=0.6) agg <- aggregate(dat, cluster=study, V=V) agg ### use a correlation of 0.7 for effect sizes corresponding to the same type of ### delinquent behavior and a correlation of 0.5 for effect sizes corresponding ### to different types of delinquent behavior V <- vcalc(vi, cluster=study, type=deltype, obs=esid, data=dat, rho=c(0.7, 0.5)) agg <- aggregate(dat, cluster=study, V=V) agg ### reshape 'dat.ishak2007' into long format dat <- dat.ishak2007 dat <- reshape(dat.ishak2007, direction="long", idvar="study", v.names=c("yi","vi"), varying=list(c(2,4,6,8), c(3,5,7,9))) dat <- dat[order(study, time),] dat <- dat[!is.na(yi),] rownames(dat) <- NULL head(dat, 8) ### aggregate the estimates to the study level, assuming a CAR structure for ### the sampling errors within studies with an autocorrelation of 0.9 agg <- aggregate(dat, cluster=study, struct="CAR", time=time, phi=0.9) head(agg, 5) } \keyword{models} metafor/man/metafor.news.Rd0000644000176200001440000000131714505063152015364 0ustar liggesusers\name{metafor.news} \alias{metafor.news} \title{Read News File of the Metafor Package} \description{ Function to read the \file{NEWS} file of the \pkg{\link{metafor-package}}. } \usage{ metafor.news() } \details{ The function is just a wrapper for \code{news(package="metafor")} which parses and displays the \file{NEWS} file of the package. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \examples{ \dontrun{ metafor.news() } } \keyword{utilities} metafor/man/robust.Rd0000644000176200001440000002770014505063152014276 0ustar liggesusers\name{robust} \alias{robust} \alias{robust.rma.uni} \alias{robust.rma.mv} \title{Cluster-Robust Tests and Confidence Intervals for 'rma' Objects} \description{ Function to obtain cluster-robust tests and confidence intervals (also known as robust variance estimation) of the model coefficients for objects of class \code{"rma"}. \loadmathjax } \usage{ robust(x, cluster, \dots) \method{robust}{rma.uni}(x, cluster, adjust=TRUE, clubSandwich=FALSE, digits, \dots) \method{robust}{rma.mv}(x, cluster, adjust=TRUE, clubSandwich=FALSE, digits, \dots) } \arguments{ \item{x}{an object of class \code{"rma.uni"} or \code{"rma.mv"}.} \item{cluster}{vector to specify the clustering variable to use for constructing the sandwich estimator of the variance-covariance matrix.} \item{adjust}{logical to specify whether a small-sample correction should be applied to the variance-covariance matrix.} \item{clubSandwich}{logical to specify whether the \href{https://cran.r-project.org/package=clubSandwich}{clubSandwich} package should be used to obtain the cluster-robust tests and confidence intervals.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} \item{\dots}{other arguments.} } \details{ The function constructs a cluster-robust estimate of the variance-covariance matrix of the model coefficients based on a sandwich-type estimator and then computes tests and confidence intervals of the model coefficients. This function will often be part of a general workflow for meta-analyses involving complex dependency structures as described \link[=misc-recs]{here}. By default, tests of individual coefficients and confidence intervals are based on a t-distribution with \mjseqn{n-p} degrees of freedom, while the omnibus test uses an F-distribution with \mjseqn{m} and \mjseqn{n-p} degrees of freedom, where \mjseqn{n} is the number of clusters, \mjseqn{p} denotes the total number of model coefficients (including the intercept if it is present), and \mjseqn{m} denotes the number of coefficients tested by the omnibus test. This is sometimes called the \sQuote{residual} method for approximating the (denominator) degrees of freedom. When \code{adjust=TRUE} (the default), the cluster-robust estimate of the variance-covariance matrix is multiplied by the factor \mjseqn{n/(n-p)}, which serves as a small-sample adjustment that tends to improve the performance of the method when the number of clusters is small. This is sometimes called the \sQuote{CR1} adjustment/estimator (in contrast to \sQuote{CR0} when \code{adjust=FALSE}). For an even better small-sample adjustment, one can set \code{clubSandwich=TRUE} in which case the \href{https://cran.r-project.org/package=clubSandwich}{clubSandwich} package is used to obtain the cluster-robust tests and confidence intervals. The variance-covariance matrix of the model coefficients is then estimated using the \sQuote{bias-reduced linearization} adjustment proposed by Bell and McCaffrey (2002) and further developed in Tipton (2015) and Pustejovsky and Tipton (2018). This is sometimes called the \sQuote{CR2} adjustment/estimator. The degrees of freedom of the t-tests are then estimated using a Satterthwaite approximation. F-tests are then based on an approximate Hotelling's T-squared reference distribution, with denominator degrees of freedom estimated using a method by Zhang (2012, 2013), as further described in Tipton and Pustejovky (2015). } \value{ An object of class \code{"robust.rma"}. The object is a list containing the following components: \item{beta}{estimated coefficients of the model.} \item{se}{robust standard errors of the coefficients.} \item{zval}{test statistics of the coefficients.} \item{pval}{corresponding p-values.} \item{ci.lb}{lower bound of the confidence intervals for the coefficients.} \item{ci.ub}{upper bound of the confidence intervals for the coefficients.} \item{vb}{robust variance-covariance matrix of the estimated coefficients.} \item{QM}{test statistic of the omnibus test of moderators.} \item{QMp}{corresponding p-value.} \item{\dots}{some additional elements/values.} The results are formatted and printed with the \code{\link{print.rma.uni}} and \code{\link{print.rma.mv}} functions (depending on the type of model). Predicted/fitted values based on \code{"robust.rma"} objects can be obtained with the \code{\link[=predict.rma]{predict}} function. Tests for sets of model coefficients or linear combinations thereof can be obtained with the \code{\link[=anova.rma]{anova}} function. } \note{ The variable specified via \code{cluster} is assumed to be of the same length as the data originally passed to the \code{rma.uni} or \code{rma.mv} functions (and if the \code{data} argument was used in the original model fit, then the variable will be searched for within this data frame first). Any subsetting and removal of studies with missing values that was applied during the model fitting is also automatically applied to the variable specified via the \code{cluster} argument. The idea of the robust (sandwich-type) estimator for models with unspecified heteroscedasticity can be traced back to Eicker (1967), Huber (1967), and White (1980, 1984). Hence, the method in general is often referred to as the Eicker-Huber-White method. Some small-sample improvements to the method are described by MacKinnon and White (1985). The extension to the cluster-robust estimator can be found in Froot (1989) and Williams (2000), which is also related to the GEE approach by Liang and Zeger (1986). Cameron and Miller (2015) provide an extensive overview of cluster-robust methods. Sidik and Jonkman (2005, 2006) introduced robust methods in the meta-analytic context for standard random/mixed-effects models. The use of cluster-robust methods for multivariate/multilevel meta-analytic models was introduced by Hedges, Tipton, and Johnson (2010). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Bell, R. M., & McCaffry, D. F. (2002). Bias reduction in standard errors for linear regression with multi-stage samples. \emph{Survey Methodology}, \bold{28}(2), 169--181. \verb{https://www150.statcan.gc.ca/n1/en/catalogue/12-001-X20020029058} Cameron, A. C., & Miller, D. L. (2015). A practitioner's guide to cluster-robust inference. \emph{Journal of Human Resources}, \bold{50}(2), 317--372. \verb{https://doi.org/10.3368/jhr.50.2.317} Eicker, F. (1967). Limit theorems for regressions with unequal and dependent errors. In L. M. LeCam & J. Neyman (Eds.), \emph{Proceedings of the Fifth Berkeley Symposium on Mathematical Statistics and Probability} (pp. 59--82). Berkeley: University of California Press. Froot, K. A. (1989). Consistent covariance matrix estimation with cross-sectional dependence and heteroskedasticity in financial data. \emph{Journal of Financial and Quantitative Analysis}, \bold{24}(3), 333--355. \verb{https://doi.org/10.2307/2330815} Hedges, L. V., Tipton, E., & Johnson, M. C. (2010). Robust variance estimation in meta-regression with dependent effect size estimates. \emph{Research Synthesis Methods}, \bold{1}(1), 39--65. \verb{https://doi.org/10.1002/jrsm.5} Huber, P. (1967). The behavior of maximum-likelihood estimates under nonstandard conditions. In L. M. LeCam & J. Neyman (Eds.), \emph{Proceedings of the Fifth Berkeley Symposium on Mathematical Statistics and Probability} (pp. 221--233). University of California Press. Liang, K. Y., & Zeger, S. L. (1986). Longitudinal data analysis using generalized linear models. \emph{Biometrika}, \bold{73}(1), 13--22. \verb{https://doi.org/10.1093/biomet/73.1.13} MacKinnon, J. G., & White, H. (1985). Some heteroskedasticity-consistent covariance matrix estimators with improved finite sample properties. \emph{Journal of Econometrics}, \bold{29}(3), 305--325. \verb{https://doi.org/10.1016/0304-4076(85)90158-7} Tipton, E. (2015). Small sample adjustments for robust variance estimation with meta-regression. \emph{Psychological Methods}, \bold{20}(3), 375--393. \verb{https://doi.org/10.1037/met0000011} Tipton, E., & Pustejovsky, J. E. (2015). Small-sample adjustments for tests of moderators and model fit using robust variance estimation in meta-regression. \emph{Journal of Educational and Behavioral Statistics}, \bold{40}(6), 604--634. \verb{https://doi.org/10.3102/1076998615606099} Sidik, K., & Jonkman, J. N. (2005). A note on variance estimation in random effects meta-regression. \emph{Journal of Biopharmaceutical Statistics}, \bold{15}(5), 823--838. \verb{https://doi.org/10.1081/BIP-200067915} Sidik, K., & Jonkman, J. N. (2006). Robust variance estimation for random effects meta-analysis. \emph{Computational Statistics & Data Analysis}, \bold{50}(12), 3681--3701. \verb{https://doi.org/10.1016/j.csda.2005.07.019} White, H. (1980). A heteroskedasticity-consistent covariance matrix estimator and a direct test for heteroskedasticity. \emph{Econometrica}, \bold{48}(4), 817--838. \verb{https://doi.org/10.2307/1912934} White, H. (1984). \emph{Asymptotic theory for econometricians}. Orlando, FL: Academic Press. Williams, R. L. (2000). A note on robust variance estimation for cluster-correlated data. \emph{Biometrics}, \bold{56}(2), 645--646. \verb{https://doi.org/10.1111/j.0006-341x.2000.00645.x} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Zhang, J.-T. (2012). An approximate Hotelling T2-test for heteroscedastic one-way MANOVA. \emph{Open Journal of Statistics}, \bold{2}(1), 1--11. \verb{https://doi.org/10.4236/ojs.2012.21001} Zhang, J.-T. (2013). Tests of linear hypotheses in the ANOVA under heteroscedasticity. \emph{International Journal of Advanced Statistics and Probability}, \bold{1}, 9--24. \verb{https://doi.org/10.14419/ijasp.v1i2.908} } \seealso{ \code{\link{rma.uni}} and \code{\link{rma.mv}} for functions to fit models for which cluster-robust tests and confidence intervals can be obtained. } \examples{ ############################################################################ ### copy data from Bangert-Drowns et al. (2004) into 'dat' dat <- dat.bangertdrowns2004 ### fit random-effects model res <- rma(yi, vi, data=dat) res ### use cluster-robust inference methods robust(res, cluster=id) ### use methods from the clubSandwich package robust(res, cluster=id, clubSandwich=TRUE) ### fit meta-regression model res <- rma(yi, vi, mods = ~ length, data=dat) res ### use cluster-robust inference methods robust(res, cluster=id) ### use methods from the clubSandwich package robust(res, cluster=id, clubSandwich=TRUE) ############################################################################ ### copy data from Konstantopoulos (2011) into 'dat' dat <- dat.konstantopoulos2011 ### fit multilevel random-effects model res <- rma.mv(yi, vi, random = ~ 1 | district/school, data=dat) res ### use cluster-robust inference methods robust(res, cluster=district) ### use methods from the clubSandwich package robust(res, cluster=district, clubSandwich=TRUE) ############################################################################ ### copy data from Berkey et al. (1998) into 'dat' dat <- dat.berkey1998 ### variables v1i and v2i correspond to the 2x2 var-cov matrices of the studies; ### so use these variables to construct the V matrix (note: since v1i and v2i are ### var-cov matrices and not correlation matrices, set vi=1 for all rows) V <- vcalc(vi=1, cluster=author, rvars=c(v1i, v2i), data=dat) ### fit multivariate model res <- rma.mv(yi, V, mods = ~ outcome - 1, random = ~ outcome | trial, struct="UN", data=dat) res ### use cluster-robust inference methods robust(res, cluster=trial) ### use methods from the clubSandwich package robust(res, cluster=trial, clubSandwich=TRUE) ############################################################################ } \keyword{htest} metafor/man/addpoly.Rd0000644000176200001440000000416414505063152014413 0ustar liggesusers\name{addpoly} \alias{addpoly} \title{Add Polygons to Forest Plots} \description{ Function to add polygons (sometimes called \sQuote{diamonds}) to a forest plot, for example to indicate summary estimates for subgroups of studies or to indicate fitted/predicted values based on models involving moderators. } \usage{ addpoly(x, \dots) } \arguments{ \item{x}{either an object of class \code{"rma"}, an object of class \code{"predict.rma"}, or the values at which polygons should be drawn. See \sQuote{Details}.} \item{\dots}{other arguments.} } \details{ Currently, methods exist for three types of situations. In the first case, object \code{x} is a fitted model coming from the \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, or \code{\link{rma.mv}} functions. The model must either be an equal- or a random-effects model, that is, the model should not contain any moderators. The corresponding method is \code{\link{addpoly.rma}}. It can be used to add a polygon to an existing forest plot (usually at the bottom), showing the summary estimate (with its confidence interval) based on the fitted model. Alternatively, \code{x} can be an object of class \code{"predict.rma"} obtained with the \code{\link[=predict.rma]{predict}} function. In this case, polygons based on the predicted values are drawn. The corresponding method is \code{\link{addpoly.predict.rma}}. Alternatively, object \code{x} can be a vector with values at which one or more polygons should be drawn. The corresponding method is \code{\link{addpoly.default}}. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{addpoly.rma}}, \code{\link{addpoly.predict.rma}}, and \code{\link{addpoly.default}} for the specific method functions. \code{\link{forest}} for functions to draw forest plots to which polygons can be added. } \keyword{aplot} metafor/man/weights.rma.Rd0000644000176200001440000000673614505063152015216 0ustar liggesusers\name{weights.rma} \alias{weights} \alias{weights.rma} \alias{weights.rma.uni} \alias{weights.rma.mh} \alias{weights.rma.peto} \alias{weights.rma.glmm} \alias{weights.rma.mv} \title{Compute Weights for 'rma' Objects} \description{ Functions to compute the weights given to the observed effect sizes or outcomes during the model fitting for objects of class \code{"rma.uni"}, \code{"rma.mh"}, \code{"rma.peto"}, and \code{"rma.mv"}. } \usage{ \method{weights}{rma.uni}(object, type="diagonal", \dots) \method{weights}{rma.mh}(object, type="diagonal", \dots) \method{weights}{rma.peto}(object, type="diagonal", \dots) \method{weights}{rma.glmm}(object, \dots) \method{weights}{rma.mv}(object, type="diagonal", \dots) } \arguments{ \item{object}{an object of class \code{"rma.uni"}, \code{"rma.mh"}, \code{"rma.peto"}, or \code{"rma.mv"}. The method is not yet implemented for objects of class \code{"rma.glmm"}.} \item{type}{character string to specify whether to return only the diagonal of the weight matrix (\code{"diagonal"}) or the entire weight matrix (\code{"matrix"}). For \code{"rma.mv"}, this can also be \code{"rowsum"} for \sQuote{row-sum weights} (for intercept-only models).} \item{\dots}{other arguments.} } \value{ Either a vector with the diagonal elements of the weight matrix or the entire weight matrix. When only the diagonal elements are returned, they are given in \% (and they add up to 100\%). When the entire weight matrix is requested, this is always a diagonal matrix for objects of class \code{"rma.uni"}, \code{"rma.mh"}, \code{"rma.peto"}. For \code{"rma.mv"}, the structure of the weight matrix depends on the model fitted (i.e., the random effects included and the variance-covariance matrix of the sampling errors) but is often more complex and not just diagonal. For intercept-only \code{"rma.mv"} models, one can also take the sum over the rows in the weight matrix, which are actually the weights assigned to the observed effect sizes or outcomes when estimating the model intercept. These weights can be obtained with \code{type="rowsum"} (as with \code{type="diagonal"}, they are also given in \%). See \href{https://www.metafor-project.org/doku.php/tips:weights_in_rma.mv_models}{here} for a discussion of this. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W. (2021). Model checking in meta-analysis. In C. H. Schmid, T. Stijnen, & I. R. White (Eds.), \emph{Handbook of meta-analysis} (pp. 219--254). Boca Raton, FL: CRC Press. \verb{https://doi.org/10.1201/9781315119403} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, and \code{\link{rma.mv}} for functions to fit models for which model fitting weights can be extracted. \code{\link{influence.rma.uni}} and \code{\link{influence.rma.mv}} for other model diagnostics. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit mixed-effects model with absolute latitude and publication year as moderators res <- rma(yi, vi, mods = ~ ablat + year, data=dat) ### extract the model fitting weights (in %) weights(res) ### extract the weight matrix round(weights(res, type="matrix"), 4) } \keyword{models} metafor/man/confint.rma.Rd0000644000176200001440000004403714505063152015200 0ustar liggesusers\name{confint.rma} \alias{confint} \alias{confint.rma} \alias{confint.rma.uni} \alias{confint.rma.mh} \alias{confint.rma.peto} \alias{confint.rma.glmm} \alias{confint.rma.mv} \alias{confint.rma.uni.selmodel} \alias{confint.rma.ls} \title{Confidence Intervals for 'rma' Objects} \description{ Functions to compute confidence intervals for the model coefficients, variance components, and other parameters in meta-analytic models. \loadmathjax } \usage{ \method{confint}{rma.uni}(object, parm, level, fixed=FALSE, random=TRUE, type, digits, transf, targs, verbose=FALSE, control, \dots) \method{confint}{rma.mh}(object, parm, level, digits, transf, targs, \dots) \method{confint}{rma.peto}(object, parm, level, digits, transf, targs, \dots) \method{confint}{rma.glmm}(object, parm, level, digits, transf, targs, \dots) \method{confint}{rma.mv}(object, parm, level, fixed=FALSE, sigma2, tau2, rho, gamma2, phi, digits, transf, targs, verbose=FALSE, control, \dots) \method{confint}{rma.uni.selmodel}(object, parm, level, fixed=FALSE, tau2, delta, digits, transf, targs, verbose=FALSE, control, \dots) \method{confint}{rma.ls}(object, parm, level, fixed=FALSE, alpha, digits, transf, targs, verbose=FALSE, control, \dots) } \arguments{ \item{object}{an object of class \code{"rma.uni"}, \code{"rma.mh"}, \code{"rma.peto"}, \code{"rma.mv"}, \code{"rma.uni.selmodel"}, or \code{"rma.ls"}. The method is not yet implemented for objects of class \code{"rma.glmm"}.} \item{parm}{this argument is here for compatibility with the generic function \code{\link{confint}}, but is (currently) ignored.} \item{fixed}{logical to specify whether confidence intervals for the model coefficients should be returned.} \item{random}{logical to specify whether a confidence interval for the amount of (residual) heterogeneity should be returned.} \item{type}{optional character string to specify the method for computing the confidence interval for the amount of (residual) heterogeneity (either \code{"QP"}, \code{"GENQ"}, \code{"PL"}, or \code{"HT"}).} \item{sigma2}{integer to specify for which \mjseqn{\sigma^2} parameter a confidence interval should be obtained.} \item{tau2}{integer to specify for which \mjseqn{\tau^2} parameter a confidence interval should be obtained.} \item{rho}{integer to specify for which \mjseqn{\rho} parameter the confidence interval should be obtained.} \item{gamma2}{integer to specify for which \mjseqn{\gamma^2} parameter a confidence interval should be obtained.} \item{phi}{integer to specify for which \mjseqn{\phi} parameter a confidence interval should be obtained.} \item{delta}{integer to specify for which \mjseqn{\delta} parameter a confidence interval should be obtained.} \item{alpha}{integer to specify for which \mjseqn{\alpha} parameter a confidence interval should be obtained.} \item{level}{numeric value between 0 and 100 to specify the confidence interval level (see \link[=misc-options]{here} for details). If unspecified, the default is to take the value from the object.} \item{digits}{optional integer to specify the number of decimal places to which the results should be rounded. If unspecified, the default is to take the value from the object.} \item{transf}{optional argument to specify a function to transform the model coefficients and interval bounds (e.g., \code{transf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{targs}{optional arguments needed by the function specified under \code{transf}.} \item{verbose}{logical to specify whether output should be generated on the progress of the iterative algorithms used to obtain the confidence intervals (the default is \code{FALSE}). See \sQuote{Details}.} \item{control}{list of control values for the iterative algorithms. If unspecified, default values are used. See \sQuote{Note}.} \item{\dots}{other arguments.} } \details{ Confidence intervals for the model coefficients can be obtained by setting \code{fixed=TRUE} and are simply the usual Wald-type intervals (which are also shown when printing the fitted object). Other parameter(s) for which confidence intervals can be obtained depend on the model object: \itemize{ \item For objects of class \code{"rma.uni"} obtained with the \code{\link{rma.uni}} function, a confidence interval for the amount of (residual) heterogeneity (i.e., \mjseqn{\tau^2}) can be obtained by setting \code{random=TRUE} (which is the default). The interval is obtained iteratively either via the Q-profile method or via the generalized Q-statistic method (Hartung and Knapp, 2005; Viechtbauer, 2007; Jackson, 2013; Jackson et al., 2014). The latter is automatically used when the model was fitted with \code{method="GENQ"} or \code{method="GENQM"}, the former is used in all other cases. Either method provides an exact confidence interval for \mjseqn{\tau^2} in random- and mixed-effects models. The square root of the interval bounds is also returned for easier interpretation. Confidence intervals for \mjseqn{I^2} and \mjseqn{H^2} are also provided (Higgins & Thompson, 2002). Since \mjseqn{I^2} and \mjseqn{H^2} are just monotonic transformations of \mjseqn{\tau^2} (for details, see \code{\link[=print.rma.uni]{print}}), the confidence intervals for \mjseqn{I^2} and \mjseqn{H^2} are also exact. One can also set \code{type="PL"} to obtain a profile likelihood confidence interval for \mjseqn{\tau^2} (and corresponding CIs for \mjseqn{I^2} and \mjseqn{H^2}), which would be more consistent with the use of ML/REML estimation, but is not exact (see \sQuote{Note}). For models without moderators (i.e., random-effects models), one can also set \code{type="HT"}, in which case the \sQuote{test-based method} (method III in Higgins & Thompson, 2002) is used to construct confidence intervals for \mjseqn{\tau^2}, \mjseqn{I^2}, and \mjseqn{H^2} (see also Borenstein et al., 2009, chapter 16). However, note that this method tends to yield confidence intervals that are too narrow when the amount of heterogeneity is large. \item For objects of class \code{"rma.mv"} obtained with the \code{\link{rma.mv}} function, confidence intervals are obtained by default for all (non-fixed) variance and correlation components of the model. Alternatively, one can use the \code{sigma2}, \code{tau2}, \code{rho}, \code{gamma2}, or \code{phi} arguments to specify for which variance/correlation parameter a confidence interval should be obtained. Only one of these arguments can be used at a time. A single integer is used to specify the number of the parameter. The function provides profile likelihood confidence intervals for these parameters. It is a good idea to examine the corresponding profile likelihood plots (via the \code{\link[=profile.rma.mv]{profile}} function) to make sure that the bounds obtained are sensible. \item For selection model objects of class \code{"rma.uni.selmodel"} obtained with the \code{\link{selmodel}} function, confidence intervals are obtained by default for \mjseqn{\tau^2} (for models where this is an estimated parameter) and all (non-fixed) selection model parameters. Alternatively, one can choose to obtain a confidence interval only for \mjseqn{\tau^2} by setting \code{tau2=TRUE} or for one of the selection model parameters by specifying its number via the \code{delta} argument. The function provides profile likelihood confidence intervals for these parameters. It is a good idea to examine the corresponding profile likelihood plots (via the \code{\link[=profile.rma.uni.selmodel]{profile}} function) to make sure that the bounds obtained are sensible. \item For location-scale model objects of class \code{"rma.ls"} obtained with the \code{\link{rma.uni}} function, confidence intervals are obtained by default for all (non-fixed) scale parameters. Alternatively, one can choose to obtain a confidence interval for one of the scale parameters by specifying its number via the \code{alpha} argument. The function provides profile likelihood confidence intervals for these parameters. It is a good idea to examine the corresponding profile likelihood plots (via the \code{\link[=profile.rma.ls]{profile}} function) to make sure that the bounds obtained are sensible. } The methods used to find confidence intervals for these parameters are iterative and require the use of the \code{\link{uniroot}} function. By default, the desired accuracy (\code{tol}) is set equal to \code{.Machine$double.eps^0.25} and the maximum number of iterations (\code{maxiter}) to \code{1000}. These values can be adjusted with \code{control=list(tol=value, maxiter=value)}, but the defaults should be adequate for most purposes. If \code{verbose=TRUE}, output is generated on the progress of the iterative algorithms. This is especially useful when model fitting is slow, in which case finding the confidence interval bounds can also take considerable amounts of time. When using the \code{\link{uniroot}} function, one must also set appropriate end points of the interval to be searched for the confidence interval bounds. The function sets some sensible defaults for the end points, but it may happen that the function is only able to determine that a bound is below/above a certain limit (this is indicated in the output accordingly with \code{<} or \code{>} signs). It can also happen that the model cannot be fitted or does not converge especially at the extremes of the interval to be searched. This will result in missing (\code{NA}) bounds and corresponding warnings. It may then be necessary to adjust the end points manually (see \sQuote{Note}). Finally, it is also possible that the lower and upper confidence interval bounds for a variance component both fall below zero. Since both bounds then fall outside of the parameter space, the confidence interval then consists of the null/empty set. Alternatively, one could interpret this as a confidence interval with bounds \mjseqn{[0,0]} or as indicating \sQuote{highly/overly homogeneous} data. } \value{ An object of class \code{"confint.rma"}. The object is a list with either one or two elements (named \code{fixed} and \code{random}) with the following elements: \item{estimate}{estimate of the model coefficient, variance/correlation component, or selection model parameter.} \item{ci.lb}{lower bound of the confidence interval.} \item{ci.ub}{upper bound of the confidence interval.} When obtaining confidence intervals for multiple components, the object is a list of class \code{"list.confint.rma"}, where each element is a \code{"confint.rma"} object as described above. The results are formatted and printed with the \code{\link[=print.confint.rma]{print}} function. To format the results as a data frame, one can use the \code{\link[=as.data.frame.confint.rma]{as.data.frame}} function. } \note{ When computing a CI for \mjseqn{\tau^2} for objects of class \code{"rma.uni"}, the estimate of \mjseqn{\tau^2} will usually fall within the CI bounds provided by the Q-profile method. However, this is not guaranteed. Depending on the method used to estimate \mjseqn{\tau^2} and the width of the CI, it can happen that the CI does not actually contain the estimate. Using the empirical Bayes or Paule-Mandel estimator of \mjseqn{\tau^2} when fitting the model (i.e., using \code{method="EB"} or \code{method="PM"}) usually ensures that the estimate of \mjseqn{\tau^2} falls within the CI (for \code{method="PMM"}, this is guaranteed). When \code{method="GENQ"} was used to fit the model, the corresponding CI obtained via the generalized Q-statistic method also usually contains the estimate \mjseqn{\tau^2} (for \code{method="GENQM"}, this is guaranteed). When using ML/REML estimation, the profile likelihood CI (obtained when setting \code{type="PL"}) is guaranteed to contain the estimate of \mjseqn{\tau^2}. When computing a CI for \mjseqn{\tau^2} for objects of class \code{"rma.uni"}, the end points of the interval to be searched for the CI bounds are \mjseqn{[0,100]} (or, for the upper bound, ten times the estimate of \mjseqn{\tau^2}, whichever is greater). The upper bound should be large enough for most cases, but can be adjusted with \code{control=list(tau2.max=value)}. One can also adjust the lower end point with \code{control=list(tau2.min=value)}. You should only play around with this value if you know what you are doing. For objects of class \code{"rma.mv"}, the function provides profile likelihood CIs for the variance/correlation parameters in the model. For variance components, the lower end point of the interval to be searched is set to 0 and the upper end point to the larger of 10 and 100 times the value of the component. For correlations, the function sets the lower end point to a sensible default depending on the type of variance structure chosen, while the upper end point is set to 1. One can adjust the lower and/or upper end points with \code{control=list(vc.min=value, vc.max=value)}. Also, the function adjusts the lower/upper end points when the model does not converge at these extremes (the end points are then moved closer to the estimated value of the component). The total number of tries for setting/adjusting the end points in this manner is determined via \code{control=list(eptries=value)}, with the default being 10 tries. For objects of class \code{"rma.uni.selmodel"} or \code{"rma.ls"}, the function also sets some sensible defaults for the end points of the interval to be searched for the CI bounds (of the \mjseqn{\tau^2}, \mjseqn{\delta}, and \mjseqn{\alpha} parameter(s)). One can again adjust the end points and the number of retries (as described above) with \code{control=list(vc.min=value, vc.max=value, eptries=value)}. The Q-profile and generalized Q-statistic methods are both exact under the assumptions of the random- and mixed-effects models (i.e., normally distributed observed and true effect sizes or outcomes and known sampling variances). In practice, these assumptions are usually only approximately true, turning CIs for \mjseqn{\tau^2} also into approximations. Profile likelihood CIs are not exact by construction and rely on the asymptotic behavior of the likelihood ratio statistic, so they may be inaccurate in small samples, but they are inherently consistent with the use of ML/REML estimation. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Borenstein, M., Hedges, L. V., Higgins, J. P. T., & Rothstein, H. (2009). \emph{Introduction to meta-analysis}. Chichester, UK: Wiley. Hardy, R. J., & Thompson, S. G. (1996). A likelihood approach to meta-analysis with random effects. \emph{Statistics in Medicine}, \bold{15}(6), 619--629. \verb{https://doi.org/10.1002/(sici)1097-0258(19960330)15:6\%3C619::aid-sim188\%3E3.0.co;2-a} Hartung, J., & Knapp, G. (2005). On confidence intervals for the among-group variance in the one-way random effects model with unequal error variances. \emph{Journal of Statistical Planning and Inference}, \bold{127}(1-2), 157--177. \verb{https://doi.org/10.1016/j.jspi.2003.09.032} Higgins, J. P. T., & Thompson, S. G. (2002). Quantifying heterogeneity in a meta-analysis. \emph{Statistics in Medicine}, \bold{21}(11), 1539--1558. \verb{https://doi.org/10.1002/sim.1186} Jackson, D. (2013). Confidence intervals for the between-study variance in random effects meta-analysis using generalised Cochran heterogeneity statistics. \emph{Research Synthesis Methods}, \bold{4}(3), 220--229. \verb{https://doi.org/10.1186/s12874-016-0219-y} Jackson, D., Turner, R., Rhodes, K., & Viechtbauer, W. (2014). Methods for calculating confidence and credible intervals for the residual between-study variance in random effects meta-regression models. \emph{BMC Medical Research Methodology}, \bold{14}, 103. \verb{https://doi.org/10.1186/1471-2288-14-103} Viechtbauer, W. (2007). Confidence intervals for the amount of heterogeneity in meta-analysis. \emph{Statistics in Medicine}, \bold{26}(1), 37--52. \verb{https://doi.org/10.1002/sim.2514} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W., & \enc{López-López}{Lopez-Lopez}, J. A. (2022). Location-scale models for meta-analysis. \emph{Research Synthesis Methods}. \bold{13}(6), 697--715. \verb{https://doi.org/10.1002/jrsm.1562} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, \code{\link{rma.mv}}, and \code{\link[=selmodel.rma.uni]{selmodel}} for functions to fit models for which confidence intervals can be computed. \code{\link[=profile.rma]{profile}} for functions to create profile likelihood plots corresponding to profile likelihood confidence intervals. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### meta-analysis of the log risk ratios using a random-effects model res <- rma(yi, vi, data=dat, method="REML") ### confidence interval for the total amount of heterogeneity confint(res) ### mixed-effects model with absolute latitude in the model res <- rma(yi, vi, mods = ~ ablat, data=dat) ### confidence interval for the residual amount of heterogeneity confint(res) ### multilevel random-effects model res <- rma.mv(yi, vi, random = ~ 1 | district/school, data=dat.konstantopoulos2011) ### profile plots and confidence intervals for the variance components \dontrun{ par(mfrow=c(2,1)) profile(res, sigma2=1, steps=40, cline=TRUE) sav <- confint(res, sigma2=1) sav abline(v=sav$random[1,2:3], lty="dotted") profile(res, sigma2=2, steps=40, cline=TRUE) sav <- confint(res, sigma2=2) sav abline(v=sav$random[1,2:3], lty="dotted") } ### multivariate parameterization of the model res <- rma.mv(yi, vi, random = ~ school | district, data=dat.konstantopoulos2011) ### profile plots and confidence intervals for the variance component and correlation \dontrun{ par(mfrow=c(2,1)) profile(res, tau2=1, steps=40, cline=TRUE) sav <- confint(res, tau2=1) sav abline(v=sav$random[1,2:3], lty="dotted") profile(res, rho=1, steps=40, cline=TRUE) sav <- confint(res, rho=1) sav abline(v=sav$random[1,2:3], lty="dotted") } } \keyword{models} metafor/man/forest.Rd0000644000176200001440000000322514505063152014256 0ustar liggesusers\name{forest} \alias{forest} \title{Forest Plots} \description{ Function to create forest plots. } \usage{ forest(x, \dots) } \arguments{ \item{x}{either an object of class \code{"rma"}, a vector with the observed effect sizes or outcomes, or an object of class \code{"cumul.rma"}. See \sQuote{Details}.} \item{\dots}{other arguments.} } \details{ Currently, methods exist for three types of situations. In the first case, object \code{x} is a fitted model object coming from the \code{\link{rma.uni}}, \code{\link{rma.mh}}, or \code{\link{rma.peto}} functions. The corresponding method is then \code{\link{forest.rma}}. Alternatively, object \code{x} can be a vector with observed effect sizes or outcomes. The corresponding method is then \code{\link{forest.default}}. Finally, object \code{x} can be an object coming from the \code{\link{cumul.rma.uni}}, \code{\link{cumul.rma.mh}}, or \code{\link{cumul.rma.peto}} functions. The corresponding method is then \code{\link{forest.cumul.rma}}. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Lewis, S., & Clarke, M. (2001). Forest plots: Trying to see the wood and the trees. \emph{British Medical Journal}, \bold{322}(7300), 1479--1480. \verb{https://doi.org/10.1136/bmj.322.7300.1479} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{forest.rma}}, \code{\link{forest.default}}, and \code{\link{forest.cumul.rma}} for the specific method functions. } \keyword{hplot} metafor/man/metafor-package.Rd0000644000176200001440000003712114505063152016004 0ustar liggesusers\name{metafor-package} \alias{metafor-package} \alias{metafor} \docType{package} \title{metafor: A Meta-Analysis Package for R \loadmathjax} \description{ The \pkg{metafor} package provides a comprehensive collection of functions for conducting meta-analyses in \R. The package can be used to calculate various effect sizes or outcome measures and then allows the user to fit equal-, fixed-, and random-effects models to these data. By including study-level variables (\sQuote{moderators}) as predictors in these models, (mixed-effects) meta-regression models can also be fitted. For meta-analyses of \mjeqn{2 \times 2}{2x2} tables, proportions, incidence rates, and incidence rate ratios, the package also provides functions that implement specialized methods, including the Mantel-Haenszel method, Peto's method, and a variety of suitable generalized linear mixed-effects models (i.e., mixed-effects logistic and Poisson regression models). For non-independent effects/outcomes (e.g., due to correlated sampling errors, correlated true effects or outcomes, or other forms of clustering), the package also provides a function for fitting multilevel and multivariate models to meta-analytic data. Various methods are available to assess model fit, to identify outliers and/or influential studies, and for conducting sensitivity analyses (e.g., standardized residuals, Cook's distances, leave-one-out analyses). Advanced techniques for hypothesis testing and obtaining confidence intervals (e.g., for the average effect or outcome or for the model coefficients in a meta-regression model) have also been implemented (e.g., the Knapp and Hartung method, permutation tests, cluster-robust inference methods / robust variance estimation). The package also provides functions for creating forest, funnel, radial (Galbraith), normal quantile-quantile, \enc{L'Abbé}{L'Abbe}, Baujat, bubble, and GOSH plots. The presence of publication bias (or more precisely, funnel plot asymmetry or \sQuote{small-study effects}) and its potential impact on the results can be examined via the rank correlation and Egger's regression test, the trim and fill method, the test of excess significance, and by applying a variety of selection models. } \section{The escalc Function}{ [\code{\link{escalc}}] Before a meta-analysis can be conducted, the relevant results from each study must be quantified in such a way that the resulting values can be further aggregated and compared. The \code{\link{escalc}} function can be used to compute a wide variety of effect sizes or \sQuote{outcome measures} (and the corresponding sampling variances) that are often used in meta-analyses (e.g., risk ratios, odds ratios, risk differences, mean differences, standardized mean differences, response ratios / ratios of means, raw or r-to-z transformed correlation coefficients). Measures for quantifying some characteristic of individual groups (e.g., in terms of means, proportions, or incidence rates and transformations thereof), measures of change (e.g., raw and standardized mean changes), and measures of variability (e.g., variability ratios and coefficient of variation ratios) are also available. } \section{The rma.uni Function}{ [\code{\link{rma.uni}}] The various meta-analytic models that are typically used in practice are special cases of the general linear (mixed-effects) model. The \code{\link{rma.uni}} function (with alias \code{\link{rma}}) provides a general framework for fitting such models. The function can be used in combination with any of the effect sizes or outcome measures computed with the \code{\link{escalc}} function or, more generally, any set of estimates (with corresponding sampling variances or standard errors) one would like to analyze. The notation and models underlying the \code{\link{rma.uni}} function are explained below. For a set of \mjseqn{i = 1, \ldots, k} independent studies, let \mjseqn{y_i} denote the observed value of the effect size or outcome measure in the \mjeqn{i\textrm{th}}{ith} study. Let \mjseqn{\theta_i} denote the corresponding (unknown) true effect/outcome, such that \mjdeqn{y_i | \theta_i \sim N(\theta_i, v_i).}{y_i | \theta_i ~ N(\theta_i, v_i).} In other words, the observed effect sizes or outcomes are assumed to be unbiased and normally distributed estimates of the corresponding true effects/outcomes with sampling variances equal to \mjseqn{v_i} (where \mjseqn{v_i} is just the square of the standard errors of the estimates). The \mjseqn{v_i} values are assumed to be known. Depending on the outcome measure used, a bias correction, normalizing, and/or variance stabilizing transformation may be necessary to ensure that these assumptions are (at least approximately) true (e.g., the log transformation for odds/risk ratios, the bias correction for standardized mean differences, Fisher's r-to-z transformation for correlations; see \code{\link{escalc}} for more details). According to the \bold{random-effects model}, we further assume that \mjeqn{\theta_i \sim N(\mu, \tau^2)}{\theta_i ~ N(\mu, \tau^2)}, that is, the true effects/outcomes are normally distributed with \mjseqn{\mu} denoting the average true effect/outcome and \mjseqn{\tau^2} the variance in the true effects/outcomes (\mjseqn{\tau^2} is therefore often referred to as the amount of \sQuote{heterogeneity} in the true effects/outcomes). The random-effects model can also be written as \mjdeqn{y_i = \mu + u_i + \varepsilon_i,}{y_i = \mu + u_i + \epsilon_i,} where \mjeqn{u_i \sim N(0, \tau^2)}{u_i ~ N(0, \tau^2)} and \mjeqn{\varepsilon_i \sim N(0, v_i)}{\epsilon_i ~ N(0, v_i)}. The fitted model provides estimates of \mjseqn{\mu} and \mjseqn{\tau^2}, that is, \mjdeqn{\hat{\mu} = \frac{\sum_{i=1}^k w_i y_i}{\sum_{i=1}^k w_i},}{\mu-hat = \sum w_i y_i / \sum w_i,} where \mjeqn{w_i = 1/(\hat{\tau}^2 + v_i)}{w_i = 1/(\tau-hat^2 + v_i)} and \mjeqn{\hat{\tau}^2}{\tau-hat^2} denotes an estimate of \mjseqn{\tau^2} obtained with one of the many estimators that have described in the literature for this purpose (this is the standard \sQuote{inverse-variance} method for random-effects models). A special case of the model above is the \bold{equal-effects model} (also sometimes called the common-effects model) which arises when \mjseqn{\tau^2 = 0}. In this case, the true effects/outcomes are homogeneous (i.e., \mjeqn{\theta_1 = \theta_2 = \ldots = \theta_k \equiv \theta}{\theta_1 = \theta_2 = \ldots = \theta_k = \theta}) and hence we can write the model as \mjdeqn{y_i = \theta + \varepsilon_i,}{y_i = \theta + \epsilon_i,} where \mjseqn{\theta} denotes \emph{the} true effect/outcome in the studies, which is estimated with \mjdeqn{\hat{\theta} = \frac{\sum_{i=1}^k w_i y_i}{\sum_{i=1}^k w_i},}{\theta-hat = \sum w_i y_i / \sum w_i,} where \mjeqn{w_i = 1/v_i}{w_i = 1/v_i} (again, this is the standard \sQuote{inverse-variance} method as described in the meta-analytic literature). Note that the commonly-used term \sQuote{fixed-effects model} is not used here - for an explanation, see \link[=misc-models]{here}. Study-level variables (often referred to as \sQuote{moderators}) can also be included as predictors in meta-analytic models, leading to so-called \sQuote{meta-regression} analyses (to examine whether the effects/outcomes tend to be larger/smaller under certain conditions or circumstances). When including moderator variables in a random-effects model, we obtain a \bold{mixed-effects meta-regression model}. This model can be written as \mjdeqn{y_i = \beta_0 + \beta_1 x_{i1} + \beta_2 x_{i2} + \ldots + \beta_{p'} x_{ip'} + u_i + \varepsilon_i,}{y_i = \beta_0 + \beta_1 x_i1 + \beta_2 x_i2 + \ldots + \beta_p' x_ip' + u_i + \epsilon_i,} where \mjeqn{u_i \sim N(0, \tau^2)}{u_i ~ N(0, \tau^2)} and \mjeqn{\varepsilon_i \sim N(0, v_i)}{\epsilon_i ~ N(0, v_i)} as before and \mjeqn{x_{ij}}{x_ij} denotes the value of the \mjeqn{j\textrm{th}}{jth} moderator variable for the \mjeqn{i\textrm{th}}{ith} study (letting \mjseqn{p = p' + 1} denote the total number of coefficients in the model including the model intercept). Therefore, \mjseqn{\beta_j} denotes how the average true effect/outcome changes for a one-unit increase in \mjeqn{x_{ij}}{x_ij} and the model intercept \mjseqn{\beta_0} denotes the average true effect/outcome when the values of all moderator variables are equal to zero. The value of \mjseqn{\tau^2} in the mixed-effects model denotes the amount of \sQuote{residual heterogeneity} in the true effects/outcomes (i.e., the amount of variability in the true effects/outcomes that is not accounted for by the moderators included in the model). } \section{The rma.mh Function}{ [\code{\link{rma.mh}}] The Mantel-Haenszel method provides an alternative approach for fitting equal-effects models when dealing with studies providing data in the form of \mjeqn{2 \times 2}{2x2} tables or in the form of event counts (i.e., person-time data) for two groups (Mantel & Haenszel, 1959). The method is particularly advantageous when aggregating a large number of studies with small sample sizes (the so-called sparse data or increasing strata case). The Mantel-Haenszel method is implemented in the \code{\link{rma.mh}} function. It can be used in combination with risk ratios, odds ratios, risk differences, incidence rate ratios, and incidence rate differences. } \section{The rma.peto Function}{ [\code{\link{rma.peto}}] Yet another method that can be used in the context of a meta-analysis of \mjeqn{2 \times 2}{2x2} table data is Peto's method (see Yusuf et al., 1985), implemented in the \code{\link{rma.peto}} function. The method provides an estimate of the (log) odds ratio under an equal-effects model. The method is particularly advantageous when the event of interest is rare, but see the documentation of the function for some caveats. } \section{The rma.glmm Function}{ [\code{\link{rma.glmm}}] Dichotomous response variables and event counts (based on which one can calculate outcome measures such as odds ratios, incidence rate ratios, proportions, and incidence rates) are often assumed to arise from binomial and Poisson distributed data. Meta-analytic models that are directly based on such distributions are implemented in the \code{\link{rma.glmm}} function. These models are essentially special cases of generalized linear mixed-effects models (i.e., mixed-effects logistic and Poisson regression models). For \mjeqn{2 \times 2}{2x2} table data, a mixed-effects conditional logistic model (based on the non-central hypergeometric distribution) is also available. Random/mixed-effects models with dichotomous data are often referred to as \sQuote{binomial-normal} models in the meta-analytic literature. Analogously, for event count data, such models could be referred to as \sQuote{Poisson-normal} models. } \section{The rma.mv Function}{ [\code{\link{rma.mv}}] Standard meta-analytic models assume independence between the observed effect sizes or outcomes obtained from a set of studies. This assumption is often violated in practice. Dependencies can arise for a variety of reasons. For example, the sampling errors and/or true effects/outcomes may be correlated in multiple treatment studies (e.g., when multiple treatment groups are compared with a common control/reference group, such that the data from the control/reference group is used multiple times to compute the observed effect sizes or outcomes) or in multiple endpoint studies (e.g., when more than one effect size estimate or outcome is calculated based on the same sample of subjects due to the use of multiple endpoints or response variables). Correlations in the true effects/outcomes can also arise due to other forms of clustering (e.g., when multiple effects/outcomes derived from the same author, lab, or research group may be more similar to each other than effects/outcomes derived from different authors, labs, or research groups). In ecology and related fields, the shared phylogenetic history among the organisms studied (e.g., plants, fungi, animals) can also induce correlations among the effects/outcomes. The \code{\link{rma.mv}} function can be used to fit suitable meta-analytic multivariate/multilevel models to such data, so that the non-independence in the effects/outcomes is accounted for. Network meta-analyses (also called multiple/mixed treatment comparisons) can also be carried out with this function. } \section{Future Plans and Updates}{ The \pkg{metafor} package is a work in progress and is updated on a regular basis with new functions and options. With \code{metafor.news()}, you can read the \file{NEWS} file of the package after installation. Comments, feedback, and suggestions for improvements are always welcome. } \section{Citing the Package}{ To cite the package, please use the following reference: Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1-48. \doi{10.18637/jss.v036.i03} } \section{Getting Started with the Package}{ The paper mentioned above is a good starting place for those interested in using the package. The purpose of the article is to provide a general overview of the package and its capabilities (as of version 1.4-0). Not all of the functions and options are described in the paper, but it should provide a useful introduction to the package. The paper can be freely downloaded from the URL given above or can be directly loaded with the command \code{vignette("metafor")}. In addition to reading the paper, carefully read this page and then the help pages for the \code{\link{escalc}} and the \code{\link{rma.uni}} functions (or the \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, and/or \code{\link{rma.mv}} functions if you intend to use these methods). The help pages for these functions provide links to many additional functions, which can be used after fitting a model. You can also read the entire documentation online at \url{https://wviechtb.github.io/metafor/} (where it is nicely formatted and the output from all examples is provided). A (pdf) diagram showing the various functions in the metafor package (and how they are related to each other) can be opened with the command \code{vignette("diagram")}. Finally, additional information about the package, several detailed analysis examples, examples of plots and figures provided by the package (with the corresponding code), some additional tips and notes, and a FAQ can be found on the package website at \url{https://www.metafor-project.org}. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \cr package website: \url{https://www.metafor-project.org} \cr author homepage: \verb{https://www.wvbauer.com} \cr Suggestions on how to obtain help with using the package can found on the package website at: \url{https://www.metafor-project.org/doku.php/help} } \references{ Cooper, H., Hedges, L. V., & Valentine, J. C. (Eds.) (2009). \emph{The handbook of research synthesis and meta-analysis} (2nd ed.). New York: Russell Sage Foundation. Hedges, L. V., & Olkin, I. (1985). \emph{Statistical methods for meta-analysis}. San Diego, CA: Academic Press. Mantel, N., & Haenszel, W. (1959). Statistical aspects of the analysis of data from retrospective studies of disease. \emph{Journal of the National Cancer Institute}, \bold{22}(4), 719--748. \verb{https://doi.org/10.1093/jnci/22.4.719} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Yusuf, S., Peto, R., Lewis, J., Collins, R., & Sleight, P. (1985). Beta blockade during and after myocardial infarction: An overview of the randomized trials. \emph{Progress in Cardiovascular Disease}, \bold{27}(5), 335--371. \verb{https://doi.org/10.1016/s0033-0620(85)80003-7} } \keyword{package} metafor/man/forest.rma.Rd0000644000176200001440000006471714505063152015051 0ustar liggesusers\name{forest.rma} \alias{forest.rma} \title{Forest Plots (Method for 'rma' Objects)} \description{ Function to create forest plots for objects of class \code{"rma"}. \loadmathjax } \usage{ \method{forest}{rma}(x, annotate=TRUE, addfit=TRUE, addpred=FALSE, showweights=FALSE, header=FALSE, xlim, alim, olim, ylim, at, steps=5, level=x$level, refline=0, digits=2L, width, xlab, slab, mlab, ilab, ilab.xpos, ilab.pos, order, transf, atransf, targs, rows, efac=1, pch, psize, plim=c(0.5,1.5), colout, col, border, shade, colshade, lty, fonts, cex, cex.lab, cex.axis, \dots) } \arguments{ \item{x}{an object of class \code{"rma"}.} \item{annotate}{logical to specify whether annotations should be added to the plot (the default is \code{TRUE}).} \item{addfit}{logical to specify whether the summary estimate (for models without moderators) or fitted values (for models with moderators) should be added to the plot (the default is \code{TRUE}). See \sQuote{Details}.} \item{addpred}{logical to specify whether the bounds of the prediction interval should be added to the plot (the default is \code{FALSE}). See \sQuote{Details}.} \item{showweights}{logical to specify whether the annotations should also include the weights given to the observed outcomes during the model fitting (the default is \code{FALSE}). See \sQuote{Details}.} \item{header}{logical to specify whether column headings should be added to the plot (the default is \code{FALSE}). Can also be a character vector to specify the left and right headings (or only the left one).} \item{xlim}{horizontal limits of the plot region. If unspecified, the function sets the horizontal plot limits to some sensible values.} \item{alim}{the x-axis limits. If unspecified, the function sets the x-axis limits to some sensible values.} \item{olim}{optional argument to specify observation/outcome limits. If unspecified, no limits are used.} \item{ylim}{the y-axis limits of the plot. If unspecified, the function sets the y-axis limits to some sensible values.} \item{at}{position of the x-axis tick marks and corresponding labels. If unspecified, the function sets the tick mark positions/labels to some sensible values.} \item{steps}{the number of tick marks for the x-axis (the default is 5). Ignored when the positions are specified via the \code{at} argument.} \item{level}{numeric value between 0 and 100 to specify the confidence interval level (see \link[=misc-options]{here} for details). The default is to take the value from the object.} \item{refline}{numeric value to specify the location of the vertical \sQuote{reference} line (the default is 0). The line can be suppressed by setting this argument to \code{NA}.} \item{digits}{integer to specify the number of decimal places to which the tick mark labels of the x-axis and the annotations should be rounded (the default is \code{2L}). Can also be a vector of two integers, the first to specify the number of decimal places for the annotations, the second for the x-axis labels (when \code{showweights=TRUE}, can also specify a third value for the weights). When specifying an integer (e.g., \code{2L}), trailing zeros after the decimal mark are dropped for the x-axis labels. When specifying a numeric value (e.g., \code{2}), trailing zeros are retained.} \item{width}{optional integer to manually adjust the width of the columns for the annotations (either a single integer or a vector of the same length as the number of annotation columns).} \item{xlab}{title for the x-axis. If unspecified, the function sets an appropriate axis title. Can also be a vector of three/two values (to also/only add labels at the end points of the x-axis limits).} \item{slab}{optional vector with labels for the \mjseqn{k} studies. If unspecified, the function tries to extract study labels from \code{x} or simple labels are created within the function. To suppress labels, set this argument to \code{NA}.} \item{mlab}{optional character string giving a label to the summary estimate from an equal- or a random-effects model. If unspecified, the label is created within the function.} \item{ilab}{optional vector, matrix, or data frame providing additional information about the studies that should be added to the plot.} \item{ilab.xpos}{numeric vector to specify the horizontal position(s) of the variable(s) given via \code{ilab}.} \item{ilab.pos}{integer(s) (either 1, 2, 3, or 4) to specify the alignment of the vector(s) given via \code{ilab} (2 means right, 4 mean left aligned). If unspecified, the default is to center the labels.} \item{order}{optional character string to specify how the studies should be ordered. Can also be a variable based on which the studies will be ordered. See \sQuote{Details}.} \item{transf}{optional argument to specify a function to transform the observed outcomes, summary estimates, fitted values, and confidence interval bounds (e.g., \code{transf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{atransf}{optional argument to specify a function to transform the x-axis labels and annotations (e.g., \code{atransf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{targs}{optional arguments needed by the function specified via \code{transf} or \code{atransf}.} \item{rows}{optional vector to specify the rows (or more generally, the horizontal positions) for plotting the outcomes. Can also be a single value to specify the row (horizontal position) of the first outcome (the remaining outcomes are then plotted below this starting row).} \item{efac}{vertical expansion factor for confidence interval limits, arrows, and the symbol used to denote summary estimates. The default value of 1 should usually work okay. Can also be a vector of two numbers, the first for CI limits and arrows, the second for summary estimates. Can also be a vector of three numbers, the first for CI limits, the second for arrows, the third for summary estimates.} \item{pch}{plotting symbol to use for the observed outcomes. By default, a filled square is used. See \code{\link{points}} for other options. Can also be a vector of values.} \item{psize}{optional numeric value to specify the point sizes for the observed outcomes. If unspecified, the point sizes are a function of the model weights. Can also be a vector of values.} \item{plim}{numeric vector of length 2 to scale the point sizes (ignored when \code{psize} is specified). See \sQuote{Details}.} \item{colout}{optional character string to specify the color of the observed outcomes. Can also be a vector.} \item{col}{optional character string to specify the color of the summary polygon or fitted values.} \item{border}{optional character string to specify the border color of the summary polygon or fitted values.} \item{shade}{optional character string or a (logical or numeric) vector for shading rows of the plot. See \sQuote{Details}.} \item{colshade}{optional argument to specify the color for the shading.} \item{lty}{optional character string to specify the line type for the confidence intervals. If unspecified, the function sets this to \code{"solid"} by default.} \item{fonts}{optional character string to specify the font for the study labels, annotations, and the extra information (if specified via \code{ilab}). If unspecified, the default font is used.} \item{cex}{optional character and symbol expansion factor. If unspecified, the function sets this to a sensible value.} \item{cex.lab}{optional expansion factor for the x-axis title. If unspecified, the function sets this to a sensible value.} \item{cex.axis}{optional expansion factor for the x-axis labels. If unspecified, the function sets this to a sensible value.} \item{\dots}{other arguments.} } \details{ The plot shows the observed effect sizes or outcomes with corresponding confidence intervals. For an equal- and a random-effects model (i.e., for models without moderators), a four-sided polygon, sometimes called a summary \sQuote{diamond}, is added to the bottom of the forest plot, showing the summary estimate based on the model (with the center of the polygon corresponding to the estimate and the left/right edges indicating the confidence interval limits). The \code{col} and \code{border} arguments can be used to adjust the (border) color of the polygon. Drawing of the polgyon can be suppressed by setting \code{addfit=FALSE}. For random-effects models and if \code{addpred=TRUE}, a dotted line is added to the summary polygon which indicates the bounds of the prediction interval (the interval estimates where \code{level} \% of the true outcomes are expected to fall) (Riley et al., 2011). For random-effects models of class \code{"rma.mv"} (see \code{\link{rma.mv}}) with multiple \mjseqn{\tau^2} values, the \code{addpred} argument can be used to specify for which level of the inner factor the prediction interval should be provided (since the intervals differ depending on the \mjseqn{\tau^2} value). If the model should also contain multiple \mjseqn{\gamma^2} values, the \code{addpred} argument should then be of length 2 to specify the levels of both inner factors. See also \code{\link[=predict.rma]{predict}}, which is used to compute these interval bounds. For meta-regression models (i.e., models involving moderators), the fitted value for each study is added as a polygon to the plot. By default, the width of the polygons corresponds to the confidence interval limits for the fitted values. By setting \code{addpred=TRUE}, the width reflects the prediction interval limits. Again, the \code{col} and \code{border} arguments can be used to adjust the (border) color of the polygons. These polygons can be suppressed by setting \code{addfit=FALSE}. With the \code{transf} argument, the observed outcomes, summary estimate, fitted values, confidence interval bounds, and prediction interval bounds can be transformed with some suitable function. For example, when plotting log odds ratios, one could use \code{transf=exp} to obtain a forest plot showing the odds ratios. Alternatively, one can use the \code{atransf} argument to transform the x-axis labels and annotations (e.g., \code{atransf=exp}). See also \link{transf} for some other useful transformation functions in the context of a meta-analysis. The examples below illustrate the use of these arguments. By default, the studies are ordered from top to bottom (i.e., the first study in the dataset will be placed in row \mjseqn{k}, the second study in row \mjseqn{k-1}, and so on, until the last study, which is placed in the first row). The studies can be reordered with the \code{order} argument: \itemize{ \item \code{order="obs"}: the studies are ordered by the observed outcomes, \item \code{order="fit"}: the studies are ordered by the fitted values, \item \code{order="prec"}: the studies are ordered by their sampling variances, \item \code{order="resid"}: the studies are ordered by the size of their residuals, \item \code{order="rstandard"}: the studies are ordered by the size of their standardized residuals, \item \code{order="abs.resid"}: the studies are ordered by the size of their absolute residuals, \item \code{order="abs.rstandard"}: the studies are ordered by the size of their absolute standardized residuals. } Alternatively, it is also possible to set \code{order} equal to a variable based on which the studies will be ordered (see \sQuote{Examples}). Additional columns with information about the studies can be added to the plot via the \code{ilab} argument. This can either be a single variable or an entire matrix / data frame (with as many rows as there are studies in the forest plot). The \code{ilab.xpos} argument can then also be specified to indicate the horizontal position of the variables specified via \code{ilab}. \if{html}{The figure below illustrates how the elements in a forest plot can be arranged and the meaning of the some of the arguments such as \code{xlim}, \code{alim} or \code{at}, \code{ilab}, and \code{ilab.xpos}.} \if{html}{\figure{forest-arrangement.png}{options: width=800}} \if{html}{The figure corresponds to the following code: \preformatted{dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, data=dat, slab=paste(author, year, sep=", ")) forest(res, addpred=TRUE, xlim=c(-16,7), at=seq(-3,2,by=1), shade="zebra", ilab=cbind(tpos, tneg, cpos, cneg), ilab.xpos=c(-9.5,-8,-6,-4.5), cex=0.75, header="Author(s) and Year") text(c(-9.5,-8,-6,-4.5), res$k+2, c("TB+", "TB-", "TB+", "TB-"), cex=0.75, font=2) text(c(-8.75,-5.25), res$k+3, c("Vaccinated", "Control"), cex=0.75, font=2)}} \if{latex}{The figure below illustrates how the elements in a forest plot can be arranged and the meaning of the some of the arguments such as \code{xlim}, \code{alim} or \code{at}, \code{ilab}, and \code{ilab.xpos}. \figure{forest-arrangement.pdf}{options: width=5.5in} The figure corresponds to the following code: \preformatted{dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, data=dat, slab=paste(author, year, sep=", ")) forest(res, addpred=TRUE, xlim=c(-16,7), at=seq(-3,2,by=1), shade="zebra", ilab=cbind(tpos, tneg, cpos, cneg), ilab.xpos=c(-9.5,-8,-6,-4.5), cex=0.75, header="Author(s) and Year") text(c(-9.5,-8,-6,-4.5), res$k+2, c("TB+", "TB-", "TB+", "TB-"), cex=0.75, font=2) text(c(-8.75,-5.25), res$k+3, c("Vaccinated", "Control"), cex=0.75, font=2)}} Additional summary estimates can be added to the plot with the \code{\link{addpoly}} function. See the documentation for that function for examples. When \code{showweights=TRUE}, the annotations will include information about the weights given to the observed outcomes during the model fitting. For simple models (such as those fitted with the \code{\link{rma.uni}} function), these weights correspond to the \sQuote{inverse-variance weights} (but are given in percent). For models fitted with the \code{\link{rma.mv}} function, the weights are based on the diagonal of the weight matrix. Note that the weighting structure is typically more complex in such models (i.e., the weight matrix is usually not just a diagonal matrix) and the weights shown therefore do not reflect this complexity. See \code{\link[=weights.rma]{weights}} for more details (for the special case that \code{x} is an intercept-only \code{"rma.mv"} model, one can also set \code{showweights="rowsum"} to show the \sQuote{row-sum weights}). By default (i.e., when \code{psize} is not specified), the point sizes are a function of the square root of the model weights. This way, their areas are proportional to the weights. However, the point sizes are rescaled so that the smallest point size is \code{plim[1]} and the largest point size is \code{plim[2]}. As a result, their relative sizes (i.e., areas) no longer exactly correspond to their relative weights. If exactly relative point sizes are desired, one can set \code{plim[2]} to \code{NA}, in which case the points are rescaled so that the smallest point size corresponds to \code{plim[1]} and all other points are scaled accordingly. As a result, the largest point may be very large. Alternatively, one can set \code{plim[1]} to \code{NA}, in which case the points are rescaled so that the largest point size corresponds to \code{plim[2]} and all other points are scaled accordingly. As a result, the smallest point may be very small and essentially indistinguishable from the confidence interval line. To avoid the latter, one can also set \code{plim[3]}, which enforces a minimal point size. With the \code{shade} argument, one can shade rows of the plot. The argument can be set to one of the following character strings: \code{"zebra"} (same as \code{shade=TRUE}) or \code{"zebra2"} to use zebra-style shading (starting either at the first or second study) or to \code{"all"} in which case all rows are shaded. Alternatively, the argument can be set to a logical vector to indicates for which studies the rows should be shaded. Finally, the argument can also be a numeric vector to indicate which rows to shade. The \code{colshade} argument can be used to set the color of shaded rows. } \section{Note}{ The function sets some sensible values for the optional arguments, but it may be necessary to adjust these in certain circumstances. The function actually returns some information about the chosen values invisibly. Printing this information is useful as a starting point to make adjustments to the plot (see \sQuote{Examples}). Arguments \code{slab} and \code{ilab} and when specifying vectors for arguments \code{pch}, \code{psize}, \code{order}, and/or \code{colout} (and when \code{shade} is a logical vector), the variables specified are assumed to be of the same length as the data originally passed to the model fitting function (and if the \code{data} argument was used in the original model fit, then the variables will be searched for within this data frame first). Any subsetting and removal of studies with missing values is automatically applied to the variables specified via these arguments. If the number of studies is quite large, the labels, annotations, and symbols may become quite small and impossible to read. Stretching the plot window vertically may then provide a more readable figure (one should call the function again after adjusting the window size, so that the label/symbol sizes can be properly adjusted). Also, the \code{cex}, \code{cex.lab}, and \code{cex.axis} arguments are then useful to adjust the symbol and text sizes. If the outcome measure used for creating the plot is bounded (e.g., correlations are bounded between -1 and +1, proportions are bounded between 0 and 1), one can use the \code{olim} argument to enforce those limits (the observed outcomes and confidence/prediction intervals cannot exceed those bounds then). The models without moderators, the \code{col} argument can also be a vector of two elements, the first for specifying the color of the summary polygon, the second for specifying the color of the line for the prediction interval. The \code{lty} argument can also be a vector of up to three elements, the first for specifying the line type of the individual CIs (\code{"solid"} by default), the second for the line type of the prediction interval (\code{"dotted"} by default), the third for the line type of the horizontal lines that are automatically added to the plot (\code{"solid"} by default; set to \code{"blank"} to remove them). } \section{Additional Optional Arguments}{ There are some additional optional arguments that can be passed to the function via \code{...} (hence, they cannot be abbreviated): \describe{ \item{top}{single numeric value to specify the amount of space (in terms of number of rows) to leave empty at the top of the plot (e.g., for adding headers). The default is 3.} \item{annosym}{vector of length 3 to select the left bracket, separation, and right bracket symbols for the annotations. The default is \code{c(" [", ", ", "]")}. Can also include a 4th element to adjust the look of the minus symbol, for example to use a proper minus sign (\ifelse{latex}{\mjseqn{-}}{\enc{−}{-}}) instead of a hyphen-minus (-). Can also include a 5th element that should be a space-like symbol (e.g., an \sQuote{en space}) that is used in place of numbers (only relevant when trying to line up numbers exactly).} \item{tabfig}{single numeric value (either a 1, 2, or 3) to set \code{annosym} automatically to a vector that will exactly align the numbers in the annotations when using a font that provides \sQuote{tabular figures}. The appropriate value for this argument depends on the font used. For example, for fonts Calibri and Carlito, 1 or 2 should work; for fonts Source Sans 3 and Palatino Linotype, 1, 2, and 3 should all work; for Computer Moden and Latin Modern fonts, 2 should work; for Lato, Roboto, and Open Sans (and maybe Arial), 3 should work. Other fonts may work as well, but this is untested.} \item{textpos}{numeric vector of length 2 to specify the placement of the study labels and the annotations. The default is to use the horizontal limits of the plot region, i.e., the study labels to the right of \code{xlim[1]} and the annotations to the left of \code{xlim[2]}.} \item{rowadj}{numeric vector of length 3 to vertically adjust the position of the study labels, the annotations, and the extra information (if specified via \code{ilab}). This is useful for fine-tuning the position of text added with different positional alignments (i.e., argument \code{pos} in the \code{\link{text}} function).} } } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Lewis, S., & Clarke, M. (2001). Forest plots: Trying to see the wood and the trees. \emph{British Medical Journal}, \bold{322}(7300), 1479--1480. \verb{https://doi.org/10.1136/bmj.322.7300.1479} Riley, R. D., Higgins, J. P. T., & Deeks, J. J. (2011). Interpretation of random effects meta-analyses. \emph{British Medical Journal}, \bold{342}, d549. \verb{https://doi.org/10.1136/bmj.d549} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{forest}} for an overview of the various \code{forest} functions and \code{\link{forest.default}} for the function draw forest plots without a summary polygon. \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models for which forest plots can be drawn. \code{\link{addpoly}} for a function to add polygons to forest plots. } \examples{ ### meta-analysis of the log risk ratios using a random-effects model res <- rma(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, slab=paste(author, year, sep=", ")) ### default forest plot of the log risk ratios and summary estimate forest(res, header=TRUE) ### summary estimate in row -1; studies in rows k=13 through 1; horizontal ### lines in rows 0 and k+1; two extra lines of space at the top for headings, ### and other annotations; headings (if requested) in line k+2 op <- par(xpd=TRUE) text(x=-8.1, y=-1:16, -1:16, pos=4, cex=0.6, col="red") par(op) ### can also inspect defaults chosen defaults <- forest(res) defaults ### several forest plots illustrating the use of various arguments forest(res, cex=0.8) forest(res, cex=0.8, addpred=TRUE) forest(res, cex=0.8, alim=c(-3,3)) forest(res, cex=0.8, alim=c(-3,3), order="prec") forest(res, cex=0.8, alim=c(-3,3), order="obs") forest(res, cex=0.8, alim=c(-3,3), order=ablat) ### adjust xlim values to see how that changes the plot forest(res) par("usr")[1:2] # this shows what xlim values were chosen by default forest(res, xlim=c(-16,14)) forest(res, xlim=c(-18,10)) forest(res, xlim=c(-10,12)) ### illustrate transf argument forest(res, transf=exp, at=0:7, xlim=c(-8,12), cex=0.8, refline=1, header=TRUE) ### illustrate atransf argument forest(res, atransf=exp, at=log(c(0.05,0.25,1,4,20)), xlim=c(-8,7), cex=0.8, header=TRUE) ### showweights argument forest(res, atransf=exp, at=log(c(0.05,0.25,1,4,20)), xlim=c(-8,8), order="prec", showweights=TRUE, cex=0.8) ### illustrade shade argument forest(res, header=TRUE, shade="zebra") forest(res, header=TRUE, shade=year >= 1970) forest(res, header=TRUE, shade=c(1,5,10)) ### forest plot with extra annotations ### note: may need to widen plotting device to avoid overlapping text forest(res, atransf=exp, at=log(c(0.05, 0.25, 1, 4)), xlim=c(-16,6), ilab=cbind(tpos, tneg, cpos, cneg), ilab.xpos=c(-9.5,-8,-6,-4.5), cex=0.75, header="Author(s) and Year") op <- par(cex=0.75, font=2) text(c(-9.5,-8,-6,-4.5), res$k+2, c("TB+", "TB-", "TB+", "TB-")) text(c(-8.75,-5.25), res$k+3, c("Vaccinated", "Control")) par(op) ### mixed-effects model with absolute latitude as moderator res <- rma(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, mods = ~ ablat, data=dat.bcg, slab=paste(author, year, sep=", ")) ### forest plot with observed and fitted values forest(res, xlim=c(-9,5), order="fit", cex=0.8, ilab=ablat, ilab.xpos=-4, atransf=exp, at=log(c(0.05,0.25,1,4)), header="Author(s) and Year") text(-4, res$k+2, "Latitude", cex=0.8, font=2) ### meta-analysis of the log risk ratios using a random-effects model res <- rma(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, slab=paste(author, year, sep=", ")) ### for more complicated plots, the ylim and rows arguments may be useful forest(res) forest(res, ylim=c(-1.5, 16)) # the default forest(res, ylim=c(-1.5, 20)) # extra space in plot forest(res, ylim=c(-1.5, 20), rows=c(17:15, 12:6, 3:1)) # set positions ### forest plot with subgrouping of studies ### note: may need to widen plotting device to avoid overlapping text tmp <- forest(res, xlim=c(-16, 4.6), at=log(c(0.05, 0.25, 1, 4)), atransf=exp, ilab=cbind(tpos, tneg, cpos, cneg), ilab.xpos=c(-9.5,-8,-6,-4.5), cex=0.75, ylim=c(0.5, 21), order=alloc, rows=c(1:2,5:11,14:17), header="Author(s) and Year", shade=c(3,12,18)) op <- par(cex=0.75, font=2) text(c(-9.5,-8,-6,-4.5), tmp$ylim[2]-1, c("TB+", "TB-", "TB+", "TB-")) text(c(-8.75,-5.25), tmp$ylim[2], c("Vaccinated", "Control")) par(font=4) text(-16, c(18,12,3), c("Systematic Allocation", "Random Allocation", "Alternate Allocation"), pos=4) par(op) ### see also the addpoly.rma function for an example where summaries ### for the three subgroups are added to such a forest plot ### illustrate use of olim argument with a meta-analysis of raw correlation ### coefficients (data from Pritz, 1997); without olim=c(0,1), some of the ### CIs would have upper bounds larger than 1 dat <- escalc(measure="PR", xi=xi, ni=ni, data=dat.pritz1997) res <- rma(yi, vi, data=dat, slab=paste0(study, ") ", authors)) forest(res, xlim=c(-0.8,1.6), alim=c(0,1), psize=1, refline=coef(res), olim=c(0,1), header=TRUE) ### an example of a forest plot where the data have a multilevel structure and ### we want to reflect this by grouping together estimates from the same cluster dat <- dat.konstantopoulos2011 res <- rma.mv(yi, vi, random = ~ 1 | district/school, data=dat, slab=paste0("District ", district, ", School: ", school)) dd <- c(0,diff(dat$district)) dd[dd > 0] <- 1 rows <- (1:res$k) + cumsum(dd) op <- par(tck=-0.01, mgp = c(1.6,0.2,0), mar=c(3,8,1,6)) forest(res, cex=0.5, header=TRUE, rows=rows, ylim=c(0.5,max(rows)+3)) abline(h = rows[c(1,diff(rows)) == 2] - 1, lty="dotted") par(op) } \keyword{hplot} metafor/man/anova.rma.Rd0000644000176200001440000003742014505063152014642 0ustar liggesusers\name{anova.rma} \alias{anova} \alias{anova.rma} \title{Likelihood Ratio and Wald-Type Tests for 'rma' Objects} \description{ For two (nested) models of class \code{"rma.uni"} or \code{"rma.mv"}, the function provides a full versus reduced model comparison in terms of model fit statistics and a likelihood ratio test. When a single model is specified, a Wald-type test of one or more model coefficients or linear combinations thereof is carried out. \loadmathjax } \usage{ \method{anova}{rma}(object, object2, btt, X, att, Z, rhs, digits, refit=FALSE, \dots) } \arguments{ \item{object}{an object of class \code{"rma.uni"} or \code{"rma.mv"}.} \item{object2}{an (optional) object of class \code{"rma.uni"} or \code{"rma.mv"}. Only relevant when conducting a model comparison and likelihood ratio test. See \sQuote{Details}.} \item{btt}{optional vector of indices (or list thereof) to specify which coefficients should be included in the Wald-type test. Can also be a string to \code{\link{grep}} for. See \sQuote{Details}.} \item{X}{optional numeric vector or matrix to specify one or more linear combinations of the coefficients in the model that should be tested. See \sQuote{Details}.} \item{att}{optional vector of indices (or list thereof) to specify which scale coefficients should be included in the Wald-type test. Can also be a string to \code{\link{grep}} for. See \sQuote{Details}. Only relevant for location-scale models (see \code{\link{rma.uni}}).} \item{Z}{optional numeric vector or matrix to specify one or more linear combinations of the scale coefficients in the model that should be tested. See \sQuote{Details}. Only relevant for location-scale models (see \code{\link{rma.uni}}).} \item{rhs}{optional scalar or vector of values for the right-hand side of the null hypothesis when testing a set of coefficients (via \code{btt} or \code{att}) or linear combinations thereof (via \code{X} or \code{Z}). If unspecified, this defaults to a vector of zeros of the appropriate length. See \sQuote{Details}.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} \item{refit}{logical to indicate whether models fitted with REML estimation and differing in their fixed effects should be refitted with ML estimation when conducting a likelihood ratio test (the default is \code{FALSE}).} \item{\dots}{other arguments.} } \details{ The function can be used in three different ways: \enumerate{ \item When a single model is specified (via argument \code{object}), the function provides a Wald-type test of one or more model coefficients, that is, \mjsdeqn{\mbox{H}_0{:}\; \beta_{j \in \texttt{btt}} = 0,} where \mjseqn{\beta_{j \in \texttt{btt}}} is the set of coefficients to be tested (by default whether the set of coefficients is significantly different from zero, but one can specify a different value under the null hypothesis via argument \code{rhs}). In particular, for equal- or random-effects models (i.e., models without moderators), this is just the test of the single coefficient of the model (i.e., \mjseqn{\mbox{H}_0{:}\; \theta = 0} or \mjseqn{\mbox{H}_0{:}\; \mu = 0}). For models including moderators, an omnibus test of all model coefficients is conducted that excludes the intercept (the first coefficient) if it is included in the model. If no intercept is included in the model, then the omnibus test includes all coefficients in the model including the first. Alternatively, one can manually specify the indices of the coefficients to test via the \code{btt} (\sQuote{betas to test}) argument. For example, with \code{btt=c(3,4)}, only the third and fourth coefficients from the model are included in the test (if an intercept is included in the model, then it corresponds to the first coefficient in the model). Instead of specifying the coefficient numbers, one can specify a string for \code{btt}. In that case, \code{\link{grep}} will be used to search for all coefficient names that match the string (and hence, one can use regular expressions to fine-tune the search for matching strings). Using the \code{btt} argument, one can for example select all coefficients corresponding to a particular factor to test if the factor as a whole is significant. One can also specify a list of indices/strings, in which case tests of all list elements will be conducted. See \sQuote{Examples}. For location-scale models fitted with the \code{\link{rma.uni}} function, one can use the \code{att} argument in an analogous manner to specify the indices of the scale coefficients to test (i.e., \mjseqn{\mbox{H}_0{:}\; \alpha_{j \in \texttt{att}} = 0}, where \mjseqn{\alpha_{j \in \texttt{att}}} is the set of coefficients to be tested). \item When a single model is specified (via argument \code{object}), one can use the \code{X} argument\mjseqn{^1} to specify a linear combination of the coefficients in the model that should be tested using a Wald-type test, that is, \mjsdeqn{\mbox{H}_0{:}\; X \beta = 0,} where \code{X} is a (row) vector of the same length as there are coefficients in the model (by default whether the linear combination is significantly different from zero, but one can specify a different value under the null hypothesis via argument \code{rhs}). If a matrix of linear combinations is specified, each row defines a particular linear combination to be tested (if \code{rhs} is used, then it should either be a scalar or of the same length as the number of combinations to be tested). If the matrix is of full rank, an omnibus Wald-type test of all linear combinations is also provided. Linear combinations can also be obtained with the \code{\link[=predict.rma]{predict}} function, which provides corresponding confidence intervals. For location-scale models fitted with the \code{\link{rma.uni}} function, one can use the \code{Z} argument in an analogous manner to specify one or multiple linear combinations of the scale coefficients in the model that should be tested (i.e., \mjseqn{\mbox{H}_0{:}\; Z \alpha = 0}). \item When specifying two models for comparison (via arguments \code{object} and \code{object2}), the function provides a likelihood ratio test (LRT) comparing the two models. The two models must be based on the same set of data, must be of the same class, and should be nested for the LRT to make sense. Also, LRTs are not meaningful when using REML estimation and the two models differ in terms of their fixed effects (setting \code{refit=TRUE} automatically refits the two models using ML estimation). Also, the theory underlying LRTs is only really applicable when comparing models that were fitted with ML/REML estimation, so if some other estimation was used to fit the two models, the results should be treated with caution. } --------- \mjseqn{^1} This argument used to be called \code{L}, but was renamed to \code{X} (but using \code{L} in place of \code{X} still works). } \value{ An object of class \code{"anova.rma"}. When a single model is specified (without any further arguments or together with the \code{btt} or \code{att} argument), the object is a list containing the following components: \item{QM}{test statistic of the Wald-type test of the model coefficients.} \item{QMdf}{corresponding degrees of freedom.} \item{QMp}{corresponding p-value.} \item{btt}{indices of the coefficients tested by the Wald-type test.} \item{k}{number of outcomes included in the analysis.} \item{p}{number of coefficients in the model (including the intercept).} \item{m}{number of coefficients included in the Wald-type test.} \item{\dots}{some additional elements/values.} When \code{btt} or \code{att} was a list, then the object is a list of class \code{"list.anova.rma"}, where each element is an \code{"anova.rma"} object as described above. When argument \code{X} is used, the object is a list containing the following components: \item{QM}{test statistic of the omnibus Wald-type test of all linear combinations.} \item{QMdf}{corresponding degrees of freedom.} \item{QMp}{corresponding p-value.} \item{hyp}{description of the linear combinations tested.} \item{Xb}{values of the linear combinations.} \item{se}{standard errors of the linear combinations.} \item{zval}{test statistics of the linear combinations.} \item{pval}{corresponding p-values.} When two models are specified, the object is a list containing the following components: \item{fit.stats.f}{log-likelihood, deviance, AIC, BIC, and AICc for the full model.} \item{fit.stats.r}{log-likelihood, deviance, AIC, BIC, and AICc for the reduced model.} \item{parms.f}{number of parameters in the full model.} \item{parms.r}{number of parameters in the reduced model.} \item{LRT}{likelihood ratio test statistic.} \item{pval}{corresponding p-value.} \item{QE.f}{test statistic of the test for (residual) heterogeneity from the full model.} \item{QE.r}{test statistic of the test for (residual) heterogeneity from the reduced model.} \item{tau2.f}{estimated \mjseqn{\tau^2} value from the full model. \code{NA} for \code{"rma.mv"} objects.} \item{tau2.r}{estimated \mjseqn{\tau^2} value from the reduced model. \code{NA} for \code{"rma.mv"} objects.} \item{R2}{amount (in percent) of the heterogeneity in the reduced model that is accounted for in the full model (\code{NA} for \code{"rma.mv"} objects). This can be regarded as a pseudo \mjseqn{R^2} statistic (Raudenbush, 2009). Note that the value may not be very accurate unless \mjseqn{k} is large (Lopez-Lopez et al., 2014).} \item{\dots}{some additional elements/values.} The results are formatted and printed with the \code{\link[=print.anova.rma]{print}} function. To format the results as a data frame, one can use the \code{\link[=as.data.frame.anova.rma]{as.data.frame}} function. } \note{ The function can also be used to conduct a likelihood ratio test (LRT) for the amount of (residual) heterogeneity in random- and mixed-effects models. The full model should then be fitted with either \code{method="ML"} or \code{method="REML"} and the reduced model with \code{method="EE"} (or with \code{tau2=0}). The p-value for the test is based on a chi-square distribution with 1 degree of freedom, but actually needs to be adjusted for the fact that the parameter (i.e., \mjseqn{\tau^2}) falls on the boundary of the parameter space under the null hypothesis (see Viechtbauer, 2007, for more details). LRTs for variance components in more complex models (as fitted with the \code{\link{rma.mv}} function) can also be conducted in this manner (see \sQuote{Examples}). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Hardy, R. J., & Thompson, S. G. (1996). A likelihood approach to meta-analysis with random effects. \emph{Statistics in Medicine}, \bold{15}(6), 619--629. \verb{https://doi.org/10.1002/(sici)1097-0258(19960330)15:6\%3C619::aid-sim188\%3E3.0.co;2-a} Huizenga, H. M., Visser, I., & Dolan, C. V. (2011). Testing overall and moderator effects in random effects meta-regression. \emph{British Journal of Mathematical and Statistical Psychology}, \bold{64}(1), 1--19. \verb{https://doi.org/10.1348/000711010X522687} \enc{López-López}{Lopez-Lopez}, J. A., \enc{Marín-Martínez}{Marin-Martinez}, F., \enc{Sánchez-Meca}{Sanchez-Meca}, J., Van den Noortgate, W., & Viechtbauer, W. (2014). Estimation of the predictive power of the model in mixed-effects meta-regression: A simulation study. \emph{British Journal of Mathematical and Statistical Psychology}, \bold{67}(1), 30--48. \verb{https://doi.org/10.1111/bmsp.12002} Raudenbush, S. W. (2009). Analyzing effect sizes: Random effects models. In H. Cooper, L. V. Hedges, & J. C. Valentine (Eds.), \emph{The handbook of research synthesis and meta-analysis} (2nd ed., pp. 295--315). New York: Russell Sage Foundation. Viechtbauer, W. (2007). Hypothesis tests for population heterogeneity in meta-analysis. \emph{British Journal of Mathematical and Statistical Psychology}, \bold{60}(1), 29--60. \verb{https://doi.org/10.1348/000711005X64042} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W., & \enc{López-López}{Lopez-Lopez}, J. A. (2022). Location-scale models for meta-analysis. \emph{Research Synthesis Methods}. \bold{13}(6), 697--715. \verb{https://doi.org/10.1002/jrsm.1562} } \seealso{ \code{\link{rma.uni}} and \code{\link{rma.mv}} for functions to fit models for which likelihood ratio and Wald-type tests can be conducted. \code{\link[=print.anova.rma]{print}} for the print method and \code{\link[=as.data.frame.anova.rma]{as.data.frame}} for the method to format the results as a data frame. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit random-effects model res1 <- rma(yi, vi, data=dat, method="ML") res1 ### fit mixed-effects model with two moderators (absolute latitude and publication year) res2 <- rma(yi, vi, mods = ~ ablat + year, data=dat, method="ML") res2 ### Wald-type test of the two moderators anova(res2) ### alternative way of specifying the same test anova(res2, X=rbind(c(0,1,0), c(0,0,1))) ### corresponding likelihood ratio test anova(res1, res2) ### Wald-type test of a linear combination anova(res2, X=c(1,35,1970)) ### use predict() to obtain the same linear combination (with its CI) predict(res2, newmods=c(35,1970)) ### mixed-effects model with three moderators res3 <- rma(yi, vi, mods = ~ ablat + year + alloc, data=dat, method="ML") res3 ### Wald-type test of the 'alloc' factor anova(res3, btt=4:5) ### instead of specifying the coefficient numbers, grep for "alloc" anova(res3, btt="alloc") ### specify a list for the 'btt' argument anova(res3, btt=list(2,3,4:5)) ############################################################################ ### an example of doing LRTs of variance components in more complex models dat <- dat.konstantopoulos2011 res <- rma.mv(yi, vi, random = ~ 1 | district/school, data=dat) ### likelihood ratio test of the district-level variance component res0 <- rma.mv(yi, vi, random = ~ 1 | district/school, data=dat, sigma2=c(0,NA)) anova(res, res0) ### likelihood ratio test of the school-level variance component res0 <- rma.mv(yi, vi, random = ~ 1 | district/school, data=dat, sigma2=c(NA,0)) anova(res, res0) ### likelihood ratio test of both variance components simultaneously res0 <- rma.mv(yi, vi, data=dat) anova(res, res0) ############################################################################ ### an example illustrating a workflow involving cluster-robust inference dat <- dat.assink2016 ### assume that the effect sizes within studies are correlated with rho=0.6 V <- vcalc(vi, cluster=study, obs=esid, data=dat, rho=0.6) ### fit multilevel model using this approximate V matrix res <- rma.mv(yi, V, random = ~ 1 | study/esid, data=dat) res ### likelihood ratio tests of the two variance components res0 <- rma.mv(yi, V, random = ~ 1 | study/esid, data=dat, sigma2=c(0,NA)) anova(res, res0) res0 <- rma.mv(yi, V, random = ~ 1 | study/esid, data=dat, sigma2=c(NA,0)) anova(res, res0) ### use cluster-robust methods for inferences about the fixed effects sav <- robust(res, cluster=study, clubSandwich=TRUE) sav ### examine if 'deltype' is a potential moderator res <- rma.mv(yi, V, mods = ~ deltype, random = ~ 1 | study/esid, data=dat) sav <- robust(res, cluster=study, clubSandwich=TRUE) sav ### note: the (denominator) dfs for the omnibus F-test are very low, so the results ### of this test may not be trustworthy; consider using cluster wild bootstrapping \dontrun{ library(wildmeta) Wald_test_cwb(res, constraints=constrain_zero(2:3), R=1000, seed=1234) } } \keyword{models} metafor/man/methods.matreg.Rd0000644000176200001440000000272214505063152015676 0ustar liggesusers\name{coef.matreg} \alias{coef.matreg} \alias{vcov.matreg} \title{Extract the Model Coefficients and Variance-Covariance Matrix from 'matreg' Objects} \description{ Methods for objects of class \code{"matreg"}. } \usage{ \method{coef}{matreg}(object, \dots) \method{vcov}{matreg}(object, \dots) } \arguments{ \item{object}{an object of class \code{"matreg"}.} \item{\dots}{other arguments.} } \details{ The \code{coef} function extracts the estimated model coefficients from objects of class \code{"matreg"}. The \code{vcov} function extracts the corresponding variance-covariance matrix. } \value{ Either a vector with the estimated model coefficients or a variance-covariance matrix. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{matreg}} for the function to create \code{matreg} objects. } \examples{ ### fit a regression model with lm() to the 'mtcars' dataset res <- lm(mpg ~ hp + wt + am, data=mtcars) coef(res) vcov(res) ### covariance matrix of the dataset S <- cov(mtcars) ### fit the same regression model using matreg() res <- matreg(y="mpg", x=c("hp","wt","am"), R=S, cov=TRUE, means=colMeans(mtcars), n=nrow(mtcars)) coef(res) vcov(res) } \keyword{models} metafor/man/blsplit.Rd0000644000176200001440000000303114505063152014420 0ustar liggesusers\name{blsplit} \alias{blsplit} \title{Split Block Diagonal Matrix} \description{ Function to split a block diagonal matrix into a list of sub-matrices. } \usage{ blsplit(x, cluster, fun, args, sort=FALSE) } \arguments{ \item{x}{a block diagonal matrix.} \item{cluster}{vector to specify the clustering variable to use for splitting.} \item{fun}{optional argument to specify a function to apply to each sub-matrix.} \item{args}{optional argument to specify any additional argument(s) for the function specified via \code{fun}.} \item{sort}{logical to indicate whether to sort the list by the unique cluster values (the default is \code{FALSE}).} } \value{ A list of one or more sub-matrices. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \seealso{ \code{\link{bldiag}} for a function to create a block diagonal matrix based on sub-matrices. \code{\link{vcalc}} for a function to construct a variance-covariance matrix of dependent effect sizes or outcomes, which often has a block diagonal structure. } \examples{ ### copy data into 'dat' dat <- dat.assink2016 ### assume that the effect sizes within studies are correlated with rho=0.6 V <- vcalc(vi, cluster=study, obs=esid, data=dat, rho=0.6) ### split V matrix into list of sub-matrices Vs <- blsplit(V, cluster=dat$study) Vs[1:2] lapply(Vs[1:2], cov2cor) ### illustrate the use of the fun and args arguments blsplit(V, cluster=dat$study, cov2cor)[1:2] blsplit(V, cluster=dat$study, round, 3)[1:2] } \keyword{manip} metafor/man/to.table.Rd0000644000176200001440000001376014505063152014471 0ustar liggesusers\name{to.table} \alias{to.table} \title{Convert Data from Vector to Table Format} \description{ Function to convert summary data in vector format to the corresponding table format. \loadmathjax } \usage{ to.table(measure, ai, bi, ci, di, n1i, n2i, x1i, x2i, t1i, t2i, m1i, m2i, sd1i, sd2i, xi, mi, ri, ti, sdi, ni, data, slab, subset, add=1/2, to="none", drop00=FALSE, rows, cols) } \arguments{ \item{measure}{a character string to specify the effect size or outcome measure corresponding to the summary data supplied. See \sQuote{Details} and the documentation of the \code{\link{escalc}} function for possible options.} \item{ai}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (upper left cell).} \item{bi}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (upper right cell).} \item{ci}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (lower left cell).} \item{di}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (lower right cell).} \item{n1i}{vector with the group sizes or row totals (first group/row).} \item{n2i}{vector with the group sizes or row totals (second group/row).} \item{x1i}{vector with the number of events (first group).} \item{x2i}{vector with the number of events (second group).} \item{t1i}{vector with the total person-times (first group).} \item{t2i}{vector with the total person-times (second group).} \item{m1i}{vector with the means (first group or time point).} \item{m2i}{vector with the means (second group or time point).} \item{sd1i}{vector with the standard deviations (first group or time point).} \item{sd2i}{vector with the standard deviations (second group or time point).} \item{xi}{vector with the frequencies of the event of interest.} \item{mi}{vector with the frequencies of the complement of the event of interest or the group means.} \item{ri}{vector with the raw correlation coefficients.} \item{ti}{vector with the total person-times.} \item{sdi}{vector with the standard deviations.} \item{ni}{vector with the sample/group sizes.} \item{data}{optional data frame containing the variables given to the arguments above.} \item{slab}{optional vector with labels for the studies.} \item{subset}{optional (logical or numeric) vector to specify the subset of studies that should be included in the array returned by the function.} \item{add}{see the documentation of the \code{\link{escalc}} function.} \item{to}{see the documentation of the \code{\link{escalc}} function.} \item{drop00}{see the documentation of the \code{\link{escalc}} function.} \item{rows}{optional vector with row/group names.} \item{cols}{optional vector with column/outcome names.} } \details{ The \code{\link{escalc}} function describes a wide variety of effect sizes or outcome measures that can be computed for a meta-analysis. The summary data used to compute those measures are typically contained in vectors, each element corresponding to a study. The \code{to.table} function takes this information and constructs an array of \mjseqn{k} tables from these data. For example, in various fields (such as the health and medical sciences), the response variable measured is often dichotomous (binary), so that the data from a study comparing two different groups can be expressed in terms of a \mjeqn{2 \times 2}{2x2} table, such as: \tabular{lcccccc}{ \tab \ics \tab outcome 1 \tab \ics \tab outcome 2 \tab \ics \tab total \cr group 1 \tab \ics \tab \code{ai} \tab \ics \tab \code{bi} \tab \ics \tab \code{n1i} \cr group 2 \tab \ics \tab \code{ci} \tab \ics \tab \code{di} \tab \ics \tab \code{n2i} } where \code{ai}, \code{bi}, \code{ci}, and \code{di} denote the cell frequencies (i.e., the number of individuals falling into a particular category) and \code{n1i} and \code{n2i} the row totals (i.e., the group sizes). The cell frequencies in \mjseqn{k} such \mjeqn{2 \times 2}{2x2} tables can be specified via the \code{ai}, \code{bi}, \code{ci}, and \code{di} arguments (or alternatively, via the \code{ai}, \code{ci}, \code{n1i}, and \code{n2i} arguments). The function then creates the corresponding \mjeqn{2 \times 2 \times k}{2*2*k} array of tables. The \code{measure} argument should then be set equal to one of the outcome measures that can be computed based on this type of data, such as \code{"RR"}, \code{"OR"}, \code{"RD"} (it is not relevant which specific measure is chosen, as long as it corresponds to the specified summary data). See the documentation of the \code{\link{escalc}} function for more details on the types of data formats available. The examples below illustrate the use of this function. } \value{ An array with \mjseqn{k} elements each consisting of either 1 or 2 rows and an appropriate number of columns. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{escalc}} for a function to compute observed effect sizes or outcomes (and corresponding sampling variances) based on similar inputs. \code{\link{to.long}} for a function to turn similar inputs into a long format dataset. } \examples{ ### create tables dat <- to.table(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, slab=paste(author, year, sep=", "), rows=c("Vaccinated", "Not Vaccinated"), cols=c("TB+", "TB-")) dat ### create tables dat <- to.table(measure="IRR", x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, data=dat.hart1999, slab=paste(study, year, sep=", "), rows=c("Warfarin Group", "Placebo/Control Group")) dat ### create tables dat <- to.table(measure="MD", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat.normand1999, slab=source, rows=c("Specialized Care", "Routine Care")) dat } \keyword{manip} metafor/man/macros/0000755000176200001440000000000013722772107013756 5ustar liggesusersmetafor/man/macros/metafor.Rd0000644000176200001440000000021514161317561015675 0ustar liggesusers\newcommand{\icsl}{\out{\hspace*{0.1em}}} \newcommand{\icsh}{\out{ }} \newcommand{\ics}{\ifelse{latex}{\icsl}{\ifelse{html}{\icsh}{ }}} metafor/man/methods.vif.rma.Rd0000644000176200001440000000241414505063152015757 0ustar liggesusers\name{methods.vif.rma} \alias{methods.vif.rma} \alias{as.data.frame.vif.rma} \title{Methods for 'vif.rma' Objects} \description{ Methods for objects of class \code{"vif.rma"}. } \usage{ \method{as.data.frame}{vif.rma}(x, \dots) } \arguments{ \item{x}{an object of class \code{"vif.rma"}.} \item{\dots}{other arguments.} } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \examples{ ### copy data into 'dat' dat <- dat.bcg ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) ### fit mixed-effects meta-regression model res <- rma(yi, vi, mods = ~ ablat + year + alloc, data=dat) ### get variance inflation factors for all individual coefficients sav <- vif(res) sav ### turn object into a regular data frame as.data.frame(sav) ### get VIFs for ablat and year and the generalized VIF for alloc sav <- vif(res, btt=list("ablat","alloc","year")) sav ### turn object into a regular data frame as.data.frame(sav) } \keyword{internal} metafor/man/ranktest.Rd0000644000176200001440000000737514505063152014621 0ustar liggesusers\name{ranktest} \alias{ranktest} \title{Rank Correlation Test for Funnel Plot Asymmetry} \description{ Function to carry out the rank correlation test for funnel plot asymmetry. } \usage{ ranktest(x, vi, sei, subset, data, digits, \dots) } \arguments{ \item{x}{a vector with the observed effect sizes or outcomes or an object of class \code{"rma"}.} \item{vi}{vector with the corresponding sampling variances (ignored if \code{x} is an object of class \code{"rma"}).} \item{sei}{vector with the corresponding standard errors (note: only one of the two, \code{vi} or \code{sei}, needs to be specified).} \item{subset}{optional (logical or numeric) vector to specify the subset of studies that should be included in the test (ignored if \code{x} is an object of class \code{"rma"}).} \item{data}{optional data frame containing the variables given to the arguments above.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded.} \item{\dots}{other arguments.} } \details{ The function carries out the rank correlation test as described by Begg and Mazumdar (1994). The test can be used to examine whether the observed effect sizes or outcomes and the corresponding sampling variances are correlated. A high correlation would indicate that the funnel plot is asymmetric, which may be a result of publication bias. One can either pass a vector with the observed effect sizes or outcomes (via \code{x}) and the corresponding sampling variances via \code{vi} (or the standard errors via \code{sei}) to the function or an object of class \code{"rma"}. When passing a model object, the model must be a model without moderators (i.e., either an equal- or a random-effects model). } \value{ An object of class \code{"ranktest"}. The object is a list containing the following components: \item{tau}{the estimated value of Kendall's tau rank correlation coefficient.} \item{pval}{the corresponding p-value for the test that the true tau value is equal to zero.} The results are formatted and printed with the \code{\link[=print.ranktest]{print}} function. } \note{ The method does not depend on the model fitted. Therefore, regardless of the model passed to the function, the results of the rank test will always be the same. See \code{\link{regtest}} for tests of funnel plot asymmetry that are based on regression models and model dependent. The function makes use of the \code{\link{cor.test}} function with \code{method="kendall"}. If possible, an exact p-value is provided; otherwise, a large-sample approximation is used. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Begg, C. B., & Mazumdar, M. (1994). Operating characteristics of a rank correlation test for publication bias. \emph{Biometrics}, \bold{50}(4), 1088--1101. \verb{https://doi.org/10.2307/2533446} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{regtest}} for the regression test, \code{\link{trimfill}} for the trim and fill method, \code{\link{tes}} for the test of excess significance, \code{\link{fsn}} to compute the fail-safe N (file drawer analysis), and \code{\link{selmodel}} for selection models. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit random-effects model res <- rma(yi, vi, data=dat) ### carry out the rank correlation test ranktest(res) ### can also pass the observed outcomes and corresponding sampling variances to the function ranktest(yi, vi, data=dat) } \keyword{htest} metafor/man/plot.cumul.rma.Rd0000644000176200001440000001021714505063152015633 0ustar liggesusers\name{plot.cumul.rma} \alias{plot.cumul.rma} \title{Plot Method for 'cumul.rma' Objects} \description{ Function to plot objects of class \code{"cumul.rma"}. \loadmathjax } \usage{ \method{plot}{cumul.rma}(x, yaxis, xlim, ylim, xlab, ylab, at, transf, atransf, targs, digits, cols, grid=TRUE, pch=19, cex=1, lwd=2, \dots) } \arguments{ \item{x}{an object of class \code{"cumul.rma"} obtained with \code{\link{cumul}}.} \item{yaxis}{either \code{"tau2"}, \code{"I2"}, or \code{"H2"} to indicate what values should be placed on the y-axis. See \sQuote{Details}.} \item{xlim}{x-axis limits. If unspecified, the function sets the x-axis limits to some sensible values.} \item{ylim}{y-axis limits. If unspecified, the function sets the y-axis limits to some sensible values.} \item{xlab}{title for the x-axis. If unspecified, the function sets an appropriate axis title.} \item{ylab}{title for the y-axis. If unspecified, the function sets an appropriate axis title.} \item{at}{position of the x-axis tick marks and corresponding labels. If unspecified, the function sets the tick mark positions/labels to some sensible values.} \item{transf}{optional argument to specify a function to transform the summary estimates (e.g., \code{transf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{atransf}{optional argument to specify a function to transform the x-axis labels (e.g., \code{atransf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{targs}{optional arguments needed by the function specified via \code{transf} or \code{atransf}.} \item{digits}{optional integer to specify the number of decimal places to which the tick mark labels of the x- and y-axis should be rounded. Can also be a vector of two integers, the first to specify the number of decimal places for the x-axis, the second for the y-axis labels (e.g., \code{digits=c(2,3)}). If unspecified, the function tries to set the argument to some sensible values.} \item{cols}{vector with two or more colors for visualizing the order of the cumulative results.} \item{grid}{logical to specify whether a grid should be added to the plot. Can also be a color name.} \item{pch}{plotting symbol to use. By default, a filled circle is used. See \code{\link{points}} for other options.} \item{cex}{symbol expansion factor.} \item{lwd}{line width.} \item{\dots}{other arguments.} } \details{ The function can be used to visualize the results from a cumulative meta-analysis as obtained with the \code{\link{cumul}} function. The plot shows the model estimate (i.e., the estimated overall/average outcome) on the x-axis and some measure of heterogeneity on the y-axis in the cumulative order of the results in the \code{"cumul.rma"} object. By default, \mjseqn{\tau^2} is shown on the y-axis for a random-effects model and \mjseqn{I^2} otherwise, but one can also use argument \code{yaxis} to specify the measure of heterogeneity to place on the y-axis. The color gradient of the points/lines indicates the order of the cumulative results (by default, light gray at the beginning, dark gray at the end). A different set of colors can be chosen via the \code{cols} argument. See \sQuote{Examples}. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link[=cumul.rma.uni]{cumul}} for the function to conduct a cumulative meta-analysis. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### random-effects model res <- rma(yi, vi, data=dat) ### cumulative meta-analysis (in the order of publication year) sav <- cumul(res, order=year) ### plot of model estimate and tau^2 over time plot(sav) ### illustrate some other plot options plot(sav, yaxis="I2", ylim=c(0,100), transf=exp, xlim=c(0.25,0.55), lwd=5, cex=1.5, cols=c("green","blue","red")) } \keyword{hplot} metafor/man/to.wide.Rd0000644000176200001440000001307214505063152014326 0ustar liggesusers\name{to.wide} \alias{to.wide} \title{Convert Data from a Long to a Wide Format} \description{ Function to convert data given in long format to a wide format. } \usage{ to.wide(data, study, grp, ref, grpvars, postfix=c(".1",".2"), addid=TRUE, addcomp=TRUE, adddesign=TRUE, minlen=2, var.names=c("id","comp","design")) } \arguments{ \item{data}{a data frame in long format.} \item{study}{either the name (given as a character string) or the position (given as a single number) of the study variable in the data frame.} \item{grp}{either the name (given as a character string) or the position (given as a single number) of the group variable in the data frame.} \item{ref}{optional character string to specify the reference group (must be one of the groups in the group variable). If not given, the most frequently occurring group is used as the reference group.} \item{grpvars}{either the names (given as a character vector) or the positions (given as a numeric vector) of the group-level variables.} \item{postfix}{a character string of length 2 giving the affix that is placed after the names of the group-level variables for the first and second group.} \item{addid}{logical to specify whether a row id variable should be added to the data frame (the default is \code{TRUE}).} \item{addcomp}{logical to specify whether a comparison id variable should be added to the data frame (the default is \code{TRUE}).} \item{adddesign}{logical to specify whether a design id variable should be added to the data frame (the default is \code{TRUE}).} \item{minlen}{integer to specify the minimum length of the shortened group names for the comparison and design id variables (the default is 2).} \item{var.names}{character vector with three elements to specify the name of the id, comparison, and design variables (the defaults are \code{"id"}, \code{"comp"}, and \code{"design"}, respectively).} } \details{ A meta-analytic dataset may be structured in a \sQuote{long} format, where each row in the dataset corresponds to a particular study group (e.g., treatment arm). Using this function, such a dataset can be restructured into a \sQuote{wide} format, where each group within a study is contrasted against a particular reference group. The \code{study} and \code{group} arguments are used to specify the study and group variables in the dataset (either as character strings or as numbers indicating the column positions of these variables in the dataset). Optional argument \code{ref} is used to specify the reference group (this must be one of the groups in the \code{group} variable). Argument \code{grpvars} is used to specify (either as a character vector or by giving the column positions) of those variables in the dataset that correspond to group-level outcomes (the remaining variables are treated as study-level outcomes). The dataset is restructured so that a two-group study will yield a single row in the restructured dataset, contrasting the first group against the second/reference group. For studies with more than two groups (often called \sQuote{multiarm} or \sQuote{multitreatment} studies in the medical literature), the reference group is repeated as many times as needed (so a three-group study would yield two rows in the restructured dataset, contrasting two groups against a common reference group). If a study does not include the reference group, then another group from the study will be used as the reference group. This group is chosen based on the factor levels of the \code{grp} variable (i.e., the last level that occurs in the study becomes the reference group). To distinguish the names of the group-level outcome variables for the two first and second group in the restructured dataset, the strings given for the \code{postfix} argument are placed after the respective variable names. If requested, row id, comparison id, and design id variables are added to the restructured dataset. The row id is simply a unique number for each row in the dataset. The comparison id variable indicates which two groups have been compared against each other). The design id variable indicates which groups were included in a particular study. The group names are shortened for the comparison and design variables (to at least \code{minlen}; the actual length might be longer to ensure uniqueness of the group names). The examples below illustrate the use of this function. } \value{ A data frame with rows contrasting groups against a reference group and an appropriate number of columns (depending on the number of group-level outcome variables). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{contrmat}} for a function to construct a contrast matrix based on a dataset in wide format. \code{\link[metadat]{dat.hasselblad1998}}, \code{\link[metadat]{dat.lopez2019}}, \code{\link[metadat]{dat.obrien2003}}, \code{\link[metadat]{dat.pagliaro1992}}, \code{\link[metadat]{dat.senn2013}} for illustrative examples. } \examples{ ### data in long format dat <- dat.senn2013 dat <- dat[c(1,4,3,2,5,6)] dat ### restructure to wide format dat <- to.wide(dat, study="study", grp="treatment", ref="placebo", grpvars=4:6) dat ### data in long format dat <- dat.hasselblad1998 dat ### restructure to wide format dat <- to.wide(dat, study="study", grp="trt", ref="no_contact", grpvars=6:7) dat } \keyword{manip} metafor/man/forest.cumul.rma.Rd0000644000176200001440000002243114505063152016160 0ustar liggesusers\name{forest.cumul.rma} \alias{forest.cumul.rma} \title{Forest Plots (Method for 'cumul.rma' Objects)} \description{ Function to create forest plots for objects of class \code{"cumul.rma"}. } \usage{ \method{forest}{cumul.rma}(x, annotate=TRUE, header=FALSE, xlim, alim, olim, ylim, at, steps=5, level=x$level, refline=0, digits=2L, width, xlab, ilab, ilab.xpos, ilab.pos, transf, atransf, targs, rows, efac=1, pch, psize, col, shade, colshade, lty, fonts, cex, cex.lab, cex.axis, \dots) } \arguments{ \item{x}{an object of class \code{"cumul.rma"} obtained with \code{\link{cumul}}.} \item{annotate}{logical to specify whether annotations should be added to the plot (the default is \code{TRUE}).} \item{header}{logical to specify whether column headings should be added to the plot (the default is \code{FALSE}). Can also be a character vector to specify the left and right headings (or only the left one).} \item{xlim}{horizontal limits of the plot region. If unspecified, the function sets the horizontal plot limits to some sensible values.} \item{alim}{the x-axis limits. If unspecified, the function sets the x-axis limits to some sensible values.} \item{olim}{optional argument to specify observation/outcome limits. If unspecified, no limits are used.} \item{ylim}{the y-axis limits of the plot. If unspecified, the function sets the y-axis limits to some sensible values.} \item{at}{position of the x-axis tick marks and corresponding labels. If unspecified, the function sets the tick mark positions/labels to some sensible values.} \item{steps}{the number of tick marks for the x-axis (the default is 5). Ignored when the positions are specified via the \code{at} argument.} \item{level}{numeric value between 0 and 100 to specify the confidence interval level (see \link[=misc-options]{here} for details). The default is to take the value from the object.} \item{refline}{numeric value to specify the location of the vertical \sQuote{reference} line (the default is 0). The line can be suppressed by setting this argument to \code{NA}.} \item{digits}{integer to specify the number of decimal places to which the tick mark labels of the x-axis and the annotations should be rounded (the default is \code{2L}). Can also be a vector of two integers, the first to specify the number of decimal places for the annotations, the second for the x-axis labels. When specifying an integer (e.g., \code{2L}), trailing zeros after the decimal mark are dropped for the x-axis labels. When specifying a numeric value (e.g., \code{2}), trailing zeros are retained.} \item{width}{optional integer to manually adjust the width of the columns for the annotations (either a single integer or a vector of the same length as the number of annotation columns).} \item{xlab}{title for the x-axis. If unspecified, the function sets an appropriate axis title. Can also be a vector of three/two values (to also/only add labels at the end points of the x-axis limits).} \item{ilab}{optional vector, matrix, or data frame providing additional information about the studies that should be added to the plot.} \item{ilab.xpos}{numeric vector to specify the horizontal position(s) of the variable(s) given via \code{ilab}.} \item{ilab.pos}{integer(s) (either 1, 2, 3, or 4) to specify the alignment of the vector(s) given via \code{ilab} (2 means right, 4 mean left aligned). If unspecified, the default is to center the labels.} \item{transf}{optional argument to specify a function to transform the estimates and confidence interval bounds (e.g., \code{transf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{atransf}{optional argument to specify a function to transform the x-axis labels and annotations (e.g., \code{atransf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{targs}{optional arguments needed by the function specified via \code{transf} or \code{atransf}.} \item{rows}{optional vector to specify the rows (or more generally, the horizontal positions) for plotting the outcomes. Can also be a single value to specify the row (horizontal position) of the first outcome (the remaining outcomes are then plotted below this starting row).} \item{efac}{vertical expansion factor for confidence interval limits and arrows. The default value of 1 should usually work okay. Can also be a vector of two numbers, the first for CI limits, the second for arrows.} \item{pch}{plotting symbol to use for the estimates. By default, a filled square is used. See \code{\link{points}} for other options. Can also be a vector of values.} \item{psize}{numeric value to specify the point sizes for the estimates (the default is 1). Can also be a vector of values.} \item{col}{optional character string to specify the color of the estimates. Can also be a vector.} \item{shade}{optional character string or a (logical or numeric) vector for shading rows of the plot.} \item{colshade}{optional argument to specify the color for the shading.} \item{lty}{optional character string to specify the line type for the confidence intervals. If unspecified, the function sets this to \code{"solid"} by default.} \item{fonts}{optional character string to specify the font for the study labels, annotations, and the extra information (if specified via \code{ilab}). If unspecified, the default font is used.} \item{cex}{optional character and symbol expansion factor. If unspecified, the function sets this to a sensible value.} \item{cex.lab}{optional expansion factor for the x-axis title. If unspecified, the function sets this to a sensible value.} \item{cex.axis}{optional expansion factor for the x-axis labels. If unspecified, the function sets this to a sensible value.} \item{\dots}{other arguments.} } \details{ The plot shows the estimated (average) outcome with corresponding confidence interval as one study at a time is added to the analysis. See \code{\link{forest.default}} and \code{\link{forest.rma}} for further details on the purpose of the various arguments. } \section{Note}{ The function sets some sensible values for the optional arguments, but it may be necessary to adjust these in certain circumstances. The function actually returns some information about the chosen values invisibly. Printing this information is useful as a starting point to make adjustments to the plot. If the number of studies is quite large, the labels, annotations, and symbols may become quite small and impossible to read. Stretching the plot window vertically may then provide a more readable figure (one should call the function again after adjusting the window size, so that the label/symbol sizes can be properly adjusted). Also, the \code{cex}, \code{cex.lab}, and \code{cex.axis} arguments are then useful to adjust the symbol and text sizes. If the outcome measure used for creating the plot is bounded (e.g., correlations are bounded between -1 and +1, proportions are bounded between 0 and 1), one can use the \code{olim} argument to enforce those limits (the observed outcomes and confidence intervals cannot exceed those bounds then). The \code{lty} argument can also be a vector of two elements, the first for specifying the line type of the individual CIs (\code{"solid"} by default), the second for the line type of the horizontal line that is automatically added to the plot (\code{"solid"} by default; set to \code{"blank"} to remove it). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Chalmers, T. C., & Lau, J. (1993). Meta-analytic stimulus for changes in clinical trials. \emph{Statistical Methods in Medical Research}, \bold{2}(2), 161--172. \verb{https://doi.org/10.1177/096228029300200204} Lau, J., Schmid, C. H., & Chalmers, T. C. (1995). Cumulative meta-analysis of clinical trials builds evidence for exemplary medical care. \emph{Journal of Clinical Epidemiology}, \bold{48}(1), 45--57. \verb{https://doi.org/10.1016/0895-4356(94)00106-z} Lewis, S., & Clarke, M. (2001). Forest plots: Trying to see the wood and the trees. \emph{British Medical Journal}, \bold{322}(7300), 1479--1480. \verb{https://doi.org/10.1136/bmj.322.7300.1479} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{forest}} for an overview of the various \code{forest} functions. \code{\link{cumul}} for the function to create \code{cumul.rma} objects. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, slab=paste(author, year, sep=", ")) ### fit random-effects model res <- rma(yi, vi, data=dat) ### draw cumulative forest plots x <- cumul(res, order=year) forest(x, cex=0.8, header=TRUE, top=2) forest(x, xlim=c(-4,2.5), alim=c(-2,1), cex=0.8, header=TRUE, top=2) ### meta-analysis of the (log) risk ratios using the Mantel-Haenszel method res <- rma.mh(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, slab=paste(author, year, sep=", ")) ### draw cumulative forest plot x <- cumul(res, order=year) forest(x, xlim=c(-4,2.5), alim=c(-2,1), cex=0.8, header=TRUE, top=2) } \keyword{hplot} metafor/man/baujat.Rd0000644000176200001440000001153414505063152014224 0ustar liggesusers\name{baujat} \alias{baujat} \alias{baujat.rma} \title{Baujat Plots for 'rma' Objects} \description{ Function to create Baujat plots for objects of class \code{"rma"}. \loadmathjax } \usage{ baujat(x, \dots) \method{baujat}{rma}(x, xlim, ylim, xlab, ylab, cex, symbol="ids", grid=TRUE, progbar=FALSE, \dots) } \arguments{ \item{x}{an object of class \code{"rma"}.} \item{xlim}{x-axis limits. If unspecified, the function sets the x-axis limits to some sensible values.} \item{ylim}{y-axis limits. If unspecified, the function sets the y-axis limits to some sensible values.} \item{xlab}{title for the x-axis. If unspecified, the function sets an appropriate axis title.} \item{ylab}{title for the y-axis. If unspecified, the function sets an appropriate axis title.} \item{cex}{symbol/character expansion factor.} \item{symbol}{either an integer to specify the \code{pch} value (i.e., plotting symbol), or \code{"slab"} to plot the study labels, or \code{"ids"} (the default) to plot the study id numbers.} \item{grid}{logical to specify whether a grid should be added to the plot. Can also be a color name.} \item{progbar}{logical to specify whether a progress bar should be shown (the default is \code{FALSE}).} \item{\dots}{other arguments.} } \details{ The model specified via \code{x} must be a model fitted with either the \code{\link{rma.uni}}, \code{\link{rma.mh}}, or \code{\link{rma.peto}} functions. Baujat et al. (2002) proposed a diagnostic plot to detect sources of heterogeneity in meta-analytic data. The plot shows the contribution of each study to the overall \mjseqn{Q}-test statistic for heterogeneity on the x-axis versus the influence of each study (defined as the standardized squared difference between the overall estimate based on an equal-effects model with and without the study included in the model fitting) on the y-axis. The same type of plot can be produced by first fitting an equal-effects model with either the \code{\link{rma.uni}} (using \code{method="EE"}), \code{\link{rma.mh}}, or \code{\link{rma.peto}} functions and then passing the fitted model object to the \code{baujat} function. For models fitted with the \code{\link{rma.uni}} function (which may be random-effects or mixed-effects meta-regressions models), the idea underlying this type of plot can be generalized as described by Viechtbauer (2021): The x-axis then corresponds to the squared Pearson residual of a study, while the y-axis corresponds to the standardized squared difference between the predicted/fitted value for the study with and without the study included in the model fitting. By default, the points plotted are the study id numbers, but one can also plot the study labels by setting \code{symbol="slab"} (if study labels are available within the model object) or one can specify a plotting symbol via the \code{symbol} argument that gets passed to \code{pch} (see \code{\link{points}} for possible options). } \value{ A data frame with components: \item{x}{the x-axis coordinates of the points that were plotted.} \item{y}{the y-axis coordinates of the points that were plotted.} \item{ids}{the study id numbers.} \item{slab}{the study labels.} Note that the data frame is returned invisibly. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Baujat, B., Mahe, C., Pignon, J.-P., & Hill, C. (2002). A graphical method for exploring heterogeneity in meta-analyses: Application to a meta-analysis of 65 trials. \emph{Statistics in Medicine}, \bold{21}(18), 2641--2652. \verb{https://doi.org/10.1002/sim.1221} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W. (2021). Model checking in meta-analysis. In C. H. Schmid, T. Stijnen, & I. R. White (Eds.), \emph{Handbook of meta-analysis} (pp. 219--254). Boca Raton, FL: CRC Press. \verb{https://doi.org/10.1201/9781315119403} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}} and \code{\link{rma.peto}} for functions to fit models for which Baujat plots can be created. \code{\link[=influence.rma.uni]{influence}} for other model diagnostics. } \examples{ ### copy data from Pignon et al. (2000) into 'dat' dat <- dat.pignon2000 ### calculate estimated log hazard ratios and sampling variances dat$yi <- with(dat, OmE/V) dat$vi <- with(dat, 1/V) ### meta-analysis based on all 65 trials res <- rma(yi, vi, data=dat, method="EE", slab=trial) ### create Baujat plot baujat(res) ### some variations of the plotting symbol baujat(res, symbol=19) baujat(res, symbol="slab") ### label only a selection of the more 'extreme' points sav <- baujat(res, symbol=19, xlim=c(0,20)) sav <- sav[sav$x >= 10 | sav$y >= 0.10,] text(sav$x, sav$y, sav$slab, pos=1, cex=0.8) } \keyword{hplot} metafor/man/vcalc.Rd0000644000176200001440000005204514505063152014050 0ustar liggesusers\name{vcalc} \alias{vcalc} \title{Construct or Approximate the Variance-Covariance Matrix of Dependent Effect Sizes or Outcomes} \description{ Function to construct or approximate the variance-covariance matrix of dependent effect sizes or outcomes, or more precisely, of their sampling errors (i.e., the \code{V} matrix in \code{\link{rma.mv}}). \loadmathjax } \usage{ vcalc(vi, cluster, subgroup, obs, type, time1, time2, grp1, grp2, w1, w2, data, rho, phi, rvars, checkpd=TRUE, nearpd=FALSE, sparse=FALSE, \dots) } \arguments{ \item{vi}{numeric vector to specify the sampling variances of the observed effect sizes or outcomes.} \item{cluster}{vector to specify the clustering variable (e.g., study).} \item{subgroup}{optional vector to specify different (independent) subgroups within clusters.} \item{obs}{optional vector to distinguish different observed effect sizes or outcomes corresponding to the same construct or response/dependent variable.} \item{type}{optional vector to distinguish different types of constructs or response/dependent variables underlying the observed effect sizes or outcomes.} \item{time1}{optional numeric vector to specify the time points when the observed effect sizes or outcomes were obtained (in the first condition if the observed effect sizes or outcomes represent contrasts between two conditions).} \item{time2}{optional numeric vector to specify the time points when the observed effect sizes or outcomes were obtained in the second condition (only relevant when the observed effect sizes or outcomes represent contrasts between two conditions).} \item{grp1}{optional vector to specify the group of the first condition when the observed effect sizes or outcomes represent contrasts between two conditions.} \item{grp2}{optional vector to specify the group of the second condition when the observed effect sizes or outcomes represent contrasts between two conditions.} \item{w1}{optional numeric vector to specify the size of the group (or more generally, the inverse-sampling variance weight) of the first condition when the observed effect sizes or outcomes represent contrasts between two conditions.} \item{w2}{optional numeric vector to specify the size of the group (or more generally, the inverse-sampling variance weight) of the second condition when the observed effect sizes or outcomes represent contrasts between two conditions.} \item{data}{optional data frame containing the variables given to the arguments above.} \item{rho}{argument to specify the correlation(s) of observed effect sizes or outcomes measured concurrently. See \sQuote{Details}.} \item{phi}{argument to specify the autocorrelation of observed effect sizes or outcomes measured at different time points. See \sQuote{Details}.} \item{rvars}{optional argument for specifying the variables that correspond to the correlation matrices of the studies (if this is specified, all arguments above except for \code{cluster} and \code{subgroup} are ignored). See \sQuote{Details}.} \item{checkpd}{logical to specify whether to check that the variance-covariance matrices within clusters are positive definite (the default is \code{TRUE}). See \sQuote{Note}.} \item{nearpd}{logical to specify whether the \code{\link[Matrix]{nearPD}} function from the \href{https://cran.r-project.org/package=Matrix}{Matrix} package should be used on variance-covariance matrices that are not positive definite. See \sQuote{Note}.} \item{sparse}{logical to specify whether the variance-covariance matrix should be returned as a sparse matrix (the default is \code{FALSE}).} \item{\dots}{other arguments.} } \details{ Standard meta-analytic models (such as those that can be fitted with the \code{\link{rma.uni}} function) assume that the observed effect sizes or outcomes (or more precisely, their sampling errors) are independent. This assumption is typically violated whenever multiple observed effect sizes or outcomes are computed based on the same sample of subjects (or whatever the study units are) or if there is at least partial overlap of subjects that contribute information to the computation of multiple effect sizes or outcomes. The present function can be used to construct or approximate the variance-covariance matrix of the sampling errors of dependent effect sizes or outcomes for a wide variety of circumstances (this variance-covariance matrix is the so-called \code{V} matrix that may be needed as input for multilevel/multivariate meta-analytic models as can be fitted with the \code{\link{rma.mv}} function; see also \link[=misc-recs]{here} for some recommendations on a general workflow for meta-analyses involving complex dependency structures). Argument \code{cluster} is used to specify the clustering variable. Rows with the same value of this variable are allowed to be dependent, while rows with different values are assumed to be independent. Typically, \code{cluster} will be a study identifier. Within the same cluster, there may be different subgroups with no overlap of subjects across subgroups. Argument \code{subgroup} can be used to distinguish such subgroups. Rows with the same value of this variable within a cluster are allowed to be dependent, while rows with different values are assumed to be independent even if they come from the same cluster. Therefore, from hereon, \sQuote{cluster} really refers to the combination of \code{cluster} and \code{subgroup}. Multiple effect sizes or outcomes belonging to the same cluster may be dependent due to a variety of reasons: \enumerate{ \item The same construct of interest (e.g., severity of depression) may have been measured using different scales or instruments within a study (e.g., using the Beck Depression Inventory (BDI) and the Hamilton Depression Rating Scale (HDRS)) based on which multiple effect sizes can be computed for the same group of subjects (e.g., contrasting a treatment versus a control group with respect to each scale). In this case, we have multiple effect sizes that are different \sQuote{observations} of the effect with respect to the same type of construct. Argument \code{obs} is then used to distinguish different effect sizes corresponding to the same construct. If \code{obs} is specified, then argument \code{rho} must also be specified to indicate the degree of correlation among the sampling errors of the different effect sizes. Since this correlation is typically not known, the correlation among the various scales (or a rough \sQuote{guestimate} thereof) can be used as a proxy (i.e., the (typical) correlation between BDI and HDRS measurements). One can also specify an entire correlation matrix via \code{rho} to indicate, for each possible pair of \code{obs} values, the corresponding correlation. The row/column names of the matrix must then correspond to the unique values of the \code{obs} variable. \item Multiple types of constructs (or more generally, types of response/dependent variables) may have been measured in the same group of subjects (e.g., severity of depression as measured with the Beck Depression Inventory (BDI) and severity of anxiety as measured with the State-Trait Anxiety Inventory (STAI)). If this is of interest for a meta-analysis, effect sizes can then be computed with respect to each \sQuote{type} of construct. Argument \code{type} is then used to distinguish effect sizes corresponding to these different types of constructs. If \code{type} is specified, then argument \code{rho} must also be specified to indicate the degree of correlation among the sampling errors of effect sizes belonging to these different types. As above, the correlation among the various scales is typically used here as a proxy (i.e., the (typical) correlation between BDI and STAI measurements). One can also specify an entire correlation matrix via \code{rho} to indicate, for each possible pair of \code{type} values, the corresponding correlation. The row/column names of the matrix must then correspond to the unique values of the \code{type} variable. \item If there are multiple types of constructs, multiple scales or instruments may also have been used (in at least some of the studies) to measure the same construct and hence there may again be multiple effect sizes that are \sQuote{observations} of the same type of construct. Arguments \code{type} and \code{obs} should then be used together to indicate the various construct types and observations thereof. In this case, argument \code{rho} must be a vector of two values, the first to specify the within-construct correlation and the second to specify the between-construct correlation. One can also specify a list with two elements for \code{rho}, the first element being either a scalar or an entire correlation matrix for the within-construct correlation(s) and the second element being a scalar or an entire correlation matrix for the between-construct correlation(s). As above, any matrices specified must have row/column names corresponding to the unique values of the \code{obs} and/or \code{type} variables. \item The same construct and scale may have been assessed/used multiple times, allowing the computation of multiple effect sizes for the same group of subjects at different time points (e.g., right after the end of a treatment, at a short-term follow-up, and at a long-term follow-up). Argument \code{time1} is then used to specify the time points when the observed effect sizes were obtained. Argument \code{phi} must then also be specified to indicate the autocorrelation among the sampling errors of two effect sizes that differ by one unit on the \code{time1} variable. As above, the autocorrelation of the measurements themselves can be used here as a proxy. If multiple constructs and/or multiple scales have also been assessed at the various time points, then arguments \code{type} and/or \code{obs} (together with argument \code{rho}) should be used as needed to differentiate effect sizes corresponding to the different constructs and/or scales. \item Many effect sizes or outcome measures (e.g., raw or standardized mean differences, log-transformed ratios of means, log risk/odds ratios and risk differences) reflect the difference between two conditions (i.e., a contrast). Within a study, there may be more than two conditions, allowing the computation of multiple such contrasts (e.g., treatment A versus a control condition and treatment B versus the same control condition) and hence corresponding effect sizes. The reuse of information from the \sQuote{shared} condition (in this example, the control condition) then induces correlation among the effect sizes. To account for this, arguments \code{grp1} and \code{grp2} should be specified to indicate (within each cluster) which two groups were compared in the computation of each effect size (e.g., in the example above, the coding could be \code{grp1=c(2,3)} and \code{grp2=c(1,1)}; whether numbers or strings are used as identifiers is irrelevant). The degree of correlation between two contrast-type effect sizes that is induced by the use of a shared condition is a function of the size of the groups involved in the computation of the two effect sizes (or, more generally, the inverse-sampling variance weights of the condition-specific outcomes). By default, the group sizes (weights) are assumed to be identical across conditions, which implies a correlation of 0.5. If the group sizes (weights) are known, they can be specified via arguments \code{w1} and \code{w2} (in which case this information is used by the function to calculate a more accurate estimate of the correlation induced by the shared condition). Moreover, a contrast-type effect size can be based on a between- or a within-subjects design. When at least one or more of the contrast-type effect sizes are based on a within-subjects design, then \code{time1} and \code{time2} should be used in combination with \code{grp1} and \code{grp2} to indicate for each effect size the group(s) and time point(s) involved. For example, \code{grp1=c(2,3)} and \code{grp2=c(1,1)} as above in combination with \code{time1=c(1,1)} and \code{time2=c(1,1)} would imply a between-subjects design involving three groups where two effect sizes were computed contrasting groups 2 and 3 versus group 1 at a single time point. On the other hand, \code{grp1=c(1,1)} and \code{grp2=c(1,1)} in combination with \code{time1=c(2,3)} and \code{time2=c(1,1)} would imply a within-subjects design where two effect sizes were computed contrasting time points 2 and 3 versus time point 1 in a single group. Argument \code{phi} is then used as above to indicate the autocorrelation of the measurements within groups (i.e., for the within-subjects design above, it would be the autocorrelation between time points 2 and 1 or equivalently, between time points 3 and 2). } All of the arguments above can be specified together to account for a fairly wide variety of dependency types. \subsection{Using the \code{rvars} Argument}{ The function also provides an alternative approach for constructing the variance-covariance matrix using the \code{rvars} argument. Here, one must specify the names of the variables in the dataset that correspond to the correlation matrices of the studies (the variables should be specified as a vector; e.g., \code{c(var1, var2, var3)}). In particular, let \mjseqn{k_i} denote the number of rows corresponding to the \mjeqn{i\textrm{th}}{ith} cluster. Then the values of the first \mjseqn{k_i} variables from \code{rvars} are used to construct the correlation matrix and, together with the sampling variances (specified via \code{vi}), the variance-covariance matrix. Say there are three studies, the first with two correlated estimates, the second with a single estimate, and the third with four correlated estimates. Then the data structure should look like this: \preformatted{study yi vi r1 r2 r3 r4 ============================= 1 . . 1 NA NA NA 1 . . .6 1 NA NA ----------------------------- 2 . . 1 NA NA NA ----------------------------- 3 . . 1 NA NA NA 3 . . .8 1 NA NA 3 . . .5 .5 1 NA 3 . . .5 .5 .8 1 =============================} with \code{rvars = c(r1, r2, r3, r4)}. If the \code{rvars} variables are a consecutive set in the data frame (as above), then one can use the shorthand notation \code{rvars = c(r1:r4)}, so \code{r1} denotes the first and \code{r4} the last variable in the set. Note that only the lower triangular part of the submatrices defined by the \code{rvars} variables is used. There must be as many variables specified via \code{rvars} as the number of rows in the \emph{largest} cluster (in smaller clusters, the non-relevant variables can just be set to \code{NA}; see above). } } \value{ A \mjseqn{k \times k} variance-covariance matrix (given as a sparse matrix when \code{sparse=TRUE}), where \mjseqn{k} denotes the length of the \code{vi} variable (i.e., the number of rows in the dataset). } \note{ Depending on the data structure, the specified variables, and the specified values for \code{rho} and/or \code{phi}, it is possible that the constructed variance-covariance matrix is not positive definite within one or more clusters (this is checked when \code{checkpd=TRUE}, which is the default). If such non-positive definite submatrices are found, the reasons for this should be carefully checked since this might indicate misapplication of the function and/or the specification of implausible values for \code{rho} and/or \code{phi}. When setting \code{nearpd=TRUE}, the \code{\link[Matrix]{nearPD}} function from the \href{https://cran.r-project.org/package=Matrix}{Matrix} package is used on variance-covariance submatrices that are not positive definite. This should only be used cautiously and after understanding why these matrices are not positive definite. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{escalc}} for a function to compute the observed effect sizes or outcomes (and corresponding sampling variances) for which a variance-covariance matrix could be constructed. \code{\link{rcalc}} for a function to construct the variance-covariance matrix of dependent correlation coefficients. \code{\link{rma.mv}} for a model fitting function that can be used to meta-analyze dependent effect sizes or outcomes. } \examples{ ############################################################################ ### see help(dat.assink2016) for further details on this dataset dat <- dat.assink2016 head(dat, 9) ### assume that the effect sizes within studies are correlated with rho=0.6 V <- vcalc(vi, cluster=study, obs=esid, data=dat, rho=0.6) ### show part of V matrix for studies 1 and 2 round(V[dat$study \%in\% c(1,2), dat$study \%in\% c(1,2)], 4) ### or show as list of matrices blsplit(V, dat$study, round, 4)[1:2] ### use a correlation of 0.7 for effect sizes corresponding to the same type of ### delinquent behavior and a correlation of 0.5 for effect sizes corresponding ### to different types of delinquent behavior V <- vcalc(vi, cluster=study, type=deltype, obs=esid, data=dat, rho=c(0.7, 0.5)) blsplit(V, dat$study, round, 3)[16] ### examine the correlation matrix for study 16 blsplit(V, dat$study, cov2cor)[16] ############################################################################ ### see help(dat.ishak2007) for further details on this dataset dat <- dat.ishak2007 head(dat, 5) ### create long format dataset dat <- reshape(dat, direction="long", idvar="study", v.names=c("yi","vi"), varying=list(c(2,4,6,8), c(3,5,7,9))) dat <- dat[order(study, time),] ### remove missing measurement occasions from dat dat <- dat[!is.na(yi),] rownames(dat) <- NULL ### show the data for the first 5 studies head(dat, 8) ### construct the full (block diagonal) V matrix with an AR(1) structure ### assuming an autocorrelation of 0.97 as estimated by Ishak et al. (2007) V <- vcalc(vi, cluster=study, time1=time, phi=0.97, data=dat) V[1:8, 1:8] cov2cor(V[1:8, 1:8]) ### or show as a list of matrices blsplit(V, dat$study)[1:5] blsplit(V, dat$study, cov2cor)[1:5] ############################################################################ ### see help(dat.kalaian1996) for further details on this dataset dat <- dat.kalaian1996 head(dat, 12) ### construct the variance-covariance matrix assuming rho = 0.66 for effect sizes ### corresponding to the 'verbal' and 'math' outcome types V <- vcalc(vi, cluster=study, type=outcome, data=dat, rho=0.66) round(V[1:12,1:12], 4) ############################################################################ ### see help(dat.berkey1998) for further details on this dataset dat <- dat.berkey1998 ### variables v1i and v2i correspond to the 2x2 var-cov matrices of the studies; ### so use these variables to construct the V matrix (note: since v1i and v2i are ### var-cov matrices and not correlation matrices, set vi=1 for all rows) V <- vcalc(vi=1, cluster=author, rvars=c(v1i, v2i), data=dat) V round(cov2cor(V), 2) ### or show as a list of matrices blsplit(V, dat$author, function(x) round(cov2cor(x), 2)) ### construct the variance-covariance matrix assuming rho = 0.4 for effect sizes ### corresponding to the 'PD' and 'AL' outcome types V <- vcalc(vi=vi, cluster=trial, type=outcome, data=dat, rho=0.4) round(V,4) cov2cor(V) ############################################################################ ### see help(dat.knapp2017) for further details on this dataset dat <- dat.knapp2017 dat[-c(1:2)] ### create variable that indicates the task and difficulty combination as increasing integers dat$task.diff <- unlist(lapply(split(dat, dat$study), function(x) { task.int <- as.integer(factor(x$task)) diff.int <- as.integer(factor(x$difficulty)) diff.int[is.na(diff.int)] <- 1 paste0(task.int, ".", diff.int)})) ### construct correlation matrix for two tasks with four different difficulties where the ### correlation is 0.4 for different difficulties of the same task, 0.7 for the same ### difficulty of different tasks, and 0.28 for different difficulties of different tasks R <- matrix(0.4, nrow=8, ncol=8) R[5:8,1:4] <- R[1:4,5:8] <- 0.28 diag(R[1:4,5:8]) <- 0.7 diag(R[5:8,1:4]) <- 0.7 diag(R) <- 1 rownames(R) <- colnames(R) <- paste0(rep(1:2, each=4), ".", 1:4) R ### construct an approximate V matrix accounting for the use of shared groups and ### for correlations among tasks/difficulties as specified in the R matrix above V <- vcalc(vi, cluster=study, grp1=group1, grp2=group2, w1=n_sz, w2=n_hc, obs=task.diff, rho=R, data=dat) Vs <- blsplit(V, dat$study) cov2cor(Vs[[3]]) # study with multiple SZ groups and a single HC group cov2cor(Vs[[6]]) # study with two task types and multiple difficulties cov2cor(Vs[[12]]) # study with multiple difficulties for the same task cov2cor(Vs[[24]]) # study with separate rows for males and females cov2cor(Vs[[29]]) # study with separate rows for three genotypes ############################################################################ } \keyword{datagen} metafor/man/fitted.rma.Rd0000644000176200001440000000337114505063152015013 0ustar liggesusers\name{fitted.rma} \alias{fitted} \alias{fitted.rma} \title{Fitted Values for 'rma' Objects} \description{ Function to compute the fitted values for objects of class \code{"rma"}. } \usage{ \method{fitted}{rma}(object, \dots) } \arguments{ \item{object}{an object of class \code{"rma"}.} \item{\dots}{other arguments.} } \value{ A vector with the fitted values. } \note{ The \code{\link[=predict.rma]{predict}} function also provides standard errors and confidence intervals for the fitted values. Best linear unbiased predictions (BLUPs) that combine the fitted values based on the fixed effects and the estimated contributions of the random effects can be obtained with \code{\link[=blup.rma.uni]{blup}} (only for objects of class \code{"rma.uni"}). For objects not involving moderators, the fitted values are all identical to the estimated value of the model intercept. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link[=predict.rma]{predict}} for a function to computed predicted values and \code{\link[=blup.rma.uni]{blup}} for a function to compute BLUPs that combine the fitted values and predicted random effects. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit mixed-effects model with absolute latitude and publication year as moderators res <- rma(yi, vi, mods = ~ ablat + year, data=dat) ### compute the fitted values fitted(res) } \keyword{models} metafor/man/print.list.rma.Rd0000644000176200001440000000215614505063152015642 0ustar liggesusers\name{print.list.rma} \alias{print.list.rma} \title{Print Method for 'list.rma' Objects} \description{ Function to print objects of class \code{"list.rma"}. } \usage{ \method{print}{list.rma}(x, digits=x$digits, \dots) } \arguments{ \item{x}{an object of class \code{"list.rma"}.} \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} \item{\dots}{other arguments.} } \value{ See the documentation of the function that creates the \code{"list.rma"} object for details on what is printed. Regardless of what is printed, a data frame with the results is also returned invisibly. See \code{\link{methods.list.rma}} for some additional method functions for \code{"list.rma"} objects. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \keyword{print} metafor/man/addpoly.rma.Rd0000644000176200001440000001300414505063152015162 0ustar liggesusers\name{addpoly.rma} \alias{addpoly.rma} \title{Add Polygons to Forest Plots (Method for 'rma' Objects)} \description{ Function to add a polygon to a forest plot showing the summary estimate with corresponding confidence interval based on an object of class \code{"rma"}. } \usage{ \method{addpoly}{rma}(x, row=-2, level=x$level, annotate, addpred=FALSE, digits, width, mlab, transf, atransf, targs, efac, col, border, lty, fonts, cex, \dots) } \arguments{ \item{x}{an object of class \code{"rma"}.} \item{row}{numeric value to specify the row (or more generally, the horizontal position) for plotting the polygon (the default is \code{-2}).} \item{level}{numeric value between 0 and 100 to specify the confidence interval level (see \link[=misc-options]{here} for details). The default is to take the value from the object.} \item{annotate}{optional logical to specify whether annotations for the summary estimate should be added to the plot.} \item{addpred}{logical to specify whether the bounds of the prediction interval should be added to the plot (the default is \code{FALSE}).} \item{digits}{optional integer to specify the number of decimal places to which the annotations should be rounded.} \item{width}{optional integer to manually adjust the width of the columns for the annotations.} \item{mlab}{optional character string giving a label for the summary estimate polygon. If unspecified, the function sets a default label.} \item{transf}{optional argument to specify a function to transform the summary estimate and confidence interval bound (e.g., \code{transf=exp}; see also \link{transf}).} \item{atransf}{optional argument to specify a function to transform the annotations (e.g., \code{atransf=exp}; see also \link{transf}).} \item{targs}{optional arguments needed by the function specified via \code{transf} or \code{atransf}.} \item{efac}{optional vertical expansion factor for the polygon.} \item{col}{optional character string to specify the color of the polygon.} \item{border}{optional character string to specify the border color of the polygon.} \item{lty}{optional character string to specify the line type for the prediction interval.} \item{fonts}{optional character string to specify the font for the label and annotations.} \item{cex}{optional symbol expansion factor.} \item{\dots}{other arguments.} } \details{ The function can be used to add a four-sided polygon, sometimes called a summary \sQuote{diamond}, to an existing forest plot created with the \code{\link{forest}} function. The polygon shows the summary estimate (with its confidence interval bounds) based on an equal- or a random-effects model. Using this function, summary estimates based on different types of models can be shown in the same plot. Also, summary estimates based on a subgrouping of the studies can be added to the plot this way. See \sQuote{Examples}. If unspecified, arguments \code{annotate}, \code{digits}, \code{width}, \code{transf}, \code{atransf}, \code{targs}, \code{efac} (only if the forest plot was created with \code{\link{forest.rma}}), \code{fonts}, \code{cex}, \code{annosym}, and \code{textpos} are automatically set equal to the same values that were used when creating the forest plot. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{forest}} for functions to draw forest plots to which polygons can be added. } \examples{ ### meta-analysis of the log risk ratios using the Mantel-Haenszel method res <- rma.mh(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, slab=paste(author, year, sep=", ")) ### forest plot of the observed risk ratios with summary estimate forest(res, atransf=exp, xlim=c(-8,6), ylim=c(-2.5,15), header=TRUE, top=2) ### meta-analysis of the log risk ratios using a random-effects model res <- rma(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### add summary estimate from the random-effects model to the forest plot addpoly(res) ### forest plot with subgrouping of studies and summaries per subgroup res <- rma(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, slab=paste(author, year, sep=", ")) tmp <- forest(res, xlim=c(-16, 4.6), at=log(c(0.05, 0.25, 1, 4)), atransf=exp, ilab=cbind(tpos, tneg, cpos, cneg), ilab.xpos=c(-9.5,-8,-6,-4.5), cex=0.75, ylim=c(-1, 27), order=alloc, rows=c(3:4,9:15,20:23), mlab="RE Model for All Studies", header="Author(s) and Year") op <- par(cex=0.75, font=2) text(c(-9.5,-8,-6,-4.5), tmp$ylim[2]-1, c("TB+", "TB-", "TB+", "TB-")) text(c(-8.75,-5.25), tmp$ylim[2], c("Vaccinated", "Control")) par(font=4) text(-16, c(24,16,5), c("Systematic Allocation", "Random Allocation", "Alternate Allocation"), pos=4) par(op) res <- rma(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, subset=(alloc=="systematic")) addpoly(res, row=18.5, mlab="RE Model for Subgroup") res <- rma(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, subset=(alloc=="random")) addpoly(res, row=7.5, mlab="RE Model for Subgroup") res <- rma(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, subset=(alloc=="alternate")) addpoly(res, row=1.5, mlab="RE Model for Subgroup") } \keyword{aplot} metafor/man/cumul.Rd0000644000176200001440000001345614505063152014110 0ustar liggesusers\name{cumul} \alias{cumul} \alias{cumul.rma.uni} \alias{cumul.rma.mh} \alias{cumul.rma.peto} \title{Cumulative Meta-Analysis for 'rma' Objects} \description{ Function to carry out a \sQuote{cumulative meta-analysis}, by repeatedly fitting the specified model adding one study at a time. \loadmathjax } \usage{ cumul(x, \dots) \method{cumul}{rma.uni}(x, order, digits, transf, targs, progbar=FALSE, \dots) \method{cumul}{rma.mh}(x, order, digits, transf, targs, progbar=FALSE, \dots) \method{cumul}{rma.peto}(x, order, digits, transf, targs, progbar=FALSE, \dots) } \arguments{ \item{x}{an object of class \code{"rma.uni"}, \code{"rma.mh"}, or \code{"rma.peto"}.} \item{order}{optional argument to specify a variable based on which the studies will be ordered for the cumulative meta-analysis.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} \item{transf}{optional argument to specify a function to transform the model coefficients and interval bounds (e.g., \code{transf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{targs}{optional arguments needed by the function specified under \code{transf}.} \item{progbar}{logical to specify whether a progress bar should be shown (the default is \code{FALSE}).} \item{\dots}{other arguments.} } \details{ For \code{"rma.uni"} objects, the model specified via \code{x} must be a model without moderators (i.e., either an equal- or a random-effects model). If argument \code{order} is not specified, the studies are added according to their order in the original dataset. When a variable is specified for \code{order}, the variable is assumed to be of the same length as the original dataset that was used in the model fitting (and if the \code{data} argument was used in the original model fit, then the variable will be searched for within this data frame first). Any subsetting and removal of studies with missing values that was applied during the model fitting is also automatically applied to the variable specified via the \code{order} argument. See \sQuote{Examples}. } \value{ An object of class \code{c("list.rma","cumul.rma")}. The object is a list containing the following components: \item{estimate}{estimated (average) outcomes.} \item{se}{corresponding standard errors.} \item{zval}{corresponding test statistics.} \item{pval}{corresponding p-values.} \item{ci.lb}{lower bounds of the confidence intervals.} \item{ci.ub}{upper bounds of the confidence intervals.} \item{Q}{test statistics for the test of heterogeneity.} \item{Qp}{corresponding p-values.} \item{tau2}{estimated amount of heterogeneity (only for random-effects models).} \item{I2}{values of \mjseqn{I^2}.} \item{H2}{values of \mjseqn{H^2}.} \item{\dots}{other arguments.} When the model was fitted with \code{test="t"} or \code{test="knha"}, then \code{zval} is called \code{tval} in the object that is returned by the function. The object is formatted and printed with the \code{\link[=print.list.rma]{print}} function. To format the results as a data frame, one can use the \code{\link[=as.data.frame.list.rma]{as.data.frame}} function. A forest plot showing the results from the cumulative meta-analysis can be obtained with \code{\link[=forest.cumul.rma]{forest}}. Alternatively, \code{\link[=plot.cumul.rma]{plot}} can also be used to visualize the results. } \note{ When using the \code{transf} option, the transformation is applied to the estimated coefficients and the corresponding interval bounds. The standard errors are then set equal to \code{NA} and are omitted from the printed output. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Chalmers, T. C., & Lau, J. (1993). Meta-analytic stimulus for changes in clinical trials. \emph{Statistical Methods in Medical Research}, \bold{2}(2), 161--172. \verb{https://doi.org/10.1177/096228029300200204} Lau, J., Schmid, C. H., & Chalmers, T. C. (1995). Cumulative meta-analysis of clinical trials builds evidence for exemplary medical care. \emph{Journal of Clinical Epidemiology}, \bold{48}(1), 45--57. \verb{https://doi.org/10.1016/0895-4356(94)00106-z} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link[=forest.cumul.rma]{forest}} for a function to draw cumulative forest plots and \code{\link[=plot.cumul.rma]{plot}} for a different visualization of the cumulative results. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit random-effects model res <- rma(yi, vi, data=dat) ### cumulative meta-analysis (in the order of publication year) cumul(res, transf=exp, order=year) ### meta-analysis of the (log) risk ratios using the Mantel-Haenszel method res <- rma.mh(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### cumulative meta-analysis cumul(res, order=year) cumul(res, order=year, transf=TRUE) ### meta-analysis of the (log) odds ratios using Peto's method res <- rma.peto(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### cumulative meta-analysis cumul(res, order=year) cumul(res, order=year, transf=TRUE) ### make first log risk ratio missing and fit model without study 2; then the ### variable specified via 'order' should still be of the same length as the ### original dataset; subsetting and removal of studies with missing values is ### automatically done by the cumul() function dat$yi[1] <- NA res <- rma(yi, vi, data=dat, subset=-2) cumul(res, transf=exp, order=year) } \keyword{methods} metafor/man/figures/0000755000176200001440000000000014465440735014142 5ustar liggesusersmetafor/man/figures/selmodel-beta.pdf0000644000176200001440000006441314465413172017355 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20230811130738) /ModDate (D:20230811130738) /Title (R Graphics Output) /Producer (R 4.3.1) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 22841 /Filter /FlateDecode >> stream xK|u9@~?=aHEm_Z%R57XN܏+?~>1,HU+}O~Sz~?*(7Wl49~ozl\oQn9rVռmnu[_%onZzeUnr[۪VjUmo~[jV㶚ռmnm///o/G^V*UmUov[۪Vոm5ny[jVz~9={-u|ٙJ+jkzoFoV{)Gt {W_ ~%W_ ~-׃_~#7 ~3ෂS۾.=޺<}|=+jZFoV[xAO=nA_~5~J+jkzoFoV{1GS[З_˷ߣoJ+Zkzofoz~x#ۯJZkFof[oz=z<}|=+jZFoV[ob޿AϷ97ۯJZkFof[oz=P{З3ŮA~%W_ ~5ׂ_ ~=7~#7 ~+=(o#L;݃w +jZFoV[{~k3Ag+jZFoV[G{AϷ~9kз_ ~%W_ ~-ׂ_~=7~3ෂ ~O=[?z3A/g>^J+jkzoFoV{1Gw}=W_ ~%W_ ~-׃_~#7 ~3ෂSO=o̿s=נoJ+Zkzofoz~|gA_~|}W_ ~5ׂ_ ~-׃~#7 ~+cS[?t{5ۯJZkFof[o}̚nAy3.AK-ۯjZFof[o];[̿KЗ3NAoJZkzofoumgnA73.A_~;݂J+jkzofoֵ[w =./?-ۯjZFof[o][̿KЗ3NAoJZkzofougnA3.A_~;݂J+jkzofoֵ[w }=t +jzFoV[~n}){>̿S-ۯjZFof[o][̿KЗ3NAoJZkzofougnA3.A_~;݂J+jkzofoֵ[w|}=t+jzFoV[~n}9{>̿s=ۯjZFof[o]{kЗ3AoJZkzofougA3AKt+jzFoV[~n{9{=̿s=ۯjZFof[o]{kЗ3AoJZkzofougA3A_~;݃J+jkzofoֵ۞wn|}=t+jzFoV[~n{9{=̿s=ۯjZFof[o]{kЗ3AoJZkzofoug]~a-oJ+zC_-?__ ?Ρ@9E _=/Pa߿/^{w/We7I0ן=1&'dĘ`sbL熜'dx‰1pbLS'd8{bL3'd8"wbL['d8@tbL1e((cLFBAc^c2 QPƘto:1&}1 eI_((cLIvbLDAc' +'Ƥ1&1eI((cL081&1 eI((cLzEAc=Ę2Ƥ1&OI((cLzBAc ͉1ieI((cLBAc*PRŘ*ƤMU1&m1ieU v?'ƤuV1&1iUIkbLZCqc*1cՁω1iVI+bLZAc2jQdŘ*+Ƥ%Y1&?'Ƥ:91&uҊ1 VI]bLBcR'cR[sbL`cR݄cR;YoƘz3Ƥ6֛1&ތ1fIݱω1fI-7cLjfcռω1fIM7cL>'Ƥ&֛1&eތ1)^ω1)fIY7cLbcR&2YoƘz3Ƥ891&eތ191&ތ1)fIi7cLJccR*RYoƘz3ƤxĘz3Ƥd֛1&%ތ1)fII7cLJbcω1ɛfIެ7cLbcXoƘz3Ęz3$֛1&٧Bc;YoƘz3$7֛1&?'$stĘz3$sȥ1bLrfc3abLrbcđbLwC|NIڬ7cLbc8RI7cLdc8SIդω1IfIL1&0Řz3$5֛1&0Řz3$U֛1&C1Ř$?'Ęz3$q8YoƘz3$qDG1&z#ƤncbvQoĘFcbϨ7bL|w_/bL|:Sf1F~F;8>c51&QoĘ^_ecb3V1&> Fuވ11z#Ƥ(4Ii1& 1cbFuWވ11z#Ƥ(ĺ5PoĘFcb:Euވ11z#Ėïވ1a7G1&ޭR4vOi]+7bLLވ1K5ĘXwӨ7bLF674BcRQu#ވ11z#4nBcbyifRcLLވ1+1&QoĘFcb]7bLLވ101&(Ļ2y7G1&ޝowu z#Ļu7XoĘԩbLLBm~cވ11z#ĺPoĘFcbFI!4.DcbFܩݯވ11z#ĺQoĘx7$^_ccݔx?'>1nNޭtfcbFi76&EcbFuވ11'uFcRQi1&QoĘX,Ө7bLwEi1&kEcbFu ވ11z#4>FcbFu3o<ǘxws^oƘxwt^oƘxwuwcL؝Qwoofz3t7qbLLg<k11|~fuÏJ ¯ތ1}cb:-jG1&+cL cb ތ15Ƙf 1q!S_5bL{*k1qbQdcbF\oވ11z#ƤӨ7bLLވ11Fi1&QoĘ݂z#ttacbFi1&Fߠވ11z#h1&QoĘFcR k11]z#DݡQoĘ81&N75 z#IݡQoĘ8]x1&QoĘz#4PoĘFFFcbtJFi1&Fވ1XF(71&QoĘNzcb}7bLLވ11:FIeQi1&Fވ11z#A1&N& ]|~F iŏbLfXoĘ8 ӒzBw11z#hL1&5s9QoĘFcbFѢ7bLLވ11z#ƤbӨ7bLfEcbFi1&FǢވ11z#ƤkӨ7bLLވ1u1&QoĘ z#`<.tecqiP_actv?cbFi1&5qӵS?~Fgވ11z#tbcbFI1hr1&QoĘz#t[F7bLLވ11zFi1&QoĘ?'uFcbt?3FciCވ114I=QoĘXNFImQ%ވ11z#PoĘFcbF9ވ1)K5ĘN:Ө7bL,mFi1&QoĘXzӵP_acbfi1&z#4K@cbL<ݣPx 1&ҩ4OƋ,j7bL_7bL_7bLawoވ1EcbFi1&ŘFFFcboӨ7bLm_|11z#425^Ci1&vYވ11z#t׋PoĘFcb-Ө7bLLވ1Ө7bLLXZވ11z#4أވ11z#n#7bLLEQoܸ춄z#4Ө7bL춇z#4mވ11z#Ƥ cLQoĘmRh1&0oވ1G1&S~5z#4ꍅrZ[zA{cbz3Ĵכ1&fi7cLL{wcLkӵSkhtocb:ojx1&1&S6cLLAm~mތ11uN&| u2QoƘ0qQh7cLlXfi7cLlfi1&QoĘذw,z#ĆѨ7bLLވ11z#Ć7&QoĘŘFcbFMPoĘFcbFMKPoĘl+~cb1&QoĘȟ1&>mFO*uFciG1&>7cbFMQoĘFcbN1&QoĘcLlz#4ވ11|>7z#Ħ٨7bLJx1&6mGcbFi1& 2FcbF-3xlM(Ė)PoĘFc*_&)Wп.|c08^c/lz#Ė}PoĘ.fcR2k11z#ĖPoĘFcb\7bLLވ11z#Ƥdcb7cbp7bLLވ11z#ĖPoĘFcbF-zcLLވ1eG1&ۦШ7bL|Y3S7h1&\(ėM;FcˮAވ11z#ĖqQoĘ||cb¨7bLLވ11:\(ef1&QoĘزo04[GcbF-ވ11z#Ĵo0ĖQoĘFcRk1m1&QoĘ6Ө7bL|"Q?~MtDƷ9خQoĘ6ɠn}ЋzAވ11z#$cQi1&̓zcc4Ө7bLlFi1& z#$#-Ө7bLl[k: &Ccb4vCck11z#4DmFo+&mZ5Ędvz#ķ5;u Ƙ^Ę馞Ш7bLlFi1&mz ƘFcb7bLLވ1H(4Ө7bLlFiyFcbo5z#$eӨ7bLLވ1mz1&QoĘ6046bL SOh1&ކШ;4oc׋osXF锩ݯވ11z#0PoĘFcbFuވ1ɸ?161&Qo,΍ٜz#4kcAcA3~cm/4^CE4j7bLx 7&oYFi1&:11z#ڊPoĘxzږPoĘbLLވ16(1&QoĘX[i1&QoĘXכ1&ތ1/7cLL{cbk#z3Ĵכ1&G1&ތ16D~1*Nx?cmv o:'2ӵRkl431ȍ5ƘnzC{cbm^oƘz3$ތ11fIn1.1&QoĘX'Ө7bLLވ1P1&QoĘX)Ө7bL-?Wпok+7bL-Soh1&V?ncb:glm7Mވ1_1&ێŘFcbmŨ7bLLވ11z#ڔQoĘ.:iG1&QoĘX5Ө7bL-F;WYoĘX7\9^cވ11zcmz/oCoSF ?16Im~eވ16MݡQoĘX>bFIFG1&QoĘFcbӨ7bLLވ11Fi#0ŘFcb:& Ө7bL @cbFi1&puR?_܆ވ11z#ı>Ę8VR;4b)Ř82'4 PɱEݡ1&QoĘVz#4rPoĘFcbFa?sSOh1&Qo4zF4*FcbXӨ7bLLވ11 Fi1&MycLLވ1ɉ5Ƙz#4úPoĘFcXvz#ƄG1&uj7bLScLLވ11z#091&kvz#4Ө7/ CcbFi1&ŘFc9\c|YldZ#dk ? 0ٓF~8 %{m%{/!dkYb$(dkܒX_Ėb5:Ch.h`f.-"KvaiX52C`,,Jvb]5,CZNaX,*Jd@ŗdH*YEPZ,(rJc!ϔV'HŁ7މ ["?Bbn q\PfAB㝝s;BL5Nlxc3qmoo$ 7v<oo"4^7 WFl!4^;׆B㵠xh 4^DƋ y@] ՄKÞ5–3B6q~_htrwh~  ,AGox oS4n5❮-(B㶖8_=иC o4^A@g_D?'x[P Pq !ޡq[hи%(<5jn͛6&и,jkܔ"4n{77?Mƽ)~Q4'A M(WmJ!HPN^&qiT 6_иR674{x?[~.H'K}vz 9/snRc!4nM&Hڡqk"Ҷ; hA(T@ԇP@{ƽWдˁ[S :@ބ7ݯ7$~{/02?߀ƽ)N?7}hܚ;4^hMhܛ&!Gޤ1{?ˁ{xn{/: ?.:&1hoJ[ߐxN/hܚ~&~; 4!?nZ/e/и5Qи5I и5EhtDn~U!ƭ %@ԴDhܛ:qыx9'Ƌ ;ͯ(иi\?ƽH6&E~ !4^Ba[/@1>4M@ @q=>;݆Ө/и5h!4M9n0^4^Fh!4M64n_৐!@4#HB#dи54~b[LO qoz&1;;4!;qkRи7޿?AƝ]ֲ|^{ fݰ|K'4OHqgݏF[7@&iwyPoh^@Gи5yhܛ>R qg+и|>MA)EhBmKߏ1|#m"Dw ӔAh&|C4ne h/De4w贩o./i 4n5M'AǦ Bh4! и& 4 ۄ>Pm*ti 4-AдC!HWO ~"U6e ?@6 h4-?M OqoZ$~\$g7snSPz$h܆^{ ?"E  Oh|Ή?ޏ N/hܦQCPxhܦe[mʶ Wh@597 uUX7'qu;CEs4M zqojqF~oȿï  Wh@aMz4HhQBи7&ABޔRtt7ӄ'иm[4nzJ/h|7]4*}h^Є,(Oq@7qI Om4H7MiӸJݲ7`|hܛl9;4nz"и~>804M9x| hܛt|~lB$4m7& mL%AOu?~?"4nq4n qg7g@Tԩ4/@㦋 rahܶY 1x~84MJ~oh46Gи!|A "4O qo|x>!+ƽIjP?7FncxxVh+7|1Ι8!4胺AS<|-, X&m}=Nl1`Ʒ< $ʗ%/A':pY1딬>h"a #';&T{+✚b9Ŏ/bڋ>@ڋ{dսLD{mՕV8^l= 48hF+\ހϒ ֦Vvًfɀe/L^E`g[DHd/Z^Ad]{6oFc/f^'|{qM a+Z>(@kux1>D:tZgDOZV`^K("}@z1ܵ]/NV(?D2K@I\% |r=\i"{Dz1Z5p19ŘgbKgP`?S=i ~m ֋s WxN7 ]vՋm]di/ՋAGÃEXIAUbr8"k Dz)o <\8Z={McS/dAͽIɎ$ R) k2v bC)u iY\!C)MzMșVkR,Z/|%H O/f푝D&[vY%JX j-a57OZ-2)+%+,\~Y(7䋕~KZ,β9LE T<('BoIA߲H.FoI+CVy)4z$緜oe%I-$[VYI[J|s|.+~jVVM`se~E#;շ/ -i7JreeUoz[۪VUm5d%y唕d~u[[:%1 [[^V*UmUov[۪Vոm5oy[jV-}% [[^V*UmUov[۪Vոm5oy[jV>\/.[[H+eUnr[۪VV̶Q˗l?L+: D+ -SV.Z\ץA+\a'he_z<65޿D+Nl>K1gqdV%Z$[Diev+o 8%Z4$A+{{?iҘ Zٚ{ db?hek551ʞk ~=YUZڮ| ZٺlM`8i{*c|&؛;D+R^) SY lIՅyE瞀VR0l}8=4V.jlR[/ʞڿD+[C\V~FV"V%Z$`ozmlV:u7km݊,7?9_"SA$iekjF5hek&M뫿DtʦI6}o:҂5}/|Ag<gH+;=RMo'rz?ie|s޴/yAmoBm~KGV6nyFp/t$lNFN /Z9die:^G0#vDz@W79&uiebVnN=AwV:RiO4h|XD[CB/Zٻ7uZPGGvgngV6Mo'␴r9"wZٻ;u~fuie ~@+;/h>O*1q{vHNr?he/AZ١Im~}]GV]=heV|yMN#h ?&3MOh/xޭ¯ Z4n Zٻve=__}=YGVvR_[GZ'~b9t[n|Hm tq_woj Z4.ShܸAOZ#+7NZٻu ~A+|gЃw'E'_%MAZ9zw'jl!u$ie/V|i}GVI~J엕}hd߁VJϑw㑓;S/H+{w>?}V|?M~xʦ}Z4A+meJ[t=tʧ;'췱BݠAcV|з~#EM~ZnzʦˋVa׋V}9l^ФmA+M/m.Z9o:}ʇF'9_uD;iY+iyVքPrf$hDVM~NZ93Lq&ZYGVVV7ḧ}ʇ'*Z93LrmMZ9_H+#A+,rf$h$i}KZ9+EVIG@VΌ#Z9zIcISIʉ*L'A+'VVhʉmD+'w$$(Z9qBr:/^_olʧr-H+!rbĴhs(iʩjʉNIG’VN]7zrꢱA++RTrbhuFIG0VNsH+#HVNE+:rA+'щHE+'MZ9aTI6ie"Z*Z9'DVN_VN:brFZ9q}FrDZ9eڠ=@Z9n&x#Z9xʉ)DϑVN:⒴rIZ96"&,:~E+o.>VޛX*oImvT[\UU\ʒFy/Un"ր^|P1O޼OޢA'oNKPZIX.0yOq%oa9ک=uRC[ +s߁$D N y3<|'#+4>'`;U]"okA" {Nya¾μRC y+>2"ț$NuH*݅L|3Ǜd-Lx8O[vǻwuv,m:{ъl{W|ix D"mGx%kx1bp%rƻ ӭx+> 3Z4'b,䁄:UצwաNʋxzVoxxTzѪ$Uh=(]uw8 U9#TŰ)RXCG'ExoQ*5~ZJ&$K,\(VRHbmM$V59]#L$E԰x=i&S +I` Â)Ho@xx71vCÛ [ApXlͅOb;/hX725&1`G>gXwZ-`A+' +jf4I 'y1Ec}s22o I@kWwN[hEz +\i+H`Xm/.xk`,x+5 Tf#`Adq މ5ZV~'p@[7hp<'Q`!$$FXɑB VBkfgϹ@F} BWߥ!"6R ؝VS/Z:zҊ?OZ6/Pki'# #6@~-wQGx(ҁ`}f+>Pߵutz- D8ߥzp-t.8_4j!Mb9p1r<绖Pip| *PbO9ŌcrK1pK]"绖Ψn w`pZ{pZt:-8ߵH?= 8ð] "绘@ -|w1| .|.XG>P]px绖Ngj/W |wq^F/|υ!{ppGuʟ5 |=+0|O;8_lO_|ɟש&q Ϝi:Ǧ1{ZZG/q.@ ܿ9_w5ÊI|^ z ,_|ĹVlB;`7:Idb 8_'yg̣!$mp>ztU VդTClz1iq p :drI7Tb. H/$y9ߴ71MoZ7相!7Mq|N1#相 $7!xv8_AMC2MC'8$No&:IW)|.7urF|NE$盺8ap[-+zoҩ|n&oGW|Sc:9$oj?9T݂MJR&e/7UqK~݅{zsm>o;oseAp t[AsCXbI#aLWDrl_'uZ7x\eU;;iͣn nE:$ր b# WpNwD72[C [  pw w7ao}+aA[Do7g$ow Gܭ3]yչdnB@n΃q&{[$0]msOvWV샵U >Q]9bi# áZf}Rc5TbElEOվOZv@vvҊlQE+U@n hr'L\#p}^u.BB3Qs5B`q]DVZV2\`XV((03`I#n2dhws6@Vڝ9?~읾lhг;[oY쪳[a$g7o B HZ4Bf @fKE=xYA\v$вf,uN *{:dfN9Y9ALV)ZdHv&2Ddwh6z:|" ұ[&؃I݉t XfA2Pcu't؝I mIOZPk0YD`u Ck/V8< :+|_AŃV@ˆ2xG⯌=tՅ&1_u` W_u Ip _rzkB+`{_&|P"_q;CDaH-wjv:q䋀!L.NÉNxKG8BU Cڈ G!*pkYm'ڂr;xPoWXU %A!*vE!cQ e!*b#WBUd W-_7.A_BU'BumU Wq/__!BU ץ偿.Cu **Z**8WA2_]B! L+xeȪPJ4,*10_]K6Yy %Ļ }kq|U W6_`CU W ?_oCU W6_] *o !*o !*i_ECU4W8_ECu- !*8⯂s !*8⯂s !*8⯂s !*8[ d CUpW9_CUpodU)9_CuM1>P:vg(KD_+%i:J4, z&LI+VK4l%0"ʼnꔴKX߇Bv>GxGfZ!*둅Vl!lG6Y5JZU\o9d)[NYG.Z!z$Wa0__r}#%Q=__}#"J9޲ʪP[lʔ-e%}V L$#$ͻ[$*YVGYIvdz&B9޲JVr吕x)+-$xISl0ח\/I%[ˊz_,oYe%nyY5YM]V-m5ny[jVZD:)7#-Kȷ_lmUnz[۪VjUmoq[ m7zdzKGz$N+G =r#ao-ILR둴w*v_yb.5ݒVc[ =H'=H'ψz$8햴#iVVMz˃f-:nf_;EҮ=+ލJY]%M )5VS4,0T;둴{W z$̓R H_1=+ϵzs_y&W_)?WWE_@pWu+X"4ைT8+1Hg8"sdsmz X:cn?t-+E9_aFI+?x䉹?umy㯊9"@ssm[$cncroU([cnBUa+_BUU WeՉ_CU2_L\(U5\sCrN+r%P+ rQQ+C|rAR+W/2HV_wK1,<9_wЅv'1HU_Mu_7{_ĨW{"$t[[௛tW >_7C:'4K'"zCK a[u6P؂KXԆmA:K,in?aX?E:⴨Og3{ ͊ ??ׯݵ_OOf}H?J_ u/~ocZ=|357[3B`=H߃Gů~ϻk_NzL=ۯ???e^c]ҵrCymoy*_~܅yxό^}KeÇKU32;|vCgV<.<Ѓ<ƒ]<T<\~8Cg-/?ty~?.??}y~.+/> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000023206 00000 n 0000023289 00000 n 0000023412 00000 n 0000023445 00000 n 0000000212 00000 n 0000000292 00000 n 0000026140 00000 n 0000026397 00000 n 0000026494 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 26572 %%EOF metafor/man/figures/ex_bubble_plot.png0000644000176200001440000016341114465440735017643 0ustar liggesusersPNG  IHDR}* pHYsnu>PLTE888DDDJJJ)))>>>333}}}!!!ZZZ /// 333'''vvvfffϰݘىQQQWWW```NNNnnn +++rrrcccSSSGGG oooBBBKKKjjj///===%%%VVVxxxaaa###888iiiȥ:::ݫfffsss;;;[[[]]](((NNN___+++kkk\\\}}}RRR888111{{{DDDIIIcccTTT>>>IIIWWWxxxMMMddd!!!%%%ґ͋,,,///;;;xxxbbb ___SSSuuu)))888YYYjjjCCC묬WWWNNNeee\\\???555gggPPP333111###}}}~~~lllqqqnnnIIIrrrzzzEEE˂GGG===KKKUUUAAA,*tRNSﴽ۾п᷹ٴ6m IDATx_leqN/h\gfɨa BSwzQm[&E]l:eL_g]P/Pq ڐKn9i+Yyy{Nfyyysu|6m7 >zڏaw}CVi !qk*MBd>92k ! B ! B ! B ! B ! B ! B ! B ! B ! B ! B ! B ! B ! R \;46w55n<[Z/v5jxcS &B\v쎪zw4}tP_E V# g8W^G s!썳ꏽ8IД'˄p$c2yRM3&=xɣ' ®xw2$ /˥B27vׄ7'CgؙM&0b{!{_¦8L_/†քp4jo<0{ Nz\K hLzOEuw"dM0gv@ƚ' w\B ak+@G^fjBXhi]ƻ˧ ' _v!2 iIEJ2>]]R]:{p\zh@MZ߳#.7QZ@D>%ik]®]Ź2g.oQe !pE!<g_@zW|mpz"\XR;zroE&{HlRz촩X-b2?!g~Ad&VxG"ߗ'"Җ~1as?8£p)…!<6wR†c9/~d)ϔ΂㢯Ga4~n*YiWz$VpDPyN̤4bzs|-Z-c|d7ºO"6&ӫ_=|ľeX*c+7&[mtowKLTB٘^%?12ѵ镄]}MAL/(mݑ&֑Q!o@B;6xW$]u_hiXzXsb]K_:ڲ(իP98P]-_{$c޽ܾ'|۾ur!<1@Bm)TҶקO6+L 쯾tt+_h];63sw07\nht{e\.6>7{{vK[+߇:z_/%;Re瓛W5BBjoo˶}[O$OW}FLLj❷OGo/*P !{!D?Ӎ;7{I{@!k#*o>%Xy_{z!nX[| ˵;鑘%-FBjtwV6_$h7ol՝zgFBp}: 5/qkunI@?7hrmy.mJG:7 S.4 RtY2!,?rB^8P-Ӓ25B~ULB+چ& $xwS'>h.s+>}?D,0ѥpPIDX>]Dm]ć/1p@yDO}Q?>W]0!!ý1g&<q>z@US'HdA"|"Yzi !ķ2D́>D;X@N* !ic! Uj;sJoIZ|ibӜ`z BV3'M?1@?>a["Q BV? ٟOx"D/eDSU?=v!ju!TXOqKKgnCn&"tBm!DhhltEcXaY~ EhD  B!qu&N\xTyiCrYؐ"؏DSz_B1}z!d.9Tzߥ(@PYIupD2f痾"=?~D;w$Ox   "pᕃ}_yEgiYb S"l%(yBɞwi&@|BWy KZ  _]JDgVG)ayh0&JGϲpZ0!3"dFR:DqWvnlPLDح\KO.VĢ! q=E BimCDG<|FSL6DȊ .D .&27k-gDIM> zXr+ڳ6)Uᮊ1+] LQ) bic\﬩"IT(Ldhi|0)4 J0)]c]Ӫٍ5k@"eqDؘ"" u*J}"yU1YpJ)K4]œ~)քu;[" iS6>4iLZ|-KZ-YTx( )°TYYYƣN4_2Nf?VHaP,(mqI4 rY.0؇L.BK ;*ԧadzRa,{aP;/‰ EwdEԯGcGUAEhDب"T@0]ag-6g,5D^׋&I ]c bv7|OOR,}A *BnE8{J,3E?U@\"|hp/JTss1Қv$BK BP[";*FZOFCO(JZL0oň68"\- J[>K#¨"Dب"yua#d}]#](A  q1}T/g~ PqJnf(,@eL>2tļ˨gi&BNBhqP5l2Q9%- "l8.,* a+xfbKZrQu>}b:g!'a͏2sMSV""D"߯PYayHi E-"\ 9 nmn*nN3>5967?|hi-L&6k/+&EI`1q\?ZK)'V%Ɯ!@ ,B ",Sޑyj "'S#} q^Xt[ޕ"XαD;gbKrD" F:d!}u}zHxF{i=a̭ 6LKIDPͬl-B!BDXLNm)+}`& Ь;&ƺ ˤ ö'L GXcHؘgr=<˂"D"|'VhM-R@'(.@`mBR-w A)_J/V&F"1$YT 0&RV]{o šVͭ䱣Ix "Yb(aGk&BDX" +5^fj.1 ָb Bf^ B^Ez@Wo"pGDEpw B^0^2DX=?IPdKb>5#.ӶJ$sޡ,Mko2~'ݲ;鞑\kЛpq$bBu>ʉ.ϬI^S}uxGuEWr,¦/(J ), c5.B[C rHOh1OeP<fd;Dx;Eң(4@[2E6{$a-o5R.Oh# jhCo@1FD8`0M`BHQbdXfdT*UEla7TیZ;jCPz Ck%K#5r;JO]/zY٦,@8C7FADmzEvdUR^1.Fܬ=!vYr9Ht%٬?8K <0b?QC 44G g WՃ )' XT]‘sM&@8;>6'hˉ@$Br|£ 6ڂ7*,3@ݤ >/RŠ.)D9?r ^1h%;ګaАB-1EV9e1/+1@8C"qqmBW.^?&z;&FS:gM~!fH<}zQO~ ;ՇdəӐɺi'][%/ #A3t QCGD)$cFCS9M  1^|Y|a// )AB V12AI䱸 OQ^A{TABxێã-8-ugwuѵ-XiYaa-%JC(WMS0"* FTrؐqP30 #5tAX edn|FnwY>a 1W8P?\gơDV7K9)ՌN`**m$CTzJ"_t[[ lҰbJC d)A\BoZK@<4lAil6tA83BRTKVLP] o=PHFuQqZp'itHkJCvUӔ \B<)GmQ="5˵7 G7@@8gP$#+ᣑ83nl`D1f:A  b4_)4 P5@2А 5-ʖ8ԴmE1tg O@@8mȠZCnMjf^z4) }wxrCu1:S5T8_k^W5ѮZ 58 AnpYbSwχl J=B{!/&TnUe洩@x*b4{T}py+_J TaŠ孳޴8#  ! e7WrW1-\“6wR Ha5Ak7#B{twEQC[ٰͰTN W!2t2gXق` p3 i:b{iHB>AT.Tob^bͶx[U!?sKp 'n5jݔ1DmPŴ@xDS d D{5%i]uLA{bÁ,׳7BlP?+?,Fkl6lEuq:1ߠugڍJoszǻkgijS:1Ѽ/U8ͯeQaPNM* ,w9L9Lag >;}J,ڐn[n?{%Rؿyw,ب[@7h;]wM B[\];]K22c ifVqiSЎlڋ50 B;z~ΝMT`d }h>na5f +_~So^uQOeU&I2v{>ɣ땁U z dhbs[{;QHf!Ԭ NZJ7Jy96!pqAt  !G! !HA!.6C;Bӝoa #3l<BOsA!., l<εzsi ; D( Sq=Y"OeَHƽU薎F-A*܎B"j\bހ6qd9WN2R\ %4 \*{}[7hM&\{$J\Y>>o iw~}Zm!FTh1,kug\8 (ٺ]́4 ?{uM睧Z ]S~RUS0zQWHqBp })6O~^љx1ߵ_':v-*?D6Z4( vE.Z_ [@r}o` ђ.y2WHN rm9 IDATR$0L]l y@Xo6"z1lhBMlR\qFx^hlaҗxTm p˱ˤ 3X:y`fnoJJἀT%jev|mvWV=_-"\o%AmJHuM]Bgej+Niqr&*8vcQLp`%Z+r 1rP#9Jø8nFt^ ;!ߺb *-I ᪓#?bFq2jf5F"Ob@Nfg3(mOT/OiJX8ay5rgJLIRC:#İiF}QuGM%$676mC",ݫgV]>̒5E>ɹt?#cW:sYDgi m%…DP@58k.çt@&__|gR>p6k%|^s7'iKsu+LZZI޼"9f競Xs50M:֒Kaj2nK OᓜK7oN9hpbl/u6 DXu(aEG_ezSޖ"\-XOۄhY$,CZAMYu[M;R«(.\w+o ®U.!W5\ 莆!" \}7LO}PTD "\|䣬@I#}f*~3Acȑ!2oiG_}CpwhKiq QRs?}%B-K̻QB߱ԥp*VeD(52I8,IΥ7~rf9Oӓ3tD<"$_`wIIKt$)RNpWVF~źd^Q+2g"к"1Pg9c#"XC F\t mB)㝍I'spo`IR)ۈs+&vw$ձJ|-lU Fa1A[zaS9!D)׬)[0z>L1eEBc"nƇGW>6+9o)h>靖2[B"ia=!j"l0 qq|QgGl"|Oo{UUsnN-ܻ۸4SKkV{ՔkԡsE=nB\?K7aP2wA/SEo_<*O[iER̨A߹m{UmJfѾYo40r/DҐm-֒f{jffX+nE0(aV{5k7y|[u*G/4ݻ B9Jy&'_v5nX;FBcb*l L:Lnhimo*[fJS@qTd56k;ؘth 7X9&td+"t/`A='El_ $5;6h.fF m=Yc.Kd:Na\Կ݆,;ñ͊0}n_:\|/u%B"L-'ۏb;lI0(BsU9l9K!"'W32&G`?w,gG}+kxd":=ך=J^W#Uk_=cZhѳ+|tE|h:n0G\b Zs FUyDd"𝏳4D D>%"s?+"D"TW0+"D@! B@ gw B@g#DP]_|"TVӬF" !"D@! B@ p DPe"-$DP]|H[7" B@>Ê+B2G! BD"Ą"S* B@ʊ/* B@nN"TW~,"@!2!"{,P:"~"ĄO PSpۉꞇY!?PS?ݬL_3ǙPV7zbn@]޺"$s!"1PW/^0?oRU*{YEH( BEx'"PW'w2GUUYᕫ#PWd"ĄiE+·3O_NPWoq& !1!-+1Uҧ+PW,PVeE|uEH( BEExy9 6& L+[˻0PWd"Ą@a<'o>-.<6Ԣf៞9}kc DxC@]v>(zB?_lq010za E0HHHHpф%P/$!땻zsicbS(Ł 8 &l*B~VwBUˇ:8[64^/]!TBlSӿ_=oirȤ&0f8bM!<=ZWf\8&ngYYBg5.Nk3S* ܦfr!.1TcJx8P$#ފɅ™ jB-j نx3+!نoW<&db{H0XbT- ?& @!`/t& @5!Lg6Y 3TB:X¹ JB:d(;`M*Bx9^Lb˓ @!,N#] /sx";z^;G6sA 6G`O~3T`Ks_ PAךO$WD#HO'cPA=r # 9 @e!TBa%l\bT‹K1 @!{ ޸x9P~ a{w|ٜ(?b[]}LTu;G7iW (GqOW!\QP~wǒ aGP~L!f6psI@o\`dZYPIS=|QJa%lbyPA?8d@!g#OlgӉ/&{̅ @!, [G6[Τ>&!4Ceg((=`O2w2ua_Gs!:ט:e续imt @!LQf$J@!,!Lr賋LCXlMڱ'Cxe=g(މ/=e4o 0zacf6{⠭d`K˾TCQaq8J4N4~JṞ-=b[@!:_6!,9[4ѧkO>`BXr>|Q* m!,= Sk@aљjwƕ-!,9{K4qE %p{ܼ185"’CN|[ &]F@ a%l?_05ٖGO$[^g9a!Gl ;lCXlm[.!,3@hOWN$kҽ#kgXBXb7bdC#.&~-ay⓶noW֔|Ck(jW[BXj.aT@K a%|?.\=η$T7[W-.{W<{bBt$W.ev~F]6W^,2sqR!~l;^¯_fF7pqqʄ>'KTl(+2wCCJ^A]b/gF׏ܒv|?n)=aq}CX πF`^7avo\ N7uSgox#z\E?œC- /ဋ$@.nqqf~~59]6}w?d(znugpGh!WGJ4`'^/ nF%$Zz$N79!\oj3a%\Q?˸9{lH7x}mQ ИC;wCƒ@a]|{5*{O>p欿7bn/q;m-zbef={g8Ҳ,c$zܙ]io>>g)>B3 Лמ]=\vfQg %@/28g>=ꙩݞ)L:KM`m fzB3oo'^ "qrW{ ^:ĨyǓrS($oiʜ2Kcq+yHk;i(@/r×kWb2m3E,Ϗ>#{@ )|4xmG 7?Γ~wͮM>bj׫uQ]~!Ld;'@f=C'py|J'$cf9;B$DJOQa!vqH l?H 6(!,Xי@ ׮DaŶP6w-!̶I0\S [7&ņhc };nN!; @vU{. o0Xa7t@DaKᑉf @ V̴`0wíI WYS2{0!J .a ט2!n ) @{K&tûaK @pb+fl_!oB쓽qy2Ĭaƺ=>|B!ٺ' ~"peB 9!Lm @ouQ!۵@{0aeK~|=!VYGf0gٖJ k0g_uP)! aAؙNLl0WɄpge0Oͻ{+)q|&lK a@<%53Bلהʆp-I3|BXs(jLV7@[w>!93T8pe}BkL ظ% cF@s|xd[B%\ok0? 54!@]|f U aBlXT6M_!'l)~6BXk -2BXZ0 Jg5pL#䞫5>=8a^> Ip{]|8a9T W6L6B涸ŊA6uqQd)\ىL*޵JD!H!JaDRI r"*Ux`JHÞA3gBPA تIvvOdssh<žQv7bG·KKOyKž!_t3em K[v2#$p:AX1o=߲;P#`n>"__y"r`&[ IDATU(0&Qgf9Jdy!wI3`r5$-:#Q IPF, Iܭ{P(`^"oID+79 ؏wR$z+Bz>9Y f kf$Y[Q*`V DAβxLx#fB㙍QAXj7ةk; QtwK~ips!y¾]֍jSr(ˏ ,gmޖdJe?A)L J}6[SA Uv&59<`Vߖnwnt/P+rk fHBhhhյfADm!pu7$! _.?dBIXVz[A^~N~]o |-N?3PAx{~ I`̀F߱?0 P:`D8Iu{ Ž Aؚ ApqTyKζ0 ϊ$B9ҏiE.NPAJ98`eε$T/YCQÇ@cޞD F&YfP[۰SAxAx*9*A:|5p! p]}!3SծF'! %Np+J$~8Q3¼Y.>{IԻe+@' u{NOb(p:U(wG`x T^YKFbwz#T]InC&O;5ګ&P$| Dne$g| \()$lw0v`tmJWSD BC]þ{kFQQQ@* D©Pyvu3("Msެ/W{ ܙOIՍy!p6RmBB5Z0N 1DC]wvSh J_!'^!maQ'z.Ȫ6E{ϵ-r)SL*OgB3$Lj*=De/(:,~gjD*aOةgl FZ%W߯x$WMڎYa !Q?0^,` @l& RB$GQ>M%ɦ&tDu1}goRamǔ6tvP¦)eTbvv)-V97{zcxGD=Jh5L4YVv{W./ە>rڔ׼x;ж;_cEjbkdY&Ɩ-Âg \c7D%FF`6C ~ yeoyj~7lli& I&)5X׵KKn{ιWelYyeܣ㋎>;TC;GeurzDXzL%18zIlXV!#ZJٯP١ޞ` t-'B xp ʇ0F fx"b;$yVOHIs(? pʢӴ8`NÅLַ :-6DmVY ,x ",+*I%fQ6R0$ħħ{#7C]&Cy=bhtăaU1^R64[2ͧN]Uq.#liyP}x4A.e[(;aV*Lgm,o~GuO/UH仗Hy.Cٌ|T0 gj"°1]8l*h<%k\q?甓6Smq<7'M3"K#E1T.KNSiDeݣjjʫE>%mdsg^.B}1hNÅ PL@dhؤUaʹ "t37n9+w1/;"-I\>oy].BIm c ea@2]ȗ\YISnBI],[p)P_.4\1TăOao;!D ޽~,Qw\}hR*K# 53FS~$;Nm|jEyj/'.ai"j+]g԰I B)ێ:+y4T2SI)u !- [&yiMqT|“*8JI1 xiT:n^-ip"lk%yb- @5];NϮ3bBM|Z}1{X?'7*̯W|J9U|v7l SnDl.j_7 ~#jNÅ> z24#Tk %́kqv6%07#;UPa|po_$XF = j8`VC>XkŶS/z{]E=Hqgإ0`I_BhNÅyz<kpp2jeз]7!^X",-+)/9g~LYmf]BA;4NK)]PCTzSj-^<#`(g;(%ᒦYEVVVq*^S#! kX¼Esj0gz }lvļ[?aDX!ᵋ_9̾1eqgM-ezAZqiIvMK2*"퍝;fJ-`\~Q|˥)KI'^[bq=YN{fߢ'r&2fjDW,K;ܞ Cb rцT,jL<,@=GbU%=hS ˭4kwiCKH'6F2YP6VJ4}V,J+j+xpKv:9h]",pQQ܄{=xo-z Dż\?Zy=e0 ϔs,·.)o4-Pݸ @[/>]CRQ}:FS[?f:Vn}Lx[<<{ o*αU[@@ky=9BKD@0a1ͫGǧOۚ BãϰjDiý"tLg޵ /( 2}Dx@c+px/f"q^U. cG?v ([AeSf֩nVJL81L6ekӗgB<)S:ƍ\ON#s7l.8_uC43D7H>"Ao[[>TNj9"/7?$v)'~`$L8@΅wNt?@MLϭjP u9lԩ%[k# "|LXy=cj88Rm+>~@ 'C4"ߦ4XwDX _^fs}`(b2@Ԯ=12aA[SѻH BT\12a KgiApyE9XќL7W/;o y -G=M7A4 n5O?#%MEE"+CeM2%!v|9@aVYb{^)30fd*8Q9Hlapv&30!`+˜c頦"u7\gB!Sc' ہg}۳:+H "/JDm: bg1CB%”Z[?̌ag?Bvă]%iHS;\yf"Ds ;NHCϯ ?z$#rҠ(mRD?T4J4n cp|| Rf`$Hf0Qm Q&n0akj&طie}7_}Yn9 ů=t/*?8~ "qɌ"|D; -/}TI#:&zU6fI惗,zE/B{!­uB^@qQ5H*ȰksD8^n" D.&3 Ƥu544Jjvq/06mRӦ&vco蕉I m64^ԫwΣta@@%88 2jUTG[ԝqF:Bpϙ~bY2C2Z5gY3-pe}<eӟEp[NpTȷOV|hY߭VȰ0/WfYp3(u0ں7N⭿lދ0~c!{+D`YQ}wCx $ipN! ݒi3FK;X'flٚbϜWBX2s@&3Fۛ'/r<5GLs!%P[lxQ<=>ߒgg,BH Y<  "ZJ` 3`L !pU#@/ /"]Je[*BH)%τ*EJY3/"Bz E ^i e#R5PBZJ/ +M#geԬݭ- '0u~X>{^F9c%3wXfY?<B]TBpxˁ-k*Z?~+Bu%YpGïVxiLVp$ %4 ZcBH S*ӲƍEp\Rh&!|gVp$,jzMb C8f #z2 jB3T˶I 1C8f~+BH 9o0!!l W2!!¶.M%^a tC8%s@ee&BzlVlL73H'OGmKXY >]( ЩR[.թ ~2abeiVU{ @B8RL й k;e С=ԅiBH)1Bhe,!q=w4HxK!$.a@JXآoɌcfB8T+ԕp!@D9=l!9W#UJX^ ;^1\¡;}ïo6O!IGa ۖ.dB8tL( O"$u]WŠW3 !31w@,` Bә'N] aH4;`obB8p[\QhϚN4*< !D*7sʺ%BT*v !D31ѽ59BGp9W@Cfbl^p n k˙.-%ՌB[ FU0u9@RآR !D֊N%7[)B@GM$<-#%tpm!4tCkn YY.@I3BvExEvf(b7G͸f4ttg 1؉fNRt;+)$ƴvMJpFjs@IMƤ?4:"rBw29%Ɣ8jF7M%a2τCzBh̽_% ̭i*;S}&VS*dk]l njBhv]&RkNnY:q%oczBhI#,-E{KXU!M!4[Yʫt'䲽oU[~(^/|@*1%W*LN)Š S @OtZ tMSx&\TBSTHX0,r2_ @MxUxhEF[lP¤]mU8lo0)z?HzU~>#a8)* %LBn+D%**cKXH ʈPBc`7: Y4@Q鹚Xf&qI3DXKCSK$ty9J]9_ J=!$VB|슉boTM 6Kс44@Ɉ^ I]mTx v HDxDhT8zzCm}np J~ =҇ L<~(R\B[+j6Z2Wcd!cs݂:L&a.y 1@&2vЁa 4Oy{DwDX=a j^eǣad!cQV8|K;1RЯ[4y~5 (LgL"Twko3|"D&A/ uOo:G0cH bN!coŲBPLgο!k ;_/ufu4LM-Cӄq჆DLkl"dԘTXyq *^kҥB $!ceb}P9UN9X Ku 'VQݕܹ Y[ т4xՀM.Wg`vdhA:)FRb$&a!cm==L++! *%BZT *u*Du=rm7+l|Ƃ06VmlrVWabCA'1LMh&>hՓDZ[2KwNeT%Du4*qٟ3"WAhQ_}v<W~ݸPlULf'z-!]jgTE8_{DF+d޷A+]*1Ƣq@f2}AG1痯+&AƁ _CY-VfʋSոpFcjr]*BO6⩂͑x/SՁ|.Vu.K-Rweir9fO ,y*:%#]Dutl4%҉2pg,"dlUTW]r|HVVyF_U&EevƼpqeI4"c`EW1,6ޕsBZW=n (œp-[fۋy;[=ӷlf!coAA3kM%j` )7O'TyQ!}N#E$Z촌T/-(lӣTūXGdLP}K4#µ\}eQlx=7mL#RVQzE*-w e;f̵dFjN3[YS!}k(D;Zqshz`sU\E38I(^Tٵ5tS%Hy=aW~NENFXP%zjg:Bգl(W}l*` 2vThDGo$SrJ,U7kͮ)$zW\qTLK*>Ր v EAfk|"̟2bGp?sJ'&.2mT(ɟ%.RPv0 M}DOƏÝ&¦J._(VP4Մ{ #;!E k4 %%nFqM2-dZW!DZ,NOȡoD)XrFQaK﫮C9(=?jafJUcu'% MZYK}E-Qؠ"e8 \k_"}[&.X2->9(D&3jv̷x"BwڌKq4"dȋ)۹q?q}k!U?K܇Ú)U\QSڽUI_)DYs#G0!bcNdSǵDȗL"Wmpcv;ҹFe8ˇ K8aD5g|D& y$EhdشD,Ӵż"j|-WH˼O ͮd۔ՠ03>scį bA48J ?k`uzՁtUʻg2IGisi*[pC;q[01\,@1d41&ć51C#H ҵr)fQ#0u%7ʦx 72)_sϪ(5HCF ).fӶdD*& N3&V8fQ4rv"U( ѽ'tc:qIһF T ZQ^,ۼT]>gsm_c@mg#.->т (󴭋;)bG;l˚RE3T="8fXG6Y35ZL4ASz6}C{p)5G(F<?ׯcgB=%{@,9du&7iM&f@).s{d32fOVq\;r6S-<q",.k=ki:{ziO>z̞`y]VrW~c8PcxcYb~=K?_p%J Z` s b8Ml@CǑ,B[)S+|Ob!B>N0 Ap0M8ּ|T4隌=׮׷5nDpMj(+KIHWųsSXjunPLւh/:#HMbT:պ2+bH*+q N/"f'p"U(:x~30j=[%OB\hYɳ8.!w|x,Tὑ@M`.DUt&ڌ"|Ed%Q}pK@uS}.xiZP ϗa5] Rค (Bg UXE CvpW+g08)Q(WGߌ}΃r Z30+Ń[`&5* 09t){+pTB_^Ufܒ$Bm<n U9 9B2p`@aqqik@@_`Amjr ,F 2|/ŁA|Q ;O{Un>lDHy&*$8KitˠЂ‚KI8 | .E^цEh)4HȢ4f'GGr\0Y`"tseR=,ZMY SEaQiѻ WCğ"L=C )9B9[B:~O>!3 8:񣙔aN!KMU؝ ^ٿ G+γY1Gyߣ=VB* Bdt@[zbF rLW]6 Ÿ0!,=3T|W"TOL;(B}GDfJ:!Yx-1='(Bia:Ξg3=S}"хW_@E?=Vtvo_fcC0!]z0&_OP’>5]t>z8h!EXK•~\5˭(…kӋrP EA>҉fSl]`D+;U (r%fQXToy¸7Koe6ޠ /r\68l!?p%B.MEhER+OU}z'(]Jx+湆ye6!ŧj*3 9BT;g]q"`$6Û[aNk.>2l8$QnN8y0'-kߵG%pva YFre4(AFW",rĈXgp"R2yOB:$U;_29n>X APEh2"W2b V RExsY*ۭW@0 "<*YQ^%;}>3=Xey6L'Qq6׹ۅ8H?thBT}BjUM0.U?Idh,bD91jF$`"TjD t(nfrUBG*FhIH9)NB#DPq*QH^(BZ u`::AAm{|=cyXY& ,5(B3gVQˢ Uq1c|JmRc&d'Swv?Mfyoً%bf&khj6a2nVMLL&ź13dʞm>TBPP B˫$X "mwnj}J~. $sw3@ ]7[W*foˬi21ol! ꧠ>UBU7ӕTާgg Cʍ7"h*T+|2@SmsnjF13:uP . R:k, /Q{-gnC+ݫx &I>ErWl*,4G[ =$A?ߐicm~Q; DbpeM?vN \ohF'c![ۃmLwD3{Lٻ"bowk EU؊c˹S BȤM*fYDn׿_nm6.͟"nz BSaMhsd7 v;:x][  !U* f XftOSVD !oʼn܆] k+iWt;i\3N2DYzPa0 pLWJQ,镣H B(!On;6^[#s9c!v N+! BwE s#tD֤[®nQWH-h+̓Z!Hv 䨨&2xk}4/|ʋ(ntp ӕ'"n24=!s :*,y>w-2Ǭrt,m"䋙Ee]sH=a h"NrԼDq0Q -f/ͺ_"_!5DE)% }]i4_¡@jHSMJ߇Jq?H=R˾S}dCdiEB+[ ΄ aLN8 +]™U g2YRKGo," /=RθD,#ۯF$rǤpsC3_GeTNCE9;єDW^?_B4U>SR)Zho+kZ҈& B=U^k5v3Q͕DzP@<,3`"zɕM1D!ׅ3DV׿oeP1[Q@͊Tgr *ThEz;,Eҫ 6p[e]="jpéby W4͚<݇"䬛`<>Gr؎Ӹ+{$!GϔֽL -n.G?H, BjZ(ΡFy*X"u.is[@|Ŭ[h͡rH. Bn^qV1w#y"QN i&ґ30[śV9I!/է#"p!ʑ_!Lvw=rB5-ܳsA:@~E;|>AZ /N$!e9ctl1(-( #Kx??@2,!f:Ѓ4tR[XS5TK"T^i5,hDxȘf-I;\XniҤr!үꦅ3ȣ3*A˦pfzT3=Wcj&]p`g"b 愇A(t"<XaJM,] Vyݠ:sf5ÖFa--?j5p4ED(DOu;Ug \ժCw: yP0gY1:ͅ"֔K>Ϫg&aɿ]`^DXe"LKKr~HD{Z |ѫWk*? EjF8tl-["5nHBSD7x@6QTR/hs5W_hwűNd kf3tD~DqJ= HDϐ :&5= Us>*Y IDATyFߒ%8xfk|@~-AcU*GUͅ枴jV2kWnܾΜEEbTH} ùeuX"]G-(&NH=prm&m hN34"|5m,PLn^"HcwT<0f5.d> !DnaE*D͔N53胻D}MIz֯׾@!DX P3.nUb u%a.I60d"el9焌O| A#HKmwG!DxI}Jm1仾%! B,%{4ǩ2UƸcxK _,ՃMn奅#1΀P*넥 :*!Ej"NvqBl:d$$b"g~UA*-ў2OդNJãp+A9 [5"U[X;p:;b#hK2z9 +UQMEwt҅^,0T&s|f/~@fJu"̒|{']Q Bew`DjbS=.|Z.UI̾wȭihx!ڪh>甿Fe,U.cP=CjRZLu"6Qayn SMPbRw3Æ|#DdD_](*W *da(C!c"D*Exe0DOE[Y3,n@w?$ CD^F1) )UU4]Xʚݕo$gYn`Cf B =a UA7uXJkVY. ,byT0b!| /tXu"l#vUra8TYw1\%5O?6D$#GՉp |B=Ü90r D$@KѪD"oYu)k4+aNAbg B >O4_^Vykl7)7BKNJ&r$ԑ~z!h7Xbeࠢ\M9 %{—=rM7㑐uc9 NB~G[Flb l/Yf2WˠnD棍N"L], .u+a赗+3g>Cd4zns,4% 6N!B:ӎ2 hNT{Xٗ@a=M_ihb*;՞$N hȺ›*դ— DhP'"<ݽ7^Hb! #)=ᏼHgw̅5ٹbq (qo 8ԑK%tŲ72ZND˙V'0s1~iS/Vi4jTʿrqB̹OׁD̳j"iTJB[gC/є4WXrt[ZNmpDcXPlMzgU4-$ڰ\U^شFܸus0 E zjNǘiRđmz oN[=\~bU:4LȺ=@ @F'a%ǐ.9mGGQntCם)* lWFub !3D7,S{V]V\7N Μov0JOmuw$8nԈL$;R|n kYk=\4~E3 @\s~u&(F QDsb%4-҂=N\J)(R¢YZZz*mPJͨocf@q,hľnNuǛB;h6b#Lg {X >7:p˸}L+G>dBhZ?ZY`4݆Nĥ~Kl7#p ,zfJϋ$]ߋyyGH%](larلb˶z_]WwU{\Cڛ9wRKGfl2^4Uѭ5wUFKp/- ?³^F oגf%wJ:&WCxĔFQ)gQL P iR͉҈Qew y4\~02Vұkҁ=sAI#lR#[_̖@)^8T}OեMkZSC- iDx?:sVN BeJ{ dݬL~uMB}TZ~v#pPi11׃Iɺa~pBuߘ}[% `Yʤb֖6J ٸR^^v~8<P9-r!{ŅC0gN) Nqqtˇ8tًC*{]i/fP~vÁNe)3ߖb1&>pa ޏ[6)8<<GT}!J]{җڴhj =Վ q8bnc{+*=vC6 J|%)0Z~ 2ّ̎xP}'>V FȧWxP?Sx(OJ"tk!WJ)CdJ53\0*ujV/p fIHxQ4r(mb&YYk4|+ȧ,ӗh3Ԯe5fNʝ&Z?{]16JO~ / jL箞FL[}Nb@vT ?GѾmx۷ =}BEmYZ7HDp('s?xyMwҜfߌ|$o8iU,<fg௳,iͦiPgmED:)2*ѐ p3%dvԻr_~ g!"RO+X#ƕo+ }xxS!7:,F2I]FN8ݥ">&YuS5AFT M Rhjl_(+!a]m^M(k2  >l–EPԶ+7&Sm9@FIO<%+ aTŻ!BDΏ6ӐVD3nNLlH~Sf ¨xϿXOVd YzqaBRE),'E2PKTa y憫'ˍB|j$Y,S/)U0ԥ/ IDAT| qJ}UdAR폤ړ$4T`0_BϣH! _J]!M-\':B- $g?rCQ^* 4SU咦a'[QO88H75kX 3Ub Qǘk&* -Vd(6r+֝o r@(2i3mǛ7Tμ-tP4aQG7<-(Gh_;2F x[GMDc8K0=RՂPJ5d BVR$7vE0ǚ/BK+{F=ΌRG悈uM l">!Is!/]@Hm{G6J qN>WpL2F[6#%.-82ťR04:\}ŠodxYĂ{2u_\O `Rg֟أ9yR _ۿ~S8EN"{CDs<|0*p.MRi8wI\^ Y4oQa&-3hu3:B"J%-t:sd;k*4tUHE QÅٔ-xAX:y*ثu#xPT"L]` Bj D [M4a ٗfؚR""B^n#~̐9\2ڔLD!1gB E}p$%ٝ'Gz,dmenֶ 2Z"y.!Ɍ2cȍN|*Sp^s( $" ~xvARוMdYZܐ_in Eaw,I6LK l _n!YH(oZu|6JƂ{aMɞgM<wRaXbܽY%y8XDKC:3(CU:O]nk@ <[:oC׮ V2 B=-=E4$RڬaI-jD*i_!JERx`wF3T_JK%W JMu#RWQiFMizQ"5['$/ _RX5y#tM:Nͬf-mg/u'8*nMtt>z;^6B55|)dEd`"ͰuTJNR$ 1P!Ru94ځyDxd)O$'Ypbð |pQ nQIV*YK "`P0g8VxpBpٌ{:ѧ6w?G,.3`EjɲR$XHxoK UGpmbCE3VP2F:5cl8wLB!%ޓ[ށ6z jIJuNGJJ-BLZ~Jfʤ:O3f Vc\EVܰu+Z%Q!=" .KnP6 BYbRb ^){E-aq9 O\UV:җ<\r޲ڭoӻJ4T|wrTʽGB!!J~lէ#T5TH)9p+C+3w&ur(gFB!.:wVQ; Z.U#,U'a eoJǝggiuX />u3+1ӚMyCs:-͔h<)Fbw9XMbxZ3L*s47CSZQOdLA-]9p晸s~(J>1Ϧ`8]fJ VƝlfOw7ږVJi +VVY׿PƓi~8tT:5kh@ˠhQP" BKUO~>< P鶌' TA1MC"*w~wu QVi\H>^C"jxMzSO&$fiM[m7ӒCZgD'K!B~S{ibMmʫҴ`2Y-֡"*9u_Qz;-Ch5ĶkVGR:*kqLYGZtE;ǥ!DTˏWi`}pa.2zJ!MUʧ-Vo|Q}i2ɥ!DTʹO g~NvM ߀?)Jt3O@}!Dɑto5*faRӪ'r"҇zE|ҍ ~騴ȵN.GwHۺ<)W>!B⭲ w|˓pѓaZ`G&ZZczE>1! D΍Wo|iwsF]/*:.>̈@@x1^7PC} =o@!uWytAm-ɵQeèܽ>]_R:į|z5܁)5;.mBVST>CvE'!,yzAA)bvJ^)fv_&|~{"ۓޞN@@U&aJNyhol+=\tT\4ɠB&".A~_Tpv-gB|Hr܇&Yjx3T2kQCjZٗF"@[|_e:UPSIl8{gw)3g=> ̆u@!rŴ, uI1ݢ? Kex0n6:Ǜ }En/kRC5ADD>Rj!V۪B-[p# ).eUחf<9ӼK KL]3!Dze~1߽|yltI4!NHa,`%F՞\HtŁӔ?!(1u"PgnRj\t=yѐ/Rˣ\ SԮ$ ik־֍5%|[< 2Ѡ\b:qO>D'T5~' n R-նBRd>"Li9~tD׊2omK֕ԼYz"@\W~fZ$/3-0ZYӒoOUIG؀YOLlx ']3;6or)p(s9C!*ъ?͏1#,L(x"h>UBV5}h%~S[PgOtoQx!Bs|Z=@`$Qr&:`jbQb6ut~,"@U [w!Fl5dur'ZId⵰㵛n.d|Drx!B[eR")W4dHshrt?h&ct3f jULQlѝǛ. C|>'*e ך)xyچ0IJ BD A-]gl4VR'xǗCʅo,"@\*<,CC|uNJȘbM ɾ94`m#]ԤmVSmQL"⹅!&VK"V"̬Y|nA57 NH3WtլÙfRKoœb]{(1g;!BsƒGWzŵ `vj/E$FH~k#4ov~Zd>sSlj"rľWwC?s"+p`yU)_ Z IMR oXMS#_:\j;,5^#;yP0ג'?vJGCbQlH|,"OɱkküϕV{'bL #)%B$:n%Il Gw<۶!R5[:!BG k:^y)j ZbOuClx8B ɳmć ӮM[->Oɰ!Wy]Ԡ"P-OWVƋ,$9x3j BBu9MvM&C}V{hԒ3nNR3dL$zymνusi*x^&MJV ь,&p&d&&/lw1I|q6SB[HK텶Pj PJ)VܑndwZUh8%i9~e"D.eνLE }W#Séi*~)jfZGPԾR: QHJˤ`B96TEFuyQC3bLЈ%(B!' -$1U-xDaf.ugxs"Eo';ϱ~`ƃ{mJCGֈ(WMC"'9tSrёmLjZoheKe>Vfu{"::lSPZ3Uڜk3 ޘ?;# iYQxOfNmoV)2CJc2m_o3SpXoD8F 0:7b:sʹWM#!ss}c#Sâ-o3R3ye,dp MոB{1_ pUSm{ȚxILƗ8 X3D6}N!bE+&|%bXyg=G;2J1.޺@Q?i8t[3}@5^eDU랁Իe /m!24AuibY VZ*k\g&֡<"DH&p[g;h[d9f˘Ȩ#f[#:\*q?ެA#yjk_}\7<q%1&^%(Bdmr@9Qr~f,D'TLЧ8FF ͋%ۗQw{}L4ͫd^(=w]A0$G⥁"DBkEOs,;,I|u%~AvK6YUR4%. _Evuz3tjh^QL#+)\11$\#㏓ۉGL_O)!c5S4665?lvR1>:fCNY1فFdjt2RH\oGvCʂ5=8|Z IDAT[Ep&bGoqӼ)& fT38+4*] ;DʫiA~!QH2*\?4,yp$`j C9oa5F /HWoSy <#?lqX2! iC:n%3hk8Sq}Վ!Vu:Y0𗅩u tóU<8m)V )EpO/J+JBn[D8F+Z:x/bP$\x}L-^#'} 𱚣mn)FT@sYbE"DbQ;:+̅y]XBҼi(B!_-b_8&ȇF<oST},$LM6^G4KMlQ6lU.4Z643Epg8&$&GRɃxөZ5?'G0)@Po,OA8Y5]IYF!$WQ(Bc䄅uހN==>'X7-v8*-01 8Un#bE.*< TSb!?w0"#V{rVH7Դ& ilj]VNN=2[|sV> =NE"DljtC^O}8l3CmJG{eՓ]Ī._1BjFBeK=/4Q(B\|^ze'B<@N%VI̫)br  QE@bjdfBa|Mg O E"DaˉyLHw݁\eyx vN{[zȂ=B9Epgpᣝt!uٵ>`ݞ=B8NO )䞃7MVPfƃD%]o"Xa/GV;qR 6.`Eߞ :D-zBQ EiHMEĩOed6&9E"D#*|*=l~}Dx`"#̿‹.AO? Ku$bK#ihIVCL{zjikLY<!tG`0$D!;'&VC$%Njp1㢣 Y¨8WUuUAG 矘Z]ι܋ D^ԣrWaF\q˹[_M_ 4Xk 4Cs lF{6 5x,uh:BJ Sn`'A=ੁh%w?}tA DTRR%|2߼^~{]pxp-UxCd9vfKa쐤 9)Mv`E4}e!p_~6nήm+RHSI2]q$sS4c K)w"OA&kt#9lYYf7e!A .hRZ#}'S[pbP@DŽ5VeeI*bMYG&Ύ;={+V]_<3v ATe 58y(􂏍+ KRJ3(PirM /#TAH^]'J |A sF@rH#A36;Z-Zqnpp:O PeriEң-?ȫ3DxШIf$h0d:PґA_Z] GXOF:>! [ݦf.I547A |Ity@-f-i!%*5`z[* &YFN #۰vcmk@s9=n-ڻc"vH}w ~C} \<;vA vUͲK0&J,u'aEpiL )`e4@hBAnM顙fbb95ʧPA_Ukd\w4_'D:`WrD(Ds6@XQZ42[Apa,|RrQN.Yk^[YF/Mv݁ bW1=%6exW=DoƦhbmm!3 2~-A)]DA C. Wz`R ড2-@ ~%%ԭh̬#ZD rZmW6 Btbxxb ]0ص|~.`sqRD~R9Mq]`OLN^o6 V4ZؖRT zC9@MWj ”9#$fS) c?4y_B!IqB#M$M#;翝= DbL)JaF;zZ.;nf~d&UzC8D2;`|SuaT- <.NrୁZA5>DT:LȌϟ!K[AU/>XAp{ݻ-daf9t 4E湼~+Pg ސ\]`OUgwr 4y*CwbcU,lܻbՁ4孾CpgXEMD=5"WAz{5@"䚳ezB\"ٞ54:K D5mBQ(+5oh -NiSBT˱ƟWzm*=,6IR,#d@n.# R= / MI:MVm들tc??eDy8}A DC%@ކ2wimrWqplG);̯B! B-vYe!M{LJRG!B kKqOAڒs&C4IAT*H@\Qt%]vu n'<,7I2=is~m:t6~LL~࿿g"""""""""PPPPPPPPPPPPPPPz7l|sGQ X}!@HnnGQ ncEP!!j\"YJo31>HlD>"0/oGTH P5>¢V{M$7>BQd]wEP }s̸3(BSeWʷxdO˟O"<'9g"< b0"'r^2>BaHc}!@J_{(B ?x-j"}s֦  YpE7ѥFcWx&s\_vjJ#<"}fu~cXM;rn*æmNʝ{"{I]M[eGQl].k"|S:șT޴HTyn눞}[2[k(B")B!EHR!E")B"EHR!EH")B"AR!EHR)B")BP!EHR!(B")B!EHR!E")B"EHR!EH")B"AR!EHR)B")BP!EHR!(B")BCTVoVbuTJ2Y1xZuDx+R5W+€ L`v6{m!k% +ѷ ɪwY[|j:k)B&l xh֫&?L\uP aH5GUWM:}Cv%"x]ZA:Ri!WO 3{ w^6?Y8$Tϋr}q9vxߜsȊ:R 'Ȯp~V^/E&Gވۻ^u^c`"Ϻ/jc;om~xo5—X4:]SHX^qϘ`ȉuev)ʱ>0Gk'Uok=?[YJo37hz*RmPs $ ޫl$I䵕c{SpI8'ތHNvL֑I'IW`a_QV( +" ˃"81x=I]#7/ UEAs^ݕb"="Ҩ݌6ZJZa'2[nn&"̮֑KNȷ&=yɄPO&\Ht]͸w"Κj݌[[W[}%yƢWҝi#y~rkw`coDvb"x3)_D/\#T -"׆HJqkcc"F{OowUVyemu+ǻvV"-ñ8c p:'"TxۑީߺzSIټ:C{eMD\53y7n <. Pwcv_g" u>lO*B o2el;7R"r-B3餵tg7ȭ:BۯICEh ƤŚQN\KI;UpɽYҞ.M.gmP#x'EaS*PHި'ez'̑ z_';o15 Ѯw4(Bܹ+3.gK"eԕ Dj&B&w? ߄[Z)Bћny,qgph_6TVjx6N+ڏhz%:JWfE  ?謹TkfpƱ=G:qeHgqz9{uO /7UƱ*B́7_Ta=9ɯEPV(݋oFPs㟰=jlzs'%;vUv~hj;pOjOWH4w|&ٷ"e|;R]e%6tlPu`p;na]TaZGs5^,+Bۣoxn`KvU^ 庍^d|jvջ8-Bѳ,B>'"8=N*\絩tpJ4XچVib?҅AJK%0P Sڕ܅jNf?b{~ԶI{bng&yY|xrp1R{ލx_ 6b?=>ɈsjĝE$!|܍?VC!G̴b7ƅr뭈Y!B٦:# {[G!|=n]]ʶ:پQK?:ZnD.ܕnyG \5|+{Z*i?k~YX`8D|j4E,Bm^O"91W\^:Pys4gsIbs!\³'Pqiњꅰdؼ_^L*m`vDYޙؙ}YJ~e!u`nmo/_J޶86T6v)!H濹t3ZeLdǽ^~K8kK$Y@ei`#߫dxs_k_r=9hP7#fC&E\=6ԏ'N9mO{~;6 hKQJ½٣j?B,ɏ<؍>_Wwa3;EQp|!L~t*j¾`W'I*Ӎ{_ws[E>f ]&׵w}:~[Byzi|^\s&^_FZ*D >G7IHFfk#(7#F™lFgM|.W9YN!،vя$)n[Ne;Z~Vy$R8n!}t{3xCx;nWM!xn!R`7W|X,Ls\!C ƻޫ/r:Cw 0LrNoa~0ytmeg4d!B83Ns9U#;ѩ^Axӷ3A.p,{[4N:ƒEӎD.Cw d{^D/zaj%eBAEAB8Y}Mct`g"&Bx k+&Й߫-"yv#^*1,Qۇ4Y5z!}5nZ8GמP+IDATFgg@oj9[u“}՛h3a 0t~oVz7&!Wby),f+v3}j7b‘j2#6wJK[Yӏmԇ*CX=?yVe>v¾`$Vfw-kzM֊y#7]{_ޫ ZWm  ᳈fHolyg@d#ϧw׮PE秜CD+=6]b6jU˭t Ս~,wcvctoI~b6=2Ұ.z,\DeQbn\ow2uK*=7g}XKUrp5T)]`{# nyk 0lVݸd/O-~hځ).ߊ~ϨPlz+!,f<*#FƉ֥ٻWdR,%Kdž*fTCrڱП/fvñv:HC8|ܻs^k\yv89Xx3N{b{Qi~]n먵}ƛvso}MZl5T'Ohoom,~ ? iKqًIENDB`metafor/man/figures/crayon2.png0000644000176200001440000027703214441312113016216 0ustar liggesusersPNG  IHDR h) pHYs  zTXtRaw profile type exifxڭi7vc^f-9/E&)[l+Y?/Z˥jzd?tc{}绿jy+>h{?M}ߟ'A~Fv>?TCPa}^o(ƒR'Aߔ!>w~/)+ez?^}~ ?G8H?/B?8Q;/w{gv#W"Z~܆NBe}_HOVu!FCk+^O-Z\Iy 7diNV<%{bY?rݻ`Zb\Qu09}S$$o o R%兹3j+<'>WxPpmo@xva0}TB B  FS Rf1TkG=kZx%֨&QFn, s~Z(RJ-tWjkU 7ZjV[kY=Kޭb՚u3#|~Ό3<ˬ>mEʪlwĮm)N>N?vƥn[o?|o˔>~fw]k?n'E9#c12ޔ :*g2yʕ rvPHa>!~RʜS?2HݿseӅOt-6m;Ues2Cs|0quhǂ%j=ݝ; s[pHFRڮ촺AK59 jg{0Y7w!.>XPt!zn^Om)v})`DD=^'4@ό0`2cw8)16P[ VXaoD]Y̥^TSͺ!3:\[9FձǸwl(G9p:<3qS\Dj|xFլ:{)$BY2Bbn0 0IBȷJ{hXi:ڝG0!&#s*$mPH6 (R[_o⬄A,To,/Qf'xr!8пVf(c[xi_np В NL֘vtd2%srnvU<-pWeVVf%聆KOJ[GҸc#c`mzSI%p6쯕*PN"'ijjL 'Rև3B*bbfw^ߐ_cIzL+3N_ggRE9~gD=_$ (5L|S@ȱ!mTa!z0;&D(~.,Τ Z}V=Q[Wɋ],8tmdn2(=`彍5iڥKk+/"ԍ퀯(Tbc9Sk^iFdM;Gg6O֥zvOk}>FF*zY;h!weHF.( "8 %˕^-Ec`FH#p?=RT(2lQ(gKkA\U+MJ30JRJUQJx6=ی A囩&$xUiP4 8&b 8hA("f` `y7%#E>v j2D42ڛFHUx$!%->iᎰ[Iݦ#QGw#hvZ8s;8!NuQsTA~Ϯs$* )!BBN3Hng8{6qkL^ Fz 4r=Lk=L zݐl!= ]Z;Qάjn(ԉh*>lj/.6p0K%By<k.ڱ"V'mHnw }y )! ue}yoCIf'n0lm Z-aCV_ czr(1a#-NOq7pDO GzƏҲ|~4 QF07!d'3:1v삊%Aj #Eiy)wK2rUXC: ̗'#b-HZF"&@D-KMj<|ҽNҺDJg3fa6Ypz$IȠMY28ZS:iM)pb!ŀ1%U V %DmuRn8yc(?Sp [:5]tyt5LE) H( LiL #F:*:dP HTșTB/_'8  s婱9n #<3, ٴmW6r#4ךaKxlfAj@2䭄t=JJi#,(]mu;, }~t9<"픉3Z^R^yk]07 +гt4S@Co1 1C mi4uH8PNahi~ [SH^ׁMb>J!msE@n??/ǮrW#_kj@9eZ:9c*ьO!e=$J]Ȍ۞Ƭ^iB%[@icdp7d|ij:BT `rY.V@,[p$d@guhE~,.[-Վ2@j D 7 ;hE>ҵ*6 c|ElB 7- ?РA/(*F )܈t.ηb*AdɀbZZb_,S%*H}J^]XhFbQ\p@4 9&/>=zu>L%n/"9ZQiHF :E+28ԥ?I$~E{ 6.%d86Gcj( VB͐a׮]THC%4VbR~!, OS[@1~5mD"r 49TLEߕ[0 :`NoQ!bp Y=tc/*{&Rshceb͑rv0D|$n.̑/B\ϊF,fqsE';cPPCl,Ѩ |[:ڱhU HWln"nk]h(da]奡ïtf2D2`PzjjupBZpoX-'c1Nʈ}wJ׆ߡ{n S~ RwyJa dHy"~7^Xh]%9:ψ`A@EYuR2@5k+$1mrF3E iVDX"l=ݹexܡ :`liw$x5(i k6L4I%wblIيi dj-(PP Ew* ځJ5hAX)Z"z.BI9 $ަospv(v>{}%v>[p4ލ^* ۡ)bm̃olhV5RDB$KȓjG̗*<>}VO2pO RE>Z ;e)Ig 6N㫅٤mfN^`Ň""'@LвLK ]ᶒ@4暧(Rt"2p($fT&M>>eOAe#މ}r03rTc Rsv{K@r+0VWhзG |{F+rvdÈL޴T3C(hh4ЊEc= ȕDI70Hk*^:E5@gG*8@OL*Sy(UߊF rJIooG wg8`hpWf=݃W8җБ[kqxnQ9{Di+:LT8;tŃ>߄_s uAs% >W#WW፞Ӟ2)f wG`7-Qk[-!M-ݓAOde/G~0ZFhW u9$4s OiYy@ϳ1Bo6'ϸ=AՏi(TuQplm1(-ybT'/s+|g=VZ97j_@HḏjdrI+tj[[0|[CɍP٠Η_(} cu0E+a4N*Rn2oX M\-je5}_F>禖%ɠ^_NtGn7}S#(]]X>ME4^-NHH?d@{'Qk:(]kxV!3ipӼFz)`-oNJ>npumuGRC젴U Ր7ߠdY`í޴}Nx93?"+zCuj򼕮@:!}[ZiE5=  Amxh ̴GTidmF۴^&>AB#BBEmU!C=C),{+١.X&nBa@:'p }A{b@$SuБBzM[L8bȄּHuJ=|,ih>a j6-\y=Wc5]A\@:ãiNaʹP@3Tiy$A0⟪cRak4=[n6L Ro%:-QM+:os>CJ.i@;-CTZ8Sv.Cަ(n^D P9p*|n U?m iqXnR3BW["P(.:F(p뇎֓%F jMiI1::ہ]ǼNuzme"D$뉮[pJE%"[`C ц1D9dZL&u]!?OEX:Zj?;, [LYFx'}gћVbQT=19xT+F;"`t鸋{ YFX#|/DH1Qrs%"LHC N@d/j p4J-w:PȸӂZ8gBk,Iԑ@P0tMbvpRC+hë$UB0/_IGe O86qF +:}ߣ H+ Yq}6 Բeed-wie=S/'CB^g]Q|־thګ-OYsCPLTE4ebbb.46_qqqllldddnnn_ceνøuuuhhhccczzzՖ}}}ɡݩfffꘙ)))BoGt8>@gklkkkwz{>>>AFHrss9i/574:< 179EJL摑yMRT;ACGGGZ'''555>DExxxBBBLOPz}~6fa###֔'wXXXV[]|---\abPzQVX999~~~Ꮺ+++\\\cgi]b///hQQQV s?KwlprjnoTTTp?mp;rvwLLL e;;;```HMOꂅtS}Y^_mҴ222hm3嫫lߋTY[@EG曻bΧMDŽ٭uxzs-{{Ń^Y|$3iI;m3W&3?@B!`܅i)Sc _uج*Ԛj_b=&<}̜5/" хiٙ{־<*R_bU4iY0'oX_ ?"mY ;oִan(p2,:F! D$cCeہ?b;Q Klv`z@npP)}=9W$DK4hzgJi(BTպg}IJ)e=Bdm|3CdQ]\N=2&abu\n=tu(])}';s8y!`HK;};HW^GR^sG)%0KdeLKhBdCh2K;5 d':uYv́:ڃ-~F$B7$"wCwΔWFQViZlN?5R^'DMȠ٪0q=(m^ty@v'Hk^!!dB9"_!^0Bt2'H+( /v8% XHVֱ J!A'{EL[ּfP(::ug4[ws|Q"V"n ~H-@7!rV[EnލlA*,LG)4c"yYYzo }'3D$i}wfpz4 nWNy!ZtpzO]>RH\Y,1sRR,Dea'ɞR"bzB4G}ԇ!D3deQ'ɍѨSă 6u>?Dm^:RH\T,%D S mz0]/tb^pLX'jOw%)gj`&}Tt.Ӄ˚taCAG~Bdp 5 LJw}*~%o -]]|`:>z"F,.VQʵNEMp>lз̝LQ~}?W}zYjt nE"xf=υ ڹv1"[1OvP&%|ko:3._ws^WxeDBKjiYs~{&ݚ DNc}P"n "},#*,A/!:d&BȢ_U}چ<+}rS} QRp(OM(>SdQe_QeFƄRI'7v|Bۤ?vYL1u-ieeWKmo( QLZNaۛ(yà }Az)4cE!u#c; &9HBt[C=xWܨ`N g!m>(] nb"D9ѹk.:BTrsiH#nUބ(: "^ i4"ruix"w+wЕu^kcfa7Jz3hZe;| !"LJÞ0R-yq=NMeuJv.-"4WTsC\&;ABdID岆 $^*DNV9}aLD㛂͙"^0BԲ^rs7;8B)׆oymfV) S^(c|,烼q_>LJz0 n; ..[ZJEeMCT.G=$Rn&D N(O*͘BD+]#:jyLmL{)j[Vl_ ѓ{mSO1s72Gz;jQ}ohTqN:RH7!L ^03D*BOu!=><]9A]yN%:]vCM9+˚VvwK1$M]NBԖ;SQ UMH\ѿu,cV]3?%O*-kAשE%wyua;8 QA^֗R}'\s>4/"o3H!{溙ytxe":MZj][|!$4%?-}Ouԭ3!zXuHѿKg!rRM="gXtL]C}P"m.8L,D겉l=W/fHkwԸ>qO2!Wbk;Z^Y!^3=8!t/YX"wg?~;aumo u×=] Q^ɗ}HJ"{j;޵"wFGf؟p!Ng"uvf=x6c국IbA}~ HX Q^Mg0$UIL:U;2ߢ"ZLXjmj[|!wC턅Hu4oh*1~sB$[l#D##D/܅Lu{!/v#+;Nҡl"b?땥ֹ=K!z%n/mR|HKEdjB"-gA QbA1+oEWP_B: QB4 8o+D-5"%w$|Bqk 3D3PeBlOZxc'DX 3D[t̢9 _bܑ30!z޽ˇy~=*jɻd6թM1P_l!u F,O[ Hh݅}γ^=Yy4#< )C"uټmV$o#rVB$u5rX4H7$iB">7k(-Ү30!Z7b&YaDERT%Dr.u9D}lA%oR6{I#!D]c+Dt8rLo0"uټ l;N)xuβXGdqO2!(*_=,`~ 8ҭ"o )Wr࿔XޙȶPR"Ӄ둩ВsevNyMBd,uڛ&"M Q^4 LSh7јϖDṷ4B0BB$;icۓx{\\xv xKM$*W Zl_\;%8,IR/_:B#ɘؒ2MNA>F"QE3G晏Qs?D{>xh1)l)o>hF*Kmz!B.7 C\z+MtƲq\bm+ DBts(SˌE"*m*+$Dޑ8Ը . Z a5N{8ƖA jwXvqBT}TeGWiQ{6|_o# ?cCwhl11zBȥ<.HH2ȼ!Dͅ^W"T!/I{ _u6SOnJ[:l޻ZTwQqEPT.-3f 92SEJ Lod\ۉg Bgr_~[[܆>#!Kz:iMWfBd+w;*f&FJq ѸߚWm;9-uLik5@"YoAx Dp!z%/Pn,{wl x6| C|lzV/RO"0Ni*/?wڨbRU9+O~UE~Ql;NۋOѧ~֔ClFJl91+nI:(.Q ⺬mdZg Bgns\I zgCIխBP{H{YSVHɞiD/GŸdb+{1#]d[8B3 N4; \oB$8W0TIjGD)GEAE{{((.#«t"k4ָ "(!:{!qURv~$!>f4lH:6>[~g̜'f%Ej0*"Ph,hZvYy*a}vlݷ9.B?߲ =GyS)'FDmT31E:BT V;[.y M/~TuC2ȴ#D̏aaGA)[VyZ8Yjqr ;$܁c~<[હA!j QxrOO7!w2ou!L\`kSvY>0dǍ$Yg8Y\%}&p! ͪASrW:"j9K ekaBtp(1<9<i]X=4"/med[ی |nz7 cu`}OW?>`nB0h"'s2ƶ-Ǵ,h҅h%V-!aw0:"% m*<Md[۫ʀ^!DJi:OSީZOsh?{!z:gۍZ[I"G$$-0},JϧB[UGvm] N{?2?zO?ĹK^1ӹi904m'cFCdbG<}>=^v]Jzqap˫f3Ųн%jYҏ>d:zGFFM ~jSLyB c+'f5f$s#f="^k9{ YR!{#Hg GC~ .\w1m幣!Z]!һh.yyt3NOM˞5LW01UvQ a c+(6kB٧(=MO[fW-Oɥ/(s#ݥŜ1ڙӼcG}ӫwo9}n%7nk@w$ k]!*]1l5VP~-g KdY~sT QE3s"(f 7C.~|tdžwXu6`$hN)>XE /ǻr[s^hPp)7K`kcBoMԴ 5 |IN,@ !!f)C(CK iP)`C"6V>}Q1Z_  >Yv⎱E:Z_  >DEOfK.?A !!*zgbS"@"̃ŗ/?Z@! ߂rYP!" `C0D"! (μ}tkqm(M1 (7u*C -vIsðuoGL_Ȳ7&[Z-ݼ#Sl#vՎjE8jh4pPY%Y,w fgԞ bP H :U4-*])iϴgmkKh;Wk\IƓA]]o~.㉦m{< BuܟU#̟AT`<8Sbv,V+B%{V0^鍐 W>u&F۰Sn:ԯfCApS<Y,>|uArU"u:4-.aG:?j{1pVjL0k?EAy=Y4GLTExNh Fg>G]<˝AT`JKllUf|JPnf[Nl4]Q=7ګ69d“:^#5_@nY,}K 0D<Ҵ홪!Mwl?i ^ϩec."x%K"(Oy~uH5g O4R.*C1MKIlw_Ѿ bv5/~|m/BߋI~Sܤ/f: "gD8Mp)J$|1j:Eٳ1w )4i U3ȡm{OLHJAaSqdf=iƽ!dpNArU"E~1$d\p>䁳Mµ /Zmc W#h/$RW^mhڠ'uF9j(H("Nf *P!R$J\ɷUWic0]H'+++u7ƨ>ɣnCNg }z~ Jx@~,-(H("Nf1q5T.*C6:̆t<ۿ{:4E 2? Gpfc7MڛHmE`C|y50D͏R?֖r 1}{TS*Xhh!eqw )w%n5_㮛fmgTzxTRO}"?o ݙNF\NP:ië:J`ڛ! 5*g7؆Qh\@U1RcTt]D%k%@8}l;̴ ́ٞQ@[Ԟ Q4Q:%ZN4D.*C/vCziAҜ1LL`v,aڌg>x\r QUvCR\ i PGgXk:y8  ҙZH w,k+дHZ"}\]9SG!Q{1DA@Y,"P!R0DɄ${,7wLsձRCfL"ĉܩ>Q{0DA@Y%,'"P!bqmkvGB,7QfqP[Hs9jК"^wyd[grT`EnPJYNZ7{Lx.*C@iwe7~?vf^oe\يlߥkiJߣ:!\6Qi VGd[}K&M <P!RkΣ[ =K!]cv#s.h4DRN@%1M7TZMuܟUrzwi0DiOTzJ~=a6x7 Z.5-Ne^rԠ4}7QAbx&֩N  kI{gm2@o߶8Arhl~g1SwiN"ݾڛ k2_M<Ԡ?{řp|]CQ@XR+*jkDvErޑ Z-MT%&͝MJҘƋ 6*CRM4Ihb&=30vٝ>yy~;3;cV*oZjD lcY,۞hAVfȱJk׿??Q̎/ּib}ʵ t)M'Yz:DD2cWXf΅Ep,XǭZKI`:Y5"䱪Mp)ȟn+/l٫٫tz`o巾'am׋=NS]&?7gduz޲A`:GǮ.,uB1X2X'~UcY !r*dxK ;cdx~7>ZKd蕻G{>? !R˺'%?1Kؕ%Nr 1 VqY Iu?Ȫ9%od?սRY}٠R&=:7{uJ; zt?!ʁFd,XjdIu?Ȫ9$ c@:%pmlm}ǂ{9~\3"y  !"$D@BH " !@B$DH >CHo7dDAgrVU6)BњIm 0,[Ͱq e`Zema&ZrD*9nM{װcɰq6_^:fG^>t&fgphtlz|d|hxSQ.}ٖ*uRs¢DȲ"!Juҝ̶$>-HkZ(2"_?H=/vxdrGS4iBTb|uI|Hwi墴G"w#Dzo5(/"VV˅OQ<С/'6!"*R<5?u_ȼ>*'$)K;M1j_?nQ"/x?C$Pu3?%D.G_y})ʺRb穢Sֹ9#|5ohcQ1pهlWDI^Nsӡ{ gdB廈.O )Ƚh4geTJ^g-:S^?i#օLIL.by(ք݈[\1 No"VI$㣎MRY:fQ1Tb23M#6C J'M N&O_4AЎ,"^[`M^оE׸F5DԢԬm\ רv6lxy~m* = ;)HvulUom&M5'"tnzq?h`CyM-#jrbcCm'Yu2-ET_1ʇ.4l 7cdeI37h l6"\5"b2rk`V.(4 $Qa!ևA߅˞>=?ԋtOS_ש@d4{V8k̚KeU]Zl#C}h=j c}m%$߽__@D!CHv_sD-6:/罃*KjK2Vx}[-dڂlelIYm=YޢXws?b=M232ԬZQR>n#HYەrρkY`,,SҪ,eE 3EAkaCi$FU(-Y9T ZgkNՏؑ% IDATJtoZ'^֠zĸ/P=izb?އBel=&B;pz| z(X <Z`%OMGT;V}i:$vfPv_@F-19;ݵp[Mʍ^#3ўߗ_ٟ]HG8uR@ȵ4NSu\nX7'b$Qz"D~DBW L}Z".QDstH<nUB3]!z"Nlg ժ@s6ZvQAȝ\\֔ IFBdPm']][,pw#ӽHF@<jȲ1\jQKciiD[|}uCmsS;+%k.hloRp`-ՌT/,V{OQ[}tD\7j+t.QgA !XqY(J`646{iNhBP;G[,/ jj?K%iY&UP,hSu .J|gʑ0T]D7z}֖LHz8{ff\p!YDVI}|ef z rJpȥl% µ`[نy "tąo2胹ȗbu 8JP~-٩11-"qyưk?]Ez;kFaQ)Vb0QԆ[lMnK7E eIeCBb|W֩4ZEF7Di(z{[b6"L A)۽xDGP ӛb4u!3Efi5=qPXât$"O}晓:2Cw?>y7h=P:ZVr8=dDG~\s@D!֞}҇fyӮ>[l6dQYЮ8 ,%kUF=-TKw  *2FX:883ciQ 0!{$ԕ*prD -pqH_ zD\͕}J8mI>Sbtl3ԁG&afuHJvf롡y)왾,Y QtuK6 P jI" -hd<+ JH֗GZT@T+%5Rb E"Ziwmn  7ȕ' JzDY@@5L/T_1 |o @t1H 9\\?.H`!_ ™zD\Ӊ OW@XHVnn3uؗj3O|dN&(oo,}26ڱ\=?y1hxIQXM&۩  ɽ< : wUbr{HHm&ίw:Q4z Mh"D:88[ls 8q. @4 pU(AZ"xD|-gQ 5Wk$4:xD4Ӫ*?QQoa&jTyQǓT8};t Ewo#;SS3 0Q2k*Q(D1}'ZѽPk0'DX8pwlYY&e_J3E? ¤shD8GmO u)  8xBr;B@TxDV]gL7- s=P4gnwQGf~xz`n}"?}hqs&"9-:2^D=Xބ@N yƊ xC"ۿ7 B#~/sm?`iDa^ڏ4P@$ X@Bx׏b!A"zD\B͝ԡ2c$?πHkY5_f쩳Gr{ 4;f{Ќn[fٿDy\@D'l׳\pcȧ.߃[f Ţ:6MK"mT8Iᛃ~-^@KPe[uD(!=P\"` 9\\?,$(@6SoKTNpm2w@t0UlEYlhB M`_MHǛ aȞҭñѐ<B" 36h B( "y! \*Y_unUʶMbwW׹ܾ_nC}AĶ-qm:EXuXXˋz5;UBŌuYl>XAtitFJ *DS|̊aQKW lDwVUMADZ``53 ~"5-1uV8+ 7 2kH{8r5B_~f$ʱK}ҚeČQ j= CZugCX= s%3Sgm~ћp~3!N "Z뉴G #D~{lV)COk*ՇcU<l10tg7'/r͉/8fV9QiIH 4D|QEb!^zՏ*˲d'E8 NXY?s[8:?^K";!f%e.<Ó'蘚 "#tg7fCDf-iEn8_VЧs [Ž<M% ]Z& ~G!M>VwV?PDF[,vG1_0 곶YAdNt|HIK-Dڣ++yU>]7o^p;FG4lv~wL81MgUdob; :6G٦ "G=*=h?*sYt'ZHy[zy0T}]&oAg}uf;yh]"qV~CDY`(Ivy#"RΘaYLMu鷔YAdP0>o!BqőZ\Q {H{ r9>wfxCs/z[Id1W粔ֹE>=f[|X[fϔzrJG|!eyaga*~*Kz_Wo3~I*j AsADG!GQ ^_]R15DDKIH D{ C2=㌣@*;=(hGHٜKf*_RgʾfJ"Lߔʎi̶|z&^PH׊>C^ID/̘ r֣w9](`6=.)Wep&1Ty)?Xx+PqOA$-Wu`ițLw;й \-#C{Z]v%(=QLc٦<~+WZLԼ;Rb8 Tq\ѽFO4~& ֊4O4V{AOdϑ{gPu:o0۝Z6|5jZ[b&l53L.ldLbn X2-W佳y^u r֣ yGT](9 ss3WI'Ζv^ٵa]m&] Ǝ#aey ?Xdm@`e\BI-7|Ftl Hn^`~)nc@Ѫڵsh(2x2g Sgr 䆹ʫD_GfIve+3+P! #nw~WC#{Pp&.6ξSM!a`;ɣ-]*jm(RwLEk_n ~XWmn^C[}zkz1zUD}1喖 s "YpӦ k233pb.ei3p"M 0̪HbFBLt $+,h >< ]'d|8JOunUXZzTyv/Ž7xiP~V -qDºqL*/X~_G"@9ٕODU#xTFP[—NropE92j]<Z].;(^#ԇSPZ^ҽi$uSf.HD`lJߚ< G |Thm9hF)>AQeh^gr0".9)"ACӣٶ J\ ~x aءUAj;5#_  TvWIt]1< „ D|P/0um+763+ٹwDD\rV.2D#Nπj32\:@ ~n=Ʈo%>?~5@$ʚ5yfʔ7C=WǮ YTc&EA{,۷LG0ρK l3D=T τOSvKR{"|BO_/Aһ)>@$ ßkkBЌ*o!GBgD\rT2DwFpSv2D)={07ȷ>gZ Gxm͒\O-L|lYuh]m3u(pK#UTTŢ8w>ʓvѣqY͡c'Vm/'Y, Z %mWWLp̀`IYR+TӲSK@Dд4̮ibM.O.c5|$wqgcJ=c,`!dm`Ax-N jp@ؑV?Y]yj  @I% -AD38sj[)@dSmU@w1!mL3,L ntSaF['h.FI䖜&)6iJx$i :N٣KzvL@DZA?ܣ5M3EXmVC IDATfSb`!mfm,@D,Q!%jr4!e:tSjgׅDIy뼝o:j yWmK|"@d_Zp_]^^jwkp!{X9r Ԁ{T_KAikjLÝ0gr 47LuE䄴"tje^T`" \<%V{Pgo]]C%5h4.|ynkSk|+/ЅSрf6c?V 7a<\ׅXbF4YCZWv(u «jAJmSg`drPc_"P Çx.QoS)tyd:ҰAaq=?Ȋ\q!jx҉HX-I*Ć"b#tTl!,껁*lA].{ Y L+T9v|%Hme5q[:"< І <,4mD"ʪ+Xx*6ڜ.?vVxB{!vTaڨFXC\v2]v ?9=4gJ jX)1ԅIJ<Ï\M\3=Av= 3L=}'n@e7Щxz"Ԩw~ؼvjQۼ90j!JV_m]h ]D4،m~$D6EP3nhs7Z&F 鞣CPv2\Qn&-0no4r~7@TjCy=GޘU}򂲉}ؚj!/0A'Y _?@e&h͂> Q j5@ m jwb0٣af8;mH7kq @&& , h 1ɫO*Kaҡ[M(;m XptV|;m y6s9"JH9?E<~"[7$=Qw뚟?^@ā"<u :i{/o8"4%X]|A5O"$DvڜU c6zjC!@X&{8G,T!hfOwO*.o6 eЈar<ڧN+oСDQL(j~b_v}H\ā.mUg@$>ym',7]JZtkQKCT}>5@TI~7jOI9"<'1 Hj~H'biGJnl$* ـb4]՝jCZ3 b * / yNw_ŏًϿGEHanO DED\8Ҕ4ujM<y@ D Sh ƭ:ML"@dY?QQ[%ƲӓJ b >g'ǘ!lnm>֔1t^?!x"p̛3gV#.3ƙg+ha*".&ku7Wy i *Ęv}Ua:i3+!esx5 } eDN3 "|q@D%ƲIօ<ღnf)j3 b h&mo73/YCt}ـSP~Tǁgiz_豵9D\v9 ,uKQ5ye" TR/1jM]H7aDV3 8@D%ƲNׅ:wTIhX ,1Tf%]fqm(oBt#G®Gj گ|";;V3N"A(;xXabM" ddjsDvy@OstVp@.L={V LqhSA|դ_?oo,@՟D_ CtYOB o]ñ8hO9q@T)`JHuD"Sf:*8|HzO[gBH0IьL\Q(3^N.1xN`@J 0$kqBY] AY !,>$``aA@=S>éutUWx]UuZDc^'tT)^Q@K ]2D9!Az,D9'!\vDnq:n@>ãz?z< 03B$QlxSܭt̨,W|8%ADӆƾ v9f^|_lVy~Xj!~ @2d1%lbcCOf5Oe }+o1'6 |A#&^hT 2]Q[n. ͡ M=DV;Dœ÷ڢwL]8HN9^lȓzl "RIf^UON|jW_B& +N,WLӌqpʒ_&tf8rBDsta6B=;NwH2vϷ@`5_Œ#xe!|mb Qi69D4班N0x(;R:IffPO).,j@k.5=Cf-Mט`7M6kO~Gn4mOW6C o[U\q=Iw7i͞-L~CCK;-Lgىi'btpǓN#jlųncjQ]ghQ[K };D=EPy?u.\!͡ ⧁ 7 Dœ9xQB?if藶8#n2E.b/ 5:>xkϳSLwȸwrs\Yfp1[2D2쥾Ft|oM {okT`H3m.=ID0p}ԒH,&:#5\ V%rۃ ZS973,p "nkuYH ?u9ǔ҂(u!hRѣ_;Rn%"pjpTd@fȪ7_j:ɣBo7gkAW;5 ;'#9 xR׊=NCCʩlidyv F)Й+x "1<A!OD\x 9D4.NrN:ܜc!yA󺐹 ҷ b7X6ϢvunLG?Gck&uL±i J^7}b5_TV=T;5Vy75JwĴee8V{7/pZo@)pp %VV{ՕIrAa9D4L(D͹d;.d!.f.l" 90jhJs۳ zlATƝ dҕ _^ڝ3 S7*}` kNY_H8_Q~I3'TE0 ,X-p$XaKy#^.dOFp@?Y&xr.UvvT]P> ыa~s/m|=OYrz6ޡlE~ [n :YONҕZJD5؉ &QQD W?d'[AvF5%2U^c6 g,ODjZuGeHˢ'ZALT` 4׮DMy'x'{n7RAȿ5I"nh^ he&/,2sn6^*gμLx㟩}`C&? L  ywZkZWC+a0{~ yl'MuWtDO[v:1Xn &e= U!V bڞxGSߞ"lźC#N/}բ(Wq<%ouo=uSvkv9?LNycYa~Y("r`)WBONv75ˊdup`fig*3[NI;!.Rkls p@@ $eYd_r?(C[OXX! .\Nrկ%FDR\2JPjl[Q|# RDR;"rצ"v 3催;oGTe_@Q< (%$g U2ՃvżdteA꟨< z騈 e%{QPo(ҋk7QB5hbWǃ?Gi/_C8:0NybHHAͻd VD?m2`4DWvܽ3h2%rx-^/l,DE<*쁡EIZ?[t!D3yTRhOaP{ U2;p,@tqR8*0Rh7sT `*J<l2V3R S=QLTÓgɗv!@Ԥ@zʜZMjh,.Qځ(e:xVxE5R $URGC~93\p3x=t`r$RnOG^Oͻl1)N2`4ՇLuBʨ>fDl* .1zVSʹsfo?%朸OAg і*DLs)vb ʼnVIDC !Vת=*mJ$?d.rY_qݐlp)T,4.]"x\ebC5ɃKcHS J^p}=aid|XXc#!t2s)h{77 \۷:q Ja X'ZKFpe4C9d1e3AY^Cۅ7-C7{;?0XNz"g Qf35qw .׻>F@i]/PO}r4 :pYy9 RlQ38fl9T07Ңfy4ZGd3>J#NLN9 V_VU,LvQ¡Ean?"4nPk  (/ʆඣoDI +9y"J :7(x$L TDlqd{HW!,9%!n.Q{ I[N1̓!^-Wm=?'zސC'{{#!M9|MQ/Q Ƃ* ZDB2b]nB7)7NBܜYʳWfT"mdY`B%ȣRD.v`/(XEJ~ .2-hj5x'Nkk9 > ~Gzxb*iQm&ƴnm=?N' jϣ&z{>`sʑ:Tv4LvQ£#t IDAT)H5ouX% ^Z¤Z- HHF{8u,5m^9-oGVI~&q7M}\QE 7U0_kmoP!N!zaUԑ2]d( WvTU+Dz"*iQf!Bn莩53nztYڦ(2{>t*!nfEh ?͡ࣄr~ݮD[Q a0ŕMߧDB2 {{TfCtlDy RD` +={nO~< DsyS1.s`" " i3oZ8\HDY.>lnF V@G{TIB϶8l&3sKN%$`)qne%\L[I>~Qϕ4DscaARѮջ@ls/{#DrwoDg䟌Yv /=q՚ Yɔ?"zӡ1w@\{RkwmQ5[s&ߋg22l_{~O6*lDE= 3*!mw\vQ¥> t~6㧞G*KBkhDdx=!wX p]3lD9+<ȣBdKLɬB` t#;-f .Dw#(a DA&#3Bad,Ȃ<4Ouܪ{h^4]uO{ֽ`=v3e "tFp7Ui#6aam;*3›) Z*M)52#b9Ns=ʶm(zwNå]nʑodzؖ*Ÿ՟ș{-H"z|d&#;SPIUM[G s1IܧQ ȅjx7~C?2w%3S4nmysƔW^` D-.";voa(Fc\7_`KSfÕtlARPJ b+Նu(#=ٻO6d8sݓ|1)p+tK9 =>2u)S_4>?erSD2:*Іg,aGf zB? [ RE2bnjvduy/hx)p:.,!&ȩv*K"C8QOd#1ٰh}"gr@#!+! #sG s &eȆD2fJxrOLΜ_YN9]gٞs}'O)+oz?3%:!\2sgًtYviͰp; pTfl(ymf3Ӆ V+fB-pS G s "}{:CViI([~Z垎*v!Aejj̽}2+=߸rh6 DlSLmfs( iݑaoK2n2]-`zߑs|'u%JB~I6o|e.ҤNCʪ~vfΩ)7TX7Vj-?]^AD4OksA`9sNC({y7Ѻ4L,Һ?_u؏}3\9[ʕK//QSߒ qBDd|J`4q{ J[ Rު}+bcdH2bQM8+eWԦc~ ]I'ܩjiqR|WkHyNC誖S({0tUrNKcv+׳bgri)-!>_":z|$&%;S'<;%1vRԮ)'xdbMoF0#lvA~2f(rXzGY-[V*q0[-3CWܞ@[Bm&.+KrVcQ--gm!=8-={/͍9TT{xi)KZ ˗NKi 6 FW񑨛OG$F?ޡd27U#EKj\F?$lb֕e-τ "-Tɻ۟~sa;CwÞȭA-6wD "_%* <]>J֙+sN|֡vMk NXoh$6 ZZ0W Aٌsp{ئ[ռcIT[Zߡ8M6TK}3:ǒs!ܖR_oy_sA$' f \PD|I|kV@ bZG6O{_!]  7egXR[#PB c 2 M-ۯ&v 9: v7/Udcd -Ãck~rB"ifwT 6[o9Ri薲Պ䦏)4| n^ؕqf|&%;S">?c b;SvlWw27|{5w^?H^|S"RL}lG?xAEi5LY*WݥrԝBJtF;G:(Qo)2z<>P !}:~8DW$g/ x\hnZ@`p}eNj6+#ր\jPBh % uh*J*~,Ӽn.w `=cd4C&Bc6fKLƘ;zհh ,&n _Z(~g^S7Tm2=< b'@Ű6zJ& 5Q5 P1dnBDc=7Lb "(T+͓U{cˀwI24`*Æ;+ʘ5]z:Xp(d}EiFM]%`Dj~k0ᥡT@,䒪9s9Ɵ?E$?~?OwC!T/$U=ѨQ۰`Z(qUboL5vy][ޱoDZ-9rp.2D#9uiգji^4$UwuQ$[ F'?dd&dt3'Ā# 7.(jD"1a}F\ATD8," Cȃa p.NtwuOUwltk9sWNUa1(/>#Oџ!"đUi0?4R@B.e ޟ9*FB$rVuv]1] !ʒ(Vߥ]<e/il,՗_[*&jS@j`x_3uwv7\IHB6Pb! ғ5w5R%0`Us;%KfS5!JW]0uV!QYdGN4$Z`WӉ_>6쑔&1Dq6ֲR?%l\34D}$`p[ݬDs.5X qѤƣ% AN<]o"Sqyi`uf{?zpLٝ'/pJ"!1Z,#g HY,g] tIwh]+Lj=f1wZ l X]msYR`XѤ6|@@  ivʍJNdU`.=SaXo0{ v0՚{DN\WHiQ"&BQ[{L#jAxz[,gU?u|Uy;w.!"ĭ &Q18ã5 v] n QnRڅ9~ddeg}uӦ sz8!R]ƹbalgߚKo2%ֺw՚6:q-ǤJ(܉*n;\"&l5b SiA-ٞ/WnQfVFג DBh$* YFZ)YrLA57,vƗO,V5r5]xhVīP=ғ-0'Tpd]WS"[S]5bn{]Pln=A t⚪@;psMXG@['S`1ɣJؼywlU\#wf^>}kGA!D'4* pnivK$\"D&h-3@,Y,9OA7k3&^iuA1DĐ yY %="Al#{QM͖l4g,ժ67!g0c=FcOYD\Wl+bv]SVͮ c^"]skO;FHBTk=Mf5lqsK@8hZũU=6۳|K7O.$@!" Db3D kE\kTm=RKT>Ym,H{@R%IHGx7CV?2E{9A'f\.jk]@c· 1HjsewwRyc$! 14L\ *S`_@NJȦ༏>Y~, B$D#! f-9Q4wԸ=$%Da(c!G)873٬!˜$AJ}?{նar8h̨6@\c[0"dBRǃtƉp`\|$ġ78%P!zH^>߽֞?{={!u}Z~8SLML |}"nnl.մ=,cs 'TVAlyUkDzD,O!~jFOmsF>&ϫv^y|/S^LHų)Mgڶ_ YHDXw5,[NO*`\Gۡ'yDG QpO^~"OPx+ !#Gm3!ޖ*0Y>AP/Xm'yͺ5e]t xҎz*iU0di Adn7o"& 󪝞2#|ݱULIq^'Ĉ IDAT:G~^BTDƆl܊3zCt-#ٌRiCD " NhF8-&9׏~ UBu.tGm r.230/ڬsx&_5Y+X"s&<#*VZUwgySݵziV=Q@D-R\hs {ٽr&Ct$ڪ9sb2];&Ý G4yS%zUL tݍ2[SEv/ K%XO1ckͽը"ki Adn7QϨ0zUE ;}̆TCv QnFW+j8guGY ?jٸ9Mp~];Z7 A 2Z8]5oYBp1v^;zPWPLX"s&#BR* h6OxF萐b1گ^D&JE;zE^UI!劗+00Ԍ!Icn8xV( vP :Bj4tPxXehQ/Mdvk8^Wi+Adj7Ѣ\ʁWe俒~ӛO5qw.gGUz_7<@D3{4*:xDQU6Ns&+j 8摘X@t6Yd-U,  V3ž ]tvWC,3ed Ij]F5j_6:Vnn z;LUx++^,׈'^O"(p$ȴ{  ILfu)GtL+*D'MBz8ay< V 8h1E2D4_x`@skxnADeN̬c?tgf:չ3(!? W()*I xuDd^^eUdP7_c;"%+um~U}^_g=#u>E_K". 7S}ѽZO IVs 8DG?yS/|}I/VustG@#VZugІ w딝4`;}`G.0:|}“x/$ Ӊ&IWD>Msֱ])ɡKݖ~?lRk1׊tg ,_c`5}Bé9 Q'c)f:Sf=hwwwl|mޏ eޓ.a'OǾ]~\477<5.zlD8Dq & YQR7yDIܧDMq]&ݕ;.6zpl9TU (|yC> AlfV $c]ֵDjB$uW?^f6cS1,Wc2f{d~E+[[vs`SO+L$WYzU`UI)bT}ꭜ6}ՅWG";.|QUNpT'NM3 g8'"W#2E-.hQy'7l~7j1+t W r;pjs#VZUH*KYUcVnc扙Sx+^Ez>q^'UzE/7kƥ!pHqrHɕ#3WmbHst'Գr(d'4PqmrueS+=M-__Oϝ:^ |epGou9;\ ;Wk8-mVO$5(:#ʌT\`q4[HAtqA.E{ՅdXP$db~^>ռ{[&Ag&So)ګ2vR$s*pL/@idWO{D)zlLT[VfH vK^P Bc:Y3 դJkjL-όmuH+ҫĻRUKw]vS%hᓧ8Lw! NW >]ٝofKyV;NgWk~hw5lȓ/Xal \m; Fu#3=$qM"nlg`o>#ƅ9;`0)wNK%Ql6V+@,z21$\1m/K` .,,Ps~r6{u2tva\jdve#[A`>sD:v( 㣦dz=0~Y=[w=zټM.^Dz۟oٳ?{{HG@{|/vpR;()[g[LJ, r;Od>iiS;ȎZ/JG3R/7 #MkeHLuqĉ OPh ! Up/YpII ,$C%D>)anꮞyqTOSw@f:/ZgKY^>.DUٕZ5[&͍Ji-Tz4㼎,Qn ל:f- $.ÈM }[g@O* z~~dPo/A  BjR>znU!4gZfHw8݇=Bd'D{N n Yƒ fL="O2FYYP_c P,'6q_́xO˲#D.|69PՅz5jo@( `չJ079s@cw0rDШsCVvGO{D6a@~*MJ, D 482j^MxGK X#C\Ҝmr&1Ӝ"O2NXQJ#K1Lhm`sƧ=7eyZ"A ͰYT+C/y˞ڝ5L~@1Ӝ"O2Aqj*5@_G dQ?A$<S$?B5&p`byI="j۲<(QѦ/eN86 crPe`7o sWQ_fI[JBJFwfzRfj5Rj@;z*jM5XsP%tu&l-)*o 9wfXDz7G AH}ڑ}vLAc]њy<5yDֺIc4f82Av_x|mid|?@^fztuA$Q 1+#:D] [LwZְOȆ#ڄrQC?"q(70'mDW7$mTV-ӱFH}ڑ7 b4A+dbwbațYTvqK7ME9([زS+4r.5--_gInyD61VeEHP"H v:;fk );pvS@ #+oxx}Y!6Jصh[Y2CGU@WB1ڻ l\Ztw ~=hzs=fx<+fp)y43ۼ!]ހ֕z)2]5yDǫ̧VeT$,!hx`+( M|.AY~fY!Y^@j<ڊN~\}\S?1*\@ O/XZð^/V?b"eLM%KЏ3o7ӇЖ^ br9 ֋IBÕk6|Nmc7L"c8 w-4*oN(A4ͬɗ$0 ɖ- rkDuB~edZ? b9;8[/VA4-DkŒ܋U#.ei@//E?FE:ĵ+,;׫jN\'z u'xDՖ=޿QJțkoj&uFTvQc QJyRhڜcDpiDi~@jsnmsds^8* :86_Y\D!9Bfa}P_4v)}K7[4_l3DhsMJf d E!֚-tƵc0j>/KD`;{&HPwMM6`.ʪɗ$mc+Fű\3d$^Z5t㒷dD6W_Y>elş|$D rԍ &cg!޶Hܮo]F*D6憟^d~KYc ʰ01 bs1 fk=@ڱM M0}=N6 ."@zAĬɗ$-fM| rwkO€DN_dyh# b:●vtZq =["A֎N(rs~mF }L if.9P QZ%A[-_ȖOڱM =a>i{@acKAޔS&3k%u'BnGDr]Ñ?(3@Ǘe!Y-JWkx4oꇋa*H@TEf#x*-"V5*(`"H@Vi~ J`^H;#4 Sk2Dl2DtL \4ۀQi>doq2W@hBnF(y8MT6K3k%u}u8+@( ٱjurIKD<' ms|DiU[Y{|_<A:b%Y֣i#9/qDzr]~uk(A fh%WȁL@z@ڱM(rq>1)|<FXu xM(=ȍU7Id[pl\eJV.b$2D~kl_pgmoK`E7S+| 2pDW MLlLJ!vU 9l@$D4FMY 13L8h^s!국{7֤WjUIXYhDmR:Dw%7yjD?s%rA'N6%9 صڮi=B@)AduDrQPo=RaZcV=PWb4۸mhm%oFvVg%}V5Q~ޮY ^kDދcYV[9OB/Tke@i= M[Z_\9[ husP"'E ·LHAoqAk lgPy*-|F; \5EyDa9^y@$>7LE*d~QbZDyXn{gݫ@$b3OXڊ0Db4wluAfjBrUPwuQPwˌα76%s+7PʺjDM`J8ꍞVR<)1.t|L-XRh 栲1$05qq4 >jqo!kEi&/݌M'۝8ǺlBloBcNOeDS[WuZDyV>~-/ Rksk(We+vQG ^_fw[Iϋ;ĴOC\_@77C4O?IӕaWjVt6=NxC2"E=Lf;2R"y; :+PxH_w_7D) ~R@(~۝>Hmu||ݛޙCH:P# wC#4FMZ̩b;NI-U5OyQBI}˚pԬ&Jx'{ 7 eӌ,ףXn+tn<C1Xb= sՉf<NY W0|A7~+!XZh'H "?^yiķ [AɡFa с)0?D_QlvHTba _MG S ho"a~6!DbCmk-Ft8QZm!mB$OB`*Dma՟LS&>9Ѕhi[+Q#q#?I|ew(H ܒ3 DC":;F~=WH !!joO9'\Muw4]myB1&޴?9tsS~;Mb#y~HU##[2Ëzv,DϪ˓<.DHe! #oF޴iɦeSԷ Qi~l"% "t^Y3׵ӊ1}eݜyNɡ|ػJ+YzJnX,Y{\zy+=ЃOCRCw lT4-L!)s#˂(sn%%k'E3oXo #t!X>?3|! ^^V gR=[vݠnCVcihhټHB5-!R4o%}G*ϜH ̜zZi*%k\tS';*ȏ0ߍr\Y_tLexal-%,!77S)ċU B ~# Q}&'!JXA "fN|uYgrݺWy%V7U}F; BfR71;[P_\R<%< .yLuB$# ED2':,3HNfyX7d[V@h݆VvؘSZ{{/N{Vf 0e&8S@cEldJ;xL !)Ŭg"MxTH׍ݬMjt.3Њnhl{^K"Q̉0 QOi]wOhs7OCJ6WJ9 ?H-X'"6i#"%DgzrrV. cϔfz˦{B+a+ +?lzCRJE }|V_R;..:зyw!Ҍj? $Rad 92zD:$[͏0f4z8T "%D bΗ;!DtO:eO!>r/DO2m%6*:yR.@b)DV"fN ]? gSv\M覬i$7?=@H]F._䠄-yxMxR0cVKOƷԮ&k'RxHH(s}Yd3á&DRVx< QB%']>Ħ bBDGLB^pDBD[n!ܳCiԮ``H(s}Yd-uɈۡ"v嘋x< =T Q"z5eNasu>U,%q~bXuţ=gԮңm;!ZXY{sXB$T9>,H2ŏ=I,)Be뽂@hӶ[^ KF/d7zvaH \ בdB?B$T9>,H2ߝiiߡz^lS<^H-OU9BQmaBR/|7@vatNUMLF*Ȝt,2wDzqZj]fۡm9U(q!m BQ|̐> CLkIAW=7BM.]oF_?R;^u-!8 fo̝SN툯[&h!zWbYBQC9z=4a+[f%"B4BsG*!T֌Gv,H3G2]t3/_/]#"yϴ/m! JjcZbYo%DYD2-]HsFjWp %Ӄ7ӅtXT؋zXB] \!=U;b!rΜHQzz@)IDL@p+$#.ݦl]<5"K {zG/Rۂ㴦BDpzYV,?;2D*ΜlAd;Jv$ ;:]2Ǫ^Ƴ bB4I9Z:~̻J{?Yݷhc;c2o!b3LS|Gj[piOo]iTCMMXj7^8s}DYdFR ^98۸To!rG,D!D_gj+-@(ūJ@+m;φ +ֵKfT+;xN{yddb{3#F>C{~턔&>7Ӝ( Q*ۼ z׭Pz/7YB$T9>,H2'WN7قs;8Ie~A Bj3Kp`\*7-<3 #IЄyLm[H2 !pМB ͒J$&2(܌,13LTdP0>x"7 e r]twUWMuʹ;'s~Suu\;,!ǬBO/zc49a Q[/r.q-D=^[u!T9A 7 1)>.~q&O㓔{ӓG Dp(.IM~f Q+nnoYs+T4rzn̜uik׉g&Dܞ2Ǐg/'"{tu'O Dp̄(=ZewQ?Pqn6Igs'/.'DՕa ~ y͉oc·xz*7FN>O)*ޯ#~(.mH.;lP'! SPoj21Y9y3CWuKCBnt[^_Kk~]yCS_Wy[!D O1+\"^OřĈ9}Kυ#"N =zj52H{?N~w_rwԅ'_zt=8h88j=ϼΜq㩡Ï&'}> 8=fN#9s啽eo1J:J1ܞZ +ӿ?x 6.gr?)>AB1 ?<%PF!M)7vD3w!D! ΚBZ5Y%_=c6ff POg.aBviu߃ "?z QK4폎ބ!D! )"v+o­&D"_QOz{q:jB6@Pn>2:S5WC "}qG7[U?qezq\ P#SQ@n Wµ0}r_!>C+!SչTrqba;|ےsiHRI1-~n*{r@,,s6Z46M6t8\ vCZw}*+ Nmnj~LS# JCEgY wBTɓFnL RԏF|N3lh%QeDFΒ(ioV}ɞhp}j_xWyޞʹc_龽j%͚7}p3nS$bZce@s&-6]3qBD> }Frd*%%)s.c cvbDkj:etk"fe@m~(5ckSeA`;Ʊ@W!̱ng5g׉m8D*&3Fu Dq"?#6P!Pj 6"Qĸ1p&U1%]b۔U8nNQʲ1dd&2m}lJWЊs Qc-D*Ǩf@3#ֳ_hD)"'D)V=>hkIFڍ&s2Y"QMLٶ{ƞ6 rv):C:-kk!R?F )%`PwLʞB4lKDBiF\GJfbk0`o[=4me' !<.3q̱"cTHf"gn""2%NyU|%rx80mP`I,[n!Zc֨芡QVfhUmC;"ŹCEզB/Fz!})ϯFBTÏQ9#mjģT#BԞC.tPNiIf/(ӘU}-D=6mxJmWt6@mbbU4$i$v'*񅈍@aGBFmFI|NH%?3F/9#D[F%YU)ޣB<"c(#DFwtЭxMLV7ԶdHgL}Sz: QVF*FuCrE:'؈)eN%?3]1QE !Z:0GDaoAb&dMj1V(V>a! cdez%k @Jң~&yw B] DL7zr&DzpLiӱs(k@T2~lPc)#"!J_R6oDzQushr%e< mȮGjR ?oe̺y1*BdxcR%[~jwlĺʮbB~lPc U"!!kι\Beٖ fH[!j7wX6>цhjz1JB=܈;h .iٷ1%DnoD2~lP,d猈u;H{l(xq_h3gȳ\h5SCCC)b+mS23OmX[ ~ܘBdwhVyݥMU;R[ԅHcTHf"̗M2xB"PغkiRTX[Gr6.%x URwR1Bd%3T'ۮI7ᙃ"cTe*K[-*!ejVUgNȪLed׬C!CEmfq@M|ތ'DL9TMҦc#G;c{rF*yBv`yWvRc-\NǖJ#7ҍ@dxEyjk?R (D%a9j1tBJ3DlPǻ~Qu 9:uw0,/ VrEشo!bbThR,qӎ~g 3Nt#"cTHd@wj hyjn!!fQtfNK?m۳/{ƕq\ !A:)nh ]6dz%bS"/K7!VHLYV=\W`ࠋai Š\t 9PVoFHo7O#{|?D?͛yJ7o7WvH DeLk1+n>.#[ 17wLZ.DOy6yC4e8u<1c$;}Y7ݦ^>r /pP2.VX] ϾVeĒbT~{W[nL@Զ6&gi"ڧѤ4uǛZhI 2i2&[<[ZM\ib82EuqDb}տ*u^!/0ɶ~-ZGvMmSӿ[9R.ik˞ϸ D#4S^m[Q݊"nTPiqĉm媡(Qx1g]Cl@hnq+MGԿbO׫z|ABՕkju|meWL 9m9=&/m/&,8˶4QZDm6%wmI0+%*͎,u鎒Ix1ߑ.7@+NVQdT\V8Vf~23z;H<կ6ĻͦwO%ktJ-yR2֥3i2&[;' Dvш"<$3N}QdS ե=_),'}Mj6 8Wbr J DsOŠI(X{kiY|9j#D&Ӣuk4P5}5oi|HՍՔoht_ݢ͌v7K\ Q!2,W{z<*lIx(ώwx18 QeZh :~ |bρX>VYsM"sy˚dYe-HEFHEr'~B>.="ɴa\՟DL7=(oY@8쇞?h;隹JV$Dyp̉eVgWYU6[b'hbbB+@8֓i:B {t@@ X\~i# " D@ jw~?8< ׺g~_znL+zOnuLW[{]qۏIgԮGҲS "5g玦<%~ݘ Ѓ/^T+0}ǿs>| D@co:@?/]o>vUN_N=|cQgǴrԅnĻ強\2k?&ek>8#mi D" B٭4Qϻ a ^]݋wyoj腯 }/yiۏ. Dzй"͚@y|ʷZj@y]'|ݽx\6==#M>׾'@//wf D@?k[?@/U+F>_ q x\6mG>_"߿}9mys9:}ku )KEjo Du/|vLf%㋑@gD'2a> ( ,t„ "$weMM$/ g\nַvUUuSݦgp0Lur*^G.Θe2OT>@x^uH$QCAʜ{0Mٷ9t1|aMV7xtDnԂ~:u%)}}`kUry586xGi8 2)^ 'K_##~'yfm6 KoZS?#Ǻ"}|eD"^e|6pYs']ч~QLGD*zjuyW,~{6Sѫ= J]x)i;6; 4羣݌5ށlCQNˉ}7MHH`z  ~ cj}`H-[sMV fcvZ$Dmp6s ђxn]yQ)F@D"H D6~ۦ7)ޛnXDP? `0Py 4*ށmF!Jx*\=A. N@l+ %DG2h "HY"'vV<>zf}` n\Ȣ3S`:se=J5ܹD`?^,FD8W*:ߠ?zԃl4 tO5bx1]nQ hJm8Ꭽ_ Q量b '=D"8 _ixǗ,_EGůqJFkluOy frӢAʢdɱ%= zA B|`;}e~\7yI0tx;~Q@ʥJ(!-|gS2ayWg|1Q h;umMށ +Y䤨p8 H$iƁ Xn.rQ>~9_f^3p8 U5n@f B|AW}j| zB~$Wt;نy'Q lCڀ9@ujö@ܳ~)~y׿oXݓH$ҌQ.F 6Q&+@`R *s=3tÅ Dp?9qi"tSx> hY%TZb$ n~pE2x.ˁX3|D1#D"<KRWz5 3~_hS~ Dp?Y1n@3E#95W`?(:,Y .I@6m&i ϨdUy[RZ}D"H3 DuU ;uVfjJVqDs++ O)o|A./ݍ$ >GjJ~=K7;IH6myq+''kz r6FP| D"F *N[ԯW"yɂ.LDF5*wXp"ΣDi#Xt:7+g|P$ Dmpض|Z~2D"F )CK [ODi2' N DH?čD@Ian6 >AGOgz8 N@;m7-/9  j;yV!D"B *s``@cY?JYH@쉅.!.\hj}P>f Ouĝ(UUCMV[@ن)h.Y 3 hQD"^!4p!p4˗*`3;yKf QVDњ,U3D;Qt,Yض^_Ҽ@hɌD"^%9ƽ}ѳV糑{x=]Q/k szpѲs\"W>k GM;qG$Dmpض?Dif&H$,1p䕠/Thx!E@3lfOK:j]^#>>&A]N(@Z[i0m'$) m 㡜K@D"HD<:>/yiiw: 1䊝?"Lpd0>@R,>F"T:YQCq6v l[@?)H$Q-Lv/gxf&~NՕXRd-ND@W T01o@z䗗Q}B"6 l=!ֳ%!H$35-0_r l:nA׬s>\/Te4 uovmw"6 h=1`XǮɄN,f}_tD"<XP9\:RW粇 v4wSQݏ"-3vf`yd.WzDQHOv6zmw"6 hb>X?EwIqoh}Kf]Ӑ)yD"89R}{VMjW%'w(\~|*<6?[3OΎcJ +&v߱ˡ*<_$U*u+}|f <|}ǭ߷Z N| Zr|wY*ptvmC@(ӻ|_t{iIvxE#DQ JgBHPu/{]بY^V{7"e+L`Pyn$;P GԗТ3ud N| 9(ۆlQw^eD2mi "HY"cLͅx@dlzdL Dw"66-zz#JжFG$4@d_jrRN \T9>J:JNy.F. DK.E@stˣ8ͲlLr/',';m`?w$w7Cui)ޑ+8^ iG'R% ~%!I@&EB2c !,BAc#HoPʨpqdf?ͮ+'~kw5ogG3]z]M?vH]yl!mIؖ QwCwt!$DAyov)_Ov>>3_w_ȶ/^x"n|'遏CՁs;9~w턯%W)S^Y÷;~>ՀNdb .V{xiz_e?|i"DG.IG!toP1N< @{>yu% D }?G'I?w@@Ҽҟ*xKrBoP1OZ ^>|"" Ds@)K9TMUUӎ}Z;C(jwk5R Qb$?=MT|] b~łnZyY[}2L3K{:W6L#P!졵 ߵvYllيZseij+=mO*MSVEUU)S+Gn+5!*4JsP&ʑx( mG!f/DIۜ[ҶBt(eC^:}U sKiҽ'ԪOJꈲ.OUhŪ3HjiB4ՕD9+Yx!Xoz ј5Q.!F9>]P̈ Ԫou"#M.,4AB-n=ȤVpJ.QŠeYzww[kVkqџ=$T!=Ce#%R)dT euUY"T'L8ط8Pj\as"x>B6r-vrd nwa5lM!dHAK2;F!MuNɧI9mQph-UVVG(XGtk]z & 3^kZJeYzrn=};~; 6pErG b/;LV< IDAT#"XMWg Q?lB^PRXxqA0^I%`WgR!t$m=ʬuU㥔٤(щTDЦbE]pXi_"̿L#"XY?YB MQV{ƢNUx#(VZe,upⴽu9X{t-1!ePv${r#t-v=o#CBrYCxPJ2Q@`] I:D&]&W &^j>w T#?U!bs3J,ECrkOOxRG5;lܶ50/Pj,úxŎD8himl)duW}moI,_&ge-/Dǔ#;"D%jīӍ:Rb#f>[2\?_:^4y2|hQ0Kj=^;O^C"+}1w5!x9yBH%kХuD{gbouci*A Qס:Tpu]*۽|oFݮTfI Q?B(G D.ܳ̾3u!R.FQkx!~e17[I[nuGFVG6\K}tVmiwxf %zBoi,$87E27~bu"E DQf{%D,mH sd4!G`$t1uRcEL;V.ZB43#52R첾Er"rB51O !b[5-AbC4|Bԓ2{ 'l=w#nBAlNm *:a8و ь>ᓅ(06{Z Onܽ4ً\& +ӞeV蔍̴]eB8^+G Gii>$弴Ǟ4!Wzj4ȑpSi ,y)Ow'BPΙ7tv뺫~>/qwvo|O$UT}FJ]IntY-sx;rG (Xk(\t?(*QRyn6v k@TS1Y:7d5ԲE hf_# DC=31B[/v_7pt!RxWzj,LIQ>l%|pSKwVV;d?KwH|3/ѷ%ٺ3fDCCE ls7ٕX$%:Z::5_MkX ϠHYKg}j"4@g,ڣV*dqkaw5=Hp~%(;+o# ud’A'”>paÒ*dO@T(2 ԗ7WP̵FYcϣȥٱ~ۧ-@&#/VZTu,KOW_O5i /m,>uhkDddʎŒh0rv`(75Ω|.:vWv6[a[ZW"homz+sÝ7^W: /r\x:cIg}j"4Z$Gѥ\SݍJSr{pA>;#3U> 7Oņ"[\L\{ M33\2]7 ĮK̹:Uڕ!&F6ԲE h]#@t=7;&2"}9Ӕ1w#wtc& DګΒX1ty.V#m=7rն$-gcl%S݄'(|Ζn~ծ=-#0=3j@ jF%XX~٧-@aatۺ[4{^0֬^=o ]rfՍ7JR@zle~iuv|sWج">nYXڥac>lGI?ؼrgA]Z "8X&#39ޛITmTF `'o= nkkLf)ڝy %ZКI~Ja*|pa} 7Ts%U8"'2<1p<5x81<+_ ~⨫@6 @ H I<ΞmH ""gnS=(o@U떓;~ތ lmЬLgvBS䑺j& D̄|y?DFWƏ;x j=kT@ѫo Dۗ-G"8(דvQ @R=;U,s@t>{>[@/ D*@!e͏i@;lɮ6 +aDfnO6a z2Lў@u@!y6i?Q&ɉulث_x鲁h_'.|w3=~g٧^xO~lwGIMt}_"?ñ@4~ῙgU'o+ѱ;Mg7{Wgcy5-s?EISXiَ_tf>(w`›Ѣ@"O=?2X ˩Aw/={tU8K0Ws * D叓ik@yx0>-C Gɳ@Η\9CmCx*Lv7d|m33|g:DƉ%) A4>+O&t|F|_Zh6⻐{?4Ӧ :\hcb1HG p 2O0D Z$ET妗#zt3(|w3A:ڌ_@Ԟ z#,VDBkcDABbݴfT-d.U8_>fW_턁G1>aCx\*d'}9̖[mkcIfی3lўQqSDK˦@^rfh*>_v¡̚A^K4;x5kA30:/&{F gm}vQqM khj'< \r@ʹ3 :y=kkZfcF'T5pAlO|RHXe$KBKB$h}6sgjWmef7`RNQq3Bat>\bDU2[- zTh!Ycqj5׹ j6 QeafQO)y\.:8goD?# AV8<#h=DDziQL=se}DG3z`vFmF"iUo^bf YfKDɟ NdiZf :Qo* V?KGo~0#St zy0t!ɝhyxh0idnT@n(UD#ý7& ɏhKi+NA@+F11b;,MDջׇvDe\̆W^zuVFD-x+=|0*j>Nmȿ6 /H (81A?ՉJunK*w<8h|WAzm+ۏ3[?JGDw0m`K% ?AL/GsSw v*AKm;N]5FdoexAIIb+ "O]mȃ)gjqѻ?DAlFMoWW&fv˵tjo876l7Nh.;_@ёv2A,oD-P<=ޟ[zd}'sʍ%+olCgVov噡 N7hIg/__~鑠ÚK3=S~S-\xivd+3#Dm         pc3AAAAA(g|Uލ`,_SfQ|j߾^:՟Gӽ{، ʡ*/_4?{'(~vdD#@omZ-qȩ_>9A? 'AԞ;n}nݟbr'+{\Q{~"DB?-OarDm#@ޛP٫q'A.}ooBeA@A$@ڽ= {HA$hOW}'u?|/Lfժ'~]יс ͏Gf�>n٦l]wfhV$oGn;Go2|޿dp_s{u LR mtv[9&{*魷ͩVNAlaJɡ K.Iȇ@Q#$dd Fmf4f͌lY==޼yo&4AqSԩ-9!S ̌';\9A˴u̥U>Ў ?i7I>m|߽I'$2+8rYsat{rY+x ݶ=Wx8yvDi<7iNo Y .c{jn4嘸}@tpbO%.6qODTn? JHb.$\r;(r!@dU=N ]_skھ=xd6ftUOjZۿ'mG'$2QE*^w=RYS@tdOa?VOVX7`"@$B%OջC'51 |茝ʧq KET ?MT4&z?n95̃m4u DBD*Z.4d$@O(*M̢#*N$yUA='*OsYBσ y`LD紦QO52 @Ή:Ʀs*oga @tb~3t|MyYJg2BKk2[}Fp 2}41 @hŶ1gmPYOkҰ17;-J_luR֑RaDc>aER*S-7#*x^b0.Ǿ),OL+ayL.׆Fy@̓dZV[l7j~H;ƼݹQٻ5ػ[7$n9=uiرp"@$F pWd mGhGK/{(BA"eOPu彛?7'^^Ν;{|||'ڻ\ϛyʵKMsA+_]D[|y4T;W0k_OM?-Z|Rnn+Ճo]~lmId÷[_6or)S^.6o81;g_:j-$h<4:m{zSD<25{I٘y8z~ѽx<ƻ${+]ѕ}s[^"[ߎ=6U?!6o\<rυ;1޾K%_l x1MvF@Qi4ƸWpчw}05{#q{&ecV ֏ϬVqZo/:٭ 6HFh-_}/޵{qҴBB*'TTATDHtQUUPZUX wE,誊t%Ui>{df\᳁3vz<:lժj ;ui` }""gj:iq} %6(4 t#w @tP9%(N7̥I1u[ &M+] ^M)s{ow崼9CJ"M{h 3|pVx ?1֧U1 u< ͷVrI. at;7 l޼ 6J* 4H@4w>sش396}m. iD&;`>o*0o<0}úm *I=]}Q'ADL{&-&9>eӘ%mpIűJ"MIFTzh\U Pĸ:k-dƨ;h48Y'+Bb_NCxШX|J!yu"=_B/"o| I,w@M\[aS$%y *[t߬).@^@Hq{eaaڒ0j;ל1fxéWmfjw3'w~` #!MW1a)#O>tt'̖TXX5Z(^6UJRX"M( z9wH36u>_͹)q'N;0jMDCUugk7L D.Cl,|'zE%Bp`“T`qFƺBbM|ˣoQMՐ-XF62e(:^ƏVm+4`GNG K>n9牍:Kr4DYtjЮŔxN$t /?XtػVq@3ؗ ucV硷A?oՑa_$BUStÈXXnbD ߪ`>*aS5$%y *;Vi@&Uv]m{r(s(@ sI3W~3R#-lE^kcyI>pNsڪ}k-POtBbbr ofBpp“ 5b ~ [E=n jM-X& (@nM9@d?;؀[ [Y]8,i+D L#d:k/7H3|T¦JHJPRwҀHD$ rvqfqYDNcI *s@9׃@R~c=B;yj͉TE;  ɓmD?8 LIV'g, 3՞:QFl ߤt;G%l$oA%u* 4i@D" rbGFyȩw9C)E$8Õ I@O`OJ࠱yV3Ju.~aGeLZZr|+jDnP_Y]-сr R4 Ҥ 0shoDϟ6 *%a"hJG}u!A6 N!6A[w+N8*a@& \ <޸<@o>ݣ^MvɞHmv"1  I:VD;O AA42@&#.PQp [dm3+@J4-ni@I0 'Ta(Ũ%$w+TIhHW}'tu3<7gޛ`)O0 j?-8JRkF^xh@a1t0@J4vu@R4 ҤQśPO"'6jr7;'Υ3q $U"SLY웃$eYqn|4DCg""o  H'NQMcQ7o%eM"M `VvNGԾX8(C^bXrJ.S( *IV` \r0Qpq+-ցO4neSR4 Ҥ p< ʡqH>DN=2 \ω2D'rAa5yݵu#9ǖA(_Y~(5o;~tg^ɽBb 578T@TӜH[ s>}TlӸ}ś?IyzӀHD:{D[I *y?'"Bb%/<Qr@"2jv~WbV Yl3tUnӫ>Ԑgha)x@s~|ThӘ}͛IbDn c\ڳq5j}Tq~<0+W8 2Z0}<'*&Mk8p8};6•xPlXhBQJ(DC[8 %PjH+q KTqȞHH/5z%/東vlgbX'333c{C/*MAM+5 黶j3C||1+f9(2OgQI792CJcA4?t ޥ@M{~6:(~Q6cx6hP̷K=i)߬2 "y-Ke :+eR'A{Z[yƅxGO_h|Z'%@.>%f ZÉTUrpj@3,9(:ݣfM9sJ υz`M{~6:(~Q6cx6輿K|gD)WEMN^VX*~7Ngl=gG!nr/flb9(u_dXF6 3{?rכ!__9?ՃG6:rS{XA "fA"D@ D A" @?x=FD@@ D A"DgtaewtX"yaʥp&Ax2vV6#*ih(U׈;)lAHߟYW攚fsI1Fǻ:FRse$+^2?XZ;WKSQ?/S]~;84tE /Wio9t_`R-Eny${A4ZOǦrxF8tiAn@MMUXf9X,Ժ>БvN&%QL'7nc{͌/-uCpSV9fk'ErI>.x֪)esLC cO9t@|<>ޭA񺍮+u|I?v6Ђ D{ӭb:lD4;D֦kvAdz4OyV c8ςȃ>*>q y|F;D-veAn> SZEb_YW rmMւh 7Tm:uY~՝6,ۿ_ѹ0&a;!muIުLooEz_R4?bu;cJ9x,FGO1gmTlt. y7f"LKwZAT讓EꝒhD_0lf,sLvE{z=_XMsbQc8TVNz FV*IˆBUAH:;h5r XϹbt18ڨ̴<nr[Pf]f+Z,gocBIDATx`DG 1.>?g,mBp!edt9f DkQok'9 -7z$eI~^7V&c9Лw}7c#7;*=z;*Һl NCJ9x,FO0g~ 99\r{ B?Y0|_h7%vI3I̊wC/sbtgGZ?C:J{[y4*ZߜwqYoٝiJ{⻞Mz k$-{bDQsǾ.ť}F'G|s CwiDɁin-(+D91]ي_]J[ӴtQ|ػSo uHpG-2Fh]xhe\2ԥ?IsQ"\qOtqORx ;07ѷ͆ۀǶj1k R@Jg/EHVF:)z2lo/^20tm=׆;?71BM`;}{MFS^mv)Or e>}Ӵ]6%fS *Z\ g#^;Fr DҖ32 Vuy _k}e]qi}~YX&w ޶ţw_^Wγ=tnRԟ|Ó(Қj~}F DX@$"kӟSD[/)K[@2.|#77WSMj>Sbh_nDZA)%wh^_=\om齁-Ri[m[?3[t\9EYP㿟hQ>m4d3|[u;&r"ui)D8f-g,h9&zhȅ;.[Z1%Hr 7iÌt;Pyޞ듔D´O4Gg$H:79][6ўOg R@r&-9geZܻ܇9pA[Cz/@bF w6IY5 >A]D@@t$p-"k ^yԥ-i z!.ٯwC^!>~CVگK;Zo@TP?lj9;EX'~ zOloY. aY@.mv/S ::ҁ#f􃭟zeވ|$y<$쌢_i]=iBM/iv}?픲`(_$-=kpOwtqmQ=奧M@Ԗ%3@.mV<pR>eQwJAYo 5wv&Cfuߊ.ͥ ί(ښ&M&]UgMNPL DK-U ǝsXf.8T|f.g;f:bAܶl멩Oi#vO rqzsgbЈGWoNFlj9I E['~ޚEQA?ܣaDڭ8\˞!T;smǼ粙e NҪ{z&/zժ-0я`˘]l7/ V0ZS۷|ݜlhdSAjSZIt+. RFK%w|{b=5g|]Glj9I E\;~EQos9S@Dbiw1N`r^V6Έ4=3SWG5R+7怓ۧ/-sMݬ ^G?fw2w"=)bZs~ ר>sִ5^>Qh2x;Z{D㹟"`@{`C?ʧpp~L;t,mzt,vϻy3c{>2ށhOuȳ}כoRTڪєryi5^-3?s$rߓD )DqԔ@,2$tu#v&S:ϰ 772ayJ]_̎5V-$5z zw=Rxlz"m]|כnY]kiilj9I$E\jJ B"c}zK]8уo˞}oqifydUPv_|.2YA : *VԾ~)Vm6iah\*u߰%Ҧ)c?w4qD@ @" @"D @ Dٻĝ8$倒0rx0ыDċ<!H & ,G+x}i0:m+XFh""fXw{J7y/$Z]54YnpVY?z>敕;󝝎՟Stg(5]-htMTS}{ 2fk;‘Q;j-I~ZY>X-ƙ~S]U%o!MBv]s~rb4ܒm(G^gqkG+Zw{'>H33 "Rubj:q Ⱦ %*"OR6C$ob5胄ȧs B=QhnRYs#cfG£$ Hc؞HՉ{sj6 OcaQqz'LH"{0S+V;T]>;oG[he섨}aϩoۀQ/37J?PҚ8ldKD{){,ۿ^ɲϾ稊G^gakZa[m;A/o=;*"UU'|)sۀˋ)VyOJ={%\1OzTuT74>]",j$ۋ>l,N2}HwWh[T*:q ȺW: ?IB4>3&Tu"ɵ߾ Sδj۬B税G^G^rz+Naߢj- Ld!cU/mTS]'׷_! q-{U2g{,k`jϣ%Q΂F[z'>Bb"ފO=R{Nud\wؼ){qTʛs` iRw?1kl>n[z)o huݸcs8!vf/KÜacz ǁDem孙3V(G^gAkֱ]a[Mew,Dzif,V'=Nm2N74JVX͕ʡqg^ roBF֬p3-jd }Qm}h6j0gkISsQ(ӯ,0l+4{'>H5aGluRc)gۀk,fV]7~$DEwgbv۽4%+{<*μP5*CJ˸?:Aeq{ >L{^Ms 6Z8'DVi<_I'cțU뭃CbUwg6,{DQrD9Yba[e;AjA#㩒uG=Nmd$D" (u'KDMn~tg~e{}q+{wAD :;5IuӽoKgg^O,8ᱞ+i*SwC ///s*ΦvrX?GY<:KcVoN}r'QHIr+sG;ׂ#$D"﹚v7yG'DbW3^G)*껹yi~a|`H{=WM#]䵓>y$NI,њa{z'>H7R1TMFP\=DFۄH,sכDBTI7!JC] /o=[馰'k<>m)TmSf;Y5EÙY۰HI K9WoS1sҾ;խї'h)$DWηꇮrb˝P[;}_Z_cxVM^q baqYN`Mtl#Hk٩)ȽIJ" QΘLNА5!YcW&/̌zvHv[`qYN`M ꍋȄS{MknV6db]ΦXe` Pha6 ԥv^|kRU9k9!WT}'mf[nv✃Dj[ItD@70ҿ,p=+AAtY+xiyo \nIke}'mf[nv✃Dm $WףѨTv [HA2rHjDҊ9rwR<8]YEjImz/Xu2i6cqET_[zs&,;Ikf'9Teu $wk#7R " uUWFSҮեЂh޶DOkYdh> kφ݋43_*i*g*/ZQk|egn7gGӇEӚUcʃ_r?ۄe'iͶ92#5V[Z1ovGnDxꡊݔd7giZÏЂhB !vvj>r:Wud_Of{vlNs /R[ыb]ѽݑ)pVzeQtmO.(j){ :;\E3lgrٶ:绳^{| ~J_45Hڗx!;ÍHkV1w;2#ϊRuc{#0x+J#R^>8!f%pD< ,,^felƐcb.g,\nSs^JVq3,> 86#{.-KȤUb H0Ȩ}IENDB`metafor/man/figures/selmodel-preston-prec.png0000644000176200001440000012641714465413203021074 0ustar liggesusersPNG  IHDRz}$PLTEmmm\\\SkaO("fff///DDDwww UlSNNNKKK&痗򇇇z/ue]tXp[[[bbP666lcy7n]"""@@@iX+pyi~jjj5w=~߇222HHH0RRREeS+V쏏,,,___~pM'''tƹkՄ醗耒뒢pppFbbbfί؛ᏸ?|WWWȦ_ꍜ왧Myj:::ܛ麟힬栾s뵥囻[7|||۱,;ݹNŞQoDڡXsqԮN؈Ne>]]lX߬z욖`sk=˃YZ~+Pv[p&ey^ۥ(?OzDSS IDATx_LSYXkM۴ yaSFR h&G! 4fc\}^4qW$ ACt4'fcp yZ_|ŧI6{m--ʴO{WOw9IuiD}e @ߺDߊ^ ID :qA@tD@t@tD@t :D|eI ];!ߋ@tD@t#è?7^.'虤yҍd| DOѿORU!:!z!z5Z"!:I! #ٿՋFHDO o-z3hZE!:WڔWO_TL DO]Z!2;iGm4LUUVwM!yUћun]kdP*qlT b>|2~lҢ^2X" P+Cx!:D Z=Ct,{!}7W35V3&:bP;6o!}}md]{PGj^;zީ!H[-C!ƋI=jݺ~*:"#3ߠOQC)[nw\bjm=i4$a̢+Ue77vߔA=vw1=k zLfu9>e&}:SV̢2k3p&/vԈ^+`"sr!D_]2oW> ӱA[$醑+[ZlӈNu('S["ޟ[blAylH N_]^-nA'{A̍K@z:׵rئ]}}ZOtifglI/z#lYKu ,vv[_Z}/+j.GtdkVs:j~ǻyr:N[#|ct#M໩BX>mPݙ7\[J' Mz{Ws)1)j}Jҟ8oQT/vO 6AP_*NS:B>JKvnDќ1?i&m)ECXHmE[-/2XCU#Lrmasԡ{ @.VWdcI4ɥD6;;\ۿJT{.nA)ax2Z'ȉ\׌e1;ey&. ]ThXO"{ [pxP]]1M.u\&LSP+ڔ2)=$ꝵCG{𢣺fJ>sԈ^V3ԋ}w9HDOkJdRnC]Q^)0o3EtWnݒJiilT]e/}K|f?gZT]СDڢ_b]5V U]3)gh?UbV2 !l>?U&}8>2F-ss<!QՀ*6a[l8(Zё9cgx\< S9qʏ#0,%EMĸjPZ &ՕںJDn½lɥ3!z8o{)ӜӯxrM{^lNQcꝱaMj@(DlQ>괁)c7`ͺa}x˲ewSJti9vK{bXj$1ۭLbv:ѩQ1Iܘ~D 2>e wy{PWE?F--q̅ɹS);1.ZN9ʟ1uȑOWT\n!]&Gp]7I }lNϯH~l3~zD6io̦qѩs\CRDt%Bc+E\cN C(0> ƖN_u nOYm\z~ 9*Wi"k7:X_*PBd2 zt=>GToV[aބ]lnO}":.@[st"Unْ(lD] K8?뫞R`[#[&{4>| :DOج=KK/~\@hr|Π66a/Ӟ}A ; vF6hlb15/1`ElS^[P"\i]QixPH *~闪뻙]3'nfio65B ǽͺCarwk~0cfRډcۅ#xAO%|L܏˸{nvD/Ai6#{@%^lq#&nc9YO8\Wm6l gh2) f{f?5kR2 (D{?ḧY)ICzSgǞ.JMjDm%ur}FYz@os f(I"̇%gqt B+l iˉͱK=eR6翊,-wg"mũ:tz1k9AO .? _o 'm,J]ʼT:e$n9 ]K:n14N|}{e~62k5L^OEqt.j]%N!d&dr^# <07@dd .{\ZaXAi>}c.$0ŗKEJB&ILwF!_ߐ՞1}x˛`ɛ-[fe61vǵ|6nc ]))!C} !( !_ty,!*˖g[<UٜL1MDҫ̗t=Spucݬ/I [? 85(5gѕM?#}~G+LO1Y}#x[{"GGz#G-1xj ̩6*؅{F({"U tAO\.o%Dm;.ɱEßm2|P2>Fo,$#f=q=˦ٍ,[ޟ8dWvx>u m6 Z/s?&YG֣?[+ZmIĉWȩ/|t "@ AO &XB|F 7Ղu\+:@'滝I}N(InO- zcoܼw}s?j>_=^HasiEKgog߅tX(`IeKXx(mj'[ r:n 8Y.Բ%,\LE 9K$:n (`#,[Bc{^G-nTAt`Jr6nX-lfۛhm;kG Ų%<00|Ϫѓ-40HV%Xl0ՒFp LjtH:a-QdU1s"F 97/NoY̊m:G&XɲfեzdVܞ7[z>eu00T~J.{'CKF;!s{'EmzdK4g4 w.W>.%jSvJ&EKsB$ "vvL v/!q>K ̦?_3:ۢ955ޭ{rRl](儼ᅗmd+@)A=6Y^~#qgӺ>iCVLՉm=uIЃ N2'Q@)!{p~2 z2z7sSO+fq,I'&j)mCɩ]^˺R@}~hx>C1_/ =]Ӑ}O&Ŵ2lft26"k?tRTlT$W۸-RFd=ص8@jG]Ɏ%}bcuEZ++=3|DCJ؛Aμ)W+zܠ7j>IihtqWdw,@y@R \V+F=p$]Kd#b/ҩaKGlf)qǯtA'n&#N9x6GWHiT(ivB!7;G%g0Doqsn~ ,7Z׌^JpG}5@ԋa5ij&zH ߉>ig: zHݹ6?yAfoA|gnH%d;Fr_CJF;^iyN$ %xAWe>M#2n0e;N1S@tr B]6O HJ@O듮=@-= )j>GĞujtC&+m}~ޓ RyW#薁#;?Jѓ 'ށ'3rۺIm[܃a>-[,eQJ.E] ՓgWZ¡wGQ_9СO&.ޙkZklb\)QLL젮k:~ٽ=>KN2n%ƦIXS-P쨠WttLNcφW|~ꂀVx_oZF'랻q/D)_M@A|E1FNL-r1)Ш9Fo)ҜU^]]۽3ȼ4n??г,Ôt?Oa!k0+:7{tu5.^"/Q*Ues$=AW.n'ÚdW5 r.9\ pbzTgm혺%[r2 LV29\xc%1m#ݎ{t ?K$SJ8\أPU{,2b\GU#f;UAJDU[*Jiٹx{T& ;}.Jp31MmJeyCsm]]CM$7>y[4S4/ԋW tq8)?wƵP}kY#p{]m sл ^9趁 I(аuRyHex.0ө'_)uAstv05`֌M9rwI'I Og~A'j:a:Ns`">d3>xF zAm Eq\|ZyfQt%t[A۪2r2;5+@3 **㒃@Z驗+TdɠtI?֗n'?㿫-cegee3RA\r:CW`]&.9oao3_ᄁ/,'=&A _OBحHi.IөzIftk'C!٫K=LJF~RT 9rma{1Y)Mtf[[lex;h\׃u4:a:.9^"_ Z9K9+KzuJNu\` :P!pnEq_Ar|Y, ସT zwE;j\,q m- 5uHSMod?Y',˪ z;jU\\t{ Ԩ@nU][Kj4S>#t, EN`6˩zir@ Uq/z?KGgӣTbS6{Q&5=*z.Q_W%$%9Aoʡ{f8-f>lʲV,9c/B]D,WݧH?^|5)R%E]6M5.kbrG8үW7J?n/i D, }\~)p~}ݐ\8W G㞛2С厫azΙB"6 7s-n+訽W;}Kv>_r(m[Kqm]|ơJb3Э#a͈=B,i!gKw![pGߪQ8s[·c)L}Õ1pb'3J9,A(U~#mp5J8RM49 A7Ag G>ld. 9~JXnkKwn,.t8jVh<.N%]fׯ:Nkr>G7Agڣ?mj\ժX'55T8SU!o1~Wa.z+.Aq(4?Nȃ \?=!q'D\ WO 'زݝ%j[thu"KhAi =\K9AGqTZ>PoiF߷Cz==Ȣ-z 򩋲JlA(to5鷹x$t6n>!w-ʆ=&-'W]|T-h//kowA>#s,TL,sL[ퟪ}H"gSҷĖS <xSj{U{3}+!>b?cL 9k0-49@=88xbuvΚYUhGd r8 Xy?6cY[Frv'힫̜s{0tm\u!C ;u?:q9N/w exң Nry>#\`{A*7M?{ŕٞs[,"qQ0j@QWkEED jԘ1*J4&,F >X&Vmgӯn2soTi?nsk~}S{+C_&k8b bydR荲M4]68IAwOf=体ݮVf)t zY8KR9lZś~f<VIM#E٦ :WoG&j ngۭjZr3~kKj}5NA-)tkfE&}1UwnR)*]19c j{rǪ pRNVpZ| :="{Mù@O.'h8,KB/ c&+.fbRm_%t z$ׁ+ vݹvOŤ@ϣg|G~RHi" :=|[ LU5%k\T'\B3'Pǧ&1/a3lup5F(lla+Ak_Zwfx}=wjtx=v>u圾޳V+de'8gG_ഴ.VTik b-h !ƾ)6lGAd._PwwVF^I` Tz=Jrpjq@$~ 7t5s^N _ R3ѳufq-aSlӚ5! 8*n tg|/eR(F_)sE>qr tȓh3Qn"oA 0-a 5:/|-Y-mhM?zU.U6g٧2[E( nAB{%E|{立 ;C6xg${s<}S)CsSPƽV5uM>]lJCsv.^V#݁Fpoaϫٙ kۘ~c64| V9#>7]Ok3C\'u;MJ1%>!Й蹩QMnR:xz ze*6T`0uxbNi]O7hLrF>2NRve$˦겄@GώPa :Qk:#0ܦqDZvy)ꀒ/CwzskukJ|AS=Aj?vO,YsĹm} 1U}pXz4޴ ђ\M,6Fd*21JAW@ 6տ) A `zs+x =W@}]yqyكq{{1۫ݻuN5jFgwMǑϳ{ vAo 8aHw_2Es2)FMu O,u@VH=e}#c@j4q 5CRx lJdK WJ^w^i]r1hWtYaq#SX|eaӢ0q7AN ^H> '3@gL ns {;/z~n4w^LO [/sT]𧮠kJ*MuV72i&3|Zqs 9 u2wsN88^D/>[DAg.K[W- l6w]SZI4sxnd3<"iδO K|22ЇGGKp ! Q &-M0ﰉ~z 먺zXtҺ AS}2R|0k__N%%q?\([N Go|Ag^F`* b[b0uJ*MDnWXįgX̵X&*9x܋(W"Y6QADu6^ u Qq>rx:^S$' \Z.&wϼ%٣?5׌Vc{WzvuUEKUS Ni]Oijs'7Bx׼F%Ѭ`G`FУ }/E-9;nѬ-;n;Sò4c :q/ yŧRY_mmt\c.E}eNt1y V%||v8ǟ^SD0Iz!Nt{SoInZKme7_9z]q#}ܼo6=ruẌJmd҅Z^v^,I=2_Z]r22a-E''QG=19>ScE߆oVeq;>6{Z|Q gA͙"b)]L'e2|B$ Vs,^ʱxR.EXͦSc]ٻVed`ۢa3ɎbBoptI-t #\d/&gWWB&=D*OA {CfȆY66ƭYRoR)F[~#;z.0JvQlM {b;t zl..`@%klbwh7ѢOW>+Э\aB /G!3`<+p8FZ-b3R5+U)QKaN)ve$b֙cTLNHA@Ud zTAr-Cf Ul.WGR,5n0fR-[i ,PaYX6&ө_ϑSУ 2dP6X]D辸m0m)+dLj(+z@(o~/3ЧHDI䌁>(pP-J!K〉>PHT]q ?Rlcu\,|llvD}LY_Lk`T˛cɠ'޹Eqeqj>▏0a@@G|%&@PBY듸(htWͪDhkg4UnO~"}{rϗiz@IRTRT=[~nWOAѰ n;ZI6z?]]ǪzJ(bV>9#v BDn>.#c[]y(`6*n]w)~:\)E,l>2M%embzρ=e`ߴ㪲-!sn%ۻ 11m/.Iq)^UK%ߗU9ZyPQ{9=:֬>Feq C}Ύ9za\ⷺYRCUġuBAF<V颳>rZ):8=6lw٧S );qկ NjvﶼEZ])nvQy?|dxrO.x #I}O}k n}~x$N)>O]F]i4v!KťF]/\^AtշM@ .Ͻ尬R'0Q]ȩпIFT0Zy~A}# 9Y"! EJp>_Ykfc}wn!(F[~=Kn*ycv:{˟a( ^t^myG.( P7W t}L'G -T4KȐ6Ss= SLz?xUhctFg9l@?jOrLJi( {um?8ׂUo=WTǚRm!WB-Zpz=VMh+Jy-PJGKVO7h GHV_tz[f5V?LBF!;$At~ފR>?]L[b&⨾ӝl9@ր({OOc9. RZO" tz@?.*P^a*s&FBN41A8A砇 teFskC-ԟ9*6XJB\*s:2g- RlsA Hs (W}$G8_?lSArBVW) _SlO'_`-\/ma[`Mf߲pun .:%'~Hm6.U!+L($}OX7`w_;,A |+= ~m.c 2M+`DieT11)grE] E{h}0Y.;E Z@AgC9E^~sn9PG=/Mks7~w;XZ]fls/S)Y>l.XLzڸ3bv˥t94hkfH#_AS$J QaTV֡Ijkg%XetDtr2 }?Az2Lҽ)3lQnSvL-fe$Q}RnyLO[5 }6LГLhd[Keg~\K3C9ieUGe΅ ݉:$R:-,("z|?dG%~ Qd٢ l;S:7hv/!Ijιs#t4tXV?E(Q0tO/]J)ϋtG]"R.Y"ts/}~@RԑF c BVg#߮[6۰KPF*t2 `Uyb&k 6Ht)7;s-+ZH?-⠛ tӭS)ؠtK>)]o4h7a d|a!tkf~$;彂R:2AlҰ#E?Ag:+Q鹖`te+;6 N;$-qlNtS~qNϵ 4]t{ScMT1Z7G녱tnYi@ZJ-|1Tsr[+^/H䠛(l+(zg쿚8~5̠ Y&D )RB"nEuRP7QDYjE۪/[(z\m.Ȫ9ݳع3dBBn&y"9d~|qAi$u̜A#0>[-%Emf8:{A-h@ZnjWv-JCue&[E8葳Ŧ<i4u->Ez XJO]o) {\5 ٭MGUрNZ|O<)z\S__YbXTv\pfiȀ>(TCA9Lx@?ۧH'Y FMg>r 荂6+ÊUc?37e}8"H브H/wۓbHY ZjwtKVxNmhl0S6=ra8A `c "$ t= RJʯ"w'[/iޢU@ic]j,,@S;JbKTУD (A3;5dʷH:N,HHFwybzé:Kma&"LvKGd^jxV˵N^ڤމ #N uM1IcGlDdQ@Uzp{E^fz iG7du=K"DfxH.b4ʅ )=;alYqjӄ3DzN]-`6^{7_OU>|i'ΙqkSk ǒHgX+[M'c"H@}(Oc2iHBΞ-^Szoqycm0!$ҿahH|Bn k]< H`[78NO럹[ _1E7˪ES?q#ϖ1ЃV%α P*,{Ɗה~'X}VΫN@ ]盐ND: ]CL \h]=g/[@Нu-3NEYW?}J$~򭬊6\& яn=ZlS2d,u|Jye+#_t%=@!5L @6 BÏg-َ{@JA!btt*ar{M6LWѽpLjqvĠ(:]u:$s, u/43DJ+A?&Gtٱ`hfqtǖjej>i18 rE3$-b ;n=KÇ:[(83{4spC4 :8y:-=@o9=ُKӌ[C xt5>7ct@'qK5m,Ō)zgD>4Vu#:bE"'@=6,3>ЩH_ԲN8i{JOh?p{7sKN{m6 HUptj[,њ,ádId,%AoKgd|S 4QJ7aw4k Qej[ŝ0Y&;!M.KCC)@E%ic߇LIA2f.k#k^ycw @)0Z Z5--cFҙF .|:%eފYt$=n2o˞n:*hQt>ˡ[ht&b+BSn.L+̨ gb+RS\z^ )w[h⠛ : 3 =GRqE w]eslA7tf܃ao(YLyDA7 tfz+46G$ڱscʵQt@g]aFF_=V DIza"90 oA:t" 8Ee:..l)HßaO⠛: 3@a"n4yaKOFxh5ry =WfF=0]3BV#{qr|2$ЙW`<+Wߺt4ZCX}AO'PyiݟgkаHN9̪ݍR1A*̼ Y]<*FA.%#.;ܚ9Aؖ!G΁tR}B7pefdVUlyl )˩Z鞫f +-zͦ׹3O=.Ob{ϥc4.=-x5r:Vu22Ux'<Rz kqc>:؎J1-*.IOhtץ?@3N>0CS0jr}+˺2aP߂7ѪWj 3\K[~Яw޽b8}`4< hQyjYq.,5uPeֈtA-1I)V]+JnMx5Ev%%zC j8ҲG9vO\o0+\#{p-wR==#X` "5Ӹ-q]g6QB cJu9!z aDԽos.Dz,:` ldw^ MVcs<-05^ rU6ʷJ/caho7(` 9PpTGQqe/_5ҧqF >qc B-vaeJm(6Hiܙ.B2c 3 H+I19zڠ =hr ]vw h!*E9_"ftG%;K*eK:sNsY=|yRphF_/aVWk,tAaD+LKo2{XԞ$黃vPAÎ-17 "EAY rB@awI4QU0hLܣM}={Tቈ357`úJkB!@ݪsVL'^#Kҟ"gNdO]v(IT)'ǣll@?APNU5=vB'9:HCKsj@&tӒ=īwh8~zZ(fR)OKxkmH;ywcqt2BIOh$*K $ @"o5rړ ,C ѷw 8'LZzZ[ ]AkխVKR;#.v3pX߾t-z_Q$|3ިP+CWf͘dҪ9pЫID+݀KQu(0+I06o>E@ e: q.t%QdG$6hpyŦffN8{+8UN,;.j0-['7`=(# qA,႑V:Cr t¿uTǁf: ]:xC`57ՙ\Рk"8K}C s8U[0O ͋%in Յ-Э#4jlAj&&SQxWl2zC(ƳbE {?A(53z ,)IJGQޱk_X݊W|:osд{$qaZ&|N͌%_D.@#b{n쯣M r=I).= lڷhc$KV./'g<"8MR| 1y}>3{O AwZݯ-N?}BUDqZeͥ6tbQ7][uԞ^Ȼ F)# eezsUݖĀsw+QW\5Jsx"AP1jT$P@E<>+﹝OKvۻO|ޥ}~睽zdY_ji7st~ }mk#ω֗UBm2}i;tbRRr|3On{ *- [.ӕ B[F_JIӾ\ۨ7B :l]:Kd!JsTVs:Oa=2F#D lEKdCHt1(qP_EnY8}؂5,:-{j]WS˳D|DH}؂0Bom4U[.huv>Q_QqEnZ:M+zE tf8yμwX[ X8["S-v[ 1->ĭK+cROtuFICџ^R Bk >?W!ݻ"!xGw:V_ {NOT!`R7kՐ"iP&ʾpEgqD@ PC*-#;b~=G,#7\aJz<]O{W_+Ct"2rmZInNršwl%pZxbX{iX5” 6 o4uonOw2ѣ.2D7zf)KB$;r>IwWc'lS?[BDIޭ`1e\BzfWfpLҘ.7nsR냏?S0эl6rwGsY7sXR :Cq?_ϵJb YV]a>rY7=!r[k>"W"]7~uDt3rw˙f͈ﳘ!Hq:}JDhƻ(Q'~Iͣ$Ggx5JN!K@i5wwA+;5!'~+ϛ%"FfBDt};ۆK^B2Lb|!ktl^)%P ,PDއX4+&qo҆@1ޜv/WFD$Nn` {@5 !/ZܼE*t{Мf!Ot5rT;{n ^=Rќf$v{-HI kN~V-?D*jbpRDAGrfIp  :ZDdԖpPۓwg`>-=B]OA)C,=g+w>M /4vx%c2zGntkbD-Qv-~ (FtМ􇔞uhЅr;:e&:@W)m#g2 h3缾̬_uܑJZ`8V>ƺ%g-{7R ;LBz76w{DWTb,3p \ӥ!ћ)bj-fU&}DK0ҫZ 5YFB90ҏ}G !50}]9Uh"mU$Yozd0MNq2^I>=C IDATtc?V@H}v<,E8JR)ge,xG $(ݞVǛ<%g/$"{\*]hބzj!Jg?avk٨i4g=R81!X=u^;D7Ɩ }k\rovv\Do|QӎH'}ۢa?a+cmc;s*I'eȻrZ!9S^D/@Qߧ ׀BPHEzB2?r ,ϟv%i(eSЍh@!*sG [1ǐ "E+ ۵,X(ED[BRя3o4jDu2϶3Lwr4{xe 6vb/?>dץǥQ ^0IuiiB/G;c1xuAl+IJK2Ud6rA߀(F B(\U ֬A tȏ0"l[7~ꉒaL =r v ݉aa^Nw+r.&~S1hal;5 6v'JgܥoAu,sDĕ Lz^=GXtmݽ e0ih fiyl]\V}؆7Eb[AYOXgt9$=3O5gǞWk\G'Pf8C'4<gXt،m:[]M>gǫpэP;i4-.M~L.5Q-+p zp(]C&sj+苦ÀxH9ͰK@GeA7T&m=w ai;PF#pDMXu,ǽErFamq0IKz%/Xp#pE.~-4XS avc: &tg5ܮ3[{gҊ\'Va:>dYM.ʌNɀX4umPF'ȅ%Er<:>gY\ՀtU7um;Wm̥r<2Ǡ K<tD)]:zUyQoQ˄#q=zǎPV9$_S?aUymiA( Bbk}6*e@#tF [{kh_c##. :W>1K=!tn{ xݯlDl8aI7 RŢ&Bv3|r[|*h:3Qk=WW*B-xǑW]bGiLzwT/QzƅAt3&. m)}/pL;AEPНud#*_Iҗm,yKB-T{BݩO@i_>~a'qSlprzD LW;{+z$=`}W$@:lQE›.R/'Ny 8}&*me #-͜"'+Zn*:lŶ(5:yly^IPeI3/8ts:B+i]-]h#~lƭ߁OHWGz:'N0LZ0DXkrgnyB'_[ئsMxv_SO|)I1|~u[vں霽Kle?~p@ x^:ϰjR9юӖUqTƿ蟊E%5:lk.@!WAǹq@=a[b@B#ֱ@DZQ! i.]BqQhUA1.r':\`!&%l}" UT/&suޥ{cТ/ģ^x}wh5o\7M~trz jIa \&i@_iz53cavتV0528W5!r߰=!Yi 𳯒64]U.9YwP , 9ui{gR1~ȷMEoaI[t r 9彽6eXLz]Zl z35? v'!K{FWtSJc at!w<..@ v 1.Y=o].W`),s[*6/v@L>#3 e;^4l_1v./bܙN!<9ǡ;W}6ܖBF%>]Fam!r|@ ><l8_.>zϠmYE[un*fB' ƪ{8=&4!?j&`K?x5נ3W:Ytc68jE{d@G>㉘+5AJ{HiG/]5zm9[>2[m٨Qy /80@uhS;QԠG(zl3-ǶSWyy_ut}%1 * rS ޅ]@qVT-ŊR)e֮XϾo/년9{ܞT;ZM v\,la%e dݤ`$b( taUӥ3b;(kƯq6ƹ )-q}j/0qz +2h4(5Sy8{\;B$׿jyŷP PwkR%οbt_}ʙt!S%1`?b5gΪ4QЧb>QsSF͜Z;@ߓ1ϩ"$Lc> Ҫn>!aw?}|3A!w !?)R?f.>/rv6ѶqEБ&!w$sze??cK 郭lHL~Fa܀މsm#1H0.ŔB>}?ݡ47}bzVOzl9SQ~`Ez$ǣdo9V[e; -lh:jf**8 `etf\~;]tb1{o!$gW?};c ߽O'ncj!D0 zč} VA/3 [+6;|/+vN$3,mdsUЕ=vk?^YQl#a,<*hv9bSI?w91!ݒ Oc3f̂9LmaMQ4yBc%fAW|mjzv'F,>Sܡ~ؓ36 BYn/q9 pЗ_ -%RQ&v :!ѱq\u6Żm*\om7 ) sEwh=zJ]kAj`G߭w=6%r8BPUf`ru0.4s!Sy]gGȿe5Pk5M368wT3tK"/:rkU&H#7"I?v8ݫK8Vzzl@9tt_YtϪY :Ct:aBdC}I|kbYcŕ"7?  Bh~Ƹ/b׭OA(u[+˚)r|' EH9}˝ܐ 4Ҕ)d(eǠ'bEzt,\+Gr{=!ka\CȠ'*9F>T^}A;HLIY8PM߶=ܻ!栧3 u-χq##1櫞bJE^y9;59laa[W=&rK:B=^eӖ>%:aCeq~-'VWw81.e(,*%5+\6lmp'eu9\7ncMLXO]7{rؚ۫۔ґ2pdS'H6>QwfthKe=FGgKsZ(R'T,n.II$ !+:AH$cu'G.>m6q}e AD+$%?_uе.vlfyX6tt cY :H蠣C+O.\O$} p}͢xSݫ6'? -KzRrt+{F;Sc'3{P %Cw}M&gѶ{5kn6æ:z<ڴ+.ydž>װEC:4 S)~-@OnaYU8 uK4@HVyAOO&+ QMW@mJnRwPn5vF!A7vu@]V4R綨euH.f2VQդwKw`  dbxuQ7$} סR06fhuT{)?Fd\ I G Wk{e"tNzp> Ku_R[.ƹs(uhwc. ?E"V]/됥tW6 9]] ȃڧ{T54q95%&e3\LfU9]V!*|΄ |]DݫK8XtT?Pt ԃ}:ӯc<,/F u.+9|MG#`՛NՃp~j3u_%I٥9Ȁa I\3I!݌R*įЯ:6\n t\3^X+fש~:E~4bB?Eqqe{ʫ\ܣ8Q‰.'/KP*"࢐T `Dh|ooν"xyVV&HuG15jrkΠ'zn[M /|=@s/m/OSFJ>[?5~豋=pt1Mjbwqa3hztMK]HeA_j 5S&}2杗ysNhQ[Yol{]HX&𦁾Aj|(A.6r4auBgv;o X ]V_ 8 j32:ȊWN~% Oƫ3UIӣɇ115Q hy+&],yC469cW)ņ|_PRueKcQ9!P+@k?W$1UgS6.)w)8r Ÿ:]bJ# ' .Ô^:na>}lQ"LFnU[cs R Cef] I;zJQ?c+B;:)}Wĉ״`xNKG=M"V6"oj3cY0nH gz[5YV OR Lb8DnWNzˇ/"zN*ƅ&[PJZ#>Sz%y7[=+I>԰; A\3Us뎚'".m״ UFMU L ,ׄM:X1ևEMհw".tn[%H{ӛ]A A7TIm[:#gMߐ7"c \uSC.ITKftsK$xێ*)H OXA; /}vK0&"iMƻFVhKzU-qvW` n k5xJ۱ Pnبn~N e&I (h{Bi,(\,!wȮܐ7;n+/(材O5VH {=wVI. *ŶNY)MBts4Ċ;~&MBN1.nfyrT rBSm7jC>69bvA7Eì0ȀJPHOCoFv\"5 (hR3Ŝ~=P`nJ1( !!u A7V IDATWQ3䶪s9Zo ى:nڃfm9!w0zA7A-Q36W-crPr]+u׊|XjtmcrV){(,pa!UFM#h:xSM՝ڄb` nR]!&J@nl# b#͂HWibax+g))@',L 5{4m7&3< =B4׏;CZԼυMV[iC8~y7s:ȻRta,A$s\{.`+Eȥƴ#bu'97ޭGs<[%!!"XHy]FGNHVtl[{**rvSnNEhO隀ңMH1L$May0U5Efjj1} G.ѷWyK0c?]~sb|-Q*>Gņuڶ-d8ݶY`;9Rʶha A3E1ݗ}H㞾߾{Ug tSUEJQGAVx5/HĂN5k:x*DUz4@yI|Ix'}x XBWە+6k=vA>x^Gs8zd_a2atEyIJٟFqm!'HdweTN'HQY遌16ZZtUOhܚ^"t=mV]mJŽ9BA%h/yt{B3󰙶p EzZ4jVEAxቸo5[)>m+K8ErEj I$0;49ٜ:.; Smxgv $Ɵ^mWZF&٠#BXL2Լ.$FAQFLXA:#l:E`X9oke?fTAQ6[e;VOc~֪b?`RWArU%g\~|8nf2P])HMJpI, `b B-\cpBQX~' Nz}wpN'ӏܧhT]t~8,鋞9#鷔; ?C4mG;#kHuj>]XtNrlvK ɟ}ǩ^L5A$K7d~7mҷ+fiCjHo|_YJ:){ؒڂ%o!CJ䮯+HH-̩Guӏ#`~5ҭC{; \":bitA:d]>(mKymAti~$rF۰oqү0ˆ_A'FN=nN)6E.[tNK-}S*yE5\K!WtE?IeVlztFty_Rw'ԋlefmA6B3\g^[\oyi6Lf0t={M8X4 vNL%%OSl{J$i3}݌f27lgQ4zki~Պ@z W!=^&:&{"C@NkjfɊn6eIpM":25.y}HzZ&#m#p?Q\ DvH΢( v-aDa+Zvk6^zFt]dzEk~<`ʂ9=AFӷ xo rѳ8%RQ$Iqzf kګR^\TTEҳehAGЍ+bv7SziHLsɎSE[U}4赃%2Ub5Q |O9%djsA7Hf+sjq A۳e3pK.{{>Jf,!="{AG [L-B(}Ӟp^"|/%dO͗>ÈA*/d"$ 9Zk|L>lع**HAL̜NOrr0YL)x@$-:nT#i?g{AH'Qtgud竤q5e%+ uU AS0FQͨ[۸m_zTQAG چʢ4ònrH},36V@oyJAy#FIݯR:B{xTtqNA7vfOze qyRBɐAAG ͚tGǠ+.YBt$=7Sz8O {} 9g;zrE&Rz\RNmVqWȏ#$"rlCJ^6KU/ᙇG )i#P9r(K xmÍovfJYAGЍ)|A屛_v~=,o S29h-VKo{84U#,4#U.9M%؏3|Ua7(9xf2ȂVA-)~#R6[7 EQ'FFGЍh3Y.kӣrxfgCP`[z]uGИC^):,dl-G0U?skMwɵr Uue-aEtjq1uxp՛wEGs"&WK\tY1c6JilvZD=nyI L@  FrfJ/a ൳ۜ^5KHzdMw݈&B;f:xZ'󦣞JmzީV8GuJ)}F}1|UcaA1gpӲ7JP:S1`,h]MELW4WL OZ|#n25O˘) F-:_1,:~yǰyjv x{OAC}M\) wɶoC=7F)9Z#M7%40ϛ6C)P1(wFt]kM_J_Ie̊ݪ'ٯ\ Zt]!Ƣ:CJζT\ќ [ԫf[/lAGePD/5[IKmOoۄhΎg#m7:nDo ܔrY5ɂO/Rؕ}Igma}#.,iSFNYƪ ix>2Atමgp*K c=mͰYU~AG_.zR;N}}3hv )UTN DtfR utp ޞs?Jʪ[L !O=XO"<lHVO=uVu= 1Vh°,I:RI;4pI悜8EL2T AE$ Q<(hD4A+j?hhIN?^7ifZz{iBҽ~}^=Ct :pFDRn\9j Y7玣dW?ߴu*BJsiV 6\F"<^. `1tp:jэ0«:%cY FU92#ǠcZiSOvhVގ\} QOW,0UfD^/^-/v9{ &GzM?^AF+^JgNKAd@Lt*t,:RŃK`kُIKe GJ21XKu2#; aE&Cz nؾl"AǢ!>@Fq(K8Xt![ w_w>iOaЯLK!Cr{̮ b3n|j)maw~5_)Dus؇gMhٛ=U4Yo2 1X4QPCd{srS܃\8_g5 i$Xߑr0Xt@)t0ș[܉tΙ2rT)?B{n7w6aб~uV2XJ5 2ܭvKS=4Vbб`'(Kz7UcGڝͱXgn&^.kƵ `ЯIP^A=!d^5{2wKSZELt,vL/ )R;Hc/!M=-Y';hޏZ`cQݟMxA0X5|a-Ny% Zr h^2]P=֔ʳuABa1, 96*ŷmArbӉ즱dO%s#< dOH#ȏ\*:KP7n_5]rw 5,֍ ,P`/Qu6p[4eUۆ6 LR`z3ۃV.5yc=wL]p~pgd=eYa :qWm"JbVՠcVH|n^ЪM ]\_X_M )"2 :Z[ඃ\q#j{T;U6i>h0댪T   i#l8aP}ڋN ~1cl6]}0[ub)җs@kV$ȼ3ΉѮ 3ɳ{xQ? v|PC8p#3yӱVK6tu;w#*k\j8s˪ZM4D^ABa)z$^!)#=s&@??.=s};AB\ )DPovRsW[8O ԴjyP˽NE$c<\xg~irvFj%WƠc%H#v#$hPmk쪈ݱؿaܥU~x}ul3k/q֩0X 4vlД8ޙ];N z6ܧgQxF~OI:uda=bJgϮ rivm2)[{E֣h߼4o+1XTarvBjEs'omW@C3xVYXiKzG߮koJ~K~  :V tS־43?ĻP9<$z|]^+P94̊|;z @Y3kQNԿlo(MAJgEq'ÕTTov?=|9 ۟{ө-641ؿ~wut??0WBN̮4;#re ]b ''^~|N^ee9}O޿x\s:e΅2_>à_)ɖ }xL),K Y1_%otx}:ugs.Ij+{ؽ0՚;{S°ɻ|~2~qg+Y/Kb"]ъ0吧ܞ~K+SE9}~$tE?~y''ϪZ@=-?3&eo ׌?,px47 REU ,LykwV}ТSn0ߪiyŋ/_zXޱR1qLeC'No[l41v7`]9 >/k?gCIfу1B;;p;go_Ѕ2oC{o#t_-1-ќc;;nc v/C5hЁUU!)+2 u惩 O:CO%H?1F%Qh: 4!  tBB@΄B't +BB@ t&:N:@WP?Fճhg]fZ[]WrO^rר]3tu/^nj V%ӫW=_f񖬶#tB't &tB't #tB't #tB't _)ճ+IxK6fN@cYwVsk]Еq;\Rq'ڮۖ0^ bg1hz8QsE$TH3.R8LԌE%Wn^ՠ]n=gzIGwY֔#!*B^ ,kVxNi"Vq<*BWF%2Ni9hz2S\gЃtF%qfˢin^9Mo\y"}s?Ow6h=hz7<{]n_k%ztaRИeum"fTئ!HϼSլ~E _XEa-}"\c7w ߩrvxЃ_dbDLUVCĊ/E+ #oaQ)ҘkLf6Kxe =KE ܳ53J{w*ڢd=S4=`E4nt0jhH$/^Jw*Ψ ]Qysy>OD'4.^ҮI) =`z)~{{/#Uw4퀫[ӦhhFUeKI3gBAHBKsKU|^gn(/S4=4.5gT.ޔL/+G^ڸK(& CWFުdwLK4瘢陏ғԹx2'pzfCkfg'(uHw(-9M*u|"u[ 7;[/EbV0TfB/hLRߥv|*.݃wO7\pvo={(vDa_ԧȀԹLm|bL %8 )\<=M/4.'lS8tLJޖD\Q"ĘUS OQ聯mĊ⢠]mƤ;+t}aYh`LDO聋'uut-#Jg^D/빱g*Y:B@ftڻBscR?R'ӟ }vuq'Z5RCo񘬙+}BDjj_Gl Չ%MXV:*Ww\"*{eCPI[wJ+ (=n`{hUՅ2~i>#a9x0uzu8ޗG"Ѡr+&&6BAw4Ӏmvݷ<>5 љ+DW1/ ONt]>Ѱ>mohRl[}kþzgLvߕquBtDEuʱ(y}ԍn~NuW>Yh+MEg6ىn8k:22x+2?[Z.W[]gh7[/FTGD ebEײ|+&w>4[0FGL$7|E037?+rU8ɚ ֌fr[~x%ng#=F*VCOFnsEײ|+&ݭۋNOmtv#fz+,{ϓ %lk{mFw.3/:WE߄頁h#d'Z74ּ6'^NcwMMCwR_l}|ӂtnٱCJa\쑺$ge-hV }>kRiYNWq[nF-D3D^t0|E,GzB.{<osBsDr,ꦻ[1ɜ(Q%4~+"t5s/t Bw(]5=YnSك1.PI'IH^$oKǍgR"+[}K]kXU;(w+tCKmHT=[ӉB+ I[}7p.6܋VV_hq4>k>]tzMH׆VUˢşם;"] ΍*xA$D:G7hx6ן t\%~#^V;_(YRu;m9ws5ΩDᢏ˘!z-eIMw*ˤ^h;YhDƟ"ƿŋw^_;\=`E,Uݠ-?\I %:$\HYl!:D7.UKeAxw_:Њ܂YX'T5rCZ$ޓA>YBI>CtÈVR8.]W:D2:o_?.@LR=hvŚթLkRB3bU7-At5dUn@'%bW]z*`U̪ #LЭ&kW1 fx3*ǰN/B &/\PF$YYL,i3Б~|s衾!tqMn7ࡴo2_ -tC)袚,jtOZ\Ut2vō_ 3q.b8bUW2SR 53v d 6JУL)1t鰚 r te<[:^j u"$φ= teFSe#̔(Еbn(u`$6A[V҇t2ף@W (S=Cm] tzNDz% tC2+k̟ҪEK t#Ao'Ťe# |ݡ'"~aAE4ka&݊23gލtF q.ZX tn8@Ln% ?m9anA/SgRwb )Ekf@K;u!Ff܂\=NnHEעMy@W8۱ràozIoDyE,ZcNk1/ dX|z}y6OLi 9$Jm&(78&] 'i;Ai#cB.l,4m?gZ[ф1Y,Zވ>,A?SDB )/o}_/ԗ׸D1YMQ M5ЏkĔggȅ梉.b ,&qrA̠ CNa8!Eoi~-^]C>j Uj7ٔb$&a_!ȩq2v5~<..",LO $7YL eѩ/V}5.XtLt9MIRשof#fRXx zɢ,~Ig4Þ7C6?@OZd1IНJԇ=og< g )E?XrzV)hzR&I>G/;7@M2Q')e 9P9nZոKk^]lI4;i~wؼT* 7c؏W'C@7 n6Q3TxKA;)V+̓y:G*Me,,v+AKfwc#u2>#4o%jt1LCt  t1L ~ [e:Gzb.ɢpR5'V_wrX ah</SN_D=r;eC@dx8)@_hM~6g=D]E0\i?^뇶@ bh4 Ɨ:]8Vy;~@ah8Ӆ[&NV݂7( 肘,'[4oF^靔6@0Y4N ׇ[&4;6oIhb,'룎V8% &}pW&@'˴~&bz}4K_Ip'EH)I+brαeZЧ_eBх0YL"Uz.΄el 7.#b,'d-3Uݦ|<9Nw0Y4N ߋ-3N u@d1pRm^ޥ'jUbc?2NoE0YL"PJ-@c^/(EAnd͸͐V'2Y䂾\48>!V셡="\5qAcؾX@d1G)b99UǗ2Y588Ssl-7Afh-AN sjLK@oPJV]~UrMWX%ZU@tyDn˷og `,8w׋7b*0\l9ҔP0p1ņQ*B $DU()q%(5ӄVIKtgvvv&\H3}3;y@\2^Pà:Ѝ#c29̌8eR.à: #d O-3c@a(;7݄\}n11;LT r= .Ѝ#ϴϢ4OK65yjw5{xdFwyvL^ߒ \3 tZ/߄K00JMBr݊tʈ¤GcכF8Kv!?9%ǙKLlx_!7nmCAQxDXK 8[hŽ1YO{UwanQ C?frP|Iyhd FY#gGbv p3gL~g(˶st<}\ ~@9[1s>-,z=#ِY8s?4=$A:/.`:W#
A/&8$eN*rSTd1F_1'c,Ryq {|fR;鐦Z -,rOY<(ڝ|HS.@3ȠZv׊w˯ !n_` Z d_s:BcGŖ͔fyZg tC?ݏ~{By)WRZlAOŃv,o<2F>|X{I^1 ,Πg]'䝤W[tCwIR6VgN~Y^Cy V%,n+l`u"rR%X z/[Mm.l/Q^A7}5wȄ*X'6m~Ơ>QX?Qq+I|#tЅ!'Ψ: .$bc{`2-]Ӱv[{6w1ݪ;dBE02@]~ y@ۃ9'F-Cj V;Ki]L#V!*;lɠE8]Ŋ:3A- G=Ag4Nӄbޙ6' -Ļf^OlY>K>Ox%w0@?"ݰu콢؈x.ޡ"d=WһwI ɠn4.P-D|'ta"nOVg]ImQ&AݎTBZ%D<СbI]ETBhmut @&#ɠ@% u\B兄=a?QAO~Y.)mrV1 Tg۳I<naSEV*]A@&Ͷ=[Tݢ2}H6t1ށ^U7FItдy @e0nWנ;8A-lHLoQ`&oRTYkm;OhorJYt_WA g8;:OhǛTIM!hznyBmc;@,p$isNaKrgzN2ހ>$E3rNO@nt ΢+LϏG?PנJ'{Eq RyL z!]chL)k>2 LLf!]q^^QyB͌A!]ӂ q/BLuaEȩʬS5@!]r7X]gW7+y2%?@!]oԏuǧɫt-=ݐI?9EW*-0 gJ]}̘U_iNTdYhrLnbs tP]8:5ULY5tKw v4y5v?]mhrs0f>;o_S 5mna8WAoO}_z5U3L%l&ݽmtkΊ2SK&EqA^~BB{wHloJO~@70.Z=軤q}>l'XOtsexAE :>*5q7!nD"I$o@W:Dj"I.Mx¨.wdRiZTKgKNf3mcV]r qfA9]-|"6y5KU@&EME l6  g8~.'V%s/egE L ZJZ]GkbS5 Hj4Pė4u%5VVkkVj7t+M;3w^ƙ39ߨw !s>jfj_lLt"Z,-WVrs.jL %YCЉjnr6lf4ttKZ}+ < oB#S3_tDҚ  b*osdlj6S5 rݻ}n@LhD^zDtD P%Y} 3I !y&혐a3&q.n/o*owI 9K;"IW 51:bwKX(7f* zL[!'@A;U<1o+^ϔS}#5y͙ύfq{"+vt+;mӏ 0UKڐ9P褊-e?R=Xtl7 'Un/;NP,[.}|[x@N'7O\qq݅0 z5f!2 )>]}ܨq?ϖ@6 ˙jk n@d.zn 6' Jvŗp#_BKBn g Jv3;j[[\XBKVSK jAߧWu9 b6cRA66^(_F^WNVi*~ukXI-M/.&6|M5>(;Kfl~@AtԵmb#&@G 5ʎEfl0FbKtSaqRd %,ҏ+F-mгA'ZkOq"qe`nIQ~h JZ9`ҏj-a}zjknUZ5BL)EEKL}nkC-n7/:J=afK\p$| šBo/K.x4-/%SU)TWV?%AaBC$)iN85.GM5q4FnДP5<P\X50tj\Dr%wU`?9]؏ $ g;MZ ~!}q7\\<+tx"& wɨ}yMl|S,eJ7.ݒ~\=JIS E5Z>ͼɓi =Ϲ@w(CпL}z9Y6ǭk"`ɂj @uW ,tߐ3_~V2(i9|C1<BC%0P^JRpC՘tD8?nD/n=7#A?ꉯ$OA'P5.a?nP7B8Нd^`|#/wDFZԥ{rV~ )7$@wc\.J u0KFmi :0pEV\ N<@&^|L| l:B>L*"G}Wl Dq|+|l@;#*3aʢ- uOQٚ :j<42f"1%Lq9WZ1Ur P0?N͈:8ÆI[#7\H_r)e`m|㌮̏ke[;j?q5i ɢ2Enr)yL$ˤt]br[Âq2i赃ݬޏϢdlLh ?$EXR^3VOaVZ;G("RI2uhE([2y iEO`VrVoh 5-v((gz! ؞ZV).gU0?Pg"z<+f@ރtfVr95@x)8*$u{鉋)5k^Xbqh,g :;KG ͟.u@x%D@och>H6i!U0ALtS%' N2:J W𮄙 Fqf!>HGh\3{XӮoH>dv>H7u:Xi-qF$b*p%M ߟ~G露#:X6hYЫcT 4A#="W tB<[s!пR=C"WǏw9s8m:C_#:XdԈDž.Rt#Q`}z):eE]Zar4J3}>hw[Kqq҆m0K ߾SP_֊ZAatC]89Z^ɏkzKe:zP jBW/RNh%y W"%&L]KO#=AiݱK @Gv|\+T7bvkƏ&ɀ :卪XnmAg\8~ZîK (HDTE_6ڨD!(A1_4Tbɘ֘cM㣓wtE e3: as~=~$Q3j.Ki:)%{pWT],غ+gqA+58KIflM}fZ'>mk|E/$1EA-$lwc״%XyyZ}\V"Jfl+ժI>n 1ZC*KԌ-KVt`SKGЫm3@[eF/$G@Aot%I+<@3Hj&jڵ3zzrR)@'Pf[< Yݰuގf_@'QfA;BKӌMݰu tw87SK"suު^.Yհut'xz2),g9q. cg R|dƭv1nغ#H.G[MϸmA/U2v首钘tHWd :oU}3^Mfk$2V5l]ܗ51zj8A?GB;fʹ3Vy1VB]뒘ͤxB;vS&'}\Eh8v~Fa)[.Aw{#zb5o)kt-]Շ 0~&wB^ZI[TAL-$7` tml ocet{ @m}kyP,_-}[,f3 th0x={K \wݱhS` tt،qW$kN+cݓHIdmGG2ηz -}SNA3ЉtkixsJa63%z)cF,jܤ%)nIFw dp~FTAܤ8KI@7w i^P:9(nq'X@GhXx ttX'Iqxpg(cAo#\ץ#$EqKDxZ=t:l-}ϫ.GqK ;QHQK砓v7-]!тJQK_ f2#Ɩ>ZݮRтJQK4y9<{#I:ZxRDz'?:=ޑY-uV!%Qى}Ky :_1{PexĆ-Dnմ%zY)j f'<7WES[5mtVZB> 㝄Y=-тJQKЉT}ڂ\)B сHQK(/Qnmk?H&p(K(Ag%{-}~4+ʣbp8E*KhA'-LmUЗw}A}i\~ER*J3(%ē`r{%LOURQpd'*;KqM;;L0Dq9g=@/O>mE`_;[W-bt1-)Ҿ;ĿL/ľ sݽlbd`ڭu AI(0f ;h: =TW{{+!F.Irn*eUm zYJ4&A'^nwS)*IС(Z4fp;\%ό Awx#\7rU2]haV3:+ NmB'8w.Ŷy a tQ@6,Wyn^h0VVjjW=;qV`a{&{#G #9Gtθ8~]0N̿ڈMTisL=\?5C ARi;N5/_9ǃ t@0> 5v8*o"+m4(aK?)M#hضR%@/2jy߸y+6V.{H@AA0> 5Fyrq5"gNw€Vc>vY&m+U S葩I za|r ߦ5];ZRg) t{HvXG1@_dӚ/΃ALjTV'B|4o\7Ssڈ2ΣAL0An\ӎ\#x3gTN_=΄=*s{Ġ~Z@Gn_(Y:½׌aNVh^AZl{ )q{Z\[[@p3 L }ؙ[ t4ۘdŵwÌKAVe؄n+y# aH^ %z)3Ⱥb0]hO!Q'wKE;mAh 3Z?9\  t=ܛ&]}3DbY_5{Ar^}_ʈR؃%h:A pņ F &G 6}yXC\Js>M㾊 =/n[ ^^~2p)KuBjE2]2j@'h!NM}=MsBMg C.c5=b!lT@g oZLix-=RR!Jm#@Ѹ~ [ÎӬkAk(,cY p7ܭˠרΨs8q1[/33=@N9 ް5Ԭ`:->}"}/i{T_g>u_7;'wҝSR*]?$f˙Y7ՠMtt!]W)^ՃbO Tbnw=(z˘Y7 C:Z=(~-c;w tq *9;!}\E>[Ƞ? >RS+۾2;!]q}x&zGLnF&D twKȏs>9`nM-!?NT茟߰L"\@S4Ak,k- !@M@Q3EcXL?ETc~I2'vmmЦqQ3 c/K8E6n)Й}1PvwJ8 wOQ\Y-9GbL "(*j)cqUʮ%+h(>]Wsj|U0Vhv-I4QU;=Xշg}?Rr?̹}Ão`ݰb)xGغ%`:ˠR?NM3- Zj:ˠSe?݄0}]!U4X% IDAT Vq(%,,Tb|;U{ ZSu%eWу.ORՠr7FgAzU+&b~} D UQ(YBl@v vOJ tR }(RMecQ ދ!=*پlklABOa b-+6A6S SO.|boу(S2#r1ݝ,УQ/( ~оT=DG9|cd'DP2SH@B5 ~W|C'~H5F؈Y TYG!QṽH'>JŚ6B2q2Ays ( Rsߑ7\*U/ū4x[@ JdbtIhl/:6%Š:ŭ4.3|C&l xfiнp; ;Y%#lAMA`+\u#%=-c|Gz?k,q)RJ~8V{e Î׼a с>_M5{ qhqn\㓾\j)-۩7[ܯ# #ŝT^ϗbfWP6]4PO tEOS[^ @?A!V ;vN>RH5ezv+'Ԥi?.C\HV g{\ߩ b$ݔo2'} ;0WnԠ{j:w\&#J;M;qhE6sP zCum) Zg1ݔ7aȎ"x/oP0RԠ;]8!u"~H9#MG0|&,l"uNJg)jo0qAg25~VeCZ^ 8f g(ǺNaKP8O0!`K)s]J' X0њ [g L RJCf4)yJV$ԡ0 RڊZTwAh$bwrC;YX(\Ah@w3!u)"cnUr[(d ),L] ۴؝ᚌ6ۇWjCyAϊpmTbIl-fn3|=$wԧ3;5^.*RBT z`.v|ލߤTRgmoE@~_W,|2- _o7mqӣAeE;a[GnA 7Ɖi 5۳ Al/lժJ?  m4 `oڢ!aeX`N|-|f@QrQ\"+5$g-uSdRĖό9Ɣ ,_A'z2&?u?%AM p%atV-!ֲh?7x`Ai \N![)۸㟱I rXC|Ah>I_Svp0{ϢhNinYۣS+Z\2<r^gNDŽV_Щw-9tG9@oS>VAۘ \{glC/   oSt}[kk^ޑV@AogFsz-fd_d2d6q_EKt]󄬥&KZ}nO:tΠkw (o9-~ rڝ'd| { .L:s{H ҃3Y5L~Gl}̠H}o ]M,_& lӋеVz^;8avk؂~brߦ3~7Rߚ3:~,:UYuxiLl?S<@}T:tL@O8[MGWN z+#NRBg*`ó4#0Wrڦ뮄.SCIKo;#Ѧ-܃i'H5%A ޠ/OF:%lPn.RmkӋkJ |AcdkAb:r{ N9M7vmz8fʠ4 ׂZ[Ʒ0~Qb(Y+<nF.ȭʆp 'aNo fLn ~#L:9%Փ ⻑ +X.mfCξN}bU3NRWwOQgߏ|6VGVLpDZaTzz#֠ ((_(jU K`A56Ifƿ{ x}1~s/>~gv^_ZTMvoK>z_?4zE-{AUe&`."/?#L3TmM4{}楇GP =xdSs;"Ѝ'|uGzns?8\p@OjQ"Gz]r>xL3y s#Z"BBA4 H+ iZ\̛ @LE[aD,}tQ^P&/p3G l L) @Q &{~3?5j.H3f?*`ߡʶᶅCz@\I;4~%d~3ɴ$t@OPEE 3IW˚h>t6dѯ (r܀<l()vJXz=A<7/}E}8Uo1v?iH]b(nz k0F: nQrEݟJ5H2:vm ~MZŚA\3jAb ,AiWCq͸tВ 4=05((m<d5zG)-E@Rl.aN3Ju'Db n1l٫f'0{Eݟ]kƭufĹCF @k\p/B٭$.1̡K(= ksRfmG!:=c].rI"zaDXwjHW_|J."WM"]U^_s:;îX$ WGbx$=ꚳyn3Ζpzl'LPRS tAw*l-K={^F R tAfH;5&0SlҏxIZZ(Rf:Mz!ޠuƃ~It*KAytb\So"Ф+wժ.3VqIߜT[ 5Ja*ݚN)Z3[hѠ˥Z^;؈([ ;-:>wy[jpK銦W.%نt tA߭I#X/mpIwZ AG'wS*C:s.ɶ.X ~IDkWXw9bR%]w-Ѝ&iW2:{_Dn: @7taawA)X-tUy5+7,Ѝ]밻rTma&6@etFƂ~H밻Ky`99>RPPKp96Axdu#膂wm<] ӗìE-@7tj HkWж';ls`3)4HЅQ!n$,8U-9'`a]G t@V^.f;'K5ɍ8u[w2n+R@崃eբ ڑ!i~KY?a)iμHl]u\*鷖l +u*s0l`wp5%3л ̯g$jmBx_$X.t} :ޫa?Ԟ˧At}"2,ЍLI65f;6ajL4R:臥6==i%Ӊۋb D)T ϰ@74I\<Iis%DB t@!]Pl1iN A(ZD , kz>wlWaҢςuNi q\VTn)w(8=A|‹[l &tXoD1fl FD ݾ1s !iLjXt3RtAhE5ݾh0 ~[&1#׆Oz.#ZMz/4A1GOWf׿N5^gK*<ӷ {օ$q?r!jz>ܺ wWs7.>ƨ5AxKE=8|:8󲛸o`rUe3mϙ螜 mҞ>qtO2>n[-4gV 猪L's޾+7 PbIKz t ^$;.%IwQvt}ԓCt!. bZ^zϾ`[5VSwOUWwgwi8c H*P.74D,!QFP/((@4FQJZbdvѻWIN?sX ^ҷ7Tqt}!fNB?H^?_)隩ſ?-jwfltv3ό&fo| N>o1yo-^/ Cel1J}E˩D~ x׏]g+a#xMrZEi :{io[:I2~vy7ԃs#S}?@gėtAoGV0ֈt}?$gB-Ѐn; n>`o3X|'Rk%2MngO: p_ 趃N%Ǖ8|ܦvx QtAO;TZ{MGffBt@pU39̤tJpp~ ^qD':a%aDii˷q!:9+. ԅ ,b,Nn̋U(ԫ0N2(e~y8;OΚ %ItfӁB5rin5> 0Ld@tB:{X5GR&5P[l!:LX1 Y؂za&O*76mݹNilVA'ҟo@@vӕ5 黪Q[5es vOc#}@MzRCtyU5a٢ vN.ɂ6ԤG_ u<,5V햘nۼ򁃻`l< 5zfQL}ūtA''1]ԎXbtQڋ$ E1nf}2vwP@"3K@]9q_h#z Gt65znunIzZ#@ԷwT4W(q!zWPX>ɜ)4k|!A=EiᑣF./tAOnǛ*{pdJs;p$9+hPOU>S=urҖ{8w%2v&*\|m@tXXY#nwWKb{tAO(dl7Pڅb$uC#XUCtWA8MLccɕQ?n$c^] QQ5ﯬی#ĒtJkP\jy 1׀n7O7DG=; ]bh-HiXd@"nq$|(MHZmBBGuH[Bt[dYyJp(1\u)l 6 :9.}kT(ww6s3Q 趃NJGh+%D-r7tRZV_u~"|vHa8'gA_7PJrxS܀n7$%Rz{jSw NZ}Xwqw]|=Ш[Y~Е} 8K m]k`U8A$: tR{#PؑJQ/l|s#()~UC Nz/CP'6u^ $xӹѴ#IDAT [63)@'}E}|WAޥ9ε_%`@z?*U_9喟<9G-ȀtB 0`R储ns-9o :@zҷo0KՋ{7+Y.f6ztu]脴EJy haaulkkMr'7!5kĤI XQw۬깔zmScDį Z@' $PI.T9z~RWG>OщDx͑bgеNq/B]}vnHc%j7TS.K9Kxۀ tS$eZ \Jj.W/J]bMg@vbo:i @')g`J*GgjT H].ԧ.s6@'do }?٠pibu)z H].tmH)#{@cṚlQJwuA#z!~m@:y w1lשQ|&.(gaеNȀ;cR\`)j}JUu$iXgzSAf֡@PߦJeFAHJw+xNj}1].Aoy!cb]'$O=߁?8z |iZ3 :A'gރVuϝ*֭3r[n,`7,͝.63kn) "'"YØUje+N[+ ˀ@'sLM)Czr VPјTI:!g(@+X|-ֵ'ח/3 A'~O=8@VO e}ս`XFɫ:E pBGT' UJ+CR t5"B_m@w⯶F"B$TY^_5l4n%˜ZM-ˀNCb`PwptSϥ ݡBU%EGR^l0g:)F8;u߀P\6lg#*p?iR)n*kզTsA-4;@JVbeX§1f*շixQt1Ss`A si:x+&Fݺw+(ud FRJ3.b +W$$\ v ,064-srk~ߓG9>|9Ef&ɐy ."C7uAZkop7\ΰ$Xux97#'M6$A֣{+_Is;V 4w(Δ5iI,sl[P+p??( cLUuiDj>$u{'<_G ŎSé8WME ̾%]ah8Snt2O_28Fo[ X_^Ok#oeXaX"R[Rso?YʠYWs\z. zCo)fUūF&WG ta͚<U#H5*.Н콅 {/!^ʠ>E}ctMdtbX.t >sDCjҎ^KHq>~4L,{S2 `An!JtM&k6R+-{wbqh?M-פS9~T|~OyM^[`~>w|k:i0)nH. W딻f%<[g <췊bK>>!kMvIDCCl-EgKLY>!4}NWe6%9jEDψ<Ի]`K;Tr ߮8՚>PQSzLѰ(^\;r8y|ۻ~ƍ_LTIN߮L׺gҿɇM#mc΃80"}4NؿB~һhf.K \=|([_ޏ(CއjߡcrҀ/,ndx vir'++O[ã|@Ac4WY]1|8O[Ǎ/锂_ZT$ݙ_; ϮR*dۀrԚ?ANsM:)ZdX7?>RߴH?$ީxINDJ8BrG]viQWR]P;~a=4w/{JAs~톶}3kt|\ܤrt۞J a?_GCAçfnRw /IU[a>Jݒ*|cLg\Q+pb9=4 -&ϏCA%C@y^?o6څ| VޕAzx$@s =|w ],?8@A3k0C?<}~M_PxQ=$rOݶkQ.GO(̄2|mp/et:/fyޚ~*K$0+GzxcsɜyOZ>ׅ;C)K.؍ P|DLV#0CK+ۋ< +O,ӺrO0 ^I +~&b,{^K+]8tήlc26K$^oe7 {)KCHIv"8XXPvw-m:ɥ崽yiÄP|vSdJA i7˫|*;hD/VjT;5/͌χgs)zɡ^A^[ځS|G髜}ODAa_{(#㏱䯵a_]yC}]t]CETn; *:a^ et:n ."Pʗ7˜~zBd2E+VP_߹gxlS)ޓ{v#xiP s&;t:~;L/!p`f˻0k,tRV&aL|hB+Ԓ[В񒷩<8=#S&s#F_A{jY:4jVV=yE,({mUѰMxX_!Kj] K|5Y}}+l埮Qn?{E}#'>AKrM JLбPˠ XDS2 haXJ*XZ T VXtlMku BwwB~l.2;|ͼxyw}o8 Z╥FlmӸڏ76Hz;zݸegߵrQ^ޠ3s{?hY&k>q[q/0z_۾f7:/^vqKk|OowWsޱ+\˻d8kXw`4Kz{ =|&p}yq͉?b_X16˯}I?sW{6~}ջ^ߛ<ڿvSl57#:u{:37nq f7?oС .pݠARhV`[N30cփ1{|?eYG?ڻ7k3\/[l3?]ycI7띿ݚ7xT7!:@bxY}f#f7{H$v0zpļyfx?pavlpܟyn6~G+8p,^6ĜOZxWT~Hz幈pLN+3;K͠Հ0jtߨQrwldLHCMϯ۳y//Zt}OthH(5%{7_U"7M/Axtn: Yxw#Ly{is.i6 K*])S k'^1ERSxErHk|.HB2[ 1E2bNi3,̳T~\$D_v!q dBѕo%Jߘeɔ jbtJog^ʮ(ѳ& Q("1RHV&71uU%.a#WzUR=_(̮0G;$TOZ+ꘄ((viK_xDJF`(0+&KBQҰ.:uYV4&-Gt3 E/).~ns6U _vFqamNOx A :dK "ft*t n͡`A2Y:u;cR(t:39o\jM tZEEs {Qbl+߳@C\?whfq֕Wόy/b65PQ 5f񰮡]О֫O ُ]6pv=SgrK1k2kڬ If 2Y}k^pĝÍ޴:Nh겛@fC^h*'Z,7fp8-K+SB_v OK&?60=:b< O5M:oҋ#}]]Aeя~\kMYo%=\m%ۊɌG/ d6txS՜jeK7f!oNBL6 5vlrjWMOfd$CKtOzWe!~a(z-Zk=ܼ>kgt{^ܼqǾƒ'6ny-Uo̻jՖ= K+َtl@ t޷IENDB`metafor/man/figures/plots-dark.png0000644000176200001440000034125314466631453016740 0ustar liggesusersPNG  IHDR Ca؋PLTEMMM,,,---bbb444"""(((000333%%%)))쯯vvv666IIIZZZ把222555Ѽppp@@@yyy^^^777888:::ͨiiiuuuhhhFFFeeePPPCCC///髫tttaaaWWWgggDDD___HHHʔTTT&&&AAAEEE;;;ܐqqqmmmXXX???YYYBBB|||<<<==={{{KKK OOOrrrwwwooo~~~fffQQQkkkVVVRRRSSSɒ999***'''NNNLLL΢GGGUUUxxx!!!֮lll$$$nnnddd]]]Ԡzzzjjjccc```sssJJJ˘>>>}}}[[[\\\###...+++111 pHYs&r&r!+ IDATxkUM QRhuGlE d$Fs:P$|Ӄ z^K1p=;jss |ݽ/5X@5X@ b @ b  kb  k5Xk5X@5X@5b @ b @ kb  kb Xk5Xk5X@5X@ b @ b  kb  k5Xk5Xkb  kb  k5Xk5X@5X@AWuy3j| 'OPNG/X|`8[gVWFJφ u}5نL$ܮ v<8|x~4qS]ރĿ×x6{ohY6# -v$㋝,EʚlCYm]p|ɲ@RxY#6ӫ:7ndec@+ڷ@P2Pc9le'y7&Pրp;ZM_LɲvE:kYyknL|`o~h6%g:Њ-xl4qHYm(k@*n]\X |7w}ɲv&^6<sãK-kHZѾʳڞxMsoeMpk\pyg'ڱxuS :Z_}ÓpYfJ } 4gc欲ּά}*k e <ܢ+;S%ڹSMyhd¿-][%[^m9 hEhӽeɬ}5نL$3\S3We$ٰ[W~?<6H*Њ-gYk~rVY*k7b65p{hdYk^Mb8kOZѾ,kOde-{9?+k e [ͭWT*J$w߆Nk7-l+/kEhӳ=O.G_yeMpK9WKgetbCix|λɋ(K-kEhӬi[WUK+kW^Ym(k ܲbYLpάdY{rJzSl b } V>- e+65n)_ޘuz'mcORZѾ NT+kۢ哉x*D_eMpKc˺φ}ڋǣ=Ʊ;hp{oeh'`hy^ȁWK,k9WfYm(k V6:7n\]UiW*mCעkѕݛ|b}4> ?:@+wjyX-jdU̲}5ن-Ѭ /k57}W֗V;W;O6?`'`?;%}e5ن­{efB2k~Y-'`t$,IJ}5ن-\mn%u[n-;R 0HXnue-'J-k e [gnK]#{gJ^MDũfBO/*!r]p2^]F3_[)D_eMpkյ_F&WZ@O_#.~8G$z%\򿪿@wyֿ1nm Z+65`_ۣ=Om ?9xgXn]{ykO%~ާOω*e(k(k(k(k(k(k(k(k(k(k(k(k(k(k(k(kc* y (.2*(b:Eb)j8FAjK2LcjHtr_g.|~{νggι@ kb  kb Xk5Xk55vJ''ix1o|2I ,^9e#xGv0/g^ I-q؛A[ŇVr(52^-հƵ!fȪ;*u)ܙ|FX+wrgs,*u݋YX N`M^R4D"EUVxsXK"`j8ao+izRDX̓55V`ةPM2ZS"4/qۼEj~4P!EH$ZDW?Dˠ-v rwS8a-Ps!iI5G*Sƚ†ŵ,j k7ovy:dr}]]0V9PVk*O\oLZk:7@ %`D"" '+KkE>Z  bz$CϷ̕22 !PuNk/"4T6&֖ g@<N `"V`˥@t`o,#Kq+gP,|)˗X ru˾W$:} :XCVZy^8h5D"X(Xa5 v-oX0mٵf5)\a(5q#4T6&քu`լv0(isKe kymK/|pfpK!VY5y&SY 0`YLZ >(!ڠ~+Vj;H$֊Xocױ=ydmsX~ZyL k*9 J&XqTLQ2u_.˭IMMɔK0f JfۦդpHP'42IAd`)Z53cHG19i{rWN឵#- (F#[7(kb:k%?F"H$TAZ wt︋q*\E,}KwE>RX'"K k{ ~/[ 2Zt}8yjƲ}mLI3p :hjmZM zX3kY٭f`)al̰uLd=yn}U:*Y8cV6vem. !Z Ik$D5a+QզfIiԷn_Ac)wdO&RNr:|9ӫkriK^~=R >yX GF($/Z#5C^1=Ew=b.B_[[? 2:LESmjRaS0rOK=͍h0YZ `amjRԓwoQ{.t Mw`  *j%[$Rd藭:L)vFY,2BiKx"+9)+p?w<7%ɳ#fWFY%??NNZ4UX$o#>,[F"Ӫ]m"5 IDATkOp(`-hjmZMj VÚpXkk!+0oḛ8-C|2JMs]u6F'd[/KCąHR_ںO YV^Qvd4}$:`$:a?vp.HX;G9xIA|#d*ˈ?3ғ x4w`Պ^\mhSգZ[+Opl4Ot ֪N.D'.T[\`ʘg~Z@il۴&XKRfT2]Raam䬻γ Cs0Pi}dyMms{Zh5~caMF2UHңYK`-*aĭ݀A'o̕([a/ #RvqW=;F ;Uy s˰{k#24u xBTVu7}U&g~hjmZM M0b P2+0Ú3ÚaU`m0yA=HZ X߂sgo p9h5RtiSiǥ E#ŗ?^poZ5 ؤL[Bq.k걋+W)JD8R+V[š\OnHSD(BW[T`E"ָ/o^ttkҢٶi5-;m:nU V1ln4X\\V&Ka5+gkr_qmdcD\{qf?=>-ZK%XX+hB&X#EHw$ݠD6θ9*fYÚ8@N{=y3qO~pD}NT)WPh k΋4٢]mm k~O,W}ͶMIm5-Lm\QfsRaYپ9o Ss,/QX<MF* "G}7 Zږm4X{>^ kc޿/KII"iJ(b@ "AI*=4XJ1Eh 啠ZyH84 G u*bj=;;ݙuL&/,wwӎ'M0߉6?Ycmľ ֶj.󺩕UV;Y`Kσɚ3_Z=6x5NycZv7{5mFXs 7z-U Wx;O)ܱ5yƚI'Ys({jw>׿6g|hx8:E\K.myGkPh^$B! wV>cуWm1Ox+8Ю֑֫3Eω%5upZǚkJwFe}xXc\7܌n ]x?{pǚkGdL2V,XU(دAnrJ}5SoZa/0ohE&V  B Zz~I-C&?lxي}eXS׮׆|h1fu#n涋Y֌{ґB *pJ;)I/[#36x>5s jϗSkXۙ^cM׹3<JT":Z5cm׌ӳJ]5mz F:=#mӜV!Rk1_lk!b Z cVcsHBu5kjZWf_V.Po@͟\^ȍZn~"gfCݰtڈIdX[n W U{mbĚc)ZZjv7{>х"͌nE{B=RDA+ּF?wuS̓ak3G7"UڸANsJ5}v?ɲ=ڼoab 4ks ZX[ Zc>Wcǚ>goWtzŚIטDzOuo׾~r_؞D;55ٶ>{|kiZws˧UN݈\5wjY嵉k~X߱훽FĚVOg^ƌ5?{-=F?w 6SM1fznl`D9G~6HcM1SU.V3P lN0੻3,jNc~k֥˱Ysg['bbX_Lǚ.ucVϽs=4lx4w}3ƚ^@5-Q3k=|}X:/snXm|ƞ#Et^ܱL~G=/̓rQm:sq6v㝋wwh6ִQm/55[BtDc!qL@*+ѿ?uswnokKbM.kFn뷞ifyi&s(wק듵i}X{)i^1fgkb4$SF85yĚ>5Ǧ1﩯^UFb$[Oj8ִ;w7kkh5 Ś:cCDbo^vLeO%Toogxǚ[w|;1KsZF$.kW_xfFc5>;o-%娑ޱ͙psĚ6|CC^)ͯ'O'k[ nf']Q&ɨƎ55ܒ\#Ett9?yŚ-zalxێ Mcy7) _hY0TԱZyB|gZaBl稀X R"J>!=Em~u-űhkAm5cT#ֈ5 "uo-6.]@kQTmK8C"ށ555bXz(vAkvy^ [9/YHfX[SSG6jSSbXàk5gQk ֈ^'ehFH7%{k~y!k;dw^kN qF){]%ѳ ֈ5b 聂J2ysOQwF=pU!%+;8: ֈ55d q+\-MX# ր~e!O bXXndwm<-ns|@kk@Evp|@kk@pهO{ŮFX# _ZhB5b b _X# ր4;y-&jsWڑ['kN#ŒmV>2G)kFJI)kFGdhHX# ր4\JG8R ֈ55 BđF@kh#@kkZKr>ZF@>55b b H8b ֈ55 ꎉUvNV~!OPǹF܇"+kŊs߱պ[ÑG ֈ5b 5k@5)5G͹BڞcrY|cbX35Zcgخ%o^묺/ǚ5X#̛ XVPž)vo1ɏK'yXS5b b Hgo[kZ\vNVbXX*K4)u\2']IYS5b b HVӺnd/DVbXXR02^kD*&~S b HV Ec+{怼(X҆IKGXNk&)65Za}Q-֚X]5b 5k@fL/k~/-3ZM/ F~'keJնwY?3Z' Fd@y4eM KKܶVkau!ֈ55 i&plcR%sAR] k6X{jJkk@=gZ&lV+b]!ֈ55 5[Mnd֝ww.I=YW5b b H6mRC䚖BkWd@(RdwH53 ֈ5XҭԧQ#秶VZRe35b @Pd%b B4j㝂YZ/mO8vM35b k Hg_m:5Z:8X#dR X,a~#D*T`fo'"c-|2ZO _2 fgN35b Ds6Ec]5yvDrGo'dtd]Hwnhj/YǪ Le;S֭"6&X>槅G3E=d{"q[Չ\yx3$/Cd[V6&X+m)sF W`̓k|X6C-kl+ƭҺ~~,9k[S8G2kQzRYu8O7HM欒h,;=&Ia,|ù@9 |o x!__mTX37/W.2/1d]蛳y7;Ӧ cb-cY|)7+C&E"W9|!G GwK^-"s#i4ѝ`,|ù@9!6} Z~2ƚ٧CW<[|KUq?EK[[F^ONq-[^p>Ypw5HЮ}iW·r,_,g\ݧ"SÕ)k4Nd0V\ Ίy,٠{5rOPX3q{/1dO|H?!ֈ5d`5(5HXKXLd`)+ |iV 80"jY2R5*%Z ꀥ eREHf+eLxITNf2=4Cw|/s^pN_yN`m H/y רK\,?P~_(DԤ'FR@xx%lNogtH41PZ_"Wd*DAC,&wM [H>沑v)pƀ .KThLc?8Y+k@iL}l7KUrQPZX-j᢮;%@؈M 0ɞ55mm:h2amiV Y:a8l \܁ ?{ƿ>҃x_hss~zqK*eNCZ-OZJ*.Qi1M*{!+vLl/ ;VdwGsF5@ia-VhxwdOlpLX, p˧ ɮf9  P+֬ klˋ07W_ 5W8 g4fHC% &~ B ڗOr}b(RhLc?Ů5^ ;"/M %{ժYkI+_Nm2 *iGx+ZkֺK՘Ff55M5&\v Y֖Jƙ0 &[udo>:_c|xK~{8~ #I [$!sZV>%k?J[ң;l4ac? XY+$xtZ֖᱕/@% hҌ6a-Fo/ԏֺcbݕe3V HԶ?m̘TA, k7X/lBʮ\X!l,7<,q. T ȧ0Ci̧wFzVOπʊ|؛Qm1/po?VǗIi-XZe'XkZٲ3&>GQ8wP0.X[bE #.Z Tl`K$ZDfQX;ԼUx^&3(+e m%p ^YFKIM YW/HSP,~t@mtEј&U^?:jb@vpEZ .]]fiF-V VuW#g``dSeXA $5KšraM|jprժB? vό%&?- " IDATeC;-#V>OiɊnx,t4I^ z`_9P4*/(&rB;5h1v3_B#uqct<ykk$b55`հ̭vs/dZ8s{V%&v9E$La&\:6`?hX {< k뢕M+hG-vBi6+ɖhmfґvOW5Sআ$MmݘugoxGzuÛ04qZ"R˹.=M Ht4E@vpE~4.4Gk!+_R@$`M7ۇăyxFʙSzUۇ55 sӅ1+läxp.͑nXDI"X3 Iy/o/a 5^Z"u I>̙1_t\]QF ,R k2/\Z`ž=kX,n^BҎ6`M7@~Z@d;DkP``d/]hf~I0̙|0c -h%Ik]<䰶zՉ:a<^R=gz DaQS#aM+a1? `ś SKPAy"/p)u8]-P>h!>kw(|l1rWfDlL4+K=% ko{$e}9W*$4Ւ-~[6V@jV{X`k|um4EjcaM+KW{8,=&kq KCd0a(XT$Edqk'zMHRu02P/ë5OZDf*oQج5e%:Ӵ?gh #ftfV]f`mV5dӪ)kj/-\ VZ(C}XjZ~/;q7kʼn(0miiVӳWaZXc`UU,Ɇʰ(/mDfN\v5}`MJ3W 9I6uD$X#X#jZ5)`ϮeX: ִ^rE&Gf``DZ+D5tPk4\5]`-(\k k授kk$;Z~հڕDf{X zk%65=`-(=]U7 98y:#kk$h L1{֘uSd퀛01t YgD ?{gEZ>@vYHr B ŠA@aA@a#eYEӃÈDnP9taATܓtLNO}NUUS(VRˬ)|\o|d<`Yd YAZ],RjEEi6;pzѮ!ka Y0սyvdr5d 5d Ez*ȅjUbUYEfo>najVIAc3+v'tֆҬ!k!k]kkkjҬ!k@ 0!kZJU3WEO#a Y0gVs==+siX@֐5p"";9 k9F{,kWUK\-!kA3Zo]ݼfiqL̩sWݟNS!5d X^4/_)Ej`֐5sSZ,W_j j k$ˬ}岶a j k$V?Nx=YCYCY@ֿ fF5d 5d p~36Tm͞m/:kcG dY䃮;}sɼUcnіgm9"K1"?9&2~݋c{tjN{c{԰²$"t4,lݨNWEN9^YǬeIv3k姦u2zw逈|eb؁.j@}XR_‚A~U~U ?5?QjYe?!n5 kRLtQA֐$Kj}S~o7BY)+E&IƏ^YYnF'H7hr,9gVdM^"RnwasWϞe kaglVyFn9F_$BViu|n:.K9&JnɵUu/p3:,P wDfŃ#NQ>H30i+AV8jր38b|%+ #x  DIDȪytl+x,^{o1S~eœ1\X-aZgU1 kiӸZ˘(mŸ8 ւ$rMLL>S_9&},! W`a:0FۘOŽ7?Uw'_e`+4 FRo X:}#V:WGТ̗ "CzOb`ϸ#5-@Q[9(*n#9}گFۦ6Bk,BX3a.za*@jGEND5\{0b\"n^B kÔ(%sncX"Uş`M]8i˸+BYmmKlsW>_Sk9Y}ѷ7}D/D&A%6q}l&dTֿvsF*-o{!meC)4 k +0!hy{&paQND-lƹLk7ZR HIٲx)u/aMte,R)޲1`#/PyxlyVhF8l]5o$doX+=NƣQC$̗1p~$:_|_Y.c㞨kE[`]pڔaZ~~q`m`uqեU`<=z0/aZ$U݄v'bs}iZ5gŶxŴKHI6҃Z`"X)4 F`-gh.$tWam kRl_tkdf|һħ܏6)"UET:Y^ibex{ܓr(W 둒L0ZʚHs׷᯿|} "]>mՇ U`[FM5ߐ.L*j9ѤfpAø| NVF>k o{R\C 5 c !|:gG+ƻ DqzPC΄.LK5pX֙5=]PbӪ']z<#]6a\" ƨx̬}!!W 颴XYlk/5Y8T*N Xck=XStBvN;pABGdg՘<`åiZ"Gc2vܲ*0L7Ak |&>hK؜5;Ab-BX3l0aZ'Wm#*yZ:WZ$ZPbkP/m/5/͐O/ZܷAG@ޡ>Ic5mX .0}ѵ`\rt_}8 pCLHo{ \U IJr}mmS (3Z`|8Y6H`lJi'T5z̆ kl >8qE{܇sǛ]]xz_Z$Z)O>m kj k)"Gek+l)=В vml}l؉wDq8E>̊Kc#\) EY :҃y.㞂\C5o@]M10)H>U-Nc+T5挍´4[5k\Wy{v?}Ȁ@ zx hˉ(e ƞkPKe,A:")=~9v]`򥜾=1}ѷ2Cffp27pLuAVd'a` qO!-PW!%9Ú_ET|@߬~+EIP$cf U`"Dpa^5|O=&Př)ҋqX6J0m%(͓-?)].J9G?G8 v"RY pS,s6nմ* !{@8h֘G^b k.=hdf8L5X{{ܓ5$lLs.|ߌÚ%FT$I i|ϗ^._ugBYX3-=  d^5Ҙb:n?\"*~@&p)#,ٗLy"a2L,`Wp4wúYr B;X ҡ >̭gF! `M}!`$މ#'/H.ϗL#@La:W9w d2u )[ [ x X{!a寽D=6Ŗ]PZ ޓiF,ƞa AȼЃ5k\$krqXX#W<,-Y̝Wʒ[M̮R=@g5IR9S9r5$Y@a:"֘gH$aHi,ԕ5oc`'ky[QM1k z= \WGIUoQfp~0K =pXYk$kݣOЏAFPSSOJ.JxȰFn8P0Y9EUw"{,`\}<'W,u͎͊+LNqE15}_kd̂))YsTAb@о $-]]&y]C[xOE675W%L(/@fRźp2/-aW'd/acZ[urӓ7^:}_ `3vsÎkb]C MNaͪNi|B8qEJfBzG Vޚa5!m$RqX{;a5g!kָ"G'{.l]n+U4]:Hx?{gUEpNwǫ 0P[)  J [\-k#RA2{!z{n; yYȚAܐwM_L.Y[LuiY@/̼Sk/y1)/OO~mr:_wЗV]7ǵ"jԐaQWGQrJJJϋNvBsJJ5d ⅟É_(;kQZZ IDAT'ɀNJedVtB/ !klҘ;+wud-yΜC9 kȚ k %G?jeYH0*@в$} /TQ $ak k$0kOnp @BB-`SܳIֺӏZ5ⱺ@B|z]5~;j5@ 1vꦍYd tuki5J-1 kA|_rs}ksƀ HZC8nmT kgܶW@Rհ5@D&P OY{d1hJW EP ksL} L[@BPNja YT}8-tg3~k Ր5`XCel`TCnTմ9Fd Yx 5d RUZ֢YC )9B-0!kڜWRK)EqNRGc#M5b޵ad YxRM%0!kԫMq$6k>T-xa \\ pTvEF׭Q-OT?[I]T;lޕ jV1Ecڄ+Q(W3=D`5B1$J3mez!uAlعcUl)&?dCz1ȚK>jo[)Y8^w[[ZZr>tn˚*@RbggY)6=.k K^C !kSb:;Y kEp׳"ljQqN<'4aY[#K). H`Ҿ";µS۽i $%G2 ?VlhϾ=DD]i1,{EVlZ5i}}5d RJɏ6q`kHG27$"k3DEb.h:(j̉^n4>3gó"}IQ{wDq@*D!ZH٧\\.X6 Y!kzvlk k) kXtVp'Y 0xNKŬPҾ t+oؐ^^ͪxZ|ݑ+ۖF4gl-JHm$(_ 䇡Q!tY3lSĻjez/$ksvB͋ѓ7t])Yw(HKY h}@ܒ5IBg_5 k"Vd'SڬvLy8zkAoEt8%->G[дZi:Z7щ[Gyl(=.k٧.iez/$k[蒦('DVB~OUW[K knڏ"9lLv/5av yuN* 粼9Ot5EީW?k#aa=Y^+9ΟCȇ"OžxyvC;zK-6gZg\E 額p3evO\bM&BB5lSfM뽴¦5-4>h K1Ov7ǎO!k0T(Ue;jYsG֚ %h Nu ޞ|5_q.] w^OpY{J|"}W<UfUF#"ke =Y[-r ,"_gr[7?>x1g7C)yɌmAHYcH6fkQBZpܔDQQune>7%"lZ6udKys"K}yTI@`sD}5WdCSE~SrvHΘ&ݘ|ݐ(=A$u?3$P,V_ >9[Gf iRX02ny=h |P^GfOD!ttHaW}ͯz:E—FpneF82 3B^z[KԽMi8|֢FH*YQ~Y(=.k٥L){ٴK+lmoR4ȊaҚ`4d ƙ4S7fEYwYe~o۴ ;A@*ND--s-fm<ڈe6oTǎ]1(ݚ3B^%46fkQBZpkTOrYbO&$RGs_e>7woQig|}<чaDDRW1DPD6F`ETVh@1<ȡnw]ͳ뿳tu ;=~jwUoUMx5{qXd4CnR oͦ'X#9, øcɊa{?;CmDHNGȷ5X}`$pKAJ7@֞ @yZqւڰ%@2[Af^/`}ob} + 10;\4DnC^m.J  &f+٢Gj9J=^^3q5kk9GoZ"eWظ냀P`^`䴆wjp`xK@-DXTz+k$CSwߟ].rdj@b|h%k`(ڬujExa k\%/*g;`YuQ`}d"ji!/ƄpOVQC6梄삃E z'wMwϻ{֫8Ú5 VN/V6 7,oVn꟒]kfwa6@"XsNZaa}ǩn]V<ϲ׷ۮ%j4j?d$5-4p/6(P[noiӀyx7 (+8FݕmP!/k9 2%6VbL).ם?ih y(! ]?.0Cfm<',Pf^\a>gm^=G`۰63kk$5c:{ jj*fNʱkL*++OKHKaMY7G⍛ X)ǞZ9^Lϴ57cZ󜱮p Yo'\c9kj-(! X`ZV=3گM}%?dl?w!kQuZQBVAaTѵ}/gaښiN)C.[ /vʀ;o%>:g䤮 ̄UAȡ@"Xs@r$k #[Clx1(X(5;؝VՄ(3ܐ[y1&Ig11kML|Ep]t,m/g>,ٟ=kLs_ )ދ+lO.]!k#,o[[U-_&<$Xۛ,5­xc !}[ɖ#6snb}N~`oC7,3o6{4-Lk,sEP y1$=-;WK(!࠰ZTƬ~嬡9Cfm41qދ+l _a-Oow^ADi:Ak6 uj XT$}A-.f$(ֳoJ VLaW;M Sx-MAmXx U<~W#QA׏}QBCk0š\Ip%mQpº_es?X3˹!^\afr3k_>7y=ʱ4bͬOyB5[G~GD3kÚ)0NZ6q*P!cwza}`\Q*Vʫ#︔eyZMa,L2k4Y؞^dX^ M;e@oYcU"FI( ACȋ!aŢWZ@-|Ak3kk\//HO_o0v{Cfi̛ygwZ֌ދ/lĬ%Ƭd:m6+Q)PH(Rs:>QԌ\l 6˫=t}ri8u%\#d}hZ456qkxX x:-yY^r qu[,m"p6q$x6+)|΁ @I9&0.`;"kO/jKUg(d y1$ gðXK(!=8(aA[?|]6PEV/\+f%%d&Es9ʩ8~mb{DMK5+kf*ak ˤk=y%c^}")`ADF"X X˯n[p9tqQ꜕jI%)wÉ˧z;ҕ[Ąk&&NvvvfӦk^|n' 51-J{G^^єVK/dF_jRуi[,eg@-s!/ƄI@1\M?E;q6F AR]{9+i/W(i/ Hp*ZS?P jbjeL4\(B\ 5 hZ=roط[q L"}QB|h# i ]WJha-&!A((SAODFf:cGZaSg(r!/&10ջ0W1X3%Yą6HZhVZ=yu+!7 Hj&&m#?/ >TK%*ʧ "((xAGQzxFb&Fbh5zTk=k0B,.; ~0;3;/Ͼ3}9L^(aWJ{p}13J^ vJ{Hʙ9.Zf\_Y/m +;œA:.>:d-}ڰ]dV YVJ4onz5d-+I\o(kNj3hlhP4Z25k+IƿrCL>/& k*T_hO y#Bf"Q$k6frRҞ0ǵ`7K菬A뀜1!$ k kЎNk2l~6YhsE5ଆ >O~G/pZ(Ot)/kE \Fl 8!k:+IJڅg5d 8!k;?:g+jYtO5mjf͈mSԽ$ k k oWY5O%CYCYC֠MxKS;BMu^v.s:'}LaY'yؤPt_Fȥ.RD.RzGryzN.^?˵څIi m>jƋzgD۞/,oՁG}?h2XEߌqy/7F?bq$4gmL ۱ÛhhevŃ6u{-d/?8ƺ}Dǡ$\ =L^sJ~E QpSODsQVon➱2 n&www?_e\km_! "kF])sOG֐5čMZW󛘵VᢗAX]gY¾[b;?r3QTk/% /<)A{Uh0F %fwƜHNa$ kZ¾Ҿj. E IDAT}>Q|+n4ysռ\_iӌQٽgGyxӔMQ5c'(ĘV>6SY xyTZY3n&6*n|&$ h50D c]t3ÿM|PK}ZtغW2<`EȚW腥JCb^[TdE7فe-p4b!ҵqi$ֶ& #ko*к߇w4SNJba25e-5W.C:0 N^+mKrlE|'f kmyaS\[Ǯy7'c5Y[_j`Yͣ91ז׵bk"Vʉȹ0.N[5 -Jj`beе4/jAO[J"FdusDDK@XւEY#"/۶búڧ֕lR͉b4ȢbU{25el~U4J{?{q x^b KGaQ#WHD/h5D 㽘DE5ި>4$-VV<Uc\ܯYe=YΞϙygp ]XXaZf/ydW/:+5j2B6Qn;2MFQ&:f q. _u赇Alamwj#kj"ߙ SꌈJ6~0wXx`>m}s cN,3Y4ʫ14'X$⑻J~"b;N^cmkjgJ GpJ߶6<;l& .fL5!^YɃY٦3Y4ʳ1r|U!o5Oc`84_ߊYNMKSd%u)ky(&<5kLjC6/҇o+ASؿ HB*mD$o"'ߞX#"21| ե"E1'L،㦋>`Iϰ?b~ S SoS@U=TYi‘i聹,}sZDMB~O6ɢQ^M69Z0OPPiXU9(F}үHk,إK+g`Jk7hEZac`-`~Rᑴc96uXd{9^Gւmks@80T}[p"E1'Q7n k.|XVR_ j]y ֌y O#RKϦSNdgrlLhbd;5. 2@dsMsUϲm]mSB@ 5kL諡1hگ kKJ&8pvvqO6/^mq7E`+r^R@HMt>Ex2Y*E|4GH8 ՟pe , ٚ3Y4ʣѝ/zu*\a"juT× k4^9(ץx1Xc!o;whZF0Jl|?56Wk>j քkלY)/kȑŢ~MEbH6YsZ<W(rʘ"!lcFAEKtAjy`4ox9QY35y6CZj+zSO[yوn=yd9Ú[4ͅt_]j/ȭ5V?j[cq:A+EX.O? ȰVdk[ `Ё 9}vC_S bJV!Z2kܹɡI[R]\M *z`aoꉯ:{^.]UW\i/$sy|3^yNn~/Hk ֘zD9ooƦfZuC'k5XwG<z֎B2tp8ѹ֌o`m S6š9Y#}k+ 5SeM#ޭ`z@P5f@%PV ְ͉B~ʙjb4{q}yJ1{E6 ֜.ٚ[x|`S?3,&tKAk5X $ciˀsFM5uMUY% '+"<0&5s&GfkFFZHE$YreK{ϚC44xք[%(= la`G LfL h45{ځ¢"ձN<F˖Lh P֔FXѣ%KJ<=#578*mdS업sΟW!<O@~0X@[ ʯ3eR~:}TS2'jr6 yxnmkZUe?ߝDb I+F3]H?3qG[|+ wWjS1Xcb&k@} ':B: ͟ Gm_eUw?X~ 1济{-^evM&HD5@>7Il6FX3'k15)8!G1]M] @ҀeV6~75e:[ BYV9QYȃ+FF#O|O}X tٲ7hPv`8"B~E)`6ŝ_Z\v@6Z([lfs 11V#zc`+&mԫ#21mHkӰÍJWs[Lf3!& $ %єDH(P HCh)A 0vAł!AX{Keν>=޳ܳ'gƦ^ >yff,AXa)AY1"k1NZZ(/+F#d YyG5@[vz k`S(hАڢDCRd)kE)vAd6er Bx:YC$kΎFRT9Jd pI4"qXd)kE7L}"E29`x:5d B#dN^`خڔ7 Yd+k{kk)S$1 %dudvPAX~GY+{F555d -=\v=lm} 5-Tu>Z2F{B֐5p ]n/\ԟu)+ 5GYC ?eZVgƕ5ڛ]CzwA2C'?}]]6_{ yJR˴#M=UTů Md .Kne]7ogW=ÃrVEv'7֫Ϩ?fHÐ#0d-ߨ5wZYwXT^.PF&Y;.Ð5紆h5uLKՓY_?0J}ICJ:8 kP ֐5pB3YkYl*S2j.c3tp@0'#Nkcfu=TYr$\fr7 k)rZആXaj,mHq kAra 5dӑu ? y[\؊ӻYپ0I`Y1YKɲ6!}糾? `ȼYCYCYڲ6qJNZpH:ɥ 3Y;OV̿`УA.jE-=Eޙ}2l + APY(*5ox5da?d~__m$׈:%?zn {l<3'W}}5d ls ONZ#{Y̡^^}৥5JI)t-9&)3"jImhcH9?!Vm+c6n{Y/ᓪϼ,wDN[' H ނ<-ax*y,2'~d Y1[E笅yC]׀e+kKY%2lTker,)s"#+4ťo莩oňvLq" 1p#i A7oZśz /d 0 tMkzC1m"_ɟDnlZ:I0ͣoW?$ȃnL[:0e$&hGEևN5dtO.:Q8 47=U,NfzC1^Y}$p")(2iY$&r4}Oї"MFɻG֐5_Ndm9>ypYGmf ^)#V]SV{rdA(JpQ(Q8DADN)ZjQ<*ѓħzQ I^﹙y}`};MVTf=:=a ^\`5\eV4 tX`-ri`fc 7i^ոa?)2 B" E1͡u΃6y<3ٝ4?Ss=dE\@ojױWUXj<0l15Zq[T;O Xv=KI:~hi%ڟa- 2 NY鎆{FC]%L'֚N`}{:X@w~c+!kc:X'.%˴{Gzz.AdV4_dߗZ};`y(2N?0XYa[@`7T-Ʃb]Oƃt;e9.z` o;Sb7gSQ9dkUt XKkXdvR \paPơ ֢|m@q>py0;|zkք(1_HZ9__t >jPSƺ,Vr5S_E{ֆc6tg$k\:+UŴRR]\ W#V*RLKe1V9D *Hs=h3S™n33q~qjea=5סn^'fK־贮>?as*e&eߎ̭y"F((!m9v8;|zkք ZrIs)BvFx x牶)ZJ6:78 k\:+uPFwO"o21\6*8G7&$kJ=> iy4٭.QL7L?^7Di vXs0&Uk.C%C/.CN֊8SK7l{Xw?C֝>9F(5-] LË^5!kքe58wFT hy .Ik'! kU;4Jpn`NJ֤c W(?V RBm#L|ECRVAwDkø fP^y<0٭..ә2퐪 jmf7&]k.C% XK?Xk*dwkCW`a}PkQBz:vz2Fk惹 %œ}SқuKk ڡ57X=k;EtX[Ni(VNJd YUXwR]evTW_aKgjk\R&> 6>r6i63~Xeo:CSM;Q<9^8~lkuX&Ͷ0MuX;VYh<n:E 1tZF{Rx7, ֜f XJ\}fҴ@eL k k崧I}\֭[`Vǡƥ-k\R&>@uk°&ڙUYK_4[gݛvy<0qVgӍLKwo{ׇ,uea+́ךVW֔kc'}}% sU.j`u]DzR>ra-JIl@_8i[s;&`M(a]t^k-QH簶**l6&E k85. n%ecxϚ({ճ(1RKdJ[ h*JiSguq6ݘϤntU zUHKš|n|a3$T]vYVW/4uP֢XQ267\S֦քRU}+7 X}-QHOQ]71+@.Pl֚JsZ79ebPӋy5٬.QL7L ZT畷'95׭"KΦr6}tk`M"5=T5޾el{(]DFg=!}šro>/kBVK}i^cb5aXuA,X;js1XYa(Dw7ܸk| WQɛ↵KZ+j0OP8~:ʘgAVo:|H7]"k{Etltҧ(eě5Uϥ= RtXS8n&'<1\αzw4*eh eV_lGp#}5ShH|@llz*X 4Ej[X|yZs:Mv$LK3w{s}2DZVA"kZSJֶHϝ/D|.fIff]1fM"/C–Bb䉖Y+ޱvS`k y]*+W^:MRDvfV#kzq(w#'ihvV=q /?U/L%獥"t{T;S3jwA-ή8-EK>wai?_UZ-B ĿTdFwOxWBA rfx.k֥M5JpQ噙 >rݍv6_kO^_=iqQ7+jt?ƺL!k&oN(޹|ɨsբ== k 3h3hiI@ ΫRbMIqzt}:ۺ/Y<<+ZBrMQkZfm~LxȞs:8TRj 4aQ$ k`ZIˁ+)NOuIL?ɰ׮=*lcd-!9Юr̓D5>ȚFd YЩ.rTj 82KId ,'W)-ή8-E>+'0E#kɁ6Ek$C'k<& kʚ¹JMrC?OVT:Vi-ήT=/GꚆ`+YӒmZ/,Hd emqwǡ Zl/\Yc~@֠O^ 0Y q9#Ϙ !kU_-d 5d 5A֐5HKWȨk؀!khi_FսYgP:;[ 隀KXpZ) ޓ}8rÍj}5[@+pZkbW5H6gG#aY&;Yu#rVf̈́=aK[0>򈐏5H2+5rJw`'>}L9w5H2+TBiy u i8YoArkJ 9z' kR mi͚u"EO|z d n$7Cd 8 "c_%r Yd YCYC ɲ'>d p5nYC ɲo(?ɣ9w-Xz]՗KYNkB̌߰XZ5H>N5ۨyFf|)'2Yګ9/S@l"%]5Ky18.d ::"'sH S@lb:Er{_W"YƇM?d Y6,;ÿx+Wӑ$5\6un };+BBZڏ6{B 4y`akrtUk몣~uס/{ϻ.() - ǬvK ?sz}5d-X l 5d {qQUk:CWYRJMBYC/o۷R*,Zfpe-%> ϣX5H>iiv_TX5H#d @RkY?5yz, k60+95p]J]AR|:XHd `|(h$(rYPUTaڼ> yCdolGR#:鱀 k0Ĝ NF`@,Ƅ\YK+5jC 5@֐5 .<`47iE{z@Yr^BYs?ώ ׮GIc |ٰll IR{~Ae|2/eIqkxH(1Ҵ#qH);f9d i?pUj[o|}:=]֪FϜ7}/kM֙5Uw6g9Jtdc dFֿ]o^Yll#,dͺ4mF특E+!kT#jNLBzڡ\]KT!keſi,zݝM'91NJwy"n,HQ"BM5\&7A$o"Z^YR"%]ijcdm[UUJӆ}HGʖUUu5Ya3FhoV. mR, -knj{BM8T ُX_]"2~2=Cɔܲ1GzeM{@,CG͘Y.s\7:W&k\)#k _Ǐ|Lly-p֗B Ax}izK+&%!FTGEM=^N5NJN眹33ϰ|~y3|yM~,s3J ndl{3Xc^t8O9v2dXZq uֲ'@ĉBʷEٍɔRSV-Ma) J1ƪq=-ڤlYm[>t_M%5R;.0Cxvtݨha jWQU2fZwk@'G*Sa q9:*v2Xc>0`ʾ=saJן:^JC<煀aSg?}x(f* k@O}2ѤU1R؀GG>~CJ2_}lLRlǮ*g /-'ݞG&Ⱦ9Q:I.;xĜm+2íFDHH:!Y^S2}+ ʛqsީ^GTXk/7C0E@FNʆM`X2آ.OL=ָ][ t#0N>_`:qRflڂŮ\QaM"_]GR Kɩ-)l 2wy,G4+7 e{ټdmBaM_or<2ek Ũc$2k6npQ+цÈZ8j"c.(3 ʽ6*Gvr3c ndlZ}Zm1urk.f&)YfF6xSVhRa-[N?c2uCx{@Q km+qc0#FZk: kfwc8饑 E7%wEʬ`-v-7u;wcӈm@G+uf[L܄dln0vbYbögb6x Ɠ`mj$$,s#"}U#hJMr짰kmS꽍K-!9˙d\ɼ.5c?}]m#85VF. tGa5SXR{Ç< !Ulx/5/3f~io)߮=ַɝ:wֱ@U]dN$kZEM?4~~/}y$JִMc޸{J\)5+-_Ie\7?wW6 -E>&F֖ DNG43Sh]N+ʚex85dիe5A#7𩵬-,<ow{ֲw%Rf)ksclS3N/k֧ YRc5!J-=eM+|kјV^HִFgY;,)qHMiBG̙s"t5%p kZ`YƆcFwp=ZJ]-*E16ff` iEYGx Z=zƘDQ15R}(`(m#opЂ4YO}8}j)dmS!k*Vsr? rR5hiCr&(zg?N]*}:hۃ%eMw/??*Lѩ7"0k1N#kZU/=Fd97x#g85m􁅅d~Ѿv={Ԡݾڧ\_𼛢O7KqӴ̑y6:(kс%?jUժW#W s KDi^^?/"kf>z^65S!k(Ys&iIYkUK3enE" ^ks0bjiBkluZ3f":0l *.FXZR1,zި[=, Ț )Y0rG4sduNkʚEt"#t_ ӷ奶F$Y֒K!k⍅kz,Ț"\!kZsBL5ց:9:F.AJJBEL#ɕRt5޵,/s>ƋG8SI-Q-!>2*Pu7]CHCxo?I1&Gy_|L#X*\زDK \!kak!k£j/(k"iK/YC`Xm (]DLGd Yhzq>;Jd Yd 2KqyUwm@)YtbRx*5#EmP0m5]Ji Z7^su ͎{!k m@5h<J}!k k k@e-oǾ5[d 5h8K%فAkYsu= ?Ci˾ q@KY4TW5q/U?|K+d Y=;){QQ;Z9 kN.pZfS\xojB+WZ{VeÎTB!k`ٞz4[*rZ9J* 5mbʕ*f~`TCa Yd'k k kjcԴրQ Y5d t[qʌaK5d ҁ[yy8o'5GE*a YgEUxyj+wF5d DP k= JBd@RՐ5"k ks'x&Z<S"ש5d ڞNus-?{~t3Q Yp®2*a YǓϘR' N{gTCх*`XCYkʕ*FրQ Y5d p5d [d Y a k%JրQ Y& kt Qe)~ѣK`vϨjY{[dz̆C"REE3ZY\1TRu8'@jQ`~&pSȒ,ylr)zGN.(onᙵ:`Ygox\XQ2饏QY SEa#`ZjO0AHPo :5m13QV/_eoU#+oՏ/,$GrheԦǕsY ;&=RUXO#re;xq k'Qb,x 6)v_`ZZ X-HWn5 ֞'&̐WO,ձSN/n+'qu2dXš~`w `mWU 04`puʑh_eoU#*o՟/,$ueG{,STNQiJ~SXO#k NdܻhuƂ`5FkL  V܅rUuݏ'noA܃)dlaqAY.:܃l:1Ҙ"toDSq HZD5m g mIa[zQ*{#bI|~|a!ɝ>G-h _W9t.ri=q7U5:r\tNv:YRϢV`,E350*j }]_ctd3XbX 'ӱI6<[ZA ֐7 hqۀ4qWi}ҷj&tw ґU5ݹtHY+=kՒ$ZՌ Ai9[zQ*7ZXE/oՏ/,$e/);*a<0lxߡt7l2O,s.r*fb2s1uowZF(2M(򝀬 ֘¨\;cV=8_͎k kDNGQɰ&\ XE?EN-$ ku:PFW4hX&?:f:ޢ`8hS!KzQ*Vё5o5(ϚUk8i]6{sʎc k9>_TT*I>`TS"GOvZ7ăejZ>0㜶:b>yicUkN^Z#wH8nk͟ kj3zK"V'y't{dX琤CktE5N;cn>SÃkڱoS!KzQ*rf[ ʳ@B[=_&}e{s2XSѵtv(o*lLnIU`>w% 6<&uL"UJ70,R#>~9J@P>51Kju ֢֎q> ~^R*+֞ZfkkvͭLiv ":b;uVam`k |F; SҁoSX($ #*:D'[Ϛeb3X)`FIOgt: .ny*fBG$BAӺ5~5mR^iy.\x'U\j˙`)|js!Kjo"v0X^XP.2T͎\wO"]Y.rJq_ŧJu`:Xlz G˞\\cx2" !Et L ָ{>yewX w#5N(E$FPUtt`-Ϛ##=KsW>h% UJ*b+6W)fKr*fBE~'I:#m6ŧoO}9f,@>XX;E3,Ėb٬f#mD:XI6I]7rWkO֨:5udߺ^UCʴ~n֩ФZ($j9 K5k("@eQ k!\@Y0 }  ~%On F[[F,M}OҸ('[+iOzk՘11X簶 <5$Wzʆn~D| ֦a8#wR{TazӦ;&w!$Rkki+@KʶR"V T(bVp"A rx-(,쟳7G&sgi4~~I&v2;7J+Y)dg>?|_9:`GEY뽬 >v9SR6YNYk*OZ#2l4}CMU]֜H%_zBR_M8]ԕ5wٟ.i h+M]ŝ98*w(eV'ePVvnjZ1v* 8%Nd5:@Y&<2[Qe63hU3ZZ`qS]:mt^/6P6h?g]vWUnXKB+r[Vho^~ WMQY Kd{v Wrm]IYK*>el@YKWY@OLe)o6vCvb,湀(Y Eã_?~2dM.2JvQk-&k_{.5ǣ-}˝ӦS_'5Q/)_emMsX3|Tt/kkkrQ:\<~F3&*˚ckRIio ˱8>:/ޙdn)*kD#pI՗Uxe-ygeZi`_\9ひ2Xsܽ^mxuv6|p={*ZeMwemUx#g\;OIERLG)'&k` ?խwoni/ŦYmb+Wqqd.SUAШheZ,=@mI_ڷVThqҭY_S7>z82,*˚ckr--rv- jzesrlmx5]SEUSU?&RXxXnSg8?;*B|2>EひP\ zkn?dͳu6^\U_>bX Z֤֒33ՐVԽyjշ_9 5>}F]MtwX^R6Mu2?9œ-Mͣɲin`@UB3Dʚ'd/u$k"$6_(h/d͓;˫4^ޘ=_xiסTSq"E|MM9bCư .6IYmVy晡;/)4!h;AtUYsh͍S #+xOX?ol2١jQZ%i><I1pKY()BR_ҍ)-TQ/)_eDE(kAۻX:PNʒnk 2g3GBOX)*k۶uc m׋wK#*(kt5B[#5ZQ4!>5:'6Q/)_%AQ$ʚc-}F^]('eI7LvSRᄕf7z͉sQY[j4Fe(kTQv(($OىPT|F|ɓ5 ZַW]o/qRRP֞%vY'{&58 YkÞK06#PIx&$F($Ykɉfo"OXGrraC}|(O%^Zԓy !~ BYK}xLHrYð _՟L֐ #etgTT+~+Yc KQO8)Aq$eBHd-dѿY`.~@ IDATu'k`?sI9vBY3HQ$(kBح~ U<(2e-S 3OQq+ (kBحx\!kE}ูZFNe-=\}vfkנ= aV^F!Z/s +'ϰB:ikV'T"ソeBd7r#[ 6 [5!5j5B%Pn!A8ϚpFh+FW#^F!d@mŞ^Z83t@Dy;b`F(keBY[s} xpw! ˡC$KB_-]YȟFeFWk챣1^]3W{,}wx"(䊐TBǚG@FR)k.F(?sFY#Wc͝=N>6B5BW#5BYBEyJ)-ejY95BY#5BY#9gRSKY<;.\ZR U݇yP(kŁ< ĝA"eZ5R;NQEHM<BYB~gFb!ỤKظo2sSnjQ!DcVn OEU͕ͯ'4WӥϤDS"Ix쮔ƕ(k5Bmf򪡬Q!,< F_I) ;xP֒ZʅO?rkupb*\Ǚ)amI5iG͋:oC~(0\(>)(BFU~)vdc h;1HRqqO)nicY(52u%e5/ 78;i,81r(k,k E;){\E(66Q+q?W3ߨ3:g3e[(aMH(l|cpc(ܜ͂.k )k֑iJNGuCYkܲ&/Pv5F %k&%63}=J銮Pu  }#9_V04ݢn0©CE9רQ{wJ):h;Y :zX8 { T-GxC(3xk=RW::{?tC{$Ⰵwj}Ǒ%٢CpjZbAbcnN{Iݰ-( LY#5Z;Al_-j %e`E&Ɵy/ɺYړ/*g5*jTi" Ś@=N_cӹP ]nͿB %1И<>ta[zDZ۲}7ByzNf&nA" ,aO#-,yCQwQ7ByzN3ޱs(k+knA" ,1)JE>BZbhw~1t`Ͽ钲yP)/ :H&IEYkdI:1dm-𵖘3 YZSu#[)ka%n>Ό3Z|ֻ]ܣFj:zW/ P]r\Boӄ@w6]Kb#cŻ&O}fUtЗgwd& m ׬f%1 hTi뗘EZВԆ߆~Oݶ86!i1+k$a%k &K%k;]Yi6 k&4\up(zœu؉3ZRݖIA Iuh9ڋi-VaK}N=r9Li,Nٜ.Y N%xR4u"QiII a4 J5En -o\~>Ih;na{mHSB8Z/IX?09RzŨ5QL+zIY4MR(|AuGd և )VV*Msg?xxxDt<12ؤ,) ZK:b޷,P 3d1%)te06a hD2}a6& Ԓiքl00=}6HCp@,/IX?09RG}e-E&e [cykʂ窬 _EiV?dIޔsI@%I\-\3gJ%104t)9aldmz)o Q{;0=}6H5a"òKVO,Lbd uN\L=J/N^$R0 kLѣ盬wҧ4g}'%KJC:YcbkhI{${ԘM_2U"(KWTꕎg&OֵvJ= hDqRhȉ`ɦdUY [c'nii*QŶ񒄕 ,DEЅE,,o[n9@fmƉYwYPR2 D,̒rl/ kLϔiqYJ˳z 1q3`r~V^#DJ}EYDg{,NɷZڝo. 2FlPp3K_1&xnÔQlMp1Ę].(bIR֘h chԨ@"L镵p0PvBN,ZB9 B#OM/IFQݼ랃i5&vO*VoKGǔEYs';tU^ow5XG4O8vpmc9lI aZ6k4 `$qVx_H֘>}ّ<6?XDE55wcrld651>&9$8):pbA]{bkϨ'RJΨYe\]UZ{)8ثnBmwV[u0ֹIi)a"|L!?!]otaD)_lM4JŁ' kY3F7&T|ڰY$Lqsr)N+dMW57iNbuYRﻥƥMbkoMt-HpFo:oYGOoq,a9QCaBXF؂-⓸F %u~t(&Lyz`i4.AȚy5kލA,,[]N 8lZ!<`~ZLZ8heH]\ȚUWΛ0 eOc:;^z'd H\Y[6Yٝ^>IkAE@(‰ Y30KZMʅ*|< "ĆAqHFG:( \I8ߞ,X3z3+ !}%Gۇk!pX/Qk:"&l,.]Hr0LЂؔ5Cvt8(kHՒh6.I|#]OLGY}Y}[|vTú^()ž= k^f팺/b !W|Ŭ)=\US*cmuν&+YNMXl]nsΟ)kLYB+kQt;ZZz1l^uO^g;lp7dm@}s145cW7EYΨ.ШRc#Y-d![=Ԝ~v))U1ꢒU>>o>H3\ 3@h պfd-iԄ֥)BtvnMY+)+FY#FZ}֜9gQb^n}Fa8 しoTʁWb(G3Y<o~*Ephz,~ͯiR+n(PT59/S*51| Fj{kF,%vкhs-xFlqQ5b4Վaye@[v44Pv+ޑY[\=݇Y )? IDATDph=,U ko;uQn9Q= kRs?9;%"uynzOTdF[B237P #!1CV~K/^q? e25acuEkq}DVE5"Jt BY#[֒U=&H6_;VՈ^ڽoqF*}P`ae5@4$wX^z(ke|C 36J&0HALis/K٭QBXbmOK88 _֬S6Z-uMvkv|hz)Cv,F™_?`%P%HitZL˚ :#gv+9pUu`]NT:!/Ř~G5YkLSp0gP~a9kK%Y0YklF楠J `vc6Eno1xS[-ݭs^|Z R~dzO~|jP֪c:{W +0b3 $Nb|Y5bmfкhsmX`a c)%Cgyw>e-veͥDÞￕcR|o-k{ŘfAv*pSQNo72&DAYۚG!v|`W7W-jvg,nY:Ǣx .\pޛlNxύ"؏?1c(Ŵɬ|g 1(k1Y[tF$dXG YNMXh]lHֹ6qՊ3(k$ԩI.BG$ie-veh6.ԢȪaP. 0/9%7^.cr[)8*Gy^"!1jB@)) ~ԟm铵 mbH;.s |(vr؜S-B} !XOxoNxΩD(E1Z $DLoWa$xK?xK?,oI!kڮ,e*k֩  :&;9Y?9_H!~߳FX@*ooښZv9jp KO5ZڧL66G̍v6RIoFRlScI^4CX RHLQ,˕0]5W-(>闵#Ш*8*C ⁊>T}蛡VUAO)ys[^a`UJ{Sa=-':eoƯWa$xKYaڟ`E3cB֘vM[;^65ԄFdk>7M$}=.kDIBO)l@Z.)@+p*w,tP]2Z.C!{bJl.kA)r>YSnj~V=Z)熮>Id&RSFg)@/R|O2RHR,뺺YPà[ADNQ DJw=_QEH*X1Q,_[xQ4u߹젻\av?< SrxI@KCh_/QI~v;nr9$fFD`)S5kM[5b D+bݭPZZps ؤK OzXI ͻ $3x k̰Vr(cdP-SJB["RtTJȟQ y w꭯W/OjZ:ik /erθ{,/[kmi_]{BZZZPo.Bى„8>$kL9S֪>&[>'`-uam.A4uY-~*PUN7`@.ƒM@мcIҳk5rܾ;FP7wk4 v*{01nFԨ̫pV:F!S9L}d)txq,3>G,aͰls4~p6Z[WyxI kkƒTlݸ+B9&.S5j餇>l HX+#@9=Ab`-R]0lRyBk*5+Riԩ)FtRO?⾍Z/n4(Ў_ k&8n9~1D =Z3+dӚtpѧ;znV6y[ȈĔ)8amO8S%8y5!ӣU^nl~+T:h60 ;;~>)k;u.tH'u{0YFфVKE&"k\*5d-&̤W߉n=K(kδ0yBWEx~(e5J+d ?W[k#CZ%ńt B58PL7m+IYW0pW*5d T9E-0YncgaPm&4z?֪0=*Ր5H@nւH_"*:e6Ț.j5dQ Y{@{g=w*d p5m*5ZՐ5`X{:jcls%m Y|YsyijYsmj޵WlB֠F8NJԂ&ANF5d Z\/WO~ͿU6 YM'?mO1N↪[OdTCZOr5H^8Ju}2!kX\G*a-@b 51qɨ@B*5d ax82R' ED2!k\hj k!kh u1!k,TsaXD-`kj@.֐5wڟ20fʨB>UȚy>2!k!kڛj:IJt򦪨2=CYKHB5'P)S :RRg(k9 lUGSE֐5H)@%Q1Jd͙5Td YD!wR AT`R5d "s@Yl 5d Y5d Y|<YdW9<\jA?weld Y_Y,Qp)ZNAl YC:!)TjJ-"kJGM[pg->x連Ǐ!k:Xy@?sn>X?j-ko_3Z%Sވ(c5?F/+83L9sBsݣLJmPT|Hk=O}͢{Ѣ:7[^eTf}̕fԑm5NQuJ Y3,Gc5;Ʀ sՎl\ϴJ%?".7,`w>fM#Zhe069AJ:<|?M$eCEc57FcR+.aC!2]eSD="pafe|O),,޿Sd㚢 C{v%Sn/چe{Ѣ87 gemxȄeW eѝ /.ޅ!k%WrYhi+)QϠs,'zHƋD /LmeE~Ȋ\•Tyg ޛŹyﻕ_֌Od!k溓*iNֲvaT%w?Hw|!K&Z/9 ܳٓbGDBӇdȜ:"ͅ:\]{,]e-d Ih=Iɰd48\:*5d1#5dI$$MX?W(22IleUp 7f~(jQFDaa̵z?WIkKKlMC7^ "u3l}daK#"GU۳"ROkcD6{>/nlHQxY ޛ̮0?i;\@֐5gS=XkBl(Pj Ys]Yh.嬳 i#s k}{]hoɂ?Ek6#YrPj"qJ7Gi’T(-x"$fARj:~.laT/M5Jw*>X1Ilih>^M|z0Cqz; i%eNNRš[-mk: עt=sX U IDATEg? 2jv~rX^X Ŏ%M>׉y(TL a:P`5eiŔ~C^ZԜu \ʣaEoR'n5?6e:iL{$G'#8$->>FC 8C*6`VS3 f d~̅qd" 2 uk\.^GQ<MÚk`ͷ_ pWEMˊTm?`d>sX+ocMC95[07?N1΃hiL)X4``4>'BGIrdHCDc9g"6uC*?Ce1YorKo%RKؐ@ٺ\k6(=pXYW J:::8'HsuV Km S4 )#!Y0K:3;,5# nigj{`<>W*C$G}!z1B3{MBE8 <*?ޫV۫\E,~65[S~ۺR0!JGk8qqqXn= ^PѦnWXZu齗܈{OUUhoM`jbpݶr^'(5knՆ3z+vp>|?5vدRԳ6Izsz .0PaIrnAkgEif#Z]=?hhMWÚX1M}!j"AǙ&i!hS NkY2 F4˯& 8mk,&7m;5/pXV}\4OaUzh*F(*^mr#3R%ޔM^e.8_L`- fmST0+)I \,<x8qXs4r?Z|vdkkwPfZiUQjPO#ysomfvj k<ʿúVO-6Z[^X+8ml 5DIV1BI9glHbT4m$Y <~p9ܤtZ71-mӏV9H%8qXs>ΫjǓu?9@`XZþ!}4c SH.ܑҍi֮-TrgZ\ReU\wN}!5Q'Q{@aaOV=Q0̺LV8$-dFZC(u_Y\,=~]tT$|'\NmF9F/ZvnA,Jѭz=ИaÚ[K}޳15WZbRRl+= WMm8 / 348`5I ن\ʰ amu]<@: uphOa>7Laҍek#7K?= 5k8@b!8qX v au\)rvcv*WCV La-AIj8ANG暗&+` _.R>ɕ[RϱMIrf ٘r>5I ن\۾IZbsQSWT~rN_KzxilfkVn&e[#,Ã7u3= nn!%LM=)+ [[u:[ebPp je)1D-tb%)M1ZQ nBj5160t 0z_>pOozLUYCp5d YK YK<>|xP#Da`S瞩ϴ!z'k(Gm2mpdm|-߾l3]g# i!kcGר!hs_0N&xP-dV8KGE6i!k#GY\Vhd M[:QjDDc`S瞩ϴ!mLЮH[ȼZd,:G.Y SSdmӨ l34L&XPď-dLIQֲ iLZyU6\Uȏ^FNfaM#k0\z>"#-LfN9Io}B֐tejS~}ƞaM#kVZA֐~,X4X k k kjZl YC5@F!kI7h,8qzAYcFj{H0՝|V7,̐8T=$%JMcu#k" k\pk7mV7 kξ6>VI bmnd YR k>vEbYp@Y |)6!kj5@֐5Jd YC5 e}3Q!k;ֱʑ;Hf׫;n\Fh+B z/[ܻR72u%!k⹕m%. kUֳaG쏴1 ּfZ}&+͐5D5dMC̲l4j|O`ΐ5d WsdmA>n%VvP Ƿ~U^g4-Zc[ZQ_he,zj|~l?u2.Κ{*E\ 9D'k_*).x knŽ4"j♕}oo*%vv? yyțDuWdК*D.־Zv_~-@Y֤ɄݽiH.Ct1heuÇ;ZYu:YCGU,jwlb{cqfLV>eYGD'kSd)hWVɚ2Ľq-k&S9E+@ӋewaO<d,Sw/0[T|w-_[K9BB!s>ixg,Ng?.VqXKd!TEU25=ӽ"~s'#N:)2c)=2VA%];;r:+βo1.mykuO156öUPh23|SNI e^Cim|KzW|!-;|7E, $C1Z{sy@ wnK㻵We:C֐{Nu9jήǛ R d\RgXZ4eM=J&𯬔vUx.Jw{ZBnx=ߗKTޛeOn1&m'%@jK v}wѶ Ә~6.HwO43uYdd¬w"|˖4RGjeM$cjUqUyē|-Ơ`1=\v֓ Ik7M%cڒmmD֜I@)b]B0mH+6Uķ>we:C֐qMC`9;oO d|HRWV?EYKՊ؀˷}?%~YKѷއ=Y% V1\e|lZ"s⊹L֎MOi*ӳ]&F#"xIP]5W|e-IԪRL.wEhcL { D-'c=EI|٬$h[RȚC5 Rlq@ 9,k!FK4gۘ۟En{_nΐ5d-nTot fG֢(kwEZlojRyÃ"*-IKY~']+a$c߷/'4r^O"33S-ƨО{9E+v";'ZjimxJVu%MI])7zк/r`tncE 3Cr\q5CUX!-86>@ccjo0%zm1`C(cOH_-X[Ro/f^veHfe'C1Z.gܾ)`;,VYaa"RQJȮO|)#" E Hnb)XbiX1jɮZAMjپww0zz3ݗ^3k֒giz||9n I* HXX\;,T` %}ʛv>ޒt䟺Q N_RX+F-N^x\ܗPѬ5OiŏA)9kFA͔Zkp̗TXdR_P?~::cIت5+$)`y;)+/XJX,/ šjreu9w9K6L䱚kTG !?K5~k ${%pŧR5t`:N d"z ud2 kiwXik; i7@Z, hoPtӏ<-I5H*U!_a{X8mv0!''o˒IPگ@r#ž\?s"m?x1Ƭ:1$r|`="?r%6NX{Ʌ5W5)ORiZhȀ֢xSmЋ\{Wc3 p&`MZRs@ɳ=s*$x)'rUH].q@Zb`Ƕ5E7!ƪIme$ܰXxYYW0,c*=f_cZ$.k_'bHkٺw5cig%.i#׮ Z2-"XK]P|$X?U[Xٿ_{z;cv\PM={ iL_gý`[kuƒ&;'|F]lDQ>5yq||@9 ܋}76 vaC?͘F{K_<5F2<1ǻ"cf3m[`\7/E 4ɒ,_Z"J~y 콑8XJKˏ7.F/=rTY~3k֒a"W&Lk3) ]wzPrW@p$8|q9B]`VQ>^3_Emb Z33˝GΕ?o#SIi2#U5T-R#]XՠK IDAT1PvSl;m ڂeṶ,F(`kWe)5?'?i߁pf&~ fWaoa=Мs-{ohT |n8&`M0aK&H9tmzqfZَ@@g k_W{ږ(VՀ5ylHR嬞dDM>l[uW)DyȀ<"9lXKU,fJ{ b[ƪqk k$i㔱5j ";Xۍ9SPlIXjr%]~a[^nshy^{NвB:2a X&L5kIUczչvgi]EX̾HS@V4k]!: [:H34VnaM* )8a/LSCgc4Vu #c|X6m[`6-?8˒J^ `B= !r+f'rq3{ im-{oy+gl™5ko8+taҺgx `-1FB[c#:5cMP rbߡ9%siǴgKp|HOCEo:@֤?fU\d|R[~5[956Xzzs+.ˀI kTE>Z㆙1 hl1i;Mn0aܟ,aJ1B@h0k  B-u!( C^@ Sc J6N>lBv7Kιgٓn˚Ύsٶu,KӃX ,xHߜۛ(Ys Z'M9Cbנ2ƗWX,dty7xٹ_7"keR~޾EmB/V,YSLi3#;t.Ut8^SaO&88Vĕ5X7>ܣ%u}i#ouȚ)A+}d&=ZּhcaZ2YV5>bzۘO5d-.#AYs.U <){pӿ=. hcʚXLIz:m%u}i#% g%1ؠ6==p[.ٺa홁D'!kIDM%3 ]wh'q,U)57dzd YϚa|q E9Akhp@ kErw5Op#\~/҂%t#_3YC%K"Wg^dm>.r9RّYC5d YUma8"J2k"xqTC4>ۓYK"H\DY}K-9@4;[5d LLd/a-U6IvO|DC#C֒2DqU"2 k kβvQבڟE,E^ ;Z^;́WjYC0M~L䰖2΋LԤ1^ngS&k$FnW#8W$6 k˘k[YZ2m7lIs+<S{,R<C%77mCU=! k˅n^8cۺ=UK )BΝmĆ>Zw8]浅+mZz3ki14(7f YC eϺf-#yHmD֬%rrs8ݩ3̂9Q Ydw̌vKPn_҆!kG5d ҉ kbH7tHm D͢ Hox!k`O`fZLױH\䬥OE^D˯T H٣RJ@֐50a-+:(Gdjed-"%p>"J k kvJ\{yEv&7I4Ԑu,I4YC&SVdRiǽ?mtҢpf]ZYvDk<,TYCֺOai&'ҤWEo -P|hk~Id鯂"O k+&cD d ] ܼJ<;9sf}A7хa u!YqTj<`D d mS5B~VXRǛ9;!k)+!F8ep(0#kω;W`5d Y0{o5սq5ϊڣ[jfˎ;$jIY88@<ƪo/53i&t[ZH⡃`e?ZUu8@<-P'15*2ZPvtJuYC5d-GǴy\E@`2 j` d-Q;:[DB7.n]ssۗdDr{8O~DI<)?R;nɃ:Z_ k&}[~Îއۙ,3|̈́`y _Y/hy6|rT6Vk\1el6uDpS5dڗ{]sY94eE<W֋_Y?QDYTk huJNUq|Clݗ;5d-Df)Y05ZOYWd,q-7Y"ٛ/[#';jp2=EOZDO<axl12oy+z>ؙdmt(G~E?oD,/ϲ~C؜ݿ!kWU+鷉l*`"%"C!R8;-4A6JN`YWM-"% UIQx{L+NIGHS`'Jd_x0r{,!u#}yKl̨ͨsuMj~LH[:> +MikºG,/XENT ̕_10GODTtˠfwY7ͥ{d YK"\l-O@zDr: {~ڳ" xWMEJCWGWhG'qapLzD# FEEP$# F&1 YC$uk7&hrD9U骞u^5u~֭r)(z֊?)~3"ԂCvsQц-jm|9aI3%mjS~U-_=JWM}p,=8& U?:f1hnzkbG-$l!`-"ɞŻ~ qySsju N2Rl9#IqW}ՠKS[N{J0f=V˛*uG#OcekѝkGAAXyP5'6ܷ!2;z?Gog%2sDbh"TN30sWaI3'mjSwHrtp`-U`U>lW!`:3 kEʦ~:tq&`-vY_A8BBh|xvXDfS#uN1Che)_ƉVMcCzZkF霥kie+؀JOd/Sjg7 ֆiAKnT֎'_V `U˂4S5k1pBxrXHoZi]H.ƃ$FR$9e?Htj~V)d1u 2t7IHa4i$t8AvFapA/RXC Dsu2:dqVwpfH%O kkrԀ[V2}NɊG 2(GVGn$/7Ҵ3k ӁlNK,$q'k}hP轭f"W}{U yVP\l/{-d`8z.*+do*Sۊ'MR&DaM֩*j9mUo m'`-H)'ܫ0+%KN0Z:?nΒM kY'?8`VVSf+j%! 6N V{UiwAК> k@G[ȉ )ls, 65T0uta]eQX;_˝m9`T+0OSƞx%"Ռ&c.Sԣ)Ìq:4{Go3p P[ޒ75b!*[kkIv䛞PMW7-d2,}&I,gŒ4 mp>$Rv=^Tv^)l/{S[.J3[Hu _rMTI[w$,䛘+&&.f 67fsz0j0 do9XGZ4UۙXXeD }q#1+Y4S5kёz5<3DZr44 aM] k$# WK@aJMFmNI>Pa|O,GnˤL:տFQyWu{SI7+厞F^_I_9G&nJT>5fO$Z11_5@`Dƿ:ֈ-YcN3a6 ?gMncn( mT/`MZL4掭~p{_z BսٶSDZuo#%iBK20&Pr3ᇩ> {f yhو2,':PQG6s.X;CcVeOu*a7S'MZ3 #B?U%:ԬN)@ɀ5~|s¤q<S2sQtpzHl&t4Io߼ltjZ;=1X4ke6ND 6jsb-kWML/`-l4Xd#*V$k(ڏ$c9E388S>3(̮G}eO 4}Koϥ(jl9"$SU]]`d&\10i\5@@Ok})= k_:kZD sk`OS8 XUN&\n!0YvEJDm#xmo5> ^hCZ$5UZcuogvݙ=|?3ǝ3gd IkoG¦DtZvd Iv71"gmQA667 uQB;?35|itzX]̆}F8lw ]ʷXd [?{_ W7C k BLD/Yk$RÑNr|Wpb6ަ-}>)m\D4N|!yW&ꗆVV6բG k Լ:cz-Gp*Q0fcy YHkhȀ*@ObaKڐ>!DFm/8Y)G!xtߢkƘoeö@n&A6с^1Q/QvIw_9>J?\2DIy!&;Ydvj^g J{3 YS&R '+Q/\+)c>$ O7vs h;U7SYӓz՟֗hdq8zM?R'TY&7_/kob}EeچuD U83e١Zjfw15ڪ?[^̼)80"͘Ic%hmDW}ƪVa frxd d &=%7?Y\Cj<ەBdNS20*Q1Zz}*]WPV%)s7~ZDDL2=E4^}9;M@eY>rSU}dQiO N U}ܟQ6>6 f{D );Xb#dKvxۛDi57k!k)_\cp T](QO2d]̼L_|M^3&-!J9ZE5N!p _75\m0r#l &ISP_zLצ 6H +k ..޼L$v(iM1OΎo>y#)FQ!m?"ւ5A e}RirB#RR{kGek/zT*XZdU_>Y#)J f,ų]"NI]g}KU\J,eMK3Mq :knCyZ[>^\bK>EȚD'YOJKt7C΄hE=`qIv7b{gm/2;։Nx< IgVtbdMȝ[KwaERO1AhUC kv)"^'΢F틵VmO k5XmϧDIUjRN'ٙ$8ɟ5W@%Z$Jҿ@ kv"7Ѳy:D :+BY~FD#Lָ$;H +喯\v[YH d f7Xa!bA7Di?C?O k!RQWKUʠ[3YDZH 69o5{da *ϤE?XO kֺHL>& 2dOo"MϚ+dÒp%X1 lWi8K[ Yٌ(J+'5*XQF̓Q}kc[d Yrsy5d 0h}Q#k6YqxAl Y@%$F>[b"k;q5H_@əEodM4Xa1b&FY{iPK%AWF(.W[h,fq԰Oov[t NҾ ŰVHs?l6U',V!ָmۿ,MVkk AXL39 Bka-I³ǮW\c^dTB[3h1mxءhwO0aRq1#k38jXͧٺ`#V% kA4׃i]Stv NƏ&6'q.&79$+5ahֳRC򷹩 X kReq"+甸,<ck\ _ݐyˇUIfĥ|, EsbHEd׌, omҏ.twJ'͋w%l֦2u{`2 itLX9o?KKo vC c0b-}n6uF.0#gWtr#} l3a3V@}p.I9%oG&-]LnrHVkkQ*zZ* *RC񫴟=Z57k1JCꪥJgJQm`e!k W;LqW-6kiڰOfFݳ8 ,RJxajԏ-[AQyM`7tY0q0 1 63L/ّ{H k .@i !v7kH% s_$R\R ָ8<Syame;եDi7<@``q>98H` km] =FXmMV.xDHF 5g7SŃRFrU"{@d7#Duvڐy5{3 /k1X!k|`txXDhY^vkUl{aeW;k]ִ6>XYkˮot3k{;ݕʚbbPP ?hic`!k sEknbh.d͟ODN~lIn5C/Ć\*&S6d!]|j"]D&r 'm|r*#sCIgk1 .kȋqH=eэ>A"{ϻGqaȥݾ>CtdHo?cHp~LYomϮyْI 66y VŐ[C"+kk$c#_V6_Ywk3VӛCgvnذWl1^]̿߼ohH=~ublǭ#`ZȋXq^AÀfF Gqn0Ҽ{F6dndͿ[ C6ic`!kZ ]YKTt&r.UcCZ<\ѱN3FZ:KqH4SֲKcy{r 6|ThYJgr۟IdOխ*FCdr0h-QH=eލA" j>YXY*byҙFc3xZAsȚk8QKrshmxY&}B֐`C'2KF YZ},5+Җ+Re붡dȒmbs䇉vyqR\Jij˯dí"O:neHT[E^FK.چaEf}[j p#g}OuUh 'ָ֢E^Dv`"}eheэA"SgʖsՅts]]ힲZCd|vkX%4֮a*667_mVh>)yU0/d͇F}᪹7=Hǭ .RۄW֞{[ݽ콣pQ<$mYoT+g76X]7DZr꿭~8OmڪE3?mD%kS{VtxѺ?n-wdpHs;MAy5ځ] 5G7zebö!{Y3s]D~sqwE5Hҵ+#ҽ%5/*ToxֳkcvYCJgRS)+{脊U @ּY~Xfm}<¡|Xuwִ劔ZW tw{sN2ʘKf4o|e-0+#ow÷Hc`8vEhD\4 (knNAŇUjiyd󋶦\VjAKb}f$|dͿ=ߙλdMV2uJV]ԧ @|V?=sCoYhiCy=6᜹M_O3F"-63e-q9-i%%34tfvkR=YK7!f-MyֶL˿vMϠc΀]@kqG^DH=eэUOAAɲ6friK-D9fz;.!Zq뗍mi$Y\5dd)FyicuYӻ#t1/׻vy5zG5g7jW=e-,+M0u d-4FE2wY h-ȋ;7<ҧ_G0})h#,.wB֐JZ,xCDjK h-ZEhnxa@Ysw*=NAVY+!kZG kV,jM!kz.h-vnlQֺqe")>+=Vzuu"k?^E/`kV 0Lzie- Zcs'!k%Й@O*^ ('5d Y+/+YJKL8Y5@ֲ4R_vbe BBQLkeyKTȑȬ%fBi 5껃Qg}mV1Q!kgJi Y8>= <|tP~^H'0!k1@`BΡX>i YCYC֐59!k>֐ Y W &*d HΠ֐J⁵W(Yޢ3k_dBL.`ZC*ߩsQaR腨Ы2[!k1A@YAة5`ZxG)2|,z!2WU LW0A|emϷPGI f+d ƲFE ^5rUm֐5d 5dt~p#8K/TH`kZd { k`k]/_WMuhZ+P.~9[ U竧)#EWvz!RRkab@x腿 U?*5b8RPqRyqN.R #knnUj*@Vֶ쮣O*5@/DDz@d:8r8qz!r`bM֨5d YXȼ@֐5@֐5qs̤Y[CBd2YTdY?{yp<'HQC\F@4Xbb2jZoQTTE4&aTꌢcBRb8:J. ~?d/x|9pXL "1,ȰY#&Abf,hmwSp8ّGkz]@]H1+`:9^e]q @olLj5`Dq)Hb #סnFkk 5bXXXֈ5/73kvYL!Rsl~o2JO IDATkx5kv&Rʊ+QYDd<]eLĚm#_װBkbZP/YtH⪉2b 5HkjǪ: >;CkX^RbY]ǚکrR§KG )S !UvD"XRNƇbUkXӒMXS37XQk; F5bXøBL!\6Yl5b- QDa+jG;][5Z#h[eI vXks=ŒX1{ ĚM%5VYp_ŒX b͞;!ckYA.̈5#>Ě}#Pmkۂ"n̈5 ڑ;wYPr%XW(ɥ̈5 @q)HECr6&̈5ow<@j*=L!l'j{xʌX"MHSmFbVg¬#bm8bX#,i,f)|?20ʝ94fk" , 8sUCV;W3b )Fb͆W)c! ށsJ-ޢF<#` Zo` lg,e < Ml )c8@YCNq<# pT˘5. 3b tfXF!\g\63bX#U\ p1jX#/5b Q 5bXXR[ [b N@kk-mdaˏAi$hZD+99)>Nkk-4GXLZ@Iu-<.ш5@"uj'㊐f bx"h4b 5k"Df@k3k¢=)k>2kvq$ID0iZ$2WXΚ@$)dGkkUYs Ԉ53'Nq~4T*g &i^ܙq/mc5 8YG\eF @E]kY5b vZ/0k\Bk/>Z#X5b @?Rt5SfWn5N}EL85b ry 3k6SYPd=S0vqsr̈́X[R|5chþ(!{(y+RMz\5e'o~v 9p SՏcV}ONN{یa7GoٚkwE5NHS0N[ӈ5bt5C dOݎZ>_57ӻKbޚOxio6|SbX{G5,3i ֌z'h N;GڍXQ<Ǿ₊,U:6_ꦻU9<r>lo'j[c|ћvkfZso5O[ y7kFڂ;V}k r|'^1H I:8JkJT>fDy/B\O_tfv6R?j5Κi6f&M+v6 _#DE7&)ޚXuO'=7so$o~ޔX3=XF!Loxd uoQMFOIo=yF5odoMmV->\fkhG1ޛ j>߫VؔX3Mҍ>6%̎5VF9:.MW/Uw_uKb-sdxɦ߯썵{@xq_{{UT"<{Z̈ghʖ5ծzxVˮT}c6r_k&ZΣ\q=fTufekymd@Bq_yz{O=wF-#P_L0J4(*z"'ެ`D g4QIq='H"j\59'3=Ƈce'vOWw!k/Vo=B!m{2!LemgMAؠ4m`gfmM% F絃37Sw:7e^AM8E=[ t)Sbh>cU)kSO3qط6ԩS:o5V%+6 `K j . :GtQHĔW8] L ^ y⼮4ZzVBѸp?h'kyU}_vChN qiR䕵r?liGAZ[o^֌1R6⬗5͚2X*=.}L.kK|?7eV$L A,]w$L:~Xe}I*~}',Y͋]@mfI P&1ggPe&)3 k)Yۈ NjdZ;uYujl!><ţ6υƷ6u4qXݪ.77:`~[FY#P(ka)k>A!EygezͬM~R{fֲuY+}Qiy] ?kCnO]}hyt}ҷ}|>9TF76I./˳JYV֘B[)sD$Y{d(1#kY}68j?em6e';/DUsn)2,3Y>w6ua^WFSK3SyL`mP?N R䔵N0_%DZfm͠I!k//k)J#k@YCCVn7@yٻc)k*gJZjⴷM$,yRɉHXՋ e^=5Ѵ-N,!MP*eMNY2UBd)kRȚ[Ǧ/kJaG}WebHxK5Dque淬͛Z|Eہ䧝ɚ^/ok룲ߜkL5NG+⢌Ǿr"\UI)keM.OVLI!k%^Yѿ\щd^&06ރ쫿*96^_ȚFHsCј@6iVܩsrqCϾʚrv?Z!pX-^ lrۅ*E;)PUʚSϘ'iR3M59d-f ÔZMMҸ*/YSԌvݭ{jN[ ,ɾ_NO)5Bgc{ڛ~WaY\`˻U@W{Y+q5|`֌b/ke|̹Z`Lm[bm[lT&刢LWeI#q&)l!kɚ2x˚0zۨ{;s;:Y_*HX8۔5%-7]6=Zd\vϾvޢpkͱ׾2e4)3F+kEgyd Y - ƫR5f5B,Ж~18c }º7&eHns(k5!D:f/R٫/eFW#֮p eF!%w)kI*!$""FY#[n+} е_NYMvR !'5!vad7֠z(kRڢnTB|5!ذAYku(k nEѩeF!5BYkC9*y,Q!Ğ6WLM !(k5Bbe0?0r*hcޟ*BUiiFT"Bi/ 6^Z2Ӓk"\JCK;e Va:#N6f1I͒e_.vE|XzaniYr,7 &@'?<$P.s-Wt:`ꃹ#Fθ}Zuozs ֬HɫOiY &Ҽ1`/w::NIbImJbM@{7beޜ\ teoZLw;kO~@V Rd-ȀkPi|qH)<~{u"F./LckRg`)y{ᢴgw }↯d핂knqϴgg-I R:l1tؘRw a怲y-bt^~Zx~Jv#o.ڲX_|+1HGӂeXc`o #6G|秸3+WY>!:#b 2c{ <8ה;_ۺ @jF믝 (bf޽of) XkgdYlF]6 <ڋTn]Ֆz'Z@5)mkb Eq/nxn[+s:S5Jl I [MZLĚX>8e쬡_?hL~pobcm_cZo |ƴE5-h(c\;[tX:i?+ݳW ڭ>)N0:4 #k@w5pꈛbMjM5k5SnoZkr?|Լ@Wkb `eZio>KF{bMX+V5zPJ5b修֘$]Ofܝv&@YzҕoʧmV5k%6Z+Og\R#yĚG5 >n0 55Pa|)6bMjM5\zɂqbM6aLl6 kL VSwߑfbKŚX2w5 riJ-9)fY,Koֈ5b$RȊjSd(olMXk Ө& NhXk JbCs7)!fm8,5/g'55PQ6OgkZ Pkb 5Z^L*=lR^xҞ`Sī%?wp(kk k֗S+gÇdd8?LFT_3U. q{=W=ΥC9c{ݫ P9.XUb 8{I!.檶kTb _D,(  DԹt(`y6F@l=2֛ױex;kXgו#n.[ #fcl 1#2>۲1ЁTMXkb ĚXkbM5@5@5&ĚXĚX&ĚXkb kb kbM5&&@5&ĚXĚXĚXkbM5@5kbM5&&5&ĚXkXk ĚXkbM5@5kbM5&&&ĚXkb kb ĚXkbM5@5@5&ĚXĚX&ĚXkb kbMXkbM55bM5&ĚXĚX&ĚXkb kb kbM5&&@5&ĚXĚXĚXkbM5@5kbM5&&5&ĚXk@pil*K|'5fdKΡ+wgcKl tb}6F|F^^P)+w\\3 XU14_sꁉ脺32Ar~&#]rOFFb  kb Xkػ; Xr3r\B%\E D0 i2C%Д,δ( 8t L>{dwϲ9{s~s3_k@X a k@X a @X a @X a @X5a @X~X}u=9٧ǝg. Oh9u[juͶw5_;82@;/- @{mӡ7zΎȀVd[?qa5[_^5xX) On,LVwG99Ѷ\-dOf+~6hR}`wj k >0Pr!9?Tz[j]f4YբJi*g\afFQyjgs1xR}`GDX೦ ' msoSuf <]1ek晋8R3n?SO~mkt=6zQt?[^^NCwp e޷5W_mjxlMt_1^GVlrŤ*rXĸ<;֚#%wNw*IDAT @jge,6 k1NS5_nJ\fhYC1W*mi>V=ޭI6OEkMDX\5JkSO^bV3k"z*9el0V/r)˾ i_ZcQu:2Wm\qTΏBoVt4 a*k~Hܖwω(lEGiM*jXkxU kOM%ytA|^V?l:Su @͖WP͖ܷA5C:PBX KyĞ6Y =оO-Ίi>xb"-<*nXۨ!4}1]z:6s/{'_TֲۀQKY_oKΰOskU<}J~+_{ě-jX־a pzhyVw.~Vlx==w _-fK+f#e۷4-DX*y!9K<)+Š)H'/zbbsDX#.ZݪFiO໦NjjN>c_$_)]MH[ kmq+?Si{Ιg3g"ji^GXK=k 1ߚ?x|xe RemͶWHͶGX˲o k5VMc㼗EgڷKT2QjՊ5&zQ9M7^q.~hee p>N ,,`o獵z kq8ir6yk@c-&~gX}4Xkhimv%bk@c-Y|XʄNkU5ٱvg*q9jH6VuDI!W7kϬ#Z}xL+Wle-]?澟t.Ne'In}YVe}wً-sF1+vJ49wDϧyLܰ}#ڤӱ[?.lhW1%Uk =\kNNo!OL~ޥ=k5.iwȑkU:e"[_ik@bmإSYID>y_fJW,G~tA[l:?}yO_}wijXڈml,{W[rF%, 18X ր&Z͵FGΏ4sp0bZm팘[|GRk5qAa=k=FlS!.37;&\&XkmۊXh\Ywnx_п;TkDo~5TbZͮ3k jX\ުeї3}rXo]'Xkɉ{z~e\>\&V-Y}GڦPbWDOy %Ukk+n_]{ֲ˞^}#cͲ ؗw=qk@b-y=ʪXKoݛ=ii,ҌW~-ĒX={y7o\SaKFY]*zf}4pOV}UU lM"dr #Iqm!D&m#eO eV7bBYi ER٤ZeB":& LBø$ )+$!< &-{Uֺ dm! X֤<eBȿ._лGOOp?Bȳ$ke%weݗy謩dmjBY#hk+y S E(kB!'f!U2b \nһK5.Im} Mh:ӀRsWfYsMi9X0IYv 1dėˋP!BHɚk $k=s.-gW2}'W&=v`)zd5)E5ȚÉM7 /\ S87d< F!Bz$ks3^4gX4"kWB wg cT`Rd.Țј۞YXh) ]jVǡOg7a,"5B!Y 7rG PIu~~*ܰ>yiBďQ=`1v qMJYsp$ed~b)Nߒf5Y K)/BY#B!=54y6YT xdt+$}%ݠ6βL >XdqU\-5ۉOȡf5mMkAB!^5irP\I1s^.p&k SB'2dr%'i1ael^)SኙjMS'Cm f;dͱf5#o6mgbx/BY#B!!kR8&k2f2Jr̓8HqנtOchJ ,8e \ \oxbSntYM;X拝*p}!BY˷zdMlcC] ҁ)|_Ү+kBq6%m(quʻy<5Oy11Vo05i_Y#q}!BY{E2pl5X3u0S1 bk^ q5m3)5$YHfnDjEZQ)D v@̞=ꆲ9˘]O^^|)Xb#ʧވ٣Z_򋈻 SݕK#fFvq`ID󈾱VxWf;_kEO%a8˘]:6g{"zb kT1%N;4>mz&bԈ\U;KlL|wĤ1^:ÎAޥT|/InYw(Z[Y8Ɯd$ۿ׮J X|6G5&}t@9|UU,s*Wd+鞻+mcF򞎅IEl]o k{WΪwx*u3 Xi IҫU.sGG 6-]{^o// +静5?Ukގ^=+lmui,s^v΃ :beړ?]+.}55c{kwNqR7ZeBXO6:Ӷ!Xk8]_AdiڑwZ~+KY̳x} ؾeNyW.,X+>IjX߰~i*4wߚQ憲\\t^k^~fڞmDKZZZf&棞έmpvi:q IDATxmh\UO弜:Idv&iCZi@͏ *D XB MA@Sl+R+jHPBgHҙ|̽31]$\- O zo'vڬ۾qK&D_: ޖvSXm ҉^9{b>6޽{ܽ!8K'zdP+5f~OnC]{vZ 6q ܣ{@XrZ.o{B+ufF, J~N: '̽0j^=1 I%1}ʵ^ݜWFOʶ&6dɕԒK)cjޚ}S] \#wTvK@bs8*Y )cg{Kn.xX EX@v8YzwDWC/SlӪ0ոZԾ Z:xXr ۗo>qazʉ'9E5B} _Jlqc}ŒY.֠yze$znWNӻ'-3U6i>SuYF0xQtM4#~I[cXh^U.Ю鹫29;MUcw덜tjz9(~=Hl},3ͦo}]4=o2!/ч ͉ hx(5%)n>jFktl_bR@ٯO48p7P17X;ItP#=Jy0wsCѧ9imyՑͧzucޕ}6q;=1S5ӯ 36IK=nCfCg;aH`~I"s4ۇW-:l;xC$7:jqCՄt>Os^]=$j(Ak~e߾jwV]M;xAtj[Wһ(sLzU{Qo Bt5nwﻪyWfT}gռsL'Mո:3U@U"kTov9۪|D_b/zu{tqF6 jjLgg]ӽD=1)Z^h; o@t?3fJ-뭼>r+#x#\'`zz/1VJtwE7lil 裉iwPELϊC]ԡu5+Q rUE eu)C'`aŅnu] uD_>\Y Rr'LU-3z:V}WA[눾l+؞=5(zU*V,2ϵV}U}pWdSJ ( XܖlkZ}lGsUd\*_5f,l-.K *)'>R- StR =Q A]Ŋv FU`uɖ9u/}pWdqz{0XC`g`*ْMӀ UyljeCtD X_ɖl0CkON^%[pVe#:{MAlTpAtDAylɾO;#DͻdKMDGt>ylɢZ&[OR{ylxf#:{JOP%L!:{LtldK>gtyѽ%LldKr~]Gl^3n˟h0ކLLT%ztD_Aѯ'83TMi'OZ4.ϒ+*zt})c-dK&Gu-k#ʉwDh}4&nWPXދLt5>3.pjЧIdC?Px0ڗZc@"-ڐ=vv@vh 1hKRv>xxKg,xM6%+l5KR:@KiOTR_/C)ѿ=u[%Kw@"?$E/ D:6KOLbn[vWm: kѥ޾ !Y\ )˼tO1 (s@PH?{qcx6N- ή8 H4FDЈSJ0NU l?R!UUJ0`"j"!UWwfݽq|;>z1̼rS"H=Sk zHR%e:!笓S~~vL;I~W!U :/`~O(_ K6VҵNl[)_Ʒksԡ3S'|Mr^ };Aww43@=I$,#tc~55:/p&-H@&s_Fρ1l5@SʦfŅ WʿSʵdM{хAzut,DLЫSׁj>{ З:5sZX{A @ף?@wI)u5I> bA7ݕx:ЭkzO~\Qp9 X A 3?N:b}=K6紮`]0~t .:k* (^r$ef ^DT(oӦHxtrŧДjhHHm?Cq6{tg6u8S'!/g o"shoa3b-Sbݙ[u\j92 Ww0$XSm- a6y_j0K [6u8Sg5hktWtFk*A1!@ɺ= :{6l~Gf^8$H@h :-ʠ5hmr=|g\I3rɚ:l4 o譯;q-#]؏>ˠU+Uwh g YiXFu`(RO<:pdܷ3+yb(l)oGuA0ae|ę`ǵq|@b,=+/Bz9ExAϢlܖU!܂;ataZWӚ;U8rJ'{eK ϼ l+^ӿZ|#=3[+~i& #s~ #G :/t=/#zƑ[7t_#z~@ϒk*/A{3q]!LXJAGt2Ɖ“:=K6NLGg*q ڬǽlDA CtJk@Mef:ف[tAUU lqOP(D%~-3dkt#agL4#s :3(~i@/ETR.ś/ړ5بRSZhYWG=򟌠( _sT#"lA r 1MT'c&i3Qгeȇ'(蘏Cs*H]ێr e0ns;ǂП AI*㫜1aL{q>kЫ1P^.]+#,c}Y% ]_eV'~j3Cg z@^.] Ѷ'+C+qr,{tDϖ#W-z 窻S>܍\2M%>p? OU,8ql1U wujJ@5"c+l&݊@5b} ɄufpyՂ_}1Wوn+ꚨQ0`?T_ޔVXI9C6[̫/U\CE}ݶـNXmhrn%42 j>{zibA~@Q>͌~$%?AT er F(5H_doThFEzkqqT'N |\2:jDА;̵}ٝqDily[Ddoz@'ujzY%scͪ_ޯM6j Ot]a5xtqfT6!瀠%'0P&9߈n~礙KFй(kY GWa%t_wُvP0Ч >fh~҂{8h%>Y7XLm:ƭ)+6ݛ'!@]М6J4[T/f >FQ'!Hb%#tU+a{yי>yAx!DE1dDT%"$(V+^R/]/FM4x0jHZmbu4Vg,kcT_dKy.s69:{><90n^z>x]1b2f>.?܌: ݔ[\%l>4ɂ^h>f~-}("bXJ8Հ8u\SG3mziż-HSb+[fzǙK]\L] e cb^Cj) pŸqz^@o};a6Ƃ&NMl7vPRjdER -n=3>F>~޼36\xY3=)bO*hpWRI#=ҨA7u*Qw!̫ bDFb /3tz$ m0GmB-ozJLl,6޿P浧FS`S;fӏo(! mVWF%l#k~~ɓίZkb HEt 跊 [wo847ujj`D׼mtBRt~yԓjTo~/X2nvoC$}?U?XIn}i# ayaNHQUP"WyFBCVvD3U'z}bӺLlaudߏU"XZTN=DZ+ qYO4dG[ikȚI[+_:& ] ד>-4m7?̷t'%lb[>_zt.tJl,y)]{y4q [&{Ә|{X>}%~['97z<袝T|@rAlZ+H5a1 tɠї,LwT MH]2xxbK;K<l*p7 C:@ :{ŸI; 8 C:@ ?yN+jiYtV)3lV@Hnm=w}"!.t2sξU]ХO$e~GiS)~Ї_µYH٦r@]f޴[Wm2eܷ.2bmJ~лt23v[ju:囀i@~w/mдʶp;9@]xKU+V] IDAT$t7 L;mW.\in@n` gz  .y*o1 2@;v[p@a/v[bp@fгW(0s3u ҃!׃: WtUp@#fX\߶_V:(C=y,F7[._*c!1>q ҕJ7(åC=?=諣헨*Yk5S6xK}yt !HgY ? 2tŠBTQG@u-'ls㨃 :`tŷ҅Kr-tW@7 !J hn \:n+K՜S!E]SrVIpA=Xg灚g@u-AYpAO! xF~kGT~p鐋AKac? 裌 Ӣ# gåCfğπ.Z>tZRC](84 b^ˋNA:[WåC]4{]<[rt 7jVGu-AzlmO4\:RЫ)xA:ۨPåCnNߕTʒH&/W$.r1[07 ]EtŠk~s#%A"US qAn'3$;eJ-¥C]yc&p AL?:C5ʛD¥CivCU,M".C}ذ\񣓼C+[!/N*H_i Jz=蹥4z t|©tȍwԦ6PSAl Q:ԋAkt|=h>yYpŕ-p鐻@?駮*SE>yt?mpT}zayYvd3K@JD &dC佈҂DPMAQ !"X:P;RF>ДL봝Lg:'&DgMs7;lr/d٣_)鄕I|g ,.CD& JgJĩقR3PvnGvH)>e!D7UmvHS"IVb\C=k'p@+D$ԞKJ 6եު0ckS}f ,: R%1YIJg$-BYz8z=:;I_*ۘC=tsK/uOꨕo[\b\C=κ^ޑ+xXҡl^z>C4eN{>Ќs^:,'tp{U"{ tsD`B3DG|S#BY:ֺ<7nsLB3ҡku-=зYIA@f`Pvn5g9fgW^hh0kP27q;I?/夥Czu]ybO{[I?eIi8Be~?h N!X.KY<(c|{IL=)TKy4 :Ur@w3R#ҡl=TN>S*%uAgt^'n';"}NZdFH?@k Nҥuҡ%As$[B+ K{SKWD$cBG?U}Bt(+@^$۪j}V?GCAy< o gS|o?BA4&(c;IraKZ#P6@Jh ]c8IX:!On']~8yX:tCJ?32gY葐6C}\g8!G?訕1CYw+8d%钫` Y~?, +XsKղ:β}OBZAv'IotUzCX:tWI%]kǩ߬JO!{L*IoHجXz+:'KzjY>1z%tW\J6ZpWC薐6н^ax+IKN8G9Pifmk :rCA|[D~slvcYTybKH螯0cb5NVtiU1cUM?E5N'Dlr*, :WSˁ wySQNqtldՒiI߻tH'Z˥c(Q]X/Y)y"9qҡzվT6Jv.Z|w/qF+房O[(,1 `i`J~9E\^@u6OEKWnc> 蚐r/Yx&q>n5vs@aO.&c tMH5t 6Zc,`t(A2z1F 6TzCbA3H[ ; nzY#M'߸'E!=ߦ'K˰t{ h8ʜ〖_,W8;eQBG^=+[ .4-xa2Ћ9A`h~\]еϭD6w@bHs!uǸr8~K^}8qM {2-)".~N4qQ}9pQ˂eOB*@_+s ~K^b8jqKRU[n&%sܡGaB.KM󼛇M)|?,RDEG'r]B8]mK)=( zt85\㪖[,RzHYiYSu$< :[]-#zJOw`2пPd~e>C̩rBX= +}]h&[JJY>ItUH Լ۵`rRtH!C/9fq4rSRװt(A/t̫%/ q|yUtͰ!UsNJ= Vl0ksf3ބCj@盕 JTdΊg\Yk )3WcUm\ ,R:}^0rttse~tͰY z+t-@@̸آq ]ԁI'[4ΰ!-vEeS_!Va[MsFdX:л뢍5z7snh4WkPSH҇!^ i.uJ6҇!_7#/-ذb <9b0N#܄>M pl!9Q b )?#;sY<\~$ܭzG{Y!Eul!*k^yMJWU""ECDW/nyؒ;>lnHߍ! ]ש!8Wˉޒ!@Eȭ8K9"{!/z궨Xn͋!3B;U)l׽#,Gt`C'd"`ۢbuBHH5aSDWlǂRDw-kB:0R܇U`yƈM$b H EVrhg轤j4sli XY:[0Fr)8AS42Ft:/ovswDAӃv骙j 2HtՃs1X7-&B:0RthAF>g,1wgLK]:XxٹYč-6XV B:0PȬ\=}V$zߢtm,*,$Iy>ȁX D'Y{_âAǖ4ܝq B:NBѐ&V$:#i4'1.AR^I)Kt#D}pwM$U Ti!&z^f{xQݭ>1>wWi5APWɽF'+ D!$~/Swz(U 4s!%:BGFN65wfNZ3~7tbNdUZ2L}"ik,k~ щ2j{f|B t3gBtF&PrqzwiFHFnhRbJ:=.Ɛ\tCZ8:3DC" D75 jqF/! D76EqCכq\`4B:H&(u Ԣp+iw'u~0H&(-ћ): aRMjQtbw}U]V򭃍 CH)ܤ)Q1vX NjQ>qhOk%7釐R*I-m*=mCWS Ԣ$Ny?46,}{ Vge+bc?  .Lb-nDHf_.aur:|d83%rL"T9\E/ r {&ߣ7vc[cR[!1Ht2[z ^Jةݭlv E.N]t`mD٢HǶ8vvu7DHS^f@/+lU\HEvi+DyanGܤt٪ᎳC]4Ȉ^W~Be/;G#kIz'޷3GHGV0~Au[,?A4:v !@梺-Ro6E| ޥKO 6!]O=3Tt}[!sfKc*:]Ts{y|UN9[a;wlњsVL p9uRBƚRt_ |j#LVbXo,e)E;1[8J]K0K'Z FH>DcEu&Bzw>asĖΤ N~ h_ڎ(ɢ90m:;24#}T;n7XtEe"nh iO sEOݫ4_2_ݜ/E^';l[X8#&`L?>DJt*k ;w~N9Cz`g)4#zz%ELEOiJW!}ٟv֣2#zCׄ =R?w:FUz"́JF='|6)p7ڟ?5"'zQQ/zR1Y'ͬt́1G"#zmXG}&ƒL=]7+?깈n13 -zr>Y9{H?nT[<>-zr>׶oĐ/}/?=9wzA5eg?D]ѿ;l׻kx~ڢwjػ'=9w-`9kHGg/(vjO7[]ՙ*{. ( Eo/鿥 QE32[.Ȑ~ u".BzBσ-w E"/,w2xѓ5"Uȡz_}3E!DQm'\~ͤ2[Ȑ>aJ]щ6ABtZz3[$q(*4DE5,rM}rY,d;C:cJ \r~*zV#.-j]h;w`t{gs"zqh*P$쥶>luax/w0ܩ6WE[cڶ*]z" D&Ǘqomwc|gex\+}|YWǩ-ؐ p ~7fdUՉ C*!zV zl^v^NV%/]緊{tZR-v6rbS`ǜ#bw f] q:9+ݮ]; /a3r[DonE|0-7E3Us^Z+/h z$KV cY.t0D4N /id䶀fNEt]jUw m]DƜPތ7}b(P~"2ǮLk@+6"6]x󌶢%NS=X]kBXDa>+EqϏ%5Y _5/w ѷr_df.r1[ˉςwP`dm~[ng?-Kt!v~c-,ỆI"z{_wHOe-KX?{ŕ7>۠I9[FƨA"^"2(FŻQ#x7$5/mMU1Vk/e윹v23Sy> SSX>ﺝ+û䞋0B 232nkM1У6X,}sP,N$Pb@f k-fՔjali}k;LfQ):nBw <,`e.A]i%IExQZy6FXA=]>#;kr^\Gl^-(nP=ڔqGz[ V 3mzOՒQNY/$v~-iK=Я/ U~ya6j%b&*/IV?'PAh[x-fJlZ~Y`4mY4Y7cьѳ*+1z+@Va2s[3.㫚e'2YATܺjPXܖKFTz\D >NJɿ2wt* {Eܖp(J}xY ,;IOg) z4.Ҵ%Mc%N{fzI`t>O{Z(ūDh}M opgA`%Ӓ|BW{Ʃkk@i|]gU4@]7 $=cCG-+˯0kZPcUҹVfQ=PFvb"@_JB}[>j镾Ue =BY+;juDd?s"O5ħtԚɛBI 7Dɮzwb,oUAxU [k梱 zwgq}ZA$ U f$jDb:@^~-Ƭ\z̝B]3'$Nz|MXÕ3[x:!0fS IDAT6zKn2Tmk߄B>XڰQ&q"sv!1!EJZ3(z|H1clzsAM]!jmD л՘|Ӟ6=_(YA[$^<;vkRClb֠垼^tf _7Z,56hBMP҂>*RhGR[b>8!&Yl]tq`jK2ؐ;?_lRrEjCYl\Q8PVkkͤbq }AMj;V嵟wHExF=v'JtP7WTP(BgDvGDd4.ԷGZc=R}pjk6vĹG/6AƄ\,EA% UeZ2jSŪKVK)VɵB/6A{& : .-t~mഖ=V;ֈV vvP\;@ʫo %75ؒ~ZpIHymXz,ܚYW.9k9;@B}Wǵh>S9ʽ%[M{,q2_CPq.t/YՍ%IM-5.,,B֧UaDG /dyo;&]!j-Wʂ^7sKqcTyvY<Xgܰ NGcw%ݛV?;gt<Ŝz *~'V%]?n Cw"ʠ .S(AcDYQ/_iFqwXl>y@9z,II-!}h^/S\j&tV260ޒ6uw"yEq8NeT?2Bj^<Y*Zj&X?gK:z?asaIR9T߼Rt{Mz\yy@NRtGDO&x8:Iu6D۶Mjr U:NRt0۶VjgҘ8gNZd.98,:cj(=ö/zU'/zT%|iK}fpX4Q?sfa4^%s#n7%Ѓfmy>{U"^OR3{cЩוt2iӏ7']%FWe( :dtGWGt@ANI`tiNݚy` ʃZàOJ:9M3)-TP$tJc!гX@7*P2jM-=;_:k/¬I=6 Mq!&oB<tAH^й5;cw\0oPބB0SK/y~U;fN@|LilL\$ Vi#,OcXtn_ڋzP;>Xn,NcwLӕ9ʶp.zH_} 27K0?+ >W0!u` ɛ d h7\ ֕يv5:HL֔xEС; UaIw뼟6'ƆͻbQ tԬ߻cyMuXZjt~~_pڕ[&;[U\8uԠݩ5%ݥ8Xڤ*J&l:@fI?ngNK$.`zKzA+X$6@O%pc2clؼt ;>{u:%NFEB yQ, DAAT4AZ0[NSgtM>:Y9{~x8?^k=k-b"c4 =>7^G?>M( !=+eqޢ~tI&؆Q z+}N*~7Un8n3O[hL ެm[8}΅ԥnk)=V}{e²P|F7]DwЧmq[lS(aYN7=U|R:@2!+9e{N7C:@em c"%,[MO>/0aWz$m; 0X}ʶ;{$_M"E{<{R~t>csSU6]2t>1oᝆrkӵn}>Pզ:@Mux^Mʅ@4\_ Vqt>igCB.=&ҼrGA @A @杦`ky.݌gDC I;ZtniPO7S@Sv`khm c8-G^ȱt>c-N o?z];C Gp%7Y{rhg<Ѵvю@A׺DGj^܄:6Чm,\59mY'h\eigtXOjyR XO_@S:@kG G">\:Ha:@ъ&̙Jccg9ik +]Nc+YI kzshgWjrGnW^3N*t OӤ-[ylO! :6${(t'-Ry[Uhz Xz75s>7tЕ MW}n:+6Ai:7v6{MGc)Еo~VMߝ5-mmoc^*7kz~tЕE;T-kKfvX98Myʚlbtqle=ZYH+h!cQqVuAmDk>݉pN'Z!MW%[^:tصH8&Z1VȳwtDN7*Y@7zEWen5>]5h 2UIӒdUQ-4jx1te={ç.* ȩvz3"  OR޵aεE?IIHZyS;OT1Zv 9cA_V*%ɤE KeN!BN5}e{3;ڙ&Q8нQjn:J.r\x)\*g*8НdhV1U* -gT@ 9A|H5}m(KK@?~F,PI \LܷR&:fotU[MdiHEg)AOp>ߔeF{2=`Cz^E~4%恾P~@>ֆ#iVDV:dT6:wA 0Х̫%Es﬘'϶K_џhwU~jlaz7hX%%͟m}EޱhwU *pRʖw=L=if7KѝQMVq:m%QY" w@_;4ߙ{4:$*ek԰M䯝5Dn`l9d }tz)s@|gJIr%f21諭e z_Lky$+Rꯘ٠{ȻMWƞLp9(2z7t\}m,j\fY<Ƃ-܏&$5y}ƾJXh4{>Y]F@k)n<줽'ڽ=Vu):t t}ރM_ XMZ6xU3QovU[HwEވhE*@7t @jkO!ټ"#zV1)eYbЍ]5ccln]T @7tc;*R+y D_.FN;FzQ-]V1@7tJбӒ0^uh=%_y/1 1,@78n:5޳6N!>chɘnC:aMOOsA!n2n47=F6)x%.!+7},V9Þܗ&3n2l|}2ŤwV}O]cވȼɠSK96 jɵMy Ѡ{7wb=QmU"\(^w7ۇR6n6誱1{zg 6i>Qɠ a7l9Otweɠb>PmU\x, ɠ+xr,O+>)q=XeN3  ;u5pIUZ:@wz*b)nY9LjfCr v2#[,֒k@:@.)UV/t gއޥqP.~Ir :;z'3J:rG8uQW )y趣 .`U},9:}e]!v-g+]_yeuSV;>t&_PPyWsϋLtN%ɱ}6y x-^Gcm7w| tcͿҮ4S*$7@+<{CeLzh0tKs0b$9`[^d%,XE a3E, A$rC.H{q+^j搮kÍ">jj"{I &x$G {j3nfCV7{`z$] HݸZcoSw>)`'4CrB:1}I5lC[%1l#jRzmQwH]V-RQQTP]?8.t6puB料%J͆>D3qKGŠ76.nLOtC!Nпk`P6f,/jP_jȻqAGӐէlP/${Ґw ., ͽtUi݈w u]LҧKx޾/Ir#L9y u]X}b?/J} vI1P;ğARy}5L _%1Pǎ:.*磄ln^5IR{[8 _y~c)'?cԌ}6]H5Ʃ Wa;mWRAQqfr&!ѧ5gm{t]@p^&78}̈́d$'_V^ATe0$rbH|| (F $>G3<8!`:a\̅f·^>]ߚ=UQ8PA)/c,)S.O;]xegКMnzir@;oǽJ uz #*\! ,| utt?K"܅'{Xֿ>sGc:pAGT]XI~(lу u^6b5c8Zk^e}ḣoZ2S:vAF猅NAb=Ꞵz^ꠔ^&V])An;|}M/u( V~RQ/]!x]Ի〨OZ a].5$6Jkb#MClsk&67W81 . @^HevDn7 :.NCXW׵ F,~/  =H.i\}PnAA߸/tַL~GWHް_ޚA'*.y u@tj+RL:Mvm%*3p6!lu)Si<(\6ڟ4إ^xary޶pW Z_)N-}e''#z,jAGEqƅ)E=%`su|\1ufݫ{~= zLw[Ğonr}(D&Wc}{]4uH5:̓{b~|wMN 3}jym1= vY}UQU`nhDd^K]3y{ =$Bn{ĸIe^ތwS 7$<ˮN*l=)}wOZUg̾xu7/u]_lSJIYi§YQ;Ėg߭O0<)ک. Vv.%˺~y|J9"c <3lLxr?z<! ɒWqgvIlӞv Y-3F3T1v7vx7>p 4maW] WJ P1X`d,C$'#o1Ӌެy'D#g6Xwj_хvINVPk2k-__ ΧyQI'-''®2/^Ct2Cwld hvv'Ǐs~yBecIY!$䣒+Or>-idٳ^d~kכy{z`^uH̺hUE _٠FP[pIZ1Dr@auynRoxsz'On ck]kR.f+4HƉғ{Eהjf}@\ysN'0L'޿~޿ Z7;DFyCm]򸤳Wϣ+Z*tozdĿW:]2 iGߩɾ_u?1#9U8ogVHk]Xü^Ye;^Wg eCݥ5^> ) ּ'גgWWO#>ѾTF2{E ' c?yO>y2<,0"(b_ݮ$o\G̚+%9`s |"СN0^}TE,_QwOC"X9YB@7J{ Pw6/VիW/^<3o}6N@vI 9|~~Ŭї _{!OZ|.ݚR)Son) l}4go޼ٿe˖/_RDwox./*D_ʫd%Ǿb-A]I1Wooo$_ZƿOCC&mgB|hhBBs_j۷QX@Zdޗ_t7c /[k})zZ.Nz#@UJ\׷x\HM`PCH`@#m3Fq/~a޳k;ܗeG x ڋz*Vg ͱ'_zH+Бf%@&ThO]P)mY&p > n@|h@Z j/:Ø92 :<ی"_-w'B꜉Ξyg ~'KcH8VYr6Ɓ-Fd5*Ip$  0*;ma^-ȡұ1OVXڝv=G|8TV|s[kgݔ_x)Q5}x'^]f6 :Xe_w]a :XtZfѡ ,iD`~̍q:+e,Y|1a E]99Iqk.W@tD@t@tD@tD :DCt :D^AtW܇󙭼n-6o>>e~;Z^n͚mx]Fެ\FϾuyy]݃yflD!:DCt!:Dn!:CtѱyCtlDc :D<!:D/a?[8y]͚McsnrGy(~Qst9m𳺽7:?_X%Uv8BH=XQyp)eu+7lWep7ԅyH5G1iE3;]l񧼽ND|p 02cH4M*cw4.r +HC$D&b2Vw>L d+oW𚃐~f;~0fEՓ]9Bг9wnrI-?ztCٵތ^5CǯaP׊g2^f_&3mZW]>]}ڿ/ 7%`9ǁpzYUk'ЕIa5 a ?WVrH`5xާ'z͚r*?>[oZ z+(q^&`8xPaq9^l: j^{ znU;v}t7YA/k-4`٠ϧr&+yޏu_/G𬠏\=4Aߗ_+y.za%zf{` iI7}v(dWQI&q}Gj2D~ӛi#փm%'@[}WtT^{D,2Ml]+]-+~[m]{с; (0 ; Qo' .ueŧ$M ~h7:0Z`ݠneq=ښRv⴬}T姟[D0LnKZֶҋj#tWsל.nuo.BAgA@t?1IENDB`metafor/man/figures/selmodel-stepfun.pdf0000644000176200001440000001536514465413201020121 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20230811130745) /ModDate (D:20230811130745) /Title (R Graphics Output) /Producer (R 4.3.1) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 2962 /Filter /FlateDecode >> stream xMo~ɢ _|n@bY]$6Iۿ_rfdC=Ft% 4?|5{Ryq'Ys?>||üm/m<׏ca-X7G~ϔBP3B~a3ByBi3R(p2F3B1hr e1hv e1hq e,s;)yvzS eCcP(p=f@]Kޕ=P(PHB#cP(Џ@#cP(c}OisX8Ԝ٨҃AQKAK҃6j+=hi^zF-Cؘ7A=='6qP},{/4j{JZQGAKPܿ36e[/qPcωz)=hikA4j-=h҃AmQz8y[yCcisb^JZZzF--ZKڨqP{Au4gCccm=4A=='6qPmRz8JZQGAKm=46fCcisb^JZZzF--ZKڨqP{Au4dCccm=4A=='6qPmRz8JZQGAK㜙qm>?8DZN6NZJZ'S[Ak҃v(=hmy[9X'8ة҃ISKAk҃vj+=hm^zNsaCcgm=4I=='vqRRz8JZ'SGAk\؉y_6Nq9S/z-=h҃IVz8:JZ0o롱3m=4I=='vqRRz8JZ'SGAkTm=4ve[qRcωz)=hmkA;6Nj-=h҃IQz8y[yCcmsb^JZ'ZzN-ZKکqR{A;u6NgCcgm=4I=='vqRRz8JZ'SGAk m=4vfCcmsb^JZ'ZzN-ZKکqR{A;u6dCcgm=4I=='vqRRz8JZ'SGA+u8}ާz{N,z)=h^KZۼW栖ڨu稜Amm^z8m0>K-9}ڨDZ8҃6qPKA4j+=h҃Am ss8sgz{N,z)=h^KZQkAK㠶҃6j/=hiQzж2>K-x}ޘڨǡ8҃6qPKA4j+=h҃Amœ.41F=='AQ-ZJڨqP[A4(=hSuq0/>OLmsbiKAZz8ZKZQ{AK㠎҃6c}^Z:F=='AQ-ZJڨqP[A4(=hsuq0˼S8XRzF4j)=h҃Amm^z8-sץ>OLmsbiKAZz8ZKZQ{AK㠎҃d}^Z<1QcωqP/mkAK㠖҃6j-=hiVzF-:Jguq2S;8X'RzN6Nj)=h҃Im^z8}0>K9}کDZ8҃vqRKA;6Nj+=h҃I s8s物z{Nz)=h^KZ'SkAk㤶҃vj/=hmQzо2>KXy'vq96Nz-=hmRzNJکqRGA0>Ky<1ScωqR/kAk㤖҃vj-=hmVzN:Jڕ9y]jm˼S;8X'RzN6Nj)=h҃Im^z8ݘsץɼ<1ScωqR/kAk㤖҃vj-=hmVzN:Jڝ9y]jm2N=='ISZJکqR[A;6N(=huq2S;8X'RzN6Nj)=h҃Im^z8=sץl>OLsbmKA;Zz8ZKZ'S{Ak㤎҃Eaa^8DZF4{^WK.~ųC^j=.OOϝunm i|./ƻ.d|wxm/oѷ_O?cūׯ޾߼_n$k6g|vXiID\+t9e?\p?Zj{Ή~?ߍ~~5}3Гzk|sӺ{~~q~q~JDendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 504 504] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj xref 0 11 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000003326 00000 n 0000003409 00000 n 0000003521 00000 n 0000003554 00000 n 0000000212 00000 n 0000000292 00000 n 0000006249 00000 n 0000006506 00000 n trailer << /Size 11 /Info 1 0 R /Root 2 0 R >> startxref 6603 %%EOF metafor/man/figures/selmodel-stepfun.png0000644000176200001440000002752514465413204020140 0ustar liggesusersPNG  IHDRz}$PLTE///mmmfff\\\EEEwwwDDD ݉oooWWWiiixxxKKK[[[UUU777___kkkOOO@@@### HHHߥXXX 333"""cccNNNFFF AAA---)))MMMSSSvvv,,, {{{GGGaaa111ʳQQQ```ŀ^^^jjjhhhZZZ%%%dddppp&&&򋋋555III000۴汱ޫ+++!!!ggg888lll駧LLLPPP]]]:::...JJJqqqBBB֨===444TTT***zzz$$$999uuuъeee>>>}}}???CCC~~~yyy⾾VVV222ƯnnnRRR((('''<<Q3VAʹ]om)bw~ȌkcP3-Hl .ݖSdyj:].tGwtGw;].tGwtGwtGwtGwt; ].tGwt;>-KOBwtWBt-h4յGntGw%C㊡+tGwA⊡/Ywd@wtWt&V>ubO~ݕѩCo+֠;+ ueC@NtGw@rW }o<Kݕes]';?V9Rz;hܙ~?Eދs>5qnۮ}u">Cs CGwtGz[<]ќU2_u/:ttGwt͡?PhaS&{⮊讚#>X>MOGң{]Q>MVEO}>:=ʆZ Cwt׵D* ]D* ].tGwt;].tGwt;;;; ݅.tGwt; ݅BwtGwtGwtGwtGw;݅BwtGw;].tGwtGw;].tGwtGwtGwtGwt; ].tGwt; ݅BwtGw;; ݅BwtGw;;;;]BwtGw;].tGwt;].tGwt; ݅BwtGwt; ݅BwtGwtGwtGwtGw;݅BwtGw;].tGwtGw;].tGwt;;;; ݅.tGwt; ݅BwtGw;; ݅BwtGw;;;;]BwtGw;].tGwtGwtGwtGwt;˃BwtGw;].tGwt;].tGwtWmѽuu]SǺݕ[FS]{tyڪ<4~,:&jKSJK8|l9/R~*瑸ok-?{])н1^ϮX3~mw _Wx4?"v_m+oERx.?;"&dDP67tgQxk#776.d w{h0+ta;#3dž>>_u1>{K7y;Ϩ5qnǮƾ-83tN2c5: 돇s {ڗ`P }::{œco[g9t>Þ|(v__g` ;+G_wkځW~:ݕ݇W}l_G-<[7Cq{ݿ-my]Q>==wYECGwtW=˺/.m3ѡg?xԼi~'WWqWoBwtGwtGw.tGwt;].tGwt;;;; ݅.tGwt; ݅BwCGwtGwtGwtGw;݅BwtGw;].tGwtGw;].tGwtGwtBwtGw;; ݅BwtGw;+:; ݅.tGwt; ݅BwtGw{toxB4݅iҽ5֝b4tIq]MGGwtWYM ]U:H2 Sϟ- gތqH.tO}ttGwU Ӥ\yp4UEgˎ?ol>j~" ko}g+Mq<]U譛1tIUk~.tO37݅i~݅i [.tOp!k8!]&ݳ߬f8ttGwUYuix[ e9ttGwUn=;k>>G;k~rI=9GN+:?M ݅ѽޣ;:t5vGw{rty~lhFw{rt[=dmB2RJv@k)r0@ȸ d ^unngFHؒ]lK%[\y2ɘ=}4tw4oM_mݤ{A ^ IxԠ/ݤ{A]ʮݤ{K Lzjݤ{{ʪܮНt7TzQ td[61#d0CwHw3~StMAwNнK;AwFAwѽs;AwstS Aww3ݧ;;tw0Cн Нf7 A&@wv!3ݛa{;;totgM7=&}e5qQ_CwNߍ0s4e6Ud[ Cw,od'1m]4O3w[=RmӎzS8tU7c1gB:LJmSVc|~oqС;t';t:;ou.5,.XKtkݡ;١ VU3yPml:?_R>WCw :-ؿy\4iVào>e]ѣpu?ݡ;AR&3]7*/zmFJKSVH7hZ<%:Lp>QUA8@&_VytWN7MG<ݡ;١e-h^~z+5*uT Cw*go_woTENUe%=ݡ;ETb鋛>FS6e3T[tu{Wt7:c2穨w 1iRݡ;D b#& 9ti^E;t~;НB{tCw :tݡ;tНWtݡ;A&Low]$h'Neǘ]`}OJНst_ݝ{ONZWݝ_Tѡ;t';th :td }Z5ՌpCwHw3y܍9Нt7Ǥ@w*>,I%G2.AН,}GmtwyRuu!:td-CwHUQY*NM{B I105t'&͛&zoLݡ;Y1k2c^Q„9E{a ݡ;It*ݣ1eGaС;t'ݡ;tCw CwNCwNtQНstWR tdsȁUu(РSНst/d?SO@wq';Aw I>o4[ NMOPhݤp \.ݤX qС;t't7fC1{j sС;t'tj;9/t&ݍ)jrի:td9瞻1'AНlTNQSŇ%Hڅ8E਍VBwn=@Լtw-qNMrWAwn} NMi}}ɨ_-;Aw7n,4{`Bt"ݍ]&AН,ݫ -?_)LG&#rQ tdCwH\ݡ;Y{T.jН,=*@wNZ;t'tE-EG"ݣrQ tdQCwH\ݡ;YW.jНl6ݡ;I?Z Int%NMߧ؀UAНt/йHCwN3t"'ƠCwN~LНt}НtwV/,Jݝ ;G/5 tw5)GjС;t';tq;Aw.u;rНstԩ;Awst#5wit'#qwnt'#uݡ;١{w2G;UnOg+ sС;t't dISf8EW޲~2fO͇ݤ65tW[;Aw7wn@wn=,5K;Aw7^}W0軲;Aw7R^Z-;Aw7>S^ IwzApEKEsCwNn̾5kc>r@ sС;t't< ݡ;HW_Z Iij8Sǟd"(:?{l_NӁ`c)2K[h)]ƥnhk*7&,0]ɜH..1[Dw˖m-Yvsz9mMz~<=(Mݤ;#;MV I+sVCw&w)Ӎݡ;Y1I/}t{С;t';t︊jT I@]CwCnAw=AwN=Pݡ;١{FƩ3rН]t'ݳ"]Aw=Pѡ;t';tRٳНstR6/!>t))t;Awݡ;Aw CwNCwD͂{/~1y6/NqtH_^PJ2v_:OVOFKM6=y7CwNv~݅.RQ;_-tL_wh.ۣ݉Tݡ;=E*L~U7MН\mYݽu'CwN}\)ܾ9.b&CwNнBbu-K?4:qݡ;tڶAXէ5S@^>m5e t|9zq[gI[-qS^?gT "m}) :td<[u=j껼Cw 4i1A==xL>S˖G7CwNitӃWQ!GeCbohZ?:td%)PK)ț(t" GF ݡ;H˱A١>:td4 VACwHwsKs]CwHwcNSAН,l ݡ;HߙН| :td;ʤ϶ {С;t't7>IBw̮]{/-Нto%\Mt7㍥:tdkT{v/t'(G?3"=߶{t.O* I*Yw~Aݤ*y?G? Iwc^0f쯛CwNֺAНl=IAwNnAw]݂ݝnAw=Pѡ;t';toK&wݡ;١{kcΟMSCwN6>^*ΓUjZ IiI"cMНt? LНtyڴilݤ{IJ7[`;t't/H:;Aw7>T^CC;Aw7~[H^Xpaݤ 2>:tdƜܹ;:sݡ;YׁٶCwY ;H]7]hɏ߯^/Н,{IƟ]+@wNv~JKfW%CwNv>Q1~zOVCwse}Ҥ獯݃ӖԸσ^Y5>g8=( Nc<*j/߃݃$4kzfjP_{ǠС{paЃӰ\ z`ؠCwNհt5~twA"td\Mt-N9'5jС;t';tԠCwNCwݡ;tН;tݡ;tݡ;t'ݡ;Aw Cwݡ;ݡ;t'ݡ;Awݡ;Aw CwNCwt;:tНAtН;tН;tݡ;t'ݡ;Awݡ;t;:tН;tݡ;tݡ;t'ݡ;Aw Cwݡ;ttН;tН;tݡ;t'ݡ;Aw 3Cwݡ;t'ݡ;Awݡ;Aw CwNCwCwΠCw CwNCwN-ۼ+lݡ;9B+JT„CTQ+T߾w@w1}t) t7KTe6"-n~f ݡ;9@wzB 9*{#Eӌ9P=ʻ .6+Bd \"kuP&%;\\6p P)K814h4af1^MLJ5gcOyh瓽J{25$7v(ݕ!tGwU +8ttGwe:].tGwtGw;].tGwtGwtGwtGwt; ].tGwt; ݅BwtGw;; ݅BwtGw;;;;]BwtGw;].tGwt;].tGwt; ݅BwtGwt; ݅BwtGwtGwtGwtGw;݅BwtGw;].tGwtGw;].tGwt;;;; ݅.tGwt; ݅BwtGw;; ݅BwtGw;;;;]BwtGw;].tGwtGwtGwtGwt; ].tGwt; ݅BwtGwt; ݅BwtGwtGwtGwtGw;݅BwtGw;].tGwtGwtGwtGw;].tGwtGwtGwtGwt; ].tGwtWU}M;=tGwU/ǮhXUt=q=tGwU/Ƿ/[CwtWNĆUtGksL-z]UL7΋X\hzm_1FK,+v]UL\lb m?<讪9 ;+#tu^bJݕ_ks.zO]1#nEE;>*<6*{2t&7]wCwtW=ٸ WLQwCwtW=In-.|C]UB ]{冎.tGwtGwtGwtGwt; ].tGwt; ݅BwtGwt; ݅BwtGw;;gwk(^2:w9tJ՛Aflݼ>]ǃu|K^3LQU&0wk *e0~=n2tC7tC7tC7tC7t en2tC7t ]nYA+{)O9tH$I$I$I$I$I$I$I$I$))zǒ = rx_st<z]5 Ѱ"O^ch$|7EϤ@jS^C/IigI/;{/sŖ?ea%]k'3ѝ^o ~w ;/9am|Sg]cx k# y;K;qѫu}3\8^#W)^? _# oIJ ^6.mTRo+ ;m+Fici9e|w,p ]$I$I$I$I$I$I$I$I$I$I$I$I$I$I$I$I$I$I$ISd ]K2tI8qfLx߷u7:f/K]z[ɺ-ֱ딶&I'"w8 5OF|YJz$i7v<|=jdoWŸ-f^$['7ݡo_wǓ7u$9FzdhwŢ_vRv:kB|֖[:̔[񏁆~w|?AmK<4}7iH$9?3噧>)# ק)ev|u$($=Wx}ct)Cƺ?Yg?Rqq'/N~uM?wC1!JzOz,K.l>UqUzC?;/F_K F)evtcׅ?=uK0E{IrtnαgĮ ١Ǯ_,b$fă۵C0ß_,CXpW0 ~DT jXD b ,ڌ^$Vmnyt8_87ykյ'9+VsÄzیBsw,,^7l$YÄꆾ2[nx5wNgz}Q>OGúYBC7: t@>, ʠIENDB`metafor/man/figures/selmodel-preston.pdf0000644000176200001440000006567514465413173020150 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20230811130739) /ModDate (D:20230811130739) /Title (R Graphics Output) /Producer (R 4.3.1) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 23531 /Filter /FlateDecode >> stream xKmUWPG#F7 !. %ak̜{@\@Rʵ櫪fU}9ǟ~䏿H|OUW?>~go#}?/#۟GoOݷ?՜lsͷ鑟&e\d^($29d:$Rt}?:CJw^Wl.g3ȱ u7$}veYIƑJnUoVyUX`U [US򂤕5`V gc*'2wo#*}rs<C6NvM Y}nuqq# eLҭ8j}r@V;ϻjta5,:`5pڏlC.?cj{':n`տ K9 &Y!99%;-t3}ݫ ;?mǻ8iAI~7, ~I/ɿMNS6p6n;|R>Gϴ\ω4?:waمtCgzA/g=6~~4oj;aR/h¯2~ O ~YwM FpvNӢn-S_: -z:yZ;pi\ߣg+oL'f;zA~E+/~|vRݯ{Shos޳Չ3?ݯG>{^k?иʂ_Ut}~{R0}ъ >h~E헍L{ ݠ0~\^Cfh} ~L>' ;x΅ps$jK|^^h΅5ٞVڹ7rٍ20^˜rnbz|cj΍}gV*shWx?Ai[A%~I\\ wq~G< L_g{o 4ݯ}Wy?N(=q>ӉF@~?*~ /cHkA}?#gXi~g4h hっo >]g¯qfFиvWo8?:?:NρdSm'=1ް,ӃLw>zg=ƫb=o{)»rjv.ef`IOh kF2=fo¯~]ǻw~v"PϹ9~7l-fpm~Uytkm~Dz \|92~~did5/G_f{569fs]x#o`|p6xhkO~?k(}NL= Oa\Ӊz8Qm~g4w 8/~:uG_xh5;5ݯ ~s9/8ӑ_P7tty4|GDM5MOr*t9)ikx>M_YR_E{i ϒ~hN.m~6_w۔ϧ<ʹͻ7u~];0^-i{ݯy4}.z/eeb7ѓSOD97Y6?ўv }~4~GnLwh~M_xllSV'>?ot΋iϧ]ݯ,qJشqe|Q,;2>`zBx+N/> EBm~?r w'b/^G)hoLۯb/rХQ_>K?͟QQn_w~m~/~lܯ}дqb 5̦s 'zG^Zn =oͯ,iS_Lj;=Zy=<iLo+v2s~R@/;o_?L鷁_/(LOӍKiG'N6m\ ..q`Cy:2F1XI֬7 wq~Դ5vcgh1~j/vx'8?g8޶;t˺ <_$[YzB;lA7bi܏G'4O/k/{F+ Ӧ/cl Y7zeÆ-4~` i.d`и^6nmݏmpg"~M~VbbH'l؉c/>+XXa,^>ۋ6;WzB /zgZcTq>;Jꏎvk|>mtcy%%U787+41(_YK|l-}kZi60B@L<3op|qFad![5`V5OXCtM.f_?;eAJ~:_hv GӂqDiv_zȹ_ ?!5' 4>eist4Ɨ#p?כh_0=8;AwM?OÑ10lY`/m fڏ^ԋiMh>A{{c8jzAW?6=;>_e˦w61QӢ6>l vj Ϸ=p<0h,jhl"%AIݠKvA)нRǷƳeըtO w)O8J~?v?]?[x//+=g`3ݠv ~6p(stH.g럋z@<:t61{> Y.K'mwI7.}m!ק-Gv?=돶X} и^g q{/\BE=?Z he_gtQM='biGwt/QknS_?m#"4Ηx@x+S}|mz@x4ï۞NhE~Ol[HO_Ƅ_h7XfhoZBFd{qq򫍚~h/g_b۸Ѿؾlho7=hUu]~}{eW/ZJؔG6u#;={|{%9]<.$|BvJ gUZeIX%I\m.t_[4;r\vIXa`w\?8Wk Ϩ-DrY @m>@u=#}fsR.qo"KZ; #ikgZ_߅V7W-l{UvF}-BoY.m)%:igwZak=hl%&;ᐉVxRpCXn0ԪKmF]bкlm[uJómo@tV~DVyS*WZAiVܺirCgmW LNHVDNL$݆.{UNZJ :)aUah]627LnH"SəNҿvd!{a +_43 VZybVЙΆ!%pm*dU_aUA+ NZM )apD֞Ny|gmo;\m;\mxCPǿVĩ+VldUUZB (a3yދaäGx R(a%pb]2Q*WMZ&N|C؉ WByFE{mxl2Sn8b (a;k7VhjUB󅩤0!`V(G yUK³YxjioVhl?:ig %2~բn. !e̔=YܯoCҿȦ9!ew2|hh|aVh[.wB*Н\XF+\iuZB + mЪ/JX =½&᳋V)͖9Ҵ8QcD|pm9JiV> p2S ]U+[iUUɔm+2r )awZ&V>iF&i(͊Ȅ_rRaZlA3B!VG zi|G yY%JX$==T9o>~vۿ;t?m§ۿU ^_Z:kX> (X;6W?g\b=8o-?|_k?[b>ŵGo?‡I?m{OWo+|V_n+~_?§ܯbCa4F4ߍoO㡾>G/>N$Xُݏtw/WQ}:2HԌ:Fz N0OH9HνDC.HƍOhdG1ң*Dz4B0ңJHZi3ң򕋑ӥ(caFznczQHWDzdGnx{cGJ0]vH0# \AFzvEz³H<(æL";ZBnpҭ %H<"=dYM΀" 3)H[KH[۔aIXL tXRFddWCGH_iFGz5QDzwUćU!SpnS_iHZh"v.B#s3DzNw8)Hۉ/?!a;_wY3'jޟGGՖsFzN!DJL,RH۹ QA6}*WH &~$"=ꃔ#vC[ԭ9BHۙH$9"=l'aRćq⍑E]9#=淄D"Ah3#=T,eO8(KH="=l,?DzZߙ;ov/x^Q H8&FzNfiHI z"=lT nQaEzrF )r"=l{}EzNzEx$ TUզ^*02$"=zEz#fv?]?Dz)Qa~m kdbDz8鱩ͯ ?0poS "=d E /z!\ODzT#N sDzIH'^AzMG"ңhK"#=Nr)£MGp}a#><Ñ%E| Jp^QDZ#= Q!ңn`!IC H#22ZDzaH#@q$ Y8CVnЌ񽪆 '";&d#Ð#W0HDzr NV1a "= 9BHCA1H _;*OH->0;"=LG#F҃t_D!FQe%qyE!EHI HQUG!R4"|߂ߐ"]a;"= !BD"=DGDGzF$ ^lEz2 ">"Dz!#kꞑBH''2_$ ݠ^ [Ó ;t鑗"+a  D!BK3"=<ǿgM'ExT C<,IwDz+Dz" 1"o Ó4^#!"1(HLpM1@,\ODzF{SC?@wgM'(x"N<4CV7"ˎ d٧"=6~"=2>a7"=Fd"=LW=0XuIoˊiK ~\8e#DzBW#D_#4Dz'Bl>ܠMތ H f8Sw"EқHt_lEnDЌ) u o"=L!N=_#=Lx0##c"=)ve!0;|XaߗQ9zEzdʟ0 dYa -DzH9҄H&LݡQWp!Æ]@رw5;Çm92H=~YÏ_ad@>0&>P1 >! vPwh _pD _\Qjz"=LW7$"=|.=,!+O+DnT1bZ1ᑉ0UB+#cS+4oD#MH鑱SD@0_HG)q!4eDzk$#)<#+rS'4#LYi" ?!x+Fzd2ç^6Mňq}J "=8HIdm "<:4#. A=Ѿ!Ñ-E|th?"=rV ֧'~Gz8U;4#CDz4d@";24"cHצH,$  ^iBݡHG^HGQ^6m"#zEz'Yx0Fzش1#@0#ߌ[b页)EzKHcEzhC9~bH'#gȌVG<RHLD\TGJEzd"HEz$n=TGH[Ez$_2顈[Ez$(㉠aGR#=7Z)#q"=#HH&FzIߊHlTG~Fz,c>=H$>!MIQH `G_HDCi|0C"=ƃH8HEz߃HDhCI8HU"!dNI1HTbGR#=4HFz*,M$~HTH7*#U>DzSG|1Ez$(#UEtLeib^>HHEz$E1#E #E^ #=eG*+#7{e'#)Ȯ"=Ez$E 1#qDX"=HDX@x"=Ez$ߌHa@Ez$EN2#$"=*#qC"=#鑸BI1#=RRE_V1#q~{+y] ,籹qXTVr,E3csI۸9#cs5c0c^nnl cP49 Od=x̱rH"c3 J+"a5ȱz@ݕ:9DZ4D1c?YV@ű;v$ql c39͍KL؝ ! P#8  @9 E~0|̵n-vxQ$ol[2xc78 2ucsЍUWXiܶƸ4m즰J+XdmlYIA ʜ0ll+3B661cC*#6 ɀ]y"_csZ+O;56'"W#YC+5rʧb5vUJGpqjeV$ "5veb56G P54D2Ncsi[*؜XeƮl7!I* ]x)he ;346ǟr w}gezȕupFglk!ppp܌1/c3vQ Hz:fef"<I+LZ1oc 2672-C 026k0+cEu f,&eGA"3Gج `HV2260"cg !C8126ߙ!;+j(,V㕍O4Ɠ1h,FcdF'0enұh$eX܃2YEcdvmLa`4FVrDAYYh e16h q11XUE|Q47*#6c4hEcp1h ҊPX15h Dc( ba4+C1HJȴJʀFc(҅IVCh )#}eaj()V UGc X1c 701Hq+C3 ԭh N(*롊tEc$%t C/H)C819^Fcg4!> Q4)C81^Fcg4F"h H h .+C91+&1iFcpE4h 3x0uDch2h(aV0Xzhŕ"Fc &D /hźh#XLAb4$(hG4\81xzDc,n{b4b1xhEh zFc,F3cmj4ZW41h[S8chZx~DcI+XLb4ڊpXhnFc-"} VN*̝ m"Ufi@L ?bn+H喙}R٫$ .UxA*K Ri7"bA*k)e#mUPfc$RyHM&^$H*UlD*+M"A*DT^;I*<& I.+s;I%R}  Ry8H9HT OIn+MŐA*JPn݋UlrUʶ|T4 }=MNwʾ;I*bv"ITоkW֗62/RsN*JTEYA*>ΖTmD m5H寤ʶ -ӓd_/槝$בT$ CR9djRj!Ieۏ$2T W@* }Jv? mK}ʾA~OdIefTKRTFZ{f[1Ie-TE1Hb"7wTHeT^d!Iŝ"i Ryq-]j"A*/kT^9 Ryl#Hbs <dS|H*OnAl@d0Hb$g Ie%YTx)Ryp"R)KRyt%TnIGRM{M.IzI"Tn;IƤNʍ$ E*I*οT."[I**Rr)H*"2raHeuT.H*,?%~$\8/RI $mT.d,RWrORh|CR5$&R9s}DrH}c"ٓT&3D*gzTDR9/^YI3$UYrfRHSY5ILOrBRI $oTLRTTΝ$5"R9y"o*,RY-"s!5'$5?#R97]~$A*g_T/T/H*gI*g7H*R9}r&$R9HSr._DRYI"!R9sWr,Rٗu}~* VtL?ms\ٖMعÏ7eO+eE2 f'rNNMn9k[eOHuЀ8v??_eBݠ6`6 sN\7's$j$UL{G ۸W'J b MBdt 2AN"tidtViԎd4gDFr$!2j#,[D'DF3I]dt! F2S\{"9t͚)"9q 2ZхhJ!9%Gd ]Ȩ\ # Sћ"HFk7&]{G2z w! 2zsM2zsޝd.0AFoIFoNޙ$6mr$w ; <$7oIF,> $wⵝL%\' I2z3d΢ HUZ"7]iҰ­2zgЍV;;wZn",RN59p.7]9] +ef4k87W g;ݜݜ@fas$PE"$} 5y~@fՐ%pI5cIF!dt$kTù}ҬEBj|P.\_dm0Ҭ dtQVSù2k8T gTY 15"Frɍ1ɘ5Ad L}K j,t˨<S$k8ϦS5FYy,5S5 .2:)Ɂdt|TdvvNI2H2:;$rdvfz0yf$μ go0sz6XeVe4̚#ɬgU.iG aފ¬$Y_ĉ/e#]|&Ev\Y +0OZ5aeU"|ڼGdYH,e"BZĕŎNl+ofˑU*˱ETF8FNY[݈)k3)e^#jdSӊDqU +̃Vħ'N>1[2`pr2<&*HZ:@/N(^KnoTgX˖U/Nf*J'I#U @%[~vjVZպmo}Y~v˷ᗼmUnr[۪Vj} xK/nrVZպmo}YtK[X:%/r[۪VUmn+$-~v󶚷պmn}[ˊ[# %W_ ~5ׂ_ ~=9 N\.oV[o}t  |ۯJZk?_ɃKץ ~+o?—nA_~/}W_ ~5ׂ_ ~-@K; |—V[o@-oJ+Zk |—^ov۷K/?—J+jkzρKץ ~+ස߾_}W_ ~%W_ ~-׃_~z—nA~;[ЗK~%W_ ~5ׂ_ ~=7ޗvҾo=o}t |ۯJZkF K;syiVt߾_}W_ ~%W_ ~-׃_~#$K; |yiu߾_}W_ ~%W_ ~-׃_~#KKKwۗKG@K+jkzoFs _/߾_}W_ ~%W_ ~-׃_~#7__^/d/?—A_~/}W_ ~5ׂ_ ~-׃~#7|ib|—_}W_ ~%W_ ~-׃_~#7 ~ztz_KϷ |@ҷ_ ~%W_ ~-ׂ_~=7~3/݃ޗvH _}W_ ~%W_ ~-׃_~#7 ~3vN_z5K/? ėJ+jkzoFokST[_Z|W_ ~5W_ ~-׃_~#7 ~3pKK$/=.o?@ǗJ+jkzofoV 3AKט"_z\:~/}W_ ~5ׂ_ ~=׃~#7 ~+Kכ(_z\:_Ĕ/}W_ ~5ׂ_ ~=׃~#7 ~+ස߾֛.i˗5K~%W_ ~5ׂ_~=7~37 ~+/ Z&|ۯjZFof[ovz3qKKkoJZkzofov/\pЗ5QKKW_ ~5ׂ_ ~=׃~#7 ~+ස~ }q|7t ~%W_ ~-׃_~=7 ~3ෂ ~;oz3KKkKW_ ~-׃_~=7 ~3ෂ ~;o? ՗~7tz_\_jkzofoVo}=}r_~jzFoV[oҗ0K˵~MkZFof[ovۗKK׃˵~MFҾtkzofoVo}۾pf/]f/]kۗZkzofovo~/}tLZ&}ۯzFoV[oҗPKͤ/=/]kߗZkzofovo~ /}tL Z& ~ۯzFoV[o4җKor7z7t ~-׃_~#7 ~3ෂ~;/?PA~Zo&9Zo&;~}ZFof[ov۷`K_~/݃RZon.nT/>~oّW?}Hv{,L#P?| Ocџ`y8yBmJeg+]Ax_Fa8A>8 >Jt>Fj/~?#+?mb{~`WM_wׇ˿ᆅ7ׇ ?'|??_w?:~OY nǟK%vL_|h6=~g:u~ҏҊendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 504 504] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000023896 00000 n 0000023979 00000 n 0000024102 00000 n 0000024135 00000 n 0000000212 00000 n 0000000292 00000 n 0000026830 00000 n 0000027087 00000 n 0000027184 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 27262 %%EOF metafor/man/figures/selmodel-preston-step.pdf0000644000176200001440000006426114465413175021111 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20230811130740) /ModDate (D:20230811130740) /Title (R Graphics Output) /Producer (R 4.3.1) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 22751 /Filter /FlateDecode >> stream xKvu;~E Ɂ>2m@86` eQHʢl;׊]; [3:`}ɝ'Vwo}~c)}eǏo??Z쟭_|?_~?dF۬foG~l\oٿ[ոm5oy[jV/[\{߲meueUnr[۪VjUmo~[jV㶚ռmnsK~[[vmUnr[۪>VdU6drA=H*߷tV{] w*_r@ir꜅ pts![}s:C K/R\g u^R/W/'t1=kkvM'ݠ{^~7]sq"t;d~Novt^r_=t_^'nR/ߟ;P/S76#9e-|o%ٍ`MfzG/h~F=q]uy~Ig/xm ]yt{G p]d깿uΓ\3*BSA|ps>+s?A9pLw; :9__.~=Ήth;~ ~[];~~< s|yCsߧ_s#$hGKKw;*~1d7wtN:kBy04wM~c݄v/Y5틘aZiȒb7t3iO&: k` Hy~~+3:xx=`h+}/~IKNϫ L/r Md/ZӝM/t?ݠq~y?~ӑHиߎ6s!OJ=%\OȘghO_<=9)9z@y>3+~ϣ/}`4E6kM<:;z'4'UJO9p<'4s뱛N|~6s?=w9Qwn;/jxlaztOe%y?eOv$Ȥи?wyapD;IG_xz 44tn}t~ϝvfGj^lwkx4gEm~}nڋt~W؞８2t:3~w<sԤyVӍA{񚮸?JzMn:?gzC{pǯ[cM?f8^:_|ߙv?L7t+hL_FVΉrtI8~,j[OsI~}g`S1okhLgi|ڍa`hL__K;&rnLfT]uq7ihyܯa|g*c74:e<ݏrDڴzSo茿7o}2m~}Ｏq_<< hx9SNCMǦ/cXJ_Bn4t:uj;oGG5:8 uM_Cd*0ߦ'4Ӱs? /t}L={4iΗv?=?E~'o &U66~UPM8]}vmxf#`fhq0i{~ п?l&~ύa@{CbKOӃ9q:Kw2wݏpW0> O i;1sd蚨4_4m~|w<<ܨ~]??W؃Y+ڂ޿6\n;QzB:yQkfQw E_먛^G_X￣ݯ}o W5? Z9 SW0c2ӰUܩݏ㉂a{4ڃ upM"n70?jCsa}"t>ѳn&]ݏG@l"tf{n/ӉQ؞Bvw4ϣo?p^|w3߆Ong=:1ހ_|^Wy~\ղ}Fe A"44kޑ0sr^xGd{bKfиֱ1v<Xauv?η[Ǫ@x;Z+-:f6 o'Lش3Ghq?s/y>Qeω)Y46MŸot3=~.L1=AV_2:?97JY~:FKи3]x?+>ǕRݏi4ͯsm;suA.hO|Z?КFfxcjiH 4g(nϞ(Axa2]y^xb Ӹz@}~٣ݏK>ЃkKO?ܦ<@ 0G{'8k_S]}DM/oBil]L7<_wn~^>a}+/~nޟ1Ă%̇ ޳Lx|"t.q0mt 4m@{-10fAΉ!~đP4߯ " i+ߚv#w2ݠKv??DY~|lbl>qS7豨t^Jӧeډޗqt^'.=q@4d ?m"@дum2A{tP*8{ ~ )>Q '[_zAz?|":x& g+X0q􄿿LJݠ^schoOMh|_B{{n2k zci~_t߯[xDzi~ OÏ 6_Sv?R'_/ i8b&l g# h/-ÏۦM#l@}d=e + H7Ԩݯ`>j и^". :I_- !=7yڄ_c/z\ߵ@ҷMBi7h6E}NmB{:*K4$hnhzB Lh|KЭQ7hoC{&7_!t_ 7!?> _ytD2O4ۍkf%\miFKq&=I_BaD?q6#Q]&I".dw.Α%q$aoêH*K o)[K\%^M6rJvPGr Ô#ae 5[VxDϐVx,_܃ ͼ󳼡\2]mr'Z Vw#a.™܅VhϰVۇLnx1vuݪc$>|ѺշNZ)aVAXB 6(awj0 +# )/{TZ5;VG3h:[KA&JX A+m$Ф9c OʘZJgN$B.hz{KGFI+C3*S. +G ݏYig/ ~i4p/467-??>~~E~8)_`^@[x ;B W?#7MR?gG?a'OmcUtڷߟ?ųOyB튅aÎg\b<8~(_M_ {c_xƵ{o?‡?mO_'V{בۊmO/omWc&}JZύPx/~?~~ßů\O8`?~?v?~?󟟿?~7_/LsmmRcHLΠ0cp`L11e ~Lfz nfGZ3=:0@9LA3=Xafђ2%Q26Q9OL5.ezBUL#3= Ms( LR1LLsdz=ȍEȉ3=bF3='#5er #qQ{֘a3`ȁsޫ&a=]0 0Ѩ[c,m~k1F-03=_|dzzVyT3g&'m~c)7$oL\dzR)2&aK%fzR6>IL_VƇu1vh{A=|*ö0sgl2=*>a[/"÷vj¶3=|+_dzYkfz8#ͯlexmbfgz֣+*2=l+Ydz*| n+ö|p> &dzT1t~Q dzid ö^EmsL~c'Su]7;zdzVyx^`|[ 0 2=Mh73Q0qLG)j4e|_O)ia3L0pF0S`yez#Ù@i)fzJ2=LC kSQL"l7 0fW]_7'c1O2= ]{2;̯ycipViO03=<"涐LcB  LGqntc2?̯(e1yx#æLLcQLdz8ڪK_ +dz'^7/dzF~C1wapS7hfxCS2tə:|< ;}dz8cFjK2=1Ø L ?_pT=E3u| M=џ@1tCȉ _%CG- gpN;SGС}@G5 Mge|Wdz3^qLEAfzdV1#kѨoMO 2=S2=ckb3sG#Ӄ_Sy ~IWLz`a.ϯÅ~0 Odz v#42=Y dzcݯ"42eݠha-'2=LW7Q|"Ú!֢'_T|{3szB33=#X֛J~baL22=_L̼(+dƑexThfrTe2d0~IǭO2=reƆo7 FY&kSļ"û <ލ@c{7#QO `00]ݯ*"Ï/3=L3Cw2ÇLU L?ǘM֍LaЭ  &'2?&9L ns>/jV3=Lz#úH|]cuy"#?aĦU:2=lX߯x> 3=LyDiftDѡq~L<#׭ oL.2=|ש;42鑕Lg'43(M;4;nFG|3=A3~C#p#3=|%SOh0a~e~K[|olHzC}EG.bΑL+aXzC#36 }A3CWi7iF=^"432v?wa 2=!_2H v?G24idzpS6L?wӜ)#CwGLezdzTGQ{LLAL3=2r鑷2'鑕!LY$L2=wfzQTG&LL'ÉHSHKez,?|fzTGxTi~ex`I|H|aGz2=L42>WA?fz$鑘QL53=2d\1#u2=ה鑔)L0ezNڊygGP)AHWG|2=ғR嗥闤ݏHb鑘LĝH*#1X2cIHUG"'Le)#ex #)gG*dXE?H?TG*ʬLT2?eGL2#ee~ #ee` CH WGxaü2#qXxXfzL柙-ez<"Qyw<.;63c+L{9AvFwl&)1c?V,؎T:vlN 0cs̎H}Fvl2cs[@Pyu؊AS53Tcs[#ܝD53OcW6/46 P4+K _, *K(xY,PdiƓ4dF%cFJˀQeiVZak)KCQ_,4XFYEVB{, 0KCafisWw*KCefi%|LZ2K|EkX>D3, e0K(xYP7)KsP 4XIYWY3KCS O, +Kx48բ,4n,4m, `?fip [YYVMjְ|dihx, `/ei0_YVx!Y(K#+L h/42^fidEMTZeFUV;KCdyfidt K{ifip'4, f*KCqબ48RFR48%, 0K4ei({Y\.Tw+K9ei;KCJ4T, Qr iYL-43, 0K#\gBP4&+fi$T$Cdg7+KfiPqQi fipECY,*, )0K#)*+<VR ΃VaF πfi(YdiC YON4N0Km@|8 Kcq6Y,!KcqrYO4di 4di,N,0K @LaAƓ,'YXO(4+2KI@ڊيh(-5qgi0jBY]<, Ob, YLPZ,N9 Z?Ȗ, Ek0KdiL~'m0K, o(K-ғALyr,r4di0|XYOh48ɦ, ex0K**BZFUd‡3x4, OZ'KWX4N>YQCf`4 $Yy4֝,ugi;KcY@dixls>Uʇm.>m#mgDhsAh<"63(Xh3l6kK2QE'h(;O6[TfEڼRm, y=OYaB57+y ڬi mFSKh8ŵKy6/NQ m^ڼT.h3JmV;̓[6y mG# 7.^@ ,ݍi/)GLو<@*W'?@(lD7416фht ]v?6;q/l_ͦ g/6;Q6ͯ m6Mtf#mvNCe/# m6/f'\m.B[6 hsyl6;a(2g6H4p'@ QBݯɿOQW@l(OQX f*g@I~ m.ښOXgf#h mvgMD/__2xf(7=F)fI,f׃:w"~\'l:IP͛s)y/歭D76k<'y'FBcͻ6o&ڼ+#y@տڬ|ʱڼ"y ڬz Vڌm^*NYQ B1͋'B7 m^MhUnm^*oJy !ڼj͋?6?劉6/Dc6<m*My|)fE) m,(y~?͓6O[Dgو mMh5Ym,."yܔYRmEh6Bm*Lyr]h@6zm_m6wDThB6n<:?Ch:шm:)y4=Cx6Ch'!hh̓E.6$hjIYK}hs_}%'Q"O> m( >&m?m߉6w]ͽ"U~hs:HW}ͽhs/B6"hsZK7~mܓh6?哉67. mn[(4@ q׿&4hs{m]$8+ >Oyeͭ}J|8}B+67]O͍[y67DʋmnEh6V<mnFA $6hsK!ڬrBm+# '\3Ahs:ZB* |9*thse9Iu \JAhsU UE͵A6Wn\m?6WvB+ mU6ZPh3mU=rB+ m~!6\3f\>K&}e~'\hsB6D 0zKhs!$,Ee \tmFAVE(+GOT¨@e\_'\MBt@ iͥhs!** \8?!cڬrB5\5&~%\*wͅ;6 ͅÅ6p=NhsB6?Dͅu6W6Em.66xڜ}Phsf&Yh9漿P=B3wm6g6C9s>WhsVK9J<&ڜ)9+hSh_6rD 93Ph6+JBh$6.͚ڬ`Y0rD(A6gF mΌڜ_ڜ9 9W|DY槼6@sڜżm*K9}"9(!ڜ%&9 ڜhm,D(9s~@hs@9\/ mΙPB"mVfEKmB6gnڜ9_!9sK6 MڬBU[h mvm_(3p mV%^-1͜nhMM?&?OSGM$ o ߀!=7I!sLM?B*ˇO6UNĻv 0ʾ޷$jmŅ8g[1B5O) SܳGM)n UWg&$==^GOHӏkɯJ t~QоIzMDOU=!=  (GOH`iOо xpA*?=jO\ h@W[wC*ڣ'}TQBr@}_f85Bݠg^hH{Ĥ"H~1=Q Jڣ'5<Ί&&(EJ6<5%Q ~Ir..z~Ķ>0Q8)?߁LEO 4 Bz{ViEOV-7ъ u iEO_4~A[tUCmV\P4悦f@*Oh9HYQ$>h>iՄT 9iM/}A@ӌo4]AӜ4oAӌ*4ͤcAS 0inv4=PT]iKhznKhMOR +2MsyC㋒.MOhz1$4=x Ms,h+킦tBӜ4m<&4=x{;`Dhz0h\ib hRYC4ךMsj_4G9,h Nh ohZcBӬf#hGhZI;߄GдzK/hZI;>BJ 4$ BJ 4x_(д:-DAhZIC +IB톦DAhZBJ 4$ BJ 4$ BViMs^4eM7ʙVē3#fi&Qi&QfA\4͡iM3Lt%WHhZA,!hF"hK9#%hMW瀦+:B\4]IfAӕ4(M3Lt%hFh#4Y2AӅ׈4MsB4􂦹S4@A+TZ&4]DvOZ%4]r/Z .`m@ &JAӜ4.ix .3HXZ$4]TWZ= 5.ht%h`Ѱ3Hh$$4]>Zt46f2A&h:μIhZ1ML8ޙ7靅gZMQҰ hzgQÅV7MoN3Dhzsʇ|Mof_ޙ> BӛGwhzPiQtZ!ݡЄteB(@I4!]@eUDHWA뭢zKA/NK= ])e&=ՃܤzгbW=hA-(So MQzA^/Aw#Fkhj{? |oOofg@9^@m~KnM>YAӕMWAkSe@UX MWգ#4]'.!h<7RUtQ}@BEG MzրOU͕PGq@Y ĄQ4 4 ˀpM'ζN4#4e1r MM. $4]jHhFh:^sEUz2 $փ^A?Yz/HtXzrSCӨz̨?<94'zFY]Sw{~2BXz,B=1誏zCYzp~L7xGQ^9Aw՛d=}ԃ `={V}jԃtzMYZF@ӨwzӀtRFwh zǀX.A[ o3FzUtYr]kic i+[QZ6Mʀ.#h4AɀUJt유PB'h:/Pыqz vBӅk _A y4] $h<1=΂^ M?KMg=_3W h8Mz̀ dBhZ5!D,h: "'4YDtDh:W;4$4a@YP~&y@Y-[4IMg3 MgDŽQN Mրt H72iA~QN7iA?BiCvMkPBӉ[Ai|A~M~I84:GBO}GBөN 4 NMMk| uFTBө 4:Ah:U74:'h:=q_$~ 4XFд6 NESaOhZM'h4~BTM'V4 .?^Bs՛`!*k Gba.JI+ĴjL+Ͼ.UXdNxM(hhCŷU$55xK%h=kVɷ3H5Uܸ%p]V-i0d(a5_[ -/h5 hJVV\uy:ikz-d\oN$~UV-a5^[ *᷄kwYAY &o9e)-[.Y5[VrL*<|Ie̔-rzKZӭ췄reNG)+~KVr喕d%@&YIηtz--7pzUV/z-i7ᷜoe%oyY YSV-mdoo_Nm--7$xYredenv[۪VVMp|IG[^VZվmVNre~[^@/`[ηtz--/v[۪Vոm5oy[jVڷվe&|,+&~KrooyY۪VUm5ny[jVZվm/../rv_r/eenv[۪Vոm5oy[jVڷվjjjjXr(-Qr%-/v[۪Vոm5oy[jVڷվeeeeeŒˏD嗜o/oyY۪VUm5ny[jVZվm/..//~v\~(-mn~[۪Vռm5ou[jVڗHHȗȗȷJ.|K\~~jUmoq[jV󶚷պmo}[jjjjj> z%Ǘ4z8?:av[۪VW_r%l\o9oy[jVڷվDu z]:_vt ~%W_ ~-ׂ_~4nAK;=|oVo~,-ˏ%+jZv-ui/}ෂ ~;[ЗK~%W_ ~5ׂ_ ~=9Ҏ^.oV[o}t =|ۯJZkp=@_.ǥW[oz-oJ+Zkzs-ui/=. ~+o?×nA_~/}W_ ~5ׂ_ ~-׃_/.ǥ}g[з~=|zҷ_ ~%W_ ~-ׂ_~=oܸto~/݃@_+jZ=N_z^\}o?×A_~/}W_ ~5ׂ_ ~-׃~#9N_z^1Koz=oJ+Zkzop=@_z^ڷ]/߾H_//?/]_ ~%W_ ~-׃_~#7.]AKo?×A_~/}W_ ~5ׂ_ ~-׃~#MAK;=|{ЗK~%W_ ~5ׂ_ ~=7~#_^//}t=|ۯJZkFo=|×o z=oJ+ZkzofϷ_/[t=|ۯJZkFof |k×A_~@/}W_ ~5ׂ_ ~-׃~#7 ~+rK[,-ۯjZFof[/\ƗnAI_z\:~/}W_ ~5ׂ_ ~=׃~#7 ~+෯fȗ~1Et@#_+jzFoV[/\ʗ~7Qt֯)_+jzFoV[o}7]Ҁ/=.k˗J+jkzofoV/\@_Tǥ~Mҷ_ ~%W_ ~-׃_~=7 ~3ෂ ~;෯fΗ5K~%W_ ~5ׂ_~=7~37 ~+ස_/=.kЗ^.jzFoV[o@Zo&#}uJZkzofovo~#\/fӗ^.5问Zkzofovo~@/^o&T}t֯ Vt ~5ׂ_ ~=׃~#7 ~+ස~k}{Z&q5W_ ~-׃_~#7 ~3ෂ~;/?`ؗAKk(KW_ ~-׃_~=7 ~3ෂ ~;/?ٗKKkK;}ׂ_ ~=׃~#7 ~+ස~}D_\̈́_^ķ/}ׂ_~=7~37 ~+ස߾s_}{P~Mҷ_ ~-׃_~#7 ~3ෂ~;/?ޗAכI{_z^^/}ׂ_~=7~37 ~+ස߾@_~{~Mҷ_ ~-׃_~#7 ~3ෂ~;h/?A~Zo& Zo&"~}ZFof[ov۷K_~/݃ʵLrLv-׃_~=7 ~3ෂ ~;o?䗾_}.\ܨ?_|߲#W毷>ڇv{,P?| Oc|LJa ?ODZv}:/Ah~vj5Ah~0>m$)ɉïB~7?hCw?@?>xzm;we𛏟?~o}m>\nXp |>/8av=pϿrß4?Q /w׿_ͦ'~q?sH?sHF3endstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 504 504] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000023116 00000 n 0000023199 00000 n 0000023322 00000 n 0000023355 00000 n 0000000212 00000 n 0000000292 00000 n 0000026050 00000 n 0000026307 00000 n 0000026404 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 26482 %%EOF metafor/man/figures/plots-light.png0000644000176200001440000034401314466631452017122 0ustar liggesusersPNG  IHDR Ca؋PLTEfff興wwwもRRR'''[[[CCCgggKKK###\\\??? {{{䀀GGGWWWOOOqqqnnn999777  kkk+++===///NNN333 ⷷ ***sssƽmmm"""ܧ000ooo͟bbb<<<(((222DDD&&&%%%666;;;---BBB~~~zzz!!!111hhhȶ JJJ...SSS^^^tttVVV)))}}}$$$```@@@888iiivvvTTTcccUUUeeeEEE,,,MMMFFFXXX|||___:::555III>>>AAAuuuHHH444pppyyyrrrZZZPPP]]]jjjdddLLLxxx殮QQQlllaaaYYY I pHYs&r&r!+ IDATxMuq!ڲb1fRBa+/P$H a,:(t@<8J!/VDDAAbAP{%wgޟJ3mi|gy؃?2*sf5X@5X@ b @ b  kb  k5Xk5X@5X@5b @ b @ kb  kb Xk5Xk5X@5X@ b @ b  kb  k5Xk5Xk~b  kb  k5Xk5X@5X@AW GVuy3⭛wkXT`e|jr {v͓mq;~vb4-fس;lb q[#ZkQZg]5ۆXzoz鶁Ewv6h7u/lb q;Nb-zAfسnƚmC=5nŷ 7m`Ϻk mf{2vN&,Pʕ>z?3>X+[3hmZ'*өk ۢ叮Hޖk,5֒NN}W]}crOӉAzn 2b=}(k/4lb eŦ'|dIs}R9 ן;M\6X1>6mZzqBmyk ks[4;N|뿺}#ڽ2nI6hb-5niکNM_`62nMj/ uҡ7cr|K~~`ɹ:9?O6h=k+bOV}G9k ?nO,56:|[bmsH{w#GYܑKI)Z>%B4ЈbJ[1F`bV[@mPZE%1RBZC hiSwvvfovf{7s<4?_~{3ÃS/wT*> .9vs~t)mN?F3}4?:6N.@wemډ_J[9vYm(kֆo'Knp6oaޭ3|'# ZVYXJ/G)mg9/)k e I]ravG VY{]{i[7~H[eaѾUvEKvodeM:@|WiemfWn)<+~]E~u Hw+Voe5iY΋5نۊjF-Km[rAk~qkz(kg?LZѾQ/ X΍5نKSNVGo>xa@mW/}u0UÜ3іh `|YexMsoeMpk\7%xt\g~3vGܑ8 hEh+φZ?*kw\eM[ڕ%L!YvΝjϽ~;}E .h: hEh㽬ugM򼬲}m5ن$ܢ $≥[$־h/7|)k[ERVo0>xάv_|aVY^Ώ{(lCY5/8~,kK6niXٽ^Vo0>xYemn~Y^ΏʚlCYhU#ʑ0dYtƼSv\f6¬ZѾ,kwSJ+kW^Ym(k RV~UsMz_W&n-:y̨Vo0EMujie-?+k e [V->?u9Ve!NTz&F>V;ʕaxjOm35 =s~5@+wkyvv36 Υse+65nigݍem]?pEt_嵥ՎO >}ԁV0wHRZNYd&ۇŒTZoҭ錐lGǜw>]p2\NGK,k9WjYm(k :^h΅*k=7!VmBK]M;rM 0HzYe-'J-k e [?34Y*]7>{`m_*cN?QNo/!r]p2^tE#\V)D_eMpkiO_\.kq7|qRSF(#r]p2`uYro2J.k e f~ֹo^,`ܭv]Uw'Cyj{^}V&655e e @Y@Y@YPP55e e e @Y@YPP555e e @Y@YPPP55e e @Y@Y@YPP55e e e @Y@YPP555e e @Y@YPPP55e e @Y@Y@YPP5{TUV# ayB $IW,'ԔI GHd42!-'5I-QLð{]>ܳ{ w b  kb  k5Xk5XkPcZP{ysd8dNŏw,x̘'/|dwm|f;@托D˛rS;qu9z`;o׶X@Pz)dkw;ιP؉cm=*oݎ]tfb Fc߃Rܘ=Z#ٮ83ږJQ۱oL h#7n?ؑ\ӥKvr|wn {>R$k^,nMS}윎/k5{17Kwg_9gF'ŠW/v^[sN_8>}s 畏rꡓxnibmy~Z2Pu~qc׎1oM/nםj M؃G>o_Xq.Vëdryycs'jbQݳgoQ{XmZqkOZ|͉]S޼zn!ŏ޾!TK_+W h`CrL?ZW&FLʛ}ϝW4_~f̯k7+miN':ֱ67W hdM{ƻMa<Ԟ1.\ -]Bۏ<Jo>|J$>ӈ!ba.4'o{G9zg)Ywg64Ka+k)O OCC8~{$b\)u'bĸT?U ZLU#Td(IWsǵ$3o6)1/2=d4d4cV-0ɝ.X@#c߃|-y"Zq`PvRounxy՟'jc$e;\%i:/O]:-tήBn:|cXXΩ=ZW hhy=ȖmgpclJJ&jct*^wJS4NVf;\ܜX;(euIf{/&Zk[W hhQ쓋U oSX€X{9DV*I3Ph`ϊ^mXF3qS{[W hhFl%EN]\g>!QuTDm=NY*WI5V>Russb?/o.;qUOCO6n +k4=]cKF=~ (-_R7Qkk p~tDdM2,}ZձqS*ֲ+k4qwL qx q4-[x7f o;cĶbp$RIF[&Z?]bhUx;k^X@ҭ?W$xmJc3$'kuK8tiݺlBRS⁳#7)֞{t%Zȿ) B8=xP~,5mz1OкKǞI85v?~b[Vwl1voId%ހlc{)WRzIY+Vbú=G&'.e2z>8qs~Ϭ:k5>n-Io=xpl2DLg#&kK֬q-xu9#y_q0k*= c:N^qoVȮ%Z̪c-o_X ޘvɣ[5K4l;obVeÕ!\4̂5W6oR7V}닳_|;k3}bx!7[gbC2Z+FSC6bp#nM-d#ӽ:m8kb-:|Oŕ[X65k3}Pή5ZqY'6\3bإٽsBwcX&f}5ۊm5wI5w 3d-Cb-Ś{zҪ-f-ŗ Zjcn_Tt^b v2v}5 kXkb b kbMX@b @5k5@  5 ĚXXXk kX@b @5k5@5b 5& xLWLxE3CD! gHJKjg~UKUϴ*ThkQjt_CjӇvkqČLwf_(*p~}4?2-\ JY2WmXM6Aɚ_~]ۃcJRce2֐H%xG;s&c_w8'@zJQH1^橸F) 2ߵ=I q'@7?+#JmfYO ]e a7ѿYg˓jSlm/k,/kˉئՄ/em$CEF6pE~P? ҽ3Z ~H=QlAz=\VM>ޓ#iMT/ {ҚBcT  Å?$"sY -Qn?OUR:ŪS$?N7[iO|Qdm|ސH&Y\:Һ _y=R\" $H}!477j fۦՄ/em (T2u7徍IS=(ʭ(GLYְ*Ixi?|n _{WL|k3' ;SjtI| :Y0B^-^dk"AaY[ϡ ?Dz]*C&e{.RwviɆ 郺cTd$v}]mԍxy*"ӎYV?[;n&dٶi5Y;~5sw#Zqr)ee %]=Av׊^KCeK|㈸6ɜt6 mnE!1$kAe-4x`eSݨގ%zwpgL,QX1I+ݧωЬN~s醳$`,k/~zs~p2t5+T ^$餺oVUֲ&v6$kٶi5QiY~i|X9Iv<)ʽY~fYRλ5-{&BP/emYZYs IDATel;AHpdAܖ2ʓ5 Fgex  OE?m#W%λR*a -$ᯊfy`$>x a%kQ6]DZڛVUGMj fۦDed^ݍ'`e)[[~fYCAl=VO,|),U.lgW|dF8sEC=1i5\X/=q-'co|KH`ZS:?4/Wg2rpq8xEd^Mo. <›kf!>i[l8貕ECҜFNdʽ#VUvGvVHͶM ZTK(sw6 @ϊ2fY̲֭(<9KQ 䌼 's5~ڹuCN'[(BKKhbtذb^!Ŗ+c,k@ \?3'3dMI~ ߾ƪ [B}M$kٶi5Y F&=,Seͪ3iXXHNR}i3l}th=}y-(A'kxO{"oIֈbDǥ’7oANj[em cio Y"3FD]V]D|xR;J+eMZaH;2IYӎ+5s,НMe w**^gZ_MGiW1Pjk fۦDedF\46"LMV4ݨ6&ճL=Y֬z? YcI4 A3,d2)M Ǟ%Yc&Y#GñGAv8'z*kҦe-_zL)nǙ?II`*Wԟ68]qYJ 5EXfQlm*kNgKck;*;xxFIڀ!JimQ^`hqR@)-PWc-SPЖRZ -i bt{uxȽlsr/=D+KƑ5X.^Y~~&\ZɩO5Z!~)5=M7ZDκGMr=?jsaR0"o'8u k!a9vi}Zwrok"/[O7k{i5yVnT=׽;#]c$x4gYs˚~0R?t$\wxYSKP—TdFxYCֺh[\QKy#WY$o_KYs9aux㔵JkodZF ll!"MJd-7^ =z& ר y;1nns^iu?yX.~+km˚>#?3 _֔z=fVuE۰d;0+5c?aGM'c1t1\)e͘;U'gwt떦v;;Ò\֤ߺ5't2cC:쵩"mY~^Y{zZcWn )[{0{ F"inY;cs55[9=Ty#kjJY;O?=!ċ jK5Y~6Bϔ?o~@՟",yEdEn 3[ܚ]LO镵t2UbY{XCA/"k3t%y~'d;0:6S EZnEeB/8h˚_f:)gh1[_}3߈DUzx rv\7HTs*gǂ)k[Ѳnӟ?x৫?AYW⮷w kaDt |ӡȚ1g|'kSа>4&3vXdۘF_/~ۧs)L᯻im{u視1+kS^U5"=w eE;/$kRVdIe\CȚ\hL7XfWėFht:[D?5c~=CZVxcOzÜ`b#R^ kGqHe]^!> b~@%k]bcmY>n~͖7χ|eMNuuL eMtΈ#[\=os-^14JXj[BYszE/7$kVf5;z:v`r u!kcwz%kpcZM;DFhF?is^4v4S=J2mzZϋf\޽xwl&7eX0Y%k~5ӄp=h%D>eZdh?~>ݤaZ,{J[2Y+l7sO)O~{2k,ɫG'>ɒ |h@V/O՛”DJY#[̷a_)q5'Ț15f\؝ =c"k(Ewg1-oF,krƙYSndHݣ[|#k:&mEmVH&Y5v֎Oflc˚<mf˚MDd'g&$pdoZ|jav`r u"k>6F#kYDht9dM9SF-rsSNYU꘽n9 ,)yt6٨e- k.ًmƏ2PJ0ZX~a0H(5ӭSǓ,kեl&^|YK67mؐiڳ Zd Y(H]X$bݐS ʍ&׀!kTEv%]vLVW:ډĥZPn$0pڟ+Sܜ55l 5dSA DCn>]xa L!ܲ{RUfRd g;{RH5dr8}vOT !k@-XwEG~[G՞kU+V kP &M[WwJ 'P:!k@=k!Oy kP/|"z')@֐5d ^&ʪ+5SE> G]][d Y@꿑:3kS}v(3@֐5d M/q+e$DiAͫqV(ˣYC5d3f㯖OYC5L)3+ k0RP d YZt@5`%j6x5d YHˑ"s$B̾Yk)JYl 5d YH%+~Zٻب;~&8!@oJvЧPBK)d`B2 0vCbD: a* L쮽^wߵ=)UX# ր)tm[lY?k`M) b b 0⦔pOXX%eA@+mp^*C3||?5b b כJ* lRs)熪8WEj9bXXtI"'XIk]5A()xeVĚacn&ˆ5~5 kav4S b @kfwftԮe12Ue`hnJT|G DUHb YNzM]o75{bFk@XzlB>N*54w1'k5@_Ժ֨3lL5˿bX@Rgng@ڣ!k/nW\G'ͤkУo_YWNd%sn3_bT5b b 0VtRBv^o%iaR8B55;ђۮPfwW%1*"`_6Q! ne@߈}Mkb "5@?-pjeeWq!ֈ5/kR(u˲Wc\5b 5k@ygl*i%SjbX'dVkCwjzI&jX;BkH6 Tޜ #nfJwXϸkctrB sW%2,r^o&z XX .)4ڴdwڪC ua>MH5 ֈ5@a*5#9@I[ sWլ35b @_d@8 _-}/0GĚqbmDUX3 ˆ5rkEz>bw@b0@<F}ȒcZF5b lhLp}R8Z5Fѳdvg1X{q[/  X#րQjfX*F} U ֈ5 BT^k O"%FyDf5b -^;#|Ǽ)F @k@}Zs+F}-rU ֈ5 [mbM;|mۍ܆ ~"kgV~5F5b ZwTb @k@T\/g+59HXF5b M3Oc~nEU4fX.뻈2uyYsk^k~膵fcyou?hNPNL!xl;;bht*_^ I "6ڛ6'(<)Q_:'2"3dJㅐu":P#ֈ5 {/ p;D>'z#F*LumMD&;o9&ֹ}:*ɮ%숽FDŽ5]>fX7L~'Y7{mOPX h^|9oHUhgDR΋DN'< Ww`9Fn:WX5pl卒Y &Eu:wсNx!2nGŽ( [x kvh{IVA޹Uqq\\vtp " mcLjbPM_ F1 F11UƦJ:qԶݻ].pqw|!&GƈSF>ZX#%!Vht? @ P3^1Sw_vO,N)dF԰5-":o-Kq)uD[#s )G־e3̴eš.jN*bw 'L9W[Sj283q&DŽ#rt >pI"%Vht? @ PMS:<(|rt 𔶈IQ@7־t}y55S+_(6~M׀Df\Xs #*֖)v`b\ܶG1f ?U1e;̹mWÓͿgRlZ wX =Ê푒m4er{&`r_ҽ}(B]OBq"Hh PjX՚ʩ[6nGk[&P4m1{'g4&X#X#VG[^NX+_@"X3*v~b'cIHO i{{^ 3" IDATkc& b$G?yoGNo: -{h$X#X#T+wBWDfPX̻)`MfPO g9<~]v6KY15&U|⸸F5MbA`p{lpgnR>^uM/\5kg\ Ȩ\fhּZ:k#NrQb* 2R#Zv .)x@^Sնg$XCKj21ͩly#K⁹™96Ym4]Ea k./cW:?NIb@'[XTvXqz 0}@m4|޻/8N+Έے*'``D&0*aCkq~Ql/5О d=+"")5Y͋&X5^ 3"؊3u*Ke+稣Xښ{׆X׭BD|~9)mȁ[-Kv{.$`K`mŬ#Bk8>0^c윹I{ mI#e-F,R^ 3"7cd 5v r4 `P,&$XښӄLD k0j;)eNק 1``dB}ݠו F3{_EB,.&`MX9V7n_m[d`p-(j>v ɮ \9]SKiX0VׯּhBE `8Ú dW#=kxC( gNXښ{O k@گݛK>- ̥xKIkŲ-7LXz.'`MwX+)%(C k/[BxU n=54&c_ړss\2 xRgj^m4!"0aM2+F X74&J[ҠuL 51Lkcmaey@``Dfiijі3tIIkzֺG3$w`X aH"Ϝd]#"Rڳ`.)`- `-ښּ ^rE\```DfhhNDf~X+RnkX +X(W$Zwš{tKe񒧬By*P)r@@@h)P(hR#AZ@ޡRJz"R)ش(EyXiAJfgw>df{;ogCz-M%5qs۳Y ?Xd-`.PtfE)_(k *gfDRP!k)d+ssk̭XsZ0  kUZ,mV>{K:!kdSӗ3_g+Ҝb'G*5 , kU#Ț kD':e|mTIMmPuWkø!k`Q/Ob櫩֜qd Yd Y'flڪ>FlQ+ k k_Zk {t֗ad Yd YVM rb.dXYCPA@֐5*jm흕e\-y; 6}(hv}7>f\vM``YCy!k}L7ZjO+b\YCYd Yf!u1 ۸Jh\tyKٌ* kؕe GYC ]"3M 8(@!ģd Y0Qu k&(@֐5@֐5B2[VwZֲdYCYCրfB,0+Ƙk:5\BYClDր Yrv{%3Bd G%k 9Q0d *j_dj>$k%2@8N%q<5 5d 5d ߯ZE 5d cd2G5pU',kox@U cIO k(k|] >+x kiT5Td Y@\k{E2YYC58EQϐM5@֐5d ɆRO3Ý-jYp3,@Ypa Oݎ3!O-bnK^Ad *Ïʉ3K[D6q2T˻$޲مKfH;S3YDl*;c7巘vA"F}1u{to[Փܷ˩5K5,YLY|v>L=黗Ɔڤ$lݚHZ3qYJN/a!@ *a 5dMcxO7*\˸q5^of[bO ʕk%)[TZt%Ed Y^n]MWj¦L=]Un'R;S[7"yq냾:eX"+kŋ$_̹>JCʌIRQ*Y,f"ʮqfLY-o]QM$977A*#"xkaOF\ k-ZjkRY\YkPO-te\˓7[ykEJw#kZtp Y-J~[d Y+(sI72\A׷I[׍،h%_[8SRfsOkf|택{J}^.:ƚ!sJ'AUbHa]w%*JEꗵUʗ [3|5d-JH k kȚqcSVʾWN$۲^H>Y-F+)6G;%#^[/a6W;i{>1י{Sitp3V2;-Z JLǴDJ_9mN9OւWѕ!vh kZ$>;s-ZMZ|҃0@%k^m{;:eQ䎣?{u|1"K1"~lX{ANĎkuro~vHtyݽ@}B/.o,/5-gtviTjR|Ce~/pI)}_3ZX'=[cFnRf=M.7QNlwƋ"{s)0O.]&L貆N ,͕"_MB֪&EkE^)mȫd-x]pbE)dtod+m7 Y'S 5g(eW~i%ݏE޹GGQq$,/( d#9)$BTB@^ 0A)  ! ʣ V@ZrH! yܙ ΰg>vg{'m 㱢VQKkF=0=wM֐s0i%EFcg&?Wk0-/X8'Y*>p䉽U:/TL2tWDe 9H50U9P'C4H{`_8*I>2h6; k&"P߬5k4 Εy<0ybL ւk*\:I)6 ǿ&_k kuk0SWR3O :ѰqW;fB %Ɲ( gָA,|4xh% EOn!2g5tZ Հ^i =r^nbʦD Xid@.p' k&"P߬5k=ucb*v+|(ZGy:J^91qHMWo-RZ,`u^8˒K]6MVL:qk:X&WAEFE?FQr,ţ QK dλt#D]^ 2r{ܓ5bZ؀<}C#Mrkm!Z`T5sР `Zx-%7 `-xԿOIogHJCK atfcX,r],x*kc7.ΡBJ.O5Z6mv1Qk4_@Xk;_0 ;G!gbr&^[8 쮇:_}tǾ_ǣA$f (6 `Ibf(dp^t `k k&kwa^`Zj_eN511XY+>aMJZ#KU w yTx7_(Nǁ'y3<9;>z> Mh{ +kmR;gȚ\Cvro@I*Y8&h4ӋX+.c'=IYCJ H!/BZ\j_nX#nS$> x_;vo˶2a0͎a`-0WM11X )X:kkcDH5OTګ0_ AB& qk}a`,;yP4礅&5aC75;]{{ym"_el'9kȵ@Q'B%CVHi`Ƹ87s k&Fg܅im5k_-;55]P?NҰfZ}r2͆a`)t쩼:d#>* ӳQ paLnzJR̓p`Y.ku+gT-8ƺH*WyK~ }\4 -Xӏ_weTo?^2L-GLmbT&pMJlKwR2s{ܓ6kH%~Ѐ x)HSlSlaٴSn'? _wY'12aʹ6 . ym·5 &ط`-$` #yNQZX##gz(f <$or- M7ZI FIKFc )gs?FE?FdN%񒩅c?UK@t@=I5|Z^#2  N*찃5K D 4_c#SX3b0pBY;k ֘1Zcb? k$f_:5rzݾ+rܾi ҏ H$haĽg^r)|QZB&}y;V Ϻi9#&kXӏE?;F*n'Y8$mnI\ "23K5xZ DUkh`欅 >Oj}f4Y&@а755 /ֹ C'd^a`)Y-wARTwϰ f\7%WX]KYn8VR!.U(` H8D % R@IhB$P=43}Lwׯ}3n=,2e~*r+ć(̙vw8Pxvo^[,UBt IDAT.c2!x<'v|;j!k !k"rz-͠UYs1&|X?O^ӗE9 Z"ml3OERkZ|eNУl $rY{ZF9#kBavzu~>xvdͽ䟮;\a5RMmY5ڛqn^P\s]<2`'d7,0|wF@֠dAYC54]+E=AUlJZZT<P>\aU;߇nP>s,vBEШ!;}Pֲ333K ;5d "8sVU3GTj- Ț{I_7@ӒI ܧA@`J}ġ MZ53Wy)_-G9 k6Ț k~#k,ZKf#Ҁd @P  k/"@Ash#_8y<5p\ 9H-`2#OsG\N F3Jd *us׫c5~m  k R?^ʚwJ6d 5C+^(5õܥvƀaȄe^w3'Wu5@ր Y*M% k.[F-%f+$ Yгi4oҀن tJ-H!gj }E[@X0INP P_::NڟAk@Xpce*YCʴRjkR3>$rhm@֐5@֐5F9n=۪Rim@֐5@֐56 Yu[Z5d 5d <ށ/6$v,ڀ!k!kN AրJ 5d P Αh)ۚ耬!kvxISLPhu@֐5p;ER D):E!kiTL\zq_5d N5ɡ5d 5v\LTKȯ+d-(y.ץ)?HwQ=uyWtmӢԚ>>!=h=vEcs.ԍOz[w3tt/qٴѫHa+s}YC֠tU~X+byt5dOJmmid-?a֯yƘ[n[NFU1 H{YfJvB5܊ܓY禍^E !kFɚd-v!lj$ok*F쓵7Ƥ*O&ibZw4oD|!~HżZy" XDf)UC{:! dEVVV;R'C| ˦^ ;2+AԹgR5="Ud1+ʗ/OmH-?-\MQqRgs,&u/DU} 'FBrN@Ĕl[YC dܜ[5Ey%ÏOK+"7ps2AdS M1^>_+OennY?m{Z|aK/_I4W=m-JHm²LUE!tY3,S̒JX6m M6vo= j {]28Únc ȚS=7I YH||Y%L!՘Ԑu#+dxeceH?wL-3#S.ۛmHfn']8P_(!=céֽw%7k%7w!ER?E[&~d_Yu_^EʾKcgcXV UabL)/kEeӬ6LjtrdȺ]i; e֌hZ{=mlɎtHC}֢FU[;^=\H #.kֹY KZ6m EvIxVO<67xgEJ-VY@֜C .2bJls}]{v574'ks\\n)VMo<#h<5YkDGo9'ƛ}ɻ ܵiR`ɼ{Y+ "7|1B-EK9_7l:GHCm֢ #P{UD~de:7)qٴK+lȚQ5v3񱵠|-Qc{Ǝ5=;ՍG}4^5Ț#vX5hjX$o Ck!QeEVT8iuM>Qٸq/8Yץs##o>"rv2h˼P^5Bgb+_L(n7}Wތ8'8'D$ƌ=kcS$ŹS.iX|֢F(Y^o˚unV);Dl=(3H]. AYjH"j*(A"(ZV1Fot#5jhZIL2Ӧvzݽ]dv}=\~}9sF u tmp,P+.,3k通O8q լUBqX;?uf#p΂]!5Aoq6@W$WRXC7:Ƕ ȕ\4k']IIt%3lfͻ9aEOl+'MeD}Y\Z}Z#Fj`vædtعs:.f3*!F0{Q -5.⏡T5sof%<ȃͽ1SوbBcoR]qٴ&_[ָzmSm{)g5ѩ/qP{e-4W.Qz)3+i23fE:XS&HKNS~eVhXֲNC#g5)CC26?c;Fj`uT;uJC]fTB8(P*/f #5~L>n|w"j݄^I P",{3)ڦ%OR7fb*1^WBK]qX!eSqX ٦*z?)7BQW1`S:qMF2Eq Nb/Dq,hX@wIV I C,J@}4U?Uɋ>#PPy'q—ur?<[齗W0# kLJ:wS7T6b`m90MKt%yB`75najQ]g5n+m<8FvmX*_qYENj4=3V%hl .%/ T)Vmp5]+8Ú)e!Ҽ&v`53B0Q!X4nT6B`m+3fĩ o$/3yĒ>JO*.~ ˙Ђ5U.5p`aԛh҆R'eM?z͚]uXkָV) ܸq͚aDo _K I|SJ$FHPҫC92U@|bdUYo/Ŏ_\󥚩WOz ;=:-팿f|Oz3m90(:(Hg0fԷ^8ZHaͽTB8(a͏lű(0 }u,p``ԛhru]ZAe#g76Zj0讪ͫ8q V[##8q/`M\IpB=[,SҖr1`i!Mٺ_F|INc0k43X?jH9rFᇊ2#|\:5#ye*e.k%2vЂqn#B^Qpiš703{Ӎ^ XIc{:lGqXbsXa-0f[pu,7%TM̘jZ]J-&%25nmokΎUѕ9t/VosrXT; {jӜ:U;=.@3zߥ@=3}F>0\3~&4[bA!=!Xc^,g̃_/\rsCa GPʙ:-#` L($cp82)8 &%p%)4 W#-GBlYVVj5?LG"[Zh^Yc#Cj{5Ǵx5B5#WakY/kSwޱ|.h;YD;m,JCJJH+m5 Z!kEκ,{o/:rAH9tyO3!k钵"4S1/YW+yk` Y'/dAʚIo^YvЊY;(rp#7v,YY9$Hlΐ!k9+[*yTXDk%/&50 ^'2Y39KH+mY;hE'~kHN>O3ݧG"kZf',^z!k8?u<~˶) T7pm!9J˒|+FN4n!iyyyA.Cd59//%2d-jȲ"g|i\ÂC#kPRjyRgG^XeXk} /5߉bAVEntLl{BYYHsp"k~3F~F/ ke+/o(5&W~AK`kUdA8ɚmnA9sz^f@֐5@֐5('(6M)|z+d Yd YraRy6Z_dխi֐!!k!kP.lT/sSZEX>@֐5n_9en CYCF,{tSD(婦@@M5d "Y;=uÜ_"YCYd Y\6%6 .A!kP3r!Ѷœ~I!@֐5(CgN@֐5f:G&6kұwzMǝ k kXsjR6kRTK5d 5d ,fRO k1NTG5YT 50d fc|جIoi=Pw59I"XKd%lOlפ[;؇&Ld 5aŠ&Ț|C&PVlM:5`v 2s5K&PFl/W@ր!hT^$Y(#LY&Z3Y{Td Y@22;$2a:0#:qpWK;L6PF4{C Ag4ÎzyCy*#~ۮZO 52cԷ@֠3]혯0z=(bt~S k`?U]*e{YՀq4Y[D6XKlՔz͢P{ ٺY6yOЅI&@Y>#Ej,3WE.VR2Dx!)"sDi|Ǯ(Es"- iQ}dLMKkwiW0y=M,񭁙1>MQ|PI}Jr;"FoYXdƓme'l$ٮ{85Ѵ%3"&IJٶ)HS!b|Jc&k; JF "UZlD,ۋEwpyzr=3Kǁ7D{Ra)\c奂C)4Z &_Yӫd|d ާDI(b?fqCf#ˤpײ Ws"[wEk@hۖ,Þ8ͨ0SV\Ggwͺ?jJjQ&x۬]Qc6GǶOC&qy(o+mm^+)h;,eS{i!O=M,k`Vm⋅JRS1"kޤ,N3DޙGWQq\^2P(E !D&@ hY *d051(VŲ*Z ([RTm(Bz:3w?w}gfHsevy'̢v5h3 M ,7MM˿9<5kLUtcvDo]qDZlq?XbbF֖fkܐ i>G[XBm:@=1X;O^J5.+ӽvSTbNVqrR3]v]xm#0ecZ-YT>KU5؀čmj柳Hfk ,baɉB>>m9m|UC]tT TN3E3Y"ln `mxk ֘Fe99T:^`&ڭ?}3AL (Z5 GXIrZt;kjg)WdK9i"by[ks&f!~?ͶɦQ~Mѥ>g|=~KG!gyXsf:WI6 aCJgmxk ֘HɁ(`m/GM`f`@MI?2ٓ.yc WR!Qvٌ矒 _S|Ú_ǒqi EpޡO,]% ù`50 y}|5r$F51Fٍ5 k+Ljk**3vUr)N k _מ!s׮Tn= ;s1XcbA]ZZ~8NQ211X kYc֒+\Bk ?8) yް&O(7r (dԂC<_P? 8*: y'( PU.0Fe槉 .9pˉB~ȚɦQ>M ֪U:aMk@ѝw5hϻ?]p>LLnWV1XcX=L]211X4L3`DbG7 `Q_=<8Y='[E4&KV&ٔTv-Y-o$=1Wfewvޏ ra R@W[-U4u8Et+H*՟m ,ٺ#4ʧ6Uȫ@OU[kU im17kt}B8QJgtTf1XcEjҥQ ~6&w.]XE 5^]kt {) Z{m2Q<,ǚ1T(d;5O̩sQMy.gUt,ߔiEKTB&j1x`txۍv5\r&gGrj1`DcYv&Hb^F#?W|a!FfɗL2fMב&i3[O4S`ӭQǽT:Wuf zb=EX[+Q&.ߩZm&ōIe :k>9%Y-v6X ț;.F-Ӗ>BvV8?sp;S<=0 莥npΉB^~`M9S4[;SLQ>Ge!"p򑟢^ xE\nR%7ԥ k4 9ڎht<5kLD3b6Qb̽%&k`mvs=K.f M!Ոքߔ bakdͰvB.6Pe xl[ (k4i !*=0JCH[k8DMnf!~;SLk FbWUx4Q3 S;ɍh(Z*5hT.cHdb`S4ޢU@IL b@[b0B1/ {÷˷ET QͰ,"UA5Y3 1NfD 4T 64ԷPV -_i(š#iPZ>'jr5 octjZv:glYsfHiYniW`5kL7k<EX롔&-w ňc9qR N۰;MࣉqҴ%3˃goȰF5ÚiʒM!֬ɚa inyQ󩩿Ŀ XF$b򁏕4)z? EX3x`$L{|TW6'jr7 spI,?)!H5QPGUyA pKT"SO(=b-}eݙݝ]gLIv;~1|A$1"k"K&3ݟ!T^^oZ 6M yLiQ<Td YdG#ڠ kZH~(meD7M8fTR$_S]>͏5ṀΖ+)zm2(B}Zp7;(I;<.5m)]}->I#u{(R6@c6Hdތg[Pg6 [[%">hN};N 5dѦvm7}/gΐ.yɳ=#{K'?4,skk:GojȚc[ɚYs4W"saYs4.1vQA5f[2k#|+k"7V<ՔiiDK2cPB1AEIb U0 kߖkq=lVuXAY WN앴-#kk{?'!4?a)1Ț98&7c?rx^ uh~IwjYs]۵礝h[:㈭=왷qe-PV)ζK/{WY4V+kG̞t5GV;:mw`:w0NmG|Esf<.mM5YH!Y|Rhm"ɚ|U1ų ( d-Lm3KSל>_ug5u<}X@֐5Z66"M k `-N A$3'R>M,Ƴ!gȺT6Fd!mO|09Y#eDȭwl!k`"eNzJxd 3E{4mH'?Vs/|>MɁ))y[ݯt["Ma YHa|AENbDC$kF&2L QCD k`eMTg*ue|8eM3CÔiiI u>I"'1rn1jftSULM[ߜW4|oBP|xeMsUsfDPLXPHO\Iz9-d%[g6z<\E.Ux-<1b>0ޅJFY:Qo5d 4<۷@6f"ZÖ۾|"5d X"k d{;d YdUjx]pؕilɄ=' k6;4>M]z5 ׿7XFB5^JVeO?~u/:j|UUgBWmV1gɹ3Old (wgYK 5wiR}96*b5[%E m@ 6) ؁[u3W 1np+ !!k5eQ ?]yrȋ}_ZD7 kFX+r'X}BZf hli]C`&!k`9,)pFi iS5c&(!k`9vZb}k{Ara 5d YC<W~mmQl7d ir9!k`9h'k{Vݳ(;Hp`d Yq@#k#ߎ7C}Oe(_X;ڀjsF*}YXWǗ4c[3qQwTm Yd YS\M<6N0^_P†ޯԵ( k kZRzT&c lzmew~+P@֐5@֐L^SQ3Y6d Ysd YRRUW{6b2b5d NY!kb\ keG=Y ^\Yewsnc"OZz{ep 915d vס=e׶ڷd- #k#$7-dYXz-,d`Wj/sJզ|"2<$'FU{ǵ{\Euqc;$6 Ic 4 ! NE  5MP;!!РQXǴ ʴ qN>ݛsw9ٳsm{xtd$0!]Ay4rl-^LamaV΂Pu,<[{6Z8ro,ba-#[YL5醸7 U~cD<+=C28Lq1ݰWJע|zlؙhmqE>+>6?f"=T5q Vw+XJUvxkָڬmp4Zk ֺKqqX4X "$h)S#O 4>?&]%_%`G)q0J$ߜY55FڇXPE6O㌇'[ˁ\P k.!-DSo՝dk8qU㚅_qXx=Q/x fFsԆNԳ--D켰o5=U~Pe N3t k$MZy,>,8־ZjW55c[c _A`M—nMh) }@pyAJթxT[jY=H)g81ݰWBwOO t|k66> L#@XP k.!ӂCϑ͋NOwsXV6 ~5%z+MI)Z5`mNMVӳ=PMҵ/d2ֺtBDl-98 JyRS] .IA`OvLɑ"dm-DRJ)juaL7̕&@2T? k9УV36>a-a#}v+IR&prx᪑y0H|ضxkָ(qJw⨮|1}\B@/?6>>r$`3H:eX(9>t?FbO"o0\ u0 k4(a583yXo[Țe&K]''y&@ k:cd$e#kIZػX-;g;Sb5ݰW lSc=SF́^)צ!kQ kgC&YiҒ≯Ja%)/[_\a&#q؉aW'}\0` 3 a II)\% IDATJfzyK?2Ӥ@TpĥSnbHa) kʰȽBk&&@"jR}!~L_/)S>6`qrq( e{1s?g0JIL8ޥSݳݩa5jL6t=M2X;h^}~:ÓHޫ Ja%dwdצc#z2[<5k\8qkeXF=?f S|b2KZ`sZ!̩k>TIXc3ڦ,TՑ=Tl SSΑπP`MjReXJh=h >54d{B5:k#]#B۽|0R]wz~EP k!ÁGN? ଱/~ݺ;+zM8qqX P{;m(YpS^ER1LvDN kbls_h@2-H9T% g8n?m:" _h5s`xfʵid+CG|7FƺaO(=ˌ%>?0٥Ja9dS!ҔQӆF!ÚvM8qA~zb) 89Z>#^ kD fܓ ؝E|.-hpW2ӵ=&&Z}pHa) k])#{zMǩ3Zk2[o0|Y8֞VW4y5dy`Z]L7+*Stn\zZVVXn5SM#[a}1pQ 3jZ=&湆RXs 7e ykߎ[d֌'3sX#B489YZkխXK'* nרkȒ1.'mvSjySf: Bb`/[krG6kϳФ[I+8tcR2GmT: cXo5SS#951iy52k SnΡZChpp./dZ<5k\^FuO07";"Vf+=okӱD;$P'`k4Ham2CD5832'EƚR1,C5qRAfHYRi#)YMZx<01V{ӍJp]rvNS[^Y kVs`fujk{XXSuɭK~%/0y+AΡH_(-8u:I8qip?֢xQl7D.k0PXWMYjyJ2N`) k+Rޞ,ehI1Y+>:QkfiZ`Ǜy`c.㕤Yp]3!~aj LN|a,Tr$4@v`Z^)hVnjbh@}vU|k~dR|ږ_sXTpXqasXm0jCi2"/IuXc3Z<IXcc 4 'w- k1d9eQϜ^Fσa0|1pMq\IݻLay,kZ͔ȇƆ k#udsv_eksk!SV:Zp:x;d#֤3fW(#G BZ7A<_=&$8AZ苼 k{pTE9dNdI@$yNCR"(B;&ar{wϞ{Ν=swkeM.Z,r}鯿T2ZN/P&ڦ1CςcoܰY*MDm,h9pv%. %{"r)ᫌ`H MM֊\`3"(^Nh83t+3+9kw=7%\t\h]4$kET&^ωۄ&]̏Mwe|Eɣc5eIceu}fwOm|-\ckNldKd?id46ʑiѷ͝*ɥgWR?եfl n^I&ZafZתZ6apgBk+}ENѹ*Y }CBA"oy="]H<;xH$i^&lW]{A3-˚um"oE Դ'Xɏcw]6Md HS(eAH@5ϱZ@9MLQj 4ڻELyڤٕ&{Z[ww)[GZLr]5$֘y愑YCJ8׻r(uRFRU$ k`YFi9pv%i.Z^ ߍS#d-69Ц^kwY5{G 5px\ 9iyJ_O^CLV˘ӁrJMur=۲ly|iɁ6Z׬Zu]]#O;5d RMYNad 5A֐5HIWKKk] A2IXY7d - DqvK]o@ 3C ڀ9wa]"9 Zw6,w말5H0#č&|e YCWЖ<6-mUx?x(d 0WGoT#k8Uq8v65q Y~}9AػS-@̝*#5(8 Ț%;EE~~I$CJGuJ8d &ZCy$M^d r6#wS@5d-.t}y3D>LC aL\{ܦu:T98T-?C$ a3~^[[8~[|D󻸲q $k-=7p=!"k =[d |k[YPƟ㛋1C֐5lF U/ݕ:( ׸ 瓷BҼj1ZJTΰ/z$~ YPTgdrR X@l+X%/Zb]|9Lm+"dYh>(,)Y(کL74Q"sD.#k)Nd X@5ha.ALi2?3dG-}]"\3׸k, k8`Iy"RF!5@1 k)ZYk}.-XRs{=*'s?HVNz1И'a?{gE%Io"Y0& 9E[ Hy@.Y]E`Aµd-FPXWeC@W, *"%}O5͐UuoSݿaϒf5 錋یIclQXo9i3;0IuCK6>3:LգXXlbA\VICwzt֖{R?Z#љ0:2G-,8`س6'60xOl$Úl,5 kT(i7sši-szR6G[?7|-NPXk4[OXnNqs,zD狯];~e~r')s 33TTq@TY@ZU&"V ZlIIIj36wۨoړQXg3 :+Lڵ 3^T ka܏|*vkfp=0hԠΚ ujž~̡#3Ӈ=tKEe=c[AZX {K-qU}='齓Xošš < Xb Nlv!gkT k%e+ÚADI\ͱ|v989X ^'<>QyD`y :ԫȺ3q)SO8Vkcd1PG]MT/dᨸG.ya$Nip@H4`(S6 xOly' k{Q"]VN9>`^пš .Kw'KO׽fԘͦNX~].Q >rgͧDrQԙz<7:@f==."nHIcšxe5*JkTrnDA7pGlZcAviD/!Zm܇xb;YX muLL 36D֎0UnӟpE:X{15}fz /ts-#Pp =UYX h/jQ0ܭnZ!zH eg]tyX'G)_1Ί.m4S `r/FƳcs%8-%Bmtk%fmrmuaTZt# z kӰ*nS:`eqQQ!"V}<'X}uyu w`@e/RV1pL]*_?gDY^):nGE/u-RuE.ct`0pf`F{l-aDa{Qs#gF>G5݇o;YX_CPXcΛ}l(4s™1: hXru:tjYU&Gt#q&"G(e[ut6stv $WP3\͊J9}?ɟє1RO~.dl,7.\pWW௲Y JNNq~X] K1ȚܹKZ? ]-!?ȃגkڕ.L/p@{P4X 9|Oc.'ocPjOԲK.GY{P_6sIU،wȠ] zq {&>O '?+ B}'5KjHʚ}i:XG),S@? +FY# PnwǬ+TL(k7-CfjV~{K;DWH#/&2܋_g&O]MYki45U)p krZVF},;vٷ;VV/ f(TK-kFkl:q5a:#hnT`U،$BY+[oh/~UjQFK #`/2:%u6e$?dKnʏ%i {4ɍH=?z߰㡗5ؾ>c13J]ҷ3~GNCSn3}q;0$k߯Y:pLy]Zot '&7(obyzym{&e}8`kb2<C},zf5Xy6A8ʚ08>CTg!v*lFSNF:3ҼgdMW-.qa|aYIi#bRYF'eܔ%Rvok7dEi{4ŕ[%oㅥB^Tyg _IXR-uK&̚ ظ-"ː^ \5aDY#BY/eF̑z`0Vvф6rZYgT Jd5XyNDﵠ5ZF5cY(EYğz6ȰM(kn6B䲎s~mAd5X5N\g ؤmbf4(4RHle-eF˚M5*X2Dݝ6xo[b}EEŊQꉊ5qZp6 $0ՋԃQA5Xm_!Ԑ@9eCY#v]̩:ƞM(kBY#5yH+x3;zQQmBY#"e'*$G#&I3ٷ eBjFÕlBY#B<#7^g3Vf&5B!F;3X5ypeB% $iv}P!Y\r{`FxS!ʚMcSgn(kFhkF!Du:e'N(kPH=ER?W*?^N(kBY#uc=5?H҃:#=$i{9B\`+AYKn.HWEM)KEUJ!qeFl$FY=SK/Vy;(;)[ &Ґ  $@HbECD"B(iG^ "DyklJc `(J+"00hnwnonτ\n.^w 9IXɚH!0'pP!P(k8eP(kB(k5BW ⚵v5B!5-/H@'5B P(k$(ljG 8 eBbk7|(k5l&Dp[DžpS(k 5i{ |% 9)k5B leFBAMBDo`KP$;9)k5B he(e=-8{7V ޫ"k;eF!,zeXcrt2Kpw5B b5 VRlBQn5Q!3Fj-E D[#<)kB(k&15{jEEo^@ہ+@?ۥCpV~ >vu!kyVuB9en\b[N!w%O~h_av)&+Mt|`~6]Kqͱ֯o;5TK# R(kezO^k ȧQ 6yY{yKLl kQO欖D޾:_9z~XS5gӵLXu5Зk866AY#-̠gꋵQe>e-e8.WUAb6Q&$^',9ޒґ`kC~I$s&NocԾzS" }^WL2,ߥZUUDגg墍77187Ba*+d-[!Szs fۓZJrٵe00jpfmpR7ڥQnY%YS‥ȓ}Nr54i9`V(L-N3WAEE[mnG,8.-OZ(螔%?>eQ P"} /Ҿ1>,MDgӵgۑ{f&@R҄5+aνw1qe0b5:>cβvȏtME"kw&kɃcᒵ=Ѓr!觩[6{69FB`j@t._ͭ‚ OfxIYfPXiǣRP< U5]˗|NAɾS hORH{(]mϑϳ>eM]K>37i/V+IJr(-k o8TfbʡXT2)Q/|gTmeU薆ۀ.^gR&rltre8pU5}.+V&fW}4dxFj-q2hk}xZoR8ƉkǮxqbOEϜXΓ.pf;Q}瑖f^R\*Yri"MZ- *G? ZO3Mu~Ez++(kFYʚ?Yς?P6sd-)l`kG1ϴy\vCyYmVqvAɉEw͚~g%k9bD0YuFQ7KSEt* h[ F#~>0v'~h&xfRU֌K̍Rum1ݷ9ۨ!*k=n(.塬 \ [X3&{- QY6ԸvܤQaNĢtɳ&'$x$A+V*Zi#Un_w.&VD*s7[th&J1~۔9Z|}@¦3rQnO-GFzUFAPϨh[ (fiO)]jiu6ъ 6~à8 +T,R;G*k%ûK'^\}CO84DeJvSv4ӛFZWb]&-ʺ:[+=\E c׀Dq목dB񚻐<0oӐ{(IXL4!`H0"(h-,@ a" HS:,n0 .$J*ABB3mrͻo~?Ȼ἗{N~{Zz'*W(@vH_tPVGܭA.0:xs˘֩DZ8frD'WZ<χi%XsQh$X;?a+MI1h*{_rZ1Qo۞s m>+;6vs`:dm[^G`-&>&):(.;o俬r\/0Azj4f%rPYs,)XUjãjĥJ+;=߹.sCc eJPՋWAVZ\=Fn;g'_\)&~uDe8 W+&gڦWua;UB5XsJ^5w7%6Yˆ:Bg͗/q9Ox=`<elu @y*!?sj6kL8k⽲M{k5I554%-lgX!% 6f5%ΛaIha/ėp74X PRQuƔYzN%"ՋW9Aҹ܊ C72U_~/Nt]k$*3p%\ٸ3k-` tC^B5XsJ6xX| V$)ԧ擔Vx]nb9R`\`%H kPN_(dF`P' g3} tSgx k|&5aq76')nƦ]>lŲN% ՋW9A]ּ¼ .=;ektUU)S-eJn{W ئ mmnS!9"B} kgOA@69jֲAO789H#|?Z`a-gFE!(Gu1 ?D3@&e&`GgSbUFPWE5o0Z^/1%X ._, [H-Y-TvB%;r-/=VgWn8>ˀ?>6D& rWk]!X#X(7{]TbK=kaz &N[`MxD^}iXyI513]ϰFٍ;Z_2Xf#*: X cs1ˏWC koRYlrYC|MqPDF LkA5GZvk[͋adӾU雧5FXa+2d/D:x5;cF4y.7GiPoxVdOvr4Ziv\fiN7MrƼїk #KĴ:[moB=QpkRROa(!4 IDAT+6Щ#]cJqZubwMӭE`-6I?*#_X3ku%w^j5:c) tWlrh5{9aL]_aoh&N_7a6kv[;hy%gJRՋW9AmV4š-116U\++=:eIp ;.?yzDb R;}DurTE]\B}tRw$U=~7Fe\Hև[BkIւq֩$[8fM##Ђv T?)KjGZjd5 X>w'31$7Q_G;'=QF"Z#@?U>H>:^7ڭi5W#Z OSԎk~| kN'Qq`lE(kC8SAЙ "@!@Zf4l֩$A^3rV-aZ_8䜲$kZѷ[քԙDJd2,WY}Ŧp*7ȗ V۸,彮BOF6xA2m!A8Dlk$DJPYkǁ B`MH&hJL3kkiwA8H=!X#H$RF* @Z_#Ћ9"4S X#X#H$ZrJUGigܣ8N7; _-!5ˣs6/ y<,Rbj@ V!TNx U XbK;sg|N@n*҆0YykډHGA=OsfP(kB(ka76sp_)_Z|T+I֎j k,1O# !ضbe- jGNh}5i(kbHtᔵ {YϾȑ5fi(kbH|)6e-j_Ul|4BY# 5BeFY3bf}kV*jyŹ;HYktRBygeF!^~=ʚ)gf0Lt)Tv(?fSw4hjZ#LWi4/ЊW)BYB7r(kTy^ J7P"´RJgպ$Е8((%wzZ8G(k5B!He ~N-=)"eCK)*EӜ#5!Zh$=N-ӰY|aڤEZ#dLD: etZ!eBe-4U7+(;o eZ ć%ӇQ!OQ!PB!SSKlxMs kP@Y#/95s^QS*FEY#t5B[#5!8AR g`\yYPePeB*`GI(.ލ+)k|S:geBܹ80@)?d(n6 BSkJ8HuOlQ!DF"!mTߎFj#ΨLA qP(k8g![͙7W+ݥYP}$YBYB1 ՠ^K[3|g)k֥lAΦRl^v& eF!4<(kfOZ(س9[(k5B!FXrm6H$0P!_Fhk 5B!$LfCY#5BY#5B^iA z`eO>8H)g eF!.\([F"sMسղV<.I}gaͭMiT*ިOY~UQjnygsRfدWY{4ߛTtP{"vZq9f#˚o0FMfXt1Hɑ"XVPbYfz@_GY䅵$b10 pP֢Ytvw+6Jߴ|xʤ+P6^ʗ!–k0H6Gryyy`EtQ*).Te[m,&k.+'FdSH ?weíKݺ`Dɷ^̡Ey =.eWҐh?Y9ĥ3[vO(86\p^k bDEߵja$#>ȿ c.J7#PeM5em" PH.b5/6匝ְeMl"%㫗KZ}/Yo2HN^"_黀#{:JE3Y8%1-Bͽ~70[?c7#=odt{B]S%{ĔQ˯A= R!8\V8[b9eX2/548o3e?0] z jKhwbM&mF=%܅Պc@uCˆ@-P3Y X@c`-%6 ZZsNn%-^%- uOO[27)K>0zh  ,1HtKݍeZ%Bc/>ڐQC峚hl9wf{2sd6Țe1F3hb欔n[j mx-Gw+Y&[jfF*ʥݒ]\@Yc)pӠ ȸԦTpܵ7{B]SIV})H~ED aT %0T}3<2n4e[^RHZڊ@[cXhx5YUa{'P^Jt&ki}ۃ9j1VV\ћTH_rͳ%7±ưb;.G}'K͜X>Dgha$̚j$ } oFG$h}Y;@ne^Nlq"aw~T#. #AN&ZÕC@dM\)y_UYUm'DMg?=: ' ha$!B!H%IMQHc=Z@#P D(TJ䚃jPX  Bsޙɐݘgwf7;7!y_ސq5]>9pYicd}xO2=k,Ku &¥MPWbo1 ']ߐxOTM4085=3 'Xs2,\gː8X`.~ΰƪN]eiY5R \ޝ֊~0Qc2 XaN|Hq&Zm H-^pK~gyٞڜHK62UzUƇ.HXRbЎ*YW 2%Z+_zφ˪ŰgE`m$pBY Ҁ!'`ƀ15 H~E79z@ɻ? e8.6`’BnDpxWo:}L#1bK{ܦBl oͥZyX{\}m5m7M>-ٙ9Aԥ")IS-ǎ ZmpkG9=K/i$h˞%ѩ:*#VѵӘĪBhh^[N-n Dm5C_šI8".U _KI HV/OǰVО8˒L\=gNZͻ*eHa4[3B$JvrM!?Ʊ Nv1kp5ݨ.ق-aLX?˪>ybXKtXPC9G|G_+,԰sP mݳL@E&-Mfi-( ֬MטFXԊ 4415;;ˑ9laAYkc33|6ǁ< -!&Fbh+4/Y;Cn*MOqtMeV[D5kp55!Fd 5@YCYZn"qW:-Rv"KCCjuھoHCD!kD s k\9NrDrI,50'm5N#s#BaEI! EiF!kD d͚7uRwtu/w'_,{ *j YCYs8Re{zFtOE"k`66ڇS k 2Sp8{3S-d IueQJ dHiun@*쐴N` 8d YdxD滧E&kb5D#5d "d͒hWdWVytyl 5"&_d͒y"=N뷑g$!k瀉QmC5 |^dEA#c񆎥 D@@d+Y( hԻxC֐5@ eͱUvplU'5QAaĠGK!{ IDATkh%hTuV%29($@؉=YGΫɧ F!^!kiSY>JQ5<A~@!k kCo*1@硁|8]C/Zu?~~Ng Y[ߖ\Kd&k U NV6wjeZwUF30k#mmHs \˝I2d\5ө{Ž&j g-Ѫm;5պzZtG3ػT#iBSv쳼v)j"k ,p1k-Y uYKS={-NU>yHYn&ksٻ棪5ې-UOt<(uu5Y\g*!u/@16NNsu{)bv?2D t֬^l]lH֭6Д5>>߈D@dxðz[CTY)sihHbRfdmMR'#ȟEXsؑm-^i_c 1%dEoS+Do*A)'Kv\[d|fy7t:'M<^195 5029.AER+lg;q2w{HYbcRuݥ~ k` kq @ eq>daI5#k D\%^L+kfJڜ"LOiW$C۲[e}eX1nLV,IbIRUjZX˚A>Ә$kFS6% ։EqJ}1_©*dhz=uMNjvjyWrGcet~CBY/WZ*?lgdg<.?8? yθIqO.ǯER`rwD{ǬYoYl/𑵱(t]Ҩ?*ƍr_~f%),=Sd-e v dK{9=_Va='Ho>+k"h,wmaa8|aPD~Wi1=}ySY>ņFdjm+>DQ}>%Mx34zY ]YV>#*neSQ" kYkklXIi<ԯͯOR0U־s-ڻY͙u%Y[?^$" [-ΊӶGq_yEͽ[yќp<&%%Du`n c}>k!"-Z+ޓY|}G@Lf׽?9{=WO!f}4Ë ɺ&' ZZ~>(wUTw\gmql^71C MΤ<$%M%He TH gy(0RĢi*iXT=sf/ل{s9sĖ4K{H"\mA>_/8yJ#"~k IXk÷79Ud:WWW"Lh?0gqè@ a-%0 A,cj}TX~qk:.l&Q~FۀrwWAVH:2w`$7V>e' x,yA,P;:DeB VXB;LW\LZվ除Ϭ \~{֠vpFS"SɾԌ=kst%/K)aA-$G/-UeNսaz'aͳПO|> "Cv)df$OhCHoX!&S,CQe凃xzL=$٤! Ajĸj֒⁅74[iuN*Wz+Z]0^5]wi V%uڗ0BSU1`e,UL0y1z, kQd_jF1aiٌI|'^|y+ܩ}xYXtc^ Q}\j2QR~MZ.?.tT~.YL.ذaBi26cy`k7 Na/IfÒ2 S~U8uhρd2)yhQ~\tS9rxBxQ?Ӷv+i!(sa lt/mNTRFB+ ĩړT̀%~av5lXOL.#ckbU5IXPp#rX,5:=\Q!騺ĻqZ%X5ZR:珚7t(pL^?_g%;+ש `VyH98WXoW`5=7e.I;{另֦d a-a=@; н f:DkT>= kSum.k\688< kO6.7n@hE`13]ޑ IGt$sa/{ kҾ}+v EXcJ,ll:/Τ/ާ0Nj%o]SkёK4Fأ{Y-=[9%=/vWh7B\KA`jZ$/!Yn0 e:Hڼg^L%`-͋քnT!OpO%:v}XTË#5l_+q!qqW5nҾܓ!ڟ0|S4=cz=8Sݠ,RScD.#cZopX涎:%=lyd6A(_ I fs'fX@! IGU5$]5Cj i*n ߂e{uXkMQa.H22d2ȉceh؊:2K tDTa !qqWV<8b-kd +DsTso7hXf+yt֨|{nQ.y|x&8JpXົ;Ckބ5Z@_ʞ>!gֺS ' &!騪N]%C{ ~`:+1+A2+EXkK𙆍` Uo@B[5s}S;8uߠ0Ú!D3n9Zy 8^sO2'TJ[Pݨz`>%ʇa+e.,ԙ8-pM}>,ּ k'̧#: `^ ,lnpzZλQ)<$ZJ ko[j 8eX۔+m6u"{N+p.ȋN\Ѱ y>ɱË#^˚%qC8qqI¬\Vk}mܓX!2HRIETovd>  fZ͈D{v|y~sHkm>_ \wSJe-!9y~DlU#9 #WS6iK@^0mBZL>o[ |(BeduH}1de~SB$TTũËe&`@1#w.Jܪ5}II-`d4{"*?C;fQI]Y{GSf]5*Fƞ_' 98Q:79qjqZົ:㇭qX( *ר_>2 dߑ+zkA(*;,6܂zzTH:,e>_"u+u &sZ_1ɳICamPKy X-)h>#uʗĢ:^P77!3WdSE]5.՚پ $b֤or1//~& Z~K85Ԩ\?`mjӏx^x'}2o;?EkބA]ELlrYI`1N "V^̸ Ȓj-!J/@m;XޙšsKnuXK5vuuc1Udz3}TE?GhD QOM9qxi^I~gC8tqC¨LX]u=lCpX,-j ypUCE؄# sH (`. %%lX(Qӭu͊,U%{ŵb[B3$=!{&O_~Kߗ׭-C@g A~xnD!8f,}Y9 h5;ٰ,m!~Qu;V$o ʹJGEڴYT[6i((!/iU5{ZsVA]kژdKrey/0tZ ~Rq䑉4ZV%ZInǎbSYݚagT~lޟc,dL֗,?5d-ҭȆb[=e1c' p]xP6-kyo ,5r WF~,[Ye%)'YL 71%-ө'篞o{9dʴ\c*X`TȂ?kc|M'yՈP.i9.S{G?G{ m]nͰrG9,4}J@}gjZp{yMzRes*lm-hM ,Lʘt-__f|RLY34x [mp~;(E9eG׼3Ț.}}3>`eq"Q&kƶh]_oN:_9,uHݚ)T|s^GK5V&VI>!}0E"Kg_Y{8=ɻFm#`Y CVooykSo!2ΎOiK֪hͰrG9گE׵ȿ"]5լufl#e.qv[D{, ^MDRּjgԘ-IsZ\wYvz02@TւnX}rwqiZx %rڝWIs6Oؐ5d-WvgbI\>q4e*Ց(`k " kwMFvVs\+qC잯!k5@f?֏o"kYZWvVֳ}"u23+rEdNd YZ"k[ger~ kV7X.5!kP[d%a#k!P؏MJ"kDG Z]jŃ\h`?KOd Y!k|u7YC E5d cT3;d 5@֐5r,Yc A|#[5(`k$v&p/Ŷ:M5d 5d2P5۪ٙ+YCYCjU6טLS5Q*!ՠED!kv`R;,(XIՠf7\V B5C{shx=YC R,s k` M5@Yd 5@5d Yc8A`\" _:겞\Q?fld Yv5e9ݕ" s5d Y@j e9Ju$ Su, kKQ\^Zx5!kV;(Qj5W6u=Dzn*u^в6Fe=۩mG SQ}mUBiYQؾK*hעI˿s4ri‡K6l[xEz/FӤ*Vq5gkcܓ5؛ޮVwٗ uc<&!k65+-k[Omyڪvό,ϕ^o#%3ϓwx^^[:nӷo.+_|fM5?i瑵U?YCȬ,Ӂ!vK Db-sWNlY}{g{g3sܙ7^x욦=@4t]MyA~`Zwdoxj},O}9ǖBC$Ej1eOW2N|PbxX3fЛFnH1XAehOFvm{H557IK X۰HϕUf"l #QWb3=Ǜ1mG͹C$c 0m˃j'h ̣y4붩MLf`q+Vf IDATJ55w+cޖ<:14\MO&X[ eSw$=آi{Wb;tE1}kuPHQs֖ Չmzrf_z-  u &)\_Gf80MI~#Vᥨ_+{79'FǖB!w?SM׀s#`lxX3&Ѭ&x0A2I9U$#rFa( Ψ@GW/{`m*`wҌ?*ޗUw6 ֆ%%a}VC0TGRqBše@=P J7դ.}\0H CT\bc`ιy}>5_ˡ)nS?!8 53! Ov E&"k<9X KFj $-  %Xs = V>>2n'̇L&AÛsEƃ*ecUaÌ@ό,&׃UI5w$֎;iy =h2FODvf@;V3X,[9M?#Q}j$3޹yxsm>[w Y؇bT?~io^w2AP3cX MߛGm$ᴨ\[0N,hA_5WZݟ}ڄb4.دXTƑn!@(7N"kU  7Qޘ jV"uRs̋ ]MpaesPРM]}I:CXԛGm#a(kekk]db:=:+E/Zta-Dʭ/q m0Cۄ}]:j؄i*Q *::X{EP%O]u`2yTu HſZv}X2pmfbx;s=88}>5 orJ&X KӶS.>Hyg kMFf-p΅IF!W2ߵz*%Uwhgu[`ۖMyخ'aM#bG"dԂ+[:XV9¡`2F{ͭtIXσt~a`\뾪-b#(Q+h ֌s{+pNcQsnMk]nKx_zk۩|6u "eK4ut8e H$5XF\i85pMlyz OVs&{盲ۦ9 o#sԜ[(k,2 MSy xP_Ӈ,XfܛYm rư&f_W4)A+cE^K,s(AZ@c7Qһ9_९yXi(-UmZ|p֬b͕~4gaRU6HIFXϋaW`ιy5&=G͹"6E]\Wf# clQQ̀J>E4DͲmU1.P55j@I"Ů ֢k^."ecɭ|.ʳuCEk҇klޛ mZ|p޳f#\9MmȦa=psO ט|>56E_ب۝C%``rh0Zh.e~j4t'X#Xs ,:T]ZQM#tEI@3,$h|W{6xmZ`pg!h9XQ].,s1kuiԲ5_AuxEHdڙ9%wH†IrJp(&+o‰u?X->8k1s)Ԟz|xR*LmxO`E7Zɨ8%3,3=G͹,H.;&p4!//7V p.zEӝsaY(ES.fH; V8О``ͥ*rR(Ӛ"+`-&l5P^N!v|zMnBMQ }FX,cJ_{ih:>_+1jp/Oȹ3*pHf6BE&>{s YbTe?mz/uwQUgC$R ]yB@)G7B+Z RšjNaJ(*H+RZeRNaon}dov99_/{ c\hl󿄕"5d-QY<)ٛ'Dz5ǽ"]ᬗEv/Y8Bp9\AkIu}jQ#_la&kt0")[9DX>$?0HmK%mwb뛭"of%]Mo.P:\xzBP cYkBa5RB4q~;+^ g EWE2\~JMsz4hfȓY֩ȒZVS՚nJYKY-n)D|Ak]6[? Ms^L&nz.k"|TuYӂccat,G)ms"Gk[H?fCI֬-Z`P* j+YJ:eȁX:>@ ;p0A>n! kʚE YCo+ bM#kPIf5|gUA^y7&=Ooo2`0,?n!S+MUGY[]ZZZIhM--!k EgaS̩yx-s.W'XT;󿹃8Ek{@H͙l=3jIbχgM#kPdB5dzn [|X kYCYd W5W3 Qc5d D#{;9@֨12f!f$gm#kvc$50NT$35%V7`/F k` 2 BQnd ^ DYTF$H6oSYٚHIr/^(5d fd-d5& <]V7`3F݉$Zb#kd Y\ Y7{(zJ' Y@ ,?$##CȾKYȚ4h Y ϨEL"H^YȚĔ}sI `ŅJaA2Xάsd YХ! UDԜvBG֐5 =D' &df?Α5d 5@֐5OՄgޚElYC6䶗 !k$SIo̫tSrQl5 !I@֐5n*]|Ո˕*#Yd YdZFY n}9I#FAYC Oo ]2d*Qp!k!k]j':$֍UMc2G֐5@֐5Ёh9-~sVw).+YCYC¾ ՝tY+ގv`R5d y$YC 6Nj.i^O<Y2^iSf\޿ R5 kBDKI)9VeyzRə.3)gwG֐5\^t7hT6֨9I*kv8ۋi"WQs"?v] O;#K k2u;!MZt?X*HrrÆtlDv~ͽG%U^eD)3Y] >&lUZnAhm)ѱ$ $sLjY36h*)-<3;g @´;Fk36IP8XwMz850n7/"WO>P*Y m<.|c5S$ϼ!kZq8C}ԉ Md4fWj=kYI5G|gONMIh^"5<"6gJA*wUTwٯ3%F*7 !!&F)(8BAi "II "P`K;"CLv߻{^rsn~eg5d(Th|Ɛf{:  K=dog!o#pXO~ij04ChX|#ػ!@3qXuiom]'x~!ayZ$aMnض:gT|P|LE/afP,=84PKWmةl>pC K/-k#S;Ou.e Ov.0.oWc #iZnj*u%bG|/WJތ5.ÚY$CIU4 )!RP=SKĆ6l#Fق#YSi#js pq)!95o7bLWZe3k\ 5=DL{_Hwl39E "6`S*g<5a,ڶxqOyCɥE`E+S;2ڪQ@F= +XA`K(>G _6ډU[- k"J2t|) _W+)ac(%rfVIWݏ;ɒJ9ES]/ @lI6eo[!^Q1 x8qXs^#s±3dr_{f]-~k P7f-1 =]F,FjV_o)U\{ >]^[829v˷ohQC=$8d"#kX!FPn+sEX2WBY̺QvD9 P =*Re XFi'܀N?+EaɐR9K hJAaX݃湀;ZL,FYgk@^m/ŮVkNXLHAaڛ7P֣VX)gtta(džk5ƍÚYOQQUX"g;W,g87vqޘȞ+Z24,`!k9[>/6&:JB5a3YJ(]EQ~d .!!*-b]Ƈ01`/%æT9GNdIΤ֢֎p̧BpXV ;0 x23&}f3k8E={R+aOKi's'ӗ \` J3 RZq0uqQ>~ \ + 0̵2!OYnݟ\R?WQP9S)@j]bbIqXuH )UTආ)ac(AaX">*6$GFk`t4 9c*($XGTA, XU'3"e!Ú0}yKK-m}[pJmw`>+qb}o{4 u %أ|Drl`ذvP,lq$Kr"ml,*c1<:Ih(u %أ|l&böR kO%;%66eә&ҙ#:9^XhkntkC{G7}_e`:a ;Xs~Ӹh/7|5knZo|lZrRHKY󒵔7jCt^=K֌[qpyKo6~*1N7A k:^@l kᒵ!ݓ#y׳DqxJKJޙ7^&n$-ZbA,w=T8ޣ{/5﬑YZY{5+hZAj#dK~^}xj]BWVZ}fZ2NN[|A˸DIJ C YYC&YN)烮#m32trl[1h.ًdm\6ѺIێo_/?(}:m$zU#ky֪E&%M+h.o馊(ѹOKp/@~dAXO"Z+SUdM˱9425 41ɚaڌGʎjdh~pAd$kɱY.gb["Q}p)U(+ 5=g m^'hVCXUys6A kp5`k>Q%k9kW%ɳŌN~}4 6{'8Vd` Q%==^m]n˚uXOg!zThYӦh޳}IΎ$i34m=]%Ji0iI~SMCAX6{+ϪZO1ȵ߲fZ$Luqk59 Y4[:Ry|/d-<ƇGWwNhvܛ3dwn9!j}*w{&ӆ՚rKܲfB_ZrYMncύ5X56YNfD1AeMz6͇w^K>-k|tZTZRH֔^W^iw;zw߲棵wudo6 -?ܱ~SFD6]W7貴uzA0 0Nc:[#@%kQŅ]QQjFT]S'.d&FWִ"MH 0-)FȚī6:dMeYk ߇Ы^8Fy"N*c1Pc06P'7YKQ(kTN (gKMjhcʚε.k1D)xj#dM%Y m2}z#WeG/eBHc0Nk)c8"d t eMy?u":65 41eM{-Faw?;-)F`^B#k Zf+feneK5[L Jˉ;џ!kadT\oAր+l<Y}~JTʚ6UzvƜft2J@\вB:?-)F`fYZUUW5*a"Qy׏&:<ƿe,P%d 柋A"$kNIdY+$xUqn)1d~_N "@ k]B#k w;稫o])dlA!AYz@-P m]?d d !R^;ZiADJQ{U׼Z8{/x2^"d D HJ&Q[U7e甼7>FA)"d sw\^SJ{֫}niC^vSZcA1bl'bd ^E3D^@#^M$kck818onD/C 5@4ff kh|M.d=oL&my-57F?01E6 cs1$+Bl 55(&ZSj}gP|ڊVs8ѰȀ֌ưn`o/6 k kffes2s|M}o$}BD#+>|oV曫~+ Ч-V aYCJ<}^EJ]{ƫ 7OY 5Jbm/o*d  |:-#ˈVI'mD[%V:5(9d-֊HrA`yl[?e30 7zHF>MF=R9Wѫ<.yk+o8 GB/++ k/1΁ޢ69@wuA hm2@o,SKi-֌ VOFFFF"XZFϽ햝z\_7x%"~.3 ?tOXԕT`ڃW8RBWsJc{yI<=$Jۆ*Qט5>//O³q@Haw0WX TCb/Co5'X#XWΡk6j,(oyY < o. xjn?_7SR%@LQX @/ (nl} e cXcDzriNA1k`bAoN$RwIv e˚Pnl񍭾1r(,Fm6>F=zh`_Y{XK7L)覤:âCh"ίaͿK$@*|MVXv )w0U?`HdϮtQ65fn&x$sԌ&#>rRds{Otia˺1s`mh`/%,X/a-{`^ؠ7Nkk>9zَDrKLsyh-rv|mZ9 qKԇ+MBڻo^@epV<ԌF{lpSކNejmٙpd y$sԌ&#hQuJֵa vi,5U5H{ŽRMFf|Ϫ1S=Z;p6H$7d:N}GGҬD8?Dv-”g޴(gfܸ~YȤ-TjՄS W0gX|$˒9>?Dk/MXKpoj2 XS*`3X{?LWMam|hf%IA'ERe fdT3qw28 ew5۹z)$)a,oX)U\vOٰufd yߤKrΏ>uO(0Ey{>Շp`my"GiIElcf`0D4[=ǚ"g-uw 26Ʃ``G({]EqqIrY!x҈ R#/ȣ6A11^ EyD*r@R@BpDJ[Pj7Uݙ]7wCv']vgg~EUkBŵ8ɫg8\!,iCVu~@i@ia4ΑamQ`1_78U K$s/7Bfԡm#Rk#|MUbud*вnt^Q W 1Mw1G$,XIy 6cFܗ?ԕ{,O@[)ݭ)m _DJ?Z6u/`M3z+n .UчX UO9I4k[tXSLaxJ :v @=Q}oN]KcHy@.p4] %07ztEXۭ]/{[:z+75އ&qr'JXЊNgQ~X;qo#&Lh^>έ#WQGJ.*OEטͰ6N CC},+[1hxkQBwx-ʾ[4w\{l1?"pfUH]c`M]XǗ h+T7N9 MǺ^DZ:WHCZ:!f k"'(NN0e|TY_$gg)GWZ/J.)g^&m6z|d2pq{3쥡ZJrDgŎsr)KWJi2:Qw%GV1%oyC8t:"Dv)64ϟӆ?i?lv(Ƭz(박ީ!sKUs6ۃAn XsfK U2Hk!YuABXvTsf+5ax?yr)u* ~TpDu U'&6u k>iXk-uFP:-]tWJg20 F2 IDATh)l 7U04ܵ%)RX|?Ty5΁o~ˁZ"}7k[}ZlBq&` ED/"`-dWiC$w(L$64P"d&*]Kan&ȲA2px|E5߲9BU%tJ_>5k';MU)|& wmk@IU,Or ?Mq( k9䲲ܘYX#xJb1)*['-)ݾ S7N X&H@taY%*xp=bkStEYVpU'2bߞtXs478Js$vJ{Xٔb:9,HV*#P2̌/{kӗd_<ꨪn- ؞WPu_;pI@FNw:ˤ Є}"Uma-i?̱{7g %Ib`C416&ziIӁq4_60CY|[;3 cкnl V)I!ZSšhyZ[ذMh8jCn-XȎ5w: 6fHlPZ@?ڪVpP1[5kڽⅨZr OYoMZTmZIԡ&Hbm :H)%'opʐFoQo:_T5wIѱl Ukk^5? 5_ I53k^P.)){,r!U~߫) '; f 0 71n4MJCKy"ܑ^CÍwIOǫ=A5߻53YnV~Z~b6hS7xk®Y.oHiPbSꯆ7z%#]\aCޝK<lA6ܱGJۦP56.u!N쏏8zH5iOhvHlբ?1jDj&睤[fU km2{5. ֤MSS1|x/ sܲX7J/fAYc7SDM1${wu"s0,2A9UpwmC{X3xk­\WNGsǺ}քT']Z/k^^J%5/ްX'; I@y~XFjc`/[c]Zwaڋ@,O 9n4g܃.@RHwh #A^%) Uň(P"PtjRa+B "V:UimjNi) =7Hv{w7gnη76JEn9L'YӊoMwZہhG G]Ju[@R|A֐x3R9͞f)^0O,.V}'$d[mVK-Z;ɚ^d$ҡr'@"d-YC> rY_Rcؾk\Ln' k榶zM Ț^d$xұG5d WsCN_.tֈP kȚ'^8''*Y[ ׹i=A7+@i%Ō k~^5?NYW'Y~^RlpL6Ȃ33:Qn@ U" Z̔RLպfdR`:@dAYwڮzmk=ˉ, kHY;̅YH:c Y# ,JgApFB> FTw9Z9`k)d |)6 k>>_}-9 m߈d!kvQ%>;VY\= ؤd!kɤQbY'ۨ~;'"\k FܵaRoaY@2rh5pRM|wV{Tճ9J 9Z, Yr=dIZ FĶxIcs֭NJeszhf0HN75Hc;e!k k(x , YCYCp}FBYCHYC֐5M3 XǴ5d DfwQc W@bDHd Y$1@eJX.(u!k] {Ո\c>Kڈk!k$VR( kȚF]['*ǵ5d C 6|)iXC֐5@֐5ۏA]B֐5@֐5\4Qj5@֐5rc:FY#`XƕC׌WK60xͶ)__"C/?-3mmBH$B ۞^=˂ &+彲'G[a 6}>ۊ╶ ;Ɣ/ã-hUŦYC֮'9cNt Y7TGcOɝYmx*MdrRZpryg&fm-BƸo Ot5֚e͵(A -6Y kZl,S|d[ZV?=_߈9+]IUeSQ}_JEzu<Uw~"M''O~#n#qল"#j`c>&&k/_5cȇLVFm=hE=6YL^?J5qD[ZuR s8 T~ =ETl$f"OU|>n 8 CR&T{j[>YnYE"t ̼U76YP]kF?b{kA+`YC֮_s VixT$cd-GT=Ez MGŒYd[hQ9̒;e= K1FKl_gPFKQ#ZdaŢv =BS$4aqfd9˚kkXV[޻b5d-+5s<)B֢")޾{UdmD҆"5{DvDlxF,4m[ʈb0jK E2_I7u5֌\3=h!X!kZ dOݎsE/Iʏg#\ZtY dx]ZWfwL빤̜%C-NYɆĚvŚ'N3 0yZdxE֦fImOdt{0ޱ*?QPuipsȅʢ4Reip![JJ9yc緕<ñʱk`&%}neDu[F!hGx㸗a!r,b!YZNR;ɚ{k˞[s Za5dCV*U(x| Y.kP̟SךyV#g7hZj0k>6a=l.xvCm&zXÇvM~927|\5֭*@䈹fBÛ<d98ͭ/t_+R h5ڂ$iv/4nkèRy{xY֎U:a9FCDW4H֌"2>Z<2"&bCB֐5\IlF[C|)kSD  T;~B$YH־[rۤMOxn_eO߀^\J֭m t`Ȫ aY۲*P+_Yw[S{0D2=|[9]ū]">7olWoʒϛnF(]3?{C4r* xF+y*j/Ӻ^hxֆK/YZ^g:+?=B/kɧRdޚqFozb\_ }{kA+svfN W щq4EL Vsl"* H!*VMF5&:c'M6mmNuν2ps`5X L6$<fބyq G/' ?U#[adlP`R9yH(5g ҎI,h༾gM{Ԡ@zFCL冴)Џ %dU&3 iy!5 Xn[ 69^#OxEX7rKtH }C1rߎ娰fF&fT1X{+=G]d{15q)ͻ}%B ־?2 _M?27ֈ.K k;MɃZyRc4F9@/6 8P.(r[ҝRx iEy#O J5*sC,}D-~vFs/ɑ'GѢ}kMҫV@E4ЯdE;fa:H9uѼ(Ɋ5?5cY@v#V?! YMi %dgQ p9E4PVDmbNVP&oih6"_`{!܊ w|{xT:& ħgj1aH 17'uhoa1#OxE2]Yآ%<4NRa:ZSb yhaMd`p4|U9t1XT"\kYRޖFVFCMFK#2(z`Kf}0ʎ2̜!iL*5hb.ֈDIV YG.LLPI..kV5,b\#N/-jG@k -`*zX#bo`/3WGL rEFDBEϰ=7т[RKYQW \ͤ{>,J3|X3H-416ҧth H\{:>ԊpU<0@+/"^\kFS&wX#r%Y1Xc柊ew)4R.kza"a,Ӷq?K=1FPf֮ s&_rc Y[)WX]+):\6WA~8TM5ڎ*` QcnO6h H^=KX ^ɇe{H₲aZqOE󞴈DIV mQgb`Z} o!NšXNNI+"FDX;Pڥ{zG/!Yu6H}x*HR޻,pX[o ZH 17ҧ6h Hy(A^/c^ efp e->C\6S`:ڃ3,d8yOZDn$+k Ep6 =vڅ3 Ry |fW+"`iMz)@qÆ?J`6VB^Z)ʺҮ:m~ Z,` QC4g6h Hdy(`!`dBnpFD1if͡6haMd`c({)65k/q64*<{8qߑ*Wv!mX9>h1JAhtքԌKV]LUK6 ҄]amjP1 :u#p NPmH`y6#7I vR ay!5DC,}nSš~F"b#k kă5Iy:ՄO5h|(M/&Z/LV "v1VE̶`JSx48y䷞e_"deI(,nFc*%xSa-)xɼrr5_,Tu\yGw`eg0]\ sRS,5W»۸[@mv7]4.@j!,/hFfF$ȆUQ3Df%",lRZ˞ tӢ"iF&2Y1XcǶ%r6 _50ҌDK GQ&{w.|7`iwψws/WOetTa: .'FERh``w;Ǐ ֏;G1bf2+xYyH,fHe|],Rk(1rvk%ہK*ZSQr[$[a^ SI(0Tvw锔+(o vR ay!5DCP,}nSša)F"%ޣʻ% ~*DD^>` gk G ֈD40Xcpbw):p|ЋZWJ1 i6A{=w=kJ_HYAq=#R#*6ָ+ ȹČ#b*[; gUZ`+;6ixx]++FuAcd5g4H-f !-6AM5ka${i{3vh Ddw1^u厯 bN(8Kv;vViÃF4Q:Z1VlYkHBLh ʹX;t?lmmy`F+VG<^wg|})?e1狵jӮ|qjÊ:M5@a[84WksBk#0]WU]R{%u&}&#}]avS2#QXkٱV/-&ֆmA{b%*jd{#V#/5;c IDATK: 1~:{f'ɗlĚXs~()%*dGDs~eqD c-u%u>'r?Wc6kcu~#Z&헖Xkb:@5V ^vwD6=kvUK L|NNG~1?vj|ʺ?Bxƛ\}nΝ]Zs bMiYbSPkbMŮOT1pGqƽ56 WbGck*2$pm`rm5 5%,BbVkC{Ob vƗBXkXwdЙ|&/XCq >ڲcQha8@ ĚX+=nP=@~|iCkbu` kbu ĚX nXkbeĚX _XkoXF{:M!X$@ƾ~CkbL6X a)¶Ldl5V&s Ŏɸ0G5!C<=&{ VtBxr#|̿1T"yC-7BB0.{~k@%b5XdXkZkb Ěf"3kbMXsYթ@! ~b! ֊cX,d\]%}XhLɠ) ֊Y,&6g+C@Czk? hY۔k {DXkqmaFk̠IUY2А' V`g-kX2Nj _/cm<@12pQUXcmZ2'Z XK qUUXSFNߵWQkbM ĚXw0+ul3> ʢI0eUecJՃ[MYV?cʺp Xv`uB>vՋfofb `_e6ZA-aB>^k=-H| Ym bcKXibپGvH5PlZq- #!/K3~m)e&Dk6 :v w+kXk#Xs+Hb׎M4yX[C2 F?M7ĚV)BYuYծʥkXda V4SLŚm5kbpNрX"=^ݿbEDcxvMYZD5 XWfTcj|67i Ov30[V6!]Qj395XKLq0TxR5ۚ$sLV8vY&biy&7IMV@Xb hwXkb <3C@i5bcZkb <.6ĚX9<[5bD<"?&&@[lj"+ŸAV&&@ڭ!" FcWhb Z ,b;>k40<M0Ztog{Vk40,3X+5L5BR Ob#ܶx[h4 k.a({@5p-%M&hO]d bM5xK V*PٸcNk hp1C,Z;\OV#!ྵ,):P;Еs+]fr$%,GCM$kyف^jOY#6~u\mjm=j+YζER(kISesIYB.Ըj YˈfIYᩯeR(׾y&qThݬÔUx1Yk]_y@nYen>zJegף-k)'v4gA)ݍ-桔5eSGPPD5yTYBݭ5BB② E}nS݀\y pL֬%.[@/aYo`E(eMpYBYUhYQ4, YK~ ).`c[}t\ǂyFp:%kx1ê5B%_AՠޒoBizC`o C$æ{~F0m&k6KlTّnJY[8q(kZV`^ YKח&'ks]CuY{ZerGPgA<>J Ӌ@aJ6l Bo054l,M!v0*&3GXONYJz lZ6Ԑ-ro~eGڿ]zLXyOod4j|\R<rn ᐺjF6X}(]ۦ)?RDc3YM.nl2ML4bC)k?cr(kD4nr좬UtY[XXxohYK/yDAW+8. 5FR<0NivxK#R)c^{a jZgG.FZx)j96h{(w|QffCÿ6KD4d+k"DHR&ςϬUxYs=vt9KJ{fM^T*h疵h:^iMVS)C0Μdು-z1 vkLMk~eȚu6/M7#&?5qe&0^gA`(kbȚi mRmz閵Q*X˧BߛH!eiuͽ1t7N/^zצjo9;[e&kټ7Oh\h\PeBYUHYځ3AȚ|Lem7kGr-NFH!bmȈ4z,?nCwɚe6ey&5aesFmVeM܈ B֎aBzdm*UjMuFHٳs}f/6CizqίMr/+k9P`w@fMs_ARĔWb9iKjO)kBZQC+[vydc7VC>Zk]FvR)Sqjj 9{;Y Ma^idMiXRqhDY#y0aM-wOɚVZ׶CejIKYg&J&B )k&."*ᷤ)5!dMvp/YiD^wWh֞6VA[xm!k!eN*3熔SzƆԐg91zvY&_#V\֬-f')If޷jN,JYSֆK?8g"3GQ7 /W R4^@h9)q"L$ƫ Dk2Q+t∀ztb!- UZJ:Jml6Lr^HNr>]...`e;OY#ֲk!me`˸6e^WD p䉵+ lj~CHۈ5 6楖ץ+nY_"cN|8"+Z)bk5YbzO:y>Z?k99on"hoWb͚vzsfeuJ0 VVkֈ5-Qi#OM15 ״U(vϾIOϚ͝雪 7XGQyw=->6ZO__kZ;={.BZ}OܽKh>u{k֌+j9e(F\5ZSZoifFe?ΧG/\1kZ|˿L^K'ր1gٛe1=ɺm'ִÇh.BZ;GjY3=דZ;G#ڕXfq5b Z{mrԏ3O`,.z;ݗ9k,bX#XC3Bb-g5bVW|5cbX\XXkZ6i%_Fk`[16TUU=Rm1r=EUU5| @|:Ok`&&Z1.~) >!bRo)@ۦ& E*nGY0+8 %)X#X5nQ9[FVfk0HJe2 ({X#L:֥B5{,Κuahcb 7F+5b 8H3EFHIzfPE jd5H1@I5NjCDޏ.g+PsQꞤUwVq-so$YvA@gʿ]dasM$SOD6t!z9z~<.`X7FcmIiؼT$_ۢ\cvE\BRlkz԰mK߹~5AkQ@ eXJt VcXkt߇c1E[c_g^hn]bZ\t^ bXn`9[Dry?fe:E^#Dqbv0rbX yu@ɠY\}{krDkrUQ@kD{Gj[Ndwyyy@vRx}_kS:Je2 0zI[5b npagF<sv}R}1yi?>+b`jmv7s@~bXlKbMw49|v p]'ֈ5p "jQ R3VL ެMiږo.[PxG޷Af2)mebH@3X#@W(R(XPkkx%a `Z##k]|"S̗oe`X#@b`ģ>ʈmu|'DLw4Vcc=;1XAF1 $k?܈^aXjI7Ǫ| L|L:;bN>&}->A[#X&5&ĚXkXkXkbM55bM5&  ĚXkbMbMXkbM555&ĚXkXk ĚXkbMbM5kbM53 IDAT&&@5&ĚXkXk ĚXkbMbMbM5& 5&ĚXkXkXkbM55bM5& ĚX&ĚXkb kb ĚXkbM55bM5&  ĚXkbMbMXkbM555&ĚXkXk ĚXkbMbM5kbM5&րwM1W<J = Liiҁ%cҷbW> n5#Dma^ .|p{Iϰ`5uԜ ۋ9ՙyY׬ɠW<0<'U b @ kb  kb  <b  kb  k5Xk5X@5X@5b Տ|o]?F_}vm=8ˮdMt543}}WAI=L;1_6e`[WO ;'R}ԏW'2kVp&nW!;T|Cxinj] V6e/g̩rc Τm#sas>79=>oF׭w .^8pbZ7E_S03~sǫ Τ26Þ ׾Ѷ5Ϭ'9ƴ}`_%qqfmMAɲIoo4==f8c1qsΣ Y9UuS>^Wp&n3lk55c7+Nmҩ,i{W^*L*۬jFN??̶Z]co{xGkvŢF+T&kvGnu~Ν=>h ̜9Һͪ7#ƶ5v( {=3?bw1reMe ҋuh0"4i+biI)(bE.b[[%11!~ Ęnwgwvlw}zޙy9gv?pf.bf#ڢ+ k?Y͉y>b^hRwt,'i㧧朖WS9/OX4oG֘Ӗk@}b!bv=R'?0#v7Xz+LCeĥ[Y^5=bU-I榴}9Ts*ۑ嶈[a ODFNf:;ި5mEcK݋*. Ǥ=m99 <`#ݹ5bohXZS\;JXj"W<# {yIlNkmy:9-OXjގc:&PX隈{ƈI}bBK#vhzG̈ kWV kП孷-uƜ={I^kqy:9-OXjގ ߘsWo#bIڈufCęUFom"X1b]ڷ#H5tmBy3VbӾS[=99 <rk]pYփs[s˫ܗ'>o5a ΊqCDd{#~Iшs:73.aKJZ㻓&2{"]Yl#bZK5K+;.bei#ߚs^^ 5258n~jw_xyUZꮺ'b}S;.yiČGFm~rXs˫<UšdK;aȞd:# Gȸ{vª+Sr\H(v@XրwXΛtI /qיWEϰوm|{ optRUX[ZiUދ׌ yyDWy}yxX[* kk   kk  kk  kkk   kk  kkTcmuK N*^K{{tӋ?<:u$IW0ĨM3Ea ްnֺO~.Ω:5L3%㞧@X'=7_&1n~a$?X5a-y70Ga vqy゛#jo=|@Zo* ǣ0ÓM5Ia 氖fB.qrX꯶qZx$5`Zr*faX {X{5"?{EyÂ@6ؐ@C.%A$@Db*! P"܊UK("HрV.i@jgwfv͢ ?`ww6|CemZTemZU>:pΏͼN[YF?)<۞!Φ#ޤLWw|b{F4-D⁾ѡ>miejiЄ!l31g !B(k?"UZY[ X.YPc)kRbE)u= ʱmys%Zk".rB!FiXYp7嚤0T'@hӳ8$D@ݻvMtO%ߊ^~r_ؠ*pJ'kQqݏHڮɗ4m[!C?VvOU]rB!F5 ;ceUpP4ϧ2BD<劾@Z0/x(=J'U'ke@O˚ `>T^9O!BY#yY_QQq>ZxUjeQhܽ"҃@ZkڸQe܃é~y9eeqSq}Ƶ^^$r.#n K/+?`LRFšh* $"!NG'k+MlKX;жUGN߯<ؖ{v8$8K!wk:|eM_ҚF0emFTC l"5BFpg&'h[\ׁfyO[ g_fDZ?cLCmYmY 7ٙv?쯯Dw"[@X@CZ ƉdF[kݪ*92g#15-i kDtY.2?g;X3vI,Sx LV.-c kr*3ʝ9-e޴[vUB/sVҐvUkm kv;]jEzXf2Y$apa7hydp9:mr{.2==khPXK6/ ( kaVI8E_u+0fYݵd__MJaE ܲ߬/삖Zyv'/i`a k@6P_X9+>i*a} iKТȘÍaȀXQ]ϋ5cˑ8 Ba-|a^К }_Q=iTPX-wȼ$8U")ugkHSO1"o{d71SfrXdZlz9k {IdV kN k^(c7khfH#ؤPX2vq. k)ǿ{&A\|@X@c5{ENS596&ҹ"R!?Ѓhb{'Ybʢf ?Ú]jm-PX3]=jDm"/[3{Zp2ZK=~}ApK =iM"TeYUzQ:N IDAT]loyYwF#5c^$vz4zǂ/:֌]-)K*gbۆdfgyZolBH'lSDVs{F k$qZR4t~ZM:2=> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 19440 /Filter /FlateDecode >> stream xM-Gr,6@bRƗGuCz34&FxٯUHj_?anyTE-xAʌs2<<=Szӿ~~͏u]OOSsO?|O_wzHzCӳ\O9zs<_۟o|^OobxϽO۟~eNWy~?os^}^~ޣJ2kyTnK[חi73Ͽ3&ҟ|uOgiO`/s a}_}&dO0Ga׳>?}~˗O__Yw5?|.W| 1y Ytp<ߙa#Hv:\򟟾۷w䟹Է09z?~O%F9z}o\>㽟_WO v\8Sx]oF{]ʼ?}g?|ݏZyW>9"f}_//ҡo.s|%d*nr]&0Ӿ 翭B}oP5fݬ:zHEV1 25Ogzh_9F>.N4+Nim'yyWL~oCw/3?p_^8sW ϋ@J\ּ+7#S?SWheXZ/G&yщPuOߢ]̿x.}}VO/ݢb-'v-0_~vDF;`!XqQ=TjͺO_6x G|ݤ< l8~ ı1ke|;1V$]kR~8g_yU5֫r.w ʺ]$9}aaKK`VKoX0^>˅^_xX//>1تcǜᗍgx;3 ؽK;3qaNw@~ ,%7)Vpαn%pGȽ1Ց!QQAߥ79J~??ӗO_s / =t3ƾmlӯǧ/ =u5dxWO.xM}D?.`/}ӷ{@bjէt|_i/{7O.%]B 6`;7?=?  vwÊʊB.ۛ?^¶ُ4~ʎGWm(=?|{z\ňܲncEVtn!CʷC ?r5<!}bӥuy+[f/z5dFwΓuR3?2|] 跴_|=#~fZ凼\{!?3EDCn)jY"*?+\}A ׇZX Q&ϣ*thnp%A,$\{2(Z0 ןX+*Q5 Jae•$ps(. 5. QJ7_Y+f zi{5n݂S x%Ue\}bpQ$XF/«~'O[Bd*E+0nwUZp}U/pj5 Z6dpXE̬Zp]ނC ] \V>쀝#*C.(1j ap4n#\RZ`pd#?`:kg~ n%vA־d{0P]^nVA@MX/T{z (.Z hǠ^@<\y2("[Z xOO^0V.X}G^{#>Vۍ[2\7 PẼV,Q">QR8 2,Sj`+״ob _ךi#o >98r^1 2\鋏n1XmA +[ ۰\ku,uymX ,\p~4br|#vO<+״G̑2 \ h\?_p^cRĖd1XVu,x.\0i~ ۽ cp K\pݬG3.o-3.bp[qdS;;\1:K*#ud πAW&^T 2N\{A]0nn xf+xG^{#vw{ \tK0o 18Ta X}d1suA&HeLAe2h 2`^0`A.[ cDdz\pd VK{Fd Vs#ݵpBd16'2>zb1d2lnpݝG^7A$-2*^+[X1XU߲ ca A R5Tz lp ހY r b1HȂA?g+(d "Za-ѓ9]k[ [K q%Jȝ2 c*U  RVlb*b*«HӸ,Xp 2wb7ט#Y V],}urd4bpd "I-k< =`ջ`p 2 qAٸ`?% 8ǠnAM#ՒW034aZ&U߭y -59bI~i`Xr!oEsut[ nwzDΰq b3p KπYcZ .=-g cp3,}֘Ɯ rlJU/$)  i&A=fd;%bpzjSI b̖` -b1VynC> 2{W0`LcA+grd .R#eY-ݳY 6݃X1DZwʘ`hkݙb1zd4{#=`u"4Q>2Sbp%I[A$Ib92l$)z>D7}LH |h*Y2f6l7\9p3C,_8b EՓ[,vL%`f ܞE ߍל7"a 禘 C@[TT¶V1-Mj|!L;-4'R pj3h,\آ[ [xN's*[\M;2)1\b rq>85 pu+LJ2rJL PŪ+f"0f/g$q>8-&az`aNaa4?+%ר&dȊƁ0W(0v:o-S>~x!KN 9dmu'ɰ*R4V.;O&eXz)}[ɹ|HN--â 9]pmN-f.,SQ2?fJcfI0W b:fhfҸ c>$OCEٳsWSǤu_79$p+ϻI4'q8#p-~;&0A):SiXVG]v2 TJi-~*)7[*Wm`$|N?YWkG-~'uBmvbMt)l;w_Eέ"e'׺:\Ut݀]!]wSv+N-Eq!NaMM oE`./:KUl]oZ uj=W]+/k鶅u>8ֵ(I(θufvӁ :tY^8:]3O'0~x`oj7Xڍc>dN׊+d[ #)rZ`o׉8 Nv$(>>_y0`_ppG1~A<$|(NƁ`9񑿔fːd0k ]8#g9%9'").>>茦۵~|N\ŃVT)#-Nρ-~t I03t`IbߡKqIS}|Y:(\tMtC:Q5U$w.\-~/:w:]׵t_1T2Y80E󝡫_,h1v pb1vC9H%0~qB5:u*f˜ٻ/2#)N bPJK  bP#N-:*)+zeaՙCIԜ5ls~oaupD+,М[Ksoh)0,Pĝeǟ,`|iy5b3]dBc>4Fw?;rЉ|gBe2jXC|gβ|poP3҆;C?-~ nA\Rs2&烳cr>87&ô_3Sq(^8 `߅1Y@8 88_ĉ3bD>a088u bze&ꁜ#ggE/HȬ08)8F0qZIq񑿈S)Tn&R y`; R;u w0 i w@?i3||q'0wa/-ߙߩ mgeX' AN|LQj8Yp󝅑ϊӅ Us|g*1\||/BҮw.tSwRwpȧlbv*fMg[Gҝ/]mWD0Ub땩;hJKw|oSl;4^[Z9_0|!(⡸_Sԝ/$iS!-~·|T"wjҝ/L9l;%`|a. uJ##7J5F>ۍ/`|!·|tݢ* 1 gZE0a|!0a|!p3ߨfa_0/|@Z3gďb NbB`̇a|!0`)A ۥŁF2/F>;/|`̇a|!00 <0]Z$gGza_j 1*V3000OB`|00000X9K8/`|! 5R ##c>L 6vN/|˼<~0#|W(ء]_.`Յ:t_fJ0H,~·Yc>;t>ՄF2ǯ[jA!dØz*f8_ft3qX`/B`B`̇)\c>L 1_$F2/lI ݰ u>_B`/B`/B`/– u>_ e|!0ARWk"i? pK 7iš*\ax. %.(>i3~ B`7;(fb)f&wg|!LINv j|GeJY1GU::1%G̗(pn-~;`W~ǯ&[VØ:ʼn9_ܓ㏢)<~ e|HWw!O^>?\'%_l|UJJȧd|aF,.Yks2Ō߬_p{EL}f5ffUj3~,. i$|Hc>$ u>tw.s2q fx1' u>_aX3S3~V0fLdvB`]L\8/|WŌ\Vc|!9'w*Yu_ObW&N>4+Y9_^R6nOboVޜ/Vo {S<|zT 6iMJl3~JFȫYm|!pϔ_|6lL\`cZ䘳xjZ'íW?|=~DNV07"i6>|aZWժG`;Bry*%c> [0h0ŏߢՏP3~:3djḃb|!0򗅧_ f,7bE} 6lWJQb__8_b/>襘n3~____؊s/B`|0K1K1K1l1z u>_ƍc__gB`̇zY橘[JRهa/5YSN-p_P/lfCIzZ'__P #c>T 1j|-W [zI0~ȁo+ůVfc>u>wK[j$ůKLW_`_XGRǯ>Hv[hbcW+zI`_>>|azI`/6bW|!U:_ȍyu_4 .,Rg ɊUP/تj^ #i2|9_XZu;>nO'oףɴ؟7C_$K'oߧO޾o%2oe߯g>>=_O|Z?Vs|D+ 61߫OFQZ+^jdO-ޗup>޷u2qg}]'p# *EBO@ZoFEv|BSOOѴ~2g4 f!M7/a!O)mp>8Ҕ >;Чqj69OjmkojZ?|TD"_|\k@e, >M.sηuEI"_|$J"?|Ыm:(|:_)|:)Z|( /LTkoERZ)kϕB^)kBb"Bm6-|R:-|R:.|R:.vJ/+_|4K#_~8i #D'cB~23Dj":bD49~ b?Ft3kD'c?G~2{ǹ8"QO&t(د8,Iw ~D엉ZM~}$bM |?N~2D'c?z(c?P؎tO~)iF,$JQ?ϔ|Ю_ڵ~2SO~khCmh/횸~p†/"႑n(\+Xٝ{~rwOɽ3|g~<4bg~~gײַ^?`¸r7x+~r;tOz]/+WxE?z zxDFg謟zrA!^Փ7鬟(^~r׳P/]z|zNg]/Ӆi:'wMg鬟:kѨ@]! '꬟F~r+с$PxꝺWD=TW犨꬟Tު~rcuOz-6|z.ژDWW!rԃuOz]OY?:'w= [ZWڨgcn~r Oz]o7xC ϣ^oE?%'w=`mBo#q>8_8t3tpXcOV'#s>8_82 cktpXt~r׋[=`o]o: i/u~r׻%aGz?ӎw'Xi/z^`upT:_H ]/8w=10'޸ Oz=2p.Q Ig=ꝁۭ~`c[w;^ \oMXFԋ7>v=90'޼ Oz=:pQo5E; '^^Om~ӭ^8K-X[R8_8X?zCo>F~riF~%pq7 `>F^DHn`'o~#5 p+WL 0CK'_~*YoXCkrG~/gxb$-~3E+l{qmIp?`aD& կB`k2Xn~?#,$'~M7~M~Eg,~G~I /V& կ~M-{-կBI~M'%~SG~MW~Ve|!5h~MJjk2-F6.ojUİ5_ܯ9€OL1'7B`s33n-΀p~jBcZ~m ?7 X_|1ON/o8F~u_K ?<^/x=$os>`/|?@~_ '%k#ntoB;n-_"p)~~r1#qF<^rA/I@~_%png ~ ?j~sA:>k?P`5XG/6h/N7?S`5XG/VQ e*oxcL kN~?j|!_JK ?Y`>ݏV-7kl[2Xh/`~ <$x_6~Gk~o`f€=ma5K܈p s 71\x8\ k#6ɀZp=7^e2KI7mNn,sg4`+,pVҀ}liRqj)Z&Հ),lka_؀l 6X[+mgrKQ \7 lov3psp5Hp8mB.E)p(۹D7\i%Gڶꀸf.E+ ݒano` +x@mǶ6ܠ R4g5pc|@20|@'E+rfî_Xful@v#@8n"8n1 E  zX{Rv@20pݼ9- z87\.`vmx+v@ `&e<ݕ7<ԪFo]%ol(n8n!E *`ʻ`n`U,p={pno8n "U7L#k&{k*q ` `vwK5߼aT_v*;f+XUިPn8p o#jc2y3ڍi[mk%!yCJd{aGh (i7 em7}!@oR na op,,ǀv{sduu2Ȼ2z{eR)3o Xn Xn n (}n$ 8n3-{ބpbD~ ?:ǿ~=?z\qGח=?z\|qǵG/=?z\qGk=?z\qqǵGG=?z\_?z\qzqGnG=G=?z\GqGmCJ}h'?A~_ ??(+U?M8>kG8oypmxp8>~[%q8MPKCpz?uSU{ub=xfZ7ëp:|A앿>vxezvx=8~j/éq;\?=w8uywr;'çp;<WޯaU=i7{{xr=|Sp>/|x(ˇ|8;}>\Q>ܨ'W>ׇ }8hڇ7p><Op"?_.~ݙm~x_&x?8>\?o×k8vg;vg; vg.lp[xlpkxlp8E$v(vY.vgnٮu;lr9ۍ<#9ەngr;9ۡRv*gcv/g;]Nl7sylWsyls9vv<zv>?lt : vDvFvIg;َll.l'u:QY^:ev[g;]c;v`gnlGv+{lgv;{lvS;ۭvmg;vog;vrgٮlgl]Nlw;_ < vg³cóvg;ųَlxs|hxvg;ɳَlWy<]> n7|#>vg;vg;vg泝l.l'َlW}>]vُvۯqvg.Nl7svg;lNlٮl~{?ɟ_?՟v8VF ĖV5Y[Z %.|pi50KMz->JTI iuliu#˲CZ ZHki5pBZ FH/ iuK%g|RY9n=*RY)6X^*9+^*I͖Vj`zKi5pV直X^*9 ^*IMіV#qi50V#qi5]Z l4{*RI+3Vj`VXRV4K%'\ZݨF:uK&n=.|pi5pBZ |V7PjqV72[Z K%X..j`/.N) xV|RAKu>xՠK8ݤg]Zݨ)j`VX^*9hj|Vj`VAK5[Z ,#MBZ \oj`.|pi55BZ.65w4JTћV#ui5p.!VimP*F V7n mi5JTrPj2BZ g/ºؤӌ_l_ݥ]!niwK[Z= ^*9 ^*92^*9(5A)V*{0)J iЂV%CZ=wK b{0J}Їzh]`Hzhe`H[Z=(5A)Vs?5CBZ=E VJ巴zPJ՝R-oiu*Vw- iu:VwZliuUVwZ liuVw%CZmVw%BZiu՝V[Zi՝V [Zݵf0]CZݵj0ܱiuÖVwZAliuUĖVw} .BiKVbK;. cK;2 .BK!+՝V[Zi՝V [Z.R\VFK;HӪdK;L5!!RbVJK{٥՝V+[ZiŲ՝V-[Zi岥սTۋKԺ&>uVwZliuU͖VL)KY)%wiuϔJgK;vӊgK;z'J]Z.RzV(0 iu׉ꮚVw% CZ%] CZݵ0]BZJ)]BZݵ0բU!-; i5V+բ/VZIZjÐVVZ0բVW! i5BZ-ZjĐV>CZ- iD iWHEBZ-jjRĐV"Z1բVe!|piKi5 CZ-XZ ihQbHE8\Z-բVo!F)KQjiZ.FKQjκZK^,R)uiTJw]Z-^VKץR) viJ]Z-bVKإ\x!BiKPj)FZ .(LK%Sjɔn!]Z2.LK%QZjIZK%q>ZK%QjIƻZ.zVRkߋ$:BZVEK5󅢉xHZ}hHZi)cH2i1cHV3) V7!nSHCZݴ1MZCZ5M^CZTꦕ!nZt!f~H!n iuSېV7!nZ%!nZV!njuZ!nZꦅ!nJ̇B!$:CZK[|p,MCZݴ1M+CZ*K[|pDnH[}VV)uiu+:_ B)KZQJ/lRcVB)P|a˔2eJ//$CZ2L-S)v%J/lRoVD)-Q*|aK;_H!QH[–(Mv%J/lRSvQ*|a(w]v&͞>oꪥ!jjFCZ͍V|a|a ɐVW- iuɐVW- iuUdHQjJBZ]P2U"!ńjbꪭBZ]UAH2iuzɐVW iuzɐVW iuRҐVWM\CZMrHqj*CZ]!J"U[Mj+VW iuzɐVW i5Ő!iuՅoHk|pVV󃅴jdHKjdHk|pV k|pZPՅR-&V&V)7iRIxVkMZ7iKޤ&VMZMZ7if~b〧~z7OｱIPf}??)bZ=.˂ }"乎tlm?Q}>b؊h{.p|:^miӾOhXm"u2ֽ٤uchZ.VGxug>.do?`_2kQumoqORm?@GyQP1!yxvG34?9;!dO:Dctk?בͣ'vR{lEq{.p,T&'j))5t\D:RߛkH[7v%ug):|s 5Ho 1o{tlm?Ͻ(}cW2zޮν_;KK~kzDhCҺr(߽մvG߶uٹ2laSϴj CMFʖs <~k}f{lEؕsm }OtKY>MB{ g:{O7emaveD(IEWn/4~75$~_O4ZAǮ~_߶uٹ"T|DJ]'=цMO7v#O& \RqieޯEe#-^Q]+a=T)PZy>oJf޿׍ߟ__#lƿS?}"aw$&Zq\_K\IXcg!G>p><`O>`+kv~`04x;~)_}e_7?fݺ~G!ӯ I>?}e?}t_<{~OF*\~.ۡĹg 3nƙ\3~-pr)Q÷OݛnT_O'V@d.o}yڗ.Qendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 720 308] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 9 0 R >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000019805 00000 n 0000019888 00000 n 0000020011 00000 n 0000020044 00000 n 0000000212 00000 n 0000000292 00000 n 0000022739 00000 n 0000022996 00000 n 0000023093 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 23195 %%EOF metafor/man/figures/selmodel-preston-step.png0000644000176200001440000007250014465413203021107 0ustar liggesusersPNG  IHDRz}$PLTEmmm"aOSk\\\(fff///wwwUUUDDDXXX KKK'瓓OOOχ /afU777[[[jGGG]tVmػS/Đ===񥥥YpN67+p`vg___,,,DkZpWf{222m聒߆麟bbbx'''Eaw݋>_iϦ鉙K=荍[y磼q|mppp휪u될f훛SSS{̓詉엥kkkK뢢yҸꮁrhhhvDHA@@]`zzzձۖľjjjʉNׇ-Xlttt9ݼYzXEڝ1lllEݭjbw?lU}}}[^܏tztޗq@dϮf(naNُӳaNmؿ˺j|΃Ñͼޱch3supPVik2Dx IDATxklTUzs9w/0Ӯ * YТDMj£[meM7Fd|lVT`NLۙ9LgsЩ͹?` M0}+`sp j +D@t@t@tD@tD@tD@tD+D@t@t@tDGtD@tD><(-q $޶)W5!: z$MB% \##G2(m^_/}D-zhmDD/я$HG%ל'^o+F$>Z>OɉF$T b~*2 Ttu5G _ 9#}Dwސv4VKD<JR|hwȑ^/}Dɖɸm#!gm/jg ѳ)z/- /kas]y*={F'3 zPuѳ*{d;H=:Tѕn1HSDrwWL#fZ!z>-NemUPlqf@y+V$4"*+=ʩ/4f6, #dYxf!zjm__k+4g&S>F?zפaxwDDG>u5{c$2ixw vz_l%̾}[D{1l] z_쮵Ep]}T75 .Z+}^.Yga ztdIEȗݬ94x{3zU-69ȽNh}%lo]޴G_5m|=5Q4h{A+Z]gXH#?u.;uҀ61pA4Wt= ڵҮ} W/U=Ww 螎u|vANc{»<_SEqfE,9elv.Z6PwHHjn]Ģݷ[ܬZc۫iڐ;ѷK(L?FdEZMûW轺smom#mr&z#{D6 .g,kAS;l{3r%:)2yj*ʠaxw^ѩv ]V~Mr+[w8|Im"]߼n-mL܉ #N+jwt-ִb:P,PTݯXs  X~xJb:3r AߛnWL_IDUMzs`ӷ^OߌvGD?oY&y9þw@!ݽ9˺;-vly.z:8ͺ%Y5|GI2fͰk9s=E}V/p#z~M/Nt^k/" g̒,FWB%Z=YuZl uv @#z,bMHsLs8!zr:=XJ񷰜Y$$3R>DV܇EZ=Kdd1,MMW4 z Ou}XE6D$Yl wF<;T>:wDʧedqH@͊MbE*8wD%Y, 5yҌəOO>l4yDz2J~ }qZD7HMrO}3Cbo#QŨ#{/#zr~O߬>'R5^„9%Yl=$#=yz\>9Z%JG!&$r/9ɹWw>IN}Nd7G@#z>-$[$P'ɦ[LW̄g,Fo?*qDO;iwJS-8CNI) S ѧV[W-CLfIkE6:jR:{+ =#[gL&#zwΧܢb{[7舞?oU5kQE :?' %N|舞_OS*0=DWO讇 a:#z~+M[Lu鬦#:i4 l0Lg5=Dg,%jFtD/mč^9ZoOlzGtD+у?֧.[T-C31Ywۺ7=c]?/[zx"=7؂.cK+: zD/sjZ=ci`Ot G!z.D/_ >᏷+n7 lYBH}@'-qr襇NdǏ'Pۦѫ!Wtkm{v"~*y2@,Tx 4f'aî%"%aDDkAk E?Ñ;uk K# j˪DF T?/[|f[HV025+sG$I* '>ڎ:8R9rFEB2iSv_c!'ˋ]wQiI.9I&`/ą#Aϸ%(E.zBNR\: R!UI2Kf&Ztct|kR[LE}["~5OtlITzn=UX`  ХC jb 7DA/X]W듀.ChԬܡ1Ay*jXQ[Ԋr˪0 uEғ"gGV op1]>5ƱSD[$ܯzh[~/c衡:{w>+K+#FT@X==3p7腤YcK :l'h.w[.(r݌̪Wː DU߭g@oFI_~Yڭ(߸:9X:A=$Ҕ m~'ח?c_RN{ -}@_kz4̬ '8o\w)/"}CEb5݉2mu\KWeE9n,}uDť״7"9DM!JsHr&,`VrfIq=w:@O\U\vuV:@OwwWˠtX=A?ovƱmҥN" @i#Oc*X$zڀ..n.m:T;]eAR;ԍzzw*Os. $=A#|mP:oN>.1>tߠYK=;zDcɓ;}%SԽv)&|L2gWoKD;fŻi=>`_﮹sJiC=AgAflvk Mt40~-ݧqlRR+`lbͨ6FFdl^yU j K`l醴qOW6OqAU# NDP?=N-}0Ty+ݻ_(Sr=N i hyV>w};z"U=&Wy@bj 1]vƱ13My@ ӭ 8sǦ)[zzk(>in;PJj5<:@OO_xE[[B))toN o Le~@ /枪ׄR 6G8azo;MOKZk>!J9o傲(ߜ]] ˝vDZ iQ@?mKS:,t3Ad){nE׌j=`@_ѝ(cKNݛ_ _4_݉xeГ]~+Ň]nތ5] iՙC '/iwo;Z9HM.q @w :+-%]:Tk-~됮E\ "?t2r:D}.ٕ<"AM~6 @%tWZʯڭAU=^G.v~+娢;u%_vݕ^s6mQv^l݇e ]i :ptڝիg(80ݽOu&= qz &@bL1$P"1mʗR Jl "* 3:ә0NqOt ].\af7 {~}ϻfg/p,6GX5@q-1S a*('bZcշpzՠocIh,īzo;ǚd^3Ŵ΅X/S) f**꨽Ω*em=lQ zWĞJ11F>@mR@GdFyߡtN*6Go @]_onѠ\uѽ@q-'û @eq}3,1D'nEݬ۳q_NB,VĖ!NBp1V!YG#=BѤ,>4*=KfblsGdxwv a]^`t }PbD9Ty1! Y!Ѓ}F4ɖK{-t1-娲,BX>Lb[PغKdWVrIV0 ,&ўsT/Yw"繚Ak!{旌tٸ l"@YwBX~W YĖhI:Gtw@7\@jS{ܤ۳q;x-zryÀ^b˂t-&*⋘=o=F|UiZaM  見ufjV :o`{jʎ6"t\]IllkzW:&52~ RڬhZ[&?NjA?-$5X Їl$Xlm-.Yf>i3ZF(]m`cl Г}NIlϥ7OYN2B]:1bٸq'W] yLzi>&E}>j {(Ip7ۼ2K` 0OG* lPw֤ :ߚt>zlKlaiq&FR:gbXSAЭm۳qC̰e;Xj;xYw&p t&^=#L" tnKf$z\Dtt{6 KwG ՃΊ{OHٿ :@W zrY2#ѻ@AoUCHW]9{yw.Kf$zw& ]%謚vY2#ӻRt]fzw4]9蝼r.32M'tU\X޽Hw>0]!8ih}":@W :ot>+}+ߣ fbrہY B;y 4{w/H}yNyr @/o;{[Z+ez9Kzyf.Z?C5A{V;ݭ3+Aw_.6G~7\.iP! kmVVI/GI*6 Vw&+}۾]4C]v}-»oxt+};]W OH~t+=7kΗ'?EUN}-ўy#d.B]'y˻k{tt+Wk]]}v%}/]HVI?ЕWS뺯ۈtEb~)o_5(@Wz'-_HJ:UvմP!q~5I.sQ!t/_rtBH꭬~ 7wN璽;J:U~7V_^AI@?ݵchȽBt+=Oso>qM;t.6%h>3(@'yc'{E{1OrgCǍ IDAT]M',iJ/30{po>G 7FIyAiC] bN}U4mܻaJ@䕏fOjG$%8_w#>_wzZ+GIFi@>Os~&AHƞ*~Xy2ZwLu#6:6mۡC=B="[Ct# e/.FIF!ӧl}vGFC^='yU|zmrK:A^=+~͗.ޱ9 ]vdK!,U? j(-WwU#[P!oNsU~fG'@ătّ-vIGUGJ#:k䗭A# قy/-: ߁ͻsWg-2-NIG^:Ms#g_, ]zg!C^=b$gPE&>KnyZ&AZ/$y:Jd| ^JKW9$t,e[%}>}@ C! :.(@7,1|X2d.u(AeΫ2o],I2HOC8KP!^GWWW.bғ ~%&c UlIͻ ~%&ADo%3Ih?aB^/Z n1߁9*쾧 $ afBXa@ !F/1 h@1DlyP,EAXZ~evO @M_Lu>9}eƭH'Sz t@H/"'Os \P)Gг!O@[Na?aih! xE}{i'F׈,8(3J3qC]8Hy8NO,'-tYէ/dvw[ؾ%mheuRV d>߾M 1#D* U.E:M Jb,_찄;H@?(vt ja'9 Y|Ս^\m2 ia8)GA`Y<*gg.IZ8|z,LdZ Sx4?8M9,?txv&|f?eqXKqz!Nq:!CS A/&g‡WG4͢N,A>A˕^O6B\@dtQ:-7ܒy7qJg 8_c `ay&S8C_T4DH97/eQ=ɭe,}^(۲/e%m)b/"'HXE#RE/@үcm A_-7UsmWC,?^u HU!gi,NuskYgS2 9|:k!6_k)n2d>6X7p0|RyK2dal-R F?@ӻR 9)P:f,2r-PK'șv2(7in~S:@ ^F &Y.i`~Ñ9W0zj$- 9\M IQQr|@Ȁ6O  6Jq<=4fNO9 Y{z@Z@Ow?)|9<=JIEn~RPu/5Y,^p@OA}2poUÌ4w(qDjji< *{*a]pJgy:zS2nc)5pEJ.|ΘƐ9J58&YނnS] [w6t0F,dyz-ۥ<%MnrX,pJgyKO(Fy`.Xxj)]=,o@'\w]]OTxl),O@ M`.X*G׈,щe;Dv-;(0K$[J;R]j)}D#twÌ_hv. 10 r)=&F80Y 3"};}R:W,@E t)9,o@ %,eW҅8őpQ:g0;lF6 Y^3JTɜ]:+`94Y3^AlqULfniXơpQZtjp6˜ZJ5CBdyr9e"TbG#yR~>kvP)}&f5c$/.% xg-jmfQ9'+ПV'jKnW/U^2[fatԥG_=-Q=n~^S(d?d?A6˜Ybc]Z#˸:[˾N>%;Nn 3Mb.ޅa,#tk=u!>,[jB>)-'ʔÓMлU^ÿ1d=GiG|`SQuu+)an ^3͡`tVvA<Ǣxq"о;bB}FvU31l0$N Q" CnεHZG6_I6}~+=j`H/ޏ$8Gde0_}Q& i>zt)>b+qtUS"]L"N N,B{L<]zex O<[{Gwg~$JD(+{mg2ٿb lL:6;_,=JEKE'T׶Zs'5N_`#lb?G(+kc8?UٌonE?`}S_u=NO f#lS:+k[CNk =u l+W{]-"]pXK7 +ee 5]^Þ7Ar &}@l2<P»;E~ vt)E:vsKt)yQ x2kP^QsB?@wtE$@T3[k'4P{.?YD|o|\L7=bRoAЭ"}+`5ݙ-*bW,"Fbi1tN'6dՍ$5Q)}G)A'sdNP:+D>EŠS> VG ]#rt"0Fխ*ҷ[ڡF3YYKj4RlM4rJgeVv]`Olҍi{s?fNV;s q#$Fnl#E!EiFbwu1t(iHZS2tg];.e[7~E$y9[O~Hlan@^FB%n .ץ@/+{Ưy[9]Cn=)ڪt.}(S:-aX:лRPOΪ)K?rSU$Q:¹x"f!T,Ư?>b]M|, '[֩ƯXQ\t!ֵyӱl_EBw}"/VR:kX9r&!.W$@!ui_;К K'N-HٮZIDKxד7Sl+JQ1 ˚S]UUR~_YK7^{$&w Vu:?\V!F_ qG"&݂ݯw.,$ I{`'k?a*kcQ@n?A5`ݽWPʸO!Nj 1 j NO|ǻȅx@{R2 -Xeљ~N!6y$2 L-X:wa'D>ęAwkjGXÆ[`.zEۤ)I /+K_؅X@O^K _Rϻ,Y憋C\L2^[_|OfenH4x4,bT6"ba/M,sF..a^ g4,b^x9k0׵jo֙]qKѨa{efº{a%Cg!@i[3yKJ!У% w(1ѽf{26X:zxWLkݝXӘK8@#76PJjatHo~~CtzB<%@ޙ qNWDTZs2}* ,b(qcHZuMн6A!MMjQ%f! Nj6\r`'P-[g&6X:?&'(ylufaCnrRB44;HX:;F'PQv}w]% I-JFaProzٛRU"3  I-Jɽ{ޔ}`ϠԢW?=쫚2U!_A7;EnnכeC tZlD+Ӛs^,tZ*o ӣ9=Yo1tX:7AN;A|{!_Aoh[UQLffQEVf.c۞got4W|KjLiܖgw5VEtG+iv_hΙ>кnz(Fƃ>j[5'pizTg4S9Xh<tE"ri&h忌}^re@5`PWKw SA]@K]$SA^S5'PiFYUD3TzIƂ_~"J3IK; 6mͤRVκ_it5cLaì+K_RW=ӚIם{&C% zyq V݃Ktq3.W˝n6 ",* _ɠgڪ.le}˾;s1 e۪kum[gb*Sh[NoCްNC0`'$* ),3a6ewMl,j q b@UPHx!5-fWDATCP+$A&w>}uq˜5a5T0b<6ZA/zY9JW-%ޕ_BXC$t,1O<9Jwuut`C2/ ::u*ΞJ["*H Hg;PcGt4lU:猊#A)nA_*zzNR:i7VMjI٪4w3 /}GKD: ,ҵ|٪tYTȆ -?$畕U/.jD6T tY4yulRj4@{:ƿS&X:T(I Z{An4.N*[%-B*>9?3t:$?ɌOx':@#6уP!ϐ$*Zʯ{ (@AG;+P!;n<70߾?e_ \ A%Be<9҉v٢ PVF*D?QBn<ْٻ٢zהBE@iE4""Г{L1XR?3R :W Qnzn1X2YTkQ"T D_(@wP[Ln[/PgFDn m 3ckX:9@yK;s[LH~%T#ޝ~Σ ѽ*?3T;z6ݻ9?wT7޻{ԁ ܤ3D"!aD D˫ TRfbU^DQQ(/ "ЕF 懮9CB3;gl|ɽk欳gj:@۵v,7N$#;r،v.ꪷW}qF`XQT t9_m4s@Q)H |;rݿv܎'ҏg>XwڎEB:JApgjU3EZQvd`NM4O&]DX gXDt+6/,B:J(1=sӸ[7O =}uV1/JL=754:J<蓣FuVJ*,iu{F c, s0Pis["1>kn*tSj!7 ץhRbH9"GZkz adS` sNٿu]z#+0ͩXoT3IXk>\m)c*zFa-试)vgb熾yWt%1u}DIJf6 ?W/.Kf>+_&Tzfy]Dsc4*:9[U;#1?3jI_Zzf~^ vm!b+\l=9 гd!bq\bptIqeM4гW=UB;N[ gQv{Ӻؒ48b[: "[=jz6-4fnM)BtE8W;տ;[TM)ݐ"Glc@{tC pE"f.6_ v-(ل{v]}H"!Ջ )ݣ?tvR`o1^!bnـTڎٵ~ҷeu!}LgZwm'ەRnuĶ'>ӋƖ NE;@K[E4MгU_B_ʍ)E;@)MTr2/ΆVh&~F,}M18] %9 gJzXߎkzL{w-48]*Ut%_kC'o#=N0؏]DFD,{ҞBzJc~#A;u0 ? {TZv\~!TqMbo;@jx8eb۬=_eL%(zJ~$="ͬ/]5nڏ(tM J3UjQA?"YUt킰؏$A7M=@iRa7jsJ(?q׻ rD>U|YmX~ܤ3ȏ젏O@Zs?k@-"uqyN{AޗU)'W=*@RGI%t!{SʯZ-0aUzys%ЃY5E$0Pis[5>뿷4w4(?%0aWE8~#5Lt=szO`.=PZcD?ZtU5: 4k>k~H:A,މ^6?2sD[ ޞ:) --] 1A9;1.-v<*PPazW7AO4P޴gݛ8ai`bp~ڑ˸2)E4c{z :;-sҬ 'lx[a\*6s}2EL'lPe_8anImj Mwux]b0.uܴ^7yuFp>xAoqۏ^ OL6IUtL8L78j.b3&t85C 28L+$c쟪8~3֖ʝP%ĠE F| 4**8o*T%PGiN;zwobܳ=g!7ݜwϜ<"2sW^lI5C #_GY) /؆d體Л:jHBd*N.&ddC?2ˡJ$+JIX 3=ٕ&ֳ46?_ =c2f46 2 :K.bl4S^iƪ5#b:^aljH$4-sv1Ԡ/)Cg;vDfmzjP<6Ԡ5T.?iNXS^fVTw8aC 2[}fR@pT;{6s#db 9U!V;wفX6fZ\SJP+)阓ֶ˜Y Hc $#Q$=%mry\UtzA8#]]:@QuP!WuMRH/ٮ7e: wK$ǭP6+,@Bs@#\'9-v]D\U)tս?OLt Tyl͒yXGe&J}uW =lZaRُU}tEi6Rڦ#y%)36r/lbh:@辊Cئqބh:@tthU~nEazW\MzX}(LWFRvH+M_hjHrQ fX_C!6Tl[Jcmz7-EhgDzM72Azڀr(^畘Nϲ%j;@FYOMU( ՋtS_؈훑BA= 9:@.M}8x>=\K}8@._]n]_6gҟ蓔wN9D6R>jY,BЯaSY V 蓴NH֘C7*Ugn@.>xF>}o/$9r%_Wn\\A_2&>Z6-ԧڟa$]9rcY?7FNƁ\A;{\}qm[ܩ3'<3Og[[ d5|_\gUGVkq?Ё~mNcl{StwF*:[9GP:tgg c&ZC$y~\z/ԛaN9l3C\-zγ)lʢIOOD!>>z_F זt+ *Ll|>N{Cs'G>dŮ*vz.Ki[Y,7Kwdl_ † \$،]pyY.= k . .W i7!d{}3LmQޔmJoJg >c!%y&يIDKNeOşmEˌJu~Xt{,r-ܷ|OXgIEyCgGU>i.ؚ߲c &1gZ НꛙPYs^yT\tDؚ g K k[+].*'s1)tytrJ`ng׼Ƥ?(Dн4T!x39tftNSE΁tc.jI<#Cw&ǾԗCCtp>*Vq ^V_fU!evU,r~FxYf+cvqqtI7I8y5XbݮCtR%=ksiMrF|]DkIZÞ Ư*r\0C3cr;qZALMGD1L+e6c=v膅|՜/PwdcnîUb?۔o8Mxg3P)P?+;9@.+lV֦z_LݣrG WwRJ/{-"to }UʢR~1곭=Ά(2{nV%'.9c.!M!:6[ Qk.G=\2\#~'껶-߳[Z:Pv [wp|=_YmcR{dK&<4, х-.c2g'Ϋ)wƚmq[\ :x`tg)w<ҦӐI{ԅe7g*.9?!-lD3c@ʹT#f0'o30藍BW_ޤ8s|P^[c Q֙ON|Va?"o'/g֛a*Sm^4WyfG;ʷἃIw|ӳe)WrrC{&Btp̢ޭ{mͿzlU#Rrܥ4yUp^CxHg 1DwYtLw,6ԝhD?,DzL7/I}4瘓FQrG;ϨUSjkQ@tp4M7ϩK55% :Dtí&^RM1ό\'!^v^ޣ'Ԛ1`,&3PGE9cEmWHWJ۶#)^ gAtp"Hيgn_g)(.VsHQ~{cu6ήkÜTf;]cB|ۑiGH]c;:vs69nϥJʝ=rtnjsvw&mNsKʿ|*T*"7,!:3)V<~ɹ @ ʿz+]T3f ,ҟ՜׌[P}[_W*$ _e1KZT}ScVQv!: 6wV䚡zXW1ϡ =ݨoH鰩s3T&U]GU4ʝư tgSl5GhY6UN.>9nNK9J½zMTB[Y}/_-L,,&I#8\8IzUk:ҥk uOTQI۬5HڡV9_%R]W&Zb!:JeuaR=GO͡"!:ZʆI0V;B7"D+4AtpMSP Mr*s!@}Ti&k1scZk&D!NO>'蚆XzETMB )5?ZmW~7U)Υ8|+&{*#{A2My9+kԒ}WU+!R{wØ;j;D2LNEgT^& !T}❞C+{KLի6~?с%־zr^:t գ"!TF+9ֵOs!TduΜԛ =1Ur{iz ES97^\U%mZ_?Ze5ޮXP9mZFաmk7UA Dדz;#NYQhݷC/w Q!:ԃtގfXӺ?wrC뽕,_MQkAcc "j00 ϚK?{-꟠:DF~XUU'Z9v4]/YLCPØ,K5e ?S{/Eo!:pXSQKq=3\O~:rRʹu,|$M Ko'M׳[T uu&' ?p`rwzѕi{]hO~4&P]Qfyr5NT] S&(h-c_\랷G|YVrN!StXʉc.VTs+/rslf7mh YRfO4zUgh93jX y1uSC]^wWRv"b=GU^+xԩ+Uu15h'g}n">ľ;N/͹}Glur#Nџu.[;Tvgn3Yuanehne«#RP-Hx,e (q]eD%+WW XLKcqhgݿh88ӱeWϹ7!@\BHNIDAT f==soRÚx.vY+xv$[Ot@hXJ#^TT;v~f ~ ax^Ase@@t>lӖu .>M BؗG~P?xF0 _Xa59q[-k{?XSx@G,i)UͺRB}gbc޳GoW:{jzU׺j*>eIoٳ_^NGqY7&mb\N^Б>~&;[~R-[[]uLN{SMBc-ȧqO{# rZu._R&*BR9e{W=gRZxKiMlm)h''~=})@t,fM5 ]z]yL#6Rhrvߞn+鬩o-|b7W=1APk]mnܺT'[yrH X@ߥ}: -ENN>?S܇+{3`XvMfw瞖w cߗq LsǜQEOYgND;]ؖUimy%|{}J$ZW-kr}_yj_DSluK-w.%Z'fw7ۻG^8iŞyGutk _l˝\;v[Bπ k缏;iuMkר{r G2Úr0&Y`ݻBsjfS\e?x>_b.߱ύBUl=cWRcVwʞ)＀m8bّM05\aJ5 )6xԝnIC&zno[:DaW&YK~>;TQRfy:vr ѾNk;#N%?=$*kcN3}m Sm\@F|De_N}7Դkή @}t 2BsΔlSU}o$(/|ugzw$fCB@ ^ ]g)An<_yQE5is'R:eo&ޮ{_?z੫g_|{i/>H܋7_]r 7pqZ{y@3*CB7ճ~O |;pGZ,dO}A6_V8ְW/mo0>.1=Aze1V1]j(HZvWLj=z}T~DsDaeݰ48ǏpMٰ)/ׄ˲CG3_p<ԠiiG[NħݾƏOU Q#>O~D4?l2=yc_yϸٳb! :~Z)C_{m{ljOvﭒIQM/VԣJ~HξN +4\]<>W3o"sοL잚z$ӝesKr @nyϼp =4!rרː DA|o$Q_"\,&N^tu?:"yb$%y0~=".wϟ?M?XpCq88k(GՆعUUrcZ4I[[ɋTi.I_Ibp46%d~`~~0{:bc֜*T`7REFUlhЫ.%JDmoMZv]j*D;ue з1'f1@Gӕj14*C!X*I EYbud!0 d-PE"ѨFC%]$tY imœw|g}=cs ߺ}6U{Cg3-̇YnZjfR3)"~_ ~Hf,H!+NgIozˢlO5ҟ?T۪K$JF3*BNh,'*TK 6bf6ԮcMYfv" ۻYbM&{!+fe-㾶]t4⚬:c`>f?3:cڞپjo dCW_0;X_/tY?l;Dc :?.}#& 耎 p: #cB耎 W : !::#:#GAazG]n=.9K}v9֛n}7ҽo{l޴Z_ɭwӭgǸyNg<@t@t@t@t@t@t@t@t@tw:m__b}aDM,;Α,64 zrKH-p H ѤA MRl+Zv@Ȅp}?3؏gC:A'tNA'3v?`~AO֍TT3^c>sAʠv`BЋki+!2@ϟXCY<}◤]5C]Lvw5A/j~ .IxU,{ﶜtCYVXU3T?rD ګH>Z|iv}`?tC4UոfYI~#g#դhrIYPa2膂13_лxYSѥc$%'avw랢-MTm{ v,A F;g(_keiarxU-;#A/h/9?v4̮bЃ=NӷjK_&wy1r1*^W;[r.y] `̬{iҷ95 orPs溫誩V P0fv^]WΚ\ssӫR^ P0L?tygP{Xkf3q^-?Z]]?e7 n(ۊӫ ǿ~Q3Eg zQ{ 5~^'~un/3 <_ԬW W3v"_e IExIM ߥto>jۑN [{9֪>X\uVoU@tA}uNO ׋zه_z8QQ^ף_v9綥r|$PX%tM~wn+us+ ӣ?Śs6&`8t{VP?. j' fm:TxkF鿴 'EA/k9fif bIzܛZ'פA34Ax.?Q\KIR0#]c ^3렷|XKGRV-N~&u"`?譫5vF<[Vy)迨UkOWW/L0tϷÛVKBikQY/v&`6&Io]K/#JE,]* y '+ zadz4Rjzjpst@tA#"ynIENDB`metafor/man/figures/forest-arrangement.pdf0000644000176200001440000001605114465441230020432 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20230811161550) /ModDate (D:20230811161550) /Title (R Graphics Output) /Producer (R 4.3.1) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 3137 /Filter /FlateDecode >> stream x[KoW%f=lcXYY"|-ڒ=",SU%@ YU]]~ kKcw34Fv3m9__zO =?/͋·ΰ.2ήgO3;Yh]rIZSw?{ﰕ+m;#ޛNÿk;{~nrVM}cNf<0&[`?ugdrx*FtF3aUg-2  -e)  YF$ɸ| VNw8>b ߇;G ُ/>Gƣ;c^oWÂ]|tAbJ7Zw orw:9_3LI!;-IKB^839ˁLOt#Wmk`y\<~)j$~ܑ~؏v y6N.  CO}NMqyGb0 x(eB1=8Y(P=:)!c( XpD S]&< }$T!  l >a IĄ΄4Ox(8rIcw@e ǎFXVwJQ_YICƂG>NA}dS(x'T"r!|RjҔr,l~l۫[?~zTC!WI#7`/2ʒx 49xCxv6b?;]IXGuǶ.i`2dX'Tdl]=9GUX.(\/<_IEЍU\cy#x"\ UᬰM_܍U ad{FQzp{w3)sf=''/9yH  N ka("<GI$qIq72TI@jeHN ^JXϰ枥+ 돫rwZ=+Nj"w~vr;V[^5.8xI U¿RYhl$c+^U:G"\AEC9K$bq?¨mj+HHObexr,V^\Qw 7Gٲ`h އ/ɁrC|la1HIC;3ovly)v'+fae 5zmuzV; |X}(jIP+J ihO)ii?4?.x{߸mxC {(Y*F\WL4N8) $!++3"QT I5ɨG?A4B=҆uk6 w#ۜfky--C0C)[:=|Lo>7ӛcz1||%~z1|Lo>7ӛ7ӛcz1`ӛyӛcz1||UN}쿣5endstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 720 612] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 9 0 R >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000003501 00000 n 0000003584 00000 n 0000003707 00000 n 0000003740 00000 n 0000000212 00000 n 0000000292 00000 n 0000006435 00000 n 0000006692 00000 n 0000006789 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 6891 %%EOF metafor/man/figures/selmodel-stepfun-fixed.png0000644000176200001440000005115214465413204021226 0ustar liggesusersPNG  IHDRz}$PLTE"SkwwwoooaOGGGSSSQQQOOODDD^^^&&&JJJ CCC 333[[[ccc555777;;;$$$sssXXXWWWIIIم???ggg@@@\\\===u"""rֵ|||###+++rrrUUUfffuuuvfTTTN///kkkAAAbbbLLLկꈈ{{{hhh(((Z)))f---ȼ111```襁MMMlllP배ޅpﹹYpttt*999wz|EEE񝝝ppp㕗ዾgUj|WmmmLퟬ鉚i򲲲zzznnneee䛇y뱔߈q$>̲l|mo_ꏞq옧聒aw.UmJ IDATxkl2pgC_u26&72D  KÄ"yɢRT!rISy} ")k/ݻMۛO»gf7 B!B!B!B!B!B!B!BRMΫwNY77tHo|-q{-C=?߷<)uITUIk ̡:Ι_847?q^ԾY: hf =!_H*jæ| ml/7OMk1 ~I4h3S?Qf\ry ttKA!샠/F@[Y?x+ك>\<_-c BYK(NB6c[[łcy/ѦݧtZo fUGv;2Gbi` Z4O> 3Et|{TY y֪+K rKrqX鮭Ήѐ]$:Z!Z1B[s9FE|Y}ĚvM7yE'WYJUi_?yh4I0hׁ2Sg?Rta}+rluQ.du9ruT{EتtcW!2Jn9z!@}d w;0WE\Y5Zo6#d\U9 x1o~zOә}Nez|:;ɱދ])5\T⟢9[龭(QWXBϝ{wCrP_5 aA5\O*͘ъ~7 ;5}Sgr~ `Ok!7g!Gp㗽HBƤOzaHn/D&VG[kP'WMHc]i3堝U"VLyzgoH7f[AR$;;}u!1zsT\Cj > Y:ES>n^Wjs_Z}sX0tBmEݐ{s Ӵ&Ѡ(nW?i0O <"t +ݽk$D@wX}#ζة^Ȧڹw; ^6nMk@l_o}r1/qO3 MkNٟAoς{yE-øZ-'`@d3OwtO;#ZepW EWlɄۮk|YmMk@ͦuVO*P@=qvL&CBp<=3r 8}\@u V?#Z!NNn{`Eݹ*)'J5llMWc:zl'4s1=tc&@A5o !B!B!B!B!B!B!B!3:tNqm6̧s:-pvV*1?fpPXYA*kFqR J ]4ldոuML?lb05M|jj/mIFs/ 0sp/8pϽ@ (pwb0@#.#t!`gi~IU-TQM˴^B }}+o"JJr/ֱnǣK]s.Xt6Yirѡ&](?ֱIU/i'D]U\J/pn"w.'t!xg'ؔSAeZm/6> }֋]NܙCtWDب}uXm!tEƹ_=kkb!Sw!h46Cl/tڶPt9x»eׇu7!G"CtRbvŶfZ+5  ˚.hMH6#t!`k3 :hixJ"/|V&sz@tE0ED5C.2 A }pWz}O펾_ }!|E0EL %i־ d8MIY'}m D ]M[@Կޡͨ3DAw sQt&cwF!Ns1z-!:G GƑX\s!:Gѯy6(JEs@w3sQt69nƷ(HE/t734:jrȼE%9 eվ{vcEviЅ3E_4=i>O",έꘃBO5sBj ):=:rjr);aex*7%#iiH2 S+@-2l31Q'mm8f!t|o:??%==D-HKo4{\z>ekO&sZћ32^Hiޠ_T_!z~j ` (t1=gފݱQ^:}c_xNӄq1:Ӱ{0.tyCel>o$PyfYhql˥4K]^}٢Iozw=zrhsx["Ul֌72.tyC ײzvp5?Dw1t9C^C]r2+}mlөl t9C~s0Vrb:v9D .7"DZr2q}?̄V_=9X+Dw]Q1t5CE)AW9Dtjyˬ@t];eC0~k]Q)|_oD5(s)u(sTBtݠ+;JtECt4)jtCt2 k]a.@W9DtV擓mO<] 3Z1ncteCtde5?@t +ckܓtCt7F}tDLCe]ʃAW9D_yZ,*C9D_$lʱU2VC} {ѥ"s+^cvglԡ&}7(AG!d mi/تk]ctI+;e`: xN uRkcm:%Xx]_IޙueglM$c[mZ[ˊ WBU l9v!q"$5uS0Fn ijJBQCZ K!:i^(tj!HwFc}{rru|{Ƴe4 vΏr\8Wd0Q;*HYvå\a#޲sr?TJi! C6lKyBq0%cRi]t+ 0Q!BW# C7c^\"sUG>[28(  C!s-Hǹ5zR t}ҝ6\%88_gE}kt/+6G\%883tkq-~k  C5qNH't:  KKGq0t޲/t+ n9HW:εB']E"6}E@}U~A@绿o|oO脎sxB't: 焎tBy36j!]U8Wzp%bAq/`yOLM+  C?[.L$t+ rXMKҕsNGVt%\a#ҫ$t+ N5N ҕsc~)8&}!]I8W{DD|]ŚHOqm1=YGFz*d(ob8L/I㫿_t%\ayƜ-6;t%\a{3Gq0to1χ?] :ޒezVt%\aojLu/~qe?8-*Bǹ>{~ 8W.CoOx8WzS\\jA:j o"}BHOQ8W oR4fD:Նn ]W8Wz!ՅsBG:4st.J_@zJǹmt}qN@@@@@萚ߴo)arGH't: 焎tB9ґs#89ґs#89ґs#qNH'tYHt[f,$:qt]}1lpJ_~@3yV6'2CME7=>wis[jn9ΓFȮ]1p+dz~+fxKue =CΤ-96jm8y2cn:`{2ޔg_q!} #s![qpX> mOɏ~-_m_Ic|V̰*/9>k'-K۾8y\k_ɉ2`{ymRe➡trdž3\[7=i/ AF5_ˣftW8Ob %e ncgE<bͲ=. H4ںK۾8y8YM̭-4`{)q}f[ԲbwE7Liy=s8~U?S?8tW8Oye mXt%} ~HVYo?yϹx۾8?vD_@K*H˭X ʓUPA &,J4f]tu5a@| ZQC$",1jb}˛)wfO93m9iWZ.;hx=gW^7ؐv҃U8gj=,xvi]顧]IfWN.冴{=;QmchGLc=b˰?zB$ӯ$3g+ꋿc)7x-./k J6d:Zh2agӓiiW3sdq~:|ĺ!6`dc0󝪭 >gag%酞a%93_9ѹ-nȬ^Զ2Czh)/[ȸMzZ/•L+̙=s]rrq2a6~C1weZj<+̙9e(,3'N̜:1sbi%M 0^{!4x/FC7a|[oh1srFg ]z:qŝum}s1_md99"tJ!*' qԗ#ލ[pK~|k, 3'gޯކb[R> yJzWd`+ {6ȫb uMӃ11+a99!Qm=uD Q+k^nO b̜`&ު9k(՞٫a1n;:r̜uf\Too{'ZՏ'ԣ B/2nIc8 2srD4m5[:뛝1CsB@M3B{W{ma@5y3^pm =|}72srF葼`g=s g[Kz7k:ļ;][/Wc!KKsܓ7#C@p`{*?EJ͂MIg\Fqͅ^lU^TllTA`DLxͦeBj3 b o'bז $)[liuPІԁ:ȫCLS P.7)ї,yą|ț3 WaeAvM_)P$qWmւebn1!uE*)YMud3gg.&-c6 mw/*\⢼ھ}{pG19B2}7W~1T"=>wM}lr_^I΀$!20s1MҢQA'T.RM R~&I9;sXlq爛 LluZKwmtqLGo'޵6 Gc['eH.WHY4U?o$Ϝ[cޣ4o`N2JK|je٦^PߌaT/"y:i?Wn9}]k@_rxx+B5QI⮢BmtcCZ# eİpɒg\Op"U `Jw@UONCວ7,-!ˠ?@Lk8`=޵4V_IǪҶm`l}6ظ&HU4! }mO9;tJ{ =߼ř)Qumach$w@Tx7Ox+Ę~[ck}hc3uF\m]w힊ظ&HU4! d䙳C#8_> EySҐ5d$/>JKHPdcj | D%DATVvUڡ@[*Mk8vby$.θg\-۬NofgoikJF,z.4sBlKu|۾Sȷ޻L&wzl}}Jy}֛SEꢫiͮf"'Sr׬ͣgAAAAAAAAAAAAAAA'"QO;:G̙5v~,:G̙gt9JGt|WW5Uiץs:;쥗RVbuXs:7R)Ttt_$B*tt!_^zdktt!9^n'Pzu;iN'mʑ=iΎh9t.͔Y;>q |~r6|a?mgnt^FeR:q >GgJ}ݧwzd_^pA#@?wԽ*kJ⊳c56\_tRAGBkˑG2*u65|-9Z\0N)Ba:/<@_Y5#0;#j9r+m66J#^ Ҡj~CvG8s'>='-_J[As@I:t@Gt@t@t@t@t@t@A?~'grt@Wz3 wa(_Q[ 耮8Wl!pW8ڏ@tšd) =<~@0!eK@]%=k]R瀮$ k]R瀮tWA9=@ ]%#]7:t6}&%u*A/óA9&%u*AR]a:tŠlZtЕYaƤO yN|a9%r:w<A!9z!ʆIt`#:z@ԹaYJ>q$bwz!MLs 6rq ZK?Pr"=R |ҠЯC&lB?a?nyV6\?0vpP2|Y tlZh'@:G d*:-z593C/_0_SuWt @:G ]m2t[nks@gNT(OSt>\:##?t suchKЙ6ǷQ@ЙFVks@g[:@oc{@9O'Mѓ%]Swy>=*wstE}2ks@g\KtMsti9iZ3-tMst66g&9:tfS)@:G =}xJsU؆y*]c:G ʹSsJ)+1wJsOͧ$@A:3aT7~ɔC)W߰53@A:3t5W}RȼJW%07Uݢـ9:tnB3dlN='['ii}`E: s@^}l94ZOtg\z1l&t:~8ٴ]:iN1݆ ܯ s}y~e~ : ]~ [GM-$~~}j]63/mrMTr}V&^.ǒs@g:EXR@*Dh啌56GR;k]]"tƼ/ĢqnjtU:tžW k]]*tFY @t@t@t@t@t@t@t@t@tWnU%BO. tU:tK tU:t4Bz@*Dm.5J.nIG@Ws@ H!ѵH.[kt:t;+̱ژi t:t pUC>j@Ws@ }}`v}k]]2,Fzk]]2t*F 5B. {TrlL?{gUvA; /e,#]EYKJTHyU.5n]LmOfۥ`7YĴM&ۤ~;oL6OD/Ͻ:;!6`WYhӶKFPEn-U:^ ہ9D_e/S_&UA#T-DMc:x; ѕ!*.5UOǂdW\;8QmNtAtEsڢ Qw\tD~x'iwW D_emMyfuL{ jj 9snClK)>= jBOCߘJ͚߯f9Zl3ϾļS{gK>GZl3 v/05 k,z?^{gCuK1\͡fMײOYgo/1TA[6Eu5 :7-:eS9$Y]B`6ކEcѳ/I=?h蚊n;WzY:m Ic6:>>:) Z?g6G7◌ܰ9۶A3!b?uFr[L޽iH2qtUW.q&DWLtuCekMf;P;m\/K7Bt&/K NSj2}l?k&!D/@0_KW!:dї%(LDW9D˜$At;$s.Dן9DX{  g^3kAtCt !k]ot%Ct Nѵ]M]d}5j2"kAtDW9D gBtCt)]]` ,Dן9D g~/㺤{?G̸˼17:FWaE}v6S`)WWC(S`)s. ]S=C0z2k:D5 3z2"Éjnl(+̙1DڌW2ݴvRqo[ɯtŠ9Cщ-`6ˁzntŠ9Cѝ&㕌n3GJa@W :3џ$ nv)t0׌1GZlKmiv & E7'Y?SU=k=6̘ORϠk7QG^@o:$ݦcE_]ې9TKś+9SqIƹ=uъzo_tBs5z :KҤD 1*Cs>&GN[}Aî" Bs~Ms9Cѷ8^pfЙ@s8$DwЙ@srbЙ@s{x.t.<( t0g(ze}!:B:3{.(ԣD]s`Pt1/be7:`Pt3;YAs6t@g@gY+@mμܤtVȬ(n:`ΐ_&<L9C'D9 1kt&QaB:8~HFAtS3ȓ@ R ՝R[I4aK})٥l&٦骛4lwlfw C1{wg^9mNn΀Z=4i' Ns}H:zD&G{ѓDޱ R{\Nm"!inࠫ1 )R#e㥣JEnNt8)_-ݴ47yndш47@gU"|ք47pwKUr̈NszѺޗ?MNso_DOD4: tm_WD7$:͍t%-f :͍D7niΠAyQ ,8D7ain747o?ZDGD7/:t0`A49щNs49щNs4g }޲@bNsK>(oJ 7/آܼQ_s.آA~: 9^linW:`][tT:@E[t8+ܷ\5qvt8'R޴_&zRҟs,d9BŽNsCSo$c܂9^lin{-ԡ D/47pЯȬRrѺ^@Ns]][ Vpы4: цk D/47pеݼ4gA :Ao(x8XAsOJ-;|u=;pl_CsA9Nt :t49щNs49щNs49t3Dgi^dפþy;÷472lx˂JzQza_S,X5agiuxu7J('IsM|P$߲T>?ӈNpۙHIr,WhbQN4ϗsҨT/9whw} =kU뾽rc߼YnKHft퓤9/\fǾU]`vшCm+JC$P]$iNnun ;DO:̉NϠTY^Z /9f]w'ѵO4ϗR[9wX& zY;ܐC;7}+wP ˞txAeF>Iڰk vxVgЎCG vX ۔'Is\  :h :h|\=u$ە|@n۷Sj~ WkG[]gcQ};_WFڷCR.JfxV98Yi]ֵ,zuAkJYYEf9@0Oٷ׫+7wJ6#=?p4G!D86ZҾFƖI'iB~ӹˏW¶R FJX{R"'HsfQO;jܷrWhX|?V֢ZR~yz4ZS~lƎ~OZbE w~iw]yu+aIC>vK9@0\xkkD~kݢy[s$r(r7ﭓ'm]HsFXϙh,<6$kten?^}vƺ˜Q ;899;}\nIENDB`metafor/man/figures/forest-arrangement.png0000644000176200001440000033472714465441230020462 0ustar liggesusersPNG  IHDRS pHYsnu>PLTEqqqff LLLUUU555;;;+++{{{ 999DDD>>>@@@###(((RRRcccwww222JJ---%%%&&&ݺtttIII000hhhӣYYY㭭GGGooo~~~!!!///aaa88OOBBB^^^666FFFSS̞Ӓjjjlll// OOOVVV||MMM粲]]]Ռ郃<<[[[EE""񩩩&&++\\\33븸ttlleee``|||22WW掎iiퟟ디xx@@qq[[꾾줤cc++99JJwwGG~~쬬yyjjoo__ee##|]]VĦ..::GGOO Mܦ IDATxsqQp%N1X`@w9! RMA  $0#C fF0I9C 0) PXa/?1[}ݾ_LvnrٽCz1t@A: @At: At@ :t@A: t@A: @At@ :t@A: t@A: %O3NyA p_ik}L3!1{i-]:ՠ@ù _k pj 8)?%^o -\lygBݨ:4g| jAN@\8s3c@As'M-s0})9tC$x,-F9-7C((6Ap9n]K סgCw^A]:YCG:{d) c[9tܲ&$۫sr~PGI2<w\7.*K,{QRJ f7bkX4VW'} ~D+' voI$}>=`O.C9KPο zsOz,Wdй=p.v _Q!"I\hлv/>{sbե3)j|Ȃ YෞX{v/A' BvϠ_kƭ 秊{)>)6ձiVUVG~Ȃ~ؓmA_W6:tpZK*=A(eIA7> }z^T,fm8MZL N෶9~:|sOs~͎Ҡ="l~aDPZڼ6޹]U#Us=ۂm>*{ϩ-}} FcO M SUco]ϊ(PYnM3gL=`;{>2oqwF\З|ci [䷇9p]nј1 Fsq{gJos/CZ=WS'A]`~7*~f>AtܐyF_Ӡ}ECfI-DlZir>jys Ҟo|xфS-W?;<;e%2#Sշ)2[%X'y1AW'f>A4Dr4n3IM6zWyV_$PE1)X]弘Ӿ>#f3)[?;[ ܨ[{ҌBGmn)yn$}'۔ΝvNo8}-#edqCERd^#2#x%9Ldz[Mի`N}^/y0V'իg:fQfɌ767&6ߪ;_C{R5={^_t8uPǦC}r3mwA?.ᏀSxN7Sj|pӋb9*4%jb[3.]g:#lM }X؝AI^:_9LO# M1A{WZie@ު> whjlH/IWhQiepUB>7iy1| >)^sE AM/W_n5&p{͉Ǭ.zz>twuF]~BGX[fQBЭ˻Y[ zw9o>`ht}_q!Hz޺4s;OlvrЯXwAHmPM\ N>x&Ͱ.V%ɳ.R[:nt{wg zat:.i1LHbkcЮf\>a/:HkYwjչ~^n}8Sc=sG!R!~C*h!1U!hʼnځjFTbĈbZ8j ա)F'tƉ?tgނǗ}~gw}>>gOujڻvm"R },SPKF*+Gpm ⾐'~B PBDREfQdQl!$v3„q= ob=E78zTgTƃG/y3)Cw:gܙ|3ޮ#3Vxǀ W^M-.Mۣɝ 'Y%Tj2ʛno{: ഄOmVg(p푣 Lnd2{F:m~ʿ}%4BO23YkOVՌ/:p{ġġ[OB_@k+bcC ĉ Է|T9+(2IfB7T5f og/s8.M>Z( Mgy^h~6L^rj60Fk$tQCww =bXM߷᭗ ̷ {{>y<_mb"t|C=\׍#Wpe`mwe`5R|mrw(}*|׀8t8tD tK4uɖBnL[d+4uvG*+G\] ;K?ylh AH4\#pk/yR潿tآn4<̳*䔴Hq]WH(ЖSXzI>BŅ ]K[9PJ3P$jq-tgơP:OkT:zSSf/J:gE| p.ҟbP~c1NB.Nl`R?VЍf^ :ilWom=&5be23e}ft&*VsM~/AYV~ mơOTI- .//g(t)8?_S2iP.+<hQn|0߈*tp^7J+nXS q }R =_jOeB:y69T4[H;L/v@ =VjScBO)J-ZfqXv\Nrt͠{Yu2e į#UHMw+{:̤0yBM׾JjnR0*#O*J۞p&*u%S+Mt XR nEA1z1H:iwzoRfBgSĉxSX+NgyhX2:^O3^B>s_|&pѯ&<񍒶u]CD{Xzܺ_`զ2֙-ϳL;7 I+J9/K{˕mkڰztz|rB.\}\̈́vxa&t;eZkfG])ȗ}yEIVS#޺C[QzWclu2B]EQ|Qd >bB`e u&EIWsxC֣FwsC짜VuuuOunσ_gtׯ{oF'/]㐚b|@dvQݍ\VfR@rw>A wUS_2cK?xE].]4R'$i]N@d;( =Қt\xMyR_@|O__6Foc<۾]?T^|I(sQ̮Klgl`b+դM[hfzuݦ!r[EPս$:#>]tu@"'/2Q2]|]4Y{Zxy1 硋W߉*vg认[-OMc+4I'oc~16?v DB|D`%  :=ߍ*UafW9I|[>Q|=5vHOo>) ˓ кjp˄@GW=F0qVQ_|< 0b?\w@wf" t$vg( 6ZFi/<>#6(ˢ(w0]w`˝ɶ%/?%+p_{\)zXZLFcL7ҧbl$2x&wh~z#$L1i> />΀ ){^oW?qI.Gz@&w.~;\/=Xe]؆.ݐgjRda(.|su~-k > eNgh7n'<_Edf^#o޷2B7kMs=hrlG D1y9)VgK%^D?S\>?XRb藟o}jȀ>{Cvֱ42rX%w i|,:Jl[;G,X 8]2kۭ=`ʯĪ_ =X1*{d<]4#c1]5OmAR(jc])͎*YBܲ0(Ϣk9_Kv>߿6}BٷtCTn B|>/-_jY#Ȥ R,jIԼj! Ӝ }%hEW@嚮*#xhFҴ=$s@'F-UːJtqJnSFG7!t"ﺎF}X+ c ¤Z^h;[2A{X qsY}S{8˾$×#R-)#Pdp A}%*pV?gsa>͞ ԓ2ZcU=8SWDR2ƤVR!+ѴkZG(;=DO-Г5cUjf0@o7@w1Mȷ0qIf+m53"c*7x<x x|M96,[j\ UsE^C^団.ʼn_0]T).G6FHvgxhۂhA6JRl=|y@UW!HIk9䂲g0x5?:+8n vYp.4+ d@?LT/.:K[q!mِ( IDAT Q=8׋ڝUhl =ּz}\Frs%H,r güjZy@z[ tcuNߵl#SZrKh8zN9E@Bk".L,d++ tq P|B4-[#:VTT@ VڨJi΋t1eR[N@rZF)m0knr % zinŖC8Bŝp 7.Nw]ٝcKo Kȅ|PK\ݴa褺.f?@Ki+]>F.:ɬiAv+1'~lZ~g]hQ4qYٙ.ijr%>~O kI[ZHf(E#Gq|۝0{&؝b:ְ*h Ht\31Q\SbDnS$_ت <"%" T%d~BfQ{l$rw?م@ (E7s` 0E")ʾl7,g |'cНo =$+}]'I*d==(ʺ/쀎RW С М1S͙ GJTizT@WGVEVJyad@G6@f5۫c7Peœ_,4ۂ?8{$D Wl:0.k$PN@mm6m9ǯpڴAd1E=S+Q::V DA>0f.%fOF&b?'sdVr)OKennfLAY,}NiEcA xw=~.JQ0D@HJ4^8Ʌ"ݙX0#l_Bz,tcB@mMlX8")yY'b? =gnCۺ8F.qұWXTH eXY7 JhL!0DB2y1 6H;~ap:-#M){ $vd29U՛XWs_νjRr/`UMMͶRE@/ǭMY+to(ϰY;V@֎>t P!~a1W^!\ś%zQ?nm2rCEcnt)+t-{'w-]E"WK7z]aC#q"VߦljΓ߬qǟݵ&k 7 `񢎒h-x C ȀTZ(p5Pkwff:$ikEe"֠]zmg@@@M"ZT"@z4lr"6f`Ӷ }.y"68|:mkmMQ00н0C  Э^Աir`[*(t: 3knf6$ d dliF>t&ӣA Qهajh^Zܤ7r Zk>tj*wБB缇Kё`q\}': t@g}v/(0 HN:`p5Pkwff:$ikEe"֠]73bb A@& EP-q*Ht@S=e6930i[X>tnDTqQ^ u>_c ؂5 жިLptVi/4WF0_kvN:}LdS^$j6_?cn~V9X@onf6$z tJ@OI`fiTǦS^M J@O|LZ:}M:G)j,T+Gzz_Hi2Iͬ>O[0k4I/EPSnRΗo޿WZph1$z|C!}]ZHa~6ϋʌw7W` .@pa忧)E]<@#P6Ntnylr)+kbg`T@@IuF(=ze$ "zCge{G0 He9]Ґzt]zۇ·Wj;?,}]ۿ@3uP@w'e vd X@@l`;|㕻s""|2R@zC"k =8a`77q"}SDh[r-6CTK Rk; r&`C[6S ?PWE{=ef'NJhSAU9N(7%t>mwm6Eqz)|u-` 4@ۚz2a`{a A[c(]AFiDǔ-L{mw?@ Wþ@onf>tI4@ 0C:r-e@Ig]LR>S FR:&EP켑+to(֠]?TT W`(Ep'6:,VƉNPZzCc4#񢎒h-x C @E@JώyQ}3U3@l򴵗ݵL2 RfhkЇ՛11 ApHl"8:l ^m z40 }Dl@m 8Yч",ik1.#K;vxaR^ ALulqF(jm\@2=nP>3Aړ^]bڕ9r'}eRk|ũba[70͋" 5@ό-@GJ}Ì-`}D};sej1=)1'Rޓkz)֠]w\:Xmk\->}ONt:a}FiCGNדzKGZ:QT҇ݮZr/*ݷCC'?g'=5DchkЇ՛p ]5.7|?A[Jt ܎ǧ@~0 }1 :YiжV/=G>Go-zC]};n˲ 1@HWΧ?[NcqdHqc<Σ^7?\P2 Sæt..;|N9+[/o8umf[֯dd s8[ʵkW8 ޫagkM&eY nqܟ믄 ؼPh}ߡ-}__~[zBIN釩aS92.;y~{u҇nQsF,;>r|%3z9 ~ oܓ#3}jP}6 l!ٻ(+ιݴ!@]wx HWOXj`,66]|آXjbqi EЇDWw'@Yu4τ~+(fxPMՖO,>Lz4NԊFz݀~ٷEZZ'FsIė'`M5NP|]H?_@7c}Jڔ?p9%ݶ #` Q_Su􆌔:+bN%iFNeQO!ܜW%4Vrrrʁs6_B'aEuE);A1PUO/}UX߼TR" hgm?|  T01\~9 pRB:_xB7['^myĒCaPmy#P('xEx!»nΎ6KaRvAQ|//}Ma9\AQb&E86%?G vr6KF,2sB4tIb;I0qhĦtxqHR{-c@*Ն F`JW i.bNZM楸2g@e2)DAh.~ѧںh$IĿhe'(NnȔ?B?1[xG晇TmcnD[$ḍhQ["SH gz4드1^arhzi=4Nɬ :[4WkyL.̙&4Ze!Di0=_ ?ʽ[ڎ6K Ŀe(# G.a${нvM>r肈:pQiF3T˧ÞfF)@Z-4pAHa{ ] <;df c: (g,JzhrP*:Yk51VZȜi2I>!z["n?>ͽ'KvQ]D SUg_ԲSG+nAl0^Rr)a7흏ŴUJ@) 5Zoy)@a}/̌tOTY@2iMp.RǨeRA7XW$gZ3q|.tur#Vu|9֤Cf5H_M ta YK 7yDEJꆊJW/ u7Cʪ bfQEvpRB6Cc~i@]5NBUe?lE 85W->++L@4#,г*z5BiRjTB7bU5XZƍQxWxL)<M1DZj֓:quE'J d!ǘt'#7$ 'Ce]Gݽ\dϹTmA$RA/!|?ËPX~/Wi(n[ֲ4B7b]5XRDgJnt5B?o[~5BP._5iPZjg t oA)}Dؚ:蛖~ S{:/EiP rPƹ󐼋3tfM^[b `LmU :y6뾑 tƋBdDK >)@~hu6KݎaՌE);ALڗEB5I46j/8fg>)G1=%GݚjƑNJKA(y&tJЇDeCes!EI5exb 9\@$ k'cO-;Iq;sVb8Y$tL"[zO U&-!J`i(XVdzzFx ղXmeKϷLJuEB'S-u/B42WP9^z~(iFsI0_ <$Ž<ʱ  $_JӨw 5Ԡ)Ifb3xйe꾎]z츪PCn?>?]:\A%ͽ@%@! "AO>*xC%#.޸7:x+H 8t:>Y-at F6OfT <(|[:CZ *_C%MpN pyOntq!@Jl.w?AAÄC%C:nmA:0 tġ'U IDAT7<9DZeALƛq}7l~JcŸQ 6{O+Ѵġ;ġϩ:]ЁvދJp'tc8r/+_sl!tBD9J~UF8t`[Z%qڳgA>Uaq>rv߂ڍ7!Ʃ~fmX" N@n?O ''+Q}cꞿA#$=TE#*>dAo OxbOjynGK >_ \0w,B[YDsߜ$$q]i5,k+uʷ. ";5IGU[͓l3~Tn}s$dЯ  bT+47!gDOM:Vy_V[>dA?V3o<'1"wɐ4qjgwGgMyT~qHQ,Kْ)ƚ .3(Vnk5'%%ӀJBmqs28gt^Ia:ɫ3\ZSfhw`vxB/&(+_0=as *6W02D gcaG鰒Ϛtżu.ҁb$"7Z[chw2ծaqV58Uró,e9!Üg?ѼLHf {$e',lFV*eЏ>ރKi [y% T%?CMeʺI;(]sA.9[У“fokok/oD 9M hqqc\KvAdLu  PL ы.+lpV}vHO!JlBKC<)BPX3h; UDԷTN'!-4:BF,>WBЭ]8AOJ*ĩEU-9|Q3MY)xma&akzA?( laL[đ_dLOUP o5x\lXs W)*7VFbm$kc=/ z׳Fdq q*NLЃ-- $J[Zoߛ 5]EԪ%ԜGq8br-/:C EymxWs*mTv]̠45L~&>r?rAtܱ~jC2y%Ii}KЍiMI;y]ګYͽZT# o,Z] P$!`(*&ҎhtU)ںO#3'Ǣ#1.t:x`kT+ge1tsU h]>}؁GUө|{H qqi]zCJ6>2>݂y#AҾ[d^R_d. F6e}J;Բ#5񜠏LI'k4I"Li~Lk.<= B/0,TGZ蟟ez$AľWC?M,ڰїL2#1ƍ8ptPqU!HJltEM<+k|Xkg`"b. A# #T^vy$$BQ%"TŪUT[Ҧ tgwvwvwvv}>{Y9s~8vr[~#eqIQP1?vˏُA6Nt(CKw#l,A[rs΢gLxQI̳$WnUj*Kƒu04|B?6q*t[\nHq7e)3UxB@ٖޯTWz4c#VBOܶLYFlz:rwQ+ x3GJ$KO^0VW9Uj맇 Oc< ex,0" t(]?Fr~>ϕ3n#tRUQr:S>=JiMEj  K&jq@<X- YxܧqYY0F6TB'D6t|GFE,夺xQ)ȍWieYq`M$ ;<;ěrt uadYۉbtZ%)?mJʌypc8t +=)IrY[vXfY^*';K&.cUag)De߷Fлt4bVݬz:<SNZhx`1}'CQ +[~ a.ã>tnI߅Jp>.LvvWeDܭC%" пʯ9/g3#j W[n13hSvIJG BLˀA| 狕:&IȺAuB4:nVQY( %JZny+4P3۟NUOz~=jW]"At(Q<8#еLRτ)kn]=Q4xOs  '$F_9d[@a&=XF0FSxC%v.>`W!du/k{eoQBg*pֵrcTZY@#YZ|+r0}*K5oD0ҷ%'za.D FһZ%]Y4~d$t\3?H%}rJkwm3+\|BO#D_VlN5=]D謺YEVVʲomή;QeHufuw(hul_VQ :~Ox^9OQK{&Qֻ(;*sKIjLAB"'_J)\uzhWޤ3Srx!:#5Q,5}˞U7 sA'-:v_ގWԚ6R3uzx0p:CYoa/J_O3@~zP!E0!S~:KTY"\y8HS>cΐ[`2N#O!2N6VZq-~'v0דZw0IO9p\MN茺D4tV$fMʬK|pXidLMI6j'#x(xow؊"D&D'l ZB_q莄X6pn3 N(`<,i\QN$'/&890Z7z-}\wpB_g4߾1j_9S8cI#C:"N茺D6tbz!j9oVRrlVO'YYN/GQZFk ]ąsKHxrOYVj'Uf[aJ'g s؂6&4o4d]%hBpX&HuU#O͔o'}>T+/S mUIli|[gOнg`2m\RWgE.!F]lU_%P٫e1BDF; F-_`au տ/848!of3QP@LKw,BBE/d_"t4SBBv`|:xP#֦1j>bn[/0;8vacⷻI\УjHПoi2M"4\lbg.p!ڄ!Bz46Yw*a;qBې%?>##1a@z wC'. %lmW`'jW(兩"=a][~{o>Ү$ġ?=꾆u0[,vhoNqplS9_|i?y 6k D ҟ Çax@ »9MρQC##һ t<-|Y pGABġx86q }j)[P`-e#H"_>,.lN2*lf$jES]hqK!d|U+tq>Zhqġ{:^Vz!?"Ų8.h/A':3y| QҘ_ mq @ ՜B@#D)~šE (VV?mkQ h"A,-Dc>ig_sl(a">An[sm}< |Vsgp>tt*wQX_BpxDcO2zyֳx ! : :X#ZZ+$ k@p:o/CA_U܀'!xx%CG %Ot&ϾF܇`B |Xn,Ec"Cpx*w:=n[C %~qwzվ/Nt##LX /?\,N.T X^2$rxAqOm $$7hn NY_SQw/<2 5^5jx,HHll(h&R_} }臈 hIۥ  uJxNS\K:ZvpbzF! r}׃jnWu$[C(kAJhmU+^Y͞} V{>h{Yݬmp`PsG@\wpKG}}@Fón. NIsqHq-d:ĴWz!{$Ҭ{O TraOhf.HeR^=̋n-{A!JHWg ?O|w_mQ@ tJ8X̣S ρg_J|A{TTFY;b ɢui9`(ڛAHdDt'VV/-ȀMM5Bv,Qa뽰8I\*wU]^\q 2Co:lBF紕tZ~^+5@c2N8wp.uA_끝4<槮rY*LKH(A:ĴӴƒE)Ն=)˄W=6"ČuĥΦJU{a*m@Jwc%%a[BSeSt n$C{+5\z,\)z1*??Y7EthD㣲t CLZUCRe?)$cU#ꨝ%5y ] bcnߞzPʂi炞kXh)x|A,aQSwTY7s'%>^OhqfplaѠ9@tx`Z43+;2. "7j̵@A7CDVF>|rG_?A7e~Z8{r3 (w z9`? zeԧ$YCw,cG`Yw\Yroq,=}CFI+9nQ4d402I}JL ~P}Cƴ,B =m.n7eZF#jC^G⢛nVi&&La 9 uN͡/N ,|HPA{:jߞa1 V;D.Bqw AgsS"M~dظ&|#MU5RQO0 `4÷C"}C0m%L5S@:-M}MC_roֺ zVa:ds6+^6sg=/־i،3Av ]<:`NЙo#b7I9 CQ՟n?Vgᩔux $G~ H7<ʴC8ZbXP[nU>ު̷MFvMO1C A,ŇkπQg='yjۘ){9t)VƏNcƭ&#ATk8!>[a+9y n3M>Tvh/"jo1+;r`>.VdY %&P֣gMvXL :N8; /?r&t{t@)6J+}ǚ\a8lb!!#q:P1 BVCh-oٷ ܠ.B2$n}rv]ݚIbI61)XsäԳhwA*H+$ 1i(A`'@b +8-;$U.H\!'{vgvvg\v{V=}>34-VVf!Q=*fs?;0;jǡ_&TT-KxW۫}:aM>^I`rQFy' zyz3/1ih'2Ku;7n36zeQeZ oöf&L* ~N-`ݛ>˾ k'\^vEq1׫̝rgވC񍫢 =a W%+O1bQ.U/Ck,SɆswwE>f6PE;$v ĒVWt*U BtN{^!U&P &#*xpu/n-xNA ߠ"'5(Q{{2scف7fN? d-쥳!v_":Dlyyw+$^VηF;rU6GRY֐DhVy'i՚c^OHp'Lhi-J-X&8c Ahòv5ΫH;O 1$JF|7 Ou;Q=i8gP?9He%K*m(Q2G}i ;U ]"-Q6O!n/;1O6*Nl_HЙzKrP?Fg$W'QrT0'+AzV92ջhZGk- 0մ!! A(h'Q)ySn`E#:oP?w@FARS91GATcف/}ѽ\]z-Mq9+cҩl8O5SƂ>mRlr t3AꗰP ]A's9 ޝZ _dG?@m&Н|=C!5sjcv&z8t J!?Oj,E|ۚjGA/9~ޭ9H!"ơ;W-w~[[y*»: z,&%4go`7weNT/(u?KiD#@!vn#l |'x ġ3nzak^ ġ듚c=X"Ə'[|BUُ< />C_u] o@:HWB;V\[hq֯aks'/g lűEvvA Il7Aq= Cf6 zWK VvfW#jGE6sl|ix3KaZ}4o0Ck CwCk*wf3t׃5˩{a-ڣ/vyS{&DO E%1AAٹ ] q z(o ^G=˝v/۞C'>퓚.un6!Vp8߰N|`7F+'  7Ѿ#4z} :jhAaki5=([x$F v_Oj-ڟvcQ Ə5} _@ؚ@ؚ\񠠗Z p^洜F#j0@_^p̱E;vAOw@Ё퇶yPлZZзe:0ʊ=(CO ґe-_ae7ތCEKLòwțmvw43Ͽ>'>gpIU,Jg<@C5U B{& B0ABӠL'!!BJSF&IK*t@=~\Wh֚f-rgZ( 3݌Q2!`*X{ڃwR~Mp'37J*!]fo5fK%N8g ,oTT'QT! -%5Ğ=;/kS?ek朝#蓉ʬ +}sD> Oj3Ok#3|㽒IMD'_qVyidk_EwC{NjTSs{r p h=I;Jy$SAepҧ\O=O*]N;-vw&A-F~M%qўsv3Qj-| $$L IEa";۲#ٟIRJP##jwvA7˷zvU&^a+3W2v3UHT}NϺԨp^:TMXAb=CO'-i6o$ d=kJ~L{==v_9-*uokωg SNw9!'T~̅=2-ދʬ/mO3s DPI 7gL ҊѳJn8mu<n7>zyCM4;J_nư3ʓ>_\%&uBhIC&%}^٧y||Yc멯뷣Q(^>|EZ8^EtvrJ~AxP 9:\8Zm 2/$Su҆Pԛz&h J*XK^O,k|$dbSs='4{r2M  z8t=iHy$A7>k̲^Ob^wI'?ůZ( Qپ:;wE+ y>4YA?uB$eVG RyrDcdFq\_>Lӻ ` Ɣ X6Ufs\`\ KA!rB'jD_[%~љݝٝl)͛73_{QT*)UPa8]#TY\l3/cd4B7 K6i&}(So'8z%ڵO2]-;7Y8FĞZ1Q>eJF#/!г-) I^P|7ݥ\E(5ӅP;ݲ`0nwlQzf,uW\ O2V8+p'(9eK1ЛEC3{Lk9HDпJlIjm VJڱLq4 qBJZK9@58c0ڒlKq?dVYՀL xaneiҬ-WS難q%Џ$fku3*ݜ8DKR8C>9r_S~˰j[j90]Ζ!X#Ĺ7n*@7HMDQyơ7٩LSt9|9CDl/W~_{#Y=g,"8fg,:m ЉF[̝gwLށA:Ajm+pN)\I2`-{&{hÒeq`ƃmTS7ԏZSQ\\Jkel'&@O@,g[$ߑzMOcr [kdVO:9;TNȷW2$8L'u@ eY&ʌQCVNj[xtẄJ$6( v2FNY>G&:F@qԶ:f̂le ._P|Œgޓcl<7qԅ>=@x $&CӀtw- O*l7pyW;Ա֌' @3JY`Y3:#mf4fb@r}wsz W'U!>3sB:S\Z%`޾k02UֱDAqʟ]n8 zB|l9"+z8Nq yht9ٚO ֞?};ۻ5::g q |rp`te~[;@/0o1`^how]1;\qݥ=_=-u ) :$8_p^~/~\ێ #dd ғh7:^G?8k2L]6.o3oMkTSg}GXԯ7]DoG>x鼨(@,\n%i5xL64Rѻa(Y[Ը9L\O[]40q}*Mj7CNrh 횽:iDi.0&ܓQMC~>j; F HkCԂd ]6,c?׎Y|ҷ ]׺c/XGXR칟vO^^[-\%i :ܘ!}jCde9>$aG%=el"eq_%į# :gЕɑb:$8=!_3ccc'Ԫw.YQT?[8Ea$dU<Ta7'h^0R(~j2L.&) &Q:"@.^N466"3-&I& IDAT3p>;9z96;PJ-G6_ 6rsEΝ$X}4?շ²~ IuB@W"c]Yu!@/"{j*4R* זZw8Q>i4̦ho|fAٍEz .Ee5d`+&j2n8~vE*-/ -uP qI%!bC@K4 i I'd&3 iJy oBtIwY'^_|Z}vޞv,ƨʪHV/vתoM8kT}P`V7r""o A>;x2k](]M4 U{/J5M?+MK̨M|},VyWpLJ5Ҍ0OI +NRH.$gS9V[$߉iߪK蟥)UYɒ gQfO5z==ƀOƂA~}f 9X[潻ħ DTJMo+>|eCB~Ey.b~=A'~0 /:7'~]&DFv!.ΒS&Bّ;BAgë[|DZ<o|VZs.@Vޑ?t4cʒg?|Jp=-_w[#ɹsƓS:P_u^+?粖N(4/:nj,r_kp!O c:@YsRC:CuӅ0CVG=!ր.V˳öEoǀ<AyH}gCP 'X&˺,rF.CjgWWW؋d +m`NA5mrz#A{HwIl.蛶o߄  k]&Eިs*P臅Ɲ!x^HMoV!A4-m^zӍ:D? f+ :6 ':8'm xOWB#~ .A.؇p:}/#5cۢ} `SѶxl[ضVxޢPhZ ) 4VlÂB `> m=~A0(xO7\\a" @~օ>z U܅G1-^EoT4Tb68zӨBWC] pހ 5zN =,M g8J_ )g8bݏ3tA8^hmn:!tB1&Kenض4BAߴд:؇p6{se-۱K臅Ɲ!xNy1Sz= ^C`z9wMr@`88A2Ntp:x}*𠠯- p؇tEpNةz۶h.\0uB9l[+<ضVx.wz/O#Be8ѯ6iܿO߼ez}ZKy9}-sts,x-~>IYe?h]h uj1eNVB'd(ztVDJTwL|,IjbDG`KmTuz'6<$` 6HSgu@J :W>YF}7Fhq¾@e?7L(wafukSdS3Ay'tKyA{Bd4WSPy>Wӂ%`P+fr)9yh}"9|G3#Ao@)}yO  {^67͕==dcu{ғcrZ[f :t*%AŬ!`+eiʣ,1$8dU,|yNKkb' H'V1)j+?myy5Dt^Xʧ! O ?q7=6ZzIjAF0y07WvMXYFÆ~Pm'ZJ y:S73d]u-8Cз" +؇hpxֳ&Ԕ屄tm$Jy-ٗ y yOZ +և~7=d롣7Y3f͸Ng\$6=[& eCAw>WoG3tJ]г&L %}T)Q2F:fjG"$.1KiDR8١ylIGc-ɳ9 қ s\AWbp +և@>^ѬkXs&չFqU~)!!(-U$ Anmn/6E4CUYul/{kXxsaK]ɊH:z+!{cjAU.S zzA1Nة*Eu"Of?W/O 8'.tkm}Ncb%Ki~Z˼FȊZAO6V^Ӈ0CֽdB'P5/3tSxD5m)M9In=[&e7r:%Oa3B% #P jNyV'DȫdvU$B"\F9]Sniqr E ]SJBf-:w;J]VL ƀ6y<_]WYҙ=e*ۜGHSaj@bZA7V^ӇR6A`[Ae~C7~{/ C'HЍtkslٹU~tG*M=8%)RZ[%b̚no4K+T/L䲫Cݿg;;-n^E04s1 I4FV- +)BJ6qPd@/U:۟ЙogǻsvCp}ٙ־oO)Rf)&i4)B26z>:PЯ : Ye[ͪ ]5 /#q1+q-w߬;xg\^˴x&W OQ:|!0 ˤzP9M] rD[j@HK#tzvѡaQ@an祻ٔ9 ?ӏ+*9}vRLL)hSI x(g~b/ p9;$.ЁR>NSinֿрlU12t@$7d|HM7d˺=}oĠM]M!of&[j@HHK3e-IifS&$Ge8uKCѨ6 kܨ|(ߤʵ9{ݑY{6S (H.Mj9-E3-bVKBҼ.Ctu0a6 Y8 +YZq(N=E>O 2ϲZUHޗ$Ёn=E跋1!:|`@ƒPTgz.!0ܩIKuJ]T<0Mt7PӏoϽ&BWBw?!oieh uWIGBSd*W (H5܎Fs~k6ڙ Byc="̦קGC\\btd6q7==JL6 MRMmPm }Ppb*[ }xN N?~11$.*y^MY}>~W]ILe _IXB9{"7Oyޮ%IЁRnzۙݶ~||U|YؗГg6<]^YbtnU0&.8{%Ń*_~һi6Y f=?tNKpJ ]T<0Mt721޿ZLt<47WD#B_I@zPiel%f)h== N@FBOgQoO-BrORR~./Ώ*|oev)mY%٢'=u:FJ3w <CsbٳԎ%;%an祻ٔ{|e_97Z} VDW;y:Pp聻f%EԊ]yѶIyڞ x,3&q+we=QepY{k-کAznYz{ЧCB_n<0$ivJ#tQv7bE;~d }59[cΰtGB?'A+4ЁR9=f!FTr*?B綃􈊥&W <Eo9%eH@OdQuTo/гM5KWuJ%tQv7]pzɁqr hK_/0ꆪ ]s!FF9BJ5z;pܶ{lUjRP;MĮkG#eF6ۚm1=r,זە cΚzm9=Pz[m@HK#􅨻ϴMLan6e!#կ}%#YȾgڧB$6]L%tT# MB,T[M$)Z9,i*l3F :?5|5;v2Za]j(`{lUҹʝrP#M}k m|-t Gx+v^q!:2^>,WWqL: $_ {= , H.TZ7ZLKj4ˁ9.*;aS2? t)1ʑ|)^3KSI=͕P/J:gX0s:[K5.[#nqde՗Y:UXW.eZTDz w쾉UkY;Mo@2Ғk+i&:2/$-Ԛ ޶O`Syy$F _駒""qO ksHr/ٵl#ŀ[ɩUl DBGE(47G" EHp揑X(@ ( zO1OW!$[~5_$ Db g)&/F!FElDQhTt`4>(W]/y.A?8~#l>6rnVUţy |Kz (?t$t[@ /0D_#RMU  @ X6"j~,!ko;]@ £@7nG${_`uq::%[#"5/\{m 1B/r Pt~!x@ #Ћ趆@ a#,7p  @ lS 6 @ |*"س"l@?ts@Ia CG ŎG Vq lX @Dͳ趶@ǝ'a=,0# aV[T4jHl.PƬl%VVbRIŭd[*~ctO߹ =L3s~UtOss>"ٰ4""F$!OOb"$<$t++KBB.["U0xжl(vr$k!)34B1!FH0~Hw/V-28.B#$Gw ƽד3CF@BG htqjoHr!F@ۇu@ ųFI\N;X B\z% #)g臉FrCGBG R W?H'msj=?O>E R}" @ #Hb6whDch$t@Ao4 @ f;p"@$p:?]"j7?uZ/:p/vٶmm$IIEY9_駚#: )1\Z,6|] ;:綕 /N ~YV[[}iQ,r;7 aeMnWӮ;l0;Gn/5V/ȢHAץɿʱ[ r9bA;z$uVYM}ʹ}P2=BOOSl`_^EH 幥ENfjM%R_ L r`0Lmٶ1:6sr SSDVI?ɟ]GvUWt%tJ|au/,tORrU۞G:HMj$ _((ΥW&œ&7OQ+ l) jIvWҏ: V!>=z鯲*JhN-vfIg:zz5 IDAT =v!c՞C,x=Dz3NtoutiJBNQ(c w3ΠJɗf4^}b i++_H' z0BoOZaksX6 ALC0 5vcse?e_3=v֥9lw_ЏI.^P:–;)^]{kaFlO!Q~WRzccBk_k-l'8j˥ʬF`r8\$2CП6=1`Ub~A9u<3b`+Q&t[ۆW+EHBu>30Kg0}[J\k˰Eeصv&R})WT#^ aMU {Bi#⣙qIċ2M}YQ_<'Sg3$2;%e][sst63ŝ$Mgg]:ӿR^8&\ȋS)VP:s!cޚC\$N?ϻ (VVT('tߛCA (XObys +Jfvԗ@ rF}DM&KX[]O@^ۘ@h^(-wkxG봠8HB/ *GZJxG3JŰA9y: ZY [cnay,CYRMQ.H}趂ڦ1W ŽX>wU.ޝ(|d}$2id a a~R pB ^#!Eּ6tjD-oFne.l 2.ue͢!-,CP@?7҆٢lN"Ã$ԧCrMb@Z+b( .VT7 ᵲ?kyb Y=KmBvAΐi!̈F~ub:]@U6Z3TGraV]ݰRu(\TAC8j&toj:#gɇH"2{t8QD *3[ՖHJG̈́6 }o|JYSxy kfj=մ׮~LUtn ٸ1nJ.+`S _b웧Amٮ}ȟG'-NP:6CF=3"6L;.I~.%Zyoi1m:u}&B'9vr+-",T::)ѓ[wAnUnƋH'_]fi64]dH '0ԋ&:rjv;4P^( 6_oXRBIDž:Gd;Aү3Smc:h2d sr9b꡿"M(wWKw/BpBBoc2v=f R3o*`npk[oCWLt:l `>n6[i2y!]m4?M0I!@d9,Hx_kQj&:K&\#_4sCZ)dPDkv6Jgp>t/T =?}j^ t^ds Ø&/*HNAûh4T BY>Ba H[>j@ii/#®eu2Gf+-Ge)HC#|R#r%&\I%'FnS%-rS(jSϜ:V֮t:t#$_C(Nz=j^ t^ds&*CC57M^$/mSPNa"7,78@Ee5خL.WC,jzArj]P٣)~@_p5!Bsce N FxAW'OWưnlxd1>W.3jedLf rcnЛ+>}}꠶u BEA{N1GlRm}r_/ЛD-FSYm5s 5%kHPU\|J!lPVwcFT٣\z,scә&ӫk8qJ > r7J>AGst%;C/b c꠶u B7H]z|w6VB D8F9Lpb ZŠB ^JCUC"RDŠI[%ڪ⭴yCI?zr{۽3wfv-ܛ!(AgY~iwmjA/5T:AߢRㄌf[8EIkyAD3JQW22FFDˏ']fC6z~t&4^>TQc bM|Xu"DTl7|Sn7sJVAIГSWj^;l!޴ 14>,Wus?ɹwmuK z Sl qԝOs)WBCDs9ϛ%x`9̞Lծ_P9@ *aeE?L|]ci 1ʯA.6b~\ T*Rw8b jz3;n_t AO[xEY (fmHJ|<VmΏkn%Fy|xIzA$U.Hu;i rBS4Eڷɹsjb'Mף.s SwԾ.xAX͜GKhߡݜ_o,[:K&wctzh&rfvNM=ſ\l8Wۇ̺"v 2ܛ!56Pq|prSSZ hB8 NzmLL^F%Ǐ&B5Ƹ/Z4՚mWVʼD8Znk:šgՁoGG4B(4&ugs%) ibJMJEkG?.eӛ9%rs}ښ{q}ȭN"]vuwַBf{zBt{ X|~ mQ鬪㲠VWw<#ԠnE O'ɩ1mETkIlPOH\}>;nR*|9kC2CS=ngc&A.zz!Nf+ m҆PklN[s^!V->KC_Y׏{[gi3m]p?ͣDŽEu^"Ъ!4E#*q}te^Q~.4wwwYsЉ[s #F k*BЅ1i;z!ϑdLIQlI*ɱJzh+v6N/[GDYOleu4AҴMw6^c!詴({J'92ᝈ]."o`C7E- f-JC+Ĭa3x+BT)ė'zhc[E饂e, ,ݜ)VTN&k6&VW-!9SUBMf!Q1O=>N/NOTZ]Άi.mUPCq6uhnu{{-ic6)mB),VTL}Vʚw6=wXMJ8Xڢ>-&P-Q~rp-AlQBb%r*woU$̍/uW%sLfR"9tj 镤={lL_tǂ~(ǧRMtG^Gtj!26^cC)[Wc_Ln8`00m|!~b}WBA?Imm~gm>Y2[6phTba` rAvck-Hg'J'@г)Yol,;xo>Q lڦ^=g1x1ۖD"C j Ƀֽ۬N^Y1qxI>eyO/VC'v_Aq!- `,98t\ǃ?ۼ( fµ ;؟^s 1 =aЀ8tgq/2 *wF@;B#'tox?,#}te`6AokCЁ%͒\w8E q@AG:l8߽J^8t:abܰ߬me߇'BгЀ8t8tuJAtA 45? #x7)# h4Ԕt J3* , h <|7ŲQ1p00AC.oHtif!Y`e @XÞ&kc7p ABM GjQ{Ma#xM0W#l 0nHtqf!.xH e &>EЁ#>ԄUkj3epQ^8!k_^{F=l;Ѐ8t8tX` l > pLfE'e`6Aoñ?8t`Ƀ އ@A8t@~s/${J}^8t:a7C}N[gPġġ{ϝ/䓠*7Bʽ> h*w9CAo%$$AX"BZϛ|VbApi}cjMW#2c0qBDu=CiqaY-G瑃[ydj)+c髻U5ECcw#;9ɞPx4>)$`^BR3lA"0Zq}~bg&)y,]Z/S't y+213{-<5CWS##)R-~O1 zsbWV䅠?AF}EZv dZ͙IJٖ '0rYhu#+ N .1Rtp!_>No_HtOtMxwlx:PڈecPd-Jcǡ ]}^b.gĻU^**D#!=N?r5wFCERrEa/XU%e_%B%>RSvSyy}i th ȇQ f?L_Q~=-V3~LcTj7\R 19j:sX {rFwVqE\K~B4JyS5]P1FBQ/tfP"s {B /^zwQx , k< RRрZx[FOzJtbĨ+;ҬeGG}֘;Е11J%X"1 6A:9^f D}$ԆIQ޳:yMsx+F(I`/Tˑt2@WgB-X@"~gA&8j(h3Jc)-68 PDwZR5.!X[l}K>BB]Eit TL]ؽ39 ]om;@_}Sq zr57$[Q-ZFDM )̤XvO-9@Om{]5z$jMm` q<@}0M*m?LgJׯ\n9%?Qy&O_v(-$or©yk2(d!+*JrbrW 2~e /9 =Qi//h21""ߵ91K+Xd +KY؎!vGR{JdAѽk`-#N\C햇B5Afz!˿zH>To2ݴ[8hKHcI%+Mۗ'Y;krj/Ch$o]8[^qGݷtƮM +ĻD)CqMdlLg^cqz@ =  5;@>`tsrpƁ鹭x0]x!c׉H9D9ߥMc~DBOkR0i>p8z/Я׃ۙ @h$o8[^q;gK0[QP1C(ք8X|m=X ;r~bH=;+Nt:СfY۔A2˂ZS ،[ق,ވGYD0@BKzXkC>NzkS9l$yѰ2 Y{څj)Au5<]S];摂UƞxoѶQ$0AU1z:HhE!Ng$|6T/PmV@IV8.iD8G@h$o^8-Z./o3@?E!nL 䘶_藌>u`k3Ӷ_#:j6Y8`? IDAT#g:mCgg g!총2r oa^1<ơ[ E<[vKR]0e]a~ϸWz&({  3;"m0`JC+UuQNc8桗*#;i:%v[jVl7՟xi5h tZ+KjGYo[F<}zRjC!:Сf t%_eڹD_̟A@:~Lvw +͏Inqǣo"J?[<VWG~F Eֻڢa U=ijУߣt$ldép}8YkǾ]|âGZJPPm$n#l tޣ'+PcF>VJYOq#1nE X@_&m$x:v0iWPP.:v]n2f6'*>t絓lc)^2ĺ 9M}W zUfnĭ=RjvCG/AdzB8]C5ש)mM!tO?T)\rÃo}`szޭbF} J@/S(K5R0_@w(-Jwݯ9Ub7שnބ%:9 mΓs1̞=R&J5;z]$; Cǟ]S#nEw6fq? dc"u㦢=8Hh:μy$:lqݛHkXYzgtvg!'TH|.w{[\l0@v@?+xRI}t"a-ye ީ>ct849FkP

ǹPЇއﷳ[R] _M{@y 血NeU'!J:O(,.Oh լA yՎ D}XXJ[!hUOxpbu+k|ȦAy[ %JEZXpX-UTlXȯ{%n#EEH_ǶK@SRsF'XϷmݶy#yW$JqO2Fc16 u$ zk AϨk z6Yjɜ[~ &کz軂HIMK]T9K\F'xRM#wV+^XHoGH* mLYZG LϽW=27iߪDH:7Z p؇NA/,)yIqw{IIIH(\5pSF{:c{CsW㑖mɝ{N$1>o? Wmkmk|ōзD#˕+ѳxw`G#m tn{,Gl[t:RYfHBk5A}= p؇D. @s3VDܕ;h*?卆5޶}FY;2\ p]F[0ffoZ<C?UfW&UڃF'IMʆ}=,m`:r{ҾE CW7`v+Wót:6tm>`5gVtɰFtp:"&==#ۘ A^sم%][xa`ȗݺg:tfV=XA7y3gCm`ۚ\P}[k84kX V) `mHCm^~A۰xOwF]\([,r y mkۺ(q>Ykv?'b~ozt-m[?Ar`3K03l~L{ȶU+ AR6\$[~v>/̴a6ykXWI2'H$/DGϗK ͝lS%lلSIV/*IhRAsKA\Ih2q Iږm2*m$&7ytto9 AFTet,.J}XT+nTRl\-Nۇ~V|ܼa&!D-XO?њr :Ӥtͪ`PJSj<ײ#J?(bJSv]GQl NљlI M fȾ=#q+`7vgnIw 5ŶU]5'z<8BgE/cqQR+/[+nXRl\lmm I٫N'ɓI_TG)/ٯ^fz# L7x *oTo7rqZ1=e3L礙4M$ &K.^c QR,CIJ NF%ō!}X%__>>xަ&tI5w&_xFL)+h\vBh ^I7ct&5H+i8&S#da.NעxYNͲI-!ՁqgnI7Wd=->jϬ.J]ZōJnSa xa=8'%LIj,0NBtQR(X*nTRvA~J<=)5[5WN:*QtR:'l*SӼiwY/v*:x J&y8>eB 7IDb<0^&B* E/1] 88&%(;0&eÿD{z>k THOwٲZ8|h" ˸\׫ߡK/#GoYw*qc]tB*.]YwTp iQ viKqX:izOB\>pd&MyQ˕D{Viv@c]semEoA"%8&+21,9A_rz(! [ۯfPtmH\b z>ԗ/79#iCГF6 YdOLn}[o6e_:Y5A=kh{ߛQRR:IzXP'HضMu B\>p̠T J%mT8߉ лIG4nR[ lWؚ{ sNv#L{5SoӦeAb*)9u)w0FTgIuu6]lڶB*[|(/荈6߾`ʹ s6AG8Il_4sd0mtt|N3$oQ=O># @c$"%8&+21;A[2_g\w9JЯiuC5틻,SГZUYAǜsFe=}kFXg s?8+hƍ{4vEJ/-*vC߭=~utl+d撆c27$MמҿXB IA3i\`lZp6kGrQgt瘝,ۯk7{r-%r9͐WU{)-&C?Oj/< tu|A53S`*n 遌2sI1FBvQ.N vxORӛ?)`{x^tUf?A?T~#cBAB}sNѯ#%jMvT]^q9ƻDK1H_͎JK uo'QLGhAW揫2 4 !JBD횩Brct &^4J 8Jte %q3x]!^.Yx&3,:Nw"ݕƓE["؏;:/\}45N М#IDK8,=} GWgΓ3AgjMA@Gzy}y3 ݲt l}5ѿAeyFPCIMWaz{[#-Iu^N}1\LP^f?%oN8LAʐDGd f_i .ih;r]sġy:{ii9 l҂.*^B=tV%of:xOH]a)lScm0;Tƶ ;X3jK9'I*5le[қ6L W&oǖҙԱO ?xb)'J5%:  ]$CjEyUK x'Nb/Fɾ2H8:>p=urzQރ8O&-3 Ϊd%t$C+l-mm HZ'I8'CQ]} g4e=;Z9)|.U)Hz_❸/a&U\ ,ΎiTi {;_rw.zy6yAWdzu)ґtLm%07;0IUsOX[*>]sZ!JAr$8v_`M}$wu4Sm["r.?P$J뽂5Ji=/JP`ECЅߕ.X}F}7 gL ۗA/b7AЯg5KR䂾g=l~#}m` < znZ,KšJ_tAlz5J+^{czD-A.ub1i/aݦOG3܆M@s+VM/mhhxQt@3 :q|șoD l a#זA!dh mG8t kơbJ'CwbRӹOp2DzL?~-qakE@֢UF]ݴ :NJ#YMc;hX6B?YBCEښ@>E'8B ;"Ӎ 9ڗʼnۂW/>%|B_#iWEʄAo^T;zA :Fԋ*ڐ$&J*Qb|4AG81HMhoUiet ntxТMGD."'z\BT)Xk\K)r'| y ^ȷF鰹 jρ&w1BT˩Я1r즖~YS5IKڐmI ;􀦑^MGk x1t[`o!Z/'@--U7sЈq/;ͯw)IRFpܜ?}XCw7J-f6&5 *_=!Qa{ʋ7u mM޴#3 fHk;" 6DRmCUa>$_jxg{E>UoOvΫ)Rph1Sk8,O%ꮸ] Fش~-n&Pd`WDŹ lq}H)6rPlB|O+:B ilêV-ALH[HcFUBuM7IL}<oǃlm ,,JAqw;r='{\BU)85\/~,;~3ތ5;kGh]cII[W=# _#&ػMB*RR'V6Э,:fKGc=Ki]ceX•z#.==z }9K#{T؂Jg#*j`vBg&7e-[?tk`x"M#):*^^7R x~rz6ni\D7dY =&?shik7;rP4=[J%t4iYXIQvY}={mAg6=mraJ9>g]$$3uO]ǰr)bA?'Ք̋|m}5%E A' z&AFUܭޣ<$q0HLa%?hd|!KE%VIK tb҅aۂNǖP<dK?3л̻@=]ۭ֯YГsGrWS.}B' ڇ]=3NVuDg>\G~'=mgl.c֞5G3:Za[j6ئ-Թ ؜z_X[ޥsjeq4rd}_ `Pٗ!5Z&ALJB N΢?BY__=ݸn)Ū`|1>vV `(Hm7si惺' 属wP;|MAqz-lIp>!z]{G ;~2f :xH|FA@&KM7ָLwU42fojUkɟiK(dpe퓽~5|\MbS- 4 |wʤFvx͑Hdk*ARt᰾8ʄb+Y6&?N +:GNC[\+6"-N7TЗ=(Ylu=h},! $EK:r'+"=mg W|Fp)71TՍ9txrek@Yem(jb /U(Sg%%r*Rlok˄ԃ5Yh^RTϊ2׍NO4wɓ&deP[YKQ[M~NfC`T֞CKƀh J\0 }9{ƺ^O,k^h |GY*1R0\Ү=3ڠ-CJ\2, رTzDzX>})wa ŧd$hyLym|#X2lU9lX>&ԇÖSűKqϱ&MaA\j_ݠ6\_7/f/Ѧm,P35+A.rMv.&yttK.G Y{v z8t3kd#m} :%ZO(ɮ-[dԤSe'ڈd]C}w>&./.>6v*g& 7oՒv+4AtA݇~F7~ A`=5UhABk5XU :dG#K(t;VV폇( ͞} / l l-\nxP}۶k:W4V\êKh|]:F(L,溾@abXhFD8}%u~QNO>? C -)74G/G b`Ar`̷][/A53Aa4h,)EF}ndic46Ytdvҷh)_S^h ukT(h)'2@݋U,R1_~;`TNl '۬VA\\R p*5 zLI04Xfv9<GNNtoy,go{S?EIEQ53\UIq,@ aWČ^?#sTAn&}mpkӸ'V}2Gsk @Atzgz81ӭ*JOFUjwfi~@~`pp0!/"?7kmns=B Ch f8do-׍_# ؏sWi< ǴUAn\1@Cf>!tC<_G襏rYeqKUw~Mt륊?&p#HZ;Ǒ_n\3 !ė귞֑ cqILdūe*F*ⴛ7 =ar0yQh֯Cwd25Wл=`1z5hմ]*ϭ*Tf IDAT\?ZRZFܳ 9 j+5L=<,+JUU7PQ1x]3=${zfƺ; Lº55侏 bs!8ɇo@43Tb_7nY_ @Iߊ@ϰ: ndɎIzo 6*1X~ !Jghw=`1z{ c+h̕#鰼r:]M3dhCu%$c8)m6OS3t>djCGq2͊awv^H,y1PuA>3 a:~PMBʪym$ɒN1 @)]pyBd.a|7*}R8ncvvGmyQKPa~Iv/JL@S ޵k. =Êc4#j~BqrAn/3J9څs6=0l 2\y1TS8 Œg (Auc+JV@'qK+NPu+ŚEbȆ,@~*@A +Е]D%KI#i״V^|Og} ыyh#f4}BIzR[&.=@ߠ>Ø$0߻zFUCX Q?XUoC+PK-"ͩ$aWbV/PݎiΡYۣJ PVy*?9%,EB; 2@/͜]nTqZUsf6MWb(:u6k{5Qѣ! JJ(> tmnrBDx8 iuaÇԖa@Wֳ1n*.䊊cbL$ ;Ze^ l -l.lշtK&]nTa1$)N⊥cBfi*Ev}$NKzI[a N];KL÷BgK_x=5JP!08G4S󰅡ii][15գ4Py)s!nc]j1zJoYϋ 4!Wk]wC]hU^ k` *bS3p47W#W7Q[=;2m%|NݘH+1h;M"j4/*tGv>696H#vwyfK5d/Jfq{NB"@_9r}'KDʏ*_#Tݱ Gj'aCXnL ߀Rŋ":[ |nFu}6 w.[r? ;<=ӑj^~Jv|Jjժ큮GirJךQ̵'sXN!sv~ͭ SP!;B  D_Λ.>7Ly*.I7"j@`=݁U}F~1q7 o/&K5d/J?ld5b6Txv(I!(n|҈U'Gi1@`&EՠxB,@w{KɄ5b놀* dCE @w/3ck<03twzb1z3x:J^%ٳR.Cg8vm$%i7PoDs{>H.z&C7A>~  ʦo%)"zÏd*֭SY#oC٦߸B/Un qiU*CmIȠ#]rz7 |` q[@w=t;1|Є1zM=,O'ء\Rݛ~E YԳFhP!W̓+)2'P٨+'7ҍܣE|S @[F=NNGZ.q %QOwĝKyngt oAlgfp@Ͽ{tC(ct= IUqG'a~<)إ9r%gq0[l_,܇@ r4Ɏp˜@.r(Fjn$e>;اUbnyNeXLK_We^1SCn7^ @/?{gy4վ4KjG|D2޺15W1Jp!\Bh @h!h SPeD4=;3{xs|?>y)=~yՂ<}l%mSȒăH9{ՄK[6wfDr^Sp"2䗙' E<~Vz OmukRn8\514dd'm DJѡkQE)F>YAEL(0jY(/dE}E ßٱ+./ȡ/$닔% )oo/ -]:[`I[~-GDrtp"蚒la"_ D+TM9}hA(Xd_H &:} vgYStnԍR3U 7M%pݜDA^Nq h̩4 gx K>WYͭ{Ͻ'J9Q9 :Wp8 <Ҧ`\A<[A3v틓ݧ,܈8JtVU+S%>7uͲ#j4t V󎲤9B=!e7Nl*w z'Ӯ:S(@} k.蝇P=;\ _sA7P-]OtW%7f}W^;imm+lֶE3t?CR_v al5A﹍# pOF}ՅԄUp[<>[BhhwCmvQƝy3 xF ='-y6y燱: m pyer8kmpA,k.,m r߅s{qht?B:Ƚm[[\%i}oQ?KyI;AAshQ ȆΛРS _y ZS/<{Ҷi%!k$˱vjYAx{%ñچp6[K%2F-=4~A=Wu)ϋ s:׽Z❖vRG\{S}O^TNO["uJJr1r+zl7] _\A^j爾k!GSèj`B 8+Iҧ] UvIm[qm^HW%,bCݤx^LH5ĘMesU=N%#Gˈ[N~82B#DN?~̶͸>0ꅔDY0|ty1!cZ{v]GtvbB${@ H<(Luѽ>eXZz>[-Z[O@`]=^wRU(FHM9B6N&Mhm3!i|MD`G;|0'&$lWmdXPVfz2޹^I-4vA>c eOЍ"G͊ĄTCiuS"Mmf,l8*n~܉[A_V mml]|ee /7fxZqBCA?Tz1.̙SJ!s|q)(ymCAOh;,n^Ґ,aBj5~Xj퓸I_ajܽ<2Kޣ ˤ C7腉DTHt1!c^{}:sAl7 6u75ro41-*l,giW$AP,.gWݩ$׌ YD.\SaAFy--Op e|˛#lsԸNGg|05StU h8 WGJkʈϮd_h5 v4<"Nu ղ؎߯vyRՖ!+y"]>1pccTM12*NjDCiʢFVJ)uB TԪU"[%R_* )4} ٝ=;{w/r$ϝs~3g9S.^>х)<xlZ j[oxK& =?Bx8X {riBw&FzzZ'&!Oim6>Iƽ:Їo2?_ZP'3熁csCӄ='˱1]Ag& +g(!z e?\0B_:_OBq[} B/g]["VlWB?2rnH vco0Ź+pt=]=~<^DwYд` /e/'ZxXxф6TN~\re_gB覵„ <6GS=mZWQUշUqW8JulfzY: h,.bQ{36}^ }q O.=#q99*m!O)( ws,) qi}9Z hZC4t };aqXKy8CR2>l+#j. 3=xj21>;ӮuEG?Ryh#oIٷ+x nN}<ABo \pzZ IjEL BM}d,0iDԴCDz Z.=˗/$itq`z?PM+z.0`#| <$<< ݩ0F4؂xj21>ӡu~FHU/E~ߢ;iyOyB+&t7;1. rOj~FhH 9+k}t KYZKv.BsƓGeXKe@ӊ J$qsY wIB';вq^X/ X&eb*SĄ%'e~+8O?oF4ыb^[H~:#1KP]P#WShU FyDsc :B xf oF4)2JBES-410;}L1`8Źh< hZ 鞵y%D{Z>}0^q#Zh+n:&F$VO@*3B',iY.=z6WvA܉IRK303+֝.[/sNt ~$$\'t~kyZ)31jk@~nfniJ.V?#iAӂ(2_OOCL!<}Rܶ&=r5 lo#'uQ$ \nlp[hV"b]v%hW}]z5";I2B'Yz"rߧ0#̙1jze;8]׎xpM\YFޜ IDATuuu ct,+$СЇr.%D pϧ{R܇.SN)/{&F RPĄ~*Ы<:b]r;Iv-뼍<}'QZOM.P*g,̲rZ57`QI^ in*u՟#KF>,oB/ɲF#hF(:-I|^LJc q#eCe3'/B6B'6_OwBJAYJh<{}AC&&zw*uyz>'2zfOb3kc+"YlӎzGΓ -<=HʓId6lTIMʦX}֚Y9P6fIyIuܥ~a}d $Uiml%ش=H5@2MA^ vgpз҂e|Ƶw![A9T;9I6uӂA.q5^k$t{RfV\jߧZ&EOՠX_xԮ1B ͈f,u~ =R{`̕0~7Je2װ_}} q ƳFjB.BOZ)&#/'Zđ7DZ(t7x[0E!01bBw(ua\ZjI΍7}3$;&tU;MFHzPtGviaNS;p۔LdcK>S/B#kcMn1ء%vt֥U~ɮ յM=j[$#>>*BGiq/'"~}*%oǂ. tx I(#^ ~I .^WL|JG/Z*!QSAE62=j8$JD >oDt|6%Fп݊m:nWDZQ'_1S]g߾aj"mDpU$tmjZ =Ԕ]=(w Jmd'#CZa8o> o'Tٲ90: I[ :y<3SF,9t:aO ;=[!Y`ԩn g`\Uy F1}G>ty6Z (Χ47 Z#y!?ÝyW<[ktb/v xGsjnw AЁPVCA9tAۧltè\s@`xN)k.+r|9B~ssϵS::]Ё}#'tgx.(ûC<['_B'@a4A߸7pAJ$#Ǐ@A2̇sm? sFz~ky@hݢQ~O/ko~T9sy%譿P(=g*bQPƌXy=_R*Q b(l~B$ -{E1"g"Gi")2j{4ńLܕ%E N'ϕhӬRՕle/ +ArP͡,!Ay #UM熡@ 9|n\D{hVer뻊r?^YoyAKfJ&BhK,cC</S]Ͱ<:ðJFʎFgJj5Oӻ.AUV{e'ܲecZ5irgJRUenZ Ӵ/t=)^`AVܹUjA N1*R00/hkEV n\Ɨ:!ĠmmmQ? } ⎡Q-4:To6#˘?`>CGKdž>˥mYi"vg9l\7Gl`7)VZ{q٫PuqfPoTj=Z~1bkJC &N"2u@SD1m}k(F\tkHj>pNh.M) //#⚢,vg />jW&O z"w}\g:CV0I ZA5d_ѥ]bMj啬hjIqCuQĪ}-lrojq6d+{=Yr_`yuDiuތs쮪>IIA0%yQ5`Nh.-) wWOnҧ(O:}ȱmcO zQOhJQU'!i JRП0W75ԃFĞwaނa%1o6o4~j)n8Hd+{=YrLdm;H^N3zӲ^aΝl΃U kǿ!j6 "AwI^h ЭK AJ=Oϡ̑a̳}~}^]~1-"QhcXz%)R͗_6͉Rع޴J|bH_YnnV;#?l IŻ5$'~ʗYȕd[NM\b ;=t3Mq  x%E @ݒ5ZtB0q_ ggO:SڮO KV~;?S{J{ <* !N%L`;6)%vh Lv){/TVQAʱlI@BtmЭK AJO(bors@B#y*~F: zd_c\h/*PY5oc'cMMg ըA|b1ˤ1W/4g:hϨr<xtrDe _BuYJ\ƻ'n:3 YݎңFx2NKIZ# wXJ᜕چ63כAzgܷcr4vbtmЭK AJ)|JSAl23ݨ`/7j//fw1 wj}3uQDThC ZAz5S/))xZ0$oY[ ۥN7ll`yo2"-Sd 螣[/&yhF2Qt8}+FӢdi6nuӲZ ǧnn19)Y~7DY%1O͉?A߮~ve4u?Q8yW5]%/橸PE).w=l|3}D۪_%sVaX_`Ug1=M۲6<EV4DQP\(D$W73CWx cQ>B}>YKėY~>kV!Z¹  i PZt9N by-?ݻWX~1ln:\j5F]y.UUf6{8dtVK҂/*kKfq8f ]`s]YXe0-yq5Oł.JI7A߸UQ^NwR8{ޠ/M3wBjUIZKCTլm 7YgOm⑋Z4Auћ?{uaܽ3^" ;2`ف@n$ `"B%&RFQS"NՈ|J*C?yޝ9sޝϜl3>{9~U|5rJҼ8uLNY״Vz>wQMͯVg5 Jg!/SQJ|W^,''=Wt'<%XƬښjm86(M~í(ۥ^,hzc|P$LH`#Y\ťgɝCS81.\&t@$<`Gڟf)\,R+wY 3Ka8k6w[.o);܅(ù\MIu>=թNnSIJP,}e`=Wk(}N"6Liuˀ0c&f]_1:)OF<+[fj=+2/ݏI}T Cr{:04E@B0IAB$ń~xļ"'7ekzV-HoRl h7Yz'Xn#E@аcyQpZپzmZ}l6饢o ٢&{*XZwyB/ACHQ76pa C.EVew﹑mfWrC!C\q)3C"bVPK|kr/ F2mm tx``bB?%O>}V~r_ 8}@GPE5|"ә^f^+A+8o3LMzM/Ja]m' ,R ]-;?0d(rz7< txht Hg۟:X"B(ϒA2mWhfΗힾ}XA bFzz˳h~*#Q6gfo&j5IѾ-d; oaim F93V +/ljyv$p_YњQk( * TR%+t -܊6hhh '`] 湩5D$XxG%=:~19H@UA5uAW혘UD5vQɒĝj=n<[}X=G^ѰZ{ݡD,ü=;*GB/Om|ֺbzvi`>4D"aZCHfŌ3wWffֶ2Q3MMP "&m׳OП3.KJ#Mq8VZ9BG6E?~Hoe׫k v=nw&k L0*ßp9uTPwyS+4VK5ӖdQLs e :Z!IMs3j-& T<@Q%,cTF9;dg*HUȚtM PkY&tC8 3Y$>'3.ސⰣUZJ͌U2@$43' P|)*#} :@A,v4683ׇM9W_f\=τ̬~yݬ +!ګ;LjDVGQ ϛ*4j(3JH2;# FV5ޕmb~uޝ>o .BՍO |~ч@( ´niznL #:TM;'74ED"0u Hnj+?@Br:kqwb>¸M+"jSnlVEKI${ƭ+Ww~bͶ fn鳲ܘAݝύ#ÍHܲRn1 ]M c[|6)Y]M;WXeuIDJ4S)Cl&m^u??GBTެa/濇- -ޕ-xKM"$t5X%(ޥ?KvFؐ.[׮GvTsq zIs"44'EanW\  Ka$ȇi W*m%GuzXP8t/B%ń¹C 'V $tzifI [CxR;?>Rc7 >K"#˜X@ J&zgI$tgh(.bؚ>%wHG"н%tRڣw$ل!<àp%:ơ#=j= 5&?E  []Z@C =rZ *mok A $t<?C=DBG Ĭp #S!"<@B޺u-!#DKY` 0WTI\FCeT-"48!N(5nc'rٳ_-`qOr D/w+tB0?@ |kaYΔj.F':@ f ;6B"`8M$;N\C `a7xu] IDAT , p'JoPK2 !iwg~>K5*MbZm0lE\ 2dMȊeJ(1Z(X .**U&yP /}R&z7ggvǻ3}9s|g}9st-Q5#Pj<I(1"ѳ :7PDYca;$x$@ `I@#Dc !O?=@ * !³Oq@:HI@#rƒ﫤}{k_`$/^?зD1n[+=pZ4Y%>C?'CGAG(-}rG e'R_5QxV%?8uͷcCttQ I6AWYQi} ۷c;4"|CG eOۯpUjT> Q5x|$σO/7>t_@ pz!2G׫jn}_|ЉO*eh@ Z$QQ/~hPlZBnzk9DHRt>%|4@ݎ}ڿ+bd"D}kD" Ydo:?3(,*&Y|(}.n)8<Jpa6rg%+gZd&fK xgaҹ@n(p7Rr'V&kx_ A z<ܼmxvƹVw<D~R86Ec!ENR.<'!1o3AøU>wr>Cx݃͘#FJ-%:2̐eafu+r]HLM=Be cλhK@QY>4j EChX{cɢע8/R"sty);tƭN,_~R^?FnAgR'R&-W[h+E3qGANOZԣVBh+39ѡxM=2NBezܤMQY>$Py>7\ zU7r]==ޣrnE4[;tơV'ܶVCǵ:Zo "X+IuEHmv2.Fg, !͂ J]^fڧ͖ƷO9}{9ߐFNNҞuqH]# 7b~,Ad2MSpQ1Y> Ϸ^-,~W΂~"OKR; YSn]d.rG9މ6:t V2j^ګfj[|uZQvvrpq,ٵ lԋꓼzb|zߐ=ѓSХm..lO!tВAR2֨YWz'`YAd$Խ0̈́l)**V>.gAclq=r_QA^TyO:gC.2o kPCAmR"w4O-k"D3ĞSIo_A5Lzioif"dZ4B{VP%7hf A?HI}5k[6D觙s h7- v,FzUg$n:ÒnL8G>P\NꌟE pE:4s((pؼKE=(B`䦢D 8tơVWׂ*Sʖ8IlˈazmtH%+kF)+[XW/nJk}t`~ŀɲ }: Q%c̃!>pMFEq3_Qq^/E{W3A*uQ#S򔝞 M d&LZXП-~Z.޶G}#{iR֞RA(i­>V )>=e22V랊VJᮇŬKAK?9dҸh-!1gc >Aߡቀd̟Y E{W{"Y<|Xד;ϰ.,B9g.tJAK< M@{B k,@AYxhLa}=˛3s~*.`h5k8hZP-IFZL&A?7my[l\BIzG'ι=ORdNLD@2%RFM՞z,Jo|_*uxޢ \es=L@S&SAwk])QB~k͵-W8z8K.#-T4j"X>sx9.]ښi"L K"G>B2D 2.DR$SpQ)Xs'n1c8퍛ϧ5: v)z-mm#'wDQpC<Z#Awk<A`߃qĎP9FOTsk/0Ejeq"cWGdaxϰ0=Xa7]%{2/qdUcpQ X4ajO3Py[`oeCwe됳sp.2D.8t+2˽KPeJ% |qT}Uȟ[kLtA wLͼr## Ƴo#p`A zWӒLo2% cgM)iC&ቀdq?pR͌b6=t3@a.?-l_DA//߫__4\ Mм5rOK$\OЫqz${\{IKt:W0 z3VAoCjFV4^KsOKm!d:sE7osЗoVRC"s=<0 :~S/ڥ&EEgjO{lǯE޹JWw.586WM@%)5G@qk95Hcbc'@Ul1h"5H4m*Tjۛ]|?yfv7oLV)F{ /gqIW ŝ8ڦvLR]/ĞysD 7ws%AO@ÆW{#u=? ٥$TB[r_RU$d=K#nJWdže0_ 6Um s[ *C5`O>k+AijC=ΔS TY5T;,CKSŪ5>|#(|bϝj1^hgUÈڨ,," 8NP.lg^_>1ʕOkzA+z'%*A-10HM\y]oSm aQ1STHJ}؊6!3=>y>nV3U$g"^Ǚ|bMRГK<%Ah?A`P{[q9K?e9KIhb$3fRfѸmRܱ9CpeR zn;GMRП _Eǣɱo&p•O[$O| zFeqp-#?tC]H순pAt :vgas0@Tv",i1zu,x` vg/9_[h/\AOe=#p[3۹9M'~:߄:rؚs 0.rr9kk-C:p| xKhYӀ:cF}8)w@8%~[~6Ol^4l>Lx`1ؠ gGUt~LдwLnnGr ^!-sܰA~y\b(o6:`6pMnUs4aiǙ>yv?I6ma@ `X68 nh3*y˖f4-8b?@A#m#U&,47vYw>aBEk{;=9v0CCsJ_KLVGgCN 8I_eݢm$1AAw7GjILO6cg!y#OSydNr: lj}3=~n)~i﯂ ϊ`A"q#4ܜ 54:pdXOai!o8[c٢ ifm9 nkq|5 Ҕ{赵hZz6RmU{ wcyVZ#:$9˲h4Β:3"z{,[u E=N mpCzԵ7:PЇa-a|d߮9~RyNl\T? @F,p@^fwERgt 1JN=b rqik`,p}ڥWm0Czx;J#N& !Y#JiOItI볢wbQ8sGtMVmÎ!"cd{W\BJyfw׊vT{6fV-(fp`+ߍc#~[LJcF٩s;+_|]AwJ7w{=`p,vܤRh-A^q_EY},V{fip wo%*B߈ I$?DuMk,UB .|LU6'sNJt6gP##'Czx%Cc!,(QmAЅ1ަK&WZ?oj,#-V- Uʗ9۸6"3YðöC7hAA3羟1ݏ,N¢Xc:Ȟb/ceg"XF䡋"_,#rAgu wkkRشް'.g:bkGAAHҋ 4A]ł^h٣Du_v<|:߯zr\lKTЏKn.އA_~*Q=ިgf_ofå(Iv?'iy ޮ_./|Eʔ?()z:KdS{EQA覊b5TʳX7'´gBЫ7 h[En zFAtEςZfwRG|&ayjA<vsBaz*uBrV}ҷ=AĦYL</Cl hz?L$4˰74$tKaЏp2q}{9ɯ %C :Fԫk: ښPzw?QyO5Z85^Ej"Q*[$ 0"^+IoԆ(*ߚ/7vv8ˮ|gf|y߁e[ o—NU1ƦYЫ囫$ܸx=rp ^(|Bo? Q%P~-{l~2/'_*~]3ʲMy0,'23>% &^u}"Ȋc+Vp; x?'&5K >).#Vܿ\J"4DŽ|, z.!ա3= fl}?Z$&iCH|s{On(bS!=ΌHvVZ&u n ǽ|-ChWS +p=x{tq"*@)4sIZ#$UWR.Mz`R-ҘI%bɌ e>zK^fߚxDnrj{2tF'?^aA(>ւM*U=O#mBj}ƶoT>WlkB{vW:y;}Z KG船}[ظA Nкly囗DA:BĸKILCop/~G4-CRԾ"2cyOqIS3#%P̼@`)c;OC7LqOw&9Q>tqXMǝ(hA8[jrøǷaʩ8]\R+jSJ*09\_ Iԯc-f|3}Aqh}qoED3hK[VY1[zaă^Po@^WVlL)mdA7'w ++KA_&^@ܔJ~!Ɂqkis%L06j}I?h4+~b:OO_KO0W=o'>uz&Ot'v X z0Fl ^rn%6i p{]ܦNX5 D+zuԦu|;' `[c.-Ga?t-U =W;s=L zү)hCUUQF)P9.Aitqmyqd{4VinEq=uvtLFچ+YA?4S~{SqQ`OE?hQ7-EUI@ :|;'WFBHA?+n+[ܚ2Anϔ،tه9qEU6>t`[*ӏYs/ߚ;I{2jJfKF-LYȊq>G݉t=Ox58f{=s|Aɇ0:a:Uzz_*aqAL{CDi-(}N>]lv^D'.6VQn2mhqAoiooA ASm(;C3-}*̬h͈3N~7>i܀ƞ>tCmj}4ƿ)U[ `pMDC>t@ЭgvhҎ t::Xxzx'12>A?Ig8{̏JCc~*@`p74v>tVC6čJA/ͱZ#_Z9>MxSE{ފEq׋h[m-95`[)P94=Q*w"#mvtQ/g= 0Ioޞ>fق=K= o2[ӸA,V h#݀Dن>SR2،t+PCw*ǬoMΝ=r ^y%e(}qj9.~wX~~ZW3?j,7P^زUVi|Nb;`ކ=;>JX@<;jutZpy9J=f_S:O0[1 A 4A?zm𡃨L%a\[[д:pT :|NoLKst673kZ3ߝmw7 PFۆZ%MgounkUzD:C>t: )ށj}O:9D~ ИJtXt' h#݀DՐ5Mq@DC6;~ csVOӿ^;/=lўbQ=!"/ցa[ a5@ ֬g7ԥa}MDC>tAw=Ʀk"oZOo m6y\E.^Jt+% Bb6!B%.l IL Ief*exft蚬?q~`٘q1gy'RRv4MǑ;zg{~Dh0@dӷul{O%Iݜ&?hU +fz<> 䡃~D](,7з5RąBG8Εc߮]hr˗=?z èI<Y$C^+='Nmm_iN8'Mn ʕ+G,@"Cҫ@C˝_SۣT_iđ2Io)Ӆ7r/C` Ѕ=BCoJUZ wMq鄱]RI…H\Ͳ>tz?:&Jt }yߢ>]9 _u K.!?pгC|zR}D;}{{]@UJ1ô+=h#_WЗ_{>B#|G0{˘)!,n+BZ,tqӅ=^%mbqfRz-cu9#|uT[V\>Hp?>K?y17?ǟ8بTH͇y,am@)7nJ[#)5.)Umb޺iaVҼ`]E1Q~f~w<4|yrgL)X<ߜ5֤DUYy˭NoNu|^}:K)T[}rN2|cަoH( ik<ai}} #hi=sy;- ݢ%,]ZͲ8쪯-lkIzԸns2oZɋQ-Ji̸䮶֮Tɶ-)< 7 }$ w϶3)#,hKy,a By6b;F%j#bB,J$f%E`X[qO[>δkN_/d4I>淠|gN<>CSRv4MǑ;clB8O,Z5o? t1-XЭ{' 7 denIKhH,5:n7e~EM^]QkK|Gֲdӷul{O% C3d{Ѕu%nC,od1B Bz<>B!Y"5j !˸) CD仛?uNmKMV t070BE2QHrК%Hb=ƍ#tkg[A:ڶfu`>)B| ;S#>YMB:  Bg;\d2B!b\(t* \IgOMByRVW֞Lv[+#W!tZB1j?Ϧ/O->v*{2cz֠=M6NA^]*1л,XPy"]{‰sU/-Tmjw=abxCY1CNz^'* kYC'7[z?EqqAЈDF0~9F/Q3FmJw&,TTz\F6SP%#8YFHE!vP'Gѻ[;{ <}>˾{>![=#ZUx"z:J8| 7/3{-cݩi ͝#]櫿)iйhe|FDGlN]>O:˯TqhoAz9 TH.{p7 T^k a9:+}[+ؔH_}wFR^l\,)isXQ䴱?2A'sAzP$FRݟ<={ckX/r57\3{V>uO:cǾ%6C/S53tGR rPﳇKc)MH[rShc)ie;C:BO2u&;L~8>u3t)U#uVrr\~rJӱ~Ƽ)i;`61mRSf)iU$*$B>}w=>g>b'2~fdY ]MBw3+^DڣݑROr%ciBו&t4Gm>+~L$t;Ʌ UvBw K)B/>Ӗ3i.1HJJ!t}BwW'NfpN,,i Щ\1}T{ra`c` =lcvfOX23T\5NgxB(=UK*l{bڪY] t07+%Sq4mf&:VnB?=I=.aR_a ϷdN9£j䴕Dbӂ>=ܢjGKy^AO.I zVT+PC36zTb u݋) 1ۍB`xlG.)Ma4@ I3 i9Þ#to+cn)䋹cG}pshM9C\S]0f1gyB>XM'zK©iϊbqZ4 d:$PV֦1[-񨯳 {kf3 }JR.  U{}j=6{{dd`? -f0ḡLCNGHֆZԡ':t@{ tB@`hc|DG0m|=i}U /ey Ͽ>G} Q0,ɜu$ϡc?s?I:c^:]Auf,{",wApչ hͼ[,6+`B_X׉^x;h>!*id>Ѿ9ڇ߸fu\en-."zGxJԫ*A@˛xk5kk޳_?[~!h\FOZPL5Q;uD6_#ZD枟jlGVjUD2WQ3#`BO9lւl-e|;D/hlD_(GbLlFu~Ac7.U1?CxZ+:d,X.ͳ׵fu.(SҪ-D+uSbT hYյir"ui#s>g>b,'zKcG7U' 8KRbT >~aQ4ϊf}/ 6%Z# 1* te]9xџP) }b c9Za-,L9UUkUgle :π5T\5NgRlVYq6nN|h1{kVB0j*M(tԡ[W}zιE GPM^٘_-YDO5.N}hB0s֡ ݊41^e?5,d|̘灜LzB mE iUZN r.\HAz2C_'*iUzSYc ]S':(t`3Їzf B9\G|es!LCyCKw6,b.wʊioblOD2yQ:/WD:`AF􆲽1jKq5CS3W"Ȩ VZv?[ fu_s%QF_*T-\ކ/R UGTo6E&/"Z{Y2Ѽ;;K@(0,DŽBGU)Måo_x,4}(cYDNhl"ڵ*AlM{fpx_0s֡Cn|솨hq7ٜ\,,_ JQ;eb ]=N[RkEP~CqT{K#y٫w/h| B3 @P DzN;`N{'B^]-JnPЁp2]##X6j|PRBn9[ R$FRVcO7e4fz)蟡{BEn HɌ􆁱~Yp =ro3Dp(>LtBЍ9}؋ɼH.toC Fܠ:G/,m?Ħ-#v'f:nSC ;ǀ)F)l<[5t{ 1vy yCB:X4DotjQIEA'@`Uwt`؉RnЁh]$k|I_qaA06ă !m pik♠y4ϡ`h3A:mE(gXdd{ꕵ?&>ϹqcW:aa)fC(,mMĎxap1#v-賠cnw c FtV yv;ſ͖>ioO=jr=/<3_4ODc<H?M\QR^>:_4 YKF׋#CyCOt,ArrF݈G賈cc)00/kwnQm؇N1o{1SɅch؈؂BG]x4شe$@4CmJ{zGp?h1忛g+޶&z ֎ =~ ].!k ik♠y4ϡ`h3ABw:To_5I(gXdd{ꕵ?&>ϹqkA^ҼŬ|MشbY5zV̠p Z@@J K>,iIo)e? O:%ym BI)ЕBDj"tDg'`AwK,9{E{~VN9R.=Np֞7GNgIc[8]վU`9YP1; _'׋~Z"qںdew3~}R5),J.|߳X ,H'mБnWSl;,kwzJ{/_xfЗdZ,;YḨa$5U;X/UzͪZV\4|l5u:UW&U\S!MMsyD%k(ťeGi=FoGoQ ^ɜo,vj̏؟)o_/%Wm9!RWqSYO ffܴ5s.< YKF׋#Cy&??"oYсxQeq]]_v!{}(Cv|toMy≎:U@}eB'>bAMw'֔o7zo+iu.I_db^ݨ+=[J%)nA HɌ􆁱~Yp =ro34)8/dL"b:E9JȡDBp;ͽoœ7?cw[i5==(!B78ghD'2_L&0N*YЗ\@]YMsKR궮eFB7InZm3 Gc:__VOEq#Qr!%[-M^K>r{\'դU npLDr{{ZB/49Qܛo3(;z$vǁЫw.̚>pEҬB{ܠ:G/,m?Ħ-&mZo}cKs]q1n#tƵw^Scxy,&de)yхo}9q۝ H4CmJ{zGp?h1忛g+M[`vYxl&g!JOtx*BJnNB.M-B7A Az&C/eqH#Nqjj9||.jB\uԴ8Df MyCfIEVs}{uE).,=BW{aZJSUee?%dO B:}N 7#c?еmTm>]E^伤/+vjau,M ]9[0kgL]/~Jbt΅'x݃[r„pPC_ZG"VnU,іɥsI.YV4k󕗨IݛǴ`ɫƖY3:^BOG[vf]kɗaG/A:|mai]W+9/?O #zېbnvz " +rqqͻVu9Mt&p+BWN̉դ_PsrEI-/{wHqR=ٶϥ`,k;4sV1B!$Dr % x$$A,*7qulo4&ut~?gޯ<7f|_˿S+NrC|chB#D[ꋮ6utR4OD-hYDZP_|T^3ѯe u.s dBGUD}oW.5\V櫟2JpwEصhClE䉩QQ+/M~2+t+dj>t?С}'j)w&.+t+mYp))o"7Lղ[ 3֑@uÏK%w= |nzO8ၾZ*2:t+! t t2V_@d'>t="ꋖ幩Qsmʾ4_L=[[LmU5ԉ4-_wy> c#vS>I'FĔ\/f(uu坎34sC<r7OGN:o#:('jm :t&:tgn t #HNCV: AGJuk</{kf n8@ %J>u.s dB"&}]V(yL2(iW@@X\dr<j"dWC"&}:@A[[[Lm̜P O nVp׋7?|FPAcċWbD o%eQ-IDATJD֌3W25+{I.b+  tes`m0Sۑ@rq),fŊ2%{m|?֮m/ULtv/G,:2M^ǜ]ى_xu}iΕѥV^%Fg§Y/vE/4qA\_=@Ҿ\-jʼnm ؖ@Lia +o{8c-ڴJy'tespț~ɏqR@_><??C~.ba_V>w~__9ڶmOb"EPJ|v՜VcZ]&&K;keyβ5 `x y/]R7IkUMȶ\I~>pFמ& chX7јܞN3hHۃ?HE@:[ o_q]ɞ!1z:FF{IˍrNbu?Π'q&s5`?EIo<#1<hi@ Y 1j1qLK)եK|v.S<3D?Bw~JZ}5V72BrWhf:<*pc6_Kt R{S_5U`bLѯFW1P 9lLF}5*r&)Qzu=K#aKƬйFc{?)u$!K>opRT6?C2x1)#s:;uf#яP.AfߐέFzz 4&$aρ~Za tL és@bxΚzHdDBzK'n5K5kAJu 6?&v]OQ Ü&ͅE.l[rln/wAƜY"xr$O&zʽOBצׅs+#G1y1gt+KzJBv#6_osYklPRknq:`{{:;z49,t_i|;ޘv Y~}1_["nv#(+CZ}g{ڄrFr+}5΅~G nIڋ+]sp:o:ݤb(t_iSh@ i&=|xw#G☀o[J aC^͆w '3Ez2:ÛʪB۠|]\2=7:`#I۟g[=1yvzIc&L;^?O=RfXPr\8'>/i9#CDmBU(K<>ZCO2TᵞFbEFîN rhwV^J&?^~3Y`㹏f8(wLWݝhrc -t_ G9ުwE@:t֮ʥ`BX0TY}1ڝ βD"Bg4vuQE\EUK<\ ;H>U]]/ʨzVo?B͖J3kss] =O@>a: v )O +W?]uY9Lɡኴ<:g{Q:X)#ȎS2aOz~O`atŻn5S_L0W#~ Gϛ,cHu䵵߳ΏB Jǝɦ^nM.꡽VQO^̓!AyNzp?jQ~nqH_/WWC]]F@!-#2ٙc%QUg[ R_ӈצ_rtw.i~e~jV\C~!ؙ3V9p;2T . t vdpkr<;9m w4fuFr5{ RnNxg @!t]GGݔM MwC~6 &͹d;ߍ2760P*MBqnw.ibXvy+V }*Nc{g\'>: LkccDXM#;'fg{ *1Nh-B :OcU.FCgDhC8޾B*%=ɬ*y B|(od{JY>P &5hN4R5Zoir U=QߟYZY{?G2|چ|Kغ";yhz'BC9|rNngr*KeŰՋXP =KCbaqE^mǖs ba{GIKeObajmݷ[,f)4 .љU+e_{֞p|vg+}Hv.Ȣ.M@dBL"tSQtCRtB..mR:+e$&zr;fbM|(4 = A )g#ba#눕Uݓvr5+/#M^+S|}sf來ޞ}mʾ4չY6AKyع5)w>n}XϏO> |XS+|wsf.ydrZ>"۽ޮo*7g{_//g6ϧAd/ٶ AARܤ"@}R1Z2ertt@lnΌȒU( j n:}Ȓ|F @l[NcAA} J%3 SNZ>A_X7Z2d/RtȘtCt=AO׍,8LcAAZ͌Ȓq nc:& 9=TLYi 3#dzi6Ao - C梚 ۇ@Ƥsz++tc*_'Ţ%t@@ARɌȔy ً>t2&AOAГu K.6t@@AV3#d~ ۶@؇)pKl :U`3ttAAtb4S- C~d~,3-}:z tݢ8*wtAAttAAAj! 'Ţ%t@@Att@At@AAF˕Fcs3G6b:I^DX϶:MSg.?[2ptHЯSUՕd5E局mEO3* ~t/<(= z ۠EV j4݃ڠ/FLTAUQ\883vkL%Z~ͤ Dl<| r/I>K\9g0p?놽Qs<?j}#_{gd~*ʥA;k.?-xd xvuVxc0hh§~c[(z}8Jo yѰ]uנ\xTzSjxtͨsp}}_.n~5 Y+,wzA_U},~dz-;Aς?ǗhutD뽫aޝ9^_ :\}&cwf,6 Zi-[J~qrsoAZ O_BgDo5ڹpy{yu8O4v;pD޾Z[`p*1lg(" z&߇ ewlOFcEiw'W|ɬa>z}ՈyA4<}: : :: : : :: : : : L 0IENDB`metafor/man/figures/selmodel-negexppow.pdf0000644000176200001440000007307314465413201020451 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20230811130744) /ModDate (D:20230811130744) /Title (R Graphics Output) /Producer (R 4.3.1) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 26217 /Filter /FlateDecode >> stream xK-u?b7.;s6C2 T`0( )٦+Lj/r"{N"gzk>~G?~y~*ctW/~wVOm~oՏǷ8O喟!ǻw~;]cJ;~oz=u=7V._٩n=Mwo~'z|盞z;>qYo>o?E멯ぞԽ?|=目z=hg*z|:O;o_{E<~C/O?o?k-yH{MtGo~ m}FWG߭;a@w.7[_Gۯ~9wl4~ljHj}xzr莶_~Yo_~N4~@n5-}q5*~ziyzéo_EOwohƁN~@B[%nԩ zHƯ_ϿzEۯkW_[hZ~5VUMՅO㛵y|it?]tt5_EZ׎"uC|QZKODyit]?]oOד8 BύO|ͩп_οK|4~MΧKһrͮ;zt>ׄJ|DwtUw'@˯ɯr|/=g9uit4~:>d?_.?._av}Mwq>BL zJ ϗKn~^pt?~}ƯM4~:Y8~=.Ə;ۄίKOtCoi~q[9Z紟wƏ{@(k> }Hx}U:)]75/wziJzJ;uB7D4~_Η5ƯTtCoSߡ/!O_o 5p ?|f}H]*]gm-wǻa}H]*h?~|Cs75=&ah}[_O[k~.k}/^?{it=\kk>ޥu=^n;W: K_Ї~?Lhw BUZǧ>>͸ޥCzJ/K~ǡoqki>)~) k\ӠMi]?J~v)74moh~q4:o:˯ր!_9kܯxuƒKOo{ȯp\^NBO:^p]/ҫiϙк_]z>_]ZYw}g})1~Xiݯ>߯oiB zECZO\eӏXk ZQti>BW4ݨBǍMZK_?n9^ }Hi[yb+'r5~X0ZʅzA7GzPZ&)ЇZ$?O Bx@K?7^:Xj1-vnvOm[yi1q]EZCLs} t>_LLuDzl΅кifB>hh]N5.Һ~.~__K/i!)9Yرmϴk[0FۥߥcUkݤs: ʯh)t)5zj=55l<[߇op>]/yx.uC~Ϳ!?~N{Ϳ~3'REZ3'v^:6MZΉ(wU~{Wy&7.?wOi;\zIyj 3ӯMyh uk_>RS:~PWt|C_?t~:C~&]:=t?7uNa%?KӏIS+~C_~0ׅPB~zH73_R t^>ʏkKg=.liߥӏ^*_c-tzzF:u^hKb*coM~C_k>˯Z~=8ӏj۟o:ơyޤ_:o50H~XcS~տ:?ZN$5u }rP zYKFttMB&!rصM/}Jx@Ǯ ~A¯Z~&Eoߍ"?t9W9?2;] ;.l}ȉb\em~C8~!7o'N?_G.\qWy56ïLG׉~c-t5%Wy>iՊⱫgYLC\>h |v#q0&q#hY~Q8Bo,,\:i~׍IH_v2YR + sC1 ~M㯼Qo$Ǚ -wvzJk<vtϸхW6å/ҹp|WsLtBO߄:OSun\ FzpQ۶׃>|4&zUZǥg7&SHy?w[{ݝqY;OCr&z_}Hz}KU9Qʏz+?tc"e&C3ͅЇ?XQuM/C߰_z,tT'BHqN?֗C ~~ޅ>^7(s1t-CZbaK~SXJ~!?c),KߎM }=,N?OBy|s,4W~D,uj~Co,ܥt>*CW]Oiuʏ7Bo鼾sa24uo UsȏArTZ륯eSc#3`wEOvwrbe~'o޿U~XH:-oLYf,ӯSzJNA,lwi1 x)oyzJtu%?sX2C~W ~{:ᡯ[=B2qghο QFЇ~^4? =uMoM~]~Gw-~N?bJڿߥ~i %㫍:tc(׍?Nb#=[G^ʏSZ٥u'~g?>O/;}oNy=0b%-SGNIx+$ï;rJrScPNfW)aƆ)ai9%T^89%]Oi0pN ԤsJ S蜒!sJqN sJuN G)5SBsJsJ@SʠsJ:[u$VrJ)2;?T+SRS)ZmqN )a-9%;9%,4;h [LNZ$DwN%rJ+䔈sJ~)1NDNɢzՀ9%rJ䔬S9%(rJGEN甘qN甘qNfS;d-1rJք#dQ'뜒5)Yy8dM83rJQNaS:,HS̥SIS S_)Yﯜs()qsJIrJ9GrJVxSSSXGuN*PN^ JN~?LS2OrJ& )'19%x9%x)9dRw^):d뜒$9%sVN{rJs )ΐsJENI_p$O(OrJQNIpsJs-)A 7n(SW㜒^nn^sJ:sJچ[')i'29%|$.꜒꜒vp?#DxS甴I9%Ϳ'9%m)i!#gu+5rJWrJZuNrJ䔴TsT~T&)?SRምSRYGvNIqNIsNSR'9T8SRNNI󘜒rJj~NNp;r)QySRXKuNs?휒G;~INIPNI9QNAwNI\c✒߇s;T)Ѱ))9%Q.rJ-@9%Y)I@~X%$%4;9%Ҩϯк_)!V0tUNIh]_ r=ϕS(sKtss~*$ty$g  4ooMQWLNI,}w唄D9%YnC~pdsIҏ}|rJA?}QNIW!rJ\K^S^:Sb-9*{*JNIs7S~#$rJ|PrJP{$鷸SҝS@NICV5pSZK9%c~:$LiwSnTzTQ7ONI~csIo|?d>G9%Q~{[ZH)r^rO :~)rῧ'))rfSBsJB+WF9%]sJZrJBSNIs=lliq)rGNIґSZ\rJ9&G.9%cINIhq)r|qf)r~($88@IE&&:xS83$l$Qb9%+$>FrLS\F_7C9%]*) MGNOQHg!O9%sLow 8J唄!I?) B94) Ϳ+($49-q>rJH>Sx>o!8 q) ]cr t͜~s) ]KRgn-39%m(C9%q(wʏrJzeߝ5c>rJW :sqS\)MNȐ߄TNIr}HCWNIp ʑD$9l&C~.V9%]O$\/q) .DrJqnɱQrJُnM8^唀~:$8r?ϓSDgrJ+CZ׫& 疄߹>SZ節Lt*$qd}xN~؇Vn&($8ܒ)F\KNIܒxq*䔴nк?*$t;_>rJ?S$~\S\ "C~ĕS<h-$9g^tSҜFNIp0:~)i#$t{d܂}$3SZ9)iSrs2'CnFXO9%5SZ/霒v($D2g[9%QNS4tNIhWNIh])iwn>h,S\,`u=rJB+7I9%qsI~qS ])9!rJⶳ9%#$ncS=qD?*sJB 9%#$n)iZtNI)JE/\"IS4SrJZ_9%sI8%]) rJ1[[S}S i])a\&rJbآ㧜8ds)[9%=%IWIӜ[2AzTNIh)asJBG:9%9 Sܔ:S^MMNIܒS[) rJb~:Y9d]9%Mq )iDC>rJv)isKΖ\s) ]9%9MRF[rJ+o0^QNIhĴOe唄61!9%yIO}rJbKҤ#$ ?7 >||VNIN}2$tqnɍiSR]INIhrGE*$t?)e\&MNHe䔄WX!˯iP_9'0Z )e"qg) MJnƲ\&Mʒr!Ź%HNIrm}M$bYMrJrnH΍ܓ\ / *$r SˆSZW9%)W\rJrRS˚dNI=*$8f28lT) MɔÜrJrX|)e>%*9%9T皓SR朖Hߏк^SZrJb^rJa.\9%7GNIh?唄.᷸PZܯrJb^ù$E8$ףrJB唄6r)M) չ䔄w:9%7gHNIl+QWcRW9ST }J+B9%uO`) MITדSzq9$oSz;,hs.rJ[+%$|ܜ)9%Qֱr~S[i=Se#ޔSe%}jwNrJSunɐ,cy䔄({,!]9%QVCF䔄/@;=Ou#=9%5RNI7)2wn)]~K~͟wɏ>䔄\9%Yƴg_9%u~*$rSDϒr*Srs䔄I9%YgNIm9&[ZC) MIQNc?(CWNImQNIhrO:SzZOܒ-ߋ~sJ*)ν#9%d|@NIu.9%FNIe=9%KNWSR}?%|'z~ANI])SR)SR}SRJsJ*}SRrJ*\sJpNrJ*):r}8R휒J5T9J.sJ*m))IrNIe9%rNIe?9%ڏT8:gZk園JsJ* Bn9%9%f9%Tr:SUTSRqNϜSRSRؿrNI✒rJ '))W:P䔔9 )){NI1MNI9;rCNI9~))O9%sJwڏrhSR()qnsJrrJrrJ )sJʝ#+:W.I%뜒brJs ))ӹ!))לSR_9%w9%Ź=89%eS9%rJ `sJ }SR+蜒\ rJ E甔!O99%=ꅝSRsGSRUS\iƛ)) DNɝ@NIsJWx}9%b)) 霒;W9휒BΠsJ 9y)) Ĺ))w:з9%ŹSSmn90vNIBsJspSSꢔ;B!%{;%3J֦M% %{8/|1HdEIVlzl&'WILL;\ቀt*CL %dܒIZI$d;0K$AH6eđl)d&0MH(}89ea7RVC}8epbW ;2C$O%l i ˉ!@ (~d/G6Ea>C>"|Ĺ1><g2> Ln?V4b9#HMbH+H%y}Y$ )"Qb/#d;|Q;|DWHEEya,8=5͂ Â맻Y8| n*FXE3"XUXɔ +İsb',K`'eXp7% >^`( >M{a`&,xY ,x'sÂwV`;AoH76a=g&`[u /w\*,x=bS _WXJ,xe ^.ed/SC9XBZX ^ WS5H -<ł<XX\7HnU#OO\fsłI0 K.bzLܬtQ ~r(kłF1,x,qm Kbb/Ă=$`8gVG,x,  ޽ KbĂ'k`Y{KbĂwĝeJE}Xp?͂ Kbł璹11ǒ?/VOE˱E+<n- X&+!Zbs w U /Q,xhSbvk=`c`d ='Qⶭ}9]obnZbI,xֺnB,xz %u!_jo Z,XE-T[Xf<vO =5=$<4,vQj`Cy%x~Z>U.ѱw{NE~fł.,‚&*+,X:_ł0Q׳X?S?Xv#[:,x]a.CcU_3+<U?w܇)fͶ@9ĂֱB=,xfł ކw=raYYXF+,/͂7̂7୿3 ޚO,xk~?,xsyX,xYVzodUolX7[ ̎‚7/̂7ky7zof`+_7 ^?1 ^Y4 ll>,xfχS5,xR,x=a`#,x5 ^Oa?XXYz,WY,̂e[,x]fłWߟ`+,YJ)YpgwOH,',xu,x5k ^ٯ5 ^'l,xf5Y$X:yĂWu dWus7f+@f+Yf+}ޟ0 ^‚WgmWf̂W)̂ ^,Ê2 ^o69X`KahE՟O,xfł^,K ͂Wg'{,xebe:kV7XjbǰYZxkfk1,x%,x-wY7,xfł2 ^|?/Ә/ ,xa|h80^4 ^6Xb8Z6 ^wffˇ</dwVf̂ /?xjO ^~f̂ß_,x04 ^~~‚͂g[̂eZ,x,YlX`f$` fY ^a?XB er‚i\,xa=,Y9e2/~̂̂g,xft;;,xfłM` ,xYBe0/*wO`lJp{z(}7*{8}y$7 @4ܰFeݱ*Ên}g;t]pvh&{ ؽ7FfuoRoVP&#jto'&@"wϽ)9t߀i{Vz|$Bro67cHqSl{ƽ`{X. ͢1nqdcۘ/7|ƸMq/¸ q;8L07mAqSj&Ƹ'?7LƸPƸ'a-XcNfnRc ߍq;1n֦qOVnY=yqSdUyclfN`{.qSj7c7\uM11njq30N16Lu˪cܶt1bP[V:`ܬ6] = [qn}`7{]`u|oqCf%yc܀Ƹ~aeo1zknEq;Zw4HSZ㎙ziRmL Teͦ1X&0>)oƝ5 Va܉%ݝ ';Z;1n/Wrqwz 0Ȱ*=㎝ ΍a,;5c܉g%˶{|=cr0_Ƹ+3q'ش?qGzxzIrLvƸ2IQW0 ꎴŹ*;Xʇ1(Q[FMZ "VsAf&T ΊعTywƝL51Ƹ8l0lL՝V~)+vqGVzmaY?qSDh;kLJ1,aמQ ' gN;7&wV(4Ɲ-*:&F_R`D`Y]7^wkX_36GYyn) #Z\؀0>^ T`ܭ|\n||cc$ lAw4-6q7GqW'qWQRSwh}~a80 Q`0+MOƝX%K~Awh/aYKZX0;cޱMz~ߍ2iۮ2V(UwOcQ>qgF/i¸ ̻0(3 n*;O(;S-"[zg7G^҇0VTe:_qgټ&=[g=gFwtlݘubܡ!]w=*.w/tzR=VF c0ߴƝe¦")sun*cS2RzW<)}GʃqgO12ZWwE0ljDi;iҊ>) 2T.Kwnl{H}7_¸CMwE-"o z(œh20F>~Cc1;zHOcݧ0(#+;z`ܡ5 -ׅq',ܯ LhZTjփ2Ɲe¢:KwFK7ubqDz<wwzqgYDaYw|m{I~K~ޅq`YF.,P$:AS`>0:rVwW2q¸Cy7~ayzHcݧt5(% aY6q0<zQ6nlP6>у>- ˨~Eރqe0Ї1SZX0;;gayƼMQ6iWčuOio?mJs-xpܑ`Y&nl{R&~7eDIwØvSZדqm{[`K~[l/.;#Ű0c;t*w|և0qbwF Qw [nc ;;zS6Uw>?0,7ֽe`ܵcS~7ֽ0F l\?׍O¸Ck+;wcqxDwWܘ~qq;Iwc q!;ȅEw];`YV^ГL|L;;zRVC'ƸG0X 0v2>n1panY`c~g"w3& c¸c܍w;~~>ؾ1 cmZ~oilS^/ cnunDtna܍"M(ݦqa.K7݌qaZKqa[wn]׍m'l %9w~aw~aܭlZ,q7wƸ[wra܍Lc͘ ؍q7ƃƸ0於`܍2Lcܭŷ0nnHƸ;cwJ0x܍qjO#wsT0Vyq#an9a0R0n0~4_+֛2x}~a-[+ c.7]ՀqW4㮌Gq eƸ0|jj㮧[f7q-Ļ|~+[e]+]c¸`xa|㮾߂qw=qWjPqWߏ[.qe1nv1J>17qW2q¸qi \wn-wi?Z/']k4]RseN<2~cX!wqƸ]o}]oc~㮃7q1X0j1J1nUG}w`ܵs-ɗt<+-qk?]¸O`ܵ㮎㮴X3]ɃqWu-!q{?wmܿd-[q61ncƸ`w~~qwد?1nc Ƹ[qj[w56 mL[v̧1)w1maܵeux4֍v0֍-V`ܵp?q,.-qN19`e]qیqm]wqd00B 1Y1W'Vcܢ1?o-uq\01VgsƸ `t i?Pq[6va-X7~qŏ1nǤ.'s0w1ba?w9u .`Ƹ %ƸaLn፟`܅Kc܅9c܅ncI0BY1ncƸa|l[c܅7cnadx<]x3]raBq1^vCW4~`~;~ˆ[q1▕`$wYn)>'wƮqƸݒw1F ]~ yceii;s :Ƹww[V .VM0qe1B1B 1Ba12 .Ԃ.-qbqc`7UƸ 1Ƹo,+.Ğ.02 ..P[qbq%128o5UƸ Yc7f]:Xwawćh=Gi?0iĸo,-qq1ci10"[wwqKp0nן10[cЍqwi0Bc- uc7] 2];ƭqbqf|b܅ c7FPcX1wqf0`ƌqfhƸ aƸ3o-ӌq@qf[w1fa܎95]kƸ[q[2]6ƭe. -یqk2]~:~`܅X2c1`b01]nZwacTˮ8&To66e8V-q¸K1F-X1nm|w![v=1ncWƸK1~ﭥwaƸ cm1SZ/cuf\mn6mwyO c܍qƸ2[.n=o^w6]^X7Qܛ` nSc0{s.ޛSA'o)ޤAo1lr a[Mc mhpn+ 7]O44#`ۅڛuop9-Dk!vvXmG=j=%|p1´7- ioaho:g '%go69a6+dOtާ{/tPٮ^m${nUdo +84>غb5,>Fbiݰiu cİ7PF7 0tĪЖ_8ª+aT 1 7Q`p̠뻑!r+q4ýV7N-+aSNlM`E%EZo0oQf}z𳢬aHj(9!N|އs'yIFo7oQpV]+V൬9jY6V΂އ!莕;1՛ DfezS ONjS/LMMajB6_ L8c[S2l%0riԆ1Y㊕N``wJ\0rꆕ0@`j Sh '02<X'Lm-02-~`잽 S/'V"^FS,05,MSfziY6O LԁSbzv cUMOJ'?05z S/xa`jªluX\ ajs6 LMajS9+Vi*RVŁݭH,05%AZw[X-ղҝ,0|=M@/[@f0[`j6 S0\`j SF+V Sk0tU7=UA L{`g 0afw0u5.- QkY颻aStlXc]7L]LO S+fYcqͬBrL}V䁕.I`SXiLmlJԦi`P S^0.{t7L SC@^6Laj[})i|+L}]ޱ=@Iǭ`jJ4 SGEOpSGAd}[YQ&aU n*4VA|sbdQ0u=dSGX\"SGeX ;΂ǹ/:ۑAaf NH*,I}0uy Nc~N(?dx0DL=*j2Ox>CV괢\0ur9k I߼`lNt7$3_j(:B NLiN|0LIN1-: a:ɒa tO zIKV ^0u0d*%=eE_S8? S'=$i*aLpul~= NfS'ӧ7-n3#:zjwMNDaʏbcvqC ~LpBE >0u Nt` 6:6+{%LNX@0o&#jxzHW֙aM 05a,SmY0u3<L S7b=ڂ{S7R S7.G0=0ucf11LݘVva|mO0uL}n7+Z0usQ`6 3 nkp 0up 0u3\L S75ԭqS03 S7zndnL}n'v7x S;0us]`jn0u3\Ltp90u+`a Rf۰`"`jgZv&ajgv&ajgv&ajgv&aꞍ-ㆩт+K|{`zУ\ou&L])2L]Yb2L] ^ y5~:+Z2-~`Nォ+V{2S LouLvG`0u{> G [ va-0u0uA\ Lnw 0u+2+,wZ`JqaꞪ=ف+= S;0u%30ud6_`jg{w?f?zX77\W O@>)SWΌ7L]#V^놫+큩kz=SWÚԵIvGoSW S;s0uu]`G10ue30uuOx`0`Z sSbyO6l-cnL]ni e .=S SS?/qoleY0u1 L]NW`jg.l4=Ga?ԅizOL]Nt~S?ρ_7߂ ;'ۆ7Z`js..0Q7L]fL]~L]44L]<vqajw.eڙ t I a[03 SԅM3冕Sl.7'x 0uan?eSaj.퀩 [H;`j.tjp0uqJ`Bax0 S80u,Nb03L]&p0ua[0uqO@`jvO=4 O'xㆩ|Ư .?P.&7L]X7L 0-p`..7Lr=jVg90u1Lbsp#0uak ~ݣ0u1<L H`28^ԅajt0L]G2L = SÕԥsKS܂{S SX0u1 L]. Lu.^7L]S8<t9`jv1a`ҁ뀩aP`j.'v ԅ =5]nt>-=- Sæ.~7L]afya41] oj=1 SfKsOap5~wl`bc4~~ށ݃0u!x0 SfX[0uq80ui.7L]ւ 7ԥ Lb{ԥa0u1 L ]o.Zm7L|ԥSajvabxg<0u!0u1\ L]X4L]{T v1a|0L S0 S~:]o0ԥL]nyO0uoԥrSvԅ bT`Z``0abډӆ .ɂ g 6L`=[ SupKaLm0ui? S;l0 ae? aj'nˁ >тbp. SN7L] '77ᆩn?zFw|6L] 7ѳ{OaԬ05[7L] C/S_5<a?߆_aj6Lm05p0f9-u@J@Ro.9}qF'z;tG6/y@ V@PoNٛG*{Tezzo^X-Բm>/rz8+̈́MoRҠ eMI/D!b-~ӲX^ݰtJuB77!buos+a^¤EېĊV fd+9XMh-}oDt&l8]`vG<6WހoTDk-Eo77}#P &ID !@͕mI4vo&XM4(Mv&@}%!aЛ)(}΂IS􍨈Л%MX|+77"X>oC>۫ Έra9}r q$z@8&O l7ߔ}GJ}r mާV`5Hռ_A7#m@o`GD hv/x78vry2oL@4ɼ d6lyY(MH}IH 4eEՓ^6(Y]67lnry6nn0j-π[Y6dhf+]$he#HnnBazb@}pl^ Lټf_H%}>}C&dMɛ dNɛoxuU}0\]E\I( T(d1zfI$@ưUEbeXV4Xi{a{$2y&Qh!Kzj&>Hd5NDvqHŝ ,pq@fnn`IdRA">մUGbՐX=ƪ eU$2&a:GDvuHdL";9 S $2&A"ǃD^nmՐXLJJ$D6lvyòHd|>aĪ!҇m5z+! ]+ٸ%$-+VI"ƄDvOUHdf3!q! ;zH_oï?~o[>˷*~(e1NX#džuǯߏH\?bRZn|yCLm?G_8zP^3@kսjҼ ^H[^GPn$zt?_7~_?G\d+'?//?~o_7|Z`,ъ}cs}o}ċx|{7Nj'_YUn?ſPXB=UU> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000026582 00000 n 0000026665 00000 n 0000026788 00000 n 0000026821 00000 n 0000000212 00000 n 0000000292 00000 n 0000029516 00000 n 0000029773 00000 n 0000029870 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 29948 %%EOF metafor/man/figures/plots-dark.pdf0000644000176200001440000005573114466631452016727 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20230815101122) /ModDate (D:20230815101122) /Title (R Graphics Output) /Producer (R 4.3.1) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 19439 /Filter /FlateDecode >> stream xM6Gr-EolU+2syg3C҂p̨_")w8dsniE/*2"O9)=_?ozOst=|=_SsO?|O_wzHzCӳ\O9|է3ݯޞO")=ϟ^}W)=wYӯ*ϹGm]N/~կ׿kn~'LQ,O_oW7_ag}Eo<Hϵx>ap ۷`۠ߓ5dg!Mxeݜu׻~[~J̱kYvHiTC;./tCIߴ2|uǏưEq{n1dgC Iy5yNM? 񐆫\8zY~!{{<.jMÏw~uY~C,@tگ3Ïl(җ:;1|?$K_\߻Fhv00 ?q|;$LOhϗ~hw~=q|;$u۸>Cx]uɠg!o䂜 /֍i8!㐷%xq?7OO_$o淐5`krמoiE\߾}tu#¥֓60~/1lP]WEGxz_zﰭ>a/:z7Z;z0U歿?}>~; ;ə OOw߿|Juk ^wӺOVt󕐩uäN&,~W\>{ AH֘vx%"Yy(0Jo?UQt<YTN@8xʮ8K+Oo|hދ^1]/KB^|ߕW7@}=zy˛]f7X;?/)qY?k܌LM{O]aixqϚdcNG'B6?}vwD06aYmgGD>#&Fvx{0ٷ(o*r~T;N_F7N)BDlOYw; -BVaL}]߂C̶s#4;EG`wĤk8?h<=GDw<{o-3+yn0wW÷7Fozc}ow텑u/'#B<{bd'^oUqVpm)"Α6CEBحJ/V;ҍfEV;=TpmPaDja|=&wu:Tj>`{UpzUm F{M(|<~;ԍ;@ y5A|]wOMp,];cwS7up+.\= ^SYiˆ}?>ah=Ϻ ^/`z~86!t lx:Ɗ4׳kQ*8\/>1zU݅⎝UY80;/L5l~ ,تy ygg%mtM<~o P~Ze<};u[uR3,/x#cb;9;~ \ug&71h/C;E N9V 80ư:<$**c4{#G_QO~~4\~#CKC팱{8 au` >^ ^3'՛OnS<4Qkb#-  ow_|3؃Zc;×kZ?} So)KI XGqk7?=?  vwÊʊB.ۛ?^¶ُ4~ʎGWm(??|Nz\ňܲncEVtn!CʷC ?r5<!}bӥuy+[䟛pn3ޓ);OuK{2+X$ xzy-헾_Ͽ=-숟{r!'מvL=Dͭ1ܪY"*?+\}A ׇZX Q&ϣ*thnp%A,$\{2(Z0 ןX+*Q5 Jae•$ps(. 5. QJ7_Y+f zi{5n݂S x%Ue\}bpQ$XF/«~'O[Bd*E+0nwUZp}U/pj5 Z6dpXE̬Zp]ނC ] \V>쀝#*C.(1j ap4n#\RZ`pd#?`:kg~ n%vA־d{0P]^nVA@MX/T{z (.Z hǠ^@<\y2("[Z xOO^0V.X}G^{#>Vۍ[2\7 PẼV,Q">QR8 2,Sj`+״ob _ךi#o >98r^1 2\鋏n1XmA +[ ۰\ku,uymX ,\p~4br|#vO<+״G̑2 \ h\?_p^cRĖd1XVu,x.\0i~ ۽ cp K\pݬG3.o-3.bp[qdS;;\1:K*#ud πAW&^T 2N\{A]0nn xf+xG^{#vw{ \tK0o 18Ta X}d1suA&HeLAe2h 2`^0`A.[ cDdz\pd VK{Fd Vs#ݵpBd16'2>zb1d2lnpݝG^7A$-2*^+[X1XU߲ ca A R5Tz lp ހY r b1HȂA?g+(d "Za-ѓ9]k[ [K q%Jȝ2 c*U  RVlb*b*«HӸ,Xp 2wb7ט#Y V],}urd4bpd "I-k< =`ջ`p 2 qAٸ`?% 8ǠnAM#ՒW034aZ&U߭y -59bI~i`Xr!oEsut[ nwzDΰq b3p KπYcZ .=-g cp3,}֘Ɯ rlJU/$)  i&A=fd;%bpzjSI b̖` -b1VynC> 2{W0`LcA+grd .R#eY-ݳY 6݃X1DZwʘ`hkݙb1zd4{#=`u"4Q>2Sbp%I[A$Ib92l$)z>D7}LH |h*Y2f6l7\9p3C,_8b EՓ[,vL%`f ܞE ߍל7"a 禘 C@[TT¶V1-Mj|!L;-4'R pj3h,\آ[ [xN's*[\M;2)1\b rq>85 pu+LJ2rJL PŪ+f"0f/g$q>8-&az`aNaa4?+%ר&dȊƁ0W(0v:o-S>~x!KN 9dmu'ɰ*R4V.;O&eXz)}[ɹ|HN--â 9]pmN-f.,SQ2?fJcfI0W b:fhfҸ c>$OCEٳsWSǤu_79$p+ϻI4'q8#p-~;&0A):SiXVG]v2 TJi-~*)7[*Wm`$|N?YWkG-~'uBmvbMt)l;w_Eέ"e'׺:\Ut݀]!]wSv+N-Eq!NaMM oE`./:KUl]oZ uj=W]+/k鶅u>8ֵ(I(θufvӁ :tY^8:]3O'0~x`oj7Xڍc>dN׊+d[ #)rZ`o׉8 Nv$(>>_y0`_ppG1~A<$|(NƁ`9񑿔fːd0k ]8#g9%9'").>>茦۵~|N\ŃVT)#-Nρ-~t I03t`IbߡKqIS}|Y:(\tMtC:Q5U$w.\-~/:w:]׵t_1T2Y80E󝡫_,h1v pb1vC9H%0~qB5:u*f˜ٻ/2#)N bPJK  bP#N-:*)+zeaՙCIԜ5ls~oaupD+,М[Ksoh)0,Pĝeǟ,`|iy5b3]dBc>4Fw?;rЉ|gBe2jXC|gβ|poP3҆;C?-~ nA\Rs2&烳cr>87&ô_3Sq(^8 `߅1Y@8 88_ĉ3bD>a088u bze&ꁜ#ggE/HȬ08)8F0qZIq񑿈S)Tn&R y`; R;u w0 i w@?i3||q'0wa/-ߙߩ mgeX' AN|LQj8Yp󝅑ϊӅ Us|g*1\||/BҮw.tSwRwpȧlbv*fMg[Gҝ/]mWD0Ub땩;hJKw|oSl;4^[Z9_0|!(⡸_Sԝ/$iS!-~·|T"wjҝ/L9l;%`|a. uJ##7J5F>ۍ/`|!·|tݢ* 1 gZE0a|!0a|!p3ߨfa_0/|@Z3gďb NbB`̇a|!0`)A ۥŁF2/F>;/|`̇a|!00 <0]Z$gGza_j 1*V3000OB`|00000X9K8/`|! 5R ##c>L 6vN/|˼<~0#|W(ء]_.`Յ:t_fJ0H,~·Yc>;t>ՄF2ǯ[jA!dØz*f8_ft3qX`/B`B`̇)\c>L 1_$F2/lI ݰ u>_B`/B`/B`/– u>_ e|!0ARWk"i? pK 7iš*\ax. %.(>i3~ B`7;(fb)f&wg|!LINv j|GeJY1GU::1%G̗(pn-~;`W~ǯ&[VØ:ʼn9_ܓ㏢)<~ e|HWw!O^>?\'%_l|UJJȧd|aF,.Yks2Ō߬_p{EL}f5ffUj3~,. i$|Hc>$ u>tw.s2q fx1' u>_aX3S3~V0fLdvB`]L\8/|WŌ\Vc|!9'w*Yu_ObW&N>4+Y9_^R6nOboVޜ/Vo {S<|zT 6iMJl3~JFȫYm|!pϔ_|6lL\`cZ䘳xjZ'íW?|=~DNV07"i6>|aZWժG`;Bry*%c> [0h0ŏߢՏP3~:3djḃb|!0򗅧_ f,7bE} 6lWJQb__8_b/>襘n3~____؊s/B`|0K1K1K1l1z u>_ƍc__gB`̇zY橘[JRهa/5YSN-p_P/lfCIzZ'__P #c>T 1j|-W [zI0~ȁo+ůVfc>u>wK[j$ůKLW_`_XGRǯ>Hv[hbcW+zI`_>>|azI`/6bW|!U:_ȍyu_4 .,Rg ɊUP/تj^ #i2|9_XZu;>nO'oףɴ؟7C_$K'oߧO޾o%2oe߯g>>=_O|Z?Vs|D+ 61߫OFQZ+^jdO-ޗup>޷u2qg}]'p# *EBO@ZoFEv|BSOOѴ~2g4 f!M7/a!O)mp>8Ҕ >;Чqj69OjmkojZ?|TD"_|\k@e, >M.sηuEI"_|$J"?|Ыm:(|:_)|:)Z|( /LTkoERZ)kϕB^)kBb"Bm6-|R:-|R:.|R:.vJ/+_|4K#_~8i #D'cB~23Dj":bD49~ b?Ft3kD'c?G~2{ǹ8"QO&t(د8,Iw ~D엉ZM~}$bM |?N~2D'c?z(c?P؎tO~)iF,$JQ?ϔ|Ю_ڵ~2SO~khCmh/횸~p†/"႑n(\+Xٝ{~rwOɽ3|g~<4bg~~gײַ^?`¸r7x+~r;tOz]/+WxE?z zxDFg謟zrA!^Փ7鬟(^~r׳P/]z|zNg]/Ӆi:'wMg鬟:kѨ@]! '꬟F~r+с$PxꝺWD=TW犨꬟Tު~rcuOz-6|z.ژDWW!rԃuOz]OY?:'w= [ZWڨgcn~r Oz]o7xC ϣ^oE?%'w=`mBo#q>8_8t3tpXcOV'#s>8_82 cktpXt~r׋[=`o]o: i/u~r׻%aGz?ӎw'Xi/z^`upT:_H ]/8w=10'޸ Oz=2p.Q Ig=ꝁۭ~`c[w;^ \oMXFԋ7>v=90'޼ Oz=:pQo5E; '^^Om~ӭ^8K-X[R8_8X?zCo>F~riF~%pq7 `>F^DHn`'o~#5 p+WL 0CK'_~*YoXCkrG~/gxb$-~3E+l{qmIp?`aD& կB`k2Xn~?#,$'~M7~M~Eg,~G~I /V& կ~M-{-կBI~M'%~SG~MW~Ve|!5h~MJjk2-F6.ojUİ5_ܯ9€OL1'7B`s33n-΀p~jBcZ~m ?7 X_|1ON/o8F~u_K ?<^/x=$os>`/|?@~_ '%k#ntoB;n-_"p)~~r1#qF<^rA/I@~_%png ~ ?j~sA:>k?P`5XG/6h/N7?S`5XG/VQ e*oxcL kN~?j|!_JK ?Y`>ݏV-7kl[2Xh/`~ <$x_6~Gk~o`f€=ma5K܈p s 71\x8\ k#6ɀZp=7^e2KI7mNn,sg4`+,pVҀ}liRqj)Z&Հ),lka_؀l 6X[+mgrKQ \7 lov3psp5Hp8mB.E)p(۹D7\i%Gڶꀸf.E+ ݒano` +x@mǶ6ܠ R4g5pc|@20|@'E+rfî_Xful@v#@8n"8n1 E  zX{Rv@20pݼ9- z87\.`vmx+v@ `&e<ݕ7<ԪFo]%ol(n8n!E *`ʻ`n`U,p={pno8n "U7L#k&{k*q ` `vwK5߼aT_v*;f+XUިPn8p o#jc2y3ڍi[mk%!yCJd{aGh (i7 em7}!@oR na op,,ǀv{sduu2Ȼ2z{eR)3o Xn Xn n (}n$ 8n3-{ބpbD:wqGk=?z\ ~qG=u=?z\~qG=?z\qGkG=}=?z\N?z\q2GG=?z\w=?z\q-?z\qZ߷=?z\M=j?VnWC~(=6?JCJ~h?A_pnDp)8\ ^{?px+  k+O8"/ipxaq8\;q8k}xr<×p-<< ?-x0.xC<%Õ<-.7W^ypp| z8Iz8~n+GpY=^pE=x |‡G|?xNǯ|CpX>w }xF҇FU}8Y>\A>ܷWއ ~8~Tp9?<?pW?okWp?7kbx?x?8\Op 8 <8nWp38v g;c;]vg.l'qxlGqxlwq8e4v8vy>v gnٮu;lrS9ۭX۵\^{9bv2gcv7g;]Nlsyhsv?g;]Nl7t#zlWt3zltK:)vLgvNgvQg;َlWlw.lu:qy^;ۅvcg;]c;vhgnlvk;۹={;nw;͝vug;vwg;vzgٮll]Nl7x#< _K<)vgƳCdzϴ=ۅn'z=ۑJvgvgTvg;ֳ]llnlG{=ٞnvrvxvg;߳]Nuٮlg|;>!?K>)n|c>5vg;vg;vg곝l}~l}~ݎl}>}vvgkG~+?ۙvgvgvg;lNl7ٮlg/=8V7j Mj.!|pi50K1\Z lkUMJHeKY-jBZ \sHj4BZ |IH۬^*9+烗J`p!V)JJ*RY)RIjnxVK%'\Z \GH8ߤ*MRY(]RIjKKj`^wߤW鶗JNZVݤ*-긴X^*9iFזV7ҩ[Z ,7i5p!|pi50KjkV)j`^*9(ri5pV#qi5pJ!nݤX烗JJ\Z K%]Z %&F>FMVc>X$*RAEV直8Vc> J]Zݨj`!njzV#ui50K6(ti5IQЌޤKs i5J/lRQV7jXqKhKU쥒RUVj`>{֥&fb.Fߤ iTwK[Z=(Q( RQ(Rɑ)-RAVJzTK%ITrh=`Hz(q걥[j|gK%ITr>CCZ=00C+CZ=(%AVJѷ!Z/V]zP*ՃR-oiuKV k`H `K;J`K;+jnk+N-BN-R5!Z4U!}H; bK;"(](uiuJ{]Zݵz0՝V[Ziu՝V[Zi](MviuJ]Zݕ(i5\!N-(uiuo⺴7Ju]ZiE՝V%[Zieլ iuWJ]Z+.ZN+-jN+-ťҌ^\Jť7)v񯻴ӊfK;jgJ]ZҜVL)K{ܥ՝V:[Zi՝V<[Ziճ=Q (wiuOһGiuׅaHNԐVw$+Qj&.!Zo!jVJ!jE!: ihaH_!}хZJ*բVZ0բ! iVHYjĐV Zjх]HE'ZHEBZ-jjQV"Z1բň!* iKE8\Zͅ@HY^j*բPHECZ-ji.z i4J]Z-TVKtե(mui4J_]Z-XVKt֥R]j f!JiKRjZ*.JiKP:j)Z .3,` iJ]Z-gVK4ڥR(viGidJ]Z-lVKtۥլ iB%Ւ) widJ]Z-rVKܥՒ8\Z-Ւ8\Z-wVK4ޥՒ(wi\ֻZ.Z[^.&jHZ.J]Z-/MCZ3M@CZ*4MKCZݴ1MCZݴ1MV7]hiu-$BZEE!njV!njRV7l iuƐV7 i5CZݔiugHZ݆D iu ǐV7-q iuǐV7 iuSސV7 iu:ǐV7-t iuSb>M !&8\ZM_d!nZ!nZV9\Z*$rCZꣴU^7_JK[V(uJ]ZԊ:խPJ|a+J/lRe [٥-S|!5|!&)veJ/lRlVL-Q|aKz%J/lRq [B BZDi-Q|a(uwʐVRy E)zV˥7i|VW- iuՍǐVS3jn䄴N |pN VHjdHHjdH%CZ͍VSꪅ! iu/&UVWmEꪭ BZ]AHKjdHKjdHjjjCZ͍ÐVS1֐VW iuV!j"U[QjdHKjdH) iuGH.|CZ]+r>,U%CZ]^2U%CZ]+r>8_X 󅵸ڤՅR-.joi&7ig7iJIMZƛZ%ojI^&V/7i*gnj%ojI0V?<=g~z͎OOj0|IuXdX&uchsVG߶u܇ӯjO5?EjcA;90-~&v#GOr="=6s> iv!|RO O]l3{[jy:*7 ;k'?Yݹ &{!^tlm?sc+⍳u܇g2?Q LI il޼%\C:6>>W N؊+5~oeޯ>KiOt[OAz[TL`=}5ch ~E鵍v]v=Iu]D_^];#B{ptG֕COM?אhD}{lE<ޮν_ݗΐ6f{ O4m}u5Tn5WdkH]s5c+Ʈd]{n,Nsk7]BWRgo"{4[o8;Qs>WW-{m]}n /'ZGN.>up}Q+~Ͼ ~!Ѽ =vޮν_5~'oU*v=驏6oz҅s|2O粗cM̸.;~,*QmϷjD,]9U JokXN~(䩟 PUͮ}5vZVXоE?Hbᴂk !yYi:ұyDK!}cW2_}n|_=h_oS?"aw$&Zq\_K\IXcg!G>p><`O>`+kv~`04x;~)_}e_7?nWxkׄWò}՟?W:/=}?'#X o?P3eqf~C7Xgcq(ۧxM7z \o_|1endstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 720 308] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 9 0 R >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000019804 00000 n 0000019887 00000 n 0000020010 00000 n 0000020043 00000 n 0000000212 00000 n 0000000292 00000 n 0000022738 00000 n 0000022995 00000 n 0000023092 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 23194 %%EOF metafor/man/figures/selmodel-beta.png0000644000176200001440000006326314465413203017365 0ustar liggesusersPNG  IHDRz}$PLTE"mmmSkaO(\\\fff///wwwUUUDDD  ϽșcR ◗R___KKKvf,,,Vm888kGGGgUYp@@@/XXXoookkk]sqa~~~'''߅㔸222l[酖Dzdzeq}'~h}8cccMMMk5`wwҋ~ꌜmLw=qPPPrٷ.듢pzk勤[효'ω&`vbA󃃃:Ʒ꯼4I,Ի.ɞq[V>OUI(=bV쉉~hhhp}uuuvsssyПy-ӏI࿡#3Fڜ<ܯsi]ݢpݩqlFɠ}BGpd @f IDATxoTUO{~hZ:ݡBJD PPS!VZ D^B4!&EQ&f7D$Wv57k/Mdf:v۹O3vyM~z=|Ԛ &\[h/W`W@tD@tD@tD+D@t@t@tDGtD :CXq`9Ħj{DDGtDDGtDDGt_x"([$q~〴7I[[#zxD_&oG !a~DWUDDBmmvWK-IDDBd"eԱӣGt@tSE3nSR /rѭ ۥs8(r-]t_U:>-)z뜢Zvs8U=[Zdnm!6U{%K~u)yD7R\gos'RGeԱS**/LGthH#SfٜP5vgDһm ۚI qoչHz ]>ٗT1kaLw.#_gV͇V.Nʎj설~LM~. z Һb]!r/+c-ߪwIvC)i?E*{Zێ#z&8|Qt6? QE77cl@Z6'{˷] }2IbKw@O^{V 1}0>tD]t.f[˷]Ӆ۝3"ׄmE_zJ ٹORZUr6~SoF z ޝ.\W2,ߪ{9Efɒ/~n7PѓSOzE:"6߰ -kO/H;Iĵ?[턜(IC |Skc_{5,gE>N X0Ko mzS7L.zf^\Hʙ.cяk}K͚N׽vB%;'7 N^.[.zAs[r#jWΊ]ߜsgЂ1z2>byMd(EfY.wB5)gEgg/}-@Dqijɪ| sf\jWΆO^s}ҧyO#'W>* !oUS=jXe>=鈞e"m~N[˷*ezkXY}⋯;'!oy{x_P˷I5=I_DD7PKW"W/#u?ԅtVEUq?Jiᇌ`KIyMq>tDEon'9!:ߢO~R! 1O>iչO0Ŏ[v ,g]KU!ѣcFVeef#9#5M#G8]cJlgt"=F,.-u>r]ZΥ~"=F,H!2REW,U-FD !ZHq~0#dq P"A}Oow^ bNȢRP&ѿ{k'cPȢZ$Mc匟ìOiaf_mH,AljL*/O;p̜%XΦ]ͦVb7&dHJ3E/,Uuf~hSBmJ99ngc%z0$dqQV<;C]-+Uu`DP#_w Y\խ Yt~/fC0Xr,MI[3N?#z&,vZ/&z[|M'у1 dngȢKt?>~FD !#z:`4D0"zCNb@k:޸X9Kt'`4`6"1E'd聳`M'  zd f=,r fCtD7E3 vt"lC͂FDGtCEUm/ fCtD7R0`gx#VMπP1_=g:l^kG}D3{-/7 !gpqtD뚐6pVVf+D "#. lkZ{VpFD5d`9Z`gMw^'ݘ XV)ezD0"#׆$y,}9j۝3!zFd]Lrs*D0",fd9e]R?9;ԟ+E?D/C#cFڅKlC^`6EX ەkEճD['z>z'zS*!u^,V-Wjr6q*h7{N#ۃ_k':H\#zc>5 !:7ed-ytDG=jD0":7s|L'EW'V`,z̐E-2ޭG=M>'V"/Tc%H)'݋j_nH_JѮb/'6c: R> =rrZM{k^gI|\葇~EO| Tx~ O;(O))=5Jm*c&Fd`,UAN*-H(倜}hP!^-}+/U[Eޞ}w;fgfgf)dϮ\vw>ߦsȈqQL,,=H0&StaPp_ꛬNpUwm v࿉~-`L|àa]7a-&X Ͳg'/~y%LtaPᰑ>. Q7YN4x]6$(:_0pocezwvF߮ l%NtaPN32p=-&}Fs-gzo9ْ$:g0pbG\;ԗ? w_L{NDt F=E?_>zX81wvu)lo׼LMZtQ<fR?~%2_Y .h``z_du!F+.[^{oG,V *ֲ;YEwٺʛ`C.y ̖蜑ŠaëuɐÅ,C6r#.Y幚!\2D, {t,^gg?,bE]`@19T,s3NכySk{vBkdOŊϋcrD,2Fj Y`Φ:Ǝ ggd"/y ̖y# ;np;RmVG+ȽOfK +vsa6%bu` 6C$!dYRt2GgDoH0Bt X3-B ŪE_4LxXYtwMH0BtdQH0Bt}vJ* :D>D LnU:%gÐ`]/$mV.0Q6SpAMGEK鐤MCbFZ2ka56.y#f"nGs=Y[pMGE'%iw a6[EY\ɗ* n:&@Yڴ(mn0,nk.E>QD68 ]\d9̓]tLBw_E$]\d1cdC!G7 LGFEIQ:+.h^!O ,77{M J n:_S !' qfOtl_COqֺSpM$ѥ>QLKGY< 7!'@1&4p4fa_dc"DD#|+" M\dq7/FY tLVGYlO={nБMd>B;do'lV.08rmW'p#ᛎ}JfGŝۜ9]o 矦 tLo˛E ,qX`cnÅ,m:&D%7 h"# 7T7\bئJ!J*V$-D *66`D GENѧd7 FDyEs=2,r渼A -|0NtA2#sQAt*n˛#DO a9a6LyE9a6Dy]q%t<ѹEr\)H0Bĉݯ) S͆`:DO ?U =Ys+D^Oզ#$:wBR8X)=1WׯF!D>K{`I_!%5L60DO tL7;5`:DO ãʿH0BĈۯ,8Aۯ,:JL7U7[ۯ-[VAQ A_!X'jV}.E yEW`:H (Zy H0DΏPѕ?زlGῘ[VާO\9DW!z #D]@@t%` H0FtrRY%tDW"oga6 t[ʘ#EWZl FyDC?U\DW iJc! |XJ/ F~yjf]1=^Fa6%CtPz!H0.C  Tk;v F%NNѫ:}:K}tb.#D'c-(U0DMzL]q.(U lX*;.Et7JLG@t9g*a6N.1m\M]{]P$D!kH0.Nƻl)#l}:=$D/P܋ ! X_ v" hZLG @t?f#E'sthh:=Z#rMn!f]: l}ix`]虹  f]dJ[g0@ta?"g.J~M^a6хܝ.Bem0L]˚~y?OP FňI@9D"sw" )0@<$swD"=gz/L= }^;l fӻڧ+sD1V1WtH08E?۷1XtL m= s\a6- M#bї #}#;k& F7| ~Vt@ ?XF:3E3futcH08DA!F%#T 2wG "z靭w]a:[twk~k @k=tP+c'L]@`*ER{{2{v؟b9`ܝxa6T~zM}Ιs[H0e5on6]5 ! l4]t2GgL:J7"Ԉܚ70Flq?@lGl?Iɽ#P":;&ǘxm:eցB(rc?D#P":9h|N,}el@,4,H Ea:P% TDGM;XH0 G~y0(:cGtZaF虹)LD߻!G6ww`x^Mtv F SAtrx_9Ӂ,+D&2${g`sul]#F{`D_HbZqF''%3Z60>u?Ry3v>K 5 F At7Nt*k>2!$5Pt3ReLGm㴹O  *bKRB $ BATZiX%ETZˤtIPQ( QBLh4?*gb'8{K$w{|y;":ckqUݭ҈~3-٘lAE_"Rf-Et-j:@E$j2Dip${*%tD0‹^O8""[? \hr`6 3Gy4[yOJ.[SQj`URXp)*-q]JOFP*DA / 83{m15_g:\|@"Fb2/^rSORM !\v6βws~~7?SS_s3nF>g=ЏHknj34~%_YZуR^J7A#D͸h"ԗc<-T~*Ԡ\9zCKIs=Om5V{xAzQLE:;i Yr^J7A0D3To~S|1 sB$I^[J[?gјسDEe$ j k $Z ʼfΉ@Nw8^JOF>;dUQr^g(d:jxgm)Y/. IDAT ?0 Zc)/CGw|auQseu+NoU=Oa:DtW,u(9Mj ۱=N!ab\31gd RcJ=n3Ke')NvȐֵWjD#DMa~2lK)f|d_H=Fz&E_z}uƉ:-iAK1q & duG~m{#E٥}P*5@(̳RX/KD9s뒋_8#{dJtD0BBK-ym57͹.WVk"m{%@#DH<%&jѿs Y$r:`n5pU-i].7A-i-z ̖4tngU_r l`6&B պFN[a:DSc5q /]{!dbExǷnD;-elڸ+>!Axi$NbE?|6% D0Bt;.:G@%w;`6\#C3d/4cl}ɄX_E_ Lqs *(Z:FB3v,$557Ȫ#!Pw9ti d`6nPIZ#}e(gXE̡c<`I]`ѯ虓ZWPl$O`虝* |l1_z/,XtRq =y%Ewp=J 1D0Bt:J1M  Ql8Nӷ!Mqы6`6 {a>}sR[Tko0"̦쑟̯GL_Ն"!Ίyh-:G8Fn>| |&xZ8`6Ή?NmQo8Yl ߾sRɪMG0D+]KpC#Dw[k7 At7~[k7tAtᢿ;5*ՎLE¯9C*   "PBEǥhv5UgCD0*&:)Ho|\YW$Yuf&)1:,@'zq$"5DĊ¯8%xE;|dD0 /+:<+M;S/z$|Dgwj19^b6F0L[:*ֺi`/qbG 3FE/S@%_$Xo}Q{U>D0.:{'",~kS iZ#Mf;۟;cEX`qh@!V+ēhj-Uجkpbb(f&_hMm6` ڄdc|դfbܝr>{9Ϻ3>sߙݠg}R*t(]`sO(>xL,RQb>MWTvKh!fs3L6kXko&c@KAg]X3=C)!fs%|67'7l|GFlj1@'(9a .ϦWb [Tѕb^#R-a&}k_`t|6kY'mz`t#\6|d>&)ׅ%rZ>UE\:M-Yo9 KL!fs\6X'erج> FdS%)cUׇQ Ǧ t]ByإaD\z6V=l1ew85Xv_jh&ʇE&: D;*vL `L'Hw軨bp@Uؖ>3P0t3Gc&lK @%e"4~S1+@/.BZ56_Cs#HZfbI? @o*tTiSAG6uP?w }EâY7P0:t~_hڑnff }GL>&i1" Fߣg+ >,{;43k,#m4~<m)ok<tt zek}N3sfA_A3A'6㉜~е_3ut2P0:B#* @Gu֭zHi+RiC4g f]533͝@#A_{5 `# Fje/-:yACr`物` 詀ZSx F>&2]376O +o:Y~Vcw FgQAD @wz4w fs"W(0YMB r~.5􃝟=9' fs\tqr]ӺLR;_`t.<,@׼݈8q@?gnKT#}HwU~ MW- FKCo\z %@牜= =ڑ-ݖG!ojta:Atٜ/ h-,@I#Tuc(.60/L@:(NNC$ЍT5f}\6jڌݪb*!fs푯wޖϡ*R%FK(zkƙUcj|ҡ`tٗxixЀ"@BUe:qBGHwVgo_=iq]@.]bml@g65@`tb)`O(75q5|3DFN]]T< t "C[5@EGm@׿S zJ%C:l\Ag%pmPEJ8P0,&\@7Unb,%(ߣg#I.ʿ"Ŕx`InC8=J=`Jt8^Y9D8&Kf^W0͗99A:?Љx"t&Kf)Szb+ A/++D ڝ9)= (F~KTdc(ك1)2H;Z;8tn#P0$@gSzB]ܕ*)t8cRއ)=@M:1@Ot&,ZbJ=Sy)FL1(;]33nOnbRLL(ـn.OAqޘ?-\tKO9[ACA _*ZU8xstqRq&ޥ\@?xR1C)-ewL8<,@O:3e.'ӎeqٸSc*!fs 譴DPMRcJw6P0:eVE^I?9\)ғCvA*#%)h "b6uz"2-)/)(ً%fC:QZE^b1+?ΛAg¢ǻ]!fs|/JtQ#kT=@_5˥{%Kwq 6KEB6Q6<ݸvC7m3Ԕ9b6u_o:B Q``t%W/^@~#*( 񜨡9O[j'-B/J;ش20 Fݠ_Dg5 &@GԼd߰f\mf3*3bhً)fAB3԰Vt"eb؃NN悺6%ZAZ Oi7yw0@EzN# tqTT՛J`l' F}@?<;Cֲʺ_]?e3P0 8! .Q#lrف.ju0We7=ڑ-ݖG!~Nu=TatB t_^["+*ev`.60/ Aw9ml1W>ٴni4'dյJt4E9!svإ.c|(N1%5S(9xM1+gq&؂}"SHq92'-'ݽh*j`- *Ut~@rЍ-k :kw`P0iGn&r  ޾@oWȡ"mItٲ:QY8@5%^V]XjL1HC9T@?IJ¦t(t.WH36 1WVQa xIJ=¦t2:6#*\Aū@3@/++4?tqɊw@ `(qyr;?ê1[6@/;uye-跥fWj3b,NK'UE@/-ŪgQ#tf4O#?t`j&}1}4= |Aoic슌U3i t6 su7_Q~ҭqOTuq|faZv#V(6X"cFݒԨ_)VX*%*GkX7i_?=b.{f F8=Woʠ6.sʵ, 65 M#3_؎ :?$xkqĦN_@EL.#$[ȣ zbf @a,ogqnb:ؔ l@-ByŏѰ$AgHn zfh2gϺlڠ+ L0fzK"ڛqvzj?+T_Mjw[MHBӜ&xe9pǩ,uO08E'>' :8}Nr F Pb*c(T0f:SZ͙,|2~՞87q)Թ=0fSfԻtEv\H)ۜn:oJJ:@-5,: ]\c6X0!":+$w FU!z,^N-0fS>TOtՁ(^@;T+l7uSJzU=wa?N=0fSzu:ߛ$h68J %HW(!RS%ČY6H»+ @\L|.{s#;F :\#>N`"7{YYyA38U.)}bMtM4h&p:.~e:Ѵt."_UØ;iyLtwӼ+y0<(}BxWз$ ?jE l@!Y ꫓E^K@!Z4~u?`t6f`FKG#o7yݯ;piP2x]*w]3k@/m"j^A)oU_h8ЯQvhj c%6l,>E>3*ɦ0LccA;?e >.V~ &\ڻk|<:[փe#Ch%HCϨ#QGxJtт()uBdWkBÁ%脧^܂Z @OݗBe>.kم[P`=虩J"UdetTH:٢]  )}i;2ӵ Q>]q/2RpGpR'X0 z F$)LG$.1VK[l;X0&HXyG:,}r}XB;3g<m)ԢF1),ntvl[f܇H1_Ѫ&!!846r@@9D>~0ݼ3dilIH@D [-[=PV3`6Jc14{>8 Q`f!襱Oƻyxx;Ø:ldm[X޵*It#!Ouxx׭D`#1~*ލ5f}<[˅8]Sᄶ`L 7ta3]{s[6c@lh#clAyGª^k/t7n UO%1^Hx,jEQւ>зztL JEjVZ0[M"+A=Gމ>Λ .'P=<4_D,~m؉,4iW l#/ 8PnxߧWy]z*MܦD`x좪'nf9~:U7ʍ^.Aه363'1} Wyt|[363rtI[a/66pƆ"H? IP~⽗Ugl(BaBac6NIｔRR#`fwdn8?Ey\z;^`hİ`r~؉bg%(4İ`5r~h+5Ez"u]E?lBa )p4D|N r yYY=fL)-MnGVF3cZ0hFqohߌ"]ڙ]1Ż}RU:y7HXeu`eRTW[ң.qnH%9ɀ~Q-:kZ4ݔڂ>зHyVUg?4ݤ٘;]R^Tw lUR.SNg*rM)~-=_cMfصb䦛S:;"[G>lMǪ1~v|Yzy\ewǼ](!g`r yUE ДӘBЗJ{lmI'%N;[@zUPej3J1x`O?{0]FHC F A=Uiukh1[KNKeqDZݩ\mq*׆9r&Î1AWnurFe}\۶&P^v VY0!JZ r9ʂq0;W!R]w˒mbT2LQ"Uz!׉UȂq]SUa)#أbgRgtk|iٹ/7^AWW=R /g3_XB@Z#2EޫN:R=t5 n?!`1ģ"S{)=I IDATz-SaÂq׋B/ ߟ7JL~# <~Vaءtz7,+|}x/:Z{聕~Piu!.#"*}WO"{^|Ox]muuzw޷aݨ7f.S ibLuO#?]uѸev ua/g!#>|rFkm=o˨ kZ9!!RŸ?,/_aϑw4.y!V ?e`<?bʥ}kԋڝG5ӏYgL/̣:1q0wԗyIҏ!;ߟ3܆Its_AʽZ%ٛmZIPFЭXӤm$ LLX1R`!}U_CϬ^"y3Fq|vf__h`𘤨)ח`BwB ;8g5Lت&Jh)X6fۡ[~B%t-'׀ܭG~/遀W_ x˿t4ЏB͟RaS'[0zE^w~zӫCO>f!}㯐cBS:Vx)ɷo:~%_R!}f[/2"ub/z(o>xO᫡_0AoRڙIo]9 1[0??~2!@_2`7Ye,RF3Bj ;}퍦y{轤[D;HtgH5Z89etH&tNv[FO5_"cfA*Bt˩i\< z0D.\O F/W3Ao<-ҋ9~{!҃ F;A?!`*ߓՔ qȃ F;A$w&O餝IޘmJ!mSgH'yyW~8m^+8i$I;Ʊ-f6/1tϬM5'=H;ٱtA/kj0=*g7@ H@Z0:^Uᆂ~Nn0"N. ԘVWk)#=f)A "]uhhh+ FϧU.%,y8<-BtlXhf,1tRY6հ4ZA zl <apY z`az3<…U"e'jޱt@H]&Q(RZV .Vx&}ӀRY|Hx Ɣ@(1,ٰ˥":HKY0$,4s<M:_ep9.N`Lyy z-[Κ|/[I@:1۴;̞ئU3S9BErXZ'}*ҙ H"/k2nB9lu>%I`+16)1DW^ԩ Tztb+d{QǟQ^)N>c6A_ ΂mWM6r~Lo Sj,"y}Q_|{;lif;}_Yr!(f mrjE+:b:*P,mB+OяTy6:CUM㶃>0އɂzFЎ-IEߟ {K#]㸗#0rYs'߇8`ta.'9+&D%M F~YJa] OWV QNV.pk0fX-f9Obt6,[$s؃r3EB S`U2π<~ZȿFc_΀И +2miMφ(6}`|5i]'e&f 8܏ QF6bxN lYnČXyu~E~~?!D] ~@gR68f4؋bK%?jիmEEV8䃦TPAI?[{GLY'bgBQl`F6ݫUu~/&*y:1tG]ȳGE0-eNR>2<^Wq' N !骮W2fsl-Y*~;?3T*y?d,$YǠ}ᢞ9k ܫziY,LìI+<_9,6{UXڿ㘔96j\7q^U^ջM㾌<!z\Y_07 =oZ`af7 3@[zd]1*R9AS7Wj}:y^?y5fTBzdz[83# JRn5j(QjY,aDJE.++'YD6&Q*|wj>M\B:5qd=DS#E\Gg$톤]C׮uL3o[ Dž$Vdۈ\:v"xY\z8KJ1w!ֻSl3.LDw+aflLt<8 p4!I4MTs#%c$.]aD ƾNU)#92wXu`Dw]ɼg?1_v(l\o_($fh{V륔_)`6zo]c*Iծ0Vj`y&,Nm9Ӟ`])3z`.]o*4;(<:]>p'tWi5J:GZ״FdQj, {NLR!/Ls?8}@2&ݳfdu_V}-Yn]J1wF:@ă\?r`^S;l)1t&_ iKa=2ָyG0"9['5]F0oC]& K D` dsc_\2?%mF:-?jyۻZޗ)kfO=<睽t*J;sރZ-c- #J>t2c 7C/3O?G2 yF[-[Tf Pg}|m!_\';$1'5>fCF[ט RQQPJ &TX4 '628Ϭ9PAev?֣~/|5zV$ j سS Cv=ݓRR-5EH9q&z@k"*55a 7D: mG0p}7L@T9{n swZч7Y`]ť 'CI-idmӥip gۺK];6P/0Df >g4{rc,dؗ4tp,ZHōZ[d9N7|qKbg<$ԂK+1xW: Z f7?~*-!{:-D})XZ;`?[/SgГWl;ۊD7Y.?9g Ç@89G=v_~|{5zM?7R~W.0huRAٔ0 ;R Q43nũAXtd=G ^d(ُ9$U"TwN઎Rbp#5o_~!V胣'viY`)ՁH@:`XD`3'ϦDACïLr!J@H%A Xjq{~s[kY8ܗ7L٢Qp|y"hu׉HpO+&-kz}5:2 H ZJe @@Ĭ071 qF|O?KHt||L> szzz| Ht00 C܁L -@Ϟ=O?*J0~ؿp=y?;; umm)й ! 9ep06;'0x0KÄPv/t>[u^XVGBD S⛏@1-KO >Ppho{SH k +Q_g߯xg56><*.. n Y?kpSpz|n?'o͏>y?} wt7\|^O'_uحw:=wo:\c_|P|yvS{?\~j\͸oSM&rb᳻uݓ7O[Ǐ?NtTzL):uЁKz tE]ġ;O8G$F)Ϋ~k\Н-ſG~jЁO Oh  tBB@@:@N t:N:@7Z췬fz 6ݼ,Y }!]4=]潷jxd ;ǫn޶d #tB'tB'tB'tB'tB'tBg &tB'tBg #tB'tBg #tB'tB'tB'_pmW8Ky潷56H๹RkϹBW]elj随rnqcJCij=oY34޲+J& ͧίKO8x>X5G>Wߗj{NkvkZl9Ρ7/#'>*ܼL%\_Paa PZUv"8ܮˮkPSSt{~B eo^];+;ә ѳ%uֻ2O7]sZs '7Gѱqst#m+iwo- ݏ'5C_ov4ko(+kBO?yrS6pF`7P=:A5C_WLN&BO/fJ[29]P̞3 Ť P=*UƬmxlt' -YsueSEUϭ΄n(I_fhXJ߱zxe)j ]y~,T70z&zekFBO@Fw8J'iV43>\Pab%=p5sr(ʏܼ=u0^pF=ؔ6oA헶ӗnk z3yo^܌{cI{\,\40z6;qRksE4mnކܼN_}榛P9 P=[c|XksNݼA?&~+e|+A S漫C7{|)ΛoSlvb&.ݓ YMn]CԤJIDAT7FUpZ2;cxWT܋e nГue_ N7j x玩ѳl;Btk+g_V\R9=>hd7_Tt)*>;g76WIJ5j̆tpMgs=m~?8y{Bp_ҝH^C^h7uRBƷsY?w (YF)ƓBYAү&V~)>~㏔bG|}GK,7F|_^O?q o系+ߊz?.!OcƯ} ~r/v!Bf?w,1Ƹcz;)OY_ƖFَǑϵw٤y 5.?rɗw+DA,ŊuE5P;"!~V^|}+,J _K~VzyN秅k!ޅP9R 5c 8v4Y9Dc1TkGݛϴKQ/M$Y܌4IV΅iSCK)]eTs-\R˭ZmSϽ[}9H``usF7ZO^YqWYuXsS>;nﱧEKLXf݆)N>N?Kt-vw7Y/Sz_5^uD匌xS(訜rʜrPDYgA#Xn_J9#s=o k&/c.TL}HUm6?:g>G~(ivfrV,v-ZU/W<-^LvwAyF9qSUZ{\hOƱkK>\kէ9: ͯkJ r~]W:v7ν{{i3Y\,XjMO Hbt >f\mqo9 gUgp=IŸ{Cnw7.{]oE['yNpyᄚ9ǮOׅ,MiUP@t}CFv;o9qBp,"'m'>- |yq4[uxOQ۰: C#0R1^N_WjLϼ zxOǓЖZ! N&Vw*Uw ,V5Ҟ'p\+mͱS!RlQ z yRw* hm,蚀[H-:R)iBtմig] o<iG9i}t1N#hBsL f%ei&+P//Ɗr=k?u(jF_]<*4b" *&3tȢo *{R7Eʃx`B~H# 2ڞ7a4lvU?biOٺˢn {Ag-(NN OR 57| {"hZtLд=k&o cQHcž`B;1IBS$sW13:Y=qe.ۚ̓EMҨB6TW_AzpCk-UT a+ȣTu}4Qё(iZ g'pszgm;L>sKf1ύ[cW8I oMVlx#I3.#d}3Ao ER#񥝑:܍Vq'GW̑Q+v5$1żw-g|B^J>`BmÐb/wr CPբB/@hE#7~|H:K[A(#Fb{ep PY4IXQ8D8W[L*rc*w~└.?=l$BBZZĨzP].㢼,ORE@ERUxYP4_h ]N)@ jmfB]Y6p۴|iX,C㽞Jޠr;gïE4 Mh3F:"O(4kA$hAIY,vP{A"8NUvYa- &kf[TA:eᛦ=2#َJL!=]H!!Y ;Z8`1fu _':%m ɈiAykEv5duV ?|i3xAP6 EiUpXPl_Kj r!2J2l\\dG9`6@YUY;nM39tHJ,%;pn 長@f"0;#$Q\!# 458]d}Ö{q*RЫ"k|[*Y{Ԫ!Ϗޅ3YU2TfU!9Y>E!Jhd,W̎M>+MQhM)yٱ?>H69xSE9Jİ2(T.XEr{8RqUI] bystKv? KZwp)d@U6cE96 =|qYº(إOcA% F%\${Ddn8`pGbm)5.VLm!(ƁMҖY_B:+:]W"*`62 }D蜭2@2hVC5xsuڵ.M>*L"ъzcnfM2{3݁ϴ2}2OCdp(/pH ͥP tb9ڛu8@o>1N7{WGu/ υkӯ+:KJ]> U3W1G.gXQ B EU(5uQa ݶ# nIp.0r|V}#nvB c @xE\As͠% DHmc{7zxFPD@;(O%T N;jL6*#jfQˍ;D<$uD-4IQ X&,SUțV %L zDjrDEbᮎ21%t.Om[Grxsk^w&Ɲg\$$N#+dZHO$# ȢW/ M8.EְFC "m<#UIL#f-}(1v. Vu/:ɒu S-&]|Q+r U^Bͬ3&Yn^*ZJeLVD84@[ x Ve 6Az$"}]0#"Yb@e%煄) } ГA*Ϊ '4L eƆ`08A Ph8'G&0rb:TkAOK='JtrUW[0ٻ?Fh2_)z6w MMpud,0?2Ҁf8h&(x͠Wtk^xEH "F_ lJFœe< 9]נYslLŋ*W$P11cWe"&q4l|$5MM+@\ 745ơ\l+HrOְ'6YU|8)Z坅ԍƚ _rjCgM"mtƑ\|ʕOB 0,9ԟI;rWz>"ЭwEJ h>G/:QKHL[Lڳq;7گ?c3h߸ "; I0A]>vRƖR{!ī+\d\m$5'glH@ܡӍK$4s.J iRgn p8NP4e %;`ƥorviϏkj'5-zFGUDlNּhYA$=Fѵ _FETO^U1vzᰕWuBB׳z@ ʹzd@ }"KA'A>uj5hW&S,Ʉa.uD GgS+&LpU-U܀tz$2lݦ}'02U e R&Z,U:=霗|#M(}ش1 QtNdXvut 7Ѫ %GSE9.kǥ! , ?DF< ThM^Qu@+8h~' N:d;E%)hΪ9#F]wϔ:wUJ@^}sѲZG'nCuГI3Xԁ:CqrML7 ׫ܚ\5pMN|e^A"4Ŭ_$qL0XFTu e*cmB_[8x4,+m k?eC =-qtdSU E1S*V`_d=gi uC{śm“x4=S$@(HG8=ECLLH )LUCU{n\b@1g=ȤnjP5cr09^ң2Z?km={zp G@wZeSp5Վ\پsxSZ*0 " lؔ 难4ncD }mG990M(eQ?7UGSҌxmd9½XM ')aPz^E:SA#{V+C|[`'#ܬ+M&;UU|b g-yz՞@< ) TbǷ"u} c}I d>P/ZoUBBѠpQ#CnRꈂwܨu>bչAvL#-9kIǹa<3A mz^z%ې>oQG2ɷX&:[IA5Bv7׃4M_ֆ2BȔVԦ镣DءdcIOg~WT/nQFM@[ 9@r3uZ+#֊@iwVJeWO:d Nɖ{ݱVm@C}2z@w%csNjS$v ? "m]~c4 C˄g"?L띃m6}H f_]}^şN}޸~ޑwߘ+GKf$}ADG, FTy[ :}w|`20Łfz<[˵GDсh9lz:v9,pRWSyHW=l&tm{僽{R1xQ{eA}Xwlo ۇ[|?m,G?ڶCDbʒ'1w*U Tт~N>ؼ.̣pk.Gx#?ʎX+˫^b"|W@^:ƹlxQam>%}HK7!--SCwHޙ!(i)"`ԙTAt qoF 9|B,oVb6gKo˹%u^("P-G ":v,A6[s+׽Ū {P7./rxwyz-IO)&|du5\VהVhQuCPN̸2-qyz1%bAr c`M+תٓE=Yƛiۑ&:c>_͛91P>4{υ Uw0NVoOᇯoZj ӥV$*Iu%QQumDnQ~-Q"LFkfIws[m b:9\)ToYf3\`Ch"F[D`")}K mE~'} bbϒuoʶCEԱ;<̽DDrDUT Dikϲ6ϲQDx_!AEWV~e$msߣ{xpe[\X _7^q6Q>lo[u3(P%*NʶCEbƾ +so#ҷ%#hg :6?DO mAd" t?tQ`fWoĐc32-L쳒GS 1 ,\N{ 2"i(ƫv>%vҶмCFcw|QW VKGQEƁѐhAthӞ65_^A Z%ZHxzxt|cxě0/6k-kQ T,'=OL^(H> Mi{H*N i[h!#{'%<ʽDj"Q 3т(U( Vǣ&z?D2 JJϹxK̝x", Ǝ:>i'.AËڽ#=}Pv^iw[t(6=́4mi[h!#{Qytgh3A*2̆|f 0:,O0_U l?yzhobDBrIzοX,'@+ޤn~ xʥ6@*Fu,PWt]L>8^>lYG᷑sOʱm0fwHB}eS>|Nt Ҭ%#"pg :Hm"Y}S  Bs XD93 7>MJu]+zݓ6Rձ@![{مOo q "i(Y٧0(͂ i[h!#147v*ͣAA]K\GTQ vDX[8A4(=5QtZNWII;F|o1jqD+J"FzUÏ Z]^Qg|mom[K63s~ G;myD;<νDuDUd>{&| NCA4~)fzkBEaAO}>t C7-9r\\Mw|Λw }٭O郅_I]mobfdB9Cc(gBwy#FN(*3DD3\qcV{.Dn9gy tīokZrZK_p,kuG~45Jߦۇ5 Чc__ަv;0;mayD;tʽQD?%#jg>z:$sqwDQnk6;HUk!kjcטV,΄Jl8döXyruwZ;ov^jQ[ҶCG":zި ETtn 4i3]-/['  (*-W ܤ%`}vjǾzrc Fe² ~SWzf^q8 +~.lEݱ$:iy+FM(f>kg!/-.pYd[.aZiDءKʡcIAYS<򻤫_Kx~=A|`<X}h~)k%vҶCG":z^"G0#"ETq`>g ZKDmg\80b%>$Ċ5MXz6GDu$zMڈ9Jz(l@<V b|%M{cfّ;>x~7;s!Dܠr:s }JAD&},t\>P'ቮ-4j Bj>pֿu[0&6*e:zKmFy*aHyH:ZTP3QM5^$鵬 F_j>jAuAmeiS)hҤT菕ntʑfԗ(ߙw\aE.AƢn\/"R WmFy*aH׉X3#D*yև.Чxa V$pTwWXPy*Vtu*8 [ xA*-8Q"Z쨭]%99}SN9{sg[-h`y~iblw eqA`cTh4a^PIV||ѥmEdeVlp$v1)6IUK^]j+|=d1=3eGɇF{w露葃_9SbWο]y2I%vԚRdŖCw/ZN@b Du#QA)ME{,=#1BⴅbQGM !K‡1$@$Dߊ?Hc#vޚH8/W[- )LFV-ή#Vۍx|QGզ? AFQ0)!'njabm36ydA|[U D7k5?3{us0z'h#CUAxtZ2C1U~ʧ,JA^ALZix\Yv)=ʕYcTA<, ?/i敉bQGͳ ~)b[0)bLjAd _ gfq&NCbUHLoZ2IM},(F?'E'-p(-~:&aDj]\G_܀zarp_eM+TmF56,L*N^#a8@;D"C(gf#W ߷Ʊ,WD>b6ō]=ͱ&17i%엞 O$ JFMZiCA<ۢ4CD9 wf('d7?/G?0Pی=jmFYezz ;<ŎQXA4[3̖!OH/3}NPEEAߎu!OC-ym/y~\qoJ 4+nVۑ][f0j7\\Gٌ YF750"O1i6j~ha hb'QpA=]}D=:ȁ>3Q(᠙#UXJ?~#/BvAXd0 uG$x|Ț|1l:ȜRQl36@q;*D "m%awD O#uėj"91(oO"?=wv&ڜK&J[ę>||ڼ%'7>ߣlEDYCف#xɚAxLp OZhfXmQm3'WĎQ ]{lؽ?>L4/cAƛK)wgeu8&͙G / JN6lcz-:{f!Hkc !NS O҂Ok 'AdAx|2eܨЮ-RZ~qω 2$50 n|iwY٢ Lw#ʇ˚5)_M@1 D͸ڨӣffNrKǎ!Qvޙt 1S$nǽ|?y 3C=[L~FbjN׷-"w{BI-<7~TtZM;еvD"r)-Ad2Pu)!#TL)nib7hXhfIx0gZ8t(/Y^Fܰ TdDW`Xh|DѠF-s?~?XٙY؝YvN<_,sJRx)uN%cxzl@}Kl>ȯd ֍!yr xX@$Yޙuq@x YBŭ&fzhZD+ZpMXL-U 7\JLA dwTdJ۩a,N;\wԿN+1f| *>_߭arvybȂ5Go G޾#bgNB2 Ҕ;@eY\$~:q4cNѱ0?Gp?SC|:POL{UAd BZe b!T '7+vK b9 I^05ȨyUS"@>whZ- =^ K K!4|}َc7Aш" :ONb*@!@H *;€HW z L:"IFqRQ3p1 qٲ慠J, ;9د:" IDATA?'GNSi\a!%(L;P G^Aˠ[k1pNH//yMq*ʖ2ryfd=K f/0TDDNN: *.8*{%Eg@ψ.FkpնJE5;IPWkFcK>q}ln~Dj3i}e3pR%4P>ۣ*?| \;U cV/xE0B\OUR}+lUaI892SuCkQCkᔽw(eaH"IvA69`?i>YrF 9Ҥ!wt+3LJ8Сhd7Cv,U x@4UfU}tNz $٫720 4o%Z#(s5'3lDhs8 \#+z†0FL=\O9+>b㪳m<*.g]@eDS]?wѹTu INtN"~ܨ4c3j5P6O}Ksp#e[. r)T)&Alo"YЄ]JYb&o8//VkpU"(\|(#j>#Z:wgŽ?: yC*"]kP)>Do3_;jg GDG͋P \/m*Zt(R1LC"fF87kY&lnaD*q.UZD@X v5[W,@.!"Rl+ɷflf83S3L3Wtf G ;(V3lȥT6 RȔ`"3F4FL RbjYZBL̍kGpB2:KmFᝤ2;rv N2QnRDo)@$YQ4c3Z 3o7{;&A*Л%,큪:r|4:"K"T $Y)sU.l¸*t X6:.dDfFti"(;I@{]"ރ ڋKdڽY H ,{!~ˌ /M_R(ՏI.6zΒT )'~$D.ŗ@ ʗSn>yMvQ) S?-'ظJIvBEz3C.$'gv 6B"3#Q)TPWrN/`@!l[<~ "^ xeciW"=$GEX):/ b=`".I/ghO0}gIgi=L' wl,x}OD.ŕB#wO2{EDSGBuu$`t3F&P𜿗dW+ .ظ*_/rj-g\X0bH=MD#+ hRzУ,ZX%Z,G[!{rdzBҙ{C2M'=3Odf^*=ZgxztS"Ư;scE֍IzTV8!!^a!ѝMa"Ũ!JqJw kM@յdssNj</{p^{! ?g_|c2a|"eC怉Ǐd6^ew,k5D;9莼}IIc^^{ڷCޟ\w6!KI(/!CQy`f?_qcuq/\YȖk[ "g/ؾT]u諴|yFB&SM`֣10;qA]#Q-Zg{4Zzpա1<: |2%̄>퇾 ]=["0D0D!!  ``CC""" `!!0D0D!!  ``@N12E/,EnC7l Cb,4N_nzjvnRNtFI!gƀOx0YG /kL~GDz_cƮ/vS%BUQO޵ve<ӛ۩hoq5 D<;jVwiEbWs45.LTI\[T$Eg+cMtT{CKKLAuKwg+|Jq`FnWw(4>-X-Hd'0l6"dz(֤':Db>P>.CT0vHpZՍDͪÕ}lYglV9ur4)K- iIi\GM6WeLQ-<,GH"}Q%ʆ)!H)vQScj*Si"_GᰦIRKzbw--[TuNN7fqsRTIi'AcM)Q%q bpKf"BwxڼrRQDRĨź!r9 `15)vW[x Q?r.mcҜMKrZ7D4=LCv}g*Sl\|3y[BHABgDvض]ɷĊ%\u2O5S=iY•6T2*r c5(G*a0D%޸"qȱ#Sq3[ʟ^cibLDbFV>C4XJjIs!6-jv[A!\eT׫psct`Zj] / IV D%8Mu26:uAt2:IJ1+M_rR QëUz1*atd 0EJiҒhSSZnQ{u7D779iVoC;:~9;{u-޳=BR%KwU͝4Ss>0#*1U-&q>u%BpjU0FT c;m>%0D)4k۩ۺxT$i^3}9gfVoC;][7G.Z²;tq'!)Ԫl<~LHw") d1*FAꗈROeU`L STF};"1N(iCJwfVmOuV^^|;7KYwakz t}!Ow}dA_pTC^M I6O^Ѥ}ͱYK?OU&#E哣TuМSQٙ{RDY K)EvG_|(AfK,@2U<3sDŽOTqG먱VDOR%5l sLEbJNS>ӆOOc[:!j-y|M]"mHlkfBYO?qjEm)xkW OaqUS;:XIȉZ6QyŽؕY=OK{="¡HUpɓҨFI:;SL9}Qv٬a kmG6Y ȝqsNN\m#9uHR_h+RJ#Ǒػd$i^=3m/sjNbeZ}Oc#ks EQA6.%Y"Gx濑~OR|Ǭ!ZiԱgo8iܣ}`yuR+9Y4# wEGWdQ-x i7,]StUxk (ԠpKWrDnu4Vy3H|٧ލJ5'3N)iCԨj7Dv4y}mMHZAwBqB Kء;C+/ddodlOn{L?7iZ3[-x!7e=_x+iKݻxw=zMB_Gj+ٕ]_dأ}`SlvA&}/H^MBuDpFG^=lTe A(j[b )hF8*t/༠4[H[GHBQ?'A4nSR?G "MUi?(!阚 vZWOL"vsj7DoKDO˔<=t81nw^1sUI&3DlQhU<\^qdgr@}wB!+A("T1v`Ah;c2y0*ԜW6t*7egG;a"DS栲1*u#Qtf2wQ:C_(y.6._0gA_ŴhQ%Y^2bDZL2o?}>[|E%$Gc ƴ>|,!pTUh}zOWpa][Sm{1Kn^B7jyl3}Þ~`"B4W0b| ڰmYI]Ec~YyBղdf&ੇےS+Q_rwRGҵYKvZEtF Rƒ2:cfq`ȍ.a;O۾n2!z"BDm7w֓9.R5b$aϞ4:l:sk-hF9dl2wmfJoU܃ A5g9q)EUNҀ+|rQ3#@Т )J>(VAy_>51/.bmhƇB8]5r_gs2\s 5^ BF]iPrrkd>k6/-R(4@G-hF9dg!c!+@Ȫ]q A5%=u9{-!4N1g-ʐBXއkWV)nr]{XIy+Rڞoz"lB"$ysk=r}kb^]Ő!Z#JG8jݢ?d{m~*no:wJ 8"enl\U#DM_.D"tF2R6&N4G@!dqa:Hj3lǁnTIJ%\P>8VAhQR/S ݷxKI 6 OܑW0;f"GX gjoLFF%{`/|~Q2 威2ב[`ofvڅu>뮛|t%k9fni?Za;.+\/qv#Dg,[O' (27۩<ѳWv@إcy1dfkh+- Bjy+Ԫ~_K yhmRc;wc,BĈsB"h7n0r]ˬz yvAC>( Nہr 稱_I$Cp}e;.frT2(60k1ܾ"e h`QA__.kyzVz8ΨޏvꉷO`ʸQpJ`ߚد[ .Dӆ囜hQ*GUUӄԲWbR/9Ip-#DܤP0n8*QV #7#DDEBgbl m{1A`L9jyJwOm`_|v+Պlw"!׵9#vyy gIozn$4ԂiD-'Ͷ\å2 2Ǡ3&ۑ]͌xZP>*-ñG@BB䎣Ӄάm_"wW[7 * !›|Y4<H`/|ꤎLB:jk* zVaNs!y->ԫ5XW8O ;-or6h] h 䘿i?B$Qd%^l{b t oD} \$ɼ<\1 IDAT!EG0(!5LvR%޺%\MHB*-C" #DmX8v.}ib^]ŐOeB$QFPng](cQc(#C@dIegb.;Cfӝ,g_8[q a.捛?\ 70nVqaQ(|uMTPYxWp9u-A⮏p1!$D ܖ6y/Cqzn"G|Ij.8'A>51. "'I6k.L;jE ёis`ÿVNÍSl@PnU?!:N g=Xw\iH8o=PF  %!0o) Rw}#m}@g[BȨZBl]EP !b֧QFѼO@MǶ S)BR'be&!5zu!/!Ժ!Ձ9Ⱦm;d8E1"p3$&=Y?H8m_0'tBxkjiVs/f0HWs-@⮏xoyHk:I5ŬnU8BM"Cݴ 38Ew,D%Wnj܍DO0؋ !XIG"`έq+3/CYCϜ/{*l8.#ŜH4KbGYx UT`R Mt}Mac EQG<^Q)ʔ A}jͻ%\$RHcQv&D}\nCL۵G" ]SiMmѨ 'CV;ED$ԣF Q?pgDOmy"؍]ti&gg҄!DuPspkM:&k髵3|d]M0 fccmQ|#DqO6uףKԧ5c yn)'1/!^kٚkP&q?9HQZ ۪gbB/i Bt"foxQՄ!9s+jer`TZ=lm^w DU1IUPG=Wv[I23(!hPdԃauD 3պ}!u?|0MvT27P1n+>|" >Ԛnr'BFo\W5[iNޙ~5qZ)eGY6kA(XTąG_y7Wܛi,4!iI~%ߛf($7s,H(4RMyN]JhqlKsh~ Asv䙱Ђ,X5b|骘JSIQ*7;ޚO;ƒf:/[L,LAxge>/Mh=ZZD5Zq3sI]ue>U&YK| Q-$S}DNnM$uS5//"}b}5䷳sA>`?e>S]q2C?^'?]DbOnM4Ts߯䫕/2R=JM''7mISuewiXtpnGfk&Ѻ\ 9ZGV>zC8R|r*h1 ՑgjiC ^*i\dH-&ʔO':*DznNv%V>DfDs"3_|[ؑq'7+tY9|78ZZ7zhOMTN]aתb7VEFGi}IZzԥd\ef>,j[,gci_Pb 2?2jG;#Ec3 "gYN"A:Wʟ=IF &vC5AӽJDjnNv%V>DD`Uvt=|%ܹ3҉[[|:9}pw2- oa-qUJ.jD Z ܱS'pﲡS5 "fAQ~R8qE;nxDƿ.- "}CU$[4 rޙ(^-+WbfAr,FO'"AmB;@}--&Lbd6FDܽZDZnNv%V>%UW`<.k`M#dm=8NyKh{O tUԷ=)i2S}c$=7ԹGi}Gzm:fGwMX+:GZDz]1rh15O8W$^Ob\́IuGQ>6ʧ㮀).b0/DVgѧ2٨6KQIXp.֔գL -kĦ5n8&wʎ$ "VH "ضjFqݘ|#|ۯ/˫zwq̉FQ-0Zמ b@P"oҘw"CWk'T&Ug6*_mgD4mM spVMkZ-Dhcؓ(lD۶UU۶zuN\s'oCOٞiy}fQ9e =x?/qtkq7$|Jm1w(B7cy0x@>lT%۩|I[ЊM|ۚ[fa2J,VMkZQgdX~ vZyD$یDÄDYU17e\x<[ݸ[ ~~[lUWwQ_u٧CzG:Bhf,R r< ^YSj6ϒmT>mԡETlMCmqfK%NFD$یDO0jBꭣ%?tͤ7k }¢͟͡%btHbPHG%ތ [?2AojzO)٨mT>RI[OS*Zu[ TX-Da9߆vn$Nsw@T(j?LYm,f(cbAD^=׿#VK&Cm;C+w|}D J]-Z݉~ͦBlƇ5%?#7WzGʧzG2Bhf(7X w;ط7e+ZzsADׯBO6[`-m]E:E',^&mA ٚjA'V2VQ&u5;:x6S^]n@q)Ґ)HSgbQ`>S[g:p3Ajiۨ$׶Hy^o\ 1LC"GFQ>~Cԗ Y*)D-Sy>d>;B7CYe/bDft\mzU jʡȄ '{o8^ ={mYֈ:EƬ'-\$M҂2j%nM B<`9Adł_}+P K'"P0DI,g Ss`^҂vIBv6EҶHm/So/Z֥J`R)c/P]yey(En!nD@C1@VZs *^Z&7|r?>3;3ݳszgggw֮aw׏sZQN} ,'zr҅\EL-C bZ< YqAvЊL<-I1=P-5Dǫ-޽(FYoߧlAqA wX #fQD "t4nEn]Ur+G;zT֚ bPu$ o*)E:ߖƊQ(Kg5\e/O֫ZjxMKZk:>[VK- gWZܯ H-èC? Y~#DxoO}MS2TGϑQJ!詪7yCM*WH:QkǷ7?&)-< D jVZ݀ =j24`|ZOY0[=04fR)671dS5X]~TM3nDe99+Z-A#l,a EJtKi= ?L04 (4Ű Q^ Oh)9 MQϔBޭ]w<k?_Uec|Od7DvBd=֧l@9؛ iMJŮ$`4`g 5#: r yoɝw®s6RSk|*!_QAuD3ԱklF{KD!my9#jD]~V`޹HlY)(ʤQo Rlk{wUhw& d*gDڥ N=zrVmZ  N/,Z`ԙgUG|nW%HyDLp,7 ,7+iDG$<R 5.P #|x 1{oAӧl@9[" ̮kD*/_] 581TJÄ{Ȝ5c\K+."8eubcg퍋`N&e6ZC*ABM b3bOoZ]QٱHHYLȷ}$*8,}[]sHINt] "ϰqw躉2Z2FIfMq,mVүf7Kfwv ^tk╗ 6Zbo~E q_Pxo[mx A>D&cQiD>F-#%|M62- V jD &s?#_2'kqOg0I;_ak "<^Dсv)<Ƨ^!mZ,t86̟jT͙Zg5KpV}XN ^[ p4+Qb-* }AὝnA4-)peIx[zQ^ZD# la=O٘dY{QrXmҙpDAmDν&S[fmC!'ob| q{OK96\_[z,D׻y ᬠ\6ڭВ#'tp|w`j۳B6NQb8YTA t )O{x9]zQ J YSg6J pEcMZ쎠6?@/3ܜȝ:ƌтWZH=2/I| Aʗf ? =jWSl+2|n7e61_klf_uW )[ٴ}N{(3d D=uL0D&}F Oޜ@36yA/GP*AAm I7p,NJ ID|z}y+a6:9ѱVDb s~/g!2f$4~i;en[xAd:rOTlDz;3)pk!B[AImm`=O(@9ۛ86yA4dYF j*1U8NP<#ۉ_ֻ_)D0h4~[rGFyMz噾ǵ` ۽a6LzоK%Z/}(||7z'{}Zmo!PA{ Y|G!PV%XS6 |_:/Q_ g7CͿf Π0 ÄQdDڍ (: Aw9&s+{YT(yWZB?'%Y+n76RAv "SB穽, Bu >"6 |z/я~tY jZ%ҡˆQerҍ j$/3 O'ɅƱclb *2@m7#@Ӽ:,yR(uw ,URXNAK o1WQuXA{ -Mӽ!mJwAjX קla][Q;؛Z&- U)A S efb[8EQ.LNm ?s|i|;YсƱclbϦNjsJHz@ĝ^E-%a̝X V IDAT̘D(Ù}/\A{ 0xJtk,ލ/`=ӧlb];vevNa_ zz O0Q$');{3>2 - ?D]6A+3r7!v1\?(j^<&B%8.Ǔ^IOq tj&yǒVs" rwңFK@O6 " D,$.8O "SpYݥO߂wr0>ufK+AtJU<%?KA4T/ڰ߰S9eLԬ RWwW(sޫ9tb!|&|zXl}'~`aW?EIV *\vz/$ n 5 /^c_;ƄsH8 g:Tnrq.b/ *j qXIE 9*'o#鶪=SU]}!让t4~*hm2wSBKaO8nRRd?R[|0d d" "i6 g Yd7GAw _o IW6(:̣Z3j[hxfzn AmB-WwY&azdg*Rܨq1ƳY;7Խ -zqO쯢 ޔEC Ѵ#۫4΁Y]|y'KB(M`6 n&Ҫ%Foffrc>b{vUDJ[5J9w0zMJ Fcc~n`L@!b˱ g "qejf)B'zkm_ۈ4a֢D8VDZB?z_h ٍqQ~Z&/3?]ޑg2/a= (Xc.WR>}50&uĂ(yw޺mx\WlD u{ey06 { l"af˱doztH7ZŲܺOfh1Jc-A􋡧C^ӣ)"c#֜}A^V U},+eձj>Jt\YzD G uEζV-bۤm *p~u~w_ߦ\zSemnDgyic " Ⱥ f y>d`į=wV|тdLgQ!:Lj2j[]^(M)3ko[i܉?lp6Ӆ+uz]=~h`{[yGόUչڵg~k̿ğT_|2v-`+c6|1Mܟ&;9Ii =@*/*:ky9۹^ɄIIv;;ڈᘿy.6gfJv0)'SySRR}X 8$ԾWAك!FAq=Y}'IXGov8%Q'QN붧vӃ\|d eCHe:3 @ľm "MMZy1*N<sՎ7$lp#ȱކXA]TBj;(43S4L֩r4:&Hzj69UD{_"lz6'kQՑ^%A4 ʕYDŤȒ`}\dQd]M}ҾmYD Em\҂7<ڟM&Fc3{MBLك1UR|o z $Xp?UN0yBO96fp,&ZCtN{=dn۱g4-¾QXD ٕ(WVgEhM53Ar&ω TcZ{Ƿ+۷mK @᥅lߩ$o~0)q:B7`3#:kX)f9x8й1q-Lcjzn.:RGhz)X,D̸#@SqΩm C̍a;4Ȓ]㳠olIEGu$&n_bEywy'rfu6c%A *v7I ܯ&umEAeȼ"2[x(8'4 -8*[G8y6&]H!c%/EE[3CyO9b7\N4;:,"<6 q27rK؈ ZXa:/ Ө. ʝDՊ &'cNU:ݲm +v5r;#-m { f37H=>}Hu |Mi "emtkh:b`SNɵ/EFgH,Աe9UDW"izz+ )YBRGo: hᆗ&rgu6QĚ ZM&x: )TU\m SNf}6žk=܅A%`zKp1p;-JPaXr2=>;GV:,vNBߙBW"nF*ku &#(QD{_8Q6DSM#kO{Io"|ԍ.*kzOiu/ff%B{t;hb[BMpdu9HS_t+DqGYX0{}v|gHiJm !lg9EE1,#=D B#Dme)V X>-ԩe9\ C]\!'ˑjN|#׵s#r["nFZHn=ru%ʂ1Q. @ 6!]h!BhVK/z9X@yrA-w*Xݰ^~.3LᏫKM8HH`D˴YLdlaQbvzħJCZ8Aw|+1~+LD'-D&&fC(Zm+/d)ҷ?u^!{:lvNjgs؛{dL:Wne3tNĚ7G߬̍Q;vzk`d/pu%ʂ":iU ʥ2AҠJ:daOh+\XT'o rc5A$թ]L/]b{*ՙLFYLdAٻ֟(- }+OԈdE **d}`.(1W]o~n鞪:5=p狌էԩS~UuT7,wna]w2%b pxItzL{_?hq'&lGQjT)`_ʱyE'ApMu-֦!*@$.}X/9@s5/3&BZ D;jzOpV !x8{yU@t+nOJ.3Z}팝ԡK(LɒYeXo8?a5+o(]:Ө{ggrJV͏C09?@i$;;EU -( [=֤߳oKetʋ=C連E~59}֩ry!OMOu<<8%啔4UŬx߅<([ˤRTDU2$ FQ3) OqD `%h&b/J[{;3gfOMQ}![\_ TH@2ۓIؙyq"\ ЎvW% ǻ-۳t DF$UӺWLb1}@#la@cF; kioy%6հX]LU樳RpzDkO ƀQ~>Cn7+QD u **rTOusvw0_;au?7i֌@B׺u}XGt|ըpF˴ S/;ꢇmV xIt6jty.:~sGH=sB79:$SJ룲DT%P|T۪bD_CڋH$m!DvNNŶ p5=駷EM go8Vڊt{ZFMU:mNDA `1"GMwtgaL<1΃("  *ʀ;1v:հI:B~v.{pt@ĜY(B8{?&0hD@tN>_xWг+jR+&+9ؘjQT賑]n&$urz{8ȣ$yj)R )c(A[ɯM*@|auD.dgӍ)7DTޡn񁣦;:tZ8$J<mEՎ\j[|mSmoD!Јt:ɿ5p5=Z!-/+DK|KqsVD"X>$G[/S7+uQPqi)DRiQv:" J\m!tMD''UbsQ'cy"V/f|6GAjSط>nRY&@Z'ITǪDw1CQGg#%I3Q_*(K(xQ~Fs#:pDu}~K w$6$EW>7$na{[4@!dCII B4KpSH6%3o+Z B}SKs#ZBUluܑw'E3?"G8`u[SOaMf**v(Tb%YjYU,.|HNҜih IOd"Fͤ,Eh~*;u.2p$mq@l]  P&h D0}Y٧`lTg [%DD(.pd%2 J$FL/|>feǯj%Fr֜j{;xblU  GIt.6Ի7Jna9 :(%x(ܪx$ z佈,Sb4?V",XA:1Ir'HjSX5,3*jao1M5`Ȭ@%v^t`Dc> -^i|G&Kx %"z1„޻<4nh.wS)(.[^D-BPPOާ6s @YFsѠ觃ma-=Gk/Ij) d`y4u\S {6յ">dC;ƺ(jo CcJ&y %I>½.x ]!@!Zk̖S$CDIhSm* 2CVΕH~O+[˃΃y,ÿe]MAj5r*QDT` D[ 88l_L6i1)@k-bYz/RA00^װ[ i= UICҚy{WK2`ix{6շ">"Lp0!; O[J4jzOrmEx0{y]eska.)@@A{l~2"fלwO6Բd"@eQ \#Q'T) Oi-KmtJagR6`'QXP.?oTff(l㤒z=4k^=ʱNJ"K2AO[7AzN1W2)躬a]{J•D^DpG:Rp͸1$o%γqgNfk:S,3 ±@}RTMYC=UN 'wBW-Df)u_K`i5 'h J Fפ> 譖tqAD;w\o?zf:n)KIT,B:C`-W飿_4JN܏R&"-x9~PZs]/| $QKR?K8UA\:ILIE U{"ZޝęKmjRk]a^;LY,ӳf: IDAT>H (_i[c4=}K"ZR>M)&!TM: eD )LS:C xwYcՌ2xcף( Hy{}T,~D-=wqy qH[OX.+ԜݛpMP~[@e\qWV%aQ>y_(ς9=ԐTQA)7&/ZJ >UrS˔x#5b]k;ż)oo(8"Pi[)BJo?)fIZR biJQ6AduaI2y"%i_Ue/C(Qoz4@CywznO-.b%uQ/='J7](-r?!jz+fbӰ3GUU-)9xkh!tuʂ(zŤUW2׉ 21ԕ䃳@W"Ris(Uor[R>PAdu;.6G-:-n 25NIJ笠eƮGkQ:U_(yex*lӷQޕ?-0pR_u+PE6 䅫OYlA(߂&e_XS~f Aj{*h,|e޼V# Vi({SSa8o ]2(tZj0٧*!;gciA4N{^AdjW4-Y=Vkщ7v={ "`ٔu(4if!WDȇ]bΝ-;"t/z YUF/$  AA""@ADD  XDp T"@ADD <}=znI/Ld `Ai?n'9 sK|Ofb}{~h 6Tdtߍ˶7]S^]]Ϩ''?t态߾}&C9okzg&̑X#ٙf2| $NU1bVw"!騴Ũ9}`jv 4GQ0#QQAUZ Ih#qDۧ "W#S&4[AJ-e˲'r* O%VOlbXmgz%{@ϗ- ZyiEνvhU "#ы8׺#L\ cdq֧tP[ q9ehQTZV!XM_i/dž6$ "1A$%ިLvYȟfA4}hφ;F]'CɟXyD>Jɳc>׍sq=Tf=V[sOh?p~ʎ.! P-T+a݁xA9kïF$:Nŵ]9`kdqh]c+'w#>Ũ3 9ehQ Waj*P 7(r"@ hB*p?y!KK&y3cTJ:r(r6ڻt3iXl{̍H{ʜjek /8=ggFR#aSq3UFȽX2k4T1jLkjN0| $.I_qȌk]1ATSCH0y-@IY\_N`'+ct !o# S6]0ܾ*B"wH紈'MǞyN:q_"U٘0}D`[T\Gՙ"b)v'9{F*FMiX)öm " Wa.V 2I oJ1t~ "{Jg\IL%-m|SI״[II JJ98sg$U=l0#1,?Y#x% GREQQgZ3Vsʰ-kOBCc" +5N~_.Wpj8$_Y] mS0ؗᩡC'^LDˍ儜6%Atx2v3"!w-0%6l]‹;oߝx1;eA4KZo~+O}U~y/2I昻ݤ[ںotK"[D잳6#a!f%qmbs3\uC*N99~SwOQYk 5%B:|Q& F"Wn|YEѨT'/OV>; è;t&Qn:UdTw(Zz]n`jn<-1EE\"XZy˺_[H\sn=]Z8hU, i5S'2ޖTaD`,ꔱ,J:"DzrBԟAX]pOLh!BF1fy`]7ػsR|#mG3n--]D.$D6t}㸮x"T7n t6.Q5k`=ys$٫\܀U  I@ 5L ;ͽA`5U1ā~6!ל[ĔA'DR.Z= "ܢ)76o#0=˒ȺNY[0imP(($Bt`g&ej9!B(HKs>-{΅r̷l%7R8!&׊0"1BT[.7j| qD!otn 潗D]7'6陸B\BB\?U!]ݸ[A8j6\{$J9jז* DHfXt,K*m2kULimPKҨȭЁ!Z% B"DyFyÑĝ) Լou ɞNnHOp!JSofCI6FW"z-_G E/N&++N7<|x .!b! +bq /6l'ξ3׸(Zsx$ (!]X0SX*5`;o6c", >U1`ڠQ#[ B4M k*!Z4#D>x/ÌÈ^dάE(pB3C+ՄH%1'Tsǭr+{ c!D0~/즯 r>a6>g7җ67S8218-2{Cq9 _D85GbAڵ< nԺ-K-W,kU-X6%i3^9h!KOrcWK[ur?(Bt3"D徒w_u Kq'dPA vz|oH񹝌0[TJNDO9"D3pٯ~sO߳sGX7q@ds2 Vl+@c-K9_;`)nq`\Nf5C<ꑘr4tPy6`U>!" ja3F`,rR;.fT"`ڠQ"=-BDSEtZAΙGM&Kc賠%ڕ'Db6s6x\x7F[26B佃FLTbseqLMMώO?ă9 es:n6 r$+ D#hT Q\0Bd3AZ،y#t[:UۂnOxH@< QᠷD5zB~ъ!Ed$ )◽z{nuwA- yB$F`CSyBoQfGލYXօ#D !Xu].,鄍޸ A\sͽ@-^p #T!4 Ѣ J-GC}U`Ǘ !`3F ׳,7`1}u*n.0:0&DQ~W袖oQ[XWHB,.k+4C/(55J4zy!! !DD僈*in6n*! yc]oȾ wT2=H١@K ܄8&X`YN5#EAwҪ,-)l|8"B$f@,|kYůY*lAA@< l[mZN ў.hsB߶:B(ȫ>ev@{6ᒙ hoVbYZZzjM"!:7 5a.wMbwY+MHwwqhW O^_}P^jΑG'D*k Ϙ* !R`3F`L-+*oa*mAA@<"}o"M!DTM̃{p=9s@s )+4!z"; Db6 iF!E"D?D/zح:7JE@\#5%SAГZ/ep?F5#EA[<"6cbx}ˊ[7zԴNڠMC x =/C3nS+o1Oۇ=!!#!DaI'H1!@"S$Bt 'B{FN~YKE@\!.J%l7dtQ`_F!SZO lU6JLT،eEjo\J[imP!?GmA?h.!zIgC;a!  !9#D܌ "uL: 'GyiH\[BH+ ѱ!Z>x!Rל+G'D*{ y _%&D*lEײRPqmAA<<vP!C~eN-4!n&OQ!WϒH~G'H~EE!Dm=L)o0H]H:#@$+TP[$LmsxuPVeo\O쫉,!H!"h @YDAťAqeE6L+v69S~y{TVݛ$W%rl +2ZFjgM7Q1{[ZvsK=>6DǕ_=vU{cTI.z󙆈!"(]a2zN"^m}CNۢ7|^Ey}zJ/p=*0iHnQٜ7w\]f#LFbDz6!vVG03SH*YiV Ed]G8- Mu,ʨC aCOIy j }Zu8񏱃ROUc qo^6DR``298r& CīMvH!FX6HWc?>Eg+!N ׯWu\)ϦxDdZXC972{=} J>B"WJ JQxLZƜR[Z 2 !.?מ8@$Z f<͔k|<N#&dԃ0DtJTVV獒QeҬ Go|Y-d{P?[Aۜ 6>M',+)t T0ah: Sqك2EoX`H\ yCrĕP^]P/HA; }|-miufC92>؀Y%L!`CdMX\x3#+MZR:vf{a՜e-C>ya╲[sɩ0D;ߝ^]WWW1KCzԦ~XLQ_j}k}DdS&**"ռK"_s ŧʴ^+)u$ڊ 7+CĩM|g}ZY]GmQ%2vwrFϺ-wٙB8WqCkS Y=l;9]ɞr@X5gk@}`=1,5ﺗS-a>;~Wwi TALCWcǹ0D:s{cUB})C@VMȞ>6RNYT5M%ҮDzVTh=d !b  \El@C𬒏` S*!)Y>Zs稤?UYZ(WgUb3BAJg۶KMؕqQ~hPk.]CD}8A $ /_\̺,FM(Ii{k]6D]ЛL_LkcejQ٦ F{OGᬇ9>#P9<^' 0Gej2 5DSKѠ//tYLw*ܚ;(pqT*K<1Dy@a)ԕCaf*O-0qB2vEe0c MUM1Iūh9! @kꮧ Gb?4`G,؜[)J?a=xWyg؆;!REr6Eůs#zT5OAQc#CQ6 'jXYHt^ hQ`*I1K_3DŽ |k& TAdD[lc*9Q]7Ϙ!""loM :&&)rM~JskϘi=?q[1*n/͏ϙFF ت@5uJokXgL֑ 6VBYɭhdĥ j]w%DHNæ`ncB8G*W7~jNZ{l煇!p=s9{LzeYVŁC]+| !j+<I]m99s.|v}e+WiUH4W>L1]f!}=n9evvv^kBB4b^]+\8p7 J6B0DMl|"# 6|N`7ojR|J}o!rEvljڋ`[ zσ8FG탋lz&ko“5Ṝ3R*J_EM۶)B^.)Ǹϝ~j4`q̚0Cº”:Cuxy^0=lɔz K~Lj1LtAe'7O TBO"׶nƯMxk0# <6|L Ak8ڃ/Z"IRذk/SE#^h) j< BFHƼ,,7߽)?_.<.Osس6x1l lc)JPLSιߔ2+ N!g])iCHP~a7~JԨ%uܛ=iwfK%Z zmᜣ%]s@# <6V*iS5!S|ˠ"GkX$iKaæfO xЫ*Z2|4th}TB)ΨE#A]󸌗7p:uQ"!: Ʀ5o" 5/˅Lܰk/?vp*RhSx4EG&R5:n|NԜpND ?o)B4CC 7rO.kUt|6\7h*D}s]+RoV͍?]m/).u-j1uؚiHI9_Mh]ǵng,zBy'swLܰkOCRSx71c ,[ wB "f-l׶`bd gjz* ?VWɲU!";p[3ZPݴpKGM q='X4Gw K 8X۲өW%߿!m9t6^M% v&tW)i}Hk:]ԊKKSB'5nMbEZt_$m-GlUͽl"n>WY"5[;0,ND̶k4%`nfW w)hxLjxӃqUْg"m|KQ)Se{VƏ5A}J FYBY}G~ Ajb&aUe oz'/Yhdiɰm ӂ AqtA}nU JjricR]'2-Fq'Rӷ35SGI[o1ZCA-5h_ܔh3l#Y36Ϝy#S8" Х=j)uל񗓝om9y4mi5ϖxjyjL@_g>74P{~q<#m,f6G0=xz'Q0 h"WTwuZZdX3#rͷw*utbMn{/4 IDATֶەҽV="IίR+Q!P1~e?~;P*66:cEi#ظOJUvG.ts2ٶ#{ȟ,m= k`A4,fkf՝%mOeeW{񈁻/v#Q.Yĥݕ˫њ_TvS3vCKDk#ظOsn>HiՎh=<ҞtA m"7z3bG6f5sU- kaBյDKӒ;iO`J'Λ{|sa*Qcώ{P>:9  lܧ9;H}Z,#Vye_ui]߽ƒt[2ٶ#(kL޶Ytۨ{ yjClєj/E&A3(c' qX0J?sdۙ9bo=q@ mS/v\qD}3Lr[ &c7imc9IeSȸT#|NQ}rвWr^%:,uS:)lD^7Fc9"nu+[`RL\U[[z.+W(^'K?w'q 1)4ĸp*S F%yk6G]vNt*{XoK^Hg1+*eHj>͙"{Ƿcmn w?,oɶAD^cD05z#0Q\,.<5s\)?05/j yndnI~(?3 >sIL+/Y?3oSO_Dl5,c \`jBʌNe+]f۶~XmȢgjvX`_O޵5Ed;-DZlDeDEe@ )rK,@(xc8;pCcey"y3++2nFvUuV2w˓dn5PI kfm/W ۬"@e c~W?# /Ɯ?TgW~_~ՈI,GsW n`t}YBGE0 Nz5h". =m:E ԰fv_\.[jYe>3+'®ǗO*,{O|wNZV0x[;S/VrtybCuY<^pZ~!ҴEDjƳBY+r۪&,n Ez*WM᷁Y$.7?Ke(VKۋeztz0qkMQL[ۮ^GE0 z5h". E6!\RÚYi!4Ϟ4sjb2$_+{z)HR(#㹚7$|yDjwF,ogosz(M$H@KYǟҎDl E"rHP槏r(B rx@TJ=_M㷁v0|7_Ke*/;_i}jBE{\,8mZNO(‘@bxPؤergx_ǭřGω1vNg=! AP!TkK&Zu://D lBdn<ˉ5,fїklpCұGFXs਷]#aE e]8wl:B6?Qt7G4lӖsC 9]'=CQeͷ;1߹iΕ6u4i\RqJWkD:«:rRo6^"D<5B&bJbŽI.o"ar6L5`/U߷MqoA0mwFs=k&Y'D?D!U@DJष#W xBYh3I kf"Y#~mD5e4-e|OPr,TjŌT`O' ˓T.wen!~54㍾eG6!*S%,{@zdP"-qыr B$o -࠷"kۅs“@]LtW q}#zŌ*5P;` ؈jN״4=O/::@\W`deN!J@.{Wk,od:y H-,4vM̮"-*re 3}z |aB&'5}9'-Bx艌pb{ C|[ZQs_gigH@[`AoDc][R=PC܊EL LrPY"ߠ ogɩl.C&%ղqE|#DWX Y$Lաv${[< bu4blai!8k`Zv#K}! l˯1/E 0}ZLMr<9c-uQ6-4(I*om/*RJ/J:%D'ɲ)E ێŷ.v. $QO+J 6ES}kl3 傄fjsz8]-Q:bWG[WB3&v<>iW>`Rw^Ֆm>3j/{űaX83 wq! p@Q#(%F85&b$/<םkTUWO^fW{׷j)W/mJG 77";}Q̭i"P}0yLPS0`Xc:zL]KN|RvHƛcUwiS ot #sAp,vu;Յၸ ,0߹p{eN^>4DLu"%QA4j@!s.3tJ=砓\5_Ado:jw5ɴP2QPLx2X,DG[5׼"VwR aAt$ '{\3Kᾼ|?P()=wUsL}+,Ε'eI!ADTxE 86dnݣ9DhGW-D&gQYʺGHV5' ^Mf0eLɻϥܝE~a[jپo4#w'V\{J*E˩Ղh\;?/o h57.tu('{MgVDRE)XR^?U$,ȁbLS7gW5φ1|Zah, VCt88?Ќ^ڎHR)?R"rIʯVX1%O{rcڄ&AͽolƛCݾD&^:Yi|*̹=86L63E3OG8/U~ηɻ0"q@.^#V6du IH7Nt*f"ի菮,=!MuhQ`ژPo$4ն-=+O{>7S|!̮XKNh )o B6,lkՅꁨ L|u2}~OyJӌXRnW),WAfPO&e=^e'MTº$6QM|1o ذPVBUeGͶ=7%װWU h4R~{V).։D@%UbY#Q{B'NʔTIE/ Tyuutۣu8 M/ƛ݂)D&^J* 7 ɇM%6⍓\fE{ P=DKB g{MVrL %g40=וL:t[JyM7}mÁkJDUwЏ@HQoKqy8ˁ>2?) H}M)p.Adnx^TXV h7 bBV,"~uy (m=~p{ӯb?{Z[IJ'~OAADRiP\y˽oC; φ+cx61z-Gs%ڻ#ͩk4Wv}u7_jSNǾZK32DqdgnonY)v"sk/awMTXM2ՂGx/h2u6HR<{` cF.4=]i=^i>{\n&g /uӾvF\בk+W&f#~gg*;w[ ڦ/x'fes AA""@ADD-..B7Pht.?wz 'I!g;/'(ȹon'bp[+{yU~:"9zӎSK::Q ƆoVyh6rL" (>鵝ӨS5{ۄlXL+cbyYYvIc@7}yHYSШS !ڠHp eTdɍ9zWkfr!r;T}p)6Ulj߆Z8fzm4[d=FL58()2t*јUօTߍa[n0_ƒĚ{FU1lg7Q`XyĺS&^74Gƪazp?/f0`WŠB򔝬 ) tthT1AW1:XqItk"I*9dTm&$:*ަOwL&<ȫ-ang+AO>xy: 0gN?J#{8cjQ0=F8y6ݺB˅Maq!rH65kCox36ef=FH_xmX"8|>YgC Acnn"hp<&e?_Yv H4At|wi[-H ot$Cc&$X lm?PC6AxyZGPmp4hIT.cw%+.-VwC j.t{t|[ ٝp )vTlj׆^8fm[z >%A]){PJT(Zӆ#ˤq Z"G3|+[~I D⸼8zl!"Ðg[_`omc8'䂣mim9n}u^i4G3ۃѐH$ݱJ0raI:z,yA3!<Ƙrlh A)~OFjY-wzA K=W`+xF>-r IΌAv=+I6H,QlQ&C픷ZI[xf-\bZ#;~dUPU#^cUp<%n7䂯1­/jP!2dl AHїUĦ;v EG> و-Y8W A3錂!˻ H3Tw{k59 v6cZ{Hp2;p[aW IDATAak&A Q_`1 Cfܨ!^>_?{tT_NUu\[_t8Ugy)E[dPS#UMe NtЈ[VHjp>'{f/Y?!Tr!9[5p #,B;KQfm~OCBux;5 ТugfoO6\j<61rh (ގy}پ0p+-/$gm {"|rC76EYfpAe\{V=e8uD4;JKЈ[c,M4*>ufo 6Rֵۋv;voC==Pݎeeyq_C82r64k@FTc22U}*e?!=BԸN^VeNćKKk؁e:ChE"LVJ*,w61c~1|$DC-.VY6pi?ZIzmf 3KM:^IH[(TB#n9M:tt O~CΓm(QQua\tM Bg k΁—g^ЁXQbůq!<)[5/#(1Ci#z9Skݴ>!"A jQB.щjr!/W?}NoV>dXh-dzivZGV *W1Bd)`EdH2uч/bZ^q Ȳ_cC2[f4##(1km/bH!DQMBԲV/E!̟ʫG\Oy%tDYtd= h3/ :})wL4'Mן]>p3t6 z CȌ.d "#g󨥂22hȀy+r!bZOFrHO| ֭܅8Hq@ 5 N=[:d"d: v^% צYiI Tp87נּ'B%D,Q"6]!`4@sMhXX/SzOٺ0nݗ:kQ8@Ⱥ'NWlI<=|VBs"%`2.=kmgutlH [/u}:-^"D6Jhf;@+AmP}ԡ-L?I#o UEq'"!#D! lJü#D?R1=F~OMT"!'D^7kM!jHmEFB$&7 PtQ:ҿkX(_+$dݛCzbWՐR&\=zw eeJ/Jڪ0MQX=!Xc,XL!D՛Jڳ6H`u:Ѡ G$/ԉ:_w[UH/WPwB}v@ =־!D}22|BVDHk!*zr!zVUgrsc4U)B:BtfYM)[1`~j+kAO|c}'#ثqYs 3hQ3aw%DCք''K#Ԡn{%TVn>(3^6H`uKTD[<,]M7fSσ DN0DBeH2x ! BԪ~f^%juBTXYNOb5$?qC:B1#_ `607뺐 =M;D0֣ȳ Dzbv5uIVƕgodS7SE#dY]!,J5[[,P?B4VEX@]3/(5[kBC$dP[4!^"8*V<`O-7E=1l!zd:,])WĞAs e%N[P75"r,P򗹽.Y,gxC KE]PXmL%DUZ&DN0DBeH2h1B>\cO0BdkWG-ʧ| !BKK{f6q3(D=!Z- tp.A9s('% HF">HMt_LKt!lNZGDm-T|acowF ThXC擡"'"!ԢeH2X1 B d=g}$j9W.knն>/+7j +8=n Df0sF01uYs&\3gg\Qb-'iMC9 /}8;G !~->| #  6o zDF "*,ϧ=?S8O s"PKaI ·I"4]z4h8'r {"'Iswlؐv5azvd6Ğg:pJ;Hſ4#Ds2: )5T|ذQB#NpD7?NnBC26o zDF W LO6x1S"q@0khB8Lp̖ DxiN*޹=Ea|'38dA-D"* ,XOQ\E'P^Y{weם0C2t&LF d&o?t:~STkGDž4BۏLE0*ZSۄvѝ}iATf߂|IBS z#DLDt'f8!!et۔oX` c 7e_+iIO7 "B)D;4iFOI][ 9UXx MWKR~D1_$.éE7cQөtv_?8xvԧ #At`K;S;#4r^&f 2mJ2mDV3pQFdAIX BĔq-,fBD~A4CP(( Җ ë&F}jATFn}[Gvӡ+*5M/*H&DVje@bܸ RƗ.$ tjf,=?Ѫ ~xe,A8_F'}-vwDmIaZKmӐAtXiE]lAZf:Sp'#Q[0HW6]T6["Y^E,z2B%)'EZti&D+uCQ:־A-ʯ=/:Jמ5uص}Xqʥfk XLR'n=B) X#Q~~xe{Opj[(< bgK˂:E&U"JFOυ\Lg bgf?\2:mDVXe^JunI>==dCVy6mw7C=D(xNDk &N V|WG7,ZkwiG~eze8]^rֶ5+[uvY՚zf:S'#M~ݔ_sH}2fQBY^,QWFL/]HO7 ̳ZAM=TڭW~I5 zMr5~u#(k^ULľ;7nܥݪ~"v ^se8gHRFf"i7 "@Ħuý3W3ϷXFs@qsezVSeL V[?sP ", 3\/]iHfm;4>TWf^.&V}wҬ'֜}2h˴Sه' y1-codpj4vi2˂7o&pDCKBN):ug9["Y^m@\|@DD  AA""@A%6D )_o"@ADD fuq> a(4l A3nnJK}{ڌbI~:&IǓoᦹV}Gɳ/_c354Ҷ$߭4VoF*HLŎ3rAHBl'x㉳ZTTJZ*ߑNr'%y9 LGUOdD.}f!%ĈO 5sTKoGl?.3:>Tg36eVV^MkmxNj a+|00-ܦIB1? Q\e)kjF8ebhb5m,m1IMZu}n`Ƣr/R]ij9Q9 dmT_|~_̩ɹXaCQ2(' 5I_{FV_¡8:1xTEEM{\lGT_HT 6oS>~H:kTѓN ߭kJw-hv&JD:$.vm+C%5Mm"fYB(1YD4I0- J*$ٹ8Sf28e^]Zb{sr |#=V_SEO?m}ɀ S)ސc9i|E> 㔵|2R¢?LPҘ k/ :;BM f}ɬz:r{IM? +Q\e)jjv^GjA$_.>g5yHbq)DK%ԣ\2 tPAj>z(YDJb8A7N*h~p93tusZLF,I}t'ijL{z|nutlk"{u(fTGnt6-a6MmXhd*Laۖf)3[-"| jT:uS-P͓R>>#qsì xna4DK['xFomѩlt# ƜTЍm@( jc<'i4JR~dfJ79U=ۨHtfwlOw̐6MmXhd*LaV)xV"r[@O̧ojziyJAz\ "9t ytD!CHМ\.r2ԝ#H94ef8xt Ryѳ>rձ5m>qacLX]SKo G0zǸ(** B(Ǫx (|>.t%44v?m}o[Y=SUSY]=33f!3=՝]_UefW5h?MyD&7,N D@458?8HKI|l\=2w \lg+_JhZn6[ɬ\$D*{ǖ7î 8.o|t&(54Gb`w}#wS.?,!D$_\3w{)uS&wH-*Wp팵Vt\!Mc cBo˱oٰ\ ,o#e'mK!'fG`gs9Or*+꿰!aӠZoI$#F[ػ.u>~#DWxW٤ioDafìU9Q-3ê^r<~\Ez0q09'ڈ"խ޷ޑ=^. OKMPki )뛲$pt(]8ULgH>74ba<Bowɷ}ٯ+AQޑ=^#%;!c@>mJz,䞚H"vɑM'NjUS$8m/Z?!D!`6w H||Gi*̦:}õs"!Z'͑zngm@oЯ)* IDATtH$D {{'o",9s6 r|Nנɵ9+D̀V_R{G|8 [@q#Dr q2a32\@:+m)Ge!DB=Z۬xڴo&m/[&bRTJ cF@u#Dr Z0_l}3ԗџ|<Ž!+*TtxHۙkj{ZkY>zv=(+?oAr)񡜸[Q=+!Ofz6 l1՜ (uЀκ'N!DOEkS Cϼ;$)썜0~G[܀~=&4w%ə!sJZ&f+>u w')i؀ƽ ri"Cv'+I{YB!=At-.Xأ%ţXF w\kEOU+Z'&rBCV'Xx%8 qxO#Q-3͉$ rLnYus>ھ} (sӢn 0+2UJh"tB"~'Hw=߁/0)}nrC\M(`.66Wvɟ>tŔ޻CRz{>`%%Ϣaghl(4ȭX'bQ B"9o{TL^XTHۙkh{Z"xm% QkrCzD< ` .(vCgs"||!JJ鸆n 0JѸ6A(A@P{[FNh(/VT@sJgZfZ-n |RBmj4|W>k ZP wSB] RPBĔ`Lg;L38$D(@e uxV)B÷ *kC␋>2NiZFg(#at:K:ٚ.h:rR0w"n 0SVq!1;"ޠdQA؜G5ơ1;KAQ/J<J%]an &" |r.VʸwχnZ&'6 ~9&D%俗%!2,A3,ďkFe @Q?ac ;5!B0A D=RB.U|l8k! QY_&^[P#Cm)~?֚0.N Y5ڧDSkߌ H`4Bt"e-Qô ${dKd]/n InY{jE у $}A3pnԑ ʄRD*YezɎz9Ƕ世GOrq-Cτ #,t{pkHnU}VɺF<Ham2*?ڼ Z9VRUbdD/hRrj!6(w(r :`Z`Z7l8.U[s2ZR^ONx%Ԙ[tkIF}y uEIm5fj"uLψ2´CDpр.Vi/ax0VA¢ ۼe~ ܏>vŸjzmV62X)%2L?'}A9+nzxGyj6gQ&H&j.W+ҟ3p"MDژסqf볉/{~N-!I=mQCD`1έf ADoѥJo~zBodeݡ#Ϝ b~ \m;+buX{kn9uA1&HDzez ^hA"6z*HaBY^`.&gV6BNVߩiS.]Xk{3`qSrg點_ujMUvY @A$WǥӧS5 BADH^VDװADH>C̀  B'   "s,!*v@AP!yGݼr^ͧdlAైdxAAA J{.@AP!yq9ZZ@AP!vGS# "AA  ( AAA  HM  g "AAP BA "AAP BA "AAP B g b|[rm>݄Whr+ͶEQl6_,?v}dmm Z1Gp1[4#eu(6Dᓙy5;3w/uug6+Bm)D IBLy$f̰@?\yusD{#^ "[P9HÊ*-^Uynݘ-j/4MX\ߞKF|>${8|=Qil6kb{S:@mX2LYQjD;O M[x#kp7f>$˖=SmDd ؖ˭㭤3ug#7$7z3%TN8`lQ{֡m*xQ5˫Doy6wQuI P;' $+NVFux?Ю襗aXʹV -7vggܻٶt(mekJ,Qu)(MFo;!hFZOk[sތx vc]mFsM|D}J{(O#O{XƯYi7&${gZ{Hp2vx`pP"G@.:/b0 F KrMmUtOUO5՗M4MVO][xބi`Bl\obBiZEFRj267hfn&cdipl*,6K,oJ} H?k&ozW9R!-V2i251&aL#bqf1u3hՌwjʰX!F(19V9n>7Pߛ ZmI&C>omڪ})AW+A?C&8J+x؂D@}kU1y{q\uR{j%,tc(R>P ฉ"ꯁ?|a"YL~k S5UX$@5R>R|#Y2 ZMJE>Y7/U>^ a7yD٩R8DѺ-]LGvfمݍU[k7- "~kSc#8alGlP}D0x}g7VȈxbMQ_h@* @0ouQX?8&bWq+gI`(|BgqMc#9{!!`>[]vS{wh۰!h|`oΒi`c -|uA6 UUUm'yQvށǬ/;>}PaF{FXz\\9f[#f ͞@ UxD\06 o#FОIԆޠZ c38@7AD5A$<)o v ,zl,v_u16E/$3_K'YAnV~B"gh.|/~ۆ7[;@*؛緳dl7'3^ E5Ӂ #4P"!26W笫_v7H*6Ip+uDvT#XŸi4mIPQtal"P) B?'koPLCE7AD5A,C9nXTO"bz(%2b2] 5Klg_-q0 1iƊ޶=Oq @>7z5l7'>26seD}xh9aXi=G鱆:?\͕sy0P=m ~mvi2MIK3McEц!@'_lP}#3:u_gry 0?]+R>` " w(b9t$؄-8YoCiDL D3{3ddNiTC}*r'Ʒ auBUHr[ۆ-CX!|`osl7Ohv/C+ͽ Gɱ Qc!#w+;W9wsɇ׺n!ݙ_л+wiEPL@;s WB cx_A6TLprz IDATj3/wDe )0p(./Zt`S2U5 "k~Igd>)v$ 7u5ĮpRq7ԘABDix+#ClЄD@pj;A+6cObϝ`3IWF] "xcMQ .qi.8~x"YL ~ALn7(BK(D5bNsƍ4*ߨckTR4mCJ@S@knj\ o] dn7EB ԺelOA&u AxNܴX|ɒn)A$HcRw܆#v)l3嘽j9 T}SSZԶ]|1&x aV\ <:0)od6(A${btD'݆ظLKy~58Ve8ĩ "+ڶ9&xGG|ͧ7^4 oW0SKZILelNїّr:dQ.gHP翮.o2!ET5Y*>RSn;oD4t":`WlZ ǨUf m_{]d `tZ\sQGE#7_MmYZ{5,Y݁دeA,pLũ)d ]H-gkC'C "2\ xN\8n>MJAy$&mϲ+TD as*(;muJVg̰GGTLӯfoZ;IuqCAfe FC^t}D h!EnDez!ᲇ ܶD+>-#7_MT>'[]{AF5Gf1 X;/ b1,Db ]17 !С@(@o6sS{pPA!RX-_ueȒ>[ÎfZJcƚ<,qSmĭD4 y0jQk6ONϴT"4g?g>{ŦlDdGhbMO(22qЯ:#DԶ @=>5bNos~!b ]:?iH7ķzDI p2۰rK?n>O5[QFq+"VUr,qf>O}uwA*s殉bD4SWu!oFZMH s,-O'dROMH~]>q>$G7}`XSRL xYi!zandL ~#^XvDq(\xD[WAd[$k@nnjLٰA|eVo.ͩ [-04{6Ay^#]E.fl͖ AMNLt":`.Ĵk3֚&^ڨUG1UDn#T)Z>&~Inw|چ :0X QL`$,a=`)@v49iDBq(d ~o@[i,`yDEcQSA2˔3LlUFHg_mMN )Jޘj o# [!ZkIÇQhFma6 Mq®}eXUn^fݣ3sOOۦ$z*Iz$\Y1+?h$n !z#`m?+c`XdA"ryh`3ܲnWP0 Q"ٕ"C՝ !*5YzWGܠ<= !1D!'7Q`\iX*vRuƶ:%^ 57!" č+o]ޟY2DR Oq0r'R"_U+G  x07biXvQUwn洒$lv*FЙ;nF?! q4~Bd/^?[+7_b&nPk Qt: #fn QՈ @0[=}JؔkӬSGf::83ʙ!MXn)Ch&~bG  x0 Uκs'сU,`}Wc]?t(R1zJGCW P]!.9όehܾM*Cx mfrpU h͛!"p *ksHRn Q$IWzZ$teĴ]\CDwCt||&, )dNA,Zf8 +Pc`hWrIt` X߸hTs(e]3cǧEPT!iCCe5s7l=Ci7[bfn@k 'y% psiUAQSխ^8窩?YWǼC$,4ۼ`M3p"sÏ=n%!MW%bWE;ULǬ~|;V0 OC/kȒKx, =!r3zyu*fWF5>B>jՅ.>&Y@M[:;-f/@07ɂݼ/x }'~1M;ĸPKXַn 4pUmrQX+::TԅaxR$!zK7%57ESEONzLLW(z`KaͫCcFoͣ!&h<Ԅ 37׆H߰2kIE4FTssZDҸu=vnVտOwr)y zeWDIfҬ vӑ, 5 lnfܝ]'%dfb*nt+XCTuH|8pGUԶIAbсU,Lf1D|:-(P1;Y[NR0D< a)RyQ~}5:1GCdd4 Q;/tu+z`襰ԡfr}qw 2؄ 37H4>9M DdC~PSLꎈSOuO%jen[m7th{` \9dPYx;an -5))WZ7ٹ)7n'eJB8np\@6e"[ba7!GYmbQmixuJAWV"XC~ƯhMU_Jk=՘ԨZ(i=\T6v="fkأšSʚɍښWCɏ&d7DR_E*_b#0G,Khq) \)+F]Ean H|3YW }=-,f1Dۥg#rpNADb!7bP]sTP !p?w10-2b.*gYwJ=i sRXsPYZl2x, fn QJ;-2ю 9x4wbkA4ښMmnݣp QtuwTGLf%!x5T07&dsWamĬ$|PJ0qcET.ܔkuّq~W2T,<U,j|34uanjEѐkzFW_XXS˞W=(5Xš]ΚÍҚC^&¹D'ܠpzN}mKgJ'κRf2o>=.PYFEѱɿOŽ'?ζE51Ɖh u&KJ` *N}k"PTfZ?fX)k"GC*|dE߲u4pFWș[.[c^:k7#֚ C@ 8a;@4D7/J@!B  @ ժZv @C@ u  @ /ɊD7@ W74|S'c0hN Q.^c@C@ mP !b/p/C!@?!B C@  @ "˯@ @C@  "@ h!@C@ "4D@ !BDZXkhɥbYl@ ˷1 hjynK:ZrNMY-~{p.*>ͦf6f~+gS:?Rj lH; N52 |T;7?psK3tT ֮pfC(+{Cm.)M^Hd/[nVl?P#+CDUב)cVSϹS>l*N۫TtTHo—=G>^>RJ d9Ԑ?e.9GU+}xBbO+*GKZŜաDlX&n\%BIԐjFu_{x'H7Ϲ!,՘jGvы2Dtnkw^Z~6__z0ۏo^ #0YKV C |uK!6n*8W Wp93 ԌH 8ݪcּ:ԑF!zyYo" pIfnR!bU+}"Y !0 1" .oYW9tc] > jx-ꮢ ~"ULQYFӝS]]UUVMjZcd-!f[< ݫB1Z>aʼ5&Bxu6ot{wö :vhKYZCAMN)՚MCV}؛M{UW{eR(s1sc/ %bC'y| (&m5 hĬ%DsLpM$m*ck=|7iǁUUń*Ä87/j Oo RI?.y"ĶFR Zsy>t ,d/)p.qC]Hfe; jXVkF 6Y i/7Lk~jo@ zR4 sc:=Q fA<>ѽx,פK6͝1NK]Hm* 0.F{}I.>х0a" -s|`4 %QLj~N1h !jAk8f۴Q@sְPAޛ>&7k ōܪH{W)(Ʃ:EISsݰ"D+P@JkQۺ\7 ݨں ֍V D:`fϙ-F!x<;c盶p 2|O@3<+rZ?R[AC~F~׫2*-!{dBta%!LDjsij;h)/0\ %QLj28 D#jBTVWqґͶi tXXVˉ .@̑p?Lvܜ V%dۯ[Ib@Y)h$D9}֔^rk+k68;D^R~@7+3<`xO W^yPF1 ]h"EiEKya_f|LѰ=QT(ÉS4Ҭ^%D߈DN9 yw>F(%\&%X=Fl _|ȏsKmOO6%hey3bWyΐVe^JBd@W%FHTƭVvvDXc4/fdн(}CNQ fvം*M^qUh9sK)4Ѕl %D8Z ;x: I(_DYSZ ;NHz}#鍖y恊¦9jgO"DtkSF q"hbx%rIO>ťo8ƿS3[ZACa^+r(">לSM( -"Kpf̱n ΛҰQ~jO jRA7&jl^V]Y&b(0ђ!O3DQb! QLj28 D#UBQ$,.썇xsn{[}50=~B1%Jpv]!*H!2>RhdweiwP;O,&ȗ> D[3S N&ל}v*J] (+a3pbo% )|:E@We*H\˥OSP E&Z1D12#Dccc]SvKu߉hPOT@z}#Rn󒸩nV1;GOOYq[Jzby;PB+Qᒄ}*B4y膚mfޙF%O:?=j0sLsH!vҺ6HQ,,W=<ʓ!N6u3e1k!4Y+Kqў9~SVVZ;" !+'U-0jG]0E#Cl搀s⊈crHR,&c57Q}@Aˍ_rCDd<#S  ~1U-> >C4iᔎOD[{q2, "ps Wu>欽> nB,&[}9Y`:5vö1ߔYa֎P+;%A^ܻ3R{z^مŖY"(`pIXLjkE#l5 <ԿJy r RDU,tK%s̯] j\Q>xvLED^4-AD9q{ gU}YرÃk'NyNOx50YpgL6Io< rau YwB{0]u骪"ƝbkL -yP1R@绹HI%YLj5D# Y+PM$&L^o*aYm !;LT{պpo-c+$꟫9kL -yb$Yf0[ʀsd0Cn4 ׄYLj.P~Q *"u1Z4)uGVI xq]Dw),s*Y KbD)2;k֞MpmAl5qQ] A4MΏl /dsαUܹJ^oj:.8?HA/އ^ "9,:[଻L?߫և{eZHtױs> A`K&`'0uuP?:}{WĠ,jv{"'Q3nNj_MND;L}v6w^ӱ";}K %~1yWEE4'QC/vhbZlY[t"mOɋendawkmHd˥v뱙#Jddy9:]Is۪+rFRn蝳+`K]A;nk% ^/Uį%O b`'rQ~γZo)fR|A4i\?u﨑slk?VTVxA,b?TAdA.tbm#ۍyZ'dvq7mVou}j K)Y=iUoqZDOq3o뼀 2rDXޗ;7p&?UU%AG9+)k57A^N+rߝQYʮ!kP\ZWܺalU) 'fjn1 n֎YDEyf^mlM/zf% _ڪ %ԯyK~S_ D?߫֍{`LAcC`\H"*%iEJ؞(b`5D@罦?Zz6y0ݙ [7>kZXjJ+\?s6~qb(Ifm"]8yTfT\uOvLPrrK[͍M=۲k5nڢe꜄A/UazkX.2fKFXb9ByGɥow΋.@ r_Bg!@ r)rg@ ۪~j@ B DcNU) "@0b5 P!p9XD(H$H>I  "@ -`] P!N  "@*;5M2Dn"@  "@ ( @ B @AD@ /D@ P B @ D(@ BA@  C]4]nZFDܫDO.~7﷖]zwhU핹gɍYl'd ]12 , QF!DK,\e@ryT@PF7./?VuOtԩn1>}ίO:U tg˽;zc@c`ǖfc斶>ҁ08;~@1J7W [L=|@j-nMک /Cp';k=TID^P9Der! jvw&D:)].fTq5X'Joof@tXrC#E&\"gl(ٮkZHaLsoGwgȰ:(AJzu6K)B=3pcNQ*E~96D0 V\P/q!M:MH.];O'}6ڒ}\)v:D67t@ ɠ7啒uM-9arYJcH7.0tK:>DvYU5-0RXB1 \C0Hǧr}Ȑ֪TJ>5J1ҥHjs=/vWƱLNQf jr\@ +.׀;ˈ?T"NPBA>ۘfRO5=CV z0#C3AK!ec3t`:,b̹ ԮE#ߜx`@%"!al[hp VP  }c }4NhB|jХh͈Y5?8 :y5H\SRq쓎}aoI׏ dU8 bqmK6kiߔh[Cҁ088 OR{H7"G^&|$l BkdHa Ŭp rq9Do䓿.Ǿ78$ps=oCd+Og9DAYrJSM8Bor쓎}5 =1|[P?VLζьl,˭M0dТ @X:0%O59@H7IG,wWR"5U6G!z֎ DRSɚt{s ќfb)% 7Grm -nnp]<獼Z4w1A8M,!Þ'4}[[}O]3Ž{S\ (eI6yx9DdN?W3ަ>w]:c_`Rc_U>t$hdhQ.#eGEqBmq}}RZU/YX5t$04fێ~]>MOǵ1'̏?@jIwb/0"t-dB,i趽ZPR|v<`WP&&CR tܩ4kd@Ha ,q͇Uim>(v::L}Ql.F">!1l8,^(7Wu]"$ IyAܛ4>%èN,o^S!*#9#T f=߇Ӭ+-,ۣa2Y TDM5jXoA:,_n^WG g7Y|CnhdFJc'C\1*6+UWѵ{Up m؈LT4fE2ktld9G:D /ƍK_}_"Nl0̀dCyM.v[=)$}2ۉP-+N$mxs}9?OD[J5Odj!Z[jl( 5yb@Y׷]P.I+q.vǵ,Fos݃UjA(C]׋@ѷDސĿ;^hk̞f-H\ĩُLT^m>M-Thˎ_=IFV VPn//#ߟqтt@:C'зa |ON hLq)~Α ln1o?~j_H0JKҴzB(3rm/orMf#0QY:TUr`T6_^㡎T1G?52Z@b*im>" 9]ylA0L#Hkߏ o[L]7ChәmΟĀKQ/9ɽ"C5%2/kQr'&HXfш0PøkNeSWwȯZA9У3 Lnsr&X t mr^~czxDeu&kBf"͗ӾH~Ԓq7),%XšoZF!";D!rA< j4lq YJo#ܸ)Hp/fREr"aHow W^f8w‹^Eq5. dAF_@%,1h4ɺ&O/oNUwO˩g<ԩ:(PʠjM4&)J>v;XqԭcZ< k1܅'`lfWzxOd284׃>W8Vhƕ?U IDATI/"4Z`jz:vC}ʂB@9Q$DTV\xzeN\+n7ܷ't=ňBT(轰o%"D7 G u aU|i5rM|(9ݮ$xG=Lk+v[+G95+8l?JOS5!hi~¹oJc@T"}\ J՗$e!EV>IvcoJAiXN48 fD~q*(S)Q,RXͷPzZ,(K'w(Icmcsk&zM=[*,^qq|Z{.%D3H;$_.A;Afk N=FkNT:-ifuW Ea(|Q`[48+pU[ IFnq #玓ah%lAOݳIbMDq^dILNӮxOaJER唷Mj uz|/M;ݑ ͐ t. _⒫u0BT|[GcU͗qTRbIHss @ |ǤA"8q+j~TQX/ĄBT|Pv' ц ]&~#Z[ !VE=QIL7]Իpk6,Ui~8A")^NV_m&(,@ T¿oZ{D&mB4='b|r"[JEWXFW]rcJ"Y]=e,Ck%%޻#  rA x_eQoC&0#߶dvg%VS1⦔7*)R(sb Du*NIVt&sTkW۵_]Vh@-|*UW:l8@ ^E6doP FqAywO^Mr_m+$h H80ֹKR|P3;VD*A,in Plv? `M7*)r(&sӢd&L KrAI ;/VCYN㰵 JXҴW nkxqs AqUϲ!/_ gz+Ju2GȬTm5dd3M;SZ/\;84A$|ʤmp^YGn^$˱e˲!ZZsH%Vr'W]r")PLYk ME&D1'-_TBQ\鋄8\yJhn pp ~ m2l.ka|jVxh8ZۼD嬃SNBócDA$#"vF|Nh6xx(  ubuZ'< g="Pyƙ8zV \pZD,E ISZ\ME%Dg Qt=dQ/B/Mܩ5qtGZ"}8ӯRNX}ۿ.9BBp&7?@:8e$DA|=`įC-^=HƧ\n! e~ls@L]9D,K6i--nF cL]x<;Pñd"*׎գoIFi?őBŔV*|9i ^`W%ANum颛g <); 㚐#5h)%7tҰe Ε k">jc p4FJᲧuqHN8t=I, P ºD!&r_Nl)Wyn߆I: i{@ʧ.;!DHa$C&Ui:@|^Y]kR"Z'|{ )|͑;:DU~G0a)ްWȄH)P,֨#H:aO8JQuKw\7rj ]oݕR)*!za\baV[сҖs|g_^7n6Cn!kǘz~uWڡp"vO} V^)T+{ҡ;!b-y-8v.k#ߤ7TFFSG bIP-JH1:R麭A(ƉW:8 32]0_jA+oPv mطljT>֢dXqO֍wEQ9tKs]ܓU|" kj7"!ODz}N`5H62 Fփ x0!D3-Km5c;m-8tnM:詠Cf<#;q㖑 >sj!sORf7| βFyFpsuqD\dkn`몱N(sj"p+Ћ;",H@QPn qo g'yyXTuҝtһRI@wvJUhl!IQEVTC_¹!?G "r'kW2Jj/5Fe.2O< "'M%L.'Yo䆂HunMA^!tݪ^}H-a9򭫓ˡ̥IZ6Bx$~X `0-h tw9ؖ7H_-XQS OR +g> 2C9N9y+cYAĊ\Q̲ՠpcD$ 7Dʿ|J)%y[9Ŋ@?BE3e uvC`)_ir$aߊuQj4ds~@_T'/;jVu/_/MkܾԜ7-\qzGx 20 MIgTT:S g,WɥlB%;p9l 2w>mg-x2L%/TЬi,O|Q+6{nS0} ͧXƒa{F rŷ%׵}"X뽜-j(ƪ#O> ڸ!t 8YxIcOwmBvk[,^%IIDl ˂H[W֝U9fr~ zr ȕw$vAF}zp)w|fAGX^;Ey-ЖGCFi^hQcX!f/Hљv8]wݞLԎndۄ2-L]mYB , lDEύtzI俷hK.WS=wutDfZV1JHc9۬O%d#9t 5)wX}N0:&$H1ˉ#}loĜbkmVD10Vx,IE~LA5mS6z'&?mխWoiDlD@!0rCS0dPGtx<}BZh E¢۬QZr;u_&mj;A0Zٺ#3J[#/-1{Z[p3UCz+iGăw'&x">-%,XA$6A̦rmD^Gy,meRc3q9>$P([Cҗ$)1ۦfpfkD#3bHaw9WIRtK1<-j6HF ƅGT+lX\D "~k=\z'Zbbڲ61g|\=*#GW6H_3|s1  M;8T=Kƒ`aیC2қ- sNLη ɶ &UGN sG4cM6͟SS-th1rBmO c9i$KXͽjԘekK?Goգ"١\ƶ9>t-zDn^;f۔'"i|rGX+W'"͒Q _lQL'EK0*EKni:CcI{yZ[հmYskapR1'q#_Az֭c_y!vk^ާr+lpDY^VIXX_lP,[I_MWnL,J`R~B5^fo}=$5%?NF5͡Dw 0dilsp}n<^;f۔'"i| rzƃ#ث3ñD1Ž@ a"EoD?Zr@K bw1ŔzimVö1%#k/{\-&'&+ C%a#y#4ķƲ{"CYdz5XǢw0#IfDO,Nlb?=%,$u%+6Kٕ1 "!'ÎO{H-Dݓ&Ip3wUe-I猯m"| {nZs,AtՏHDxaQ~taFK(0a"(Zr(2D8 O+DW :zI,5l|}>fVyғJKg?CBѥܙRi]T%wAySkS\A9Q`gWu֞v0ACS5&U~P;l>F]SGrEX@{$HJE DT|nĨdw;ucMUӖ_3}f;ݧ39U;wNͯOw]\o>\gǝ K!kdIOp%[GMM5ncc6)8*c/H5CEHC_2>%ߣ{[;"q~zdFdFZGi%ɺ"؈tzF4,˜})2rN,H~2wq{Dsa9 p4jr Q%]*Q9 @ِ%iO&֦vg>LnjrRCz]!G&Y o۪7'M ǵLƜ>)0UBIQkSDbm[o)!8ªc/H,gebHR!2D"-e3/z`h^֎Hk\7a}^͡Lė&ɺ"kgZUp@}›F[ {YJX9$#.!]|Tڂb#l"뱟V6GB(^GA8 Kjz˺}͞/6$fNI;Dn&cNV5p:;L[(n65!Dq`-;[Q4q28`/Hkݫ;-4Er %D8ZK5 ڽ{zvkG5>B>!ƍw3 Ƶb:1dB\o*Mla?^bC(:_;N44GCu;Vv-x6ݽCC=Y0|^nV.n4>&:"ï Ju_Dz$:JmjBx[Atu"EK9aԙߣ{u[;"q÷02p% J"qu{ku.-_[$L> ͌@?Zї cHh6@9vUNާCp4YDhs7Umyi:wr6'5=ǯ3TX먴 !r}'t~Vm8"mU.Rc&! 39iX=W#G1A}MNN?nmh؊K[(2 - L/s?.|;ƎG)e(AcYo},!XgXQD{9m aGz"D##D8>ٿ>OӮlYAugđI%$:'*au3>`b|hFczK$:mjBƭrt)؋#p^ECEr $D#BZ!BQm/Vmd[b$AY^Rb;=fkxqfoCE(AF :) hۚ˺It:n`L,QK+LCp`$vel sd2YIXI"ئ&Npˁ+#4RtSA ]h)MBtKOf x/S h^֎Hk\7>9eEG1 $Rri~txkm#o*P?IJVR.>ؙ/$6!s YSݎ?Ŭ!B Q `Ay n&6'S~\-Iux[ n9[p^\j85t(R!H9{֢WAnָn\}&(~)!RH" Q"0FGOS?gX3=烡=mUg Q P -MQ"zPĕ)'S8wO_gD >;mʝ>ap|2t -IumjHq#q&V{D_pa{Hr $D'DULt ^֎Hk\7>Ch4I-3BM%ᛁCܑ7N2P0 Z!u(MHAWs%BB0@S5W̹jMb6 $<-Iu65![Q6_*bDjχ/Lob(2C\!7%TGv4ZKtcVAEWf(߆7K+hũ[(ixv1ƣH,+[Oj.B gW|/N2k!%.(=B4<2.oKDpl-OX@ԟߧut)p%ɱަ&=5ne 5X GXM!WiǭTG1]$h!>D{:Uz}\t["Ð`4o>|k%ɱަ&==bJ/8c/H +mˤ+U". MB$AKd@;J{4zQkGDXPW+Dh(cxͬ!DV-%[ q9ḅNS(!ZURo)#4f*hg !Bn&6@Sw(XoS"ًH!;Zܔ. MB4T:;}z=רZ[,n@y(N‘U4y̌ $ i;A%'Z'ݐYa_ D\t倏Ɲ&%!D_[&5ބ7:Qg3I4꧞ T2ƛv$1Ԥl-nY[# o1(-0DHB$AK# 㼣]vrVkQh-ӍOOQ&U5'Bb-$i ^ϻ; 8>r3C d )4S %_$r$f40+)k/%15)V@Ӷ aonW:^乵()&[:]FJU- &QOF:qyWL[VX "kzoSxUWZn[ɜͻ ,U,;Ñ5DٝsA`?~gbs=YxU?1i۱T۬?҂JE<)0as۔~=kdv;5dҸk82c5PHr)H6eK7o$pnI 3ceÚ}t%515)V@Ӷ)+5&oHarSF:g-p> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 41605 /Filter /FlateDecode >> stream xM5Kv7@2#lm< 8DHZl}YYyZ͆}]]UɏȈx._U?}~k_՛Uoo~~5_?{~o[򯾮|\aZ8#FWE^X];5$dZ_'yCr"y˪C#.)Wy~Uɹ%'2y[rt.٧$V-v[K*-iUMVUǼrwY_cIv%jqUْXySVϝ*֔ܒ:KVdUVy32_gJri}%{ⲇCK^ȰS9%{rM[VddZ=q&k)<./x˴Zn%uCV+B)YSVS]r-0&d5t{-kl.喻ܧ!d;\Wź-=Z"K_~SmίsS:RmsݺK ~m,uoZ:)t Ct/u[Oi?u˯q-?,t#tQszJyi}y'W[oi}ïVJw-B_6סFSʿ˯D:˯)L'ZZ}!_.t]':vwz^]Z ?oD'=yN|6t=¹uߟXC }=o'(}|w\[oiW~/[xV=V{777[ߜ<dz[_q-ƛy=kωMIEtYame//y(zi1޳^oKV7Ѓ3^Bwc*/:_zWníӯą}ѾK~]Holq|K~r- -0:í./nBߧ9Ά-t%ovw3n~ݭi|pAZuă闷y&?&B'˯Ҿ: ӏr74W?vXhϝvz~wÖ~::0_c [' OwBzwC|a'5u=w~xAW|?A ڇ[_gɏ W?J_QzH:.`_̝teo~P rE:ϖS¡ӏVd} Rx)PԘެwפs:R{^+|*&t~x~W]~WC~Ǵ^NU/['{]=wG~CӏJ{T}D ]5>-;ڋGBݑ-t5zwE:ؚ뭗׹??B3 }>ȯr:7WԟN=&nCo͗^Uz}8~u}ȼ z@)Pz/=8TG&nk=kzB.BCZӭï07JݏuC/iH^Hfc~4tuqc霿 ~n/o~]c~.t1ގ+.[Wtz{HDzIv hA|q#nҏKZgTu ʯq>?F_x:t!+|~8_1Qbآ/[ѐj=B/(̷N?ۢ.:v4;bH#'bة/9ZXao8J;s/M~qiݟZaG,Hav|}>fQvt.@;字,)n~S~DžN?ߢoo91PHdzwŲ}fNkޡ?DZ7 C3>ρX =9o2F7x4P PƆv:֐5]7&VBWWא[toJ~/ry\9ZoX9"bXyh>DC0_4@C%1?1%!n i=1Q5UZѭӯ2M~Whn.xpDmL˩91ZΉ;ˉSZC<=K~-&&C/6UZgiL;r[E:z%?֣Eq*ȏxKS<ގ44OBOi'cZ[ϭ55;c>VGx]zXoi|o}7EÊйM FwiX^C3~ =yK:ۛk-WGzJ}_W4^*}mtȸ@_zCo FR{)X.]+:c"J=5čb[:;S:Ϙ8~~~$W5WUX^ӯ}Kg \$&RKCNIWύҺb!OMt~X:-?ڿwCVʉX]zXoO5-LƲq>9(E~OĤtӏȬ_9Bw[˿ˏ lӏd1zI~֋Vh=uȯj_BOiݯuɯro~gɯ|Ƌǭкt!cBs~sTn[7tο~Y|ݥ~s*^zJ|%51 ~u?UzUx?tWET UzLXHu:ϫ6N}ޖߠ}ob\tNokqu<^׸>9s| /UZO|_KO--::j=՟iLl;]zZo.)BЧoB[oi1%|b[w/™jF~pnJI|D.̅}i Z3u}FzD.IW0X*\Xu1^ʅKS%?kCwi[Wѭ5{}Is~r$Om ̎.]ht"{.-36"J|ŋOH~ޱ12t_ttCO/% 5V{z$6zKZ\n|/UZ̍"rsXiQJ^V{}c〴U:?:c86.i//[Z[;COu}5~M~~jְ[F?oRJl()r̹'eGot%bʣTúr-99z ya_n/I-WJ;wI9-Ga)P-j b)2kM4-\)9R䉿ܑrXJÄؿR@,Թ +=XR]-jjgt!e#eɎ~CHYUTVU?XfwItauեoisuub+oHY76*:u`)vH>a+RVm#e3y*I],Z*)+xחtT +݄X8`}%`dGɂۓ~D.攼#o/X0 Y# .woX +=t[t{JW|լHYfzJF_X %en\S܇'Ҵ 9Ra9Aw9RU,HY+X龊IY5jAJhXYu@Jw*RR<V J]X 4 Յ +`BðiF~8Ͽ}X_*~zW3O܀zu =|B5| z~_pk;wJ VױW J+ϑ ?_'ۊ෮d8 hԚw7an}//WϟןW_??W/ג>I\wo|ҟv|m ;"=2Nd5si@GdH͢?RH`6H}"=h(wY"=:LчFDzQ)ңQѦn%"=;hU6W."=*ӥDzԩ0vDzxH+eSEz/HGz{#ң$|Ua"=+H?"=Pruy&s{y5YCsFzDH5Y9f*#gg 툋;)H.Ӫʊ(EzĤx$aUG,l2¯RG"w~9"ˏ'H֌h*#v.RG"s~Ո"=b';#vzN?&(:󅈎Κлg*$^[ΉȝBșY$XsI"=r"*2ңlvG"hH%[:*"=ڃ+#v SG!2#v|*#v IVGbHIx9#x#ң+'#m$R^-Dz$SHIQzEzNYȝy93wo EzN`=/"ң:Hl~-\DzNj!Њ;#:AEz dRL"=DG"=h~@!XIztIH IQH$Q.?G(#ODo'RG9vG"N[sEzIH$^AW"LBfQ%Ha"#I.Gx"=Y"##=YrDF5jLFc7"=QSGl #KH]~V,"=I"$YDtK {UA/ Gv,VG GjZ:H"= m1+#EzrW ׃H\;OH->DzR]+## b$׸H"=Q/xHϫ"=)"b$#=B_B#<*HBO"}ޖߴ#]Z"=!RD"=DWDEFzV$^lEz2K#>"EzSG=BDG = WG& Xwid!?_oEz EzRG Cz>vGVHLj+>-˟/Gx4!C\ɤ"=r"=VH@(\Ezd+#oEz"_}q$&ŁDzdvGx@qXHlS~M!ɞ?'(|"N2#CVGEzeH"ۑqi|H^E ߎ[q[+L+# ]EzH|z]~ő#]~ˏS"=!%_9cHk|Hк?QAEzЌ};#ݑZٌV&R"0.Rd}@|j+BvH&*zHR"=%^o;!Mu鑈@bDGh^{EzvGtz?ՎbHк.H6s5WGHBQAHG cl)#t{Ez0(&Ez0i&ʯp)#]BصwHur$dZ9!#HF6b/9D@%CEzD䃔ډB鑈t$Kz"=B7!}Y!I>aYRDGpE#W鑯 h#bHxX( L =^0"="=B*"=izEzHM/ߎ(O$"=BWGx'"=qRDFzHBDRdGq<)"#=BB~&o.H|MvǑVĂ"=BPG"Q ΊtG~i!ъ|"D4JDOEz^L+|;#)EN."#NHBrزHGh!i71FGN#E~)#m+#qzIa2n6"=/i"%?#x+"=GiWGLS7nN[9cIQ\ߎ}9#|+#^z9cHqQ u,hMVHD1QW9-KWEi"C&"=rB/!ZۑEZ1H#"tyEz<9MZCZH _Dz$HjӶz>Z"=JiS{G?= >a͑#@5";MHkr>0HA"=.Dz\;b}(pH"=."|bGzs"=.G*q9H: WwG_N?*}8jPq5"=9jJ8 ׇ$.9CLSH8OhGt28Oz;̖q̓q>sVq9U68VgrqsH&VZqH"<# ?_Er<9gr58Cz;i^"FsI8\ 8^ ;Dg$g%8T'8y8) +t 0Kf#<8OŠy +u8l%- 0aZdeꨎ|?T")Ie&'F8T %;8QFa  d0]L<)XMej15x?&V "@4enQұz2"WDc0?hBF4F!h +h v9DDco3A\Dch AUGch 6:pA1v41015G4 Ec8h qGc8hˉ YO!Ñ.Dc\XM_j1X;r4! ~!Ƹ~3dEJ70P܎p @ݎ`B:ƸСh qi h Dc\pDc'@Gc'`GcPʼnƸz0=N4O4ar1.P DⰣ1q9baE`J Dch *M9r1.].[A4ƃ+cDc<Ժ1IBJ 16VxvEclY)"cIt[]HY-}JH16u0A4> xxEc(XU'eJ1EclV6Uh';@*1(Ecl$ (cY 0Hvl +gaJl# )P4RDcz1YDc q9)JAP[G4v1w@4NP4شDc8 hJ9mUX V eEJ&/2A;Dc8Xh "1@4#Na ) Dc0hG6 1u4Kbخ?vE*7 T-"c5L[r,~piwC*璟H.?vC*bE_+'"xt暩uïR9s$s%E*"sy KjD*ǂH"ʱMORHXxi%R9!s&9+:Rxrl>$caR99tܼR9c2~T "WD*"sJGIwʱH 3lgTV ꯾Rk&lR=TISMT>;4|dRSL&cRy/BHND{YK7IaʛuM!E*om2I,RyHKL|>D*؂`Ry9RyS٤j&wE*/VL* 77LoC֫fRO ntr`Hz]&E*{/Ieq5|4|A*{7IhO Ǜʮ`RL*{ϚIC@ʧE&ƤT ^7| )M*o dR&7Ix̤6bʛb~&+Hm RywHMIe'=T Ryןi~.Ry\.HʛjʋKʋe%ʋq~!2I-Ry-HdRjRTn$٘TnNJTv_md(jR\T~3 HR+L&CRTno@*7 Tn.flR1nRăTn& eRTn& 'HnA!$ H"t7]*nF&Z •cHx!3C?bbCWSCIfl\l[.IF/nK}8,#r.Wt 9zxj?,q2B'DO1idҢ26ɜοXܦ0Μŧ zKМ}8e2>/'Qid"v41\.j 56 78͙qz͙qSL0Ό{͙a8g2Kz,nm rΤkt9gR5~?`ʤo.$I[*7;LOOs&sXL@'Ks&uT4~'9:Dw>I/9vzzzOܶd9HփΤ}ޖQ?1?ŸA(C]Z 03cX)XP",t&u3}&:qɯϔxb3C7LH7^Lt?Ptq4Tt&ux^}DF>ƨEF㘌>EFCd1FѮkhF&A*LFAV0͊hfmXd; ͆mvpd;2hw@Fj2fd; kːѼ}^tFѮ_M^|_hLF8j2_,vsEEvfdCFO}__d4&]2,P2Mi\d4MF3k2EF4=AFd208чuy2$d!2S+u naҲҭ"2+` y`<_X,/AiYF} б&da 22¹XS .вm&2P2 2P2ڱю*#dhDFCF@!C5dP>瀌>CYBm2ڱюvdc= }X5>G>Thz@F;2ڱ~pXhz@F{+da&2z>`/O'Cd2z~b=DF?"Xчc'Cd!2j z>O'Cd!2z~b=DF?юvdc= Xhz@F;2ڱюvdc= sюvdc= Xhz@F;2oюvd4ULF;2ڱюvdc= Xhz@F;2ڱюvdc= }>IFZV}ƪ!*H + z$}ho?"G gR~j8wdpu%DwvKXK$qHGny/!%Dwm" Pz +6 M /~j8l*p./2]y]ÙUpf5F̔*dtnt g6H3U\ù+Z AtIA %2H*&Xbž*& vSÙ0C gjj8SPÙTpz]Ù΋Ppviej823ݮΓ&s p ganr]jv'Q:$2;ZfƼhVѸՀ#wcF N` 5;!l5O?O5EF72kLF7#&\Ù s$#[,25μ'ݓ\ݓp-aOR$%DD%P`-! }"/׌I_׀q CJSsyN?8 P^dtl08\#2:+\]S&-]Ùk8;!5f?$tH&U3x?5U3x[LTSYIQEg[ZTcY[Q_p^&ἺϏj8/lYOCj8O,4K M$45]kk8c?pN:XXLM"_UR\4I\#Y׫.Hvbɗ魚"IܻϷj8f2W5;1~ EFW#~?55 .\ù1ͤ5kSù54\Ϗ}[]#ĭ<q[?_$n}O$n>դkBD]LCF.6]k".2.Ltv5!"]cd#HLF_&_!/Έ$U2 UުI/ jv eRjċNJ\X$D^sMY Yob:_.ZNm2 ]J7dt dtyueEFm\dt\ ~66~j/45~f ܦf0ѭIF$NKZ5-ἜTB 2k8/_2Y5?5 p^Ϳ5|Z5˪<=^<5'5kN $85]SvR3CT]I6mEZkRy5@<SyE -1dthi?[$ns2B?t-לV g#2:&t7)=uaIVH/dtn~n&[N:Mэ%6э)э!EF5EFdGu{7I^iP kuHdt&EF+P!+dt}dt􇌮1]$dte':\Xdt5]] 2 &kā#26H9Jeѵs2dt}jB~ȎK$n-,^&EVZNd]OeCCF{h'C.ˤb2dt2M"~jBF{>dtaWdt,2tԺXE6OM"4b2..Ґ"kBF?5A! A& & uLFprMh!EF . "/VYLF_&m!}LAF?58!/GV!o_Z$|ES;/ }-LAF_ 2RїI^h7}.dS2;MF_5EF?5-!/JP\2Y }􁌾(d2b{ї:hd7}5"q=^ձ>x}17}쁌~jDBF_NZ4CF_1}92*&EF_Ԉ1}Qd> n2rd|rMhm2y"їkCF_& 32n;%hm~aч P D#BDD gv΋y/,1 +!ԴY?[@AЮ! ho6bʺ4.LlϮ|;RP |tcPq]a){0Ϟxy>ÄtJVIwۂ;{{-;{-ŵ:{,k:q 0~ =ӍH!QN |:,t㼉7kC8pm>.+&E.bybEU7 xA-bвU{ȲwA,j+A+]![Vh.1.R N[ Jٻ׀] F<ʼnVn YV+酕#'|-#6[MO $볹 0US8y\oЂJ,d﹂I&+ͼ.DQ y3IOM޿+0w,+q / A^$S'T?v]c>v}g@>+ ر@ б԰$J4 .=qZ3ᥓ7vpc6vE`c|5vPcm4vSiV3Ou(cO2vcWH1v cW90vYb./vib".vb-vb,vb+v]b*֦o3{s )CDfxo+ުΰMcfUa3a JBH]8Bqě7ަt6!L{ ~x]>]\xxo  F$tx9 ކ" mxT0V bmRvt{ qnuli6`mTSvuon e y`vCXm#òzj%c+}m~c_Rf9@x ]r##?lea^[b%2wo9me^xՅRV +-J O#oϽl[vɁo[beX5~n+K[YOi+VVrS B9!-s[l)[v[Y)[N[Yb%wr|VVV 9>y}re|?2\ole9>U VSVj}ZOe+S<m%-Vr|ʓ6\oٰzVӪZOi5>ZVVyrrʗUŸrey[yZreo9>UVj|ZOi5?r|V-ϧ:V*ׇU)VN~*-U:%ǧVj|ZOi5?ZVjZOiu>·U>aUˇU֧ڟV|ZOaծv}Xaʇ/R_r|i?ƧVj~ZOi>:V|XJۺ~dÊɏT\o/9>UVj|ZOi5?֧ZVjZOiu>a5Q>F/R_r|ӪZOi5>ZVj}ZOiu>ΧoY>fJK SVj|ZOi5?ZVjZOiu>·պ>aʇ*V|Z}vG ~#wݵ' S巿uܮ_}]_*L,*Jw>VPO@I*<)(G?`?,// IM`Ƃ!Lċċsī=lqG&^MSċ]Fċu`Lp&^Sfy`QfyPfyOE,.l37{j c5`2ˋx',/ hPfyDEeW?eW-.Iz,/){(\ JE̲SfyJEbeWլ-eMY^/X2g)ab:eW}bTy۪CcS2˫j2˫rr3ĩ Kk`bڤoĩ_0qYL[W\ʏ0"`D7M fLZ~.}.is,G}XXy2M,4z}4m]1߆CLZ0`̧,,sġqs~]b%0qv/8#*?3Mg &Rkuކ`(QޡUf}!L0q52`X&=_0q<Vz &.CL~cs^0qhox K"Oesϛf+ ܉2ˡ)S7|>rM>&ġ_ &!a`Д)N8F|9<[׹C LRyLx`%-E0q oi~C,`҂kTf9[sY@Y MeCy 36LO0qh}?]Q)~{{BwixKL9/84poSV9Jġ> K &X>03ջW6ݏ*p=u?2o|.ܟ2CLKġx`Ђ-qt*LZϯ`|5<\)`SC LZχ`>L]֍2"_[8zϻ,w}2.z` 5.*54l֋9 _rCCyLuY  6l՟ &%)^0q/8&!e<^LXQf94~ wܑl2ˡ/.K;z7.2y`L^jV%84eϧ`̭7_ &}Ls[ġ0qNU,te%{0qhߔ9#*ܻ2Tf?,^xġ)SCs< T)ppġ &ff0qh"?K&I0qnxH?LzL&?L.҂3'a✂%MYㄉspPv YM%?6Qf9Wm zA,0qN`✫C&^0qh=CL 粃%wy|&81#9\B0qhʯ( L%?)1:[~̼W S';:|qşcxIOEZ(Д=΁S.*8ʴ & 0q7 LXM0qhC L+C NLxw"O `2˱*7(#2˽,,jF.4qЂbڤ`D 8W:#LU~e &eV&?CsVwlrĹc8V" lgcY0`Ђ{TfoYe\Q0qh>/\?ڜ`~stLr-ı迭`pq1~&= sCϐ. &S0qh)?C`pnL,}=0q˰𖟱aMxĹw=&]!O#U0qn"N?LzZC7l``ġ &1z>C~.++8GO1&έ::ϒġr\O0q_}&$`ۄC L[^0qp-8 1 g>zfVfzġ)k/8Η`"7Ĺ,=` @]%ݍi*\8+šˋ(DU1IMS\8vUxPXqsp{Cۉ,nN-n-nb&998w- ͉f8<3EZf8wPoRfm3V#IK7Y}ƱT/ڸm?CxT~_s*߯.粺C|:-~m3<+8rsXqn_NT/8zɾ摇ȱ12Iۚ!Ǯm(yJJHBS6oO,rhRaxDK^]Z4b3x4C)wim09ju}y~XK2&Yprz trn)>94eXPx`IҺ>bC,7H u)GKH UjBX S~5,dp$6^r, T)e`aCZx`Os!0є.ز*wfyK:W-U~yˡu?_NDG q CS&zk1́M1?9`S/9lE sJӯ| e98u nJ,oC#̗k iNkL 6%)9;qAZ@ՎI)M! (97[]f9tyA-̈́ a~ͨYn,s.$hK  t-Es̷:_sh(& #ewL4_҂<'F[ZɄ< gGss"=-s]f/fK 0>˯ρzǀ%]ҔN9:48%?@u+Pth "?J!A~-W tBEEBg8Boj9* C?%-W8t Cx\ZDtK7}K~ǻ7|[~Ǜ|nӲ,x `|m yD^BG~Yˢ2U~僐n&mD:t1ҡnfǟዓtt3~FJxwoxwoxs) #& 꽲ίMⲎC676)]LM&?jNg3xpٌ.y/~:aH=^us7u4@`l9xQmIF݊>EnUi9%}~NtnJXyB*2񢩣-:4ŋHMn޺ʏ] ٍ˯ɯfn#: Tesoqա<=duhI[SZyC^&܈P5o9"@%ȨZ0ק 02 Y0Yg1 ݥ5>iPOZקԫX\lZOD[קp&SE˯~Յ*!>\WL-u]]f:q5IA^k@_,}'gCՙ5F3^qv1u ȏB|\z6vh]?QYld'qء< ĎDDbY(6f5Ԩlء^]_@v&k<*";MƮK)BKKVД.1Mbg4B/³cCsOqк?Dh41iN?Cik.<~@%?{ɏҩ9i&<ᘆUץsh*XYl&!L}ٮ ZvS%l;η9GZUзzZv_iKϒ uJ@icTi&* TWsN> shUUD{łC=紱}C} ݡG^ Pw~=y`1mNi!?wC:(?ڝ=)`;4hTq,#I2CCij@Wwts=%ȯ\ Wwh~7ڱL8 옪{]=?];!2 ߹KwWՋKm;W2t.mucY]:gUйl7CZϋЪ* 6Zϣ\F#v !B.~.B,<5/Fs,BCS:Y*k+ѡhrCŪTVVECFѡ\7\ȏᡩ$]-4lx._XqnkxxYO""CjX,k}J< |-@,Uke.JK'zHW5Wkݮ|^ұBU,>TQT փZTlnc4xh?sۈwȯ uܦ3w=fSGZ|5q2Q܆c=thݟ3]],B"4Ьï!?`sVcQCSzɏU^Xdy"]^:!&Od7`'9mi TTUnr|Q |.PmiP哧|2U5o?ɎU U> l*T&|V fg'uŠ'g|p 6w=T'/TX+QWPcBoPc*TTa@]TAہ*D*EPh|\j¡5P,Tyg~\ UwN;N >"UއnBβ>TywISMy*ZSڽȒ]&`YxB@2 %(>@?'KkBivʌ{Y7ʛ0PgVʛhP@rP\r}\U^7j[Ж*>rvyQuj*u.U^ ^(*>*'JĦUy%rЪ|TyEZWUyEYWw+V]Ǩt*7Zz=\.U^x Ul*/k*/¶*/Q*/BPF~Ks֍*/ .U^ *,U^*gWU^ Zxk⻚”򂪵*/L**DZ *Ϩ%x~Ry3|#gUx*DgVف+rv]Qtʳg3ͪP啬 JRUytȋڷj*(ysW{rԵS#O_lx!U^O-u+U]PTyl޽TytWnU^R'U^f{zQETTylf6S'}Kݑq:#Vx؜߷u|*?hjFwՎNZ/ro6c3Z*h(ſo:J:̧ҭ#"Y<6Q[]鎄ZϻnV]T򳙯Tyeժ)KR,]OzJZO|QR姶R118ʣOS/QS[gT ӌTySsA8|ު5^]wu~u[G{u=Ů~h?ލZ)1R;^YZ/,ThB/Ӝs#QY#]jU@/UfTytKiԎt.ZV9Ih^juݴ_Sgyu{w=_]V]kU~j}ޥʣbߨZڙ U~ˬc2͚*:ڇN4?SKHG[w=>_R R) VNyR5@Z*@4*?Ty4u7Zo=D7Zo8Nʝ*ZƉ2節CGPyŗj&S*w3Ԋy*?uyhlj*?ͤ}ʣTuzDvK.z.Uy4ROuoxVT V׼ԬTy4RORRvz*ޗ*.{e/ԝ.Ա1R]YW]YIU[yWG$TytK]7GT+Vȫ*ϱ*溫~QoRaR]ZZK*麻KO#8E4'SuGt[fwDu4KEgS[UGJTyS+O-%U~ثCJGWuU;BiZSQOT(*?ojWd|u[Xj~O_RMVb}S*?]CHIg)cU*O"@'TUy)<ԹTydUPV$dIs*Oʓ:Q]#TyB['TyJBY$KOOm<0OPuSH$U~UyRe;G˪ԅ_~*? CP1Jcnr P6롺ƓR8^TyF@rUnU~jR偟Xϣ˝ʡoVO(˓= ZTyK*/7YΗj+9w V,ySϟTy!ժnjUC MU{zK;CNZ*֪<^:|]e>T$U~jώ:*?ϤOx( ] eΗ"/+|ΨXkV_&]E}z2fVE>P\7*/ U-UeTKAHRVqXj*]"8|ic2*ʼ8 J*?uGVYMBQg*?yz(7P6uS<ʪkEk^J }hJzQ歽TyaU_6Ԏ~[HC*/$XAJGoP=RYe?23:k=T9-X/U^bU~j[WV>2S[G#*Re,izPBPH*?TT9͒*?ãp۪eKIZL_*?@RMR兩2VV)V/UI9TēDsg%LA/z㲆7:>q]7՝z/U~j+]y?Ǫ<.˨j+D*?yʯ*?zLM*/S MV奿yS-u(U~j}/Tu_<uSݨj+odU~.^zs׿U~*EĪ<uSݨj??^y~RQ`^uT{=^x{FKwʻsbU9[ߩ>V=YqZU9SQwʙz*oߪyj&}`U|X7>V oUN'-ԺTy[JdU.qUy"o;|z*o.UtT96H*o-UPVmhU~Y7C*oݟg*oV孡ƥ[# [_U<U8?*o.Uުʛwʛ李SYSuUR lU"*_UuTy(g)fzTdUTuTyA*o@7ߟCb*V*Ty(qUy* .U^)PRu|'JW+TyǪs:yRSPuҪTy>*\_XWʫkvURwUyJ?ʫ2Ǫ/৶*VjZQR啩+V쏡+SXwFW%TyڪTyuBkA}KWkFuKW_kFyK3EU^3*[ U,TyM_CQf[TUyq<:TyzʋȠʋo˶*/DDQyTyAYʙ*/G&˴J*U^<U^PZVeTyVVa2X_t֗*g?U^:KR'y}x}K*/Jͪ4^⩸**/BUyU^|~*/E]X*XʋPgKy/jUm S KFKX*/_@3UN>~8U^ʼêxTyr)WU/P僟gU>TMK(X*(p~*xQ?U~UxBoyĭʛ?oƯ*(3Et<2|;ϫrAKe{rE{1nU^G#'@=?^86US{iIVoLUt(ʽ-AVy_ U5=.? STQ1V@U^T ʧTrʽ`UNU9YV6*A**A*]'V)VTVdZf)-UނUpU9V'VʇMZOUpU [|EϪ1VV#U9ߪ|Ӫ|^UH([w_9ZoU=bUcUQV}ƥ;jΪlUu*ӪN֣Uy'+Ϫ{vͥo6UywW DoUygT9P/@wʻwuQYUXUw;yV]sTyGYwzAwTU9PoUɒ*BwBw;Vlv**o7+]].U]{T**oG9 Uv*.=ʛ"ʵqUy2oXlRATyVVm8k֪^[yQls2*oL)*o"D7UR孑=.UՅ*odm[#U*TycʁUy+>RH#UPV--U,;TyXTys1%%åYV-M.Uά;Ty}+ΪnTy]u}+ٺVC#U@u*5/U^QVzUFATyEiYWwQ+YVgJU9wQ TyEqYWw} Z*kZ}*#2YʫgU^JVyU,Y'd׫U]gkʫgU]fk uVyMgesWrʋ*/>= p~nVyv"YyQ15e>YyxTgEvʳ*Ͼ"كdT*ϨugerU*Ϝ:R:|\Uk*'UZ|;KUPV7{ת)E٪fZ/V˻*kUj*_B*׍֏DK/]5PRkoUVQV嫣ԥʗϏQ %kU*_F<ª|y|lo*_Lm*_dZJvTvU *_.U՘UbUB=Z/ZG/fWr*_dE[/w%ʗP(TJZ/w'VsUVo)w.!TnT\dKOgߪ|$ʧg3$K\|TdKOϪEϫʵqUzè)rwPU|eOږ* G3U U>P7٪|lsrPl{yΥ'Skʧ'olU>y[O\'o򉲴* .U>}=*zEerX&]|lT.9|.KwVR僩8V僬_Hr|XQ@´*G*ت**GQ@ѿr|*Ӫ*G٩CP( TgmU>*R( Tp6|?Ǎ*7+\|p~r6*o;|pgOe#|~3YdWVygʻUޝeFVyxr**(cgwgUpY)@*5Yo#G7~pVyw6/YY[dDVyg*U* 7Tʻ.*Vd륬r*g9Yqgwg=U+Y"wֶUrdGzdUΔ2ʳ_dgԶ3*wW*Od;;7<=Ysgg7gUެ*gx;Y3d7gUn& <ȝn%VVys6 Y/7|U>eT;-}Qdx=Efx*GUvV7U@V7'ȝU^2U'QMaBYYFwVy"SKnVyYV9ʙr{*dK6)Jv[";]Y-}QVYQnd*ߨA˝Uz&SnVWoVVwVݬrYr߬r*ԝU>P*d;uCVܬrT+Y*QK+*JAVU6*|U^<86Ըk#|^<νTyk*(6g3JVka=eWU^ [YQdIV9)d)*7\Y5+S,U^)&SVyMr*/U^6)MYOYeQ1dz*/U^ 2pVy![Ye~QN ٱ*/9>U^P*/BVyJʋ*/gg>*/|>U^|8pVya F#P JY%Vd3gԙ S1U^U^u Ycʋϟ*GU^r*/{gd/R*/|8]򼭚UB!~V姮Cקc TyL{SwyQ]_R5Gy*EEy*fO*zQaU~wVy|/ױ^CwPC5ׇCmJ:Szn*)֫(h<>YR1upުإO-SKKBj'.UYREy˪:kYUe{zL*Ӿzn(򬺠Ȼj]b"y*?uSח*–j维S#USQ]_81<^O8.jϥ4|L< NSrHZRMoZx$USQYuGwV]yrbU~jڣ̻jgO~S$U^*uW?nZTyLY̮cBvxz~*?u;uѪ<..^YUy*[e~^zN*Txݮ"}$U~/|LĪ|oԥʷQ7$T^(xPR/BMKoOGoU'J]fTF1Y"*~Bo7Ѫ|{|7Jɪ|]jUm2PGwGKoPYYoUF1Z35U*CxTF-ZJT~V|*ת|ʷwA7KoUN*ߨDyRS=PlU*`U޶*d1[*B*_.U6]|mVfwg֓Ҵ*_oEvU9ߨPRk9;ת|GoVRfK3U&.UR)N5.*_N!AU/'WGK/﷠WGK/OA/OF/SWTe*_*_ .UUdyK/?GT~=W*_C/U*VVSQ+*_,uQR lU}*_&?*z%ԾT;TJ>[/X ϬPg=u|nTDZO_Ϊ|.Tt6|z?U> P: |y*gU>Vk)p TYR峓-U>=uUNJ|~rQ!T9S@Q峑=.U>}U>}*%.U>}=*|?ZO>VϧU,(ti*_U>aU>aUNr4|fgFIKL6wa=}<%Ǫ~T9SEQM^UnU>cU>cU>cU>cU>WUN|x| \xX_|,[>VϫU9T9SIQ`TyT^ߪ|8 U>KRWrpĹ8Yo*72*W)|)xX8-ތ.s~sX>͛-_Y$U.tdobs8>Y=**7oV*W*ɾYqdV*I=0&Y[q7w#%m2yߢ˼y^sr 7<ןx?YW '<~=@*vIWx@VyiY>=Yq'OVyʛt+/噛p5ni-ܦeυ(3#$s*w͹EߝUa6d{V*' rbݬB=+fmIVpnVy"Y(dYRu[)XKz%|;eY&As%0 ť0sVoi-.RmI*'Kr߬rz*G-U*G%UB$Pܨ.˶*/WiWŭ_Tyxgo'[̇| DCBΗj?Is/U*p?_gYuV9/YY弾VljrvmPoUdK*ϼ3_rvMnV"#ܳnVy3ty+RZ*Wߝ^*wpM}dnRַT/YV/7Ud'3mӪ< U|E3U,p)|r߬rڽY+ʝmwʫYK\VRYj߈PPVָ83NvT&T٫Ty 7n+Lvvzu](X,YZji=Ŵ*?._*gjYj:7tT 5AlPҖkmO}׀d/ԫS\UJV [Ykxꀳʗ*_U8;|}wV9ꃬrYㅳW(|eʹKtYʕsu7: U,:EEV9wQ*5 |,U>Q*#|5e>TrzU>+ZY哩4*&|:뒬gOg[UUU+ Yce3뜬 ٟVţQeIUyA ZIϓ*g7)/[t%I1ϓb.'lmTy!+ڪ^OtT9SWPwQ]aTyIk򌚰*dZkr3قVf}KgfEe*kVyHTyFYZݞ.8Tyy]kR& ~s5tIYgLs&]<*>s**ٷV) V]ȨJ*O*gj<ͯ<|UNITynU<%UNW)lTyYRtAy=)]P媥~ZBߩVɻ>PR]VU"ܥʣKH:Tyt5}]O@tXGv+<(X]oVO6Ty`:k"Ϫ *>!SO]^lHuF_Z%۶+doǔ/4^<RuSQK^/,P姶bU~j/6OS*?tZϗTyl̗j+|תl#+U~j?ߩbU`U~j?ߥѷ֫r~[_[ө_dU'_<ӥnU~y} Ui3*?_RF@6 UP6O}y)V]U;+k=0IZ&=PYѧj+PN(^z*?O[z UZϵ ;}k=SvzU<ʲq#ᴥ'Ui߶*?E։MɡcݴOSKK6=]e3>VO׫RYSY2ARvvw|~*L*?d̷jPRCTF??|o~~o߷XX췿[b%w?R\Qų~?O= ׃z_A~=?ȯ;zp!:>QϏrI  _.endstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 504 504] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000041970 00000 n 0000042053 00000 n 0000042176 00000 n 0000042209 00000 n 0000000212 00000 n 0000000292 00000 n 0000044904 00000 n 0000045161 00000 n 0000045258 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 45336 %%EOF metafor/man/figures/ex_funnel_plot.png0000644000176200001440000007017614465440735017704 0ustar liggesusersPNG  IHDR}* pHYsnu>PLTE*** |||RRRIII&&&fff WWWMMM>>>ZZZ̄rrr...xxx999DDDcccjjj___+++222444㫫nnnǢ;;;###"""...$$$!!!zzzfffѿggg×Ǒhhhpppwwwrrrkkkٳuuummm}}}춶{{{nnnգqqq㬬DDD000999WWW'''JJJ\\\PPPbbbԺPtRNSд޿˹ǷF6 IDATxO[a)cњ,SUKvnMnzUF.m;6JCBw 4s熃}G{<4'f@q$& B !B( B !B( B !B( B !B( B !B( B !B( B !B( B !B(aoSB@Cdza%!x!<2^)-:wNPŸ7.P*['wB}& B@B3CCP^B,*/׭WCH(TυBw%?\^2ؐ gz3J@i?rC4)@Cxi? s?qprenff }υF0p/p('68f ߏ^aS'M; :#ք-_K*dY@f}y×$~)pNN\4 l/npKBnnMӀ~0_Bx;LB>L6~lg}M!B(a{-e!B(d3A jU A!XBB(ím#xJlB!*6W.om7Wf !ߍ/Vk{s*~qtB!_p}b P} B( B` P$Ov?Y5!P!Ӵ#|;vקgo#Byv7VV]3Br讋ʮoGߛB(cK-B(cɁ!B(r!BȭJ{^Z!B.,^yvKErA~\[Gx:>0+P!¤f ! {^5P!B( B"BڜM B!\?핼j׫ƅkf !H5޻ޣx=^~/V !Bȑkz#Zk|mfB?y1<=]cYCdbZ-7BCh!Ç!Bp7>#!ByNKVF6;P!~igZK !Bb:®g7+f !@ 9 !>Ib !T!Bȶ/ӑwp$B!LގG|!BȲXԕJ!B(a{Lyvn{ߚ!B(e}[GQP! J !8Ąc!k& !d7!oL!BȢF<#X6KP!q19mB|c& !dG{eB>;8:B%D2i4@v+͙'B(- w´Zu?m(B()$96ObDB!, 2BO3SP!K,\6& !䰃4(!!6#BP!K?"6L!BȄqfл`*A{wԶ`*Wǩ@ 1.6`>1$nаo60mj#mh9:rȑ!$ R2ynV^k_x!$!'އpv/o.KJ|*^oF&!$@CHBK1Y*pVy*ӜMʩ:;z^nQ|"PM '~D x}ky*!$jp2%s򯿽y^B}E !qhCE !ʞ棽Jީ==(BHh>ѻpE !@_Q {R*vL+qބbvs)BH.hjΪ;{z-ַpsB@%u%eg$Ϋ/;x9E !l:;Y,_)8T o؊B@-̉;~Wdȼ柧lsFBB(F Hcyft E !@_ X-HZ6E 57!!%[?'mbCY8!!"eK.|}>JsBBDKHiA]j)#!$@Ӯ^`vBBD08!!!@ ! |!2qQѐ=K$\pEwBBDC0~~fSOJlBHhh`[nὡ8 t-|\j.tyBBD“|jmV1s @lCXЧ] {eK(!@ !bgV}S%kV9 Wj B!ˀgB \u|TlWo4ɼ 'B TSJPD^pv!$@ԭg^#d !!"Av#֊E!blWI Z=):mrvL{%!iIJ7/:5x6!!2!Kgju}٠wI6 BB"t'~zg/ a',!$@H~]Rs}u=z^0^zpW!y6_ P^\RBBBz\tڃ792 Z"W` !!֖LTB6BH`p`J^4,]u6!$@<3K%ӓ7b<@ !`YGH A !@BB'5<\Σ726!!!+ES( !!,]-b̸B `B IS3ɸB >1. Py<%!;{#32: t<\:lmBBm(wq%{2d|@ !ು"ꝰ~Y?~b|@ !3-BB(l6B!o\^4qBH<0&&32YBq;9o:o ;n/ON(!$cFa=W]SkBB BH҈GFN-(!<k A !ذ@2>;d4A !•:|}TKqm"F  ~!%!$YFN !>ŢIB꠮ҹV2@u:|LD!$ˇJ|w|M꜊ HZB+eW]\!$šz!,-+%BBH-HomN T6MLEBBP\CXR[u61QBBICXGH A !Ҵ0ljq"6+ ۴uM~@S:G!$5-w@Z X:8/QZ,e##!!Dd: x8&W8A !B_pIh@?o 8iS )ZpKBqJRRJ2L?`G׀m~A# -cD& tY&`bj'Ҍv'dW!$Ӎ?tV3LXOB8߮ZUX!$IEj9KZRz~ܒXeBBT'Bʼna"gy\ BHBBB`0H B(=v""jfr@ !PFیV;JU_P+3mmBBX[Վ_ϼ kmBB^LV3d BH[51rk<.!$!!!vDl)R(dF; BH|2hG2sesBHt$;됄BHEjua BB~d՞Y+=:=g;<9!$;H A !@BHm5zmx/Ys2fW߮9=!!bWZGŲ$!$k7biCI)3_ {;QMJCؿ@ !mD!a B0.($%!!!طv("YF!!zEf:UBBW7:{C` BA%,!`PO(H!$p'B'x:|BBW x$X!$p>Z}Ikc-!!!+Meel?]!!+)-i:B&BB_BBB:h@1ýycDBK}H=Z݌ BBW1cL& 2H(׫0!!!dtb:~|aLB[J2q>=n 9A!$p,1Qؒ{%vܥ"c)!!+td^ {]4't4 BBBX]!! BM)!!!+=vMOz7!$m},t47!$iAc~hesdBԴ82ia9jCsz.B8c =b6+y魗 !அBc\:~l>(z7v7B@{1');clWiH[o8:c 2R@Kbw~&c+|-ȳ[dBݦd+Ÿ2 ~ḵͿL/4^Iڀi"ڎ('|sqC4]]8B("if0V@*xׯ{4!jm<~Enz|\}W!j4 /11*1 !.y£Ɯo^ʘ_zE5?k;:xA)!c͟8SM?^+_F)Q/GL70bPm s '*/ ]2.7ዺ!$cp۹[侚I6݆fkҩrh8rh1fo>,,F;N6Sw0A5~&> ᶦY0eOm0x!2 6CxƘ+ԯo֕}}t ]}Xۼsj6zBBj}{RW-?eB(5=ӭ57#랙fX'c]x!]’RZHD顥$!z_9~45RsC !]FEQ7&JKB|vL6[M7Ahr~O3{Z?Z^n֎0Y1[!W1 ImkktwI߹\ 2p[|-{X.B(zj o{9"G8~tߒ"BH>|u׃۬8^a6cKZjaWzi`} BHl$ɾ墇~&$ !iDzw;R#V7ok޷!BJ́ޤ!BJ2 }!D]^!ԇqܯvـbzʹ!BH&a#rY !iSj셰899GͼpkM fB!$m{G 3_tǾ0̙8PIWVyLM /<>cZ7q68w}7c7P|3q"P !!Z;9Ml5 B!$=*a+9> s ! \Wa%!B(EyDFo'n.MB(E8i?nB!$5dQPA!Brin&-?㉣mVooC3#<B(1/gcL@P9kgyIE !gM GB!DQBPɥRIVd B! ;xYעToVBP9;;T*w[a"Bși_PKڍ4rfkHIym"Bș-dA"BӱA{ Ao۵] J ??7B(p /Bi'߼Z(<B!^"j IDATRFp+Go/|~Bz\[$/k#|cz۾4B(K^n&SL"<#!]!BHyO's‘r^z__83VkLߎ~'B(z۟ϏʵpQ|bX{ aᚷ !y1}n/ Itw C8!BHN{+oH2:ɉ섛"{CŽ8Qlqb9x5B(WW=_SDb$Ortk l$B!$7^t-BSKLUo !Byw{]x"Z-wν=3Pɍ.RzkIX;.PɸVx,:i8}`=B!$˞ W=AhE'QZg BH<:ro蠷XSҜt*Y4r,^,EՎJ%1rL+?\`'PWBBa_Qu#}B !}hjx|i>n''QҸF!Eou:qNRPK`3}7Շ77B( viM¶9E)IM퍕)B( M|ݨV;%c !Bس$UBBM]3GfOH٬"B0$ˮ`912v|i;22xaaԢ,]!Bnd+B( X8 !:׈JB a* !!vr攩EZkB%ka"B/qKEs28 kqJVqm P˻ڒ-M-B( X8 !:"BH.J%s[]52 B=sXhx#B lZM#|5$l^Pd?] OM/B( X)%N'W32_Z8 !:"B"7k{QZ50B(lX:IST-YS !'p+E}>Cs)FX߼<0.obP9ˀBCh(!O[H2B(z'\џpjB!wÍb(Zp4#BH6XWK#<46M3B(g#B|5 !JZQBq!41Y2r,[kaL#Bqd_>ⱟ$mS !ǰQJ% B(ѕ\B>#w+BP9|e}V"BɢB^;82LB]fF^aC6%Ӎ !=X /F|.? !Bz0۸:T9KYӍ !( I-mPE.>B GB!Ds~E(ur9WyB!*ax-Gw)O1X.rPyٰ2!X P BȻ :+S. !+bU)qP#TBPyjIWt [!$6K[=Rf NI{pŬs!['!$ƼLovN= !iW]X%uw 9W(/DX8 S(!F_ o#aC !Wp2Z;A>C'q!,2; ''y%L ^/zB5n ~ajmLa))]W躏pkԔ}›PK{NC/!dQ}P?"?0/e7DlnzB YRk^(x%~a^9yujaB yJ-g慰F{w!5BX8 :1m\ (r.uBAKp(!`FEV/`09 XŴH}_χ4cٽwgEBX{G3`NDon9D !,bqVd~ޗHgTBhcǚ:B/ L CAAUm-p-y!%!~>x#U{t@w<#&f%_= j|^G`M0ޖBG~FPJC0a, !+rr>)C#Q 7^ !<^=nj>"B9 GaF+ULAAkmzT!D M0#lb\5Z+!mQͧ(rBCg 9fJ@G"ϖ {B-3&^!Ǘ108cr5ɟ3Br5Ax8f[Br5X>rr5cV=gGjAt\M8#136!X.!f6 rMBB-֠F02!X. ! GavEBSr5X>[qLU^&|$Uo!&>TK>!4wOBɴe&UӌBm.EE.zxRԗ|Q鑇0'~yeBX}9TQBktbGH A'0(LcBqB ! W\971jفBO=R>1R!!DݫLHm0V!!D^!?c~*!!$(XLq|> GAAvop(!!GHA &xXfBBL3x83F !$(8c%0pT1baCXZmUE)!^a1__ B&Fa6F\BHQpܓ"!! B:h OmjL 0$!!D-MRlԒC ! Ʋ`jO$40UO ! njbf F!$(9!AO _3r!!D`V GA !!!!!r (!! ܇fdJ8 Ɍ}`BBo߄)=`BBoǦ(XKnY}dBBoNS8%QBHc6eIBAuoX8J3th3k"fSvopR!F!̆RslZ,)>QC|}2>3a,ڽwi!j3+?#fAܯx%5fxx8 >xH"YPyBh]B30Hr.9BBBhBgwg!D-0#;M0cRzs]H#!DνQr8ToO0SՅT:E.B)|ߕ dD 4T]>&"yOOV` x2aK"v?ptW'NMe|qf8#fjKi8YG[qN3 !b0}s X8 sBϝꎮ3g{*ȍ֓$ׅ!lO=E^\ T&vNAAaޖ?|Xcq3v!D?טMkN2a&J";.+Dw2-=Lԍl1a&JE~IDe;EW9QEi^ d6rX3aB'u~rQ[;VFeڽmH@G4#f.]i~!"~EwN8;mFKo  a\̖vKSźSa?c"7b ;6BhF r5V”F+z%95>ɰ)CXR P *l91rȅ3;'ݮ# Ϳ6g|$N!l9FeRq0_M2a>F5Hߋۏ(v8S6ra\a|5˔D?,m 8fKb8.r4Z_U4utBM%6 aC0B-ws^̆1!;q0#< !!7jo||ȑď,!aZ<!)!I=n^.lBY)ﺇqFӼq8(wA&zĭwOM]y38["jx"".塬l a]_;SZ,BE'VkKNgsD 1ޓˍ|?/J oxη79&x=@cB3JE]U".WہH u[dCH !ejdӲ iЄvi풆C7jQ!V&f癩3?;H#&x4Vjbu%΃Xա|O^mI~ !`6hprO^vlHV$ۻIBı¶;XEZ@! !A!<h>Z$B槙 QM3UOQ=HBhw[ubu qD|"?{HI;!vs4L2FEFoꮍGgBhf)vyx#UxcSjNl!.|fBvѯKb%t!cz6cYY8 BME.B:cJq(!l OW`YW~bBB'LS;B!ΑIVunJ850cZeB.EfiQ]f;BhpB{K8qG !y,SCQBt`{mSnBN!t@k@&ŗ8MQˀ:>)!aGyW-S%/qȨY#`|1B#a9S|S&eTHaRo8OͨƜl0kjG3喆Է &Mn=72a? FB}=}0cMIyDH-!6L`(K"yo"-tz9–qTT=-"ۼ~@Yo$OyB]{RW!&<>Bk,f zx tfLO8$ҦΚ?w5\]W0󍅄X& ''y.CjqJPQs#iy;BBn݇α}VpBa] ugYWQ%!,[S<}t^X K9t3"BX*Rwf(LI>5+FHw/0vi풆" 0ύ3™f0-FJMlL$0ebs SB;~+ -a%!)C 0425i-PwBX.{Z$BB#$)r;Y:BA' 8bŽ^쑮#:'&BJB(r!A°@+wP-CZ20jh)fv͂aAK9J<"0 \cH=d„jI!16+rm5˨%gt`m7!;UA[厐&8"r Xrf'`3kr X8,0ݪQ:$O #{&>BJB2ɭqfUBko8&BN}Yߺ !QLY2:5Ȓe5% gNW[BZugifa92Hڢ݉'! 0 !r0H a鋞z^+퉼"'1v aI5F^5qE~)!DP0b[._ ^m"adk@V_UDn bEj !24|w􏵵W eRʇwJs}l1LF)Co_EDĭaZD>¬Ą/g~&IG!2ҿ̫ BE7 |I4'^7!DF^>d_Lڅ\lZU;>v];yHk5˼eaxn'W͸$DB-1zB!tZ;6Lx0CkU-Bȩ,&=)K]B(ƌLC 0B!L'B!DQBP9fB!L&E( !' fJugGB!d²?a|<7?. r2;Y͔0ELP9j+B!D;%DBBXu%Eߝs ysIQ͇O\B(p\p)|rT7pk{h.3Lyoo  !>) BzE"`ij@ B˶)Gt!B vb -߽-Bqzg')7w r䱙LĄ3Hd޵.B1[ɔU<}"mח\B(D}p B2Z IDATXky!BFl]B(8?1œk^13Ȇk^!L3NABtG!QXLTm_1 Rj3cd䯡p ­0Fe8\B(p?!{0B!iϥf]B(`h8 _"BfFUx{VB8t#[vG !~ +rZ = BR<0٩՜Av$ɒ B!,Ͱo)iPKyb-l K/ȅ!DKJVf}V, ayMš!r[ 9*BX^kCfdɽf PKkg)P}T|\!B%DPAB!,)zdo1 f̈́02B(eT `Gp×o O'ٽb3Wm}Z& BX>OK~DS BXB" (!B(%T3|/ZB!,'eZ]Fġy!2n0IN! mPˣ.(0[{ PKd㗼"dĞ' ы#5g B !!B(6}gߗqeδB!,k#21 Qm !BXa3 ~-NB(%5E}Qxe!PI !ǽK2B(!1i6AT, "BX`+~̡oZB!,ʍзtp~ỷPl? evþB!,Atq{2ddRX[;fB\z!"3rqa, j7 !BHZ+.>3OC(PN멅7{ںc/Ph'im8xVc1P ne$nCW \| gMB!,"a B,   !BzE"ʶOƩVsQ8&!B^Suw aXNph9P d3\lp¦B!,ҟFv-R R}B!,‚ODr !'}B2vVMrkCÚIV  a”Iӛ = "BX]gq7< B(PYjp&+ "BX ~ cV;%D a)(!B,[d1sa쾿 auá)YkQ; ];"Bg;aoʢ?rر$B(9vic'B(dm'B(:J aULW.LL8\Y!œupy`?_:' > e%B!̗^虮>|˛1#̋/)"B'Zٯ&_Z a=- JƪJ''M;u"B+fk'_)"B篇D B!2ɏ.;!D0"ͺOWw$Τ כE0²"Wk4uǙ[kE0{!F^d֏ǻ~x펳]Bx\2Q<1ɰ?Ƅrzcg?Y)Bx\gk$^qFhL+u\z>qx%*!QT 11ǔvظ~ ԩT/:ݚ&nwB:ZV@ Q!<'ojQn*7?]eBHq0Gx,!N<!畺Y[zl;+cBHqP.ǀCؤg"Wm7RwXH ٜ7 >!'O(!FxP+!(43֍?P]~û"3ǑMJ"8n1dʡC^x̉vw"+7.#8ow-J3[WFs'~J9 aU3F8n"=;ɻY@żϺ~H+ou *ky?P{|Z.W.~Eyv0ky[/_jT/~1IB:PB-E"t8)u~ın a%݌~ܼ^v_ɝ뭿sLZZy`a?W}Y\> q3H ZRu/~:׿m۱ϛJ/OX &U:s8kuu/ݮ!hk:+CzzB6BݟߪM~?+F !!܏vsɐo! [fŐxA\5f$yP+A3 _ƌ7+47(cl!$,1%%Bs [F a C^M0TB`> +BBxXˆLſC8|Bl!$2Z!a=B:XJ8|L{0h! 3;SOYʒ 3BBxF,d?%L_sf}'ܴ< BAoBrFhOJ4BH셸MZ(>}>2a`!!8nBirh }Ke fb!!$%F^x!!$0fr8;VBC~w 3d_l_OExМ+e!!ܷye7!2+l!$da`c`WCO6BH- v\!BnƶBBHJBHKy @G1 G ai)Ya0s ̱"^6’d0FH/3Gq1ǀg ΰx"- ޽65,t4XUl4$xR#guE%`HfyTvd{,z ᗴ\$IC|b,Bh(5!B!P0 sySec{9!HYS 7Hxo6ơ:=S8GGN Fa%EŠ aڿ|P,>8-Bh(5!B!PP%B!̪þ1 a5ZT|qZ !L{>j3B!̴źg!p(Bh 1TR(B  ! B(Y3wZ}6'BQo TPV-,S*Y[B(jNr^% fRa89Bx Bh(^<#B!$1@ 060C!¬&60+B1S֓@0[aWrB!̔/> JOHe!B[Fs|[BE  !YW,P3mJoffX2Q-M!Œ |Li`TGiC0G'vV9`wB(ܶ@ԵZLkB[F:&!BDQB!”vMeR1iz-o+Bvjy dfffz8tjPSq?dϝW3Y-X0:ɉ5&G#Bro9ofz0KB!eL+A?O{GPɲjU:x/'Bf+a*v.{ azܿmW1ݾ#BVaM^:E!”z-8z aJ[2 ^ c+Bh(0E*BP*A*7  Y6HmNgpWB!Ls|s)up W, MiXXafa-e!”yfŢ1Ho^_K a쇛 GPvkgĭQ!e I1@0{&-CɷZvU1 aj<>Dp#dhX0-%2!?I<B!La2J0'BwLYG-Bh(5!B!PP%B!^;J%ce!iWhЪ!p%kfApʭ&+Cs> B(~g\exz+β 2dJg gB  ! B(Sj㵺YB!Zi2r0PB!VGp$e$$Fr3tPDezF!# B(SP%"d B(Ţ1`d J(B8u &'p5 sB(ӧ]9jm!© !FPͽPVFo|}ѭ=!)S.57s\RYЖQ5*:H6T*%B!B!LʶI \핂 8MZp B85?[mRWZ!)XkVMJ.D\PB!I.(.[Bh(!!B^^5PS\Bg GB(Wt<&P'n/웍d=!‰LF?ԅP'nh.r 1B(j$.CPI5B!A"%z<6 #1RP'g;r!0IZB!,&EB!ݥ;&!0YwvP!]PʷZ> /QB!L] Bt?B!zV5JpiB!r/Cw޽FU]ʥ@-/r RŰQ7fB R(E@QQ1o6]hvϜ}> œ3‰B(>: KB(9ñ#B(. R!4x֪#'Rr8;(B/ӈUGGHVFҗB(K-;p||#4/Btɪ#7nٸPsՕ).SWB!t(|G(:( R[F\ a_ 3wY9M!\K-7>Bt1]B!,\#BQ߹tQ!`!3 ;ƄPs;PBMP!B!,<[llM0(BXFW_Q%S'&NWnyP8Աa@eGۯ4@Gn!ˌ, #B1c_vfe/k>#TYkfnUsāk۲ع?yQ_Q3 [SG0kV-k+;BK ~#g"6U>efEy-f!b_}ԠԂSBmK"nf9Z:ݲZp~!ҙѦֈ% O9\b}& !vk*eaF~N^9BoѳkiĻ:Cw,/v"@ az^q`--Fԗ~칏xfhEk7"23}o(@985%^8RؽmBX;WSXWōf@Y՜ 36=bzLCC8%BX!>yt?fNoGjeԒ#5Cm2-=1h'^Cx:d1b:-YFXޞgYQwpofdߙxX+y[3\FO( R6'O:"ҏ/ݿt="^e`=GhIሐ#Y>cu'-3>^Ch=Q6CCfV}y2-%Z~I^S!wP&0#7G}ۆ__҃lQT!=J=">Dm BL/OyoWS}p:];fAص4-YYBˢJQ aSӪ7 -;z۵/S>G BXj*?M: lOL wH8 KFn#̄P!DPu5:j(V[]԰˷PSP _iek!`B / R*6; !| >46eQ3 /SciR1\s@!!qϽ@]:vϩQ!t(؄Bjun|D%̿~M?97^y@R/+aN?R9c!Tвh5 j+k0 nCWc!TP{6PPPB!!BPA!BB!DPB!!BPA!BB!DPB!!BPA!BB!DPB!!BPA!BB!DʖPA[VBu+iÎC ?T%ݽnQT̚xrv;¡]&O64 {mm}o7 o}+;W;/-WGE[qs𷘆>CoĎg wxQ1mō=-ΎzȊ{;NpVW֧qqhΞa{-X5ն(> 9;XLnZ o{#fDt> l sޘ $umM[9c_D7rv[?'~G4o}hj1Tٻ(5 120 @0Yh~vwϱf`OYIOeYV_g ^iG#ԇd384WS{y^ fAil\5iDK]Kav3b|g OмXW#")xqt׸y[f Wda'}؆zAH5Krn\ Je">wbͩO-Dney}ԧ_%W2Z}SR;ܮ<x=T N}h<"6GzfAYD|h. <1N}J[\2fD\ JmwbN}J*] JQ6쾨Sv ݓV蹨lﴏE)uW*R_7JA?$f榲m ,TQB1A8P_?Ml7;<Ҡ OI_x6 zA L"K$_ljmdEtRٜywVLc0LNtm~4luZ7Xg׉Wb/0UJf?V.aA` FsQ}j:yQ|rq~CG Z<7\8ϵW~xx]SYfsz3mi w&#f{ Z%4Z6"6I^x:⨵iċ~{IrJ3ZHtuDA` N>w`jTfM 9Os5˻LW?uv*Qm$/‚>pA,M0Y 𒙯I.{;wOzi'AXTBcWAXg.ss4AYii`Ό#j?m\:yOW"֒A1[}0އ4x^a>~mr9,*s׹j^2۫/ZEAXg.#>lE³NѳJ;Ok{+^u2>pAxy+qVY ͯwjMup.מvܦқ~ʽlJ ˛'ZhseQU13丿9qp~ѹ.b&}0وRVyZzJŋ0{[#mDte!bdYukpF:k$[Kڞ%N>킰:җs>ރ5(e/nniGT6'7`{W~a:ٽEJJډNlF?nytM Saך-oMXK ܞûU^hGlr_0\&jepj l=;qr:'4e[TJ' +';WkՇj?~sWvE7̯D͜ ryq9e@(Z\hֲ%f#{al޺ҵ|fG5O{p@ ~ <O#Q|IENDB`metafor/man/figures/ex_forest_plot.png0000644000176200001440000023644014465440735017715 0ustar liggesusersPNG  IHDR}* pHYsnu>PLTE999|||&&&eeeNNNZZZ222***jjj HHHqqq444 EEExxx ...<<<!!!111uuuRRR___+++WWWmmmUUU666OOOKKK???$$$###aaaooocccfffBBBSSS૫ۖXXX\\\RRR{{{gggտ{{{'''֎rrrnnnCCC <<< \\\###777vvveee---111Ȭxxx'''```zzz%%%RRRضKKK///kkk}}}bbb)))999???GGGsss ggg===TTT[[[YYYqqqiii+++PPP]]]ӠNNN444(((WWWEEEpppѷGtRNSܸںйųǽܷڿ࿺ǻҹL{# IDATxwE~cDr rpq\B4$A\\ΊxTy{錄;{t]ݝ$GQKe½m7X^[_M$O G>5j`.R[:vsKo\^)U`WcACo^\] w]зzK{,c:t{+k?3Ѷ [zp{j B:nvh|||gSg&g 4qvLlm!t?ﯿyA8?~•며CɶF90Bqly7/MlZ}ֵnQ(/&={˭}^_,lrtbabvCNgkV:\' sWa]7MMly[_-O[兙#J|}w+j k_^Njc{YiXe5,^ K/I6\hv21Ζ~ '<$֦\ ӕr:eE]q*ʷ?paSn5\ )? ;|rkA,əc!@[_K'B7ss1LYI]KEMAx+F軹Z@ fS{*?D\c hQ_}?I -nV*gcd͜ LB> _Z [= &%Ȼ;!֖^=\>!9AxE}ABVl4^Q>S; ;/zY9 ¼VRܟ9s)61IApX L'oĕS+uB7a^}A6>|v 런|aVA,vGBuN~X- zذK' a7a^}A6Ґ0Y%N ԦV};[uZanӒs!"*\*zjOaUMS72R'w1s BY-Ԗ$*- ًuf8:Ri%wÉR`O ;Mm}0AX?9TU;g:uuouV5|9FG'Lm_X_/m ~QI) ,ъ|Z@!vRS'=ձiוּgC`Y0Ͻ7{3;k63VHg5>4Why -lI"‹^@̮6eZ/쎸+RUzG *SfF3d_zAƐCy+xı ,tUF_aSm:{ Th W\UuXAʫN {:S[0Zo M. °4e_av۾ŹvG&ItWjB񂐔WY]a*(V,yY# |}>P3:jGVc" a5oaLŹC/PI.l:|n?E .ruTcqf [*%ǯ WY]W¼n0\SC1DNwhR9DEB D3A\sn 4V]SZ Yעq T^á6u6BX?;]NWj~ ~tAh;Fq LC/ϩtI{~m"# 󓞆BR`iؓ}0͗fR-_+Apf6.]xM,m3i7.j/tm[2fq⇷/i,5F"U_ TѺرrjR{qM2MA_iNyeˠ Q&nihj1| khFFA t?GKx_iNWP6&c%&czu:c%ы AH,LeTeUdע+a hBƒ}Q^a5{WBq9e!6abJUgi᪺g6־?D0@  fa|mWx9KN 7ݛi3e@_їi ˨y`(ڼ j*jUΖ\pl7ёf]nw8G\=^MHAZW,@(BZܺ.% xN"uF-e%(r}E"YKcl>摶SE <mxXѭӵUc\wg|U1)bz&`A]ZAf1$PQ>lQ'B捓Ƨ?_+aė}|ýn M2MH@CW^2kBJ5V\^DwmXo1E滮<Ks6GހvaYf-bPz%/sd_r+놪vزpغͭk ?PK/wFͼP6Wa oYTehm曯6MqlR}OL'S_ p`m9iBh0dNCtwUh@ j}Ns;nqM3tӚ "ɫCI7Ŷ%0~x9H_9A4 u t"W=+BLs @hTtc{ĕڂpeπ&&D m[D}I@(b@ˇ͛k 3˥$m25]9p܆8T}&8gw& o$-}q}P3Ӊƀs-q!v@Mu,[HD`'8:aҴN1Hv.i0;р3r P;L z/ϼI^ BQHPSb$ٱ*U|:ı=JA@qnI4t.O$ h},fR6DӄQY]OA8b~BAx[E:(Yu\iH^Y;GoBnAaD[pD\{;cQyUfk񄃰@EVS!W~RCoL ̄'Q_Ju Jx~T03MCG)L>?L!h># |NXF- 'Qc]5Of"uv3S]yQ]v@8ioU 0^OQ8G\ 鏬eDX솭$KBPիkJ$Qk<2[ޡaYhZBwt,}<yJ3@8I.nN]_EP_ey"-4.sm31/2kjd0VcׇkTmS!Wj3xAX _e@l'S_Ju"4I|ח *|0y!C!Q7Nu0jc%,I+@s;ı=J@גz;)"@Vy2%kBp|a{?Dz~L0!Ao2ȣ $:"#N8L֦1ǕkTPa3KRl#UAGl L s&<641{Hﶨ@H~xs!a qf \'eMRM}?*Oum\ͤ% L֤KbKUL-Ug)ʎ9jn4cNadN3܉Ѡ&{)PS2FHN ,gw7r=Á3/VfQ?V $̏{U[ $Å\hf͢zk}%ꂐU4qlR3l+&ӄ'? ԗ9e:ZBBY)]FֱL c\5tɴXD48 Y\MȚ€umcc(8_Қy!9*Q0RfFkFc61HMϭDO*DQ@,K,Fvefo>nnof<|wf ˙a%Jkv,KN/e}QikJae廼Vf5 5d5NO 8nAĂĶ" ^޸({F> %3jo`zՆd1Z-l­_\|E}6{ifQy١V|;"?6\;'쟞b¶3,z+˒Lʎ̆oVyYɼ{G}'͟P5UimB9!O/ra' 2$^Wvkzӫ2| %TՂG2o,V~ B8o%nT)wynˈᬾd{i:{'V qgLtX+#&M;߽JVr}̘s{߈*85=~s)Ævŏ=V8闎>4ǗW1r'֞c2n)[MZ3NDAb[1ۦv6Jb$,L _%uyUoΚ07sg_=a.] cnA*>р;czB@WǗ}a8׊@ _.(68\rͺeQTbܨ;6u=}8׊LgtRq?|M*[un}VKQCmƱ]VFI ‹=ʭ'8NogǤS8{CoƱ]VєO܄afqt^] `Hac l].3C ! ~RpK h!=_b_.Ѐ)uN$Y$1OHsS:s"\# ~Vkܜ)$nPީ$TN"`JI>6E qI-F=1jh5}PP!ݳUKw^3 :j~5܂گA+PHUlu!|{}vY/R5 k_U,eњ_ …Xn6P]B֝f%oTBx35 |*]υP8jMx$cs~:[wnf5ؔ޺nu?ٰ5dC 6>;X%{P'g+WBx)tv!>:X-8]*IROϷl#@ IDATmF6[< BKkv>Ӭ@{5g\O*' H*Fp?^ܛksy‹r6oUk襮TIMBcceFwo} Մqm~y>1pHg!l L^,ut>OJZ_e_X=_P`ڗ Ƥ،mLi'3ić6t&N3MqwW.WJD$xcF  *(B0%*(At?ٿww޽{{w~^~w=vH]5U+ !.t[;t@d]GYXnS!j>ugw QzHRƇSʻ(!>r{hBjn݈#=SAiӅ|&uJ7i6[>e=pV ?&y:Uy1sT%4)m%ak!>k4B8צSn:qD6KZLb@jY/!cˮML\# h,,R%}@T\yQNhO.K8Pl4Jt@D "hiU% Q0Z2V2fʺĘ? by ˅wڽ`= s6KZLf ,04|@u3IreOQIѦ.&utFmfϧ7Wc{PYHx:@q& +)(7O(a($$})1pιF#[tepy+׈֨ql=yɶBK m8)/jB_jFtCDžRe/QYLI}XVXGnRR4,wC_q/IR'ifϧV 9C> G1wAL$/MWc`1mlK!i](T_ĪEz;.ƕTMK{ێwI}:hE;.緥qM֝mW~ŅY6<2f)3X@9sG9#1dC)ތW#&DQIBm)6ST_(J^tQ qBt\GBxِ+׽]s=>r}@"MqUiQI>(˘}i{0^!fnͤ%R-l*׈LY>"!ui!KWh$f01]XMD2 W@O1-3W>֓R_䎭۸PKKt*v5 r.O,a1bxG1#9 !L'nKQ?9R[Q:LBm:Q_li>!aSkYqs]i+6Bu / 6 a'4 b]ʯn,c4&Q .DX6g6>&Х,R]r2il9^}k>7 EB%J;Tz7^cUM[Ш7ʡ# "˛9TmZV_ĮV4 }qI/8lBY #WV+"L-vB(|0lyآ~O|BlEf0y/wJSi isV aO)qٿ>U|ſk2wLe߱+Zm|Uu>Y$Rp&A_aĴ6@-|3 !Li``_k$ڨ6a$?ٮxüNKP?'$4g.; ̞ka&*m p"-v~ A T>vB@3J~4m!|J)g3iJ)fGaNBe^#B|Y@65!BB!!D1>!|L,'@!uB!B B_Q '@!S@! BB! ʷ oZZ '/B'1߅/*8Yp~b> '/XGB-_'<=uɲG Wxg#O6 Z='_i-GR_5^Oۖyney[9xK+xPVWlX5g=j(d M}1&RcI/_")mUJRnJ5X,N7׾w)eEBEҶa6gMf&Yi B4X"(`RcVYx^)I]-+wsss78/vg:kk"Y?Cd\ D-ܕ (袞u/oezfzz3I0.I,xe~]7\Jߜ=;}nvl DrO [k ca4+X%@.}V]bx2]AEw"H,oq|*ԡ%؛ e)5݇r;V!0j$ZbG@xOI[wSlb?.BεaJs8_zrEE(R#rb`+`lxɰq4$$E&3.94-JC!W-ds* @V#2q T1y$к5b@ ۍ|WQ0 @&k!B6-;>u>\6_k?,m] `EI]PRC#i˦ɔAK7*njdZ22*&oZS,S x9|kq9>?8)s~Fqeb3hϚL|fߴ\|^<',êQXoNfZXwr;}&t (c`*s?Em!s̬@m/B=ɛmHiMY64D5M?Ra#TYD˔FƀP$Ӳ@q qtH\7qZf&Bw7y_$,rw<}(ak@ ݫT9r_߼ʀ03 _?CL/0܇+2zYcT\<(ZJ= uhm1e逰Pi5^-S3 T1I괬$ȺbY^h&slZ0 x@nqg'jȜ@X R/H L'zrp+{~ƒ`6-.<#f/U8N *i~41+se5Yn7q['{ 0./*ա4m1w$ne9, ԵeJv*&Iȩ'Yk %c1*&~ka̡4vүZοcMl~/ƾKV 2 :@O,@V0=o^Q}I 2IO/˜˹契k3vLl<ņfWа(5ġxdt+KO FVôL΀P$Ӳ9bcy#IV zlf%T-Y? EcZsK"MoNw5;#>>+E%w)m1e| T 9 Zdg@biYZNMX^'4M*~#_f!ʖABqQ d+^\m$w-Z@H{D[$}Qtk2ڇeQBjfc.㊒Q =8hhkBή9zGюByQi6OmIhrt$Q.?Zdg@biYa]X@x(d/LI2j|~3J7/ak?@H*wU[ӭQ(,%Y<\T&ceqd^^T jXfhmQS}I4''aF=RZO3*4F2%;BNJTveM.&b <O;6W#z:z 9]RTB!̎и2dQRuayQ8L΀P$ =b!J's`W3'# Dln_M4XY;y6BYܢsx:`t"~iI-%6B|v&%EV/v  -t 'Op0jZdg@b =b|"[1ajkYORKF٠ l\bOgtNEB>'h-J6Rhi]}һXA1 F/Ғ ׆,nR*Թ0j\Zdg@b hJE_bn o:(؝Hs7=ʢISTΑ-@([TM 7nMU!#}[cGG/L{{HJ0{0'e BCŠqkIZa%{;2a3٫:\Ke(4O$^sRg-3]Y.@` w>v1(moQ˔!u^BoXW+?8{I\t@bt($ER@O,qhJ:>?#^Z|P =j'NW Z@(GTp[O M 8KNτ<n~-۶))CD oh$mF+b>]B#j$Zb@biYu9r';%cQ _ipL!ɼ,pNDv5at:Y%>$Clb\ٱ`w|U yE !_a9O~cE٧6i]9XAɡ5SShEN_Y璢(a -:vs91wR jTɬb[[0=euwAQ]gC:7c5af&2V%͌jf6mmƩL3 ( UDT$G_o=u={Y{ww=>?7NӣY&E[>t[3,*kCfEi4d&/s^ZFiSd-,>h"}|ܵlY:i:+3Sf& &ҙ˞ĴTyG̬/1]иoƦ."Pצ}3s36oWk&/\̕aM`Fw~g/dݢeos8}0º?3ˬ<4mI`zB_١~yh:8qm 9Q3Z~ 2LLB:y8QIfum);h*T$E5w'\,[Ki~ԒٿKT=~}'d_76wB"C% EfhjHB0m o.P52|ڠ}۵F'p091HH5,x0xu(G:CK6}1+s''&(fz}IedN]5S3S}i sqiBvʬiˣo-0^NZ2kzb)/NH]fhjhBOs&&&pin p1Oe$&uFo=}V^N~#+m)5/ ӹiÚC D'C!!j{Y a: ))FZEz2&; S0B0BhuBPjD=&&%z@T1 &ZN q_-:ac )Q6թ-dżo#t0;GRqq) IDbIWh:555#p*rs%fHL)k`!$-i6䧾GϮJK\v+/=O@sB̤ķ`qհįg◱ @5a?F| bރ bB*u 0B!P#7! B!%e`!B!!BB!nB!/۩FB #Bq-FBqB!!B@!x&l!g#!G!2NΒ)Rǃ}5vܿ{sl"G#}(R VpEXr]}])UMrO-:]tgGK ի{vȢ6S}'n"GS)jd;VY:<2N2 Y \D/ˬ/(6ÑH V0ԥl;kv]N+?g\TVTm]R凭kK k_ԲP+rxE `Sw9ux>~\jv#I :XA2N  Y̰noLc熦x a.žf{14\h\xd\KVs1[8Ɏ鿣#>'j*. Xc8<~Y RY@EuzQDߺ܆A2N A4pj9vBZ'{b^sKCq5>%*;=S".",O`jiyݱh}TDRviy[hVa3=~8t? ʍ1u")F'xIy'g,%o'yMN K})9P:RbP9IeJ7U+c $܊H jRϒ%,tc"G-} M"`n -qA!~dqrQͲٺ*Nn?!HtU͢;{ ftUwݕ>;QhV; e!ti4v^sQ]:BǷвΗu8"Po.;Ҟh$WgIkSrJrLj%y#`n -qA'ebK289(fucT6vr'UjˎW ({M+SԒNM?mPvfQ\ l.H,l+ܣ.. nez!j?KtDgQU{xCu=)EQ=x ^`E8XB-* bGlaq^YF!4dݦ\ *0/jSnU>!v:BB8qrQ n7QifOiT%QnL+ |ZJGwf+ՙIW1^ջ-ėh:,8y[dl1R m $8PJ r*)SB$;QIZ,Յ*E B71D9 +Iι3,+5jӋFUb8~ლY]={f!+dFP&'QXkmQocj>_ɋRL2P?}"tK?SLtEo aLG2"gYɦwew t󨔑VBxnɱ%wx72m}1pdB8-!t8QF,:ٴ;#9N*-)#O 9mơVNCUltBX\ BʷQX0;)Qﻈ)A1vO-ꗇ {qg(-ㄟ̩輶 '=֒)w !mp$B52)ʈeB'v]uXLqqnMi1S% o9)"E*xm"1qN!C]a1͌7n Ij=Q|x.w,l{){_r|dXb΋B<*.eDβ My2qRqNYFǿEi]h|.<-0ÞNA;Xe i]no2eIJ,B/p)+8 '2,s3{ Cᒎ&gxOKї(R|"VXC9!6NQF,:ڤ;gڅ󩎓s"e'Vk Ok7s" kģ<!ܥ.ƴ an:e"ʈeB'wp?N"ΉCOFŋ#X{ Ds !U#?]!|ئ--VEFTY4씷k*eܩd%]<"đ\;$v%9*˖RE}(rEgY!N"Rs0>oAe=6QF,:شpWMYKJuisN#3p vW㏴%}ݼIWE~'.ٚ|6BX?B=MbSݖ͢ ^MkENC#:"ݸpV^TuDJu~F/Po˛4Em^TÝJ; CY E`(#rEmH2IRlZ>tC6'5 u>ɵJY?[oH=}0XX!UB\[-lkVٞ͢Ohg'6!H=u#OaX9dشH@:xmG&KwTWwNPFu5辇ޟJg$AmN:T́)j<ὓ"06QF,ڤ4Lɔ`i)L<`´LD>@7B@+n0S*0JC >eA01)B`. ڼ%mpnn~)u9 !u*,aBB!7>b .B@! BB! (}NBً_ 3XG!A2!CBB!!BģB!d/0!tUJY%= Fg3K? d ~b|pu6N!WNd1q6 yX> :BYk %$3dI}-;p)onxkY+f{3x`[EsK^hQR7ϱhȢo3`Ԗ9'm<2wԜ)k~,3kEhcw gO뗯7~7Jj9@3aME_U-31r/pIdL7MΏ9SLYvB{DT(W5!m@%E#N#P ݦǓ@'ÍjfpIp 04Tc2`8aͲơM*͠LsM֢2RgP> -gaοAⶖ\~k5+dUOn6IЅ@'MN૩% |3s/<Ìi؃@"i rhdlBoΈ܋*A92C Q^[9!(]S캨)^HɱaȬX0n|*GDZrՁ;Pc@|sV[Ak;n@SrSj՝p>EMʍ١vCNj檹@ .T@BX<0.D3C]Ō 51},nI5L݀O]0o{x$ƽ?n`VLʌN\[_~\#8?%orj]x Я #Zm-I@xQwlIЍ@'Í?b <ʛZF@'@K^ -~ X8u4tyq5`4o)L7LfE]|uW 5`fԉuzaUS=fb/}'B[0i< S"!&q0v1ѫD\=*lk)U³H:)M?ns@S2ΓB/R@H=D³`H2N&wdBVJ)W{ Bb 4߆\rN6 *qxdi¿X%7D%{=E@xv \ƨ<]6~i5%L$xSgX[*#E}g_?nyt `gAQi.Ea䁻N~S45A4e0)7!}wVcy9YmOn#L.mQPiK;GxnہP'͓B Q- \Fo.-# pcZc#K x9!5Z7+w|ɚIv:oj_⽩q1RoR\*DΉ RxN%opn1D#kyS)!&wScŲ6Yzե2U4Mg~ u 7jsX4mex:)c| kf\L3MP.32iGRh"$(\,8 -L]xE%/4%&|YHn-A`RI2{ե2UTk֖I68[n@(I))۞6XzLp F2cdæ ȡ@b3^V&Œ:ouϛP-2οR0Xը-ZU:ǷH+fAʯa.KVլadro5xII}뤧aڥUBI:=Etzar7OF'C? Mrv.*ia S~#EVGG@xB$m2ҀP>|ٍ^QMFlHUcQw>za,p=aD T`1_ǴBe֬=8VDG,wBpƘsO97~dϸvf=uK[%gҔ\6^Atu|꾋̮m|grZ_ W~x#Q +Y{gy#3NBK} "U"1L`mj$dv&D[':vGw Û iRlQPFS%F2ww{ދ>]Vy}S߅[6IR49'ƨO^X4+ժWLW\#n"‘jE>wNo1|'5uJs[+B2ys8ҨLʏ%Fkoa M1<1]aL/&'fIO˥md1"XZAչYC="Zuj>bX-/W+&Zƙ-o%v-m IJ2y+?DhyS}ջMpT|}2r_o=2ͷ,峤H _K0iU*aZ/B^9"<%E}xś6٪y9I f̽qЉ#\4S> 0̛l~.M#CQbl9KVNXLadN^֊PL.^4(cHy+^gb<9[ů1Mur2GسmH]9$'˚2*޴?Y\DWr<Z,xqy5XDi8O3ʶf/[g-ߙ;2@g#]T2c)s$2+|"dA>-gDVN2x6.+kO1Υjd 8X"sᩯ`Dtj o\0{I0Y.B2uzqpQ}" ktV P0*e܊0GS00ҁ"MA VA$D@ F Z(gc" J0jH^1 VVӟ@ @GS1"$SҢx.} 8&~Db  H\=B!X & C@"L+#"@RJ"@-` B @!"B BH@! q)7` B{!DHhvS9"Ka D!B!D""$.u%1!DH\=B"@"ʶ 1!DH`*1!D"@Q+BG #O B_ h"KiEΓ]Ty}c}TyO8B>"z5_x<"UֽAt3n<+qo +SŔ]:Em MѫLU/s:[?N V/U,'?I+ _F^*9G|QUP3"AA.)ˑ}Bϭ;otϹcfegk˅3k^N[FϫD׭+cʔHה!/nm㽫P?ʆXEFxus t;$\%=Qm!JʘTװHyEX5baG[^_P}8AʂNiv8D}wb Gz{9^=aИ_`j*n=,!pRf~ $:,tէjH $֩輼Dn_DJ? #cD85|+DmGLڽyH'.^en ۵U :bq=cVqn ڥQ/BMb&9^!:Ǐ!W>s8I\Յ|nry6_i@7WX$dv`oL>KҎn縎@PCPITg+BLN*ű[1Ѹޞ1Ez:o ȟnV}7D=\(n}?Q.4oXuD|&یyPP]Fm,fP$_6~S*;k/ }U"ĭjԄx,?ZEѭh~%_.)E+CtR+-x_!(^;"?@%6"-}!>]/,,BLAyՕxpQ*6}",m̹"tdvVڗw6CZWR"t rMq2X]SME[-D'l>m7!QQ`Al&=IM7<מ{>B1WzBbyŶFʣTM+vpjvK| B* q 3q6soz}kc`Q[w"C'²Zq5BƮc|Bq%PrrK;ٻsFlF+ټE)U%1áMD}vPg5e6&n)E=_oeC"Sn>pp8R~= l!#BɨVglV8mW+nz9]hr0/`y .Hy!hHBJ(\Fc66iui,?gFq`z_=B|d~9^"T n4o]* 's&uI fSk<5ʛ5~Cdyg E+~% [@OekRG|ZRX-GT58tNbl0V;犯06C77<g`!B~Ҁ#D ˇKaB_/斶ݙ.!+Beduf hg[嵎p9=?{"[C.ホ2Ey;2X>銐5(yS6V8o1!FN%gwY>6<)R|`("Y'?&G tA$ GmҍۇwOp.maW"lw,#D ˇ̳4ƌcJrNv6+BedsIz>z*e9=:: y]k f#Bښ377sDHXD[T1T4)\m,}خ({w>q$ʻ}~3kB[ @ZgKj퓏GHX>-/YO- -,PU(43c;Lc "*)S.K"tgz޻e oYC_"̍Z tDH+?Tm]bG{ S7_rپ}RDTt6y[#|UVk:^8uO%uWW4J#,A8=B|4"ܩ>-M:Xz$UPX2cg'/GW@6SO% y9-B^{Fg Rkn4B N@XbӵBDA|ڃk^*Fpprnhف)'l*^y}IMclantǷrDHaeޭPRŤSyC;|&s;AG٘U/;IJaZƜ lgah2H4ͮ"9c7cC0W?~DH䖚pGBBt2r +x+4 3p۞;ELVDtgH_RŤSY͜HU l ,1H=C]oK*gݐvfΚQtw~n:w.I+ˇK{鶜[ ˪:ҷT3V2bz׼0!q;x":{DHa6/6vgB%UL:NM%3"bFCl*R{}Cu-rւ)w-H_Yj@v&[jӫozh!!B9|Ń'BE!*U?t9cŋ<"@'S97]]~b9"BnLyb5Sh6c; ՗D1Tkäƒ'Qcv`8cV. k-7sv]g[^͙:y'F͵#/_di&q"ٱv!=BzaI"j.|ب.%rKD:7oưUu\;gnTdX"LۊvOoX7Wy/yx"|lDHZ鶹DpϱM/bҩqNü/,?c~wŌ(Ϻ!mxZ-oB *v=:a勫G.",IkrnémuM2%ꔓ932nXsgnTdX"ԲKns<Ԥnsr"Lb[ \k]gɧ2)}?ŊPs>1HT&35>Tҗt)_`%jԍ~gKxܿ{% ^2/lI=Br!sK1~Ë"TYG7!U3^jڧᑔ1s×{lƘ fk8-B bZJ鈴[u_#N崭#c9tץ\oltϩc`*\o{}~ّ6f&v$Be\TR9UDX8_e!25({ "‹ayA'P :2Dx!1",kr1zG^G.B!f3 xNPPQ!T;͆0oO̓qM kʉ.lTȐDCxd;O=hȳ?q gpS9GV;Tq9 { A<'ԃơϠQk ߗsdBgˆ?˱ ŏUd鉎Ymҫ/P 4%8ՈOIi-' .L9;GzI^7ԄnVKxNfaz Px8^6ք<]W6P[}x}I0C= 4\)C?1Z n##~0=,<ө:]NE"2/Ơ3ڞ<ٹ  ? `x~;tB1eF\Oq7]PݠMtajI0oOʓq:M )(Η{i’iһ-AO"u2V~k販Ė.hM0gZ94[Nf`%2kdd47v o=x,`Eu]6$^){m·t7l)YBHi^.I&v|$ߕikg%;v٢ Ɂm # !x<)\ekS?Bej~pՒWy35~t/l$j!<3?Z̒5)k@nHɼtcʶxXAzp$>,`LX1fB 琨RZ*Hf2m+l54ZtZ5 k &p3c;v)jI1=HBH?M/_g~ Z~wv\=\5!vcگžoί5!>CL9\M;MB {AW캦~Z‹8Q%y҇rR.GoiWSX8-·z14A(K1hhAjn ;)2ӗBZ<[SU)8 ۃLk3&]|gnftPQED}m>Ұ"*K7N)uVC)+ZBk>P=9<``%eـځ}4<-99S.p%"w>t,ֻvkJ5,a01gZ:|_U8qVn89ea(daueYEHd}ga>4βᎩ esٸ4\U^Օ aq0K WVa\qEauFeuEdPVS^`X{0۳j&uUs}+*;yd!*jZA!XZu :Ie**8)=T̃ ȶܑ] 0)kaaOPa'?@ʑz}*=B!eBR(0< z ɆBh?Sʢ*!ML BӻLXy`BB"i(Ld0@^#0cWca%+R#.G Ь0FHUBB!!3} @!r!˳ FBB!ɞ-[a!`B!!BB!oB! 0B.G!0B0^ BB!!B_܂ x @aCFvKY^]r.o?qeNBS}nZgMg_wQ-kgKm^_^wnuhsc[NlFL(,am=+xd3w@|;N/ǥ̣W`\X<&S{7`'p-a7?-i/zwf6K5(/OՉss@DeӂmI,?OVK‹9lO6K}=3Vtr%ڢDZn N{W9krd=יK7iE C]XXˊ>eC 6w{g^j/F䢜΄p_ers@dO &Wei}Lԍ;&&pFz\ko*h;6SDh:Imˍ5{)̕Pz65M(,-*LGÊR}-t3u-/}DV"(/E h'w0li{,vz~wݱ~)_2}MpޏcE0WGvQe>]D]5K7ibw1jo E?DW4n[B_7\"օP;W DJ=Bx"7.H_y]7Ɩ=ug޵54C&9(R,,r"rE=x&d'KZBf>Af̳ٝ;{3ן9 s<a}ct"=۱t :|[t␑ 4ƎL+AL'_be]5jZ栊*B]ևJYJC>!`<7e 3YE@X6UL@E3 T a ;HՍI0U#V:Ζ<ފO'0Mn^*. Rmo #2/yN[UA/Đ6|yLtsr+I'sQq:e*M?B/ `.7-Pu$S;R-Ҁ5Q UBOQX xŁBh,7@H2 .nlݴA( $ ':ȈSj>\\n\NO#D}>Bg{_c[8w6Oo`[Ncje*- ߻/VѴp$1rߊ7# ,D*P|p6˗L&9RSvMRu4HDL%Z`e>o~ 8j5?g 2xb.H k^ܗ;MN]C2qeh_id fXH{RYJ3|C.cύ=o6Jt 7-m$ hW]@D*pDb9,]&T/?dlԴOJ)'Җ,2 kC>q6I@U LLf˗wk ¼%sn8; Kk)2 I 0W#O,De^]b: v SägyTUC訽v4kEL@8B@Te"a<Nfn];-ԣ@xa3s˛?-jHC>a?Yf󭅅Sm.:,W6{ )e-{2Ϟ"PS |g|L%5;E!Z.1  {$=jy޹ΏU.ϵ|Jq*!'(_,\@HmVM,~hga0 8L<)F\G N5E4j5eW\|!]at fؕՐRJ?IWf1N"=!BY^*-'n944>f#~]Vh0DET3 T !<_į+Ya^Xcjmf@YЬ]@8h6m4sYK#抝l7BEַ_e- Fd+5P׮nN%4R,o –猉s0Bͷ:G?8zI@UH RkDF!w5RdgZPhw譬2oG NGa@Xu0]g.T3 T !<_D]O),a 6 -Ž`Qmko}3c\a)$ Ī]&Bq>k4 A-*#ҡ #28 ZOeTZ! v>wQHenUu{RJ 2%Y[ɷd9k 1lb:?I| H;qēv@x M q{*N&`xd )jhn$}oeTZ! Y k֒D@,bI68}"LOVɒ..Rz#TirU=XqV? ն>i&j0TY4BE H4U^:i:Cı%5"a!]zKVr Jڄvb:Zv1@~j i@zʪ;gp8I IDAT43?P :. pi-$0*,B2Q@h( X=T\+^7/ƀPގ7 B5megm+4) drB-77ڟ ,+&w%|}[oK o-Mnu5/*2@jf{9coHs&$0izQ;TU&ׄ(Bz.R@haY#g(*GZ ha909BDU3U2a[E ETT۽) @x;4r"(c  fnj]WB 1&9ʛ(D=z@DyAU@У-(=ZXwO]WVzs^tu_W]{ޓٳ3C a3{2yVwwW!!vo ? pB/xB!@B+!b@! BB!!&~ B! aBB!P'@!B!uXD'/]WtN^:6_ `# =BB dN6 BL. LDZ<^f!)`NQ'toirNٿz[N>D.ua{K#Cl*棓} q˔X*[+~=mٵoV᪠X`Rֆr!M Ґv#i MM!!U%V6oR2]y SL%K]!TI/xiWLBF6O]0ln;0];Y#u1)qξZy{/G7 -aP( #挝8YU-asʪ0yn۬ByB|rP;<ֲRcl#6G9ncU>M}>7TsZ7&hn:\|,0%N8kIm",8CB%{Dp8VW7[XA%­jhkTy SJ˭gB&G?V"OTȸ abm }!Xmz2+m&X^QL=-V718 juz= JoVx&1*\pi%ڱ##a:c6! wU $B(i̖4gBYy S麭"-q mf $DQGG]Dգg B(i̖47PZ /VO7mxO.j&9[y=MhIiz<'R|~>5K"ÔTauH$x8j0CB/V뎪BiS:-BW(LokM!\#Sⷘy9s-n9cVB&^v`Z- D]y|Ѧ߲W3ܧjV4GVn}s{F E.kYvAq[ BB%{D~eW@؅QL$UK*j3L=x[uZ}!lebē1;%/]Gc'SgQin#^њ vxAژh7F36?XVr۔1I6gLx7aRL'7g+?T{Ogr]PЪڔcvр~`L]a2N( #ң:7!!BIՒ aj+Lw,ܻB=RPGу'!d5V[gyBuWFD|"x*mB8;3\lMy;ۛcijO-䙾DYEi&JmِR\ Z=4Ai+eKKvy0Sъ0J쨽W7KP(0%By;BgZ]!3x6}mtB@__.njY:5v?\voJ7Iʳė[_)\vF.l'^"1l[%q雳wS$鑶rWú3Sj8AHLw1B(IՒ ӝ -F 3qūv=J!|3x;+I, AC_&;h7b=f!*G%2O\\V F* &E\g]3Q k%05c', "=!!4&JDW:oBH2[*+Lw.´FB|MEypF)K嗣dG^0*;(6__:'j^w.V4]a/N+@h_NfVxO1QzJJ`ʑ:@OTz̸Q;łA\`$-BYE;B_BxY5U!5ONNVzBxB5-v6|`^ߘgC}eHz^_U[r^ Tn%[7D,{TX$f!b #nG]=KTz uFR!UaKZ/!5>G%,u/43cY v/հu'eqo8uSW&돸5 S'¾9ZyF=yqq+mPXI/b&j ZcZD;LuҌv. /(" ֪h)FThjVMC$TSKҳ{wߗ{9={s9w熪͋ȥ$%B$E"g}KL>afl.9wӞŰ[B7%!|CL$l#Vnt2yUDI{xCTL9^ ۽v}θ5Ƿz̅(;6$Fpۃq&`"n aZBh)0'>Oi6M`$ %h0lӞI[3 Wfw62!M[2mr9^/X?:2/F0.$E"YE>o B@`E;n3!e{)w,͍3a>%Vs9 #EeIBhT?{V#JGr~Zl;rmr9ϸsq)~aę]KEʯL˗ :j MsBB(T,3]/I,0GY/P{#AQ75kB6kQ ?99yB(ϰəg{SIzhiD+"lQ3JSlڝ(Lۘ\a\}*D.&iXMd=:BȸϚyg8#ɣrie:rSgW/ӭB섣BXs~9 % 1LB(5cHWx'(H+g/5X,J3Ջ YL7;t&QXO4qYO5үC|YĄg(?b=c0``YI~~@񖃾;7={zYᙙ^z<ζmL.ǘ7(;5d..)C< Sޞa8%8/EϚ !OPzlXDPBh>Pfh7BIaet_p`2B3]z:O3ҳFF"BɄIahaDB/{L3QȄ^a7_3!\ԃzdADV|ICfl!2ț#p/!W&EK`y`r{@8b( @h".y@/BB!:#@!`!^VP9!m!\LAB!!B@!7q6B#@!B!W'@!WSXs FB@! BB!M6BewI=! ~G!B RES*'k\Nu2!oy˞FgLt_>sVo}UEE?_Q|ܐvpG]t֝N:NוI k۾$16e*UT\^X_9An"cn.7;iYT^e;X̱q.k<L;ƍhi׆Fߘ)^ܨ] m]򕾾"F>vpN2tvRmX5UӒjR֘ 4[|iSH^/sQryyQ醪=Z7|PhY[d7X̱q.Fmd BmJz@Pޖ%rmnB?QQَ!_9W.ױ(:B5tbqG%fpS5K%="ת 1>߬|7ͲݧqQdž!"&6f< nCR!ChqC\0],8Q~e_&S@F@mCpRgmmmC̅@n^eWKK#D78!\Navޫ#!,gzW+NzxWzrVu8Fe%nzʪaMÄ]ɨ5\뛄S"QK`Y5l ,WB:b?b|1sa(C8nEK6Uk! jQ[c"gj-b%e'yyӖ]Mq&EʸӺX/WsUjRZGtWP'N!%?MjeUݳ}X(*!aC!.TX]URdXo+ .~"B]90MLFPm[X ajQXD}LBX*Yp"Y6V8^"`g=DEȟRĬ*6w?l6P7NY>,Q/*$3UOM ;^޳ڒy=LE&xq;Zvk Gc4Bzwɕ}8PB/ׯkBh%чs:F \rvἻhs7m5:wmM,K9<$bd_d3&E""7ʢr8詞gzBýǡUoWwu~Ƃdr @X K0z7ߎCa}(K.U>M9B6B3Ƚ`W/O"D;WpM&pm l>^\\߀oy Ԉ* IL Z 8Թm/ڛ!该Mg (ӸW5GW!7]r{td&qWn Yv rՀ $3~Ƃeaq7opYYGŌ{@q g[*HG^$e3 ԧNցJ /1F>GSѽ5Ο͋b }4?. UxJ\ P +"\u]QV 8 ʭsu8TV<=.j@Xa?cA}䲁70 DU!L%X*i6-^v~`UD Z93+=/ŹBa;VuSY“!ELſpi4i`5;gu;i"pSXIg,6t\/\ZOнTH{Ns=" IơCW z֨G>l ,l.% pUMWב';cah'i- +6hw[&gm sZ}|nYc&WZ4 Q88 zy|I}C:FfR tgQ)!{ Q9]cTGa0i٬]z(4Hbc2€Pʼ}2=ŀ70 DU3.%4SѦTP5òk3C@6է @k4gHڠ|{dM C{N$ߧ}$,[d%7f66rOaB% S0Fu*A-B'TGa0o*1L$\?c||r9@XJ"* +N?ewyXuŒ#s`(] u/9bb O/~nj![x;5솴IFnr\ O_AQh.j_>% nXRm*6"U r& = UB F2NW ?cA||rq@X:J"* e8gŵx&da#."lb ڗK!DA tsѤ&ŠiX6hv+#0G46=X'UL#g,'dJ"* IWz#`epK&䍵P5-Œφz%qh pAtzz!ݫ|Z:lTi'Y~8^neѾ\Z~۱+ {]D†De{Dqx617 cA|:@'P@ϐPgFI#yo8ޱd&KeJ+=1h{7*|Œqح4E/:9 @۝x﵀~C$Q;6Z3M͘1};. B21 PBc(f$V䨽Y5J˄'SC}Jwph=nf9#9e.j'.3:]C`H0I;3@G" cBzRk3Urndi6yjM>j mL '!^D/^:B/W\c MVֵbh)m]U›½BX3F'~2([2H{[ʘKz9|rʛ;ߤ +3o^6igԴ 6h꛳qQDנZnEb0  Ūa_-cǝ0K| hW{Oڗ͌eڗGBP.k\|JʪaDb(ԓA枺6jVŸۺ+;[ 62D#N.d"QtD|@@(f, k#".(OM?0#ؗ>6sMn !/(^xΊ`X"I{Fځ#KRz7[ɿ2woJ/5u!.j)2y=4?u=h'9Wn@ĽM8;N. d"DQ"b< @6śH2eb͞=m[͉aF1Xǒ#fP0 Tc\VUs3 ءU>wϿZn)Ӳ 'VLrĺ EOهծH?6ߨX5UϟzW'W^ o3Ck_<}# !^@BnsB! B1_8!BB!!BD B@xI! #B,!Bͧ+!B@! B@ſ#z'B!pIeB FB@n Kf!P"~ 1Cab Ky@xsB}D@mLf.^#L.ԾHm]D.#:fdrPӶ . Gsk=yd0jʉռ*ĕj?TnmM[N14ۘoݲt+aw1H׾hrnqY=!v׺9j7㧝L=sA;fSmhL5Hca'Pr :ED8ѩXJcۥnsF1r]/q%CSmH\Rpj-MY2vd; "Ym _muh5= J4y q /3kks4J5DDxwq$BUS๲?RkCнJlR#&IF+ cFOun9쪗8B9\H_oooϿz!l6dN2UBY`-gljz:~H-MZSGDyQ5bBdU6BgXߗNMGN UL<Yqp/dz֙ڥ]6RwM-SN̈́ta79O&!gA{1HBȆ u/~gjJVg4=#8Ŧ8ԫHt`ZxJ{Q5bB쪵8GD4'1Z;&u0΄&52S4SԶl2ZBtnzc Nf2At;B(MbW\SDٜl.ES }QcbSDk8qxYhӘs e}౺Ė*&Pڤ!62-[2ZBtnzc 7ļ."d@8QّltpSy4w]2_?'TAKF]ubRLTBLMc2z5&$e݊҈󁁥zM;)/JDWx͙NM9(1z^ B!Ri1pJ]e&f7~DA]#ˏ u\@YRZ՟z8[:O/DUK.w7B8KsMۢOVBBƏq`jU" $4U90BXgDKDWx9$-'Vw~Ec77A_nIow} mj0њڧupKR/IM c^0!A~U{/$M̔ Xe!&dЅSr!H{WZ")sxK՚.1N\9&?5'+QvQf9K&sr`tNzqSLv⛔aN6_#ً^&{dQQ;˔,0N!k.Tbj㒭tͻ'J>jkMQ*=N8qלM11ODo+J @pK$8e&n| 7g;%"W.E fƼtyyi΀~Hz.1%iAao\;i7L+'gf´r!57.RAq0I0^!!tǮc5ʠ^^nKJ׋M8ĕc^s^2[.KDVt&!\F6\քЍOᦗ.B(_yo$e~wd#bHTnC5J!|K}HwXhY,(a&uPFK]kvKTk"[7`3tVfC]E W1o S)"_|ׇ6nc)1K\&iN+D曶|-?#٭ўz{|Ej爎- t2U%v>*{|L J%-d2ou\њI*#\^bN{pUogt3\!<JH @`((` Jˣ)e?C&yHH#Z1" `$<*` (t)HuRyHr=?wsoo{=^Nj&6& /?&]XѷLQd-̾GN1^#B8$#Fq􌧊*vܮ,|^8MCRB+-jo.DffE\=RY]+P~ Iv%tlVKٵpvMJj| D+ Fm75\\>,ERfs´l E=zS6xۻ -1_]p eq=RK[^IIv$mdy p3jik^fs,{OČM f8,t.gc,%i$`L,BNr9L!L#[\YMJHb.o#Z7Vg,G'h%? BB|X1U!nTKlpamϴ.v_f]sH.nڗ!9hڰ¢ t#5gE=qO֏ɖ'8/.4Xfܦ /(ksxWNR"n>&G ]RTN(-m!t1쭖x 3E3犙7k kF4D,R<~RV!,%fIx,5_vU"??FErLl|Irˁ1_9IZ>Hн"9Qr -4wߡњz7] {%^B8*MeCg^⋄qD|4&eYԌ9X=+ՉZ>i;*IGBܧ,! t{1//4id rư&IuiXGfH[7!w60<ǣ/(YᒢhX>33pz> z1HZn^!xeMNBEj B@pA!\O B!!BB!u B@pٳv?! B!!BAeK!`6B!!BB! '@!0A!@uB!  B! \? @'{enmO;c_%gl-Dj}_cCc㱿P&#zr9s;sWph`cñvtx-WkhF#, [ 셖:(έf{D9]QwW.YFk:ñW8EKC9 ΫX[t9qI[#69kL:TssDFN~Xkbr/PГe!<zv'v%Uwq[Bh87?Nc5D;Y/mQLj~GZñW8EKC; ݬ%.8Oף.{EH9d;{ۺ5BxkG1&lZ%o֊'9'| a](Zb"vun3i8`M+ѯo >BӹH'ݞ`vTNStއ,i暷k]eH-)(/ (ˬ<݈GEwviM[L/y3W8EKCeIf46m!>xuAf}"}[GhWB˹&Gh$o/'pͭ\[H0=&OJ 'W8EKCxe9 ^}: IDATnpx.xuBOB|;-QBG)&lZ9?{Z 3lΫBBjVzȜ?"u7m~*O RkHLj(9^gA>S w%5F5Z. t\p}-õ`ٮ1wcuډc![)Oj;<{ E54Lr~ZRiKW㠇XDM(zǃ r/xzllm>RZ(d;|wvg'p3!ǵ`Z@ڴP6H4+{-*x.F#D/02"L%BLռ#aR+S5s&'Mo#NL ܪd 8Squ{TA$*D38jWCkêDض2$z0 ]{ybjaolabq6ؿ#Oc?lI"\U*imUQ} P"ˆDt%Ķ|E22UILiיSmpsc/HD9);X]O,"׋b+װׅ!RPb\6+, _i<~{`1$Y4>RYoT!ףlXB^Iݪ9~vU&BoF~胻HәJ8 >r⤏Ks>PU)Uj.C!Tۨbh'>ZDxm-ѣL%BLռ#aR+S5su&Yt;j3cOS<La{97Hr _svP>J$2}PY=ITL4|64*}' 8ڜ5^B?&݇bÌPZ4R:%;&XD:بk%Bڶ4GJZyG¤Я3W y$'B*:U^$²vV7c2]Qf D)>Ќ,C ؄B% 2nF<5NJJ3C\t`һԲُqq~ )GMm\hrfo.d `.LUMa#u-",br:)㰹NږTAJZyGdv͜~p o]WvԹX{0;!h=zҟrp(Mh.OVFQlDB^tf%+l}آSqGo<.5Ye92mQTF|GwGPS,[@솨ҞҴPH0^;>Fݵ/sPRTsꪠL%BL¼#aRNiי_k'ygy"|-VuNeeeNWGi2 dB:aO]?*凎!#.bp 9b46'y"xL\X(ZXI~G.ORv  a mR"$XzD) DwC2N}g# "M*@Z)}xDx&{tcQz!2)G`T8*J{DӾBtx"zΗo!TI;=D`C%lvJK5-IfIk ; ;I,ӾE&BiIg~F]\k"TmvP'0H$͜~0;K@3e "kgA*BDr}}"H,OLKd8i]WDjFtD?-:O$B63H+-s"ٝBɮD3 ӈN6BsD BiGW0Gݵ-Kv Gnip}{QN&acԗN&a$OY <%}!Œ(N ㄻh02kn"}oL<0F b!G%iN._]ybn/)ΠD',Sq4-p3od",Oǻ8UqJ}Q|jK&%\ڨDl߳Yyb*G=RMk8"ĉ%ʒYa^ʶ@(SP'2o1KU#0s'BcY= )=W4o #5?4a "< fIBXi]tV"4=w4a LXkF{('֫j[FBJ:y+^:Sп Dh|Ž^^s<O[s>̫zۓ 7Vf|F{_F6 x8%I>awOjjlMDh۬#% dlƟl`nNKYEUv$){ޙ-?UJXH`މ*Ѵ#IaVP>6_0T"$[y RT͜ &.+}ViViVd"/w.OmdWUJicd0 $ 0BNBB!!B~巿%!|̯!BB!!w8B!&a1|v+?_ "9,}'1=~b>_¹ QN_18i]߄]7>p@;'1A`gQP9 GRU2رRtDF&X%hCd]m$5}쩯H'UN.εav=u )q;J{O`(S}GEcӉhj/ԢҠTWއ糉tsBcC ۹p}>i4xܥ,5#]5%|+s]c\-Wߩ"yw˓cCsz]C\®v"NQ^'ҊHk9:gHZYCdz7mۖQ#ۚZB8|Lh}kp+E,4CpNC\uܚT̝a7%)cc,`ReaϏ-iыwj{!K9S r;yv]<pwiWpWrHB(8^amAhi+lǍ2wF{sX!wDnC3cd[S@g;d7RM# [)6Sn!9H2[Nv^'=knp#X0v1AH-w}U}Ea,V.9cS5)iV= %8Dܑ\ɻgo"Dg3!dOԖ"jڲAڄDak;f-< В֟%B#SKLVS6pyv4zdF&E#DoR[@2оBȃ`Ǒ2ͯ0\:pqeqѡєa[®H_:θcױT՗=߭wۈi7/CW3A-"IDmfLwbONB(8/ <"%2?IԡuIC ԙvzHKkݒQ"[ZBx8Nb[9ak;f-[o/Я!mYmt׶W{rΨV &n崢AH+ulu{,CmZ!CeBx!Thn= aϐ\)궍ۮmj@ycgZ qH^ẅ]k3ރt*B*1=bo(5֋4sP/zd>':bEǥFc9ӊa d2Sf! 8—}@d9sJMLОI-\!ab\XO3Y#mO1HxVyl@D' pu#KKx!-T4cmǫ@ 9>Xm_;b aW(pnu7l,8^˲]_j7-‘l"q52h[5fYlG=Ǝ)v (VƞGmw* f LidvKFqlAj ᬾ|JtX7-Xp4씁f,@a:gRI}R\uauΔiY@Ym,W7}67DBgEIvg&쓉hBOtL;KԄ]ANW5m^]xlRS3r6agÍڔ]-ר7Ep'%G6L$'vCh\[&m-T9G~!\)2k-P-H-V!ؿl..8œٶѰ]*4Sf!ͻ,($mjnbQH@MC[3@BWY$eQiA{rL٠lsRIҊD)7;]{^gxԕ?u){:$ Zq7XWx/c 9m2UƾJIY )ʲzO%7<7 U&ڟnh2rH zN b"8Qs9ʳC:a*fz'xD}1Ooi9_⶧.=fn[Ò?v'Q:nS־'m uBx~q;ruv]]-)Cwe 'u!4ןz;|c rLeK2PGFcזE4gD/~)[= &T솃SFGl_zgqqoh ל$Ίy[6յ[K4!q wz * UMmhuN.ƴ58ojhҷ]H:ĄHhKz3Kw\kcɈulsJo z#! Y,FB{cyzdMB;|c>VlJ![jZyW9~6oό V\B[-h ee\Z2p aIBux7]Y/Be]Cۤ5[5qc,RkؿTa9=;JCyR]0;n}-'$+ P¶/|^oL/hvČs:G[>+CyzrTۍ_m7':䖤5z]e!pp;ɷhjoiɕ.8E~GJ2.MKg-bD;GȎU.%FZpMi_]bHl3.~IS{f-_E;^g# 5 Ѫmiq۬Eu?L5i͌n0wݩ6_~/iSXU}OW{~ڹPnv?b?CmZj Ex,V#W2/muK>ț!RQGql߮qtX9Lӈ2Sm!ج=>-hE1Uy Ie ݐ|;:u{']_bRFYWCs?˶)WK;0"+EB }WP:^(/pDQVDBWSG/clIk*SJVe᮱ZK!Ѳɮ)}dcF8'ԗD IDATb6[bi0OL03Pk$k"oEf­֨)/§)&DBOs\"$^cS;-k}uoޱ:m_m,5l4?t\WYSH_O{f#?(g8]A cǒv?}7+;}#jT2wyE\~`G{ehf֬)!$Z6ѵPLH_2ioKE3L6s8>3t89j%u}#FK$鰎 D>i 8^j]m02gYaG:XȰ1uBK[w'Xkf>k̼Q'f֚d yB)!DD`Iw{E\Z[MŸGپGXVKR-ZBj g51JT)a'mB\خˏ]֥S |11SBܩnkG?b#.cZ{zBfMfCgY X,rfOy܋'6:kaX!lDdaΨ>y'W$H|^1PcYvuruR9lJj\%!$ 3բ0=壞ʏeaǞZ0cl1l&\beœrڟ*DG&f۹w:#I4ˎ͍2OL0nmbzk悈w18¤03ǥ65u|LH;7p FE]bVD::vJI8B$LF2Xse#c-6usiggQU[+<~Bq׹ Q^ϻ"'>6+ǃk|tX<(Xɝ_ -|m/}#-҆I+.Nb-gN*Bs#ղ][M@~r^Ĵ$DŽD{>°O>I3B.v@Ԑ9^1Be㤕1V2ɄȖqrui Ψ3ꌈ3p_;,3 7w&yY~<" SU4>yw?0!TN6c3Ƶw>w3 IiB`_X~P^&G[ĥǐ-)dvw-n!T.FiR#:$܆I9 B\Ydh)RGawa3ٛu{dBb/Ss >wpM5.W]>\8rkz%FLs!T P>l,qKFN]W> 2} !Y]u]Ub#-M5,&)dvw-n!T>YTڙfl6YJ݆6s(Qx2d.aFCA,XU>6 "];pB%,=23~/pX8U |£J>n9=Ӟ ޗN #ʟ=K}5ޓ;P 5/X? $ | :߃@I~*a?  oCG8Bo !B_!BB!!o8B!? B! !B5!b~|!B@! B@OB//NB\_L?dR-\ T/)!r!Dy=}7Ǧd[JlZB$ӝgf3$BIRH",#P)Rn^H$J""E)%J"EIB,E)Rn'~oiȋg_wZECP{oJ&7)x& }5>g2q-wgVlQy¡21Ih_b¢!D1h4<3DXbD8Ryz-e䷪ovhգatVHA"8n=IK6:ٴ7A]p(HP @ofA>pEUBHT/| K\GUgbT0`n*)2&DE՝>1=쏺>="!\qӦVϢJFq?PGj^VIm0A RcJ?L6[X"IT:] @Na jt: u@mܝCimwܸ"M܁quJBwU=duO¼5V/l!i *)ţ"~#DP#c>[,_hx E ֈqBV5ǼŒ!ž:,- 42aDIbYїya8bd %wKIXO9jN\h3sbU݉+jaQy¡2hQDJ "tAvh4zY,36nB^GW^HP @ΒIs4&Hs2n3o/eΕk.j ^6hIʹv+|$s@'"%%hM;g]W'qm|vB JndN'Ȥ6_n6/k"aUu$吓0Wþ'{Sbz>%a}{NfSs*I& o oQYBe`Ѽj ٌUPo|G*IDHe_8m3[aa䝋E:,% 43?h"hXel"l1kR^O7ptVНHw,~QA75'^90t\1imn(e?L?t>6oEe6z.fq `֣f`P# >:GkSu}I/qհEE"XtX0ƒ!@EM"}U=hwWg4:@'|[\;$a־܃* 9}'Q@_5P1e`WgBF- quZ"|Az7CA䵜;c|`{! _QQ"PEKs<& btv0Gt<6RMmӦ'6lj0+y^1ܳ k[ƒ\54dshfCf11S^0%\f̳5ӌĩuT|.( @mDrP#|4۫fI9E0/"eE:Y "ig~D )_wQى9o%7c„:銙DG`dn_/54qM"^YI{F?$4?p!#S#ga?>~W^ΥWH&cG]EZ@!5FݝM*[B^ !B w}U+-vwP @RIs<&B2Fj:91;i Mcv8!hk ݯ٠!.[=pltMߌzm"yjקڋEk.֐.4rȣ4@-qXOҼeU$C=}dcRKEG߅ٛl81םw]e uP"Dϳͅn{_)/XkD(:,,!@q۟`'3'Bwxm[C.S>b[JY'pi?>](v 5bYEʭ^#H3_(cN>:K!B$amW;[PQ->70!h%¹Q2,' c#fDLmEJv+"O:'1䪒dQȟfe9ѡߪ@*j|/Qٳ_$V"t_(sa1\ uBH4>I>7ag43D#ulof QM~2|şqE>"ptΌ [N UJ^n'ӣ!GS;RTq@1DCN HҩK "ChQu#"FGj4UYݐ"VaV-ؓőxqD(҉Pg)D9Aas6 ֶ?{YqqسC1)!5-"hL8t:VZL'Rp1Ti Gf _Ʉ_% !D/$4R@ u3 h+Xj+>w?M.K/~o?.=p;lNߺ=~ӌ+ECGb3˜2GzQ!C9(" +ϛh|׸gvnvQv"׿n?#DkeW?Nb U4{v0ԊW7aEW\b-qhWW гb7W9^*6j5ӉAݾѥ_Ɋ/.Z  ϣIۢŖ>^.bgXJlǷ\Zj⼱ōz-h]l7X4UTDg'SJZ};zӾ"3bݬGRgCSlm*6@6'\ 'belsjYfB #[qnlћB4i,±DoȜt{a1_ɩX-;V >/l\MN'|y[)\52rvgsB%՘LeW8 Ǟ27jJh& cNڽwdtcSAض8;ց;l^m*6@ET6rϿA< Mrޞk[;zCHv l;\35%]G hʼnwI7:P}0# Owv7jjlm43Q9eAJaυ3{8~2ھr׶x!ĥfh5NK]1n[4UUDg'SK^};pjQ.fݎ;6Axk֜l7}c W̳6\A٦{T9NjS;M(r͚e‰iD/( 4 a}hWRgi2(y?ղumۚv_~ix}>m >Ã_0wn;eweuoeE3XPeET{v*.kh7@É HKj(6_N B6 P+B>Pk_ǡ7 ~0]/j1צmP_ِ<>r484P?`Yʱc]WB.X-焯k _(mNƱ}}G? 8*PF9Q˭a+"=;Q:e(H f֑QTjUd jSivs9 7М3sS%+Tha_ttS(;a&pZ:UpZ-v@;ՏVEpz:UpZ}  ឞ#zz'JjPFi>J@ ! $[S@uH)AH B]!A@c7S ! $!A@'A B $q!A@k,Cy"$'x[^K `ףb EhxEhG J6R>Z[LjNꪨ@_JZ$Q7P@'k@,Bb!&)ܓ "! (KT|%)@_#-oU5P@'uU`%Eqm(@_e(qm}1@y1%t+H*g@g#hm3Eh:}+)@_#hmXD*@,sh Eq]ϣ(٫|}^ }%`vխ iٷ3&_˟)JzZ!(Ob!'h;+2{GfIV{U=pWEEJw;/V5 y5hS)1iUϑ ps!)k]Ue~ɪERWqaoAfaYee>AfaAuc <}i;8,$L?|U s*? leF%֫cw؋Wz/~ŻMF^=gEg'DM͆;څ3NAa"xyIF!x~mH#Gr $9 SDQSCsYd=9m&24E.t9oނpFd ΍k閅Džn$:vAV|YY!10]q)*NO^zu E.0a,EC0M{/=dl:~A3ʷYoAx@7xKk~&oλ|ݜq?.=g!OIDATяR=}|Ad p^.}|,.Sz!DvB JmZ~SiχYgA.n VszV:4/[F6Ήh4+ 1^nYϺso 1@k/ 7k"S%Sӊ1sk24+W VT~ڶKfhpsMnveQnsz>A8-2d?+1'A(Aq /1pf_H_̟ "Enk ,ڴN3;-ћjO"7oSA>h :8 FH3ս |nv/>D s-b8j7unc%%Įȡ%gˬ8m2m9GOۘyd.~ɰGsY!UFÂ0M}]+TaSieVԪB{n5iMt1)M: `Y^2͈v=\QNYgU l6`^k䦪Eߦpewn, h ~e; =mi^om9AN?1d(EjxL(RfOEe1~ՊPmqnMIad7K;w w@MU̙ oS'S7̞jaI5AC) )?1Oڿy&Fɷ 4=p7RSE=Jz{n}B xhFO?nWx,&^Sj0kmP ),T>eV/Ux:5}BUMAxA=碩'Dˈ.cN,_J*-w"o4X( ͞봙Gdg7_{Sym?xo<_5m.tTzz>ȻZϼsdXB~ma5 X+v#7c03Z#4Sl8\ZPڒ>mZoGla?J&ӇYW͒%Ke/Á1D þ:0;%m.V5@f-.!c GwaD ͐M5Md~)m-%E-A8"rN ܹL_1 4_sRPZ3*Jtw6XiUPFMQm>Ow!juY_A֭yYU-=>;KqRJ-eEbn2)dPP̩)8qV~u] -0XfBtˆ6Eܕ^6̸M粒7oSwAhx 2r.X3KK˴&JŭY/ڮwIk B@YO>jLc[:aFu"{,1XA(rjLFiR⟬?vrfM/Ie?oLfak:fwGh}(aObo劳XȦ%9p#y|vHwW~K9m߀k&DP!witbWB̤׏ ¨6?A6n L6uZjкP:Rt-6=wz#kdW>i WSފK1!ps+Q޽ƫHpSQA-J̅9-"#|;rn7‚0QҫB?XgZzq36}k .~E!u7 $(·±xA8kE-B]nObg B6mv@o}ՖRGPھ QRۻP5(.BTP޻G: ʘGPZ"6C SYPJۗ!PWj{"*]s0"PJ1QwqjPW[>Kb!@i2DJ{}jN82H/"/l`[jBnݪkNtmwtf_={@ ?&B.nDo !@[yIe~DF׊?7~?!|1]3b_w`ӝlE|ZTHzӋ\m?U[«Qo`}['YϾ%ܽ|z3;$<]d&=qr;odn3K;=!\gmɽkڵmS-sD:ӋWӅ̕w#o?^iy__o ET8zӚ~巵oZB@&s?sm:*^k FDwOhs2OAMcɌ_~'!lmRmN%{S.d2ޙ>vc%kגDӅ7TvUœ{#l/#5~G|ڢţF㰳`kc !;R#qUBxbor_6[*eb6رcCH/ ዦ[BP:QpG4OjsCӳwS:ffgz#[(^97653;ޟikGch⛾![+'׋ ԅp!K}:R+Ijǫ͈Kuj٧&{>_5BեɆ&7; Ux%(wk_~vl*PgI{7v|r{zf={E ?xKh%K{/z{#B]|="ήo6zfs6z+!|XŗTKk)&9[1?\NeWm|i )g+Otҏ<݈R:&)ZI>*~<2Pw{eB橉$xkq aU4kVPHMMDB1,lU_̤g& d~aKJωGDBAX=o"*?{65.2Pn*qmT&>:0AS$틨/"߼r%}4Y1p琚7 )KpVA݇*=tzT>yG&#ZoJb?_nϤ.Z/"3" )r+i4PJld(.' aDndG Qcފ.콞) /u'8&mgTe~ZJu  mܻ ª!LAC9-KE@d7c/*ОX^}=m/ \{I|p^i B\r"k 4qbxLx΃P6C\`N䈏4T V)= =ɀbw]$~wZMd% {DWbw'D.&| a7}a3"|t03))Jb}quJ 5t]M&r[K <"_퀾#餓AUL=tZ u@C;4|{ZݓwvM"K)WCVv8IJt͊Pzӷa!1"?O{4'Ro υ!: Bly단mIf玢qdM5kS&zϼ"8 NҫD:UCkaEOcFDyIg_5 *%^j֫b. /We 5etGM_&+][>OE tSL{!D;*%r:Mޑk*uիv BuΉ(5{϶ {络^SA/o/t V"/D. ~2EV8SdgM})uۏFsc{ŝ%[L/_^|LkԑJ*P 5hmwRrl6D&/\gZ$ v_ BCĒ}v|jE] V=iznEZg}Թ,h ZuCvyɶ -'մ1PUWtmg^3VRK'C]KE}ӳ{ZZjft}EYr ,%&l-ko}GqPwDZ~h!u=8?{MZ`(&n=UMd m͟=E{j!^VXpHS DwKb}Y9"X>Qow%mݕE5? > endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 12740 /Filter /FlateDecode >> stream xMǑ;E9q5ڊ0ALЀĬ̪ݳ_ҁ@?DfDwn۟o{7of־q}׭f/oo?o7۶?~/M|?ܶ_op/Tuʹۏwg':+7c5<*͈zXB7?i} s_4#N\uz,(hF"g, ͈sεi1͉)LBdesD݈)Y8ќ"{, Cڈp1<(֓:7[#KxCڈ6)2Pbda!DmDĩScda,JFIL CdPvMb Y" ?Sdmm_н# Cd0v-b<Y9h"[,<_O'Fܗ:%N߈^g?:CdposY81E?- 1D'}#@Uވ)2bda,BFuz, cUވ)2iQ!pL*1EY;qL*;1E9YyJNuY" "SdCdXD5b 1XD5^Y(Q胘"5FBوDx0DFT'Sd.DوDjsY(Nt!'I ҈:.yBd9RQ'ѕ"[,JFIt%:{, ҉:xķ!P:Qѕ"%Fv#J'"SdY(F\uZ,<!dqߞ4 ⾄F\u7m#BDۈn8cdaw mDwb \10Dm#ʶm+ٹ7};Vٹ7>"lkl=Roue[cd/%KꭎբllߴΎբll_m/(:;F{ꭎbll_ezco;F?vc`ύ{{/<6{nzco8{nSoug^m&},6aνђzGcMس$kꭎ2&ع7{eMٳso}/Y&۔=;;F[{eMٳ={[-mʞ{v& bggzdYl3Sou֍mƞ<=[=[7;FKnۜ{5V!l)dKձz[ۜ{ MC6ٹ7z6C6S+Vlml<{{llݎ[=m{{n=m=i*;{.[={5Mνv&jlzIMν3Vjjl쵑Wꭎղ>ع7Xc89^X6:ۅ{[–vazco4:ۅy[-νr''jillWv[ݕ-^l:VKgdso[-νNٺnRou7t.{ >iCeuع7ɱZ6;F[ݝ-m۝{Wxd׃}_6;{ YRouavgh{co۝{-Va[cdhOձZm퓽\k#{agTVc`DKꭎղ>ع7ZSoullu ;F[ꭎljdOձZ['ۅ{{u]ٹ7zlilly=}pXυucveNni=q=|nS~$mʟwAݾGNj?}WOG|y|ͦq:!jN_/~onox{`x)^xUq:qϏ/~z޿k_۳o[?gm/}&C~~۱dQ>1<ӿzHȏzܥic!!ggE^zI6cνmG`sU9V֍$z`6g#0_Hձz[79;FKꭎCL9;^/S찐InƶνіzdakcdO%{ꭎC6ٹ7"C6ٹ7z[=m{Cٶ-Vall[ݏ[=m{G/#6wG^<W=G^9VG^Y7t[=;F1"{Uؾso*lo=SouƞRouνze Ve{cz{gVe{gzcoXlUw\zcoXl5wvcD&9VVc`hM}b}F[{ec}so[-[택{1"{ec]ع7z.llj`bC.}|S{u]ع7[-ν#VweKcdW'Kꭎ:ٮLjLr쭖vehKٺn:VKgb [ޔ>ȼ.{ #2{emcsonWν-V+vg/![{EWvgFd^9Vٹ7ZRoyDE>ٹ7ZSou>ȼ5OR[->ȼOv0"ʱZm}y=Sou_lQu/v^:VGd^:{+ #2식{[y[-ƶ>ȼrzll1 #Vjq ع7ZRougGd^ynK^|]NcD&y_Ymž{-Vggc#2_[-mž{[-mʞ{WGLeMٳso>^١2٦Rou쭖6eνIղfٹ7z1زf9ع7ZRou֍mƞLjLrی{-V7g֍mνўzconlsLձz[ۜ{1"{mso{6C6S-VlmlSouζνICٶع7ZRou[ll[idMձz[;;F1e{umso[=;F[70ozcopoܛڏmw#腽=Ro>"<ν=Vl7>"u[{dso#2ɱzL*;Fkېdso[$"{ꭎcY0d=[=[흝{WG`b}sٲm+Vc`Rou쭖νIղ.=Roullu ;FKꭎljdMձZ['ۅ{aI:ٮ+[['ە:y[-ν+Vjl]lWv -v轰t.;F[ݍ-^Sou쭖vcq&jln-;[6;;j;^[mcޯRouavgh?{co۝{g{E>ٹ7z[&[cd/;^Xm퓝{۱ߛ{E>ٹ7آll_=Rou{}%Vj1 /vc79Vmνіzc`ύ{=Vjq 3Vjq {n[-6aνc-6a^Rou쭖6j=>uc=2~ol=[-m{so2٦k5VjYlSm~or쭖6cνўzco,{Mν3V6cA^~orی{e{`6gzconlsrOձz[ۜ{DZߛ{ٹ7ZRou!lml:VekcdO%[ꭎC6ٹ7ڏ[=޿p-Pv-v^:VckgbO{/z/c>ع7ZRou{>k#k꽰zec}z-Vjl [6:ۅ{gꭎljzco4N ;v' KcdsotK]:ٮz{ZOu\Ot̮#:oޟoim~K[ڏNo/rȋcxC>⏽ytr۱[>iy|HX7'^p_x)_u{/_"?p|N_~цgy:}zu߰юx{z-ϫ1p8DSy8Dd!ϛE|<C C[]|rwxr{|B~~/~ot;>ߺ߇/oo_T"e}!W}~no~_m}Ƿ۷|O>p۷o߿w~5z7ۯn {{jOo~mwp ,[=611> myv7=>_&9pº͞|I8;qyn^;2%J3ĵ^=َWQ?h} s_4#N\uz,(hF"g, ͈sc0DAԍhNLg"+ F4'Ny-F!D݈cda,B4'xM:M} sQ)"%FIBFI:5F¡DmDh `,JNIL# CdPvR8cda[ġDD[trY8h"`aDD[bd~j/x_7yEDD߈_爑!p8Q7b <Cdp 7b Yq8Q荘"-F1*Do9_Y8&Q荘"=BY8&Q荘"W,8&Q蝘"Ϝ[)2p>cՈ>k{# CdlD5b Y" e#}SdG" e#])2cdalDu q9cda,FT'Sd1" u])̵sd4N+1EYؕ(J\uY" u])2p!P:Qѕ"%Fv#J'"SdY(F\uZ,<!ˬ(/uxo#BDۈn8cdaw mDwb \10Dm#ʶm+ٹ7ѱZmν=Va[cdzco('{)YRoue[gdhG#co(:;F[-ʶνўzco:{y[-ƶνkbl칱sopbc`ύRoug`ύ{{ꭎlثUq⧝<ш}=dq {6v[=[mž&YSou쭖6aνZt쭖6eνўzGgdggzcoL){vZzco,){vv G;^Xی=;;F[=[ی=;F[{uc U([=[7;FKnۜ{5V!l)dKձz[ۜ{} C6ٹ7z6C6S+Vlml<{{ll[=m{{n=m=K3VjQ5Ov^qco(:';s:;(:;F[{~ [gb/#[{a}so/{6aso_bl칱so[_{ndKձZ^/pṱsoɱZmž{g-6a^Rou쭖6&xa/2٦ع7ɱZ&۔=;;F[=:[&۔=;{-HձZ۔=;;F˱ߛ{eسso[-mƞ{-V6cAc79V֍mν3V7g֍mν+V!l) akcsot;{co69;F[}|!lml=RouƶɞJ[{msoɱz([;;F[n=m{=V+kgbO#[{ͯl{W~[=;ݷ-^<:ؾΫ[ꭎ:ؾsotϯ{UؾsoHձz8[}~-7p /x9= нdsoѱzL*;F{=&[흝{gꭎcUsWꭎcUٹ7xCbsotK}b}sotOձZ6{mz//7[6{mdIձZ6:;Fk–vahKձZ[^쩷:VKcdso<2O:ٮRouW4Nͻ~ܷݕ-vٻ]٫c=l9F۔[)?6}?ޞOS_ _~O_x:q[>l93϶8{ɛn496o\oXcC_^d_~L/<x#gggǗ}M=N^k>zOVzxg_SϳqO>>'5 ppAaϟ{OOy{1 ~%wo_wWM~&N}zkk|:o߾wwv?}o߾}})>ΠO?]LJ廟|uq>|}ݻoxk}Mڷ^[k|OQĸɎ llf?ggE>͢G_c=`3䗿 6lYl3+V6cνm֍mƞ܎[=[79;F[ݜ=[79{ y[=ۜ{%V!lmlsv^k_6[YC6ٹ7Rou!lmldOձz([&;F?6coPvMv^:Vekgb:-Pv-4rKձz[;;Fc3 9Vc`bz˰aW>+y}cO#aWaW=:Vg`νa^9Vg}chOaWVa{czcol7zco0+{c}ؼCdsotKaWν=V0+"[{ba^;;FKy[=[}yXl5yd[-[택{=VjaWν3 ür쭖>ür^ [6:ۅX0+ Kc]ع7aW:.Sou쭖>ür+[['ە}Y-:VKgdsoaWٺخm< ٺn:VKgb0g_o>1/6^a[-mۍ{uΖν-V}&6;{ [-އIٹ7z0ɱZmνђzad5Ov[{adkldKձZm퓝{Iբll_=Sou_lQu/v^:V}mc`bv $j1 ع7걱6sc/'[{6schIձZmž{qICggchKգ&0:Vdgcc5:VdgczadlSWv轰L){v> u[{eMٳsot?aco,{vvzI6cνђzconl3d}r {`6chKcucso[=ۜ=(:;F[{l틽,:V식{5rc`{_9F[=7v[{l=7rLձZ}~ν؏Nll<{ll5-Vjl_~y=O7~<[&۔=;Fc:9VdgghIգeMٳ"kꭎղئٹ7ڎ[-mƞ{=VjYl3N9ν3V6cA^~orی{enۜ{[ꭎCغS=V!lmlsv~or6ghIyWƶνњzcoP6MT[=m{دNC zbekgbzcoymu>σ-vnaco0ysotO}cc`>σ:Vg`ν_9Vg}chMձz8[}m7p /xTdu?@CνMcUع7z}7yL*;;{/z/<&[흽~-Vتlݏ[=[흝{G=[택{%V}7Y탽6 {1-[탽6[-[택{=VwaVgsoLձZ[^Rou쭖va`{aillWvn+[['r?z^qtWtοveNozm-Kni oGxm>c߸8`/xe'?SÓ3Op_j)q͏/ۛ?owg7_gsy>[>u i8m}==?OgOv[?ޞ|ߴr1M~xǿ|:oC񯝟y|ȳ!niNj6?{[|5<-} Q>*{9}}e< ='^|Ov|u󧿼?o&/~}r?&?ӿ>׾n~|wxW}=ۿ}~Hq>}#}epooƠnvy<؇7{.r{endstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 504 504] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 9 0 R >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000013105 00000 n 0000013188 00000 n 0000013311 00000 n 0000013344 00000 n 0000000212 00000 n 0000000292 00000 n 0000016039 00000 n 0000016296 00000 n 0000016393 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 16495 %%EOF metafor/man/rma.mh.Rd0000644000176200001440000003677614505063152014157 0ustar liggesusers\name{rma.mh} \alias{rma.mh} \title{Meta-Analysis via the Mantel-Haenszel Method} \description{ Function to fit equal-effects models to \mjeqn{2 \times 2}{2x2} table and person-time data via the Mantel-Haenszel method. See below and the introduction to the \pkg{\link{metafor-package}} for more details on these models. \loadmathjax } \usage{ rma.mh(ai, bi, ci, di, n1i, n2i, x1i, x2i, t1i, t2i, measure="OR", data, slab, subset, add=1/2, to="only0", drop00=TRUE, correct=TRUE, level=95, verbose=FALSE, digits, \dots) } \arguments{ \item{ai}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (upper left cell). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{bi}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (upper right cell). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{ci}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (lower left cell). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{di}{vector with the \mjeqn{2 \times 2}{2x2} table frequencies (lower right cell). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{n1i}{vector with the group sizes or row totals (first group). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{n2i}{vector with the group sizes or row totals (second group). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{x1i}{vector with the number of events (first group). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{x2i}{vector with the number of events (second group). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{t1i}{vector with the total person-times (first group). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{t2i}{vector with the total person-times (second group). See below and the documentation of the \code{\link{escalc}} function for more details.} \item{measure}{character string to specify the outcome measure to use for the meta-analysis. Possible options are \code{"RR"} for the (log transformed) risk ratio, \code{"OR"} for the (log transformed) odds ratio, \code{"RD"} for the risk difference, \code{"IRR"} for the (log transformed) incidence rate ratio, or \code{"IRD"} for the incidence rate difference.} \item{data}{optional data frame containing the data supplied to the function.} \item{slab}{optional vector with labels for the \mjseqn{k} studies.} \item{subset}{optional (logical or numeric) vector to specify the subset of studies that should be used for the analysis.} \item{add}{non-negative number to specify the amount to add to zero cells or even counts when calculating the observed effect sizes of the individual studies. Can also be a vector of two numbers, where the first number is used in the calculation of the observed effect sizes and the second number is used when applying the Mantel-Haenszel method. See below and the documentation of the \code{\link{escalc}} function for more details.} \item{to}{character string to specify when the values under \code{add} should be added (either \code{"only0"}, \code{"all"}, \code{"if0all"}, or \code{"none"}). Can also be a character vector, where the first string again applies when calculating the observed effect sizes or outcomes and the second string when applying the Mantel-Haenszel method. See below and the documentation of the \code{\link{escalc}} function for more details.} \item{drop00}{logical to specify whether studies with no cases/events (or only cases) in both groups should be dropped when calculating the observed effect sizes or outcomes (the outcomes for such studies are set to \code{NA}). Can also be a vector of two logicals, where the first applies to the calculation of the observed effect sizes or outcomes and the second when applying the Mantel-Haenszel method. See below and the documentation of the \code{\link{escalc}} function for more details.} \item{correct}{logical to specify whether to apply a continuity correction when computing the Cochran-Mantel-Haenszel test statistic.} \item{level}{numeric value between 0 and 100 to specify the confidence interval level (the default is 95; see \link[=misc-options]{here} for details).} \item{verbose}{logical to specify whether output should be generated on the progress of the model fitting (the default is \code{FALSE}).} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is 4. See also \link[=misc-options]{here} for further details on how to control the number of digits in the output.} \item{\dots}{additional arguments.} } \details{ \subsection{Specifying the Data}{ When the outcome measure is either the risk ratio (measure=\code{"RR"}), odds ratio (\code{measure="OR"}), or risk difference (\code{measure="RD"}), the studies are assumed to provide data in terms of \mjeqn{2 \times 2}{2x2} tables of the form: \tabular{lcccccc}{ \tab \ics \tab outcome 1 \tab \ics \tab outcome 2 \tab \ics \tab total \cr group 1 \tab \ics \tab \code{ai} \tab \ics \tab \code{bi} \tab \ics \tab \code{n1i} \cr group 2 \tab \ics \tab \code{ci} \tab \ics \tab \code{di} \tab \ics \tab \code{n2i}} where \code{ai}, \code{bi}, \code{ci}, and \code{di} denote the cell frequencies and \code{n1i} and \code{n2i} the row totals. For example, in a set of randomized clinical trials (RCTs) or cohort studies, group 1 and group 2 may refer to the treatment/exposed and placebo/control/non-exposed group, respectively, with outcome 1 denoting some event of interest (e.g., death) and outcome 2 its complement. In a set of case-control studies, group 1 and group 2 may refer to the group of cases and the group of controls, with outcome 1 denoting, for example, exposure to some risk factor and outcome 2 non-exposure. For these outcome measures, one needs to specify the cell frequencies via the \code{ai}, \code{bi}, \code{ci}, and \code{di} arguments (or alternatively, one can use the \code{ai}, \code{ci}, \code{n1i}, and \code{n2i} arguments). Alternatively, when the outcome measure is the incidence rate ratio (\code{measure="IRR"}) or the incidence rate difference (\code{measure="IRD"}), the studies are assumed to provide data in terms of tables of the form: \tabular{lcccc}{ \tab \ics \tab events \tab \ics \tab person-time \cr group 1 \tab \ics \tab \code{x1i} \tab \ics \tab \code{t1i} \cr group 2 \tab \ics \tab \code{x2i} \tab \ics \tab \code{t2i}} where \code{x1i} and \code{x2i} denote the number of events in the first and the second group, respectively, and \code{t1i} and \code{t2i} the corresponding total person-times at risk. } \subsection{Mantel-Haenszel Method}{ An approach for aggregating data of these types was suggested by Mantel and Haenszel (1959) and later extended by various authors (see references). The Mantel-Haenszel method provides a weighted estimate under an equal-effects model. The method is particularly advantageous when aggregating a large number of studies with small sample sizes (the so-called sparse data or increasing strata case). When analyzing odds ratios, the Cochran-Mantel-Haenszel (CMH) test (Cochran, 1954; Mantel & Haenszel, 1959) and Tarone's test for heterogeneity (Tarone, 1985) are also provided (by default, the CMH test statistic is computed with the continuity correction; this can be switched off with \code{correct=FALSE}). When analyzing incidence rate ratios, the Mantel-Haenszel (MH) test (Rothman et al., 2008) for person-time data is also provided (again, the \code{correct} argument controls whether the continuity correction is applied). When analyzing risk ratios, odds ratios, or incidence rate ratios, the printed results are given both in terms of the log and the raw units (for easier interpretation). } \subsection{Observed Effect Sizes or Outcomes of the Individual Studies}{ The Mantel-Haenszel method itself does not require the calculation of the observed effect sizes of the individual studies (e.g., the observed log odds ratios of the \mjseqn{k} studies) and directly makes use of the cell/event counts. Zero cells/events are not a problem (except in extreme cases, such as when one of the two outcomes never occurs in any of the \mjeqn{2 \times 2}{2x2} tables or when there are no events for one of the two groups in any of the tables). Therefore, it is unnecessary to add some constant to the cell/event counts when there are zero cells/events. However, for plotting and various other functions, it is necessary to calculate the observed effect sizes for the \mjseqn{k} studies. Here, zero cells/events can be problematic, so adding a constant value to the cell/event counts ensures that all \mjseqn{k} values can be calculated. The \code{add} and \code{to} arguments are used to specify what value should be added to the cell/event counts and under what circumstances when calculating the observed effect sizes and when applying the Mantel-Haenszel method. Similarly, the \code{drop00} argument is used to specify how studies with no cases/events (or only cases) in both groups should be handled. The documentation of the \code{\link{escalc}} function explains how the \code{add}, \code{to}, and \code{drop00} arguments work. If only a single value for these arguments is specified (as per default), then these values are used when calculating the observed effect sizes and no adjustment to the cell/event counts is made when applying the Mantel-Haenszel method. Alternatively, when specifying two values for these arguments, the first value applies when calculating the observed effect sizes and the second value when applying the Mantel-Haenszel method. Note that \code{drop00} is set to \code{TRUE} by default. Therefore, the observed effect sizes for studies where \code{ai=ci=0} or \code{bi=di=0} or studies where \code{x1i=x2i=0} are set to \code{NA}. When applying the Mantel-Haenszel method, such studies are not explicitly dropped (unless the second value of \code{drop00} argument is also set to \code{TRUE}), but this is practically not necessary, as they do not actually influence the results (assuming no adjustment to the cell/event counts are made when applying the Mantel-Haenszel method). } } \value{ An object of class \code{c("rma.mh","rma")}. The object is a list containing the following components: \item{beta}{aggregated log risk ratio, log odds ratio, risk difference, log rate ratio, or rate difference.} \item{se}{standard error of the aggregated value.} \item{zval}{test statistics of the aggregated value.} \item{pval}{corresponding p-value.} \item{ci.lb}{lower bound of the confidence interval.} \item{ci.ub}{upper bound of the confidence interval.} \item{QE}{test statistic of the test for heterogeneity.} \item{QEp}{correspinding p-value.} \item{MH}{Cochran-Mantel-Haenszel test statistic (\code{measure="OR"}) or Mantel-Haenszel test statistic (\code{measure="IRR"}).} \item{MHp}{corresponding p-value.} \item{TA}{test statistic of Tarone's test for heterogeneity (only when \code{measure="OR"}).} \item{TAp}{corresponding p-value (only when \code{measure="OR"}).} \item{k}{number of studies included in the analysis.} \item{yi, vi}{the vector of outcomes and corresponding sampling variances.} \item{fit.stats}{a list with the log-likelihood, deviance, AIC, BIC, and AICc values under the unrestricted and restricted likelihood.} \item{\dots}{some additional elements/values.} } \section{Methods}{ The results of the fitted model are formatted and printed with the \code{\link[=print.rma.mh]{print}} function. If fit statistics should also be given, use \code{\link[=summary.rma]{summary}} (or use the \code{\link[=fitstats.rma]{fitstats}} function to extract them). The \code{\link[=residuals.rma]{residuals}}, \code{\link[=rstandard.rma.mh]{rstandard}}, and \code{\link[=rstudent.rma.mh]{rstudent}} functions extract raw and standardized residuals. Leave-one-out diagnostics can be obtained with \code{\link[=leave1out.rma.mh]{leave1out}}. Forest, funnel, radial, \enc{L'Abbé}{L'Abbe}, and Baujat plots can be obtained with \code{\link[=forest.rma]{forest}}, \code{\link[=funnel.rma]{funnel}}, \code{\link[=radial.rma]{radial}}, \code{\link[=labbe.rma]{labbe}}, and \code{\link[=baujat.rma]{baujat}}. The \code{\link[=qqnorm.rma.mh]{qqnorm}} function provides normal QQ plots of the standardized residuals. One can also just call \code{\link[=plot.rma.mh]{plot}} on the fitted model object to obtain various plots at once. A cumulative meta-analysis (i.e., adding one observation at a time) can be obtained with \code{\link[=cumul.rma.mh]{cumul}}. Other extractor functions include \code{\link[=coef.rma]{coef}}, \code{\link[=vcov.rma]{vcov}}, \code{\link[=logLik.rma]{logLik}}, \code{\link[=deviance.rma]{deviance}}, \code{\link[=AIC.rma]{AIC}}, and \code{\link[=BIC.rma]{BIC}}. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Cochran, W. G. (1954). Some methods for strengthening the common \mjseqn{\chi^2} tests. \emph{Biometrics}, \bold{10}(4), 417--451. \verb{https://doi.org/10.2307/3001616} Greenland, S., & Robins, J. M. (1985). Estimation of a common effect parameter from sparse follow-up data. \emph{Biometrics}, \bold{41}(1), 55--68. \verb{https://doi.org/10.2307/2530643} Mantel, N., & Haenszel, W. (1959). Statistical aspects of the analysis of data from retrospective studies of disease. \emph{Journal of the National Cancer Institute}, \bold{22}(4), 719--748. \verb{https://doi.org/10.1093/jnci/22.4.719} Nurminen, M. (1981). Asymptotic efficiency of general noniterative estimators of common relative risk. \emph{Biometrika}, \bold{68}(2), 525--530. \verb{https://doi.org/10.1093/biomet/68.2.525} Robins, J., Breslow, N., & Greenland, S. (1986). Estimators of the Mantel-Haenszel variance consistent in both sparse data and large-strata limiting models. \emph{Biometrics}, \bold{42}(2), 311--323. \verb{https://doi.org/10.2307/2531052 } Rothman, K. J., Greenland, S., & Lash, T. L. (2008). \emph{Modern epidemiology} (3rd ed.). Philadelphia: Lippincott Williams & Wilkins. Sato, T., Greenland, S., & Robins, J. M. (1989). On the variance estimator for the Mantel-Haenszel risk difference. \emph{Biometrics}, \bold{45}(4), 1323--1324. \verb{https://www.jstor.org/stable/2531784} Tarone, R. E. (1981). On summary estimators of relative risk. \emph{Journal of Chronic Diseases}, \bold{34}(9-10), 463--468. \verb{https://doi.org/10.1016/0021-9681(81)90006-0} Tarone, R. E. (1985). On heterogeneity tests based on efficient scores. \emph{Biometrika}, \bold{72}(1), 91--95. \verb{https://doi.org/10.1093/biomet/72.1.91} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.glmm}}, \code{\link{rma.peto}}, and \code{\link{rma.mv}} for other model fitting functions. } \examples{ ### meta-analysis of the (log) odds ratios using the Mantel-Haenszel method rma.mh(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### meta-analysis of the (log) risk ratios using the Mantel-Haenszel method rma.mh(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) } \keyword{models} metafor/man/misc-recs.Rd0000644000176200001440000003042414505063152014642 0ustar liggesusers\name{misc-recs} \alias{misc-recs} \alias{misc_recs} \title{Some Recommended Practices} \description{ This page documents some recommended practices when working with the \pkg{metafor} package (and more generally when conducting meta-analyses). \loadmathjax } \details{ \subsection{Restricted Maximum Likelihood Estimation}{ When fitting models with the \code{\link{rma.uni}} and \code{\link{rma.mv}} functions, use of restricted maximum likelihood (REML) estimation is generally recommended. This is also the default setting (i.e., \code{method="REML"}). Various simulation studies have indicated that REML estimation tends to provide approximately unbiased estimates of the amount of heterogeneity (e.g., Langan et al., 2019; Veroniki et al., 2016; Viechtbauer, 2005), or more generally, of the variance components in more complex mixed-effects models (Harville, 1977). For models fitted with the \code{\link{rma.uni}} function, the empirical Bayes / Paule-Mandel estimators (i.e., \code{method="EB"} / \code{method="PM"}), which can actually be shown to be identical to each other despite their different derivations (Viechtbauer et al., 2015), also have some favorable properties. However, these estimators do not generalize in a straightforward manner to more complex models, such as those that can be fitted with the \code{\link{rma.mv}} function. } \subsection{Improved Inference Methods}{ When fitting models with the \code{\link{rma.uni}} function, tests of individual model coefficients and the corresponding confidence intervals are by default (i.e., when \code{test="z"}) based on a standard normal distribution, while the omnibus test is based on a chi-square distribution. These inference methods may not perform nominally (i.e., the Type I error rate of tests and the coverage rate of confidence intervals may deviate from the chosen level), especially when the number of studies, \mjseqn{k}, is low. Therefore, it is highly recommended to use the method by Hartung (1999), Sidik and Jonkman (2002), and Knapp and Hartung (2003) (the Knapp-Hartung method; also referred to as the Hartung-Knapp-Sidik-Jonkman method) by setting \code{test="knha"}. Then tests of individual coefficients and confidence intervals are based on a t-distribution with \mjseqn{k-p} degrees of freedom, while the omnibus test then uses an F-distribution with \mjseqn{m} and \mjseqn{k-p} degrees of freedom (with \mjseqn{m} denoting the number of coefficients tested and \mjseqn{p} the total number of model coefficients). Various simulation studies have shown that this method works very well in providing tests and confidence intervals with close to nominal performance (e.g., \enc{Sánchez-Meca}{Sanchez-Meca} & \enc{Marín-Martínez}{Marin-Martinez}, 2008; Viechtbauer et al., 2015). Alternatively, one can also conduct permutation tests using the \code{\link{permutest}} function. These also perform very well (and are, in a certain sense, \sQuote{exact} tests), but are computationally expensive. For models fitted with the \code{\link{rma.mv}} and \code{\link{rma.glmm}} functions, the Knapp-Hartung method and permutation tests are not available. Instead, one can set \code{test="t"} to also use t- and F-distributions for making inferences (although this does not involve the adjustment to the standard errors of the estimated model coefficients that is made as part of the Knapp-Hartung method). For \code{\link{rma.mv}}, one should also set \code{dfs="contain"}, which uses an improved method for approximating the degrees of freedom of the t- and F-distributions. Note that \code{test="z"} is the default for the \code{\link{rma.uni}}, \code{\link{rma.mv}}, and the \code{\link{rma.glmm}} functions. While the improved inference methods described above should ideally be the default, changing this now would break backwards compatibility. } \subsection{General Workflow for Meta-Analyses Involving Complex Dependency Structures}{ Many meta-analyses involve observed outcomes / effect size estimates that cannot be assumed to be independent, because some estimates were computed based on the same sample of subjects (or at least a partially overlapping set). In this case, one should compute the covariances for any pair of estimates that involve (fully or partially) overlapping subjects. Doing so is difficult, but we can often construct an approximate variance-covariance matrix (say \mjseqn{V}) of such dependent estimates. This can be done with the \code{\link{vcalc}} function (and/or see the \code{\link{rcalc}} function when dealing specifically with dependent correlation coefficients). We can then fit a multivariate/multilevel model to the estimates with the \code{\link{rma.mv}} function, using \mjseqn{V} as the approximate var-cov matrix of the estimates and adding fixed and random effects to the model as deemed necessary. However, since \mjseqn{V} is often just a rough approximation (and since the random effects structure may not fully capture all dependencies in the underlying true outcomes/effects), we can then apply cluster-robust inference methods (also known as robust variance estimation) to the model. This can be done with the \code{\link{robust}} function, which also interfaces with the improved inference methods implemented in the \href{https://cran.r-project.org/package=clubSandwich}{clubSandwich} package to obtain the cluster-robust tests and confidence intervals.\mjseqn{^1} Finally, we can compute predicted outcomes (with corresponding confidence intervals) and test sets of coefficients or linear combinations thereof using the \code{\link[=predict.rma]{predict}} and \code{\link[=anova.rma]{anova}} functions. See Pustejovsky and Tipton (2022) for a paper describing such a workflow for various cases. To summarize, the general workflow therefore will often consist of these steps: \preformatted{# construct/approximate the var-cov matrix of dependent estimates V <- vcalc(...) # fit multivariate/multilevel model with appropriate fixed/random effects res <- rma.mv(yi, V, mods = ~ ..., random = ~ ...) # apply cluster-robust inference methods (robust variance estimation) # note: use the improved methods from the clubSandwich package sav <- robust(res, cluster = ..., clubSandwich = TRUE) sav # compute predicted outcomes (with corresponding CIs) as needed predict(sav, ...) # test sets of coefficients / linear combinations as needed anova(sav, ...)} How \code{\link{vcalc}} and \code{\link{rma.mv}} should be used (and the clustering variable specified for \code{\link{robust}}) will depend on the specifics of the application. See \code{\link[metadat]{dat.knapp2017}} and \code{\link[metadat]{dat.tannersmith2016}} for some examples illustrating this workflow. } \subsection{Profile Likelihood Plots to Check Parameter Identifiability}{ When fitting complex models, it is not guaranteed that all parameters of the model are identifiable (i.e., that there is a unique set of values for the parameters that maximizes the (restricted) likelihood function). For models fitted with the \code{\link{rma.mv}} function, this pertains especially to the variance/correlation components of the model (i.e., what is specified via the \code{random} argument). Therefore, it is strongly advised in general to do post model fitting checks to make sure that the likelihood surface around the ML/REML estimates is not flat for some combination of the parameter estimates (which would imply that the estimates are essentially arbitrary). For example, one can plot the (restricted) log-likelihood as a function of each variance/correlation component in the model to make sure that each profile plot shows a clear peak at the corresponding ML/REML estimate. The \code{\link[=profile.rma]{profile}} function can be used for this purpose. See also Raue et al. (2009) for some further discussion of parameter identifiability and the use of profile likelihoods to check for this. The \code{\link[=profile.rma]{profile}} function should also be used after fitting location-scale models (Viechtbauer & \enc{López-López}{Lopez-Lopez}, 2022) with the \code{\link{rma.uni}} function and after fitting selection models with the \code{\link{selmodel}} function. } --------- \mjseqn{^1} In small meta-analyses, the (denominator) degrees of freedom for the approximate t- and F-tests provided by the cluster-robust inference methods might be very low, in which case the tests may not be trustworthy and overly conservative (Joshi et al., 2022). Under these circumstances, one can consider the use of cluster wild bootstrapping (as implemented in the \href{https://cran.r-project.org/package=wildmeta}{wildmeta} package) as an alternative method for making inferences. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Hartung, J. (1999). An alternative method for meta-analysis. \emph{Biometrical Journal}, \bold{41}(8), 901--916. \verb{https://doi.org/10.1002/(SICI)1521-4036(199912)41:8<901::AID-BIMJ901>3.0.CO;2-W} Harville, D. A. (1977). Maximum likelihood approaches to variance component estimation and to related problems. \emph{Journal of the American Statistical Association}, \bold{72}(358), 320--338. \verb{https://doi.org/10.2307/2286796} Joshi, M., Pustejovsky, J. E., & Beretvas, S. N. (2022). Cluster wild bootstrapping to handle dependent effect sizes in meta-analysis with a small number of studies. \emph{Research Synthesis Methods}, \bold{13}(4), 457--477. \verb{https://doi.org/10.1002/jrsm.1554} Knapp, G., & Hartung, J. (2003). Improved tests for a random effects meta-regression with a single covariate. \emph{Statistics in Medicine}, \bold{22}(17), 2693--2710. \verb{https://doi.org/10.1002/sim.1482} Langan, D., Higgins, J. P. T., Jackson, D., Bowden, J., Veroniki, A. A., Kontopantelis, E., Viechtbauer, W. & Simmonds, M. (2019). A comparison of heterogeneity variance estimators in simulated random-effects meta-analyses. \emph{Research Synthesis Methods}, \bold{10}(1), 83--98. https://doi.org/10.1002/jrsm.1316 Pustejovsky, J. E. & Tipton, E. (2022). Meta-analysis with robust variance estimation: Expanding the range of working models. \emph{Prevention Science}, \bold{23}, 425--438. \verb{https://doi.org/10.1007/s11121-021-01246-3} Raue, A., Kreutz, C., Maiwald, T., Bachmann, J., Schilling, M., Klingmuller, U., & Timmer, J. (2009). Structural and practical identifiability analysis of partially observed dynamical models by exploiting the profile likelihood. \emph{Bioinformatics}, \bold{25}(15), 1923--1929. \verb{https://doi.org/10.1093/bioinformatics/btp358} \enc{Sánchez-Meca}{Sanchez-Meca}, J. & \enc{Marín-Martínez}{Marin-Martinez}, F. (2008). Confidence intervals for the overall effect size in random-effects meta-analysis. \emph{Psychological Methods}, \bold{13}(1), 31--48. \verb{https://doi.org/10.1037/1082-989x.13.1.31} Sidik, K. & Jonkman, J. N. (2002). A simple confidence interval for meta-analysis. \emph{Statistics in Medicine}, \bold{21}(21), 3153--3159. \verb{https://doi.org/10.1002/sim.1262} Veroniki, A. A., Jackson, D., Viechtbauer, W., Bender, R., Bowden, J., Knapp, G., Kuss, O., Higgins, J. P., Langan, D., & Salanti, G. (2016). Methods to estimate the between-study variance and its uncertainty in meta-analysis. \emph{Research Synthesis Methods}, \bold{7}(1), 55--79. \verb{https://doi.org/10.1002/jrsm.1164} Viechtbauer, W. (2005). Bias and efficiency of meta-analytic variance estimators in the random-effects model. \emph{Journal of Educational and Behavioral Statistics}, \bold{30}(3), 261--293. \verb{https://doi.org/10.3102/10769986030003261} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W., \enc{López-López}{Lopez-Lopez}, J. A., \enc{Sánchez-Meca}{Sanchez-Meca}, J., & \enc{Marín-Martínez}{Marin-Martinez}, F. (2015). A comparison of procedures to test for moderators in mixed-effects meta-regression models. \emph{Psychological Methods}, \bold{20}(3), 360--374. \verb{https://doi.org/10.1037/met0000023} Viechtbauer, W., & \enc{López-López}{Lopez-Lopez}, J. A. (2022). Location-scale models for meta-analysis. \emph{Research Synthesis Methods}. \bold{13}(6), 697--715. \verb{https://doi.org/10.1002/jrsm.1562} } \keyword{documentation} \keyword{misc} metafor/man/influence.rma.mv.Rd0000644000176200001440000001531114505063152016122 0ustar liggesusers\name{influence.rma.mv} \alias{influence.rma.mv} \alias{cooks.distance.rma.mv} \alias{dfbetas.rma.mv} \alias{hatvalues.rma.mv} \title{Model Diagnostics for 'rma.mv' Objects} \description{ Functions to compute various outlier and influential study diagnostics (some of which indicate the influence of deleting one study at a time on the model fit or the fitted/residual values) for objects of class \code{"rma.mv"}. \loadmathjax } \usage{ \method{cooks.distance}{rma.mv}(model, progbar=FALSE, cluster, reestimate=TRUE, parallel="no", ncpus=1, cl, \dots) \method{dfbetas}{rma.mv}(model, progbar=FALSE, cluster, reestimate=TRUE, parallel="no", ncpus=1, cl, \dots) \method{hatvalues}{rma.mv}(model, type="diagonal", \dots) } \arguments{ \item{model}{an object of class \code{"rma.mv"}.} \item{progbar}{logical to specify whether a progress bar should be shown (the default is \code{FALSE}).} \item{cluster}{optional vector to specify a clustering variable to use for computing the Cook's distances or DFBETAS values. If unspecified, these measures are computed for the individual observed effect sizes or outcomes.} \item{reestimate}{logical to specify whether variance/correlation components should be re-estimated after deletion of the \mjeqn{i\textrm{th}}{ith} case (the default is \code{TRUE}).} \item{parallel}{character string to specify whether parallel processing should be used (the default is \code{"no"}). For parallel processing, set to either \code{"snow"} or \code{"multicore"}. See \sQuote{Note}.} \item{ncpus}{integer to specify the number of processes to use in the parallel processing.} \item{cl}{optional cluster to use if \code{parallel="snow"}. If unspecified, a cluster on the local machine is created for the duration of the call.} \item{type}{character string to specify whether only the diagonal of the hat matrix (\code{"diagonal"}) or the entire hat matrix (\code{"matrix"}) should be returned.} \item{\dots}{other arguments.} } \details{ The term \sQuote{case} below refers to a particular row from the dataset used in the model fitting (when argument \code{cluster} is not specified) or each level of the variable specified via \code{cluster}. Cook's distance for the \mjeqn{i\textrm{th}}{ith} case can be interpreted as the Mahalanobis distance between the entire set of predicted values once with the \mjeqn{i\textrm{th}}{ith} case included and once with the \mjeqn{i\textrm{th}}{ith} case excluded from the model fitting. The DFBETAS value(s) essentially indicate(s) how many standard deviations the estimated coefficient(s) change(s) after excluding the \mjeqn{i\textrm{th}}{ith} case from the model fitting. } \value{ The \code{cooks.distance} function returns a vector. The \code{dfbetas} function returns a data frame. The \code{hatvalues} function returns either a vector with the diagonal elements of the hat matrix or the entire hat matrix. } \note{ The variable specified via \code{cluster} is assumed to be of the same length as the data originally passed to the \code{rma.mv} function (and if the \code{data} argument was used in the original model fit, then the variable will be searched for within this data frame first). Any subsetting and removal of studies with missing values that was applied during the model fitting is also automatically applied to the variable specified via the \code{cluster} argument. Leave-one-out diagnostics are calculated by refitting the model \mjseqn{k} times (where \mjseqn{k} denotes the number of cases). Depending on how large \mjseqn{k} is, it may take a few moments to finish the calculations. For complex models fitted with \code{\link{rma.mv}}, this can become computationally expensive. On machines with multiple cores, one can try to speed things up by delegating the model fitting to separate worker processes, that is, by setting \code{parallel="snow"} or \code{parallel="multicore"} and \code{ncpus} to some value larger than 1. Parallel processing makes use of the \code{\link[parallel]{parallel}} package, using the \code{\link[parallel]{makePSOCKcluster}} and \code{\link[parallel]{parLapply}} functions when \code{parallel="snow"} or using \code{\link[parallel]{mclapply}} when \code{parallel="multicore"} (the latter only works on Unix/Linux-alikes). With \code{parallel::detectCores()}, one can check on the number of available cores on the local machine. Alternatively (or in addition to using parallel processing), one can also set \code{reestimate=FALSE}, in which case any variance/correlation components in the model are not re-estimated after deleting the \mjeqn{i\textrm{th}}{ith} case from the dataset. Doing so only yields an approximation to the Cook's distances and DFBETAS values that ignores the influence of the \mjeqn{i\textrm{th}}{ith} case on the variance/correlation components, but is considerably faster (and often yields similar results). It may not be possible to fit the model after deletion of the \mjeqn{i\textrm{th}}{ith} case from the dataset. This will result in \code{NA} values for that case. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Belsley, D. A., Kuh, E., & Welsch, R. E. (1980). \emph{Regression diagnostics}. New York: Wiley. Cook, R. D., & Weisberg, S. (1982). \emph{Residuals and influence in regression}. London: Chapman and Hall. Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W. (2021). Model checking in meta-analysis. In C. H. Schmid, T. Stijnen, & I. R. White (Eds.), \emph{Handbook of meta-analysis} (pp. 219--254). Boca Raton, FL: CRC Press. \verb{https://doi.org/10.1201/9781315119403} Viechtbauer, W., & Cheung, M. W.-L. (2010). Outlier and influence diagnostics for meta-analysis. \emph{Research Synthesis Methods}, \bold{1}(2), 112--125. \verb{https://doi.org/10.1002/jrsm.11} } \seealso{ \code{\link[=rstudent.rma.mv]{rstudent}} for externally standardized residuals and \code{\link[=weights.rma.mv]{weights}} for model fitting weights. } \examples{ ### copy data from Konstantopoulos (2011) into 'dat' dat <- dat.konstantopoulos2011 ### multilevel random-effects model res <- rma.mv(yi, vi, random = ~ 1 | district/school, data=dat) print(res, digits=3) ### Cook's distance for each observed outcome x <- cooks.distance(res) x plot(x, type="o", pch=19, xlab="Observed Outcome", ylab="Cook's Distance") ### Cook's distance for each district x <- cooks.distance(res, cluster=district) x plot(x, type="o", pch=19, xlab="District", ylab="Cook's Distance", xaxt="n") axis(side=1, at=seq_along(x), labels=as.numeric(names(x))) ### hat values hatvalues(res) } \keyword{models} metafor/man/print.rma.Rd0000644000176200001440000003076614505063152014700 0ustar liggesusers\name{print.rma} \alias{print.rma} \alias{print.rma.uni} \alias{print.rma.mh} \alias{print.rma.peto} \alias{print.rma.glmm} \alias{print.rma.mv} \alias{summary} \alias{summary.rma} \alias{print.summary.rma} \title{Print and Summary Methods for 'rma' Objects} \description{ Functions to print objects of class \code{"rma.uni"}, \code{"rma.mh"}, \code{"rma.peto"}, \code{"rma.glmm"}, \code{"rma.glmm"}, and \code{"rma.mv"}. \loadmathjax } \usage{ \method{print}{rma.uni}(x, digits, showfit=FALSE, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, \dots) \method{print}{rma.mh}(x, digits, showfit=FALSE, \dots) \method{print}{rma.peto}(x, digits, showfit=FALSE, \dots) \method{print}{rma.glmm}(x, digits, showfit=FALSE, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, \dots) \method{print}{rma.mv}(x, digits, showfit=FALSE, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, \dots) \method{summary}{rma}(object, digits, \dots) \method{print}{summary.rma}(x, digits, showfit=TRUE, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, \dots) } \arguments{ \item{x}{an object of class \code{"rma.uni"}, \code{"rma.mh"}, \code{"rma.peto"}, \code{"rma.glmm"}, \code{"rma.mv"}, or \code{"summary.rma"} (for \code{print}).} \item{object}{an object of class \code{"rma"} (for \code{summary}).} \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object. See also \link[=misc-options]{here} for further details on how to control the number of digits in the output.} \item{showfit}{logical to specify whether the fit statistics and information criteria should be printed (the default is \code{FALSE} for \code{print} and \code{TRUE} for \code{summary}).} \item{signif.stars}{logical to specify whether p-values should be encoded visually with \sQuote{significance stars}. Defaults to the \code{show.signif.stars} slot of \code{\link{options}}.} \item{signif.legend}{logical to specify whether the legend for the \sQuote{significance stars} should be printed. Defaults to the value for \code{signif.stars}.} \item{\dots}{other arguments.} } \details{ The output includes: \itemize{ \item the log-likelihood, deviance, AIC, BIC, and AICc value (when setting \code{showfit=TRUE} or by default for \code{summary}). \item for objects of class \code{"rma.uni"} and \code{"rma.glmm"}, the amount of (residual) heterogeneity in the random/mixed-effects model (i.e., the estimate of \mjseqn{\tau^2} and its square root). Suppressed for equal-effects models. The (asymptotic) standard error of the estimate of \mjseqn{\tau^2} is also provided (where possible). \item for objects of \code{"rma.mv"}, a table providing information about the variance components and correlations in the model. For \mjseqn{\sigma^2} components, the estimate and its square root are provided, in addition to the number of values/levels, whether the component was fixed or estimated, and the name of the grouping variable/factor. If the \code{R} argument was used to specify known correlation matrices, this is also indicated. For models with an \sQuote{\code{~ inner | outer}} formula term, the name of the inner and outer grouping variable/factor are given and the number of values/levels of these variables/factors. In addition, for each \mjseqn{\tau^2} component, the estimate and its square root are provided, the number of effects or outcomes observed at each level of the inner grouping variable/factor (only for \code{struct="HCS"}, \code{struct="DIAG"}, \code{struct="HAR"}, and \code{struct="UN"}), and whether the component was fixed or estimated. Finally, either the estimate of \mjseqn{\rho} (for \code{struct="CS"}, \code{struct="AR"}, \code{struct="CAR"}, \code{struct="HAR"}, or \code{struct="HCS"}) or the entire estimated correlation matrix (for \code{struct="UN"}) between the levels of the inner grouping variable/factor is provided, again with information whether a particular correlation was fixed or estimated, and how often each combination of levels of the inner grouping variable/factor was observed across the levels of the outer grouping variable/factor. If there is a second \sQuote{\code{~ inner | outer}} formula term, the same information as described above will be provided, but now for the \mjseqn{\gamma^2} and \mjseqn{\phi} components. \item the \mjseqn{I^2} statistic, which estimates (in percent) how much of the total variability in the observed effect sizes or outcomes (which is composed of heterogeneity plus sampling variability) can be attributed to heterogeneity among the true effects. For a meta-regression model, \mjseqn{I^2} estimates how much of the unaccounted variability (which is composed of residual heterogeneity plus sampling variability) can be attributed to residual heterogeneity. See \sQuote{Note} for how \mjseqn{I^2} is computed. \item the \mjseqn{H^2} statistic, which estimates the ratio of the total amount of variability in the observed effect sizes or outcomes to the amount of sampling variability. For a meta-regression model, \mjseqn{H^2} estimates the ratio of the unaccounted variability in the observed effect sizes or outcomes to the amount of sampling variability. See \sQuote{Note} for how \mjseqn{H^2} is computed. \item for objects of class \code{"rma.uni"}, the \mjseqn{R^2} statistic, which estimates the amount of heterogeneity accounted for by the moderators included in the model and can be regarded as a pseudo \mjseqn{R^2} statistic (Raudenbush, 2009). Only provided when fitting a model including moderators. This is suppressed (and set to \code{NULL}) for models without moderators or if the model does not contain an intercept. See \sQuote{Note} for how \mjseqn{R^2} is computed. \item for objects of class \code{"rma.glmm"}, the amount of study level variability (only when using a model that models study level differences as a random effect). \item the results of the test for (residual) heterogeneity. This is the usual \mjseqn{Q}-test for heterogeneity when not including moderators in the model and the \mjseqn{Q_E}-test for residual heterogeneity when moderators are included. For objects of class \code{"rma.glmm"}, the results from a Wald-type test and a likelihood ratio test are provided (see \code{\link{rma.glmm}} for more details). \item the results of the omnibus (Wald-type) test of the coefficients in the model (the indices of the coefficients tested are also indicated). Suppressed if the model includes only one coefficient (e.g., only an intercept, like in the equal- and random-effects models). \item a table with the estimated coefficients, corresponding standard errors, test statistics, p-values, and confidence interval bounds. \item the Cochran-Mantel-Haenszel test and Tarone's test for heterogeneity (only when analyzing odds ratios using the Mantel-Haenszel method, i.e., \code{"rma.mh"}). } See also \link[=misc-options]{here} for details on the option to create styled/colored output with the help of the \href{https://cran.r-project.org/package=crayon}{crayon} package. } \value{ The \code{print} functions do not return an object. The \code{summary} function returns the object passed to it (with additional class \code{"summary.rma"}). } \note{ For random-effects models, the \mjseqn{I^2} statistic is computed with \mjdeqn{I^2 = 100\\\\\\\% \times \frac{\hat{\tau}^2}{\hat{\tau}^2 + \tilde{v}},}{I^2 = 100\\\% hat(\tau)^2 / (hat(\tau)^2 + v),} where \mjeqn{\hat{\tau}^2}{hat(\tau)^2} is the estimated value of \mjseqn{\tau^2} and \mjdeqn{\tilde{v} = \frac{(k-1) \sum w_i}{(\sum w_i)^2 - \sum w_i^2},}{v = ((k-1) \sum w_i) / ((\sum w_i)^2 - \sum w_i^2),} where \mjseqn{w_i = 1 / v_i} is the inverse of the sampling variance of the \mjeqn{i\textrm{th}}{ith} study (\mjeqn{\tilde{v}}{v} is equation 9 in Higgins & Thompson, 2002, and can be regarded as the \sQuote{typical} within-study variance of the observed effect sizes or outcomes). The \mjseqn{H^2} statistic is computed with \mjdeqn{H^2 = \frac{\hat{\tau}^2 + \tilde{v}}{\tilde{v}}.}{H^2 = (hat(\tau)^2 + v) / v.} Analogous equations are used for mixed-effects models. Therefore, depending on the estimator of \mjseqn{\tau^2} used, the values of \mjseqn{I^2} and \mjseqn{H^2} will change. For random-effects models, \mjseqn{I^2} and \mjseqn{H^2} are often computed with \mjseqn{I^2 = (Q-(k-1))/Q} and \mjseqn{H^2 = Q/(k-1)}, where \mjseqn{Q} denotes the statistic of the test for heterogeneity and \mjseqn{k} the number of studies (i.e., observed effect sizes or outcomes) included in the meta-analysis. The equations used in the \pkg{metafor} package to compute these statistics are more general and have the advantage that the values of \mjseqn{I^2} and \mjseqn{H^2} will be consistent with the estimated value of \mjseqn{\tau^2} (i.e., if \mjeqn{\hat{\tau}^2 = 0}{hat(\tau)^2 = 0}, then \mjseqn{I^2 = 0} and \mjseqn{H^2 = 1} and if \mjeqn{\hat{\tau}^2 > 0}{hat(\tau)^2 > 0}, then \mjseqn{I^2 > 0} and \mjseqn{H^2 > 1}). The two definitions of \mjseqn{I^2} and \mjseqn{H^2} actually coincide when using the DerSimonian-Laird estimator of \mjseqn{\tau^2} (i.e., the commonly used equations are actually special cases of the more general definitions given above). Therefore, if you prefer the more conventional definitions of these statistics, use \code{method="DL"} when fitting the random/mixed-effects model with the \code{\link{rma.uni}} function. The conventional definitions are also automatically used when fitting an equal-effects models. For mixed-effects models, the pseudo \mjseqn{R^2} statistic (Raudenbush, 2009) is computed with \mjdeqn{R^2 = \frac{\hat{\tau}_{RE}^2 - \hat{\tau}_{ME}^2}{\hat{\tau}_{RE}^2},}{R^2 = (hat(\tau)^2_RE - hat(\tau)^2_ME) / hat(\tau)^2_RE,} where \mjeqn{\hat{\tau}_{RE}^2}{hat(\tau)^2_RE} denotes the estimated value of \mjseqn{\tau^2} based on the random-effects model (i.e., the total amount of heterogeneity) and \mjeqn{\hat{\tau}_{ME}^2}{hat(\tau)^2_ME} denotes the estimated value of \mjseqn{\tau^2} based on the mixed-effects model (i.e., the residual amount of heterogeneity). It can happen that \mjeqn{\hat{\tau}_{RE}^2 < \hat{\tau}_{ME}^2}{hat(\tau)^2_RE < hat(\tau)^2_ME}, in which case \mjseqn{R^2} is set to zero (and also if \mjeqn{\hat{\tau}_{RE}^2 = 0}{hat(\tau)^2_RE = 0}). Again, the value of \mjseqn{R^2} will change depending on the estimator of \mjseqn{\tau^2} used. This statistic is only computed when the mixed-effects model includes an intercept (so that the random-effects model is clearly nested within the mixed-effects model). You can also use the \code{\link[=anova.rma]{anova}} function to compute \mjseqn{R^2} for any two models that are known to be nested. Note that the pseudo \mjseqn{R^2} statistic may not be very accurate unless \mjseqn{k} is large (Lopez-Lopez et al., 2014). For fixed-effects with moderators models, the \mjseqn{R^2} statistic is simply the standard \mjseqn{R^2} statistic (also known as the \sQuote{coefficient of determination}) computed based on weighted least squares estimation. To be precise, the so-called \sQuote{adjusted} \mjseqn{R^2} statistic is provided, since \mjseqn{k} is often relatively small in meta-analyses, in which case the adjustment is relevant. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Higgins, J. P. T., & Thompson, S. G. (2002). Quantifying heterogeneity in a meta-analysis. \emph{Statistics in Medicine}, \bold{21}(11), 1539--1558. \verb{https://doi.org/10.1002/sim.1186} \enc{López-López}{Lopez-Lopez}, J. A., \enc{Marín-Martínez}{Marin-Martinez}, F., \enc{Sánchez-Meca}{Sanchez-Meca}, J., Van den Noortgate, W., & Viechtbauer, W. (2014). Estimation of the predictive power of the model in mixed-effects meta-regression: A simulation study. \emph{British Journal of Mathematical and Statistical Psychology}, \bold{67}(1), 30--48. \verb{https://doi.org/10.1111/bmsp.12002} Raudenbush, S. W. (2009). Analyzing effect sizes: Random effects models. In H. Cooper, L. V. Hedges, & J. C. Valentine (Eds.), \emph{The handbook of research synthesis and meta-analysis} (2nd ed., pp. 295--315). New York: Russell Sage Foundation. Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for the corresponding model fitting functions. } \keyword{print} metafor/man/radial.Rd0000644000176200001440000001630614505063152014214 0ustar liggesusers\name{radial} \alias{radial} \alias{galbraith} \alias{radial.rma} \title{Radial (Galbraith) Plots for 'rma' Objects} \description{ Function to create radial (also called Galbraith) plots for objects of class \code{"rma"}. \loadmathjax } \usage{ radial(x, \dots) galbraith(x, \dots) \method{radial}{rma}(x, center=FALSE, xlim, zlim, xlab, zlab, atz, aty, steps=7, level=x$level, digits=2, transf, targs, pch=21, col, bg, back, arc.res=100, cex, cex.lab, cex.axis, \dots) } \arguments{ \item{x}{an object of class \code{"rma"}.} \item{center}{logical to indicate whether the plot should be centered horizontally at the model estimate (the default is \code{FALSE}).} \item{xlim}{x-axis limits. If unspecified, the function sets the x-axis limits to some sensible values.} \item{zlim}{z-axis limits. If unspecified, the function sets the z-axis limits to some sensible values (note that the z-axis limits are the actual vertical limit of the plotting region).} \item{xlab}{title for the x-axis. If unspecified, the function sets an appropriate axis title.} \item{zlab}{title for the z-axis. If unspecified, the function sets an appropriate axis title.} \item{atz}{position for the z-axis tick marks and labels. If unspecified, these values are set by the function.} \item{aty}{position for the y-axis tick marks and labels. If unspecified, these values are set by the function.} \item{steps}{the number of tick marks for the y-axis (the default is 7). Ignored when argument \code{aty} is used.} \item{level}{numeric value between 0 and 100 to specify the level of the z-axis error region. The default is to take the value from the object.} \item{digits}{integer to specify the number of decimal places to which the tick mark labels of the y-axis should be rounded (the default is 2).} \item{transf}{argument to specify a function to transform the y-axis labels (e.g., \code{transf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{targs}{optional arguments needed by the function specified via \code{transf}.} \item{pch}{plotting symbol. By default, an open circle is used. See \code{\link{points}} for other options.} \item{col}{character string to specify the (border) color of the points.} \item{bg}{character string to specify the background color of open plot symbols.} \item{back}{character string to specify the background color of the z-axis error region. If unspecified, a shade of gray is used. Set to \code{NA} to suppress shading of the region.} \item{arc.res}{integer to specify the number of line segments (i.e., the resolution) when drawing the y-axis and confidence interval arcs (the default is 100).} \item{cex}{symbol expansion factor.} \item{cex.lab}{character expansion factor for axis labels.} \item{cex.axis}{character expansion factor for axis annotations.} \item{\dots}{other arguments.} } \details{ For an equal-effects model, the plot shows the inverse of the standard errors on the horizontal axis (i.e., \mjeqn{1/\sqrt{v_i}}{1/\sqrt(v_i)}, where \mjseqn{v_i} is the sampling variance of the observed effect size or outcome) against the observed effect sizes or outcomes standardized by their corresponding standard errors on the vertical axis (i.e., \mjeqn{y_i/\sqrt{v_i}}{y_i/\sqrt(v_i)}). Since the vertical axis corresponds to standardized values, it is referred to as the z-axis within this function. On the right hand side of the plot, an arc is drawn (referred to as the y-axis within this function) corresponding to the observed effect sizes or outcomes. A line projected from (0,0) through a particular point within the plot onto this arc indicates the value of the observed effect size or outcome for that point. For a random-effects model, the function uses \mjeqn{1/\sqrt{v_i + \tau^2}}{1/\sqrt(v_i + \tau^2)} for the horizontal axis, where \mjseqn{\tau^2} is the amount of heterogeneity as estimated based on the model. For the z-axis, \mjeqn{y_i/\sqrt{v_i + \tau^2}}{y_i/\sqrt(v_i + \tau^2)} is used to compute standardized values of the observed effect sizes or outcomes. The second (inner/smaller) arc that is drawn on the right hand side indicates the model estimate (in the middle of the arc) and the corresponding confidence interval (at the ends of the arc). The shaded region in the plot is the z-axis error region. For \code{level=95} (or if this was the \code{level} value when the model was fitted), this corresponds to z-axis values equal to \mjeqn{\pm 1.96}{+-1.96}. Under the assumptions of the equal/random-effects models, approximately 95\% of the points should fall within this region. When \code{center=TRUE}, the values on the y-axis are centered around the model estimate. As a result, the plot is centered horizontally at the model estimate. If the z-axis label on the left is too close to the actual z-axis and/or the arc on the right is clipped, then this can be solved by increasing the margins on the right and/or left (see \code{\link{par}} and in particular the \code{mar} argument). Note that radial plots cannot be drawn for models that contain moderators. } \value{ A data frame with components: \item{x}{the x-axis coordinates of the points that were plotted.} \item{y}{the y-axis coordinates of the points that were plotted.} \item{ids}{the study id numbers.} \item{slab}{the study labels.} Note that the data frame is returned invisibly. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Galbraith, R. F. (1988). Graphical display of estimates having differing standard errors. \emph{Technometrics}, \bold{30}(3), 271--281. \verb{https://doi.org/10.1080/00401706.1988.10488400} Galbraith, R. F. (1988). A note on graphical presentation of estimated odds ratios from several clinical trials. \emph{Statistics in Medicine}, \bold{7}(8), 889--894. \verb{https://doi.org/10.1002/sim.4780070807} Galbraith, R. F (1994). Some applications of radial plots. \emph{Journal of the American Statistical Association}, \bold{89}(428), 1232--1242. \verb{https://doi.org/10.1080/01621459.1994.10476864} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models for which radial plots can be drawn. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) dat ### fit equal-effects model res <- rma(yi, vi, data=dat, method="EE") ### draw radial plot radial(res) ### the line from (0,0) with a slope equal to the log risk ratio from the 4th study points ### to the corresponding effect size value on the arc (i.e., -1.44) abline(a=0, b=dat$yi[4], lty="dotted") dat$yi[4] ### meta-analysis of the log risk ratios using a random-effects model res <- rma(yi, vi, data=dat) ### draw radial plot radial(res) ### center the values around the model estimate radial(res, center=TRUE) ### show risk ratio values on the y-axis arc radial(res, transf=exp) } \keyword{hplot} metafor/man/formatters.Rd0000644000176200001440000001176314505063152015150 0ustar liggesusers\name{formatters} \alias{formatters} \alias{fmtp} \alias{fmtx} \alias{fmtt} \title{Formatter Functions} \description{ Functions to format various types of outputs. \loadmathjax } \usage{ fmtp(p, digits=4, pname="", equal=FALSE, sep=FALSE, add0=FALSE, quote=FALSE) fmtx(x, digits=4, flag="", quote=FALSE, \dots) fmtt(val, tname, df, df1, df2, pval, digits=4, pname="p-val", format=1, sep=TRUE, quote=FALSE, call=FALSE, \dots) } \arguments{ \emph{Arguments for \code{fmtp}:} \item{p}{vector of p-values to be formatted.} \item{digits}{integer to specify the number of decimal places to which the values should be rounded. For \code{fmmt}, can be a vector of length 2, to specify the number of digits for the test statistic and the p-value, respectively.} \item{pname}{string to add as a prefix to the p-value (e.g., something like \code{"p-val"} or just \code{"p"}).} \item{equal}{logical to specify whether an equal symbol should be shown before the p-value (when it is larger than the rounding cutoff).} \item{sep}{logical to specify whether a space should be added between \code{pname}, the equal/lesser symbol, and the p-value.} \item{add0}{logical to specify whether a 0 should be shown before the decimal point when the p-value is below the rounding cutoff.} \item{quote}{logical to specify whether formatted strings should be quoted when printed.} \emph{Arguments specific for \code{fmtx}:} \item{x}{vector of numeric values to be formatted.} \item{flag}{a character string giving a format modifier as defined for \code{\link{formatC}}.} \emph{Arguments specific for \code{fmtt}:} \item{val}{test statistic value to be formatted.} \item{tname}{character string for the name of the test statistic.} \item{df}{optional value for the degrees of freedom of the test statistic.} \item{df1}{optional value for the numerator degrees of freedom of the test statistic.} \item{df2}{optional value for the denominator degrees of freedom of the test statistic.} \item{pval}{the p-value corresponding to the test statistic.} \item{format}{either \code{1} or \code{2} to denote whether the degrees of freedom should be given before the test statistic (in parentheses) or after the test statistic.} \item{call}{logical to specify whether the formatted test result should be returned as a call or not.} \item{\dots}{other arguments.} } \details{ The \code{fmtp} function takes one or multiple p-values as input and rounds them to the chosen number of digits. For p-values that are smaller than \code{10^(-digits)} (e.g., \code{0.0001} for \code{digits=4}), the value is shown to fall below this bound (e.g., \code{<.0001}). The \code{fmtx} function takes one or multiple numeric values as input and rounds them to the chosen number of digits, without using scientific notation and without dropping trailing zeros (using \code{\link{formatC}}). The \code{fmtt} function takes a single test statistic value as input (and, if applicable, its degrees of freedom via argument \code{df} or its numerator and denominator degrees of freedom via arguments \code{df1} and \code{df2}) and the corresponding p-value and formats it for printing. Two different formats are available (chosen via the \code{format} argument), one giving the degrees of freedom before the test statistic (in parentheses) and one after the test statistic. } \value{ A character vector with the formatted values. By default (i.e., when \code{quote=FALSE}), formatted strings are not quoted when printed. } \note{ The option in \code{fmtt} to return the formatted test result as a call can be useful when adding the output to a plot with \code{\link{text}} and one would like to use \code{\link{plotmath}} formatting for \code{tname}. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \examples{ # examples for fmtp() fmtp(c(.0002, .00008), quote=TRUE, digits=4) fmtp(c(.0002, .00008), quote=TRUE, digits=4, equal=TRUE) fmtp(c(.0002, .00008), quote=TRUE, digits=4, equal=TRUE, sep=TRUE) fmtp(c(.0002, .00008), quote=TRUE, digits=4, equal=TRUE, sep=TRUE, add0=TRUE) # examples for fmtx() fmtx(c(1.0002, 2.00008, 3.00004), digits=4) fmtx(c(-1, 1), digits=4) fmtx(c(-1, 1), digits=4, flag=" ") # examples for fmtt() fmtt(2.45, "z", pval=0.01429, digits=2) fmtt(3.45, "z", pval=0.00056, digits=2) fmtt(2.45, "t", df=23, pval=0.02232, digits=2) fmtt(3.45, "t", df=23, pval=0.00218, digits=2) fmtt(3.45, "t", df=23, pval=0.00218, digits=2, format=2) fmtt(46.23, "Q", df=29, pval=0.0226, digits=2) fmtt(46.23, "Q", df=29, pval=0.0226, digits=2, format=2) fmtt(8.75, "F", df1=2, df2=35, pval=0.00083, digits=c(2,3)) fmtt(8.75, "F", df1=2, df2=35, pval=0.00083, digits=c(2,3), format=2, pname="p") fmtt(8.75, "F", df1=2, df2=35, pval=0.00083, digits=c(2,3), format=2, pname="p", sep=FALSE) } \keyword{manip} metafor/man/forest.default.Rd0000644000176200001440000004205014505063152015700 0ustar liggesusers\name{forest.default} \alias{forest.default} \title{Forest Plots (Default Method)} \description{ Function to create forest plots for a given set of data. \loadmathjax } \usage{ \method{forest}{default}(x, vi, sei, ci.lb, ci.ub, annotate=TRUE, showweights=FALSE, header=FALSE, xlim, alim, olim, ylim, at, steps=5, level=95, refline=0, digits=2L, width, xlab, slab, ilab, ilab.xpos, ilab.pos, order, subset, transf, atransf, targs, rows, efac=1, pch, psize, plim=c(0.5,1.5), col, shade, colshade, lty, fonts, cex, cex.lab, cex.axis, \dots) } \arguments{ \item{x}{vector of length \mjseqn{k} with the observed effect sizes or outcomes.} \item{vi}{vector of length \mjseqn{k} with the corresponding sampling variances.} \item{sei}{vector of length \mjseqn{k} with the corresponding standard errors (note: only one of the two, \code{vi} or \code{sei}, needs to be specified).} \item{ci.lb}{vector of length \mjseqn{k} with the corresponding lower confidence interval bounds. Not needed if \code{vi} or \code{sei} is specified. See \sQuote{Details}.} \item{ci.ub}{vector of length \mjseqn{k} with the corresponding upper confidence interval bounds. Not needed if \code{vi} or \code{sei} is specified. See \sQuote{Details}.} \item{annotate}{logical to specify whether annotations should be added to the plot (the default is \code{TRUE}).} \item{showweights}{logical to specify whether the annotations should also include the inverse variance weights (the default is \code{FALSE}).} \item{header}{logical to specify whether column headings should be added to the plot (the default is \code{FALSE}). Can also be a character vector to specify the left and right headings (or only the left one).} \item{xlim}{horizontal limits of the plot region. If unspecified, the function sets the horizontal plot limits to some sensible values.} \item{alim}{the x-axis limits. If unspecified, the function sets the x-axis limits to some sensible values.} \item{olim}{optional argument to specify observation/outcome limits. If unspecified, no limits are used.} \item{ylim}{the y-axis limits of the plot. If unspecified, the function sets the y-axis limits to some sensible values.} \item{at}{position of the x-axis tick marks and corresponding labels. If unspecified, the function sets the tick mark positions/labels to some sensible values.} \item{steps}{the number of tick marks for the x-axis (the default is 5). Ignored when the positions are specified via the \code{at} argument.} \item{level}{numeric value between 0 and 100 to specify the confidence interval level (the default is 95; see \link[=misc-options]{here} for details).} \item{refline}{numeric value to specify the location of the vertical \sQuote{reference} line (the default is 0). The line can be suppressed by setting this argument to \code{NA}.} \item{digits}{integer to specify the number of decimal places to which the tick mark labels of the x-axis and the annotations should be rounded (the default is \code{2L}). Can also be a vector of two integers, the first to specify the number of decimal places for the annotations, the second for the x-axis labels (when \code{showweights=TRUE}, can also specify a third value for the weights). When specifying an integer (e.g., \code{2L}), trailing zeros after the decimal mark are dropped for the x-axis labels. When specifying a numeric value (e.g., \code{2}), trailing zeros are retained.} \item{width}{optional integer to manually adjust the width of the columns for the annotations (either a single integer or a vector of the same length as the number of annotation columns).} \item{xlab}{title for the x-axis. If unspecified, the function sets an appropriate axis title. Can also be a vector of three/two values (to also/only add labels at the end points of the x-axis limits).} \item{slab}{optional vector with labels for the \mjseqn{k} studies. If unspecified, the function tries to extract study labels from \code{x} and otherwise simple labels are created within the function. To suppress labels, set this argument to \code{NA}.} \item{ilab}{optional vector, matrix, or data frame providing additional information about the studies that should be added to the plot.} \item{ilab.xpos}{numeric vector to specify the horizontal position(s) of the variable(s) given via \code{ilab}.} \item{ilab.pos}{integer(s) (either 1, 2, 3, or 4) to specify the alignment of the vector(s) given via \code{ilab} (2 means right, 4 mean left aligned). If unspecified, the default is to center the labels.} \item{order}{optional character string to specify how the studies should be ordered. Can also be a variable based on which the studies will be ordered. See \sQuote{Details}.} \item{subset}{optional (logical or numeric) vector to specify the subset of studies that should be included in the plot.} \item{transf}{optional argument to specify a function to transform the observed outcomes and corresponding confidence interval bounds (e.g., \code{transf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{atransf}{optional argument to specify a function to transform the x-axis labels and annotations (e.g., \code{atransf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{targs}{optional arguments needed by the function specified via \code{transf} or \code{atransf}.} \item{rows}{optional vector to specify the rows (or more generally, the horizontal positions) for plotting the outcomes. Can also be a single value to specify the row (horizontal position) of the first outcome (the remaining outcomes are then plotted below this starting row).} \item{efac}{vertical expansion factor for confidence interval limits and arrows. The default value of 1 should usually work okay. Can also be a vector of two numbers, the first for CI limits, the second for arrows.} \item{pch}{plotting symbol to use for the observed outcomes. By default, a filled square is used. See \code{\link{points}} for other options. Can also be a vector of values.} \item{psize}{optional numeric value to specify the point sizes for the observed outcomes. If unspecified, the point sizes are a function of the precision of the estimates. Can also be a vector of values.} \item{plim}{numeric vector of length 2 to scale the point sizes (ignored when \code{psize} is specified). See \sQuote{Details}.} \item{col}{optional character string to specify the color of the observed outcomes. Can also be a vector.} \item{shade}{optional character string or a (logical or numeric) vector for shading rows of the plot. See \sQuote{Details}.} \item{colshade}{optional argument to specify the color for the shading.} \item{lty}{optional character string to specify the line type for the confidence intervals. If unspecified, the function sets this to \code{"solid"} by default.} \item{fonts}{optional character string to specify the font for the study labels, annotations, and the extra information (if specified via \code{ilab}). If unspecified, the default font is used.} \item{cex}{optional character and symbol expansion factor. If unspecified, the function sets this to a sensible value.} \item{cex.lab}{optional expansion factor for the x-axis title. If unspecified, the function sets this to a sensible value.} \item{cex.axis}{optional expansion factor for the x-axis labels. If unspecified, the function sets this to a sensible value.} \item{\dots}{other arguments.} } \details{ The plot shows the observed effect sizes or outcomes with corresponding confidence intervals. To use the function, one should specify the observed outcomes (via the \code{x} argument) together with the corresponding sampling variances (via the \code{vi} argument) or with the corresponding standard errors (via the \code{sei} argument). Alternatively, one can specify the observed outcomes together with the corresponding confidence interval bounds (via the \code{ci.lb} and \code{ci.ub} arguments). With the \code{transf} argument, the observed outcomes and corresponding confidence interval bounds can be transformed with some suitable function. For example, when plotting log odds ratios, then one could use \code{transf=exp} to obtain a forest plot showing the odds ratios. Alternatively, one can use the \code{atransf} argument to transform the x-axis labels and annotations (e.g., \code{atransf=exp}). See also \link{transf} for some other useful transformation functions in the context of a meta-analysis. The examples below illustrate the use of these arguments. By default, the studies are ordered from top to bottom (i.e., the first study in the dataset will be placed in row \mjseqn{k}, the second study in row \mjseqn{k-1}, and so on, until the last study, which is placed in the first row). The studies can be reordered with the \code{order} argument: \itemize{ \item \code{order="obs"}: the studies are ordered by the observed outcomes, \item \code{order="prec"}: the studies are ordered by their sampling variances. } Alternatively, it is also possible to set \code{order} equal to a variable based on which the studies will be ordered (see \sQuote{Examples}). Additional columns with information about the studies can be added to the plot via the \code{ilab} argument. This can either be a single variable or an entire matrix / data frame (with as many rows as there are studies in the forest plot). The \code{ilab.xpos} argument can then also be specified to indicate the horizontal position of the variables specified via \code{ilab}. Summary estimates can be added to the plot with the \code{\link{addpoly}} function. See the documentation for that function for examples. By default (i.e., when \code{psize} is not specified), the point sizes are a function of the precision (i.e., inverse standard errors) of the outcomes. This way, more precise estimates are visually more prominent in the plot. By making the point sizes a function of the inverse standard errors of the estimates, their areas are proportional to the inverse sampling variances, which corresponds to the weights they would receive in an equal-effects model. However, the point sizes are rescaled so that the smallest point size is \code{plim[1]} and the largest point size is \code{plim[2]}. As a result, their relative sizes (i.e., areas) no longer exactly correspond to their relative weights in such a model. If exactly relative point sizes are desired, one can set \code{plim[2]} to \code{NA}, in which case the points are rescaled so that the smallest point size corresponds to \code{plim[1]} and all other points are scaled accordingly. As a result, the largest point may be very large. Alternatively, one can set \code{plim[1]} to \code{NA}, in which case the points are rescaled so that the largest point size corresponds to \code{plim[2]} and all other points are scaled accordingly. As a result, the smallest point may be very small and essentially indistinguishable from the confidence interval line. To avoid the latter, one can also set \code{plim[3]}, which enforces a minimal point size. With the \code{shade} argument, one can shade rows of the plot. The argument can be set to one of the following character strings: \code{"zebra"} (same as \code{shade=TRUE}) or \code{"zebra2"} to use zebra-style shading (starting either at the first or second study) or to \code{"all"} in which case all rows are shaded. Alternatively, the argument can be set to a logical vector to indicates for which studies the rows should be shaded. Finally, the argument can also be a numeric vector to indicate which rows to shade. The \code{colshade} argument can be used to set the color of shaded rows. } \section{Note}{ The function sets some sensible values for the optional arguments, but it may be necessary to adjust these in certain circumstances. The function actually returns some information about the chosen values invisibly. Printing this information is useful as a starting point to make adjustments to the plot. If the number of studies is quite large, the labels, annotations, and symbols may become quite small and impossible to read. Stretching the plot window vertically may then provide a more readable figure (one should call the function again after adjusting the window size, so that the label/symbol sizes can be properly adjusted). Also, the \code{cex}, \code{cex.lab}, and \code{cex.axis} arguments are then useful to adjust the symbol and text sizes. If the outcome measure used for creating the plot is bounded (e.g., correlations are bounded between -1 and +1, proportions are bounded between 0 and 1), one can use the \code{olim} argument to enforce those limits (the observed outcomes and confidence intervals cannot exceed those bounds then). The \code{lty} argument can also be a vector of two elements, the first for specifying the line type of the individual CIs (\code{"solid"} by default), the second for the line type of the horizontal line that is automatically added to the plot (\code{"solid"} by default; set to \code{"blank"} to remove it). } \section{Additional Optional Arguments}{ There are some additional optional arguments that can be passed to the function via \code{...} (hence, they cannot be abbreviated): \describe{ \item{top}{single numeric value to specify the amount of space (in terms of number of rows) to leave empty at the top of the plot (e.g., for adding headers). The default is 3.} \item{annosym}{vector of length 3 to select the left bracket, separation, and right bracket symbols for the annotations. The default is \code{c(" [", ", ", "]")}. Can also include a 4th element to adjust the look of the minus symbol, for example to use a proper minus sign (\ifelse{latex}{\mjseqn{-}}{\enc{−}{-}}) instead of a hyphen-minus (-). Can also include a 5th element that should be a space-like symbol (e.g., an \sQuote{en space}) that is used in place of numbers (only relevant when trying to line up numbers exactly).} \item{tabfig}{single numeric value (either a 1, 2, or 3) to set \code{annosym} automatically to a vector that will exactly align the numbers in the annotations when using a font that provides \sQuote{tabular figures}. The appropriate value for this argument depends on the font used. For example, for fonts Calibri and Carlito, 1 or 2 should work; for fonts Source Sans 3 and Palatino Linotype, 1, 2, and 3 should all work; for Computer Moden and Latin Modern fonts, 2 should work; for Lato, Roboto, and Open Sans (and maybe Arial), 3 should work. Other fonts may work as well, but this is untested.} \item{textpos}{numeric vector of length 2 to specify the placement of the study labels and the annotations. The default is to use the horizontal limits of the plot region, i.e., the study labels to the right of \code{xlim[1]} and the annotations to the left of \code{xlim[2]}.} \item{rowadj}{numeric vector of length 3 to vertically adjust the position of the study labels, the annotations, and the extra information (if specified via \code{ilab}). This is useful for fine-tuning the position of text added with different positional alignments (i.e., argument \code{pos} in the \code{\link{text}} function).} } } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Lewis, S., & Clarke, M. (2001). Forest plots: Trying to see the wood and the trees. \emph{British Medical Journal}, \bold{322}(7300), 1479--1480. \verb{https://doi.org/10.1136/bmj.322.7300.1479} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{forest}} for an overview of the various \code{forest} functions and especially \code{\link{forest.rma}} for the function draw forest plots including a summary polygon. \code{\link{addpoly}} for a function to add polygons to forest plots. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, slab=paste(author, year, sep=", ")) ### default forest plot of the observed log risk ratios forest(dat$yi, dat$vi, header=TRUE) ### the with() function can be used to avoid having to retype dat$... over and over with(dat, forest(yi, vi, header=TRUE)) ### forest plot of the observed risk ratios (transform outcomes) with(dat, forest(yi, vi, transf=exp, alim=c(0,2), steps=5, xlim=c(-2.5,4), refline=1, cex=0.9, header=TRUE, top=2)) ### forest plot of the observed risk ratios (transformed x-axis) with(dat, forest(yi, vi, atransf=exp, at=log(c(0.05,0.25,1,4,20)), xlim=c(-10,8), cex=0.9, header=TRUE, top=2)) ### forest plot of the observed risk ratios with studies ordered by the RRs with(dat, forest(yi, vi, atransf=exp, at=log(c(0.05,0.25,1,4,20)), xlim=c(-10,8), cex=0.9, header=TRUE, top=2, order="obs")) ### forest plot of the observed risk ratios with studies ordered by absolute latitude with(dat, forest(yi, vi, atransf=exp, at=log(c(0.05,0.25,1,4,20)), xlim=c(-10,8), cex=0.9, header=TRUE, top=2, order=ablat)) ### see also examples for the forest.rma function } \keyword{hplot} metafor/man/print.matreg.Rd0000644000176200001440000000360214505063152015365 0ustar liggesusers\name{print.matreg} \alias{print.matreg} \alias{summary.matreg} \alias{print.summary.matreg} \title{Print and Summary Methods for 'matreg' Objects} \description{ Functions to print objects of class \code{"matreg"} and \code{"summary.matreg"}. \loadmathjax } \usage{ \method{print}{matreg}(x, digits, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, \dots) \method{summary}{matreg}(object, digits, \dots) \method{print}{summary.matreg}(x, digits, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, \dots) } \arguments{ \item{x}{an object of class \code{"matreg"} or \code{"summary.matreg"} (for \code{print}).} \item{object}{an object of class \code{"matreg"} (for \code{summary}).} \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} \item{signif.stars}{logical to specify whether p-values should be encoded visually with \sQuote{significance stars}. Defaults to the \code{show.signif.stars} slot of \code{\link{options}}.} \item{signif.legend}{logical to specify whether the legend for the \sQuote{significance stars} should be printed. Defaults to the value for \code{signif.stars}.} \item{\dots}{other arguments.} } \details{ The output is a table with the estimated coefficients, corresponding standard errors, test statistics, p-values, and confidence interval bounds. When using \code{summary}, the output includes additional statistics, including \mjseqn{R^2} and the omnibus test of the model coefficients (either an F- or a chi-square test). } \value{ The function does not return an object. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \seealso{ \code{\link{matreg}} for the function to create \code{matreg} objects. } \keyword{print} metafor/man/print.confint.rma.Rd0000644000176200001440000000270414505063152016326 0ustar liggesusers\name{print.confint.rma} \alias{print.confint.rma} \alias{print.list.confint.rma} \title{Print Methods for 'confint.rma' and 'list.confint.rma' Objects} \description{ Functions to print objects of class \code{"confint.rma"} and \code{"list.confint.rma"}. } \usage{ \method{print}{confint.rma}(x, digits=x$digits, \dots) \method{print}{list.confint.rma}(x, digits=x$digits, \dots) } \arguments{ \item{x}{an object of class \code{"confint.rma"} or \code{"list.confint.rma"} obtained with \code{\link[=confint.rma.uni]{confint}}.} \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} \item{\dots}{other arguments.} } \details{ The output includes: \itemize{ \item estimate of the model coefficient or variance/correlation parameter \item lower bound of the confidence interval \item upper bound of the confidence interval } } \value{ The function does not return an object. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link[=confint.rma]{confint}} for the functions to create \code{confint.rma} and \code{list.confint.rma} objects. } \keyword{print} metafor/man/print.escalc.Rd0000644000176200001440000001315114505063152015340 0ustar liggesusers\name{print.escalc} \alias{print.escalc} \alias{summary.escalc} \title{Print and Summary Methods for 'escalc' Objects} \description{ Function to print objects of class \code{"escalc"} (and to obtain inferences for the individual studies/rows in such an object). \loadmathjax } \usage{ \method{print}{escalc}(x, digits=attr(x,"digits"), \dots) \method{summary}{escalc}(object, out.names=c("sei","zi","pval","ci.lb","ci.ub"), var.names, H0=0, append=TRUE, replace=TRUE, level=95, olim, digits, transf, \dots) } \arguments{ \item{x}{an object of class \code{"escalc"} obtained with \code{\link{escalc}}.} \item{object}{an object of class \code{"escalc"} obtained with \code{\link{escalc}}.} \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} \item{out.names}{character string with four elements to specify the variable names for the standard errors, test statistics, and lower/upper confidence interval bounds.} \item{var.names}{character string with two elements to specify the variable names for the observed effect sizes or outcomes and the sampling variances (the default is to take the value from the object if possible).} \item{H0}{numeric value to specify the value of the effect size or outcome under the null hypothesis (the default is 0).} \item{append}{logical to specify whether the data frame specified via the \code{object} argument should be returned together with the additional variables that are calculated by the \code{summary} function (the default is \code{TRUE}).} \item{replace}{logical to specify whether existing values for \code{sei}, \code{zi}, \code{ci.lb}, and \code{ci.ub} in the data frame should be replaced. Only relevant when the data frame already contains these variables. If \code{replace=TRUE} (the default), all of the existing values will be overwritten. If \code{replace=FALSE}, only \code{NA} values will be replaced.} \item{level}{numeric value between 0 and 100 to specify the confidence interval level (the default is 95; see \link[=misc-options]{here} for details).} \item{olim}{optional argument to specify observation/outcome limits. If unspecified, no limits are used.} \item{transf}{optional argument to specify a function to transform the observed effect sizes or outcomes and interval bounds (e.g., \code{transf=exp}; see also \link{transf}). If unspecified, no transformation is used. Any additional arguments needed for the function specified here can be passed via \code{\dots}.} \item{\dots}{other arguments.} } \value{ The \code{print.escalc} function formats and prints the data frame, so that the observed effect sizes or outcomes and sampling variances are rounded (to the number of digits specified). The \code{summary.escalc} function creates an object that is a data frame containing the original data (if \code{append=TRUE}) and the following components: \item{yi}{observed effect sizes or outcomes (transformed if \code{transf} is specified).} \item{vi}{corresponding sampling variances.} \item{sei}{corresponding standard errors.} \item{zi}{test statistics for testing \mjeqn{\mbox{H}_0{:}\; \theta_i = \mbox{H0}}{H_0: \theta_i = H0} (i.e., \code{(yi-H0)/sei}).} \item{pval}{corresponding p-values.} \item{ci.lb}{lower confidence interval bounds (transformed if \code{transf} is specified).} \item{ci.ub}{upper confidence interval bounds (transformed if \code{transf} is specified).} When the \code{transf} argument is specified, elements \code{vi}, \code{sei}, \code{zi}, and \code{pval} are not included (since these only apply to the untransformed effect sizes or outcomes). Note that the actual variable names above depend on the \code{out.names} (and \code{var.names}) arguments. If the data frame already contains variables with names as specified by the \code{out.names} argument, the values for these variables will be overwritten when \code{replace=TRUE} (which is the default). By setting \code{replace=FALSE}, only values that are \code{NA} will be replaced. The \code{print.escalc} function again formats and prints the data frame, rounding the added variables to the number of digits specified. } \note{ If some transformation function has been specified for the \code{transf} argument, then \code{yi}, \code{ci.lb}, and \code{ci.ub} will be transformed accordingly. However, \code{vi} and \code{sei} then still reflect the sampling variances and standard errors of the untransformed values. The \code{summary.escalc} function computes \code{level} \% Wald-type confidence intervals, which may or may not be the most accurate method for computing confidence intervals for the chosen effect size or outcome measure. If the outcome measure used is bounded (e.g., correlations are bounded between -1 and +1, proportions are bounded between 0 and 1), one can use the \code{olim} argument to enforce those observation/outcome limits (the observed outcomes and confidence intervals cannot exceed those bounds then). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{escalc}} for the function to create \code{escalc} objects. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) dat ### apply summary function summary(dat) summary(dat, transf=exp) } \keyword{print} metafor/man/blup.Rd0000644000176200001440000001254414505063152013722 0ustar liggesusers\name{blup} \alias{blup} \alias{blup.rma.uni} \title{Best Linear Unbiased Predictions for 'rma.uni' Objects} \description{ Function to compute best linear unbiased predictions (BLUPs) of the study-specific true effect sizes or outcomes (by combining the fitted values based on the fixed effects and the estimated contributions of the random effects) for objects of class \code{"rma.uni"}. Corresponding standard errors and prediction interval bounds are also provided. \loadmathjax } \usage{ blup(x, \dots) \method{blup}{rma.uni}(x, level, digits, transf, targs, \dots) } \arguments{ \item{x}{an object of class \code{"rma.uni"}.} \item{level}{numeric value between 0 and 100 to specify the prediction interval level (see \link[=misc-options]{here} for details). If unspecified, the default is to take the value from the object.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} \item{transf}{optional argument to specify a function to transform the predicted values and interval bounds (e.g., \code{transf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{targs}{optional arguments needed by the function specified under \code{transf}.} \item{\dots}{other arguments.} } \value{ An object of class \code{"list.rma"}. The object is a list containing the following components: \item{pred}{predicted values.} \item{se}{corresponding standard errors.} \item{pi.lb}{lower bound of the prediction intervals.} \item{pi.ub}{upper bound of the prediction intervals.} \item{\dots}{some additional elements/values.} The object is formatted and printed with the \code{\link[=print.list.rma]{print}} function. To format the results as a data frame, one can use the \code{\link[=as.data.frame.list.rma]{as.data.frame}} function. } \note{ For best linear unbiased predictions of only the random effects, see \code{\link{ranef}}. For predicted/fitted values that are based only on the fixed effects of the model, see \code{\link[=fitted.rma]{fitted}} and \code{\link[=predict.rma]{predict}}. For conditional residuals (the deviations of the observed effect sizes or outcomes from the BLUPs), see \code{rstandard.rma.uni} with \code{type="conditional"}. Equal-effects models do not contain random study effects. The BLUPs for these models will therefore be equal to the fitted values, that is, those obtained with \code{\link[=fitted.rma]{fitted}} and \code{\link[=predict.rma]{predict}}. When using the \code{transf} argument, the transformation is applied to the predicted values and the corresponding interval bounds. The standard errors are then set equal to \code{NA} and are omitted from the printed output. By default, a standard normal distribution is used to construct the prediction intervals. When the model was fitted with \code{test="t"} or \code{test="knha"}, then a t-distribution with \mjseqn{k-p} degrees of freedom is used. To be precise, it should be noted that the function actually computes empirical BLUPs (eBLUPs), since the predicted values are a function of the estimated value of \mjseqn{\tau^2}. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Kackar, R. N., & Harville, D. A. (1981). Unbiasedness of two-stage estimation and prediction procedures for mixed linear models. Communications in Statistics, Theory and Methods, \bold{10}(13), 1249--1261. \verb{https://doi.org/10.1080/03610928108828108} Raudenbush, S. W., & Bryk, A. S. (1985). Empirical Bayes meta-analysis. \emph{Journal of Educational Statistics}, \bold{10}(2), 75--98. \verb{https://doi.org/10.3102/10769986010002075} Robinson, G. K. (1991). That BLUP is a good thing: The estimation of random effects. \emph{Statistical Science}, \bold{6}(1), 15--32. \verb{https://doi.org/10.1214/ss/1177011926} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}} for the function to fit models for which BLUPs can be extracted. \code{\link[=predict.rma]{predict}} and \code{\link[=fitted.rma]{fitted}} for functions to compute the predicted/fitted values based only on the fixed effects and \code{\link{ranef}} for a function to compute the BLUPs based only on the random effects. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### meta-analysis of the log risk ratios using a random-effects model res <- rma(yi, vi, data=dat) ### BLUPs of the true risk ratios for each study blup(res, transf=exp) ### illustrate shrinkage of BLUPs towards the (estimated) population average res <- rma(yi, vi, data=dat) blups <- blup(res)$pred plot(NA, NA, xlim=c(.8,2.4), ylim=c(-2,0.5), pch=19, xaxt="n", bty="n", xlab="", ylab="Log Risk Ratio") segments(rep(1,13), dat$yi, rep(2,13), blups, col="darkgray") points(rep(1,13), dat$yi, pch=19) points(rep(2,13), blups, pch=19) axis(side=1, at=c(1,2), labels=c("Observed\nValues", "BLUPs"), lwd=0) segments(0, res$beta, 2.15, res$beta, lty="dotted") text(2.3, res$beta, substitute(hat(mu)==muhat, list(muhat=round(res$beta[[1]], 2))), cex=1) } \keyword{models} metafor/man/vif.Rd0000644000176200001440000003603414505063152013544 0ustar liggesusers\name{vif} \alias{vif} \alias{vif.rma} \alias{print.vif.rma} \title{Variance Inflation Factors for 'rma' Objects} \description{ Function to compute (generalized) variance inflation factors (VIFs) for objects of class \code{"rma"}. \loadmathjax } \usage{ vif(x, \dots) \method{vif}{rma}(x, btt, att, table=FALSE, reestimate=FALSE, sim=FALSE, progbar=TRUE, seed=NULL, parallel="no", ncpus=1, cl, digits, \dots) \method{print}{vif.rma}(x, digits=x$digits, \dots) } \arguments{ \item{x}{an object of class \code{"rma"} (for \code{vif}) or \code{"vif.rma"} (for \code{print}).} \item{btt}{optional vector of indices (or list thereof) to specify a set of coefficients for which a generalized variance inflation factor (GVIF) should be computed. Can also be a string to \code{\link{grep}} for.} \item{att}{optional vector of indices (or list thereof) to specify a set of scale coefficients for which a generalized variance inflation factor (GVIF) should be computed. Can also be a string to \code{\link{grep}} for. Only relevant for location-scale models (see \code{\link{rma.uni}}).} \item{table}{logical to specify whether the VIFs should be added to the model coefficient table (the default is \code{FALSE}). Only relevant when \code{btt} (or \code{att}) is not specified.} \item{reestimate}{logical to specify whether the model should be reestimated when removing moderator variables from the model for computing a (G)VIF (the default is \code{FALSE}).} \item{sim}{logical to specify whether the distribution of each (G)VIF under independence should be simulated (the default is \code{FALSE}). Can also be an integer to specify how many values to simulate (when \code{sim=TRUE}, the default is \code{1000}).} \item{progbar}{logical to specify whether a progress bar should be shown when \code{sim=TRUE} (the default is \code{TRUE}).} \item{seed}{optional value to specify the seed of the random number generator when \code{sim=TRUE} (for reproducibility).} \item{parallel}{character string to specify whether parallel processing should be used (the default is \code{"no"}). For parallel processing, set to either \code{"snow"} or \code{"multicore"}. See \sQuote{Note}.} \item{ncpus}{integer to specify the number of processes to use in the parallel processing.} \item{cl}{optional cluster to use if \code{parallel="snow"}. If unspecified, a cluster on the local machine is created for the duration of the call.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} \item{\dots}{other arguments.} } \details{ The function computes (generalized) variance inflation factors (VIFs) for meta-regression models. Hence, the model specified via argument \code{x} must include moderator variables (and more than one for this to be useful, as the VIF for a model with a single moderator variable will always be equal to 1). \subsection{VIFs for Individual Coefficients}{ By default (i.e., if \code{btt} is not specified), VIFs are computed for the individual model coefficients. Let \mjseqn{b_j} denote the estimate of the \mjeqn{j\textrm{th}}{jth} model coefficient of a particular meta-regression model and \mjeqn{\mbox{Var}[b_j]}{Var[b_j]} its variance (i.e., the corresponding diagonal element from the matrix obtained with the \code{\link[=vcov.rma]{vcov}} function). Moreover, let \mjseqn{b'_j} denote the estimate of the same model coefficient if the other moderator variables in the model had \emph{not} been included in the model and \mjeqn{\mbox{Var}[b'_j]}{Var[b'_j]} the corresponding variance. Then the VIF for the model coefficient is given by \mjdeqn{\mbox{VIF}[b_j] = \frac{\mbox{Var}[b_j]}{\mbox{Var}[b'_j]},}{VIF[b_j] = Var[b_j] / Var[b'_j],} which indicates the inflation in the variance of the estimated model coefficient due to potential collinearity of the \mjeqn{j\textrm{th}}{jth} moderator variable with the other moderator variables in the model. Taking the square root of a VIF gives the corresponding standard error inflation factor (SIF). } \subsection{GVIFs for Sets of Coefficients}{ If the model includes factors (coded in terms of multiple dummy variables) or other sets of moderator variables that belong together (e.g., for polynomials or cubic splines), one may want to examine how much the variance in all of the coefficients in the set is jointly impacted by collinearity with the other moderator variables in the model. For this, we can compute a generalized variance inflation factor (GVIF) (Fox & Monette, 1992) by setting the \code{btt} argument equal to the indices of those coefficients for which the GVIF should be computed. The square root of a GVIF indicates the inflation in the confidence ellipse/(hyper)ellipsoid for the set of coefficients corresponding to the set due to collinearity. However, to make this value more directly comparable to SIFs (based on single coefficients), the function computes the generalized standard error inflation factor (GSIF) by raising the GVIF to the power of \mjseqn{1/(2m)} (where \mjseqn{m} denotes the number of coefficients in the set). One can also specify a list of indices/strings, in which case GVIFs/GSIFs of all list elements will be computed. See \sQuote{Examples}. For location-scale models fitted with the \code{\link{rma.uni}} function, one can use the \code{att} argument in an analogous manner to specify the indices of the scale coefficients for which a GVIF should be computed. } \subsection{Re-Estimating the Model}{ The way the VIF is typically computed for a particular model coefficient (or a set thereof for a GVIF) makes use of some clever linear algebra to avoid having to re-estimate the model when removing the other moderator variables from the model. This speeds up the computations considerably. However, this assumes that the other moderator variables do not impact other aspects of the model, in particular the amount of residual heterogeneity (or, more generally, any variance/correlation components in a more complex model, such as those that can be fitted with the \code{\link{rma.mv}} function). For a more accurate (but slower) computation of each (G)VIF, one can set \code{reestimate=TRUE}, in which case the model is refitted to account for the impact that removal of the other moderator variables has on all aspects of the model. Note that refitting may fail, in which case the corresponding (G)VIF will be missing. } \subsection{Interpreting the Size of (G)VIFs}{ A large VIF value suggests that the precision with which we can estimate a particular model coefficient (or a set thereof for a GVIF) is negatively impacted by multicollinearity among the moderator variables. However, there is no specific cutoff for determining whether a particular (G)VIF is \sQuote{large}. Sometimes, values such as 5 or 10 have been suggested as rules of thumb, but such cutoffs are essentially arbitrary. } \subsection{Simulating the Distribution of (G)VIFs Under Independence}{ As a more principled approach, we can simulate the distribution of a particular (G)VIF under independence and then examine how extreme the actually observed (G)VIF value is under this distribution. The distribution is simulated by randomly reshuffling the columns of the model matrix (to break any dependence between the moderators) and recomputing the (G)VIF. When setting \code{sim=TRUE}, this is done 1000 times (but one can also set \code{sim} to an integer to indicate how many (G)VIF values should be simulated). The way the model matrix is reshuffled depends on how the model was fitted. When the model was specified as a formula via the \code{mods} argument and the data was supplied via the \code{data} argument, then each column of the data frame specified via \code{data} is reshuffled and the formula is evaluated within the reshuffled data (creating the corresponding reshuffled model matrix). This way, factor/character variables are properly reshuffled and derived terms (e.g., interactions, polynomials, splines) are correct constructed. This is the recommended approach. On the other hand, if the model matrix was directly supplied to the \code{mods} argument, then each column of the matrix is directly reshuffled. This is not recommended, since this approach cannot account for any inherent relationships between variables in the model matrix (e.g., an interaction term is the product of two variables and should not be reshuffled by itself). Once the distribution of a (G)VIF under independence has been simulated, the proportion of simulated values that are smaller than the actually observed (G)VIF value is computed. If the proportion is close to 1, then this indicates that the actually observed (G)VIF value is extreme. The general principle underlying the simulation approach is the same as that underlying Horn's parallel analysis (1965) for determining the number of components / factors to keep in a principal component / factor analysis. } } \value{ An object of class \code{"vif.rma"}. The object is a list containing the following components: \item{vif}{a list of data frames with the (G)VIFs and (G)SIFs and some additional information.} \item{vifs}{a vector with just the (G)VIFs.} \item{table}{the model coefficient table (only when \code{table=TRUE}).} \item{sim}{a matrix with the simulated (G)VIF values (only when \code{sim=TRUE}).} \item{prop}{vector with the proportions of simulated values that are smaller than the actually observed (G)VIF values (only when \code{sim=TRUE}).} \item{\dots}{some additional elements/values.} When \code{x} was a location-scale model object and (G)VIFs can be computed for both the location and the scale coefficients, then the object is a list with elements \code{beta} and \code{alpha}, where each element is an \code{"vif.rma"} object as described above. The results are formatted and printed with the \code{print} function. To format the results as a data frame, one can use the \code{\link[=as.data.frame.vif.rma]{as.data.frame}} function. When \code{sim=TRUE}, the distribution of each (G)VIF can be plotted with the \code{\link[=plot.vif.rma]{plot}} function. } \note{ If the original model fitted involved redundant predictors that were dropped from the model, then \code{sim=TRUE} cannot be used. In this case, one should remove any redundancies in the original model fitted before using this method. When using \code{sim=TRUE}, the model needs to be refitted (by default) 1000 times. When \code{sim=TRUE} is combined with \code{reestimate=TRUE}, then this value needs to be multiplied by the total number of (G)VIF values that are computed by the function. Hence, the combination of \code{sim=TRUE} with \code{reestimate=TRUE} is computationally expensive, especially for more complex models where model fitting can be slow. When refitting the model fails, the simulated (G)VIF value(s) will be missing. It can also happen that one or multiple model coefficients become inestimable due to redundancies in the model matrix after the reshuffling. In this case, the corresponding simulated (G)VIF value(s) will be set to \code{Inf} (as that is the value of (G)VIFs in the limit as we approach perfect multicollinearity). On machines with multiple cores, one can try to speed things up by delegating the model fitting to separate worker processes, that is, by setting \code{parallel="snow"} or \code{parallel="multicore"} and \code{ncpus} to some value larger than 1. Parallel processing makes use of the \code{\link[parallel]{parallel}} package, using the \code{\link[parallel]{makePSOCKcluster}} and \code{\link[parallel]{parLapply}} functions when \code{parallel="snow"} or using \code{\link[parallel]{mclapply}} when \code{parallel="multicore"} (the latter only works on Unix/Linux-alikes). With \code{parallel::detectCores()}, one can check on the number of available cores on the local machine. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Belsley, D. A., Kuh, E., & Welsch, R. E. (1980). \emph{Regression diagnostics}. New York: Wiley. Fox, J., & Monette, G. (1992). Generalized collinearity diagnostics. \emph{Journal of the American Statistical Association}, \bold{87}(417), 178--183. \verb{https://doi.org/10.2307/2290467} Horn, J. L. (1965). A rationale and test for the number of factors in factor analysis. \emph{Psychometrika}, \bold{30}(2), 179--185. \verb{https://doi.org/10.1007/BF02289447} Stewart, G. W. (1987). Collinearity and least squares regression. \emph{Statistical Science}, \bold{2}(1), 68-84. \verb{https://doi.org/10.1214/ss/1177013439} Wax, Y. (1992). Collinearity diagnosis for a relative risk regression-analysis: An application to assessment of diet cancer relationship in epidemiologic studies. \emph{Statistics in Medicine}, \bold{11}(10), 1273--1287. \verb{https://doi.org/10.1002/sim.4780111003} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W., & \enc{López-López}{Lopez-Lopez}, J. A. (2022). Location-scale models for meta-analysis. \emph{Research Synthesis Methods}. \bold{13}(6), 697--715. \verb{https://doi.org/10.1002/jrsm.1562} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models for which variance inflation factors can be computed. \code{\link[=plot.vif.rma]{plot}} for the plot method and \code{\link[=as.data.frame.vif.rma]{as.data.frame}} for the method to format the results as a data frame. } \examples{ ### copy data from Bangert-Drowns et al. (2004) into 'dat' dat <- dat.bangertdrowns2004 ### fit mixed-effects meta-regression model res <- rma(yi, vi, mods = ~ length + wic + feedback + info + pers + imag + meta, data=dat) ### get variance inflation factors vif(res) ### use the simulation approach to analyze the size of the VIFs \dontrun{ vif(res, sim=TRUE, seed=1234) } ### get variance inflation factors using the re-estimation approach vif(res, reestimate=TRUE) ### show that VIFs are not influenced by scaling of the predictors u <- scale # to standardize the predictors res <- rma(yi, vi, mods = ~ u(length) + u(wic) + u(feedback) + u(info) + u(pers) + u(imag) + u(meta), data=dat) vif(res, reestimate=TRUE) ### get full table vif(res, reestimate=TRUE, table=TRUE) ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit meta-regression model where one predictor (alloc) is a three-level factor res <- rma(yi, vi, mods = ~ ablat + alloc + year, data=dat) ### get variance inflation factors for all individual coefficients vif(res, table=TRUE) ### generalized variance inflation factor for the 'alloc' factor vif(res, btt=3:4) ### can also specify a string to grep for vif(res, btt="alloc") ### can also specify a list for the 'btt' argument (and use the simulation approach) \dontrun{ vif(res, btt=list(2,3:4,5), sim=TRUE, seed=1234) } } \keyword{models} metafor/man/conv.2x2.Rd0000644000176200001440000002767714505063152014354 0ustar liggesusers\name{conv.2x2} \alias{conv.2x2} \title{Reconstruct Cell Frequencies of \mjeqn{2 \times 2}{2x2} Tables} \description{ Function to reconstruct the cell frequencies of \mjeqn{2 \times 2}{2x2} tables based on other summary statistics. \loadmathjax } \usage{ conv.2x2(ori, ri, x2i, ni, n1i, n2i, correct=TRUE, data, include, var.names=c("ai","bi","ci","di"), append=TRUE, replace="ifna") } \arguments{ \item{ori}{optional vector with the odds ratios corresponding to the tables.} \item{ri}{optional vector with the phi coefficients corresponding to the tables.} \item{x2i}{optional vector with the (signed) chi-square statistics corresponding to the tables.} \item{ni}{vector with the total sample sizes.} \item{n1i}{vector with the marginal counts for the outcome of interest on the first variable.} \item{n2i}{vector with the marginal counts for the outcome of interest on the second variable.} \item{correct}{optional logical (or vector thereof) to indicate whether chi-square statistics were computed using Yates's correction for continuity (the default is \code{TRUE}).} \item{data}{optional data frame containing the variables given to the arguments above.} \item{include}{optional (logical or numeric) vector to specify the subset of studies for which the cell frequencies should be reconstructed.} \item{var.names}{character vector with four elements to specify the names of the variables for the reconstructed cell frequencies (the default is \code{c("ai","bi","ci","di")}).} \item{append}{logical to specify whether the data frame provided via the \code{data} argument should be returned together with the reconstructed values (the default is \code{TRUE}).} \item{replace}{character string or logical to specify how values in \code{var.names} should be replaced (only relevant when using the \code{data} argument and if variables in \code{var.names} already exist in the data frame). See the \sQuote{Value} section for more details.} } \details{ For meta-analyses based on \mjeqn{2 \times 2}{2x2} table data, the problem often arises that some studies do not directly report the cell frequencies. The present function allows the reconstruction of such tables based on other summary statistics. In particular, assume that the data of interest for a particular study are of the form: \tabular{lcccccc}{ \tab \ics \tab variable 2, outcome + \tab \ics \tab variable 2, outcome - \tab \ics \tab total \cr variable 1, outcome + \tab \ics \tab \code{ai} \tab \ics \tab \code{bi} \tab \ics \tab \code{n1i} \cr variable 1, outcome - \tab \ics \tab \code{ci} \tab \ics \tab \code{di} \tab \ics \tab \cr total \tab \ics \tab \code{n2i} \tab \ics \tab \tab \ics \tab \code{ni}} where \code{ai}, \code{bi}, \code{ci}, and \code{di} denote the cell frequencies (i.e., the number of individuals falling into a particular category), \code{n1i} (i.e., \code{ai+bi}) and \code{n2i} (i.e., \code{ai+ci}) are the marginal totals for the outcome of interest on the first and second variable, respectively, and \code{ni} is the total sample size (i.e., \code{ai+bi+ci+di}) of the study. For example, if variable 1 denotes two different groups (e.g., treated versus control) and variable 2 indicates whether a particular outcome of interest has occurred or not (e.g., death, complications, failure to improve under the treatment), then \code{n1i} denotes the number of individuals in the treatment group, but \code{n2i} is \emph{not} the number of individuals in the control group, but the total number of individuals who experienced the outcome of interest on variable 2. \bold{Note that the meaning of \code{n2i} is therefore different here compared to the \code{\link{escalc}} function (where \code{n2i} denotes \code{ci+di})}. If a study does not report the cell frequencies, but it reports the total sample size (which can be specified via the \code{ni} argument), the two marginal counts (which can be specified via the \code{n1i} and \code{n2i} arguments), and some other statistic corresponding to the table, then it may be possible to reconstruct the cell frequencies. The present function currently allows this for three different cases: \enumerate{ \item If the odds ratio \mjdeqn{OR = \frac{a_i d_i}{b_i c_i}}{ai*di/(bi*ci)} is known, then the cell frequencies can be reconstructed (Bonett, 2007). Odds ratios can be specified via the \code{ori} argument. \item If the phi coefficient \mjdeqn{\phi = \frac{a_i d_i - b_i c_i}{\sqrt{n_{1i}(n_i-n_{1i})n_{2i}(n_i-n_{2i})}}}{\phi = (ai*di-bi*ci) / \sqrt{n1i*(ni-n1i)*n2i*(ni-n2i)}} is known, then the cell frequencies can again be reconstructed (own derivation). Phi coefficients can be specified via the \code{ri} argument. \item If the chi-square statistic from Pearson's chi-square test of independence is known (which can be specified via the \code{x2i} argument), then it can be used to recalculate the phi coefficient and hence again the cell frequencies can be reconstructed. However, the chi-square statistic does not carry information about the sign of the phi coefficient. Therefore, values specified via the \code{x2i} argument can be positive or negative, which allows the specification of the correct sign. Also, when using a chi-square statistic as input, it is assumed that it was computed using Yates's correction for continuity (unless \code{correct=FALSE}). If the chi-square statistic is not known, but its p-value, one can first back-calculate the chi-square statistic using \code{qchisq(, df=1, lower.tail=FALSE)}. } Typically, the odds ratio, phi coefficient, or chi-square statistic (or its p-value) that can be extracted from a study will be rounded to a certain degree. The calculations underlying the function are exact only for unrounded values. Rounding can therefore introduce some discrepancies. If a marginal total is unknown, then external information needs to be used to \sQuote{guestimate} the number of individuals that experienced the outcome of interest on this variable. Depending on the accuracy of such an estimate, the reconstructed cell frequencies will be more or less accurate and need to be treated with due caution. The true marginal counts also put constraints on the possible values for the odds ratio, phi coefficient, and chi-square statistic. If a marginal count is replaced by a guestimate which is not compatible with the given statistic, one or more reconstructed cell frequencies may be negative. The function issues a warning if this happens and sets the cell frequencies to \code{NA} for such a study. If only one of the two marginal counts is unknown but a 95\% CI for the odds ratio is also available, then the \href{https://cran.r-project.org/package=estimraw}{estimraw} package can also be used to reconstruct the corresponding cell frequencies (Di Pietrantonj, 2006; but see Veroniki et al., 2013, for some cautions). } \value{ If the \code{data} argument was not specified or \code{append=FALSE}, a data frame with four variables called \code{var.names} with the reconstructed cell frequencies. If \code{data} was specified and \code{append=TRUE}, then the original data frame is returned. If \code{var.names[j]} (for \mjeqn{\textrm{j} \in \\\\{1, \ldots, 4\\\\}}{for j in \{1, ..., 4\}}) is a variable in \code{data} and \code{replace="ifna"} (or \code{replace=FALSE}), then only missing values in this variable are replaced with the estimated frequencies (where possible) and otherwise a new variable called \code{var.names[j]} is added to the data frame. If \code{replace="all"} (or \code{replace=TRUE}), then all values in \code{var.names[j]} where a reconstructed cell frequency can be computed are replaced, even for cases where the value in \code{var.names[j]} is not missing. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Bonett, D. G. (2007). Transforming odds ratios into correlations for meta-analytic research. \emph{American Psychologist}, \bold{62}(3), 254--255. \verb{https://doi.org/10.1037/0003-066x.62.3.254} Di Pietrantonj, C. (2006). Four-fold table cell frequencies imputation in meta analysis. \emph{Statistics in Medicine}, \bold{25}(13), 2299--2322. \verb{https://doi.org/10.1002/sim.2287} Veroniki, A. A., Pavlides, M., Patsopoulos, N. A., & Salanti, G. (2013). Reconstructing 2 x 2 contingency tables from odds ratios using the Di Pietrantonj method: Difficulties, constraints and impact in meta-analysis results. \emph{Research Synthesis Methods}, \bold{4}(1), 78--94. \verb{https://doi.org/10.1002/jrsm.1061} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{escalc}} for a function to compute various effect size measures based on \mjeqn{2 \times 2}{2x2} table data. } \examples{ ### demonstration that the reconstruction of the 2x2 table works ### (note: the values in rows 2, 3, and 4 correspond to those in row 1) dat <- data.frame(ai=c(36,NA,NA,NA), bi=c(86,NA,NA,NA), ci=c(20,NA,NA,NA), di=c(98,NA,NA,NA), oddsratio=NA, phi=NA, chisq=NA, ni=NA, n1i=NA, n2i=NA) dat$oddsratio[2] <- round(exp(escalc(measure="OR", ai=ai, bi=bi, ci=ci, di=di, data=dat)$yi[1]), 2) dat$phi[3] <- round(escalc(measure="PHI", ai=ai, bi=bi, ci=ci, di=di, data=dat)$yi[1], 2) dat$chisq[4] <- round(chisq.test(matrix(c(t(dat[1,1:4])), nrow=2, byrow=TRUE))$statistic, 2) dat$ni[2:4] <- with(dat, ai[1] + bi[1] + ci[1] + di[1]) dat$n1i[2:4] <- with(dat, ai[1] + bi[1]) dat$n2i[2:4] <- with(dat, ai[1] + ci[1]) dat ### reconstruct cell frequencies for rows 2, 3, and 4 dat <- conv.2x2(ri=phi, ori=oddsratio, x2i=chisq, ni=ni, n1i=n1i, n2i=n2i, data=dat) dat ### same example but with cell frequencies that are 10 times as large dat <- data.frame(ai=c(360,NA,NA,NA), bi=c(860,NA,NA,NA), ci=c(200,NA,NA,NA), di=c(980,NA,NA,NA), oddsratio=NA, phi=NA, chisq=NA, ni=NA, n1i=NA, n2i=NA) dat$oddsratio[2] <- round(exp(escalc(measure="OR", ai=ai, bi=bi, ci=ci, di=di, data=dat)$yi[1]), 2) dat$phi[3] <- round(escalc(measure="PHI", ai=ai, bi=bi, ci=ci, di=di, data=dat)$yi[1], 2) dat$chisq[4] <- round(chisq.test(matrix(c(t(dat[1,1:4])), nrow=2, byrow=TRUE))$statistic, 2) dat$ni[2:4] <- with(dat, ai[1] + bi[1] + ci[1] + di[1]) dat$n1i[2:4] <- with(dat, ai[1] + bi[1]) dat$n2i[2:4] <- with(dat, ai[1] + ci[1]) dat <- conv.2x2(ri=phi, ori=oddsratio, x2i=chisq, ni=ni, n1i=n1i, n2i=n2i, data=dat) dat # slight inaccuracy in row 3 due to rounding ### demonstrate what happens when a true marginal count is guestimated escalc(measure="PHI", ai=176, bi=24, ci=72, di=128) conv.2x2(ri=0.54, ni=400, n1i=200, n2i=248) # using the true marginal counts conv.2x2(ri=0.54, ni=400, n1i=200, n2i=200) # marginal count for variable 2 is guestimated conv.2x2(ri=0.54, ni=400, n1i=200, n2i=50) # marginal count for variable 2 is incompatible ### demonstrate that using the correct sign for the chi-square statistic is important chisq <- round(chisq.test(matrix(c(40,60,60,40), nrow=2, byrow=TRUE))$statistic, 2) conv.2x2(x2i=-chisq, ni=200, n1i=100, n2i=100) # correct reconstruction conv.2x2(x2i=chisq, ni=200, n1i=100, n2i=100) # incorrect reconstruction ### demonstrate use of the 'correct' argument tab <- matrix(c(28,14,12,18), nrow=2, byrow=TRUE) chisq <- round(chisq.test(tab)$statistic, 2) # chi-square test with Yates' continuity correction conv.2x2(x2i=chisq, ni=72, n1i=42, n2i=40) # correct reconstruction chisq <- round(chisq.test(tab, correct=FALSE)$statistic, 2) # without Yates' continuity correction conv.2x2(x2i=chisq, ni=72, n1i=42, n2i=40) # incorrect reconstruction conv.2x2(x2i=chisq, ni=72, n1i=42, n2i=40, correct=FALSE) # correct reconstruction ### recalculate chi-square statistic based on p-value pval <- round(chisq.test(tab)$p.value, 2) chisq <- qchisq(pval, df=1, lower.tail=FALSE) conv.2x2(x2i=chisq, ni=72, n1i=42, n2i=40) } \keyword{manip} metafor/man/contrmat.Rd0000644000176200001440000000713714505063152014611 0ustar liggesusers\name{contrmat} \alias{contrmat} \title{Construct Contrast Matrix for Two-Group Comparisons} \description{ Function to construct a matrix that indicates which two groups have been contrasted against each other in each row of a dataset. } \usage{ contrmat(data, grp1, grp2, last, shorten=FALSE, minlen=2, check=TRUE, append=TRUE) } \arguments{ \item{data}{a data frame in wide format.} \item{grp1}{either the name (given as a character string) or the position (given as a single number) of the first group variable in the data frame.} \item{grp2}{either the name (given as a character string) or the position (given as a single number) of the second group variable in the data frame.} \item{last}{optional character string to specify which group will be placed in the last column of the matrix (must be one of the groups in the group variables). If not given, the most frequently occurring second group is placed last.} \item{shorten}{logical to specify whether the variable names corresponding to the group names should be shortened (the default is \code{FALSE}).} \item{minlen}{integer to specify the minimum length of the shortened variable names (the default is 2).} \item{check}{logical to specify whether the variables names should be checked to ensure that they are syntactically valid variable names and if not, they are adjusted (by \code{\link{make.names}}) so that they are (the default is \code{TRUE}).} \item{append}{logical to specify whether the contrast matrix should be appended to the data frame specified via the \code{data} argument (the default is \code{TRUE}). If \code{append=FALSE}, only the contrast matrix is returned.} } \details{ The function can be used to construct a matrix that indicates which two groups have been contrasted against each other in each row of a data frame (with \code{1} for the first group, \code{-1} for the second group, and \code{0} otherwise). The \code{grp1} and \code{grp2} arguments are used to specify the group variables in the dataset (either as character strings or as numbers indicating the column positions of these variables in the dataset). Optional argument \code{last} is used to specify which group will be placed in the last column of the matrix. If \code{shorten=TRUE}, the variable names corresponding to the group names are shortened (to at least \code{minlen}; the actual length might be longer to ensure uniqueness of the variable names). The examples below illustrate the use of this function. } \value{ A matrix with as many variables as there are groups. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{to.wide}} for a function to create \sQuote{wide} format datasets. \code{\link[metadat]{dat.senn2013}}, \code{\link[metadat]{dat.hasselblad1998}}, \code{\link[metadat]{dat.lopez2019}} for illustrative examples. } \examples{ ### restructure to wide format dat <- dat.senn2013 dat <- dat[c(1,4,3,2,5,6)] dat <- to.wide(dat, study="study", grp="treatment", ref="placebo", grpvars=4:6) dat ### add contrast matrix dat <- contrmat(dat, grp1="treatment.1", grp2="treatment.2") dat ### data in long format dat <- dat.hasselblad1998 dat ### restructure to wide format dat <- to.wide(dat, study="study", grp="trt", ref="no_contact", grpvars=6:7) dat ### add contrast matrix dat <- contrmat(dat, grp1="trt.1", grp2="trt.2", shorten=TRUE, minlen=3) dat } \keyword{manip} metafor/man/predict.rma.Rd0000644000176200001440000003215614505063152015171 0ustar liggesusers\name{predict.rma} \alias{predict} \alias{predict.rma} \alias{predict.rma.ls} \title{Predicted Values for 'rma' Objects} \description{ The function computes predicted values, corresponding standard errors, confidence intervals, and prediction intervals for objects of class \code{"rma"}. \loadmathjax } \usage{ \method{predict}{rma}(object, newmods, intercept, tau2.levels, gamma2.levels, addx=FALSE, level, digits, transf, targs, vcov=FALSE, \dots) \method{predict}{rma.ls}(object, newmods, intercept, addx=FALSE, newscale, addz=FALSE, level, digits, transf, targs, vcov=FALSE, \dots) } \arguments{ \item{object}{an object of class \code{"rma"} or \code{"rma.ls"}.} \item{newmods}{optional vector or matrix to specify the values of the moderator values for which the predicted values should be calculated. See \sQuote{Details}.} \item{intercept}{logical to specify whether the intercept should be included when calculating the predicted values for \code{newmods}. If unspecified, the intercept is automatically added when the original model also included an intercept.} \item{tau2.levels}{vector to specify the levels of the inner factor when computing prediction intervals. Only relevant for models of class \code{"rma.mv"} (see \code{\link{rma.mv}}) and when the model includes more than a single \mjseqn{\tau^2} value. See \sQuote{Details}.} \item{gamma2.levels}{vector to specify the levels of the inner factor when computing prediction intervals. Only relevant for models of class \code{"rma.mv"} (see \code{\link{rma.mv}}) and when the model includes more than a single \mjseqn{\gamma^2} value. See \sQuote{Details}.} \item{addx}{logical to specify whether the values of the moderator variables should be added to the returned object. See \sQuote{Examples}.} \item{newscale}{optional vector or matrix to specify the values of the scale variables for which the predicted values should be calculated. Only relevant for location-scale models (see \code{\link{rma.uni}}). See \sQuote{Details}.} \item{addz}{logical to specify whether the values of the scale variables should be added to the returned object.} \item{level}{numeric value between 0 and 100 to specify the confidence and prediction interval level (see \link[=misc-options]{here} for details). If unspecified, the default is to take the value from the object.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} \item{transf}{optional argument to specify a function to transform the predicted values and interval bounds (e.g., \code{transf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{targs}{optional arguments needed by the function specified under \code{transf}.} \item{vcov}{logical to specify whether the variance-covariance matrix of the predicted values should also be returned (the default is \code{FALSE}).} \item{\dots}{other arguments.} } \details{ For an equal-effects model, \code{predict(object)} returns the estimated (average) outcome in the set of studies included in the meta-analysis. This is the same as the estimated intercept in the equal-effects model (i.e., \mjseqn{\hat{\theta}}). For a random-effects model, \code{predict(object)} returns the estimated (average) outcome in the hypothetical population of studies from which the set of studies included in the meta-analysis are assumed to be a random selection. This is the same as the estimated intercept in the random-effects model (i.e., \mjseqn{\hat{\mu}}). For models including one or more moderators, \code{predict(object)} returns the estimated (average) outcomes for values of the moderator(s) equal to those of the \mjseqn{k} studies included in the meta-analysis (i.e., the \sQuote{fitted values} for the \mjseqn{k} studies). For models including \mjseqn{p'} moderator variables, new moderator values (for \mjeqn{k_{new}}{k_new} hypothetical new studies) can be specified by setting \code{newmods} equal to a \mjeqn{k_{new} \times p'}{k_new x p'} matrix with the corresponding new moderator values. If the model object included an intercept, then it should not be explicitly specified under \code{newmods}, as it will be added by default (unless one sets \code{intercept=FALSE}). Also, any factors in the original model get turned into the appropriate contrast variables within the \code{rma} function, so that \code{newmods} should actually include the values for the contrast variables. Examples are shown below. For random/mixed-effects models, a prediction interval is also computed (Riley et al., 2011). The interval estimates where \code{level} \% of the true effect sizes or outcomes fall in the hypothetical population of studies (and hence where the true effect or outcome of a new study from the population of studies should fall in \code{level} \% of the cases). For random-effects models that were fitted with the \code{\link{rma.mv}} function, the model may actually include multiple \mjseqn{\tau^2} values (i.e., when the \code{random} argument includes an \sQuote{\code{~ inner | outer}} term and \code{struct="HCS"}, \code{struct="DIAG"}, \code{struct="HAR"}, or \code{struct="UN"}). In that case, the function will provide prediction intervals for each level of the inner factor (since the prediction intervals differ depending on the \mjseqn{\tau^2} value). Alternatively, one can use the \code{tau2.levels} argument to specify for which level(s) the prediction interval should be provided. If the model includes a second \sQuote{\code{~ inner | outer}} term with multiple \mjseqn{\gamma^2} values, prediction intervals for each combination of levels of the inner factors will be provided. Alternatively, one can use the \code{tau2.levels} and \code{gamma2.levels} arguments to specify for which level combination(s) the prediction interval should be provided. When using the \code{newmods} argument for mixed-effects models that were fitted with the \code{\link{rma.mv}} function, if the model includes multiple \mjseqn{\tau^2} (and multiple \mjseqn{\gamma^2}) values, then one must use the \code{tau2.levels} (and \code{gamma2.levels}) argument to specify the levels of the inner factor(s) (i.e., a vector of length \mjeqn{k_{new}}{k_new}) to obtain the appropriate prediction interval(s). For location-scale models fitted with the \code{\link{rma.uni}} function, one can use \code{newmods} to specify the values of the \mjseqn{p'} moderator variables included in the model and \code{newscale} to specify the values of the \mjseqn{q'} scale variables included in the model. Whenever \code{newmods} is specified, the function computes predicted effects/outcomes for the specified moderators values. To obtain the corresponding prediction intervals, one must also specify the corresponding \code{newscale} values. If only \code{newscale} is specified (and not \code{newmods}), the function computes the predicted log-transformed \mjseqn{\tau^2} values (when using a log link) for the specified scale values. By setting \code{transf=exp}, one can then obtain the predicted \mjseqn{\tau^2} values. } \value{ An object of class \code{c("predict.rma","list.rma")}. The object is a list containing the following components: \item{pred}{predicted value(s).} \item{se}{corresponding standard error(s).} \item{ci.lb}{lower bound of the confidence interval(s).} \item{ci.ub}{upper bound of the confidence interval(s).} \item{pi.lb}{lower bound of the prediction interval(s) (only for random/mixed-effects models).} \item{pi.ub}{upper bound of the prediction interval(s) (only for random/mixed-effects models).} \item{tau2.level}{the level(s) of the inner factor (only for models of class \code{"rma.mv"} with multiple \mjseqn{\tau^2} values).} \item{gamma2.level}{the level(s) of the inner factor (only for models of class \code{"rma.mv"} with multiple \mjseqn{\gamma^2} values).} \item{X}{the moderator value(s) used to calculate the predicted values (only when \code{addx=TRUE}).} \item{Z}{the scale value(s) used to calculate the predicted values (only when \code{addz=TRUE} and only for location-scale models).} \item{\dots}{some additional elements/values.} If \code{vcov=TRUE}, then the returned object is a list with the first element equal to the one as described above and the second element equal to the variance-covariance matrix of the predicted values. The object is formatted and printed with the \code{\link[=print.list.rma]{print}} function. To format the results as a data frame, one can use the \code{\link[=as.data.frame.list.rma]{as.data.frame}} function. } \note{ Confidence and prediction intervals are constructed based on the critical values from a standard normal distribution (i.e., \mjeqn{\pm 1.96}{±1.96} for \code{level=95}). When the model was fitted with \code{test="t"} or \code{test="knha"}, then a t-distribution with \mjseqn{k-p} degrees of freedom is used. For a random-effects model (where \mjseqn{p=1}) fitted with the \code{\link{rma.uni}} function, note that this differs slightly from Riley et al. (2011), who suggest to use a t-distribution with \mjseqn{k-2} degrees of freedom for constructing the prediction interval. Neither a normal, nor a t-distribution with \mjseqn{k-1} or \mjseqn{k-2} degrees of freedom is correct; all of these are approximations. The computations are done in the way described above, so that the prediction interval is identical to the confidence interval when \mjeqn{\hat{\tau}^2 = 0}{hat(\tau)^2 = 0}, which could be argued is the logical thing that should happen. If the prediction interval should be computed exactly as described by Riley et al. (2011), then one can use argument \code{pi.type="Riley"}. The predicted values are based only on the fixed effects of the model. Best linear unbiased predictions (BLUPs) that combine the fitted values based on the fixed effects and the estimated contributions of the random effects can be obtained with \code{\link[=blup.rma.uni]{blup}} (currently only for objects of class \code{"rma.uni"}). When using the \code{transf} option, the transformation is applied to the predicted values and the corresponding interval bounds. The standard errors are omitted from the printed output. Also, \code{vcov=TRUE} is ignored when using the \code{transf} option. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Hedges, L. V., & Olkin, I. (1985). \emph{Statistical methods for meta-analysis}. San Diego, CA: Academic Press. Riley, R. D., Higgins, J. P. T., & Deeks, J. J. (2011). Interpretation of random effects meta-analyses. \emph{British Medical Journal}, \bold{342}, d549. \verb{https://doi.org/10.1136/bmj.d549} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W., & \enc{López-López}{Lopez-Lopez}, J. A. (2022). Location-scale models for meta-analysis. \emph{Research Synthesis Methods}. \bold{13}(6), 697--715. \verb{https://doi.org/10.1002/jrsm.1562} } \seealso{ \code{\link[=fitted.rma]{fitted}} for a function to extract the fitted values, \code{\link[=blup.rma.uni]{blup}} for a function to compute BLUPs that combine the fitted values and predicted random effects, and \code{\link[=addpoly.predict.rma]{addpoly}} to add polygons based on predicted values to a forest plot. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit random-effects model res <- rma(yi, vi, data=dat) ### average risk ratio with 95\% CI predict(res, transf=exp) ### fit mixed-effects model with absolute latitude as a moderator res <- rma(yi, vi, mods = ~ ablat, data=dat) ### predicted average risk ratios for given absolute latitude values predict(res, transf=exp, addx=TRUE) ### predicted average risk ratios for 10-60 degrees absolute latitude predict(res, newmods=c(10, 20, 30, 40, 50, 60), transf=exp, addx=TRUE) ### fit mixed-effects model with absolute latitude and publication year as moderators res <- rma(yi, vi, mods = ~ ablat + year, data=dat) ### predicted average risk ratios for 10 and 60 degrees latitude in 1950 and 1980 predict(res, newmods=cbind(c(10,60,10,60),c(1950,1950,1980,1980)), transf=exp, addx=TRUE) ### fit mixed-effects model with two moderators (one of which is a factor) res <- rma(yi, vi, mods = ~ ablat + factor(alloc), data=dat) ### examine how the factor was actually coded for the studies in the dataset predict(res, addx=TRUE) ### predictd average risk ratios at 30 degrees for the three factor levels ### note: the contrast (dummy) variables need to specified explicitly here predict(res, newmods=c(30, 0, 0), addx=TRUE) # for alternate allocation predict(res, newmods=c(30, 1, 0), addx=TRUE) # for random allocation predict(res, newmods=c(30, 0, 1), addx=TRUE) # for systematic allocation ### can also use named vector with arbitrary order and abbreviated variable names predict(res, newmods=c(sys=0, ran=0, abl=30)) predict(res, newmods=c(sys=0, ran=1, abl=30)) predict(res, newmods=c(sys=1, ran=0, abl=30)) } \keyword{models} metafor/man/influence.rma.uni.Rd0000644000176200001440000002075114505063152016277 0ustar liggesusers\name{influence.rma.uni} \alias{influence} \alias{cooks.distance} \alias{dfbetas} \alias{hatvalues} \alias{influence.rma.uni} \alias{print.infl.rma.uni} \alias{cooks.distance.rma.uni} \alias{dfbetas.rma.uni} \alias{hatvalues.rma.uni} \title{Model Diagnostics for 'rma.uni' Objects} \description{ Functions to compute various outlier and influential study diagnostics (some of which indicate the influence of deleting one study at a time on the model fit or the fitted/residual values) for objects of class \code{"rma.uni"}. For the corresponding documentation for \code{"rma.mv"} objects, see \code{\link[=influence.rma.mv]{influence}}. \loadmathjax } \usage{ \method{influence}{rma.uni}(model, digits, progbar=FALSE, \dots) \method{print}{infl.rma.uni}(x, digits=x$digits, infonly=FALSE, \dots) \method{cooks.distance}{rma.uni}(model, progbar=FALSE, \dots) \method{dfbetas}{rma.uni}(model, progbar=FALSE, \dots) \method{hatvalues}{rma.uni}(model, type="diagonal", \dots) } \arguments{ \item{model}{an object of class \code{"rma.uni"}.} \item{x}{an object of class \code{"infl.rma.uni"} (for \code{print}).} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} \item{progbar}{logical to specify whether a progress bar should be shown (the default is \code{FALSE}).} \item{infonly}{logical to specify whether only the influential cases should be printed (the default is \code{FALSE}).} \item{type}{character string to specify whether only the diagonal of the hat matrix (\code{"diagonal"}) or the entire hat matrix (\code{"matrix"}) should be returned.} \item{\dots}{other arguments.} } \details{ The term \sQuote{case} below refers to a particular row from the dataset used in the model fitting (which is typically synonymous with \sQuote{study}). The \code{influence} function calculates the following leave-one-out diagnostics for each case: \itemize{ \item externally standardized residual, \item DFFITS value, \item Cook's distance, \item covariance ratio, \item the leave-one-out amount of (residual) heterogeneity, \item the leave-one-out test statistic of the test for (residual) heterogeneity, \item DFBETAS value(s). } The diagonal elements of the hat matrix and the weights (in \%) given to the observed effect sizes or outcomes during the model fitting are also provided (except for their scaling, the hat values and weights are the same for models without moderators, but will differ when moderators are included). For details on externally standardized residuals, see \code{\link[=rstudent.rma.uni]{rstudent}}. The DFFITS value essentially indicates how many standard deviations the predicted (average) effect or outcome for the \mjeqn{i\textrm{th}}{ith} case changes after excluding the \mjeqn{i\textrm{th}}{ith} case from the model fitting. Cook's distance can be interpreted as the Mahalanobis distance between the entire set of predicted values once with the \mjeqn{i\textrm{th}}{ith} case included and once with the \mjeqn{i\textrm{th}}{ith} case excluded from the model fitting. The covariance ratio is defined as the determinant of the variance-covariance matrix of the parameter estimates based on the dataset with the \mjeqn{i\textrm{th}}{ith} case removed divided by the determinant of the variance-covariance matrix of the parameter estimates based on the complete dataset. A value below 1 therefore indicates that removal of the \mjeqn{i\textrm{th}}{ith} case yields more precise estimates of the model coefficients. The leave-one-out amount of (residual) heterogeneity is the estimated value of \mjseqn{\tau^2} based on the dataset with the \mjeqn{i\textrm{th}}{ith} case removed. This is always equal to 0 for equal-effects models. Similarly, the leave-one-out test statistic of the test for (residual) heterogeneity is the value of the test statistic of the test for (residual) heterogeneity calculated based on the dataset with the \mjeqn{i\textrm{th}}{ith} case removed. Finally, the DFBETAS value(s) essentially indicate(s) how many standard deviations the estimated coefficient(s) change(s) after excluding the \mjeqn{i\textrm{th}}{ith} case from the model fitting. A case may be considered to be \sQuote{influential} if at least one of the following is true: \itemize{ \item The absolute DFFITS value is larger than \mjeqn{3 \times \sqrt{p/(k-p)}}{3*\sqrt(p/(k-p))}, where \mjseqn{p} is the number of model coefficients and \mjseqn{k} the number of cases. \item The lower tail area of a chi-square distribution with \mjseqn{p} degrees of freedom cut off by the Cook's distance is larger than 50\%. \item The hat value is larger than \mjeqn{3 \times (p/k)}{3*(p/k)}. \item Any DFBETAS value is larger than \mjseqn{1}. } Cases which are considered influential with respect to any of these measures are marked with an asterisk. Note that the chosen cut-offs are (somewhat) arbitrary. Substantively informed judgment should always be used when examining the influence of each case on the results. } \value{ An object of class \code{"infl.rma.uni"}, which is a list containing the following components: \item{inf}{an element of class \code{"list.rma"} with the externally standardized residuals, DFFITS values, Cook's distances, covariance ratios, leave-one-out \mjseqn{\tau^2} estimates, leave-one-out (residual) heterogeneity test statistics, hat values, weights, and an indicator whether a case is influential.} \item{dfbs}{an element of class \code{"list.rma"} with the DFBETAS values.} \item{\dots}{some additional elements/values.} The results are printed with \code{print} and plotted with \code{\link[=plot.infl.rma.uni]{plot}}. To format the results as a data frame, one can use the \code{\link[=as.data.frame.list.rma]{as.data.frame}} function. } \note{ Leave-one-out diagnostics are calculated by refitting the model \mjseqn{k} times. Depending on how large \mjseqn{k} is, it may take a few moments to finish the calculations. There are shortcuts for calculating at least some of these values without refitting the model each time, but these are currently not implemented (and may not exist for all of the leave-one-out diagnostics calculated by the function). It may not be possible to fit the model after deletion of the \mjeqn{i\textrm{th}}{ith} case from the dataset. This will result in \code{NA} values for that case. Certain relationships between the leave-one-out diagnostics and the (internally or externally) standardized residuals (Belsley, Kuh, & Welsch, 1980; Cook & Weisberg, 1982) no longer hold for meta-analytic models. Maybe there are other relationships. These remain to be determined. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Belsley, D. A., Kuh, E., & Welsch, R. E. (1980). \emph{Regression diagnostics}. New York: Wiley. Cook, R. D., & Weisberg, S. (1982). \emph{Residuals and influence in regression}. London: Chapman and Hall. Hedges, L. V., & Olkin, I. (1985). \emph{Statistical methods for meta-analysis}. San Diego, CA: Academic Press. Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W. (2021). Model checking in meta-analysis. In C. H. Schmid, T. Stijnen, & I. R. White (Eds.), \emph{Handbook of meta-analysis} (pp. 219--254). Boca Raton, FL: CRC Press. \verb{https://doi.org/10.1201/9781315119403} Viechtbauer, W., & Cheung, M. W.-L. (2010). Outlier and influence diagnostics for meta-analysis. \emph{Research Synthesis Methods}, \bold{1}(2), 112--125. \verb{https://doi.org/10.1002/jrsm.11} } \seealso{ \code{\link[=plot.infl.rma.uni]{plot}} for a method to plot the outlier and influential case diagnostics. \code{\link[=rstudent.rma.uni]{rstudent}} for externally standardized residuals and \code{\link[=weights.rma.uni]{weights}} for model fitting weights. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit mixed-effects model with absolute latitude and publication year as moderators res <- rma(yi, vi, mods = ~ ablat + year, data=dat) ### compute the diagnostics inf <- influence(res) inf ### plot the values plot(inf) ### compute Cook's distances, DFBETAS values, and hat values cooks.distance(res) dfbetas(res) hatvalues(res) } \keyword{models} metafor/man/bldiag.Rd0000644000176200001440000000250114505063152014172 0ustar liggesusers\name{bldiag} \alias{bldiag} \title{Construct Block Diagonal Matrix} \description{ Function to construct a block diagonal matrix from (a list of) matrices. } \usage{ bldiag(\dots, order) } \arguments{ \item{\dots}{individual matrices or a list of matrices.} \item{order}{optional argument to specify a variable based on which a square block diagonal matrix should be ordered.} } \author{ Posted to R-help by Berton Gunter (2 Sep 2005) with some further adjustments by Wolfgang Viechtbauer } \seealso{ \code{\link{rma.mv}} for the model fitting function that can take such a block diagonal matrix as input (for the \code{V} argument). \code{\link{blsplit}} for a function that can split a block diagonal matrix into a list of sub-matrices. } \examples{ ### copy data into 'dat' dat <- dat.berkey1998 dat ### construct list with the variance-covariance matrices of the observed outcomes for the studies V <- lapply(split(dat[c("v1i","v2i")], dat$trial), as.matrix) V ### construct block diagonal matrix V <- bldiag(V) V ### if we split based on 'author', the list elements in V are in a different order than tha data V <- lapply(split(dat[c("v1i","v2i")], dat$author), as.matrix) V ### can use 'order' argument to reorder the block-diagonal matrix into the correct order V <- bldiag(V, order=dat$author) V } \keyword{manip} metafor/man/plot.infl.rma.uni.Rd0000644000176200001440000001335614505063152016237 0ustar liggesusers\name{plot.infl.rma.uni} \alias{plot.infl.rma.uni} \title{Plot Method for 'infl.rma.uni' Objects} \description{ Function to plot objects of class \code{"infl.rma.uni"}. \loadmathjax } \usage{ \method{plot}{infl.rma.uni}(x, plotinf=TRUE, plotdfbs=FALSE, dfbsnew=FALSE, logcov=TRUE, layout, slab.style=1, las=0, pch=21, bg, bg.infl, col.na, \dots) } \arguments{ \item{x}{an object of class \code{"infl.rma.uni"} obtained with \code{\link[=influence.rma.uni]{influence}}.} \item{plotinf}{logical to specify whether the various case diagnostics should be plotted (the default is \code{TRUE}). Can also be a vector of up to 8 integers to specify which plots to draw. See \sQuote{Details} for the numbers corresponding to the various plots.} \item{plotdfbs}{logical to specify whether the DFBETAS values should be plotted (the default is \code{FALSE}). Can also be a vector of integers to specify for which coefficient(s) to plot the DFBETAS values.} \item{dfbsnew}{logical to specify whether a new device should be opened for plotting the DFBETAS values (the default is \code{FALSE}).} \item{logcov}{logical to specify whether the covariance ratios should be plotted on a log scale (the default is \code{TRUE}).} \item{layout}{optional vector of two numbers to specify the number of rows and columns for the layout of the figure.} \item{slab.style}{integer to indicate the style of the x-axis labels: 1 = study number, 2 = study label, 3 = abbreviated study label. Note that study labels, even when abbreviated, may be too long to fit in the margins.)} \item{las}{integer between 0 and 3 to specify the alignment of the axis labels (see \code{\link{par}}). The most useful alternative to 0 is 3, so that the x-axis labels are drawn vertical to the axis.} \item{pch}{plotting symbol to use. By default, an open circle is used. See \code{\link{points}} for other options.} \item{bg}{optional character string to specify the background color of open plotting symbols. If unspecified, gray is used by default.} \item{bg.infl}{optional character string to specify the background color when the point is considered influential. If unspecified, red is used by default.} \item{col.na}{optional character string to specify the color for lines connecting two points with \code{NA} values in between. If unspecified, a light shade of gray is used by default.} \item{\dots}{other arguments.} } \details{ When \code{plotinf=TRUE}, the function plots the (1) externally standardized residuals, (2) DFFITS values, (3) Cook's distances, (4) covariance ratios, (5) leave-one-out \mjseqn{\tau^2} estimates, (6) leave-one-out (residual) heterogeneity test statistics, (7) hat values, and (8) weights. If \code{plotdfbs=TRUE}, the DFBETAS values are also plotted either after confirming the page change (if \code{dfbsnew=FALSE}) or on a separate device (if \code{dfbsnew=TRUE}). A case (which is typically synonymous with study) may be considered to be \sQuote{influential} if at least one of the following is true: \itemize{ \item The absolute DFFITS value is larger than \mjeqn{3 \times \sqrt{p/(k-p)}}{3*\sqrt(p/(k-p))}, where \mjseqn{p} is the number of model coefficients and \mjseqn{k} the number of cases. \item The lower tail area of a chi-square distribution with \mjseqn{p} degrees of freedom cut off by the Cook's distance is larger than 50\%. \item The hat value is larger than \mjeqn{3 \times (p/k)}{3*(p/k)}. \item Any DFBETAS value is larger than \mjseqn{1}. } Cases which are considered influential with respect to any of these measures are indicated by the color specified for the \code{bg.infl} argument (the default is \code{"red"}). The cut-offs described above are indicated in the plot with horizontal reference lines. In addition, on the plot of the externally standardized residuals, horizontal reference lines are drawn at -1.96, 0, and 1.96. On the plot of the hat values, a horizontal reference line is drawn at \mjseqn{p/k}. Since the sum of the hat values is equal to \mjseqn{p}, the value \mjseqn{p/k} indicates equal hat values for all \mjseqn{k} cases. Finally, on the plot of weights, a horizontal reference line is drawn at \mjseqn{100/k}, corresponding to the value for equal weights (in \%) for all \mjseqn{k} cases. Note that all weights will automatically be equal to each other when using unweighted model fitting. Also, the hat values will be equal to the weights values (except for their scaling) in models without moderators. The chosen cut-offs are (somewhat) arbitrary. Substantively informed judgment should always be used when examining the influence of each case on the results. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W., & Cheung, M. W.-L. (2010). Outlier and influence diagnostics for meta-analysis. \emph{Research Synthesis Methods}, \bold{1}(2), 112--125. \verb{https://doi.org/10.1002/jrsm.11} } \seealso{ \code{\link[=influence.rma.uni]{influence}} for the function to compute the various model diagnostics. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit mixed-effects model with absolute latitude and publication year as moderators res <- rma(yi, vi, mods = ~ ablat + year, data=dat) ### compute the diagnostics inf <- influence(res) ### plot the values plot(inf) ### select which plots to show plot(inf, plotinf=1:4) plot(inf, plotinf=1:4, layout=c(4,1)) ### plot the DFBETAS values plot(inf, plotinf=FALSE, plotdfbs=TRUE) } \keyword{hplot} metafor/man/fsn.Rd0000644000176200001440000002657414505063152013556 0ustar liggesusers\name{fsn} \alias{fsn} \title{Fail-Safe N Analysis (File Drawer Analysis)} \description{ Function to compute the fail-safe N (also called a file drawer analysis). \loadmathjax } \usage{ fsn(x, vi, sei, subset, data, type, alpha=.05, target, method, exact=FALSE, verbose=FALSE, digits, \dots) } \arguments{ \item{x}{a vector with the observed effect sizes or outcomes or an object of class \code{"rma"}.} \item{vi}{vector with the corresponding sampling variances (ignored if \code{x} is an object of class \code{"rma"}).} \item{sei}{vector with the corresponding standard errors (note: only one of the two, \code{vi} or \code{sei}, needs to be specified).} \item{subset}{optional (logical or numeric) vector to specify the subset of studies that should be used for the calculation (ignored if \code{x} is an object of class \code{"rma"}).} \item{data}{optional data frame containing the variables given to the arguments above.} \item{type}{optional character string to specify the type of method to use for the calculation of the fail-safe N. Possible options are \code{"Rosenthal"} (the default when \code{x} is a vector with the observed effect sizes or outcomes), \code{"Orwin"}, \code{"Rosenberg"}, or \code{"General"} (the default when \code{x} is an object of class \code{"rma"}). Can be abbreviated. See \sQuote{Details}.} \item{alpha}{target alpha level for the Rosenthal, Rosenberg, and General methods (the default is .05).} \item{target}{target average effect size or outcome for the Orwin and General methods.} \item{method}{optional character string to specify the model fitting method for \code{type="General"} (if unspecified, either \code{"REML"} by default or the method that was used in fitting the \code{"rma"} model). See \code{\link{rma.uni}} for options.} \item{exact}{logical to indicate whether the general method should be based on exact (but slower) or approximate (but faster) calculations.} \item{verbose}{logical to specify whether output should be generated on the progress of the calculations for \code{type="General"} (the default is \code{FALSE}).} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded.} \item{\dots}{other arguments.} } \details{ The function can be used to calculate the \sQuote{fail-safe N}, that is, the minimum number of studies averaging null results that would have to be added to a given set of \mjseqn{k} studies to change the conclusion of a meta-analysis. If this number is small (in relation to the actual number of studies), then this indicates that the results based on the observed studies are not robust to publication bias (of the form assumed by the method, that is, where a set of studies averaging null results is missing). The method is also called a \sQuote{file drawer analysis} as it assumes that there is a set of studies averaging null results hiding in file drawers, which can overturn the findings from a meta-analysis. There are various types of methods that are all based on the same principle, which are described in more detail further below. Note that \emph{the fail-safe N is not an estimate of the number of missing studies}, only how many studies must be hiding in file drawers for the findings to be overturned. One can either pass a vector with the observed effect sizes or outcomes (via \code{x}) and the corresponding sampling variances via \code{vi} (or the standard errors via \code{sei}) to the function or an object of class \code{"rma"}. When passing a model object, the model must be a model without moderators (i.e., either an equal- or a random-effects model). \subsection{Rosenthal Method}{ The Rosenthal method (\code{type="Rosenthal"}) calculates the minimum number of studies averaging null results that would have to be added to a given set of studies to reduce the (one-tailed) combined significance level (i.e., p-value) to a particular alpha level, which can be specified via the \code{alpha} argument (.05 by default). The calculation is based on Stouffer's method for combining p-values and is described in Rosenthal (1979). Note that the method is primarily of interest for historical reasons, but the other methods described below are more closely aligned with the way meta-analyses are typically conducted in practice. } \subsection{Orwin Method}{ The Orwin method (\code{type="Orwin"}) calculates the minimum number of studies averaging null results that would have to be added to a given set of studies to reduce the (unweighted or weighted) average effect size / outcome to a target value (as specified via the \code{target} argument). The method is described in Orwin (1983). When \code{vi} (or \code{sei}) is not specified, the method is based on the unweighted average of the effect sizes / outcomes; otherwise, the method uses the inverse-variance weighted average. If the \code{target} argument is not specified, then the target value will be equal to the observed average effect size / outcome divided by 2 (which is entirely arbitrary and will always lead to a fail-safe N number that is equal to \mjseqn{k}). One should really set \code{target} to a value that reflects an effect size / outcome that would be considered to be practically irrelevant. Note that if \code{target} has the opposite sign as the actually observed average, then its sign is automatically flipped. } \subsection{Rosenberg Method}{ The Rosenberg method (\code{type="Rosenberg"}) calculates the minimum number of studies averaging null results that would have to be added to a given set of studies to reduce the significance level (i.e., p-value) of the average effect size / outcome (as estimated based on an equal-effects model) to a particular alpha level, which can be specified via the \code{alpha} argument (.05 by default). The method is described in Rosenberg (2005). Note that the p-value is calculated based on a standard normal distribution (instead of a t-distribution, as suggested by Rosenberg, 2005), but the difference is typically negligible. } \subsection{General Method}{ This method is a generalization of the methods by Orwin and Rosenberg. By default (i.e., when \code{target} is not specified), it calculates the minimum number of studies averaging null results that would have to be added to a given set of studies to reduce the significance level (i.e., p-value) of the average effect size / outcome (as estimated based on a chosen model) to a particular alpha level, which can be specified via the \code{alpha} argument (.05 by default). The type of model that is used in the calculation is chosen via the \code{method} argument. If this is unspecified, then a random-effects model is automatically used (using \code{method="REML"}) or the method that was used in fitting the \code{"rma"} model (see \code{\link{rma.uni}} for options). Therefore, when setting \code{method="EE"}, then an equal-effects model is used, which yields (essentially) identical results as Rosenberg's method. If \code{target} is specified, then the method calculates the minimum number of studies averaging null results that would have to be added to a given set of studies to reduce the average effect size / outcome (as estimated based on a chosen model) to a target value (as specified via the \code{target} argument). As described above, the type of model that is used in the calculation is chosen via the \code{method} argument. When setting \code{method="EE"}, then an equal-effects model is used, which yields (essentially) identical results as Orwin's method with inverse-variance weights. The method uses an iterative algorithm for calculating the fail-safe N, which can be computationally expensive especially when N is large. By default, the method uses approximate (but faster) calculations, but when setting \code{exact=TRUE}, the method uses exact (but slower) calculations. The difference between the two is typically negligible. If N is larger than \mjseqn{10^7}, then the calculated number is given as \code{>1e+07}. } } \value{ An object of class \code{"fsn"}. The object is a list containing the following components (some of which may be \code{NA} if they are not applicable to the chosen method): \item{type}{the type of method used.} \item{fsnum}{the calculated fail-safe N.} \item{est}{the average effect size / outcome based on the observed studies.} \item{tau2}{the estimated amount of heterogeneity based on the observed studies.} \item{pval}{the p-value of the observed results.} \item{alpha}{the specified target alpha level.} \item{target}{the target average effect size / outcome.} \item{est.fsn}{the average effect size / outcome when combining the observed studies with those in the file drawer.} \item{tau2}{the estimated amount of heterogeneity when combining the observed studies with those in the file drawer.} \item{pval}{the p-value when combining the observed studies with those in the file drawer.} \item{\dots}{some additional elements/values.} The results are formatted and printed with the \code{\link[=print.fsn]{print}} function. } \note{ If the significance level of the observed studies is already above the specified alpha level or if the average effect size / outcome of the observed studies is already below the target average effect size / outcome, then the fail-safe N value is zero. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Rosenthal, R. (1979). The "file drawer problem" and tolerance for null results. \emph{Psychological Bulletin}, \bold{86}(3), 638--641. \verb{https://doi.org/10.1037/0033-2909.86.3.638} Orwin, R. G. (1983). A fail-safe N for effect size in meta-analysis. \emph{Journal of Educational Statistics}, \bold{8}(2), 157--159. \verb{https://doi.org/10.3102/10769986008002157} Rosenberg, M. S. (2005). The file-drawer problem revisited: A general weighted method for calculating fail-safe numbers in meta-analysis. \emph{Evolution}, \bold{59}(2), 464--468. \verb{https://doi.org/10.1111/j.0014-3820.2005.tb01004.x} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{regtest}} for the regression test, \code{\link{ranktest}} for the rank correlation test, \code{\link{trimfill}} for the trim and fill method, \code{\link{tes}} for the test of excess significance, and \code{\link{selmodel}} for selection models. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit equal-effects model rma(yi, vi, data=dat, method="EE") ### fail-safe N computations fsn(yi, vi, data=dat) fsn(yi, data=dat, type="Orwin", target=log(0.95)) # target corresponds to a 5% risk reduction fsn(yi, vi, data=dat, type="Orwin", target=log(0.95)) # Orwin's method with 1/vi weights fsn(yi, vi, data=dat, type="General", target=log(0.95), method="EE") # like Orwin's method fsn(yi, vi, data=dat, type="Rosenberg") fsn(yi, vi, data=dat, type="General", method="EE") # like Rosenberg's method fsn(yi, vi, data=dat, type="General") # based on a random-effects model fsn(yi, vi, data=dat, type="General", target=log(0.95)) # based on a random-effects model ### fit a random-effects model and use fsn() on the model object res <- rma(yi, vi, data=dat) fsn(res) fsn(res, target=log(0.95)) } \keyword{htest} metafor/man/emmprep.Rd0000644000176200001440000001776014505063152014432 0ustar liggesusers\name{emmprep} \alias{emmprep} \title{Create a Reference Grid for the 'emmeans' Function} \description{ Function to create a reference grid for use with the \code{\link[emmeans]{emmeans}} function from the package of the same name. \loadmathjax } \usage{ emmprep(x, verbose=FALSE, \dots) } \arguments{ \item{x}{an object of class \code{"rma"}.} \item{verbose}{logical to specify whether information on some (extracted) settings should be printed when creating the reference grid (the default is \code{FALSE}).} \item{\dots}{other arguments that will be passed on to the \code{\link[emmeans]{qdrg}} function.} } \details{ The \href{https://cran.r-project.org/package=emmeans}{emmeans} package is a popular package that facilitates the computation of 'estimated marginal means'. The function is a wrapper around the \code{\link[emmeans]{qdrg}} function from the \code{emmeans} package to make \code{"rma"} objects compatible with the latter. Unless one needs to pass additional arguments to the \code{\link[emmeans]{qdrg}} function, one simply applies this function to the \code{"rma"} object and then the \code{\link[emmeans]{emmeans}} function (or one of the other functions that can be applied to \code{"emmGrid"} objects) to the resulting object to obtain the desired estimated marginal means. } \value{ An \code{"emmGrid"} object as created by the \code{\link[emmeans]{qdrg}} function from the \code{emmeans} package. The resulting object will typically be used in combination with the \code{\link[emmeans]{emmeans}} function. } \note{ When creating the reference grid, the function extracts the degrees of freedom for tests/confidence intervals from the model object (if the model was fitted with \code{test="t"} or \code{test="knha"}; otherwise the degrees of freedom are infinity). In some cases, there is not just a single value for the degrees of freedom, but an entire vector (e.g., for models fitted with \code{\link{rma.mv}}). In this case, the smallest value will be used (as a conservative option). One can set a different/custom value for the degrees of freedom with \code{emmprep(..., df=value)}. When the model object contains information about the outcome measure used in the analysis (which should be the case if the observed outcomes were computed with \code{\link{escalc}} or if the \code{measure} argument was set when fitting the model), then information about the appropriate back-transformation (if available) is stored as part of the returned object. If so, the back-transformation is automatically applied when calling \code{\link[emmeans]{emmeans}} with \code{type="response"}. The function also tries to extract the estimated value of \mjseqn{\tau^2} (or more precisely, its square root) from the model object (when the model is a random/mixed-effects model). This value is only needed when computing prediction intervals (i.e., when \code{interval="predict"} in \code{\link[emmeans]{predict.emmGrid}}) or when applying the bias adjustment in the back-transformation (i.e., when \code{bias.adjust=TRUE} in \code{\link[emmeans]{summary.emmGrid}}). For some models (e.g., those fitted with \code{\link{rma.mv}}), it is not possible to automatically extract the estimate. In this case, one can manually set the value with \code{emmprep(..., sigma=value)} (note: the argument is called \code{sigma}, following the conventions of \code{\link[emmeans]{summary.emmGrid}} and one must supply the square root of the \mjseqn{\tau^2} estimate). By default, the reference grid is created based on the data used for fitting the original model (which is typically the sensible thing to do). One can specify a different dataset with \code{emmprep(..., data=obj)}, where \code{obj} must be a data frame that contains the same variables as used in the original model fitted. If the original model fitted involved redundant predictors that were dropped from the model (due to \sQuote{rank deficiencies}), then the function cannot be used. In this case, one should remove any redundancies in the original model fitted before using this function. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit meta-regression model with absolute latitude as predictor res <- rma(yi, vi, mods = ~ ablat, data=dat) res ### create reference grid sav <- emmprep(res, verbose=TRUE) ### estimated marginal mean (back-transformed to the risk ratio scale) if (require(emmeans)) emmeans(sav, specs="1", type="response") ### same as the predicted effect at the mean absolute latitude predict(res, newmods = mean(model.matrix(res, asdf=TRUE)$ablat), transf=exp, digits=3) ### fit meta-regression model with allocation factor res <- rma(yi, vi, mods = ~ alloc, data=dat) res ### create reference grid sav <- emmprep(res) ### estimated marginal mean using proportional cell weighting if (require(emmeans)) emmeans(sav, specs="1", type="response", weights="proportional") ### estimated marginal mean using equal cell weighting (this is actually the default) if (require(emmeans)) emmeans(sav, specs="1", type="response", weights="equal") ### same as the predicted effect using cell proportions as observed in the data ### or using equal proportions for the three groups predict(res, newmods = colMeans(model.matrix(res))[-1], transf=exp, digits=3) predict(res, newmods = c(1/3,1/3), transf=exp, digits=3) ### fit meta-regression model with absolute latitude and allocation as predictors res <- rma(yi, vi, mods = ~ ablat + alloc, data=dat) res ### create reference grid sav <- emmprep(res) ### estimated marginal mean using equal cell weighting if (require(emmeans)) emmeans(sav, specs="1", type="response") ### same as the predicted effect at the mean absolute latitude and using equal proportions ### for the allocation factor predict(res, newmods = c(mean(model.matrix(res, asdf=TRUE)$ablat),1/3,1/3), transf=exp, digits=3) ### create reference grid with ablat set equal to 10, 30, and 50 degrees sav <- emmprep(res, at=list(ablat=c(10,30,50))) ### estimated marginal means at the three ablat values if (require(emmeans)) emmeans(sav, specs="1", by="ablat", type="response") ### same as the predicted effect at the chosen absolute latitude values and using equal ### proportions for the allocation factor predict(res, newmods = cbind(c(10,30,50),1/3,1/3), transf=exp, digits=3) ############################################################################ ### copy data into 'dat' and examine data dat <- dat.mcdaniel1994 head(dat) ### calculate r-to-z transformed correlations and corresponding sampling variances dat <- escalc(measure="ZCOR", ri=ri, ni=ni, data=dat) ### mixed-effects model with interview type as factor res <- rma(yi, vi, mods = ~ factor(type), data=dat, test="knha") res ### create reference grid sav <- emmprep(res, verbose=TRUE) ### estimated marginal mean (back-transformed to the correlation scale) if (require(emmeans)) emmeans(sav, specs="1", type="response") ### same as the predicted correlation using equal cell proportions predict(res, newmods = c(1/3,1/3), transf=transf.ztor, digits=3) ### estimated marginal means for the three interview types if (require(emmeans)) emmeans(sav, specs="type", type="response") ### same as the predicted correlations predict(res, newmods = rbind(c(0,0), c(1,0), c(0,1)), transf=transf.ztor, digits=3) ### illustrate use of the 'df' and 'sigma' arguments res <- rma.mv(yi, vi, mods = ~ factor(type), random = ~ 1 | study, data=dat, test="t", dfs="contain") res ### create reference grid sav <- emmprep(res, verbose=TRUE, df=154, sigma=0.1681) ### estimated marginal mean (back-transformed to the correlation scale) if (require(emmeans)) emmeans(sav, specs="1", type="response") } \keyword{manip} metafor/man/print.anova.rma.Rd0000644000176200001440000000615714505063152016000 0ustar liggesusers\name{print.anova.rma} \alias{print.anova.rma} \alias{print.list.anova.rma} \title{Print Methods for 'anova.rma' and 'list.anova.rma' Objects} \description{ Functions to print objects of class \code{"anova.rma"} and \code{"list.anova.rma"}. \loadmathjax } \usage{ \method{print}{anova.rma}(x, digits=x$digits, \dots) \method{print}{list.anova.rma}(x, digits=x[[1]]$digits, \dots) } \arguments{ \item{x}{an object of class \code{"anova.rma"} or \code{"list.anova.rma"} obtained with \code{\link[=anova.rma]{anova}}.} \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} \item{\dots}{other arguments.} } \details{ For a Wald-type test of one or multiple model coefficients, the output includes the test statistic (either a chi-square or F-value) and the corresponding p-value. When testing one or multiple contrasts, the output includes the estimated value of the contrast, its standard error, test statistic (either a z- or a t-value), and the corresponding p-value. When comparing two model objects, the output includes: \itemize{ \item the number of parameters in the full and the reduced model. \item the AIC, BIC, AICc, and log-likelihood of the full and the reduced model. \item the value of the likelihood ratio test statistic. \item the corresponding p-value. \item the test statistic of the test for (residual) heterogeneity for the full and the reduced model. \item the estimate of \mjseqn{\tau^2} from the full and the reduced model. Suppressed for equal-effects models. \item amount (in percent) of heterogeneity in the reduced model that is accounted for in the full model (\code{NA} for \code{"rma.mv"} objects). This can be regarded as a pseudo \mjseqn{R^2} statistic (Raudenbush, 2009). Note that the value may not be very accurate unless \mjseqn{k} is large (Lopez-Lopez et al., 2014). } The last two items are not provided when comparing \code{"rma.mv"} models. } \value{ The function does not return an object. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ \enc{López-López}{Lopez-Lopez}, J. A., \enc{Marín-Martínez}{Marin-Martinez}, F., \enc{Sánchez-Meca}{Sanchez-Meca}, J., Van den Noortgate, W., & Viechtbauer, W. (2014). Estimation of the predictive power of the model in mixed-effects meta-regression: A simulation study. \emph{British Journal of Mathematical and Statistical Psychology}, \bold{67}(1), 30--48. \verb{https://doi.org/10.1111/bmsp.12002} Raudenbush, S. W. (2009). Analyzing effect sizes: Random effects models. In H. Cooper, L. V. Hedges, & J. C. Valentine (Eds.), \emph{The handbook of research synthesis and meta-analysis} (2nd ed., pp. 295--315). New York: Russell Sage Foundation. Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link[=anova.rma]{anova}} for the function to create \code{anova.rma} objects. } \keyword{print} metafor/man/reporter.Rd0000644000176200001440000001252714505063152014623 0ustar liggesusers\name{reporter} \alias{reporter} \alias{reporter.rma.uni} \title{Dynamically Generated Analysis Reports for 'rma.uni' Objects} \description{ Function to dynamically generate an analysis report for objects of class \code{"rma.uni"}. } \usage{ reporter(x, \dots) \method{reporter}{rma.uni}(x, dir, filename, format="html_document", open=TRUE, digits, forest, funnel, footnotes=FALSE, verbose=TRUE, \dots) } \arguments{ \item{x}{an object of class \code{"rma.uni"}.} \item{dir}{optional character string to specify the directory for creating the report. If unspecified, \code{\link{tempdir}} will be used.} \item{filename}{optional character string to specify the filename (without file extension) for the report. If unspecified, the function sets a filename automatically.} \item{format}{output format for the report (either \code{html_document}, \code{pdf_document}, or \code{word_document}). Can be abbreviated. See \sQuote{Note}.} \item{open}{logical to specify whether the report should be opened after it has been generated (the default is \code{TRUE}). See \sQuote{Note}.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} \item{forest}{either a logical which will suppress the drawing of the forest plot when set to \code{FALSE} or a character string with arguments to be added to the call to \code{\link[=forest.rma]{forest}} for generating the forest plot.} \item{funnel}{either a logical which will suppress the drawing of the funnel plot when set to \code{FALSE} or a character string with arguments to be added to the call to \code{\link[=funnel.rma]{funnel}} for generating the funnel plot.} \item{footnotes}{logical to specify whether additional explanatory footnotes should be added to the report (the default is \code{FALSE}).} \item{verbose}{logical to specify whether information on the progress of the report generation should be provided (the default is \code{TRUE}).} \item{\dots}{other arguments.} } \details{ The function dynamically generates an analysis report based on the model object. The report includes information about the model that was fitted, the distribution of the observed effect sizes or outcomes, the estimate of the average outcome based on the fitted model, tests and statistics that are informative about potential (residual) heterogeneity in the outcomes, checks for outliers and/or influential studies, and tests for funnel plot asymmetry. By default, a forest plot and a funnel plot are also provided (these can be suppressed by setting \code{forest=FALSE} and/or \code{funnel=FALSE}). } \value{ The function generates either a html, pdf, or docx file and returns (invisibly) the path to the generated document. } \note{ Since the report is created based on an R Markdown document that is generated by the function, the \href{https://cran.r-project.org/package=rmarkdown}{rmarkdown} package and \href{https://pandoc.org}{pandoc} must be installed. To render the report into a pdf document (i.e., using \code{format="pdf_document"}) requires a LaTeX installation. If LaTeX is not already installed, you could try using the \href{https://cran.r-project.org/package=tinytex}{tinytex} package to install a lightweight LaTeX distribution based on TeX Live. Once the report is generated, the function opens the output file (either a .html, .pdf, or .docx file) with an appropriate application (if \code{open=TRUE}). This will only work when an appropriate application for the file type is installed and associated with the extension. If \code{filename} is unspecified, the default is to use \code{report}, followed by an underscore (i.e., \code{_}) and the name of the object passed to the function. Both the R Markdown file (with extension .rmd) and the actual report (with extension .html, .pdf, or .docx) are named accordingly. To generate the report, the model object is also saved to a file (with the same filename as above, but with extension .rdata). Also, files \code{references.bib} and \code{apa.csl} are copied to the same directory (these files are needed to generate the references in APA format). Since the report is put together based on predefined text blocks, the writing is not very elegant. Also, using personal pronouns (\sQuote{I} or \sQuote{we}) does not make sense for such a report, so a lot of passive voice is used. The generated report provides an illustration of how the results of the model can be reported, but is not a substitute for a careful examination of the results. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}} for the function to fit models for which an analysis report can be generated. } \examples{ ### copy BCG vaccine data into 'dat' dat <- dat.bcg ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, slab=paste(author, ", ", year, sep="")) ### fit random-effects model res <- rma(yi, vi, data=dat) \dontrun{ ### generate report reporter(res) } } \keyword{methods} metafor/man/update.rma.Rd0000644000176200001440000000463014505063152015015 0ustar liggesusers\name{update.rma} \alias{update} \alias{update.rma} \title{Model Updating for 'rma' Objects} \description{ Function to update and (by default) refit \code{"rma"} models. It does this by extracting the call stored in the object, updating the call, and (by default) evaluating that call. } \usage{ \method{update}{rma}(object, formula., \dots, evaluate=TRUE) } \arguments{ \item{object}{an object of class \code{"rma"}.} \item{formula.}{changes to the formula. See \sQuote{Details}.} \item{\dots}{additional arguments to the call, or arguments with changed values.} \item{evaluate}{logical to specify whether to evaluate the new call or just return the call.} } \details{ For objects of class \code{"rma.uni"}, \code{"rma.glmm"}, and \code{"rma.mv"}, the \code{formula.} argument can be used to update the set of moderators included in the model (see \sQuote{Examples}). } \value{ If \code{evaluate=TRUE} the fitted object, otherwise the updated call. } \author{ The present function is based on \code{\link{update.default}}, with changes made by Wolfgang Viechtbauer (\email{wvb@metafor-project.org}) so that the formula updating works with the (somewhat non-standard) interface of the \code{\link{rma.uni}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} functions. } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models which can be updated / refit. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit random-effects model (method="REML" is default) res <- rma(yi, vi, data=dat, digits=3) res ### fit mixed-effects model with two moderators (absolute latitude and publication year) res <- update(res, ~ ablat + year) res ### remove 'year' moderator res <- update(res, ~ . - year) res ### fit model with ML estimation update(res, method="ML") ### example with rma.glmm() res <- rma.glmm(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, digits=3) res <- update(res, mods = ~ ablat) res ### fit conditional model with approximate likelihood update(res, model="CM.AL") } \keyword{models} metafor/man/rma.mv.Rd0000644000176200001440000015366314505063152014170 0ustar liggesusers\name{rma.mv} \alias{rma.mv} \title{Meta-Analysis via Multivariate/Multilevel Linear (Mixed-Effects) Models} \description{ Function to fit meta-analytic multivariate/multilevel fixed- and random/mixed-effects models with or without moderators via linear (mixed-effects) models. See below and the introduction to the \pkg{\link{metafor-package}} for more details on these models. \loadmathjax } \usage{ rma.mv(yi, V, W, mods, random, struct="CS", intercept=TRUE, data, slab, subset, method="REML", test="z", dfs="residual", level=95, btt, R, Rscale="cor", sigma2, tau2, rho, gamma2, phi, cvvc=FALSE, sparse=FALSE, verbose=FALSE, digits, control, \dots) } \arguments{ \item{yi}{vector of length \mjseqn{k} with the observed effect sizes or outcomes. See \sQuote{Details}.} \item{V}{vector of length \mjseqn{k} with the corresponding sampling variances or a \mjeqn{k \times k}{kxk} variance-covariance matrix of the sampling errors. See \sQuote{Details}.} \item{W}{optional argument to specify a vector of length \mjseqn{k} with user-defined weights or a \mjeqn{k \times k}{kxk} user-defined weight matrix. See \sQuote{Details}.} \item{mods}{optional argument to include one or more moderators in the model. A single moderator can be given as a vector of length \mjseqn{k} specifying the values of the moderator. Multiple moderators are specified by giving a matrix with \mjseqn{k} rows and as many columns as there are moderator variables. Alternatively, a model \code{\link{formula}} can be used to specify the model. See \sQuote{Details}.} \item{random}{either a single one-sided formula or list of one-sided formulas to specify the random-effects structure of the model. See \sQuote{Details}.} \item{struct}{character string to specify the variance structure of an \code{~ inner | outer} formula in the \code{random} argument. Either \code{"CS"} for compound symmetry, \code{"HCS"} for heteroscedastic compound symmetry, \code{"UN"} or \code{"GEN"} for an unstructured variance-covariance matrix, \code{"ID"} for a scaled identity matrix, \code{"DIAG"} for a diagonal matrix, \code{"AR"} for an AR(1) autoregressive structure, \code{"HAR"} for a heteroscedastic AR(1) autoregressive structure, \code{"CAR"} for a continuous-time autoregressive structure, or one of \code{"SPEXP"}, \code{"SPGAU"}, \code{"SPLIN"}, \code{"SPRAT"}, or \code{"SPSPH"} for one of the spatial correlation structures. See \sQuote{Details}.} \item{intercept}{logical to specify whether an intercept should be added to the model (the default is \code{TRUE}). Ignored when \code{mods} is a formula.} \item{data}{optional data frame containing the data supplied to the function.} \item{slab}{optional vector with labels for the \mjseqn{k} outcomes/studies.} \item{subset}{optional (logical or numeric) vector to specify the subset of studies (or more precisely, rows of the dataset) that should be used for the analysis.} \item{method}{character string to specify whether the model should be fitted via maximum likelihood (\code{"ML"}) or via restricted maximum likelihood (\code{"REML"}) estimation (the default is \code{"REML"}).} \item{test}{character string to specify how test statistics and confidence intervals for the fixed effects should be computed. By default (\code{test="z"}), Wald-type tests and CIs are obtained, which are based on a standard normal distribution. When \code{test="t"}, a t-distribution is used instead. See \sQuote{Details} and also \link[=misc-recs]{here} for some recommended practices.} \item{dfs}{character string to specify how the (denominator) degrees of freedom should be calculated when \code{test="t"}. Either \code{dfs="residual"} or \code{dfs="contain"}. Can also be a numeric vector with the degrees of freedom for each model coefficient. See \sQuote{Details}.} \item{level}{numeric value between 0 and 100 to specify the confidence interval level (the default is 95; see \link[=misc-options]{here} for details).} \item{btt}{optional vector of indices to specify which coefficients to include in the omnibus test of moderators. Can also be a string to \code{\link{grep}} for. See \sQuote{Details}.} \item{R}{an optional named list of known correlation matrices corresponding to (some of) the components specified via the \code{random} argument. See \sQuote{Details}.} \item{Rscale}{character string, integer, or logical to specify how matrices specified via the \code{R} argument should be scaled. See \sQuote{Details}.} \item{sigma2}{optional numeric vector (of the same length as the number of random intercept components specified via the \code{random} argument) to fix the corresponding \mjseqn{\sigma^2} value(s). A specific \mjseqn{\sigma^2} value can be fixed by setting the corresponding element of this argument to the desired value. A specific \mjseqn{\sigma^2} value will be estimated if the corresponding element is set equal to \code{NA}. See \sQuote{Details}.} \item{tau2}{optional numeric value (for \code{struct="CS"}, \code{"AR"}, \code{"CAR"}, or a spatial correlation structure) or vector (for \code{struct="HCS"}, \code{"UN"}, or \code{"HAR"}) to fix the amount of (residual) heterogeneity for the levels of the \code{inner} factor corresponding to an \code{~ inner | outer} formula specified in the \code{random} argument. A numeric value fixes a particular \mjseqn{\tau^2} value, while \code{NA} means that the value should be estimated. See \sQuote{Details}.} \item{rho}{optional numeric value (for \code{struct="CS"}, \code{"HCS"}, \code{"AR"}, \code{"HAR"}, \code{"CAR"}, or a spatial correlation structure) or vector (for \code{struct="UN"}) to fix the correlation between the levels of the \code{inner} factor corresponding to an \code{~ inner | outer} formula specified in the \code{random} argument. A numeric value fixes a particular \mjseqn{\rho} value, while \code{NA} means that the value should be estimated. See \sQuote{Details}.} \item{gamma2}{as \code{tau2} argument, but for a second \code{~ inner | outer} formula specified in the \code{random} argument. See \sQuote{Details}.} \item{phi}{as \code{rho} argument, but for a second \code{~ inner | outer} formula specified in the \code{random} argument. See \sQuote{Details}.} \item{cvvc}{logical to specify whether to calculate the variance-covariance matrix of the variance/correlation component estimates (can also be set to \code{"varcov"} or \code{"varcor"}). See \sQuote{Details}.} \item{sparse}{logical to specify whether the function should use sparse matrix objects to the extent possible (can speed up model fitting substantially for certain models). See \sQuote{Note}.} \item{verbose}{logical to specify whether output should be generated on the progress of the model fitting (the default is \code{FALSE}). Can also be an integer. Values > 1 generate more verbose output. See \sQuote{Note}.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is 4. See also \link[=misc-options]{here} for further details on how to control the number of digits in the output.} \item{control}{optional list of control values for the estimation algorithms. If unspecified, default values are defined inside the function. See \sQuote{Note}.} \item{\dots}{additional arguments.} } \details{ \subsection{Specifying the Data}{ The function can be used in combination with any of the usual effect sizes or outcome measures used in meta-analyses (e.g., log risk ratios, log odds ratios, risk differences, mean differences, standardized mean differences, log transformed ratios of means, raw correlation coefficients, correlation coefficients transformed with Fisher's r-to-z transformation), or, more generally, any set of estimates (with corresponding sampling variances) one would like to meta-analyze. Simply specify the observed effect sizes or outcomes via the \code{yi} argument and the corresponding sampling variances via the \code{V} argument. In case the sampling errors are correlated, then one can specify the entire variance-covariance matrix of the sampling errors via the \code{V} argument. The \code{\link{escalc}} function can be used to compute a wide variety of effect sizes or outcome measures (and the corresponding sampling variances) based on summary statistics. Equations for computing the covariance between the sampling errors for a variety of different effect sizes or outcome measures can be found, for example, in Gleser and Olkin (2009), Lajeunesse (2011), and Wei and Higgins (2013). For raw and Fisher r-to-z transformed correlations, one can find suitable equations, for example, in Steiger (1980). The latter are implemented in the \code{\link{rcalc}} function. See also \code{\link{vcalc}} for a function that can be used to construct or approximate the variance-covariance matrix of dependent effect sizes or outcomes for a wide variety of circumstances. See also \link[=misc-recs]{here} for some recommendations on a general workflow for meta-analyses involving complex dependency structures. } \subsection{Specifying Fixed Effects}{ With \code{rma.mv(yi, V)}, a fixed-effects model is fitted to the data (note: arguments \code{struct}, \code{sigma2}, \code{tau2}, \code{rho}, \code{gamma2}, \code{phi}, \code{R}, and \code{Rscale} are not relevant then and are ignored). The model is then simply given by \mjeqn{y \sim N(\theta, V)}{y ~ N(\theta, V)}, where \mjseqn{y} is a (column) vector with the observed outcomes, \mjseqn{\theta} is the (average) true outcome, and \mjseqn{V} is the variance-covariance matrix of the sampling errors (if a vector of sampling variances is provided via the \code{V} argument, then \mjseqn{V} is assumed to be diagonal). Note that the argument is \code{V}, not \code{v} (\R is case sensitive!). One or more moderators can be included in the model via the \code{mods} argument. A single moderator can be given as a (row or column) vector of length \mjseqn{k} specifying the values of the moderator. Multiple moderators are specified by giving an appropriate model matrix (i.e., \mjseqn{X}) with \mjseqn{k} rows and as many columns as there are moderator variables (e.g., \code{mods = cbind(mod1, mod2, mod3)}, where \code{mod1}, \code{mod2}, and \code{mod3} correspond to the names of the variables for the three moderator variables). The intercept is added to the model matrix by default unless \code{intercept=FALSE}. Alternatively, one can use standard \code{\link{formula}} syntax to specify the model. In this case, the \code{mods} argument should be set equal to a one-sided formula of the form \code{mods = ~ model} (e.g., \code{mods = ~ mod1 + mod2 + mod3}). Interactions, polynomial terms, and factors can be easily added to the model in this manner. When specifying a model formula via the \code{mods} argument, the \code{intercept} argument is ignored. Instead, the inclusion/exclusion of the intercept is controlled by the specified formula (e.g., \code{mods = ~ mod1 + mod2 + mod3 - 1} would lead to the removal of the intercept). One can also directly specify moderators via the \code{yi} argument (e.g., \code{rma.mv(yi ~ mod1 + mod2 + mod3, V)}). In that case, the \code{mods} argument is ignored and the inclusion/exclusion of the intercept again is controlled by the specified formula. With moderators included, the model is then given by \mjeqn{y \sim N(X \beta, V)}{y ~ N(X \beta, V)}, where \mjseqn{X} denotes the model matrix containing the moderator values (and possibly the intercept) and \mjseqn{\beta} is a column vector containing the corresponding model coefficients. The model coefficients (i.e., \mjseqn{\beta}) are then estimated with \mjeqn{b = (X'WX')^{-1} X'Wy}{b = (X'WX)^(-1) X'Wy}, where \mjeqn{W = V^{-1}}{W = V^(-1)} is the weight matrix (without moderators, \mjseqn{X} is just a column vector of 1's). With the \code{W} argument, one can also specify user-defined weights (or a weight matrix). } \subsection{Specifying Random Effects}{ One can fit random/mixed-effects models to the data by specifying the desired random effects structure via the \code{random} argument. The \code{random} argument is either a single one-sided formula or a list of one-sided formulas. One formula type that can be specified via this argument is of the form \code{random = ~ 1 | id}. Such a formula adds a random effect corresponding to the grouping variable \code{id} to the model. Outcomes with the same value of the \code{id} variable receive the same value of the random effect, while outcomes with different values of the \code{id} variable are assumed to be independent. The variance component corresponding to such a formula is denoted by \mjseqn{\sigma^2}. An arbitrary number of such formulas can be specified as a list of formulas (e.g., \code{random = list(~ 1 | id1, ~ 1 | id2)}), with variance components \mjseqn{\sigma^2_1}, \mjseqn{\sigma^2_2}, and so on. Nested random effects of this form can also be added using \code{random = ~ 1 | id1/id2}, which adds a random effect corresponding to the grouping variable \code{id1} and a random effect corresponding to \code{id2} within \code{id1} to the model. This can be extended to models with even more levels of nesting (e.g., \code{random = ~ 1 | id1/id2/id3}). Random effects of this form are useful to model clustering (and hence non-independence) induced by a multilevel structure in the data (e.g., outcomes derived from the same paper, lab, research group, or species may be more similar to each other than outcomes derived from different papers, labs, research groups, or species). See, for example, Konstantopoulos (2011) and Nakagawa and Santos (2012) for more details. See \code{\link[metadat]{dat.konstantopoulos2011}}, \code{\link[metadat]{dat.bornmann2007}}, \code{\link[metadat]{dat.obrien2003}}, and \code{\link[metadat]{dat.crede2010}} for examples of multilevel meta-analyses. In addition or alternatively to specifying one or multiple \code{~ 1 | id} terms, the \code{random} argument can also contain a formula of the form \code{~ inner | outer}. Outcomes with the same value of the \code{outer} grouping variable share correlated random effects corresponding to the levels of the \code{inner} grouping variable, while outcomes with different values of the \code{outer} grouping variable are assumed to be independent (note that the \code{inner} variable is automatically treated as a factor). The \code{struct} argument is used to specify the variance structure corresponding to the \code{inner} variable. With \code{struct="CS"}, a compound symmetric structure is assumed (i.e., a single variance component \mjseqn{\tau^2} corresponding to the \mjseqn{j = 1, \ldots, J} levels of the \code{inner} variable and a single correlation coefficient \mjseqn{\rho} for the correlation between the different levels). With \code{struct="HCS"}, a heteroscedastic compound symmetric structure is assumed (with \mjseqn{\tau^2_j} denoting the variance component corresponding to the \mjeqn{j\textrm{th}}{jth} level of the \code{inner} variable and a single correlation coefficient \mjseqn{\rho} for the correlation between the different levels). With \code{struct="UN"}, an unstructured (but positive definite) variance-covariance matrix is assumed (with \mjseqn{\tau^2_j} as described above and correlation coefficient \mjeqn{\rho_{jj'}}{\rho_jj'} for the combination of the \mjeqn{j\textrm{th}}{jth} and \mjeqn{j'\textrm{th}}{j'th} level of the \code{inner} variable). \ifelse{text}{}{For example, for an \code{inner} variable with four levels, the three structures correspond to variance-covariance matrices of the form:} \mjtdeqn{\small \begin{array}{ccc} \texttt{struct="CS"} & \texttt{struct="HCS"} & \texttt{struct="UN"} \\\ \left[ \begin{array}{cccc} \tau^2 & & & \\\ \rho\tau^2 & \tau^2 & & \\\ \rho\tau^2 & \rho\tau^2 & \tau^2 & \\\ \rho\tau^2 & \rho\tau^2 & \rho\tau^2 & \tau^2 \end{array} \right] & \left[ \begin{array}{cccc} \tau_1^2 & & & \\\ \rho\tau_2\tau_1 & \tau_2^2 & & \\\ \rho\tau_3\tau_1 & \rho\tau_3\tau_2 & \tau_3^2 & \\\ \rho\tau_4\tau_1 & \rho\tau_4\tau_2 & \rho\tau_4\tau_3 & \tau_4^2 \end{array} \right] & \left[ \begin{array}{cccc} \tau_1^2 & & & \\\ \rho_{21}\tau_2\tau_1 & \tau_2^2 & & \\\ \rho_{31}\tau_3\tau_1 & \rho_{32}\tau_3\tau_2 & \tau_3^2 & \\\ \rho_{41}\tau_4\tau_1 & \rho_{42}\tau_4\tau_2 & \rho_{43}\tau_4\tau_3 & \tau_4^2 \end{array} \right] \end{array}}{\begin{array}{ccc}\texttt{struct="CS"} & \texttt{struct="HCS"} & \texttt{struct="UN"} \\\\\ \begin{bmatrix} \tau^2 & & & \\\\\ \rho\tau^2 & \tau^2 & & \\\\\ \rho\tau^2 & \rho\tau^2 & \tau^2 & \\\\\ \rho\tau^2 & \rho\tau^2 & \rho\tau^2 & \tau^2 \end{bmatrix} & \begin{bmatrix} \tau_1^2 & & & \\\\\ \rho\tau_2\tau_1 & \tau_2^2 & & \\\\\ \rho\tau_3\tau_1 & \rho\tau_3\tau_2 & \tau_3^2 & \\\\\ \rho\tau_4\tau_1 & \rho\tau_4\tau_2 & \rho\tau_4\tau_3 & \tau_4^2 \end{bmatrix} & \begin{bmatrix} \tau_1^2 & & & \\\\\ \rho_{21}\tau_2\tau_1 & \tau_2^2 & & \\\\\ \rho_{31}\tau_3\tau_1 & \rho_{32}\tau_3\tau_2 & \tau_3^2 & \\\\\ \rho_{41}\tau_4\tau_1 & \rho_{42}\tau_4\tau_2 & \rho_{43}\tau_4\tau_3 & \tau_4^2 \end{bmatrix} \end{array}}{} Structures \code{struct="ID"} and \code{struct="DIAG"} are just like \code{struct="CS"} and \code{struct="HCS"}, respectively, except that \mjseqn{\rho} is set to 0, so that we either get a scaled identity matrix or a diagonal matrix. With the \code{outer} term corresponding to a study identification variable and the \code{inner} term to a variable indicating the treatment type or study arm, such a random effect could be used to estimate how strongly different treatment effects or outcomes within the same study are correlated and/or whether the amount of heterogeneity differs across different treatment types/arms. Network meta-analyses (also known as mixed treatment comparisons) will also typically require such a random effect (e.g., Salanti et al., 2008). The meta-analytic bivariate model (e.g., van Houwelingen, Arends, & Stijnen, 2002) can also be fitted in this manner (see the examples below). The \code{inner} term could also correspond to a variable indicating different types of outcomes measured within the same study, which allows for fitting multivariate models with multiple correlated effects/outcomes per study (e.g., Berkey et al., 1998; Kalaian & Raudenbush, 1996). See \code{\link[metadat]{dat.berkey1998}}, \code{\link[metadat]{dat.assink2016}}, \code{\link[metadat]{dat.kalaian1996}}, \code{\link[metadat]{dat.dagostino1998}}, and \code{\link[metadat]{dat.craft2003}} for examples of multivariate meta-analyses with multiple outcomes. See \code{\link[metadat]{dat.knapp2017}}, \code{\link[metadat]{dat.mccurdy2020}}, and \code{\link[metadat]{dat.tannersmith2016}} for further examples of multilevel/multivariate models with complex data structures (see also \link[=misc-recs]{here} for a related discussion of a recommended workflow for such cases). See \code{\link[metadat]{dat.kearon1998}} for an example using a bivariate model to analyze sensitivity and specificity. See \code{\link[metadat]{dat.hasselblad1998}}, \code{\link[metadat]{dat.pagliaro1992}}, \code{\link[metadat]{dat.lopez2019}}, and \code{\link[metadat]{dat.senn2013}} for examples of network meta-analyses. For meta-analyses of studies reporting outcomes at multiple time points, it may also be reasonable to assume that the true effects/outcomes are correlated over time according to an autoregressive structure (Ishak et al., 2007; Trikalinos & Olkin, 2012). For this purpose, one can choose \code{struct="AR"}, corresponding to a structure with a single variance component \mjseqn{\tau^2} and AR(1) autocorrelation among the values of the random effect. The values of the \code{inner} variable should then reflect the various time points, with increasing values reflecting later time points. This structure assumes equally spaced time points, so the actual values of the \code{inner} variable are not relevant, only their ordering. One can also use \code{struct="HAR"}, which allows for fitting a heteroscedastic AR(1) structure (with \mjseqn{\tau^2_j} denoting the variance component of the \mjeqn{j\textrm{th}}{jth} measurement occasion). Finally, when time points are not evenly spaced, one might consider using \code{struct="CAR"} for a continuous-time autoregressive structure, in which case the values of the \code{inner} variable should reflect the exact time points of the measurement occasions. \ifelse{text}{}{For example, for an \code{inner} variable with four time points, these structures correspond to variance-covariance matrices of the form:} \mjtdeqn{\small \begin{array}{ccc} \texttt{struct="AR"} & \texttt{struct="HAR"} & \texttt{struct="CAR"} \\\ \left[ \begin{array}{cccc} \tau^2 & & & \\\ \rho\tau^2 & \tau^2 & & \\\ \rho^2\tau^2 & \rho\tau^2 & \tau^2 & \\\ \rho^3\tau^2 & \rho^2\tau^2 & \rho\tau^2 & \tau^2 \end{array} \right] & \left[ \begin{array}{cccc} \tau_1^2 & & & \\\ \rho\tau_2\tau_1 & \tau_2^2 & & \\\ \rho^2\tau_3\tau_1 & \rho\tau_3\tau_2 & \tau_3^2 & \\\ \rho^3\tau_4\tau_1 & \rho^2\tau_4\tau_2 & \rho\tau_4\tau_3 & \tau_4^2 \end{array} \right] & \left[ \begin{array}{cccc} \tau^2 & & & \\\ \rho^{|t_2-t_1|}\tau^2 & \tau^2 & & \\\ \rho^{|t_3-t_1|}\tau^2 & \rho^{|t_3-t_2|}\tau^2 & \tau^2 & \\\ \rho^{|t_4-t_1|}\tau^2 & \rho^{|t_4-t_2|}\tau^2 & \rho^{|t_4-t_3|}\tau^2 & \tau^2 \end{array} \right] \end{array}}{\begin{array}{ccc}\texttt{struct="AR"} & \texttt{struct="HAR"} & \texttt{struct="CAR"} \\\\\ \begin{bmatrix} \tau^2 & & & \\\\\ \rho\tau^2 & \tau^2 & & \\\\\ \rho^2\tau^2 & \rho\tau^2 & \tau^2 & \\\\\ \rho^3\tau^2 & \rho^2\tau^2 & \rho\tau^2 & \tau^2 \end{bmatrix} & \begin{bmatrix} \tau_1^2 & & & \\\\\ \rho\tau_2\tau_1 & \tau_2^2 & & \\\\\ \rho^2\tau_3\tau_1 & \rho\tau_3\tau_2 & \tau_3^2 & \\\\\ \rho^3\tau_4\tau_1 & \rho^2\tau_4\tau_2 & \rho\tau_4\tau_3 & \tau_4^2 \end{bmatrix} & \begin{bmatrix} \tau^2 & & & \\\\\ \rho^{|t_2-t_1|}\tau^2 & \tau^2 & & \\\\\ \rho^{|t_3-t_1|}\tau^2 & \rho^{|t_3-t_2|}\tau^2 & \tau^2 & \\\\\ \rho^{|t_4-t_1|}\tau^2 & \rho^{|t_4-t_2|}\tau^2 & \rho^{|t_4-t_3|}\tau^2 & \tau^2 \end{bmatrix} \end{array}}{} See \code{\link[metadat]{dat.fine1993}} and \code{\link[metadat]{dat.ishak2007}} for examples involving such structures. For outcomes that have a known spatial configuration, various spatial correlation structures are also available. For these structures, the formula is of the form \code{random = ~ var1 + var2 + \dots | outer}, where \code{var1}, \code{var2}, and so on are variables to indicate the spatial coordinates (e.g., longitude and latitude) based on which distances (by default Euclidean) will be computed. Let \mjseqn{d} denote the distance between two points that share the same value of the \code{outer} variable (if all true effects/outcomes are allowed to be spatially correlated, simply set \code{outer} to a variable that is a constant). Then the correlation between the true effects/outcomes corresponding to these two points is a function of \mjseqn{d} and the parameter \mjseqn{\rho}. The following table shows the types of spatial correlation structures that can be specified and the equations for the correlation. The covariance between the true effects/outcomes is then the correlation times \mjseqn{\tau^2}. \tabular{lllll}{ structure \tab \ics \tab \code{struct} \tab \ics \tab correlation \cr exponential \tab \ics \tab \code{"SPEXP"} \tab \ics \tab \mjeqn{\exp(-d/\rho)}{exp(-d/rho)} \cr Gaussian \tab \ics \tab \code{"SPGAU"} \tab \ics \tab \mjeqn{\exp(-d^2/\rho^2)}{exp(-d^2/rho^2)} \cr linear \tab \ics \tab \code{"SPLIN"} \tab \ics \tab \mjeqn{(1 - d/\rho) I(d < \rho)}{(1 - d/rho) I(d < rho)} \cr rational quadratic \tab \ics \tab \code{"SPRAT"} \tab \ics \tab \mjeqn{1 - (d/\rho)^2 / (1 + (d/\rho)^2)}{1 - (d/rho)^2 / (1 + (d/rho)^2)} \cr spherical \tab \ics \tab \code{"SPSPH"} \tab \ics \tab \mjeqn{(1 - 1.5(d/\rho) + 0.5(d/\rho)^3) I(d < \rho)}{(1 - 1.5(d/rho) + 0.5(d/rho)^3) I(d < rho)}} Note that \mjseqn{I(d < \rho)} is equal to \mjseqn{1} if \mjseqn{d < \rho} and \mjseqn{0} otherwise. The parameterization of the various structures is based on Pinheiro and Bates (2000). Instead of Euclidean distances, one can also use other distance measures by setting (the undocumented) argument \code{dist} to either \code{"maximum"} for the maximum distance between two points (supremum norm), to \code{"manhattan"} for the absolute distance between the coordinate vectors (L1 norm), or to \code{"gcd"} for the great-circle distance (WGS84 ellipsoid method). In the latter case, only two variables, namely the longitude and latitude (in decimal degrees, with minus signs for West and South), must be specified. If a distance matrix has already been computed, one can also pass this matrix as a list element to the \code{dist} argument. In this case, one should use a formula of the form \code{random = ~ id | outer}, where \code{id} are location identifiers, with corresponding row/column names in the distance matrix specified via the \code{dist} argument. See \code{\link[metadat]{dat.maire2019}} for an example of a meta-analysis with a spatial correlation structure. An \code{~ inner | outer} formula can also be used to add random effects to the model corresponding to a set of predictor variables when \code{struct="GEN"}. Here, the \code{inner} term is used to specify one or multiple variables (e.g., \code{random = ~ var1 + var2 | outer}) and corresponding \sQuote{random slopes} are added to the model (and a \sQuote{random intercept} unless the intercept is removed from the \code{inner} term). The variance-covariance matrix of the random effects added in this manner is assumed to be a general unstructured (but positive definite) matrix. Such a random effects structure may be useful in a meta-analysis examining the dose-response relationship between a moderator variable and the size of the true effects/outcomes (sometimes called a \sQuote{dose-response meta-analysis}). See \code{\link[metadat]{dat.obrien2003}} for an example of a meta-analysis examining a dose-response relationship. The \code{random} argument can also contain a second formula of the form \code{~ inner | outer} (but no more!). A second formula of this form works exactly described as above, but its variance components are denoted by \mjseqn{\gamma^2} and its correlation components by \mjseqn{\phi}. The \code{struct} argument should then be of length 2 to specify the variance-covariance structure for the first and second component, respectively. When the \code{random} argument contains a formula of the form \code{~ 1 | id}, one can use the (optional) argument \code{R} to specify a corresponding known correlation matrix for the random effect (i.e., \code{R = list(id = Cor)}, where \code{Cor} is the correlation matrix). In that case, outcomes with the same value of the \code{id} variable receive the same value for the random effect, while outcomes with different values of the \code{id} variable receive values that are correlated as specified in the corresponding correlation matrix given via the \code{R} argument. The column/row names of the correlation matrix given via the \code{R} argument must therefore correspond to the unique values of the \code{id} variable. When the \code{random} argument contains multiple formulas of the form \code{~ 1 | id}, one can specify known correlation matrices for none, some, or all of those terms (e.g., with \code{random = list(~ 1 | id1, ~ 1 | id2)}, one could specify \code{R = list(id1 = Cor1)} or \code{R = list(id1 = Cor1, id2 = Cor2)}, where \code{Cor1} and \code{Cor2} are the correlation matrices corresponding to the grouping variables \code{id1} and \code{id2}, respectively). Such a random effect with a known (or at least approximately known) correlation structure is useful in a variety of contexts. For example, such a component can be used to account for the correlations induced by the shared phylogenetic history among organisms (e.g., plants, fungi, animals). In that case, \code{~ 1 | species} is used to specify the species and argument \code{R} is used to specify the phylogenetic correlation matrix of the species studied in the meta-analysis. The corresponding variance component then indicates how much variance/heterogeneity is attributable to the specified phylogeny. See Nakagawa and Santos (2012) for more details. As another example, in a genetic meta-analysis studying disease association for several single nucleotide polymorphisms (SNPs), linkage disequilibrium (LD) among the SNPs can induce an approximately known degree of correlation among the effects/outcomes. In that case, \code{~ 1 | snp} could be used to specify the SNPs and \code{R} the corresponding LD correlation matrix for the SNPs included in the meta-analysis. The \code{Rscale} argument controls how matrices specified via the \code{R} argument are scaled. With \code{Rscale="none"} (or \code{Rscale=0} or \code{Rscale=FALSE}), no scaling is used. With \code{Rscale="cor"} (or \code{Rscale=1} or \code{Rscale=TRUE}), the \code{\link{cov2cor}} function is used to ensure that the matrices are correlation matrices (assuming they were covariance matrices to begin with). With \code{Rscale="cor0"} (or \code{Rscale=2}), first \code{\link{cov2cor}} is used and then the elements of each correlation matrix are scaled with \mjseqn{(R - \min(R)) / (1 - \min(R))} (this ensures that a correlation of zero in a phylogenetic correlation matrix corresponds to the split at the root node of the tree comprising the species that are actually analyzed). Finally, \code{Rscale="cov0"} (or \code{Rscale=3}) only rescales with \mjseqn{R - \min(R)} (which ensures that a phylogenetic covariance matrix is rooted at the lowest split). See \code{\link[metadat]{dat.moura2021}} and \code{\link[metadat]{dat.lim2014}} for examples of meta-analyses with phylogenetic correlation structures. Together with the variance-covariance matrix of the sampling errors (i.e., \mjseqn{V}), the specified random effects structure of the model implies a particular \sQuote{marginal} variance-covariance matrix of the observed effect sizes or outcomes. Once estimates of the variance components (i.e., of the \mjseqn{\sigma^2}, \mjseqn{\tau^2}, \mjseqn{\rho}, \mjseqn{\gamma^2}, and/or \mjseqn{\phi} values) have been obtained (either using maximum likelihood or restricted maximum likelihood estimation), the estimated marginal variance-covariance matrix can be constructed (denoted by \mjseqn{M}). The model coefficients (i.e., \mjseqn{\beta}) are then estimated with \mjeqn{b = (X'WX')^{-1} X'Wy}{b = (X'WX)^(-1) X'Wy}, where \mjeqn{W = M^{-1}}{W = M^(-1)} is the weight matrix. With the \code{W} argument, one can again specify user-defined weights (or a weight matrix). } \subsection{Fixing Variance/Correlation Components}{ Arguments \code{sigma2}, \code{tau2}, \code{rho}, \code{gamma2}, and \code{phi} can be used to fix particular variance/correlation components at a given value. This is useful for sensitivity analyses (e.g., for plotting the regular/restricted log-likelihood as a function of a particular variance/correlation component), likelihood ratio tests, or for imposing a desired variance-covariance structure on the data. For example, if \code{random = list(~ 1 | id1, ~ 1 | id2)} or \code{random = ~ 1 | id1/id2}, then \code{sigma2} must be of length 2 (corresponding to \mjseqn{\sigma^2_1} and \mjseqn{\sigma^2_2}) and a fixed value can be assigned to either or both variance components. Setting a particular component to \code{NA} means that the component will be estimated by the function (e.g., \code{sigma2=c(0,NA)} would fix \mjseqn{\sigma^2_1} to 0 and estimate \mjseqn{\sigma^2_2}). Argument \code{tau2} is only relevant when the \code{random} argument contains an \code{~ inner | outer} formula. In that case, if the \code{tau2} argument is used, it must be either of length 1 (for \code{"CS"}, \code{"ID"}, \code{"AR"}, \code{"CAR"}, or one of the spatial correlation structures) or of the same length as the number of unique values of the \code{inner} variable (for \code{"HCS"}, \code{"DIAG"}, \code{"UN"}, or \code{"HAR"}). A numeric value in the \code{tau2} argument then fixes the corresponding variance component to that value, while \code{NA} means that the component will be estimated. Similarly, if argument \code{rho} is used, it must be either of length 1 (for \code{"CS"}, \code{"HCS"}, \code{"AR"}, \code{"HAR"}, or one of the spatial correlation structures) or of length \mjseqn{J(J-1)/2} (for \code{"UN"}), where \mjseqn{J} denotes the number of unique values of the \code{inner} variable. Again, a numeric value fixes the corresponding correlation, while \code{NA} means that the correlation will be estimated. For example, with \code{struct="CS"} and \code{rho=0}, the variance-covariance matrix of the \code{inner} variable will be diagonal with \mjseqn{\tau^2} along the diagonal. For \code{struct="UN"}, the values specified under \code{rho} should be given in column-wise order (e.g., for an \code{inner} variable with four levels, the order would be \mjeqn{\rho_{21}}{\rho_21}, \mjeqn{\rho_{31}}{\rho_31}, \mjeqn{\rho_{41}}{\rho_41}, \mjeqn{\rho_{32}}{\rho_32}, \mjeqn{\rho_{42}}{\rho_42}, \mjeqn{\rho_{43}}{\rho_43}). Similarly, arguments \code{gamma2} and \code{phi} are only relevant when the \code{random} argument contains a second \code{~ inner | outer} formula. The arguments then work exactly as described above. } \subsection{Omnibus Test of Moderators}{ For models including moderators, an omnibus test of all model coefficients is conducted that excludes the intercept (the first coefficient) if it is included in the model. If no intercept is included in the model, then the omnibus test includes all coefficients in the model including the first. Alternatively, one can manually specify the indices of the coefficients to test via the \code{btt} (\sQuote{betas to test}) argument (i.e., to test \mjseqn{\mbox{H}_0{:}\; \beta_{j \in \texttt{btt}} = 0}, where \mjseqn{\beta_{j \in \texttt{btt}}} is the set of coefficients to be tested). For example, with \code{btt=c(3,4)}, only the third and fourth coefficients from the model are included in the test (if an intercept is included in the model, then it corresponds to the first coefficient in the model). Instead of specifying the coefficient numbers, one can specify a string for \code{btt}. In that case, \code{\link{grep}} will be used to search for all coefficient names that match the string. The omnibus test is called the \mjseqn{Q_M}-test and follows asymptotically a chi-square distribution with \mjseqn{m} degrees of freedom (with \mjseqn{m} denoting the number of coefficients tested) under the null hypothesis (that the true value of all coefficients tested is equal to 0). } \subsection{Categorical Moderators}{ Categorical moderator variables can be included in the model via the \code{mods} argument in the same way that appropriately (dummy) coded categorical variables can be included in linear models. One can either do the dummy coding manually or use a model formula together with the \code{\link{factor}} function to automate the coding (note that string/character variables in a model formula are automatically converted to factors). } \subsection{Tests and Confidence Intervals}{ By default, tests of individual coefficients in the model (and the corresponding confidence intervals) are based on a standard normal distribution, while the omnibus test is based on a chi-square distribution (see above). As an alternative, one can set \code{test="t"}, in which case tests of individual coefficients and confidence intervals are based on a t-distribution with \mjseqn{k-p} degrees of freedom, while the omnibus test then uses an F-distribution with \mjseqn{m} and \mjseqn{k-p} degrees of freedom (with \mjseqn{k} denoting the total number of estimates included in the analysis and \mjseqn{p} the total number of model coefficients including the intercept if it is present). Note that \code{test="t"} is not the same as \code{test="knha"} in \code{\link{rma.uni}}, as no adjustment to the standard errors of the estimated coefficients is made. The method for calculating the (denominator) degrees of freedom described above (which corresponds to \code{dfs="residual"}) is quite simplistic and may lead to tests with inflated Type I error rates and confidence intervals that are too narrow on average. As an alternative, one can set \code{dfs="contain"} (which automatically also sets \code{test="t"}), in which case the degrees of freedom for the test of a particular model coefficient, \mjseqn{b_j}, are determined by checking whether \mjseqn{x_j}, the corresponding column of the model matrix \mjseqn{X}, varies at the level corresponding to a particular random effect in the model. If such a random effect can be found, then the degrees of freedom are set to \mjseqn{l-p}, where \mjseqn{l} denotes the number of unique values of this random effect (i.e., for an \code{~ 1 | id} term, the number of unique values of the \code{id} variable and for an \code{~ inner | outer} term, the number of unique values of the \code{outer} variable). If no such random effect can be found, then \mjseqn{k-p} is used as the degrees of freedom. For the omnibus F-test, the minimum of the degrees of freedom of all coefficients involved in the test is used as the denominator degrees of freedom. This approach for calculating the degrees of freedom should often lead to tests with better control of the Type I error rate and confidence intervals with closer to nominal coverage rates (see also \link[=misc-recs]{here}). One can also set \code{dfs} to a numeric vector with the desired values for the degrees of freedom for testing the model coefficients (e.g., if some other method for determining the degrees of freedom was used). } \subsection{Tests and Confidence Intervals for Variance/Correlation Components}{ Depending on the random effects structure specified, the model may include one or multiple variance/correlation components. Profile likelihood confidence intervals for such components can be obtained using the \code{\link[=confint.rma.mv]{confint}} function. Corresponding likelihood ratio tests can be obtained using the \code{\link[=anova.rma]{anova}} function (by comparing two models where the size of the component to be tested is constrained to some null value in the reduced model). It is also always a good idea to examine plots of the (restricted) log-likelihood as a function of the variance/correlation components in the model using the \code{\link[=profile.rma.mv]{profile}} function to check for parameter identifiability (see \sQuote{Note}). } \subsection{Test for (Residual) Heterogeneity}{ A test for (residual) heterogeneity is automatically carried out by the function. Without moderators in the model, this test is the generalized/weighted least squares extension of Cochran's \mjseqn{Q}-test, which tests whether the variability in the observed effect sizes or outcomes is larger than one would expect based on sampling variability (and the given covariances among the sampling errors) alone. A significant test suggests that the true effects/outcomes are heterogeneous. When moderators are included in the model, this is the \mjseqn{Q_E}-test for residual heterogeneity, which tests whether the variability in the observed effect sizes or outcomes that is not accounted for by the moderators included in the model is larger than one would expect based on sampling variability (and the given covariances among the sampling errors) alone. } \subsection{Var-Cov Matrix of the Variance/Correlation Component Estimates}{ In some cases, one might want to obtain the variance-covariance matrix of the variance/correlation component estimates (i.e., of the estimated \mjseqn{\sigma^2}, \mjseqn{\tau^2}, \mjseqn{\rho}, \mjseqn{\gamma^2}, \mjseqn{\phi} values). The function will try to calculate this matrix when \code{cvvc=TRUE} (or equivalently, when \code{cvvc="varcor"}). This is done by inverting the Hessian, which is numerically approximated using the \code{\link[numDeriv]{hessian}} function from the \code{numDeriv} package. Note that these computations may not be numerically stable, especially when the estimates are close to their parameter bounds and/or the likelihood surface is relatively flat around its maximum. When \code{struct="UN"}, one can also set \code{cvvc="varcov"} in which case the variance-covariance matrix is given for the variance and covariance components (instead of the correlation components). } } \value{ An object of class \code{c("rma.mv","rma")}. The object is a list containing the following components: \item{beta}{estimated coefficients of the model.} \item{se}{standard errors of the coefficients.} \item{zval}{test statistics of the coefficients.} \item{pval}{corresponding p-values.} \item{ci.lb}{lower bound of the confidence intervals for the coefficients.} \item{ci.ub}{upper bound of the confidence intervals for the coefficients.} \item{vb}{variance-covariance matrix of the estimated coefficients.} \item{sigma2}{estimated \mjseqn{\sigma^2} value(s).} \item{tau2}{estimated \mjseqn{\tau^2} value(s).} \item{rho}{estimated \mjseqn{\rho} value(s).} \item{gamma2}{estimated \mjseqn{\gamma^2} value(s).} \item{phi}{estimated \mjseqn{\phi} value(s).} \item{k}{number of observed effect sizes or outcomes included in the analysis.} \item{p}{number of coefficients in the model (including the intercept).} \item{m}{number of coefficients included in the omnibus test of moderators.} \item{QE}{test statistic of the test for (residual) heterogeneity.} \item{QEp}{corresponding p-value.} \item{QM}{test statistic of the omnibus test of moderators.} \item{QMp}{corresponding p-value.} \item{int.only}{logical that indicates whether the model is an intercept-only model.} \item{yi, V, X}{the vector of outcomes, the corresponding variance-covariance matrix of the sampling errors, and the model matrix.} \item{M}{the estimated marginal variance-covariance matrix of the observed effect sizes or outcomes.} \item{fit.stats}{a list with the log-likelihood, deviance, AIC, BIC, and AICc values.} \item{vvc}{variance-covariance matrix of the variance/correlation component estimates (\code{NA} when \code{cvvc=FALSE}).} \item{\dots}{some additional elements/values.} } \section{Methods}{ The results of the fitted model are formatted and printed with the \code{\link[=print.rma.mv]{print}} function. If fit statistics should also be given, use \code{\link[=summary.rma]{summary}} (or use the \code{\link[=fitstats.rma]{fitstats}} function to extract them). Full versus reduced model comparisons in terms of fit statistics and likelihood ratio tests can be obtained with \code{\link[=anova.rma]{anova}}. Wald-type tests for sets of model coefficients or linear combinations thereof can be obtained with the same function. Tests and confidence intervals based on (cluster) robust methods can be obtained with \code{\link[=robust.rma.mv]{robust}}. Predicted/fitted values can be obtained with \code{\link[=predict.rma]{predict}} and \code{\link[=fitted.rma]{fitted}}. For best linear unbiased predictions, see \code{\link[=ranef.rma.mv]{ranef}}. The \code{\link[=residuals.rma]{residuals}}, \code{\link[=rstandard.rma.mv]{rstandard}}, and \code{\link[=rstudent.rma.mv]{rstudent}} functions extract raw and standardized residuals. See \code{\link[=influence.rma.mv]{influence}} for additional model diagnostics (e.g., to determine influential studies). For models with moderators, variance inflation factors can be obtained with \code{\link[=vif.rma]{vif}}. Confidence intervals for any variance/correlation components in the model can be obtained with \code{\link[=confint.rma.mv]{confint}}. For random/mixed-effects models, the \code{\link[=profile.rma.mv]{profile}} function can be used to obtain a plot of the (restricted) log-likelihood as a function of a specific variance/correlation component of the model. For models with moderators, \code{\link[=regplot.rma]{regplot}} draws scatter plots / bubble plots, showing the (marginal) relationship between the observed outcomes and a selected moderator from the model. Other extractor functions include \code{\link[=coef.rma]{coef}}, \code{\link[=vcov.rma]{vcov}}, \code{\link[=logLik.rma]{logLik}}, \code{\link[=deviance.rma]{deviance}}, \code{\link[=AIC.rma]{AIC}}, \code{\link[=BIC.rma]{BIC}}, \code{\link[=hatvalues.rma.mv]{hatvalues}}, and \code{\link[=weights.rma.mv]{weights}}. } \note{ Argument \code{V} also accepts a list of variance-covariance matrices for the observed effect sizes or outcomes. From the list elements, the full (block diagonal) variance-covariance matrix is then automatically constructed. For this to work correctly, the list elements must be in the same order as the observed outcomes. Model fitting is done via numerical optimization over the model parameters. By default, \code{\link{nlminb}} is used for the optimization. One can also chose a different optimizer from \code{\link{optim}} via the \code{control} argument (e.g., \code{control=list(optimizer="BFGS")} or \code{control=list(optimizer="Nelder-Mead")}). Besides \code{\link{nlminb}} and one of the methods from \code{\link{optim}}, one can also choose one of the optimizers from the \code{minqa} package (i.e., \code{\link[minqa]{uobyqa}}, \code{\link[minqa]{newuoa}}, or \code{\link[minqa]{bobyqa}}), one of the (derivative-free) algorithms from the \code{\link[nloptr]{nloptr}} package, the Newton-type algorithm implemented in \code{\link{nlm}}, the various algorithms implemented in the \code{dfoptim} package (\code{\link[dfoptim]{hjk}} for the Hooke-Jeeves, \code{\link[dfoptim]{nmk}} for the Nelder-Mead, and \code{\link[dfoptim]{mads}} for the Mesh Adaptive Direct Searches algorithm), the quasi-Newton type optimizers \code{\link[ucminf]{ucminf}} and \code{\link[lbfgsb3c]{lbfgsb3c}} and the subspace-searching simplex algorithm \code{\link[subplex]{subplex}} from the packages of the same name, the Barzilai-Borwein gradient decent method implemented in \code{\link[BB]{BBoptim}}, the \code{\link[Rcgmin]{Rcgmin}} and \code{\link[Rvmmin]{Rvmmin}} optimizers, or the parallelized version of the L-BFGS-B algorithm implemented in \code{\link[optimParallel]{optimParallel}} from the package of the same name. The optimizer name must be given as a character string (i.e., in quotes). Additional control parameters can be specified via the \code{control} argument (e.g., \code{control=list(iter.max=1000, rel.tol=1e-8)}). For \code{\link[nloptr]{nloptr}}, the default is to use the BOBYQA implementation from that package with a relative convergence criterion of \code{1e-8} on the function value (i.e., log-likelihood), but this can be changed via the \code{algorithm} and \code{ftop_rel} arguments (e.g., \code{control=list(optimizer="nloptr", algorithm="NLOPT_LN_SBPLX", ftol_rel=1e-6)}). For \code{\link[optimParallel]{optimParallel}}, the control argument \code{ncpus} can be used to specify the number of cores to use for the parallelization (e.g., \code{control=list(optimizer="optimParallel", ncpus=2)}). With \code{parallel::detectCores()}, one can check on the number of available cores on the local machine. At the moment, the starting values are not chosen in a terribly clever way and could be far off. As a result, the optimizer may be slow to converge or may even get stuck at a local maximum. One can set the starting values manually for the various variance/correlation components in the model via the \code{control} argument by specifying the vectors \code{sigma2.init}, \code{tau2.init}, \code{rho.init}, \code{gamma2.init}, and/or \code{phi.init} as needed. Especially for complex models, it is a good idea to try out different starting values to make sure that the same estimates are obtained. Information on the progress of the optimization algorithm can be obtained by setting \code{verbose=TRUE} (this won't work when using parallelization). Since fitting complex models with many random effects can be computationally expensive, this option is useful to determine how the model fitting is progressing. One can also set \code{verbose} to an integer (\code{verbose=2} yields even more information and \code{verbose=3} also sets \code{option(warn=1)} temporarily). Whether a particular variance/correlation component is actually identifiable needs to be carefully examined when fitting complex models. The function does some limited checking internally to fix variances and/or correlations at zero when it is clear that insufficient information is available to estimate a particular parameter (e.g., if a particular factor has only a single level, the corresponding variance component cannot be estimated). However, it is strongly advised in general to do post model fitting checks to make sure that the likelihood surface around the ML/REML estimates is not flat for some combination of the parameter estimates (which would imply that the estimates are essentially arbitrary). For example, one can plot the (restricted) log-likelihood as a function of each variance/correlation component in the model to make sure that each profile plot shows a clear peak at the corresponding ML/REML estimate. The \code{\link[=profile.rma.mv]{profile}} function can be used for this purpose. Finally, note that the model fitting is not done in a very efficient manner at the moment, which is partly a result of allowing for crossed random effects and correlations across the entire dataset (e.g., when using the \code{R} argument). As a result, the function works directly with the entire \mjeqn{k \times k}{kxk} (marginal) variance-covariance matrix of the observed effect sizes or outcomes (instead of working with smaller blocks in a block diagonal structure). As a result, model fitting can be slow for large \mjseqn{k}. However, when the variance-covariance structure is actually sparse, a lot of speed can be gained by setting \code{sparse=TRUE}, in which case sparse matrix objects are used (via the \href{https://cran.r-project.org/package=Matrix}{Matrix} package). Also, when model fitting appears to be slow, setting \code{verbose=TRUE} is useful to obtain information on how the model fitting is progressing. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Berkey, C. S., Hoaglin, D. C., Antczak-Bouckoms, A., Mosteller, F., & Colditz, G. A. (1998). Meta-analysis of multiple outcomes by regression with random effects. \emph{Statistics in Medicine}, \bold{17}(22), 2537--2550. \verb{https://doi.org/10.1002/(sici)1097-0258(19981130)17:22<2537::aid-sim953>3.0.co;2-c} Gleser, L. J., & Olkin, I. (2009). Stochastically dependent effect sizes. In H. Cooper, L. V. Hedges, & J. C. Valentine (Eds.), \emph{The handbook of research synthesis and meta-analysis} (2nd ed., pp. 357--376). New York: Russell Sage Foundation. van Houwelingen, H. C., Arends, L. R., & Stijnen, T. (2002). Advanced methods in meta-analysis: Multivariate approach and meta-regression. \emph{Statistics in Medicine}, \bold{21}(4), 589--624. \verb{https://doi.org/10.1002/sim.1040} Ishak, K. J., Platt, R. W., Joseph, L., Hanley, J. A., & Caro, J. J. (2007). Meta-analysis of longitudinal studies. \emph{Clinical Trials}, \bold{4}(5), 525--539. \verb{https://doi.org/10.1177/1740774507083567} Kalaian, H. A., & Raudenbush, S. W. (1996). A multivariate mixed linear model for meta-analysis. \emph{Psychological Methods}, \bold{1}(3), 227-235. \verb{https://doi.org/10.1037/1082-989X.1.3.227} Konstantopoulos, S. (2011). Fixed effects and variance components estimation in three-level meta-analysis. \emph{Research Synthesis Methods}, \bold{2}(1), 61--76. \verb{https://doi.org/10.1002/jrsm.35} Lajeunesse, M. J. (2011). On the meta-analysis of response ratios for studies with correlated and multi-group designs. \emph{Ecology}, \bold{92}(11), 2049--2055. \verb{https://doi.org/10.1890/11-0423.1} Nakagawa, S., & Santos, E. S. A. (2012). Methodological issues and advances in biological meta-analysis. \emph{Evolutionary Ecology}, \bold{26}(5), 1253--1274. \verb{https://doi.org/10.1007/s10682-012-9555-5} Pinheiro, J. C., & Bates, D. (2000). \emph{Mixed-effects models in S and S-PLUS}. New York: Springer. Steiger, J. H. (1980). Tests for comparing elements of a correlation matrix. \emph{Psychological Bulletin}, \bold{87}(2), 245--251. \verb{https://doi.org/10.1037/0033-2909.87.2.245} Salanti, G., Higgins, J. P. T., Ades, A. E., & Ioannidis, J. P. A. (2008). Evaluation of networks of randomized trials. \emph{Statistical Methods in Medical Research}, \bold{17}(3), 279--301. \verb{https://doi.org/10.1177/0962280207080643} Trikalinos, T. A., & Olkin, I. (2012). Meta-analysis of effect sizes reported at multiple time points: A multivariate approach. \emph{Clinical Trials}, \bold{9}(5), 610--620. \verb{https://doi.org/10.1177/1740774512453218} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Wei, Y., & Higgins, J. P. (2013). Estimating within-study covariances in multivariate meta-analysis with multiple outcomes. \emph{Statistics in Medicine}, \bold{32}(7), 1191--1205. \verb{https://doi.org/10.1002/sim.5679} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, and \code{\link{rma.glmm}} for other model fitting functions. } \examples{ ### calculate log odds ratios and corresponding sampling variances dat <- escalc(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) dat ### fit random-effects model using rma.uni() rma(yi, vi, data=dat) ### fit random-effects model using rma.mv() ### note: sigma^2 in this model is the same as tau^2 from the previous model rma.mv(yi, vi, random = ~ 1 | trial, data=dat) ### change data into long format dat.long <- to.long(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, append=FALSE) ### set levels of group variable ("exp" = experimental/vaccinated; "con" = control/non-vaccinated) levels(dat.long$group) <- c("exp", "con") ### set "con" to reference level dat.long$group <- relevel(dat.long$group, ref="con") ### calculate log odds and corresponding sampling variances dat.long <- escalc(measure="PLO", xi=out1, mi=out2, data=dat.long) dat.long ### fit bivariate random-effects model using rma.mv() res <- rma.mv(yi, vi, mods = ~ group, random = ~ group | study, struct="UN", data=dat.long) res } \keyword{models} metafor/man/matreg.Rd0000644000176200001440000003220314505063152014231 0ustar liggesusers\name{matreg} \alias{matreg} \title{Fit Regression Models based on Correlation and Covariance Matrices} \description{ Function to fit regression models based on correlation and covariance matrices. \loadmathjax } \usage{ matreg(y, x, R, n, V, cov=FALSE, means, ztor=FALSE, nearpd=FALSE, level=95, digits, \dots) } \arguments{ \item{y}{index (or name given as a character string) of the outcome variable.} \item{x}{indices (or names given as a character vector) of the predictor variables.} \item{R}{correlation or covariance matrix (or only the lower triangular part including the diagonal).} \item{n}{sample size based on which the elements in the correlation/covariance matrix were computed.} \item{V}{variance-covariance matrix of the lower triangular elements of the correlation/covariance matrix. Either \code{V} or \code{n} should be specified, not both. See \sQuote{Details}.} \item{cov}{logical to specify whether \code{R} is a covariance matrix (the default is \code{FALSE}).} \item{means}{optional vector to specify the means of the variables (only relevant when \code{cov=TRUE}).} \item{ztor}{logical to specify whether \code{R} is a matrix of r-to-z transformed correlations and hence should be back-transformed to raw correlations (the default is \code{FALSE}). See \sQuote{Details}.} \item{nearpd}{logical to specify whether the \code{\link[Matrix]{nearPD}} function from the \href{https://cran.r-project.org/package=Matrix}{Matrix} package should be used when the \mjeqn{R_{x,x}}{R[x,x]} matrix cannot be inverted. See \sQuote{Note}.} \item{level}{numeric value between 0 and 100 to specify the confidence interval level (the default is 95; see \link[=misc-options]{here} for details).} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded.} \item{\dots}{other arguments.} } \details{ Let \mjseqn{R} be a \mjeqn{p \times p}{pxp} correlation or covariance matrix. Let \mjseqn{y} denote the row/column of the outcome variable and \mjseqn{x} the row(s)/column(s) of the predictor variable(s) in this matrix. Let \mjeqn{R_{x,x}}{R[x,x]} and \mjeqn{R_{x,y}}{R[x,y]} denote the corresponding submatrices of \mjseqn{R}. Then \mjdeqn{b = R_{x,x}^{-1} R_{x,y}}{b = R[x,x]^(-1) R[x,y]} yields the standardized or raw regression coefficients (depending on whether \mjseqn{R} is a correlation or covariance matrix, respectively) when regressing the outcome variable on the predictor variable(s). The \mjseqn{R} matrix may be computed based on a single sample of \mjseqn{n} subjects. In this case, one should specify the sample size via argument \code{n}. The variance-covariance matrix of the standardized regression coefficients is then given by \mjeqn{\mbox{Var}[b] = \mbox{MSE} \times R_{x,x}^{-1}}{Var[b] = MSE * R[x,x]^(-1)}, where \mjeqn{\mbox{MSE} = (1 - b'R_{x,y}) / (n - m)}{MSE = (1 - b'R[x,y]) / (n -m)} and \mjseqn{m} denotes the number of predictor variables. The standard errors are then given by the square root of the diagonal elements of \mjeqn{\mbox{Var}[b]}{Var[b]}. Test statistics (in this case, t-statistics) and the corresponding p-values can then be computed as in a regular regression analysis. When \mjseqn{R} is a covariance matrix, one should set \code{cov=TRUE} and specify the means of the \mjseqn{p} variables via argument \code{means} to obtain raw regression coefficients including the intercept and corresponding standard errors. Alternatively, \mjseqn{R} may be the result of a meta-analysis of correlation coefficients. In this case, the elements in \mjseqn{R} are pooled correlation coefficients and the variance-covariance matrix of these pooled coefficients should be specified via argument \code{V}. The order of elements in \code{V} should correspond to the order of elements in the lower triangular part of \mjseqn{R} column-wise. For example, if \mjseqn{R} is a \mjeqn{4 \times 4}{4x4} matrix\ifelse{text}{,}{ of the form: \mjtdeqn{\left[ \begin{array}{cccc} 1 & & & \\\ r_{21} & 1 & & \\\ r_{31} & r_{32} & 1 & \\\ r_{41} & r_{42} & r_{43} & 1 \end{array} \right]}{\begin{bmatrix} 1 & & & \\\\\ r_{21} & 1 & & \\\\\ r_{31} & r_{32} & 1 & \\\\\ r_{41} & r_{42} & r_{43} & 1 \end{bmatrix}}{}} then the elements are \mjseqn{r_{21}}, \mjseqn{r_{31}}, \mjseqn{r_{41}}, \mjseqn{r_{32}}, \mjseqn{r_{42}}, and \mjseqn{r_{43}} and hence \code{V} should be a \mjeqn{6 \times 6}{6x6} variance-covariance matrix of these elements in this order. The variance-covariance matrix of the standardized regression coefficients (i.e., \mjeqn{\mbox{Var}[b]}{Var[b]}) is then computed as a function of \code{V} as described in Becker (1992) using the multivariate delta method. The standard errors are then again given by the square root of the diagonal elements of \mjeqn{\mbox{Var}[b]}{Var[b]}. Test statistics (in this case, z-statistics) and the corresponding p-values can then be computed in the usual manner. In case \mjseqn{R} is the result of a meta-analysis of Fisher r-to-z transformed correlation coefficients (and hence \code{V} is then the corresponding variance-covariance matrix of these pooled transformed coefficients), one should set argument \code{ztor=TRUE}, so that the appropriate back-transformation is then applied to \code{R} (and \code{V}) within the function. Finally, \mjseqn{R} may be a covariance matrix based on a meta-analysis (e.g., the estimated variance-covariance matrix of the random effects in a multivariate model). In this case, one should set \code{cov=TRUE} and \code{V} should again be the variance-covariance matrix of the elements in \mjseqn{R}, but now including the diagonal. Hence, if \mjseqn{R} is a \mjeqn{4 \times 4}{4x4} matrix\ifelse{text}{,}{ of the form: \mjtdeqn{\left[ \begin{array}{cccc} \tau_1^2 & & & \\\ \tau_{21} & \tau_2^2 & & \\\ \tau_{31} & \tau_{32} & \tau_3^2 & \\\ \tau_{41} & \tau_{42} & \tau_{43} & \tau_4^2 \end{array} \right]}{\begin{bmatrix} \tau_1^2 & & & \\\\\ \tau_{21} & \tau_2^2 & & \\\\\ \tau_{31} & \tau_{32} & \tau_3^2 & \\\\\ \tau_{41} & \tau_{42} & \tau_{43} & \tau_4^2 \end{bmatrix}}{}} then the elements are \mjseqn{\tau^2_1}, \mjseqn{\tau_{21}}, \mjseqn{\tau_{31}}, \mjseqn{\tau_{41}}, \mjseqn{\tau^2_2}, \mjseqn{\tau_{32}}, \mjseqn{\tau_{42}}, \mjseqn{\tau^2_3}, \mjseqn{\tau_{43}}, and \mjseqn{\tau^2_4}, and hence \code{V} should be a \mjeqn{10 \times 10}{10x10} variance-covariance matrix of these elements in this order. Argument \code{means} can then again be used to specify the means of the variables. } \value{ An object of class \code{"matreg"}. The object is a list containing the following components: \item{tab}{a data frame with the estimated model coefficients, standard errors, test statistics, degrees of freedom (only for t-tests), p-values, and lower/upper confidence interval bounds.} \item{vb}{the variance-covariance matrix of the estimated model coefficients.} \item{\dots}{some additional elements/values.} The results are formatted and printed with the \code{\link[=print.matreg]{print}} function. Extractor functions include \code{\link[=coef.matreg]{coef}} and \code{\link[=vcov.matreg]{vcov}}. } \note{ Only the lower triangular part of \code{R} (and \code{V} if it is specified) is used in the computations. If \mjeqn{R_{x,x}}{R[x,x]} is not invertible, an error will be issued. In this case, one can set argument \code{nearpd=TRUE}, in which case the \code{\link[Matrix]{nearPD}} function from the \href{https://cran.r-project.org/package=Matrix}{Matrix} package will be used to find the nearest positive semi-definite matrix, which should be invertible. The results should be treated with caution when this is done. When \mjseqn{R} is a covariance matrix with \code{V} and \code{means} specified, the means are treated as known constants when estimating the standard error of the intercept. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Becker, B. J. (1992). Using results from replicated studies to estimate linear models. \emph{Journal of Educational Statistics}, \bold{17}(4), 341--362. \verb{https://doi.org/10.3102/10769986017004341} Becker, B. J. (1995). Corrections to "Using results from replicated studies to estimate linear models". \emph{Journal of Educational and Behavioral Statistics}, \bold{20}(1), 100--102. \verb{https://doi.org/10.3102/10769986020001100} Becker, B. J., & Aloe, A. (2019). Model-based meta-analysis and related approaches. In H. Cooper, L. V. Hedges, & J. C. Valentine (Eds.), \emph{The handbook of research synthesis and meta-analysis} (3rd ed., pp. 339--363). New York: Russell Sage Foundation. } \seealso{ \code{\link{rma.mv}} for a function to meta-analyze multiple correlation coefficients that can be used to construct an \mjseqn{R} matrix. \code{\link{rcalc}} for a function to construct the variance-covariance matrix of dependent correlation coefficients. } \examples{ ############################################################################ ### first an example unrelated to meta-analysis, simply demonstrating that ### one can obtain the same results from lm() and matreg() ### fit a regression model with lm() to the 'mtcars' dataset res <- lm(mpg ~ hp + wt + am, data=mtcars) summary(res) ### covariance matrix of the dataset S <- cov(mtcars) ### fit the same regression model using matreg() res <- matreg(y="mpg", x=c("hp","wt","am"), R=S, cov=TRUE, means=colMeans(mtcars), n=nrow(mtcars)) summary(res) ### copy the 'mtcars' dataset to 'dat' and standardize all variables dat <- mtcars dat[] <- scale(dat) ### fit a regression model with lm() to obtain standardized regression coefficients ('betas') res <- lm(mpg ~ 0 + hp + wt + am, data=dat) summary(res) ### correlation matrix of the dataset R <- cor(mtcars) ### fit the same regression model using matreg() res <- matreg(y="mpg", x=c("hp","wt","am"), R=R, n=nrow(mtcars)) summary(res) ### note: the standard errors of the betas should not be used to construct CIs ### as they assume that the null hypothesis (H0: beta_j = 0) is true ### construct the var-cov matrix of correlations in R V <- rcalc(R, ni=nrow(mtcars))$V ### fit the same regression model using matreg() but now supply V res <- matreg(y="mpg", x=c("hp","wt","am"), R=R, V=V) summary(res) ### the standard errors computed in this way can now be used to construct ### CIs for the betas (here, the difference is relatively small) ############################################################################ ### copy data into 'dat' dat <- dat.craft2003 ### construct dataset and var-cov matrix of the correlations tmp <- rcalc(ri ~ var1 + var2 | study, ni=ni, data=dat) V <- tmp$V dat <- tmp$dat ### turn var1.var2 into a factor with the desired order of levels dat$var1.var2 <- factor(dat$var1.var2, levels=c("acog.perf", "asom.perf", "conf.perf", "acog.asom", "acog.conf", "asom.conf")) ### multivariate random-effects model res <- rma.mv(yi, V, mods = ~ var1.var2 - 1, random = ~ var1.var2 | study, struct="UN", data=dat) res ### restructure estimated mean correlations into a 4x4 matrix R <- vec2mat(coef(res)) rownames(R) <- colnames(R) <- c("perf", "acog", "asom", "conf") round(R, digits=3) ### check that order in vcov(res) corresponds to order in R round(vcov(res), digits=4) ### fit regression model with 'perf' as outcome and 'acog', 'asom', and 'conf' as predictors matreg(1, 2:4, R=R, V=vcov(res)) ### can also specify variable names matreg("perf", c("acog","asom","conf"), R=R, V=vcov(res)) \dontrun{ ### repeat the above but with r-to-z transformed correlations dat <- dat.craft2003 tmp <- rcalc(ri ~ var1 + var2 | study, ni=ni, data=dat, rtoz=TRUE) V <- tmp$V dat <- tmp$dat dat$var1.var2 <- factor(dat$var1.var2, levels=c("acog.perf", "asom.perf", "conf.perf", "acog.asom", "acog.conf", "asom.conf")) res <- rma.mv(yi, V, mods = ~ var1.var2 - 1, random = ~ var1.var2 | study, struct="UN", data=dat) R <- vec2mat(coef(res)) rownames(R) <- colnames(R) <- c("perf", "acog", "asom", "conf") matreg(1, 2:4, R=R, V=vcov(res), ztor=TRUE) } ############################################################################ ### a different example based on van Houwelingen et al. (2002) ### create dataset in long format dat.long <- to.long(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.colditz1994, append=FALSE) dat.long <- escalc(measure="PLO", xi=out1, mi=out2, data=dat.long) levels(dat.long$group) <- c("CON", "EXP") dat.long ### fit bivariate model res <- rma.mv(yi, vi, mods = ~ group - 1, random = ~ group | study, struct="UN", data=dat.long, method="ML") res ### regression of log(odds)_EXP on log(odds)_CON matreg(y=2, x=1, R=res$G, cov=TRUE, means=coef(res), n=res$g.levels.comb.k) ### but the SE of the CON coefficient is not computed correctly, since above we treat res$G as if ### it was a var-cov matrix computed from raw data based on res$g.levels.comb.k (= 13) data points ### fit bivariate model and get the var-cov matrix of the estimates in res$G res <- rma.mv(yi, vi, mods = ~ group - 1, random = ~ group | study, struct="UN", data=dat.long, method="ML", cvvc="varcov", control=list(nearpd=TRUE)) ### now use res$vvc as the var-cov matrix of the estimates in res$G matreg(y=2, x=1, R=res$G, cov=TRUE, means=coef(res), V=res$vvc) } \keyword{models} metafor/man/profile.rma.Rd0000644000176200001440000003160614505063152015176 0ustar liggesusers\name{profile.rma} \alias{profile} \alias{profile.rma} \alias{profile.rma.uni} \alias{profile.rma.mv} \alias{profile.rma.uni.selmodel} \alias{profile.rma.ls} \alias{print.profile.rma} \alias{plot.profile.rma} \title{Profile Likelihood Plots for 'rma' Objects} \description{ Functions to profile the (restricted) log-likelihood for objects of class \code{"rma.uni"}, \code{"rma.mv"}, \code{"rma.uni.selmodel"}, and \code{"rma.ls"}. \loadmathjax } \usage{ \method{profile}{rma.uni}(fitted, xlim, ylim, steps=20, lltol=1e-03, progbar=TRUE, parallel="no", ncpus=1, cl, plot=TRUE, pch=19, refline=TRUE, cline=FALSE, \dots) \method{profile}{rma.mv}(fitted, sigma2, tau2, rho, gamma2, phi, xlim, ylim, steps=20, lltol=1e-03, progbar=TRUE, parallel="no", ncpus=1, cl, plot=TRUE, pch=19, refline=TRUE, cline=FALSE, \dots) \method{profile}{rma.uni.selmodel}(fitted, tau2, delta, xlim, ylim, steps=20, lltol=1e-03, progbar=TRUE, parallel="no", ncpus=1, cl, plot=TRUE, pch=19, refline=TRUE, cline=FALSE, \dots) \method{profile}{rma.ls}(fitted, alpha, xlim, ylim, steps=20, lltol=1e-03, progbar=TRUE, parallel="no", ncpus=1, cl, plot=TRUE, pch=19, refline=TRUE, cline=FALSE, \dots) \method{print}{profile.rma}(x, \dots) \method{plot}{profile.rma}(x, xlim, ylim, pch=19, xlab, ylab, main, refline=TRUE, cline=FALSE, \dots) } \arguments{ \item{fitted}{an object of class \code{"rma.uni"}, \code{"rma.mv"}, \code{"rma.uni.selmodel"}, or \code{"rma.ls"}.} \item{x}{an object of class \code{"profile.rma"} (for \code{plot} and \code{print}).} \item{sigma2}{optional integer to specify for which \mjseqn{\sigma^2} value the likelihood should be profiled.} \item{tau2}{optional integer to specify for which \mjseqn{\tau^2} value the likelihood should be profiled.} \item{rho}{optional integer to specify for which \mjseqn{\rho} value the likelihood should be profiled.} \item{gamma2}{optional integer to specify for which \mjseqn{\gamma^2} value the likelihood should be profiled.} \item{phi}{optional integer to specify for which \mjseqn{\phi} value the likelihood should be profiled.} \item{delta}{optional integer to specify for which \mjseqn{\delta} value the likelihood should be profiled.} \item{alpha}{optional integer to specify for which \mjseqn{\alpha} value the likelihood should be profiled.} \item{xlim}{optional vector to specify the lower and upper limit of the parameter over which the profiling should be done. If unspecified, the function sets these limits automatically.} \item{ylim}{optional vector to specify the y-axis limits when plotting the profiled likelihood. If unspecified, the function sets these limits automatically.} \item{steps}{number of points between \code{xlim[1]} and \code{xlim[2]} (inclusive) for which the likelihood should be evaluated (the default is 20).} \item{lltol}{numerical tolerance used when comparing values of the profiled log-likelihood with the log-likelihood of the fitted model (the default is 1e-03).} \item{progbar}{logical to specify whether a progress bar should be shown (the default is \code{TRUE}).} \item{parallel}{character string to specify whether parallel processing should be used (the default is \code{"no"}). For parallel processing, set to either \code{"snow"} or \code{"multicore"}. See \sQuote{Details}.} \item{ncpus}{integer to specify the number of processes to use in the parallel processing.} \item{cl}{optional cluster to use if \code{parallel="snow"}. If unspecified, a cluster on the local machine is created for the duration of the call.} \item{plot}{logical to specify whether the profile plot should be drawn after profiling is finished (the default is \code{TRUE}).} \item{pch}{plotting symbol to use. By default, a filled circle is used. See \code{\link{points}} for other options.} \item{refline}{logical to specify whether the value of the parameter estimate should be indicated by a dotted vertical line and its log-likelihood value by a dotted horizontal line (the default is \code{TRUE}).} \item{cline}{logical to specify whether a horizontal reference line should be added to the plot that indicates the log-likelihood value corresponding to the 95\% profile confidence interval (the default is \code{FALSE}).} \item{xlab}{title for the x-axis. If unspecified, the function sets an appropriate axis title.} \item{ylab}{title for the y-axis. If unspecified, the function sets an appropriate axis title.} \item{main}{title for the plot. If unspecified, the function sets an appropriate title.} \item{\dots}{other arguments.} } \details{ The function fixes a particular parameter of the model and then computes the maximized (restricted) log-likelihood over the remaining parameters of the model. By doing this for a range of values for the parameter that was fixed, a profile of the (restricted) log-likelihood is constructed. \subsection{Selecting the Parameter(s) to Profile}{ The parameters that can be profiled depend on the model object: \itemize{ \item For objects of class \code{"rma.uni"} obtained with the \code{\link{rma.uni}} function, the function profiles over \mjseqn{\tau^2} (not for equal-effects models). \item For objects of class \code{"rma.mv"} obtained with the \code{\link{rma.mv}} function, profiling is done by default over all (non-fixed) variance and correlation components of the model. Alternatively, one can use the \code{sigma2}, \code{tau2}, \code{rho}, \code{gamma2}, or \code{phi} arguments to specify over which parameter the profiling should be done. Only one of these arguments can be used at a time. A single integer is used to specify the number of the parameter. \item For selection model objects of class \code{"rma.uni.selmodel"} obtained with the \code{\link{selmodel}} function, profiling is done by default over \mjseqn{\tau^2} (for models where this is an estimated parameter) and all (non-fixed) selection model parameters. Alternatively, one can choose to profile only \mjseqn{\tau^2} by setting \code{tau2=TRUE} or one can select one of the selection model parameters to profile by specifying its number via the \code{delta} argument. \item For location-scale model objects of class \code{"rma.ls"} obtained with the \code{\link{rma.uni}} function, profiling is done by default over all (non-fixed) \mjseqn{\alpha} parameters that are part of the scale model. } } \subsection{Interpreting a Likelihood Profile}{ A profile plot should show a single peak at the corresponding ML/REML estimate (assuming that the model was fitted with ML/REML estimation). If \code{refline=TRUE} (the default), the value of the parameter estimate is indicated by a dotted vertical line and its log-likelihood value by a dotted horizontal line. Hence, the intersection of these two lines should correspond to the peak. When profiling a variance component (or some other parameter that cannot be negative), the peak may be at zero (if this corresponds to the ML/REML estimate of the parameter). In this case, the profiled log-likelihood should be a monotonically decreasing function of the parameter. If the profiled log-likelihood has multiple peaks, this indicates that the likelihood surface is not unimodal. In such cases, the ML/REML estimate may correspond to a local optimum (when the intersection of the two dotted lines is not at the highest peak). If the profile is flat (over the entire parameter space or large portions of it), then this suggests that at least some of the parameters of the model are not identifiable (and the parameter estimates obtained are to some extent arbitrary). See Raue et al. (2009) for some further discussion of parameter identifiability (structurally and practically) and the use of profile likelihoods to check for this. The function checks whether any profiled log-likelihood value is actually larger than the log-likelihood of the fitted model (using a numerical tolerance of \code{lltol}). If so, a warning is issued as this might indicate that the optimizer did not identify the actual ML/REML estimate. } \subsection{Parallel Processing}{ Profiling requires repeatedly refitting the model, which can be slow when \mjseqn{k} is large and/or the model is complex (the latter especially applies to \code{"rma.mv"} objects and also to certain \code{"rma.uni.selmodel"} or \code{"rma.ls"} objects). On machines with multiple cores, one can try to speed things up by delegating the model fitting to separate worker processes, that is, by setting \code{parallel="snow"} or \code{parallel="multicore"} and \code{ncpus} to some value larger than 1. Parallel processing makes use of the \code{\link[parallel]{parallel}} package, using the \code{\link[parallel]{makePSOCKcluster}} and \code{\link[parallel]{parLapply}} functions when \code{parallel="snow"} or using \code{\link[parallel]{mclapply}} when \code{parallel="multicore"} (the latter only works on Unix/Linux-alikes). With \code{parallel::detectCores()}, one can check on the number of available cores on the local machine. } } \value{ An object of class \code{"profile.rma"}. The object is a list (or list of such lists) containing the following components: One of the following (depending on the parameter that was actually profiled): \item{sigma2}{values of \mjseqn{\sigma^2} over which the likelihood was profiled.} \item{tau2}{values of \mjseqn{\tau^2} over which the likelihood was profiled.} \item{rho}{values of \mjseqn{\rho} over which the likelihood was profiled.} \item{gamma2}{values of \mjseqn{\gamma^2} over which the likelihood was profiled.} \item{phi}{values of \mjseqn{\phi} over which the likelihood was profiled.} \item{delta}{values of \mjseqn{\delta} over which the likelihood was profiled.} \item{alpha}{values of \mjseqn{\alpha} over which the likelihood was profiled.} In addition, the following components are included: \item{ll}{(restricted) log-likelihood values at the corresponding parameter values.} \item{beta}{a matrix with the estimated model coefficients at the corresponding parameter values.} \item{ci.lb}{a matrix with the lower confidence interval bounds of the model coefficients at the corresponding parameter values.} \item{ci.ub}{a matrix with the upper confidence interval bounds of the model coefficients at the corresponding parameter values.} \item{\dots}{some additional elements/values.} Note that the list is returned invisibly. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Raue, A., Kreutz, C., Maiwald, T., Bachmann, J., Schilling, M., Klingmuller, U., & Timmer, J. (2009). Structural and practical identifiability analysis of partially observed dynamical models by exploiting the profile likelihood. \emph{Bioinformatics}, \bold{25}(15), 1923--1929. \verb{https://doi.org/10.1093/bioinformatics/btp358} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W., & \enc{López-López}{Lopez-Lopez}, J. A. (2022). Location-scale models for meta-analysis. \emph{Research Synthesis Methods}. \bold{13}(6), 697--715. \verb{https://doi.org/10.1002/jrsm.1562} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mv}}, and \code{\link[=selmodel.rma.uni]{selmodel}} for functions to fit models for which profile likelihood plots can be drawn. \code{\link[=confint.rma]{confint}} for functions to compute corresponding profile likelihood confidence intervals. } \examples{ ### calculate log odds ratios and corresponding sampling variances dat <- escalc(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit random-effects model using rma.uni() res <- rma(yi, vi, data=dat) ### profile over tau^2 profile(res, progbar=FALSE) ### change data into long format dat.long <- to.long(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, append=FALSE) ### set levels of group variable ("exp" = experimental/vaccinated; "con" = control/non-vaccinated) levels(dat.long$group) <- c("exp", "con") ### set "con" to reference level dat.long$group <- relevel(dat.long$group, ref="con") ### calculate log odds and corresponding sampling variances dat.long <- escalc(measure="PLO", xi=out1, mi=out2, data=dat.long) dat.long ### fit bivariate random-effects model using rma.mv() res <- rma.mv(yi, vi, mods = ~ group, random = ~ group | study, struct="UN", data=dat.long) res ### profile over tau^2_1, tau^2_2, and rho ### note: for rho, adjust region over which profiling is done ('zoom in' on area around estimate) \dontrun{ par(mfrow=c(2,2)) profile(res, tau2=1) profile(res, tau2=2) profile(res, rho=1, xlim=c(0.90, 0.98)) } ### an example where the peak of the likelihood profile is at 0 dat <- escalc(measure="RD", n1i=n1i, n2i=n2i, ai=ai, ci=ci, data=dat.hine1989) res <- rma(yi, vi, data=dat) par(mfrow=c(1,1)) profile(res, progbar=FALSE) } \keyword{hplot} metafor/man/conv.delta.Rd0000644000176200001440000003237414505063152015020 0ustar liggesusers\name{conv.delta} \alias{conv.delta} \title{Transform Observed Effect Sizes or Outcomes and their Sampling Variances using the Delta Method} \description{ Function to transform observed effect sizes or outcomes and their sampling variances using the delta method. \loadmathjax } \usage{ conv.delta(yi, vi, ni, data, include, transf, var.names, append=TRUE, replace="ifna", \dots) } \arguments{ \item{yi}{vector with the observed effect sizes or outcomes.} \item{vi}{vector with the corresponding sampling variances.} \item{ni}{vector with the total sample sizes of the studies.} \item{data}{optional data frame containing the variables given to the arguments above.} \item{include}{optional (logical or numeric) vector to specify the subset of studies for which the transformation should be carried out.} \item{transf}{a function which should be used for the transformation.} \item{var.names}{character vector with two elements to specify the name of the variable for the transformed effect sizes or outcomes and the name of the variable for the corresponding sampling variances (if \code{data} is an object of class \code{"escalc"}, the \code{var.names} are taken from the object; otherwise the defaults are \code{"yi"} and \code{"vi"}).} \item{append}{logical to specify whether the data frame provided via the \code{data} argument should be returned together with the estimated values (the default is \code{TRUE}).} \item{replace}{character string or logical to specify how values in \code{var.names} should be replaced (only relevant when using the \code{data} argument and if variables in \code{var.names} already exist in the data frame). See the \sQuote{Value} section for more details.} \item{\dots}{other arguments for the transformation function.} } \details{ The \code{\link{escalc}} function can be used to compute a wide variety of effect sizes or \sQuote{outcome measures}. In some cases, it may be necessary to transform one type of measure to another. The present function provides a general method for doing so via the \href{https://en.wikipedia.org/wiki/Delta_method}{delta method}, which briefly works as follows. Let \mjseqn{y_i} denote the observed effect size or outcome for a particular study and \mjseqn{v_i} the corresponding sampling variance. Then \mjseqn{f(y_i)} will be the transformed effect size or outcome, where \mjeqn{f(\cdot)}{f(.)} is the function specified via the \code{transf} argument. The sampling variance of the transformed effect size or outcome is then computed with \mjseqn{v_i \times f'(y_i)^2}, where \mjseqn{f'(y_i)} denotes the derivative of \mjeqn{f(\cdot)}{f(.)} evaluated at \mjseqn{y_i}. The present function computes the derivative numerically using the \code{\link[numDeriv]{grad}} function from the \code{numDeriv} package. The value of the observed effect size or outcome should be the first argument of the function specified via \code{transf}. The function can have additional arguments, which can be specified via the \dots argument. However, due to the manner in which these additional arguments are evaluated, they cannot have names that match one of the arguments of the \code{\link[numDeriv]{grad}} function (an error will be issued if such a naming clash is detected). Optionally, one can use the \code{ni} argument to supply the total sample sizes of the studies. This has no relevance for the calculations done by the present function, but some other functions may use this information (e.g., when drawing a funnel plot with the \code{\link{funnel}} function and one adjusts the \code{yaxis} argument to one of the options that puts the sample sizes or some transformation thereof on the y-axis). } \value{ If the \code{data} argument was not specified or \code{append=FALSE}, a data frame of class \code{c("escalc","data.frame")} with two variables called \code{var.names[1]} (by default \code{"yi"}) and \code{var.names[2]} (by default \code{"vi"}) with the transformed observed effect sizes or outcomes and the corresponding sampling variances (computed as described above). If \code{data} was specified and \code{append=TRUE}, then the original data frame is returned. If \code{var.names[1]} is a variable in \code{data} and \code{replace="ifna"} (or \code{replace=FALSE}), then only missing values in this variable are replaced with the transformed observed effect sizes or outcomes (where possible) and otherwise a new variable called \code{var.names[1]} is added to the data frame. Similarly, if \code{var.names[2]} is a variable in \code{data} and \code{replace="ifna"} (or \code{replace=FALSE}), then only missing values in this variable are replaced with the sampling variances calculated as described above (where possible) and otherwise a new variable called \code{var.names[2]} is added to the data frame. If \code{replace="all"} (or \code{replace=TRUE}), then all values in \code{var.names[1]} and \code{var.names[2]} are replaced, even for cases where the value in \code{var.names[1]} and \code{var.names[2]} is not missing. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{escalc}} for a function to compute various effect size measures. } \examples{ ############################################################################ ### the following examples illustrate that the use of the delta method (with numeric derivatives) ### yields essentially identical results as the analytic calculations that are done by escalc() ### compute logit transformed proportions and corresponding sampling variances for two studies escalc(measure="PLO", xi=c(5,12), ni=c(40,80)) ### compute raw proportions and corresponding sampling variances for the two studies dat <- escalc(measure="PR", xi=c(5,12), ni=c(40,80)) dat ### apply the logit transformation (note: this yields the same values as above with measure="PLO") conv.delta(dat$yi, dat$vi, transf=transf.logit) ### using the 'data' argument conv.delta(yi, vi, data=dat, transf=transf.logit, var.names=c("yi.t","vi.t")) ### or replace the existing 'yi' and 'vi' values conv.delta(yi, vi, data=dat, transf=transf.logit, replace="all") ###################################### ### use escalc() with measure D2ORN which transforms standardized mean differences (computed ### from means and standard deviations) into the corresponding log odds ratios escalc(measure="D2ORN", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat.normand1999) ### use escalc() to compute standardized mean differences (without the usual bias correction) and ### then apply the same transformation to the standardized mean differences dat <- escalc(measure="SMD", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat.normand1999, correct=FALSE) conv.delta(yi, vi, data=dat, transf=transf.dtolnor.norm, replace="all") ###################################### ### an example where the transformation function takes additional arguments ### use escalc() with measure RPB which transforms standardized mean differences (computed ### from means and standard deviations) into the corresponding point-biserial correlations escalc(measure="RPB", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat.normand1999) ### use escalc() to compute standardized mean differences (without the usual bias correction) and ### then apply the same transformation to the standardized mean differences dat <- escalc(measure="SMD", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat.normand1999, correct=FALSE) conv.delta(yi, vi, data=dat, transf=transf.dtorpb, n1i=n1i, n2i=n2i, replace="all") ############################################################################ ### a more elaborate example showing how this function could be used in the data ### preparation steps for a meta-analysis of standardized mean differences (SMDs) dat <- data.frame(study=1:6, m1i=c(2.03,NA,NA,NA,NA,NA), sd1i=c(0.95,NA,NA,NA,NA,NA), n1i=c(32,95,145,NA,NA,NA), m2i=c(1.25,NA,NA,NA,NA,NA), sd2i=c(1.04,NA,NA,NA,NA,NA), n2i=c(30,99,155,NA,NA,NA), tval=c(NA,2.12,NA,NA,NA,NA), dval=c(NA,NA,0.37,NA,NA,NA), ai=c(NA,NA,NA,26,NA,NA), bi=c(NA,NA,NA,58,NA,NA), ci=c(NA,NA,NA,11,NA,NA), di=c(NA,NA,NA,74,NA,NA), or=c(NA,NA,NA,NA,2.56,NA), lower=c(NA,NA,NA,NA,1.23,NA), upper=c(NA,NA,NA,NA,5.30,NA), corr=c(NA,NA,NA,NA,NA,.32), ntot=c(NA,NA,NA,NA,NA,86)) dat ### study types: ### 1) reports means and SDs so that the SMD can be directly calculated ### 2) reports the t-statistic from an independent samples t-test (and group sizes) ### 3) reports the standardized mean difference directly (and group sizes) ### 4) dichotomized the continuous dependent variable and reports the resulting 2x2 table ### 5) dichotomized the continuous dependent variable and reports an odds ratio with 95% CI ### 6) treated the group variable continuously and reports a Pearson product-moment correlation ### use escalc() to directly compute the SMD and its variance for studies 1, 2, and 3 dat <- escalc(measure="SMD", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, ti=tval, di=dval, data=dat) dat ### use escalc() with measure OR2DN to compute the SMD value for study 4 dat <- escalc(measure="OR2DN", ai=ai, bi=bi, ci=ci, di=di, data=dat, replace=FALSE) dat ### use conv.wald() to convert the OR and CI into the log odds ratio and its variance for study 5 dat <- conv.wald(out=or, ci.lb=lower, ci.ub=upper, data=dat, transf=log, var.names=c("lnor","vlnor")) dat ### use conv.delta() to transform the log odds ratio into the SMD value for study 5 dat <- conv.delta(lnor, vlnor, data=dat, transf=transf.lnortod.norm, var.names=c("yi","vi")) dat ### remove the lnor and vlnor variables (no longer needed) dat$lnor <- NULL dat$vlnor <- NULL ### use escalc() with measure COR to compute the sampling variance of ri for study 6 dat <- escalc(measure="COR", ri=corr, ni=ntot, data=dat, var.names=c("ri","vri")) dat ### use conv.delta() to transform the correlation into the SMD value for study 6 dat <- conv.delta(ri, vri, data=dat, transf=transf.rtod, var.names=c("yi","vi")) dat ### remove the ri and vri variables (no longer needed) dat$ri <- NULL dat$vri <- NULL ### now variable 'yi' is complete with the SMD values for all studies dat ### fit an equal-effects model to the SMD values rma(yi, vi, data=dat, method="EE") ############################################################################ ### a more elaborate example showing how this function could be used in the data ### preparation steps for a meta-analysis of correlation coefficients dat <- data.frame(study=1:6, ri=c(.42,NA,NA,NA,NA,NA), tval=c(NA,2.85,NA,NA,NA,NA), phi=c(NA,NA,NA,0.27,NA,NA), ni=c(93,182,NA,112,NA,NA), ai=c(NA,NA,NA,NA,61,NA), bi=c(NA,NA,NA,NA,36,NA), ci=c(NA,NA,NA,NA,39,NA), di=c(NA,NA,NA,NA,57,NA), or=c(NA,NA,NA,NA,NA,1.86), lower=c(NA,NA,NA,NA,NA,1.12), upper=c(NA,NA,NA,NA,NA,3.10), m1i=c(NA,NA,54.1,NA,NA,NA), sd1i=c(NA,NA,5.79,NA,NA,NA), n1i=c(NA,NA,66,75,NA,NA), m2i=c(NA,NA,51.7,NA,NA,NA), sd2i=c(NA,NA,6.23,NA,NA,NA), n2i=c(NA,NA,65,88,NA,NA)) dat ### study types: ### 1) reports the correlation coefficient directly ### 2) reports the t-statistic from a t-test of H0: rho = 0 ### 3) dichotomized one variable and reports means and SDs for the two corresponding groups ### 4) reports the phi coefficient, marginal counts, and total sample size ### 5) dichotomized both variables and reports the resulting 2x2 table ### 6) dichotomized both variables and reports an odds ratio with 95% CI ### use escalc() to directly compute the correlation and its variance for studies 1 and 2 dat <- escalc(measure="COR", ri=ri, ni=ni, ti=tval, data=dat) dat ### use escalc() with measure RBIS to compute the biserial correlation for study 3 dat <- escalc(measure="RBIS", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat, replace=FALSE) dat ### use conv.2x2() to reconstruct the 2x2 table for study 4 dat <- conv.2x2(ri=phi, ni=ni, n1i=n1i, n2i=n2i, data=dat) dat ### use escalc() with measure RTET to compute the tetrachoric correlation for studies 4 and 5 dat <- escalc(measure="RTET", ai=ai, bi=bi, ci=ci, di=di, data=dat, replace=FALSE) dat ### use conv.wald() to convert the OR and CI into the log odds ratio and its variance for study 6 dat <- conv.wald(out=or, ci.lb=lower, ci.ub=upper, data=dat, transf=log, var.names=c("lnor","vlnor")) dat ### use conv.delta() to estimate the tetrachoric correlation from the log odds ratio for study 6 dat <- conv.delta(lnor, vlnor, data=dat, transf=transf.lnortortet.pearson, var.names=c("yi","vi")) dat ### remove the lnor and vlnor variables (no longer needed) dat$lnor <- NULL dat$vlnor <- NULL ### now variable 'yi' is complete with the correlations for all studies dat ### fit an equal-effects model to the correlations rma(yi, vi, data=dat, method="EE") ############################################################################ } \keyword{manip} metafor/man/llplot.Rd0000644000176200001440000001400514505063152014260 0ustar liggesusers\name{llplot} \alias{llplot} \title{Plot of Likelihoods for Individual Studies} \description{ Function to plot the likelihood of a certain parameter corresponding to an effect size or outcome measure given the study data. \loadmathjax } \usage{ llplot(measure, yi, vi, sei, ai, bi, ci, di, n1i, n2i, data, subset, drop00=TRUE, xvals=1000, xlim, ylim, xlab, ylab, scale=TRUE, lty, lwd, col, level=99.99, refline=0, \dots) } \arguments{ \item{measure}{a character string to specify for which effect size or outcome measure the likelihoods should be calculated. See \sQuote{Details} for possible options and how the data should then be specified.} \item{yi}{vector with the observed effect sizes or outcomes.} \item{vi}{vector with the corresponding sampling variances.} \item{sei}{vector to specify the corresponding standard.} \item{ai}{vector to specify the \mjeqn{2 \times 2}{2x2} table frequencies (upper left cell).} \item{bi}{vector to specify the \mjeqn{2 \times 2}{2x2} table frequencies (upper right cell).} \item{ci}{vector to specify the \mjeqn{2 \times 2}{2x2} table frequencies (lower left cell).} \item{di}{vector to specify the \mjeqn{2 \times 2}{2x2} table frequencies (lower right cell).} \item{n1i}{vector to specify the group sizes or row totals (first group/row).} \item{n2i}{vector to specify the group sizes or row totals (second group/row).} \item{data}{optional data frame containing the variables given to the arguments above.} \item{subset}{optional (logical or numeric) vector to specify the subset of studies that should be included in the plot.} \item{drop00}{logical to specify whether studies with no cases (or only cases) in both groups should be dropped. See \sQuote{Details}.} \item{xvals}{integer to specify for how many distinct values the likelihood should be evaluated.} \item{xlim}{x-axis limits. If unspecified, the function sets the x-axis limits to some sensible values.} \item{ylim}{y-axis limits. If unspecified, the function sets the y-axis limits to some sensible values.} \item{xlab}{title for the x-axis. If unspecified, the function sets an appropriate axis title.} \item{ylab}{title for the y-axis. If unspecified, the function sets an appropriate axis title.} \item{scale}{logical to specify whether the likelihood values should be scaled, so that the total area under each curve is (approximately) equal to 1.} \item{lty}{the line types (either a single value or a vector of length \mjseqn{k}). If unspecified, the function sets the line types according to some characteristics of the likelihood function. See \sQuote{Details}.} \item{lwd}{the line widths (either a single value or a vector of length \mjseqn{k}). If unspecified, the function sets the widths according to the sampling variances (so that the line is thicker for more precise studies and vice-versa).} \item{col}{the line colors (either a single value or a vector of length \mjseqn{k}). If unspecified, the function uses various shades of gray according to the sampling variances (so that darker shades are used for more precise studies and vice-versa).} \item{level}{numeric value between 0 and 100 to specify the plotting limits for each likelihood line in terms of the confidence interval (the default is 99.99).} \item{refline}{numeric value to specify the location of the vertical \sQuote{reference} line (the default is 0). The line can be suppressed by setting this argument to \code{NA}.} \item{\dots}{other arguments.} } \details{ At the moment, the function only accepts \code{measure="GEN"} or \code{measure="OR"}. For \code{measure="GEN"}, one must specify arguments \code{yi} for the observed effect sizes or outcomes and \code{vi} for the corresponding sampling variances (instead of specifying \code{vi}, one can specify the standard errors via the \code{sei} argument). The function then plots the likelihood of the true effect size or outcome based on a normal sampling distribution with observed outcome as given by \code{yi} and variance as given by \code{vi} for each study. For \code{measure="OR"}, one must specify arguments \code{ai}, \code{bi}, \code{ci}, and \code{di}, which denote the cell frequencies of the \mjeqn{2 \times 2}{2x2} tables. Alternatively, one can specify \code{ai}, \code{ci}, \code{n1i}, and \code{n2i}. See \code{\link{escalc}} function for more details. The function then plots the likelihood of the true log odds ratio based on the non-central hypergeometric distribution for each \mjeqn{2 \times 2}{2x2} table. Since studies with no cases (or only cases) in both groups have a flat likelihood and are not informative about the odds ratio, they are dropped by default (i.e., \code{drop00=TRUE}) and are hence not drawn (if \code{drop00=FALSE}, these likelihood are indicated by dotted lines). For studies that have a single zero count, the MLE of the odds ratio is infinite and these likelihoods are indicated by dashed lines. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ van Houwelingen, H. C., Zwinderman, K. H., & Stijnen, T. (1993). A bivariate approach to meta-analysis. \emph{Statistics in Medicine}, \bold{12}(24), 2273--2284. \verb{https://doi.org/10.1002/sim.4780122405} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}} and \code{\link{rma.glmm}} for model fitting functions that are based on corresponding likelihood functions. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### draw likelihoods llplot(measure="GEN", yi=yi, vi=vi, data=dat, lwd=1, refline=NA, xlim=c(-3,2)) ### create plot (Figure 2 in van Houwelingen, Zwinderman, & Stijnen, 1993) llplot(measure="OR", ai=b.xci, n1i=nci, ci=b.xti, n2i=nti, data=dat.collins1985a, lwd=1, refline=NA, xlim=c(-4,4), drop00=FALSE) } \keyword{hplot} metafor/man/plot.vif.rma.Rd0000644000176200001440000001025514505063152015274 0ustar liggesusers\name{plot.vif.rma} \alias{plot.vif.rma} \title{Plot Method for 'vif.rma' Objects} \description{ Plot method for objects of class \code{"vif.rma"}. } \usage{ \method{plot}{vif.rma}(x, breaks="Scott", freq=FALSE, col, border, col.out, col.density, trim=0, adjust=1, lwd=c(2,0), layout, \dots) } \arguments{ \item{x}{an object of class \code{"vif.rma"} obtained with \code{\link[=vif.rma]{vif}}.} \item{breaks}{argument to be passed on to the corresponding argument of \code{\link{hist}} to set (the method for determining) the (number of) breakpoints.} \item{freq}{logical to indicate whether frequencies or probability densities should be plotted (the default is \code{FALSE} to plot densities).} \item{col}{optional character string to specify the color of the histogram bars.} \item{border}{optional character string to specify the color of the borders around the bars.} \item{col.out}{optional character string to specify the color of the bars that are more extreme than the observed (G)VIF value (the default is a semi-transparent shade of red).} \item{col.density}{optional character string to specify the color of the kernel density estimate of the distribution that is superimposed on top of the histogram (the default is blue).} \item{trim}{the fraction (up to 0.5) of observations to be trimmed from the upper tail of each distribution before its histogram is plotted.} \item{adjust}{numeric value to be passed on to the corresponding argument of \code{\link{density}} (for adjusting the bandwidth of the kernel density estimate).} \item{lwd}{numeric vector to specify the width of the vertical lines corresponding to the value of the observed (G)VIFs and of the density estimate (note: by default, the density estimate has a line width of 0 and is therefore not plotted).} \item{layout}{optional vector of two numbers to specify the number of rows and columns for the layout of the figure.} \item{\dots}{other arguments.} } \details{ The function plots the distribution of each (G)VIF as simulated under independence as a histogram. Arguments \code{breaks}, \code{freq}, \code{col}, and \code{border} are passed on to the \code{\link{hist}} function for the plotting. Argument \code{trim} can be used to trim away a certain fraction of observations from the upper tail of each distribution before its histogram is plotted. By setting this to a value above 0, one can quickly remove some of the extreme values that might lead to the bulk of the distribution getting squished together at the left (typically, a small value such as \code{trim=0.01} is sufficient for this purpose). The observed (G)VIF value is indicated as a vertical dashed line. If the observed exceeds the upper plot limit, then this is indicated by an arrow pointing to the line. Argument \code{col.out} is used to specify the color for the bars in the histogram that are more extreme than the observed (G)VIF value. A kernel density estimate of the distribution can be superimposed on top of the histogram (as a smoothed representation of the distribution). Note that the kernel density estimate of the distribution is only shown when setting the line width for this element greater than 0 via the \code{lwd} argument (e.g., \code{lwd=c(2,2)}). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link[=vif.rma]{vif}} for the function to create \code{vif.rma} objects. } \examples{ ### copy data from Bangert-Drowns et al. (2004) into 'dat' dat <- dat.bangertdrowns2004 ### fit mixed-effects meta-regression model res <- rma(yi, vi, mods = ~ length + wic + feedback + info + pers + imag + meta, data=dat) ### use the simulation approach to analyze the size of the VIFs \dontrun{ vifs <- vif(res, sim=TRUE, seed=1234) vifs ### plot the simulated distributions of the VIFs plot(vifs) ### add densities, trim away some extremes, and set break points plot(vifs, lwd=c(2,2), trim=0.01, breaks=seq(1,2.2,by=0.05), adjust=1.5) } } \keyword{hplot} metafor/man/misc-models.Rd0000644000176200001440000003665114505063152015201 0ustar liggesusers\name{misc-models} \alias{misc-models} \alias{misc_models} \title{Fixed-Effects and Random-Effects Models in Meta-Analysis \loadmathjax} \description{ Books and articles about meta-analysis often describe and discuss the difference between the so-called \sQuote{fixed-effects model} and the \sQuote{random-effects model} (e.g., Cooper et al., 2009). The former term is (mostly) avoided throughout the documentation of the \pkg{metafor} package. The term \sQuote{equal-effects model} is used instead, since it more concretely describes the main assumption underlying this model (i.e., that the underlying true effects/outcomes are homogeneous, or in other words, that they are all equal to each other). The terms \sQuote{common-effect(s) model} or \sQuote{homogenous-effect(s) model} have also sometimes been used in the literature to describe this model and are equally descriptive. Moreover, the term \sQuote{fixed-effects model} creates a bit of a conundrum. When authors use this term, they are really typically referring to the equal-effects model. There is however another type of model, the \sQuote{real} fixed-effects model, that is different from the equal-effects model, but now we would need to invent (unnecessarily) a different term to refer to this model. Some have done so or tried to make a distinction between the \sQuote{fixed-effect model} (without the s!) and the \sQuote{fixed-effects model}, but this subtle difference in terminology is easily overlooked/missed. Using the term \sQuote{equal-effects model} avoids this confusion and is more informative. However, the question then remains what the real fixed-effects model is all about. The purpose of this page is to describe this model and to contrast it with the well-known random-effects model. } \details{ \subsection{Fixed-Effects Model}{ Assume we have a set of \mjseqn{i = 1, \ldots, k} independent studies and let \mjseqn{y_i} denote the observed value of the effect size or outcome measure in the \mjeqn{i\textrm{th}}{ith} study. Let \mjseqn{\theta_i} denote the corresponding (unknown) true effect/outcome, such that \mjdeqn{y_i | \theta_i \sim N(\theta_i, v_i).}{y_i | \theta_i ~ N(\theta_i, v_i).} In other words, the observed effect sizes or outcomes are assumed to be unbiased and normally distributed estimates of the corresponding true effects/outcomes with sampling variances equal to \mjseqn{v_i}. The \mjseqn{v_i} values are assumed to be known. The fixed-effects model is simply given by \mjdeqn{y_i = \theta_i + \varepsilon_i,}{y_i = \theta_i + \epsilon_i,} where the \mjseqn{\theta_i} values are the (fixed) true effects/outcomes of the \mjseqn{k} studies. Therefore, the model \sQuote{conditions} on the true effects/outcomes and provides a \emph{conditional inference} about the \mjseqn{k} studies included in the meta-analysis. When using weighted estimation (the default in \code{\link{rma.uni}} when \code{method="FE"}), this implies that the fitted model provides an estimate of \mjdeqn{\bar{\theta}_w = \frac{\sum_{i=1}^k w_i \theta_i}{\sum_{i=1}^k w_i},}{\theta_w = \sum w_i \theta_i / \sum w_i,} that is, the \emph{weighted average} of the true effects/outcomes in the \mjseqn{k} studies, with weights equal to \mjseqn{w_i = 1/v_i}. As an example, consider the meta-analysis by Bangert-Drowns et al. (2004) on the effectiveness of writing-to-learn interventions on academic achievement. The dataset (\code{\link[metadat]{dat.bangertdrowns2004}}) includes the observed standardized mean differences (variable \code{yi}) and the corresponding sampling variances (variable \code{vi}) of the 48 studies. We can fit a fixed-effects model to these data with: \preformatted{# copy data into 'dat' dat <- dat.bangertdrowns2004 # fit a fixed-effects model res <- rma(yi, vi, data=dat, method="FE") res # Fixed-Effects Model (k = 48) # # I^2 (total heterogeneity / total variability): 56.12\% # H^2 (total variability / sampling variability): 2.28 # # Test for Heterogeneity: # Q(df = 47) = 107.1061, p-val < .0001 # # Model Results: # # estimate se zval pval ci.lb ci.ub # 0.1656 0.0269 6.1499 <.0001 0.1128 0.2184} The Q-test suggests that the underlying true standardized mean differences are heterogeneous \mjeqn{(Q(\textrm{df}=47) = 107.11, p < .0001).}{(Q(df=47) = 107.11, p < .0001).} Therefore, if we believe this to be true, then the value shown under \code{estimate} is an estimate of the inverse-variance weighted average of the true standardized mean differences of these 48 studies (i.e., \mjeqn{\hat{\bar{\theta}}_w = 0.17}{\theta-bar-hat_w = 0.17}). One can also employ an unweighted estimation method (by setting \code{weighted=FALSE} in \code{\link{rma.uni}}), which provides an estimate of the \emph{unweighted average} of the true effects/outcomes in the \mjseqn{k} studies, that is, an estimate of \mjdeqn{\bar{\theta}_u = \frac{\sum_{i=1}^k \theta_i}{k}.}{\theta_u = \sum \theta_i / k.} Returning to the example, we then find: \preformatted{# fit a fixed-effects model using unweighted estimation res <- rma(yi, vi, data=dat, method="FE", weighted=FALSE) res # Fixed-Effects Model (k = 48) # # I^2 (total heterogeneity / total variability): 56.12\% # H^2 (total variability / sampling variability): 2.28 # # Test for Heterogeneity: # Q(df = 47) = 107.1061, p-val < .0001 # # Model Results: # # estimate se zval pval ci.lb ci.ub # 0.2598 0.0380 6.8366 <.0001 0.1853 0.3343} Therefore, the \code{estimate} value is now an estimate of the average of the true standardized mean differences of these 48 studies (i.e., \mjeqn{\hat{\bar{\theta}}_u = 0.26}{\theta-bar-hat_u = 0.26}). For weighted estimation, one could also choose to estimate \mjeqn{\bar{\theta}_w}{\theta_w}, where the \mjseqn{w_i} values are user-defined weights (via argument \code{weights} in \code{\link{rma.uni}}). Hence, using inverse-variance weights or unit weights (as in unweighted estimation) are just special cases. It is up to the user to decide to what extent \mjeqn{\bar{\theta}_w}{\theta_w} is a meaningful parameter to estimate (regardless of the weights used). For example, we could use the sample sizes as weights: \preformatted{# fit a fixed-effects model using the sample sizes as weights res <- rma(yi, vi, data=dat, method="FE", weights=ni) res # Fixed-Effects Model (k = 48) # # I^2 (total heterogeneity / total variability): 56.12\% # H^2 (total variability / sampling variability): 2.28 # # Test for Heterogeneity: # Q(df = 47) = 107.1061, p-val < .0001 # # Model Results: # # estimate se zval pval ci.lb ci.ub # 0.1719 0.0269 6.3802 <.0001 0.1191 0.2248} We therefore obtain an estimate of the sample-size weighted average of the true standardized mean differences of these 48 studies (i.e., \mjeqn{\hat{\bar{\theta}}_w = 0.17}{\theta-bar-hat_w = 0.17}). Since the sample sizes and the inverse sampling variances are highly correlated (\code{cor(dat$ni, 1/dat$vi)} yields \code{0.999}), the results are almost identical to the ones we obtained earlier using inverse-variance weighting. } \subsection{Random-Effects Model}{ The random-effects model does not condition on the true effects/outcomes. Instead, the \mjseqn{k} studies included in the meta-analysis are assumed to be a random sample from a larger population of studies. In rare cases, the studies included in a meta-analysis are actually sampled from a larger collection of studies. More typically, all efforts have been made to find and include all relevant studies providing evidence about the phenomenon of interest and hence the population of studies is a hypothetical population of an essentially infinite set of studies comprising all of the studies that have been conducted, that could have been conducted, or that may be conducted in the future. We assume that \mjeqn{\theta_i \sim N(\mu, \tau^2)}{\theta_i ~ N(\mu, \tau^2)}, that is, the true effects/outcomes in the population of studies are normally distributed with \mjseqn{\mu} denoting the average true effect/outcome and \mjseqn{\tau^2} the variance of the true effects/outcomes in the population (\mjseqn{\tau^2} is therefore often referred to as the amount of \sQuote{heterogeneity} in the true effects/outcomes). The random-effects model can also be written as \mjdeqn{y_i = \mu + u_i + \varepsilon_i,}{y_i = \mu + u_i + \epsilon_i,} where \mjeqn{u_i \sim N(0, \tau^2)}{u_i ~ N(0, \tau^2)} and \mjeqn{\varepsilon_i \sim N(0, v_i)}{\epsilon_i ~ N(0, v_i)}. The fitted model provides estimates of \mjseqn{\mu} and \mjseqn{\tau^2}. Consequently, the random-effects model provides an \emph{unconditional inference} about the average true effect/outcome in the population of studies (from which the \mjseqn{k} studies included in the meta-analysis are assumed to be a random sample). Fitting a random-effects model to the example data yields: \preformatted{# fit a random-effects model (note: method="REML" is the default) res <- rma(yi, vi, data=dat) res # Random-Effects Model (k = 48; tau^2 estimator: REML) # # tau^2 (estimated amount of total heterogeneity): 0.0499 (SE = 0.0197) # tau (square root of estimated tau^2 value): 0.2235 # I^2 (total heterogeneity / total variability): 58.37\% # H^2 (total variability / sampling variability): 2.40 # # Test for Heterogeneity: # Q(df = 47) = 107.1061, p-val < .0001 # # Model Results: # # estimate se zval pval ci.lb ci.ub # 0.2219 0.0460 4.8209 <.0001 0.1317 0.3122} The value shown under \code{estimate} is now an estimate of the average true standardized mean difference of studies in the population of studies from which the 48 studies included in this dataset have come (i.e., \mjeqn{\hat{\mu}_w = 0.22}{\mu-hat = 0.22}). When using weighted estimation in the context of a random-effects model, the model is fitted with weights equal to \mjseqn{w_i = 1/(\tau^2 + v_i)}, with \mjseqn{\tau^2} replaced by its estimate (the default in \code{\link{rma.uni}} when \code{method} is set to one of the possible choices for estimating \mjseqn{\tau^2}). One can also choose unweighted estimation in the context of the random-effects model (\code{weighted=FALSE}) or specify user-defined weights (via \code{weights}), although the parameter that is estimated (i.e., \mjseqn{\mu}) remains the same regardless of the estimation method and weights used (as opposed to the fixed-effect model, where the parameter estimated is different for weighted versus unweighted estimation or when using different weights than the standard inverse-variance weights). Since weighted estimation with inverse-variance weights is most efficient, it is usually to be preferred for random-effects models (while in the fixed-effect model case, we must carefully consider whether \mjeqn{\bar{\theta}_w}{\theta_w} or \mjeqn{\bar{\theta}_u}{\theta_u} is the more meaningful parameter to estimate). } \subsection{Conditional versus Unconditional Inferences}{ Contrary to what is often stated in the literature, it is important to realize that the fixed-effects model does \emph{not} assume that the true effects/outcomes are homogeneous (i.e., that \mjseqn{\theta_i} is equal to some common value \mjseqn{\theta} in all \mjseqn{k} studies). In other words, the fixed-effects model provides perfectly valid inferences under heterogeneity, as long as one is restricting these inferences to the set of studies included in the meta-analysis and one realizes that the model does not provide an estimate of \mjseqn{\theta} or \mjseqn{\mu}, but of \mjeqn{\bar{\theta}_w}{\theta_w} or \mjeqn{\bar{\theta}_u}{\theta_u} (depending on the estimation method used). However, such inferences are conditional on the included studies. It is therefore not permissible to generalize those inferences beyond the set of studies included in a meta-analysis. In contrast, a random-effects model provides unconditional inferences and therefore allows a generalization beyond the set of included studies, although the population of studies to which we can generalize is typically only vaguely defined (since the included studies are not a proper random sample from a specified sampling frame). Instead, we simply must assume that the included studies are a representative sample of \emph{some} population and it is to that population to which we are generalizing. Leaving aside this issue, the above implies that there is nothing wrong with fitting both the fixed- and random-effects models to the same data, since these models address inherently different questions (i.e., what was the average effect in the studies that have been conducted and are included in this meta-analysis versus what is the average effect in the larger population of studies?). } \subsection{Equal-Effects Model}{ In the special case that the true effects/outcomes are actually homogeneous (the equal-effects case), the distinction between the fixed- and random-effects models disappears, since homogeneity implies that \mjeqn{\mu = \bar{\theta}_w = \bar{\theta}_u \equiv \theta}{\mu = \theta_w = \theta_u = \theta}. Therefore, if one belives that the true effects/outcomes are homogeneous, then one can fit an equal-effects model (using weighted estimation), since this will provide the most efficient estimate of \mjseqn{\theta} (note that if the true effects/outcomes are really homogeneous but we fit a random-effects model, it can happen that the estimate of \mjseqn{\tau^2} is actually larger than 0, which then leads to a loss of efficiency). However, since there is no infallible method to test whether the true effects/outcomes are really homogeneous or not, a researcher should decide on the type of inference desired before examining the data and choose the model accordingly. Note that fitting an equal-effects model (with \code{method="EE"}) yields the exact same output as fitting a fixed-effects model, since the equations used to fit these two models are identical. However, the interpretation of the results is different. If we fit an equal-effects model, we make the assumption that the true effects are homogeneous and, if we believe this assumption to be justified, can interpret the estimate as an estimate of \emph{the} true effect. On the other hand, if we reject the homogeneity assumption, then we should reject the model altogether. In contrast, if we fit a fixed-effects model, we do not assume homogeneity and instead interpret the estimate as an estimate of the (weighted) average true effect of the included studies. } For further discussions of the distinction between the equal-, fixed-, and random-effects models, see Laird and Mosteller (1990) and Hedges and Vevea (1998). } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Cooper, H., Hedges, L. V., & Valentine, J. C. (Eds.) (2009). \emph{The handbook of research synthesis and meta-analysis} (2nd ed.). New York: Russell Sage Foundation. Hedges, L. V., & Vevea, J. L. (1998). Fixed- and random-effects models in meta-analysis. \emph{Psychological Methods}, \bold{3}(4), 486--504. \verb{https://doi.org/10.1037/1082-989X.3.4.486} Laird, N. M., & Mosteller, F. (1990). Some statistical methods for combining experimental results. \emph{International Journal of Technology Assessment in Health Care}, \bold{6}(1), 5--30. \verb{https://doi.org/10.1017/S0266462300008916} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \keyword{documentation} \keyword{models} metafor/man/qqnorm.rma.Rd0000644000176200001440000001607214505063152015053 0ustar liggesusers\name{qqnorm.rma} \alias{qqnorm} \alias{qqnorm.rma} \alias{qqnorm.rma.uni} \alias{qqnorm.rma.mh} \alias{qqnorm.rma.peto} \alias{qqnorm.rma.glmm} \alias{qqnorm.rma.mv} \title{Normal QQ Plots for 'rma' Objects} \description{ Function to create normal QQ plots for objects of class \code{"rma.uni"}, \code{"rma.mh"}, and \code{"rma.peto"}. \loadmathjax } \usage{ \method{qqnorm}{rma.uni}(y, type="rstandard", pch=21, col, bg, envelope=TRUE, level=y$level, bonferroni=FALSE, reps=1000, smooth=TRUE, bass=0, label=FALSE, offset=0.3, pos=13, lty, \dots) \method{qqnorm}{rma.mh}(y, type="rstandard", pch=21, col, bg, label=FALSE, offset=0.3, pos=13, \dots) \method{qqnorm}{rma.peto}(y, type="rstandard", pch=21, col, bg, label=FALSE, offset=0.3, pos=13, \dots) \method{qqnorm}{rma.glmm}(y, \dots) \method{qqnorm}{rma.mv}(y, \dots) } \arguments{ \item{y}{an object of class \code{"rma.uni"}, \code{"rma.mh"}, or \code{"rma.peto"}. The method is not yet implemented for objects of class \code{"rma.glmm"} or \code{"rma.mv"}.} \item{type}{character string (either \code{"rstandard"} (default) or \code{"rstudent"}) to specify whether standardized residuals or studentized deleted residuals should be used in creating the plot. See \sQuote{Details}.} \item{pch}{plotting symbol to use for the observed outcomes. By default, an open circle is used. See \code{\link{points}} for other options.} \item{col}{optional character string to specify the (border) color of the points.} \item{bg}{optional character string to specify the background color of open plot symbols.} \item{envelope}{logical to specify whether a pseudo confidence envelope should be simulated and added to the plot (the default is \code{TRUE})). Only for objects of class \code{"rma.uni"}. See \sQuote{Details}.} \item{level}{numeric value between 0 and 100 to specify the level of the pseudo confidence envelope (see \link[=misc-options]{here} for details). The default is to take the value from the object.} \item{bonferroni}{logical to specify whether the bounds of the envelope should be Bonferroni corrected.} \item{reps}{numeric value to specify the number of iterations for simulating the pseudo confidence envelope (the default is 1000).} \item{smooth}{logical to specify whether the results from the simulation should be smoothed (the default is \code{TRUE}).} \item{bass}{numeric value that controls the degree of smoothing (the default is 0).} \item{label}{argument to control the labeling of the points (the default is \code{FALSE}). See \sQuote{Details}.} \item{offset}{argument to control the distance between the points and the corresponding labels.} \item{pos}{argument to control the position of the labels.} \item{lty}{optional character string to specify the line type for the diagonal line and the pseudo confidence envelope. If unspecified, the function sets this to \code{c("solid", "dotted")} by default.} \item{\dots}{other arguments.} } \details{ The plot shows the theoretical quantiles of a normal distribution on the horizontal axis against the observed quantiles for either the standardized residuals (\code{type="rstandard"}, the default) or the externally standardized residuals (\code{type="rstudent"}) on the vertical axis (see \code{\link[=residuals.rma]{residuals}} for details on the definition of these residual types). For reference, a line is added to the plot with a slope of 1, going through the (0,0) point. For objects of class \code{"rma.uni"}, it is also possible to add a pseudo confidence envelope to the plot. The envelope is created based on the quantiles of sets of pseudo residuals simulated from the given model (for details, see Cook & Weisberg, 1982). The number of sets simulated can be controlled with the \code{reps} argument. When \code{smooth=TRUE}, the simulated bounds are smoothed with Friedman's SuperSmoother (see \code{\link{supsmu}}). The \code{bass} argument can be set to a number between 0 and 10, with higher numbers indicating increasing smoothness. If \code{bonferroni=TRUE}, the envelope bounds are Bonferroni corrected, so that the envelope can be regarded as a confidence region for all \mjseqn{k} residuals simultaneously. The default however is \code{bonferroni=FALSE}, which makes the plot more sensitive to deviations from normality. With the \code{label} argument, one can control whether points in the plot will be labeled (e.g., to identify outliers). If \code{label="all"} (or \code{label=TRUE}), all points in the plot will be labeled. If \code{label="out"}, points falling outside of the confidence envelope will be labeled (only available for objects of class \code{"rma.uni"}). Finally, one can also set this argument to a numeric value (between 1 and \mjseqn{k}), indicating how many of the most extreme points should be labeled (for example, with \code{label=1} only the most extreme point is labeled, while with \code{label=3}, the most extreme, and the second and third most extreme points is labeled). With the \code{offset} argument, one can adjust the distance between the labels and the corresponding points. The \code{pos} argument is the position specifier for the labels (\code{1}, \code{2}, \code{3}, and \code{4}, respectively indicate positions below, to the left of, above, and to the right of the points; \code{13} places the labels below the points for points that fall below the reference line and above otherwise; \code{24} places the labels to the left of the points for points that fall above the reference line and to the right otherwise). } \value{ A list with components: \item{x}{the x-axis coordinates of the points that were plotted.} \item{y}{the y-axis coordinates of the points that were plotted.} Note that the list is returned invisibly. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Cook, R. D., & Weisberg, S. (1982). \emph{Residuals and influence in regression}. London: Chapman and Hall. Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W. (2021). Model checking in meta-analysis. In C. H. Schmid, T. Stijnen, & I. R. White (Eds.), \emph{Handbook of meta-analysis} (pp. 219--254). Boca Raton, FL: CRC Press. \verb{https://doi.org/10.1201/9781315119403} Wang, M. C., & Bushman, B. J. (1998). Using the normal quantile plot to explore meta-analytic data sets. \emph{Psychological Methods}, \bold{3}(1), 46--54. \verb{https://doi.org/10.1037/1082-989X.3.1.46} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, and \code{\link{rma.peto}} for functions to fit models for which normal QQ plots can be drawn. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit random-effects model res <- rma(yi, vi, data=dat) ### draw QQ plot qqnorm(res) ### fit mixed-effects model with absolute latitude as moderator res <- rma(yi, vi, mods = ~ ablat, data=dat) ### draw QQ plot qqnorm(res) } \keyword{hplot} metafor/man/rma.uni.Rd0000644000176200001440000014725514505063152014341 0ustar liggesusers\name{rma.uni} \alias{rma.uni} \alias{rma} \title{Meta-Analysis via Linear (Mixed-Effects) Models} \description{ Function to fit meta-analytic equal-, fixed-, and random-effects models and (mixed-effects) meta-regression models using a linear (mixed-effects) model framework. See below and the introduction to the \pkg{\link{metafor-package}} for more details on these models. \loadmathjax } \usage{ rma.uni(yi, vi, sei, weights, ai, bi, ci, di, n1i, n2i, x1i, x2i, t1i, t2i, m1i, m2i, sd1i, sd2i, xi, mi, ri, ti, fi, pi, sdi, r2i, ni, mods, scale, measure="GEN", intercept=TRUE, data, slab, subset, add=1/2, to="only0", drop00=FALSE, vtype="LS", method="REML", weighted=TRUE, test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, \dots) rma(yi, vi, sei, weights, ai, bi, ci, di, n1i, n2i, x1i, x2i, t1i, t2i, m1i, m2i, sd1i, sd2i, xi, mi, ri, ti, fi, pi, sdi, r2i, ni, mods, scale, measure="GEN", intercept=TRUE, data, slab, subset, add=1/2, to="only0", drop00=FALSE, vtype="LS", method="REML", weighted=TRUE, test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, \dots) } \arguments{ \item{yi}{vector of length \mjseqn{k} with the observed effect sizes or outcomes. See \sQuote{Details}.} \item{vi}{vector of length \mjseqn{k} with the corresponding sampling variances. See \sQuote{Details}.} \item{sei}{vector of length \mjseqn{k} with the corresponding standard errors (only relevant when not using \code{vi}). See \sQuote{Details}.} \item{weights}{optional argument to specify a vector of length \mjseqn{k} with user-defined weights. See \sQuote{Details}.} \item{ai}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{bi}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{ci}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{di}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{n1i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{n2i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{x1i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{x2i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{t1i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{t2i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{m1i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{m2i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{sd1i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{sd2i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{xi}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{mi}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{ri}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{ti}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{fi}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{pi}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{sdi}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{r2i}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{ni}{see below and the documentation of the \code{\link{escalc}} function for more details.} \item{mods}{optional argument to include one or more moderators in the model. A single moderator can be given as a vector of length \mjseqn{k} specifying the values of the moderator. Multiple moderators are specified by giving a matrix with \mjseqn{k} rows and as many columns as there are moderator variables. Alternatively, a model \code{\link{formula}} can be used to specify the model. See \sQuote{Details}.} \item{scale}{optional argument to include one or more predictors for the scale part in a location-scale model. See \sQuote{Details}.} \item{measure}{character string to specify the type of data supplied to the function. When \code{measure="GEN"} (default), the observed effect sizes or outcomes and corresponding sampling variances should be supplied to the function via the \code{yi} and \code{vi} arguments, respectively (instead of the sampling variances, one can supply the standard errors via the \code{sei} argument). Alternatively, one can set \code{measure} to one of the effect sizes or outcome measures described under the documentation for the \code{\link{escalc}} function in which case one must specify the required data via the appropriate arguments (see \code{\link{escalc}}).} \item{intercept}{logical to specify whether an intercept should be added to the model (the default is \code{TRUE}). Ignored when \code{mods} is a formula.} \item{data}{optional data frame containing the data supplied to the function.} \item{slab}{optional vector with labels for the \mjseqn{k} studies.} \item{subset}{optional (logical or numeric) vector to specify the subset of studies that should be used for the analysis.} \item{add}{see the documentation of the \code{\link{escalc}} function.} \item{to}{see the documentation of the \code{\link{escalc}} function.} \item{drop00}{see the documentation of the \code{\link{escalc}} function.} \item{vtype}{see the documentation of the \code{\link{escalc}} function.} \item{method}{character string to specify whether an equal- or a random-effects model should be fitted. An equal-effects model is fitted when using \code{method="EE"}. A random-effects model is fitted by setting \code{method} equal to one of the following: \code{"DL"}, \code{"HE"}, \code{"HS"}, \code{"HSk"}, \code{"SJ"}, \code{"ML"}, \code{"REML"}, \code{"EB"}, \code{"PM"}, \code{"GENQ"}, \code{"PMM"}, or \code{"GENQM"}. The default is \code{"REML"}. See \sQuote{Details}.} \item{weighted}{logical to specify whether weighted (default) or unweighted estimation should be used to fit the model (the default is \code{TRUE}).} \item{test}{character string to specify how test statistics and confidence intervals for the fixed effects should be computed. By default (\code{test="z"}), Wald-type tests and CIs are obtained, which are based on a standard normal distribution. When \code{test="t"}, a t-distribution is used instead. When \code{test="knha"}, the method by Knapp and Hartung (2003) is used. See \sQuote{Details} and also \link[=misc-recs]{here} for some recommended practices.} \item{level}{numeric value between 0 and 100 to specify the confidence interval level (the default is 95; see \link[=misc-options]{here} for details).} \item{btt}{optional vector of indices to specify which coefficients to include in the omnibus test of moderators. Can also be a string to \code{\link{grep}} for. See \sQuote{Details}.} \item{att}{optional vector of indices to specify which scale coefficients to include in the omnibus test. Only relevant for location-scale models. See \sQuote{Details}.} \item{tau2}{optional numeric value to specify the amount of (residual) heterogeneity in a random- or mixed-effects model (instead of estimating it). Useful for sensitivity analyses (e.g., for plotting results as a function of \mjseqn{\tau^2}). If unspecified, the value of \mjseqn{\tau^2} is estimated from the data.} \item{verbose}{logical to specify whether output should be generated on the progress of the model fitting (the default is \code{FALSE}). Can also be an integer. Values > 1 generate more verbose output. See \sQuote{Note}.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is 4. See also \link[=misc-options]{here} for further details on how to control the number of digits in the output.} \item{control}{optional list of control values for the iterative estimation algorithms. If unspecified, default values are defined inside the function. See \sQuote{Note}.} \item{\dots}{additional arguments.} } \details{ \subsection{Specifying the Data}{ The function can be used in combination with any of the usual effect sizes or outcome measures used in meta-analyses (e.g., log risk ratios, log odds ratios, risk differences, mean differences, standardized mean differences, log transformed ratios of means, raw correlation coefficients, correlation coefficients transformed with Fisher's r-to-z transformation), or, more generally, any set of estimates (with corresponding sampling variances) one would like to analyze. Simply specify the observed effect sizes or outcomes via the \code{yi} argument and the corresponding sampling variances via the \code{vi} argument. Instead of specifying \code{vi}, one can specify the standard errors (the square root of the sampling variances) via the \code{sei} argument. The \code{\link{escalc}} function can be used to compute a wide variety of effect sizes or outcome measures (and the corresponding sampling variances) based on summary statistics. Alternatively, the function can automatically calculate the values of a chosen effect size or outcome measure (and the corresponding sampling variances) when supplied with the necessary data. The \code{\link{escalc}} function describes which effect sizes or outcome measures are currently implemented and what data/arguments should then be specified/used. The \code{measure} argument should then be set to the desired effect size or outcome measure. } \subsection{Specifying the Model}{ The function can be used to fit equal-, fixed-, and random-effects models, as well as (mixed-effects) meta-regression models including one or multiple moderators (the difference between the various models is described in detail on the introductory \pkg{\link{metafor-package}} help page). Assuming the observed effect sizes or outcomes and corresponding sampling variances are supplied via the \code{yi} and \code{vi} arguments, an \emph{equal-effects model} can be fitted with \code{rma(yi, vi, method="EE")}. Setting \code{method="FE"} fits a \emph{fixed-effects model} (see \link[=misc-models]{here} for a discussion of this model). Weighted estimation (with inverse-variance weights) is used by default. User-defined weights can be supplied via the \code{weights} argument. Unweighted estimation can be used by setting \code{weighted=FALSE} (which is the same as setting the weights equal to a constant). A \emph{random-effects model} can be fitted with the same code but setting the \code{method} argument to one of the various estimators for the amount of heterogeneity: \itemize{ \item \code{method="DL"} = DerSimonian-Laird estimator (DerSimonian & Laird, 1986; Raudenbush, 2009), \item \code{method="HE"} = Hedges estimator (Hedges, 1983, 1992), \item \code{method="HS"} = Hunter-Schmidt estimator (Hunter & Schmidt, 1990; Viechtbauer et al., 2015), \item \code{method="HSk"} = Hunter-Schmidt estimator with a small sample-size correction (Brannick et al., 2019), \item \code{method="SJ"} = Sidik-Jonkman estimator (Sidik & Jonkman, 2005b, 2007), \item \code{method="ML"} = maximum likelihood estimator (Hardy & Thompson, 1996; Raudenbush, 2009), \item \code{method="REML"} = restricted maximum likelihood estimator (Viechtbauer, 2005; Raudenbush, 2009) \item \code{method="EB"} = empirical Bayes estimator (Morris, 1983; Berkey et al. 1995), \item \code{method="PM"} = Paule-Mandel estimator (Paule & Mandel, 1982; Viechtbauer et al., 2015), \item \code{method="GENQ"} = generalized Q-statistic estimator (DerSimonian & Kacker, 2007; Jackson et al., 2014), \item \code{method="PMM"} = median-unbiased Paule-Mandel estimator (Viechtbauer, 2021), \item \code{method="GENQM"} = median-unbiased generalized Q-statistic estimator (Viechtbauer, 2021). } For a description of the various estimators, see Brannick et al. (2019), DerSimonian and Kacker (2007), Raudenbush (2009), Veroniki et al. (2016), Viechtbauer (2005), and Viechtbauer et al. (2015). Note that the Hedges estimator is also called the \sQuote{variance component estimator} or \sQuote{Cochran estimator}, the Sidik-Jonkman estimator is also called the \sQuote{model error variance estimator}, the empirical Bayes estimator is actually identical to the Paule-Mandel estimator (Viechtbauer et al., 2015), and the generalized Q-statistic estimator is a general method-of-moments estimator (DerSimonian & Kacker, 2007) requiring the specification of weights (the HE and DL estimators are just special cases with equal and inverse sampling variance weights, respectively). Finally, the two median-unbiased estimators are versions of the Paule-Mandel and generalized Q-statistic estimators that equate the respective estimating equations not to their expected values, but to the medians of their theoretical distributions (Viechtbauer, 2021). One or more moderators can be included in a model via the \code{mods} argument. A single moderator can be given as a (row or column) vector of length \mjseqn{k} specifying the values of the moderator. Multiple moderators are specified by giving an appropriate model matrix (i.e., \mjseqn{X}) with \mjseqn{k} rows and as many columns as there are moderator variables (e.g., \code{mods = cbind(mod1, mod2, mod3)}, where \code{mod1}, \code{mod2}, and \code{mod3} correspond to the names of the variables for three moderator variables). The intercept is added to the model matrix by default unless \code{intercept=FALSE}. Alternatively, one can use standard \code{\link{formula}} syntax to specify the model. In this case, the \code{mods} argument should be set equal to a one-sided formula of the form \code{mods = ~ model} (e.g., \code{mods = ~ mod1 + mod2 + mod3}). Interactions, polynomial terms, and factors can be easily added to the model in this manner. When specifying a model formula via the \code{mods} argument, the \code{intercept} argument is ignored. Instead, the inclusion/exclusion of the intercept is controlled by the specified formula (e.g., \code{mods = ~ mod1 + mod2 + mod3 - 1} would lead to the removal of the intercept). When the observed effect sizes or outcomes and corresponding sampling variances are supplied via the \code{yi} and \code{vi} (or \code{sei}) arguments, one can also specify moderators via the \code{yi} argument (e.g., \code{rma(yi ~ mod1 + mod2 + mod3, vi)}). In that case, the \code{mods} argument is ignored and the inclusion/exclusion of the intercept again is controlled by the specified formula. } \subsection{Omnibus Test of Moderators}{ For models including moderators, an omnibus test of all model coefficients is conducted that excludes the intercept (the first coefficient) if it is included in the model. If no intercept is included in the model, then the omnibus test includes all coefficients in the model including the first. Alternatively, one can manually specify the indices of the coefficients to test via the \code{btt} (\sQuote{betas to test}) argument (i.e., to test \mjseqn{\mbox{H}_0{:}\; \beta_{j \in \texttt{btt}} = 0}, where \mjseqn{\beta_{j \in \texttt{btt}}} is the set of coefficients to be tested). For example, with \code{btt=c(3,4)}, only the third and fourth coefficients from the model are included in the test (if an intercept is included in the model, then it corresponds to the first coefficient in the model). Instead of specifying the coefficient numbers, one can specify a string for \code{btt}. In that case, \code{\link{grep}} will be used to search for all coefficient names that match the string. The omnibus test is called the \mjseqn{Q_M}-test and follows asymptotically a chi-square distribution with \mjseqn{m} degrees of freedom (with \mjseqn{m} denoting the number of coefficients tested) under the null hypothesis (that the true value of all coefficients tested is equal to 0). } \subsection{Categorical Moderators}{ Categorical moderator variables can be included in the model via the \code{mods} argument in the same way that appropriately (dummy) coded categorical variables can be included in linear models. One can either do the dummy coding manually or use a model formula together with the \code{\link{factor}} function to automate the coding (note that string/character variables in a model formula are automatically converted to factors). An example to illustrate these different approaches is provided below. } \subsection{Tests and Confidence Intervals}{ By default, tests of individual coefficients in the model (and the corresponding confidence intervals) are based on a standard normal distribution, while the omnibus test is based on a chi-square distribution (see above). As an alternative, one can set \code{test="t"}, in which case tests of individual coefficients and confidence intervals are based on a t-distribution with \mjseqn{k-p} degrees of freedom, while the omnibus test then uses an F-distribution with \mjseqn{m} and \mjseqn{k-p} degrees of freedom (with \mjseqn{k} denoting the total number of estimates included in the analysis and \mjseqn{p} the total number of model coefficients including the intercept if it is present). Furthermore, when \code{test="knha"}, the method by Hartung (1999), Sidik and Jonkman (2002), and Knapp and Hartung (2003) (the Knapp-Hartung method; also referred to as the Hartung-Knapp-Sidik-Jonkman method) is used, which applies an adjustment to the standard errors of the estimated coefficients (to account for the uncertainty in the estimate of the amount of (residual) heterogeneity) and uses t- and F-distributions as described above (see also \link[=misc-recs]{here}). Finally, one can set \code{test="adhoc"}, in which case the Knapp-Hartung method is used, but with the restriction that the adjustment to the standard errors can never result in adjusted standard errors that are smaller than the unadjusted ones (see Jackson et al., 2017, section 4.3). } \subsection{Test for (Residual) Heterogeneity}{ A test for (residual) heterogeneity is automatically carried out by the function. Without moderators in the model, this is simply Cochran's \mjseqn{Q}-test (Cochran, 1954), which tests whether the variability in the observed effect sizes or outcomes is larger than would be expected based on sampling variability alone. A significant test suggests that the true effects/outcomes are heterogeneous. When moderators are included in the model, this is the \mjseqn{Q_E}-test for residual heterogeneity, which tests whether the variability in the observed effect sizes or outcomes not accounted for by the moderators included in the model is larger than would be expected based on sampling variability alone. } \subsection{Location-Scale Models}{ The function can also be used to fit so-called \sQuote{location-scale models} (Viechtbauer & \enc{López-López}{Lopez-Lopez}, 2022). In such models, one can specify not only predictors for the size of the average true outcome (i.e., for their \sQuote{location}), but also predictors for the amount of heterogeneity in the outcomes (i.e., for their \sQuote{scale}). The model is given by \mjdeqn{y_i = \beta_0 + \beta_1 x_{i1} + \beta_2 x_{i2} + \ldots + \beta_{p'} x_{ip'} + u_i + \varepsilon_i,}{y_i = \beta_0 + \beta_1 x_i1 + \beta_2 x_i2 + \ldots + \beta_p' x_ip' + u_i + \epsilon_i,} \mjdeqn{u_i \sim N(0, \tau_i^2), \; \varepsilon_i \sim N(0, v_i),}{u_i ~ N(0, tau_i^2), \epsilon_i \sim N(0, v_i),} \mjdeqn{\ln(\tau_i^2) = \alpha_0 + \alpha_1 z_{i1} + \alpha_2 z_{i2} + \ldots + \alpha_{q'} z_{iq'},}{log(tau^2) = \alpha_0 + \alpha z_i1 + \alpha z_i2 + \ldots + \alpha_q' z_iq',} where \mjeqn{x_{i1}, \ldots, x_{ip'}}{x_i1, \ldots, x_ip'} are the values of the \mjseqn{p'} predictor variables that may be related to the size of the average true outcome (letting \mjseqn{p = p' + 1} denote the total number of location coefficients in the model including the model intercept \mjseqn{\beta_0}) and \mjeqn{z_{i1}, \ldots, z_{iq'}}{z_i1, \ldots, z_iq'} are the values of the \mjseqn{q'} scale variables that may be related to the amount of heterogeneity in the outcomes (letting \mjseqn{q = q' + 1} denote the total number of scale coefficients in the model including the model intercept \mjseqn{\alpha_0}). Location variables can be specified via the \code{mods} argument as described above (e.g., \code{mods = ~ mod1 + mod2 + mod3}). Scale variables can be specified via the \code{scale} argument (e.g., \code{scale = ~ var1 + var2 + var3}). A log link is used for specifying the relationship between the scale variables and the amount of heterogeneity so that \mjseqn{\tau_i^2} is guaranteed to be non-negative (one can also set (the undocumented) argument \code{link="identity"} to use an identity link, but this is more likely to lead to estimation problems). Estimates of the location and scale coefficients can be obtained either with maximum likelihood (\code{method="ML"}) or restricted maximum likelihood (\code{method="REML"}) estimation. An omnibus test of the scale coefficients is conducted as described above (where the \code{att} argument can be used to specify which scale coefficients to include in the test). } } \value{ An object of class \code{c("rma.uni","rma")}. The object is a list containing the following components: \item{beta}{estimated coefficients of the model.} \item{se}{standard errors of the coefficients.} \item{zval}{test statistics of the coefficients.} \item{pval}{corresponding p-values.} \item{ci.lb}{lower bound of the confidence intervals for the coefficients.} \item{ci.ub}{upper bound of the confidence intervals for the coefficients.} \item{vb}{variance-covariance matrix of the estimated coefficients.} \item{tau2}{estimated amount of (residual) heterogeneity. Always \code{0} when \code{method="EE"}.} \item{se.tau2}{standard error of the estimated amount of (residual) heterogeneity.} \item{k}{number of studies included in the analysis.} \item{p}{number of coefficients in the model (including the intercept).} \item{m}{number of coefficients included in the omnibus test of moderators.} \item{QE}{test statistic of the test for (residual) heterogeneity.} \item{QEp}{corresponding p-value.} \item{QM}{test statistic of the omnibus test of moderators.} \item{QMp}{corresponding p-value.} \item{I2}{value of \mjseqn{I^2}. See \code{\link[=print.rma.uni]{print}} for more details.} \item{H2}{value of \mjseqn{H^2}. See \code{\link[=print.rma.uni]{print}} for more details.} \item{R2}{value of \mjseqn{R^2}. See \code{\link[=print.rma.uni]{print}} for more details.} \item{int.only}{logical that indicates whether the model is an intercept-only model.} \item{yi, vi, X}{the vector of outcomes, the corresponding sampling variances, and the model matrix.} \item{fit.stats}{a list with the log-likelihood, deviance, AIC, BIC, and AICc values under the unrestricted and restricted likelihood.} \item{\dots}{some additional elements/values.} For location-scale models, the object is of class \code{c("rma.ls","rma.uni","rma")} and includes the following components in addition to the ones listed above: \item{alpha}{estimated scale coefficients of the model.} \item{se.alpha}{standard errors of the coefficients.} \item{zval.alpha}{test statistics of the coefficients.} \item{pval.alpha}{corresponding p-values.} \item{ci.lb.alpha}{lower bound of the confidence intervals for the coefficients.} \item{ci.ub.alpha}{upper bound of the confidence intervals for the coefficients.} \item{va}{variance-covariance matrix of the estimated coefficients.} \item{tau2}{as above, but now a vector of values.} \item{q}{number of scale coefficients in the model (including the intercept).} \item{QS}{test statistic of the omnibus test of the scale coefficients.} \item{QSp}{corresponding p-value.} \item{\dots}{some additional elements/values.} } \section{Methods}{ The results of the fitted model are formatted and printed with the \code{\link[=print.rma.uni]{print}} function. If fit statistics should also be given, use \code{\link[=summary.rma]{summary}} (or use the \code{\link[=fitstats.rma]{fitstats}} function to extract them). Full versus reduced model comparisons in terms of fit statistics and likelihood ratio tests can be obtained with \code{\link[=anova.rma]{anova}}. Wald-type tests for sets of model coefficients or linear combinations thereof can be obtained with the same function. Permutation tests for the model coefficient(s) can be obtained with \code{\link[=permutest.rma.uni]{permutest}}. Tests and confidence intervals based on (cluster) robust methods can be obtained with \code{\link[=robust.rma.uni]{robust}}. Predicted/fitted values can be obtained with \code{\link[=predict.rma]{predict}} and \code{\link[=fitted.rma]{fitted}}. For best linear unbiased predictions, see \code{\link[=blup.rma.uni]{blup}} and \code{\link[=ranef.rma.uni]{ranef}}. The \code{\link[=residuals.rma]{residuals}}, \code{\link[=rstandard.rma.uni]{rstandard}}, and \code{\link[=rstudent.rma.uni]{rstudent}} functions extract raw and standardized residuals. Additional model diagnostics (e.g., to determine influential studies) can be obtained with the \code{\link[=influence.rma.uni]{influence}} function. For models without moderators, leave-one-out diagnostics can also be obtained with \code{\link[=leave1out.rma.uni]{leave1out}}. For models with moderators, variance inflation factors can be obtained with \code{\link[=vif.rma]{vif}}. A confidence interval for the amount of (residual) heterogeneity in the random/mixed-effects model can be obtained with \code{\link[=confint.rma.uni]{confint}}. For location-scale models, \code{\link[=confint.rma.ls]{confint}} can provide confidence intervals for the scale coefficients. Forest, funnel, radial, \enc{L'Abbé}{L'Abbe}, and Baujat plots can be obtained with \code{\link[=forest.rma]{forest}}, \code{\link[=funnel.rma]{funnel}}, \code{\link[=radial.rma]{radial}}, \code{\link[=labbe.rma]{labbe}}, and \code{\link[=baujat.rma]{baujat}} (radial and \enc{L'Abbé}{L'Abbe} plots only for models without moderators). The \code{\link[=qqnorm.rma.uni]{qqnorm}} function provides normal QQ plots of the standardized residuals. One can also just call \code{\link[=plot.rma.uni]{plot}} on the fitted model object to obtain various plots at once. For random/mixed-effects models, the \code{\link[=profile.rma.uni]{profile}} function can be used to obtain a plot of the (restricted) log-likelihood as a function of \mjseqn{\tau^2}. For location-scale models, \code{\link[=profile.rma.ls]{profile}} draws analogous plots based on the scale coefficients. For models with moderators, \code{\link[=regplot.rma]{regplot}} draws scatter plots / bubble plots, showing the (marginal) relationship between the observed outcomes and a selected moderator from the model. Tests for funnel plot asymmetry (which may be indicative of publication bias) can be obtained with \code{\link{ranktest}} and \code{\link{regtest}}. For models without moderators, the \code{\link[=trimfill.rma.uni]{trimfill}} method can be used to carry out a trim and fill analysis and \code{\link[=hc.rma.uni]{hc}} provides a random-effects model analysis that is more robust to publication bias (based on the method by Henmi & Copas, 2010). The test of \sQuote{excess significance} can be carried out with the \code{\link{tes}} function. The fail-safe N (based on a file drawer analysis) can be computed using \code{\link{fsn}}. Selection models can be fitted with the \code{\link{selmodel}} function. For models without moderators, a cumulative meta-analysis (i.e., adding one observation at a time) can be obtained with \code{\link[=cumul.rma.uni]{cumul}}. Other extractor functions include \code{\link[=coef.rma]{coef}}, \code{\link[=vcov.rma]{vcov}}, \code{\link[=logLik.rma]{logLik}}, \code{\link[=deviance.rma]{deviance}}, \code{\link[=AIC.rma]{AIC}}, \code{\link[=BIC.rma]{BIC}}, \code{\link[=hatvalues.rma.uni]{hatvalues}}, and \code{\link[=weights.rma.uni]{weights}}. } \note{ While the HS, HSk, HE, DL, SJ, and GENQ estimators of \mjseqn{\tau^2} are based on closed-form solutions, the ML, REML, and EB estimators must be obtained iteratively. For this, the function makes use of the Fisher scoring algorithm, which is robust to poor starting values and usually converges quickly (Harville, 1977; Jennrich & Sampson, 1976). By default, the starting value is set equal to the value of the Hedges (HE) estimator and the algorithm terminates when the change in the estimated value of \mjseqn{\tau^2} is smaller than \mjeqn{10^{-5}}{10^(-5)} from one iteration to the next. The maximum number of iterations is 100 by default (which should be sufficient in most cases). Information on the progress of the algorithm can be obtained by setting \code{verbose=TRUE}. One can also set \code{verbose} to an integer (\code{verbose=2} yields even more information and \code{verbose=3} also sets \code{option(warn=1)} temporarily). A different starting value, threshold, and maximum number of iterations can be specified via the \code{control} argument by setting \code{control=list(tau2.init=value, threshold=value, maxiter=value)}. The step length of the Fisher scoring algorithm can also be adjusted by a desired factor with \code{control=list(stepadj=value)} (values below 1 will reduce the step length). If using \code{verbose=TRUE} shows the estimate jumping around erratically (or cycling through a few values), decreasing the step length (and increasing the maximum number of iterations) can often help with convergence (e.g., \code{control=list(stepadj=0.5, maxiter=1000)}). The PM, PMM, and GENQM estimators also involve iterative algorithms, which make use of the \code{\link{uniroot}} function. By default, the desired accuracy (\code{tol}) is set equal to \code{.Machine$double.eps^0.25} and the maximum number of iterations (\code{maxiter}) to \code{100} (as above). The upper bound of the interval searched (\code{tau2.max}) is set to the larger of 100 and \code{10*mad(yi)^2} (i.e., 10 times the squared median absolute deviation of the observed effect sizes or outcomes computed with the \code{\link{mad}} function). These values can be adjusted with \code{control=list(tol=value, maxiter=value, tau2.max=value)}. All of the heterogeneity estimators except SJ can in principle yield negative estimates for the amount of (residual) heterogeneity. However, negative estimates of \mjseqn{\tau^2} are outside of the parameter space. For the HS, HSk, HE, DL, and GENQ estimators, negative estimates are therefore truncated to zero. For the ML, REML, and EB estimators, the Fisher scoring algorithm makes use of step halving (Jennrich & Sampson, 1976) to guarantee a non-negative estimate. Finally, for the PM, PMM, and GENQM estimators, the lower bound of the interval searched is set to zero by default. For those brave enough to step into risky territory, there is the option to set the lower bound for all these estimators to some other value besides zero (even a negative one) with \code{control=list(tau2.min=value)}, but the lowest value permitted is \code{-min(vi)} (to ensure that the marginal variances are always non-negative). The Hunter-Schmidt estimator for the amount of heterogeneity is defined in Hunter and Schmidt (1990) only in the context of the random-effects model when analyzing correlation coefficients. A general version of this estimator for random- and mixed-effects models not specific to any particular outcome measure is described in Viechtbauer (2005) and Viechtbauer et al. (2015) and is implemented here. The Sidik-Jonkman estimator starts with a crude estimate of \mjseqn{\tau^2}, which is then updated as described in Sidik and Jonkman (2005b, 2007). If, instead of the crude estimate, one wants to use a better a priori estimate, one can do so by passing this value via \code{control=list(tau2.init=value)}. One can also specify a vector of estimators via the \code{method} argument (e.g., \code{rma(yi, vi, method=c("REML","DL"))}). The various estimators are then applied in turn until one converges. This is mostly useful for simulation studies where an estimator (like the REML estimator) is not guaranteed to converge and one can then substitute one (like the DL estimator) that does not involve iterative methods and is guaranteed to provide an estimate. Outcomes with non-positive sampling variances are problematic. If a sampling variance is equal to zero, then its weight will be \mjseqn{1/0} for equal-effects models when using weighted estimation. Switching to unweighted estimation is a possible solution then. For random/mixed-effects model, some estimators of \mjseqn{\tau^2} are undefined when there is at least one sampling variance equal to zero. Other estimators may work, but it may still be necessary to switch to unweighted model fitting, especially when the estimate of \mjseqn{\tau^2} converges to zero. When including moderators in the model, it is possible that the model matrix is not of full rank (i.e., there is a linear relationship between the moderator variables included in the model). The function automatically tries to reduce the model matrix to full rank by removing redundant predictors, but if this fails the model cannot be fitted and an error will be issued. Deleting (redundant) moderator variables from the model as needed should solve this problem. Some general words of caution about the assumptions underlying the models: \itemize{ \item The sampling variances (i.e., the \code{vi} values) are treated as if they are known constants, even though in practice they are usually estimates themselves. This implies that the distributions of the test statistics and corresponding confidence intervals are only exact and have nominal coverage when the within-study sample sizes are large (i.e., when the error in the sampling variance estimates is small). Certain outcome measures (e.g., the arcsine square root transformed risk difference and Fisher's r-to-z transformed correlation coefficient) are based on variance stabilizing transformations that also help to make the assumption of known sampling variances much more reasonable. \item When fitting a mixed/random-effects model, \mjseqn{\tau^2} is estimated and then treated as a known constant thereafter. This ignores the uncertainty in the estimate of \mjseqn{\tau^2}. As a consequence, the standard errors of the parameter estimates tend to be too small, yielding test statistics that are too large and confidence intervals that are not wide enough. The Knapp and Hartung (2003) adjustment (i.e., using \code{test="knha"}) can be used to counter this problem, yielding test statistics and confidence intervals whose properties are closer to nominal. \item Most effect sizes or outcome measures do not have exactly normal sampling distributions as assumed under the various models. However, the normal approximation usually becomes more accurate for most effect sizes or outcome measures as the within-study sample sizes increase. Therefore, sufficiently large within-study sample sizes are (usually) needed to be certain that the tests and confidence intervals have nominal levels/coverage. Again, certain outcome measures (e.g., Fisher's r-to-z transformed correlation coefficient) may be preferable from this perspective as well. } For location-scale models, model fitting is done via numerical optimization over the model parameters. By default, \code{\link{nlminb}} is used for the optimization. One can also chose a different optimizer from \code{\link{optim}} via the \code{control} argument (e.g., \code{control=list(optimizer="BFGS")} or \code{control=list(optimizer="Nelder-Mead")}). Besides \code{\link{nlminb}} and one of the methods from \code{\link{optim}}, one can also choose one of the optimizers from the \code{minqa} package (i.e., \code{\link[minqa]{uobyqa}}, \code{\link[minqa]{newuoa}}, or \code{\link[minqa]{bobyqa}}), one of the (derivative-free) algorithms from the \code{\link[nloptr]{nloptr}} package, the Newton-type algorithm implemented in \code{\link{nlm}}, the various algorithms implemented in the \code{dfoptim} package (\code{\link[dfoptim]{hjk}} for the Hooke-Jeeves, \code{\link[dfoptim]{nmk}} for the Nelder-Mead, and \code{\link[dfoptim]{mads}} for the Mesh Adaptive Direct Searches algorithm), the quasi-Newton type optimizers \code{\link[ucminf]{ucminf}} and \code{\link[lbfgsb3c]{lbfgsb3c}} and the subspace-searching simplex algorithm \code{\link[subplex]{subplex}} from the packages of the same name, the Barzilai-Borwein gradient decent method implemented in \code{\link[BB]{BBoptim}}, the \code{\link[Rcgmin]{Rcgmin}} and \code{\link[Rvmmin]{Rvmmin}} optimizers, or the parallelized version of the L-BFGS-B algorithm implemented in \code{\link[optimParallel]{optimParallel}} from the package of the same name. When using an identity link with \code{link="identity"}, constrained optimization (to ensure non-negative \mjseqn{\tau_i^2} values) as implemented in \code{\link{constrOptim}} is used by default. Alternative optimizers in this case are the \code{\link[Rsolnp]{solnp}} solver from the \code{Rsolnp} package, \code{\link[nloptr]{nloptr}}, or the augmented Lagrangian adaptive barrier minimization algorithm \code{\link[alabama]{constrOptim.nl}} from the \code{alabama} package. The optimizer name must be given as a character string (i.e., in quotes). Additional control parameters can be specified via the \code{control} argument (e.g., \code{control=list(iter.max=1000, rel.tol=1e-8)}). For \code{\link[nloptr]{nloptr}}, the default is to use the BOBYQA implementation from that package with a relative convergence criterion of \code{1e-8} on the function value (i.e., log-likelihood), but this can be changed via the \code{algorithm} and \code{ftop_rel} arguments (e.g., \code{control=list(optimizer="nloptr", algorithm="NLOPT_LN_SBPLX", ftol_rel=1e-6)}) (note: when using \code{optimizer="nloptr"} in combination with an identity link, the \code{"NLOPT_LN_COBYLA"} algorithm is automatically used, since this one allows for inequality constraints). For \code{\link[optimParallel]{optimParallel}}, the control argument \code{ncpus} can be used to specify the number of cores to use for the parallelization (e.g., \code{control=list(optimizer="optimParallel", ncpus=2)}). With \code{parallel::detectCores()}, one can check on the number of available cores on the local machine. Under certain circumstances (e.g., when the amount of heterogeneity is very small for certain combinations of values for the scale variables and scale coefficients), the values of the scale coefficients may try to drift towards minus or plus infinity, which can lead to problems with the optimization. One can impose constraints on the scale coefficients via \code{control=list(alpha.min=minval, alpha.max=maxval)} where \code{minval} and \code{maxval} are either scalars or vectors of the appropriate length. Finally, for location-scale models, the standard errors of the scale coefficients are obtained by inverting the Hessian, which is numerically approximated using the \code{\link[numDeriv]{hessian}} function from the \code{numDeriv} package. This may fail (especially when using an identity link), leading to \code{NA} values for the standard errors and hence test statistics, p-values, and confidence interval bounds. One can set control argument \code{hessianCtrl} to a list of named arguments to be passed on to the \code{method.args} argument of the \code{\link[numDeriv]{hessian}} function (the default is \code{control=list(hessianCtrl=list(r=8))}). One can also set \code{control=list(hesspack="pracma")} in which case the \code{\link[pracma]{hessian}} function from the \code{pracma} package is used instead for approximating the Hessian. Even if the Hessian can be approximated and inverted, the standard errors may be unreasonably large when the likelihood surface is very flat around the estimated scale coefficients. This is more likely to happen when \mjseqn{k} is small and when the amount of heterogeneity is very small under some conditions as defined by the scale coefficients/variables. Setting constraints on the scale coefficients as described above can also help to mitigate this issue. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Berkey, C. S., Hoaglin, D. C., Mosteller, F., & Colditz, G. A. (1995). A random-effects regression model for meta-analysis. \emph{Statistics in Medicine}, \bold{14}(4), 395--411. \verb{https://doi.org/10.1002/sim.4780140406} Brannick, M. T., Potter, S. M., Benitez, B., & Morris, S. B. (2019). Bias and precision of alternate estimators in meta-analysis: Benefits of blending Schmidt–Hunter and Hedges approaches. \emph{Organizational Research Methods}, \bold{22}(2), 490--514. \verb{https://doi.org/10.1177/1094428117741966} Cochran, W. G. (1954). The combination of estimates from different experiments. \emph{Biometrics}, \bold{10}(1), 101--129. \verb{https://doi.org/10.2307/3001666} DerSimonian, R., & Laird, N. (1986). Meta-analysis in clinical trials. \emph{Controlled Clinical Trials}, \bold{7}(3), 177--188. \verb{https://doi.org/10.1016/0197-2456(86)90046-2} DerSimonian, R., & Kacker, R. (2007). Random-effects model for meta-analysis of clinical trials: An update. \emph{Contemporary Clinical Trials}, \bold{28}(2), 105--114. \verb{https://doi.org/10.1016/j.cct.2006.04.004} Hardy, R. J. & Thompson, S. G. (1996). A likelihood approach to meta-analysis with random effects. \emph{Statistics in Medicine}, \bold{15}(6), 619--629. \verb{https://doi.org/10.1002/(SICI)1097-0258(19960330)15:6<619::AID-SIM188>3.0.CO;2-A} Hartung, J. (1999). An alternative method for meta-analysis. \emph{Biometrical Journal}, \bold{41}(8), 901--916. \verb{https://doi.org/10.1002/(SICI)1521-4036(199912)41:8<901::AID-BIMJ901>3.0.CO;2-W} Harville, D. A. (1977). Maximum likelihood approaches to variance component estimation and to related problems. \emph{Journal of the American Statistical Association}, \bold{72}(358), 320--338. \verb{https://doi.org/10.2307/2286796} Hedges, L. V. (1983). A random effects model for effect sizes. \emph{Psychological Bulletin}, \bold{93}(2), 388--395. \verb{https://doi.org/10.1037/0033-2909.93.2.388} Hedges, L. V. (1992). Meta-analysis. \emph{Journal of Educational Statistics}, \bold{17}(4), 279--296. \verb{https://doi.org/10.3102/10769986017004279} Hedges, L. V., & Olkin, I. (1985). \emph{Statistical methods for meta-analysis}. San Diego, CA: Academic Press. Henmi, M., & Copas, J. B. (2010). Confidence intervals for random effects meta-analysis and robustness to publication bias. \emph{Statistics in Medicine}, \bold{29}(29), 2969--2983. \verb{https://doi.org/10.1002/sim.4029} Hunter, J. E., & Schmidt, F. L. (1990). \emph{Methods of meta-analysis: Correcting error and bias in research findings}. Thousand Oaks, CA: Sage. Jackson, D., Turner, R., Rhodes, K. & Viechtbauer, W. (2014). Methods for calculating confidence and credible intervals for the residual between-study variance in random effects meta-regression models. \emph{BMC Medical Research Methodology}, \bold{14}, 103. \verb{https://doi.org/10.1186/1471-2288-14-103} Jackson, D., Law, M., \enc{Rücker}{Ruecker}, G., & Schwarzer, G. (2017). The Hartung-Knapp modification for random-effects meta-analysis: A useful refinement but are there any residual concerns? \emph{Statistics in Medicine}, \bold{36}(25), 3923--3934. \verb{https://doi.org/10.1002/sim.7411} Jennrich, R. I., & Sampson, P. F. (1976). Newton-Raphson and related algorithms for maximum likelihood variance component estimation. \emph{Technometrics}, \bold{18}(1), 11--17. \verb{https://doi.org/10.2307/1267911} Knapp, G., & Hartung, J. (2003). Improved tests for a random effects meta-regression with a single covariate. \emph{Statistics in Medicine}, \bold{22}(17), 2693--2710. \verb{https://doi.org/10.1002/sim.1482} Morris, C. N. (1983). Parametric empirical Bayes inference: Theory and applications. \emph{Journal of the American Statistical Association}, \bold{78}(381), 47--55. \verb{https://doi.org/10.2307/2287098} Paule, R. C., & Mandel, J. (1982). Consensus values and weighting factors. \emph{Journal of Research of the National Bureau of Standards}, \bold{87}(5), 377--385. \verb{https://doi.org/10.6028/jres.087.022} Raudenbush, S. W. (2009). Analyzing effect sizes: Random effects models. In H. Cooper, L. V. Hedges, & J. C. Valentine (Eds.), \emph{The handbook of research synthesis and meta-analysis} (2nd ed., pp. 295--315). New York: Russell Sage Foundation. Sidik, K. & Jonkman, J. N. (2002). A simple confidence interval for meta-analysis. \emph{Statistics in Medicine}, \bold{21}(21), 3153--3159. \verb{https://doi.org/10.1002/sim.1262} Sidik, K., & Jonkman, J. N. (2005a). A note on variance estimation in random effects meta-regression. \emph{Journal of Biopharmaceutical Statistics}, \bold{15}(5), 823--838. \verb{https://doi.org/10.1081/BIP-200067915} Sidik, K., & Jonkman, J. N. (2005b). Simple heterogeneity variance estimation for meta-analysis. \emph{Journal of the Royal Statistical Society, Series C}, \bold{54}(2), 367--384. \verb{https://doi.org/10.1111/j.1467-9876.2005.00489.x} Sidik, K., & Jonkman, J. N. (2007). A comparison of heterogeneity variance estimators in combining results of studies. \emph{Statistics in Medicine}, \bold{26}(9), 1964--1981. \verb{https://doi.org/10.1002/sim.2688} Veroniki, A. A., Jackson, D., Viechtbauer, W., Bender, R., Bowden, J., Knapp, G., Kuss, O., Higgins, J. P., Langan, D., & Salanti, G. (2016). Methods to estimate the between-study variance and its uncertainty in meta-analysis. \emph{Research Synthesis Methods}, \bold{7}(1), 55--79. \verb{https://doi.org/10.1002/jrsm.1164} Viechtbauer, W. (2005). Bias and efficiency of meta-analytic variance estimators in the random-effects model. \emph{Journal of Educational and Behavioral Statistics}, \bold{30}(3), 261--293. \verb{https://doi.org/10.3102/10769986030003261} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W. (2021). Median-unbiased estimators for the amount of heterogeneity in meta-analysis. \emph{European Congress of Methodology}, Valencia, Spain. \verb{https://www.wvbauer.com/lib/exe/fetch.php/talks:2021_viechtbauer_eam_median_tau2.pdf} Viechtbauer, W., & \enc{López-López}{Lopez-Lopez}, J. A. (2022). Location-scale models for meta-analysis. \emph{Research Synthesis Methods}. \bold{13}(6), 697--715. \verb{https://doi.org/10.1002/jrsm.1562} Viechtbauer, W., \enc{López-López}{Lopez-Lopez}, J. A., \enc{Sánchez-Meca}{Sanchez-Meca}, J., & \enc{Marín-Martínez}{Marin-Martinez}, F. (2015). A comparison of procedures to test for moderators in mixed-effects meta-regression models. \emph{Psychological Methods}, \bold{20}(3), 360--374. \verb{https://doi.org/10.1037/met0000023} } \seealso{ \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for other model fitting functions. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit a random-effects model using the log risk ratios and sampling variances as input ### note: method="REML" is the default, so one could leave this out rma(yi, vi, data=dat, method="REML") ### fit a random-effects model using the log risk ratios and standard errors as input ### note: the second argument of rma() is for the *sampling variances*, so we use the ### named argument 'sei' to supply the standard errors to the function dat$sei <- sqrt(dat$vi) rma(yi, sei=sei, data=dat) ### fit a random-effects model supplying the 2x2 table cell frequencies to the function rma(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) ### fit a mixed-effects model with two moderators (absolute latitude and publication year) rma(yi, vi, mods=cbind(ablat, year), data=dat) ### using a model formula to specify the same model rma(yi, vi, mods = ~ ablat + year, data=dat) ### using a model formula as part of the yi argument rma(yi ~ ablat + year, vi, data=dat) ### manual dummy coding of the allocation factor alloc.random <- ifelse(dat$alloc == "random", 1, 0) alloc.alternate <- ifelse(dat$alloc == "alternate", 1, 0) alloc.systematic <- ifelse(dat$alloc == "systematic", 1, 0) ### test the allocation factor (in the presence of the other moderators) ### note: 'alternate' is the reference level of the allocation factor, ### since this is the dummy/level we leave out of the model ### note: the intercept is the first coefficient, so with btt=2:3 we test ### coefficients 2 and 3, corresponding to the coefficients for the ### allocation factor rma(yi, vi, mods = ~ alloc.random + alloc.systematic + year + ablat, data=dat, btt=2:3) ### using a model formula to specify the same model rma(yi, vi, mods = ~ factor(alloc) + year + ablat, data=dat, btt=2:3) ### factor() is not needed as character variables are automatically converted to factors rma(yi, vi, mods = ~ alloc + year + ablat, data=dat, btt=2:3) ### test all pairwise differences with Holm's method (using the 'multcomp' package if installed) res <- rma(yi, vi, mods = ~ factor(alloc) - 1, data=dat) res if (require(multcomp)) summary(glht(res, linfct=contrMat(c("alternate"=1,"random"=1,"systematic"=1), type="Tukey")), test=adjusted("holm")) ### subgrouping versus using a single model with a factor (subgrouping provides ### an estimate of tau^2 within each subgroup, but the number of studies in each ### subgroup is quite small; the model with the allocation factor provides a ### single estimate of tau^2 based on a larger number of studies, but assumes ### that tau^2 is the same within each subgroup) res.a <- rma(yi, vi, data=dat, subset=(alloc=="alternate")) res.r <- rma(yi, vi, data=dat, subset=(alloc=="random")) res.s <- rma(yi, vi, data=dat, subset=(alloc=="systematic")) res.a res.r res.s res <- rma(yi, vi, mods = ~ factor(alloc) - 1, data=dat) res ############################################################################ ### demonstrating that Q_E + Q_M = Q_Total for fixed-effects models ### note: this does not work for random/mixed-effects models, since Q_E and ### Q_Total are calculated under the assumption that tau^2 = 0, while the ### calculation of Q_M incorporates the estimate of tau^2 res <- rma(yi, vi, data=dat, method="FE") res ### this gives Q_Total res <- rma(yi, vi, mods = ~ ablat + year, data=dat, method="FE") res ### this gives Q_E and Q_M res$QE + res$QM ### decomposition of Q_E into subgroup Q-values res <- rma(yi, vi, mods = ~ factor(alloc), data=dat) res res.a <- rma(yi, vi, data=dat, subset=(alloc=="alternate")) res.r <- rma(yi, vi, data=dat, subset=(alloc=="random")) res.s <- rma(yi, vi, data=dat, subset=(alloc=="systematic")) res.a$QE ### Q-value within subgroup "alternate" res.r$QE ### Q-value within subgroup "random" res.s$QE ### Q-value within subgroup "systematic" res$QE res.a$QE + res.r$QE + res.s$QE ############################################################################ ### an example of a location-scale model dat <- dat.bangertdrowns2004 ### fit a standard random-effects model res <- rma(yi, vi, data=dat) res ### fit the same model as a location-scale model res <- rma(yi, vi, scale = ~ 1, data=dat) res ### check that we obtain the same estimate for tau^2 predict(res, newscale=1, transf=exp) ### add the total sample size (per 100) as a location and scale predictor dat$ni100 <- dat$ni/100 res <- rma(yi, vi, mods = ~ ni100, scale = ~ ni100, data=dat) res ### variables in the location and scale parts can differ res <- rma(yi, vi, mods = ~ ni100 + meta, scale = ~ ni100 + imag, data=dat) res } \keyword{models} metafor/man/regtest.Rd0000644000176200001440000003204514505063152014433 0ustar liggesusers\name{regtest} \alias{regtest} \title{Regression Test for Funnel Plot Asymmetry} \description{ Function to carry out (various versions of) Egger's regression test for funnel plot asymmetry. \loadmathjax } \usage{ regtest(x, vi, sei, ni, subset, data, model="rma", predictor="sei", ret.fit=FALSE, digits, \dots) } \arguments{ \item{x}{a vector with the observed effect sizes or outcomes or an object of class \code{"rma"}.} \item{vi}{vector with the corresponding sampling variances (ignored if \code{x} is an object of class \code{"rma"}).} \item{sei}{vector with the corresponding standard errors (note: only one of the two, \code{vi} or \code{sei}, needs to be specified).} \item{ni}{optional vector with the corresponding sample sizes (only relevant when using the sample sizes (or a transformation thereof) as predictor).} \item{subset}{optional (logical or numeric) vector to specify the subset of studies that should be included in the test (ignored if \code{x} is an object of class \code{"rma"}).} \item{data}{optional data frame containing the variables given to the arguments above.} \item{model}{either \code{"rma"} or \code{"lm"} to indicate the type of model to use for the regression test. See \sQuote{Details}.} \item{predictor}{either \code{"sei"} \code{"vi"}, \code{"ni"}, \code{"ninv"}, \code{"sqrtni"}, or \code{"sqrtninv"} to indicate the predictor to use for the regression test. See \sQuote{Details}.} \item{ret.fit}{logical to specify whether the full results from the fitted model should also be returned.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded.} \item{\dots}{other arguments.} } \details{ Various tests for funnel plot asymmetry have been suggested in the literature, including the rank correlation test by Begg and Mazumdar (1994) and the regression test by Egger et al. (1997). Extensions, modifications, and further developments of the regression test are described (among others) by Macaskill, Walter, and Irwig (2001), Sterne and Egger (2005), Harbord, Egger, and Sterne (2006), Peters et al. (2006), \enc{Rücker}{Ruecker} et al. (2008), and Moreno et al. (2009). The various versions of the regression test differ in terms of the model (either a weighted regression model with a multiplicative dispersion term or a fixed/mixed-effects meta-regression model is used), in terms of the predictor variable that the observed effect sizes or outcomes are hypothesized to be related to when publication bias is present (suggested predictors include the standard error, the sampling variance, and the sample size or transformations thereof), and in terms of the outcome measure used (e.g., for \mjeqn{2 \times 2}{2x2} table data, one has the choice between various outcome measures). The idea behind the various tests is the same though: If there is a relationship between the observed effect sizes or outcomes and the chosen predictor, then this usually implies asymmetry in the funnel plot, which in turn may be an indication of publication bias. The \code{regtest} function can be used to carry out various versions of the regression test. One can either pass a vector with the observed effect sizes or outcomes (via \code{x}) and the corresponding sampling variances via \code{vi} (or the standard errors via \code{sei}) to the function or an object of class \code{"rma"}. The model type for the regression test is chosen via the \code{model} argument, with \code{model="lm"} for a weighted regression model with a multiplicative dispersion term or \code{model="rma"} for a (mixed-effects) meta-regression model (the default). The predictor for the test is chosen via the \code{predictor} argument: \itemize{ \item \code{predictor="sei"} for the standard errors (the default), \item \code{predictor="vi"} for the sampling variances, \item \code{predictor="ni"} for the sample sizes, \item \code{predictor="ninv"} for the inverse of the sample sizes, \item \code{predictor="sqrtni"} for the square root of the sample sizes, or \item \code{predictor="sqrtninv"} for the inverse square root of the sample sizes. } The outcome measure used for the regression test is simply determined by the values passed to the function or the measure that was used in fitting the original model (when passing an object of class \code{"rma"} to the function). When using the sample sizes (or a transformation thereof) as the predictor, one can use the \code{ni} argument to specify the sample sizes. When \code{x} is a vector with the observed effect sizes or outcomes and it was computed with \code{\link{escalc}}, then the sample sizes should automatically be stored as an attribute of \code{x} and \code{ni} does not need to be specified. This should also be the case when passing an object of class \code{"rma"} to the function and the input to the model fitting function came from \code{\link{escalc}}. When passing an object of class \code{"rma"} to the function, arguments such as \code{method}, \code{weighted}, and \code{test} as used during the initial model fitting are also used for the regression test. If the model already included one or more moderators, then \code{regtest} will add the chosen predictor to the moderator(s) already included in the model. This way, one can test for funnel plot asymmetry after accounting first for the influence of the moderator(s) already included in the model. The model used for conducting the regression test can also be used to obtain a \sQuote{limit estimate} of the (average) true effect or outcome. In particular, when the standard errors, sampling variances, or inverse (square root) sample sizes are used as the predictor, the model intercept in essence reflects the estimate under infinite precision. This is sometimes (cautiously) interpreted as an estimate of the (average) true effect or outcome that is adjusted for publication bias. } \value{ An object of class \code{"regtest"}. The object is a list containing the following components: \item{model}{the model used for the regression test.} \item{predictor}{the predictor used for the regression test.} \item{zval}{the value of the test statistic.} \item{pval}{the corresponding p-value} \item{dfs}{the degrees of freedom of the test statistic (if the test is based on a t-distribution).} \item{fit}{the full results from the fitted model.} \item{est}{the limit estimate (only for predictors \code{"sei"} \code{"vi"}, \code{"ninv"}, or \code{"sqrtninv"} and when the model does not contain any additional moderators; \code{NULL} otherwise).} \item{ci.lb}{lower bound of the confidence interval for the limit estimate.} \item{ci.ub}{upper bound of the confidence intervals for the limit estimate.} The results are formatted and printed with the \code{\link[=print.regtest]{print}} function. } \note{ The classical \sQuote{Egger test} is obtained by setting \code{model="lm"} and \code{predictor="sei"}. For the random/mixed-effects version of the test, set \code{model="rma"} (this is the default). See Sterne and Egger (2005) for details on these two types of models/tests. When conducting a classical \sQuote{Egger test}, the test of the limit estimate is the same as the \sQuote{precision-effect test} (PET) of Stanley and Doucouliagos (2014). The limit estimate when using the sampling variance as predictor is sometimes called the \sQuote{precision-effect estimate with SE} (PEESE) (Stanley & Doucouliagos, 2014). A conditional procedure where we use the limit estimate when PET is not significant (i.e., when using the standard error as predictor) and the PEESE (i.e., when using the sampling variance as predictor) when PET is significant is sometimes called the PET-PEESE procedure (Stanley & Doucouliagos, 2014). All of the tests do not directly test for publication bias, but for a relationship between the observed effect sizes or outcomes and the chosen predictor. If such a relationship is present, then this usually implies asymmetry in the funnel plot, which in turn may be an indication of publication bias. However, it is important to keep in mind that there can be other reasons besides publication bias that could lead to asymmetry in the funnel plot. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Begg, C. B., & Mazumdar, M. (1994). Operating characteristics of a rank correlation test for publication bias. \emph{Biometrics}, \bold{50}(4), 1088--1101. \verb{https://doi.org/10.2307/2533446} Egger, M., Davey Smith, G., Schneider, M., & Minder, C. (1997). Bias in meta-analysis detected by a simple, graphical test. \emph{British Medical Journal}, \bold{315}(7109), 629--634. \verb{https://doi.org/10.1136/bmj.315.7109.629 } Harbord, R. M., Egger, M., & Sterne, J. A. C. (2006). A modified test for small-study effects in meta-analyses of controlled trials with binary endpoints. \emph{Statistics in Medicine}, \bold{25}(20), 3443--3457. \verb{https://doi.org/10.1002/sim.2380} Macaskill, P., Walter, S. D., & Irwig, L. (2001). A comparison of methods to detect publication bias in meta-analysis. \emph{Statistics in Medicine}, \bold{20}(4), 641--654. \verb{https://doi.org/10.1002/sim.698} Moreno, S. G., Sutton, A. J., Ades, A. E., Stanley, T. D., Abrams, K. R., Peters, J. L., & Cooper, N. J. (2009). Assessment of regression-based methods to adjust for publication bias through a comprehensive simulation study. \emph{BMC Medical Research Methodology}, \bold{9}, 2. \verb{https://doi.org/10.1186/1471-2288-9-2} Peters, J. L., Sutton, A. J., Jones, D. R., Abrams, K. R., & Rushton, L. (2006). Comparison of two methods to detect publication bias in meta-analysis. \emph{Journal of the American Medical Association}, \bold{295}(6), 676--680. \verb{https://doi.org/10.1001/jama.295.6.676} \enc{Rücker}{Ruecker}, G., Schwarzer, G., & Carpenter, J. (2008). Arcsine test for publication bias in meta-analyses with binary outcomes. \emph{Statistics in Medicine}, \bold{27}(5), 746--763. \verb{https://doi.org/10.1002/sim.2971} Stanley, T. D., & Doucouliagos, H. (2014). Meta-regression approximations to reduce publication selection bias. \emph{Research Synthesis Methods}, \bold{5}(1), 60--78. \verb{https://doi.org/10.1002/jrsm.1095} Sterne, J. A. C., & Egger, M. (2005). Regression methods to detect publication and other bias in meta-analysis. In H. R. Rothstein, A. J. Sutton, & M. Borenstein (Eds.) \emph{Publication bias in meta-analysis: Prevention, assessment, and adjustments} (pp. 99--110). Chichester, England: Wiley. Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{ranktest}} for the rank correlation test, \code{\link{trimfill}} for the trim and fill method, \code{\link{tes}} for the test of excess significance, \code{\link{fsn}} to compute the fail-safe N (file drawer analysis), and \code{\link{selmodel}} for selection models. } \examples{ ### copy data into 'dat' and examine data dat <- dat.egger2001 ### calculate log odds ratios and corresponding sampling variances (but remove ISIS-4 trial) dat <- escalc(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, subset=-16) ### fit random-effects model res <- rma(yi, vi, data=dat) res ### classical Egger test regtest(res, model="lm") ### mixed-effects meta-regression version of the Egger test regtest(res) ### same tests, but passing outcomes directly regtest(yi, vi, data=dat, model="lm") regtest(yi, vi, data=dat) ### if dat$yi is computed with escalc(), sample size information is stored in attributes dat$yi ### then this will also work regtest(yi, vi, data=dat, predictor="ni") ### similarly when passing a model object to the function regtest(res, model="lm", predictor="ni") regtest(res, model="lm", predictor="ninv") regtest(res, predictor="ni") regtest(res, predictor="ninv") ### otherwise have to supply sample sizes manually dat$yi <- c(dat$yi) # this removes the 'ni' attribute from 'yi' dat$nitotal <- with(dat, n1i + n2i) regtest(yi, vi, ni=nitotal, data=dat, predictor="ni") res <- rma(yi, vi, data=dat) regtest(res, predictor="ni", ni=nitotal, data=dat) ### standard funnel plot (with standard errors on the y-axis) funnel(res, refline=0) ### regression test (by default the standard errors are used as predictor) reg <- regtest(res) reg ### add regression line to funnel plot se <- seq(0,1.8,length=100) lines(coef(reg$fit)[1] + coef(reg$fit)[2]*se, se, lwd=3) ### regression test (using the sampling variances as predictor) reg <- regtest(res, predictor="vi") ### add regression line to funnel plot (using the sampling variances as predictor) lines(coef(reg$fit)[1] + coef(reg$fit)[2]*se^2, se, lwd=3, lty="dotted") ### add legend legend("bottomright", inset=0.02, lty=c("solid","dotted"), lwd=3, cex=0.9, bg="white", legend=c("Standard Errors as Predictor", "Sampling Variances as Predictor")) ### testing for asymmetry after accounting for the influence of a moderator res <- rma(yi, vi, mods = ~ year, data=dat) regtest(res, model="lm") regtest(res) } \keyword{htest} metafor/man/addpoly.predict.rma.Rd0000644000176200001440000001214214505063152016615 0ustar liggesusers\name{addpoly.predict.rma} \alias{addpoly.predict.rma} \title{Add Polygons to Forest Plots (Method for 'predict.rma' Objects)} \description{ Function to add one or more polygons to a forest plot based on an object of class \code{"predict.rma"}. } \usage{ \method{addpoly}{predict.rma}(x, rows=-2, annotate, addpred=FALSE, digits, width, mlab, transf, atransf, targs, efac, col, border, lty, fonts, cex, constarea=FALSE, \dots) } \arguments{ \item{x}{an object of class \code{"predict.rma"}.} \item{rows}{vector to specify the rows (or more generally, the horizontal positions) for plotting the polygons (defaults is \code{-2}). Can also be a single value to specify the row (horizontal position) of the first polygon (the remaining polygons are then plotted below this starting row).} \item{annotate}{optional logical to specify whether annotations should be added to the plot for the polygons that are drawn.} \item{addpred}{logical to specify whether the bounds of the prediction interval should be added to the plot (the default is \code{FALSE}).} \item{digits}{optional integer to specify the number of decimal places to which the annotations should be rounded.} \item{width}{optional integer to manually adjust the width of the columns for the annotations.} \item{mlab}{optional character vector with the same length as \code{x} giving labels for the polygons that are drawn.} \item{transf}{optional argument to specify a function to transform the \code{x} values and confidence interval bounds (e.g., \code{transf=exp}; see also \link{transf}).} \item{atransf}{optional argument to specify a function to transform the annotations (e.g., \code{atransf=exp}; see also \link{transf}).} \item{targs}{optional arguments needed by the function specified via \code{transf} or \code{atransf}.} \item{efac}{optional vertical expansion factor for the polygons.} \item{col}{optional character string to specify the color of the polygons.} \item{border}{optional character string to specify the border color of the polygons.} \item{lty}{optional character string to specify the line type for the prediction interval.} \item{fonts}{optional character string to specify the font for the labels and annotations.} \item{cex}{optional symbol expansion factor.} \item{constarea}{logical to specify whether the height of the polygons (when adding multiple) should be adjusted so that the area of the polygons is constant (the default is \code{FALSE}).} \item{\dots}{other arguments.} } \details{ The function can be used to add one or more polygons to an existing forest plot created with the \code{\link{forest}} function. For example, summary estimates based on a model involving moderators can be added to the plot this way (see \sQuote{Examples}). To use the function, one should specify the values at which the polygons should be drawn (via the \code{x} argument) together with the corresponding variances (via the \code{vi} argument) or with the corresponding standard errors (via the \code{sei} argument). Alternatively, one can specify the values at which the polygons should be drawn together with the corresponding confidence interval bounds (via the \code{ci.lb} and \code{ci.ub} arguments). Optionally, one can also specify the bounds of the corresponding prediction interval bounds via the \code{pi.lb} and \code{pi.ub} arguments. If unspecified, arguments \code{annotate}, \code{digits}, \code{width}, \code{transf}, \code{atransf}, \code{targs}, \code{efac} (only if the forest plot was created with \code{\link{forest.rma}}), \code{fonts}, \code{cex}, \code{annosym}, and \code{textpos} are automatically set equal to the same values that were used when creating the forest plot. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{forest}} for functions to draw forest plots to which polygons can be added. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, slab=paste(author, year, sep=", ")) ### forest plot of the observed risk ratios with(dat, forest(yi, vi, atransf=exp, xlim=c(-9,5), ylim=c(-4.5,15), at=log(c(0.05, 0.25, 1, 4)), cex=0.9, order=alloc, ilab=alloc, ilab.xpos=-4.5, header="Author(s) and Year", top=2)) ### fit mixed-effects model with allocation method as a moderator res <- rma(yi, vi, mods = ~ 0 + alloc, data=dat) ### predicted log risk ratios for the different allocation methods x <- predict(res, newmods=diag(3)) ### add predicted average risk ratios to forest plot addpoly(x, efac=1.3, col="gray", addpred=TRUE, mlab=c("Alternate Allocation", "Random Allocation", "Systematic Allocation")) abline(h=0) text(-9, -1, "Model-Based Estimates:", pos=4, cex=0.9, font=2) text(-4.5, res$k+2, "Allocation", cex=0.9, font=2) } \keyword{aplot} metafor/man/fitstats.Rd0000644000176200001440000000705014505063152014615 0ustar liggesusers\name{fitstats} \alias{fitstats} \alias{fitstats.rma} \alias{logLik.rma} \alias{deviance.rma} \alias{AIC.rma} \alias{BIC.rma} \alias{nobs.rma} \alias{df.residual.rma} \title{Fit Statistics and Information Criteria for 'rma' Objects} \description{ Functions to extract the log-likelihood, deviance, AIC, BIC, and AICc values from objects of class \code{"rma"}. \loadmathjax } \usage{ fitstats(object, \dots) \method{fitstats}{rma}(object, \dots, REML) \method{logLik}{rma}(object, REML, \dots) \method{deviance}{rma}(object, REML, \dots) \method{AIC}{rma}(object, \dots, k=2, correct=FALSE) \method{BIC}{rma}(object, \dots) } \arguments{ \item{object}{an object of class \code{"rma"}.} \item{\dots}{optionally more fitted model objects (only for \code{fitstats()}, \code{AIC()}, and \code{BIC()}).} \item{REML}{logical to specify whether the regular or restricted likelihood function should be used to obtain the fit statistics and information criteria. Defaults to the method of estimation used (i.e., \code{TRUE} if \code{object} was fitted with \code{method="REML"} and \code{FALSE} otherwise).} \item{k}{numeric value to specify the penalty per parameter. The default (\code{k=2}) is the classical AIC. See \code{\link{AIC}} for more details.} \item{correct}{logical to specify whether the regular (default) or corrected (i.e., AICc) should be extracted.} } \value{ For \code{fitstats}, a data frame with the (restricted) log-likelihood, deviance, AIC, BIC, and AICc values for each model passed to the function. For \code{logLik}, an object of class \code{"logLik"}, providing the (restricted) log-likelihood of the model evaluated at the estimated coefficient(s). For \code{deviance}, a numeric value with the corresponding deviance. For \code{AIC} and \code{BIC}, either a numeric value with the corresponding AIC, AICc, or BIC or a data frame with rows corresponding to the models and columns representing the number of parameters in the model (\code{df}) and the AIC, AICc, or BIC. } \note{ Variance components in the model (e.g., \mjseqn{\tau^2} in random/mixed-effects models fitted with \code{\link{rma.uni}}) are counted as additional parameters in the calculation of the AIC, BIC, and AICc. Also, the fixed effects are counted as parameters in the calculation of the AIC, BIC, and AICc even when using REML estimation. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models for which fit statistics and information criteria can be extracted. \code{\link[=anova.rma]{anova}} for a function to conduct likelihood ratio tests. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### random-effects model res1 <- rma(yi, vi, data=dat, method="ML") ### mixed-effects model with absolute latitude and publication year as moderators res2 <- rma(yi, vi, mods = ~ ablat + year, data=dat, method="ML") ### compare fit statistics fitstats(res1, res2) ### log-likelihoods logLik(res1) logLik(res2) ### deviances deviance(res1) deviance(res2) ### AIC, AICc, and BIC values AIC(res1, res2) AIC(res1, res2, correct=TRUE) BIC(res1, res2) } \keyword{models} metafor/man/coef.rma.Rd0000644000176200001440000000424214505063152014446 0ustar liggesusers\name{coef.rma} \alias{coef} \alias{coef.rma} \alias{coef.summary.rma} \title{Extract the Model Coefficients and Coefficient Table from 'rma' and 'summary.rma' Objects} \description{ Function to extract the estimated model coefficients from objects of class \code{"rma"}. For objects of class \code{"summary.rma"}, the model coefficients, corresponding standard errors, test statistics, p-values, and confidence interval bounds are extracted. } \usage{ \method{coef}{rma}(object, \dots) \method{coef}{summary.rma}(object, \dots) } \arguments{ \item{object}{an object of class \code{"rma"} or \code{"summary.rma"}.} \item{\dots}{other arguments.} } \value{ Either a vector with the estimated model coefficient(s) or a data frame with the following elements: \item{estimate}{estimated model coefficient(s).} \item{se}{corresponding standard error(s).} \item{zval}{corresponding test statistic(s).} \item{pval}{corresponding p-value(s).} \item{ci.lb}{corresponding lower bound of the confidence interval(s).} \item{ci.ub}{corresponding upper bound of the confidence interval(s).} When the model was fitted with \code{test="t"} or \code{test="knha"}, then \code{zval} is called \code{tval} in the data frame that is returned by the function. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models for which model coefficients/tables can be extracted. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit mixed-effects model with absolute latitude and publication year as moderators res <- rma(yi, vi, mods = ~ ablat + year, data=dat) ### extract model coefficients coef(res) ### extract model coefficient table coef(summary(res)) } \keyword{models} metafor/man/transf.Rd0000644000176200001440000003765714505063152014271 0ustar liggesusers\name{transf} \alias{transf} \alias{transf.rtoz} \alias{transf.ztor} \alias{transf.logit} \alias{transf.ilogit} \alias{transf.arcsin} \alias{transf.iarcsin} \alias{transf.pft} \alias{transf.ipft} \alias{transf.ipft.hm} \alias{transf.isqrt} \alias{transf.irft} \alias{transf.iirft} \alias{transf.ahw} \alias{transf.iahw} \alias{transf.abt} \alias{transf.iabt} \alias{transf.r2toz} \alias{transf.ztor2} \alias{transf.ztor.int} \alias{transf.exp.int} \alias{transf.ilogit.int} \alias{transf.dtou1} \alias{transf.dtou2} \alias{transf.dtou3} \alias{transf.dtocles} \alias{transf.dtobesd} \alias{transf.dtomd} \alias{transf.dtorpb} \alias{transf.dtorbis} \alias{transf.rpbtorbis} \alias{transf.rtorpb} \alias{transf.rtod} \alias{transf.rpbtod} \alias{transf.lnortord} \alias{transf.lnortorr} \alias{transf.lnortod.norm} \alias{transf.lnortod.logis} \alias{transf.dtolnor.norm} \alias{transf.dtolnor.logis} \alias{transf.lnortortet.pearson} \alias{transf.lnortortet.digby} \title{Transformation Functions} \description{ Functions to carry out various types of transformations that are useful for meta-analyses. \loadmathjax } \usage{ transf.rtoz(xi) transf.ztor(xi) transf.logit(xi) transf.ilogit(xi) transf.arcsin(xi) transf.iarcsin(xi) transf.pft(xi, ni) transf.ipft(xi, ni) transf.ipft.hm(xi, targs) transf.isqrt(xi) transf.irft(xi, ti) transf.iirft(xi, ti) transf.ahw(xi) transf.iahw(xi) transf.abt(xi) transf.iabt(xi) transf.r2toz(xi) transf.ztor2(xi) transf.ztor.int(xi, targs) transf.exp.int(xi, targs) transf.ilogit.int(xi, targs) transf.dtou1(xi) transf.dtou2(xi) transf.dtou3(xi) transf.dtobesd(xi) transf.dtomd(xi, targs) transf.dtorpb(xi, n1i, n2i) transf.dtorbis(xi, n1i, n2i) transf.rpbtorbis(xi, pi) transf.rtorpb(xi, pi) transf.rtod(xi, n1i, n2i) transf.rpbtod(xi, n1i, n2i) transf.lnortord(xi, pc) transf.lnortorr(xi, pc) transf.lnortod.norm(xi) transf.lnortod.logis(xi) transf.dtolnor.norm(xi) transf.dtolnor.logis(xi) transf.lnortortet.pearson(xi) transf.lnortortet.digby(xi) } \arguments{ \item{xi}{vector of values to be transformed.} \item{ni}{vector of sample sizes.} \item{n1i}{vector of sample sizes for the first group.} \item{n2i}{vector of sample sizes for the second group.} \item{ti}{vector of person-times at risk.} \item{pc}{control group risk (either a single value or a vector).} \item{pi}{proportion of individuals falling into the first of the two groups that is created by the dichotomization.} \item{targs}{list with additional arguments for the transformation function. See \sQuote{Details}.} } \details{ The following transformation functions are currently implemented: \itemize{ \item \code{transf.rtoz}: Fisher's r-to-z transformation for correlation coefficients (same as \code{atanh(x)}). \item \code{transf.ztor}: inverse of the former (i.e., the z-to-r transformation; same as \code{tanh(x)}). \item \code{transf.logit}: logit (log odds) transformation for proportions (same as \code{qlogis(x)}). \item \code{transf.ilogit}: inverse of the former (same as \code{plogis(x)}). \item \code{transf.arcsin}: arcsine square root transformation for proportions. \item \code{transf.iarcsin}: inverse of the former. \item \code{transf.pft}: Freeman-Tukey (double arcsine) transformation for proportions. See Freeman & Tukey (1950). The \code{xi} argument is used to specify the proportions and the \code{ni} argument the corresponding sample sizes. \item \code{transf.ipft}: inverse of the former. See Miller (1978). \item \code{transf.ipft.hm}: inverse of the former, using the harmonic mean of the sample sizes for the back-transformation. See Miller (1978). The sample sizes are specified via the \code{targs} argument (the list element should be called \code{ni}). \item \code{transf.isqrt}: inverse of the square root transformation (i.e., function to square a number). \item \code{transf.irft}: Freeman-Tukey transformation for incidence rates. See Freeman & Tukey (1950). The \code{xi} argument is used to specify the incidence rates and the \code{ti} argument the corresponding person-times at risk. \item \code{transf.iirft}: inverse of the former. \item \code{transf.ahw}: transformation of coefficient alpha as suggested by Hakstian & Whalen (1976), except that \mjeqn{1-(1-\alpha)^{1/3}}{1-(1-\alpha)^(1/3)} is used (so that the transformed values are a monotonically increasing function of the \mjseqn{\alpha} values). \item \code{transf.iahw}: inverse of the former. \item \code{transf.abt}: transformation of coefficient alpha as suggested by Bonett (2002), except that \mjeqn{-\ln(1-\alpha)}{-ln(1-\alpha)} is used (so that the transformed values are a monotonically increasing function of the \mjseqn{\alpha} values). \item \code{transf.iabt}: inverse of the former. \item \code{transf.r2toz}: variance stabilizing transformation for the coefficient of determination, given by \mjeqn{z_i = \frac{1}{2} \log \left[\frac{1+\sqrt{R_i^2}}{1-\sqrt{R_i^2}}\right]}{z_i = 1/2 log[(1+\sqrt(R_i^2))/(1-\sqrt(R_i^2))]} (see Olkin & Finn, 1995, but with the additional \mjseqn{\frac{1}{2}} factor). \item \code{transf.ztor2}: inverse of the former. \item \code{transf.ztor.int}: integral transformation method for the z-to-r transformation. \item \code{transf.exp.int}: integral transformation method for the exponential transformation. \item \code{transf.ilogit.int}: integral transformation method for the inverse logit transformation. \item \code{transf.dtou1}: transformation of standardized mean differences to Cohen's \mjseqn{U_1} values (Cohen, 1988). Under the assumption that the data for those in the first (say, treated) and second (say, control) group are normally distributed with equal variances but potentially different means, Cohen's \mjseqn{U_1} indicates the proportion of non-overlap between the two distributions (i.e., when \mjseqn{d=0}, then \mjseqn{U_1} is equal to 0, which goes to 1 as \mjseqn{d} increases). \item \code{transf.dtou2}: transformation of standardized mean differences to Cohen's \mjseqn{U_2} values (Cohen, 1988). Under the same assumptions as above, Cohen's \mjseqn{U_2} indicates the proportion in the first group that exceeds the same proportion in the second group (i.e., when \mjseqn{d=0}, then \mjseqn{U_2} is equal to 0.5, which goes to 1 as \mjseqn{d} increases). \item \code{transf.dtou3}: transformation of standardized mean differences to Cohen's \mjseqn{U_3} values (Cohen, 1988). Under the same assumptions as above, Cohen's \mjseqn{U_3} indicates the proportion of individuals in the first group that have a higher value than the mean of those in the second group (i.e., when \mjseqn{d=0}, then \mjseqn{U_3} is equal to 0.5, which goes to 1 as \mjseqn{d} increases). \item \code{transf.dtocles}: transformation of standardized mean differences to common language effect size (CLES) values (McGraw & Wong, 1992) (also called the probability of superiority). A CLES value indicates the probability that a randomly sampled individual from the first group has a higher value than a randomly sampled individual from the second group (i.e., when \mjseqn{d=0}, then the CLES is equal to 0.5, which goes to 1 as \mjseqn{d} increases). \item \code{transf.dtobesd}: transformation of standardized mean differences to binomial effect size display values (Rosenthal & Rubin, 1982). Note that the function only provides the proportion in the first group scoring above the median (the proportion in the second group scoring above the median is simply one minus this value). \item \code{transf.dtomd}: transformation of standardized mean differences to mean differences given a known standard deviation (which needs to be specified via the \code{targs} argument). \item \code{transf.dtorpb}: transformation of standardized mean differences to point-biserial correlations. Arguments \code{n1i} and \code{n2i} denote the number of individuals in the first and second group, respectively. If \code{n1i} and \code{n2i} are not specified, the function assumes \code{n1i = n2i} and uses the approximate formula \mjeqn{r_{pb} = \frac{d}{\sqrt{d^2 + 4}}}{r_pb = d / \sqrt{d^2 + 4}}. If \code{n1i} and \code{n2i} are specified, the function uses the exact transformation formula \mjeqn{r_{pb} = \frac{d}{\sqrt{d^2 + h}}}{r_pb = d / \sqrt{d^2 + h}}, where \mjeqn{h = \frac{m}{n_1} + \frac{m}{n_2}}{h = m / n_1 + m / n_2} and \mjseqn{m = n_1 + n_2 - 2} (Jacobs & Viechtbauer, 2017). \item \code{transf.dtorbis}: transformation of standardized mean differences to biserial correlations. Like \code{transf.dtorpb}, but the point-biserial correlations are then transformed to biserial correlations with \mjeqn{r_{bis} = \frac{\sqrt{p(1-p)}}{f(z_p)} r_{pb}}{r_bis = sqrt(p*(1-p)) / f(z_p) r_pb}, where \mjseqn{p = \frac{n1}{n1+n2}} and \mjseqn{f(z_p)} denotes the density of the standard normal distribution at value \mjseqn{z_p}, which is the point for which \mjseqn{P(Z > z_p) = p}, with \mjseqn{Z} denoting a random variable following a standard normal distribution (Jacobs & Viechtbauer, 2017). \item \code{transf.rpbtorbis}: transformation of point-biserial correlations to biserial correlations. Argument \code{pi} denotes the proportion of individuals falling into the first of the two groups that is created by the dichotomization (hence, \code{1-pi} falls into the second group). If \code{pi} is not specified, the function assumes \code{pi=0.5}, which corresponds to dichotomization at the median. The transformation is carried out as described for \code{transf.dtorbis}. \item \code{transf.rtorpb}: transformation of Pearson product-moment correlations to the corresponding point-biserial correlations, when one of the two variables is dichotomized. Argument \code{pi} can be used to denote the proportion of individuals falling into the first of the two groups that is created by the dichotomization (hence, \code{1-pi} falls into the second group). If \code{pi} is not specified, the function assumes \code{pi=0.5}, which corresponds to dichotomization at the median. This function is simply the inverse of \code{transf.rpbtorbis}. \item \code{transf.rtod}: transformation of Pearson product-moment correlations to the corresponding standardized mean differences, when one of the two variables is dichotomized. Arguments \code{n1i} and \code{n2i} can be used to denote the number of individuals in the first and second group created by the dichotomization. If \code{n1i} and \code{n2i} are not specified, the function assumes \code{n1i = n2i}. This function is simply the inverse of \code{transf.dtorbis}. \item \code{transf.rpbtod}: transformation of point-biserial correlations to standardized mean differences. This is simply the inverse of \code{transf.dtorpb}. \item \code{transf.lnortord}: transformation of log odds ratios to risk differences, assuming a particular value for the control group risk (which needs to be specified via the \code{pc} argument). \item \code{transf.lnortorr}: transformation of log odds ratios to risk ratios, assuming a particular value for the control group risk (which needs to be specified via the \code{pc} argument). \item \code{transf.lnortod.norm}: transformation of log odds ratios to standardized mean differences (assuming normal distributions) (Cox & Snell, 1989). \item \code{transf.lnortod.logis}: transformation of log odds ratios to standardized mean differences (assuming logistic distributions) (Chinn, 2000). \item \code{transf.dtolnor.norm}: transformation of standardized mean differences to log odds ratios (assuming normal distributions) (Cox & Snell, 1989). \item \code{transf.dtolnor.logis}: transformation of standardized mean differences to log odds ratios (assuming logistic distributions) (Chinn, 2000). \item \code{transf.lnortortet.pearson}: transformation of log odds ratios to tetrachoric correlations as suggested by Pearson (1900). \item \code{transf.lnortortet.digby}: transformation of log odds ratios to tetrachoric correlations as suggested by Digby (1983). } } \value{ A vector with the transformed values. } \note{ The integral transformation method for a transformation function \mjseqn{h(z)} is given by \mjsdeqn{\int_{\textrm{lower}}^{\textrm{upper}} h(z) f(z) dz} using the limits \code{targs$lower} and \code{targs$upper}, where \mjseqn{f(z)} is the density of a normal distribution with mean equal to \code{xi} and variance equal to \code{targs$tau2}. An example is provided below. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Bonett, D. G. (2002). Sample size requirements for testing and estimating coefficient alpha. \emph{Journal of Educational and Behavioral Statistics}, \bold{27}(4), 335--340. \verb{https://doi.org/10.3102/10769986027004335} Chinn, S. (2000). A simple method for converting an odds ratio to effect size for use in meta-analysis. \emph{Statistics in Medicine}, \bold{19}(22), 3127--3131. \verb{https://doi.org/10.1002/1097-0258(20001130)19:22<3127::aid-sim784>3.0.co;2-m} Cohen, J. (1988). \emph{Statistical power analysis for the behavioral sciences} (2nd ed.). Hillsdale, NJ: Lawrence Erlbaum Associates. Cox, D. R., & Snell, E. J. (1989). \emph{Analysis of binary data} (2nd ed.). London: Chapman & Hall. Digby, P. G. N. (1983). Approximating the tetrachoric correlation coefficient. \emph{Biometrics}, \bold{39}(3), 753--757. \verb{https://doi.org/10.2307/2531104} Fisher, R. A. (1921). On the \dQuote{probable error} of a coefficient of correlation deduced from a small sample. \emph{Metron}, \bold{1}, 1--32. \verb{http://hdl.handle.net/2440/15169} Freeman, M. F., & Tukey, J. W. (1950). Transformations related to the angular and the square root. \emph{Annals of Mathematical Statistics}, \bold{21}(4), 607--611. \verb{https://doi.org/10.1214/aoms/1177729756} Hakstian, A. R., & Whalen, T. E. (1976). A k-sample significance test for independent alpha coefficients. \emph{Psychometrika}, \bold{41}(2), 219--231. \verb{https://doi.org/10.1007/BF02291840} Jacobs, P., & Viechtbauer, W. (2017). Estimation of the biserial correlation and its sampling variance for use in meta-analysis. \emph{Research Synthesis Methods}, \bold{8}(2), 161--180. \verb{https://doi.org/10.1002/jrsm.1218} McGraw, K. O., & Wong, S. P. (1992). A common language effect size statistic. \emph{Psychological Bulletin}, \bold{111}(2), 361--365. \verb{https://doi.org/10.1037/0033-2909.111.2.361} Miller, J. J. (1978). The inverse of the Freeman-Tukey double arcsine transformation. \emph{American Statistician}, \bold{32}(4), 138. \verb{https://doi.org/10.1080/00031305.1978.10479283} Olkin, I., & Finn, J. D. (1995). Correlations redux. \emph{Psychological Bulletin}, \bold{118}(1), 155--164. \verb{https://doi.org/10.1037/0033-2909.118.1.155} Pearson, K. (1900). Mathematical contributions to the theory of evolution. VII. On the correlation of characters not quantitatively measurable. \emph{Philosophical Transactions of the Royal Society of London, Series A}, \bold{195}, 1--47. \verb{https://doi.org/10.1098/rsta.1900.0022} Rosenthal, R., & Rubin, D. B. (1982). A simple, general purpose display of magnitude of experimental effect. \emph{Journal of Educational Psychology}, \bold{74}(2), 166--169. \verb{https://doi.org/10.1037/0022-0663.74.2.166} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit random-effects model res <- rma(yi, vi, data=dat) ### average risk ratio with 95\% CI (but technically, this provides an ### estimate of the median risk ratio, not the mean risk ratio!) predict(res, transf=exp) ### average risk ratio with 95\% CI using the integral transformation predict(res, transf=transf.exp.int, targs=list(tau2=res$tau2, lower=-4, upper=4)) ### this also works predict(res, transf=transf.exp.int, targs=list(tau2=res$tau2)) ### this as well predict(res, transf=transf.exp.int, targs=res$tau2) } \keyword{manip} metafor/man/selmodel.Rd0000644000176200001440000012000314505063152014552 0ustar liggesusers\name{selmodel} \alias{selmodel} \alias{selmodel.rma.uni} \title{Selection Models} \description{ Function to fit selection models. \loadmathjax } \usage{ selmodel(x, \dots) \method{selmodel}{rma.uni}(x, type, alternative="greater", prec, delta, steps, verbose=FALSE, digits, control, \dots) } \arguments{ \item{x}{an object of class \code{"rma.uni"}.} \item{type}{character string to specify the type of selection model. Possible options are \code{"beta"}, \code{"halfnorm"}, \code{"negexp"}, \code{"logistic"}, \code{"power"}, \code{"negexppow"}, \code{"stepfun"}, \code{"trunc"}, and \code{"truncest"}. Can be abbreviated. See \sQuote{Details}.} \item{alternative}{character string to specify the sidedness of the hypothesis when testing the observed outcomes. Possible options are \code{"greater"} (the default), \code{"less"}, or \code{"two.sided"}. Can be abbreviated.} \item{prec}{optional character string to specify the measure of precision (only relevant for selection models that can incorporate this into the selection function). Possible options are \code{"sei"}, \code{"vi"}, \code{"ninv"}, or \code{"sqrtninv"}. See \sQuote{Details}.} \item{delta}{optional numeric vector (of the same length as the number of selection model parameters) to fix the corresponding \mjseqn{\delta} value(s). A specific \mjseqn{\delta} value can be fixed by setting the corresponding element of this argument to the desired value. A specific \mjseqn{\delta} value will be estimated if the corresponding element is set equal to \code{NA}. See \sQuote{Details}.} \item{steps}{numeric vector of one or more values that can or must be specified for certain selection functions. See \sQuote{Details}.} \item{verbose}{logical to specify whether output should be generated on the progress of the model fitting (the default is \code{FALSE}). Can also be an integer. Values > 1 generate more verbose output. See \sQuote{Note}.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} \item{control}{optional list of control values for the estimation algorithm. See \sQuote{Note}.} \item{\dots}{other arguments.} } \details{ Selection models are a general class of models that attempt to model the process by which the studies included in a meta-analysis may have been influenced by some form of publication bias. If a particular selection model is an adequate approximation for the underlying selection process, then the model provides estimates of the parameters of interest (e.g., the average true outcome and the amount of heterogeneity in the true outcomes) that are \sQuote{corrected} for this selection process (i.e., they are estimates of the parameters in the population of studies before any selection has taken place). The present function fits a variety of such selection models. To do so, one should pass an object fitted with the \code{\link{rma.uni}} function to the first argument. The model that will then be fitted is of the same form as the original model combined with the specific selection model chosen (see below for possible options). For example, if the original model was a random-effects model, then a random-effects selection model will be fitted. Similarly, if the original model included moderators, then they will also be accounted for in the selection model fitted. Model fitting is done via maximum likelihood (ML) estimation over the fixed- and random-effects parameters (e.g., \mjseqn{\mu} and \mjseqn{\tau^2} in a random-effects model) and the selection model parameters. Argument \code{type} determines the specific type of selection model that should be fitted. Many selection models are based on the idea that selection may haven taken place based on the p-values of the studies. In particular, let \mjseqn{y_i} and \mjseqn{v_i} denote the observed outcome and the corresponding sampling variance of the \mjeqn{i\textrm{th}}{ith} study. Then \mjseqn{z_i = y_i / \sqrt{v_i}} is the (Wald-type) test statistic for testing the null hypothesis \mjeqn{\mbox{H}_0{:}\; \theta_i = 0}{H_0: \theta_i = 0} and \mjseqn{p_i = 1 - \Phi(z_i)} (if \code{alternative="greater"}), \mjseqn{p_i = \Phi(z_i)} (if \code{alternative="less"}), or \mjseqn{p_i = 2(1 - \Phi(|z_i|))} (if \code{alternative="two.sided"}) the corresponding (one- or two-sided) p-value, where \mjseqn{\Phi()} denotes the cumulative distribution function of a standard normal distribution. Finally, let \mjseqn{w(p_i)} denote some function that specifies the relative likelihood of selection given the p-value of a study. If \mjseqn{w(p_i) > w(p_{i'})} when \mjseqn{p_i < p_{i'}} (i.e., \mjseqn{w(p_i)} is larger for smaller p-values), then \code{alternative="greater"} implies selection in favor of increasingly significant positive outcomes, \code{alternative="less"} implies selection in favor of increasingly significant negative outcomes, and \code{alternative="two.sided"} implies selection in favor of increasingly significant outcomes regardless of their direction. \subsection{Beta Selection Model}{ When \code{type="beta"}, the function can be used to fit the \sQuote{beta selection model} by Citkowicz and Vevea (2017). For this model, the selection function is given by \mjsdeqn{w(p_i) = p_i^{\delta_1 - 1} \times (1 - p_i)^{\delta_2 - 1}} where \mjseqn{\delta_1 > 0} and \mjseqn{\delta_2 > 0}. The null hypothesis \mjeqn{\mbox{H}_0{:}\; \delta_1 = \delta_2 = 1}{H_0: \delta_1 = \delta_2 = 1} represents the case where there is no selection (at least not depending on the p-values). \ifelse{text}{}{The figure below illustrates with some examples how the relative likelihood of selection can depend on the p-value for various combinations of \mjseqn{\delta_1} and \mjseqn{\delta_2}.} Note that the model allows for a non-monotonic selection function. \if{html}{\figure{selmodel-beta.png}{options: width=600}} \if{latex}{\figure{selmodel-beta.pdf}{options: width=4in}} } \subsection{Half-Normal, Negative-Exponential, Logistic, and Power Selection Models}{ Preston et al. (2004) suggested the first three of the following selection functions: \tabular{lllll}{ \bold{name} \tab \ics \tab \bold{\code{type}} \tab \ics \tab \bold{selection function} \cr half-normal \tab \ics \tab \code{"halfnorm"} \tab \ics \tab \mjseqn{w(p_i) = \exp(-\delta \times p_i^2)} \cr negative-exponential \tab \ics \tab \code{"negexp"} \tab \ics \tab \mjseqn{w(p_i) = \exp(-\delta \times p_i)} \cr logistic \tab \ics \tab \code{"logistic"} \tab \ics \tab \mjseqn{w(p_i) = 2 \times \exp(-\delta \times p_i) / (1 + \exp(-\delta \times p_i))} \cr power \tab \ics \tab \code{"power"} \tab \ics \tab \mjseqn{w(p_i) = (1-p_i)^\delta}} The power selection model is added here as it has similar properties as the models suggested by Preston et al. (2004). For all models, assume \mjseqn{\delta \ge 0}, so that all functions imply a monotonically decreasing relationship between the p-value and the selection probability. For all functions, \mjeqn{\mbox{H}_0{:}\; \delta = 0}{H_0: \delta = 0} implies no selection. \ifelse{text}{}{The figure below shows the relative likelihood of selection as a function of the p-value for \mjseqn{\delta = 0} and for the various selection functions when \mjseqn{\delta = 6}.} \if{html}{\figure{selmodel-preston.png}{options: width=600}} \if{latex}{\figure{selmodel-preston.pdf}{options: width=4in}} Here, these functions are extended to allow for the possibility that \mjseqn{w(p_i) = 1} for p-values below a certain significance threshold denoted by \mjseqn{\alpha} (e.g., to model the case that the relative likelihood of selection is equally high for all significant studies but decreases monotonically for p-values above the significance threshold). To fit such a selection model, one should specify the \mjseqn{\alpha} value (with \mjseqn{0 < \alpha < 1}) via the \code{steps} argument. There must be at least one observed p-value below and one observed p-value above the chosen threshold to fit these models. \ifelse{text}{}{The figure below shows some examples of the relative likelihood of selection when \code{steps=.05}.} \if{html}{\figure{selmodel-preston-step.png}{options: width=600}} \if{latex}{\figure{selmodel-preston-step.pdf}{options: width=4in}} Preston et al. (2004) also suggested selection functions where the relatively likelihood of selection not only depends on the p-value, but also the precision (e.g., standard error) of the estimate (if two studies have similar p-values, it may be plausible to assume that the larger / more precise study has a higher probability of selection). These selection functions (plus the corresponding power function) are given by: \tabular{lllll}{ \bold{name} \tab \ics \tab \bold{\code{type}} \tab \ics \tab \bold{selection function} \cr half-normal \tab \ics \tab \code{"halfnorm"} \tab \ics \tab \mjseqn{w(p_i) = \exp(-\delta \times \mathrm{prec}_i \times p_i^2)} \cr negative-exponential \tab \ics \tab \code{"negexp"} \tab \ics \tab \mjseqn{w(p_i) = \exp(-\delta \times \mathrm{prec}_i \times p_i)} \cr logistic \tab \ics \tab \code{"logistic"} \tab \ics \tab \mjseqn{w(p_i) = 2 \times \exp(-\delta \times \mathrm{prec}_i \times p_i) / (1 + \exp(-\delta \times \mathrm{prec}_i \times p_i))} \cr power \tab \ics \tab \code{"power"} \tab \ics \tab \mjseqn{w(p_i) = (1-p_i)^{\delta \times \mathrm{prec}_i}}} where \mjseqn{\mathrm{prec}_i = \sqrt{v_i}} (i.e., the standard error of the \mjeqn{i\textrm{th}}{ith} study) according to Preston et al. (2004). Here, this idea is generalized to allow the user to specify the specific measure of precision to use (via the \code{prec} argument). Possible options are: \itemize{ \item \code{prec="sei"} for the standard errors, \item \code{prec="vi"} for the sampling variances, \item \code{prec="ninv"} for the inverse of the sample sizes, \item \code{prec="sqrtninv"} for the inverse square root of the sample sizes. } Using some function of the sample sizes as a measure of precision is only possible when information about the sample sizes is actually stored within the object passed to the \code{selmodel} function. See \sQuote{Note}. Note that \mjseqn{\mathrm{prec}_i} is really a measure of imprecision (with higher values corresponding to lower precision). Also, regardless of the specific measure chosen, the values are actually rescaled with \mjseqn{\mathrm{prec}_i = \mathrm{prec}_i / \max(\mathrm{prec}_i)} inside of the function, such that \mjseqn{\mathrm{prec}_i = 1} for the least precise study and \mjseqn{\mathrm{prec}_i < 1} for the remaining studies (the rescaling does not actually change the fit of the model, it only helps to improve the stability of model fitting algorithm). \ifelse{text}{}{The figure below shows some examples of the relative likelihood of selection using these selection functions for two different precision values (note that lower values of \mjseqn{\mathrm{prec}} lead to a higher likelihood of selection).} \if{html}{\figure{selmodel-preston-prec.png}{options: width=600}} \if{latex}{\figure{selmodel-preston-prec.pdf}{options: width=4in}} One can also use the \code{steps} argument as described above in combination with these selection functions (studies with p-values below the chosen threshold then have \mjseqn{w(p_i) = 1} regardless of their exact p-value or precision). } \subsection{Negative Exponential Power Selection Model}{ As an extension of the half-normal and negative-exponential models, one can also choose \code{type="negexppow"} for a \sQuote{negative exponential power selection model}. The selection function for this model is given by \mjsdeqn{w(p_i) = \exp(-\delta_1 \times p_i^{1/\delta_2})} where \mjseqn{\delta_1 \ge 0} and \mjseqn{\delta_2 \ge 0} (see Begg & Mazumdar, 1994, although here a different parameterization is used, such that increasing \mjseqn{\delta_2} leads to more severe selection). \ifelse{text}{}{The figure below shows some examples of this selection function when holding \mjseqn{\delta_1} constant while increasing \mjseqn{\delta_2}.} \if{html}{\figure{selmodel-negexppow.png}{options: width=600}} \if{latex}{\figure{selmodel-negexppow.pdf}{options: width=4in}} This model affords greater flexibility in the shape of the selection function, but requires the estimation of the additional power parameter (the half-normal and negative-exponential models are therefore special cases when fixing \mjseqn{\delta_2} to 0.5 or 1, respectively). \mjeqn{\mbox{H}_0{:}\; \delta_1 = 0}{H_0: \delta_1 = 0} again implies no selection, but so does \mjeqn{\mbox{H}_0{:}\; \delta_2 = 0}{H_0: \delta_2 = 0}. One can again use the \code{steps} argument to specify a single significance threshold, \mjseqn{\alpha}, so that \mjseqn{w(p_i) = 1} for p-values below this threshold and otherwise \mjseqn{w(p_i)} follows the selection function as given above. One can also use the \code{prec} argument to specify a measure of precision in combination with this model, which leads to the selection function \mjsdeqn{w(p_i) = \exp(-\delta_1 \times \mathrm{prec}_i \times p_i^{1/\delta_2})} and hence is the logical extension of the negative exponential power selection model that also incorporates some measure of precision into the selection process. } \subsection{Step Function Selection Models}{ When \code{type="stepfun"}, the function can be used to fit \sQuote{step function models} as described by Iyengar and Greenhouse (1988), Hedges (1992), Vevea and Hedges (1995), and Vevea and Woods (2005). For these models, one must specify one or multiple values via the \code{steps} argument, which define intervals in which the relative likelihood of selection is constant. Let \mjsdeqn{\alpha_1 < \alpha_2 < \ldots < \alpha_c} denote these cutpoints sorted in increasing order, with the constraint that \mjseqn{\alpha_c = 1} (if the highest value specified via \code{steps} is not 1, the function will automatically add this cutpoint), and define \mjseqn{\alpha_0 = 0}. The selection function is then given by \mjseqn{w(p_i) = \delta_j} if \mjseqn{\alpha_{j-1} < p_i \le \alpha_j}. To make the model identifiable, we set \mjseqn{\delta_1 = 1}. The \mjseqn{\delta_j} values therefore denote the likelihood of selection in the various intervals relative to the interval for p-values between 0 and \mjseqn{\alpha_1}. Hence, the null hypothesis \mjeqn{\mbox{H}_0{:}\; \delta_j = 1}{H_0: \delta_j = 1} for \mjseqn{j = 1, \ldots, c} implies no selection. For example, if \code{steps=c(.05, .10, .50, 1)}, then \mjseqn{\delta_2} is the likelihood of selection for p-values between .05 and .10, \mjseqn{\delta_3} is the likelihood of selection for p-values between .10 and .50, and \mjseqn{\delta_4} is the likelihood of selection for p-values between .50 and 1 relative to the likelihood of selection for p-values between 0 and .05. \ifelse{text}{}{The figure below shows the corresponding selection function for some arbitrarily chosen \mjseqn{\delta_j} values.} \if{html}{\figure{selmodel-stepfun.png}{options: width=600}} \if{latex}{\figure{selmodel-stepfun.pdf}{options: width=4in}} There must be at least one observed p-value within each interval to fit this model. If this is not the case, an error will be issued (setting \code{verbose=TRUE} provides information about the number of p-values falling into each interval). When specifying a single cutpoint in the context of a random-effects model, this model is sometimes called the \sQuote{three-parameter selection model} (3PSM), corresponding to the parameters \mjseqn{\mu}, \mjseqn{\tau^2}, and \mjseqn{\delta_2} (e.g., Carter et al., 2019; McShane et al., 2016; Pustejovsky & Rodgers, 2019). The same idea but in the context of an equal-effects model was also described by Iyengar and Greenhouse (1988). Note that when \code{alternative="greater"} or \code{alternative="less"} (i.e., when we assume that the relative likelihood of selection is not only related to the p-values of the studies, but also the directionality of the outcomes), then it would usually make sense to divide conventional levels of significance (e.g., .05) by 2 before passing these values to the \code{steps} argument. For example, if we think that studies were selected for positive outcomes that are significant at two-tailed \mjseqn{\alpha = .05}, then we should use \code{alternative="greater"} in combination with \code{steps=c(.025, 1)}. One of the challenges when fitting this model with many cutpoints is the large number of parameters that need to be estimated (which is especially problematic when the number of studies is small). An alternative approach suggested by Vevea and Woods (2005) is to fix the \mjseqn{\delta_j} values to some a priori chosen values instead of estimating them. One can then conduct a sensitivity analysis by examining the results (e.g., the estimates of \mjseqn{\mu} and \mjseqn{\tau^2} in a random-effects model) for a variety of different sets of \mjseqn{\delta_j} values (reflecting more or less severe forms of selection). This can be done by specifying the \mjseqn{\delta_j} values via the \code{delta} argument. Table 1 in Vevea and Woods (2005) provides some illustrative examples of moderate and severe selection functions for one- and two-tailed selection. The code below creates a data frame that contains these functions. \preformatted{tab <- data.frame( steps = c(0.005, 0.01, 0.05, 0.10, 0.25, 0.35, 0.50, 0.65, 0.75, 0.90, 0.95, 0.99, 0.995, 1), delta.mod.1 = c(1, 0.99, 0.95, 0.80, 0.75, 0.65, 0.60, 0.55, 0.50, 0.50, 0.50, 0.50, 0.50, 0.50), delta.sev.1 = c(1, 0.99, 0.90, 0.75, 0.60, 0.50, 0.40, 0.35, 0.30, 0.25, 0.10, 0.10, 0.10, 0.10), delta.mod.2 = c(1, 0.99, 0.95, 0.90, 0.80, 0.75, 0.60, 0.60, 0.75, 0.80, 0.90, 0.95, 0.99, 1.00), delta.sev.2 = c(1, 0.99, 0.90, 0.75, 0.60, 0.50, 0.25, 0.25, 0.50, 0.60, 0.75, 0.90, 0.99, 1.00))} \ifelse{text}{}{The figure below shows the corresponding selection functions.} \if{html}{\figure{selmodel-stepfun-fixed.png}{options: width=600}} \if{latex}{\figure{selmodel-stepfun-fixed.pdf}{options: width=4in}} These four functions are \dQuote{merely examples and should not be regarded as canonical} (Vevea & Woods, 2005). } \subsection{Truncated Distribution Selection Model}{ When \code{type="trunc"}, the model assumes that the relative likelihood of selection depends not on the p-value but on the value of the observed effect size or outcome of a study. Let \mjseqn{y_c} denote a single cutpoint (which can be specified via argument \code{steps} and which is assumed to be 0 when unspecified). Let \mjtdeqn{w(y_i) = \left\\\{ \begin{array}{cc} 1 & \textrm{if} \; y_i > y_c \\\ \delta_1 & \textrm{if} \; y_i \le y_c \end{array} \right.}{w(y_i) = \left\\\\\\\{ \begin{matrix} \; 1 & \textrm{if} \; y_i > y_c \\\\\ \; \delta_1 & \textrm{if} \; y_i \le y_c \\\\\ \end{matrix} \right.}{w(y_i > y_c) = 1 and w(y_i \le y_c) = \delta_1} denote the selection function when \code{alternative="greater"} and \mjtdeqn{w(y_i) = \left\\\{ \begin{array}{cc} 1 & \textrm{if} \; y_i < y_c \\\ \delta_1 & \textrm{if} \; y_i \ge y_c \end{array} \right.}{w(y_i) = \left\\\\\\\{ \begin{matrix} \; 1 & \textrm{if} \; y_i < y_c \\\\\ \; \delta_1 & \textrm{if} \; y_i \ge y_c \\\\\ \end{matrix} \right.}{w(y_i < y_c) = 1 and w(y_i >= y_c) = \delta_1} when \code{alternative="less"} (note that \code{alternative="two.sided"} is not an option for this type of selection model). Therefore, when \code{alternative="greater"}, \mjseqn{\delta_1} denotes the likelihood of selection for observed effect sizes or outcomes that fall below the chosen cutpoint relative to those that fall above it (and vice-versa when \code{alternative="less"}). Hence, the null hypothesis \mjeqn{\mbox{H}_0{:}\; \delta_1 = 1}{H_0: \delta_1 = 1} implies no selection. In principle, it is also possible to obtain a maximum likelihood estimate of the cutpoint. For this, one can set \code{type="truncest"}, in which case the selection function is given by \mjtdeqn{w(y_i) = \left\\\{ \begin{array}{cc} 1 & \textrm{if} \; y_i > \delta_2 \\\ \delta_1 & \textrm{if} \; y_i \le \delta_2 \end{array} \right.}{w(y_i) = \left\\\\\\\{ \begin{matrix} \; 1 & \textrm{if} \; y_i > \delta_2 \\\\\ \; \delta_1 & \textrm{if} \; y_i \le \delta_2 \\\\\ \end{matrix} \right.}{w(y_i > \delta_2) = 1 and w(y_i \le \delta_2) = \delta_1} when \code{alternative="greater"} and analogously when \code{alternative="less"}. Therefore, instead of specifying the cutpoint via the \code{steps} argument, it is estimated via \mjseqn{\delta_2}. Note that estimating both \mjseqn{\delta_1} and \mjseqn{\delta_2} simultaneously is typically very difficult (the likelihood surface is often quite rugged with multiple local optima) and will require a large number of studies. The implementation of this selection function should be considered experimental. Models similar to those described above were proposed by Rust et al. (1990) and Formann (2008), but made various simplifying assumptions (e.g., Formann assumed \mjseqn{\delta_1 = 0}) and did not account for the heteroscedastic nature of the sampling variances of the observed effect sizes or outcomes, nor did they allow for heterogeneity in the true effects or the influence of moderators. } } \value{ An object of class \code{c("rma.uni","rma")}. The object is a list containing the same components as a regular \code{c("rma.uni","rma")} object, but the parameter estimates are based on the selection model. Most importantly, the following elements are modified based on the selection model: \item{beta}{estimated coefficients of the model.} \item{se}{standard errors of the coefficients.} \item{zval}{test statistics of the coefficients.} \item{pval}{corresponding p-values.} \item{ci.lb}{lower bound of the confidence intervals for the coefficients.} \item{ci.ub}{upper bound of the confidence intervals for the coefficients.} \item{vb}{variance-covariance matrix of the estimated coefficients.} \item{tau2}{estimated amount of (residual) heterogeneity. Always \code{0} when \code{method="EE"}.} \item{se.tau2}{standard error of the estimated amount of (residual) heterogeneity.} In addition, the object contains the following additional elements: \item{delta}{estimated selection model parameter(s).} \item{se.delta}{corresponding standard error(s).} \item{zval.delta}{corresponding test statistic(s).} \item{pval.delta}{corresponding p-value(s).} \item{ci.lb.delta}{lower bound of the confidence intervals for the parameter(s).} \item{ci.ub.delta}{upper bound of the confidence intervals for the parameter(s).} \item{LRT}{test statistic of the likelihood ratio test for the selection model parameter(s).} \item{LRTdf}{degrees of freedom for the likelihood ratio test.} \item{LRTp}{p-value for the likelihood ratio test.} \item{LRT.tau2}{test statistic of the likelihood ratio test for testing \mjeqn{\mbox{H}_0{:}\; \tau^2 = 0}{H_0: \tau^2 = 0} (\code{NA} when fitting an equal-effects model).} \item{LRTp.tau2}{p-value for the likelihood ratio test.} \item{\dots}{some additional elements/values.} } \section{Methods}{ The results of the fitted model are formatted and printed with the \code{\link[=print.rma.uni]{print}} function. The estimated selection function can be drawn with \code{\link[=plot.rma.uni.selmodel]{plot}}. The \code{\link[=profile.rma.uni.selmodel]{profile}} function can be used to obtain a plot of the log-likelihood as a function of \mjseqn{\tau^2} and/or the selection model parameter(s) of the model. Corresponding confidence intervals can be obtained with the \code{\link[=confint.rma.uni.selmodel]{confint}} function. } \note{ Model fitting is done via numerical optimization over the model parameters. By default, \code{\link{optim}} with method \code{"BFGS"} is used for the optimization. One can also chose a different optimizer from \code{\link{optim}} via the \code{control} argument (e.g., \code{control=list(optimizer="Nelder-Mead")}). Besides one of the methods from \code{\link{optim}}, one can also choose the quasi-Newton algorithm in \code{\link{nlminb}}, one of the optimizers from the \code{minqa} package (i.e., \code{\link[minqa]{uobyqa}}, \code{\link[minqa]{newuoa}}, or \code{\link[minqa]{bobyqa}}), one of the (derivative-free) algorithms from the \code{\link[nloptr]{nloptr}} package, the Newton-type algorithm implemented in \code{\link{nlm}}, the various algorithms implemented in the \code{dfoptim} package (\code{\link[dfoptim]{hjk}} for the Hooke-Jeeves, \code{\link[dfoptim]{nmk}} for the Nelder-Mead, and \code{\link[dfoptim]{mads}} for the Mesh Adaptive Direct Searches algorithm), the quasi-Newton type optimizers \code{\link[ucminf]{ucminf}} and \code{\link[lbfgsb3c]{lbfgsb3c}} and the subspace-searching simplex algorithm \code{\link[subplex]{subplex}} from the packages of the same name, the Barzilai-Borwein gradient decent method implemented in \code{\link[BB]{BBoptim}}, the \code{\link[Rcgmin]{Rcgmin}} and \code{\link[Rvmmin]{Rvmmin}} optimizers, or the parallelized version of the L-BFGS-B algorithm implemented in \code{\link[optimParallel]{optimParallel}} from the package of the same name. The optimizer name must be given as a character string (i.e., in quotes). Additional control parameters can be specified via the \code{control} argument (e.g., \code{control=list(maxit=1000, reltol=1e-8)}). For \code{\link[nloptr]{nloptr}}, the default is to use the BOBYQA implementation from that package with a relative convergence criterion of \code{1e-8} on the function value (i.e., log-likelihood), but this can be changed via the \code{algorithm} and \code{ftop_rel} arguments (e.g., \code{control=list(optimizer="nloptr", algorithm="NLOPT_LN_SBPLX", ftol_rel=1e-6)}). For \code{\link[optimParallel]{optimParallel}}, the control argument \code{ncpus} can be used to specify the number of cores to use for the parallelization (e.g., \code{control=list(optimizer="optimParallel", ncpus=2)}). With \code{parallel::detectCores()}, one can check on the number of available cores on the local machine. All selection models (except for \code{type="stepfun"}, \code{type="trunc"}, and \code{type="truncest"}) require repeated evaluations of an integral, which is done via adaptive quadrature as implemented in the \code{\link{integrate}} function. One can adjust the arguments of the \code{integrate} function via control element \code{intCtrl}, which is a list of named arguments (e.g., \code{control = list(intCtrl = list(rel.tol=1e-4, subdivisions=100))}). The starting values for the fixed effects, the \mjseqn{\tau^2} value (only relevant in random/mixed-effects selection models), and the \mjseqn{\delta} parameter(s) are chosen automatically by the function, but one can also set the starting values manually via the \code{control} argument by specifying a vector of the appropriate length for \code{beta.init}, a single value for \code{tau2.init}, and a vector of the appropriate length for \code{delta.init}. By default, the \mjseqn{\delta} parameter(s) are constrained to a certain range, which improves the stability of the optimization algorithm. For all models, the maximum is set to \code{100} and the minimum to \code{0} (except for \code{type="beta"}, where the minimum for both parameters is \code{1e-5}). These defaults can be changed via the \code{control} argument by specifying a vector of the appropriate length for \code{delta.min} and/or \code{delta.max}. A difficulty with fitting the beta selection model (i.e., \code{type="beta"}) is the behavior of \mjseqn{w(p_i)} when \mjseqn{p_i = 0} or \mjseqn{p_i = 1}. When \mjseqn{\delta_1 < 1} or \mjseqn{\delta_2 < 1}, then this leads to selection weights equal to infinity, which causes problems when computing the likelihood function. Following Citkowicz and Vevea (2017), this problem can be avoided by censoring p-values too close to 0 or 1. The specific censoring point can be set via the \code{pval.min} element of the \code{control} argument. The default for this selection model is \code{control=list(pval.min=1e-5)}. A similar issue arises for the power selection model (i.e., \code{type="power"}) when \mjseqn{p_i = 1}. Again, \code{pval.min=1e-5} is used to circumvent this issue. For all other selection models, the default is \code{pval.min=0}. The variance-covariance matrix corresponding to the estimates of the fixed effects, the \mjseqn{\tau^2} value (only relevant in random/mixed-effects selection models), and the \mjseqn{\delta} parameter(s) is obtained by inverting the Hessian, which is numerically approximated using the \code{\link[numDeriv]{hessian}} function from the \code{numDeriv} package. This may fail, leading to \code{NA} values for the standard errors and hence test statistics, p-values, and confidence interval bounds. One can set control argument \code{hessianCtrl} to a list of named arguments to be passed on to the \code{method.args} argument of the \code{\link[numDeriv]{hessian}} function (the default is \code{control=list(hessianCtrl=list(r=6))}). One can also set \code{control=list(hesspack="pracma")} in which case the \code{\link[pracma]{hessian}} function from the \code{pracma} package is used instead for approximating the Hessian. When \mjseqn{\tau^2} is estimated to be smaller than either \mjeqn{10^{-4}}{10^(-4)} or \mjseqn{\min(v_1, \ldots, v_k)/10} (where \mjseqn{v_i} denotes the sampling variances of the \mjeqn{i\textrm{th}}{ith} study), then \mjseqn{\tau^2} is effectively treated as zero for computing the standard errors (which helps to avoid numerical problems in approximating the Hessian). This cutoff can be adjusted via the \code{tau2tol} control argument (e.g., \code{control=list(tau2tol=0)} to switch off this behavior). Information on the progress of the optimization algorithm can be obtained by setting \code{verbose=TRUE} (this won't work when using parallelization). One can also set \code{verbose} to an integer (\code{verbose=2} yields even more information and \code{verbose=3} also show the progress visually by drawing the selection function as the optimization proceeds). For selection functions where the \code{prec} argument is relevant, using a function of the sample sizes as the measure of precision (i.e., \code{prec="ninv"} or \code{prec="sqrtninv"}) is only possible when information about the sample sizes is actually stored within the object passed to the \code{selmodel} function. That should automatically be the case when the observed effect sizes or outcomes were computed with the \code{\link{escalc}} function or when the observed effect sizes or outcomes were computed within the model fitting function. On the other hand, this will not be the case when \code{\link{rma.uni}} was used together with the \code{yi} and \code{vi} arguments and the \code{yi} and \code{vi} values were \emph{not} computed with \code{\link{escalc}}. In that case, it is still possible to pass information about the sample sizes to the \code{\link{rma.uni}} function (e.g., use \code{rma.uni(yi, vi, ni=ni, data=dat)}, where data frame \code{dat} includes a variable called \code{ni} with the sample sizes). Finally, the automatic rescaling of the chosen precision measure can be switched off by setting \code{scaleprec=FALSE}. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Begg, C. B., & Mazumdar, M. (1994). Operating characteristics of a rank correlation test for publication bias. \emph{Biometrics}, \bold{50}(4), 1088--1101. \verb{https://doi.org/10.2307/2533446} Carter, E. C., \enc{Schönbrodt}{Schoenbrodt}, F. D., Gervais, W. M., & Hilgard, J. (2019). Correcting for bias in psychology: A comparison of meta-analytic methods. \emph{Advances in Methods and Practices in Psychological Science}, \bold{2}(2), 115--144. \verb{https://doi.org/10.1177/2515245919847196} Citkowicz, M., & Vevea, J. L. (2017). A parsimonious weight function for modeling publication bias. \emph{Psychological Methods}, \bold{22}(1), 28--41. \verb{https://doi.org/10.1037/met0000119} Formann, A. K. (2008). Estimating the proportion of studies missing for meta-analysis due to publication bias. \emph{Contemporary Clinical Trials}, \bold{29}(5), 732--739. \verb{https://doi.org/10.1016/j.cct.2008.05.004} Hedges, L. V. (1992). Modeling publication selection effects in meta-analysis. \emph{Statistical Science}, \bold{7}(2), 246--255. \verb{https://doi.org/10.1214/ss/1177011364} Iyengar, S., & Greenhouse, J. B. (1988). Selection models and the file drawer problem. \emph{Statistical Science}, \bold{3}(1), 109--117. \verb{https://doi.org/10.1214/ss/1177013012} McShane, B. B., Bockenholt, U., & Hansen, K. T. (2016). Adjusting for publication bias in meta-analysis: An evaluation of selection methods and some cautionary notes. \emph{Perspectives on Psychological Science}, \bold{11}(5), 730--749. \verb{https://doi.org/10.1177/1745691616662243} Preston, C., Ashby, D., & Smyth, R. (2004). Adjusting for publication bias: Modelling the selection process. \emph{Journal of Evaluation in Clinical Practice}, \bold{10}(2), 313--322. \verb{https://doi.org/10.1111/j.1365-2753.2003.00457.x} Pustejovsky, J. E., & Rodgers, M. A. (2019). Testing for funnel plot asymmetry of standardized mean differences. \emph{Research Synthesis Methods}, \bold{10}(1), 57--71. \verb{https://doi.org/10.1002/jrsm.1332} Rust, R. T., Lehmann, D. R. & Farley, J. U. (1990). Estimating publication bias in meta-analysis. \emph{Journal of Marketing Research}, \bold{27}(2), 220--226. \verb{https://doi.org/10.1177/002224379002700209} Vevea, J. L., & Hedges, L. V. (1995). A general linear model for estimating effect size in the presence of publication bias. \emph{Psychometrika}, \bold{60}(3), 419--435. \verb{https://doi.org/10.1007/BF02294384} Vevea, J. L., & Woods, C. M. (2005). Publication bias in research synthesis: Sensitivity analysis using a priori weight functions. \emph{Psychological Methods}, \bold{10}(4), 428--443. \verb{https://doi.org/10.1037/1082-989X.10.4.428} } \seealso{ \code{\link{rma.uni}} for the function to fit models which can be extended with selection models. } \examples{ ############################################################################ ### example from Citkowicz and Vevea (2017) for beta selection model # copy data into 'dat' and examine data dat <- dat.baskerville2012 dat # fit random-effects model res <- rma(smd, se^2, data=dat, method="ML", digits=3) res # funnel plot funnel(res, ylim=c(0,0.6), xlab="Standardized Mean Difference") # fit beta selection model \dontrun{ sel <- selmodel(res, type="beta") sel # plot the selection function plot(sel, ylim=c(0,40)) } # fit mixed-effects meta-regression model with 'blind' dummy variable as moderator res <- rma(smd, se^2, data=dat, mods = ~ blind, method="ML", digits=3) res # predicted average effect for studies that do not and that do use blinding predict(res, newmods=c(0,1)) # fit beta selection model \dontrun{ sel <- selmodel(res, type="beta") sel predict(sel, newmods=c(0,1)) } ############################################################################ ### example from Preston et al. (2004) # copy data into 'dat' and examine data dat <- dat.hahn2001 dat ### meta-analysis of (log) odds rations using the Mantel-Haenszel method res <- rma.mh(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, digits=2, slab=study) res # calculate log odds ratios and corresponding sampling variances dat <- escalc(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, drop00=TRUE) dat # fit equal-effects model res <- rma(yi, vi, data=dat, method="EE") # predicted odds ratio (with 95\% CI) predict(res, transf=exp, digits=2) # funnel plot funnel(res, atransf=exp, at=log(c(0.01,0.1,1,10,100)), ylim=c(0,2)) # fit half-normal, negative-exponential, logistic, and power selection models \dontrun{ sel1 <- selmodel(res, type="halfnorm", alternative="less") sel2 <- selmodel(res, type="negexp", alternative="less") sel3 <- selmodel(res, type="logistic", alternative="less") sel4 <- selmodel(res, type="power", alternative="less") # plot the selection functions plot(sel1) plot(sel2, add=TRUE, col="blue") plot(sel3, add=TRUE, col="red") plot(sel4, add=TRUE, col="green") # add legend legend("topright", inset=0.02, lty="solid", lwd=2, col=c("black","blue","red","green"), legend=c("Half-normal", "Negative-exponential", "Logistic", "Power")) # show estimates of delta (and corresponding SEs) tab <- data.frame(delta = c(sel1$delta, sel2$delta, sel3$delta, sel4$delta), se = c(sel1$se.delta, sel2$se.delta, sel3$se.delta, sel4$se.delta)) rownames(tab) <- c("Half-normal", "Negative-exponential", "Logistic", "Power") round(tab, 2) # predicted odds ratios (with 95\% CI) predict(res, transf=exp, digits=2) predict(sel1, transf=exp, digits=2) predict(sel2, transf=exp, digits=2) predict(sel3, transf=exp, digits=2) predict(sel4, transf=exp, digits=2) } # fit selection models including standard error as precision measure (note: using # scaleprec=FALSE here since Preston et al. (2004) did not use the rescaling) \dontrun{ sel1 <- selmodel(res, type="halfnorm", prec="sei", alternative="less", scaleprec=FALSE) sel2 <- selmodel(res, type="negexp", prec="sei", alternative="less", scaleprec=FALSE) sel3 <- selmodel(res, type="logistic", prec="sei", alternative="less", scaleprec=FALSE) sel4 <- selmodel(res, type="power", prec="sei", alternative="less", scaleprec=FALSE) # show estimates of delta (and corresponding SEs) tab <- data.frame(delta = c(sel1$delta, sel2$delta, sel3$delta, sel4$delta), se = c(sel1$se.delta, sel2$se.delta, sel3$se.delta, sel4$se.delta)) rownames(tab) <- c("Half-normal", "Negative-exponential", "Logistic", "Power") round(tab, 2) # predicted odds ratio (with 95\% CI) predict(res, transf=exp, digits=2) predict(sel1, transf=exp, digits=2) predict(sel2, transf=exp, digits=2) predict(sel3, transf=exp, digits=2) predict(sel4, transf=exp, digits=2) } ############################################################################ ### meta-analysis on the effect of environmental tobacco smoke on lung cancer risk # copy data into 'dat' and examine data dat <- dat.hackshaw1998 dat # fit random-effects model res <- rma(yi, vi, data=dat, method="ML") res # funnel plot funnel(res, atransf=exp, at=log(c(0.25,0.5,1,2,4,8)), ylim=c(0,0.8)) # step function selection model \dontrun{ sel <- selmodel(res, type="stepfun", alternative="greater", steps=c(.025,.10,.50,1)) sel # plot the selection function plot(sel) # truncated distribution selection model (with steps=0 by default) sel <- selmodel(res, type="trunc") sel } ############################################################################ ### validity of student ratings example from Vevea & Woods (2005) # copy data into 'dat' and examine data dat <- dat.cohen1981 dat[c(1,4,5)] # calculate r-to-z transformed correlations and corresponding sampling variances dat <- escalc(measure="ZCOR", ri=ri, ni=ni, data=dat[c(1,4,5)]) dat # fit random-effects model res <- rma(yi, vi, data=dat, method="ML", digits=3) res # predicted average correlation (with 95\% CI) predict(res, transf=transf.ztor) # funnel plot funnel(res, ylim=c(0,0.4)) # selection functions from Vevea & Woods (2005) tab <- data.frame( steps = c(0.005, 0.01, 0.05, 0.10, 0.25, 0.35, 0.50, 0.65, 0.75, 0.90, 0.95, 0.99, 0.995, 1), delta.mod.1 = c(1, 0.99, 0.95, 0.80, 0.75, 0.65, 0.60, 0.55, 0.50, 0.50, 0.50, 0.50, 0.50, 0.50), delta.sev.1 = c(1, 0.99, 0.90, 0.75, 0.60, 0.50, 0.40, 0.35, 0.30, 0.25, 0.10, 0.10, 0.10, 0.10), delta.mod.2 = c(1, 0.99, 0.95, 0.90, 0.80, 0.75, 0.60, 0.60, 0.75, 0.80, 0.90, 0.95, 0.99, 1.00), delta.sev.2 = c(1, 0.99, 0.90, 0.75, 0.60, 0.50, 0.25, 0.25, 0.50, 0.60, 0.75, 0.90, 0.99, 1.00)) # apply step function model with a priori chosen selection weights \dontrun{ sel <- lapply(tab[-1], function(delta) selmodel(res, type="stepfun", steps=tab$steps, delta=delta)) # estimates (transformed correlation) and tau^2 values sav <- data.frame(estimate = round(c(res$beta, sapply(sel, function(x) x$beta)), 2), varcomp = round(c(res$tau2, sapply(sel, function(x) x$tau2)), 3)) sav } ############################################################################ } \keyword{models} metafor/man/tes.Rd0000644000176200001440000002465314505063152013557 0ustar liggesusers\name{tes} \alias{tes} \alias{print.tes} \title{Test of Excess Significance} \description{ Function to conduct the test of excess significance. \loadmathjax } \usage{ tes(x, vi, sei, subset, data, H0=0, alternative="two.sided", alpha=.05, theta, tau2, test, tes.alternative="greater", progbar=TRUE, tes.alpha=.10, digits, \dots) \method{print}{tes}(x, digits=x$digits, \dots) } \arguments{ \emph{These arguments pertain to data input:} \item{x}{a vector with the observed effect sizes or outcomes or an object of class \code{"rma"}.} \item{vi}{vector with the corresponding sampling variances (ignored if \code{x} is an object of class \code{"rma"}).} \item{sei}{vector with the corresponding standard errors (note: only one of the two, \code{vi} or \code{sei}, needs to be specified).} \item{subset}{optional (logical or numeric) vector to specify the subset of studies that should be included (ignored if \code{x} is an object of class \code{"rma"}).} \item{data}{optional data frame containing the variables given to the arguments above.} \emph{These arguments pertain to the tests of the observed effect sizes or outcomes:} \item{H0}{numeric value to specify the value of the effect size or outcome under the null hypothesis (the default is 0).} \item{alternative}{character string to specify the sidedness of the hypothesis when testing the observed effect sizes or outcomes. Possible options are \code{"two.sided"} (the default), \code{"greater"}, or \code{"less"}. Can be abbreviated.} \item{alpha}{alpha level for testing the observed effect sizes or outcomes (the default is .05).} \emph{These arguments pertain to the power of the tests:} \item{theta}{optional numeric value to specify the value of the true effect size or outcome under the alternative hypothesis. If unspecified, it will be estimated based on the data or the value is taken from the \code{"rma"} object.} \item{tau2}{optional numeric value to specify the amount of heterogeneity in the true effect sizes or outcomes. If unspecified, the true effect sizes or outcomes are assumed to be homogeneous or the value is taken from the \code{"rma"} object.} \emph{These arguments pertain to the test of excess significance:} \item{test}{optional character string to specify the type of test to use for conducting the test of excess significance. Possible options are \code{"chi2"}, \code{"binom"}, or \code{"exact"}. Can be abbreviated. If unspecified, the function chooses the type of test based on the data.} \item{tes.alternative}{character string to specify the sidedness of the hypothesis for the test of excess significance. Possible options are \code{"greater"} (the default), \code{"two.sided"}, or \code{"less"}. Can be abbreviated.} \item{progbar}{logical to specify whether a progress bar should be shown (the default is \code{TRUE}). Only relevant when conducting an exact test.} \item{tes.alpha}{alpha level for the test of excess significance (the default is .10). Only relevant for finding the \sQuote{limit estimate}.} \emph{Miscellaneous arguments:} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded.} \item{\dots}{other arguments.} } \details{ The function carries out the test of excess significance described by Ioannidis and Trikalinos (2007). The test can be used to examine whether the observed number of significant findings is greater than the number of significant findings expected given the power of the tests. An overabundance of significant tests may suggest that the collection of studies is not representative of all studies conducted on a particular topic. One can either pass a vector with the observed effect sizes or outcomes (via \code{x}) and the corresponding sampling variances via \code{vi} (or the standard errors via \code{sei}) to the function or an object of class \code{"rma"}. The observed effect sizes or outcomes are tested for significance based on a standard Wald-type test, that is, by comparing \mjdeqn{z_i = \frac{y_i - \mbox{H}_0}{\sqrt{v_i}}}{z_i = (y_i - H_0) / sqrt(v_i)} against the appropriate critical value(s) of a standard normal distribution (e.g., \mjseqn{\pm 1.96} for \code{alternative="two.sided"} and \code{alpha=.05}, which are the defaults). Let \mjseqn{O} denote the observed number of significant tests. Given a particular value for the true effect or outcome denoted by \mjseqn{\theta} (which, if it is unspecified, is determined by computing the inverse-variance weighted average of the observed effect sizes or outcomes or the value is taken from the model object), let \mjseqn{1-\beta_i} denote the power of the \mjeqn{i\textrm{th}}{ith} test (where \mjseqn{\beta_i} denotes the Type II error probability). If \mjseqn{\tau^2 > 0}, let \mjseqn{1-\beta_i} denote the expected power (computed based on integrating the power over a normal distribution with mean \mjseqn{\theta} and variance \mjseqn{\tau^2}). Let \mjseqn{E = \sum_{i=1}^k (1-\beta_i)} denote the expected number of significant tests. The test of excess significance then tests if \mjseqn{O} is significantly greater (if \code{tes.alternative="greater"}) than \mjseqn{E}. This can be done using Pearson's chi-square test (if \code{test="chi2"}), a binomial test (if \code{test="binomial"}), or an exact test (if \code{test="exact"}). The latter is described in Francis (2013). If argument \code{test} is unspecified, the default is to do an exact test if the number of elements in the sum that needs to be computed is less than or equal to \code{10^6} and to do a chi-square test otherwise. One can also iteratively find the value of \mjseqn{\theta} such that the p-value of the test of excess significance is equal to \code{tes.alpha} (which is \code{.10} by default). The resulting value is called the \sQuote{limit estimate} and is denoted \mjeqn{\theta_{lim}}{\theta_lim} by Ioannidis and Trikalinos (2007). Note that the limit estimate is not computable if the p-value is larger than \code{tes.alpha} even if \mjeqn{\theta = \mbox{H}_0}{\theta = H_0}. } \value{ An object of class \code{"tes"}. The object is a list containing the following components: \item{k}{the number of studies included in the analysis.} \item{O}{the observed number of significant tests.} \item{E}{the expected number of significant tests.} \item{OEratio}{the ratio of O over E.} \item{test}{the type of test conducted.} \item{pval}{the p-value of the test of excess significance.} \item{power}{the (estimated) power of the tests.} \item{sig}{logical vector indicating which tests were significant.} \item{theta}{the value of \mjseqn{\theta} used for computing the power of the tests.} \item{theta.lim}{the \sQuote{limit estimate} (i.e., \mjeqn{\theta_{lim}}{\theta_lim}).} \item{\dots}{some additional elements/values.} The results are formatted and printed with the \code{print} function. } \note{ When \code{tes.alternative="greater"} (the default), then the function tests if \mjseqn{O} is significantly greater than \mjseqn{E} and hence this is indeed a test of excess significance. When \code{tes.alternative="two.sided"}, then the function tests if \mjseqn{O} differs significantly from \mjseqn{E} in either direction and hence it would be more apt to describe this as a test of (in)consistency (between \mjseqn{O} and \mjseqn{E}). Finally, one can also set \code{tes.alternative="less"}, in which case the function tests if \mjseqn{O} is significantly lower than \mjseqn{E}, which could be considered a test of excess non-significance. When \code{tes.alternative="two.sided"}, one can actually compute two limit estimates. The function attempts to compute both. The function computes the significance and power of the studies based on Wald-type tests regardless of the effect size or outcome measure used as input. This works as an adequate approximation as long as the within-study sample sizes are not too small. Note that the test is not a test for publication bias but a test whether the set of studies includes an unusual number of significant findings given the power of the studies. The general usefulness of the test and its usefulness under particular circumstances (e.g., when there is substantial heterogeneity in the true effect sizes or outcomes) has been the subject of considerable debate. See Francis (2013) and the commentaries on this article in the same issue of the journal. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Francis, G. (2013). Replication, statistical consistency, and publication bias. \emph{Journal of Mathematical Psychology}, \bold{57}(5), 153--169. \verb{https://doi.org/10.1016/j.jmp.2013.02.003} Ioannidis, J. P. A., & Trikalinos, T. A. (2007). An exploratory test for an excess of significant findings. \emph{Clinical Trials}, \bold{4}(3), 245--253. \verb{https://doi.org/10.1177/1740774507079441} Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{regtest}} for the regression test, \code{\link{ranktest}} for the rank correlation test, \code{\link{trimfill}} for the trim and fill method, \code{\link{fsn}} to compute the fail-safe N (file drawer analysis), and \code{\link{selmodel}} for selection models. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=x.a, n1i=n.a, ci=x.p, n2i=n.p, data=dat.dorn2007) ### conduct test of excess significance (using test="chi2" to speed things up) tes(yi, vi, data=dat, test="chi2") ### same as fitting an EE model and then passing the object to the function res <- rma(yi, vi, data=dat, method="EE") tes(res, test="chi2") ### illustrate limit estimate (value of theta where p-value of test is equal to tes.alpha) thetas <- seq(0,1,length=101) pvals <- sapply(thetas, function(theta) tes(yi, vi, data=dat, test="chi2", theta=theta)$pval) plot(thetas, pvals, type="o", pch=19, ylim=c(0,1)) sav <- tes(yi, vi, data=dat, test="chi2") abline(h=sav$tes.alpha, lty="dotted") abline(v=sav$theta.lim, lty="dotted") ### examine significance of test as a function of alpha (to examine 'significance chasing') alphas <- seq(.01,.99,length=101) pvals <- sapply(alphas, function(alpha) tes(yi, vi, data=dat, test="chi2", alpha=alpha)$pval) plot(alphas, pvals, type="o", pch=19, ylim=c(0,1)) abline(v=.05, lty="dotted") abline(h=.10, lty="dotted") } \keyword{htest} metafor/man/plot.rma.Rd0000644000176200001440000000473514505063152014517 0ustar liggesusers\name{plot.rma} \alias{plot.rma} \alias{plot.rma.uni} \alias{plot.rma.mh} \alias{plot.rma.peto} \alias{plot.rma.glmm} \title{Plot Method for 'rma' Objects} \description{ Functions to plot objects of class \code{"rma.uni"}, \code{"rma.mh"}, \code{"rma.peto"}, and \code{"rma.glmm"}. } \usage{ \method{plot}{rma.uni}(x, qqplot=FALSE, \dots) \method{plot}{rma.mh}(x, qqplot=FALSE, \dots) \method{plot}{rma.peto}(x, qqplot=FALSE, \dots) \method{plot}{rma.glmm}(x, qqplot=FALSE, \dots) } \arguments{ \item{x}{an object of class \code{"rma.uni"}, \code{"rma.mh"}, or \code{"rma.peto"}. The method is not yet implemented for objects of class \code{"rma.glmm"}.} \item{qqplot}{logical to specify whether a normal QQ plot should be drawn (the default is \code{FALSE}).} \item{\dots}{other arguments.} } \details{ Four plots are produced. If the model does not contain any moderators, then a forest plot, funnel plot, radial plot, and a plot of the standardized residuals is provided. If \code{qqplot=TRUE}, the last plot is replaced by a normal QQ plot of the standardized residuals. If the model contains moderators, then a forest plot, funnel plot, plot of the standardized residuals against the fitted values, and a plot of the standardized residuals is provided. If \code{qqplot=TRUE}, the last plot is replaced by a normal QQ plot of the standardized residuals. } \note{ If the number of studies is large, the forest plot may become difficult to read due to the small font size. Stretching the plotting device vertically should provide more space. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{forest}} for forest plots, \code{\link{funnel}} for funnel plots, \code{\link{radial}} for radial plots, and \code{\link[=qqnorm.rma]{qqnorm}} for normal QQ plots. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit random-effects model res <- rma(yi, vi, data=dat) ### plot results plot(res, qqplot=TRUE) ### fit mixed-effects model with absolute latitude and publication year as moderators res <- rma(yi, vi, mods = ~ ablat + year, data=dat) ### plot results plot(res, qqplot=TRUE) } \keyword{hplot} metafor/man/leave1out.Rd0000644000176200001440000001046314505063152014663 0ustar liggesusers\name{leave1out} \alias{leave1out} \alias{leave1out.rma.uni} \alias{leave1out.rma.mh} \alias{leave1out.rma.peto} \title{Leave-One-Out Diagnostics for 'rma' Objects} \description{ Functions to carry out a \sQuote{leave-one-out analysis}, by repeatedly fitting the specified model leaving out one study at a time. \loadmathjax } \usage{ leave1out(x, \dots) \method{leave1out}{rma.uni}(x, digits, transf, targs, progbar=FALSE, \dots) \method{leave1out}{rma.mh}(x, digits, transf, targs, progbar=FALSE, \dots) \method{leave1out}{rma.peto}(x, digits, transf, targs, progbar=FALSE, \dots) } \arguments{ \item{x}{an object of class \code{"rma.uni"}, \code{"rma.mh"}, or \code{"rma.peto"}.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} \item{transf}{optional argument to specify a function to transform the model coefficients and interval bounds (e.g., \code{transf=exp}; see also \link{transf}). If unspecified, no transformation is used.} \item{targs}{optional arguments needed by the function specified under \code{transf}.} \item{progbar}{logical to specify whether a progress bar should be shown (the default is \code{FALSE}).} \item{\dots}{other arguments.} } \details{ For \code{"rma.uni"} objects, the model specified via \code{x} must be a model without moderators (i.e., either an equal- or a random-effects model). } \value{ An object of class \code{"list.rma"}. The object is a list containing the following components: \item{estimate}{estimated (average) outcomes.} \item{se}{corresponding standard errors.} \item{zval}{corresponding test statistics.} \item{pval}{corresponding p-values.} \item{ci.lb}{lower bounds of the confidence intervals.} \item{ci.ub}{upper bounds of the confidence intervals.} \item{Q}{test statistics for the test of heterogeneity.} \item{Qp}{corresponding p-values.} \item{tau2}{estimated amount of heterogeneity (only for random-effects models).} \item{I2}{values of \mjseqn{I^2}.} \item{H2}{values of \mjseqn{H^2}.} When the model was fitted with \code{test="t"} or \code{test="knha"}, then \code{zval} is called \code{tval} in the object that is returned by the function. The object is formatted and printed with the \code{\link[=print.list.rma]{print}} function. To format the results as a data frame, one can use the \code{\link[=as.data.frame.list.rma]{as.data.frame}} function. } \note{ When using the \code{transf} option, the transformation is applied to the estimated coefficients and the corresponding interval bounds. The standard errors are then set equal to \code{NA} and are omitted from the printed output. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W. (2021). Model checking in meta-analysis. In C. H. Schmid, T. Stijnen, & I. R. White (Eds.), \emph{Handbook of meta-analysis} (pp. 219--254). Boca Raton, FL: CRC Press. \verb{https://doi.org/10.1201/9781315119403} Viechtbauer, W., & Cheung, M. W.-L. (2010). Outlier and influence diagnostics for meta-analysis. \emph{Research Synthesis Methods}, \bold{1}(2), 112--125. \verb{https://doi.org/10.1002/jrsm.11} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, and \code{\link{rma.peto}} for functions to fit models for which leave-one-out diagnostics can be computed. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### random-effects model res <- rma(yi, vi, data=dat) ### leave-one-out analysis leave1out(res) leave1out(res, transf=exp) ### meta-analysis of the (log) risk ratios using the Mantel-Haenszel method res <- rma.mh(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### leave-one-out analysis leave1out(res) leave1out(res, transf=exp) ### meta-analysis of the (log) odds ratios using Peto's method res <- rma.peto(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### leave-one-out analysis leave1out(res) leave1out(res, transf=exp) } \keyword{methods} metafor/man/dfround.Rd0000644000176200001440000000311514505063152014413 0ustar liggesusers\name{dfround} \alias{dfround} \title{Round Variables in a Data Frame} \description{ Function to round the numeric variables in a data frame. } \usage{ dfround(x, digits, drop0=TRUE) } \arguments{ \item{x}{a data frame.} \item{digits}{either a single integer or a numeric vector of the same length as there are columns in \code{x}.} \item{drop0}{logical (or a vector thereof) indicating if trailing zeros after the decimal mark should be removed (the default is \code{TRUE}).} } \details{ A simple convenience function to round the numeric variables in a data frame, possibly to different numbers of digits. Hence, \code{digits} can either be a single integer (which will then be used to round all numeric variables to the specified number of digits) or a numeric vector (of the same length as there are columns in \code{x}) to specify the number of digits to which each variable should be rounded. Non-numeric variables are skipped. If \code{digits} is a vector, some arbitrary value (or \code{NA}) can be specified for those variables. Note: When \code{drop0=FALSE}, then \code{\link{formatC}} is used to format the numbers, which turns them into character variables. } \value{ Returns the data frame with variables rounded as specified. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \examples{ dat <- dat.bcg dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) res <- rma(yi, vi, mods = ~ ablat + year, data=dat) coef(summary(res)) dfround(coef(summary(res)), digits=c(2,3,2,3,2,2)) } \keyword{manip} metafor/man/conv.wald.Rd0000644000176200001440000003760514505063152014660 0ustar liggesusers\name{conv.wald} \alias{conv.wald} \title{Convert Wald-Type Confidence Intervals and Tests to Sampling Variances} \description{ Function to convert Wald-type confidence intervals (CIs) and test statistics (or the corresponding p-values) to sampling variances. \loadmathjax } \usage{ conv.wald(out, ci.lb, ci.ub, zval, pval, n, data, include, level=95, transf, check=TRUE, var.names, append=TRUE, replace="ifna", \dots) } \arguments{ \item{out}{vector with the observed effect sizes or outcomes.} \item{ci.lb}{vector with the lower bounds of the corresponding Wald-type CIs.} \item{ci.ub}{vector with the upper bounds of the corresponding Wald-type CIs.} \item{zval}{vector with the Wald-type test statistics.} \item{pval}{vector with the p-values of the Wald-type tests.} \item{n}{vector with the total sample sizes of the studies.} \item{data}{optional data frame containing the variables given to the arguments above.} \item{include}{optional (logical or numeric) vector to specify the subset of studies for which the conversion should be carried out.} \item{level}{numeric value (or vector) to specify the confidence interval level(s) (the default is 95; see \link[=misc-options]{here} for details).} \item{transf}{optional argument to specify a function to transform \code{out}, \code{ci.lb}, and \code{ci.ub} (e.g., \code{transf=log}). If unspecified, no transformation is used.} \item{check}{logical to specify whether the function should carry out a check to examine if the point estimates fall (approximately) halfway between the CI bounds (the default is \code{TRUE}).} \item{var.names}{character vector with two elements to specify the name of the variable for the observed effect sizes or outcomes and the name of the variable for the corresponding sampling variances (if \code{data} is an object of class \code{"escalc"}, the \code{var.names} are taken from the object; otherwise the defaults are \code{"yi"} and \code{"vi"}).} \item{append}{logical to specify whether the data frame provided via the \code{data} argument should be returned together with the estimated values (the default is \code{TRUE}).} \item{replace}{character string or logical to specify how values in \code{var.names} should be replaced (only relevant when using the \code{data} argument and if variables in \code{var.names} already exist in the data frame). See the \sQuote{Value} section for more details.} \item{\dots}{other arguments.} } \details{ The \code{\link{escalc}} function can be used to compute a wide variety of effect sizes or \sQuote{outcome measures}. However, the inputs required to compute certain measures with this function may not be reported for all of the studies. Under certain circumstances, other information (such as point estimates and corresponding confidence intervals and/or test statistics) may be available that can be converted into the appropriate format needed for a meta-analysis. The purpose of the present function is to facilitate this process. The function typically takes a data frame created with the \code{\link{escalc}} function as input via the \code{data} argument. This object should contain variables \code{yi} and \code{vi} (unless argument \code{var.names} was used to adjust these variable names when the \code{"escalc"} object was created) for the observed effect sizes or outcomes and the corresponding sampling variances, respectively. For some studies, the values for these variables may be missing. \subsection{Converting Point Estimates and Confidence Intervals}{ In some studies, the effect size estimate or observed outcome may already be reported. If so, such values can be supplied via the \code{out} argument and are then substituted for missing \code{yi} values. At times, it may be necessary to transform the reported values (e.g., reported odds ratios to log odds ratios). Via argument \code{transf}, an appropriate transformation function can be specified (e.g., \code{transf=log}), in which case \mjseqn{y_i = f(\textrm{out})} where \mjeqn{f(\cdot)}{f(.)} is the function specified via \code{transf}. Moreover, a confidence interval (CI) may have been reported together with the estimate. The bounds of the CI can be supplied via arguments \code{ci.lb} and \code{ci.ub}, which are also transformed if a function is specified via \code{transf}. Assume that the bounds were obtained from a Wald-type CI of the form \mjseqn{y_i \pm z_{crit} \sqrt{v_i}} (on the transformed scale if \code{transf} is specified), where \mjseqn{v_i} is the sampling variance corresponding to the effect size estimate or observed outcome (so that \mjseqn{\sqrt{v_i}} is the corresponding standard error) and \mjeqn{z_{crit}}{z_crit} is the appropriate critical value from a standard normal distribution (e.g., \mjseqn{1.96} for a 95\% CI). Then \mjdeqn{v_i = \left(\frac{\textrm{ci.ub} - \textrm{ci.lb}}{2 \times z_{crit}}\right)^2}{v_i = ((ci.ub - ci.lb) / (2*z_crit))^2} is used to back-calculate the sampling variances of the (transformed) effect size estimates or observed outcomes and these values are then substituted for missing \code{vi} values in the dataset. For example, consider the following dataset of three RCTs used as input for a meta-analysis of log odds ratios: \preformatted{ dat <- data.frame(study = 1:3, cases.trt = c(23, NA, 4), n.trt = c(194, 183, 46), cases.plc = c(38, NA, 7), n.plc = c(201, 188, 44), oddsratio = c(NA, 0.64, NA), lower = c(NA, 0.33, NA), upper = c(NA, 1.22, NA)) dat <- escalc(measure="OR", ai=cases.trt, n1i=n.trt, ci=cases.plc, n2i=n.plc, data=dat) dat # study cases.trt n.trt cases.plc n.plc oddsratio lower upper yi vi # 1 1 23 194 38 201 NA NA NA -0.5500 0.0818 # 2 2 NA 183 NA 188 0.64 0.33 1.22 NA NA # 3 3 4 46 7 44 NA NA NA -0.6864 0.4437} where variable \code{yi} contains the log odds ratios and \code{vi} the corresponding sampling variances as computed from the counts and group sizes by \code{escalc()}. Study 2 does not report the counts (or sufficient information to reconstruct them), but the odds ratio and a corresponding 95\% confidence interval (CI) directly, as given by variables \code{oddsratio}, \code{lower}, and \code{upper}. The CI is a standard Wald-type CI that was computed on the log scale (and whose bounds were then exponentiated). Then the present function can be used as follows: \preformatted{ dat <- conv.wald(out=oddsratio, ci.lb=lower, ci.ub=upper, data=dat, transf=log) dat # study cases.trt n.trt cases.plc n.plc oddsratio lower upper yi vi # 1 1 23 194 38 201 NA NA NA -0.5500 0.0818 # 2 2 NA 183 NA 188 0.64 0.33 1.22 -0.4463 0.1113 # 3 3 4 46 7 44 NA NA NA -0.6864 0.4437} Now variables \code{yi} and \code{vi} in the dataset are complete. If the CI was not a 95\% CI, then one can specify the appropriate level via the \code{level} argument. This can also be an entire vector in case different studies used different levels. By default (i.e., when \code{check=TRUE}), the function carries out a rough check to examine if the point estimate falls (approximately) halfway between the CI bounds (on the transformed scale) for each study for which the conversion was carried out. A warning is issued if there are studies where this is not the case. This may indicate that a particular CI was not a Wald-type CI or was computed on a different scale (in which case the back-calculation above would be inappropriate), but can also arise due to rounding of the reported values (in which case the back-calculation would still be appropriate, albeit possibly a bit inaccurate). Care should be taken when using such back-calculated values in a meta-analysis. } \subsection{Converting Test Statistics and P-Values}{ Similarly, study authors may report the test statistic and/or p-value from a Wald-type test of the form \mjseqn{\textrm{zval} = y_i / \sqrt{v_i}} (on the transformed scale if \code{transf} is specified), with the corresponding two-sided p-value given by \mjseqn{\textrm{pval} = 2(1 - \Phi(\textrm{|zval|}))}, where \mjeqn{\Phi(\cdot)}{Phi(.)} denotes the cumulative distribution function of a standard normal distribution (i.e., \code{\link{pnorm}}). Test statistics and/or corresponding p-values of this form can be supplied via arguments \code{zval} and \code{pval}. A given p-value can be back-transformed into the corresponding test statistic (if it is not already available) with \mjseqn{\textrm{zval} = \Phi^{-1}(1 - \textrm{pval}/2)}, where \mjeqn{\Phi^{-1}(\cdot)}{Phi^{-1}(.)} denotes the quantile function (i.e., the inverse of the cumulative distribution function) of a standard normal distribution (i.e., \code{\link{qnorm}}). Then \mjdeqn{v_i = \left(\frac{y_i}{\textrm{zval}}\right)^2}{v_i = (yi / zval)^2} is used to back-calculate a missing \code{vi} value in the dataset. Note that the conversion of a p-value to the corresponding test statistic (which is then converted into sampling variance) as shown above assumes that the exact p-value is reported. If authors only report that the p-value fell below a certain threshold (e.g., \mjseqn{p < .01} or if authors only state that the test was significant -- which typically implies \mjseqn{p < .05}), then a common approach is to use the value of the cutoff reported (e.g., if \mjseqn{p < .01} is reported, then assume \mjseqn{p = .01}), which is conservative (since the actual p-value was below that assumed value by some unknown amount). The conversion will therefore tend to be much less accurate. Using the earlier example, suppose that only the odds ratio and the corresponding two-sided p-value from a Wald-type test (whether the log odds ratio differs significantly from zero) is reported for study 2. \preformatted{ dat <- data.frame(study = 1:3, cases.trt = c(23, NA, 4), n.trt = c(194, 183, 46), cases.plc = c(38, NA, 7), n.plc = c(201, 188, 44), oddsratio = c(NA, 0.64, NA), pval = c(NA, 0.17, NA)) dat <- escalc(measure="OR", ai=cases.trt, n1i=n.trt, ci=cases.plc, n2i=n.plc, data=dat) dat study cases.trt n.trt cases.plc n.plc oddsratio pval yi vi 1 1 23 194 38 201 NA NA -0.5500 0.0818 2 2 NA 183 NA 188 0.64 0.17 NA NA 3 3 4 46 7 44 NA NA -0.6864 0.4437} Then the function can be used as follows: \preformatted{ dat <- conv.wald(out=oddsratio, pval=pval, data=dat, transf=log) dat # study cases.trt n.trt cases.plc n.plc oddsratio pval yi vi # 1 1 23 194 38 201 NA NA -0.5500 0.0818 # 2 2 NA 183 NA 188 0.64 0.17 -0.4463 0.1058 # 3 3 4 46 7 44 NA NA -0.6864 0.4437} Note that the back-calculated sampling variance for study 2 is not identical in these two examples, because the CI bounds and p-value are rounded to two decimal places, which introduces some inaccuracies. Also, if both (\code{ci.lb}, \code{ci.ub}) and either \code{zval} or {pval} is available for a study, then the back-calculation of \mjseqn{v_i} via the confidence interval is preferred. } Optionally, one can use the \code{n} argument to supply the total sample sizes of the studies. This has no relevance for the calculations done by the present function, but some other functions may use this information (e.g., when drawing a funnel plot with the \code{\link{funnel}} function and one adjusts the \code{yaxis} argument to one of the options that puts the sample sizes or some transformation thereof on the y-axis). } \value{ If the \code{data} argument was not specified or \code{append=FALSE}, a data frame of class \code{c("escalc","data.frame")} with two variables called \code{var.names[1]} (by default \code{"yi"}) and \code{var.names[2]} (by default \code{"vi"}) with the (transformed) observed effect sizes or outcomes and the corresponding sampling variances (computed as described above). If \code{data} was specified and \code{append=TRUE}, then the original data frame is returned. If \code{var.names[1]} is a variable in \code{data} and \code{replace="ifna"} (or \code{replace=FALSE}), then only missing values in this variable are replaced with the (possibly transformed) observed effect sizes or outcomes from \code{out} (where possible) and otherwise a new variable called \code{var.names[1]} is added to the data frame. Similarly, if \code{var.names[2]} is a variable in \code{data} and \code{replace="ifna"} (or \code{replace=FALSE}), then only missing values in this variable are replaced with the sampling variances back-calculated as described above (where possible) and otherwise a new variable called \code{var.names[2]} is added to the data frame. If \code{replace="all"} (or \code{replace=TRUE}), then all values in \code{var.names[1]} and \code{var.names[2]} are replaced, even for cases where the value in \code{var.names[1]} and \code{var.names[2]} is not missing. } \note{ \bold{A word of caution}: Except for the check on the CI bounds, there is no possibility to determine if the back-calculations done by the function are appropriate in a given context. They are only appropriate when the CI bounds and tests statistics (or p-values) arose from Wald-type CIs / tests as described above. Using the same back-calculations for other purposes is likely to yield nonsensical values. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{escalc}} for a function to compute various effect size measures. } \examples{ ### a very simple example dat <- data.frame(or=c(1.37,1.89), or.lb=c(1.03,1.60), or.ub=c(1.82,2.23)) dat ### convert the odds ratios and CIs into log odds ratios with corresponding sampling variances dat <- conv.wald(out=or, ci.lb=or.lb, ci.ub=or.ub, data=dat, transf=log) dat ############################################################################ ### a more elaborate example based on the BCG vaccine dataset dat <- dat.bcg[,c(2:7)] dat ### with complete data, we can use escalc() in the usual way dat1 <- escalc(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) dat1 ### random-effects model fitted to these data res1 <- rma(yi, vi, data=dat1) res1 ### now suppose that the 2x2 table data are not reported in all studies, but that the ### following dataset could be assembled based on information reported in the studies dat2 <- data.frame(summary(dat1)) dat2[c("yi", "ci.lb", "ci.ub")] <- data.frame(summary(dat1, transf=exp))[c("yi", "ci.lb", "ci.ub")] names(dat2)[which(names(dat2) == "yi")] <- "or" dat2[,c("or","ci.lb","ci.ub","pval")] <- round(dat2[,c("or","ci.lb","ci.ub","pval")], digits=2) dat2$vi <- dat2$sei <- dat2$zi <- NULL dat2$ntot <- with(dat2, tpos + tneg + cpos + cneg) dat2[c(1,12),c(3:6,9:10)] <- NA dat2[c(4,9), c(3:6,8)] <- NA dat2[c(2:3,5:8,10:11,13),c(7:10)] <- NA dat2$ntot[!is.na(dat2$tpos)] <- NA dat2 ### in studies 1 and 12, authors reported only the odds ratio and the corresponding p-value ### in studies 4 and 9, authors reported only the odds ratio and the corresponding 95% CI ### use escalc() first dat2 <- escalc(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat2) dat2 ### fill in the missing log odds ratios and sampling variances dat2 <- conv.wald(out=or, ci.lb=ci.lb, ci.ub=ci.ub, pval=pval, n=ntot, data=dat2, transf=log) dat2 ### random-effects model fitted to these data res2 <- rma(yi, vi, data=dat2) res2 ### any differences between res1 and res2 are a result of or, ci.lb, ci.ub, and pval being ### rounded in dat2 to two decimal places; without rounding, the results would be identical } \keyword{manip} metafor/man/residuals.rma.Rd0000644000176200001440000002604414505063152015531 0ustar liggesusers\name{residuals.rma} \alias{residuals} \alias{rstandard} \alias{rstudent} \alias{residuals.rma} \alias{rstandard.rma.uni} \alias{rstandard.rma.mh} \alias{rstandard.rma.mv} \alias{rstandard.rma.peto} \alias{rstudent.rma.uni} \alias{rstudent.rma.mh} \alias{rstudent.rma.mv} \alias{rstudent.rma.peto} \title{Residual Values based on 'rma' Objects} \description{ Functions to compute residuals and standardized versions thereof for models fitted with the \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, and \code{\link{rma.mv}} functions. \loadmathjax } \usage{ \method{residuals}{rma}(object, type="response", \dots) \method{rstandard}{rma.uni}(model, digits, type="marginal", \dots) \method{rstandard}{rma.mh}(model, digits, \dots) \method{rstandard}{rma.peto}(model, digits, \dots) \method{rstandard}{rma.mv}(model, digits, cluster, \dots) \method{rstudent}{rma.uni}(model, digits, progbar=FALSE, \dots) \method{rstudent}{rma.mh}(model, digits, progbar=FALSE, \dots) \method{rstudent}{rma.peto}(model, digits, progbar=FALSE, \dots) \method{rstudent}{rma.mv}(model, digits, progbar=FALSE, cluster, reestimate=TRUE, parallel="no", ncpus=1, cl, \dots) } \arguments{ \item{object}{an object of class \code{"rma"} (for \code{residuals}).} \item{type}{the type of residuals which should be returned. For \code{residuals}, the alternatives are: \code{"response"} (default), \code{"rstandard"}, \code{"rstudent"}, and \code{"pearson"}. For \code{rstandard.rma.uni}, the alternatives are: \code{"marginal"} (default) and \code{"conditional"}. See \sQuote{Details}.} \item{model}{an object of class \code{"rma"} (for \code{residuals}) or an object of class \code{"rma.uni"}, \code{"rma.mh"}, \code{"rma.peto"}, or \code{"rma.mv"} (for \code{rstandard} and \code{rstudent}).} \item{cluster}{optional vector to specify a clustering variable to use for computing cluster-level multivariate standardized residuals (only for \code{"rma.mv"} objects).} \item{reestimate}{logical to specify whether variance/correlation components should be re-estimated after deletion of the \mjeqn{i\textrm{th}}{ith} case when computing externally standardized residuals for \code{"rma.mv"} objects (the default is \code{TRUE}).} \item{parallel}{character string to specify whether parallel processing should be used (the default is \code{"no"}). For parallel processing, set to either \code{"snow"} or \code{"multicore"}. See \sQuote{Note}.} \item{ncpus}{integer to specify the number of processes to use in the parallel processing.} \item{cl}{optional cluster to use if \code{parallel="snow"}. If unspecified, a cluster on the local machine is created for the duration of the call.} \item{digits}{optional integer to specify the number of decimal places to which the printed results should be rounded. If unspecified, the default is to take the value from the object.} \item{progbar}{logical to specify whether a progress bar should be shown (only for \code{rstudent}) (the default is \code{FALSE}).} \item{\dots}{other arguments.} } \details{ The observed residuals (obtained with \code{residuals}) are simply equal to the \sQuote{observed - fitted} values. These can be obtained with \code{residuals(object)} (using the default \code{type="response"}). Dividing the observed residuals by the model-implied standard errors of the observed effect sizes or outcomes yields Pearson (or semi-standardized) residuals. These can be obtained with \code{residuals(object, type="pearson")}. Dividing the observed residuals by their corresponding standard errors yields (internally) standardized residuals. These can be obtained with \code{rstandard(model)} or \code{residuals(object, type="rstandard")}. With \code{rstudent(model)} (or \code{residuals(object, type="rstudent")}), one can obtain the externally standardized residuals (also called standardized deleted residuals or (externally) studentized residuals). The externally standardized residual for the \mjeqn{i\textrm{th}}{ith} case is obtained by deleting the \mjeqn{i\textrm{th}}{ith} case from the dataset, fitting the model based on the remaining cases, calculating the predicted value for the \mjeqn{i\textrm{th}}{ith} case based on the fitted model, taking the difference between the observed and the predicted value for the \mjeqn{i\textrm{th}}{ith} case (which yields the deleted residual), and then standardizing the deleted residual based on its standard error. If a particular case fits the model, its standardized residual follows (asymptotically) a standard normal distribution. A large standardized residual for a case therefore may suggest that the case does not fit the assumed model (i.e., it may be an outlier). For \code{"rma.uni"} objects, \code{rstandard(model, type="conditional")} computes conditional residuals, which are the deviations of the observed effect sizes or outcomes from the best linear unbiased predictions (BLUPs) of the study-specific true effect sizes or outcomes (see \code{\link[=blup.rma.uni]{blup}}). For \code{"rma.mv"} objects, one can specify a clustering variable (via the \code{cluster} argument). If specified, \code{rstandard(model)} and \code{rstudent(model)} also compute cluster-level multivariate (internally or externally) standardized residuals. If all outcomes within a cluster fit the model, then the multivariate standardized residual for the cluster follows (asymptotically) a chi-square distribution with \mjseqn{k_i} degrees of freedom (where \mjseqn{k_i} denotes the number of outcomes within the cluster). See also \code{\link{influence.rma.uni}} and \code{\link{influence.rma.mv}} for other leave-one-out diagnostics that are useful for detecting influential cases in models fitted with the \code{\link{rma.uni}} and \code{\link{rma.mv}} functions. } \value{ Either a vector with the residuals of the requested type (for \code{residuals}) or an object of class \code{"list.rma"}, which is a list containing the following components: \item{resid}{observed residuals (for \code{rstandard}) or deleted residuals (for \code{rstudent}).} \item{se}{corresponding standard errors.} \item{z}{standardized residuals (internally standardized for \code{rstandard} or externally standardized for \code{rstudent}).} When a clustering variable is specified for \code{"rma.mv"} objects, the returned object is a list with the first element (named \code{obs}) as described above and a second element (named \code{cluster} of class \code{"list.rma"} with: \item{X2}{cluster-level multivariate standardized residuals.} \item{k}{number of observed effect sizes or outcomes within the clusters.} The object is formatted and printed with \code{\link[=print.list.rma]{print}}. To format the results as a data frame, one can use the \code{\link[=as.data.frame.list.rma]{as.data.frame}} function. } \note{ The externally standardized residuals (obtained with \code{rstudent}) are calculated by refitting the model \mjseqn{k} times (where \mjseqn{k} denotes the number of cases). Depending on how large \mjseqn{k} is, it may take a few moments to finish the calculations. For complex models fitted with \code{\link{rma.mv}}, this can become computationally expensive. On machines with multiple cores, one can try to speed things up by delegating the model fitting to separate worker processes, that is, by setting \code{parallel="snow"} or \code{parallel="multicore"} and \code{ncpus} to some value larger than 1 (only for objects of class \code{"rma.mv"}). Parallel processing makes use of the \code{\link[parallel]{parallel}} package, using the \code{\link[parallel]{makePSOCKcluster}} and \code{\link[parallel]{parLapply}} functions when \code{parallel="snow"} or using \code{\link[parallel]{mclapply}} when \code{parallel="multicore"} (the latter only works on Unix/Linux-alikes). With \code{parallel::detectCores()}, one can check on the number of available cores on the local machine. Alternatively (or in addition to using parallel processing), one can also set \code{reestimate=FALSE}, in which case any variance/correlation components in the model are not re-estimated after deleting the \mjeqn{i\textrm{th}}{ith} case from the dataset. Doing so only yields an approximation to the externally standardized residuals (and the cluster-level multivariate standardized residuals) that ignores the influence of the \mjeqn{i\textrm{th}}{ith} case on the variance/correlation components, but is considerably faster (and often yields similar results). It may not be possible to fit the model after deletion of the \mjeqn{i\textrm{th}}{ith} case from the dataset. This will result in \code{NA} values for that case when calling \code{rstudent}. Also, for \code{"rma.mv"} objects with a clustering variable specified, it may not be possible to compute the cluster-level multivariate standardized residual for a particular cluster (if the var-cov matrix of the residuals within a cluster is not of full rank). This will result in \code{NA} for that cluster. The variable specified via \code{cluster} is assumed to be of the same length as the data originally passed to the \code{rma.mv} function (and if the \code{data} argument was used in the original model fit, then the variable will be searched for within this data frame first). Any subsetting and removal of studies with missing values that was applied during the model fitting is also automatically applied to the variable specified via the \code{cluster} argument. For objects of class \code{"rma.mh"} and \code{"rma.peto"}, \code{rstandard} actually computes Pearson (or semi-standardized) residuals. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Hedges, L. V., & Olkin, I. (1985). \emph{Statistical methods for meta-analysis}. San Diego, CA: Academic Press. Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} Viechtbauer, W. (2021). Model checking in meta-analysis. In C. H. Schmid, T. Stijnen, & I. R. White (Eds.), \emph{Handbook of meta-analysis} (pp. 219--254). Boca Raton, FL: CRC Press. \verb{https://doi.org/10.1201/9781315119403} Viechtbauer, W., & Cheung, M. W.-L. (2010). Outlier and influence diagnostics for meta-analysis. \emph{Research Synthesis Methods}, \bold{1}(2), 112--125. \verb{https://doi.org/10.1002/jrsm.11} } \seealso{ \code{\link{rma.uni}}, \code{\link{rma.mh}}, \code{\link{rma.peto}}, \code{\link{rma.glmm}}, and \code{\link{rma.mv}} for functions to fit models for which the various types of residuals can be computed. \code{\link{influence.rma.uni}} and \code{\link{influence.rma.mv}} for other model diagnostics. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit random-effects model res <- rma(yi, vi, data=dat) ### compute the studentized residuals rstudent(res) ### fit mixed-effects model with absolute latitude as moderator res <- rma(yi, vi, mods = ~ ablat, data=dat) ### compute the studentized residuals rstudent(res) } \keyword{models} metafor/man/mfopt.Rd0000644000176200001440000000732414505063152014105 0ustar liggesusers\name{mfopt} \alias{mfopt} \alias{getmfopt} \alias{setmfopt} \title{Getting and Setting Package Options} \description{ Functions for getting and setting \pkg{metafor} package options. \loadmathjax } \usage{ getmfopt(x, default=NULL) setmfopt(...) } \arguments{ \item{x}{The name of an option. If unspecified, all options are returned.} \item{default}{value to return if the option name does not exist.} \item{\dots}{one or more option names and the corresponding values to which they should be set.} } \details{ The \pkg{metafor} package stores some of its options as a list element called \code{"metafor"} in the system options (see \code{\link{options}}). Hence, \code{getmfopt()} is the same as \code{getOption("metafor")}. One can also set \code{x} to the name of an option to return. With \code{setmfopt()}, one can set one or more options to their desired values. Currently, the following options are supported: \describe{ \item{\code{check}}{logical to specify whether a version check should be carried out when loading the package (the default is \code{TRUE}). See \link[=misc-options]{here} for details. Obviously, this option must be set before loading the package (e.g., with \code{options(metafor=list(check=FALSE))}).} \item{\code{silent}}{logical to specify whether a startup message should be issued when loading the package (the default is \code{FALSE}). Obviously, this option must be set before loading the package (e.g., with \code{options(metafor=list(silent=TRUE))}). Note that messages about required packages that are automatically loaded are not suppressed by this. To fully suppress all startup messages, load the package with \code{\link{suppressPackageStartupMessages}}.} \item{\code{space}}{logical to specify whether an empty line should be added before and after the output (the default is \code{TRUE}). See \link[=misc-options]{here} for details.} \item{\code{digits}}{a named vector to specify how various aspects of the output should be rounded (unset by default). See \link[=misc-options]{here} for details.} \item{\code{style}}{a list whose elements specify the styles for various parts of the output when the \href{https://cran.r-project.org/package=crayon}{crayon} package is loaded and a terminal is used that support \sQuote{ANSI} color/highlight codes (unset by default). See \link[=misc-options]{here} for details.} \item{\code{theme}}{character string to specify how plots created by the package should be themed. The default is \code{"default"}, which means that the default foreground and background colors of plotting devices are used. Alternative options are \code{"light"} and \code{"dark"}, which forces plots to be drawn with a light or dark background, respectively. See \link[=misc-options]{here} for further details. RStudio users can also set this to \code{"auto"}, in which case plotting colors are chosen depending on the RStudio theme used (for some themes, using \code{"auto2"} might be aesthetically more pleasing). One can also use \code{setmfopt(theme="custom", fg=, bg=)} to set the foreground and background colors to custom choices (depending on the colors chosen, using \code{"custom2"} might be aesthetically more pleasing).} } } \value{ Either a vector with the value for the chosen option or a list with all options. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \examples{ getmfopt() getmfopt(space) setmfopt(space=FALSE) getmfopt() setmfopt(space=TRUE) getmfopt() } \keyword{manip} metafor/man/trimfill.Rd0000644000176200001440000001613114505063152014576 0ustar liggesusers\name{trimfill} \alias{trimfill} \alias{trimfill.rma.uni} \title{Trim and Fill Analysis for 'rma.uni' Objects} \description{ Function to carry out a trim and fill analysis for objects of class \code{"rma.uni"}. \loadmathjax } \usage{ trimfill(x, \dots) \method{trimfill}{rma.uni}(x, side, estimator="L0", maxiter=100, verbose=FALSE, ilim, \dots) } \arguments{ \item{x}{an object of class \code{"rma.uni"}.} \item{side}{optional character string (either \code{"left"} or \code{"right"}) to specify on which side of the funnel plot the missing studies should be imputed. If left unspecified, the side is chosen within the function depending on the results of the regression test (see \code{\link{regtest}} for details on this test).} \item{estimator}{character string (either \code{"L0"}, \code{"R0"}, or \code{"Q0"}) to specify the estimator for the number of missing studies (the default is \code{"L0"}).} \item{maxiter}{integer to specify the maximum number of iterations for the trim and fill method (the default is \code{100}).} \item{verbose}{logical to specify whether output should be generated on the progress of the iterative algorithm used as part of the trim and fill method (the default is \code{FALSE}).} \item{ilim}{limits for the imputed values. If unspecified, no limits are used.} \item{\dots}{other arguments.} } \details{ The trim and fill method is a nonparametric (rank-based) data augmentation technique proposed by Duval and Tweedie (2000a, 2000b; see also Duval, 2005). The method can be used to estimate the number of studies missing from a meta-analysis due to suppression of the most extreme results on one side of the funnel plot. The method then augments the observed data so that the funnel plot is more symmetric and recomputes the summary estimate based on the complete data. The trim and fill method can only be used in the context of an equal- or a random-effects model (i.e., in models without moderators). The method should not be regarded as a way of yielding a more \sQuote{valid} estimate of the overall effect or outcome, but as a way of examining the sensitivity of the results to one particular selection mechanism (i.e., one particular form of publication bias). } \value{ An object of class \code{c("rma.uni.trimfill","rma.uni","rma")}. The object is a list containing the same components as objects created by \code{\link{rma.uni}}, except that the data are augmented by the trim and fill method. The following components are also added: \item{k0}{estimated number of missing studies.} \item{side}{either \code{"left"} or \code{"right"}, indicating on which side of the funnel plot the missing studies (if any) were imputed.} \item{se.k0}{standard error of k0.} \item{p.k0}{p-value for the test of \mjeqn{\mbox{H}_0}{H_0}: no missing studies on the chosen side (only when \code{estimator="R0"}; \code{NA} otherwise).} \item{yi}{the observed effect sizes or outcomes plus the imputed values (if there are any).} \item{vi}{the corresponding sampling variances} \item{fill}{a logical vector indicating which of the values in \code{yi} are the observed (\code{FALSE}) and the imputed (\code{TRUE}) data.} The results of the fitted model after the data augmentation are printed with the \code{\link[=print.rma.uni]{print}} function. Calling \code{\link[=funnel.rma]{funnel}} on the object provides a funnel plot of the observed and imputed data. } \note{ Three different estimators for the number of missing studies were proposed by Duval and Tweedie (2000a, 2000b). Based on these articles and Duval (2005), \code{"R0"} and \code{"L0"} are recommended. An advantage of estimator \code{"R0"} is that it provides a test of the null hypothesis that the number of missing studies (on the chosen side) is zero. If the outcome measure used for the analysis is bounded (e.g., correlations are bounded between -1 and +1, proportions are bounded between 0 and 1), one can use the \code{ilim} argument to enforce those limits when imputing values (imputed values cannot exceed those bounds then). The model used during the trim and fill procedure is the same as used by the original model object. Hence, if an equal-effects model is passed to the function, then an equal-effects model is also used during the trim and fill procedure and the results provided are also based on an equal-effects model. This would be an \sQuote{equal-equal} approach. Similarly, if a random-effects model is passed to the function, then the same model is used as part of the trim and fill procedure and for the final analysis. This would be a \sQuote{random-random} approach. However, one can also easily fit a different model for the final analysis than was used for the trim and fill procedure. See \sQuote{Examples} for an illustration of an \sQuote{equal-random} approach. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Duval, S. J., & Tweedie, R. L. (2000a). Trim and fill: A simple funnel-plot-based method of testing and adjusting for publication bias in meta-analysis. \emph{Biometrics}, \bold{56}(2), 455--463. \verb{https://doi.org/10.1111/j.0006-341x.2000.00455.x} Duval, S. J., & Tweedie, R. L. (2000b). A nonparametric "trim and fill" method of accounting for publication bias in meta-analysis. \emph{Journal of the American Statistical Association}, \bold{95}(449), 89--98. \verb{https://doi.org/10.1080/01621459.2000.10473905} Duval, S. J. (2005). The trim and fill method. In H. R. Rothstein, A. J. Sutton, & M. Borenstein (Eds.) \emph{Publication bias in meta-analysis: Prevention, assessment, and adjustments} (pp. 127--144). Chichester, England: Wiley. Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link[=funnel.rma]{funnel}} for a function to create funnel plots of the observed and augmented data. \code{\link{regtest}} for the regression test, \code{\link{ranktest}} for the rank correlation test, \code{\link{tes}} for the test of excess significance, \code{\link{fsn}} to compute the fail-safe N (file drawer analysis), and \code{\link{selmodel}} for selection models. } \examples{ ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### meta-analysis of the log risk ratios using an equal-effects model res <- rma(yi, vi, data=dat, method="EE") taf <- trimfill(res) taf funnel(taf, cex=1.2, legend=list(show="cis")) ### estimator "R0" also provides test of H0: no missing studies (on the chosen side) taf <- trimfill(res, estimator="R0") taf ### meta-analysis of the log risk ratios using a random-effects model res <- rma(yi, vi, data=dat) taf <- trimfill(res) taf funnel(taf, cex=1.2, legend=list(show="cis")) ### the examples above are equal-equal and random-random approaches ### illustration of an equal-random approach res <- rma(yi, vi, data=dat, method="EE") taf <- trimfill(res) filled <- data.frame(yi = taf$yi, vi = taf$vi, fill = taf$fill) filled rma(yi, vi, data=filled) } \keyword{models} metafor/man/print.ranktest.rma.Rd0000644000176200001440000000226614505063152016524 0ustar liggesusers\name{print.ranktest} \alias{print.ranktest} \title{Print Method for 'ranktest' Objects} \description{ Function to print objects of class \code{"ranktest"}. } \usage{ \method{print}{ranktest}(x, digits=x$digits, \dots) } \arguments{ \item{x}{an object of class \code{"ranktest"} obtained with \code{\link{ranktest}}.} \item{digits}{integer to specify the number of decimal places to which the printed results should be rounded (the default is to take the value from the object).} \item{\dots}{other arguments.} } \details{ The output includes: \itemize{ \item the estimated value of Kendall's tau rank correlation coefficient \item the corresponding p-value for the test that the true tau is equal to zero } } \value{ The function does not return an object. } \author{ Wolfgang Viechtbauer \email{wvb@metafor-project.org} \url{https://www.metafor-project.org} } \references{ Viechtbauer, W. (2010). Conducting meta-analyses in R with the metafor package. \emph{Journal of Statistical Software}, \bold{36}(3), 1--48. \verb{https://doi.org/10.18637/jss.v036.i03} } \seealso{ \code{\link{ranktest}} for the function to create \code{ranktest} objects. } \keyword{print} metafor/DESCRIPTION0000644000176200001440000000477414505073402013431 0ustar liggesusersPackage: metafor Version: 4.4-0 Date: 2023-09-27 Title: Meta-Analysis Package for R Authors@R: person(given = "Wolfgang", family = "Viechtbauer", role = c("aut","cre"), email = "wvb@metafor-project.org", comment = c(ORCID = "0000-0003-3463-4063")) Depends: R (>= 4.0.0), methods, Matrix, metadat, numDeriv Imports: stats, utils, graphics, grDevices, nlme, mathjaxr, pbapply Suggests: lme4, pracma, minqa, nloptr, dfoptim, ucminf, lbfgsb3c, subplex, BB, Rsolnp, alabama, Rcgmin, Rvmmin, optimParallel, CompQuadForm, mvtnorm, BiasedUrn, Epi, survival, GLMMadaptive, glmmTMB, multcomp, gsl, sp, ape, boot, clubSandwich, crayon, R.rsp, testthat, rmarkdown, wildmeta, emmeans, estmeansd, metaBLUE, rstudioapi Description: A comprehensive collection of functions for conducting meta-analyses in R. The package includes functions to calculate various effect sizes or outcome measures, fit equal-, fixed-, random-, and mixed-effects models to such data, carry out moderator and meta-regression analyses, and create various types of meta-analytical plots (e.g., forest, funnel, radial, L'Abbe, Baujat, bubble, and GOSH plots). For meta-analyses of binomial and person-time data, the package also provides functions that implement specialized methods, including the Mantel-Haenszel method, Peto's method, and a variety of suitable generalized linear (mixed-effects) models (i.e., mixed-effects logistic and Poisson regression models). Finally, the package provides functionality for fitting meta-analytic multivariate/multilevel models that account for non-independent sampling errors and/or true effects (e.g., due to the inclusion of multiple treatment studies, multiple endpoints, or other forms of clustering). Network meta-analyses and meta-analyses accounting for known correlation structures (e.g., due to phylogenetic relatedness) can also be conducted. An introduction to the package can be found in Viechtbauer (2010) . License: GPL (>= 2) ByteCompile: TRUE Encoding: UTF-8 RdMacros: mathjaxr VignetteBuilder: R.rsp URL: https://www.metafor-project.org https://github.com/wviechtb/metafor https://wviechtb.github.io/metafor/ https://www.wvbauer.com BugReports: https://github.com/wviechtb/metafor/issues NeedsCompilation: no Packaged: 2023-09-27 17:31:40 UTC; wviechtb Author: Wolfgang Viechtbauer [aut, cre] () Maintainer: Wolfgang Viechtbauer Repository: CRAN Date/Publication: 2023-09-27 18:40:02 UTC metafor/build/0000755000176200001440000000000014505063374013015 5ustar liggesusersmetafor/build/vignette.rds0000644000176200001440000000040514505063374015353 0ustar liggesusersuM0~ {lE{DH/6q[=d2d^L`74ad΢0ir1+4 Qqx4}gLI|R(GF09aƬd-NX} ̯=e{Rq}S<v^7wa`da}nxU(GLP]+Y?hR*t捳 u]%9*)EajӬJH]metafor/build/metafor.pdf0000644000176200001440000543115514505063373015162 0ustar liggesusers%PDF-1.5 % 2 0 obj << /Type /ObjStm /N 100 /First 804 /Length 982 /Filter /FlateDecode >> stream xڍV˒Hu~F8|rF4"PYB]ٙYEu&Ȑ1I).|e$$HXD0$ iM"%IԔeICf2(KI •)RJRfIYRKk D֞!R'*)ʳ%+9p2,j1,j1ꁃpO~Ja?#/Cd#o)Dj/S(禀AExG ^$$ ) ebβ/;4ܹ[M87]/bʰ3/@@聃p 0li.0qCB,<5XrbSAf, xင1 Jx 5TFe*`3x %`Ҹ8)x,!UXBQi,N>)fv( SrLEaa(8g\3P*Tu\E X?ܘ[aVEgŘ*醴0wb^gp؝ І. \?n8=tcPR0CQMA0Qu'oPu? Cy uZhFlC3?`W.M_Ϯc y0]<][ԡ.ډ;Qv#EsCɼ1~z.Mnj[0]+*J2AM[ܶpݢu'iz>{d^Pއ^N׉ac]_oou"_hyf ¯Us':szGO}0`ա9υ AWƩoop/z)j/a2Qq5C_3F D|"K%nak endstream endobj 203 0 obj << /Type /ObjStm /N 100 /First 862 /Length 961 /Filter /FlateDecode >> stream x}U˲8 ^bϪ^Mg$THIM $#l TD.Tn c9\)Tj!mj JiJ } d$V'"IKZh ^AA2S k+,q zU +,{s*-Y!N}+¹a7 8.` +Fe xB`HD 48B$U0lp L5$y 3W Kq/bc U2 #aM٠0bH댠PiQ7VX;@f#NKP`AbA"dS4MAMzC5Q-SސodΚ0H.lKu&>UsK{q&D1)N7-qqTܶU *<7+DPPq%"_?vwqwo?~dV8jĻՊH/e\r7&2>}ۆnCYRW3T+Vyp#oF_ޯs,:횂@ քhy޿K<Ůa4hc_ּ9bś~{;/_vM2q&yJԨ;Vuf> stream xڕXs6 ~_w5lkmle(JFRq~DҒ(K"J&7}={x&8&$"&IZ8'|8d6"oOIςhwwQEVh&،$h#"eJD#X4^jV)AIZ܏Vh 5MkuG8\!?K#D˹7j1 U++2f#Xݙ{WJE-ͪ`,ti 8 bl6a+y*N3s q,4t05CyY4Z \0eg7bՆbI*yx0s$DJDk'D\גY$Yfwnsꓪ)}[$ޣn!3A!r=9Z6D7}ebH~&d֖${jּWm., ;\G2hlU8 mAҏ메As .ЧGl'(>{g5Z_x9F#G $żK|<6@B^Z!X#^P%Iq壬c.BaubOgG4IfA:ר3A:W.kN( i2/uU`K-(.u&sG/\JS[\zUo: Iӂ\{tǻ_:jj>Z nM͡ђGS7nW}[)$) Hݠ-2W=f s ?Rtmo:?r Ss? CL' 8_PFPRLC`;ȴ eHi@%PʝJi jZk]rQRq~i@l]nzPv>sf h^rBɱ g3^[:< *^艁# J亟wnӅa|t5ae)tT>]{lVp┹[;cp(NI\|$pW߲&1..7] dJ_8g2T̥@3̮;`Jz70b6JNb1?b@՝؜ԍp|Ű qtQŅc7pK3 s!')уƈz16xs䙙]~x;SόZgusVDt|=j-QkFge9Ʀ9Cwo WMgB`ǧx:naȦ1k#E3Ҍ43mb u& LT/ 5?Yq1i+lLjh:){T`0ڿU]8ȘY|;dC4gQ}ؒ?|Uj%׉ n.5OA_R|!ht~ٽT endstream endobj 475 0 obj << /Length 978 /Filter /FlateDecode >> stream xKs0ဪcg-큀pI+{$=t/&I!ݛ;9WD$*H#J nC}xN'DPnosrs\ ɉec9E14rnugt}lG_4K bdz=فLr9&\-n)~8 (nBŒ乽\s,ϛ6fB0y2vڗq)[D/jQ wp*JuhX̍PR?k竅F]KCƶ)RY*j348/41'vpudxdXMTM"GLwG꾬|( )]1)KR7CwMu, bzeỸr{[1^פ- p=),#swt^6kDaH3Cyݶè(9uY*l"UL0 ʛ9!?'aSj r:^R|**k~؏Y M[X;Ss$ߕx=,ioaEu.!f,8,.;g{s,m9>؉]7uWSQ{  %_5[}B =NE͍M+i6p.u}&3|0+iw}`C͑] bِ{\͗6kGz\6#lDj~pށaQ2nJ7sq Ǿsc$׷-k_ endstream endobj 575 0 obj << /Length 895 /Filter /FlateDecode >> stream xMs0UHδ1[aʇpڟ_0dv/ًefyewZh huiE# 6 D*&&OLM4Dㄮ #&:oCeۄ~v7PnÔNqI1IUᲨZ5 #A) 1)?)A;\_ozзtKb XMܖJM* @Pm[:0RBU ~WĿl:C9e*5~ĭV.M=~SPJ!ku'Z*#o1혚h[N05q<& 0b;KE[fk" D{ؾ-ꎤub2NGH,7 | "'7 4s#ഭ2C{ gu5搞 O* pf~X=y pSTe/Av)w: zk\Y{?dz$mEgCKq*rF3Sz'了M΁һ[T^_E*Rڴv[l+IQTǖ}U=orf( endstream endobj 404 0 obj << /Type /ObjStm /N 100 /First 911 /Length 2571 /Filter /FlateDecode >> stream x[]o}_Gd p5M =Vh ieRS< `Ί<$/y!T(:%JxF|B19Q{'tW*] 6"DJE&MOEלQKBGu)d+ )XjU8ǍH LѥL`(jT+j;Lɀ/D#IV:(V:ʥnP:f률 .42>È0b+G+?f+\Ā$D'U0 ͈H ;ɊZ"NCG44]0-ʆ58f jAX Sgm)`]`eʈ`YjF39g0G\ 6mvru%&A 8B6hX׈iM\79tSuU@TU b\ `Nc[`0&1t.6$E6ǐBc" j1)hcv#HNZ 16bVmĚ8 V+t<1ٌMT1eX0|Hjhhɉ^鏻;7_~ͣg2lMOVd3ׇ~|n]+LϷW˳a=vݫ/k=tAKRc';zukLI'p|l^L}=zf<|u?R1@>gOXd*|2CL;O>_]gb<#x,#|wƟ~>}<ߞ߿⇣4T jߠH+ƱA 5>M՛NU_ ʔOAoQR>k 䧏o^_o/mڿbD0~^mÃzhTίW KO Ÿ1_N+PX+{ ?<;1(涱&j/9u/wg/>HOry~Y~4>gic-_;>@mo7PQG-xq-xq-xq'-xI'-xI'-xi-xi-xi[;{f[6b&ABA[IU-I=q_f @#χd] =/1bc(0x3fG|\lnJCi} Ht Ft0BS> xTǐ2 $㠖_2P`]`CaåW;``C;"In1$ZNqIIGgYu#Y$T_$cR|Y` zHG%)!+(9+5C:22!>|@]`PC:2KRR,H1ɎLʀHٗ0$hp#DqOk30K5Ga}>P,Ռ#_T[ NRmYydZf zpG˂,Lܑ>%A%>ql~&G EvpG;Wpڦ3 N"`%P(R%/uJ u#Pbj3SEBAƼ@ {(`,I읾i. {(F %sdԻ4E ,)UwqE(~qabr*PO99 @Q2w -Db^ʬ߱,PH[Z@. `gOeČsi;"%sHE  scE{jYXHV=Byaih2oM&yɔX@%)9>K{Mi4I$tf:I3NL'i4I$tf:I3NL'i4I$tf:I3NL'i4I$tf:I3NL'i4I$tf:I3NL'ik:, L+j~ZՌdw_(NI(Z*87^dZJsÀ, byHCgx]2,5{ZNRH8qvQ l\[/.R{wA}^bs Xʠ :CvQ-?E1@$&D,t^%wZWd|^X1>.vӽ8rAN].PX½GIw/P@ =bw,z"LpǤb^pۣMG`kŀ݌<]l#܀> stream xYKsܸW͜* >sۛnrn1$fC,#j[䤃@Fl\~"((7MA*Myn~~3F'1!Ծ*?IW®t/Ee@,d^WUy~V͠UwAAJVj")zhmWYM@Uq1 $hL=khulg)dRR=Zt;C5Ykpƹp)dT<{iNG|zz0 8{rˆKJh9a+c*,F6km ņ8O&7ϗ6s55 -GdVVV7Æg浃%9腈j <2k[XMa U6waսchYGr28mJi ã3E*q6m̧nĻ?a0:'i&:h 4ovE'8w q-K܆}29(³LU,[. 8HtD"Ȥ^aa"긫MiMQ=t9lj[Z^M"}N#xBwϮFTtq`ʬN߁'6TQt;L $Tib]7ىyQ~QG@YS>zwrCQh:t7At 6XG+3 Yj7q"MAkbL)J[%Cc(a=gp:;i =A`!( B#xvr% .; ' :$Ɣ퐲\"nȲӖA1e.˼ChT}GN2]{dV-l2+w"p[I(PeMlc][ ' >; ,~0:lp`0NK7SJ{6^[XFA|~Z=tٷGvZh{;@LX_xV{VB >ߕ)ߕWD8D#> stream x[Yo~heڈ)v ~`nֺ[TkIGUXU//WzAE2%~%R-4L%v6k/]z{!52VL+A)vJWF]HhhLhD/meArU9o4n7,Ӓf?f5ph&,ў Ɍʺ?^G>]tEoeeyiov?yKS/bo6/X}c(wW kvvU6"J F|8ҔȮIayK[ ʦ(m^S8k.:߽] |î# }Pg^2R-ys>)F8Sr .Y&eyĮPNm<~ d@ѸA<^֢lVOC-6g^@2A2P[p?{)fUm2xIB S/TA:95,zS|AQ-l-,omkbݾEpQEJ%K~+mgiuT5H[_xyz^{Ui۶"L'R6oPX)rv;4vkU71mڼ\/SUϫUZ*7ߦxKs:ŲоZ;XũY:,˵7/M R\b)4KT`SSmq>69;OTt agg+&<ppn+!y4c,ǘbToS&Ē)˒|{ T7Gw?RSg'U ؚ?gi6&^nHgtdź?6/G ld:1cf1)1Q' j-BEzy!j!m/sMS<)]k6 0Z<*Eƣ #l{2g2՝r x{P֩`ڨҚ-S2fQ^ܞ!/J:egN`Pb'HI|j<ȇ)C\s3p`R׳483njXy5(q[k8#$aFgdcRS` aP؄Nq,F'COխڙx>S-=\I+_RdJ M4UB/|v7ne~zl^MRuq$:wfLb?_kVhpwX'Bgұ>";i$ḣ/^aC"̕cQCwq ]j@.838_ԅv{ O#}0B 9TXXɁf)LqF2 ÅÅ/ܠ#iۼNsCP :'ra4gI2d/@68,A+ 4~_W 0^9RILBO7@OlP Sܓ&^/ v=N#s :&i)E&;3A! (d 8KBd gXR VNz oTh.ôGHƤ2}+Gxu,*ohQ%MAV#08%ԉ@KF! &4x9B؜ˆ:̆rhԫhz:k{O[9f)N $fb.OOuhOSĔYѾ#XC} CF<tV>9yy|T]~~%sb`B?ͱp𻓱pKx>Ra7e:OZO.lWO@o~0&9% ,}>4a&U^~sb  ]FzF /q\]2RK#gq8L'}̒3W| ynF=kF0(xiO(fSq`3S RPG'Fh*W*`H/ lf ŀr` Q:P ߶*}\)f8'R|:T f/1[52d&02D5uBe8 %#G)fK^Qݛ~^(H8(B E,B0tiƁMF#'9XFͮ*2')׽jtm(7zK*ͱW!a! .]Z >\~OLopn^"zpzK0%xXOC_}G=_qk޿n̞[sn=2a_PkU endstream endobj 680 0 obj << /Length 3170 /Filter /FlateDecode >> stream xZY~_CFƎ5xHb$M `gQl[YYr$y_:(YIAQd,dq7|ߘ&s؛)DIonw7?Fv_zFа Pܷ&T?{^jJRgn/&147[rxVݻs;~Z~HE\W modJ( ?{?jW,'أ*i!ODŽ#nA`1il? U&/jWf#,>v[u;;Zs(}jR&VY 'O'nl*C:g|s ffFM`G)b#xBj&JgpDff35n9gn& X|ǀ`<(~I|dIJ~s%sf6凅ՒRřtrZn%J@pba>zLH1KOLS"C8g׵`x h1095@ksr %-rj̆R\F̸ 4c{nn@s}cXwO/Z3eA_.~yT;UV501JB6灉Ѭ}HūoY"Λ~~ ]Ak7wәݬ T[8;7|c>P t*g78\wM~H1(q;?aq2 nD\o-\&7G7U}㢒?kPĦK풧'T&3b),}tT&%bLzg+j^ +7)y&]1`h22˲OUij}D 2!ד| |o -ŮfN#3ȓnGq%f1|Hikmdnrz,`+M UrH\] m@ɎS3@kϾF*VETy#4!v3墅IȁT32~}Y\4\pT: f:O ȋҤ>rb|aqr8~tn!9aI@ciK%q~eWE0O>$WB%iv'w<*:Wlm:9\~@CE1\Z2cv|v|:9UnE#Il=\ f>J011w_@|ngQ3NL[g] fa|Ϡ]~>K$V稍Nbp*FNlUqYDh8t=D>B+Bb؂s9blss4(e+CqbZj<9^+Oz:c >Ѐf4]tJxR& ๴3v"˳g,G:f p,=pѢs(.W\Nȝ0cEye߷UߓjCVyq4b-fOZ2`}WuIgZI> stream xڭkAx~ܷ nӠ8X,fKs"8`G(K$} 6߿ݛ,ٔ~E l|.҈(v~'XlMϳM9 $;rƴ,( <}Ʈ2Vd,f~V/F~q1lf+E_ixjkVh;щ4!\T-ہbƋ$Ԧe/OWIZ=H eGPu߆'k6J % lvqGAr 2Ma5J],fY#Β#Յ~ =èGnowq^ޚ6[V]H7NëBhLo,Cj,AU M `h=J֥y$k)2>Xi+'KʷKҀЦ; (=JƘ44'߸E {qI VRi1"~ @''٪$5;i5LA艙K9#Va%?|0V^ˣl߀bAy΄l:0Lr^|8 8\'IQ*ŋƭyv8WY/kWPWMfo(`gds_ AQǼ2 5bb& h)bpCչy8<‹޸ Ьb G_')?d[ l.6ӻ |d2P1=) AvW*,7-r4D!G: W;zH\z6?KoAJNسHGM#* :Z./S,ӧ[&jDzSg8:Hu9Ҁ#+I{S9ZFXD_\}hݒxӱ?C߯O@0um?#׾np]}FNThZ R:T7ګմxig|}$w?<؉޺]NR-U[*,ECVb-.N>.^-+*lބWޣ1( |9G 9XDw?qdh/D#Q )ǫ&"T@! t!&_$ZFXۗ>ɷW&<f7rb.`"h io9#/ȋ Ecc(8%7;^X[&G+,U&18\U*kSn\h9mb(]*%qy\dmB \J+$8ϯ,n K,w oC(ߓ]m5Ftx+l\*Ogu4b(n>F,8A`b0%Ov6rldVͻ0"o@ ~]–8F4Ղf)$ ъ3 _6O48Q ;'ά4G-eHp*QSO5d=ӧ()o&.4]~Y7hdg;6PcO3(}s Ho8t󕔥L,vG,([?@?p-am,vLi艉ʹ4@:<ʃix3y # mOpS8*=ckAE: ,_sxha#?MUǮyXeՁF+Ξ_FQdr~'/?(\K0 'AryAT&PG+:WIXEPRO|mvvܢ̀"夓znjױJœX:K%Ⱦk/h,^6Ú[HPAYsQe=n"YLq܆1hN &j;&L@$6u&86eMfFOU5b"w'=`U Lym<û2x簾ΰBȐ9ƸpjgR!wMEbd]=r|IG 3?L*nc 9Nพs͓ d7*ogܾqBm,p~=]OM4[1u¹Yv3 \8l-*ԯa26o4\ڠz_BXĠfr|]ZQpm,a^.=ԑwӦ?Is/+jETrT#}{*depɕ [D S!M積*QK/ u?RǶUUOZ2otJM`5:epݖ0[+fvTۣח9 S?5.c4=<~~9>=RreO5^; endstream endobj 719 0 obj << /Length 1926 /Filter /FlateDecode >> stream xڝXm6ȇV"/z]4m^ݻh +Ѷu3$XHŤ23tYw]^"'y“z(%"J)c$\dެ^'B$"cȲ ^P/DG;aKSn2Amu9631D2כef 9H2Amw/{պKq$%&pS\6ܷ*:?kŃ(wAݛS6$S袅 iMHͶr:dPj#N=Ћh([S{Pr0iD(Sl$͙o yNػm(U1P vOwzFUuc`e\g4<.(dF׺o3;Ւ[v5:*CO^\̠ FYPoDʵ{%ߓJ~G-M mX8X ktUڶimi0J3;)qxJ9֔Gt;Hʦ}kۥHeb`N6O l*k;  (1I:d0lU%qWhVygƩ_BuåQu&oGxZJ',%ܹ#6@l8ѯOCBԚYHB@Bn?hKX[pg-Ǣ#Y`p~U)F{].U!K ^I)xZev߲T[Qdݖ'R5qeέZP]3E6Zh%H6:"S8&o4`+δcZmeU4h 5o/+JĶ덚C2$gߠpݷ ,k Һ ܽ;5l<K?}LZL㘊 )s(#3)NH>L,2JCST+ d#)EHT{N G?Hcz_I`Z7e`Ĕǡ.`5>ss0 89ʲYQlgX7ix#uwp4:v+glX gǀp8!hG>> stream xڥXKs6W U53MTRUٱws"!YPH&)k)F?]6Lu 8g*JT,̑劓4M'Kϼ)L*f 'L ҭ~߶非Kpk[vn`"?U]k:h!igۮݻ+t E"eI8?7&38#dНAU S͔#LʛL3TZ)hZaÚ۪8zQagdxXhcGGStJ4MV}SzwX~u< >\#seDS9;ۋ'IG7m/%K01 f .,gv}b<72"G+ fKSG#e*WWĨ^KGۖ9V7.!8\CtEJ!j5 q8Eln!OэQئ*UƠ&$'7ŭmǎҌcX٦"k`R~ydzKSeK##Fg(MYeT,dLXپ[vO!#knu4&≧At=%rzQSRwc,MSc}DqFJ@ĸqcpS e|mz^I]*ˢY ~ UЌ ]ԺΈ<i(%]k[̶oB,#|D=p80*|Q$E >ƈLi+5 @dJ:U*ő%8țgM.'[*Bև&ͯN\wb1=ʓ)*ԊxryPiVԭH(r35G Hk޾'W sX̰iXWd 0)YJ ,2(W~A eНuDX8":dO~(3 Ls5&!7%9WWo&]Y=$x׀Q6l1f6ꊶ!P_n Isr<zqy&PiO3LgS_~ppEW+ Fz+":㩢bH=<ʠ>CRsmH릱P jwO z[k۷~٨)miZUD6tV,\;onoy#q3>B"U endstream endobj 610 0 obj << /Type /ObjStm /N 100 /First 897 /Length 2511 /Filter /FlateDecode >> stream xڽZo6?6p0 rWp {w}h/EHl+p ɔ .ť\%9 %9dJ ն}vbV-|*D*p=f9Y `O4Ac=Whu @@T`_1j@x)̔4>gپ5Dآ c,Ɍ%p=0kj>VXS\X;6@gx&A5S$P; JHn E V(R{QL,ޢrC1UP^ &j/2 > 0}(ֈpoM&wugb#ݦ}K8@^B[H( ^ͫ9Ջy3s6+5>>t>/[^ş5Mj}nZuD6,eJҕu]rJuwZ.ћ :}6@D{u4!DY}>Ss9 ",(kH6 Ă_1xJ1h-1i1D]>#soi=a ~SaAIdFȣ!@FWҮ~\` $9&P&OqQ`Za ؂H dž,xQj) [P1:[ %HvlG?<9Z|y7o>Ͷ XJHǧC frO6_Py_-IW&]Mw9MO@"G[S턋$*tD'f^p+WeY(8T@[Xmյ|\ y2rjQ˹>!%KEbTbEbD l-ۇa7>@nؘ(3qdd2'Co1-vܥ[m! MxOmQ Mۗ˛픵mˎGkǣhDmM2E:W*_!O#Rmկxpz}q<@_5ZomsbSݷm%"`+\52f)Ov#6h7@b d+l_9D#!oX@c2nd""n}|n7sNYPm$T|l~|z?NoEs1_}X\7FɶUt%P_ugw-aA [m{ = k D3íA|#&qߟy){ t_Q"<̆̔x"wY/ 7]Ͼzy. <28?nUs:?3% m:%jT} eXcF[h4mS}p4NL&zyig3v%wteʵ׸)+KWv۪nVZֻG,\l+@yi' [-dLnnp *6#|)n$; aG8 WQ,]ƠvkN"' M9AA2ž_/28[0F^!mkݔ{5hgT,@ fgW2 *mJS^z6NnW!K+6+ 9)zB&8kN*N6sFzMpky &A`)dڀb5mAA͌l endstream endobj 755 0 obj << /Length 1805 /Filter /FlateDecode >> stream xڽ]o6=oE}nC5ak- SE~ez6[ҜD%t?+g< =_4bTN":\;]Elk0]} \F$ɀɞDK&$RkrkDseQmWTUr 6b*i9LS!Y,*A(UO>q k-~\,YHQo'p|a\ql8 IJSr<&dAF艒<{zHQ-"(7IAAd͕k]j5`Yk+4}ll^ƧN}aa)BVQ~KFф(7]}%?e(fMF K$:翲yd;xGLoBj~l$ 8d*Vx8OY(X(˼⎅n9&_D>貖V6Nݰ2uG\d gks:{ ټ3~WT}j j(SqJj+P¾$$8ժ̠hJ$zmh @o  8b\zglfnF~qt6u 48b jLʺfiίLm#0:Q݌WI~D,$,͞ ß,i.e RW Ч=0۪'46Z=JT; Nɱ3FK`[dUBW]ëKUҭA̡6'cC%c&len0jLD u:EBQ{izQO>q߾bF$cg瀒,&\`? endstream endobj 765 0 obj << /Length 2183 /Filter /FlateDecode >> stream xڥYm۸_alF\R:zI6ť@iu%(ΐCYY7IÙg|ɟcLRF^4yZMI,tO~<, ,WS/ٿ~z&,N@Y'Nyi7i܋a̷K~T,J=X[KR2vF}E]^&4^܎}}QW$ns[74J_L5SۢZR5JncnHn-?L46nl0fF@=9š`DL?hdJu# v+g|Oab k;{) D)mҎ,Ӻ<xpg4eKɜF͆!70Ot:6,vжu4L}N30w ev;q(%NЛz_vީX= p*˽E}7EL:#mɌcy#gG< Q(NXCD2]﷪j,MV $#RY/wuېM! DžnK}0`;uňga}]]w^P;Te۞jbhθ9tj5jO=d){!fI >s cO9z_F/+@d+#%A*jss@$̭o;L,G`|? ԵmunŎ%54L!1Y:dרarh[C~QW OWXG=I$fhE+STiE#0v 'fڵjh }/֙#z$ؑ @H4G#2RA}EAr@Ǜ."D~*?GO 1ܖ/~tTJq1y%t$4$we@ uǯobNe/3ݲ^FS/B7m<+]4jݕ}J68}*z 'J}wwiÇzKUjMXdw9`.K&p"aUJZ 6e.nRϩ'\ D M8 v9NV i)zkj[8t( {-lۚ [x!çɦf`f+A F?lqPb0 aϦ gET[ ܤӉ/؁:u[.v.16JU0 qNi0w_CYk٤=lNѩrZ7q Gl? M\#rz*9_ 8`AoTo߼wZQz[d1nnG0Sp{G .M /]70d ڤ͂_?eb?8}H"ګ Rݗ{newKsȼ8?> stream xڽXK6W!6"'6[hGZmJr_!g(KZbmL7v}vMx)K#y[>AŜHm}\r/o`)`<Qy~U.ٱyu9(pqo-8 }'EqDza|JlY^āq}X7H9T, E8.Xp<_E/^%UeݬdmGe~}M;m^q5e :c3F~0FDܝxғ &oqpWS̙г)cz P6 y>V<\&3ɲ=qosR {D#w~_ Ke+27!C&=\+ W"Oe& ̃*`((W&2!|@ v)Q  L*,T-G?R: >U 蚭49jG7]T~,DR?'mNk\X ia33K!0K :6)Inc2ݎ:l?ca=kwބ6!֖2W'AʙUeg*d$g4ƗoBU&x9DE z}y/jTmtxߛ0 ZuQ~t6)nai_' n['R/H( 99ɓeB* kMD1tCV9끉X,Snj_ZhI*2S*"UFu)&O`)jcofM"wixgɦB%^GLl Ut x3ԟ8,]a9p;Ÿ!> stream xڥYm~P]sI+^ڻ{E@iȒ#o_3Ce+)XQ9yጏ3>˻^=} Y’ g/y~8`^ُ]]a]"X|)}.XlOx`m4X 79ldQ}ól1=l}٨WYWԕy$ s[6O Dԍynfu]W;+#SϩhZhoY(kǢې8PX X>0̒1$tr~]þ8݂_;dq$4Q8j_i\t*G/xXƔ^<`rB5/aq Q,b]8W̱Ȼ͔%Yw)dP)0jLhVuHc_6]*[[K$GӺ蹍cɡyT32pԁa ,\9mFW˺x ?u\sjyAM{_%q{*|{<,v,Y']gݬ`4b B|~Gmn~t<w+qfg*תyV+ h>Oubf\.8!|\K(ШJvlTsӦavN8?z6#(_Rz5gi$+b=3\}gUwѩ+1 qFnL 'd$AL~/BJ1.}FdqEO?-;p(c MS29?`6ŚrU{Q2(1Pڎ3-ѧb۫$u>{@FXٮL Y߿ǘGl_b_zmML#`*zW6ApEC_8~21yoZ9U7*}x~~xC z[[ivÛg.te 2R.ӝl;KYI;l.<`?[sL5*86%>zbBO@) cGܹP=ӎfNeM51D|Y(A+Degp7C@8s-r{ꔂ,z\5) u82@-SYo vZ)6JЇWG[v.uvO{ nj;…~árh4m^~MHgw)ՎJiZC^6(Nz JivDhf2NcI!3*uDӼM VoWdOЙ:hPas a 蔾<}Zbh|zx\ APoo~|ĨWK12\}&C؇à4dX;C:|?c' e&'ˏ/~P endstream endobj 802 0 obj << /Length 1824 /Filter /FlateDecode >> stream xڽXYF ~dtKaf-zdAƶYr%9חY;ss#cn np/\]f%MIdeLM%xYFhmÒ3ܰZ|B#F ) .sVq+zYe3?޲YZΛ4/lCnuY4Ӕ-e5wSԍF!fSV *;/gu^'47ps,syO$vh>NC 2N\ 6a8`!PУ^)CVժP_m\Vf۸QY^RV,v, ("# >pnHY#+Q}fq- ƪ-TEmuM:t .xqa[ a NVY:^I}mᵆ|bCV90w¾S18i ~2{jFА*1쎚BW.Bj..DHoo~}FJujpf<^nSE FM\)_8Z;.*Vm14 HT@bzI96|:v.bN6gC_Xl!p6@!w,W̪,{;b/h(z'lTx`"fz Ro- Q9+ K~3`iw9:]Ȯ 듳JZT=}M˙YgaO&u׌YcCaھ2J2n/0c+29Q7NM\ԁ,I4#JfvDM83L282 rNqBj€B_d0IDPXy{ U40Jf36qL &bvܸ^S: ÑJ02YMľMWH]uT$_?oPʆ@~#BR+V %C`pbK[)Cv$Fw߹ZV| 3U^ +&8TwpLR|Axy>3nޔ&J|s7Aݐ endstream endobj 811 0 obj << /Length 2020 /Filter /FlateDecode >> stream xX6PgqEԇ&meIqH h[$"wdɑS_p8<8\woZ?: f)I#/3YL)tg,QQ8'm?:L8̵Z7:bW\sC]҄D9CB3VAP0bV8 ϝ;ȹBw^Wϥ**.́e'~y*֞ `qP OE 9_pTHU;`P˥2M)*k9SZ- 7d8If-g1 X] A=G^o& wSƢe {Q=eD4[;kL|P8M?煒fz93nj: oh&}Xؽ2Ӳ:÷(z˳΂J"H5$}!܁G a泳3@ 2$uj6 XHb%v[Fʮ0Ȕ/K)0SoFiǥH@akš19[[:=!/ 냖hwf;ɺ'D4ԝ3ӺFEơGCw'V5%B^ Z6<+0xq!IMCq5K hsb~Yb)IB1.'DŮx &Ins,r )V) JDnkcU9~@(5[-˦>L؜D]L~'4z )!nr]zMTi;ЍTѳFYwk_8J|\q@~?O2([e`ISuC)=JRrϏ&`' D$q׍<޶"Ӈqe/n):عi{^b̃u/3n[h1eOi?.w.nu]DP3<۫ ;v",G 84b"ݿA$uaPwZ^F?pO 5

Oo\M؜cRLR"mK%Z+/n`R'p^H@Ůb^Β&WW.}w)p8ޟ}ggW 칞vH̓^LW)RfimQ?FXL^kI*'TRKۃFNԿ&8a0wNޅcIҌ5PdZL9m UH[+\`iKgpw\6Gcw˥3y0pvp d3g<҆qK.-ݪEwGn)W,.w¾{ )-=FzԧYc!MLL-f5RR?#7N:-=Ib$5|O̠oob%!Γ34Zk>௞ skua^"_9'j1~x6fcTfi'jն&"J#4\8k㗨v=BUj 4ٖO E> rag?.8aHGZbN*|i U$sR/NI>k CyDUz!ǂmwdq-=ʭ7-tVЋwxIt ä<~&IO Q Mi@mo4%E^|9Ԏ +_6OnhYmyQLΏ ߔyaU1zehk_Sr@.q-a2 Jv# i+8a  _MZ5=¸^CE# 7@EPg :% Lz7̍hNfQ.I%(w7PnۏnJpY*07 9΂0r0Kh7 lGF5m yE0$ہ;WR:@ #]nfoXAcmcV 9Y?۲=wN {$n. CZoȀzeViĂBRnࣂ+8N:1@Hb B@@H`p, @mewg1_$"bPA $n!NjkY^mF5 ?zxJp¤~CRgMxCJDDw Lj7}BqG-7lK+Kf*@Z62ϟ`>uqaӉigѯClM-;p[w(b] dH{Qw2$(pDpf^e)xƨ^+<j± Ndz(c'm' ilE$|o N>djk'>NpɷP:Fx=m*2L@ǂ*2 ۠HہO.v%z(K4Ƈ\+Hc\L>딪RI~YpBU& a%8aH\!jSRW?#ao!8aίR>y*+Ħç2GLx<?9x~7$vc?si~Dq,>(/ qvJV|׵Gi\Yl;fȽP׋e..0;g/<~/)s)r 2W NEjg׎+QX (xF갭vYDW=2Vf]p8̳ CL=N*2<w e?q-gFgMMm\wJfwvb]lժ(/R4} =w8tzIB ƔrڐPmɑ)eABf\Vpj%WT>M%9*R Uû%c9p1%qW Nү:/M!uhwh faMOH5חBcπc8f*' 2v#JI< x+q+Xi#fZw6GoFBc*sY9!~iz/ VLw <%57o >@S&yH)9h5240]Bg_*8,w Nek NZ l ェuY'PQ%WKVr7e28GQ*4>qۃ/l`R%Fo)nnq 3]RVbt?cתUWAK8 W49I- >q{aXRzU=?:T[μhUѪf(V[`8C_C8+kz D*4Ы ,O"V8HNp $JR7 N$I|qMw N$nʡ CA>cө"MAX>,Mm:'UPێ+vMp TH [Cv67.l졢>Nzp\uI;練Cj\kEU:S$ $VZ@mGbmwT\qԶ#5׶[JJ,ʽxSpBeVjQĭ^'sW" {-옰1&H|w|D;RągJດӃWM/p*yA m$n=Sm$Vm&@h#]Cn'Dc,yr,(yBj/y]ͧP8."[Cpɺ p$(IE9&Hl0GA&QՉƘ%.8 7Rc%P}m,ȑy R:er͡ґfAߑ[?{ey7 'CRS=T~M.j OEG_idU_][vt)UOUe9VF+7PFhI%? Q '9$q~Ip)\a,S~4/.EO+8aH[.pJ@*"#Q4}xY3+_| F`x2PF .ׁ-Q4$E.AQ8y V?ˑ$']19|1$r YyrfWw+{b 79.i|{BFMy:πF”#x $4>k) ׁ?AQ??i]`ǝwȭyRTy8,8a qA CzDQ4R!#T$5=Lyc#WJd b0s(%* 0C60 3*u>!"qzR ;A5ĭ0I#P䑰>1cɡ֜v]{S塽ze̠LY|nA="x_ֺƞzLmuNeQjͮZ}kj$i#|'$)/S! N26;@QgC;cB,56te2U$%,y] DhUr4+8s4.Ѹr碅qjX.(Bb*d1c,fʗQ+T ƢBVAcHQwHǐrXÒ}/65TWR_tWLTuxW0cU2q/dxz93^20' Qyia;LFmrMyJ<ͺ+jMZ*BA!/cOY)=Z~ S#O:G3+F{ W1_jhl/n._ؼJ?Y'0DpBEF2&\0f .yxw6črw@拏O&n=8$gNpE6vy^ j$n=p)MLMrv]SWcl\pH>&8aR CL0Fc"ez1B +7vy`ĭ c X0X1Hb @@1p7MpqԤ+ 9L.'eA\. $np:sAlp r FQw\Uj /MJ8[O|D<;?3 ec$ `<% TS="1]Hc)B $5VgѼrLB<`*C;Hz-)Uv\en TIEp]K3zwC]ܕJ3_ =[0}%uHL@ŪPBUFʕ˥w)p!M;fZ  P՘iS?!5r9x\˿̂$9<˿?m^m]vJxߎFW%wp#r뵖۬6?0{÷Ql%\~c,|P̭L.άM/0)x&j';zhًj,`5vOV6Oi 5xyOfIXӶ6⺖׵N ~NUZI!|Zuˀ0q%s&q2Tx%U*I5 NM~z Cڤ ѩXQvqm\1mjٮ-8Q1/+=51O^ A`z!\e%Oax1űX<|ih_"*.=Ke$OM zf͡-tYh@˖`I=X4WQv:}N50sSS͹߫Dm(CG'48Sr:V^$g}-< ?QfW7@'1 q~:h1R3J. 9'e;,~ \zY$~^|[R̲*~U~6PE交x,#/"r}Hʬ"Q)/8a6.<z$vvo?i)eKg^n T 1=SN ּ`l%2vBy 0;ۂ&e^} Yq$8y~@c$c7Pe>)Q +Sg¿`]8^8I~]p8LE7' i+2*IIwǴ't3;A)* %:0ב0vh4 zmc;\>pVyffrܶ9VTJ"4;6? 8aG';>22 9aǁ_Cnަ$令:oa1L uXp;rΫnK8{D.srעع_N-My=Ùj~}}X+TJd]-fI1T,ڧ7.8GEfw>rQSK:G7Y*e?.8,a'"?tЄBkV$I^˦=fG5?6Zr)-P&O/4@Y1ƏȉMu4['N I!8G55BkUsW@yb6py~CyR9o N=iSQ*҂9am~Io  sցk%89p1qe^ı:˭6"QGCN"PEWæDw-0XcxǴ[̒Ny0Pp-˺c}~%VG-f4)T\;1](|e.:EZ>=I^nh`ph*-*QOf=6xI]:gߘ_ZimIw]ૅi)i3.ܗjoGtڮ,I**yoGq协dls%4lIc## HZ3-#Yv#rm$}6nncol_3-iF{pm~?kFzU{uMM+ou_~ioUm@mZT +8axMpTpB]# HN=oUXV Vl"tH'L&9~FSxfŻ'H N>.=!})M+T:'V4 uW@vu!5NaAh)Tv mL5-_UC0"Cʬ&InF| qP&LrUtO_$86 6,Go0r-Ց[cG]aMHl;]_UC]tY<]pnz/)uzz:RLj̹{W ^ZplUrxQ;7 kxf9FJ],G&$6+GAgrfZ@>oM%[ ݓtջ1iO[%ZC7M~ ʲU;Zq!k\Pa@3|S2uS: zE{q;oN$pB\ǷR%uRq8vrX|+@y |YI$~y 'i5^SP-.wF< aL Lww:+ܔ;E70`fS8 *߼!]IKj'gÇxzSu:L?tC>k3|ޫ?Yw+~t-F4x/8#xJP}+T5% k=>w-q`M{:kjTD7lnR-0-G ISWEcbR?=f(W::*3 GT4g5j'O>U5 GIHk< h?I! k# 6yT 12X(-܋r%<+xEhK9VX_N}sNڔW6sօz3Y^[KyeH55V_yi+aXC][PTxkq歳^bZ#i= Kz-BX$f;+kbjX Y @9 Q0x,'X'}k9hYB JPc&P60xR vkH*j'Fֳia756%6ԳG|p֞mjT J]Rh,˹ Yp mQI-5 jԦQDY>G4*)|:(F%uBFբgSMm%,kf5/rsoԳÞx aF%;RMF%0iTz>P4R!t0x a!}nOcCHWpBMM! Nv'}!&&e5x-%g~.%hѳ)ᾶ 5p?ޚ9܏[Y[>BX$>+H9TӖHy5Lx)lRﬡ[J q]/%}H0K $~s RRQ@n UElBK K|"elcglPRrB[ߚJz)n6q)_YCK 򷘒"[J q;{S]NR0:Id$:WT |?Rƪ O*Nq\% H5SW˃#W;_x~Ƒ.bM ȹfhq<gd|k@aRI'L #Cb*ҡ8 8a<*)r1զImYp "F*9>?[1ZwTRζqȔ֛h YwF%j Ͻ*Ȇ[ږ<oU4 xX> #Zz~,ݤZ.l^4<4IuWJUorݥ/R]/yR%/v?6 ?Ymg_ No0=7F=9oWtyBpoP[t& Ӝ-JEtq}4kL+ڮSd-47UM o.%΋;LְImZ$YZ?L9ꃢ r\!8befԗZA8RPSj<W|͗j$TC{OHH5 j$H +Ebݣ__JzΔ7gTg0ݴ/pM\PSlĝPpfXO2 I5m虸&hR:qEϦZJX:g׸bj: OLPRrBۣ[O~⚤ntM\+¦:g_$@t.xj{217:O7 HNUF-u 'sWv*\@xX|cH5+EG`}6I=v cX@B\J%@6q_TÄHjؓjѳ@ gG! uAMtϮq<-1u.>+#G`}IN5moqe 0w10B]L$|OwPӾPT;7e^3"az)[sc7hЧKi*1ayٱ;J>t^ c3%}*^ާ x1cۙ38"}/}sźե2qQC[9Y3XdM7xGaA 7&N]i2o K]$,rŸ^k)p&Tb=6##@04&p$įa1=)`"\GJÝVxPk41 uq$n8"ZH(p}^%,1RWWr޵5Sw{IzR[IZW@Ms;?VQ2Zt[H)ol5 ozFgvx+ml]2,0 t{aܩ%kw[?T ;>m3UZ398n Vhf]⢵ 4Żż*'hWn~A9xJj?  _8ڤgI@}רjS@t)iӛ3+ީ!Z;|!Z:I5lQ:R:)m6qXbwߝ}'}.N+[9{bv~G: =2V/??dEWٚe64K׀?># /~"ɘ'+;.B+xڀ!'XoUPAZ#8a 3E]]vbޗ."f([ML5 tv+Vuoz9*hRག&chx N q?U**9Lj'{/FGIgBz?7"U֦F GV_jz QezpT9ns?E*k9O/s@]F\c ߵL"f/T&TF~i=F'E8'Gۍbtw 8at뷀(8aDC+cl;LN>9nwBR+'Isf'NEfkfA41\N6vMT H9B'F$pɷ'l {_Rpے?~Wpˆm)&Y='lzO?0 gF4Z01YG,@6 ަ(m%cof(Y Uslfi[(&sCݡ-HۧPSȲ5 | 9 #֠yfNؐY;YۂJ›OP@ݔ!E~ w Fp¨u&P=*hA7 ޚ= bEs>Mm+٤dOH&X9~bTtV8lpN:]݉iR8NAgy*zʦW$@ͷHڴwK W0ߦO-:,-b5gzfzyA[Yo3= 7{6θq,X%7vetd +$ujj f J[uk\u[/5kq5g.I6PS|"PpQr#gt&5Na_؛tcH0b9%]X NZ'g;cܗPg쳮o\zկW/蓹s!SѻoM1Xg: }FW68D-73o-M*bmY|7^׼B_iit+-Ns~bZYg% 0g`z9~p Ө}uXU~y<1p[Czߪ?GWz4s$4jcp4u]2:x}WCUEq=Cu}qcq|ͤ}>ʥn9RoV4zXO% *B<էؔ'OԤ5M`oN`o1oR~鹙| vSٲE.:v^|UUG~&cjg8m*V)#ӂ]/>\<ŗ1#'Tx_h OʈBj>P; iϺRND.& kج)>.Z-s_V6_vwm{1T? 8!`Tj$2Eg("}qUcI7{B6syQeqG蒙>z~ Y*mVѐ)rp|$Ђ] ܼz'|2GxW+8'o}{2_aؔ U^| ÆI}W2/xV2$cOɒ"~s4?&[WmtDϪd'l&ڜ{?C26)1͊_b.V[M$\J|4jn]JUI`-폯S}80/8a-[ȶW^Ԙo-)ebm} _tق4w'{FTlM:]W,)U_j 9Ҋ"YR"^,V諚OTgL4c6eO ? |H!4BC4^ZXѽt/%8a~3?0mU?~[pBMY]5+oUAN>sd3?\D%IRu%!mځ'LRKڀ'D)=d3щ '|g3ߪ~xsPpY\yώZ:I5lvϣt>tR S$2մ$~U 'QD`f>/Q_3qSjZ=ӜsUeO)-Mȍ)I:ՂF4YtV p~_c6lbFWPs߶f΍Ye4\-\G0GOEh}AXcz8lbGWPs\uYt1k[Uy6J#? ٿŌz-p1݊z #o|vcRM*H4@M>91|NyV}V2 (gW="O0BVpˆ# y"%؏yJA8#@ijGˍdm}/.7xE rAH)WQ?hSan$W6Kmp@Yi߬ ^7WIClaxwT_E͹>v0.uz'˝gCI99:.[اNLiк29U|1n ڑq8Os~xbðPN>. Ήrv^4t\ǢI).kJUKu%2 E%48!J(t7Ekj)ղtE\"6v5I7|MkWuuT)(m2ob(J /jMͨbQgm q2tZR$`(GWG&WIR} Ju}5gCeQM=̂5Ys'aC ^zl_32 7M _xHqţOhSCgmJIZHLqKR뫚O_O#G]3|+ σg")X[//Tu)9m\E[g+c w/ik*{&-6FT KF([IW<ڜj*%N匐g(ũQCSգShxjЩ(uqj?8RIUK/քRI"ۀW_ok 69JR! ;&N΀$c2vj7DZЛ%}NM1iU`'a/O#WG~π?idͤ'T8@Mfgb :++ꨥCjTfsΟk)T$mL5$_UC͇%:F:d{7Re pqn.tR Qy@MjGE*Aρ?YS;3~*։W F* Xp+CzREo-nXu{c*3j\]gڠilM*ܺhVh(uFS#zF'SouTJ bO}nyY0" )cC-M[} Qc߄+-juW:CUr8Zv8,sh*Ɲn|RꩪOO1&LЕyFmJ4Szړ%-/^nRO8qyŵzԨۓUC%ۇjɑE+} a{OM3Uq7brn>2w pYw-}Q hj Tw Oeu=z1cJ)o_*Ų(ʫIXAnq2xf5igRmKeh`mwm6*!yl̋)Y&)FU^2nǵsΔx=^[^%+XR|]sf_~4xiRxKH-*GйJM))"1],=tRfaMUrJ-vfna6=Aou=%ςu}A-}!PQ\OߪE }V}oXI=Bߪj?hзK;-cϳi۟<~vZH bfq]]OVL, ˎC49M3N4իN/sVgfЪ}2d˿x>GяllEΗQl?غNp¤èjui='~`.# )=~guSCxE,2]šQ/oLhdvu`1W`!KNRu`Q~B#|l Vmn7}E €dٲv`x*2xx{M͍ڙ ,RP:SfNx/'͌Z(u"dtGUxFucD TixA]UY 5|5E^5wpx{J -T8-8&{޹K+8a2'8aD{ r&E\ sܙN,y?ӂjdmv o$3o |ƤUhZe RUwIyhka7s"bK/VZg=I;1~e+lChܙ:Ib ٲx= 9dȗ8C |ȆfNLd{>3&t+^=f%d8-\2l3 TVI~I9 5&>@#6o_ZfM? L/QD]oo&HWQH|k GMJ5fT€ ebk`57'!}\d;_Yu6<PDjQԎjFN{rWzSN/|w_E{ ~vj4{i6Y0%ѴڵKīkZ/&ֽQ;9 ]+87s3JgmHf. ^ NwBNf (YQT/E/6ʆѤ΅,x6뵜lvoٞH~%$>'L8ިFx46Uwat)abꥁk彈?asUi%~$6K5j.xF #V]DJqr|#/.DpQZgً)\t`uQPP2LۥCd;^V NTnjy:=E+ 2zoas7Q!j)Q:,To˵Zq-q,N[@Tn<·ĭn\Ccb*l7YG㻃XòL=Ɇ|uVN=Ku6}`b §_<|mCi}t+SSu.KEH1l M ?5w0-x*zv6&U0I7C>d{TL2FN$Y& #4o'9#{kC b~6=qFL)U MYf.%e)ԇ\c*nU_~Ep$jg(8a9 3rן=&u/j2][ǖ_ܿ[pˆkM)^FGcػsIh'1&a ] I$qk tLͪ69 xjHۄq\+8aSlr: dd}J60 \N(5 0])խ ډMlEiT)o6&Ca["652zM.ne{26!8aSlr%p\Zղ8*xKG`]}D?f7N$;z[-J6Mr#p\p¦$ ޒhs)d?0 XMr5I\;ӂjt(M0r_ex-JyV N-~_p3_ NѺI̗.KN_r,&0ZSW5k#1kodc,-HpF\<&:T:Ĥ* ͊Zr،׉]'ztʺˮ;pj+u3fM@Z胹 0x4)/{zzfff2a^ P*n#K o0鮇V̊? :2TS^0Z5 nJq@WZŲ6.M[,SSV6]fėBEԮLl`Te;cQ]W[qUNV I+rFz)L*: |Bfb=S&>%O_+8;;UP NN!@o0=vJgWiҁ;6yٞlo&;חΰ^?3 `c\-@N[xPp¤}Q 'i5:@M97uV+r֌qpF}pF}ĵ&][kmI9Zz7l+/ Vkʜ?>\Mi;u?y'LFSjv?ہ0nC;w N:TjXlYg{nژ8+|? j^@G7'q 'i5V@M纅gߔS,{tc[ƸR.qXv]OYHUx-ZJg불Q'g[,'7:~zF,2ܔ |XΫx7|DT Q 5ٯe@AW0xv6$1kWs6vwnPjZO!k 8 }={ތ+:} Ӑ)ڵrĽ- I0xVck4ocf9xic/r5Sv*15Wsw;n3:|RxSt ,p۩+j(&?N,+.ȻPNoC9Mpk_%vcrf[mSq{,v N"<u"q94v)($S=hPa`L6qHQزRp¸Į0iAW0xVDQ"G5w.;<4(F?H2zthԝ2KY a^gvik31"MJ=gS| TsC_.8a]|XpXDBBpBMfl^*ObHDFp Cb}C޸6O)`=[b빝L28r{~ׂm9CIw$oj0nB M 3e=R/Z0=}$) W{BΉNtM_IZ53Py 9d~ڸ"Xt%۵h:s6Dh @jkb&ByJޗ$| %E; HISm)8$>-B:5oI@zVF^|6aqCww@Rz;ÂjMבv 0%] N!q7?Ik!8aNI:i'ۡW?.8a=9D 'i5Ά TxeH,G.)xpۥShd줩3LaN(c{JF~`ѯYF{xoW[S-t<GlBh<6g/j"qF0Y|&mSg)*̵֌"ݿxU(ep*l QT & TCkϚ޶)ZݨhumZ;Dc]$V? 'ς8~ Rz?nM9">/L/_[[S[$UwӡpA(Dߠt{\"qC&ݑ\q+is}^ |Rp¸;UF4lj}4?ݟd]?Ԃ^ |7q^S7kÃݽ}xwve7]BiiY284pi7s..JFZo m w#ڭ\OjtR5yS#9SH#MPS_vf,ר mh"$NLukͻo!qk#k{1c /bqUk`lw fhl<:s[WrG pt8|Mco*\E& NxG>!ƣ@KHwz$ )8%e^|$f}@lvppoxp28),ۂ% H{\mQ0ZGO}7Py+qG2| ,3 sZ6sjSKPЇX0h{p2btmOeqB8 q}A=eDj>Z=6pL$ pQ1O?)8.ǔm8U> vL$S/N1txnP~"OWG-^vi/HݿHm8aܮ)Ķ3 $8Pk*2״Y m |эS4y6ehͻDΆgO`c*9Yrh< VeV f#pq`wvP>k ~5J"^4l$nlĺACǏ D7# D e6ڐn4 Ѧ+ٵ+|WA|e^d5`6%mKx;WD&H;0>)Zqթ7vߠpsuP;l#qQpB-a[&}n3k6Qo)Ҹmz|2Q0i^Yf1i,x~%o+8𲄓xIm-Фؖ2{U3j j >"b7 )ծ#[f`0 *\c2EM_{sp ӟ>CmIIy9Lofqeŵm?7E[7iyg/xfQIN/qWvJ% 92n,ǻt閳/O8rmϩxRe:Ӑ0#iHWK|^ *T< {&Ÿ dwRy%𭂫]]:5Cýd7nDP-޲gd־Lof۞${?0nDI$5 ؊z:M9Eh8_bvS#;Ϳל7n n&iQH!766x;5mNn5K|D7DAؚ[3*'Y8a^z^8{);7eb77K> ?s 5y]_3gr;=KvmwHb -7c;oa_s5un*3gܔ?nV( .XشZ͢pe^mhdߡnَ %/Y#qqzIG0|q;݂kDE8Oa;{Y #O-S,jUjA~Np=lvףD׍O5?旁?\-m!qTp@;`i&s?W[IwH6J_ U q}5]f~\[>?Llٰ)dMƮz.+X8-Urĭ8+60:)׵D,\.L+kptCى:SkCPCV4k K"hY.΁|EJR0:} rS9\tۅW'e֋tTz)!1k:D rڗ7!##kDW6#=Jp{ 1 W7йÍI.8&aV:#=qc$ NtN^IZ`j&/sykۭJ`Oq5, ƌ||_X3U =:D$xƒxWH $!rG/90;z>J^U)}wfpn_ IW[wOKulw@_&+fH&Z/fHܻ_;F 'i5܌ns/lW9S%n,_|M:oktHޞo9\RxiB/hk(z.!ݦ5qGWCW!q!\1ed]y )ʹ8i !H !}^ |j;gsmjS/;Loܔ_ eݣvo6%}ׇ&|}Ķ ތHעj5v3wB;GT[_ooX|61ݼ}Т&sESfiҚ{9y4-oyWa?!ЦT9 i$^y'=7S'l~Zp ] k@u-K/ vSΕ"#NjF*3 5Yn: f?nntM:k"-7clf7Pkzrkُ)8dp"w[ #B"1f<$2QI;Oy: ('S$V۵C F$U =%7"?$vfYD0xvF$O!'@HOPpBMu z$ '!?I{Oj@M!]k7'S\ש[(n ͿWXvuy;!'1'm`uU-V[`l!kk)at7khqk)奛((B}qz3c+=xmQJE )]ʻ1OWܻ%_5 'Ӂ~6_+H'sT;d{%S xq;Q)Hp¤O0xVc ~],F:5=x>y0kt?Lyϧ  >^?GĩF<3l6-ܣ0z4PJΣn]k,grFpJγCp=O N6}g\ b'TMRIjMڬdLiHӁ'۩ N7!0xVXɩIN͚9q+Ŧ!vˮ3;5]A * HB+q)){v% F(;5=;.Ho\k~|rn;7 NdegIw%8a~ĽnO5?=;h#}{\u2;.Yq1zꎋ $} l9Ap¸}Ğ(8aNFH 8aΆ?|HpcSg҆yj| {9𕂫U҅Y8I'oPm.ezLdIR vtHϐ!x3 o0xVc j3b~feܳ=s:Sn h ] ]iއҔ9Z1JoQ1KM=Ub:>Jgg-A{BN-dXe;om< e'ka:lt4wFmn2es|(fѣ^lZfڣGpatȣN䵶%mH*bA%PD-y UVs{./~&r[\%xJiT,ENvv6fr  N#VgYIhrS3{?n*KjK3f 3OCg) }G^4ݜg[6ڜ_p-ӧ7ARYZ  TX}̤7t 8J'(f %?,dhk3GC1(o`` 3a2|661{v1ӿ!+3-[ %No q(-ŸJ$~} dں՘͋kp]9GRn:ؽɮ'j+:Y[tsܨIӀxx=!im'1"Q( B.gnJ |A-{4aҙ5h%Sjm~fCv'<V(뀴gڔ>jѪmSfer9 J,6MDE7HWO*ыSb>^mB:n B(Ayy8FVI;7Ng0u*~)'ѫ )1mLoڟi@[6.* 00=Q~)/@pLo7e2h"LJH I$DP*&$!5lV)Xi@ F2dgjw]g籱\9sݸ":Pv-ϣdA]xax-0nB N{!/PYZ |@pSGr |Pp+ }=?4?,.yZ|?ô0(!qIw$0xVvXü@%炫.%y,v'?[M:@z@M0nWEb''' '0xVS5"sUL_$V! Q:4=|+8'㔘O8O$fM^.6FKt;) 59HEjnd9$|i/pA '&'琸"bTlEݽW~y+Y 5y t;ǀ%C p(Z'?a$F jr;0s2w&νs*0WbxU\` .G8P.8. v>}qb;3 !eiqRptSrP @6֝n!/;u j? ILG^MٔdH/} r6]J*8&QOoo?q``xwGoow"+ך,w"mkH.HOjas&4Ji|W\zhZ:Vfn9)(^lT[8'4tԙgLWv6)y3w4-$npVp [M} ?<$X}ҿQA{ No!q/'8adB_#4jY[-C{ntoƌ/UHէ\-^*$NtwN?[IZ j*72 seƸ^l;m;(4% =wΟq /^whK,Dis| OmO"' MIƐsPvnxD*$W .#eEp2}=}W5/仁_\븳!qo~Ep N鎝a 'i5|ɿ2K-w]c5tcS(%O|1Z)?ͯ[/8lܒ<LPF⬓3<-إ ͉-%6LL연[lGnYPNoֲ:$䣡6z'grW ?0n'Ej{":)5'dq;) wWP8j?]?( O'd[{<~AƾNֹ v˦&^`i(ޗsY$Vp¤}?Ӱ:Pzmk`{FӴkNܱmܐD%V`oJtɧvn{F.[aQ kWԩSjna9<'V~'͠PGgcwb.͉R4~ Iծ֒P$ W[|H\q~i _3.DדnzolƅԵWJǸ]2YKHgQ<֖VmcH܍@;^ |Z7f5pB$[װ1K &QmKs(O.Ľ> #ZxqU  j2Lg {7l(;<"m?j#;9C>^َcؼ:a)^G H|k GDUk<KE!KaiZeזJ\-]OF3 zn~+j d9'o5@T dKy$P RJ9hu]UEW*(xITUznPS)_^+8a*{~5xF[}S~0PVpH/"994;Чj}yM|vi%kE$ Vpˆb"Ә(JVrHb ƄkQaq-P0G1{*x֡)X8|s*c]w=|輾Ç{}ƘoSm4}+>{˶= : ʽ}+T5jO=BzO3ԨۯzKrMRnmmPu ISWEcbR?LgR\j\UOKVaO&Z݉l^hu!/:Vtcj3H\;LG?"qm'X1NxE&\ t3شYXe<1M7oiK3%ˢ8++ϗRb\s✩fh!zfhA7f7AH+B$+3>hIwwEV.` 5[ < sӠ߃O_i#A'<?%k#3I?[l ;oNSj!K홴D:O.)8a^T{"y;[To5p-~GghCC-]E5ClK)sJ߯}96{1Wr|]5'7oSiF"MY7/%Wܝ]ޏ{PXi9$ O|M4SoIA\F}#&ruEEԸםsT؇}_ lR>t؂F, }O>$!H A " ]C6ȇ JA>[Aʴ[ ZY[QM_kܢlVwj\|maԏemaAѩTX Wp$*+Cb+6Y0&l$ :iu&qM]EDº4шf<܂MMڥrŗ\NIl^ (B_-锂nwtF2 )k\hNI\T|Fĭ$4Z7u,jD'LNIԉӁ=y1I^S iKp$%'L^l^-8az1xdgmJ=xlgYf!qCptz]iO[kґm{^G[X,?wz& S xzf1N/k1]xEL[-Ys|Rk]2KBWᅔ9/^ȵ3gmޱi 5s`Ӛ8ct57¯_ xx_g kd7eM\EZ7B95P. ̉\AU~NlN&&׋t9Z-#ތ#|E)@h-jyV؅B] kj{U9{q>i]*y˝P)mxB}Qͨpnn(_mߎ7#?>Moө;jj =ީtk׳=S2W vBk7ܜ(\#~%_?ލ%Nj7~zGk8^ x^hJx4U0G#px^r_c1hV˦[fşrܴ2] ށp3assCfڎnvĆ.&ބ_fö<UGrblm(f[jT/ڑ~ o;ުG(G)Nߙ@1Wd#ev` K,Yv;oz~k-cMY[ZCefYZGGjMNhs>v|.1*t6u|gSf뀨6]~@'hG(ގ0ڵ#O/*u PiSFO.4&_Ԅz{֋.q} D%Ck-AlsiZ|^|z7Y*'=  tlH,讱˞5KzJJy)L6mIJ'°䩼;uf{{FPnޘ6po_~`_?6{CO{]}XYWwo?mfAƁQRvG/no}Go% oZSshkۿx~A&Y,k_|Skk~IK"% _Sܖ"^;Wx/+\.[ tض7Qa9ex˚3\o o,+Wlx_ϖ.߷w<.[ЈrmrҌ͗m^i z{Fwݔ P|aS-c%-cu`A^j]N M بhyn`nt;ßuu-3=|)sgc͔,T.Nxv=Ƿt'*v^xo34ّwr6E‘O%ҁ/%6.c:c{"a~lsso<-~al)g0mdzz㥗?s``Cpc$EuO)4}Ο:|A ^^}+7Vp<'Ɔk}wHUKi6'w}#`KrNdq{i-Y5|%CU)- vwdsDU-Ŵ!l !~Ua#F"'"hlR^RՙzKjޘsM\i;7@8xڨ3Z=YN7##.5hUTCVWVѮE^̕,ISfJ]6&7RHb}Y܎O@%<15烟8oͤ4x TͥךM Jp)]m9h'eQߊڪj[:,ߢѕq<Z4NȅI.d=-'FPEN#ZF6/ VDb/L->VD \L7#`<qɖ]$ UcmfC&EVj#L), 9x# ßq!O|bjbq7a{p:隴s_Z$XYRpits:5U[H~A4SфNM9_T4SӜNE:UksR ~ qX3'ID8-? %!ģX VGUgmJLb'b_D ε*\JS]2O(o='|xbJuHT{[H^<`lh{{۷ ĶH|$߫!3G&5ځ+qY(Eǵtu<"N,O^~N%ӐB;{Ӑˁ{Fd'ِ^$/ ~k2&~[d(ux10gftdbe cYLnN9tA:߁&0iLI))3B6VЬxc\aMm~L1)l [OkN-qcNjD'UMREjt+49cV^A 5 #q6 & HB<޾}zZkQ6i9h@Qlkcɱ"[Fi ΅Y,5(5 HSmnυ9ME2Jff%;.TtªlbOb7#[A UO+EIczzvr8/vំ< 6 [yh'G?js U{BglS::T LP"MeיmGƂ[DdQEbH\AFw[vfD%e们EbS a gRg%0AN~rsޝhS TN5(VP`},U{z=jzʔZVGM&1jGđI!C+ϷY7\y[֪g؀鸅+ cKs*TyaM[%ZM4z'KPEK_Ϣ]jؓķ0ZyLTu(YB<K4{&&MV_nܔ?nV,٢n؉082Sg/ǭueסN*(i7o8]h w-p\iibn RPh9A򙙙@11mj,5 [h̊?E?dfRMzI|kuˣӓuTFi_qƍ7ە19|%ǧ)u,,f#̂-ĄzKX7ɰ: yxh΂+EOCjqnI \qP/K{)>[J!Ft? 'hO7?se{7f~IJ> 45nr}%3I޻φ?v}rRޅ܇P7M5ÒF󰫣ӗT>uKy?LB}K扝~|p N? Bx*}wr;$ xx/_GZQ8DqJA4RZq.;q0iRj˩F-Qn3 +ۓYMWwNLEMYN 4"_'voW>ѐUtx1POVcZA;Ԋdj<40M)O>sS7ɏ3KsOɆz7ƀU3Q7@8a|RL %$?3osm^E^ \ VUx.Rz~ĵ;;"~Z 01Ĭn8CK-[:)|z뵕1ϲ̂ԑ܇v1qK1$5xNmB<eyW6\/Nw83il*dF%-\7}u:U\ksH~8#%k2m9<#'z3Of<7)~/Bx-چzlTMv:]/Wre54Kg.sNv͠i#ry^- osUfPeGȲuvu@ss XWʕe~u+\!b[Y_%x{1FE\}m52(O|kjrwNlӊJkZGjpҔ7Oފ!˅/J܊!רъ'7PdȏͶz}EH'zЪ|USVRU WPp%J RF *UzRHWAj%_T"QAEi%bgYtAǨe7W]v[^EgmXv{ʞeWW1 kZto aSbJYRRbpU*MX [3[ou0uZےQH !ģV :RՃ#J}ooQɉggm⏞ sVMפosI_, f؅|vP6߷q"?41у-=E 2AIsT%g6h(+ٟ ި$ ͘G{K ĨuT[64sf*-CyՖF^|mW\K3^ftgǼ;.6?Z=at[:2g]] LG>/enX\mOES.ﱼ =u;G=Q)ط;.6GǛ|!ّwr6tpPgswu!1h/e߰i&G͖rL :^zI3^oy}x[u͓<=ֱ>=L9FҁP S79nyO _+'i+.gI=a/A-Rn$J/]lth,]5WH4VmWds8ԂP0A ~\a.ἴ4ыdY.++8aR'OW-ԕlLe7OA1c}$,,0j4[x6r@j~Q hH C_x0@m*Iz= PJ]$ W-ß^0 Rt庎t&)f Ƒ~bzxXp1ƀANWNOGh! )i0<~PE 5{M$$kFɲ0 aC<LpC;#py0 |&4!qm&wHB'ΩFso<8|ÉԜTԒyZI~}5f,8ɛr*<-fy)I Rxں6:.=H" ^{IwDnҫ$zJ\Dڀ>|D+!ē|Pctl( OM]Saz:]]A߱KӖYխ^4ju=h볖ri{?քN?|;6IwZ$IZ+3:cDځR vGn\9JijإX)zSSMH (tM$ +cl3Kِ J*I׊B5Y&|~KΧV NZk o9%K׫ {>wH_O=颹pk,X ?^ߛѡ)ǵ:%u}L7EW+λ3ךd!Z5aTJI4BObE? -ԠžWRd[Jsr-tGIWO-%tY-Ŕo)guKKy1ݔ 695K3p'@!ē|k8-x[#D 830ܳ7J*I*d'ifJN2Ɗge™~73Q /OM,Tm M,Tbi LJB$fpg{Nɵ+-Gk$!ē|8X[F+g>);+9 7Es*<Ȫ@#DE6߂F!|;ۓoA$!ē| :X[RZAvTM%TK7]jU'7tF4Yr\+O%ᐂVcj2m'VNU"_ckm0UI^|ͤZvZǃ'"qm&'C'NcOSZ;PerƸX>;fSV z 3.Qk\moF-+14y0̂]xs=~srb/HR..+̋ҋ3+])kw$ !ē|GznJtu\qˇr૕w2nە_trfx5m>_Vx;#6Vu j]|5E]o\3z-i,RGƤsf'lT||ƻ> )ۛ3ߪPF_~x?^'q.F_e ۻ6?w!!Kc$.RЭ*uӊy:=I`Km!~Xfj3SvnjNQ`'\:Kz\N\mnwlF R+ףwtg?`T툵?>gmwU BCb-TN>PI> e*E|*H/E_Xix-c<5&4hyaQdH6ŗ)atLVf2#^ೂ6Whシ(:y #7 >OTt1NV;STkF;Bp,UBjaA+ cXe#ǚHaǝBQc(L?ȓ2;9ߺC"Z6WAvQm`sgwŐ2\YGZdD2ZVKV6t{) 3Fhf8]&,v>G5G":דok$!ē|[xۚ'.@@K[UG6-PA~p2hp3fYID#/ )~ժҚRLM })ѴT_jhz=%Z܅R?%ZRIZ?J޶-­>6[i]hDh?5|X=_A>xdNd3dž\vb t`εX.1vTWc;i Q#/K>5\a1o2FwsE_e Do`[AlI$|NcnQ;P@м=mMgi(o&+4UĆ6?)Ƴvu⊅E1QdFL- g8.B<-I+Bشs:RVPK(;;֣~rsxJT7gG8I$uv1ƵsǕϚG*Wtz:jeQذ:)gf΀6oDI!@3MF5] 9B!: 7Y[OWy֦9@|8≻O#qm8>$x.5cʸg5:罘nUt{S ή#N5vAb㼁 fzu^UҠi\@RyT?B<7.i. 1'tkFoO#޹h/3DB}-.23~i|6FBoo:PBOC$5r :Vᛂ|?ڱ-O+mo`b?$'#ۦ8jb̀FU#ϒwG$!ē;J1Rk"ځSOߦ+#_4wICK2xY[ovoHwoH{i!E> h j_!q_=HT}0~CڀGB'y->g;}֥ΝJ賝o;0'[ /TCBW:&BH.G*פ7_"mV9BxY^Wچ oDY@B'n@ڀ6G O!#*47ΌC ځ7,fޤ0)̯ *:eLZ%˥CF{.~NɪΗ_#Һi\߯:<kMDRk3t.$"/gR]h3בɒ>(*8a6Jbqa͖įa$l{T{mքSЬW䱡4s1S󫛍7T(TjF窃ES. :zUÿJnh=%e~`y]4Õ7kˢ~ɷ6Iw|F2̟:HLX LE}V.R2/֟5l$]n"F'SYH6jG4n &eK@L]J&I=! qm{MUB'yW/j49G6)>ȝmHR PmqtG\[G',o $B<ɷXRoRROڸ5d VݪOjFoML_ oeo=Ax<ċ&/ !{({(W$Cm5cǶSHv`c\tiU'dk:)2*P :N !kF%VAvŗC;.PLyE8P/>?9;Ѩ5 m>`= |8ڱ5~4y-o#qmw#~Ŀ3xEb‘_$ځwOF׼v(IgzCUU\2F@ #ҐQRtYຎɖ-h-lijTٲx 2N[>?f̌:Ck_=R^,o_: u 5Չ9;Sh4hs_ NDFK\URQO0 F1JWF6*$U~w[|bS2a* ُcA#Ђ8pyztH+%#$xZ𵑭jMJ.iܪe |G*+v :@ѥm' ΤtiAW/ sJtw:E*K 5?MJgq^Gθo%:x谚׆(56 n!.eHpBMfVt9b^&0 wNƗpE 54JNQӂ$'=|-dt*:I!x./}:IgPq$d q~XpˆyT O*fY8Q)O8W/k:o80f,z6RzHe M_ecK*lTV!Q'ĝf!n8I:~nӾS>s9_vʄn0]JSW fN\DA$}+ޗp|Z[iw}Çu]:ˎuQ:t^l.I_q[i .do7Ɗ{jC+kuk*!VQDzĕ:2Ajԟ?ըdn>5NKZ=ZjR4*^ D2sU;Un3鶣tKwgU;7|wHw(ԢF$8J]N}9R׹HoV4fl"ӌiGsZmY;К۲CˢMku|jkZ;Мvr h#5-ۭuPz> 8 >ڌu%ZԕQ[W]y&w\ $Y!ē;Q Ym|5x T|٪ jvw7yB "GvúbA'אMz po=V'^ae/f۱2ՃfE;?PG <|Q|Θ;J 8gTyL˜ymgF^w"fm_)Eb4w "[T M€^%23o|b"IFZbzҬhB$ޭՔ`6y y 5dN{9\J5_-ND5 .0b5mƢ Igk)pX{Ky;lsX3O^ :ˁMZ&`2-_JER[RFsVQ_d~qR,l6>Oub7& eP2NaVA+WT`x5RJfEↀ׀GL%?6CXNwbS1~-Dmh nע2U>go\M^=ЉtpYij./ O_T-@%ڧ_[C:!.M[g?jZǴ,3lZܵ*R>".qƭSK NY5+s^p܆4&S0e Lv 4^K3=9Xt$ianxO>YU(dΌń7 A{A_&C+yY/PS[FݒU4o5i'0bWyN5e:,\pBS݂ؕ&a-k'hf-Իvlf}k r2)#F)MZ<^Ku "$XUX?b~y~w<ۥPT`{.i|ZT-Y\)8ahI+pkQBm`5$[ݢbK|I $=3_}aF `mz $<`䳀K]rxIX-8aDK  &6s̈t0穋,M6lV|8oRO NжBp Ԇvۢ'RێMiNci[~gl<i>]f)5Od {/1axz*j g Ջ!YM6+(ıFJ:P-,?';Xtb3N[N="X_ )[\ai+`^o#M#vRy|_ џ{&t]Gqqra6B?+\'N9UUӀޚL%l=h8o7D"/j:FFި̖WcϑY>59Qu7^[5JWьktzԂ^ꁹWΈtsn,K`֦dG^|$ c{ryjɜ*Eڿrlj,C%_{47 ͉3W T@na fmlƂ]c{s~YHhQ aoፘҦDApaB4j1]ˍtĀp|ϸb\*nЦh~6jç\d!ʨHnJl-L)mXg^vi;o} |:̋T{#~sT$;/H# 4)7^7)p/rn/Yy4s*W77IoQro6h|ce4  HM@SpˆU:,'5Mv`Yp$!8aDVYtp3jK,~Kߢy~ +)Z˶,ư #YrRÒ"8aEBTQOp􁚇&dhy+>B0qtPXd+d&[ ԝv(^lWS@[kls vQ%* 8o$O"r=b"3 V66k]n56, )P;?LoI-i n.FR1(@ \ex6 d%p5[<\m/id&&1iq~mN4X.m0ٲU;(;lZO ~رcbC<|+w~l?%9wYF ?T|@sM? o^N`R[2[? ν)Cֿ8X67?Ox-N-/*f+%'LL|9SfZ-fy0 Ҧ 8$ڽ:u.c=u$ nM%CBZ^4+t>`d] 50zTRce$_.&R.:%SVPx׺ Ah=okJ͜etyx- #Y@|d*`g]G-nQN}(MYfr=$ 9HQX~#YiI\M>z B<ɷqX[2ꟽF)\ Z[2[(XI[r bjM0⚹fM~IeI,t;qCk B1|mĉ㖎K6 Ş$w#r##cl RP+z`j2Kqf.U{u˭PVA?&+7 gf{5Uܣ͑"{5m2󜈾+A(V)WlO]nzl=EZ6A7EmFVSNs3A7?TjsSAwN {RAv*U.h/.-bΟBwE%6 JH_ ȍz!_Q3OK~"Ps6 m5Fe? =u#kk<;0KTh1a]g߮[;0v _? οV)\{t+c5眯'Dr"-o֧)D>ߡ& XNщ]Jv%EBp T\M^psg yn=F0KJMAK N< n"q NDn0b8Xz֞ F"& vIG<$OτhM#E*~^*PZ(ߧokX9uu' L߆t6=꒯C{B} z7=ԥz? / APOFzeFHeeKI##]5J' ^___6w0K][^ ~u#jjo{NDm%r ~Q9̣[<8dQ=< rIזxߚa*UI|/@X2C]?qX u9hUģފMh9Ԃ 9^u3flwnEY-B`h2z7dt)G\IYjg%z]J/36cBIf$7xmN9WORb9ܚÇ*#]sӓڷv$,`Cv@\M[n "![ړ;zɘ=b2-&ӞoNZ]˷ڽeΫ4GoZZ2o;;}uQb_w o j\הe66ueY%Y;]\ B )iNsvqKS\/I.Zr=w|XXJ;;d1o7Ov9_ ʹN(SvlJEq}~3}y_xXdA;̾Ǚu\@#Sޟa;j4҃ڞe.6}ovڜzWª~tlT\,`_O?tgטFzr~˸c{gkt- dZHo;[I6yջuw()sU.$/; 8Jh_Gn"P% N4({1o$!Ig?sB.,!IyE9$rpp=`|p!\R- "NjZ^(n(ٹ4$]Ru,8AH/,nַ$d5wVčbfEEc(\ñgvNjf /yp|8j/[{lZ׬777 sJ,K!. 섯"zjK=Ħ Ëua˔NlyUO8)66fsi*cV ]吝^%zl(٬wFޘqC"BۭVa&]y(XnP*v<L_&nW7pQu@}Z26g>>UdOķ"qmuG=nqMQ< {/æ!C&qΧ|vUzr[ ( &WIkׁ_'W8 x==<'(}@^c* ޗ|F|']L bo%!]wG}4!&ڲ]9Z&x(CӓwU! ^W.u85lD_TV+7KT$IWvʷDu]p7rCKT|Շxo|81K |lsn *-hCJd0,JtVK̫bs4GںkNq]0ftAçcl}>N4v$ E4vT_jd7[ԛӎ!!~5)Sˢ[ W7P6)f{Rc*O}'n~wCTOЅ¢9 -JplM7uFJgƬ*hڔϛ2ˮa&ήBM#ڬ|$l_B%Tܣׂ]} :y'}K/ |*>w_Bu&$ߗ\$,c|}y_ m?Qԟ,I~Nd^ڄ9evJcw"$bC/b?^d3ס>,g~"0_&o&P-JסCߵ1|]sQBn2e^D'-IC͙mL;תe$֎~.Br(jϕsh`i!\>r$S|ىIW)ОBſ·x55zS;)p0su?R k92x9~oX 佁Op)?ӏ@)[gC.O.ɻ_!]2elxW Y,pن6Bk'1G'q>Gx Tq4=$.3zؽI?O_b9&7r ̟J}E E}(sdU*+ߠʃ,> tt9Rp<Ƈx+5WA A Ѻ;8/Y"3/WKcݨ;^GxU^DeNOuHX^ڔKT} i{{8UI<|+zkT%R+_MkuFx)o.ߘ|EſɇxoF1F):,6 w`-Vy,Э`VZ KuZ|AeRפvpNO+n+~$h=lFgg"MS,xkiN?aJUq*a[ Βg⺀ρ?|;Kxogn1} !\7pe}[K+`SEn: 6e-ۻ\B;߫4C~_d˿C#!m]NRafG\fîf: ӱ~?.?3l8O| iOSq~\j\=QTg}'ޅ~s.T}'E1=Q" lQD-iMOsvԧ# %گ `MOɦ95P `'/kl:/Z۩转\ne6?lF|ap&6\F=G";*|ޚ㞳)y[>_lXheL|T`jd?̩Sk^SꢜL&u >Sc;<M=vAxe&eϲ捚GBs «gOI _k&a}.mx^.Vbs kyxN`zrYmZ@jHB:zOOgÂFU-mӬL9nqGZ|أ&S=GW C\6π)!Z70\vHmtE%\ՋEwW)k3ѽ Whư6Y4HѨ}e7Ps(O֝^yw;[E_߻w/%]T/Oջ(d@[~Y!+;&e]H&mqنg8BE¡ 6̨X9bVh_ \]8_~ kuI¿kNx_[ Z7ItM#OlN0y%$^  ﲣ8ݍ{c*QF3kG{OOV~ĜN;LFt='$;dJlIqhhoЛ EHK E>R:npCOEh%b5Koy%@qmS̅3.,6[kiiAoY` >|jOFV( 4 iǬ,&KqiXS_%V`Id4࿀K5lNSq]#v*}'acK#v~tL-b(p\hœ2P;66NVb`r*Ru&hol%*t5p#π+֥PzKGTZ7ZK]jh],.ui՘L|:sr֔$酂Yf䒘p(s2w:2 )9w1:-kc%۴$ U$ݥy#jk8|8Ymۦ>V4G"3߅qqe| T`LL<&<S,Qq]@IY]IYZ/c|bf? 麁b ԰xYm( ~|CosC͉2vS{e]4L$JK9I;t;ZfH+zײO$d##C?y?¾" UWFm&7o!CUo7[Ope{urg|5\cEq3Fbz3.ֺEGJH*ώDT?nu >_Q y56d覞 `N/Ⱥk}+fKY.؏D?⺀ QTO}u9G-ҥP}AN`>{e %av몢<]!/Y wr𗷳!AmoH o7_ Nூj 5_K݇xo1y5ag Hn`yf˜ʆQi>OA4*mJv!$!1pn*n/N;#[}CHh.*Y«y0p\j6ZNODoT#Pq]@LGO=BV4+t$*߮Z|fi],&aӱl Hw7ּ:é-rL>ē buJ;SG8377 av,UCǘ&D}V#RP`5as$=Q*"[3^ȑ$zx\$)*<;=@2pEhsT}'>X]$U NϼU %[7pEGԝ2=xNב6E * T@ ܊J@ş!a.0;t2}Y|ܬX b؍:7w!>8br4''|'y' d4 ;'uj`}0\Ѷ>?ö buΤ^;]@}y`o9{2Ek'a ʛ.QWKvH)KM33ѧCO-|[(*QI(,ciXg'HTiēouo;`@9.1}}=̞w ,^ k_qY 9q)ߦ}ĩ'o}e)I;Fu&v$ߎm11Ÿ~/ T?8s-^}ɪy{y^ls<ډzL*Zp ;qgIM@IS/9~+7tTW}'n0|qNA~BDf*lހ&?ߎy :Uxp|6~g <~*yǠOOΰ5VX#>V8V|>Z`hyg%[!2pypαARpyhA?C<;68ĶXc19ٙt@Zs:܃j|p) ?{P/! ݃#P=M}+őZ6{P`W_R=>ģݣ5({Ls;Oү`;lCZ]bÏF˘9#7xtQYNU1) d5)5IQykLBP{嶜hLGB fe< T+oKd,MW5\2fUe KM|s.Ie?p_k:"w׾Л'DBsNyQ,>G KX3T4hKKXʚqٳsJ 2UFt׀W nbPk P j0<xXS^~RSfV9vЦL"])~S7oRZv搧ya , νXSWbZ:iB l>2XP4aRkt_J' &u2]j4f2f*̽aL9b ҕ9ll4408Ȣ}u;M`_pBEz_c\iGBM P}jCpˆ_eINA3-CQ %82sn-8aVxbeZ*UIK^)\4~5Y{btK3GReQZͬ=C?vG]PK<ȁ 0\%K?hta|VZ3J32צg]Y =)FLF3BAGnS֥JǨ_|޼f߮7M>Rш@]V ?qp 7 ND 'wϚ4xXi_ { rٰO14Jh=9X(WU"Y&VZĞnJ=K#H:$Dz0I . ͤ[pˆ>Ao33a Ɇ#{\TG{?'ZǨ+pNLY?inG r.b/PN9 Rd?QeF􂡬NFyT|̹9>{9KxD ,7KmLY a$eMY47mfYCg:k:#e,:BfNjF9]oS(=77M7*J\'pq4A+'h7m}W݄s 6ܓUHC)ӫNG.=-Vg0^ #Sj#pA Dr# c .ZRYWg^pyQl6=~lvm8 YpO\MéDIp J5J tٚy ]%Գ4jLۢcc@S-fQѽշփX"cN6XxZrWc".9g2Z"Y09*|FTyQ޶+*`y{bkf'p 'p]Bb,!x+y/~wLbT-,!E-y%Ɯ }⺁Ga[|lXX"/?oo^o07Оܟg7WYg5^Ò$zRxU6>xR־ùg|62m͡%ZJmS/%xh; <`{ <`{ | uox &7%N)ZC5}N w;1kKe;] ܹS2#Kt.P'SfR(:.kӨYomRmFPacGw'EhpY5Y6g~^tƁ,d YHnu2f N]$8aD3leS?񘅎{wʒ{wpNZy2#)ᭉw߳'DW>?Ih N!50)HOE9=i}*4%&/-Yöm]FPaT)$Z <<ɸD5I1maʚpkŽECs $l[/OP6'\LX23qOz]Y|#յ&3E5!Q|';oM7.5 }\7=Q]R#<'?xNB'~t]|Y&?6ς?D% /$_~aV&e௃`XB|Gj~=,IhO|GQ;GBJ-$C^#_~ˑ5",C2|࿡L+2$oQo\j=$!*[oam:aqN_|r0rXG-^ .u4om4^ Ys3O.u!Ym!Ř!{ƻw:< Q }5Lu zGVI&BqT"$jz4\F]Q˟uz!Mˇu,4>(ikw;Ijt1ݡI'BJcCrFZJo0'&]GmkJ+x*n *"5" x/V Fb>mœ2jw2w";Ke?7b:&LyoEN-lKM/I~[jfrղ)!\b@KM} 'Xk x]ZܛmQg<˔Ϸ=h.1S}^fSOR Nl,00Bh1ֺItѪeby El[2$d+ hR@GHÐҁ)7.5 ن u>!> 9:3ǵyf4MWV̼^,2sԣ͐W 6BPuY:ꂉOrxU,27LP>T0\$.7ǀ"xZn]=7H:zO'x4]+nUfM*R3h';w EwFOFtMyv$bNMNM.{(eQ$m&Ϋ7)we<TBYہ NHY+~3w0L^ÂFTD:pg^pˆ tnkf.҆ĽxZbvЅLK0:fũa=6d\*n6 x-Umi@Q&XzvW $d~a[#1E"ݴ>ۆ.b[b&njv5mLvk9lGyFlNڧ^ƶ^`*-8"c[T)0 0T'p*4ZPƆ4 ]p$460ޟv2#cmɶQɓhD+Z /]6*3KA_06 `V"go/8aV 8aD"=K?PZwh?%8aǂFY1 ٯ6P L}l^CՍGt(a #j4c4g)*L)<;uoK,aجM9y~8%xZnP59{4^2m N؞8w<-)lW ?MpˆK%n.Gn.s:"v+8a<ONfĆW ǡ<|]~;pY5I(~ܶJVy,Oqw,S\FQE/k]r[װuueCsߺ 1uϢ 1hVGZ,%k%BOL BOLVkfbr)mRK2)Kh=ɏ5h|oT2%DVNS[W`t+*.C+X3AS|wlR@dͅJ?|!uRIqqɨa mRIX/Se [F%.p|&೑Ugt?Kb4j^|Qc'LPSiun#57F$wg#]8dӴ*Rfp( ښ%_+  R QlsBLj$W Vcn*J7YpBU!$UGVR{OIV m+]FϣN뎘D5EOur*7çu;?Oٛ$fdm%ӛvg5:P|H=Fg-HWލ4:&)۾՛" 6H3yhT~*fSRkDs=TbhB+O[iw1Gx- #?+@"I;8>Yim&0jf}{a4l,}S /v1oKmF y:,{B @\]N΢;ֵH+w-*n1pܮDoZՊ \]{;[DM6Em^Ij_n #co\BxCx5oljc,KsJmIimozKR ߁]2ߏ\պ=f'-l\% hVk@(rXP"˅mH?F\e&iG޼ &l鋖׶Hq *荭 FwUTO%1O 'Fӵ*uK%Yh)3h#~~M ƒU-NEZTvg /Ѷ^ۢ(UYh-?]7\qG+:zrMGj{c+tR@]O:聊$Q6VZD343p+,i'[gBqA mggO.aXuqi ߅oIkYqogx }\Q,:U ZPoTπ?ىN]wm` ɦe6U_%:б 9Q=A@~b%͡3eY  hRW{OH;l"9n[*9=gF{z4vp d3g/ K<ȁ :`NT.l=K?hta2 /#x;=TmfF Ժ&hz).uZĴ17xGc7I&Q46yĹQg|@킧݅s8"x*m8^F8.8QkI'L_opc?ܠ z]v: k;ye b~ؔ +!է_`'#5*S>Ϟp_СY?3Q)60wh>|?;aEnK,U+O㺁ްn//".{i4[ YA7q go%ݯ1ABW7'$d_!-hiLV f,r3Iȿ |,#df0GT-;lvOF~-ȗAV lش3atU0*\#1U"Mwm]]4]+ R0EDӖ}ߟάja6-m?<ɢ_{Cgߵ*Uts2~o,ʶ}xJ y֒>ˢM{r!6)6EKd|bD5YmOKP](~ :zO!E1yw:cS¶P$T7peGyMi5CkZ_,l s$?uQɌ܅1$wG%T/#;5_ɑS_ L-P_6BҬ^(@h  /0j/݁)tKOEO{ ccXۚ %dF6?c_*!͆Kh}K֚2}zCό9ޔB (kӤ(?oШ? ^\ \OG'fsڡ]AIh1)Ma)ڱHhevm)U+'Td|x _&\/xJ*c㬷7^- _tP26 ɶoPzfD@7 NU w N*Ϋm'=kO /$R5]( Hxu#'7q,uhp9$_U< ē*>ģ wUxOt胊Od08o$!ol*O,T4^5B'|Dx ܈U?vM%YpWvrvӀv\,uQb@k$Q&]l΅Un%rp\]VѪH!E_4WIhdu֦O0Z{ITq 2V~ctQ6VUFV;2C|߭[\gvG -P?pmprZʽj&Txm6u&tlYUp%|肻 ‭T=*x5u IR*ǘU,;|"၁ެ6a־ [@W^o-X&Mc9U GeIw ez2챀b WfObMhj:{9b٬v$z̉ &9tn1Gx3H^ʺR 1EON*i8 >㳎DvT= 1v9$ |5Me*| kPO_ Z] &[U&E r =)Vظa nw+ӊ6_7C]Hg_ڙw2TYC wz*p|  x2]7IrcߙPq/>xdu, ९o)'z))f]e˦'750)g UHԷ>^{#_L9xQڍvϙf;T%!I<=H3uOķ"h.06M l+]E),6`[\jbc|.9kLc`FY'g%fpuv=.u+ƶo%V682י0G\(*2> ,qer2fr h[Z&Z‚Okڕzsnd,2`<&(dõ$.໓A=m[MLK% B5M>.*M>`ddxX/{LIv8>UNKma op\j޽,NԆvE {w{'dc؇IY|^a5l[3(0Ɛ]/h%!J`!; L0d⺀BA1UDo+|^=] Wۢ ykQ;aSD}O *N9χx"=k׮/CLEkBM<;DbS_m5+~pxvf>u\;sH R)Y-oO tWaɍ'k jAx;kԯFFlPjnd#7Z?=Tq{ P|aS(MϚ%5BW >-g3?Y<0rȝë!5mPQjT~;YƶxSl#tɢUqBCŇ6F68Ofq뙸UA|v dXo>?V7RvXOpCMV6NVyr/J+~(t-> o1r-.`o7T QCxEBg33#}[r6)X7u@nݏ^鱍BOx? v1S^Cri ߼}e{y[GnH'ű14B^-'!:ue&sz^H/< K>=TcbxjL^l1ŪR-Mu8=rkYHO \.Qc&m o}<GϔlY徒!ZqIZ4K#LpvXb,{Vg)Sr^{F{ Q [+nx+;|;Evv EV4J~(2;I6^qN ~Z_ȄQz_Kli7Ō=UpZ!ؙA4LQE仩9t]~ Zm~皁O}pDsrcqKvp@B_X! _X/(1|s%*jjeKx- -!UWE_Bcºwd`溒}J;8{T06WQj@k2=*D#b D& l6fCIfiD_CJ!~e{ > Jo@&BuηD5-'D*{nƱQ :M e{R\8~^ ~ed!38Y!H)c%x߀Ldq".>j;FMI._A"s>3(6$68l8zr )?.|3]HHI4 w\^=K<Ձ'1qϛe6*Pv1MVQ w\ oAv.~e{Kƙ3Fq1*V nTsUll١M|{*#Fj|?|4װg/r߅܄##m0?C1Q5!RKIbJ8>3[nn/1{|s<<?3%m89^/ _(5҈/!5DwkE~~; kVM T7j&{6-$6ߡl>tHi=*UfBuI\H6KԪN|aV+}Tp2Ane>gyMflCL,y7LkLd15&6[eq 7o,m&L󠛷 mjyy? ˝PPMCm+;ձ ۪9E|/!?+56M TqrKƭ sچܦ޳LеjBxPZ鿠*GVocӐhxs4(!BF^7ʋ}Ţ7ۆ f7l,!AZaa!k`X!7MX8a͚kf}ʧ5 ȵ%pW6N,%ᶲ!H?=b:%lV4ˣldF絝ԸEUzG-Zzv]&݋eu?EpBvme{&-N s[%_V $T5ft6,6I3-JD$:5x XuҴ >tSBP3,RiȑVj6℗ŧ?+ AJəl( t~TIn߹'1>nMqe8Mi6koۦ{n{C-5SͱJ;Cר 5"T7ߗhVX&)JŰ1Z.8Z w`;ZPݞSg8yϼsdjeslX+ЕXJ[(7w<$I_~<,Mj4cq'|ȔZjބjz!4 !+yovГ+lDFBQG=6K !֍DoI*{4k`E,SFQcq5V/+Bת"T7sqj:XJBY6-ZpDKutֺ橿1BHzށz^WUv\V?šZˡBKqǫ U*\i":ڴ1D+r̼'-kBWcLiSt[߄ *FTKe]P PX0)Ҹ]BJyed!W 39wh-z%ZYQ12*}vp#S(y *~>UOnsu 96mYZgac$>ƺ& 密[!ssOmol);? %}&C?^ #9تQLd/dsj##Z-ّEoKI!1GuʐH!H-]2H%GO:THa3u1$΂IB NH)GOӖ4^b >0i\,>Ƚ9JiuguȘ#}b9}ANj.^˚Cr-k͎~T?)g`Y, n288tt=y3#OEͅ-ڛ>C0k9Y87sMi\fyϪ:zdQkGB M]b*pӲԅz[it{IZ-T>ģH-]%R!Py%_VI)_C< 2R!]PBW |<6* JPBC,$5plB@ U{D݉R *ԏkV=^~YrςP܇x"AMo`fSKVDgV2kDArb'RѣLž ,(]:>aF`>mvs;uAG;:& (Oez~{V|gq-suT~R3|;9eʆ_ȝ<4o8P_7^-٧{nqvEۙ4ZEϟ7҃ڞe.6}ovڜzWª~ttN6+fFz/ۧh3[kLk#=\?WZeܱ_|͎35[c4XN֠YVD?tt`c:7,6MHp#!Ig_u{^C<4$Thvt9a=qGt8 ?Y\C#>Mlx@:ehTiO* 3P\(U&Thr[ ^`x_䷕6 ,H?}3Sz0dg3R{òGa%>g*}Lƞ,yE^#Vf,/VߙR7i[Py\]uXcNϊ?QiFvG>ԇx"3} ^:Zv~vK lqe^D\ je^x&w 'mPZQV{T ( x 5kgu>ē;aUSu#63X>^⬝ba֔Y_pŘyˀKWQ ( 8>9S>ē9.ќ\Bn 6Ko]4f;ҘM~XҋZkSpga`ڞ]>Up5^T嗂 |NOSq%4tdpVoɊFyب1ҁ2%;t—[{Ds}}Q Rg~!o!Cl_{RyJn9OC6͋7!~3;W*̵ȉs$Iē \1*aFO?wwHNAS0 dADڒ1Ý6?HTdp/^ej`7M?7M ~gd^d[pCeG~a).HQq],F$HꢝuKWn)Լ|]xmJ2H T>V=41k5)ߨ4zm* x?;(G4ӧ!ŸaV}2bجpq}r3/k2) G;(ׁ_4J] v!eص@u? T|·x×m(0] Dۇjw-ʬY˦f |c'M7j*~$oWըh_d9LF<8Ų݄9%nf¡’U`]9 x,T[#Oл$TE|";?\A|!>* ɷ}T$-U‰jضBC/ڱ HLc۫H&T6MPq]6M46Zr ֆp B/@kkM(f#LHa{x ɛ4чx70㵱WbZ2I s&YջUڸ,-okaׄw'oTIƯ]_ ruJuR,@/̻`L؆H3hWbM د?S|'yc__w%QX;Nin5.~OvNx/=$o֯$|*]1Zkg sQIj]0wBmoNp(yo1~^& ͛C<ɛ/5Q~DlQ6t[d|P_"欜}3$U>ģ̏f5@ \l]ZY}j5רSHP@2B!$Ko˨h5jѰ[i3c^%~N/)]wVv+T>G?Bu?*>ē|+\cQF>jwd EeíڴGs0 $d~ '4?C3 ţefj*+ƥ+*>C<U:؇j.;}9'WM(;H$Tk̄݃N$ 50IŽSܣ71]V7>G~O 3fQ2&G?P!39/r2iீJ2Q /D6^{% ;zyS-}10TIx.O4ҡ>*?3/RF o(v֠O0Zз08[ٳćx"KXwUЙeIwL?] z"WOOT2\+}:Ư9ՑӀ7)%,ģF;i mmz5C9Oķr57ݝ2C9mU.T<"Wzq1h=V;Ri=B0rZȊ@ńGkYli7Cywu;l+> h$ w 8 >= c?< ~ZÛ$y91c*} q#cif7 m"D>2ŬՂeR7?8ܲixsqM oʙ!;WW) (/1ޅQTFgh6oZ.t6T|ڇz؋U"ٛx"jƌ^ q8&"" ǥghPV#Z!uȝw"!;!'ax_d9+? /͐ЋJFY1*5w559&YZ -A5crFiN[3Gi3P}VdCofVIЈd DdAV$|7Eom|YzK '!Py+!CەzHK3۰1jmd 70ahkMC } ;3 _߼amp=rB]c;S迏.,bFK| d*މj[cY2E}*QIi*>h s6Y )] \!SR0f- n|CheU.&x^t:[9Lݞl5j-/br{j{{] 50Ty>lk!"S^g1\꽴,u^4Vp/!Bԇx=Y;Am'_G7-YvOv!5b+?%N^oT[sP܇x"UT]qZo,ыSXR K+(7JIT謓0\gqRԓ)XyO0mmO2WZmN=+aUY?::jU۝mV\,`_O?tgטFzr~˸c{gkF1̬6~9)Jbj6L\//NZTeR6=.=a[+kFRqwǢ7 9 }GY⺀BڇmxÇxo0v(=eJ lquȆ9in9JdJM6ksl٬2e^r>}ڞ&>!Çxnwo?/£@ls@Xn2z:WDa;)4tap|&rCw>ē|\3:N6 :Z]~wfam[6( 6*gEu\=m>HYlq{Ħ('lH?;D kKVI1.4yURɨdh[U& (Ֆ94 { |51륯M=$cF1cn:S"^2Ut|כݎJ}[-hkQnH/EqF1 }5௕Q1 &≻A^|3_,c-H$$'l2z0skØ .4Tï0#Ը=m??I2@~GF2JIJ'T bm NbR 'YLBWF͒[aOcFT&\ E?n<]Ԯ:zO"8c _@$ 20 ='OMDeU\¡Ɣ;QC&2OM_.8@5]z-*R֢Qj Tc7 Nulvfs'P['Lzfk'¢97cN2sj}bV4bm6jx3sAigKn`c0K'*C<{',f'![7pEGfn\aF5Vχ O`r|;a'}ض `kH$dF7%M2|%tkhY⢦ `G* E,88T n@NOFv5ZתڶfLR*3/2-9~)Uz'ȪڬoE'ЖiaX㹠$E"$o dUovd=.d Di$3%eSB)C*?a2]:kPD|y_*R](6%8aҡ"$*^(\c\h@/u,u E C!.1z.,k*YiG\+ۚ1K}wηe!`pr!I'*)I[.\,B ẁ+;j$yG>Q캋q31 }Afu$W^,.j8wTI+_KV͙P+o '7л_2z;i#k(g*g7⺀@ >ē|org1NӉ?uWtMәeט0)WKcԱ'bV)tz}nzOW?/hHlZ.A] 1.3?cP}'y]1;?JPmamZm)W'oT|(}hM--DI{G[*ΥO5ZcK>;,ko ӚiMYtA{Kn<-uA"$I_ 0\ C3]G -Sof&%w307*PbVma&=hUdDŽ)UuYX~b'š417+E>*]%C1hM紃YC`罂*2]wP3r mpz'BP:8~ #eERIkZ+ٚMdatk#m=6 #D30qjf~ T ؞VH2 3Sf Ԅ0aeNq(󡀥*=r廤)Ϭ Ut'0yI'QޫO?YyWP4e9%UFG?LU2I?dt1R4L7M)OR> .wՍv, ;KFq>#+ќv7 ϣPF{ovx~|_\fvySz()h6a':Oۨ6@ MD&$ETC5U(05镵xC$WsW5r%QG"OFA_15cStG&WC*B_])mɧU"o+ÑS>roB6 ռPXeB/]:fiϜ(fBeEc_ҋUWPmפ:caIы NN ;*=-6 N-'8˶A6NaԟMu*0#2WXÇeUfp歽-aζb%6p|K5i:,_mCwhS7ěe"3z>ä6kĨ8y6]Q f4F4y+'LsAsa"(0RӲFy|]!t2>ē{6XEyޥ✽TĻ# 2#1! ZC5tI=vC"BߖFEaR4$^~]x=W/HZ6̉I~<2 G- zѝ1-J IO3OIB]j #ݶZP;g@C*nXx]-xJj Eպ ! ='|]@B%:<ޛH",xNƁu^oyߗqְz-4,Z]1z6ያ̾1=liSK'l{7^5&b<ˀ -HLC;m>C,0xKO;9eβ!-#fXx~{tmݞ$V4t}-Z3.Rx;Kg#xZ~EۙI+sO$^\xxkCtvfebάL֥lgVۙ~)3[<ۙՙkXdMp6* "8Aܹ0޹AAgrǢ=wy'>[kz\=qm163qsf1]t{93wJWm~Bp$ O NtmRUXtE˂~(ВLSΤyڧ]uxѬT$R>%kzR3#쥆mEᄉr oJ mZ)ö(6q(IjUmDbOF9X4ڸO4E RH8-8a*gNDv,ԛ]д?HWi-rL5>Vŝeǥ >~2KAS`+f}RpY껌 &m2=LǷ;lL 2tKV`zVp¤Zxp] Px]*~{6DQmb@wwT;^.ݡ$O&4myƄ ^k:^`T]ަPֲ/W9zz|D;2 vBr9W-8xdbϜD3/"g-?Iۆth L}^ܙBu3'LS$8aE̵ N'њI|HVΝd綐CᵝNpBE^&="w f{'LB;$_PU#-ud= Nc #jo)\/ㄿ{$_ NA9$y CNLKwPq?I_KpˆƱN/rFIѕl,*ryn'L@{=@gsOxmi/Y(ʹCM~{5@\Kc ֬F0Aa>5T3_"{C/iH{#>Hx! vLđJL>]./q> JѦOEo >;kI5c og= N|F܎=o/ YT~QpAdE} 5SR'WYYz !:W 飂&smUC51_X鴃}nWӋ^iIZHLL44~RuuqPqV3f*F١o4xC<]l:1ܣ_t{X2ڌKWOu)G3h$ 7T_ "#sΆ{9\`ИncV< LU'| QNlu <9@ymS N mLFRzCЖ21Z G3綔IպԀs[jUrs[|K[:-umofWaB й^~~XhǠq@׿>rKۡG NQuБ. &nACavmEᄉ<5.ƝTi6~meGeN/Ei7(/Od{y}Tq[!o";#/o=OE\Q6YMw7ZMǥ̋ʵq/ tQqh6VLY*Z(pN7z]K_Yt )pv^]l(e_VMw[>8F.Zx |YS4,Ԧ`Bɽ#\.#(7⺀L2C<ɛ0c5竖$D.P}?eMSltXS&WJΔof҇D3e*χx7`7jʝ^>`KMg0ajx`~,䭝?C<[NXXիCu쏵8zɪop ۢs[;wsGrÙN91cɛ<$o7o+Szea7bOWͤ!IߌK g7Ì 7oHޤ>ēIդ=7h@cmw$6N5hsp|0~#&JޠaIޠoAϿou>ٺ+W(^_yMn)ek&-C<[nXX-{ msNYBnJLp!&5WUݐe9iw#yX Y ip KѼ!bG0xL|'y rmr[ù VN~ m z` Q4X/0 k$*@6|@&5|fT$-^Xjn LM[]lA\ kˮ.ِr:IzooutSBہ)zv?i{ ,1"ao~sy+0a#`7 Ȇ}6^-w GQ(w;>#UFg?{Oķ! ]mYq[k1MS6$\RCQsq_U/| C#Oi([n+؏# < C]V*⻭EwF~ӫF*CO"xzj&ɞ)}ۢM9˞Rnߤ7J] 9Ah(U[qOOOB* 8 ;AB[;$|ЇxU~Ѩ^u'-;!׽M/aW*|'[9ʚ^O˝ԋYHp޼ R{|Ol4f|VP.bG⣍\Qpag6?i f&aG>$}@ R+:OgeTthT޲IBY)S 1f :RS"3ܛ6 o۴aP}^| eP Ih@np`xspց-r9&~Ⱦ}# Rdt*cžexp`M[n40e``IK!q> .!\B=|r* >ēw PMzo"n;ӎj:y_HHLq<댂wZ9[Yx 2wZ{*V/BCŽnw|/{ j6ng?sw@Tu@6m۰i|ypuw ԰ n24%  l̈́H_#?Qq !ŸGjz"1QdyG48:]V x71 ޅocĴV'tb2g̮sjcXnͿ@B g  )I^f8rcPq/>xdu,Sg Ő$>2Ŭkl47́ᐽ vRsWz*/aQTFgD:V&֫kRT|ڇx$viTqG=HJ 6& /F9‹/R7AB!_؀=uT\pM^..:aCK.Bw$rSYlr#pdle+V[amrju[aJmDb''[kq IU\*w]xg$c1&/l1W,78&0E(e0 .75tF'C$[yQ&c+~ cm庺Ƅ ͼYnC8q"&FBw"vDjq]OtHZ xJ*tR:+  .Ȟ|'kٵvzNFhMh:!- mU.М*E"]MN<Dj4ádJTmcȑR#nŢ)Y-oO 🰿GrcЕz!<~0> CGLMU`EX_YĵvI̚Ymʬ2s <#\ J-l( Tf)%`ڀ\W_YƋƝW8"\jzA=FiGz4M#U nz꭪#.2ݸ-wrJNb?TESw_MN~W[ņ5llYXu ΡkhV^tfamËDx"fg>pn iN'PB߱u\D]vl*Eka'3qTJz '.lt;y14G{WJd' 3z: [h۝ "Tj, /I@|Idy.<-(6" 2e% [jz1B 'LJð3L0f-N z \"yx^O*!ceg+g]KW\Q5Z\ngS#cUXܸeppxhxaxx?r?kr }'ԍT{Njr9xF8`; EྋCsZ;1?iZ/ES^׸$~{M{ɻ^?uiA˩? F1E̔i+<9z̶ȲޓPGB uMb2pWӲԅz[uit;IZ%T Qn 3C \*6,Ӿ$IP",Z Ƹ^-I:/0tA- R (R=\5b-9KXY,k4qMتwYe^~AY{BYYUzPM S:phBVzW^~MTIGӓnxQcbߏd!#v!1ba?pcyϑ<{-ib謓ccl@nY{ +z%ƻ"nGOlnY?:~w2;>PKM}~Ds-u;YL:|=bD@B".DԢ(">"غ1y>ѐyл^ {בUWVz/^u %lCJګzՖ.:D%xvDE =Dŧ}G ǥ>Hd:2( rR ۇMVB7M✯'3狺ȼe~osp%',N4G-tM1%1R%WɗIۡN7.Y`<ܸHu E*!!ۡ)!W7Л?OF f>g-S63s\ /߫ l[+ZQqwtBh[-r[ް} Z@sEu_ +*u>ē|sup5W"KˎV;TfضeSce6*gj70VCT{Qz  ao{:M B*)dT2*Yը'|W1H ௎Ǡ⺀M=$c\%cn9lAt!5DXQ?aEcJ/4ݭ[aCs`-2u75j_c҇xn1 nFwȰ܇xn. 7GT|чxo4ak3 ٺ+:j[5Io*,ݒɯ,.wV&<|A^Rx\<<}/"^R=Iەxt2Z)_6i /UnhE[^|#'l^ G(EIWy]JF%oݑU +G"4 {i9|pJy?R? o`rSvifҋU6Vz^>iG CFߩbY.?S::wT-7HEVh E*>ģ̜&.wڇPLJx"!1#,c|]tbGBn2e2ޞhL.R*ת,orƽ6YOX _^OX moIH T GxU38zY+۪&3wuk9B\jO8FO8>PyI| B;:$`6yXϭK׵=l\ 6^p;0k8&mo䇶[HH8 .8x5)K(U&O:G3kG{OOlGſɇx| l.sI \uhH7PkS 4'np7Z82捡QVo=~S_&?ySOK-3=9 l0ѳfyZ8v ϽR^:[*+G?h7&i Oރg|'yAOBnʎZlI7j>6j(Q/n4!eVCdD.^HE0BGJ $?K@܎*CӋ%!x2 -ǁBb_ |hU(_H?* ,/Ts>ē|r0}1FxjU Ѻ#͇q] f.eN̒&Cv܁}Isx'!T^]wEmPq]{2 5>lCC<ɷ= c&YBnřR+jYv cΩ,I[>4M@&`b6y׶e]6L!a-I`iڎ{5y6mRV Li4em2a0#Pv7lJ2 ZY ײRqW7Nѩ[/P MPM4g#TuW [6tSMſޓ|S~10ܗ=L\$RYҝ66榑k+Q-Xk͂QqWi1AqŸ:֯kҰ ^|Tr̳zW)NOa;yҍ˜ov}d=q5{Ÿ"QfT4#b4~? _RzOr}e\cX1VbiR;юT Y>*P-,=sI8ejYpBE0,*0"8a҃S*~k' n0鈇ޓ|'Lc /f? ẁ+;.4~`ӴyQS)~9~#Pnd~IOF42([6S1W>_Q;H_!$=rnwX6|d( YHEH$b7'TGc$2BP NtA_XG; [B NtA_\GI>  XBnಎ64{\Z>Gxq/9l@]\.5P 9Pq3/i^eWJ`!Yz7)SR7)"BWJG#={fFQ?菼NUdf=Au'ߴAt e ب?6l$'}' })OElRain2?$2*ɇeT_Oa+J>,ڇxEs1,k%$F˚% ?.֧8;EU~'{P&Nߏ> p'G*~̇x@_P.!Z7py-J:&+sq ^VEϻT,U,lAgOGnƬe9>nشIlhyp6h oQq]-$ >ɢYI2uWtDg˟lUvy ]5zva=8.AX=auYVOܩ`Ap\3l1؟2lG-s-c;;hǧgҹiXzo: 3)~q7Tl0醙$0 o_Ytg%FͻQr?ڹo !9؜mvZ;[RW,RR7ݖ)ߤwRqO T%gl 82:c0ֿ8 7Lu`*o}'&xpJ16`@MZ,̖,ٯvf)Y,_M;_4jb׀FyCb'dz- <`'wd=n[-%'oK.' ݖR!ҍ¯8ז.fmi 麁W)kPl *Qd@$pmģ[ 'BSk[f͍m[=)o@]|ybz :57KŽ&7o/#;zwē|I8Cؼ;In`Ys^ȌYv{vy:d T ܒ O[RvKfXX=!=6!!W7P}Iy x8|+WOqDDj_CnvՕbE;͒T;%m!EEٗ4$ =#-ODg!ho%֊PFluZm9#UfYS4ںkNo`ki܌#SsSCۃkV>em1Zr`hmӑ'H5ؔ$r12џMI"+ɻxg}ϼI?.0XݓO TZ'pt{#k-* 9gh'´I~Q3_W:'ma/xxpH^ُz)a?9[|}plvNGO[IFE?r6 6W=o儌Ḱ|+Ho#LԤ/Hmn Ls;~,d:oOyq] eVwe߱>mj ;(TzFhin^lKW@;d.v]_;PC+z{kfŏ S2g78o0' H`o%isIV%lj]4ڔT /?VwJl%.0zb vem+Rf"%/I7 Apt5%GjB.!Zr+'L|N#F4ִ͘ ])X_UGntON5T-eݴJyR.z_zB4׀ĩeK/7ZlksW..R*S5]}h3͍*lS5YٔDɲh!7r^t 38Yg.noM7MCs@>勐' .ģ*BHT]%⃄kEPqK"{'փH:w^&0y ^s[{<6xm5e 0S6|rw8W_Y35'b°h;Rv(J=ppqpup":Z$O{Ai/|rp)7nx@GWV@.n=.n.na8((gC up|s;;_<;*tGヷw$!T];ow$L$on3o3o3y֙{+NVvH[¹~WFVu( KWooKlwnt=.unt.unZZR}|,eP"+ghNڹHޫGù¡ǹ¡׹¡ڞ}ZY8 3$K;(0qJ.iig7#q0S~0)]Xqʺ/ R3K4oy WGASR+u 0pϕ0phSVΫ'LB%hS7 NQ%yFyEsCg,̆^;Ъ;0PNa=5TJBCt>̻[`,b) j׌֏!=}z "neN c$ǃ>Qq(z.IKKZyR] 9ehm==|;"k!$SOB]lRj<9Q'_O-r&~:RU?uUw hndMm'i7zSb X=} %!G n?qSm(>&irAu*(VF B |21(/O`x9x]r鬌F^ ~2,p&uT ޛJ^~]d,ʌLIԲpOe3p;xiAx)8ÕHLF+mݒs~2 LB=wˍJ \֔ЀLZy*sz\㨷K0q;/w:*" -JF "Kmn;[JF'6a*;HhB5lZ \ x Jm[Ke':Uݷ^L 1hdMz)Sy\XQ tdnd/2-*p|Vnnd.!5ɨ '"&GSȅ 7YUWʿ~ ࿞oDV[ƙ.)Hf6huMRst,7"$!+Zq㚱̘NFY@MOI7o!n0n/HMI{IpRdXs.)X4Z:wK l7eO[ :͜}52Zp5Z}v@coKi?R,=R1iMk%<%q5cƵ5$O[oef.yT|m%/,8a]rYW'b|kuM#m6 / qXBi)I(vGa6,*]h>]LBPZ,Ɠ(xZ*ujhMu`It)[BUqV0i(ח>pT2+GfRC5p5#,Ws1a aY\jQ6#Pq*5$ԣr'[odkHa&M(ZzUQq $c"[m97 Ԛ 6d- v0d1 ˖]h9ɱޓRB-FTj}cTV6 UcVF;=I͂ENH ̲pdxHp$TxXp¶ s̕{ NB F'R*c*Rĉ?\0x'#d;}OI*gΨ!pCBE Nb3S>'8aqfc/:ޖ~md=ƔQ)5(Lc S/V F4EiuSpU=Icv"Upl ى6rSZ5m\n]ᵗF6Owt^'TbVjTR:wT-7H}wG47xH3Mof %;~;'L|Q^h*.'T-]F+0 < urw |Y Un=)օ1_0 |% #frA{-$wpmyk+?=r@2eNjlߓ7T\,xxxU_Dpˆ<ԠJ߮F6S,ha\~g2UxƤw(!Â&NLOtFT5E[1 TpVp$uFWgo-$O NQ[*.E.%PiQš&lD|+jvX.hVu$Ν> UD:\oƇ x\mY~*^})KH$X/&%4SZ2DL>X2MyTȷҐX ]hUw;vȌIHZlB}ipu~g?Y7^q̱!Қq.<Ǭ;76yJo4ǵl7`ʵel #TeFP?OK0'Ǘ%ƹZ-x*ZK 5/!ǁ<%Jš J}VjxDM!ͼEm{~''r{aܭhy;'TlX&ZGB"h.VGF˵iݡ ԣM%?lDr un cKi 5𵂧&c'^|JpɆI!xZ*oxSFT-W 3 4#Kr*O?#xZe0> g>i }W/"/+xtL0 W'LBC_S*kc7F pK?PU 䯀-8a.o:P5~G=ː8aDB хkf_<7FjYBKs,<Q.1Ix=;E$7s*. =_-aß픂GZz5~MmB[~\*#Z:}ߏliaSzQ. kS4%3Dg22!3yqBp~ИF&+ `v!$25qh=Y^B ե. kHA|2#rXX&Q^~QM-^ .|)ʠdM6H8H-^$%oV7ީ'e4x; .~5~;x:H-M <]T!=w/]({:܉E&HI .5^-cRI.'L%HS>ēF*ioJ,{q-_u e:ZcЁ/VOT2zzR^Kp*ҜLe,0Fjw>841ܑЅϘ60mKː2+(Tw L]$xJ*(k'R$l!uP<%b W NClݯլ"xK?C ZZi;noNY՜ꘗ6Je'bndS Ӱ;VTf[5~n =#0FpBeJ/0C-O.*}bVZ6L6-P=RIN )>R~g>}'X-L8z,2TqS?|{;vBNˀw)lL(*~$o&ڌg%a &>0k3Y7af{M܄Y{6?>7u:de˔Y*>`1,nk9B \~f _*LJx"1sc86ܪ]惉)v͆O m(QDTV17a{aTq{'[6CX 2;Wg<+CO]%ܪxzj즒lhW-Yv|BjMQb@kyQ&]l΅Uń$(T֥V Mm>@M(QNZv@#Cku>^UJ<>!irYZYtvV%ݜ2[li!> ߇wZ*sm<7y>6챍)Ә_چ} :<$Ce?]9m^„ܦݦS],SvvHЇOG?*V3ʓt_ANO/Y Fm(V̒3UcE}M)c>n[%UG ugľ՞  /(X`@L*e{w,%*ZagUH_~\jpNJ} }+SVzӠ_P7 ꋜ-[7m޸)Z͛H/ _3?'P?!ŘZ(|SYn0c烤BUt6NΑa)i=B0B;4*Cx2Ǹu٠ᛕָ;ۆggccYp}  x>fx2wo@CŽ8ձ43L]L_߆-RN SO)S̺V˖MÛ;Nnj`xS٫o>.uW]^{#_L9xQæVTy Ʃ}*>Cd,2`<&(dõ$._0Ml&{&n~[<61Q,$8 nǼ6q>6 uc -u:^$p |*8Q͞!i/3GI^l&c/E_^0%bi$tMҽ>){9GЋբYaYg:Tvʡc*>C<.s\ LURC<_˺k2cj7Uy?fŁ]ZG6u"˺ɢm#rcR= IWϰxPԋ*s{C+Zm:'XsqOH K(u$Ym-1>۔F.O(@_]QF.P4§@?߹j/ۯfYm( a3OwjͣфobnWh"|b.W\S M5* ){`2?k,> i{Yg8G&w΂]9LZz)Ϲ>0& ? #U8WMj&/wjly+43Q2Q(sFW V[;M6Hv:Ch :9R!ۋJ弋dŪnz 욍~*jdeeaPUHB+Tm" k`N ;@5v907FV>߯-XpQgz@nC7Z -3NatLX{|xGŊ`V \|q'u̱*: DbLWexDJJ٩%i 'FW(MhiyaV۷s1={>yU.M9gXOfUoXyRcVwjz9Zv SbB&͠7ǖMˈ{0} ⷷ5>kZB߇T-6@)BvHÖ"R 7?KBY@,U [;BEo@0;@ߑ',IU7!apFFoAom' ٮ~(-*ȇ2}x$hx$MDOZxfu)S17c;H @nY'#WjiTbȘ#X_?[O#{.kɵvaiyJρgܙ }#cUTس``hpxqhxu{\P Fzjuʸ-J'l74[HN`'κ#/_|*;⥅VcQ:Ɇtt޵^+I2ԯK҆tq#/0^:2렪_gkYrqd,S`Fy 76:dJ85#!*cNg%p5hiuE^/z> p+-Q~rzD,"@w![b^R(Rʖ..ծS8F2%mrޮPQv(Nw(bx$W-<OZ٫it ?{&N}+_FcsBIw]-A@^e6yw!=c)МB jlGOĕp:K׮Gي8JWK;OÎa 牫]>}##O>8z 4=:& ϰ3 9>Zukkm3IɈ, }h宸tҴ ϪY,M^g>Ϙ-Pzǫ{v;zF9G^h? lpp7^t-_lmmQ9xvջz-8fpycg^Q7]Oh4\?w}?sNj~FL"|켊2|ϵka#b'@_jƚoɗlS S9F 2ҋ~qY#ƒ7!r7J׆5 6葥G&3B˲9$Hxq(Gn9V!Q8`C" Gع3G4B](PeEk4:\%C!9P9C@ !\'p=ʂA0%?„+F ۻQm OOf]k“Ooxҷ8b ` l|aydO7 =3it:~OShLlJ:R-)e 51WKw( /OuN%3/2.fnlǐR/o~ bfEN5 |W`{D)?U@&"ƿEbēt FځĈ_'@l#7g Ė!uUE;߁hý(ՠCjz'@?ok7~bx7~E0i?nk-NV+PRI|u 茲n*oA'Gb9̸V2bVk DM\e0\GoZ.,V]t^/E]T{}k~]#Iwj}Ԟ^oZsjmF)6ҷYb- EҀwQ&`Rdky7ᆉ -$@;vE.)OZG'Ս(pKt 1;Э]0՚phWN:5LWόQLqӣn%9A%v'~RZ%>窖)!#׀{h0tb7|X#>؆pZׁcǔ 2rݪ$ @_"L`lt(AOǶYjaxUFbxto>tMA?YmkjIi\؄$y/AxHa" .L qiʫ8㛙pʤmh>ΰ'i=A6"2-'*+:^ZȞItkQIk>9،Z#J`P$^Yre5c>} s>|ں}ڵZD#Ǭ6R%3R oE- 0cG|eUc$-mkIIӯgD{*)У2s 9V5B/x^NhV2DUve0%lmv[jqj\1g"Ku 5fUJLumt-iJ"c)(hqM7&UVO_gu5tCl$ϰx)O6=ǮNLاse1 Y]s8;~G49"_kE &.*GqLRHݿqh^ B9X5hՔI2}l NXyOUX 5Py^9W""ZM" vN6[v5}X;4᫢k dW҇p>*Ӌ*j/P#Ŗ0fUKh? ץ1E)~}\バq䇀4I OI*#ItJ$iN2U-N29qjLSvv$7%R GG)d=_4S~E+2Jy@O*)TN{*%K&:^RY~t~myɥ^KpiC/p[q`!Pw@ѿvzX>ru6*a b`9mt\"D!k1 ul'uӄ,*tGs42!;] N4Z"7erG bp^X=m $~ӄir0zȌX} ^&OC.4a-_4a&qq0IHm"~N*6 ٭]$ׁi4G 0_! cš.M_Ĩ2fKMu<?e[,Z!U=Y [q9^u0ĮU[q5rn&y-[dWUՈUzU*y^5U/^5AK{UE)~{0(1K Ǟ[dwٷa4a )UzIN:SOƹ*Cp_H=:}$1ORjr\V՘Dza?I6XTӫմ l5]勲*sYm7C`yY{YjuO ߱+(լ>4޹஬,%_p”kѯ i wݔoed5{e?$f6#O <~Lߚ|&PnnPdAj^7x=oV4 DoHo򝑵3ftP7+Θn䭻b)-Mq[W} dWm6#iHӪSur$lez/8o-/N' D1/(kC׹>I+_ʴz"7@Fl\#6kEs|pP$VƱӄjjNp|-n4aL<뷬P,c11MZ2B!~ҫ]=JA~_ , SEp5|wsRor0I[` L 4a m J+W]IMUVʽ~iv(KS[ϑJp@oQZe(bGE؊}grL(ݤ>mhck|ehS$ VԱ^5=R\')6ۑ8(@`?6e Oo6_ L ؔiV)cKf6`Sn2!(MNi بdNEn jnՔA;rTۺ8izmݜn_: IuaMscFm S2sdϰQf԰48j(fmy׼ Aq o)W-|@ YA">JyuNhNA{ݔK&M< zgl]Y+I1z= z=ĸ]b-E9rsF6<,Ľ.2ˤM%$Icv-%X'p 5$-K׊k听 n~.>\2i~ZnZ2ŹF2nOON]ׂ~fr6k^}-ؿN@<鷍h;m2FBNZk5Ɔ9[Kʜ?\p3c ZkD5x"ɛ8%З7wbx70}I/DN:8ҋEo7ԌAKLnߴ^nT&)7A'o;aҷab?( jT3ɚe!8%68z `O˼#oSB3(4z漮5 $ ^Yrx:=0gAۤϝ'ËiW@_Qn$do;ӱu$oC> Ye4G@H:<|V 9 zX|snբW6HMqšY+ i0iZϗ/hס6mZ7_>YPQ67&ZbE QJ9c;SCk\R~ <5,?˻ou襒Qv-{;]MT?<'N_-$? gƺz|%WїZ*aY$o2%- j|$˟ _o_qҘmi`Łk$7X֧ h'w<o8iBQʠF_#9MJw. ]N*r.'Naӄ1-vKoiWب8ҏM'nt)IH2ftϣ3`t&\FjZl9Ӫ괩iL_tmt7:=xhxF;Nӏ q08}¤Q"u?OfI kJvA/E9ݦrҲFux77^`}x$|E\qh%uxb-t@.O,n'[@ߢ)Lmش4g;Bj*ya}7h"m{off&AW!GkH#<2]NDؿF@< ߑ׫ޤ8j-MuľMx7+m[+ bѪkiʴڙ\V;Oc1Iβvhsjf9XN  ^M&2IJJI;xM9-b}B Y:b&9*jSUQ7|UA[arV@?$"_N{)8I G6R1{ dݽCR-ς2l ۢmR7ПeF U]HKb,Puӆ3sof=xckjQ̻aޓmÍn9 MKouD@En BR?C+GUYX=!!cY*Bbw8z } xUej+!ϛo;bZೠϮw*K52ըGٿwh_M͙Q{C@|B|sbU-UƽU4WI= Kks6Z,E|3W,â䴇'M2'n'ۋڠmeei*u9&!4ݠS 9/Y-SX|{v3C.ڈLԎ.9s(2|h)O ?04g`ΏD{#v/{bQTy,gMPעEb& I]WOZ8D{*!6lCSsU˔n=pM m}"A߬mȊ%kZnF6o V&L<)!N`t6ݛÉŶY͔$Cp7ʭb%YEl O>]}&< Zl4~EϦ3cAM'a~Ψ d}NYլ̻\;$sb&`AG't+0{V 'f߾}; Jj .]Rr @_]]ɓ 2s SjAړ'[ý0Ⱦ 40ְS'װa{ A O@d cmew !sS@5S?̩NR&c3|عѓ&)TZ-e;2$;a;1NujM~qUQE;qo}EM 9FkYBx:E3Ũҟgc7OwY(1EClN(rC"#YL 2d5 jcJ2\wCa ^-ϩZ!ΎWjwaĿM@H!UyRj2R 59Ro,h,gb .N sʘF{J.B@?Y+~x*`[m#"c:zc-~Rn| ^5Z4ro3̅Y*?004w8|ʺg j{AFeTV~4Vy:zn-プOo]/;5VYFWd~ ޯO-KG{] %#&>AsT37G&_"Gp@4zjx'ĥ$2ҋqY#ƒ7᪲r7r۰ g.ؖe_gL7C˲9$Hx(?t&_4ͱ( DY1Gop %׈u"j&R/=^B;@KM4ڑ]![[Ao:j4`WGVCld"4=-am`#?×G} p/8?WhD@S]HA\GvM*Q$f~c'ԅj%N圈^AHCà圴mt:0紪BU@n{"9nn-5_= q-J=yscm"m 8z(Mlw%6 pxivEfg;[xmY6Pط o%8KPC<1kEP as\r5K \ײnvn-H/p;ul=.;7Rģ!wvnл>_!{ē_6$W:0zeN昞lɞ(^ erҘؚ;iWKE:Ϩp(zDT } s>|ں}׮֘yϘUo2l酥[r u`Ԓvȗ0k\b2WH rHF]w*$ѩ21gDU{*)d2s V5qeCꧡdK4f)o)s퀗Kn : bEپZv;-E"( $?D$v?%пԄ!"_Gћ_+G,Pe%:@˯9Z ôZ/PDz`AHNSXlg{lX뛨p7,ih@TD< @{&b7nzr)&kxu-i'@BV}N|_HGw~\;iDB+?/)GD пj~5_9mԈ<&]п]#ρ$)?U/T_]L ro#/?Oҁ>Ay mc[u7:ےPƼ6`OtQl{fۼ]W[P ŗlZ(I2hHXgUGW0륨uC?"vpZ컈Gēﺍ7]%XBNZky9'Uy90xJuZjb>e:#N}G&h3vKT"Nl][ile7KJ_[gޚWu,K!>%ߥvA>.A@/!M[@Kmu9Wbɳ>dϰnwpY*&<r4}5eNNʡ 4Âge}+ Zn MbohEҼ&oJ>"v7~sluC#z+li6ȩ-MF~ ^=7@#~MߌѶo }h tfUDA(BaDRW^[*Q^[w k|u!{m^[e5Vjk^R-I+^d.V]^[\LN1szI1S o0,q\({~NJ]ٮ$(@ꇦ+I #mRW 2rJXWD]:$ݕT|K+IRa]Ir\ӕi=xW ~b?o@O/?j1Jթ&iVR-I½r\մ۝.b}{LwI7A-n+ޤ[7t{;Vx楖ȸ=m}os)ծk'[sÊSԊƴՎlc|,w/ 5?O仈XQoJOWAL~JS2rHǬLHZ$1T|KcNZa;d.1k=wYQ,kMY O7KmOĭ'wGŭ+]Gj(<#E`QP apJ2 ]&o-,%^Rc]K;?6t=jvaV,pK8 3lx*hkszِV@ Lmk8:Я8s; hrڙd{(~c/b}WV+Cr;[6GCg:;z=}e=aOݡK+M  ̂VY)nTٴ2/ k ,v z*IP9zӠ)w:5@) :.M _,dzQv)-}2-}S*ZooaLu4 kߺ;cJ~rCw 8K]+p\'Ik dQGK4\'MR d<HPR)_/V`^v.qr,%g2FHG!i" Y~{<[ }Nt(k9#AN*H%U]\5T gQ9C6zm=Uo}~jmD'-hclNa[MĂ >.]6|]N}xV.:+nrK$A 2_P&F+%Dj5dB>ZbBYxM YK 3KugYAΜȁ(<mZ\ j\1ԺJ%"EvLR]er\*՘^hXg 2Ѣ~'ailߟSb!K d菽\? ӯAƥ*CKU"RdN$+%ܥ&:.UY>nV3ikN)CӵqcgkeA<O{yVo3dqOE>X.n4"/ϗLk*m9Mmݼx cZZoOtdyҜf̲53p$&)r,i e0sMiY(:k¶Oz2<4 WVhbн' mv oϋ`?LG^T@@Y7E*IcσJ:~3$? gƺzh_Vݗ:jrYJBIoLJNV W*|נ:V~&Ais9Rh,f6%oC ;8M8쑽9MJw. ]N*r.'Naӄ1-vKoiWب8ҏM'ntԌ/+-AmM{2gΙVuW/S$FINTӛqݿ?nQJY6K ZܞȓbE'Pͤ1M434oT0c?2^c{$܏_V&F"2"jUd^R-~9i5Dfi߹Iw4u[ P/ wVS\l 5wlpMP?3 j|ikeEe9"m4qb*Ĭ[X]Э !(LzczՈ}7Dx h+pL-칷W !5^{ f)f> GNz^=733<̃+NDؿF@< MNط WkVv3{/ J\V;ӎɬv;W@ ߓ"J:2E+jF 6ؖJBCK/)2BF`_ۏ ~{CN`hAa6rE0ոٷ0t36|0Aޝ5US&M9͞eGcuKN;g[E:+eZ d5uZ/"?Ivhӷ0(!j3 ~`oWҜk;sFy["C(!X@4 UAG,'FqoFw®6XJǀU6 i%`wsb+-+gWA_U fRC1f!l_ |ձ&3ԓz{wjDo>yuN0*&s⺹9(∊D/(ݴጅ}Ervo#sbU-aUƽUw>j?Ѳ%v.Xv:&f1]fg^ ³39 4=C˜,^l%A,c1%u9&!4ݠUN5Į|sM"e*68pwpnf]=9.Q_-I^c!R߁} _~w~EAK]cObڮW\o4Tg+{f_z%n7pStIF,=(aQ GņLBMŨ.> Z*| 4!&o ۔u@Bw 'ؽPWfށ=R-yA\(Q?wq˹PŅ.$䧁_{b o:-(*<{pI m9ڢO\ľM@<{u 'f,c=mDAJ^7<-4IH ݣ.q~p sN*xp+譲/N.лVJNbݱMn?3f3]|Ơky} d~HiwĤ5#<3Ea,oӠVfOLn_ { K:{ނ$0+y0xH?E]ľMxM/W͈'سZ@<1e۵] .yEѳ+vd y=[^YP#adOlٷ2Yý$ynj$qd)OA2­ϘT$M9bJ4sr1>n<{Ȣxw3G'S,+2sfVfX^ hO:fs ]<g :і!f1n8dEs貝<7 Vy?x*sd L/Ljk8,(e3,9J-YB+\a90;sodj{ /ؾn1ߘ jAveTlH0窖f:!kTA\Wc-_*|DzV@:ˎEUz$*x_Z`Du.y6ӫPBf7.Z^n6N"k`>n%^yOYipRrA Ѽ{Z \zX %So[ a[[y䴴B7 GV7ET2&7a]eM髆, E(1Iz \z] :iiG >"je94%]' l#TbGP+[@Ku &h= Gv6 9ґz:TJj @JK,ģH=G*Z)<1qZ}G*"[ģHE]$u --E*frQ,wGUS$ ttB#M{{vh' U.Q'ByWj4Qz"ݗΈ}x$u:8t:Ĭhvvݛgs.֮k`Kmw'_Hk~ *{QEt t3˵l xiž`g)Vkz|CyoJj6%MuvC7πb[ڮv 3ۢIUhefU<#x; DZӄԷOhuvN ^z/j޺e5׈d r0^2[/+7 /\f d_C9M4aLm|P? |ӄh;7ǃtڣlyԇbM'aǰ.>{쑑'=y3:& ϰ3 9>Zukkm3IɈ,P_h宸c6ex}VWֽ+ѡ>*_xTbow.ߣq\(h)ͼ~! 2 wE'ŦvW +|OW~-8fpycg^QsVAcZn}ח>3G(0?Ӏq~:߽3;Ly?sZ/?Q`ӭŨfLo,ʟ&_"Gp]eYIjCސ^85l,y8\VV\C+Jo,}p,f F ZesI rhFQ5m:o0`wV3+fGx$/W+#)O[ZU qy%x+h\;e?GcljZ[dofIn~jh^P>(mR-u͆K'~l}{*tx ؂Dob7n_ FlIRWׂ^yy9 KHx[K%7{-Ķ;hΖ4tV?t lC'o}4$h$)}kBCGa2 e3 iWWnjd6C'a6ޚFcZ"@k-CّTۀ@K}à7}#(oW$b7vjv"a6on%|%|VATAנp=hP$^>%ty!+KA' t:7tn?Jk춥7*k p75MhL@hF">@V䫮>h- 6 :o#O6HPF@<1kE" 6Jjf т=k@tna=_z vSg=Z;CVv GYM(m?zX^Xm :Y ĝ Ft*;l-p+ʜʺnq3g!v@K5hi-6c -#ӎd<Z~"4j95]-@RF>iЧĮx=>?+ =0KuZe9fo5KҘ0EV9>1`ً^0|8}:i]-1CsU49̸V/F1N7ut<}767n)jӢ| 7М_bMU@<7-a/ՁK :[Ζ ?IL̤Mg\!-FXZfA( C $:&Л*AOtwNG)yQ- R'9OŞFyZ`t!} w9aPe^JI^v.v*=m9Ρn٨ #W}w32QXJ(UXvԩ3G@!7%4G9=PHRl\x\d@'YB?].dRܠlJiP :a  W5CA% ϏGz:cZnL'h 2Lo.nπEE %flsJxY8Q|Kn+l$ r34 m6GfR{O^>#FbR?sPJ.r]+!#vpn?i8r-F>@%^L/4XьaNL72գMӆ'ze~˻2պYW;Mꎡ%צf6>={t4ػٚhX/Z }e~A1|ҟ}%Kd1Ym{,Xm~2Bĉކ&hF4-gbfBg[4a=GQd9s_o8.Rk~|f@}uu]߭1sN7|uI!Z2M1{A7jEiWW-uI1_c$'#wm;Ju~Mb4I3=aXtd3Vm 1IP%dǔv%zoEI0[Џd;.p6h^%XFn5_%EvTW+ORa?9qjZ͛<ek7]e˧,:<@6GXI[)>fx3agDhc=. 0fE.x/ Mx.JZAU`eb$+.RV5Iv%ߒ肓VX.8YKtZ6Jle__1?~xorCFn5_y%ETW+ORa?9jZNFb_VC5#`%lfI:V4M> +ni|ϺWsˆ?zf_RNQJ^AG>ބ dC+#ZtzhIV/Dr]Vzo{h(۴hMrcs v0\)&Æ~lzb">`ۇG;|9Y`[{I8MjZ(FLjHgR#]ԞIjK*%3%О)AKLZ=g3ReFW0iEt s=.L?fix>T0LT*{=.$EʤUM=zIŷ$zָ'N=#~(;{PM:c+,P=>(QF [C\-\u(!=(4 v^{ckntfC\O$F=;Mq89I}@tU H^x/.LڤBbOruq\I^!Y7m;P]] }̵KUoA~*֠J߷2յ 8zic<9wvTo'z. ><[PIЅW؂- re?P&Fî|&"3 iVKf&UU^fm"?C]] NYf q̵Vd} X:>r$ jܽ1_ҖT";vuFPcoV;^I1K۞`ު1A9^tJ֋~YП}x NFp5^Ta^tJʋ*)Uz0coV{^Nj1KM \(MF@&5lJ'``MP"@,'q6]t0iOW~ʪcUVN+~IU{@*=Gg@y5{$YA2nLHZ}(=$])d.3K1@8#vY+Tlx`av{Qyh]@1:ʓH&tĶ(k1\m!Vw!-cՖuLo'h7C?%K*N@+/][!YO r;~wLFampS|NʹޒFѤj(ufָwOV$~,Q@׌7%1v[;f߲s&Vw՜LKr zaJ##xWaՁ2"ujqj7Rwgr];Sgѻ3Q6;D;kukm}@<1 ^Kb\@)ABgcǚQ5wRnda˘I \ztb@7(~? (I.`7neeIA& v6mד,$ςuUS r' /K`O #a)B7)]% sQ ьY ^FPR\&*zSr*r]b~B߾_y x5?Sڲ-g sbcme=4y(?m}osAfNk41dضAN="<釞Ъ =ۋcdJ{e Ğv_ ' 8Z*{;Aǟ\=-bQ=x=k tX_O"uzƢ5#1:@(oi4)ŢI[Rs>9&)7A'oaҷab?( Ÿ Pԭ[0ϩWν(HF֔N}ѢvL$Nݠ uLn0 :R8*}$_$dO@)TTɴp륅:Lp Ae_'Ѕt`t1imJ\ƪ^Ь;e?nkȤ_$ qfVws$tZBįQD >uп ML?o6x*P0y6o@KejouEޏ{"&6H qeOxbq7V4  ![sHL(*XP)qǥ w]T{9Z:bκ?OT[7xسXrql9Ͳ=ͤIV;gh B_&.iKKa1]OA֏q0Ճhmc3^ b9V2x52$&PBb< >&]WET{~LIOmqAeQ+#6IVn 18mT|K⢍8H#~]p;ĭ3&fF>",JVoU. s@a+$ȏ t:M|s5wsQ"MF}H灟ckx:g8th1IB̼ðdR|JodhZ^֌K\V:vh5p`!;΄` дmёIT5[6S/e8's^xfG7i hٴ$n{ZyӄQ}TaDOb& I_"8OZ5FvFaӫ̰"J8Dx [9gǎR`ͣt/g;Bj*yjv@o2:/ E::y`_L.BB=0Zz3GPi Ozkģ,ԫޤ8Vx]/o0+YZĬB9Xɜ=ZQ@Amn7P>Gץ#!K bb+v&m䨋A蟄E¾](v$ z2;k𠞒cM@BpHfO2QУպ%mԎO2a5u "?IvhӷfQwrC~ X2v?wޡG#zv]0Puͨ^D 6b8Zͫm9m Әcchym`  մQfV{`7ǙuF :rOa|U”>aDn0ERn Bg*MjvFqoFwnR&!΂M9sߖ3*U^ y|37+Tǘ]*}-YVǚPOVݽ_<:|B6io?7о+̡N͙Ca"*69xڮ^nܫ ^ Z*| 4!&o ۔)n.WO'"8 qԦE lTGZMSjz@@o-\;*(`O &51ɤjs~/h@A[N+T|BN' n`7s.D.5M8 z8n.[KNݭ-zAt]L\rRvR6X+K6ؽQi< mh,,XFM-= ZT)cnv-> xSo|L[)~x*`[m#(v=荠o䟭n| ^5Z4'ro3̅Y*?004w8|ʺW٥\P_G?~j/o i1KX_j<-_|PWP"ˎEUih^ӕ$_ u\8z摂OCuS FQ|CXd̬͒+/p}-"Ϛ:JLJq H̜Z \Zfr]KިKnC54Q_' EYC XWӊLw-:ôB7 GV8SvLC;Qv.w)TgzF.Mht--UTժХot)d]UC([6PXU[wԷNB-ndk|e&or2%zڨӣiY$f`p&ş_J_GOx<.薹 Ee ]^4p1[Ym7s dWys<:jVqkͰS̺>a ;U4'?vc<'.蜛0<Út/Vh9eY&u'#~ӳg 9,*e6&G wOg|R}H~~ǝs=qAh? lp*v/:/6ncJXQv~n1+fϳ;5ݝ pw.p뻾G9rmF̬ 8EyekB,xį<aOE5czcQ5Q?-Kuchh_eF%oG O6誄kÉ5 e~u$Wiв,c5ɢ4$^@+6VOnZ*E8`⼙C" Gζ33NBeOKOKh`r,} \ײY,t\z}rP95`tns9C\\ѯ[7ިuľp'HْܱYjsgflG$ڍ>}EYͳٌptg;ntyv|Gk ~QF)Jarxpp!ӟۓ.89nR˪RVj O;7z2}D#@kvb xh)ϸ}DcC+U (Czl_o#@ľMx!;kV$ +)j[g%p̈ܠ[XW$g`^dZj66Ņ+; x7crkNB#Y(+^н7bOe#7ښd2BD :kA gMWcr%ת[1 iP(F]>G\_!anh=Ǥ[FX?pR9@KI%%&梷dO10'h 7m 7ohnK`Z;>A%RpS_NؕcW6O- FGV7%nKxo7oJEo7oJ̥n{7np>5M0M6ez(!X'p h 8it] x7hqRy4VVi4}D!ېb궺+n>,E{I@?^Bk> '}w3o_>&<[BNjЫeJ鑈Zj;K}ZnzG2}8yGàUG=G@Kڤ vQЏ&];1R6# '}'\[%dv,:-_ 4ݙ=?s4nS.픃<lZM"ghl>ZUu'uؘ)H^r-URgv tՇؔEK-p2ɷk7~Sc릷g%2VubԎD}%_Jc!vsw,ē~Dzu,[u׵0>_q50FQ?k tgAMOv"$@?|'B> /!'iCځ 9bxw>r{1 JaRBN ̧$2՝+% ]YZלvՒG)4bXZt %jiZ§1FiFFcybV$ӻ#,bV{A7yI|n7Sn0 ~g@&yJځ? I߃ە ov :÷"}Y,xsB򥾏H|mf*f[+WqU[+FvoḚ̏In4Ds0FSo.hZ̎K5Mj~3+%cQɘ$ V$ʳ tc#%`W؍Dl뿑ƚ둊I2%u B=|7(RG}j{azroGMI v7? 'vn>&8-QSS@#څke6 XCCXfvCyR@B§-J:ɷ =ؗl;`w$&$ߦQ~ aL/LM8vտM󉡰zmTπ~FYvXЊy#MUvZ! |3.HYBH<f6|3&yFځHߣOm+7z| :[gf7dOl'z06gu?NRQEZAh ]wv&9j3؊'@O$ 'AO ) mJޜ`!ɐ?kг7r,*S'Oĺ|W%?JLH7Z,zf'Z6=ʿ4] ]UBPtv,vg;i{$? %S;<7^jZ#K[8Mj{[S:j-u=vNM~V*Ậo#r0龍̣l8MvFw1x۶q#QmFn(*}g4xҮnxx$[˱lG P:тvOViS" x'TE(,+CAvwBw5nmn=,\u=>Ƭ_kW=X-c\V3L,xz5Fg{ڿy'qNyOca<&w9 qO)v}iПN 6KO? Znђ$Q?L_ _I"~ұ_b,_-b%YDň|A;-tl׀ Oc,u5_dbTGY@Sl8Tssy1ivV̀ⷛ M;;qǻ=2u [)jDJQO=N)`ӄ1u(JhN*E9=|[NtD;4ŢKG~ӭAutlTJG< !i˜::u;V]/9ضW?͂ 5 )ryI߁ӄih cjI*E١4~qc&N*TTv;pۤ#f`7ۺckGCuobRӜ&TLmrz ANz sK3uɂ< c ]jd=X9miBe k'vooEHe'1"K;BkfM? wljq H(ue꒾L{Aߛa}㠏'+Z-jR;= sc%')GB2cŢjnY/(v=$/~C M(oӵWZkWF2y}>} s>|ں}׮L ipv0HK_O/@Er_/_a M66򔸹KA:^I3I7gUQ%dk5{ v[ I4Pxsl2D[4Og=KYC^LRq[Nga\+iq PfKκ('}xQ[""ǎBnuӏ{uPMx+N m2xvA&B!=",dus0RwqWjKe቞w 6iqYbaYQw8,Kv>_)MlZ4bZi^ffe}*h^$p|5~Fi\okz;i1u>83i&ríV h0'&fSʬ9MW>owN;m-X C\Ȭ@ۤhַ~vrT:(OH[۴T_ۍm[ W [mugBhǣX>&.͜1F ؎`WB ۥEWi):G"Y_ }LynbCf$M ̝ y~~6̜8߬5q7͛S^7i8PQk4Z$C Ŕϋr:^lRľM@<鶸Vf`;4I/d,*fF(d։)DZ~0'L.e]hP:aICqQgM)w꾯rw3#V"$ kEHO '}Y$ksbu %n0tM|f=\Y4Y&j FT?>&T[5KRu}G;% zkK5oCءd7]CءDFУ̖p;haL1}0K@G֒}Ymwߑw 'C~/؞Q_MWs X1i5$ 1"́`VN}x$ЉUY+03z.Oli&1jDrz"-ҕ<3=vlxVQr5\%4^{QR}rDη "m{off&AW!H# >2(kc.C>ñѕj{{G`?L9waX6)?Ի{^^&ĐY_u՝_6/ӏI_ WI[{k&Be0j~d#mX-z·vvk0Ɇ;U7:9:HPX2Jو\ufдK pl =ׄ? Znwu foN{!v> Xb@/sR-A?L1w5[wusC{sfP^D*oN U{/sRdwN* E_wkmQ: 9'm+3R%@鍟qGǡ֐F-yqG uh޻P͠!lC4v`0[Aߪ$n#vX6`/t,6`tIݯ"do#'@KmnȈo";M;O>&V 5s؅{$գ@?]uz:vq8z,]sy6$}Xj w~P,pzNȁ)35NAxl J |gFHO Yw Ң%hi ?xU/WDOj9}vqFЬ^D} Zɘ]S0S阅1\p n{ Yk{c1 pz5+LD.}(OjC8 i=L]"un!\K:; )΢1*iP5&XB'2Jߠq23)9Em1Kr 1K]qVKEI&Q-|&pu #)cnv-\@wx/@k?z~{]ִkʕ#ϸ3Fƪf8g>,uIJ_lԪ1lX6U%C6jy_b pGL}Z0נ[|[|^]¦+|ٱŁ\IE_O-`3z\lM~jz;(oLY2xN!XzgS3jGB fM]JzRӐ늼^2F=radVF(ʆzcRQvA#%kfBI+ǴCo"UC!أ7v(+i>-ep4RYj%D=ˡm|ճ*Y2Co"}{bONe0>}lvqND=U"=Po A'M^Zzgx$W s 'fl4픸RgRhjQ•[&}0_+!]*鎼@51x;rAGKsnj]qgirt:inQrvo[ysa ;.>{쑑'=yssgXә_wj-:5ǵ6¤dzzLwPrW\V洓 Ϫـٛ3=}1[WK%v!=wra]4Fn[=ڎڢr*aEٙ74{O+fϳ;5ݝ pw.p뻾G9rmF1Y!3 p΋;*>d=׮XF~jƢK#K^D8 &H\IR@2ҋNwY#ƒ7Ar7r .ؖe_0fC˲9$Hx("ݮK+T!epE3+7H6 :d– jFн2 k_+]G-aEk4$Ao]%mH71QTkuO4hNky೅25KrcZVR3!~kc4EvBv9az5l3Yq1>u譝p $vS6<+kRH_Ei%:4,Bu 626 'kd$ 3hd$Y4.4D.4.΍-]JfօEo:2fF<Tz͌3fF}^ŬW]}m'd}KHU6 i0 'Y# "qt#TB("u.ݠ[BIw#ߑMnUVtGm$`tNY3=D4`n.G=L-+yL,{@ߓVGAY͎D8< Z~HP1A%sA?jNPn1'ģ! ];ЏGē~/ 1^x%dvR6%ʹů h]CM _Hi݀D"oZIi݈tcMZ%dl5 d5-6 ۖ^; /p;[ 1>nLÿN*-amC6j#7݈@8 zVZ!"i zAK 9;@#vKY}Hs C2 z'cm~PR>$O*MHZbOغYYBVi{1?N!voFxvncrrTBNຖEg"#:tpQja6U׶N}+%h$Yr˄Th'B<|Ը.Z'B> Zjo8IO·صēOVf$l-~^!ԝ4qXK!11"f,-`D(QyyJ_寨ވd)'@O$IГB[OTwDMW?v/ '}wt3gպ#%Y!;gѱK je$h-yvJ mw GQ;546ixx$[ˊlF Pz%v~@'䢯" j;;$:&ЛgJ`#s#a ڴ 0g(S[%uT@|Cә^F`?"Į8ZnmdIē=o oMԞܨKje|Gveވ2iB)jp&)w;yS %̂ΦoľW@<雲5g50Zk2fyih~\dcUUg4c`9й '}cޖ1W6D\噟Z6G@;ĊM?noQhGbbOV NԊ\iLBNi61`''`qHE6lwhh c&<Z*W<&ēao1oOܰQ {;y{2]T10vvsM3;aw&jحH)`{ -,d' fa7ղIե/ ;awœڕTd&ēek+Qn{"!W'PLx[]ۻi0! mxvG6A :G3z-JwF7.a2z$y+'=Iww&jmgN8a|ݾp1j\ֵԗֵٳ\͛6k+W`k׮>J]2+I~ p;QK@o,Jڑ/_qA, 1$w^3?$%$)F[|OX݄d~U&Tc!_j^% mf oVƞ2DMS61Q;O]0!`ilm0tԮvg]i$I;Ե+#k?-ѵ+*R׮V# YҸkO]:ܵbصv`vbC@5]{d1zВTaEOpj`Fws"*: a7net%- w{aIxtB$L@.̍$G^VsLYoD@JG5{/j:8vN/L;Km[R-2/j|ղRy5 <,.S')JG5mV̀fZB6F𪎵8ICN$nIПLkj:~ց?0³:Vdʩ#JcY=9]Q ^Z oװ/p.8$!0~R >(hh /uokmoAHGuOld EYdAAP EtyDZ2_Vf?=п_A" (yr]\䞖ط G+N'>OZܫnp(4\}FH;@ߑ|&v7[Gxb=aqHR)QzJ^Yƕo7-Hʏ /8sKN4AY]8&c#/ W Wc._(gj9ݮz 9 ^a5YεF }M("^% r uvi|Bg!(Lzcz5zZA0Ht&~ѲVn;Bj*jnBn/AhxhkpqL.BH#|'yΏH}30p`wdG~ =K{-~q~ΏIjMdyzUdQ鞫ROP4 ˮ9_$#JGXnǭ#kNaRؐIH)ೠh.~KkV@MZ$yxہρue)#Ղ~ՍR1}WU\HBB~u_Ow!v&L߭үγw ۀn]?G'}x$ue\q(HjRK,; ?X5%[zfra(PDېHbjmNo V&.!N`T 7 m+~h-Q}ݠw+}:8<L:vxv1⏫i5㦇0wOŞ7o\F[4 ?w}36PySV+a-!1u}-MR}[^8[rh}wxbV۷өB{V'4t4vPQ rJi1u 4#(8Kr{^p8UfN*aY`O?m?DOBEA/Նq Tz64JPY{!fЛcw;PR>2sfV6K(;YR P.o#]8T=CŖ˗nIazS tWz'UMJt T)vTcaM w3V-( }(LE:b}.~Rw0lzr!lfr?xH_A<$!|ez$.wj,x$Xt{KlӕuB 9,Žy&y'Bb|9a{+\$L z0n5d*o҈z{HQEi mƛiX4_Z~O?;9*2fl (  XVH{n1HzcgG7bn˚Cr]X>\a90;sodj{ /nQ.ӏje q AJJMMUܺ҂*ogE˧zqdK DXԊNZfꕹ$zZ`2AĎKG%/) !ydꍺ6C:I[%ľK@ΙSFɜY/蜱Yģ^hQ{ePjLԨ% [Si GRm#Pa߾YӴSXEAj0T&-]+]fUt#΂etݽ?3Ýf sy ]fsP20 7~s܊h;7ǃԿl<5N1z1Vpzg=2䃣'@977jŚt/Vh9eY&u'#~ӳgt¦ex}Vo>{tpylo;^-݇Kw9393Eifox |w{;EUŠ3S+v Y48}Y}ԭUИֆs>[ehAm[Ys`7p=2 . C2n/#msq⊳V$3YD>WB8ܯhI ׂ{R 4^9` {f3?v5wҮ^`d1o-7nN ^UG:9b7+c%6I{׭J1r#1b%?'ʪ/v0wēgГs{ms\WrEx f~Zf13mE >.ĥyGAM߼1o]0d{:yw1}Q %<HBjmT +JuEOԺFT^RQE2o(P/[Q9 G5P,!Ї70gBmڦM '}/%Lq/gSc˖qp;J\o#\zu`A-,s )Ғ IT;AZ.zcBҊ|Jrw]Q&FQ|W*1א&iBjqW&uNյۻ4Oqx22Jp1iT> b| S/^OF|L0|lT.%З`~ }{'#I77%lQ}l|S"~ ?. - ~H]BN`WK퀆"ӿR3}JVΜl1 =Z㮀<TU(U1hNWA_MiCWmsLikIilFs؜ly$do44g& fNLtFt4*?0OSi+ǎ7-΂Vc$o6eucpvo\:+b$];ߙ"?" խܢ}LY-3H \R;F5-Ϙ0|Y洢zWX[ud ~Nn@o 7bo'& \Or G $$=>۫Ϛ.39̸Vjy i,zM`RM%܆|K O8z*@KI%loI%Eo [`[i s2-a.mI%loinKi-vXɶJd'!Y'P}KS\Pٿ[^Ac-~+jꠥ5acoľ 0;ms0;hs7;6;`w4i `+~k `TBN;[0ȸ>KÚkmz_tY*1¤V:ӆHo5f\f<]6 H g+ GA4C?& Ƣ%p9 :X a6,fs6L]hHֈqdXޤLwς>+>l֩їKr rTE[x;+nr{xIfBm-{xpAcy>3y2s ٺV ih1ެJiA6YKlUg=/wBFz`;5?L-32Mj LRkb+kk$̟_*5FbWc!k$v߀#Bbē~D[IF3E :# |ҌY& ]A* IsA?j I<~HL u!2"j<$LRr]"$Tg}!! Zj,pP`Ttk;@wB\ ɴ5ys%v+-~n2XZzQXKQGQ1bv ʻX]Q[͗T pTƜ{8z.ՔwӵiD]I |+ @-u:VgMӚa kViSɚO&𿁖ےpHK*75>Y0?Y0]Yj͢L;!z]jc:Mj_5vz޸)cU}&~ Z2Tɘ1NʝS~ nUn-?)N_\V=S링i¦6 ӯӄ1J "H u[æÄiaf Hu͠7'on%VRa$m}3zd?CtTxتj^GK ,hqx?hͷqxyutI}\⼪}K!RsgefHyyu: \mIEtt?!YmfdQѰlF4 q$7|rnxӠ:j荔ox#y?+Ykm-핉 odk5dǽZ0BLG7roI𖴺HgԵ iJXgNӘ17@c?9?O&/@ǟmh6^='ι[b{Јb?翎h@pN.c挜̸"N*r5~×G<)ʶvNI]9hiӄ1-莞'cؤXLoJk{'9ݦnRt vعQ)/s0 aW8&KQ IU4 tIl(:EEGg 9 9d A30-._`vP ;y U ^*|Qt zM:E#٢V'ǞUY+h]Э !(LzczՈz"NV~n;Y: {+}(x9ۙRWI`;@mgA2:/ E::y`_L.BT0Zj>$H:a:|b(7i;!NnKS]/o0]W~SxbsӺ3m6v:gc3&]%SGاYm6W,zrN 80Bcژ.'֨^sz @ݖSlXDóԳy,3Ȑlm/:CJt;AS%y߫PcvGؘݓ -Ղ4h,PԳ#kI}k@n5˹ %Yo)Tጅ ۠~CD@=̺ʢtܶՂ*I5 7 -?鴊^'-b7 C8 zT]y֮:Lp8׺Q{ܛac a΂Vy>4s!vsйgWA_U׹ 핐M7~s {-YVǚ[z{wjDo>yeQо+ڛ3"*$ꇀ/~!^ؽ"wQTy'Hh"meOKSGsľM@0~ ])lZp끛@oRlCBor7LZkZnr; dKfb%YD\np@:fq'p`:fqp`oR*%mIJ JX ڮY=\}q VoUV+a%4O"m:_8k4ѼZ@<15ړX-!mksLw(L>K$T㠏.Ʌ"k{52S;=2ҝtsثnVceLd9\?)2>+LD.! Ym;@5&2y .'Gmز],hff^Z6gϙYm6j@VsxR Dzl,2C?^} T})sU6H?V'e a=_\(Yh/!rf*ր9lQ?A'Q`X݁;];KVZ}5Uyc-ޢo0^h0^>IQ$J \#uH6eN)aurG6ҨN-2Ho7W6gG7^n˚Cr]X}^7s`wBX,;^?>އŁ>3q /h[ANeT-!dEY#dq 5uM勜⃗ObG̊6\ˎEMņJ/rw|j7u\8z摂WENWNW/|!EgȚ;5%cW^ ˍقawSr1HΠY \ Zjr]Kި'nC=ͯUBģH%2=mĘcyq.id\7H]Kw^^A˳ *$<BuzWj„e?'Sk˼Li/ Iu.)80-6i5#+/0#+ԍ #H*&l.Wys<8=8jVY%vY'aǠW|GF|phftMaMg|sH}x2۬g Y3fh宸i'g^U)`ś3=}1[WK%v!=wrLw.`p7^t-_lmmQ9xә݂cV<,w33yVuk;g4\?w}?sNNN1Y!3 p΋;*>d=׮ :0J{$'1|֋P?(I S2ҋ}ײF%oCen5, ?kl2|~dch/,˘CM(c=UvMhpcU_,3*&Vētd:Gߕc\Vj#Yje)dᓍYl薛՞lE}%B(l)NLZT2ф鹡B] }wJ+%tr}f[jcŬeoKZ/Ge#ˢC:lb&`W\qhxxb֊5P aN%,Ij3ZƟ!d>cZ IvȌE`yw64$8ݠ-"6i}?&} !mbۂszB,],4}AGi11l#=R%Qy~ Бz#Io rSFZ jkQ/Tg7*1אzjz\kMwɶ,u51YK\ܨوjdKA}!tiڴІC(?'eBmIWPaob? '7k;_obx} 9 \ qJ T[ղAO륪7cxߟ_4Xq隖g8Es.4չI#$ۀNMtAzrmԉMw,ge^G@HfO56#a,~GwĮQMߑ '}G7:g%d'prT׽8>=3Z-H=ӳiG!!0BBM\]3SQK1x/xIlxIbxI%x8'ߋ{Ouߞֽungj~={'0\NӍEy*-:KfXt؋HkAe ,zS;M (דk2AL+$CtbʰNyh͏8BAT1.\{ݝ]#6 .FP֒uhW|Um?rPKH4{S:b=x-eXCޏ:C )DLpkN`6\vx/EEh*yɍ2*=&<6Rxcj OPG@M:ly ŨP^'%ֲVM8kďUY׹1r^Lvn sexJhzΕlSR.T 7aN1Rًi+ڹ'j箦OjٻQ;.A<Ʌ #BjܼQr]ʻ+$ceiJM.>TYOǵa;A]gvXuX-<7tiMB] ş#njQ?UBI؟GG*7Bɥ1K魁#zK}(<ř^ܘ5ߠ7ҙyƅ-Qߛ/8޿*z52bXVZd[RqVWtӐ\5ՆH6x_-.!pɀ gqVhR] 1QǮP+]1ɖŴLcWTm M:jnCp67"馲T#smL\#'9WPTC %aNI,HPhrvj̲%vBH8Q$s4v|I9>α/j<;4zNk`vhtP;߅*&*rd9⯖!V[m(L|S_NQlTV,O:\T(Gક$ܢ;iXee-g>^rIdejȘޜ"uHb!5FTceP+$LG"QqjKUczp{n9Wg >N 0޹6o-cGOJ;00f\ HIBj".6@x5G| -2Z*eZ*PR%](-Uiԙ%t[pPEîjMm\Q@@:Ֆu|d8ԣ28T%4-PPvѡF{ZPKCUc`WmDD|i1 !38?AQߎە2k{9ď"F ɽ)4Ֆq5x }.!_t./*E{t |s?~r>{]˶ѿdI O(ɮLw5yY!aJh54BX!+f#2Bug)`(wڞ#Sm(ӥ9ktelC6l*ՆVԆM~Sķ75_[6'|_e2hs~k2մ9Jh9mN'jknk)S[sU+ ,URrt3\5u:F{Z!KTcGp7 Ɨ4utט3DGq``lSb29r9A10–phJ:q#L=0ޣ2m54Bsd|z>\n:EsjDJѭmLKimLocU!Hax>4fӲf̔?|6Hc{C8j݃0tY|ѩ{&i(ɏH~Nol?a2 =GeiUPK %D>XhD{R՘%4,N_; ~Ƕo%UĉcwmVADPڭ[ɀ1uw%m7C%+g2`^Uۋx}KRjrW쩡쉟UhP(cOP"Sm)2K Wp v Ueڸ24=h20pkSukaԴKV`WFO[9'g _=GLOKѧfjMYlˉֈ+ jW/3qbaĕh 2h=+$FՇs҅F$j0BYO`=˗ޤ /kׇaH/o؇/jLc|6ϡ|nyG_+}%G2x_%4z_%:}$},h\䟾.E:e#lcnF.#6ȕEB&*{D&J5LiW%+[fZ5p'&M >(.&Aj͡GX,\vUVuחXR9ٍRyL\1R 2ĕHjh(P#)BL},WjnY3AՌtwN3\g u~ sL\W:P:PvLP]grvpj̲)[>\Jm>mmɺ/"9doq%[TB#J𦢥\n.Tb:S+BJ~%xtuLK]=T;8w55%AM~d~ ]#o% O L39 :G΢.X8鸕=D&JZT?>YK'.~8lb _7,cҿ_+)>^?wDF-<;6zȣoo@ ۂaQ02&\sjyȀ]LtO=$χ@&#a_?D(KIϹ"YDM@"5,N nODqCdmT2NH[Z %Yh05G'A $2`̠|ٲJ?2 Hr|bR/fJ2Õ\}1PA4Pu_#!dE VjY!T+3آpۡN)fVDRmB(Wf~J[{<^&. o9![*[KzK%:6J&[&jo@r2q!5oM[ވxɀ [SoFoM[*%-)|e٧U22T;xK5?#Hz嘴< <?)C\TB]l9&-r^e٧U22T;xK5?"[{Ka2UxUoFR[*%-)bK)odD{R-hӜ<r1ǥ= cLޏ|# q5S vs\c*%1)P_d*Y7͚m0f,UR:,U)jj+HWI  W,q-kB_ ㈯!2JB}5PWKPjɦڦ,. :kH65SyM:ܥq% NE#Qbi iGWŻ/?@Ug 7wI ?D.ߍmEd|!$?_ -[#ffU4=[cd7eL\qSf#>&C\IܤҸI %ѸI>-ȸ)TM̒iŚ5:y T\3~?郈SLΨYG:!Ƒ*֑*$H#GdD;RH՘eS˙x.Rܹ c#>d+MC]gexJh$p92n.Tb:nI=O-˙VWsO.]MiIPr&kfH?'qW0z3ۘir&&I:j/gNF|ɀrO:뵓5o+ K3T;L5F? f]w3pa8p#C\TBC]>eԄ:o]ʾ 'm&jLrn3^4ݦ)O1paOs?-C\TBC]m*&6|{Rn3‰vɥm1S x:TfMA]& =W5CrJ ;Muj9zU6>3T;L5F?!j] {L\NW4jJT 5Npfrvpj̴iND.j){&B_! )G2xN%4:RG"a&8թ|M-h\#m1N7BY:~ Q)6xʾ10b. 'ϊk"&S#'#Ai&?5v#^dqs2ujhVڋ Y^2vBt::T>:i,N0Ͱ?=x^Gӿlymm?|^Ƽ<,4_d7.9&H6NyjIv1-,!exGe2E5eP6|ݴ/cٌ'|U $!~$ zM\:WCqVӴ}2J긒{hݿ]Ԁh:F?$cjj/5EOLJM*oE 建o1}{Ϣg{EY4,Z2\z 7Wta`y1#pp0$?!~Mc6@51RN4f}KcAPu/7A"k27guҔv'1S][}=\˹pup$x߈<'{7F<;N8 OĶK[}W/$ ~2R}7Y*7~:$(;bʛ+߄򛔙DYnqs~⯠+Y?.ħP~JΐXZ_ycoʌCtX߇%X{!/#~( }Cҽsu=**?t`Bg Y*אh;AIǗ4zS5KwґhAC4@n<:k)cQ*jy-@$]!-ScDQW{dTCtC%Gz]6sR3L3 DMvr3`®E\K37Pg^L|mNfƟ3 %] ɳsK@@Dڮ,A܈F|]^|x_);:(e4BB-JT#@J%PZRфj_RWdSmI]FvHho-f2ٴ6kZ1=fm{56*5]r! rf3 ݭ'Nh|GP~$_c9fi*OfPM(K 9Y *;z#~ )TVŇeO!*ʿ*Kx7(;vfOv{IcYt~+(Eli߯z{KnݡңN W)}ʘho(mZ?DWU]+m?CCM0ds>~]Nt$x8pIcʴ;Sk_kXdG|ʯUm9m|1zw.ei GGܱ{#;GF-G U8cňdߍ(q[H4v17PM{*NZՂ%1[ʲ3 x S*HDC 7qZ!`"% ArQ~ Au؈ ~& Ar1iFI+4:224DܻT8(K# *?ɷBCti^7i[}c}EMZА u!8 iCUKӆG̩7ߑkWe>i쁲vuc1eH3:mi㜂ƊU 'a[ D"oF}? {=miBˎwQwC>N NcV{ڣya[Ph/<afypܖSvUZ]$!~$y\:0벌C,3+n@?"r[ n!Ay\8/ekQ^0و9HqbD7O 1 )U vuh4Zensk%>Ku=Hg YP7?\xEh[XRx C¢ %|aQYX,B"᠍nhX8P-*@5Dr&\-VIE|iq $ q *ã8G\Tx1Ni+U.Æ8FB!Q++ߥ0ts"z`V:rT9_:+H#Ek ?1f xɩ:-vjLyHIh?8WQaΈg9&yNsV`] y(K`֒!GFN#epn˼UA/zPvP85 7~u۸PmL0 AmJW]$ŻtJO. qk8%1p6]ծf}d'sq߆,s_pWTt%9ݎ</D9""qB,2^Y˻;:zq;B6+k_\kC[0.ĴTpyѵrEy4~i'ci'Jف@n`'+9ݯQd }١&JuZs=alx߅9)c0MxPM:c"CK[i0nY͛brr!]̼$Li5&u7\ؤ.%hy%2Gq^`DLP >xA#hn-NUÌ>3Ux2$#M`Ɂ &^;Uy?fsTJM\Y@[P?鏍 sԡiF\0$ #:vt3C yKW5Gv"{=3 RƤF$,\r-pʫR2uL;@Q_smjeyjc$ĭqat-]h8n٠'RYi$.*_}u3Dⳃg! woLkzəW wDT?e' ;k eߓ6 3!m4@Fpb;4/ru13J́G?C})C ΋ܖ ݞ;E]0ģHotd(ZY^}q{Rw&יe k8l<oBٸą]0W6Lߛg8t2PMeK{F$g1IX+&Wu2= +6`WXUL eoW+(__iF#k!B s'N/Ip+9oͱA-oVIkB(JMU8K=  74G_i&4O7_i S}cS݃ >m|Q#i@t L;@yCӵ|Dm|m P1U ՋΌA'[r|g(ޛt g8**obT :FQ{#T7_nt| ]*Y2&$XJ~,Л`G̢HByU;QdߊNT߆T7@ET>ߎyT7N!ڟbdF&o\6!\c 74եc#b H]=*ZP ?]n,3̈{1Ք%~c2;ρ)#[;f ˴t#c❓9(ߘBiPMi)11mښS<"13~$8@l!֧ tWs#H~rZ1EDLpf><ؙ٥ b RYe?3{7iv*1qpǣۙHDʀf0iƏ[ UԧP+a  ](D02'!Q>$?H~Lscvj(lQg*I jDaG(}Gc2.շrܱ (7o2%An&WSe.sAPKנ-C sw88cz9pɼt.9eӞjR`F Ŵ/9zm~MlRjoDj{ I2ڼr~~gQ0#|61Pǻt uGF&Rĵ(KQh eat/Hokt[7zH7K5AH'}(NÖtK'}^Q$e,E*"t*;jF5ÎV GR+}sjaM٣ߎ2uiạ[v{ dp[qtսϯp9'lI.g;q};yoF"׽Lv`ƯڽZ*LiZwy_3X*PyY\M k_2=-G>eJ{9ďd$.?1%]dVK}R"^%2"CTDK/EzyAkUי1LkLg)ż#G)J>6.Q -ꞈ{ "v(Wc{njp ݣmǰ<]c uU+6i6D^ǗkY u>03̄ ]SW &g(K ]5k 20=<غyei 4AVO;'[r^;HZ Qw!~ɀç#<ָt٘FB X!?_A ~}ލi6.Te4BBhKQq *&ӡ#WJ'Wꘖ¯kM66׵9 ͧ|/Q a "XHK |.֡-I#lƌhΨ*7K_%l K#ú!DgHD^iG 5~^tiuhIsM6X f1hf<)ytqڜs5cvBNaHF~$QV7Ѓcvkx_E%Kwж.vn {ÙY,Gh5f@BG.&gkܿ& t29+M$kFӽ#ziMw ftӢ 9y$BӃ/RphQe. 8fҪ3ݢѹ9]0zlDg& n΅0Y&}5Ge^([>c 96WWIi|fN w K n`)z fwFI.X*v6^br wvP&_;$ :|lZ_c]YT[TLVÆ\H fzXGpUAr%5,l.7v,C*)=. uj4*g#Ƕa2T쭺Utuӟ谻Ho69M0 !QX%cbOK;b))iVRėW٥T=WYi7뵇bX'qㇴ{Z2KaM8zb᭒~Y. بI+?Tօ>DC ]0 yj_%t@L{$i9&m 9`+8ڌ}F,SSJ8 5+7fKw%%p5^1fTL<RYoB{&ϕipٝ]ofi9iƅof_fe2sb8=f&vd3B| `!ɀ1MMsBÅ,58'0ש# 8Aͱ m֩YN[&&`␳d2sY=|&v{#ɀ]0[gr xSӀ!3NW-N ˙%&vYt/"].XŦuZwOQUpFN`w"S Vف5;"rv}%LQ1o}B!/=rį!2>Bvy+cj2oڜP:ߪVN66k-r_Xi7nGy48>~2*VoAONB)ײtPl%L}+&|Y&<1">ZY+6ŭ/lU'f.Hi.'!V?y]xԀI˻LLc7#'qɀ O;!OF`\w@ )fKF:G|ZLWdӥZvh1Nds] 0\-[dqJhvJH JuIU&Y,Ѯ2T;J5?h}6C|mLHY:zAM$|>|H}9 09o!**!%di$!'dD;Rd՘&4tX:BA`v4Džhg1]Ј""zj%n%iQU,^6T;xY5?ͳŋ 5!rZgrFL1xǡ.f-O,Bɀ §sWSBrP[UKԭ*TJ'*HϚ`="埲1$(ãXAy7"_ N&. z#~DF~U /aN)$K&گ&j@r+M&`y e:Y85[$&ի p8p9| [,w._KYm*2g]o ܼ (+mT٘HXN:@Ꙗc4sƐ$0b268S@8$80wjyjM)c.<&P^l)Y([jz#wK%lF^M­#Bz6$-C<^SkNz̝5^]yŽ &JxŽIJPjh6& ӥRCSPNmFDmIB)MKэCrvhT,9ѠRy(aCK8ę=lw6SV1pAxHVB EEmAPVP΋՟+X-NKFrvh7T8)(-!^мS̄nHtSZ7'?d2qdbz q5- !%H2-h_\|l 1x@"7m׈d* q5R jx {KuJIl:ђvɥa1Prn9{s$siBӔ{ $gI{fK&]t*'Ϛ<͒.Nyno䏇ߓwІ?bad@E.9Y̾b8;bP_^s2j$G(]ǩ )fa1L0M6L# ,VβBBsicܗ7!o5}&⇙ !H|i2jhDs] [F:sC)W(S񚜖^[RЂt-u\r|AcHc+xot%>|L\78ߐ᭦}PB#&^Rv:tjZDJʬsLKo>T;{5/!oeMe6;iv gLT4}߿s]?!z5=:$6DhDRC(tVsn18‘t(Zk^& W@K8ϟ6=ZsghYۿע Pٍ98QFa׬Ct^tH* x̡,wg_Bou#G<ey#$7x僱5y[,=T)({lBc֠6;m58x@}2PQ$e@s u[]8%\)+n VTkS*)µ)F.jL6^I*5dE2J9#"1pA e#2Ј(%)ɀ]{ߍ/`2`L砖ڎQpm.8Ѻo:F{L w?˙ H@Vѯ ɀz˴qA_Ρbbz!Zd@9e2`L^Y?>&!|=YY>iqVYƌaՊ\z ː(0ʪ2Xn q)!ěQ9\c%V6hY%3Kt i1[[KVseezY)K%-(E]χw)<%Ƚ([~+PXluU*Y3^1mF4 /[J2<,ݝ2a&lR6-&eUO#-mtK D%zwԽLq~|' f0?0Se2"\iZM*`2$2-Cd2]RA ?L2m^mBtjRɄrz"}{튪 Ɔ$ѭZxe'ۙ_P7Nn?ݸK!Z}Q&._.j|QJ {|uxxKeH|oi),'jO7,mBVz q >d_~ o5_ (ouJ ;~ux_-S6U2-E;RԞZC׵e>,ZނZ^D=:ϷMhto+⇙fpOsğ!ƹ+uoSR] 7a׮N1hiNM.~TOu7a:nivR4\=)9Y2 {ewᖌ?+]  e&a8ޏ2Ņ/_.C\WVC#+//dQ2.Y 1QP+\rOh"qNJLz1=R>eT).  lp)|+seJ39&S o5X jx buJIlS1ǖT&9Ut\5Uz]qk1[[)GdD!dJh1RFLرyQVDRG՘(oY,.W5Vx0([Vm^;CGAKQ}Ģ˙L.:}@ A&/\ zѵke+jh(X/QP)q}ILN0YOjufr޵~}5< MA"tz%8L^TWv,* a2`L>(5@Uu5-RxP'F.&vQd~FCd( _R thK a㔞/Bu9Sӂ{9ďd=(+͕yd7H-7CT_i 2ـ؏r,/ڐ2Ipq-kU/(y.G\:ɖHvzǶ=@ u Ca{gH 'V]g,CN=#9CoS5 p>(;}>PQl\/G;l35u xsH ՐR:NbͧDkeTf}Pdxt>cx/f~ɀ]=^ɪH֓j0U{e{0n]I8p'b.!]=Br3'n1KӎTwYulW9E:0p7M6mўfI1ǵCj+5FӽqQKg(۪8 ׻@;6~Uiضw5⛘ aJޅ4A]17#>dpNx h|י ؅1N{6#4frcf 3#fP!ߐ8nM'kxސ0#bĵ=]ې-GHn v'CQ!) aq8;=Ý!p&i;ذ t3|n'Lҩ tӁ7: UuuRK%kDl|_ULjl7]MJP.l?#*zCJMXT|,kZ|ބ+i!"$_աA?WzU:0 hqӿ ,i`Bʒi2})q@5?5֞}_:kGeNͅ9h[Âl&?w&Y%Ⱦ4ʧ:K_ u뱕+|,gw|G_ʕ|E*G$"Poyv|0m%UG|e18up8]u'{nXޞ={O³el ˭ɏ1s!όț#i\2$3( mb9*p?":r>B|Oh k{}&wj8RN_ۧ"kΫMmP^MZpY7}\Z1:R]Yh|&iDuӗEl ;ax¹o[rl o-= |&>ȕJxBftAfZ|O^kxz9ďVt>]?Xa"?3DyPom[@#!~5gq"W36X);$Ɣ5 jj{^ƶg%B5/RkQoUkz vCJlFvgLcv(-̞wNkpt" 56C*w ܖ5wKxl "hx%,6Ѣ`a|\nydy:t8!y%aXuږ0wC2g`$-sG͋' {5S A :=zg2s&58Հ\0*ⷙ 侈&=&!iFNT3 4#/*Pg`/h+*I1z?E`! J'e|>B ([t$bZ 3F+$wEٍmm4(|,]CJҸmJ{%QV9W2E|'c/B|'c[%\,wo@P<ND,ʟ펉<9? Q|[x D7[Yk_Gݱ/!~ot&~ (3%?EO A_"OPIwl忏d]4Oj@f$^&v0?Lɀ0d? .0'@'|\1yxLNǏ[#P~tܤFwJH'~?[ܢ=+ҥ0 ;[φk4]g(Ed@E)&?eӵbtqb8pĄ{0P)j1eL]Բp3K0t^S57+ZVu@+MyYx=1즁j44m'OzF g Jap[ƥeA aIZ6 کmXOz b!>ɷ A9p ď,:^َړ!iyi93m朠ыeթg)2CE|x\w9Zr|6?iNS o٨\}rZ:8 F2cr<}ʾV}w5$2k=XI+ފCO%PS[75Z΍=lMuY*7oqʹCy1S0uG^EG`26rym^({Ax<X &M"g΂v8axD*!EYnUtu)a1=qOю<ϰ,8R_!>rqp᪳ -@5e :iH= W( qǩ@u.JF@r[|,V[LciQ1KQ8I^~ԁ:u7v't: t;9kg:Esh "\n,Q+VY ԝ:j$~-8{]K?򇒯Y,u}oӈϠn?sؘO!~O+TG Ge[ni;Gw 8|+(E];xdCvo悽9?)T_$UF@!~MvմCρbfG# vh$Hb' 3υǣ]< {VH2g#Dd[Sշ!~/$ߪ@ro@|eSawCtƭL TӪ*ϯyɜvtn>#Ƭ!:eŠcs2̩i,ZrHRt]R];%-lҥ9iK!,~ekhpJ1iZCݣ5I}_o  B;1Qv=` x| (]NAr@QNکCC;GweOZ:@;c#Y\v"ddY #,H'eLv[_( npzL=l?wIU긜{9*R)>av(_}@9ď\[5/0=2 o"]?տD~`1\^?Wv;9|X3]c;&&'*=XjAz%|?m.I/8)(ʤS8spr[mr7E'ſˈ{d^U:`,ѥf4K?nsj=rJ~`FGE%F˦Q>ω b.Wη J hbOv@r8g1 e MR(KLh ea-r/Cokt[#JH#K _F)}U(RP}h HbJ)RQ]VJ?*?]"T0@se!S,lpp #V+97vBLCƇ oo*AFQ}=^J@)@)mAmm^>Xl-{ת剁nO_ hWK@>?L6ܙ {pngZ$#ِ sR.IZ >G|s0GQ>*jƼ;VY,AzD%c {O1+&o|G: #t1mGjY #/L(;q @0F9\ynL0F ~$+W"D1sr ?1#˃{tN+:i'; .c\t^|^r$e(@]^Nqb j<IB9>)L- Tf0ꙥp;*&vmd.@erFjw[83Ra`D#L`ۘ JuwGY=!-^r%][ 9YQ56|kUbxiZʿb,GQ~T+]D_:_ (Kv-Epx0ņQa %]7@ ]?i 8Ig2 v|W݆pM=5߁{aNMn;$`U QM5& N8I7%s|_z;MK}arX6f[WY-Yfc^$8[LL0/O!~əowŚ3A=Q$&>K019RG8JؚGKT>_ ű5HBck.5R\ezE- rWu W + Հ_򫺣 WǮj@5o@YjMa5`!gPj;jՀ?ey7"~6 [$2Q@7oe!%ovC^.)ӏ `^Kc+܅VŤNr䓪ĵpތB{ &ؚ6[^.L"ߒٴK^Y9y݀R_C&oC|'\(YCo|WPt:PyQB%E8tHn (?}?!~RqX؍n_M[m.DT$4v<#o5|:] l {Uw9w:l9 6Dۃw\η^CՃ! Rn-{?Z4})4 Q *#WH_b…/A Fi..1_E!y6 F(2-.)xw?bqX+9OS\T@3̬crF;+ DH*W"^Yy=(,1 tֺɀ!|R 7jG ! T*!ƞ] ! ㇀)?#ߞO/ޙөZ7~0ڜlit߱9 (6Vـ_ __+cЙP1tc44*]㏴ ?X=l̘%_0,1: a iބf؍>@C˙YC%&əO-KQb&*⁲RzD6 %J&Tˉ~Uy`▉-͖@iHq4!*nh.PC6!LL1&D| 5Eyɀ jFLi}i@=Ysyc pǸ>-{nR;b:c22G#)HgLʩO|IISVrhK0gEW vd2%^Zv3d@e-;(~LF7!d2`4߻V&Ʈ62# 9ݻUAqs6%KK H#&J5w*9mrjb/5rZ!(c2`7R30'iqq J< |\|m }(If]: w5b}RnJ!&T#`r e1>%L$OOLٯdO1nT/΋a \tmU@8OilP|T0Iy5M9^@GҙƥsU;/@5G˟ 5ؗOW:74`^iɂgg}+mV);YWĸ)4եSF}qb1*Wu_'c^+yoѻj 21GxcݪwKWzo:5~:|g3NJ5*n5::>cM.g=>h6C&'YSi0 q}tT|G?j&o[{ ib;[8nW|o-<v]6w;vrwH;^$7k_{5'Uf 6岝#kθyj4CƇ oo*ADBQ}=2<4فS 4smJwP۲EV$$+[ S$U_3ɗݮbtn4|~?Hm3VXlA"Ɇ$\rO05R9½ϝD;o#f5cxc7V`3WcfazRr0 {1+&oM| T{KmǾ]+>PyY\M cN qV;9ďd[!~bF0S7;)*o!D*<l!}LǮ+8 Ex[qkjfLJM^(>ɀ1U1GM=z9y&xoXFZӊN:*l2Zuveͼ5rk&TpSq pj^?l4iQ#C/MF(y9LmBi^N;+M;Q)xc %CU(nmbA..ԋ {"XDVF#|z`TAE&R0<ՈDjՓiOoUHh5rKХ$jӍN냁 N4xexOn…Yu.C\gUB#|E!K*Lv4ə1%&j4Hv|]aV wng%o3 3F0yec47}𒀫=ynW8t ~(Y ^L\p+VさؖS+VNSM{#2T>DtLKaэDrvh$Ԟu=!SS8h]>_ %+_W֕u+ @R.] 3aN-NVD{R=)t?b$rٚM'Jl!|\ds.oxrH\} i/ Yl՜6ss^~$M9ϝ@yr;s}a.`RRqߡ_MТB .|-KGы V"d۷jn˗mFdAaO;V6,KMմXKaH.!V)| ]iΌ:."z10Aߌtw;ML\}}}2ĕ Јl!%l)HhOX"}|L)[oD.<?.C\TBCTBJQHB2bvɥQ1MUl2,%yҌ 5m-@5k GZCzHEo->9cZ ^TGQ-? ;uZCgZMچqH_1Yw%1OsO8 !Q2BK2Ў֜RS(7r(d۴n=.V%ETzd߄B#fh(ULSKRsIML.SO Y9F}S 7ڦP_#2W%4¯q)d($X飓c4 %ڣ&j,7xϤlBĨ*;J0I/$s>&*Zy aL! u]֪3cPeY8ܰQ4t[pf;;D.;Qwy!3xɀ{iP%s'}L\HJE&.P%S∗d+ UP$(GJ$jPEYO}¦]j - O2l_l_$ >{=Fܚ5̩in9EGzP_t= v+zfG!w3!),>^PMa%G$v o]Rf<ģ(U:-'~)O <0UJQw{u(." 9vt%:r30!'Hn ^&T5X @qQgrF*Ji0 xO19`8 QhRFIWQIJtS\:5f?ՂaZmu< פ<%ÒF E|/}# q5nT P7+Pv4ɡGHx]krvpjL+E~7 wGǮrei6k9}kX~l(d ])XfL{R+|v|mqC DEFN\ ]$T063?:c4UfjQQ A(oMA[0-Jzf| f."6zd1\Fyπ=U%3o֊,8㱉m&|F;۱[ӈK޶^Zѱ]c""xs = %PQB#%} &?rb[A8Oi\ PMTj)tא߫MMZƉG`u3~pj&frI:qofd'Mp 4;A8zSZ6F R(2gPh]i~YG{D'O1O5bT:-9= Rم$WRt4pVW# $\[4,vdعЄ]имiɜ6tZ 's̻, b(5M,e2"FC)ɀ15̾u (ϴg 3 mݖUO!hY3osW00~3C!r\y%W brWXE Pomc 2BMu OV+`%NKHD7iߠ4א׺?0,jFQ#6-ш:5;l9aӲź>3GQ>̗ HOw:_||݊x?ox哱 e!( q$7u(^6ksYH.e (߁;՜+BʟR{'Qt| &(:wQZҦ?=ĿFtpޭ =e4mSFIV7%](dSmPgӁ榿Fxp<鹔?<2i*-'EOhq\0AY dc85n#ӓ2 LT缔ѕ(ʲ"B(K|JJ_⥣OM}&x3<nf@5Dy6JtkMW8laq`v]ީ1!ǨZ5 l>Y?LÙӈCs5(|PXjQH>QBDl 侌 Ս"5/ ~o6wC04B=fuEK[UugI@.ʴ3> kӾږ?a? ɀ ?yu2mjh$WO4~S㊹o'3T6z 1%dҪW`ITm5tl(ЈMiLc|vvd@5c1q~7yl#` SxH 8^]-S\o0G&HzրkNM;l1 އ xn,'P~BPѫ'?<X?Vnlİ^pZM,<WVB\8 }t׍Lٽy04ERhvӆM 0mpatBK-W]HZM蚾_Ck )=/shPk%(IlTseT:$0ɚ_s< 3Ka7d@I3;Ծqm3+ڝB ^{pl߹#s_k{a&*hmKA筤VC# v!Ӯa+ڮ+TUU( e*\Rkdd`#EuBnń760e|,֠Ś5i-\_6@ӔlZi-aei[ЈM*Մ(!%܄H VDR՘&4ލk8'1ĨCKš.fͼO}?' 0|8⟒!Ƨ*SArJx UuJVۛ}Z%YKgUcCm9}\+p?cy!zA?L\r q5V <^žVRILM.VOGaX[t>F~0\Me n+N%nNh ^]زGNZNLZJﮚG&SʣASN4n/ڬk`>73\'MlRӮjDN+P¨z'1=%6-?b2E5mpWb 0wT#|2cR_x)SQo䅗&۾Wp)k+ ]vyM9G62wyu F.-E2b|5M V҇RC# 5.mBuj3"jKJJlZlL}㠨zfɉːe5 Z!gNA FGʵ.Gɀ } o5kXTcpcNU ?)W(SZNۍRnpSP2$8“1l}>"M7D^j&*Jv.fk8⯑!PBCJ"5uIf%QKK/Uc-5A6u4KtjJS2_Ɵ3 %9n.lv|cO㮊c1+-1,_{P'vnlsن0Ep#cSScSLN)L:@5af-R5/ w(i$ 坱ɋ8obڀ(qh3S6(sCno۽[?@ϚݽSTr-=\ufX^鍭F?]) e#L|+?S 9}ɶQd '6m+n>qs*L擇1퇕*5'.RS(On>,8㱉'ccxɶ#-kldw';Gyא+c:o>@{ &?ޓ'6SdPvChSh޴3 wH Wd87A7wjiPK#XE-t6#^ʬ8hqHn#u(_[_^̆K2bS .i" 'ѳ$]6P\9,#2J-Pd%%\{6l6K&I>Uy:[Vj#!a#@fM7|~1[uIYZFR,;kM=‣5y/ܿɀ6wBQwϲϝ.g%a2c ŀJG54BդylѸLKhKP9ͭ)P(Nu3-E6 ھ)WTZ ` 2L#6Ǩd;D"d ]y9|~_rD/I1WNu3-E;RT#HpC.)C:Ș]/YL1kg5P>c8b}()3VHt5CaO/?ݦ",Ss6Ѷ n?wrm{Q2pA*hLpn#,۬@黺KGfq]Wl X&q_s`(ɬTm&5tL8ēqjiU6]dSmURgMty@uσMVjQRqUɺgcrF8tMɝfA'ĝhT+Lu r&ۘ}Z%JL+Udӥ=-KQk#Lȁ 5L\r-G| q5R u+$)飓>$+~)K<і5KQC&*r$WFkv`!o↥ L}+@%^4ZE0z1n!f\jfF]]0Dކ[ \'HLUE * ?"9v oKz‘=MO8 4XFN^uGxƄ~ ^ rD%|`:wU Z;E[wQyZ@La>4Lm8`׷~~L)4{[^4f9 Z.g.3ؙ]|5ejF6waB0L>)owiǚ 3qt%[o񦝚UF 9¯W W *^1mYI%^J VKg(˟/"m8k@5P(: .'jJ.F{|Pہx+ʷe̠V7 ̦uI(lTj V4陫TlH@Y1 ~l>,7[n51j1#nlҡvWO1rtLw\ t\g ll"z!C5úYhu/j!/3PQ#d e0PY=d! cփ1R9=3xCN#C~ܢݣ[}v{^۟ײ^~Pˎkx;&oRV ~s `Q6 Nh-k%rp+$!Ell=0y;Y{jvĮ$ԎCStF8/B|g_߁RynZUȯ0vZks +R UhZsԫ˙a<0O7@8Eb{4ʧcWrHxe)`re(:V9"ٳhlmniv>M (AjGGw56{my^08oG_R-F$F/,76b> 6_aoe1@ON3-Kc'O^;#MD0ΙMvyS)O4 l )z.$ʓm0m1vҭ 4mCS f2`_wE3 ħQ~:B|xc(T]cutc} 3(&6VdGIc}hh|D}K()ht;!vm# |K}(M$44@5-qq#98Z^:E•=(WV)6q q=L |ib $wr=?xeQ0],Qė[HEe,CCvIUDIe&eٵtr9EhUoU 7 >r MA_?r@ivX3lK?²SUII‰,C\ZeYZ8e3P^}@9ď",fއ\(["CJ/?r0caY#+ƅ-./]Kɵu8Wv;9|X3]c;&&'1pJCAv%|?m,I|iD]YAɡ+#kLD EYT^T^P=~h^+zC8}s̫M+ܿ~Nm#oD_lnb"jDj{ 1I2ڼrWs s 0gs24 …,U@..薩EOX%m@k8ďJŜSL*#{-pKoTL*#@8LcXζ6a ݯhXՏ*DyP|ӷ\?Z 8ďťWr.UXt xG9/C'L1!~mSQ}M쨆^l' 6nBy^(0kCY/0WOME!PEAe4jS#.oEVe[C Ά|F8sz JA^mLǂiӁ`k'EVv;MC"7EyWڂ1iz= .k3wIR*{D 3[ m9gL\̜ ~Ub+1[(e ϟ='s|J~.ӌ¤LDT!;k@eBՅ+O:/A|ohImkЮTc律ӕY`K:yt6wS307α x.gb&O|KpG*3qf= ~R)˰8.SR4= .Gyy|c)GQCGZX\e- b $w!Z 3= ϰKNbM;7h]CQ]]tX.O]+@u7Tse:uJ?W[aLWb WbG(*}T[š'8t?(꤀](O& !N<[a= t ڞƺ,--igP~&C{=T>PG*"O!>ݱ ~/ƶ]ZcE=x [jC`ۈ+wW\J0sɀ0dqR+95 uR@g-RL;f`+M0gQ/p4~j%AߝDe~V1tN s?d;k50E[0q6W1wA8LiV,S,&kmw]sܯ[ZM P%W(k6$_ m2)qU 4vrn[ *1@5uNo)gOSl`Eyw:WD NeE?bOоъʻlކ^}(KMF d#ތͱ-kG#h$:10 uՊn@'A帍OyY+܏xVhc#y1SǨZqC 5eNl^NγZE?Ewұ=#U<*E;V!/G:_W322B>O>侁[x͚6 -hʳ!⿢u9#W/;T7 #ab&vCyɮf2`Ls8\NgK5&S t2ֳLS2R39#5\.U;kCQ;sktl0goqW¡bFw"V(h;&hd@EZ\RbHF,R3D/2j*{Qb2R=8Z x*3;̸uzUwn]gs]XN n9 8N_ a0sɀZ 3 Li`fӫh*ـ¤cDÂ(9S6IhcLvC:,ih=1WP!nJ cq +)Z` ]5H~j-6H?u@Р.\,! /ioS% `zZ,X&A,~vHZ`UIZ`UIZ`U PS֪I]~05 Pn MݙWy2z$Ôμڋe:^؊VpǵĉX*9.Fh@L70ooy6,!'0k:zKL:4߈Rt[mk}Y\ 8i'x6X9&L8B2~];t),',#F$߄Jc>>O)-mt/ snAyKl7s ~t;'1튗{1K*5#s\ݞ(.݇ᥘyaxFþEo#!8K]z^ J  s I0r[_İY►\HL>ŐaJ!S6{)8lv0Ͱ= ;l AL9l׌k(ö ۊIm1¶T Ht؆,*jieXu;j =ã67 F%O"g@nΛBSq^.v{a c7H~)nӨD)p<8AD`"m@nYYK!L:@5%rVt¢WͳjՀ%Fo`ywCtɨL6NŇ3;MUdmfS¤L3`!s8 j\c9Skz4en` gpn OlAJcm! 7Ynb1_u<6M0r>6&W2'Js@_ KS9p5 P8f:WGs^ |W0+`SE(y6k "㑝-*[37$7LQO_Ep1+6ӻIT?%!)+P"6]3员-[7s zp)#^$>YmrNq#c@nGkL+Z7\5de-;r08%(_f_!~Mc`,?ۣ"Z o?W, fW,,hFvne JtB_/:3{;9rrS/Nz|1#(?}C=`ZrvhyDb/C2i{Kl5^G5Į ~PR,)LS$Hx bѰ1C'c>|<&agЀ~L2 E4^`j6L%qmmC;r̨83PT~]{O}nME7|tk*vFRgjunʮM:Kg6+,km 7S'TRz -Β@̕\X5=Cu>̹ +I8~ j$*faen:HOf(g?'b)~+ j"~ /)8"QrwⓈ_A+ 7PnKNܚmQ#H2̬e2`}˘]600zTt=1 XP&Fb\"xTS6 <]+F7Ƨ2(TXBZRJ̯S~ &Z7r{-\r(KX'0q.LF E4zT@j,vk;i ^G%Cx d /'1Sy&DOa`ybJto `JXfo&]r , > kZvrH߆E(@q U;̜͍sosZT!26-H-Hp3ʛ'"±FzXg X 9mgsY s<+ReG4e lk&p}^;Hg@M#E"߂V*]s2KzQ~6P=5?b[l*hz`ꚞD[kYcpst~Cۓ5+_Flxjf:N(M:qYI=ӪkE`c]@+`0]x37&oj~=[5S~aLTexpAȱp`1PF{BrD{$qd>&*R`^>L^>[LlTv Vċ S+rrw5Z& g7H4FL j&Kn0q$\?30޴ m`z Q&vV96Lm=*pZUqE=Rk7,k!5$E(c)ByUlRmfYH=QzD󪺛A H06^lݴ?x5x0(wb&c`uK0;P?!~MWPqZ?cN+T8F8D˄n xaߝG;촉h^M~{ m.U;YGD$՚tlˤV4Y޴F"j Kg(nL:4[`QjAj0Z'q4.?(&UtynCV!nDYjuAB{h86Hp cB8IŠB#~*Q^ S%)a (KMd'dk#ݰІGQVW"K4Jɏs x֙ӌ(ޏ鿿'ɺqʫ )j>@Zk )ʓ.7@!ťs\vӖ`!,D0$q6iH~;IŤ?fDM%*TX40ۄ8TC+jD+ V%JRDX~. U5 +.n,l  5x1r]J\Md=59#<|# Ոy >?0 eʤ|Pڇx  coEF\t\PWb5ߩYa>v_+?1?G%,uM1xr%1YLNoqIkZ5'D}evx=ttE͒N~l)</){CwwѭUq,bx74s %t'`́%jGA?Ж'@Dƴ#mзQfvӊV}c;haٞ9F/i1ڷi45ff# / Ͱ&MǶh`C}'?,,PQyѱC>1#'?pC^؛&T֓j ۂ&iYs$XЄT' kwa3$w#h?~OЄ1?l%D[ Pv ϸy晍f%$ hh?jA_{'T^x )3YtTܡ6eÂ&LAo3bj?Wgpz2K=$ 4zHW4a CC'ML4aL{t:A&L{#jfkRwh=:($-bQ4&RGT?IlZhvOADܵkӹd|FH)Shpt#cjЯVkP|Iip:{m93T,jiN2S <ߚEEjή.Dπ _)mĽj{aj}A?'kubh&y %i? ş=gn:/I(Lxrӆ$AFo1[+y7p yCbx cY&rI 0cB5l 0] 5@A>a6I0d\X^E9)KaS ]0%ȧr5Osyyi_%2IIۦ~QM.S lH}^7DjYXjszj}Pa2DvVy9$'v}à︥Lୠ㍫Td t,^cG#Gd}rXAQ1<[B3@M@M<@{ *pd261^*%{:ЯK&_ x 49&%d{;@T:f{@'x^ms|mJ|?hQ⡱t|sǀtσ|lVG("|`d"DwAWȤ`[cuћ ՌaSs uϓx DKJuBЄi_JA6IM^媄kxN~DqW0h^ RЄ 15dFg CR96Vj&lQ`n/W8Y:KBOЄjYWk> <%Sz},5^o> h†+ ]Z4°4av1\XK. qAa',sN%rV19t=]*k[Yϝȟc)g;FBNff$&,pWB7'(߂&LC c*V-KBlSt;ˣQ:e&N%ë:Qk',c6_ kWe#&TוSCwD>B 0f-)N5f\,t}F"HIi9 9I{ cJyEP͊\__%mLbo60X7qٜ6|EWCs4eߘ﷣^)A8z愩$ 歳O ؠa60B\XtFw g WBAKL]W$5ē*43qvR)E͒y&9_Є7;MVqWCO$?J&v{'AmKj!CMBn&Eh6ұaY8prݸIRU~(AO&LànM<|%W&c7Iotl A9x'@DlۦG2HK2}QM*菥c~c[iMkbbFy(鷿fxv1#}^x7[s ?iUo%CݦQ)eiF+M^R9yo^wx{,T!A*n k]u"6&LE4&LE4&"܆;bo_ϱgMX-Gz+Ǔ#/eV.G)IE-~Ag⥖ ~ͮz(uH>Av~Ag%_ %!an4" m;ʦŬ3z .ภ3RKbuQhfB1Gݏ~1\Zd+D[DF%q kN/ލuC 3C46/NM<ñЇR04hHЄo-;ґ\ "s*M|]s=Gd cu+Fr׺\Pr#l@?alԘRΌpp)h\LZ~ZЄ)9m`ONHЄi?t\B{)_*fDf7 1`>v2B)H2ZP[IN m^tk:u3p[{i`;WlqOh.f Ypt1gr I2h5ǴǁZHNtmwEBjE,ל4UXUO6."n: 1[u%b8O(av:ᲁ@GIO cr1[4t>MLLqv;zF9Oc5K!__pM۩mݪ-(Vm###v;-8f`1cG.R3VAcZ}nK˸wOiFɥ-=:Gq ؖS9&<>ĂW`D? |;G5cڻ 8.wPI4wARO#b(!^vzu'Va~.66UZP,J=AEgg7zӳ3μ٭ϸu䉽G=(z쭺3i(e;;#!L Y!jBErW InͼzЯWǤ4cwV7մf|'ws_ٙCQrNYԋ3u6t0-nB e{1'T!i;<*㙔V{q@/ښe{~nh ׺9>`-Eay:r^ۮ1zջ6IЄ/m0Ϊk?4a m?4aLYEH?  {aæA׃9aiк\8MӅJi)>,NF%Fpg^Cmb#okN_zLTX8ؠA-P9NRC9.`\=IۜP5|N__t$T0pbw0pbw PdtplɢH>DSYfE /pCnI(Et&Y˓܏f;1ۧ$tqW6YAE8yC|yПO>п{sC6 m1``EKl CUa+lxTger9O&.*YA4Nַ˓ sFM`:LЎh؎н+4amw4)Q{u1igj 4 '˕gUˣl~gXHo_ȳ}Asvt|sHvKHyzAܖLn"[`EЙQ}bVihE NttkH6ߐĨ͖dόtL>0e"L>E] 5FU 7K$jw)GBɞ~K0'.FAܪ;^I{wY4pwԶΔuhu_f jcw];Ǎb֍v|K|yvq U#X%š3ք.dK 9`[Rl2fA%xD bHv6T>I*ahhH r"4K" hq;2+ԈQP͢LFqB,,bH AGL316w eE:ĭ(P=,mۂ&|ix/j1\e)_DȾV>s{*%&u O,瘣(_(_}E #A~q?2JP**T"$%O&u ?4^Z'"ŭ1ZCA4\_ոN%b /qG"e6㺄Tcw{۴lϿevAtd* ㍢l$ [MgZtyNAF" gں+ .8S5b9S(THQB},LÌQL亸3UdwPR.x x\aҍڤhSFD)Dk;g.|XPlCAS7V01}qW^M  ПW iU \ηF;I"{Z?bdOCU!pbϒLy`?hp'%vYvۓĮT˶$r 3dr|"<x:fxtFI'cE!*l 37k:ROf#zq6sY,ہ?8uخe痁 WQbO6t .;XBγS,*1Oy ~9YiMڥIN/%'>J?[U@姤*; 'hIV /3<%)hKAMkiM7 A71/e6[* sJ͟ 951w i"㙚ǂ&LC] A˥4S~~ @_D^i6?ePg!H H* tPyH&~Y: xbJˠ1qRB ^+@"ӱQУ-=WK_ Q` tE3@R_ ؆ |WceA:mev U;/UfWsQ{YEOerZaBEfHqJu 6P@Oxn,L*Q͛Mvxv $y]-_"F [gAA ޮ@0̯k&x;zHe;gJSzۏ{#|$=hT(GUц=ZN;1_2ꏫwc$x6i_1ݚ{Gamf¡Įz̷d"Rl~ XE>Z2Fy{KFN<{LCZ.>益?xViO>KV2tt>(R1Qz^qIsڢ*贄KG?-rڋySnvJWP.X,5sCؼv4fwf:%1O\C'[j f9e]}&'`GZyj(iS6Q"I OH{5 GHF4InV&F&;#oV&R}!cMaިJ:YlVgwww0պYxH݃ &T<^6YKev06EЄIF5&iGF|Z7]Ð4̵&Tm( xBЙ!IAa(7o4aLCYCAib/tdfϘsNv%"DY[fѣ@XNJ} g! PM+L Ӱ$h4#L m %&|) #Z/4KbѲ9 f #ԈtFHbh#0BY}u޼ Ms1vʼnz .kՈEAgQ0\Wwf7:1']kT{^b^ ?2JP륕KG"^:J q]K1L-l΁Ù]v鄘/*Fn/🩲 _+wFm?LWrL$p{]\[^Xt|\m`9=y-_S'hB@^貵);84ǁ_~WE6wƁb.79aL/gVbJY_ \v9d]=ykyV3] gqc5aXeDnVM ~j ,zMf'|DЄ1m]ӳG!a;ם.$/Q Ig ,'oP(k&#PZ{2 T,n`:Aӊ 3;⎵Zo8F,xA"57u̔5ĕ+sN ڎƂ.Cw٨iZl?`2%A/W 5]O4aa9&"qg PN`eӂ&L!^^>#h˜H>,M&Tlt˞QGrѭ} ,i~PЄlO 0 [}3\}݉yaNR@}ڞtp3>eV<_)JXb8F<`m $2>7v c6n@j&uqO٬eVOg a{k1y6jz_ll(ᝠLjx∲\fNxi^D8p$\2QZnHNإٳL9)Y7ޘ{G5J޳e G Ԅ{@]u|;ވBzŦu)rAkX #~=I[Pjl] Xne ۥ-JϡH/9s%!vW"aH&W6&$RbO2uVu4b p@l?i&X"O.k {? ߐ~GK$RPsӒј/ `Ғ݀a6q#&ݶ}I솷g9aEdL3Iљ5hU% xԺ/EqMb -0[w!'v rbf[x .F$NzmdA9-apf+0)U]ZUgߟKU 8^Y6YC"K Zi.4@?sc-&Ssp v;TIA&ɐ~kM%N">s5yW )WlK 6n㘝4uICl^|BЄ1 qa: KO< qA` O$fMwȜxRuĎ/2c[V>1fE[خ|*,gs' .bUL {бǘ͆߁6j3ݬ8a&rәY9%^wFM;3pg)POǻrPfGxcϲr̫?&\ iJY,(uU-,A*Pµ|qA1]\d$;?'hBCoş~B-*7N{g4agN:QUu#2.b~tHg~ucU2h뢁zsnH_KO;h;;j"ESVCЭF^$ktZt:$ԵA_w:$&`%N~q0Z}!v]fTN'x#|1~ST[K?/|<'| g;knW]$D| ,觥/7U\2[N=odەYb@#!n xy7cwr8PI\_lej:_gGT90x95JbJq7jh ]:>1t"i^֔C§*{iL ~פbbhU͎"ǯ$D]4V}¢jذ`N߷y6hfTjlb ."k@Kyx5s}lXk9ⶖF9VFtdLH; . :k|I2ݍ21Q&S~ DY$]+$ut7 3n*-Ӣ+QlѰ2pNg59˫E"2:i鎫z-RIÙJT# Q7dsU)&<)j5} H HE$@_ |RRWkG4qRHJ@bw &+9IK{~ آ/ ܿWA(PC@.#EfPfɭys mG<^ay\qneY+(463 N]GDx hu5lGߔRPfY,:=⛛ToѮQmjj*AW!] 8Z>֑@FGYWY8j~B^b `<{68teٚY+xUk<kݻw(yxl1;n0ݼA@S/ٴ|]@L$-~x1dds/p܍uGCGSAc.@Yՙvvuj;c@L7'h|8ۓ9pwG_o!z:ްk+ 7?r#ǎ?{NuWĮ u%_RI a[~kObvQC5=+IDY΅3;w~6s^0Zf99[{Z"M>rn8 Kv5ntEe(KX1XivgW" ~O"v?Ѐ.!.쓐-6ZE> h{;%ղ~Cx/i5s@N @CM??I[B5T }uB|= ){mvޤv< y@?}&X/T2ky2SLk P cUˣvZ4]IT@˹z !5t0 Xh pLHq@ Bz)bAARw_uTo<~ 賂W >j]]wjB5VVݱc{^GͫMt/EllW ZncدEI[ۅkzR/E9#͙g?X̻w9F~ú;rSBQ rqm@c ִ!٦O~*9A?݀?|z!-4~kluld]M̕˨mV7\:d}] kHO5oFN3xcX(jﲾ6-id^;^:θ6޿ٞbz;i8ea4^f[]%%  9<̆rٶ. 7+M|fuG8;Agam:Og`_ `;g`\S~"S\p,EA7ۿVA7#ˀMl,#!Zk]p c;:]{۽+ڝK@T_F®4a.nոW1pfy>qڜұBᗡܠf޵_ ɼ8ߖJiEq.ûE'|W)kIO:$4`}.(D I'o-Est~[;N4NwVꜶoGWvU g ev۷}+T!<w@'p}W*}O@cT9^*xH^(„Y*4D"/#E% PXNa~_q{ b {an" ]٣tDK//fLWJœ7ݨa¿wʚڛM۴E2f!jO2+G|F?%A?{]f0hK{[%p+bccw {wP[4^*hBEӢGJ]9j1A&ˀMvCO̢-˅kذS9a雑h ٮcF!15m%"ʈXa=d"XY^pF# ض HkCcŏX] ux1#ora A5FqoLˣǥt*v6uĉ *MbGtg v灺t5i {퉿|K>-7mq3%_n؆$[n lRZ\b{?JvMç{G!Qר鐺dk|o?j* 6c6y[b7`b[iYl(ŸWhj;Z5hi/Hm)|R{3NPݏSz#(a`@QPˇdvT]@I;:HAOS!vA?[}W>wB<|Գ. I/;bFA:}ON?@iڴN?;⒐~s/ zs-u=fD? hGY=|IПL"v9\-FAhjz *]M^Zj{QrWhFFDW@@,5}6Vvp;ض3ATč (:DS-"$餒{F@cZ yI~[ (:lKl(:aDx*V4|V4Qxű F DiS+F+,߉yH*Sh UYd3C T4[$4 M<dz$ C,]II@:e=V\;˴ˁױgS_jQtYCM$g/͹TNan#NSبS"Pu .7hA‹A˵ĆMr`ð~z h՟xB=5ưᶺ׮xIڨ2n_ q>$v>|B_eդ$Ś&)"_|+Ub7J.;;v;D}-$~u|H:/~&;oM*˭a xuLoEgG)څ*]L)sMAK?u9cLN=2}n)}KGnZ˦[( 5-5j \ zm*!G|*3TQ& OAX|kVo Ư5Z34^==t֝:=4Z5Kz{Ɗƺ[d]Qp~>o=7}Va X i'++S<`Εj tVZ7,[}qprO,~T74CVtm$Eƿ>#w<߈gV?z^53(ʛk ̺5Y#/4L^AUdVKZ!GV66&竖Q;-%/IA;&rfik_@<~vJ!iB7ޔrZ֦WV؆mrW]N hvb.:ٴ z"̃+ԙgzz2艰tw:#=#qšgmĬp*pl;ΌfW= /laIZ\(鮫E,O] |8x(D['@PfFXPZԉ~I'c+u?"ہwCfVtnCJ1#Bӂ+I*N`t1bx8z,=#ع \:ndؘ8:[-yS̹>n :0}?uw=pk{7?nx5vGZ>ϚcZjlaBw:;LmPݢQ2'exVFi}z_kZ*OwܨdGθQ8*Q WC v/ŦԶnCT +ʶRq Y48qQ}KԡUИ;n[2-~fmQr &3+dOyGG:T|>;ϟC:b@ՌGJ^D RQI4B7 +#}5ԓl4y++w}dIq;zO,;{C~ODM9$ROxdP4wQ#EC\mcA0KEYȊ'x|#׿PqBG<1#5|v:t/`L@寑h{v-p#Ⱥ!.^؂DUЁRiɮsyӐ&Ke]ږ.\D /˵m70n^FsccZ/x6|( X`E^<Pl;՝SCw09J9v)w x$Y`Zމ:`ԴY\D :E5 D;-_||.n-5_9~/-|ESds".xF#u#P7);vHMD+'nq0޸bs\q(n^@<1kE8MTŽCXdl8RWRg}t[I_ ̃Vj:a}LAwǶVvdݯL1 )c7ޟ^o}s|PʁQVzϔCض>~COBasx)!?O.Iu=[s+FѦ&Xn8 5w®ڨMW泔hՒ;*ge aezi;hxy J<| S6^0<|I vgA?~A@< \J m̓ȡEY6[({Hdc~aYmʃXo1{9W~2JSDQ;IA>΄ؽoX2Q] 4h)eV3yIZ㌭ľy'}8alÂp+sGKPRMcb̝QSV\߷ QѪYTGf3$w9Gs}>8Dl?po6F?u?@<{$#6,![;0~6__x^,VJ:po'5&8.ǮZEMkGƴ%~49m+q/ 6eq3_.ڴ6? 7KМ\M.xoZќ6'ڴڰGCBvyBLW ]֬ GXGB~ LXlRԡh^h$ˀ=>mHX`c8:^UWIUtl; emжBLLi|Mc5F$=նHW_ ,QЏVX1TI"+ A9"^kX8W=VVi%cRV!/+S*잗ؒD п> Vremo2-GOϕ)e5mbM_c"bēO;鏉_Oczc"}$F;pmSO bfI1ݨ6KRmjmR)ՠNf}G(*}HM-uxoiG}2ظx$[˅qŹ-GA1ExpJS҆ Xr7x(*Aptx1Τog ypi3*вޔEةUd~6Xvv{f 'tv|aѿR9&sQtb19Fx}9Fo |U/xL(bM!BvT-N:[f{w݉o;Qm +H&L\ 1|TӀN{f9*IO1(Ɋ@r;dtm=W!/5pT OLƀKn-0~$ #2b̒!MȵĨc${HgẌ́TQ&R}!)U#0 YU7R̵ ^"Q YoSWkP-6Iu dulfr5v2G. Ezb(/D2ۖ!"[qh/ӳ]<T OK-~Ô9ft扸=LQ|TH˯s*;ķ`OˬhɢC[UBݠwK;#qJb ͫQyE5-p%BvkAfz >Hf-!3Į~Op;eXtz.=簎ҤRL6~*qC/LhuҜqP^՞2&fj}[e]+fu|5E}VnDU@AfGKgdFK$%y%# xGK- | _nm&#D0*V٭Ȓn5U-n59KU5|`WJ;S_/B/6ę _.#oDyțHS%REvT;]U/49KS5|#Oco{NxOP@4ʏՒ~߁ e/':J1hU#UT?P%/|%ԏ&uq?8=IPR*-~"[RgMSk|TfqfI/hI{cҰ~ )ȳ=Oy=ȵ)xC̙e:Dς3" \@d!*nuWG;TpsoT Hg0n;+Ok6bb$*AKcQ@?\T"ʉmeBEv4v3㺄Tcw zzlnn4acfdfIVzA$idWNՈtf[TQB$1t:.Pgݫvv͟A!!dwܴ6#DƉ*C鴶2";Qu*IbZ;z wq]‰1Lkh =<:z{?׻sw+=,P+]\i(#ODFг3U"XdgN+3̈́M4j_PXSl]|r\pjZM-KxE^ 8}<+ ;'be`{:>Ңt0Q31CkG,3"|՝s#9\`ﻆEm'A*pyXov$zVoU֠Bm㧵HN誗@>NRȣP]cQ\}ĻH°p r5dN44,pjye y潂&Td:14*hl&Aƴ,k(.A*rGvYBA+#CJbw7(h˜Ꙛu'eGk ٛ2 l$6:s< ([2'LV4دYߪ]~"KԹA6oMF+SM >U?cOiF+6|V`rtN6UYhs,l; ׹FDaMQ`}̺SmOP֡i\)nt2 Eۡ[?'h˜FY)3~ZЄ/(.yo 0 K&&\$—+h;Pu*$h˜Jy~0Tbu/FNȸ'z{ 0όW=t!MifޭT,4a0[/loHAM)c3B 0{Q{^P'Ua*c6K/dZT]*&$&l@!)M12 AjPRHQC P2J 0x,ﮢi>y#(Ч Чҟ6壚Mb]7K2\ɬ!I5"!yn5]z[l]`S<ޝ^ձܸS3 |#7Dr<4&#uYs4ƂIÙLǝ[b~4ϸl㰯Tlqb#q蓶Ytk {DZ{Z˃j&qCD7:bV:>0'meeē=~f`&ͺ5p9H|3U0#sହG]uw!׮ScWmZ}ТjLkU(P?Ub8\D<ح^j|_CkL(M4٧Xm#n MXY5ƌh9V[\N z~U]Gd"q;c|y6dbخ"x,]Vc=X*%`_㙠Xr> ~hd,>k%d7,dxƂlsZ*hYW lKA*jYE˒hT|? 0F? ZnnvN|XhA4)aw&`s]](a-䨁Fi1MZ͹ѭhħ)ͽ (k.NS]ݒhJ03&TdI%(aGM54aL+Zﯢ0WؓB| yAYlaÂ`N@»V0o@/ `2~f;|g\Xt s[.'?" C;{L[\Œē}*}Tc_{kSsZשuNfnMXkNYWxm1^ ;ڒi a{8z(=ۜɝ.TbPgYV3jDHCX!sW73Z-N`I&'xy*歂nZ.n@aэ`NzB>elPMbmP5Fb 皸P"xbŬؐ&vCJy|Dx1cuO]Ё]/޺# dWAw'qM=GLAi4LEN٥=ŷ;mH^` t]>ar#ʤuI\zdD#<(b-$L(m;}No z?lyvr`ՠW+3#0kO0oVѪ+XGU8wJ) }wfO_@<05gd$knQߎ9HɻdӮgj/E\j P&uǴYCAx Ff> DQpVO:e-`j3?Kx [70m[AK%gHoa5ۏAA|]";?п}Gm+8@Kyh ,pt|/IJ,+ҨhJy"Q GlmszYycmT @Tģ|;ITNTf~yma~ uJ"Q--fЭ3JHOty ɫĜ ?ZEts~69z-{ kz$y.p&vwsS ('j quF7b#Ya-hJjk#%ۋۏӂ&TH5? qAH^ͮy 4o4a ͎p| c6UH O PQ=,፵߽ƛ6#>@'j|1ԥT&Rd_NKi.p%| ;IDx9w_7#Ǘ6VH-Ľο1M]Y4~Ll=};]2޼FR(b3lZfA$r/\SV#Ft TFnYFrˋ|%1'uqǬ4n^yY:u]|怬ϼ8 恗|j|1}怔T"TdN#/g|%g&u 4sKm#;6JK%mbb?\::9}`TTq\n^LӮ͘i~ _m&#ϫDwHvVRXl:,倗6FNN~XyW:`ey7dywC+r _N?(#D jD+#yD+%E&u ,[ymJ1x~>ʯk f7^YLv֨nA6fva<$̡~XFp%Z e:ly aߨj u r]e+21#;Se֤R();- 2Ge*C""LuIf+j wq]e1OhYuew| cOͽw.=lJ=#:ZM| %>Y7d{CwwѭO'y.څobi4安m==};.o´tхvSccb*c&uk'| P]W_/h˜Gc ^:߯=Lpx.1h$* 4"FW9v}1?o 0?4aLuk,$RWMB9 )\=? 0 %MwdC/A'#0)(Y&mT)L/0/n\S|:bˬv0e|"hnrty1Z<5:<#[r=Cᣫ7s A:^>m/1+茛V_O[A͠4j* &Te69 ?:.ɢz &LQL^:nԔۖ.M*{&LCy[e&h˜ʻoe]-6QЄ*s 0 UMSU-H&)H䩼ۅ>kf*?M._^;oB6h"w@eue:vLCB}BctQ]U޿ƈAݠ߿۟nŒpZB腙׃*g;"r$ޏ?:DbAǟA@e},Wˁe5ӣz|QMN~7)GFo S޾3[ow &RU7Nn{*ҟ l41f7&A~>Aٙ1$~&T`t~\7SFw 0 4aLkK-:=;>Gp7׏@,q7`H9G_4"/\8D>&)]MS=85dz .k6(y+$9A i9͗6Y&hԚifV۱SD!Ga6hL{zZΊ[yrXhto]+٬ lwĬ^kSf |E =W0M]?xu=z՛'CMΦ^b `<׻=8,&xbKnY9`^۟i[&t1zI޽3ݩ"EP5GvY3Xs5jt]f\k y7MyM瘅;I1 V c+Е:D^!Ў2dvYDYgc.Cغs.ߙvuu)da;Ԣm3*=^_|OO@W<9'+B~:bKR_PI azூbkē/wZnbN;׎>7ޤ̾o89,GIuAQ\+Ne3v!$@b҅KwJӲNQ3yƔr9s6\qLk܈~\X4½/4 k洣yjxuj.W\2vh!;yZ*܍~Syvե#"v~ē EPMW3̺jN*=W)V |G`np<4f,*Ǎm~П<V:jW&8u9lyS[!!N7⏤bw 8z ? <Zn@[[GA?|B>Z*œޮkς~Vbס}u=y'4$UHԷ? *@?;' x@hjz *]+ ᅠ/hɺknW]$D52"6Kf }ӫiV!EbJ>/g@;c&]B )3z,ɆA{R@r{JL ZAD'u~|#VT[/)$33̆2L!)'@1ThHS?,LI|w"ct%`tQRz?IFYp9Mes(vYE#?*Sh&UYwIw0aq>j:fxv1L6Cl䠉'0~&=#_.GB@4MeY˞cC,tu.zx>س=*MG݉86lbm G 4@?7s,A86OBOb -.T]C5 "-br,av90 zaD] W&i7M6 R#7kykhC8 X$N.!&ϰk\ YXM|1.n"7 U 7 Vۚ\ 8*BX2{gWRy+a11!1?uA݇hi~O7IJj}Fu0K藦!FgG`WVZX<Q*!l!=|2%[TdlC7P&RB؆n&vK@ {ѤYγ1 S`kpk bY(FFe =~e I4q0O-=Q3 H4uϓA.p7^^_s@K'=Ynɻb nu zrm" t w ɫno Zjs_|@ƀv{M+[1?MZ֬uc,jHZfM*17)3? kf݇eŠM`Ks ZbGEHޏ;ʪkňktl8b}&FPqB3kԴ*xbVˁ-[T(3z*xQ Lb+Ƥt$Tx/ꞶK3h淐-^vs(#,c< ]_7ɏ;# BxtkGrG5g38 ,FViFXe{%#rJT"{^Qի j+U4¯o Րp+譱e]YJ($ \zEr7LG5&ZhJ9-;h}"j!^ o}بtƄgYi7B٣LwEz};?eL qP]h4LEcPV"@[E)2⥒V4,~}umKU-(2r@a{(up,c8L7p֋e< إ9cۃicZ* tq?DԢ}HMQMBv=&ĵ4%.ZA)-vrlY6jC_N+M پ\?Μ6]2셮%=%5<~ФCULuٮaqZRUDJ kB}y\l{(M"&\zBWtgP&{OOlZŏn|\1+kɵf~ir{{;u{hj;v wu#MwYgj}~t-M߯U+cB${[ rD"zr6oxmyǩ]Țyl[КY7g+uI/{Nm;ybϷ$7Cm[I_5(jk Y2 `z;'E唼8x$Po-^Zr]>L^/A}dKK5~S(R͖4ǦXy[MM۴>j^:bCRˏ5 L[_>@688&2z * W^\]5#;g#dm_'¦Oi>/[ ^M]VC>K [Ѕh5&ڂ85-8sM|{u:>^-MM_o;e8j5s5ormܩdϯv!1] k$aS$i U6Cp]b7U72Wk( |#$(&dؽo΅hnuŨ= @R= k2_N! { {6]5PM+E]q.Ɵ!\r"|W(^t$>bN#} _|B^ zA:ص?3/'ba[H\woeׂ,(Emtf޸7me*xVзJWp4/څ0'@҅#;@*$r/W%©E trpx|G ēt@Z&h3؟ {M 9&8%ΔI4{>0ޜV\պ roP0^ |TΝ6'>α)b1 ً6i<3Ŕ nRנ3-1R6 lݬ)k|Q=+ɴ /h¤=+]Є1P|-)5M]s <; 0iWM O0mWM쟜EIUN+'M~%$k_o݈m%ڤVyVxfh(#O`__\M._M*֎#b_ [fXd[3]y@ 05aB:?0"jiSSbyo6[ 6s+na 7'fk$fR)LH\ Z>ȼi?ǯ)ڼ5T]#;PqWb9F#IZ}u_mU!UI8 ]}=ߓͿA)7bQ} \8wgnh{#^/DE OFʧ]&h)Ȯt!7%#x-Z,PHgXW&W}!*%ߞ7fɧ̵ N#Q Sy#YsXj1~s譩o9A7]Dq-GkspwDkeW_ՈQHsU#TTP#K9E QY亸gUdw+{SkѪg!N'EBQeMi̴*M`YTF%f+:Wc^FɨCn~LЄif%žqG/dfݴֲw/d JG>b1nZi"gXμ_+,qHڼJŞ>&lװA9kP_%et͔D𛠿|3%v_~ bֺ^C>𻠿L=+͹_>Tw J #2}!O 8*`H1ZwJQnLHleY+N.46[ڝQFj۠'xikě&G*cFRPfِYtOT]ģHGWWNMM#*dCBQ8:a }b(|7a;!Nng+Ng#2\o活ZElX-M΁okCKhfǑ/*&=#d O/ cޔ-4$f0#v3gcWLjY9R*? !ϫ~T:FR1C@?[9k.FೠUknhԍv{w >ɞs%Q,hDW!4o>{bQTU#34Q0 n:= a}&zָf.0VH$ x k6]a랟'>|2%_/vൠUX%!h]9n5e+HpݐgvHm@?VAk+!͜ZTΏgw7>Y-l٢x@Vch%{\sLPz](%bRwL%R >$Nj *`PGNAb9m1 `Rd}_dG oEA>Ն>i=L/,_?d" zsl`Jg}Ovi>r;" WI];G5Ǜ|خ,*QW3cN@]+]}TKe  }et }Tn94:o7xثFdwCRnݱn'Ly l]7jԹiJUsH|'8j&,Gv$$ ,ĔƜƷ ҕ.B'әfiۑљ\AOxETqp !<vu;au:FKUc;:^HK-E+G9k bLbwRkzL dE$ڦDCCg)}pF3m|#W >Wt(v9''W6kG7>^5Z347w{JgYwxh,{w+*OwYy"ny|ku˸P/ i-ؒ;!TmMW*hxm?yǩ]X^xmA:dlV W# ;τm'O f}> SWl.FZ[oc>fE>B'(WήRr@(9Q+\%SegP%鴴C/ Ezc7aĴۂڦ k@w)T1/ jUFGRemqš~`mĬkY~80S.G\ZDQAikڎqwD>P9nлYur  ՗No'=#pm Q{})\O7*}?uw=p7<Úv{Fbg1-{u0;{ ~P(Zn(N2nRfq7qZm;=c@J7j'3gdd;vjsF|֭ڂr*aE62q Y48qQ}KԡUИ;n[2-~fm4b2Bd0y$zc[nNs~b'|5'`\=R"'Vu>ARO#bQTµsmY=.6th9$ROxIP#"ݮ)XUDGM d/H6屧iaEH%&IՠWHVW/dd뀁LƊṁn!Ĭ1ƽY 860h˘,{R|6ő_ qXkginIͻLe`+Tab9:NyK:Z~M)t<`JD_7>pZ8oaRw>x<W:xb֊ĦO?!$aMI)vmا̿ ld x^,%$V`?~M; Fn^K E} )l%J%+KK U捃5%+$P ˠXAڊY% eɏLZЕjb`7I6Dµ7->fy"->J&mW)IkhESl:_UÜv>)MKd &44ڽIГ;'2p Tvq3jv\k?I墣OI@!R߶T۠LËd@!m:^;^#Lu~Mi~JgUn^QY`9@*rE̢gcr} IB:1> Z滲%:o>tj0UUQ.@e|N/j_EZ"h}+mR*(,W~`ccfeږVQ+oFn[J 7# :`8&cz]Bv|g.z3*yI`]1h:O/ cus:QIWx=|I3"O_ {+b |ץרּ'}o%>#09o\It\! 4H76z)F U楤CgAOIч<àn<|%W&CW~UN>IIm1I'wHȆ'5_1qДy7e&Oe/ӇRJ$(U˖[vHU'T֍)Rњ4i7 b?@<7h mc$k^eMfS3sX{֫ 4W{&QT}k7q3ѽnN3& +՜Vg(\lE bvsKʺ3nZnS^/HmD#K~# .j~-%TZ$]3n>ⷻQÛ2~~_q }yXq莄`E11Pbw?px98z"vSLף`ƪ%fAX"3R4x{t5ʡ;ɻYb 诤fW'}7{ht„`@nv_m:ԝ)ܒY{'m0\0yXKAW] n$d ЯH;:h=e/QУ[|(R!{QTEDU"kN!I!^$bf4$O;phmuy6BGZ `9Ό;vUL~9%yT7ӪI5~)6{VԆB5Z)m\A b6lmb4m(m8$!\;p}SܕB^Y]t 0i{^Zzb7Q$w~gb4w~Wؿ;xo<`6%xt5^<ێh0W )9JmXxSÚGB RAmnm%b-f:.t'"NVPQlgAVaM7b |sk2# [ њbFù$F;pmӂ1Áb_yGRmjm)ՠNf}G(*}HM-uxin6fظx$[Ko\q.E QLܭt 'E U[PYYmHNvn%0@Ϗ˂?lofLՂRiEkUԝyԎ/UVi}Ç;}fM^s/NdFmzˁzSF1ʱO+ΝiF[zG:ӋZ?H"H9O,Ȝ6R>2A溻$f 9k}lfɮ>*Cebu#Yڑΰ ɭL\CrkUJ`ݡxsQoTpOkF|wB =iӝڄ<=nX鱁6ytqq)}w'\8>Ԧ Y]yМ4&I o(hNA7N4wA*_5S<KL X O PdQ4a~^ATyרT_4Wl-7M~MA7?w"C[o 0!B5T3R>ƄEn8i!L6HcƲ2UӼ|Wh3pStAx 1eF*#!؝W~$4)1<AKmɘSSdQ,"mK%{zҺS5nj$( ߐ~㣚!1zƟv &xү u)$dضW {ҩvs^4kY,'S]+}m=&RmMlFV?Wqts왮JY60_tօJ,ѡ&]Hb@']Q+l$bga iFYLUU5jFr]dHK29ڏDҜ}FZ8Yo_VAGj['AƬW:N|T= ۥqm,;$eci9jz(6MUit8wpKEf1SK:W@qS0iͯrc1b={Eu~uHѠnΗJN}&x$q5S>Y+3vil\gti&Q\ND麠'K@__459 c6 ^vKiLz9yE zg|ѮQ&<=55 =0:a }b(X1a;!Nng+Nw#2\o活Z3`cӓRnW9$6RߎfU}k V7]m W?1oE=QX) dtux9eHj࣠UQT a1ЏVlgNھK,g)Z[-&uݽ=];On~ oG\IԷ? Zm3@76XbI[^k {U;0aTv,^m9QJ&zdɢ[6O :!ӍBP:"袲rÆ3g3]+!c|K׀~Mz8 O(SSEy:x`ݓg@?[}uujA]n>QϜ?"/&߻w։oүmy7u-hgoW@57K:_ku7q @6ܒiajd8X:|2%_yǺݥZB1:jԎnl`+U¿crby) F^B ɻAVVq+F\à r`˖-ZA/%ndk|d1w+wK J%<@/ꞶK3hEZ^.deeT,W௰ha3rv AOjC}Tz$33=lN.cl(xS;ۘ^hp۩TGK\ iX\Q ;Ap){ weg̜6& jrisgm$}쁸(} jrFQ,^E5 \Uz ^ qxF6q/}alI,^t !ACDYSHgQP"ՔK;aOE $# U/c` ۣ$"zSl֕.: sх=  û}TkbNNVEgۆ?w~{tYYeã#KR;O*Uf0hn RPD^$;ZkY3SSoe:9UOe6Ikk+kV|d/WʚCr_C^==t֝:=4Z5Kz{Ɗƺ磻[d^O|"x$HܩZTM|D/zIXlvbF]o@(ԝgzz+Sv;b+G][\qcX@<1kZMV:yra.ŒFΎ J# dvVd:ZyGI fenE>[{&A!Їʑ3bLs/ :ŜƠcXEùܱn=>tq8qgXَyowtި^Z9e&t'|st; E+edN:yJi}z_kZ*OwܨdGθQS(!_;Abvj[j !e?ƻW<,vc?vT/uh;c4|ֽ{t{~F̬=:Gq ؖS9&<>l؉c2AՌ N)zGԗ:vLR>)[I6yD >אCJS-a#в0dQ /P 64(BU&57-*'24#)O[e$IVW^-#Y]ֿ1"ҭ^ ZjPWkHB7}Uб7;ӦKf9ޞ8FbiЎ Հ'A-W0ǨݝЋ_w`/WAŢlV9c{bzQ73Xvv,vXyF3썾\ognPKa {@D_F"z}bT]‡xWUM1:0^s}\qVb֊^cg'XQ<-!V{Ŏ-'鹝_l=CaiB lauL]nZلJ(k7зRV=O}BM_8pH:r+>~(+}Ž@?~oHIY+亟V %$î`oh.}V6˦C+n`,牚*]bo£Ŋ $5cyȘVj1p ڷ7a@ Ƣ6G@$\(菦ߘ'ƴ h]i&zcZ.ttfncJs/ oI'j͖X7/cVl8f)xi67ULSZnu 8>9!~l/Iₛbi3j{Y/=gA?|{Y6BFoLg~,xo/F6$^ZiTBv`b<#Ѯ,W|9%d|p'h:u7(0,{79L> Zj("vׂ~mΊؿ.xwV4I:+%kwV#/tkU/'d#'o}ZZj&IU;-tN 8 zZaCk΀I9ēs \s*y3; ,Cf*8cy+|$S[6K`#3}b_oa6fDLx̢7oo5hת">?xҷKa*}¦P$VN^půņgZ6,/͒Th-yvJx5ӷYb@RSKޫa]}#Zs9ZG"AYc2Dee1FumzM Ti%ƀڡmG^<|A\[G@?~7gA5aXailb;)91 79fh&D?cuަ9-0fkHoS"@ɘ4JsP*T+េ3eͱ}6[H5As-9_@KlΏ1C{-@]Bu*A*1|)JA*SZmB h˜JM5>ZѲ̌r<)Oɵf xTЄ[ĩIv=nJv5 x'7H5_)hBEk-R , ѽ zAYnA3,I O PV%>mA> cp^͗+hBEYFt,0 MS;jSf}H5(jk6 @{Kgfg8.\;Y2]GЄ"i4 !AgR,;x^ЙmW͎Cpd|oaO E1|)A c*o}VweXBK A*r^ }uA~CЄ15 sfku M Gy>@Z 06'G4{;#O}T-7ZόzkQC#t ?-7|"#T~)?2eQ;zw* y.PC3.YT|pXЄU!N4acQA n.V!\K]9jSU 623̋eC̲9"4ad&nXЅI4iS>!b.oynk++Iiy~sHvKHyzAܖ_a mQ AXpeH NuP?ثu ebԟ ՎtUOu5JJif7fɧ̵ N#Q {?0 {~5"AMЦQT0JHANg@}9aPAw/tHذt.: 8"ƋR]YAuo@GҨ{'#S tJuSJr]g5u&uS}lשe6 XiZ\Upem4qǾ'/X͒>Z gTf<eI} <"7B55?.h—3۠,̛" OęC3W#WTgP)9Dk&ԙ'uqg@ﮝunݠLLSV+Y<.8,Dt AG}&x$\$N}V.%n46N(LxzՈu+D8n YgQCWűVv:"4e&u?̢Cnnݝi{Xv"]5y|]$^hu[GNv}_@<:"MNg+NI$LOZf7qs]y-Cym6jJ]f\>hCb#̛ gq#E,X'TL8 Zn=G8jW&8 {Gّ(Ұ=MNL$=i*ggm~.ąU>Y-mٲE+ؕ{:-e6FniLwCw~r]l/ah{HXTݻ" k/xw^m8Lvك[gkvjGv#K w?ytLNYΘ9m=d+'`DZ::# !Ze+8(tk,px-vO#8}EloabO1Svܬ/lOgGNc#w7-з4@G54ϳL/ J"bK/q%3ݰZtEiSWEvM2yTl˰b0:Wuٮ. ~#LSȳ>xgM"tks#\#tLcfvꭶ =.}܊G|*3TGP&sOOlZŏn|\1+kɵf~it{JgYwxh,{w+:twYf)U曾_bƼ 4?W4 g,'d Y-:hxmGyǩ]$9fۂfu*tal xo{<<1|ӛjV׫*Es c133K"y^7 )Vx$ĨgmP\DNip-2B|D/z>: Lb$i.Z`+dm6^KAcM[/Q9N.zմB(EioãH5'jv(Fۘi'ĵ ]vT.JzePaՋE IuV^p]TnJ͜D\ #?VQw8^pXJ+)Up{݇V> ie-jYk<a1Sdy3ߪՄ vm#y+;W̞s?7lLW{%VK;sǍAǰs߹cOztC1|4K>< ϰ&QYsL^mkó:;LmP]63'exVii}z_kZ*Owܨdg\()vՐ/Ȕ֭ڂr*aE62ORq Y4ُէKXim#fu/-=gߦс,&3+dOyGG:T|>;ϟE{~j=Wl x U$?2bK=F7rrS ׺S?N{C~OMt9$ROxOP>tzhcU}QQ\fY1$x$@+!x$ sKڄTV;#\zpm]db6/-5^˵mD# a `|n¬seL!<ڗysڸ^. = }Oiӊ6 G1*3,ؓ\**T:hAw2L@KiEu_~JXggܴ (z㯞u\w֢ จm?]>RuH>$OLG|7rI3{^WY+g6@%uΰ)G g%![;p]S-F͓ݿYzV5ҕfVw0OݠY]bw-tOlneH^vە)eE>r#f7wy  e7=¶x;b8xEsL۷!$ΟdXzo'ԫDvIM2OKzV=ǜBB`ڒ#בP-q6lDF!q?̏ T$;^(cM~_Տ k Iߏ Xp]r~lemD-!^{lWSJ8ύ[S7aT5ȴ jy)~Mc X$xYuj.%4z O$us'A?kGƴ%n<}Sgn4C3>银csOiDveEk'7i:ۿ $`?[wH";m@%|ӊG#TwWgحgu$û-e.iPl_P|N_XO? ӱouDHX-ktUj$gŎwsȿ2ZDW7 ֽd\ L+j#_!L\C6UJ\!7f_!,EPgwWѣdW@A7G&HnƇ't/tZQGuYGu/En+_<.-Qݚ9$D]Tq~3Y6~\G.J>'vo4#~ 3ՏHO? Zjm\G> Ϥc? %пב Аq݊Fv$?/ ?=6xX z% ځ^kH"% .M 'Jv.K̐RfHڐQB/)l!S$B!S$sz)!?ltN|6@/Kw'0@OIw'0p7dxMA>_b}~v%hh/&Aē~،f9&/I\۴ 1z}Vl8fA?no0,K9CM`X]Viv5*'I>D"u_,nKQ#͢=s|%Wʽ-N&)I>,(y1WK^1뵵1.RnJ$@An\|7&@X7a~zʂ"{>X)^Ԑ38v*h4bE=,i4+a&l t8hO>:~XFP~`PBAO )S|;y+]ߕH4 ݱuU'̳-P Wے~Wt]+𫠿~C7xtW&9$DkV߰q50hhTs^fhϯGAMOv"$;Aߙ|'B^ {q]Xl`$JTȅ,D$.% v;Y E˖%$bI\%;q[Js;/Ky/Eߜٽ ,8w{=vnd8:C~kpL _24v4]KH~[jft^w.lW|PN$WYSrĘe^1 L0f%6f0TըqW!L )va¦) B!?H 3;LB,uP Dwf2"ģBhe^ h7t$Z(H^ff5*?!<3?x"Ax!])@pƍrɨh)YO]kLIZl 1,~ QE0x9ȟ a ?YK+Hz>/ORN gNl>t݄rI}ǐxtrm)4|Mnv\ <ց*ɗm4-:K.wlwRǑ45jT 1sq6ڥjI/vi*jZ2U&)d&WHy&&F=^*5:ѝwl;[4r#9_C9L(I+8$tX8L2E&FTޝS,ie wZ:ac:ea-{LwUUӨj&JyfY{ p {{?p' #z"Uw20}W~ 8 1Lnz Μ*\0z[4$/ #_,:Y{~I+6߰蛙ΑP v*KڔJQ6 t)omP1C{n7 siJ:" "(w{gmD%(~ޚܖ\I8\nk%4~ZNj$Lex A}CڭO%>d =7@xɄ juà %<d¤=p7qۛ4BIj.X$/n=. |LC>,pRq{G e ʨ!G?& ieujfTvFz5D(MQ6,jMc" Wؗo$ɇ#n'ϳ2Ն˿ԀkJmOkOf-԰<?03 "†D3/@B2'? G#kjM#+=:)HFq_~7$3T/_FNũ{[%5/q:Ti <&&aFL&ЧL&efj2ˀk,vyhdoeTsv&Jo4{4c:qUm!29#v̗>MoV go2pN dq)rhȟ+쬀D6+k XjYIe.ǭVT[wTv,Mԧm-Ln;J ;9v7un&w' dˆ|/%Ut m謋Ӷ6f K+B#{d27ю /1]h |xRLtAPsO 1g"OA\qOs?-B_fǠrͲExo5(si[Ɍ&#~O@9aɄm28-dϡ%\dˆ]ڦϚJV>GG#3cWG9k(8_2 zTUPK71q:4ښZ"xJ_@.@nH㩸r`d빙bqȏKQEQȣh Țsz|Ɓ/B~Qc פ_8>"^{EGѐxM4N_ m/5)q׊o-LywMK'ݥh)%OCiiiQH_kt?uȿ~v;Np? J/!.B#|F)t(O!vVw:K(0O6/0Kscj᳾s3Y&?$.nc2a=`8dˆ:iJu[O?>ZޤXlk$KEFzTdo84|ajuxlo&^AU?cr{9mBLnfQ)M (}>&&]J+[I700%dˆJݳ5oC@Uwc2aA!&&L&A^;"⨰dڦZ\DGof2a {[a2I:Kv#Q)uf21z #@O@lSɣ*`z#<(|&B}y-uCڥHarv}Ʉ|Wc%l FL&s漕;L8':y8DK0АaÔ:Xk&Ì$?]|a+t6&i(_mn*Y% aoJgjC<ke({+ޕƨR(V"7CKk [o+d̲U-&9XY pw3pd *f7̻2Q͸9ATa(I/pm k~|'ІlG~y$E8l}dp: /ԧߺ \ %u[+Yh66OV5V n[.DN[ lRT͢{'1^BV0ar.yc {'yc1/҈Nr˥=NʈQw Q/ɟX -{>b D,!-{<eZ y0ˮUX y0Y5kكfSl8-*೷ÚbُlSfJ1N `;P G $xo;`;bo]xkOHH{Z kld*  ­`4^sP[T7~X< pE RYviPs$'%6ÀiP*Sl+]W@dV WI:L UWþ}#a"&DG_FC4^UJۅfE_Oj&xdiGr!ǁOC~:H;T! dFrDfX\M%ɖ?| ̅X?^xXN l1 Ulќh&۸?<#?x:9*#xN$݇E_05"#AN`8 FſԦٻ(U .oXFYSF%E+i}8#Py!-m!iz() ۚG3 euGcB;">ˀ7ANv *n!p 5UkB Skfʼn$fgM?홚>Ҫ5`#ί#Ƅvn0 Gn:JAuTQ)_9>FHv3!zرrWӾO`QFMN_5iGx`J?RKߧF4CW1}`%N 0> aQ3~y;S;(*nxȶ`=6ܕU+9U)jY|=?|Ie#9׀_d&QOBIiA/Cde@~%ܒjȯHy#)w{=..tOKŷsGDElX+9ƑL{tƲ͚D4d N4 Q(;~2B.v5q7ZJs |s•"EjYlk{[};\*z3eȡ FWs_}\rh:J4fUҩi5/xKmz/wg#ֆvn r-A5D ]u1d AQ#oXfѹkB&ு5[.KDk ~\7)UnRFYc`7_I9+>E-p8fLVM^vsZJv."M=2=ex0Q͞l&$E:$]UM2`MFݞ2wʐҏp1Ɵź;~@Jw~M{}P@ |vE9 v 3۾͙ $:ew4-vb1ںԢO¸CJEe:*1q6;ָq7*9:#^/vI-Ьz1Б) vv.wTgC#8G4o쩪6EW /簙\dBI&ji?P*&F4Л:LGM1QΦ9X(8mF 3􊦚J2,%3'nJ7|js%7i.;DQ ]͟ )EsDׂ DjHV ,s#f&Jk-R."9ub;7˷00nE+]dˆ t-Ԝ[v[!rc)xL(YL&L@u'9YuC5D$pɄI5R(Y5ُ孖u\WC^-lNaY"x';Y*:"QeNH=B|nlQIgI|Sy=t۽. 3K(P `y?Ѫ甽%}hH<䟗_Jr~ې;NU BwfO,4F oDVb4? 0V ͧ}Ln32P4Q%Mr'bBݴQS^r==Y( m7ONFR1~E=Jq֝B-}B4(^Y4t+s[Fr7dI,_~W$lB3G!MSvT/p'i(w9.ܘG9z~gT8OnaM dZii旔5BA2FI H>Rij` {xij2(y[!5΄{"civKw2ۻuP#zi:[]p-9K^ 2/߫Pq9:xqirz53{(Fئof\v+_j{P,4rQefygՑ*RoBٚvڽn`yaiKh'J T\YuX4,+*t@;?$s籝B*%8ϻ!Bjz/Q/ B;|>6֑? J>Y+N2s{omBAP?,M7}L69d B4|y~#4mnڶLïG/;L:d~MN: !A]Pʨ=΃^w@#:GJ';(zC4x=-cx}(C9@T'4SӸϖwn[w84# rZtmY/Őv^p"\ ym -lhAZ(Qxzݮ5vq,}Qa~ `ie:y|f= {S01#8@FЈg6p3OН?3Ŏe #"] BKAP (C9?xm쯧a_ejE$'0T(glum3-DJxB.kF&RF1GE KtLQj]F/D(G#Y^}]­ڇ*P} _ qs#uk+m;C3xaÑ_ w2WYש =y/EMr<Y(C9ƞ48ߡd)1L]%@U Gk[z}>v-nQΪQ_jM8Yh-uLlX1ZiqcMݻu^H5Y-v=Ԋ:KMIkivw{|,;Z"8KDs4Ol%:T4-ӽ=g#5xRFs`!,[kT7")9RXQMXu*2w 7 )ئ[Q ldkfab7zolbo4FX0FWWрYSQ&B7zMR(ze{(1|2䬨eZSXibEBGLmBWk? ތ!L1!dk'phmqФ9ȹ$HD <>5V}kTҾ.SdV-@<^B/RÎɉuW@^!M+I2yP8#V3> &beo+oGW~d0w4&e>\vgekxHM/زypehJM'Usgfb")S1 H MrjŘP[m LNxjog3"Ђ7q?\8A8K2֨Ḙ XiٳS+؞1i7~szaRΗLfOU6 #_^Z|s9qLgM=\BC<4b0q@#RՒuIZ7T-⑤nJ%yP moK@Ada $:I MuEmrNI92S|p/hvv@uB~0y5R8#QPbX+E9VGNe! otm+PpҌ:p2=YN;#koȖ{zv@#M7+OC>|&Ÿ+QYghߝGNi9Sj%2=iCV)j+>tdcO9u`BwjʍiVvM>V_wQ%r0Y?坳-+ VQ+f}jsKlӬm}v@;Z+owݧt~~M(nvOaCh _4=6nq2=X8)w/MUmE/us~zKQJAq6ԕ97;=칺IKg} O+9T=z5[ބGcBX3o̸ oidE(u=E}Q="1iՋ,{ q, 6!W ZfC*WoBT9ē|ZfBzs-oAZJ1XSQͱZYVX%V d%~];%\y}6KwqGwj){)Ls%0YqQB PxTDM4yV-{)eӫMt z˛ mtT/R@,rэ -,qO^=yHUw[|>a }LʆW_j[t'a_1c|4O#k;wϔjIRۙ2滃'`/4^셗na٧U3'\B8X WO9UVB>lNh [_HW\$LWb;zŢZVzEjfA96G;hR7}Ru P:?4~|oPmYZ#!s* AE|WK*^,O%('JyKD1o;Q;!3bzrziW(hcIܛV+"{BĮWbcs!p%?9Wi4gViBEr52[Ӫ5R[LN;֊Zefӽ;{ܰ54f\%;SL-UJZM܋epK\w2pN::R|ۺً"WW>fƞVKmo%%F TsLSGv_E#;;\G*0W`pF.rGe?ufx"VAT|$Mc=C9[g8Mk:ᖩ@4&tM6R ɽ | !JGDgP 7@Cd<#8<^lUJ7 AInYT|;x=*Z^ġxb{w if̊R?ڀ|4Zw(EemL|6d ҡ<9VnFitLuVGԚz>5 =\'yrbu.ל sL,]Vvb@k!on":!I:Z ̅UH!%ajfvC>Z)ۺݖ9zoJ6svqsp,eL^v+_t.P\ "}gBpqb)$^&_G^JnHNٛ ̞Ԫ"n@+W>[uvPHU{X֓!i6u]rG灶c4^0Ph,׼G9(fCWD`NW>Z);VP(> դSj$fe e!BB6a[hGS=|P3,jajk=YIɲS۲JUN=#0m+ou^.Դ,Wv){K/J7VթЉj.3PPspx׃nָrpj^R U씷Ik0n8]^i2D <L!q˚v*+ʡp$N7w4YfÀfDŝNAJ!/@m<xG= | ձ4;b"%/IS~ݎ-.XVn`N2#/ xT{As*uHz%y;U ntN쥸@ŷsGh# `&̰*!̐ hBY|@"ƒw3GZQ3~B@ut:]"[\lf a]7@#?idy-v?8cq!<&-MSKdɟmiK9p"lmcpy[ԭ:MM_8z \yE:يyGf|˽nFmk#}clhkhCf\.W9|ٚ<7Usoz3^N 44B"[VC^PWmf?e9}L9hQ*+c]Dܷ}f>ޑ'O:XOC [WQLZOE6 _8++VԲ_>OP7rGl^iQ[c~h to|؎hoC!IYne՜Sj9#I5fآ?WEmkViL SV08sz"}' _Rwvj1CfDz1myŢfR̩Wv*ܘfkl״k>>dW.U3=g[: JUJhv_Z``K%)'ߣ߱,[+(v~{{8wyM nRPyOi%]z*WXpL |mzе1}cFQ?7bTy/"y?;ϏH2$SRR^xOyYw88_ŏH8#IKEٜSQ?U2m5͊!JlKN`4sϲ@ )}1PHtնM?vo %f[m-0B > yG*,> yWd"v'C!78k^-i *p)nx3dyۻޞ@ϲqa]iik42OuB-9Psjɾ_専;?ߣժ3:=|@bj6vns^=֣ئZF;5.AÐ'Ԩ#㐏Ԉ I'匂s/ wbBs-n;*Єx"֊a%1K:9-d2Sn“+`K 23Jt6{!Jk偓TAE6Tc_@E}!CT$/R!NG' |2|##aH{kS^BIaa_9xn@~j]Jߡ/ VOc/ YlƂ4bCv>ߡn#~txdcQȏ&wr'~| c>lCyC<;X_Cc&,u;9}^1ͤ} VU+S.C.:,%ŝ{zaVtz#lPqV*w9e,}zQߟtW ZfC*WoBT9ē|Zf:&>)@ɒZ˴C-Nl75SJZY6:RrN}Kej4 f7aˬ'5V:%ʨ^E FiV5?+lS iȟ)F! $ߔr'm!)Wu7_oJz>dK2F,18}~Eq>t|Hoz5ZjZ_rwhcWհ,!@7'?O ?<_k?/i-z`3y5$B=acOU dތC7 z+4nDs |7 **xo79kXVu]2L;\Øf&_Tm N3oa pxD4qBp34TqlO)9V07\hY)J-uڊ 3,v9]Cl.#S ?I?)Mi"_LF__[Y F*O!4eu&Mo!m23AȚjP>H>8!䃃5̜]/8X`:+kxiZD%qN m\/W˙gizXCL@>ǡ> 't@*(dyZe!}w(gb8 | JwJ Q"bd,`jр _Z גQEj3܀)9D4gIP!{KLM-N2lэf5&U)3'ϥ)-\ O)+ ?CViH4R>W7-ԝ0&4sm[_fv19#vO<{n3{ǘC6s8 #vabP &g^_!R>dˆJY;5=#d&LȕZodo~#W*~ޓff@\'uHr:o%ygD'5'6w@~ ܷ1s} \|3V3;q@L|wIl-R/*VpO]'/@&; Gfܝ-ࡧw?;R*?yGJxwi` \y((ݼ+qmAqk˝7m6U+=JGR S܂^|1p ̟|SI)),`uW^*hԦt쌾aC՚QjһۥEņKհ#%"nː_DŽ~p((W !p> (U!>nԛ$ԉ^H[AxmR*F{gܶCaRP+4T1~&F0 Tv}L&L}fL ]PC }d¤ *zOŭ̂]] >K1W4܅ kjPof C^R]Z|^Ӽ Rn`l-CQ-S8O"=j!).f]u µ܁FaDXp3nXVc{'\v^ 4N`OtPQZwk@"|ɷ;aq2i9]% j:(k9ø:4"BETpAKݬFtxi~6P#qەʸ_ ++tˁ'9%hfoh~Do(IRFŽ]a{ #?F0A)]W'0Akgϲ9[%^e뙣&Id,u5\|4 E :<\2*=six?!zf.&⃫gc8躾`f9v7fߚ)7saäO ՚[hEP*W_BwN3!am8@ߖ`{e*>!mywC|ΤN`tϼ`ۧ%aKJۿ,t9r*>J$y_iI솁|U3+^ٰUҕCW꿲j>%fl)]RQՇ!0QD+@ߘqe҂|󎜁 00˒ukuET' 1D6wU^KXp\efZ֖R7_ޢҫۜ.u!|itsZB!nXݱZqˣ䭨u>4fm?4t<^ Y^ x"sx N*Aq#{x"sxЄt8DudC<{̺]fMhE-qTDWDd@T܃=LQOq(vZ8³^‘`A]Әn%27o,tgvK-6v7h e[@ewA$x-`2 <4}#&G! u@rxrG5c!?>O@W,Oq8|tj檥Vƀ N xx݊^1NR(N>2f8RUMV#ᷬ{QNuj7lqt@-5.g5PG JBۋC(2 ,tҷzO`!>@N /)0yI(YgF,y 4䧓Q0PFVqD:E=[:Fx7<"r ~ 򗮓_h_+m(+4~YM*2&g$J710f&gȪKɲ uC͜bi3bɄt-9&qzxWPcLDjf$D{_!ǁ e '$"I&KM BIU%&KH y,ae"4&gg ˴[Tuvn(-mK6(ܶ8f9ܵv]{L"wkf;y .%]S0^!t9#nJ'B0â܁24sOPƠKM=Hs. /DT!GۯlRsP,g[jgX\HF;y`r1vOSp4}@B\g m\1 ٌ}`/A iCio,}:Z/@~!ZGZ(&E@rȘ&4SIsqᗒȏ'ODV|!.M%"灿O rK*,ljRJ,nΧþޝ/͋gؕ67*&&3;cc ;;Qq;%w2ewP>}Vy pdQuj-'jkOU}z6^Vhٞ6Jٰljj;2,O3>--n/kU3~h7 Y~o3:{/Y7Ys=IidKȲgJDK(};vE(UӨfWqL7ڳ|N"[P!/CJ_-|QeSq~ ";2kŹ{u Kkqݫ);oCv,܁vѭc?AwP-0s )a맄LpԶePl <9VnFitLuGu0n5-ʃ!wk$rN:-q2gc$ 'Kyꥀr0Ahx$hݸmW]}} H@$󐅒A <YLN?!I/0֜ p2Xio0]5eX+ylNn)JVpcvjJjE-MYNWa Y3Sj:唐/*&<4F n!Ԉ^%iVNh@n`},+7ѿe0o ٹ՗_ȇb | k.TKw4fV@_BnvW[=,aʃEOZH*!4 Шnm%&7Il>@^#؀* $nym[iN]!ߟ@dmumc/dy-MK\yT<aBC@D}6lPJԀKƘbEŤ Uouzor?JrNjUXbakxGQ!jX=ʈ#Tܿ mr'7RREC>:>E;k@<DiȷŲXDrWNh@ xe7A rqpx~p-:yy;(ՠB T|;z jca%zԤaM'<="y(OΫހfff2yg JSㅜYVsd58/̫o͟$Ϝ>؋oLo܇ g4g Q]Dxέf??V=srnPn^MZ_2=al3|czIkk^V~&p@OZmЈȩ{ZP% tկnGh'*~-x$)Xcئ6)';$y!wPl.5'n~7yQ9jlaT: ,OZ٨(Anml -Jz|hp#Ҍ}iWöŽèw@!ͨըMwF^{E.*>EѾ;zwrs9Sj%2=iCV)j+>tdcO9u`4UrjʍiVvM>V_wQ%r0Y?- 3WJ[4k[]-J%])'ߣ߱,[+(vOa?ԅ/K~[ٸQJWٔϻw+ ^8u#^.E*PW.WZc?&"q8;/ٟ)8?<_tkSOS8ܛ~ՠ!x[|wPX3o̸iidE焨+p>ı?$žwo!C@i_j5LRJs.]0*<eP|?"ڡ#IKEٜSQmhz/`cy:&qGO[>$* /Ksk ^+k! |K]gg| δSB?){U.ńmlvDnAh~z*u" 8yP(f9b@;Πͭ5ΨthŁL{"֊%P $InCV'6ht{ 2:뮏8y *Nn9IpE)X"ۆ.-FRn{9`r^{V1!>1Q3~<'!?s SPq!?|LūI//\"Yn^ icScIS,,jIqSYYn;r4&SkܨnP4:Mk(zQkdcVFMr+^V_JMh) ᫐_M QOMۂ% oլ45L @VeS'o]Z_DqSrJAWɨ՚UvtpIMV%uD+i> <'r; /y;C>pK_ 9 ǻmqGBdQ) Ytf:ݲ)DfK+8?I_,ҵT󧀟d*3?YυQ3?L)JYwA3U?`~~#Ro1Y?$AYwu]2d¤*fIuӯaQ8a8B4q'zAS1X/maC/GEO>1!Q[ M=y}vhxo(&|v@*ʕ Wl-]C7fX/_k~gG|}V; HB!oڙ2滃'`g4^̐n~٧U3'\B8X tUKT !yacQm3 +B>Y-ݝ*y0$~fx dTrx* ހJgB~4FNSpz1_QQFnkfcZEJ#}PMPM(&(&Jk&4Sja5vDY0LT֤52W7xhdi1^b3T f[` B-8lKN"2{! Vr!bO6RTׯ=a:|i;@mKY%dL2gԪUaGlw@:U{yH-u5_Z e BR9#%bvtP#?݌z2:SkfeN-}4:C_f;.5MɊnx͊DsGX+ =FKyfIJO`ی$ :(?_ԠEtiI#Hr"?$*m'|ی$I*IHzI`uAzvIV'o:H*&<Yh;$D OȃS*4pmFII@$Q'B''6#du$6#:$'&/_j?j8՗>I#. ?^Oz*uHzY+L{X*Ô7elW< *!>'!x';%xޅ Y(/wA^'>fЩYl2o f끻!͞"p̓|4 A>Yc JV l`twPFyPḿ.op,@'97B+ H^'=Uo! &b9Cz`i-H^+R¬Az|14Wr<=Аm-y#B[j&iP7qGbN1kk$v q nn,Ϣ,prt{l>iYW)A#IFAÐ#+(|z|*4Qy7=~|tX3oX{U="Hz|i_j!l)N%_ګSSfb{;^>i iV7!ƾZ@ۚOO[Z-/ⶦoN?=BمVo,oEj|/n4G>s4rBnvYd'' ̿KqJژVTwAnm#LT&bYS/A-82;ܒi 5Ex3d)ڰ.' }aZ̪,jD Y̒Z4=\-?a<-Z(p !5<xdztDx';PAB> JT.a }i0ЃF =| bh1|U[T*hCҡϊ?!ZsSR!NmgL7YCˀf\1F`/^ie3=P27C,M/GwA>~C>Y? `#OHPZ>drx9 AN@%yy%5$\~ɇTSI/M/`=NWc󏈭;ds/p3d(gn%%OwB)M3L2T&] ?Y1]>xPDSq#D~.C<ɻYRrB'oI.˟jS* e]í6an ۢVߢ_[_8ē|qclQKIIފ3$m/cnR]Mkex^ѹ+!MtTiJ"_z[ cz5k(h55iMsazfAY [Ꜳ92˻IB&i [5c!lpF0Qq~G"kb w`#? @H1k_F~:דO OEeTOs' I>ƠC<c,kZmI5Aڥ\O"}- dyLٹ4䧓'*d Af"!#@~4e^Ke? %TKAX}  xK\B~58xKfIn/گB4:fdΉ8Rvb ͸=.>y8#[_ʾ6qs'Btr(MƇ}.eFƽTCu#wW7#C;$wo YIai3?#1vTGMo{]:5Jg jGυG~xް/߄Ͱo@Ha"-DYÃh|vXaiK 8*W#윯ʹ0xKmq?vp8⧈:|)rxmOI*IH /~RbHk)vtŵMF Z;~G(?G]m "-Y:DD}--6s?d"k+{G mh 8s Y'·?$x*`Ʒn9}?L̲2@rYWsڇ+)Wr7T*АjyWB9kBů$,k4]}7B1p-UҚpGf87W=7͸#%6t@AD?O5펔YPLUq#%68,fTC;RfT.TcAªf\l"bBI3Bأrl=t­#`:Vhv :⑤%^zFՐŐzY ]r` }v#x$eU\ x[5-Ʀ>CZk#I;r.۷@W!o۷[ oI^oTVmUT:eq9x"JLoyS>oEUн+Vˌ9 Ai&Cn=ʶRN;eQ iCJF+ JI+G .o.GO@~"< <\JzϷ,(E/4bKX\NF/O++)V!WL [ %^H<.̻;-&/Qy[פֿHૐ_ kTnu$8"y8GnupR*}#[ yj>("v["LbR;xkʛEN;O[HY \y5{fтi$nqJX!!+bxnqcrT=z@W-їn>ȯUK.] -pjIt%"v͸jI{ m o,qXCuX Zo~ji%K|?/om-UXK"f7 $ײmBZrڲv;RhܦeSY ߲Ͷ{AmOs:hl-p dbMnI m" 6\omZb`LmV5Bmi|ݧ!?}=3)3 TD Ls::XQl10qƄD^2'By'!?y=+>f L_,0M%3 Hj&_Ͷ?EnWHXZl=nAh5ƶ%;ByVĕ k>g p#5g*v^ќ@ro N؆Q5`BǵhAl%Go B_h4 [(&1 ΜJ^ Y{머! m-tI~w砤ےy ؠJzczDl5e.oO<A߭Pqw!p4ޮGl KF1ہ!OS!Sq %CI{ clA['07ӧ1qA;]FPG:}@cY-)ՒZܴ5z.[E76PR_ֵ"~ Kp_nevJ9i Qjk_:5S`u@q_Ɗ7ʺU5E- 7 (:w!ndpM5Z3 pibTqcҽ]èئQnnT wEjXN{ &;Tl]d¤9@Iޟod B, nX yC_<^29>9-eF/vvӎU阘+|vxW _7,p7>A~[',4 ; ;iEh|e/'r-V2?B"W?Qʇ? k*~gS@/%~S@S_z)?|E4x1\Km ;7A$2[8QWcn3rB ݪ]sh9bz5k*M"&i.[ 7QyȭbuNς_6k1zF3 |wHSتUv%=Cp] NG $+Vp1Q'!2|{"c i(U*!e[XƧ?YB/6ƠC^6\Au$cP?!c,kF.c,kM/@mfsL0|: ' ӐN" 7smfcU:|HSQQzCŽ%ߗPp' Yh_Q8),%̪]ۗ'.oqu+ PͱZYVX%V d%~톝bQ-E-*C<޾3_WO]0{)6!ֲ4*{B<>DNj/*zP5kWXv=d?+E{(t\mFwZ/Dcx>Ezi ]wXbӃl bZI7bR&t{(Ъ_ĸYg SQ,ͶʘHU.|\b˝3!?KŝYn3 #SM"4!T%Fl-h|}Qw.S$o4b?S)8E*()qJkbrďPkwk;T:`r.vk>[i&¹P" r멸oa{ղQ:YSbM-u+㚭ƘVt{i:4}eVFGWv(r4˪ ~'߳QȻI+Wǯ\u/g7 仯\0py[=9{~+%3Y/_mKL"c!^3i =IÿL H/Rnn@EKOf\Oԅp(vәgjI> ;U_49sY5Uچi=RT͢nƗҙ;H32[ W3[9[EKqrhwrxukf]sv͒ .:ƄN ivUò~gzLFf*0A0#Laʛ X9}@Ro,הu7?7ACRQTVփfE)uصaJ(W R0M~~ r3zY; &O8>VVłN `.9D9/BdyO00OML(I3AldL]LC3{2Aufrd4x.Fӌ}QDQLAcNC!^9(3Y9rF\Hg.k^*3b( b Lv1"3v+#=i$f-nYS [yCtUj%l2V{ (پ1j;Yig?0 ŕiLsLò|^b1wZW,`u(d ;eL&L]dBiV ^dˆnqexᛶ}ZJQ >B9bLhN3*XZ/yl4lZ7/2y [=r Jg u)MX-*B\ʄ[=\I+9NZITlV~Zu8qc'$iS\ϩSy %ّ.y໙L87\{8!.eJ8(V]Ja]Ss&VJU1NeܮxJ?J?90-Q@yDa1peb|9p-itbDV"ģwbhLg Hjd>U-]X&ifI6-ZJV(U,8[;X9c 6l?%_֚fYAO:hsfjfPԘ`tV j|T6͎ 5kl8ʥi4o//;*eV{Mmt\(7ɭmi%>[YOL8'zG|@B ɽRa{ Z{Km[H2MpVQ JHq F?.2S5srJ(F+&J35*dˆƳ]!~ɄsG29s}#q9;Z)Bw4SGgw:KG+4O{%ut9NKLa STl0E!>/ΩE"|+G\`LɄ 1) &J3>*20agSL&[h2E&gB'Hͼ#6R:Q94$wrHD%j$N4j Dc,u'*4O'2'0-fv qZ \-n`o[bRq뀹6Y.%}@NN#76 +BYa;6΂W-V4^!sؿ}ȿ?Wp@-l-Th-O#198%aW,[iN6V[Y=9e_;79UQݶiTft%(8j%wmi6M#L&.;9zT`y xɄ p6LΈ%?=܍&tR~Q-N^1l`TlJ5ºj ͛ ~ɄT~ޜL&ͩ_c2aD ϛׁd¹e~5&k'Ƚ#uR"94$ErH $j$(j b,uX$4O͛82'ym0-ͩ6oNϛwcr+l\I `+u>}uug6 V…6MkkEGj{q)fjS>30Blz~'!26;v:ND;f-Rlt& 6:tJhg5EfM?CPKKqtSUeY.tQiI%r=3~u[='uS.fpaf5 vt/ GdQ=jT!e;U͢0íqPPK5bʨӃU 33eĨUE~'L"v vc;a;Z{\#gƝ{LuU=j2ͨ{it<&K 5ՊZLFc m,SY(kQQ }}' e/K jAmy8nPq~JD4.]Q۬oܶ_EMtO*Ȅ?C'AOZrY5DT Cɨn70ÑU:Bn R3'6m%jՒb ?|wI.(5_C^{d4APW"aG!T/Ȼd9RCvJ.OZrPZT 4FKg9`r.7B8}"ģjFCfNxiK "W#j >jo-v3M۹6I |D<|z4sN?DLw-Kր-K :ې- XtGrBv)4|;,r] }<֗47Ǘ54ʹ+u/lPsghU۸;a s3 Ƞ]}f9v&Ή;DKrhgjE^aD6CӪ@7cݨ$mjMv=8`f/t+yVV&ү^z"z8Oof˄vTx:&A&Ή9!>tHZlPwRfEYz)Kyd^I%_XM95._$ F,%DˉťiVM ɥ sl!55*(؏W,~T{zeB3-N|gγkA췞KYbwL&~cnMrxRA޼EvaD:R4M2-v1ں3zO!ce6KԜpB} N& N.r醖j<ܹFRY ji*دW,~]N?}|J.IScczR6*Ǎr2**{/e4i.`=U {m&UxI8 10j]J/빧fX[4Lni$k_b2=ɳrĿ*B\N.̛ ݱȬ Lw:K*4O%33<^ =prfus<%q`ZRԪH|KÖn%aT*^}u1VnnG+hHv+W.WRvwwNڢsg7$ :PI'Sq9%#<\9ERh)!Th)O#1䔈Zf|7fSK9SQ!I9qb>,C.?YWDRhȜF*㮖`?_I9ڭLꥒRW+cZU. }7bΗK_ሿ"B\/BCv)Th_*O#1ŜqVK/Y|lj 1G М9E_+~pq9~R 1R<sY-~2RgrLtfZ%& RX#GD=sœ%G/ERhzқ܈YB~U ~U~fҪ`/_xY9fJDQBT<2O>׆D1d !%oio'9fsƞV;JI1KӝJQƎ6Y[]biQ?W(Ue2g9gERhyՋB^U ^U>fAƞV{Jū1Kˮ#k뎏Ͳg?BFu jZQKSnSÍa|1wMoJk }]2P V/510)<]^,ͦIQ۲#+eaMUE-NqՎ80lb2a p{L8'z##"ĥrhH!TؾXFk1ں7dM-ApRrT'7w>d¹'qω'АC~RFkJO1M~xDsԊ3̰6wȹg.|e[40pw?d¹U#"xU)4+cZ35Rgr t7 MЫ 0]W6mR|Vo8טL(ƛ:ExqRh$ 9Y) C;Yy-RfJ/Ӣ tsBT^AS L&_pB'/_mR2[=U5^3RgrLEzTT:̿+ 73ЭϔB,ϔY}fkOj}f|3("gM9ͼ oȖ;ap8:x ”ü{9Yи)=baa]Drn S) Xj@Rj*PxʡNfd G{L8'yr!.KjAԷK!ڷ5M9y8&kW,^S6):r0y5)ye2g9gERhr#6 Xh)O+4liUMόY|?v xd"o8OD5{Pڨ^ٙ᭐oMc=Aonq.t*DxG|蝊42OnH#CNn]-ILfSK y*B7?)xrC>Wr2OnH#OH '7⮖`?_I9WQ vM-W zQGfEnt|cfFEW+GU,F׍K/c# SC~\qC7+xQk&W,Vwj(;Nn;H>٪j]-)b9܌|~f`Lp<:bLh9fN}T2jJolF8b5%!b2vFqkѮ 42'39#4s F12O09 Gu:mvKsᕙ9|Ʉ#e5W>|ɄY+}* 0?dˆftAU X@ຨe(j6@P/udMV\Vz2'`2a =:ʙ*{}ӬZZhm0 9J=oX,&΅0oo!=̖F#h6cX ƖF*T-W#f|Z`[j[iqyHjUFjxg[ѮI I{Q]Wzqɕ}5v7GMp+hg̯]d6[>5|t+}JWzD}z?!Oi>O{ߋ M̎Qn~ZmлR曎Rps$vOA_s5f4 |D;0s %t!w6x_f^d b؞F~fi|ZHJKiZ b,uG I*M'Dϑdz!a)-=LCJ3>%c"x)4$/JSJ< qL/Y|?}DQip_ӖW۰)Q~٨UlMWt_x^hxL8'_xo9Z k Ϗ R(*URb[fj|V(ϻI (eϖ:ni&ׂ6JT+jC+fd-\X%M5*ǡU= 'x~ܨ+, %ld;"5u?V 5<#LvQuY>V1E sfYCLvQ_<# x.Fkj7ճЄ!Zv<ԘܡDuas!P09q)G~rHR$j$_XjEiTFaZrųA,4M+ƤPG49akC8P]~s+LvqN8ڟq9V َV ЎVFbrqVKY?UgLfU'4sJQ :nV)iDh7\&8'|rU_*P;(IP Ic6OhiUJY?H[%ӔQ]uWќ\m[_q']5t07@ѦI?7&4 I@Of䡹=="ģwAh 祑 H | [jnHiv5XzZr}JQ5C'y>9D^|q8G$B\BCB*hD+u'*4O.lYDP;!SZ`8^5vHzŽwEw? h=R3 5 #$Ow72ԏjOj8XTSdw]jj2z6ML; %)ZP2KL3700xV@+=s+Tuds׋ȡ!9C*lL#Q#4VK`LccIzgjzQ+8CJA$s{RqbK;~!&--y#~X)iB;OywJu1KӳQ[(VrFX(kګVҔYje9?6VkA}/ai:?_Y EŷsG,J,OZEQFitL)ZaQkdw z"-͓#ՏfH\ v0H*Aȃyuz)ܵ퐣_9z J$orr2BWCKGjfvC>LdoKRFs]Q8|2D'{H+N~$)s=FQZFG9S)s#5G*ЭOB'anQukN/&Ǵ^+G xeHЃ{ xoQѳJSQ>/_Dub@o "cuv`Gضegom;Zہ~iQhԝ g+0 DMhH@4NCЩ|Rw1 :Q{xyhsPIYxy@J|N9# (O_9<_T@'8 >}lY^[{{wp?g.HL߸U Lȑ<8w?@gXJ {I~CeO4N1UQyg5֜Nkfw{I9in2ޱ[.k._P")SWC9e InhNy4Ҋc䷑}ΟԒVhS(Zn4ޝyKk<[O;}z#q&cT0XSt. DŽ:#Аc,N}hE'ΩVsz{ ls6T&Co 짋xh@q!͚:E吗-uA^- b;*ЧHJ'DIw3]$j!Mƚ^9#I/+x'b3@7kMAx3䛓 0Gn:`jC7A)̇:$2&M5a,l!~eZYZ!T(pu ( JJg=xh?]>Yu,LxtB嶟Ul#,[vA#k!M^;T⑤ՒE9l1fTb(dqoJZaS='^EFQ9r'.79ڤa5vBU$ߠ" ysjpGPmˢҡܕ9V}5.VxgMͲM`knd&Fe0P.1Ǥ5]ƺhwb^yyiA|>/uRO4,b!ːhi`r%%*4>r$ߑ~;#Gl18 rJf &-'^*@HTvjszZɶbecڐUyʱSgNطW95e4[Ld}}RS]_\W,Yw%++ 3WJWV iֶ>[[JηSN:GcMYVQ*Phz+.mneFe{*q^eS>&EmLj+zqQ/?u)5U)(ֆr>fgw=W7)jd֧|M=MpoW,eV2ߏ?3a͘1#|P9ߕĕXcYkl$~9hR*}cRÞ_q_.6$}H|Qc6Wbƀ0ýҴ;iV a;x{Z@-?S('-ζPY+Њf9<9RbGVo,o>ua6CBy벴SR_*e_ZC{B,Wm-=4#36CHʤKYJC] *jQ oKx?#Š4k. QU+Zp{:8$ ! MѰ斩 }pZD`7pPd"}F"cX7o,oUwZ[鮻XK+{[9k=ʘZvTû)|wznʷGhCuL請Y=MGxJ#PہD`70ۈu+uP vM07„͠av'8b9zԝ\GgV#sm LBG@n4;ۡN-44k؂j`C;ByCu㪬I"97 s'~O STv`ix<СZ cA^&^yVo,w6]r!KD^ ߎu%׎d =hDnFr! Mp)C!B+k 77nxW"-|fhS"Z7CfTG[V>}rC[By{ .,4Z-vAfc~斣νaxz oJ!iZ㟈>ds4#g~bt(@ &l':%JF1@=r (!ioZ96*~C<JE_$@iCH HDlpu|ʲ.nڱlan,46 X8QܦOhxOwBPK<y_2ZY(a }LʆWAޭ'jaBx򡰯Aߘqpa|rrVe̋|!^YgnF÷YzwUPCiK 8p(W-FlVݸfp :b5RneB-X.!5nJEeDRF [ D}p/uEG_MvGiB rU2[Ӫ!R[4{C*xC*!C{c\~`%uW͍[b DpN-?"ģG h.?@iBE r2CkOn#xKm13R"nT\Єl&1P-?8Puʤq]L{R![ D}pNM*9F¡4 bC X dIN&z-E 8Oc x N*Pq'M*"w P.oquu$UzFVu2L ہ‡AAi4( (H*Pٷ(t5)Ռo-By[ӭ@+.T:d#Pr'P!fGc +q]L;ThU-C"8B"|#R F`6t WPARfZj?T<?-T&*PqC*!C>4;=Pn9f3L=R (nL:ʮU!e-kgcB 11S* +@wS;ԊX9lzA-6>|ːCs"| k7-*u$ߴќmZSV?S,M뽳4^ny>9U|65F#Ҋ\l?#~Bh퇊xo?h3n*vj(#Թ*UZN7bOjN; [ژe!uyP dt@ HB9zU-Dap7ݒYH/!NF/C#Dq%W OhO8Fqj;NSFZVjs40. T\?|B?xA6b={gN`dF Iя|4S4f9[ a(rV}\S^L6ZNX^M9Wn@T-, k@h?9zQp'fK h! \ yp7р8m*{3YNd\'HM@n!E,?lh@T QȣTy |V7*CFT\dWѼC<{̜]-` \y;Z<¸C@sv>~cNxHn^,fn 뛈3@oڊ@X,o) _M4i]]e hna]VŘ'dtg &:R?Ҵ4s`j~6|s.jS& Ҕpfz[2׀eazfAeߣG#ac1*p'X>O>C;(YY'RJ}xZVC>o> 䍟C< ~0Vo/ @^"lgDnҼ͚kߣ"ֳhT,>C*̵s@i]*qѨ=w)McTݕvҲzXEu?e/ﻨ! -D]T8ē1JuJ[rkV~NVuZKcwDFnGQَNBHl/Qy-.|&~+/﨨_LQQoOj3gsTqb)1pTy(!)Ny^zpBmA7 %˦]YzODr@l' ijVpɶ7wn>T.QJϢz@UA48ޣB@߁wTׁRpTc :OwTr'yxgc=0?M6lkKk9V긪S9s+l#T!4`#_O `7~w `*| ߝDJv'vwv=L meU0o77a_=' ? A>Sy$o{`{[>a[z7c=N'0odS9V+k;d-ZT +)z듷Y*C<޾3_WOw4I {GJDݎ9Qf,frk%ӴavBfwmd͛);QYL FG, VqqΦF$MKa vKjA 1ʘ;ONN՝T-:t ~=ںcTkq.hR30i~4<ӎ}(0SZI+ӟL!kuӬI~+[!oGU)!-k?:wok' 咤)E9?2F.8]-0*劖X Xa(^wD=R5PTM[萊]\YhgrSUqʱj^s NK!E~}qYVsTgA' /1Xw⺀"GM1i\6 =m??0u {xY ةD= | cl#t 49 sVkbWG7 a_t7bLz>kYͮjCgo˿ԀryҀͭ>o-73PJb,LM-jn<3*%KV\jo%v mȎD2Sq< <"O_.L#T*4!ɓ@ HzCPd?#”SZy!~¾}#"yEG_yFCʋ4^UJ<+/q׌KXygUYȮ}{2KLPlDŅ.v-jUMH{k2;7|FjY2ˁf4Xz7;Z/f( Y7èA~pw ?^~'#[7e) tcr)3.n6eSm~ aΎqr?0&&N=2g8KjpM0-FY]R2 є6殹p\RVd۶rY3 %,OG3t#Q?W-D=4};ahTK4T^?Hyi(t{d]ܑl hx(V2[9<ڲ^\Eob`gR9\?BvTN_\][¸kDȼ[KFrd':w coLPTRgAC96~6VRex|aUI۴&c^C砑[1fkMkִTvNGo룺:R%Ŭ4?SڞOhlr9ۦjNuUҜ;V߿=Iњzɢnj[k`x\{Jɲt5Mİjn/'{T]s0."gn6`^a?> _i$!{ƅ@ڜ(Ցkn]ڜ !`fٚzJnGk@iR!6&.?^~"XT ttgC.btC]/P;,iFg;md< 0< 'L|d˷:GF09~S'QQm '+O֯ KxV+Iڎ5gjNj9Bսn?ރ8iI^|&'!~(kޖp˟=>?'B<4[>{1ʽ4Jl+ƞV/[jE{yfzg6w}ED`Z.jQ9m?fjk 7B[Ikd©'IT+/@BdQʎhY;4":_0 ɨ7 9T%ீ o%7) D"^ꦌ#JY-zj}z`4')"?Zm=-2|[h45ikʤa^6~at#wL(`VT1*Ƥd> e2a:9#/09#)Ɔz\%OɄI}Q10ݤ~ 5&,T ՚%C&c ɄRک֧v|Q5#!vJ$v^ Ϯ};p iq&d)2]V_Ʉ zzL&h7*UpQz"%f{~Z&vԉ}J5 d݆U8ǥ0WL >d”:0P.v4f,!$l wk}7L(Z( c2aDk]Yt`.cަGLxKL&LBU_~ɄUI#(- (闁_g2p\(:~Ʉ׻sc7.<6[L&Lb m&F.dlOM8o5>[dˆZڴ6.dBI:]E >~v uq`Ʉ u!yZd>'헸YPԝ'cb7/zQgV[FD}-nȡO "ģGho*q"GiBrU2[Ӫ( R[D4(g{ *x*xJhs1NgNVشѿ8 p/G„!oO#2Q8a|U{)lI|:K /oΚez֊ݾ|Y76o:ˁBZ] 9YgoTcI-Xwh'-:Ჶg3:*eձK,{{#.n+^Й Xa̤?mj' Q$lؽk_sjc锬s.QaVFHthM^|,_BMC<7E-&R DjhHZH ͢lYm"54 Sk"hқH뉮a[t::2x On !o[0C<i:6|/uZt]3Bo2[Hi*tIX8a/^i [wȧ\ e]Ύo`c_Δ,OZ1FitLuzGu0n5-]:'[ msE7ON<|O_c_wCo}Y_7dOq6o.J1X+)^J4fY*5"Àf۸6vF!,؀˷=mG[l:*-Vf0})I'm@PEB EAE=">Vb1+Xdi%7`wxXbӫ<9q/GDy[6y#U6?*df~*Ւa[5#R4J}X.O? ɇ1/6SG9є@6Ncd!P&g @{%6B v}x7dyYhڬd͞{'Mn:'梼i-#`@-mv V:徣Ojٷa(j%զ;cQ,ZIC5ۛHPM]p7y'J]gQݽFlYS uܽu/\-HIT4\R$VbĥDR$J,Z6 hfXr؎8v{KN^8y}+Wk_sܹ3Ys){|qjY˘jEs?)1^gS FCxx{L'0+Qd q,Ac^wo7ɼY-+3of2rn}+xFג~gwWsE%HDx-hY&ndtQ&ϧukN=ubTd97[Z.Pd̘J;P8B (aKړڔcת/0s~mvI'Ќ^,dSg=Kzwe[P:"b&J-l /ZQ1+J]wCH@yx0v=Q_VYΟl?4vh,o .`γTqI] %zGt] '9MC`?qs]FZ0Q\ Y WF>QG3K?*3ÏC`w>~XI&UxhjW+gacP, }wb|]s=eĨɧvtS&esӦeٽ'z18Kv㐋P rS32 1:!T׎("5iۖy_/'}Hb@06Y4m(ҧD_pMWP!m9c~vm@u)# XVD4%czcuW_I]cG!kɵ4w yϞ챡B,Fv9Y=99ӼCB4}ǰ~XXr yk=e;Ŷ娢0~$>[ :>uxݗՃ_._KMy*]A?˾-I?\|;?lu5l6^Lt++>&5)xjHv[Dvhp522J鈚Y m^ 4XvJ*-,aA@ifm@3Uó#f .nvwYWMi醞'L+Qˡ)L/nC>MSD'͈@֩ GMhG]Y{!?|CgG۴F5/((ԖgzvÛ+!k-x$28Ϊ#riqp `MZ7%[-˺j $ʬ~tC %y>C@?[яGAU+S6K1`t>V  4w}tcN:)]n|{Z\9zIݓ\y1ZsǝR)c1<~SēO:x1Z<9 ϰf2-_ܩ?ZukNjMd ,~?iLdvKFٜqr YPE2C17X Nev {;_/EOC0'Nj/ŦжnCT +ʶ|_d-:fxQcGAQVQcZ}nCq!3.n>T&3+p | |u[Lx1ĂnwzګhfLoj}cUl%O wݹLR?yqI; ɛG!rrƂU{e/WcBahYdQ ƣH%CeegA'+D Igr VsK jAGLYHukAKM<_Cc-<}mWYa]3;%GGZ.gT6]}Wlijgm&Ӈ L^ۚ4ǶL+N+UVlۛ|8z֢ ς>t(]Y/@t{r5ӊJ͇Cer9 ӻB>[qEZ-H=A_T:h==$$h9Ï$p+].T뀩z Qf$kSI{~`3p -su"#tj aǫ/RC"\ :;$&`?h)'nvYS)<njԄ`?b@ | KIE)u~OG/?; 8#_~ /? {9 |&xJ[HgA67\ & V AK8-ozھ=ál*c޴9\36 .+Q I4zO }Gl^eJƤ^+{-r'>l)JH8a~$f褃[5<8ۯyu5K5;*Q2ʆ;m%/LK WyʶN-< W2[X~f9 ρG,ϻl/W*I7߁w { \o`Iu \ZjrO$УLxdq+La>,Xc\ÙaAȮyEb9hv`t"eE,D[ -Umӊ|ldσ>GC+$v6 7> >yj 7 QC% t藒Į2mē~ACeюzV@ߏf`;%-4d"ťJ+6^<7%b׍ EdۧBAKf7 xO m?4A_%:ih,sYVuZ^G"0w lد#y-Czԃ(䵠_u0 !Q | ~ZHؽ2c;9UWTF qW-$g_tTZl- _6V1 e1bM`.I @z'.Fa,%DZ;XުU ,j3zƺ7k^0oG[_x FPTu2貺eykAK=BsWWL8$ ]s{/W{7{D 2 zԛωK5N:v_uI[G]b п~%@'r oIz)=d}]mJ4hl/ jcf%-釴L>PnNr #|-h݀'A:NB_@<;ue"ql}*?qi"Al+8Q fQmж~̌2=CCw]xԺyy_> ZjE;Z"v/'I3[qJ&$!YP}+~oK+>{{]v5kà\ )%Eo7=3OY&X:Ys2EzbpoD~)!!Z0Y5wT,$J6޴3"nKX<fw)> ]bwhLKR*$DX]Pu(S"*İt@;cԶػēt@zh/'ah D& l2=8L:6QlZZtu}J7-k>9T _k?`1Ae+[32GX/$' v~c[Ϟ 0n9֧dJ~ #?RԵu% &LC+-w)Mۛ|w13%ɮn4a =WQ+ 42-Avx]hYYB>AwK#NnTbw+AwǿuOpco,XVp5ꁉv݁\Զ~AcM8GtY=7 FY je-:{X d)[usԴ8=Ƒ+v)O_YQMe_ʎ{mƻKI66ے/z`\2We5(nܰk|(sm[06g(14vr~.mx}½I;ݭŶ /f-6v4axre}$fv]?P~VQ)AwOiAw%B ~{o6\_НWc(UtkU ֑S!L Pq|[l_ /`9o 0 MӬ#KTo-hBUAyzDR;?t(׃ߒw&$kV89E.^r5*9?HbZipy8,uꛄ'g Uʹ. =G9l=tOM^l\ ;k؝W ǘ]Nu㧗0;&,yIF:}"]E~!<H>c]YeV?)~:J[f$%?YXW[Y[mS&l(XI['MH|$Y&LA4aLeMaohj4|͏>8QgFl^t w 'f8&|_(C 2"Շ+ L\QgoϲR`Ucڞewkoe+RǨO62YxN{Tp"=kM疋^ՈDs FAЦ$h˜ޮP{'qʆ{6OPdԈQ&LC,+ή.@<1k˓S51WkF~'B)]a[m:6vޖNiw*4hz!|+AͣHGL{^սchhvv6AW!H}eDqf-mm[#v@ꤧ{gγݝ'Y=m$9RUѼdvG8z>/Y /(UN y(Rg?ܪ@Vܾ[ʉ^ |[YMF Fv5fv宰%AYf mJ5xcvմ*vVet*GyQ<'RXv_N;YveX=?G]ӦghC%N^E,](( ZEo,ǺJƚI9|+&*%/6VsȞۙ!6{6SYGmv m$*eAKE~4g##{G~$oZjAG"Gbēw mQM+lnQևC5wAځv*fpoGu?88ٚ1({Jd=e?JIX-w|;O;_޴]H4zRWyGzĮ|a74)p1q@kE^V"<| KjpE5 J^Skwbx+NFY@<1͛<ƚc4R.e4 bFwL:lF.ɽPeKmk*ɱi{5åd*cbUsܫnV+02Z/OJд8OP\Pc%gr>d&tfveИx ,E22+%`A03of|r=T|}TuOj"\G! :b˵g0UFWYb`Ŝ3J ]Qgn4= ' :ݠ]6^dtqUL8^$9 L l`yx)q*׶e{E9MJI{:r[:MQ3]bvpMW[CzYi7~z \ zm:9|#W hWtgQ.s7+gWgGllȚCrn-;!R`3qޝ=64QȎ##c;'Kc''o[C" 9^1 q\B%9tK/zhƐ% ]@ܿ)xxAl_V ||6 $~{[lO?\z[HEkxe (zkYY6yrgj,n&خ)nLx$Pg-U5m.eSoz$mģH%WL傣zD,&]M RbZ =1b>ximKC UzVVODB@KZUģH-Mph{}NmƴM;.rG{)TE8UOLml]n,GA6b?@7RVnO`d9 | c>t]=̃VpOMRq+G޼9駰?iUí=w)e]O2*?uߑOwؐ"opV.Nߣq]Ϩ䨳/EOC0Nj/ŦжnCT +ʶ|_-:fxQcGAQVQcZ}nCq!3.n(8r8ӆqs>:߿-TY&{\bf@$iOG5czcme[/~ч:̕$d%$+$oݞkȅJYh[}!'¦B˲$Nx=h"ݮʗ ass OT]IWF >tf,>dr` *PjОYڍ#JZk̢/Eu3Of%+$nz!^ Fr%45 tW׀öi"3Sxh\+TcZj6ray#jseΕ쿑͊>b <,|Vc;+<>#@2`q4@͘=GɬΔFn\bʱ9 G/ZMH#vnA7"(avJHFx [k% Nҭ* )5Wj7}t_o#e}Oe'fHUBűQ%Er䜿#}l9E^"Ub bYu|XQ3ALx۔x1Ӏ=$4 eI?\A=Q O%kL0,I kgEQ土Nt@mFImyt=4bkzf~&ïH3&Zg(zೠUx>j"Y^kH"v/~1 D W 6 WĮ&oJ?\7Oa W4ܕ1뒜j+ceR'_Wwry>-pO#s][:-J@nݨp #|POOxԴ}]t1F}DK\Zj*@.lxN9B\1zwzL9|D*ZI#={ēG/!iGw#nܐG/qǎyD=b) !ZpMׂC1'xZ`8|i5dʲi}v`}&gV1,O +P8IbρV-5t~e磮 eJ` t-Dz3gҏL~6xҏL7 `d⛪$DƏL"=ϢEjÛ5XM0<"g%'5E11N5G0v\?'fIǮ- Q=aߞ/!|w1ēllLcv]oզS>lղ^4 $VG%t]JoF#jX|;`|Y"ӡz52zcB.T\7 π>'7Q;$IГw|Y~N6>74~`]BA@Ԡ}~i? &$%4sρ~.nήXWӹI\Hԟ~GoT]/c?~B?@<7*~JeO^߸ecj,͘L> B8S7!~iЧ;_COҡς>~!OG1j1}$P0FkS߲W v9gtIfW K+NlW$$Ic-^ƊL|JGdrEcyk) Z#!ڠ#!OpS~ F¢u_$HzczyF,S б\۩o'S@ M 7ub4x7~wS Y_m:3Q,k'ALa愧@K .`݋2F,:k^2o}>SUq%͠\GyQy𝠥uU[^V\qdP74,w 7b "/܈'EX;r$bxeW=FKQ(m?3g0y~X۲Bz,^IDk̙ӕŅF#/nA?{x @(}" =VxͭzВ5ȭBDV3檺`;Q[U[\mo>@<[VXDx9^IKu;p{j|.!qojd=qoA/}&wOƽ -Q^'qeTu_ue{4I}5 ɛx fk{mPouFv'$-`vLK+ŢI}?fih-yN i, E҆zC`>Q:`61CҌgjzZlSʮYôf 5cX)/z``зC6h[K.oNҽ'F:}"#<H>c]ӬwA|Q[ʹT7:TCMB.p)rݟi'Mj6 D 69"ySV3a첳7mRzj'hsjӦik`X~Bw2ṁ3hi 崬9mRul]^,2]tSUʺ#v;7mqB@6}7%z{O.cn ze Ь:'@5Y]i7Z?$Xs BT#\n^{bLKnvhܻ@ =)#wn21v{olXAޏ21#~RPE-*emtپ/,EB<,VOײ%9_+-eyeªdۂ :&NL .4Jh&J)R}j&<&T}ȟ+vwLSe~_tNcZplo>M=Lv_Y뺂߳#;M<(z}"R2L1X|Ra.%}Q-Ut4 |3t @lq# &M B-pD4c|׷D.*:wlt"_h#=;}.I~@? e?Q&F[_?A5 ZnMmTBm# I A}:Z>@Cl- >G/%@S赎j1ٞ!&gdlJ5s,\ [#:"w3Gl'.cllEd0 Rnfdtq%>Y+Jk^1/e#w@a@o-Dޕ;0BQs8}(V]Լ L4!yqƄW AZ;Z `R YM% `&>YM¬v¬}옉ì5%f)jnq6׈$?6r2-m-p3ɛ8̖06m&O&f/Qug%\7K}D6,s#@k>,&{OL1ƚƔfQ1Qh$R X]U{ يu~G {""*Lذ<@_P].ς~6:f讑#R^s&,dԂ Fw o53G}}áz i`I 8c8o~7oaoObj[eٯY4l-m ]:fXz`CSR% Wq X'Ųie!]/GopEi/w T:NRaX).m8j̢i2^ [bW :TԽKB bNρ9 n޽gppR^ூUeڶrJnûX3d${|C~ g Ob']G5 ξ 7{Sv;ʡWe:qolCn":b u6¢-&}u#!!U'ݦh6m6׀3gԍfv"U_|Bfρ~.:lfedtltppdtoߞˆfd{r4hDk#60$[70;GvbēG먦9DV;4#ì9h[ZѣY0vYT?!]bJZs3@aO>3n :=Nԑ (p\ ;=߁Vƚ 3)!@|+Ckbc3ܾ[ʉ^ |skeα]COnnfxlgت~oUۀ_9j(*ʼCI)uHw=إ-\ľ'x$vU\qv >>Nb?10~#W˝YpW7ޠmC]B}B!z]/:r/Fox@/]$IT%d̂Φcӱ9йYprXAQ5<[Bq=viG 8!R0{/*W*ҝAyM>ZjFt'bIJ,?+QOKK 3=-5q*gAϦcpAS[@x:Iϻwfqz [Iy@IYȻ];N]xx?Zn޼J2xV4t(\zM$AvIseGK [s~RqjY˘jEs?)1Br@BM ]1ϊ7iaD%0ʇ3rP9Nj&X ~m,iExbx2E\fͬ6c6+KviСfvBInnςjt{ ګ`CY!5-*!R6@KGG5j{#sKej42~77v8T51Kx/&s;\gS>э& RSFf!-cjeo~ďKDw>A-0}u"  7= >dU[~W30OAǟٸHuE(>"!|%A6oըmxB`дŞàc}}CY-3z zG5$lWճYfrZ i>ԭǚwrܘFW0ls4v؝SȓEľ'&Z]NS(1\z2ȟ3gm2@uR{>⑫oL+ %czc5~eJWC> Y~HխcȫT&Lwg Mjf4c!l+֐D9N1q[B9KX*lo$!{zW̪#1ÃHǭ\YE\Ab?Nj-ߤ?\|?Էzl>Ec_`˙-OecW.w+X]O_`C9S Tʹ,M]3܃ji5B"Nt]U!Ym^ 4^nfQU ̈́/O( U)(&2 [ )v5N1i &.CJ6]oKmۄi 'jҋ!G3rFi)tH8>#+CϚGeM7CfjU9?W*D5NVGo˺jK& #!EuE?|?6H'y\E~bW> TfpjЯV"nI)EK_JG1_rlLЩ"镸ٸ@ޱg̒Q|P6㖫goޜ/doC,x |A}T37\*_'h6ĥ$?郡vI; ɛGrrףmgV-ږeX/WLhؼehYdQ +"ݮʗ as :T.NV?#+ -D',,.>?RU} iŴhmE<ׇ7iuy^lx a]9_wWӑ?.趌e5~W72'CݙrCބIy]W#]u]Ms"UWhd{拈]Ʈ諽$=C2k%\je"%we%#[TZ "Zn5.:o<HkƊl(!uH I'Yϲ|e64&݈ߵ =׵WG<1kE"ME1xpu ٰلoj1/m* - 8SE3$1c2rE$vۨ{5;U$nл)FzĹ xtx/{R e} ?@v* 'UZ"crsK'΀Qk0:"._uɏ,_OVީQ7qPЋ~2}F}[7myV-?&~:wA7F? 9&8 u5&ՎX渚eD_Zi<!<Zn$z mDHg@I!vς>bp$|]/Џ|ē~=PYW WvGe{JzN,dּͫpʰ GܢgkOd=lj[2-Erϳ Tъ~AK=E+bw"c;J@pE|#7& Ms+M$F0~Qy,w,I֒٫a@oJf}(*}_6ͬU6#Io%8WwN)8%.eL`\+6۔qhKf@gb+%w 4=LS}e䶔}4U},S U ZnZtrٞQض("52ǁo-ջۿ8~á^3ｺ__QWc],~ԾuxP%܏ɾt_#^>Q<KJe{sqQMd\7?ޞ)_%̂Φo~0x7`7$jKf\~ؗa)SvvMҮ-5][&zOvM Fu-][1UIӵa7v֮o-1\VJ {S"vR Q6dА\&-0m&-m؏OblfnR@ZlܠH=#v#/7(͐殶Y%fCڷ'$hǀ'Z"׎ss\@KNk˻'A;>:GDF@m;4r)-ҘaoNFtq6#ٖ͑9._.hkǛc~Yc~t+!AS~w:iThPK Fm]Zjey}:4Qn;)@#S22hm.>x`D{d#=#igOZyK?uZT6dzt5iαQu\S_PSkS0kfTjg.7X+uʵd_~ 蝍$勒/"?sJ~ahؽ5_E=c+:~/QM}AZ9,x,~(Ϸ +p+D(h EexyyĄBbAI;|3J"<|=Z*u<$³Sʭu9RB_H\WCdI{} A2{}=?!@ F? Eп~ UXxմ`ւZxM8SٚewWVq0^u<k\Y\Ok@C\KrUү X׳?;mX}Vbq>VmzK s=f7',U[@[Goov)sի2m/8p8|i׸\F4'AR/c_~\n4K>n%Eɭȡ2?釾ۄ&=B߁y@m"*k%ӭO-6Vwkڸ.xVw)>nG  p~?8/Z7"voL&D@L/+^YwݓD~Q_-5liY7䔲A@IW}f$]P_>cT.;J#3օ#/o#$ׁyXp|iI0Jڵv^V;##x}QOץvA?azMȕ$ʄj5J ́E S=e+5Y/g1 >;EqƂ"fag>~4QuE5x`ԅ3MXdžFyCWctx&171ĕYF@Uk*&Ky3c;Y.ς¾UR`SȆC{G2/+{ BM) ϘFq+9'BM)܍͓DΔp'yFf9]w7h E:ſpvv6AW!9 W؞ל0M>C"xu+7m;!A\w0^+h85#9z56ӎV>ݙ1e֝'i=Gr-?iҬ=ȯ)}޹h9_(C,xT>6uܵRY!6v0,Y赝yGDlsՇi vzlZcő{GFwD]@2 mB6 ΍ 92gt7n߈ɠ&TEʸ_m;}O'm1 QMc zdX;N洳<4pe)&aq '}9w ^wM73@!-un3l:b:RM\Fwv:AȬ{vc'rB=` t- ,"ɷ,n*ЯՙQְ18g=|humTFGڹg#ãûvDlTHܷZj5ZB 2h EsbI[BuTӨC##v  U^HsB $ߜ7? Zj>^' -]G599iӰ]\֩qZl ft ̄wKPҶ8`( < Z <: 9>`3X'ؑ;f٘lF2> M?`. M$3:Q ε(rdƵ >88JSFd&-kr1=ꑯw$!΁0yP EQ_B=*b,5_[2|wpp{1:IZˠ_NC{خ]773<3gEP~kB:Tm5x~ec84bllTkoʶ$r45q|V$Jg =(wX}#zB RnBx-k Lz1mB*p=p#ʭbH#!m!CŖΒ-]j3.b7Gb)oN}mydb%MTQkA6.auT>ID0H,wVnݰ&tJϊߍo} ~x+[Įδ$6ҵ'd:<H:#Ixe: |tZh֚> P RHQG@D Ȥ"~MLb"y? :+s[/v' 4]"[`'ei:jotpE5 $ q.|頃 ľ'x$+N\jQ5R"3żjbdR <)W m^7(dG?v5uľ'=1Q&Zׂ^qΘvsBcJ!G3Ѯ]2Ho7VW֋Ϯzŏ1Ce_ִkuki yϞ챡B,Fv9Y=99m C'WskaJ%T؛BdCݖ0 Y]UY.~$>[ &>uxm_._@,68bM}Wdb/`9O8~o<^0uSߕg(Y Ly93Il,eg_w@i$BlWc13;+@KL[z5=*I[#~M(Ƚ<[wQ5ayAN6<%#13r;/ Sb"x$u480+M, I<8kdiy V=ǜ㗙̬0d >խkQ"wZ | q+goޜ3y4ci)eqy;'OK˸o}iy 9i89dߖm,.^ @.ҍ5@Ռ)V˶^BB5N/YF`d#b?GYs ٦kӪE۲ -6 e I Zؠh/7E]EUCWB=\H:{oR+ ]=|ܓjf!db-iЭkDC ņ\ Ll/vD% n:)!Cu~EWVW|VCӴ'fH y^z=sben(1<|7ď91xYrȅĮ&o_Msd&l2z" Ch6p l!5?Fsly>xo8AP<, 5 Ho O$o`O~2}'OO\ J{iH$!Y_Wc "?ݸٿ0̿ҊOWg]I3^XQ?+_t>@հ{BNO>v&Y  }`ID=ųi:r0氅3ك[/$ʩ%Q+@_ɂuj>uA<|%? v_'r"/Z-Z.Z/Z7Ojg F+ D-meiы Ot5׍5m\HCYYz[>Ý{@ vx (լRc fVšN$͠Fm> !Y|$߄\,ث X]Ze rj gQeJg9Yԧ_t41WA5664WV1t+5$׀/ԅ~LJ]}OG] VXԛ cؠԴ0Io4"MJN 0`NjݦqHЄq;Q~t7llGMv7؏6fw&^&vH踶9-P]lZ`񝝍cx52JNE)bN ;끯ju:zEAK55?~Klo>5@藒YR/e/蝷O1kgjcf!ɔ Sz#L*u<N#mvpM, E҆wLs=C{}#-*Ԍ{gE/<zk5cgXsg&nB6<>!W&8A;9,]>t[e?*Pt._:"հA: P,1'ߡ vM ? 3+mjg |Ϭkx6Ɗ-w/I hmsn&_4ET2nS3E Ij &@$6ݣ! In4a ѳE=[b镍i r+pHЄi{&ݠ{ɥDc{O 7kP0kF6kp,QkƢQ#4@=!ۿ 6xү +j?NRq3:M7:M㻱i ݷA,4wraѐ&K-QW/۲Ai#ysal骋 9|fH~"}uaŋ #C_h% ,#67\<2AE֩T% o>\9LyPm~ zB_*=א×j踵L^;U3SA#QmAQ^Rt|>I ~L%b,0"LuJjKL5wYꆊr4'T+Mɘڴ-b!fv2ULzW;S[iNYVy򴨂u_} i>tC1@SP157v#K Y"0#t)R,Z G- JpОe5W|%0wIݑ7,m9v,#vYmL!ȴjdV+TVbӡj+g:C; r]ӂŚXtƒ1F4fFnL˘9#'Es;6uyokFvoeWӂ(cݨN\[ uJ]wfor\/xh%1' }zam/P;#(t _;.agě֋<2-C=gL \|/vA\["k'A%?2oPxmI\TJIfm)iߠ&uU6RPODvIA'%`~# 7dW0Hd J0)rfwffr\/0h=}KO\k-ʯP[ m#[(A>CW?JAwKI .EB+F, PAsB@dVڪ#ڊi[V#kX$WkV:)`nC\6(D\ؠKrC .M1p@P" })% }ILxL% ~#E񋝋ST~FЄ??+#hDŢ"GKuJh)3Eḧ́G^"Z1rҗss[H)hŸhߒ\MT"-E-)%-EILxL%m6+Z;;Bݑv*be@\MT"bSDSR.+bJ/KDL5'̠rrHEkf[}yêU Go~IKzĬȩTI[Q>I08L @)WO/~IftRSzaNٳ{X$:^>Ǿ iY͞ۑoBY Nտ}TSkX)̶!k5rHk׃^YMFo}Cl},(K,sjEpw7{f<2Rä\tsW@NR,3ϧ*hF|J|CaƞWFa~GQ /V\ᗁnRʨR> hYJ?[)c6<J ɤv*qL#G3@mw ~{v H76Zi%#&TЛSrC Ad c*s3O/B$)[MHʮ'څ} 1ATlC8 &} A/CЄ1nx2QOjsq07"sMnSv%Ko GЄ:L\BI &4a &sx\Є1MZwUod$'hY6d_ Di.l9^ kij@(A*Ќpx cM>V./%eHyrV#fVin˔<aQAcbO,(qAL<'b+ysj*n1/+IM'"-&LCi*h˜JiU)yӔ jƤ^+{4+B[|1%([o 0 ~Aȟ,qz3zG*x6YM(!zfEEl ^ጻ]+?yPǮ7Eq& zѫ˺CVXgVvzٵ>OYUɵp \EAv'fM-MN6a3 Is4DX,a9؍_.r Xer>~΀ M 0f"lQG5?| DN gojl,SeZ$aJKɮoA AO+NErēS;X]#Wrm#At,5_[1-1BɈ!@S3fQ6*+6-m"l^;َѯ^ۥr>Kʣw5R0>E[Є1 z~N! C&w? |DЄii c鎦PUtٻV6)o5z| NAK8Tm?@ICW8r<}&TTfm_Ke1r=+.quxbL-h˖I\gŹJY;}GTA}Cb -q?愱/xII$JF#|c zvFϫ,qU1u/eVΤVwZ[Į6PF.xw@n}FBt%-|t)sUq KT@R֡Z)BN=4@wi$]OAKE FĮh6FI[ۄMQI/cI5gke ^0B3Zpq́ThjZ3vyE}֤%*k{p /?G@bٕa!]7(pjEZĺ|U#yT&T5??j"A 0E6Amã/.,0'/5BVFľ'񆅫3ȞVN0F;}vۏ"n]EAɄA.ZK,5n'uzio'  2;=]6/g^#W&T{!jR1NUK-r]d : ~jeWLKXǯ-[B-.>CSWi{v>5HwC|C) ']xNr`K Pn8 vЅĿ,.)SђV@Wo7@[63:ƆY16&?6"ʔs?:.&Fs#cG aܝ1#6$$kb*௃#8D-:iHNʚrS4n}ATw)^*#( '^am vX]NM!v+Bg6[@LE=wI3=|B9s;GwH<_L7]Iٽ(L- VAK]E!v/ZෑC9b(*<{p mՆ;T#守+.q6GsqQC%Qvx2*3] 5 lZB7ޠmȱb /yj cZ&Mi+6Rנn3jXtH;FEx*u󠥮I`> L.xߕ .^(kN%Dx+[ĵ?n{9clwύWq zk+"ftq8n|An$fv{*SLMY2-38ȄEqar? `[w%6.D;и7.+яgk|\>YcP]R(ղepuUj<5TdQC<-t O~> 3n'![)QD"HQ?F1[ . ;<7lhKG] ,#JM4ćG5١#(a'?YC 1+mh<C'G5f̎.աi10=~ 5=ޖytڝBvRZmE(SQ&~@EjY?gN3NA@K_+~}Uz&O]2Io7Vw5E+^ b66dM!VfM8(ridѝݓCȽ5Tѭ!>@U {*e̖Pa07qjQrw9p5 #aÃ&-2\YEnj 9^l?Op͇kP_+>NWfX`˙9OecW.wMN'dg򻄄͕Jֳ7oNW&4cvDw)e];t.y;'OT7a5>_w_UH+'? 8:t Ll8/5 N`kAF~,"zՠm.ϳnN~TCfs:FiCYh?xQ^2ħ $}%ߧsez9eQ 7@]!";SnV+3Fy|n R攃W0ŔzԗZfuN 1`5>^ vdiCT.gȂGc ~/z0mzٴX =9mʎ 礼#ыr%' $YA(e^Yeo,fbe7zX5^MlsQ/Fcw^&F/[D+k@K͞7\^ Zj*8j3I\+&_'zS'nrS&ۯo#H}OH+]WOZlXjwBQL힓/-W#ӕ-\[]KFF[ -Z_WS6֚eGusg+0:CS; 8:~;zfr? =L-+E\)t2 ݱ "I"}Hbbʕj}:}&j5*kM-T=C'ZF$U*CJigt4N@(0A2,>@ZT- Ϥ_~gts:?gTB K@Z5@Cēst^ZÐjiZ"ѫ+V?݊,f-;- т{Vo@"/_rA:~'ug|ӯh}5([ӗ[~j]r)*xKqCvpBtHσ">򛭓N7ke/E^l/eZ˘|}DgKƜmϲ߫NVer )L9RF`!AwKim/4aڑ@I?$ܑcstAB>`9VXdrjVݚ?^hWk:FӠNn'}.}O I67& =a#c20/ IxF1]OYOcp3D=a9βIkAĘf=#ݙWK_ + ;-+ǎnM)Pq3G+%yGC5}G"@<;-p[u^;!Tߤ"k^Dz.Scn{@Khp ̟ :~0 ľ@<黂גu:-!YP+LLe|h@\N'ժcWY [ag$ȯP=ĥCV6Õ  t;CftuplT'= F%֧.I=.=YE|9[0R,HLR! @V!or7'n1Z?`k=O=ZMs+GeCev`,OUeh:EJ/qh Ge'])2銨k/~1VDnۙ8dzgAl"yۗ?7 }*ns6?&j(%~=PJzC)dJ_qLok~>3 bqݞƇ |HQY5̩i:fq@duwz]ô''i~U.Kbt4(S˲It 0 o]!+!讴v[՗ޖ4q(Sm+R廝 A6Ѝ*R -u@)ZH Aw?U$V'V62<R~D$?(Vma)֔7򆱨:KƜl5Guc]OBz+,܆-59>1b]ЀH|='EWoH H7_\nZ槁>eY$7-1|~J6$ētCBzoH'va*QH>/N^ꦊLvJ3U@[ Apv=at!} v|aFMz Sr՟/_ z?>93]E@%\4A;BO4병؟ a?#O )H>φaɆjϨIH|%p R{m6oN2 ^|BިT/\5B>y$?p>|ƺyEυ~铇&?8q['aDX4ؓI\7N~3aCɤMVƙ@ A^ MT)r& -յ4plOұAϧI?6 ypxe\0B~GB@HGaՄAL‰=ēr:c0iByѺ,ˌ9S2;&횣;vܮ?mJx~; ND:qm >FG(}#:xے7/!XPoʺ?.GUǠ8y7#? ]nlG.7ujlG".X.7k@?_+k|nl WG9bIvv&sƔaEup]IdI~huMHW5*z`tAլ,&+C]hbáb3gmԤr1e| /㇊`? ӱ֡&h(! (AocT߉mT=*' =п|KGz[:bI%܈cKsuD_^"̖ްY$ni :JQcQ]Ui-?r[YT܇#ZIZZO(QX #R( 9KUN?נ&tbI7U 'QKKz#Q=o@M:z~lZY%a~o2H24"-J;/4a܎Cn$mrAem"+?wv 樶۴'[ N0~WUã,I֒ݰYM7oľ?x/_WK4]{`>#qŹ#xҝgQTDWg]M;%cG4Fz`LNэ&%⩰r00w-el+pOz͙IG?4wLwW nx#.8#§ho`ɔtŪ)hJʞؠO;Gȓw$PQeUV -qKm&LB >#nMUarXA.sdNU$R4(cӡ1tHjQn>Nt!h´#^j,AiZr*̬|Rc1Ÿנ{=7#h |\k ;꘍$9 < Zꚍhc6bwxت}4M t';R2pޢ08kMGML J3FVT횖uGI-3j%AؖLEe~*͝6M{ӶkX3w] ̜˲ЍsEEsQwҮoO^1tu1LO`Mv',j" ,r7Χ#wd" |L."ɲ x+&v7[UMY.35~ad>5pVc:V?Ϟ5f }j)gIsmq Ra~m<6|j[SB٬<6u^%hLσ^-h˜&wK=PYBcMTcRx v~A؇r~}wǢa1vEʼ -[+kc9aRch gDYφCe.;TAQЄ4aV7 0%O.hBEj9_F#[#g4 ki\veWN47 IƔ؞ǁEA鞳{J5}N@P^dJY2Wycep,q#q+A"h4ᯁUЄ=GAH5E #q/A_AHܦ?%'MND% z(zC'MSѯ[Z`$_ᵭ3鏨hZ\P^$oDj"1&e#A/F KIЄ1-c[oXSV1-i5'I{{f̂FX[j&4xLi-7nJdx [7lbw P)Pf;ZM2JzCJQӝv>[M?ot1SزvC!V/{}JsIGqpSN A_[W7S`K}ߏm(7ô ?N+_gGZЄ)({ p c*k%O-u& x U\;6I UR^ѵsp cģ(Gd PZ$$aFMV݂&R WlF?S +WbG&SG5U[J9)WоY,;m7,W}m@V}]lok4~V1!jl}5eHgQ2ծ䒍LpG@@[KLVDA+Mͩӑ@?|77~clM/2MIyׁ-uT<.vG>ArTg??Gr{4vd}dƳ<, & KY h[0gf#8r/lrS}#U)2T#8Ǧ9E[/ˀ X]bХj,P|(Jd$嗽Òv+w?ZW-+ =+ӂU8h[OYƜOD𓈺3z15݋NQ/;{QM ]AJ΢k4xmp:$IwICS+Ghj抶.bR,B [bY,B$]"D++_xx/{cl!>qǕh,B$#IG/'iT)E f_I#tc\6gW/}zQ\m/[v.-:GGga·tCTڂ('b-?[pq_`}AЄ vT{Yl 0~zAw]Q6f+EMH?+5qI~GMHC^& c'r_2WMVK|d PGp[^$ IWjOZyuj(]4Ybxv)t03$&жK$m2椈Hl »E?in(E?~̃%/o*K 9)/Nl#QO ^tGV-$T^۠kwY9?1U&@P%ⴌ>t4w h7o{"o&G@Sׁ*H>:!;|t!JAK8$ERt8pd2-7'^aJF6 >L3+7CI x՘,k@K Z7t@J Yw"-s.d+Χ,ʤyPwĜ y@eMֽT [ 7 0[ [n6>l,X~*1yfV"\$Н4I,,5v2E停ߚZ5y8FŦ7׫L*8Z(R!^͆3jp4QQT MD={@qՌ>H!iTCiΕUjT̹ޟẾ6u92Xw* 菩 v٬D $g#8 66}iN2E.zW13Ӕ>SO ^|__J;HN7OP(bH~^XQ9~t[CV6T}5(2-G8DԌP۸qEcLQYxuzD[ ɛC0W›@w`,B7O;sHt{L +ATfYs#^c34󭲳cIsX=h}l m$d6>O®O&gItm$dgm$ǎ)Dm|5g;_)e&N}0y?>x&~ !%&aa֧5EWKí7Ix7軓Ӱio@og`gE@,&XP}]-7j ^ zO}Lx;7lbgogag5$TPsS$d$A)M¬ ;7!ر05E,&ZP}dg:Opdrw=~z 2-5̊fò |^d+'Ob<Q2llhL#e#0c]53&Oi? q w!힭>*fea$^Wh!n'#ƞh$&h^ychknj8fj7W@wmU~˳5"7ZOqOr=!pEIw2CY1wPH?+eyQ cB|7zw4eqšWOZ2w)3Q z-zǡ'@˥lړ3XuljruBiw*4hwlA2:@zk¢Ro"Us:%X C%yĮ98UoX?OړެDmVHGsoV)<4+<huٞzvJ</$߬gXVeppn)'z-e/+S̭;v =ᱝ9sx,bBe_NU!vo~Wģ+̭Op.P-vut~6ҠH"4 ]k2j%w # > ,D_fj3a2ڸ*V&|{r-s#'{ ,*5d| u# A5j;ifYx?(za#GX nzoN+n)zd< znlPaCNOnY/f;) $/1Wns(1:`̓n0<w2V Zn\p} d| "+3 (ᓠ< >1GDDY`*k;E]/3QOX1l/r.L~$víjK1ex&= he[yZĔ34#C)y0/:oy V7oMVԧ*%^Dπ>b~skM\5oΤrZ3zbt NMxinڤw=a'ۤwjqp3_T)c(HWs[=pO8]VCnfSV\3sx$T7J\^J"5Ǜ"˘%o/Lc̹MӐjtQE>-R4˞V@ݧmTw\_"OQ:U^?>E6Xƙ\\0/p?Dj,iYҢ+F)7o4[\hߒc_iIj^@]U֍.g!*R۲"o4]px}NZ#i#=#!FӋ 銑"-syp-xG[ ,>ux >u_._DM\A? -?\|?ʬS㕭odrfГfX=nvѾA?O)  M5-eylZTDOWȟNz6Dcee%|D@Sàj3r;O .5b?@ {ӗGYXWbT}]1bC8@{/ "5.]kz uIt/gI8Gtz"xIg(ilOCŢ]nw ړZLۖ%ʵxe%Ky,Hǁ:h]Yd9I cs)҇ Jz%Х"7'8wC=3\}6W`uf꾓)S'vV18;T ^i^d@[YCbZrDCvKthOIq<zЯW >@$O_~ b)843?|B/? .'egɵ.-!Y00_v޶{&B]2MhiB5!Sa7,0#{~$y_c'|>,x70RBB>``:K򗷈0i| S_ׂV4$~7:fЛc۰I 6eJ/WtQ]'(:9H1d#t6#F U>+2ok ~H;i2*@˭=TsZ+!ԫeJ]w^ZgV6ؿ.xn]oW}HieS飶I͆EjOI Z565A(]g m=[AoMZ@˵M$L(kg2-zFWp XlDoCF,9t4x7;(2kFJ'>N>!>ZjX[wqe, b*=؇J^{ov,N?/՝SıkV)cPiA'σ>c ēcl3lP] 9yOQy P_j$:ZKf7N 7ޔQT|]-mxi^ Ёka>{s}Y‰Ŀ SwI75d]j-e76N2Tg0pȁdm>O8?hU(k-7/0_.{i]o$S<\>y$?p>|ƺyͣ/݉Q-Qs<:7REQy~(w([Ҩ7[Lw9Hk:>Ao7# GҪ+-u_Yd=jAwWtwpò4$%c Mr>A}MSq=;|AI賎j:|{!:zS87Bj½6rx/{mb7K5/WE'VxY%Nڑ@OAOG&h3pS2.ߧie]Ȫ./ݖ*3or/iZYP$-:@Ɖ$nAww`MfauT8 qj/V I A+K g.w% nx7c+qeQ#U @KiƸ%ymsBb uѯ^B&dkfȇ-ģ(m&%jLNj79F%n2hA`kzb*Ԁ͝͝"zԚGIdތ 7ޘCm Zʏ[>`:h}g'h u\xq+l.ɳB\j+܈00nFL_;u+vzxNx6xӶx6xӶz6xj=%\mËۺPI6 ]\]"/π> 2q-ܱX K'm1P> 6VzgYdCK[{0bdV~ \Y]9ĔD?h;IG\'ߥo uHmV26,S|$v~bUڏJ@]w;G5$sqi:'N#b%&E23)HI䝁=-奩bda3NeICq{c+!q&}~hTnj6 <𿂖i]n;[E _AX˦u.? (E4a`-h[~^?Vͳ),H"Aѵ|@ВkōO j~xRЄ1պ >,nJO4a*y 0JJ6+K?d鶦'zt֥R<_4aG$7'h4u-7 ~{@˴Xk+3pԏ ynC ~G`:AR랛ݣr .E=RSpͪg=VA4XV6A( ŒfĪ9GH I0=[g[Z#c6pߜ[+NSRBi:Qm]풌> tv iˈ,.( VL`t5π~&Vee$=L329HW_ heQ~bѮYba:aa`^&jϐ*w#_MvuHktP'Yםh[ZغI gt/v."'FY'@O(s5ebzڬd{ 8 ZE. ~?mUvOޒgL 1=: Y,ʺ;mΕd틧}d?'pu}Z]-NѨzϳyNzWF$d&,]tu^('Qy~@`{io^f}zZ )=])8ɉb"?-MVKh8_GQl":YgL"<,.(SK|:tTSتo-L,ɰwi'{ۏѪ4O N?>*详kJ|;kFqIuAK&vN]`bI |0l .\ !ZPRᾲ=k8ZI &߰w̰㯱4Z;ahG4kNxK(5| @8Ȁ%%6 iʹgɲc 98@r@Mn悄d7f7d7wv7{_iFkz?4gxuW |GN =pWHWW*]E&v7O™jjX; mT=0pS>l|3EwY9eJBʽvwGUl\L vUy9'.pj ~p+VY'J.]Rq_ٸ+ &7) ;h}R#h*q}x"<>ݓWh!Zv:CC,Kg>psԓ욧.u"%HqAqs q6JZNWw\[H ;:iXDUWTcEHiLSvnQmdIjq2*5?LQ#>| x~OGVgnk Cc@ RΥ|X'HG9Fm~'«]Dlw'f"Kg I'} .0l ԀrK Mlр\JqU8>Lo(ժ ڸ:ZNk۹qW;iӭ1}v!m>d򺖴sCT>Z!i$%Ai~Evgddz'ΰU'XImiocxq]'n@b}۵6bN+{Ylw촑УV5yl+JZu!d63eHoѵq^&RPj;!+A+ll&W6Cp¸g&TD%]ė@i6BZ1Yc O)'#?pͼ6`x_[~J#xEMn3.$?MRR=)I?[d&aXZN AuMEV)ekQ <:xHF09$<ufDw{p wWi:1kSN$cZ_9/Öƕ Brz(;ס[zve#Y,ek]Jf$!G3d%lË^ ~zLwXF3Lsm6},{^pn*}!PWښw->Pq,>o[չe+;:-^"Ն>2W=]]-N1ݥHU<࿬} W{*_'n1 QMͺ3`;֛&Nj~R;7Kٹ/U #4qsz6z̘o(Nbi9wL3׉LKwؿ2y۴W־sUʴ¦d!~QTg\O!j2sϩuP$Ǘ . ObD;(>icfIm' FYS_J;Ǧ-Ψ9Զԅ\^wLW,+R\ZxktGOxg}Cx]:T~w!P~ )!σA{/!"c[0>.15O#β+B{]W'n1z&# +x]>?533)h݀0+m6lcSNJW.lJ9x;D@w T\6Ҽa. ~1lX9B7. XscmK3 ߶8kiCcJ q߶jB N{gg [J q,:Qqo06$nO"PBN8۷b٢%˻:WX2'7 XF$8a܁?&ŷqQi\|;׶(-"ظv[p׷&70O# P)urC[m;m!WRPTܽ:Pa'H_ІQT7q2-_a+:2VyֵhSLse)&zpEF kFqJbžAp}q/ uQMt 'Efkz_x6p$>[F IҦp:suoX*6ۊtkfTwP1֝ac WIeTߋ9q2Dx eo߬˪,&>;NZR[OzC/0#Tؽ\BO? n~*BU|JA'e),_:)˗-j> ۗ~yrk@5B]~ ,'T U +To[{)T7Q$ \󎽗AH,;F6k}҇.r+ ۾1ry.n  ڇ*~G '.pӶa$}ShC ژECNlVHOG*Lkv;nsU 4ekl'V^v-ƥBETl|&FMXJi3D,ثLn(~aYӨb?6fT{VFa; Zٹ;6J#lh;$"J}>}T> _lI-Oi+W#W4O)Йo5euJd9 ވ2&'|TrX Oj>!R*f8}.5%>{՝S${kj]1:}M=,:>.?\ ,s*Q{V(\cI4ڙQŹAH#"N&0:QJNy$% #<\ݚL~ ŶZRlT\3Xc#Vbq\ Rx4a=Tc1kc1;!FCJc?FRh[ 3KIⱕ*x5Ցm崒 ui.ӆ\|a&3Z= '1'W9<xe4 G :W4Z4qtLΟjO\i@RV\#sKH':-O(IT/%6 NђK"g~Y7j 8 ~0kWP[oo `*N!%EZN_`;1-{:gk ]ȝW&(,it# &DJA{C˖qK(ݳcCҷc^ ;0\zѶi٣I2{ؓfOsORs tt- bCx^:0Q@F4hzx'e4! 'D0Ƙ^G ݐkREك w ›Veƴx7M6 gmw*ݠޤ,d)/m=&=ӕmܽ]T؄+#¬ëJA8 |Vlը7E7" yjP:"Ё- )T_AA@O,j†˝%f#(G5x 9HsʘIq`7@؞]Yg?$T77l(w.fNvL]jͯpV8 WUzd$lo,M^kDB!%g$Z@k(Uod'TFVF=V|@ vn;BK~-%\ 8kXݡo$ -sa :vN[8f. Atµk#)$ez]ƣejgYx~JdQUFٷA`e :׵xZK~#Qic ގ}T>Qf>Ko:t; 85_h!i={'$"<\j_ZDU eF瑪[|gGy;S]MwOCMx NH6EE .`ePhQnA3eLwtށt-]յ{`fEHY([~R~^Xm+D]0'暙uS,4T*ᩞGQҜ_ 7es`צ\3/piF+mRN'__Cv}[.N{?zj_ܲ:*a㿗 rs`ӘqIZXz!4<8H?bT2EՅ4m FӁsʈUԩz+FTs<41w~(1A.r1QVUZtsn+L*w$e=TME_b/ {-|^pN8>$NDk7EX(﨓E.w)L"=& |?㱉?&J%|(5U'Ig?U| 3Xcgl3_Gye/Gqu9e37nS!=N&LCFcXùlu6+.۸ӯoM aLW}5}ai ~>gZ +e6sIYtoxwEtgHu Y313r)֚?%.= nqw۵N&* 킷v̼mvjVZcZiM-:kV/?Bf m WrօɲO2~*zDI|{ӓsR˘C&<;Cg%9wt1h@Ԥ1ɭACk\ &Tߔق=-\R6E.>hS$J*U ?;6cmt=MU[||T 1@{VضO߶=4;=md5/|e|-|>5h$Ykܓe ïoXWU7,Q]R cxO= xYL:4,١WV`8pRu:>*a\M;xEGlZ$Z:pZ4МNIӒPʠk:P]j;H}-Ĝ\}}Y1cP=z/H[=,iMyEo=%\. (3Ϭ{ V{_pJ{Gu46 *1x$͠58̌ 4D&֘B r2TBH8jL $dk#3o]2w8S+o|MieQ5l;'Y.jSULŝ lS6:4%.2pyzҤnj7oRRj9|7=#Wf- * X;L;K$$k%':gIR/6Ú;lmtz22)mSxӊn{{ky}}m$?2g`=]cvQIm9Vf7GL #>H.unk-ZK=ģ \J1 ~ʦI&)|$>?+udWZ%>| U#=E5qTE+&g?+uڢ;ơB-ښS&H:ac'TYiʘtLRO0)xBj+bh=%;'jHp cmx( ^pBEz_jY xBn4v>?S(v Yh1TO1 Es|6(!Z pvÄ[dBNS?@,WW&IӁ)T=w p^jd._n"= F Me=1]覤 m^~""R(̂gQx.OPez)h% :ij5( [rV[[Y/S\йx]̈b~(nױ; 'vrlR< ,dsI3Rی̴ , _PfWtR-_G1_~уLT7/ ̩f/G~s*[ak70mµϕ 4Ny1٩t6evFt#1]=Bqd B5xk>;ƈrg噲K1l+;IĘS&wQOCdTܝ rjP H? .>ΣQq$~F4xh X;R/!_ #qr g!3|Z_1+m,Jێcdu~ܑ뿸e:h soZ؃2mRm§ f<=kۂWZtؿfg~o&ӫvt4FW=$oLH:? Ʀ*(; 2r`gGH7[mAUW*ZIW*Zժ&qWVT?3UVoRo1: ^'ZZg\7@Gm2ɲkD6/K viIW?QT8:ZEnlAЫ($O2e5ӹH EAM'z{_(YpgQ)zAߌb N^Bq0gsL KH>O:H'EtA1 C_r:6\Vn肺^Hn|H+W{D [b7pM&5Hɕ-(VײGt0rNx=|\jkJ4~ cʴrX+(MNC$_xTy#Fn)r7UtvгZ$Ko[>S*E+DQ ZwĨfwG5x-̱Ly Z3/6!l:TV!7XſQ!5~zyvׅ30x/+'~oamv˸q[A pEauN)T$Z}k_ټ/Ii[%|id5wLKSx6R]|+[Q^FVQ,*:>\Pq-pA@<3=sT.&T%,T?m2*h\X%5p6{ρ,0n[G۷Rl ≻ qHsӁ#μ.> p gd^Og6jzZHqSPa`( ˟&y:+n8W {3MHs\h+ ?,ZSyEM f%fd ́"1 wS\ݲhxY厲V`vn>XdNPEBaE8%=su} 2so+8=מ nIo.-/-s,m߄+1EtP1`pq?7)k3\ڙbc|4W)/Fn7n/1v:J)g2Dk#j: "[ZcG3?uR|Tn{ ϤpZT U6lLݨ 2s!B=m(T&>1r +gA5gWD-_^e~ӞlKsyWl&ЕG˾ˌԵU_kqВz$l@~j@;Nxmr']\i!Ξdlex$u 9C)#Eob[i8.C/k^(^bfO4fwVbt{ 1!v=34QPpe[FfM.sU)HL >rC&&7㱿/_)e瞾.}HYTi3࿀KTd%R Iڪ-W)H5}U\‡tm.^Q`U<׾URqR˪xC'&qUJ.]&} F@<OGWT lWk߽'pNN>\-pI3ц5eq6пEj3)&2@0Ҧv|6%\H]{=QB,Ծ=Sq5k"pSDp }D^i8I;h2Ga*],PKh,u)l=z:$y'&)Pqo9R52vʞ3`|N\Ζ*-σ^d4*W_ZdHO_~<"k\$?&~^3{Г$Ŀz 7 r,rςtOr ʩ g?]*|mL*~]oޛ`қjjމ=b0xq4}mbp+}|Ul}p>hNo 8]x?L|O u$Ͷ?RCN l QBstZŢ'I1 W~~y1pwۨwF)m [NK&'6$*%X(b2F~>oWnt7EB"~ 3=eG1OKݔWo> ld$8JpBŶ;ξΛldR xlzÂaWNćO$Of3|vLB_NϦ4?Ө($agOHeU,/_0SM<rYM5t;+Pjz=ǰ^&/DǀzD9zDI< <<w,p!x5 v@[-\1yóT<]T\<.Ƥ^?K^\%y67C-k;wDVKޘDqRy=șyMHa4.w)9;Xsnnuq!txGҞFjģ Z^dgtI4ހ^0BϿ^ =G zyǦȞ! !52eyjlr._ݠet"xa˻-MU%]r _ N5M^~Y } zI"fݝ]7VW2u5~&  eȪvR4Dكި񋄼|o  8>V!&|2]5.^&![ׂK-TQǀT)mۓZWGǒRz෪:~2cԕ\ՙZlEC\,ev.$Q>Bݍ@bo> .734; xvDrTbQe_ UuIi[,mCJxz8gf.F=seXAc=ޔvѰZƌjt( n+k,ǹ֭m[Foo%I$|>uw^z;kg3nںJл=4} |\ʓvǺHV._ѵkiW%<Ώ{su_Ob mQLt~6 k(mc+ձQ9܌Y6uV+B4ގ0QBb]ؐImcS 9XsyT:to]@<]Sq7ouSﺫ{T x?FbLggݎKuUU\BB> |\jzB=wT_?}pI o(zW1%tP#iGjKD&iC 267EjGeJ7xQ my£VXlycV,KK#} w4U=W9l Ip6-d`xG<q0E,vw*>' zgM,nMt7oM 661$n~R \j>Ml^.:_2!׮fL+##X(hGhM-nygANbmR=qlu:8r:gIM4xZYLw U(œ;q∊o Ɇ3絊Sn@<e ?S!1=C\px:<7o[U< 4M@{ٛl螶C3\zimeY۔ÏJji'&:H~,^p;YmU9r(G529"\18ȏq?ZF r~Bt)/3̤6bt^6䲕^y}ƛ} G-4" ;$ I]M(G5\̜Ȕ7Ldp,RRERx D'\ 6ktTh9ݣ]ހ1 'a4nDA>ҍyJy/1W,vF74w1 /_:a~M焔v?Q8Xcy %'sƯ*~^Uo5Vzu 2HߘMߘ_9\\fP55m-rE?+{lk銮3W .ьE9ZT:LS~^M?=Y-V-+^DU*R5/W|M/ص&e4QiF+m@TI2W78iĿsGߖӞoG^Zv_=Z>lWaWn  {3A3kL|\U }瀾!&oh(sv#!J@48\r*:_Ϛz܈hlR ?/B@DöW b],m5-Cwm|Q  #\^ $[qV/*M ťG*㴨P(@<kUJMgW=3WّdEJ?bl.~1 "um(`Y_I(=ɚ C0dZc󃙥BFjbq2TBȟ{e C*~G?FZwHO$ 'OUH781q +c8߶ns]{}7fOԐH[븏[Ԋ5]sPk;ڗ֝g~߳X.MsIYXޭ]x.]{;~}Lm'=w\pm;*0i_pMۮv6=DWYokY3ifusZ5ZOk*/me\z5jt%Gζ +?XtdY'e?~@Yɮ!=@ppfLߘp}gP?/I9?%.!O HATIڛGȾ+ ԊӶer=^>.5.JT!>:T!a> e*T/GΩB?@1 Sf`TXaœ9L]v$kF?S7~ƣbǦAJAt< GExǠUح8XW| \nVIsd= $ǀς?[C=|ȭk^Ԯ9LSS6: {ߋGC~ O9 I~ 7s@k_9@<Pq߂6≿sp0g4{IH5 Ռq]= 62Ggbmk9Py=j}~D |j{X1IT\7+_e{Z$Ν{]nP5Pq[-~'lԡ*Z߰Ex(%I>7St+;Ͳe3ɰ s2{rp=]BpB9'N xvv.gX4PMpZa6O+݇o,߇M6ȱ;H$R pv3Φ7jnF']7$Wj&L{\z憏zW_YWJ|Ԇ~u&HBSZ;'9B`'Y;R*^HOC4:5\)@-+W+\i_6iQ\5i;ga+&NitKViu!0 Qs7VtCux? 2 n>A ]n-1$9>+9$a~q 9ǁLt6Q ZG6* 3G6*?Es4%$kF?BAvMT:C",Tyۤ{M1mt\ycl89f;^3'}v=ԑ5Ysض3)mWc98lH%ݼme\g6)rKr)|_UDb$?3H;R@He,;;ސy3,Nx*QS_!8a7یb[n?jΚؑp- Q=Eϝ5Ŕoh?EglsDbkG}gw?*wY'Ir?R ??@ڍQq0~7F?@K՜8SI4}PӀGv'djaf(D[iZ-HGO?Qa27 xIs Ӎ՚32횝ɸC>MmM$Ni5ZhAۚV5*-j4հ#d:\sZ&:K`Dͤ4'Jl_llX$԰zИzӰzИz۰zИ|UڹuGՃoAcQڰ7cmDimfH%i{`[XZEթAZSjM}[*նفеu{&j lY[֠YQ5m)vmlnR6uYQTRdUhBg= @O XQ\DKi'< a dǎn"~B'S7x mTaFe5Ii20Ôv鞾J-.]/sXvKs!IQzظu߀ #W,~0\ f\zV?%xlTu(|cTt]q:$`ۈ._ #)p8I'nCƐVྎg61|Nl&Gt3˳jL"}0 3oЄO;A#\~#.xtڿݚn3sFս+͸ocuzwTy`x_o̜n&z5Uiw{vx!1ibT^.ػU.IeBjr҇ͱ^m1Rմ?=F󸳧N?':(=uF?PQ^~Ud}%i?7jw tiiBW\-qLO.%>wCo!>"n-b=7lA[TLj{>K՜8WI4Tm5U=i:{P3zex-U$b[YfU+i= VڶqhY2tGp?(cݵz^d(xAxZyi՝WxZ5kVw^-ʶ&ĥ> L07/Osu6#6LE Jv*7^J)2x4[[pi[YMd,d~b :] %+&Cl>7%T}Mf$NN~ƄMfs2#27 5t.3ebTN߶'2e"U.2ʨh1U^Ry WmKd : ~)rcpYo.- CVy*[|B\Iop RLm.~qP$U Z%8a39}T3sBUps!EX'Meg&Nvw־'EŝvM N#h BeպVc%?1mtup }eMMLkwW/tYpkk"񥤸&kZ]l#0 g`hn,HO7n"|PJ\L~? Ǧ:⇐؋:fˊNz]JyrYg'j[n$c:&  dMA <jC6`Zvwuzc՝>$m?'-$Ӎ;'q5xrINk}w#>q>''_Ds̘kźvYV'(,(snV򀓴s*(eqwXvٚn0k"鰶E+$ ).HHV*dZ<ڷV*\|8.I/X"&!fh`<Ykoi/13B](7Qr\"uVg@-n-7)I-O?9 .0, y=e#:\"[`8 [uQMغ ~l $1.pS; 4HҌ+Y[31]6n[<ԯIiBV^ e!~ |AM>w#Req$MwJTC+e:;,ln:"D~˵Tܧ/YYͬ=ɨ+Mj$$6?=} _B_Ӷ,L"mpqعFTeWѶ4)Tn׮801Y]pV}AϠ8bG^nPtV |?UTT`x @ӼR\ǚ4ZȚ]mbԃ();;[UD{͒m>'ٚ)8KpxL?Ql # ]n;1xR;. .Z1z=LTMU؎믞V:[ȈQttGL]f|1$'\ V73ܰD9x.uT:yEű3u"i hW9B|*űGIi;[Yڈ8؃ZְXPVrki{H?V~F{H)C4e"U.4P7֕RyoZmKdo: ~׿ܟmõ4V)meѕ4dn~1wLZ6{Wr5#'SX)'N V'h.#FjNbFNY>ꔫ{*Sa;eEfYV`TAEkRpׇ\|j|1v\ՈGG-:5>vG156w3e}Kk . =-_!.h==+k^'ď֣L+ųt.&J1L % |Ppˆ:2SuPhKF/>-8azy q #Q }I j[F#?/8a FԤnPVhko NVrCsiRhbjL3&'Zc`zi*ev)FϦu[6JXHR{9C[H%@KF+' Gwlլ靎Yf!.#\:vuBFOdSZн.!r`xBr \-;xYMSs,OK.S%טҶXl;MҮXzDţ &7$$KW_Un{$Ꮐs<b%/wKI-ogpBu R]3;V_jt2T,?sF-Aj)Xgx;]'dĵ'hsZ6&n+xBQ>|Bp8ttI #h9d%bg8:] ѲfڶAg]O T N3~P/G׃ w%@|^0t}Qjj^??'J6#V#TMՑVR5 UUUb]?sȎ5v$L`|({z*O_%q"_'#x]Ĩ8Xjo K\KKRkrWTUR'@ 1/\ |G"^iKģbEubF]G/Ϭkc)=HڤHX3QZ4QZ4jCLa"te hp[W_ <ñSF1:·a]w$!ޓQqw;$_g3&XH<qxZ%"=n@nn+L|1\.]6n|`VI\rg4SIKT.\/xhc[PBf ^4 ~DpBeS+UScR~Tpˆ^=1ITǀ/ N()_ Tn޻+::O bn~y~*z*9D6WR'NeqOd }"[xw[8=LʥVVMxiF-uquT6GPF~/_ݨ$r >r2 xRFp5~YS0\UR>X}:Eovߪ1=﫢a B^=IW+ +k-̈zmK<^ c61 #N4ӴCVL1xæGs4V_~V`1&̗qS9H^{*s]qj2|-C׸AF2l&6}:soSp \T"ZDnS>j6kY)fJ=TcOo`nӲ=.PMZjcy5]U]Sfn ?U3@eL9\p*#@cQ8aif3 c*~JJTu ;QmbGm=cvh+O?U:̈C-x6%ZQ)'V 7:V$wzx n2IK/@:Om^~ad~9BˆcbR?pYhvLkg51]I kZM [IAi)_; R ={$"ҋdo-l k^N XE,*T`15[pˆv}m1YOL_l:ڍknbmk#U:e6>-p+o{@AL¦mkp.IۤƠ=՜k= 8l]#\$H"J;(XKf`f#N$lwGr6FCnn'-=bu.ƽt-}f*U &5)MiZ 8Onp*x[G.IV, =w\( +x:"/ҫZpBWfOG_)xu~A+ d~Ljj^C`(rUV0jj|FmKd Ci?Vaj{ &5WJrfmj1=O'|}x 2JPZLоV>׺R{ڕzO,Q(?(?Hǀ\T"B{IuQRO֮ԃI5TfĀ|'Grl 6/a/ NCdWaQJuMՈêA=l5cWT+ VY?cN,f 9%4. Miۋ;o"8/(kyQ*|IpBE*lK'#IW,6ꮌg 0=ְ.q07#?Gp8T2 48GpBeکk0_;O&,[3 Ƿ"Oq8St\fB~蜞1Bc98 8a h0"mڛQ8aiW3 >F*~J봏ǺU(61>];=zwzl!!\`q.oKT}K'nQ^7"Q;p?ktqL1VޡU"IG![b$6b'/$r+M\s2oFBo *^T3Q.S51 LצW吼!| 4{ Fp:L4vtW}y\ܟ<}Hl@}QP[G1jGB6SU+g~j[$3? 356,e0~[dk.%Mffq/O۠G{(hѤwaxm"84?{97J 0+O Ѩw(Өs k=(8aDYQ:zGcAf),̚i*ق˾g'/0[!ncpǙoFugRSXq浨~fסĤ3w0pFWg#h; o.R:20uJGJ7h.~ H]qrH?(~* S2G)C(e"ĩՇQcږ:NY>M;v0ocSw/^vidN7B,.5+>(t-Y#Ǽ^oi^1r?&5u(~8NFA4+0tqa׀&/KCɔ%>dn;F{ e ՝1#CTl饕 ;}>$ NwIt ](0AYay@z*Ӓu0^cY7 M' ~!EF_2B~Pk])mK$3(6'4?Qb9-&iLK1Sf9 -8%0U=$fNzDh[YibZkE)8"}U]ʢW NQ[RI: ѳeTEp8Tx b1a(Qk'G"z,]f-HU{0d 9A(nxA5g4lZ\œx̩åw /? w#֭Qn]e6w8D֭CtLIF4J|V7-WG%MQѠqpqhLق)4nnQ*; NJ Npo)SԌc;;e:,> #*0-,K(g?z )yWeT.-ơo0jNtŔIQ("ۀO NHat'mH5O?'8a:{y #Y :I +<@;mH+o NZ|Ipcep8%ry*RҌ]fnI5{ Pπ1z¥.1zLui)vxBtvaEVwpطzo3 T*~J=~mb3= e%/AiRj+o I587QOZ9uf*:Щn?JY0:"hMmmH>,QqG;;#+m8pҥJ)˟mxUX#ɻYl=B-+Ro`nIB,Y2U*S._5Rl3p xNbSK'~f|kMM_ %W 0pՄ]%Hк4I:.r A #&ߠA#ݼoD61a |4¥%[hvʔr+Q\6<6p0p7v*~Gow塀0;jc|>6c~G~ 0pfw﬩7;a݄ǐ+y0fiۧZNs +Zh7e~NVNo .X]5fO/tKH 2N%+sZR.; #<\n#\#Ռ\=q^(ksU꩸[#T7XB%ۀTrXLOƍ2ʹOǣ>`<! T@<T\3p|0p@OnakPNH9iL*H4e#fVvw%p9rݏJ:Y^-Lہ_Z{Dmm=_V{D5/<~D_@<{X;T$bQ]ծ k$,r7 W߬YSf%jzMɬ]VTaU(Mx.ԉp~``wU6iNvWFX8W{̜pM x7{a䧝1/a[**k 6/{a1zov﫩ڻKBz׽>1xpzÁbb })Sk=xxӿ~áǯуSn5ITEV7$g׀u?&< _@<[kjMoK >$)ކ ~j6Lş@۲!?5D. /a:%nh/ #~bqZT]uwqX$g$<`'xgm-axW6LwuRܛ`?{1m?Z6^<(m7u(~G<U;[zil))tUt(ߺȵΏwh)Lp&ifqʳq1%D:uUQf9'.pϫ,!yPe%ۀ&TJT9Kŝ ;//^ەҶ D9=tܐ9bXIN~&>-rv&z<Lf.!G2  XC/)XlV55%tdp$տx wV/K_*WS<2=_Rѳ5ci~K=5.$L.8_ΒG72^gӺ}eyWq< ;phYV 'YPBz`ڒA֠7So1:Ӧg=u <@>U4a֜ZXՉ](۱Qp[k5Xǰ׶`^n"q^/8a |5+L|h8#8azy' #es܋VEZ8c8&' g ){LL'TD?IɲZNaxPt=3ؠ.zFr9=|{Jjo&f@!.IH.+ 5F G"QRs:C9wUط{oDx1xβE%3~F?Bb 哨O*yE*8\n֢8mS^08 \N%LG5p <\n֢\;($B+4ӔkgöԺS($Sp%x |Ud휝, G shzhYJWt[m[.ΆÚˋҥK${&*")b֫lس$;7ߤPs9x3[olPK_xY $ҳ8H ^QIU@\*VLϧZٜi Hv zp;ê,oPqo[<o!%]21|ǸAu#?V:tD?w'߃>/LBe_3{H6s1Q&6 J 4WAp2Ëx18`h-+'hh?*96K{g2ޘUl#mPf6<7!f1Zt߷>9 hNq(;̸=B!텎HnZ¿+6kV U`K=(rx5*iU {o|R#鬪fu="!y^ 7'6LF)SVGZc$-r`^pBE`,*71%>*JՂFTqkCFJaZPkdu *RI<錝[Uې=yGOv-y _0rc3-Đ."[:a_ NG* LBIF }o'n F&'('LLɜKS p1( Ms'?Dv툥NN\rD}pr^ߘ)tG1s7j|1 |Y@dߑX ՆX\KrűZ"sEU3o9mr@L֟:3*9=3<1HلO;C8 uZW;ֱZ< x T`k_ }j1*xARV`:AP4z髺ۯ]qjMY|aDʹ aSmkO>>zORFp5\5)++#WkY3]fJ=TcO?{|38m93뮶pl>3sBqVfUF6ϓ#)-iy9h^}N4Q^Ԃg yw%iFL]rJ˯K'TԨ1jo97Ƅ&j8$8htMw @k3RCSWXkFWG-z@q=27c { ~9FI\ETZG-pGL :{ :ɧ&K륇79m{| >؟]ri&uυm p=zF_e/ |C <3C6+0Ű~\*xl\hJyQĉgIJU2=7~tro:$;MڝZM[ۍlp:zFNixv_XoÕ˥Wd?'L~ #c_ǑM#2hǾoWK!ӥ-ق`+f 㰕Cs'h+KE`)z_WzW <QFeb s3WCl0-&607ȥ&iz ]}D(cU55l> k'춛Բ&:;ᗇ'do0Ɇݛ?Jpk'[F'6woP^|qC#tSrC#Ɯ~r逬3}Wv˧š?-8av\2U%`-C'Ix׎A0)#u> 7 ՏY /[c#pr9›E_QoQޮbgNѮZqZWWCp%LՂ*6&+tbh < c6nn0inQ~i2Yv{C F?MbqLpBEiɦD&6^|qo #4P΍o(U#!؇ NG:IM& N&T5q*jO}K6\1\An'Tr2* +*2/8a'hX\Kd"~w nsNϸ%k #51^:8qMRZ_\e7@'hƻpu~MH{Z;a#k1':hd9 'e`,-P7eN7 "8aDJH"6;8-!} $ gQD~77I70c5UʐWD)F3s$Uӷ'TlӘ$pVpX:cG'TdM1^^pˆ6<:(xNAGt5>3mg0-m3&OXy{'T ֯6chK{MsT ݂s}hYO5_)8G}{J6;G_YZી QKp1X*:7 α>}曁 QOsPe~AM!7c0Tt?"8hO4٬eF'0Ű8[pˆ9s{~s2-]R-ǭI7Xlm=۷ع늭ۯ[sLY7 I \j?xu6x{k6)G}Q "F)6 qo>P=Z'$m W,8"5J 6N`r̈́ƼFS;3ucBBnp+ qM NHŝR`QBOLi 0dЄ(dz/ps r!xe7U2g dmR*8a^+xԚ{YS’6{Y#Z/);lNtF%~Epˆ/#qP867)St~;JIKO*6DO xu% dn_$ .uwܓLsǁW{C~|dIM'OV=\ 8/Ò ^ -~V-: "먣xݠ5˔]\̧W]ݖ.5DҢ |$MU.WQ@xl-w;\[3L~ VB|\H ֍O*E=+p,G2Ҟe4ykh~-?>qjcYFʺA|؞ =H"_w?/_D5]uk~z ::uZ"f3p;ڷ*n=p~8A* ;Kef_a%%Gᄑ%.Z/$ƬX/S5xNMn? xa-Uf*w6d%i ~l 0I#d)ti"v7g"uF_4+j˄%8p9O2,4cXv/*#Ĺh[MC3@~LW_uVi7%FE;Q%aQi:FE*~fFL\$yä=7 x(8:,Qȇ NB|\cS2O?j: $ӂq9.1gWp9nS{=$g NU=+1ރϓT(c)/}T#y3uYN {b |ٟDҀ}(^'1OGO?~ < *wɰO* nֺsHeJp9ZI-u3U\Y3Cۦ): Www.d3ZޱG ]48h5z:]pyAXdby A^oҺKעR>A] yryo&Ii}4s@I/Vg5sH\Sw]pDYY6 Оm,%yĨ jv,8!vo}`;O?]gqrXv:;y"(9W]Qt'~m)9LkW ?C}>3ēh,"Uo{Fk3IRhvNQr"v R* RN]+ N NQ]sJ:Z!͎ i. NWދf~`` %$w!I|3g/w)ML5 .]꺻#3=z/!Ho־!Pq)Ϥ4T^v._׼6*OR̴QzXf*bq:%wra{tb/fţ@&$fX`bz40 I!8a CWDr~3lSx9)64y9Bj`6˦*mVJe s]dl̇Y.67|jD%$>usOm ,5VPi~7 8n j$m^ | wGT$='BET3N#*ϸ]5hXǤJӳ'kn!O/hЦ?vC_ރp;e8m-N%GEcV_/F]|[I4TMUQrCfroEcHlNŵؼ=$z4zb u;|M=+h<ԧ!J}+h<>֬!!/oCz 8ސ}T46·WjG>*ӂV|-;h5>mA-hwr&4:[$XwlS-;xYhIEn}Zwz[ߖ]kv}_$1}P],:4`7xw=ϫh0Fm<K,/ϷV^)/?%u=ԽjZAf~Vv0C}F ުLݛ&iځPq &5L"t/U#$jzepz wHKfư|Lb=D k_G?_~g~ \.S5~fd>?G+Gg?3?+ gRz7^~= oToYT#Qfg +~QpY'of'TeX'bX x"2tBoy')N*xBnVI/- 6(I5I|TJab:^{#~ȖIm@Eyf[Mݸ^eή.>wަovt0v:?E#1Zc8#r4H)<3Kq[fА j"<he lAy#iUFt7] 1O.W]*\ۥ1eYfdikۀǰsWiY#|Rn"SC?||Tbv^ݤ3Jji=vγ*9)iә=[$uYB^sBSD()CC>ƨ),-n&Ϩ‡RNXs$ڹ63:֛KköA1/׾ Rq~ <Po̦ |ejWuBģLv6Sژ>t?r&bwu;u-]cɲ+S]]˪ݨ]M@/ilV)Q TOb\jFt¨Ai(oNiXȺtԴ2_XG>mїvյrbʊ Po\]Ʈn yn~{ NYu/iOjwttwX"Ղ> nnXņs\3Z|EgWwΪ=*d}K5T#ќ<[.X45=lhfd>Զ1*jLRMHj[RZ/3uQ&QYqr;sšTqe=%W0I3Wj ~"|C,dl~YTǁFBMKRrZ\BW^C2ߏmY\sRWm|銰"wwp'8a1?.PNhY#Oō#/phtW9 /Qq~\ƈ!cBҰr$ǀO?UD=|\tN /[ѱxJqL7W@]+W,\ܵKw/^j7J,"y SDUb<࿏?P 7"EװXgrqiN6CC3ŧh Aqesƨ)&lDowWXbb#hvƛ^~&wm2FCz Н7? ڇ$*-!(cSÆ$㯀tC3ymho+/jQ~\Ji/_ԹrYw%K/Yҹ2dH"i_'>$Qq3TObF(jB3sv> U2Ft K,,15נ"F" b1~H$HɳVZltG輂oQiπ?#ٞ~\ֹ{*u^T˪:I ?}YuUQu. H'etRoIΐQO[Z%jQb\@{pAşPB[ EQMzE]Ǣu_xڑ.eD+a- xkU)N>,]Y?_٘kBK*c^WD ?=q E=}-!HQ_ 6HFZ _YE~K dqT g?SՂTWKWpսk%UVLc˺YL3;!ѯR6 \'\a# FQD5@--QmmL!-ƁEOvG axvsR`xpޯFu'l"!/[D!QrITLB!{3:"cfbѱdT#x+sjbvnjsٹ8dT!Q>.5-.Pq6~wN?@<~uT:c:WGhG-V$.04*zS˔n.(6* r !<\fb$ȡ⚁ǀ%~>RGK0_1eD.'ɴOc';;ⱈ)T,bSEL'-!]l㱉㱉.&MmbjR&%!pp+y .^~ylyQj_@<e NnV;UW/(G5&UI$.mZeNF݈mþ N /}|&m.ꡫٸtJji'&=4H]ztȱup<u~/KPlf,nZJWLka6g,YǒuIe.RTr4GSr^ILi>*ځqu=pkcŃem">rT)Yӳ"E; {Z/ؖWT{ix;‹vRh2bLW '%M%3 7/ rw+a-xa0Q4 `H5Ysض3a gƱa[j$jo7 o71bVjIثf1&!27tتo{9}L=t᱙3khy65,/ŋnl8${}͋jUFUD%Ԥ&FG3_>*G8dOrAiݶ31_rF͑}ɡ= B:T.1)jM-%T42NX.q|:I1o,abG}c x'zƐ!ljJd!%qYvr9 O'ס4ȡE/ !D !T-%TBf>S[A31iVaC^Hub,Pj瑉3le04P,=q3#Zg3þ)x!BE~4Δ>1ܺܽf^3YfeBk谊]Cc⵱Hޫn={GukW 2.B/ x`6`S펤wgYɲ1=B {!\*].=JK\ү''igyfxwz["CQuV+J{i+~WX;{ܡ>DAx)D=v:J=zk(GVG0m?j\O/?b?]uSK3 RΊ~=/ǓH$kÝu:_kغ/|5J=P 쟽PW^9Wrޑ4_J%}x+"TQ!:G2ƈ%$?[æu^qËL:=v8X2[?DoLǽBf&59393C|aD[x_2 Ԥ͗.Qo| K̺+o_^TaAwrWY,Y߿j`ha^[ҭޠ ]K7/e2ygƛ7-ǁWYƃ̊_?PIrѬBcH3{ћfxL蚫l)ӫP8_N /yCWMYY4r,To5> ]* . 594>KRESWgI&!ĥ$];iq(G0uyNba𨈚XW)4gzzeIȦb´ GKpqi(_o/u5{uKcfI^֔!;D+Sn<\:z3bULRK7Lrp 4իAqlEo ':[Z.V79Ou=F=9iZc Eb[9X-Cӡk#%|4ʼ tH.?B|'ۡ%n,Os dw'? Ghv#+A8Pvnq RAz| `89tWݴ{/ 6_L=cgX_wt^U?jt;5G9:;gLGu׏ճeoӜpz,ʥޒ\pzƁ<=_hXdww\]~~ǝr=C\G]R[k(+|nw̲ ؕnQSV^cVeH[K6Jb-ә=d_E+.g٨lc࿃᢭~(-&bnH!(ycluMۘ-KB~w%}VP|zk}v)q{!mLˬƣ]\,h+f|tjZHӥYyE=#S(${o;5N{YQa]c/Sz0;ޥ=a[ũ>R۱}}~Kt}GuyqXi1t]#k nڱg ͘鹡І*@XgbĂ(^tx1ű]64"[m ,t oI|Vxvs\u@q|+;ዣ^uv^nJ\ XF/_3Y>"kDW8.ά>zz#!m@%GO^#w>zej$GLH,I^]}I~}Rѫ+9;G?JVd4%Q,v/Jɰܶ#~O`Pwn kżn/ O>B![~{el:aV|9> bzF)Dl0-H?5'O +\x/_>& DͅI= se03)9 8rawwraej$ +-R.0ȅ6W\8Y rau%GvWx.c '3 ~Q N/>2+ IIWKeђawQGd{ p4Z2LڀOB#'$J?pL0GMvї =KϤdn< 8agwaej$ +-R20%H6Wd8Y aef9o*#mtϋ)v MStϣ'[RڀM{W-<%L0.DͅIvї VKϤ\,|ʅI5Mʅ@.LHZ$ SK"N\sd6ȅՕۺ<NcX|{[a%;I;I}c{ b0k>?  شx1dꏚ BT sgfc])kyK:F"z'=2n%t:'X8I \ U8I}ĵpk GNRrItp!,$r R!,Z$qe}M8T9I\ !+r$oWD^|L0rrB@ƙӪFX=c2Mze@8J%''$<~ xIFSSGS$Wc/I\"Kҏ$eLj7/SI0GGI:*#WH$q%T0I )`bW0I\Q*r$ +y/_>&0 &)T0o0veJ)&=2Q1I'82tDLgKhč:"&)vQp-b6cCUI_% #pr3rI GIL%ɤ[?JB&TWBB&bWILwM!; | \*vE $ **r$W!^|L.d.~ʵTXI3ӖzcqsLk8wF]v6[+{>}M{w8Gv],e~D@U x%V&cEr.𻒏_$nx7ݱ ʪrt;?vJFSsLwPc#|;j9pJlv07*KRf1}c6iUe`a )K?(Ԃr1x,iy}0%̴fF=3pNЈR-sx%+cqEՈ3LV+yQtR*`L), b- I]J?K?;emf%KS \Z/Fyb-NOq[)QN) QTGx 5wkMInqOKi| ځmFV]cZҩApx9p*igwEXvQF{5p|0tǬK6—_"xU-KQ?폼QJhTksDŽ:{^JuJmnP[^`EuoM'qmmүIJ?%0!?$GBvಖRժZfV[ C͟SqR,h#WCZO.5l@xpe) (g$Z6ZBABv̤e[ݖ1{DurѧL{ck<4ђ5+4rr^WцY1r&XQFљR0'BȠr6떦]ʘN҆nQ#jӕbitW'H_Kgࡎ_Cg *2Z "qo -{&("s)c+h*,c*yteFYСR&jD7 <~C$w[I0Gd /N*_VY 3N*vkxRfy- oH,ΙMZ}[y*1 2ꖉt|f7cA ՜5~5H܋0<|-GOS{#5v5C O8'LG?ZJw/_>&حtЭvYn3t3}z+o/} eno*04 N}WhC!>'4cn%?^Ս&S?S_⽞>e]CQ3RGOan+[mYN`]^ %L#m4;!WrNxT$W0鄀}m SpIH9a yhs´W ټ|ಯ8,I(\wL&d4Hazj ??RR7qGg\,ZNΆ?|99a/'$Jh(ZdA%Qj(KJku<#!,g& }~7sQ,90Y9p؟iS`ꕢG\9=oWζQ&уK9霙Ų?Pw`tXi*= _.Q)BUvR| TP@J_+ 9-XwY\+m?d!ߍ{ձ/h911::Zfk:R UW)Bz H& KLIg'[id#F%R:fZVl3ԝl㭖o.-HWX <Ƭ:y8Jw]Dˎ=a JMZTyz ӨEw|<3A]Ds6B^QF+ӭԐ=X&hʫSKTUwd6F]}6?U:F;\^5UBG\>._i'rI'IqaƩiڴEB،p)T`m %}q2/Y⊩FO<u8%3R5=b>>,'O?YIvF̝-N}"}Ӓ#gt-yC}=FIֳ];CKxjl+keo8Rn֮9\O&-O=|/>n-j?g]RGr/A:{ԮSg%,v˼3+_G(fDG. \v)rlZ. Gc5\.9S%pr?>{ sT[_RL^k(d^Ze:_" mn>?r+Q;\.M唼u:&%yJr.\g]RGr/aj~ V⯬])&/WwÙWu8x+}"7M@\1෿%Z.~eZ6M%&OΣoRAu[MIHɏZ&d'yN}L3.# םսI@uR/LqI!!]!Er)sw|cJ/e\KmI3_#̛n:AMKȉ:&P'yJ.g]RGr/av~ Vӟ@Rf HRPH%ԃKZ'P^ ~isqR!`-Λi Vy3 ԽRPhDϦ%JpDG]J<% uLBL3.#0G^;{O!Ww"ʨo~S:5on=# .N2l\b1m.N ܻ}\ 4`AROhi\,\RDig8'LDg?,~s¦f?i pN{%65~] Ӱ׀9a2_s¦f9a6{O9'iMw*Tղ\"-=ةFVq &3'r*Qi=xR#ۮ39'lF|kEGMٜ65\yLЀ9 btԴ^yTGfok?piBj Uᴮ^y\vop3i2s^ϒZupTs˜*E冭"j\hW׽3ڋEy=?">P*<ر}O:~[Ovms:v+[x~_"ƻ\x> h:ƻc hgo:t=@fh`VcO0jөKK>R48c=j;FzWԙ1K|\P؝!s-.U 5NWLa7u/^K6$uf1 8ovc̫,HS,Y&=WX)pkssv8s)~&%U}$Lٝսw fq!we39pLRERN- }ZsASJbٴdN\ɪkR\r$KI ~&%U}$ȩ`u/^RL^Vׂheqm3KK*뀛d6&oQLI6qT#aܫ{8eJROhiZ)˔>8LIS.S%z6%V#e?jDβv8Y3Ļ^Bdw V2%0?S@\/a֜'Z&?_[N!qgWm9q蔝&[nM5)GAk?P{@F2z6-V#g:TF)ɨtd2gwIUɽ9-X݋])&/Z%ړ˨/^~Y:zPl{d#O!S< 8x@ AWs1 xBKH7y4x@"}(ѳ)Meo8R ֮I4uMN}Sg]RGr/Ac V< 8x@PA Hs)M< 9< &n)G)eԱlZF Gt5:9SQ'pd?>{ s$[?ВI]l_'e- Xu6:턊"H)'D'S8Nd&>\ܑhIO?)i'N~BDI\sӱϋmqV4b8Y|Qq鮑% |>p|Ra W ~w:>{?J4y%/I&_ 6;V$q@2Iٗ? US;epVVexحmp,mڕ1Hqz |C\hI;u3W4N ..U:.kCR#'||,5.TJc#^Ke/ؘc6|COBjnelp=Li~[5~Ú ꆦ#e<*?Ӯ_aZ5 ~ m vhױ:c?| eM8)T1Kli4^6FGYrW+u3n,Niza ߋX| :{gLLQctܒ^,jf9?{˄2bbf] ϡ鼞D_ _9aj=yo K/Ne .nnutWtjҘW8pwNwlX?1n0 0)-o?Yo[t1W4y1cz3W͓Or^߅xd1o?_ًWt7Q8#{taDS <1r-zu=uhǞ-Q^ҩ s¤^w>p1 KY0rޚE4*-ti}};}13]QMKLzsBE""_~s4\ρy&AA?P=f,'<F.Qal_M sCE-9~{yME{C蓬֥rqV3~^1(V^_sˆ]]h`RK!0f%mf_ `u4>ѰYw3 ɴoYQQ ۭɪwk{xv,@ˁW_)[ФNqo`ۻyrݠBQ 6e{i:8 Y/Rɯ`};pB3_5N8uڟR"Z_G|a nŷ]3&|>SnEpavЊÇ[QL=8tǬ&K\PU!?"(ŧi47Aj\ w8T/5d.Z{dj/ܜ0goK=e &sKۏw^Lj&Y:AVgT=s ?w{1Jy?z#EQ `d𣥻4ttM^`?hv>_qVݚ2K۾QЊjdoІ@ < D,'3z? `F~pfhFQ_a< BN]f+>JPjHQ\8z#K0Ն:f U)>DڎŚ%V,#oLёtzthd޶\gúLά#wU 1lBPE5x=Iyv.c G0gDr;MRj44Gqldħ߂'&<~`H)·6)|}2OͧLHZ{(o%RױJmPǪsKCAG :qV% {f5zOg֓zbזEg : ?o?p,p^15ʼnGW\I\VҸFqY=ˉиqY[ߞͣi5Vz%WVvZY]Vf_&^ +t[ 0 5*IֳeL89a&Y s˜&]qbmw=XqR,P)c~犯P󦓯( fʄІ)Z.{돝h{̒O,{EoRٓ8'Te ] SkSLwۓ'Z6߁UvR?Q X5gnS "GwpN5꺈Rc9'T!E"OsNc c:>48P.(*~s9a[O8'ilA~ MMw Ӱ?9aL{,ZK: { _,i? V ·O IݤѶShL@JUμR6.yWtAӫ6FL,Wq=?'&>%`DXzhCNځuKX_9sֲ9:EƱs,ܑöXE5ap.kNDj4VFRdROF6$xgƶb?d~0Y~:q}NmE)i:[j{wri˵¸iCG 1]n V'mH7Tx?yg|T <|auf1 fy)QG1󁏁?,'h*Ϋ2#{<0 i'h:fzcmU8_Tמ5$c/ӱ̟ ؖ)+N1:(m,j1&MǦ̬LMU4\wv>nXk띸d\2x%%\=0's˜pNbetA8Y rڜ4ԧ:wJ==Ɣ_h+{@|Cޫ(+8_Ԍu9u+%*G?@E?RA]glU+'Vi`C8aKimh7qi4_ ո?@i+fѭ#+ .@::T# o$g=,qY"V"< \\S{J]D::Vיn+Hw2'6hh|ݴ*j.ImNd[}QT#{5b"U14\6‚f%Kd4`2m 5c}`b5~Cm{{z$v9WiQ gC0/ +p5JՉl02^4ӫ;p &%o~GiRv)p5}j1pه|įW>} D}  ځ#|nn*:"[_W&\._<&ĕ[_ W6Y.Gwk&'M%->Kމ~~NLW +}' ݝ/ț= ځKK9Xpb(^wFdխISͻʄM$~M{{wJTWޓ[Wz\yOnn`:uuڰqFzշgl;Rw羽}!E% /8}&ĕg_o>QnvKYBvqR5̥X4 x.[Rx>LW>|D}8 ځ󂙽a';̈9 ׀[{\iόww9~ؠ \j/2D"I o;^Rf%Um-g=x7X~Ole;V$^ 6!L qm&Sǫ,Hĕ~eq#kLxv^QP\t[L1~KĄğ/`7%f87ҫ?i蜇Q )Ɇx%L]Yt-p|8z]&ԣ$6^ |.sӏA$^W1f>&X^7TPΩ[42`/xhH! nԄ@C7/<@Cڀ[hHVqhM jtGVXLfc\Ӎ֤:W&l -)K0%tk._̷7NyO8BqL]#6tQN;-pp]wvwa8p~PЕPx ՃXwoqV ߻훻M* _`G#ub%s|+?}&R }ԑnzIk oKqh,9jeg/o(Y}W{Ci805XBREt/cgy.\p+\;UfjJ6Uj.̑A_SB={e;cc HH{{62?ל`c[8)a |[)tgJB?t\ALN.{'o9>9}Vn~ᖖZ;i' (F-\.彶e^;|tV>PlZ\M}w l 'nbW >fټQV)0H_=0zxDe?"˿/?Tc2s=s¸G&6$ nB乣WQMtքj(d (v}1rVR.]ٝ3:[<;V|ʝ\ ~rgjJEtH)mgdz]_aCG9 m+tO+mOMAZo7*0E@B7H0ήtjŃ\cV*ikm_ nk<"Z=AnNM4JA %t{%5z]NU}%]![xB2ez/-|mkq;Iz]'}>ɴ\k,~!eVz /iOMn~Y宺o=] K:WŮlG9ꗁ/ג~8?vT?BX?ˎ|=w*X]>x% w.nBk@ p p '#ڮ~e;% 853srHӀ+u*z^M Y 쇧؛keǞ0 K׋ڵעú EСEB0|>a兠HB3d~we~S$} c7QvQYxz)1i/yg098³m毞+.JIu4O2?c4#D6xɨ>a:EWJy?wK,ctK1Yu?7kY2:WS+JvxiYsr$ xEI<'3v)>Etn c(& 籠p5 N0m;h8ckUz\r{56YAeS$}%v"p]dgrp7MGyr7]XvQw!7G]<5t2 d_\ \&?U 6MwK5Pe2@gIw} '닀W: n^*w֡%O4O=f+~\zQ_K_JI2c;܀gUnrԟu~#)s \zb4G9~4OBs+{cÏ`˝j$>+ .R0:{+ oMnc5`qoDQ) i]'ON\Fۣ]vl-豝1 %5Z\zQbS/A26Z/ .E6:{E=luÖݛB8 nf [oM?ĥ ovB bKSC/ /^WZhD@\1,@.m[߰fugv+}=]11oܰh4W*ّn`SH&v F5{C,+ޡ܊֡We~ܼm Dc߳eΡͻy-={>qQ2E-ӳJůQܿVh-IQhqwF Օ Eh_3f|OY"DT GQjoE]qd`OF1߯} z Ƚ}$"d$''c.BIpgYnug]w5REx]ՖF6e3o]諭k%닀1܄ጄ}j +m5ln*ixX,UԭBK;_mۥ]٣SkXʽgjz_43;ziF.m Z,ړݕV==r))9-W,Ox'W,e.PߣbY/CNb!q%~VYݽvTy1ǒV֬[zUj|Ip+:C*?~<'O +m5nvjeU+.m_9ԋzqueVTwTiSkۿs-k8xd))e&w]qh|<.obU;HۻoW$!qZg! \jGg`@B*ĽA*jجݽnusSf@}Vf@yzT3/|=D>7K . p]dZQ;3rJeϦ#gY̛0M:,B[e _8du >eE\N<<#a0O}f"SEj!q5j!wK-_]/Kj!qw]k۰TyJW*ʰe/J56tX~\>VG|QA@\iQ ruui-ړAgZ_*Fo'u 깈X3,[oѴʢݮEdz4/>37C7">o> dU{#hBD~\.ͯCz| O$_%? .[TJZݽj`T/Bmm}kB Ho"~%@# ՘䆮h_y%*uU_١]u=V 1zpu3$\e`LhMI(x)Zk,HnݱA˭r Qaf,b/E\6yڍfh%Y,<|xR# Va٘decK딊٣5}5߄Uن6 -j:>8=H4="}>胐uHx_$aF_  r'~_8lgWw7jB-oQfs\V4ga֯~'a$-O. 8č]E5;etiYSjl9/9^'Pp\j?0zy=.QR Hũ$!~ & 7!BcP}-3CH(b܆>"%f͐>6n𻕙nr޾ kX׷/beB?| +wG#Gq!qan*L[8ʹi}mgd4N<UWoD$}voZg!q;r{7FEHoSW&_1pLݽaTo sTd\7߳!tlHA W$ӥ Ǵc6V.n*:CةOcIRٶ <&mk֗n-unayVYwa[Ay2GI݉:|IQwp | ?<.7~d>W\HB6qU&%/2ԝK~u\go/~R1'U*$eOIĥ{[Gxo5qg ӶU^#U󭴲6"$ୱ sBRXrˁ'ֶ5%x2 ņl Fڀm$~%O?MKC.1V,$[ I'd|lxvoM'6oK'V"OI:lߥ/'qLHv M+z:^q5p|$W+)?t5ӫSDC?uQsKSsQ0^.HY{՗o5 +kٱbŊgajyhujvjvl6sL-#=r%Cw+1q6Al]#1֥I?34 KU41!PMQlI9xu8Ϗ(u;lKbv J}#rl%YY_Q6$2e +Ԥ<|! QH{^nGc)ݱrl9}?B?r3k}^Kf>E^ܻg#X_ªV-V/\=;~q)⥿S&,|="qi,nk7f/ /*B[,U&!Eo/z^?ϊT7tEtE̛G͢#mwXz^CRfb2qIΡ9\ԕpX/z8N6 _& .E&ٶ2ơ c0umgQ4&Xjô r;F{3۩픩[aG]3bb&M ǴmJMU |i[=< mQ=TQ4.On.@ ]>{ C1/B9?+LE| S_BZ./'pH(u߃ڣGLlpyX/ؾ+َ-L`oא]O cLk\E`_=ƁscN :ͭv]wŕC7{-/ߥmL=cgX_wt^U?jt;5G9:;gLG0w!_zmNexVߧlUyzJX;zF\G]|[k(+}7y,{Y~J@7C)+1 vέ%{\rxFۇ3C!yX=ܱkڋbOÇ:0N@\y&rBw:᢭~(IQ()sDi\~bnH1V!Jm1o[?bFajROxٝڥȶ  sO3kãh /&h]K{\`*⊙lܔ٥ХE ۅ̺a)`=d)䍲7xtE~c`c?3oe5. X v޲sGGt b+i`Ab `KBE/ kϋv;T%zK"˄ôuͱ>Хyz1T7*hDR!nڱgK EL? 鱢 +N };a%#HKh`{zH&V_c6) x2tTj+wV{L* aVxqY K+[ &!3+6{ S^=CP{˴GWK#O(Oɼϒ_S2exNI0HNANū~3,RFùϦSRZ{u=&ٛRKҩsKڲDe΄QNr̓t/o t(7߬4-wJ(5WhDڊ9@܌1H<>q)zægBĶQ4_W cr Z +b?Vu~F, ~<Ƴ+W· d)SC]~LHZ{(ϒ~)d6Թm_-?ێceۢ9~Ks(7(uku`zh@5׆=V@:-%Av! X[ۖ[MUFت"[u mX&&z5(2Wx595%Gv}5w%s:j`8ȵE6e^Na+ehkn{;#^Z{D@\I6G?飶鞏 +ܣ}L~Zme;cm|kNt3nc^.?c!<= y yRx6'PטWRR=7~)d6Թp ƨim0=ƻ(GO㝞g xlSNT%j$xW[05)%xO\a?9s}5%GzwV++tRWB[$ N/ [$ $>j+@@\Ocr6/Y;p xF6M+_ Ͷ -X1)5A|mH}Z^C3' K] pJ;J ~!_$7MO \P2ONLH9Z{(o'Rg~JmsK|S6+Fugj~Ӣ΂5{#S`M~ yR]?̗GA?(&*QCmUR$_JxMNW[{wakI],M~%H&=ñDS]u}Z cmQ)Uzt2 g ۬![ѐCؐͥIn(ەA#BG BJs2_9a}<$sNvtŐ6}s´xHj\mr}<  &7bZ:Cb]5etfES4]tg'՝fV# -,- _E?5I#~_ _$ zp;j" +u"h_4KVimܦYbMs["`I< +T~ݩZk8a"lZ^'$*s,V=N0,q-B;HB>:&ԣm %lF_XQ_^ | T 1 ohKeb4wDOE>ጴz-)iASJP> tlC|C,n(t:"}S*,`/e:vW࿊m6jI߁NaaڶE(ˑFi0QĒUM V:ɔL89Rrf67rZـUA cln@߭bTs]PU&qmR9Ϩ+n*3t`cdsBekhTSt; |!J v;5َ1kNmc)! 凒Ӝa?9aLíC!&`sBev,i?pf9'LÎ g:o/ioZӪ7 Mު̶/P-ufMX3x)X3{)ppsBF6tQ9aF8yV./oD8'ThۥdYԮvэX<;9 {:)T8'L(6γR.ދa=gեd=\!edsN]g_9aL[r{&kU[uu$j # iR9'TeFqtR+orNȊ I0#o0yq8:w8'QIwk\1ՐG6hG?z*zZ竵`Z13ς0>ɚ vەbf(XڣQR4ӕ@p5TDDaH2waH>.;{cM̸A6OU SH/,2 V#K!qmO!O+j$>&dϒЬ% U jڨ K7`[)fűQ$Gx 5Iqk`w[@\w:(NBv`|oѹU"v$ӒN䵓q*UFM9%8y\H{9%)|%2W]%"RS*SԐj|9e/rd6XN-oOziQ3QN> qmkI? + -$ J\wLUVd8f3H f,JAp{-lSvm@_j`JٟtbF4H5tƔkF.DfNSPp /Dl!',K_Fx>ZcGMϣ&mar,UJZoq.h9<8.53/dae$sThtn8KyNId89 nɳ1ʪ wzMS9 \jȩn;v`F:pCb{ RNނ٥ݨ Tϭy;aD3?6SsP:UНfNF$Lr?̠(1I8PmtO8'L%g EcQrM 5鉴\ \9"INz"e.^9"5Dpv|[kXg+j UhW6 FJ7c3_`tݎ{9'Sz/_\Fg_Yv`AV/ )0I1&R$l9o@-Òj\簧2cr9lka4j ځǁKՔuSؽs,+ͱt.m 12RKbINԢ\,:x I<4cew?!5(24>2,YQRy+RbD7m[zͺSFM MNgJJ @fM}3o[I4>o|E9@ʜr4Z+*ĵ_ PU҇BŭB4>&*+W!g贿.> 695Rs;xb/QB|p %}&OEbHar[jII¨y-K)a ^iMlKq̰_n +p w |騏Aw;)iAO(^ )Q7 y e՗IZ̵I\߬wSd6ثBߞgm(Zrmpuv͏'%TP2JH$*,rUg$h&<&'u8Ioc64G4`驪Q4Bc(=`&?n\9< Ιk:wM @ŕg5j$h58+4K9w88+rRۭΓfH~eʸ%bYv`P]CaAwPsNBwP'9'iӅR PM$H2_<#sLHi W S cZ&R K_+h~s¸Ou\Y + p1]ZJh%@v6C3f*En4"sp*/!92F)K⺀;[$*3IVvX2W6"WwaXwݕٜ7com5i[|BJ/@ ]!>D:|1 ohRz#MoR~$N{fEț孊9mTx)=I?tAdzN bGt12Lo1Y?19*e8f,.0.0YFu@ iv&o3nK(oLM2( /qH~'_I FbvA%-fT8|{:&x%x3ƛHU@MR# 7cFX&7,$&y.^H$R;+0(p |LIdeI ;d肻Mʠ,.wZZô@b4z?cKǖ~\j?i/b셨dj%R_B]yX"]~ OLdž/mCKs&5ژ^5\wkcg,= OTH HӁg|=@ <{FӥT<1ky*J^ .5Hi x 5m#ZpVrB] n~ʌ&ٵ@8ItlU?V17*'e˝q0"e^ |4R)1p)ҩNH\N?"PzݸԹܣ}LpvNyܔPc<Y<xeQO< c<;x:GUE\IHK;fD7zNGQEz F2V@kvET4y!/O#"_(NH\L?" +4<>&F'&Tg ^Pbhg1u+ot_f{Y6=ꮖ emm;\.;=gGy# qHkg&wi.{߫.]>ԡ>'S* %><盝2_~id$ oˍЉFHĕt@ڀNccRnYw tk.k;&:C77X>Z|3Z3lG}v]shʞ2kZVEmn-d]仼 :zQ'?!emW5DSπ&(G? ,gӏr$sJ:ʑ6jiO5ʑ/+(EE3bGsT;p9r0`R9+♈o=mΰc9[] 0=IzG-?,\-:cϖ2r?!%#qw8vIU#'8ԴG}%Z̺kr'sHC~MHҨH7C$ĕt=Dڀ?Aүrܝ}L0.cAJ:gۏT@'a؇%vcq3?:9Pu9v*ФZŪti3#!al[cg:_ qEԧo33rNt&myu $~q + 6 Gʵm@̌U#wtjo)dG-9D/َ鍗8kói#Y0H埝xW ?Iǁoc' |&77 +0FڀoKaĿU@\釱 ;6`,uځKJz`"t3HܨK<8+ЙRUԑy!WگB8z$qB1 Wo Pq$"Z&=kog^{ˁұq Hj' & Pe]'ۊgz҈iluenMT4FGA~g9#Ϻ}T5uVL4Ҋ~!..Iq +oOhaOh;C[.Mf^15L>MĞ̛rBjỒ)k7IFucޗ\,Nuo81uPMK"`ֆ6kZ&i=Hk8L˹ڄLck!:92òA R|JγA sƌΖf^ÐN`l^!37q_ + ;9ʭ}0M{;[3vx?<蟵~tdL 1_γr?+W9aLX\9)s´S~n*IykJD}a;\K@lK2\ -3P躵qYb ~f%-~V$?P*W Rv%sB9g9u-l{K{ZjI?Z'ۧw֙ք]Rqچn& =z8'LɲsK cוxS~l# vm @@\i?Z_'ܜ"l5n_GE kqa0Q_ҋkERqL`8b'r#DTh= \ .7a3-qJzOi"7evi7tay $8gǶѥ]PRI!/I?Vt-gٞqQm]5m)B^O}4_K mboc&p |*XdC;P5TX0Ap[!+kK/y:y>w3#Wx6y7ɣ7,g7.7On! ƱA |/{1[_ ~O*3HplO4s0Z4=Fa' | 4n lh/ӱ˧r?Z*c 2?7fَQ ]hcȔq?+%E8'ЊYQϚ҆ira8ѩyNlTUӏCӏ7'=A6~37lV(eWJ E9ǜi7륄@ոA1g:ϲ{,ge]v [ŋcgpN4F_Hzlap) 1\8n%Χ2 x#$(~JJ5j(*ըTh$D_JhUU"]n瀎Zh돨}pQC7{e + %G9o/.%Lau2ɄI\J$lMZNK}焒h "wpNDqX5, ȋHw0nNl>^E5k'6W[d*Q[k>M+_j+TɖEНp&eV'*ہ;S8mOo\r, 6 L'cOj ӆRXӳhXc>xsZ/eZ/wGEh[/kzQR֋Z{z sfd6hsKdn6ئ\8ȏ=J3i+(>3xhKcsvEa1z"f O8h 7I9 8D^ڤPPBŕe5jde3(9{^JhPNPj㠬- b~(?b G((QFq51RJW5*EDK I#FqKMk|rKk Oci),Q9++^gQǏ6GLc WF]Bo<[w'MƴwqNbU/c?9avy7ÜƴKu$#?<#5"2yY ӰG0Eڒ~sBVY%c9aV38'iYzRqǨ[ya5. 䍲? uLUϟXE:Z5͑v$N5UcPjgT$qG#{$<;[#{sVQ|do<0萕` ⴘ>:^/o/+ [!~%$_H܅K/:};eyg.?z0i{֗I T:+l6Qv5Dɪ:nןArԥO~ M;ʘs-~uoI6IoYtBڅ~˛C̕4W:wls=Iz9eL*SrycTϋn 5SR[h7Ԇ ujI:c^ 3_9a ~" cŲ+$̓y1ug͜<ڪћ0  chbtclD DgƹdztZ G(:Uy/l焊\]"wߑm+=%A+Wp.w˴78qCdO> X=p5^1p"0+D>f0>sBE q$)>9'L>9aLc_5g9J5OGueUfqR0 !] 1N[lۭٟyMϊZʌ6=γG#|$@53_[5-_ᄭj[q `kI1o]i/Wj 4Döѩ{j=wV.i[FG-hr`<'[fHHj\( i3 ov٧=jzۮd0  Dvdiv kҺ ZT^1d׏]%W Q+pR=$_ ve>_v4U׃>8 i AdQe}[4Y&2Y_|gp7U6h*ڂ$^bi* >~VY9"O9kwhfAi24u]t=ڞJ~yB`iPYEiDc])Ww)ĄrNY9Ӿ f054o0iWM|g&_;gK?(|+8MUhi?0yÜ0B6ҠYw sLCy!f j8'Lˁ;8J4i2sM` "3vVvvV1i;P 33c%'h8@F{ #R+_Q31~ߴd8oSē-KŵԽ>}gf v^xhH$%Ǡ @KchEF~MimV >1iEvŹ){-9ѧ?}H {[d^m|i /V\cR % ~ ݴl67:i #V=/>>LDAF f0ݪel8]ZQXgt)=2E/Y2C:;yV8w^*?-:|̳vhZn\K߯铺=tz _fэ[[œ۠Fj昶se/;jȽ:m=;M/nx2p-Zav۲?xE%w)$4>x&Ѫ |}lރI7/H.'\['5{z .=;s/ tb7aGyr]Jk8A6q GuAq!b֤Kee}*$GǾF7*W?t<%%4w^r-R[yYo lsrMN*&rN+:SQ1L :@6&Q rN\ VfɅcL8>unflVnU0w<Ɗ.Rw5Qfewj&'ˊ]a~&c7tlZOƶ!?.f; #6 ukqzqc I3#z3r}#uR 3g.n<#(3sN̗6s˵H-9'lvͼ 0/PA/r4ˀ_眰%1} 079aLّVW'a)39JG2cY4iT\^ʳ)8*϶SOQ\IFa\ TfQ+Pf{Ʈ߬wZ&(q%IoWdWfU]}q=n߰g!o3O}劏OrcM8}m)}͡şQ\MD }j\3IB}:/9syjS6;ĪWVs!SI8_ =sZUjWaAˍTAü$~{@UY 䁅;9_ة@E s˜9:yG8rN(i*"f7qpt,iĭ Ԍ#Cn>s¦;48_hG9'1ݨ]q0b˷CaGܳ&k;~I~ U _0kδKUUO ظw+}X߽4;ÏU[wػz߬V?Zݳ=4pUoS{_׫yhQ\ ~߇;gFn~~.U}ί4cKy2׎4G1}9)g=L7Eh?|AvI3\wJu+,kT']#SWX+MYi iR%+eI mezbdžoI*e+cjJ苒`.V/Q jaC:&՛lX#~/MTG+m5v~;# ~BwD'Nvw$ON_NRJHs92, lsmR^ ~q:nnqƾtȾiEs`RfxUːľ[n0 pѭx++CGG&֦h tVv>=KI#Ҍyz$l6|ˤ5l~RWEZDR A'd?mNJ+*RJIX۟{ߨIVj Svv wuic礡7n8Nܼ^4 IGThS-#,>د~SjgjJxShψJ]E/S$]N~Z5tcR1*)xk.$i3o7E)Lq#qGcOqn-X; }s漩9XN;GX! 3Y3q{XqJ&"8IvdiՎ O;=)hr0ݬ I{Aјu5=خ[W zR=ۣ2I?T{-#߲'-Z^2УVdӵ-=@ϝf =c=]QRd[#k#oα Jm/;vW6"Ё=VBAzF|e%tԀ 0 8CE <LYg[ .w'㮺2_+6uz rpczקoh &u?+rP~Qp?~exp:z3N;w[OZl|lɄQv{싀2}vKftx'}SKk>걶* :׏zU~xfloW;OXzzxZqm}c43Rs~K/Y.>F3*L3+ݜg~ )|t%6#\ s$R>_q S}}J,pNxN +ڰL !$n8y&h|V9ȝgE>}nUr {pNx.  |%im (1v/p8׬߲7G7G| =O2#Fc9'LKv+J/P|1p;F r +=Ysi%* -ړCy%)nv zγR}s7tǶz"88cov8yv\e19;9a 7-{s˜^]{®V3QWj44װCh2%4%&ͰKCrN@`\w]8R qR-Y9'L| 6OqNe˖6s؁Z.9yT^[gsN7jjqVt̴vpNa~]6 1z9ңyk/p 焊-xk V /ъ*cYBc1hEZ(w؛{9'T{i8,z[m c:ln`Uomye1<7o/UT27/sG;N b@:FviW)̒m.d_SiO!_'yWٳ/g̱'hf5K+c–Zn;g0X1pڮvvuqC`.+Nv.Ͷ zr~fy9a (U];#7&k9ϬM8Ϭ].몿&$pztu7\zd~Vi89SY}F{#(_֟*SnnŒU^@UkV6vfkP` :o wx^jkB/VjیO[^ėL!F{ʊpNF}O9'iO*f%%qEZ -vŝi)ۣzV'9;ЪjesCW3nKܲm3'/c6ۗs|)&{9\'~IXkQz,̬f: Hv5rnPʺEm9"6tK5yT-e Y cZvsuw:V.U69sCt0OroQ\IF +,j,se߲'nB6ο9mN+5 ynۺ6)IW zJ9~UF"G+.rUg fC'588iWIPSzoG 1^|^4aZhĜׅ6seLVU7JtH@,dM0L! _\\m-Ŝ~jo=\4Wf-T͇Bh'J9u:m V}Tchp6ɢ,vx9Mv3Ą 3 nQ}puUJ}9}ZZ;>{mn mNw6띌: GgK^p5 N)hs3SH5 ո*ټJh ;QRGϑ|\o )Hv!p\#q~~*f>mt{{8Ft۪_ {W-~j)>_#pyiONxYO4WtZT?-?8_yeNNL%:_eUUf^e3r]bCNS&T٩ia Grvt@wxjQ0#T<1N1grxN6k&+m5nl7AWŽѿaCԕB3[T\Ox< + i$zk噴*SB+ׁ_w;-; Sػĭ~Cl휾t۴&MGw E^-lkr]M7PE5u;jk8'-랩iȨ9Vq5[]Յ-LACkfדI|;(勏Fop xTKh ^ڕbr.p%漄53DQqR|2 'q5Rg2No1Jekץ_( U/l~dCC2jUֳiY79Qgפ2oIGk7=p+{Ñ!vM"Nb' ;g]RGr/A;{wcsM&9vc/s͖Q*P/6uׂmM +E\lb76(&̛nlRwHPhVgӲj%o8rήIey:AK&~&xTK#߂սI&nlU@\j=yɰq.ڷN|Imq7 LަjF~ Hu+sly12"!l*Q,vYX)YszjʑT7ĥ $EbwuėS Un+k&f//g> ~jj I= ıJ^Rl`G˼$uWjcJlJ7)SQk$zUؽ* ;^gwIUɽiŧ?VIR6qT?VmB*I^`c$ıJNt*Iz`*IFX%)<eތUCGX=U+yÑuvM*Nd :\2Y3Ļ^ŧ?VIR78VI ܱ1(s@/? 9\VKm2xYIxLv̒]vY*Sne->Qg-&aAm_&+uPMn0d:@܋_bˢiix*%+$4`/IYΛKRl`G˼$uWjJlJO7)cQk$zZ=- ;gwIUɽiŧ?~IR6qT?~cB/I^`$KNt/Iz`/IF%)<eތ_CG=U+yÑuvM*Nd :\2Y3Ļ^ŧ?~IR78~I SrZ5e\Aۨ.Oײ+0遷SILv4K.f*Snurp."j*4r%Ls j&ZF+Ͳg!dQY)hR]R\Y qлD$ +t]~v{E/?QMp<zC$,')|6e q+!N%z63Fk1z^ΘN}g3Ļ^B4o V$8Is=t]GRCM/0!N l'_'`C$u=C$~f^2o8I!AuSM˪َ:&U'yJ.g]RGr/av~ VZ$M$[l94PmZ.> :ƍ n ۀ/'2ASu+ssFOe*G+s!uEI/Y?9jV5ePVRy׬!$GW +uckkF^9TSSK~Hi&7㡤y3J>ZCٔeo8RF֮I$y{nv8=7?>{ Ҽ/X݋O< lx( ~ҋU\kTC+\LkLˑJ`+%B;c>5mMŽ#,M@$U/<:ġC"LIok0}F7MfsBE90KR}vo0 \s˜Fm/x7bxaiޤmXv+eǠ,)uvensBEV]̬j{)>|'iwqNӮWUvu ˾۶S0- #3R~7wʠ:)/l i0mQc^wtEYZ3Efա޸]+cϊxg7U)SRX@ҽ5fz/?r&ōYҋ g,k%ӢD\_ v3ǙS*CsGMud^gM cUS`>B{y@](1dE8oʬlfQeuX?ӊטW~57#xLx''/$?TYVf 3nW?K֩l*E=2֜~#ʬlz jwj,ݡo82HǼ&xs ,*v~{ 5 2V!G?J*#?ƶ8+tTy5Q-*&'Ze*Pӱ'{,*Y~=Z¼V6a3WqN` Thdgvo\5mZ Q~7| @F]&i#ǎAvX[st1׿ABE ޥЃ3^p.3ϔx/N4^om 8ʬ=dSM[R)?,2H.~\/_ٌ 1zR hX0Xp,CQ* ~kK)-a%J7~VOځgFj[d ͳV^(hčQ#AۯĔ,HnJO1 & պ(}r (sxض%Τң71?x)MohWELI>),q6E S%5 &oL-{VXLj-gtɘ߂V)ZLSې@@?3pNrN'v#jteNvsΰ[ˆ+Z& jѰ{mBn0zűV#Ȉ.pNpa8b,o6"Hc<1mwVXt}U EW(̢{[ra[9'lvEyI S?9af/XbUv-7R횞9ahcԴLmO%O"?Bf=Z)3ۗdIy4uڮk=ZY~qt1{L{[m=sT"X՜ƌ`;H5u%~as:&鸔:4U:jnp=m{Iӓj{KuEHb`/xolzkޠNARx᠈"pp]N(L'Q3$dcf}mm1o[gDxAW+d.d`IFlscfcò󡺆4]nIWbwJ?Y&>_]ɲjZOSlˠi.K 4[-F?qxL/BBRG_:ci/!#(+Bej-l y2K Y,s.ln/IVje;TvE@U\PgsN؄6\7%j$`"fVQ\I@UF݀z ̰2TVQBL|Kh MPj@9}#¬ꒃ.-X%#^j3R#N3R%L{ZѼ{hXc޸6 {!c `̨`= 7jK~#Oũ1?9a1LjcDZl,R6!\L]!eN~z%ƍg@ htŸjֈgj]7+SТ/@ uvIx[ׁ_xזo2U.SR嗶ݰaW&;&->)?-{Қ6ØvP Marf}=}o[yOح sfͶ7 ;_"eWnЭ.2f_Y~#cjױ,lrg VP&U DicRfݺ .e֕XG oIeo w5FMQMqAsvfXnpl]yZ{k8oꋎlp-1't3t+ ђhFq^,rԥd8z2?nrk+9'TdEe~C]Z@dZ_|s4Q9'x XH& [*2BQ?1ꗲU&; 7 cڬJk Hc.*\˕v m)$S9'i]|mG56k##Iإ URۅ]:]IwRy}}e=bi 7r|d֦|JRVKXM{9QU[YT1pޖNc ?m/-~c]2}Tf*k81Z}gOKjA}Vy)en**YUu=VSZDV4tS.;E+ֿfPدܗ"MQÊѶ/Tg-8q;oj^1cVJZntyult΃͎?Cc9'TT^EԵ]8'LܶA cFܕTh!~Vu;6K0Ұ?0ͮ3ԿF|3VX)֨ -=?rl[y[vp{T]@n^/Q9xRKjIbӇ:>|8{ p;&/qa+ׂ_|G]h?z%H"xQ]X쐱YpU4lV ~wl-$sySfc`>ü Wc?02cl+Wwq֡{ nW ض95,py,۬eRtleC3OOa234w.av_/cs4Lm0iuJNJ,.0uYiQޞȇjZ8'Tf~Ğ"Ϻ*u%qR:&}]q􁾁F*jq:iz2G /nIuӢuUcB/p*hWK(|QﮗoU4^~}lwO bV4B;+âOǸ8W]TQMu-& /8 .Y:E DZWr;I< 5Ԃ H[o3RxXP|XF3ej?w8wCV2"cVY7o%+A[L[L3d&EZkuUmR|]YA;;c-Փ?W79$ǟrԛk8t9ֻq.M-?e-ɇJWnEzq&Խ |:6 EBP ŕTj=ƕh&Vhj\Y&BNPj Yfe+U=CM ="197 ,DELߴRR^:/}LxLNRE@@iA'umXy ps+eW+z<)3TTUH$sEF.߬':GTrq2ÄfS\+r|t]b!AC2JmøRRf:oz7139sL5N*~{,mzY>'WT>s_R _9/j¦5BSLfXD!SIN1]Y%<\&'up9o?:q}F :3(h9'sT5+%Y(]&pi9MsƞLˆe0EwF#];9o[|@t*?t$( >S2gwo<{< oQ\IxWF2]JQcB{9E$ٛRB{RvEn)~{N'-O訙7ű syg#o׬2JԨ#5KɲRQTZ:E:}^Lx$MNT{ߞud jRQ'۾!Њj}6nZyM+;o;Xc| _X\w'N2M ܅,&q%-D\%jԍ:TVfFAΆxQHyiҋbR,SIPSoeϒ5n ~#sO|K2>?9' zj*%jԭ jPgj<44ҫAlƒ}rRj FPa{r)-[OUTov¶"=ήap)2W_w*PUm7p:5Vاk8c&u } zsE[fШj^QE5+[5-OA8a+x2Z{<\*Ѩk6OHY|`'xg:р_$\ڴdp TnnZM2:zp^7lW ɥ6n -[bda~VVUrǁ-(e7:6m"q;׃޴)su0,8Fe< aQ=ZܫIߩp̜0,>ߍFF;RҖkz]*gtߗ7;InaNlTGXc/91In͹#eLv?-O k:tgtF d8q0%IɋFd'Lr-Q>5}O?IYX][^muL& H/mDH!rN3IUU$cn:VVZŧQHj8>)c=p/Ø x%aVjQꩢayڀ~:v% 7|뤕3g=eoؾ .^|?>ݑARIA'e?rL˚y#\*ӭԐKk߬S0Y F9r!ӤU9aƽJ cw6iW+WH9lWf "5|HPC2+IԨLRnQS#I] M85RϢOzPQ .c!t |SlcT]sB[YZ.dxݩe8t~l/^J`7-p+Φ)VJQѶ[)|^d /Q#K\/ U͵VWt Wg6kӅHW UuVؼCƊ5_ců<~}24WhKYG$-?mE~'RhRwE4"w,cI# aClLRџMKl˺gŐc;'A%V4몊e^1=|Y`TRV~(a<9a X) ca摢!RЖ>>9y\Ny ap.7?^ئrN5qmR6y=Maǀo朰)6y **%e9ayI cZdA RsN.v%O?9aVƴi=%c1ɔ|}3 I2?RBŜF{ #9}FA2W9};40n}4/5dFZdZnKVj|tڷ{U!20/ilxR;KE[7wp*X^5wJnOj^yRR&sQ=WP2ɔvvߕRU"Wa1Wz)uWrR稻Ըm9MhJ@U@cc'l|@h  c YWn(5&|O5~~hP@^g0`ږ2ƑhƷpNȜyoàdrड़]zqcƳjwb ?-=if;d4E /✰\l|T%\ 9aL#&-G튣 yQF -am 焒J=aVfǻ`?HL_94xIߗ zTFo% 5%,! l-Q-jN.AN (4Uk, Jm++*;Rުz z}ՌJ:n Et{dVݕ8JT*VM9 d,ݓ:GtWSvo{{{Wψ_|#_j5GՒ]j:at_-ժ)5Gl£{rRjʎ\t3g͎fρ9Ἀ?j5䢻"Gwuv9}@&USk,GՔ[!?}Ft_- # 8?;A7z+jԘ#wjTHswXM9 d,8+*;R=cas&GU3*0 CFo5]sDUr]j:it_%ժ)5Gl£{rRjʎ("gAb+`{'UWL5N}|ZDR v RIˈBg2+o0w0m,=B'Z㦌MVׂM&=ub V` Egאf{+Argא2ߛ>J55? e֊{}a<.`s+V*ߠtvԼ j;Q{ˆ\~Ws yW6<3 Y4cDYV$K%9{lzvUFl&.``.KL,q~߷v{ꮙnݪsι瞛 ەҢae%~ڕ1HJZ}lO<D S,YfjWG dw.vwKNjGR#@\IӃJ)uhSвWe5YXB`_XêgP0s&KuXPi 2g=Y0 @7^l㴄&W8֫m/hFwfDWbU.ɪ:zjL{A/S1^MI*&jO7sR&IͷI1SI>?,(8vB¦0G';!q0bLk] zqSrTìUPUNS]Fy1F)ݵfAkfI<EY;\o;Gkd}k,$ {ARy67xΦHzR/xej-]\ 2Km0x۫^jQ`.x6WoJn&<-Fէ4v*ɸNpN9ϑQ\I\VFݸ|: -6+4L18|hjoc<*rC:[>5xl|++̉r]+34*wQm&8Mg{l:2bꍚN4b[pRCƾvvSe=*=T4KLn:Ϟ9'7D7߹#[[Tt:Bbsu+}Lp)8a.>KpˆQfWt=)y1 #n3e ͞NpBef*ցb_|Ixz 8aDHQp ɍ}&j^2mIM_'NuYMFwtMѾ{.C" s (ƃ5ƛ]̮25Jm%(L&ߪҰ9E6EX,㮦g{f`ZnqoP7)f+e\EP}k׶$Ħͥ1^Ups"uX%j4:;$^:Lᵡ4I!q෧hy51Ĉt tjO:~~tUsTT]ĕ+=ƕ.v5nџ1+1%9sQ<Rgb`5rCA5( ;IN}3΄\dhe.3 {FqBWJnT3{M ڕ)4XS%y1~Oe'h3ËT#c\N0_]Xs-u>_pBe`ĝ0N0_ߣ*O?(_+M'-bX*\WFu4S}zZ֘xbL X |IW! ?b˲A8a* `2}lO_'fӒ8l9CNmX35lbG#njKR?vz>Y.2ՍZ(蕢wyBh^t $ N^XMSns?h05 ⺻W@鵥mWFe5O?AO|ZC-Ͳ> FH\X #Ry@nϸ) 9Tz"ң>xi^́r囎_w_ x*ItG PFh452Km0"3Ϋiz-0d CkUga PW\׺[[GvKh1? N87ODFq5VF:֪_JH"2UTŜH s#F6oeW#:#UT("1eqq2>3I5VdĀ~ł"< :K' N8'Bg'($tQQzy@&pQ)lThFު0l(yToLٞ^ LIdw}-8A Q[a˲f`Ap¹aG(&*QQJMը:ªnj4I!ªq7 f`s {вcahvEuM <'(c"8"7LU #8SkUF_\pBEvZ$tեL0 S_F4Ue3o N4u{X[ʵ\*824Hځ'L).5aҫߝkٚ_q=>[T'c;՝,9?mc蒞?=α+ 9kE1v6)ި绢bRԫ.jL&wٙrօ!i /Sʢ|ZUB^R~Weĕ^d/xS7*&c\T.x[OhE6 bش E^Į(vQ5M3JlٟY?c'+[`\ b>8F{R=u&= '=_'"gFڭ(8abRG Mf7MSfd]=m Y٩:GY0l =~'lAS{v7}"?b@/(IF]C?)S*TZ84[Z@+I: ~{N@y9,f9TvBˍn CoM=(G?Ε8Q\MUF8zP2*Q*tUghcokiG:CUo2u6+% )k8AMX{OK-s>*zd{h$ Ctfgb;i~"pB㬀g(YF ݕ)a"1,w4lZ(yBkMEg۠C[p܍i+? MT%2K_uwiű)NӤ:uVWScoL̩(ڕ"Ѿ4=ֱSM+x0\v [@O/ cFyoA]q5>'TiԖ,u;Jq+4RyPNiF'Ś;'H/nVE5?N? aK+'*+MB#l&5p-ĝ<Vye-1sژAN xƗ?a\nZ^gk;қE]bUXZlR7 _-~ɗW…}lூpvve^<Îu-1 x5^-'!ɨ>twZL`mY"/T- %ϵ |t;iqT{WWnXG5nmQo6ʆcä  )9`̤i64|sR!:7rU}Wʱ ;m<`Qn GT?{,-c_kox۹q`'\ja{!KKc (i/?ğ֑ȥpGH^mӤvBPAZI`j~nczx"KBCT3+L>/5['T+ pv;Vΰ%O,wqaFcTh[s&۵uk(#e+2`?x\EQIj `@x'Eg1xˍT84"Y'Ԫ;IGUX_{i߽od> +8ᜨr}dWRQєTfWJGRa+qJjcokiX(y5ߦ2=ߞܜP\#Џ\ήXz hLj -¶kQvJ߆nǖus ^oau}ǖSTThuӳvM0|n?GI♖w9&5 ]mj\ /G+/Qϔ6`1bxkO-Y#{ډ!_:%펅ìVoi|/sA %[dPF]qC@i,3@frV͐x6is[x+(1sW#SDj"5FN1iBKuF)^6wV2>3DK5V.Zz|-Ψ-+iOϕXL@gdW+Q{)+a"BGJu&)R6sVq2>3I5V.Nz|3- GRg\ (]J%j4løRRf:oz7cf|Rgj4\GlQnY5eqJFq5R sKfXXDбRIf-|K8 ~{1vR"W7Ţ9|2Ĥ4 2Klx~JTR{Tnl,7tkMi\%8"6\FVW NѤ'i]ULfZ|򋔱RkWNXNv.xJO`WF4صؘ?OcY4f8սk?&ôAJg? xJjO+kGţH(%7'Tf&+kW1 ?|VpB9G0 [Ft꜂cd=*8az6ز p'5?EAx '5ylѤw(u.n:3.tqI++[9[O=Xtu7򿁕O?AYUwLkNhyF] ;4`xO; d>2'`).X~uaX#bx70 Y$4._,Y]ήMgt^ WKmѠ4Qj xɇu*wK^Pzu/RЬ nu'倵a4]ߡ'&LޡI٩G¡ '~oqhL;^1a 1Z@}O,X甸{q{0FUlY~}t9KnX\ܤ͑=bx6 .5΋%\"y/&]ĕ-Zĵ Fx6SIv9]nwj?jW$|M>_@\WEc盧WVQ'0z盺Jp'ҏ ) ^M{u:1>W$^MyuV=O:$~ ?REco>&lÞt.m=ϱVGI?8zIក-W򝴔iWkvҊԯڤWo> 擸` {I7Pcl7bԼ'}[ݼ T?8[ԼWҝiWk8vԯڤWo>}m5I\?zeTWϧH@\G-V5}g#<$Fҋzv*=bn;{$$~oq%$^/K@q'KthtG!gС#n; /:K[cnߚ+y'8:y-e :{*tBa}t[ <}[s7C0?7Oo?wЫ>PR{ bO /$y&WIx'cݻugk&ݖП0Bsز)bᅦVqBBN1(sE{{̝s|q>Nrj$=(r;ѓSpuOI ĕx~hf%w{m<[;S>gK"* kG|>/$F   /$Ϡ`<k!IMޟAQmM()Έi:b0Rb@8>1xO8 >|1 fq%_ >LਂRѕPx,r$la=nzL{vJFc0d 7eؿrބ$JVg7GONB=1?߷$FoΛΙ#q_FuIM١|IY# 5RBQexC\^q{=wGU4HHeQ}0kGj 1QR̋C581U\)7r_VJ%ݙPh2.~T&'Pi߯ ǒ?m_Q/I.dN5=,<߀&2࿍׎9l89z]նVEmp _ :4pJ<)o P򃔳4zAGi'0< U4eI_ND ˕# N̤VT̤Npˆe拽uz1M x3Mv %$x8ÊeiPza2zeF yR9#YI+.[s,cZI4T- B_|Lp$Jݒ!tK"}jJ^| |\pˆ%/]!"zRD}x6BB _$J;OKppQ_·;ňGG,[ u#RӞ0%&`dA4nn.wb{Aj7@>|mq aդˁ02p+C''TSt!'LCW Nx? |rњ_]E5M,kRo751Ò) _ófc>~:$Pt*լ <~DIx_4'BA)d@|QT|TXxaɳ]+|X"i̸4$v jqM`&ФVNp=e 9T+*&MJ 9bptɟ_I\7 +"{jSPcUhʢt\=Y9|{2hMw_cknș37jQMi.W1F-W.ut (\GAe"$s<^pB5%+V4m3R}!<\j?ܺ,umhcR9ެ-\%qǁ0A!?homo3Ĵ?oOxm?TPRL(о/]٢;gu|>mRzN7J7ڸG>DfZv. ʅpd NtGDX'_do>o[6fʻÏ˞Y2ؤgʺ^g8[6NhyW^{x(›oR̷%J6 ,b{-p+HEↁ6vk,p^Jt4υdzܨ,M>El`\€e?ܹq%%Tl[m L·>"~ K}($f_~r9v1lB3p>?lc4OCF'*%](3|.1+8a/=UpˆT0R5%glճ9uQdY_.CK-x O")xJjQnAKn: gK M &S Nk\< x@d8wHRv~)U|Pʆ8R*ZT&+_)xM|W .mҋ_)%8O5z5˂*,0s[(8aVzxJjM%u;ZkH^EpB5BN4TGu^,|`DSj.SR o& N+.<9P/_< nGI},i2+oOh%KuAoO`=w7ՂFtޫλpG yL^mI F@-2*ka S= nWr%*׭yYG8i  N?=Zpˆ~/uxr_..f #nveNB.`yfU}T>xR哀sY;1rg+Y5f@Т'8G^NzJ(WcE#8G5>].8|V9F[kpw:bF9dug8zF@ΉލqsT\ 6nLf; [9&P 7J(_ QM)wsLsVKmJ:I Qq'7r;x \"8ODd^,E~T[w;{hBF.@pB^?Ux0 |I8d_+ ǁ02B'XΞWOKC/%  #jziEQIzG#-Ħ%Qew鍹,LV=~Ά)>XXO=)-^p]U.#m^|/G$>GvHFe6Ꞵd[ gh^}7`햱ۀ_j2V+ي p".w'R3H-xB} /_1w x٣ʍ7PKNqxuZ&t?fPR~TΡ0W†)0<m'IR)PI)Zaȱ$xJBKWjbpx0&SҝѲO&H|"eApBE=ں' N? F!)ڸPcmG&a,8aD[M\\/ONJ7Z/Z+v^yv^oƫv^Ͼc&.)\- ~/Y[nп-0Lop6uj@OpYߩC4OKO{ p.D= 8a yV\i4Yu._.8avz #iDOU)e 0Z$5Q_ |kF5Ѥ* C2M)8a/\pˆްU7IKZtcb;Q #>L 7TaLD%zw[ʌf[Z?3ҖE6'x)gWyR6;iNmewq~W WS {),y,UJ]ëzI*|gV?B-f #zՂ*cjE'7 `kVv¯. :r1dwb.xJWfE9R{MdL7 t'LtY+xʍl𻣐|X<%`yWX_x%f:Q[*0 <|-ˀ/<%jFR(ZS&aW&xJk#tʼ7tH=gl=5d71@_u"7slLD~t2XVs;[+ۮ7%oQC6`Oޱ+Xkgߞ-vZzL Rl@0?D*s7ש+*h,/wH?гѮ%}>eA}~m+&7C2j]֭eI.V{tK/N&_=\4jq"?*O,_JvYUY Rw_w0-gH#GUf4fHcLA5U==V*6/\]g_Wjf`͚5Ys5kWZݰAuCھu_ݐ.ս!q6QpD "p%yyq]ᐸǁEdk,`ꁞ5+oWנ9Q~-\!%<2$-g0:/Wjs2X-SoT,ڨ%xs%vM&?q ͡Lj11zP|>=#])kyG5 Vwo-9jLH(<RI^Haz!>.Y~!=^|_v P3U5Ko2YYo` Ri*glP͐7ނN@\IUTSY5s~@ z6M餬#/,ӯ4[^ib8֖ɚ;5e~$,㶌 יj~ +;,!mZ?|>T7U<Ԩ WːKUn>030jeO3Hئd-5}@굃=,b[jUO6 6WLߠ!qZCGyJZʦU6W֨abTo6Ҟ| w]]<]ԡwaxVUޞv^WB>=W$|odLC'TLj n&b3\K~zn4ޞf qN5m*.[ .!ē^~rȍbLKBEpt/\? ,ZLѯX@VL &~m 8.5!*\2ET?K Vъ3|\d5_gp]޵kz{!s)R˥~ɇrWjIjjTET7igFf˫XB_0Zgmu2fѴ崙[(=KK5I|bCKx/లҳ:6:}XJ(}7\qq0ڈK.1PBn{o:.Tm= |k#>#fͺk#\rq9V9/htfMk90溈$'LSCJZ =@=.EW;hZq|?rO yNl;|lҫmU@jed NW.CiB>MJ=|Jgc4{HܽW`6F* _J7пzHܫo\vg^,\[p¸kX!m?r)zH{?0O>*z'iYOgu m|%Ƿ DA=SSwb2с#܋T;cl]c to\wBXJ<(\J] 0\aS42%n=˥!w;^ #hެ`T! sN1Wﺽc+Wa4ˀ/8aܵ {C&I?пVcj;iOLh7f̔5_VRꡩZmocƤe?{.<KSYQU~KU<$.o;7m? |*A }|rU<$Ntg`M=VYƪk6HTWķ*ᐊ?y#KӊeJ( xŶv\4a>3S_)8a~1R,$xI^.8a~ -/,mop놝5\îaEnuD\ħk1=U?E п"MguӋ -Պfζz7-͓GzL{V7pC?00&8WuOG3\zZ~,lC^XHF˙C9I O>ӛ͍t~x(+PWD~OhU@B Uz,UZ{cY|p<2]͸ :@grrW#Skhcf+w #<I"XqRfLÖ$슔c*.T.\s2(61}X4 Mg\[ ]c̴+93g"܅g}wũ)Cڀv+ʼnք}кN"'>ק5bwN8.'BO3癑REbUgs# ;n 8\c=7'C:F5ͅ}^ܷgݞC}{XE$.W-0[![}LZ-5`7a%5o_ 7oZ\=Xh1OS ~`Z!blJjr!iƟN 0cW]w9w OCS-_O-/zK&&4^<`&#_^3<}S2aƏnU%Jh!p)˩+u^4zӾx鶺?)c8%G4|mnkW1wl;Cx. m^^ jۊwN~IqE|+kCCm 㶊^[.~ϗVqx+fm]g wo5pYG:aZj}`[ڰiϕ +1sGO/Lא+{. V vkRFdf2K%/0t z5)2/ K]k ~E  ^mahYh[5iLu}!=ԣ4M, P׃^M |`ocd:Kf;̿-L;4*;?k,;79[)zϸs!:opn>kvl~>$l|p{G ϰƺOzyzQqYкδFu+]wYJ.{k^U.tot~ҕ}3z bݽ|v=wR/ 0㯳Z_qMۭ{69+abxl9,{Z`hVNcVZKYNj/?sS3{:H^"3g~%Y3UIypx?((!%k2w{=ͲDơC'=mY/n+GQogig5GHvP.E=z8ocA>6q6G\}A!`0*~fnL0F25@435Y5=MG9{Fszu /GA/Ez>?47a-UAf.]-5KFX=13nUFuԶky~ #6\Pas3+djkؠ^ExO}}W:@?p|@Y?\qi9cqħ-DUg1TWķ~ͷPY4JsӺ)W'p">l]q\LB;:=/@I(uwU@U2zG^WF t zRkK{=ns^Wjuu%'.t㶊a׮Jl8,,xZ(\#Gz"Ŕh ܰw=| Ke{%R_bzFXF߀M9wq% /cp6l.L`,̅tI0= z(VF 2Bj _.^]p檟 +I.q.#1'gY N_2+m J%$K_:aReJ%$nYhdĿ'O=cLsaa8ag /)OΥdYлEɰ25bH*VkazH6Wd8^Maegf9o"Gmt#; v Mwge0R_%1L7u[1L;υi/ap>l.Ltg_.LZ-%<R.L ݢ\X1t 5L|z=wIq~.&nǰȅ>mctz`0{>0awpVv b/&1L:NI{زcE_2n ͆INRsېyMRٰ֩5x>wX`lO/Y078)-pkN0.$|TJIlrUX[$N| k$ĕ|DKls0lटz9x#')h۳$r/| r1R!,\$qe=̦I | T 9I\CVI_@\GD_St :KΩmu(6*8t ˠ#"}Viߏ}W_' ;y'{+y?>~|Nk%4F)]`M)K>•+ﴛ 1 @4Ph}p|(tǴцån| /Qvn,$b.?3.kT;7ޠ-ky4*;= E :וe+6H~{G }yZ0Vׯ1mwN8+*0ʟĽQ ;pTǁ<7C; Е?A +Q8WH \V=@6Bo`Á,̼a,?FA=W[j= c'=1oSV3wP}#%b.uL7#f3z ~~LGRW"@J:>8:WWq/.qNuUwSJ4iF\ %1,=NJSTc8[7TCysijpxˍp׭Za[<˽?#$qw%%:^/\/Z"WTI \gjzIu$%r#aGyaX.985s[y ,Bcl^*eg) oXd4{?<Ei?$Y_|3#\wdPqx8|/8Ցy1J9lQIlv G$7_TCJ>p& ,G 'sm颵ҧF|D֝AT;x9;ip\sMqIRUԑy:Wүt8$̒꜁b#ߊ8L'/}^p/S?._.Nj@RJڏd> AWxV`Sw]mꌲcy,ݧpJ!gAg /lJϳ=rX;rD&;"~쨃k97N}P$'%G[sy{덬g;;C[jCVpJ]S3LZ=\Fmp?]RG|/I:{'ծ%,Bk2t':烟zs#= vB\d=[)yáXuv+r1:\<_>{ 3Ts[?PL^W)e^j&:67onOl mn>7rwȨP.YϖrJp:V]<%\O.g^ )] &/"K8ZL%=z%F@MoaI-Q ~cBw7I] { 3s[ :T7A% .U uV*^V= 5z KZcK+Al4%sf)mL!uwԞ@ٲZ訳k\ u|$I,xTK!ۂս䧁ˁW" .E u5 Q_ d2ꫀ7{@\\zsqH-QIsqBOx_!% xl[p!Ρ8Ig\%z @5NéoY.#Ф1{!'[8'?s sqr:␸jaNok\} ¹8$>93͙8@@:G-KЉ:ƕPyJ./ςwIUڹ-X݋O~.Ip._@\TB=-8$n 𒶖!W>¹8$~K\Rx+p{ۜC=[(ѳe 7:Qg׸{  p#ڤ))irwEI?xqq{۫m8E#CkxtìgCF^MEsLGZמMW˜=j;o Yޟ\'4$s ݣeerQY/g[c,?a▍gʼn6nzaxps]1~ô<}efm7%6#7== RWx95zT_7DUd@̚y먰\>Jth=类&?Q{ö*O෡%ݢWWD5$2? ەEn%_Vu@xGJ$~^q%x>'2Mz]|+\my OUtĕX>*c8es2RpkfΎ>AyGud/]qŸ{#NMA [!?j)u@x +n?/-}lO B`ThZqy3ƂĊ"GFxW;Z.57I]ĕi}ToOjY_[zQ,hy)2SED)D}ϠV;W^j<ɜ괒~}R& .["|i7֎oLZ2JG<ЇY8r#Gw0Kg e}`Gj:3O"sfF.g ''zRFIN U㖉S=rKjn!Q[} 搨5Lj$XZvդ8\,&,Tu%'4O Wplk-$ےee%CBfX5NulZx߁1ָs4;8>ѭ}\h25mjW,#gLPϋnʜmk@˫&C>SOu<%_I'DYH3b5n Gqؖ|N*xJngV 4*͍f"&g<-$4โF0RS Ywg˘dRp$L^ 8aD|G*4Jt(ZjT6rfa5u?W.+ȅ] geQg9UJ 4,%j }R/|W 0VkjtJ\c%+Xp+.0{]u/W4ŹFp g٘6e;bg7Fu> (sv˚4'K N'R!I'TE:@ˀo0 |'ϭʢnZ.CIWy#6[H G0¯!~^p– &8axu #Cn} w'l}c'L.zS QWfѭ# HH7~$>@\Q+:C+[9A,;i*Qd1Q Ű '(Z23DwIӀ}}ׇ$D`?xd]$)a4]z|Gݴ>ǂ],/ڝĶ°nGVT [yّeaIBNbpq0/WBenneR@ݢO~q%ȗy/ՑܹPzu/R+hN^w84'C̩87o(iRv pL|R1*pgZi: t!#u.6.qiZ*ހ׀߭7 ׂudDrk.wpu9[o+oŭOmg[|IGʉ7>sU8nḄ炟?12onՉbVBN%R1-kWhsCva[3;vI̱ú5){ p xy\į `bfݺ֭7Õ7֕r9 Wޜ[o+on[o+2W[w7QjW'P}gr],> 'sjv3ŐBp yx3z{6(歱zv-e :GKc.M- ~v>~KxT ͇Iĕ_,VnZĥȃϷ*)0+Vh6-8nX&׀'t\W&laAeI6XzL :K*+{ >ߋ{bCKݓ԰Ot,p\V[wW.=V?`zu?VY `/F=EQ4Gm7Ƹwg 7e* _9XM]h/oy8#گ-( v‡JWe 5y/4g~K4_8NևIc-@>LK6#wnz9E.Kq@ىw ,G!qE4VEjXI)_{4Tkǐϲ .G{ y\M QQ?MwWן'^.8e2k4&Hb.~d֚|!w4S;eY<KXW J;}q'GAers y[D2'?}g%C_r]ȊLWo.uy]2UGd=yg=?~iJl])6tv*ɴ m ̕Pp(L°:$S U(ޤq3TR{{/$n!7׆qcpXz{7ߘ>gl"] \^;rr7YyCcFV.iu!p.{쐯swߥoM mBQek'TS):"(Zͧ41ǶU񴼩Xhch;Kk = 7S͋MèZ)%^,)I ??w]6$4#O6=Vj|pM:ϦWW# cy:"ݻх鈍 k>tD].(7Y1')z+ޞL!X2DF)]/gכ$O_~E`Hmgz(*g&5CjR~=lTQM?0ة*%~̘A{=L5z31Ѷ N5,J,冡6YJvxC\aوBqpi ~g n W&,•,:Fű^[ 5PpMMlx)H_:\zin&q7o^CMջXl|_RnJJn mQ'Enz9V[q-@\of9r7_Gvaw!;!"~=$yU~rW]o- O?.ut_ Ze0moK]\F> |\E3wm߰}b~x!cS>L2NNg2W0lF:|E/wԍR3/qԍҎ'e /~ +_EIH? kep \;3] T5ħKΏu:*"4M.FtkD4r^Vύv"< \j-APvXR.NOٱivF$ԀW+sFI7 \.dRd3F=^7>>VnٳK8,x3ɇKq)zzA m- $>h7{uqqE|+bwhzmap3m42n`~ ͑b"cq@wF[gmO2_Um澁ށ>,\&--b+q?*ۘd.<%uAځ]CJZ U-1 [B{nJk`ݺ~Vm4uSQF]n(6$O.7oʋbSH7x\z4ϯSH>a-SH#GνwB~_dk,Zɪ (-Uz%LsnJ5k_j!]_(GZHKuG$ĕPjy=ZjgolQ-N2U&⹀7׍|ƨsvky}6~N6Mӡ̚-XkD^k^ _?j'k'?܂ډ6&3RBg W=? 8kVXfTM3f@Ȫ@㮚H?BlJT H| CWQMV5Pq+쌶Ƹɻ2&Z492*)(ZEvѲE;w@ϳ:P Np҄E>zjBmc19_ 9&_ =x7o*a:^3mgt7W)ꎶt =1Sρ.zĽyp/(M:߈"q_~\CpJ3jV\ӳr̀TQg=[K sW_=ł kN ۚ"E AEb' .ZğRCJZzTY{Yhum|%G`jA[ k]0rxqք)*g+jSs]u'lCJ<.R ] hACu֭`V!=ru 1|4*%Rj{:-xJV=Bne;c1 n~K2^|_2^ x+l>15phWjWwlhd{gB'`#Ѫ&-HF!0lY^zsb<îa"NvKonɇ\qFr';"N:灟ׂT̀K aZn=vK9J=8lp/\go2j 7(w4*K.+ < .ߙE2x;x#r3Cv,Pq^*Ft(,&pϛ 7oϦ+7oi'۽^Fݢa3LR}D{mZG!7ka+O4tLgQqE|-uY'iRq*#ݚϻCZSۉp SA /J&=zwW݌e2F2ZOOhuHw'(BkH\%c17ݐ:Ym%C|pu\IN/K(${Jl?ZoN%[ey5Q/t0}6oZ`=X8j*rRbCj/s!iN 0e^u<߃?uN։S}Njޑ c>0ͣ0.E-nhz b O 4$PT-.z7u֋^>NE'm٤ɖQ vw&`@4OSmRA .EE?[3umiu2-nmL"{_vŷ؋p mGp>!m :DDWķ,4,6y͸{2(g)H½Ĉ˿* o9_@"ph?Z:?j58aڤ96i+v+1gT8ҥT_ % 9ϕ†t} _(1\>0@ed?w[l&?q4kCWvj鋆QT\bMot~ҕ}3z bݽ|v=wR/e]vg-Ǎզ=W╰GY1<rwϮ \Yߍv*' :1GO᢭~QӺ[ӛ __dzew9nk%nl;\WxS>jROhY^Pj"=7 vҫG\c0 _S03=\g/wvYmh dFF??$ HG^\iH!ڤf!av=ӋFijW݊˶\01Qs1T/YJ5O7$k'Af{hm's?uν)Ƽ2{ĝ{hhL=_{48|ϖ];{ -?$#WhšuXoTig.6A}|XmҡQ!Cg[æduőM/kIm#+얄0R͡p9-$v늝?\q2{zǷEhEot5x^UDHV[e&'$u|/V0aJЈ52@܌1J<RM(5<~ |+$cL&hO'p&h\LH3s*A#(ASMJ4PR'hJmsm+ϬODt-VgI"?#7uRaěw~FO ;$h?@\g' _~a4Rx4T#WhZ <9{.$hyϓQ h4,ΥI\E/J>&W)£9ƗK/2 :IS;\/j3R)?#-90Zt%qۤ&Nг[n»Q>=u-vm:CAnNRv  " 'V [HzeRUmї9H%H [L0UYH0x#- 1 HN l `ĭ&H* v`u[HEcˇ O'p΄?Rv p?i0G $npV?Rl;0G:- $`|qq56BsR*U$N D  \*$n5p;H>%:sf3)8>N }&qLV¹Ϥ`sI\sI|!|q19gB9H٥H`#q2b; ?la#, Gc HNiKK:m&%q 6I*lbہ 6I\_oeAQ8Ƹd] :W~,甛VXm T7ݳ}̓"}R6hiwh9bQU1 K]>v;'Ea;>~<2W/&y޹25ԝwLRwByq+y2mNsF,L#^VlRrqRtYoy-;Aa~HJao;\ ('_%jJT #Ki:CUoj=tkBJr,SbS Ep,coq"CQdMاv Nak*E=r[yS*t!끆)kt!=]t+FRe4ks{HÂ* 6N ^ |ƒb{LI r!񯩡C1b_+8a}<$u5xV _<5$T._"UL.ٝU$px?ɇ*@qH\AU$ĕ|@x4BՂ'l":ISڙ=ǒh299&uuOJ\4EE_2u%ڟe!i1^˶\Qٳ[fo-:N"q֕7 zugk8c̎F`<5QVx.5p˶'p=#eM]))nژ ߂u0e Cd+a? L'Te1v WA1$\$xJjĤ&nFRNJ%кL =GO/TRC]XwXwJ0 bh+xUfvא2!&avxDpٻeUjx2VWJ'2M-vN|-w#Uu1'eTûr3Ȋ7:6#0}i)1L"N.827軼Ax xZz1POomw0vb_"8aܝv@&݉A_ZCJc(F8ʴX3ʞzcƘ7Ek"Fb|ԠCѪJz>_kQ.^'f28hʲ\%lE.T.4@܋\(yeS6.DT߫>Mf6 ?}> hd,2k[.= WkF U#$ĕ|5Z6fSv*Y'0mĹY̴%g*qrS]";@\x-Y :cFgW•+UPX鎤XF񪫤$*SCݴUe*՗`ڪZ{(K?m5^MsGiWɛF5Auo'qFIJ_E_?߭d]#lg \ TY{Zw&*%1s~>0ex۳O` Y': ]6聏rpAX@x<^A :uv=P~{hbpЪ(ƑA#qR5Z#;+^'16r]Эk#m(|YKkw#17H\pc[u{Ֆ9cp'ߕ|#WWq"Q8ƸpVH \Ҧz0G*%atS9?$0G.^ ~ia7UwoY#=6/j s$\*F s$~Wq%Dqc:W2Q;l Ν9ES 3n5GvGw1ǯa]0=j|1׬BX_)Z$4|˖JVgkokqĽSKR/mX5#f'h!'iķ-eFl^ؚ$}SF& 5XǙ.:'Tdwʔ7Z%q),0RKOI} PEIEI NEP%N%9 x,W"'L"g'lE/x*ڀg9 eAj 0IFp–cu*+${wHYR& 4R'lE N"]'L"w .gatPUz|I'8a6x- Nl(eXvWWc6cE]BN6'lƨ=ƴg 7 fްr؉iL1P0V7"n)K q$^2#(_ a :O_ 1= |ȥGh|*^t4;K{ .ϲ:V6pPݨֲmbce+G?6'ct>Ox)'],xJ*Lz t֒4< ƣW .7Xʔ0kT2S L `~^L>Q[z6*,w *%_RÂ%w<%W'][:xޣU%tpFoSpBeE6{韦ơz#'OUTi '0O\ڜ=]*Y̅τk'EBZ~Yp¤[$$+5[$21%0Ec= \Ҧz KĹ,qqN&uZ#i%V$Ȧ<xm-q"-g†V ^{VEpKxh͋$tB+:7R|%+$Uĕ| &'ad=;P'07SоsꆐvZX.Mfz,co&14{?X5}pifG?=օ&L/p]ȼVE}*>*0uqnQ7Mп[Ec~$\'pY[p5rM1y1B+,3ˑhɝߡe`#ZF+̼18mLt+mi&JvpuCM2Q: 4J h$Nw&H+vpgjZ'.i `j9=^M1b^B<7p2o۹&$~Eq)zY> +W #."szTu+鷲Qq$"N_稳d.._.뎏j@RJڏvd>*)ՁV?M&šEhOM:_ozn,/Qi҂K2qcœf~37j )=j7?3Y*FqV?^=.-VJE"cchqS49m 2XdOLFUf4W3uv'wW!0%0%F*H3OKH \Ye|X3"2}6 UrLʐ 8a0!ϬkDZ)aQTQc&a_$8aDsݘ`nc8b׽B]4m{~X/^G(-8";[65'8aDC/ ˫;'`WRANOP,$q' N{$8aDxum]4yt iqן[w׶r+L6 ے7s2&ݠB8x4?'4XlojFx69J5*T" m]ˍڮaMYǒa ɏFt+edb%Yt2!JCρn [/D>Y- C<V'9 ]\%|-n ᄑ[J]4VAW+icyĕ{}lOQ}iqSwќd M_̑jARJڑ|TH[ԋ#3b fhQ,vMZ-OZ'AO]y ?OJg؉٫ՍDvŭ[MRxϿϚ7i~LB[KL-C_jFIiRzO)HI,x)Fh|uOP؎"xJ?bm(2{ݡRFŋk>6[)1~a CN6N%;*Ã඲<_b ǟ⓸2 Ɵ )a #L~x}ɘG6I똪2;'| 6L$|5ThIKWdcVFx! 'Y$wM3n~h-˻e ?Z}On4YO/ʬȷ-e Gp :B*QCy$05_pBU0} c@0ZOi4_؟t8x)淪]złhK4t%PNix Z=Dv+:1>DQծsƞfZc=~Rq;9= $KP. ,SŸ NSO\S`VwS?>UpBE\+>$9)u_p,> 8 8aDn`Ř.ҊL(r|)-~Q^NRNt/f!:m Ѐp!Be~\d /??"qG>v^T,(l5(3| HaHܵ,x6 ,"¤1 TJ4ͭm:i zR}%b؍5&1,.7AMwJ_܄|ՒW31մ5,~ NEw[ĥfa"iiIbGڐp%bkP |3k{Jްw4 ΄-v,gQnnMEQ|m /z3QnVZcn1`Yⵒn0|ňpxsn-(FH݂btKk-(F>U.RݒlE**R:gondIEj0|NjWzZȍzY¾4Tv)Qd˘r+-c;Y+RT)=d'XAz.]9~p?, Z5.mmˢ- ݞ-.V]`=9mY^bEQ#Ȗ͊c9zk^9Q)|a=ΙokQˡZSr(o֖ʛ1Ux[6.y96+J o+yFl: ]frphQ'уBE%-ҕoMIˣt[[(]>TҮQɖ4tpծ5_Ŏ0m.N#O3O*V5 44RC~K  Hk  Hk  j ڒ`exU&Y+j#(^g4;?^BOX<~En%m4j+u!/mu֑| (W$~aq%wMsi|~ SV>Nֺspf$aA$5 GyF 9'{5:&i{\iLWGUyEmF4'xש~m5^ Z69^͟ ,A{H+ܼdFัzK'LB. #Zh@hL]IKm:e<]8!nɶ/0ۺWNͶmwmus^ol'ӟ)=rճfζHv =%[lguJtkq[=Va֜WLq۶-\;hçTt4 %u`%| +/oh[MKmBq{Z>:E}:'կ'{Ra7 >5ː.ʲ=QMfȃt/-1?g2?8+lΒ7iĒSEMe;#z;tv@D*.yەe 0ŗb7Bs../BsKj[W0B'U.[m^~yd{ߠ : Eu˱9X)Yݬ6T5~3&zWZ63lkJ#"Gwx묁#mK؁u-{vmش? |3Ow=-wMgoSſ%[d6w:pej- w7z3nٳ1NK%/QzLCgoK᎞eۃ&U?jw7=XXX.rٱ, Է,]r̃ZkV>6N<%?x)(_/i/]Ή(-FFAzFAY=f ʍU/aPQj-' E4L[+$\'8܈PFq51RJW5*GKi#:CTo7j/6][ZpZbkDG(R;5vw!-5|]٨5J | t ѩS_'8aD[/)wLW] NbU7 cw-8avy  #%-U | -2(c?"8a[G'hH?-8B_0 <@KnZ$tW8&ѤrFc~QI-ڕq L_/xzenr[V%ӥD<$}C"oôgql`Gpz\=30^AYwGӝ/)~e/GoI6I meznB- tJ=#n N[nF+ .Ѭ.q N1t,NKMޒnYӫ]O ?sB-9A] #:| 'L/R0_N@S_-xJnzM=UmU N>-8aDjQVv<g3|g#gI-̜Mى@+S^.8"W8I`z]we72 p~ 67yrUdGi(c,OuNI1 n+qz@4Ny5N-! m(rI肻Wz^dKK*TR3U'"wdL&+r(R(3IkHc%c/Qd_w5O~L` aH8,$#_b2&|%/E61Q.#u GnB ?2mGƆ7ޏ!v˺F7wsJ NF4r\Ό miK. ~[@fnZf-tOO|Ig 穢 =+sEn"x?[{I1]I p}lOxE4}֝^xʕ%V\j &O.vw͎F&v ,wJ_MD%eԁٰa#S6`:?ЭM`1lphY䮿w|]Aq`֤Q=Tm4_->8kZy3W;3Id.1,(8a +M< |Tp¸1 #ʹ PAg O:jEpBEi |1Kj ~{Jw'I<EY;\o;Gkd}k,$ {ARy67xΦkV!?o =,ݑR/x5HIYQF>8B/pQ} 5L \Vad5:~+B"M:%xZ>OiTq9-8ᜈs#FX\nhnFװ1XfGVxV#1i5x}j#4ke6mOH>GЕNDC f(6 h@Gpˆ=6P] (d'7Yl} ] thč%eQ1,ן3'gҟvW'uN%GV5ߥkBt+%Gw NK0bY6u /yڟ|Lp橛8FYB'Pt!q/^p$Xo0wʤX⊩֮;Q^b!wx XT8+׍=-=vt ْ6E}$'q.4:N (~JjԨnUF[Z6bڼ95^æHE1;Q*{6җhQǽBbp_A)S\ے*뀷 qNX=.DF;=«BWuqFު8'u-ߞ #F%6}A?˭ qN'D aSJæ:{6|)f|Rgj2,lZ}բZXyŢ6:Q?\cOقa?زI!045[8 `&O28ᇢDӉ'l=cIO:>?G9* IJڕj>qŤmZLh˝lx 5"g~x-|ߌg년\dhPкRi[#5hE2tz/?R2LNWˋH|*?A9m6u 1暤_]'p]͆=l:/82k0EHį FiWųKikp.zˍ'is|ߣV :as6;2l[ݫmY,V hRom`8Tx!s_߄,kЉ.Ǖ0(UlYRs&R:-LtI(ѽǖ]~WThN+.-l@v kMx}== QmIjW.3DX5n֨XmG:i.epi^m+ma8%16U!|ye%p<`ņ&Ö'8"7L? lz)dx6J|x5nݺ̛xötK]n2gտc߮o{oT8bV.}=⯸_n1 V#+'KbX=DN`X?aO.R$+ā̆Vr'k .|[5XɰG 0nzZ6R7>i&Ћ(6?qDpBEŦ Qc QUq͘\)vL7zH{ QJi|%sOkZ41L'O !w2]=9ZD]=?jdn{ca1clXͨf̡j+,cUx,LY1J/ DB\5WDzaN{3`+ï wQ'8h><{+WeS#pħEAx ˒ylt}lOGeQP^Եl 9j/˨]՜Jګ}TU\n*6SOCg ٬AC^:VݦnqheY*dFZu.\D@q}q+H'?)x8ej4;NJcFުR;.^MԹeTX 2 [uA!%kł8hz)f>Y8:khON@|l1E*5G,* jtned8y W;5,ju]q{ʁ&S*ե>/xJcU$,[ΉڄVJj5j4ުrL}FB8÷4QbڼFQoOO5yŲ=/]G7&5DZ 'L|[֥&D-oa7u3ǖ !Q}i7;Nѳ7 Q/}g-]mjBRcEq%Ih>Uk@dC] &'l0RG.*U㋾ϹJ2>G] Ga`H|od.Ӻ5ܨ+.>WbWs9Ѣ.{Ol 2]v\3[Nwx\y=ϋG4 88 0E~" (cMKOu%c,ANRo>҆^KYYZ>E6,L*ӑȾp}UC+fL@o\(0vh`VWfyP,k?,BOƮ,Ȗ>[/SmҍcEm@»yPZv|{ޔ:GwY7S]tv'@;l~0?6kJ.8¿$<_c_QvMhgf Ʋ́Ir+ ߪ/iW#L|&ڦZ՘[S<[Fz[c) 75S:yڊOxhh{Wl^Ye'71m/݂pϰk+3ڰn)tNxgvu\73+&(ur}r\3\C7I[Q:RH#/QuPe} EE5дO 5kgjT jU-(ACM|2?27_*#]LDv,U5Xo[AܶBsix!gzn)N70B[";\}~WXLC[io?g6-*5s<}2rG L-=PVIv&UUC!Ctfe NBM,|{آXЗ!\svWa?[1n'2Jh|@gyW"ShcAf ͪ`̦ MZNI-{Qq]|S4*<;|+7+;F|aGG'&X`5b4 5%V#[XKaf3j'"uzHQ^+[6Nm:Iټy"GQćb۱A"<žw- \EV"F{h[)sDX]dgPfUM- XNK&Y_C'e<|p,i2wy=Ubccx{,#D-2J mrյҌA]IUxwfe >BM,&=f f˟nj4,f.`|J@A}'#F&+l'efh6c:TO5=׊E4b|ݠk7D{ob>x}\V"FsyBcu 3߬ 6q(QTϙnY&k'"Þo'Ͳǿ kc%b4`k\)kDX]dgRfM- X?j^+_LIRX,P&QSoszz,fݠtr=gGSր7zSg1{Ύ|j3\o4gm6\%tj3~DD0'Ӕ;̮ƞdr+lapL{`Ua7jT֫5gm>G<Şo$pXn|3r|E{X{x'$ |nN1ˬSV CK&0ZtI-&$4[ۯU߾Ic^fۯ;J*O2+#pƕ,XEaR̞Q/c8{^}ܥՕ4;B%yMkde.s?Le.s?]"uKK9Xuŵ?ȍ XBxq_n,=3Y&%ھMT$Z,0Ǟ9?Þ%m4hsHI_K>uzk䂅Ν 5Q [s6mk9Y`ě9l6fPJDCs u{&p^TCWO!8Z!r2ݛ\>9|QwC__z7Zd^;;ZfG@E ̂Nonօ"8ڌne& QXBoq.1)olڰZGAogx5Ԋ0gv,:$!A/Oޮ>ēJjXU:Mkp>ڭVAw 8t?4ٯa$]BJL 7y&}>ēB%'VupTrԘ0-.ͼӒjLDMWi6^t9J 57^pY73,XX-.4~-K t$$>ēXxv%D\z25g# U[ekz4~IWMEXZjD8e-p+;‡xWŮհ~xZ.'AKV\e aӔ~(*{j4&T?\÷1mJz1xx$ߏJ~h6%/I^ˉVI^f?Ϫ^ G'I-,.7 U5qgV[_CO?7$]+5As$>ģmEV9ߒi]w)k~͛;d`t> ,.D7a7|'nw@f@%$^'c|5< "gϧF;OOH@_ҿNx5諓Wzb,I^?ҷk(R}+Ղi޾JkI〫@_*:y&k|'y~Pj]kժZ蜘y+?& ekCnAK4o!5ahjzIBy>T5}ךWl']N a8mNx+vbӇxGĪ+7K5~brĝ^xKbr~p3h (6Rӡє_C<+PGcU+7%<tNn9 l}n:(p hC5t/!uǪé+K5P46{pukф(y&Ohb+%mT"g2s YEfY37Z4jԩOn#tz,'Oҍ%ˎiU$D  #">sxؔǦn:%>ē|l cMMIy#(6%qnMI*6% ޤTAVTPbS-2clͪƱi\MթObS,GXlJ"mU) 66o&.<ۀ Ʀn)æŦonހ0tWؔlZl MR⸄t A/om*f^/iL~\c#zmY*\C*ɉg:NU'|6g'I^?3nQ<[ByE)ݤأF"mz|ſaK"^v wٓ"En@; 8 ZonTpH݀؛>ē|7xx`Ȭdi+!ēoz'+XW^(e-EW$ޟ$x5jzح> t۹Y70?lGb@ջ|(t*ʳofXw@ f%DTΫripP$BZkn$o>ēfX5{kdePw1GD* $ry'T\I^U~Wj=K)7Jc$=TӆSwA ׂr_C<+W˲n(cQlEK_ %̀$>C<{U=P`ALU=Ps=$*I^埀?WT |<5"YjDsU MSBʧFj{݄G$.x/4>lڥf/V-}mZT_͵DwnZV4t߶}xp9DŽ+@G-N>ēN? =~2VnABy>T#t/xr>II8ᕠL^߉.I^ߟ?-!%ln,bC #ZjHQA)(@lGIA_/+o-uL!JK&h3¯҆V|WVtݿ=EE m5Vu4|a+vZ*θp~'c!2ioid4@*uYIi@MeNI;@!=ߓYRs (ohׁȚ{G6m@RWVR-Qq.V |->ߺc%E I'͡|RE5mg PuL[vF~C&LW4>z;aA&gZo>"hˆ}YYz h3mYp {=ĿWa2t:Πi2@cЙF}Ϲl_vnV袷$|<;.U]QkMS%cE /^& MD7[_Z~B:$hB5-UHЄ tu 0bw{vVÕI Cԛu|vi=(M/ۤ`R?40GH.!_ Mj>4|?8_H&T ~:%h$:Ov #vT6]Є=5T34m' InL@QHJSˢ]ҽ\D.I~VR۵~*.лĮӉ $v٠LDGKF] %ڠmeںxd8ښQC5h :i6: =1F+b,!'dT~W2"yъmπL2J&gAy&s/rmZ_wɨ~.p}L_='҄W࿁^C5v,܀iک. 1$ֹ4hVĞ |"lg+ Й;1 ̂Fi@bPX/SxW}M2 &!;@Pd\ύs20Aw.ӁjzŠf~Ojko}2dvPּ}g8̃ mSlidiZB/Fši )MԪ&'i[4jۏ2|ntlMhN\+VdSA&ЉZ^"uLowPGvtihFƶ>wֿH3T7 Ud1$=ZBYWML C)AJmko~UЄIt7&hˆbǔ~02}8t:+fɊug Pqh5>@+Ro՟ĕ P§W :%/§4a!ky'xSM 5T3tHӴvԶi%j^d٥PhaVƽC BRw<`2А./(4!R[_uzFB|!$_ =J }G@Kme g8ݍGA?.gD1;tY2|]=L{L? 9'b҄Z^qٱGџ>Y aK| KIORC5tqV4bA6Z, P>]&7'rmۄm~1 .TFGopNؐ,[%Rk. `twd=>&$eِX7Y. !MV7g4?3_H,1"i ڳn)1{| 85qi,cPUn%d{5BTK,/=/b]TV {$TFP>Y^^UE !!r7}8)UK[GN{2U}#-^$?5hT--?+VE].~Gn k& 2{LQ?G('?SdEdA2K#7ܝ֮(;l4"8!uVRvUH,=SG}Ͽ lۅz)\ֶ(j}֪dk==RKlj|&=gGj2!$`jYda/WnKAWVf/IIkP_1 olc@V#5b oKyC@Z Qe[fķJe[=MQgZlQ3;y啞#n+,afoŢL/mS fQ$$m3{=LOF?{~ʞQ~O=RI=  R)q;p,'cW]t *oUq\5,p-0Q)fY2=5d5żCp2~,!RQ*:DJž)z.yFIܺKDֻ;hH)=֢8@nu+ §sMHT<|h(G`ܡsz/osz]o\{7"?3{Ϟ߄-q7J\&\BeുEe4q M;T=Wo޵!N81694Mͪ smшUA*ݍmMnN%m)0͞ss^RLHz7I s*M!R(ڎf[D&jyVp1JE2CvDSuoEޢ8ư mgQrIYns{do=&ȞwBLi8>YҝaӢ}؎!Ne#f1t gOKDkQ4@wmȱKQmIAfE>#[ l b#xdTqsl3룏hȴ &QF4`.Z Cj~#=ZutkD~SϬ%! LaOJe!y81Ix9nw'/ъ[ZdC$=zcRq 2TO}{2K(̟~w@vR# pKY!ļ0Jk$Rs¸kF[;MXS#r^4a>$/5&T<:A&|kE&//Xt@ҕk209:' уǵU2F3Лaw1D_ [ @pL6 KA*Ҕʪ] ҕJЄuL3N: kY&Tlژj, ALS' 0 S3(݊S K x2pD);ߦׯ!ג t*SN%'ؙqAFԯn>]DNh vCD0K :%765\l |JЄI :%}o]8y&;)L AMQUCu6fZZ" L-84F6ͯUfڶy^|d 5G ˷1VB{~ ҂~.x~10tԔo:RGYbw#AF%~8y%h\AyZAVX-_xK@/Q޽gђdA_L>X$Y{kAɿHߘ>M7c^'@oRy{TB^{RSWRM^1ox=Q@$5A畫霢=/!aୠoMFQ %U <Zzy7dT|>7IU_|!*WչcԔ%>d~OfIu}!)S;~<u}$u}߮\]_QBO? h~&~ ПP~Qw?MR/}j% ? tBoVoGʔڿ^II_[NI+V4 '0 U]_Zrb~aL7/4aJk]$hˆJ+dxA*V1Ȩ*`ڸsB?DW%&Tg :;TEV{'l4^ЭbQ >Ftypb!Ө.vX+k4M{m%9mږv_&%w\n,>-X_FCFZ&t&}:AgRΟH2s 8謶Q9w4>/i:SPߧtǨmFelvog6wf?Y6Dh" 0G8TQ1=%}vt/ӥEX7o;B/32RJkw[݊T]1Uݪ^,SQfjtn՝QX4ZϚU..3,ˡo^Ke׶'+چq` b%_q"Q\70^$ ">AYbݹusW|hPwFp0?[Æw Ujm?AJ%)lk@VJ4QR':J175ro %6kN)ӅTG0 nUOi.4Y`Iq:t mZiiG-cmbFE†+;fq+* zMQˉ_\C5~w2&,/ FbALpO+"sF$.sP(atA]Lc Ix:̸ӓ4l􋔵S?کhΊ^͚Y韬/H5.C<*ˁ_-2|%ryN^/vn(kE̴TY telaH9K U*slCE9}PYՠMЄ Ak]Є`։Ahi=E5f5o`!4ZAR@ЄGpDzA&ў/+V,jh&BЄI_M^C5Auu^qݿSF}G_G4 ءӈPqDim5~n/FV/8^tUGϏ#Q+A?̼UH7X2mqR''蚲+J 0h6)z~Ĵs vuhd{].ۻB>%j~#ڲڞi'x W"hɁ!$I] :%e ÷6M_%_"h¤g!jfDˬŢgMG 6afe?gDme[tirC4H$+x'B)mnjQI7Gh!|7IUАoH O'eO-P|F\V( FkxNZ>MmGD0K[/^"e=ox<opFQ&&-Q#~da'8+#zq < JAgvy4˶2SgхtGMb",c3 T ^ج8NX|ᓽƾ?NLY xZTfA:xL Ew HHydq,u1].e'۩כٶ.xקm)A*gLyS2-ɨD<x j]pM?=7 V*Ve:/0C% /4i kQSv%h$2M6hl,[T`n_h8Ջc;_&'8G3(TJF3*H,T|'I&xX/aZD5%x_ٳfMw⟌qd⊃俘*tzDq ǭs1&\WQȐmx͋sT|fǴsw9(~iG*zer+8+ ҋY/1KlHH7א 9M~~ bxf}sY0g.%6,u-E U߆hwq4 I+|_!#xa21jQ]3rfNA~—B޷Z.>q[ݗgBs4{ڸoeNclZ4`c(eI/$je4B,.62YENT ZnD~~tB$^A}n틬iWr AH>hqVL_(NlD ɳX߅@RsaYzczMV7Q, $fURDNI7LҸ?ASM:B%txdjMo< [h6[?)`0iU̢pP^:>wp6emZP73Q[Lf*΢_꡶w06_+.g=_ɥuo+ ~_MOlC|}BW\o:;n& ftkkBNSC562>P횼r]T.c+VErq.}4-nҀ'C)ඞ$>_q4I;})#x121odzLP`-2xoV4uѯ:v9<1̧qZaVipu nf0Z !KƵ62^K<͵X &b)2Rx_^(h£kZ^.;dyMm2+1jPECw+||45ž^gK}yqmvf},n`Ѽ;|C \X2yҖ4f'k#f*4u :Z \"TM2>CW#WXQb3Lُf_?=w?g%[D,a).jy#G8696+k+wr$sSCUM[juw1jl0iPͼicZ~6qJe BE8^K'ֆ-?;@G_]?kTmڐ @I!'E8I^~zi ͊Q `? 8pHZ8ued%LA5I@KmhOb.zԋ4b%o v˶U!ygLBxl`$]6a>ڦ9P`xO#t4C޻. F6p]Nk5nL5}͋_q4h998=]oȫͪ{,|uk.߫`g>J4*KPж( P'X!0!A&oXrLOfXW'mg0?;&kϠ~A޼Ԍ)xOM2GR&)erR(LM]3:Ԕ:jkI-v|a>)3( liز2ÉKU%V ~ '@h1͟ I՘f%b`4kLs5l:iVO֓%kPaUzl;1sf q od!#ÇRb(列Sngk|)T^.?ު;*M1r}]H%*o} لT1#\ I>M\ {'&U]o8VFg`_Pfႉ9|!6 = B`j \&‰,Qxj HX8**->UgpJkś~8Fq&M0%kܢyIJ/iT|33}M b;IYI*KO; n0itҾ+K|N? y4aA!WMӗ&#Yno:9a]ڗIAFX)$`8HN@31S 0 t_D ݘE?AO*HEgObu5Qh繒gܼ^[wdC>Zb9ϳ;DvQX0̝xBȲ %=)i[EfH%d bR>\@2[bwx;%'N,/э_&]c/36X_ 6o+W\H ~5_'[?oѭ uٓ$?Zf4# фIUЭѽO$N HЄGԬLdž-4ZO4aM *Ae"4zh M6B7vC/5 h Â&hX m7tMx`7/hd83j 0jY[IU/݀dHEwp| ] 0 ]y>AK< #ʊz2(/"ܧ<5@-POYЄlffne,h$Zw4aV)6u:S&{jʻpG̷jn2[܉DDxCUw͌Oh|<[h 5_Є|ɴ6K.,u9K | LAsT cz?X2As%N`Zг*а;ؗn#2Aϒ3éj/4G5\гԥ VY3mMYމ\~}]Fds$#YQV3IN F<%~AsT#h !གMϣcvKfPc4`;ciiÎ^'Z9ѧ1g_樸l >x  $ #hBEo1`Pu9RIHa Pu+?bO A&+K |.KЄj4u3&L@Sg#'h&ʳW P]&LFQeƢ=[싀M"GгDV]IKP,E m[N/d6\ }M&TbD$D$+&LB#c&T o~MЄ)q:+艌IYL}pmusN4au<T,9x h9'O"C&8ؚay~~e ÷qs4QmͥC{M[$^-hpŠ7NE}eO[hة qCR&Yc)6L)fRfM[r&:%zz=N:K \"'\!74#&!.ࣂ&L)# ziYY48m+>o$ӊo~7#b;[Ÿ'!=;B $ӿGpmN? Q ZjBeB~)̮ф]\ WlZ1H@WjK|qS]llL hؚtk^1EJNZJ[ @KЭVƿ/W^Q3EsQ4Gl%.G$+(Xhb G'ZmGMy fe4amQM_~CЭR޸Q]Ua ho"hˆ ^Ot%;#]-ر튝{n۱w۞>cM\&hpL4?)Gr7vS#7]ZjkMRWD[PQS/ں- hZ,#Χu. yD3iONsNЄra#nd۶RQ꽂NL^:M;>|SR''T5W+6erZc_d>LU{wM˸k[*.&T<D;RЄI "}:pۤ~IUK+\-6-O kf$j{ Ai3ʗAI3YmW#h$i'&N& 'fmŵ\Ҡ@:/C){qU6l]mRKC 8UN,+:3A& \mr[eY;I_'6ɯmSk FW66vJ5:FЄI4vg͋T3G~ojgQ,{D t/VQ+t<"b>JAϊ5*"oP"Y>MӮ7zM'_-%z|Xw<MZ ˠw3.h} TkU\UFy-w./[\Ȕ~&30bLw .*d2-&6̏p*:#kRWOEw!Ɣ6 cqz"VMW8G$ģPQm%0WJΘaOrwgDz%~PЄʚwfnY> #6Z=9S̡p;"ߕ2 k29ܟjt*֑wBjf[^O1-BK4$OoN =/MR )hKPi9$o_̈́Ibf hO;r ݵ-}8¨:׏HhnFmyW؀UíԩoL(ќ[Zٰ5Ut G9tӴH a7N6G'dOdsh]os,sDj5 ˜)\7R4ԩߒ[|ȮT\w͈.g#mo1ewmPVmTw~zoy$_4h#FLֿ$5n5&1_}~MЄʂ$:Ҁ?[J: )4sCIю!r zeu}WF~2W'Dx hѱKFEgla|%k;Bjrün \ZDD i>ģjgR)kƲ!*Rkׂ6yC!eVVFl'PCKSM/O0]Tqlq>Vnfw7FdV[.VZ۔eJkm6/ 'ma?.6EbLkdYg͚GsXb2,H`cء+!~*>@2[zq5Yu ʬɻk4S(`2$d|!~+ XKn } 5Qg:mצ.mj{ ZK(7ΏB姷jkvAojNB> ȡ;? +6y2ĝ̓3  i/wdS@Z'X;2$o[TƎWBRL-|Z nGF$FdG5LfEr~G)QԕMg#Gֳj5˗&zyϚa]I{ 0ǞvdweĮ :ѝ!u5K^ ^C5̕m#xVFl\byWgJcan[Jszvd#&ʆcĒZȂ7 CԽ} ļ Fr=-/!v{r[w#R8ISZڠmn\O&ӻF˔7I]8Vur=+C{׃ʎ{o6$-vq gY-~DplMvp_z%%ChZtPcY/w2^ZnopFh{r^ Z~8'B. N%%eԺJBC*!}CVb>dj4 |>+kt9ݹ52WdaM.|e&p@PH-5ΡTؿ߇xDPC;~[ŧrG5q&`jj-Z.aL>- 63gavtg< z4]2_C_/A)̧~/zؽ:ЯSxzes<s`$̃mAg_6dX-2됸OZI8ChЇx㯢k 1Uw \egψ]*WlĤؚ|o繷· Np;g-4+W {  0n'D> gA&m=I1KrB|krZۖծ|Gr;7k u6AؠLOG=̽dž*s3 .^'h]+h] PX'!4aܮ  ZnHիXB PQۜpӷ;ɭɮf!}{ 1A˅E|;|\ЄIob:zObM"ȇ靼,CZNH۩L>6yK}MFBn&i.NA&4]&T4zB3r\|9 b\ADO]&Ìp)2fOВ.zZfꕹUr&}HA| n?>A&muŘ+ZCE>cdA[̮(A)1sKXqH^)h¸} KВYmniLcNkׯQ2NJ6o7d>0z5OidieJQ]ވ96NSAh/4؃Ubz7UrASG%ތJY]^. n61:-g:iy#M-I˟w akV(luTz &T<ڴ)4r} ㎾?4a&ޓNJP9<Mf}25QHFc\8Lx>vMFAI86ڎ!%) $GGY qi8qV[O U,j_M7S4^X(7˽HFsϡ>>"پD4}sTO /!TaMJ y~5WEUKXٻ(}syM ߡ$1jyOȆ \Cjm(\dCRNQQ>鐂wS3KsZ0*٥G\6a1+#%M݅?=zvTzq{%yt'A+͖zKl ] C&r fA-is=a[-wbb{xoTy >A*j=+W tŇ4aN= dDu8Q 7p^7Mʎ={y`z/A'k5 )xgr_*숆!vw;VӘfLfEC]$}Zr4ܚ'Hw,h { A&mW=I+J=Tgv0?SR>]v5iuؒ[uQX5n1[<]2@v(|ޥfwkC1*;a/>_| 2 M!w_.hIoˬ{ x55&W4ad/Wl(x^&An662+s9ͭ^G\ IvM!vo~]r#h6ޓP]z`XUwx's"Ϟ^?rME))Ҷ[˴AAN-%MWEb:7lWhv:Víʺr81Š7hն,Qޡ(gHہ4aܾ #*P?SVFE)rV륋MzV>F77k[*s|.l ? A&π +^ͺn`nlk_&X a\TSSN)Hy&Fx5vfd0DtdWUAKޡx:pumyn4a$hɛ.f ms3NA+~we؎A p g:6gPC1%أйK슡V}_/g[BP\B5e ]ѝ7bZ: [FJN#hCN |%'lr< |DЄq;bwQA*QXM[@WKd$a^| ͒guOKwf ю p;$?ܞpnؽCA7GuDk{dngnjlbaVz裚QRJZPCz'h;opL6JȿJ ݔmAC-ʷ{x0mamȄOg?~@<|JВ|5<`ӽ/۳ft l쁐~(Vz$E Βv_=I!CE~C0Cَ. ͌APX0()) /_"97y:;GM{1 zWJ00n2:Yevqcq!腑[C["Y~EDY|&g*k>-q[{61nFln%yB/!X*ZCEN5Ȳ(ch0 +?>1?  xIHhSQ讲 &T.pYz1e>|+8 b"hJ %o ih$'!ϻ4aؽ%G3Oz(knV`Lբ|F?E%jU.#ECCw#(툲^m:v-|_A>4Ii_.hg| 34aDxFZZɛzZ];I; ZrݤQlXvl+n6o`q2*ly]ыݵ{GZK{K\Vjo\ idOЄqDbz_M-:_|$)FF$<$jCH2dvtH4NW|ܶO=Q6fHxSr5LZ<%;E\.٧s%.&n+ݲ<6WWMl1qaB{HU@WRfsխ:|@rZt}%+dբ$!T3|e(=4HJB^E]Bl\rͪLfUO$[T'DaiEL$滁_o)Q B F}'߬#'/FVb !%d^D; T M@]@fQ =G $rAF֥cH) `?* SXPۍ.!FYϞmz$vt.Ncυ-*+h{tx^]w>v+àP4SN(th™rN-vhHiы"k㑖V4؆^vQ:߻GŘ ھy(d9GGET@?i;IE%7f"Wwۚ9f"[k7F38"7pQ S5fIs*UQظL[rSJOFLoUP$ZxB m:VuaײH gt{&bw>pw ߧֺ# +ģ;";974 T4T ]>UGyQ_D66 )H/ '7s-Hv$J[4lOFHYy\,h.?x#\sI#FŖn)0#hN0+h inA6E'rA̬͌RIBu͂nQX "h$tx[｟%j~+p[⪧=F%d{p Њ=MVn#kŹ|8n]b xjaCpA*aE(kij(JSuV8wmbФ:zOjx9hy}Zݯ9.m1ܲmH\T.qCdp#xc(Œf}dn1;v`F쯔m7 22Z^g懻Bj% %jhj rR{!5aFvWijQZ&iTt3,W+˷#&r6Q(Z Lo6o֡./UҫJZsmͶ(mXЊ>JGKDQ֠(PMq3uNO,Vx^ Y qEn*)z_9.PWGSo\ CҺ}! Gx5 w ݦFަ[*I3"U7Ǟu̠ЅG^8dJ5eRV(6u k/> ]u( %(MUeғsop*^ aN,ia"n_Kx1$$D} zȱ^Ay EhgTzj}Sj!ǸJ{z#v?ӋI#ڂ0#40qmP<-VQ3cStbBv*ՂȗRzwi(!sQA +۟4+E.j !uwCEC 7q/W6Тo!z-֙ k7iٵyGiK!3!6M3Gl eJ}Ep;/Y~B~9d'ȼeQȔ4llەwwIzQ+TKq6s.heX\ZnLLp4 `Yd,|5kk-п W/)^EaEB+NagEp݊AɪE W+Q+!|G9v)툗RGv;it#eB(-|"sG87B%d>˼ھh@k]=( A*|cpDnQ13tv)bPB#䲉3欼Qxe2yKb%h`R]GE$= ] LpHIj|lҗW1@B@g bѻ3 lG>_D8FX}ta2.9x4 0n%> 0BkXuȧΙ,(DGt}Ȣ>>X%/9j=;֨T؟0١wGnAl]YCYZ'L\Y+UO dw3]Cގ\շ2KuZg}i34:"{0F!|}('!hP 6x'CAO,,Gb7C΂("o'~W CCU؛Eں39\0IݴV4|Y]t;}7'7 ?0P.B F #W=xGWW~/tv! C6 Can'Y::82_?6"'/yzmPcވ|TwX;;Kii4We0:]ˍ0?XSV4b}, ].2vsQ +[bVxr\RLP&Bo&Un[LBϦ ϖ׵ ƙFt8 ܏BƧ+#z k4Rv N 3ǐ'~i-&%):Opr[P]POO ˂yf2(!vF,F)C 3G0n07&r TJT_(]rt!(L(!|ݎA1u7񴝔rf|\w|^|hޠzE!Tx)'Sbc /bwM,8TnV"H! hfbW4wW;%QЪtO)L,k66bD-f0EfR2VS"5.!; #e-% $EtXDO GhTh CBBueOҊX7QqVÚt<7CJ³ Y 9V|D/xV+2="H/hBE2w`1>f;. xxob]ƛ{*`[] k}+"z8|"F#9.ku\])wuѽkj =+V*{twtd*f[V6*O{VԤ -Kx,cMUx͞bڳ%Z|8oD>mDzU%xont¤WWtcEQQ9?tFSԹY4yfw=k_&cc8>#!:&3xhiu΀^4FwlPut}GQ,@7 4mh“@@ht#tRMC94yZfZD'&2xkDFDkYP OVF-s"+t2x i{ "rn!\JAFu\H2}@0~[@oQؖRlfI-Vlг.郚mAPJ/ <M~^S4h_ocᏼޤ-5!Ԕ.Sz+_]W YG5*~;XgF\7^tgqЏGVЗso ۢʑp:4R)m(;u ZN!Va1h߳޵ݛ7nAMQ1ΎIwt]~5xߟmDϺ|M"|sY0GeTr*#uq e"{m'>o Ҹ`? ô /:K[TRQ%(jЅn1)Tc;ǭZ#fyܺgq݅k^Q*:&3+dI:'T|>cXqwm_qjvA?N~؁P?>Cqw#+4jN~'dŶF Ư!Qen̕T3. '_z] 1gQ -m(BXUDcT-#b9 Hv.z):e 3CnvY \z}27+(}GY͊Q `; k>ē_(4c|ƾAp'̿ШNJQkw=$#CDƧN:KRfVHͬ*{*%u#F-'#b#tԯQ~ }?Zl|@Fp56RQ%BZ$`4j qNQMz_?ssKKv@Ryv':Jl1KKr)T3ƗAެJ 1rn*RKgx`q'g@3c8˒LRAsOe21J2R!BNu1 RfUJጏ SZ?tNnCowd_gH3cծ䘿V/lU)h£._%b(U#Rh㫮=Ro|\g0j/t\Zw2 (avɨ%(y"^Yϛ˜ !՟4w`/ [bo7`cINM;IJEĺLHseZ'hˆtliڳh]Hi΀^&6b4}/'J :nN<ʴ=9;x"7>ӷ+K-̕"ΏK(~~Sv BiCMA}4$}ZF衦21NmS`N2S97jr&TO_q*pFŖIÅ  N͊a)BQ1l8,)qP9Ƴ`U 6=QF*7py&TdN4u7j Y4-^ WmA>Z8튙 FUf{~>4Zgo.9TubEi\-zgxm'>{?K航cM. /PjDA&(y|_ GGvLlF%-)fVV2GA-߻Ee'PeAS [;Q8[hTb:sFtR޴G\_{;G' S,mۤrY5:w`0]>%wgC>C<<UE,x(a}ēJ5>'VNy z2>cD")hNM'd|p59e5$~$BύUg \h3a g3`z]a+Qsa\1aM5_æ%P%t9J//E.r KRK%\e%ľӇxܥj켙-J6Eu^~62mr֭r_4ɦ",n-5NٗB wޑ+|'ye__W*2(xZ.'ˠ˒Uv5o/{4ewƪѰ &T?CəOUNN(d \e{4ewūWnkPL]z=!N:Zф@_ф(y&O}4Xe -uOkCNn8 $sA% :abԇx+\q>P}whz`&hk &KHʅ\:|>tO:L{}'i1Z> 5;˄PhJ;6x]IȚAյJWߤGq3%Dx9wz)lަmbZnv2i@H]w)׍cQp/p}ɨ5mrV5v>n.q;]7B-6[S$4᷃%kA6yzWC5\fw:F3 =dr,|x}`HI!o]4Bע"2~'vK@˝*ځP.?2h`szOJ^ֲ,NB 胱)WI$Y|CׅWo⑚ j{vdw 8b@[i177ؠݜ aA\y[fE 3Ity\`?ʺ?:R&L;l*7: $,AJr3|5|>C<vATqhZ݇x"31K?EC]RRFߠUQ֎rac5fIK}fd3; `=[-sT^2a 3n3f3V,ke$Û=qqo}[2;|>GnYZQ$ /be2gکi[AߝL|5WGnI:2dko6e 5L3=|4ہO~*j3RzZq'=ȬŊj=uX ?boaf!鸕 ^𔉤Qb-zj4\1f(.?Iƈ"\xjb/%_tmMVl:j3.UA6߉~ A&_PЄrOUC$ȏ4aqh*ۮE4j kMs]˫aϪV Ll7otaVƽ|)O]ho8ZgϚ'7si9[iO`ڟgY fkŽX#z*2-ùd7/ji=tBd8+ܻ-Տ/kes]]أqI/YFHV-mWwŬ\h epc1dfq\g0A:saQիW2!72@}$2P%0xD)Fa5Q%t"e5j /%g4ȭ๕]ӱE9sΉ2bR;0K%QCC|.U褨w挂ELD"ekssQ64ίQE\˩c Pŵ'D*-KxGS>6UZc8Ƈx"). Sg4#AjB;e!~O$!\ Zݒ͜}tTi>ģ2UeCU@f*rp􀲶5PuZj ZR/Z_'·qĈVFM/O0}~TqH !r#3)j۳imi=T_r(7D0!d% IBZ፠EΨbW E{x\BۀwV9t٦TkGYzWK !)lAX`{/aGn;{ئgLguTyNT6nϊ\8[v8VOauTr=gYaɭlLx'Rزl47]?s~$-/=B/# z6.CږҠi`\gΈܑ,s*P״-t# z~sevձ*M 2\J9bw=з4o}:׳"'!~I|)*r=}=2UR]e@ߧm\O6y>\o}#N,<{!I~w/~g@&yN?CIu4Erkb~b>O,|_s̓7'7_ Zn\pc!bQ">DHW {!b2@ ʚGBONؽ$'#q=Xl2 "Q~ 53\{㖲a=E@*~D> 5&$!(jjBђ~,UKFmC2hJyKyJ71 ' Ա#x?{>ǠYz$FooO&B`_'/Hܟ?iif(jzhPO^\B4KW_ͶMڕoaA1pAؾ>Fΐ%݂@uyL1N J݆*ʆ(p )U}G{з(z `E<x;҆ޚAޑWe{=w?G}`Ɯȇx5TSb>v"M!%ܯSimkv٘:?sھp̣@tl?Gé[QwKYZJ*Q> w/{%oD|7wFk$y?UڳoD L_oC/Z h6gew/<ēW֮ɸ鷢>ۖDOunKj,6v s$~+A2~C @ . |5hTjђ_ub:{Aڕ{$m.|!@KY/w zBlnU6vC>1zݻ?-5RfO}'i1M^C5N܉m|J C䛦~_޳ &TX惰[H[wq/&x TuMDr4 u]ׂ~rP s-ߢmO]xl2ϐ~31W@%yOC[5saO?ZV8B~7#>ē׈֮sF˲=¥ą;xm+A s0{z3gwȌ;z}Pp+ʆ5r2a/$_x] x蛚Z[@ߢZ{%yY/-7Pz8_f$In ne޾>7KF#ۓ˅= @8Zݫm:$-sEsPkyN#BIx cdlS1vgwHz3cehcu /`Fiv.g @>=usD!h}{7G'C8 {$m"u8U˔ɠOVmYD?l -A >qۦ'ܿgU7 ) }~ igzb&rFLό } |ŐW O}zd :7mW+y ,LlyQcJW舢F}]sF]{foQ׽PݨF19׽JZHZ=)|C!(!W6y(:|={o=rFo5d{̀q_hv)Л"}ʇx$hymj )-bS8 56zFF;a! VjW{A[dԑX@ooY$~wnE|/geM!\ݕR{ߚ]ݱݻfгbuOO_ʡBꡡn~.VYNo)Fz\(:HO]Q u)f=[285o)h 5\˹$/ͼNҘ}/}v)RyV'nu`F324ģQNu4Np1 4\=@I5?ՇxT5nh#Cv~T(t bjY)62g f6,4gvTqp!DӴ-8X+skj#N>t9%D5u9thR*>48Pvbw iAY)=}W޼q=favvL^ǻyu0?;Ϻ|M|sYmN2*V>}݆b|j@ɾw+F)KaDgG{ioF/:K[TRQ%(jЅn1,wlg_v~ #~աXwd?[2[|ͺ4e2ـ$~*>d]Yqwm_qj'N~؁P?>#AN%E5' {}H-m$_=Bݘ+f\\!0o[0  jEi$H4(jc 9V?D4̊!R>#E۝6:f' 7"JWQK`W8A.-7 ? t_t(ģf(-770a p.QϨ̢XGBy@'mWN$,آ=@bknțC|IL&gҔpVi9XdEN21dj{"4cШTtp}îI|"袲61,)I ɴK x&MA߬]vXưq,*/dZAI -S.ٍ[0L..p2rЏ4]땵K{G3Fy.JQ|7w7Q|e>Lk Ӡ?LüПiR|9ПS84%,_~ i Mj XũZr_e2=@*rIˤۦw~ =+a "6_i_#iYmP:(,d݆8ﶞ"Vd ;&64Co#a.4jpڕj=)ȭzw{j4 l4a҇"{"!1Ph4f$<2r' Vi5 F2Z.>,F '7B]5 މ`W<}1_0>[ú@!v/}` b+tF<|+*k9ER-SJ|?GnivdAger!6~Wi 椆D[} s??$ vCbKI>$X$caGBya'IN6SPP2t1*stwVq\s1[)~iml;2b"C8jӥ&Xӟ P%I @b1A1rW ?CIfuʵ72۠1FT?62Q61T6𗠣;$(DAfT? iEn9Rk$_Mm$gHnmߐ4kİ 0j06&ϨJ.*5Y-&'{ޞΘB|Ch Z$ K/$Sjp̼6ʢZf;zm1_7Y=uVfxnw"W- (_:"ICt;LW:̏t3u~yu蜞Ço=J ]a AoL9>P2A}~2S{^2״/2aj8hW t 3j5 FiJC^U3\?=YՋUj1Lt>fo>-[O~hOJFp5T1XP%r%> g[`A(‚zw(hͼ<14Q YFsqVG ;<JMidd4mˠȒw6iH3GB:ú`+e4X00Vpb/NX}'nce3/$oN1>cՎ,NR i&O"$,uhyZZ,6,.%enٱu6d fg% "Mc ]ϥ6%Y|1h).%v7o-e'&T.V/6VK{+ưdZZL(1CQ)^:+kY;j&?DCQ~퇈,A8y?DC<:s%dGGt ^a[[;Ĭ c438 J`t/_hwX,*4%}\G *4 0+&t8J,buhE0h.u=]1բ>@"4P +V y3Ѓs8NFGixnG+ZoX*ZΊPчY|TڥꔟXb!Зfe*'* O PQtt _~γQPxZ ᧀ(hˆ->IN3k-8"v7:=>5h Ѥna6+}pi#CӤk 1 dUeތ l4lJƴe 4ʺٹ!h:px$w% O_:lbѴ.&T6`}+A"g!KS;l2R΄z6^kYh 8XF&1W09hZ~m5#6Zk)c'Fgh 5&O{{m&өG9̞ۥ14#8)N#JFfd^8IJUGG؎aM` 2Y k) GMu?%6o.h۷u᠕ pJ3qglx(&жR5@iweɂ& Wz#$be R3v*dz2s Ef97Z4{?թ愞 / h&9z]<xgi,SyOeWc*Y7T"WhkQf,?7f f|\g0jbQDUv > ;G/>"' π6zfXM{GBJt& ~3<ͭC{Dw%< p|M.8r|C+Ɩؠם8 HjþsI Aݭ3 I\?4zx1.|sihHi)߀Ms{qHOGCC'e(#h85tLPq8ͪM\nԩ愞 3?9vrTN9&<*dk{]p N#NI5B [dF;ͪ@;#"ǖ]1^`PN<7B>[y Y#](.\s{ޚ=*NPefʈn /JfEEXa%b4' tZ+.9V49N(Фi(d,QuG?=OHHr'OhX|pklTuk3Z5 t#?ƢgB樻5c~?y̪" kZ ~@i>phόCk\ RUt9pډHZ L-4&:J 1p+W#mX3f ۧ:M>ܬ 51r(k,yM!M Qӣe#&|AVa&?Z 4Qɧ|(#X<٠!Cu-4SC4j|\gjTwBO:!-Bg^QV)E'`d[%hBE4ƠjnAFl{W x#g-A>m=%b4^4D>O]fGhVԨ"!h£'{eWѰ9-Hk<`خѬ vqQ }Fz_YZ<Vk? 0 MVu5i[F$ .\Fr/(CB[ h&892Ⱥ˶3MxT˶3})#wFie:G2 ԾY5 c:+TOb!_-,MV0݊cV'ܝAu`tYCf-݅ x9x[iK|x K/\%V"F%M+ek-j߬ qQP#)0nRFua6ڗj asԘp`ٳ۴98a|iȥ Zi3,gYU`"_ue\x6I{H2GwYhN\C/e2r_jh&Cj+4LNaB@˲ XciBMh=^£Ş\=U"FBKYR%҅f&Kt@'؆uFYlG@oj0Boz/Y{dWc?x E\-Fg % qfQPX^Qw<:~b^ڶ.Щo/r37?cQC:{s=p~-k^$jT>Z~˭7t9z9=QaX\G+^:sXV^y@qo_+l7ͥB|N$$omL좁FhkCN(+TiتacǠͩƓKfrI㉉6E6R5['ODhy+< |Od>+LUMW&]Xif\|]YhDc:U4_S!ʩM5QLi [Fp5&T3^iD&T]<]:]hV`B(ӓ]Ӊe䷉DM'lJNDOk5}z"1a;fy3.A*0&%y_2rJhhodqKl%6Z3ةz}IU8IDoV#{utFaUpTTw ̈Tl\t^ъVد+Z(Z;w& _nAlO*]ji1,nYGȌt{iE#PZ廉쪫ҠIl/KT_R&26Ed@8> h£b$zO$fP#FØdLPFAfi77n}i\tBDyfWl> | O'dWc612J$ m655A߬ 6qlQRܙT}$3=WЄ˿I!.^.HӋl]g#-+Sx˶|}AR /A/x.?!gȸ(h>pma zq6liIS]"k]#ԵlD\$KA+4bx!pu1x苒biJO_*Ԋc|=}vQ$D<uPȮDb<yu%!_7MW'ua:1k^ :z ՉzIZeBjش7`NM.p0c+|VI1lIZ.TMӉ:1}d^<l>P-êm0Ti\DN^ ji?jOҺw>C57 "fT1KJr˻4:<~OGҒ1 dKe16l (+:6sPlK&w薢؇xjhn%6e KDO}b],m.0rj$atЧK7LK> Yϊnd*A!bd#>l=|h̻r4qr!i<l๠ +81eh k٠"19'':I,ʍe=ow(1JYΆ;+CKI;~A50LWVݹvmAd&~ռc-5Jn#QFQ9B-)_%Lzv3VWKOR`Ty>!nsb !Vׂ^0Bz |g7҇~IS`Z6on/} ElZDCGZ5>>SǨpDzK}W 3G7cuII0x ͩm>!h”|Ѕd@ќ!*6wMf:DOD1N+#Ď 3e5rB9:e z𬖦-k{͇xA |6(Z q>R5ٔAm8Aj^AP ~gG|0Xg_ KM\ 0yeR4 Z zkA'A^ZjQcB=" -{Tu&./ >stDG{O#uyAMpG]YǧyJ".AoI*af_^ [M\^ |(@FɏsNf@3#rxw:m]Vq;Jb̩sHq2O6i`eb4t˼KqmYu ڳkD0ͪ w:#ROl(vD F7FD޵~47l#H""q=xVKCRٔe5*PPۮqLuīy:bV8S/zK}W zG?cu""q] ji""?χjv(ŗR.!uTK|k"7,yX3:EDEDbxz#(ZD$q/}."*ik׸"4OIdY=-)_%݌U|u+~xLk"]6q;p" <|LFKh6̼~QȡiQ4/uFJY1QAACbȇx""rj!cˇ Y-M[>$$h]H]>T"gS&9p0Am1EYOr-)_%LU|ˇu)iˇ<>Er. @= RٴZI xԵk\u|$Q≬fpn*>CCb͇[>"--hZgv~Ak'3ZA?zƼH?/4*·]?B/I*+\hOegZL6z/^u?bxILAKbF(/IB "z,a Y-M[$S,$h]H]T"gSXpBm1EbYO-)_%LU|u)i<]lQfGP+$MpUT3p؝\ Z G6^%q]l%CR/ٴZI xԵk\u|$Q≬fpn*>KKb͇[\\[;uXہEE%0H$#xHeb4t"'uEEe ZiEŐYUx0^38%^-NY'A=|'i1C=QB+@K6jz`14̊65K&k6eéKVc/T rp\0}QbVwe-~.OjB ݠn=~0lh9KEx51Џ ~'2GhoO7ph'LPNVmdNhV4rƳSV/Kk ^ջΙR8Z6f}< ]kZÚcuYʘaXܢ3zʬU?}Y4+uk^cH+hBiç95k~@i>phόCk\AbczpZL~J[G9j[MܦJ,1Zg22_a†*@4Mr>ͮ۬ tU1rU)eOsDCˮ; n66bHHbKM(-I]K!shF{L ƄO5(#]!g6#b]w'h& E˿MЭ;Jbd=/ǬFyAm(&+lb3j'зuzߦHQfh (Q1볻qfTFЄM+%l* XЄG]|j1f+B[Yu l7vl|\gjik6B]_AaW:zObDPbSm~n(iB1$| " Od _˔j]l 4j$4t$o-ӔξZ:vli>x' C!{Iz0ZjzrӒ/\ZpphvFMp~$-Q5Ta\.V14w @^w 8P1,.Si-Mm5RX Y(Fa!?`:ׅ-H3$^{e>W&FА޼d 5W03gTfN!\STs* ^7nZk[搙׭,mFbA+zlݝ3#RIo';dWcs8@hZ){DV]doWfL V?g͊u!a`qCo61GmuK]J@@oG"iN f_G j{lmd_]͏00i_{Z-ITspF_'oZ4QZCЄGwh}Ow;CwP#WXQbLwA?=N:ʈ~"})sANPZ)!h£À~'7eWc@Ѐ.RT| ƙɐ>nЬ 6qQXQS Ck@YVԩz,?JЄ'0!ׂ&4/tgZ2J:Vm0Ȇ+>]5 Ԙ ?c#ˏ[y3V1| lTBxh xP)b'o$ٮ]T.$68٨I5A*ٟͭ蜩oIЄ tׁ?4azI'?4a]%?$-Bk]`-qn I-q;u `$=}+ɵf6 ps1\z2CY;r9~4 _ F"V.z?{tol]>~0kp hu=o.O /-tyb :z_ >ēFPIvay7bk r xòisv .sgyӥ[aP)hN7a™%fNb̮ōF=Ҕȷ\ԫ9X4f7,hpn6tuFb,!%6eLc%CB'>AC=0h lq#6< HEA'wq=xVK."D#$B-wOlXbNDΆwe5Н/mTOf&+^͋?fSEoI*a_ҒZu)ij|'Bhxub.Hߵ*]$ڟч~ISoiE^?GGD娹ȋĽ'z9+Бv+OD1*\<߃ߒrU X]'q lE^~/j=u5KBB2vhN bm;̇&h3z]Z"|'8l56 x:5ZA59A$hY]H]P"gSAj8Tp]ūyA1+AߋߒrU4cO~Y.6qY؟uPIAfG0$hQ;xhE /Nny6qyY{Q@b^H]^P"g"k%5:Q׮qEi:F'{3[R#J!=V`ޟqTf$q'厜8R2ˉqBl۹LKj{fz#Y1@+&,r˹,{—ke+z]鑫 ?O3-էzE@6ιGY']=;]#?"DFFFdp쳴9H-/>Euժl|RњJhn"f")Ge ;IɿJ@<1i`&b;b{Xq*Vŷ͒nh0HJڶDRx"|9pD+gL-/VR^&1^/IؙR\!4  >HJu=e3ꝉ\ɢL_vF$:mS7sd5mVJ?b89HJu'3n̏zpDgL-tģOIEY:AK&M3-#B# +g")DRغȭS%Q%sB~W<$~@e*CjѰ5١<)? -'m>55 j,A&혞J ~_& X$%r࣐_s+ KΨv$WӟT/mk$%o)!—h7sDJ:gKFJTWI$kyGJ68#%)v&|$WMOR]nk$%wCQfgYH"Lq7$%w !)wCR;-w g~D{h(>S lYd#}zM*ND \2oo)5NX_?IpEAN'J#r3&Fo\#kQ3-s@_$&@*ObjѰ9zPLۚgAt+=*wx5ThTC[VGLR_~㗁4*% ĤiT~-$ k0iTJڶMRx"|9pM+g4-VR^&1ؓIؙR\!4  >iTJu=eӨF]D"PM?p -L3rAjd 89iTJu'Өn̏Si(>SQlYd#}zM*ND \2oo)5NX_?JpEMgZ{HTey|"$/@xOm4"4IKm9nsoIK]UUex1ThKx156Hz8m$dg(ē6a!IcS\ːd,A^֒K !~?5RRC-%RjѰ4)\UVUԫZE*Ҫj&jP1v]v 2<߬MhX븆3||Dg{NIS>y=['}fqXY폩wdqY]VkU}TzlL -*̚TV),'_O}da [+; 76v,: hQbf~*/345rjI޼]0ʖXlf/]㶩|2 Lɻt(57MTgVrPDMSrp0v`U%x=\bLw.ە$~Lv&:.TZ%{3ҿ?g8*Es3 OK)(h)JeV9"E7VRX& M^n yNϲ;e}:x KuK!_[-#3Gdk $ 5Ԛ[ZSnA5Ԛ֠x @^ Yi\JvZ1\:UrDaf`!v)pm-CPo@9:t&Duh)C2.]ۦբ9A,^k+ pD.T XK:ǵmS(ؒtU`kATNQB[V AT#!_|:jD 3nfU)W^zuzB:z5LuqPX!E!ESO}{J~xҦq+>D=C m6+)[HRFlGlp*ILY *e3{SgIf%˞Vј1  Q5=*=EWk\Y2s?Q*>|9ȟK'Rr<ǶuG,%}u_צo)0kw!Wv yOIJA^ld Jw{>nyӗ#`r~A8VX sҔs]dsCoDw ĻUǟF:w!yim1/W;s :͊Ъ"j<lMf)s 'H;c\c,XXp\N%=.;o*yNQ-,ϫǧ3' cgUb$yՃLP,!4bxW-qI/}rrrs61s 3C-j"2N'Y&BM`Ug *6&8Wcr0#Smh v^0׉^׵ϟ;=xz=\&|H >B\BWZHJf}7KTVSM.9> Rb`A R4bT C>| }@*\-4NPZHJ\}UsKuto\*v%cֶ<LqaUj0fVF-!`*g47fА3n+O/@dҨX;o;&.*HGUewwq9t Y^3hQhӃ7Lx|:Lև\d6G>a1)WUtm-eR\4 yp&hXU[ uU!| t p\&lAS~4ϥ؈gű}!ۥ@o_4EdyZq=46hUo=do>JЪlLyí\oNN}D8|j©l&'Ǹ p0fII7LaM(_vҿ ?[&吗{Q ׄkz|7*a!_J@9[r1a}} 6Bޫ(5"s Ӗp;s>.Y?[OOKjܬL+KW@^z/HV){pRvZU~]Q פS7BV}2U[9~]MIܢ'MM*Q0+Yi K)75rCoU~hzk \y6\oM] UuP$Z_k[EZd?NRS+|})zd+A ޫ`ԇI*&2:攊a3Ǖ P.8BKGk*P>,fBDsϩ?(FC\8V~BG7!kDhnoU4J6& Uv`BVۥ1L[*" G*wCwF۵!6AtQzV%@@ ƼA,f{dY1'UTC~^ڠ;{Kb+;ߋ5R1Xz[LK/bN-v%l,bO#n^}WL8?|W_U!GkG/JY 3iO-syLUe헓KuHo;²xZ#F%xR2=H?\&T46A֖5h\j ZsN\&laB& Z@ q- s4hk1m4t4\IMd`4MF*~{Qp*t]'Apr^2p/XgF=̤>$;HlirLm&ʾxIw+$.Ϳ7JS>i8 b+[C5hCPqzʺdռ괨2= *uF" ڼTo sd]\-qSW~Pw >pƵ(Q-@C\&-ʇV᭧EBCEPnQnQJEiVC/[ғnQKuEO]Y;;yHIQ %3, Z[3 -"+,$.WAV:<08H9,dk~o+KkJ ]jV Y95vM?Q{˅Cf:f9D %IxWm4%, T+h%U\;U%8:H6&с>f9Pw*<`VIÐ*T"bUZh$p06nSb&]:4Tz U?8lض'~MͺO'? O:O'%TqZhD\JV /iO)sM;U%\Ku@o2Z*&˧*~cpA^UBV2+LuQտɨNf5p Sɬ^o݈Qez7.m|1E/G[ cS[#De/rF}φ7quI~)oLNNb]wU7j1{ʜvvԖA7bmM5Eyg6o$CTAnW [u\ӷpvED19N< 12âA Qτ-Hr6f +f J~-c blFv\h#U5a݌0&Kq^ ܣܪ=WDO@aMyc_p1)XSy~{OʵoWKqT2{\&dVj+o%@*) !˹LӌM8RF Z[.SG#3ҟkx$_OX%{S7 [,G>˄\){SE5r|=;\_tג!bUa>5CfKhˀԐJbP1M5E9dlML%<`N\+,H@ZUYp}ֈ~hܭM x,Qd˜UezyYh+y( (drV:*hCd&«UǟdFH`fmdݴFO |"]q6wŚUJ(>蘒c3gL={;no}o% Yc{+kLSk7S~Ƅ]*fw@Y*Ma*|9lfѷEFA72a [>՝G2h=% q=s}J[#n=t[fUUz&c:\>\Q0WUjK9SBkpp~8۟ B\B=_tjYj(qg.{ڕUvKule`}`8ԵhOA˸I*_pl?e$}qkqzh4tlU²VrUEzLd,uy4k"-eᒕ3&( V ;[⟗ g˷_[ H *l-̤}>~&g'>[^7IR+*> ;.rǙw_)1:.>L| ~А<.YB0UE5-'ۊ$jVDS]V<TnW'^NrꞚ;AxGU ^U!B͡JVZJ{~}+?ݪЪ2vɥ:;c4E$ @Io/BԳ5O&+.օ_RՐWks:k򃅮|ߦclbGyR&țxzJfțcnQ/T n$;!q>$?B<~[?1t'XLUe8.H6&q>#]?,b.k|QHK}U(:_|oS!j1ݠs0r>7[U6>7TzTvA01-GRQc q=~W 9F%էQߪɥ:cMZ=$g6 uǑy& klK󭓾< /2biv`v'Gd~;7ިPp\NH' 5طKX6awM.M1S,<3m@V}4rf4 q- Wjc&ۀjTKRq.4T7tZc5n^f۸mK3\Ɵ'S>iӨ^gl!5 }?g8*zQ*\] 1Z \yyl<.{pwZmt 09*Jݘ>~!_0"s Җp;;.;NOK*{UUwfT4k{qD6Ӌ={>.*]N Tdj;%rj&])ē6EQO*t0~(0ti=Kp]1,06 7@Lݾ7n?`H,`7,u\~0]X]4 Y2.JU_8nÎg =|ިmB F K[\Dɽ'bʭtIָ]h߈0b?Jyr!T"7nM3nrw_=Xz*bMbP]:;܀Yp*4HmY):kd*/*#AwYtiy%AiikRlj&:7 46P ?@ 9Н10zIo#*Ӎ3>TEo:Ju_+@*jѰZ/]5Wm1W#s61VKdSm2ʨ4o+D߄͖8ɅCYo@O~ }ߟ/~'h'0?VUj%*)e.W[U22Tz tڷJkD.?xX?Oo3оC3iO-IHlfr7g.+?{L3,8׿Z@ȘYO7_kZ|34(_ OȚphPŰAƄtӄeW+4TJe~#y0*C86ϯm9T;OY]~ucͪS+W n NZ.45BxN?fqlъ=bJ |ߦnr0?~ʲ W}3:*#C3>36VV>j6S>˄1%YLڕ܆asS7hCS`{u{i:֟pz|ӦiyC<\ZQ%t JWgsSI'+FK踂cIufTVO.Y63VіӽchU:NP-Eb+lXLSJ̵JM[,P`|a2{|xRͪ6[kOZ\JnG~@*xd-4ZI{d}jI#'Y69TzTvemSՃ> VVuUf?eBM*>< c*GeS%b~F0oJ5wd**uqV> @  NC `IzNE7;ƴ+ͧwr0f9KO¥C@xt-\6v,_M^* 1BW_nbtI_~ 7n >[l6o&'S(z§A~Z\ #pyVkA^}Sy|Is9}:rGX\ԗSṬcߔv7溟|NDL&Ӂ::+כO3-U>{֜DiN+9  gU]`[_!/gē6gA!}6vf4p`?1Z\yr-`ϖ\<YiɬlG٨sG!M)ē6Cle{. Uh)py[gK_4ٞUT8a@[|+ kp}@䙳9!ߨ-3g)E_)Ӓ*a:K3M|/n!:/4 פS!+U?:O-9~eIEQO~4 ,:5W¤Β$_bk!UI3+ЖZɩ` i)aN. >u@-%hA>[]|{=Sk6ɟ"C<~=xfz.Cnf&Kڰ{ zV%@@  95|-|/- ՜ xessYx69˄1)rxF?)V+[\| w RY{X D gb޳n`^1Mu_Po;>m C%k:e [v䃧 ~w˧k ;No2j45w,~_5\{tσC38 M(;r2[sN Ll}|@a"ϭKWydn}5 5DYQ>x)b}iҵfԺz|Py9yjNmPa]gsc}ۧ֎/,߹L_D!Zq=4Vy6][٦]Oۼ괨2= *uFF# <To/0rDU|;ٝ6˹L􆟗r; ?|MR~:g,r?4I\+^xO:hcѱfO~ːaB=MxeD:"VK(B~ilؐ(U^zf!,^Б L"q ^g(|z;r£4 |Ns߈^İ5\BEawqƤB>1eB lrf]i=q\"h4_FLiKTʆ,uGxfLd&l kۺ괭i* \ֽ3J6o2a l/f.g2:;ts3ԼҤڞ| 5Mè<rd::3\&0ϸ>;x~!.gtPۭL\> P䇁2aLEo$z\A_.*Աa@[ϹL" /Tǟ/FceWjc&S.{2VMt\M&%y`}&|)Î?fLBo:`׾x 7mX ~ q-T ȴ1Ւ"&қ&jsoH ="v^˄m UqZh$a&6% 4Ѳvɥ:cⷿ6<\c_ߍB猳-w2.ws;b,gķ*5nmt*6co?l|)| . bґv%Ua ƇZѶ<~$-ɱh VEl>LUhۑK˅OV-~$G(xYGv+y^*<+y=ajat =L' 'ЪTٗEZq΋or5mGמU*m[s!eHGĺ634JZ_pL\3$ %2a9_JNYxIȟm;@S*h4lWNuH6vR^վNhU4nMIXo}rS}jcoWbtdzt9 yi&tlv89$^dMmȡTyVŲIZ7HwkTW32RіjǕ)Z(KQ $D=M@۵}Ο$>(貏WCTRߊj|R{Vk.J>+ Ƹt^M& ]2|<%sf m InWC^-YUdQwV;s$uFE3DR`r^1GNxSr{!hkWҎpk Y:ֿcً5Z.dLS$a`b/7B{ibL,8m -'3ȳ3 ֟u\߬ItġxCOG7eK8fs0Y4_9Z5fKgC>;VG|늩0Ǣ3;P9ben) W7@ޠپUHJ~x7_Ig%jlsfEe;e}=e .COޠ_#&Sē č&ko)cU`oJSkM0[fKس㲖Pr[8gSpBCoߝ7v&Iɟ oP.ܙ2hsS^-omjaȇdiǜ`޽*ʹ X\HG9GEQ9-$Pr#7xo̍:䚃EWhJ+E>{ώvNPй ߖѿNx;7zJM-0h6.Xތ9]T~T~+2@x#ᭂ#y'Lp X@m PPUSc ]^ @ޒ:[!oMRēYDz1kU,@pdͥI 0v1a (Ml0w$jKhjYɨC~f& +UΨC& ysFMoOFN;5ꪪQDzM)fk~',095L 7}kē5 Dyi0ɬd Jvq5hL1 '7VK>nݦg(Q^o>3dLo|)}*mSAoeAT> 7j#(򡓹F3:-.Sm>b g  QJD"Qɮ_xr/AKA!۱ ~g4|~aE 2lEלpcWPqnՒb_~WӱՃ74<+(dwO_t?=+}4u7 #C'DYṄApE%ٳT/pdtMAP[y䜖Lq9p3dyDL-nଶF N74ȷ'Ȝa!8}; J |>+)! y]DWA~l&荴 !¯Zx /m4%C]\ғ[x5N5brKR47VL㹢dSm2W@o=Ƣ{mi{j!E\$yW))M\Τ % %rF[AL:AJAJf 3񃔥S]l٠ rfrX<}Nt Ggf]i:ԩ^$ rOx^}Sqۤ[-׮_h?k -wʱN\/o4ֈY+9C2U>sAjcR"sV2r򮈒V Wb[ٸh3P x )mn<UNQ >sA~(<BJLA6|8\EG,JrBp\j_f~au*}[uTөc[cYAcFWڪ=ϾDM> غ90-ﴕDRJe4Z#WsP]? |˄io2aLƵqw'؁-W֙;u.j6v֙U =s0l/e4s0ON Q?ؾ˄:#͆КukW/2a k_ ˄1շd[+ˀWq]ZϦz b~m˄iTsT3۹ܮu_2aZ..+6t/OwV͖5ny*;L9*nX2nOh3cܞΌA]@nlýn¼[.؀Ph 5nGٔdJ|' p}=\nWWvy}) .=Z77f*U7.Lt2˜%D~ݹsaABPPջeBZlWFu+^ <j{,\1i${ cEq!.w( Ȩ7np;;tTPq9@=ƺx-;Yq)p;b {Kgxc] z'%GqE:T , `: \PM|鬩8|!;⯩}8:(zxf2*j6iv ˮY+ƍU Ø/j;ւݻَ>'өݻ+߸ Oq9*Ol YS4] l"./пyn(=]˄ʄ2K]e,uLآXy../JPjzGij`7NPU onmC z{L"_p caa"Xx^T*Y%igP Գ[d肽pP՟dVdL⇁e4?6?eBMu1p0:ZgL\1+VKow&˄1J uԳy8jijQy>w0j[~$MaYngoxK]ofn[^w5u(v[#UGlGj{>>b-ս_G!?|=|W6{+ovm:lZ%}olV{_t4W!5O~)ې?pUZFKȿL)pU&}!+4 d?CئZc8vm8_v]S)?gכpXpkjǩQV͑6:sTQ)`!e8$"'/q0'%QOo˨eB]b| 3Jkr0zx\]{\VaX*,OL ? 5Oe(/˄1yH}+z5i*B!t_}2"r|uu*ɴ'KOW)ɒ.}dSm'gⷯj's*;}i[.]QOCct=&,d6llr]|m}G1:hFޚ6ۖke uÃ|GU>ـStA|ȟm":,"MoB6eICA d^wYJT?Ѧ|-u;UtKAttSCV;=WkMGau#-l~p̬2& ~M фU e˜LWOk0eBMSm$6&piLQrǸad*F"orFLcX|$:#\(EH:}7\&)c?rF)(k3|ۦCW-]^9~˄1#?:E \&CztNgtjE{d.c*2b9 f/P4@p!L)C2q7" X\Tkqz̎j:H-ٓ# chD9rJ9j8Ո1GJs̱ٷd9&j1G}:[ K+r<1h/2?B\Bq3*L-Ĥ}>30VML.9ME&/V~U2c/.q*L-4~%ԧtQߪvɥ:cw(!w@~GK2.XCuq/O:h:WvSjSZU>N4TpzuZ6ΐɧ!t }!}xoĿB\Bc:ATsYhUD{RÃ1V2 ?cdҩ) =úf+2B&åYQuUi)WkYĩ93AL*<,LkKp]sܱVLT{wPr:?Ϫ_r_U}g., :+ 5j̏e˜MHjY]eBM:R]Dlie2aLmg5.ᄟ c:@a9!>x# 5iiՎDx7AJK5hs0fw]t]2]5FٞpOՙt->嬾j8_4 ܩ?嬾SS .g6/NsZݪsO?etbg?s.gWv@*ĵH`^1nF$7phDLyIߞQӮ(5k!VcΞk9 h .a ,Ë9 [ǩĠA2aˬśuCc\&Ԥ%uU)F\&LAO2aL=/p0&ܟJPqSpB(k-\˫:b06fny;E?=iIN"?<YVDD@ 6OK*@ԫ-P93i&jP߶N1;wZtO! yUqZhh>)F/iO)s;]b.h\s8]=*~'Ű3Sb't~XT,\P-{{Oqu"_Re%6Y'˄:M]̊V {LFy_^e¤{Ĕ:..ƬN]'3:eErFas?r2aj X2aL5]U9j(b˄)F+UQTv?."(0h4$(LK,lsySӀǹwo˻'=[LU65FD|: Ϙ/JLxG}2/\L>|# cESQ_Wy+&qPY7myЂOe4LSu 7yWI(2&Bd;Y(J/r=#(AkLeWꫢ=Ki2ӂ.i )@GN.i?7s0me3bԠf 5yo\ 1.hs01Y S3F9vwqP1 o{\nfL%D Z?WT4*e$DK&r*)TO%i2P.rᚨ"FpY*Y4Bs ƨ ̶ISwgcWƨ8._.ͬ]ln[B#j!=4glԫA&T*}E{R7Ӳp??[-*ەc9cTthݽ}3sp^L'YϮFC~) P4WL-]9ZUX6T;ZMf,~wĨFi8m?f+Վ+\p^>x q=nU cCEJT )iO#s9&ߪbvɥ:cWEufZ]j:Aveq$Cuw˧1U{r`D*`Ј:MTNS\+Cʧq]%[6 Th׊8-cyTԺg_ERKUqZhKڡSJbyLL.9<@0춵ǭҤV0gz'X9sq_5fʩ]cS_ڕQH0_*ق\PSgY/! t^yZ~./PZ5}p^.+?*Ѻ hrP.4Mu7| 0\&iϪ/պfncܳs0&Ic>_G<1iiM w9` :.sa(S,:.zIT2wG|jlrfM`J*p0^bLGblb.jj޲QѬa˾J._e˜Z2ZB^ |=iq%V.gry6.TɹWOQ3QrVgDA>J:suO_2a*\&'6D?%j I˄T+LS5+ftm2ҭ ;]G:"\&L.2aL#oD 9F>=: HNgEy}^.1]0* S"~.`g].ƴ##=Ql:&1Ξ=XaP4}sӭķ ~.?e¸aqVTU?eB] =#?) _rR7oW Zf*r44j_.FচL~ % cjjhvO_q8˄1IO!qLhݮ>í>oAHæ-9U[IX+(둑+#,@.h+(SV0o-Gbux%WNB}) Ҙ} ߅V㗮|V@<0.?aYY*2pS5Yݽݶ cY?O' !+x!e7Yg:4ǜwQp3yU6RDk[ +O m&wbb"/NDr'pSQZyd:%x4e~k7PR[K]/%0KT\zw[9cOrtsƁտmFZd_\u0ff\~ j&]!y[Hm3Z.mzyC2 t!ƒݶrkD 'Sr𹐟?,^H?|וԧ%B~Fu ;bD/ b㜮9o֞~Jr!Y+[tljU{lڰa͒,| QuO "ٷ73 'm_zFwk^.k-rxe]5bθ+}XB_ǂ 8ڝ(S-HԴGN| y!< :q1dD.`JԂ/++k E& JCМ ==6)U !Z^٨9y4Xz066%D%߆7% }8%aM\uӔM'xNZQZTr$ѵʘSI7j]RH! ¦v%+8rÓw'»!;#A|KCBLKI4)~ 8Y͙6lRN lFA$ݤPrg@~&?XT֔lQ:b@I!~ 3T#JeCxxҦ\uӤ5) G k@v󥋻 jTJ~θ/ 0+UѠQ> aA_-ۍ]SC;T%L{Nv  ƒg2"|gZWwkZ 8[7Z{߆4ZJ)x\_oRx~ cZ|\gFq5"_B6D߲qm7o<012hs\e¤.JWHv- n1(yc 'm^G= W5\;\r76< ֶ7'qOlJvo䛟FN *7;5ԈjRY[ )[o(oAۀovmP YL6{}ߧ zz6 (U? YFkoؼg`˦ 4ów6mɟl瀿"JS7ē6ኯȧ:{'&A;t)BlԲTS4RTQ-9azeE5W["mدE{drc!-rKCVjTy.:lyƌ#րҺlUSX[@Հ܊k -n7{-ml.Z6V!_f.ooYa@! &o&Pr~ FZo3ݒۡzC-Ȗq9`' a@|!&Pr#A~Q Ja!k U)O4z4hpptOP{skNCy8vUlIk'ڎkC*|'|h@Z YiE ZPo;5?CkAVck~(wYmKvEp` JOAT(߷ugmwd3D|?% Qr/ģ)K;h~Ц.J>+ EKgxbJ;k%*!lF7يWVZcP/Иl ?Վ=t C5 &lqoU-;ތ ҇YSV-J S]eɫ;q>rpɮ2ryrD;tΐ gGb9H.vN/[Tm^Qrlb<7DMF{ZRp 0Y&x06 ln4ywZpUx5_^k֔+2m4$_f\nXod:Yj噮SBȄk Bv͂g)B}7নFd-bW/ןYIXa7 +7@I3K#=1(<5VNŪ6}Jq\kT:Q{VLGAdRwI6> 4y-+L*y*x}JV,Y'?ʉf&kQj@T0;a F{6De 4l=!9. БdGkb4Zڦ!"W^$DxJp=D@ V_`UX \k;K&ˢh&a^0& Y%Fl!ˍX<7'!g S[5v#hlZc^GdX+S cSK;+U?99%Ⱦ(Mi[b,j 2='ݝswLS!P!}~T;yk$O$ b%dhbLw't&{tObL7jbc1mjuUH9܆ȏbR)lٺ}(}Z0M9,zRbaZtff/]3F/Fqx;;cYZ0Kܷ#{1Qe VNu̴v[`—I~ ~?2ExUF6>L 4L|i:,en(lB};Os 9={ܝsҹtF˝t qތ+ooS=ߘD%)X` GQ%J(*:I g`zGbLu   LTzp&|V#)Sز,cQSyvսa+7]i-# vxɚVevJ3faPp 윰RZ(흐1Pߚr~x<@yt ߜ/1ҿm ;7BqCHSgMJz&H0Y,vTwz-,c(ἝDN-y6ET멱u}ĩ%w -qA)+¨ДȻ #ǏcT *zxxxq~[6Ʒ7!ȇ@ Z-,`-m_C|>|ȧ;L4XgD?m6`o*G○fՠCӀS~fEoa.Y[΂ZO?̲/V2]:ۜ~%/b 4$+:> 4425:K +KT%lgQٶǰJ~x4㬪kWVڡvmZcVph@>'}PģI+eVZ0d<=ZG`c$膰rF=_j̈́Xi鉒B@;7ǝ;zUY3d_Wf<$&=yUnZi:,sPoY37|cP1(oPwP)T½*ŖC2ЖƩi&jMWfsd^ڙCM2+kEj{M]6TͱhV Q G~Ũ! zlČ_ncAJI$ҳڰg|}d77c?=H'/c`< ܇t΂FoiuYua= W/n|EgQO} C3+ p+𩐟\W$8g)=zI? vOx6U5lЧ U S]4[G$6X9h,{òWVht rWz@iE&y`/^c5u"ZLT^o¬񂂛YM>@)~ΚMI"+BaPӘc̚hN `?^oWh5CV:lr_L 'm+a,! , hkvPKZ"E}A4Y7qItX[7~Rv I/8e.q W(Rgo|6-mqhB65:SlԴQrw!ǯyģ-o#!^QxC9gCq[RJSmfsgv5]hqGTx9fv~x#@T>d?= 4dJ8y"|2O 02`Y-\Y3ڰybڽP^xS)M,C9,_+wBSO%Cgi!J. Y)<>K  -j7UI X\IG%#@[%krFŲ [W m[ U o1( (X@<q#0c!9Tm֖q'x6KF]"V`6ZrBw8̜$?3GxfRR*u=bA( jaxnwo=Ijz-_ʹM[u^أsHvZZ; ߡ#e/u Y(ē6 ᦞZ$FG4} OSA1?DP^J%cl^.S'QOAVȵEkP+ W JA_5.Bu(ѪTX6@p P+֑#=6٘FΠ(яEy"T1hDms6cyVl<dk!Q[ýTX-۱$FoXRrocצӼ\?Ӑ?MMgW( /Cr:J}AJZS' _~׵ifa'yJjKw!7|=ߋBktIl@/%+M?DM@<  3 ԖC^->P2JָU2Fh_#6IGɔsº0{-q >Ėc/Ej3}`3p  Ȏ\*Jx-k5ZsĨ̥`woFxҦq 'ĖYZ$V5G+RjKە >p#4[;a-tTM#aƄ]*Q|Z4Mۃ 7Oop>}P;ڼL(q. CA7%C~:sղA!cA%䟥) '}hp0P\l 0|Lwsf٩Uu̡[3jU,Ю4t3fz9%3=Ff5lcN9Hթy]O?T/\#%}/ eX +u\#%wkC@'+=GoѦEv)+) !+M+@@l(Mhԋuy %|ȟIG/ ,} gi Cpdcu8fr0X@3F%Oĕ\4ba| $/|b<Ϊ -$LP/>mR}} y-͐ߜ[bW[ ))Z/bQg!+5)js?ך(|GHc4| HG- &oVeDD[@Iq%)䟦P( L..Xx-R99qsoX&,0k*Yh 4QH!_ isQtܱ"*%w/phz۝7 U͊ B}= u]Dv ȯIuQrB~mxw]Wq09uVpzK'ir^Y wNf{UKRՎsj%l1 ܞ |i'/VgQ'iEu64>->xҦͺ-[FL/<`{T2ԩ|([YḞvN ;!wo,:MjG-k5Zl6_oP-QG39gDoZ5|x}Xf/VK&ޛ T h8Sp/߅ܮNOLMu_1(SIbPr+a[z" MYbuЀl$o9)I,%) M_2TWK4{t6$Ebm9N5$DKD2/rttܝSR_6L{&RkEk0Kv񌮁-y4k>$\\Y+V}Dmk*e?zz=4W5$kuL wF]\s5xAfg=~Mٜ4hҖJ^A@FMfY>^0KKxQ5].J&5U5^T^R5 ӮJ}}+CpȞ,;*rE׸mGNo|hk"Ff)Ф5 䇴NNnr$4p.\*x"?W!>m{N[GCFe!VwmYhjĭ8 %Vh!^RNv] OSQ5f:U%B.;O!ǥM kAeG+Je2bβ67S~[Cղџ߶Ygn2&%3U+}vGm49ˆB)=djↆ3鷪l"p6štZv;lV_. XOvr&!}D{ %:H.9=f)~;%+z:|.Yv|TDZyKn酨gva73ӦA\^Ay kI pفM)"#6ȷ͇f.]xfJeT+Vi%VU\mUsoU4nMI@o?it~n(-=ceWZU jCʸzVO˜1r&N],.P 9$ 0˄-pg 3?f+z9N.g:牧ϬS!ӟ=U׮CMk\~NoUDSm52mik|-)?mB7*,|Ocg?_wr9sT]k6m*W-4וC]<vVjZ02|2kR%[h\sx}=GlQb"%̖͋bFL8?fW ֵh|VPWY 1iO+ss~&w&S1SMJߛn;tas.dwp4j?׺d7k ;>U8L8?R!ǻj}ի`pv3[U:>6Tz uڷu.{(,?*'?Q!yj̀jҾS^Mp]gr:-֏/#]|N185x+m!&_̊\&lw";˄5gw wпB/YQ)Hd"r6wʚ Tvy("F=N[9[9rVz~<}TZhD{NRKsSix&fߪɥ:cTd")L%.󒽴ܫ1}ks:R ".G@az 1LJU [iOUsW*Ҫvɥ:c tZy?ͰZBN~,-=MT !f(Em %^ Yz`+0"C Cx&L }[(QjCʤ qclM#}f)~{mZd.5r ]ڪΚ*ߋI< Yқq%w7pN?pYAWYi6s> ̽X bz9-4J͜J͜>}E{ %K.99=f)~μg-λ/::eoLs*WZx$j,jSK`'91됿N97 #6/1lWMW7?vl#m Y*iW'!?#0 cjSQe3r9t|*ʬ^eY˄1LbsJbȨh4i42aVLS/u;E}53j=2dWje~vŲ'Wu-abjpcm.겍6+F˄i"E\&i]^nҮ ۳ǟb`/ cʕ^G=y9" <8Dx@| ]sm44KW)ɬKdwғMI']caEp).oԽ\߱C5\V漉>2 >_G󀯄ت]HQ yqȏkO{OE3>t4f!;f1tw {pd7N1 Gqi0EZd"P%,C#!Q*vFՄi6x׉OԖ9jf:'jYS%uO|!Mgx)23KV8 4g1|أgFy-\&L!˼V.4 W!o˄-j΄-/Wg1{rFzFE17T'B=a 0MJҡ>  4#-*fJӚ*Fɥ:GLR_J,x|K[,*2{K^é@=S53FQBģݺҡeTV+;%ՐWkktS6#./|y%wrgl5@MԳݣjQ%@m p9{sW8]~ERMDn!y3&yc&MoO&}DM9?bK /f[J(s%c װ+Ec/gMнPBoQȉ ^{7`؄ K)ēaM4ݏЄ`|1qv8sBTY}-D/ KGF;p@Gxe$hhᤍWT#VUJ2;.K2Mɒ }*~{Q!FXh0fHw$Pr;!ߙ~L@% c}xg58duzK R4 g "&/Dx *$%BiOO6&t}f)~66DON=@~| R!wjnm}>};eHP}gr;Π?GEMWK+w3<|Ugu3 'EAt4!V򥺻?irFmpmI"<˄y,/W!yCCkB%Q>Z$Z(c6o5%Fܙ)1o7vϯ~.gwqnoT!qj_ԧ$JL.9=AX6݂\ksaƄS+ꣲZYtpS +ٞĤ5lR'ǑYf໹>ʾU~⿥B\BCo֧D$ %'~XYN3ƨϳHrp~xȏ ?B\BCoԧD"$ %C&RY^ڝ7Tx7gI_*R&(~S[Y=kn 팪Mƶ3 % 5)6௸LS}sL6ȝg L8 sp^Nx q--Zz(ɶD!BlLy ,o/~lV\=SwίC:~.y@&z<Zz(I{N}HhD{Rs1KraeEm~Tz3 f!dؙ޺pv [ :n(WCBgרcYXl™qAhYʺfSakφ!^ZD ņN;{98E&~T b5" bm)e8m--[Ws-~I''c:-->MU]$=PǢ(!%B; mI3Ւw#%^1܊C1<4Bc g0ʠy͓hlpjm f>\?1fSX~SU*5.o|<XQ{ Vrٟb3R+Us .3kUXiTM׷ -ʞO]V~4O.O joX-סtm2wk ,6ƨ,dNh΃+=03qIJ}.ccoA6]*Q f)'t%(Y&ԩǝk^00JvdojFgģ/K% r!EENidd.v*fIvAOBwRח-d9>yǕ=_͐7k煬jڥt@yFFEG[ģIGk|m흘K*H$w i?(Mm 92N' mX9n{{[K]/%00.:l,#7V5r,aйgDbyC2cwBńakG輙0Y B;eVo0攜IwOA>1 s5鐟[Y(π mnڢ@~Fu ;bD>90ՊM9ӆ۔ mעcScߗ{<\͓ 6H6D1!Q -w8"P$ i5^G=ڗRܜ7nXvqԵO%Ϗ҇maϮ ]Wr\wɩNY G#:ndЁh0+ ˫^k-En[`!-0f9jI׉!dP7fЍ9"tǎ8#ʞ[>C < dM %w8 yM d.\>̆ ||.&߶PrO>R1mٸU=G)F x߆y[BT_ $O&ߪPr?SsJєC˥͔^:I[8PHgģhҡq%*_mcP a;dCTf,Flk*\0| Zce=.^Yi}Dc(fo/ z֨nx@n*]rBV/[5rUƔ0%uDzc[$NXՀO4X/o1Ac16զo-5&6 ?`G};tlq  lXL#qbfcEפ[o{9MB~Y2+>kAt,Xҏb[a i.߷f56Ș_Q9Ov%O Hzmd9Jd]twQ"m4ˬ䦇WNd&`t1'U~0fR(r|QB"f;uϝmk G S[}E=aΒ`K{_R/MqI"%( Rɸ&{yj\h뤇(f.S]HKbܜ1TxšpFNA+ H_'^x `[ÍtdM+g+GW= ~d/NqM!^g͖^\=vo`]*o߿a`Hq֑^-^ }擰u(KzQr Q Q6ʊJwl`K3]j+|hV[)84v;UYg_CGnO%3[ҩҙodT6]y3fki7ˍhO-moYJxhh4ijzCV*.2K٨%΢ m ~Z:JCS'Wq*7`dsUiAcBG $=!5̷Rz$,kܛ(>(lA\:9!.WA}-uiY$V.d=ܞF; gB/ Åw\vǐ=/y:Yuatk%t97GAעi=u`7ێsAoUƻ:g|}Qx1.ʞq$$L΅p\ip>1f.b2+ESُ%s8g9: x@~J sd3Yq*DSܷ#{s8/VY6xm#NC65RVNi-W!ƫĥT6q&.r)[\ y FMt͂ob`)^%W@~6?h{j񉝄+cWǞp{ΚӇ * (in!_īym=@1 Ac? "/ƶS*$ϳT]'J?X6o#?/&I f.l Aܲmڞofe%8'( KPQ}O⒜S,0|E@h'"tDqp#*=Y#Z Ǔ;nxoR]l9h4luM)Zm1W19܌XZT: y5RW}M>j핆?Z׬Jb)Y#QJnEz仒\!ߝ~B# `2,%3/pY&.ˀ)p!- \H pM*pѫ<ŷ8pI6&#~>:pq1Ez7dB.r:@2HG.xҏ\;\ Y30rw"z2|\ME.h$h&ULr~[ Kj$jE[sՇ\D)K;ز!sxB`R \ߤsp>.wE6 .ڸI.z\࢟B.ɦ$pWso%Ɛ5!J!J~H -"JlBAVZ ېЎ˨ԪS΄;>5b_eK[:`f7'o`݄OS'}KQSR> kºM%,ݳ~.\ U3utNr|6uJx7`%k'y01ޙ^YBg[/6`Є7`Є;!L߸)ēq>?aàOĸ6n}K[af+TLκχEbVM_/ {5,zuKհՉXwLBjSjj U;30հ-v%mޔ.o/Hؼp-[=p:}_B0-%mߔno¦/L־Bw2+=65ЍcW|i6}a-\J6b{ lzM-$b"[t1 | z ,mXU˒6pJ~x7`%jtl%G hgZ盕5nߵ!ȇ7`ℷB5}s* bIC&~q"]{] [jxr~1lbYCwJxҷw$jK`jiS8$Du[NԗwCV$,X5#i oO~)d-,kª/M> KVf ==~Va!cprIWKacү- e0˒l5 Y"ՠgf5p ~Y`UpՊ/mٗM-2X3ᵐM߲)I߲š&kپe5MIJ=.kkaÄ}絰a~3%? ـ s'y€R4zMLW +T΢ X1ҷhJ~xҷaŗ'jيA_#&LC[zCY{&ˁ}myaÄ-Д-НDU`f~' 3>!T|ӮwM#%^j#o|SN Yif<'G?E@<;:k 0E>(.^ 3-Ba9G!t>ku'(M\k<G, }U:`_m 0~'Q?GWg#N|}~YB?GwCB?G<o'_Qr(Iu`r~nAp9%mKܢևyQ1y80q˝iq-YE˩& *YfF<v>)9ڎs X\lmG|*붖mSyx?[kB#ʵsZIv}ӵqzyo5RWkO.9\#~{6N-Xz" ?|畒>;ē~絛ק3U";JW{vZuau ͺ㶩2G9X<YmDvY߂{ݰ7QX"(;!KՀF=b83=cز*S kF|gVl+kĬ|Tt OG߶WE_~W_غ?؝7,y4 ck|:HXtdWvaLX^::e~cR.fg^e e˜]J㭇lADQ3!aPHv#3HHG) #]\q k=zKkC?|Ð?~G@/|ql唇-2%0&Ea-28(zd_piv^ X:̏˨Bӟ&{7{LXLzЫ˦;ɽ0q!S'eӵ>mi2DW&"^ GtxUôՊYɼ_1 ~GfB.`e5\(Uipǔ XwԮ*}lVxwkfufiEa!ǃۥL]r0(ͤz1ￏFd6VVHgX%2  ֨V1O쏂uW1OPc4(#NR+ʳ-(9T H5wa9ju ]ux8cSv Gʅ},O6_F3rI*ib m1#W1-S|KaEj<#lMfsk:x]QheVp0Q>nU&7jTS w6\*Wq#!Z@<1ԘOP?Fz_-NY/߆3*R@<1iÐdIBpS b""|_} i!<*fT_*ol wA` B,3K6JX*ҫ'ky[og51ڙR\!4L 'e5p #K*q WZW _Td=# *SblY,X}zM*Kr \2oo)5!NX_秞^܀Jqlh ȃN.ȻZc3?b=}͏XF*SblY,X}zM*Kr \2oo)5!NX_8>r#I[w@V״<ڇ nDw܂c){s=|+5GKw8?M.kE3x/D+&OX_?Mi5T GfViGDD.vBf[( k:O6^|xG@}5p-? yI`ul- tOIY:AK&M3-#B# +|[(޶m!6GW@=Po^ YM5\Ah;-\B͛5 DFD ϖZJX:ѧפ,OK@%P&ؙR\!|k@(@}k@ h +JmoK'>l q(;-\C#8K7p082-ـBsws9y/>Shْn ?5nNؙR\!4m| q(5m-[C_$8^ٖBJb` PWBJJ` Py&ғ clY@}zM*N \2oo)5qNX_^CMmkB ]uQ)Lq!%…8.ġTw[- Pk7 q3u!- tOIY:AK&M3-#B# +P-\C"8J` q(b,ibZtGAw@V[{3dPw '& Ø\7rs ,gaވ ρ|NvI-jqTq..V>zUJG rY:LtՇ4NM͐7^[bd(Z'32 Vd5Ry;omZyrPRb,yƈY*Mv%%j]&(5긓ݪ: | c(wA~W:J'b+}N |4%&=ȿNI7ؙ'?N{|spuxDA^&:Ib m슬}o)‹!ŷ9[3'"7"ޗ|,zc@բq/+zz D^YFC`M(E 4ӫT4ڋ2VJMɸ>-8FM5\Μ)?9nȻd/{'{{TxZh$pٻ6n.TbB0R=iuE;Rù9⷗=ÖU=b[Ec6E ?S\Vq 'QrE` r)))2OD<>$p>}g s ?'~4lL |!Ӊ1y9ȏhl7LwV*gt9a|˭=n&sqڙW? ng~ } ȟi_,s?j'?/AReA3mP!&~QW߁64[Q)"Ba:J.G[)Z|0?R|۩P S1د>Z^թiNFlFMPP9fqP-ӫ3q0%gorFm} o̩\w|úf 1EФ[韩^M0SzLfLV'cPS~縜&vt>ܩb h3_2aV1g\ΨFJbA\&ԦCj6/LF+.D# .#7(ir9N[&}yUM9'l0W=#Vs<#o4 O9WS#^\6WvWB͠/V cXGW0Kyn263)ٕ>B.g+3;| cZ瞩E_FaFX|.y) bhawhZz eaUjqzָ԰Eg` `g{~PC1ӧǀyȟOG~b9+R#7 tqfm:jMKka`5zJXh͆M\feBM]*}蔿<> cj׊tH݆[8&ñ% 2Љ(Or9d:J7&d˜JoߠD0te´oq}Q& ބ6[7| 'ʨK(dg1e ߐec~2o(5'IժTb}ZQ,^<4<:!}G ?~ r-ju,Wic*9]*BvMlMyV}3^. czf4!r7H9)xŊtvR 'f\ jf\ &l̰?':JahS(zYFڛBUTOMhRT#v4ՇMIJ}Cɦdߐ>_!肬~N 'n(fBUxZh̹!T}j&>)7Q<ŷTV+ڱ']KM %7@Vg}/7ȷ TxZhD|nҾ]bv<ŷTV+ڷ']Ov0R69djG3'|]M~F涔eEi1[")/ ۱߅5q@,?M}DWAo\( I${ caK^ &3ebڣv,Z *p \VMD~"` e\&ԤCfH; 1h )x¸tv,, ø)o˜?lwCOBP`b|囬0 ?n*4!ohVٴKn=EVh1߯z{{'&&N!b͍6ཐƫ}5q# U=m-u|Vxwq\:4 rxbz3]}}ycS) B)J=&k'=~̨樕7$3*&<Y7;5Mo؏GŒߌOj #@(Iȓ/?B?<6]e7lVs!\X>씊></Н3{z6nUD>m2lVMho_ [z{^~oݷAq%~'5nr#})ȟJu?- M_:ޱ\RjKkki Kglq K-ORig-$P a;d{C>_cخ \ yd#b(/mMX!'<@p=52:- a{gts)2!{9!d(䣱vV5i>YW"TQkƪAp5d`q{bΘN/o8Y0i1OSTZ[mH;D=,ҳJOB7,o3µfOa8/vfM:XQIt;kҝMnl 9Z $2}E45Ӧz!!`E!qc@hشtj~{=L`|Oנcagm*И۶m]i"bgp 8MRVާ!?Bݲf6C܍m_'6nu6JXQf뜂mV],we?v>?tgRИֆs>[24Hdfϴ`9/wo6U|=gu;?>`t1sX/Yz#jRT"@Rb3dGDY[s 8@ ז=ױ0^1cP.,X@(lGnW9Vv{ۜbG<y,uޣd~saGifNiҔKiotכ򦄼 o*(7D.mi cfBӇIlS*?K(]j9n" "iWHz8<7$+V`HѶ7ؑq /9ᇧ 1p^LaIS=Q\?k*OZXRCKP \zpmt\Y8d [ k#gup?etjj4vH_|ҺI̡z _,,;w,U !|o2Wk]IFGA4"<+Lq-?mпmF DMvV-1i_''~7֍oVM2ē|)!&ioGovd 2"HH?(>u08=PyǮW.WMKw &y21ş~?ą? <1q <]_#yJ\/ 33B̅,0swV2zJ;;S\CLPZėS|K"s[]3xΓ(cKɚ4" Lqȅy@Ԇ\ֶd0ĥ6q!yϿąZyJ\`UL"Eղ696m,I/y_Oü/fzF~[S,mà Aoà ޟqēq_$f/A_q/lbmݗ/5p} ,T m$o`n7t^V&m^JU ۱*|4"R^^;[-kg{LzlS]6ob@@<ɛz;t^^yyG aahe -} IyFթİB7?( [9N.mFI7IU-↶Kaӗ&kߗ¦/M׾/mk}oMoپC P}!;oQopFVթIJB8?$ 2ex'O"!Y,zEhLw2Gx;7`w3ys'w 'ys&~y:_<s?pN0_.᭑5p~9lrYC m~D@<+b~,0BmT>4̺ pܰN-I+`Մ@GB[8?, -|#zc^kacjQy/H$? K6Vq 6 '@O$Onp%LxW zgOJe+*nh˾q ^{+ä́@K޲uI޲77knXkeoYx==o ߞ7 @$o~P@<۳bENPU k$j h)h VL8z(y&ēEooբ;*a z30x7 3 ߖX &L1BASݰXnm%$$Ҍ";H/S/f;ڗy2q&~u{;6Qkkx>o0vuLm[x  uc:(9<_1} #Z;δ ڴx7`WjK uWSdOԍ;S#EWXBo|堡B=Tw5gªڨBV4tol}F fWاgs: ą7~SNs͠ߜ'yruNH/%F.%F05ZJa{[]rLàU8 ޯma. ݪK:ȑ7o}KAuo-=3Z#/OAn+w'_$F5Ƒ׀yH]@K%bVZbThUH79G: bU@<Ǹmܝb#9o-#?\#v&I>e;y&@)!YP-02xp;hp6#y&;ēM{iOUB.zM31kJa==o=0f½֓E3lbO@Or\bq*e/?%vˀLUi_gxKd5C/LhVϹXffrnvki背!rBN4`l_ R|a]gĻt1Ӽڵ-*`Yfx}_ӄ%.. }ÕI{p0ƜÕ'NW&uAp]Fzv&y21Z|TCԚkj!4--&ӪGuՙ~tVF8YJMn.lJ*7fO{aa>/|e7LŘVf̂>VUi F' ĺ&ơ-EmG^4G Zh?kl,LXU&.Q!׎3)odCeH)/̦q˘2,1첷PBVvLߑT )iA㽞}N97ĈzejI*oI;LGzroI\OZrW9kyϚD ۨ b4aD$FUyRp/} Qi+B -?NӮW`ՠpL%OD1r~T]cGfԩ9bN=I"'"/}4- 'Qߗb_"#vSJ$u J'^09ӟ0YΖջ3~gYlpJ^0=d<^[YVT= nb[S;ߒj>⫄y2󟱺$n-53+d2UJ:f@gұ5^нG.ɈP.Yr9%5U׸r,OI.œ<ؙT_%,RߌU|$A*ec8 z8<Zj;Ht8( #;G.w M2b'E3\NI nc5\.>Shpr?v&%|W T7cuSI0yяX{e'Yo(_ t Ts:|󽑡GKw8&?M\WW6=|ϰIhĽD:DT2le5*Q82x-/rϰ^L|KIt*>oM̷T%\& J  ONd3t2 I.n%u\% mj`}xΏy bVPG3ZI Nt5:>SPhp$?v&%|W 7cukKzqZ~ U CQPJ%{@ucz;: nݐQǰx׀9?CΛ5 $M5 JL-VRáuz+$1\< σoI5UyX]' TDnzQe@*><D2QݠNGGQ,!S\CPBKi{B⺲qtJ qxx-p `d 5$)k^QN ANF'=DɘV4*wRIGkF`1sF_ZG *5+Es,]xjVܫj =#_+ I_Q;J_,_~RͭI~'ɇ:W[S&+4@]]\uQYWxeVEx9˥*)>x}jWޘ3^4_>ws2 U|M`ޜLmq>s*Dj5`DQ>z1ӪuEuf-8^ ZiY?wSy* 9O>$#ȩDW&[N1~0;)%q| q] y+ڨ9U`FQ4uC!@9İ1 rx {~Į,.EVWaJ_V@W#1 RNLFp TJ΀Q$K/dqǢR$W~:6&A^| SA?Y'[5hk5'L6J;z'AK lg>/$O)ŵ/ iǵk+?)CfZ$_?( o7@CRϋ$~Q_;伱ZVZTwY_ǛlpVHsz.GZwF,}z8+`kd7r=twH~ !sǹ:R#dJB -49R;AsѴ48#Ǿy:\ S`͈pl*eCwj!Ѯ? 48n$Ү4aDE3aJEޜpjƣ5fU OL%=judTkQFuLLY>;20;N˭h vt˘|ӄI 3_8ML#wi߀i$44a*1'&T#e4\i$4S]iˆyR˘"Zr5(:S&h)^+LXQR+Y3Đ}Ppژrjnxu|Qh*xaZ\᭣c)&`dRABwӄ̤dVN}8Muv >NwHcmCNekeapuZbo魲:>ޡ<-F*tT mYNnuTq5zJ3FɚR渶5wC.M#a-8_ nV]h HƦQC& ԁ FSz^(p-b%:x9Ы{鍤WǒW_!#x/eb[L#]j|ulܕz)^ "3Kۻ5`mCg v8Ҥko > [X3H;6oHgZmR/UJr 2e{*uI~R/Z鞶zfL;./*K\@<kR.cuf[wFaknBJ7 =^ Rey eȱI,{\BH NmYwp] ZFGģHG&\뛚ʅU@;BBA#5;HS{~0CLdQ)^b!`л,8׳Dc, 7ݓ2=9U) ^OԫWҌ÷ufZU/Ǎ`7@ń@Snj6rc4|21k̝~4ieN vǁ3g"+?7? <2]u 픐1WQT `B6ۻ} 觔)jY-Z&5};vtdΜ?q%Q,*ݤa},go]ģ+6*ՠ\ )ľC[Xfm]X+tJ^əM{DL>ׁ^mD>Ita /ЬQǰ'fN ?Y24Ҽӡ "&u{K@lY4f1?CEFr0G5!K9XskhZB5uUIwGtɺI8<<l=;]ևHiO>:Ǩ%ey0cyd7*uM; \xscW'b\e,ǺЂ ̋F 3\^f9O nr(#*xV+"#"fPĒ&tسgOS`pZqFA\ [$'qcE#,c;dU\* `pKZ؏ qW08a+ NQVa{ HMi)~SfA<1R- $sPa9jX1dXӖl[]iK5; 6e4l\$QwY UM]*|]BEpDEEr!\x}{0T'KTbC*FLT12TPjZPLάfBO}c<1v^WMI7R(ҍ? cLW%T##a&u Ȭm)Ў8})h) YMlL@<[kB*FPFpVKH1aӀ PƆ#xIebB*2(㲄sqY QbV5S/w?g\u\ޖlp9Ab@ 6T3j8Ő"a\u\j:|gV1 $F(0pc<+̘bhH\ m\ٖ:++R]D G}4GͰ &cS[lԱ-hF 6G5RѠr4(iI)ofDam3AbD#Tфmasn¶&i 'ia>@ ga5ؒl61[%>2T(UUmN\}8@/Pd,!us5quº:]\ }V75JR?[Ba@-vlNQC"\u فkێU kB>nfiZ"QsT4GgBZP]GM@oJ^G4}dM.=;. )PLitT\-:% dۚV, I%EohOZyH n՜}nY/&tWmzܱZ_H,^M臢㺼9{z̘؆S+ΰ]:>n Fh9zͷwǎ:|;GxlɍQtgVh9e6WN&t;#~3gP JS4J$K* R-1 Lԧo3}1[2-;83kstjQh? ìp7^}+=֭ڜr*aEٖ{^ljfq([^Q;3ƴ6ܝqu}gݦmwj,yu{[L9{6aI'Ú11 ܕQ?Bta*>%HJFzqZJ#dNܭr+1缺JB_a|eYjEi%HSTQەm{+sn*JbHH:{Ϲxj3}1YӘG;6K;:Ģ Rb BAb+ýRr ABa7]D.lZ.%vM>_0~~`; fvBBud1RdVHH R*?PhFm7!TM<\w B E)k YENmԕM8(^N/yͿΘPܾ?aOLI)sZYiʊoSj+kT$TYbQnPZY~v9Ku klPJR.5J?MmvzF0"T6m1G ]yFrc,nmz˿frRFJ[ Rq[I"[}E ~[s]0n| DQyN]=)L@o,ߺׁ^%uV{"Tג]!j7wB;:fe\Ņh© 3ijH#1cJ! 1m%JJ㐉P]tڸR<)N@T_J4)Lw++bI )v%+됤DbF-.}B~(5/}w^rhCTqoG'b,4- ug@/VӦ\]WR-Fy-K5[4j4VŜɻO JX{Æ=;ޅc66^m8%0* mA탱"֟ TRk[ҝ01v\mnk$j{7ā{AMް>$oٰC0b1R`V˚X8~̩SIlbxajnX~L>0A^,3]6Sam\̂o~ {A&o>' m#r !WP-b1صÞjdt+,n{E͢OG`ׄA]}$y'7 'yaz66^k=?Ye{X6+Es,ER8̵lvDS l2]xo„Zeq*[p)SW =[$pXb7/!ZpUҞhHK&)5X4ɄĬH՛jcUӎLe}\gWÆ%j~X]PK]5m5O@ O]1l "xDĮ8z,@Dģ]C}?7bR("%Q!WOZ9š[5E~@`sυm3f4/HFqoآP*0ijLsȍm qx ńz Ķ ty2\@<A`/^ZN*A v]AG_}^FamfV9~w2̂G/h (Qe]ze"3#ZX]MF࣠zzrac `]n1Z0Hl;)@b\xb 7 (&^$L0.xpfV& 1o e̜zhϊ4G_|T24EIǘWO:!j#J J$W)D?b L1~+Nr/^Z!B캀W^ͫ-@EU;OH{@ߣL2Бy8Zj)>nH @'NqzB##_.wA&ٰr /^Z:@W!v]7FO2xWޯ.Uesxdv=vзH;w+Wj0Gl;)8b\x?)"au{5^ .>Sνx ;_#kܫ *dBd~EuT9QCLz}&—? Tq^~%_JF~# I7޴S*EZBӴ2lHr~O)j0vSlr6̣)Zx0GbT7 Y*X]yWo}SUU*GUE>)u*^$LSF캀:eop,9 .[ rs^8ۜN/llɍ2ISIgf6?3ʬfލ˗w1F6FF!x Ws&ZHt좌~C?L3%A~ $ ћm" 3sKM|Db LM$T&+e s>|rf3[Ϟ]8Л{y@Po2웞{3s  [\zcK哬DSi2:~ރlS8h3ssUdl5*h joV~R-|ykZZ\5aKcu,{׌c'aU\>Kt&JM E^?-?OЁo!(٤l3+8MRt8+^p%m1Z WL{FB7joiL` 1X6&BlQK O{%5Xa }cb LoL o\\"a+Į nrEup;i$\f2L>pcZ =0; ZZKnhU1\W FOƐME9%xҪ| z> PJ@?/0 2rG (e,0iV{.2Bu *g!ٮR 4-u^:_}.J.#ߕ1!2i.xH\ uJg( q] 1&Ô9iot{*GOSN`]_b\F}"a#GĮ <9":r4 N}tij_gJ?]7 nS^ئNW5KVWh`8h]6+KYmܜ4*4$@awIJG~Ԇΰjy:L5_2yڈtfa!gXUw6'}A ٬d垞 A՝ )o;:E Lh>̨BX-TE^R)UnbiF.[\鲩srA-vGIto4+)سgGV>j;cdVN0 B0V}p/Cƨ O|J)5blV3~e5…mhjfsp'0u`To1U/sN?"LOl;)vruHa;3x0>>wX; 9ϜNNg|T?əç"ᕠ߅Nm7Y77 Ƹ2YbeÝ᱖4^> 4< L:vu&]O;QUG; 7s^٦갿#hQq9o6*&`t! o{!X1I~?m-X1 <&>򾮊z =FL\ƈjd1y >ji=6/yƆՙ3^̤ItJY8r/o/ꮎ4r(dtsLmCwbwޟcJ0ҵR6n[,BMǵGk,W8`ry/]pQ"?*:N_}x3 ϋ~ -2+jP6+Hj q] 1&Y RCC]~ag8"g?+#HD BGJu)?Z#e|\jLSv )4 ڸŇxl Th{Q65;& O5f)~{xQA>$f_"LavSm&ģ(p̓A54"Hl3$F}m)6}|$x^6c)6+#O7:#Q&TDFΡOdiUK$^$LS͎^֤!=+ޅ_&<_o j¬1TY%B4SZl|\jLS<۴TVIFiU<" eni4/I~ӄE@n\I@V#Y_eB 5ìoc:@VdM f}EavB[ھ xϗHyHj"1j )i$5j q] R1M۫g}s;TCTܼ/=|zL+ڂඌj1*)t UqWJpTYFEMQ$yîS%}r( \PP /&8K캀/x_[Az7!W$ xYF|D2Be$j5r OZZ$r''Qgi%y[aׁռ/ [f#Y%bJ fi$0g.f՘kKMŚ^r'Ip` ˁQCT 5~ӄikYa ( ϋp~ 2+ jP9+LZFbZu\׊Lܬ(qs|KlO4)uAp]Fp5R[5B4ObkG.)՘m,¢//K% ܿ| Ϗ( S2JP7+L1T> ])4> DP5f)~iVXE~ 0Yab LqV/1+\(NP /nQ .m.Wh_j^`Ւ^fo ?2n;r>rpOi[{ʸw`KTb 07]3xԪmZ6gON;Obn_=]c)Z MTژm NDLs)UÃMۧ9MFWrx$>i5ebT&TMFbZZlr'eSg1KaW)m'0>0_.`l}Q r>K"a}`bTL7 ߢTKL;b9F&K>6qlӄɇNK' 航^ݫ'' :O~:zЯsTx*aϻ^pd5۠e Mi&2&7 ; Q_sSw GYdQg MT_۷rPޖ3_҆59wp0oto=9ѫUۚ6YbZIPw὜&s1uf`}RkYkΣ{Рv({ioY1*}s:z-zcάؒ|d|b$;!#wI1ebt"2[s 4S/Ҭ#Rvtz/^&ģ뢼 +|ڻ9MD 78MR>G8Mn>I9MN> ܺw˧rzfLwhSq]cs6`6!qulMtxljĐK&R65"M+b6!)_|+K-FlOvS=7+Js %dng*e%{z,^Ԡd[q+&Nw^ԲMy ~AQP"FF|f%"ng iURpDUيn2kѶjwFakv_' {" )^ X"Ћ-0#QꄭQ`x0Į xemwInhT6T2gm)Su$$1Џ%j[c\Mzhofg7fA'@\2 _50^3lB>V Vo2fƇG[߰?w3k{X LLU K\R6!yw5H-͉!+e,VBg=BC(!- l)zOK㭻r+?oeEiCD_Zw k*Vj?گ>i Q"F| %Rn'ԩhQ0.V=G.]o ]<QI%.፳l0ՁCL UAj1ZӮ|V*|*+tTfV.0ALtl 86Gk|-#GQm1 ~ӄG eWjt0%ӫTU"T8N# LliUKpAVinO4ƈ6 t~Pւlk`"ӄG0 dWL2^4X**/t\U깹AZ5b@UcM {ua~ a~J(m_6zcG' ϋٱ!8W=Ոt2SHaB},xoU)12FHEf)~[}}N\F𶩏RɚWM,8 :+^k%La%/p˛ZEM7)NĮ "+Xlu ^:'@LUSFg@IF._Y/nZ Z|L/(2[igu,~ڙÏw6]A[0aV<['hcV'ʌsW;9M9lp09t{vj9m[ p0Ums0}8MQ_rI#)qP֖T=48n$c&9nZIʼk=gJi)6luۦsY *NP8뜖#$ԟӄIiˆ&'B6 W)Dm'0Ş_.ڞ–h x03]pc3i m,i- no#=1ry/ƒnR[XFQWCs% fZD.@Km o/_>ߏl/e-b9|pCUU'8MfD4a~7NGX_Ӂq0Ugn%U&LB__ii| &LC|NK 5 9MQsqmEIvYB_رrI,$U!N&!9Mxφ4a=szBφvS٬hlax2З'Į x9h;ښ*J51 ݳ ݮR]"/*I~W/kmFjB?_$SG։=OSΠ:2]*_pl uqNOodZSz[99J),aӄI`]t%B$|- M!sZjI;8MU{qI_. i/ G4a*D&LH N& |W)m'0^ _.^I~+"a[Į n~*nIZZh'ʑLo;1'-wmI0Il;)Lb\@!s5 |-4ӘRژtupץ뤯cI74Ea=ux0Ztp:x'aZz^V_^l]9S7]W2g$+A2 | ~T:>t})j}r\,3a=)H=uYGT䏻#-|藥Os0?C<{'+_, eP4\,9-8QݯI}x$cQGTq#x"JڤQpn:8O 2^sB;8RCKKXDޔ c4(8ofRDx{\cKNX }w5!K0%rPqDtOULE7>{"ULI|beRp\Z,t\|&V>8^X8o/eQ ;>!s묐X|beqVʳF3yטv5eg>TVڣOևo6%ubo'7I+&J8„TaK%+4tqqlJf ܀(APYƱq*πT4E}yПWh!CQC/BdEIp&mrэ2dt;?u#{]7Ig"=;_k$O2)#6&_S"UEJciKpR5)~{ápo[`N&ѩsZ9C/'ΰ(J=ӄųW (v=&LBY74aDei9si\-Uۚ44/i:$Iwpӄ*pj\mLiwGfDzDK5M*묇(\ =^ Re~jrcˌQps=.! z2{^@,zWtn(Ѧ ׭:{r!tyyyXL>ģ,kerݷz}BU@@<kzZuvSN cwӆf˴ ~LpՍ,/#&? 16fL:T/U' U+,yd]#Zgb4&IӢ)c.OqAYaй'v:-4:Bh@KI]/hp< =Jo>XޓՆvmrw? t㷻Eˤvo?74?p={v߿I&q?[P=cw7A'i1~kjS^cg~!.\*XtaM,vwk{ug ,B}Jk/$QȚ̊!! |9_B[C_ |hOZ5{$yzЯ!v" 56Xk304 Ao{@?cN{wn{Yxٵ{\`-lD;E"v |S@S@­*|`Q3ZQwu !{@6ao6R*{YW,ުݬJ $<=ajwzc}uځjն/oN zXh'y/B8Z.*Гdz!_N&~,?|TBBjݼ_5<  Jko&eJѨagD+Eܾo`,e'),߲7-u&N@:iǨe uќv7&rvʘ4uiӽy >R2Nk[}ve*#==6TNKՙTB$fZЯ!v'A?B C_| Sza-_71i/%=HZ.Wo΁W$[>ejjp`{n]v ٵcg0O@޼_xIzbgIZ_ڛS,RsgB/t ijgNo ũ^_7^1Y8AY"R4NO_.(&aSktf |T{Kob]RR}M  85161$ǫ@/=| 轘Z$18wPb Z@moK$vpp![W@%օؽ۠߆wēમ ֺܪQfavd`.ִbo~Dڠť^gxZ!oSF(m*g.1C ڱ +&"V$|wؽ ^r o÷@Wה}8O {à?9;;p#σ2lZwv T]@Cb[C6o'wē⚮.-dSY9޷*;͞AgSehL7;@ThW0Bxho| h@ekacH{e*'b7>!! LEeH) b(4ӊ!jJv3W~2\۲)?4;O/7clTHীb_[YR3CѢ9V@AO>BAZ䮠NI-!# vuкN;v.?*j|!x . vLAؿ[@ԌS:-\C"h%Kۮ=.3RpM{ݠm#I~ ǔn`oΝC]s9&~Ƈ4?7>G}bM$-Ƨ먦9V+ ‚2;Zmq*֪z>icʼbо'){6 y?p3Zbw8z&օ}F]21`UZbBVH߮f>M e@?L1WjZvdmIM̙aqHԷ? :=iೠS'үȳw [8۹uڒu@;#i8Oj9e59NXFM?ht{NY.ɳP*!R'k5jjCNc{d;Ymc<I'tF0On0PCAo}{|V(G5޳dt]TVlRh7]FfdvY̘Yml4>TxF7>uZچyώChњ,PNZɲqņЅ2 @xhoPapA}eW($-͇𯚾8 >6 f!glؘ!R0os0Ƶf5i8y9_.'2JrL9&=.afze5Yͻ&ux{Oxc=pH c \za6b٧g,_88hGѽ }} Q6hSF)|Z򇐅p-赑~Z6q ޮö<{Zu> vM6Cw׈}ѺkY )\z2,˟2fX8k5up5xGnxh9zͷwǎ:|;M1qrkT&3ݳ٧?uki͕Ӵl?#~3gg{IhI;R-$ޝ8O0g8;\c@VӽO3F9Gah? ìxf/ھOlmVmN9xĺ\ljfq>ܪO5ݙ4\ַ?6(9?ӂq~:߽-TY&{=4LŠ;r;~ko̗,"e^"Q'՜ ҏH/E$4ܟјú-BnDw P5뢊sDOZYiA$*PTۧ%d^4K GVAy@oR4El@甹yӀ}{yNB+QVz6v@$x*I{_PBB./+廭*v׏VƵaV5dc 8 z8&MݩYRZxAeZYmrjx;Q!$j̱ͪhSfa5jQҪ%x+VCf V*jf5([4xVl,ҍ~t ds)2QXB8&c=.8MZBq1p[=&Tf_%r*F5&L4aDܛ,n5} 6!9MwC& 7q]nU6tCon$w8Ɨ,H  z`/^e-j' .mN]w)C/倻Alw;{{AU9}8}$Fg%OzFୠoUr8(ODVѦznR+G'dJ83uYZHɤr>cdnA0z b;~ONG@$xO ^1XK1$!\pM[=ْLfTޖXnf%\+ DY~j^'( R(4_"v.,)("\DW"v~I1ؿT@<Ǩ 5{c”p_P Ĩ Z5Zs8~kQmyf0ؤqf2FZUvn5|Tzc!lx#Y>2;?S)7ig@Fa~g#?tx# 8['-񑐬 }FoD@tKRa&AK5&*mË[a "G/I1$o! ^jŰlUms'hk,턵Yj-PoN 7ޜn(*}WSZ]w lG<UuW5C{+"ǃ2O:ˆE KQumWNNڸw>-hK}hki~aMNQ׳>f㑼7wLBMƇRik̓?9f[TͬHE&ej՟lW3]( 34I$$ׇi:=dʡ+utwDIՙ)l`y-3)V.LZ2ا(RGRW}e%7Gkz'.j3g޿oq퐥44%:o[VEѵ)~7Ìi:b=Y5;*s9.bx: 5N* K]5m!oӄ#s9y fFVE Nf?1*:&II\y\& kK|3„^1oޤђoFMbhK5~^TTey8!Rx>Fk6GgC_u=XXw iaI]{E tӝ43hd<6`2R}0oM e-t`רBaIPA 4 O ǽ;H(IOFR=V$ۀ.ZXF|3u*ڮQu{Y\N.71TE E ؾR s0Sru5u5Yq*?*;@w_=@:O:x7+`Wj2=F^<[x#\Z]$n+"v[@ol2;:H@oS$MIfՒ-wr4R|E\fz)nPNkA6fu-߆n6ē|5#:"'[.q\vQ3lSaD[ F.V[7bbM@<0+c5jxvK=Y6KK xc!xc,!6\o,Hw!9-l2p̖gSmQkgM懃*~<~Öޘsܒ|$]EAV#qv{ 2r׭c[*2[4 :fNl3V1 Rriń.E|so¦ٸ?ʷL{y|ƛ/QЏsy)g$4e_?_ ٱOF7/+2x)O%Wtd}ԼWSc^K@: _O݀Mܬ=qLƔ ~LU;XinpjX; |j2X~(~'|[?D@<[ɰ֯X*l%$^LpFKLޠhmoՠ;%N 3&>3!]rMX΂0`G1PnN7=ƒK%[Tx+h¥_/Ҧf9#ۀjSn#Y LFGO>]G=ޢ1!)Yg )=|9'_Zg*~/o/^gM3&O 'i1EQ͒1ȿ1%1:MAaj7sz-dɶ4AK3Ş= )^nyׁYIГDbw8zJA^ែ%#QW~r]WHA?]1%&-w^<痟:_Ov_ пvo)j[fѠr#7Sg^2!R|C?TVK^ -l)!uQš52KV|sl̰Y{809ul!䴃VFN]P"sf:m }V ;@K%;Dy@/:Ş$~APR$$Q>$!v~ ti^jm.mrӋz.vcOݧ{/[um_6MͺRI㿾)s5ӆm^4aҭ6n@uT5 o}ZНNG1r,@)BrEQe `EYN{oδ{I!ΠZ.ty9 t\XK8G~Ҍw>EI?=[B|> 33LtHm9.›oN+8M|T0G<-lonLjHl: 8-7n6*#btI+68$ϼ*?١(6vOi͑62Sхzٮk< ^ۀwsPQ8 bxxۣTM2ꅉvnf >e!|l<~z1{eKwީ̞䍲nn-uRhxhӄV}}SSS DBA3_4 =!(k;_6'ȐR ľChe>X+ogiV+rc2Lyv@sLJG1KSU0M>L/Q7CNԜa+oveiSO$ϻ" m.rjxN y~ I*FR1G}muf'm߱w!)4@2q2 ̱wht '+Bn:dLR7@L&—/|DOb pQMkslhUƁYgw7 t ^(XJM *堥b[MCZ=P6Xyvvp`zIೠ.< NW?s)S/vj y~{bsv}_A;}Rۻg_}gLnrک};1"c NKm J +9Mt@/h$-W{մRfRX|ANݜlr'0+YjK`[9ek-szzvS<;j:jwƤQ{48 +tUB~`)bW> :e`ZZiz{ogsvz>3MxXe1KLss{j<=x2ЗJ=痻[@KP]'*WE%A]#3tZn4l܍"Ր r5m%|T%b>0'/,qZn pu9lA/-FIbJE褜=TMr=F7&c+{7)[ ȶ5l)Ap$o1'@O(En%$P 8ZbAc,&pt^9"sbDmiீ&3愝m#>%c2 0'c2~G"n/Yu1C]ˌ%C+]a鞬Np1J S?Mƒ3*W_cI/W_pw]t K8MNà/-8v]@~mYDC[l znsfdkҼ(8N ]P*!3guzz5ád|{dEJsحZNVeDjs}Rd urЅ!Ym7jF2YQbHVЅ9ZTk9e=3cfI,o!$m7 _Fa/jm0Br ;AwF%G2L"@n0qR3΄55]0w@Rpz !5t, ߟZ?V.M( '"՚/s /͐c'uy^toQOMV1ƧnЅy 6y6x"z9 ySnoioi7wj0954}Ԛ䷸'x=$%zwA|B!IJGG5UKU(q~B,, '?s x dIƒfK$|t,|nT2+b/}ftmɝwނۏOC]syuSφYXRf47+|k?++G b{x$Pf,-U3-.%Sow:$iUQY \u9iOmߍC?YhaJGhW\  4dQAEEvM5]c4G棼߾WӴ%7Bu+/.,lyw.1P>"iڍ Rö3rYh |?/$ģȑI_~#[ _o$A>lq^Zf.l)Q bdL?McQO_$Q.op˥gnjNYn)V9zͷwǎ:|; qrkT&3ݳ٧?uki͕Ӆ ΈnZXɝtXܜsTˬNԧo3}1[XӽO3F9Gqh? ìu/ھOlmVmN9xl,Ɵ)fp7K&nէ{GݚT pw.s[XvfNvL Y"|lSgM?sl0+F0?% ko̗,-7p¿+ŸdGȮrJז"+c[/_?߰R P`YgQZ -]EƣH+E\9z{ۜCXH:Sz4L@<S[ M=h^·pjUfiXT _l pjvu/55 ]e#bnҼ'oЦ\ݬнffڎK^X4!9ߙV?vma7SV'= aw0nG\ #G# 'yGwa8(!ZP#c?t r3V4üdLB~y!Ǡg^o$ $I3aƘ_$d]m,  !-[,ցp"8 3Iށē] 8v ۲] 8zC$=/t*lt |P|ߞcfH"~ܨ^Y4l3Ds|y^7gT˫ wK_wFbIaupu8ߥϦqֺ?hwgYQ't{ϸ k} }OO)X =aI>eh@Y8?xm­NeږBͦɲLN;fI] Ikcg0/> e4UVk$e_WF*b ;R WxwUw5UT"OjhcT SB.HE*ZB3IE%_ | ci-A?D"_ɇ-b]'ߘ|"oOa2n8#5 }Fv,YZ#was; n  S7bVKٽΚ*D?#>4~zyσ|dZ,s W@E^Z=b{2m?"+"[sbܡG*G '[v@ GD@ 7|@x]'A{9$#\-8whu״Eݡ5{OKJָY`Iл0X x"`C() YU1]Ec̬0s2;_zR Q_Z.o9@L{ö4$/Zؽ7,k]H_{K^$ #?DB (&ߴ 'u?7-Ii5-KuW9:bs|-Ks I #ElGVq>f 8xxAY. @KmmoH> aS?+9j['> %0{ $'Co6ާof&6Ԓ#~KdG j΄U+QC9FQc67obW,wn-Q~C?L5#I~ |sI$qG&0$ط7N`i¤8b|1&q02 ٺѓٳyNn3pk6MǑk[_ Bb\  Y^| ğǀz:Я?fNSJ>fē|̺۳jca[z*$1:g;ˋHư6KRjmJ)fЛYb- E҂ & `lG<ޒ*OZEc^)vQ5 2[G85.ݷ%z1uYN2-pᛥtAbJwa+t 1#?Q vG:h=q>V aߘ6Zx]\'-o>3SrqZyⱬ8:*Ҍ6iZ%3 bLF2MZ:5QTh66zһ1Ŋqh$]zy!T  a]xvMh[/KzW42Q& +,ݿ/!1+ <'lH"kرӄInմ?`g}.7"_q9] 䭕Y-r;eڅZqo<SV/z5@@YG+A$ 'I~1h5VxG+Ǡ6i&UdLŒ[]:ccŜ&L:csd,+Yr_R!a[U&i.n!J.^%\~ָ9mĚr׷K5;:%z$,/2:,756y3ousG5ބ2E]s~~w"[FRtSih:4hi¤CV: . 𵨍ã{x)vAOb*V~^-iPZBa7M8g~,~!v5<"9. t <eκoSqd͠x GFc!h4~%WFA*9i /tܦg@>POvu ~YB _| ۣ/${7FFJ}O~,:Ϧ4_~ӄ ēiˆzG"&|?~ӄI(揁iˆ- 2\uT< dU\6O Q5E]faa=a݃> ŖX#q F_#ʨ@bOr-Z%%EN2Бo=m dX p d4wgr /z9ޤ&Ą>i0`9Y C>$$X1I#ﺁ[rpvK%~eWky轛Yr »#:e1ben>Ӻ- /UAg@? |7wG_r6KmZ#g3:Ec64N82ku?k9Imx.#^Z4کubMUsNVj(oK'd,=pTdi]54{->isbbӜ\ ~|XOxׅ9 IQ,2}?Me|=9ݞ/9n9uTaiëoVo[[6MzXȄ{@I5X$7>&v{@nj^V-ֳn$a)ЧR͇H肖 ZitqGA Q 70 Q.-5. vlGMaa?c eFCO>_ |ɨ e_t8D3IM#]RYS5&瞽dc8>gaQ(Ɋ8F: i¤[x ȄϏ5`kn/?FR\j^IX-5^o%$z;FרSAi2C@,-D^ہdؾs·Q;^.0'Laxv *R"[X7ע'm|z" y}cTK2n?|OS-ֳx9@츿JMoj~:^hwD{*b]OAKæF8Ѥ"pMIΟqli4[i¸[b 8iˆB" wrPU.1F 4a:ӄu2埕c(m~ KSW"7B,X1DRf~ӄ)Hi$S/q0gIZ^nc̹.mD 8FٿiN/s8i¤ܾ&80LI_F,r( $):Irp?; ToY"7i3dX7|t,kfۼ؉zeq_@c 3^?gt8zk?ohS\& I>iP3koK9ӜVuYYTV ̶IwveV{8MQ/++VB${4am^:6 S!@u룺[mJy99cAc,SvA'=`tE6'c.51&n oԻ^Z$){kլWJk8m:ۯ4a lL#Y;8.ԅiZNNKvoCOvBG.sZnVb${}r7sZt֩Eu”Q;i$;9-FOU$k~*+1GѬ|.py : :vp#HЁHб#!aؼcª 9wNo4aiud&mnsa)5:'y~+p3% a{ւ#(-$@(~#v5A8IA'I>d Ӡw7h7(;Nb]$FI?7z{fߴ^F;W=-79zS&;*~ϭus:Ķ4<p<)5}&:& 4PXG+]ް)RmzΩ>Xt#NCS C^N&j*\~8tլw]_,ߟK8R,sO#WkWGXV,m[Kzdo&[α8_ڂ%΄n2u,tԎ\Yr=^'p0r'aƴws9x2 FyneTU@ӄI77 ˖,M/Z($merlݠu9j>̂Ɵ3-^н5&hDA*UʠR)Qppd|Hc[epꤷ'@Hju \s g5O!oq6eXֳ=Sf=+ȥ PS ,0'v ̥=8zWAd}9"N&z‹9#WWjQ:*1ڸ 1gR>bL76*%8MtqFdůylqVZzkNRP-{_&*U2VYc:veK=,;SoL=1Az3A݈!!N* oSsIg\/0\T#v|ϥ0rVILY\iTұxtu|Wq>#_!Ճ] 5b@u5k?'DcO/j%t@&Y-JF+ 6oGUJPҾÑ~tKkDY rݦ:k_ӄ)yR:en|Tx P9MQ)/h!^F}F}) }wB'$T* NHnvQG5 Hϓ&HrS}{$zfЛ7b ;D"lnMndGHp7&zOd\-rr;ɶx{)m(GC@}2=:@[jť&/dS>6e48#t}guEѦ%&4σyS ֧ǼtwM HJ⮈vDxOZ94SҜ_i̩}6NGwqz# r0 ݌ &K5E4 U7ih4aʚӄi9kOqZnv,ъN&覚x۬FmQ8l|ŚIB7^)*=;sP$IA&`)o4aDK?ݗIȠzx։ML;ښ]}Фh͜KL *o`9([8.E;+oa-v O[oJ\wwgIz܋/Ob܂QM"Jg5V:pBHhf+0:'#g1Q=6#uēcƱqqwj[,D^)k뤍U (Q4o4 h]oq^5YG%t@;);*r"/Q |1G՛Ӝv3d09'MynuWw { ©Z[NIGEz| kz 8.!5]TȰ dd'8.udhΗ%ӄQ} }Nc=5>xUu5iJFphټ9f̄[.=7Չ3gV=l2pS,?qF(e@鬃X9II)8*e-PA%~ VIGBI q2-g^Aѫ##5W5ި63U-'u)bE)~: Cn|wi5pRE>Z^K"2X+ͼkLv;Q;!jV@W%,i-AnKFn5V-#|FTTU"]萫N5~hkm<ΐRn ]2-7q]1P=$tJ"Λ@K |ۂJFFp5^j%B4SZgG.I՘a;)~G9,)ೠ.chcρ\d7N>p-VӚ`ƦӈyG4o9vʹޡ< Sw7a @Dr0'JN;W!L/} Kx7S0pF|FFp5-1ZyPT"RP>j=J n@,o/o+qwŸ+oe~#y+mߖLsFA=v4pa1ΐ ?E"Awe5$m, S\hKuwm0o[* riChj24!Ko(c|'iBa騢ȞF D@K8.bERywS,#eɩ@͛: $q5еdRN>yZѪϽ )soYMoz ȼu ~t?1EP=%aIԅO-xd,xȖzQ#4#{@ߣG9M+pݪ`땜[-"g}UpJ77T!/[-o> I&6Ԓׁ~]diU/OL⽮!e-;|tDD#>CT>F+Ygu]LMxLКSv)ޥfOqT:nuSH,Ã}# D& 'b\JIUי1m wTDx)hu+OOMP6\5h)! z2{^7ʺY  -QM~655 ̃+UgfijA&zCQTy֮LXv@!׭z}Bﲨ<ʞ V+DܬvON CVDȕz^q#cf~RB̆ 3TE[qcq1k̝bYA\IBg@DV~G:igch<BuZVDdu de@?L1Wj2@n`Ρ]}''7?3gl\IԷ? u7iأl> Z hN@ :: 1]S`>/%|x ^ Z ^Ze)-:R -}X<znu.X͂I@*z 蝄8 c15X=p]sI lFgv3m63p;*4 Ӓ6f Cz^k .Hxie,k)=0ZJs'p ROj9EBP/QR3b,x*NϘ0JLQwsh6?gc5ۻHoV]AvP/o:V-uZsM%pY^$%g==ez) t!{ }TjeaawSKUm4. p.G1o}[",q,I3)VRwpbsa,P&z_ 2Qq(9aM$\PMb[1Z_9йBiyfi\mV `?ն!4~S+G5Hf2Jـ&hh-Wjt3w e.ly``e}#tlëI.Ϸ:t;S5؟.kP;AߩXfVQkԘ'MњEݱ@QC(k ì֋7z9 -P]kVJ0̤' n fYTO:.wE.U!nv6OA<«@_By}Tm~ilV|bF6,֚.Xr~#zK ~#xFX LsaΈL講ݿ+@t@ߐBu"x:/,Z_ظ` '4+ovÎ~/$5*ޯB4_o(nZBwhђU8D}ܪ襞ư2 4Nx ] %ry%z͵*E}=P,g]&K/0LZȁaoVNT MB:'T7bj?o@ •WF_` #>y/‡jC =Ç a7Ȃ^j$&v7C*AKr.*Q?(x0X10jSzI7=1'<`  ]/ W UZ߂DAG_# o> AW^>>Q$xEҞaM9g2t>\}`-Ѯ8͛wJ6_ʧ.C3P:arX-$\7DYrg!ѳJCx?x Lxn.5S kv} x>崍 -ܗ!aC_oT]dt*'L4Vo]jqG,}( ]R08>x(_ 1GuK  C.a kVIxYRIsx)7mB VŃg ;R0x}; (g uZsчxS8cu%љ*!Lskv a7Ȃ5 ;q.3ݣ5{wx!d&zO #Qa#'{PBu܎㝇qۜ ]AG?MtcULѝ*;3\ʩJ$߀J3aSb5D%%_WA*@hAtmeVug|jݹl]p+)DoD{X{)5nxug(CP?rOԻZ(K\a@Qo'+u/8t!< ml$}; s( ]oPT#`!fֲZŶw3,Xa%߂lAoV ;Eđex-!۷y)-:4OOխRZB*.^\P]|B'CۨRΟ 01"􏐝PcHhA;Rh }T0Z8C˭UۚU7&BUlhhEtgB6n[7`Q3K 2LټmbݩŸ2{^Qk2|c/( 1[_N3nW=e x`>950\y9͈AFLozWP޵†7:m##Q&) }md!\Z nțC =Ț8m {u̾Z2c 4=>8tq~" f98~gvPQ%܂W+}^~JET+d$kUrvY2KuW^P_igo}|K%9>tRhH*d^_|3  wq{ o??uf¯z-J6ښM`A/e=fy^9@8O z 28QwB4>ˀ+@%%ydaI)_ E 2EeR)-&bV@ט-Pz8v>N{;Ό%U4xxbh[jse[>j뜂mV],wgV}ԭL1 wr}>e]giF1I8Em٦2ٛ~٠AVܑ`Ɵ~Ú1r+%K/~PF^jN "H dGUY[s%ӌk1JQ1,b5΢$Zf$ƣH+EꀼLd5HfŐHtő~$ *rY𒵔h<yZ \ ZGْ|p'VCaams}ݪ*oa=-p}y 0:r:Oӗ}~ 5L!ElľCh+84 R@<kESa\uW^-b͒"BU<5$˵>}?yNB#QVzvA&x*J'eu5&B@KƔ$@ku763|sQkQ4|lL>AehJEڊ?*>Fv۠ Gj@4}·T{t(Y*qױ5Hi+?hs?G5@˺=nV9՜aOֵ=:p)7N*RSWq}_":o^iˆ:ګ؋Zۇ9M6Vt랔V_ | k9MQ{Bjի^rf$4aܙ'a' <7BOW5]M'a=~t9F%F:q欷-29K>Z9e-g.̳LkgԮ&6Y2λ 6A9lA9 ؖ'YYoXԦnWp3@'T-ź|f=AUMvS `B<$Zj)߹iZ4aK cu)5ݻuܛAʼnoB7@#ahYl{I{cAȭ=P"F`Ms{ (.tKN5 R^)5WSBrgLQ"O hkָQ1LwF6]ƣ^̺K%GfpD(a N.G>E}:u%mRF862+i$Ԉ|FFmB7{;j 1r?*2M~ut#Z;WNG~ b>^ n]*]>NcNǁo4]2r JʿEUKX%҅T` )Oi),8u{oCWҼҼ;4.T|pN US$&V[ptZjY:κfZAhmсZjTelUnQ)jQ^2WP2'@?fqSV k`^:Bh$⑴},~{  ̖-ƣ5˔fOCAZy':)LkITq.k{z}ģ*̘6„; [ )mq<&GoUۢV2gBjw*4ĥe ]wE7h"mO.ʅU@MBA&5;HS{[֤N_du{R ľChwYTqhX+X"nV'e{r!ּZxr^fZTFp#%ûBv%TLx 1uVf+֝9f5Nv$i {H8pLdwHFOπ>LWC;%y 8c*:ؽhO8Uf' n-D/>)eoVIh@n`Ρ]}''7?3gl\IԷ? u7iأl> ZnOmpN?' E_g 7l:@Rla}ZؕQa>mQ͆ mEEr斳X-!:mɬ `\zBwŽAK&ۥ  @_$xcSȶ M"IX\Jopڼ,jtà'cG@I&71% x3hmbT.KHwn4e^ h6q !R':+dxX]Q$dp T2VaAK4)oIphBft$nj,LO%90kb* Az^w C/9V@:Osw[b!`N΅*N<6~ x"V!eTȒ5٦sJFb~ fuwo J%<P^]pˇˆlc{d^sحZNVeDjs}Rdon0ܫQAʱ}T=w{UShS׮e}ԱJ52!f9nhxŜw6c6]dM˲[6nwG.vfd9̘YfB:ڰ"V.V ZO(w=g .vSQ}D"Ekh\hE.6z J@iA+t;/pw0cQ՜oը:R׾g% ?Ͷjbװp<ӓՆk<5Z oh<3c G" 1[Zk'W)xn%j|Uu ^DQ[+_)[%7r潄7JC;͙3!eOm{YV _+  wpBd8NYD{ (&۱y׿j9 }-zPx!+5B ELvhzi*$i}κ'>Ez{U DX8tGN.fiqŠ/N@3Y,iuQvKeG.o 4\MD|1E8zH.>$l1H*.OZϺ6Ѱxk6=C ̺2wr#j, "+eq&7ANw#Yrw# .ݠVˬU˃@Z(QZNB%`tQa&v@/Ҭ,TB`C YYvZ@l*m( U!Ef"2Th lm06xcwm{c_=v3s؞w"eUfx282ވ{߽mYɧiľ(!"3Erը=OM/pS137C\>O[q,Z<@]. iO߳b-F+V.NAP6%Zb#}m}?֜7jBʲ6KTg^2A;k:8Y~| k~U_o%v/F l.%~_/A2yK%!}\̾>׌sI^`|;@߈si{o {=A :N K^t|{^3mxcM*7CIڷ"DJ`hAjX :x Ա@CA%6Pj A&]"Z[nD,O)ԙ_Yu C|KB|> Z/piWC1x\#wq^EZSk㙖^K1,+8%cV 1Go9VѬ9U:NW}~,/٠HU{ȝۀw^Uw3vX731Ut致i9)g@&%= |#:$£σ>y̩'O~:|>N#wVvp6\(hoV]I%/%J>ޯͱ}񾷾LMA^4bg>x/{= BgI~FPLtYg]w-I.ǒIJR;$D{&|suqWA]5ok#vׯzW q%ڤl풂`uarfG;O+4!ChXf~"E5HcI:jBr~Ay%B\EϽ x,{@~E ؍e{ߌ2i' ń;e4ʴb#hfz]H i%j|ɨ'oUBȌ~OMI=C* #O7Ϡ܁tE (y)6 ĶlQ#Ձľ| J۾t(Qras &EYo0tŏҀ Zv>N8-wCn7VзƏq4__PUAQ:[ ,>ӥc=r %ĕ|8Q3ʼn" Y/pIWqY1H+^_B9V!yfrcDZu,уʼn{:,H:WE:ŚsbP9۱ӑ UZQFsPĮxCB\;m9mz+@+mo!*Dy궙)m 9eyk¼ᢇ;Z)GuX$~`t@b6&3|-%Ӻese+hnGin*N)1LFwTl(<# >mZYĚw=KI5_~i9T,%/V͂1}1'2UЯsvW'I׀?mJ9j̿ 5?HDLB\NĈ]砕_KĈ/$ĕ|"v0gm\KK( \w-Ll2D :x-fXee&=# 0xw~WOoW w>jX;bf䝚_MwQ.A_^wK)%%#Gڟ>/m;F.ff@Wx&%3?a-4r{5 TпϝBGA?c.bq q%N c|Q KA^ಮY`ŌO!>,V3/x@j^/ WP9mqf1B;+}p5(i:ߴNEs"|7-bM q%ߴNCs:M{"jUNC "ԟ/w7^+fި6KRiS3@f* qizޱP-MxiPaRl-'@ P[1/r(t[g+K9kլa1&m3lFWr>i[kWrbAC>jXrtE/e T "!9)֜ /}f 48X8a:SOBlCoa Nrǹ)$}yغK:Y.ؓbcTcCA9ê$1%ĕQ ǨN6.i;ke3 )gA(BidVV٦{P?3A+櫉)@+gˈgz4h]ov+=K Y 6ˊ if"<*f*çҫчW:6[~äHWF}Ŭä+Rt R)xIUDvѼXuջiq֔6smq֔^H5Zliz-z|E[MS(($|6< Z=o#σCzޱuV'B:V}z]ܻTUԫ.K˪VrZ^&ptC粒o$;֎}\ۑ&U7iIIؠA#H1@caX)8ҎBbx?qЏD'$P[O"FqXzʕ# }9R.:8BZq=BӐoo4_P˜"_z,:TrvlsK:U>`iM#(1|yNZ8ɼ;]MIre!W9 a !GI?ȭ'ji>q a  #Y}9 ѡwT#6Nu>G%k  YZZnXr7Iܴw 0f9{F&=nQh>CٹM #X3g :81qȘ1`Q @ݗ,hBM]B[#P3ϨެXoSp9z*jhël-bΖfUcg?2഑GLa?UФ-b-ep`]OArljeqnQV_8<5&PF™yk K3"ITҥ#F.jҨ6/,+3mUX˘FsMG7=a:WΎWۣ5Z.VP8~_5+^lGwnJ~SM7y?@Zyh愱6Z5x̯|O(6aNz~% b?_B\Iq6^s61g9m{nԪbl;#ݯW$Ơ6 Jv([aïou b6J\bš8t=`QGN|XBR0Fr\^u\TlM[l[QunT|a_.ߗK1EyRf nj(O"$7L +#Q1Q7vLvBe 4XQ0arƘZAǼ5ƕU+c m2G1ɫAHhP0~2AjJUJ$"蔾-TЩSի Ƀ=TJ0"/T!Keu|yv}A[./vŷtMj 5ux$!F5vS_tľ)B?J?|;XFLG3=ߎR4IL*dǶ}Y>ov5 TnZGL=SIM3m?hJU*!x-&{ =&hBEjj@zԪ^s 73PۅlAO%' &fG|f.;{&pJ"wE懆KJRH=>}S4NN}\$cX`Ϩ٢ڗ5.^$?5(iL]q( tet&,I?'a`}b"X wStOI[^xWXG;T=C9tZ@ ;1tG,'w c£XYx Q,m Կ&J9[mW1o @RAЃlidfke[AV[kMKA_mb7 e p$A . x+[yfa5dhє Zx,۩Mwk>s^]˺aRZ-Gܢ9z}7A Fw05愉MMwpnϗCsxv&ց61Ҹ`tJJ ]\zrlq\%}JږCmjsE:GStNWsL&Z?'ҠML<ڳ/|ļC`q+WI0'1Y)?׳Jd`p †&HX L lIyRK/eߦ䜆3Y`l .)&:;f5 \ ޅ-}aܚ(Y(9aU-ϥi%e;#w0LgX9,aXʅ)>t>.OQt~lvYؗ&ֽKЄ+Ml؝JЄ1R $x va W{hrf>OgYF:WC}o!1Y(+Jlƒ^ jmeecI=BhogJ }|A)ܳ՛Et33\D:L077JָJl$#i-OѴf68Tlqz`FE(0u nۛav,愉w(vψ| ;=Cbl<0?/M}n2+Fx*.zԁ;jWFu>ţ$bu EMk,K]qT]x Pqt052IkN-d][Э5 ȃăUݢ]~O.^FpQa#PfAjJsE)YЄbSh0"h¸YcuY~Fحv47ЪA[& LYګ9r#h¤;.s3=`LϗCExv&.ĜʖQE(6`M}c+eR*bRkYzr sb\5WH+ik PO s;R?Cm󴳅9JsDy oklx* {VhUeiK 9"oɁԊ|WB hƒ!sA,q/7QOԊE'eJƮzP6M'yJSUṇ>,#G Yz`JD o% PSN)"ݣEAlK ۢAHb\mX}SJ47_t4a{]AT>W6qԄe"c^"h¤cĥH= 0 AKӂf nI&#ֽ$mck&. nmj`eC#Q~Ј{6/CBD7 fU*Np䰢Z!9Ut𻠕Utݽ|+uw~ R1)Pqe=x.'0-h2x %?pSCDjx c>ٷ:3X%&Uz׮qIZń v'L1*܊I7DeIM)W .##oτ[qܪGgWcgC$Dz39 PЄImC/49 *y7zrcpَg  M\ uw ־'_Bg)J))eh?z{كfE" #gL:f-շi|ċvb9B {> Se'TK HUcm[uCa!tX- CǴ2&h$ l4H}>Жf?C0[gYZmӐYd_K[пM^:MM\ 愉OWш}wpϗCUWlM.cѴ gܮj_byv\q&!oe%Xk(~BK+AԖ/Z5iUQStTYjN&8(Y[ ZuwUjF56|-0:׉Dؾy ZiX@*5o#<~ G1 BI idgRY\4Aێ]J-s[^doKJGzXttVOeSN7I'lQy#̂ζߚGafb?(!:XumUQRes7C9iL} BnI[SZA]Z-3/bZ1}Q pu4wCzW3bKB\ɻQslcz\g33 HjruC/nTGG}m8? I%:iCH+ydzG46f4 Y/0~>䜽q:so"q>{.b">{.b|{.bQ q%n&Q"j|2K^`^٬ݴ3˂ڞDarp`m-mK+i1V飅)ݠl VifQ ɱLB\2np9展qlZ4(9.GbX9JppQڇʐ&0< k+X f%=9+WsKP~Wc|T| ЦSPʷb߀C{&f_J}bЧF󞝣9w2Z7?rzՖKnQO0nלX.&bXNT V˵&.^T['YG@։:/KRxY: BRǮM_< p,6SϒY._> YX\ri< ?s0~W1ρV^rU:=$W/~YwRa#q~| k;A[Gf.JNݝƪJr!7C\Č.Y* %ߗ'e̐%=MtFi QKFJuQ_ 1b1suЅZ8a^^YQ"ʄ n5SiuA5 5Kc5'P,V-p2rґWsw4e)\ƼbT7A RZM>ఠ ctPE*DHd)^آbyETUw?zE|7yJ!eL.h7|s P+~{ c\΍JֲJM|03 6`ȋ6d<tf0p[h..YM(-o#w+\PiZ -;;A֦͛y/}ߧQ9)`{[+6eM6SjY~'gצ,r`h0;npVIB~A&-/ׂ']:$r#,tTcWSg[8q%8.:z*j(*(ZĒkzX/h@IM@N<oX]I *3<ZʁNeaGP٠jnRTmUM #l޼eϴ?T(&'_WbB! %P2ZL{&7&M 'exﯙ4_7r}%H]w7(2vm[@ҁAoMm VFgBB\.A۱qtz7Wj7{55mz9YZ?CC6 [nKA|nYПMgI+i1 m't)~ݏsIZcn5L5tmxy֓OU Vvw~~G>1mmlexJ#ޗO_R"ejo'wAՑmڵR矀 +aluus3yR נM=kn|]i纈ad@^w]颅)b&.t*l[@1QOeaJZ]AʅZoi|"{w!][DC8 zT[8]i*E .$uԴ.:45у xA}eFynnp!v}:-7+5}{;?746fQD(/?_bSB\IQQOTY9;$D&!J+mrE]Kv\ź_ӠרŻ\.&9@Zūkj\=cV9߂Vn3ydѻE#R0_GboxqJbMI-t%NPjR>%|}OB!#Đ'!Jj05p[98>P Xb x%e4eSw$̧O}|InhսІsY mrbh9{z8bu,ֿxhٱ/ cb-!.E]WSJ+[Q8r*!HeGy%3[+ -hݥ}F- նF'>II,$wJ%AЃmbAF0zvX@vQTm+phR簊N;MA_*Fyת^RR1?55anͤ4h墘| S84Vz+䓅ۄ]'gQ}Y t*Ыt#< \ zu} ضzbb5P $Y#-8Q|$ZX]NƔG_-lR MƦ/V@WbЦaշreFB~ceQ JwuM%μUqZVt%󵜷zjT[qK%fyzKa:|8{p}˖e?^ 2 }^'8bOgsB,㝐TЧZq2m BU:㾘rdw sQ "DәzKOc]L>10<^01ᥠ/('? ~>Exhx: xG[I;%бlt")iFp6ZBӭ>I> IΩQ%Ef`z!#CJs@+ ιZZd},Y( OTQxFmɘ4%崂/N^@-itB;>>q!XsJ0#K&,#)ٚV*10$\zMQPc4`4Ϗn3w(|y)of£B2DڂЊE! /}q8&uZYwnA}(wz}p -?38\_p$ Rrd?! }vlW6ht7UѵDh1PVoUǖ*e/paz5^!M#<׃^ٴ ~K gHv3d6}opM5J%p{BmFo#O퇈KX4f^OӵO& Z-xOh@T,H(ShB@/h)k)(o8&bBB\j/`֯w7{O㱻T~~!YNGsj]֤/ķ4P-Uvl}?u\v C6 X,\,@,2I[J Vb8KͪCtfٝ4iuYE9׬?8**.ͻ]6bdvp%#,NN|{Ru%f uY(ҙ7UưhI%A%bW[,(eiV.[\GDdžYϖ1e->n9-ڎ5l/3Ùb<`҃,̲U(a/ި_ /g6 -"#'?XUW8,\Mal-`BJ`7tܲ&Ot*{~Qgث_=w'{A,4tmetafor/tests/0000755000176200001440000000000013150625652013056 5ustar liggesusersmetafor/tests/testthat/0000755000176200001440000000000014505073402014711 5ustar liggesusersmetafor/tests/testthat/test_misc_metan_vs_rma.peto_with_dat.bcg.r0000644000176200001440000000201514204414447025206 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: rma.peto() against metan with 'dat.bcg'") source("settings.r") test_that("results match (EE model, measure='OR').", { ### compare results with: metan tpos tneg cpos cneg, peto nograph or log res <- rma.peto(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) expect_equivalent(res$beta, -0.4744, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -0.5541, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, -0.3948, tolerance=.tol[["ci"]]) expect_equivalent(res$zval, -11.6689, tolerance=.tol[["test"]]) ### 11.67 in Stata expect_equivalent(res$QE, 167.7302, tolerance=.tol[["test"]]) ### compare results with: metan tpos tneg cpos cneg, peto nograph or sav <- predict(res, transf=exp) expect_equivalent(sav$pred, 0.6222, tolerance=.tol[["pred"]]) expect_equivalent(sav$ci.lb, 0.5746, tolerance=.tol[["ci"]]) expect_equivalent(sav$ci.ub, 0.6738, tolerance=.tol[["ci"]]) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_raudenbush1985.r0000644000176200001440000001567514503346727024271 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:raudenbush1985 context("Checking analysis example: raudenbush1985") source("settings.r") ### load data dat <- dat.raudenbush1985 test_that("results are correct for the random-effects model.", { ### random-effects model res <- rma(yi, vi, data=dat, digits=3) ### compare with results on pages 83, 85, and 86 (in text) expect_equivalent(res$tau2, 0.0188, tolerance=.tol[["var"]]) expect_equivalent(coef(res), 0.0837, tolerance=.tol[["coef"]]) expect_equivalent(res$QE, 35.8295, tolerance=.tol[["test"]]) ### 35.85 in paper expect_equivalent(res$zval, 1.6208, tolerance=.tol[["test"]]) ### empirical Bayes estimates tmp <- blup(res) out <- capture.output(print(tmp)) ### so that print.list.rma() is run (at least once) ### compare with results in Figure 2 expect_equivalent(tmp$pred, c(0.0543, 0.1006, -0.0064, 0.2144, 0.1051, -0.0082, 0.0174, -0.0293, 0.1604, 0.2485, 0.1618, 0.1102, 0.0646, 0.1105, -0.0288, 0.0258, 0.1905, 0.0744, 0.0248), tolerance=.tol[["pred"]]) expect_equivalent(tmp$pi.lb, c(-0.1324, -0.1033, -0.2228, -0.0533, -0.1622, -0.1737, -0.1481, -0.2689, -0.0543, 0, -0.097, -0.1303, -0.192, -0.1463, -0.2405, -0.1906, -0.0076, -0.0808, -0.1954), tolerance=.tol[["ci"]]) expect_equivalent(tmp$pi.ub, c(0.2411, 0.3045, 0.21, 0.4821, 0.3724, 0.1572, 0.1828, 0.2102, 0.3751, 0.497, 0.4206, 0.3507, 0.3212, 0.3672, 0.1829, 0.2422, 0.3886, 0.2295, 0.245), tolerance=.tol[["ci"]]) ### empirical Bayes estimates (just the random effects) tmp <- ranef(res) expect_equivalent(tmp$pred, c(-0.0294, 0.0169, -0.0901, 0.1307, 0.0214, -0.0919, -0.0664, -0.1131, 0.0767, 0.1648, 0.0781, 0.0265, -0.0191, 0.0268, -0.1125, -0.0579, 0.1068, -0.0093, -0.0589), tolerance=.tol[["pred"]]) expect_equivalent(tmp$pi.lb, c(-0.2187, -0.1852, -0.3019, -0.122, -0.231, -0.2659, -0.2403, -0.343, -0.1337, -0.0723, -0.1674, -0.2043, -0.2627, -0.217, -0.3207, -0.2697, -0.091, -0.1761, -0.2736), tolerance=.tol[["ci"]]) expect_equivalent(tmp$pi.ub, c(0.1599, 0.219, 0.1216, 0.3834, 0.2738, 0.082, 0.1076, 0.1169, 0.2871, 0.4019, 0.3235, 0.2572, 0.2246, 0.2706, 0.0956, 0.1539, 0.3046, 0.1574, 0.1558), tolerance=.tol[["ci"]]) skip_on_cran() ### profile tau^2 png("images/test_analysis_example_raudenbush1985_profile_1_test.png", res=200, width=1800, height=1600, type="cairo") profile(res, xlim=c(0,.20), progbar=FALSE) dev.off() expect_true(.vistest("images/test_analysis_example_raudenbush1985_profile_1_test.png", "images/test_analysis_example_raudenbush1985_profile_1.png")) ### profile tau^2 (without 'xlim' specified) png("images/test_analysis_example_raudenbush1985_profile_2_test.png", res=200, width=1800, height=1600, type="cairo") profile(res, progbar=FALSE) dev.off() expect_true(.vistest("images/test_analysis_example_raudenbush1985_profile_2_test.png", "images/test_analysis_example_raudenbush1985_profile_2.png")) ### profile tau^2 (with parallel processing) png("images/test_analysis_example_raudenbush1985_profile_3_test.png", res=200, width=1800, height=1600, type="cairo") profile(res, xlim=c(0,.20), progbar=FALSE, parallel="snow") dev.off() expect_true(.vistest("images/test_analysis_example_raudenbush1985_profile_3_test.png", "images/test_analysis_example_raudenbush1985_profile_3.png")) }) test_that("results are correct for the mixed-effects model.", { ### recode weeks variable dat$weeks.c <- ifelse(dat$weeks > 3, 3, dat$weeks) ### mixed-effects model res <- rma(yi, vi, mods = ~ weeks.c, data=dat, digits=3) ### compare with results on pages 90 and 92 (in text) expect_equivalent(res$tau2, 0.0000, tolerance=.tol[["var"]]) expect_equivalent(coef(res), c(0.4072, -0.1572), tolerance=.tol[["coef"]]) expect_equivalent(res$QE, 16.5708, tolerance=.tol[["test"]]) ### 16.58 in paper expect_equivalent(res$zval, c(4.6782, -4.3884), tolerance=.tol[["test"]]) ### empirical Bayes estimates tmp <- blup(res) ### (results for this not given in chapter) expect_equivalent(tmp$pred, c(0.0927, -0.0645, -0.0646, 0.4072, 0.4072, -0.0645, -0.0645, -0.0646, 0.4072, 0.2499, 0.4072, 0.4072, 0.2499, 0.0927, -0.0646, -0.0645, 0.2499, 0.0927, -0.0645), tolerance=.tol[["pred"]]) expect_equivalent(tmp$pi.lb, c(0.0198, -0.1552, -0.1552, 0.2366, 0.2366, -0.1552, -0.1552, -0.1552, 0.2366, 0.1391, 0.2366, 0.2366, 0.1391, 0.0198, -0.1552, -0.1552, 0.1391, 0.0198, -0.1552), tolerance=.tol[["ci"]]) expect_equivalent(tmp$pi.ub, c(0.1656, 0.0261, 0.0261, 0.5778, 0.5778, 0.0261, 0.0261, 0.0261, 0.5778, 0.3608, 0.5778, 0.5778, 0.3608, 0.1656, 0.0261, 0.0261, 0.3608, 0.1656, 0.0261), tolerance=.tol[["ci"]]) ### empirical Bayes estimates (just the random effects) tmp <- ranef(res) expect_equivalent(tmp$pred, c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), tolerance=.tol[["pred"]]) expect_equivalent(tmp$pi.lb, c(-0.0016, -0.0016, -0.0016, -0.0016, -0.0016, -0.0016, -0.0016, -0.0016, -0.0016, -0.0016, -0.0016, -0.0016, -0.0016, -0.0016, -0.0016, -0.0016, -0.0016, -0.0016, -0.0016), tolerance=.tol[["ci"]]) expect_equivalent(tmp$pi.ub, c(0.0016, 0.0016, 0.0016, 0.0016, 0.0016, 0.0016, 0.0016, 0.0016, 0.0016, 0.0016, 0.0016, 0.0016, 0.0016, 0.0016, 0.0016, 0.0016, 0.0016, 0.0016, 0.0016), tolerance=.tol[["ci"]]) ### predicted/fitted values tmp <- predict(res) ### (results for this not given in chapter) expect_equivalent(tmp$pred, c(0.0927, -0.0645, -0.0645, 0.4072, 0.4072, -0.0645, -0.0645, -0.0645, 0.4072, 0.2499, 0.4072, 0.4072, 0.2499, 0.0927, -0.0645, -0.0645, 0.2499, 0.0927, -0.0645), tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, c(0.0198, -0.1552, -0.1552, 0.2366, 0.2366, -0.1552, -0.1552, -0.1552, 0.2366, 0.1391, 0.2366, 0.2366, 0.1391, 0.0198, -0.1552, -0.1552, 0.1391, 0.0198, -0.1552), tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, c(0.1656, 0.0261, 0.0261, 0.5778, 0.5778, 0.0261, 0.0261, 0.0261, 0.5778, 0.3607, 0.5778, 0.5778, 0.3607, 0.1656, 0.0261, 0.0261, 0.3607, 0.1656, 0.0261), tolerance=.tol[["ci"]]) skip_on_cran() ### profile tau^2 png("images/test_analysis_example_raudenbush1985_profile_4_test.png", res=200, width=1800, height=1600, type="cairo") profile(res, xlim=c(0,.06), progbar=FALSE) dev.off() expect_true(.vistest("images/test_analysis_example_raudenbush1985_profile_4_test.png", "images/test_analysis_example_raudenbush1985_profile_4.png")) ### regplot png(filename="images/test_analysis_example_raudenbush1985_scatterplot_test.png", res=200, width=1800, height=1600, type="cairo") par(mar=c(5,5,1,2)) regplot(res, xlab="Weeks of Prior Contact", bty="l", las=1, digits=1, refline=0, xaxt="n") axis(side=1, at=c(0,1,2,3), labels=c("0", "1", "2", ">2")) dev.off() expect_true(.vistest("images/test_analysis_example_raudenbush1985_scatterplot_test.png", "images/test_analysis_example_raudenbush1985_scatterplot.png")) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_morris2008.r0000644000176200001440000000735714204414252023410 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:morris2008 context("Checking analysis example: morris2008") source("settings.r") ### create datasets datT <- data.frame( m_pre = c(30.6, 23.5, 0.5, 53.4, 35.6), m_post = c(38.5, 26.8, 0.7, 75.9, 36.0), sd_pre = c(15.0, 3.1, 0.1, 14.5, 4.7), sd_post = c(11.6, 4.1, 0.1, 4.4, 4.6), ni = c(20, 50, 9, 10, 14), ri = c(.47, .64, .77, .89, .44)) datC <- data.frame( m_pre = c(23.1, 24.9, 0.6, 55.7, 34.8), m_post = c(19.7, 25.3, 0.6, 60.7, 33.4), sd_pre = c(13.8, 4.1, 0.2, 17.3, 3.1), sd_post = c(14.8, 3.3, 0.2, 17.9, 6.9), ni = c(20, 42, 9, 11, 14), ri = c(.47, .64, .77, .89, .44)) test_that("calculations of escalc() are correct for measure='SMCR'.", { ### compute standardized mean changes using raw-score standardization datT <- escalc(measure="SMCR", m1i=m_post, m2i=m_pre, sd1i=sd_pre, ni=ni, ri=ri, data=datT) datC <- escalc(measure="SMCR", m1i=m_post, m2i=m_pre, sd1i=sd_pre, ni=ni, ri=ri, data=datC) ### (results for this not given in paper) expect_equivalent(datT$yi, c( 0.5056, 1.0481, 1.8054, 1.4181, 0.0801), tolerance=.tol[["est"]]) expect_equivalent(datT$vi, c( 0.0594, 0.0254, 0.2322, 0.1225, 0.0802), tolerance=.tol[["var"]]) expect_equivalent(datC$yi, c(-0.2365, 0.0958, 0.0000, 0.2667, -0.4250), tolerance=.tol[["est"]]) expect_equivalent(datC$vi, c( 0.0544, 0.0173, 0.0511, 0.0232, 0.0864), tolerance=.tol[["var"]]) ### compute difference between treatment and control groups dat <- data.frame(yi = datT$yi - datC$yi, vi = datT$vi + datC$vi) ### compare with results on page 382 (Table 5) expect_equivalent(dat$yi, c(0.7421, 0.9524, 1.8054, 1.1514, 0.5050), tolerance=.tol[["est"]]) ### (results for this not given in paper) expect_equivalent(dat$vi, c(0.1138, 0.0426, 0.2833, 0.1458, 0.1667), tolerance=.tol[["var"]]) ### use pooled pretest SDs sd_pool <- sqrt((with(datT, (ni-1)*sd_pre^2) + with(datC, (ni-1)*sd_pre^2)) / (datT$ni + datC$ni - 2)) dat <- data.frame(yi = metafor:::.cmicalc(datT$ni + datC$ni - 2) * (with(datT, m_post - m_pre) - with(datC, m_post - m_pre)) / sd_pool) dat$vi <- 2*(1-datT$ri) * (1/datT$ni + 1/datC$ni) + dat$yi^2 / (2*(datT$ni + datC$ni)) ### compare with results on page 382 (Table 5) expect_equivalent(dat$yi, c(0.7684, 0.8010, 1.2045, 1.0476, 0.4389), tolerance=.tol[["est"]]) ### (results for this not given in paper) expect_equivalent(dat$vi, c(0.1134, 0.0350, 0.1425, 0.0681, 0.1634), tolerance=.tol[["var"]]) }) test_that("calculations of escalc() are correct for measure='SMCC'.", { ### compute standardized mean changes using change-score standardization datT <- escalc(measure="SMCC", m1i=m_post, m2i=m_pre, sd1i=sd_post, sd2i=sd_pre, ni=ni, ri=ri, data=datT) datC <- escalc(measure="SMCC", m1i=m_post, m2i=m_pre, sd1i=sd_post, sd2i=sd_pre, ni=ni, ri=ri, data=datC) ### (results for this not given in paper) expect_equivalent(datT$yi, c( 0.5417, 1.0198, 2.6619, 1.9088, 0.0765), tolerance=.tol[["est"]]) expect_equivalent(datT$vi, c( 0.0573, 0.0304, 0.5048, 0.2822, 0.0716), tolerance=.tol[["var"]]) expect_equivalent(datC$yi, c(-0.2213, 0.1219, 0.0000, 0.5575, -0.2126), tolerance=.tol[["est"]]) expect_equivalent(datC$vi, c( 0.0512, 0.0240, 0.1111, 0.1050, 0.0730), tolerance=.tol[["var"]]) ### compute difference between treatment and control groups dat <- data.frame(yi = datT$yi - datC$yi, vi = datT$vi + datC$vi) ### (results for this not given in paper) expect_equivalent(dat$yi, c(0.7630, 0.8979, 2.6619, 1.3513, 0.2891), tolerance=.tol[["est"]]) expect_equivalent(dat$vi, c(0.1086, 0.0544, 0.6159, 0.3872, 0.1447), tolerance=.tol[["var"]]) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_dersimonian2007.r0000644000176200001440000000613514503057205024400 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:dersimonian2007 source("settings.r") context("Checking analysis example: dersimonian2007") ### data for the CLASP example n1i <- c(156, 303, 565, 1570, 103, 4659) n2i <- c( 74, 303, 477, 1565, 105, 4650) ai <- c( 5, 5, 12, 69, 9, 313) ci <- c( 8, 17, 9, 94, 11, 352) test_that("results are correct for the CLASP example.", { skip_on_cran() ### calculate log(OR)s and corresponding sampling variances dat <- escalc(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i) ### fit RE model with various tau^2 estimators res.PM <- rma(yi, vi, method="PM", data=dat) res.CA <- rma(yi, vi, method="HE", data=dat) res.DL <- rma(yi, vi, method="DL", data=dat) res.CA2 <- rma(yi, vi, method="GENQ", weights=1/(vi + res.CA$tau2), data=dat) res.DL2 <- rma(yi, vi, method="GENQ", weights=1/(vi + res.DL$tau2), data=dat) res.CA2 <- rma(yi, vi, tau2=res.CA2$tau2, data=dat) res.DL2 <- rma(yi, vi, tau2=res.DL2$tau2, data=dat) res.EB <- rma(yi, vi, method="EB", data=dat) res.ML <- rma(yi, vi, method="ML", data=dat) res.REML <- rma(yi, vi, method="REML", data=dat) res.HS <- rma(yi, vi, method="HS", data=dat) res.SJ <- rma(yi, vi, method="SJ", data=dat) res.SJ2 <- rma(yi, vi, method="SJ", data=dat, control=list(tau2.init=res.CA$tau2)) ### some extra ones res.HSk <- rma(yi, vi, method="HSk", data=dat) res.GENQM <- rma(yi, vi, method="GENQM", weights=1/vi, data=dat) res.PMM <- rma(yi, vi, method="PMM", data=dat) ### combine results into one long list of fitted models res.all <- list(res.PM, res.CA, res.DL, res.CA2, res.DL2, res.EB, res.ML, res.REML, res.HS, res.SJ, res.SJ2, res.HSk, res.GENQM, res.PMM) ### create table with estimate of tau, mu, and standard error results <- rbind( tau = sapply(res.all, function(x) sqrt(x$tau2)), mu = sapply(res.all, coef), se = sapply(res.all, function(x) sqrt(vcov(x)))) colnames(results) <- c("PM", "CA", "DL", "CA2", "DL2", "EB", "ML", "REML", "HS", "SJ", "SJ2", "HSk", "GENQM", "PMM") tmp <- t(results) ### compare with results on page 111-112 (Tables 3 and 4) expected <- structure(c( 0.3681, 0.4410, 0.2323, 0.3831, 0.3254, 0.3681, 0.0023, 0.1843, 0.1330, 0.4572, 0.4084, 0.1644, 0.2929, 0.4341, -0.3811, -0.4035, -0.3240, -0.3861, -0.3655, -0.3811, -0.1974, -0.2980, -0.2666, -0.4079, -0.3941, -0.2863, -0.1973, -0.4016, 0.2060, 0.2327, 0.1540, 0.2115, 0.1901, 0.2060, 0.0694, 0.1343, 0.1125, 0.2386, 0.2208, 0.1259, 0.2342, 0.2302), .Dim = c(14L, 3L), .Dimnames = list(c("PM", "CA", "DL", "CA2", "DL2", "EB", "ML", "REML", "HS", "SJ", "SJ2", "HSk", "GENQM", "PMM"), c("tau", "mu", "se"))) expect_equivalent(tmp[,1], expected[,1], tolerance=.tol[["var"]]) expect_equivalent(tmp[,2], expected[,2], tolerance=.tol[["coef"]]) expect_equivalent(tmp[,3], expected[,3], tolerance=.tol[["se"]]) }) rm(list=ls()) metafor/tests/testthat/test_misc_rma_vs_lm.r0000644000176200001440000000304214502304027021121 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking tip: rma() results match up with those from lm()") source("settings.r") test_that("results for rma() and lm() match.", { dat <- escalc(measure="ZCOR", ri=ri, ni=ni, data=dat.molloy2014) res1 <- rma(yi, 0, data=dat) res2 <- lm(yi ~ 1, data=dat) ### coefficients should be the same expect_equivalent(coef(res1), coef(res2)) ### standard errors should be the same expect_equivalent(res1$se, coef(summary(res2))[1,2]) }) test_that("results for rma.mv() and lm() match.", { dat <- escalc(measure="ZCOR", ri=ri, ni=ni, data=dat.molloy2014) dat$id <- 1:nrow(dat) res1 <- rma.mv(yi, 0, random = ~ 1 | id, data=dat, sparse=.sparse) res2 <- lm(yi ~ 1, data=dat) ### coefficients should be the same expect_equivalent(coef(res1), coef(res2)) ### standard errors should be the same expect_equivalent(res1$se, coef(summary(res2))[1,2]) ### get profile likelihood CI for sigma^2 sav <- confint(res1) expect_equivalent(sav$random[1,2:3], c(.0111, .0474), tolerance=.tol[["var"]]) ### fit with sparse=TRUE res1 <- rma.mv(yi, 0, random = ~ 1 | id, data=dat, sparse=TRUE) ### coefficients should be the same expect_equivalent(coef(res1), coef(res2)) ### standard errors should be the same expect_equivalent(res1$se, coef(summary(res2))[1,2]) ### get profile likelihood CI for sigma^2 sav <- confint(res1) expect_equivalent(sav$random[1,2:3], c(.0111, .0474), tolerance=.tol[["var"]]) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_yusuf1985.r0000644000176200001440000000410314503345441023254 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:yusuf1985 context("Checking analysis example: yusuf1985") source("settings.r") ### create dataset for example dat <- dat.yusuf1985 dat$grp_ratios <- round(dat$n1i / dat$n2i, 2) test_that("log likelihood plot can be drawn.", { skip_on_cran() png(filename="images/test_analysis_example_yusuf1985_test.png", res=200, width=1800, height=800, type="cairo") par(mar=c(5,4,1,2)) par(mfrow=c(1,2)) expect_warning(llplot(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, subset=(table=="6"), drop00=FALSE, lwd=1, xlim=c(-5,5))) expect_warning(llplot(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, subset=(table=="6"), drop00=FALSE, lwd=1, xlim=c(-5,5), scale=FALSE)) dev.off() expect_true(.vistest("images/test_analysis_example_yusuf1985_test.png", "images/test_analysis_example_yusuf1985.png")) }) test_that("results are correct for the analysis using Peto's method.", { expect_warning(res <- rma.peto(ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, subset=(table=="6"))) out <- capture.output(print(res)) ### so that print.rma.peto() is run (at least once) out <- capture.output(print(summary(res))) ### so that print.rma.peto() is run (at least once) with showfit=TRUE sav <- predict(res, transf=exp) tmp <- c(sav$pred, sav$ci.lb, sav$ci.ub) ### compare with results on page 107 expect_equivalent(tmp, c(.9332, .7385, 1.1792), tolerance=.tol[["pred"]]) }) test_that("results are correct for the analysis using the inverse-variance method.", { expect_warning(dat <- escalc(measure="PETO", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, subset=(table=="6"), add=0)) expect_warning(res <- rma(yi, vi, data=dat, method="EE")) sav <- predict(res, transf=exp) tmp <- c(sav$pred, sav$ci.lb, sav$ci.ub) ### compare with results on page 107 expect_equivalent(tmp, c(.9332, .7385, 1.1792), tolerance=.tol[["pred"]]) }) rm(list=ls()) metafor/tests/testthat/test_plots_plot_of_influence_diagnostics.r0000644000176200001440000000247414503346363025453 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/plots:plot_of_influence_diagnostics source("settings.r") context("Checking plots example: plot of influence diagnostics") test_that("plot can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() ### fit random-effects model with r-to-z transformed correlations res <- rma(ri=ri, ni=ni, measure="ZCOR", data=dat.mcdaniel1994) ### calculate influence diagnostics inf <- influence(res) ### plot the influence diagnostics png("images/test_plots_plot_of_influence_diagnostics_1_test.png", res=200, width=1800, height=3600, type="cairo") plot(inf, layout=c(8,1)) dev.off() expect_true(.vistest("images/test_plots_plot_of_influence_diagnostics_1_test.png", "images/test_plots_plot_of_influence_diagnostics_1.png")) png("images/test_plots_plot_of_influence_diagnostics_2_test.png", res=200, width=1800, height=1800, type="cairo") plot(inf, plotinf=FALSE, plotdfbs=TRUE) dev.off() expect_true(.vistest("images/test_plots_plot_of_influence_diagnostics_2_test.png", "images/test_plots_plot_of_influence_diagnostics_2.png")) out <- capture.output(print(inf)) # so that print.infl.rma.uni() is run (at least once) }) rm(list=ls()) metafor/tests/testthat/test_misc_pdfs.r0000644000176200001440000000154514204414456020113 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: pdfs of various measures") source("settings.r") test_that(".dsmd() works correctly.", { d <- metafor:::.dsmd(0.5, n1=15, n2=15, theta=0.8, correct=TRUE) expect_equivalent(d, 0.8208, tolerance=.tol[["den"]]) d <- metafor:::.dsmd(0.5, n1=15, n2=15, theta=0.8, correct=FALSE) expect_equivalent(d, 0.7757, tolerance=.tol[["den"]]) }) test_that(".dcor() works correctly.", { d <- metafor:::.dcor(0.5, n=15, rho=0.8) expect_equivalent(d, 0.2255, tolerance=.tol[["den"]]) }) test_that(".dzcor() works correctly.", { d <- metafor:::.dzcor(0.5, n=15, rho=0.8) expect_equivalent(d, 0.1183, tolerance=.tol[["den"]]) d <- metafor:::.dzcor(0.5, n=15, zrho=transf.rtoz(0.8)) expect_equivalent(d, 0.1183, tolerance=.tol[["den"]]) }) rm(list=ls()) metafor/tests/testthat/test_misc_setlab.r0000644000176200001440000002125714504513427020434 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: .setlab() function") source("settings.r") yi <- c(-.3, -.1, 0, .2, .2) vi <- rep(.02, length(yi)) test_that(".setlab() works correctly together with forest().", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png(filename="images/test_misc_setlab_test.png", res=300, width=5000, height=8000, type="cairo") par(mfrow=c(14,6), mar=c(5,4,0,4)) xlim <- c(-3,5) cex.lab <- 0.5 dat <- escalc(measure="GEN", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="RR", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=exp, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=exp, header=TRUE) dat <- escalc(measure="OR", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=exp, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=exp, header=TRUE) dat <- escalc(measure="RD", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="AS", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="PHI", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="YUQ", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="YUY", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="IRR", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=exp, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=exp, header=TRUE) dat <- escalc(measure="IRD", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="IRSD", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="MD", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="SMD", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="ROM", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=exp, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=exp, header=TRUE) dat <- escalc(measure="CVR", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=exp, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=exp, header=TRUE) dat <- escalc(measure="VR", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=exp, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=exp, header=TRUE) dat <- escalc(measure="RPB", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="COR", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="ZCOR", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=transf.ztor, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=transf.ztor, header=TRUE) dat <- escalc(measure="PR", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="PLN", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=exp, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=exp, header=TRUE) dat <- escalc(measure="PLO", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=transf.ilogit, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=transf.ilogit, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=exp, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=exp, header=TRUE) dat <- escalc(measure="PAS", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=transf.iarcsin, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=transf.iarcsin, header=TRUE) dat <- escalc(measure="PFT", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=transf.ipft.hm, targs=list(ni=rep(10,length(yi))), header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=transf.ipft.hm, targs=list(ni=rep(10,length(yi))), header=TRUE) dat <- escalc(measure="IR", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="IRLN", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=exp, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=exp, header=TRUE) dat <- escalc(measure="IRS", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=transf.isqrt, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=transf.isqrt, header=TRUE) dat <- escalc(measure="IRFT", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="MN", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="MNLN", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=exp, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=exp, header=TRUE) dat <- escalc(measure="CVLN", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=exp, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=exp, header=TRUE) dat <- escalc(measure="SDLN", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=exp, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=exp, header=TRUE) dat <- escalc(measure="MC", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="SMCC", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="ROMC", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=exp, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=exp, header=TRUE) dat <- escalc(measure="ARAW", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="AHW", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=transf.iahw, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=transf.iahw, header=TRUE) dat <- escalc(measure="ABT", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=transf.iabt, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=transf.iabt, header=TRUE) dat <- escalc(measure="PCOR", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dat <- escalc(measure="ZPCOR", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, transf=transf.ztor, header=TRUE) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, atransf=transf.ztor, header=TRUE) dat <- escalc(measure="SPCOR", yi=yi, vi=vi) forest(dat$yi, dat$vi, xlim=xlim, cex.lab=cex.lab, header=TRUE) dev.off() expect_true(.vistest("images/test_misc_setlab_test.png", "images/test_misc_setlab.png")) }) rm(list=ls()) metafor/tests/testthat/test_misc_dfround.r0000644000176200001440000000115714204414333020611 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: dfround() function") source("settings.r") test_that("dfround() works correctly.", { dat <- as.data.frame(dat.raudenbush1985) dat$yi <- c(dat$yi) dat <- dfround(dat, c(rep(NA,8), 2, 3)) expect_identical(dat$yi, c(0.03, 0.12, -0.14, 1.18, 0.26, -0.06, -0.02, -0.32, 0.27, 0.8, 0.54, 0.18, -0.02, 0.23, -0.18, -0.06, 0.3, 0.07, -0.07)) expect_identical(dat$vi, c(0.016, 0.022, 0.028, 0.139, 0.136, 0.011, 0.011, 0.048, 0.027, 0.063, 0.091, 0.05, 0.084, 0.084, 0.025, 0.028, 0.019, 0.009, 0.03)) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_viechtbauer2007a.r0000644000176200001440000001414514503345405024534 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:viechtbauer2007a context("Checking analysis example: viechtbauer2007a") source("settings.r") ### load data dat <- dat.collins1985b[,1:7] dat <- escalc(measure="OR", ai=pre.xti, n1i=pre.nti, ci=pre.xci, n2i=pre.nci, data=dat) ### fit model with different tau^2 estimators res.DL <- rma(yi, vi, data=dat, method="DL") res.ML <- rma(yi, vi, data=dat, method="ML") res.REML <- rma(yi, vi, data=dat, method="REML") res.SJ <- rma(yi, vi, data=dat, method="SJ") ### note: results are compared with those in Table II on page 44 (but without rounding) test_that("the heterogeneity estimates are correct.", { sav <- c(DL=res.DL$tau2, ML=res.ML$tau2, REML=res.REML$tau2, SJ=res.SJ$tau2) expect_equivalent(sav, c(.2297, .2386, .3008, .4563), tolerance=.tol[["var"]]) }) test_that("CI is correct for the Q-profile method.", { sav <- confint(res.DL) sav <- c(sav$random["tau^2","ci.lb"], sav$random["tau^2","ci.ub"]) expect_equivalent(sav, c(.0723, 2.2027), tolerance=.tol[["var"]]) }) test_that("CI is correct for the Biggerstaff–Tweedie method.", { CI.D.func <- function(tau2val, s1, s2, Q, k, lower.tail) { expQ <- (k-1) + s1*tau2val varQ <- 2*(k-1) + 4*s1*tau2val + 2*s2*tau2val^2 shape <- expQ^2/varQ scale <- varQ/expQ qtry <- Q/scale pgamma(qtry, shape = shape, scale = 1, lower.tail = lower.tail) - .025 } wi <- 1/dat$vi s1 <- sum(wi) - sum(wi^2)/sum(wi) s2 <- sum(wi^2) - 2*sum(wi^3)/sum(wi) + sum(wi^2)^2/sum(wi)^2 ci.lb <- uniroot(CI.D.func, interval=c(0,10), s1=s1, s2=s2, Q=res.DL$QE, k=res.DL$k, lower.tail=FALSE)$root ci.ub <- uniroot(CI.D.func, interval=c(0,10), s1=s1, s2=s2, Q=res.DL$QE, k=res.DL$k, lower.tail=TRUE)$root sav <- c(ci.lb=ci.lb, ci.ub=ci.ub) expect_equivalent(sav, c(.0481, 2.3551), tolerance=.tol[["var"]]) }) test_that("CI is correct for the profile likelihood method.", { sav <- confint(res.ML, type="PL") sav <- c(sav$random["tau^2","ci.lb"], sav$random["tau^2","ci.ub"]) expect_equivalent(sav, c(.0266, 1.1308), tolerance=.tol[["var"]]) sav <- confint(res.REML, type="PL") sav <- c(sav$random["tau^2","ci.lb"], sav$random["tau^2","ci.ub"]) expect_equivalent(sav, c(.0427, 1.4747), tolerance=.tol[["var"]]) res.ML.mv <- rma.mv(yi, vi, random = ~ 1 | id, data=dat, method="ML") res.REML.mv <- rma.mv(yi, vi, random = ~ 1 | id, data=dat, method="REML") sav <- confint(res.ML.mv) sav <- c(sav$random["sigma^2","ci.lb"], sav$random["sigma^2","ci.ub"]) expect_equivalent(sav, c(.0266, 1.1308), tolerance=.tol[["var"]]) sav <- confint(res.REML.mv) sav <- c(sav$random["sigma^2","ci.lb"], sav$random["sigma^2","ci.ub"]) expect_equivalent(sav, c(.0427, 1.4747), tolerance=.tol[["var"]]) skip_on_cran() png(filename="images/test_analysis_example_viechtbauer2007a_profile_ll_ml_test.png", res=200, width=1800, height=1400, type="cairo") profile(res.ML, xlim=c(0,1.2), steps=50, cline=TRUE) tmp <- confint(res.ML, type="PL", digits=2) abline(v=tmp$random[1, 2:3], lty="dotted") dev.off() expect_true(.vistest("images/test_analysis_example_viechtbauer2007a_profile_ll_ml_test.png", "images/test_analysis_example_viechtbauer2007a_profile_ll_ml.png")) png(filename="images/test_analysis_example_viechtbauer2007a_profile_ll_reml_test.png", res=200, width=1800, height=1400, type="cairo") profile(res.REML, xlim=c(0,1.6), steps=50, cline=TRUE) tmp <- confint(res.REML, type="PL", digits=2) abline(v=tmp$random[1, 2:3], lty="dotted") dev.off() expect_true(.vistest("images/test_analysis_example_viechtbauer2007a_profile_ll_reml_test.png", "images/test_analysis_example_viechtbauer2007a_profile_ll_reml.png")) }) test_that("CI is correct for the Wald-type method.", { sav <- confint(res.ML, type="Wald") sav <- c(sav$random["tau^2","ci.lb"], sav$random["tau^2","ci.ub"]) expect_equivalent(sav, c(0, .5782), tolerance=.tol[["var"]]) sav <- confint(res.REML, type="Wald") sav <- c(sav$random["tau^2","ci.lb"], sav$random["tau^2","ci.ub"]) expect_equivalent(sav, c(0, .7322), tolerance=.tol[["var"]]) }) test_that("CI is correct for the Sidik-Jonkman method.", { sav <- c(ci.lb=(res.SJ$k-1) * res.SJ$tau2 / qchisq(.975, df=res.SJ$k-1), ci.ub=(res.SJ$k-1) * res.SJ$tau2 / qchisq(.025, df=res.SJ$k-1)) expect_equivalent(sav, c(.2082, 1.6748), tolerance=.tol[["var"]]) }) test_that("CI is correct for the parametric bootstrap method.", { skip_on_cran() maj <- as.numeric(R.Version()$major) min <- as.numeric(R.Version()$minor) ### run test only on R versions 3.6.x or later (due to change in sampler) if (maj >= 3 && min >= 6) { library(boot) boot.func <- function(data.boot) { res <- rma(yi, vi, data=data.boot, method="DL") c(res$tau2, res$se.tau2^2) } data.gen <- function(dat, mle) { data.frame(yi=rnorm(nrow(dat), mle$mu, sqrt(mle$tau2 + dat$vi)), vi=dat$vi) } res.DL <- rma(yi, vi, data=dat, method="DL") set.seed(12345) sav <- boot(dat, boot.func, R=1000, sim="parametric", ran.gen=data.gen, mle=list(mu=coef(res.DL), tau2=res.DL$tau2)) sav <- boot.ci(sav, type=c("norm", "basic", "stud", "perc")) sav <- sav$percent[4:5] expect_equivalent(sav, c(0, .7171), tolerance=.tol[["var"]]) } else { expect_true(TRUE) } }) test_that("CI is correct for the non-parametric bootstrap method.", { skip_on_cran() maj <- as.numeric(R.Version()$major) min <- as.numeric(R.Version()$minor) ### run test only on R versions 3.6.x or later (due to change in sampler) if (maj >= 3 && min >= 6) { library(boot) boot.func <- function(dat, indices) { res <- rma(yi, vi, data=dat, subset=indices, method="DL") c(res$tau2, res$se.tau2^2) } set.seed(12345) sav <- boot(dat, boot.func, R=1000) sav <- boot.ci(sav) sav <- sav$percent[4:5] expect_equivalent(sav, c(.0218, .5143), tolerance=.tol[["var"]]) } else { expect_true(TRUE) } }) rm(list=ls()) metafor/tests/testthat/test_misc_handling_nas.r0000644000176200001440000002057714502303772021611 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: handling of NAs") source("settings.r") dat <- data.frame(yi = c(NA, 1, 3, 2, 5, 4, 6), vi = c(1, NA, 1, 1, 1, 1, 1), xi = c(0, 1, NA, 3, 4, 5, 6)) test_that("NAs are correctly handled by various method functions for rma.uni() intercept-only models.", { expect_warning(res <- rma(yi, vi, data=dat)) expect_equivalent(res$k, 5) options(na.action = "na.omit") expect_equivalent(fitted(res), c(4, 4, 4, 4, 4)) expect_equivalent(resid(res), c(-1, -2, 1, 0, 2)) expect_equivalent(predict(res)$pred, 4) expect_equivalent(blup(res)$pred, c(3.4, 2.8, 4.6, 4.0, 5.2)) expect_equivalent(cooks.distance(res), c(0.125, 0.5, 0.125, 0, 0.5)) expect_equivalent(dfbetas(res)[[1]], c(-0.3273, -0.8660, 0.3273, 0, 0.8660), tolerance=.tol[["inf"]]) expect_equivalent(hatvalues(res), c(0.2, 0.2, 0.2, 0.2, 0.2)) expect_equivalent(leave1out(res)$estimate, c(4.25, 4.5, 3.75, 4, 3.5)) expect_equivalent(ranef(res)$pred, c(-0.6, -1.2, 0.6, 0, 1.2)) expect_equivalent(rstandard(res)$resid, c(-1, -2, 1, 0, 2)) expect_equivalent(rstudent(res)$resid, c(-1.25, -2.5, 1.25, 0, 2.5)) expect_equivalent(length(simulate(res, seed=1234)[[1]]), 5) expect_equivalent(weights(res), c(20, 20, 20, 20, 20)) options(na.action = "na.pass") # note: all of these are of the same length as the original data (except for predict(), which gives a single value for intercept-only models) expect_equivalent(fitted(res), c(4, 4, 4, 4, 4, 4, 4)) # note: can compute fitted value even for the study with missing yi and the study with missing vi expect_equivalent(resid(res), c(NA, -3, -1, -2, 1, 0, 2)) # note: can compute residual value even for the study with missing vi expect_equivalent(predict(res)$pred, 4) expect_equivalent(blup(res)$pred, c(NA, NA, 3.4, 2.8, 4.6, 4.0, 5.2)) expect_equivalent(cooks.distance(res), c(NA, NA, 0.125, 0.5, 0.125, 0, 0.5)) expect_equivalent(dfbetas(res)[[1]], c(NA, NA, -0.3273, -0.8660, 0.3273, 0, 0.8660), tolerance=.tol[["inf"]]) expect_equivalent(hatvalues(res), c(NA, NA, 0.2, 0.2, 0.2, 0.2, 0.2)) expect_equivalent(leave1out(res)$estimate, c(NA, NA, 4.25, 4.5, 3.75, 4, 3.5)) expect_equivalent(ranef(res)$pred, c(NA, NA, -0.6, -1.2, 0.6, 0, 1.2)) expect_equivalent(rstandard(res)$resid, c(NA, NA, -1, -2, 1, 0, 2)) expect_equivalent(rstudent(res)$resid, c(NA, NA, -1.25, -2.5, 1.25, 0, 2.5)) expect_equivalent(length(simulate(res, seed=1234)[[1]]), 7) expect_equivalent(weights(res), c(NA, NA, 20, 20, 20, 20, 20)) options(na.action = "na.exclude") # note: all of these are of the same length as the original data, but are NA for studies 1 and 2 expect_equivalent(fitted(res), c(NA, NA, 4, 4, 4, 4, 4)) # note: all of these are of the same length as the original data, but are NA for studies 1 and 2 expect_equivalent(resid(res), c(NA, NA, -1, -2, 1, 0, 2)) expect_equivalent(predict(res)$pred, 4) expect_equivalent(blup(res)$pred, c(NA, NA, 3.4, 2.8, 4.6, 4.0, 5.2)) expect_equivalent(cooks.distance(res), c(NA, NA, 0.125, 0.5, 0.125, 0, 0.5)) expect_equivalent(dfbetas(res)[[1]], c(NA, NA, -0.3273, -0.8660, 0.3273, 0, 0.8660), tolerance=.tol[["inf"]]) expect_equivalent(hatvalues(res), c(NA, NA, 0.2, 0.2, 0.2, 0.2, 0.2)) expect_equivalent(leave1out(res)$estimate, c(NA, NA, 4.25, 4.5, 3.75, 4, 3.5)) expect_equivalent(ranef(res)$pred, c(NA, NA, -0.6, -1.2, 0.6, 0, 1.2)) expect_equivalent(rstandard(res)$resid, c(NA, NA, -1, -2, 1, 0, 2)) expect_equivalent(rstudent(res)$resid, c(NA, NA, -1.25, -2.5, 1.25, 0, 2.5)) expect_equivalent(length(simulate(res, seed=1234)[[1]]), 7) expect_equivalent(weights(res), c(NA, NA, 20, 20, 20, 20, 20)) options(na.action = "na.omit") }) test_that("NAs are correctly handled by various method functions for rma.uni() meta-regression models.", { expect_warning(res <- rma(yi, vi, mods = ~ xi, data=dat)) expect_equivalent(res$k, 4) options(na.action = "na.omit") expect_equivalent(fitted(res), c(2.6, 3.7, 4.8, 5.9)) expect_equivalent(resid(res), c(-0.6, 1.3, -0.8, 0.1)) expect_equivalent(predict(res)$pred, c(2.6, 3.7, 4.8, 5.9)) expect_equivalent(blup(res)$pred, c(2.4444, 4.0370, 4.5926, 5.9259), tolerance=.tol[["pred"]]) expect_equivalent(cooks.distance(res), c(2.0741, 0.7664, 0.2902, 0.0576), tolerance=.tol[["inf"]]) expect_equivalent(dfbetas(res)[[2]], c(1.0954, -0.4153, -0.1912, 0.1369), tolerance=.tol[["inf"]]) expect_equivalent(hatvalues(res), c(0.7, 0.3, 0.3, 0.7)) expect_equivalent(ranef(res)$pred, c(-0.1556, 0.3370, -0.2074, 0.0259), tolerance=.tol[["pred"]]) expect_equivalent(rstandard(res)$resid, c(-0.6, 1.3, -0.8, 0.1)) expect_equivalent(rstudent(res)$resid, c(-2, 1.8571, -1.1429, 0.3333), tolerance=.tol[["pred"]]) expect_equivalent(length(simulate(res, seed=1234)[[1]]), 4) expect_equivalent(weights(res), c(25, 25, 25, 25)) options(na.action = "na.pass") # note: all of these are of the same length as the original data expect_equivalent(fitted(res), c(-0.7, 0.4, NA, 2.6, 3.7, 4.8, 5.9)) # note: can compute fitted value even for the study with missing yi and the study with missing vi expect_equivalent(resid(res), c(NA, 0.6, NA, -0.6, 1.3, -0.8, 0.1)) # note: can compute residual value even for the study with missing vi expect_equivalent(predict(res)$pred, c(-0.7, 0.4, NA, 2.6, 3.7, 4.8, 5.9)) expect_equivalent(blup(res)$pred, c(NA, NA, NA, 2.4444, 4.0370, 4.5926, 5.9259), tolerance=.tol[["pred"]]) expect_equivalent(cooks.distance(res), c(NA, NA, NA, 2.0741, 0.7664, 0.2902, 0.0576), tolerance=.tol[["inf"]]) expect_equivalent(dfbetas(res)[[2]], c(NA, NA, NA, 1.0954, -0.4153, -0.1912, 0.1369), tolerance=.tol[["inf"]]) expect_equivalent(hatvalues(res), c(NA, NA, NA, 0.7, 0.3, 0.3, 0.7)) expect_equivalent(ranef(res)$pred, c(NA, NA, NA, -0.1556, 0.3370, -0.2074, 0.0259), tolerance=.tol[["pred"]]) expect_equivalent(rstandard(res)$resid, c(NA, NA, NA, -0.6, 1.3, -0.8, 0.1)) expect_equivalent(rstudent(res)$resid, c(NA, NA, NA, -2, 1.8571, -1.1429, 0.3333), tolerance=.tol[["pred"]]) expect_equivalent(length(simulate(res, seed=1234)[[1]]), 7) expect_equivalent(weights(res), c(NA, NA, NA, 25, 25, 25, 25)) options(na.action = "na.exclude") # note: all of these are of the same length as the original data, but are NA for studies 1, 2, and 3 expect_equivalent(fitted(res), c(NA, NA, NA, 2.6, 3.7, 4.8, 5.9)) expect_equivalent(resid(res), c(NA, NA, NA, -0.6, 1.3, -0.8, 0.1)) expect_equivalent(predict(res)$pred, c(NA, NA, NA, 2.6, 3.7, 4.8, 5.9)) expect_equivalent(blup(res)$pred, c(NA, NA, NA, 2.4444, 4.0370, 4.5926, 5.9259), tolerance=.tol[["pred"]]) expect_equivalent(cooks.distance(res), c(NA, NA, NA, 2.0741, 0.7664, 0.2902, 0.0576), tolerance=.tol[["inf"]]) expect_equivalent(dfbetas(res)[[2]], c(NA, NA, NA, 1.0954, -0.4153, -0.1912, 0.1369), tolerance=.tol[["inf"]]) expect_equivalent(hatvalues(res), c(NA, NA, NA, 0.7, 0.3, 0.3, 0.7)) expect_equivalent(ranef(res)$pred, c(NA, NA, NA, -0.1556, 0.3370, -0.2074, 0.0259), tolerance=.tol[["pred"]]) expect_equivalent(rstandard(res)$resid, c(NA, NA, NA, -0.6, 1.3, -0.8, 0.1)) expect_equivalent(rstudent(res)$resid, c(NA, NA, NA, -2, 1.8571, -1.1429, 0.3333), tolerance=.tol[["pred"]]) expect_equivalent(length(simulate(res, seed=1234)[[1]]), 7) expect_equivalent(weights(res), c(NA, NA, NA, 25, 25, 25, 25)) options(na.action = "na.omit") }) test_that("NAs are correctly handled by rma.mv() intercept-only models.", { dat <- dat.konstantopoulos2011 res1 <- rma.mv(yi, vi, random = ~ 1 | district/study, data=dat, sparse=.sparse) res2 <- rma.mv(yi, vi, random = ~ factor(study) | district, data=dat, sparse=.sparse) expect_equivalent(logLik(res1), logLik(res2), tolerance=.tol[["fit"]]) dat$yi[1:2] <- NA expect_warning(res1 <- rma.mv(yi, vi, random = ~ 1 | district/study, data=dat, sparse=.sparse)) expect_warning(res2 <- rma.mv(yi, vi, random = ~ factor(study) | district, data=dat, sparse=.sparse)) expect_equivalent(logLik(res1), logLik(res2), tolerance=.tol[["fit"]]) dat$yi[1:4] <- NA # entire district 11 is missing expect_warning(res1 <- rma.mv(yi, vi, random = ~ 1 | district/study, data=dat, sparse=.sparse)) expect_warning(res2 <- rma.mv(yi, vi, random = ~ factor(study) | district, data=dat, sparse=.sparse)) expect_equivalent(logLik(res1), logLik(res2), tolerance=.tol[["fit"]]) }) rm(list=ls()) metafor/tests/testthat/test_misc_to_long_table_wide.r0000644000176200001440000002010514204414573022770 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: to.long() function") source("settings.r") test_that("to.long() works correctly for measure='MD'", { dat <- dat.normand1999 sav <- to.long(measure="MD", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat, subset=1:4) sav <- sav[,c(1,10:13)] expected <- structure(list(study = c(1L, 1L, 2L, 2L, 3L, 3L, 4L, 4L), group = structure(c(2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L), .Label = c("2", "1"), class = "factor"), mean = c(55L, 75L, 27L, 29L, 64L, 119L, 66L, 137L), sd = c(47L, 64L, 7L, 4L, 17L, 29L, 20L, 48L), n = c(155L, 156L, 31L, 32L, 75L, 71L, 18L, 18L)), class = "data.frame", row.names = c(NA, 8L)) expect_equivalent(sav, expected) }) test_that("to.table() works correctly for measure='MD'", { dat <- dat.normand1999 sav <- to.table(measure="MD", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat, subset=1:4) expected <- structure(c(55L, 75L, 47L, 64L, 155L, 156L, 27L, 29L, 7L, 4L, 31L, 32L, 64L, 119L, 17L, 29L, 75L, 71L, 66L, 137L, 20L, 48L, 18L, 18L), .Dim = 2:4, .Dimnames = list(c("Grp1", "Grp2"), c("Mean", "SD", "n"), c("1", "2", "3", "4"))) expect_equivalent(sav, expected) }) test_that("to.long() works correctly for measure='COR'", { dat <- dat.molloy2014 sav <- to.long(measure="COR", ri=ri, ni=ni, data=dat, subset=1:4) sav <- sav[,c(11:13)] expected <- structure(list(study = structure(1:4, .Label = c("1", "2", "3", "4"), class = "factor"), r = c(0.187, 0.162, 0.34, 0.32), n = c(109L, 749L, 55L, 107L)), class = "data.frame", row.names = c(NA, 4L )) expect_equivalent(sav, expected) }) test_that("to.table() works correctly for measure='COR'", { dat <- dat.molloy2014 sav <- to.table(measure="COR", ri=ri, ni=ni, data=dat, subset=1:4) expected <- structure(c(0.187, 109, 0.162, 749, 0.34, 55, 0.32, 107), .Dim = c(1L, 2L, 4L), .Dimnames = list("Grp", c("r", "n"), c("1", "2", "3", "4"))) expect_equivalent(sav, expected) }) test_that("to.long() works correctly for measure='PR'", { dat <- dat.debruin2009 sav <- to.long(measure="PR", xi=xi, ni=ni, data=dat, subset=1:4) sav <- sav[,c(11:13)] expected <- structure(list(study = structure(1:4, .Label = c("1", "2", "3", "4"), class = "factor"), out1 = c(11L, 24L, 179L, 82L), out2 = c(18L, 9L, 147L, 158L)), class = "data.frame", row.names = c(NA, 4L)) expect_equivalent(sav, expected) }) test_that("to.table() works correctly for measure='PR'", { dat <- dat.debruin2009 sav <- to.table(measure="PR", xi=xi, ni=ni, data=dat, subset=1:4) expected <- structure(c(11, 18, 24, 9, 179, 147, 82, 158), .Dim = c(1, 2, 4), .Dimnames = list("Grp", c("Out1", "Out2"), c("1", "2", "3", "4"))) expect_equivalent(sav, expected) }) test_that("to.long() works correctly for measure='IR'", { dat <- dat.hart1999 sav <- to.long(measure="IR", xi=x1i, ti=t1i, data=dat, subset=1:4) sav <- sav[,c(1,14:15)] expected <- structure(list(trial = 1:4, events = c(9L, 8L, 3L, 6L), ptime = c(413L, 263L, 487L, 237L)), class = "data.frame", row.names = c(NA, 4L)) expect_equivalent(sav, expected) }) test_that("to.table() works correctly for measure='IR'", { dat <- dat.hart1999 sav <- to.table(measure="IR", xi=x1i, ti=t1i, data=dat, subset=1:4) expected <- structure(c(9, 413, 8, 263, 3, 487, 6, 237), .Dim = c(1, 2, 4), .Dimnames = list("Grp", c("Events", "Person-Time"), c("1", "2", "3", "4"))) expect_equivalent(sav, expected) }) test_that("to.long() works correctly for measure='MN'", { dat <- dat.normand1999 sav <- to.long(measure="MN", mi=m1i, sdi=sd1i, ni=n1i, data=dat, subset=1:4) sav <- sav[,c(1,10:12)] expected <- structure(list(study = 1:4, mean = c(55L, 27L, 64L, 66L), sd = c(47L, 7L, 17L, 20L), n = c(155L, 31L, 75L, 18L)), class = "data.frame", row.names = c(NA, 4L)) expect_equivalent(sav, expected) }) test_that("to.table() works correctly for measure='MN'", { dat <- dat.normand1999 sav <- to.table(measure="MN", mi=m1i, sdi=sd1i, ni=n1i, data=dat, subset=1:4) expected <- structure(c(55, 47, 155, 27, 7, 31, 64, 17, 75, 66, 20, 18), .Dim = c(1, 3, 4), .Dimnames = list("Grp", c("Mean", "SD", "n"), c("1", "2", "3", "4"))) expect_equivalent(sav, expected) }) ### create dataset (from Morris, 2008) datT <- data.frame( m_pre = c(30.6, 23.5, 0.5, 53.4, 35.6), m_post = c(38.5, 26.8, 0.7, 75.9, 36.0), sd_pre = c(15.0, 3.1, 0.1, 14.5, 4.7), sd_post = c(11.6, 4.1, 0.1, 4.4, 4.6), ni = c(20, 50, 9, 10, 14), ri = c(.47, .64, .77, .89, .44)) test_that("to.long() works correctly for measure='SMCR'", { sav <- to.long(measure="SMCR", m1i=m_post, m2i=m_pre, sd1i=sd_pre, ni=ni, ri=ri, data=datT, subset=2:4) sav <- sav[,c(7:12)] expected <- structure(list(study = structure(1:3, .Label = c("2", "3", "4"), class = "factor"), mean1 = c(26.8, 0.7, 75.9), mean2 = c(23.5, 0.5, 53.4), sd1 = c(3.1, 0.1, 14.5), n = c(50, 9, 10), r = c(0.64, 0.77, 0.89)), class = "data.frame", row.names = c(NA, 3L)) expect_equivalent(sav, expected) }) test_that("to.table() works correctly for measure='SMCR'", { sav <- to.table(measure="SMCR", m1i=m_post, m2i=m_pre, sd1i=sd_pre, ni=ni, ri=ri, data=datT, subset=2:4) expected <- structure(c(26.8, 23.5, 3.1, 50, 0.64, 0.7, 0.5, 0.1, 9, 0.77, 75.9, 53.4, 14.5, 10, 0.89), .Dim = c(1, 5, 3), .Dimnames = list("Grp", c("Mean1", "Mean2", "SD1", "n", "r"), c("2", "3", "4"))) expect_equivalent(sav, expected) }) test_that("to.long() works correctly for measure='ARAW'", { dat <- dat.bonett2010 sav <- to.long(measure="AHW", ai=ai, mi=mi, ni=ni, data=dat, subset=1:4) sav <- sav[,c(1,8:10)] expected <- structure(list(study = 1:4, alpha = c(0.93, 0.91, 0.94, 0.89), m = c(20L, 20L, 20L, 20L), n = c(103L, 64L, 118L, 401L)), class = "data.frame", row.names = c(NA, 4L)) expect_equivalent(sav, expected) }) test_that("to.table() works correctly for measure='ARAW'", { dat <- dat.bonett2010 sav <- to.table(measure="AHW", ai=ai, mi=mi, ni=ni, data=dat, subset=1:4) expected <- structure(c(0.93, 20, 103, 0.91, 20, 64, 0.94, 20, 118, 0.89, 20, 401), .Dim = c(1, 3, 4), .Dimnames = list("Grp", c("alpha", "m", "n"), c("1", "2", "3", "4"))) expect_equivalent(sav, expected) }) test_that("to.wide() works correctly.", { dat.l <- dat.hasselblad1998 dat.c <- to.wide(dat.l, study="study", grp="trt", ref="no_contact", grpvars=6:7) expect_equivalent(dat.c$xi.1, c(363, 10, 23, 9, 237, 9, 16, 31, 26, 29, 12, 17, 77, 21, 107, 20, 3, 32, 8, 34, 9, 19, 143, 36, 73, 54)) expect_equivalent(dat.c$xi.2, c(75, 9, 9, 2, 58, 0, 20, 3, 1, 11, 11, 6, 79, 18, 64, 12, 9, 7, 5, 20, 0, 8, 95, 15, 78, 69)) expect_equivalent(dat.c$comp, c("in-no", "gr-no", "in-no", "in-no", "in-no", "in-no", "in-se", "in-no", "in-no", "gr-se", "in-se", "in-no", "se-no", "se-no", "in-no", "gr-in", "gr-in", "gr-se", "in-no", "in-no", "gr-no", "se-no", "in-no", "in-no", "in-no", "in-no")) expect_equivalent(dat.c$design, c("in-no", "gr-in-no", "gr-in-no", "in-no", "in-no", "in-no", "in-se", "in-no", "in-no", "gr-in-se", "gr-in-se", "in-no", "se-no", "se-no", "in-no", "gr-in", "gr-in", "gr-se", "in-no", "in-no", "gr-no", "se-no", "in-no", "in-no", "in-no", "in-no")) dat.l$trt <- factor(dat.l$trt, levels=c("no_contact", "ind_counseling", "grp_counseling", "self_help")) dat.c <- to.wide(dat.l, study="study", grp="trt", grpvars=5:7, postfix=c(".T",".C"), minlen=1) expect_equivalent(dat.c$xi.T, c(363, 23, 10, 9, 237, 9, 16, 31, 26, 12, 29, 17, 77, 21, 107, 12, 9, 32, 8, 34, 9, 19, 143, 36, 73, 54)) expect_equivalent(dat.c$xi.C, c(75, 9, 9, 2, 58, 0, 20, 3, 1, 11, 11, 6, 79, 18, 64, 20, 3, 7, 5, 20, 0, 8, 95, 15, 78, 69)) expect_equivalent(dat.c$comp, c("i-n", "i-n", "g-n", "i-n", "i-n", "i-n", "i-s", "i-n", "i-n", "i-s", "g-s", "i-n", "s-n", "s-n", "i-n", "i-g", "i-g", "g-s", "i-n", "i-n", "g-n", "s-n", "i-n", "i-n", "i-n", "i-n")) expect_equivalent(dat.c$design, c("i-n", "i-g-n", "i-g-n", "i-n", "i-n", "i-n", "i-s", "i-n", "i-n", "i-g-s", "i-g-s", "i-n", "s-n", "s-n", "i-n", "i-g", "i-g", "g-s", "i-n", "i-n", "g-n", "s-n", "i-n", "i-n", "i-n", "i-n")) }) rm(list=ls()) metafor/tests/testthat/test_plots_regplot.r0000644000176200001440000000232714503346421021036 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/plots:baujat_plot source("settings.r") context("Checking plots example: scatter/bubble plot") test_that("plot can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_regplot_test.png", res=200, width=1800, height=1500, type="cairo") ### adjust margins so the space is better used par(mar=c(5,5,1,2)) ### calculate (log) risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit mixed-effects model with absolute latitude as predictor res <- rma(yi, vi, mods = ~ ablat, data=dat) ### draw plot sav <- regplot(res, xlim=c(10,60), predlim=c(10,60), xlab="Absolute Latitude", refline=0, atransf=exp, at=log(seq(0.2,1.6,by=0.2)), digits=1, las=1, bty="l", label=c(4,7,12,13), offset=c(1.6,0.8), labsize=0.9, pi=TRUE, legend=TRUE, grid=TRUE) points(sav) dev.off() expect_true(.vistest("images/test_plots_regplot_test.png", "images/test_plots_regplot.png")) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_rothman2008.r0000644000176200001440000004372614232774762023565 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:rothman2008 context("Checking analysis example: rothman2008") source("settings.r") ############################################################################ ### create dataset (Table 15-1) dat <- data.frame( age = c("Age <55", "Age 55+"), ai = c(8,22), bi = c(98,76), ci = c(5,16), di = c(115,69), stringsAsFactors=FALSE) test_that("the to.table() function works.", { tmp <- to.table(ai=ai, bi=bi, ci=ci, di=di, data=dat, measure="OR", slab=age, rows=c("Tolbutamide", "Placebo"), cols=c("Dead", "Surviving")) expected <- structure(c(8, 5, 98, 115, 22, 16, 76, 69), .Dim = c(2L, 2L, 2L), .Dimnames = list(c("Tolbutamide", "Placebo"), c("Dead", "Surviving"), c("Age <55", "Age 55+"))) ### compare with data in Table 15-1 expect_equivalent(tmp, expected) }) test_that("the to.long() function works.", { tmp <- to.long(ai=ai, bi=bi, ci=ci, di=di, data=dat, measure="OR", slab=age) expected <- structure(list(age = c("Age <55", "Age <55", "Age 55+", "Age 55+"), ai = c(8, 8, 22, 22), bi = c(98, 98, 76, 76), ci = c(5, 5, 16, 16), di = c(115, 115, 69, 69), study = structure(c(2L, 2L, 1L, 1L), .Label = c("Age 55+", "Age <55"), class = "factor"), group = structure(c(2L, 1L, 2L, 1L), .Label = c("2", "1"), class = "factor"), out1 = c(8, 5, 22, 16), out2 = c(98, 115, 76, 69)), class = "data.frame", row.names = c(NA, 4L)) expect_equivalent(tmp, expected) }) test_that("the stratum-specific and crude risk differences are computed correctly.", { ### stratum-specific risk differences tmp <- summary(escalc(ai=ai, bi=bi, ci=ci, di=di, data=dat, measure="RD", digits=3, append=FALSE)) tmp <- as.matrix(tmp[1:4]) expected <- structure(c(0.0338, 0.0363, 0.001, 0.0036, 0.0315, 0.0598, 1.0738, 0.6064), .Dim = c(2L, 4L), .Dimnames = list(NULL, c("yi", "vi", "sei", "zi"))) ### compare with data in Table 15-1 expect_equivalent(tmp, expected, tolerance=.tol[["misc"]]) ### crude risk difference tmp <- summary(escalc(ai=sum(ai), bi=sum(bi), ci=sum(ci), di=sum(di), data=dat, measure="RD", digits=3, append=FALSE)) tmp <- as.matrix(tmp[1:4]) expected <- structure(c(0.0446, 0.0011, 0.0326, 1.3683), .Dim = c(1L, 4L), .Dimnames = list(NULL, c("yi", "vi", "sei", "zi"))) ### compare with data in Table 15-1 expect_equivalent(tmp, expected, tolerance=.tol[["misc"]]) }) test_that("the stratum-specific and crude risk ratios are computed correctly.", { ### stratum-specific risk ratios tmp <- summary(escalc(ai=ai, bi=bi, ci=ci, di=di, data=dat, measure="RR", digits=2), transf=exp, append=FALSE) tmp <- as.matrix(tmp) expected <- structure(c(1.8113, 1.1926, 0.6112, 0.6713, 5.3679, 2.1188), .Dim = 2:3, .Dimnames = list(NULL, c("yi", "ci.lb", "ci.ub"))) ### compare with data in Table 15-1 expect_equivalent(tmp, expected, tolerance=.tol[["misc"]]) ### crude risk ratio tmp <- summary(escalc(ai=sum(ai), bi=sum(bi), ci=sum(ci), di=sum(di), data=dat, measure="RR", digits=2, append=FALSE), transf=exp) tmp <- as.matrix(tmp) expected <- structure(c(1.4356, 0.851, 2.4216), .Dim = c(1L, 3L), .Dimnames = list(NULL, c("yi", "ci.lb", "ci.ub"))) ### compare with data in Table 15-1 expect_equivalent(tmp, expected, tolerance=.tol[["misc"]]) }) test_that("results are correct for Mantel-Haenszel method.", { ### Mantel-Haenszel method with risk differences res <- rma.mh(ai=ai, bi=bi, ci=ci, di=di, data=dat, measure="RD", digits=3, level=90) out <- capture.output(print(res)) ### so that print.rma.mh() is used expect_equivalent(coef(res), 0.0349, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -0.0176, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 0.0874, tolerance=.tol[["ci"]]) ### 0.088 in chapter expect_equivalent(res$QE, 0.0017, tolerance=.tol[["test"]]) ### 0.001 in chapter expect_equivalent(res$QEp, 0.9669, tolerance=.tol[["pval"]]) ### Mantel-Haenszel method with risk ratios res <- rma.mh(ai=ai, bi=bi, ci=ci, di=di, data=dat, measure="RR", digits=2, level=90) out <- capture.output(print(res)) ### so that print.rma.mh() is used expect_equivalent(coef(res), 0.2818, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -0.1442, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 0.7078, tolerance=.tol[["ci"]]) expect_equivalent(res$QE, 0.4472, tolerance=.tol[["test"]]) expect_equivalent(res$QEp, 0.5037, tolerance=.tol[["pval"]]) tmp <- c(confint(res, transf=exp)$fixed) expect_equivalent(tmp, c(1.3256, 0.8658, 2.0296), tolerance=.tol[["ci"]]) ### Mantel-Haenszel method with odds ratios res <- rma.mh(ai=ai, bi=bi, ci=ci, di=di, data=dat, measure="OR", correct=FALSE, digits=2, level=90) out <- capture.output(print(res)) ### so that print.rma.mh() is used expect_equivalent(coef(res), 0.3387, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -0.1731, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 0.8505, tolerance=.tol[["ci"]]) expect_equivalent(res$QE, 0.3474, tolerance=.tol[["test"]]) expect_equivalent(res$QEp, 0.5556, tolerance=.tol[["pval"]]) expect_equivalent(res$CO, 1.1976, tolerance=.tol[["test"]]) expect_equivalent(res$COp, 0.2738, tolerance=.tol[["pval"]]) expect_equivalent(res$MH, 1.1914, tolerance=.tol[["test"]]) expect_equivalent(res$MHp, 0.2750, tolerance=.tol[["pval"]]) expect_equivalent(res$TA, 0.3489, tolerance=.tol[["test"]]) expect_equivalent(res$TAp, 0.5547, tolerance=.tol[["pval"]]) tmp <- c(confint(res, transf=exp)$fixed) expect_equivalent(tmp, c(1.4031, 0.8411, 2.3409), tolerance=.tol[["ci"]]) skip_on_cran() ### conditional MLE of the odds ratio res <- rma.glmm(ai=ai, bi=bi, ci=ci, di=di, data=dat, measure="OR", model="CM.EL", method="EE") expect_equivalent(coef(res), 0.3381, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -0.2699, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 0.9461, tolerance=.tol[["ci"]]) expect_equivalent(res$QE.Wld, 0.3480, tolerance=.tol[["test"]]) expect_equivalent(res$QEp.Wld, 0.5552, tolerance=.tol[["pval"]]) expect_equivalent(res$QE.LRT, 0.3502, tolerance=.tol[["test"]]) expect_equivalent(res$QEp.LRT, 0.5540, tolerance=.tol[["pval"]]) tmp <- predict(res, transf=exp) expect_equivalent(tmp$pred, 1.4022, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 0.7634, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 2.5756, tolerance=.tol[["ci"]]) }) ############################################################################ ### create dataset (Table 15-2) dat <- data.frame( age = c("35-44", "45-54", "55-64", "65-74", "75-84"), x1i = c(32, 104, 206, 186, 102), t1i = c(52407, 43248, 28612, 12663, 5317) / 10000, x2i = c(2, 12, 28, 28, 31), t2i = c(18790, 10673, 5710, 2585, 1462) / 10000, stringsAsFactors=FALSE) test_that("the to.table() function works.", { tmp <- to.table(x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, data=dat, measure="IRR", slab=age, rows=c("Smokers", "Nonsmokers"), cols=c("Deaths", "Years")) expected <- structure(c(32, 2, 5.2407, 1.879, 104, 12, 4.3248, 1.0673, 206, 28, 2.8612, 0.571, 186, 28, 1.2663, 0.2585, 102, 31, 0.5317, 0.1462), .Dim = c(2L, 2L, 5L), .Dimnames = list(c("Smokers", "Nonsmokers"), c("Deaths", "Years"), c("35-44", "45-54", "55-64", "65-74", "75-84"))) ### compare with data in Table 15-2 expect_equivalent(tmp, expected) }) test_that("the to.long() function works.", { tmp <- to.long(x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, data=dat, measure="IRR", slab=age) expected <- structure(list(age = c("35-44", "35-44", "45-54", "45-54", "55-64", "55-64", "65-74", "65-74", "75-84", "75-84"), x1i = c(32, 32, 104, 104, 206, 206, 186, 186, 102, 102), t1i = c(5.2407, 5.2407, 4.3248, 4.3248, 2.8612, 2.8612, 1.2663, 1.2663, 0.5317, 0.5317), x2i = c(2, 2, 12, 12, 28, 28, 28, 28, 31, 31), t2i = c(1.879, 1.879, 1.0673, 1.0673, 0.571, 0.571, 0.2585, 0.2585, 0.1462, 0.1462), study = structure(c(1L, 1L, 2L, 2L, 3L, 3L, 4L, 4L, 5L, 5L), .Label = c("35-44", "45-54", "55-64", "65-74", "75-84"), class = "factor"), group = structure(c(2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L), .Label = c("2", "1"), class = "factor"), events = c(32, 2, 104, 12, 206, 28, 186, 28, 102, 31), ptime = c(5.2407, 1.879, 4.3248, 1.0673, 2.8612, 0.571, 1.2663, 0.2585, 0.5317, 0.1462)), class = "data.frame", row.names = c(NA, 10L)) expect_equivalent(tmp, expected) }) test_that("the stratum-specific and crude rate differences are computed correctly.", { ### stratum-specific rate differences tmp <- summary(escalc(x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, data=dat, measure="IRD", digits=1, append=FALSE)) tmp <- as.matrix(tmp[1:4]) expected <- structure(c(5.0417, 12.804, 22.961, 38.5674, -20.2008, 1.7316, 16.0947, 111.0423, 535.0172, 1811.1307, 1.3159, 4.0118, 10.5377, 23.1304, 42.5574, 3.8313, 3.1916, 2.1789, 1.6674, -0.4747), .Dim = c(5L, 4L), .Dimnames = list(NULL, c("yi", "vi", "sei", "zi"))) ### compare with data in Table 15-2 expect_equivalent(tmp, expected, tolerance=.tol[["misc"]]) ### crude rate difference tmp <- summary(escalc(x1i=sum(x1i), x2i=sum(x2i), t1i=sum(t1i), t2i=sum(t2i), data=dat, measure="IRD", digits=1, append=FALSE)) tmp <- as.matrix(tmp[1:4]) expected <- structure(c(18.537, 9.6796, 3.1112, 5.9581), .Dim = c(1L, 4L), .Dimnames = list(NULL, c("yi", "vi", "sei", "zi"))) ### compare with data in Table 15-2 expect_equivalent(tmp, expected, tolerance=.tol[["misc"]]) }) test_that("the stratum-specific and crude rate ratios are computed correctly.", { ### stratum-specific rate ratios tmp <- summary(escalc(x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, data=dat, measure="IRR", digits=1, append=FALSE), transf=exp) tmp <- as.matrix(tmp) expected <- structure(c(5.7366, 2.1388, 1.4682, 1.3561, 0.9047, 1.3748, 1.1767, 0.9894, 0.9115, 0.6053, 23.9371, 3.8876, 2.1789, 2.0176, 1.3524), .Dim = c(5L, 3L), .Dimnames = list(NULL, c("yi", "ci.lb", "ci.ub"))) ### compare with data in Table 15-2 expect_equivalent(tmp, expected, tolerance=.tol[["misc"]]) ### crude rate ratio tmp <- summary(escalc(x1i=sum(x1i), x2i=sum(x2i), t1i=sum(t1i), t2i=sum(t2i), data=dat, measure="IRR", digits=1, append=FALSE), transf=exp) tmp <- as.matrix(tmp) expected <- structure(c(1.7198, 1.394, 2.1219), .Dim = c(1L, 3L), .Dimnames = list(NULL, c("yi", "ci.lb", "ci.ub"))) ### compare with data in Table 15-2 expect_equivalent(tmp, expected, tolerance=.tol[["misc"]]) }) test_that("results are correct for Mantel-Haenszel method.", { ### Mantel-Haenszel method with rate differences res <- rma.mh(x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, data=dat, measure="IRD", digits=2, level=90) expect_equivalent(coef(res), 11.4392, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, 6.3498, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 16.5286, tolerance=.tol[["ci"]]) expect_equivalent(res$QE, 26.8758, tolerance=.tol[["test"]]) expect_equivalent(res$QEp, 0.0000, tolerance=.tol[["pval"]]) ### Mantel-Haenszel method with rate ratios res <- rma.mh(x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, data=dat, measure="IRR", digits=2, level=90) expect_equivalent(coef(res), 0.3539, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, 0.1776, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 0.5303, tolerance=.tol[["ci"]]) expect_equivalent(res$QE, 10.4117, tolerance=.tol[["test"]]) expect_equivalent(res$QEp, 0.0340, tolerance=.tol[["pval"]]) expect_equivalent(res$MH, 10.7021, tolerance=.tol[["test"]]) expect_equivalent(res$MHp, 0.0011, tolerance=.tol[["pval"]]) tmp <- c(confint(res, transf=exp)$fixed) expect_equivalent(tmp, c(1.4247, 1.1944, 1.6994), tolerance=.tol[["ci"]]) ### Mantel-Haenszel test without continuity correction res <- rma.mh(x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, data=dat, measure="IRR", level=90, correct=FALSE) expect_equivalent(res$MH, 11.0162, tolerance=.tol[["test"]]) expect_equivalent(res$MHp, 0.0009, tolerance=.tol[["pval"]]) skip_on_cran() ### unconditional MLE of the rate ratio res <- rma.glmm(x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, data=dat, measure="IRR", digits=2, level=90, model="UM.FS", method="EE") expect_equivalent(coef(res), 0.3545, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, 0.1779, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 0.5312, tolerance=.tol[["ci"]]) expect_equivalent(res$QE.Wld, 10.1991, tolerance=.tol[["test"]]) expect_equivalent(res$QEp.Wld, 0.0372, tolerance=.tol[["pval"]]) expect_equivalent(res$QE.LRT, 12.1324, tolerance=.tol[["test"]]) expect_equivalent(res$QEp.LRT, 0.0164, tolerance=.tol[["pval"]]) tmp <- predict(res, transf=exp) expect_equivalent(tmp$pred, 1.4255, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 1.1947, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 1.7009, tolerance=.tol[["ci"]]) ### conditional MLE of the rate ratio res <- rma.glmm(x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, data=dat, measure="IRR", digits=2, level=90, model="CM.EL", method="EE") expect_equivalent(coef(res), 0.3545, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, 0.1779, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 0.5312, tolerance=.tol[["ci"]]) expect_equivalent(res$QE.Wld, 10.1991, tolerance=.tol[["test"]]) expect_equivalent(res$QEp.Wld, 0.0372, tolerance=.tol[["pval"]]) expect_equivalent(res$QE.LRT, 12.1324, tolerance=.tol[["test"]]) expect_equivalent(res$QEp.LRT, 0.0164, tolerance=.tol[["pval"]]) tmp <- predict(res, transf=exp) expect_equivalent(tmp$pred, 1.4255, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 1.1947, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 1.7009, tolerance=.tol[["ci"]]) }) ############################################################################ ### create dataset (Table 15-5) dat <- data.frame( age = c("<35", "35+"), ai = c(3,1), bi = c(9,3), ci = c(104,5), di = c(1059,86), stringsAsFactors=FALSE) test_that("the to.table() function works.", { tmp <- to.table(ai=ai, bi=bi, ci=ci, di=di, data=dat, measure="OR", slab=age, rows=c("Down Syndrome", "Control"), cols=c("Spermicide Use", "No Spermicide")) expected <- structure(c(3, 104, 9, 1059, 1, 5, 3, 86), .Dim = c(2L, 2L, 2L), .Dimnames = list(c("Down Syndrome", "Control"), c("Spermicide Use", "No Spermicide"), c("<35", "35+"))) ### compare with data in Table 15-5 expect_equivalent(tmp, expected) }) test_that("the to.long() function works.", { tmp <- to.long(ai=ai, bi=bi, ci=ci, di=di, data=dat, measure="OR", slab=age) expected <- structure(list(age = c("<35", "<35", "35+", "35+"), ai = c(3, 3, 1, 1), bi = c(9, 9, 3, 3), ci = c(104, 104, 5, 5), di = c(1059, 1059, 86, 86), study = structure(c(2L, 2L, 1L, 1L), .Label = c("35+", "<35"), class = "factor"), group = structure(c(1L, 2L, 1L, 2L), .Label = c("1", "2"), class = "factor"), out1 = c(3, 104, 1, 5), out2 = c(9, 1059, 3, 86)), class = "data.frame", row.names = c(NA, 4L)) expect_equivalent(tmp, expected) }) test_that("results are correct for Mantel-Haenszel method.", { ### Mantel-Haenszel method with odds ratios res <- rma.mh(ai=ai, bi=bi, ci=ci, di=di, data=dat, measure="OR", digits=2, level=90, correct=FALSE) expect_equivalent(coef(res), 1.3300, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, 0.3579, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 2.3021, tolerance=.tol[["ci"]]) expect_equivalent(res$QE, 0.1378, tolerance=.tol[["test"]]) expect_equivalent(res$QEp, 0.7105, tolerance=.tol[["pval"]]) expect_equivalent(res$CO, 5.8248, tolerance=.tol[["test"]]) expect_equivalent(res$COp, 0.0158, tolerance=.tol[["pval"]]) expect_equivalent(res$MH, 5.8092, tolerance=.tol[["test"]]) expect_equivalent(res$MHp, 0.0159, tolerance=.tol[["pval"]]) expect_equivalent(res$TA, 0.1391, tolerance=.tol[["test"]]) expect_equivalent(res$TAp, 0.7092, tolerance=.tol[["pval"]]) tmp <- c(confint(res, transf=exp)$fixed) expect_equivalent(tmp, c(3.7812, 1.4304, 9.9954), tolerance=.tol[["ci"]]) skip_on_cran() ### unconditional MLE of the odds ratio res <- rma.glmm(ai=ai, bi=bi, ci=ci, di=di, data=dat, measure="OR", digits=2, level=90, model="UM.FS", method="EE") expect_equivalent(coef(res), 1.3318, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, 0.3582, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 2.3053, tolerance=.tol[["ci"]]) expect_equivalent(res$QE.Wld, 0.1374, tolerance=.tol[["test"]]) expect_equivalent(res$QEp.Wld, 0.7109, tolerance=.tol[["pval"]]) expect_equivalent(res$QE.LRT, 0.1324, tolerance=.tol[["test"]]) expect_equivalent(res$QEp.LRT, 0.7160, tolerance=.tol[["pval"]]) tmp <- predict(res, transf=exp) expect_equivalent(tmp$pred, 3.7878, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 1.4308, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 10.0276, tolerance=.tol[["ci"]]) ### conditional MLE of the odds ratio res <- rma.glmm(ai=ai, bi=bi, ci=ci, di=di, data=dat, measure="OR", digits=2, level=90, model="CM.EL", method="EE", control=list(optimizer="bobyqa")) #res <- rma.glmm(ai=ai, bi=bi, ci=ci, di=di, data=dat, measure="OR", digits=2, level=90, model="CM.EL", method="EE") expect_equivalent(coef(res), 1.3257, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, 0.3563, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 2.2950, tolerance=.tol[["ci"]]) expect_equivalent(res$QE.Wld, 0.1323, tolerance=.tol[["test"]]) expect_equivalent(res$QEp.Wld, 0.7161, tolerance=.tol[["pval"]]) expect_equivalent(res$QE.LRT, 0.1188, tolerance=.tol[["test"]]) expect_equivalent(res$QEp.LRT, 0.7304, tolerance=.tol[["pval"]]) tmp <- predict(res, transf=exp) expect_equivalent(tmp$pred, 3.7647, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 1.4280, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 9.9246, tolerance=.tol[["ci"]]) }) ############################################################################ rm(list=ls()) metafor/tests/testthat/test_misc_list_rma.r0000644000176200001440000000440314502310407020755 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: head.list.rma() and tail.list.rma() functions") source("settings.r") test_that("head.list.rma() works correctly.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, data=dat) res <- head(rstandard(res), 4) sav <- structure(list(resid = c(-0.1748, -0.8709, -0.6335, -0.727), se = c(0.7788, 0.6896, 0.8344, 0.5486), z = c(-0.2244, -1.2629, -0.7592, -1.3253), slab = 1:4, digits = c(est = 4, se = 4, test = 4, pval = 4, ci = 4, var = 4, sevar = 4, fit = 4, het = 4)), class = "list.rma") expect_equivalent(res, sav, tolerance=.tol[["misc"]]) }) test_that("tail.list.rma() works correctly.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, data=dat) res <- tail(rstandard(res), 4) sav <- structure(list(resid = c(-0.6568, 0.3752, 1.1604, 0.6972), se = c(0.5949, 0.5416, 0.9019, 0.5936), z = c(-1.104, 0.6927, 1.2867, 1.1746 ), slab = 10:13, digits = c(est = 4, se = 4, test = 4, pval = 4, ci = 4, var = 4, sevar = 4, fit = 4, het = 4)), class = "list.rma") expect_equivalent(res, sav, tolerance=.tol[["misc"]]) }) test_that("as.data.frame.list.rma() works correctly.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, mods = ~ ablat, data=dat) res <- predict(res) res <- as.data.frame(res) res <- res[1:3,1:2] sav <- structure(list(pred = c(-1.02900878645837, -1.34912705666653, -0.97080546460234), se = c(0.140375124151501, 0.201103941277043, 0.131456743392091)), row.names = c(NA, 3L), class = "data.frame") expect_equivalent(res, sav, tolerance=.tol[["misc"]]) }) test_that("as.matrix.list.rma() works correctly.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, mods = ~ ablat, data=dat) res <- predict(res) res <- as.matrix(res) res <- res[1:3,1:2] sav <- structure(c(-1.02900878645837, -1.34912705666653, -0.97080546460234, 0.140375124151501, 0.201103941277043, 0.131456743392091), dim = 3:2, dimnames = list(c("1", "2", "3"), c("pred", "se"))) expect_equivalent(res, sav, tolerance=.tol[["misc"]]) }) rm(list=ls()) metafor/tests/testthat/test_misc_plot_rma.r0000644000176200001440000000337114504513326020772 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: plot() function") source("settings.r") test_that("plot can be drawn for rma().", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, data=dat) png(filename="images/test_misc_plot_rma_1_test.png", res=200, width=1800, height=1800, type="cairo") plot(res) dev.off() expect_true(.vistest("images/test_misc_plot_rma_1_test.png", "images/test_misc_plot_rma_1.png")) res <- rma(yi ~ ablat, vi, data=dat) png(filename="images/test_misc_plot_rma_2_test.png", res=200, width=1800, height=1800, type="cairo") plot(res) dev.off() expect_true(.vistest("images/test_misc_plot_rma_2_test.png", "images/test_misc_plot_rma_2.png")) }) test_that("plot can be drawn for rma.mh().", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() res <- rma.mh(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) png(filename="images/test_misc_plot_rma_3_test.png", res=200, width=1800, height=1800, type="cairo") plot(res) dev.off() expect_true(.vistest("images/test_misc_plot_rma_3_test.png", "images/test_misc_plot_rma_3.png")) }) test_that("plot can be drawn for rma.peto().", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() res <- rma.peto(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) png(filename="images/test_misc_plot_rma_4_test.png", res=200, width=1800, height=1800, type="cairo") plot(res) dev.off() expect_true(.vistest("images/test_misc_plot_rma_4_test.png", "images/test_misc_plot_rma_4.png")) }) rm(list=ls()) metafor/tests/testthat/test_misc_emmprep.r0000644000176200001440000000441114304137131020610 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: emmprep() function") source("settings.r") test_that("emmprep() gives correct results for an intercept-only model.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, data=dat) sav <- capture.output(emmprep(res, verbose=TRUE)) sav <- emmprep(res) skip_on_cran() tmp <- emmeans::emmeans(sav, specs="1", type="response") tmp <- as.data.frame(tmp) expect_equivalent(tmp$response, 0.4894209, tolerance=.tol[["pred"]]) expect_equivalent(tmp$asymp.LCL, 0.3440743, tolerance=.tol[["ci"]]) expect_equivalent(tmp$asymp.UCL, 0.6961661, tolerance=.tol[["ci"]]) }) test_that("emmprep() gives correct results for a meta-regression model.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) dat$yi[1] <- NA res <- suppressWarnings(rma(yi, vi, mods = ~ ablat + alloc, data=dat, subset=-2, test="knha")) sav <- emmprep(res) skip_on_cran() tmp <- emmeans::emmeans(sav, specs="1", type="response") tmp <- as.data.frame(tmp) expect_equivalent(tmp$response, 0.5395324, tolerance=.tol[["pred"]]) expect_equivalent(tmp$lower.CL, 0.3564229, tolerance=.tol[["ci"]]) expect_equivalent(tmp$upper.CL, 0.8167130, tolerance=.tol[["ci"]]) sav <- emmprep(res, data=dat[-c(1,2),], df=7, sigma=sqrt(res$tau2), tran="log") tmp <- as.data.frame(tmp) expect_equivalent(tmp$response, 0.5395324, tolerance=.tol[["pred"]]) expect_equivalent(tmp$lower.CL, 0.3564229, tolerance=.tol[["ci"]]) expect_equivalent(tmp$upper.CL, 0.8167130, tolerance=.tol[["ci"]]) }) test_that("emmprep() gives correct results for the r-to-z transformation.", { dat <- dat.mcdaniel1994 dat <- escalc(measure="ZCOR", ri=ri, ni=ni, data=dat) res <- suppressWarnings(rma(yi, vi, mods = ~ factor(type), data=dat, test="knha")) sav <- emmprep(res) skip_on_cran() tmp <- emmeans::emmeans(sav, specs="1", type="response") tmp <- as.data.frame(tmp) expect_equivalent(tmp$response, 0.2218468, tolerance=.tol[["pred"]]) expect_equivalent(tmp$lower.CL, 0.1680606, tolerance=.tol[["ci"]]) expect_equivalent(tmp$upper.CL, 0.2743160, tolerance=.tol[["ci"]]) }) rm(list=ls()) metafor/tests/testthat/test_misc_fitstats.r0000644000176200001440000000702314502303765021016 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: computations of fit statistics") source("settings.r") test_that("fit statistics are correct for rma.uni().", { ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit random- and mixed-effects models (with ML estimation) res1 <- rma(yi, vi, data=dat, method="ML") res2 <- rma(yi ~ ablat, vi, data=dat, method="ML") tmp <- c(logLik(res1)) expect_equivalent(tmp, -12.6651, tolerance=.tol[["fit"]]) expect_equivalent(tmp, sum(dnorm(dat$yi, coef(res1), sqrt(dat$vi+res1$tau2), log=TRUE)), tolerance=.tol[["fit"]]) tmp <- deviance(res1) expect_equivalent(tmp, 37.1160, tolerance=.tol[["fit"]]) expect_equivalent(tmp, -2 * (sum(dnorm(dat$yi, coef(res1), sqrt(dat$vi+res1$tau2), log=TRUE)) - sum(dnorm(dat$yi, dat$yi, sqrt(dat$vi), log=TRUE))), tolerance=.tol[["fit"]]) tmp <- AIC(res1) expect_equivalent(tmp, 29.3302, tolerance=.tol[["fit"]]) expect_equivalent(tmp, -2 * sum(dnorm(dat$yi, coef(res1), sqrt(dat$vi+res1$tau2), log=TRUE)) + 2*2, tolerance=.tol[["fit"]]) tmp <- AIC(res1, res2) expect_equivalent(tmp, structure(list(df = c(2, 3), AIC = c(29.3302, 21.3713)), .Names = c("df", "AIC"), row.names = c("res1", "res2"), class = "data.frame"), tolerance=.tol[["fit"]]) tmp <- BIC(res1) expect_equivalent(tmp, 30.4601, tolerance=.tol[["fit"]]) expect_equivalent(tmp, -2 * sum(dnorm(dat$yi, coef(res1), sqrt(dat$vi+res1$tau2), log=TRUE)) + 2*log(res1$k), tolerance=.tol[["fit"]]) tmp <- BIC(res1, res2) expect_equivalent(tmp, structure(list(df = c(2, 3), BIC = c(30.4601, 23.0662)), .Names = c("df", "BIC"), row.names = c("res1", "res2"), class = "data.frame"), tolerance=.tol[["fit"]]) tmp <- c(fitstats(res1)) expect_equivalent(tmp, c(-12.6651, 37.1160, 29.3302, 30.4601, 30.5302), tolerance=.tol[["fit"]]) tmp <- fitstats(res1, res2) expect_equivalent(tmp, structure(list(res1 = c(-12.6651, 37.116, 29.3302, 30.4601, 30.5302), res2 = c(-7.6857, 27.1572, 21.3713, 23.0662, 24.038)), .Names = c("res1", "res2"), row.names = c("logLik:", "deviance:", "AIC:", "BIC:", "AICc:"), class = "data.frame"), tolerance=.tol[["fit"]]) tmp <- nobs(res1) expect_equivalent(tmp, 13) tmp <- df.residual(res1) expect_equivalent(tmp, 12) }) test_that("fit statistics are correct for rma.mv().", { ### load data dat <- dat.berkey1998 ### construct variance-covariance matrix of the observed outcomes V <- bldiag(lapply(split(dat[,c("v1i", "v2i")], dat$trial), as.matrix)) ### multiple outcomes random-effects model (with ML estimation) res <- rma.mv(yi, V, mods = ~ outcome - 1, random = ~ outcome | trial, struct="UN", data=dat, method="ML", sparse=.sparse) tmp <- c(logLik(res)) expect_equivalent(tmp, 5.8407, tolerance=.tol[["fit"]]) tmp <- deviance(res) expect_equivalent(tmp, 25.6621, tolerance=.tol[["fit"]]) tmp <- AIC(res) expect_equivalent(tmp, -1.6813, tolerance=.tol[["fit"]]) expect_equivalent(tmp, -2 * c(logLik(res)) + 2*5, tolerance=.tol[["fit"]]) tmp <- BIC(res) expect_equivalent(tmp, -0.1684, tolerance=.tol[["fit"]]) expect_equivalent(tmp, -2 * c(logLik(res)) + 5*log(res$k), tolerance=.tol[["fit"]]) tmp <- c(fitstats(res)) expect_equivalent(tmp, c(5.8407, 25.6621, -1.6813, -0.1684, 13.3187), tolerance=.tol[["fit"]]) tmp <- nobs(res) expect_equivalent(tmp, 10) tmp <- df.residual(res) expect_equivalent(tmp, 8) }) rm(list=ls()) metafor/tests/testthat/test_misc_pub_bias.r0000644000176200001440000000347214204414476020746 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: regtest() and ranktest() functions") source("settings.r") test_that("regtest() works correctly for 'rma.uni' objects.", { dat <- dat.egger2001 dat <- escalc(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat) res <- rma(yi, vi, data=dat) sav <- regtest(res) expect_equivalent(sav$zval, -4.6686, tolerance=.tol[["test"]]) out <- capture.output(print(sav)) ### so that print.regtest.rma() is run (at least once) sav <- regtest(yi, vi, data=dat) expect_equivalent(sav$zval, -4.6686, tolerance=.tol[["test"]]) sav <- regtest(yi, vi, data=dat) expect_equivalent(sav$zval, -4.6686, tolerance=.tol[["test"]]) sav <- regtest(res, model="lm", predictor="sqrtninv") expect_equivalent(sav$zval, -5.6083, tolerance=.tol[["test"]]) sav <- regtest(yi, vi, data=dat, model="lm", predictor="sqrtninv") expect_equivalent(sav$zval, -5.6083, tolerance=.tol[["test"]]) sav <- regtest(yi, vi, data=dat, model="lm", predictor="sqrtninv") expect_equivalent(sav$zval, -5.6083, tolerance=.tol[["test"]]) }) test_that("ranktest() works correctly for 'rma.uni' objects.", { dat <- dat.egger2001 dat <- escalc(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat) res <- rma(yi, vi, data=dat) sav <- ranktest(res) expect_equivalent(sav$tau, 0.15) expect_equivalent(sav$pval, 0.4503, tolerance=.tol[["pval"]]) sav <- ranktest(yi, vi, data=dat) expect_equivalent(sav$tau, 0.15) expect_equivalent(sav$pval, 0.4503, tolerance=.tol[["pval"]]) sav <- ranktest(yi, vi, data=dat) expect_equivalent(sav$tau, 0.15) expect_equivalent(sav$pval, 0.4503, tolerance=.tol[["pval"]]) out <- capture.output(print(sav)) ### so that print.ranktest.rma() is run (at least once) }) rm(list=ls()) metafor/tests/testthat/test_misc_transf.r0000644000176200001440000000365714204414575020464 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: transformation functions") source("settings.r") test_that("transformations work correctly.", { expect_equivalent(transf.rtoz(.5), 0.549306, tolerance=.tol[["est"]]) expect_equivalent(transf.ztor(transf.rtoz(.5)), .5) expect_equivalent(transf.logit(.1), -2.197225, tolerance=.tol[["est"]]) expect_equivalent(transf.ilogit(transf.logit(.1)), .1) expect_equivalent(transf.arcsin(.1), 0.321751, tolerance=.tol[["est"]]) expect_equivalent(transf.iarcsin(transf.arcsin(.1)), .1) expect_equivalent(transf.pft(.1,10), 0.373394, tolerance=.tol[["est"]]) expect_equivalent(transf.ipft(transf.pft(.1,10), 10), .1) expect_equivalent(transf.ipft.hm(transf.pft(.1,10), targs=list(ni=c(10))), .1) expect_equivalent(transf.isqrt(.1), 0.01) expect_equivalent(transf.irft(.1,10), 0.381721, tolerance=.tol[["est"]]) expect_equivalent(transf.iirft(transf.irft(.1,10), 10), .1) expect_equivalent(transf.ahw(.9), 0.535841, tolerance=.tol[["est"]]) expect_equivalent(transf.iahw(transf.ahw(.9)), .9) expect_equivalent(transf.abt(.9), 2.302585, tolerance=.tol[["est"]]) expect_equivalent(transf.iabt(transf.abt(.9)), .9) expect_equivalent(transf.ztor.int(transf.rtoz(.5), targs=list(tau2=0)), .5) expect_equivalent(transf.ztor.int(transf.rtoz(.5), targs=list(tau2=0.1)), 0.46663, tolerance=.tol[["est"]]) expect_equivalent(transf.exp.int(log(.5), targs=list(tau2=0)), .5) expect_equivalent(transf.exp.int(log(.5), targs=list(tau2=0.1)), 0.525635, tolerance=.tol[["est"]]) expect_equivalent(transf.exp.int(log(.5), targs=list(tau2=0.1, lower=-10, upper=10)), exp(log(.5) + 0.1/2), tolerance=.tol[["est"]]) expect_equivalent(transf.ilogit.int(transf.logit(.1), targs=list(tau2=0)), .1) expect_equivalent(transf.ilogit.int(transf.logit(.1), targs=list(tau2=0.1)), 0.103591, tolerance=.tol[["est"]]) }) rm(list=ls()) metafor/tests/testthat/test_misc_predict.r0000644000176200001440000000533014204414473020604 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: predict() function") source("settings.r") test_that("predict() correctly matches named vectors in 'newmods'", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) dat$alloc[dat$alloc == "systematic"] <- "system" res <- rma(yi ~ ablat + alloc, vi, data=dat) pred1 <- predict(res, newmods = c(30, 0, 1)) pred2 <- predict(res, newmods = c(abl = 30, ran = 0, sys = 1)) pred3 <- predict(res, newmods = c(abl = 30, sys = 1, ran = 0)) pred4 <- predict(res, newmods = c(ran = 0, abl = 30, sys = 1)) pred5 <- predict(res, newmods = c(sys = 1, abl = 30, ran = 0)) pred6 <- predict(res, newmods = c(ran = 0, sys = 1, abl = 30)) pred7 <- predict(res, newmods = c(sys = 1, ran = 0, abl = 30)) expect_equivalent(pred1, pred2) expect_equivalent(pred1, pred3) expect_equivalent(pred1, pred4) expect_equivalent(pred1, pred5) expect_equivalent(pred1, pred6) expect_equivalent(pred1, pred7) expect_error(predict(res, newmods = c(30, 0))) # not the right length expect_error(predict(res, newmods = c(30, 0, 0, 0))) # not the right length expect_error(predict(res, newmods = c(abl = 30, random = 0))) # not the right length expect_error(predict(res, newmods = c(abl = 30, alloc = 0, sys = 1))) # alloc matches up equally to allocrandom and allocsystem expect_error(predict(res, newmods = c(abl = 30, ran = 0, year = 1970))) # year not in the model expect_error(predict(res, newmods = c(abl = 30, ran = 0, sys = 1, ran = 1))) # ran used twice expect_error(predict(res, newmods = c(abl = 30, ran = 0, sys = 1, rand = 1))) # same issue res <- rma(yi ~ ablat * year, vi, data=dat) pred1 <- predict(res, newmods = c(30, 1970, 30*1970)) pred2 <- predict(res, newmods = c('ablat' = 30, 'year' = 1970, 'ablat:year' = 30*1970)) pred3 <- predict(res, newmods = c('ablat:year' = 30*1970, 'year' = 1970, 'ablat' = 30)) pred4 <- predict(res, newmods = c('ab' = 30, 'ye' = 1970, 'ablat:' = 30*1970)) pred5 <- predict(res, newmods = c('ablat:' = 30*1970, 'ye' = 1970, 'ab' = 30)) expect_equivalent(pred1, pred2) expect_equivalent(pred1, pred3) expect_equivalent(pred1, pred4) expect_equivalent(pred1, pred5) }) test_that("predict() gives correct results when vcov=TRUE", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, data=dat) sav <- predict(res, vcov=TRUE) expect_equivalent(sav$pred$se, c(sqrt(sav$vcov)), tolerance=.tol[["se"]]) res <- rma(yi, vi, mods = ~ ablat, data=dat) sav <- predict(res, vcov=TRUE) expect_equivalent(sav$pred$se, c(sqrt(diag(sav$vcov))), tolerance=.tol[["se"]]) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_konstantopoulos2011.r0000644000176200001440000002626514503355474025364 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:konstantopoulos2011 context("Checking analysis example: konstantopoulos2011") source("settings.r") dat <- dat.konstantopoulos2011 test_that("results are correct for the two-level random-effects model fitted with rma().", { res <- rma(yi, vi, data=dat) ### compare with results on page 70 (Table 4) expect_equivalent(coef(res), 0.1279, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.0439, tolerance=.tol[["se"]]) expect_equivalent(res$tau2, 0.0884, tolerance=.tol[["var"]]) expect_equivalent(res$se.tau2, 0.0202, tolerance=.tol[["sevar"]]) ### CI for tau^2 based on the Q-profile method (CI in paper is based on a Satterthwaite approximation) tmp <- confint(res, digits=3) out <- capture.output(print(tmp)) ### so that print.confint.rma() is run (at least once) expect_equivalent(tmp$random[1,2], 0.0564, tolerance=.tol[["var"]]) expect_equivalent(tmp$random[1,3], 0.1388, tolerance=.tol[["var"]]) }) test_that("results are correct for the two-level mixed-effects model fitted with rma().", { res <- rma(yi, vi, mods = ~ I(year-mean(year)), data=dat) ### compare with results on page 70 (Table 4) expect_equivalent(coef(res), c(0.1258, 0.0052), tolerance=.tol[["coef"]]) expect_equivalent(res$se, c(0.0440, 0.0044), tolerance=.tol[["se"]]) ### 0.043 in paper expect_equivalent(res$tau2, 0.0889, tolerance=.tol[["var"]]) ### 0.088 in paper expect_equivalent(res$se.tau2, 0.0205, tolerance=.tol[["sevar"]]) ### CI for tau^2 based on the Q-profile method (CI in paper is based on a Satterthwaite approximation) tmp <- confint(res, digits=3) expect_equivalent(tmp$random[1,2], 0.0560, tolerance=.tol[["var"]]) expect_equivalent(tmp$random[1,3], 0.1376, tolerance=.tol[["var"]]) }) test_that("results are correct for the two-level random-effects model fitted with rma.mv().", { res <- rma.mv(yi, vi, random = ~ 1 | study, data=dat, sparse=.sparse) ### compare with results on page 70 (Table 4) expect_equivalent(coef(res), 0.1279, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.0439, tolerance=.tol[["se"]]) expect_equivalent(res$sigma2, 0.0884, tolerance=.tol[["var"]]) }) test_that("results are correct for the three-level random-effects model fitted with rma.mv() using ML estimation.", { ### three-level model (ml = multilevel parameterization) res.ml <- rma.mv(yi, vi, random = ~ 1 | district/study, data=dat, method="ML", sparse=.sparse) out <- capture.output(print(res.ml)) out <- capture.output(print(summary(res.ml))) ### compare with results on page 71 (Table 5) expect_equivalent(coef(res.ml), 0.1845, tolerance=.tol[["coef"]]) expect_equivalent(res.ml$se, 0.0805, tolerance=.tol[["se"]]) expect_equivalent(res.ml$sigma2, c(0.0577, 0.0329), tolerance=.tol[["var"]]) sav <- predict(res.ml) expect_equivalent(c(sav$pi.lb, sav$pi.ub), c(-0.4262, 0.7951), tolerance=.tol[["pred"]]) }) test_that("results are correct for the three-level mixed-effects model fitted with rma.mv() using ML estimation.", { ### three-level model (multilevel parameterization) res.ml <- rma.mv(yi, vi, mods = ~ I(year-mean(year)), random = ~ 1 | district/study, data=dat, method="ML", sparse=.sparse) out <- capture.output(print(res.ml)) ### compare with results on page 71 (Table 5) expect_equivalent(coef(res.ml), c(0.1780, 0.0051), tolerance=.tol[["coef"]]) ### intercept is given as 0.183 in paper, but this seems to be a misprint expect_equivalent(res.ml$se, c(0.0805, 0.0085), tolerance=.tol[["se"]]) expect_equivalent(res.ml$sigma2, c(0.0565, 0.0329), tolerance=.tol[["var"]]) }) test_that("results are correct for the three-level random-effects model fitted with rma.mv() using REML estimation.", { ### three-level model (ml = multilevel parameterization) res.ml <- rma.mv(yi, vi, random = ~ 1 | district/study, data=dat, sparse=.sparse) out <- capture.output(print(res.ml)) ### (results for this not given in paper) expect_equivalent(coef(res.ml), 0.1847, tolerance=.tol[["coef"]]) expect_equivalent(res.ml$se, 0.0846, tolerance=.tol[["se"]]) expect_equivalent(res.ml$sigma2, c(0.0651, 0.0327), tolerance=.tol[["var"]]) ### ICC expect_equivalent(res.ml$sigma2[1] / sum(res.ml$sigma2), 0.6653, tolerance=.tol[["cor"]]) ### total amount of heterogeneity expect_equivalent(sum(res.ml$sigma2), 0.0978, tolerance=.tol[["var"]]) ### log likelihood expect_equivalent(c(logLik(res.ml)), -7.9587, tolerance=.tol[["fit"]]) ### CIs for variance components sav <- confint(res.ml) sav <- round(as.data.frame(sav), 4) expected <- structure(c(0.0651, 0.2551, 0.0327, 0.1809, 0.0222, 0.1491, 0.0163, 0.1276, 0.2072, 0.4552, 0.0628, 0.2507), .Dim = 4:3, .Dimnames = list(c("sigma^2.1", "sigma.1", "sigma^2.2", "sigma.2"), c("estimate", "ci.lb", "ci.ub"))) expect_equivalent(sav, expected, tolerance=.tol[["var"]]) }) test_that("profiling works for the three-level random-effects model (multilevel parameterization).", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() ### three-level model (ml = multilevel parameterization) res.ml <- rma.mv(yi, vi, random = ~ 1 | district/study, data=dat, sparse=.sparse) ### profile variance components png("images/test_analysis_example_konstantopoulos2011_profile_1_test.png", res=200, width=1800, height=2000, type="cairo") par(mfrow=c(2,1)) sav <- profile(res.ml, progbar=FALSE) dev.off() expect_true(.vistest("images/test_analysis_example_konstantopoulos2011_profile_1_test.png", "images/test_analysis_example_konstantopoulos2011_profile_1.png")) out <- capture.output(print(sav)) }) test_that("results are correct for the three-level random-effects model when using the multivariate parameterization.", { ### three-level model (mv = multivariate parameterization) res.mv <- rma.mv(yi, vi, random = ~ factor(study) | district, data=dat, sparse=.sparse) ### (results for this not given in paper) expect_equivalent(coef(res.mv), 0.1847, tolerance=.tol[["coef"]]) expect_equivalent(res.mv$se, 0.0846, tolerance=.tol[["se"]]) expect_equivalent(res.mv$tau2, 0.0978, tolerance=.tol[["var"]]) expect_equivalent(res.mv$rho, 0.6653, tolerance=.tol[["cor"]]) ### log likelihood expect_equivalent(c(logLik(res.mv)), -7.9587, tolerance=.tol[["fit"]]) }) test_that("profiling works for the three-level random-effects model (multivariate parameterization).", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() ### three-level model (mv = multivariate parameterization) res.mv <- rma.mv(yi, vi, random = ~ factor(study) | district, data=dat, sparse=.sparse) ### profile variance components png("images/test_analysis_example_konstantopoulos2011_profile_2_test.png", res=200, width=1800, height=2000, type="cairo") par(mfrow=c(2,1)) #profile(res.mv, progbar=FALSE) profile(res.mv, progbar=FALSE, parallel="snow") dev.off() expect_true(.vistest("images/test_analysis_example_konstantopoulos2011_profile_2_test.png", "images/test_analysis_example_konstantopoulos2011_profile_2.png")) }) test_that("BLUPs are calculated correctly for the three-level random-effects model (multilevel parameterization).", { skip_on_cran() ### three-level model (ml = multilevel parameterization) res.ml <- rma.mv(yi, vi, random = ~ 1 | district/study, data=dat, sparse=.sparse) sav <- ranef(res.ml) expect_equivalent(sav[[1]]$intrcpt, c(-0.18998596, -0.08467077, 0.1407273, 0.24064814, -0.1072942, -0.23650899, 0.5342778, -0.2004695, 0.05711692, -0.14168396, -0.01215679), tolerance=.tol[["pred"]]) expect_equivalent(sav[[1]]$se, c(0.16653966, 0.12407891, 0.13724053, 0.11885896, 0.11895233, 0.10112845, 0.1297891, 0.101322, 0.11104458, 0.12485549, 0.15042221), tolerance=.tol[["se"]]) expect_equivalent(sav[[2]]$intrcpt, c(-0.03794675, -0.04663383, 0.04357906, -0.05459167, 0.02098376, -0.25219111, 0.06169069, 0.12691378, 0.07315932, 0.02358293, -0.02593401, -0.16472466, 0.20017925, -0.05824454, 0.14387428, 0.00163316, -0.03082723, 0.09766431, -0.12245631, -0.07958353, 0.03342001, 0.03277405, -0.13648311, 0.00732233, -0.15120705, 0.10293055, 0.04267145, 0.08386343, -0.02323572, -0.03147411, -0.28733359, 0.19536367, 0.36079672, -0.0526358, -0.03322863, 0.00558571, 0.03469647, -0.01382146, 0.0152893, 0.02499288, -0.08174655, 0.19776024, 0.31299764, -0.03204218, -0.18968221, -0.13730492, -0.12298966, -0.28918454, 0.33743506, -0.03810734, 0.11843554, -0.19986832, -0.01436916, 0.12481101, -0.04350898, -0.07304968), tolerance=.tol[["pred"]]) expect_equivalent(sav[[2]]$se, c(0.16388194, 0.16388194, 0.16603559, 0.16603559, 0.12233812, 0.12233812, 0.12342216, 0.13171712, 0.13653182, 0.14617064, 0.12941105, 0.12588568, 0.10313659, 0.10313659, 0.10868276, 0.12489868, 0.10877088, 0.10517399, 0.10324522, 0.11803445, 0.11512181, 0.11661284, 0.12068892, 0.11803445, 0.11939164, 0.08878259, 0.09186319, 0.09186319, 0.09186319, 0.09186319, 0.12687757, 0.12311091, 0.12210943, 0.06873404, 0.06873404, 0.06873404, 0.06873404, 0.06873404, 0.06873404, 0.06873404, 0.06873404, 0.10744609, 0.10928134, 0.10744609, 0.10550931, 0.11267925, 0.11267925, 0.13697347, 0.13697347, 0.13632667, 0.13632667, 0.13632667, 0.1589217, 0.1581043, 0.15527374, 0.15527374), tolerance=.tol[["se"]]) }) test_that("restarting with 'restart=TRUE' works.", { skip_on_cran() expect_error(res <- rma.mv(yi, vi, random = ~ 1 | district/study, data=dat, control=list(maxiter=4))) expect_error(res <- rma.mv(yi, vi, random = ~ 1 | district/study, data=dat, control=list(maxiter=4), restart=TRUE)) res <- rma.mv(yi, vi, random = ~ 1 | district/study, data=dat, control=list(maxiter=4), restart=TRUE) expect_equivalent(coef(res), 0.1847132, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.08455592, tolerance=.tol[["se"]]) expect_equivalent(res$sigma2, c(0.06506194, 0.03273652), tolerance=.tol[["var"]]) }) test_that("results are correct when allowing for different tau^2 per district.", { skip_on_cran() ### shuffle up dat to make sure that this does not affect things set.seed(1234) dat <- dat[sample(nrow(dat)),] res <- rma.mv(yi, vi, random = list(~ 1 | district, ~ factor(district) | study), struct="DIAG", data=dat, control=list(optimizer="optim"), sparse=.sparse) out <- capture.output(print(res, digits=4)) out <- capture.output(print(summary(res, digits=4))) expect_equivalent(coef(res), 0.1270, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.0588, tolerance=.tol[["se"]]) expect_equivalent(res$tau2, c(0.0000, 0.0402, 0.0000, 0.0582, 0.0082, 0.0000, 0.5380, 0.0008, 0.0606, 0.1803, 0.0000), tolerance=.tol[["var"]]) ### check that output is also correct tau2 <- as.numeric(substr(out[grep("tau", out)], 13, 18)) expect_equivalent(res$tau2, c(0.0000, 0.0402, 0.0000, 0.0582, 0.0082, 0.0000, 0.5380, 0.0008, 0.0606, 0.1803, 0.0000), tolerance=.tol[["var"]]) k.lvl <- as.numeric(substr(out[grep("tau", out)], 32, 33)) expect_equivalent(k.lvl, c(4, 4, 3, 4, 4, 11, 3, 8, 6, 5, 4)) level <- as.numeric(substr(out[grep("tau", out)], 45, 47)) expect_equivalent(level, c(11, 12, 18, 27, 56, 58, 71, 86, 91, 108, 644)) }) rm(list=ls()) metafor/tests/testthat/test_misc_matreg.r0000644000176200001440000001005614502304001020414 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: matreg() function") source("settings.r") test_that("matreg() works correctly for the 'mtcars' dataset.", { dat <- mtcars res1 <- lm(mpg ~ hp + wt + am, data=dat) S <- cov(dat) res2 <- matreg(y="mpg", x=c("hp","wt","am"), R=S, cov=TRUE, means=colMeans(dat), n=nrow(dat)) expect_equivalent(coef(res1), coef(res2), tolerance=.tol[["coef"]]) expect_equivalent(vcov(res1), vcov(res2), tolerance=.tol[["coef"]]) dat[] <- scale(dat) res1 <- lm(mpg ~ 0 + hp + wt + am, data=dat) R <- cor(dat) res2 <- matreg(y="mpg", x=c("hp","wt","am"), R=R, n=nrow(dat)) expect_equivalent(coef(res1), coef(res2), tolerance=.tol[["coef"]]) expect_equivalent(vcov(res1), vcov(res2), tolerance=.tol[["coef"]]) }) test_that("matreg() works correctly for 'dat.craft2003'.", { dat <- dat.craft2003 ### construct dataset and var-cov matrix of the correlations tmp <- rcalc(ri ~ var1 + var2 | study, ni=ni, data=dat) V <- tmp$V dat <- tmp$dat out <- capture.output(print(tmp)) sav <- structure(list(study = c("1", "1", "1", "1", "1", "1"), var1 = c("acog", "asom", "conf", "acog", "acog", "asom"), var2 = c("perf", "perf", "perf", "asom", "conf", "conf"), var1.var2 = c("acog.perf", "asom.perf", "conf.perf", "acog.asom", "acog.conf", "asom.conf"), yi = c(-0.55, -0.48, 0.66, 0.47, -0.38, -0.46), ni = c(142L, 142L, 142L, 142L, 142L, 142L)), row.names = c(NA, 6L), class = "data.frame") expect_equivalent(dat[1:6,], sav, tolerance=.tol[["coef"]]) sav <- structure(c(0.00345039893617021, 0.00132651489361702, -0.000554579787234042, -0.00139678475177305, 0.00250189539007092, 0.000932237234042553, 0.00132651489361702, 0.00420059687943262, -0.000952140709219857, -0.00194335914893617, 0.00126485617021277, 0.00251607829787234, -0.000554579787234042, -0.000952140709219857, 0.00225920113475177, 0.00057910914893617, -0.00153379787234043, -0.00106924595744681, -0.00139678475177305, -0.00194335914893617, 0.00057910914893617, 0.00430494191489362, -0.00180268914893617, -0.00120505595744681, 0.00250189539007092, 0.00126485617021277, -0.00153379787234043, -0.00180268914893617, 0.00519185361702128, 0.00188440468085106, 0.000932237234042553, 0.00251607829787234, -0.00106924595744681, -0.00120505595744681, 0.00188440468085106, 0.00440833021276596), .Dim = c(6L, 6L), .Dimnames = list(c("acog.perf", "asom.perf", "conf.perf", "acog.asom", "acog.conf", "asom.conf"), c("acog.perf", "asom.perf", "conf.perf", "acog.asom", "acog.conf", "asom.conf"))) expect_equivalent(V[1:6,1:6], sav, tolerance=.tol[["var"]]) ### turn var1.var2 into a factor with the desired order of levels dat$var1.var2 <- factor(dat$var1.var2, levels=c("acog.perf", "asom.perf", "conf.perf", "acog.asom", "acog.conf", "asom.conf")) ### multivariate random-effects model expect_warning(res <- rma.mv(yi, V, mods = ~ var1.var2 - 1, random = ~ var1.var2 | study, struct="UN", data=dat, sparse=.sparse)) ### restructure estimated mean correlations into a 4x4 matrix R <- matrix(NA, nrow=4, ncol=4) R[lower.tri(R)] <- coef(res) rownames(R) <- colnames(R) <- c("perf", "acog", "asom", "conf") ### fit regression model with 'perf' as outcome and 'acog', 'asom', and 'conf' as predictors fit <- matreg(1, 2:4, R=R, V=vcov(res)) out <- capture.output(print(fit)) sav <- structure(list(estimate = c(0.14817903234559, -0.0536342615587582, 0.363679177420187), se = c(0.156551433378687, 0.0768472434859867, 0.0909539697381244), zval = c(0.946519805967891, -0.697933447262015, 3.99849702511387), pval = c(0.343883525131896, 0.485218815885662, 0.0000637459821320369), ci.lb = c(-0.158656138804758, -0.204252091102472, 0.185412672482517), ci.ub = c(0.455014203495939, 0.0969835679849561, 0.541945682357857)), class = "data.frame", row.names = c("acog", "asom", "conf")) expect_equivalent(fit$tab, sav, tolerance=.tol[["misc"]]) ### use variable names fit <- matreg("perf", c("acog","asom","conf"), R=R, V=vcov(res)) expect_equivalent(fit$tab, sav, tolerance=.tol[["misc"]]) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_berkey1998.r0000644000176200001440000000701214502303707023366 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:berkey1998 source("settings.r") context("Checking analysis example: berkey1998") ### load data dat <- dat.berkey1998 ### construct variance-covariance matrix of the observed outcomes V <- bldiag(lapply(split(dat[,c("v1i", "v2i")], dat$trial), as.matrix)) test_that("results are correct for the multiple outcomes random-effects model.", { ### multiple outcomes random-effects model (with ML estimation) res <- rma.mv(yi, V, mods = ~ outcome - 1, random = ~ outcome | trial, struct="UN", data=dat, method="ML", sparse=.sparse) out <- capture.output(print(res)) ### so that print.rma.mv() is run (at least once) ### (results for this model not given in paper) expect_equivalent(coef(res), c(-0.3379, 0.3448), tolerance=.tol[["coef"]]) expect_equivalent(res$se, c(0.0798, 0.0495), tolerance=.tol[["se"]]) expect_equivalent(res$tau2, c(0.0261, 0.0070), tolerance=.tol[["var"]]) expect_equivalent(res$rho, 0.6992, tolerance=.tol[["cor"]]) }) test_that("results are correct for the multiple outcomes mixed-effects (meta-regression) model.", { ### multiple outcomes mixed-effects (meta-regression) model (with ML estimation) res <- rma.mv(yi, V, mods = ~ outcome + outcome:I(year - 1983) - 1, random = ~ outcome | trial, struct="UN", data=dat, method="ML", sparse=.sparse) ### compare with results on page 2545 (Table II) expect_equivalent(coef(res), c(-0.3351, 0.3479, -0.0108, 0.0010), tolerance=.tol[["coef"]]) expect_equivalent(res$se, c(0.0787, 0.0520, 0.0243, 0.0154), tolerance=.tol[["se"]]) expect_equivalent(res$tau2, c(0.0250, 0.0080), tolerance=.tol[["var"]]) expect_equivalent(res$rho, 0.6587, tolerance=.tol[["cor"]]) ### compute the covariance tmp <- res$rho*sqrt(res$tau2[1]*res$tau2[2]) expect_equivalent(tmp, 0.0093, tolerance=.tol[["cov"]]) ### test the difference in slopes res <- rma.mv(yi, V, mods = ~ outcome*I(year - 1983) - 1, random = ~ outcome | trial, struct="UN", data=dat, method="ML", sparse=.sparse) ### (results for this model not given in paper) expect_equivalent(coef(res), c(-0.3351, 0.3479, -0.0108, 0.0118), tolerance=.tol[["coef"]]) expect_equivalent(res$se, c(0.0787, 0.0520, 0.0243, 0.0199), tolerance=.tol[["se"]]) expect_equivalent(res$pval, c(0.0000, 0.0000, 0.6563, 0.5534), tolerance=.tol[["pval"]]) }) test_that("results are correct when testing var-cov structures against each other with LRTs.", { ### test whether the amount of heterogeneity is the same in the two outcomes res1 <- rma.mv(yi, V, mods = ~ outcome - 1, random = ~ outcome | trial, struct="UN", data=dat, method="ML", sparse=.sparse) res0 <- rma.mv(yi, V, mods = ~ outcome - 1, random = ~ outcome | trial, struct="CS", data=dat, method="ML", sparse=.sparse) tmp <- anova(res0, res1) out <- capture.output(print(tmp)) ### so that print.anova.rma() is run (at least once) ### (results for this not given in paper) expect_equivalent(tmp$pval, 0.2597, tolerance=.tol[["pval"]]) ### test the correlation among the true effects res1 <- rma.mv(yi, V, mods = ~ outcome - 1, random = ~ outcome | trial, struct="UN", data=dat, method="ML", sparse=.sparse) res0 <- rma.mv(yi, V, mods = ~ outcome - 1, random = ~ outcome | trial, struct="UN", data=dat, method="ML", rho=0, sparse=.sparse) tmp <- anova(res0, res1) ### (results for this not given in paper) expect_equivalent(tmp$pval, 0.2452, tolerance=.tol[["pval"]]) }) rm(list=ls()) metafor/tests/testthat/test_plots_caterpillar_plot.r0000644000176200001440000000333514503345773022733 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/plots:caterpillar_plot source("settings.r") context("Checking plots example: caterpillar plot") test_that("plot can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() ### simulate some data set.seed(5132) k <- 250 vi <- rchisq(k, df=1) * .03 yi <- rnorm(k, rnorm(k, 0.5, 0.4), sqrt(vi)) ### fit RE model res <- rma(yi, vi) png("images/test_plots_caterpillar_plot_test.png", res=200, width=1800, height=1500, type="cairo") ### decrease margins so the full space is used par(mar=c(5,1,1,1)) ### create plot forest(yi, vi, xlim=c(-2.5,3.5), ### adjust horizontal plot region limits order=yi, ### order by size of yi slab=NA, annotate=FALSE, ### remove study labels and annotations efac=0, ### remove vertical bars at end of CIs pch=19, ### changing point symbol to filled circle col="gray40", ### change color of points/CIs psize=2, ### increase point size cex.lab=1, cex.axis=1, ### increase size of x-axis title/labels lty=c("solid","blank")) ### remove horizontal line at top of plot ### draw points one more time to make them easier to see points(sort(yi), k:1, pch=19, cex=0.5) ### add summary polygon at bottom and text addpoly(res, mlab="", cex=1) text(-2, -2, "RE Model", pos=4, offset=0, cex=1) dev.off() expect_true(.vistest("images/test_plots_caterpillar_plot_test.png", "images/test_plots_caterpillar_plot.png")) }) rm(list=ls()) metafor/tests/testthat/test_misc_vcalc.r0000644000176200001440000002245114231267735020254 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: vcalc() function") source("settings.r") test_that("vcov() works correctly for 'dat.assink2016' example.", { dat <- dat.assink2016 ### assume that the effect sizes within studies are correlated with rho=0.6 V <- vcalc(vi, cluster=study, obs=esid, data=dat, rho=0.6) sav <- blsplit(V, dat$study, round, 4)[1:2] expected <- list(`1` = structure(c(0.074, 0.0326, 0.0358, 0.0252, 0.0297, 0.0486, 0.0326, 0.0398, 0.0263, 0.0185, 0.0218, 0.0356, 0.0358, 0.0263, 0.0481, 0.0203, 0.0239, 0.0392, 0.0252, 0.0185, 0.0203, 0.0239, 0.0169, 0.0276, 0.0297, 0.0218, 0.0239, 0.0169, 0.0331, 0.0325, 0.0486, 0.0356, 0.0392, 0.0276, 0.0325, 0.0886), .Dim = c(6L,6L)), `2` = structure(c(0.0115, 0.0056, 0.0052, 0.0056, 0.0076, 0.0042, 0.0052, 0.0042, 0.0065), .Dim = c(3L, 3L))) expect_equivalent(sav, expected, tolerance=.tol[["var"]]) ### use a correlation of 0.7 for effect sizes corresponding to the same type of ### delinquent behavior and a correlation of 0.5 for effect sizes corresponding ### to different types of delinquent behavior V <- vcalc(vi, cluster=study, type=deltype, obs=esid, data=dat, rho=c(0.7, 0.5)) sav <- blsplit(V, dat$study, round, 3)[16] expected <- list(`16` = structure(c(0.091, 0.045, 0.027, 0.044, 0.03, 0.039, 0.076, 0.028, 0.034, 0.03, 0.039, 0.043, 0.039, 0.067, 0.028, 0.032, 0.045, 0.087, 0.027, 0.061, 0.03, 0.039, 0.053, 0.027, 0.047, 0.041, 0.053, 0.059, 0.053, 0.046, 0.038, 0.043, 0.027, 0.027, 0.033, 0.027, 0.025, 0.033, 0.033, 0.023, 0.021, 0.018, 0.023, 0.026, 0.023, 0.029, 0.017, 0.019, 0.044, 0.061, 0.027, 0.086, 0.029, 0.038, 0.053, 0.027, 0.047, 0.041, 0.053, 0.058, 0.053, 0.046, 0.038, 0.043, 0.03, 0.03, 0.025, 0.029, 0.04, 0.037, 0.036, 0.026, 0.023, 0.02, 0.026, 0.028, 0.026, 0.031, 0.018, 0.021, 0.039, 0.039, 0.033, 0.038, 0.037, 0.068, 0.047, 0.033, 0.03, 0.026, 0.034, 0.037, 0.034, 0.041, 0.024, 0.027, 0.076, 0.053, 0.033, 0.053, 0.036, 0.047, 0.129, 0.033, 0.041, 0.035, 0.046, 0.051, 0.046, 0.079, 0.033, 0.037, 0.028, 0.027, 0.023, 0.027, 0.026, 0.033, 0.033, 0.033, 0.021, 0.018, 0.023, 0.026, 0.024, 0.029, 0.017, 0.019, 0.034, 0.047, 0.021, 0.047, 0.023, 0.03, 0.041, 0.021, 0.052, 0.031, 0.041, 0.045, 0.041, 0.036, 0.029, 0.033, 0.03, 0.041, 0.018, 0.041, 0.02, 0.026, 0.035, 0.018, 0.031, 0.039, 0.036, 0.039, 0.036, 0.031, 0.025, 0.029, 0.039, 0.053, 0.023, 0.053, 0.026, 0.034, 0.046, 0.023, 0.041, 0.036, 0.066, 0.051, 0.047, 0.04, 0.033, 0.038, 0.043, 0.059, 0.026, 0.058, 0.028, 0.037, 0.051, 0.026, 0.045, 0.039, 0.051, 0.081, 0.051, 0.045, 0.037, 0.042, 0.039, 0.053, 0.023, 0.053, 0.026, 0.034, 0.046, 0.024, 0.041, 0.036, 0.047, 0.051, 0.067, 0.041, 0.033, 0.038, 0.067, 0.046, 0.029, 0.046, 0.031, 0.041, 0.079, 0.029, 0.036, 0.031, 0.04, 0.045, 0.041, 0.099, 0.029, 0.033, 0.028, 0.038, 0.017, 0.038, 0.018, 0.024, 0.033, 0.017, 0.029, 0.025, 0.033, 0.037, 0.033, 0.029, 0.034, 0.027, 0.032, 0.043, 0.019, 0.043, 0.021, 0.027, 0.037, 0.019, 0.033, 0.029, 0.038, 0.042, 0.038, 0.033, 0.027, 0.044), .Dim = c(16L, 16L))) expect_equivalent(sav, expected, tolerance=.tol[["var"]]) }) test_that("vcov() works correctly for 'dat.ishak2007' example.", { dat <- dat.ishak2007 ### create long format dataset dat <- reshape(dat, direction="long", idvar="study", v.names=c("yi","vi"), varying=list(c(2,4,6,8), c(3,5,7,9))) dat <- dat[order(study, time),] ### remove missing measurement occasions from dat dat <- dat[!is.na(yi),] rownames(dat) <- NULL ### construct the full (block diagonal) V matrix with an AR(1) structure ### assuming an autocorrelation of 0.97 as estimated by Ishak et al. (2007) V <- vcalc(vi, cluster=study, time1=time, phi=0.97, data=dat) sav <- blsplit(V, dat$study)[1:5] expected <- list(`Alegret (2001)` = structure(14.3, .Dim = c(1L, 1L)), `Barichella (2003)` = structure(c(7.3, 6.0693520102314, 6.0693520102314, 5.7), .Dim = c(2L, 2L)), `Berney (2002)` = structure(7.3, .Dim = c(1L, 1L)), `Burchiel (1999)` = structure(c(8, 7.76, 5.95077410090486, 7.76, 8, 6.13481866072665, 5.95077410090486, 6.13481866072665, 5), .Dim = c(3L, 3L)), `Chen (2003)` = structure(125, .Dim = c(1L, 1L))) expect_equivalent(sav, expected, tolerance=.tol[["var"]]) }) test_that("vcov() works correctly for 'dat.kalaian1996' example.", { dat <- dat.kalaian1996 ### construct the variance-covariance matrix assuming rho = 0.66 for effect sizes ### corresponding to the 'verbal' and 'math' outcome types V <- vcalc(vi, cluster=study, type=outcome, data=dat, rho=0.66) sav <- round(V[1:12,1:12], 4) expected <- structure(c(0.0817, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0507, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1045, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0442, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0535, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0557, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0561, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1151, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0147, 0.0097, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0097, 0.0147, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0218, 0.0143, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0143, 0.0216), .Dim = c(12L, 12L)) expect_equivalent(sav, expected, tolerance=.tol[["var"]]) }) test_that("vcov() works correctly for 'dat.berkey1998' example.", { dat <- dat.berkey1998 ### variables v1i and v2i correspond to the 2x2 var-cov matrices of the studies; ### so use these variables to construct the V matrix (note: since v1i and v2i are ### var-cov matrices and not correlation matrices, set vi=1 for all rows) V <- vcalc(vi=1, cluster=author, rvars=c(v1i, v2i), data=dat) sav <- blsplit(V, dat$author, function(x) round(cov2cor(x), 2)) expected <- list(`Pihlstrom et al.` = structure(c(1, 0.39, 0.39, 1), .Dim = c(2L, 2L)), `Lindhe et al.` = structure(c(1, 0.42, 0.42, 1), .Dim = c(2L, 2L)), `Knowles et al.` = structure(c(1, 0.41, 0.41, 1), .Dim = c(2L, 2L)), `Ramfjord et al.` = structure(c(1, 0.43, 0.43, 1), .Dim = c(2L, 2L)), `Becker et al.` = structure(c(1, 0.34, 0.34, 1), .Dim = c(2L, 2L))) expect_equivalent(sav, expected, tolerance=.tol[["var"]]) }) test_that("vcov() works correctly for 'dat.knapp2017' example.", { dat <- dat.knapp2017 ### create variable that indicates the task and difficulty combination as increasing integers dat$task.diff <- unlist(lapply(split(dat, dat$study), function(x) { task.int <- as.integer(factor(x$task)) diff.int <- as.integer(factor(x$difficulty)) diff.int[is.na(diff.int)] <- 1 paste0(task.int, ".", diff.int)})) ### construct correlation matrix for two tasks with four different difficulties where the ### correlation is 0.4 for different difficulties of the same task, 0.7 for the same ### difficulty of different tasks, and 0.28 for different difficulties of different tasks R <- matrix(0.4, nrow=8, ncol=8) R[5:8,1:4] <- R[1:4,5:8] <- 0.28 diag(R[1:4,5:8]) <- 0.7 diag(R[5:8,1:4]) <- 0.7 diag(R) <- 1 rownames(R) <- colnames(R) <- paste0(rep(1:2, each=4), ".", 1:4) ### construct an approximate V matrix accounting for the use of shared groups and ### for correlations among tasks/difficulties as specified in the R matrix above V <- vcalc(vi, cluster=study, grp1=group1, grp2=group2, w1=n_sz, w2=n_hc, obs=task.diff, rho=R, data=dat) Vs <- blsplit(V, dat$study) sav <- Vs[c(3,6,12,24,29)] expected <- list(`3` = structure(c(0.062, 0.0313021866879515, 0.0305960523769429, 0.0306223534669685, 0.0313021866879515, 0.073, 0.0301021398261882, 0.0301280163373072, 0.0305960523769429, 0.0301021398261882, 0.102, 0.029448369695669, 0.0306223534669685, 0.0301280163373072, 0.029448369695669, 0.084), .Dim = c(4L, 4L)), `6` = structure(c(0.17, 0.07485452558129, 0.0675988165576883, 0.0711280535372648, 0.120045408075445, 0.0489799959167005, 0.0511105468567888, 0.0495212277715325, 0.07485452558129, 0.206, 0.0744129021070943, 0.0782978926919493, 0.0528584827629398, 0.134793174901402, 0.0562625843700767, 0.0545130589858981, 0.0675988165576884, 0.0744129021070943, 0.168, 0.0707084153407499, 0.0477348677593224, 0.0486910258671965, 0.127022517688794, 0.0492290645858725, 0.0711280535372648, 0.0782978926919493, 0.0707084153407499, 0.186, 0.0502270365440765, 0.0512331142914424, 0.0534616722521846, 0.129498108094288, 0.120045408075445, 0.0528584827629398, 0.0477348677593224, 0.0502270365440765, 0.173, 0.0705861176152932, 0.0736565000526091, 0.0713660983941255, 0.0489799959167005, 0.134793174901402, 0.0486910258671965, 0.0512331142914424, 0.0705861176152932, 0.18, 0.0751318840439929, 0.0727956042628949, 0.0511105468567888, 0.0562625843700767, 0.127022517688794, 0.0534616722521846, 0.0736565000526091, 0.0751318840439929, 0.196, 0.075962095811003, 0.0495212277715325, 0.0545130589858981, 0.0492290645858725, 0.129498108094288, 0.0713660983941255, 0.0727956042628949, 0.075962095811003, 0.184), .Dim = c(8L, 8L)), `12` = structure(c(0.02, 0.00819756061276768, 0.008, 0.00839047078536121, 0.00819756061276768, 0.021, 0.00819756061276768, 0.00859767410408187, 0.008, 0.00819756061276768, 0.02, 0.00839047078536121, 0.00839047078536121, 0.00859767410408187, 0.00839047078536121, 0.022), .Dim = c(4L, 4L)), `24` = structure(c(0.022, 0, 0, 0.03), .Dim = c(2L, 2L)), `29` = structure(c(0.039, 0, 0, 0, 0.039, 0, 0, 0, 0.121), .Dim = c(3L, 3L))) expect_equivalent(sav, expected, tolerance=.tol[["var"]]) }) rm(list=ls()) metafor/tests/testthat/test_plots_normal_qq_plots.r0000644000176200001440000000572614503346320022600 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/plots:normal_qq_plots source("settings.r") context("Checking plots example: normal QQ plots") test_that("plot can be drawn for 'rma.uni' object.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_normal_qq_plots_1_test.png", res=200, width=1800, height=1800, type="cairo") ### set up 2x2 array for plotting par(mfrow=c(2,2)) ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit equal- and random-effects models res1 <- rma(yi, vi, data=dat, method="EE") res2 <- rma(yi, vi, data=dat) ### fit fixed- and random-effects models with absolute latitude moderator res3 <- rma(yi, vi, mods=~ablat, data=dat, method="FE") res4 <- rma(yi, vi, mods=~ablat, data=dat) ### normal QQ plots for the various models qqnorm(res1, seed=1234, main="Equal-Effects Model") qqnorm(res2, seed=1234, main="Random-Effects Model") qqnorm(res3, seed=1234, main="Fixed-Effects with Moderators Model") qqnorm(res4, seed=1234, main="Mixed-Effects Model") dev.off() expect_true(.vistest("images/test_plots_normal_qq_plots_1_test.png", "images/test_plots_normal_qq_plots_1.png")) ### draw plot with studentized residuals and labels png("images/test_plots_normal_qq_plots_2_test.png", res=200, width=1800, height=1800, type="cairo") qqnorm(res2, type="rstudent", label=TRUE, seed=1234) dev.off() expect_true(.vistest("images/test_plots_normal_qq_plots_2_test.png", "images/test_plots_normal_qq_plots_2.png")) }) test_that("plot can be drawn for 'rma.mh' object.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_normal_qq_plots_3_test.png", res=200, width=1800, height=1800, type="cairo") res <- rma.mh(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) qqnorm(res) qqnorm(res, type="rstudent", label=TRUE) dev.off() expect_true(.vistest("images/test_plots_normal_qq_plots_3_test.png", "images/test_plots_normal_qq_plots_3.png")) }) test_that("plot can be drawn for 'rma.peto' object.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_normal_qq_plots_4_test.png", res=200, width=1800, height=1800, type="cairo") res <- rma.peto(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) qqnorm(res) qqnorm(res, type="rstudent", label=TRUE) dev.off() expect_true(.vistest("images/test_plots_normal_qq_plots_4_test.png", "images/test_plots_normal_qq_plots_4.png")) }) test_that("plot cannot be drawn for 'rma.mv' object.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, sparse=.sparse) expect_error(qqnorm(res)) }) rm(list=ls()) metafor/tests/testthat/test_misc_funnel.r0000644000176200001440000000430214503345503020436 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: funnel() functions") source("settings.r") test_that("funnel() works correctly.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() ### simulate a large meta-analytic dataset (correlations with rho = 0.0) ### with no heterogeneity or publication bias; then try out different ### versions of the funnel plot gencor <- function(rhoi, ni) { x1 <- rnorm(ni, mean=0, sd=1) x2 <- rnorm(ni, mean=0, sd=1) x3 <- rhoi*x1 + sqrt(1-rhoi^2)*x2 cor(x1, x3) } set.seed(78123) k <- 200 ### number of studies to simulate ni <- round(rchisq(k, df=2) * 20 + 20) ### simulate sample sizes (skewed distribution) ri <- mapply(gencor, rep(0.0,k), ni) ### simulate correlations dat <- escalc(measure="ZCOR", ri=ri, ni=ni) ### compute r-to-z transformed correlations res <- rma(yi, vi, data=dat, method="EE") png(filename="images/test_misc_funnel_1_test.png", res=200, width=1800, height=2000, type="cairo") par(mfrow=c(5,2), mar=c(5,4,1,1), cex=0.5) funnel(res, yaxis="sei") funnel(res, yaxis="vi") funnel(res, yaxis="seinv") funnel(res, yaxis="vinv") funnel(res, yaxis="ni") funnel(res, yaxis="ninv") funnel(res, yaxis="sqrtni") funnel(res, yaxis="sqrtninv") funnel(res, yaxis="lni") funnel(res, yaxis="wi") dev.off() expect_true(.vistest("images/test_misc_funnel_1_test.png", "images/test_misc_funnel_1.png")) png(filename="images/test_misc_funnel_2_test.png", res=200, width=1800, height=2000, type="cairo") par(mfrow=c(5,2), mar=c(5,4,1,1), cex=0.5) funnel(dat$yi, dat$vi, yaxis="sei") funnel(dat$yi, dat$vi, yaxis="vi") funnel(dat$yi, dat$vi, yaxis="seinv") funnel(dat$yi, dat$vi, yaxis="vinv") funnel(dat$yi, dat$vi, yaxis="ni") funnel(dat$yi, dat$vi, yaxis="ninv") funnel(dat$yi, dat$vi, yaxis="sqrtni") funnel(dat$yi, dat$vi, yaxis="sqrtninv") funnel(dat$yi, dat$vi, yaxis="lni") funnel(dat$yi, dat$vi, yaxis="wi") dev.off() expect_true(.vistest("images/test_misc_funnel_2_test.png", "images/test_misc_funnel_2.png")) }) rm(list=ls()) metafor/tests/testthat/test_misc_reporter.r0000644000176200001440000000067014204414503021010 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: reporter() function") source("settings.r") test_that("reporter() works correctly for 'rma.uni' objects.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) expect_error(res <- rma(yi, vi, data=dat), NA) # to avoid this being an empty test skip_on_cran() reporter(res, open=FALSE) }) rm(list=ls()) metafor/tests/testthat/test_plots_forest_plot_with_subgroups.r0000644000176200001440000000677514503346103025076 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/plots:forest_plot_with_subgroups source("settings.r") context("Checking plots example: forest plot with subgroups") test_that("plot can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_forest_plot_with_subgroups_test.png", res=240, width=1800, height=1800, type="cairo") ### decrease margins so the full space is used par(mar=c(4,4,1,2)) ### copy BCG vaccine meta-analysis data into 'dat' dat <- dat.bcg ### calculate log risk ratios and corresponding sampling variances (and use ### the 'slab' argument to store study labels as part of the data frame) dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, slab=paste(author, year, sep=", ")) ### fit random-effects model res <- rma(yi, vi, data=dat) ### a little helper function to add Q-test, I^2, and tau^2 estimate info mlabfun <- function(text, x) { list(bquote(paste(.(text), " (Q = ", .(fmtx(x$QE, digits=2)), ", df = ", .(x$k - x$p), ", ", .(fmtp(x$QEp, digits=3, pname="p", add0=TRUE, sep=TRUE, equal=TRUE)), "; ", I^2, " = ", .(fmtx(x$I2, digits=1)), "%, ", tau^2, " = ", .(fmtx(x$tau2, digits=2)), ")")))} ### set up forest plot (with 2x2 table counts added; the 'rows' argument is ### used to specify in which rows the outcomes will be plotted) forest(res, xlim=c(-16, 4.6), at=log(c(0.05, 0.25, 1, 4)), atransf=exp, ilab=cbind(tpos, tneg, cpos, cneg), ilab.xpos=c(-9.5,-8,-6,-4.5), cex=0.75, ylim=c(-1, 27), order=alloc, rows=c(3:4,9:15,20:23), mlab=mlabfun("RE Model for All Studies", res), psize=1, header="Author(s) and Year") ### set font expansion factor (as in forest() above) and use a bold font op <- par(cex=0.75, font=2) ### add additional column headings to the plot text(c(-9.5,-8,-6,-4.5), 26, c("TB+", "TB-", "TB+", "TB-")) text(c(-8.75,-5.25), 27, c("Vaccinated", "Control")) ### switch to bold italic font par(font=4) ### add text for the subgroups text(-16, c(24,16,5), pos=4, c("Systematic Allocation", "Random Allocation", "Alternate Allocation")) ### set par back to the original settings par(op) ### fit random-effects model in the three subgroups res.s <- rma(yi, vi, subset=(alloc=="systematic"), data=dat) res.r <- rma(yi, vi, subset=(alloc=="random"), data=dat) res.a <- rma(yi, vi, subset=(alloc=="alternate"), data=dat) ### add summary polygons for the three subgroups addpoly(res.s, row=18.5, mlab=mlabfun("RE Model for Subgroup", res.s)) addpoly(res.r, row= 7.5, mlab=mlabfun("RE Model for Subgroup", res.r)) addpoly(res.a, row= 1.5, mlab=mlabfun("RE Model for Subgroup", res.a)) ### fit meta-regression model to test for subgroup differences res <- rma(yi, vi, mods = ~ alloc, data=dat) ### add text for the test of subgroup differences text(-16, -1.8, pos=4, cex=0.75, bquote(paste("Test for Subgroup Differences: ", Q[M], " = ", .(fmtx(res$QM, digits=2)), ", df = ", .(res$p - 1), ", ", .(fmtp(res$QMp, digits=2, pname="p", add0=TRUE, sep=TRUE, equal=TRUE))))) dev.off() expect_true(.vistest("images/test_plots_forest_plot_with_subgroups_test.png", "images/test_plots_forest_plot_with_subgroups.png")) }) rm(list=ls()) metafor/tests/testthat/test_misc_rma_error_handling.r0000644000176200001440000000123614204414513023002 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: proper handling of errors in rma()") source("settings.r") test_that("rma() handles NAs correctly.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) dat$yi[1] <- NA dat$yi[2] <- NA expect_warning(res <- rma(yi, vi, data=dat, digits=3)) expect_equivalent(res$k, 11) expect_equivalent(res$k.f, 13) expect_equivalent(length(res$yi), 11) expect_equivalent(length(res$yi.f), 13) expect_equivalent(res$not.na, rep(c(FALSE,TRUE),times=c(2,11))) dat$ablat[3] <- NA ### TODO: complete this ... }) rm(list=ls()) metafor/tests/testthat/test_misc_replmiss.r0000644000176200001440000000066014204414500021000 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: replmiss() function") source("settings.r") test_that("replmiss() works correctly.", { var1 <- c(1:4,NA,6,NA,8:10) var2 <- as.numeric(1:10) expect_identical(replmiss(var1, 0), c(1, 2, 3, 4, 0, 6, 0, 8, 9, 10)) expect_identical(replmiss(var1, var2), as.numeric(1:10)) expect_error(replmiss(var1, 1:9)) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_vanhouwelingen1993.r0000644000176200001440000000662414503345255025146 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:vanhouwelingen1993 context("Checking analysis example: vanhouwelingen1993") source("settings.r") ### load data dat <- dat.collins1985a test_that("the log likelihood plot can be created.", { skip_on_cran() png(filename="images/test_analysis_example_vanhouwelingen1993_llplot_test.png", res=200, width=1800, height=1200, type="cairo") par(mar=c(5,5,1,2)) expect_warning(llplot(measure="OR", ai=b.xci, n1i=nci, ci=b.xti, n2i=nti, data=dat, xlim=c(-4,4), lwd=1, col="black", refline=NA, drop00=FALSE)) dev.off() expect_true(.vistest("images/test_analysis_example_vanhouwelingen1993_llplot_test.png", "images/test_analysis_example_vanhouwelingen1993_llplot.png")) }) test_that("results of the equal-effects conditional logistic model are correct.", { skip_on_cran() expect_warning(res <- rma.glmm(measure="OR", ai=b.xci, n1i=nci, ci=b.xti, n2i=nti, data=dat, model="CM.EL", method="EE")) ### compare with results on page 2275 (in text) expect_equivalent(coef(res), 0.1216, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.0995, tolerance=.tol[["se"]]) expect_equivalent(res$ci.lb, -0.0734, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 0.3165, tolerance=.tol[["ci"]]) ### 0.31 in paper (rounded a bit more heavily, so 32-bit and 64-bit versions give same result) expect_equivalent(c(logLik(res)), -53.6789, tolerance=.tol[["fit"]]) ### run with control(dnchgcalc="dnoncenhypergeom") expect_warning(res <- rma.glmm(measure="OR", ai=b.xci, n1i=nci, ci=b.xti, n2i=nti, data=dat, model="CM.EL", method="EE", control=list(dnchgcalc="dnoncenhypergeom"))) ### some very minor discrepancies expect_equivalent(coef(res), 0.1216, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.0996, tolerance=.tol[["se"]]) expect_equivalent(res$ci.lb, -0.0735, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 0.3167, tolerance=.tol[["ci"]]) expect_equivalent(c(logLik(res)), -53.6789, tolerance=.tol[["fit"]]) }) test_that("results of the random-effects conditional logistic model are correct.", { skip_on_cran() expect_warning(res <- rma.glmm(measure="OR", ai=b.xci, n1i=nci, ci=b.xti, n2i=nti, data=dat, model="CM.EL", method="ML")) ### compare with results on page 2277 (in text) expect_equivalent(coef(res), 0.1744, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.1364, tolerance=.tol[["se"]]) expect_equivalent(res$ci.lb, -0.0929, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 0.4417, tolerance=.tol[["ci"]]) expect_equivalent(c(logLik(res)), -52.99009, tolerance=.tol[["fit"]]) expect_equivalent(res$tau2, 0.1192, tolerance=.tol[["var"]]) ### run with control(dnchgcalc="dnoncenhypergeom") expect_warning(res <- rma.glmm(measure="OR", ai=b.xci, n1i=nci, ci=b.xti, n2i=nti, data=dat, model="CM.EL", method="ML", control=list(dnchgcalc="dnoncenhypergeom"))) ### no discrepancies expect_equivalent(coef(res), 0.1744, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.1364, tolerance=.tol[["se"]]) expect_equivalent(res$ci.lb, -0.0930, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 0.4418, tolerance=.tol[["ci"]]) expect_equivalent(c(logLik(res)), -52.99009, tolerance=.tol[["fit"]]) expect_equivalent(res$tau2, 0.1192, tolerance=.tol[["var"]]) }) rm(list=ls()) metafor/tests/testthat/test_misc_escalc.r0000644000176200001440000003646114435633554020426 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: escalc() function") source("settings.r") test_that("escalc() works correctly for measure='RR'", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) expect_equivalent(dat$yi[1], -0.8893, tolerance=.tol[["est"]]) expect_equivalent(dat$vi[1], 0.3256, tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='PHI/YUQ/YUY/RTET/PBIT/OR2D/OR2DN'", { ### see Table 13.4 (p. 242) in the Handbook of Research Synthesis and Meta-Analysis dat <- escalc(measure="PHI", ai=135, bi=15, ci=40, di=10) sav <- summary(dat) expect_equivalent(sav$yi, 0.1309, tolerance=.tol[["est"]]) expect_equivalent(sav$sei, 0.0789, tolerance=.tol[["var"]]) dat <- escalc(measure="YUQ", ai=135, bi=15, ci=40, di=10) sav <- summary(dat) expect_equivalent(sav$yi, 0.3846, tolerance=.tol[["est"]]) expect_equivalent(sav$sei, 0.1901, tolerance=.tol[["var"]]) dat <- escalc(measure="YUY", ai=135, bi=15, ci=40, di=10) sav <- summary(dat) expect_equivalent(sav$yi, 0.2000, tolerance=.tol[["est"]]) expect_equivalent(sav$sei, 0.1071, tolerance=.tol[["var"]]) dat <- escalc(measure="RTET", ai=135, bi=15, ci=40, di=10) sav <- summary(dat) expect_equivalent(sav$yi, 0.2603, tolerance=.tol[["est"]]) expect_equivalent(sav$sei, 0.1423, tolerance=.tol[["var"]]) dat <- escalc(measure="PBIT", ai=135, bi=15, ci=40, di=10) sav <- summary(dat) expect_equivalent(sav$yi, 0.4399, tolerance=.tol[["est"]]) expect_equivalent(sav$sei, 0.2456, tolerance=.tol[["var"]]) dat <- escalc(measure="OR2D", ai=135, bi=15, ci=40, di=10) sav <- summary(dat) expect_equivalent(sav$yi, 0.4471, tolerance=.tol[["est"]]) expect_equivalent(sav$sei, 0.2460, tolerance=.tol[["var"]]) dat <- escalc(measure="OR2DN", ai=135, bi=15, ci=40, di=10) sav <- summary(dat) expect_equivalent(sav$yi, 0.4915, tolerance=.tol[["est"]]) expect_equivalent(sav$sei, 0.2704, tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='SMD/SMDH/ROM'", { dat <- dat.normand1999 sav <- escalc(measure="SMD", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat, subset=1:4) expect_equivalent(sav$yi, c(-0.3552, -0.3479, -2.3176, -1.8880), tolerance=.tol[["est"]]) expect_equivalent(sav$vi, c( 0.0131, 0.0645, 0.0458, 0.1606), tolerance=.tol[["var"]]) sav <- escalc(measure="SMDH", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat, subset=1:4) expect_equivalent(sav$yi, c(-0.3553, -0.3465, -2.3018, -1.8880), tolerance=.tol[["est"]]) expect_equivalent(sav$vi, c( 0.0131, 0.0657, 0.0509, 0.1874), tolerance=.tol[["var"]]) sav <- escalc(measure="ROM", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat, subset=1:4) expect_equivalent(sav$yi, c(-0.3102, -0.0715, -0.6202, -0.7303), tolerance=.tol[["est"]]) expect_equivalent(sav$vi, c( 0.0094, 0.0028, 0.0018, 0.0119), tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='CVR/VR'", { dat <- dat.normand1999 dat <- escalc(measure="CVR", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat, subset=1) expect_equivalent(dat$yi[1], 0.0014, tolerance=.tol[["est"]]) expect_equivalent(dat$vi[1], 0.0159, tolerance=.tol[["var"]]) dat <- dat.normand1999 dat <- escalc(measure="VR", sd1i=sd1i, n1i=n1i, sd2i=sd2i, n2i=n2i, data=dat, subset=1) expect_equivalent(dat$yi[1], -0.3087, tolerance=.tol[["est"]]) expect_equivalent(dat$vi[1], 0.0065, tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='RPB/RBIS'", { x <- c(20, 31, 18, 22, 30, 16, 28, 24, 23, 27, 1, 4, 8, 15, 9, 11, 11, 6, 8, 4) y <- c(3, 3, 4, 5, 6, 4, 7, 6, 5, 4, 3, 5, 1, 5, 2, 4, 6, 4, 2, 4) xb <- ifelse(x > median(x), 1, 0) sav <- escalc(measure="RPB", m1i=mean(y[xb==1]), sd1i=sd(y[xb==1]), n1i=sum(xb==1), m2i=mean(y[xb==0]), sd2i=sd(y[xb==0]), n2i=sum(xb==0)) expect_equivalent(sav$yi, 0.3685, tolerance=.tol[["est"]]) expect_equivalent(sav$vi, 0.0384, tolerance=.tol[["var"]]) sav <- escalc(measure="RBIS", m1i=mean(y[xb==1]), sd1i=sd(y[xb==1]), n1i=sum(xb==1), m2i=mean(y[xb==0]), sd2i=sd(y[xb==0]), n2i=sum(xb==0)) expect_equivalent(sav$yi, 0.4619, tolerance=.tol[["est"]]) expect_equivalent(sav$vi, 0.0570, tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='D2ORL/D2ORN'", { dat <- dat.gibson2002 sav <- escalc(measure="D2ORL", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat, subset=1:4) expect_equivalent(sav$yi, c(-0.4315, -0.9285, 0.5932, -0.1890), tolerance=.tol[["est"]]) expect_equivalent(sav$vi, c( 0.1276, 0.0493, 0.3204, 0.0690), tolerance=.tol[["var"]]) sav <- escalc(measure="D2ORN", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat, subset=1:4) expect_equivalent(sav$yi, c(-0.3925, -0.8447, 0.5397, -0.1719), tolerance=.tol[["est"]]) expect_equivalent(sav$vi, c( 0.1056, 0.0408, 0.2651, 0.0571), tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='COR/UCOR/ZCOR'", { dat <- dat.mcdaniel1994 sav <- escalc(measure="COR", ri=ri, ni=ni, data=dat, subset=c(1,13,33,102)) expect_equivalent(sav$yi, c(0.0000, 0.6200, 0.9900, -0.1300), tolerance=.tol[["est"]]) expect_equivalent(sav$vi, c(0.0082, 0.0271, 0.0001, 0.0242), tolerance=.tol[["var"]]) sav <- escalc(measure="UCOR", ri=ri, ni=ni, data=dat, subset=c(1,13,33,102)) expect_equivalent(sav$yi, c(0.0000, 0.6363, 0.9925, -0.1317), tolerance=.tol[["est"]]) expect_equivalent(sav$vi, c(0.0082, 0.0253, 0.0000, 0.0241), tolerance=.tol[["var"]]) sav <- escalc(measure="UCOR", ri=ri, ni=ni, data=dat, vtype="UB", subset=c(1,13,33,102)) expect_equivalent(sav$vi, c(0.0084, 0.0283, 0.0000, 0.0261), tolerance=.tol[["var"]]) sav <- escalc(measure="ZCOR", ri=ri, ni=ni, data=dat, subset=c(1,13,33,102)) expect_equivalent(sav$yi, c(0.0000, 0.7250, 2.6467, -0.1307), tolerance=.tol[["est"]]) expect_equivalent(sav$vi, c(0.0083, 0.0833, 0.3333, 0.0263), tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='PCOR/ZPCOR/SPCOR'", { dat <- dat.aloe2013 dat <- escalc(measure="PCOR", ti=tval, ni=n, mi=preds, data=dat) expect_equivalent(dat$yi[1], 0.3012, tolerance=.tol[["est"]]) expect_equivalent(dat$vi[1], 0.0039, tolerance=.tol[["var"]]) dat <- escalc(measure="ZPCOR", ti=tval, ni=n, mi=preds, data=dat) expect_equivalent(dat$yi[1], 0.3108, tolerance=.tol[["est"]]) expect_equivalent(dat$vi[1], 0.0047, tolerance=.tol[["var"]]) dat <- escalc(measure="SPCOR", ti=tval, ni=n, mi=preds, r2i=R2, data=dat) expect_equivalent(dat$yi[1], 0.2754, tolerance=.tol[["est"]]) expect_equivalent(dat$vi[1], 0.0033, tolerance=.tol[["var"]]) dat <- escalc(measure="ZSPCOR", ti=tval, ni=n, mi=preds, r2i=R2, data=dat) expect_equivalent(dat$yi[1], 0.2827, tolerance=.tol[["est"]]) expect_equivalent(dat$vi[1], 0.0038, tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='MC/SMCRH'", { dat <- escalc(measure="MC", m1i=26, m2i=22, sd1i=sqrt(30), sd2i=sqrt(20), ni=60, ri=0.7) expect_equivalent(dat$yi, 4.0000, tolerance=.tol[["est"]]) expect_equivalent(dat$vi, 0.2618, tolerance=.tol[["var"]]) dat <- escalc(measure="SMCRH", m1i=26, m2i=22, sd1i=sqrt(30), sd2i=sqrt(20), ni=60, ri=0.7) expect_equivalent(dat$yi, 0.7210, tolerance=.tol[["est"]]) expect_equivalent(dat$vi, 0.0129, tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='PAS'", { dat <- escalc(measure="PAS", xi=10, ni=20) expect_equivalent(dat$yi, 0.7854, tolerance=.tol[["est"]]) expect_equivalent(dat$vi, 0.0125, tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='IRS/IRFT'", { dat <- escalc(measure="IRS", xi=10, ti=20) expect_equivalent(dat$yi, 0.7071, tolerance=.tol[["est"]]) expect_equivalent(dat$vi, 0.0125, tolerance=.tol[["var"]]) dat <- escalc(measure="IRFT", xi=10, ti=20) expect_equivalent(dat$yi, 0.7244, tolerance=.tol[["est"]]) expect_equivalent(dat$vi, 0.0125, tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='ROMC'", { dat <- escalc(measure="ROMC", m1i=26, m2i=22, sd1i=sqrt(30), sd2i=sqrt(20), ni=60, ri=0.7) expect_equivalent(dat$yi, 0.1671, tolerance=.tol[["est"]]) expect_equivalent(dat$vi, 0.0004, tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='MPRD'", { dat <- escalc(measure="MPRD", ai=20, bi=10, ci=5, di=20) expect_equivalent(dat$yi, 0.0909, tolerance=.tol[["est"]]) expect_equivalent(dat$vi, 0.0048, tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='MPRR'", { dat <- escalc(measure="MPRR", ai=20, bi=10, ci=5, di=20) expect_equivalent(dat$yi, 0.1823, tolerance=.tol[["est"]]) expect_equivalent(dat$vi, 0.0200, tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='MPOR'", { dat <- escalc(measure="MPOR", ai=20, bi=10, ci=5, di=20) expect_equivalent(dat$yi, 0.3646, tolerance=.tol[["est"]]) expect_equivalent(dat$vi, 0.0782, tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='MPORC'", { dat <- escalc(measure="MPORC", ai=20, bi=10, ci=5, di=20) expect_equivalent(dat$yi, 0.6931, tolerance=.tol[["est"]]) expect_equivalent(dat$vi, 0.3000, tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='MPPETO'", { dat <- escalc(measure="MPPETO", ai=20, bi=10, ci=5, di=20) expect_equivalent(dat$yi, 0.6667, tolerance=.tol[["est"]]) expect_equivalent(dat$vi, 0.2667, tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='IRSD'", { dat <- escalc(measure="IRSD", x1i=10, x2i=6, t1i=20, t2i=20) expect_equivalent(dat$yi, 0.1594, tolerance=.tol[["est"]]) expect_equivalent(dat$vi, 0.0250, tolerance=.tol[["var"]]) }) test_that("escalc() works correctly for measure='MNLN/CVLN/SDLN'", { dat <- escalc(measure="MNLN", mi=10, sdi=2, ni=20) expect_equivalent(dat$yi, 2.3026, tolerance=.tol[["est"]]) expect_equivalent(dat$vi, 0.0020, tolerance=.tol[["var"]]) dat <- escalc(measure="CVLN", mi=10, sdi=2, ni=20) expect_equivalent(dat$yi, -1.5831, tolerance=.tol[["est"]]) expect_equivalent(dat$vi, 0.0283, tolerance=.tol[["var"]]) dat <- escalc(measure="SDLN", sdi=2, ni=20) expect_equivalent(dat$yi, 0.7195, tolerance=.tol[["est"]]) expect_equivalent(dat$vi, 0.0263, tolerance=.tol[["var"]]) }) test_that("'var.names' argument works correctly for 'escalc' objects.", { dat <- dat.bcg dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, var.names=c("y1","v1"), slab=paste0(author, ", ", year)) dat <- escalc(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, var.names=c("y2","v2"), slab=paste0(author, ", ", year)) expect_identical(tail(names(dat), 4), c("y1","v1","y2","v2")) expect_identical(attributes(dat)$yi.names, c("y2","y1")) expect_identical(attributes(dat)$vi.names, c("v2","v1")) expect_identical(attr(dat$y1, "measure"), "RR") expect_identical(attr(dat$y2, "measure"), "OR") }) test_that("`[`, cbind(), and rbind() work correctly for 'escalc' objects.", { dat <- dat.bcg dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, var.names=c("y1","v1"), slab=paste0(author, ", ", year)) dat <- escalc(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, var.names=c("y2","v2"), slab=paste0(author, ", ", year)) dat <- cbind(dat[,1:9], dat[,c(12:13,10:11)]) expect_identical(tail(names(dat), 4), c("y2","v2","y1","v1")) expect_identical(attributes(dat)$yi.names, c("y2","y1")) expect_identical(attributes(dat)$vi.names, c("v2","v1")) expect_identical(attr(dat$y1, "measure"), "RR") expect_identical(attr(dat$y2, "measure"), "OR") dat <- rbind(dat[13,], dat[1:12,]) expect_equivalent(attr(dat$y2, "ni"), rowSums(dat[,c("tpos", "tneg", "cpos", "cneg")])) expect_identical(attr(dat$y2, "slab"), paste0(dat$author, ", ", dat$year)) dat <- dat.bcg dat1 <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, var.names=c("y1","v1"), slab=paste0(author, ", ", year)) dat2 <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, var.names=c("y1","v1"), slab=paste0(author, ", ", year)) dat1 <- dat1[1:4,] dat2 <- dat2[4:1,] dat <- rbind(dat1, dat2) expect_equivalent(attr(dat$y1, "ni"), rowSums(dat[,c("tpos", "tneg", "cpos", "cneg")])) attr(dat1$y1, "ni") <- NULL dat <- rbind(dat1, dat2) expect_null(attr(dat$y1, "ni")) }) test_that("summary() of 'escalc' objects works correctly with the 'out.names' argument.", { dat <- dat.bcg dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, var.names=c("y1","v1"), slab=paste0(author, ", ", year)) dat <- escalc(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, var.names=c("y2","v2"), slab=paste0(author, ", ", year)) dat <- summary(dat, var.names=c("y1","v1"), out.names=c("sei1","zi1","pval1","ci.lb1","ci.ub1")) dat <- summary(dat, var.names=c("y2","v2"), out.names=c("sei2","zi2","pval2","ci.lb2","ci.ub2")) expect_equivalent(with(dat, c(zi1[1], sei1[1], ci.lb1[1], ci.ub1[1])), c(-1.5586, 0.5706, -2.0077, 0.2290), tolerance=.tol[["est"]]) expect_equivalent(with(dat, c(zi2[1], sei2[1], ci.lb2[1], ci.ub2[1])), c(-1.5708, 0.5976, -2.1100, 0.2326), tolerance=.tol[["est"]]) dat <- dat[,1:11] expect_identical(attr(dat, "yi.names"), "y1") expect_identical(attr(dat, "vi.names"), "v1") }) test_that("'subset' and 'include' arguments work correctly in 'escalc'.", { all <- dat.bcg all$tpos[1] <- NA dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=all, subset=1:4) expect_equivalent(c(dat$yi), c(NA, -1.5854, -1.3481, -1.4416), tolerance=.tol[["est"]]) dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=all, subset=1:4, include=1:3) expect_equivalent(c(dat$yi), c(NA, -1.5854, -1.3481, NA), tolerance=.tol[["est"]]) expect_identical(attributes(dat$yi)$ni, c(NA, 609L, 451L, NA)) dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=all, subset=1:4, include=1:3, add.measure=TRUE) expect_identical(dat$measure, c("", "RR", "RR", "")) attributes(dat$yi)$ni[3] <- 1L dat <- escalc(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, include=3:4, add.measure=TRUE) expect_equivalent(c(dat$yi), c(NA, -1.5854, -1.3863, -1.4564), tolerance=.tol[["est"]]) expect_identical(dat$measure, c("", "RR", "OR", "OR")) expect_identical(attributes(dat$yi)$ni, c(NA, 609L, 451L, 26465L)) dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=all, subset=1:4, include=1:3, add.measure=TRUE) attributes(dat$yi)$ni[3] <- 1L dat <- escalc(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, include=3:4, replace=FALSE, add.measure=TRUE) expect_equivalent(c(dat$yi), c(NA, -1.5854, -1.3481, -1.4564), tolerance=.tol[["est"]]) expect_identical(dat$measure, c("", "RR", "RR", "OR")) expect_identical(attributes(dat$yi)$ni, c(NA, 609L, 1L, 26465L)) dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=all, subset=1:4, include=1:3, append=FALSE, add.measure=TRUE) expect_equivalent(c(dat$yi), c(NA, -1.5854, -1.3481, NA), tolerance=.tol[["est"]]) expect_identical(dat$measure, c("", "RR", "RR", "")) }) rm(list=ls()) metafor/tests/testthat/test_misc_permutest.r0000644000176200001440000000534014231265722021204 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: permutest() function") source("settings.r") ### load data dat <- dat.hine1989 ### calculate risk differences and corresponding sampling variances dat <- escalc(measure="RD", n1i=n1i, n2i=n2i, ai=ai, ci=ci, data=dat) test_that("permutest() gives correct results for a random-effects model.", { skip_on_cran() ### fit random-effects model res <- rma(yi, vi, data=dat) ### exact permutation test sav <- permutest(res, progbar=FALSE) expect_equivalent(sav$pval, 0.0625) out <- capture.output(print(sav)) ### so that print.permutest.rma.uni() is run (at least once) tmp <- coef(sav) expected <- structure(list(estimate = 0.029444, se = 0.013068, zval = 2.253107, pval = 0.0625, ci.lb = 0.003831, ci.ub = 0.055058), .Names = c("estimate", "se", "zval", "pval", "ci.lb", "ci.ub"), row.names = "intrcpt", class = "data.frame") expect_equivalent(tmp, expected, tolerance=.tol[["misc"]]) ### approximate permutation test set.seed(1234) sav <- permutest(res, iter=50, progbar=FALSE, control=list(p2defn="px2")) expect_equivalent(sav$pval, 0.08) set.seed(1234) sav <- permutest(res, iter=50, progbar=FALSE, control=list(p2defn="px2", stat="coef")) expect_equivalent(sav$pval, 0.08) }) test_that("permutest() gives correct results for a mixed-effects model.", { skip_on_cran() ### add a fake moderator dat$mod <- c(3,1,2,2,4,5) ### fit mixed-effects model res <- rma(yi, vi, mods = ~ mod, data=dat) ### exact permutation test sav <- permutest(res, progbar=FALSE) expect_equivalent(sav$pval, c(1, 0.0028), tolerance=.tol[["pval"]]) ### approximate permutation test set.seed(1234) sav <- permutest(res, iter=50, progbar=FALSE, control=list(p2defn="px2")) expect_equivalent(sav$pval, c(.04, .04)) sav <- permutest(res, iter=50, progbar=FALSE, control=list(p2defn="px2", stat="coef")) expect_equivalent(sav$pval, c(.04, .04)) }) test_that("permutest() gives correct results for example in Follmann & Proschan (1999).", { skip_on_cran() ### data in Table 1 dat <- read.table(header=TRUE, text = " ai n1i ci n2i 173 5331 210 5296 157 1906 193 1900 131 4541 121 4516 56 2051 84 2030 52 424 65 422 36 1149 42 1129 62 6582 20 1663 2 88 2 30") dat <- escalc(measure="PETO", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat) res <- rma(yi, vi, data=dat, method="DL") sav <- permutest(res, permci=TRUE, progbar=FALSE, control=list(stat="coef")) expect_equivalent(sav$pval, 10/256) expect_equivalent(sav$ci.lb, -0.3677, tolerance=.tol[["ci"]]) expect_equivalent(sav$ci.ub, -0.0020, tolerance=.tol[["ci"]]) }) rm(list=ls()) metafor/tests/testthat/settings.r0000644000176200001440000000506214505026426016743 0ustar liggesusers############################################################################ .tol <- c(est = .01, # effect size estimates coef = .01, # model coefficients pred = .01, # predicted values, BLUPs, also residuals se = .01, # standard errors test = .01, # test statistics, standardized residuals pval = .01, # p-values ci = .01, # confidence/prediction interval bounds, CI for effects var = .01, # variance components (and CIs thereof), also if sqrt(), var-cov matrices, sampling variances cor = .01, # correlations, ICCs cov = .01, # covariances sevar = .01, # SEs of variance components fit = .01, # fit statistics r2 = .01, # R^2 type values het = .01, # heterogeneity statistics (and CIs thereof) inf = .01, # influence statistics, hat values den = .01, # density misc = .01) # miscellaneous, mix of values # to quickly set all tolerances to a common value .tol[1:length(.tol)] <- .01 ############################################################################ .sparse <- FALSE #.sparse <- TRUE ############################################################################ .vistest <- function(file1, file2) { if (isFALSE(as.logical(Sys.getenv("RUN_VIS_TESTS", "false")))) { return(TRUE) } else { hash1 <- suppressWarnings(system2("md5sum", file1, stdout=TRUE, stderr=TRUE)) hash2 <- suppressWarnings(system2("md5sum", file2, stdout=TRUE, stderr=TRUE)) if (isTRUE(attributes(hash1)$status == 1) || isTRUE(attributes(hash2)$status == 1)) return(FALSE) hash1 <- strsplit(hash1, " ")[[1]][1] hash2 <- strsplit(hash2, " ")[[1]][1] return(identical(hash1,hash2)) #file1 <- readLines(file1, warn=FALSE) #file2 <- readLines(file2, warn=FALSE) #file1 <- file1[!grepl("CreationDate", file1, fixed=TRUE, useBytes=TRUE)] #file2 <- file2[!grepl("CreationDate", file2, fixed=TRUE, useBytes=TRUE)] #file1 <- file1[!grepl("ModDate", file1, fixed=TRUE, useBytes=TRUE)] #file2 <- file2[!grepl("ModDate", file2, fixed=TRUE, useBytes=TRUE)] #file1 <- file1[!grepl("Producer", file1, fixed=TRUE, useBytes=TRUE)] #file2 <- file2[!grepl("Producer", file2, fixed=TRUE, useBytes=TRUE)] #return(identical(file1,file2)) } } ############################################################################ setmfopt(theme="default") ############################################################################ metafor/tests/testthat/test_analysis_example_raudenbush2009.r0000644000176200001440000001423014204414264024225 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:raudenbush2009 context("Checking analysis example: raudenbush2009") source("settings.r") ### load data dat <- dat.raudenbush1985 test_that("results are correct for the equal-effects model.", { ### equal-effects model res.EE <- rma(yi, vi, data=dat, digits=3, method="EE") ### compare with results on page 301 (Table 16.2) and page 302 expect_equivalent(coef(res.EE), 0.0604, tolerance=.tol[["coef"]]) expect_equivalent(res.EE$QE, 35.8295, tolerance=.tol[["test"]]) expect_equivalent(res.EE$zval, 1.6553, tolerance=.tol[["test"]]) ### 1.65 in chapter }) test_that("results are correct for the random-effects model.", { ### random-effects model res.RE <- rma(yi, vi, data=dat, digits=3) ### compare with results on page 301 (Table 16.2) and page 302 expect_equivalent(coef(res.RE), 0.0837, tolerance=.tol[["coef"]]) ### 0.083 in chapter expect_equivalent(res.RE$zval, 1.6208, tolerance=.tol[["test"]]) expect_equivalent(res.RE$tau2, 0.0188, tolerance=.tol[["var"]]) ### prediction interval tmp <- predict(res.RE) ### compare with results on page 301 (Table 16.2) and page 302 expect_equivalent(tmp$pi.lb, -0.2036, tolerance=.tol[["ci"]]) ### -0.19 in chapter but computed in a slightly different way expect_equivalent(tmp$pi.ub, 0.3711, tolerance=.tol[["ci"]]) ### 0.35 in chapter but computed in a slightly different way ### range of BLUPs tmp <- range(blup(res.RE)$pred) ### compare with results on page 301 (Table 16.2) expect_equivalent(tmp, c(-0.0293, 0.2485), tolerance=.tol[["pred"]]) }) test_that("results are correct for the mixed-effects model.", { ### recode weeks variable dat$weeks.c <- ifelse(dat$weeks > 3, 3, dat$weeks) ### mixed-effects model res.ME <- rma(yi, vi, mods = ~ weeks.c, data=dat, digits=3) ### compare with results on page 301 (Table 16.2) expect_equivalent(res.ME$tau2, 0.0000, tolerance=.tol[["var"]]) expect_equivalent(coef(res.ME), c(0.4072, -0.1572), tolerance=.tol[["coef"]]) expect_equivalent(res.ME$QE, 16.5708, tolerance=.tol[["test"]]) expect_equivalent(res.ME$zval, c(4.6782, -4.3884), tolerance=.tol[["test"]]) ### range of BLUPs tmp <- range(blup(res.ME)$pred) ### compare with results on page 301 (Table 16.2) expect_equivalent(tmp, c(-0.0646, 0.4072), tolerance=.tol[["pred"]]) ### -0.07 in chapter }) test_that("results are correct for the random-effects model (conventional approach).", { res.std <- list() res.std$EE <- rma(yi, vi, data=dat, digits=3, method="EE") res.std$ML <- rma(yi, vi, data=dat, digits=3, method="ML") res.std$REML <- rma(yi, vi, data=dat, digits=3, method="REML") res.std$DL <- rma(yi, vi, data=dat, digits=3, method="DL") res.std$HE <- rma(yi, vi, data=dat, digits=3, method="HE") tmp <- t(sapply(res.std, function(x) c(tau2=x$tau2, mu=x$beta, se=x$se, z=x$zval, ci.lb=x$ci.lb, ci.ub=x$ci.ub))) expected <- structure(c(0, 0.0126, 0.0188, 0.0259, 0.0804, 0.0604, 0.0777, 0.0837, 0.0893, 0.1143, 0.0365, 0.0475, 0.0516, 0.0558, 0.0792, 1.6553, 1.6368, 1.6208, 1.6009, 1.4432, -0.0111, -0.0153, -0.0175, -0.02, -0.0409, 0.1318, 0.1708, 0.1849, 0.1987, 0.2696), .Dim = 5:6, .Dimnames = list(c("EE", "ML", "REML", "DL", "HE"), c("tau2", "mu", "se", "z", "ci.lb", "ci.ub"))) ### compare with results on page 309 (Table 16.3) expect_equivalent(tmp, expected, tolerance=.tol[["misc"]]) }) test_that("results are correct for the random-effects model (Knapp & Hartung method).", { res.knha <- list() expect_warning(res.knha$EE <- rma(yi, vi, data=dat, digits=3, method="EE", test="knha")) res.knha$ML <- rma(yi, vi, data=dat, digits=3, method="ML", test="knha") res.knha$REML <- rma(yi, vi, data=dat, digits=3, method="REML", test="knha") res.knha$DL <- rma(yi, vi, data=dat, digits=3, method="DL", test="knha") res.knha$HE <- rma(yi, vi, data=dat, digits=3, method="HE", test="knha") tmp <- t(sapply(res.knha, function(x) c(tau2=x$tau2, mu=x$beta, se=x$se, z=x$zval, ci.lb=x$ci.lb, ci.ub=x$ci.ub))) expected <- structure(c(0, 0.0126, 0.0188, 0.0259, 0.0804, 0.0604, 0.0777, 0.0837, 0.0893, 0.1143, 0.0515, 0.0593, 0.0616, 0.0636, 0.0711, 1.1733, 1.311, 1.3593, 1.405, 1.6078, -0.0477, -0.0468, -0.0457, -0.0442, -0.0351, 0.1685, 0.2023, 0.2131, 0.2229, 0.2637), .Dim = 5:6, .Dimnames = list(c("EE", "ML", "REML", "DL", "HE"), c("tau2", "mu", "se", "z", "ci.lb", "ci.ub"))) ### compare with results on page 309 (Table 16.3) expect_equivalent(tmp, expected, tolerance=.tol[["misc"]]) }) test_that("results are correct for the random-effects model (Huber-White method).", { res.std <- list() res.std$EE <- rma(yi, vi, data=dat, digits=3, method="EE") res.std$ML <- rma(yi, vi, data=dat, digits=3, method="ML") res.std$REML <- rma(yi, vi, data=dat, digits=3, method="REML") res.std$DL <- rma(yi, vi, data=dat, digits=3, method="DL") res.std$HE <- rma(yi, vi, data=dat, digits=3, method="HE") res.hw <- list() res.hw$EE <- robust(res.std$EE, cluster=study, adjust=FALSE) res.hw$ML <- robust(res.std$ML, cluster=study, adjust=FALSE) res.hw$REML <- robust(res.std$REML, cluster=study, adjust=FALSE) res.hw$DL <- robust(res.std$DL, cluster=study, adjust=FALSE) res.hw$HE <- robust(res.std$HE, cluster=study, adjust=FALSE) out <- capture.output(print(res.hw$REML)) ### so that print.robust.rma() is run (at least once) tmp <- t(sapply(res.hw, function(x) c(tau2=x$tau2, mu=x$beta, se=x$se, t=x$zval, ci.lb=x$ci.lb, ci.ub=x$ci.ub))) expected <- structure(c(0, 0.0126, 0.0188, 0.0259, 0.0804, 0.0604, 0.0777, 0.0837, 0.0893, 0.1143, 0.0398, 0.0475, 0.05, 0.0522, 0.0618, 1.5148, 1.6369, 1.6756, 1.7105, 1.8503, -0.0234, -0.022, -0.0213, -0.0204, -0.0155, 0.1441, 0.1775, 0.1887, 0.199, 0.2441), .Dim = 5:6, .Dimnames = list(c("EE", "ML", "REML", "DL", "HE"), c("tau2", "mu", "se", "t", "ci.lb", "ci.ub"))) ### compare with results on page 309 (Table 16.3) expect_equivalent(tmp, expected, tolerance=.tol[["misc"]]) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_law2016.r0000644000176200001440000002053314502306377022657 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking analysis example: law2016") source("settings.r") test_that("results are correct for example 1.", { skip_on_cran() ### example 1 EG1 <- read.table(header=TRUE, as.is=TRUE, text=" study y ref trt contr design 1 -0.16561092 C D CD CD 2 -0.13597406 C D CD CD 3 -0.08012604 C E CE CE 4 -0.14746890 C F CF CF 5 0.09316853 E F EF EF 6 -0.15859403 E F EF EF 7 -0.22314355 E F EF EF 8 -0.06744128 F G FG FG 9 -0.11888254 C H CH CH 10 -0.06899287 C H CH CH 11 0.26917860 B C BC BC 12 -0.33160986 A B AB AB 13 -0.26236426 A B AB AB 14 -0.39319502 F G FG FG 15 -0.11557703 A B AB AB 16 0.00000000 E F EF EF 17 -0.40987456 A E AE AE ") S1 <- structure(c(0.0294183340466069, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.147112449467866, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0780588660166125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.140361934247383, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0479709251030665, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0506583523716436, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.235695187165775, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2.04499494438827, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.17968120987923, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.735714285714286, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.184889643463497, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0294022652280727, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.232478632478632, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.857874134296899, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0219285638496459, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.168131868131868, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0826973577700322 ), .Dim = c(17, 17)) ### create contrast matrix X <- contrmat(EG1, grp1="trt", grp2="ref", append=FALSE, last=NA)[,-1] # remove 'A' to make it the reference level ### fit model assuming consistency (tau^2_omega=0) modC <- rma.mv(y, S1, mods=X, intercept=FALSE, random = ~ contr | study, rho=1/2, data=EG1, sparse=.sparse) ci <- confint(modC) expect_equivalent(modC$tau2, 0.0000, tolerance=.tol[["var"]]) expect_equivalent(coef(modC), c(-0.2243, -0.1667, -0.3274, -0.3152, -0.3520, -0.6489, -0.2758), tolerance=.tol[["coef"]]) expect_equivalent(ci$random[1,2:3], c(0.0000, 0.0708), tolerance=.tol[["var"]]) ### fit inconsistency model (switch optimizer so that model converges also under Atlas) #modI <- rma.mv(y, S1, mods=X, intercept=FALSE, random = list(~ contr | study, ~ contr | design), rho=1/2, phi=1/2, data=EG1, sparse=.sparse) modI <- rma.mv(y, S1, mods=X, intercept=FALSE, random = list(~ contr | study, ~ contr | design), rho=1/2, phi=1/2, data=EG1, sparse=.sparse, control=list(optimizer="optim")) ci <- confint(modI) out <- capture.output(print(modI)) out <- capture.output(print(ci)) expect_equivalent(modI$tau2, 0.0000, tolerance=.tol[["var"]]) expect_equivalent(modI$gamma2, 0.0000, tolerance=.tol[["var"]]) expect_equivalent(coef(modI), c(-0.2243, -0.1667, -0.3274, -0.3152, -0.3520, -0.6489, -0.2758), tolerance=.tol[["coef"]]) expect_equivalent(ci[[1]]$random[1,2:3], c(0.0000, 0.0708), tolerance=.tol[["var"]]) expect_equivalent(ci[[2]]$random[1,2:3], c(0.0000, 0.6153), tolerance=.tol[["var"]]) sav <- predict(modI, newmods=c(1,0,0,0,0,0,0), transf=exp) sav <- c(sav[[1]], sav[[3]], sav[[4]], sav[[5]], sav[[6]]) expect_equivalent(sav, c(0.7991, 0.6477, 0.9859, 0.6477, 0.9859), tolerance=.tol[["pred"]]) }) test_that("results are correct for example 2.", { skip_on_cran() ### example 2 EG2 <- read.table(header=TRUE, as.is=TRUE, text=" study y ref trt contr design 1 -3.61988658 A B AB AB 2 0.00000000 B C BC BC 3 0.19342045 B C BC BC 4 2.79320801 B C BC BC 5 0.24512246 B C BC BC 6 0.03748309 B C BC BC 7 0.86020127 B D BD BD 8 0.14310084 B D BD BD 9 0.07598591 C D CD CD 10 -0.99039870 C D CD CD 11 -1.74085310 A B AB ABD 11 0.34830670 A D AD ABD 12 0.40546510 B C BC BCD 12 1.91692260 B D BD BCD 13 -0.32850410 B C BC BCD 13 1.07329450 B D BD BCD ") S2 <- structure(c(0.9672619, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.24987648, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.61904762, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.27958937, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.23845689, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.04321419, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.47692308, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.18416468, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.61978022, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.12650164, 0.07397504, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.07397504, 0.1583906, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.389881, 0.2857143, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2857143, 0.5151261, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.4361111, 0.2111111, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2111111, 0.5380342 ), .Dim = c(16, 16)) ### create contrast matrix X <- contrmat(EG2, grp1="trt", grp2="ref", append=FALSE, last=NA)[,-1] # remove 'A' to make it the reference level ### fit model assuming consistency (tau^2_omega=0) modC <- rma.mv(y, S2, mods=X, intercept=FALSE, random = ~ contr | study, rho=1/2, data=EG2, sparse=.sparse) ci <- confint(modC) expect_equivalent(modC$tau2, 0.5482, tolerance=.tol[["var"]]) expect_equivalent(coef(modC), c(-1.8847, -1.3366, -0.7402), tolerance=.tol[["coef"]]) expect_equivalent(ci$random[1,2:3], c(0.0788, 2.0156), tolerance=.tol[["var"]]) ### fit inconsistency model modI <- rma.mv(y, S2, mods=X, intercept=FALSE, random = list(~ contr | study, ~ contr | design), rho=1/2, phi=1/2, data=EG2, sparse=.sparse) ci <- confint(modI) expect_equivalent(modI$tau2, 0.1036, tolerance=.tol[["var"]]) expect_equivalent(modI$gamma2, 0.5391, tolerance=.tol[["var"]]) expect_equivalent(coef(modI), c(-1.9735, -1.3957, -0.6572), tolerance=.tol[["coef"]]) expect_equivalent(ci[[1]]$random[1,2:3], c(0.0000, 1.6661), tolerance=.tol[["var"]]) expect_equivalent(ci[[2]]$random[1,2:3], c(0.0000, 3.9602), tolerance=.tol[["var"]]) sav <- predict(modI, newmods=c(1,0,0), transf=exp) sav <- c(sav[[1]], sav[[3]], sav[[4]], sav[[5]], sav[[6]]) expect_equivalent(sav, c(0.1390, 0.0369, 0.5230, 0.0178, 1.0856), tolerance=.tol[["pred"]]) sav <- ranef(modI) expect_equivalent(sav[[1]]$intrcpt, c(-0.10597655, -0.09440298, -0.07779308, 0.3347431, -0.05778032, -0.12762821, 0.02644374, -0.12131344, 0.01314657, -0.14752923, 0.02919657, 0.12976825, 0.02697319, 0.08415593, -0.10064816, -0.06422411), tolerance=.tol[["pred"]]) expect_equivalent(sav[[1]]$se, c(0.31440795, 0.29262165, 0.28283046, 0.30063561, 0.28520752, 0.28184516, 0.28589877, 0.29733608, 0.29721077, 0.30375728, 0.3128377, 0.31456144, 0.3010675, 0.30435923, 0.30178776, 0.3045846), tolerance=.tol[["se"]]) expect_equivalent(sav[[2]]$intrcpt, c(-0.55126986, 0.15187503, 0.67502976, -0.11892109, -0.38324316, 0.10368152, -0.49349415, -0.69903298), tolerance=.tol[["pred"]]) expect_equivalent(sav[[2]]$se, c(0.64017885, 0.61901365, 0.64221591, 0.51773958, 0.54266969, 0.53007858, 0.48613683, 0.54031058), tolerance=.tol[["se"]]) out <- capture.output(print(sav)) sav <- predict(modI) expect_equivalent(sav$pi.lb, c(-4.029, -1.2853, -1.2853, -1.2853, -1.2853, -1.2853, -0.4911, -0.4911, -1.137, -1.137, -4.029, -2.7699, -1.2853, -0.4911, -1.2853, -0.4911), tolerance=.tol[["pred"]]) }) rm(list=ls()) metafor/tests/testthat/test_plots_llplot.r0000644000176200001440000000146414503346231020670 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") source("settings.r") context("Checking plots example: likelihood plot") test_that("plot can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_llplot_test.png", res=200, width=1800, height=1600, type="cairo") ### adjust margins so the space is better used par(mar=c(5,4,2,2)) ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### create likelihood plot llplot(measure="GEN", yi=yi, vi=vi, data=dat, lwd=1, refline=NA, xlim=c(-3,2)) dev.off() expect_true(.vistest("images/test_plots_llplot_test.png", "images/test_plots_llplot.png")) }) rm(list=ls()) metafor/tests/testthat/test_misc_tes.r0000644000176200001440000000242514302165514017745 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: tes() function") source("settings.r") test_that("tes() works correctly for 'dat.dorn2007'.", { dat <- escalc(measure="RR", ai=x.a, n1i=n.a, ci=x.p, n2i=n.p, data=dat.dorn2007) sav <- tes(dat$yi, dat$vi, test="chi2") out <- capture.output(print(sav)) expect_identical(sav$O, 10L) expect_equivalent(sav$E, 4.923333, tolerance=.tol[["misc"]]) expect_equivalent(sav$X2, 7.065648, tolerance=.tol[["test"]]) expect_equivalent(sav$pval, 0.003928794, tolerance=.tol[["pval"]]) sav <- tes(yi, vi, data=dat, test="chi2") expect_equivalent(sav$pval, 0.003928794, tolerance=.tol[["pval"]]) sav <- tes(yi, vi, data=dat, test="binom") expect_equivalent(sav$pval, 0.01159554, tolerance=.tol[["pval"]]) skip_on_cran() sav <- tes(yi, vi, data=dat, test="exact", progbar=FALSE) expect_equivalent(sav$pval, 0.007778529, tolerance=.tol[["pval"]]) res <- rma(yi, vi, data=dat, method="EE") sav <- tes(res, test="chi2") expect_identical(sav$O, 10L) expect_equivalent(sav$E, 4.923333, tolerance=.tol[["misc"]]) expect_equivalent(sav$X2, 7.065648, tolerance=.tol[["test"]]) expect_equivalent(sav$pval, 0.003928794, tolerance=.tol[["pval"]]) }) rm(list=ls()) metafor/tests/testthat/test_tips_rma_vs_lm_and_lme.r0000644000176200001440000000540214204414750022632 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking tip: rma() results match up with those from lm() and lme()") source("settings.r") ### this is essentially checking the equivalence of the results as explained here: ### https://www.metafor-project.org/doku.php/tips:rma_vs_lm_and_lme test_that("results for rma() and lm() match for method='FE'.", { dat <- escalc(measure="ZCOR", ri=ri, ni=ni, data=dat.molloy2014) res.ee <- rma(yi, vi, data=dat, method="EE") res.lm <- lm(yi ~ 1, weights = 1/vi, data=dat) ### coefficients should be the same expect_equivalent(coef(res.ee), coef(res.lm), tolerance=.tol[["coef"]]) ### standard errors should be the same after adjusting the 'lm' one for sigma expect_equivalent(res.ee$se, coef(summary(res.lm))[1,2] / sigma(res.lm), tolerance=.tol[["se"]]) ### fit the same model as is fitted by lm() with rma() function res.ee <- rma(yi, vi*sigma(res.lm)^2, data=dat, method="EE") ### coefficients should still be the same expect_equivalent(coef(res.ee), coef(res.lm), tolerance=.tol[["coef"]]) ### standard errors should be the same expect_equivalent(res.ee$se, coef(summary(res.lm))[1,2], tolerance=.tol[["se"]]) }) test_that("results for rma() and lme() match for method='ML'.", { library("nlme") dat <- escalc(measure="ZCOR", ri=ri, ni=ni, data=dat.molloy2014) dat$study <- 1:nrow(dat) res.lme <- lme(yi ~ 1, random = ~ 1 | study, weights = varFixed(~ vi), data=dat, method="ML") res.re <- rma(yi, vi*sigma(res.lme)^2, data=dat, method="ML") ### coefficients should be the same expect_equivalent(coef(res.re), fixef(res.lme), tolerance=.tol[["coef"]]) ### standard errors should be the same after adjusting the 'rma' one by the factor sqrt(k/(k-p)) expect_equivalent(res.re$se * sqrt(res.re$k / (res.re$k - res.re$p)), summary(res.lme)$tTable[1,2], tolerance=.tol[["se"]]) ### check that BLUPs are the same expect_equivalent(blup(res.re)$pred, coef(res.lme)$"(Intercept)", tolerance=.tol[["pred"]]) }) test_that("results for rma() and lme() match for method='REML'.", { library("nlme") dat <- escalc(measure="ZCOR", ri=ri, ni=ni, data=dat.molloy2014) dat$study <- 1:nrow(dat) res.lme <- lme(yi ~ 1, random = ~ 1 | study, weights = varFixed(~ vi), data=dat, method="REML") res.re <- rma(yi, vi*sigma(res.lme)^2, data=dat, method="REML") ### coefficients should be the same expect_equivalent(coef(res.re), fixef(res.lme), tolerance=.tol[["coef"]]) ### standard errors should be the same expect_equivalent(res.re$se, summary(res.lme)$tTable[1,2], tolerance=.tol[["se"]]) ### check that BLUPs are the same expect_equivalent(blup(res.re)$pred, coef(res.lme)$"(Intercept)", tolerance=.tol[["pred"]]) }) rm(list=ls()) metafor/tests/testthat/test_plots_contour-enhanced_funnel_plot.r0000644000176200001440000000205714503346013025220 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/plots:contour_enhanced_funnel_plot source("settings.r") context("Checking plots example: contour-enhanced funnel plot") test_that("plot can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_contour_enhanced_funnel_plot_test.png", res=200, width=1800, height=1500, type="cairo") ### decrease margins so the full space is used par(mar=c(5,4,1,2)) ### fit random-effects model res <- rma(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, measure="RR", slab=paste(author, year, sep=", "), method="REML") ### create contour enhanced funnel plot (with funnel centered at 0) funnel(res, level=c(90, 95, 99), shade=c("white", "gray55", "gray75"), refline=0, legend=TRUE) dev.off() expect_true(.vistest("images/test_plots_contour_enhanced_funnel_plot_test.png", "images/test_plots_contour_enhanced_funnel_plot.png")) }) rm(list=ls()) metafor/tests/testthat/test_plots_gosh.r0000644000176200001440000000453014503346200020313 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/plots:gosh_plot source("settings.r") context("Checking plots example: GOSH plot") test_that("plot can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() ### meta-analysis of all trials including ISIS-4 using an equal-effects model res <- rma(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat.egger2001, method="EE") ### fit EE model to all possible subsets sav <- gosh(res, progbar=FALSE) out <- capture.output(print(sav)) # so that print.gosh.rma() is run (at least once) ### create GOSH plot ### red points for subsets that include and blue points ### for subsets that exclude study 16 (the ISIS-4 trial) png("images/test_plots_gosh_1_test.png", res=200, width=1800, height=1800, type="cairo") plot(sav, out=16, breaks=100) dev.off() expect_true(.vistest("images/test_plots_gosh_1_test.png", "images/test_plots_gosh_1.png")) ### fit EE model to random subsets (with parallel processing) sav <- gosh(res, progbar=FALSE, parallel="snow", subsets=1000) ### meta-analysis using MH method (using subset to speed things up) res <- rma.mh(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat.egger2001, subset=c(1:7,16)) sav <- gosh(res, progbar=FALSE) ### create GOSH plot png("images/test_plots_gosh_2_test.png", res=200, width=1800, height=1800, type="cairo") plot(sav, out=8, breaks=40) dev.off() expect_true(.vistest("images/test_plots_gosh_2_test.png", "images/test_plots_gosh_2.png")) ### fit EE model to all possible subsets (with parallel processing) sav <- gosh(res, progbar=FALSE, parallel="snow", subsets=1000) ### meta-analysis using Peto's method (using subset to speed things up) res <- rma.peto(ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat.egger2001, subset=c(1:7,16)) sav <- gosh(res, progbar=FALSE) ### create GOSH plot png("images/test_plots_gosh_3_test.png", res=200, width=1800, height=1800, type="cairo") plot(sav, out=8, breaks=40) dev.off() expect_true(.vistest("images/test_plots_gosh_3_test.png", "images/test_plots_gosh_3.png")) ### fit EE model to all possible subsets (with parallel processing) sav <- gosh(res, progbar=FALSE, parallel="snow", subsets=1000) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_vanhouwelingen2002.r0000644000176200001440000002204714503345325025117 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:vanhouwelingen2002 context("Checking analysis example: vanhouwelingen2002") source("settings.r") ### load data dat <- dat.colditz1994 ### calculate log(OR)s and corresponding sampling variances dat <- escalc(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) ### 'center' year variable dat$year <- dat$year - 1900 test_that("results for the equal-effects model are correct.", { res <- rma(yi, vi, data=dat, method="EE") tmp <- predict(res, transf=exp, digits=3) ### compare with results on page 596 (in text) expect_equivalent(tmp$pred, .6465, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, .5951, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, .7024, tolerance=.tol[["ci"]]) ### .703 in paper }) test_that("results for the random-effects model are correct.", { res <- rma(yi, vi, data=dat, method="ML") tmp <- predict(res, transf=exp, digits=3) ### compare with results on page 597 (in text) expect_equivalent(tmp$pred, .4762, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, .3360, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, .6749, tolerance=.tol[["ci"]]) expect_equivalent(res$tau2, .3025, tolerance=.tol[["var"]]) ### CI for tau^2 (profile likelihood method) tmp <- confint(res, type="PL") expect_equivalent(tmp$random[1,2], 0.1151, tolerance=.tol[["var"]]) expect_equivalent(tmp$random[1,3], 0.8937, tolerance=.tol[["var"]]) ### CI for tau^2 (Q-profile method) tmp <- confint(res) expect_equivalent(tmp$random[1,2], 0.1302, tolerance=.tol[["var"]]) ### 0.1350 based on a Satterthwaite approximation (page 597) expect_equivalent(tmp$random[1,3], 1.1812, tolerance=.tol[["var"]]) ### 1.1810 based on a Satterthwaite approximation (page 597) ### CI for mu with Knapp & Hartung method res <- rma(yi, vi, data=dat, method="ML", test="knha") tmp <- predict(res, transf=exp, digits=3) ### (results for this not given in paper) expect_equivalent(tmp$ci.lb, .3175, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, .7141, tolerance=.tol[["ci"]]) }) test_that("profile plot for tau^2 can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() res <- rma(yi, vi, data=dat, method="ML") png(filename="images/test_analysis_example_vanhouwelingen2002_profile_test.png", res=200, width=1800, height=1600, type="cairo") profile(res, xlim=c(0.01,2), steps=200, log="x", cex=0, lwd=2, cline=TRUE, progbar=FALSE) abline(v=c(0.1151, 0.8937), lty="dotted") dev.off() expect_true(.vistest("images/test_analysis_example_vanhouwelingen2002_profile_test.png", "images/test_analysis_example_vanhouwelingen2002_profile.png")) }) test_that("forest plot of observed log(OR)s and corresponding BLUPs can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() res <- rma(yi, vi, data=dat, method="ML") sav <- blup(res) png(filename="images/test_analysis_example_vanhouwelingen2002_forest_test.png", res=200, width=1800, height=1400, family="mono") par(mar=c(5,5,1,2)) forest(res, refline=res$b, addcred=TRUE, xlim=c(-7,7), alim=c(-3,3), slab=1:13, psize=0.8, ilab=paste0("(n = ", formatC(apply(dat[,c(4:7)], 1, sum), width=7, big.mark=","), ")"), ilab.xpos=-3.5, ilab.pos=2, rows=13:1+0.15, header="Trial (total n)", lty="dashed") arrows(sav$pi.lb, 13:1 - 0.15, sav$pi.ub, 13:1 - 0.15, length=0.035, angle=90, code=3) points(sav$pred, 13:1 - 0.15, pch=15, cex=0.8) dev.off() expect_true(.vistest("images/test_analysis_example_vanhouwelingen2002_forest_test.png", "images/test_analysis_example_vanhouwelingen2002_forest.png")) }) test_that("the prediction interval is correct.", { res <- rma(yi, vi, data=dat, method="ML") ### computation as done in the paper tmp <- c(res$beta) + c(-1,+1) * qnorm(.975) * sqrt(res$tau2) ### compare with results on page 599 (in text) expect_equivalent(tmp, c(-1.8199, 0.3359), tolerance=.tol[["ci"]]) ### computation done with metafor tmp <- predict(res, digits=3) ### (results for this not given in paper) expect_equivalent(tmp$pi.lb, -1.875, tolerance=.tol[["ci"]]) expect_equivalent(tmp$pi.ub, 0.391, tolerance=.tol[["ci"]]) }) test_that("L'Abbe plot can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() res <- rma(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat, method="EE") png(filename="images/test_analysis_example_vanhouwelingen2002_labbe_test.png", res=200, width=1800, height=1400, type="cairo") par(mar=c(5,5,1,2)) labbe(res, xlim=c(-7,-1), ylim=c(-7,-1), xlab="ln(odds) not-vaccinated group", ylab="ln(odds) vaccinated group") dev.off() expect_true(.vistest("images/test_analysis_example_vanhouwelingen2002_labbe_test.png", "images/test_analysis_example_vanhouwelingen2002_labbe.png")) }) ############################################################################ ### create dataset in long format dat.long <- to.long(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.colditz1994) dat.long <- escalc(measure="PLO", xi=out1, mi=out2, data=dat.long) dat.long$tpos <- dat.long$tneg <- dat.long$cpos <- dat.long$cneg <- NULL levels(dat.long$group) <- c("CON", "EXP") test_that("results for the bivariate model are correct.", { res <- rma.mv(yi, vi, mods = ~ group - 1, random = ~ group | trial, struct="UN", data=dat.long, method="ML", sparse=.sparse) ### compare with results on pages 604-605 (in text) expect_equivalent(coef(res), c(-4.0960, -4.8337), tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, c(2.4073, 1.4314), tolerance=.tol[["var"]]) expect_equivalent(res$rho, .9467, tolerance=.tol[["cor"]]) res <- rma.mv(yi, vi, mods = ~ group, random = ~ group | trial, struct="UN", data=dat.long, method="ML", sparse=.sparse) ### compare with results on pages 604-605 (in text) expect_equivalent(coef(res), c(-4.0960, -0.7378), tolerance=.tol[["coef"]]) expect_equivalent(res$se, c(0.4347, 0.1797), tolerance=.tol[["se"]]) ### estimated odds ratio tmp <- predict(res, newmods=1, intercept=FALSE, transf=exp, digits=3) expect_equivalent(tmp$pred, 0.4782, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 0.3362, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 0.6801, tolerance=.tol[["ci"]]) ### amount of heterogeneity in log odds ratios tmp <- res$tau2[1] + res$tau2[2] - 2*res$rho*sqrt(res$tau2[1]*res$tau2[2]) expect_equivalent(tmp, 0.3241, tolerance=.tol[["var"]]) ### regression of log(odds)_EXP on log(odds)_CON res <- rma.mv(yi, vi, mods = ~ group - 1, random = ~ group | trial, struct="UN", data=dat.long, method="ML", sparse=.sparse) reg <- matreg(y=2, x=1, R=res$G, cov=TRUE, means=coef(res), n=res$g.levels.comb.k) expect_equivalent(reg$tab$beta, c(-1.8437, 0.7300), tolerance=.tol[["coef"]]) expect_equivalent(reg$tab$se, c( 0.3265, 0.0749), tolerance=.tol[["se"]]) ### same idea but now use var-cov matrix of tau^2_1, tau_12, tau^2_2 for this res <- rma.mv(yi, vi, mods = ~ group - 1, random = ~ group | trial, struct="UN", data=dat.long, method="ML", cvvc="varcov", control=list(nearpd=TRUE), sparse=.sparse) reg <- matreg(y=2, x=1, R=res$G, cov=TRUE, means=coef(res), V=res$vvc) expect_equivalent(reg$tab$beta, c(-1.8437, 0.7300), tolerance=.tol[["coef"]]) expect_equivalent(reg$tab$se, c( 0.3548, 0.0866), tolerance=.tol[["se"]]) }) ############################################################################ test_that("results for the meta-regression analyses are correct.", { res <- rma(yi, vi, mods = ~ ablat, data=dat, method="ML") ### compare with results on pages 608-609 (in text) expect_equivalent(coef(res), c(0.3710, -0.0327), tolerance=.tol[["coef"]]) expect_equivalent(res$se, c(0.1061, 0.0034), tolerance=.tol[["se"]]) expect_equivalent(res$tau2, 0.0040, tolerance=.tol[["var"]]) expect_equivalent(res$R2, 98.6691, tolerance=.tol[["r2"]]) res <- rma.mv(yi, vi, mods = ~ group + group:I(ablat-33) - 1, random = ~ group | trial, struct="UN", data=dat.long, method="ML", sparse=.sparse) ### compare with results on pages 612-613 (in text) expect_equivalent(coef(res), c(-4.1174, -4.8257, 0.0725, 0.0391), tolerance=.tol[["coef"]]) expect_equivalent(res$se, c(0.3061, 0.3129, 0.0219, 0.0224), tolerance=.tol[["se"]]) expect_equivalent(res$tau2, c(1.1819, 1.2262), tolerance=.tol[["var"]]) expect_equivalent(res$rho, 1.0000, tolerance=.tol[["cor"]]) res <- rma.mv(yi, vi, mods = ~ group*I(ablat-33), random = ~ group | trial, struct="UN", data=dat.long, method="ML", sparse=.sparse) ### compare with results on pages 612-613 (in text) expect_equivalent(coef(res), c(-4.1174, -0.7083, 0.0725, -0.0333), tolerance=.tol[["coef"]]) expect_equivalent(res$se, c(0.3061, 0.0481, 0.0219, 0.0028), tolerance=.tol[["se"]]) expect_equivalent(res$tau2, c(1.1819, 1.2262), tolerance=.tol[["var"]]) expect_equivalent(res$rho, 1.0000, tolerance=.tol[["cor"]]) }) rm(list=ls()) metafor/tests/testthat/test_plots_meta-analytic_scatterplot.r0000644000176200001440000000231014503346245024532 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/plots:meta_analytic_scatterplot source("settings.r") context("Checking plots example: meta-analytic scatterplot") test_that("plot can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_meta_analytic_scatterplot_test.png", res=200, width=1800, height=1500, type="cairo") ### adjust margins so the space is better used par(mar=c(5,5,1,2)) ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit mixed-effects model with absolute latitude as predictor res <- rma(yi, vi, mods = ~ ablat, data=dat) ### draw plot regplot(res, xlim=c(10,60), predlim=c(10,60), xlab="Absolute Latitude", refline=0, atransf=exp, at=log(seq(0.2,1.6,by=0.2)), digits=1, las=1, bty="l", label=c(4,7,12,13), offset=c(1.6,0.8), labsize=0.9) dev.off() expect_true(.vistest("images/test_plots_meta_analytic_scatterplot_test.png", "images/test_plots_meta_analytic_scatterplot.png")) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_normand1999.r0000644000176200001440000001102714204414255023545 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:normand1999 context("Checking analysis example: normand1999") source("settings.r") test_that("results are correct for the first example (using dat.hine1989).", { ### calculate risk differences and corresponding sampling variances dat <- escalc(measure="RD", n1i=n1i, n2i=n2i, ai=ai, ci=ci, data=dat.hine1989) ### transform into percentage points dat$yi <- dat$yi * 100 dat$vi <- dat$vi * 100^2 out <- capture.output(print(dat)) ### so that print.escalc() is run (at least once) ### compare with results on page 330 (Table III) expect_equivalent(dat$yi, c(2.8026, 0.0000, 1.9711, 1.7961, 3.5334, 4.4031), tolerance=.tol[["est"]]) expect_equivalent(dat$vi, c(17.7575, 37.5657, 8.1323, 10.8998, 8.0114, 6.1320), tolerance=.tol[["var"]]) ### CIs for individual studies tmp <- summary(dat) ### compare with results on page 330 (Table III) expect_equivalent(tmp$ci.lb, c(-5.4566, -12.0128, -3.6182, -4.6747, -2.0141, -0.4503), tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, c(11.0618, 12.0128, 7.5604, 8.2669, 9.0810, 9.2566), tolerance=.tol[["ci"]]) ### fit equal-effects model res <- rma(yi, vi, data=dat, method="EE", digits=2) ### compare with results on page 349 (Table VII) expect_equivalent(coef(res), 2.9444, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, 0.3831, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 5.5058, tolerance=.tol[["ci"]]) ### fit random-effects model (REML estimator) res <- rma(yi, vi, data=dat, digits=2) ### compare with results on page 349 (Table VII) expect_equivalent(coef(res), 2.9444, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, 0.3831, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 5.5058, tolerance=.tol[["ci"]]) expect_equivalent(res$tau2, 0.0000, tolerance=.tol[["var"]]) ### fit random-effects model (DL estimator) res <- rma(yi, vi, data=dat, method="DL", digits=2) ### compare with results on page 349 (Table VII) expect_equivalent(coef(res), 2.9444, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, 0.3831, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 5.5058, tolerance=.tol[["ci"]]) expect_equivalent(res$tau2, 0.0000, tolerance=.tol[["var"]]) }) test_that("results are correct for the second example (using dat.normand1999).", { ### compute pooled SD dat.normand1999$sdpi <- with(dat.normand1999, sqrt(((n1i-1)*sd1i^2 + (n2i-1)*sd2i^2)/(n1i+n2i-2))) ### calculate mean differences and corresponding sampling variances dat <- escalc(m1i=m1i, sd1i=sdpi, n1i=n1i, m2i=m2i, sd2i=sdpi, n2i=n2i, measure="MD", data=dat.normand1999, digits=2) ### compare with results on page 351 (Table VIII) expect_equivalent(dat$yi, c(-20, -2, -55, -71, -4, 1, 11, -10, 7)) expect_equivalent(dat$vi, c(40.5863, 2.0468, 15.2809, 150.2222, 20.1923, 1.2235, 95.3756, 8.0321, 20.6936), tolerance=.tol[["var"]]) ### CIs for individual studies tmp <- summary(dat) ### (results for this not given in paper) expect_equivalent(tmp$ci.lb, c(-32.4864, -4.8041, -62.6616, -95.0223, -12.8073, -1.168, -8.1411, -15.5547, -1.9159), tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, c(-7.5136, 0.8041, -47.3384, -46.9777, 4.8073, 3.168, 30.1411, -4.4453, 15.9159), tolerance=.tol[["ci"]]) ### fit equal-effects model res <- rma(yi, vi, data=dat, method="EE", digits=2) ### compare with results on page 352 (Table IX) expect_equivalent(coef(res), -3.4939, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -5.0265, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, -1.9613, tolerance=.tol[["ci"]]) ### fit random-effects model (DL estimator) res <- rma(yi, vi, data=dat, method="DL", digits=2) ### compare with results on page 352 (Table IX) expect_equivalent(coef(res), -14.0972, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -24.4454, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, -3.7490, tolerance=.tol[["ci"]]) expect_equivalent(res$tau2, 218.7216, tolerance=.tol[["var"]]) ### fit random-effects model (REML estimator) res <- rma(yi, vi, data=dat, digits=2) ### compare with results on page 352 (Table IX) expect_equivalent(coef(res), -15.1217, tolerance=.tol[["est"]]) expect_equivalent(res$ci.lb, -32.6716, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, 2.4282, tolerance=.tol[["ci"]]) expect_equivalent(res$tau2, 685.1965, tolerance=.tol[["var"]]) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_miller1978.r0000644000176200001440000000671414503345143023400 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:miller1978 context("Checking analysis example: miller1978") source("settings.r") ### create dataset dat <- data.frame(xi=c(3, 6, 10, 1), ni=c(11, 17, 21, 6)) dat$pi <- with(dat, xi/ni) dat <- escalc(measure="PFT", xi=xi, ni=ni, data=dat) test_that("calculations of escalc() for measure='PFT' are correct.", { ### compare with results on page 138 expect_equivalent(dat$yi*2, c(1.1391, 1.2888, 1.5253, 0.9515), tolerance=.tol[["est"]]) ### need *2 factor due to difference in definition of measure expect_equivalent(dat$vi*4, c(0.0870, 0.0571, 0.0465, 0.1538), tolerance=.tol[["var"]]) }) test_that("results are correct for the equal-effects model using unweighted estimation.", { res <- rma(yi, vi, method="EE", data=dat, weighted=FALSE) pred <- predict(res, transf=function(x) x*2) expect_equivalent(pred$pred, 1.2262, tolerance=.tol[["pred"]]) pred <- predict(res, transf=transf.ipft.hm, targs=list(ni=dat$ni)) expect_equivalent(pred$pred, 0.3164, tolerance=.tol[["pred"]]) }) test_that("results are correct for the equal-effects model using weighted estimation.", { res <- rma(yi, vi, method="EE", data=dat) pred <- predict(res, transf=function(x) x*2) expect_equivalent(pred$pred, 1.3093, tolerance=.tol[["pred"]]) pred <- predict(res, transf=transf.ipft.hm, targs=list(ni=dat$ni)) expect_equivalent(pred$pred, 0.3595, tolerance=.tol[["pred"]]) }) test_that("results are correct when there are proportions of 0 and 1.", { ### create dataset dat <- data.frame(xi=c(0,10), ni=c(10,10)) dat$pi <- with(dat, xi/ni) dat <- escalc(measure="PFT", xi=xi, ni=ni, data=dat, add=0) ### back-transformation of the individual outcomes expect_equivalent(transf.ipft(dat$yi, dat$ni), c(0,1)) }) test_that("back-transformations work as intended for individual studies and the model estimate.", { ### create dataset dat <- data.frame(xi = c( 0, 4, 9, 16, 20), ni = c(10, 10, 15, 20, 20)) dat$pi <- with(dat, xi/ni) dat <- escalc(measure="PFT", xi=xi, ni=ni, data=dat, add=0) ### back-transformation of the individual outcomes expect_equivalent(transf.ipft(dat$yi, dat$ni), c(0.0, 0.4, 0.6, 0.8, 1.0)) ### back-transformation of the estimated average res <- rma(yi, vi, method="EE", data=dat) pred <- predict(res, transf=transf.ipft.hm, targs=list(ni=dat$ni)) expect_equivalent(pred$pred, 0.6886, tolerance=.tol[["pred"]]) expect_equivalent(pred$ci.lb, 0.5734, tolerance=.tol[["ci"]]) expect_equivalent(pred$ci.ub, 0.7943, tolerance=.tol[["ci"]]) ### calculate back-transformed CI bounds dat.back <- summary(dat, transf=transf.ipft, ni=dat$ni) skip_on_cran() ### create forest plot with CI bounds supplied and then add model estimate png("images/test_analysis_example_miller1978_test.png", res=200, width=1800, height=800, type="cairo") par(mar=c(5,8,1,8)) forest(dat.back$yi, ci.lb=dat.back$ci.lb, ci.ub=dat.back$ci.ub, psize=1, xlim=c(-.5,1.8), alim=c(0,1), ylim=c(-1,8), refline=NA, digits=3, xlab="Proportion", header=c("Study", "Proportion [95% CI]")) addpoly(pred$pred, ci.lb=pred$ci.lb, ci.ub=pred$ci.ub, rows=-0.5, mlab="EE Model", efac=1.3) abline(h=0.5) dev.off() expect_true(.vistest("images/test_analysis_example_miller1978_test.png", "images/test_analysis_example_miller1978.png")) }) rm(list=ls()) metafor/tests/testthat/test_misc_aggregate.r0000644000176200001440000001215314232434613021100 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: aggregate() function") source("settings.r") test_that("aggregate() works correctly for 'dat.konstantopoulos2011'.", { dat <- dat.konstantopoulos2011 agg <- aggregate(dat, cluster=district, struct="ID", addk=TRUE) expect_equivalent(c(agg$yi), c(-0.125687, 0.06654, 0.350303, 0.499691, 0.051008, -0.041842, 0.885529, -0.02875, 0.250475, 0.015033, 0.161917), tolerance=.tol[["est"]]) expect_equivalent(c(agg$vi), c(0.032427, 0.003981, 0.006664, 0.001443, 0.001549, 0.000962, 0.003882, 0.000125, 0.001799, 0.006078, 0.018678), tolerance=.tol[["var"]]) agg <- aggregate(dat, cluster=district, struct="ID", weighted=FALSE, subset=district!=12) expect_equivalent(c(agg$yi), c(-0.1175, 0.373333, 0.4425, 0.0625, -0.077273, 0.823333, -0.02875, 0.246667, 0.016, 0.18), tolerance=.tol[["est"]]) expect_equivalent(c(agg$vi), c(0.03275, 0.008667, 0.002187, 0.002187, 0.001273, 0.004, 0.000125, 0.001833, 0.00608, 0.018938), tolerance=.tol[["var"]]) }) test_that("aggregate() works correctly for 'dat.assink2016'.", { dat <- dat.assink2016 dat <- escalc(yi=yi, vi=vi, data=dat) agg <- aggregate(dat, cluster=study, rho=0.6) expect_equivalent(c(agg$yi), c(0.162877, 0.406036, 1.079003, -0.0447, 1.549, -0.054978, 1.007244, 0.3695, 0.137862, 0.116737, 0.525765, 0.280461, 0.301829, 0.035593, 0.090821, 0.018099, -0.055203), tolerance=.tol[["est"]]) expect_equivalent(c(agg$vi), c(0.019697, 0.005572, 0.083174, 0.0331, 0.1384, 0.02139, 0.054485, 0.0199, 0.027057, 0.010729, 0.011432, 0.002814, 0.011, 0.001435, 0.126887, 0.016863, 0.007215), tolerance=.tol[["var"]]) V <- vcalc(vi, cluster=study, obs=esid, data=dat, rho=0.6) agg <- aggregate(dat, cluster=study, V=V) expect_equivalent(c(agg$yi), c(0.162877, 0.406036, 1.079003, -0.0447, 1.549, -0.054978, 1.007244, 0.3695, 0.137862, 0.116737, 0.525765, 0.280461, 0.301829, 0.035593, 0.090821, 0.018099, -0.055203), tolerance=.tol[["est"]]) expect_equivalent(c(agg$vi), c(0.019697, 0.005572, 0.083174, 0.0331, 0.1384, 0.02139, 0.054485, 0.0199, 0.027057, 0.010729, 0.011432, 0.002814, 0.011, 0.001435, 0.126887, 0.016863, 0.007215), tolerance=.tol[["var"]]) V <- vcalc(vi, cluster=study, obs=esid, data=dat, rho=0.6) res <- rma.mv(yi, V, random = ~ 1 | study/esid, data=dat) agg <- aggregate(dat, cluster=study, V=vcov(res, type="obs")) expect_equivalent(c(agg$yi), c(0.286465, 0.445671, 1.25335, -0.0447, 1.549, 0.08437, 0.845211, 0.3695, 0.139644, 0.176455, 1.053596, 0.281093, 0.302574, 0.051816, 0.10101, 0.077539, 0.068278), tolerance=.tol[["est"]]) expect_equivalent(c(agg$vi), c(0.137059, 0.138413, 0.214471, 0.268376, 0.373676, 0.152661, 0.169315, 0.255176, 0.18508, 0.130173, 0.117845, 0.114457, 0.169005, 0.114346, 0.264118, 0.123989, 0.117208), tolerance=.tol[["var"]]) }) test_that("aggregate() works correctly for 'dat.ishak2007'.", { dat <- dat.ishak2007 dat <- reshape(dat.ishak2007, direction="long", idvar="study", v.names=c("yi","vi"), varying=list(c(2,4,6,8), c(3,5,7,9))) dat <- dat[order(study, time),] dat <- dat[!is.na(yi),] rownames(dat) <- NULL agg <- aggregate(dat, cluster=study, struct="CAR", time=time, phi=0.9) expect_equivalent(c(agg$yi), c(-33.4, -28.137183, -21.1, -17.22908, -32.9, -26.342019, -31.37934, -25, -36, -21.275427, -8.6, -28.830656, -28.00566, -35.277625, -28.02381, -24.818713, -36.3, -29.4, -33.552998, -20.6, -33.9, -35.4, -34.9, -32.7, -26.471326, -32.753685, -18.412199, -29.2, -31.7, -32.46738, -31.7, -35.274832, -30.189494, -17.6, -22.9, -36, -22.5, -20.67624, -9.3, -25.52315, -16.7, -29.440786, -31.221009, -20.73355, -37.982183, -22.1), tolerance=.tol[["est"]]) expect_equivalent(c(agg$vi), c(14.3, 5.611511, 7.3, 4.562371, 125, 4.132918, 86.117899, 17, 5, 6.308605, 41, 20.229622, 7.743863, 5.632795, 3.438095, 12.975915, 27.3, 10.7, 1.895013, 25.3, 20.1, 21.2, 18, 16.3, 29.751824, 9.417499, 5.156788, 5.8, 12.4, 24.954806, 19.1, 17.528303, 8.508767, 28.4, 20, 27.7, 20.3, 1.379225, 85.2, 15.281948, 9.8, 179.802277, 3.317364, 15.082821, 20.888464, 40.8), tolerance=.tol[["var"]]) V <- vcalc(vi, cluster=study, time1=time, data=dat, phi=0.9) agg <- aggregate(dat, cluster=study, V=V) expect_equivalent(c(agg$yi), c(-33.4, -28.137183, -21.1, -17.22908, -32.9, -26.342019, -31.37934, -25, -36, -21.275427, -8.6, -28.830656, -28.00566, -35.277625, -28.02381, -24.818713, -36.3, -29.4, -33.552998, -20.6, -33.9, -35.4, -34.9, -32.7, -26.471326, -32.753685, -18.412199, -29.2, -31.7, -32.46738, -31.7, -35.274832, -30.189494, -17.6, -22.9, -36, -22.5, -20.67624, -9.3, -25.52315, -16.7, -29.440786, -31.221009, -20.73355, -37.982183, -22.1), tolerance=.tol[["est"]]) expect_equivalent(c(agg$vi), c(14.3, 5.611511, 7.3, 4.562371, 125, 4.132918, 86.117899, 17, 5, 6.308605, 41, 20.229622, 7.743863, 5.632795, 3.438095, 12.975915, 27.3, 10.7, 1.895013, 25.3, 20.1, 21.2, 18, 16.3, 29.751824, 9.417499, 5.156788, 5.8, 12.4, 24.954806, 19.1, 17.528303, 8.508767, 28.4, 20, 27.7, 20.3, 1.379225, 85.2, 15.281948, 9.8, 179.802277, 3.317364, 15.082821, 20.888464, 40.8), tolerance=.tol[["var"]]) }) rm(list=ls()) metafor/tests/testthat/test_plots_cumulative_forest_plot.r0000644000176200001440000000603714503346065024166 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/plots:cumulative_forest_plot source("settings.r") context("Checking plots example: cumulative forest plot") test_that("plot can be drawn for 'rma.uni' object.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_cumulative_forest_plot_1_test.png", res=240, width=1800, height=1400, type="cairo") ### decrease margins so the full space is used par(mar=c(4,4,1,2)) ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit random-effects models res <- rma(yi, vi, data=dat, slab=paste(author, year, sep=", ")) ### cumulative meta-analysis (in the order of publication year) tmp <- cumul(res, order=year) ### cumulative forest plot forest(tmp, xlim=c(-4,2), at=log(c(0.125, 0.25, 0.5, 1, 2)), atransf=exp, digits=c(2L,3L), cex=0.85, header="Author(s) and Year") dev.off() expect_true(.vistest("images/test_plots_cumulative_forest_plot_1_test.png", "images/test_plots_cumulative_forest_plot_1.png")) }) test_that("plot can be drawn for 'rma.mh' object.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_cumulative_forest_plot_2_test.png", res=240, width=1800, height=1400, type="cairo") ### decrease margins so the full space is used par(mar=c(4,4,1,2)) ### fit equal-effects models using the Mantel-Haenszel method res <- rma.mh(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, slab=paste(author, year, sep=", ")) ### cumulative meta-analysis (in the order of publication year) tmp <- cumul(res, order=dat.bcg$year) ### cumulative forest plot forest(tmp, xlim=c(-4,2), at=log(c(0.125, 0.25, 0.5, 1, 2)), atransf=exp, digits=c(2L,3L), cex=0.85, header="Author(s) and Year") dev.off() expect_true(.vistest("images/test_plots_cumulative_forest_plot_2_test.png", "images/test_plots_cumulative_forest_plot_2.png")) }) test_that("plot can be drawn for 'rma.peto' object.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_cumulative_forest_plot_3_test.png", res=240, width=1800, height=1400, type="cairo") ### decrease margins so the full space is used par(mar=c(4,4,1,2)) ### fit equal-effects models using Peto's method res <- rma.peto(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, slab=paste(author, year, sep=", ")) ### cumulative meta-analysis (in the order of publication year) tmp <- cumul(res, order=dat.bcg$year) ### cumulative forest plot forest(tmp, xlim=c(-4,2), at=log(c(0.125, 0.25, 0.5, 1, 2)), atransf=exp, digits=c(2L,3L), cex=0.85, header="Author(s) and Year") dev.off() expect_true(.vistest("images/test_plots_cumulative_forest_plot_3_test.png", "images/test_plots_cumulative_forest_plot_3.png")) }) rm(list=ls()) metafor/tests/testthat/test_misc_rma_uni.r0000644000176200001440000000631214435633663020617 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: rma() function") source("settings.r") dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) test_that("rma() correctly handles a formula for the 'yi' argument", { res1 <- rma(yi ~ ablat, vi, data=dat) res2 <- rma(yi, vi, mods = ~ ablat, data=dat) expect_equivalent(coef(res1), coef(res2)) }) test_that("rma() correctly handles an 'escalc' object", { res1 <- rma(yi, vi, data=dat) res2 <- rma(dat) expect_equivalent(coef(res1), coef(res2)) }) test_that("rma() works with method='DLIT' and method='SJIT'", { res <- rma(yi, vi, data=dat, method="DLIT", control=list(maxiter=500)) expect_equivalent(res$tau2, 0.1576, tolerance=.tol[["var"]]) res <- rma(yi, vi, data=dat, method="SJIT") expect_equivalent(res$tau2, 0.3181, tolerance=.tol[["var"]]) }) test_that("rma() works directly with input for measure='SMD'", { dat <- dat.normand1999 dat <- escalc(measure="SMD", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat, subset=1:4) res1 <- rma(yi, vi, data=dat) res2 <- rma(measure="SMD", m1i=m1i, sd1i=sd1i, n1i=n1i, m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat, subset=1:4) expect_equivalent(res1$tau2, 1.0090, tolerance=.tol[["var"]]) expect_equivalent(res2$tau2, 1.0090, tolerance=.tol[["var"]]) }) test_that("rma() works directly with input for measure='PCOR'", { dat <- dat.aloe2013 dat <- escalc(measure="PCOR", ti=tval, ni=n, mi=preds, data=dat) res1 <- rma(yi, vi, data=dat) res2 <- rma(measure="PCOR", ti=tval, ni=n, mi=preds, data=dat) expect_equivalent(res1$tau2, 0.0298, tolerance=.tol[["var"]]) expect_equivalent(res2$tau2, 0.0298, tolerance=.tol[["var"]]) }) test_that("rma() works directly with input for measure='MN'", { dat <- dat.normand1999 dat <- escalc(measure="MN", mi=m1i, sdi=sd1i, ni=n1i, data=dat) res1 <- rma(yi, vi, data=dat) res2 <- rma(measure="MN", mi=m1i, sdi=sd1i, ni=n1i, data=dat) expect_equivalent(res1$tau2, 408.9277, tolerance=.tol[["var"]]) expect_equivalent(res2$tau2, 408.9277, tolerance=.tol[["var"]]) }) test_that("rma() works directly with input for measure='SMCR'", { datT <- data.frame( m_pre = c(30.6, 23.5, 0.5, 53.4, 35.6), m_post = c(38.5, 26.8, 0.7, 75.9, 36.0), sd_pre = c(15.0, 3.1, 0.1, 14.5, 4.7), sd_post = c(11.6, 4.1, 0.1, 4.4, 4.6), ni = c(20, 50, 9, 10, 14), ri = c(.47, .64, .77, .89, .44)) dat <- escalc(measure="SMCR", m1i=m_post, m2i=m_pre, sd1i=sd_pre, ni=ni, ri=ri, data=datT) res1 <- rma(yi, vi, data=dat) res2 <- rma(measure="SMCR", m1i=m_post, m2i=m_pre, sd1i=sd_pre, ni=ni, ri=ri, data=datT) expect_equivalent(res1$tau2, 0.3164, tolerance=.tol[["var"]]) expect_equivalent(res2$tau2, 0.3164, tolerance=.tol[["var"]]) }) test_that("rma() works directly with input for measure='AHW'", { dat <- dat.bonett2010 dat <- escalc(measure="AHW", ai=ai, mi=mi, ni=ni, data=dat) res1 <- rma(yi, vi, data=dat) res2 <- rma(measure="AHW", ai=ai, mi=mi, ni=ni, data=dat) expect_equivalent(res1$tau2, 0.0011, tolerance=.tol[["var"]]) expect_equivalent(res2$tau2, 0.0011, tolerance=.tol[["var"]]) }) rm(list=ls()) metafor/tests/testthat/test_misc_rma_handling_nas.r0000644000176200001440000001055014247662035022444 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: proper handling of missing values") source("settings.r") test_that("rma.glmm() handles NAs correctly.", { skip_on_cran() dat <- data.frame(ni = rep(20, 10), xi = c(NA, 4, 0, 0, 2, 2, 3, 8, 9, 2), mod1 = c(0, NA, 0, 0, 0, 0, 0, 1, 1, 1), mod2 = c(0, 0, 0, 1, 0, 0, 0, 0, 0, 0)) ### 1) NA in table data for study 1 ### 2) NA for mod1 in study 2 ### 3) if add=0, then yi/vi pair will be NA/NA for study 3 ### 4) if add=0, then yi/vi pair will be NA/NA for study 4, which causes the X.yi matrix to be rank deficient after row 4 is removed ### note: even for the model fitting itself, study 4 is a problem, because the log(odds) for study 4 is -Inf, so the coefficient for ### mod2 is in essence also -Inf; on x86_64-w64-mingw32/x64 (64-bit) with lme4 version 1.1-7, this just barely converges, but ### may fail in other cases; so checks with both moderators included are skipped on CRAN expect_warning(res <- rma.glmm(measure="PLO", xi=xi, ni=ni, mods = ~ mod1, data=dat)) ### k, length of xi/mi, and number of rows in X must be equal to 8 (studies 1 and 2 removed due to NAs in table data) expect_equivalent(res$k, 8) expect_equivalent(length(res$outdat$xi), 8) expect_equivalent(length(res$outdat$mi), 8) expect_equivalent(nrow(res$X), 8) ### k.yi and length of yi/vi must be equal to 8 (studies 1 and 2 removed due to NAs in table data) expect_equivalent(res$k.yi, 8) expect_equivalent(length(res$yi), 8) expect_equivalent(length(res$vi), 8) ### full data saved in .f elements expect_equivalent(res$k.f, 10) expect_equivalent(length(res$outdat.f$xi), 10) expect_equivalent(length(res$outdat.f$mi), 10) expect_equivalent(nrow(res$X.f), 10) expect_equivalent(length(res$yi.f), 10) expect_equivalent(length(res$vi.f), 10) ### now use add=0, so that studies 3 and 4 have NA/NA for yi/vi expect_warning(res <- rma.glmm(measure="PLO", xi=xi, ni=ni, mods = ~ mod1, data=dat, add=0)) ### k, length of xi/mi, and number of rows in X must be equal to 8 (studies 1 and 2 removed due to NAs in table data, but studies 3 and 4 included in the model fitting) expect_equivalent(res$k, 8) expect_equivalent(length(res$outdat$xi), 8) expect_equivalent(length(res$outdat$mi), 8) expect_equivalent(nrow(res$X), 8) ### k.yi and length of yi/vi must be equal to 6 (studies 1 and 2 removed due to NAs in table data and studies 3 and 4 have NA/NA for yi/vi) expect_equivalent(res$k.yi, 6) expect_equivalent(length(res$yi), 6) expect_equivalent(length(res$vi), 6) ### full data saved in .f elements expect_equivalent(res$k.f, 10) expect_equivalent(length(res$outdat.f$xi), 10) expect_equivalent(length(res$outdat.f$mi), 10) expect_equivalent(nrow(res$X.f), 10) expect_equivalent(length(res$yi.f), 10) expect_equivalent(length(res$vi.f), 10) ### include both mod1 and mod2 in the model and use add=0, so that studies 3 and 4 have NA/NA for yi/vi ### as a result, the model matrix for X.yi is rank deficient, so that in essence mod2 needs to be removed for the I^2/H^2 computation ### also note that the coefficient for mod2 is technically -Inf (since xi=0 for the only study where mod2=1); glmer() therefore issues ### several warnings expect_warning(res <- rma.glmm(measure="PLO", xi=xi, ni=ni, mods = ~ mod1 + mod2, data=dat, add=0)) ### k, length of xi/mi, and number of rows in X must be equal to 8 (studies 1 and 2 removed due to NAs in table data, but studies 3 and 4 included in the model fitting) expect_equivalent(res$k, 8) expect_equivalent(length(res$outdat$xi), 8) expect_equivalent(length(res$outdat$mi), 8) expect_equivalent(nrow(res$X), 8) ### k.yi and length of yi/vi must be equal to 6 (studies 1 and 2 removed due to NAs in table data and studies 3 and 4 have NA/NA for yi/vi) expect_equivalent(res$k.yi, 6) expect_equivalent(length(res$yi), 6) expect_equivalent(length(res$vi), 6) ### full data saved in .f elements expect_equivalent(res$k.f, 10) expect_equivalent(length(res$outdat.f$xi), 10) expect_equivalent(length(res$outdat.f$mi), 10) expect_equivalent(nrow(res$X.f), 10) expect_equivalent(length(res$yi.f), 10) expect_equivalent(length(res$vi.f), 10) }) rm(list=ls()) metafor/tests/testthat/test_misc_rma_uni_ls.r0000644000176200001440000000751014502344716021307 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: rma() function with location-scale models") source("settings.r") test_that("location-scale model results are correct for in intercept-only model", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res1 <- rma(yi, vi, data=dat, test="t") res2 <- rma(yi, vi, scale = ~ 1, data=dat, test="t", control=list(optimizer="optim")) res3 <- suppressWarnings(rma(yi, vi, scale = ~ 1, link="identity", data=dat, test="t", control=list(optimizer="Nelder-Mead"))) expect_equivalent(res1$tau2, as.vector(exp(coef(res2)$alpha)), tolerance=.tol[["var"]]) expect_equivalent(res1$tau2, as.vector(coef(res3)$alpha), tolerance=.tol[["var"]]) }) test_that("location-scale model results are correct for a categorical predictor", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res1 <- rma(yi ~ alloc, vi, scale = ~ alloc - 1, data=dat) res2 <- rma(yi ~ alloc, vi, scale = ~ alloc - 1, link = "identity", data=dat, control=list(optimizer="solnp")) res3 <- rma.mv(yi ~ alloc, vi, random = ~ alloc | trial, struct="DIAG", data=dat, sparse=.sparse) expect_equivalent(as.vector(exp(coef(res1)$alpha)), as.vector(coef(res2)$alpha), tolerance=.tol[["var"]]) expect_equivalent(as.vector(exp(coef(res1)$alpha)), res3$tau2, tolerance=.tol[["var"]]) }) test_that("location-scale model results are correct for a continuous predictor", { dat <- escalc(measure="RR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat.laopaiboon2015) dat$ni <- dat$n1i + dat$n2i dat$ni[dat$study == "Whitlock"] <- dat$ni[dat$study == "Whitlock"] + 2 res <- suppressWarnings(rma(yi, vi, scale = ~ I(1/ni) - 1, link="identity", data=dat, method="ML")) expect_equivalent(as.vector(coef(res)$alpha), 79.07531, tolerance=.tol[["var"]]) expect_equivalent(exp(c(res$beta, res$ci.lb, res$ci.ub)), c(0.8539, 0.5482, 1.3302), tolerance=.tol[["coef"]]) res <- rma(yi, vi, scale = ~ I(1/ni), link="identity", data=dat, method="ML") expect_equivalent(as.vector(coef(res)$alpha), c(0.274623, 31.523043), tolerance=.tol[["var"]]) expect_equivalent(exp(c(res$beta, res$ci.lb, res$ci.ub)), c(1.0161589, 0.6214663, 1.6615205), tolerance=.tol[["coef"]]) res <- rma(yi, vi, scale = ~ I(1/ni) - 1, data=dat) expect_equivalent(as.vector(coef(res)$alpha), -34.5187, tolerance=.tol[["var"]]) expect_equivalent(exp(c(res$beta, res$ci.lb, res$ci.ub)), c(1.1251, 0.6381, 1.9839), tolerance=.tol[["coef"]]) res <- rma(yi, vi, scale = ~ I(1/ni), data=dat) expect_equivalent(as.vector(coef(res)$alpha), c(-0.8868, 42.4065), tolerance=.tol[["var"]]) expect_equivalent(exp(c(res$beta, res$ci.lb, res$ci.ub)), c(1.0474, 0.6242, 1.7577), tolerance=.tol[["coef"]]) sav <- coef(summary(res)) expected <- list(beta = structure(list(estimate = 0.0463401794422422, se = 0.264116077624852, zval = 0.175453837793485, pval = 0.86072304016451, ci.lb = -0.471317820440453, ci.ub = 0.563998179324937), class = "data.frame", row.names = "intrcpt"), alpha = structure(list(estimate = c(-0.886827277584096, 42.4065282951426 ), se = c(1.23920300372018, 118.69324661881), zval = c(-0.715643260161388, 0.357278358315816), pval = c(0.474211654391012, 0.720883429839682 ), ci.lb = c(-3.31562053440951, -190.227960285855), ci.ub = c(1.54196597924132, 275.04101687614)), class = "data.frame", row.names = c("intrcpt", "I(1/ni)"))) expect_equivalent(sav, expected, tolerance=.tol[["misc"]]) sav <- model.matrix(res)$scale expect_equivalent(sav, cbind(1, 1/dat$ni)) sav <- fitted(res)$scale expect_equivalent(sav, c(-0.4790722, -0.58818975, -0.8305852, -0.71086658, -0.49417424, -0.25389402, -0.66126064, -0.45847851, -0.54205875, -0.03869671, -0.03869671, -0.12956784, -0.40493491, -0.76426506, -0.35674567), tolerance=.tol[["var"]]) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_gleser2009.r0000644000176200001440000002204714502303721023347 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:gleser2009 source("settings.r") context("Checking analysis example: gleser2009") ############################################################################ ### create dataset dat <- data.frame(study=c(1,1,2,3,3,3), trt=c(1,2,1,1,2,3), ai=c( 40, 40, 10,150,150,150), n1i=c(1000,1000,200,2000,2000,2000), ci=c(100,150, 15, 40, 80, 50), n2i=c(4000,4000,400,1000,1000,1000)) dat$pti <- with(dat, ci / n2i) dat$pci <- with(dat, ai / n1i) test_that("results are correct for the multiple-treatment studies example with risk differences.", { dat <- escalc(measure="RD", ai=ai, ci=ci, n1i=n1i, n2i=n2i, data=dat) ### compare with results on page 360 (Table 19.2) expect_equivalent(dat$yi, c(0.0150, 0.0025, 0.0125, 0.0350, -0.0050, 0.0250), tolerance=.tol[["est"]]) calc.v <- function(x) { v <- matrix(x$pci[1]*(1-x$pci[1])/x$n1i[1], nrow=nrow(x), ncol=nrow(x)) diag(v) <- x$vi v } V <- bldiag(lapply(split(dat, dat$study), calc.v)) res <- rma.mv(yi, V, mods = ~ factor(trt) - 1, data=dat, sparse=.sparse) ### compare with results on page 361 (eq. 19.6) expect_equivalent(coef(res), c(0.0200, 0.0043, 0.0211), tolerance=.tol[["coef"]]) ### compare with results on page 361 (eq. 19.7) tmp <- vcov(res) * 10^6 expected <- structure(c(24.612, 19.954, 13.323, 19.954, 28.538, 13.255, 13.323, 13.255, 69.806), .Dim = c(3L, 3L), .Dimnames = list(c("factor(trt)1", "factor(trt)2", "factor(trt)3"), c("factor(trt)1", "factor(trt)2", "factor(trt)3"))) expect_equivalent(tmp, expected, tolerance=.tol[["var"]]) ### compare with results on page 362 (eq. 19.8) expect_equivalent(res$QE, 7.1907, tolerance=.tol[["test"]]) }) test_that("results are correct for the multiple-treatment studies example with log odds ratios.", { dat <- escalc(measure="OR", ai=ai, ci=ci, n1i=n1i, n2i=n2i, data=dat) ### compare with results on page 362 expect_equivalent(dat$yi, c(0.4855, 0.0671, 0.3008, 0.6657, -0.0700, 0.4321), tolerance=.tol[["est"]]) calc.v <- function(x) { v <- matrix(1/(x$n1i[1]*x$pci[1]*(1-x$pci[1])), nrow=nrow(x), ncol=nrow(x)) diag(v) <- x$vi v } V <- bldiag(lapply(split(dat, dat$study), calc.v)) res <- rma.mv(yi, V, mods = ~ factor(trt) - 1, data=dat, sparse=.sparse) ### compare with results on page 363 expect_equivalent(coef(res), c(0.5099, 0.0044, 0.4301), tolerance=.tol[["coef"]]) ### compare with results on page 363 tmp <- vcov(res) expected <- structure(c(0.01412, 0.00712, 0.00425, 0.00712, 0.01178, 0.00455, 0.00425, 0.00455, 0.02703), .Dim = c(3L, 3L), .Dimnames = list(c("factor(trt)1", "factor(trt)2", "factor(trt)3"), c("factor(trt)1", "factor(trt)2", "factor(trt)3"))) expect_equivalent(tmp, expected, tolerance=.tol[["var"]]) ### compare with results on page 363 expect_equivalent(res$QE, 2.0563, tolerance=.tol[["test"]]) ### 2.057 in chapter }) test_that("results are correct for the multiple-treatment studies example with log risk ratios.", { dat <- escalc(measure="RR", ai=ai, ci=ci, n1i=n1i, n2i=n2i, data=dat) ### compare with results on page 364 expect_equivalent(dat$yi, c(0.4700, 0.0645, 0.2877, 0.6286, -0.0645, 0.4055), tolerance=.tol[["est"]]) calc.v <- function(x) { v <- matrix((1-x$pci[1])/(x$n1i[1]*x$pci[1]), nrow=nrow(x), ncol=nrow(x)) diag(v) <- x$vi v } V <- bldiag(lapply(split(dat, dat$study), calc.v)) res <- rma.mv(yi, V, mods = ~ factor(trt) - 1, data=dat, sparse=.sparse) ### compare with results on page 363 expect_equivalent(coef(res), c(0.4875, 0.0006, 0.4047), tolerance=.tol[["coef"]]) ### (results for this not given in chapter) tmp <- vcov(res) expected <- structure(c(0.01287, 0.00623, 0.00371, 0.00623, 0.01037, 0.00399, 0.00371, 0.00399, 0.02416), .Dim = c(3L, 3L), .Dimnames = list(c("factor(trt)1", "factor(trt)2", "factor(trt)3"), c("factor(trt)1", "factor(trt)2", "factor(trt)3"))) expect_equivalent(tmp, expected, tolerance=.tol[["var"]]) ### (results for this not given in chapter) expect_equivalent(res$QE, 1.8954, tolerance=.tol[["test"]]) }) test_that("results are correct for the multiple-treatment studies example with difference of arcsine transformed risks.", { dat <- escalc(measure="AS", ai=ai, ci=ci, n1i=n1i, n2i=n2i, data=dat) ### compare with results on page 364 expect_equivalent(dat$yi*2, c(0.0852, 0.0130, 0.0613, 0.1521, -0.0187, 0.1038), tolerance=.tol[["est"]]) ### need *2 factor due to difference in definition of measure calc.v <- function(x) { v <- matrix(1/(4*x$n1i[1]), nrow=nrow(x), ncol=nrow(x)) diag(v) <- x$vi v } V <- bldiag(lapply(split(dat, dat$study), calc.v)) res <- rma.mv(yi, V, mods = ~ factor(trt) - 1, data=dat, sparse=.sparse) ### compare with results on page 365 expect_equivalent(coef(res)*2, c(0.1010, 0.0102, 0.0982), tolerance=.tol[["coef"]]) ### compare with results on page 365 tmp <- vcov(res)*2^2 expected <- structure(c(0.00058, 4e-04, 0.00024, 4e-04, 0.00061, 0.00025, 0.00024, 0.00025, 0.00137), .Dim = c(3L, 3L), .Dimnames = list(c("factor(trt)1", "factor(trt)2", "factor(trt)3"), c("factor(trt)1", "factor(trt)2", "factor(trt)3"))) expect_equivalent(tmp, expected, tolerance=.tol[["var"]]) ### compare with results on page 365 expect_equivalent(res$QE, 4.2634, tolerance=.tol[["test"]]) ### 4.264 in chapter }) ############################################################################ ### create dataset dat <- data.frame(study=c(1,1,2,3,4,4), trt=c(1,2,1,1,1,2), m1i=c(7.87, 4.35, 9.32, 8.08, 7.44, 5.34), m2i=c(-1.36, -1.36, 0.98, 1.17, 0.45, 0.45), sdpi=c(4.2593,4.2593,2.8831,3.1764,2.9344,2.9344), n1i=c(25,22,38,50,30,30), n2i=c(25,25,40,50,30,30)) test_that("results are correct for the multiple-treatment studies example with standardized mean differences.", { dat$Ni <- unlist(lapply(split(dat, dat$study), function(x) rep(sum(x$n1i) + x$n2i[1], each=nrow(x)))) dat$yi <- with(dat, (m1i-m2i)/sdpi) dat$vi <- with(dat, 1/n1i + 1/n2i + yi^2/(2*Ni)) ### compare with results on page 364 expect_equivalent(dat$yi, c(2.1670, 1.3406, 2.8927, 2.1754, 2.3821, 1.6664), tolerance=.tol[["est"]]) calc.v <- function(x) { v <- matrix(1/x$n2i[1] + outer(x$yi, x$yi, "*")/(2*x$Ni[1]), nrow=nrow(x), ncol=nrow(x)) diag(v) <- x$vi v } V <- bldiag(lapply(split(dat, dat$study), calc.v)) res <- rma.mv(yi, V, mods = ~ factor(trt) - 1, data=dat, sparse=.sparse) ### compare with results on page 367 expect_equivalent(coef(res), c(2.3743, 1.5702), tolerance=.tol[["coef"]]) ### compare with results on page 367 tmp <- vcov(res) expected <- structure(c(0.02257, 0.01244, 0.01244, 0.03554), .Dim = c(2L, 2L), .Dimnames = list(c("factor(trt)1", "factor(trt)2"), c("factor(trt)1", "factor(trt)2"))) expect_equivalent(tmp, expected, tolerance=.tol[["var"]]) ### compare with results on page 367 expect_equivalent(res$QE, 3.9447, tolerance=.tol[["test"]]) }) ############################################################################ ### create dataset dat <- data.frame(school=c(1,1,2,2,3,3,4,4,5,5,6,6,7,7), outcome=rep(c("math", "reading"), times=7), m1i=c(2.3,2.5,2.4,1.3,2.5,2.4,3.3,1.7,1.1,2.0,2.8,2.1,1.7,0.6), m2i=c(10.3,6.6,9.7,3.1,8.7,3.7,7.5,8.5,2.2,2.1,3.8,1.4,1.8,3.9), sdpi=c(8.2,7.3,8.3,8.9,8.5,8.3,7.7,9.8,9.1,10.4,9.6,7.9,9.2,10.2), ri=rep(c(.55,.43,.57,.66,.51,.59,.49), each=2), n1i=rep(c(22,21,26,18,38,42,39), each=2), n2i=rep(c(24,21,23,18,36,42,38), each=2)) test_that("results are correct for the multiple-endpoint studies example with standardized mean differences.", { dat$yi <- round(with(dat, (m2i-m1i)/sdpi), 3) dat$vi <- round(with(dat, 1/n1i + 1/n2i + yi^2/(2*(n1i+n2i))), 4) dat$covi <- round(with(dat, (1/n1i + 1/n2i) * ri + (rep(sapply(split(dat$yi, dat$school), prod), each=2) / (2*(n1i+n2i))) * ri^2), 4) V <- bldiag(lapply(split(dat, dat$school), function(x) matrix(c(x$vi[1], x$covi[1], x$covi[2], x$vi[2]), nrow=2))) ### fit model res <- rma.mv(yi, V, mods = ~ outcome - 1, data=dat, sparse=.sparse) ### (results for this not given in chapter) expect_equivalent(coef(res), c(0.3617, 0.2051), tolerance=.tol[["coef"]]) ### (results for this not given in chapter) tmp <- vcov(res) expected <- structure(c(0.01008, 0.00537, 0.00537, 0.00989), .Dim = c(2L, 2L), .Dimnames = list(c("outcomemath", "outcomereading"), c("outcomemath", "outcomereading"))) expect_equivalent(tmp, expected, tolerance=.tol[["var"]]) ### compare with results on page 371 expect_equivalent(res$QE, 19.6264, tolerance=.tol[["test"]]) ### 19.62 in chapter }) ############################################################################ rm(list=ls()) metafor/tests/testthat/test_misc_robust.r0000644000176200001440000001606714502304032020467 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: robust() function") source("settings.r") test_that("robust() works correctly for 'rma' objects.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, data=dat) sav <- robust(res, cluster=trial) expect_equivalent(c(vcov(sav)), 0.032106, tolerance=.tol[["var"]]) expect_equivalent(sav$dfs, 12, tolerance=.tol[["misc"]]) expect_equivalent(sav$zval, -3.98776, tolerance=.tol[["test"]]) tmp <- predict(sav, transf=exp) expect_equivalent(tmp$pred, 0.4894209, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 0.3312324, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 0.7231565, tolerance=.tol[["ci"]]) expect_equivalent(tmp$pi.lb, 0.1360214, tolerance=.tol[["ci"]]) expect_equivalent(tmp$pi.ub, 1.7609930, tolerance=.tol[["ci"]]) sav <- robust(res, cluster=trial, adjust=FALSE) expect_equivalent(c(vcov(sav)), 0.029636, tolerance=.tol[["var"]]) expect_equivalent(sav$dfs, 12, tolerance=.tol[["misc"]]) expect_equivalent(sav$zval, -4.150592, tolerance=.tol[["test"]]) sav <- robust(res, cluster=trial, clubSandwich=TRUE) expect_equivalent(c(vcov(sav)), 0.03229357, tolerance=.tol[["var"]]) expect_equivalent(sav$dfs, 11.04125, tolerance=.tol[["misc"]]) expect_equivalent(sav$zval, -3.97616, tolerance=.tol[["test"]]) tmp <- predict(sav, transf=exp) expect_equivalent(tmp$pred, 0.4894209, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 0.3295991, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 0.7267400, tolerance=.tol[["ci"]]) expect_equivalent(tmp$pi.lb, 0.1342926, tolerance=.tol[["ci"]]) expect_equivalent(tmp$pi.ub, 1.7836640, tolerance=.tol[["ci"]]) res <- rma(yi, vi, weights=1, data=dat) sav <- robust(res, cluster=trial) expect_equivalent(c(vcov(sav)), 0.037028, tolerance=.tol[["var"]]) expect_equivalent(sav$dfs, 12, tolerance=.tol[["misc"]]) expect_equivalent(sav$zval, -3.848996, tolerance=.tol[["test"]]) }) test_that("robust() works correctly for 'rma' objects with moderators.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, mods = ~ ablat + year, data=dat) sav <- robust(res, cluster=trial) expect_equivalent(sav$se, c(23.910483, 0.007857, 0.012079), tolerance=.tol[["se"]]) expect_equivalent(sav$dfs, 10, tolerance=.tol[["misc"]]) expect_equivalent(sav$zval, c(-0.148282, -3.564978, 0.157928), tolerance=.tol[["test"]]) expect_equivalent(sav$QM, 11.8546, tolerance=.tol[["test"]]) tmp <- predict(sav, newmods=c(30, 1970), transf=exp) expect_equivalent(tmp$pred, 0.5336811, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 0.4079824, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 0.6981073, tolerance=.tol[["ci"]]) expect_equivalent(tmp$pi.lb, 0.2425081, tolerance=.tol[["ci"]]) expect_equivalent(tmp$pi.ub, 1.1744580, tolerance=.tol[["ci"]]) sav <- robust(res, cluster=trial, clubSandwich=TRUE) expect_equivalent(sav$se, c(33.655367, 0.011994, 0.016963), tolerance=.tol[["se"]]) expect_equivalent(sav$dfs, c(2.724625, 2.112895, 2.745919), tolerance=.tol[["misc"]]) expect_equivalent(sav$zval, c(-0.105347, -2.335398, 0.112456), tolerance=.tol[["test"]]) expect_equivalent(sav$QM, 6.708996, tolerance=.tol[["test"]]) expect_equivalent(sav$QMdf, c(2, 2.528214), tolerance=.tol[["misc"]]) expect_equivalent(sav$QMp, 0.097479, tolerance=.tol[["pval"]]) tmp <- anova(sav) expect_equivalent(tmp$QM, 6.708996, tolerance=.tol[["test"]]) expect_equivalent(tmp$QMdf, c(2, 2.528214), tolerance=.tol[["misc"]]) expect_equivalent(tmp$QMp, 0.097479, tolerance=.tol[["pval"]]) tmp <- predict(sav, newmods=c(30, 1970), transf=exp) expect_equivalent(tmp$pred, 0.5336811, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 0.3938412, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 0.7231735, tolerance=.tol[["ci"]]) expect_equivalent(tmp$pi.lb, 0.2265965, tolerance=.tol[["ci"]]) expect_equivalent(tmp$pi.ub, 1.2569280, tolerance=.tol[["ci"]]) res <- rma(yi, vi, mods = ~ ablat + alloc, data=dat) sav <- robust(res, cluster=trial, clubSandwich=TRUE) tmp <- anova(sav, X=rbind(c(0,10,1,0),c(0,50,1,0))) expect_equivalent(tmp$se, c(0.210162, 0.321173), tolerance=.tol[["se"]]) expect_equivalent(tmp$ddf, c(1.929902, 3.251262), tolerance=.tol[["misc"]]) expect_equivalent(tmp$zval, c(-2.570637, -5.079127), tolerance=.tol[["test"]]) expect_equivalent(tmp$QM, 9.914783, tolerance=.tol[["test"]]) expect_equivalent(tmp$QMdf, c(2, 2.569003), tolerance=.tol[["misc"]]) expect_equivalent(tmp$QMp, 0.06194173, tolerance=.tol[["pval"]]) sav1 <- robust(res, cluster=trial) tmp1 <- anova(sav1, X=rbind(c(0,10,1,0),c(0,50,1,0))) sav2 <- robust(res, cluster=trial, clubSandwich=TRUE, vcov="CR1p", coef_test="naive-tp", wald_test="Naive-Fp") tmp2 <- anova(sav2, X=rbind(c(0,10,1,0),c(0,50,1,0))) expect_equivalent(tmp1$se, tmp2$se, tolerance=.tol[["se"]]) expect_equivalent(tmp1$ddf, tmp2$ddf, tolerance=.tol[["misc"]]) expect_equivalent(tmp1$zval, tmp2$zval, tolerance=.tol[["test"]]) expect_equivalent(tmp1$QM, tmp2$QM, tolerance=.tol[["test"]]) expect_equivalent(tmp1$QMdf, tmp2$QMdf, tolerance=.tol[["misc"]]) expect_equivalent(tmp1$QMp, tmp2$QMp, tolerance=.tol[["pval"]]) tmp1 <- predict(sav1, newmods=c(30,1,0), transf=exp) tmp2 <- predict(sav2, newmods=c(30,1,0), transf=exp) expect_equivalent(tmp1$pred, tmp2$pred, tolerance=.tol[["pred"]]) expect_equivalent(tmp1$ci.lb, tmp2$ci.lb, tolerance=.tol[["ci"]]) expect_equivalent(tmp1$ci.ub, tmp2$ci.ub, tolerance=.tol[["ci"]]) expect_equivalent(tmp1$pi.lb, tmp2$pi.lb, tolerance=.tol[["ci"]]) expect_equivalent(tmp1$pi.ub, tmp2$pi.ub, tolerance=.tol[["ci"]]) }) test_that("robust() works correctly for 'rma.mv' objects.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, sparse=.sparse) sav <- robust(res, cluster=trial) expect_equivalent(c(vcov(sav)), 0.032106, tolerance=.tol[["var"]]) expect_equivalent(sav$dfs, 12, tolerance=.tol[["misc"]]) expect_equivalent(sav$zval, -3.98776, tolerance=.tol[["test"]]) sav <- robust(res, cluster=trial, adjust=FALSE) expect_equivalent(c(vcov(sav)), 0.029636, tolerance=.tol[["var"]]) expect_equivalent(sav$dfs, 12, tolerance=.tol[["misc"]]) expect_equivalent(sav$zval, -4.150592, tolerance=.tol[["test"]]) sav <- robust(res, cluster=trial, clubSandwich=TRUE) expect_equivalent(c(vcov(sav)), 0.03229357, tolerance=.tol[["var"]]) expect_equivalent(sav$dfs, 11.04125, tolerance=.tol[["misc"]]) expect_equivalent(sav$zval, -3.97616, tolerance=.tol[["test"]]) res <- rma.mv(yi, vi, W=1, random = ~ 1 | trial, data=dat, sparse=.sparse) sav <- robust(res, cluster=trial) expect_equivalent(c(vcov(sav)), 0.037028, tolerance=.tol[["var"]]) expect_equivalent(sav$dfs, 12, tolerance=.tol[["misc"]]) expect_equivalent(sav$zval, -3.848996, tolerance=.tol[["test"]]) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_berkey1995.r0000644000176200001440000000546614204414161023372 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:berkey1995 source("settings.r") context("Checking analysis example: berkey1995") ### calculate log ratio ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### calculate "smoothed" sampling variances dat$vi <- with(dat, sum(tneg/tpos)/(13*(tneg+tpos)) + sum(cneg/cpos)/(13*(cneg+cpos))) test_that("results are correct for the random-effects model.", { ### fit random-effects model using empirical Bayes method res.RE <- rma(yi, vi, data=dat, method="EB") out <- capture.output(print(res.RE)) ### so that print.rma.uni() is run (at least once) out <- capture.output(print(summary(res.RE))) ### so that print.summary.rma() is run (at least once) ### compare with results on page 408 expect_equivalent(coef(res.RE), -0.5429, tolerance=.tol[["coef"]]) expect_equivalent(res.RE$se, 0.1842, tolerance=.tol[["se"]]) expect_equivalent(res.RE$tau2, 0.2682, tolerance=.tol[["var"]]) }) test_that("results are correct for the mixed-effects meta-regression model.", { ### fit random-effects model using empirical Bayes method res.RE <- rma(yi, vi, data=dat, method="EB") ### fit mixed-effects model with absolute latitude as moderator res.ME <- rma(yi, vi, mods=~I(ablat-33.46), data=dat, method="EB") out <- capture.output(print(res.ME)) ### compare with results on page 408 expect_equivalent(coef(res.ME), c(-0.6303, -0.0268), tolerance=.tol[["coef"]]) ### -0.6304 in article expect_equivalent(res.ME$se, c(0.1591, 0.0110), tolerance=.tol[["se"]]) expect_equivalent(res.ME$tau2, 0.1572, tolerance=.tol[["var"]]) expect_warning(tmp <- anova(res.RE, res.ME)) expect_equivalent(tmp$R2, 41.3844, tolerance=.tol[["r2"]]) ### predicted average risk ratios tmp <- predict(res.ME, newmods=c(33.46,42)-33.46, transf=exp, digits=2) ### compare with results on page 408 expect_equivalent(tmp$pred, c(0.5324, 0.4236), tolerance=.tol[["pred"]]) }) test_that("results are correct for the fixed-effects meta-regression model.", { ### fit fixed-effects model with absolute latitude as moderator res.FE <- rma(yi, vi, mods=~I(ablat-33.46), data=dat, method="FE") ### compare with results on page 408 expect_equivalent(coef(res.FE), c(-0.5949, -0.0282), tolerance=.tol[["coef"]]) ### -0.5950 in article expect_equivalent(res.FE$se, c(0.0696, 0.0040), tolerance=.tol[["se"]]) ### 0.0039 in article ### predicted risk ratios based on the fixed-effects model tmp <- predict(res.FE, newmods=c(33.46,42)-33.46, transf=exp, digits=2) ### compare with results on page 408 expect_equivalent(tmp$pred, c(0.5516, 0.4336), tolerance=.tol[["pred"]]) }) rm(list=ls()) metafor/tests/testthat/test_misc_rma_mv.r0000644000176200001440000002250714502304021020424 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: rma.mv() function") source("settings.r") dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) test_that("rma.mv() correctly handles a formula for the 'yi' argument", { res1 <- rma.mv(yi ~ ablat, vi, random = ~ 1 | trial, data=dat, sparse=.sparse) res2 <- rma.mv(yi, vi, mods = ~ ablat, random = ~ 1 | trial, data=dat, sparse=.sparse) expect_equivalent(coef(res1), coef(res2), tolerance=.tol[["coef"]]) }) test_that("rma.mv() works correctly when using user-defined weights", { res <- rma.mv(yi, vi, W=1, random = ~ 1 | trial, data=dat, sparse=.sparse) expect_equivalent(coef(res), mean(dat$yi), tolerance=.tol[["coef"]]) expect_equivalent(c(vcov(res)), 0.0358, tolerance=.tol[["var"]]) }) test_that("rma.mv() correctly handles negative sampling variances", { dat$vi[1] <- -.01 expect_warning(res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, sparse=.sparse)) expect_equivalent(coef(res), -0.7220, tolerance=.tol[["coef"]]) expect_equivalent(c(vcov(res)), 0.0293, tolerance=.tol[["var"]]) }) test_that("rma.mv() correctly handles a missing value", { dat$vi[1] <- NA expect_warning(res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, sparse=.sparse)) expect_equivalent(coef(res), -0.7071, tolerance=.tol[["coef"]]) expect_equivalent(c(vcov(res)), 0.0361, tolerance=.tol[["var"]]) }) test_that("rma.mv() correctly handles the R argument", { P <- structure(c(1.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 1.000, 0.621, 0.621, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.000, 0.621, 1.000, 0.642, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.000, 0.621, 0.642, 1.000, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.128, 0.000, 0.128, 0.128, 0.128, 1.000, 0.266, 0.266, 0.221, 0.221, 0.221, 0.157, 0.157, 0.157, 0.157, 0.157, 0.000, 0.128, 0.128, 0.128, 0.266, 1.000, 0.467, 0.221, 0.221, 0.221, 0.157, 0.157, 0.157, 0.157, 0.157, 0.000, 0.128, 0.128, 0.128, 0.266, 0.467, 1.000, 0.221, 0.221, 0.221, 0.157, 0.157, 0.157, 0.157, 0.157, 0.000, 0.128, 0.128, 0.128, 0.221, 0.221, 0.221, 1.000, 0.605, 0.296, 0.157, 0.157, 0.157, 0.157, 0.157, 0.000, 0.128, 0.128, 0.128, 0.221, 0.221, 0.221, 0.605, 1.000, 0.296, 0.157, 0.157, 0.157, 0.157, 0.157, 0.000, 0.128, 0.128, 0.128, 0.221, 0.221, 0.221, 0.296, 0.296, 1.000, 0.157, 0.157, 0.157, 0.157, 0.157, 0.000, 0.128, 0.128, 0.128, 0.157, 0.157, 0.157, 0.157, 0.157, 0.157, 1.000, 0.773, 0.390, 0.390, 0.390, 0.000, 0.128, 0.128, 0.128, 0.157, 0.157, 0.157, 0.157, 0.157, 0.157, 0.773, 1.000, 0.390, 0.390, 0.390, 0.000, 0.128, 0.128, 0.128, 0.157, 0.157, 0.157, 0.157, 0.157, 0.157, 0.390, 0.390, 1.000, 0.606, 0.606, 0.000, 0.128, 0.128, 0.128, 0.157, 0.157, 0.157, 0.157, 0.157, 0.157, 0.390, 0.390, 0.606, 1.000, 0.697, 0.000, 0.128, 0.128, 0.128, 0.157, 0.157, 0.157, 0.157, 0.157, 0.157, 0.390, 0.390, 0.606, 0.697, 1.000), .Dim = c(15L, 15L), .Dimnames = list(c("S11", "S15", "S06", "S10", "S08", "S02", "S07", "S14", "S09", "S01", "S12", "S05", "S13", "S04", "S03"), c("S11", "S15", "S06", "S10", "S08", "S02", "S07", "S14", "S09", "S01", "S12", "S05", "S13", "S04", "S03"))) dat <- structure(list(study = 1:44, species = c("S01", "S01", "S02", "S02", "S02", "S02", "S03", "S03", "S03", "S03", "S04", "S04", "S04", "S04", "S05", "S05", "S05", "S06", "S06", "S06", "S06", "S07", "S07", "S08", "S08", "S08", "S09", "S09", "S10", "S10", "S10", "S11", "S11", "S11", "S11", "S12", "S12", "S13", "S13", "S13", "S14", "S14", "S15", "S15"), phylogeny = c("S01", "S01", "S02", "S02", "S02", "S02", "S03", "S03", "S03", "S03", "S04", "S04", "S04", "S04", "S05", "S05", "S05", "S06", "S06", "S06", "S06", "S07", "S07", "S08", "S08", "S08", "S09", "S09", "S10", "S10", "S10", "S11", "S11", "S11", "S11", "S12", "S12", "S13", "S13", "S13", "S14", "S14", "S15", "S15"), yi = c(1.91, 1.67, -0.92, -0.1, -0.58, -1.29, 0.04, -1.33, 0.02, -1, 0.2, 1.75, -0.75, 1.36, 1.24, 0.64, 0.52, 1.93, 1.11, 1.12, 1.17, 0.25, 1.95, -0.06, -0.79, 0.39, 1.61, 1.96, 0.93, 0.5, 0.73, -0.7, 0.11, 0.84, 1.83, -0.59, 0.19, 0.14, 0.74, 0.55, 0.34, -1.16, 1.93, 1.85), vi = c(0.213, 0.387, 0.381, 0.467, 0.132, 0.603, 0.374, 0.2, 0.119, 0.092, 0.139, 0.449, 0.412, 0.398, 0.25, 0.168, 0.303, 0.125, 0.164, 0.229, 0.482, 0.059, 0.421, 0.111, 0.373, 0.032, 0.062, 0.126, 0.066, 0.155, 0.229, 0.276, 0.039, 0.409, 0.312, 0.304, 0.601, 0.096, 0.216, 0.181, 0.537, 0.16, 0.303, 0.281)), .Names = c("study", "species", "phylogeny", "yi", "vi"), row.names = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44"), class = "data.frame") res <- rma.mv(yi, vi, random = list(~ 1 | study, ~ 1 | species, ~ 1 | phylogeny), R = list(phylogeny=P), data=dat, sparse=.sparse) expect_equivalent(coef(res), .5504, tolerance=.tol[["coef"]]) expect_equivalent(res$sigma2, c(0.1763, 0.5125, 0.1062), tolerance=.tol[["var"]]) expect_equivalent(c(logLik(res)), -54.6272, tolerance=.tol[["fit"]]) }) dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) test_that("rma.mv() correctly computes the Hessian", { res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, cvvc=TRUE, sparse=.sparse) expect_equivalent(c(sqrt(res$vvc)), 0.1678, tolerance=.tol[["se"]]) }) test_that("rma.mv() works correctly with test='t'", { res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, test="t", sparse=.sparse) expect_equivalent(res$pval, 0.0018, tolerance=.tol[["pval"]]) }) test_that("rma.mv() works correctly with different optimizers", { res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, control=list(optimizer="BFGS"), sparse=.sparse) expect_equivalent(res$sigma2, 0.3132, tolerance=.tol[["var"]]) res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, control=list(optimizer="L-BFGS-B"), sparse=.sparse) expect_equivalent(res$sigma2, 0.3132, tolerance=.tol[["var"]]) res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, control=list(optimizer="Nelder-Mead"), sparse=.sparse) expect_equivalent(res$sigma2, 0.3133, tolerance=.tol[["var"]]) res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, control=list(optimizer="nlminb"), sparse=.sparse) expect_equivalent(res$sigma2, 0.3132, tolerance=.tol[["var"]]) res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, control=list(optimizer="uobyqa"), sparse=.sparse) expect_equivalent(res$sigma2, 0.3132, tolerance=.tol[["var"]]) res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, control=list(optimizer="newuoa"), sparse=.sparse) expect_equivalent(res$sigma2, 0.3132, tolerance=.tol[["var"]]) res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, control=list(optimizer="bobyqa"), sparse=.sparse) expect_equivalent(res$sigma2, 0.3132, tolerance=.tol[["var"]]) res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, control=list(optimizer="nloptr"), sparse=.sparse) expect_equivalent(res$sigma2, 0.3132, tolerance=.tol[["var"]]) res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, control=list(optimizer="nlm"), sparse=.sparse) expect_equivalent(res$sigma2, 0.3132, tolerance=.tol[["var"]]) res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, control=list(optimizer="hjk"), sparse=.sparse) expect_equivalent(res$sigma2, 0.3132, tolerance=.tol[["var"]]) res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, control=list(optimizer="nmk"), sparse=.sparse) expect_equivalent(res$sigma2, 0.3131, tolerance=.tol[["var"]]) res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, control=list(optimizer="ucminf"), sparse=.sparse) expect_equivalent(res$sigma2, 0.3132, tolerance=.tol[["var"]]) }) test_that("rma.mv() correctly handles 'beta' argument", { dat <- dat.berkey1998 V <- vcalc(vi=1, cluster=author, rvars=c(v1i, v2i), data=dat) res.unc <- rma.mv(yi, V, mods = ~ outcome - 1, random = ~ outcome | trial, struct="UN", data=dat, method="ML") res.01 <- rma.mv(yi, V, mods = ~ outcome - 1, random = ~ outcome | trial, struct="UN", data=dat, method="ML", beta=c(0,0)) res.02 <- rma.mv(yi, V, mods = ~ outcome - 1, random = ~ outcome | trial, struct="UN", data=dat, method="ML", beta=c(NA,0)) res.03 <- rma.mv(yi, V, mods = ~ outcome - 1, random = ~ outcome | trial, struct="UN", data=dat, method="ML", beta=c(0,NA)) fstats <- fitstats(res.01, res.02, res.03, res.unc) expect_equivalent(unlist(fstats[1,]), c(-2.464111, -0.691524, 1.010033, 5.840657), tolerance=.tol[["fit"]]) dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, scale = ~ 1, data=dat, optbeta=TRUE, beta=0) ll1 <- logLik(res) res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, beta=0) ll2 <- logLik(res) expect_equivalent(ll1, ll2, tolerance=.tol[["fit"]]) }) rm(list=ls()) metafor/tests/testthat/test_misc_diagnostics_rma.mv.r0000644000176200001440000002723614502303762022751 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: model diagnostic functions for rma.mv()") source("settings.r") dat1 <- dat.konstantopoulos2011 dat1 <- dat1[dat1$district %in% c(11, 12, 18, 71, 108, 644),] rownames(dat1) <- 1:nrow(dat1) dat1$yi[dat1$district %in% 12] <- NA ### all values for district 12 are missing dat1$yi[dat1$district %in% 18 & dat1$school == 2] <- NA ### second value for district 18 is missing dat1$yi[dat1$district %in% 108] <- dat1$yi[dat1$district %in% 108] + 1 ### increase district level variance dat1$district11 <- ifelse(dat1$district == 11, 1, 0) ### dummy for district 11 dat1$study53 <- ifelse(dat1$study == 53, 1, 0) ### dummies for studies in district 644 dat1$study54 <- ifelse(dat1$study == 54, 1, 0) ### dummies for studies in district 644 dat1$study55 <- ifelse(dat1$study == 55, 1, 0) ### dummies for studies in district 644 dat1$study56 <- ifelse(dat1$study == 56, 1, 0) ### dummies for studies in district 644 #set.seed(123214) #dat2 <- dat1[sample(nrow(dat1)),] ### reshuffled dataset dat2 <- dat1[c(23, 2, 6, 3, 19, 14, 20, 12, 21, 9, 13, 7, 11, 8, 10, 22, 18, 1, 5, 4, 17, 15, 16),] res1 <- suppressWarnings(rma.mv(yi, vi, mods = ~ district11 + study53 + study54 + study55 + study56, random = ~ 1 | district/school, data=dat1, slab=study, sparse=.sparse)) res2 <- suppressWarnings(rma.mv(yi, vi, mods = ~ district11 + study53 + study54 + study55 + study56, random = ~ 1 | district/school, data=dat2, slab=study, sparse=.sparse)) test_that("model diagnostic functions work with 'na.omit'.", { skip_on_cran() options(na.action="na.omit") sav1 <- rstandard(res1) sav2 <- rstandard(res2) sav2 <- sav2[match(sav1$slab, sav2$slab),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$resid), rep(FALSE,18)) sav1 <- rstandard(res1, cluster=dat1$district) sav2 <- rstandard(res2, cluster=dat2$district) sav2$obs <- sav2$obs[match(sav1$obs$slab, sav2$obs$slab),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$obs$resid), rep(FALSE,18)) expect_equivalent(is.na(sav1$cluster$X2), c(TRUE, rep(FALSE,3), TRUE)) sav1 <- rstudent(res1) sav2 <- rstudent(res2) sav2 <- sav2[match(sav1$slab, sav2$slab),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$resid), c(rep(FALSE,14), rep(TRUE,4))) sav1 <- rstudent(res1, cluster=dat1$district) sav2 <- rstudent(res2, cluster=dat2$district) sav2$obs <- sav2$obs[match(sav1$obs$slab, sav2$obs$slab),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$obs$resid), c(rep(TRUE,4), rep(FALSE,10), rep(TRUE,4))) expect_equivalent(is.na(sav1$cluster$X2), c(TRUE, rep(FALSE,3), TRUE)) sav1 <- rstudent(res1, cluster=dat1$district, parallel="snow") sav2 <- rstudent(res2, cluster=dat2$district, parallel="snow") sav2$obs <- sav2$obs[match(sav1$obs$slab, sav2$obs$slab),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$obs$resid), c(rep(TRUE,4), rep(FALSE,10), rep(TRUE,4))) expect_equivalent(is.na(sav1$cluster$X2), c(TRUE, rep(FALSE,3), TRUE)) sav1 <- rstudent(res1, cluster=dat1$district, reestimate=FALSE) sav2 <- rstudent(res2, cluster=dat2$district, reestimate=FALSE) sav2$obs <- sav2$obs[match(sav1$obs$slab, sav2$obs$slab),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$obs$resid), c(rep(TRUE,4), rep(FALSE,10), rep(TRUE,4))) expect_equivalent(is.na(sav1$cluster$X2), c(TRUE, rep(FALSE,3), TRUE)) sav1 <- rstudent(res1, cluster=dat1$district, parallel="snow", reestimate=FALSE) sav2 <- rstudent(res2, cluster=dat2$district, parallel="snow", reestimate=FALSE) sav2$obs <- sav2$obs[match(sav1$obs$slab, sav2$obs$slab),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$obs$resid), c(rep(TRUE,4), rep(FALSE,10), rep(TRUE,4))) expect_equivalent(is.na(sav1$cluster$X2), c(TRUE, rep(FALSE,3), TRUE)) sav1 <- cooks.distance(res1) sav2 <- cooks.distance(res2) sav2 <- sav2[match(names(sav1), names(sav2))] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1), c(rep(FALSE,14), rep(TRUE,4))) sav1 <- cooks.distance(res1, cluster=dat1$district) sav2 <- cooks.distance(res2, cluster=dat2$district) expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1), c(TRUE, rep(FALSE,3), TRUE)) sav1 <- cooks.distance(res1, cluster=dat1$district, parallel="snow") sav2 <- cooks.distance(res2, cluster=dat2$district, parallel="snow") expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1), c(TRUE, rep(FALSE,3), TRUE)) sav1 <- cooks.distance(res1, cluster=dat1$district, reestimate=FALSE) sav2 <- cooks.distance(res2, cluster=dat2$district, reestimate=FALSE) expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1), c(TRUE, rep(FALSE,3), TRUE)) sav1 <- cooks.distance(res1, cluster=dat1$district, parallel="snow", reestimate=FALSE) sav2 <- cooks.distance(res2, cluster=dat2$district, parallel="snow", reestimate=FALSE) expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1), c(TRUE, rep(FALSE,3), TRUE)) sav1 <- dfbetas(res1) sav2 <- dfbetas(res2) sav2 <- sav2[match(rownames(sav1), rownames(sav2)),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$intrcpt), c(rep(FALSE,14), rep(TRUE,4))) sav1 <- dfbetas(res1, cluster=dat1$district) sav2 <- dfbetas(res2, cluster=dat2$district) expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$intrcpt), c(TRUE, rep(FALSE,3), TRUE)) sav1 <- dfbetas(res1, cluster=dat1$district, parallel="snow") sav2 <- dfbetas(res2, cluster=dat2$district, parallel="snow") expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$intrcpt), c(TRUE, rep(FALSE,3), TRUE)) sav1 <- dfbetas(res1, cluster=dat1$district, reestimate=FALSE) sav2 <- dfbetas(res2, cluster=dat2$district, reestimate=FALSE) expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$intrcpt), c(TRUE, rep(FALSE,3), TRUE)) sav1 <- dfbetas(res1, cluster=dat1$district, parallel="snow", reestimate=FALSE) sav2 <- dfbetas(res2, cluster=dat2$district, parallel="snow", reestimate=FALSE) expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$intrcpt), c(TRUE, rep(FALSE,3), TRUE)) sav1 <- ranef(res1) sav2 <- ranef(res2) expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$district$intrcpt), rep(FALSE,5)) expect_equivalent(is.na(sav1$`district/school`$intrcpt), rep(FALSE,18)) }) test_that("model diagnostic functions work with 'na.pass'.", { skip_on_cran() options(na.action="na.pass") sav1 <- rstandard(res1) sav2 <- rstandard(res2) sav2 <- sav2[match(sav1$slab, sav2$slab),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$resid), c(rep(FALSE,4), rep(TRUE,4), FALSE, TRUE, rep(FALSE,13))) sav1 <- rstandard(res1, cluster=dat1$district) sav2 <- rstandard(res2, cluster=dat2$district) sav2$obs <- sav2$obs[match(sav1$obs$slab, sav2$obs$slab),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$obs$resid), c(rep(FALSE,4), rep(TRUE,4), FALSE, TRUE, rep(FALSE,13))) expect_equivalent(is.na(sav1$cluster$X2), c(rep(TRUE,2), rep(FALSE,3), TRUE)) sav1 <- rstudent(res1) sav2 <- rstudent(res2) sav2 <- sav2[match(sav1$slab, sav2$slab),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$resid), c(rep(FALSE,4), rep(TRUE,4), FALSE, TRUE, rep(FALSE,9), rep(TRUE,4))) sav1 <- rstudent(res1, cluster=dat1$district) sav2 <- rstudent(res2, cluster=dat2$district) sav2$obs <- sav2$obs[match(sav1$obs$slab, sav2$obs$slab),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$obs$resid), c(rep(TRUE,8), FALSE, TRUE, rep(FALSE,9), rep(TRUE,4))) expect_equivalent(is.na(sav1$cluster$X2), c(rep(TRUE,2), rep(FALSE,3), TRUE)) sav1 <- rstudent(res1, cluster=dat1$district, parallel="snow") sav2 <- rstudent(res2, cluster=dat2$district, parallel="snow") sav2$obs <- sav2$obs[match(sav1$obs$slab, sav2$obs$slab),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$obs$resid), c(rep(TRUE,8), FALSE, TRUE, rep(FALSE,9), rep(TRUE,4))) expect_equivalent(is.na(sav1$cluster$X2), c(rep(TRUE,2), rep(FALSE,3), TRUE)) sav1 <- rstudent(res1, cluster=dat1$district, reestimate=FALSE) sav2 <- rstudent(res2, cluster=dat2$district, reestimate=FALSE) sav2$obs <- sav2$obs[match(sav1$obs$slab, sav2$obs$slab),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$obs$resid), c(rep(TRUE,8), FALSE, TRUE, rep(FALSE,9), rep(TRUE,4))) expect_equivalent(is.na(sav1$cluster$X2), c(rep(TRUE,2), rep(FALSE,3), TRUE)) sav1 <- rstudent(res1, cluster=dat1$district, parallel="snow", reestimate=FALSE) sav2 <- rstudent(res2, cluster=dat2$district, parallel="snow", reestimate=FALSE) sav2$obs <- sav2$obs[match(sav1$obs$slab, sav2$obs$slab),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$obs$resid), c(rep(TRUE,8), FALSE, TRUE, rep(FALSE,9), rep(TRUE,4))) expect_equivalent(is.na(sav1$cluster$X2), c(rep(TRUE,2), rep(FALSE,3), TRUE)) sav1 <- cooks.distance(res1) sav2 <- cooks.distance(res2) sav2 <- sav2[match(names(sav1), names(sav2))] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1), c(rep(FALSE,4), rep(TRUE,4), FALSE, TRUE, rep(FALSE,9), rep(TRUE,4))) sav1 <- cooks.distance(res1, cluster=dat1$district) sav2 <- cooks.distance(res2, cluster=dat2$district) expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1), c(rep(TRUE,2), rep(FALSE,3), TRUE)) sav1 <- cooks.distance(res1, cluster=dat1$district, parallel="snow") sav2 <- cooks.distance(res2, cluster=dat2$district, parallel="snow") expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1), c(rep(TRUE,2), rep(FALSE,3), TRUE)) sav1 <- cooks.distance(res1, cluster=dat1$district, reestimate=FALSE) sav2 <- cooks.distance(res2, cluster=dat2$district, reestimate=FALSE) expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1), c(rep(TRUE,2), rep(FALSE,3), TRUE)) sav1 <- cooks.distance(res1, cluster=dat1$district, parallel="snow", reestimate=FALSE) sav2 <- cooks.distance(res2, cluster=dat2$district, parallel="snow", reestimate=FALSE) expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1), c(rep(TRUE,2), rep(FALSE,3), TRUE)) sav1 <- dfbetas(res1) sav2 <- dfbetas(res2) sav2 <- sav2[match(rownames(sav1), rownames(sav2)),] expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$intrcpt), c(rep(FALSE,4), rep(TRUE,4), FALSE, TRUE, rep(FALSE,9), rep(TRUE,4))) sav1 <- dfbetas(res1, cluster=dat1$district) sav2 <- dfbetas(res2, cluster=dat2$district) expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$intrcpt), c(rep(TRUE,2), rep(FALSE,3), TRUE)) sav1 <- dfbetas(res1, cluster=dat1$district, parallel="snow") sav2 <- dfbetas(res2, cluster=dat2$district, parallel="snow") expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$intrcpt), c(rep(TRUE,2), rep(FALSE,3), TRUE)) sav1 <- dfbetas(res1, cluster=dat1$district, reestimate=FALSE) sav2 <- dfbetas(res2, cluster=dat2$district, reestimate=FALSE) expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$intrcpt), c(rep(TRUE,2), rep(FALSE,3), TRUE)) sav1 <- dfbetas(res1, cluster=dat1$district, parallel="snow", reestimate=FALSE) sav2 <- dfbetas(res2, cluster=dat2$district, parallel="snow", reestimate=FALSE) expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$intrcpt), c(rep(TRUE,2), rep(FALSE,3), TRUE)) sav1 <- ranef(res1) sav2 <- ranef(res2) expect_equivalent(sav1, sav2) expect_equivalent(is.na(sav1$district$intrcpt), c(FALSE, TRUE, rep(FALSE,4))) expect_equivalent(is.na(sav1$`district/school`$intrcpt), c(rep(FALSE,4), rep(TRUE,4), FALSE, TRUE, rep(FALSE,13))) options(na.action="na.omit") }) rm(list=ls()) metafor/tests/testthat/test_misc_vif.r0000644000176200001440000000171114277117201017734 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: vif() function") source("settings.r") test_that("vif() works correctly for 'rma.uni' objects.", { dat <- dat.bangertdrowns2004 dat <- dat[!apply(dat[,c("length", "wic", "feedback", "info", "pers", "imag", "meta")], 1, anyNA),] res <- rma(yi, vi, mods = ~ length + wic + feedback + info + pers + imag + meta, data=dat) sav <- vif(res) out <- capture.output(print(sav)) vifs <- c(length = 1.53710262575577, wic = 1.38604929927746, feedback = 1.64904565071108, info = 1.83396138431786, pers = 5.67803138275492, imag = 1.1553714953831, meta = 4.53327503733189) expect_equivalent(sav$vifs, vifs) sav <- vif(res, table=TRUE) out <- capture.output(print(sav)) expect_equivalent(sav$vifs, vifs) sav <- vif(res, btt=2:3) out <- capture.output(print(sav)) gvif <- 2.06507966959426 expect_equivalent(sav$vifs, gvif) }) rm(list=ls()) metafor/tests/testthat/test_misc_fsn.r0000644000176200001440000000637114477347564017770 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: fsn() function") source("settings.r") test_that("confint() gives correct results for the 'expectancy data' in Becker (2005).", { sav <- fsn(yi, vi, data=dat.raudenbush1985) expect_equivalent(sav$fsnum, 26) ### note: Becker uses p-values based on t-tests, which yields N =~ 23 out <- capture.output(print(sav)) # so that print.fsn() is run (at least once) ### use Fisher's test sav <- fsn(yi, vi, data=dat.raudenbush1985, pool="Fisher") expect_equivalent(sav$fsnum, 40) sav <- fsn(yi, data=dat.raudenbush1985, type="Orwin", target=.05) expect_equivalent(sav$fsnum, 44) out <- capture.output(print(sav)) # so that print.fsn() is run (at least once) with type="Orwin" sav <- fsn(yi, vi, data=dat.raudenbush1985, type="Orwin", target=.05) expect_equivalent(sav$fsnum, 4) sav <- fsn(yi, vi, data=dat.raudenbush1985, type="Rosenberg") expect_equivalent(sav$fsnum, 0) out <- capture.output(print(sav)) # so that print.fsn() is run (at least once) with type="Rosenberg" skip_on_cran() sav <- fsn(yi, vi, data=dat.raudenbush1985, type="General") expect_equivalent(sav$fsnum, 0) sav <- fsn(yi, vi, data=dat.raudenbush1985, type="General", exact=TRUE) expect_equivalent(sav$fsnum, 0) out <- capture.output(print(sav)) # so that print.fsn() is run (at least once) with type="General" res <- rma(yi, vi, data=dat.raudenbush1985) sav <- fsn(res, target=.05) expect_equivalent(sav$fsnum, 12) }) test_that("confint() gives correct results for the 'passive smoking data' in Becker (2005).", { sav <- fsn(yi, vi, data=dat.hackshaw1998) expect_equivalent(sav$fsnum, 393) ### note: Becker finds N =~ 398 (due to rounding) sav <- fsn(yi, data=dat.hackshaw1998, type="Orwin", target=.049) expect_equivalent(sav$fsnum, 186) sav <- fsn(yi, vi, data=dat.hackshaw1998, type="Orwin", target=.049) expect_equivalent(sav$fsnum, 104) # not 103 as fsn() always rounds up sav <- fsn(yi, vi, data=dat.hackshaw1998, type="Rosenberg") expect_equivalent(sav$fsnum, 202) skip_on_cran() sav <- fsn(yi, vi, data=dat.hackshaw1998, type="General") expect_equivalent(sav$fsnum, 112) sav <- fsn(yi, vi, data=dat.hackshaw1998, type="General", exact=TRUE) expect_equivalent(sav$fsnum, 119) }) test_that("confint() gives correct results for the 'interview data' in Becker (2005).", { dat <- escalc(measure="ZCOR", ri=ri, ni=ni, data=dat.mcdaniel1994) sav <- fsn(yi, vi, data=dat) expect_equivalent(sav$fsnum, 50364) ### note: Becker uses p-values based on t-tests, which yields N =~ 51226 sav <- fsn(yi, data=dat, type="Orwin", target=.15) expect_equivalent(sav$fsnum, 129) sav <- fsn(yi, vi, data=dat, type="Orwin", target=.15) expect_equivalent(sav$fsnum, 65) # not 64 as fsn() always rounds up sav <- fsn(yi, vi, data=dat, type="Rosenberg") expect_equivalent(sav$fsnum, 45528) skip_on_cran() sav <- fsn(yi, vi, data=dat, type="General") expect_equivalent(sav$fsnum, 6068) sav <- fsn(yi, vi, data=dat, type="General", exact=TRUE) expect_equivalent(sav$fsnum, 6068) res <- rma(yi, vi, data=dat) sav <- fsn(res) expect_equivalent(sav$fsnum, 6068) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_stijnen2010.r0000644000176200001440000002134414231232112023521 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:stijnen2010 context("Checking analysis example: stijnen2010") source("settings.r") ### load data dat <- dat.nielweise2007 test_that("results for the normal-normal model are correct (measure=='PLO')", { res <- rma(measure="PLO", xi=ci, ni=n2i, data=dat) ### compare with results on page 3050 (Table II) expect_equivalent(coef(res), -3.3018, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.2378, tolerance=.tol[["se"]]) expect_equivalent(res$tau2, 0.6629, tolerance=.tol[["var"]]) tmp <- predict(res, transf=transf.ilogit) expect_equivalent(tmp$pred, 0.0355, tolerance=.tol[["pred"]]) ### 0.035 in paper expect_equivalent(tmp$ci.lb, 0.0226, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 0.0554, tolerance=.tol[["ci"]]) ### 0.056 in paper res <- rma(measure="PLO", xi=ai, ni=n1i, data=dat) ### compare with results on page 3050 (Table II) expect_equivalent(coef(res), -4.2604, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.2589, tolerance=.tol[["se"]]) expect_equivalent(res$tau2, 0.3928, tolerance=.tol[["var"]]) tmp <- predict(res, transf=transf.ilogit) expect_equivalent(tmp$pred, 0.0139, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 0.0084, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 0.0229, tolerance=.tol[["ci"]]) }) test_that("results for the binomial-normal normal are correct (measure=='PLO')", { skip_on_cran() res <- rma.glmm(measure="PLO", xi=ci, ni=n2i, data=dat) ### compare with results on page 3050 (Table II) expect_equivalent(coef(res), -3.4964, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.2570, tolerance=.tol[["se"]]) expect_equivalent(res$tau2, 0.8124, tolerance=.tol[["var"]]) tmp <- predict(res, transf=transf.ilogit) expect_equivalent(tmp$pred, 0.0294, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 0.0180, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 0.0478, tolerance=.tol[["ci"]]) res <- rma.glmm(measure="PLO", xi=ai, ni=n1i, data=dat) ### compare with results on page 3050 (Table II) expect_equivalent(coef(res), -4.8121, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.3555, tolerance=.tol[["se"]]) expect_equivalent(res$tau2, 0.8265, tolerance=.tol[["var"]]) tmp <- predict(res, transf=transf.ilogit) expect_equivalent(tmp$pred, 0.0081, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 0.0040, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 0.0161, tolerance=.tol[["ci"]]) }) test_that("results for the normal-normal model are correct (measure=='OR')", { expect_warning(res <- rma(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, drop00=TRUE)) ### compare with results on page 3052 (Table III) expect_equivalent(coef(res), -0.9804, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.2435, tolerance=.tol[["se"]]) ### 0.244 in paper expect_equivalent(sqrt(res$tau2), 0.1886, tolerance=.tol[["var"]]) tmp <- predict(res, transf=exp) expect_equivalent(tmp$pred, 0.3752, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 0.2328, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 0.6046, tolerance=.tol[["ci"]]) ### 0.62 in paper }) test_that("results for the conditional logistic model with exact likelihood are correct (measure=='OR')", { skip_on_cran() expect_warning(res <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL")) out <- capture.output(print(res)) ### so that print.rma.glmm() is run (at least once) ### compare with results on page 3052 (Table III) expect_equivalent(coef(res), -1.3532, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.3511, tolerance=.tol[["se"]]) expect_equivalent(sqrt(res$tau2), 0.8327, tolerance=.tol[["var"]]) tmp <- predict(res, transf=exp) expect_equivalent(tmp$pred, 0.2584, tolerance=.tol[["pred"]]) ### 0.25 in paper expect_equivalent(tmp$ci.lb, 0.1299, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 0.5142, tolerance=.tol[["ci"]]) }) test_that("results for the conditional logistic model with approximate likelihood are correct (measure=='OR')", { skip_on_cran() expect_warning(res <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.AL")) ### compare with results on page 3052 (Table III) expect_equivalent(coef(res), -1.3027, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.3386, tolerance=.tol[["se"]]) expect_equivalent(sqrt(res$tau2), 0.7750, tolerance=.tol[["var"]]) ### 0.77 in paper tmp <- predict(res, transf=exp) expect_equivalent(tmp$pred, 0.2718, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 0.1400, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 0.5279, tolerance=.tol[["ci"]]) }) ############################################################################ ### load data dat <- dat.nielweise2008 ### incidence rates reflect the expected number of events per 1000 days dat$t1i <- dat$t1i/1000 dat$t2i <- dat$t2i/1000 test_that("results for the normal-normal model are correct (measure=='IRLN')", { res <- rma(measure="IRLN", xi=x2i, ti=t2i, data=dat) ### compare with results on page 3054 (Table VII) expect_equivalent(coef(res), 1.4676, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.2425, tolerance=.tol[["se"]]) expect_equivalent(res$tau2, 0.3699, tolerance=.tol[["var"]]) tmp <- predict(res, transf=exp) expect_equivalent(tmp$pred, 4.3389, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 2.6973, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 6.9795, tolerance=.tol[["ci"]]) ### 6.99 in paper res <- rma(measure="IRLN", xi=x1i, ti=t1i, data=dat) ### compare with results on page 3054 (Table VII) expect_equivalent(coef(res), 0.9808, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.3259, tolerance=.tol[["se"]]) expect_equivalent(res$tau2, 0.6393, tolerance=.tol[["var"]]) tmp <- predict(res, transf=exp) expect_equivalent(tmp$pred, 2.6667, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 1.4078, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 5.0513, tolerance=.tol[["ci"]]) }) test_that("results for the Poisson-normal model are correct (measure=='IRLN')", { skip_on_cran() res <- rma.glmm(measure="IRLN", xi=x2i, ti=t2i, data=dat) ### compare with results on page 3054 (Table VII) expect_equivalent(coef(res), 1.4007, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.2310, tolerance=.tol[["se"]]) expect_equivalent(res$tau2, 0.3165, tolerance=.tol[["var"]]) ### 0.316 in paper tmp <- predict(res, transf=exp) expect_equivalent(tmp$pred, 4.0580, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 2.5803, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 6.3819, tolerance=.tol[["ci"]]) res <- rma.glmm(measure="IRLN", xi=x1i, ti=t1i, data=dat) ### compare with results on page 3054 (Table VII) expect_equivalent(coef(res), 0.8494, tolerance=.tol[["coef"]]) ### 0.850 in paper expect_equivalent(res$se, 0.3303, tolerance=.tol[["se"]]) expect_equivalent(res$tau2, 0.6543, tolerance=.tol[["var"]]) tmp <- predict(res, transf=exp) expect_equivalent(tmp$pred, 2.3383, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 1.2240, tolerance=.tol[["ci"]]) ### 1.23 in paper expect_equivalent(tmp$ci.ub, 4.4670, tolerance=.tol[["ci"]]) }) test_that("results for the normal-normal model are correct (measure=='IRR')", { res <- rma(measure="IRR", x1i=x1i, t1i=t1i, x2i=x2i, t2i=t2i, data=dat) ### compare with results on page 3055 (Table VIII) expect_equivalent(coef(res), -0.3963, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.2268, tolerance=.tol[["se"]]) ### 0.223 in paper expect_equivalent(sqrt(res$tau2), 0.3060, tolerance=.tol[["var"]]) tmp <- predict(res, transf=exp) expect_equivalent(tmp$pred, 0.6728, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 0.4314, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 1.0494, tolerance=.tol[["ci"]]) ### 1.04 in paper }) test_that("results for the Poisson-normal model are correct (measure=='IRR')", { skip_on_cran() res <- rma.glmm(measure="IRR", x1i=x1i, t1i=t1i, x2i=x2i, t2i=t2i, data=dat, model="CM.EL") ### compare with results on page 3055 (Table VIII) expect_equivalent(coef(res), -0.4762, tolerance=.tol[["coef"]]) expect_equivalent(res$se, 0.2377, tolerance=.tol[["se"]]) expect_equivalent(sqrt(res$tau2), 0.3501, tolerance=.tol[["var"]]) tmp <- predict(res, transf=exp) expect_equivalent(tmp$pred, 0.6211, tolerance=.tol[["pred"]]) expect_equivalent(tmp$ci.lb, 0.3898, tolerance=.tol[["ci"]]) expect_equivalent(tmp$ci.ub, 0.9897, tolerance=.tol[["ci"]]) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_lipsey2001.r0000644000176200001440000001126314502306532023364 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:lipsey2001 context("Checking analysis example: lipsey2001") source("settings.r") ### create dataset dat <- data.frame( id = c(100, 308, 1596, 2479, 9021, 9028, 161, 172, 537, 7049), yi = c(-0.33, 0.32, 0.39, 0.31, 0.17, 0.64, -0.33, 0.15, -0.02, 0.00), vi = c(0.084, 0.035, 0.017, 0.034, 0.072, 0.117, 0.102, 0.093, 0.012, 0.067), random = c(0, 0, 0, 0, 0, 0, 1, 1, 1, 1), intensity = c(7, 3, 7, 5, 7, 7, 4, 4, 5, 6)) test_that("results are correct for the equal-effects model.", { res <- rma(yi, vi, data=dat, method="EE") ### compare with results on page 133 (Exhibit 7.3) expect_equivalent(c(as.matrix(coef(summary(res)))), c(0.1549, 0.0609, 2.5450, 0.0109, 0.0356, 0.2742), tolerance=.tol[["misc"]]) expect_equivalent(res$QE, 14.7640, tolerance=.tol[["test"]]) expect_equivalent(res$QEp, 0.0976, tolerance=.tol[["pval"]]) }) test_that("results are correct for the random-effects model.", { res <- rma(yi, vi, data=dat, method="DL") ### compare with results on page 133 (Exhibit 7.3) expect_equivalent(c(as.matrix(coef(summary(res)))), c(0.1534, 0.0858, 1.7893, 0.0736, -0.0146, 0.3215), tolerance=.tol[["misc"]]) expect_equivalent(res$tau2, 0.025955, tolerance=.tol[["var"]]) }) test_that("results are correct for the ANOVA-type analysis.", { res <- rma(yi, vi, mods = ~ random, data=dat, method="FE") res0 <- rma(yi, vi, data=dat, method="EE", subset=random==0) res1 <- rma(yi, vi, data=dat, method="EE", subset=random==1) tmp <- predict(res, newmods=c(0,1)) tmp <- do.call(cbind, unclass(tmp)[1:4]) ### compare with results on page 138 (Exhibit 7.4) expect_equivalent(tmp[1,], c( 0.2984, 0.0813, 0.1390, 0.4578), tolerance=.tol[["pred"]]) expect_equivalent(tmp[2,], c(-0.0277, 0.0917, -0.2075, 0.1521), tolerance=.tol[["se"]]) expect_equivalent(res$QM, 7.0739, tolerance=.tol[["test"]]) ### 7.0738 in chapter expect_equivalent(res$QMp, 0.0078, tolerance=.tol[["pval"]]) expect_equivalent(res$QE, 7.6901, tolerance=.tol[["test"]]) ### 7.6902 in chapter expect_equivalent(res$QEp, 0.4643, tolerance=.tol[["pval"]]) expect_equivalent(res0$QE, 6.4382, tolerance=.tol[["test"]]) ### 6.4383 in chapter expect_equivalent(res0$QEp, 0.2659, tolerance=.tol[["pval"]]) expect_equivalent(res1$QE, 1.2519, tolerance=.tol[["test"]]) expect_equivalent(res1$QEp, 0.7406, tolerance=.tol[["pval"]]) }) test_that("results are correct for the meta-regression analysis (fixed-effects with moderators model).", { res <- rma(yi, vi, mods = ~ random + intensity, data=dat, method="FE") expected <- structure(list(estimate = c(0.32233263, -0.32978043, -0.00408559), se = c(0.29977632, 0.13041815, 0.04928185), zval = c(1.0752438, -2.52863907, -0.08290246), pval = c(0.28226559, 0.01145057, 0.9339291), ci.lb = c(-0.26521816, -0.58539531, -0.10067623), ci.ub = c(0.90988342, -0.07416555, 0.09250506)), row.names = c("intrcpt", "random", "intensity"), class = "data.frame") ### compare with results on page 141 (Exhibit 7.6) expect_equivalent(coef(summary(res)), expected, tolerance=.tol[["misc"]]) expect_equivalent(res$QM, 7.0807, tolerance=.tol[["test"]]) expect_equivalent(res$QMp, 0.0290, tolerance=.tol[["pval"]]) expect_equivalent(res$QE, 7.6832, tolerance=.tol[["test"]]) ### 7.6833 in chapter expect_equivalent(res$QEp, 0.3614, tolerance=.tol[["pval"]]) ### 0.3613 in chapter }) test_that("results are correct for the meta-regression analysis (mixed-effects model).", { res <- rma(yi, vi, mods = ~ random + intensity, data=dat, method="DL") expected <- structure(list(estimate = c(0.33106915, -0.32691858, -0.00682302), se = c(0.31983925, 0.1439395, 0.0528008), zval = c(1.03511109, -2.2712222, -0.12922184), pval = c(0.30061703, 0.02313353, 0.89718211), ci.lb = c(-0.29580425, -0.60903481, -0.11031068), ci.ub = c(0.95794255, -0.04480235, 0.09666464)), row.names = c("intrcpt", "random", "intensity"), class = "data.frame") ### compare with results on page 141 (Exhibit 7.7) expect_equivalent(coef(summary(res)), expected, tolerance=.tol[["misc"]]) expect_equivalent(res$QM, 5.5711, tolerance=.tol[["test"]]) ### 5.5709 in chapter expect_equivalent(res$QMp, 0.0617, tolerance=.tol[["pval"]]) expect_equivalent(res$tau2, 0.00488, tolerance=.tol[["var"]]) }) test_that("results are correct for the comutation of R^2 via the anova() function.", { res.ME <- rma(yi, vi, mods = ~ random + intensity, data=dat, method="DL") res.RE <- rma(yi, vi, data=dat, method="DL") expect_warning(tmp <- anova(res.RE, res.ME)) expect_equivalent(tmp$R2, 81.2023, tolerance=.tol[["r2"]]) }) rm(list=ls()) metafor/tests/testthat/test_plots_radial_plot.r0000644000176200001440000000141614503346376021663 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/plots:radial_plot source("settings.r") context("Checking plots example: radial (Galbraith) plot") test_that("plot can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_radial_plot_test.png", res=200, width=1800, height=1800, type="cairo") ### adjust margins so the space is better used par(mar=c(5,4,0,3)) ### fit equal-effects model res <- rma(yi, vi, data=dat.hackshaw1998, method="EE") ### draw radial plot radial(res) dev.off() expect_true(.vistest("images/test_plots_radial_plot_test.png", "images/test_plots_radial_plot.png")) }) rm(list=ls()) metafor/tests/testthat/test_plots_funnel_plot_with_trim_and_fill.r0000644000176200001440000000200214503346137025617 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/plots:funnel_plot_with_trim_and_fill source("settings.r") context("Checking plots example: funnel plot with trim and fill") test_that("plot can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_funnel_plot_with_trim_and_fill_test.png", res=200, width=1800, height=1500, type="cairo") ### decrease margins so the full space is used par(mar=c(5,4,1,2)) ### fit random-effects model res <- rma(yi, vi, data=dat.hackshaw1998, measure="OR") ### carry out trim-and-fill analysis taf <- trimfill(res) ### draw funnel plot with missing studies filled in funnel(taf, legend=list(show="cis")) dev.off() expect_true(.vistest("images/test_plots_funnel_plot_with_trim_and_fill_test.png", "images/test_plots_funnel_plot_with_trim_and_fill.png")) out <- capture.output(print(taf)) }) rm(list=ls()) metafor/tests/testthat/test_misc_formula.r0000644000176200001440000000141614205476634020630 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: formula() function") source("settings.r") dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) test_that("formula() works correctly for 'rma.uni' objects.", { res <- rma(yi, vi, data=dat, method="DL") expect_null(formula(res, type="mods")) expect_null(formula(res, type="yi")) res <- rma(yi, vi, mods = ~ ablat, data=dat, method="DL") expect_equal(~ablat, formula(res, type="mods")) expect_null(formula(res, type="yi")) res <- rma(yi ~ ablat, vi, data=dat, method="DL") expect_equal(~ablat, formula(res, type="mods")) expect_equal(yi~ablat, formula(res, type="yi")) expect_error(formula(res, type="scale")) }) rm(list=ls()) metafor/tests/testthat/test_misc_weights.r0000644000176200001440000001261014502304043020613 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: weights() function") source("settings.r") test_that("weights are correct for rma() with method='FE'.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### weighted analysis res <- rma(yi, vi, data=dat, method="FE") ### weights should be the same as 1/vi (scaled to percentages) expect_equivalent(weights(res), (1/dat$vi)/sum(1/dat$vi) * 100) ### weights should be the same as 1/vi expect_equivalent(diag(weights(res, type="matrix")), 1/dat$vi) ### weighted analysis with user defined weights res <- rma(yi, vi, data=dat, method="FE", weights=1:13) ### weights should match (scaled to percentages) expect_equivalent(weights(res), (1:13)/sum(1:13) * 100) ### unweighted analysis res <- rma(yi, vi, data=dat, method="FE", weighted=FALSE) ### weights should be the same as 1/k (scaled to percentages) expect_equivalent(weights(res), rep(1/res$k, res$k) * 100) ### unweighted analysis (but user has specified weights nevertheless) res <- rma(yi, vi, data=dat, method="FE", weighted=FALSE, weights=1:13) ### weights should be the same as 1/k (scaled to percentages) expect_equivalent(weights(res), rep(1/res$k, res$k) * 100) }) test_that("weights are correct for rma() with method='DL'.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### weighted analysis res <- rma(yi, vi, data=dat, method="DL") ### weights should be the same as 1/(vi+tau2) (scaled to percentages) expect_equivalent(weights(res), (1/(dat$vi+res$tau2)/sum(1/(dat$vi+res$tau2)) * 100)) ### weights should be the same as 1/(vi+tau2) expect_equivalent(diag(weights(res, type="matrix")), 1/(dat$vi+res$tau2)) ### weighted analysis with user defined weights res <- rma(yi, vi, data=dat, method="DL", weights=1:13) ### weights should match (scaled to percentages) expect_equivalent(weights(res), (1:13)/sum(1:13) * 100) ### unweighted analysis res <- rma(yi, vi, data=dat, method="DL", weighted=FALSE) ### weights should be the same as 1/k (scaled to percentages) expect_equivalent(weights(res), rep(1/res$k, res$k) * 100) ### unweighted analysis (but user has specified weights nevertheless) res <- rma(yi, vi, data=dat, method="FE", weighted=FALSE, weights=1:13) ### weights should be the same as 1/k (scaled to percentages) expect_equivalent(weights(res), rep(1/res$k, res$k) * 100) }) test_that("weights are correct for rma.mv() with method='REML'.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### weighted analysis res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, sparse=.sparse) ### weights should be the same as 1/(vi+sigma2) (scaled to percentages) expect_equivalent(weights(res), (1/(dat$vi+res$sigma2)/sum(1/(dat$vi+res$sigma2)) * 100)) ### weights should be the same as 1/(vi+sigma2) expect_equivalent(diag(weights(res, type="matrix")), 1/(dat$vi+res$sigma2)) ### weighted analysis with user defined weights res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, W=1:13, sparse=.sparse) ### weights should match (scaled to percentages) expect_equivalent(weights(res), (1:13)/sum(1:13) * 100) ### unweighted analysis res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, W=1, sparse=.sparse) ### weights should be the same as 1/k (scaled to percentages) expect_equivalent(weights(res), rep(1/res$k, res$k) * 100) }) test_that("weights are correct for rma.mh() with measure='RD/RR/OR'.", { dat <- dat.bcg res <- rma.mh(measure="RD", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) sav <- weights(res) expect_equivalent(coef(res), sum(res$yi * sav/100), tolerance=.tol[["coef"]]) tmp <- diag(weights(res, type="matrix")) expect_equivalent(sav, tmp/sum(tmp)*100) res <- rma.mh(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) sav <- weights(res) expect_equivalent(exp(coef(res)), sum(exp(res$yi) * sav/100), tolerance=.tol[["coef"]]) tmp <- diag(weights(res, type="matrix")) expect_equivalent(sav, tmp/sum(tmp)*100) res <- rma.mh(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) sav <- weights(res) expect_equivalent(exp(coef(res)), sum(exp(res$yi) * sav/100), tolerance=.tol[["coef"]]) tmp <- diag(weights(res, type="matrix")) expect_equivalent(sav, tmp/sum(tmp)*100) }) test_that("weights are correct for rma.mh() with measure='IRD/IRR'.", { dat <- dat.nielweise2008 res <- rma.mh(measure="IRD", x1i=x1i, t1i=t1i, x2i=x2i, t2i=t2i, data=dat) sav <- weights(res) expect_equivalent(coef(res), sum(res$yi * sav/100), tolerance=.tol[["coef"]]) tmp <- diag(weights(res, type="matrix")) expect_equivalent(sav, tmp/sum(tmp)*100) res <- rma.mh(measure="IRR", x1i=x1i, t1i=t1i, x2i=x2i, t2i=t2i, data=dat) sav <- weights(res) expect_equivalent(exp(coef(res)), sum(exp(res$yi) * sav/100), tolerance=.tol[["coef"]]) tmp <- diag(weights(res, type="matrix")) expect_equivalent(sav, tmp/sum(tmp)*100) }) test_that("weights are correct for rma.peto().", { dat <- dat.bcg res <- rma.peto(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat) sav <- weights(res) expect_equivalent(coef(res), sum(res$yi * sav/100), tolerance=.tol[["coef"]]) tmp <- diag(weights(res, type="matrix")) expect_equivalent(sav, tmp/sum(tmp)*100) }) rm(list=ls()) metafor/tests/testthat/test_plots_labbe_plot.r0000644000176200001440000000142314503346216021463 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/plots:labbe_plot source("settings.r") context("Checking plots example: L'Abbe plot") test_that("plot can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_labbe_plot_test.png", res=200, width=1800, height=1600, type="cairo") ### decrease margins so the full space is used par(mar=c(5,4,1,2)) ### fit random-effects model res <- rma(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, measure="RR") ### draw L'Abbé plot labbe(res) dev.off() expect_true(.vistest("images/test_plots_labbe_plot_test.png", "images/test_plots_labbe_plot.png")) }) rm(list=ls()) metafor/tests/testthat/test_misc_metan_vs_rma.mh_with_dat.bcg.r0000644000176200001440000000534214204414441024643 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: rma.mh() against metan with 'dat.bcg'") source("settings.r") test_that("results match (EE model, measure='RR').", { ### compare results with: metan tpos tneg cpos cneg, fixed nograph rr log res <- rma.mh(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) expect_equivalent(res$beta, -0.4537, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -0.5308, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, -0.3766, tolerance=.tol[["ci"]]) expect_equivalent(res$zval, -11.5338, tolerance=.tol[["test"]]) ### 11.53 in Stata expect_equivalent(res$QE, 152.5676, tolerance=.tol[["test"]]) ### compare results with: metan tpos tneg cpos cneg, fixed nograph rr sav <- predict(res, transf=exp) expect_equivalent(sav$pred, 0.6353, tolerance=.tol[["est"]]) expect_equivalent(sav$ci.lb, 0.5881, tolerance=.tol[["ci"]]) expect_equivalent(sav$ci.ub, 0.6862, tolerance=.tol[["ci"]]) }) test_that("results match (EE model, measure='OR').", { ### compare results with: metan tpos tneg cpos cneg, fixed nograph or log res <- rma.mh(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) expect_equivalent(res$beta, -0.4734, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -0.5538, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, -0.3930, tolerance=.tol[["ci"]]) expect_equivalent(res$zval, -11.5444, tolerance=.tol[["test"]]) ### 11.54 in Stata expect_equivalent(res$QE, 163.9426, tolerance=.tol[["test"]]) ### compare results with: metan tpos tneg cpos cneg, fixed nograph or sav <- predict(res, transf=exp) expect_equivalent(sav$pred, 0.6229, tolerance=.tol[["pred"]]) expect_equivalent(sav$ci.lb, 0.5748, tolerance=.tol[["ci"]]) expect_equivalent(sav$ci.ub, 0.6750, tolerance=.tol[["ci"]]) }) test_that("results match (EE model, measure='RD').", { ### compare results with: metan tpos tneg cpos cneg, fixed nograph rd res <- rma.mh(measure="RD", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) expect_equivalent(res$beta, -0.0033, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -0.0039, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, -0.0027, tolerance=.tol[["ci"]]) expect_equivalent(res$zval, -11.4708, tolerance=.tol[["test"]]) ### 11.56 in Stata expect_equivalent(res$QE, 386.7759, tolerance=.tol[["test"]]) # zval is slightly different, as metan apparently computes the SE as # described in Greenland & Robins (1985) while metafor uses the equation # given in Sato, Greenland, & Robins (1989) (only the latter is # asymptotically correct in both the sparse-data and large-strata case) }) rm(list=ls()) metafor/tests/testthat/test_misc_confint.r0000644000176200001440000000256214231264165020617 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: confint() function") source("settings.r") test_that("confint() works correctly for 'rma.uni' objects.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, data=dat, method="DL") sav <- confint(res, fixed=TRUE, transf=exp) expect_equivalent(sav$fixed, c(0.4896, 0.3449, 0.6950), tolerance=.tol[["ci"]]) expect_equivalent(sav$random[1,], c(0.3088, 0.1197, 1.1115), tolerance=.tol[["var"]]) expect_equivalent(sav$random[3,], c(92.1173, 81.9177, 97.6781), tolerance=.tol[["het"]]) expect_equivalent(sav$random[4,], c(12.6861, 5.5303, 43.0680), tolerance=.tol[["het"]]) sav <- round(as.data.frame(sav), 4) expect_equivalent(sav[,1], c(0.4896, 0.3088, 0.5557, 92.1173, 12.6861)) }) test_that("confint() works correctly for 'rma.mh' objects.", { res <- rma.mh(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) sav <- confint(res, transf=exp) expect_equivalent(sav$fixed, c(0.6353, 0.5881, 0.6862), tolerance=.tol[["ci"]]) }) test_that("confint() works correctly for 'rma.peto' objects.", { res <- rma.peto(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) sav <- confint(res, transf=exp) expect_equivalent(sav$fixed, c(0.6222, 0.5746, 0.6738), tolerance=.tol[["ci"]]) }) rm(list=ls()) metafor/tests/testthat/test_misc_rma_glmm.r0000644000176200001440000002074614502344133020751 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: rma.glmm() function") source("settings.r") dat <- dat.nielweise2007 test_that("rma.glmm() works correctly for 'UM.FS' model.", { expect_warning(res <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="UM.FS", method="EE")) out <- capture.output(print(res)) expect_equivalent(coef(res), -1.2286, tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, 0, tolerance=.tol[["var"]]) expect_warning(res <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="UM.FS", test="t")) out <- capture.output(print(res)) expect_equivalent(coef(res), -1.2370, tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, 0.3198, tolerance=.tol[["var"]]) ### check some (current) stop()'s expect_error(confint(res)) expect_error(plot(res)) expect_error(qqnorm(res)) expect_error(weights(res)) skip_on_cran() ### check GLMMadaptive and glmmTMB results expect_warning(res <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="UM.FS", test="t", control=list(package="GLMMadaptive"))) expect_equivalent(coef(res), -1.236772, tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, 0.322732, tolerance=.tol[["var"]]) expect_warning(res <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="UM.FS", test="t", control=list(package="glmmTMB"))) expect_equivalent(coef(res), -1.2372, tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, 0.3312, tolerance=.tol[["var"]]) }) test_that("rma.glmm() works correctly for 'UM.RS' model.", { expect_warning(res <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="UM.RS", method="EE")) out <- capture.output(print(res)) expect_equivalent(coef(res), -1.2207, tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, 0, tolerance=.tol[["var"]]) expect_equivalent(res$sigma2, 0.6155, tolerance=.tol[["var"]]) expect_warning(res <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="UM.RS", test="t")) out <- capture.output(print(res)) expect_equivalent(coef(res), -1.2812, tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, 0.7258, tolerance=.tol[["var"]]) expect_equivalent(res$sigma2, 0.5212, tolerance=.tol[["var"]]) ### check some (current) stop()'s expect_error(confint(res)) expect_error(plot(res)) expect_error(qqnorm(res)) expect_error(weights(res)) skip_on_cran() ### check GLMMadaptive and glmmTMB results expect_warning(res <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="UM.RS", test="t", control=list(package="GLMMadaptive"))) expect_equivalent(coef(res), -1.2795, tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, 0.7301, tolerance=.tol[["var"]]) expect_equivalent(res$sigma2, 0.5364, tolerance=.tol[["var"]]) expect_warning(res <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="UM.RS", test="t", control=list(package="glmmTMB"))) expect_equivalent(coef(res), -1.2812, tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, 0.7258, tolerance=.tol[["var"]]) expect_equivalent(res$sigma2, 0.5212, tolerance=.tol[["var"]]) }) test_that("rma.glmm() works correctly when using 'clogit' or 'clogistic'.", { skip_on_cran() expect_warning(res1 <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL", method="EE")) expect_warning(res2 <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL", method="EE", control=list(optimizer="clogit"))) expect_warning(res3 <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL", method="EE", control=list(optimizer="clogistic"))) expect_equivalent(coef(res1), -1.2236, tolerance=.tol[["coef"]]) expect_equivalent(coef(res2), -1.2236, tolerance=.tol[["coef"]]) expect_equivalent(coef(res3), -1.2236, tolerance=.tol[["coef"]]) expect_equivalent(c(vcov(res1)), 0.0502, tolerance=.tol[["var"]]) expect_equivalent(c(vcov(res2)), 0.0502, tolerance=.tol[["var"]]) expect_equivalent(c(vcov(res3)), 0.0502, tolerance=.tol[["var"]]) }) test_that("rma.glmm() works correctly for 'CM.EL' model.", { skip_on_cran() expect_warning(res1 <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL")) expect_warning(res2 <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL", control=list(optimizer="Nelder-Mead", hessianCtrl=list(d=0.00001)))) expect_warning(res3 <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL", control=list(optimizer="BFGS"))) expect_warning(res4 <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL", control=list(optimizer="bobyqa"))) expect_warning(res5 <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL", control=list(optimizer="nloptr"))) expect_warning(res6 <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL", control=list(optimizer="hjk"))) expect_warning(res7 <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL", control=list(optimizer="nmk", hessianCtrl=list(r=4)))) expect_warning(res8 <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL", control=list(optimizer="mads", hessianCtrl=list(r=4)))) expect_warning(res9 <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL", control=list(optimizer="ucminf", optCtrl=list(xtol=1e-6)))) expect_warning(res10 <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL", control=list(optimizer="lbfgsb3c"))) expect_warning(res11 <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL", control=list(optimizer="subplex", hessianCtrl=list(r=4)))) expect_warning(res12 <- rma.glmm(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat, model="CM.EL", control=list(optimizer="BBoptim"))) expect_equivalent(coef(res1), -1.353158, tolerance=.tol[["coef"]]) expect_equivalent(coef(res2), -1.354041, tolerance=.tol[["coef"]]) expect_equivalent(coef(res3), -1.353158, tolerance=.tol[["coef"]]) expect_equivalent(coef(res4), -1.353158, tolerance=.tol[["coef"]]) expect_equivalent(coef(res5), -1.352573, tolerance=.tol[["coef"]]) expect_equivalent(coef(res6), -1.353160, tolerance=.tol[["coef"]]) expect_equivalent(coef(res7), -1.359295, tolerance=.tol[["coef"]]) expect_equivalent(coef(res8), -1.354186, tolerance=.tol[["coef"]]) expect_equivalent(coef(res9), -1.353158, tolerance=.tol[["coef"]]) expect_equivalent(coef(res10), -1.353170, tolerance=.tol[["coef"]]) expect_equivalent(coef(res11), -1.354171, tolerance=.tol[["coef"]]) expect_equivalent(coef(res12), -1.353158, tolerance=.tol[["coef"]]) expect_equivalent(c(vcov(res1)), 0.1232445, tolerance=.tol[["var"]]) expect_equivalent(c(vcov(res2)), 0.1227803, tolerance=.tol[["var"]]) expect_equivalent(c(vcov(res3)), 0.1231863, tolerance=.tol[["var"]]) expect_equivalent(c(vcov(res4)), 0.1231865, tolerance=.tol[["var"]]) expect_equivalent(c(vcov(res5)), 0.1230846, tolerance=.tol[["var"]]) expect_equivalent(c(vcov(res6)), 0.1231713, tolerance=.tol[["var"]]) expect_equivalent(c(vcov(res7)), 0.0412516, tolerance=.tol[["var"]]) # :( expect_equivalent(c(vcov(res8)), 0.0404966, tolerance=.tol[["var"]]) # :( expect_equivalent(c(vcov(res9)), 0.1232442, tolerance=.tol[["var"]]) expect_equivalent(c(vcov(res10)), 0.1232348, tolerance=.tol[["var"]]) expect_equivalent(c(vcov(res11)), 0.0404973, tolerance=.tol[["var"]]) # :( expect_equivalent(c(vcov(res12)), 0.1233028, tolerance=.tol[["var"]]) expect_equivalent(res1$tau2, 0.6935, tolerance=.tol[["var"]]) expect_equivalent(res2$tau2, 0.6945, tolerance=.tol[["var"]]) expect_equivalent(res3$tau2, 0.6935, tolerance=.tol[["var"]]) expect_equivalent(res4$tau2, 0.6935, tolerance=.tol[["var"]]) expect_equivalent(res5$tau2, 0.6937, tolerance=.tol[["var"]]) expect_equivalent(res6$tau2, 0.6935, tolerance=.tol[["var"]]) expect_equivalent(res7$tau2, 0.7043, tolerance=.tol[["var"]]) expect_equivalent(res8$tau2, 0.6944, tolerance=.tol[["var"]]) expect_equivalent(res9$tau2, 0.6935, tolerance=.tol[["var"]]) expect_equivalent(res10$tau2, 0.6935, tolerance=.tol[["var"]]) expect_equivalent(res11$tau2, 0.6944, tolerance=.tol[["var"]]) expect_equivalent(res12$tau2, 0.6935, tolerance=.tol[["var"]]) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_viechtbauer2005.r0000644000176200001440000000646714204414304024372 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:viechtbauer2005 context("Checking analysis example: viechtbauer2005") source("settings.r") ### create dataset for example 1 dat <- data.frame( id=1:10, yi = c(-0.581, 0.530, 0.771, 1.031, 0.553, 0.295, 0.078, 0.573, -0.176, -0.232), vi = c(0.023, 0.052, 0.060, 0.115, 0.095, 0.203, 0.200, 0.211, 0.051, 0.040)) test_that("results are correct for example 1.", { res.HS <- rma(yi, vi, data=dat, method="HS") res.HE <- rma(yi, vi, data=dat, method="HE") res.DL <- rma(yi, vi, data=dat, method="DL") res.ML <- rma(yi, vi, data=dat, method="ML") res.REML <- rma(yi, vi, data=dat, method="REML") res.EB <- rma(yi, vi, data=dat, method="EB") res.SJ <- rma(yi, vi, data=dat, method="SJ") res <- list(res.HS, res.HE, res.DL, res.ML, res.REML, res.EB, res.SJ) res <- data.frame(method=sapply(res, function(x) x$method), tau2=sapply(res, function(x) x$tau2), I2=sapply(res, function(x) x$I2), H2=sapply(res, function(x) x$H2), se.tau2=sapply(res, function(x) x$se.tau2)) ### compare with results on page 271 expect_equivalent(res$tau2, c(0.2282, 0.1484, 0.2768, 0.1967, 0.2232, 0.192, 0.1992), tolerance=.tol[["var"]]) expect_equivalent(res$I2, c(77.2284, 68.7988, 80.4447, 74.5098, 76.8399, 74.0511, 74.7545), tolerance=.tol[["het"]]) expect_equivalent(res$H2, c(4.3914, 3.205, 5.1137, 3.9231, 4.3178, 3.8537, 3.9611), tolerance=.tol[["het"]]) expect_equivalent(res$se.tau2, c(0.1328, 0.1234, 0.1841, 0.1255, 0.1464, 0.133, 0.0979), tolerance=.tol[["sevar"]]) }) ### create dataset for example 2 dat <- data.frame( id=1:18, yi = c(0.100, -0.162, -0.090, -0.049, -0.046, -0.010, -0.431, -0.261, 0.134, 0.019, 0.175, 0.056, 0.045, 0.103, 0.121, -0.482, 0.290, 0.342), vi = c(0.016, 0.015, 0.050, 0.050, 0.032, 0.052, 0.036, 0.024, 0.034, 0.033, 0.031, 0.034, 0.039, 0.167, 0.134, 0.096, 0.016, 0.035)) test_that("results are correct for example 2.", { res.HS <- rma(yi, vi, data=dat, method="HS") res.HE <- rma(yi, vi, data=dat, method="HE") res.DL <- rma(yi, vi, data=dat, method="DL") res.ML <- rma(yi, vi, data=dat, method="ML") res.REML <- rma(yi, vi, data=dat, method="REML") res.EB <- rma(yi, vi, data=dat, method="EB") res.SJ <- rma(yi, vi, data=dat, method="SJ") res <- list(res.HS, res.HE, res.DL, res.ML, res.REML, res.EB, res.SJ) res <- data.frame(method=sapply(res, function(x) x$method), tau2=sapply(res, function(x) x$tau2), I2=sapply(res, function(x) x$I2), H2=sapply(res, function(x) x$H2), se.tau2=sapply(res, function(x) x$se.tau2)) ### compare with results on page 272 expect_equivalent(res$tau2, c(0.0099, 0, 0.0126, 0.0132, 0.0157, 0.0104, 0.0248), tolerance=.tol[["var"]]) expect_equivalent(res$I2, c(22.9266, 0, 27.5275, 28.4505, 32.0203, 23.7198, 42.6734), tolerance=.tol[["het"]]) expect_equivalent(res$H2, c(1.2975, 1, 1.3798, 1.3976, 1.471, 1.311, 1.7444), tolerance=.tol[["het"]]) expect_equivalent(res$se.tau2, c(0.0138, 0.0217, 0.0159, 0.0151, 0.0167, 0.0156, 0.0118), tolerance=.tol[["sevar"]]) }) rm(list=ls()) metafor/tests/testthat/test_misc_calc_q.r0000644000176200001440000000736214244642437020412 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: computation of Q-test") source("settings.r") test_that("computation is correct for 'dat.bcg'.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, data=dat) expect_equivalent(res$QE, 152.23301, tolerance=.tol[["test"]]) expect_equivalent(res$QEp, 0, tolerance=.tol[["pval"]]) res <- rma(yi, vi, mods = ~ ablat, data=dat) expect_equivalent(res$QE, 30.73309, tolerance=.tol[["test"]]) expect_equivalent(res$QEp, 0.001214, tolerance=.tol[["pval"]]) }) perm <- function(v) { n <- length(v) if (n == 1) { v } else { X <- NULL for (i in 1:n) X <- rbind(X, cbind(v[i], perm(v[-i]))) X } } test_that("the computation is correct for measurements of the Planck constant.", { dat <- read.table(header=TRUE, text=" exp h uh NRC-17 6.62607013300 6.00e-08 NMIJ-17 6.62607005883 1.65e-07 NIST-17 6.62606993400 8.90e-08") perms <- perm(1:nrow(dat)) QE <- rep(NA_real_, nrow(dat)) QEp <- rep(NA_real_, nrow(dat)) for (i in 1:nrow(perms)) { tmp <- dat[perms[i,],] res <- rma(yi=h, sei=uh, data=tmp, method="DL") QE[i] <- res$QE QEp[i] <- res$QEp } expect_equivalent(QE, rep(3.442127, length(QE)), tolerance=.tol[["test"]]) expect_equivalent(QEp, rep(0.1788758, length(QEp)), tolerance=.tol[["pval"]]) }) test_that("the computation is correct for measurements of the Newtonian gravitational constant.", { dat <- read.table(header=TRUE, text=" label G uG NIST-82 6.67248 0.00043 TR&D-96 6.6729 0.00050 LANL-97 6.67398 0.00070 UWash-00 6.674255 0.000092 BIPM-01 6.67559 0.00027 UWup-02 6.67422 0.00098 MSL-03 6.67387 0.00027 HUST-05 6.67222 0.00087 UZur-06 6.67425 0.00012 HUST-09 6.67349 0.00018 BIPM-14 6.67554 0.00016 LENS-14 6.67191 0.00099 UCI-14 6.67435 0.00013 HUSTT-18 6.674184 0.000078 HUSTA-18 6.674484 0.000077 JILA-18 6.67260 0.00025") QE <- rep(NA_real_, 100) QEp <- rep(NA_real_, 100) set.seed(1234) for (i in 1:100) { tmp <- dat[sample(nrow(dat)),] res <- rma(yi=G, sei=uG, data=tmp, method="DL") QE[i] <- res$QE QEp[i] <- res$QEp } expect_equivalent(QE, rep(197.8399, length(QE)), tolerance=.tol[["test"]]) expect_equivalent(QEp, rep(0, length(QEp)), tolerance=.tol[["pval"]]) }) test_that("the computation is correct for measurements Planck constant.", { dat <- read.table(header=TRUE, text=" label h uh NPL-79 6.626073000 6.70e-06 NIST-80 6.626065800 8.80e-06 NMI-89 6.626068400 3.60e-06 NPL-90 6.626068200 1.30e-06 PTB-91 6.626067000 4.20e-06 NIM-95 6.626071000 1.10e-05 NIST-98 6.626068910 5.80e-07 IAC-11 6.626069890 2.00e-07 METAS-11 6.626069100 2.00e-06 NPL-12 6.626071200 1.30e-06 IAC-15 6.626070150 1.30e-07 LNE-15 6.626068800 1.70e-06 NIST-15 6.626069360 3.80e-07 NRC-17 6.626070133 6.00e-08 LNE-17 6.626070410 3.80e-07 NMIJ-17 6.626070059 1.65e-07 NIM-17 6.626069200 1.60e-06 IAC-17 6.626070404 7.92e-08") QE <- rep(NA_real_, 100) QEp <- rep(NA_real_, 100) set.seed(1234) for (i in 1:100) { tmp <- dat[sample(nrow(dat)),] res <- rma(yi=h, sei=uh, data=tmp, method="DL") QE[i] <- res$QE QEp[i] <- res$QEp } expect_equivalent(QE, rep(26.63226, length(QE)), tolerance=.tol[["test"]]) expect_equivalent(QEp, rep(0.06368617, length(QEp)), tolerance=.tol[["pval"]]) }) rm(list=ls()) metafor/tests/testthat/test_misc_update.r0000644000176200001440000000367014502304035020432 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: update() function") source("settings.r") test_that("update() works for rma().", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res1 <- rma(yi, vi, data=dat, method="EE") res2 <- update(res1, method="DL") res3 <- rma(yi, vi, data=dat, method="DL") res4 <- update(res3, ~ ablat) res5 <- rma(yi, vi, mods = ~ ablat, data=dat, method="DL") res2$time <- NULL res3$time <- NULL res4$time <- NULL res5$time <- NULL expect_equivalent(res2, res3) expect_equivalent(res4, res5) }) test_that("update() works for rma.mv().", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res1 <- rma.mv(yi, vi, data=dat, method="EE", sparse=.sparse) res2 <- update(res1, random = ~ 1 | trial, method="REML") res3 <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, method="REML", sparse=.sparse) res4 <- update(res3, ~ ablat) res5 <- rma.mv(yi, vi, random = ~ 1 | trial, mods = ~ ablat, data=dat, method="REML", sparse=.sparse) res2$time <- NULL res3$time <- NULL res4$time <- NULL res5$time <- NULL expect_equivalent(res2, res3) expect_equivalent(res4, res5) }) test_that("update() works for rma.glmm().", { skip_on_cran() dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res1 <- rma.glmm(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, method="EE") res2 <- update(res1, method="ML") res3 <- rma.glmm(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, method="ML") res4 <- update(res3, mods = ~ ablat) res5 <- rma.glmm(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, mods = ~ ablat, data=dat.bcg, method="ML") res2$time <- NULL res3$time <- NULL res4$time <- NULL res5$time <- NULL expect_equivalent(res2, res3) expect_equivalent(res4, res5) }) rm(list=ls()) metafor/tests/testthat/test_tips_regression_with_rma.r0000644000176200001440000000412614204414717023253 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking tip: rma() results match up with those from lm()") source("settings.r") ### this is essentially checking the equivalence of the results as explained here: ### https://www.metafor-project.org/doku.php/tips:regression_with_rma test_that("results for rma() and lm() match for method='FE'.", { stackloss$vi <- 0 res.lm <- lm(stack.loss ~ Air.Flow + Water.Temp + Acid.Conc., data=stackloss) res.rma <- rma(stack.loss, vi, mods = ~ Air.Flow + Water.Temp + Acid.Conc., data=stackloss, test="knha", control=list(REMLf=FALSE)) ### log likelihood (REML) should be the same expect_equivalent(logLik(res.lm, REML=TRUE), logLik(res.rma), tolerance=.tol[["fit"]]) ### coefficients should be the same expect_equivalent(coef(res.lm), coef(res.rma), tolerance=.tol[["coef"]]) ### var-cov matrix should be the same expect_equivalent(matrix(vcov(res.lm), nrow=4, ncol=4), matrix(vcov(res.rma), nrow=4, ncol=4), tolerance=.tol[["var"]]) ### fitted values should be the same expect_equivalent(fitted(res.lm), fitted(res.rma), tolerance=.tol[["pred"]]) ### standardized residuals should be the same expect_equivalent(rstandard(res.lm), rstandard(res.rma)$z, tolerance=.tol[["test"]]) ### studentized residuals should be the same expect_equivalent(rstudent(res.lm), rstudent(res.rma)$z, tolerance=.tol[["test"]]) ### hat values should be the same expect_equivalent(hatvalues(res.lm), hatvalues(res.rma), tolerance=.tol[["inf"]]) ### dffits should be the same expect_equivalent(dffits(res.lm), influence(res.rma)$inf$dffits, tolerance=.tol[["inf"]]) ### covratios should be the same expect_equivalent(covratio(res.lm), influence(res.rma)$inf$cov.r, tolerance=.tol[["inf"]]) ### dfbetas should be the same expect_equivalent(as.matrix(dfbetas(res.lm)), as.matrix(dfbetas(res.rma)), tolerance=.tol[["inf"]]) ### Cook's distancs should differ by a factor of p expect_equivalent(cooks.distance(res.lm), cooks.distance(res.rma)/res.rma$p, tolerance=.tol[["inf"]]) }) rm(list=ls()) metafor/tests/testthat/test_plots_plot_of_cumulative_results.r0000644000176200001440000000215014503346334025040 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/plots:plot_of_cumulative_results source("settings.r") context("Checking plots example: plot of cumulative results") test_that("plot can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_plot_of_cumulative_results_test.png", res=200, width=1800, height=1600, type="cairo") ### decrease margins so the more space is used par(mar=c(5,5,2,2)) ### calculate log risk ratios and corresponding sampling variances dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### fit random-effects models res <- rma(yi, vi, data=dat) ### cumulative meta-analysis (in the order of publication year) tmp <- cumul(res, order=year) ### plot of cumulative results plot(tmp, transf=exp, xlim=c(0.25,0.5), lwd=3, cex=1.3) dev.off() expect_true(.vistest("images/test_plots_plot_of_cumulative_results_test.png", "images/test_plots_plot_of_cumulative_results.png")) }) rm(list=ls()) metafor/tests/testthat/test_misc_selmodel.r0000644000176200001440000002307014503345722020761 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: selmodel() function") source("settings.r") test_that("results are correct for a step function model.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() dat <- dat.hackshaw1998 res <- rma(yi, vi, data=dat) sav <- selmodel(res, type="stepfun", steps=c(0.05, 0.10, 0.50, 1.00)) out <- capture.output(print(sav)) expect_equivalent(coef(sav)$delta, c(1, 2.422079, 0.977543, 0.396713), tolerance=.tol[["coef"]]) expect_equivalent(sav$se.delta, c(NA, 1.66085, 0.820387, 0.469235), tolerance=.tol[["se"]]) expect_equivalent(sav$LRT, 7.066137, tolerance=.tol[["test"]]) expect_identical(sav$LRTdf, 3L) expect_equivalent(sav$tau2, 0.03071325, tolerance=.tol[["var"]]) png(filename="images/test_misc_selmodel_1_test.png", res=200, width=1800, height=1600, type="cairo") plot(sav) dev.off() expect_true(.vistest("images/test_misc_selmodel_1_test.png", "images/test_misc_selmodel_1.png")) tmp <- confint(sav) expect_equivalent(tmp[[1]]$random[1,], c(0.030713, 0.000224, 0.135284), tolerance=.tol[["var"]]) expect_equivalent(tmp[[2]]$random[1,], c(2.422079, 0.665133, 9.915798), tolerance=.tol[["coef"]]) expect_equivalent(tmp[[3]]$random[1,], c(0.977543, 0.209558, 5.386044), tolerance=.tol[["coef"]]) expect_equivalent(tmp[[4]]$random[1,], c(0.396713, 0.040198, 4.119681), tolerance=.tol[["coef"]]) }) test_that("results are correct for the beta function model.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() # data from Baskerville, N. B., Liddy, C., & Hogg, W. (2012). Systematic # review and meta-analysis of practice facilitation within primary care # settings. Annals of Family Medicine, 10(1), 63-74. yi <- c(1.01, 0.82, 0.59, 0.44, 0.84, 0.73, 1.12, 0.04, 0.24, 0.32, 1.04, 1.31, 0.59, 0.66, 0.62, 0.47, 1.08, 0.98, 0.26, 0.39, 0.60, 0.94, 0.11) sei <- c(0.52, 0.46, 0.23, 0.18, 0.29, 0.29, 0.36, 0.37, 0.15, 0.40, 0.32, 0.57, 0.29, 0.19, 0.31, 0.27, 0.32, 0.32, 0.18, 0.18, 0.31, 0.53, 0.27) xi <- c(1, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1) res <- rma(yi, sei^2, method="ML") sav <- selmodel(res, type="beta", delta=c(1,1)) expect_equivalent(logLik(res), logLik(sav), tolerance=.tol[["fit"]]) sav <- selmodel(res, type="beta") out <- capture.output(print(sav)) expect_equivalent(coef(sav)$delta, c(0.4731131, 4.4613162), tolerance=.tol[["coef"]]) expect_equivalent(sav$se.delta, c(0.2352481, 2.1841983), tolerance=.tol[["se"]]) expect_equivalent(sav$LRT, 7.846907, tolerance=.tol[["test"]]) expect_identical(sav$LRTdf, 2L) expect_equivalent(sav$tau2, 0.00000243, tolerance=.tol[["var"]]) png(filename="images/test_misc_selmodel_2_test.png", res=200, width=1800, height=1600, type="cairo") plot(sav) dev.off() expect_true(.vistest("images/test_misc_selmodel_2_test.png", "images/test_misc_selmodel_2.png")) res <- rma(yi, sei^2, mods = ~ xi, method="ML") sav <- selmodel(res, type="beta") out <- capture.output(print(sav)) expect_equivalent(coef(sav)$delta, c(0.4200973, 5.0959707), tolerance=.tol[["coef"]]) expect_equivalent(sav$se.delta, c(0.2391269, 2.4108796), tolerance=.tol[["se"]]) expect_equivalent(sav$LRT, 9.044252, tolerance=.tol[["test"]]) expect_identical(sav$LRTdf, 2L) expect_equivalent(sav$tau2, 0.00000193, tolerance=.tol[["var"]]) expect_equivalent(coef(sav)$beta, c(0.1343001, -0.1363559), tolerance=.tol[["coef"]]) expect_equivalent(sav$se, c(0.1707418, 0.1244394), tolerance=.tol[["se"]]) }) test_that("results are correct for the various exponential function models.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() # data from Preston, C., Ashby, D., & Smyth, R. (2004). Adjusting for # publication bias: Modelling the selection process. Journal of Evaluation # in Clinical Practice, 10(2), 313-322. ai <- c(4,0,34,7,6,1,0,11,2,0,0,33) n1i <- c(19,18,341,71,45,94,22,88,82,33,15,221) ci <- c(5,0,50,16,5,8,0,12,7,0,1,43) n2i <- c(19,18,334,69,44,96,22,82,84,30,20,218) dat <- escalc(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, drop00=TRUE) expect_warning(res <- rma(yi, vi, data=dat, method="EE")) alternative <- "less" sav1 <- selmodel(res, type="halfnorm", alternative=alternative) sav2 <- selmodel(res, type="negexp", alternative=alternative) sav3 <- selmodel(res, type="logistic", alternative=alternative) sav4 <- selmodel(res, type="power", alternative=alternative) expect_equivalent(c(sav1$delta, sav2$delta, sav3$delta, sav4$delta), c(3.162948, 2.656714, 3.339338, 1.458923), tolerance=.tol[["coef"]]) expect_equivalent(c(sav1$se.delta, sav2$se.delta, sav3$se.delta, sav4$se.delta), c(2.988922, 2.347468, 2.388776, 1.393725), tolerance=.tol[["se"]]) png(filename="images/test_misc_selmodel_profile_1_test.png", res=200, width=1800, height=1600, type="cairo") tmp <- profile(sav1, progbar=FALSE) dev.off() expect_true(.vistest("images/test_misc_selmodel_profile_1_test.png", "images/test_misc_selmodel_profile_1.png")) expect_equivalent(tmp$ll, c(NA, -6.569986, -6.35659, -6.210436, -6.121035, -6.07939, -6.077928, -6.110356, -6.171488, -6.257068, -6.363607, -6.488238, -6.628599, -6.782733, -6.949015, -7.126075, -7.312763, -7.508097, -7.711241, -7.921472), tolerance=.tol[["fit"]]) sav1 <- selmodel(res, type="halfnorm", prec="sei", alternative=alternative, scaleprec=FALSE) sav2 <- selmodel(res, type="negexp", prec="sei", alternative=alternative, scaleprec=FALSE) sav3 <- selmodel(res, type="logistic", prec="sei", alternative=alternative, scaleprec=FALSE) sav4 <- selmodel(res, type="power", prec="sei", alternative=alternative, scaleprec=FALSE) expect_equivalent(c(sav1$delta, sav2$delta, sav3$delta, sav4$delta), c(3.506329, 2.279336, 3.017851, 1.444174), tolerance=.tol[["coef"]]) expect_equivalent(c(sav1$se.delta, sav2$se.delta, sav3$se.delta, sav4$se.delta), c(3.387300, 2.133013, 2.315789, 1.381633), tolerance=.tol[["se"]]) sav1 <- selmodel(res, type="halfnorm", prec="sei", alternative=alternative, steps=.05) sav2 <- selmodel(res, type="negexp", prec="sei", alternative=alternative, steps=.05) sav3 <- selmodel(res, type="logistic", prec="sei", alternative=alternative, steps=.05) sav4 <- selmodel(res, type="power", prec="sei", alternative=alternative, steps=.05, control=list(hessianCtrl=list(r=8))) expect_equivalent(c(sav1$delta, sav2$delta, sav3$delta, sav4$delta), c(5.832106, 3.819847, 5.041039, 2.399645), tolerance=.tol[["coef"]]) expect_equivalent(c(sav1$se.delta, sav2$se.delta, sav3$se.delta, sav4$se.delta), c(5.644466, 3.627467, 2.306998, 2.134629), tolerance=.tol[["se"]]) sav <- selmodel(res, type="negexppow", alternative=alternative) expect_equivalent(sav$delta, c(2.673818, 1.153199), tolerance=.tol[["coef"]]) expect_equivalent(sav$se.delta, c(2.363403, 2.143849), tolerance=.tol[["se"]]) }) test_that("results are correct for a pirori chosen step function models.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() tab <- data.frame( steps = c(0.005, 0.01, 0.05, 0.10, 0.25, 0.35, 0.50, 0.65, 0.75, 0.90, 0.95, 0.99, 0.995, 1), delta.mod.1 = c(1, 0.99, 0.95, 0.80, 0.75, 0.65, 0.60, 0.55, 0.50, 0.50, 0.50, 0.50, 0.50, 0.50), delta.sev.1 = c(1, 0.99, 0.90, 0.75, 0.60, 0.50, 0.40, 0.35, 0.30, 0.25, 0.10, 0.10, 0.10, 0.10), delta.mod.2 = c(1, 0.99, 0.95, 0.90, 0.80, 0.75, 0.60, 0.60, 0.75, 0.80, 0.90, 0.95, 0.99, 1.00), delta.sev.2 = c(1, 0.99, 0.90, 0.75, 0.60, 0.50, 0.25, 0.25, 0.50, 0.60, 0.75, 0.90, 0.99, 1.00)) dat <- dat.cohen1981 dat <- escalc(measure="ZCOR", ri=ri, ni=ni, data=dat[c(1,4,5)]) res <- rma(yi, vi, data=dat, method="ML") sav <- lapply(tab[-1], function(x) selmodel(res, type="stepfun", steps=tab$steps, delta=x, defmap=TRUE)) expect_equivalent(sapply(sav, function(x) x$beta), c(0.351894, 0.321518, 0.362019, 0.33218), tolerance=.tol[["coef"]]) expect_equivalent(sapply(sav, function(x) x$tau2), c(0.0045, 0.009544, 0.002774, 0.005652), tolerance=.tol[["var"]]) }) test_that("results are correct for a truncated distribution model.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() dat <- dat.hackshaw1998 res <- rma(yi, vi, data=dat, method="ML") sav <- selmodel(res, type="trunc") out <- capture.output(print(sav)) expect_equivalent(coef(sav)$delta, 0.3818424, tolerance=.tol[["coef"]]) expect_equivalent(sav$se.delta, 0.2235527, tolerance=.tol[["se"]]) expect_equivalent(sav$LRT, 3.054457, tolerance=.tol[["test"]]) expect_identical(sav$LRTdf, 1L) expect_equivalent(sav$tau2, 0.02677134, tolerance=.tol[["var"]]) tmp <- confint(sav) expect_equivalent(tmp[[1]]$random[1,], c(0.026771, 0.001693, 0.099835), tolerance=.tol[["var"]]) expect_equivalent(tmp[[2]]$random[1,], c(0.381842, 0.108796, 1.116679), tolerance=.tol[["coef"]]) png(filename="images/test_misc_selmodel_profile_2_test.png", res=200, width=1800, height=1600, type="cairo") tmp <- profile(sav, cline=TRUE, progbar=FALSE) dev.off() expect_true(.vistest("images/test_misc_selmodel_profile_2_test.png", "images/test_misc_selmodel_profile_2.png")) res <- rma(yi, vi, data=dat, method="EE") sav <- selmodel(res, type="truncest") expect_equivalent(coef(sav)$delta, c(0.2336542, 0.4690409), tolerance=.tol[["coef"]]) sav <- selmodel(res, type="truncest", control=list(optimizer="mads")) expect_equivalent(coef(sav)$delta, c(0.1802357, 0.4187099), tolerance=.tol[["coef"]]) }) rm(list=ls()) metafor/tests/testthat/test_misc_vec2mat.r0000644000176200001440000000162414401707130020507 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: vec2mat() function") source("settings.r") test_that("vec2mat() works correctly.", { sav <- vec2mat(1:6, corr=FALSE) expect_identical(sav, structure(c(NA, 1, 2, 3, 1, NA, 4, 5, 2, 4, NA, 6, 3, 5, 6, NA), .Dim = c(4L, 4L))) sav <- vec2mat(round(seq(0.2, 0.7, by=0.1), 1), corr=TRUE) expect_identical(sav, structure(c(1, 0.2, 0.3, 0.4, 0.2, 1, 0.5, 0.6, 0.3, 0.5, 1, 0.7, 0.4, 0.6, 0.7, 1), .Dim = c(4L, 4L))) sav <- vec2mat(1:10, diag=TRUE) expect_identical(sav, structure(c(1, 2, 3, 4, 2, 5, 6, 7, 3, 6, 8, 9, 4, 7, 9, 10), .Dim = c(4L, 4L))) sav <- vec2mat(1:6, corr=FALSE, dimnames=c("A","B","C","D")) expect_identical(sav, structure(c(NA, 1, 2, 3, 1, NA, 4, 5, 2, 4, NA, 6, 3, 5, 6, NA), .Dim = c(4L, 4L), .Dimnames = list(c("A", "B", "C", "D"), c("A", "B", "C", "D")))) }) rm(list=ls()) metafor/tests/testthat/test_misc_anova.r0000644000176200001440000000752714254431671020274 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: anova() function") source("settings.r") test_that("anova() works correctly for comparing nested models.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res1 <- rma(yi, vi, data=dat, method="ML") res2 <- rma(yi ~ ablat, vi, data=dat, method="ML") sav <- anova(res1, res2) out <- capture.output(print(sav)) expect_equivalent(sav$LRT, 9.9588, tolerance=.tol[["test"]]) expect_equivalent(as.data.frame(sav)$LRT[2], 9.9588, tolerance=.tol[["test"]]) res1 <- rma(yi, vi, data=dat, method="REML") res2 <- rma(yi ~ ablat, vi, data=dat, method="REML") expect_warning(sav <- anova(res1, res2)) expect_equivalent(sav$LRT, 8.2301, tolerance=.tol[["test"]]) expect_equivalent(as.data.frame(sav)$LRT[2], 8.2301, tolerance=.tol[["test"]]) }) test_that("anova() works correctly when using the 'btt' argument.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, mods = ~ ablat + alloc, data=dat) sav <- anova(res, btt=3:4) out <- capture.output(print(sav)) expect_equivalent(sav$QM, 1.2850, tolerance=.tol[["test"]]) expect_equivalent(sav$QMp, 0.5260, tolerance=.tol[["pval"]]) expect_equivalent(as.data.frame(sav)$QM, 1.2850, tolerance=.tol[["test"]]) sav <- anova(res, btt="alloc") out <- capture.output(print(sav)) expect_equivalent(sav$QM, 1.2850, tolerance=.tol[["test"]]) expect_equivalent(sav$QMp, 0.5260, tolerance=.tol[["pval"]]) expect_equivalent(as.data.frame(sav)$QM, 1.2850, tolerance=.tol[["test"]]) res <- rma(yi, vi, mods = ~ ablat + alloc, data=dat, test="knha") sav <- anova(res, btt=3:4) out <- capture.output(print(sav)) expect_equivalent(sav$QM, 0.6007, tolerance=.tol[["test"]]) expect_equivalent(sav$QMp, 0.5690, tolerance=.tol[["pval"]]) expect_equivalent(as.data.frame(sav)$Fval, 0.6007, tolerance=.tol[["test"]]) sav <- anova(res, btt=list(2,3:4)) out <- capture.output(print(sav)) expect_equivalent(sapply(sav, function(x) x$QM), c(8.2194, 0.6007), tolerance=.tol[["test"]]) expect_equivalent(sapply(sav, function(x) x$QMp), c(0.0186, 0.5690), tolerance=.tol[["pval"]]) expect_equivalent(as.data.frame(sav)$Fval, c(8.2194, 0.6007), tolerance=.tol[["test"]]) res <- rma(yi, vi, mods = ~ ablat + alloc + year, data=dat, test="knha") sav <- anova(res, btt=as.list(attr(terms(formula(res)), "term.labels"))) expect_equivalent(as.data.frame(sav)$Fval, c(3.0213, 0.6503, 0.1410), tolerance=.tol[["test"]]) }) test_that("anova() works correctly when using the 'X' argument.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, mods = ~ ablat + alloc, data=dat) sav <- anova(res, X=rbind(c(1, 10, 0, 0), c(1, 30, 0, 0), c(1, 50, 0, 0))) out <- capture.output(print(sav)) expect_equivalent(sav$zval, c(0.0588, -1.7964, -3.1210), tolerance=.tol[["test"]]) expect_equivalent(as.data.frame(sav)$zval, c(0.0588, -1.7964, -3.1210), tolerance=.tol[["test"]]) sav <- anova(res, X=rbind(c(1, 10, 0, 0), c(1, 30, 0, 0), c(1, 50, 0, 0)), rhs=-.10) expect_equivalent(sav$zval, c(0.3463, -1.4543, -2.8295), tolerance=.tol[["test"]]) expect_equivalent(as.data.frame(sav)$zval, c(0.3463, -1.4543, -2.8295), tolerance=.tol[["test"]]) res <- rma(yi, vi, mods = ~ ablat + alloc, data=dat, test="knha") sav <- anova(res, X=rbind(c(1, 10, 0, 0), c(1, 10, 1, 0), c(1, 10, 0, 1))) out <- capture.output(print(sav)) expect_equivalent(sav$zval, c(0.0568, -0.8252, 0.2517), tolerance=.tol[["test"]]) expect_equivalent(as.data.frame(sav)$tval, c(0.0568, -0.8252, 0.2517), tolerance=.tol[["test"]]) expect_equivalent(sav$QM, 0.4230, tolerance=.tol[["test"]]) expect_equivalent(sav$QMp, 0.7412, tolerance=.tol[["pval"]]) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_jackson2014.r0000644000176200001440000000735614204414232023517 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking analysis example: jackson2014") source("settings.r") test_that("confint() gives correct results for example 1 in Jackson et al. (2014).", { skip_on_cran() ### example 1 ### yi <- c(0.0267, 0.8242, 0.3930, 2.4405, 2.1401, 1.2528, 2.4849, 0.3087, 1.4246, 0.1823, 1.1378, 1.2321, 2.0695, 4.0237, 1.4383, 1.6021) vi <- c(0.1285, 0.0315, 0.0931, 2.0967, 1.0539, 0.1602, 1.0235, 0.0218, 0.5277, 0.0556, 0.3304, 0.1721, 0.4901, 2.0200, 0.3399, 0.1830) xi <- c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1) ### random/mixed-effects meta-regression model (REML estimation by default) res <- rma(yi, vi, mods = ~ xi, digits=3) ### approximate 95% CI for tau^2 based on REML estimate and its SE ci <- exp(log(res$tau2) + c(-1.96,1.96)*(1/res$tau2 * res$se.tau2)) expect_equivalent(ci[1], 0.0110, tolerance=.tol[["var"]]) expect_equivalent(ci[2], 0.6330, tolerance=.tol[["var"]]) ### generalised Cochran heterogeneity estimate and CI (inverse variance weights) res <- rma(yi, vi, mods = ~ xi, method="GENQ", weights=1/vi, digits=3) ci <- confint(res) expect_equivalent(ci$random[1,2], 0.0029, tolerance=.tol[["var"]]) expect_equivalent(ci$random[1,3], 0.6907, tolerance=.tol[["var"]]) ### generalised Cochran heterogeneity estimate and CI (inverse SE weights) res <- rma(yi, vi, mods = ~ xi, method="GENQ", weights=1/sqrt(vi), digits=3) ci <- confint(res) expect_equivalent(ci$random[1,2], 0.0000, tolerance=.tol[["var"]]) expect_equivalent(ci$random[1,3], 1.1245, tolerance=.tol[["var"]]) ### Paule-Mandel estimate and CI res <- rma(yi, vi, mods = ~ xi, method="PM", digits=3) ci <- confint(res) expect_equivalent(ci$random[1,2], 0.0023, tolerance=.tol[["var"]]) expect_equivalent(ci$random[1,3], 1.4871, tolerance=.tol[["var"]]) }) test_that("confint() gives correct results for example 2 in Jackson et al. (2014).", { skip_on_cran() ### example 2 ### yi <- c(0.54, 0.4, 0.64, 0.365, 0.835, 0.02, 0.12, 0.085, 1.18, 0.08, 0.18, 0.325, 0.06, 0.715, 0.065, 0.245, 0.24, 0.06, 0.19) vi <- c(0.0176, 0.019, 0.0906, 0.0861, 0.0063, 0.0126, 0.0126, 0.0041, 0.0759, 0.0126, 0.0104, 0.0242, 0.0026, 0.2629, 0.0169, 0.0156, 0.0481, 0.0084, 0.0044) xi <- c(1986, 1987, 1988, 1988, 1998, 1999, 2000, 2000, 2000, 2001, 2001, 2001, 2002, 2002, 2002, 2002, 2003, 2003, 2003) ### random/mixed-effects meta-regression model (REML estimation by default) res <- rma(yi, vi, mods = ~ xi, digits=3) ### approximate 95% CI for tau^2 based on REML estimate and its SE ci <- exp(log(res$tau2) + c(-1.96,1.96)*(1/res$tau2 * res$se.tau2)) expect_equivalent(ci[1], 0.0163, tolerance=.tol[["var"]]) expect_equivalent(ci[2], 0.1108, tolerance=.tol[["var"]]) ### generalised Cochran heterogeneity estimate and CI (inverse variance weights) res <- rma(yi, vi, mods = ~ xi, method="GENQ", weights=1/vi, digits=3) ci <- confint(res) expect_equivalent(ci$random[1,2], 0.0170, tolerance=.tol[["var"]]) expect_equivalent(ci$random[1,3], 0.1393, tolerance=.tol[["var"]]) ### generalised Cochran heterogeneity estimate and CI (inverse SE weights) res <- rma(yi, vi, mods = ~ xi, method="GENQ", weights=1/sqrt(vi), digits=3) ci <- confint(res) expect_equivalent(ci$random[1,2], 0.0180, tolerance=.tol[["var"]]) expect_equivalent(ci$random[1,3], 0.1375, tolerance=.tol[["var"]]) ### Paule-Mandel estimate and CI res <- rma(yi, vi, mods = ~ xi, method="PM", digits=3) ci <- confint(res) expect_equivalent(ci$random[1,2], 0.0178, tolerance=.tol[["var"]]) expect_equivalent(ci$random[1,3], 0.1564, tolerance=.tol[["var"]]) }) rm(list=ls()) metafor/tests/testthat/test_plots_baujat_plot.r0000644000176200001440000000175414503345754021701 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/plots:baujat_plot source("settings.r") context("Checking plots example: Baujat plot") test_that("plot can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() ### create Baujat plot png("images/test_plots_baujat_plot_test.png", res=200, width=1800, height=1800, type="cairo") ### adjust margins so the space is better used par(mar=c(5,4,2,2)) ### load data from Pignon et al. (2000) dat <- dat.pignon2000 ### compute estimated log hazard ratios and sampling variances dat$yi <- with(dat, OmE/V) dat$vi <- with(dat, 1/V) ### meta-analysis based on all 65 trials res <- rma(yi, vi, data=dat, method="EE", slab=id) baujat(res, xlim=c(0,20), ylim=c(0,0.2)) dev.off() expect_true(.vistest("images/test_plots_baujat_plot_test.png", "images/test_plots_baujat_plot.png")) }) rm(list=ls()) metafor/tests/testthat/test_misc_rma_ls.r0000644000176200001440000003425214503345641020436 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: location-scale models") source("settings.r") dat <- dat.bangertdrowns2004 test_that("location-scale model works correctly for an intercept-only model", { res1 <- rma(yi, vi, data=dat) res2 <- rma.mv(yi, vi, random = ~ 1 | id, data=dat, sparse=.sparse) res3 <- rma(yi, vi, data=dat, scale = ~ 1) res4 <- rma(yi, vi, data=dat, scale = res3$Z) expect_equivalent(res1$tau2, res2$sigma2, tolerance=.tol[["var"]]) expect_equivalent(res1$tau2, exp(res3$alpha[1]), tolerance=.tol[["var"]]) expect_equivalent(res1$tau2, exp(res4$alpha[1]), tolerance=.tol[["var"]]) }) test_that("location-scale model works correctly for two subgroups with different tau^2 values", { res1 <- rma.mv(yi, vi, data=dat, random = ~ factor(meta) | id, struct="DIAG", subset=!is.na(meta), cvvc="transf", sparse=.sparse) expect_warning(res2 <- rma(yi, vi, data=dat, scale = ~ meta)) expect_warning(res3 <- rma(yi, vi, data=dat, scale = res2$Z.f)) expect_equivalent(res1$tau2, c(exp(res2$alpha[1]), exp(res2$alpha[1] + res2$alpha[2])), tolerance=.tol[["var"]]) expect_equivalent(res1$tau2, c(exp(res3$alpha[1]), exp(res3$alpha[1] + res3$alpha[2])), tolerance=.tol[["var"]]) expect_warning(res4 <- rma(yi, vi, data=dat, scale = ~ 0 + factor(meta))) expect_equivalent(unname(sqrt(diag(res1$vvc))), res4$se.alpha, tolerance=.tol[["se"]]) expect_warning(res5 <- rma(yi, vi, data=dat, scale = ~ 0 + factor(meta), link="identity")) expect_equivalent(res1$tau2, res5$alpha, tolerance=.tol[["var"]]) skip_on_cran() conf1 <- confint(res1) conf5 <- confint(res5, control=list(vc.min=0, vc.max=.5)) expect_equivalent(conf1[[1]]$random[1,], conf5[[1]]$random, tolerance=.tol[["var"]]) expect_equivalent(conf1[[2]]$random[1,], conf5[[2]]$random, tolerance=.tol[["var"]]) }) test_that("profile() and confint() work correctly for location-scale models", { skip_on_cran() png(filename="images/test_misc_rma_ls_profile_1_test.png", res=200, width=1800, height=1600, type="cairo") par(mfrow=c(2,2)) res1 <- rma(yi, vi, data=dat) prof1 <- profile(res1, progbar=FALSE, cline=TRUE, xlim=c(.01,.15)) conf1 <- confint(res1, type="PL") abline(v=conf1$random[1,2:3], lty="dotted") res2 <- rma.mv(yi, vi, random = ~ 1 | id, data=dat, sparse=.sparse) prof2 <- profile(res2, progbar=FALSE, cline=TRUE, xlim=c(.01,.15)) conf2 <- confint(res2) abline(v=conf2$random[1,2:3], lty="dotted") res3 <- rma(yi, vi, data=dat, scale = ~ 1) prof3 <- profile(res3, progbar=FALSE, cline=TRUE, xlim=log(c(.01,.15))) conf3 <- confint(res3) abline(v=conf3$random[1,2:3], lty="dotted") expect_equivalent(prof1$ll[c(1,20)], prof3$ll[c(1,20)], tolerance=.tol[["fit"]]) expect_equivalent(conf1$random[1,], exp(conf3$random), tolerance=.tol[["var"]]) res4 <- rma(yi, vi, data=dat, scale = ~ 1, link="identity") prof4 <- profile(res4, progbar=FALSE, cline=TRUE, xlim=c(.01,.15)) conf4 <- confint(res4, control=list(vc.max=.2)) abline(v=conf4$random[1,2:3], lty="dotted") dev.off() expect_true(.vistest("images/test_misc_rma_ls_profile_1_test.png", "images/test_misc_rma_ls_profile_1.png")) expect_equivalent(prof1$ll, prof2$ll, tolerance=.tol[["fit"]]) expect_equivalent(conf1$random[1,], conf2$random[1,], tolerance=.tol[["var"]]) expect_equivalent(prof1$ll, prof4$ll, tolerance=.tol[["fit"]]) expect_equivalent(conf1$random[1,], conf4$random, tolerance=.tol[["var"]]) }) test_that("location-scale model works correctly for a continuous predictor", { skip_on_cran() res1 <- rma(yi, vi, data=dat, scale = ~ grade) expect_equivalent(res1$beta, 0.2220791, tolerance=.tol[["coef"]]) expect_equivalent(res1$alpha, c(-3.10513013522415, 0.041361925354706), tolerance=.tol[["coef"]]) res2 <- rma(yi, vi, data=dat, scale = ~ grade, link="identity") expect_equivalent(res2$alpha, c(0.042926535, 0.002729234), tolerance=.tol[["coef"]]) #expect_equivalent(res1$tau2, res2$tau2, tolerance=.tol[["var"]]) # not true res3 <- rma.mv(yi, vi, data=dat, random = ~ sqrt(grade) | id, rho=0, struct="GEN", cvvc=TRUE, sparse=.sparse) expect_equivalent(c(res2$alpha), diag(res3$G), tolerance=.tol[["coef"]]) expect_equivalent(diag(res2$M), diag(res3$M), tolerance=.tol[["var"]]) expect_equivalent(unname(sqrt(diag(res3$vvc))), res2$se.alpha, tolerance=.tol[["se"]]) conf11 <- confint(res1, alpha=1) expect_equivalent(conf11$random, c(-3.10513, -5.25032, -1.21713), tolerance=.tol[["var"]]) conf12 <- confint(res1, alpha=2, xlim=c(-1,1)) expect_equivalent(conf12$random, c( 0.04136, -0.65819, 0.69562), tolerance=.tol[["var"]]) conf21 <- confint(res2, alpha=1, control=list(vc.min=-0.4, vc.max=0.3)) conf22 <- confint(res2, alpha=2, control=list(vc.min=-0.1, vc.max=0.05)) conf2 <- list(conf21, conf22) class(conf2) <- "list.confint.rma" expect_equivalent(conf2[[1]]$random, c(0.04293, -0.00137, 0.23145), tolerance=.tol[["var"]]) expect_equivalent(conf2[[2]]$random, c(0.00273, -0.04972, 0.04411), tolerance=.tol[["var"]]) conf3 <- confint(res3) expect_equivalent(conf3[[1]]$random[1,], c(0.04291, 0.00000, 0.11333), tolerance=.tol[["var"]]) expect_equivalent(conf3[[2]]$random[1,], c(0.00273, 0.00000, 0.04062), tolerance=.tol[["var"]]) # conf2 and conf3 are not the same because in res3 the two components must # be >= 0 while this restriction does not apply to res2 (and when profiling # or getting the CIs, fixing a particular component can lead to the other # component becoming negative) png(filename="images/test_misc_rma_ls_profile_2_test.png", res=200, width=1800, height=2200, type="cairo") par(mfrow=c(3,2)) profile(res1, alpha=1, progbar=FALSE, cline=TRUE) abline(v=conf11$random[2:3], lty="dotted") profile(res1, alpha=2, progbar=FALSE, cline=TRUE) abline(v=conf12$random[2:3], lty="dotted") profile(res2, alpha=1, progbar=FALSE, cline=TRUE, xlim=c(0,0.3)) abline(v=conf2[[1]]$random[2:3], lty="dotted") profile(res2, alpha=2, progbar=FALSE, cline=TRUE, xlim=c(-0.1,0.05)) abline(v=conf2[[2]]$random[2:3], lty="dotted") profile(res3, tau2=1, progbar=FALSE, cline=TRUE, xlim=c(0,.3)) abline(v=conf3[[1]]$random[1,2:3], lty="dotted") profile(res3, tau2=2, progbar=FALSE, cline=TRUE, xlim=c(0,.05)) abline(v=conf3[[2]]$random[1,2:3], lty="dotted") dev.off() expect_true(.vistest("images/test_misc_rma_ls_profile_2_test.png", "images/test_misc_rma_ls_profile_2.png")) }) test_that("location-scale model works correctly for multiple predictors", { skip_on_cran() expect_warning(res1 <- rma(yi, vi, data=dat, scale = ~ grade + meta + sqrt(ni))) expect_equivalent(res1$beta, 0.1110317, tolerance=.tol[["coef"]]) expect_equivalent(res1$alpha, c(-1.08826059, -0.03429344, 2.09197456, -0.28439165), tolerance=.tol[["coef"]]) expect_warning(res2 <- rma(yi, vi, data=dat, scale = ~ grade + meta + sqrt(ni), control=list(scaleZ=FALSE))) expect_equivalent(res2$beta, 0.1110317, tolerance=.tol[["coef"]]) expect_equivalent(res2$alpha, c(-1.08826210, -0.03429332, 2.09197501, -0.28439156), tolerance=.tol[["coef"]]) out <- capture.output(print(res1)) expect_warning(res2 <- rma(yi, vi, data=dat, scale = ~ grade + meta + sqrt(ni), control=list(optimizer="Nelder-Mead"))) expect_warning(res3 <- rma(yi, vi, data=dat, scale = ~ grade + meta + sqrt(ni), control=list(optimizer="BFGS"))) expect_warning(res4 <- rma(yi, vi, data=dat, scale = ~ grade + meta + sqrt(ni), control=list(optimizer="bobyqa"))) expect_warning(res5 <- rma(yi, vi, data=dat, scale = ~ grade + meta + sqrt(ni), control=list(optimizer="nloptr"))) expect_warning(res6 <- rma(yi, vi, data=dat, scale = ~ grade + meta + sqrt(ni), control=list(optimizer="hjk"))) expect_warning(res7 <- rma(yi, vi, data=dat, scale = ~ grade + meta + sqrt(ni), control=list(optimizer="nmk"))) expect_warning(res8 <- rma(yi, vi, data=dat, scale = ~ grade + meta + sqrt(ni), control=list(optimizer="mads"))) expect_warning(res9 <- rma(yi, vi, data=dat, scale = ~ grade + meta + sqrt(ni), control=list(optimizer="ucminf"))) expect_warning(res10 <- rma(yi, vi, data=dat, scale = ~ grade + meta + sqrt(ni), control=list(optimizer="lbfgsb3c"))) expect_warning(res11 <- rma(yi, vi, data=dat, scale = ~ grade + meta + sqrt(ni), control=list(optimizer="subplex"))) expect_warning(res12 <- rma(yi, vi, data=dat, scale = ~ grade + meta + sqrt(ni), control=list(optimizer="BBoptim"))) expect_equivalent(res1$alpha, c(-1.08826059, -0.03429344, 2.09197456, -0.28439165), tolerance=.tol[["coef"]]) expect_equivalent(res2$alpha, c(-1.08879415, -0.03426271, 2.09166227, -0.28432946), tolerance=.tol[["coef"]]) expect_equivalent(res3$alpha, c(-1.08791095, -0.03439789, 2.09179476, -0.28438389), tolerance=.tol[["coef"]]) expect_equivalent(res4$alpha, c(-1.08826099, -0.03429340, 2.09197460, -0.28439162), tolerance=.tol[["coef"]]) expect_equivalent(res5$alpha, c(-1.09036615, -0.03393392, 2.09205708, -0.28429889), tolerance=.tol[["coef"]]) expect_equivalent(res6$alpha, c(-1.08825599, -0.03429422, 2.09197166, -0.28439180), tolerance=.tol[["coef"]]) expect_equivalent(res7$alpha, c(-1.08867491, -0.03415188, 2.09213170, -0.28436838), tolerance=.tol[["coef"]]) expect_equivalent(res8$alpha, c(-1.08825988, -0.03429568, 2.09198084, -0.28439174), tolerance=.tol[["coef"]]) expect_equivalent(res9$alpha, c(-1.08826216, -0.03429383, 2.09197932, -0.28439198), tolerance=.tol[["coef"]]) expect_equivalent(res10$alpha, c(-1.08847719, -0.03428306, 2.09219886, -0.28439198), tolerance=.tol[["coef"]]) expect_equivalent(res11$alpha, c(-1.08826074, -0.03429341, 2.09197437, -0.28439162), tolerance=.tol[["coef"]]) expect_equivalent(res11$alpha, c(-1.08824263, -0.03429451, 2.09195305, -0.28439121), tolerance=.tol[["coef"]]) }) test_that("permutation tests work correctly for a location-scale model", { skip_on_cran() expect_warning(res <- rma(yi, vi, data=dat, scale = ~ grade + meta + sqrt(ni))) set.seed(1234) sav <- permutest(res, iter=100, progbar=FALSE) out <- capture.output(print(sav)) expect_equivalent(sav$pval, 0.01, tolerance=.tol[["pval"]]) expect_equivalent(sav$pval.alpha, c(0.81, 0.95, 0.02, 0.04), tolerance=.tol[["coef"]]) png(filename="images/test_misc_rma_ls_permutest_test.png", res=200, width=1800, height=1800, type="cairo") plot(sav) dev.off() expect_true(.vistest("images/test_misc_rma_ls_permutest_test.png", "images/test_misc_rma_ls_permutest.png")) }) test_that("predict() works correctly for location-scale models", { skip_on_cran() expect_warning(res <- rma(yi, vi, data=dat, mods = ~ meta, scale = ~ meta)) res0 <- rma(yi, vi, data=dat, subset=meta==0) res1 <- rma(yi, vi, data=dat, subset=meta==1) pred <- predict(res, addx=TRUE, addz=TRUE) pred0 <- predict(res0) pred1 <- predict(res1) expect_equivalent(pred$pred[1:2], c(pred1$pred, pred0$pred), tolerance=.tol[["pred"]]) expect_equivalent(pred$se[1:2] , c(pred1$se, pred0$se), tolerance=.tol[["pred"]]) expect_equivalent(pred$ci.lb[1:2], c(pred1$ci.lb, pred0$ci.lb), tolerance=.tol[["pred"]]) expect_equivalent(pred$ci.ub[1:2], c(pred1$ci.ub, pred0$ci.ub), tolerance=.tol[["pred"]]) expect_equivalent(pred$pi.lb[1:2], c(pred1$pi.lb, pred0$pi.lb), tolerance=.tol[["pred"]]) expect_equivalent(pred$pi.ub[1:2], c(pred1$pi.ub, pred0$pi.ub), tolerance=.tol[["pred"]]) pred <- predict(res, newmods=0:1) expect_equivalent(pred$pred, c(pred0$pred, pred1$pred), tolerance=.tol[["pred"]]) pred <- predict(res, newmods=0:1, newscale=0:1) expect_equivalent(pred$pred, c(pred0$pred, pred1$pred), tolerance=.tol[["pred"]]) expect_equivalent(pred$se , c(pred0$se, pred1$se), tolerance=.tol[["pred"]]) expect_equivalent(pred$ci.lb, c(pred0$ci.lb, pred1$ci.lb), tolerance=.tol[["pred"]]) expect_equivalent(pred$ci.ub, c(pred0$ci.ub, pred1$ci.ub), tolerance=.tol[["pred"]]) expect_equivalent(pred$pi.lb, c(pred0$pi.lb, pred1$pi.lb), tolerance=.tol[["pred"]]) expect_equivalent(pred$pi.ub, c(pred0$pi.ub, pred1$pi.ub), tolerance=.tol[["pred"]]) pred <- predict(res, newscale=0:1, transf=exp) expect_equivalent(pred$pred, c(res0$tau2, res1$tau2), tolerance=.tol[["var"]]) expect_warning(res <- rma(yi, vi, data=dat, mods = ~ meta, scale = ~ meta, link="identity")) pred <- predict(res, newscale=0:1) expect_equivalent(pred$pred, c(res0$tau2, res1$tau2), tolerance=.tol[["var"]]) }) test_that("anova() works correctly for location-scale models", { skip_on_cran() expect_warning(res1 <- rma(yi, vi, data=dat, mods = ~ factor(grade) + meta + sqrt(ni), scale = ~ factor(grade) + meta + sqrt(ni))) expect_warning(res0 <- rma(yi, vi, data=dat, mods = ~ factor(grade) + meta + sqrt(ni), scale = ~ 1)) sav <- anova(res1, res0) expect_equivalent(sav$LRT, 3.146726, tolerance=.tol[["test"]]) expect_equivalent(sav$pval, 0.6773767, tolerance=.tol[["pval"]]) sav <- anova(res1, btt=2:4) expect_equivalent(sav$QM, 5.286715, tolerance=.tol[["test"]]) expect_equivalent(sav$QMp, 0.1519668, tolerance=.tol[["pval"]]) sav <- anova(res1, att=2:4) expect_equivalent(sav$QS, 2.030225, tolerance=.tol[["test"]]) expect_equivalent(sav$QSp, 0.5661571, tolerance=.tol[["pval"]]) expect_error(anova(res1, btt=2:4, att=2:4)) sav <- anova(res1, X=c(0,1,-1,0,0,0)) expect_equivalent(sav$QM, 4.463309, tolerance=.tol[["test"]]) expect_equivalent(sav$QMp, 0.03463035, tolerance=.tol[["pval"]]) tmp <- predict(res1, newmods=c(1,-1,0,0,0), intercept=FALSE) expect_equivalent(sav$Xb[1,1], tmp$pred, tolerance=.tol[["test"]]) sav <- anova(res1, Z=c(0,1,-1,0,0,0)) expect_equivalent(sav$QS, 0.3679934, tolerance=.tol[["test"]]) expect_equivalent(sav$QSp, 0.5441001, tolerance=.tol[["pval"]]) tmp <- predict(res1, newscale=c(1,-1,0,0,0), intercept=FALSE) expect_equivalent(sav$Za[1,1], tmp$pred, tolerance=.tol[["test"]]) expect_error(anova(res1, X=c(0,1,-1,0,0,0), Z=c(0,1,-1,0,0,0))) }) test_that("vif() works correctly for location-scale models", { skip_on_cran() expect_warning(res <- rma(yi, vi, data=dat, scale = ~ grade + meta + sqrt(ni))) sav <- round(vif(res)$vifs, 4) expect_equivalent(sav, c(grade = 1.3087, meta = 1.06, `sqrt(ni)` = 1.2847)) }) rm(list=ls()) metafor/tests/testthat/test_misc_rma_vs_direct_computation.r0000644000176200001440000000154114204414551024412 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: rma.uni() against direct computations") source("settings.r") test_that("results match (FE model).", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, mods = ~ ablat + year, data=dat, method="FE") X <- cbind(1, dat$ablat, dat$year) W <- diag(1/dat$vi) y <- cbind(dat$yi) beta <- solve(t(X) %*% W %*% X) %*% t(X) %*% W %*% y vb <- solve(t(X) %*% W %*% X) expect_equivalent(res$beta, beta) expect_equivalent(res$vb, vb) yhat <- c(X %*% beta) expect_equivalent(fitted(res), yhat) H <- X %*% solve(t(X) %*% W %*% X) %*% t(X) %*% W expect_equivalent(hatvalues(res, type="matrix"), H) ei <- (diag(res$k) - H) %*% y expect_equivalent(resid(res), c(ei)) }) rm(list=ls()) metafor/tests/testthat/test_misc_metan_vs_rma.uni_with_dat.bcg.r0000644000176200001440000001267714204414461025045 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: rma.uni() against metan with 'dat.bcg'") source("settings.r") test_that("results match (EE model, measure='RR').", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### compare results with: metan tpos tneg cpos cneg, fixedi nograph rr log res <- rma(yi, vi, data=dat, method="EE") expect_equivalent(c(res$beta), -0.4303, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -0.5097, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, -0.3509, tolerance=.tol[["ci"]]) expect_equivalent(res$zval, -10.6247, tolerance=.tol[["test"]]) ### -10.62 in Stata expect_equivalent(res$QE, 152.2330, tolerance=.tol[["test"]]) ### compare results with: metan tpos tneg cpos cneg, fixedi nograph rr sav <- predict(res, transf=exp) expect_equivalent(sav$pred, 0.6503, tolerance=.tol[["pred"]]) expect_equivalent(sav$ci.lb, 0.6007, tolerance=.tol[["ci"]]) expect_equivalent(sav$ci.ub, 0.7040, tolerance=.tol[["ci"]]) }) test_that("results match (RE model w/ DL estimator, measure='RR').", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### compare results with: metan tpos tneg cpos cneg, randomi nograph rr log res <- rma(yi, vi, data=dat, method="DL") expect_equivalent(c(res$beta), -0.7141, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -1.0644, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, -0.3638, tolerance=.tol[["ci"]]) expect_equivalent(res$zval, -3.9952, tolerance=.tol[["test"]]) ### 4.00 in Stata expect_equivalent(res$tau2, 0.3088, tolerance=.tol[["var"]]) expect_equivalent(res$I2, 92.1173, tolerance=.tol[["het"]]) ### compare results with: metan tpos tneg cpos cneg, randomi nograph rr sav <- predict(res, transf=exp) expect_equivalent(sav$pred, 0.4896, tolerance=.tol[["pred"]]) expect_equivalent(sav$ci.lb, 0.3449, tolerance=.tol[["ci"]]) expect_equivalent(sav$ci.ub, 0.6950, tolerance=.tol[["ci"]]) }) test_that("results match (EE model, measure='OR').", { dat <- escalc(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### compare results with: metan tpos tneg cpos cneg, fixedi nograph or log res <- rma(yi, vi, data=dat, method="EE") expect_equivalent(c(res$beta), -0.4361, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -0.5190, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, -0.3533, tolerance=.tol[["ci"]]) expect_equivalent(res$zval, -10.3190, tolerance=.tol[["test"]]) ### -10.32 in Stata expect_equivalent(res$QE, 163.1649, tolerance=.tol[["test"]]) ### compare results with: metan tpos tneg cpos cneg, fixedi nograph or sav <- predict(res, transf=exp) expect_equivalent(sav$pred, 0.6465, tolerance=.tol[["pred"]]) expect_equivalent(sav$ci.lb, 0.5951, tolerance=.tol[["ci"]]) expect_equivalent(sav$ci.ub, 0.7024, tolerance=.tol[["ci"]]) }) test_that("results match (RE model w/ DL estimator, measure='OR').", { dat <- escalc(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### compare results with: metan tpos tneg cpos cneg, randomi nograph or log res <- rma(yi, vi, data=dat, method="DL") expect_equivalent(c(res$beta), -0.7474, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -1.1242, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, -0.3706, tolerance=.tol[["ci"]]) expect_equivalent(res$zval, -3.8873, tolerance=.tol[["test"]]) ### -3.89 in Stata expect_equivalent(res$tau2, 0.3663, tolerance=.tol[["var"]]) expect_equivalent(res$I2, 92.6455, tolerance=.tol[["het"]]) ### compare results with: metan tpos tneg cpos cneg, randomi nograph or sav <- predict(res, transf=exp) expect_equivalent(sav$pred, 0.4736, tolerance=.tol[["pred"]]) expect_equivalent(sav$ci.lb, 0.3249, tolerance=.tol[["ci"]]) expect_equivalent(sav$ci.ub, 0.6903, tolerance=.tol[["ci"]]) }) test_that("results match (EE model, measure='RD').", { dat <- escalc(measure="RD", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### compare results with: metan tpos tneg cpos cneg, fixedi nograph rd res <- rma(yi, vi, data=dat, method="EE") expect_equivalent(c(res$beta), -0.0009, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -0.0014, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, -0.0005, tolerance=.tol[["ci"]]) expect_equivalent(res$zval, -4.0448, tolerance=.tol[["test"]]) ### -4.04 in Stata expect_equivalent(res$QE, 276.4737, tolerance=.tol[["test"]]) }) test_that("results match (RE model w/ DL estimator, measure='RD').", { dat <- escalc(measure="RD", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) ### compare results with: metan tpos tneg cpos cneg, randomi nograph rd res <- rma(yi, vi, data=dat, method="DL") expect_equivalent(c(res$beta), -0.0071, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -0.0101, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, -0.0040, tolerance=.tol[["ci"]]) expect_equivalent(res$zval, -4.5128, tolerance=.tol[["test"]]) ### -4.51 in Stata expect_equivalent(res$tau2, 0.0000, tolerance=.tol[["var"]]) expect_equivalent(res$I2, 95.6596, tolerance=.tol[["het"]]) }) #expect_that(rma(yi ~ ablat, vi, data=dat, subset=1:2), throws_error("Number of parameters to be estimated is larger than the number of observations.")) rm(list=ls()) metafor/tests/testthat/test_analysis_example_ishak2007.r0000644000176200001440000001243614502303727023172 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking analysis example: ishak2007") source("settings.r") ### load dataset dat <- dat.ishak2007 ### create long format dataset dat.long <- reshape(dat, direction="long", idvar="study", v.names=c("yi","vi"), varying=list(c(2,4,6,8), c(3,5,7,9))) dat.long <- dat.long[order(dat.long$study, dat.long$time),] rownames(dat.long) <- 1:nrow(dat.long) ### remove missing measurement occasions from dat.long is.miss <- is.na(dat.long$yi) dat.long <- dat.long[!is.miss,] ### construct the full (block diagonal) V matrix with an AR(1) structure rho.within <- .97 ### value as estimated by Ishak et al. (2007) V <- lapply(split(with(dat, cbind(v1i, v2i, v3i, v4i)), dat$study), diag) V <- lapply(V, function(v) sqrt(v) %*% toeplitz(ARMAacf(ar=rho.within, lag.max=3)) %*% sqrt(v)) V <- bldiag(V) V <- V[!is.miss,!is.miss] ### remove missing measurement occasions from V test_that("results are correct for diag(V) and struct='DIAG'.", { res <- rma.mv(yi, diag(V), mods = ~ factor(time) - 1, random = ~ factor(time) | study, struct = "DIAG", data = dat.long, sparse=.sparse) ### Table 1, column "Time-specific (Independence)" expect_equivalent(coef(res), c(-24.8686, -27.4728, -28.5239, -24.1415), tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, c(23.0537, 27.8113, 27.6767, 29.9405), tolerance=.tol[["var"]]) }) test_that("results are correct for diag(V) and random study effects.", { res <- rma.mv(yi, diag(V), mods = ~ factor(time) - 1, random = ~ 1 | study, data = dat.long, sparse=.sparse) ### Table 1, column "Random study effects" expect_equivalent(coef(res), c(-26.2127, -27.1916, -28.5464, -25.6339), tolerance=.tol[["coef"]]) expect_equivalent(res$sigma2, 26.6829, tolerance=.tol[["var"]]) }) test_that("results are correct for diag(V) and struct='ID'.", { res <- rma.mv(yi, diag(V), mods = ~ factor(time) - 1, random = ~ factor(time) | study, struct = "ID", data = dat.long, sparse=.sparse) ### not in paper expect_equivalent(coef(res), c(-24.8792, -27.4670, -28.5185, -24.1502), tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, 26.6847, tolerance=.tol[["var"]]) }) test_that("results are correct for diag(V) and struct='HAR'.", { res <- rma.mv(yi, diag(V), mods = ~ factor(time) - 1, random = ~ time | study, struct = "HAR", data = dat.long, sparse=.sparse) ### Table 1, column "Correlated random time effects" expect_equivalent(coef(res), c(-25.9578, -27.3100, -28.5543, -25.7923), tolerance=.tol[["coef"]]) # -27.5 in Table vs -27.3 expect_equivalent(res$tau2, c(20.3185, 35.9720, 26.4233, 30.1298), tolerance=.tol[["var"]]) # 20.4 in Table vs 20.3 expect_equivalent(res$rho, 1.0000, tolerance=.tol[["cor"]]) }) test_that("results are correct for struct='HAR'.", { res <- rma.mv(yi, V, mods = ~ factor(time) - 1, random = ~ time | study, struct = "HAR", data = dat.long, sparse=.sparse) ### Table 1, column "Multivariate model" expect_equivalent(coef(res), c(-25.9047, -27.4608, -28.6559, -26.4934), tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, c(22.7258, 33.7295, 26.1426, 31.1803), tolerance=.tol[["var"]]) # 22.6 in Table vs 22.7; 31.1 in Table vs 31.2 expect_equivalent(res$rho, 0.8832, tolerance=.tol[["cor"]]) }) test_that("results are correct for struct='AR'.", { res <- rma.mv(yi, V, mods = ~ factor(time) - 1, random = ~ time | study, struct = "AR", data = dat.long, sparse=.sparse) ### not in paper expect_equivalent(coef(res), c(-25.9418, -27.3937, -28.7054, -26.3970), tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, 26.6874, tolerance=.tol[["var"]]) expect_equivalent(res$rho, 0.8656, tolerance=.tol[["cor"]]) }) test_that("results are correct for struct='HCS'.", { res <- rma.mv(yi, V, mods = ~ factor(time) - 1, random = ~ factor(time) | study, struct = "HCS", data = dat.long, sparse=.sparse) ### not in paper expect_equivalent(coef(res), c(-25.8814, -27.3293, -28.6510, -26.6631), tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, c(20.8629, 32.7429, 27.6593, 32.1908), tolerance=.tol[["var"]]) }) test_that("results are correct for struct='CAR'.", { res <- rma.mv(yi, V, mods = ~ factor(time) - 1, random = ~ time | study, struct = "CAR", data = dat.long, sparse=.sparse) ### not in paper expect_equivalent(coef(res), c(-25.9418, -27.3937, -28.7054, -26.3970), tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, 26.6875, tolerance=.tol[["var"]]) expect_equivalent(res$rho, 0.8656, tolerance=.tol[["cor"]]) }) test_that("results are correct for struct='CAR' with unequally spaced time points.", { dat.long$time[dat.long$time == 4] <- 24/3 dat.long$time[dat.long$time == 3] <- 12/3 dat.long$time[dat.long$time == 2] <- 6/3 dat.long$time[dat.long$time == 1] <- 3/3 res <- rma.mv(yi, V, mods = ~ factor(time) - 1, random = ~ time | study, struct = "CAR", data = dat.long, sparse=.sparse) ### not in paper expect_equivalent(coef(res), c(-26.0293, -27.3838, -28.7339, -26.0515), tolerance=.tol[["coef"]]) expect_equivalent(res$tau2, 26.9825, tolerance=.tol[["var"]]) expect_equivalent(res$rho, 0.9171, tolerance=.tol[["cor"]]) }) rm(list=ls()) metafor/tests/testthat/test_misc_handling_of_edge_cases_due_to_zeros.r0000644000176200001440000000304014204414407026336 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: handling of edge cases due to zeros") source("settings.r") test_that("rma.peto(), rma.mh(), and rma.glmm() handle outcome1 never occurring properly.", { ai <- c(0,0,0,0) bi <- c(10,15,20,25) ci <- c(0,0,0,0) di <- c(10,10,30,20) expect_that(suppressWarnings(rma.peto(ai=ai, bi=bi, ci=ci, di=di)), throws_error()) expect_warning(res <- rma.mh(measure="OR", ai=ai, bi=bi, ci=ci, di=di)) expect_true(is.na(res$beta)) expect_warning(res <- rma.mh(measure="RR", ai=ai, bi=bi, ci=ci, di=di)) expect_true(is.na(res$beta)) expect_warning(res <- rma.mh(measure="RD", ai=ai, bi=bi, ci=ci, di=di)) expect_equivalent(res$beta, 0) skip_on_cran() expect_error(suppressWarnings(rma.glmm(measure="OR", ai=ai, bi=bi, ci=ci, di=di))) }) test_that("rma.peto(), rma.mh(), and rma.glmm() handle outcome2 never occurring properly.", { ai <- c(10,15,20,25) bi <- c(0,0,0,0) ci <- c(10,10,30,20) di <- c(0,0,0,0) expect_error(suppressWarnings(rma.peto(ai=ai, bi=bi, ci=ci, di=di))) expect_warning(res <- rma.mh(measure="OR", ai=ai, bi=bi, ci=ci, di=di)) expect_true(is.na(res$beta)) expect_warning(res <- rma.mh(measure="RR", ai=ai, bi=bi, ci=ci, di=di)) expect_equivalent(res$beta, 0) expect_warning(res <- rma.mh(measure="RD", ai=ai, bi=bi, ci=ci, di=di)) expect_equivalent(res$beta, 0) skip_on_cran() expect_error(suppressWarnings(rma.glmm(measure="OR", ai=ai, bi=bi, ci=ci, di=di))) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_henmi2010.r0000644000176200001440000000262114204414224023152 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:henmi2010 source("settings.r") context("Checking analysis example: henmi2010") ### load dataset dat <- dat.lee2004 ### calculate log odds ratios and corresponding sampling variances dat <- escalc(measure="OR", ai=ai, n1i=n1i, ci=ci, n2i=n2i, data=dat) test_that("results are correct for the random-effects model.", { ### fit random-effects model with DL estimator res <- rma(yi, vi, data=dat, method="DL") ### compare with results on page 2978 expect_equivalent(res$tau2, 0.3325, tolerance=.tol[["var"]]) expect_equivalent(coef(res), -0.6787, tolerance=.tol[["coef"]]) expect_equivalent(res$ci.lb, -1.0664, tolerance=.tol[["ci"]]) expect_equivalent(res$ci.ub, -0.2911, tolerance=.tol[["ci"]]) }) test_that("results are correct for the Henmi & Copas method.", { ### fit random-effects model with DL estimator res <- rma(yi, vi, data=dat, method="DL") ### apply Henmi & Copas method sav <- hc(res) out <- capture.output(print(sav)) ### so that print.hc.rma.uni() is run (at least once) ### compare with results on page 2978 expect_equivalent(sav$beta, -0.5145, tolerance=.tol[["coef"]]) expect_equivalent(sav$ci.lb, -0.9994, tolerance=.tol[["ci"]]) expect_equivalent(sav$ci.ub, -0.0295, tolerance=.tol[["ci"]]) }) rm(list=ls()) metafor/tests/testthat/test_plots_funnel_plot_variations.r0000644000176200001440000000200114503346121024130 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/plots:funnel_plot_variations source("settings.r") context("Checking plots example: funnel plot variations") test_that("plot can be drawn.", { expect_equivalent(TRUE, TRUE) # avoid 'Empty test' message skip_on_cran() png("images/test_plots_funnel_plot_variations_test.png", res=200, width=1800, height=1800, type="cairo") ### fit equal-effects model res <- rma(yi, vi, data=dat.hackshaw1998, measure="OR", method="EE") ### set up 2x2 array for plotting par(mfrow=c(2,2)) ### draw funnel plots funnel(res, main="Standard Error") funnel(res, yaxis="vi", main="Sampling Variance") funnel(res, yaxis="seinv", main="Inverse Standard Error") funnel(res, yaxis="vinv", main="Inverse Sampling Variance") dev.off() expect_true(.vistest("images/test_plots_funnel_plot_variations_test.png", "images/test_plots_funnel_plot_variations.png")) }) rm(list=ls()) metafor/tests/testthat/test_misc_residuals.r0000644000176200001440000000754314502304004021142 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: residuals() function") source("settings.r") test_that("residuals are correct for rma().", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, subset=1:6) res <- rma(yi, vi, data=dat) expect_equivalent(c(residuals(res)), c(dat$yi - coef(res))) expect_equivalent(rstandard(res)$z, c(0.1401, -0.9930, -0.4719, -1.0475, 1.6462, 0.4825), tolerance=.tol[["pred"]]) expect_equivalent(rstudent(res)$z, c(0.1426, -0.9957, -0.4591, -1.1949, 2.0949, 0.4330), tolerance=.tol[["test"]]) res <- rma(yi, vi, data=dat, method="EE") expect_equivalent(sum(residuals(res, type="pearson")^2), res$QE, tolerance=.tol[["test"]]) expect_equivalent(sum(residuals(res, type="cholesky")^2), res$QE, tolerance=.tol[["test"]]) }) test_that("rstudent() yields the same results as a mean shift outlier model for rma().", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, subset=1:6) dat$trial1 <- ifelse(dat$trial == 1, 1, 0) res <- rma(yi, vi, data=dat) sav <- rstudent(res) res <- rma(yi, vi, mods = ~ trial1, data=dat) expect_equivalent(coef(res)[2], sav$resid[1], tolerance=.tol[["coef"]]) expect_equivalent(res$se[2], sav$se[1], tolerance=.tol[["se"]]) res <- rma(yi, vi, data=dat, test="knha") sav <- rstudent(res) res <- rma(yi, vi, mods = ~ trial1, data=dat, test="knha") expect_equivalent(coef(res)[2], sav$resid[1], tolerance=.tol[["pred"]]) expect_equivalent(res$se[2], sav$se[1], tolerance=.tol[["se"]]) }) test_that("residuals are correct for rma.mv().", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, subset=1:6) res <- rma.mv(yi, vi, random = ~ 1 | trial, data=dat, sparse=.sparse) expect_equivalent(c(residuals(res)), c(dat$yi - coef(res))) expect_equivalent(rstandard(res)$z, c(0.1401, -0.9930, -0.4719, -1.0476, 1.6462, 0.4825), tolerance=.tol[["test"]]) expect_equivalent(rstandard(res, cluster=alloc)$cluster$X2, c(3.7017, 3.6145), tolerance=.tol[["test"]]) expect_equivalent(rstudent(res)$z, c(0.1426, -0.9957, -0.4591, -1.1949, 2.0949, 0.4330), tolerance=.tol[["test"]]) expect_equivalent(rstudent(res, cluster=alloc)$cluster$X2, c(27.4717, 5.2128), tolerance=.tol[["test"]]) expect_equivalent(rstudent(res, cluster=alloc, reestimate=FALSE)$cluster$X2, c(3.7017, 3.6145), tolerance=.tol[["test"]]) }) test_that("residuals are correct for rma.mh().", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, subset=1:6) res <- rma.mh(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, subset=1:6) expect_equivalent(c(residuals(res)), c(dat$yi - coef(res))) expect_equivalent(residuals(res, type="rstandard"), c(0.1068, -1.4399, -0.6173, -3.4733, 3.2377, 1.9749), tolerance=.tol[["pred"]]) expect_equivalent(residuals(res, type="rstudent"), c(0.1076, -1.4668, -0.6219, -4.2413, 3.3947, 2.7908), tolerance=.tol[["pred"]]) }) test_that("residuals are correct for rma.peto().", { dat <- escalc(measure="PETO", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, subset=1:6) res <- rma.peto(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, subset=1:6) expect_equivalent(c(residuals(res)), c(dat$yi - coef(res))) expect_equivalent(rstandard(res)$z, c(0.2684, -1.1482, -0.4142, -2.3440, 3.4961, 0.8037), tolerance=.tol[["test"]]) expect_equivalent(rstudent(res)$z, c(0.2705, -1.1700, -0.4173, -2.8891, 3.6614, 1.1391), tolerance=.tol[["test"]]) }) test_that("residuals are correct for rma.glmm().", { skip_on_cran() dat <- escalc(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, subset=1:6) res <- rma.glmm(measure="OR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, subset=1:6) expect_equivalent(c(residuals(res)), c(dat$yi - coef(res))) }) rm(list=ls()) metafor/tests/testthat/test_misc_influence.r0000644000176200001440000001665414502310321021121 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: influence() and related functions") source("settings.r") test_that("influence() works for rma().", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, data=dat) sav <- influence(res) sav$inf <- sav$inf[1] sav$dfbs <- sav$dfbs[1] sav$is.infl <- sav$is.infl[1] sav$not.na <- sav$not.na[1] tmp <- structure(list(inf = structure(list(rstudent = -0.218142474344442, dffits = -0.0407075604868486, cook.d = 0.00171654236729195, cov.r = 1.11644891104804, tau2.del = 0.336156745300306, QE.del = 151.582572747109, hat = 0.0505948307931551, weight = 5.05948307931551, inf = "", slab = 1L, digits = c(est = 4, se = 4, test = 4, pval = 4, ci = 4, var = 4, sevar = 4, fit = 4, het = 4)), class = "list.rma"), dfbs = structure(list(intrcpt = -0.0402659025974144, slab = 1L, digits = c(est = 4, se = 4, test = 4, pval = 4, ci = 4, var = 4, sevar = 4, fit = 4, het = 4)), class = "list.rma"), ids = 1:13, not.na = TRUE, is.infl = FALSE, tau2 = 0.313243325980895, QE = 152.233008082373, k = 13L, p = 1L, m = 1L, digits = c(est = 4, se = 4, test = 4, pval = 4, ci = 4, var = 4, sevar = 4, fit = 4, het = 4)), class = "infl.rma.uni") expect_equivalent(sav, tmp, tolerance=.tol[["inf"]]) }) test_that("leave1out() works for rma().", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, data=dat) inf <- leave1out(res) inf <- inf[1] sav <- structure(list(estimate = -0.707083788031436, se = 0.189961024702717, zval = -3.72225717953459, pval = 0.000197449759023198, ci.lb = -1.07940055491509, ci.ub = -0.334767021147788, Q = 151.582572747109, Qp = 7.0778599767807e-27, tau2 = 0.336156745300306, I2 = 93.2259349111223, H2 = 14.762184698253, slab = 1L, digits = c(est = 4, se = 4, test = 4, pval = 4, ci = 4, var = 4, sevar = 4, fit = 4, het = 4), transf = FALSE), class = "list.rma") expect_equivalent(sav, inf, tolerance=.tol[["misc"]]) }) test_that("leave1out() works for rma.mh().", { res <- rma.mh(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) inf <- leave1out(res) inf <- inf[1] sav <- structure(list(estimate = -0.451379469928476, se = 0.0394350331703394, zval = -11.4461541842439, pval = 2.45810944109134e-30, ci.lb = -0.528670714671484, ci.ub = -0.374088225185468, Q = 151.915260738878, Qp = 6.05181927235005e-27, I2 = 92.7591211399706, H2 = 13.8104782489889, slab = 1L, digits = c(est = 4, se = 4, test = 4, pval = 4, ci = 4, var = 4, sevar = 4, fit = 4, het = 4), transf = FALSE), class = "list.rma") expect_equivalent(sav, inf, tolerance=.tol[["misc"]]) }) test_that("leave1out() works for rma.peto().", { res <- rma.peto(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) inf <- leave1out(res) inf <- inf[1] sav <- structure(list(estimate = -0.472177269248539, se = 0.0407784291562603, zval = -11.5790941195696, pval = 5.25989306490064e-31, ci.lb = -0.552101521740927, ci.ub = -0.39225301675615, Q = 167.200450619361, Qp = 4.44309617192221e-30, I2 = 93.4210703623987, H2 = 15.2000409653964, slab = 1L, digits = c(est = 4, se = 4, test = 4, pval = 4, ci = 4, var = 4, sevar = 4, fit = 4, het = 4), transf = FALSE), class = "list.rma") expect_equivalent(sav, inf, tolerance=.tol[["misc"]]) }) test_that("model.matrix() works for rma().", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, mods = ~ ablat, data=dat) sav <- structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 44, 55, 42, 52, 13, 44, 19, 13, 27, 42, 18, 33, 33), .Dim = c(13L, 2L), .Dimnames = list(c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13"), c("intrcpt", "ablat"))) expect_equivalent(sav, model.matrix(res)) }) test_that("hatvalues() works for rma().", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, mods = ~ ablat, data=dat) expect_equivalent(hatvalues(res), c(0.049, 0.1493, 0.0351, 0.3481, 0.2248, 0.2367, 0.064, 0.357, 0.0926, 0.1157, 0.2309, 0.0189, 0.0778), tolerance=.tol[["inf"]]) sav <- structure(c(0.049, 0.067, 0.0458, 0.0994, 0.1493, 0.0904, 0.0374, 0.0498, 0.0351), .Dim = c(3L, 3L), .Dimnames = list(c("1", "2", "3"), c("1", "2", "3"))) expect_equivalent(hatvalues(res, type="matrix")[1:3,1:3], sav, tolerance=.tol[["inf"]]) }) test_that("hatvalues() works for rma.mv().", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma.mv(yi, vi, mods = ~ ablat, random = ~ 1 | trial, data=dat, sparse=.sparse) expect_equivalent(hatvalues(res), c(0.049, 0.1493, 0.0351, 0.3481, 0.2248, 0.2367, 0.064, 0.357, 0.0926, 0.1157, 0.2309, 0.0189, 0.0778), tolerance=.tol[["inf"]]) sav <- structure(c(0.049, 0.067, 0.0458, 0.0994, 0.1493, 0.0904, 0.0374, 0.0498, 0.0351), .Dim = c(3L, 3L), .Dimnames = list(c("1", "2", "3"), c("1", "2", "3"))) expect_equivalent(hatvalues(res, type="matrix")[1:3,1:3], sav, tolerance=.tol[["inf"]]) }) test_that("cooks.distance() works for rma().", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi, vi, mods = ~ ablat, data=dat) expect_equivalent(cooks.distance(res), c(0.0048, 0.0489, 0.0104, 0.2495, 0.0072, 0.2883, 0.3643, 0.2719, 0.02, 0.1645, 0.0009, 0.0403, 0.1433), tolerance=.tol[["inf"]]) }) test_that("cooks.distance() works for rma.mv().", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma.mv(yi, vi, mods = ~ ablat, random = ~ 1 | trial, data=dat, sparse=.sparse) expect_equivalent(cooks.distance(res), c(0.0048, 0.0489, 0.0104, 0.2495, 0.0072, 0.2883, 0.3643, 0.2719, 0.02, 0.1645, 0.0009, 0.0404, 0.1434), tolerance=.tol[["inf"]]) expect_equivalent(cooks.distance(res, cluster=alloc), c(0.2591, 2.4372, 0.1533), tolerance=.tol[["inf"]]) expect_equivalent(cooks.distance(res, cluster=alloc, reestimate=FALSE), c(0.3199, 2.2194, 0.2421), tolerance=.tol[["inf"]]) }) test_that("influence() correctly works with 'na.omit' and 'na.pass'.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, slab=paste0("Trial ", dat.bcg$trial)) dat$yi[2] <- NA dat$vi[3] <- NA dat$ablat[5] <- NA dat$trial12 <- ifelse(dat$trial == 12, 1, 0) options(na.action="na.omit") expect_warning(res <- rma(yi, vi, mods = ~ ablat + trial12, data=dat)) sav <- influence(res) expect_equivalent(length(sav$inf$rstudent), 10) expect_equivalent(sum(is.na(sav$inf$rstudent)), 1) expect_equivalent(sum(is.na(sav$inf$hat)), 0) expect_equivalent(sum(is.na(sav$dfbs$intrcpt)), 1) options(na.action="na.pass") expect_warning(res <- rma(yi, vi, mods = ~ ablat + trial12, data=dat)) sav <- influence(res) expect_equivalent(length(sav$inf$rstudent), 13) expect_equivalent(sum(is.na(sav$inf$rstudent)), 4) expect_equivalent(sum(is.na(sav$inf$hat)), 3) expect_equivalent(sum(is.na(sav$dfbs$intrcpt)), 4) options(na.action="na.omit") }) test_that("'infonly' argument works correctly with influence().", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, slab=paste0("Trial ", dat.bcg$trial)) res <- rma(yi, vi, data=dat, method="EE") inf <- influence(res) tmp <- capture.output(sav <- print(inf)) expect_equivalent(length(sav$rstudent), 13) tmp <- capture.output(sav <- print(inf, infonly=TRUE)) expect_equivalent(length(sav$rstudent), 3) }) rm(list=ls()) metafor/tests/testthat/test_misc_vcov.r0000644000176200001440000000344214502304040020116 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") context("Checking misc: vcov() function") source("settings.r") test_that("vcov() works correctly for 'rma.uni' objects.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma(yi ~ ablat, vi, data=dat) expect_equivalent(vcov(res), structure(c(0.0621, -0.0016, -0.0016, 1e-04), .Dim = c(2L, 2L), .Dimnames = list(c("intrcpt", "ablat"), c("intrcpt", "ablat"))), tolerance=.tol[["var"]]) expect_equivalent(diag(vcov(res, type="obs")), dat$vi + res$tau2) expect_equivalent(vcov(res, type="fitted")[1,], c(0.0197, 0.0269, 0.0184, 0.025, -0.0007, 0.0197, 0.0033, -0.0007, 0.0085, 0.0184, 0.0026, 0.0125, 0.0125), tolerance=.tol[["var"]]) expect_equivalent(vcov(res, type="resid")[1,], c(0.3822, -0.0269, -0.0184, -0.025, 7e-04, -0.0197, -0.0033, 0.0007, -0.0085, -0.0184, -0.0026, -0.0125, -0.0125), tolerance=.tol[["var"]]) }) test_that("vcov() works correctly for 'rma.mv' objects.", { dat <- escalc(measure="RR", ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg) res <- rma.mv(yi ~ ablat, vi, random = ~ 1 | trial, data=dat, sparse=.sparse) expect_equivalent(vcov(res), structure(c(0.062, -0.0016, -0.0016, 1e-04), .Dim = c(2L, 2L), .Dimnames = list(c("intrcpt", "ablat"), c("intrcpt", "ablat"))), tolerance=.tol[["var"]]) expect_equivalent(diag(vcov(res, type="obs")), dat$vi + res$sigma2) expect_equivalent(vcov(res, type="fitted")[1,], c(0.0197, 0.0269, 0.0184, 0.025, -0.0007, 0.0197, 0.0033, -0.0007, 0.0085, 0.0184, 0.0026, 0.0125, 0.0125), tolerance=.tol[["var"]]) expect_equivalent(vcov(res, type="resid")[1,], c(0.3822, -0.0269, -0.0184, -0.025, 7e-04, -0.0197, -0.0033, 0.0007, -0.0085, -0.0184, -0.0026, -0.0125, -0.0125), tolerance=.tol[["var"]]) }) rm(list=ls()) metafor/tests/testthat/test_analysis_example_viechtbauer2007b.r0000644000176200001440000001300314503345423024525 0ustar liggesusers### library(metafor); library(testthat); Sys.setenv(NOT_CRAN="true") ### see also: https://www.metafor-project.org/doku.php/analyses:viechtbauer2007b context("Checking analysis example: viechtbauer2007b") source("settings.r") ### create dataset for example dat <- escalc(measure="RR", ai=ai, ci=ci, n1i=n1i, n2i=n2i, data=dat.linde2005) dat <- dat[c(7:10,13:25), c(13:16,18:19,11,6,7,9)] dat$dosage <- (dat$dosage * 7) / 1000 test_that("results are correct for the CIs.", { sav <- summary(dat, transf=exp)[c(13,17),] ### compare with results on page 106 tmp <- sav$ci.lb expect_equivalent(tmp, c(.7397, 1.0039), tolerance=.tol[["ci"]]) ### 1.01 in article tmp <- sav$ci.ub expect_equivalent(tmp, c(1.2793, 1.5434), tolerance=.tol[["ci"]]) }) test_that("results are correct for the equal-effects model.", { res <- rma(yi, vi, data=dat, method="EE") sav <- predict(res, transf=exp) tmp <- c(sav$pred, sav$ci.lb, sav$ci.ub) ### compare with results on page 107 expect_equivalent(tmp, c(1.3840, 1.2599, 1.5204), tolerance=.tol[["pred"]]) ### 1.39 in article expect_equivalent(res$QE, 51.5454, tolerance=.tol[["test"]]) ### 55.54 in article }) test_that("results are correct for the random-effects model.", { res <- rma(yi, vi, data=dat, method="DL") sav <- predict(res, transf=exp) ### compare with results on page 109 tmp <- c(sav$pred, sav$ci.lb, sav$ci.ub) expect_equivalent(tmp, c(1.5722, 1.3103, 1.8864), tolerance=.tol[["pred"]]) ### 1.90 in article tmp <- c(sav$pi.lb, sav$pi.ub) expect_equivalent(tmp, c(.8488, 2.9120), tolerance=.tol[["ci"]]) ### .87, 2.83 in article (but this was calculated without taking Var[hat(mu)] into consideration) expect_equivalent(res$tau2, .0903, tolerance=.tol[["var"]]) ### .091 in article }) test_that("results are correct for the mixed-effects model.", { dat$dosage <- dat$dosage * dat$duration res <- rma(yi, vi, mods = ~ I(dosage-34) * I(baseline-20), data=dat, method="DL") ### compare with results on page 112 expect_equivalent(res$tau2, .0475, tolerance=.tol[["var"]]) expect_equivalent(res$R2, 47.3778, tolerance=.tol[["r2"]]) ### 48% in article sav <- structure(list(estimate = c(0.47625885, -0.0058448, -0.06722782, -0.00156996), se = c(0.08764097, 0.00999872, 0.03522283, 0.00344659), zval = c(5.43420301, -0.58455444, -1.9086436, -0.45551255), pval = c(6e-08, 0.55884735, 0.05630808, 0.64874054)), row.names = c("intrcpt", "I(dosage - 34)", "I(baseline - 20)", "I(dosage - 34):I(baseline - 20)"), class = "data.frame") ### compare with results in Table II on page 113 expect_equivalent(coef(summary(res))[,1:4], sav, tolerance=.tol[["misc"]]) ### compare with results on page 113 sav <- predict(res, newmods=c(34-34, 12.5-20, (34-34)*(12.5-20)), transf=exp) tmp <- c(sav$pred, sav$ci.lb, sav$ci.ub) expect_equivalent(tmp, c(2.6657, 1.4560, 4.8806), tolerance=.tol[["pred"]]) ### 2.66, 1.46, 4.90 in article sav <- predict(res, newmods=c(34-34, 23.6-20, (34-34)*(23.6-20)), transf=exp) tmp <- c(sav$pred, sav$ci.lb, sav$ci.ub) expect_equivalent(tmp, c(1.2639, 0.9923, 1.6099), tolerance=.tol[["pred"]]) ### 1.61 in article skip_on_cran() png(filename="images/test_analysis_example_viechtbauer2007b_test.png", res=200, width=1800, height=1600, type="cairo") par(mar=c(4,4,1,1)) xvals <- seq(12, 24, by=0.1) - 20 modvals <- cbind(0, cbind(xvals, 0)) preds <- predict(res, modvals) regplot(res, mod=3, pred=preds, xvals=xvals, shade=FALSE, bty="l", las=1, digits=1, transf=exp, xlim=c(12,24)-20, ylim=c(0.5,4), xaxt="n", xlab="Baseline HRSD Score", ylab="Relative Rate") axis(side=1, at=seq(12, 24, by=2) - 20, labels=seq(12, 24, by=2)) dev.off() expect_true(.vistest("images/test_analysis_example_viechtbauer2007b_test.png", "images/test_analysis_example_viechtbauer2007b.png")) ### check results for all tau^2 estimators res.HS <- rma(yi, vi, mods = ~ I(dosage-34) * I(baseline-20), data=dat, method="HS") res.HE <- rma(yi, vi, mods = ~ I(dosage-34) * I(baseline-20), data=dat, method="HE") res.DL <- rma(yi, vi, mods = ~ I(dosage-34) * I(baseline-20), data=dat, method="DL") res.GENQ <- rma(yi, vi, mods = ~ I(dosage-34) * I(baseline-20), data=dat, method="GENQ", weights = n1i + n2i) res.SJ <- rma(yi, vi, mods = ~ I(dosage-34) * I(baseline-20), data=dat, method="SJ") res.DLIT <- rma(yi, vi, mods = ~ I(dosage-34) * I(baseline-20), data=dat, method="DLIT", control=list(maxiter=500)) res.SJIT <- rma(yi, vi, mods = ~ I(dosage-34) * I(baseline-20), data=dat, method="SJIT") res.PM <- rma(yi, vi, mods = ~ I(dosage-34) * I(baseline-20), data=dat, method="PM") res.ML <- rma(yi, vi, mods = ~ I(dosage-34) * I(baseline-20), data=dat, method="ML") res.REML <- rma(yi, vi, mods = ~ I(dosage-34) * I(baseline-20), data=dat, method="REML") res.EB <- rma(yi, vi, mods = ~ I(dosage-34) * I(baseline-20), data=dat, method="EB") res <- list(res.HS, res.HE, res.DL, res.GENQ, res.SJ, res.DLIT, res.SJIT, res.PM, res.ML, res.REML, res.EB) res <- data.frame(method=sapply(res, function(x) x$method), tau2=sapply(res, function(x) x$tau2), se.tau2=sapply(res, function(x) x$se.tau2)) expect_equivalent(res$tau2, c(0.0253, 0.0388, 0.0475, 0.06, 0.0912, 0.0299, 0.0633, 0.0633, 0.024, 0.0558, 0.0633), tolerance=.tol[["var"]]) expect_equivalent(res$se.tau2, c(0.0197, 0.0764, 0.0376, 0.0528, 0.0436, 0.0437, 0.046, 0.046, 0.0222, 0.0409, 0.046), tolerance=.tol[["sevar"]]) }) rm(list=ls()) metafor/tests/testthat.R0000644000176200001440000000023413150625652015040 0ustar liggesusers### to also run skip_on_cran() tests, uncomment: #Sys.setenv(NOT_CRAN="true") library(testthat) library(metafor) test_check("metafor", reporter="summary") metafor/vignettes/0000755000176200001440000000000014505063374013726 5ustar liggesusersmetafor/vignettes/metafor.pdf.asis0000644000176200001440000000015313150625652017011 0ustar liggesusers%\VignetteEngine{R.rsp::asis} %\VignetteIndexEntry{Conducting Meta-Analyses in R with the metafor Package} metafor/vignettes/diagram.pdf.asis0000644000176200001440000000014013150625652016754 0ustar liggesusers%\VignetteEngine{R.rsp::asis} %\VignetteIndexEntry{Diagram of Functions in the metafor Package} metafor/R/0000755000176200001440000000000014505026436012115 5ustar liggesusersmetafor/R/print.rma.mh.r0000644000176200001440000001012714305366056014621 0ustar liggesusersprint.rma.mh <- function(x, digits, showfit=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.mh") if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } .space() cat(mstyle$section("Equal-Effects Model")) cat(mstyle$section(paste0(" (k = ", x$k, ")"))) cat("\n") if (showfit) { fs <- fmtx(x$fit.stats$ML, digits[["fit"]]) names(fs) <- c("logLik", "deviance", "AIC", "BIC", "AICc") cat("\n") tmp <- capture.output(print(fs, quote=FALSE, print.gap=2)) #tmp[1] <- paste0(tmp[1], "\u200b") .print.table(tmp, mstyle) } cat("\n") if (!is.na(x$I2)) { cat(mstyle$text("I^2 (total heterogeneity / total variability): ")) cat(mstyle$result(paste0(fmtx(x$I2, 2), "%"))) cat("\n") } if (!is.na(x$H2)) { cat(mstyle$text("H^2 (total variability / sampling variability): ")) cat(mstyle$result(fmtx(x$H2, 2))) cat("\n") } if (!is.na(x$QE)) { cat("\n") cat(mstyle$section("Test for Heterogeneity:"), "\n") cat(mstyle$result(fmtt(x$QE, "Q", df=ifelse(x$k.yi-1 >= 0, x$k.yi-1, 0), pval=x$QEp, digits=digits))) } if (any(!is.na(c(x$I2, x$H2, x$QE)))) cat("\n\n") if (is.element(x$measure, c("OR","RR","IRR"))) { res.table <- c(estimate=fmtx(unname(x$beta), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), zval=fmtx(x$zval, digits[["test"]]), pval=fmtp(x$pval, digits[["pval"]]), ci.lb=fmtx(x$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$ci.ub, digits[["ci"]])) res.table.exp <- c(estimate=fmtx(exp(unname(x$beta)), digits[["est"]]), ci.lb=fmtx(exp(x$ci.lb), digits[["ci"]]), ci.ub=fmtx(exp(x$ci.ub), digits[["ci"]])) cat(mstyle$section("Model Results (log scale):")) cat("\n\n") tmp <- capture.output(.print.vector(res.table)) .print.table(tmp, mstyle) cat("\n") cat(mstyle$section(paste0("Model Results (", x$measure, " scale):"))) cat("\n\n") tmp <- capture.output(.print.vector(res.table.exp)) .print.table(tmp, mstyle) if (x$measure == "OR") { cat("\n") MH <- fmtx(x$MH, digits[["test"]]) TA <- fmtx(x$TA, digits[["test"]]) if (is.na(MH) && is.na(TA)) { width <- 1 } else { width <- max(nchar(MH), nchar(TA), na.rm=TRUE) } cat(mstyle$text("Cochran-Mantel-Haenszel Test: ")) if (is.na(MH)) { cat(mstyle$result("test value not computable for these data")) cat("\n") } else { cat(mstyle$result(paste0("CMH = ", formatC(MH, width=width), ", df = 1,", paste(rep(" ", nchar(x$k.pos)-1L), collapse=""), " p-val ", fmtp(x$MHp, digits[["pval"]], equal=TRUE, sep=TRUE, add0=TRUE)))) cat("\n") } cat(mstyle$text("Tarone's Test for Heterogeneity: ")) if (is.na(TA)) { cat(mstyle$result("test value not computable for these data")) } else { cat(mstyle$result(paste0("X^2 = ", formatC(TA, width=width), ", df = ", x$k.pos-1, ", p-val ", fmtp(x$TAp, digits[["pval"]], equal=TRUE, sep=TRUE, add0=TRUE)))) } cat("\n") } if (x$measure == "IRR") { cat("\n") cat(mstyle$text("Mantel-Haenszel Test: ")) if (is.na(x$MH)) { cat(mstyle$result("test value not computable for these data")) } else { cat(mstyle$result(paste0("MH = ", fmtx(x$MH, digits[["test"]]), ", df = 1, p-val ", fmtp(x$MHp, digits[["pval"]], equal=TRUE, sep=TRUE)))) } cat("\n") } } else { res.table <- c(estimate=fmtx(unname(x$beta), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), zval=fmtx(x$zval, digits[["test"]]), pval=fmtp(x$pval, digits[["pval"]]), ci.lb=fmtx(x$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$ci.ub, digits[["ci"]])) cat(mstyle$section("Model Results:")) cat("\n\n") tmp <- capture.output(.print.vector(res.table)) .print.table(tmp, mstyle) } .space() invisible() } metafor/R/misc.func.hidden.profile.r0000644000176200001440000002521514440115567017065 0ustar liggesusers### for profile(), confint(), and gosh() .profile.rma.uni <- function(val, obj, parallel=FALSE, profile=FALSE, confint=FALSE, subset=FALSE, objective, model=0L, verbose=FALSE, outlist=NULL) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (parallel == "snow") library(metafor) if (profile || confint) { ### for profile and confint, fit model with tau2 fixed to 'val' args <- list(yi=obj$yi, vi=obj$vi, weights=obj$weights, mods=obj$X, intercept=FALSE, method=obj$method, weighted=obj$weighted, test=obj$test, level=obj$level, control=obj$control, tau2=val, skipr2=TRUE, outlist="minimal") res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=TRUE) } if (profile) { if (inherits(res, "try-error")) { sav <- list(ll = NA_real_, beta = matrix(NA_real_, nrow=nrow(obj$beta), ncol=1), ci.lb = rep(NA_real_, length(obj$ci.lb)), ci.ub = rep(NA_real_, length(obj$ci.ub))) } else { sav <- list(ll = logLik(res), beta = res$beta, ci.lb = res$ci.lb, ci.ub = res$ci.ub) } } if (confint) { if (inherits(res, "try-error")) { if (verbose) cat(mstyle$verbose(paste("tau2 =", fmtx(val, obj$digits[["var"]], addwidth=4), " LRT - objective = NA", "\n"))) stop() } else { sav <- c(-2*(logLik(res) - logLik(obj)) - objective) if (verbose) cat(mstyle$verbose(paste("tau2 =", fmtx(val, obj$digits[["var"]], addwidth=4), " LRT - objective =", fmtx(sav, obj$digits[["test"]], addwidth=4), "\n"))) } } if (subset) { ### for subset, fit model to subset as specified by 'val' if (model >= 1L) { # special cases for gosh() for FE and RE+DL models yi <- obj$yi[val] vi <- obj$vi[val] k <- length(yi) wi <- 1/vi sumwi <- sum(wi) est <- sum(wi*yi)/sumwi Q <- 0 I2 <- 0 H2 <- 1 tau2 <- 0 if (k > 1) { Q <- sum(wi * (yi - est)^2) I2 <- max(0, 100 * (Q - (k-1)) / Q) H2 <- Q / (k-1) if (model == 2L) { tau2 <- max(0, (Q - (k-1)) / (sumwi - sum(wi^2)/sumwi)) wi <- 1 / (vi + tau2) est <- sum(wi*yi)/sum(wi) } } sav <- list(beta = est, k = k, QE = Q, I2 = I2, H2 = H2, tau2 = tau2) } else { args <- list(yi=obj$yi, vi=obj$vi, weights=obj$weights, mods=obj$X, intercept=FALSE, method=obj$method, weighted=obj$weighted, test=obj$test, level=obj$level, control=obj$control, tau2=ifelse(obj$tau2.fix, obj$tau2, NA), subset=val, skipr2=TRUE, outlist=outlist) sav <- try(suppressWarnings(.do.call(rma.uni, args)), silent=TRUE) } } return(sav) } .profile.rma.mv <- function(val, obj, comp, sigma2.pos, tau2.pos, rho.pos, gamma2.pos, phi.pos, parallel=FALSE, profile=FALSE, confint=FALSE, subset=FALSE, objective, verbose=FALSE) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (parallel == "snow") library(metafor) if (profile || confint) { ### for profile and confint, fit model with component fixed to 'val' ### set any fixed components to their values sigma2.arg <- ifelse(obj$vc.fix$sigma2, obj$sigma2, NA_real_) tau2.arg <- ifelse(obj$vc.fix$tau2, obj$tau2, NA_real_) rho.arg <- ifelse(obj$vc.fix$rho, obj$rho, NA_real_) gamma2.arg <- ifelse(obj$vc.fix$gamma2, obj$gamma2, NA_real_) phi.arg <- ifelse(obj$vc.fix$phi, obj$phi, NA_real_) if (comp == "sigma2") sigma2.arg[sigma2.pos] <- val if (comp == "tau2") tau2.arg[tau2.pos] <- val if (comp == "rho") rho.arg[rho.pos] <- val if (comp == "gamma2") gamma2.arg[gamma2.pos] <- val if (comp == "phi") phi.arg[phi.pos] <- val args <- list(yi=obj$yi, V=obj$V, W=obj$W, mods=obj$X, random=obj$random, struct=obj$struct, intercept=FALSE, data=obj$mf.r, method=obj$method, test=obj$test, dfs=obj$dfs, level=obj$level, R=obj$R, Rscale=obj$Rscale, sigma2=sigma2.arg, tau2=tau2.arg, rho=rho.arg, gamma2=gamma2.arg, phi=phi.arg, sparse=obj$sparse, dist=obj$dist, vccon=obj$vccon, control=obj$control, outlist="minimal") res <- try(suppressWarnings(.do.call(rma.mv, args)), silent=TRUE) } if (profile) { if (inherits(res, "try-error")) { sav <- list(ll = NA_real_, beta = matrix(NA_real_, nrow=nrow(obj$beta), ncol=1), ci.lb = rep(NA_real_, length(obj$ci.lb)), ci.ub = rep(NA_real_, length(obj$ci.ub))) } else { sav <- list(ll = logLik(res), beta = res$beta, ci.lb = res$ci.lb, ci.ub = res$ci.ub) } } if (confint) { if (inherits(res, "try-error")) { if (verbose) cat(mstyle$verbose(paste("val =", fmtx(val, obj$digits[["var"]], addwidth=4), " LRT - objective = NA", "\n"))) stop() } else { sav <- c(-2*(logLik(res) - logLik(obj)) - objective) if (verbose) cat(mstyle$verbose(paste("val =", fmtx(val, obj$digits[["var"]], addwidth=4), " LRT - objective =", fmtx(sav, obj$digits[["fit"]], addwidth=4), "\n"))) } } return(sav) } .profile.rma.mh <- function(val, obj, parallel=FALSE, subset=FALSE, outlist=NULL) { if (parallel == "snow") library(metafor) if (subset) { ### for subset, fit model to subset as specified by 'val' if (is.element(obj$measure, c("RR","OR","RD"))) { # obj$outdat.f$ai[obj$not.na] since obj$outlist$ai values may be modified args <- list(ai=obj$outdat.f$ai[obj$not.na], bi=obj$outdat.f$bi[obj$not.na], ci=obj$outdat.f$ci[obj$not.na], di=obj$outdat.f$di[obj$not.na], measure=obj$measure, add=obj$add, to=obj$to, drop00=obj$drop00, correct=obj$correct, level=obj$level, subset=val, outlist=outlist) } else { args <- list(x1i=obj$outdat.f$x1i[obj$not.na], x2i=obj$outdat.f$x2i[obj$not.na], t1i=obj$outdat.f$t1i[obj$not.na], t2i=obj$outdat.f$t2i[obj$not.na], measure=obj$measure, add=obj$add, to=obj$to, drop00=obj$drop00, correct=obj$correct, level=obj$level, subset=val, outlist=outlist) } sav <- try(suppressWarnings(.do.call(rma.mh, args)), silent=TRUE) } return(sav) } .profile.rma.peto <- function(val, obj, parallel=FALSE, subset=FALSE, outlist=NULL) { if (parallel == "snow") library(metafor) if (subset) { ### for subset, fit model to subset as specified by 'val' args <- list(ai=obj$outdat.f$ai[obj$not.na], bi=obj$outdat.f$bi[obj$not.na], ci=obj$outdat.f$ci[obj$not.na], di=obj$outdat.f$di[obj$not.na], add=obj$add, to=obj$to, drop00=obj$drop00, level=obj$level, subset=val, outlist=outlist) sav <- try(suppressWarnings(.do.call(rma.peto, args)), silent=TRUE) } return(sav) } .profile.rma.uni.selmodel <- function(val, obj, comp, delta.pos, parallel=FALSE, profile=FALSE, confint=FALSE, subset=FALSE, objective, verbose=FALSE) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (parallel == "snow") library(metafor) if (profile || confint) { ### for profile and confint, fit model with component fixed to 'val' ### set any fixed components to their values tau2.arg <- ifelse(is.element(obj$method, c("FE","EE","CE")) || obj$tau2.fix, obj$tau2, NA_real_) delta.arg <- ifelse(obj$delta.fix, obj$delta, NA_real_) if (comp == "tau2") tau2.arg <- val if (comp == "delta") delta.arg[delta.pos] <- val ### reset steps to NA if !stepsspec (some types set steps=0 if steps was not specified) if (!obj$stepsspec) obj$steps <- NA res <- try(suppressWarnings( selmodel(obj, obj$type, alternative=obj$alternative, prec=obj$prec, scaleprec=obj$scaleprec, tau2=tau2.arg, delta=delta.arg, steps=obj$steps, verbose=FALSE, control=obj$control, skiphes=confint, skiphet=TRUE, defmap=obj$defmap, mapfun=obj$mapfun, mapinvfun=obj$mapinvfun)), silent=TRUE) } if (profile) { if (inherits(res, "try-error")) { sav <- list(ll = NA_real_, beta = matrix(NA_real_, nrow=nrow(obj$beta), ncol=1), ci.lb = rep(NA_real_, length(obj$ci.lb)), ci.ub = rep(NA_real_, length(obj$ci.ub))) } else { sav <- list(ll = logLik(res), beta = res$beta, ci.lb = res$ci.lb, ci.ub = res$ci.ub) } } if (confint) { if (inherits(res, "try-error")) { if (verbose) cat(mstyle$verbose(paste("val =", fmtx(val, obj$digits[["var"]], addwidth=4), " LRT - objective = NA", "\n"))) stop() } else { sav <- c(-2*(logLik(res) - logLik(obj)) - objective) if (verbose) cat(mstyle$verbose(paste("val =", fmtx(val, obj$digits[["var"]], addwidth=4), " LRT - objective =", fmtx(sav, obj$digits[["fit"]], addwidth=4), "\n"))) } } return(sav) } .profile.rma.ls <- function(val, obj, comp, alpha.pos, parallel=FALSE, profile=FALSE, confint=FALSE, subset=FALSE, objective, verbose=FALSE) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (parallel == "snow") library(metafor) if (profile || confint) { ### for profile and confint, fit model with component fixed to 'val' ### set any fixed components to their values alpha.arg <- ifelse(obj$alpha.fix, obj$alpha, NA_real_) if (comp == "alpha") alpha.arg[alpha.pos] <- val args <- list(yi=obj$yi, vi=obj$vi, weights=obj$weights, mods=obj$X, intercept=FALSE, scale=obj$Z, link=obj$link, method=obj$method, weighted=obj$weighted, test=obj$test, level=obj$level, control=obj$control, skiphes=TRUE, alpha=alpha.arg, outlist="minimal") res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=TRUE) } if (profile) { if (inherits(res, "try-error")) { sav <- list(ll = NA_real_, beta = matrix(NA_real_, nrow=nrow(obj$beta), ncol=1), ci.lb = rep(NA_real_, length(obj$ci.lb)), ci.ub = rep(NA_real_, length(obj$ci.ub))) } else { sav <- list(ll = logLik(res), beta = res$beta, ci.lb = res$ci.lb, ci.ub = res$ci.ub) } } if (confint) { if (inherits(res, "try-error")) { if (verbose) cat(mstyle$verbose(paste("val =", fmtx(val, obj$digits[["var"]], addwidth=4), " LRT - objective = NA", "\n"))) stop() } else { sav <- c(-2*(logLik(res) - logLik(obj)) - objective) if (verbose) cat(mstyle$verbose(paste("val =", fmtx(val, obj$digits[["var"]], addwidth=4), " LRT - objective =", fmtx(sav, obj$digits[["fit"]], addwidth=4), "\n"))) } } return(sav) } metafor/R/print.regtest.r0000644000176200001440000000455314402114016015103 0ustar liggesusersprint.regtest <- function(x, digits=x$digits, ret.fit=x$ret.fit, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="regtest") digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) .space() cat(mstyle$section("Regression Test for Funnel Plot Asymmetry")) cat("\n\n") if (x$model == "lm") { cat(mstyle$text("Model: weighted regression with multiplicative dispersion")) } else { cat(mstyle$text(paste("Model: ", ifelse(is.element(x$method, c("FE","EE","CE")), "fixed-effects", "mixed-effects"), "meta-regression model"))) } cat("\n") if (x$predictor == "sei") cat(mstyle$text("Predictor: standard error")) if (x$predictor == "vi") cat(mstyle$text("Predictor: sampling variance")) if (x$predictor == "ni") cat(mstyle$text("Predictor: sample size")) if (x$predictor == "ninv") cat(mstyle$text("Predictor: inverse of the sample size")) if (x$predictor == "sqrtni") cat(mstyle$text("Predictor: square root sample size")) if (x$predictor == "sqrtninv") cat(mstyle$text("Predictor: inverse of the square root sample size")) cat("\n") if (ret.fit) { if (x$model == "lm") { print(summary(x$fit)) } else { .space(FALSE) print(x$fit) .space(FALSE) } } else { cat("\n") } cat(mstyle$text("Test for Funnel Plot Asymmetry: ")) if (is.na(x$ddf)) { cat(mstyle$result(fmtt(x$zval, "z", pval=x$pval, pname="p", format=2, digits=digits, flag=ifelse(!is.null(x$est) && sign(x$zval)!=sign(x$est), " ", "")))) } else { cat(mstyle$result(fmtt(x$zval, "t", df=x$ddf, pval=x$pval, pname="p", format=2, digits=digits, flag=ifelse(!is.null(x$est) && sign(x$zval)!=sign(x$est), " ", "")))) } cat("\n") if (!is.null(x$est)) { if (x$predictor == "sei") cat(mstyle$text("Limit Estimate (as sei -> 0): ")) if (x$predictor == "vi") cat(mstyle$text("Limit Estimate (as vi -> 0): ")) if (x$predictor %in% c("ninv", "sqrtninv")) cat(mstyle$text("Limit Estimate (as ni -> inf): ")) cat(mstyle$result(paste0("b = ", fmtx(x$est, digits[["est"]], flag=ifelse(sign(x$zval)!=sign(x$est), " ", "")), " (CI: ", fmtx(x$ci.lb, digits[["est"]]), ", ", fmtx(x$ci.ub, digits[["est"]]), ")"))) cat("\n") } .space() invisible() } metafor/R/addpoly.default.r0000644000176200001440000002775114505024241015363 0ustar liggesusers# Note: If x and vi (or sei) are specified, the CI bounds for the polygon are # calculated based on a normal distribution. But the Knapp and Hartung method # may have been used to obtain vi (or sei), in which case we would want to use # a t-distribution. Adding a corresponding argument would be a bit awkward, # since the user would then have to specify the degrees of freedom. Instead, # the user can just pass the CI (and PI) bounds (that were calculated with # test="knha") directly to the function via the ci.lb and ci.ub (and pi.lb and # pi.ub) arguments. addpoly.default <- function(x, vi, sei, ci.lb, ci.ub, pi.lb, pi.ub, rows=-1, level, annotate, digits, width, mlab, transf, atransf, targs, efac, col, border, lty, fonts, cex, constarea=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (missing(x)) stop(mstyle$stop("Must specify 'x' argument.")) k <- length(x) if (missing(level)) level <- .getfromenv("forest", "level", default=95) if (missing(annotate)) annotate <- .getfromenv("forest", "annotate", default=TRUE) if (missing(digits)) digits <- .getfromenv("forest", "digits", default=2) if (missing(width)) width <- .getfromenv("forest", "width", default=NULL) if (missing(transf)) transf <- .getfromenv("forest", "transf", default=FALSE) if (missing(atransf)) atransf <- .getfromenv("forest", "atransf", default=FALSE) if (is.function(transf) && is.function(atransf)) stop(mstyle$stop("Use either 'transf' or 'atransf' to specify a transformation (not both).")) if (missing(targs)) targs <- .getfromenv("forest", "targs", default=NULL) if (missing(efac)) efac <- .getfromenv("forest", "efac", default=1) ### vertical expansion factor: 1st = PI end lines, 2nd = arrows, 3rd = polygon(s) ### vertical expansion factor: 1st = polygon(s), 2nd = PI end lines ### note: forest.rma() puts 'efac' into .metafor in the order: ### 1st = CI/PI end lines, 2nd = arrows, 3rd = summary polygon or fitted polygons ### so need to pick out the 3rd and 1st element in that order if (length(efac) == 3L) efac <- c(efac[3], efac[1]) if (length(efac) == 1L) efac <- rep(efac, 2L) if (missing(fonts)) fonts <- .getfromenv("forest", "fonts", default=NULL) if (missing(mlab)) mlab <- NULL if (missing(col)) col <- par("fg") if (missing(border)) border <- par("fg") if (missing(lty)) lty <- "dotted" if (missing(cex)) cex <- .getfromenv("forest", "cex", default=NULL) ddd <- list(...) if (!is.null(ddd$cr.lb)) pi.lb <- ddd$cr.lb if (!is.null(ddd$cr.ub)) pi.ub <- ddd$cr.ub if (is.null(mlab)) { mlab <- rep("", k) } else { if (length(mlab) == 1L) mlab <- rep(mlab, k) if (length(mlab) != k) stop(mstyle$stop(paste0("Length of the 'mlab' argument (", length(mlab), ") does not correspond to the number of polygons to be plotted (", k, ")."))) } if (length(lty) == 1L) lty <- c(lty, "solid") ### annotation symbols vector if (is.null(ddd$annosym)) { annosym <- .getfromenv("forest", "annosym", default=NULL) } else { annosym <- ddd$annosym } if (is.null(annosym)) annosym <- c(" [", ", ", "]", "-", " ") # 4th element for minus sign symbol; 5th for space (in place of numbers and +) if (length(annosym) == 3L) annosym <- c(annosym, "-", " ") if (length(annosym) == 4L) annosym <- c(annosym, " ") if (length(annosym) != 5) stop(mstyle$stop("Argument 'annosym' must be a vector of length 3 (or 4 or 5).")) if (is.null(ddd$lcol)) { lcol <- .coladj(par("fg"), dark=-0.3, light=0.3) } else { lcol <- ddd$lcol } lsegments <- function(..., cr.lb, cr.ub, addcred, pi.type, lcol, annosym, textpos) segments(...) ltext <- function(..., cr.lb, cr.ub, addcred, pi.type, lcol, annosym, textpos) text(...) lpolygon <- function(..., cr.lb, cr.ub, addcred, pi.type, lcol, annosym, textpos) polygon(...) ### set/get fonts (1st for labels, 2nd for annotations) ### when passing a named vector, the names are for 'family' and the values are for 'font' if (is.null(fonts)) { fonts <- rep(par("family"), 2L) } else { if (length(fonts) == 1L) fonts <- rep(fonts, 2L) } if (is.null(names(fonts))) fonts <- setNames(c(1L,1L), nm=fonts) par(family=names(fonts)[1], font=fonts[1]) ######################################################################### level <- .level(level) yi <- x if (!missing(vi) && is.function(vi)) # if vi is utils::vi() stop(mstyle$stop("Cannot find variable specified for 'vi' argument."), call.=FALSE) if (hasArg(ci.lb) && hasArg(ci.ub)) { ### CI bounds are specified by user if (length(ci.lb) != length(ci.ub)) stop(mstyle$stop("Length of 'ci.lb' and 'ci.ub' is not the same.")) if (missing(vi) && missing(sei)) { ### vi/sei not specified, so calculate vi based on CI bounds ### note: assumes that the CI is a symmetric Wald-type CI ### computed based on a standard normal distribution vi <- ((ci.ub - ci.lb) / (2*qnorm(level/2, lower.tail=FALSE)))^2 } else { ### vi not specified, but sei is, so set vi = sei^2 if (missing(vi)) vi <- sei^2 } if (length(ci.lb) != length(vi)) stop(mstyle$stop("Length of 'vi' (or 'sei') does not match length of ('ci.lb', 'ci.ub') pairs.")) } else { ### CI bounds are not specified by user if (missing(vi)) { if (missing(sei)) { stop(mstyle$stop("Must specify either 'vi', 'sei', or ('ci.lb', 'ci.ub') pairs.")) } else { vi <- sei^2 } } if (length(vi) != k) stop(mstyle$stop("Length of 'vi' (or 'sei') does not match length of 'x'.")) ci.lb <- yi - qnorm(level/2, lower.tail=FALSE) * sqrt(vi) ci.ub <- yi + qnorm(level/2, lower.tail=FALSE) * sqrt(vi) } if (hasArg(pi.lb) && hasArg(pi.ub)) { if (length(pi.lb) != length(pi.ub)) stop(mstyle$stop("Length of 'pi.lb' and 'pi.ub' is not the same.")) if (length(pi.lb) != k) stop(mstyle$stop("Length of ('pi.lb', 'pi.ub') does not match length of 'x'.")) } else { pi.lb <- rep(NA_real_, k) pi.ub <- rep(NA_real_, k) } ### set rows value if (is.null(rows)) { rows <- -1:(-k) } else { if (length(rows) == 1L) rows <- rows:(rows-k+1) } if (length(rows) != k) stop(mstyle$stop(paste0("Length of the 'rows' argument (", length(rows), ") does not correspond to the number of polygons to be plotted (", k, ")."))) ### check for NAs in yi/vi and act accordingly yivi.na <- is.na(yi) | is.na(vi) if (any(yivi.na)) { not.na <- !yivi.na if (na.act == "na.omit") { yi <- yi[not.na] vi <- vi[not.na] ci.lb <- ci.lb[not.na] ci.ub <- ci.ub[not.na] pi.lb <- pi.lb[not.na] pi.ub <- pi.ub[not.na] mlab <- mlab[not.na] ### rearrange rows due to NAs being omitted rows.new <- rows rows.na <- rows[!not.na] for (j in seq_along(rows.na)) { rows.new[rows <= rows.na[j]] <- rows.new[rows <= rows.na[j]] + 1 } rows <- rows.new[not.na] } if (na.act == "na.fail") stop(mstyle$stop("Missing values in results.")) } k <- length(yi) ### if requested, apply transformation to yi's and CI bounds if (is.function(transf)) { if (is.null(targs)) { yi <- sapply(yi, transf) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) pi.lb <- sapply(pi.lb, transf) pi.ub <- sapply(pi.ub, transf) } else { yi <- sapply(yi, transf, targs) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) pi.lb <- sapply(pi.lb, transf, targs) pi.ub <- sapply(pi.ub, transf, targs) } } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] tmp <- .psort(pi.lb, pi.ub) pi.lb <- tmp[,1] pi.ub <- tmp[,2] ### determine height of plot and set cex accordingly (if not specified) par.usr <- par("usr") height <- par.usr[4]-par.usr[3] ### cannot use this since the value of k used in creating the plot is unknown #lheight <- strheight("O") #cex.adj <- ifelse(k * lheight > height * 0.8, height/(1.25 * k * lheight), 1) cex.adj <- min(1,20/height) xlim <- par.usr[1:2] if (is.null(cex)) cex <- par("cex") * cex.adj ### allow adjustment of position of study labels and annotations via textpos argument if (is.null(ddd$textpos)) { textpos <- .getfromenv("forest", "textpos", default=xlim) } else { textpos <- ddd$textpos } if (length(textpos) != 2L) stop(mstyle$stop("Argument 'textpos' must be of length 2.")) if (is.na(textpos[1])) textpos[1] <- xlim[1] if (is.na(textpos[2])) textpos[2] <- xlim[2] ### add annotations if (annotate) { if (is.function(atransf)) { if (is.null(targs)) { annotext <- cbind(sapply(yi, atransf), sapply(ci.lb, atransf), sapply(ci.ub, atransf)) } else { annotext <- cbind(sapply(yi, atransf, targs), sapply(ci.lb, atransf, targs), sapply(ci.ub, atransf, targs)) } ### make sure order of intervals is always increasing tmp <- .psort(annotext[,2:3]) annotext[,2:3] <- tmp } else { annotext <- cbind(yi, ci.lb, ci.ub) } annotext <- fmtx(annotext, digits[[1]]) if (is.null(width)) { width <- apply(annotext, 2, function(x) max(nchar(x))) } else { if (length(width) == 1L) width <- rep(width, ncol(annotext)) } for (j in seq_len(ncol(annotext))) { annotext[,j] <- formatC(annotext[,j], width=width[j]) } annotext <- cbind(annotext[,1], annosym[1], annotext[,2], annosym[2], annotext[,3], annosym[3]) annotext <- apply(annotext, 1, paste, collapse="") annotext <- gsub("-", annosym[4], annotext, fixed=TRUE) annotext <- gsub(" ", annosym[5], annotext, fixed=TRUE) par(family=names(fonts)[2], font=fonts[2]) ltext(x=textpos[2], rows, labels=annotext, pos=2, cex=cex, ...) par(family=names(fonts)[1], font=fonts[1]) } if (length(col) == 1L) col <- rep(col, k) if (length(border) == 1L) border <- rep(border, k) if (length(lcol) == 1L) lcol <- rep(lcol, k) if (isTRUE(constarea)) { areas <- (ci.ub - ci.lb) * (height/100)*cex*efac[1] areas <- areas / min(areas, na.rm=TRUE) invareas <- 1 / areas heights <- (height/100)*cex*efac[1]*invareas } else { heights <- rep((height/100)*cex*efac[1], k) } ### add polygon(s) for (i in seq_len(k)) { ### prediction interval(s) lsegments(pi.lb[i], rows[i], pi.ub[i], rows[i], lty=lty[1], col=lcol[i], ...) lsegments(pi.lb[i], rows[i]-(height/150)*cex*efac[2], pi.lb[i], rows[i]+(height/150)*cex*efac[2], col=lcol[i], lty=lty[2], ...) lsegments(pi.ub[i], rows[i]-(height/150)*cex*efac[2], pi.ub[i], rows[i]+(height/150)*cex*efac[2], col=lcol[i], lty=lty[2], ...) ### polygon(s) lpolygon(x=c(ci.lb[i], yi[i], ci.ub[i], yi[i]), y=c(rows[i], rows[i]+heights[i], rows[i], rows[i]-heights[i]), col=col[i], border=border[i], ...) ### label(s) if (!is.null(mlab)) { if (is.list(mlab)) { ltext(x=textpos[1], rows[i], mlab[[i]], pos=4, cex=cex, ...) } else { ltext(x=textpos[1], rows[i], mlab[i], pos=4, cex=cex, ...) } } } } metafor/R/addpoly.rma.r0000644000176200001440000000466314423777217014534 0ustar liggesusersaddpoly.rma <- function(x, row=-2, level=x$level, annotate, addpred=FALSE, digits, width, mlab, transf, atransf, targs, efac, col, border, lty, fonts, cex, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma") if (!x$int.only) stop(mstyle$stop("Fitted model should not contain moderators.")) if (missing(annotate)) annotate <- .getfromenv("forest", "annotate", default=TRUE) if (missing(digits)) digits <- .getfromenv("forest", "digits", default=2) if (missing(width)) width <- .getfromenv("forest", "width", default=NULL) if (missing(mlab)) mlab <- NULL if (missing(transf)) transf <- .getfromenv("forest", "transf", default=FALSE) if (missing(atransf)) atransf <- .getfromenv("forest", "atransf", default=FALSE) if (missing(targs)) targs <- .getfromenv("forest", "targs", default=NULL) if (missing(efac)) efac <- .getfromenv("forest", "efac", default=1) if (missing(col)) col <- par("fg") if (missing(border)) border <- par("fg") if (missing(lty)) lty <- "dotted" if (missing(fonts)) fonts <- .getfromenv("forest", "fonts", default=NULL) if (missing(cex)) cex <- .getfromenv("forest", "cex", default=NULL) ddd <- list(...) if (!is.null(ddd$addcred)) addpred <- ddd$addcred if (is.null(ddd$pi.type)) { pi.type <- "default" } else { pi.type <- ddd$pi.type } pred <- predict(x, level=level, pi.type=pi.type) ci.lb <- pred$ci.lb ci.ub <- pred$ci.ub if (addpred) { pi.lb <- pred$pi.lb pi.ub <- pred$pi.ub } else { pi.lb <- NA_real_ pi.ub <- NA_real_ } ######################################################################### ### label for model estimate (if not specified) if (is.null(mlab)) mlab <- sapply(x$method, switch, "FE"="FE Model", "EE"="EE Model", "CE"="CE Model", "RE Model", USE.NAMES=FALSE) ### passing ci.lb and ci.ub, so that the bounds are correct when the model was fitted with test="knha" addpoly(x$beta, ci.lb=ci.lb, ci.ub=ci.ub, pi.lb=pi.lb, pi.ub=pi.ub, rows=row, level=level, annotate=annotate, digits=digits, width=width, mlab=mlab, transf=transf, atransf=atransf, targs=targs, efac=efac, col=col, border=border, lty=lty, fonts=fonts, cex=cex, ...) } metafor/R/anova.rma.r0000644000176200001440000006511014440114672014163 0ustar liggesusersanova.rma <- function(object, object2, btt, X, att, Z, rhs, digits, refit=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma", notap=c("rma.mh", "rma.peto"), notav="rma.glmm") if (missing(digits)) { digits <- .get.digits(xdigits=object$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=object$digits, dmiss=FALSE) } ddd <- list(...) .chkdots(ddd, c("test", "L", "verbose", "fixed")) if (!is.null(ddd$L)) X <- ddd$L if (is.null(ddd$fixed)) { fixed <- FALSE } else { fixed <- .isTRUE(ddd$fixed) } if (!missing(att) && !inherits(object, "rma.ls")) stop(mstyle$stop("Can only specify 'att' for location-scale models.")) if (!missing(Z) && !inherits(object, "rma.ls")) stop(mstyle$stop("Can only specify 'Z' for location-scale models.")) if (missing(object2)) { ### if only 'object' has been specified, can use function to test one or multiple coefficients ### via the 'btt' (or 'att') argument or one or more linear contrasts of the coefficients via ### the 'X' (or 'Z') argument x <- object if (missing(X) && missing(Z)) { ### if 'X' (and 'Z') has not been specified, then do a Wald-test via the 'btt' argument (can also use 'att' for location-scale models) if (inherits(object, "rma.ls") && !missing(att)) { if (!missing(btt)) stop(mstyle$stop("Can only specify either 'btt' or 'att', but not both.")) ### set/check 'att' argument if (missing(att) || is.null(att)) { att <- x$att } else { if (is.character(att) && length(att) > 1L) att <- as.list(att) if (is.list(att)) { if (!missing(rhs)) stop(mstyle$stop("Cannot use 'rhs' argument when specifying a list for 'att'.")) sav <- lapply(att, function(attj) anova(x, att=attj, digits=digits, fixed=fixed)) names(sav) <- sapply(att, .format.btt) class(sav) <- "list.anova.rma" return(sav) } att <- .set.btt(att, x$q, x$Z.int.incl, colnames(x$Z), fixed=fixed) } m <- length(att) if (missing(rhs)) { rhs <- rep(0, m) } else { if (length(rhs) == 1L) rhs <- rep(rhs, m) if (length(rhs) != m) stop(mstyle$stop(paste0("Length of 'rhs' (", length(rhs), ") does not match the number of coefficients tested (", m, ")."))) } x$alpha[att,] <- x$alpha[att,] - rhs QS <- try(as.vector(t(x$alpha)[att] %*% chol2inv(chol(x$va[att,att])) %*% x$alpha[att]), silent=TRUE) if (inherits(QS, "try-error")) QS <- NA_real_ if (is.element(x$test, c("knha","adhoc","t"))) { QS <- QS / m QSdf <- c(m, x$QSdf[2]) QSp <- pf(QS, df1=QSdf[1], df2=QSdf[2], lower.tail=FALSE) } else { QSdf <- c(m, NA) QSp <- pchisq(QS, df=QSdf[1], lower.tail=FALSE) } res <- list(QS=QS, QSdf=QSdf, QSp=QSp, att=att, k=x$k, q=x$q, m=m, test=x$test, digits=digits, type="Wald.att") } else { ### set/check 'btt' argument if (missing(btt) || is.null(btt)) { btt <- x$btt } else { if (is.character(btt) && length(btt) > 1L) btt <- as.list(btt) if (is.list(btt)) { if (!missing(rhs)) stop(mstyle$stop("Cannot use 'rhs' argument when specifying a list for 'btt'.")) sav <- lapply(btt, function(bttj) anova(x, btt=bttj, digits=digits, fixed=fixed)) names(sav) <- sapply(btt, .format.btt) class(sav) <- "list.anova.rma" return(sav) } btt <- .set.btt(btt, x$p, x$int.incl, colnames(x$X), fixed=fixed) } m <- length(btt) if (missing(rhs)) { rhs <- rep(0, m) } else { if (length(rhs) == 1L) rhs <- rep(rhs, m) if (length(rhs) != m) stop(mstyle$stop(paste0("Length of 'rhs' (", length(rhs), ") does not match the number of coefficients tested (", m, ")."))) } x$b[btt,] <- x$beta[btt,] <- x$b[btt,] - rhs if (inherits(x, "robust.rma") && x$robumethod == "clubSandwich") { cs.wald <- try(clubSandwich::Wald_test(x, cluster=x$cluster, vcov=x$vb, test=x$wald_test, constraints=clubSandwich::constrain_zero(btt)), silent=!isTRUE(ddd$verbose)) if (inherits(cs.wald, "try-error")) stop(mstyle$stop("Could not obtain the cluster-robust Wald test (use verbose=TRUE for more details).")) QM <- max(0, cs.wald$Fstat) QMdf <- c(cs.wald$df_num, cs.wald$df_denom) QMp <- cs.wald$p_val } else { #QM <- try(as.vector(t((x$beta)[btt]-rhs) %*% chol2inv(chol(x$vb[btt,btt])) %*% (x$beta[btt]-rhs)), silent=TRUE) QM <- try(as.vector(t(x$beta)[btt] %*% chol2inv(chol(x$vb[btt,btt])) %*% x$beta[btt]), silent=TRUE) if (inherits(QM, "try-error")) QM <- NA_real_ if (is.element(x$test, c("knha","adhoc","t"))) { QM <- QM / m QMdf <- c(m, x$QMdf[2]) QMp <- pf(QM, df1=QMdf[1], df2=QMdf[2], lower.tail=FALSE) } else { QMdf <- c(m, NA_integer_) QMp <- pchisq(QM, df=QMdf[1], lower.tail=FALSE) } } res <- list(QM=QM, QMdf=QMdf, QMp=QMp, btt=btt, k=x$k, p=x$p, m=m, test=x$test, digits=digits, type="Wald.btt", class=class(x)) } } else { if (inherits(object, "rma.ls") && !missing(Z)) { ### if 'Z' has been specified, then do Wald-type test(s) via 'Z' argument if (!missing(X)) stop(mstyle$stop("Can only specify either 'X' or 'Z', but not both.")) if (.is.vector(Z)) Z <- rbind(Z) if (is.data.frame(Z)) Z <- as.matrix(Z) if (is.character(Z)) stop(mstyle$stop("Argument 'Z' must be a numeric vector/matrix.")) ### if model has an intercept term and Z has q-1 columns, assume user left out the intercept and add it automatically if (x$Z.int.incl && ncol(Z) == (x$q-1)) Z <- cbind(1, Z) if (ncol(Z) != x$q) stop(mstyle$stop(paste0("Length or number of columns of 'Z' (", ncol(Z), ") does not match the number of scale coefficients (", x$q, ")."))) m <- nrow(Z) ### specification of the right-hand side if (missing(rhs)) { rhs <- rep(0, m) } else { if (length(rhs) == 1L) rhs <- rep(rhs, m) if (length(rhs) != m) stop(mstyle$stop(paste0("Length of 'rhs' (", length(rhs), ") does not match the number of linear combinations (", m, ")."))) } ### test of individual hypotheses Za <- Z %*% x$alpha - rhs vZa <- Z %*% x$va %*% t(Z) se <- sqrt(diag(vZa)) zval <- c(Za/se) if (is.element(x$test, c("knha","adhoc","t"))) { pval <- if (x$ddf.alpha > 0) 2*pt(abs(zval), df=x$ddf.alpha, lower.tail=FALSE) else rep(NA_real_,m) } else { pval <- 2*pnorm(abs(zval), lower.tail=FALSE) } ### omnibus test of all hypotheses (only possible if 'Z' is of full rank) QS <- NA_real_ ### need this in case QS cannot be calculated below QSp <- NA_real_ ### need this in case QSp cannot be calculated below if (rankMatrix(Z) == m) { QS <- try(as.vector(t(Za) %*% chol2inv(chol(vZa)) %*% Za), silent=TRUE) if (inherits(QS, "try-error")) QS <- NA_real_ if (is.element(x$test, c("knha","adhoc","t"))) { QS <- QS / m QSdf <- c(m, x$QSdf[2]) QSp <- if (QSdf[2] > 0) pf(QS, df1=QSdf[1], df2=QSdf[2], lower.tail=FALSE) else NA_real_ } else { QSdf <- c(m, NA_integer_) QSp <- pchisq(QS, df=QSdf[1], lower.tail=FALSE) } } ### create a data frame with each row specifying the linear combination tested hyp <- rep("", m) for (j in seq_len(m)) { Zj <- round(Z[j,], digits[["est"]]) ### coefficients for the jth contrast sel <- Zj != 0 ### TRUE if coefficient is != 0 hyp[j] <- paste(paste(Zj[sel], rownames(x$alpha)[sel], sep="*"), collapse=" + ") ### coefficient*variable + coefficient*variable ... hyp[j] <- gsub("1*", "", hyp[j], fixed=TRUE) ### turn '+1' into '+' and '-1' into '-' hyp[j] <- gsub("+ -", "- ", hyp[j], fixed=TRUE) ### turn '+ -' into '-' } if (identical(rhs, rep(0,m))) { hyp <- paste0(hyp, " = 0") ### add '= 0' at the right } else { if (length(unique(rhs)) == 1L) { hyp <- paste0(hyp, " = ", round(rhs, digits=digits[["est"]])) ### add '= rhs' at the right } else { hyp <- paste0(hyp, " = ", fmtx(rhs, digits=digits[["est"]])) ### add '= rhs' at the right } } hyp <- data.frame(hyp, stringsAsFactors=FALSE) colnames(hyp) <- "" rownames(hyp) <- paste0(seq_len(m), ":") ### add '1:', '2:', ... as row names res <- list(QS=QS, QSdf=QSdf, QSp=QSp, hyp=hyp, Za=Za, se=se, zval=zval, pval=pval, k=x$k, q=x$q, m=m, test=x$test, ddf=x$ddf.alpha, digits=digits, type="Wald.Za") } else { ### if 'X' has been specified, then do Wald-type test(s) via 'X' argument if (.is.vector(X)) X <- rbind(X) if (is.data.frame(X)) X <- as.matrix(X) if (is.character(X)) stop(mstyle$stop("Argument 'X' must be a numeric vector/matrix.")) ### if model has an intercept term and X has p-1 columns, assume user left out the intercept and add it automatically if (x$int.incl && ncol(X) == (x$p-1)) X <- cbind(1, X) if (ncol(X) != x$p) stop(mstyle$stop(paste0("Length or number of columns of 'X' (", ncol(X), ") does not match the number of ", ifelse(inherits(object, "rma.ls"), "location", "model"), " coefficients (", x$p, ")."))) m <- nrow(X) if (inherits(x, "robust.rma") && x$robumethod == "clubSandwich") { cs.lc <- try(clubSandwich::linear_contrast(x, cluster=x$cluster, vcov=x$vb, test=x$coef_test, contrasts=X, p_values=TRUE), silent=!isTRUE(ddd$verbose)) if (inherits(cs.lc, "try-error")) stop(mstyle$stop("Could not obtain the cluster-robust test(s) (use verbose=TRUE for more details).")) ddf <- cs.lc$df if (!missing(rhs)) warning(mstyle$warning("Cannot use 'rhs' argument for 'robust.rma' objects based on 'clubSandwich'.")) rhs <- rep(0, m) Xb <- cs.lc$Est se <- cs.lc$SE zval <- c(Xb/se) pval <- cs.lc$p_val ### omnibus test of all hypotheses (only possible if 'X' is of full rank) QM <- NA_real_ # need this in case QMp cannot be calculated below QMp <- NA_real_ # need this in case QMp cannot be calculated below QMdf <- NA_integer_ # need this in case X is not of full rank if (rankMatrix(X) == m) { cs.wald <- try(clubSandwich::Wald_test(x, cluster=x$cluster, vcov=x$vb, test=x$wald_test, constraints=X), silent=!isTRUE(ddd$verbose)) if (inherits(cs.wald, "try-error")) stop(mstyle$stop("Could not obtain the cluster-robust omnibus Wald test (use verbose=TRUE for more details).")) QM <- max(0, cs.wald$Fstat) QMdf <- c(cs.wald$df_num, cs.wald$df_denom) QMp <- cs.wald$p_val } } else { ### ddf calculation if (is.element(x$test, c("knha","adhoc","t"))) { if (length(x$ddf) == 1L) { ddf <- rep(x$ddf, m) } else { ddf <- rep(NA_integer_, m) for (j in seq_len(m)) { bn0 <- X[j,] != 0 ddf[j] <- min(x$ddf[bn0]) } } } else { ddf <- rep(NA_integer_, m) } ### specification of the right-hand side if (missing(rhs)) { rhs <- rep(0, m) } else { if (length(rhs) == 1L) rhs <- rep(rhs, m) if (length(rhs) != m) stop(mstyle$stop(paste0("Length of 'rhs' (", length(rhs), ") does not match the number of linear combinations (", m, ")."))) } ### test of individual hypotheses Xb <- X %*% x$beta - rhs vXb <- X %*% x$vb %*% t(X) se <- sqrt(diag(vXb)) zval <- c(Xb/se) if (is.element(x$test, c("knha","adhoc","t"))) { pval <- sapply(seq_along(ddf), function(j) if (ddf[j] > 0) 2*pt(abs(zval[j]), df=ddf[j], lower.tail=FALSE) else NA_real_) } else { pval <- 2*pnorm(abs(zval), lower.tail=FALSE) } ### omnibus test of all hypotheses (only possible if 'X' is of full rank) QM <- NA_real_ # need this in case QMp cannot be calculated below QMp <- NA_real_ # need this in case QMp cannot be calculated below QMdf <- NA_integer_ # need this in case X is not of full rank if (rankMatrix(X) == m) { ### use try(), since this could fail: this could happen when the var-cov matrix of the ### fixed effects has been estimated using robust() -- 'vb' is then only guaranteed to ### be positive semidefinite, so for certain linear combinations, vXb could be singular ### (see Cameron & Miller, 2015, p. 326) QM <- try(as.vector(t(Xb) %*% chol2inv(chol(vXb)) %*% Xb), silent=TRUE) if (inherits(QM, "try-error")) QM <- NA_real_ if (is.element(x$test, c("knha","adhoc","t"))) { QM <- QM / m QMdf <- c(m, min(ddf)) QMp <- if (QMdf[2] > 0) pf(QM, df1=QMdf[1], df2=QMdf[2], lower.tail=FALSE) else NA_real_ } else { QMdf <- c(m, NA_integer_) QMp <- pchisq(QM, df=QMdf[1], lower.tail=FALSE) } } } ### create a data frame with each row specifying the linear combination tested hyp <- rep("", m) for (j in seq_len(m)) { Xj <- round(X[j,], digits[["est"]]) ### coefficients for the jth contrast sel <- Xj != 0 ### TRUE if coefficient is != 0 hyp[j] <- paste(paste(Xj[sel], rownames(x$beta)[sel], sep="*"), collapse=" + ") ### coefficient*variable + coefficient*variable ... hyp[j] <- gsub("1*", "", hyp[j], fixed=TRUE) ### turn '+1' into '+' and '-1' into '-' hyp[j] <- gsub("+ -", "- ", hyp[j], fixed=TRUE) ### turn '+ -' into '-' } if (identical(rhs, rep(0,m))) { hyp <- paste0(hyp, " = 0") ### add '= 0' at the right } else { if (length(unique(rhs)) == 1L) { hyp <- paste0(hyp, " = ", round(rhs, digits=digits[["est"]])) ### add '= rhs' at the right } else { hyp <- paste0(hyp, " = ", fmtx(rhs, digits=digits[["est"]])) ### add '= rhs' at the right } } hyp <- data.frame(hyp, stringsAsFactors=FALSE) colnames(hyp) <- "" rownames(hyp) <- paste0(seq_len(m), ":") ### add '1:', '2:', ... as row names res <- list(QM=QM, QMdf=QMdf, QMp=QMp, hyp=hyp, Xb=Xb, se=se, zval=zval, pval=pval, k=x$k, p=x$p, m=m, test=x$test, ddf=ddf, digits=digits, type="Wald.Xb") } } } else { ### if 'object' and 'object2' have been specified, can use function to ### do model comparisons via a likelihood ratio test (and fit indices) if (!inherits(object2, "rma")) stop(mstyle$stop("Argument 'object2' must be an object of class \"rma\".")) if (inherits(object2, c("rma.mh","rma.peto"))) stop(mstyle$stop("Function not applicable to objects of class \"rma.mh\" or \"rma.peto\".")) if (inherits(object2, "rma.glmm")) stop(mstyle$stop("Method not available for objects of class \"rma.glmm\".")) if (!identical(class(object), class(object2))) stop(mstyle$stop("Class of 'object' must be the same as class of 'object2'.")) if (!is.null(ddd$test)) { test <- match.arg(ddd$test, c("LRT", "Wald")) } else { test <- "LRT" } ### assume 'object' is the full model and 'object2' the reduced model model.f <- object model.r <- object2 ### number of parameters in the models parms.f <- model.f$parms parms.r <- model.r$parms ### check if they have the same number of parameters if (parms.f == parms.r) stop(mstyle$stop("Models have the same number of parameters. LRT not meaningful.")) ### if parms.f < parms.r, then let 'object' be the reduced model and 'object2' the full model if (parms.f < parms.r) { model.f <- object2 model.r <- object parms.f <- model.f$parms parms.r <- model.r$parms } ### check if models are based on the same data (TODO: also check for same weights?) ### note: using as.vector() to strip attributes/names, as.matrix() to make both V matrices non-sparse, and ### isTRUE(all.equal()) because conversion to non-sparse can introduce some negligible discrepancies if (inherits(object, "rma.uni")) { if (!(identical(as.vector(model.f$yi), as.vector(model.r$yi)) && isTRUE(all.equal(as.vector(model.f$vi), as.vector(model.r$vi))))) stop(mstyle$stop("Observed outcomes and/or sampling variances not equal in the full and reduced model.")) } if (inherits(object, "rma.mv")) { if (!(identical(as.vector(model.f$yi), as.vector(model.r$yi)) && isTRUE(all.equal(as.matrix(model.f$V), as.matrix(model.r$V))))) stop(mstyle$stop("Observed outcomes and/or sampling variances/covariances not equal in the full and reduced model.")) } ### for Wald-type test, both models should be fitted using the same method if (test == "Wald" && (model.f$method != model.r$method)) stop(mstyle$stop("Full and reduced model must use the same 'method' for the model fitting.")) ### for LRTs, reduced model may use method="FE/EE/CE" and full model method="(RE)ML" but the other way around doesn't really make sense if (is.element(model.f$method, c("FE","EE","CE")) && !is.element(model.r$method, c("FE","EE","CE"))) stop(mstyle$stop("Full model uses a fixed- and reduced model uses a random/mixed-effects model.")) ### but have to check for a ML/REML mismatch if ((model.f$method == "ML" && model.r$method == "REML") || model.r$method == "ML" && model.f$method == "REML") stop(mstyle$stop(paste0("Mismatch between the use of ", model.f$method, " and ", model.r$method, " estimation in the full versus reduced model."))) ### for LRTs, using anything besides ML/REML is strictly speaking incorrect if (test == "LRT" && (!is.element(model.f$method, c("FE","EE","CE","ML","REML")) || !is.element(model.r$method, c("FE","EE","CE","ML","REML")))) warning(mstyle$warning("LRTs should be based on ML/REML estimation.")) ### for LRTs based on REML estimation, check if fixed effects differ if (test == "LRT" && model.f$method == "REML" && (!identical(model.f$X, model.r$X))) { if (refit) { #message(mstyle$message("Refitting models with ML (instead of REML) estimation ...")) if (inherits(model.f, "rma.uni") && model.f$model == "rma.uni") { #model.f <- try(update(model.f, method="ML", data=model.f$data), silent=TRUE) args <- list(yi=model.f$yi, vi=model.f$vi, weights=model.f$weights, mods=model.f$X, intercept=FALSE, method="ML", weighted=model.f$weighted, test=model.f$test, level=model.f$level, tau2=ifelse(model.f$tau2.fix, model.f$tau2, NA), control=model.f$control, skipr2=TRUE) model.f <- try(suppressWarnings(.do.call(rma.uni, args)), silent=TRUE) } else { # note: this fails when building the docs with pkgdown; not sure why; the approach above at least works for 'rma.uni' objects and is more efficient as it skips the R^2 calculation model.f <- try(update(model.f, method="ML"), silent=TRUE) } if (inherits(model.f, "try-error")) stop(mstyle$stop("Refitting the full model with ML estimation failed.")) if (inherits(model.r, "rma.uni") && model.r$model == "rma.uni") { #model.r <- try(update(model.r, method="ML", data=model.r$data), silent=TRUE) args <- list(yi=model.r$yi, vi=model.r$vi, weights=model.r$weights, mods=model.r$X, intercept=FALSE, method="ML", weighted=model.r$weighted, test=model.r$test, level=model.r$level, tau2=ifelse(model.r$tau2.fix, model.r$tau2, NA), control=model.r$control, skipr2=TRUE) model.r <- try(suppressWarnings(.do.call(rma.uni, args)), silent=TRUE) } else { model.r <- try(update(model.r, method="ML"), silent=TRUE) } if (inherits(model.r, "try-error")) stop(mstyle$stop("Refitting the reduced model with ML estimation failed.")) parms.f <- model.f$parms parms.r <- model.r$parms } else { warning(mstyle$warning("REML comparisons not meaningful for models with different fixed effects\n(use 'refit=TRUE' to refit both models based on ML estimation)."), call.=FALSE) } } ### in this case, one could consider just taking the ML deviances, but this ### is really ad-hoc; there is some theory in Welham & Thompson (1997) about ### LRTs for fixed effects when using REML estimation, but this involves ### additional work ### could do even more checks for cases where the models are clearly not nested ###################################################################### ### for 'rma.uni' objects, calculate pseudo R^2 value (based on the ### proportional reduction in tau^2) comparing full vs. reduced model if (inherits(object, "rma.uni") && !inherits(object, "rma.ls") && !inherits(object, "rma.gen")) { if (is.element(model.f$method, c("FE","EE","CE"))) { if (model.f$weighted) { if (is.null(model.f$weights)) { lm.f <- lm(model.f$yi ~ model.f$X, weights=1/model.f$vi) } else { lm.f <- lm(model.f$yi ~ model.f$X, weights=model.f$weights) } } else { lm.f <- lm(model.f$yi ~ model.f$X) } if (model.r$weighted) { if (is.null(model.r$weights)) { lm.r <- lm(model.r$yi ~ model.r$X, weights=1/model.r$vi) } else { lm.r <- lm(model.r$yi ~ model.r$X, weights=model.r$weights) } } else { lm.r <- lm(model.r$yi ~ model.r$X) } s2.f <- sigma(lm.f)^2 s2.r <- sigma(lm.r)^2 R2 <- 100 * max(0, (s2.r - s2.f) / s2.r) } else if (identical(model.r$tau2,0)) { R2 <- 0 } else { R2 <- 100 * max(0, (model.r$tau2 - model.f$tau2) / model.r$tau2) } } else { R2 <- NA_real_ } ### for 'rma.uni' objects, extract tau^2 estimates if (inherits(object, "rma.uni") && !inherits(object, "rma.ls") && !inherits(object, "rma.gen")) { tau2.f <- model.f$tau2 tau2.r <- model.r$tau2 } else { tau2.f <- NA_real_ tau2.r <- NA_real_ } if (test == "LRT") { parms.diff <- parms.f - parms.r if (model.f$method == "REML") { LRT <- model.r$fit.stats["dev","REML"] - model.f$fit.stats["dev","REML"] fit.stats.f <- t(model.f$fit.stats)["REML",] # to keep (row)names of fit.stats fit.stats.r <- t(model.r$fit.stats)["REML",] # to keep (row)names of fit.stats } else { LRT <- model.r$fit.stats["dev","ML"] - model.f$fit.stats["dev","ML"] fit.stats.f <- t(model.f$fit.stats)["ML",] fit.stats.r <- t(model.r$fit.stats)["ML",] } ### set LRT to 0 if LRT < 0 (this should not happen, but could due to numerical issues) LRT[LRT < 0] <- 0 pval <- pchisq(LRT, df=parms.diff, lower.tail=FALSE) res <- list(fit.stats.f=fit.stats.f, fit.stats.r=fit.stats.r, parms.f=parms.f, parms.r=parms.r, LRT=LRT, pval=pval, QE.f=model.f$QE, QE.r=model.r$QE, tau2.f=tau2.f, tau2.r=tau2.r, R2=R2, method=model.f$method, class.f=class(model.f), digits=digits, type="LRT") } if (test == "Wald") { btt <- setdiff(colnames(model.f$X), colnames(model.r$X)) if (length(btt) == 0L) stop(mstyle$stop("Full and reduced models appear to contain the same moderators.")) if (length(setdiff(colnames(model.r$X), colnames(model.f$X))) != 0L) stop(mstyle$stop("There are coefficients in the reduced model that are not in the full model.")) btt <- charmatch(btt, colnames(model.f$X)) if (anyNA(btt)) stop(mstyle$stop("Cannot identify coefficients to test.")) res <- anova(model.f, btt=btt) return(res) } } class(res) <- "anova.rma" return(res) } metafor/R/model.matrix.rma.r0000644000176200001440000000231014303075743015456 0ustar liggesusersmodel.matrix.rma <- function(object, asdf=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) ### note: lm() always returns X (never the full model matrix, even with na.exclude or na.pass) ### but it seems a bit more logical to actually return X.f in that case if (na.act == "na.omit") out <- object$X if (na.act == "na.exclude" || na.act == "na.pass") out <- object$X.f if (na.act == "na.fail" && any(!object$not.na)) stop(mstyle$stop("Missing values in results.")) if (asdf) out <- as.data.frame(out) if (inherits(object, "rma.ls")) { out <- list(location = out) if (na.act == "na.omit") out$scale <- object$Z if (na.act == "na.exclude" || na.act == "na.pass") out$scale <- object$Z.f if (na.act == "na.fail" && any(!object$not.na)) stop(mstyle$stop("Missing values in results.")) if (asdf) out$scale <- as.data.frame(out$scale) } return(out) } metafor/R/addpoly.predict.rma.r0000644000176200001440000000373514505024235016146 0ustar liggesusersaddpoly.predict.rma <- function(x, rows=-2, annotate, addpred=FALSE, digits, width, mlab, transf, atransf, targs, efac, col, border, lty, fonts, cex, constarea=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="predict.rma") if (x$pred.type == "scale") stop(mstyle$stop("Cannot add polygons based on predicted scale values.")) if (missing(annotate)) annotate <- .getfromenv("forest", "annotate", default=TRUE) if (missing(digits)) digits <- .getfromenv("forest", "digits", default=2) if (missing(width)) width <- .getfromenv("forest", "width", default=NULL) if (missing(mlab)) mlab <- NULL if (missing(transf)) transf <- .getfromenv("forest", "transf", default=FALSE) if (missing(atransf)) atransf <- .getfromenv("forest", "atransf", default=FALSE) if (missing(targs)) targs <- .getfromenv("forest", "targs", default=NULL) if (missing(efac)) efac <- .getfromenv("forest", "efac", default=1) if (missing(col)) col <- par("fg") if (missing(border)) border <- par("fg") if (missing(lty)) lty <- "dotted" if (missing(fonts)) fonts <- .getfromenv("forest", "fonts", default=NULL) if (missing(cex)) cex <- .getfromenv("forest", "cex", default=NULL) if (addpred) { pi.lb <- x$pi.lb pi.ub <- x$pi.ub } else { pi.lb <- rep(NA_real_, length(x$pred)) pi.ub <- rep(NA_real_, length(x$pred)) } ######################################################################### addpoly(x$pred, ci.lb=x$ci.lb, ci.ub=x$ci.ub, pi.lb=pi.lb, pi.ub=pi.ub, rows=rows, annotate=annotate, digits=digits, width=width, mlab=mlab, transf=transf, atransf=atransf, targs=targs, efac=efac, col=col, border=border, lty=lty, fonts=fonts, cex=cex, constarea=constarea, ...) } metafor/R/labbe.rma.r0000644000176200001440000002340614466623010014125 0ustar liggesuserslabbe.rma <- function(x, xlim, ylim, xlab, ylab, add=x$add, to=x$to, transf, targs, pch=21, psize, plim=c(0.5,3.5), col, bg, grid=FALSE, lty, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma", notav=c("rma.ls", "rma.gen", "rma.uni.selmodel")) if (!x$int.only) stop(mstyle$stop("L'Abbe plots can only be drawn for models without moderators.")) if (!is.element(x$measure, c("RR","OR","RD","AS","IRR","IRD","IRSD"))) stop(mstyle$stop("Argument 'measure' must be set to one of the following: 'RR','OR','RD','AS','IRR','IRD','IRSD'.")) na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (length(add) == 2L) # for rma.mh and rma.peto objects (1st 'add' value applies to the individual outcomes) add <- add[1] if (length(to) == 2L) # for rma.mh and rma.peto objects (1st 'to' value applies to the individual outcomes) to <- to[1] if (!is.element(to, c("all","only0","if0all","none"))) stop(mstyle$stop("Unknown 'to' argument specified.")) .start.plot() if (missing(transf)) transf <- FALSE transf.char <- deparse(transf) if (missing(targs)) targs <- NULL if (missing(psize)) psize <- NULL if (missing(lty)) { lty <- c("solid", "dashed") # 1st value = diagonal line, 2nd value = estimated effect line } else { if (length(lty) == 1L) lty <- c(lty, lty) } ### get ... argument ddd <- list(...) ### set defaults or get addyi and addvi arguments addyi <- ifelse(is.null(ddd$addyi), TRUE, ddd$addyi) addvi <- ifelse(is.null(ddd$addvi), TRUE, ddd$addvi) ### grid argument can either be a logical or a color if (is.logical(grid)) gridcol <- .coladj(par("bg","fg"), dark=c(0.2,-0.6), light=c(-0.2,0.6)) if (is.character(grid)) { gridcol <- grid grid <- TRUE } ######################################################################### ### note: 'pch', 'psize', 'col', and 'bg' must be of the same length as the original data passed to rma() ### so we have to apply the same subsetting (if necessary) and removing of NAs as done during the ### model fitting (note: NAs are removed further below) if (length(pch) == 1L) pch <- rep(pch, x$k.all) if (length(pch) != x$k.all) stop(mstyle$stop(paste0("Length of the 'pch' argument (", length(pch), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) pch <- .getsubset(pch, x$subset) ### if user has set the point sizes if (!is.null(psize)) { if (length(psize) == 1L) psize <- rep(psize, x$k.all) if (length(psize) != x$k.all) stop(mstyle$stop(paste0("Length of the 'psize' argument (", length(psize), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) psize <- .getsubset(psize, x$subset) } if (missing(col)) col <- par("fg") if (length(col) == 1L) col <- rep(col, x$k.all) if (length(col) != x$k.all) stop(mstyle$stop(paste0("Length of the 'col' argument (", length(col), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) col <- .getsubset(col, x$subset) if (missing(bg)) bg <- .coladj(par("bg","fg"), dark=0.35, light=-0.35) if (length(bg) == 1L) bg <- rep(bg, x$k.all) if (length(bg) != x$k.all) stop(mstyle$stop(paste0("Length of the 'bg' argument (", length(bg), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) bg <- .getsubset(bg, x$subset) ######################################################################### ### these vectors may contain NAs ai <- x$outdat.f$ai bi <- x$outdat.f$bi ci <- x$outdat.f$ci di <- x$outdat.f$di x1i <- x$outdat.f$x1i x2i <- x$outdat.f$x2i t1i <- x$outdat.f$t1i t2i <- x$outdat.f$t2i ### drop00=TRUE may induce that the contrast-based yi value is NA; so ### make sure that the corresponding arm-based yi values are also NA yi.is.na <- is.na(x$yi.f) ai[yi.is.na] <- NA_real_ bi[yi.is.na] <- NA_real_ ci[yi.is.na] <- NA_real_ di[yi.is.na] <- NA_real_ x1i[yi.is.na] <- NA_real_ x2i[yi.is.na] <- NA_real_ t1i[yi.is.na] <- NA_real_ t2i[yi.is.na] <- NA_real_ options(na.action = "na.pass") ### to make sure dat.t and dat.c are of the same length measure <- switch(x$measure, "RR"="PLN", "OR"="PLO", "RD"="PR", "AS"="PAS", "IRR"="IRLN", "IRD"="IR", "IRSD"="IRS") if (is.element(x$measure, c("RR","OR","RD","AS"))) { args.t <- list(measure=measure, xi=ai, mi=bi, add=add, to=to, addyi=addyi, addvi=addvi) args.c <- list(measure=measure, xi=ci, mi=di, add=add, to=to, addyi=addyi, addvi=addvi) } if (is.element(x$measure, c("IRR","IRD","IRSD"))) { args.t <- list(measure=measure, xi=x1i, ti=t1i, add=add, to=to, addyi=addyi, addvi=addvi) args.c <- list(measure=measure, xi=x2i, ti=t2i, add=add, to=to, addyi=addyi, addvi=addvi) } dat.t <- .do.call(escalc, args.t) dat.c <- .do.call(escalc, args.c) options(na.action = na.act) ### check for NAs in yi/vi pairs and filter out has.na <- apply(is.na(dat.t), 1, any) | apply(is.na(dat.c), 1, any) not.na <- !has.na if (any(has.na)) { dat.t <- dat.t[not.na,] dat.c <- dat.c[not.na,] pch <- pch[not.na] col <- col[not.na] bg <- bg[not.na] if (is.null(psize)) psize <- psize[not.na] } if (length(dat.t$yi)==0L || length(dat.c$yi)==0L) stop(mstyle$stop("No information in object to compute arm-level outcomes.")) ######################################################################### ### determine point sizes vi <- dat.t$vi + dat.c$vi k <- length(vi) if (is.null(psize)) { if (length(plim) < 2L) stop(mstyle$stop("Argument 'plim' must be of length 2 or 3.")) wi <- sqrt(1/vi) if (!is.na(plim[1]) && !is.na(plim[2])) { rng <- max(wi, na.rm=TRUE) - min(wi, na.rm=TRUE) if (rng <= .Machine$double.eps^0.5) { psize <- rep(1, k) } else { psize <- (wi - min(wi, na.rm=TRUE)) / rng psize <- (psize * (plim[2] - plim[1])) + plim[1] } } if (is.na(plim[1]) && !is.na(plim[2])) { psize <- wi / max(wi, na.rm=TRUE) * plim[2] if (length(plim) == 3L) psize[psize <= plim[3]] <- plim[3] } if (!is.na(plim[1]) && is.na(plim[2])) { psize <- wi / min(wi, na.rm=TRUE) * plim[1] if (length(plim) == 3L) psize[psize >= plim[3]] <- plim[3] } if (all(is.na(psize))) psize <- rep(1, k) } ### determine x/y values for line that indicates the estimated effect min.yi <- min(c(dat.t$yi, dat.c$yi)) max.yi <- max(c(dat.t$yi, dat.c$yi)) rng.yi <- max.yi - min.yi len <- 1000 intrcpt <- x$beta[1] if (x$measure == "RD") c.vals <- seq(ifelse(intrcpt>0, 0, -intrcpt), ifelse(intrcpt>0, 1-intrcpt, 1), length.out=len) if (x$measure == "RR") c.vals <- seq(min.yi-rng.yi, ifelse(intrcpt>0, 0-intrcpt, 0), length.out=len) if (x$measure == "OR") c.vals <- seq(min.yi-rng.yi, max.yi+rng.yi, length.out=len) if (x$measure == "AS") c.vals <- seq(ifelse(intrcpt>0, 0, -intrcpt), ifelse(intrcpt>0, asin(sqrt(1))-intrcpt, asin(sqrt(1))), length.out=len) if (x$measure == "IRR") c.vals <- seq(min.yi-rng.yi, ifelse(intrcpt>0, 0-intrcpt, 0), length.out=len) if (x$measure == "IRD") c.vals <- seq(ifelse(intrcpt>0, 0, -intrcpt), ifelse(intrcpt>0, 1-intrcpt, 1), length.out=len) if (x$measure == "IRSD") c.vals <- seq(ifelse(intrcpt>0, 0, -intrcpt), ifelse(intrcpt>0, 1-intrcpt, 1), length.out=len) t.vals <- intrcpt + 1*c.vals if (is.function(transf)) { if (is.null(targs)) { dat.t$yi <- sapply(dat.t$yi, transf) dat.c$yi <- sapply(dat.c$yi, transf) c.vals <- sapply(c.vals, transf) t.vals <- sapply(t.vals, transf) } else { dat.t$yi <- sapply(dat.t$yi, transf, targs) dat.c$yi <- sapply(dat.c$yi, transf, targs) c.vals <- sapply(c.vals, transf, targs) t.vals <- sapply(t.vals, transf, targs) } } min.yi <- min(c(dat.t$yi, dat.c$yi)) max.yi <- max(c(dat.t$yi, dat.c$yi)) if (missing(xlim)) xlim <- c(min.yi, max.yi) if (missing(ylim)) ylim <- c(min.yi, max.yi) ### order points by psize order.vec <- order(psize, decreasing=TRUE) dat.t$yi.o <- dat.t$yi[order.vec] dat.c$yi.o <- dat.c$yi[order.vec] pch.o <- pch[order.vec] col.o <- col[order.vec] bg.o <- bg[order.vec] psize.o <- psize[order.vec] ### add x-axis label if (missing(xlab)) { xlab <- .setlab(measure, transf.char, atransf.char="FALSE", gentype=1) xlab <- paste(xlab, "(Group 1)") } ### add y-axis label if (missing(ylab)) { ylab <- .setlab(measure, transf.char, atransf.char="FALSE", gentype=1) ylab <- paste(ylab, "(Group 2)") } plot(NA, NA, xlim=xlim, ylim=ylim, xlab=xlab, ylab=ylab, ...) ### add grid (and redraw box) if (.isTRUE(grid)) { grid(col=gridcol) box(...) } ### add diagonal and estimated effects lines abline(a=0, b=1, lty=lty[1], ...) lines(c.vals, t.vals, lty=lty[2], ...) ### add points points(x=dat.c$yi.o, y=dat.t$yi.o, cex=psize.o, pch=pch.o, col=col.o, bg=bg.o, ...) ######################################################################### ### prepare data frame to return sav <- data.frame(x=dat.c$yi, y=dat.t$yi, cex=psize, pch=pch, col=col, bg=bg, ids=x$ids[not.na], slab=x$slab[not.na], stringsAsFactors=FALSE) invisible(sav) } metafor/R/baujat.rma.r0000644000176200001440000001225514466622744014343 0ustar liggesusersbaujat.rma <- function(x, xlim, ylim, xlab, ylab, cex, symbol="ids", grid=TRUE, progbar=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma", notav=c("rma.glmm", "rma.mv", "robust.rma", "rma.ls", "rma.gen", "rma.uni.selmodel")) na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (x$k == 1) stop(mstyle$stop("Stopped because k = 1.")) .start.plot() ### grid argument can either be a logical or a color if (is.logical(grid)) gridcol <- .coladj(par("bg","fg"), dark=c(0.2,-0.6), light=c(-0.2,0.6)) if (is.character(grid)) { gridcol <- grid grid <- TRUE } ######################################################################### ### set up vectors to store results in delpred <- rep(NA_real_, x$k.f) vdelpred <- rep(NA_real_, x$k.f) ### predicted values under the full model pred.full <- x$X.f %*% x$beta ### elements that need to be returned outlist <- "coef.na=coef.na, beta=beta, vb=vb" ### note: skipping NA cases ### also: it is possible that model fitting fails, so that generates more NAs (these NAs will always be shown in output) if (progbar) pbar <- pbapply::startpb(min=0, max=x$k.f) for (i in seq_len(x$k.f)) { if (progbar) pbapply::setpb(pbar, i) if (!x$not.na[i]) next if (inherits(x, "rma.uni")) res <- try(suppressWarnings(.do.call(rma.uni, yi=x$yi.f, vi=x$vi.f, weights=x$weights.f, mods=x$X.f, intercept=FALSE, method=x$method, weighted=x$weighted, test=x$test, level=x$level, tau2=ifelse(x$tau2.fix, x$tau2, NA), control=x$control, subset=-i, skipr2=TRUE, outlist=outlist)), silent=TRUE) if (inherits(x, "rma.mh")) { if (is.element(x$measure, c("RR","OR","RD"))) { res <- try(suppressWarnings(.do.call(rma.mh, ai=x$outdat.f$ai, bi=x$outdat.f$bi, ci=x$outdat.f$ci, di=x$outdat.f$di, measure=x$measure, add=x$add, to=x$to, drop00=x$drop00, correct=x$correct, level=x$level, subset=-i, outlist=outlist)), silent=TRUE) } else { res <- try(suppressWarnings(.do.call(rma.mh, x1i=x$outdat.f$x1i, x2i=x$outdat.f$x2i, t1i=x$outdat.f$t1i, t2i=x$outdat.f$t2i, measure=x$measure, add=x$add, to=x$to, drop00=x$drop00, correct=x$correct, level=x$level, subset=-i, outlist=outlist)), silent=TRUE) } } if (inherits(x, "rma.peto")) res <- try(suppressWarnings(.do.call(rma.peto, ai=x$outdat.f$ai, bi=x$outdat.f$bi, ci=x$outdat.f$ci, di=x$outdat.f$di, add=x$add, to=x$to, drop00=x$drop00, level=x$level, subset=-i)), silent=TRUE) if (inherits(res, "try-error")) next ### removing an observation could lead to a model coefficient becoming inestimable (for 'rma.uni' objects) if (any(res$coef.na)) next Xi <- matrix(x$X.f[i,], nrow=1) delpred[i] <- Xi %*% res$beta vdelpred[i] <- Xi %*% tcrossprod(res$vb,Xi) } if (progbar) pbapply::closepb(pbar) yhati <- (delpred - pred.full)^2 / vdelpred ######################################################################### ### x-axis values (use 'na.pass' to make sure we get a vector of length k.f) options(na.action = "na.pass") xhati <- resid(x)^2 / (x$tau2.f + x$vi.f) options(na.action = na.act) ######################################################################### ### set some defaults (if not specified) if (missing(cex)) cex <- par("cex") * 0.8 if (missing(xlab)) { if (is.element(x$method, c("FE","EE","CE"))) { xlab <- ifelse(x$int.only, "Contribution to Overall Heterogeneity", "Contribution to Residual Heterogeneity") } else { xlab <- "Squared Pearson Residual" } } if (missing(ylab)) ylab <- ifelse(x$int.only, "Influence on Overall Result", "Influence on Fitted Value") if (missing(xlim)) xlim <- range(xhati, na.rm=TRUE) if (missing(ylim)) ylim <- range(yhati, na.rm=TRUE) ######################################################################### ### draw empty plot plot(NA, xlab=xlab, ylab=ylab, xlim=xlim, ylim=ylim, ...) ### add grid (and redraw box) if (.isTRUE(grid)) { grid(col=gridcol) box(...) } if (is.numeric(symbol)) { if (length(symbol) == 1L) symbol <- rep(symbol, x$k.all) if (length(symbol) != x$k.all) stop(mstyle$stop(paste0("Length of the 'symbol' argument (", length(symbol), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) symbol <- .getsubset(symbol, x$subset) points(x=xhati, y=yhati, cex=cex, pch=symbol, ...) } if (is.character(symbol) && symbol=="ids") text(xhati, yhati, x$ids, cex=cex, ...) if (is.character(symbol) && symbol=="slab") text(xhati, yhati, x$slab, cex=cex, ...) ######################################################################### sav <- data.frame(x=xhati[x$not.na], y=yhati[x$not.na], ids=x$ids[x$not.na], slab=x$slab[x$not.na], stringsAsFactors=FALSE) invisible(sav) } metafor/R/robust.rma.uni.r0000644000176200001440000002465014401677077015205 0ustar liggesusersrobust.rma.uni <- function(x, cluster, adjust=TRUE, clubSandwich=FALSE, digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.uni", notav=c("rma.ls", "rma.gen", "rma.uni.selmodel")) if (missing(cluster)) stop(mstyle$stop("Must specify 'cluster' variable.")) if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } level <- .level(x$level) ddd <- list(...) .chkdots(ddd, c("vcov", "coef_test", "conf_test", "wald_test", "verbose")) ######################################################################### ### process cluster variable ### note: cluster variable is assumed to be of the same length as the original data passed to the model fitting function ### so we have to apply the same subsetting (if necessary) and removing of missings as done during model fitting mf <- match.call() cluster <- .getx("cluster", mf=mf, data=x$data) if (length(cluster) != x$k.all) stop(mstyle$stop(paste0("Length of variable specified via 'cluster' (", length(cluster), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) cluster <- .getsubset(cluster, x$subset) cluster <- cluster[x$not.na] if (anyNA(cluster)) stop(mstyle$stop("No missing values allowed in 'cluster' variable.")) if (length(cluster) == 0L) stop(mstyle$stop("Cannot find 'cluster' variable (or it has zero length).")) ### number of clusters n <- length(unique(cluster)) ### compute degrees of freedom ### note: Stata with vce(robust) also uses n-p as the dfs, but with vce(cluster ) always uses n-1 (which seems inconsistent) dfs <- n - x$p ### check if dfs are positive (note: this also handles the case where there is a single cluster) if (!clubSandwich && dfs <= 0) stop(mstyle$stop(paste0("Number of clusters (", n, ") must be larger than the number of fixed effects (", x$p, ")."))) ### use clubSandwich if requested to do so if (clubSandwich) { if (!suppressMessages(requireNamespace("clubSandwich", quietly=TRUE))) stop(mstyle$stop("Please install the 'clubSandwich' package to make use of its methods.")) ### check for vcov, coef_test, conf_test, and wald_test arguments in ... and set values accordingly if (is.null(ddd$vcov)) { ddd$vcov <- "CR2" } else { ddd$vcov <- match.arg(ddd$vcov, c("CR0", "CR1", "CR1p", "CR1S", "CR2", "CR3")) } if (is.null(ddd$coef_test)) { ddd$coef_test <- "Satterthwaite" } else { ddd$coef_test <- match.arg(ddd$coef_test, c("z", "naive-t", "naive-tp", "Satterthwaite", "saddlepoint")) } if (is.null(ddd$conf_test)) { ddd$conf_test <- ddd$coef_test if (ddd$conf_test == "saddlepoint") { ddd$conf_test <- "Satterthwaite" warning(mstyle$warning("Cannot use 'saddlepoint' for conf_test() - using 'Satterthwaite' instead."), call.=FALSE) } } else { ddd$conf_test <- match.arg(ddd$conf_test, c("z", "naive-t", "naive-tp", "Satterthwaite")) } if (is.null(ddd$wald_test)) { ddd$wald_test <- "HTZ" } else { ddd$wald_test <- match.arg(ddd$wald_test, c("chi-sq", "Naive-F", "Naive-Fp", "HTA", "HTB", "HTZ", "EDF", "EDT")) } ### calculate cluster-robust var-cov matrix of the estimated fixed effects vb <- try(clubSandwich::vcovCR(x, cluster=cluster, type=ddd$vcov), silent=!isTRUE(ddd$verbose)) if (inherits(vb, "try-error")) stop(mstyle$stop("Could not obtain the cluster-robust variance-covariance matrix (use verbose=TRUE for more details).")) #meat <- try(clubSandwich::vcovCR(x, cluster=cluster, type=ddd$vcov, form="estfun"), silent=!isTRUE(ddd$verbose)) meat <- NA_real_ ### obtain cluster-robust inferences cs.coef <- try(clubSandwich::coef_test(x, cluster=cluster, vcov=vb, test=ddd$coef_test, p_values=TRUE), silent=!isTRUE(ddd$verbose)) if (inherits(cs.coef, "try-error")) stop(mstyle$stop("Could not obtain the cluster-robust tests (use verbose=TRUE for more details).")) cs.conf <- try(clubSandwich::conf_int(x, cluster=cluster, vcov=vb, test=ddd$conf_test, level=1-level), silent=!isTRUE(ddd$verbose)) if (inherits(cs.conf, "try-error")) stop(mstyle$stop("Could not obtain the cluster-robust confidence intervals (use verbose=TRUE for more details).")) if (x$int.only) { cs.wald <- NA_real_ } else { cs.wald <- try(clubSandwich::Wald_test(x, cluster=cluster, vcov=vb, test=ddd$wald_test, constraints=clubSandwich::constrain_zero(x$btt)), silent=!isTRUE(ddd$verbose)) if (inherits(cs.wald, "try-error")) { warning(mstyle$warning("Could not obtain the cluster-robust omnibus Wald test (use verbose=TRUE for more details).")) cs.wald <- list(Fstat=NA_real_, df_num=NA_integer_, df_denom=NA_real_) } } #return(list(coef_test=cs.coef, conf_int=cs.conf, Wald_test=cs.wald)) vbest <- ddd$vcov beta <- x$beta se <- cs.coef$SE zval <- ifelse(is.infinite(cs.coef$tstat), NA_real_, cs.coef$tstat) pval <- switch(ddd$coef_test, "z" = cs.coef$p_z, "naive-t" = cs.coef$p_t, "naive-tp" = cs.coef$p_tp, "Satterthwaite" = cs.coef$p_Satt, "saddlepoint" = cs.coef$p_saddle) dfs <- switch(ddd$coef_test, "z" = cs.coef$df_z, "naive-t" = cs.coef$df_t, "naive-tp" = cs.coef$df_tp, "Satterthwaite" = cs.coef$df, "saddlepoint" = NA_real_) dfs <- ifelse(is.na(dfs), NA_real_, dfs) # ifelse() part to change NaN into just NA ci.lb <- ifelse(is.na(cs.conf$CI_L), NA_real_, cs.conf$CI_L) # note: if ddd$coef_test != ddd$conf_test, dfs for CI may be different ci.ub <- ifelse(is.na(cs.conf$CI_U), NA_real_, cs.conf$CI_U) if (x$int.only) { QM <- max(0, zval^2) QMdf <- c(1, dfs) QMp <- pval } else { QM <- max(0, cs.wald$Fstat) QMdf <- c(cs.wald$df_num, max(0, cs.wald$df_denom)) QMp <- cs.wald$p_val } x$sandwiches <- list(coef_test=cs.coef, conf_int=cs.conf, Wald_test=cs.wald) x$coef_test <- ddd$coef_test x$conf_test <- ddd$conf_test x$wald_test <- ddd$wald_test cluster.o <- cluster } else { ### note: since we use split() below and then put things back together into a block-diagonal matrix, ### we have to make sure everything is properly ordered by the cluster variable; otherwise, the 'meat' ### block-diagonal matrix is not in the same order as the rest; so we sort all relevant variables by ### the cluster variable (including the cluster variable itself) ocl <- order(cluster) cluster.o <- cluster[ocl] ### construct bread = (X'WX)^-1 X'W, where W is the weight matrix if (x$weighted) { ### for weighted analysis if (is.null(x$weights)) { ### if no weights were specified, then vb = (X'WX)^-1, so we can use that part wi <- 1/(x$vi + x$tau2) wi <- wi[ocl] W <- diag(wi, nrow=x$k, ncol=x$k) bread <- x$vb %*% crossprod(x$X[ocl,], W) } else { ### if weights were specified, then vb cannot be used A <- diag(x$weights[ocl], nrow=x$k, ncol=x$k) stXAX <- .invcalc(X=x$X[ocl,], W=A, k=x$k) bread <- stXAX %*% crossprod(x$X[ocl,], A) } } else { ### for unweighted analysis stXX <- .invcalc(X=x$X[ocl,], W=diag(x$k), k=x$k) bread <- stXX %*% t(x$X[ocl,]) } ### construct meat part ei <- c(x$yi - x$X %*% x$beta) # use this instead of resid(), since this guarantees that the length is correct ei <- ei[ocl] cluster.o <- factor(cluster.o, levels=unique(cluster.o)) meat.o <- bldiag(lapply(split(ei, cluster.o), function(e) tcrossprod(e))) ### construct robust var-cov matrix vb <- bread %*% meat.o %*% t(bread) ### apply adjustments to vb as needed vbest <- "CR0" ### suggested in Hedges, Tipton, & Johnson (2010) -- analogous to HC1 adjustment if (.isTRUE(adjust)) { vb <- (n / dfs) * vb vbest <- "CR1" } ### what Stata does if (is.character(adjust) && (adjust=="Stata" || adjust=="Stata1")) { vb <- (n / (n-1) * (x$k-1) / (x$k-x$p)) * vb # when the model was fitted with regress vbest <- "CR1.S1" } if (is.character(adjust) && adjust=="Stata2") { vb <- (n / (n-1)) * vb # when the model was fitted with mixed vbest <- "CR1.S2" } ### check for elements in vb that are essentially 0 is0 <- diag(vb) < 100 * .Machine$double.eps vb[is0,] <- NA_real_ vb[,is0] <- NA_real_ ### prepare results beta <- x$beta se <- sqrt(diag(vb)) names(se) <- NULL zval <- c(beta/se) pval <- 2*pt(abs(zval), df=dfs, lower.tail=FALSE) crit <- qt(level/2, df=dfs, lower.tail=FALSE) ci.lb <- c(beta - crit * se) ci.ub <- c(beta + crit * se) QM <- try(as.vector(t(beta)[x$btt] %*% chol2inv(chol(vb[x$btt,x$btt])) %*% beta[x$btt]), silent=TRUE) if (inherits(QM, "try-error") || is.na(QM)) { warning(mstyle$warning("Could not obtain the cluster-robust omnibus Wald test.")) QM <- NA_real_ } QM <- QM / x$m # note: m is the number of coefficients in btt, not the number of clusters QMdf <- c(x$m, dfs) QMp <- pf(QM, df1=x$m, df2=dfs, lower.tail=FALSE) ### don't need this anymore at the moment meat <- matrix(NA_real_, nrow=nrow(meat.o), ncol=ncol(meat.o)) meat[ocl,ocl] <- meat.o } ######################################################################### ### table of cluster variable tcl <- table(cluster.o) x$digits <- digits ### replace elements with robust results x$ddf <- dfs x$dfs <- dfs x$vb <- vb x$se <- se x$zval <- zval x$pval <- pval x$ci.lb <- ci.lb x$ci.ub <- ci.ub x$QM <- QM x$QMdf <- QMdf x$QMp <- QMp x$n <- n x$tcl <- tcl x$test <- "t" x$vbest <- vbest x$s2w <- 1 # just in case test="knha" originally x$robumethod <- ifelse(clubSandwich, "clubSandwich", "default") x$cluster <- cluster x$meat <- meat class(x) <- c("robust.rma", "rma", "rma.uni") return(x) } metafor/R/dfround.r0000644000176200001440000000223114377072634013747 0ustar liggesusersdfround <- function(x, digits, drop0=TRUE) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (inherits(x, "matrix") && length(dim(x)) == 2L) x <- data.frame(x, check.names=FALSE) .chkclass(class(x), must="data.frame") p <- ncol(x) if (missing(digits)) digits <- 0 if (length(digits) == 1L) digits <- rep(digits, p) if (length(drop0) == 1L) drop0 <- rep(drop0, p) if (p != length(digits)) stop(mstyle$stop(paste0("Number of columns in 'x' (", p, ") does not match length of 'digits' (", length(digits), ")."))) if (p != length(drop0)) stop(mstyle$stop(paste0("Number of columns in 'x' (", p, ") does not match length of 'drop0' (", length(drop0), ")."))) if (!is.numeric(digits)) stop(mstyle$stop("Argument 'digits' must be a numeric vector.")) if (!is.logical(drop0)) stop(mstyle$stop("Argument 'drop0' must be a logical vector.")) for (i in seq_len(p)) { if (!is.numeric(x[[i]])) next if (drop0[i]) { x[[i]] <- round(x[[i]], digits[i]) } else { x[[i]] <- formatC(x[[i]], format="f", digits=digits[i]) } } return(x) } metafor/R/to.table.r0000644000176200001440000011474714435456152014032 0ustar liggesusersto.table <- function(measure, ai, bi, ci, di, n1i, n2i, x1i, x2i, t1i, t2i, m1i, m2i, sd1i, sd2i, xi, mi, ri, ti, sdi, ni, data, slab, subset, add=1/2, to="none", drop00=FALSE, rows, cols) { mstyle <- .get.mstyle("crayon" %in% .packages()) ### check argument specifications if (missing(measure)) stop(mstyle$stop("Must specify an effect size or outcome measure via the 'measure' argument.")) if (!is.character(measure)) stop(mstyle$stop("The 'measure' argument must be a character string.")) if (!is.element(measure, c("RR","OR","PETO","RD","AS","PHI","YUQ","YUY","RTET", # 2x2 table measures "PBIT","OR2D","OR2DN","OR2DL", # - transformations to SMD "MPRD","MPRR","MPOR","MPORC","MPPETO","MPORM", # - measures for matched pairs data "IRR","IRD","IRSD", # two-group person-time data measures "MD","SMD","SMDH","ROM", # two-group mean/SD measures "CVR","VR", # coefficient of variation ratio, variability ratio "RPB","RBIS","D2OR","D2ORN","D2ORL", # - transformations to r_PB, r_BIS, and log(OR) "COR","UCOR","ZCOR", # correlations (raw and r-to-z transformed) "PCOR","ZPCOR","SPCOR", # partial and semi-partial correlations "R2","ZR2", # coefficient of determination (raw and r-to-z transformed) "PR","PLN","PLO","PAS","PFT", # single proportions (and transformations thereof) "IR","IRLN","IRS","IRFT", # single-group person-time data (and transformations thereof) "MN","MNLN","CVLN","SDLN","SMN", # mean, log(mean), log(CV), log(SD), standardized mean "MC","SMCC","SMCR","SMCRH","ROMC","CVRC","VRC", # raw/standardized mean change, log(ROM), CVR, and VR for dependent samples "ARAW","AHW","ABT"))) # alpha (and transformations thereof) stop(mstyle$stop("Unknown 'measure' specified.")) if (is.element(measure, c("CVR","VR","PCOR","ZPCOR","SPCOR","R2","ZR2","CVLN","SDLN","VRC"))) stop(mstyle$stop("Function not available for this outcome measure.")) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (!is.element(to, c("all","only0","if0all","none"))) stop(mstyle$stop("Unknown 'to' argument specified.")) ### check if data argument has been specified if (missing(data)) data <- NULL if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } mf <- match.call() ### get slab and subset arguments (will be NULL when unspecified) slab <- .getx("slab", mf=mf, data=data) subset <- .getx("subset", mf=mf, data=data) ######################################################################### ######################################################################### ######################################################################### if (is.element(measure, c("RR","OR","RD","AS","PETO","PHI","YUQ","YUY","RTET","PBIT","OR2D","OR2DN","OR2DL","MPRD","MPRR","MPOR","MPORC","MPPETO","MPORM"))) { ai <- .getx("ai", mf=mf, data=data, checknumeric=TRUE) bi <- .getx("bi", mf=mf, data=data, checknumeric=TRUE) ci <- .getx("ci", mf=mf, data=data, checknumeric=TRUE) di <- .getx("di", mf=mf, data=data, checknumeric=TRUE) n1i <- .getx("n1i", mf=mf, data=data, checknumeric=TRUE) n2i <- .getx("n2i", mf=mf, data=data, checknumeric=TRUE) if (!.equal.length(ai, bi, ci, di, n1i, n2i)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) n1i.inc <- n1i != ai + bi n2i.inc <- n2i != ci + di if (any(n1i.inc, na.rm=TRUE)) stop(mstyle$stop("One or more 'n1i' values are not equal to 'ai + bi'.")) if (any(n2i.inc, na.rm=TRUE)) stop(mstyle$stop("One or more 'n2i' values are not equal to 'ci + di'.")) bi <- replmiss(bi, n1i-ai) di <- replmiss(di, n2i-ci) if (!.all.specified(ai, bi, ci, di)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., ai, bi, ci, di or ai, n1i, ci, n2i).")) k <- length(ai) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) ai <- .getsubset(ai, subset) bi <- .getsubset(bi, subset) ci <- .getsubset(ci, subset) di <- .getsubset(di, subset) } n1i <- ai + bi n2i <- ci + di if (any(c(ai > n1i, ci > n2i), na.rm=TRUE)) stop(mstyle$stop("One or more event counts are larger than the corresponding group sizes.")) if (any(c(ai, bi, ci, di) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more counts are negative.")) if (any(c(n1i < 0, n2i < 0), na.rm=TRUE)) stop(mstyle$stop("One or more group sizes are negative.")) ni.u <- ai + bi + ci + di ### unadjusted total sample sizes ### if drop00=TRUE, set counts to NA for studies that have no events (or all events) in both arms if (drop00) { id00 <- c(ai == 0L & ci == 0L) | c(bi == 0L & di == 0L) id00[is.na(id00)] <- FALSE ai[id00] <- NA_real_ bi[id00] <- NA_real_ ci[id00] <- NA_real_ di[id00] <- NA_real_ } if (to == "all") { ### always add to all cells in all studies ai <- ai + add ci <- ci + add bi <- bi + add di <- di + add } if (to == "only0") { ### add to cells in studies with at least one 0 entry id0 <- c(ai == 0L | ci == 0L | bi == 0L | di == 0L) id0[is.na(id0)] <- FALSE ai[id0] <- ai[id0] + add ci[id0] <- ci[id0] + add bi[id0] <- bi[id0] + add di[id0] <- di[id0] + add } if (to == "if0all") { ### add to cells in all studies if there is at least one 0 entry id0 <- c(ai == 0L | ci == 0L | bi == 0L | di == 0L) id0[is.na(id0)] <- FALSE if (any(id0)) { ai <- ai + add ci <- ci + add bi <- bi + add di <- di + add } } } ######################################################################### if (is.element(measure, c("IRR","IRD","IRSD"))) { x1i <- .getx("x1i", mf=mf, data=data, checknumeric=TRUE) x2i <- .getx("x2i", mf=mf, data=data, checknumeric=TRUE) t1i <- .getx("t1i", mf=mf, data=data, checknumeric=TRUE) t2i <- .getx("t2i", mf=mf, data=data, checknumeric=TRUE) if (!.all.specified(x1i, x2i, t1i, t2i)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., x1i, x2i, t1i, t2i).")) if (!.equal.length(x1i, x2i, t1i, t2i)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k <- length(x1i) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) x1i <- .getsubset(x1i, subset) x2i <- .getsubset(x2i, subset) t1i <- .getsubset(t1i, subset) t2i <- .getsubset(t2i, subset) } if (any(c(x1i, x2i) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more counts are negative.")) if (any(c(t1i, t2i) <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more person-times are <= 0.")) ni.u <- t1i + t2i ### unadjusted total sample sizes ### if drop00=TRUE, set counts to NA for studies that have no events in both arms if (drop00) { id00 <- c(x1i == 0L & x2i == 0L) id00[is.na(id00)] <- FALSE x1i[id00] <- NA_real_ x2i[id00] <- NA_real_ } if (to == "all") { ### always add to all cells in all studies x1i <- x1i + add x2i <- x2i + add } if (to == "only0") { ### add to cells in studies with at least one 0 entry id0 <- c(x1i == 0L | x2i == 0L) id0[is.na(id0)] <- FALSE x1i[id0] <- x1i[id0] + add x2i[id0] <- x2i[id0] + add } if (to == "if0all") { ### add to cells in all studies if there is at least one 0 entry id0 <- c(x1i == 0L | x2i == 0L) id0[is.na(id0)] <- FALSE if (any(id0)) { x1i <- x1i + add x2i <- x2i + add } } } ######################################################################### if (is.element(measure, c("MD","SMD","SMDH","ROM","RPB","RBIS","D2OR","D2ORN","D2ORL"))) { m1i <- .getx("m1i", mf=mf, data=data, checknumeric=TRUE) m2i <- .getx("m2i", mf=mf, data=data, checknumeric=TRUE) sd1i <- .getx("sd1i", mf=mf, data=data, checknumeric=TRUE) sd2i <- .getx("sd2i", mf=mf, data=data, checknumeric=TRUE) n1i <- .getx("n1i", mf=mf, data=data, checknumeric=TRUE) n2i <- .getx("n2i", mf=mf, data=data, checknumeric=TRUE) if (!.all.specified(m1i, m2i, sd1i, sd2i, n1i, n2i)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., m1i, m2i, sd1i, sd2i, n1i, n2i).")) if (!.equal.length(m1i, m2i, sd1i, sd2i, n1i, n2i)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k <- length(n1i) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) m1i <- .getsubset(m1i, subset) m2i <- .getsubset(m2i, subset) sd1i <- .getsubset(sd1i, subset) sd2i <- .getsubset(sd2i, subset) n1i <- .getsubset(n1i, subset) n2i <- .getsubset(n2i, subset) } if (any(c(sd1i, sd2i) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more standard deviations are negative.")) if (any(c(n1i, n2i) <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more group sizes are <= 0.")) ni.u <- n1i + n2i ### unadjusted total sample sizes } ######################################################################### if (is.element(measure, c("COR","UCOR","ZCOR"))) { ri <- .getx("ri", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) ti <- .getx("ti", mf=mf, data=data, checknumeric=TRUE) if (!.equal.length(ri, ni, ti)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) ri <- replmiss(ri, ti / sqrt(ni - 2 + ti^2)) if (!.all.specified(ri, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., ri, ni).")) k <- length(ri) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) ri <- .getsubset(ri, subset) ni <- .getsubset(ni, subset) } if (any(abs(ri) > 1, na.rm=TRUE)) stop(mstyle$stop("One or more correlations are > 1 or < -1.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more sample sizes are <= 0.")) ni.u <- ni ### unadjusted total sample sizes } ######################################################################### if (is.element(measure, c("PR","PLN","PLO","PAS","PFT"))) { xi <- .getx("xi", mf=mf, data=data, checknumeric=TRUE) mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) if (!.equal.length(xi, mi, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) ni.inc <- ni != xi + mi if (any(ni.inc, na.rm=TRUE)) stop(mstyle$stop("One or more 'ni' values are not equal to 'xi + mi'.")) mi <- replmiss(mi, ni-xi) if (!.all.specified(xi, mi)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., xi, mi or xi, ni).")) k <- length(xi) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) xi <- .getsubset(xi, subset) mi <- .getsubset(mi, subset) } ni <- xi + mi if (any(xi > ni, na.rm=TRUE)) stop(mstyle$stop("One or more event counts are larger than the corresponding group sizes.")) if (any(c(xi, mi) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more counts are negative.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more group sizes are <= 0.")) ni.u <- ni ### unadjusted total sample sizes if (to == "all") { ### always add to all cells in all studies xi <- xi + add mi <- mi + add } if (to == "only0") { ### add to cells in studies with at least one 0 entry id0 <- c(xi == 0L | mi == 0L) id0[is.na(id0)] <- FALSE xi[id0] <- xi[id0] + add mi[id0] <- mi[id0] + add } if (to == "if0all") { ### add to cells in all studies if there is at least one 0 entry id0 <- c(xi == 0L | mi == 0L) id0[is.na(id0)] <- FALSE if (any(id0)) { xi <- xi + add mi <- mi + add } } } ######################################################################### if (is.element(measure, c("IR","IRLN","IRS","IRFT"))) { xi <- .getx("xi", mf=mf, data=data, checknumeric=TRUE) ti <- .getx("ti", mf=mf, data=data, checknumeric=TRUE) if (!.all.specified(xi, ti)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., xi, ti).")) if (!.equal.length(xi, ti)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k <- length(xi) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) xi <- .getsubset(xi, subset) ti <- .getsubset(ti, subset) } if (any(xi < 0, na.rm=TRUE)) stop(mstyle$stop("One or more counts are negative.")) if (any(ti <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more person-times are <= 0.")) ni.u <- ti ### unadjusted total sample sizes if (to == "all") { ### always add to all cells in all studies xi <- xi + add } if (to == "only0") { ### add to cells in studies with at least one 0 entry id0 <- c(xi == 0L) id0[is.na(id0)] <- FALSE xi[id0] <- xi[id0] + add } if (to == "if0all") { ### add to cells in all studies if there is at least one 0 entry id0 <- c(xi == 0L) id0[is.na(id0)] <- FALSE if (any(id0)) { xi <- xi + add } } } ######################################################################### if (is.element(measure, c("MN","MNLN","SMN"))) { mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) sdi <- .getx("sdi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) if (!.all.specified(mi, sdi, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., mi, sdi, ni).")) if (!.equal.length(mi, sdi, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k <- length(ni) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) mi <- .getsubset(mi, subset) sdi <- .getsubset(sdi, subset) ni <- .getsubset(ni, subset) } if (any(sdi < 0, na.rm=TRUE)) stop(mstyle$stop("One or more standard deviations are negative.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more sample sizes are <= 0.")) if (is.element(measure, c("MNLN","CVLN")) && any(mi < 0, na.rm=TRUE)) stop(mstyle$stop("One or more means are negative.")) ni.u <- ni ### unadjusted total sample sizes } ######################################################################### if (is.element(measure, c("MC","SMCC","SMCR","SMCRH","ROMC","CVRC"))) { m1i <- .getx("m1i", mf=mf, data=data, checknumeric=TRUE) m2i <- .getx("m2i", mf=mf, data=data, checknumeric=TRUE) sd1i <- .getx("sd1i", mf=mf, data=data, checknumeric=TRUE) sd2i <- .getx("sd2i", mf=mf, data=data, checknumeric=TRUE) ri <- .getx("ri", mf=mf, data=data, checknumeric=TRUE) ### for SMCR, do not need to supply this ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) k <- length(m1i) ### number of outcomes before subsetting if (is.element(measure, c("MC","SMCC","SMCRH","ROMC","CVRC"))) { if (!.all.specified(m1i, m2i, sd1i, sd2i, ni, ri)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., m1i, m2i, sd1i, sd2i, ni, ri).")) if (!.equal.length(m1i, m2i, sd1i, sd2i, ni, ri)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) } else { if (!.all.specified(m1i, m2i, sd1i, ni, ri)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., m1i, m2i, sd1i, ni, ri).")) if (!.equal.length(m1i, m2i, sd1i, ni, ri)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) } if (!is.null(subset)) { subset <- .chksubset(subset, k) m1i <- .getsubset(m1i, subset) m2i <- .getsubset(m2i, subset) sd1i <- .getsubset(sd1i, subset) sd2i <- .getsubset(sd2i, subset) ni <- .getsubset(ni, subset) ri <- .getsubset(ri, subset) } if (is.element(measure, c("MC","SMCC","SMCRH","ROMC","CVRC"))) { if (any(c(sd1i, sd2i) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more standard deviations are negative.")) } else { if (any(sd1i < 0, na.rm=TRUE)) stop(mstyle$stop("One or more standard deviations are negative.")) } if (any(abs(ri) > 1, na.rm=TRUE)) stop(mstyle$stop("One or more correlations are > 1 or < -1.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more sample sizes are <= 0.")) ni.u <- ni ### unadjusted total sample sizes } ######################################################################### if (is.element(measure, c("ARAW","AHW","ABT"))) { ai <- .getx("ai", mf=mf, data=data, checknumeric=TRUE) mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) if (!.all.specified(ai, mi, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., ai, mi, ni).")) if (!.equal.length(ai, mi, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k <- length(ai) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) ai <- .getsubset(ai, subset) mi <- .getsubset(mi, subset) ni <- .getsubset(ni, subset) } if (any(ai > 1, na.rm=TRUE)) stop(mstyle$stop("One or more alpha values are > 1.")) if (any(mi < 2, na.rm=TRUE)) stop(mstyle$stop("One or more mi values are < 2.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more sample sizes are <= 0.")) ni.u <- ni ### unadjusted total sample sizes } ######################################################################### ######################################################################### ######################################################################### ### generate study labels if none are specified if (is.null(slab)) { slab <- seq_len(k) } else { if (anyNA(slab)) stop(mstyle$stop("NAs in study labels.")) if (length(slab) != k) stop(mstyle$stop("Study labels not of same length as data.")) if (is.factor(slab)) slab <- as.character(slab) } ### if a subset of studies is specified if (!is.null(subset)) slab <- .getsubset(slab, subset) ### check if study labels are unique; if not, make them unique if (anyDuplicated(slab)) slab <- .make.unique(slab) ######################################################################### ######################################################################### ######################################################################### if (is.element(measure, c("RR","OR","RD","AS","PETO","PHI","YUQ","YUY","RTET","PBIT","OR2D","OR2DN","OR2DL","MPORM"))) { ### check for NAs in table data and act accordingly has.na <- is.na(ai) | is.na(bi) | is.na(ci) | is.na(di) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { ai <- ai[not.na] bi <- bi[not.na] ci <- ci[not.na] di <- di[not.na] slab <- slab[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(ai) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### row/group and column/outcome names if (missing(rows)) { rows <- c("Grp1", "Grp2") } else { if (length(rows) != 2L) stop(mstyle$stop("Group names not of length 2.")) } if (missing(cols)) { cols <- c("Out1", "Out2") } else { if (length(cols) != 2L) stop(mstyle$stop("Outcome names not of length 2.")) } dat <- array(NA_real_, dim=c(2,2,k), dimnames=list(rows, cols, slab)) for (i in seq_len(k)) { tab.i <- rbind(c(ai[i],bi[i]), c(ci[i],di[i])) dat[,,i] <- tab.i } } ######################################################################### if (is.element(measure, c("MPRD","MPRR","MPOR"))) { ### check for NAs in table data and act accordingly has.na <- is.na(ai) | is.na(bi) | is.na(ci) | is.na(di) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { ai <- ai[not.na] bi <- bi[not.na] ci <- ci[not.na] di <- di[not.na] slab <- slab[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(ai) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### row/group and column/outcome names if (missing(rows)) { rows <- c("Time1", "Time2") } else { if (length(rows) != 2L) stop(mstyle$stop("Time names not of length 2.")) } if (missing(cols)) { cols <- c("Out1", "Out2") } else { if (length(cols) != 2L) stop(mstyle$stop("Outcome names not of length 2.")) } dat <- array(NA_real_, dim=c(2,2,k), dimnames=list(rows, cols, slab)) for (i in seq_len(k)) { tab.i <- rbind(c(ai[i]+bi[i],ci[i]+di[i]), c(ai[i]+ci[i],bi[i]+di[i])) dat[,,i] <- tab.i } } ######################################################################### if (is.element(measure, c("MPORC","MPPETO"))) { ### check for NAs in table data and act accordingly has.na <- is.na(ai) | is.na(bi) | is.na(ci) | is.na(di) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { ai <- ai[not.na] bi <- bi[not.na] ci <- ci[not.na] di <- di[not.na] slab <- slab[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(ai) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### row/group and column/outcome names if (missing(rows)) { rows <- c("Time1.Out1", "Time1.Out2") } else { if (length(rows) != 2L) stop(mstyle$stop("Time1 names not of length 2.")) } if (missing(cols)) { cols <- c("Time2.Out1", "Time2.Out2") } else { if (length(cols) != 2L) stop(mstyle$stop("Time2 names not of length 2.")) } dat <- array(NA_real_, dim=c(2,2,k), dimnames=list(rows, cols, slab)) for (i in seq_len(k)) { tab.i <- rbind(c(ai[i],bi[i]), c(ci[i],di[i])) dat[,,i] <- tab.i } } ######################################################################### if (is.element(measure, c("IRR","IRD","IRSD"))) { ### check for NAs in table data and act accordingly has.na <- is.na(x1i) | is.na(x2i) | is.na(t1i) | is.na(t2i) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { x1i <- x1i[not.na] x2i <- x2i[not.na] t1i <- t1i[not.na] t2i <- t2i[not.na] slab <- slab[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(x1i) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### row/group and column/outcome names if (missing(rows)) { rows <- c("Grp1", "Grp2") } else { if (length(rows) != 2L) stop(mstyle$stop("Group names not of length 2.")) } if (missing(cols)) { cols <- c("Events", "Person-Time") } else { if (length(cols) != 2L) stop(mstyle$stop("Outcome names not of length 2.")) } dat <- array(NA_real_, dim=c(2,2,k), dimnames=list(rows, cols, slab)) for (i in seq_len(k)) { tab.i <- rbind(c(x1i[i],t1i[i]), c(x2i[i],t2i[i])) dat[,,i] <- tab.i } } ######################################################################### if (is.element(measure, c("MD","SMD","SMDH","ROM","RPB","RBIS","D2OR","D2ORN","D2ORL"))) { ### check for NAs in table data and act accordingly has.na <- is.na(m1i) | is.na(m2i) | is.na(sd1i) | is.na(sd2i) | is.na(n1i) | is.na(n2i) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { m1i <- m1i[not.na] m2i <- m2i[not.na] sd1i <- sd1i[not.na] sd2i <- sd2i[not.na] n1i <- n1i[not.na] n2i <- n2i[not.na] slab <- slab[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(m1i) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### row/group and column/outcome names if (missing(rows)) { rows <- c("Grp1", "Grp2") } else { if (length(rows) != 2L) stop(mstyle$stop("Group names not of length 2.")) } if (missing(cols)) { cols <- c("Mean", "SD", "n") } else { if (length(cols) != 3L) stop(mstyle$stop("Outcome names not of length 3.")) } dat <- array(NA_real_, dim=c(2,3,k), dimnames=list(rows, cols, slab)) for (i in seq_len(k)) { tab.i <- rbind(c(m1i[i],sd1i[i],n1i[i]), c(m2i[i],sd2i[i],n2i[i])) dat[,,i] <- tab.i } } ######################################################################### if (is.element(measure, c("COR","UCOR","ZCOR"))) { ### check for NAs in table data and act accordingly has.na <- is.na(ri) | is.na(ni) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { ri <- ri[not.na] ni <- ni[not.na] slab <- slab[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(ri) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### row/group and column/outcome names if (missing(rows)) { rows <- c("Grp") } else { if (length(rows) != 1L) stop(mstyle$stop("Group names not of length 1.")) } if (missing(cols)) { cols <- c("r", "n") } else { if (length(cols) != 2L) stop(mstyle$stop("Outcome names not of length 2.")) } dat <- array(NA_real_, dim=c(1,2,k), dimnames=list(rows, cols, slab)) for (i in seq_len(k)) { tab.i <- c(ri[i],ni[i]) dat[,,i] <- tab.i } } ######################################################################### if (is.element(measure, c("PR","PLN","PLO","PAS","PFT"))) { ### check for NAs in table data and act accordingly has.na <- is.na(xi) | is.na(mi) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { xi <- xi[not.na] mi <- mi[not.na] slab <- slab[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(xi) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### row/group and column/outcome names if (missing(rows)) { rows <- c("Grp") } else { if (length(rows) != 1L) stop(mstyle$stop("Group names not of length 1.")) } if (missing(cols)) { cols <- c("Out1", "Out2") } else { if (length(cols) != 2L) stop(mstyle$stop("Outcome names not of length 2.")) } dat <- array(NA_real_, dim=c(1,2,k), dimnames=list(rows, cols, slab)) for (i in seq_len(k)) { tab.i <- c(xi[i],mi[i]) dat[,,i] <- tab.i } } ######################################################################### if (is.element(measure, c("IR","IRLN","IRS","IRFT"))) { ### check for NAs in table data and act accordingly has.na <- is.na(xi) | is.na(ti) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { xi <- xi[not.na] ti <- ti[not.na] slab <- slab[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(xi) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### row/group and column/outcome names if (missing(rows)) { rows <- c("Grp") } else { if (length(rows) != 1L) stop(mstyle$stop("Group names not of length 1.")) } if (missing(cols)) { cols <- c("Events", "Person-Time") } else { if (length(cols) != 2L) stop(mstyle$stop("Outcome names not of length 2.")) } dat <- array(NA_real_, dim=c(1,2,k), dimnames=list(rows, cols, slab)) for (i in seq_len(k)) { tab.i <- c(xi[i],ti[i]) dat[,,i] <- tab.i } } ######################################################################### if (is.element(measure, c("MN","MNLN","SMN"))) { ### check for NAs in table data and act accordingly has.na <- is.na(mi) | is.na(sdi) | is.na(ni) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { mi <- mi[not.na] sdi <- sdi[not.na] ni <- ni[not.na] slab <- slab[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(ni) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### row/group and column/outcome names if (missing(rows)) { rows <- c("Grp") } else { if (length(rows) != 1L) stop(mstyle$stop("Group names not of length 1.")) } if (missing(cols)) { cols <- c("Mean", "SD", "n") } else { if (length(cols) != 3L) stop(mstyle$stop("Outcome names not of length 3.")) } dat <- array(NA_real_, dim=c(1,3,k), dimnames=list(rows, cols, slab)) for (i in seq_len(k)) { tab.i <- c(mi[i],sdi[i],ni[i]) dat[,,i] <- tab.i } } ######################################################################### if (is.element(measure, c("MC","SMCC","SMCR","SMCRH","ROMC","CVRC"))) { ### check for NAs in table data and act accordingly if (is.element(measure, c("MC","SMCC","SMCRH","ROMC","CVRC"))) { has.na <- is.na(m1i) | is.na(m2i) | is.na(sd1i) | is.na(sd2i) | is.na(ni) | is.na(ri) } else { has.na <- is.na(m1i) | is.na(m2i) | is.na(sd1i) | is.na(ni) | is.na(ri) } if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { m1i <- m1i[not.na] m2i <- m2i[not.na] sd1i <- sd1i[not.na] if (is.element(measure, c("MC","SMCC","SMCRH","ROMC","CVRC"))) sd2i <- sd2i[not.na] ni <- ni[not.na] ri <- ri[not.na] slab <- slab[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(m1i) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### row/group and column/outcome names if (missing(rows)) { rows <- c("Grp") } else { if (length(rows) != 1L) stop(mstyle$stop("Group names not of length 1.")) } if (is.element(measure, c("MC","SMCC","SMCRH","ROMC","CVRC"))) { if (missing(cols)) { cols <- c("Mean1", "Mean2", "SD1", "SD2", "n", "r") } else { if (length(cols) != 6L) stop(mstyle$stop("Outcome names not of length 6.")) } } else { if (missing(cols)) { cols <- c("Mean1", "Mean2", "SD1", "n", "r") } else { if (length(cols) != 5L) stop(mstyle$stop("Outcome names not of length 5.")) } } if (is.element(measure, c("MC","SMCC","SMCRH","ROMC","CVRC"))) { dat <- array(NA_real_, dim=c(1,6,k), dimnames=list(rows, cols, slab)) for (i in seq_len(k)) { tab.i <- c(m1i[i],m2i[i],sd1i[i],sd2i[i],ni[i],ri[i]) dat[,,i] <- tab.i } } else { dat <- array(NA_real_, dim=c(1,5,k), dimnames=list(rows, cols, slab)) for (i in seq_len(k)) { tab.i <- c(m1i[i],m2i[i],sd1i[i],ni[i],ri[i]) dat[,,i] <- tab.i } } } ######################################################################### if (is.element(measure, c("ARAW","AHW","ABT"))) { ### check for NAs in table data and act accordingly has.na <- is.na(ai) | is.na(mi) | is.na(ni) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { ai <- ai[not.na] mi <- mi[not.na] ni <- ni[not.na] slab <- slab[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(ai) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### row/group and column/outcome names if (missing(rows)) { rows <- c("Grp") } else { if (length(rows) != 1L) stop(mstyle$stop("Group names not of length 1.")) } if (missing(cols)) { cols <- c("alpha", "m", "n") } else { if (length(cols) != 3L) stop(mstyle$stop("Outcome names not of length 3.")) } dat <- array(NA_real_, dim=c(1,3,k), dimnames=list(rows, cols, slab)) for (i in seq_len(k)) { tab.i <- c(ai[i],mi[i],ni[i]) dat[,,i] <- tab.i } } ######################################################################### return(dat) } metafor/R/ranktest.r0000644000176200001440000000750314477355612014151 0ustar liggesusersranktest <- function(x, vi, sei, subset, data, digits, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) ddd <- list(...) .chkdots(ddd, c("exact")) if (is.null(ddd$exact)) { exact <- TRUE } else { exact <- ddd$exact } ######################################################################### ### check if data argument has been specified if (missing(data)) data <- NULL if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } mf <- match.call() x <- .getx("x", mf=mf, data=data) ############################################################################ if (inherits(x, "rma")) { if (!missing(vi) || !missing(sei) || !missing(subset)) warning(mstyle$warning("Arguments 'vi', 'sei', and 'subset' ignored when 'x' is a model object."), call.=FALSE) if (!x$int.only) stop(mstyle$stop("Test only applicable to models without moderators.")) yi <- x$yi vi <- x$vi ### set defaults for digits if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } } else { if (!.is.vector(x)) stop(mstyle$stop("Argument 'x' must be a vector or an 'rma' model object.")) yi <- x ### check if yi is numeric if (!is.numeric(yi)) stop(mstyle$stop("The object/variable specified for the 'x' argument is not numeric.")) ### set defaults for digits if (missing(digits)) { digits <- .set.digits(dmiss=TRUE) } else { digits <- .set.digits(digits, dmiss=FALSE) } vi <- .getx("vi", mf=mf, data=data, checknumeric=TRUE) sei <- .getx("sei", mf=mf, data=data, checknumeric=TRUE) subset <- .getx("subset", mf=mf, data=data) if (is.null(vi)) { if (!is.null(sei)) vi <- sei^2 } if (is.null(vi)) stop(mstyle$stop("Must specify 'vi' or 'sei' argument.")) ### check length of yi and vi if (length(yi) != length(vi)) stop(mstyle$stop("Length of 'yi' and 'vi' (or 'sei') is not the same.")) ### check 'vi' argument for potential misuse .chkviarg(mf$vi) ######################################################################### ### if a subset of studies is specified if (!is.null(subset)) { subset <- .chksubset(subset, length(yi)) yi <- .getsubset(yi, subset) vi <- .getsubset(vi, subset) } ### check for NAs and act accordingly has.na <- is.na(yi) | is.na(vi) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { yi <- yi[not.na] vi <- vi[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "studies", "study"), "with NAs omitted from test.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in data.")) } } ######################################################################### wi <- 1/vi theta <- weighted.mean(yi, wi) vb <- 1 / sum(wi) vi.star <- vi - vb yi.star <- (yi - theta) / sqrt(vi.star) res <- cor.test(yi.star, vi, method="kendall", exact=exact) pval <- res$p.value tau <- res$estimate res <- list(tau=tau, pval=pval, digits=digits) class(res) <- "ranktest" return(res) } metafor/R/fitstats.rma.r0000644000176200001440000000307014305042515014711 0ustar liggesusersfitstats.rma <- function(object, ..., REML) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma") ### unless REML argument is specified, method of first object determines ### whether to show fit statistics based on the ML or REML likelihood if (missing(REML)) { if (object$method == "REML") { REML <- TRUE } else { REML <- FALSE } } if (missing(...)) { ### if there is just 'object' if (REML) { out <- cbind(object$fit.stats$REML) colnames(out) <- "REML" } else { out <- cbind(object$fit.stats$ML) colnames(out) <- "ML" } } else { ### if there is 'object' and additional objects via ... if (REML) { out <- sapply(list(object, ...), function(x) x$fit.stats$REML) } else { out <- sapply(list(object, ...), function(x) x$fit.stats$ML) } out <- data.frame(out) ### get names of objects; same idea as in stats:::AIC.default cl <- match.call() cl$REML <- NULL names(out) <- as.character(cl[-1L]) ### check that all models were fitted to the same data yis <- lapply(list(object, ...), function(x) as.vector(x$yi)) if (!all(sapply(yis[-1], function(x) identical(x, yis[[1]])))) warning(mstyle$warning("Models not all fitted to the same data."), call.=FALSE) } rownames(out) <- c("logLik:", "deviance:", "AIC:", "BIC:", "AICc:") return(out) #print(fmtx(out, object$digits[["fit"]]), quote=FALSE) #invisible(out) } metafor/R/zzz.r0000644000176200001440000000705214505062000013124 0ustar liggesusers.onAttach <- function(libname, pkgname) { ver <- "4.4-0" loadmsg <- paste0("\nLoading the 'metafor' package (version ", ver, "). For an\nintroduction to the package please type: help(metafor)\n") installed.ver <- as.numeric(strsplit(gsub("-", ".", ver, fixed=TRUE), ".", fixed=TRUE)[[1]]) # set default options mfopts <- getOption("metafor") if (is.null(mfopts) || !is.list(mfopts)) { options("metafor" = list(check=TRUE, silent=FALSE, space=TRUE, theme="default")) } else { if (is.null(mfopts$check)) mfopts$check <- TRUE if (is.null(mfopts$silent)) mfopts$silent <- FALSE if (is.null(mfopts$space)) mfopts$space <- TRUE if (is.null(mfopts$theme)) mfopts$theme <- "default" options("metafor" = mfopts) } # only run version check in an interactive session and if METAFOR_VERSION_CHECK is not FALSE verchk <- tolower(Sys.getenv("METAFOR_VERSION_CHECK")) # "" if unset checkopt <- getOption("metafor")$check if (!is.null(checkopt)) { if (is.logical(checkopt) && isFALSE(checkopt)) verchk <- "false" if (is.character(checkopt) && isTRUE(checkopt == "devel")) verchk <- "devel" } if (interactive() && verchk != "false") { #print("Version check ...") if (isTRUE(verchk == "devel")) { # pull version number from GitHub tmp <- suppressWarnings(try(readLines("https://raw.githubusercontent.com/wviechtb/metafor/master/DESCRIPTION", n=2), silent=TRUE)) if (!inherits(tmp, "try-error") && length(tmp) == 2L) { available.ver <- tmp[2] if (!is.na(available.ver) && length(available.ver) != 0L) available.ver <- substr(available.ver, 10, nchar(available.ver)) # strip 'Version: ' part } } else { # pull version number from CRAN tmp <- suppressWarnings(try(readLines("https://cran.r-project.org/web/packages/metafor/index.html"), silent=TRUE)) if (!inherits(tmp, "try-error")) { available.ver <- tmp[grep("Version:", tmp, fixed=TRUE) + 1] if (!is.na(available.ver) && length(available.ver) != 0L) available.ver <- substr(available.ver, 5, nchar(available.ver)-5) # strip and } } if (!inherits(tmp, "try-error")) { save.ver <- available.ver # need this below is message available.ver <- as.numeric(strsplit(gsub("-", ".", available.ver), ".", fixed=TRUE)[[1]]) installed.ver <- 100000 * installed.ver[1] + 1000 * installed.ver[2] + installed.ver[3] available.ver <- 100000 * available.ver[1] + 1000 * available.ver[2] + available.ver[3] if (isTRUE(installed.ver < available.ver)) { loadmsg <- paste0(loadmsg, "\nAn updated version of the package (version ", save.ver, ") is available!\nTo update to this version type: ") if (isTRUE(verchk == "devel")) { loadmsg <- paste0(loadmsg, "remotes::install_github(\"wviechtb/metafor\")\n") } else { loadmsg <- paste0(loadmsg, "install.packages(\"metafor\")\n") } } } } options("pboptions" = list( type = if (interactive()) "timer" else "none", char = "=", txt.width = 50, gui.width = 300, style = 3, initial = 0, title = "Progress Bar", label = "", nout = 100L, min_time = 2, use_lb = FALSE)) if (isFALSE(getOption("metafor")$silent)) packageStartupMessage(loadmsg, domain=NULL, appendLF=TRUE) } .metafor <- new.env() metafor/R/vcov.rma.r0000644000176200001440000000731214401677763014050 0ustar liggesusersvcov.rma <- function(object, type="fixed", ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma") na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) type <- match.arg(type, c("fixed", "beta", "alpha", "delta", "obs", "fitted", "resid")) ######################################################################### if (type=="fixed") { out <- object$vb if (inherits(object, "rma.ls")) out <- list(beta = object$vb, alpha = object$va) if (inherits(object, "rma.uni.selmodel")) out <- list(beta = object$vb, delta = object$vd) return(out) } if (type=="beta") { out <- object$vb return(out) } if (type=="alpha") { if (!inherits(object, "rma.ls")) stop(mstyle$stop("Can only extract var-cov matrix of alpha coefficients for location-scale models.")) out <- object$va return(out) } if (type=="delta") { if (!inherits(object, "rma.uni.selmodel")) stop(mstyle$stop("Can only extract var-cov matrix of delta coefficients for selection models.")) out <- object$vd return(out) } ######################################################################### if (type=="obs") { if (inherits(object, c("rma.uni","rma.mv"))) { out <- matrix(NA_real_, nrow=object$k.f, ncol=object$k.f) out[object$not.na, object$not.na] <- as.matrix(object$M) # as.matrix() needed when sparse=TRUE rownames(out) <- colnames(out) <- object$slab if (na.act == "na.omit") out <- out[object$not.na, object$not.na] if (na.act == "na.fail" && any(!object$not.na)) stop(mstyle$stop("Missing values in data.")) return(out) } else { stop(mstyle$stop("Extraction of marginal var-cov matrix not available for objects of this class.")) } } ######################################################################### if (type=="fitted") { out <- object$X.f %*% object$vb %*% t(object$X.f) rownames(out) <- colnames(out) <- object$slab if (na.act == "na.omit") out <- out[object$not.na, object$not.na] if (na.act == "na.exclude" || na.act == "na.pass") { out[!object$not.na,] <- NA_real_ out[,!object$not.na] <- NA_real_ } return(out) } ######################################################################### if (type=="resid") { ### the SEs of the residuals cannot be estimated consistently for "robust.rma" objects if (inherits(object, c("robust.rma", "rma.gen"))) stop(mstyle$stop("Extraction of var-cov matrix of the residuals not available for objects of this type.")) options(na.action="na.omit") H <- hatvalues(object, type="matrix") options(na.action = na.act) ImH <- diag(object$k) - H if (inherits(object, "robust.rma")) { ve <- ImH %*% tcrossprod(object$meat,ImH) } else { ve <- ImH %*% tcrossprod(as.matrix(object$M),ImH) # as.matrix() needed when sparse=TRUE } if (na.act == "na.omit") { out <- ve rownames(out) <- colnames(out) <- object$slab[object$not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- matrix(NA_real_, nrow=object$k.f, ncol=object$k.f) out[object$not.na, object$not.na] <- ve rownames(out) <- colnames(out) <- object$slab } return(out) } ######################################################################### } metafor/R/mfopt.r0000644000176200001440000000306414466626612013440 0ustar liggesuserssetmfopt <- function(...) { mstyle <- .get.mstyle("crayon" %in% .packages()) mfopts <- getOption("metafor") if (is.null(mfopts) || !is.list(mfopts)) { options("metafor" = list(space=TRUE)) mfopts <- getOption("metafor") } newopts <- list(...) for (opt in names(newopts)) { if (opt == "space" && !is.logical(newopts[[opt]])) stop(mstyle$stop("'space' must be a logical.")) if (opt == "digits" && !is.null(newopts[[opt]]) && !is.vector(newopts[[opt]], mode="numeric")) stop(mstyle$stop("'digits' must be a numeric vector.")) if (opt == "style" && !is.null(newopts[[opt]]) && !is.list(newopts[[opt]])) stop(mstyle$stop("'style' must be a list.")) if (opt == "theme" && !is.null(newopts[[opt]]) && !is.element(newopts[[opt]], c("default", "light", "dark", "auto", "custom", "default2", "light2", "dark2", "auto2", "custom2"))) stop(mstyle$stop("'theme' must be either 'default(2)', 'light(2)', 'dark(2)', 'auto(2)', or 'custom(2)'.")) if (opt == "fg" && !is.character(newopts[[opt]])) stop(mstyle$stop("'fg' must be a character string.")) if (opt == "bg" && !is.character(newopts[[opt]])) stop(mstyle$stop("'bg' must be a character string.")) mfopts[[opt]] <- newopts[[opt]] } options("metafor" = mfopts) } getmfopt <- function(x, default=NULL) { opt <- getOption("metafor") if (!missing(x)) { x <- as.character(substitute(x)) opt <- opt[[x]] } if (is.null(opt)) { return(default) } else { return(opt) } } metafor/R/print.rma.mv.r0000644000176200001440000004502114503332403014625 0ustar liggesusersprint.rma.mv <- function(x, digits, showfit=FALSE, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.mv") if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } footsym <- .get.footsym() ddd <- list(...) .chkdots(ddd, c("num", "legend")) if (is.null(ddd$legend)) { legend <- ifelse(inherits(x, "robust.rma"), TRUE, FALSE) } else { if (is.na(ddd$legend)) { # can suppress legend and legend symbols with legend=NA legend <- FALSE footsym <- rep("", 6) } else { legend <- .isTRUE(ddd$legend) } } .space() cat(mstyle$section("Multivariate Meta-Analysis Model")) cat(mstyle$section(paste0(" (k = ", x$k, "; "))) cat(mstyle$section(paste0("method: ", x$method, ")"))) if (showfit) { cat("\n") if (x$method == "REML") { fs <- fmtx(x$fit.stats$REML, digits[["fit"]]) } else { fs <- fmtx(x$fit.stats$ML, digits[["fit"]]) } names(fs) <- c("logLik", "Deviance", "AIC", "BIC", "AICc") cat("\n") tmp <- capture.output(print(fs, quote=FALSE, print.gap=2)) #tmp[1] <- paste0(tmp[1], "\u200b") .print.table(tmp, mstyle) cat("\n") } else { cat("\n\n") } sigma2 <- fmtx(x$sigma2, digits[["var"]]) tau2 <- fmtx(x$tau2, digits[["var"]]) rho <- fmtx(x$rho, digits[["var"]]) gamma2 <- fmtx(x$gamma2, digits[["var"]]) phi <- fmtx(x$phi, digits[["var"]]) sigma <- fmtx(sqrt(x$sigma2), digits[["var"]]) tau <- fmtx(sqrt(x$tau2), digits[["var"]]) gamma <- fmtx(sqrt(x$gamma2), digits[["var"]]) cat(mstyle$section("Variance Components:")) right <- TRUE if (!x$withS && !x$withG && !x$withH) { cat(mstyle$text(" none")) cat("\n\n") } else { cat("\n\n") if (x$withS) { vc <- cbind(estim=sigma2, sqrt=sigma, nlvls=x$s.nlevels, fixed=ifelse(x$vc.fix$sigma2, "yes", "no"), factor=x$s.names, R=ifelse(x$Rfix, "yes", "no")) colnames(vc) <- c("estim", "sqrt", "nlvls", "fixed", "factor", "R") if (!x$withR) vc <- vc[,-6,drop=FALSE] if (length(x$sigma2) == 1L) { rownames(vc) <- "sigma^2 " } else { rownames(vc) <- paste("sigma^2.", seq_along(x$sigma2), sep="") } tmp <- capture.output(print(vc, quote=FALSE, right=right, print.gap=2)) .print.table(tmp, mstyle) cat("\n") } if (x$withG) { ### note: use g.nlevels.f[1] since the number of arms is based on all data (i.e., including NAs), but use ### g.nlevels[2] since the number of studies is based on what is actually available (i.e., excluding NAs) if (is.element(x$struct[1], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { inner <- trimws(paste0(strsplit(paste0(x$formulas[[1]], collapse=""), "|", fixed=TRUE)[[1]][1], collapse="")) if (nchar(inner) > 15) inner <- paste0(substr(inner, 1, 15), "[...]", collapse="") } else { inner <- x$g.names[1] } outer <- tail(x$g.names, 1) mng <- max(nchar(c(inner, outer))) cat(mstyle$text(paste0("outer factor: ", paste0(outer, paste(rep(" ", max(0,mng-nchar(outer))), collapse=""), collapse=""), " (nlvls = ", x$g.nlevels[2], ")"))) cat("\n") if (is.element(x$struct[1], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { cat(mstyle$text(paste0("inner term: ", paste0(inner, paste(rep(" ", max(0,mng-nchar(inner))), collapse=""), collapse=""), " (nlvls = ", x$g.nlevels.f[1], ")"))) } else { cat(mstyle$text(paste0("inner factor: ", paste0(inner, paste(rep(" ", max(0,mng-nchar(inner))), collapse=""), collapse=""), " (nlvls = ", x$g.nlevels.f[1], ")"))) } cat("\n\n") if (is.element(x$struct[1], c("CS","AR","CAR","ID","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) { vc <- cbind(tau2, tau, ifelse(x$vc.fix$tau2, "yes", "no")) vc <- rbind(vc, c(rho, "", ifelse(x$vc.fix$rho, "yes", "no"))) colnames(vc) <- c("estim", "sqrt", "fixed") rownames(vc) <- c("tau^2 ", "rho") if (x$struct[1] == "ID") vc <- vc[1,,drop=FALSE] tmp <- capture.output(print(vc, quote=FALSE, right=right, print.gap=2)) .print.table(tmp, mstyle) } if (is.element(x$struct[1], c("HCS","HAR","DIAG"))) { vc <- cbind(tau2, tau, x$g.levels.k, ifelse(x$vc.fix$tau2, "yes", "no"), x$g.levels.f[[1]]) vc <- rbind(vc, c(rho, "", "", ifelse(x$vc.fix$rho, "yes", "no"), "")) colnames(vc) <- c("estim", "sqrt", "k.lvl", "fixed", "level") if (length(x$tau2) == 1L) { rownames(vc) <- c("tau^2 ", "rho") } else { rownames(vc) <- c(paste("tau^2.", seq_along(x$tau2), " ", sep=""), "rho") } if (x$struct[1] == "DIAG") vc <- vc[seq_along(tau2),,drop=FALSE] tmp <- capture.output(print(vc, quote=FALSE, right=right, print.gap=2)) .print.table(tmp, mstyle) } if (is.element(x$struct[1], c("UN","UNR"))) { if (x$struct[1] == "UN") { vc <- cbind(tau2, tau, x$g.levels.k, ifelse(x$vc.fix$tau2, "yes", "no"), x$g.levels.f[[1]]) } else { vc <- cbind(rep(tau2, length(x$g.levels.k)), rep(tau, length(x$g.levels.k)), x$g.levels.k, ifelse(rep(x$vc.fix$tau2,length(x$g.levels.k)), "yes", "no"), x$g.levels.f[[1]]) } colnames(vc) <- c("estim", "sqrt", "k.lvl", "fixed", "level") if (length(x$g.levels.k) == 1L) { rownames(vc) <- c("tau^2") } else { rownames(vc) <- paste("tau^2.", seq_along(x$g.levels.k), " ", sep="") } tmp <- capture.output(print(vc, quote=FALSE, right=right, print.gap=2)) .print.table(tmp, mstyle) cat("\n") if (length(x$rho) == 1L) { G <- matrix(NA_real_, nrow=2, ncol=2) } else { G <- matrix(NA_real_, nrow=x$g.nlevels.f[1], ncol=x$g.nlevels.f[1]) } G[lower.tri(G)] <- rho G[upper.tri(G)] <- t(G)[upper.tri(G)] diag(G) <- 1 G[upper.tri(G)] <- "" if (length(x$rho) == 1L) { G.info <- matrix(NA_real_, nrow=2, ncol=2) } else { G.info <- matrix(NA_real_, nrow=x$g.nlevels.f[1], ncol=x$g.nlevels.f[1]) } G.info[lower.tri(G.info)] <- x$g.levels.comb.k G.info[upper.tri(G.info)] <- t(G.info)[upper.tri(G.info)] G.info[lower.tri(G.info)] <- ifelse(x$vc.fix$rho, "yes", "no") diag(G.info) <- "-" vc <- cbind(G, "", G.info) colnames(vc) <- c(paste("rho.", abbreviate(x$g.levels.f[[1]]), sep=""), "", abbreviate(x$g.levels.f[[1]])) ### FIXME: x$g.levels.f[[1]] may be numeric, in which case a wrapping 'header' is not recognized rownames(vc) <- x$g.levels.f[[1]] tmp <- capture.output(print(vc, quote=FALSE, right=right, print.gap=2)) .print.table(tmp, mstyle) } if (is.element(x$struct[1], c("GEN"))) { vc <- cbind(tau2, tau, ifelse(x$vc.fix$tau2, "yes", "no"), "") colnames(vc) <- c("estim", "sqrt", "fixed", "rho:") rownames(vc) <- x$g.names[-length(x$g.names)] G.info <- fmtx(cov2cor(x$G), digits[["var"]]) diag(G.info) <- "-" G.info[lower.tri(G.info)] <- ifelse(x$vc.fix$rho, "yes", "no") colnames(G.info) <- abbreviate(x$g.names[-length(x$g.names)]) vc <- cbind(vc, G.info) tmp <- capture.output(print(vc, quote=FALSE, right=right, print.gap=2)) .print.table(tmp, mstyle) } if (is.element(x$struct[1], c("GDIAG"))) { vc <- cbind(tau2, tau, ifelse(x$vc.fix$tau2, "yes", "no")) colnames(vc) <- c("estim", "sqrt", "fixed") rownames(vc) <- x$g.names[-length(x$g.names)] tmp <- capture.output(print(vc, quote=FALSE, right=right, print.gap=2)) .print.table(tmp, mstyle) } cat("\n") } if (x$withH) { ### note: use h.nlevels.f[1] since the number of arms is based on all data (i.e., including NAs), but use ### h.nlevels[2] since the number of studies is based on what is actually available (i.e., excluding NAs) if (is.element(x$struct[2], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { inner <- trimws(paste0(strsplit(paste0(x$formulas[[2]], collapse=""), "|", fixed=TRUE)[[1]][1], collapse="")) if (nchar(inner) > 15) inner <- paste0(substr(inner, 1, 15), "[...]", collapse="") } else { inner <- x$h.names[1] } outer <- tail(x$h.names, 1) mng <- max(nchar(c(inner, outer))) cat(mstyle$text(paste0("outer factor: ", paste0(outer, paste(rep(" ", max(0,mng-nchar(outer))), collapse=""), collapse=""), " (nlvls = ", x$h.nlevels[2], ")"))) cat("\n") if (is.element(x$struct[2], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { cat(mstyle$text(paste0("inner term: ", paste0(inner, paste(rep(" ", max(0,mng-nchar(inner))), collapse=""), collapse=""), " (nlvls = ", x$h.nlevels.f[1], ")"))) } else { cat(mstyle$text(paste0("inner factor: ", paste0(inner, paste(rep(" ", max(0,mng-nchar(inner))), collapse=""), collapse=""), " (nlvls = ", x$h.nlevels.f[1], ")"))) } cat("\n\n") if (is.element(x$struct[2], c("CS","AR","CAR","ID","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) { vc <- cbind(gamma2, gamma, ifelse(x$vc.fix$gamma2, "yes", "no")) vc <- rbind(vc, c(phi, "", ifelse(x$vc.fix$phi, "yes", "no"))) colnames(vc) <- c("estim", "sqrt", "fixed") rownames(vc) <- c("gamma^2 ", "phi") if (x$struct[2] == "ID") vc <- vc[1,,drop=FALSE] tmp <- capture.output(print(vc, quote=FALSE, right=right, print.gap=2)) .print.table(tmp, mstyle) } if (is.element(x$struct[2], c("HCS","HAR","DIAG"))) { vc <- cbind(gamma2, gamma, x$h.levels.k, ifelse(x$vc.fix$gamma2, "yes", "no"), x$h.levels.f[[1]]) vc <- rbind(vc, c(phi, "", "", ifelse(x$vc.fix$phi, "yes", "no"), "")) colnames(vc) <- c("estim", "sqrt", "k.lvl", "fixed", "level") if (length(x$gamma2) == 1L) { rownames(vc) <- c("gamma^2 ", "phi") } else { rownames(vc) <- c(paste("gamma^2.", seq_along(x$gamma2), " ", sep=""), "phi") } if (x$struct[2] == "DIAG") vc <- vc[seq_along(gamma2),,drop=FALSE] tmp <- capture.output(print(vc, quote=FALSE, right=right, print.gap=2)) .print.table(tmp, mstyle) } if (is.element(x$struct[2], c("UN","UNR"))) { if (x$struct[2] == "UN") { vc <- cbind(gamma2, gamma, x$h.levels.k, ifelse(x$vc.fix$gamma2, "yes", "no"), x$h.levels.f[[1]]) } else { vc <- cbind(rep(gamma2, length(x$h.levels.k)), rep(gamma, length(x$h.levels.k)), x$h.levels.k, ifelse(rep(x$vc.fix$gamma2,length(x$h.levels.k)), "yes", "no"), x$h.levels.f[[1]]) } colnames(vc) <- c("estim", "sqrt", "k.lvl", "fixed", "level") if (length(x$h.levels.k) == 1L) { rownames(vc) <- c("gamma^2") } else { rownames(vc) <- paste("gamma^2.", seq_along(x$h.levels.k), " ", sep="") } tmp <- capture.output(print(vc, quote=FALSE, right=right, print.gap=2)) .print.table(tmp, mstyle) cat("\n") if (length(x$phi) == 1L) { H <- matrix(NA_real_, nrow=2, ncol=2) } else { H <- matrix(NA_real_, nrow=x$h.nlevels.f[1], ncol=x$h.nlevels.f[1]) } H[lower.tri(H)] <- phi H[upper.tri(H)] <- t(H)[upper.tri(H)] diag(H) <- 1 #H[upper.tri(H)] <- "" if (length(x$phi) == 1L) { H.info <- matrix(NA_real_, nrow=2, ncol=2) } else { H.info <- matrix(NA_real_, nrow=x$h.nlevels.f[1], ncol=x$h.nlevels.f[1]) } H.info[lower.tri(H.info)] <- x$h.levels.comb.k H.info[upper.tri(H.info)] <- t(H.info)[upper.tri(H.info)] H.info[lower.tri(H.info)] <- ifelse(x$vc.fix$phi, "yes", "no") diag(H.info) <- "-" vc <- cbind(H, "", H.info) colnames(vc) <- c(paste("phi.", abbreviate(x$h.levels.f[[1]]), sep=""), "", abbreviate(x$h.levels.f[[1]])) ### FIXME: x$h.levels.f[[1]] may be numeric, in which case a wrapping 'header' is not recognized rownames(vc) <- x$h.levels.f[[1]] tmp <- capture.output(print(vc, quote=FALSE, right=right, print.gap=2)) .print.table(tmp, mstyle) } if (is.element(x$struct[2], c("GEN"))) { vc <- cbind(gamma2, gamma, ifelse(x$vc.fix$gamma2, "yes", "no"), "") colnames(vc) <- c("estim", "sqrt", "fixed", "phi:") rownames(vc) <- x$h.names[-length(x$h.names)] H.info <- fmtx(cov2cor(x$H), digits[["var"]]) diag(H.info) <- "-" H.info[lower.tri(H.info)] <- ifelse(x$vc.fix$phi, "yes", "no") colnames(H.info) <- abbreviate(x$h.names[-length(x$h.names)]) vc <- cbind(vc, H.info) tmp <- capture.output(print(vc, quote=FALSE, right=right, print.gap=2)) .print.table(tmp, mstyle) } if (is.element(x$struct[2], c("GDIAG"))) { vc <- cbind(gamma2, gamma, ifelse(x$vc.fix$gamma2, "yes", "no")) colnames(vc) <- c("estim", "sqrt", "fixed") rownames(vc) <- x$h.names[-length(x$h.names)] tmp <- capture.output(print(vc, quote=FALSE, right=right, print.gap=2)) .print.table(tmp, mstyle) } cat("\n") } } if (!is.na(x$QE)) { if (x$int.only) { cat(mstyle$section("Test for Heterogeneity:")) cat("\n") cat(mstyle$result(fmtt(x$QE, "Q", df=x$QEdf, pval=x$QEp, digits=digits))) } else { cat(mstyle$section("Test for Residual Heterogeneity:")) cat("\n") cat(mstyle$result(fmtt(x$QE, "QE", df=x$QEdf, pval=x$QEp, digits=digits))) } cat("\n\n") } if (inherits(x, "robust.rma")) { cat(mstyle$text("Number of estimates: ")) cat(mstyle$result(x$k)) cat("\n") cat(mstyle$text("Number of clusters: ")) cat(mstyle$result(x$n)) cat("\n") cat(mstyle$text("Estimates per cluster: ")) if (all(x$tcl[1] == x$tcl)) { cat(mstyle$result(x$tcl[1])) } else { cat(mstyle$result(paste0(min(x$tcl), "-", max(x$tcl), " (mean: ", fmtx(mean(x$tcl), digits=2), ", median: ", round(median(x$tcl), digits=2), ")"))) } cat("\n\n") } if (x$p > 1L && !is.na(x$QM)) { cat(mstyle$section(paste0("Test of Moderators (coefficient", ifelse(x$m == 1, " ", "s "), .format.btt(x$btt),"):", ifelse(inherits(x, "robust.rma"), footsym[1], "")))) cat("\n") if (is.element(x$test, c("knha","adhoc","t"))) { cat(mstyle$result(fmtt(x$QM, "F", df1=x$QMdf[1], df2=x$QMdf[2], pval=x$QMp, digits=digits))) } else { cat(mstyle$result(fmtt(x$QM, "QM", df=x$QMdf[1], pval=x$QMp, digits=digits))) } cat("\n\n") } if (is.element(x$test, c("knha","adhoc","t"))) { res.table <- data.frame(estimate=fmtx(c(x$beta), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), tval=fmtx(x$zval, digits[["test"]]), df=round(x$ddf,2), pval=fmtp(x$pval, digits[["pval"]]), ci.lb=fmtx(x$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$ci.ub, digits[["ci"]]), stringsAsFactors=FALSE) if (inherits(x, "robust.rma") && footsym[1] != "") res.table <- .addfootsym(res.table, 2:7, footsym[1]) } else { res.table <- data.frame(estimate=fmtx(c(x$beta), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), zval=fmtx(x$zval, digits[["test"]]), pval=fmtp(x$pval, digits[["pval"]]), ci.lb=fmtx(x$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$ci.ub, digits[["ci"]]), stringsAsFactors=FALSE) } rownames(res.table) <- rownames(x$beta) signif <- symnum(x$pval, corr=FALSE, na=FALSE, cutpoints=c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", "**", "*", ".", " ")) if (signif.stars) { res.table <- cbind(res.table, signif) colnames(res.table)[ncol(res.table)] <- "" } if (.isTRUE(ddd$num)) { width <- nchar(nrow(res.table)) rownames(res.table) <- paste0(formatC(seq_len(nrow(res.table)), format="d", width=width), ") ", rownames(res.table)) } if (x$int.only) res.table <- res.table[1,] cat(mstyle$section("Model Results:")) cat("\n\n") if (x$int.only) { tmp <- capture.output(.print.vector(res.table)) } else { tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE, print.gap=2)) } #tmp[1] <- paste0(tmp[1], "\u200b") .print.table(tmp, mstyle) if (signif.legend || legend) { cat("\n") cat(mstyle$legend("---")) } if (signif.legend) { cat("\n") cat(mstyle$legend("Signif. codes: "), mstyle$legend(attr(signif, "legend"))) cat("\n") } if (inherits(x, "robust.rma") && legend) { cat("\n") cat(mstyle$legend(paste0(footsym[2], " results based on cluster-robust inference (var-cov estimator: ", x$vbest))) if (x$robumethod == "default") { cat(mstyle$legend(",")) cat("\n") cat(mstyle$legend(paste0(" approx ", ifelse(x$int.only, "t-test and confidence interval", "t/F-tests and confidence intervals"), ", df: residual method)"))) } else { if (x$coef_test == "Satterthwaite" && x$conf_test == "Satterthwaite" && x$wald_test == "HTZ") { cat(mstyle$legend(",")) cat("\n") cat(mstyle$legend(paste0(" approx ", ifelse(x$int.only, "t-test and confidence interval", "t/F-tests and confidence intervals"), ", df: Satterthwaite approx)"))) } else { cat(mstyle$legend(")")) } } cat("\n") } .space() invisible() } metafor/R/print.rma.glmm.r0000644000176200001440000001601614503332423015143 0ustar liggesusersprint.rma.glmm <- function(x, digits, showfit=FALSE, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.glmm") if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } ddd <- list(...) .chkdots(ddd, c("num")) .space() if (is.element(x$method, c("FE","EE","CE"))) { if (x$int.only) { cat(mstyle$section(sapply(x$method, switch, "FE"="Fixed-Effects Model", "EE"="Equal-Effects Model", "CE"="Common-Effects Model", USE.NAMES=FALSE))) } else { cat(mstyle$section("Fixed-Effects with Moderators Model")) } cat(mstyle$section(paste0(" (k = ", x$k, ")"))) } else { if (x$int.only) { cat(mstyle$section("Random-Effects Model")) } else { cat(mstyle$section("Mixed-Effects Model")) } cat(mstyle$section(paste0(" (k = ", x$k, "; "))) cat(mstyle$section(paste0("tau^2 estimator: ", x$method, ")"))) } if (is.element(x$measure, c("OR","IRR"))) { cat("\n") if (x$model == "UM.FS") cat(mstyle$section("Model Type: Unconditional Model with Fixed Study Effects")) if (x$model == "UM.RS") cat(mstyle$section("Model Type: Unconditional Model with Random Study Effects")) if (x$model == "CM.AL") cat(mstyle$section("Model Type: Conditional Model with Approximate Likelihood")) if (x$model == "CM.EL") cat(mstyle$section("Model Type: Conditional Model with Exact Likelihood")) } if (showfit) { cat("\n") fs <- fmtx(x$fit.stats$ML, digits[["fit"]]) names(fs) <- c("logLik", "deviance", "AIC", "BIC", "AICc") cat("\n") tmp <- capture.output(print(fs, quote=FALSE, print.gap=2)) #tmp[1] <- paste0(tmp[1], "\u200b") .print.table(tmp, mstyle) cat("\n") } else { cat("\n\n") } if (!is.element(x$method, c("FE","EE","CE"))) { if (x$int.only) { cat(mstyle$text("tau^2 (estimated amount of total heterogeneity): ")) cat(mstyle$result(paste0(fmtx(x$tau2, digits[["var"]], thresh=.Machine$double.eps*10), ifelse(is.na(x$se.tau2), "", paste0(" (SE = " , fmtx(x$se.tau2, digits[["sevar"]]), ")"))))) cat("\n") cat(mstyle$text("tau (square root of estimated tau^2 value): ")) cat(mstyle$result(fmtx(.sqrt(x$tau2), digits[["var"]], thresh=.Machine$double.eps*10))) cat("\n") cat(mstyle$text("I^2 (total heterogeneity / total variability): ")) cat(mstyle$result(paste0(fmtx(x$I2, 2), "%"))) cat("\n") cat(mstyle$text("H^2 (total variability / sampling variability): ")) cat(mstyle$result(fmtx(x$H2, 2))) } else { cat(mstyle$text("tau^2 (estimated amount of residual heterogeneity): ")) cat(mstyle$result(paste0(fmtx(x$tau2, digits[["var"]], thresh=.Machine$double.eps*10), ifelse(is.na(x$se.tau2), "", paste0(" (SE = " , fmtx(x$se.tau2, digits[["sevar"]]), ")"))))) cat("\n") cat(mstyle$text("tau (square root of estimated tau^2 value): ")) cat(mstyle$result(fmtx(.sqrt(x$tau2), digits[["var"]], thresh=.Machine$double.eps*10))) cat("\n") cat(mstyle$text("I^2 (residual heterogeneity / unaccounted variability): ")) cat(mstyle$result(paste0(fmtx(x$I2, 2), "%"))) cat("\n") cat(mstyle$text("H^2 (unaccounted variability / sampling variability): ")) cat(mstyle$result(fmtx(x$H2, 2))) } cat("\n\n") } if (!is.na(x$sigma2)) { cat(mstyle$text("sigma^2 (estimated amount of study level variability): ")) cat(mstyle$result(fmtx(x$sigma2, digits[["var"]], thresh=.Machine$double.eps*10))) cat("\n") cat(mstyle$text("sigma (square root of estimated sigma^2 value): ")) cat(mstyle$result(fmtx(.sqrt(x$sigma2), digits[["var"]], thresh=.Machine$double.eps*10))) cat("\n\n") } if (!is.na(x$QE.Wld) || !is.na(x$QE.LRT)) { QE.Wld <- fmtx(x$QE.Wld, digits[["test"]]) QE.LRT <- fmtx(x$QE.LRT, digits[["test"]]) nchar.Wld <- nchar(QE.Wld, keepNA=FALSE) nchar.LRT <- nchar(QE.LRT, keepNA=FALSE) if (nchar.Wld > nchar.LRT) QE.LRT <- paste0(paste(rep(" ", nchar.Wld - nchar.LRT), collapse=""), QE.LRT) if (nchar.LRT > nchar.Wld) QE.Wld <- paste0(paste(rep(" ", nchar.LRT - nchar.Wld), collapse=""), QE.Wld) if (x$int.only) { cat(mstyle$section("Tests for Heterogeneity:")) } else { cat(mstyle$section("Tests for Residual Heterogeneity:")) } cat("\n") cat(mstyle$result(fmtt(x$QE.Wld, "Wld", df=x$QE.df, pval=x$QEp.Wld, digits=digits))) cat("\n") cat(mstyle$result(fmtt(x$QE.LRT, "LRT", df=x$QE.df, pval=x$QEp.LRT, digits=digits))) cat("\n\n") } if (x$p > 1L && !is.na(x$QM)) { cat(mstyle$section(paste0("Test of Moderators (coefficient", ifelse(x$m == 1, " ", "s "), .format.btt(x$btt),"):"))) cat("\n") if (is.element(x$test, c("knha","adhoc","t"))) { cat(mstyle$result(fmtt(x$QM, "F", df1=x$QMdf[1], df2=x$QMdf[2], pval=x$QMp, digits=digits))) } else { cat(mstyle$result(fmtt(x$QM, "QM", df=x$QMdf[1], pval=x$QMp, digits=digits))) } cat("\n\n") } if (is.element(x$test, c("knha","adhoc","t"))) { res.table <- data.frame(estimate=fmtx(c(x$beta), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), tval=fmtx(x$zval, digits[["test"]]), df=round(x$ddf,2), pval=fmtp(x$pval, digits[["pval"]]), ci.lb=fmtx(x$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$ci.ub, digits[["ci"]]), stringsAsFactors=FALSE) } else { res.table <- data.frame(estimate=fmtx(c(x$beta), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), zval=fmtx(x$zval, digits[["test"]]), pval=fmtp(x$pval, digits[["pval"]]), ci.lb=fmtx(x$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$ci.ub, digits[["ci"]]), stringsAsFactors=FALSE) } rownames(res.table) <- rownames(x$beta) signif <- symnum(x$pval, corr=FALSE, na=FALSE, cutpoints=c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", "**", "*", ".", " ")) if (signif.stars) { res.table <- cbind(res.table, signif) colnames(res.table)[ncol(res.table)] <- "" } if (.isTRUE(ddd$num)) { width <- nchar(nrow(res.table)) rownames(res.table) <- paste0(formatC(seq_len(nrow(res.table)), format="d", width=width), ") ", rownames(res.table)) } if (x$int.only) res.table <- res.table[1,] cat(mstyle$section("Model Results:")) cat("\n\n") if (x$int.only) { tmp <- capture.output(.print.vector(res.table)) } else { tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE, print.gap=2)) } #tmp[1] <- paste0(tmp[1], "\u200b") .print.table(tmp, mstyle) if (signif.legend) { cat("\n") cat(mstyle$legend("---")) cat("\n") cat(mstyle$legend("Signif. codes: "), mstyle$legend(attr(signif, "legend"))) cat("\n") } .space() invisible() } metafor/R/print.matreg.r0000644000176200001440000000332214305043412014701 0ustar liggesusersprint.matreg <- function(x, digits=x$digits, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="matreg") if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } .space() if (x$test == "t") { res.table <- data.frame(estimate=fmtx(c(x$tab$beta), digits[["est"]]), se=fmtx(x$tab$se, digits[["se"]]), tval=fmtx(x$tab$tval, digits[["test"]]), df=round(x$tab$df,2), pval=fmtp(x$tab$pval, digits[["pval"]]), ci.lb=fmtx(x$tab$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$tab$ci.ub, digits[["ci"]]), stringsAsFactors=FALSE) } else { res.table <- data.frame(estimate=fmtx(c(x$tab$beta), digits[["est"]]), se=fmtx(x$tab$se, digits[["se"]]), zval=fmtx(x$tab$zval, digits[["test"]]), pval=fmtp(x$tab$pval, digits[["pval"]]), ci.lb=fmtx(x$tab$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$tab$ci.ub, digits[["ci"]]), stringsAsFactors=FALSE) } rownames(res.table) <- rownames(x$tab) signif <- symnum(x$tab$pval, corr=FALSE, na=FALSE, cutpoints=c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", "**", "*", ".", " ")) if (signif.stars) { res.table <- cbind(res.table, signif) colnames(res.table)[ncol(res.table)] <- "" } tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE, print.gap=2)) #tmp[1] <- paste0(tmp[1], "\u200b") .print.table(tmp, mstyle) if (signif.legend) { cat("\n") cat(mstyle$legend("---")) cat("\n") cat(mstyle$legend("Signif. codes: "), mstyle$legend(attr(signif, "legend"))) cat("\n") } .space() invisible() } metafor/R/misc.func.hidden.mv.r0000644000176200001440000015352214476642304016055 0ustar liggesusers############################################################################ ### function to test for missings in a var-cov matrix .anyNAv <- function(x) { k <- nrow(x) not.na <- not.na.diag <- !is.na(diag(x)) for (i in seq_len(k)[not.na.diag]) { not.na[i] <- !anyNA(x[i, seq_len(k)[not.na.diag]]) } return(!not.na) } ### function to test each row for any missings in the lower triangular part of a matrix #.anyNAv <- function(x) # return(sapply(seq_len(nrow(x)), FUN=function(i) anyNA(x[i,seq_len(i)]))) ### function above is faster (and does not require making a copy of the object) #.anyNAv <- function(X) { # X[upper.tri(X)] <- 0 # return(apply(is.na(X), 1, any)) #} ############################################################################ ### function to check vccon elements .chkvccon <- function(ids, vcvals) { # get name of vcvals vcname <- as.character(match.call()[[3]]) if (is.null(ids) || is.null(vcvals)) return(vcvals) if (length(ids) != length(vcvals)) { mstyle <- .get.mstyle("crayon" %in% .packages()) stop(mstyle$stop(paste0("Length of 'vccon$", vcname, "' (", length(ids), ") does not match length of ", vcname, " (", length(vcvals), ").")), call.=FALSE) } for (id in unique(ids)) vcvals[ids == id] <- mean(vcvals[ids == id], na.rm=TRUE) # if all elements are NA, then the mean will be NaN, so fix this back to NA vcvals[is.nan(vcvals)] <- NA_real_ return(vcvals) } ############################################################################ .process.G.aftersub <- function(mf.g, struct, formula, tau2, rho, isG, k, sparse, verbose) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (verbose > 1) message(mstyle$message(paste0("Processing '", paste0(formula, collapse=""), "' term (#1) ..."))) ### number of variables in model frame nvars <- ncol(mf.g) ### check that the number of variables is correct for the chosen structure if (is.element(struct, c("CS","HCS","UN","UNR","AR","HAR","CAR","ID","DIAG","PHYBM","PHYPL","PHYPD")) && sum(sapply(mf.g, NCOL)) != 2) stop(mstyle$stop(paste0("Only a single inner variable allowed for an '~ inner | outer' term when 'struct=\"", struct, "\"'.")), call.=FALSE) # note: need to use sum(sapply(mf.g, NCOL)) above because when 'random = ~ X | study' (and X is a matrix with 2+ columns), nvars will still be 2 for (unless struct="GEN") ### get variables names in mf.g g.names <- names(mf.g) ### names for inner and outer factors/variables ### check that inner variable is a factor (or character variable) for structures that require this (no longer required) #if (is.element(struct, c("CS","HCS","UN","UNR","ID","DIAG")) && !is.factor(mf.g[[1]]) && !is.character(mf.g[[1]])) # stop(mstyle$stop(paste0("Inner variable in '~ inner | outer' term must be a factor or character variable when 'struct=\"", struct, "\"'.")), call.=FALSE) ### for struct="CAR", check that inner term is numeric and get the unique numeric values if (is.element(struct, c("CAR"))) { if (!is.numeric(mf.g[[1]])) stop(mstyle$stop("Inner variable in '~ inner | outer' term must be numeric for 'struct=\"CAR\"'."), call.=FALSE) g.values <- sort(unique(round(mf.g[[1]], digits=8L))) # aweful hack to avoid floating points issues } else { g.values <- NULL } ### turn each variable in mf.g into a factor (not for SP/PHY structures or GEN) ### if a variable was a factor to begin with, this drops any unused levels, but order of existing levels is preserved if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { mf.g <- data.frame(mf.g[-nvars], outer=factor(mf.g[[nvars]])) } else { mf.g <- data.frame(inner=factor(mf.g[[1]]), outer=factor(mf.g[[2]])) } ### check if there are any NAs anywhere in mf.g if (anyNA(mf.g)) stop(mstyle$stop("No NAs allowed in variables specified via the 'random' argument."), call.=FALSE) ### get number of levels of each variable in mf.g (vector with two values, for the inner and outer factor) #g.nlevels <- c(nlevels(mf.g[[1]]), nlevels(mf.g[[2]])) ### works only for factors if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { g.nlevels <- c(length(unique(apply(mf.g[-nvars], 1, paste, collapse=" + "))), length(unique(mf.g[[nvars]]))) } else { g.nlevels <- c(length(unique(mf.g[[1]])), length(unique(mf.g[[2]]))) } ### get levels of each variable in mf.g #g.levels <- list(levels(mf.g[[1]]), levels(mf.g[[2]])) ### works only for factors if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { g.levels <- list(sort(unique(apply(mf.g[-nvars], 1, paste, collapse=" + "))), sort(unique((mf.g[[nvars]])))) } else { #g.levels <- list(sort(unique(as.character(mf.g[[1]]))), sort(unique(as.character(mf.g[[2]])))) g.levels <- list(as.character(sort(unique(mf.g[[1]]))), as.character(sort(unique(mf.g[[2]])))) } ### determine appropriate number of tau2 and rho values (note: this is done *after* subsetting) ### note: if g.nlevels[1] is 1, then technically there is no correlation, but we still need one ### rho for the optimization function (this rho is fixed to 0 further in the rma.mv() function) if (is.element(struct, c("CS","ID","AR","CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) { tau2s <- 1 rhos <- 1 } if (is.element(struct, c("HCS","DIAG","HAR"))) { tau2s <- g.nlevels[1] rhos <- 1 } if (struct == "UN") { tau2s <- g.nlevels[1] rhos <- ifelse(g.nlevels[1] > 1, g.nlevels[1]*(g.nlevels[1]-1)/2, 1) } if (struct == "UNR") { tau2s <- 1 rhos <- ifelse(g.nlevels[1] > 1, g.nlevels[1]*(g.nlevels[1]-1)/2, 1) } if (struct == "GEN") { p <- nvars - 1 tau2s <- p rhos <- ifelse(p > 1, p*(p-1)/2, 1) } if (struct == "GDIAG") { p <- nvars - 1 tau2s <- p rhos <- 1 } ### set default value(s) for tau2 if it is unspecified if (is.null(tau2)) tau2 <- rep(NA_real_, tau2s) ### set default value(s) for rho argument if it is unspecified if (is.null(rho)) rho <- rep(NA_real_, rhos) ### allow quickly setting all tau2 values to a fixed value if (length(tau2) == 1L) tau2 <- rep(tau2, tau2s) ### allow quickly setting all rho values to a fixed value if (length(rho) == 1L) rho <- rep(rho, rhos) ### check if tau2 and rho are of correct length if (length(tau2) != tau2s) stop(mstyle$stop(paste0("Length of ", ifelse(isG, 'tau2', 'gamma2'), " argument (", length(tau2), ") does not match actual number of variance components (", tau2s, ").")), call.=FALSE) if (length(rho) != rhos) stop(mstyle$stop(paste0("Length of ", ifelse(isG, 'rho', 'phi'), " argument (", length(rho), ") does not match actual number of correlations (", rhos, ").")), call.=FALSE) ### checks on any fixed values of tau2 and rho arguments if (any(tau2 < 0, na.rm=TRUE)) stop(mstyle$stop(paste0("Specified value(s) of ", ifelse(isG, 'tau2', 'gamma2'), " must be >= 0.")), call.=FALSE) if (is.element(struct, c("CAR")) && any(rho > 1 | rho < 0, na.rm=TRUE)) stop(mstyle$stop(paste0("Specified value(s) of ", ifelse(isG, 'rho', 'phi'), " must be in [0,1].")), call.=FALSE) if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYPL","PHYPD")) && any(rho < 0, na.rm=TRUE)) stop(mstyle$stop(paste0("Specified value(s) of ", ifelse(isG, 'rho', 'phi'), " must be >= 0.")), call.=FALSE) if (!is.element(struct, c("CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD")) && any(rho > 1 | rho < -1, na.rm=TRUE)) stop(mstyle$stop(paste0("Specified value(s) of ", ifelse(isG, 'rho', 'phi'), " must be in [-1,1].")), call.=FALSE) ### create model matrix for inner and outer factors of mf.g if (is.element(struct, c("CS","HCS","UN","UNR","AR","HAR","CAR","ID","DIAG"))) { if (g.nlevels[1] == 1) { Z.G1 <- cbind(rep(1,k)) } else { if (sparse) { Z.G1 <- sparse.model.matrix(~ mf.g[[1]] - 1) } else { Z.G1 <- model.matrix(~ mf.g[[1]] - 1) } } } if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) { if (sparse) { Z.G1 <- Diagonal(k) } else { Z.G1 <- diag(1, nrow=k, ncol=k) } } if (is.element(struct, c("GEN","GDIAG"))) { if (sparse) { Z.G1 <- Matrix(as.matrix(mf.g[-nvars]), sparse=TRUE) } else { Z.G1 <- as.matrix(mf.g[-nvars]) } } if (g.nlevels[2] == 1) { Z.G2 <- cbind(rep(1,k)) } else { if (sparse) { Z.G2 <- sparse.model.matrix(~ mf.g[[nvars]] - 1) } else { Z.G2 <- model.matrix(~ mf.g[[nvars]] - 1) } } attr(Z.G1, "assign") <- NULL attr(Z.G1, "contrasts") <- NULL attr(Z.G2, "assign") <- NULL attr(Z.G2, "contrasts") <- NULL return(list(mf.g=mf.g, g.names=g.names, g.nlevels=g.nlevels, g.levels=g.levels, g.values=g.values, tau2s=tau2s, rhos=rhos, tau2=tau2, rho=rho, Z.G1=Z.G1, Z.G2=Z.G2)) } ############################################################################ .process.G.afterrmna <- function(mf.g, g.nlevels, g.levels, g.values, struct, formula, tau2, rho, Z.G1, Z.G2, isG, sparse, distspec, verbose) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (verbose > 1) message(mstyle$message(paste0("Processing '", paste0(formula, collapse=""), "' term (#2) ..."))) ### number of variables in model frame nvars <- ncol(mf.g) ### copy g.nlevels and g.levels g.nlevels.f <- g.nlevels g.levels.f <- g.levels ### redo: turn each variable in mf.g into a factor (not for SP structures or GEN) ### (reevaluates the levels present, but order of existing levels is preserved) if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { mf.g <- data.frame(mf.g[-nvars], outer=factor(mf.g[[nvars]])) } else { mf.g <- data.frame(inner=factor(mf.g[[1]]), outer=factor(mf.g[[2]])) } ### redo: get number of levels of each variable in mf.g (vector with two values, for the inner and outer factor) #g.nlevels <- c(nlevels(mf.g[[1]]), nlevels(mf.g[[2]])) ### works only for factors if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { g.nlevels <- c(length(unique(apply(mf.g[-nvars], 1, paste, collapse=" + "))), length(unique(mf.g[[nvars]]))) } else { g.nlevels <- c(length(unique(mf.g[[1]])), length(unique(mf.g[[2]]))) } ### redo: get levels of each variable in mf.g #g.levels <- list(levels(mf.g[[1]]), levels(mf.g[[2]])) ### works only for factors if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { g.levels <- list(sort(unique(apply(mf.g[-nvars], 1, paste, collapse=" + "))), sort(unique((mf.g[[nvars]])))) } else { #g.levels <- list(sort(unique(as.character(mf.g[[1]]))), sort(unique(as.character(mf.g[[2]])))) g.levels <- list(as.character(sort(unique(mf.g[[1]]))), as.character(sort(unique(mf.g[[2]])))) } ### determine which levels of the inner factor were removed g.levels.r <- !is.element(g.levels.f[[1]], g.levels[[1]]) ### warn if any levels were removed (not for "AR","CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","GEN","GDIAG") if (any(g.levels.r) && !is.element(struct, c("AR","CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","GEN","GDIAG"))) warning(mstyle$warning(paste0("One or more levels of inner factor (i.e., ", paste(g.levels.f[[1]][g.levels.r], collapse=", "), ") removed due to NAs.")), call.=FALSE) ### for "ID", "DIAG", and "GDIAG", fix rho to 0 if (is.element(struct, c("ID","DIAG","GDIAG"))) rho <- 0 ### if there is only a single arm for "CS","HCS","AR","HAR","CAR" (either to begin with or after removing NAs), then fix rho to 0 if (g.nlevels[1] == 1 && is.element(struct, c("CS","HCS","AR","HAR","CAR")) && is.na(rho)) { rho <- 0 warning(mstyle$warning(paste0("Inner factor has only a single level, so fixed value of ", ifelse(isG, 'rho', 'phi'), " to 0.")), call.=FALSE) } ### if there is only a single arm for SP/PHY structures or GEN/GDIAG (either to begin with or after removing NAs), cannot fit model if (g.nlevels[1] == 1 && is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) stop(mstyle$stop("Cannot fit model since inner term only has a single level."), call.=FALSE) ### k per level of the inner factor if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { g.levels.k <- table(factor(apply(mf.g[-nvars], 1, paste, collapse=" + "), levels=g.levels.f[[1]])) } else { g.levels.k <- table(factor(mf.g[[1]], levels=g.levels.f[[1]])) } ### for "HCS","UN","DIAG","HAR": if a particular level of the inner factor only occurs once, then set corresponding tau2 value to 0 (if not already fixed) ### note: no longer done; variance component should still be (weakly) identifiable #if (is.element(struct, c("HCS","UN","DIAG","HAR"))) { # if (any(is.na(tau2) & g.levels.k == 1)) { # tau2[is.na(tau2) & g.levels.k == 1] <- 0 # warning(mstyle$warning("Inner factor has k=1 for one or more levels. Corresponding 'tau2' value(s) fixed to 0."), call.=FALSE) # } #} ### check if each study has only a single arm (could be different arms!) ### for "CS","HCS","AR","HAR","CAR" must then fix rho to 0 (if not already fixed) ### for SP/PHY structures cannot fit model; for GEN rho may still be (weakly) identifiable if (g.nlevels[2] == nrow(mf.g)) { if (is.element(struct, c("CS","HCS","AR","HAR","CAR")) && is.na(rho)) { rho <- 0 warning(mstyle$warning(paste0("Each level of the outer factor contains only a single level of the inner factor, so fixed value of ", ifelse(isG, 'rho', 'phi'), " to 0.")), call.=FALSE) } if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) stop(mstyle$stop("Cannot fit model since each level of the outer factor contains only a single level of the inner term."), call.=FALSE) } g.levels.comb.k <- NULL if (!is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { ### create matrix where each row (= study) indicates how often each arm occurred ### then turn this into a list (with each element equal to a row (= study)) g.levels.comb.k <- crossprod(Z.G2, Z.G1) g.levels.comb.k <- split(g.levels.comb.k, seq_len(nrow(g.levels.comb.k))) ### create matrix for each element (= study) that indicates which combinations occurred ### sum up all matrices (numbers indicate in how many studies each combination occurred) ### take upper triangle part that corresponds to the arm combinations (in order of rho) g.levels.comb.k <- lapply(g.levels.comb.k, function(x) outer(x,x, FUN="&")) g.levels.comb.k <- Reduce("+", g.levels.comb.k) g.levels.comb.k <- g.levels.comb.k[lower.tri(g.levels.comb.k)] ### UN/UNR: if a particular combination of arms never occurs in any of the studies, then must fix the corresponding rho to 0 (if not already fixed) ### this also takes care of the case where each study has only a single arm if (is.element(struct, c("UN","UNR")) && any(g.levels.comb.k == 0 & is.na(rho))) { rho[g.levels.comb.k == 0] <- 0 warning(mstyle$warning(paste0("Some combinations of the levels of the inner factor never occurred. Corresponding ", ifelse(isG, 'rho', 'phi'), " value(s) fixed to 0.")), call.=FALSE) } ### if there was only a single arm for "UN" or "UNR" to begin with, then fix rho to 0 ### (technically there is then no rho at all to begin with, but rhos was still set to 1 earlier for the optimization routine) ### (if there is a single arm after removing NAs, then this is dealt with below by setting tau2 and rho values to 0) if (is.element(struct, c("UN","UNR")) && g.nlevels.f[1] == 1 && is.na(rho)) { rho <- 0 warning(mstyle$warning(paste0("Inner factor has only a single level, so fixed value of ", ifelse(isG, 'rho', 'phi'), " to 0.")), call.=FALSE) } } ### construct G matrix for the various structures if (struct == "CS") { G <- matrix(rho*tau2, nrow=g.nlevels.f[1], ncol=g.nlevels.f[1]) diag(G) <- tau2 } if (struct == "HCS") { G <- matrix(rho, nrow=g.nlevels.f[1], ncol=g.nlevels.f[1]) diag(G) <- 1 G <- diag(sqrt(tau2), nrow=g.nlevels.f[1], ncol=g.nlevels.f[1]) %*% G %*% diag(sqrt(tau2), nrow=g.nlevels.f[1], ncol=g.nlevels.f[1]) diag(G) <- tau2 } if (is.element(struct, c("UN","GEN"))) { G <- .con.vcov.UN(tau2, rho) } if (struct == "UNR") { G <- .con.vcov.UNR(tau2, rho) } if (is.element(struct, c("GDIAG"))) { G <- diag(tau2, nrow=length(tau2), ncol=length(tau2)) } if (is.element(struct, c("ID","DIAG"))) { G <- diag(tau2, nrow=g.nlevels.f[1], ncol=g.nlevels.f[1]) } if (struct == "AR") { if (is.na(rho)) { G <- matrix(NA_real_, nrow=g.nlevels.f[1], ncol=g.nlevels.f[1]) } else { ### is g.nlevels.f[1] == 1 even possible here? if (g.nlevels.f[1] > 1) { G <- toeplitz(ARMAacf(ar=rho, lag.max=g.nlevels.f[1]-1)) } else { G <- diag(1) } } G <- diag(sqrt(rep(tau2, g.nlevels.f[1])), nrow=g.nlevels.f[1], ncol=g.nlevels.f[1]) %*% G %*% diag(sqrt(rep(tau2, g.nlevels.f[1])), nrow=g.nlevels.f[1], ncol=g.nlevels.f[1]) diag(G) <- tau2 } if (struct == "HAR") { if (is.na(rho)) { G <- matrix(NA_real_, nrow=g.nlevels.f[1], ncol=g.nlevels.f[1]) } else { ### is g.nlevels.f[1] == 1 even possible here? if (g.nlevels.f[1] > 1) { G <- toeplitz(ARMAacf(ar=rho, lag.max=g.nlevels.f[1]-1)) } else { G <- diag(1) } } G <- diag(sqrt(tau2), nrow=g.nlevels.f[1], ncol=g.nlevels.f[1]) %*% G %*% diag(sqrt(tau2), nrow=g.nlevels.f[1], ncol=g.nlevels.f[1]) diag(G) <- tau2 } if (struct == "CAR") { if (is.na(rho)) { G <- matrix(NA_real_, nrow=g.nlevels.f[1], ncol=g.nlevels.f[1]) } else { ### is g.nlevels.f[1] == 1 even possible here? if (g.nlevels.f[1] > 1) { G <- outer(g.values, g.values, function(x,y) rho^(abs(x-y))) } else { G <- diag(1) } } G <- diag(sqrt(rep(tau2, g.nlevels.f[1])), nrow=g.nlevels.f[1], ncol=g.nlevels.f[1]) %*% G %*% diag(sqrt(rep(tau2, g.nlevels.f[1])), nrow=g.nlevels.f[1], ncol=g.nlevels.f[1]) diag(G) <- tau2 } if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) { ### remove the '| outer' part from the formula and add '- 1' formula <- as.formula(paste0(strsplit(paste0(formula, collapse=""), "|", fixed=TRUE)[[1]][1], "- 1", collapse="")) ### create distance matrix if (.is.matrix(distspec)) { if (anyNA(distspec)) stop(mstyle$stop("No missing values allowed in matrices specified via 'dist'."), call.=FALSE) if (!.is.square(distspec)) stop(mstyle$stop("Distance matrices specified via 'dist' must be square matrices."), call.=FALSE) if (!isSymmetric(unname(distspec))) stop(mstyle$stop("Distance matrices specified via 'dist' must be symmetric matrices."), call.=FALSE) if (is.null(rownames(distspec))) rownames(distspec) <- colnames(distspec) if (is.null(colnames(distspec))) colnames(distspec) <- rownames(distspec) if (length(colnames(distspec)) != length(unique(colnames(distspec)))) stop(mstyle$stop("Distance matrices specified via 'dist' must have unique dimension names."), call.=FALSE) if (any(!is.element(as.character(mf.g[[1]]), colnames(distspec)))) stop(mstyle$stop(paste0("There are levels in '", colnames(mf.g)[1], "' for which there are no matching rows/columns in the corresponding 'dist' matrix.")), call.=FALSE) if (is.element(struct, c("PHYBM","PHYPL","PHYPD")) && !all.equal(min(distspec), 0)) warning(mstyle$warning("Minimum value in the distance matrix is not 0."), call.=FALSE) if (is.element(struct, c("PHYBM","PHYPL","PHYPD")) && !all.equal(max(distspec), 2)) warning(mstyle$warning("Maximum value in the distance matrix is not 2."), call.=FALSE) Dmat <- distspec[as.character(mf.g[[1]]), as.character(mf.g[[1]])] } else { if (is.element(struct, c("PHYBM","PHYPL","PHYPD"))) stop(mstyle$stop("Must supply distance matrix via 'dist' for phylogenetic correlation structures."), call.=FALSE) Cmat <- model.matrix(formula, data=mf.g[-nvars]) if (is.function(distspec)) { Dmat <- distspec(Cmat) } else { if (is.element(distspec, c("euclidean", "maximum", "manhattan"))) Dmat <- as.matrix(dist(Cmat, method=distspec)) if (distspec == "gcd") Dmat <- sp::spDists(Cmat, longlat=TRUE) } } if (sparse) Dmat <- Matrix(Dmat, sparse=TRUE) } else { Dmat <- NULL } if (struct == "SPEXP") { Rmat <- exp(-Dmat/rho) G <- tau2 * Rmat * tcrossprod(Z.G2) } if (struct == "SPGAU") { Rmat <- exp(-Dmat^2/rho^2) G <- tau2 * Rmat * tcrossprod(Z.G2) } if (struct == "SPLIN") { Rmat <- (1 - Dmat/rho) * I(Dmat < rho) G <- tau2 * Rmat * tcrossprod(Z.G2) } if (struct == "SPRAT") { Rmat <- 1 - (Dmat/rho)^2 / (1 + (Dmat/rho)^2) G <- tau2 * Rmat * tcrossprod(Z.G2) } if (struct == "SPSPH") { Rmat <- (1 - 3/2*Dmat/rho + 1/2*(Dmat/rho)^3) * I(Dmat < rho) G <- tau2 * Rmat * tcrossprod(Z.G2) } if (struct == "PHYBM") { rho <- max(Dmat) Rmat <- 1 - Dmat/rho G <- tau2 * Rmat * tcrossprod(Z.G2) } if (struct == "PHYPL") { Rmat <- rho * (1 - Dmat/max(Dmat)) diag(Rmat) <- 1 Rmat[Dmat == 0] <- 1 G <- tau2 * Rmat * tcrossprod(Z.G2) } if (struct == "PHYPD") { Rmat <- 1 - Dmat/max(Dmat) G <- tau2 * Rmat^rho * tcrossprod(Z.G2) } ### for spatial and phylogeny structures, compute a much more sensible initial value for rho if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) { if (struct == "PHYBM") rho.init <- max(Dmat) if (struct == "PHYPL") rho.init <- 0.5 if (struct == "PHYPD") rho.init <- 1 if (!is.element(struct, c("PHYBM","PHYPL","PHYPD"))) rho.init <- unname(suppressMessages(quantile(Dmat[lower.tri(Dmat)], 0.25))) # suppressMessages() to avoid '[ ] : .M.sub.i.logical() maybe inefficient' messages when sparse=TRUE } else { rho.init <- NULL } ### for "CS","AR","CAR","ID" set tau2 value to 0 for any levels that were removed if (any(g.levels.r) && is.element(struct, c("CS","AR","CAR","ID"))) { G[g.levels.r,] <- 0 G[,g.levels.r] <- 0 } ### for "HCS","HAR","DIAG" set tau2 value(s) to 0 for any levels that were removed if (any(g.levels.r) && is.element(struct, c("HCS","HAR","DIAG"))) { G[g.levels.r,] <- 0 G[,g.levels.r] <- 0 tau2[g.levels.r] <- 0 warning(mstyle$warning(paste0("Fixed ", ifelse(isG, 'tau2', 'gamma2'), " to 0 for removed level(s).")), call.=FALSE) } ### for "UN", set tau2 value(s) and corresponding rho(s) to 0 for any levels that were removed if (any(g.levels.r) && struct == "UN") { G[g.levels.r,] <- 0 G[,g.levels.r] <- 0 tau2[g.levels.r] <- 0 rho <- G[lower.tri(G)] warning(mstyle$warning(paste0("Fixed ", ifelse(isG, 'tau2', 'gamma2'), " and corresponding ", ifelse(isG, 'rho', 'phi'), " value(s) to 0 for removed level(s).")), call.=FALSE) } ### for "UNR", set rho(s) to 0 corresponding to any levels that were removed if (any(g.levels.r) && struct == "UNR") { G[g.levels.r,] <- 0 G[,g.levels.r] <- 0 diag(G) <- tau2 ### don't really need this rho <- G[lower.tri(G)] warning(mstyle$warning(paste0("Fixed ", ifelse(isG, 'rho', 'phi'), " value(s) to 0 for removed level(s).")), call.=FALSE) } ### special handling for the bivariate model: ### if tau2 (for "CS","AR","CAR","UNR") or either tau2.1 or tau2.2 (for "HCS","UN","HAR") is fixed to 0, then rho must be fixed to 0 if (g.nlevels.f[1] == 2) { if (is.element(struct, c("CS","AR","CAR","UNR")) && !is.na(tau2) && tau2 == 0) rho <- 0 if (is.element(struct, c("HCS","UN","HAR")) && ((!is.na(tau2[1]) && tau2[1] == 0) || (!is.na(tau2[2]) && tau2[2] == 0))) rho <- 0 } return(list(mf.g=mf.g, g.nlevels=g.nlevels, g.nlevels.f=g.nlevels.f, g.levels=g.levels, g.levels.f=g.levels.f, g.levels.r=g.levels.r, g.levels.k=g.levels.k, g.levels.comb.k=g.levels.comb.k, tau2=tau2, rho=rho, G=G, Dmat=Dmat, rho.init=rho.init)) } ############################################################################ ### function to construct var-cov matrix for "UN" and "GEN" structures given vector of variances and correlations .con.vcov.UN <- function(vars, cors, vccov=FALSE) { dims <- length(vars) if (vccov) { G <- matrix(0, nrow=dims, ncol=dims) G[lower.tri(G)] <- cors G[upper.tri(G)] <- t(G)[upper.tri(G)] diag(G) <- vars return(G) } else { R <- matrix(1, nrow=dims, ncol=dims) R[lower.tri(R)] <- cors R[upper.tri(R)] <- t(R)[upper.tri(R)] S <- diag(sqrt(vars), nrow=dims, ncol=dims) return(S %*% R %*% S) } } ### function to construct var-cov matrix for "UN" and "GEN" structures given vector of 'choled' variances and covariances .con.vcov.UN.chol <- function(vars, covs) { dims <- length(vars) G <- matrix(0, nrow=dims, ncol=dims) G[lower.tri(G)] <- covs diag(G) <- vars return(tcrossprod(G)) } ### function to construct var-cov matrix for "UNR" structure given the variance and correlations .con.vcov.UNR <- function(var, cors) { dims <- round((1 + sqrt(1 + 8*length(cors)))/2) G <- matrix(1, nrow=dims, ncol=dims) G[lower.tri(G)] <- cors G[upper.tri(G)] <- t(G)[upper.tri(G)] return(var * G) } ### function to construct var-cov matrix for "UNR" structure given the variance and vector of 'choled' correlations .con.vcov.UNR.chol <- function(var, cors) { dims <- round((1 + sqrt(1 + 8*length(cors)))/2) G <- matrix(0, nrow=dims, ncol=dims) G[lower.tri(G)] <- cors diag(G) <- 1 return(var * tcrossprod(G)) } ############################################################################ ### function to construct var-cov matrix (G or H) for '~ inner | outer' terms .con.E <- function(v, r, v.val, r.val, Z1, Z2, levels.r, values, Dmat, struct, cholesky, vctransf, vccov, nearpd, sparse) { ### if cholesky=TRUE, back-transformation/substitution is done below; otherwise, back-transform and replace fixed values if (!cholesky) { if (vctransf) { v <- ifelse(is.na(v.val), exp(v), v.val) # variances are optimized in log space, so exponentiate if (struct == "CAR") r <- ifelse(is.na(r.val), plogis(r), r.val) # CAR correlation is optimized in qlogis space, so use plogis if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) r <- ifelse(is.na(r.val), exp(r), r.val) # spatial and phylogenetic 'correlation' parameter is optimized in log space, so exponentiate if (!is.element(struct, c("CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) r <- ifelse(is.na(r.val), tanh(r), r.val) # other correlations are optimized in atanh space, so use tanh } else { ### for Hessian computation, can choose to leave as is v <- ifelse(is.na(v.val), v, v.val) r <- ifelse(is.na(r.val), r, r.val) v[v < 0] <- 0 if (struct == "CAR") { r[r < 0] <- 0 r[r > 1] <- 1 } if (is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) { r[r < 0] <- 0 } if (!is.element(struct, c("CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD")) && !vccov) { r[r < -1] <- -1 r[r > 1] <- 1 } } v <- ifelse(v <= .Machine$double.eps*10, 0, v) # don't do this with Cholesky factorization, since values can be negative } ncol.Z1 <- ncol(Z1) if (struct == "CS") { E <- matrix(r*v, nrow=ncol.Z1, ncol=ncol.Z1) diag(E) <- v } if (struct == "HCS") { E <- matrix(r, nrow=ncol.Z1, ncol=ncol.Z1) diag(E) <- 1 E <- diag(sqrt(v), nrow=ncol.Z1, ncol=ncol.Z1) %*% E %*% diag(sqrt(v), nrow=ncol.Z1, ncol=ncol.Z1) diag(E) <- v } if (is.element(struct, c("UN","GEN"))) { if (cholesky) { E <- .con.vcov.UN.chol(v, r) v <- diag(E) # need this, so correct values are shown when verbose=TRUE r <- cov2cor(E)[lower.tri(E)] # need this, so correct values are shown when verbose=TRUE v[!is.na(v.val)] <- v.val[!is.na(v.val)] # replace any fixed values r[!is.na(r.val)] <- r.val[!is.na(r.val)] # replace any fixed values } E <- .con.vcov.UN(v, r, vccov) if (nearpd) { E <- as.matrix(nearPD(E)$mat) # nearPD() in Matrix package v <- diag(E) # need this, so correct values are shown when verbose=TRUE r <- cov2cor(E)[lower.tri(E)] # need this, so correct values are shown when verbose=TRUE } } if (struct == "UNR") { if (cholesky) { E <- .con.vcov.UNR.chol(v, r) v <- diag(E)[1,1] # need this, so correct values are shown when verbose=TRUE r <- cov2cor(E)[lower.tri(E)] # need this, so correct values are shown when verbose=TRUE v[!is.na(v.val)] <- v.val[!is.na(v.val)] # replace any fixed values r[!is.na(r.val)] <- r.val[!is.na(r.val)] # replace any fixed values } E <- .con.vcov.UNR(v, r) if (nearpd) { E <- as.matrix(nearPD(E, keepDiag=TRUE)$mat) # nearPD() in Matrix package v <- E[1,1] # need this, so correct values are shown when verbose=TRUE r <- cov2cor(E)[lower.tri(E)] # need this, so correct values are shown when verbose=TRUE } } if (struct == "GDIAG") { E <- diag(v, nrow=length(v), ncol=length(v)) } if (is.element(struct, c("ID","DIAG"))) E <- diag(v, nrow=ncol.Z1, ncol=ncol.Z1) if (struct == "AR") { if (ncol.Z1 > 1) { E <- toeplitz(ARMAacf(ar=r, lag.max=ncol.Z1-1)) } else { E <- diag(1) } E <- diag(sqrt(rep(v, ncol.Z1)), nrow=ncol.Z1, ncol=ncol.Z1) %*% E %*% diag(sqrt(rep(v, ncol.Z1)), nrow=ncol.Z1, ncol=ncol.Z1) diag(E) <- v } if (struct == "HAR") { if (ncol.Z1 > 1) { E <- toeplitz(ARMAacf(ar=r, lag.max=ncol.Z1-1)) } else { E <- diag(1) } E <- diag(sqrt(v), nrow=ncol.Z1, ncol=ncol.Z1) %*% E %*% diag(sqrt(v), nrow=ncol.Z1, ncol=ncol.Z1) diag(E) <- v } if (struct == "CAR") { if (ncol.Z1 > 1) { E <- outer(values, values, function(x,y) r^(abs(x-y))) } else { E <- diag(1) } E <- diag(sqrt(rep(v, ncol.Z1)), nrow=ncol.Z1, ncol=ncol.Z1) %*% E %*% diag(sqrt(rep(v, ncol.Z1)), nrow=ncol.Z1, ncol=ncol.Z1) diag(E) <- v } if (struct == "SPEXP") E <- v * exp(-Dmat/r) * tcrossprod(Z2) if (struct == "SPGAU") E <- v * exp(-Dmat^2/r^2) * tcrossprod(Z2) if (struct == "SPLIN") E <- v * ((1 - Dmat/r) * I(Dmat < r)) * tcrossprod(Z2) if (struct == "SPRAT") E <- v * (1 - (Dmat/r)^2 / (1 + (Dmat/r)^2)) * tcrossprod(Z2) if (struct == "SPSPH") E <- v * ((1 - 3/2*Dmat/r + 1/2*(Dmat/r)^3) * I(Dmat < r)) * tcrossprod(Z2) if (struct == "PHYBM") { r <- max(Dmat) E <- 1 - Dmat/r E <- v * E * tcrossprod(Z2) } if (struct == "PHYPL") { E <- r * (1 - Dmat/max(Dmat)) diag(E) <- 1 E[Dmat == 0] <- 1 E <- v * E * tcrossprod(Z2) } if (struct == "PHYPD") { E <- 1 - Dmat/max(Dmat) E <- v * E^r * tcrossprod(Z2) } ### set variance and corresponding correlation value(s) to 0 for any levels that were removed if (!is.element(struct, c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG")) && any(levels.r)) { E[levels.r,] <- 0 E[,levels.r] <- 0 } if (sparse) E <- Matrix(E, sparse=TRUE) return(list(v=v, r=r, E=E)) } ############################################################################ ### -1 times the log likelihood (regular or restricted) for rma.mv models .ll.rma.mv <- function(par, reml, Y, M, A, X, k, pX, # note: pX due to nlm(); M=V to begin with D.S, Z.G1, Z.G2, Z.H1, Z.H2, g.Dmat, h.Dmat, sigma2.val, tau2.val, rho.val, gamma2.val, phi.val, beta.val, sigma2s, tau2s, rhos, gamma2s, phis, withS, withG, withH, struct, g.levels.r, h.levels.r, g.values, h.values, sparse, cholesky, nearpd, vctransf, vccov, vccon, verbose, digits, REMLf, dofit=FALSE, hessian=FALSE) { mstyle <- .get.mstyle("crayon" %in% .packages()) ### only NA values in sigma2.val, tau2.val, rho.val, gamma2.val, phi.val should be estimated; otherwise, replace with fixed values if (withS) { vars <- par[seq_len(sigma2s)] if (vctransf) { sigma2 <- ifelse(is.na(sigma2.val), exp(vars), sigma2.val) # sigma2 is optimized in log space, so exponentiate } else { sigma2 <- ifelse(is.na(sigma2.val), vars, sigma2.val) # for Hessian computation, can choose to leave as is sigma2[sigma2 < 0] <- 0 } #if (any(is.nan(sigma2))) # return(Inf) ### set really small sigma2 values equal to 0 (anything below .Machine$double.eps*10 is essentially 0) sigma2 <- ifelse(sigma2 <= .Machine$double.eps*10, 0, sigma2) if (!is.null(vccon) && !is.null(vccon$sigma2)) { for (id in unique(vccon$sigma2)) sigma2[vccon$sigma2 == id] <- mean(sigma2[vccon$sigma2 == id]) } for (j in seq_len(sigma2s)) { M <- M + sigma2[j] * D.S[[j]] } } if (withG) { vars <- par[(sigma2s+1):(sigma2s+tau2s)] cors <- par[(sigma2s+tau2s+1):(sigma2s+tau2s+rhos)] resG <- .con.E(v=vars, r=cors, v.val=tau2.val, r.val=rho.val, Z1=Z.G1, Z2=Z.G2, levels.r=g.levels.r, values=g.values, Dmat=g.Dmat, struct=struct[1], cholesky=cholesky[1], vctransf=vctransf, vccov=vccov, nearpd=nearpd, sparse=sparse) tau2 <- resG$v rho <- resG$r G <- resG$E if (!is.null(vccon)) { if (!is.null(vccon$tau2)) { for (id in unique(vccon$tau2)) tau2[vccon$tau2 == id] <- mean(tau2[vccon$tau2 == id]) } if (!is.null(vccon$rho)) { for (id in unique(vccon$rho)) { rho[vccon$rho == id] <- mean(rho[vccon$rho == id]) } } resG <- .con.E(v=tau2, r=rho, v.val=tau2.val, r.val=rho.val, Z1=Z.G1, Z2=Z.G2, levels.r=g.levels.r, values=g.values, Dmat=g.Dmat, struct=struct[1], cholesky=FALSE, vctransf=FALSE, vccov=vccov, nearpd=nearpd, sparse=sparse) tau2 <- resG$v rho <- resG$r G <- resG$E } M <- M + (Z.G1 %*% G %*% t(Z.G1)) * tcrossprod(Z.G2) } if (withH) { vars <- par[(sigma2s+tau2s+rhos+1):(sigma2s+tau2s+rhos+gamma2s)] cors <- par[(sigma2s+tau2s+rhos+gamma2s+1):(sigma2s+tau2s+rhos+gamma2s+phis)] resH <- .con.E(v=vars, r=cors, v.val=gamma2.val, r.val=phi.val, Z1=Z.H1, Z2=Z.H2, levels.r=h.levels.r, values=h.values, Dmat=h.Dmat, struct=struct[2], cholesky=cholesky[2], vctransf=vctransf, vccov=vccov, nearpd=nearpd, sparse=sparse) gamma2 <- resH$v phi <- resH$r H <- resH$E if (!is.null(vccon)) { if (!is.null(vccon$gamma2)) { for (id in unique(vccon$gamma2)) { gamma2[vccon$gamma2 == id] <- mean(gamma2[vccon$gamma2 == id]) } } if (!is.null(vccon$phi)) { for (id in unique(vccon$phi)) { phi[vccon$phi == id] <- mean(phi[vccon$phi == id]) } } resH <- .con.E(v=gamma2, r=phi, v.val=gamma2.val, r.val=phi.val, Z1=Z.H1, Z2=Z.H2, levels.r=h.levels.r, values=h.values, Dmat=h.Dmat, struct=struct[2], cholesky=FALSE, vctransf=FALSE, vccov=vccov, nearpd=nearpd, sparse=sparse) gamma2 <- resH$v phi <- resH$r H <- resH$E } M <- M + (Z.H1 %*% H %*% t(Z.H1)) * tcrossprod(Z.H2) } ### put estimates so far into .metafor environment if (!hessian) { pars <- list(sigma2 = if (withS) sigma2 else NULL, tau2 = if (withG) tau2 else NULL, rho = if (withG) rho else NULL, gamma2 = if (withH) gamma2 else NULL, phi = if (withH) phi else NULL) try(assign("rma.mv", pars, envir=.metafor), silent=TRUE) } ### note: if M is sparse, then using nearPD() could blow up if (nearpd) M <- as.matrix(nearPD(M)$mat) if (verbose > 1) { W <- try(chol2inv(chol(M)), silent=FALSE) } else { W <- try(suppressWarnings(chol2inv(chol(M))), silent=TRUE) } ### note: need W for REML llval computation if (inherits(W, "try-error")) { ### if M is not positive-definite, set the (restricted) log likelihood to -Inf ### this idea is based on: https://stats.stackexchange.com/q/11368/1934 (this is crude, but should ### move the parameter estimates away from values that create the non-positive-definite M matrix) if (dofit) { stop(mstyle$stop("Final variance-covariance matrix not positive definite."), call.=FALSE) } else { llval <- -Inf } } else { if (verbose > 1) { U <- try(chol(W), silent=FALSE) } else { U <- try(suppressWarnings(chol(W)), silent=TRUE) } ### Y ~ N(Xbeta, M), so UY ~ N(UXbeta, UMU) where UMU = I ### return(U %*% M %*% U) if (inherits(U, "try-error")) { if (dofit) { stop(mstyle$stop("Cannot fit model based on estimated marginal variance-covariance matrix."), call.=FALSE) } else { llval <- -Inf } } else { if (!dofit || is.null(A)) { sX <- U %*% X sY <- U %*% Y beta <- solve(crossprod(sX), crossprod(sX, sY)) beta <- ifelse(is.na(beta.val), beta, beta.val) RSS <- sum(as.vector(sY - sX %*% beta)^2) if (dofit) vb <- matrix(solve(crossprod(sX)), nrow=pX, ncol=pX) } else { stXAX <- chol2inv(chol(as.matrix(t(X) %*% A %*% X))) #stXAX <- tcrossprod(qr.solve(sX, diag(k))) beta <- matrix(stXAX %*% crossprod(X,A) %*% Y, ncol=1) beta <- ifelse(is.na(beta.val), beta, beta.val) RSS <- as.vector(t(Y - X %*% beta) %*% W %*% (Y - X %*% beta)) vb <- matrix(stXAX %*% t(X) %*% A %*% M %*% A %*% X %*% stXAX, nrow=pX, ncol=pX) } llvals <- c(NA_real_, NA_real_) if (dofit || !reml) llvals[1] <- -1/2 * (k) * log(2*base::pi) - 1/2 * determinant(M, logarithm=TRUE)$modulus - 1/2 * RSS if (dofit || reml) llvals[2] <- -1/2 * (k-pX) * log(2*base::pi) + ifelse(REMLf, 1/2 * determinant(crossprod(X), logarithm=TRUE)$modulus, 0) + -1/2 * determinant(M, logarithm=TRUE)$modulus - 1/2 * determinant(crossprod(X,W) %*% X, logarithm=TRUE)$modulus - 1/2 * RSS if (dofit) { res <- list(beta=beta, vb=vb, M=M, llvals=llvals) if (withS) res$sigma2 <- sigma2 if (withG) { res$G <- G res$tau2 <- tau2 res$rho <- rho } if (withH) { res$H <- H res$gamma2 <- gamma2 res$phi <- phi } return(res) } else { llval <- ifelse(reml, llvals[2], llvals[1]) } } } if ((vctransf && verbose) || (!vctransf && (verbose > 1))) { if (!hessian) { iteration <- .getfromenv("iteration", default=NULL) if (!is.null(iteration)) { #cat(mstyle$verbose(paste0("Iteration ", iteration, "\t"))) cat(mstyle$verbose(paste0("Iteration ", formatC(iteration, width=5, flag="-", format="f", digits=0), " "))) try(assign("iteration", iteration+1, envir=.metafor), silent=TRUE) } } cat(mstyle$verbose(paste0("ll = ", fmtx(llval, digits[["fit"]], flag=" "))), " ") if (withS) cat(mstyle$verbose(paste0("sigma2 =", paste(fmtx(sigma2, digits[["var"]], flag=" "), collapse=" "), " "))) if (withG) { cat(mstyle$verbose(paste0("tau2 =", paste(fmtx(tau2, digits[["var"]], flag=" "), collapse=" "), " "))) cat(mstyle$verbose(paste0("rho =", paste(fmtx(rho, digits[["var"]], flag=" "), collapse=" "), " "))) } if (withH) { cat(mstyle$verbose(paste0("gamma2 =", paste(fmtx(gamma2, digits[["var"]], flag=" "), collapse=" "), " "))) cat(mstyle$verbose(paste0("phi =", paste(fmtx(phi, digits[["var"]], flag=" "), collapse=" "), " "))) } cat("\n") } return(-1 * c(llval)) } ############################################################################ .cooks.distance.rma.mv <- function(i, obj, parallel, svb, cluster, ids, reestimate, btt) { if (parallel == "snow") library(metafor) incl <- cluster %in% ids[i] ### elements that need to be returned outlist <- "coef.na=coef.na, beta=beta" ### note: not.na=FALSE only when there are missings in data, not when model below cannot be fitted or results in dropped coefficients if (reestimate) { ### set initial values to estimates from full model control <- obj$control control$sigma2.init <- obj$sigma2 control$tau2.init <- obj$tau2 control$rho.init <- obj$rho control$gamma2.init <- obj$gamma2 control$phi.init <- obj$phi ### fit model without data from ith cluster args <- list(yi=obj$yi, V=obj$V, W=obj$W, mods=obj$X, random=obj$random, struct=obj$struct, intercept=FALSE, data=obj$mf.r, method=obj$method, test=obj$test, dfs=obj$dfs, level=obj$level, R=obj$R, Rscale=obj$Rscale, sigma2=ifelse(obj$vc.fix$sigma2, obj$sigma2, NA), tau2=ifelse(obj$vc.fix$tau2, obj$tau2, NA), rho=ifelse(obj$vc.fix$rho, obj$rho, NA), gamma2=ifelse(obj$vc.fix$gamma2, obj$gamma2, NA), phi=ifelse(obj$vc.fix$phi, obj$phi, NA), sparse=obj$sparse, dist=obj$dist, vccon=obj$vccon, control=control, subset=!incl, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.mv, args)), silent=TRUE) } else { ### set values of variance/correlation components to those from the 'full' model args <- list(yi=obj$yi, V=obj$V, W=obj$W, mods=obj$X, random=obj$random, struct=obj$struct, intercept=FALSE, data=obj$mf.r, method=obj$method, test=obj$test, dfs=obj$dfs, level=obj$level, R=obj$R, Rscale=obj$Rscale, sigma2=obj$sigma2, tau2=obj$tau2, rho=obj$rho, gamma2=obj$gamma2, phi=obj$phi, sparse=obj$sparse, dist=obj$dist, vccon=obj$vccon, control=obj$control, subset=!incl, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.mv, args)), silent=TRUE) } if (inherits(res, "try-error")) return(list(cook.d = NA_real_)) ### removing a cluster could lead to a model coefficient becoming inestimable if (any(res$coef.na)) return(list(cook.d = NA_real_)) ### compute dfbeta value(s) (including coefficients as specified via btt) dfb <- obj$beta[btt] - res$beta[btt] ### compute Cook's distance return(list(cook.d = crossprod(dfb,svb) %*% dfb)) } .rstudent.rma.mv <- function(i, obj, parallel, cluster, ids, reestimate) { if (parallel == "snow") library(metafor) incl <- cluster %in% ids[i] k.id <- sum(incl) ### elements that need to be returned outlist <- "coef.na=coef.na, sigma2=sigma2, tau2=tau2, rho=rho, gamma2=gamma2, phi=phi, beta=beta, vb=vb" if (reestimate) { ### set initial values to estimates from full model control <- obj$control control$sigma2.init <- obj$sigma2 control$tau2.init <- obj$tau2 control$rho.init <- obj$rho control$gamma2.init <- obj$gamma2 control$phi.init <- obj$phi ### fit model without data from ith cluster args <- list(yi=obj$yi, V=obj$V, W=obj$W, mods=obj$X, random=obj$random, struct=obj$struct, intercept=FALSE, data=obj$mf.r, method=obj$method, test=obj$test, dfs=obj$dfs, level=obj$level, R=obj$R, Rscale=obj$Rscale, sigma2=ifelse(obj$vc.fix$sigma2, obj$sigma2, NA), tau2=ifelse(obj$vc.fix$tau2, obj$tau2, NA), rho=ifelse(obj$vc.fix$rho, obj$rho, NA), gamma2=ifelse(obj$vc.fix$gamma2, obj$gamma2, NA), phi=ifelse(obj$vc.fix$phi, obj$phi, NA), sparse=obj$sparse, dist=obj$dist, vccon=obj$vccon, control=control, subset=!incl, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.mv, args)), silent=TRUE) } else { ### set values of variance/correlation components to those from the 'full' model args <- list(yi=obj$yi, V=obj$V, W=obj$W, mods=obj$X, random=obj$random, struct=obj$struct, intercept=FALSE, data=obj$mf.r, method=obj$method, test=obj$test, dfs=obj$dfs, level=obj$level, R=obj$R, Rscale=obj$Rscale, sigma2=obj$sigma2, tau2=obj$tau2, rho=obj$rho, gamma2=obj$gamma2, phi=obj$phi, sparse=obj$sparse, dist=obj$dist, vccon=obj$vccon, control=obj$control, subset=!incl, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.mv, args)), silent=TRUE) } if (inherits(res, "try-error")) return(list(delresid = rep(NA_real_, k.id), sedelresid = rep(NA_real_, k.id), X2 = NA_real_, k.id = NA_integer_, pos = which(incl))) ### removing a cluster could lead to a model coefficient becoming inestimable if (any(res$coef.na)) return(list(delresid = rep(NA_real_, k.id), sedelresid = rep(NA_real_, k.id), X2 = NA_real_, k.id = NA_integer_, pos = which(incl))) ### elements that need to be returned outlist <- "M=M" ### fit model based on all data but with var/cor components fixed to those from res args <- list(yi=obj$yi, V=obj$V, W=obj$W, mods=obj$X, random=obj$random, struct=obj$struct, intercept=FALSE, data=obj$mf.r, method=obj$method, test=obj$test, dfs=obj$dfs, level=obj$level, R=obj$R, Rscale=obj$Rscale, sigma2=res$sigma2, tau2=res$tau2, rho=res$rho, gamma2=res$gamma2, phi=res$phi, sparse=obj$sparse, dist=obj$dist, vccon=obj$vccon, control=obj$control, outlist=outlist) tmp <- try(suppressWarnings(.do.call(rma.mv, args)), silent=TRUE) Xi <- obj$X[incl,,drop=FALSE] delpred <- Xi %*% res$beta vdelpred <- Xi %*% res$vb %*% t(Xi) delresid <- c(obj$yi[incl] - delpred) sedelresid <- c(sqrt(diag(tmp$M[incl,incl,drop=FALSE] + vdelpred))) sve <- try(chol2inv(chol(tmp$M[incl,incl,drop=FALSE] + vdelpred)), silent=TRUE) #sve <- try(solve(tmp$M[incl,incl,drop=FALSE] + vdelpred), silent=TRUE) if (inherits(sve, "try-error")) return(list(delresid = delresid, sedelresid = sedelresid, X2 = NA_real_, k.id = k.id, pos = which(incl))) X2 <- c(rbind(delresid) %*% sve %*% cbind(delresid)) if (is.list(X2)) # when sparse=TRUE, this is a list with a one-element matrix X2 <- X2[[1]][1] return(list(delresid = delresid, sedelresid = sedelresid, X2 = X2, k.id = k.id, pos = which(incl))) } .dfbetas.rma.mv <- function(i, obj, parallel, cluster, ids, reestimate) { if (parallel == "snow") library(metafor) incl <- cluster %in% ids[i] ### elements that need to be returned outlist <- "coef.na=coef.na, sigma2=sigma2, tau2=tau2, rho=rho, gamma2=gamma2, phi=phi, beta=beta" if (reestimate) { ### set initial values to estimates from full model control <- obj$control control$sigma2.init <- obj$sigma2 control$tau2.init <- obj$tau2 control$rho.init <- obj$rho control$gamma2.init <- obj$gamma2 control$phi.init <- obj$phi ### fit model without data from ith cluster args <- list(yi=obj$yi, V=obj$V, W=obj$W, mods=obj$X, random=obj$random, struct=obj$struct, intercept=FALSE, data=obj$mf.r, method=obj$method, test=obj$test, dfs=obj$dfs, level=obj$level, R=obj$R, Rscale=obj$Rscale, sigma2=ifelse(obj$vc.fix$sigma2, obj$sigma2, NA), tau2=ifelse(obj$vc.fix$tau2, obj$tau2, NA), rho=ifelse(obj$vc.fix$rho, obj$rho, NA), gamma2=ifelse(obj$vc.fix$gamma2, obj$gamma2, NA), phi=ifelse(obj$vc.fix$phi, obj$phi, NA), sparse=obj$sparse, dist=obj$dist, vccon=obj$vccon, control=control, subset=!incl, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.mv, args)), silent=TRUE) } else { ### set values of variance/correlation components to those from the 'full' model args <- list(yi=obj$yi, V=obj$V, W=obj$W, mods=obj$X, random=obj$random, struct=obj$struct, intercept=FALSE, data=obj$mf.r, method=obj$method, test=obj$test, dfs=obj$dfs, level=obj$level, R=obj$R, Rscale=obj$Rscale, sigma2=obj$sigma2, tau2=obj$tau2, rho=obj$rho, gamma2=obj$gamma2, phi=obj$phi, sparse=obj$sparse, dist=obj$dist, vccon=obj$vccon, control=obj$control, subset=!incl, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.mv, args)), silent=TRUE) } if (inherits(res, "try-error")) return(list(dfbs = NA_real_)) ### removing a cluster could lead to a model coefficient becoming inestimable if (any(res$coef.na)) return(list(dfbs = NA_real_)) ### elements that need to be returned outlist <- "vb=vb" ### fit model based on all data but with var/cor components fixed to those from res args <- list(yi=obj$yi, V=obj$V, W=obj$W, mods=obj$X, random=obj$random, struct=obj$struct, intercept=FALSE, data=obj$mf.r, method=obj$method, test=obj$test, dfs=obj$dfs, level=obj$level, R=obj$R, Rscale=obj$Rscale, sigma2=res$sigma2, tau2=res$tau2, rho=res$rho, gamma2=res$gamma2, phi=res$phi, sparse=obj$sparse, dist=obj$dist, vccon=obj$vccon, control=obj$control, outlist=outlist) tmp <- try(suppressWarnings(.do.call(rma.mv, args)), silent=TRUE) ### compute dfbeta value(s) dfb <- obj$beta - res$beta ### compute dfbetas dfbs <- c(dfb / sqrt(diag(tmp$vb))) return(list(dfbs = dfbs)) } ############################################################################ .ddf.calc <- function(dfs, X, k, p, mf.s=NULL, mf.g=NULL, mf.h=NULL, beta=TRUE) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (beta) { if (is.numeric(dfs)) { ddf <- dfs if (length(ddf) == 1L) ddf <- rep(ddf, p) if (length(ddf) != p) stop(mstyle$stop(paste0("Length of 'dfs' argument (", length(dfs), ") does not match the number of model coefficient (", p, ").")), call.=FALSE) } if (is.character(dfs) && dfs == "residual") ddf <- rep(k-p, p) if (is.character(dfs) && dfs == "contain") { if (!is.null(mf.g)) mf.g <- cbind(inner=apply(mf.g, 1, paste, collapse=" + "), outer=mf.g[ncol(mf.g)]) if (!is.null(mf.h)) mf.h <- cbind(inner=apply(mf.h, 1, paste, collapse=" + "), outer=mf.h[ncol(mf.h)]) s.nlevels <- sapply(mf.s, function(x) length(unique(x))) # list() if no S g.nlevels <- c(length(unique(mf.g[[1]])), length(unique(mf.g[[2]]))) # c(0,0) if no G h.nlevels <- c(length(unique(mf.h[[1]])), length(unique(mf.h[[2]]))) # c(0,0) if no H #print(list(s.nlevels, g.nlevels, h.nlevels)) s.ddf <- rep(k, p) g.ddf <- rep(k, p) h.ddf <- rep(k, p) for (j in seq_len(p)) { if (!is.null(mf.s)) { s.lvl <- sapply(seq_along(mf.s), function(i) all(apply(table(X[,j], mf.s[[i]]) > 0, 2, sum) == 1)) if (any(s.lvl)) s.ddf[j] <- min(s.nlevels[s.lvl]) } if (!is.null(mf.g)) { g.lvl <- sapply(seq_along(mf.g), function(i) all(apply(table(X[,j], mf.g[[i]]) > 0, 2, sum) == 1)) if (any(g.lvl)) g.ddf[j] <- min(g.nlevels[g.lvl]) } if (!is.null(mf.h)) { h.lvl <- sapply(seq_along(mf.h), function(i) all(apply(table(X[,j], mf.h[[i]]) > 0, 2, sum) == 1)) if (any(h.lvl)) h.ddf[j] <- min(h.nlevels[h.lvl]) } } #return(list(s.ddf, g.ddf, h.ddf)) ddf <- pmin(s.ddf, g.ddf, h.ddf) ddf <- ddf - p } names(ddf) <- colnames(X) } else { if (is.numeric(dfs)) dfs <- "contain" if (dfs == "residual") ddf <- k-p if (dfs == "contain") { if (!is.null(mf.s)) ddf <- length(unique(mf.s)) if (!is.null(mf.g)) ddf <- length(unique(mf.g)) if (!is.null(mf.h)) ddf <- length(unique(mf.h)) ddf <- ddf - p } } ddf[ddf < 1] <- 1 return(ddf) } ############################################################################ metafor/R/matreg.r0000644000176200001440000002306614434142502013560 0ustar liggesusersmatreg <- function(y, x, R, n, V, cov=FALSE, means, ztor=FALSE, nearpd=FALSE, level=95, digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (missing(digits)) digits <- 4 level <- .level(level) ### check/process R argument if (missing(R)) stop(mstyle$stop("Must specify 'R' argument.")) R <- as.matrix(R) if (nrow(R) != ncol(R)) stop(mstyle$stop("Argument 'R' must be a square matrix.")) if (is.null(rownames(R))) rownames(R) <- colnames(R) if (is.null(colnames(R))) colnames(R) <- rownames(R) p <- nrow(R) if (p <= 1L) stop(mstyle$stop("The 'R' matrix must be at least of size 2x2.")) ### check/process y argument if (length(y) != 1L) stop(mstyle$stop("Argument 'y' should specify a single variable.")) if (is.character(y)) { if (is.null(rownames(R))) stop(mstyle$stop("'R' must have dimension names when specifying a variable name for 'y'.")) if (anyDuplicated(rownames(R))) stop(mstyle$stop("Dimension names of 'R' must be unique.")) y.pos <- pmatch(y, rownames(R)) # NA if no match or there are duplicates if (is.na(y.pos)) stop(mstyle$stop(paste0("Could not find variable '", y, "' in the 'R' matrix."))) y <- y.pos } y <- round(y) if (y < 1 || y > p) stop(mstyle$stop(paste0("Index 'y' must be >= 1 or <= ", p, "."))) ### check/process x argument if (missing(x)) # if not specified, use all other variables in R as predictors x <- seq_len(p)[-y] if (is.character(x)) { if (is.null(rownames(R))) stop(mstyle$stop("'R' must have dimension names when specifying variable names for 'x'.")) if (anyDuplicated(rownames(R))) stop(mstyle$stop("Dimension names of 'R' must be unique.")) x.pos <- pmatch(x, rownames(R)) # NA if no match or there are duplicates if (anyNA(x.pos)) stop(mstyle$stop(paste0("Could not find variable", ifelse(sum(is.na(x.pos)) > 1L, "s", ""), " '", paste(x[is.na(x.pos)], collapse=", "), "' in the 'R' matrix."))) x <- x.pos } x <- round(x) if (anyDuplicated(x)) stop(mstyle$stop("Argument 'x' should not contain duplicated elements.")) if (any(x < 1 | x > p)) stop(mstyle$stop(paste0("Indices in 'x' must be >= 1 or <= ", p, "."))) if (y %in% x) stop(mstyle$stop("Variable 'y' should not be an element of 'x'.")) ### check/process V/n arguments if (missing(V)) V <- NULL if (is.null(V) && missing(n)) stop(mstyle$stop("Either 'V' or 'n' must be specified.")) if (!is.null(V) && !missing(n)) stop(mstyle$stop("Either 'V' or 'n' must be specified, not both.")) if (cov && ztor) stop(mstyle$stop("Cannot use a covariance matrix as input when 'ztor=TRUE'.")) ### get ... argument and check for extra/superfluous arguments ddd <- list(...) .chkdots(ddd, c("nearPD")) if (.isTRUE(ddd$nearPD)) nearpd <- TRUE ############################################################################ m <- length(x) R[upper.tri(R)] <- t(R)[upper.tri(R)] if (!is.null(V)) { V <- as.matrix(V) if (nrow(V) != ncol(V)) stop(mstyle$stop("Argument 'V' must be a square matrix.")) V[upper.tri(V)] <- t(V)[upper.tri(V)] if (cov) { s <- p*(p+1)/2 } else { s <- p*(p-1)/2 } if (nrow(V) != s) stop(mstyle$stop(paste0("Dimensions of 'V' (", nrow(V), "x", ncol(V), ") do not match the number of elements in 'R' (", s, ")."))) } ############################################################################ if (ztor) { if (!is.null(V)) { zij <- R[lower.tri(R)] Dmat <- diag(2 / (cosh(2*zij) + 1), nrow=length(zij), ncol=length(zij), names=FALSE) V <- Dmat %*% V %*% Dmat } R <- tanh(R) diag(R) <- 1 } if (cov) { S <- R R <- cov2cor(R) sdy <- sqrt(diag(S)[y]) sdx <- sqrt(diag(S)[x]) } else { if (any(abs(R) > 1, na.rm=TRUE)) stop(mstyle$stop("Argument 'R' must be a correlation matrix, but contains values outside [-1,1].")) diag(R) <- 1 sdy <- 1 } ############################################################################ Rxy <- R[x, y, drop=FALSE] Rxx <- R[x, x, drop=FALSE] #invRxx <- solve(Rxx) invRxx <- try(chol2inv(chol(Rxx)), silent=TRUE) if (inherits(invRxx, "try-error")) { if (nearpd) { message(mstyle$message("Cannot invert R[x,x] matrix. Using nearPD(). Treat results with caution.")) Rxx <- as.matrix(nearPD(Rxx, corr=TRUE)$mat) } else { stop(mstyle$stop("Cannot invert R[x,x] matrix.")) } invRxx <- try(chol2inv(chol(Rxx)), silent=TRUE) if (inherits(invRxx, "try-error")) stop(mstyle$stop("Still cannot invert R[x,x] matrix.")) } b <- invRxx %*% Rxy if (!is.null(rownames(Rxx))) { rownames(b) <- rownames(Rxx) } else { rownames(b) <- paste0("x", x) } colnames(b) <- NULL ############################################################################ if (cov) { if (missing(means)) { means <- rep(0,p) has.means <- FALSE } else { if (length(means) != p) stop(mstyle$stop(paste0("Length of 'means' (", length(means), ") does not match the dimensions of 'R' (", p, "x", p, ")."))) has.means <- TRUE } } ############################################################################ if (is.null(V)) { # when no V matrix is specified if (length(n) != 1L) stop(mstyle$stop("Argument 'n' should be a single number.")) df <- n - m - ifelse(cov, 1, 0) if (df <= 0) stop(mstyle$stop("Cannot fit model when 'n' is equal to or less than the number of regression coefficients.")) sse <- 1 - c(t(b) %*% Rxy) mse <- sse / df vb <- mse * invRxx R2 <- 1 - sse R2adj <- 1 - (1 - R2) * ((n-ifelse(cov, 1, 0)) / df) F <- c(value = (R2 / m) / mse, df1=m, df2=df) Fp <- pf(F[[1]], df1=m, df2=df, lower.tail=FALSE) mse <- sdy^2 * (n-1) * (1 - R2) / df if (cov) { b <- b * sdy / sdx b <- rbind(means[y] - means[x] %*% b, b) rownames(b)[1] <- "intrcpt" XtX <- (n-1) * bldiag(0,S[x,x]) + n * tcrossprod(c(1,means[x])) invXtX <- try(suppressWarnings(chol2inv(chol(XtX))), silent=TRUE) if (inherits(invXtX, "try-error")) { vb <- matrix(NA_real_, nrow=(m+1), ncol=(m+1)) warning(mstyle$warning("Cannot obtain var-cov matrix of the regression coefficients."), call.=FALSE) } else { vb <- mse * invXtX } if (!has.means) { b[1,] <- NA_real_ vb[1,] <- NA_real_ vb[,1] <- NA_real_ } } rownames(vb) <- colnames(vb) <- rownames(b) se <- sqrt(diag(vb)) tval <- c(b / se) pval <- 2*pt(abs(tval), df=df, lower.tail=FALSE) crit <- qt(level/2, df=df, lower.tail=FALSE) ci.lb <- c(b - crit * se) ci.ub <- c(b + crit * se) res <- list(tab = data.frame(beta=b, se=se, tval=tval, df=df, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub), vb=vb, R2=R2, R2adj=R2adj, F=F, Fdf=c(m,df), Fp=Fp, mse=mse, digits=digits, test="t") } else { # when a V matrix is specified R2 <- c(t(b) %*% Rxy) # as in Becker & Aloe (2019); assume that this also applies for Cov matrices if (cov) { b <- b * sdy / sdx Rxy <- S[x, y, drop=FALSE] invRxx <- diag(1/sdx, nrow=m, ncol=m) %*% invRxx %*% diag(1/sdx, nrow=m, ncol=m) Udiag <- TRUE } else { Udiag <- FALSE } U <- matrix(NA_integer_, nrow=p, ncol=p) U[lower.tri(U, diag=Udiag)] <- seq_len(s) U[upper.tri(U, diag=Udiag)] <- t(U)[upper.tri(U, diag=Udiag)] Uxx <- U[x, x, drop=FALSE] Uxy <- U[x, y, drop=FALSE] uxx <- unique(c(na.omit(c(Uxx)))) uxy <- c(Uxy) A <- matrix(0, nrow=m, ncol=s) for (a in 1:ncol(A)) { if (a %in% uxx) { pos <- c(which(a == Uxx, arr.ind=TRUE)) J <- matrix(0, nrow=m, ncol=m) J[pos[1],pos[2]] <- J[pos[2],pos[1]] <- 1 A[,a] <- - invRxx %*% J %*% invRxx %*% Rxy } if (a %in% uxy) { pos <- c(which(a == Uxy, arr.ind=TRUE)) A[,a] <- invRxx[,pos[1]] } } vb <- A %*% V %*% t(A) if (cov) { b <- rbind(means[y] - means[x] %*% b, b) rownames(b)[1] <- "intrcpt" X <- rbind(means[x], diag(m)) vb <- X %*% vb %*% t(X) if (!has.means) { b[1,] <- NA_real_ vb[1,] <- NA_real_ vb[,1] <- NA_real_ } } se <- sqrt(diag(vb)) zval <- c(b / se) pval <- 2*pnorm(abs(zval), lower.tail=FALSE) crit <- qnorm(level/2, lower.tail=FALSE) ci.lb <- c(b - crit * se) ci.ub <- c(b + crit * se) if (cov) { QM <- try(as.vector(t(b[-1,,drop=FALSE]) %*% chol2inv(chol(vb[-1,-1,drop=FALSE])) %*% b[-1,,drop=FALSE]), silent=TRUE) } else { QM <- try(as.vector(t(b) %*% chol2inv(chol(vb)) %*% b), silent=TRUE) } if (inherits(QM, "try-error")) QM <- NA_real_ QMp <- pchisq(QM, df=m, lower.tail=FALSE) rownames(vb) <- colnames(vb) <- rownames(b) res <- list(tab = data.frame(beta=b, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub), vb=vb, R2=R2, QM=QM, QMdf=c(m,NA_integer_), QMp=QMp, digits=digits, test="z") } class(res) <- c("matreg") return(res) } metafor/R/methods.escalc.r0000644000176200001440000001562514467671166015222 0ustar liggesusers############################################################################ "[.escalc" <- function(x, i, ...) { mf <- paste0(deparse1(match.call()), collapse="") has.drop <- grepl("drop = T", mf, fixed=TRUE) || grepl("drop = F", mf, fixed=TRUE) if (!missing(i) && nargs()-has.drop > 2L) { mf <- match.call() i <- .getx("i", mf=mf, data=x) # TODO: enable this? # treat missings in a logical vector as FALSE when selecting rows #if (is.logical(i) && length(i) == nrow(x)) # i[is.na(i)] <- FALSE } dat <- NextMethod("[") ### find all 'yi' variables that are still part of the dataset yi.names <- attr(x, "yi.names") yi.names <- yi.names[is.element(yi.names, names(dat))] for (l in seq_along(yi.names)) { ### if selecting rows, subset ni and slab attributes accordingly and add them back to each yi variable if (!missing(i) && nargs()-has.drop > 2L) { attr(dat[[yi.names[l]]], "ni") <- attr(x[[yi.names[l]]], "ni")[i] attr(dat[[yi.names[l]]], "slab") <- attr(x[[yi.names[l]]], "slab")[i] } ### add measure attribute back to each yi variable attr(dat[[yi.names[l]]], "measure") <- attr(x[[yi.names[l]]], "measure") } ### add var.names and out.names attributes back to object (but only if they exist and only keep variables still in the dataset) all.names <- c("yi.names", "vi.names", "sei.names", "zi.names", "pval.names", "ci.lb.names", "ci.ub.names") for (l in seq_along(all.names)) { if (any(is.element(attr(x, all.names[l]), names(dat)))) # check if any of the variables still exist in the dataset attr(dat, all.names[l]) <- attr(x, all.names[l])[is.element(attr(x, all.names[l]), names(dat))] } ### add digits attribute back to object (but not to vectors) if (!is.null(attr(x, "digits")) && !is.null(dim(dat))) attr(dat, "digits") <- attr(x, "digits") return(dat) } "$<-.escalc" <- function(x, name, value) { dat <- NextMethod("$<-") ### for each attribute, only keep elements that are still part of the data frame (and remove empty attributes) ### (this is relevant when 'value' is NULL, so when a particular variable is getting removed) all.names <- c("yi.names", "vi.names", "sei.names", "zi.names", "pval.names", "ci.lb.names", "ci.ub.names") for (l in seq_along(all.names)) { if (!is.null(attr(dat, all.names[l]))) { attr(dat, all.names[l]) <- attr(dat, all.names[l])[is.element(attr(dat, all.names[l]), names(dat))] if (length(attr(dat, all.names[l])) == 0L) attr(dat, all.names[l]) <- NULL } } return(dat) } ############################################################################ cbind.escalc <- function (..., deparse.level=1) { dat <- data.frame(..., check.names = FALSE) allargs <- list(...) ### for each element, extract the 'var.names' and 'out.names' attributes and add entire set back to the object yi.names <- NULL vi.names <- NULL sei.names <- NULL zi.names <- NULL pval.names <- NULL ci.lb.names <- NULL ci.ub.names <- NULL for (arg in allargs) { yi.names <- c(attr(arg, "yi.names"), yi.names) vi.names <- c(attr(arg, "vi.names"), vi.names) sei.names <- c(attr(arg, "sei.names"), sei.names) zi.names <- c(attr(arg, "zi.names"), zi.names) pval.names <- c(attr(arg, "pval.names"), pval.names) ci.lb.names <- c(attr(arg, "ci.lb.names"), ci.lb.names) ci.ub.names <- c(attr(arg, "ci.ub.names"), ci.ub.names) } ### but only keep unique variable names attr(dat, "yi.names") <- unique(yi.names) attr(dat, "vi.names") <- unique(vi.names) attr(dat, "sei.names") <- unique(sei.names) attr(dat, "zi.names") <- unique(zi.names) attr(dat, "pval.names") <- unique(pval.names) attr(dat, "ci.lb.names") <- unique(ci.lb.names) attr(dat, "ci.ub.names") <- unique(ci.ub.names) ### add 'digits' attribute back (use the values from first element) attr(dat, "digits") <- attr(arg[1], "digits") class(dat) <- c("escalc", "data.frame") return(dat) } ############################################################################ rbind.escalc <- function (..., deparse.level=1) { dat <- rbind.data.frame(..., deparse.level = deparse.level) allargs <- list(...) yi.names <- attr(dat, "yi.names") yi.names <- yi.names[is.element(yi.names, names(dat))] for (i in seq_along(yi.names)) { ### get position (column number) of the 'yi' variable (in the first argument) #yi.pos <- which(names(allargs[[1]]) == yi.names[i]) ### get position (column number) of the 'yi' variable yi.pos <- sapply(allargs, function(x) which(names(x) == yi.names[i])[1]) yi.pos <- na.omit(yi.pos)[1] ### just in case if (length(yi.pos) == 0L) next ### get 'ni' attribute from all arguments (but only if argument has 'yi' variable) ni <- lapply(allargs, function(x) {if (isTRUE(names(x)[yi.pos] == yi.names[i])) attr(x[[yi.pos]], "ni")}) ### if none of them are missing, then combine and add back to variable ### otherwise remove 'ni' attribute, since it won't be of the right length if (all(sapply(ni, function(x) !is.null(x)))) { attr(dat[[yi.pos]], "ni") <- unlist(ni) } else { attr(dat[[yi.pos]], "ni") <- NULL } ### get 'slab' attribute from all arguments (but only if argument has 'yi' variable) slab <- lapply(allargs, function(x) {if (isTRUE(names(x)[yi.pos] == yi.names[i])) attr(x[[yi.pos]], "slab")}) ### if none of them are missing, then combine and add back to variable (and make sure they are unique) ### otherwise remove 'slab' attribute, since it won't be of the right length if (all(sapply(slab, function(x) !is.null(x)))) { attr(dat[[yi.pos]], "slab") <- .make.unique(unlist(slab)) } else { attr(dat[[yi.pos]], "slab") <- NULL } } return(dat) } ############################################################################ #as.data.frame.escalc <- function(x, row.names=NULL, optional=FALSE, ...) { # # ### strip measure, ni, and slab attributes from any yi elements # # yi.names <- attr(x, "yi.names") # yi.names <- yi.names[is.element(yi.names, names(x))] # # for (l in seq_along(yi.names)) { # # attr(x[[yi.names[l]]], "measure") <- NULL # attr(x[[yi.names[l]]], "ni") <- NULL # attr(x[[yi.names[l]]], "slab") <- NULL # # } # # ### strip other attributes that may be part of an 'escalc' object # # attr(x, "digits") <- NULL # # attr(x, "yi.names") <- NULL # attr(x, "vi.names") <- NULL # attr(x, "sei.names") <- NULL # attr(x, "zi.names") <- NULL # attr(x, "pval.names") <- NULL # attr(x, "ci.lb.names") <- NULL # attr(x, "ci.ub.names") <- NULL # # class(x) <- "data.frame" # # return(x) # #} ############################################################################ metafor/R/misc.func.hidden.escalc.r0000644000176200001440000002552214435461167016664 0ustar liggesusers############################################################################ ### c(m) calculation function for bias correction of SMDs (mi = n1i + n2i - 2) or SMCC/SMCRs (mi = ni - 1) .cmicalc <- function(mi, correct=TRUE) { ### this can overflow if mi is 'large' (on my machine, if mi >= 344) #cmi <- gamma(mi/2)/(sqrt(mi/2)*gamma((mi-1)/2)) ### catch those cases and apply the approximate formula (which is accurate then) #is.na <- is.na(cmi) #cmi[is.na] <- 1 - 3/(4*mi[is.na] - 1) if (correct) { ### this avoids the problem with overflow altogether cmi <- ifelse(mi <= 1, NA_real_, exp(lgamma(mi/2) - log(sqrt(mi/2)) - lgamma((mi-1)/2))) } else { cmi <- rep(1, length(mi)) } return(cmi) } ############################################################################ ### function to compute the tetrachoric correlation coefficient and its sampling variance .rtet <- function(ai, bi, ci, di, maxcor=.9999) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (!requireNamespace("mvtnorm", quietly=TRUE)) stop(mstyle$stop("Please install the 'mvtnorm' package to compute this measure."), call.=FALSE) fn <- function(par, ai, bi, ci, di, maxcor, fixcut=FALSE) { rho <- par[1] cut.row <- par[2] cut.col <- par[3] ### truncate rho values outside of specified bounds if (abs(rho) > maxcor) rho <- sign(rho) * maxcor ### to substitute fixed cut values if (fixcut) { cut.row <- qnorm((ai+bi)/ni) cut.col <- qnorm((ai+ci)/ni) } # │ ci | di # ci = lo X and hi Y di = hi X and hi Y # var Y │----+---- # # │ ai | bi # ai = lo X and lo Y bi = hi X and lo Y # ┼───────── # var X # # lo hi # +----+----+ # lo | ai | bi | # +----+----+ var Y # hi | ci | di | # +----+----+ # var X R <- matrix(c(1,rho,rho,1), nrow=2, ncol=2) p.ai <- mvtnorm::pmvnorm(lower=c(-Inf,-Inf), upper=c(cut.col,cut.row), corr=R) p.bi <- mvtnorm::pmvnorm(lower=c(cut.col,-Inf), upper=c(+Inf,cut.row), corr=R) p.ci <- mvtnorm::pmvnorm(lower=c(-Inf,cut.row), upper=c(cut.col,+Inf), corr=R) p.di <- mvtnorm::pmvnorm(lower=c(cut.col,cut.row), upper=c(+Inf,+Inf), corr=R) ### in principle, should be able to compute these values with the following code, but this ### leads to more numerical instabilities when optimizing (possibly due to negative values) #p.y.lo <- pnorm(cut.row) #p.x.lo <- pnorm(cut.col) #p.ai <- mvtnorm::pmvnorm(lower=c(-Inf,-Inf), upper=c(cut.col,cut.row), corr=R) #p.bi <- p.y.lo - p.ai #p.ci <- p.x.lo - p.ai #p.di <- 1 - p.ai - p.bi - p.ci if (any(p.ai <= 0 || p.bi <= 0 || p.ci <= 0 || p.di <= 0)) { ll <- -Inf } else { ll <- ai*log(p.ai) + bi*log(p.bi) + ci*log(p.ci) + di*log(p.di) } return(-ll) } ni <- ai + bi + ci + di ### if one of the margins is equal to zero, then r_tet could in principle be equal to any value, ### but we define it here to be zero (presuming independence until evidence of dependence is found) ### but with infinite variance if ((ai + bi) == 0L || (ci + di) == 0L || (ai + ci) == 0L || (bi + di) == 0L) return(list(yi=0, vi=Inf)) ### if bi and ci is zero, then r_tet must be +1 with zero variance if (bi == 0L && ci == 0L) return(list(yi=1, vi=0)) ### if ai and di is zero, then r_tet must be -1 with zero variance if (ai == 0L && di == 0L) return(list(yi=-1, vi=0)) ### cases where only one cell is equal to zero are handled further below ### in all other cases, first optimize over rho with cut values set to the sample values ### use suppressWarnings() to suppress "NA/Inf replaced by maximum positive value" warnings res <- try(suppressWarnings(optimize(fn, interval=c(-1,1), ai=ai, bi=bi, ci=ci, di=di, maxcor=maxcor, fixcut=TRUE)), silent=TRUE) ### check for non-convergence if (inherits(res, "try-error")) { warning(mstyle$warning("Could not estimate tetrachoric correlation coefficient."), call.=FALSE) return(list(yi=NA, vi=NA)) } ### then use the value as the starting point and maximize over rho and the cut values ### (Nelder-Mead seems to do fine here; using L-BFGS-B doesn't seem to improve on this) res <- try(optim(par=c(res$minimum,qnorm((ai+bi)/ni),qnorm((ai+ci)/ni)), fn, ai=ai, bi=bi, ci=ci, di=di, maxcor=maxcor, fixcut=FALSE, hessian=TRUE), silent=TRUE) #res <- try(optim(par=c(res$minimum,qnorm((ai+bi)/ni),qnorm((ai+ci)/ni)), fn, method="L-BFGS-B", lower=c(-1,-Inf,-Inf), upper=c(1,Inf,Inf), ai=ai, bi=bi, ci=ci, di=di, maxcor=maxcor, fixcut=FALSE, hessian=TRUE), silent=TRUE) ### check for non-convergence if (inherits(res, "try-error")) { warning(mstyle$warning("Could not estimate tetrachoric correlation coefficient."), call.=FALSE) return(list(yi=NA, vi=NA)) } ### take inverse of hessian and extract variance for estimate ### (using hessian() seems to lead to more problems, so stick with hessian from optim()) vi <- try(chol2inv(chol(res$hessian))[1,1], silent=TRUE) #res$hessian <- try(chol2inv(chol(numDeriv::hessian(fn, x=res$par, ai=ai, bi=bi, ci=ci, di=di, maxcor=maxcor, fixcut=FALSE))), silent=TRUE) ### check for problems with computing the inverse if (inherits(vi, "try-error")) { warning(mstyle$warning("Could not estimate sampling variance of tetrachoric correlation coefficient."), call.=FALSE) vi <- NA } ### extract estimate yi <- res$par[1] ### but if bi or ci is zero, then r_tet must be +1 if (bi == 0 || ci == 0) yi <- 1 ### but if ai or di is zero, then r_tet must be -1 if (ai == 0 || di == 0) yi <- -1 ### note: what is the right variance when there is one zero cell? ### vi as estimated gets smaller as the table becomes more and more like ### a table with 0 diagonal/off-diagonal, which intuitively makes sense ### return estimate and sampling variance (and SE) return(list(yi=yi, vi=vi, sei=sqrt(vi))) ### Could consider implementing the Fisher scoring algorithm; first derivatives and ### elements of the information matrix are given in Tallis (1962). Could also consider ### estimating the variance from the inverse of the information matrix. But constructing ### the information matrix takes a bit of extra work and it is not clear to me how to ### handle estimated cell probabilities that go to zero here. } ############################################################################ ### function to calculate the Gaussian hypergeometric (Hypergeometric2F1) function .Fcalc <- function(a, b, g, x) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (!requireNamespace("gsl", quietly=TRUE)) stop(mstyle$stop("Please install the 'gsl' package to use measure='UCOR'."), call.=FALSE) k.g <- length(g) k.x <- length(x) k <- max(k.g, k.x) res <- rep(NA_real_, k) if (k.g == 1) g <- rep(g, k) if (k.x == 1) x <- rep(x, k) if (length(g) != length(x)) stop(mstyle$stop("Length of 'g' and 'x' arguments is not the same.")) for (i in seq_len(k)) { if (!is.na(g[i]) && !is.na(x[i]) && g[i] > (a+b)) { res[i] <- gsl::hyperg_2F1(a, b, g[i], x[i]) } else { res[i] <- NA } } return(res) } ############################################################################ ### pdf of SMD (with or without bias correction) .dsmd <- function(x, n1, n2, theta, correct=TRUE, xisg=FALSE, warn=FALSE) { nt <- n1 * n2 / (n1 + n2) m <- n1 + n2 - 2 cm <- .cmicalc(m) if (xisg) x <- x / cm if (!correct) cm <- 1 if (warn) { res <- dt(x * sqrt(nt) / cm, df = m, ncp = sqrt(nt) * theta) * sqrt(nt) / cm } else { res <- suppressWarnings(dt(x * sqrt(nt) / cm, df = m, ncp = sqrt(nt) * theta) * sqrt(nt) / cm) } return(res) } #integrate(function(x) .dsmd(x, n1=4, n2=4, theta=.5), lower=-Inf, upper=Inf) #integrate(function(x) x*.dsmd(x, n1=4, n2=4, theta=.5), lower=-Inf, upper=Inf) ### pdf of COR .dcor <- function(x, n, rho) { x[x < -1] <- NA x[x > 1] <- NA ### only accurate for n >= 5 n[n <= 4] <- NA ### calculate density res <- exp(log(n-2) + lgamma(n-1) + (n-1)/2 * log(1 - rho^2) + (n-4)/2 * log(1 - x^2) - 1/2 * log(2*base::pi) - lgamma(n-1/2) - (n-3/2) * log(1 - rho*x)) * .Fcalc(1/2, 1/2, n-1/2, (rho*x + 1)/2) ### make sure that density is 0 for r = +-1 res[abs(x) == 1] <- 0 return(res) } #integrate(function(x) .dcor(x, n=5, rho=.8), lower=-1, upper=1) #integrate(function(x) x*.dcor(x, n=5, rho=.8), lower=-1, upper=1) ### should not be rho due to bias! #integrate(function(x) x*.Fcalc(1/2, 1/2, (5-2)/2, 1-x^2)*.dcor(x, n=5, rho=.8), lower=-1, upper=1) ### should be ~rho ### pdf of ZCOR .dzcor <- function(x, n, rho, zrho) { ### only accurate for n >= 5 n[n <= 4] <- NA ### if rho is missing, then back-transform zrho value(s) if (missing(rho)) rho <- tanh(zrho) ### copy x to z and back-transform z values (so x = correlation) z <- x x <- tanh(z) ### calculate density res <- exp(log(n-2) + lgamma(n-1) + (n-1)/2 * log(1 - rho^2) + (n-4)/2 * log(1 - x^2) - 1/2 * log(2*base::pi) - lgamma(n-1/2) - (n-3/2) * log(1 - rho*x) + log(4) + 2*z - 2*log(exp(2*z) + 1)) * .Fcalc(1/2, 1/2, n-1/2, (rho*x + 1)/2) ### make sure that density is 0 for r = +-1 res[abs(x) == 1] <- 0 return(res) } #integrate(function(x) .dzcor(x, n=5, rho=.8), lower=-100, upper=100) #integrate(function(x) x*.dzcor(x, n=5, rho=.8), lower=-100, upper=100) ### pdf of ARAW .daraw <- function(x, n, m, alpha) { res <- df((1-x)/(1-alpha), (n-1)*(m-1), (n-1)) / (1-alpha) res[alpha >= 1] <- 0 res[alpha <= -1] <- 0 return(res) } #integrate(function(x) .daraw(x, n=10, m=2, alpha=.8), lower=-Inf, upper=Inf) #integrate(function(x) x*.daraw(x, n=10, m=2, alpha=.8), lower=-Inf, upper=Inf) ############################################################################ ### function to convert p-values to t-statistics (need this to catch NULL ### since sign(NULL) and qt(NULL) throw errors) .convp2t <- function(pval, df) { if (is.null(pval)) return(NULL) df <- ifelse(df < 1, NA, df) pval <- ifelse(abs(pval) > 1, NA, pval) sign(pval) * qt(abs(pval)/2, df=df, lower.tail=FALSE) } ### function to convert p-values to F-statistics (need this to catch NULL ### since qf(NULL) throws an error) .convp2f <- function(pval, df1, df2) { if (is.null(pval)) return(NULL) df1 <- ifelse(df1 < 1, NA, df1) df2 <- ifelse(df2 < 1, NA, df2) pval <- ifelse(pval < 0, NA, pval) pval <- ifelse(pval > 1, NA, pval) qf(pval, df1=df1, df2=df2, lower.tail=FALSE) } ############################################################################ metafor/R/gosh.rma.r0000644000176200001440000002031314401667531014017 0ustar liggesusersgosh.rma <- function(x, subsets, progbar=TRUE, parallel="no", ncpus=1, cl, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma", notav=c("rma.glmm", "rma.mv", "robust.rma", "rma.ls", "rma.gen", "rma.uni.selmodel")) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (x$k == 1) stop(mstyle$stop("Stopped because k = 1.")) parallel <- match.arg(parallel, c("no", "snow", "multicore")) if (parallel == "no" && ncpus > 1) parallel <- "snow" if (missing(cl)) cl <- NULL if (!is.null(cl) && inherits(cl, "SOCKcluster")) { parallel <- "snow" ncpus <- length(cl) } if (parallel == "snow" && ncpus < 2) parallel <- "no" if (parallel == "snow" || parallel == "multicore") { if (!requireNamespace("parallel", quietly=TRUE)) stop(mstyle$stop("Please install the 'parallel' package for parallel processing.")) ncpus <- as.integer(ncpus) if (ncpus < 1L) stop(mstyle$stop("Argument 'ncpus' must be >= 1.")) } if (!progbar) { pbo <- pbapply::pboptions(type="none") on.exit(pbapply::pboptions(pbo), add=TRUE) } ddd <- list(...) .chkdots(ddd, c("seed", "time", "LB")) if (.isTRUE(ddd$time)) time.start <- proc.time() ### total number of possible subsets N.tot <- sum(choose(x$k, x$p:x$k)) ### if 'subsets' is missing, include all possible subsets if N.tot is <= 10^6 ### and otherwise include 10^6 random subsets; if the user specifies 'subsets' ### and N.tot <= subsets, then again include all possible subsets if (missing(subsets)) { if (N.tot <= 10^6) { exact <- TRUE } else { exact <- FALSE N.tot <- 10^6 } } else { subsets <- round(subsets) if (subsets <= 1) stop(mstyle$stop("Argument 'subsets' must be >= 2.")) if (N.tot <= subsets) { exact <- TRUE } else { exact <- FALSE N.tot <- subsets } } if (N.tot == Inf) stop(mstyle$stop("Too many iterations required for all combinations.")) if (progbar) message(paste0("Fitting ", N.tot, " models (based on ", ifelse(exact, "all possible", "random"), " subsets).")) ######################################################################### ### generate inclusion matrix (either exact or at random) if (exact) { incl <- as.matrix(expand.grid(replicate(x$k, list(c(FALSE,TRUE))), KEEP.OUT.ATTRS=FALSE)) incl <- incl[rowSums(incl) >= x$p,,drop=FALSE] ### slower, but does not generate rows that need to be filtered out (as above) #incl <- lapply(x$p:x$k, function(m) apply(combn(x$k,m), 2, function(l) 1:x$k %in% l)) #incl <- t(do.call(cbind, incl)) } else { if (!is.null(ddd$seed)) set.seed(ddd$seed) j <- sample(x$p:x$k, N.tot, replace=TRUE, prob=dbinom(x$p:x$k, x$k, 0.5)) incl <- t(sapply(j, function(m) seq_len(x$k) %in% sample(x$k, m))) } colnames(incl) <- seq_len(x$k) ### check if model is a standard FE/EE/CE model or a standard RE model with the DL estimators model <- 0L if (is.element(x$method, c("FE","EE","CE")) && x$weighted && is.null(x$weights) && x$int.only) model <- 1L if (x$method=="DL" && x$weighted && is.null(x$weights) && x$int.only) model <- 2L ######################################################################### outlist <- "beta=beta, k=k, QE=QE, I2=I2, H2=H2, tau2=tau2, coef.na=coef.na" if (parallel == "no") { if (inherits(x, "rma.uni")) res <- pbapply::pbapply(incl, 1, .profile.rma.uni, obj=x, parallel=parallel, subset=TRUE, model=model, outlist=outlist) if (inherits(x, "rma.mh")) res <- pbapply::pbapply(incl, 1, .profile.rma.mh, obj=x, parallel=parallel, subset=TRUE, outlist=outlist) if (inherits(x, "rma.peto")) res <- pbapply::pbapply(incl, 1, .profile.rma.peto, obj=x, parallel=parallel, subset=TRUE, outlist=outlist) } if (parallel == "multicore") { if (inherits(x, "rma.uni")) res <- pbapply::pbapply(incl, 1, .profile.rma.uni, obj=x, parallel=parallel, subset=TRUE, model=model, outlist=outlist, cl=ncpus) #res <- parallel::mclapply(asplit(incl, 1), .profile.rma.uni, obj=x, mc.cores=ncpus, parallel=parallel, subset=TRUE, model=model, outlist=outlist) if (inherits(x, "rma.mh")) res <- pbapply::pbapply(incl, 1, .profile.rma.mh, obj=x, parallel=parallel, subset=TRUE, outlist=outlist, cl=ncpus) #res <- parallel::mclapply(asplit(incl, 1), .profile.rma.mh, obj=x, mc.cores=ncpus, parallel=parallel, subset=TRUE, outlist=outlist) if (inherits(x, "rma.peto")) res <- pbapply::pbapply(incl, 1, .profile.rma.peto, obj=x, parallel=parallel, subset=TRUE, outlist=outlist, cl=ncpus) #res <- parallel::mclapply(asplit(incl, 1), .profile.rma.peto, obj=x, mc.cores=ncpus, parallel=parallel, subset=TRUE, outlist=outlist) } if (parallel == "snow") { if (is.null(cl)) { cl <- parallel::makePSOCKcluster(ncpus) on.exit(parallel::stopCluster(cl), add=TRUE) } if (inherits(x, "rma.uni")) { if (.isTRUE(ddd$LB)) { res <- parallel::parLapplyLB(cl, asplit(incl, 1), .profile.rma.uni, obj=x, parallel=parallel, subset=TRUE, model=model, outlist=outlist) } else { res <- pbapply::pbapply(incl, 1, .profile.rma.uni, obj=x, parallel=parallel, subset=TRUE, model=model, outlist=outlist, cl=cl) #res <- parallel::parLapply(cl, asplit(incl, 1), .profile.rma.uni, obj=x, parallel=parallel, subset=TRUE, model=model, outlist=outlist) } } if (inherits(x, "rma.mh")) { if (.isTRUE(ddd$LB)) { res <- parallel::parLapplyLB(cl, asplit(incl, 1), .profile.rma.mh, obj=x, parallel=parallel, subset=TRUE, outlist=outlist) } else { res <- pbapply::pbapply(incl, 1, .profile.rma.mh, obj=x, parallel=parallel, subset=TRUE, outlist=outlist, cl=cl) #res <- parallel::parLapply(cl, asplit(incl, 1), .profile.rma.mh, obj=x, parallel=parallel, subset=TRUE, outlist=outlist) } } if (inherits(x, "rma.peto")) { if (.isTRUE(ddd$LB)) { res <- parallel::parLapplyLB(cl, asplit(incl, 1), .profile.rma.peto, obj=x, parallel=parallel, subset=TRUE, outlist=outlist) } else { res <- pbapply::pbapply(incl, 1, .profile.rma.peto, obj=x, parallel=parallel, subset=TRUE, outlist=outlist, cl=cl) #res <- parallel::parLapply(cl, asplit(incl, 1), .profile.rma.peto, obj=x, parallel=parallel, subset=TRUE, outlist=outlist) } } } beta <- do.call(rbind, lapply(res, function(x) if (inherits(x, "try-error") || any(x$coef.na)) NA_real_ else t(x$beta))) het <- do.call(rbind, lapply(res, function(x) if (inherits(x, "try-error") || any(x$coef.na)) NA_real_ else c(x$k, x$QE, x$I2, x$H2, x$tau2))) if (all(is.na(het))) stop(mstyle$stop("All model fits failed.")) ######################################################################### ### in case a model fit was skipped, this guarantees that we still get ### a value for k in the first column of the het matrix for each model het[,1] <- rowSums(incl) ### set column names colnames(het) <- c("k", "QE", "I2", "H2", "tau2") if (x$int.only) { colnames(beta) <- "estimate" } else { colnames(beta) <- colnames(x$X) } ### combine het and beta objects and order incl and res by k res <- data.frame(het, beta) incl <- incl[order(res$k),,drop=FALSE] res <- res[order(res$k),,drop=FALSE] ### fix rownames rownames(res) <- seq_len(nrow(res)) rownames(incl) <- seq_len(nrow(incl)) ### was model fitted successfully / all values are not NA? fit <- apply(res, 1, function(x) all(!is.na(x))) ### print processing time if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } ### list to return out <- list(res=res, incl=incl, fit=fit, k=x$k, int.only=x$int.only, method=x$method, measure=x$measure, digits=x$digits) class(out) <- "gosh.rma" return(out) } metafor/R/confint.rma.uni.r0000644000176200001440000005343314467652517015334 0ustar liggesusers# What would be most consistent is this: # if method='ML/REML': profile likelihood (PL) CI (based on the ML/REML likelihood) # if method='EB/PM/PMM': Q-profile (QP) CI # if method='GENQ/GENQM': generalized Q-statistic (GENQ) CI (which also covers method='DL/HE' as special cases) # if method='SJ': method by Sidik & Jonkman (2005) (but this performs poorly, except if tau^2 is very large) # if method='HS': not sure since this is an ad-hoc estimator with no obvious underlying statistical principle # Also can compute Wald-type CIs (but those perform poorly except when k is very large). # Too late to change how the function works (right now, type="GENQ" if method="GENQ/GENQM" and type="QP" otherwise). confint.rma.uni <- function(object, parm, level, fixed=FALSE, random=TRUE, type, digits, transf, targs, verbose=FALSE, control, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.uni", notav=c("robust.rma", "rma.ls", "rma.gen")) if (!missing(parm)) warning(mstyle$warning("Argument 'parm' (currently) ignored."), call.=FALSE) x <- object k <- x$k p <- x$p yi <- x$yi vi <- x$vi X <- x$X Y <- cbind(yi) weights <- x$weights if (missing(level)) level <- x$level if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL if (missing(control)) control <- list() if (!fixed && !random) stop(mstyle$stop("At least one of the arguments 'fixed' and 'random' must be TRUE.")) level <- .level(level) ddd <- list(...) .chkdots(ddd, c("time", "xlim", "extint")) if (.isTRUE(ddd$time)) time.start <- proc.time() if (!is.null(ddd$xlim)) { if (length(ddd$xlim) != 2L) stop(mstyle$stop("Argument 'xlim' should be a vector of length 2.")) control$tau2.min <- ddd$xlim[1] control$tau2.max <- ddd$xlim[2] } if (missing(type)) { if (x$method == "GENQ" || x$method == "GENQM") { type <- "genq" } else { type <- "qp" } } else { type <- tolower(type) if (!is.element(type, c("qp","genq","pl","ht","wald","wald.log","wald.sqrt"))) stop(mstyle$stop("Unknown 'type' specified.")) } ######################################################################### ######################################################################### ######################################################################### if (random) { if (k == 1) stop(mstyle$stop("Stopped because k = 1.")) if (is.element(x$method, c("FE","EE","CE"))) stop(mstyle$stop("Model does not contain a random-effects component.")) if (x$tau2.fix) stop(mstyle$stop("Model does not contain an estimated random-effects component.")) if (type == "genq" && !(is.element(x$method, c("GENQ","GENQM")))) stop(mstyle$stop("Model must be fitted with method=\"GENQ\" or method=\"GENQM\" to use this option.")) ###################################################################### ### set control parameters for uniroot() and possibly replace with user-defined values ### set tau2.min and tau2.max and possibly replace with user-defined values ### note: default tau2.min is smaller of 0 or tau2, since tau2 could in principle be negative ### note: default tau2.max must be larger than tau2 and tau2.min and really should be much larger (at least 100) if (!is.null(x$control$tau2.min) && x$control$tau2.min == -min(x$vi)) x$control$tau2.min <- x$control$tau2.min + 0.0001 # push tau2.min just a bit above -min(vi) to avoid division by zero tau2.min <- ifelse(is.null(x$control$tau2.min), min(0, x$tau2), x$control$tau2.min) tau2.max <- ifelse(is.null(x$control$tau2.max), max(100, x$tau2*10, tau2.min*10), x$control$tau2.max) ### user can in principle set non-sensical limits (i.e., tau2.min > tau2.max), but this is handled properly by the methods below con <- list(tol=.Machine$double.eps^0.25, maxiter=1000, tau2.min=tau2.min, tau2.max=tau2.max, verbose=FALSE) con.pos <- pmatch(names(control), names(con)) con[c(na.omit(con.pos))] <- control[!is.na(con.pos)] if (verbose) con$verbose <- verbose verbose <- con$verbose #return(con) ###################################################################### tau2.lb <- NA_real_ tau2.ub <- NA_real_ ci.null <- FALSE ### logical if CI is a null set lb.conv <- FALSE ### logical if search converged for lower bound (LB) ub.conv <- FALSE ### logical if search converged for upper bound (UB) lb.sign <- "" ### for sign in case LB must be below tau2.min ("<") or above tau2.max (">") ub.sign <- "" ### for sign in case UB must be below tau2.min ("<") or above tau2.max (">") ###################################################################### ######################## ### Q-profile method ### ######################## if (type == "qp") { if (!x$allvipos) stop(mstyle$stop("Cannot compute CI for tau^2 when there are non-positive sampling variances in the data.")) crit.u <- qchisq(level/2, k-p, lower.tail=FALSE) # upper critical chi^2 value for df = k-p crit.l <- qchisq(level/2, k-p, lower.tail=TRUE) # lower critical chi^2 value for df = k-p QE.tau2.max <- .QE.func(con$tau2.max, Y=Y, vi=vi, X=X, k=k, objective=0) QE.tau2.min <- try(.QE.func(con$tau2.min, Y=Y, vi=vi, X=X, k=k, objective=0), silent=TRUE) #dfs <- 12; curve(dchisq(x, df=dfs), from=0, to=40, ylim=c(0,.1), xlab="", ylab=""); abline(v=qchisq(c(.025, .975), df=dfs)); text(qchisq(c(.025, .975), df=dfs)+1.6, .1, c("crit.l", "crit.u")) ################################################################### ### start search for upper bound if (QE.tau2.min < crit.l) { ### if QE.tau2.min is to the left of the crit.l, then both bounds are below tau2.min tau2.lb <- con$tau2.min tau2.ub <- con$tau2.min lb.sign <- "<" ub.sign <- "<" lb.conv <- TRUE ub.conv <- TRUE ### and if tau2.min <= 0, then the CI is equal to the null set if (con$tau2.min <= 0) ci.null <- TRUE } else { if (QE.tau2.max > crit.l) { ### if QE.tau2.max is to the right of crit.l, then upper bound > tau2.max, so set tau2.ub to >tau2.max tau2.ub <- con$tau2.max ub.sign <- ">" ub.conv <- TRUE } else { ### now QE.tau2.min is to the right of crit.l and QE.tau2.max is to the left of crit.l, so upper bound can be found res <- try(uniroot(.QE.func, interval=c(con$tau2.min, con$tau2.max), tol=con$tol, maxiter=con$maxiter, Y=Y, vi=vi, X=X, k=k, objective=crit.l, verbose=verbose, digits=digits)$root, silent=TRUE) ### check if uniroot method converged if (!inherits(res, "try-error")) { tau2.ub <- res ub.conv <- TRUE } } } ### end search for upper bound ################################################################### ### start search for lower bound if (QE.tau2.max > crit.u) { ### if QE.tau2.max is to the right of the crit.u, then both bounds are above tau2.max tau2.lb <- con$tau2.max tau2.ub <- con$tau2.max lb.sign <- ">" ub.sign <- ">" lb.conv <- TRUE ub.conv <- TRUE } else { if (QE.tau2.min < crit.u) { ### if QE.tau2.min is to the left of crit.u, then lower bound < tau2.min, so set tau2.lb to 0) lb.sign <- "<" } else { ### now QE.tau2.min is to the right of crit.u and QE.tau2.max is to the left of crit.u, so lower bound can be found res <- try(uniroot(.QE.func, interval=c(con$tau2.min, con$tau2.max), tol=con$tol, maxiter=con$maxiter, Y=Y, vi=vi, X=X, k=k, objective=crit.u, verbose=verbose, digits=digits)$root, silent=TRUE) ### check if uniroot method converged if (!inherits(res, "try-error")) { tau2.lb <- res lb.conv <- TRUE } } } ### end search for lower bound ################################################################### } ###################################################################### ################### ### GENQ method ### ################### if (type == "genq") { if (!requireNamespace("CompQuadForm", quietly=TRUE)) stop(mstyle$stop("Please install the 'CompQuadForm' package when method='QGEN'.")) A <- diag(weights, nrow=k, ncol=k) stXAX <- .invcalc(X=X, W=A, k=k) P <- A - A %*% X %*% stXAX %*% t(X) %*% A Q <- crossprod(Y,P) %*% Y ### note: .GENQ.func(tau2val, ..., Q=Q, level=0, getlower=TRUE) gives the area to the right of Q for a ### distribution with specified tau2val; and as we increase tau2val, so does the area to the right of Q GENQ.tau2.max <- .GENQ.func(con$tau2.max, P=P, vi=vi, Q=Q, level=0, k=k, p=p, getlower=TRUE) GENQ.tau2.min <- .GENQ.func(con$tau2.min, P=P, vi=vi, Q=Q, level=0, k=k, p=p, getlower=TRUE) ################################################################### ### start search for upper bound if (GENQ.tau2.min > 1 - level/2) { ### if GENQ.tau2.min is to the right of 1 - level/2, then both bounds are below tau2.min tau2.lb <- con$tau2.min tau2.ub <- con$tau2.min lb.sign <- "<" ub.sign <- "<" lb.conv <- TRUE ub.conv <- TRUE ### and if tau2.min = 0, then the CI is equal to the null set if (con$tau2.min <= 0) ci.null <- TRUE } else { if (GENQ.tau2.max < 1 - level/2) { ### if GENQ.tau2.max is to the left of 1 - level/2, then upper bound > tau2.max, so set tau2.ub to >tau2.max tau2.ub <- con$tau2.max ub.sign <- ">" ub.conv <- TRUE } else { ### now GENQ.tau2.min is to the left of 1 - level/2 and GENQ.tau2.max is to the right of 1 - level/2, so upper bound can be found res <- try(uniroot(.GENQ.func, c(con$tau2.min, con$tau2.max), P=P, vi=vi, Q=Q, level=level/2, k=k, p=p, getlower=FALSE, verbose=verbose, digits=digits)$root, silent=TRUE) ### check if uniroot method converged if (!inherits(res, "try-error")) { tau2.ub <- res ub.conv <- TRUE } } } ### end search for upper bound ################################################################### ### start search for lower bound if (GENQ.tau2.max < level/2) { ### if GENQ.tau2.max is to the left of level/2, then both bounds are abova tau2.max tau2.lb <- con$tau2.max tau2.ub <- con$tau2.max lb.sign <- ">" ub.sign <- ">" lb.conv <- TRUE ub.conv <- TRUE } else { if (GENQ.tau2.min > level/2) { ### if GENQ.tau2.min is to the right of level/2, then lower bound < tau2.min, so set tau2.lb to 0) lb.sign <- "<" } else { ### now GENQ.tau2.max is to the right of level/2 and GENQ.tau2.min is to the left of level/2, so lower bound can be found res <- try(uniroot(.GENQ.func, c(con$tau2.min, con$tau2.max), P=P, vi=vi, Q=Q, level=level/2, k=k, p=p, getlower=TRUE, verbose=verbose, digits=digits)$root, silent=TRUE) ### check if uniroot method converged if (!inherits(res, "try-error")) { tau2.lb <- res lb.conv <- TRUE } } } ### end search for lower bound ################################################################### } ###################################################################### ################# ### PL method ### ################# if (type == "pl") { if (con$tau2.min > x$tau2) stop(mstyle$stop("Lower bound of interval to be searched must be <= actual value of component.")) if (con$tau2.max < x$tau2) stop(mstyle$stop("Upper bound of interval to be searched must be >= actual value of component.")) objective <- qchisq(1-level, df=1) ################################################################### ### start search for lower bound ### get diff value when setting component to tau2.min; this value should be positive (i.e., discrepancy must be larger than critical value) ### if it is not, then the lower bound must be below tau2.min res <- try(.profile.rma.uni(con$tau2.min, obj=x, confint=TRUE, objective=objective, verbose=verbose), silent=TRUE) if (!inherits(res, "try-error") && !is.na(res)) { if (res < 0) { tau2.lb <- con$tau2.min lb.conv <- TRUE if (con$tau2.min > 0) lb.sign <- "<" } else { if (.isTRUE(ddd$extint)) { res <- try(uniroot(.profile.rma.uni, interval=c(con$tau2.min, x$tau2), tol=con$tol, maxiter=con$maxiter, extendInt="downX", obj=x, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } else { res <- try(uniroot(.profile.rma.uni, interval=c(con$tau2.min, x$tau2), tol=con$tol, maxiter=con$maxiter, obj=x, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } ### check if uniroot method converged if (!inherits(res, "try-error")) { tau2.lb <- res lb.conv <- TRUE } } } ### end search for lower bound ################################################################### ### start search for upper bound ### get diff value when setting component to tau2.max; this value should be positive (i.e., discrepancy must be larger than critical value) ### if it is not, then the upper bound must be above tau2.max res <- try(.profile.rma.uni(con$tau2.max, obj=x, confint=TRUE, objective=objective, verbose=verbose), silent=TRUE) if (!inherits(res, "try-error") && !is.na(res)) { if (!.isTRUE(ddd$extint) && res < 0) { tau2.ub <- con$tau2.max ub.conv <- TRUE ub.sign <- ">" } else { if (.isTRUE(ddd$extint)) { res <- try(uniroot(.profile.rma.uni, interval=c(x$tau2, con$tau2.max), tol=con$tol, maxiter=con$maxiter, extendInt="upX", obj=x, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } else { res <- try(uniroot(.profile.rma.uni, interval=c(x$tau2, con$tau2.max), tol=con$tol, maxiter=con$maxiter, obj=x, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } ### check if uniroot method converged if (!inherits(res, "try-error")) { tau2.ub <- res ub.conv <- TRUE } } } ### end search for upper bound ################################################################### } ###################################################################### ################# ### HT method ### ################# if (type == "ht") { if (!x$int.only) stop(mstyle$stop("Method only applicable to models without moderators.")) #if (x$method != "DL") # stop(mstyle$stop("Method only applicable when 'method=DL'.")) if (x$k <= 2) stop(mstyle$stop("Method only applicable when k > 2.")) if (x$QE > x$k) { se.lnH <- 1/2 * (log(x$QE) - log(x$k-1)) / (sqrt(2*x$QE) - sqrt(2*x$k-3)) } else { se.lnH <- sqrt(1 / (2*(x$k-2)) * (1 - 1/(3*(x$k-2)^2))) # as in Higgins and Thompson (2002), p. 1549 #se.lnH <- sqrt(1 / ((2*(x$k-2)) * (1 - 1/(3*(x$k-2)^2)))) # as in Borenstein et al. (2009), eq. 16.21 } crit <- qnorm(level/2, lower.tail=FALSE) lb.conv <- TRUE ub.conv <- TRUE #H2.lb <- exp(log(sqrt(x$H2)) - crit * se.lnH)^2 #H2.ub <- exp(log(sqrt(x$H2)) + crit * se.lnH)^2 H2.lb <- exp(log(x$H2) - crit * 2*se.lnH) # note: SE[log(H^2)] = 2*SE[log(H)] H2.ub <- exp(log(x$H2) + crit * 2*se.lnH) I2.lb <- (H2.lb - 1) / H2.lb I2.ub <- (H2.ub - 1) / H2.ub tau2.lb <- max(0, I2.lb * x$vt / (1 - I2.lb)) tau2.ub <- I2.ub * x$vt / (1 - I2.ub) } ###################################################################### if (is.element(type, c("wald","wald.log","wald.sqrt"))) { crit <- qnorm(level/2, lower.tail=FALSE) lb.conv <- TRUE ub.conv <- TRUE } ################### ### Wald method ### ################### if (type == "wald") { tau2.lb <- x$tau2 - crit * x$se.tau2 tau2.ub <- x$tau2 + crit * x$se.tau2 tau2.lb <- max(ifelse(is.null(x$control$tau2.min), 0, x$control$tau2.min), tau2.lb) } ####################### ### Wald.log method ### ####################### if (type == "wald.log") { if (x$tau2 >= 0) { tau2.lb <- exp(log(x$tau2) - crit * x$se.tau2 / x$tau2) tau2.ub <- exp(log(x$tau2) + crit * x$se.tau2 / x$tau2) tau2.ub <- max(x$tau2, tau2.ub) # if tau2 is 0, then CI is 0 to tau2 } } ######################## ### Wald.sqrt method ### ######################## if (type == "wald.sqrt") { if (x$tau2 >= 0) { tau2.lb <- (max(0, sqrt(x$tau2) - crit * x$se.tau2 / (2 * sqrt(x$tau2))))^2 tau2.ub <- (sqrt(x$tau2) + crit * x$se.tau2 / (2 * sqrt(x$tau2)))^2 } } ###################################################################### if (!lb.conv) warning(mstyle$warning("Error in iterative search for the lower bound."), call.=FALSE) if (!ub.conv) warning(mstyle$warning("Error in iterative search for the upper bound."), call.=FALSE) #if (lb.sign == "<" && con$tau2.min > 0) # warning(mstyle$warning("Lower bound < tau2.min. Try decreasing tau2.min (via the 'control' argument)."), call.=FALSE) #if (ub.sign == ">") # warning(mstyle$warning("Upper bound > tau2.max. Try increasing tau2.max (via the 'control' argument)."), call.=FALSE) ###################################################################### I2.lb <- 100 * tau2.lb / (x$vt + tau2.lb) I2.ub <- 100 * tau2.ub / (x$vt + tau2.ub) H2.lb <- tau2.lb / x$vt + 1 H2.ub <- tau2.ub / x$vt + 1 tau2 <- c(x$tau2, tau2.lb, tau2.ub) tau <- sqrt(c(ifelse(x$tau2 >= 0, x$tau2, NA_real_), ifelse(tau2.lb >= 0, tau2.lb, NA_real_), ifelse(tau2.ub >= 0, tau2.ub, NA_real_))) I2 <- c(x$I2, I2.lb, I2.ub) H2 <- c(x$H2, H2.lb, H2.ub) res.random <- rbind("tau^2"=tau2, "tau"=tau, "I^2(%)"=I2, "H^2"=H2) colnames(res.random) <- c("estimate", "ci.lb", "ci.ub") } ######################################################################### ######################################################################### ######################################################################### if (fixed) { if (is.element(x$test, c("knha","adhoc","t"))) { crit <- qt(level/2, df=x$ddf, lower.tail=FALSE) } else { crit <- qnorm(level/2, lower.tail=FALSE) } beta <- c(x$beta) ci.lb <- c(beta - crit * x$se) ci.ub <- c(beta + crit * x$se) if (is.function(transf)) { if (is.null(targs)) { beta <- sapply(beta, transf) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) } else { beta <- sapply(beta, transf, targs) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) } } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] res.fixed <- cbind(estimate=beta, ci.lb=ci.lb, ci.ub=ci.ub) rownames(res.fixed) <- rownames(x$beta) } ######################################################################### ######################################################################### ######################################################################### res <- list() if (fixed) res$fixed <- res.fixed if (random) res$random <- res.random res$digits <- digits if (random) { res$ci.null <- ci.null res$lb.sign <- lb.sign res$ub.sign <- ub.sign res$tau2.min <- con$tau2.min } if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(res) <- "confint.rma" return(res) } metafor/R/reporter.rma.uni.r0000644000176200001440000006662014305070166015521 0ustar liggesusersreporter.rma.uni <- function(x, dir, filename, format="html_document", open=TRUE, digits, forest, funnel, footnotes=FALSE, verbose=TRUE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.uni", notav=c("robust.rma", "rma.ls", "rma.gen", "rma.uni.selmodel")) if (!suppressMessages(suppressWarnings(requireNamespace("rmarkdown", quietly=TRUE)))) stop(mstyle$stop("Please install the 'rmarkdown' package to use the reporter function.")) if (!is.element(x$test, c("z", "knha"))) stop(mstyle$stop("Cannot only use reporter function when test='z' or test='knha'.")) if (!x$weighted) stop(mstyle$stop("Cannot use reporter function when 'weighted=FALSE'.")) if (!is.null(x$weights)) stop(mstyle$stop("Cannot use reporter function for models with custom weights.")) if (is.null(x$tau2.fix)) stop(mstyle$stop("Cannot use reporter function for models with a fixed tau^2 value.")) if (!x$int.only) stop(mstyle$stop("Cannot currently use reporter function for models with moderators. This will be implemented eventually.")) if (x$k == 1) stop(mstyle$stop("Cannot use reporter function when k = 1.")) if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } format <- match.arg(format, c("html_document", "pdf_document", "word_document")) # , "bookdown::pdf_document2")) if (format == "pdf_document" && (Sys.which("pdflatex") == "")) warning(mstyle$warning("Cannot detect pdflatex executable. Rendering the pdf is likely to fail."), call.=FALSE, immediate.=TRUE) ### set/get directory for generating the report if (missing(dir)) { dir <- normalizePath(tempdir(), winslash="/") success <- file.exists(dir) if (!success) stop(mstyle$stop("No temporary directory available for creating the report.")) } else { if (!is.character(dir)) stop(mstyle$stop("Argument 'dir' must be a character string.")) success <- file.exists(dir) if (!success) stop(mstyle$stop("Specified directory does not exist.")) } if (verbose) message(mstyle$message(paste0("\nDirectory for generating the report is: ", dir, "\n"))) ### copy references.bib and apa.csl files to directory for generating the report if (verbose) message(mstyle$message("Copying references.bib and apa.csl to report directory ...")) success <- file.copy(system.file("reporter", "references.bib", package = "metafor"), dir, overwrite=TRUE) if (!success) stop(mstyle$stop("Could not copy 'references.bib' file to report directory.")) success <- file.copy(system.file("reporter", "apa.csl", package = "metafor"), dir, overwrite=TRUE) if (!success) stop(mstyle$stop("Could not copy 'apa.csl' file to report directory.")) ### set default filenames object.name <- deparse1(substitute(x)) has.object.name <- TRUE if (grepl("rma(", object.name, fixed=TRUE) || grepl("rma.uni(", object.name, fixed=TRUE)) { # check for 'reporter(rma(yi, vi))' usage has.object.name <- FALSE object.name <- "res" } if (missing(filename)) { file.rmd <- paste0("report_", object.name, ".rmd") file.obj <- paste0("report_", object.name, ".rdata") file.tex <- paste0("report_", object.name, ".tex") } else { if (!is.character(filename)) stop(mstyle$stop("Argument 'filename' must be a character string.")) file.rmd <- paste0(filename, ".rmd") file.obj <- paste0(filename, ".rdata") file.tex <- paste0(filename, ".tex") } ### process forest argument plot.forest <- TRUE args.forest <- "" if (!missing(forest)) { if (is.logical(forest)) { if (isFALSE(forest)) plot.forest <- FALSE } else { if (!is.character(forest)) stop(mstyle$stop("Argument 'forest' must be a character string.")) args.forest <- paste0(", ", forest) } } ### process funnel argument plot.funnel <- TRUE args.funnel <- "" if (!missing(funnel)) { if (is.logical(funnel)) { if (isFALSE(funnel)) plot.funnel <- FALSE } else { if (!is.character(funnel)) stop(mstyle$stop("Argument 'funnel' must be a character string.")) args.funnel <- paste0(", ", funnel) } } ### forest and funnel plot numbers if (plot.forest) { num.forest <- 1 num.funnel <- 2 } else { num.forest <- NA num.funnel <- 1 } ### save model object if (verbose) message(mstyle$message(paste0("Saving model object to ", file.obj, " ..."))) success <- try(save(x, file=file.path(dir, file.obj))) if (inherits(success, "try-error")) stop(mstyle$stop("Could not save model object to report directory.")) ### open rmd file connection if (verbose) message(mstyle$message(paste0("Creating ", file.rmd, " file ..."))) con <- try(file(file.path(dir, file.rmd), "w")) if (inherits(con, "try-error")) stop(mstyle$stop("Could not create .rmd file in report directory.")) ### get measure name measure <- tolower(.setlab(x$measure, transf.char="FALSE", atransf.char="FALSE", gentype=1)) measure <- sub("observed outcome", "outcome", measure) measure <- sub("fisher's z", "Fisher r-to-z", measure) measure <- sub("yule", "Yule", measure) measure <- sub("freeman", "Freeman", measure) measure <- sub("tukey", "Tukey", measure) measure <- sub("log ratio of means", "response ratio", measure) ### model type if (x$int.only) { if (is.element(x$method, c("FE","EE","CE"))) { model <- x$method } else { model <- "RE" } } else { if (is.element(x$method, c("FE","EE","CE"))) { model <- "MR" } else { model <- "ME" } } model.name <- c(FE = "fixed-effects", EE = "equal-effects", CE = "common-effects", MR = "(fixed-effects) meta-regression", RE = "random-effects", ME = "(mixed-effects) meta-regression")[model] ### get tau^2 estimator name and set reference tau2.method <- c(FE = "", HS = "Hunter-Schmidt", HSk = "k-corrected Hunter-Schmidt", HE = "Hedges'", DL = "DerSimonian-Laird", GENQ = "generalized Q-statistic", GENQM = "(median-unbiased) generalized Q-statistic", SJ = "Sidik-Jonkman", ML = "maximum-likelihood", REML = "restricted maximum-likelihood", EB = "empirical Bayes", PM = "Paule-Mandel", PMM = "(median-unbiased) Paule-Mandel")[x$method] if (x$method == "HS" && model == "RE") tau2.ref <- "[@hunter1990; @viechtbauer2005]" if (x$method == "HS" && model == "ME") tau2.ref <- "[@hunter1990; @viechtbauer2015]" if (x$method == "HSk" && model == "RE") tau2.ref <- "[@brannick2019; @hunter1990; @viechtbauer2005]" if (x$method == "HSk" && model == "ME") tau2.ref <- "[@brannick2019; @hunter1990; @viechtbauer2015]" if (x$method == "HE" && model == "RE") tau2.ref <- "[@hedges1985]" if (x$method == "HE" && model == "ME") tau2.ref <- "[@hedges1992]" if (x$method == "DL" && model == "RE") tau2.ref <- "[@dersimonian1986]" if (x$method == "DL" && model == "ME") tau2.ref <- "[@raudenbush2009]" if (x$method == "GENQ" && model == "RE") tau2.ref <- "[@dersimonian2007]" if (x$method == "GENQ" && model == "ME") tau2.ref <- "[@jackson2014]" if (x$method == "GENQM") tau2.ref <- "[@viechtbauer2021]" if (x$method == "SJ") tau2.ref <- "[@sidik2005]" if (x$method == "ML" && model == "RE") tau2.ref <- "[@hardy1996]" if (x$method == "ML" && model == "ME") tau2.ref <- "[@raudenbush2009]" if (x$method == "REML" && model == "RE") tau2.ref <- "[@viechtbauer2005]" if (x$method == "REML" && model == "ME") tau2.ref <- "[@raudenbush2009]" if (x$method == "EB" && model == "RE") tau2.ref <- "[@morris1983]" if (x$method == "EB" && model == "ME") tau2.ref <- "[@berkey1995]" if (is.element(x$method, c("PM","MP")) && model == "RE") tau2.ref <- "[@paule1982]" if (is.element(x$method, c("PM","MP")) && model == "ME") tau2.ref <- "[@viechtbauer2015]" if (x$method == "PMM") tau2.ref <- "[@viechtbauer2021]" ### Q-test reference if (is.element(model, c("FE","EE","CE","RE"))) { qtest.ref <- "[@cochran1954]" } else { qtest.ref <- "[@hedges1983]" } ### CI level level <- 100 * (1-x$level) ### Bonferroni-corrected critical value for studentized residuals crit <- qnorm(x$level/(2*x$k), lower.tail=FALSE) ### get influence results infres <- influence(x) ### formating function for p-values fpval <- function(p, pdigits=digits[["pval"]]) paste0("$p ", ifelse(p < 10^(-pdigits), paste0("< ", fmtx(10^(-pdigits), pdigits)), paste0("= ", fmtx(p, pdigits))), "$") # consider giving only 2 digits for p-value if p > .05 or p > .10 ######################################################################### ### yaml header header <- paste0("---\n") header <- paste0(header, "output:\n") if (format == "html_document") header <- paste0(header, " html_document:\n toc: true\n toc_float:\n collapsed: false\n") if (format == "pdf_document") header <- paste0(header, " pdf_document:\n toc: true\n") if (format == "word_document") header <- paste0(header, " word_document\n") header <- paste0(header, "title: Analysis Report\n") header <- paste0(header, "toc-title: Table of Contents\n") header <- paste0(header, "author: Generated with the reporter() Function of the metafor Package\n") header <- paste0(header, "bibliography: references.bib\n") header <- paste0(header, "csl: apa.csl\n") header <- paste0(header, "date: \"`r format(Sys.time(), '%d %B, %Y')`\"\n") header <- paste0(header, "---\n") ######################################################################### ### rsetup rsetup <- paste0("```{r, setup, include=FALSE}\n") rsetup <- paste0(rsetup, "library(metafor)\n") rsetup <- paste0(rsetup, "load('", file.path(dir, file.obj), "')\n") rsetup <- paste0(rsetup, "```") ######################################################################### ### methods section methods <- "\n## Methods\n\n" if (x$measure != "GEN") methods <- paste0(methods, "The analysis was carried out using the ", measure, " as the outcome measure. ") methods <- paste0(methods, "A", ifelse(model.name == "equal-effects", "n ", " "), model.name, " model was fitted to the data. ") if (is.element(model, c("RE", "ME"))) methods <- paste0(methods, "The amount of ", ifelse(x$int.only, "", "residual "), "heterogeneity (i.e., $\\tau^2$), was estimated using the ", tau2.method, " estimator ", tau2.ref, ". ") if (is.element(model, c("FE","EE","CE"))) methods <- paste0(methods, "The $Q$-test for heterogeneity ", qtest.ref, " and the $I^2$ statistic [@higgins2002] are reported. ") if (model == "MR") methods <- paste0(methods, "The $Q$-test for residual heterogeneity ", qtest.ref, " is reported. ") if (model == "RE") methods <- paste0(methods, "In addition to the estimate of $\\tau^2$, the $Q$-test for heterogeneity ", qtest.ref, " and the $I^2$ statistic [@higgins2002] are reported. ") if (model == "ME") methods <- paste0(methods, "In addition to the estimate of $\\tau^2$, the $Q$-test for residual heterogeneity ", qtest.ref, " is reported. ") if (model == "RE") methods <- paste0(methods, "In case any amount of heterogeneity is detected (i.e., $\\hat{\\tau}^2 > 0$, regardless of the results of the $Q$-test), a prediction interval for the true outcomes is also provided [@riley2011]. ") if (x$test == "knha") methods <- paste0(methods, "Tests and confidence intervals were computed using the Knapp and Hartung method [@knapp2003]. ") methods <- paste0(methods, "Studentized residuals and Cook's distances are used to examine whether studies may be outliers and/or influential in the context of the model [@viechtbauer2010b]. ") #methods <- paste0(methods, "Studies with a studentized residual larger than $\\pm 1.96$ are considered potential outliers. ") methods <- paste0(methods, "Studies with a studentized residual larger than the $100 \\times (1 - ", x$level, "/(2 \\times k))$th percentile of a standard normal distribution are considered potential outliers (i.e., using a Bonferroni correction with two-sided $\\alpha = ", x$level, "$ for $k$ studies included in the meta-analysis). ") # $\\pm ", fmtx(crit, digits[["test"]]), "$ ( #methods <- paste0(methods, "Studies with a Cook's distance larger than ", fmtx(qchisq(0.5, df=infres$m), digits[["test"]]), " (the 50th percentile of a $\\chi^2$-distribution with ", infres$m, " degree", ifelse(infres$m > 1, "s", ""), " of freedom) are considered to be influential. ") methods <- paste0(methods, "Studies with a Cook's distance larger than the median plus six times the interquartile range of the Cook's distances are considered to be influential.") methods <- if (footnotes) paste0(methods, "[^cook] ") else paste0(methods, " ") if (is.element(model, c("FE","EE","CE","RE"))) methods <- paste0(methods, "The rank correlation test [@begg1994] and the regression test [@sterne2005], using the standard error of the observed outcomes as predictor, are used to check for funnel plot asymmetry. ") if (is.element(model, c("MR","ME"))) methods <- paste0(methods, "The regression test [@sterne2005], using the standard error of the observed outcomes as predictor (in addition to the moderators already included in the model), is used to check for funnel plot asymmetry. ") methods <- paste0(methods, "The analysis was carried out using R (version ", getRversion(), ") [@rcore2020] and the **metafor** package (version ", x$version, ") [@viechtbauer2010a]. ") ######################################################################### ### results section results <- "\n## Results\n\n" ### number of studies results <- paste0(results, "A total of $k=", x$k, "$ studies were included in the analysis. ") ### range of observed outcomes results <- paste0(results, "The observed ", measure, "s ranged from $", fmtx(min(x$yi), digits[["est"]]), "$ to $", fmtx(max(x$yi), digits[["est"]]), "$, ") ### percent positive/negative results <- paste0(results, "with the majority of estimates being ", ifelse(mean(x$yi > 0) > .50, "positive", "negative"), " (", ifelse(mean(x$yi > 0) > .50, round(100*mean(x$yi > 0)), round(100*mean(x$yi < 0))), "%). ") if (is.element(model, c("FE","EE","CE","RE"))) { ### estimated average outcome with CI results <- paste0(results, "The estimated average ", measure, " based on the ", model.name, " model was ", ifelse(is.element(model, c("FE","EE","CE")), "$\\hat{\\theta} = ", "$\\hat{\\mu} = "), fmtx(c(x$beta), digits[["est"]]), "$ ") results <- paste0(results, "(", level, "% CI: $", fmtx(x$ci.lb, digits[["ci"]]), "$ to $", fmtx(x$ci.ub, digits[["ci"]]), "$). ") ### note: for some outcome measures (e.g., proportions), the test H0: mu/theta = 0 is not really relevant; maybe check for this results <- paste0(results, "Therefore, the average outcome ", ifelse(x$pval > 0.05, "did not differ", "differed"), " significantly from zero ($", ifelse(x$test == "z", "z", paste0("t(", x$k-1, ")")), " = ", fmtx(x$zval, digits[["test"]]), "$, ", fpval(x$pval), "). ") ### forest plot if (plot.forest) { results <- paste0(results, "A forest plot showing the observed outcomes and the estimate based on the ", model.name, " model is shown in Figure ", num.forest, ".\n\n") if (is.element(format, c("pdf_document", "bookdown::pdf_document2"))) results <- paste0(results, "```{r, forestplot, echo=FALSE, fig.align=\"center\", fig.cap=\"Forest plot showing the observed outcomes and the estimate of the ", model.name, " model\"") if (format == "html_document") results <- paste0(results, "```{r, forestplot, echo=FALSE, fig.align=\"center\", fig.cap=\"Figure ", num.forest, ": Forest plot showing the observed outcomes and the estimate of the ", model.name, " model\"") if (format == "word_document") results <- paste0(results, "```{r, forestplot, echo=FALSE, fig.cap=\"Figure ", num.forest, ": Forest plot showing the observed outcomes and the estimate of the ", model.name, " model\"") results <- paste0(results, ", dev.args=list(pointsize=9)}\npar(family=\"mono\")\npar(mar=c(5,4,1,2))\ntmp <- metafor::forest(x, addpred=TRUE, header=TRUE", args.forest, ")\n```") #text(tmp$xlim[1], x$k+2, \"Study\", pos=4, font=2, cex=tmp$cex)\ntext(tmp$xlim[2], x$k+2, \"Outcome [", level, "% CI]\", pos=2, font=2, cex=tmp$cex)\n } results <- paste0(results, "\n\n") ### test for heterogeneity if (x$QEp > 0.10) results <- paste0(results, "According to the $Q$-test, there was no significant amount of heterogeneity in the true outcomes ") if (x$QEp > 0.05 && x$QEp <= 0.10) results <- paste0(results, "The $Q$-test for heterogeneity was not significant, but some heterogeneity may still be present in the true outcomes ") if (x$QEp <= 0.05) results <- paste0(results, "According to the $Q$-test, the true outcomes appear to be heterogeneous ") results <- paste0(results, "($Q(", x$k-1, ") = ", fmtx(x$QE, digits[["test"]]), "$, ", fpval(x$QEp)) ### tau^2 estimate (only for RE models) if (model == "RE") results <- paste0(results, ", $\\hat{\\tau}^2 = ", fmtx(x$tau2, digits[["var"]]), "$") ### I^2 statistic results <- paste0(results, ", $I^2 = ", fmtx(x$I2, digits[["het"]]), "$%). ") ### for the RE model, when any amount of heterogeneity is detected, provide prediction interval and note whether the directionality of effects is consistent or not if (model == "RE" && x$tau2 > 0) { pred <- predict(x) results <- paste0(results, "A ", level, "% prediction interval for the true outcomes is given by $", fmtx(pred$pi.lb, digits[["ci"]]), "$ to $", fmtx(pred$pi.ub, digits[["ci"]]), "$. ") if (c(x$beta) > 0 && pred$pi.lb < 0) results <- paste0(results, "Hence, although the average outcome is estimated to be positive, in some studies the true outcome may in fact be negative.") if (c(x$beta) < 0 && pred$pi.ub > 0) results <- paste0(results, "Hence, although the average outcome is estimated to be negative, in some studies the true outcome may in fact be positive.") if ((c(x$beta) > 0 && pred$pi.lb > 0) || (c(x$beta) < 0 && pred$pi.ub < 0)) results <- paste0(results, "Hence, even though there may be some heterogeneity, the true outcomes of the studies are generally in the same direction as the estimated average outcome.") } results <- paste0(results, "\n\n") ### check if some studies have very large weights relatively speaking largeweight <- weights(x)/100 >= 3 / x$k if (any(largeweight)) { if (sum(largeweight) == 1) results <- paste0(results, "One study (", names(largeweight)[largeweight], ") had a relatively large weight ") if (sum(largeweight) == 2) results <- paste0(results, "Two studies (", paste(names(largeweight)[largeweight], collapse="; "), ") had relatively large weights ") if (sum(largeweight) >= 3) results <- paste0(results, "Several studies (", paste(names(largeweight)[largeweight], collapse="; "), ") had relatively large weights ") results <- paste0(results, "compared to the rest of the studies (i.e., $\\mbox{weight} \\ge 3/k$, so a weight at least 3 times as large as having equal weights across studies). ") } ### check for outliers zi <- infres$inf$rstudent abszi <- abs(zi) results <- paste0(results, "An examination of the studentized residuals revealed that ") if (all(abszi < crit, na.rm=TRUE)) results <- paste0(results, "none of the studies had a value larger than $\\pm ", fmtx(crit, digits[["test"]]), "$ and hence there was no indication of outliers ") if (sum(abszi >= crit, na.rm=TRUE) == 1) results <- paste0(results, "one study (", infres$inf$slab[abszi >= crit & !is.na(abszi)], ") had a value larger than $\\pm ", fmtx(crit, digits[["test"]]), "$ and may be a potential outlier ") if (sum(abszi >= crit, na.rm=TRUE) == 2) results <- paste0(results, "two studies (", paste(infres$inf$slab[abszi >= crit & !is.na(abszi)], collapse="; "), ") had values larger than $\\pm ", fmtx(crit, digits[["test"]]), "$ and may be potential outliers ") if (sum(abszi >= crit, na.rm=TRUE) >= 3) results <- paste0(results, "several studies (", paste(infres$inf$slab[abszi >= crit & !is.na(abszi)], collapse="; "), ") had values larger than $\\pm ", fmtx(crit, digits[["test"]]), "$ and may be potential outliers ") results <- paste0(results, "in the context of this model. ") ### check for influential cases #is.infl <- pchisq(infres$inf$cook.d, df=1) > .50 is.infl <- infres$inf$cook.d > median(infres$inf$cook.d, na.rm=TRUE) + 6 * IQR(infres$inf$cook.d, na.rm=TRUE) results <- paste0(results, "According to the Cook's distances, ") if (all(!is.infl, na.rm=TRUE)) results <- paste0(results, "none of the studies ") if (sum(is.infl, na.rm=TRUE) == 1) results <- paste0(results, "one study (", infres$inf$slab[is.infl & !is.na(abszi)], ") ") if (sum(is.infl, na.rm=TRUE) == 2) results <- paste0(results, "two studies (", paste(infres$inf$slab[is.infl & !is.na(abszi)], collapse="; "), ") ") if (sum(is.infl, na.rm=TRUE) >= 3) results <- paste0(results, "several studies (", paste(infres$inf$slab[is.infl & !is.na(abszi)], collapse="; "), ") ") results <- paste0(results, "could be considered to be overly influential.") results <- paste0(results, "\n\n") ### publication bias ranktest <- suppressWarnings(ranktest(x)) regtest <- regtest(x) if (plot.funnel) results <- paste0(results, "A funnel plot of the estimates is shown in Figure ", num.funnel, ". ") if (ranktest$pval > .05 && regtest$pval > .05) { results <- paste0(results, "Neither the rank correlation nor the regression test indicated any funnel plot asymmetry ") results <- paste0(results, "(", fpval(ranktest$pval), " and ", fpval(regtest$pval), ", respectively). ") } if (ranktest$pval <= .05 && regtest$pval <= .05) { results <- paste0(results, "Both the rank correlation and the regression test indicated potential funnel plot asymmetry ") results <- paste0(results, "(", fpval(ranktest$pval), " and ", fpval(regtest$pval), ", respectively). ") } if (ranktest$pval > .05 && regtest$pval <= .05) results <- paste0(results, "The regression test indicated funnel plot asymmetry (", fpval(regtest$pval), ") but not the rank correlation test (", fpval(ranktest$pval), "). ") if (ranktest$pval <= .05 && regtest$pval > .05) results <- paste0(results, "The rank correlation test indicated funnel plot asymmetry ($", fpval(ranktest$pval), ") but not the regression test (", fpval(regtest$pval), "). ") ### funnel plot if (plot.funnel) { if (is.element(format, c("pdf_document", "bookdown::pdf_document2"))) results <- paste0(results, "\n\n```{r, funnelplot, echo=FALSE, fig.align=\"center\", fig.cap=\"Funnel plot\", dev.args=list(pointsize=9)}\npar(mar=c(5,4,2,2))\nmetafor::funnel(x", args.funnel, ")\n```") if (format == "html_document") results <- paste0(results, "\n\n```{r, funnelplot, echo=FALSE, fig.align=\"center\", fig.cap=\"Figure ", num.funnel, ": Funnel plot\", dev.args=list(pointsize=9)}\npar(mar=c(5,4,2,2))\nmetafor::funnel(x", args.funnel, ")\n```") if (format == "word_document") results <- paste0(results, "\n\n```{r, funnelplot, echo=FALSE, fig.cap=\"Figure ", num.funnel, ": Funnel plot\", dev.args=list(pointsize=9)}\npar(mar=c(5,4,2,2))\nmetafor::funnel(x", args.funnel, ")\n```") } } if (is.element(model, c("MR", "ME"))) { if (x$int.incl) { mods <- colnames(x$X)[-1] p <- x$p - 1 } else { mods <- colnames(x$X) p <- x$p } results <- paste0(results, "The meta-regression model included ", p, " predictor", ifelse(p > 1, "s ", " ")) if (p == 1) results <- paste0(results, "(i.e., '", mods, "').") if (p == 2) results <- paste0(results, "(i.e., '", mods[1], "' and '", mods[2], "').") if (p >= 3) results <- paste0(results, "(i.e., ", paste0("'", mods[-p], "'", collapse=", "), " and ", mods[p], ").") } # 95% CI for tau^2 and I^2 # table for meta-regression model # links to help pages for functions used ######################################################################### ### notes section notes <- "\n## Notes\n\n" notes <- paste0(notes, "This analysis report was dynamically generated ", ifelse(has.object.name, paste0("for model object '`", object.name, "`'"), ""), " with the `reporter()` function of the **metafor** package. ") call <- capture.output(x$call) call <- trimws(call, which="left") call <- paste(call, collapse="") notes <- paste0(notes, "The model call that was used to fit the model was '`", call, "`'. ") notes <- paste0(notes, "This report provides an illustration of how the results of the model can be reported, but is not a substitute for a careful examination of the results.") ######################################################################### ### references section references <- "\n## References\n" ######################################################################### if (footnotes) { fnotes <- "" fnotes <- paste0(fnotes, "[^cook]: This is a somewhat arbitrary rule, but tends to detect 'spikes' in a plot of the Cook's distances fairly accurately. A better rule may be implemented in the future.") } ######################################################################### ### write sections to rmd file writeLines(header, con) writeLines(rsetup, con) writeLines(methods, con) writeLines(results, con) writeLines(notes, con) writeLines(references, con) if (footnotes) writeLines(fnotes, con) ### close rmd file connection close(con) ### render rmd file if (verbose) message(mstyle$message(paste0("Rendering ", file.rmd, " file ..."))) if (verbose >= 2) { file.out <- rmarkdown::render(file.path(dir, file.rmd), output_format=format, quiet=ifelse(verbose <= 1, TRUE, FALSE)) } else { file.out <- suppressWarnings(rmarkdown::render(file.path(dir, file.rmd), output_format=format, quiet=ifelse(verbose <= 1, TRUE, FALSE))) } if (verbose) message(mstyle$message(paste0("Generated ", file.out, " ..."))) ### render() sometimes fails to delete the intermediate tex file, so in case this happens clean up ### see also: https://github.com/rstudio/rmarkdown/issues/1308 if (file.exists(file.path(dir, file.tex))) unlink(file.path(dir, file.tex)) ### try to open output file if (open) { if (verbose) message(mstyle$message(paste0("Opening report ...\n"))) if (.Platform$OS.type == "windows") { shell.exec(file.out) } else { optb <- getOption("browser") if (is.function(optb)) { invisible(optb(file.out)) } else { system(paste0(optb, " '", file.out, "'")) } } } invisible(file.out) } metafor/R/forest.rma.r0000644000176200001440000012202114504562314014355 0ustar liggesusersforest.rma <- function(x, annotate=TRUE, addfit=TRUE, addpred=FALSE, showweights=FALSE, header=FALSE, xlim, alim, olim, ylim, at, steps=5, level=x$level, refline=0, digits=2L, width, xlab, slab, mlab, ilab, ilab.xpos, ilab.pos, order, transf, atransf, targs, rows, efac=1, pch, psize, plim=c(0.5,1.5), colout, col, border, shade, colshade, lty, fonts, cex, cex.lab, cex.axis, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma", notav=c("rma.ls", "rma.gen")) na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (missing(transf)) transf <- FALSE if (missing(atransf)) atransf <- FALSE transf.char <- deparse(transf) atransf.char <- deparse(atransf) if (is.function(transf) && is.function(atransf)) stop(mstyle$stop("Use either 'transf' or 'atransf' to specify a transformation (not both).")) .start.plot() if (missing(targs)) targs <- NULL if (missing(at)) at <- NULL mf <- match.call() if (missing(ilab)) { ilab <- NULL } else { ilab <- .getx("ilab", mf=mf, data=x$data) } if (missing(ilab.xpos)) ilab.xpos <- NULL if (missing(ilab.pos)) ilab.pos <- NULL if (missing(order)) { order <- NULL } else { order <- .getx("order", mf=mf, data=x$data) } if (missing(colout)) { colout <- par("fg") } else { colout <- .getx("colout", mf=mf, data=x$data) } if (missing(shade)) { shade <- NULL } else { shade <- .getx("shade", mf=mf, data=x$data) } if (missing(colshade)) colshade <- .coladj(par("bg","fg"), dark=0.1, light=-0.1) if (missing(pch)) { pch <- 15 } else { pch <- .getx("pch", mf=mf, data=x$data) } if (missing(psize)) { psize <- NULL } else { psize <- .getx("psize", mf=mf, data=x$data) } if (missing(cex)) cex <- NULL if (missing(cex.lab)) cex.lab <- NULL if (missing(cex.axis)) cex.axis <- NULL level <- .level(level) ### digits[1] for annotations, digits[2] for x-axis labels, digits[3] (if specified) for weights ### note: digits can also be a list (e.g., digits=list(2,3L)); trailing 0's on the x-axis labels ### are dropped if the value is an integer if (length(digits) == 1L) digits <- c(digits,digits,digits) if (length(digits) == 2L) digits <- c(digits,digits[[1]]) ddd <- list(...) ############################################################################ ### set default colors if user has not specified 'col' and 'border' arguments if (x$int.only) { if (missing(col)) { col <- c(par("fg"), .coladj(par("fg"), dark=-0.3, light=0.3)) # 1st = summary polygon, 2nd = PI } else { if (length(col) == 1L) # if user only specified one value, assume it is for the summary polygon col <- c(col, .coladj(col, dark=-0.3, light=0.3)) } if (missing(border)) border <- par("fg") # border color of summary polygon } else { if (missing(col)) col <- .coladj(par("bg","fg"), dark=0.2, light=-0.2) # color for fitted value polygons if (missing(border)) border <- .coladj(par("bg","fg"), dark=0.3, light=-0.3) } ### set default line types if user has not specified 'lty' argument if (missing(lty)) { lty <- c("solid", "dotted", "solid") # 1st = CIs, 2nd = PI, 3rd = horizontal line(s) } else { if (length(lty) == 1L) lty <- c(lty, "dotted", "solid") if (length(lty) == 2L) lty <- c(lty, "solid") } ### vertical expansion factor: 1st = CI/PI end lines, 2nd = arrows, 3rd = summary polygon or fitted polygons if (length(efac) == 1L) efac <- rep(efac, 3L) if (length(efac) == 2L) efac <- c(efac[1], efac[1], efac[2]) # if 2 values specified: 1st = CI/PI end lines and arrows, 2nd = summary polygon or fitted polygons ### annotation symbols vector if (is.null(ddd$annosym)) { annosym <- c(" [", ", ", "]", "-", " ") # 4th element for minus sign symbol; 5th for space (in place of numbers and +); see [a] } else { annosym <- ddd$annosym if (length(annosym) == 3L) annosym <- c(annosym, "-", " ") if (length(annosym) == 4L) annosym <- c(annosym, " ") if (length(annosym) != 5L) stop(mstyle$stop("Argument 'annosym' must be a vector of length 3 (or 4 or 5).")) } ### adjust annosym for tabular figures if (isTRUE(ddd$tabfig == 1)) annosym <- c("\u2009[", ",\u2009", "]", "\u2212", "\u2002") # \u2009 thin space; \u2212 minus, \u2002 en space if (isTRUE(ddd$tabfig == 2)) annosym <- c("\u2009[", ",\u2009", "]", "\u2013", "\u2002") # \u2009 thin space; \u2013 en dash, \u2002 en space if (isTRUE(ddd$tabfig == 3)) annosym <- c("\u2009[", ",\u2009", "]", "\u2212", "\u2007") # \u2009 thin space; \u2212 minus, \u2007 figure space ### get measure from object measure <- x$measure ### column header estlab <- .setlab(measure, transf.char, atransf.char, gentype=3, short=TRUE) if (is.expression(estlab)) { header.right <- str2lang(paste0("bold(", estlab, " * '", annosym[1], "' * '", 100*(1-level), "% CI'", " * '", annosym[3], "')")) } else { header.right <- paste0(estlab, annosym[1], 100*(1-level), "% CI", annosym[3]) } if (is.logical(header)) { if (header) { header.left <- "Study" } else { header.left <- NULL header.right <- NULL } } else { if (!is.character(header)) stop(mstyle$stop("Argument 'header' must either be a logical or character vector.")) if (length(header) == 1L) { header.left <- header } else { header.left <- header[1] header.right <- header[2] } } if (!annotate) header.right <- NULL if (!is.null(ddd$addcred)) addpred <- ddd$addcred if (is.null(ddd$pi.type)) { pi.type <- "default" } else { pi.type <- ddd$pi.type } if (is.null(ddd$decreasing)) { decreasing <- FALSE } else { decreasing <- ddd$decreasing } if (!is.null(ddd$clim)) olim <- ddd$clim ### row adjustments for 1) study labels, 2) annotations, and 3) ilab elements if (is.null(ddd$rowadj)) { rowadj <- rep(0,3) } else { rowadj <- ddd$rowadj if (length(rowadj) == 1L) rowadj <- c(rowadj,rowadj,0) # if one value is specified, use it for both 1&2 if (length(rowadj) == 2L) rowadj <- c(rowadj,0) # if two values are specified, use them for 1&2 } if (is.null(ddd$top)) { top <- 3 } else { top <- ddd$top } if (is.null(ddd$xlabadj)) { xlabadj <- c(NA,NA) } else { xlabadj <- ddd$xlabadj if (length(xlabadj) == 1L) xlabadj <- c(xlabadj, 1-xlabadj) } if (is.null(ddd$xlabfont)) { xlabfont <- 1 } else { xlabfont <- ddd$xlabfont } lplot <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) plot(...) labline <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) abline(...) lsegments <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) segments(...) laxis <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) axis(...) lmtext <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) mtext(...) lpolygon <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) polygon(...) ltext <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) text(...) lpoints <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) points(...) if (is.character(showweights)) { weighttype <- match.arg(showweights, c("diagonal", "rowsum")) if (weighttype == "rowsum" && !inherits(x, "rma.mv")) weighttype <- "diagonal" if (weighttype == "rowsum" && !x$int.only) stop(mstyle$stop("Row-sum weights are only meaningful for intercept-only models.")) showweights <- TRUE } else { weighttype <- "diagonal" } if (!is.logical(showweights)) stop(mstyle$stop("Argument 'showweights' must be a logical.")) ### TODO: remove this when there is a weights() function for 'rma.glmm' objects if (inherits(x, "rma.glmm") && showweights) stop(mstyle$stop("Option 'showweights=TRUE' not possible for 'rma.glmm' objects.")) ### TODO: remove this when there is a weights() function for 'rma.uni.selmodel' objects if (inherits(x, "rma.uni.selmodel") && showweights) stop(mstyle$stop("Option 'showweights=TRUE' not possible for 'rma.uni.selmodel' objects.")) if (!is.null(ddd$subset)) stop(mstyle$stop("Function does not have a 'subset' argument.")) ######################################################################### ### extract data and study labels ### note: yi.f/vi.f and pred may contain NAs yi <- x$yi.f vi <- x$vi.f X <- x$X.f k <- length(yi) # length of yi.f ### note: slab (if specified), ilab (if specified), pch (if vector), psize (if ### vector), colout (if vector), order (if vector) must have the same ### length as the original dataset slab.null <- FALSE if (missing(slab)) { if (x$slab.null) { slab <- paste("Study", x$ids) # x$ids is always of length yi.f (i.e., NAs also have an id) slab.null <- TRUE } else { slab <- x$slab # x$slab is always of length yi.f (i.e., NAs also have a study label) } } else { slab <- .getx("slab", mf=mf, data=x$data) if (length(slab) == 1L && is.na(slab)) { # slab=NA can be used to suppress study labels slab <- rep("", x$k.all) slab.null <- TRUE } if (length(slab) != x$k.all) stop(mstyle$stop(paste0("Length of the 'slab' argument (", length(slab), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) slab <- .getsubset(slab, x$subset) } if (!is.null(ilab)) { if (is.null(dim(ilab))) ilab <- cbind(ilab) if (nrow(ilab) != x$k.all) stop(mstyle$stop(paste0("Length of the 'ilab' argument (", nrow(ilab), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) ilab <- .getsubset(ilab, x$subset) } if (length(pch) == 1L) pch <- rep(pch, x$k.all) if (length(pch) != x$k.all) stop(mstyle$stop(paste0("Length of the 'pch' argument (", length(pch), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) pch <- .getsubset(pch, x$subset) if (!is.null(psize)) { if (length(psize) == 1L) psize <- rep(psize, x$k.all) if (length(psize) != x$k.all) stop(mstyle$stop(paste0("Length of the 'psize' argument (", length(psize), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) psize <- .getsubset(psize, x$subset) } if (length(colout) == 1L) colout <- rep(colout, x$k.all) if (length(colout) != x$k.all) stop(mstyle$stop(paste0("Length of the 'colout' argument (", length(colout), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) colout <- .getsubset(colout, x$subset) shade.type <- "none" if (is.character(shade)) { shade.type <- "character" shade <- shade[1] if (!is.element(shade, c("zebra", "zebra1", "zebra2", "all"))) stop(mstyle$stop("Unknown option specified for 'shade' argument.")) } if (is.logical(shade)) { if (length(shade) == 1L) { shade <- "zebra" shade.type <- "character" } else { shade.type <- "logical" shade <- .chksubset(shade, x$k.all, stoponk0=FALSE) shade <- .getsubset(shade, x$subset) } } if (is.numeric(shade)) shade.type <- "numeric" ### extract fitted values options(na.action = "na.pass") # using na.pass to get the entire vector (length of yi.f) if (x$int.only) { pred <- fitted(x) pred.ci.lb <- rep(NA_real_, k) pred.ci.ub <- rep(NA_real_, k) } else { temp <- predict(x, level=level, pi.type=pi.type) pred <- temp$pred if (addpred) { pred.ci.lb <- temp$pi.lb pred.ci.ub <- temp$pi.ub } else { pred.ci.lb <- temp$ci.lb pred.ci.ub <- temp$ci.ub } } weights <- try(weights(x, type=weighttype), silent=TRUE) # does not work for rma.glmm and rma.uni.selmodel objects if (inherits(weights, "try-error")) weights <- rep(1, k) ### sort the data if requested if (!is.null(order)) { if (length(order) == 1L) { order <- match.arg(order, c("obs", "yi", "fit", "prec", "vi", "resid", "rstandard", "abs.resid", "abs.rstandard")) if (order == "obs" || order == "yi") sort.vec <- order(yi) if (order == "fit") sort.vec <- order(pred) if (order == "prec" || order == "vi") sort.vec <- order(vi, yi) if (order == "resid") sort.vec <- order(yi-pred, yi) if (order == "rstandard") sort.vec <- order(rstandard(x)$z, yi) # need options(na.action = "na.pass") here as well if (order == "abs.resid") sort.vec <- order(abs(yi-pred), yi) if (order == "abs.rstandard") sort.vec <- order(abs(rstandard(x)$z), yi) # need options(na.action = "na.pass") here as well } else { if (length(order) != x$k.all) stop(mstyle$stop(paste0("Length of the 'order' argument (", length(order), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) if (grepl("^order\\(", deparse1(substitute(order)))) { sort.vec <- order } else { sort.vec <- order(order, decreasing=decreasing) } if (!is.null(x$subset)) sort.vec <- .getsubset(sort.vec, x$subset) - sum(!x$subset) } yi <- yi[sort.vec] vi <- vi[sort.vec] X <- X[sort.vec,,drop=FALSE] slab <- slab[sort.vec] ilab <- ilab[sort.vec,,drop=FALSE] # if NULL, remains NULL pred <- pred[sort.vec] pred.ci.lb <- pred.ci.lb[sort.vec] pred.ci.ub <- pred.ci.ub[sort.vec] weights <- weights[sort.vec] pch <- pch[sort.vec] psize <- psize[sort.vec] # if NULL, remains NULL colout <- colout[sort.vec] if (shade.type == "logical") shade <- shade[sort.vec] } options(na.action = na.act) k <- length(yi) # in case length of k has changed ### set rows value if (missing(rows)) { rows <- k:1 } else { if (length(rows) == 1L) { # note: rows must be a single value or the same rows <- rows:(rows-k+1) # length of yi.f (including NAs) *after ordering* } } if (length(rows) != k) stop(mstyle$stop(paste0("Length of the 'rows' argument (", length(rows), ") does not correspond to the number of outcomes (", k, ")."))) ### reverse order yi <- yi[k:1] vi <- vi[k:1] X <- X[k:1,,drop=FALSE] slab <- slab[k:1] ilab <- ilab[k:1,,drop=FALSE] # if NULL, remains NULL pred <- pred[k:1] pred.ci.lb <- pred.ci.lb[k:1] pred.ci.ub <- pred.ci.ub[k:1] weights <- weights[k:1] pch <- pch[k:1] psize <- psize[k:1] # if NULL, remains NULL colout <- colout[k:1] rows <- rows[k:1] if (shade.type == "logical") shade <- shade[k:1] ### check for NAs in yi/vi/X and act accordingly yiviX.na <- is.na(yi) | is.na(vi) | apply(is.na(X), 1, any) if (any(yiviX.na)) { not.na <- !yiviX.na if (na.act == "na.omit") { yi <- yi[not.na] vi <- vi[not.na] X <- X[not.na,,drop=FALSE] slab <- slab[not.na] ilab <- ilab[not.na,,drop=FALSE] # if NULL, remains NULL pred <- pred[not.na] pred.ci.lb <- pred.ci.lb[not.na] pred.ci.ub <- pred.ci.ub[not.na] weights <- weights[not.na] pch <- pch[not.na] psize <- psize[not.na] # if NULL, remains NULL colout <- colout[not.na] rows.new <- rows # rearrange rows due to NAs being omitted from plot rows.na <- rows[!not.na] # shift higher rows down according to number of NAs omitted for (j in seq_along(rows.na)) { rows.new[rows >= rows.na[j]] <- rows.new[rows >= rows.na[j]] - 1 } rows <- rows.new[not.na] if (shade.type == "logical") shade <- shade[not.na] } if (na.act == "na.fail") stop(mstyle$stop("Missing values in results.")) } # note: yi/vi may be NA if na.act == "na.exclude" or "na.pass" k <- length(yi) # in case length of k has changed ### calculate individual CI bounds ci.lb <- yi - qnorm(level/2, lower.tail=FALSE) * sqrt(vi) ci.ub <- yi + qnorm(level/2, lower.tail=FALSE) * sqrt(vi) ### if requested, apply transformation to yi's and CI bounds if (is.function(transf)) { if (is.null(targs)) { yi <- sapply(yi, transf) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) pred <- sapply(pred, transf) pred.ci.lb <- sapply(pred.ci.lb, transf) pred.ci.ub <- sapply(pred.ci.ub, transf) } else { yi <- sapply(yi, transf, targs) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) pred <- sapply(pred, transf, targs) pred.ci.lb <- sapply(pred.ci.lb, transf, targs) pred.ci.ub <- sapply(pred.ci.ub, transf, targs) } } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] tmp <- .psort(pred.ci.lb, pred.ci.ub) pred.ci.lb <- tmp[,1] pred.ci.ub <- tmp[,2] ### apply observation/outcome limits if specified if (!missing(olim)) { if (length(olim) != 2L) stop(mstyle$stop("Argument 'olim' must be of length 2.")) olim <- sort(olim) yi[yi < olim[1]] <- olim[1] yi[yi > olim[2]] <- olim[2] ci.lb[ci.lb < olim[1]] <- olim[1] ci.ub[ci.ub > olim[2]] <- olim[2] pred.ci.lb[pred.ci.lb < olim[1]] <- olim[1] pred.ci.ub[pred.ci.ub > olim[2]] <- olim[2] } ### set default point sizes (if not specified by user) if (is.null(psize)) { if (length(plim) < 2L) stop(mstyle$stop("Argument 'plim' must be of length 2 or 3.")) wi <- sqrt(weights) if (!is.na(plim[1]) && !is.na(plim[2])) { rng <- max(wi, na.rm=TRUE) - min(wi, na.rm=TRUE) if (rng <= .Machine$double.eps^0.5) { psize <- rep(1, k) } else { psize <- (wi - min(wi, na.rm=TRUE)) / rng psize <- (psize * (plim[2] - plim[1])) + plim[1] } } if (is.na(plim[1]) && !is.na(plim[2])) { psize <- wi / max(wi, na.rm=TRUE) * plim[2] if (length(plim) == 3L) psize[psize <= plim[3]] <- plim[3] } if (!is.na(plim[1]) && is.na(plim[2])) { psize <- wi / min(wi, na.rm=TRUE) * plim[1] if (length(plim) == 3L) psize[psize >= plim[3]] <- plim[3] } if (all(is.na(psize))) psize <- rep(1, k) } ######################################################################### if (!is.null(at)) { if (anyNA(at)) stop(mstyle$stop("Argument 'at' cannot contain NAs.")) if (any(is.infinite(at))) stop(mstyle$stop("Argument 'at' cannot contain +-Inf values.")) } ### set x-axis limits (at argument overrides alim argument) alim.spec <- TRUE if (missing(alim)) { if (is.null(at)) { alim <- range(pretty(x=c(min(ci.lb, na.rm=TRUE), max(ci.ub, na.rm=TRUE)), n=steps-1)) alim.spec <- FALSE } else { alim <- range(at) } } alim <- sort(alim)[1:2] if (anyNA(alim)) stop(mstyle$stop("Argument 'alim' cannot contain NAs.")) ### generate x-axis positions if none are specified if (is.null(at)) { if (alim.spec) { at <- seq(from=alim[1], to=alim[2], length.out=steps) } else { at <- pretty(x=c(min(ci.lb, na.rm=TRUE), max(ci.ub, na.rm=TRUE)), n=steps-1) } } else { at[at < alim[1]] <- alim[1] # remove at values that are below or above the axis limits at[at > alim[2]] <- alim[2] at <- unique(at) } ### x-axis labels (apply transformation to axis labels if requested) at.lab <- at if (is.function(atransf)) { if (is.null(targs)) { at.lab <- fmtx(sapply(at.lab, atransf), digits[[2]], drop0ifint=TRUE) } else { at.lab <- fmtx(sapply(at.lab, atransf, targs), digits[[2]], drop0ifint=TRUE) } } else { at.lab <- fmtx(at.lab, digits[[2]], drop0ifint=TRUE) } ### set plot limits (xlim) ncol.ilab <- ifelse(is.null(ilab), 0, ncol(ilab)) if (slab.null) { area.slab <- 25 } else { area.slab <- 40 } if (annotate) { if (showweights) { area.anno <- 30 } else { area.anno <- 25 } } else { area.anno <- 10 } iadd <- 5 area.slab <- area.slab + iadd*ncol.ilab #area.anno <- area.anno area.forest <- 100 + iadd*ncol.ilab - area.slab - area.anno area.slab <- area.slab / (100 + iadd*ncol.ilab) area.anno <- area.anno / (100 + iadd*ncol.ilab) area.forest <- area.forest / (100 + iadd*ncol.ilab) plot.multp.l <- area.slab / area.forest plot.multp.r <- area.anno / area.forest if (missing(xlim)) { if (min(ci.lb, na.rm=TRUE) < alim[1]) { f.1 <- alim[1] } else { f.1 <- min(ci.lb, na.rm=TRUE) } if (max(ci.ub, na.rm=TRUE) > alim[2]) { f.2 <- alim[2] } else { f.2 <- max(ci.ub, na.rm=TRUE) } rng <- f.2 - f.1 xlim <- c(f.1 - rng * plot.multp.l, f.2 + rng * plot.multp.r) xlim <- round(xlim, digits[[2]]) #xlim[1] <- xlim[1]*max(1, digits[[2]]/2) #xlim[2] <- xlim[2]*max(1, digits[[2]]/2) } xlim <- sort(xlim) ### plot limits must always encompass the yi values (no longer done) #if (xlim[1] > min(yi, na.rm=TRUE)) { xlim[1] <- min(yi, na.rm=TRUE) } #if (xlim[2] < max(yi, na.rm=TRUE)) { xlim[2] <- max(yi, na.rm=TRUE) } ### x-axis limits must always encompass the yi values (no longer done) #if (alim[1] > min(yi, na.rm=TRUE)) { alim[1] <- min(yi, na.rm=TRUE) } #if (alim[2] < max(yi, na.rm=TRUE)) { alim[2] <- max(yi, na.rm=TRUE) } ### plot limits must always encompass the x-axis limits (no longer done) #if (alim[1] < xlim[1]) { xlim[1] <- alim[1] } #if (alim[2] > xlim[2]) { xlim[2] <- alim[2] } ### allow adjustment of position of study labels and annotations via textpos argument if (is.null(ddd$textpos)) { textpos <- xlim } else { textpos <- ddd$textpos } if (length(textpos) != 2L) stop(mstyle$stop("Argument 'textpos' must be of length 2.")) if (is.na(textpos[1])) textpos[1] <- xlim[1] if (is.na(textpos[2])) textpos[2] <- xlim[2] ### set y-axis limits if (missing(ylim)) { if (x$int.only && addfit) { ylim <- c(-1.5, max(rows, na.rm=TRUE)+top) } else { ylim <- c(0.5, max(rows, na.rm=TRUE)+top) } } else { ylim <- sort(ylim) } ######################################################################### ### set/get fonts (1st for study labels, 2nd for annotations, 3rd for ilab) ### when passing a named vector, the names are for 'family' and the values are for 'font' if (missing(fonts)) { fonts <- rep(par("family"), 3L) } else { if (length(fonts) == 1L) fonts <- rep(fonts, 3L) if (length(fonts) == 2L) fonts <- c(fonts, fonts[1]) } if (is.null(names(fonts))) fonts <- setNames(c(1L,1L,1L), nm=fonts) par(family=names(fonts)[1], font=fonts[1]) ### adjust margins par.mar <- par("mar") par.mar.adj <- par.mar - c(0,3,1,1) par.mar.adj[par.mar.adj < 0] <- 0 par(mar = par.mar.adj) on.exit(par(mar = par.mar), add=TRUE) #if (identical(par("mar"), c(5.1,4.1,4.1,2.1))) # par(mar = c(5.1,1.1,3.1,1.1)) ### start plot lplot(NA, NA, xlim=xlim, ylim=ylim, xlab="", ylab="", yaxt="n", xaxt="n", xaxs="i", bty="n", ...) ### add shading if (shade.type == "character") { if (shade == "zebra" || shade == "zebra1") tmp <- rep_len(c(TRUE,FALSE), k) if (shade == "zebra2") tmp <- rep_len(c(FALSE,TRUE), k) if (shade == "all") tmp <- rep_len(TRUE, k) shade <- tmp } if (shade.type %in% c("character","logical")) { for (i in seq_len(k)) { if (shade[i]) rect(xlim[1], rows[i]-0.5, xlim[2], rows[i]+0.5, border=colshade, col=colshade) } } if (shade.type == "numeric") { for (i in seq_along(shade)) { rect(xlim[1], shade[i]-0.5, xlim[2], shade[i]+0.5, border=colshade, col=colshade) } } ### horizontal title line labline(h=ylim[2]-(top-1), lty=lty[3], ...) ### get coordinates of the plotting region par.usr <- par("usr") ### add reference line if (is.numeric(refline)) lsegments(refline, par.usr[3], refline, ylim[2]-(top-1), lty="dotted", ...) ### set cex, cex.lab, and cex.axis sizes as a function of the height of the figure height <- par.usr[4] - par.usr[3] if (is.null(cex)) { lheight <- strheight("O") cex.adj <- ifelse(k * lheight > height * 0.8, height/(1.25 * k * lheight), 1) } if (is.null(cex)) { cex <- par("cex") * cex.adj } else { if (is.null(cex.lab)) cex.lab <- cex if (is.null(cex.axis)) cex.axis <- cex } if (is.null(cex.lab)) cex.lab <- par("cex") * cex.adj if (is.null(cex.axis)) cex.axis <- par("cex") * cex.adj ######################################################################### ### if addfit and not an intercept-only model, add fitted polygons if (addfit && !x$int.only) { for (i in seq_len(k)) { if (is.na(pred[i])) next lpolygon(x=c(max(pred.ci.lb[i], alim[1]), pred[i], min(pred.ci.ub[i], alim[2]), pred[i]), y=c(rows[i], rows[i]+(height/100)*cex*efac[3], rows[i], rows[i]-(height/100)*cex*efac[3]), col=col, border=border, ...) ### this would only draw intervals if bounds fall within alim range #if ((pred.ci.lb[i] > alim[1]) && (pred.ci.ub[i] < alim[2])) # lpolygon(x=c(pred.ci.lb[i], pred[i], pred.ci.ub[i], pred[i]), y=c(rows[i], rows[i]+(height/100)*cex*efac[3], rows[i], rows[i]-(height/100)*cex*efac[3]), col=col, border=border, ...) } } ######################################################################### ### if addfit and intercept-only model, add fixed/random-effects model polygon if (addfit && x$int.only) { if (inherits(x, "rma.mv") && x$withG && x$tau2s > 1) { if (!is.logical(addpred)) { ### for multiple tau^2 (and gamma^2) values, need to specify level(s) of the inner factor(s) to compute the PI ### this can be done via the addpred argument (i.e., instead of using a logical, one specifies the level(s)) if (length(addpred) == 1L) addpred <- c(addpred, addpred) temp <- predict(x, level=level, tau2.levels=addpred[1], gamma2.levels=addpred[2], pi.type=pi.type) addpred <- TRUE ### set addpred to TRUE, so if (!is.element(x$method, c("FE","EE","CE")) && addpred) further below works } else { if (addpred) { ### here addpred=TRUE, but user has not specified the level, so throw an error stop(mstyle$stop("Must specify the level of the inner factor(s) via the 'addpred' argument.")) } else { ### here addpred=FALSE, so just use the first tau^2 and gamma^2 arbitrarily (so predict() works) temp <- predict(x, level=level, tau2.levels=1, gamma2.levels=1, pi.type=pi.type) } } } else { temp <- predict(x, level=level, pi.type=pi.type) } beta <- temp$pred beta.ci.lb <- temp$ci.lb beta.ci.ub <- temp$ci.ub beta.pi.lb <- temp$pi.lb beta.pi.ub <- temp$pi.ub if (is.function(transf)) { if (is.null(targs)) { beta <- sapply(beta, transf) beta.ci.lb <- sapply(beta.ci.lb, transf) beta.ci.ub <- sapply(beta.ci.ub, transf) beta.pi.lb <- sapply(beta.pi.lb, transf) beta.pi.ub <- sapply(beta.pi.ub, transf) } else { beta <- sapply(beta, transf, targs) beta.ci.lb <- sapply(beta.ci.lb, transf, targs) beta.ci.ub <- sapply(beta.ci.ub, transf, targs) beta.pi.lb <- sapply(beta.pi.lb, transf, targs) beta.pi.ub <- sapply(beta.pi.ub, transf, targs) } } ### make sure order of intervals is always increasing tmp <- .psort(beta.ci.lb, beta.ci.ub) beta.ci.lb <- tmp[,1] beta.ci.ub <- tmp[,2] tmp <- .psort(beta.pi.lb, beta.pi.ub) beta.pi.lb <- tmp[,1] beta.pi.ub <- tmp[,2] ### apply observation/outcome limits if specified if (!missing(olim)) { pred[pred < olim[1]] <- olim[1] pred[pred > olim[2]] <- olim[2] beta.ci.lb[beta.ci.lb < olim[1]] <- olim[1] beta.ci.ub[beta.ci.ub > olim[2]] <- olim[2] beta.pi.lb[beta.pi.lb < olim[1]] <- olim[1] beta.pi.ub[beta.pi.ub > olim[2]] <- olim[2] } ### add prediction interval if (!is.element(x$method, c("FE","EE","CE")) && addpred) { lsegments(max(beta.pi.lb, alim[1]), -1, min(beta.pi.ub, alim[2]), -1, lty=lty[2], col=col[2], ...) if (beta.pi.lb >= alim[1]) { lsegments(beta.pi.lb, -1-(height/150)*cex*efac[1], beta.pi.lb, -1+(height/150)*cex*efac[1], col=col[2], ...) } else { lpolygon(x=c(alim[1], alim[1]+(1.4/100)*cex*(xlim[2]-xlim[1]), alim[1]+(1.4/100)*cex*(xlim[2]-xlim[1]), alim[1]), y=c(-1, -1+(height/150)*cex*efac[2], -1-(height/150)*cex*efac[2], -1), col=col[2], border=col[2], ...) } if (beta.pi.ub <= alim[2]) { lsegments(beta.pi.ub, -1-(height/150)*cex*efac[1], beta.pi.ub, -1+(height/150)*cex*efac[1], col=col[2], ...) } else { lpolygon(x=c(alim[2], alim[2]-(1.4/100)*cex*(xlim[2]-xlim[1]), alim[2]-(1.4/100)*cex*(xlim[2]-xlim[1]), alim[2]), y=c(-1, -1+(height/150)*cex*efac[2], -1-(height/150)*cex*efac[2], -1), col=col[2], border=col[2], ...) } } ### polygon for the summary estimate lpolygon(x=c(beta.ci.lb, beta, beta.ci.ub, beta), y=c(-1, -1+(height/100)*cex*efac[3], -1, -1-(height/100)*cex*efac[3]), col=col[1], border=border, ...) ### add label for model estimate if (missing(mlab)) mlab <- sapply(x$method, switch, "FE"="FE Model", "EE"="EE Model", "CE"="CE Model", "RE Model", USE.NAMES=FALSE) if (is.list(mlab)) { ltext(textpos[1], -1+rowadj[1], mlab[[1]], pos=4, cex=cex, ...) } else { ltext(textpos[1], -1+rowadj[1], mlab, pos=4, cex=cex, ...) } } ######################################################################### ### add x-axis laxis(side=1, at=at, labels=at.lab, cex.axis=cex.axis, ...) ### add x-axis label if (missing(xlab)) xlab <- .setlab(measure, transf.char, atransf.char, gentype=1) if (!is.element(length(xlab), 1:3)) stop(mstyle$stop("Argument 'xlab' argument must be of length 1, 2, or 3.")) if (length(xlab) == 1L) lmtext(xlab, side=1, at=min(at) + (max(at)-min(at))/2, line=par("mgp")[1]-0.5, cex=cex.lab, font=xlabfont[1], ...) if (length(xlab) == 2L) { lmtext(xlab[1], side=1, at=min(at), line=par("mgp")[1]-0.5, cex=cex.lab, adj=xlabadj[1], font=xlabfont[1], ...) lmtext(xlab[2], side=1, at=max(at), line=par("mgp")[1]-0.5, cex=cex.lab, adj=xlabadj[2], font=xlabfont[1], ...) } if (length(xlab) == 3L) { lmtext(xlab[1], side=1, at=min(at), line=par("mgp")[1]-0.5, cex=cex.lab, adj=xlabadj[1], font=xlabfont[1], ...) lmtext(xlab[2], side=1, at=min(at) + (max(at)-min(at))/2, line=par("mgp")[1]-0.5, cex=cex.lab, font=xlabfont[2], ...) lmtext(xlab[3], side=1, at=max(at), line=par("mgp")[1]-0.5, cex=cex.lab, adj=xlabadj[2], font=xlabfont[1], ...) } ### add CI ends (either | or <> if outside of axis limits) for (i in seq_len(k)) { ### need to skip missings (if check below will otherwise throw an error) if (is.na(yi[i]) || is.na(vi[i])) next ### if the lower bound is actually larger than upper x-axis limit, then everything is to the right and just draw a polygon pointing in that direction if (ci.lb[i] >= alim[2]) { lpolygon(x=c(alim[2], alim[2]-(1.4/100)*cex*(xlim[2]-xlim[1]), alim[2]-(1.4/100)*cex*(xlim[2]-xlim[1]), alim[2]), y=c(rows[i], rows[i]+(height/150)*cex*efac[2], rows[i]-(height/150)*cex*efac[2], rows[i]), col=colout[i], ...) next } ### if the upper bound is actually lower than lower x-axis limit, then everything is to the left and just draw a polygon pointing in that direction if (ci.ub[i] <= alim[1]) { lpolygon(x=c(alim[1], alim[1]+(1.4/100)*cex*(xlim[2]-xlim[1]), alim[1]+(1.4/100)*cex*(xlim[2]-xlim[1]), alim[1]), y=c(rows[i], rows[i]+(height/150)*cex*efac[2], rows[i]-(height/150)*cex*efac[2], rows[i]), col=colout[i], ...) next } lsegments(max(ci.lb[i], alim[1]), rows[i], min(ci.ub[i], alim[2]), rows[i], lty=lty[1], col=colout[i], ...) if (ci.lb[i] >= alim[1]) { lsegments(ci.lb[i], rows[i]-(height/150)*cex*efac[1], ci.lb[i], rows[i]+(height/150)*cex*efac[1], col=colout[i], ...) } else { lpolygon(x=c(alim[1], alim[1]+(1.4/100)*cex*(xlim[2]-xlim[1]), alim[1]+(1.4/100)*cex*(xlim[2]-xlim[1]), alim[1]), y=c(rows[i], rows[i]+(height/150)*cex*efac[2], rows[i]-(height/150)*cex*efac[2], rows[i]), col=colout[i], ...) } if (ci.ub[i] <= alim[2]) { lsegments(ci.ub[i], rows[i]-(height/150)*cex*efac[1], ci.ub[i], rows[i]+(height/150)*cex*efac[1], col=colout[i], ...) } else { lpolygon(x=c(alim[2], alim[2]-(1.4/100)*cex*(xlim[2]-xlim[1]), alim[2]-(1.4/100)*cex*(xlim[2]-xlim[1]), alim[2]), y=c(rows[i], rows[i]+(height/150)*cex*efac[2], rows[i]-(height/150)*cex*efac[2], rows[i]), col=colout[i], ...) } } ### add study labels on the left ltext(textpos[1], rows+rowadj[1], slab, pos=4, cex=cex, ...) ### add info labels if (!is.null(ilab)) { if (is.null(ilab.xpos)) { #stop(mstyle$stop("Must specify 'ilab.xpos' argument when adding information with 'ilab'.")) dist <- min(ci.lb, na.rm=TRUE) - xlim[1] if (ncol.ilab == 1L) ilab.xpos <- xlim[1] + dist*0.75 if (ncol.ilab == 2L) ilab.xpos <- xlim[1] + dist*c(0.65, 0.85) if (ncol.ilab == 3L) ilab.xpos <- xlim[1] + dist*c(0.60, 0.75, 0.90) if (ncol.ilab >= 4L) ilab.xpos <- seq(xlim[1] + dist*0.5, xlim[1] + dist*0.9, length.out=ncol.ilab) } if (length(ilab.xpos) != ncol.ilab) stop(mstyle$stop(paste0("Number of 'ilab' columns (", ncol.ilab, ") does not match length of 'ilab.xpos' argument (", length(ilab.xpos), ")."))) if (!is.null(ilab.pos) && length(ilab.pos) == 1L) ilab.pos <- rep(ilab.pos, ncol.ilab) par(family=names(fonts)[3], font=fonts[3]) for (l in seq_len(ncol.ilab)) { ltext(ilab.xpos[l], rows+rowadj[3], ilab[,l], pos=ilab.pos[l], cex=cex, ...) } par(family=names(fonts)[1], font=fonts[1]) } ### add study annotations on the right: yi [LB, UB] ### and add model fit annotations if requested: b [LB, UB] ### (have to add this here, so that alignment is correct) if (annotate) { if (is.function(atransf)) { if (is.null(targs)) { if (addfit && x$int.only) { annotext <- cbind(sapply(c(yi, beta), atransf), sapply(c(ci.lb, beta.ci.lb), atransf), sapply(c(ci.ub, beta.ci.ub), atransf)) } else { annotext <- cbind(sapply(yi, atransf), sapply(ci.lb, atransf), sapply(ci.ub, atransf)) } } else { if (addfit && x$int.only) { annotext <- cbind(sapply(c(yi, beta), atransf, targs), sapply(c(ci.lb, beta.ci.lb), atransf, targs), sapply(c(ci.ub, beta.ci.ub), atransf, targs)) } else { annotext <- cbind(sapply(yi, atransf, targs), sapply(ci.lb, atransf, targs), sapply(ci.ub, atransf, targs)) } } ### make sure order of intervals is always increasing tmp <- .psort(annotext[,2:3]) annotext[,2:3] <- tmp } else { if (addfit && x$int.only) { annotext <- cbind(c(yi, beta), c(ci.lb, beta.ci.lb), c(ci.ub, beta.ci.ub)) } else { annotext <- cbind(yi, ci.lb, ci.ub) } } if (showweights) { if (addfit && x$int.only) { annotext <- cbind(c(unname(weights),100), annotext) annotext <- fmtx(annotext, c(digits[[3]], digits[[1]], digits[[1]], digits[[1]])) annotext[nrow(annotext),1] <- "100" } else { annotext <- cbind(unname(weights), annotext) annotext <- fmtx(annotext, c(digits[[3]], digits[[1]], digits[[1]], digits[[1]])) } } else { annotext <- fmtx(annotext, digits[[1]]) } if (missing(width)) { width <- apply(annotext, 2, function(x) max(nchar(x))) } else { if (length(width) == 1L) width <- rep(width, ncol(annotext)) if (length(width) != ncol(annotext)) stop(mstyle$stop(paste0("Length of 'width' argument (", length(width), ") does not match the number of annotation columns (", ncol(annotext), ")."))) } for (j in seq_len(ncol(annotext))) { annotext[,j] <- formatC(annotext[,j], width=width[j]) } if (showweights) width <- width[-1] # remove the first entry for the weights (so this can be used by addpoly() via .metafor) if (showweights) { annotext <- cbind(annotext[,1], paste0("%", paste0(rep(substr(annosym[1],1,1),3), collapse="")), annotext[,2], annosym[1], annotext[,3], annosym[2], annotext[,4], annosym[3]) } else { annotext <- cbind(annotext[,1], annosym[1], annotext[,2], annosym[2], annotext[,3], annosym[3]) } annotext <- apply(annotext, 1, paste, collapse="") annotext[grepl("NA", annotext, fixed=TRUE)] <- "" annotext <- gsub("-", annosym[4], annotext, fixed=TRUE) # [a] annotext <- gsub(" ", annosym[5], annotext, fixed=TRUE) par(family=names(fonts)[2], font=fonts[2]) if (addfit && x$int.only) { ltext(textpos[2], c(rows,-1)+rowadj[2], labels=annotext, pos=2, cex=cex, ...) } else { ltext(textpos[2], rows+rowadj[2], labels=annotext, pos=2, cex=cex, ...) } par(family=names(fonts)[1], font=fonts[1]) } else { width <- NULL } ### add yi points for (i in seq_len(k)) { ### need to skip missings, as if () check below will otherwise throw an error if (is.na(yi[i])) next if (yi[i] >= alim[1] && yi[i] <= alim[2]) lpoints(x=yi[i], y=rows[i], pch=pch[i], col=colout[i], cex=cex*psize[i], ...) } #lpoints(x=yi, y=rows, pch=pch, cex=cex*psize, ...) ### add horizontal line at 0 for the standard FE/RE model display if (x$int.only && addfit) labline(h=0, lty=lty[3], ...) ### add header ltext(textpos[1], ylim[2]-(top-1)+1, header.left, pos=4, font=2, cex=cex, ...) ltext(textpos[2], ylim[2]-(top-1)+1, header.right, pos=2, font=2, cex=cex, ...) ######################################################################### ### return some information about plot invisibly res <- list(xlim=par("usr")[1:2], alim=alim, at=at, ylim=ylim, rows=rows, cex=cex, cex.lab=cex.lab, cex.axis=cex.axis, ilab.xpos=ilab.xpos, ilab.pos=ilab.pos, textpos=textpos, areas=c(area.slab, area.forest, area.anno)) ### put stuff into the .metafor environment, so that it can be used by addpoly() sav <- c(res, list(level=level, annotate=annotate, digits=digits[[1]], width=width, transf=transf, atransf=atransf, targs=targs, efac=efac, fonts=fonts[1:2], annosym=annosym)) try(assign("forest", sav, envir=.metafor), silent=TRUE) invisible(res) } metafor/R/profile.rma.mv.r0000644000176200001440000004516414413113722015142 0ustar liggesusersprofile.rma.mv <- function(fitted, sigma2, tau2, rho, gamma2, phi, xlim, ylim, steps=20, lltol=1e-03, progbar=TRUE, parallel="no", ncpus=1, cl, plot=TRUE, pch=19, refline=TRUE, cline=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(fitted), must="rma.mv") if (steps < 2) stop(mstyle$stop("Argument 'steps' must be >= 2.")) x <- fitted parallel <- match.arg(parallel, c("no", "snow", "multicore")) if (parallel == "no" && ncpus > 1) parallel <- "snow" if (missing(cl)) cl <- NULL if (!is.null(cl) && inherits(cl, "SOCKcluster")) { parallel <- "snow" ncpus <- length(cl) } if (parallel == "snow" && ncpus < 2) parallel <- "no" if (parallel == "snow" || parallel == "multicore") { if (!requireNamespace("parallel", quietly=TRUE)) stop(mstyle$stop("Please install the 'parallel' package for parallel processing.")) ncpus <- as.integer(ncpus) if (ncpus < 1L) stop(mstyle$stop("Argument 'ncpus' must be >= 1.")) } if (!progbar) { pbo <- pbapply::pboptions(type="none") on.exit(pbapply::pboptions(pbo), add=TRUE) } ddd <- list(...) if (.isTRUE(ddd$time)) time.start <- proc.time() if (!is.null(ddd$startmethod)) warning(mstyle$warning("Argument 'startmethod' has been deprecated.")) ######################################################################### ### check if user has not specified one of the sigma2, tau2, rho, gamma2, or phi arguments if (missing(sigma2) && missing(tau2) && missing(rho) && missing(gamma2) && missing(phi)) { mc <- match.call() ### total number of non-fixed components comps <- ifelse(x$withS, sum(!x$vc.fix$sigma2), 0) + ifelse(x$withG, sum(!x$vc.fix$tau2) + sum(!x$vc.fix$rho), 0) + ifelse(x$withH, sum(!x$vc.fix$gamma2) + sum(!x$vc.fix$phi), 0) if (comps == 0) stop(mstyle$stop("No components in the model for which a profile likelihood can be constructed.")) if (plot) { if (dev.cur() == 1) { par(mfrow=n2mfrow(comps)) #on.exit(par(mfrow=c(1,1)), add=TRUE) } } sav <- list() j <- 0 if (x$withS && any(!x$vc.fix$sigma2)) { for (pos in seq_len(x$sigma2s)[!x$vc.fix$sigma2]) { j <- j + 1 mc.vc <- mc mc.vc$sigma2 <- pos mc.vc$time <- FALSE #mc.vc$fitted <- quote(x) if (progbar) cat(mstyle$verbose(paste("Profiling sigma2 =", pos, "\n"))) sav[[j]] <- eval(mc.vc, envir=parent.frame()) } } if (x$withG) { if (any(!x$vc.fix$tau2)) { for (pos in seq_len(x$tau2s)[!x$vc.fix$tau2]) { j <- j + 1 mc.vc <- mc mc.vc$tau2 <- pos mc.vc$time <- FALSE #mc.vc$fitted <- quote(x) if (progbar) cat(mstyle$verbose(paste("Profiling tau2 =", pos, "\n"))) sav[[j]] <- eval(mc.vc, envir=parent.frame()) } } if (any(!x$vc.fix$rho)) { for (pos in seq_len(x$rhos)[!x$vc.fix$rho]) { j <- j + 1 mc.vc <- mc mc.vc$rho <- pos mc.vc$time <- FALSE #mc.vc$fitted <- quote(x) if (progbar) cat(mstyle$verbose(paste("Profiling rho =", pos, "\n"))) sav[[j]] <- eval(mc.vc, envir=parent.frame()) } } } if (x$withH) { if (any(!x$vc.fix$gamma2)) { for (pos in seq_len(x$gamma2s)[!x$vc.fix$gamma2]) { j <- j + 1 mc.vc <- mc mc.vc$gamma2 <- pos mc.vc$time <- FALSE #mc.vc$fitted <- quote(x) if (progbar) cat(mstyle$verbose(paste("Profiling gamma2 =", pos, "\n"))) sav[[j]] <- eval(mc.vc, envir=parent.frame()) } } if (any(!x$vc.fix$phi)) { for (pos in seq_len(x$phis)[!x$vc.fix$phi]) { j <- j + 1 mc.vc <- mc mc.vc$phi <- pos mc.vc$time <- FALSE #mc.vc$fitted <- quote(x) if (progbar) cat(mstyle$verbose(paste("Profiling phi =", pos, "\n"))) sav[[j]] <- eval(mc.vc, envir=parent.frame()) } } } ### if there is just one component, turn the list of lists into a simple list if (comps == 1) sav <- sav[[1]] sav$comps <- comps if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(sav) <- "profile.rma" return(invisible(sav)) } #if (missing(sigma2) && missing(tau2) && missing(rho) && missing(gamma2) && missing(phi)) # stop(mstyle$stop("Must specify one of the arguments 'sigma2', 'tau2', 'rho', 'gamma2', or 'phi'.")) ### check if user has specified more than one of these arguments if (sum(!missing(sigma2), !missing(tau2), !missing(rho), !missing(gamma2), !missing(phi)) > 1L) stop(mstyle$stop("Must specify only one of the arguments 'sigma2', 'tau2', 'rho', 'gamma2', or 'phi'.")) ### check if model actually contains (at least one) such a component and that it was actually estimated ### note: a component that is not in the model is NA; components that are fixed are TRUE if (!missing(sigma2) && (all(is.na(x$vc.fix$sigma2)) || all(x$vc.fix$sigma2))) stop(mstyle$stop("Model does not contain any (estimated) 'sigma2' components.")) if (!missing(tau2) && (all(is.na(x$vc.fix$tau2)) || all(x$vc.fix$tau2))) stop(mstyle$stop("Model does not contain any (estimated) 'tau2' components.")) if (!missing(rho) && c(all(is.na(x$vc.fix$rho)) || all(x$vc.fix$rho))) stop(mstyle$stop("Model does not contain any (estimated) 'rho' components.")) if (!missing(gamma2) && (all(is.na(x$vc.fix$gamma2)) || all(x$vc.fix$gamma2))) stop(mstyle$stop("Model does not contain any (estimated) 'gamma2' components.")) if (!missing(phi) && c(all(is.na(x$vc.fix$phi)) || all(x$vc.fix$phi))) stop(mstyle$stop("Model does not contain any (estimated) 'phi' components.")) ### check if user specified more than one sigma2, tau2, rho, gamma2, or rho component if (!missing(sigma2) && (length(sigma2) > 1L)) stop(mstyle$stop("Can only specify one 'sigma2' component.")) if (!missing(tau2) && (length(tau2) > 1L)) stop(mstyle$stop("Can only specify one 'tau2' component.")) if (!missing(rho) && (length(rho) > 1L)) stop(mstyle$stop("Can only specify one 'rho' component.")) if (!missing(gamma2) && (length(gamma2) > 1L)) stop(mstyle$stop("Can only specify one 'gamma2' component.")) if (!missing(phi) && (length(phi) > 1L)) stop(mstyle$stop("Can only specify one 'phi' component.")) ### check if user specified a logical if (!missing(sigma2) && is.logical(sigma2)) stop(mstyle$stop("Must specify a number for the 'sigma2' component.")) if (!missing(tau2) && is.logical(tau2)) stop(mstyle$stop("Must specify a number for the 'tau2' component.")) if (!missing(rho) && is.logical(rho)) stop(mstyle$stop("Must specify a number for the 'rho' component.")) if (!missing(gamma2) && is.logical(gamma2)) stop(mstyle$stop("Must specify a number for the 'gamma2' component.")) if (!missing(phi) && is.logical(phi)) stop(mstyle$stop("Must specify a number for the 'phi' component.")) ### check if user specified a component that does not exist if (!missing(sigma2) && (sigma2 > length(x$vc.fix$sigma2) || sigma2 <= 0)) stop(mstyle$stop("No such 'sigma2' component in the model.")) if (!missing(tau2) && (tau2 > length(x$vc.fix$tau2) || tau2 <= 0)) stop(mstyle$stop("No such 'tau2' component in the model.")) if (!missing(rho) && (rho > length(x$vc.fix$rho) || rho <= 0)) stop(mstyle$stop("No such 'rho' component in the model.")) if (!missing(gamma2) && (gamma2 > length(x$vc.fix$gamma2) || gamma2 <= 0)) stop(mstyle$stop("No such 'gamma2' component in the model.")) if (!missing(phi) && (phi > length(x$vc.fix$phi) || phi <= 0)) stop(mstyle$stop("No such 'phi' component in the model.")) ### check if user specified a component that was fixed if (!missing(sigma2) && x$vc.fix$sigma2[sigma2]) stop(mstyle$stop("Specified 'sigma2' component was fixed.")) if (!missing(tau2) && x$vc.fix$tau2[tau2]) stop(mstyle$stop("Specified 'tau2' component was fixed.")) if (!missing(rho) && x$vc.fix$rho[rho]) stop(mstyle$stop("Specified 'rho' component was fixed.")) if (!missing(gamma2) && x$vc.fix$gamma2[gamma2]) stop(mstyle$stop("Specified 'gamma2' component was fixed.")) if (!missing(phi) && x$vc.fix$phi[phi]) stop(mstyle$stop("Specified 'phi' component was fixed.")) ### if everything is good so far, get value of the variance component and set 'comp' sigma2.pos <- NA_integer_ tau2.pos <- NA_integer_ rho.pos <- NA_integer_ gamma2.pos <- NA_integer_ phi.pos <- NA_integer_ if (!missing(sigma2)) { vc <- x$sigma2[sigma2] comp <- "sigma2" sigma2.pos <- sigma2 } if (!missing(tau2)) { vc <- x$tau2[tau2] comp <- "tau2" tau2.pos <- tau2 } if (!missing(rho)) { vc <- x$rho[rho] comp <- "rho" rho.pos <- rho } if (!missing(gamma2)) { vc <- x$gamma2[gamma2] comp <- "gamma2" gamma2.pos <- gamma2 } if (!missing(phi)) { vc <- x$phi[phi] comp <- "phi" phi.pos <- phi } #return(list(comp=comp, vc=vc)) if (missing(xlim)) { ### if the user has not specified xlim, set it automatically ### TODO: maybe try something based on CI later if (comp == "sigma2") { vc.lb <- max( 0, vc/4) vc.ub <- max(.1, vc*4) } if (comp == "tau2") { if (is.element(x$struct[1], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) { vc.lb <- max( 0, vc/2) vc.ub <- max(.1, vc*2) } else { vc.lb <- max( 0, vc/4) vc.ub <- max(.1, vc*4) } } if (comp == "gamma2") { if (is.element(x$struct[2], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) { vc.lb <- max( 0, vc/2) vc.ub <- max(.1, vc*2) } else { vc.lb <- max( 0, vc/4) vc.ub <- max(.1, vc*4) } } if (comp == "rho") { if (x$struct[1] == "CAR") { vc.lb <- max(0, vc-.5) vc.ub <- min(+.99999, vc+.5) } if (is.element(x$struct[1], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYPL","PHYPD"))) { vc.lb <- vc/2 vc.ub <- vc*2 } if (!is.element(x$struct[1], c("CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYPL","PHYPD"))) { vc.lb <- max(-.99999, vc-.5) vc.ub <- min(+.99999, vc+.5) } } if (comp == "phi") { if (x$struct[2] == "CAR") { vc.lb <- max(0, vc-.5) vc.ub <- min(+.99999, vc+.5) } if (is.element(x$struct[2], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYPL","PHYPD"))) { vc.lb <- vc/2 vc.ub <- vc*2 } if (!is.element(x$struct[2], c("CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYPL","PHYPD"))) { vc.lb <- max(-.99999, vc-.5) vc.ub <- min(+.99999, vc+.5) } } ### if that fails, throw an error if (is.na(vc.lb) || is.na(vc.ub)) stop(mstyle$stop("Cannot set 'xlim' automatically. Please set this argument manually.")) xlim <- c(vc.lb, vc.ub) } else { if (length(xlim) != 2L) stop(mstyle$stop("Argument 'xlim' should be a vector of length 2.")) xlim <- sort(xlim) if (is.element(comp, c("sigma2", "tau2", "gamma2"))) { if (xlim[1] < 0) stop(mstyle$stop("Lower bound for profiling must be >= 0.")) } if (comp == "rho") { if (is.element(x$struct[1], c("CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYPL","PHYPD")) && xlim[1] < 0) stop(mstyle$stop("Lower bound for profiling must be >= 0.")) if (xlim[1] < -1) stop(mstyle$stop("Lower bound for profiling must be >= -1.")) if (!is.element(x$struct[1], c("CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYPL","PHYPD")) && xlim[2] > 1) stop(mstyle$stop("Upper bound for profiling must be <= 1.")) } if (comp == "phi") { if (is.element(x$struct[2], c("CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYPL","PHYPD")) && xlim[1] < 0) stop(mstyle$stop("Lower bound for profiling must be >= 0.")) if (xlim[1] < -1) stop(mstyle$stop("Lower bound for profiling must be >= -1.")) if (!is.element(x$struct[2], c("CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYPL","PHYPD")) && xlim[2] > 1) stop(mstyle$stop("Upper bound for profiling must be <= 1.")) } } vcs <- seq(xlim[1], xlim[2], length.out=steps) #return(vcs) if (length(vcs) <= 1L) stop(mstyle$stop("Cannot set 'xlim' automatically. Please set this argument manually.")) if (parallel == "no") res <- pbapply::pblapply(vcs, .profile.rma.mv, obj=x, comp=comp, sigma2.pos=sigma2.pos, tau2.pos=tau2.pos, rho.pos=rho.pos, gamma2.pos=gamma2.pos, phi.pos=phi.pos, parallel=parallel, profile=TRUE) if (parallel == "multicore") res <- pbapply::pblapply(vcs, .profile.rma.mv, obj=x, comp=comp, sigma2.pos=sigma2.pos, tau2.pos=tau2.pos, rho.pos=rho.pos, gamma2.pos=gamma2.pos, phi.pos=phi.pos, parallel=parallel, profile=TRUE, cl=ncpus) #res <- parallel::mclapply(vcs, .profile.rma.mv, obj=x, comp=comp, sigma2.pos=sigma2.pos, tau2.pos=tau2.pos, rho.pos=rho.pos, gamma2.pos=gamma2.pos, phi.pos=phi.pos, parallel=parallel, profile=TRUE, mc.cores=ncpus) if (parallel == "snow") { if (is.null(cl)) { cl <- parallel::makePSOCKcluster(ncpus) on.exit(parallel::stopCluster(cl), add=TRUE) } if (.isTRUE(ddd$LB)) { res <- parallel::parLapplyLB(cl, vcs, .profile.rma.mv, obj=x, comp=comp, sigma2.pos=sigma2.pos, tau2.pos=tau2.pos, rho.pos=rho.pos, gamma2.pos=gamma2.pos, phi.pos=phi.pos, parallel=parallel, profile=TRUE) #res <- parallel::clusterApplyLB(cl, vcs, .profile.rma.mv, obj=x, comp=comp, sigma2.pos=sigma2.pos, tau2.pos=tau2.pos, rho.pos=rho.pos, gamma2.pos=gamma2.pos, phi.pos=phi.pos, parallel=parallel, profile=TRUE) } else { res <- pbapply::pblapply(vcs, .profile.rma.mv, obj=x, comp=comp, sigma2.pos=sigma2.pos, tau2.pos=tau2.pos, rho.pos=rho.pos, gamma2.pos=gamma2.pos, phi.pos=phi.pos, parallel=parallel, profile=TRUE, cl=cl) #res <- parallel::parLapply(cl, vcs, .profile.rma.mv, obj=x, comp=comp, sigma2.pos=sigma2.pos, tau2.pos=tau2.pos, rho.pos=rho.pos, gamma2.pos=gamma2.pos, phi.pos=phi.pos, parallel=parallel, profile=TRUE) #res <- parallel::clusterApply(cl, vcs, .profile.rma.mv, obj=x, comp=comp, sigma2.pos=sigma2.pos, tau2.pos=tau2.pos, rho.pos=rho.pos, gamma2.pos=gamma2.pos, phi.pos=phi.pos, parallel=parallel, profile=TRUE) } } lls <- sapply(res, function(x) x$ll) beta <- do.call(rbind, lapply(res, function(x) t(x$beta))) ci.lb <- do.call(rbind, lapply(res, function(x) t(x$ci.lb))) ci.ub <- do.call(rbind, lapply(res, function(x) t(x$ci.ub))) ######################################################################### if (any(lls >= logLik(x) + lltol, na.rm=TRUE)) warning(mstyle$warning("At least one profiled log-likelihood value is larger than the log-likelihood of the fitted model."), call.=FALSE) if (all(is.na(lls))) warning(mstyle$warning("All model fits failed. Cannot draw profile likelihood plot."), call.=FALSE) beta <- data.frame(beta) ci.lb <- data.frame(ci.lb) ci.ub <- data.frame(ci.ub) names(beta) <- rownames(x$beta) names(ci.lb) <- rownames(x$beta) names(ci.ub) <- rownames(x$beta) if (missing(ylim)) { if (any(is.finite(lls))) { if (xlim[1] <= vc && xlim[2] >= vc) { ylim <- range(c(logLik(x),lls[is.finite(lls)]), na.rm=TRUE) } else { ylim <- range(lls[is.finite(lls)]) } } else { ylim <- rep(logLik(x), 2L) } ylim <- ylim + c(-0.1, 0.1) } else { if (length(ylim) != 2L) stop(mstyle$stop("Argument 'ylim' should be a vector of length 2.")) ylim <- sort(ylim) } if (comp == "sigma2") { if (x$sigma2s == 1L) { xlab <- expression(paste(sigma^2, " Value")) title <- expression(paste("Profile Plot for ", sigma^2)) } else { xlab <- bquote(sigma[.(sigma2)]^2 ~ "Value") title <- bquote("Profile Plot for" ~ sigma[.(sigma2)]^2) } } if (comp == "tau2") { if (x$tau2s == 1L) { xlab <- expression(paste(tau^2, " Value")) title <- expression(paste("Profile Plot for ", tau^2)) } else { xlab <- bquote(tau[.(tau2)]^2 ~ "Value") title <- bquote("Profile Plot for" ~ tau[.(tau2)]^2) } } if (comp == "rho") { if (x$rhos == 1L) { xlab <- expression(paste(rho, " Value")) title <- expression(paste("Profile Plot for ", rho)) } else { xlab <- bquote(rho[.(rho)] ~ "Value") title <- bquote("Profile Plot for" ~ rho[.(rho)]) } } if (comp == "gamma2") { if (x$gamma2s == 1L) { xlab <- expression(paste(gamma^2, " Value")) title <- expression(paste("Profile Plot for ", gamma^2)) } else { xlab <- bquote(gamma[.(gamma2)]^2 ~ "Value") title <- bquote("Profile Plot for" ~ gamma[.(gamma2)]^2) } } if (comp == "phi") { if (x$phis == 1L) { xlab <- expression(paste(phi, " Value")) title <- expression(paste("Profile Plot for ", phi)) } else { xlab <- bquote(phi[.(phi)] ~ "Value") title <- bquote("Profile Plot for" ~ phi[.(phi)]) } } sav <- list(vc=vcs, ll=lls, beta=beta, ci.lb=ci.lb, ci.ub=ci.ub, comps=1, ylim=ylim, method=x$method, vc=vc, maxll=logLik(x), xlab=xlab, title=title) names(sav)[1] <- switch(comp, sigma2="sigma2", tau2="tau2", rho="rho", gamma2="gamma2", phi="phi") class(sav) <- "profile.rma" ######################################################################### if (plot) plot(sav, pch=pch, refline=refline, cline=cline, ...) ######################################################################### if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } invisible(sav) } metafor/R/baujat.r0000644000176200001440000000006213457322061013542 0ustar liggesusersbaujat <- function(x, ...) UseMethod("baujat") metafor/R/leave1out.rma.mh.r0000644000176200001440000001067214440116101015357 0ustar liggesusersleave1out.rma.mh <- function(x, digits, transf, targs, progbar=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.mh") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (!x$int.only) stop(mstyle$stop("Method only applicable to models without moderators.")) if (x$k == 1) stop(mstyle$stop("Stopped because k = 1.")) if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL ddd <- list(...) .chkdots(ddd, c("time")) if (.isTRUE(ddd$time)) time.start <- proc.time() ######################################################################### beta <- rep(NA_real_, x$k.f) se <- rep(NA_real_, x$k.f) zval <- rep(NA_real_, x$k.f) pval <- rep(NA_real_, x$k.f) ci.lb <- rep(NA_real_, x$k.f) ci.ub <- rep(NA_real_, x$k.f) QE <- rep(NA_real_, x$k.f) QEp <- rep(NA_real_, x$k.f) #tau2 <- rep(NA_real_, x$k.f) I2 <- rep(NA_real_, x$k.f) H2 <- rep(NA_real_, x$k.f) ### elements that need to be returned outlist <- "beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, QE=QE, QEp=QEp, tau2=tau2, I2=I2, H2=H2" ### note: skipping NA cases if (progbar) pbar <- pbapply::startpb(min=0, max=x$k.f) for (i in seq_len(x$k.f)) { if (progbar) pbapply::setpb(pbar, i) if (!x$not.na[i]) next if (is.element(x$measure, c("RR","OR","RD"))) { args <- list(ai=x$outdat.f$ai, bi=x$outdat.f$bi, ci=x$outdat.f$ci, di=x$outdat.f$di, measure=x$measure, add=x$add, to=x$to, drop00=x$drop00, correct=x$correct, level=x$level, subset=-i, outlist=outlist) } else { args <- list(x1i=x$outdat.f$x1i, x2i=x$outdat.f$x2i, t1i=x$outdat.f$t1i, t2i=x$outdat.f$t2i, measure=x$measure, add=x$add, to=x$to, drop00=x$drop00, correct=x$correct, level=x$level, subset=-i, outlist=outlist) } res <- try(suppressWarnings(.do.call(rma.mh, args)), silent=TRUE) if (inherits(res, "try-error")) next beta[i] <- res$beta se[i] <- res$se zval[i] <- res$zval pval[i] <- res$pval ci.lb[i] <- res$ci.lb ci.ub[i] <- res$ci.ub QE[i] <- res$QE QEp[i] <- res$QEp #tau2[i] <- res$tau2 I2[i] <- res$I2 H2[i] <- res$H2 } if (progbar) pbapply::closepb(pbar) ######################################################################### ### if requested, apply transformation function if (.isTRUE(transf) && is.element(x$measure, c("OR","RR","IRR"))) ### if transf=TRUE, apply exp transformation to ORs, RRs, and IRRs transf <- exp if (is.function(transf)) { if (is.null(targs)) { beta <- sapply(beta, transf) se <- rep(NA_real_, x$k.f) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) } else { beta <- sapply(beta, transf, targs) se <- rep(NA_real_, x$k.f) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) } transf <- TRUE } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] ######################################################################### if (na.act == "na.omit") { out <- list(estimate=beta[x$not.na], se=se[x$not.na], zval=zval[x$not.na], pval=pval[x$not.na], ci.lb=ci.lb[x$not.na], ci.ub=ci.ub[x$not.na], Q=QE[x$not.na], Qp=QEp[x$not.na], I2=I2[x$not.na], H2=H2[x$not.na]) out$slab <- x$slab[x$not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(estimate=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, Q=QE, Qp=QEp, I2=I2, H2=H2) out$slab <- x$slab } if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) out$digits <- digits out$transf <- transf if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(out) <- "list.rma" return(out) } metafor/R/weights.rma.peto.r0000644000176200001440000000304414247653721015505 0ustar liggesusersweights.rma.peto <- function(object, type="diagonal", ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.peto") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) type <- match.arg(type, c("diagonal", "matrix")) x <- object ######################################################################### n1i <- with(x$outdat, ai + bi) n2i <- with(x$outdat, ci + di) Ni <- with(x$outdat, ai + bi + ci + di) xt <- with(x$outdat, ai + ci) yt <- with(x$outdat, bi + di) wi <- xt * yt * (n1i/Ni) * (n2i/Ni) / (Ni - 1) ######################################################################### if (type == "diagonal") { weight <- rep(NA_real_, x$k.f) weight[x$not.na] <- wi / sum(wi) * 100 names(weight) <- x$slab if (na.act == "na.omit") weight <- weight[x$not.na] if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in weights.")) return(weight) } if (type == "matrix") { Wfull <- matrix(NA_real_, nrow=x$k.f, ncol=x$k.f) Wfull[x$not.na, x$not.na] <- diag(wi) rownames(Wfull) <- x$slab colnames(Wfull) <- x$slab if (na.act == "na.omit") Wfull <- Wfull[x$not.na, x$not.na, drop=FALSE] if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) return(Wfull) } } metafor/R/profile.rma.ls.r0000644000176200001440000002132614413113733015132 0ustar liggesusersprofile.rma.ls <- function(fitted, alpha, xlim, ylim, steps=20, lltol=1e-03, progbar=TRUE, parallel="no", ncpus=1, cl, plot=TRUE, pch=19, refline=TRUE, cline=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(fitted), must="rma.ls") if (steps < 2) stop(mstyle$stop("Argument 'steps' must be >= 2.")) x <- fitted parallel <- match.arg(parallel, c("no", "snow", "multicore")) if (parallel == "no" && ncpus > 1) parallel <- "snow" if (missing(cl)) cl <- NULL if (!is.null(cl) && inherits(cl, "SOCKcluster")) { parallel <- "snow" ncpus <- length(cl) } if (parallel == "snow" && ncpus < 2) parallel <- "no" if (parallel == "snow" || parallel == "multicore") { if (!requireNamespace("parallel", quietly=TRUE)) stop(mstyle$stop("Please install the 'parallel' package for parallel processing.")) ncpus <- as.integer(ncpus) if (ncpus < 1L) stop(mstyle$stop("Argument 'ncpus' must be >= 1.")) } if (x$optbeta) stop(mstyle$stop("Profiling not yet implemented for 'optbeta=TRUE'.")) if (!progbar) { pbo <- pbapply::pboptions(type="none") on.exit(pbapply::pboptions(pbo), add=TRUE) } ddd <- list(...) if (.isTRUE(ddd$time)) time.start <- proc.time() ######################################################################### ### check if user has not specified alpha argument if (missing(alpha)) { mc <- match.call() ### total number of non-fixed components comps <- sum(!x$alpha.fix) if (comps == 0) stop(mstyle$stop("No components in the model for which a profile likelihood can be constructed.")) if (plot) { if (dev.cur() == 1) { par(mfrow=n2mfrow(comps)) #on.exit(par(mfrow=c(1,1)), add=TRUE) } } sav <- list() j <- 0 if (any(!x$alpha.fix)) { for (pos in seq_len(x$alphas)[!x$alpha.fix]) { j <- j + 1 mc.vc <- mc mc.vc$alpha <- pos mc.vc$time <- FALSE #mc.vc$fitted <- quote(x) if (progbar) cat(mstyle$verbose(paste("Profiling alpha =", pos, "\n"))) sav[[j]] <- eval(mc.vc, envir=parent.frame()) } } ### if there is just one component, turn the list of lists into a simple list if (comps == 1) sav <- sav[[1]] sav$comps <- comps if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(sav) <- "profile.rma" return(invisible(sav)) } ### check if model actually contains (at least one) such a component and that it was actually estimated if (!missing(alpha) && all(x$alpha.fix)) stop(mstyle$stop("Model does not contain any estimated 'alpha' components.")) ### check if user specified more than one alpha component if (!missing(alpha) && (length(alpha) > 1L)) stop(mstyle$stop("Can only specify one 'alpha' component.")) ### check if user specified a logical if (!missing(alpha) && is.logical(alpha)) stop(mstyle$stop("Must specify a number for the 'alpha' component.")) ### check if user specified a component that does not exist if (!missing(alpha) && (alpha > x$alphas || alpha <= 0)) stop(mstyle$stop("No such 'alpha' component in the model.")) ### check if user specified a component that was fixed if (!missing(alpha) && x$alpha.fix[alpha]) stop(mstyle$stop("Specified 'alpha' component was fixed.")) ### if everything is good so far, get value of the component and set 'comp' alpha.pos <- NA_integer_ if (!missing(alpha)) { vc <- x$alpha[alpha] comp <- "alpha" alpha.pos <- alpha } #return(list(comp=comp, vc=vc)) if (missing(xlim)) { ### if the user has not specified xlim, set it automatically if (comp == "alpha") { if (is.na(x$se.alpha[alpha])) { vc.lb <- vc - 4 * abs(vc) vc.ub <- vc + 4 * abs(vc) } else { vc.lb <- vc - qnorm(.995) * x$se.alpha[alpha] vc.ub <- vc + qnorm(.995) * x$se.alpha[alpha] } } ### if that fails, throw an error if (is.na(vc.lb) || is.na(vc.ub)) stop(mstyle$stop("Cannot set 'xlim' automatically. Please set this argument manually.")) if (!is.null(x$control$alpha.min)) { if (length(x$control$alpha.min) == 1L) x$control$alpha.min <- rep(x$control$alpha.min, x$q) vc.lb <- max(vc.lb, x$con$alpha.min[alpha]) } if (!is.null(x$control$alpha.max)) { if (length(x$control$alpha.max) == 1L) x$control$alpha.max <- rep(x$control$alpha.max, x$q) vc.ub <- min(vc.ub, x$con$alpha.max[alpha]) } xlim <- sort(c(vc.lb, vc.ub)) } else { if (length(xlim) != 2L) stop(mstyle$stop("Argument 'xlim' should be a vector of length 2.")) xlim <- sort(xlim) } vcs <- seq(xlim[1], xlim[2], length.out=steps) if (length(vcs) <= 1L) stop(mstyle$stop("Cannot set 'xlim' automatically. Please set this argument manually.")) if (parallel == "no") res <- pbapply::pblapply(vcs, .profile.rma.ls, obj=x, comp=comp, alpha.pos=alpha.pos, parallel=parallel, profile=TRUE) if (parallel == "multicore") res <- pbapply::pblapply(vcs, .profile.rma.ls, obj=x, comp=comp, alpha.pos=alpha.pos, parallel=parallel, profile=TRUE, cl=ncpus) #res <- parallel::mclapply(vcs, .profile.rma.ls, obj=x, comp=comp, alpha.pos=alpha.pos, parallel=parallel, profile=TRUE, mc.cores=ncpus) if (parallel == "snow") { if (is.null(cl)) { cl <- parallel::makePSOCKcluster(ncpus) on.exit(parallel::stopCluster(cl), add=TRUE) } if (.isTRUE(ddd$LB)) { res <- parallel::parLapplyLB(cl, vcs, .profile.rma.ls, obj=x, comp=comp, alpha.pos=alpha.pos, parallel=parallel, profile=TRUE) #res <- parallel::clusterApplyLB(cl, vcs, .profile.rma.ls, obj=x, comp=comp, alpha.pos=alpha.pos, parallel=parallel, profile=TRUE) } else { res <- pbapply::pblapply(vcs, .profile.rma.ls, obj=x, comp=comp, alpha.pos=alpha.pos, parallel=parallel, profile=TRUE, cl=cl) #res <- parallel::parLapply(cl, vcs, .profile.rma.ls, obj=x, comp=comp, alpha.pos=alpha.pos, parallel=parallel, profile=TRUE) #res <- parallel::clusterApply(cl, vcs, .profile.rma.ls, obj=x, comp=comp, alpha.pos=alpha.pos, parallel=parallel, profile=TRUE) } } lls <- sapply(res, function(x) x$ll) beta <- do.call(rbind, lapply(res, function(x) t(x$beta))) ci.lb <- do.call(rbind, lapply(res, function(x) t(x$ci.lb))) ci.ub <- do.call(rbind, lapply(res, function(x) t(x$ci.ub))) ######################################################################### if (any(lls >= logLik(x) + lltol, na.rm=TRUE)) warning(mstyle$warning("At least one profiled log-likelihood value is larger than the log-likelihood of the fitted model."), call.=FALSE) if (all(is.na(lls))) warning(mstyle$warning("All model fits failed. Cannot draw profile likelihood plot."), call.=FALSE) beta <- data.frame(beta) ci.lb <- data.frame(ci.lb) ci.ub <- data.frame(ci.ub) names(beta) <- rownames(x$beta) names(ci.lb) <- rownames(x$beta) names(ci.ub) <- rownames(x$beta) if (missing(ylim)) { if (any(is.finite(lls))) { if (xlim[1] <= vc && xlim[2] >= vc) { ylim <- range(c(logLik(x),lls[is.finite(lls)]), na.rm=TRUE) } else { ylim <- range(lls[is.finite(lls)]) } } else { ylim <- rep(logLik(x), 2L) } ylim <- ylim + c(-0.1, 0.1) } else { if (length(ylim) != 2L) stop(mstyle$stop("Argument 'ylim' should be a vector of length 2.")) ylim <- sort(ylim) } if (comp == "alpha") { if (x$alphas == 1L) { xlab <- expression(paste(alpha, " Value")) title <- expression(paste("Profile Plot for ", alpha)) } else { if (.isTRUE(ddd$sub1)) alpha <- alpha - 1 xlab <- bquote(alpha[.(alpha)] ~ "Value") title <- bquote("Profile Plot for" ~ alpha[.(alpha)]) } } sav <- list(vc=vcs, ll=lls, beta=beta, ci.lb=ci.lb, ci.ub=ci.ub, comps=1, ylim=ylim, method=x$method, vc=vc, maxll=logLik(x), xlab=xlab, title=title) names(sav)[1] <- "alpha" class(sav) <- "profile.rma" ######################################################################### if (plot) plot(sav, pch=pch, refline=refline, cline=cline, ...) ######################################################################### if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } invisible(sav) } metafor/R/labbe.r0000644000176200001440000000006013457322061013337 0ustar liggesuserslabbe <- function(x, ...) UseMethod("labbe") metafor/R/robust.rma.mv.r0000644000176200001440000002506314401677033015023 0ustar liggesusersrobust.rma.mv <- function(x, cluster, adjust=TRUE, clubSandwich=FALSE, digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.mv") if (missing(cluster)) stop(mstyle$stop("Must specify 'cluster' variable.")) if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } level <- .level(x$level) ddd <- list(...) .chkdots(ddd, c("vcov", "coef_test", "conf_test", "wald_test", "verbose")) ######################################################################### ### process cluster variable ### note: cluster variable is assumed to be of the same length as the original data passed to the model fitting function ### so we have to apply the same subsetting (if necessary) and removing of missings as done during model fitting mf <- match.call() cluster <- .getx("cluster", mf=mf, data=x$data) if (length(cluster) != x$k.all) stop(mstyle$stop(paste0("Length of variable specified via 'cluster' (", length(cluster), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) cluster <- .getsubset(cluster, x$subset) cluster <- cluster[x$not.na] if (anyNA(cluster)) stop(mstyle$stop("No missing values allowed in 'cluster' variable.")) if (length(cluster) == 0L) stop(mstyle$stop("Cannot find 'cluster' variable (or it has zero length).")) ### number of clusters n <- length(unique(cluster)) ### compute degrees of freedom ### note: Stata with vce(robust) also uses n-p as the dfs, but with vce(cluster ) always uses n-1 (which seems inconsistent) dfs <- n - x$p ### check if dfs are positive (note: this also handles the case where there is a single cluster) if (!clubSandwich && dfs <= 0) stop(mstyle$stop(paste0("Number of clusters (", n, ") must be larger than the number of fixed effects (", x$p, ")."))) ### use clubSandwich if requested to do so if (clubSandwich) { if (!suppressMessages(requireNamespace("clubSandwich", quietly=TRUE))) stop(mstyle$stop("Please install the 'clubSandwich' package to make use of its methods.")) ### check for vcov, coef_test, conf_test, and wald_test arguments in ... and set values accordingly if (is.null(ddd$vcov)) { ddd$vcov <- "CR2" } else { ddd$vcov <- match.arg(ddd$vcov, c("CR0", "CR1", "CR1p", "CR1S", "CR2", "CR3")) } if (is.null(ddd$coef_test)) { ddd$coef_test <- "Satterthwaite" } else { ddd$coef_test <- match.arg(ddd$coef_test, c("z", "naive-t", "naive-tp", "Satterthwaite", "saddlepoint")) } if (is.null(ddd$conf_test)) { ddd$conf_test <- ddd$coef_test if (ddd$conf_test == "saddlepoint") { ddd$conf_test <- "Satterthwaite" warning(mstyle$warning("Cannot use 'saddlepoint' for conf_test() - using 'Satterthwaite' instead."), call.=FALSE) } } else { ddd$conf_test <- match.arg(ddd$conf_test, c("z", "naive-t", "naive-tp", "Satterthwaite")) } if (is.null(ddd$wald_test)) { ddd$wald_test <- "HTZ" } else { ddd$wald_test <- match.arg(ddd$wald_test, c("chi-sq", "Naive-F", "HTA", "HTB", "HTZ", "EDF", "EDT")) } ### calculate cluster-robust var-cov matrix of the estimated fixed effects vb <- try(clubSandwich::vcovCR(x, cluster=cluster, type=ddd$vcov), silent=!isTRUE(ddd$verbose)) if (inherits(vb, "try-error")) stop(mstyle$stop("Could not obtain the cluster-robust variance-covariance matrix (use verbose=TRUE for more details).")) #meat <- try(clubSandwich::vcovCR(x, cluster=cluster, type=ddd$vcov, form="meat"), silent=!isTRUE(ddd$verbose)) meat <- NA_real_ ### obtain cluster-robust inferences cs.coef <- try(clubSandwich::coef_test(x, cluster=cluster, vcov=vb, test=ddd$coef_test, p_values=TRUE), silent=!isTRUE(ddd$verbose)) if (inherits(cs.coef, "try-error")) stop(mstyle$stop("Could not obtain the cluster-robust tests (use verbose=TRUE for more details).")) cs.conf <- try(clubSandwich::conf_int(x, cluster=cluster, vcov=vb, test=ddd$conf_test, level=1-level), silent=!isTRUE(ddd$verbose)) if (inherits(cs.conf, "try-error")) stop(mstyle$stop("Could not obtain the cluster-robust confidence intervals (use verbose=TRUE for more details).")) if (x$int.only) { cs.wald <- NA_real_ } else { cs.wald <- try(clubSandwich::Wald_test(x, cluster=cluster, vcov=vb, test=ddd$wald_test, constraints=clubSandwich::constrain_zero(x$btt)), silent=!isTRUE(ddd$verbose)) if (inherits(cs.wald, "try-error")) { warning(mstyle$warning("Could not obtain the cluster-robust omnibus Wald test (use verbose=TRUE for more details).")) cs.wald <- list(Fstat=NA_real_, df_num=NA_integer_, df_denom=NA_real_) } } #return(list(coef_test=cs.coef, conf_int=cs.conf, Wald_test=cs.wald)) vbest <- ddd$vcov beta <- x$beta se <- cs.coef$SE zval <- ifelse(is.infinite(cs.coef$tstat), NA_real_, cs.coef$tstat) pval <- switch(ddd$coef_test, "z" = cs.coef$p_z, "naive-t" = cs.coef$p_t, "naive-tp" = cs.coef$p_tp, "Satterthwaite" = cs.coef$p_Satt, "saddlepoint" = cs.coef$p_saddle) dfs <- switch(ddd$coef_test, "z" = cs.coef$df_z, "naive-t" = cs.coef$df_t, "naive-tp" = cs.coef$df_tp, "Satterthwaite" = cs.coef$df, "saddlepoint" = NA_real_) dfs <- ifelse(is.na(dfs), NA_real_, dfs) # ifelse() part to change NaN into just NA ci.lb <- ifelse(is.na(cs.conf$CI_L), NA_real_, cs.conf$CI_L) # note: if ddd$coef_test != ddd$conf_test, dfs for CI may be different ci.ub <- ifelse(is.na(cs.conf$CI_U), NA_real_, cs.conf$CI_U) if (x$int.only) { QM <- max(0, zval^2) QMdf <- c(1, dfs) QMp <- pval } else { QM <- max(0, cs.wald$Fstat) QMdf <- c(cs.wald$df_num, max(0, cs.wald$df_denom)) QMp <- cs.wald$p_val } x$sandwiches <- list(coef_test=cs.coef, conf_int=cs.conf, Wald_test=cs.wald) x$coef_test <- ddd$coef_test x$conf_test <- ddd$conf_test x$wald_test <- ddd$wald_test cluster.o <- cluster } else { ### note: since we use split() below and then put things back together into a block-diagonal matrix, ### we have to make sure everything is properly ordered by the cluster variable; otherwise, the 'meat' ### block-diagonal matrix is not in the same order as the rest; so we sort all relevant variables by ### the cluster variable (including the cluster variable itself) ocl <- order(cluster) cluster.o <- cluster[ocl] ### construct bread = (X'WX)^-1 X'W, where W is the weight matrix if (is.null(x$W)) { ### if no weights were specified, then vb = (X'WX)^-1, so we can use that part W <- try(chol2inv(chol(x$M[ocl,ocl])), silent=TRUE) if (inherits(W, "try-error")) stop(mstyle$stop("Cannot invert marginal var-cov matrix.")) bread <- x$vb %*% crossprod(x$X[ocl,], W) } else { ### if weights were specified, then vb cannot be used A <- x$W[ocl,ocl] stXAX <- chol2inv(chol(as.matrix(t(x$X[ocl,]) %*% A %*% x$X[ocl,]))) # as.matrix() to avoid some issues with the matrix being not symmetric (when it must be) bread <- stXAX %*% crossprod(x$X[ocl,], A) } ### construct meat part ei <- c(x$yi - x$X %*% x$beta) # use this instead of resid(), since this guarantees that the length is correct ei <- ei[ocl] cluster.o <- factor(cluster.o, levels=unique(cluster.o)) if (x$sparse) { meat.o <- bdiag(lapply(split(ei, cluster.o), function(e) tcrossprod(e))) } else { meat.o <- bldiag(lapply(split(ei, cluster.o), function(e) tcrossprod(e))) } ### construct robust var-cov matrix vb <- bread %*% meat.o %*% t(bread) ### apply adjustments to vb as needed vbest <- "CR0" ### suggested in Hedges, Tipton, & Johnson (2010) -- analogous to HC1 adjustment if (.isTRUE(adjust)) { vb <- (n / dfs) * vb vbest <- "CR1" } ### what Stata does if (is.character(adjust) && (adjust=="Stata" || adjust=="Stata1")) { vb <- (n / (n-1) * (x$k-1) / (x$k-x$p)) * vb # when the model was fitted with regress vbest <- "CR1.S1" } if (is.character(adjust) && adjust=="Stata2") { vb <- (n / (n-1)) * vb # when the model was fitted with mixed vbest <- "CR1.S2" } ### dim(vb) is pxp and not sparse, so this won't blow up ### as.matrix() helps to avoid some issues with 'vb' appearing as non-symmetric (when it must be) if (x$sparse) vb <- as.matrix(vb) ### check for elements in vb that are essentially 0 is0 <- diag(vb) < 100 * .Machine$double.eps vb[is0,] <- NA_real_ vb[,is0] <- NA_real_ ### prepare results beta <- x$beta se <- sqrt(diag(vb)) names(se) <- NULL zval <- c(beta/se) pval <- 2*pt(abs(zval), df=dfs, lower.tail=FALSE) crit <- qt(level/2, df=dfs, lower.tail=FALSE) ci.lb <- c(beta - crit * se) ci.ub <- c(beta + crit * se) QM <- try(as.vector(t(beta)[x$btt] %*% chol2inv(chol(vb[x$btt,x$btt])) %*% beta[x$btt]), silent=TRUE) if (inherits(QM, "try-error") || is.na(QM)) { warning(mstyle$warning("Could not obtain the cluster-robust omnibus Wald test.")) QM <- NA_real_ } QM <- QM / x$m # note: m is the number of coefficients in btt, not the number of clusters QMdf <- c(x$m, dfs) QMp <- pf(QM, df1=x$m, df2=dfs, lower.tail=FALSE) ### don't need this anymore at the moment meat <- matrix(NA_real_, nrow=nrow(meat.o), ncol=ncol(meat.o)) meat[ocl,ocl] <- as.matrix(meat.o) } ######################################################################### ### table of cluster variable tcl <- table(cluster.o) x$digits <- digits ### replace elements with robust results x$ddf <- dfs x$dfs <- dfs x$vb <- vb x$se <- se x$zval <- zval x$pval <- pval x$ci.lb <- ci.lb x$ci.ub <- ci.ub x$QM <- QM x$QMdf <- QMdf x$QMp <- QMp x$n <- n x$tcl <- tcl x$test <- "t" x$vbest <- vbest x$s2w <- 1 x$robumethod <- ifelse(clubSandwich, "clubSandwich", "default") x$cluster <- cluster x$meat <- meat class(x) <- c("robust.rma", "rma", "rma.mv") return(x) } metafor/R/hc.rma.uni.r0000644000176200001440000001177714465405103014254 0ustar liggesusershc.rma.uni <- function(object, digits, transf, targs, control, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.uni", notav=c("rma.ls", "rma.gen", "rma.uni.selmodel")) x <- object if (!x$int.only) stop(mstyle$stop("Method only applicable to models without moderators.")) if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL yi <- x$yi vi <- x$vi k <- length(yi) if (k == 1) stop(mstyle$stop("Stopped because k = 1.")) if (!x$allvipos) stop(mstyle$stop("Cannot use method when one or more sampling variances are non-positive.")) level <- .level(x$level) if (missing(control)) control <- list() ######################################################################### ### set control parameters for uniroot() and possibly replace with user-defined values con <- list(tol=.Machine$double.eps^0.25, maxiter=1000, verbose=FALSE) con.pos <- pmatch(names(control), names(con)) con[c(na.omit(con.pos))] <- control[!is.na(con.pos)] ######################################################################### ### original code by Henmi & Copas (2012), modified by Michael Dewey, small adjustments ### for consistency with other functions in the metafor package by Wolfgang Viechtbauer wi <- 1/vi ### fixed effects weights W1 <- sum(wi) W2 <- sum(wi^2) / W1 W3 <- sum(wi^3) / W1 W4 <- sum(wi^4) / W1 ### fixed-effects estimate of theta beta <- sum(wi*yi) / W1 ### Q statistic Q <- sum(wi * ((yi - beta)^2)) ### DL estimate of tau^2 tau2 <- max(0, (Q - (k-1)) / (W1 - W2)) vb <- (tau2 * W2 + 1) / W1 # estimated Var of b se <- sqrt(vb) # estimated SE of b VR <- 1 + tau2 * W2 # estimated Var of R SDR <- sqrt(VR) # estimated SD of R ### conditional mean of Q given R=r EQ <- function(r) (k - 1) + tau2 * (W1 - W2) + (tau2^2)*((1/VR^2) * (r^2) - 1/VR) * (W3 - W2^2) ### conditional variance of Q given R=r VQ <- function(r) { rsq <- r^2 recipvr2 <- 1 / VR^2 2 * (k - 1) + 4 * tau2 * (W1 - W2) + 2 * tau2^2 * (W1*W2 - 2*W3 + W2^2) + 4 * tau2^2 * (recipvr2 * rsq - 1/VR) * (W3 - W2^2) + 4 * tau2^3 * (recipvr2 * rsq - 1/VR) * (W4 - 2*W2*W3 + W2^3) + 2 * tau2^4 * (recipvr2 - 2 * (1/VR^3) * rsq) * (W3 - W2^2)^2 } scale <- function(r) VQ(r) / EQ(r) # scale parameter of the gamma distribution shape <- function(r) EQ(r)^2 / VQ(r) # shape parameter of the gamma distribution ### inverse of f finv <- function(f) (W1/W2 - 1) * ((f^2) - 1) + (k - 1) ### equation to be solved eqn <- function(x) { integrand <- function(r) { pgamma(finv(r/x), scale=scale(SDR*r), shape=shape(SDR*r))*dnorm(r) } integral <- integrate(integrand, lower=x, upper=Inf)$value val <- integral - level / 2 #cat(val, "\n") val } t0 <- try(uniroot(eqn, lower=0, upper=2, tol=con$tol, maxiter=con$maxiter)) if (inherits(t0, "try-error")) stop(mstyle$stop("Error in uniroot().")) t0 <- t0$root u0 <- SDR * t0 # (approximate) percentage point for the distribution of U ######################################################################### ci.lb <- beta - u0 * se # lower CI bound ci.ub <- beta + u0 * se # upper CI bound beta.rma <- x$beta se.rma <- x$se ci.lb.rma <- x$ci.lb ci.ub.rma <- x$ci.ub ### if requested, apply transformation to yi's and CI bounds if (is.function(transf)) { if (is.null(targs)) { beta <- sapply(beta, transf) beta.rma <- sapply(beta.rma, transf) se <- NA_real_ se.rma <- NA_real_ ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) ci.lb.rma <- sapply(ci.lb.rma, transf) ci.ub.rma <- sapply(ci.ub.rma, transf) } else { beta <- sapply(beta, transf, targs) beta.rma <- sapply(beta.rma, transf, targs) se <- NA_real_ se.rma <- NA_real_ ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) ci.lb.rma <- sapply(ci.lb.rma, transf, targs) ci.ub.rma <- sapply(ci.ub.rma, transf, targs) } } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] tmp <- .psort(ci.lb.rma, ci.ub.rma) ci.lb.rma <- tmp[,1] ci.ub.rma <- tmp[,2] ######################################################################### res <- list(beta=beta, se=se, ci.lb=ci.lb, ci.ub=ci.ub, beta.rma=beta.rma, se.rma=se.rma, ci.lb.rma=ci.lb.rma, ci.ub.rma=ci.ub.rma, method="DL", method.rma=x$method, tau2=tau2, tau2.rma=x$tau2, digits=digits) class(res) <- "hc.rma.uni" return(res) } metafor/R/print.confint.rma.r0000644000176200001440000000223214412013204015632 0ustar liggesusersprint.confint.rma <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="confint.rma") digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) .space() if (names(x)[1] == "fixed") { res.fixed <- cbind(fmtx(x$fixed[,1,drop=FALSE], digits[["est"]]), fmtx(x$fixed[,2:3,drop=FALSE], digits[["ci"]])) tmp <- capture.output(print(res.fixed, quote=FALSE, right=TRUE)) .print.table(tmp, mstyle) } if (is.element("random", names(x))) { if (names(x)[1] == "fixed") cat("\n") res.random <- fmtx(x$random, digits[["var"]]) res.random[,2] <- paste0(x$lb.sign, res.random[,2]) res.random[,3] <- paste0(x$ub.sign, res.random[,3]) tmp <- capture.output(print(res.random, quote=FALSE, right=TRUE)) .print.table(tmp, mstyle) ### this can only (currently) happen for 'rma.uni' models if (x$ci.null) message(mstyle$message(paste0("\nThe upper and lower CI bounds for tau^2 both fall below ", round(x$tau2.min,4), ".\nThe CIs are therefore equal to the null/empty set."))) } .space() invisible() } metafor/R/emmprep.r0000644000176200001440000001276314436353146013762 0ustar liggesusersemmprep <- function(x, verbose=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma") if (!requireNamespace("emmeans", quietly=TRUE)) stop(mstyle$stop("Please install the 'emmeans' package to use this function.")) if (any(x$coef.na)) stop(mstyle$stop("Cannot use function when some redundant predictors were dropped from the model.")) ### check if a formula is available formula <- formula(x) if (is.null(formula) && x$int.only) formula <- ~ 1 if (is.null(formula)) stop(mstyle$stop("Cannot use function when model was fitted without a formula specification.")) if (verbose) { .space() cat("Extracted formula: ~", paste(paste(formula)[-1], collapse=""), "\n") } ### get coefficients and corresponding var-cov matrix b <- coef(x, type="beta") vb <- vcov(x, type="beta") ### change intrcpt to (Intercept) names(b) <- sub("intrcpt", "(Intercept)", names(b)) rownames(vb) <- sub("intrcpt", "(Intercept)", rownames(vb)) colnames(vb) <- sub("intrcpt", "(Intercept)", colnames(vb)) ######################################################################### ddd <- list(...) ### get data and apply subsetting / removal of missings as needed if (is.null(ddd$data)) { dat <- x$data if (is.null(dat)) stop(mstyle$stop("Cannot use function when the model object does not contain the original data.")) if (!is.null(x$subset)) dat <- dat[x$subset,,drop=FALSE] dat <- dat[x$not.na,,drop=FALSE] } else { dat <- ddd$data ddd$data <- NULL } ### set the degrees of freedom (use minimum value if there are multiple) if (is.null(ddd$df)) { if (is.na(x$ddf[1])) { ddf <- Inf } else { ddf <- min(x$ddf) } } else { ddf <- ddd$df ddd$df <- NULL } if (verbose && is.finite(ddf)) cat("Degrees of freedom:", round(ddf, 2), "\n") ### set sigma for bias adjustment if (is.null(ddd$sigma)) { if (!inherits(x, c("rma.ls","rma.mv"))) { sigma <- sqrt(x$tau2) } else { sigma <- NA_real_ } } else { sigma <- ddd$sigma ddd$sigma <- NULL } if (verbose && !is.na(sigma) && !is.element(x$method, c("FE","EE","CE"))) cat("Value of tau^2: ", round(sigma^2, 4), "\n") if (is.na(sigma)) sigma <- 0 ### create grid #out <- emmeans::qdrg(formula=formula, data=dat, coef=b, vcov=vb, df=ddf, sigma=sigma, ...) out <- do.call(emmeans::qdrg, c(list(formula=formula, data=dat, coef=b, vcov=vb, df=ddf, sigma=sigma), ddd)) ### set (back)transformation if (is.null(ddd$tran)) { if (is.element(x$measure, c("RR","OR","MPORM","PETO","MPRR","MPOR","MPORC","MPPETO","IRR","ROM","D2OR","D2ORL","D2ORN","CVR","VR","PLN","IRLN","SDLN","MNLN","CVLN","ROMC","CVRC","VRC","REH"))) { out@misc$tran <- "log" #out@misc$tran <- emmeans::make.tran("genlog", 0) #out <- update(out, emmeans::make.tran("genlog", 0)) if (verbose) cat("Transformation: log\n") } if (is.element(x$measure, c("PLO"))) { out@misc$tran <- "logit" if (verbose) cat("Transformation: logit\n") } if (is.element(x$measure, c("PAS"))) { out <- update(out, emmeans::make.tran("asin.sqrt", 1)) if (verbose) cat("Transformation: asin.sqrt\n") } if (is.element(x$measure, c("IRS"))) { out@misc$tran <- "sqrt" if (verbose) cat("Transformation: sqrt\n") } if (is.element(x$measure, c("ZPHI","ZTET","ZPB","ZBIS","ZCOR","ZPCOR","ZSPCOR"))) { out@misc$tran$linkfun <- transf.rtoz out@misc$tran$linkinv <- transf.ztor out@misc$tran$mu.eta <- function(eta) 1/cosh(eta)^2 # derivative of transf.ztor(eta) (= tanh(eta)) out@misc$tran$valideta <- function(eta) all(is.finite(eta)) && all(abs(eta) <= 1) out@misc$tran$name <- "r-to-z" if (verbose) cat("Transformation: r-to-z\n") } if (is.element(x$measure, c("ZR2"))) { out@misc$tran$linkfun <- transf.r2toz out@misc$tran$linkinv <- transf.ztor2 out@misc$tran$mu.eta <- function(eta) 2*sinh(eta)/cosh(eta)^3 # derivative of transf.ztor2(eta) (= tanh(eta)^2) out@misc$tran$valideta <- function(eta) all(is.finite(eta)) && all(eta <= 1) && all(eta >= 0) out@misc$tran$name <- "r-to-z" if (verbose) cat("Transformation: r-to-z\n") } if (is.element(x$measure, c("AHW"))) { out@misc$tran$linkfun <- transf.ahw out@misc$tran$linkinv <- transf.iahw out@misc$tran$mu.eta <- function(eta) 3*(1-eta)^2 out@misc$tran$valideta <- function(eta) all(is.finite(eta)) && all(eta <= 1) && all(eta >= 0) out@misc$tran$name <- "ahw" if (verbose) cat("Transformation: ahw\n") } if (is.element(x$measure, c("ABT"))) { out@misc$tran$linkfun <- transf.abt out@misc$tran$linkinv <- transf.iabt out@misc$tran$mu.eta <- function(eta) 1/(1-eta) out@misc$tran$valideta <- function(eta) all(is.finite(eta)) && all(eta <= 1) && all(eta >= 0) out@misc$tran$name <- "abt" if (verbose) cat("Transformation: abt\n") } } else { if (verbose) cat("Transformation: ", ddd$tran, "\n") } if (verbose) .space() return(out) } ############################################################################ metafor/R/aggregate.escalc.r0000644000176200001440000003076614467675431015507 0ustar liggesusersaggregate.escalc <- function(x, cluster, time, obs, V, struct="CS", rho, phi, weighted=TRUE, checkpd=TRUE, fun, na.rm=TRUE, addk=FALSE, subset, select, digits, var.names, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="escalc") if (any(!is.element(struct, c("ID","CS","CAR","CS+CAR","CS*CAR")))) stop(mstyle$stop("Unknown 'struct' specified.")) if (missing(cluster)) stop(mstyle$stop("Must specify 'cluster' variable.")) if (length(na.rm) == 1L) na.rm <- c(na.rm, na.rm) k <- nrow(x) ######################################################################### ### extract V, cluster, time, and subset variables mf <- match.call() V <- .getx("V", mf=mf, data=x) cluster <- .getx("cluster", mf=mf, data=x) time <- .getx("time", mf=mf, data=x) obs <- .getx("obs", mf=mf, data=x) subset <- .getx("subset", mf=mf, data=x) ######################################################################### ### checks on cluster variable if (anyNA(cluster)) stop(mstyle$stop("No missing values allowed in 'cluster' variable.")) if (length(cluster) != k) stop(mstyle$stop(paste0("Length of variable specified via 'cluster' (", length(cluster), ") does not match length of data (", k, ")."))) ucluster <- unique(cluster) n <- length(ucluster) ######################################################################### if (missing(var.names)) { if (!is.null(attr(x, "yi.names"))) { # if yi.names attributes is available yi.name <- attr(x, "yi.names")[1] # take the first entry to be the yi variable } else { # if not, see if 'yi' is in the object and assume that is the yi variable if (!is.element("yi", names(x))) stop(mstyle$stop("Cannot determine name of the 'yi' variable.")) yi.name <- "yi" } if (!is.null(attr(x, "vi.names"))) { # if vi.names attributes is available vi.name <- attr(x, "vi.names")[1] # take the first entry to be the vi variable } else { # if not, see if 'vi' is in the object and assume that is the vi variable if (!is.element("vi", names(x))) stop(mstyle$stop("Cannot determine name of the 'vi' variable.")) vi.name <- "vi" } } else { if (length(var.names) != 2L) stop(mstyle$stop("Argument 'var.names' must be of length 2.")) yi.name <- var.names[1] vi.name <- var.names[2] } yi <- as.vector(x[[yi.name]]) # as.vector() to strip attributes vi <- x[[vi.name]] if (is.null(yi)) stop(mstyle$stop(paste0("Cannot find variable '", yi.name, "' in the data frame."))) if (is.null(vi)) stop(mstyle$stop(paste0("Cannot find variable '", vi.name, "' in the data frame."))) if (!is.numeric(yi)) stop(mstyle$stop(paste0("Variable '", yi.name, "' is not numeric."))) if (!is.numeric(vi)) stop(mstyle$stop(paste0("Variable '", vi.name, "' is not numeric."))) ######################################################################### if (is.null(V)) { ### if V is not specified ### construct V matrix based on the specified structure if (struct=="ID") R <- diag(1, nrow=k, ncol=k) if (is.element(struct, c("CS","CS+CAR","CS*CAR"))) { if (missing(rho)) stop(mstyle$stop("Must specify 'rho' for this var-cov structure.")) if (length(rho) == 1L) rho <- rep(rho, n) if (length(rho) != n) stop(mstyle$stop(paste0("Length of 'rho' (", length(rho), ") does not match the number of clusters (", n, ")."))) if (any(rho > 1) || any(rho < -1)) stop(mstyle$stop("Value(s) of 'rho' must be in [-1,1].")) } if (is.element(struct, c("CAR","CS+CAR","CS*CAR"))) { if (missing(phi)) stop(mstyle$stop("Must specify 'phi' for this var-cov structure.")) if (length(phi) == 1L) phi <- rep(phi, n) if (length(phi) != n) stop(mstyle$stop(paste0("Length of 'phi' (", length(phi), ") does not match the number of clusters (", n, ")."))) if (any(phi > 1) || any(phi < 0)) stop(mstyle$stop("Value(s) of 'phi' must be in [0,1].")) ### checks on time variable if (!is.element("time", names(mf))) stop(mstyle$stop("Must specify 'time' variable for this var-cov structure.")) if (length(time) != k) stop(mstyle$stop(paste0("Length of variable specified via 'time' (", length(time), ") does not match length of data (", k, ")."))) if (struct == "CS*CAR") { ### checks on obs variable if (!is.element("obs", names(mf))) stop(mstyle$stop("Must specify 'obs' variable for this var-cov structure.")) if (length(obs) != k) stop(mstyle$stop(paste0("Length of variable specified via 'obs' (", length(obs), ") does not match length of data (", k, ")."))) } } if (struct=="CS") { R <- matrix(0, nrow=k, ncol=k) for (i in seq_len(n)) { R[cluster == ucluster[i], cluster == ucluster[i]] <- rho[i] } } if (struct == "CAR") { R <- matrix(0, nrow=k, ncol=k) for (i in seq_len(n)) { R[cluster == ucluster[i], cluster == ucluster[i]] <- outer(time[cluster == ucluster[i]], time[cluster == ucluster[i]], function(x,y) phi[i]^(abs(x-y))) } } if (struct == "CS+CAR") { R <- matrix(0, nrow=k, ncol=k) for (i in seq_len(n)) { R[cluster == ucluster[i], cluster == ucluster[i]] <- rho[i] + (1 - rho[i]) * outer(time[cluster == ucluster[i]], time[cluster == ucluster[i]], function(x,y) phi[i]^(abs(x-y))) } } if (struct == "CS*CAR") { R <- matrix(0, nrow=k, ncol=k) for (i in seq_len(n)) { R[cluster == ucluster[i], cluster == ucluster[i]] <- outer(obs[cluster == ucluster[i]], obs[cluster == ucluster[i]], function(x,y) ifelse(x==y, 1, rho[i])) * outer(time[cluster == ucluster[i]], time[cluster == ucluster[i]], function(x,y) phi[i]^(abs(x-y))) } } diag(R) <- 1 S <- diag(sqrt(as.vector(vi)), nrow=k, ncol=k) V <- S %*% R %*% S } else { ### if V is specified if (.is.vector(V)) { if (length(V) == 1L) V <- rep(V, k) if (length(V) != k) stop(mstyle$stop(paste0("Length of 'V' (", length(V), ") does not match length of data frame (", k, ")."))) V <- diag(as.vector(V), nrow=k, ncol=k) } if (is.data.frame(V)) V <- as.matrix(V) if (!is.null(dimnames(V))) V <- unname(V) if (!.is.square(V)) stop(mstyle$stop("'V' must be a square matrix.")) if (!isSymmetric(V)) stop(mstyle$stop("'V' must be a symmetric matrix.")) if (nrow(V) != k) stop(mstyle$stop(paste0("Dimensions of 'V' (", nrow(V), "x", ncol(V), ") do not match length of data frame (", k, ")."))) ### check that covariances are really 0 for estimates belonging to different clusters ### note: if na.rm[1] is FALSE, there may be missings in V, so skip check in those clusters for (i in seq_len(n)) { if (any(abs(V[cluster == ucluster[i], cluster != ucluster[i]]) >= .Machine$double.eps, na.rm=TRUE)) warning(mstyle$warning(paste0("Estimates in cluster '", ucluster[i], "' appear to have non-zero covariances with estimates belonging to different clusters.")), call.=FALSE) } } ### if 'subset' is not null, apply subset if (!is.null(subset)) { subset <- .chksubset(subset, k) x <- .getsubset(x, subset) yi <- .getsubset(yi, subset) V <- .getsubset(V, subset, col=TRUE) cluster <- .getsubset(cluster, subset) k <- nrow(x) ucluster <- unique(cluster) n <- length(ucluster) if (k == 0L) stop(mstyle$stop("Processing terminated since k == 0.")) } ### remove missings in yi/vi/V if na.rm[1] is TRUE if (na.rm[1]) { has.na <- is.na(yi) | .anyNAv(V) not.na <- !has.na if (any(has.na)) { x <- x[not.na,] yi <- yi[not.na] V <- V[not.na,not.na,drop=FALSE] cluster <- cluster[not.na] } k <- nrow(x) ucluster <- unique(cluster) n <- length(ucluster) if (k == 0L) stop(mstyle$stop("Processing terminated since k == 0.")) } ### check that 'V' is positive definite (in each cluster) if (checkpd) { all.pd <- TRUE for (i in seq_len(n)) { Vi <- V[cluster == ucluster[i], cluster == ucluster[i]] if (!anyNA(Vi) && !.chkpd(Vi)) { all.pd <- FALSE warning(mstyle$warning(paste0("'V' appears to be not positive definite in cluster ", ucluster[i], ".")), call.=FALSE) } } if (!all.pd) stop(mstyle$stop("Cannot aggregate estimates with a non-positive-definite 'V' matrix.")) } ### compute aggregated estimates and corresponding sampling variances yi.agg <- rep(NA_real_, n) vi.agg <- rep(NA_real_, n) for (i in seq_len(n)) { Vi <- V[cluster == ucluster[i], cluster == ucluster[i]] if (weighted) { Wi <- try(chol2inv(chol(Vi)), silent=TRUE) if (inherits(Wi, "try-error")) stop(mstyle$stop(paste0("Cannot take inverse of 'V' in cluster ", ucluster[i], "."))) sumWi <- sum(Wi) yi.agg[i] <- sum(Wi %*% cbind(yi[cluster == ucluster[i]])) / sumWi vi.agg[i] <- 1 / sumWi } else { ki <- sum(cluster == ucluster[i]) yi.agg[i] <- sum(yi[cluster == ucluster[i]]) / ki vi.agg[i] <- sum(Vi) / ki^2 } } if (!missing(fun)) { if (!is.list(fun) || length(fun) != 3 || any(sapply(fun, function(f) !is.function(f)))) stop(mstyle$stop("Argument 'fun' must be a list of functions of length 3.")) fun1 <- fun[[1]] fun2 <- fun[[2]] fun3 <- fun[[3]] } else { fun1 <- function(x) { m <- mean(x, na.rm=na.rm[2]) if (is.nan(m)) NA_real_ else m } fun2 <- fun1 fun3 <- function(x) { if (na.rm[2]) { tab <- table(na.omit(x)) #tab <- table(x, useNA=ifelse(na.rm[2], "no", "ifany")) } else { tab <- table(x, useNA="ifany") } val <- tail(names(sort(tab)), 1) if (is.null(val)) NA_integer_ else val } } ### turn 'cluster' into a factor with the desired levels, such that split() will give the same order fcluster <- factor(cluster, levels=ucluster) xsplit <- split(x, fcluster) xagg <- lapply(xsplit, function(xi) { tmp <- lapply(xi, function(xij) { if (inherits(xij, c("numeric","integer"))) { fun1(xij) } else if (inherits(xij, c("logical"))) { fun2(xij) } else { fun3(xij) } }) as.data.frame(tmp) }) xagg <- do.call(rbind, xagg) ### turn variables that were factors back into factors facs <- sapply(x, is.factor) if (any(facs)) { for (j in which(facs)) { xagg[[j]] <- factor(xagg[[j]]) } } ### put yi.agg and vi.agg into the aggregate data at their respective positions xagg[which(names(xagg) == yi.name)] <- yi.agg xagg[which(names(xagg) == vi.name)] <- vi.agg ### add k per cluster as variable to dataset if (addk) { ki <- sapply(xsplit, nrow) xagg <- cbind(xagg, ki) # this way, an existing 'ki' variable will not be overwritten } ### add back some attributes measure <- attr(x[[yi.name]], "measure") if (is.null(measure)) measure <- "GEN" attr(xagg[[yi.name]], "measure") <- measure attr(xagg, "yi.names") <- yi.name attr(xagg, "vi.names") <- vi.name if (!missing(digits)) { attr(xagg, "digits") <- .get.digits(digits=digits, xdigits=attr(x, "digits"), dmiss=FALSE) } else { attr(xagg, "digits") <- attr(x, "digits") } if (is.null(attr(xagg, "digits"))) ### in case x no longer has a 'digits' attribute attr(xagg, "digits") <- 4 class(xagg) <- c("escalc", "data.frame") ### if 'select' is not missing, select variables to include in the output if (!missing(select)) { nl <- as.list(seq_along(x)) names(nl) <- names(x) sel <- eval(substitute(select), nl, parent.frame()) xagg <- xagg[,sel,drop=FALSE] } rownames(xagg) <- NULL return(xagg) } metafor/R/rma.mv.r0000644000176200001440000030273714476636532013527 0ustar liggesusers# fixed/random/mixed-effects multivariate/multilevel model with: # - possibly one or multiple random intercepts (sigma2) with potentially known correlation matrices # - possibly correlated random effects for arms/groups/levels within studies (tau2 and rho for 1st term, gamma2 and phi for 2nd term) # model also allows for correlated sampling errors via non-diagonal V matrix # V = variance-covariance matrix of the sampling errors # sigma2 = (preset) value(s) for the variance of the random intercept(s) # tau2 = (preset) value(s) for the variance of the random effects # rho = (preset) value(s) for the correlation(s) between random effects # gamma2 = (preset) value(s) for the variance of the random effects # phi = (preset) value(s) for the correlation(s) between random effects # structures when there is an '~ inner | outer' term in the random argument: # - CS (compound symmetry) # - HCS (heteroscedastic compound symmetry) # - UN (general positive-definite matrix with no structure) # - UNR (general positive-definite correlation matrix with a single tau2/gamma2 value) # - AR (AR1 structure with a single tau2/gamma2 value and autocorrelation rho/phi) # - HAR (heteroscedastic AR1 structure with multiple tau2/gamma2 values and autocorrelation rho/phi) # - CAR (continuous time AR1 structure) # - ID (same as CS but with rho/phi=0) # - DIAG (same as HCS but with rho/phi=0) # - SPEXP/SPGAU/SPLIN/SPRAT/SPSPH (spatial structures: exponential, gaussian, linear, rational quadratic, spherical) # - GEN (general positive-definite matrix for an arbitrary number of predictors) # - PHYBM/PHYPL/PHYPD (phylogenetic structures: Brownian motion, Pagel's lambda, Pagel's delta) rma.mv <- function(yi, V, W, mods, random, struct="CS", intercept=TRUE, data, slab, subset, method="REML", test="z", dfs="residual", level=95, btt, R, Rscale="cor", sigma2, tau2, rho, gamma2, phi, cvvc=FALSE, sparse=FALSE, verbose=FALSE, digits, control, ...) { # add ni as argument in the future ######################################################################### ###### setup ### check argument specifications mstyle <- .get.mstyle("crayon" %in% .packages()) if (!is.element(method, c("FE","EE","CE","ML","REML"))) stop(mstyle$stop("Unknown 'method' specified.")) if (any(!is.element(struct, c("CS","HCS","UN","AR","HAR","CAR","ID","DIAG","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","GEN","GDIAG")))) # "UNR", "PHYBM","PHYPL","PHYPD")))) stop(mstyle$stop("Unknown 'struct' specified.")) if (length(struct) == 1L) struct <- c(struct, struct) na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (missing(random)) random <- NULL if (missing(R)) R <- NULL if (missing(sigma2)) sigma2 <- NULL if (missing(tau2)) tau2 <- NULL if (missing(rho)) rho <- NULL if (missing(gamma2)) gamma2 <- NULL if (missing(phi)) phi <- NULL if (missing(control)) control <- list() ### set defaults for digits if (missing(digits)) { digits <- .set.digits(dmiss=TRUE) } else { digits <- .set.digits(digits, dmiss=FALSE) } time.start <- proc.time() ### get ... argument and check for extra/superfluous arguments ddd <- list(...) .chkdots(ddd, c("tdist", "outlist", "time", "dist", "abbrev", "restart", "beta", "vccon")) ### handle 'tdist' argument from ... (note: overrides test argument) if (.isFALSE(ddd$tdist)) test <- "z" if (.isTRUE(ddd$tdist)) test <- "t" if (!is.element(test, c("z", "t", "knha", "adhoc"))) stop(mstyle$stop("Invalid option selected for 'test' argument.")) if (is.character(dfs)) dfs <- match.arg(dfs, c("residual", "contain")) if (is.numeric(dfs) || (dfs == "contain" && test == "z")) test <- "t" ### handle Rscale argument (either character, logical, or integer) if (is.character(Rscale)) Rscale <- match.arg(Rscale, c("none", "cor", "cor0", "cov0")) if (is.logical(Rscale)) Rscale <- ifelse(Rscale, "cor", "none") if (is.numeric(Rscale)) { Rscale <- round(Rscale) if (Rscale > 3 | Rscale < 0) stop(mstyle$stop("Unknown 'Rscale' value specified.")) Rscale <- switch(as.character(Rscale), "0"="none", "1"="cor", "2"="cor0", "3"="cov0") } ### handle 'dist' argument from ... if (!is.null(ddd$dist)) { if (is.data.frame(ddd$dist) || .is.matrix(ddd$dist)) ddd$dist <- list(ddd$dist) if (!inherits(ddd$dist, "list")) ddd$dist <- as.list(ddd$dist) if (length(ddd$dist) == 1L) ddd$dist <- c(ddd$dist, ddd$dist) dist.methods <- c("euclidean", "maximum", "manhattan", "gcd") for (j in 1:2) { if (is.data.frame(ddd$dist[[j]])) ddd$dist[[j]] <- as.matrix(ddd$dist[[j]]) if (!is.function(ddd$dist[[j]]) && !.is.matrix(ddd$dist[[j]])) { ddd$dist[[j]] <- charmatch(ddd$dist[[j]], dist.methods, nomatch = 0) if (ddd$dist[[j]] == 0) { stop(mstyle$stop("Argument 'dist' must be one of 'euclidean', 'maximum', 'manhattan', or 'gcd'.")) } else { ddd$dist[[j]] <- dist.methods[ddd$dist[[j]]] } } } if (any(ddd$dist == "gcd")) { if (!requireNamespace("sp", quietly=TRUE)) stop(mstyle$stop("Please install the 'sp' package to compute great-circle distances.")) } } else { ddd$dist <- list("euclidean", "euclidean") } if (is.null(ddd$vccon)) { vccon <- NULL } else { vccon <- ddd$vccon sigma2 <- .chkvccon(vccon$sigma2, sigma2) tau2 <- .chkvccon(vccon$tau2, tau2) rho <- .chkvccon(vccon$rho, rho) gamma2 <- .chkvccon(vccon$gamma2, gamma2) phi <- .chkvccon(vccon$phi, phi) } ### set defaults for formulas formula.yi <- NULL formula.mods <- NULL ### in case user specifies v (instead of V), verbose is set to v, which is non-sensical ### - if v is set to the name of a variable in 'data', it won't be found; can check for ### this with try() and inherits(verbose, "try-error") ### - if v is set to vi or var (or anything else that might be interpreted as a function), ### then can catch this by checking if verbose is a function verbose <- try(verbose, silent=TRUE) if (inherits(verbose, "try-error") || is.function(verbose) || length(verbose) != 1L || !(is.logical(verbose) || is.numeric(verbose))) stop(mstyle$stop("Argument 'verbose' must be a scalar (logical or numeric/integer).")) ### set options(warn=1) if verbose > 2 if (verbose > 2) { opwarn <- options(warn=1) on.exit(options(warn=opwarn$warn), add=TRUE) } ######################################################################### if (verbose > 1) .space() if (verbose > 1) message(mstyle$message("Extracting yi/V values ...")) ### check if data argument has been specified if (missing(data)) data <- NULL if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } mf <- match.call() ### extract yi, V, W, ni, slab, subset, and mods values, possibly from the data frame specified via data (arguments not specified are NULL) yi <- .getx("yi", mf=mf, data=data) V <- .getx("V", mf=mf, data=data) W <- .getx("W", mf=mf, data=data) ni <- .getx("ni", mf=mf, data=data) ### not yet possible to specify this slab <- .getx("slab", mf=mf, data=data) subset <- .getx("subset", mf=mf, data=data) mods <- .getx("mods", mf=mf, data=data) ### if yi is a formula, extract yi and X (this overrides anything specified via the mods argument further below) if (inherits(yi, "formula")) { formula.yi <- yi formula.mods <- formula.yi[-2] options(na.action = "na.pass") ### set na.action to na.pass, so that NAs are not filtered out (we'll do that later) mods <- model.matrix(yi, data=data) ### extract model matrix (now mods is no longer a formula, so [a] further below is skipped) attr(mods, "assign") <- NULL ### strip assign attribute (not needed at the moment) attr(mods, "contrasts") <- NULL ### strip contrasts attribute (not needed at the moment) yi <- model.response(model.frame(yi, data=data)) ### extract yi values from model frame options(na.action = na.act) ### set na.action back to na.act names(yi) <- NULL ### strip names (1:k) from yi (so res$yi is the same whether yi is a formula or not) intercept <- FALSE ### set to FALSE since formula now controls whether the intercept is included or not } ### note: code further below ([b]) actually checks whether intercept is included or not ### in case user passed a data frame to yi, convert it to a vector (if possible) if (is.data.frame(yi)) { if (ncol(yi) == 1L) { yi <- yi[[1]] } else { stop(mstyle$stop("The object/variable specified for the 'yi' argument is a data frame with multiple columns.")) } } ### in case user passed a matrix to yi, convert it to a vector (if possible) if (.is.matrix(yi)) { if (nrow(yi) == 1L || ncol(yi) == 1L) { yi <- as.vector(yi) } else { stop(mstyle$stop("The object/variable specified for the 'yi' argument is a matrix with multiple rows/columns.")) } } ### check if yi is numeric if (!is.numeric(yi)) stop(mstyle$stop("The object/variable specified for the 'yi' argument is not numeric.")) ### number of outcomes before subsetting k <- length(yi) k.all <- k ### set default measure argument measure <- "GEN" if (!is.null(attr(yi, "measure"))) ### take 'measure' from yi (if it is there) measure <- attr(yi, "measure") ### add measure attribute (back) to the yi vector attr(yi, "measure") <- measure ### some checks on V (and turn V into a diagonal matrix if it is a column/row vector) if (is.null(V)) stop(mstyle$stop("Must specify 'V' argument.")) ### catch cases where 'V' is the utils::vi() function if (identical(V, utils::vi)) stop(mstyle$stop("Variable specified for 'V' argument cannot be found.")) if (is.list(V) && !is.data.frame(V)) { ### list elements may be data frames (or scalars), so coerce to matrices V <- lapply(V, as.matrix) ### check that all elements are square if (any(!sapply(V, .is.square))) stop(mstyle$stop("All list elements in 'V' must be square matrices.")) ### turn list into block-diagonal (sparse) matrix if (sparse) { V <- bdiag(V) } else { V <- bldiag(V) } } ### check if user constrained V to 0 (can skip a lot of the steps below then) if ((.is.vector(V) && length(V) == 1L && V == 0) || (.is.vector(V) && length(V) == k && !anyNA(V) && all(V == 0))) { V0 <- TRUE } else { V0 <- FALSE } ### turn V into a diagonal matrix if it is a column/row vector ### note: if V is a scalar (e.g., V=0), then this will turn V into a kxk ### matrix with the value of V along the diagonal if (V0 || .is.vector(V) || nrow(V) == 1L || ncol(V) == 1L) { if (sparse) { V <- Diagonal(k, as.vector(V)) } else { V <- diag(as.vector(V), nrow=k, ncol=k) } } ### turn V into a matrix if it is a data frame if (is.data.frame(V)) V <- as.matrix(V) ### remove row and column names (important for isSymmetric() function) ### (but only do this if V has row/column names to avoid making an unnecessary copy) if (!is.null(dimnames(V))) V <- unname(V) ### check whether V is square and symmetric (can skip when V0) if (!V0 && !.is.square(V)) stop(mstyle$stop("'V' must be a square matrix.")) if (!V0 && !isSymmetric(V)) ### note: copy of V is made when doing this stop(mstyle$stop("'V' must be a symmetric matrix.")) ### check length of yi and V if (nrow(V) != k) stop(mstyle$stop(paste0("Length of 'yi' (", k, ") and length/dimensions of 'V' (", nrow(V), ") is not the same."))) ### force V to be sparse when sparse=TRUE (and V is not yet sparse) if (sparse && inherits(V, "matrix")) V <- Matrix(V, sparse=TRUE) ### check if V is numeric (but only for 'regular' matrices, since this is always FALSE for sparse matrices) if (inherits(V, "matrix") && !is.numeric(V)) stop(mstyle$stop("The object/variable specified for the 'V' argument is not numeric.")) ### process W if it was specified if (!is.null(W)) { ### turn W into a diagonal matrix if it is a column/row vector ### in general, turn W into A (arbitrary weight matrix) if (.is.vector(W) || nrow(W) == 1L || ncol(W) == 1L) { W <- as.vector(W) ### allow easy setting of W to a single value if (length(W) == 1L) W <- rep(W, k) A <- diag(W, nrow=length(W), ncol=length(W)) } else { A <- W } if (is.data.frame(A)) A <- as.matrix(A) ### remove row and column names (important for isSymmetric() function) ### (but only do this if A has row/column names to avoid making an unnecessary copy) if (!is.null(dimnames(A))) A <- unname(A) ### check whether A is square and symmetric if (!.is.square(A)) stop(mstyle$stop("'W' must be a square matrix.")) if (!isSymmetric(A)) stop(mstyle$stop("'W' must be a symmetric matrix.")) ### check length of yi and A if (nrow(A) != k) stop(mstyle$stop(paste0("Length of 'yi' (", k, ") and length/dimensions of 'W' (", nrow(A), ") is not the same."))) ### force A to be sparse when sparse=TRUE (and A is not yet sparse) if (sparse && inherits(A, "matrix")) A <- Matrix(A, sparse=TRUE) if (inherits(A, "matrix") && !is.numeric(A)) stop(mstyle$stop("The object/variable specified for the 'W' argument is not numeric.")) } else { A <- NULL } ### if ni has not been specified (and hence is NULL), try to get it from the attributes of yi ### note: currently ni argument removed, so this is the only way to pass ni to the function if (is.null(ni)) ni <- attr(yi, "ni") ### check length of yi and ni ### if there is a mismatch, then ni cannot be trusted, so set it to NULL if (!is.null(ni) && length(ni) != k) ni <- NULL ### if ni is now available, add it (back) as an attribute to yi ### this is currently pointless, but may be useful if function has an ni argument #if (!is.null(ni)) # attr(yi, "ni") <- ni ######################################################################### if (verbose > 1) message(mstyle$message("Creating model matrix ...")) ### convert mods formula to X matrix and set intercept equal to FALSE ### skipped if formula has already been specified via yi argument, since mods is then no longer a formula (see [a]) if (inherits(mods, "formula")) { formula.mods <- mods if (isTRUE(all.equal(formula.mods, ~ 1))) { # needed so 'mods = ~ 1' without 'data' specified works mods <- matrix(1, nrow=k, ncol=1) intercept <- FALSE } else { options(na.action = "na.pass") ### set na.action to na.pass, so that NAs are not filtered out (we'll do that later) mods <- model.matrix(mods, data=data) ### extract model matrix attr(mods, "assign") <- NULL ### strip assign attribute (not needed at the moment) attr(mods, "contrasts") <- NULL ### strip contrasts attribute (not needed at the moment) options(na.action = na.act) ### set na.action back to na.act intercept <- FALSE ### set to FALSE since formula now controls whether the intercept is included or not } ### note: code further below ([b]) actually checks whether intercept is included or not } ### turn a vector for mods into a column vector if (.is.vector(mods)) mods <- cbind(mods) ### turn a mods data frame into a matrix if (is.data.frame(mods)) mods <- as.matrix(mods) ### check if model matrix contains character variables if (is.character(mods)) stop(mstyle$stop("Model matrix contains character variables.")) ### check if mods matrix has the right number of rows if (!is.null(mods) && nrow(mods) != k) stop(mstyle$stop(paste0("Number of rows in the model matrix (", nrow(mods), ") does not match length of the outcome vector (", k, ")."))) ######################################################################### ######################################################################### ######################################################################### ### process random argument if (!is.element(method, c("FE","EE","CE")) && !is.null(random)) { if (verbose > 1) message(mstyle$message("Processing 'random' argument ...")) ### make sure random argument is always a list (so lapply() below works) if (!is.list(random)) random <- list(random) ### check that all elements are formulas if (any(sapply(random, function(x) !inherits(x, "formula")))) stop(mstyle$stop("All elements of 'random' must be formulas.")) ### check that all formulas have a vertical bar has.vbar <- sapply(random, function(f) grepl("|", paste0(f, collapse=""), fixed=TRUE)) if (any(!has.vbar)) stop(mstyle$stop("All formulas in 'random' must contain a grouping variable after the | symbol.")) ### check if any formula have a $ has.dollar <- sapply(random, function(f) grepl("$", paste0(f, collapse=""), fixed=TRUE)) if (any(has.dollar)) stop(mstyle$stop("Cannot use '$' notation in formulas in the 'random' argument (use the 'data' argument instead).")) ### check if any formula have a : has.colon <- sapply(random, function(f) grepl(":", paste0(f, collapse=""), fixed=TRUE)) if (any(has.colon)) stop(mstyle$stop("Cannot use ':' notation in formulas in the 'random' argument (use 'interaction()' instead).")) ### check if any formula have a %in% has.in <- sapply(random, function(f) grepl("%in%", paste0(f, collapse=""), fixed=TRUE)) if (any(has.in)) stop(mstyle$stop("Cannot use '%in%' notation in formulas in the 'random' argument (use 'interaction()' instead).")) ### check which formulas have a || has.dblvbar <- sapply(random, function(f) grepl("||", paste0(f, collapse=""), fixed=TRUE)) ### replace || with | random <- lapply(random, function(f) { if (grepl("||", paste0(f, collapse=""), fixed=TRUE)) { f <- paste0(f, collapse="") f <- gsub("||", "|", f, fixed=TRUE) f <- as.formula(f) } return(f) }) ### check which formulas in random are '~ inner | outer' formulas formulas <- list(NULL, NULL) split.formulas <- sapply(random, function(f) strsplit(paste0(f, collapse=""), " | ", fixed=TRUE)) is.inner.outer <- sapply(split.formulas, function(f) f[1] != "~1") ### make sure that there are only up to two '~ inner | outer' formulas if (sum(is.inner.outer) > 2) stop(mstyle$stop("Only up to two '~ inner | outer' formulas allowed in the 'random' argument.")) ### get '~ inner | outer' formulas if (any(is.inner.outer)) formulas[[1]] <- random[is.inner.outer][1][[1]] if (sum(is.inner.outer) == 2) formulas[[2]] <- random[is.inner.outer][2][[1]] ### figure out if a formulas has a slash (as in '~ 1 | study/id') has.slash <- sapply(random, function(f) grepl("/", paste0(f, collapse=""), fixed=TRUE)) ### check if slash is used in combination with an '~ inner | outer' term if (any(is.inner.outer & has.slash)) stop(mstyle$stop("Cannot use '~ inner | outer1/outer2' type terms in the 'random' argument.")) ### substitute + for | in all formulas (so that model.frame() below works) random.plus <- lapply(random, function(f) formula(sub("\\|", "+", paste0(f, collapse="")))) ### get all model frames corresponding to the formulas in the random argument ### mf.r <- lapply(random, get_all_vars, data=data) ### note: get_all_vars() does not carry out any functions calls within the formula ### so use model.frame(), which allows for things like 'random = ~ factor(arm) | study' ### need to use na.pass so that NAs are passed through (checks for NAs are done later) #mf.r <- lapply(random.plus, model.frame, data=data, na.action=na.pass) mf.r <- list() io <- 0 for (j in seq_along(is.inner.outer)) { if (is.inner.outer[j]) { io <- io + 1 ### for an '~ inner | outer' term with struct="GEN", expand the inner formula to the ### model matrix and re-combine this with the outer variable if (is.element(struct[io], c("GEN","GDIAG"))) { f.inner <- as.formula(strsplit(paste(random[[j]], collapse=""), " | ", fixed=TRUE)[[1]][1]) f.outer <- as.formula(paste("~", strsplit(paste(random[[j]], collapse=""), " | ", fixed=TRUE)[[1]][2])) options(na.action = "na.pass") X.inner <- model.matrix(f.inner, data=data) options(na.action = na.act) is.int <- apply(X.inner, 2, .is.intercept) colnames(X.inner)[is.int] <- "intrcpt" mf.r[[j]] <- cbind(X.inner, model.frame(f.outer, data=data, na.action=na.pass)) if (has.dblvbar[j]) # change "GEN" to "GDIAG" if the formula had a || struct[io] <- "GDIAG" } else { mf.r[[j]] <- model.frame(random.plus[[j]], data=data, na.action=na.pass) } } else { mf.r[[j]] <- model.frame(random.plus[[j]], data=data, na.action=na.pass) } } ### count number of columns in each model frame mf.r.ncols <- sapply(mf.r, ncol) ### for formulas with slashes, create interaction terms for (j in seq_along(has.slash)) { if (!has.slash[j]) next ### need to go backwards; otherwise, with 3 or more terms (e.g., ~ 1 | var1/var2/var3), the third term would be an ### interaction between var1, var1:var2, and var3; by going backwards, we get var1, var1:var2, and var1:var2:var3 for (p in mf.r.ncols[j]:1) { mf.r[[j]][,p] <- interaction(mf.r[[j]][1:p], drop=TRUE, lex.order=TRUE, sep = "/") colnames(mf.r[[j]])[p] <- paste(colnames(mf.r[[j]])[1:p], collapse="/") } } ### create list where model frames with multiple columns based on slashes are flattened out if (any(has.slash)) { if (length(mf.r) == 1L) { ### if formula only has one element of the form ~ 1 | var1/var2/..., create a list of the data frames (each with one column) mf.r <- lapply(seq(ncol(mf.r[[1]])), function(x) mf.r[[1]][x]) } else { ### if there are non-slash elements, then this flattens things out (obviously ...) mf.r <- unlist(mapply(function(mf, sl) if (sl) lapply(seq(mf), function(x) mf[x]) else list(mf), mf.r, has.slash, SIMPLIFY=FALSE), recursive=FALSE, use.names=FALSE) } ### recount number of columns in each model frame mf.r.ncols <- sapply(mf.r, ncol) } #return(mf.r) ### separate mf.r into mf.s (~ 1 | id), mf.g (~ inner | outer), and mf.h (~ inner | outer) parts mf.s <- mf.r[which(mf.r.ncols == 1)] # if there is no '~ 1 | factor' term, this is list() ([] so that we get a list of data frames) mf.g <- mf.r[[which(mf.r.ncols >= 2)[1]]] # if there is no 1st '~ inner | outer' terms, this is NULL ([[]] so that we get a data frame, not a list) mf.h <- mf.r[[which(mf.r.ncols >= 2)[2]]] # if there is no 2nd '~ inner | outer' terms, this is NULL ([[]] so that we get a data frame, not a list) ### if there is no (~ 1 | factor) term, then mf.s is list(), so turn that into NULL if (length(mf.s) == 0L) mf.s <- NULL ### does the random argument include at least one (~ 1 | id) term? withS <- !is.null(mf.s) ### does the random argument include '~ inner | outer' terms? withG <- !is.null(mf.g) withH <- !is.null(mf.h) ### count number of rows in each model frame mf.r.nrows <- sapply(mf.r, nrow) ### make sure that rows in each model frame match the length of the data if (any(mf.r.nrows != k)) stop(mstyle$stop("Length of variables specified via the 'random' argument does not match length of the data.")) ### need this for profile(); with things like 'random = ~ factor(arm) | study', 'mf.r' contains variables 'factor(arm)' and 'study' ### but the former won't work when using the same formula for the refitting (same when using interaction() in the random formula) ### note: with ~ 1 | interaction(var1, var2), mf.r will have 2 columns, but is actually a 'one variable' term ### and with ~ interaction(var1, var2) | var3, mf.r will have 3 columns, but is actually a 'two variable' term ### mf.r.ncols above is correct even in these cases (since it is based on the model.frame() results), but need ### to be careful that this doesn't screw up anything in other functions (for now, mf.r.ncols is not used in any other function) mf.r <- lapply(random.plus, get_all_vars, data=data) } else { ### set defaults for some elements when method="FE/EE/CE" formulas <- list(NULL, NULL) mf.r <- NULL mf.s <- NULL mf.g <- NULL mf.h <- NULL withS <- FALSE withG <- FALSE withH <- FALSE } ### warn that 'struct' argument is disregarded if it has been specified, but model contains no '~ inner | outer' terms if (!withG && "struct" %in% names(mf)) warning(mstyle$warning("Model does not contain an '~ inner | outer' term, so 'struct' argument is disregaded."), call.=FALSE) ### warn that 'random' argument is disregarded if it has been specified, but method="FE/EE/CE" if (is.element(method, c("FE","EE","CE")) && "random" %in% names(mf)) warning(mstyle$warning(paste0("The 'random' argument is disregaded when method=\"", method, "\".")), call.=FALSE) #return(list(mf.r=mf.r, mf.s=mf.s, mf.g=mf.g, mf.h=mf.h)) ### note: checks on NAs in mf.s, mf.g, and mf.h after subsetting (since NAs may be removed by subsetting) ######################################################################### ######################################################################### ######################################################################### ### generate study labels if none are specified (or none can be found in yi argument) if (verbose > 1) message(mstyle$message("Generating/extracting study labels ...")) ### study ids (1:k sequence before subsetting) ids <- seq_len(k) ### if slab has not been specified but is an attribute of yi, get it if (is.null(slab)) { slab <- attr(yi, "slab") # will be NULL if there is no slab attribute ### check length of yi and slab (only if slab is now not NULL) ### if there is a mismatch, then slab cannot be trusted, so set it to NULL if (!is.null(slab) && length(slab) != k) slab <- NULL } if (is.null(slab)) { slab.null <- TRUE slab <- ids } else { if (anyNA(slab)) stop(mstyle$stop("NAs in study labels.")) if (length(slab) != k) stop(mstyle$stop("Study labels not of same length as data.")) if (is.factor(slab)) slab <- as.character(slab) slab.null <- FALSE } ### if a subset of studies is specified if (!is.null(subset)) { if (verbose > 1) message(mstyle$message("Subsetting ...")) subset <- .chksubset(subset, k) yi <- .getsubset(yi, subset) V <- .getsubset(V, subset, col=TRUE) A <- .getsubset(A, subset, col=TRUE) ni <- .getsubset(ni, subset) mods <- .getsubset(mods, subset) slab <- .getsubset(slab, subset) mf.r <- lapply(mf.r, .getsubset, subset) mf.s <- lapply(mf.s, .getsubset, subset) mf.g <- .getsubset(mf.g, subset) mf.h <- .getsubset(mf.h, subset) ids <- .getsubset(ids, subset) k <- length(yi) attr(yi, "measure") <- measure ### add measure attribute back attr(yi, "ni") <- ni ### add ni attribute back } ### check if study labels are unique; if not, make them unique if (anyDuplicated(slab)) slab <- .make.unique(slab) ### add slab attribute back attr(yi, "slab") <- slab ### get the sampling variances from the diagonal of V vi <- diag(V) ### save full data (including potential NAs in yi/vi/V/W/ni/mods) yi.f <- yi vi.f <- vi V.f <- V W.f <- A ni.f <- ni mods.f <- mods #mf.g.f <- mf.g ### copied further below #mf.h.f <- mf.h ### copied further below #mf.s.f <- mf.s ### copied further below k.f <- k ### total number of observed outcomes including all NAs ######################################################################### ######################################################################### ######################################################################### ### stuff that need to be done after subsetting if (withS) { if (verbose > 1) message(mstyle$message(paste0("Processing '", paste0("~ 1 | ", sapply(mf.s, names), collapse=", "), "' term(s) ..."))) ### get variables names in mf.s s.names <- sapply(mf.s, names) ### one name per term ### turn each variable in mf.s into a factor (and turn each column vector into just a vector) ### if a variable was a factor to begin with, this drops any unused levels, but order of existing levels is preserved mf.s <- lapply(mf.s, function(x) factor(x[[1]])) ### check if there are any NAs anywhere in mf.s if (any(sapply(mf.s, anyNA))) stop(mstyle$stop("No NAs allowed in variables specified in the 'random' argument.")) ### how many (~ 1 | id) terms does the random argument include? (0 if none, but if withS is TRUE, must be at least 1) sigma2s <- length(mf.s) ### set default value(s) for sigma2 argument if it is unspecified if (is.null(sigma2)) sigma2 <- rep(NA_real_, sigma2s) ### allow quickly setting all sigma2 values to a fixed value if (length(sigma2) == 1L) sigma2 <- rep(sigma2, sigma2s) ### check if sigma2 is of the correct length if (length(sigma2) != sigma2s) stop(mstyle$stop(paste0("Length of 'sigma2' argument (", length(sigma2), ") does not match actual number of variance components (", sigma2s, ")."))) ### checks on any fixed values of sigma2 argument if (any(sigma2 < 0, na.rm=TRUE)) stop(mstyle$stop("Specified value(s) of 'sigma2' must be non-negative.")) ### get number of levels of each variable in mf.s (vector with one value per term) s.nlevels <- sapply(mf.s, nlevels) ### get levels of each variable in mf.s (list with levels for each variable) s.levels <- lapply(mf.s, levels) ### checks on R (note: do this after subsetting, so user can filter out ids with no info in R) if (is.null(R)) { withR <- FALSE Rfix <- rep(FALSE, sigma2s) } else { if (verbose > 1) message(mstyle$message("Processing 'R' argument ...")) withR <- TRUE ### make sure R is always a list (so lapply() below works) if (is.data.frame(R) || !is.list(R)) R <- list(R) ### check if R list has no names at all or some names are missing ### (if only some elements of R have names, then names(R) is "" for the unnamed elements, so use nchar()==0 to check for that) if (is.null(names(R)) || any(nchar(names(R)) == 0L)) stop(mstyle$stop("Argument 'R' must be a *named* list.")) ### remove elements in R that are NULL (not sure why this is needed; why would anybody ever do this?) ### maybe this had something to do with functions that repeatedly call rma.mv(); so leave this be for now R <- R[!sapply(R, is.null)] ### turn all elements in R into matrices (this would fail with a NULL element) R <- lapply(R, as.matrix) ### match up R matrices based on the s.names (and correct names of R) ### so if a particular ~ 1 | id term has a matching id=R element, the corresponding R element is that R matrix ### if a particular ~ 1 | id term does not have a matching id=R element, the corresponding R element is NULL R <- R[s.names] ### NULL elements in R would have no name, so this makes sure that all R elements have the correct s.names names(R) <- s.names ### check for which components an R matrix has been specified Rfix <- !sapply(R, is.null) ### Rfix could be all FALSE (if user has used id names in R that are not actually in 'random') ### so only do the rest below if that is *not* the case if (any(Rfix)) { ### check if given R matrices are square and symmetric if (any(!sapply(R[Rfix], .is.square))) stop(mstyle$stop("Elements of 'R' must be square matrices.")) if (any(!sapply(R[Rfix], function(x) isSymmetric(unname(x))))) stop(mstyle$stop("Elements of 'R' must be symmetric matrices.")) for (j in seq_along(R)) { if (!Rfix[j]) next ### even if isSymmetric() is TRUE, there may still be minor numerical differences between the lower and upper triangular ### parts that could lead to isSymmetric() being FALSE once we do any potentially rescaling of the R matrices further ### below; this ensures strict symmetry to avoid this issue #R[[j]][lower.tri(R[[j]])] <- t(R[[j]])[lower.tri(R[[j]])] R[[j]] <- symmpart(R[[j]]) ### if rownames are missing, copy colnames to rownames and vice-versa if (is.null(rownames(R[[j]]))) rownames(R[[j]]) <- colnames(R[[j]]) if (is.null(colnames(R[[j]]))) colnames(R[[j]]) <- rownames(R[[j]]) ### if colnames are still missing at this point, R element did not have dimension names to begin with if (is.null(colnames(R[[j]]))) stop(mstyle$stop("Elements of 'R' must have dimension names.")) } ### if user specifies the entire (k x k) correlation matrix, this removes the duplicate rows/columns #R[Rfix] <- lapply(R[Rfix], unique, MARGIN=1) #R[Rfix] <- lapply(R[Rfix], unique, MARGIN=2) ### no, the user can specify an entire (k x k) matrix; the problem is repeated dimension names ### so let's filter out rows/columns with the same dimension names R[Rfix] <- lapply(R[Rfix], function(x) x[!duplicated(rownames(x)), !duplicated(colnames(x)), drop=FALSE]) ### after the two commands above, this should always be FALSE, but leave for now just in case if (any(sapply(R[Rfix], function(x) length(colnames(x)) != length(unique(colnames(x)))))) stop(mstyle$stop("Each element of 'R' must have unique dimension names.")) ### check for R being positive definite ### skipped: even if R is not positive definite, the marginal var-cov matrix can still be; so just check for pd during optimization #if (any(sapply(R[Rfix], !.chkpd))) # stop(mstyle$stop("Matrix in R is not positive definite.")) for (j in seq_along(R)) { if (!Rfix[j]) next ### check if there are NAs in a matrix specified via R if (anyNA(R[[j]])) stop(mstyle$stop("No missing values allowed in matrices specified via 'R'.")) ### check if there are levels in s.levels which are not in R (if yes, issue an error and stop) if (any(!is.element(s.levels[[j]], colnames(R[[j]])))) stop(mstyle$stop(paste0("There are levels in '", s.names[j], "' for which there are no matching rows/columns in the corresponding 'R' matrix."))) ### check if there are levels in R which are not in s.levels (if yes, issue a warning) if (any(!is.element(colnames(R[[j]]), s.levels[[j]]))) warning(mstyle$warning(paste0("There are rows/columns in the 'R' matrix for '", s.names[j], "' for which there are no data."))) } } else { warning(mstyle$warning("Argument 'R' specified, but list name(s) not in 'random'."), call.=FALSE) withR <- FALSE Rfix <- rep(FALSE, sigma2s) R <- NULL } } } else { ### need one fixed sigma2 value for optimization function sigma2s <- 1 sigma2 <- 0 s.nlevels <- NULL s.levels <- NULL s.names <- NULL withR <- FALSE Rfix <- FALSE R <- NULL } #mf.s.f <- mf.s ### not needed at the moment ### copy s.nlevels and s.levels (needed for ranef()) s.nlevels.f <- s.nlevels s.levels.f <- s.levels ######################################################################### ### stuff that need to be done after subsetting if (withG) { tmp <- .process.G.aftersub(mf.g, struct[1], formulas[[1]], tau2, rho, isG=TRUE, k, sparse, verbose) mf.g <- tmp$mf.g g.names <- tmp$g.names g.nlevels <- tmp$g.nlevels g.levels <- tmp$g.levels g.values <- tmp$g.values tau2s <- tmp$tau2s rhos <- tmp$rhos tau2 <- tmp$tau2 rho <- tmp$rho Z.G1 <- tmp$Z.G1 Z.G2 <- tmp$Z.G2 } else { ### need one fixed tau2 and rho value for optimization function tau2s <- 1 rhos <- 1 tau2 <- 0 rho <- 0 ### need Z.G1 and Z.G2 to exist further below and for optimization function Z.G1 <- NULL Z.G2 <- NULL g.nlevels <- NULL g.levels <- NULL g.values <- NULL g.names <- NULL } mf.g.f <- mf.g ### needed for predict() ######################################################################### ### stuff that need to be done after subsetting if (withH) { tmp <- .process.G.aftersub(mf.h, struct[2], formulas[[2]], gamma2, phi, isG=FALSE, k, sparse, verbose) mf.h <- tmp$mf.g h.names <- tmp$g.names h.nlevels <- tmp$g.nlevels h.levels <- tmp$g.levels h.values <- tmp$g.values gamma2s <- tmp$tau2s phis <- tmp$rhos gamma2 <- tmp$tau2 phi <- tmp$rho Z.H1 <- tmp$Z.G1 Z.H2 <- tmp$Z.G2 } else { ### need one fixed gamma2 and phi value for optimization function gamma2s <- 1 phis <- 1 gamma2 <- 0 phi <- 0 ### need Z.H1 and Z.H2 to exist further below and for optimization function Z.H1 <- NULL Z.H2 <- NULL h.nlevels <- NULL h.levels <- NULL h.values <- NULL h.names <- NULL } mf.h.f <- mf.h ### needed for predict() # return(list(Z.G1=Z.G1, Z.G2=Z.G2, g.nlevels=g.nlevels, g.levels=g.levels, g.values=g.values, tau2=tau2, rho=rho, # Z.H1=Z.H1, Z.H2=Z.H2, h.nlevels=h.nlevels, h.levels=h.levels, h.values=h.values, gamma2=gamma2, phi=phi)) ######################################################################### ######################################################################### ######################################################################### ### check for NAs and act accordingly has.na <- is.na(yi) | (if (is.null(mods)) FALSE else apply(is.na(mods), 1, any)) | (if (V0) FALSE else .anyNAv(V)) | (if (is.null(A)) FALSE else apply(is.na(A), 1, any)) not.na <- !has.na if (any(has.na)) { if (verbose > 1) message(mstyle$message("Handling NAs ...")) if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { yi <- yi[not.na] V <- V[not.na,not.na,drop=FALSE] A <- A[not.na,not.na,drop=FALSE] vi <- vi[not.na] ni <- ni[not.na] mods <- mods[not.na,,drop=FALSE] mf.r <- lapply(mf.r, function(x) x[not.na,,drop=FALSE]) mf.s <- lapply(mf.s, function(x) x[not.na]) ### note: mf.s is a list of vectors at this point mf.g <- mf.g[not.na,,drop=FALSE] mf.h <- mf.h[not.na,,drop=FALSE] if (is.element(struct[1], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) { Z.G1 <- Z.G1[not.na,not.na,drop=FALSE] } else { Z.G1 <- Z.G1[not.na,,drop=FALSE] } Z.G2 <- Z.G2[not.na,,drop=FALSE] if (is.element(struct[2], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) { Z.H1 <- Z.H1[not.na,not.na,drop=FALSE] } else { Z.H1 <- Z.H1[not.na,,drop=FALSE] } Z.H2 <- Z.H2[not.na,,drop=FALSE] k <- length(yi) warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "rows", "row"), "with NAs omitted from model fitting.")), call.=FALSE) attr(yi, "measure") <- measure ### add measure attribute back attr(yi, "ni") <- ni ### add ni attribute back ### note: slab is always of the same length as the full yi vector (after subsetting), so missings are not removed and slab is not added back to yi } if (na.act == "na.fail") stop(mstyle$stop("Missing values in data.")) } ### more than one study left? if (k <= 1) stop(mstyle$stop("Processing terminated since k <= 1.")) ### check for non-positive sampling variances (and set negative values to 0) if (any(vi <= 0)) { allvipos <- FALSE if (!V0) warning(mstyle$warning("There are outcomes with non-positive sampling variances."), call.=FALSE) vi.neg <- vi < 0 if (any(vi.neg)) { V[vi.neg,] <- 0 ### note: entire row set to 0 (so covariances are also 0) V[,vi.neg] <- 0 ### note: entire col set to 0 (so covariances are also 0) vi[vi.neg] <- 0 warning(mstyle$warning("Negative sampling variances constrained to zero."), call.=FALSE) } } else { allvipos <- TRUE } ### check for V being positive definite (this should also cover non-positive variances) ### skipped: even if V is not positive definite, the marginal var-cov matrix can still be; so just check for pd during the optimization ### but at least issue a warning, since a fixed-effects model can then not be fitted and there is otherwise no indication why this is the case if (!V0 && !.chkpd(V)) warning(mstyle$warning("'V' appears to be not positive definite."), call.=FALSE) ### check ratio of largest to smallest sampling variance ### note: need to exclude some special cases (0/0 = NaN, max(vi)/0 = Inf) ### TODO: use the condition number of V here instead? vimaxmin <- max(vi) / min(vi) if (is.finite(vimaxmin) && vimaxmin >= 1e7) warning(mstyle$warning("Ratio of largest to smallest sampling variance extremely large. May not be able to obtain stable results."), call.=FALSE) ### make sure that there is at least one column in X ([b]) if (is.null(mods) && !intercept) { warning(mstyle$warning("Must either include an intercept and/or moderators in model.\nCoerced intercept into the model."), call.=FALSE) intercept <- TRUE } if (!is.null(mods) && ncol(mods) == 0L) { warning(mstyle$warning("Cannot fit model with an empty model matrix. Coerced intercept into the model."), call.=FALSE) intercept <- TRUE } ### add vector of 1s to the X matrix for the intercept (if intercept=TRUE) if (intercept) { X <- cbind(intrcpt=rep(1,k), mods) X.f <- cbind(intrcpt=rep(1,k.f), mods.f) } else { X <- mods X.f <- mods.f } ### drop redundant predictors ### note: need to save coef.na for functions that modify the data/model and then refit the model (regtest() and the ### various function that leave out an observation); so we can check if there are redundant/dropped predictors then tmp <- try(lm(yi ~ X - 1), silent=TRUE) if (inherits(tmp, "try-error")) { stop(mstyle$stop("Error in check for redundant predictors.")) } else { coef.na <- is.na(coef(tmp)) if (any(coef.na)) { warning(mstyle$warning("Redundant predictors dropped from the model."), call.=FALSE) X <- X[,!coef.na,drop=FALSE] X.f <- X.f[,!coef.na,drop=FALSE] } } ### check whether intercept is included and if yes, move it to the first column (NAs already removed, so na.rm=TRUE for any() not necessary) is.int <- apply(X, 2, .is.intercept) if (any(is.int)) { int.incl <- TRUE int.indx <- which(is.int, arr.ind=TRUE) X <- cbind(intrcpt=1, X[,-int.indx, drop=FALSE]) ### this removes any duplicate intercepts X.f <- cbind(intrcpt=1, X.f[,-int.indx, drop=FALSE]) ### this removes any duplicate intercepts intercept <- TRUE ### set intercept appropriately so that the predict() function works } else { int.incl <- FALSE } ### number of columns in X (including the intercept if it is included) p <- NCOL(X) ### make sure variable names in X are unique colnames(X) <- colnames(X.f) <- .make.unique(colnames(X)) ### check whether this is an intercept-only model if ((p == 1L) && .is.intercept(X)) { int.only <- TRUE } else { int.only <- FALSE } ### check if there are too many parameters for given k (currently skipped) ### set/check 'btt' argument btt <- .set.btt(btt, p, int.incl, colnames(X)) m <- length(btt) ### number of betas to test (m = p if all betas are tested) ### check which beta elements are estimated versus fixed if (is.null(ddd$beta)) { beta.val <- rep(NA_real_, p) beta.est <- rep(TRUE, p) } else { beta.val <- ddd$beta if (length(beta.val) != p) stop(mstyle$stop(paste0("Length of 'beta' argument (", length(beta.val), ") does not match actual number of fixed effects (", p, ")."))) beta.est <- is.na(beta.val) } ######################################################################### ######################################################################### ######################################################################### ### stuff that need to be done after subsetting and filtering out NAs if (withS) { ### redo: turn each variable in mf.s into a factor (reevaluates the levels present, but order of existing levels is preserved) mf.s <- lapply(mf.s, factor) ### redo: get number of levels of each variable in mf.s (vector with one value per term) s.nlevels <- sapply(mf.s, nlevels) ### redo: get levels of each variable in mf.s s.levels <- lapply(mf.s, levels) ### for any single-level factor with unfixed sigma2, fix the sigma2 value to 0 if (any(is.na(sigma2) & s.nlevels == 1)) { sigma2[is.na(sigma2) & s.nlevels == 1] <- 0 warning(mstyle$warning("Single-level factor(s) found in 'random' argument. Corresponding 'sigma2' value(s) fixed to 0."), call.=FALSE) } ### create model matrix for each element in mf.s Z.S <- vector(mode="list", length=sigma2s) for (j in seq_len(sigma2s)) { if (s.nlevels[j] == 1) { Z.S[[j]] <- cbind(rep(1,k)) } else { if (sparse) { Z.S[[j]] <- sparse.model.matrix(~ mf.s[[j]] - 1) ### cannot use this for factors with a single level } else { Z.S[[j]] <- model.matrix(~ mf.s[[j]] - 1) ### cannot use this for factors with a single level } } attr(Z.S[[j]], "assign") <- NULL attr(Z.S[[j]], "contrasts") <- NULL } } else { Z.S <- NULL } ######################################################################### ### stuff that need to be done after subsetting and filtering out NAs if (withR) { ### R may contain levels that are not in ids (that's fine; just filter them out) ### also, R may not be in the order that Z.S is in, so this fixes that up for (j in seq_along(R)) { if (!Rfix[j]) next R[[j]] <- R[[j]][s.levels[[j]], s.levels[[j]]] } ### TODO: allow Rscale to be a vector so that different Rs can be scaled differently ### force each element of R to be a correlation matrix (and do some checks on that) if (Rscale=="cor" || Rscale=="cor0") { R[Rfix] <- lapply(R[Rfix], function(x) { if (any(diag(x) <= 0)) stop(mstyle$stop("Cannot use Rscale=\"cor\" or Rscale=\"cor0\" with non-positive values on the diagonal of an 'R' matrix."), call.=FALSE) tmp <- cov2cor(x) if (any(abs(tmp) > 1)) warning(mstyle$warning("Some values are larger than +-1 in an 'R' matrix after cov2cor() (see 'Rscale' argument)."), call.=FALSE) return(tmp) }) } ### rescale R so that entries are 0 to (max(R) - min(R)) / (1 - min(R)) ### this preserves the ultrametric properties of R and makes levels split at the root uncorrelated if (Rscale=="cor0") R[Rfix] <- lapply(R[Rfix], function(x) (x - min(x)) / (1 - min(x))) ### rescale R so that min(R) is zero (this is for the case that R is covariance matrix) if (Rscale=="cov0") R[Rfix] <- lapply(R[Rfix], function(x) (x - min(x))) } ######################################################################### ### create (kxk) indicator/correlation matrices for random intercepts if (withS) { D.S <- vector(mode="list", length=sigma2s) for (j in seq_len(sigma2s)) { if (Rfix[j]) { if (sparse) { D.S[[j]] <- Z.S[[j]] %*% Matrix(R[[j]], sparse=TRUE) %*% t(Z.S[[j]]) } else { D.S[[j]] <- Z.S[[j]] %*% R[[j]] %*% t(Z.S[[j]]) } # D.S[[j]] <- as.matrix(nearPD(D.S[[j]])$mat) ### this avoids that the full matrix becomes non-positive definite but adding ### a tiny amount to the diagonal of D.S[[j]] is easier and works just as well ### TODO: consider doing something like this by default } else { D.S[[j]] <- tcrossprod(Z.S[[j]]) } } } else { D.S <- NULL } ######################################################################### ### stuff that need to be done after subsetting and filtering out NAs if (withG) { tmp <- .process.G.afterrmna(mf.g, g.nlevels, g.levels, g.values, struct[1], formulas[[1]], tau2, rho, Z.G1, Z.G2, isG=TRUE, sparse, ddd$dist[[1]], verbose) mf.g <- tmp$mf.g g.nlevels <- tmp$g.nlevels g.nlevels.f <- tmp$g.nlevels.f g.levels <- tmp$g.levels g.levels.f <- tmp$g.levels.f g.levels.r <- tmp$g.levels.r g.levels.k <- tmp$g.levels.k g.levels.comb.k <- tmp$g.levels.comb.k tau2 <- tmp$tau2 rho <- tmp$rho G <- tmp$G g.Dmat <- tmp$Dmat g.rho.init <- tmp$rho.init } else { g.nlevels.f <- NULL g.levels.f <- NULL g.levels.r <- NULL g.levels.k <- NULL g.levels.comb.k <- NULL G <- NULL g.Dmat <- NULL g.rho.init <- NULL } ######################################################################### ### stuff that need to be done after subsetting and filtering out NAs if (withH) { tmp <- .process.G.afterrmna(mf.h, h.nlevels, h.levels, h.values, struct[2], formulas[[2]], gamma2, phi, Z.H1, Z.H2, isG=FALSE, sparse, ddd$dist[[2]], verbose) mf.h <- tmp$mf.g h.nlevels <- tmp$g.nlevels h.nlevels.f <- tmp$g.nlevels.f h.levels <- tmp$g.levels h.levels.f <- tmp$g.levels.f h.levels.r <- tmp$g.levels.r h.levels.k <- tmp$g.levels.k h.levels.comb.k <- tmp$g.levels.comb.k gamma2 <- tmp$tau2 phi <- tmp$rho H <- tmp$G h.Dmat <- tmp$Dmat h.phi.init <- tmp$rho.init } else { h.nlevels.f <- NULL h.levels.f <- NULL h.levels.r <- NULL h.levels.k <- NULL h.levels.comb.k <- NULL H <- NULL h.Dmat <- NULL h.phi.init <- NULL } ######################################################################### #return(list(Z.S=Z.S, sigma2=sigma2, Z.G1=Z.G1, Z.G2=Z.G2, tau2=tau2, rho=rho, G=G, Z.H1=Z.H1, Z.H2=Z.H2, gamma2=gamma2, phi=phi, H=H, Rfix=Rfix, R=R)) ######################################################################### ######################################################################### ######################################################################### Y <- as.matrix(yi) ### initial values for variance components (need to do something better here in the future; see rma.mv2() and rma.bv() for some general ideas) if (verbose > 1) message(mstyle$message("Extracting/computing initial values ...")) QE <- NA_real_ if (!V0) { # for V0 case, this always fails, so can skip it if (verbose > 1) { U <- try(chol(chol2inv(chol(V))), silent=FALSE) } else { U <- try(suppressWarnings(chol(chol2inv(chol(V)))), silent=TRUE) } } if (V0 || inherits(U, "try-error") || any(is.infinite(U))) { ### note: if V is sparse diagonal with 0 along the diagonal, U will not be a 'try-error' ### but have Inf along the diagonal, so need to check for this as well total <- sigma(lm(Y ~ X - 1))^2 if (is.na(total)) # if X is a saturated model, then sigma() yields NaN total <- var(as.vector(Y)) / 100 } else { sX <- U %*% X sY <- U %*% Y beta.FE <- try(solve(crossprod(sX), crossprod(sX, sY)), silent=TRUE) if (inherits(beta.FE, "try-error")) { total <- var(as.vector(Y)) } else { ### TODO: consider a better way to set initial values #total <- max(.001*(sigma2s + tau2s + gamma2s), var(c(Y - X %*% res.FE$beta)) - 1/mean(1/diag(V))) #total <- max(.001*(sigma2s + tau2s + gamma2s), var(as.vector(sY - sX %*% beta)) - 1/mean(1/diag(V))) total <- max(.001*(sigma2s + tau2s + gamma2s), var(as.vector(Y) - as.vector(X %*% beta.FE)) - 1/mean(1/diag(V))) #beta.FE <- ifelse(beta.est, beta.FE, beta.val) QE <- sum(as.vector(sY - sX %*% beta.FE)^2) ### QEp calculated further below } } sigma2.init <- rep(total / (sigma2s + tau2s + gamma2s), sigma2s) tau2.init <- rep(total / (sigma2s + tau2s + gamma2s), tau2s) gamma2.init <- rep(total / (sigma2s + tau2s + gamma2s), gamma2s) if (is.null(g.rho.init)) { rho.init <- rep(.50, rhos) } else { rho.init <- g.rho.init } if (is.null(h.phi.init)) { phi.init <- rep(.50, phis) } else { phi.init <- h.phi.init } ######################################################################### ### set default control parameters con <- list(verbose = FALSE, optimizer = "nlminb", # optimizer to use ("optim","nlminb","uobyqa","newuoa","bobyqa","nloptr","nlm","hjk","nmk","mads","ucminf","lbfgsb3c","subplex","BBoptim","optimParallel","Rcgmin","Rvmmin") optmethod = "BFGS", # argument 'method' for optim() ("Nelder-Mead" and "BFGS" are sensible options) parallel = list(), # parallel argument for optimParallel() (note: 'cl' argument in parallel is not passed; this is directly specified via 'cl') cl = NULL, # arguments for optimParallel() ncpus = 1L, # arguments for optimParallel() sigma2.init = sigma2.init, # initial value(s) for sigma2 tau2.init = tau2.init, # initial value(s) for tau2 rho.init = rho.init, # initial value(s) for rho gamma2.init = gamma2.init, # initial value(s) for gamma2 phi.init = phi.init, # initial value(s) for phi REMLf = TRUE, # full REML likelihood (including all constants) evtol = 1e-07, # lower bound for eigenvalues to determine if model matrix is positive definite cholesky = ifelse(is.element(struct, c("UN","UNR","GEN")), TRUE, FALSE), # by default, use Cholesky factorization for G and H matrix for "UN", "UNR", and "GEN" structures nearpd = FALSE, # to force G and H matrix to become positive definite hessianCtrl = list(r=8), # arguments passed on to 'method.args' of hessian() hesstol = .Machine$double.eps^0.5, # threshold for detecting fixed elements in Hessian hesspack = "numDeriv") # package for computing the Hessian (numDeriv or pracma) ### replace defaults with any user-defined values con.pos <- pmatch(names(control), names(con)) con[c(na.omit(con.pos))] <- control[!is.na(con.pos)] if (verbose) con$verbose <- verbose verbose <- con$verbose ### when restart=TRUE, restart at current estimates if (isTRUE(ddd$restart)) { ### check that the restart is done for a model that has the same type/number of var-cor components as the initial one okrestart <- TRUE if (withS && (is.null(.getfromenv("rma.mv", "sigma2")) || length(.getfromenv("rma.mv", "sigma2")) != sigma2s)) okrestart <- FALSE if (withG && (is.null(.getfromenv("rma.mv", "tau2")) || length(.getfromenv("rma.mv", "tau2")) != tau2s)) okrestart <- FALSE if (withG && (is.null(.getfromenv("rma.mv", "rho")) || length(.getfromenv("rma.mv", "rho")) != rhos)) okrestart <- FALSE if (withH && (is.null(.getfromenv("rma.mv", "gamma2")) || length(.getfromenv("rma.mv", "gamma2")) != gamma2s)) okrestart <- FALSE if (withH && (is.null(.getfromenv("rma.mv", "phi")) || length(.getfromenv("rma.mv", "phi")) != phis)) okrestart <- FALSE if (!okrestart) stop(mstyle$stop(paste0("Restarting for a different model than the initial one."))) con$sigma2.init <- .getfromenv("rma.mv", "sigma2", default=con$sigma2.init) con$tau2.init <- .getfromenv("rma.mv", "tau2", default=con$tau2.init) con$rho.init <- .getfromenv("rma.mv", "rho", default=con$rho.init) con$gamma2.init <- .getfromenv("rma.mv", "gamma2", default=con$gamma2.init) con$phi.init <- .getfromenv("rma.mv", "phi", default=con$phi.init) } ### check for missings in initial values if (anyNA(con$sigma2.init)) stop(mstyle$stop(paste0("No missing values allowed in 'sigma2.init'."))) if (anyNA(con$tau2.init)) stop(mstyle$stop(paste0("No missing values allowed in 'tau2.init'."))) if (anyNA(con$rho.init)) stop(mstyle$stop(paste0("No missing values allowed in 'rho.init'."))) if (anyNA(con$gamma2.init)) stop(mstyle$stop(paste0("No missing values allowed in 'gamma2.init'."))) if (anyNA(con$phi.init)) stop(mstyle$stop(paste0("No missing values allowed in 'phi.init'."))) ### expand initial values to correct length if (length(con$sigma2.init) == 1L) con$sigma2.init <- rep(con$sigma2.init, sigma2s) if (length(con$tau2.init) == 1L) con$tau2.init <- rep(con$tau2.init, tau2s) if (length(con$rho.init) == 1L) con$rho.init <- rep(con$rho.init, rhos) if (length(con$gamma2.init) == 1L) con$gamma2.init <- rep(con$gamma2.init, gamma2s) if (length(con$phi.init) == 1L) con$phi.init <- rep(con$phi.init, phis) ### checks on initial values set by the user (the initial values computed by the function are replaced by the user defined ones at this point) if (withS && any(con$sigma2.init <= 0)) stop(mstyle$stop("Value(s) of 'sigma2.init' must be > 0")) if (withG && any(con$tau2.init <= 0)) stop(mstyle$stop("Value(s) of 'tau2.init' must be > 0.")) if (withG && struct[1]=="CAR" && (con$rho.init <= 0 | con$rho.init >= 1)) stop(mstyle$stop("Value(s) of 'rho.init' must be in (0,1).")) if (withG && is.element(struct[1], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH")) && any(con$rho.init <= 0)) stop(mstyle$stop("Value(s) of 'rho.init' must be > 0.")) if (withG && is.element(struct[1], c("PHYPL","PHYPD")) && con$rho.init < 0) stop(mstyle$stop("Value(s) of 'rho.init' must be in >= 0.")) if (withG && !is.element(struct[1], c("CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD")) && any(con$rho.init <= -1 | con$rho.init >= 1)) stop(mstyle$stop("Value(s) of 'rho.init' must be in (-1,1).")) if (withH && any(con$gamma2.init <= 0)) stop(mstyle$stop("Value(s) of 'gamma2.init' must be > 0.")) if (withH && struct[2]=="CAR" && (con$phi.init <= 0 | con$phi.init >= 1)) stop(mstyle$stop("Value(s) of 'phi.init' must be in (0,1).")) if (withH && is.element(struct[2], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH")) && any(con$phi.init <= 0)) stop(mstyle$stop("Value(s) of 'phi.init' must be > 0.")) if (withH && is.element(struct[2], c("PHYPL","PHYPD")) && con$phi.init < 0) stop(mstyle$stop("Value(s) of 'phi.init' must be in >= 0.")) if (withH && !is.element(struct[2], c("CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD")) && any(con$phi.init <= -1 | con$phi.init >= 1)) stop(mstyle$stop("Value(s) of 'phi.init' must be in (-1,1).")) ### in case user manually sets con$cholesky and specifies only a single value if (length(con$cholesky) == 1L) con$cholesky <- rep(con$cholesky, 2L) ### use of Cholesky factorization only applicable for models with "UN", "UNR", and "GEN" structure if (!withG) ### in case user sets cholesky=TRUE and struct="UN", struct="UNR", or struct="GEN" even though there is no 1st 'inner | outer' term con$cholesky[1] <- FALSE if (con$cholesky[1] && !is.element(struct[1], c("UN","UNR","GEN"))) con$cholesky[1] <- FALSE if (!withH) ### in case user sets cholesky=TRUE and struct="UN", struct="UNR", or struct="GEN" even though there is no 2nd 'inner | outer' term con$cholesky[2] <- FALSE if (con$cholesky[2] && !is.element(struct[2], c("UN","UNR","GEN"))) con$cholesky[2] <- FALSE ### copy initial values back (in case they were replaced by user-defined values); those values are ### then shown in the 'Variance Components in Model' table that is given when verbose=TRUE; cannot ### replace any fixed values, since that can lead to -Inf/+Inf below when transforming the initial ### values and then optim() throws an error and chol(G) and/or chol(H) is then likely to fail #sigma2.init <- ifelse(is.na(sigma2), con$sigma2.init, sigma2) #tau2.init <- ifelse(is.na(tau2), con$tau2.init, tau2) #rho.init <- ifelse(is.na(rho), con$rho.init, rho) sigma2.init <- con$sigma2.init tau2.init <- con$tau2.init rho.init <- con$rho.init gamma2.init <- con$gamma2.init phi.init <- con$phi.init ### plug in fixed values for sigma2, tau2, rho, gamma2, and phi and transform initial values con$sigma2.init <- log(sigma2.init) if (con$cholesky[1]) { if (struct[1] == "UNR") { G <- .con.vcov.UNR(tau2.init, rho.init) } else { G <- .con.vcov.UN(tau2.init, rho.init) } G <- try(chol(G), silent=TRUE) if (inherits(G, "try-error") || anyNA(G)) stop(mstyle$stop("Cannot take Choleski decomposition of initial 'G' matrix.")) if (struct[1] == "UNR") { con$tau2.init <- log(tau2.init) } else { con$tau2.init <- diag(G) ### note: con$tau2.init and con$rho.init are the 'choled' values of the initial G matrix, so con$rho.init really con$rho.init <- G[lower.tri(G)] ### contains the 'choled' covariances; and these values are also passed on the .ll.rma.mv as the initial values } if (length(con$rho.init) == 0L) con$rho.init <- 0 } else { con$tau2.init <- log(tau2.init) if (struct[1] == "CAR") con$rho.init <- qlogis(rho.init) if (is.element(struct[1], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) con$rho.init <- log(rho.init) if (!is.element(struct[1], c("CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) con$rho.init <- atanh(rho.init) } if (con$cholesky[2]) { H <- .con.vcov.UN(gamma2.init, phi.init) H <- try(chol(H), silent=TRUE) if (inherits(H, "try-error") || anyNA(H)) stop(mstyle$stop("Cannot take Choleski decomposition of initial 'H' matrix.")) con$gamma2.init <- diag(H) ### note: con$gamma2.init and con$phi.init are the 'choled' values of the initial H matrix, so con$phi.init really con$phi.init <- H[lower.tri(H)] ### contains the 'choled' covariances; and these values are also passed on the .ll.rma.mv as the initial values if (length(con$phi.init) == 0L) con$phi.init <- 0 } else { con$gamma2.init <- log(gamma2.init) if (struct[2] == "CAR") con$phi.init <- qlogis(phi.init) if (is.element(struct[2], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) con$phi.init <- log(phi.init) if (!is.element(struct[2], c("CAR","SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) con$phi.init <- atanh(phi.init) } optimizer <- match.arg(con$optimizer, c("optim","nlminb","uobyqa","newuoa","bobyqa","nloptr","nlm","hjk","nmk","mads","ucminf","lbfgsb3c","subplex","BBoptim","optimParallel","Nelder-Mead","BFGS","CG","L-BFGS-B","SANN","Brent","Rcgmin","Rvmmin")) optmethod <- match.arg(con$optmethod, c("Nelder-Mead","BFGS","CG","L-BFGS-B","SANN","Brent")) if (optimizer %in% c("Nelder-Mead","BFGS","CG","L-BFGS-B","SANN","Brent")) { optmethod <- optimizer optimizer <- "optim" } nearpd <- con$nearpd cholesky <- con$cholesky parallel <- con$parallel cl <- con$cl ncpus <- con$ncpus optcontrol <- control[is.na(con.pos)] ### get arguments that are control arguments for optimizer if (length(optcontrol) == 0L) optcontrol <- list() ### if control argument 'ncpus' is larger than 1, automatically switch to optimParallel optimizer if (ncpus > 1L) optimizer <- "optimParallel" reml <- ifelse(method == "REML", TRUE, FALSE) con$hesspack <- match.arg(con$hesspack, c("numDeriv","pracma")) if ((.isTRUE(cvvc) || cvvc %in% c("varcor","varcov","transf")) && !requireNamespace(con$hesspack, quietly=TRUE)) stop(mstyle$stop(paste0("Please install the '", con$hesspack, "' package to compute the Hessian."))) ### check if length of sigma2.init, tau2.init, rho.init, gamma2.init, and phi.init matches number of variance components ### note: if a particular component is not included, reset (transformed) initial values (in case the user still specifies multiple initial values) if (withS) { if (length(con$sigma2.init) != sigma2s) stop(mstyle$stop(paste0("Length of 'sigma2.init' argument (", length(con$sigma2.init), ") does not match actual number of variance components (", sigma2s, ")."))) } else { con$sigma2.init <- 0 } if (withG) { if (length(con$tau2.init) != tau2s) stop(mstyle$stop(paste0("Length of 'tau2.init' argument (", length(con$tau2.init), ") does not match actual number of variance components (", tau2s, ")."))) } else { con$tau2.init <- 0 } if (withG) { if (length(con$rho.init) != rhos) stop(mstyle$stop(paste0("Length of 'rho.init' argument (", length(con$rho.init), ") does not match actual number of correlations (", rhos, ")."))) } else { con$rho.init <- 0 } if (withH) { if (length(con$gamma2.init) != gamma2s) stop(mstyle$stop(paste0("Length of 'gamma2.init' argument (", length(con$gamma2.init), ") does not match actual number of variance components (", gamma2s, ")."))) } else { con$gamma2.init <- 0 } if (withH) { if (length(con$phi.init) != phis) stop(mstyle$stop(paste0("Length of 'phi.init' argument (", length(con$phi.init), ") does not match actual number of correlations (", phis, ")."))) } else { con$phi.init <- 0 } ######################################################################### ### check whether model matrix is of full rank if (!.chkpd(crossprod(X), tol=con$evtol)) stop(mstyle$stop("Model matrix not of full rank. Cannot fit model.")) ### which variance components are fixed? (TRUE/FALSE or NA if not applicable = not included) if (withS) { sigma2.fix <- !is.na(sigma2) } else { sigma2.fix <- NA } if (withG) { tau2.fix <- !is.na(tau2) rho.fix <- !is.na(rho) } else { tau2.fix <- NA rho.fix <- NA } if (withH) { gamma2.fix <- !is.na(gamma2) phi.fix <- !is.na(phi) } else { gamma2.fix <- NA phi.fix <- NA } vc.fix <- list(sigma2=sigma2.fix, tau2=tau2.fix, rho=rho.fix, gamma2=gamma2.fix, phi=phi.fix) ### show which variance components are included in the model, their initial value, and their specified value (NA if not specified) if (verbose) { cat("\n") cat(mstyle$verbose("Variance Components in Model:")) if (!withS && !withG && !withH) { cat(mstyle$verbose(" none")) cat("\n\n") } else { cat("\n\n") vcs <- rbind(c("sigma2" = if (withS) round(sigma2.init, digits[["var"]]) else NA_real_, "tau2" = if (withG) round(tau2.init, digits[["var"]]) else NA_real_, "rho" = if (withG) round(rho.init, digits[["var"]]) else NA_real_, "gamma2" = if (withH) round(gamma2.init, digits[["var"]]) else NA_real_, "phi" = if (withH) round(phi.init, digits[["var"]]) else NA_real_), round(c( if (withS) sigma2 else NA_real_, if (withG) tau2 else NA_real_, if (withG) rho else NA_real_, if (withH) gamma2 else NA_real_, if (withH) phi else NA_real_), digits[["var"]])) vcs <- data.frame(vcs, stringsAsFactors=FALSE) rownames(vcs) <- c("initial", "specified") vcs <- rbind(included=ifelse(c(rep(withS, sigma2s), rep(withG, tau2s), rep(withG, rhos), rep(withH, gamma2s), rep(withH, phis)), "Yes", "No"), fixed=unlist(vc.fix), vcs) tmp <- capture.output(print(vcs, na.print="---")) .print.output(tmp, mstyle$verbose) cat("\n") } } level <- .level(level) #return(list(sigma2s, tau2s, rhos, gamma2s, phis)) ######################################################################### ######################################################################### ######################################################################### ###### model fitting, test statistics, and confidence intervals if (verbose > 1) message(mstyle$message("Model fitting ...\n")) ### estimate sigma2, tau2, rho, gamma2, and phi as needed tmp <- .chkopt(optimizer, optcontrol) optimizer <- tmp$optimizer optcontrol <- tmp$optcontrol par.arg <- tmp$par.arg ctrl.arg <- tmp$ctrl.arg if (optimizer == "optimParallel::optimParallel") { parallel$cl <- NULL if (is.null(cl)) { ncpus <- as.integer(ncpus) if (ncpus < 1L) stop(mstyle$stop("Control argument 'ncpus' must be >= 1.")) cl <- parallel::makePSOCKcluster(ncpus) on.exit(parallel::stopCluster(cl), add=TRUE) } else { if (!inherits(cl, "SOCKcluster")) stop(mstyle$stop("Specified cluster is not of class 'SOCKcluster'.")) } parallel$cl <- cl if (is.null(parallel$forward)) parallel$forward <- FALSE if (is.null(parallel$loginfo)) { if (verbose) { parallel$loginfo <- TRUE } else { parallel$loginfo <- FALSE } } } if (!is.element(method, c("FE","EE","CE")) && !is.null(random)) { ### if at least one parameter needs to be estimated if (anyNA(c(sigma2, tau2, rho, gamma2, phi))) { optcall <- paste(optimizer, "(", par.arg, "=c(con$sigma2.init, con$tau2.init, con$rho.init, con$gamma2.init, con$phi.init), .ll.rma.mv, reml=reml, ", ifelse(optimizer=="optim", "method=optmethod, ", ""), "Y=Y, M=V, A=NULL, X=X, k=k, pX=p, D.S=D.S, Z.G1=Z.G1, Z.G2=Z.G2, Z.H1=Z.H1, Z.H2=Z.H2, g.Dmat=g.Dmat, h.Dmat=h.Dmat, sigma2.val=sigma2, tau2.val=tau2, rho.val=rho, gamma2.val=gamma2, phi.val=phi, beta.val=beta.val, sigma2s=sigma2s, tau2s=tau2s, rhos=rhos, gamma2s=gamma2s, phis=phis, withS=withS, withG=withG, withH=withH, struct=struct, g.levels.r=g.levels.r, h.levels.r=h.levels.r, g.values=g.values, h.values=h.values, sparse=sparse, cholesky=cholesky, nearpd=nearpd, vctransf=TRUE, vccov=FALSE, vccon=vccon, verbose=verbose, digits=digits, REMLf=con$REMLf, dofit=FALSE, hessian=FALSE", ctrl.arg, ")\n", sep="") #return(optcall) iteration <- 0 try(assign("iteration", iteration, envir=.metafor), silent=TRUE) if (verbose) { opt.res <- try(eval(str2lang(optcall)), silent=!verbose) } else { opt.res <- try(suppressWarnings(eval(str2lang(optcall))), silent=!verbose) } #return(opt.res) ### convergence checks (if verbose print optimParallel log, if verbose > 2 print opt.res, and unify opt.res$par) opt.res$par <- .chkconv(optimizer=optimizer, opt.res=opt.res, optcontrol=optcontrol, fun="rma.mv", verbose=verbose) if (p == k) { ### when fitting a saturated model (with REML estimation), estimated values of variance components can remain stuck ### at their initial values; this ensures that the values are fixed to zero (unless values were fixed by the user) sigma2[is.na(sigma2)] <- 0 tau2[is.na(tau2)] <- 0 rho[is.na(rho)] <- 0 gamma2[is.na(gamma2)] <- 0 phi[is.na(phi)] <- 0 } } else { ### if all parameter are fixed to known values, can skip optimization opt.res <- list(par=c(sigma2, tau2, rho, gamma2, phi)) } ### save these for Hessian computation sigma2.val <- sigma2 tau2.val <- tau2 rho.val <- rho gamma2.val <- gamma2 phi.val <- phi } else { opt.res <- list(par=c(0,0,0,0,0)) } ######################################################################### ### do the final model fit with estimated variance components fitcall <- .ll.rma.mv(opt.res$par, reml=reml, Y=Y, M=V, A=A, X=X, k=k, pX=p, D.S=D.S, Z.G1=Z.G1, Z.G2=Z.G2, Z.H1=Z.H1, Z.H2=Z.H2, g.Dmat=g.Dmat, h.Dmat=h.Dmat, sigma2.val=sigma2, tau2.val=tau2, rho.val=rho, gamma2.val=gamma2, phi.val=phi, beta.val=beta.val, sigma2s=sigma2s, tau2s=tau2s, rhos=rhos, gamma2s=gamma2s, phis=phis, withS=withS, withG=withG, withH=withH, struct=struct, g.levels.r=g.levels.r, h.levels.r=h.levels.r, g.values=g.values, h.values=h.values, sparse=sparse, cholesky=cholesky, nearpd=nearpd, vctransf=TRUE, vccov=FALSE, vccon=vccon, verbose=FALSE, digits=digits, REMLf=con$REMLf, dofit=TRUE) ### extract elements beta <- as.matrix(fitcall$beta) vb <- as.matrix(fitcall$vb) vb[!beta.est,] <- NA_real_ vb[,!beta.est] <- NA_real_ if (withS) sigma2 <- fitcall$sigma2 if (withG) { G <- as.matrix(fitcall$G) if (is.element(struct[1], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) colnames(G) <- rownames(G) <- seq_len(nrow(G)) if (is.element(struct[1], c("CS","HCS","UN","UNR","AR","HAR","CAR","ID","DIAG"))) colnames(G) <- rownames(G) <- g.levels.f[[1]] if (is.element(struct[1], c("GEN","GDIAG"))) colnames(G) <- rownames(G) <- g.names[-length(g.names)] tau2 <- fitcall$tau2 rho <- fitcall$rho cov1 <- G[lower.tri(G)] } else { cov1 <- 0 } if (withH) { H <- as.matrix(fitcall$H) if (is.element(struct[2], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD"))) colnames(H) <- rownames(H) <- seq_len(nrow(H)) if (is.element(struct[2], c("CS","HCS","UN","UNR","AR","HAR","CAR","ID","DIAG"))) colnames(H) <- rownames(H) <- h.levels.f[[1]] if (is.element(struct[2], c("GEN","GDIAG"))) colnames(H) <- rownames(H) <- h.names[-length(h.names)] gamma2 <- fitcall$gamma2 phi <- fitcall$phi cov2 <- H[lower.tri(H)] } else { cov2 <- 0 } M <- fitcall$M ### remove row and column names of M ### (but only do this if M has row/column names) if (!is.null(dimnames(M))) M <- unname(M) #print(M[1:8,1:8]) if (verbose > 1) message(mstyle$message(ifelse(verbose > 2, "", "\n"), "Conducting tests of the fixed effects ...")) ### ddf calculation if (is.element(test, c("knha","adhoc","t"))) { ddf <- .ddf.calc(dfs, X=X, k=k, p=p, mf.s=mf.s, mf.g=mf.g, mf.h=mf.h) } else { ddf <- rep(NA_integer_, p) } ### the Knapp & Hartung method (this is experimental) s2w <- 1 if (is.element(test, c("knha","adhoc"))) { knha.rma.mv.warn <- .getfromenv("knha.rma.mv.warn", default=TRUE) if (knha.rma.mv.warn) { warning(mstyle$warning("Use of Knapp and Hartung method for 'rma.mv()' models is experimental.\nNote: This warning is only issued once per session (ignore at your peril)."), call.=FALSE) try(assign("knha.rma.mv.warn", FALSE, envir=.metafor), silent=TRUE) } RSS <- try(as.vector(t(Y - X %*% beta) %*% chol2inv(chol(M)) %*% (Y - X %*% beta)), silent=TRUE) if (inherits(RSS, "try-error")) stop(mstyle$stop(paste0("Failure when trying to compute adjustment factor for Knapp and Hartung method."))) if (RSS <= .Machine$double.eps) { s2w <- 0 } else { s2w <- as.vector(RSS / (k - p)) } } if (test == "adhoc") s2w[s2w < 1] <- 1 vb <- s2w * vb ### QM calculation QM <- try(as.vector(t(beta)[btt] %*% chol2inv(chol(vb[btt,btt])) %*% beta[btt]), silent=TRUE) if (inherits(QM, "try-error")) QM <- NA_real_ ### abbreviate some types of coefficient names if (.isTRUE(ddd$abbrev)) { tmp <- colnames(X) tmp <- gsub("relevel(factor(", "", tmp, fixed=TRUE) tmp <- gsub("\\), ref = \"[[:alnum:]]*\")", "", tmp) tmp <- gsub("poly(", "", tmp, fixed=TRUE) tmp <- gsub(", degree = [[:digit:]], raw = TRUE)", "^", tmp) tmp <- gsub(", degree = [[:digit:]], raw = T)", "^", tmp) tmp <- gsub(", degree = [[:digit:]])", "^", tmp) tmp <- gsub("rcs\\([[:alnum:]]*, [[:digit:]]\\)", "", tmp) tmp <- gsub("factor(", "", tmp, fixed=TRUE) tmp <- gsub("I(", "", tmp, fixed=TRUE) tmp <- gsub(")", "", tmp, fixed=TRUE) colnames(X) <- tmp } rownames(beta) <- rownames(vb) <- colnames(vb) <- colnames(X.f) <- colnames(X) se <- sqrt(diag(vb)) names(se) <- NULL zval <- c(beta/se) if (is.element(test, c("knha","adhoc","t"))) { QM <- QM / m QMdf <- c(m, min(ddf[btt])) QMp <- if (QMdf[2] > 0) pf(QM, df1=QMdf[1], df2=QMdf[2], lower.tail=FALSE) else NA_real_ pval <- sapply(seq_along(ddf), function(j) if (ddf[j] > 0) 2*pt(abs(zval[j]), df=ddf[j], lower.tail=FALSE) else NA_real_) crit <- sapply(seq_along(ddf), function(j) if (ddf[j] > 0) qt(level/2, df=ddf[j], lower.tail=FALSE) else NA_real_) } else { QMdf <- c(m, NA_integer_) QMp <- pchisq(QM, df=QMdf[1], lower.tail=FALSE) pval <- 2*pnorm(abs(zval), lower.tail=FALSE) crit <- qnorm(level/2, lower.tail=FALSE) } ci.lb <- c(beta - crit * se) ci.ub <- c(beta + crit * se) ######################################################################### ### heterogeneity test (Wald-type test of the extra coefficients in the saturated model) if (verbose > 1) message(mstyle$message("Conducting heterogeneity test ...")) QEdf <- k-p if (QEdf > 0L) { ### if V is not positive definite, FE model fit will fail; then QE is NA ### otherwise compute the RSS (which is equal to the Q/QE-test statistic) QEp <- pchisq(QE, df=QEdf, lower.tail=FALSE) } else { ### if the user fits a saturated model, then fit must be perfect and QE = 0 and QEp = 1 QE <- 0 QEp <- 1 } ### log-likelihood under a saturated model with ML estimation ll.QE <- -1/2 * (k) * log(2*base::pi) - 1/2 * determinant(V, logarithm=TRUE)$modulus ######################################################################### ###### compute Hessian hessian <- NA_real_ vvc <- NA_real_ if (.isTRUE(cvvc) || cvvc %in% c("varcor","varcov","transf")) { if (verbose > 1) message(mstyle$message("Computing Hessian ...\n")) if (cvvc == "varcov" && (any(sigma2.fix, na.rm=TRUE) || any(tau2.fix, na.rm=TRUE) || any(rho.fix, na.rm=TRUE) || any(gamma2.fix, na.rm=TRUE) || any(phi.fix, na.rm=TRUE))) { warning(mstyle$warning("Cannot use cvvc='varcov' when one or more components are fixed. Setting cvvc='varcor'."), call.=FALSE) cvvc <- "varcor" } if (cvvc == "varcov" && any(!is.element(struct, c("UN","GEN")))) { warning(mstyle$warning("Cannot use cvvc='varcov' for the specified structure(s). Setting cvvc='varcor'."), call.=FALSE) cvvc <- "varcor" } if (cvvc == "varcov") { if (con$hesspack == "numDeriv") hessian <- try(numDeriv::hessian(func=.ll.rma.mv, x = c(sigma2, tau2, cov1, gamma2, cov2), method.args=con$hessianCtrl, reml=reml, Y=Y, M=V, A=NULL, X=X, k=k, pX=p, D.S=D.S, Z.G1=Z.G1, Z.G2=Z.G2, Z.H1=Z.H1, Z.H2=Z.H2, g.Dmat=g.Dmat, h.Dmat=h.Dmat, sigma2.val=sigma2.val, tau2.val=tau2.val, rho.val=rho.val, gamma2.val=gamma2.val, phi.val=phi.val, beta.val=beta.val, sigma2s=sigma2s, tau2s=tau2s, rhos=rhos, gamma2s=gamma2s, phis=phis, withS=withS, withG=withG, withH=withH, struct=struct, g.levels.r=g.levels.r, h.levels.r=h.levels.r, g.values=g.values, h.values=h.values, sparse=sparse, cholesky=c(FALSE,FALSE), nearpd=nearpd, vctransf=FALSE, vccov=TRUE, vccon=vccon, verbose=verbose, digits=digits, REMLf=con$REMLf, hessian=TRUE), silent=TRUE) if (con$hesspack == "pracma") hessian <- try(pracma::hessian(f=.ll.rma.mv, x0 = c(sigma2, tau2, cov1, gamma2, cov2), reml=reml, Y=Y, M=V, A=NULL, X=X, k=k, pX=p, D.S=D.S, Z.G1=Z.G1, Z.G2=Z.G2, Z.H1=Z.H1, Z.H2=Z.H2, g.Dmat=g.Dmat, h.Dmat=h.Dmat, sigma2.val=sigma2.val, tau2.val=tau2.val, rho.val=rho.val, gamma2.val=gamma2.val, phi.val=phi.val, beta.val=beta.val, sigma2s=sigma2s, tau2s=tau2s, rhos=rhos, gamma2s=gamma2s, phis=phis, withS=withS, withG=withG, withH=withH, struct=struct, g.levels.r=g.levels.r, h.levels.r=h.levels.r, g.values=g.values, h.values=h.values, sparse=sparse, cholesky=c(FALSE,FALSE), nearpd=nearpd, vctransf=FALSE, vccov=TRUE, vccon=vccon, verbose=verbose, digits=digits, REMLf=con$REMLf, hessian=TRUE), silent=TRUE) # note: vctransf=FALSE and cholesky=c(FALSE,FALSE), so we get the Hessian for the untransfored variances and covariances } else { if (con$hesspack == "numDeriv") hessian <- try(numDeriv::hessian(func=.ll.rma.mv, x = if (cvvc=="transf") opt.res$par else c(sigma2, tau2, rho, gamma2, phi), method.args=con$hessianCtrl, reml=reml, Y=Y, M=V, A=NULL, X=X, k=k, pX=p, D.S=D.S, Z.G1=Z.G1, Z.G2=Z.G2, Z.H1=Z.H1, Z.H2=Z.H2, g.Dmat=g.Dmat, h.Dmat=h.Dmat, sigma2.val=sigma2.val, tau2.val=tau2.val, rho.val=rho.val, gamma2.val=gamma2.val, phi.val=phi.val, beta.val=beta.val, sigma2s=sigma2s, tau2s=tau2s, rhos=rhos, gamma2s=gamma2s, phis=phis, withS=withS, withG=withG, withH=withH, struct=struct, g.levels.r=g.levels.r, h.levels.r=h.levels.r, g.values=g.values, h.values=h.values, sparse=sparse, cholesky=ifelse(c(cvvc=="transf",cvvc=="transf") & cholesky, TRUE, FALSE), nearpd=nearpd, vctransf=cvvc=="transf", vccov=FALSE, vccon=vccon, verbose=verbose, digits=digits, REMLf=con$REMLf, hessian=TRUE), silent=TRUE) if (con$hesspack == "pracma") hessian <- try(pracma::hessian(f=.ll.rma.mv, x0 = if (cvvc=="transf") opt.res$par else c(sigma2, tau2, rho, gamma2, phi), reml=reml, Y=Y, M=V, A=NULL, X=X, k=k, pX=p, D.S=D.S, Z.G1=Z.G1, Z.G2=Z.G2, Z.H1=Z.H1, Z.H2=Z.H2, g.Dmat=g.Dmat, h.Dmat=h.Dmat, sigma2.val=sigma2.val, tau2.val=tau2.val, rho.val=rho.val, gamma2.val=gamma2.val, phi.val=phi.val, beta.val=beta.val, sigma2s=sigma2s, tau2s=tau2s, rhos=rhos, gamma2s=gamma2s, phis=phis, withS=withS, withG=withG, withH=withH, struct=struct, g.levels.r=g.levels.r, h.levels.r=h.levels.r, g.values=g.values, h.values=h.values, sparse=sparse, cholesky=ifelse(c(cvvc=="transf",cvvc=="transf") & cholesky, TRUE, FALSE), nearpd=nearpd, vctransf=cvvc=="transf", vccov=FALSE, vccon=vccon, verbose=verbose, digits=digits, REMLf=con$REMLf, hessian=TRUE), silent=TRUE) # note: when cvvc=TRUE/"covcor", get the Hessian for the (untransfored) variances and correlations # when cvvc="transf", get the Hessian for the transformed variances and correlations } if (inherits(hessian, "try-error")) { warning(mstyle$warning("Error when trying to compute the Hessian."), call.=FALSE) hessian <- NA_real_ } else { ### row/column names colnames(hessian) <- seq_len(ncol(hessian)) ### need to do this, so the subsetting of colnames below works if (sigma2s == 1) { colnames(hessian)[1] <- "sigma^2" } else { colnames(hessian)[1:sigma2s] <- paste("sigma^2.", seq_len(sigma2s), sep="") } if (tau2s == 1) { colnames(hessian)[sigma2s+1] <- "tau^2" } else { colnames(hessian)[(sigma2s+1):(sigma2s+tau2s)] <- paste("tau^2.", seq_len(tau2s), sep="") } term <- ifelse(cvvc == "varcov", ifelse(withH, "cov1", "cov"), "rho") if (rhos == 1) { colnames(hessian)[sigma2s+tau2s+1] <- term } else { colnames(hessian)[(sigma2s+tau2s+1):(sigma2s+tau2s+rhos)] <- paste(term, ".", outer(seq_len(g.nlevels.f[1]), seq_len(g.nlevels.f[1]), paste, sep=".")[lower.tri(matrix(NA,nrow=g.nlevels.f,ncol=g.nlevels.f))], sep="") #colnames(hessian)[(sigma2s+tau2s+1):(sigma2s+tau2s+rhos)] <- paste(term, ".", seq_len(rhos), sep="") } if (gamma2s == 1) { colnames(hessian)[sigma2s+tau2s+rhos+1] <- "gamma^2" } else { colnames(hessian)[(sigma2s+tau2s+rhos+1):(sigma2s+tau2s+rhos+gamma2s)] <- paste("gamma^2.", seq_len(gamma2s), sep="") } term <- ifelse(cvvc == "varcov", "cov2", "phi") if (phis == 1) { colnames(hessian)[sigma2s+tau2s+rhos+gamma2s+1] <- term } else { colnames(hessian)[(sigma2s+tau2s+rhos+gamma2s+1):(sigma2s+tau2s+rhos+gamma2s+phis)] <- paste(term, ".", outer(seq_len(h.nlevels.f[1]), seq_len(h.nlevels.f[1]), paste, sep=".")[lower.tri(matrix(NA,nrow=h.nlevels.f,ncol=h.nlevels.f))], sep="") #colnames(hessian)[(sigma2s+tau2s+rhos+gamma2s+1):(sigma2s+tau2s+rhos+gamma2s+phis)] <- paste(term, ".", seq_len(phis), sep="") } rownames(hessian) <- colnames(hessian) ### select correct rows/columns from Hessian depending on components in the model ### FIXME: this isn't quite right, since "DIAG" and "ID" have a rho/phi element, but this is fixed at 0, so should also exclude this ### in fact, all fixed elements should be filtered out (done below) #if (withS && withG && withH) #hessian <- hessian[1:nrow(hessian),1:ncol(hessian), drop=FALSE] if (withS && withG && !withH) hessian <- hessian[1:(nrow(hessian)-2),1:(ncol(hessian)-2), drop=FALSE] if (withS && !withG && !withH) hessian <- hessian[1:(nrow(hessian)-4),1:(ncol(hessian)-4), drop=FALSE] if (!withS && withG && withH) hessian <- hessian[2:nrow(hessian),2:ncol(hessian), drop=FALSE] if (!withS && withG && !withH) hessian <- hessian[2:(nrow(hessian)-2),2:(ncol(hessian)-2), drop=FALSE] if (!withS && !withG && !withH) hessian <- NA_real_ ### reorder hessian when vccov into the order of the lower triangular elements of G/H if (cvvc == "varcov" && withG) { posG <- matrix(NA_real_, nrow=tau2s, ncol=tau2s) diag(posG) <- 1:tau2s posG[lower.tri(posG)] <- (tau2s+1):(tau2s*(tau2s+1)/2) posG <- posG[lower.tri(posG, diag=TRUE)] if (withS) { pos <- c(1:sigma2s, sigma2s+posG) } else { pos <- posG } if (withH) { posH <- matrix(NA_real_, nrow=gamma2s, ncol=gamma2s) diag(posH) <- 1:gamma2s posH[lower.tri(posH)] <- (gamma2s+1):(gamma2s*(gamma2s+1)/2) posH <- posH[lower.tri(posH, diag=TRUE)] pos <- c(pos, max(pos)+posH) } hessian <- hessian[pos,pos] } ### detect rows/columns that are essentially all equal to 0 (fixed elements) and filter them out hest <- !apply(hessian, 1, function(x) all(abs(x) <= con$hesstol)) hessian <- hessian[hest, hest, drop=FALSE] ### try to invert Hessian vvc <- try(suppressWarnings(chol2inv(chol(hessian))), silent=TRUE) if (inherits(vvc, "try-error") || anyNA(vvc) || any(is.infinite(vvc))) { warning(mstyle$warning("Error when trying to invert Hessian."), call.=FALSE) vvc <- NA_real_ } else { dimnames(vvc) <- dimnames(hessian) } } if (verbose > 1) cat("\n") } ######################################################################### ###### fit statistics if (verbose > 1) message(mstyle$message("Computing fit statistics and log likelihood ...")) ### note: this only counts *estimated* variance components and correlations for the total number of parameters p <- sum(beta.est) if (is.null(vccon)) { parms <- p + ifelse(withS, sum(ifelse(sigma2.fix, 0, 1)), 0) + ifelse(withG, sum(ifelse(tau2.fix, 0, 1)), 0) + ifelse(withG, sum(ifelse(rho.fix, 0, 1)), 0) + ifelse(withH, sum(ifelse(gamma2.fix, 0, 1)), 0) + ifelse(withH, sum(ifelse(phi.fix, 0, 1)), 0) } else { parms <- p + ifelse(withS && !is.null(vccon$sigma2), length(unique(vccon$sigma2)) - sum(sigma2.fix), 0) + ifelse(withG && !is.null(vccon$tau2), length(unique(vccon$tau2)) - sum(tau2.fix), 0) + ifelse(withG && !is.null(vccon$rho), length(unique(vccon$rho)) - sum(rho.fix), 0) + ifelse(withH && !is.null(vccon$gamma2), length(unique(vccon$gamma2)) - sum(gamma2.fix), 0) + ifelse(withH && !is.null(vccon$phi), length(unique(vccon$phi)) - sum(phi.fix), 0) } ll.ML <- fitcall$llvals[1] ll.REML <- fitcall$llvals[2] if (allvipos) { dev.ML <- -2 * (ll.ML - ll.QE) } else { dev.ML <- -2 * ll.ML } AIC.ML <- -2 * ll.ML + 2*parms BIC.ML <- -2 * ll.ML + parms * log(k) AICc.ML <- -2 * ll.ML + 2*parms * max(k, parms+2) / (max(k, parms+2) - parms - 1) dev.REML <- -2 * (ll.REML - 0) # saturated model has ll = 0 when using the full REML likelihood AIC.REML <- -2 * ll.REML + 2*parms BIC.REML <- -2 * ll.REML + parms * log(k-p) AICc.REML <- -2 * ll.REML + 2*parms * max(k-p, parms+2) / (max(k-p, parms+2) - parms - 1) fit.stats <- matrix(c(ll.ML, dev.ML, AIC.ML, BIC.ML, AICc.ML, ll.REML, dev.REML, AIC.REML, BIC.REML, AICc.REML), ncol=2, byrow=FALSE) dimnames(fit.stats) <- list(c("ll","dev","AIC","BIC","AICc"), c("ML","REML")) fit.stats <- data.frame(fit.stats) ######################################################################### ### replace interaction() notation with : notation for nicer output (also for paste() and paste0()) replfun <- function(x) { if (grepl("interaction(", x, fixed=TRUE) || grepl("paste(", x, fixed=TRUE) || grepl("paste0(", x, fixed=TRUE)) { #x <- gsub("^interaction\\(", "", x) #x <- gsub(", ", ":", x, fixed=TRUE) #x <- gsub("\\)$", "", x, fixed=FALSE) #x <- gsub("(.*)interaction\\(\\s*(.*)\\s*,\\s*(.*)\\s*\\)(.*)", "\\1(\\2:\\3)\\4", x) #x <- gsub("interaction\\((.*)\\s*,\\s*(.*)\\)", "(\\1:\\2)", x) x <- gsub("interaction\\((.*)\\)", "(\\1)", x) x <- gsub("paste[0]?\\((.*)\\)", "(\\1)", x) x <- gsub(",", ":", x, fixed=TRUE) x <- gsub(" ", "", x, fixed=TRUE) x <- gsub("^\\((.*)\\)$", "\\1", x) # if a name is "(...)", then can remove the () } return(x) } s.names <- sapply(s.names, replfun) g.names <- sapply(g.names, replfun) h.names <- sapply(h.names, replfun) ############################################################################ ###### prepare output if (verbose > 1) message(mstyle$message("Preparing output ...")) p.eff <- p k.eff <- k weighted <- TRUE if (is.null(ddd$outlist) || ddd$outlist == "nodata") { res <- list(b=beta, beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, vb=vb, sigma2=sigma2, tau2=tau2, rho=rho, gamma2=gamma2, phi=phi, QE=QE, QEdf=QEdf, QEp=QEp, QM=QM, QMdf=QMdf, QMp=QMp, k=k, k.f=k.f, k.eff=k.eff, k.all=k.all, p=p, p.eff=p.eff, parms=parms, int.only=int.only, int.incl=int.incl, intercept=intercept, allvipos=allvipos, coef.na=coef.na, yi=yi, vi=vi, V=V, W=A, X=X, yi.f=yi.f, vi.f=vi.f, V.f=V.f, X.f=X.f, W.f=W.f, ni=ni, ni.f=ni.f, M=M, G=G, H=H, hessian=hessian, vvc=vvc, vccon=vccon, ids=ids, not.na=not.na, subset=subset, slab=slab, slab.null=slab.null, measure=measure, method=method, weighted=weighted, test=test, dfs=dfs, ddf=ddf, s2w=s2w, btt=btt, m=m, digits=digits, level=level, sparse=sparse, dist=ddd$dist, control=control, verbose=verbose, fit.stats=fit.stats, vc.fix=vc.fix, withS=withS, withG=withG, withH=withH, withR=withR, formulas=formulas, sigma2s=sigma2s, tau2s=tau2s, rhos=rhos, gamma2s=gamma2s, phis=phis, s.names=s.names, g.names=g.names, h.names=h.names, s.levels=s.levels, s.levels.f=s.levels.f, s.nlevels=s.nlevels, s.nlevels.f=s.nlevels.f, g.nlevels.f=g.nlevels.f, g.nlevels=g.nlevels, h.nlevels.f=h.nlevels.f, h.nlevels=h.nlevels, g.levels.f=g.levels.f, g.levels.k=g.levels.k, g.levels.comb.k=g.levels.comb.k, h.levels.f=h.levels.f, h.levels.k=h.levels.k, h.levels.comb.k=h.levels.comb.k, struct=struct, Rfix=Rfix, R=R, Rscale=Rscale, mf.r=mf.r, mf.s=mf.s, mf.g=mf.g, mf.g.f=mf.g.f, mf.h=mf.h, mf.h.f=mf.h.f, Z.S=Z.S, Z.G1=Z.G1, Z.G2=Z.G2, Z.H1=Z.H1, Z.H2=Z.H2, formula.yi=formula.yi, formula.mods=formula.mods, random=random, version=packageVersion("metafor"), call=mf) if (is.null(ddd$outlist)) res <- append(res, list(data=data), which(names(res) == "fit.stats")) } else { if (ddd$outlist == "minimal") { res <- list(b=beta, beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, vb=vb, sigma2=sigma2, tau2=tau2, rho=rho, gamma2=gamma2, phi=phi, QE=QE, QEdf=QEdf, QEp=QEp, QM=QM, QMdf=QMdf, QMp=QMp, k=k, k.eff=k.eff, k.all=k.all, p=p, p.eff=p.eff, parms=parms, int.only=int.only, measure=measure, method=method, test=test, dfs=dfs, ddf=ddf, btt=btt, m=m, digits=digits, fit.stats=fit.stats, vc.fix=vc.fix, withS=withS, withG=withG, withH=withH, withR=withR, s.names=s.names, g.names=g.names, h.names=h.names, s.nlevels=s.nlevels, g.nlevels.f=g.nlevels.f, g.nlevels=g.nlevels, h.nlevels.f=h.nlevels.f, h.nlevels=h.nlevels, g.levels.f=g.levels.f, g.levels.k=g.levels.k, g.levels.comb.k=g.levels.comb.k, h.levels.f=h.levels.f, h.levels.k=h.levels.k, h.levels.comb.k=h.levels.comb.k, struct=struct, Rfix=Rfix) } else { res <- eval(str2lang(paste0("list(", ddd$outlist, ")"))) } } time.end <- proc.time() res$time <- unname(time.end - time.start)[3] if (.isTRUE(ddd$time)) .print.time(res$time) if (verbose || .isTRUE(ddd$time)) cat("\n") class(res) <- c("rma.mv", "rma") return(res) } metafor/R/dfbetas.rma.uni.r0000644000176200001440000000016413457322061015257 0ustar liggesusersdfbetas.rma.uni <- function(model, progbar=FALSE, ...) influence(model, progbar=progbar, measure="dfbetas", ...) metafor/R/misc.func.hidden.vif.r0000644000176200001440000002124414440115472016202 0ustar liggesusers############################################################################ .compvif <- function(j, btt, vcov, xintercept, intercept, spec=NULL, colnames=NULL, obj=NULL, coef="beta", sim=FALSE) { x <- obj btt <- btt[[j]] # note: this might actually be att when computing (G)VIFs for the scale coefficients in location-scale model if (is.null(x)) { ### remove intercept (if there is one and intercept=FALSE) from vcov and adjust btt accordingly if (xintercept && !intercept) { vcov <- vcov[-1,-1,drop=FALSE] btt <- btt - 1 btt <- btt[btt > 0] } rb <- suppressWarnings(cov2cor(vcov)) gvif <- det(rb[btt,btt,drop=FALSE]) * det(rb[-btt,-btt,drop=FALSE]) / det(rb) } else { ### if 'x' is not NULL, then reestimate the model for the computation of the (G)VIF if (xintercept && !intercept) btt <- btt[btt > 1] if (coef == "beta") { Xbtt <- x$X[,btt,drop=FALSE] Zbtt <- x$Z if (xintercept && !intercept && !identical(btt,1L)) Xbtt <- cbind(1, Xbtt) outlist <- "vb=vb" } else { Xbtt <- x$X Zbtt <- x$Z[,btt,drop=FALSE] if (xintercept && !intercept && !identical(btt,1L)) Zbtt <- cbind(1, Zbtt) outlist <- "va=va" } if (inherits(x, "rma.uni")) { if (inherits(x, "rma.ls")) { args <- list(yi=x$yi, vi=x$vi, weights=x$weights, mods=Xbtt, intercept=FALSE, scale=Zbtt, link=x$link, method=x$method, weighted=x$weighted, test=x$test, level=x$level, alpha=ifelse(x$alpha.fix, x$alpha, NA), optbeta=x$optbeta, beta=ifelse(x$beta.fix, x$beta, NA), control=x$control, skiphes=FALSE, outlist=outlist) } else { args <- list(yi=x$yi, vi=x$vi, weights=x$weights, mods=Xbtt, intercept=FALSE, method=x$method, weighted=x$weighted, test=x$test, level=x$level, tau2=ifelse(x$tau2.fix, x$tau2, NA), control=x$control, skipr2=TRUE, outlist=outlist) } tmp <- try(suppressWarnings(.do.call(rma.uni, args)), silent=TRUE) } if (inherits(x, "rma.mv")) { args <- list(yi=x$yi, V=x$V, W=x$W, mods=Xbtt, random=x$random, struct=x$struct, intercept=FALSE, data=x$mf.r, method=x$method, test=x$test, dfs=x$dfs, level=x$level, R=x$R, Rscale=x$Rscale, sigma2=ifelse(x$vc.fix$sigma2, x$sigma2, NA), tau2=ifelse(x$vc.fix$tau2, x$tau2, NA), rho=ifelse(x$vc.fix$rho, x$rho, NA), gamma2=ifelse(x$vc.fix$gamma2, x$gamma2, NA), phi=ifelse(x$vc.fix$phi, x$phi, NA), sparse=x$sparse, dist=x$dist, vccon=obj$vccon, control=x$control, outlist=outlist) tmp <- try(suppressWarnings(.do.call(rma.mv, args)), silent=TRUE) } if (inherits(tmp, "try-error")) { if (sim) { return(NA_real_) } else { gvif <- NA_real_ } } else { if (xintercept && !intercept) { gvif <- det(vcov(x, type=coef)[btt,btt,drop=FALSE]) / det(vcov(tmp, type=coef)[-1,-1,drop=FALSE]) } else { gvif <- det(vcov(x, type=coef)[btt,btt,drop=FALSE]) / det(vcov(tmp, type=coef)) } } } if (sim) { return(gvif) } else { m <- length(btt) gsif <- gvif^(1/(2*m)) ### readjust btt if this was done earlier if (is.null(x) && xintercept && !intercept) btt <- btt + 1 if (length(btt) == 1L) { coefname <- colnames[btt] } else { coefname <- "" } return(data.frame(spec=.format.btt(spec[[j]]), coefs=.format.btt(btt), coefname=coefname, m=m, vif=gvif, sif=gsif)) } } ############################################################################ .compvifsim <- function(l, obj, coef, btt=NULL, att=NULL, reestimate=FALSE, intercept=FALSE, parallel=FALSE, seed=NULL, joinb=NULL, joina=NULL) { if (parallel == "snow") library(metafor) if (!is.null(seed)) set.seed(seed+l) x <- obj if (coef == "beta") { if (reestimate) { outlist <- "nodata" } else { outlist <- "coef.na=coef.na, vb=vb" } if (is.null(joinb)) { if (is.null(x$data) || is.null(x$formula.mods)) { Xperm <- apply(x$X, 2, sample) } else { #data <- x$data data <- get_all_vars(x$formula.mods, data=x$data) # only get variables that are actually needed if (!is.null(x$subset)) data <- data[x$subset,,drop=FALSE] data <- data[x$not.na,,drop=FALSE] Xperm <- model.matrix(x$formula.mods, data=as.data.frame(lapply(data, sample))) #Xperm <- Xperm[,!x$coef.na,drop=FALSE] } } else { Xperm <- .permXvif(joinb, x$X) } if (inherits(x, "rma.uni")) { if (inherits(x, "rma.ls")) { args <- list(yi=x$yi, vi=x$vi, weights=x$weights, mods=Xperm, intercept=FALSE, scale=x$Z, link=x$link, method=x$method, weighted=x$weighted, test=x$test, level=x$level, alpha=ifelse(x$alpha.fix, x$alpha, NA), optbeta=x$optbeta, beta=ifelse(x$beta.fix, x$beta, NA), control=x$control, skiphes=FALSE, outlist=outlist) } else { args <- list(yi=x$yi, vi=x$vi, weights=x$weights, mods=Xperm, intercept=FALSE, method=x$method, weighted=x$weighted, test=x$test, level=x$level, tau2=ifelse(x$tau2.fix, x$tau2, NA), control=x$control, skipr2=TRUE, outlist=outlist) } tmp <- try(suppressWarnings(.do.call(rma.uni, args)), silent=TRUE) #tmp <- try(.do.call(rma.uni, args)) } if (inherits(x, "rma.mv")) { args <- list(yi=x$yi, V=x$V, W=x$W, mods=Xperm, random=x$random, struct=x$struct, intercept=FALSE, data=x$mf.r, method=x$method, test=x$test, dfs=x$dfs, level=x$level, R=x$R, Rscale=x$Rscale, sigma2=ifelse(x$vc.fix$sigma2, x$sigma2, NA), tau2=ifelse(x$vc.fix$tau2, x$tau2, NA), rho=ifelse(x$vc.fix$rho, x$rho, NA), gamma2=ifelse(x$vc.fix$gamma2, x$gamma2, NA), phi=ifelse(x$vc.fix$phi, x$phi, NA), sparse=x$sparse, dist=x$dist, vccon=obj$vccon, control=x$control, outlist=outlist) tmp <- try(suppressWarnings(.do.call(rma.mv, args)), silent=TRUE) } if (inherits(tmp, "try-error")) return(rep(NA_real_, length(btt))) if (any(tmp$coef.na)) return(sapply(btt, function(x) if (any(which(tmp$coef.na) %in% x)) Inf else NA_real_)) vcov <- vcov(tmp, type="beta") obj <- if (reestimate) tmp else NULL vifs <- sapply(seq_along(btt), .compvif, btt=btt, vcov=vcov, xintercept=x$intercept, intercept=intercept, obj=obj, sim=TRUE) } else { if (reestimate) { outlist <- "nodata" } else { outlist <- "coef.na.Z=coef.na.Z, va=va" } if (is.null(joina)) { if (is.null(x$data) || is.null(x$formula.scale)) { Zperm <- apply(x$Z, 2, sample) } else { #data <- x$data data <- get_all_vars(x$formula.scale, data=x$data) # only get variables that are actually needed if (!is.null(x$subset)) data <- data[x$subset,,drop=FALSE] data <- data[x$not.na,,drop=FALSE] Zperm <- model.matrix(x$formula.scale, data=as.data.frame(lapply(data, sample))) #Zperm <- Zperm[,!x$coef.na.Z,drop=FALSE] } } else { Zperm <- .permXvif(joina, x$Z) } args <- list(yi=x$yi, vi=x$vi, weights=x$weights, mods=x$X, intercept=FALSE, scale=Zperm, link=x$link, method=x$method, weighted=x$weighted, test=x$test, level=x$level, alpha=ifelse(x$alpha.fix, x$alpha, NA), optbeta=x$optbeta, beta=ifelse(x$beta.fix, x$beta, NA), control=x$control, skiphes=FALSE, outlist=outlist) tmp <- try(suppressWarnings(.do.call(rma.uni, args)), silent=TRUE) #tmp <- try(.do.call(rma.uni, args)) if (inherits(tmp, "try-error")) return(rep(NA_real_, length(att))) if (any(tmp$coef.na.Z)) return(sapply(att, function(x) if (any(which(tmp$coef.na.Z) %in% x)) Inf else NA_real_)) vcov <- vcov(tmp, type="alpha") obj <- if (reestimate) tmp else NULL vifs <- sapply(seq_along(att), .compvif, btt=att, vcov=vcov, xintercept=x$Z.intercept, intercept=intercept, obj=obj, sim=TRUE) } return(vifs) } .permXvif <- function(b, X) { ub <- unique(b) n <- nrow(X) for (j in 1:length(ub)) { pos <- which(ub[j] == b) X[,pos] <- X[sample(n),pos] } return(X) } ############################################################################ metafor/R/to.long.r0000644000176200001440000012647314473661357013710 0ustar liggesusersto.long <- function(measure, ai, bi, ci, di, n1i, n2i, x1i, x2i, t1i, t2i, m1i, m2i, sd1i, sd2i, xi, mi, ri, ti, sdi, ni, data, slab, subset, add=1/2, to="none", drop00=FALSE, vlong=FALSE, append=TRUE, var.names) { mstyle <- .get.mstyle("crayon" %in% .packages()) ### check argument specifications if (missing(measure)) stop(mstyle$stop("Must specify an effect size or outcome measure via the 'measure' argument.")) if (!is.character(measure)) stop(mstyle$stop("The 'measure' argument must be a character string.")) if (!is.element(measure, c("RR","OR","PETO","RD","AS","PHI","YUQ","YUY","RTET", # 2x2 table measures "PBIT","OR2D","OR2DN","OR2DL", # - transformations to SMD "MPRD","MPRR","MPOR","MPORC","MPPETO","MPORM", # - measures for matched pairs data "IRR","IRD","IRSD", # two-group person-time data measures "MD","SMD","SMDH","ROM", # two-group mean/SD measures "CVR","VR", # coefficient of variation ratio, variability ratio "RPB","RBIS","D2OR","D2ORN","D2ORL", # - transformations to r_PB, r_BIS, and log(OR) "COR","UCOR","ZCOR", # correlations (raw and r-to-z transformed) "PCOR","ZPCOR","SPCOR", # partial and semi-partial correlations "R2","ZR2", # coefficient of determination (raw and r-to-z transformed) "PR","PLN","PLO","PAS","PFT", # single proportions (and transformations thereof) "IR","IRLN","IRS","IRFT", # single-group person-time data (and transformations thereof) "MN","MNLN","CVLN","SDLN","SMN", # mean, log(mean), log(CV), log(SD), standardized mean "MC","SMCC","SMCR","SMCRH","ROMC","CVRC","VRC", # raw/standardized mean change, log(ROM), CVR, and VR for dependent samples "ARAW","AHW","ABT"))) # alpha (and transformations thereof) stop(mstyle$stop("Unknown 'measure' specified.")) if (is.element(measure, c("CVR","VR","PCOR","ZPCOR","SPCOR","R2","ZR2","CVLN","SDLN","VRC"))) stop(mstyle$stop("Function not available for this outcome measure.")) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (!is.element(to, c("all","only0","if0all","none"))) stop(mstyle$stop("Unknown 'to' argument specified.")) ### check if data argument has been specified if (missing(data)) data <- NULL ### need this at the end to check if append=TRUE can actually be done has.data <- !is.null(data) if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } doappend <- FALSE if (has.data && is.logical(append) && isTRUE(append)) { doappend <- TRUE appendvars <- seq_len(ncol(data)) } if (has.data && is.numeric(append)) { doappend <- TRUE append <- unique(round(append)) append <- append[which(append >= 1)] append <- append[which(append <= ncol(data))] append <- c(na.omit(append)) appendvars <- append } if (has.data && is.character(append)) { doappend <- TRUE append <- unique(append) append <- pmatch(append, colnames(data)) append <- c(na.omit(append)) appendvars <- append } mf <- match.call() ### get slab and subset arguments (will be NULL when unspecified) slab <- .getx("slab", mf=mf, data=data) subset <- .getx("subset", mf=mf, data=data) ######################################################################### ######################################################################### ######################################################################### if (is.element(measure, c("RR","OR","RD","AS","PETO","PHI","YUQ","YUY","RTET","PBIT","OR2D","OR2DN","OR2DL","MPRD","MPRR","MPOR","MPORC","MPPETO","MPORM"))) { ai <- .getx("ai", mf=mf, data=data, checknumeric=TRUE) bi <- .getx("bi", mf=mf, data=data, checknumeric=TRUE) ci <- .getx("ci", mf=mf, data=data, checknumeric=TRUE) di <- .getx("di", mf=mf, data=data, checknumeric=TRUE) n1i <- .getx("n1i", mf=mf, data=data, checknumeric=TRUE) n2i <- .getx("n2i", mf=mf, data=data, checknumeric=TRUE) if (!.equal.length(ai, bi, ci, di, n1i, n2i)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) n1i.inc <- n1i != ai + bi n2i.inc <- n2i != ci + di if (any(n1i.inc, na.rm=TRUE)) stop(mstyle$stop("One or more 'n1i' values are not equal to 'ai + bi'.")) if (any(n2i.inc, na.rm=TRUE)) stop(mstyle$stop("One or more 'n2i' values are not equal to 'ci + di'.")) bi <- replmiss(bi, n1i-ai) di <- replmiss(di, n2i-ci) if (!.all.specified(ai, bi, ci, di)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., ai, bi, ci, di or ai, n1i, ci, n2i).")) k <- length(ai) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) ai <- .getsubset(ai, subset) bi <- .getsubset(bi, subset) ci <- .getsubset(ci, subset) di <- .getsubset(di, subset) } n1i <- ai + bi n2i <- ci + di if (any(c(ai > n1i, ci > n2i), na.rm=TRUE)) stop(mstyle$stop("One or more event counts are larger than the corresponding group sizes.")) if (any(c(ai, bi, ci, di) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more counts are negative.")) if (any(c(n1i < 0, n2i < 0), na.rm=TRUE)) stop(mstyle$stop("One or more group sizes are negative.")) ni.u <- ai + bi + ci + di ### unadjusted total sample sizes ### if drop00=TRUE, set counts to NA for studies that have no events (or all events) in both arms if (drop00) { id00 <- c(ai == 0L & ci == 0L) | c(bi == 0L & di == 0L) id00[is.na(id00)] <- FALSE ai[id00] <- NA_real_ bi[id00] <- NA_real_ ci[id00] <- NA_real_ di[id00] <- NA_real_ } if (to == "all") { ### always add to all cells in all studies ai <- ai + add ci <- ci + add bi <- bi + add di <- di + add } if (to == "only0") { ### add to cells in studies with at least one 0 entry id0 <- c(ai == 0L | ci == 0L | bi == 0L | di == 0L) id0[is.na(id0)] <- FALSE ai[id0] <- ai[id0] + add ci[id0] <- ci[id0] + add bi[id0] <- bi[id0] + add di[id0] <- di[id0] + add } if (to == "if0all") { ### add to cells in all studies if there is at least one 0 entry id0 <- c(ai == 0L | ci == 0L | bi == 0L | di == 0L) id0[is.na(id0)] <- FALSE if (any(id0)) { ai <- ai + add ci <- ci + add bi <- bi + add di <- di + add } } } ######################################################################### if (is.element(measure, c("IRR","IRD","IRSD"))) { x1i <- .getx("x1i", mf=mf, data=data, checknumeric=TRUE) x2i <- .getx("x2i", mf=mf, data=data, checknumeric=TRUE) t1i <- .getx("t1i", mf=mf, data=data, checknumeric=TRUE) t2i <- .getx("t2i", mf=mf, data=data, checknumeric=TRUE) if (!.all.specified(x1i, x2i, t1i, t2i)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., x1i, x2i, t1i, t2i).")) if (!.equal.length(x1i, x2i, t1i, t2i)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k <- length(x1i) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) x1i <- .getsubset(x1i, subset) x2i <- .getsubset(x2i, subset) t1i <- .getsubset(t1i, subset) t2i <- .getsubset(t2i, subset) } if (any(c(x1i, x2i) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more counts are negative.")) if (any(c(t1i, t2i) <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more person-times are <= 0.")) ni.u <- t1i + t2i ### unadjusted total sample sizes ### if drop00=TRUE, set counts to NA for studies that have no events in both arms if (drop00) { id00 <- c(x1i == 0L & x2i == 0L) id00[is.na(id00)] <- FALSE x1i[id00] <- NA_real_ x2i[id00] <- NA_real_ } if (to == "all") { ### always add to all cells in all studies x1i <- x1i + add x2i <- x2i + add } if (to == "only0") { ### add to cells in studies with at least one 0 entry id0 <- c(x1i == 0L | x2i == 0L) id0[is.na(id0)] <- FALSE x1i[id0] <- x1i[id0] + add x2i[id0] <- x2i[id0] + add } if (to == "if0all") { ### add to cells in all studies if there is at least one 0 entry id0 <- c(x1i == 0L | x2i == 0L) id0[is.na(id0)] <- FALSE if (any(id0)) { x1i <- x1i + add x2i <- x2i + add } } } ######################################################################### if (is.element(measure, c("MD","SMD","SMDH","ROM","RPB","RBIS","D2OR","D2ORN","D2ORL"))) { m1i <- .getx("m1i", mf=mf, data=data, checknumeric=TRUE) m2i <- .getx("m2i", mf=mf, data=data, checknumeric=TRUE) sd1i <- .getx("sd1i", mf=mf, data=data, checknumeric=TRUE) sd2i <- .getx("sd2i", mf=mf, data=data, checknumeric=TRUE) n1i <- .getx("n1i", mf=mf, data=data, checknumeric=TRUE) n2i <- .getx("n2i", mf=mf, data=data, checknumeric=TRUE) if (!.all.specified(m1i, m2i, sd1i, sd2i, n1i, n2i)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., m1i, m2i, sd1i, sd2i, n1i, n2i).")) if (!.equal.length(m1i, m2i, sd1i, sd2i, n1i, n2i)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k <- length(n1i) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) m1i <- .getsubset(m1i, subset) m2i <- .getsubset(m2i, subset) sd1i <- .getsubset(sd1i, subset) sd2i <- .getsubset(sd2i, subset) n1i <- .getsubset(n1i, subset) n2i <- .getsubset(n2i, subset) } if (any(c(sd1i, sd2i) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more standard deviations are negative.")) if (any(c(n1i, n2i) <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more group sizes are <= 0.")) ni.u <- n1i + n2i ### unadjusted total sample sizes } ######################################################################### if (is.element(measure, c("COR","UCOR","ZCOR"))) { ri <- .getx("ri", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) ti <- .getx("ti", mf=mf, data=data, checknumeric=TRUE) if (!.equal.length(ri, ni, ti)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) ri <- replmiss(ri, ti / sqrt(ni - 2 + ti^2)) if (!.all.specified(ri, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., ri, ni).")) k <- length(ri) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k=k) ri <- .getsubset(ri, subset) ni <- .getsubset(ni, subset) } if (any(abs(ri) > 1, na.rm=TRUE)) stop(mstyle$stop("One or more correlations are > 1 or < -1.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more sample sizes are <= 0.")) ni.u <- ni ### unadjusted total sample sizes } ######################################################################### if (is.element(measure, c("PR","PLN","PLO","PAS","PFT"))) { xi <- .getx("xi", mf=mf, data=data, checknumeric=TRUE) mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) if (!.equal.length(xi, mi, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) ni.inc <- ni != xi + mi if (any(ni.inc, na.rm=TRUE)) stop(mstyle$stop("One or more 'ni' values are not equal to 'xi + mi'.")) mi <- replmiss(mi, ni-xi) if (!.all.specified(xi, mi)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., xi, mi or xi, ni).")) k <- length(xi) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) xi <- .getsubset(xi, subset) mi <- .getsubset(mi, subset) } ni <- xi + mi if (any(xi > ni, na.rm=TRUE)) stop(mstyle$stop("One or more event counts are larger than the corresponding group sizes.")) if (any(c(xi, mi) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more counts are negative.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more group sizes are <= 0.")) ni.u <- ni ### unadjusted total sample sizes if (to == "all") { ### always add to all cells in all studies xi <- xi + add mi <- mi + add } if (to == "only0") { ### add to cells in studies with at least one 0 entry id0 <- c(xi == 0L | mi == 0L) id0[is.na(id0)] <- FALSE xi[id0] <- xi[id0] + add mi[id0] <- mi[id0] + add } if (to == "if0all") { ### add to cells in all studies if there is at least one 0 entry id0 <- c(xi == 0L | mi == 0L) id0[is.na(id0)] <- FALSE if (any(id0)) { xi <- xi + add mi <- mi + add } } } ######################################################################### if (is.element(measure, c("IR","IRLN","IRS","IRFT"))) { xi <- .getx("xi", mf=mf, data=data, checknumeric=TRUE) ti <- .getx("ti", mf=mf, data=data, checknumeric=TRUE) if (!.all.specified(xi, ti)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., xi, ti).")) if (!.equal.length(xi, ti)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k <- length(xi) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) xi <- .getsubset(xi, subset) ti <- .getsubset(ti, subset) } if (any(xi < 0, na.rm=TRUE)) stop(mstyle$stop("One or more counts are negative.")) if (any(ti <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more person-times are <= 0.")) ni.u <- ti ### unadjusted total sample sizes if (to == "all") { ### always add to all cells in all studies xi <- xi + add } if (to == "only0") { ### add to cells in studies with at least one 0 entry id0 <- c(xi == 0L) id0[is.na(id0)] <- FALSE xi[id0] <- xi[id0] + add } if (to == "if0all") { ### add to cells in all studies if there is at least one 0 entry id0 <- c(xi == 0L) id0[is.na(id0)] <- FALSE if (any(id0)) { xi <- xi + add } } } ######################################################################### if (is.element(measure, c("MN","MNLN","SMN"))) { mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) sdi <- .getx("sdi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) if (!.all.specified(mi, sdi, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., mi, sdi, ni).")) if (!.equal.length(mi, sdi, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k <- length(ni) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) mi <- .getsubset(mi, subset) sdi <- .getsubset(sdi, subset) ni <- .getsubset(ni, subset) } if (any(sdi < 0, na.rm=TRUE)) stop(mstyle$stop("One or more standard deviations are negative.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more sample sizes are <= 0.")) if (is.element(measure, c("MNLN","CVLN")) && any(mi < 0, na.rm=TRUE)) stop(mstyle$stop("One or more means are negative.")) ni.u <- ni ### unadjusted total sample sizes } ######################################################################### if (is.element(measure, c("MC","SMCC","SMCR","SMCRH","ROMC","CVRC"))) { m1i <- .getx("m1i", mf=mf, data=data, checknumeric=TRUE) m2i <- .getx("m2i", mf=mf, data=data, checknumeric=TRUE) sd1i <- .getx("sd1i", mf=mf, data=data, checknumeric=TRUE) sd2i <- .getx("sd2i", mf=mf, data=data, checknumeric=TRUE) ri <- .getx("ri", mf=mf, data=data, checknumeric=TRUE) ### for SMCR, do not need to supply this ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) k <- length(m1i) ### number of outcomes before subsetting if (is.element(measure, c("MC","SMCC","SMCRH","ROMC","CVRC"))) { if (!.all.specified(m1i, m2i, sd1i, sd2i, ni, ri)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., m1i, m2i, sd1i, sd2i, ni, ri).")) if (!.equal.length(m1i, m2i, sd1i, sd2i, ni, ri)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) } else { if (!.all.specified(m1i, m2i, sd1i, ni, ri)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., m1i, m2i, sd1i, ni, ri).")) if (!.equal.length(m1i, m2i, sd1i, ni, ri)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) } if (!is.null(subset)) { subset <- .chksubset(subset, k) m1i <- .getsubset(m1i, subset) m2i <- .getsubset(m2i, subset) sd1i <- .getsubset(sd1i, subset) sd2i <- .getsubset(sd2i, subset) ni <- .getsubset(ni, subset) ri <- .getsubset(ri, subset) } if (is.element(measure, c("MC","SMCC","SMCRH","ROMC","CVRC"))) { if (any(c(sd1i, sd2i) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more standard deviations are negative.")) } else { if (any(sd1i < 0, na.rm=TRUE)) stop(mstyle$stop("One or more standard deviations are negative.")) } if (any(abs(ri) > 1, na.rm=TRUE)) stop(mstyle$stop("One or more correlations are > 1 or < -1.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more sample sizes are <= 0.")) ni.u <- ni ### unadjusted total sample sizes } ######################################################################### if (is.element(measure, c("ARAW","AHW","ABT"))) { ai <- .getx("ai", mf=mf, data=data, checknumeric=TRUE) mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) if (!.all.specified(ai, mi, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., ai, mi, ni).")) if (!.equal.length(ai, mi, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k <- length(ai) ### number of outcomes before subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) ai <- .getsubset(ai, subset) mi <- .getsubset(mi, subset) ni <- .getsubset(ni, subset) } if (any(ai > 1, na.rm=TRUE)) stop(mstyle$stop("One or more alpha values are > 1.")) if (any(mi < 2, na.rm=TRUE)) stop(mstyle$stop("One or more mi values are < 2.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more sample sizes are <= 0.")) ni.u <- ni ### unadjusted total sample sizes } ######################################################################### ######################################################################### ######################################################################### ### generate study labels if none are specified if (is.null(slab)) { slab <- seq_len(k) } else { if (anyNA(slab)) stop(mstyle$stop("NAs in study labels.")) if (length(slab) != k) stop(mstyle$stop("Study labels not of same length as data.")) if (is.factor(slab)) slab <- as.character(slab) } ### if a subset of studies is specified if (!is.null(subset)) { slab <- .getsubset(slab, subset) if (has.data) data <- .getsubset(data, subset) } ### check if study labels are unique; if not, make them unique if (anyDuplicated(slab)) slab <- .make.unique(slab) ######################################################################### ######################################################################### ######################################################################### if (is.element(measure, c("RR","OR","RD","AS","PETO","PHI","YUQ","YUY","RTET","PBIT","OR2D","OR2DN","OR2DL","MPORM"))) { ### check for NAs in table data and act accordingly has.na <- is.na(ai) | is.na(bi) | is.na(ci) | is.na(di) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { ai <- ai[not.na] bi <- bi[not.na] ci <- ci[not.na] di <- di[not.na] slab <- slab[not.na] if (has.data) data <- data[not.na,] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(ai) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### create long format dataset if (vlong) { ### create very long format dataset dat <- data.frame(rep(slab, each=4L), stringsAsFactors=FALSE) dat[[2]] <- rep(c(1,1,2,2), k) dat[[3]] <- rep(c(1,2,1,2), k) dat[[4]] <- c(rbind(ai,bi,ci,di)) if (missing(var.names)) { names(dat) <- c("study", "group", "outcome", "freq") } else { if (length(var.names) != 4L) stop(mstyle$stop("Variable names not of length 4.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) dat[[2]] <- factor(dat[[2]], levels=c(2,1)) dat[[3]] <- factor(dat[[3]], levels=c(2,1)) if (doappend) dat <- cbind(data[rep(seq_len(k), each=4L),appendvars,drop=FALSE], dat) } else { ### create regular long format dataset dat <- data.frame(rep(slab, each=2L), stringsAsFactors=FALSE) dat[[2]] <- rep(c(1,2), k) dat[[3]] <- c(rbind(ai,ci)) dat[[4]] <- c(rbind(bi,di)) if (missing(var.names)) { names(dat) <- c("study", "group", "out1", "out2") } else { if (length(var.names) != 4L) stop(mstyle$stop("Variable names not of length 4.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) dat[[2]] <- factor(dat[[2]], levels=c(2,1)) if (doappend) dat <- cbind(data[rep(seq_len(k), each=2L),appendvars,drop=FALSE], dat) } } ######################################################################### if (is.element(measure, c("MPRD","MPRR","MPOR"))) { ### check for NAs in table data and act accordingly has.na <- is.na(ai) | is.na(bi) | is.na(ci) | is.na(di) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { ai <- ai[not.na] bi <- bi[not.na] ci <- ci[not.na] di <- di[not.na] slab <- slab[not.na] if (has.data) data <- data[not.na,] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(ai) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### create long format dataset if (vlong) { ### create very long format dataset dat <- data.frame(rep(slab, each=4L), stringsAsFactors=FALSE) dat[[2]] <- rep(c(1,1,2,2), k) dat[[3]] <- rep(c(1,2,1,2), k) dat[[4]] <- c(rbind(ai+bi,ci+di,ai+ci,bi+di)) if (missing(var.names)) { names(dat) <- c("study", "time", "outcome", "freq") } else { if (length(var.names) != 4L) stop(mstyle$stop("Variable names not of length 4.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) dat[[2]] <- factor(dat[[2]], levels=c(2,1)) dat[[3]] <- factor(dat[[3]], levels=c(2,1)) if (doappend) dat <- data.frame(data[rep(seq_len(k), each=4L),appendvars,drop=FALSE], dat) } else { ### create regular long format dataset dat <- data.frame(rep(slab, each=2L), stringsAsFactors=FALSE) dat[[2]] <- rep(c(1,2), k) dat[[3]] <- c(rbind(ai+bi,ai+ci)) dat[[4]] <- c(rbind(ci+di,bi+di)) if (missing(var.names)) { names(dat) <- c("study", "time", "out1", "out2") } else { if (length(var.names) != 4L) stop(mstyle$stop("Variable names not of length 4.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) dat[[2]] <- factor(dat[[2]], levels=c(2,1)) if (doappend) dat <- cbind(data[rep(seq_len(k), each=2L),appendvars,drop=FALSE], dat) } } ######################################################################### if (is.element(measure, c("MPORC","MPPETO"))) { ### check for NAs in table data and act accordingly has.na <- is.na(ai) | is.na(bi) | is.na(ci) | is.na(di) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { ai <- ai[not.na] bi <- bi[not.na] ci <- ci[not.na] di <- di[not.na] slab <- slab[not.na] if (has.data) data <- data[not.na,] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(ai) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### create long format dataset if (vlong) { ### create very long format dataset dat <- data.frame(rep(slab, each=4L), stringsAsFactors=FALSE) dat[[2]] <- rep(c(1,1,2,2), k) dat[[3]] <- rep(c(1,2,1,2), k) dat[[4]] <- c(rbind(ai,bi,ci,di)) if (missing(var.names)) { names(dat) <- c("study", "out.time1", "out.time2", "freq") } else { if (length(var.names) != 4L) stop(mstyle$stop("Variable names not of length 4.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) dat[[2]] <- factor(dat[[2]], levels=c(2,1)) dat[[3]] <- factor(dat[[3]], levels=c(2,1)) if (doappend) dat <- cbind(data[rep(seq_len(k), each=4L),appendvars,drop=FALSE], dat) } else { ### create regular long format dataset dat <- data.frame(rep(slab, each=2L), stringsAsFactors=FALSE) dat[[2]] <- rep(c(1,2), k) dat[[3]] <- c(rbind(ai,ci)) dat[[4]] <- c(rbind(bi,di)) if (missing(var.names)) { names(dat) <- c("study", "out.time1", "out1.time2", "out2.time2") } else { if (length(var.names) != 4L) stop(mstyle$stop("Variable names not of length 4.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) dat[[2]] <- factor(dat[[2]], levels=c(2,1)) if (doappend) dat <- cbind(data[rep(seq_len(k), each=2L),appendvars,drop=FALSE], dat) } } ######################################################################### if (is.element(measure, c("IRR","IRD","IRSD"))) { ### check for NAs in table data and act accordingly has.na <- is.na(x1i) | is.na(x2i) | is.na(t1i) | is.na(t2i) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { x1i <- x1i[not.na] x2i <- x2i[not.na] t1i <- t1i[not.na] t2i <- t2i[not.na] slab <- slab[not.na] if (has.data) data <- data[not.na,] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(x1i) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### create long format dataset dat <- data.frame(rep(slab, each=2L), stringsAsFactors=FALSE) dat[[2]] <- rep(c(1,2), k) dat[[3]] <- c(rbind(x1i,x2i)) dat[[4]] <- c(rbind(t1i,t2i)) if (missing(var.names)) { names(dat) <- c("study", "group", "events", "ptime") } else { if (length(var.names) != 4L) stop(mstyle$stop("Variable names not of length 4.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) dat[[2]] <- factor(dat[[2]], levels=c(2,1)) if (doappend) dat <- cbind(data[rep(seq_len(k), each=2L),appendvars,drop=FALSE], dat) } ######################################################################### if (is.element(measure, c("MD","SMD","SMDH","ROM","RPB","RBIS","D2OR","D2ORN","D2ORL"))) { ### check for NAs in table data and act accordingly has.na <- is.na(m1i) | is.na(m2i) | is.na(sd1i) | is.na(sd2i) | is.na(n1i) | is.na(n2i) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { m1i <- m1i[not.na] m2i <- m2i[not.na] sd1i <- sd1i[not.na] sd2i <- sd2i[not.na] n1i <- n1i[not.na] n2i <- n2i[not.na] slab <- slab[not.na] if (has.data) data <- data[not.na,] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(m1i) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### create long format dataset dat <- data.frame(rep(slab, each=2L), stringsAsFactors=FALSE) dat[[2]] <- rep(c(1,2), k) dat[[3]] <- c(rbind(m1i,m2i)) dat[[4]] <- c(rbind(sd1i,sd2i)) dat[[5]] <- c(rbind(n1i,n2i)) if (missing(var.names)) { names(dat) <- c("study", "group", "mean", "sd", "n") } else { if (length(var.names) != 5L) stop(mstyle$stop("Variable names not of length 5.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) dat[[2]] <- factor(dat[[2]], levels=c(2,1)) if (doappend) dat <- cbind(data[rep(seq_len(k), each=2L),appendvars,drop=FALSE], dat) } ######################################################################### if (is.element(measure, c("COR","UCOR","ZCOR"))) { ### check for NAs in table data and act accordingly has.na <- is.na(ri) | is.na(ni) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { ri <- ri[not.na] ni <- ni[not.na] slab <- slab[not.na] if (has.data) data <- data[not.na,] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(ri) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### create long format dataset dat <- data.frame(slab, stringsAsFactors=FALSE) dat[[2]] <- ri dat[[3]] <- ni if (missing(var.names)) { names(dat) <- c("study", "r", "n") } else { if (length(var.names) != 3L) stop(mstyle$stop("Variable names not of length 3.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) if (doappend) dat <- cbind(data[,appendvars,drop=FALSE], dat) } ######################################################################### if (is.element(measure, c("PR","PLN","PLO","PAS","PFT"))) { ### check for NAs in table data and act accordingly has.na <- is.na(xi) | is.na(mi) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { xi <- xi[not.na] mi <- mi[not.na] slab <- slab[not.na] if (has.data) data <- data[not.na,] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(xi) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### create long format dataset if (vlong) { ### create very long format dataset dat <- data.frame(rep(slab, each=2L), stringsAsFactors=FALSE) dat[[2]] <- rep(c(1,2), k) dat[[3]] <- c(rbind(xi,mi)) if (missing(var.names)) { names(dat) <- c("study", "outcome", "freq") } else { if (length(var.names) != 3L) stop(mstyle$stop("Variable names not of length 3.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) dat[[2]] <- factor(dat[[2]], levels=c(2,1)) if (doappend) dat <- cbind(data[rep(seq_len(k), each=2L),appendvars,drop=FALSE], dat) } else { ### create regular long format dataset dat <- data.frame(slab, stringsAsFactors=FALSE) dat[[2]] <- xi dat[[3]] <- mi if (missing(var.names)) { names(dat) <- c("study", "out1", "out2") } else { if (length(var.names) != 3L) stop(mstyle$stop("Variable names not of length 3.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) if (doappend) dat <- cbind(data[,appendvars,drop=FALSE], dat) } } ######################################################################### if (is.element(measure, c("IR","IRLN","IRS","IRFT"))) { ### check for NAs in table data and act accordingly has.na <- is.na(xi) | is.na(ti) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { xi <- xi[not.na] ti <- ti[not.na] slab <- slab[not.na] if (has.data) data <- data[not.na,] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(xi) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### create long format dataset dat <- data.frame(slab, stringsAsFactors=FALSE) dat[[2]] <- xi dat[[3]] <- ti if (missing(var.names)) { names(dat) <- c("study", "events", "ptime") } else { if (length(var.names) != 3L) stop(mstyle$stop("Variable names not of length 3.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) if (doappend) dat <- cbind(data[,appendvars,drop=FALSE], dat) } ######################################################################### if (is.element(measure, c("MN","MNLN","SMN"))) { ### check for NAs in table data and act accordingly has.na <- is.na(mi) | is.na(sdi) | is.na(ni) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { mi <- mi[not.na] sdi <- sdi[not.na] ni <- ni[not.na] slab <- slab[not.na] if (has.data) data <- data[not.na,] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(ni) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### create long format dataset dat <- data.frame(slab, stringsAsFactors=FALSE) dat[[2]] <- mi dat[[3]] <- sdi dat[[4]] <- ni if (missing(var.names)) { names(dat) <- c("study", "mean", "sd", "n") } else { if (length(var.names) != 4L) stop(mstyle$stop("Variable names not of length 4.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) if (doappend) dat <- cbind(data[,appendvars,drop=FALSE], dat) } ######################################################################### if (is.element(measure, c("MC","SMCC","SMCR","SMCRH","ROMC","CVRC"))) { ### check for NAs in table data and act accordingly if (is.element(measure, c("MC","SMCC","SMCRH","ROMC","CVRC"))) { has.na <- is.na(m1i) | is.na(m2i) | is.na(sd1i) | is.na(sd2i) | is.na(ni) | is.na(ri) } else { has.na <- is.na(m1i) | is.na(m2i) | is.na(sd1i) | is.na(ni) | is.na(ri) } if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { m1i <- m1i[not.na] m2i <- m2i[not.na] sd1i <- sd1i[not.na] if (is.element(measure, c("MC","SMCC","SMCRH","ROMC","CVRC"))) sd2i <- sd2i[not.na] ni <- ni[not.na] ri <- ri[not.na] slab <- slab[not.na] if (has.data) data <- data[not.na,] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(m1i) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### create long format dataset if (is.element(measure, c("MC","SMCC","SMCRH","ROMC","CVRC"))) { dat <- data.frame(slab, stringsAsFactors=FALSE) dat[[2]] <- m1i dat[[3]] <- m2i dat[[4]] <- sd1i dat[[5]] <- sd2i dat[[6]] <- ni dat[[7]] <- ri if (missing(var.names)) { names(dat) <- c("study", "mean1", "mean2", "sd1", "sd2", "n", "r") } else { if (length(var.names) != 7L) stop(mstyle$stop("Variable names not of length 7.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) if (doappend) dat <- cbind(data[,appendvars,drop=FALSE], dat) } else { dat <- data.frame(slab, stringsAsFactors=FALSE) dat[[2]] <- m1i dat[[3]] <- m2i dat[[4]] <- sd1i dat[[5]] <- ni dat[[6]] <- ri if (missing(var.names)) { names(dat) <- c("study", "mean1", "mean2", "sd1", "n", "r") } else { if (length(var.names) != 6L) stop(mstyle$stop("Variable names not of length 6.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) if (doappend) dat <- cbind(data[,appendvars,drop=FALSE], dat) } } ######################################################################### if (is.element(measure, c("ARAW","AHW","ABT"))) { ### check for NAs in table data and act accordingly has.na <- is.na(ai) | is.na(mi) | is.na(ni) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit") { ai <- ai[not.na] mi <- mi[not.na] ni <- ni[not.na] slab <- slab[not.na] if (has.data) data <- data[not.na,] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "tables", "table"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } k <- length(ai) ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### create long format dataset dat <- data.frame(slab, stringsAsFactors=FALSE) dat[[2]] <- ai dat[[3]] <- mi dat[[4]] <- ni if (missing(var.names)) { names(dat) <- c("study", "alpha", "m", "n") } else { if (length(var.names) != 4L) stop(mstyle$stop("Variable names not of length 4.")) names(dat) <- var.names } dat[[1]] <- factor(dat[[1]]) if (doappend) dat <- data.frame(data[,appendvars,drop=FALSE], dat) } ######################################################################### rownames(dat) <- seq_len(nrow(dat)) return(dat) } metafor/R/misc.func.hidden.uni.r0000644000176200001440000002034014440115507016204 0ustar liggesusers############################################################################ ### function to calculate: ### solve(t(X) %*% W %*% X) = .invcalc(X=X, W=W, k=k) ### solve(t(X) %*% X) = .invcalc(X=X, W=diag(k), k=k) ### without taking the actual inverse .invcalc <- function(X, W, k) { sWX <- sqrt(W) %*% X res.qrs <- qr.solve(sWX, diag(k)) #res.qrs <- try(qr.solve(sWX, diag(k)), silent=TRUE) #if (inherits(res.qrs, "try-error")) # stop("Cannot compute QR decomposition.") return(tcrossprod(res.qrs)) } ############################################################################ ### function for confint.rma.uni() with Q-profile method and for the PM estimator .QE.func <- function(tau2val, Y, vi, X, k, objective, verbose=FALSE, digits=4) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (any(tau2val + vi < 0)) stop(mstyle$stop("Some marginal variances are negative."), call.=FALSE) W <- diag(1/(vi + tau2val), nrow=k, ncol=k) stXWX <- .invcalc(X=X, W=W, k=k) P <- W - W %*% X %*% stXWX %*% crossprod(X,W) RSS <- crossprod(Y,P) %*% Y if (verbose) cat(mstyle$verbose(paste("tau2 =", fmtx(tau2val, digits[["var"]], addwidth=4), " RSS - objective =", fmtx(RSS - objective, digits[["var"]], flag=" "), "\n"))) return(RSS - objective) } ############################################################################ ### function for confint.rma.uni() with method="GENQ" .GENQ.func <- function(tau2val, P, vi, Q, level, k, p, getlower, verbose=FALSE, digits=4) { mstyle <- .get.mstyle("crayon" %in% .packages()) S <- diag(sqrt(vi + tau2val), nrow=k, ncol=k) lambda <- Re(eigen(S %*% P %*% S, symmetric=TRUE, only.values=TRUE)$values) tmp <- CompQuadForm::farebrother(Q, lambda[seq_len(k-p)]) ### starting with version 1.4.2 of CompQuadForm, the element is called 'Qq' (before it was called 'res') ### this way, things should work regardless of the version of CompQuadForm that is installed if (exists("res", tmp)) tmp$Qq <- tmp$res if (getlower) { res <- tmp$Qq - level } else { res <- (1 - tmp$Qq) - level } if (verbose) cat(mstyle$verbose(paste("tau2 =", fmtx(tau2val, digits[["var"]], addwidth=4), " objective =", fmtx(res, digits[["var"]], flag=" "), "\n"))) return(res) } ############################################################################ ### generate all possible permutations # .genperms <- function(k) { # # v <- seq_len(k) # # sub <- function(k, v) { # if (k==1L) { # matrix(v,1,k) # } else { # X <- NULL # for(i in seq_len(k)) { # X <- rbind(X, cbind(v[i], Recall(k-1, v[-i]))) # } # X # } # } # # return(sub(k, v[seq_len(k)])) # # } ### generate all possible unique permutations .genuperms <- function(x) { z <- NULL sub <- function(x, y) { len.x <- length(x) if (len.x == 0L) { return(y) } else { prev.num <- 0 for (i in seq_len(len.x)) { num <- x[i] if (num > prev.num) { prev.num <- num z <- rbind(z, Recall(x[-i], c(y,num))) } } return(z) } } return(sub(x, y=NULL)) } .permci <- function(val, obj, j, exact, iter, progbar, level, digits, control) { mstyle <- .get.mstyle("crayon" %in% .packages()) ### fit model with shifted outcome args <- list(yi=obj$yi - c(val*obj$X[,j]), vi=obj$vi, weights=obj$weights, mods=obj$X, intercept=FALSE, method=obj$method, weighted=obj$weighted, test=obj$test, tau2=ifelse(obj$tau2.fix, obj$tau2, NA), control=obj$control, skipr2=TRUE) res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=TRUE) if (inherits(res, "try-error")) stop() ### p-value based on permutation test pval <- permutest(res, exact=exact, iter=iter, progbar=FALSE, control=control)$pval[j] ### get difference between p-value and level diff <- pval - level / ifelse(control$alternative == "two.sided", 1, 2) ### show progress if (progbar) cat(mstyle$verbose(paste("pval =", fmtx(pval, digits[["pval"]]), " diff =", fmtx(diff, digits[["pval"]], flag=" "), " val =", fmtx(val, digits[["est"]], flag=" "), "\n"))) ### penalize negative differences, which should force the CI bound to correspond to a p-value of *at least* level diff <- ifelse(diff < 0, diff*10, diff) return(diff) } ############################################################################ .mapfun.alpha <- function(x, lb, ub) { if (is.infinite(lb) || is.infinite(ub)) { x } else { lb + (ub-lb) / (1 + exp(-x)) # map (-inf,inf) to (lb,ub) } } .mapinvfun.alpha <- function(x, lb, ub) { if (is.infinite(lb) || is.infinite(ub)) { x } else { log((x-lb)/(ub-x)) } } ### -1 times the log likelihood (regular or restricted) for location-scale model .ll.rma.ls <- function(par, yi, vi, X, Z, reml, k, pX, alpha.val, beta.val, verbose, digits, REMLf, link, mZ, alpha.min, alpha.max, alpha.transf, tau2.min, tau2.max, optbeta) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (optbeta) { beta <- par[seq_len(pX)] beta <- ifelse(is.na(beta.val), beta, beta.val) alpha <- par[-seq_len(pX)] } else { alpha <- par } if (alpha.transf) alpha <- mapply(.mapfun.alpha, alpha, alpha.min, alpha.max) alpha <- ifelse(is.na(alpha.val), alpha, alpha.val) ### compute predicted tau2 values if (link == "log") { tau2 <- exp(c(Z %*% alpha)) } else { tau2 <- c(Z %*% alpha) } if (any(is.na(tau2)) || any(tau2 < tau2.min) || any(tau2 > tau2.max)) { llval <- -Inf llcomp <- FALSE } else { llcomp <- TRUE if (any(tau2 < 0)) { llval <- -Inf llcomp <- FALSE } else { ### compute weights / weights matrix wi <- 1/(vi + tau2) W <- diag(wi, nrow=k, ncol=k) if (!optbeta) { stXWX <- try(.invcalc(X=X, W=W, k=k), silent=TRUE) if (inherits(stXWX, "try-error")) { llval <- -Inf llcomp <- FALSE } else { beta <- stXWX %*% crossprod(X,W) %*% as.matrix(yi) } } } } if (llcomp) { ### compute residual sum of squares RSS <- sum(wi*c(yi - X %*% beta)^2) ### compute log-likelihood if (!reml) { llval <- -1/2 * (k) * log(2*base::pi) - 1/2 * sum(log(vi + tau2)) - 1/2 * RSS } else { llval <- -1/2 * (k-pX) * log(2*base::pi) + ifelse(REMLf, 1/2 * determinant(crossprod(X), logarithm=TRUE)$modulus, 0) + -1/2 * sum(log(vi + tau2)) - 1/2 * determinant(crossprod(X,W) %*% X, logarithm=TRUE)$modulus - 1/2 * RSS } } if (!is.null(mZ)) alpha <- mZ %*% alpha if (verbose) { cat(mstyle$verbose(paste0("ll = ", fmtx(llval, digits[["fit"]], flag=" "), " "))) if (optbeta) cat(mstyle$verbose(paste0("beta = ", paste(fmtx(beta, digits[["est"]], flag=" "), collapse=" "), " "))) cat(mstyle$verbose(paste0("alpha = ", paste(fmtx(alpha, digits[["est"]], flag=" "), collapse=" ")))) cat("\n") } return(-1 * llval) } .rma.ls.ineqfun.pos <- function(par, yi, vi, X, Z, reml, k, pX, alpha.val, beta.val, verbose, digits, REMLf, link, mZ, alpha.min, alpha.max, alpha.transf, tau2.min, tau2.max, optbeta) { if (optbeta) { alpha <- par[-seq_len(pX)] } else { alpha <- par } if (alpha.transf) alpha <- mapply(.mapfun.alpha, alpha, alpha.min, alpha.max) alpha <- ifelse(is.na(alpha.val), alpha, alpha.val) tau2 <- c(Z %*% alpha) return(tau2) } .rma.ls.ineqfun.neg <- function(par, yi, vi, X, Z, reml, k, pX, alpha.val, beta.val, verbose, digits, REMLf, link, mZ, alpha.min, alpha.max, alpha.transf, tau2.min, tau2.max, optbeta) { if (optbeta) { alpha <- par[-seq_len(pX)] } else { alpha <- par } if (alpha.transf) alpha <- mapply(.mapfun.alpha, alpha, alpha.min, alpha.max) alpha <- ifelse(is.na(alpha.val), alpha, alpha.val) tau2 <- -c(Z %*% alpha) return(tau2) } ############################################################################ metafor/R/contrmat.r0000644000176200001440000001037514436371631014140 0ustar liggesuserscontrmat <- function(data, grp1, grp2, last, shorten=FALSE, minlen=2, check=TRUE, append=TRUE) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (!is.data.frame(data)) data <- data.frame(data) ### get variable names varnames <- names(data) ### number of variables nvars <- length(varnames) ############################################################################ ### checks on 'grp1' argument if (length(grp1) != 1L) stop(mstyle$stop("Argument 'grp1' must of length 1.")) if (!(is.character(grp1) | is.numeric(grp1))) stop(mstyle$stop("Argument 'grp1' must either be a character string or a number.")) if (is.character(grp1)) { grp1.pos <- charmatch(grp1, varnames) if (is.na(grp1.pos) || grp1.pos == 0L) stop(mstyle$stop("Could not find or uniquely identify variable specified via the 'grp1' argument.")) } else { grp1.pos <- round(grp1) if (grp1.pos < 1 | grp1.pos > nvars) stop(mstyle$stop("Specified position of 'grp1' variable does not exist in the data frame.")) } ### get grp1 variable grp1 <- data[[grp1.pos]] ### make sure there are no missing values in grp1 variable if (anyNA(grp1)) stop(mstyle$stop("Variable specified via 'grp1' argument should not contain missing values.")) ############################################################################ ### checks on 'grp2' argument if (length(grp2) != 1L) stop(mstyle$stop("Argument 'grp2' must of length 1.")) if (!(is.character(grp2) | is.numeric(grp2))) stop(mstyle$stop("Argument 'grp2' must either be a character string or a number.")) if (is.character(grp2)) { grp2.pos <- charmatch(grp2, varnames) if (is.na(grp2.pos) || grp2.pos == 0L) stop(mstyle$stop("Could not find or uniquely identify variable specified via the 'grp2' argument.")) } else { grp2.pos <- round(grp2) if (grp2.pos < 1 | grp2.pos > nvars) stop(mstyle$stop("Specified position of 'grp2' variable does not exist in the data frame.")) } ### get grp2 variable grp2 <- data[[grp2.pos]] ### make sure there are no missing values in grp2 variable if (anyNA(grp2)) stop(mstyle$stop("Variable specified via 'grp2' argument should not contain missing values.")) ############################################################################ ### get all levels (of grp1 and grp2) if (is.factor(grp1) && is.factor(grp2) && identical(levels(grp1), levels(grp2))) { lvls <- levels(grp1) } else { lvls <- sort(union(levels(factor(grp1)), levels(factor(grp2)))) } ############################################################################ ### checks on 'last' argument ### if last is not specified, place most common grp2 group last if (missing(last)) last <- names(sort(table(grp2), decreasing=TRUE)[1]) if (length(last) != 1L) stop(mstyle$stop("Argument 'last' must be of length one.")) ### if last is set to NA, leave last unchanged if (is.na(last)) last <- tail(lvls, 1) last.pos <- charmatch(last, lvls) if (is.na(last.pos) || last.pos == 0L) stop(mstyle$stop("Could not find or uniquely identify group specified via the 'last' argument.")) last <- lvls[last.pos] ### reorder levels so that the reference level is always last lvls <- c(lvls[-last.pos], lvls[last.pos]) ############################################################################ ### turn grp1 and grp2 into factors with all levels grp1 <- factor(grp1, levels=lvls) grp2 <- factor(grp2, levels=lvls) ### create contrast matrix X <- model.matrix(~ grp1 - 1, contrasts.arg = list(grp1 = "contr.treatment")) - model.matrix(~ grp2 - 1, contrasts.arg = list(grp2 = "contr.treatment")) attr(X, "assign") <- NULL attr(X, "contrasts") <- NULL ### shorten variables names (if shorten=TRUE) if (shorten) lvls <- .shorten(lvls, minlen=minlen) ### add variable names if (check) { colnames(X) <- make.names(lvls, unique=TRUE) } else { colnames(X) <- lvls } ### append to original data if requested if (append) X <- cbind(data, X) ############################################################################ return(X) } metafor/R/predict.rma.r0000644000176200001440000006566414430657532014535 0ustar liggesuserspredict.rma <- function(object, newmods, intercept, tau2.levels, gamma2.levels, addx=FALSE, level, digits, transf, targs, vcov=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma", notav="rma.ls") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) x <- object if (missing(newmods)) newmods <- NULL if (missing(intercept)) intercept <- x$intercept if (missing(tau2.levels)) tau2.levels <- NULL if (missing(gamma2.levels)) gamma2.levels <- NULL if (missing(level)) level <- x$level if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL level <- .level(level) ddd <- list(...) .chkdots(ddd, c("pi.type", "newvi", "verbose")) if (is.null(ddd$pi.type)) { pi.type <- "default" } else { pi.type <- ddd$pi.type pi.type <- tolower(pi.type) } if (x$int.only && !is.null(newmods)) stop(mstyle$stop("Cannot specify new moderator values for models without moderators.")) ######################################################################### ### TODO: can this be simplified? (every time I sit down and stare at the mess below, it gives me a headache) if (is.null(newmods)) { ### if no new moderator values are specified if (!inherits(object, "rma.mv") || (inherits(object, "rma.mv") && any(is.element(object$struct, c("GEN","GDIAG"))))) { ### for rma.uni, rma.mh, rma.peto, and rma.glmm objects if (x$int.only) { # if intercept-only model predict only the intercept k.new <- 1L # X.new <- cbind(1) # } else { # otherwise predict for all k.f studies (including studies with NAs) k.new <- x$k.f # X.new <- x$X.f # } # } else { ### for rma.mv objects if (x$int.only) { # if intercept-only model: if (!x$withG) { # # if there is no G structure (and hence also no H structure) k.new <- 1L # # then we just need to predict the intercept once X.new <- cbind(1) # } # if (x$withG && x$withH) { # # if there is both a G and H structure if (is.null(tau2.levels) && is.null(gamma2.levels)) { # # and user has not specified tau2s.levels and gamma2.levels k.new <- x$tau2s * x$gamma2s # # then we need to predict intercepts for all combinations of tau2 and gamma2 values X.new <- cbind(rep(1,k.new)) # if (x$tau2s == 1) { # # if there is only a single tau^2 tau2.levels <- rep(1,k.new) # # then tau2.levels should be 1 repeated k.new times } else { # tau2.levels <- rep(levels(x$mf.g.f$inner), each=x$gamma2s) # # otherwise repeat actual levels gamma2s times } # if (x$gamma2s == 1) { # # if there is only a single gamma^2 value gamma2.levels <- rep(1,k.new) # # then gamma2.levels should be 1 repeated k.new times } else { # gamma2.levels <- rep(levels(x$mf.h.f$inner), times=x$tau2s) # # otherwise repeat actual levels tau2s times } # } # if ((!is.null(tau2.levels) && is.null(gamma2.levels)) || # # if user specifies only one of tau2.levels and gamma2.levels, throw an error (is.null(tau2.levels) && !is.null(gamma2.levels))) # stop(mstyle$stop("Either specify both of 'tau2.levels' and 'gamma2.levels' or neither.")) if (!is.null(tau2.levels) && !is.null(gamma2.levels)) { # # if user has specified both tau2s.levels and gamma2.levels if (length(tau2.levels) != length(gamma2.levels)) # stop(mstyle$stop("Length of 'tau2.levels' and 'gamma2.levels' is not the same.")) k.new <- length(tau2.levels) # # then we need to predict intercepts for those level combinations X.new <- cbind(rep(1,k.new)) # } # } # if (x$withG && !x$withH) { # # if there is only a G structure (and no H structure) if (is.null(tau2.levels)) { # # and user has not specified tau2.levels k.new <- x$tau2s # # then we need to predict intercepts for all tau2 values X.new <- cbind(rep(1,k.new)) # if (x$tau2s == 1) { # tau2.levels <- rep(1, k.new) # } else { # tau2.levels <- levels(x$mf.g.f$inner) # } # } else { # # and the user has specified tau2.levels k.new <- length(tau2.levels) # # then we need to predict intercepts for those levels X.new <- cbind(rep(1,k.new)) # } # gamma2.levels <- rep(1, k.new) # } # } else { # if not an intercept-only model k.new <- x$k.f # # then predict for all k.f studies (including studies with NAs) X.new <- x$X.f # if (!is.null(tau2.levels) || !is.null(gamma2.levels)) # warning(mstyle$warning("Arguments 'tau2.levels' and 'gamma2.levels' ignored when obtaining fitted values."), call.=FALSE) tau2.levels <- as.character(x$mf.g.f$inner) # gamma2.levels <- as.character(x$mf.h.f$inner) # } # } } else { ### if new moderator values have been specified if (!(.is.vector(newmods) || inherits(newmods, "matrix"))) stop(mstyle$stop(paste0("Argument 'newmods' should be a vector or matrix, but is of class '", class(newmods)[1], "'."))) if ((!x$int.incl && x$p == 1L) || (x$int.incl && x$p == 2L)) { # if single moderator (multiple k.new possible) (either without or with intercept in the model) k.new <- length(newmods) # X.new <- cbind(c(newmods)) # } else { # in case the model has more than one predictor: if (.is.vector(newmods) || nrow(newmods) == 1L) { # # if user gives one vector or one row matrix (only one k.new): k.new <- 1L # X.new <- rbind(newmods) # } else { # # if user gives multiple rows and columns (multiple k.new): k.new <- nrow(newmods) # X.new <- cbind(newmods) # } # ### allow matching of terms by names (note: only possible if all columns in X.new and x$X have colnames) if (!is.null(colnames(X.new)) && all(colnames(X.new) != "") && !is.null(colnames(x$X)) && all(colnames(x$X) != "")) { colnames.mod <- colnames(x$X) if (x$int.incl) colnames.mod <- colnames.mod[-1] pos <- sapply(colnames(X.new), function(colname) { d <- c(adist(colname, colnames.mod, costs=c(ins=1, sub=Inf, del=Inf))) # compute edit distances with Inf costs for substitutions/deletions if (all(is.infinite(d))) # if there is no match, then all elements are Inf stop(mstyle$stop(paste0("Could not find variable '", colname, "' in the model.")), call. = FALSE) d <- which(d == min(d)) # don't use which.min() since that only finds the first minimum if (length(d) > 1L) # if there is no unique match, then there is more than one minimum stop(mstyle$stop(paste0("Could not match up variable '", colname, "' uniquely to a variable in the model.")), call. = FALSE) return(d) }) if (anyDuplicated(pos)) { # if the same name is used more than once, then there will be duplicated pos values dups <- paste(unique(colnames(X.new)[duplicated(pos)]), collapse=", ") stop(mstyle$stop(paste0("Found multiple matches for the same variable name (", dups, ")."))) } if (length(pos) != length(colnames.mod)) { no.match <- colnames.mod[seq_along(colnames.mod)[-pos]] if (length(no.match) > 3L) stop(mstyle$stop(paste0("Argument 'newmods' does not specify values for these variables: ", paste0(no.match[1:3], collapse=", "), ", ..."))) if (length(no.match) > 1L) stop(mstyle$stop(paste0("Argument 'newmods' does not specify values for these variables: ", paste0(no.match, collapse=", ")))) if (length(no.match) == 1L) stop(mstyle$stop(paste0("Argument 'newmods' does not specify values for this variable: ", no.match))) } X.new <- X.new[,order(pos),drop=FALSE] colnames(X.new) <- colnames.mod } } if (inherits(X.new[1,1], "character")) stop(mstyle$stop("Argument 'newmods' should only contain numeric variables.")) ### if the user has specified newmods and an intercept was included in the original model, add the intercept to X.new ### but user can also decide to remove the intercept from the predictions with intercept=FALSE if (x$int.incl) { if (intercept) { X.new <- cbind(intrcpt=1, X.new) } else { X.new <- cbind(intrcpt=0, X.new) } } if (ncol(X.new) != x$p) stop(mstyle$stop(paste0("Dimensions of 'newmods' (", ncol(X.new), ") do not the match dimensions of the model (", x$p, ")."))) } #return(list(k.new=k.new, tau2=x$tau2, gamma2=x$gamma2, tau2.levels=tau2.levels, gamma2.levels=gamma2.levels)) ######################################################################### ### for rma.mv models with multiple tau^2 values, must use tau2.levels argument when using newmods to obtain prediction interval if (inherits(object, "rma.mv") && x$withG) { if (x$tau2s > 1L) { if (is.null(tau2.levels)) { #warning(mstyle$warning("Must specify 'tau2.levels' argument to obtain prediction interval."), call.=FALSE) } else { ### if tau2.levels argument is a character vector, check that specified tau^2 values actually exist if (!is.numeric(tau2.levels) && anyNA(pmatch(tau2.levels, x$g.levels.f[[1]], duplicates.ok=TRUE))) stop(mstyle$stop("Non-existing levels specified via 'tau2.levels' argument.")) ### if tau2.levels argument is numeric, check that specified tau^2 values actually exist if (is.numeric(tau2.levels)) { tau2.levels <- round(tau2.levels) if (any(tau2.levels < 1) || any(tau2.levels > x$g.nlevels.f[1])) stop(mstyle$stop("Non-existing tau^2 values specified via 'tau2.levels' argument.")) } ### allow quick setting of all levels if (length(tau2.levels) == 1L) tau2.levels <- rep(tau2.levels, k.new) ### check length of tau2.levels argument if (length(tau2.levels) != k.new) stop(mstyle$stop(paste0("Length of 'tau2.levels' argument (", length(tau2.levels), ") does not match the number of predicted values (", k.new, ")."))) } } else { tau2.levels <- rep(1, k.new) } } ### for rma.mv models with multiple gamma^2 values, must use gamma.levels argument when using newmods to obtain prediction intervals if (inherits(object, "rma.mv") && x$withH) { if (x$gamma2s > 1L) { if (is.null(gamma2.levels)) { #warning(mstyle$warning("Must specify 'gamma2.levels' argument to obtain prediction interval."), call.=FALSE) } else { ### if gamma2.levels argument is a character vector, check that specified gamma^2 values actually exist if (!is.numeric(gamma2.levels) && anyNA(pmatch(gamma2.levels, x$h.levels.f[[1]], duplicates.ok=TRUE))) stop(mstyle$stop("Non-existing levels specified via 'gamma2.levels' argument.")) ### if gamma2.levels argument is numeric, check that specified gamma^2 values actually exist if (is.numeric(gamma2.levels)) { gamma2.levels <- round(gamma2.levels) if (any(gamma2.levels < 1) || any(gamma2.levels > x$h.nlevels.f[1])) stop(mstyle$stop("Non-existing gamma^2 values specified via 'gamma2.levels' argument.")) } ### allow quick setting of all levels if (length(gamma2.levels) == 1L) gamma2.levels <- rep(gamma2.levels, k.new) ### check length of gamma2.levels argument if (length(gamma2.levels) != k.new) stop(mstyle$stop(paste0("Length of 'gamma2.levels' argument (", length(gamma2.levels), ") does not match the number of predicted values (", k.new, ")."))) } } else { gamma2.levels <- rep(1, k.new) } } ######################################################################### if (inherits(x, "robust.rma") && x$robumethod == "clubSandwich") { if (x$coef_test == "saddlepoint") stop(mstyle$stop("Cannot use method when saddlepoint correction was used.")) cs.lc <- try(clubSandwich::linear_contrast(x, cluster=x$cluster, vcov=x$vb, test=x$coef_test, contrasts=X.new, p_values=FALSE), silent=!isTRUE(ddd$verbose)) if (inherits(cs.lc, "try-error")) stop(mstyle$stop("Could not obtain the linear contrast(s) (use verbose=TRUE for more details).")) ddf <- cs.lc$df crit <- sapply(seq_along(ddf), function(j) if (ddf[j] > 0) qt(level/2, df=ddf[j], lower.tail=FALSE) else NA_real_) pred <- cs.lc$Est se <- cs.lc$SE vpred <- se^2 #ci.lb <- pred - crit * se #ci.ub <- pred + crit * se ci.lb <- cs.lc$CI_L ci.ub <- cs.lc$CI_U x$test <- switch(x$coef_test, "z"="z", "naive-t"="t", "naive-tp"="t", "Satterthwaite"="t") } else { ### ddf calculation for x$test %in% c("knha","adhoc","t") but also need this ### for pi.ddf calculation when test="z" and pi.type %in% c("riley","t") if (length(x$ddf) == 1L) { ddf <- rep(x$ddf, k.new) # when test="z", x$ddf is NA, so this then results in a vector of NAs } else { ddf <- rep(NA_integer_, k.new) for (j in seq_len(k.new)) { bn0 <- X.new[j,] != 0 # determine which coefficients are involved in the linear contrast ddf[j] <- min(x$ddf[bn0]) # take the smallest ddf value for those coefficients } } ddf[is.na(ddf)] <- x$k - x$p # when test="z", turn all NAs into the usual k-p dfs ### predicted values, SEs, and confidence intervals pred <- rep(NA_real_, k.new) vpred <- rep(NA_real_, k.new) for (i in seq_len(k.new)) { Xi.new <- X.new[i,,drop=FALSE] pred[i] <- Xi.new %*% x$beta vpred[i] <- Xi.new %*% tcrossprod(x$vb, Xi.new) } if (is.element(x$test, c("knha","adhoc","t"))) { crit <- sapply(seq_along(ddf), function(j) if (ddf[j] > 0) qt(level/2, df=ddf[j], lower.tail=FALSE) else NA_real_) } else { crit <- qnorm(level/2, lower.tail=FALSE) } vpred[vpred < 0] <- NA_real_ se <- sqrt(vpred) ci.lb <- pred - crit * se ci.ub <- pred + crit * se } ######################################################################### if (vcov) vcovpred <- X.new %*% x$vb %*% t(X.new) if (pi.type == "simple") { crit <- qnorm(level/2, lower.tail=FALSE) vpred <- 0 } pi.ddf <- ddf if (is.element(pi.type, c("riley","t"))) { if (pi.type == "riley") pi.ddf <- ddf - x$parms + x$p if (pi.type == "t") pi.ddf <- ddf pi.ddf[pi.ddf < 1] <- 1 crit <- sapply(seq_along(pi.ddf), function(j) if (pi.ddf[j] > 0) qt(level/2, df=pi.ddf[j], lower.tail=FALSE) else NA_real_) } if (is.null(ddd$newvi)) { newvi <- 0 } else { newvi <- ddd$newvi if (length(newvi) == 1L) newvi <- rep(newvi, k.new) if (length(newvi) != k.new) stop(mstyle$stop(paste0("Length of 'newvi' argument (", length(newvi), ") does not match the number of predicted values (", k.new, ")."))) } ######################################################################### ### prediction intervals if (!inherits(object, "rma.mv")) { ### for rma.uni, rma.mh, rma.peto, and rma.glmm objects (in rma.mh and rma.peto, tau2 = 0 by default and stored as such) pi.lb <- pred - crit * sqrt(vpred + x$tau2 + newvi) pi.ub <- pred + crit * sqrt(vpred + x$tau2 + newvi) } else { ### for rma.mv objects if (!x$withG) { ### if there is no G structure (and hence no H structure), there are no tau2 and gamma2 values, so just add the sum of all of the sigma2 values pi.lb <- pred - crit * sqrt(vpred + sum(x$sigma2) + newvi) pi.ub <- pred + crit * sqrt(vpred + sum(x$sigma2) + newvi) } if (x$withG && !x$withH) { ### if there is a G structure but no H structure if (x$tau2s == 1L) { ### if there is only a single tau^2 value, always add that (in addition to the sum of all of the sigma^2 values) pi.lb <- pred - crit * sqrt(vpred + sum(x$sigma2) + x$tau2 + newvi) pi.ub <- pred + crit * sqrt(vpred + sum(x$sigma2) + x$tau2 + newvi) } else { if (is.null(tau2.levels)) { ### if user has not specified tau2.levels, cannot compute bounds pi.lb <- rep(NA_real_, k.new) pi.ub <- rep(NA_real_, k.new) tau2.levels <- rep(NA, k.new) } else { ### if there are multiple tau^2 values, either let user define numerically which value(s) to use or ### match the position of the specified tau2.levels to the levels of the inner factor in the model if (!is.numeric(tau2.levels)) tau2.levels <- pmatch(tau2.levels, x$g.levels.f[[1]], duplicates.ok=TRUE) pi.lb <- pred - crit * sqrt(vpred + sum(x$sigma2) + x$tau2[tau2.levels] + newvi) pi.ub <- pred + crit * sqrt(vpred + sum(x$sigma2) + x$tau2[tau2.levels] + newvi) tau2.levels <- x$g.levels.f[[1]][tau2.levels] } } } if (x$withG && x$withH) { ### if there is a G structure and an H structure if (x$tau2s == 1L && x$gamma2s == 1L) { ### if there is only a single tau^2 and gamma^2 value, always add that (in addition to the sum of all of the sigma^2 values) pi.lb <- pred - crit * sqrt(vpred + sum(x$sigma2) + x$tau2 + x$gamma2 + newvi) pi.ub <- pred + crit * sqrt(vpred + sum(x$sigma2) + x$tau2 + x$gamma2 + newvi) } else { if (is.null(tau2.levels) || is.null(gamma2.levels)) { ### if user has not specified tau2.levels and gamma2.levels, cannot compute bounds pi.lb <- rep(NA_real_, k.new) pi.ub <- rep(NA_real_, k.new) tau2.levels <- rep(NA, k.new) gamma2.levels <- rep(NA, k.new) } else { ### if there are multiple tau^2 and/or gamma^2 values, either let user define numerically which value(s) to use or ### match the position of the specified tau2.levels and gamma2.levels to the levels of the inner factors in the model if (!is.numeric(tau2.levels)) tau2.levels <- pmatch(tau2.levels, x$g.levels.f[[1]], duplicates.ok=TRUE) if (!is.numeric(gamma2.levels)) gamma2.levels <- pmatch(gamma2.levels, x$h.levels.f[[1]], duplicates.ok=TRUE) pi.lb <- pred - crit * sqrt(vpred + sum(x$sigma2) + x$tau2[tau2.levels] + x$gamma2[gamma2.levels] + newvi) pi.ub <- pred + crit * sqrt(vpred + sum(x$sigma2) + x$tau2[tau2.levels] + x$gamma2[gamma2.levels] + newvi) tau2.levels <- x$g.levels.f[[1]][tau2.levels] gamma2.levels <- x$h.levels.f[[1]][gamma2.levels] } } } } ######################################################################### ### apply transformation function if one has been specified if (is.function(transf)) { #if (is.null(targs) && grepl("transf\\.[a-z]*\\.int$", deparse(substitute(transf))) && inherits(x, c("rma.uni","rma.glmm")) && length(x$tau2 == 1L)) # targs <- c(tau2=x$tau2) if (is.null(targs)) { pred <- sapply(pred, transf) se <- rep(NA_real_, k.new) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) pi.lb <- sapply(pi.lb, transf) pi.ub <- sapply(pi.ub, transf) } else { pred <- sapply(pred, transf, targs) se <- rep(NA_real_, k.new) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) pi.lb <- sapply(pi.lb, transf, targs) pi.ub <- sapply(pi.ub, transf, targs) } do.transf <- TRUE } else { do.transf <- FALSE } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] tmp <- .psort(pi.lb, pi.ub) pi.lb <- tmp[,1] pi.ub <- tmp[,2] ### use study labels from the object when the model has moderators and no new moderators have been specified ### otherwise, just use consecutive numbers to label the predicted values if (is.null(newmods) && !x$int.only) { slab <- x$slab } else { slab <- seq_len(k.new) } ### add row/colnames to vcovpred if (vcov) rownames(vcovpred) <- colnames(vcovpred) <- slab ### but when predicting just a single value, use "" as study label if (k.new == 1L) slab <- "" ### handle NAs not.na <- rep(TRUE, k.new) if (na.act == "na.omit") { if (is.null(newmods) && !x$int.only) { not.na <- x$not.na } else { not.na <- !is.na(pred) } } #if (na.act == "na.omit") { # not.na <- !is.na(pred) #} else { # not.na <- rep(TRUE, k.new) #} if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) out <- list(pred=pred[not.na], se=se[not.na], ci.lb=ci.lb[not.na], ci.ub=ci.ub[not.na], pi.lb=pi.lb[not.na], pi.ub=pi.ub[not.na], cr.lb=pi.lb[not.na], cr.ub=pi.ub[not.na]) if (vcov) vcovpred <- vcovpred[not.na,not.na,drop=FALSE] if (na.act == "na.exclude" && is.null(newmods) && !x$int.only) { out <- lapply(out, function(val) ifelse(x$not.na, val, NA_real_)) if (vcov) { vcovpred[!x$not.na,] <- NA_real_ vcovpred[,!x$not.na] <- NA_real_ } } ### add tau2.levels values to list if (inherits(object, "rma.mv") && x$withG && x$tau2s > 1L) out$tau2.level <- tau2.levels ### add gamma2.levels values to list if (inherits(object, "rma.mv") && x$withH && x$gamma2s > 1L) out$gamma2.level <- gamma2.levels ### remove cr part for models with a GEN structure if (inherits(object, "rma.mv") && any(is.element(object$struct, c("GEN","GDIAG")))) { out$cr.lb <- NULL out$cr.ub <- NULL out$pi.lb <- NULL out$pi.ub <- NULL out$tau2.level <- NULL out$gamma2.level <- NULL } ### add X matrix to list if (addx) { out$X <- matrix(X.new[not.na,], ncol=x$p) colnames(out$X) <- colnames(x$X) } ### add slab values to list out$slab <- slab[not.na] ### for FE/EE/CE models, remove the columns corresponding to the prediction interval bounds if (is.element(x$method, c("FE","EE","CE"))) { out$cr.lb <- NULL out$cr.ub <- NULL out$pi.lb <- NULL out$pi.ub <- NULL } out$digits <- digits out$method <- x$method out$transf <- do.transf out$pred.type <- "location" if (x$test != "z") out$ddf <- ddf if ((x$test != "z" || is.element(pi.type, c("riley","t"))) && pi.type != "simple") out$pi.ddf <- pi.ddf class(out) <- c("predict.rma", "list.rma") if (vcov & !do.transf) { out <- list(pred=out) out$vcov <- vcovpred } return(out) } metafor/R/print.rma.peto.r0000644000176200001440000000405514305366065015167 0ustar liggesusersprint.rma.peto <- function(x, digits, showfit=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.peto") if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } .space() cat(mstyle$section("Equal-Effects Model")) cat(mstyle$section(paste0(" (k = ", x$k, ")"))) cat("\n") if (showfit) { fs <- fmtx(x$fit.stats$ML, digits[["fit"]]) names(fs) <- c("logLik", "deviance", "AIC", "BIC", "AICc") cat("\n") tmp <- capture.output(print(fs, quote=FALSE, print.gap=2)) #tmp[1] <- paste0(tmp[1], "\u200b") .print.table(tmp, mstyle) } cat("\n") if (!is.na(x$I2)) { cat(mstyle$text("I^2 (total heterogeneity / total variability): ")) cat(mstyle$result(paste0(fmtx(x$I2, 2), "%"))) cat("\n") } if (!is.na(x$H2)) { cat(mstyle$text("H^2 (total variability / sampling variability): ")) cat(mstyle$result(fmtx(x$H2, 2))) cat("\n") } if (!is.na(x$QE)) { cat("\n") cat(mstyle$section("Test for Heterogeneity:"), "\n") cat(mstyle$result(fmtt(x$QE, "Q", df=x$k.pos-1, pval=x$QEp, digits=digits))) } if (any(!is.na(c(x$I2, x$H2, x$QE)))) cat("\n\n") res.table <- c(estimate=fmtx(unname(x$beta), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), zval=fmtx(x$zval, digits[["test"]]), pval=fmtp(x$pval, digits[["pval"]]), ci.lb=fmtx(x$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$ci.ub, digits[["ci"]])) res.table.exp <- c(estimate=fmtx(exp(unname(x$beta)), digits[["est"]]), ci.lb=fmtx(exp(x$ci.lb), digits[["ci"]]), ci.ub=fmtx(exp(x$ci.ub), digits[["ci"]])) cat(mstyle$section("Model Results (log scale):")) cat("\n\n") tmp <- capture.output(.print.vector(res.table)) .print.table(tmp, mstyle) cat("\n") cat(mstyle$section("Model Results (OR scale):")) cat("\n\n") tmp <- capture.output(.print.vector(res.table.exp)) .print.table(tmp, mstyle) .space() invisible() } metafor/R/regplot.r0000644000176200001440000000006414032075631013750 0ustar liggesusersregplot <- function(x, ...) UseMethod("regplot") metafor/R/simulate.rma.r0000644000176200001440000000403714274224457014713 0ustar liggesuserssimulate.rma <- function(object, nsim=1, seed=NULL, olim, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma", notav=c("rma.gen", "rma.glmm", "rma.mh", "rma.peto", "rma.uni.selmodel")) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) ### as in stats:::simulate.lm if (!exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE)) runif(1) if (is.null(seed)) { RNGstate <- get(".Random.seed", envir = .GlobalEnv) } else { R.seed <- get(".Random.seed", envir = .GlobalEnv) set.seed(seed) RNGstate <- structure(seed, kind = as.list(RNGkind())) on.exit(assign(".Random.seed", R.seed, envir = .GlobalEnv), add=TRUE) } nsim <- round(nsim) if (nsim <= 0) stop(mstyle$stop("Argument 'nsim' must be >= 1.")) ######################################################################### ### fitted values ftd <- c(object$X %*% object$beta) ### simulate for rma.uni (and rma.ls) objects if (inherits(object, "rma.uni")) val <- replicate(nsim, rnorm(object$k, mean=ftd, sd=sqrt(object$vi + object$tau2))) ### simulate for rma.mv objects if (inherits(object, "rma.mv")) val <- t(.mvrnorm(nsim, mu=ftd, Sigma=object$M)) ### apply observation/outcome limits if specified if (!missing(olim)) { if (length(olim) != 2L) stop(mstyle$stop("Argument 'olim' must be of length 2.")) olim <- sort(olim) val[val < olim[1]] <- olim[1] val[val > olim[2]] <- olim[2] } ######################################################################### res <- matrix(NA_real_, nrow=object$k.f, ncol=nsim) res[object$not.na,] <- val res <- as.data.frame(res) rownames(res) <- object$slab colnames(res) <- paste0("sim_", seq_len(nsim)) if (na.act == "na.omit") res <- res[object$not.na,,drop=FALSE] attr(res, "seed") <- RNGstate return(res) } metafor/R/tes.r0000644000176200001440000003422014421561374013076 0ustar liggesuserstes <- function(x, vi, sei, subset, data, H0=0, alternative="two.sided", alpha=.05, theta, tau2, test, tes.alternative="greater", progbar=TRUE, tes.alpha=.10, digits, ...) { # allow multiple alpha values? plot for pval as a function of alpha? ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) alternative <- match.arg(alternative, c("two.sided", "greater", "less")) tes.alternative <- match.arg(tes.alternative, c("two.sided", "greater", "less")) ######################################################################### ### check if data argument has been specified if (missing(data)) data <- NULL if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } mf <- match.call() x <- .getx("x", mf=mf, data=data) ######################################################################### if (inherits(x, "rma")) { on.exit(options(na.action=na.act), add=TRUE) .chkclass(class(x), must="rma", notav=c("rma.glmm", "rma.mv", "robust.rma", "rma.ls", "rma.gen", "rma.uni.selmodel")) ### set defaults for digits if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(test)) test <- NULL if (x$int.only) { theta <- c(x$beta) } else { options(na.action="na.omit") theta <- fitted(x) options(na.action = na.act) } tes(c(x$yi), vi=x$vi, H0=H0, alternative=alternative, alpha=alpha, theta=theta, tau2=x$tau2, test=test, tes.alternative=tes.alternative, progbar=progbar, tes.alpha=tes.alpha, digits=digits, ...) } else { ######################################################################### if (!.is.vector(x)) stop(mstyle$stop("Argument 'x' must be a vector or an 'rma' model object.")) yi <- x ### check if yi is numeric if (!is.numeric(yi)) stop(mstyle$stop("The object/variable specified for the 'x' argument is not numeric.")) ### set defaults for digits if (missing(digits)) { digits <- .set.digits(dmiss=TRUE) } else { digits <- .set.digits(digits, dmiss=FALSE) } vi <- .getx("vi", mf=mf, data=data, checknumeric=TRUE) sei <- .getx("sei", mf=mf, data=data, checknumeric=TRUE) subset <- .getx("subset", mf=mf, data=data) if (is.null(vi)) { if (!is.null(sei)) vi <- sei^2 } if (is.null(vi)) stop(mstyle$stop("Must specify 'vi' or 'sei' argument.")) ### check length of yi and vi if (length(yi) != length(vi)) stop(mstyle$stop("Length of 'yi' and 'vi' (or 'sei') is not the same.")) ### check 'vi' argument for potential misuse .chkviarg(mf$vi) ######################################################################### if (length(alpha) != 1L) stop(mstyle$stop("Argument 'alpha' must specify a single value.")) if (length(tes.alpha) != 1L) stop(mstyle$stop("Argument 'tes.alpha' must specify a single value.")) if (alpha <= 0 || alpha >= 1) stop(mstyle$stop("Value of 'alpha' needs to be > 0 and < 1.")) if (tes.alpha <= 0 || tes.alpha >= 1) stop(mstyle$stop("Value of 'tes.alpha' needs to be > 0 and < 1.")) if (alternative == "two.sided") crit <- qnorm(alpha/2, lower.tail=FALSE) if (alternative == "greater") crit <- qnorm(alpha, lower.tail=FALSE) if (alternative == "less") crit <- qnorm(alpha, lower.tail=TRUE) ddd <- list(...) .chkdots(ddd, c("correct", "rel.tol", "subdivisions", "tau2.lb", "find.lim")) if (!is.null(ddd$correct)) { correct <- ddd$correct } else { correct <- FALSE } if (!is.null(ddd$rel.tol)) { rel.tol <- ddd$rel.tol } else { rel.tol <- .Machine$double.eps^0.25 } if (!is.null(ddd$subdivisions)) { subdivisions <- ddd$subdivisions } else { subdivisions <- 100L } if (!is.null(ddd$tau2.lb)) { tau2.lb <- ddd$tau2.lb } else { #tau2.lb <- 0.0001 tau2.lb <- 0 } if (!is.null(ddd$find.lim)) { find.lim <- ddd$find.lim } else { find.lim <- TRUE } ######################################################################### k.f <- length(yi) ### checks on H0 if (length(H0) != 1L) stop(mstyle$stop("Argument 'H0' must specify a single value.")) ### checks on theta if (missing(theta) || is.null(theta)) { single.theta <- TRUE est.theta <- TRUE theta <- rep(0, k.f) } else { if (length(theta) == 1L) { single.theta <- TRUE est.theta <- FALSE theta.1 <- theta theta <- rep(theta, k.f) } else { single.theta <- FALSE est.theta <- FALSE } if (length(theta) != k.f) stop(mstyle$stop("Length of 'theta' and 'yi' is not the same.")) } ######################################################################### ### if a subset of studies is specified if (!is.null(subset)) { subset <- .chksubset(subset, k.f) yi <- .getsubset(yi, subset) vi <- .getsubset(vi, subset) theta <- .getsubset(theta, subset) } ### check for NAs and act accordingly has.na <- is.na(yi) | is.na(vi) | is.na(theta) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { yi <- yi[not.na] vi <- vi[not.na] theta <- theta[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "studies", "study"), "with NAs omitted from test.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in data.")) } ######################################################################### k <- length(yi) if (k == 0L) stop(mstyle$stop("Stopped because k = 0.")) sei <- sqrt(vi) zi <- (yi - H0) / sei if (missing(tau2) || is.null(tau2) || tau2 <= tau2.lb) { wi <- 1 / vi } else { wi <- 1 / (vi + tau2) } if (est.theta) { theta.1 <- .wmean(yi, wi) theta <- rep(theta.1, k) } if (missing(tau2) || is.null(tau2) || tau2 <= tau2.lb) { if (alternative == "two.sided") pow <- pnorm(crit, mean=(theta-H0)/sei, sd=1, lower.tail=FALSE) + pnorm(-crit, mean=(theta-H0)/sei, sd=1, lower.tail=TRUE) if (alternative == "greater") pow <- pnorm(crit, mean=(theta-H0)/sei, sd=1, lower.tail=FALSE) if (alternative == "less") pow <- pnorm(crit, mean=(theta-H0)/sei, sd=1, lower.tail=TRUE) } else { tau <- sqrt(tau2) pow <- rep(NA_real_, k) for (i in seq_len(k)) { res <- try(integrate(.tes.intfun, lower=theta[i]-5*tau, upper=theta[i]+5*tau, theta=theta[i], tau=tau, sei=sei[i], H0=H0, alternative=alternative, crit=crit, rel.tol=rel.tol, subdivisions=subdivisions, stop.on.error=FALSE), silent=TRUE) if (inherits(res, "try-error")) { stop(mstyle$stop(paste0("Could not integrate over density in study ", i, "."))) } else { pow[i] <- res$value } } } if (alternative == "two.sided") sig <- abs(zi) >= crit if (alternative == "greater") sig <- zi >= crit if (alternative == "less") sig <- zi <= crit E <- sum(pow) O <- sum(sig) if (tes.alternative == "two.sided") js <- 0:k if (tes.alternative == "greater") js <- O:k if (tes.alternative == "less") js <- 0:O if (missing(test) || is.null(test)) { tot <- sum(sapply(js, function(j) choose(k,j))) if (tot <= 10^6) { test <- "exact" } else { test <- "chi2" } } else { test <- match.arg(test, c("chi2", "binom", "exact")) } ### set defaults for progbar if (missing(progbar)) progbar <- ifelse(test == "exact", TRUE, FALSE) if (test == "chi2") { res <- suppressWarnings(prop.test(O, k, p=E/k, alternative=tes.alternative, correct=correct)) X2 <- unname(res$statistic) pval <- res$p.value } if (test == "binom") { res <- binom.test(O, k, p=E/k, alternative=tes.alternative) X2 <- NA_real_ pval <- binom.test(O, k, p=E/k, alternative=tes.alternative)$p.value } if (test == "exact") { X2 <- NA_real_ if (progbar) pbar <- pbapply::startpb(min=0, max=length(js)) prj <- rep(NA_real_, length(js)) id <- seq_len(k) for (j in seq_along(js)) { if (progbar) pbapply::setpb(pbar, j) if (js[j] == 0L) { prj[j] <- prod(1-pow) } else if (js[j] == k) { prj[j] <- prod(pow) } else { tmp <- try(suppressWarnings(sum(combn(k, js[j], FUN = function(i) { sel <- i not <- id[-i] prod(pow[sel])*prod(1-pow[not]) }))), silent=TRUE) if (inherits(tmp, "try-error")) { if (progbar) pbapply::closepb(pbar) stop(mstyle$stop(paste0("Number of combinations too large to do an exact test (use test=\"chi2\" or test=\"binomial\" instead)."))) } else { prj[j] <- tmp } } } if (progbar) pbapply::closepb(pbar) if (tes.alternative == "two.sided") pval <- sum(prj[prj <= prj[O+1] + .Machine$double.eps^0.5]) if (tes.alternative == "greater") pval <- sum(prj) if (tes.alternative == "less") pval <- sum(prj) pval[pval > 1] <- 1 } theta.lim <- NULL if (find.lim && single.theta) { if (tes.alternative == "greater") { diff.H0 <- .tes.lim(H0, yi=yi, vi=vi, H0=H0, alternative=alternative, alpha=alpha, tau2=tau2, test=test, tes.alternative=tes.alternative, progbar=FALSE, tes.alpha=tes.alpha, correct=correct, rel.tol=rel.tol, subdivisions=subdivisions, tau2.lb=tau2.lb) if (diff.H0 >= 0) { theta.lim <- NA_real_ } else { if (theta.1 >= H0) { theta.lim <- try(uniroot(.tes.lim, interval=c(H0,theta.1), extendInt="upX", yi=yi, vi=vi, H0=H0, alternative=alternative, alpha=alpha, tau2=tau2, test=test, tes.alternative=tes.alternative, progbar=FALSE, tes.alpha=tes.alpha, correct=correct, rel.tol=rel.tol, subdivisions=subdivisions, tau2.lb=tau2.lb)$root, silent=TRUE) } else { theta.lim <- try(uniroot(.tes.lim, interval=c(theta.1,H0), extendInt="downX", yi=yi, vi=vi, H0=H0, alternative=alternative, alpha=alpha, tau2=tau2, test=test, tes.alternative=tes.alternative, progbar=FALSE, tes.alpha=tes.alpha, correct=correct, rel.tol=rel.tol, subdivisions=subdivisions, tau2.lb=tau2.lb)$root, silent=TRUE) } if (inherits(theta.lim, "try-error")) theta.lim <- NA_real_ } } if (tes.alternative == "less") { diff.H0 <- .tes.lim(H0, yi=yi, vi=vi, H0=H0, alternative=alternative, alpha=alpha, tau2=tau2, test=test, tes.alternative=tes.alternative, progbar=FALSE, tes.alpha=tes.alpha, correct=correct, rel.tol=rel.tol, subdivisions=subdivisions, tau2.lb=tau2.lb) if (diff.H0 <= 0) { theta.lim <- NA_real_ } else { if (theta.1 >= H0) { theta.lim <- try(uniroot(.tes.lim, interval=c(H0,theta.1), extendInt="downX", yi=yi, vi=vi, H0=H0, alternative=alternative, alpha=alpha, tau2=tau2, test=test, tes.alternative=tes.alternative, progbar=FALSE, tes.alpha=tes.alpha, correct=correct, rel.tol=rel.tol, subdivisions=subdivisions, tau2.lb=tau2.lb)$root, silent=TRUE) } else { theta.lim <- try(uniroot(.tes.lim, interval=c(theta.1,H0), extendInt="upX", yi=yi, vi=vi, H0=H0, alternative=alternative, alpha=alpha, tau2=tau2, test=test, tes.alternative=tes.alternative, progbar=FALSE, tes.alpha=tes.alpha, correct=correct, rel.tol=rel.tol, subdivisions=subdivisions, tau2.lb=tau2.lb)$root, silent=TRUE) } if (inherits(theta.lim, "try-error")) theta.lim <- NA_real_ } } if (tes.alternative == "two.sided") { theta.lim.lb <- tes(x=yi, vi=vi, H0=H0, alternative=alternative, alpha=alpha, theta=theta.1, tau2=tau2, test=test, tes.alternative="greater", progbar=FALSE, tes.alpha=tes.alpha/2, correct=correct, rel.tol=rel.tol, subdivisions=subdivisions, tau2.lb=tau2.lb, find.lim=TRUE)$theta.lim theta.lim.ub <- tes(x=yi, vi=vi, H0=H0, alternative=alternative, alpha=alpha, theta=theta.1, tau2=tau2, test=test, tes.alternative="less", progbar=FALSE, tes.alpha=tes.alpha/2, correct=correct, rel.tol=rel.tol, subdivisions=subdivisions, tau2.lb=tau2.lb, find.lim=TRUE)$theta.lim theta.lim <- c(theta.lim.lb, theta.lim.ub) } } if (single.theta) theta <- theta.1 res <- list(k=k, O=O, E=E, OEratio=O/E, test=test, X2=X2, pval=pval, power=pow, sig=sig, theta=theta, theta.lim=theta.lim, tes.alternative=tes.alternative, tes.alpha=tes.alpha, digits=digits) class(res) <- "tes" return(res) } } metafor/R/funnel.rma.r0000644000176200001440000005600014473373415014354 0ustar liggesusersfunnel.rma <- function(x, yaxis="sei", xlim, ylim, xlab, ylab, slab, steps=5, at, atransf, targs, digits, level=x$level, addtau2=FALSE, type="rstandard", back, shade, hlines, refline, lty=3, pch, pch.fill, col, bg, label=FALSE, offset=0.4, legend=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma") na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) yaxis <- match.arg(yaxis, c("sei", "vi", "seinv", "vinv", "ni", "ninv", "sqrtni", "sqrtninv", "lni", "wi")) type <- match.arg(type, c("rstandard", "rstudent")) if (missing(atransf)) atransf <- FALSE atransf.char <- deparse(atransf) if (anyNA(level) || is.null(level)) stop(mstyle$stop("Argument 'level' cannot be NA or NULL.")) .start.plot() mf <- match.call() if (missing(back)) back <- .coladj(par("bg","fg"), dark=0.1, light=-0.2) if (missing(shade)) shade <- .coladj(par("bg","fg"), dark=c(0.2,-0.8), light=c(0,1)) if (length(level) > 1L && length(shade) == 1L) shade <- rep(shade, length(level)) if (missing(hlines)) hlines <- par("bg") if (!missing(refline) && is.null(refline)) refline <- NA #print(c(back=back, shade=shade, hlines=hlines)) if (missing(pch)) { pch <- 19 } else { pch <- .getx("pch", mf=mf, data=x$data) } if (missing(pch.fill)) pch.fill <- 21 ### check if sample size information is available if plotting (some function of) the sample sizes on the y-axis if (is.element(yaxis, c("ni", "ninv", "sqrtni", "sqrtninv", "lni"))) { if (is.null(x$ni)) stop(mstyle$stop("No sample size information stored in model object.")) if (anyNA(x$ni)) warning(mstyle$warning("Sample size information stored in model object\ncontains NAs. Not all studies will be plotted."), call.=FALSE) } ### set y-axis label if not specified if (missing(ylab)) { if (yaxis == "sei") ylab <- "Standard Error" if (yaxis == "vi") ylab <- "Variance" if (yaxis == "seinv") ylab <- "Inverse Standard Error" if (yaxis == "vinv") ylab <- "Inverse Variance" if (yaxis == "ni") ylab <- "Sample Size" if (yaxis == "ninv") ylab <- "Inverse Sample Size" if (yaxis == "sqrtni") ylab <- "Square Root Sample Size" if (yaxis == "sqrtninv") ylab <- "Inverse Square Root Sample Size" if (yaxis == "lni") ylab <- "Log Sample Size" if (yaxis == "wi") ylab <- "Weight (in %)" } if (missing(at)) at <- NULL if (missing(targs)) targs <- NULL ### default number of digits (if not specified) if (missing(digits)) { if (yaxis == "sei") digits <- c(2L,3L) if (yaxis == "vi") digits <- c(2L,3L) if (yaxis == "seinv") digits <- c(2L,3L) if (yaxis == "vinv") digits <- c(2L,3L) if (yaxis == "ni") digits <- c(2L,0L) if (yaxis == "ninv") digits <- c(2L,3L) if (yaxis == "sqrtni") digits <- c(2L,3L) if (yaxis == "sqrtninv") digits <- c(2L,3L) if (yaxis == "lni") digits <- c(2L,3L) if (yaxis == "wi") digits <- c(2L,2L) } else { if (length(digits) == 1L) # digits[1] for x-axis labels digits <- c(digits,digits) # digits[2] for y-axis labels } ### note: digits can also be a list (e.g., digits=list(2L,3)); trailing 0's are dropped for integers if (length(lty) == 1L) lty <- rep(lty, 2L) # 1st value = funnel lines, 2nd value = reference line ### note: slab, pch, col, and bg must be of the same length as the original data passed to rma() ### so we have to apply the same subsetting (if necessary) and removing of NAs as was ### done during the model fitting (note: NAs are removed further below) if (missing(slab)) { slab <- x$slab } else { slab <- .getx("slab", mf=mf, data=x$data) if (length(slab) != x$k.all) stop(mstyle$stop(paste0("Length of the 'slab' argument (", length(slab), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) slab <- .getsubset(slab, x$subset) } if (length(pch) == 1L) { pch.vec <- FALSE pch <- rep(pch, x$k.all) } else { pch.vec <- TRUE } if (length(pch) != x$k.all) stop(mstyle$stop(paste0("Length of the 'pch' argument (", length(pch), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) pch <- .getsubset(pch, x$subset) if (!inherits(x, "rma.uni.trimfill")) { if (missing(col)) { col <- par("fg") } else { col <- .getx("col", mf=mf, data=x$data) } if (length(col) == 1L) { col.vec <- FALSE col <- rep(col, x$k.all) } else { col.vec <- TRUE } if (length(col) != x$k.all) stop(mstyle$stop(paste0("Length of the 'col' argument (", length(col), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) col <- .getsubset(col, x$subset) if (missing(bg)) { bg <- .coladj(par("bg","fg"), dark=0.1, light=-0.1) } else { bg <- .getx("bg", mf=mf, data=x$data) } if (length(bg) == 1L) { bg.vec <- FALSE bg <- rep(bg, x$k.all) } else { bg.vec <- TRUE } if (length(bg) != x$k.all) stop(mstyle$stop(paste0("Length of the 'bg' argument (", length(bg), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) bg <- .getsubset(bg, x$subset) } else { ### for trimfill objects, 'col' and 'bg' are used to specify the colors of the observed and imputed data if (missing(col)) col <- c(par("fg"), par("fg")) if (length(col) == 1L) col <- c(col, par("fg")) col.vec <- FALSE if (missing(bg)) bg <- c(.coladj(par("bg","fg"), dark=0.6, light=-0.6), .coladj(par("bg","fg"), dark=0.1, light=-0.1)) if (length(bg) == 1L) bg <- c(bg, .coladj(par("bg","fg"), dark=0.1, light=-0.1)) bg.vec <- FALSE } if (length(label) != 1L) stop(mstyle$stop("Argument 'label' should be of length 1.")) ddd <- list(...) if (!is.null(ddd$transf)) warning("Function does not have a 'transf' argument (use 'atransf' instead).", call.=FALSE, immediate.=TRUE) lplot <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) plot(...) labline <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) abline(...) lsegments <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) segments(...) laxis <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) axis(...) lpolygon <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) polygon(...) llines <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) lines(...) lpoints <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) points(...) lrect <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) rect(...) ltext <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) text(...) ### refline2, level2, and lty2 for adding a second reference line / funnel if (!is.null(ddd$refline2)) { refline2 <- ddd$refline2 } else { refline2 <- NULL } if (!is.null(ddd$level2)) { level2 <- ddd$level2 } else { level2 <- x$level } if (!is.null(ddd$lty2)) { lty2 <- ddd$lty2 } else { lty2 <- 3 } ### number of y-axis values at which to calculate the bounds of the pseudo confidence interval if (!is.null(ddd$ci.res)) { ci.res <- ddd$ci.res } else { ci.res <- 1000 } ### to adjust color of reference line, region bounds, and the L box if (!is.null(ddd$colref)) { colref <- ddd$colref } else { colref <- .coladj(par("bg","fg"), dark=0.6, light=-0.6) } if (!is.null(ddd$colci)) { colci <- ddd$colci } else { colci <- .coladj(par("bg","fg"), dark=0.6, light=-0.6) } if (!is.null(ddd$colbox)) { colbox <- ddd$colbox } else { colbox <- .coladj(par("bg","fg"), dark=0.6, light=-0.6) } ######################################################################### ### get values for the x-axis (and corresponding vi, sei, and ni values) ### if int.only, get the observed values; otherwise, get the (deleted) residuals if (x$int.only) { if (missing(refline)) refline <- c(x$beta) if (inherits(x, "rma.mv") && addtau2) { warning(mstyle$warning("Argument 'addtau2' ignored for 'rma.mv' models."), call.=FALSE) addtau2 <- FALSE } yi <- x$yi # yi/vi/ni is already subsetted and NAs are removed vi <- x$vi ni <- x$ni # ni can be NULL (and there may be 'additional' NAs) sei <- sqrt(vi) if (!is.null(x$not.na.yivi)) x$not.na <- x$not.na.yivi slab <- slab[x$not.na] # slab is subsetted but NAs are not removed, so still need to do this here pch <- pch[x$not.na] # same for pch if (!inherits(x, "rma.uni.trimfill")) { col <- col[x$not.na] bg <- bg[x$not.na] } else { fill <- x$fill[x$not.na] } if (missing(xlab)) xlab <- .setlab(x$measure, transf.char="FALSE", atransf.char, gentype=1) } else { if (missing(refline)) refline <- 0 if (addtau2) { warning(mstyle$warning("Argument 'addtau2' ignored for models that contain moderators."), call.=FALSE) addtau2 <- FALSE } options(na.action = "na.pass") # note: subsetted but include the NAs (there may be more # NAs than the ones in x$not.na (rstudent() can fail), if (type == "rstandard") { # so we don't use x$not.na below res <- rstandard(x) } else { res <- rstudent(x) } options(na.action = na.act) ### need to check for missings here not.na <- !is.na(res$resid) # vector of residuals is of size k.f and can includes NAs yi <- res$resid[not.na] sei <- res$se[not.na] ni <- x$ni.f[not.na] # ni can be NULL and can still include NAs vi <- sei^2 slab <- slab[not.na] pch <- pch[not.na] col <- col[not.na] bg <- bg[not.na] if (missing(xlab)) xlab <- "Residual Value" } if (inherits(x, "rma.ls") && addtau2) { warning(mstyle$warning("Argument 'addtau2' ignored for 'rma.ls' models."), call.=FALSE) addtau2 <- FALSE } tau2 <- ifelse(addtau2, x$tau2, 0) ### get weights (omit any NAs) if (yaxis == "wi") { options(na.action = "na.omit") weights <- weights(x) options(na.action = na.act) } ######################################################################### ### set y-axis limits if (missing(ylim)) { ### 1st ylim value is always the lowest precision (should be at the bottom of the plot) ### 2nd ylim value is always the highest precision (should be at the top of the plot) if (yaxis == "sei") ylim <- c(max(sei), 0) if (yaxis == "vi") ylim <- c(max(vi), 0) if (yaxis == "seinv") ylim <- c(min(1/sei), max(1/sei)) if (yaxis == "vinv") ylim <- c(min(1/vi), max(1/vi)) if (yaxis == "ni") ylim <- c(min(ni, na.rm=TRUE), max(ni, na.rm=TRUE)) if (yaxis == "ninv") ylim <- c(max(1/ni, na.rm=TRUE), min(1/ni, na.rm=TRUE)) if (yaxis == "sqrtni") ylim <- c(min(sqrt(ni), na.rm=TRUE), max(sqrt(ni), na.rm=TRUE)) if (yaxis == "sqrtninv") ylim <- c(max(1/sqrt(ni), na.rm=TRUE), min(1/sqrt(ni), na.rm=TRUE)) if (yaxis == "lni") ylim <- c(min(log(ni), na.rm=TRUE), max(log(ni), na.rm=TRUE)) if (yaxis == "wi") ylim <- c(min(weights), max(weights)) ### infinite y-axis limits can happen with "seinv" and "vinv" when one or more sampling variances are 0 if (any(is.infinite(ylim))) stop(mstyle$stop("Setting 'ylim' automatically not possible (must set y-axis limits manually).")) } else { ### make sure that user supplied limits are in the right order if (is.element(yaxis, c("sei", "vi", "ninv", "sqrtninv"))) ylim <- c(max(ylim), min(ylim)) if (is.element(yaxis, c("seinv", "vinv", "ni", "sqrtni", "lni", "wi"))) ylim <- c(min(ylim), max(ylim)) ### make sure that user supplied limits are in the appropriate range if (is.element(yaxis, c("sei", "vi", "ni", "ninv", "sqrtni", "sqrtninv", "lni"))) { if (ylim[1] < 0 || ylim[2] < 0) stop(mstyle$stop("Both y-axis limits must be >= 0.")) } if (is.element(yaxis, c("seinv", "vinv"))) { if (ylim[1] <= 0 || ylim[2] <= 0) stop(mstyle$stop("Both y-axis limits must be > 0.")) } if (is.element(yaxis, c("wi"))) { if (ylim[1] < 0 || ylim[2] < 0) stop(mstyle$stop("Both y-axis limits must be >= 0.")) } } ######################################################################### ### set x-axis limits if (is.element(yaxis, c("sei", "vi", "seinv", "vinv"))) { level <- ifelse(level == 0, 1, ifelse(level >= 1, (100-level)/100, ifelse(level > .5, 1-level, level))) level2 <- ifelse(level2 == 0, 1, ifelse(level2 >= 1, (100-level2)/100, ifelse(level2 > .5, 1-level2, level2))) #level <- ifelse(level >= 1, (100-level)/100, ifelse(level > .5, 1-level, level)) # note: there may be multiple level values level.min <- min(level) # note: smallest level is the widest CI lvals <- length(level) ### calculate the CI bounds at the bottom of the figure (for the widest CI if there are multiple) if (yaxis == "sei") { x.lb.bot <- refline - qnorm(level.min/2, lower.tail=FALSE) * sqrt(ylim[1]^2 + tau2) x.ub.bot <- refline + qnorm(level.min/2, lower.tail=FALSE) * sqrt(ylim[1]^2 + tau2) } if (yaxis == "vi") { x.lb.bot <- refline - qnorm(level.min/2, lower.tail=FALSE) * sqrt(ylim[1] + tau2) x.ub.bot <- refline + qnorm(level.min/2, lower.tail=FALSE) * sqrt(ylim[1] + tau2) } if (yaxis == "seinv") { x.lb.bot <- refline - qnorm(level.min/2, lower.tail=FALSE) * sqrt(1/ylim[1]^2 + tau2) x.ub.bot <- refline + qnorm(level.min/2, lower.tail=FALSE) * sqrt(1/ylim[1]^2 + tau2) } if (yaxis == "vinv") { x.lb.bot <- refline - qnorm(level.min/2, lower.tail=FALSE) * sqrt(1/ylim[1] + tau2) x.ub.bot <- refline + qnorm(level.min/2, lower.tail=FALSE) * sqrt(1/ylim[1] + tau2) } if (missing(xlim)) { xlim <- c(min(x.lb.bot,min(yi),na.rm=TRUE), max(x.ub.bot,max(yi),na.rm=TRUE)) # make sure x-axis not only includes widest CI, but also all yi values rxlim <- xlim[2] - xlim[1] # calculate range of the x-axis limits xlim[1] <- xlim[1] - (rxlim * 0.10) # subtract 10% of range from lower x-axis bound xlim[2] <- xlim[2] + (rxlim * 0.10) # add 10% of range to upper x-axis bound } else { xlim <- sort(xlim) # just in case the user supplies the limits in the wrong order } } if (is.element(yaxis, c("ni", "ninv", "sqrtni", "sqrtninv", "lni", "wi"))) { if (missing(xlim)) { xlim <- c(min(yi), max(yi)) rxlim <- xlim[2] - xlim[1] # calculate range of the x-axis limits xlim[1] <- xlim[1] - (rxlim * 0.10) # subtract 10% of range from lower x-axis bound xlim[2] <- xlim[2] + (rxlim * 0.10) # add 10% of range to upper x-axis bound } else { xlim <- sort(xlim) # just in case the user supplies the limits in the wrong order } } ### if user has specified 'at' argument, make sure xlim actually contains the min and max 'at' values if (!is.null(at)) { xlim[1] <- min(c(xlim[1], at), na.rm=TRUE) xlim[2] <- max(c(xlim[2], at), na.rm=TRUE) } ######################################################################### ### set up plot lplot(NA, NA, xlim=xlim, ylim=ylim, xlab=xlab, ylab=ylab, xaxt="n", yaxt="n", bty="n", ...) ### add background shading par.usr <- par("usr") lrect(par.usr[1], par.usr[3], par.usr[2], par.usr[4], col=back, border=NA, ...) ### add y-axis laxis(side=2, at=seq(from=ylim[1], to=ylim[2], length.out=steps), labels=fmtx(seq(from=ylim[1], to=ylim[2], length.out=steps), digits[[2]], drop0ifint=TRUE), ...) ### add horizontal lines labline(h=seq(from=ylim[1], to=ylim[2], length.out=steps), col=hlines, ...) ######################################################################### ### add CI region(s) if (is.element(yaxis, c("sei", "vi", "seinv", "vinv"))) { ### add a bit to the top/bottom ylim so that the CI region(s) fill out the entire figure if (yaxis == "sei") { rylim <- ylim[1] - ylim[2] ylim[1] <- ylim[1] + (rylim * 0.10) ylim[2] <- max(0, ylim[2] - (rylim * 0.10)) } if (yaxis == "vi") { rylim <- ylim[1] - ylim[2] ylim[1] <- ylim[1] + (rylim * 0.10) ylim[2] <- max(0, ylim[2] - (rylim * 0.10)) } if (yaxis == "seinv") { rylim <- ylim[2] - ylim[1] #ylim[1] <- max(.0001, ylim[1] - (rylim * 0.10)) # not clear how much to add to bottom ylim[2] <- ylim[2] + (rylim * 0.10) } if (yaxis == "vinv") { rylim <- ylim[2] - ylim[1] #ylim[1] <- max(.0001, ylim[1] - (rylim * 0.10)) # not clear how much to add to bottom ylim[2] <- ylim[2] + (rylim * 0.10) } yi.vals <- seq(from=ylim[1], to=ylim[2], length.out=ci.res) if (yaxis == "sei") vi.vals <- yi.vals^2 if (yaxis == "vi") vi.vals <- yi.vals if (yaxis == "seinv") vi.vals <- 1/yi.vals^2 if (yaxis == "vinv") vi.vals <- 1/yi.vals for (m in lvals:1) { ci.left <- refline - qnorm(level[m]/2, lower.tail=FALSE) * sqrt(vi.vals + tau2) ci.right <- refline + qnorm(level[m]/2, lower.tail=FALSE) * sqrt(vi.vals + tau2) lpolygon(c(ci.left,ci.right[ci.res:1]), c(yi.vals,yi.vals[ci.res:1]), border=NA, col=shade[m], ...) llines(ci.left, yi.vals, lty=lty[1], col=colci, ...) llines(ci.right, yi.vals, lty=lty[1], col=colci, ...) } if (!is.null(refline2)) { ci.left <- refline2 - qnorm(level2/2, lower.tail=FALSE) * sqrt(vi.vals + tau2) ci.right <- refline2 + qnorm(level2/2, lower.tail=FALSE) * sqrt(vi.vals + tau2) llines(ci.left, yi.vals, lty=lty2, col=colci, ...) llines(ci.right, yi.vals, lty=lty2, col=colci, ...) } } ### add vertical reference line ### use segments so that line does not extent beyond tip of CI region if (is.element(yaxis, c("sei", "vi", "seinv", "vinv"))) lsegments(refline, ylim[1], refline, ylim[2], lty=lty[2], col=colref, ...) if (is.element(yaxis, c("ni", "ninv", "sqrtni", "sqrtninv", "lni", "wi"))) labline(v=refline, lty=lty[2], col=colref, ...) if (!is.null(refline2)) { if (is.element(yaxis, c("sei", "vi", "seinv", "vinv"))) lsegments(refline2, ylim[1], refline2, ylim[2], lty=lty2, col=colref, ...) if (is.element(yaxis, c("ni", "ninv", "sqrtni", "sqrtninv", "lni", "wi"))) labline(v=refline2, lty=lty2, col=colref, ...) } ######################################################################### ### add points xaxis.vals <- yi if (yaxis == "sei") yaxis.vals <- sei if (yaxis == "vi") yaxis.vals <- vi if (yaxis == "seinv") yaxis.vals <- 1/sei if (yaxis == "vinv") yaxis.vals <- 1/vi if (yaxis == "ni") yaxis.vals <- ni if (yaxis == "ninv") yaxis.vals <- 1/ni if (yaxis == "sqrtni") yaxis.vals <- sqrt(ni) if (yaxis == "sqrtninv") yaxis.vals <- 1/sqrt(ni) if (yaxis == "lni") yaxis.vals <- log(ni) if (yaxis == "wi") yaxis.vals <- weights if (!inherits(x, "rma.uni.trimfill")) { lpoints(x=xaxis.vals, y=yaxis.vals, pch=pch, col=col, bg=bg, ...) } else { lpoints(x=xaxis.vals[!fill], y=yaxis.vals[!fill], pch=pch, col=col[1], bg=bg[1], ...) lpoints(x=xaxis.vals[fill], y=yaxis.vals[fill], pch=pch.fill, col=col[2], bg=bg[2], ...) } ######################################################################### ### add L-shaped box around plot if (!is.na(colbox)) box(bty="l", col=colbox) ### generate x-axis positions if none are specified if (is.null(at)) { at <- axTicks(side=1) #at <- pretty(x=c(alim[1], alim[2]), n=steps-1) #at <- pretty(x=c(min(ci.lb), max(ci.ub)), n=steps-1) } else { at <- at[at > par("usr")[1]] at <- at[at < par("usr")[2]] } at.lab <- at if (is.function(atransf)) { if (is.null(targs)) { at.lab <- fmtx(sapply(at.lab, atransf), digits[[1]], drop0ifint=TRUE) } else { at.lab <- fmtx(sapply(at.lab, atransf, targs), digits[[1]], drop0ifint=TRUE) } } else { at.lab <- fmtx(at.lab, digits[[1]], drop0ifint=TRUE) } ### add x-axis laxis(side=1, at=at, labels=at.lab, ...) ############################################################################ ### labeling of points k <- length(yi) if (is.numeric(label) || is.character(label) || .isTRUE(label)) { if (is.na(refline)) refline <- mean(yi, na.rm=TRUE) if (is.numeric(label)) { label <- round(label) if (label < 0) label <- 0 if (label > k) label <- k label <- order(abs(yi - refline), decreasing=TRUE)[seq_len(label)] } else if ((is.character(label) && label == "all") || .isTRUE(label)) { label <- seq_len(k) } else if ((is.character(label) && label == "out")) { if (!is.element(yaxis, c("sei", "vi", "seinv", "vinv"))) { label <- seq_len(k) } else { label <- which(abs(yi - refline) / sqrt(vi + tau2) >= qnorm(level.min/2, lower.tail=FALSE)) } } else { label <- NULL } for (i in label) ltext(yi[i], yaxis.vals[i], slab[i], pos=ifelse(yi[i]-refline >= 0, 4, 2), offset=offset, ...) } ######################################################################### ### add legend (if requested) .funnel.legend(legend, level, shade, back, yaxis, trimfill=inherits(x, "rma.uni.trimfill"), pch, col, bg, pch.fill, pch.vec, col.vec, bg.vec, colci) ############################################################################ ### prepare data frame to return sav <- data.frame(x=xaxis.vals, y=yaxis.vals, slab=slab, stringsAsFactors=FALSE) if (inherits(x, "rma.uni.trimfill")) sav$fill <- fill invisible(sav) } metafor/R/fitstats.r0000644000176200001440000000007413457322061014140 0ustar liggesusersfitstats <- function (object, ...) UseMethod("fitstats") metafor/R/addpoly.r0000644000176200001440000000006413457322061013732 0ustar liggesusersaddpoly <- function(x, ...) UseMethod("addpoly") metafor/R/coef.matreg.r0000644000176200001440000000034514434120656014474 0ustar liggesuserscoef.matreg <- function(object, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="matreg") coefs <- c(object$tab$beta) names(coefs) <- rownames(object$tab) return(coefs) } metafor/R/print.anova.rma.r0000644000176200001440000001436014401676036015323 0ustar liggesusersprint.anova.rma <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="anova.rma") digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) .space() if (x$type == "Wald.btt") { if (is.element("rma.ls", x$class)) { cat(mstyle$section(paste0("Test of Location Coefficients (coefficient", ifelse(x$m == 1, " ", "s "), .format.btt(x$btt),"):"))) } else { cat(mstyle$section(paste0("Test of Moderators (coefficient", ifelse(x$m == 1, " ", "s "), .format.btt(x$btt),"):"))) } cat("\n") if (is.element(x$test, c("knha","adhoc","t"))) { cat(mstyle$result(fmtt(x$QM, "F", df1=x$QMdf[1], df2=x$QMdf[2], pval=x$QMp, digits=digits))) } else { cat(mstyle$result(fmtt(x$QM, "QM", df=x$QMdf[1], pval=x$QMp, digits=digits))) } cat("\n") } if (x$type == "Wald.att") { cat(mstyle$section(paste0("Test of Scale Coefficients (coefficient", ifelse(x$m == 1, " ", "s "), .format.btt(x$att),"):"))) cat("\n") if (is.element(x$test, c("knha","adhoc","t"))) { cat(mstyle$result(fmtt(x$QS, "F", df1=x$QSdf[1], df2=x$QSdf[2], pval=x$QSp, digits=digits))) } else { cat(mstyle$result(fmtt(x$QS, "QS", df=x$QSdf[1], pval=x$QSp, digits=digits))) } cat("\n") } if (x$type == "Wald.Xb") { if (x$m == 1) { cat(mstyle$section("Hypothesis:")) } else { cat(mstyle$section("Hypotheses:")) } tmp <- capture.output(print(x$hyp)) .print.output(tmp, mstyle$text) cat("\n") cat(mstyle$section("Results:")) cat("\n") if (is.element(x$test, c("knha","adhoc","t"))) { res.table <- data.frame(estimate=fmtx(c(x$Xb), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), tval=fmtx(x$zval, digits[["test"]]), df=round(x$ddf,2), pval=fmtp(x$pval, digits[["pval"]]), stringsAsFactors=FALSE) } else { res.table <- data.frame(estimate=fmtx(c(x$Xb), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), zval=fmtx(x$zval, digits[["test"]]), pval=fmtp(x$pval, digits[["pval"]]), stringsAsFactors=FALSE) } rownames(res.table) <- paste0(seq_len(x$m), ":") tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE)) .print.table(tmp, mstyle) if (!is.na(x$QM)) { cat("\n") if (x$m == 1) { cat(mstyle$section("Test of Hypothesis:")) } else { cat(mstyle$section("Omnibus Test of Hypotheses:")) } cat("\n") if (is.element(x$test, c("knha","adhoc","t"))) { cat(mstyle$result(fmtt(x$QM, "F", df1=x$QMdf[1], df2=x$QMdf[2], pval=x$QMp, digits=digits))) } else { cat(mstyle$result(fmtt(x$QM, "QM", df=x$QMdf[1], pval=x$QMp, digits=digits))) } cat("\n") } } if (x$type == "Wald.Za") { if (x$m == 1) { cat(mstyle$section("Hypothesis:")) } else { cat(mstyle$section("Hypotheses:")) } tmp <- capture.output(print(x$hyp)) .print.output(tmp, mstyle$text) cat("\n") cat(mstyle$section("Results:")) cat("\n") if (is.element(x$test, c("knha","adhoc","t"))) { res.table <- data.frame(estimate=fmtx(c(x$Za), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), tval=fmtx(x$zval, digits[["test"]]), df=round(x$ddf,2), pval=fmtp(x$pval, digits[["pval"]]), stringsAsFactors=FALSE) } else { res.table <- data.frame(estimate=fmtx(c(x$Za), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), zval=fmtx(x$zval, digits[["test"]]), pval=fmtp(x$pval, digits[["pval"]]), stringsAsFactors=FALSE) } rownames(res.table) <- paste0(seq_len(x$m), ":") tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE)) .print.table(tmp, mstyle) if (!is.na(x$QS)) { cat("\n") if (x$m == 1) { cat(mstyle$section("Test of Hypothesis:")) } else { cat(mstyle$section("Omnibus Test of Hypotheses:")) } cat("\n") if (is.element(x$test, c("knha","adhoc","t"))) { cat(mstyle$result(fmtt(x$QS, "F", df1=x$QSdf[1], df2=x$QSdf[2], pval=x$QSp, digits=digits))) } else { cat(mstyle$result(fmtt(x$QS, "QS", df=x$QSdf[1], pval=x$QSp, digits=digits))) } cat("\n") } } if (x$type == "LRT") { res.table <- data.frame(c(x$parms.f, x$parms.r), c(fmtx(x$fit.stats.f["AIC"], digits[["fit"]]), fmtx(x$fit.stats.r["AIC"], digits[["fit"]])), c(fmtx(x$fit.stats.f["BIC"], digits[["fit"]]), fmtx(x$fit.stats.r["BIC"], digits[["fit"]])), c(fmtx(x$fit.stats.f["AICc"], digits[["fit"]]), fmtx(x$fit.stats.r["AICc"], digits[["fit"]])), c(fmtx(x$fit.stats.f["ll"], digits[["fit"]]), fmtx(x$fit.stats.r["ll"], digits[["fit"]])), c(NA_character_, fmtx(x$LRT, digits[["test"]])), c(NA_character_, fmtp(x$pval, digits[["pval"]])), c(fmtx(x$QE.f, digits[["test"]]), fmtx(x$QE.r, digits[["test"]])), c(fmtx(x$tau2.f, digits[["var"]]), fmtx(x$tau2.r, digits[["var"]])), c(NA_character_, NA_character_), stringsAsFactors=FALSE) colnames(res.table) <- c("df", "AIC", "BIC", "AICc", "logLik", "LRT", "pval", "QE", "tau^2", "R^2") rownames(res.table) <- c("Full", "Reduced") res.table["Full",c("LRT","pval")] <- "" res.table["Full","R^2"] <- "" res.table["Reduced","R^2"] <- fmtx(x$R2, digits[["het"]], postfix="%") ### remove tau^2 column if full model is a FE/EE/CE model or tau2.f/tau2.r is NA if (is.element(x$method, c("FE","EE","CE")) || (is.na(x$tau2.f) || is.na(x$tau2.r))) res.table <- res.table[-which(names(res.table) == "tau^2")] ### remove R^2 column if full model is a rma.mv or rma.ls model if (is.element("rma.mv", x$class.f) || is.element("rma.ls", x$class.f)) res.table <- res.table[-which(names(res.table) == "R^2")] tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE)) .print.table(tmp, mstyle) } .space() invisible() } metafor/R/cumul.rma.peto.r0000644000176200001440000001246114401667020015150 0ustar liggesuserscumul.rma.peto <- function(x, order, digits, transf, targs, progbar=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.peto") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL ddd <- list(...) .chkdots(ddd, c("time", "decreasing")) if (.isTRUE(ddd$time)) time.start <- proc.time() if (is.null(ddd$decreasing)) { decreasing <- FALSE } else { decreasing <- ddd$decreasing } ######################################################################### if (grepl("^order\\(", deparse1(substitute(order)))) warning(mstyle$warning("Use of order() in 'order' argument is probably erroneous."), call.=FALSE) if (missing(order)) { order <- seq_len(x$k.all) } else { mf <- match.call() order <- .getx("order", mf=mf, data=x$data) } if (length(order) != x$k.all) stop(mstyle$stop(paste0("Length of the 'order' argument (", length(order), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) ### note: order variable is assumed to be of the same length as the size of the ### original dataset passed to the model fitting function and so we apply ### the same subsetting (if necessary) as was done during model fitting order <- .getsubset(order, x$subset) order <- order(order, decreasing=decreasing) ai.f <- x$outdat.f$ai[order] bi.f <- x$outdat.f$bi[order] ci.f <- x$outdat.f$ci[order] di.f <- x$outdat.f$di[order] yi.f <- x$yi.f[order] vi.f <- x$vi.f[order] not.na <- x$not.na[order] slab <- x$slab[order] ids <- x$ids[order] if (inherits(x$data, "environment")) { data <- NULL } else { data <- x$data[order,] } beta <- rep(NA_real_, x$k.f) se <- rep(NA_real_, x$k.f) zval <- rep(NA_real_, x$k.f) pval <- rep(NA_real_, x$k.f) ci.lb <- rep(NA_real_, x$k.f) ci.ub <- rep(NA_real_, x$k.f) QE <- rep(NA_real_, x$k.f) QEp <- rep(NA_real_, x$k.f) I2 <- rep(NA_real_, x$k.f) H2 <- rep(NA_real_, x$k.f) ### elements that need to be returned outlist <- "beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, QE=QE, QEp=QEp, tau2=tau2, I2=I2, H2=H2" ### note: skipping NA cases if (progbar) pbar <- pbapply::startpb(min=0, max=x$k.f) for (i in seq_len(x$k.f)) { if (progbar) pbapply::setpb(pbar, i) if (!not.na[i]) next args <- list(ai=ai.f, bi=bi.f, ci=ci.f, di=di.f, add=x$add, to=x$to, drop00=x$drop00, level=x$level, subset=seq_len(i), outlist=outlist) res <- try(suppressWarnings(.do.call(rma.peto, args)), silent=TRUE) if (inherits(res, "try-error")) next beta[i] <- res$beta se[i] <- res$se zval[i] <- res$zval pval[i] <- res$pval ci.lb[i] <- res$ci.lb ci.ub[i] <- res$ci.ub QE[i] <- res$QE QEp[i] <- res$QEp I2[i] <- res$I2 H2[i] <- res$H2 } if (progbar) pbapply::closepb(pbar) ######################################################################### ### if requested, apply transformation function if (.isTRUE(transf)) ### if transf=TRUE, apply exp transformation to ORs transf <- exp if (is.function(transf)) { if (is.null(targs)) { beta <- sapply(beta, transf) se <- rep(NA_real_, x$k.f) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) } else { beta <- sapply(beta, transf, targs) se <- rep(NA_real_, x$k.f) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) } transf <- TRUE } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] ######################################################################### if (na.act == "na.omit") { out <- list(estimate=beta[not.na], se=se[not.na], zval=zval[not.na], pval=pval[not.na], ci.lb=ci.lb[not.na], ci.ub=ci.ub[not.na], Q=QE[not.na], Qp=QEp[not.na], I2=I2[not.na], H2=H2[not.na]) out$slab <- slab[not.na] out$ids <- ids[not.na] out$data <- data[not.na,] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(estimate=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, Q=QE, Qp=QEp, I2=I2, H2=H2) out$slab <- slab out$ids <- ids out$data <- data } if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) out$digits <- digits out$transf <- transf out$slab.null <- x$slab.null out$level <- x$level out$measure <- x$measure out$test <- x$test attr(out$estimate, "measure") <- x$measure if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(out) <- c("list.rma", "cumul.rma") return(out) } metafor/R/print.list.confint.rma.r0000644000176200001440000000131114305043364016614 0ustar liggesusersprint.list.confint.rma <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="list.confint.rma") digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) x$digits <- NULL # so length(x) is correct .space() len <- length(x) for (j in seq_len(len)) { res.random <- fmtx(x[[j]]$random, digits[["var"]]) res.random[,2] <- paste0(x[[j]]$lb.sign, res.random[,2]) res.random[,3] <- paste0(x[[j]]$ub.sign, res.random[,3]) tmp <- capture.output(print(res.random, quote=FALSE, right=TRUE)) .print.table(tmp, mstyle) if (j != len) cat("\n") } .space() invisible() } metafor/R/radial.rma.r0000644000176200001440000002304714465412666014331 0ustar liggesusersradial.rma <- function(x, center=FALSE, xlim=NULL, zlim, xlab, zlab, atz, aty, steps=7, level=x$level, digits=2, transf, targs, pch=21, col, bg, back, arc.res=100, cex, cex.lab, cex.axis, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma", notav=c("robust.rma", "rma.mv", "rma.ls", "rma.gen", "rma.uni.selmodel")) if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL if (missing(atz)) atz <- NULL if (missing(aty)) aty <- NULL .start.plot() if (missing(back)) back <- .coladj(par("bg","fg"), dark=0.1, light=-0.1) if (missing(col)) col <- par("fg") if (missing(bg)) bg <- .coladj(par("bg","fg"), dark=0.35, light=-0.35) ######################################################################### ### radial plots only for intercept-only models if (x$int.only) { yi <- x$yi yi.c <- yi vi <- x$vi beta <- c(x$beta) ci.lb <- x$ci.lb ci.ub <- x$ci.ub tau2 <- 1/mean(1/x$tau2) ### geometric mean of tau^2 values (hackish solution for models with multiple tau^2 values) ### note: this works for 1/mean(1/0) = 0; TODO: consider something more sophisticated here if (is.null(aty)) { atyis <- range(yi) } else { atyis <- range(aty) aty.c <- aty } } else { stop(mstyle$stop("Radial plots only available for models without moderators.")) } if (center) { yi <- yi - c(x$beta) beta <- 0 ci.lb <- ci.lb - c(x$beta) ci.ub <- ci.ub - c(x$beta) atyis <- atyis - c(x$beta) if (!is.null(aty)) aty <- aty - c(x$beta) } ######################################################################### level <- .level(level) zcrit <- qnorm(level/2, lower.tail=FALSE) zi <- yi / sqrt(vi+tau2) xi <- 1 / sqrt(vi+tau2) ### if vi=0 and tau2=0, then zi and xi will be Inf if (any(is.infinite(c(xi,zi)))) stop(mstyle$stop("Setting 'xlim' and 'zlim' automatically not possible (must set axis limits manually).")) ### set x-axis limits if none are specified if (missing(xlim)) { xlims <- c(0, (1.30*max(xi))) ### add 30% to upper bound } else { xlims <- sort(xlim) } ### x-axis position of the confidence interval ci.xpos <- xlims[2] + 0.12*(xlims[2]-xlims[1]) ### add 12% of range to upper bound ### x-axis position of the y-axis on the right ya.xpos <- xlims[2] + 0.14*(xlims[2]-xlims[1]) ### add 14% of range to upper bound xaxismax <- xlims[2] ### set z-axis limits if none are specified (these are the actual y-axis limits of the plot) if (missing(zlim)) { zlims <- c(min(-5, 1.10*min(zi), 1.10*ci.lb*ci.xpos, 1.10*min(atyis)*ya.xpos, 1.10*min(yi)*ya.xpos, -1.10*zcrit+xaxismax*beta), max(5, 1.10*max(zi), 1.10*ci.ub*ci.xpos, 1.10*max(atyis)*ya.xpos, 1.10*max(yi)*ya.xpos, 1.10*zcrit+xaxismax*beta)) } else { zlims <- sort(zlim) } ### adjust margins par.mar <- par("mar") par.mar.adj <- par.mar + c(0,4,0,6) par.mar.adj[par.mar.adj < 1] <- 1 par(mar = par.mar.adj) on.exit(par(mar = par.mar), add=TRUE) ### label for the x-axis if (missing(xlab)) { if (is.element(x$method, c("FE","EE","CE"))) { xlab <- expression(x[i]==1/sqrt(v[i]), ...) } else { xlab <- expression(x[i]==1/sqrt(v[i]+tau^2), ...) } } par.pty <- par("pty") par(pty="s") on.exit(par(pty = par.pty), add=TRUE) if (missing(cex)) { cex <- par("cex") } else { cex <- par("cex") * cex } if (missing(cex.lab)) { cex.lab <- par("cex") } else { cex.lab <- par("cex") * cex.lab } if (missing(cex.axis)) { cex.axis <- par("cex") } else { cex.axis <- par("cex") * cex.axis } plot(NA, NA, ylim=zlims, xlim=xlims, bty="n", xaxt="n", yaxt="n", xlab=xlab, ylab="", xaxs="i", yaxs="i", cex.lab=cex.lab, ...) ### add polygon and +-zcrit lines polygon(c(0,xaxismax,xaxismax,0), c(zcrit, zcrit+xaxismax*beta, -zcrit+xaxismax*beta, -zcrit), border=NA, col=back) segments(0, 0, xaxismax, xaxismax*beta, lty="solid", ...) segments(0, -zcrit, xaxismax, -zcrit+xaxismax*beta, lty="dotted", ...) segments(0, zcrit, xaxismax, zcrit+xaxismax*beta, lty="dotted", ...) ### add x-axis axis(side=1, cex.axis=cex.axis, ...) ### add z-axis if (is.null(atz)) { axis(side=2, at=seq(-4, 4, length.out=9), labels=NA, las=1, tcl=par("tcl")/2, cex.axis=cex.axis, ...) axis(side=2, at=seq(-2, 2, length.out=3), las=1, cex.axis=cex.axis, ...) } else { axis(side=2, at=atz, labels=atz, las=1, cex.axis=cex.axis, ...) } ### add label for the z-axis if (missing(zlab)) { if (center) { if (is.element(x$method, c("FE","EE","CE"))) { mtext(expression(z[i]==frac(y[i]-hat(theta),sqrt(v[i]))), side=2, line=par.mar.adj[2]-1, at=0, adj=0, las=1, cex=cex.lab, ...) } else { mtext(expression(z[i]==frac(y[i]-hat(mu),sqrt(v[i]+tau^2))), side=2, line=par.mar.adj[2]-1, adj=0, at=0, las=1, cex=cex.lab, ...) } } else { if (is.element(x$method, c("FE","EE","CE"))) { mtext(expression(z[i]==frac(y[i],sqrt(v[i]))), side=2, line=par.mar.adj[2]-2, at=0, adj=0, las=1, cex=cex.lab, ...) } else { mtext(expression(z[i]==frac(y[i],sqrt(v[i]+tau^2))), side=2, line=par.mar.adj[2]-1, at=0, adj=0, las=1, cex=cex.lab, ...) } } } else { mtext(zlab, side=2, line=par.mar.adj[2]-4, at=0, cex=cex.lab, ...) } ######################################################################### ### add y-axis arc and CI arc on the right par.xpd <- par("xpd") par(xpd=TRUE) par.usr <- par("usr") asp.rat <- (par.usr[4]-par.usr[3])/(par.usr[2]-par.usr[1]) if (length(arc.res) == 1L) arc.res <- c(arc.res, arc.res/4) ### add y-axis arc if (is.null(aty)) { atyis <- seq(min(yi), max(yi), length.out=arc.res[1]) } else { atyis <- seq(min(aty), max(aty), length.out=arc.res[1]) } len <- ya.xpos xis <- rep(NA_real_, length(atyis)) zis <- rep(NA_real_, length(atyis)) for (i in seq_along(atyis)) { xis[i] <- sqrt(len^2/(1+(atyis[i]/asp.rat)^2)) zis[i] <- xis[i]*atyis[i] } valid <- zis > zlims[1] & zis < zlims[2] lines(xis[valid], zis[valid], ...) ### add y-axis tick marks if (is.null(aty)) { atyis <- seq(min(yi), max(yi), length.out=steps) } else { atyis <- aty } len.l <- ya.xpos len.u <- ya.xpos + .015*(xlims[2]-xlims[1]) xis.l <- rep(NA_real_, length(atyis)) zis.l <- rep(NA_real_, length(atyis)) xis.u <- rep(NA_real_, length(atyis)) zis.u <- rep(NA_real_, length(atyis)) for (i in seq_along(atyis)) { xis.l[i] <- sqrt(len.l^2/(1+(atyis[i]/asp.rat)^2)) zis.l[i] <- xis.l[i]*atyis[i] xis.u[i] <- sqrt(len.u^2/(1+(atyis[i]/asp.rat)^2)) zis.u[i] <- xis.u[i]*atyis[i] } valid <- zis.l > zlims[1] & zis.u > zlims[1] & zis.l < zlims[2] & zis.u < zlims[2] if (any(valid)) segments(xis.l[valid], zis.l[valid], xis.u[valid], (xis.u*atyis)[valid], ...) ### add y-axis labels if (is.null(aty)) { atyis <- seq(min(yi), max(yi), length.out=steps) atyis.lab <- seq(min(yi.c), max(yi.c), length.out=steps) } else { atyis <- aty atyis.lab <- aty.c } len <- ya.xpos+.02*(xlims[2]-xlims[1]) xis <- rep(NA_real_, length(atyis)) zis <- rep(NA_real_, length(atyis)) for (i in seq_along(atyis)) { xis[i] <- sqrt(len^2/(1+(atyis[i]/asp.rat)^2)) zis[i] <- xis[i]*atyis[i] } if (is.function(transf)) { if (is.null(targs)) { atyis.lab <- sapply(atyis.lab, transf) } else { atyis.lab <- sapply(atyis.lab, transf, targs) } } valid <- zis > zlims[1] & zis < zlims[2] if (any(valid)) text(xis[valid], zis[valid], fmtx(atyis.lab[valid], digits), pos=4, cex=cex.axis, ...) ### add CI arc atyis <- seq(ci.lb, ci.ub, length.out=arc.res[2]) len <- ci.xpos xis <- rep(NA_real_, length(atyis)) zis <- rep(NA_real_, length(atyis)) for (i in seq_along(atyis)) { xis[i] <- sqrt(len^2/(1+(atyis[i]/asp.rat)^2)) zis[i] <- xis[i]*atyis[i] } valid <- zis > zlims[1] & zis < zlims[2] if (any(valid)) lines(xis[valid], zis[valid], ...) ### add CI tick marks atyis <- c(ci.lb, beta, ci.ub) len.l <- ci.xpos-.007*(xlims[2]-xlims[1]) len.u <- ci.xpos+.007*(xlims[2]-xlims[1]) xis.l <- rep(NA_real_, 3L) zis.l <- rep(NA_real_, 3L) xis.u <- rep(NA_real_, 3L) zis.u <- rep(NA_real_, 3L) for (i in seq_along(atyis)) { xis.l[i] <- sqrt(len.l^2/(1+(atyis[i]/asp.rat)^2)) zis.l[i] <- xis.l[i]*atyis[i] xis.u[i] <- sqrt(len.u^2/(1+(atyis[i]/asp.rat)^2)) zis.u[i] <- xis.u[i]*atyis[i] } valid <- zis.l > zlims[1] & zis.u > zlims[1] & zis.l < zlims[2] & zis.u < zlims[2] if (any(valid)) segments(xis.l[valid], zis.l[valid], xis.u[valid], (xis.u*atyis)[valid], ...) par(xpd=par.xpd) ######################################################################### ### add points to the plot points(x=xi, y=zi, pch=pch, cex=cex, col=col, bg=bg, ...) if (is.null(x$not.na.yivi)) { invisible(data.frame(x=xi, y=zi, ids=x$ids[x$not.na], slab=x$slab[x$not.na], stringsAsFactors=FALSE)) } else { invisible(data.frame(x=xi, y=zi, ids=x$ids[x$not.na.yivi], slab=x$slab[x$not.na.yivi], stringsAsFactors=FALSE)) } } metafor/R/summary.matreg.r0000644000176200001440000000066614434121411015251 0ustar liggesuserssummary.matreg <- function(object, digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="matreg") if (missing(digits)) { digits <- .get.digits(xdigits=object$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=object$digits, dmiss=FALSE) } object$digits <- digits class(object) <- c("summary.matreg", class(object)) return(object) } metafor/R/plot.rma.uni.r0000644000176200001440000001026414465422273014635 0ustar liggesusersplot.rma.uni <- function(x, qqplot=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.uni", notav=c("robust.rma", "rma.ls", "rma.gen", "rma.uni.selmodel")) na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) .start.plot() par.mfrow <- par("mfrow") par(mfrow=c(2,2)) on.exit(par(mfrow = par.mfrow), add=TRUE) bg <- .coladj(par("bg","fg"), dark=0.35, light=-0.35) col.na <- .coladj(par("bg","fg"), dark=0.2, light=-0.2) ######################################################################### if (x$int.only) { ###################################################################### forest(x, ...) title("Forest Plot", ...) ###################################################################### funnel(x, ...) title("Funnel Plot", ...) ###################################################################### radial(x, ...) title("Radial Plot", ...) ###################################################################### if (qqplot) { qqnorm(x, ...) } else { options(na.action = "na.pass") z <- rstandard(x)$z options(na.action = na.act) not.na <- !is.na(z) if (na.act == "na.omit") { z <- z[not.na] ids <- x$ids[not.na] not.na <- not.na[not.na] } if (na.act == "na.exclude" || na.act == "na.pass") ids <- x$ids k <- length(z) plot(NA, NA, xlim=c(1,k), ylim=c(min(z, -2, na.rm=TRUE), max(z, 2, na.rm=TRUE)), xaxt="n", xlab="Study", ylab="", bty="l", ...) lines(seq_len(k)[not.na], z[not.na], col=col.na, ...) lines(seq_len(k), z, ...) points(x=seq_len(k), y=z, pch=21, bg=bg, ...) axis(side=1, at=seq_len(k), labels=ids, ...) abline(h=0, lty="dashed", ...) abline(h=c(qnorm(.025),qnorm(.975)), lty="dotted", ...) title("Standardized Residuals", ...) } } else { ###################################################################### forest(x, ...) title("Forest Plot", ...) ###################################################################### funnel(x, ...) title("Residual Funnel Plot", ...) ###################################################################### options(na.action = "na.pass") z <- rstandard(x)$z pred <- fitted(x) options(na.action = na.act) plot(NA, NA, xlim=range(pred), ylim=c(min(z, -2, na.rm=TRUE), max(z, 2, na.rm=TRUE)), bty="l", xlab="Fitted Value", ylab="Standardized Residual", ...) abline(h=0, lty="dashed", ...) abline(h=c(qnorm(.025),qnorm(.975)), lty="dotted", ...) points(pred, z, pch=21, bg=bg, ...) title("Fitted vs. Standardized Residuals", ...) ###################################################################### if (qqplot) { qqnorm(x, ...) } else { options(na.action = "na.pass") z <- rstandard(x)$z options(na.action = na.act) not.na <- !is.na(z) if (na.act == "na.omit") { z <- z[not.na] ids <- x$ids[not.na] not.na <- not.na[not.na] } if (na.act == "na.exclude" || na.act == "na.pass") ids <- x$ids k <- length(z) plot(NA, NA, xlim=c(1,k), ylim=c(min(z, -2, na.rm=TRUE), max(z, 2, na.rm=TRUE)), xaxt="n", xlab="Study", ylab="", bty="l", ...) lines(seq_len(k)[not.na], z[not.na], col=col.na, ...) lines(seq_len(k), z, ...) points(x=seq_len(k), y=z, pch=21, bg=bg, ...) axis(side=1, at=seq_len(k), labels=ids, ...) abline(h=0, lty="dashed", ...) abline(h=c(qnorm(.025),qnorm(.975)), lty="dotted", ...) title("Standardized Residuals", ...) } ###################################################################### } invisible() } metafor/R/ranef.rma.mv.r0000644000176200001440000002312114401676412014571 0ustar liggesusersranef.rma.mv <- function(object, level, digits, transf, targs, verbose=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.mv") x <- object na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (missing(level)) level <- x$level if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL level <- .level(level) if (x$test == "z") crit <- qnorm(level/2, lower.tail=FALSE) ### TODO: check computations for user-defined weights if (!is.null(x$W)) stop(mstyle$stop("Extraction of random effects not available for models with non-standard weights.")) ddd <- list(...) .chkdots(ddd, c("expand")) expand <- ifelse(is.null(expand), FALSE, isTRUE(ddd$expand)) # TODO: make this an option? ######################################################################### out <- NULL if (verbose) message(mstyle$message("\nComputing inverse marginal var-cov and hat matrix ... "), appendLF = FALSE) ### compute inverse marginal var-cov and hat matrix W <- chol2inv(chol(x$M)) stXWX <- chol2inv(chol(as.matrix(t(x$X) %*% W %*% x$X))) Hmat <- x$X %*% stXWX %*% crossprod(x$X,W) if (verbose) message(mstyle$message("Done!")) ### compute residuals ei <- c(x$yi - x$X %*% x$beta) ### use this instead of resid(), since this guarantees that the length is correct ### create identity matrix if (x$sparse) { I <- Diagonal(x$k) } else { I <- diag(x$k) } if (x$withS) { # u^ = DZ'W(y - Xb) = DZ'We, where W = M^-1 # note: vpred = var(u^ - u) out <- vector(mode="list", length=x$sigma2s) names(out) <- x$s.names for (j in seq_len(x$sigma2s)) { if (verbose) message(mstyle$message(paste0("Computing BLUPs for '", paste0("~ 1 | ", x$s.names[j]), "' term ... ")), appendLF = FALSE) if (x$Rfix[j]) { if (x$sparse) { D <- x$sigma2[j] * Matrix(x$R[[j]], sparse=TRUE) } else { D <- x$sigma2[j] * x$R[[j]] } } else { if (x$sparse) { D <- x$sigma2[j] * Diagonal(x$s.nlevels[j]) } else { D <- x$sigma2[j] * diag(x$s.nlevels[j]) } } DZtW <- D %*% t(x$Z.S[[j]]) %*% W pred <- as.vector(DZtW %*% cbind(ei)) pred[abs(pred) < 100 * .Machine$double.eps] <- 0 #vpred <- D - (DZtW %*% x$Z.S[[j]] %*% D - DZtW %*% x$X %*% stXWX %*% t(x$X) %*% W %*% x$Z.S[[j]] %*% D) vpred <- D - (DZtW %*% (I - Hmat) %*% x$Z.S[[j]] %*% D) # this one is the same as ranef.rma.uni() for standard RE/ME models #vpred <- DZtW %*% (I - Hmat) %*% x$Z.S[[j]] %*% D # = var(u^) #vpred <- D - (DZtW %*% x$Z.S[[j]] %*% D) # same as lme4::ranef() #vpred <- DZtW %*% x$Z.S[[j]] %*% D if (is.element(x$test, c("knha","adhoc","t"))) { ddf <- .ddf.calc(x$dfs, k=x$k, p=x$p, mf.s=x$mf.s[[j]], beta=FALSE) crit <- qt(level/2, df=ddf, lower.tail=FALSE) } se <- sqrt(diag(vpred)) pi.lb <- c(pred - crit * se) pi.ub <- c(pred + crit * se) pred <- data.frame(intrcpt=pred, se=se, pi.lb=pi.lb, pi.ub=pi.ub) if (na.act == "na.omit") { rownames(pred) <- x$s.levels[[j]] out[[j]] <- pred } if (na.act == "na.exclude" || na.act == "na.pass") { ### determine which levels were removed s.levels.r <- !is.element(x$s.levels.f[[j]], x$s.levels[[j]]) NAs <- rep(NA_real_, x$s.nlevels.f[j]) tmp <- data.frame(intrcpt=NAs, se=NAs, pi.lb=NAs, pi.ub=NAs) tmp[!s.levels.r,] <- pred pred <- tmp rownames(pred) <- x$s.levels.f[[j]] out[[j]] <- pred } if (expand) { rows <- as.vector(x$Z.S[[j]] %*% seq_along(x$s.levels[[j]])) pred <- pred[rows,] rnames <- x$s.levels[[j]][rows] rownames(pred) <- .make.unique(x$s.levels[[j]][rows]) out[[j]] <- pred } if (verbose) message(mstyle$message("Done!")) } } if (x$withG) { if (is.element(x$struct[1], c("GEN","GDIAG"))) { if (verbose) message(mstyle$message("Computation of BLUPs not currently available for struct=\"GEN\".")) } else { if (verbose) message(mstyle$message(paste0("Computing BLUPs for '", paste(x$g.names, collapse=" | "), "' term ... ")), appendLF = FALSE) G <- (x$Z.G1 %*% x$G %*% t(x$Z.G1)) * tcrossprod(x$Z.G2) GW <- G %*% W pred <- as.vector(GW %*% cbind(ei)) pred[abs(pred) < 100 * .Machine$double.eps] <- 0 #vpred <- G - (GW %*% G - GW %*% x$X %*% stXWX %*% t(x$X) %*% W %*% G) vpred <- G - (GW %*% (I - Hmat) %*% G) if (is.element(x$test, c("knha","adhoc","t"))) { ddf <- .ddf.calc(x$dfs, k=x$k, p=x$p, mf.g=x$mf.g[[2]], beta=FALSE) crit <- qt(level/2, df=ddf, lower.tail=FALSE) } se <- sqrt(diag(vpred)) pi.lb <- c(pred - crit * se) pi.ub <- c(pred + crit * se) pred <- data.frame(intrcpt=pred, se=se, pi.lb=pi.lb, pi.ub=pi.ub) nvars <- ncol(x$mf.g) if (is.element(x$struct[1], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { r.names <- paste(formatC(x$ids[x$not.na], format="f", digits=0, width=max(nchar(x$ids[x$not.na]))), x$mf.g[[nvars]], sep=" | ") } else { #r.names <- paste(x$mf.g[[1]], x$mf.g[[2]], sep=" | ") r.names <- paste(sprintf(paste0("%", max(nchar(paste(x$mf.g[[1]]))), "s", collapse=""), x$mf.g[[1]]), x$mf.g[[nvars]], sep=" | ") } is.dup <- duplicated(r.names) pred <- pred[!is.dup,] rownames(pred) <- r.names[!is.dup] if (is.element(x$struct[1], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { #r.order <- order(x$mf.g[[nvars]][!is.dup], seq_len(x$k)[!is.dup]) r.order <- seq_len(x$k) } else { r.order <- order(x$mf.g[[2]][!is.dup], x$mf.g[[1]][!is.dup]) } pred <- pred[r.order,] out <- c(out, list(pred)) #names(out)[length(out)] <- paste(x$g.names, collapse=" | ") names(out)[length(out)] <- paste0(x$formulas[[1]], collapse="") if (verbose) message(mstyle$message("Done!")) } } if (x$withH) { if (is.element(x$struct[2], c("GEN","GDIAG"))) { if (verbose) message(mstyle$message("Computation of BLUPs not currently available for struct=\"GEN\".")) } else { if (verbose) message(mstyle$message(paste0("Computing BLUPs for '", paste(x$h.names, collapse=" | "), "' term ... ")), appendLF = FALSE) H <- (x$Z.H1 %*% x$H %*% t(x$Z.H1)) * tcrossprod(x$Z.H2) HW <- H %*% W pred <- as.vector(HW %*% cbind(ei)) pred[abs(pred) < 100 * .Machine$double.eps] <- 0 #vpred <- H - (HW %*% H - HW %*% x$X %*% stXWX %*% t(x$X) %*% W %*% H) vpred <- H - (HW %*% (I - Hmat) %*% H) if (is.element(x$test, c("knha","adhoc","t"))) { ddf <- .ddf.calc(x$dfs, k=x$k, p=x$p, mf.h=x$mf.h[[2]], beta=FALSE) crit <- qt(level/2, df=ddf, lower.tail=FALSE) } se <- sqrt(diag(vpred)) pi.lb <- c(pred - crit * se) pi.ub <- c(pred + crit * se) pred <- data.frame(intrcpt=pred, se=se, pi.lb=pi.lb, pi.ub=pi.ub) nvars <- ncol(x$mf.h) if (is.element(x$struct[2], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { r.names <- paste(formatC(x$ids[x$not.na], format="f", digits=0, width=max(nchar(x$ids[x$not.na]))), x$mf.h[[nvars]], sep=" | ") } else { #r.names <- paste(x$mf.h[[1]], x$mf.h[[2]], sep=" | ") r.names <- paste(sprintf(paste0("%", max(nchar(paste(x$mf.h[[1]]))), "s", collapse=""), x$mf.h[[1]]), x$mf.h[[nvars]], sep=" | ") } is.dup <- duplicated(r.names) pred <- pred[!is.dup,] rownames(pred) <- r.names[!is.dup] if (is.element(x$struct[2], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYBM","PHYPL","PHYPD","GEN","GDIAG"))) { #r.order <- order(x$mf.h[[nvars]][!is.dup], seq_len(x$k)[!is.dup]) r.order <- seq_len(x$k) } else { r.order <- order(x$mf.h[[2]][!is.dup], x$mf.h[[1]][!is.dup]) } pred <- pred[r.order,] out <- c(out, list(pred)) #names(out)[length(out)] <- paste(x$h.names, collapse=" | ") names(out)[length(out)] <- paste0(x$formulas[[2]], collapse="") if (verbose) message(mstyle$message("Done!")) } } if (verbose) cat("\n") ######################################################################### ### if requested, apply transformation function if (is.function(transf)) { if (is.null(targs)) { out <- lapply(out, transf) } else { out <- lapply(out, transf, targs) } out <- lapply(out, function(x) x[,-2,drop=FALSE]) transf <- TRUE } ### make sure order of intervals is always increasing #tmp <- .psort(pi.lb, pi.ub) #pi.lb <- tmp[,1] #pi.ub <- tmp[,2] ######################################################################### if (is.null(out)) { return() } else { return(out) } } metafor/R/rstudent.rma.peto.r0000644000176200001440000000464014247651714015706 0ustar liggesusersrstudent.rma.peto <- function(model, digits, progbar=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(model), must="rma.peto") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) x <- model if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } ddd <- list(...) .chkdots(ddd, c("time")) if (.isTRUE(ddd$time)) time.start <- proc.time() ######################################################################### delpred <- rep(NA_real_, x$k.f) vdelpred <- rep(NA_real_, x$k.f) ### elements that need to be returned outlist <- "beta=beta, vb=vb" ### note: skipping NA tables if (progbar) pbar <- pbapply::startpb(min=0, max=x$k.f) for (i in seq_len(x$k.f)) { if (progbar) pbapply::setpb(pbar, i) if (!x$not.na[i]) next args <- list(ai=x$outdat.f$ai, bi=x$outdat.f$bi, ci=x$outdat.f$ci, di=x$outdat.f$di, add=x$add, to=x$to, drop00=x$drop00, level=x$level, subset=-i, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.peto, args)), silent=TRUE) if (inherits(res, "try-error")) next delpred[i] <- res$beta vdelpred[i] <- res$vb } if (progbar) pbapply::closepb(pbar) resid <- x$yi.f - delpred resid[abs(resid) < 100 * .Machine$double.eps] <- 0 #resid[abs(resid) < 100 * .Machine$double.eps * median(abs(resid), na.rm=TRUE)] <- 0 ### see lm.influence seresid <- sqrt(x$vi.f + vdelpred) stresid <- resid / seresid ######################################################################### if (na.act == "na.omit") { out <- list(resid=resid[x$not.na.yivi], se=seresid[x$not.na.yivi], z=stresid[x$not.na.yivi]) out$slab <- x$slab[x$not.na.yivi] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(resid=resid, se=seresid, z=stresid) out$slab <- x$slab } if (na.act == "na.fail" && any(!x$not.na.yivi)) stop(mstyle$stop("Missing values in results.")) out$digits <- digits if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(out) <- "list.rma" return(out) } metafor/R/replmiss.r0000644000176200001440000000172014401676632014142 0ustar liggesusersreplmiss <- function(x, y, data) { mstyle <- .get.mstyle("crayon" %in% .packages()) ### check if data argument has been specified if (missing(data)) data <- NULL if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } mf <- match.call() x <- .getx("x", mf=mf, data=data, checknull=FALSE) y <- .getx("y", mf=mf, data=data, checknull=FALSE) if (length(y) == 0L) return(x) if (length(x) == 0L) x <- rep(NA_real_, length(y)) ### in case user specifies a constant to use for replacement if (length(y) == 1L) y <- rep(y, length(x)) ### check that x and y are of the same length if (length(x) != length(y)) stop(mstyle$stop("Length of 'x' and 'y' is not the same.")) #x <- ifelse(is.na(x), y, x) # this is quite a bit slower than the following is.na.x <- is.na(x) x[is.na.x] <- y[is.na.x] return(x) } metafor/R/formatters.r0000644000176200001440000001272714434120342014467 0ustar liggesusers############################################################################ fmtp <- function(p, digits=4, pname="", equal=FALSE, sep=FALSE, add0=FALSE, quote=FALSE) { p[p < 0] <- 0 p[p > 1] <- 1 digits <- max(digits, 1) cutoff <- paste(c(".", rep(0,digits-1),1), collapse="") ncutoff <- as.numeric(cutoff) equal <- ifelse(equal, "=", "") if (sep) { if (pname != "") pname <- paste0(pname, " ") sep <- " " } else { sep <- "" } out <- ifelse(is.na(p), paste0(pname, equal, sep, "NA"), ifelse(p >= ncutoff, paste0(pname, equal, sep, formatC(p, digits=digits, format="f")), paste0(pname, "<", sep, ifelse(add0, "0", ""), cutoff))) if (!quote) out <- noquote(out) return(out) } fmtx <- function(x, digits=4, flag="", quote=FALSE, ...) { # in case x is a data frame / matrix with two dimensions if (length(dim(x)) == 2L) { if (length(digits) == 1L) digits <- rep(digits, ncol(x)) out <- matrix("", nrow=nrow(x), ncol=ncol(x)) rownames(out) <- rownames(x) colnames(out) <- colnames(x) for (j in seq_len(ncol(x))) out[,j] <- fmtx(x[,j], digits=digits[[j]], flag=flag, ...) if (!quote) out <- noquote(out, right=TRUE) return(out) } ddd <- list(...) if (is.null(ddd$addwidth)) { width <- NULL } else { width <- digits + ddd$addwidth } if (is.null(ddd$drop0ifint)) { drop0ifint <- FALSE } else { drop0ifint <- ddd$drop0ifint } if (is.null(ddd$add0)) { add0 <- TRUE } else { add0 <- ddd$add0 } if (!is.null(ddd$thresh)) { if (length(x) != 1L) stop("Can only use 'thresh' when 'x' is a scalar.") if (isTRUE(abs(x) <= ddd$thresh)) digits <- 0 } if (is.null(ddd$postfix)) { postfix <- "" } else { postfix <- ddd$postfix } out <- sapply(x, function(x) { if (is.na(x)) return(paste0("NA", postfix)) out <- formatC(x, format="f", digits=digits, flag=flag, width=width, drop0trailing=drop0ifint && is.integer(digits)) if (!add0) out <- gsub("0\\.", ".", out) out <- paste0(out, postfix) return(out) }) if (!quote) out <- noquote(out, right=TRUE) return(out) } ############################################################################ fmtt <- function(val, tname, df, df1, df2, pval, digits=4, pname="p-val", format=1, sep=TRUE, quote=FALSE, call=FALSE, ...) { if (length(val) != 1L) stop("Argument 'val' must be a scalar.") if (!is.element(format, c(1,2))) stop("Argument 'format' can only be equal to 1 or 2.") if (missing(pval)) stop("Must specify the 'pval' argument.") sepset <- sep if (sep) { sep <- " " } else { sep <- "" } ddd <- list(...) if (is.null(ddd$flag)) { flag <- "" } else { flag <- ddd$flag } if (length(digits) == 1L) digits <- c(test = digits, pval = digits) if (length(digits) == 2L) names(digits) <- c("test", "pval") if (any(!is.element(c("test","pval"), names(digits)))) stop("Argument 'digits' must have a 'test' and a 'pval' element.") if (format == 1) { if (missing(df)) { if (!missing(df1) && !missing(df2)) { out <- bquote(paste(.(tname), "(df1", .(sep), "=", .(sep), .(df1), ",", .(sep), "df2", .(sep), "=", .(sep), .(round(df2,2)), ")", .(sep), "=", .(sep), .(fmtx(val, digits[["test"]], flag=flag)), ", ", .(pname), .(sep), .(fmtp(pval, digits[["pval"]], equal=TRUE, sep=sepset)), sep="")) #paste0(tname, "(df1 = ", df1, ", df2 = ", round(df2,2), ") = ", fmtx(val, digits[["test"]]), ", ", pname, fmtp(pval, digits[["pval"]], equal=TRUE, sep=TRUE)) } else { out <- bquote(paste(.(tname), .(sep), "=", .(sep), .(fmtx(val, digits[["test"]], flag=flag)), ", ", .(pname), .(sep), .(fmtp(pval, digits[["pval"]], equal=TRUE, sep=sepset)), sep="")) } } else { out <- bquote(paste(.(tname), "(df", .(sep), "=", .(sep), .(df), ")", .(sep), "=", .(sep), .(fmtx(val, digits[["test"]], flag=flag)), ", ", .(pname), .(sep), .(fmtp(pval, digits[["pval"]], equal=TRUE, sep=sepset)), sep="")) #paste0(tname, "(df = ", df, ") = ", fmtx(val, digits[["test"]]), ", ", pname, fmtp(pval, digits[["pval"]], equal=TRUE, sep=TRUE)) } } if (format[[1]] == 2) { if (missing(df)) { if (!missing(df1) && !missing(df2)) { out <- bquote(paste(.(tname), .(sep), "=", .(sep), .(fmtx(val, digits[["test"]], flag=flag)), ", df1", .(sep), "=", .(sep), .(df1), ", df2", .(sep), "=", .(sep), .(round(df2,2)), ", ", .(pname), .(sep), .(fmtp(pval, digits[["pval"]], equal=TRUE, sep=sepset)), sep="")) } else { out <- bquote(paste(.(tname), .(sep), "=", .(sep), .(fmtx(val, digits[["test"]], flag=flag)), ", ", .(pname), .(sep), .(fmtp(pval, digits[["pval"]], equal=TRUE, sep=sepset)), sep="")) } } else { out <- bquote(paste(.(tname), .(sep), "=", .(sep), .(fmtx(val, digits[["test"]], flag=flag)), ", df", .(sep), "=", .(sep), .(df), ", ", .(pname), .(sep), .(fmtp(pval, digits[["pval"]], equal=TRUE, sep=sepset)), sep="")) } } if (call) { out$sep <- NULL return(out) } else { out <- eval(out) if (!quote) out <- noquote(out) return(out) } } ############################################################################ metafor/R/methods.anova.rma.r0000644000176200001440000001070514401670246015626 0ustar liggesusers############################################################################ as.data.frame.anova.rma <- function(x, ...) { .chkclass(class(x), must="anova.rma") if (x$type == "Wald.btt") { tab <- data.frame(coefs = .format.btt(x$btt), QM = x$QM, df = round(x$QMdf[1], 2), pval = x$QMp) if (is.element(x$test, c("knha","adhoc","t"))) { names(tab)[2:3] <- c("Fval", "df1") tab <- cbind(tab[1:3], df2 = round(x$QMdf[2], 2), tab[4]) } } if (x$type == "Wald.att") { tab <- data.frame(coefs = .format.btt(x$att), QS = x$QS, df = round(x$QSdf[1], 2), pval = x$QSp) if (is.element(x$test, c("knha","adhoc","t"))) { names(tab)[2:3] <- c("Fval", "df1") tab <- cbind(tab[1:3], df2 = round(x$QSdf[2], 2), tab[4]) } } if (x$type == "Wald.Xb") { if (is.element(x$test, c("knha","adhoc","t"))) { tab <- data.frame(hyp=x$hyp[[1]], estimate=c(x$Xb), se=x$se, tval=x$zval, df=round(x$ddf,2), pval=x$pval) } else { tab <- data.frame(hyp=x$hyp[[1]], estimate=c(x$Xb), se=x$se, zval=x$zval, pval=x$pval) } rownames(tab) <- paste0(seq_len(x$m), ":") return(tab) } if (x$type == "Wald.Za") { if (is.element(x$test, c("knha","adhoc","t"))) { tab <- data.frame(hyp=x$hyp[[1]], estimate=c(x$Za), se=x$se, tval=x$zval, df=round(x$ddf,2), pval=x$pval) } else { tab <- data.frame(hyp=x$hyp[[1]], estimate=c(x$Za), se=x$se, zval=x$zval, pval=x$pval) } rownames(tab) <- paste0(seq_len(x$m), ":") return(tab) } if (x$type == "LRT") { tab <- data.frame(c(x$parms.f, x$parms.r), c(x$fit.stats.f["AIC"], x$fit.stats.r["AIC"]), c(x$fit.stats.f["BIC"], x$fit.stats.r["BIC"]), c(x$fit.stats.f["AICc"], x$fit.stats.r["AICc"]), c(x$fit.stats.f["ll"], x$fit.stats.r["ll"]), c(NA_real_, x$LRT), c(NA_real_, x$pval), c(x$QE.f, x$QE.r), c(x$tau2.f, x$tau2.r), c(NA_real_, NA_real_)) colnames(tab) <- c("df", "AIC", "BIC", "AICc", "logLik", "LRT", "pval", "QE", "tau^2", "R^2") rownames(tab) <- c("Full", "Reduced") tab["Full",c("LRT","pval")] <- NA_real_ tab["Full","R^2"] <- NA_real_ tab["Reduced","R^2"] <- x$R2 ### remove tau^2 column if full model is a FE/EE/CE model or tau2.f/tau2.r is NA if (is.element(x$method, c("FE","EE","CE")) || (is.na(x$tau2.f) || is.na(x$tau2.r))) tab <- tab[-which(names(tab) == "tau^2")] ### remove R^2 column if full model is a rma.mv or rma.ls model if (is.element("rma.mv", x$class.f) || is.element("rma.ls", x$class.f)) tab <- tab[-which(names(tab) == "R^2")] } return(tab) } as.data.frame.list.anova.rma <- function(x, ...) { .chkclass(class(x), must="list.anova.rma") if (x[[1]]$type == "Wald.btt") { tab <- data.frame(spec = names(x), coefs = sapply(x, function(x) .format.btt(x$btt)), QM = sapply(x, function(x) x$QM), df = sapply(x, function(x) round(x$QMdf[1], 2)), pval = sapply(x, function(x) x$QMp)) } if (x[[1]]$type == "Wald.att") { tab <- data.frame(spec = names(x), coefs = sapply(x, function(x) .format.btt(x$att)), QS = sapply(x, function(x) x$QS), df = sapply(x, function(x) round(x$QSdf[1], 2)), pval = sapply(x, function(x) x$QSp)) } if (is.element(x[[1]]$test, c("knha","adhoc","t"))) { names(tab)[3:4] <- c("Fval", "df1") if (x[[1]]$type == "Wald.btt") tab <- cbind(tab[1:4], df2 = sapply(x, function(x) round(x$QMdf[2], 2)), tab[5]) if (x[[1]]$type == "Wald.att") tab <- cbind(tab[1:4], df2 = sapply(x, function(x) round(x$QSdf[2], 2)), tab[5]) } # if all btt/att specifications are numeric, remove the 'spec' column if (all(substr(tab$spec, 1, 1) %in% as.character(1:9))) tab$spec <- NULL # just use numbers for row names rownames(tab) <- NULL return(tab) } ############################################################################ metafor/R/plot.profile.rma.r0000644000176200001440000000561214473046136015502 0ustar liggesusersplot.profile.rma <- function(x, xlim, ylim, pch=19, xlab, ylab, main, refline=TRUE, cline=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="profile.rma") .start.plot() if (dev.cur() == 1) { par(mfrow=n2mfrow(x$comps)) #on.exit(par(mfrow=c(1,1)), add=TRUE) } missing.xlim <- missing(xlim) missing.ylim <- missing(ylim) missing.xlab <- missing(xlab) missing.ylab <- missing(ylab) missing.main <- missing(main) ### filter out some arguments for the plot() function lplot <- function(..., time, LB, startmethod, sub1) plot(...) lpoints <- function(..., time, LB, startmethod, sub1, log) points(...) # need 'log' here so profile(res, log="x") doesn't throw a warning ######################################################################### if (x$comps == 1) { if (missing.xlim) xlim <- x$xlim if (missing.ylim) ylim <- x$ylim if (missing.xlab) xlab <- x$xlab if (missing.ylab) ylab <- paste(ifelse(x$method=="REML", "Restricted ", ""), "Log-Likelihood", sep="") if (missing.main) main <- x$title if (min(x[[1]]) <= x$vc && max(x[[1]]) >= x$vc) { pos <- which(x[[1]] >= x$vc)[1] x[[1]] <- c(x[[1]][seq_len(pos-1)], x$vc, x[[1]][pos:length(x[[1]])]) x[[2]] <- c(x[[2]][seq_len(pos-1)], x$maxll, x[[2]][pos:length(x[[2]])]) } lplot(x[[1]], x[[2]], type="n", xlab=xlab, ylab=ylab, main=main, bty="l", xlim=xlim, ylim=ylim, ...) if (refline) { abline(v=x$vc, lty="dotted") abline(h=x$maxll, lty="dotted") } if (cline) abline(h=x$maxll - qchisq(0.95, df=1)/2, lty="dotted") lpoints(x[[1]], x[[2]], type="o", pch=pch, ...) } else { for (j in seq_len(x$comps)) { if (missing.xlim) xlim <- x[[j]]$xlim if (missing.ylim) ylim <- x[[j]]$ylim if (missing.xlab) { xlab <- x[[j]]$xlab } else { if (length(xlab) == 1L) { xlab <- rep(xlab, x$comps) } } if (missing.ylab) { ylab <- paste(ifelse(x[[j]]$method=="REML", "Restricted ", ""), "Log-Likelihood", sep="") } else { if (length(ylab) == 1L) { ylab <- rep(ylab, x$comps) } } if (missing.main) { main <- x[[j]]$title } else { if (length(main) == 1L) { main <- rep(main, x$comps) } } lplot(x[[j]], xlim=xlim, ylim=ylim, pch=pch, xlab=if (missing.xlab) xlab else xlab[j], ylab=if (missing.ylab) ylab else ylab[j], main=if (missing.main) main else main[j], cline=cline, ...) } } } metafor/R/blup.rma.uni.r0000644000176200001440000000620014401666005014605 0ustar liggesusersblup.rma.uni <- function(x, level, digits, transf, targs, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.uni", notav=c("rma.uni.selmodel", "rma.gen")) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (missing(level)) level <- x$level if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL level <- .level(level) if (is.element(x$test, c("knha","adhoc","t"))) { crit <- qt(level/2, df=x$ddf, lower.tail=FALSE) } else { crit <- qnorm(level/2, lower.tail=FALSE) } ### TODO: check computations for user-defined weights if (!is.null(x$weights) || !x$weighted) stop(mstyle$stop("Extraction of random effects not available for models with non-standard weights.")) ######################################################################### pred <- rep(NA_real_, x$k.f) vpred <- rep(NA_real_, x$k.f) ### see Appendix in: Raudenbush, S. W., & Bryk, A. S. (1985). Empirical ### Bayes meta-analysis. Journal of Educational Statistics, 10(2), 75-98 li <- x$tau2.f / (x$tau2.f + x$vi.f) for (i in seq_len(x$k.f)[x$not.na]) { ### note: skipping NA cases Xi <- matrix(x$X.f[i,], nrow=1) pred[i] <- li[i] * x$yi.f[i] + (1 - li[i]) * Xi %*% x$beta vpred[i] <- li[i] * x$vi.f[i] + (1 - li[i])^2 * Xi %*% tcrossprod(x$vb,Xi) } se <- sqrt(vpred) pi.lb <- pred - crit * se pi.ub <- pred + crit * se ######################################################################### ### if requested, apply transformation function to 'pred' and interval bounds if (is.function(transf)) { if (is.null(targs)) { pred <- sapply(pred, transf) se <- rep(NA_real_, x$k.f) pi.lb <- sapply(pi.lb, transf) pi.ub <- sapply(pi.ub, transf) } else { pred <- sapply(pred, transf, targs) se <- rep(NA_real_, x$k.f) pi.lb <- sapply(pi.lb, transf, targs) pi.ub <- sapply(pi.ub, transf, targs) } transf <- TRUE } ### make sure order of intervals is always increasing tmp <- .psort(pi.lb, pi.ub) pi.lb <- tmp[,1] pi.ub <- tmp[,2] ######################################################################### if (na.act == "na.omit") { out <- list(pred=pred[x$not.na], se=se[x$not.na], pi.lb=pi.lb[x$not.na], pi.ub=pi.ub[x$not.na]) out$slab <- x$slab[x$not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(pred=pred, se=se, pi.lb=pi.lb, pi.ub=pi.ub) out$slab <- x$slab } if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) ######################################################################### out$digits <- digits out$transf <- transf class(out) <- "list.rma" return(out) } metafor/R/leave1out.rma.uni.r0000644000176200001440000001055614440116046015557 0ustar liggesusersleave1out.rma.uni <- function(x, digits, transf, targs, progbar=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.uni", notav=c("robust.rma", "rma.ls", "rma.gen", "rma.uni.selmodel")) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (!x$int.only) stop(mstyle$stop("Method only applicable to models without moderators.")) if (x$k == 1) stop(mstyle$stop("Stopped because k = 1.")) if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL ddd <- list(...) .chkdots(ddd, c("time")) if (.isTRUE(ddd$time)) time.start <- proc.time() ######################################################################### beta <- rep(NA_real_, x$k.f) se <- rep(NA_real_, x$k.f) zval <- rep(NA_real_, x$k.f) pval <- rep(NA_real_, x$k.f) ci.lb <- rep(NA_real_, x$k.f) ci.ub <- rep(NA_real_, x$k.f) QE <- rep(NA_real_, x$k.f) QEp <- rep(NA_real_, x$k.f) tau2 <- rep(NA_real_, x$k.f) I2 <- rep(NA_real_, x$k.f) H2 <- rep(NA_real_, x$k.f) ### elements that need to be returned outlist <- "beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, QE=QE, QEp=QEp, tau2=tau2, I2=I2, H2=H2" ### note: skipping NA cases ### also: it is possible that model fitting fails, so that generates more NAs (these NAs will always be shown in output) if (progbar) pbar <- pbapply::startpb(min=0, max=x$k.f) for (i in seq_len(x$k.f)) { if (progbar) pbapply::setpb(pbar, i) if (!x$not.na[i]) next args <- list(yi=x$yi.f, vi=x$vi.f, weights=x$weights.f, intercept=TRUE, method=x$method, weighted=x$weighted, test=x$test, level=x$level, tau2=ifelse(x$tau2.fix, x$tau2, NA), control=x$control, subset=-i, skipr2=TRUE, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=TRUE) if (inherits(res, "try-error")) next beta[i] <- res$beta se[i] <- res$se zval[i] <- res$zval pval[i] <- res$pval ci.lb[i] <- res$ci.lb ci.ub[i] <- res$ci.ub QE[i] <- res$QE QEp[i] <- res$QEp tau2[i] <- res$tau2 I2[i] <- res$I2 H2[i] <- res$H2 } if (progbar) pbapply::closepb(pbar) ######################################################################### ### if requested, apply transformation function if (is.function(transf)) { if (is.null(targs)) { beta <- sapply(beta, transf) se <- rep(NA_real_, x$k.f) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) } else { beta <- sapply(beta, transf, targs) se <- rep(NA_real_, x$k.f) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) } transf <- TRUE } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] ######################################################################### if (na.act == "na.omit") { out <- list(estimate=beta[x$not.na], se=se[x$not.na], zval=zval[x$not.na], pval=pval[x$not.na], ci.lb=ci.lb[x$not.na], ci.ub=ci.ub[x$not.na], Q=QE[x$not.na], Qp=QEp[x$not.na], tau2=tau2[x$not.na], I2=I2[x$not.na], H2=H2[x$not.na]) out$slab <- x$slab[x$not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(estimate=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, Q=QE, Qp=QEp, tau2=tau2, I2=I2, H2=H2) out$slab <- x$slab } if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) if (is.element(x$test, c("knha","adhoc","t"))) names(out)[3] <- "tval" ### remove tau2 for FE/EE/CE models if (is.element(x$method, c("FE","EE","CE"))) out <- out[-9] out$digits <- digits out$transf <- transf if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(out) <- "list.rma" return(out) } metafor/R/permutest.r0000644000176200001440000000007013457322061014323 0ustar liggesuserspermutest <- function(x, ...) UseMethod("permutest") metafor/R/radial.r0000644000176200001440000000007713457322061013536 0ustar liggesusersradial <- galbraith <- function(x, ...) UseMethod("radial") metafor/R/misc.func.hidden.r0000644000176200001440000020577414473372001015432 0ustar liggesusers############################################################################ ### function to set default 'btt' value(s) or check specified 'btt' values .set.btt <- function(btt, p, int.incl, Xnames, fixed=FALSE) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (missing(btt) || is.null(btt)) { if (p > 1L) { ### if the model matrix has more than one column if (int.incl) { btt <- seq.int(from=2, to=p) ### and the model has an intercept term, test all coefficients except the intercept } else { btt <- seq_len(p) ### and the model does not have an intercept term, test all coefficients } } else { btt <- 1L ### if the model matrix has a single column, test that single coefficient } } else { if (is.character(btt)) { btt <- grep(btt, Xnames, fixed=fixed) if (length(btt) == 0L) stop(mstyle$stop("Cannot identify coefficient(s) corresponding to the specified 'btt' string."), call.=FALSE) } else { ### round, take unique values, sort, and turn into integer(s) btt <- as.integer(sort(unique(round(btt)))) ### check for mix of positive and negative values if (any(btt < 0) && any(btt > 0)) stop(mstyle$stop("Cannot mix positive and negative 'btt' values."), call.=FALSE) ### keep/remove from 1:p vector as specified btt <- seq_len(p)[btt] ### (1:5)[5:6] yields c(5, NA) so remove NAs if this happens btt <- btt[!is.na(btt)] ### make sure that at least one valid value is left if (length(btt) == 0L) stop(mstyle$stop("Non-existent coefficients specified via 'btt'."), call.=FALSE) } } return(btt) } ### function to format 'btt' value(s) for printing .format.btt <- function(btt) { sav <- c() if (length(btt) > 1L) { btt <- sort(btt) while (length(btt) > 0L) { x <- rle(diff(btt)) if (x$values[1] == 1 && length(x$values) != 0L) { sav <- c(sav, c(btt[1], ":", btt[x$lengths[1] + 1])) btt <- btt[-c(1:(x$lengths[1] + 1))] #sav <- c(sav, ", ") # this adds a space between multiple a:b sets sav <- c(sav, ",") } else { sav <- c(sav, btt[1], ",") btt <- btt[-1] } } sav <- paste0(sav[-length(sav)], collapse="") } else { sav <- paste0(btt) } return(sav) } ############################################################################ ### pairwise sorting of the elements of two vectors .psort <- function(x,y) { ### t(apply(xy, 1, sort)) would be okay, but problematic if there are NAs; ### either they are removed completely (na.last=NA) or they are always put ### first/last (na.last=FALSE/TRUE); but we just want to leave the NAs in ### their position! if (is.null(x) || length(x) == 0L) ### need to catch this return(NULL) if (missing(y)) { if (is.matrix(x)) { xy <- x } else { xy <- rbind(x) ### in case x is just a vector } } else { xy <- cbind(x,y) } n <- nrow(xy) for (i in seq_len(n)) { if (anyNA(xy[i,])) next xy[i,] <- sort(xy[i,]) } colnames(xy) <- NULL return(xy) } ############################################################################ ### function to take the square root of a vector of numbers, giving NA for negative numbers (without a warning) .sqrt <- function(x) sapply(x, function(x) if (is.na(x) || x < 0) NA_real_ else sqrt(x)) ### function to obtain the trace of a matrix .tr <- function(X) return(sum(diag(X))) ### function to check if a matrix is square .is.square <- function(X) NROW(X) == NCOL(X) ### use NROW/NCOL to better deal with scalars; compare: ### (V <- list(matrix(1, nrow=2, ncol=2), 3, c(1,4), cbind(c(2,1)))); sapply(V, function(x) nrow(x) == ncol(x)); sapply(V, function(x) NROW(x) == NCOL(x)) ### function to test whether a vector is all equal to 1s (e.g., to find intercept(s) in a model matrix) .is.intercept <- function(x, eps=1e-08) return(all(abs(x - 1) < eps)) ### function to test whether a vector is a dummy variable (i.e., consists of only 0s and 1s) .is.dummy <- function(x, eps=1e-08) return(all(abs(x) < eps | abs(x - 1) < eps)) #return(all(sapply(x, identical, 0) | sapply(x, identical, 1))) ### function to test whether something is a vector (in the sense of being atomic, not a matrix, and not NULL) .is.vector <- function(x) is.atomic(x) && !is.matrix(x) && !is.null(x) ### function to test if a string is an integer and to return the integer if so (otherwise return NA) .is.stringint <- function(x) { is.int <- grepl("^[0-9]+L?$", x) if (is.int) { x <- sub("L", "", x, fixed=TRUE) x <- as.integer(x) } else { x <- NA } return(x) } ### function to test if x is a matrix and that also covers Matrix objects .is.matrix <- function(x) is.matrix(x) || inherits(x, "Matrix") ### function to test if x is numeric but also allow a (vector of) NA .is.numeric <- function(x) { if (all(is.na(x))) return(TRUE) is.numeric(x) } ############################################################################ ### function to format p-values (no longer used; use fmtp() instead) ### if showeq=FALSE, c(.001, .00001) becomes c("0.0010", "<.0001") ### if showeq=TRUE, c(.001, .00001) becomes c("=0.0010", "<.0001") ### if add0=FALSE, "<.0001"; if add0=TRUE, "<0.0001" .pval <- function(p, digits=4, showeq=FALSE, sep="", add0=FALSE) { digits <- max(digits, 1) cutoff <- paste(c(".", rep(0,digits-1),1), collapse="") ncutoff <- as.numeric(cutoff) ifelse(is.na(p), paste0(ifelse(showeq, "=", ""), sep, "NA"), ifelse(p >= ncutoff, paste0(ifelse(showeq, "=", ""), sep, formatC(p, digits=digits, format="f")), paste0("<", sep, ifelse(add0, "0", ""), cutoff))) } ### function to format/round values in general (no longer used; use fmtx() instead) .fcf <- function(x, digits) { if (all(is.na(x))) { # since formatC(NA, format="f", digits=2) fails rep("NA", length(x)) } else { trimws(formatC(x, format="f", digits=digits)) } } ### function to handle 'level' argument .level <- function(level, allow.vector=FALSE) { if (!allow.vector && length(level) != 1L) { mstyle <- .get.mstyle("crayon" %in% .packages()) stop(mstyle$stop("Argument 'level' must specify a single value."), call.=FALSE) } if (!is.numeric(level)) { mstyle <- .get.mstyle("crayon" %in% .packages()) stop(mstyle$stop("The 'level' argument must be numeric."), call.=FALSE) } ifelse(level == 0, 1, ifelse(level >= 1, (100-level)/100, ifelse(level > .5, 1-level, level))) } ############################################################################ ### function to print a named (character) vector right aligned with ### a gap of two spaces between adjacent values and no padding .print.vector <- function(x, minfoot=NA, print.gap=2) { empty.last.colname <- colnames(x)[length(colnames(x))] == "" if (is.null(names(x))) names(x) <- seq_along(x) gap <- paste0(rep(" ", print.gap), collapse="") len.n <- nchar(names(x)) len.x <- nchar(x, keepNA=FALSE) len.max <- pmax(len.n, len.x) #format <- sapply(len.max, function(x) paste("%", x, "s", sep="")) #row.n <- paste(sprintf(format, names(x)), collapse=gap) # sprintf("%3s", "\u00b9") isn't right #row.x <- paste(sprintf(format, x), collapse=gap) #f <- function(x, n) # paste0(paste0(rep(" ", n-nchar(x)), collapse=""), x, collapse="") #row.n <- paste(mapply(f, names(x), len.max), collapse=gap) #row.x <- paste(mapply(f, unname(x), len.max), collapse=gap) if (is.na(minfoot)) { row.n <- paste(mapply(formatC, names(x), width=len.max), collapse=gap) # formatC("\u00b9", width=3) works row.x <- paste(mapply(formatC, x, width=len.max), collapse=gap) } else { row.n <- mapply(formatC, names(x), width=len.max) row.n[minfoot] <- paste0(" ", row.n[minfoot]) row.n <- paste(row.n, collapse=gap) row.x <- mapply(formatC, x, width=len.max) if (empty.last.colname) { row.x[length(row.x)] <- paste0(" ", row.x[length(row.x)]) } else { row.x[length(row.x)] <- paste0(row.x[length(row.x)], " ") } row.x <- paste(row.x, collapse=gap) } cat(row.n, "\n", row.x, "\n", sep="") } .addfootsym <- function(x, cols, footsym) { nc <- length(cols) if (length(footsym) == 1L) footsym <- rep(footsym, nc) if (length(footsym) != nc) stop(paste0("Length of 'cols' not the same as length of 'footsym' in .addfootsym()."), call.=FALSE) for (i in seq_along(cols)) { colnames(x)[cols[i]] <- paste0(colnames(x)[cols[i]], footsym[i]) x[[cols[i]]] <- paste0(x[[cols[i]]], " ") } return(x) } ############################################################################ .space <- function(x=TRUE) { if (exists(".rmspace")) { addspace <- FALSE } else { addspace <- isTRUE(getmfopt("space", default=TRUE)) } if (addspace && x) cat("\n") if (!addspace && !x) cat("\n") } .get.footsym <- function() { fs <- getmfopt("footsym") if (is.null(fs) || length(fs) != 6L) fs <- c("\u00b9", "1)", "\u00b2", "2)", "\u00b3", "3)") return(fs) } # setmfopt(footsym = c("\u00b9", "\u00b9\u207e", "\u00b2", "\u00b2\u207e", "\u00b3", "\u00b3\u207e")) ############################################################################ ### function that prints the model fitting time .print.time <- function(x) { mstyle <- .get.mstyle("crayon" %in% .packages()) hours <- floor(x/60/60) minutes <- floor(x/60) - hours*60 seconds <- round(x - minutes*60 - hours*60*60, ifelse(x > 60, 0, 2)) cat("\n") cat(mstyle$message(paste("Processing time:", hours, ifelse(hours == 0 || hours > 1, "hours,", "hour,"), minutes, ifelse(minutes == 0 || minutes > 1, "minutes,", "minute,"), seconds, ifelse(x < 60 || seconds == 0 || seconds > 1, "seconds", "second")))) cat("\n") } ############################################################################ ### function like make.unique(), but starts at .1 for the first instance ### of a repeated element .make.unique <- function(x) { if (is.null(x)) return(NULL) x <- as.character(x) ux <- unique(x) for (i in seq_along(ux)) { xiTF <- x == ux[i] xi <- x[xiTF] if (length(xi) == 1L) next x[xiTF] <- paste(xi, seq_along(xi), sep=".") } return(x) } ############################################################################ ### function to check if extra/superfluous arguments are specified via ... .chkdots <- function(ddd, okargs) { for (i in seq_along(okargs)) ddd[okargs[i]] <- NULL if (length(ddd) > 0L) { mstyle <- .get.mstyle("crayon" %in% .packages()) warning(mstyle$warning(paste0("Extra argument", ifelse(length(ddd) > 1L, "s ", " "), "(", paste0("'", names(ddd), "'", collapse=", "), ") disregarded.")), call.=FALSE) } } ############################################################################ .getx <- function(x, mf, data, enclos=sys.frame(sys.parent(n=2)), checknull=TRUE, checknumeric=FALSE, default) { mstyle <- .get.mstyle("crayon" %in% .packages()) mf.getx <- match.call() dname <- deparse1(mf.getx[[match("data", names(mf.getx))]]) dname <- deparse1(mf[[match(dname, names(mf))]]) mf.x <- mf[[match(x, names(mf))]] if (!is.null(dname) && dname %in% names(data) && grepl("$", deparse1(mf.x), fixed=TRUE) || grepl("[[", deparse1(mf.x), fixed=TRUE)) data <- NULL out <- try(eval(mf.x, data, enclos), silent=TRUE) # NULL if x was not specified if (inherits(out, "try-error") || is.function(out)) stop(mstyle$stop(paste0("Cannot find the object/variable ('", deparse(mf.x), "') specified for the '", x, "' argument.")), call.=FALSE) # note: is.function() check catches case where 'vi' is the utils::vi() function and other shenanigans # check if x is actually one of the elements in the call spec <- x %in% names(mf) # out could be NULL if it is not a specified argument; if so, apply default if there is one if (is.null(out) && !spec && !missing(default)) out <- default if (checknull) { # when using something like fun(dat$blah) and blah doesn't exist in dat, then get NULL if (spec && is.null(out)) { mf.txt <- deparse(mf.x) if (mf.txt == "NULL") { mf.txt <- " " } else { mf.txt <- paste0(" ('", mf.txt, "') ") } stop(mstyle$stop(paste0(deparse(mf)[1], ":\nThe object/variable", mf.txt, "specified for the '", x, "' argument is NULL.")), call.=FALSE) } } if (checknumeric && !is.null(out) && !is.list(out) && !.is.numeric(out[1])) # using [1] so is.numeric(Matrix(1:3)[1]) works stop(mstyle$stop(paste0("The object/variable specified for the '", x, "' argument is not numeric.")), call.=FALSE) return(out) } .getfromenv <- function(what, element, envir=.metafor, default=NULL) { x <- try(get(what, envir=envir, inherits=FALSE), silent=TRUE) if (inherits(x, "try-error")) { return(default) } else { if (missing(element)) { return(x) } else { x <- x[[element]] if (is.null(x)) { return(default) } else { return(x) } } } } ### a version of do.call() that allows for the arguments to be passed via ... (i.e., can either be a list or not) and removes NULL arguments .do.call <- function(fun, ...) { if (is.list(..1) && ...length() == 1L) { args <- c(...) } else { args <- list(...) } args <- args[!sapply(args, is.null)] do.call(fun, args) } ############################################################################ .chkclass <- function(class, must, notap, notav, type="Method") { mstyle <- .get.mstyle("crayon" %in% .packages()) obj <- as.character(match.call()[2]) obj <- substr(obj, 7, nchar(obj)-1) if (!missing(must) && !is.element(must, class)) stop(mstyle$stop(paste0("Argument '", obj, "' must be an object of class \"", must, "\".")), call.=FALSE) if (!missing(notap) && any(is.element(notap, class))) stop(mstyle$stop(paste0(type, " not applicable to objects of class \"", class[1], "\".")), call.=FALSE) #stop(mstyle$stop(paste0("Method not applicable to objects of class \"", paste0(class, collapse=", "), "\".")), call.=FALSE) if (!missing(notav) && any(is.element(notav, class))) stop(mstyle$stop(paste0(type, " not available for objects of class \"", class[1], "\".")), call.=FALSE) #stop(mstyle$stop(paste0("Method not available for objects of class \"", paste0(class, collapse=", "), "\".")), call.=FALSE) } ############################################################################ .chkviarg <- function(x) { runvicheck <- .getfromenv("runvicheck", default=TRUE) if (runvicheck) { x <- deparse(x) xl <- tolower(x) ok <- TRUE # starts with 'se' or 'std' if (any(grepl("^se", xl))) ok <- FALSE if (any(grepl("^std", xl))) ok <- FALSE # ends with 'se' or 'std' if (any(grepl("se$", xl))) ok <- FALSE if (any(grepl("std$", xl))) ok <- FALSE # catch cases where vi=$se and vi=$std if (any(grepl("^[[:alpha:]][[:alnum:]_.]*\\$se", xl))) ok <- FALSE if (any(grepl("^[[:alpha:]][[:alnum:]_.]*\\$std", xl))) ok <- FALSE # but if ^, *, or ( appears, don't issue a warning if (any(grepl("^", xl, fixed=TRUE))) ok <- TRUE if (any(grepl("*", xl, fixed=TRUE))) ok <- TRUE if (any(grepl("(", xl, fixed=TRUE))) ok <- TRUE if (!ok) { mstyle <- .get.mstyle("crayon" %in% .packages()) warning(mstyle$warning(paste0("The 'vi' argument is for specifying the sampling variances,\nbut '", x, "' sounds like this variable may contain standard\nerrors (maybe use 'sei=", x, "' instead?).")), call.=FALSE) try(assign("runvicheck", FALSE, envir=.metafor), silent=TRUE) } } } ############################################################################ ### check that the lengths of all non-zero length elements given via ... are equal to each other .equal.length <- function(...) { ddd <- list(...) ks <- lengths(ddd) # get the length of each element in ddd if (all(ks == 0L)) { # if all elements have length 0 (are NULL), return TRUE return(TRUE) } else { ks <- ks[ks > 0L] # keep the non-zero lengths return(length(unique(ks)) == 1L) # check that they are all identical } } ### check that all elements given via ... are not of length 0 (are not NULL) .all.specified <- function(...) { ddd <- list(...) #all(!sapply(ddd, is.null)) not0 <- lengths(ddd) != 0L all(not0) } ############################################################################ ### set axis label (for forest, funnel, and labbe functions) .setlab <- function(measure, transf.char, atransf.char, gentype, short=FALSE) { if (gentype == 1) lab <- "Observed Outcome" if (gentype == 2) lab <- "Overall Estimate" # for forest.cumul.rma() function if (gentype == 3) lab <- "Estimate" # for header ######################################################################### if (!is.null(measure)) { ###################################################################### if (is.element(measure, c("RR","MPRR"))) { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[RR]", "Log Risk Ratio") } else { lab <- ifelse(short, lab, "Transformed Log Risk Ratio") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Risk Ratio", "Risk Ratio (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Risk Ratio", "Risk Ratio") } } if (is.element(measure, c("OR","PETO","D2OR","D2ORN","D2ORL","MPOR","MPORC","MPPETO","MPORM"))) { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[OR]", "Log Odds Ratio") } else { lab <- ifelse(short, lab, "Transformed Log Odds Ratio") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Odds Ratio", "Odds Ratio (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Odds Ratio", "Odds Ratio") } } if (is.element(measure, c("RD","MPRD"))) { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Risk Difference", "Risk Difference") } else { lab <- ifelse(short, lab, "Transformed Risk Difference") } } if (measure == "AS") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Arcsine RD", "Arcsine Transformed Risk Difference") } else { lab <- ifelse(short, lab, "Transformed Arcsine Transformed Risk Difference") } } if (measure == "PHI") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Phi", "Phi Coefficient") } else { lab <- ifelse(short, lab, "Transformed Phi Coefficient") } } if (measure == "ZPHI") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, expression('Fisher\'s ' * z[phi]), "Fisher's z Transformed Phi Coefficient") } else { lab <- ifelse(short, lab, "Transformed Fisher's z Transformed Phi Coefficient") funlist <- lapply(list(transf.ztor, transf.ztor.int, tanh), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Phi", "Phi Coefficient") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Phi", "Phi Coefficient") } } if (measure == "YUQ") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Yule's Q", "Yule's Q") } else { lab <- ifelse(short, lab, "Transformed Yule's Q") } } if (measure == "YUY") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Yule's Y", "Yule's Y") } else { lab <- ifelse(short, lab, "Transformed Yule's Y") } } ###################################################################### if (measure == "IRR") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[IRR]", "Log Incidence Rate Ratio") } else { lab <- ifelse(short, lab, "Transformed Log Incidence Rate Ratio") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Rate Ratio", "Incidence Rate Ratio (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Rate Ratio", "Incidence Rate Ratio") } } if (measure == "IRD") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "IRD", "Incidence Rate Difference") } else { lab <- ifelse(short, lab, "Transformed Incidence Rate Difference") } } if (measure == "IRSD") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "IRSD", "Square Root Transformed Incidence Rate Difference") } else { lab <- ifelse(short, lab, "Transformed Square Root Transformed Incidence Rate Difference") } } ###################################################################### if (measure == "MD") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "MD", "Mean Difference") } else { lab <- ifelse(short, lab, "Transformed Mean Difference") } } if (is.element(measure, c("SMD","SMDH","SMD1","SMD1H","PBIT","OR2D","OR2DN","OR2DL"))) { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "SMD", "Standardized Mean Difference") } else { lab <- ifelse(short, lab, "Transformed Standardized Mean Difference") } } if (measure == "ROM") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[RoM]", "Log Ratio of Means") } else { lab <- ifelse(short, lab, "Transformed Log Ratio of Means") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Ratio of Means", "Ratio of Means (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Ratio of Means", "Ratio of Means") } } if (measure == "RPB") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Correlation", "Point-Biserial Correlation Coefficient") } else { lab <- ifelse(short, lab, "Transformed Point-Biserial Correlation Coefficient") } } if (measure == "ZPB") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, expression('Fisher\'s ' * z[phi]), "Fisher's z Transformed Point-Biserial Correlation Coefficient") } else { lab <- ifelse(short, lab, "Transformed Fisher's z Transformed Point-Biserial Correlation Coefficient") funlist <- lapply(list(transf.ztor, transf.ztor.int, tanh), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Correlation", "Point-Biserial Correlation Coefficient") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Correlation", "Point-Biserial Correlation Coefficient") } } if (measure == "CVR") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[CVR]", "Log Coefficient of Variation Ratio") } else { lab <- ifelse(short, lab, "Transformed Log Coefficient of Variation Ratio") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "CVR", "Coefficient of Variation Ratio (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "CVR", "Coefficient of Variation Ratio") } } if (measure == "VR") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[VR]", "Log Variability Ratio") } else { lab <- ifelse(short, lab, "Transformed Log Variability Ratio") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "VR", "Variability Ratio (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "VR", "Variability Ratio") } } ###################################################################### if (is.element(measure, c("COR","UCOR","RTET","RBIS"))) { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Correlation", "Correlation Coefficient") } else { lab <- ifelse(short, lab, "Transformed Correlation Coefficient") } } if (is.element(measure, c("ZCOR","ZTET","ZBIS"))) { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, expression('Fisher\'s ' * z[r]), "Fisher's z Transformed Correlation Coefficient") } else { lab <- ifelse(short, lab, "Transformed Fisher's z Transformed Correlation Coefficient") funlist <- lapply(list(transf.ztor, transf.ztor.int, tanh), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Correlation", "Correlation Coefficient") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Correlation", "Correlation Coefficient") } } ###################################################################### if (measure == "PCOR") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Correlation", "Partial Correlation Coefficient") } else { lab <- ifelse(short, lab, "Transformed Partial Correlation Coefficient") } } if (measure == "ZPCOR") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, expression('Fisher\'s ' * z[r]), "Fisher's z Transformed Partial Correlation Coefficient") } else { lab <- ifelse(short, lab, "Transformed Fisher's z Transformed Partial Correlation Coefficient") funlist <- lapply(list(transf.ztor, transf.ztor.int, tanh), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Correlation", "Partial Correlation Coefficient") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Correlation", "Partial Correlation Coefficient") } } if (measure == "SPCOR") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Correlation", "Semi-Partial Correlation Coefficient") } else { lab <- ifelse(short, lab, "Transformed Semi-Partial Correlation Coefficient") } } if (measure == "ZSPCOR") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, expression('Fisher\'s ' * z[r]), "Fisher's z Transformed Semi-Partial Correlation Coefficient") } else { lab <- ifelse(short, lab, "Transformed Fisher's z Transformed Semi-Partial Correlation Coefficient") funlist <- lapply(list(transf.ztor, transf.ztor.int, tanh), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Correlation", "Semi-Partial Correlation Coefficient") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Correlation", "Semi-Partial Correlation Coefficient") } } ###################################################################### if (measure == "R2") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, expression(R^2), "Coefficient of Determination") } else { lab <- ifelse(short, lab, "Transformed Coefficient of Determination") } } if (measure == "ZR2") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, expression(z[R^2]), "z Transformed Coefficient of Determination") } else { lab <- ifelse(short, lab, "Transformed z Transformed Coefficient of Determination") funlist <- lapply(list(transf.ztor2), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, expression(R^2), "Coefficient of Determination") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, expression(R^2), "Coefficient of Determination") } } ###################################################################### if (measure == "PR") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Proportion", "Proportion") } else { lab <- ifelse(short, lab, "Transformed Proportion") } } if (measure == "PLN") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[Pr]", "Log Proportion") } else { lab <- ifelse(short, lab, "Transformed Log Proportion") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Proportion", "Proportion (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Proportion", "Proportion") } } if (measure == "PLO") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[Odds]", "Log Odds") } else { lab <- ifelse(short, lab, "Transformed Log Odds") funlist <- lapply(list(transf.ilogit, transf.ilogit.int, plogis), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Proportion", "Proportion (logit scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Proportion", "Proportion") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Odds", "Odds (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Odds", "Odds") } } if (measure == "PAS") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, expression(arcsin(sqrt(p))), "Arcsine Transformed Proportion") } else { lab <- ifelse(short, lab, "Transformed Arcsine Transformed Proportion") funlist <- lapply(list(transf.iarcsin), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Proportion", "Proportion (arcsine scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Proportion", "Proportion") } } if (measure == "PFT") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "PFT", "Double Arcsine Transformed Proportion") } else { lab <- ifelse(short, lab, "Transformed Double Arcsine Transformed Proportion") funlist <- lapply(list(transf.ipft.hm), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Proportion", "Proportion") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Proportion", "Proportion") } } ###################################################################### if (measure == "IR") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Rate", "Incidence Rate") } else { lab <- ifelse(short, lab, "Transformed Incidence Rate") } } if (measure == "IRLN") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[IR]", "Log Incidence Rate") } else { lab <- ifelse(short, lab, "Transformed Log Incidence Rate") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Rate", "Incidence Rate (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Rate", "Incidence Rate") } } if (measure == "IRS") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Sqrt[IR]", "Square Root Transformed Incidence Rate") } else { lab <- ifelse(short, lab, "Transformed Square Root Transformed Incidence Rate") funlist <- lapply(list(transf.isqrt, atransf.char), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Rate", "Incidence Rate (square root scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Rate", "Incidence Rate") } } if (measure == "IRFT") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "IRFT", "Freeman-Tukey Transformed Incidence Rate") } else { lab <- ifelse(short, lab, "Transformed Freeman-Tukey Transformed Incidence Rate") } } ###################################################################### if (measure == "MN") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Mean", "Mean") } else { lab <- ifelse(short, lab, "Transformed Mean") } } if (measure == "MNLN") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[Mean]", "Log Mean") } else { lab <- ifelse(short, lab, "Transformed Log Mean") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Mean", "Mean (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Mean", "Mean") } } if (measure == "SMN") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "SM", "Standardized Mean") } else { lab <- ifelse(short, lab, "Transformed Standardized Mean") } } if (measure == "CVLN") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[CV]", "Log Coefficient of Variation") } else { lab <- ifelse(short, lab, "Transformed Log Coefficient of Variation") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "CV", "Coefficient of Variation (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "CV", "Coefficient of Variation") } } if (measure == "SDLN") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[SD]", "Log Standard Deviation") } else { lab <- ifelse(short, lab, "Transformed Log Standard Deviation") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "SD", "Standard Deviation (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "SD", "Standard Deviation") } } ###################################################################### if (measure == "MC") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Mean Change", "Mean Change") } else { lab <- ifelse(short, lab, "Transformed Mean Change") } } if (is.element(measure, c("SMCC","SMCR","SMCRH"))) { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "SMC", "Standardized Mean Change") } else { lab <- ifelse(short, lab, "Transformed Standardized Mean Change") } } if (measure == "ROMC") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[RoM]", "Log Ratio of Means") } else { lab <- ifelse(short, lab, "Transformed Log Ratio of Means") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Ratio of Means", "Ratio of Means (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Ratio of Means", "Ratio of Means") } } if (measure == "CVRC") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[CVR]", "Log Coefficient of Variation Ratio") } else { lab <- ifelse(short, lab, "Transformed Log Coefficient of Variation Ratio") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "CVR", "Coefficient of Variation Ratio (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "CVR", "Coefficient of Variation Ratio") } } if (measure == "VRC") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[VR]", "Log Variability Ratio") } else { lab <- ifelse(short, lab, "Transformed Log Variability Ratio") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "VR", "Variability Ratio (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "VR", "Variability Ratio") } } ###################################################################### if (measure == "ARAW") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Alpha", "Cronbach's alpha") } else { lab <- ifelse(short, lab, "Transformed Cronbach's alpha") } } if (measure == "AHW") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, expression('Alpha'[HW]), "Transformed Cronbach's alpha") } else { lab <- ifelse(short, lab, "Transformed Cronbach's alpha") funlist <- lapply(list(transf.iahw), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Alpha", "Cronbach's alpha") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Alpha", "Cronbach's alpha") } } if (measure == "ABT") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, expression('Alpha'[B]), "Transformed Cronbach's alpha") } else { lab <- ifelse(short, lab, "Transformed Cronbach's alpha") funlist <- lapply(list(transf.iabt), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "Alpha", "Cronbach's alpha") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "Alpha", "Cronbach's alpha") } } ###################################################################### if (measure == "REH") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[REH]", "Log Relative Excess Heterozygosity") } else { lab <- ifelse(short, lab, "Transformed Log Relative Excess Heterozygosity") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "REH", "Relative Excess Heterozygosity (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "REH", "Relative Excess Heterozygosity") } } ###################################################################### } return(lab) } ############################################################################ ### stuff related to colored/styled output .get.mstyle <- function(withcrayon) { if (withcrayon) { if (exists(".mstyle")) { .mstyle <- get(".mstyle") } else { .mstyle <- list() } styleopt <- getmfopt("style") if (!is.null(styleopt)) .mstyle <- styleopt if (!is.list(.mstyle)) .mstyle <- list(.mstyle) if (is.null(.mstyle$section)) { section <- crayon::bold } else { section <- .mstyle$section } if (is.null(.mstyle$header)) { header <- crayon::underline } else { header <- .mstyle$header } if (is.null(.mstyle$body1)) { body1 <- crayon::reset } else { body1 <- .mstyle$body1 } if (is.null(.mstyle$body2)) { body2 <- crayon::reset } else { body2 <- .mstyle$body2 } if (is.null(.mstyle$na)) { na <- crayon::reset } else { na <- .mstyle$na } if (is.null(.mstyle$text)) { text <- crayon::reset } else { text <- .mstyle$text } if (is.null(.mstyle$result)) { result <- crayon::reset } else { result <- .mstyle$result } if (is.null(.mstyle$stop)) { stop <- crayon::combine_styles(crayon::red, crayon::bold) } else { stop <- .mstyle$stop } if (is.null(.mstyle$warning)) { warning <- crayon::yellow } else { warning <- .mstyle$warning } if (is.null(.mstyle$message)) { message <- crayon::green } else { message <- .mstyle$message } if (is.null(.mstyle$verbose)) { verbose <- crayon::cyan } else { verbose <- .mstyle$verbose } if (is.null(.mstyle$legend)) { legend <- crayon::silver #legend <- crayon::make_style("gray90") } else { legend <- .mstyle$legend } } else { tmp <- function(...) paste0(...) section <- tmp header <- tmp body1 <- tmp body2 <- tmp na <- tmp text <- tmp result <- tmp stop <- tmp warning <- tmp message <- tmp verbose <- tmp legend <- tmp } return(list(section=section, header=header, body1=body1, body2=body2, na=na, text=text, result=result, stop=stop, warning=warning, message=message, verbose=verbose, legend=legend)) } .print.output <- function(x, mstyle) { if (missing(mstyle)) { for (i in seq_along(x)) { cat(x[i], "\n") } } else { for (i in seq_along(x)) { cat(mstyle(x[i]), "\n") } } } .is.even <- function(x) x %% 2 == 0 .print.table <- function(x, mstyle) { is.header <- !grepl(" [-0-9]", x) #is.header <- !grepl("^\\s*[0-9]", x) has.header <- any(is.header) for (i in seq_along(x)) { if (is.header[i]) { #x[i] <- trimws(x[i], which="right") x[i] <- mstyle$header(x[i]) } else { x[i] <- gsub("NA", mstyle$na("NA"), x[i], fixed=TRUE) if (.is.even(i-has.header)) { x[i] <- mstyle$body2(x[i]) } else { x[i] <- mstyle$body1(x[i]) } } cat(x[i], "\n") } } #.set.mstyle.1 <- str2lang(".mstyle <- list(section=make_style(\"gray90\")$bold, header=make_style(\"skyblue1\")$bold$underline, body=make_style(\"skyblue2\"), text=make_style(\"slateblue3\"), result=make_style(\"slateblue1\"))") #eval(metafor:::.set.mstyle.1) ############################################################################ .set.digits <- function(digits, dmiss) { res <- c(est=4, se=4, test=4, pval=4, ci=4, var=4, sevar=4, fit=4, het=4) if (exists(".digits")) { .digits <- get(".digits") if (is.null(names(.digits)) && length(.digits) == 1L) { # if .digits is a single unnamed scalar, set all digit values to that value res <- c(est=.digits, se=.digits, test=.digits, pval=.digits, ci=.digits, var=.digits, sevar=.digits, fit=.digits, het=.digits) } else if (any(names(.digits) != "") && any(names(.digits) == "")) { # if .digits has (at least) one unnamed element, use it to set all unnamed elements to that digits value pos <- pmatch(names(.digits), names(res)) res[c(na.omit(pos))] <- .digits[!is.na(pos)] otherval <- .digits[names(.digits) == ""][1] res[(1:9)[-c(na.omit(pos))]] <- otherval } else { pos <- pmatch(names(.digits), names(res)) res[c(na.omit(pos))] <- .digits[!is.na(pos)] } } if (!dmiss) { if (is.null(names(digits))) { res <- c(est=digits[[1]], se=digits[[1]], test=digits[[1]], pval=digits[[1]], ci=digits[[1]], var=digits[[1]], sevar=digits[[1]], fit=digits[[1]], het=digits[[1]]) } else { pos <- pmatch(names(digits), names(res)) res[c(na.omit(pos))] <- digits[!is.na(pos)] } } ### p-values are always given to at least 2 digits if (res["pval"] <= 1) res["pval"] <- 2 res } .get.digits <- function(digits, xdigits, dmiss) { res <- xdigits if (exists(".digits")) { .digits <- get(".digits") pos <- pmatch(names(.digits), names(res)) res[c(na.omit(pos))] <- .digits[!is.na(pos)] } if (!is.null(getmfopt("digits"))) { .digits <- getmfopt("digits") if (length(.digits) == 1L) .digits <- c(est=.digits[[1]], se=.digits[[1]], test=.digits[[1]], pval=.digits[[1]], ci=.digits[[1]], var=.digits[[1]], sevar=.digits[[1]], fit=.digits[[1]], het=.digits[[1]]) pos <- pmatch(names(.digits), names(res)) res[c(na.omit(pos))] <- .digits[!is.na(pos)] } if (!dmiss) { if (is.null(names(digits))) { res <- c(est=digits[[1]], se=digits[[1]], test=digits[[1]], pval=digits[[1]], ci=digits[[1]], var=digits[[1]], sevar=digits[[1]], fit=digits[[1]], het=digits[[1]]) } else { pos <- pmatch(names(digits), names(res)) res[c(na.omit(pos))] <- digits[!is.na(pos)] } } ### so we can still print objects created with older metafor versions (where xdigit is just an unnamed scalar) if (length(res) == 1L && is.null(names(res))) res <- c(est=res[[1]], se=res[[1]], test=res[[1]], pval=res[[1]], ci=res[[1]], var=res[[1]], sevar=res[[1]], fit=res[[1]], het=res[[1]]) ### p-values are always given to at least 2 digits if (!is.null(res["pval"]) && res["pval"] <= 1) res["pval"] <- 2 res } ############################################################################ ### check if x is logical and TRUE/FALSE (NAs and NULL always evaluate as FALSE) .isTRUE <- function(x) !is.null(x) && is.logical(x) && !is.na(x) && x .isFALSE <- function(x) !is.null(x) && is.logical(x) && !is.na(x) && !x # not sure anymore why I implemented these; c(isTRUE(NULL), isTRUE(NA), isFALSE(NULL), isFALSE(NA)) are all FALSE ############################################################################ ### shorten a character vector so that elements remain distinguishable .shorten <- function(x, minlen) { y <- x x <- c(na.omit(x)) n <- length(unique(x)) maxlen <- max(nchar(unique(x))) for (l in seq_len(maxlen)) { tab <- table(x, substr(x, 1, l)) if (nrow(tab) == n && ncol(tab) == n && sum(tab[upper.tri(tab)]) == 0 && sum(tab[lower.tri(tab)]) == 0) break } if (!missing(minlen) && l < minlen) { if (minlen > maxlen) minlen <- maxlen l <- minlen } return(substr(y, 1, l)) } ############################################################################ ### simplified version of what mvtnorm::rmvnorm() does .mvrnorm <- function(n, mu, Sigma) { p <- nrow(Sigma) eS <- eigen(Sigma, symmetric = TRUE) eval <- eS$values evec <- eS$vectors Y <- matrix(rnorm(p * n), nrow = n, byrow = TRUE) %*% t(evec %*% (t(evec) * sqrt(pmax(eval, 0)))) Y <- sweep(Y, 2, mu, "+") return(Y) } ############################################################################ ### check subset argument (if logical, make sure it's of the right length and set NAs to FALSE; if ### numeric, remove NAs and 0's and check that values are not beyond k) .chksubset <- function(x, k, stoponk0=TRUE) { if (is.null(x)) # if x is NULL, return x (i.e., NULL) return(x) mstyle <- .get.mstyle("crayon" %in% .packages()) argname <- deparse(substitute(x)) if (length(x) == 0L) stop(mstyle$stop(paste0("Argument '", argname, "' is of length 0.")), call.=FALSE) if (is.logical(x)) { if (length(x) != k) stop(mstyle$stop(paste0("Length of the '", argname, "' argument (", length(x), ") is not of length k = ", k, ".")), call.=FALSE) #x <- x[seq_len(k)] # keep only elements 1:k from x if (anyNA(x)) # if x includes any NA elements x[is.na(x)] <- FALSE # set NA elements to FALSE } if (is.numeric(x)) { if (anyNA(x)) # if x includes any NA elements x <- x[!is.na(x)] # remove them x <- as.integer(round(x)) x <- x[x != 0L] # also remove any 0's if (any(x > 0L) && any(x < 0L)) stop(mstyle$stop(paste0("Cannot mix positive and negative values in '", argname, "' argument.")), call.=FALSE) if (all(x > 0L)) { if (any(x > k)) stop(mstyle$stop(paste0("Argument '", argname, "' includes values larger than k = ", k, ".")), call.=FALSE) x <- is.element(seq_len(k), x) } else { if (any(x < -k)) stop(mstyle$stop(paste0("Argument '", argname, "' includes values larger than k = ", k, ".")), call.=FALSE) x <- !is.element(seq_len(k), abs(x)) } } if (stoponk0 && !any(x)) stop(mstyle$stop(paste0("Stopped because k = 0 after subsetting.")), call.=FALSE) return(x) } ### get subset function that works for matrices and data frames (selecting rows by default but rows ### and columns when col=TRUE) and vectors and also checks that x is of the same length as subset .getsubset <- function(x, subset, col=FALSE, drop=FALSE) { if (is.null(x) || is.null(subset)) # if x or subset is NULL, return x return(x) mstyle <- .get.mstyle("crayon" %in% .packages()) xname <- deparse(substitute(x)) k <- length(subset) if (.is.matrix(x) || is.data.frame(x)) { if (nrow(x) != k) stop(mstyle$stop(paste0("Element '", xname, "' is not of length ", k, ".")), call.=FALSE) if (col) { x <- x[subset,subset,drop=drop] } else { x <- x[subset,,drop=drop] } } else { if (length(x) != k) stop(mstyle$stop(paste0("Element '", xname, "' is not of length ", k, ".")), call.=FALSE) x <- x[subset] } return(x) } ############################################################################ # function to compute a weighted mean (this one works a bit different than # stats:::weighted.mean.default) .wmean <- function (x, w, na.rm=FALSE) { if (na.rm) { i <- !(is.na(x) | is.na(w)) # only include x if x and w are not missing x <- x[i] w <- w[i] } sum(x*w) / sum(w) } ############################################################################ .chkopt <- function(optimizer, optcontrol) { mstyle <- .get.mstyle("crayon" %in% .packages()) ### set NLOPT_LN_BOBYQA as the default algorithm for nloptr optimizer ### and by default use a relative convergence criterion of 1e-8 on the function value if (optimizer == "nloptr" && !is.element("algorithm", names(optcontrol))) optcontrol$algorithm <- "NLOPT_LN_BOBYQA" if (optimizer == "nloptr" && !is.element("ftol_rel", names(optcontrol))) optcontrol$ftol_rel <- 1e-8 ### for mads, set trace=FALSE and tol=1e-6 by default if (optimizer == "mads" && !is.element("trace", names(optcontrol))) optcontrol$trace <- FALSE if (optimizer == "mads" && !is.element("tol", names(optcontrol))) optcontrol$tol <- 1e-6 ### for subplex, set reltol=1e-8 by default (the default in subplex() is .Machine$double.eps) if (optimizer == "subplex" && !is.element("reltol", names(optcontrol))) optcontrol$reltol <- 1e-8 ### for BBoptim, set trace=FALSE by default if (optimizer == "BBoptim" && !is.element("trace", names(optcontrol))) optcontrol$trace <- FALSE ### for solnp, set trace=FALSE by default if (optimizer == "solnp" && !is.element("trace", names(optcontrol))) optcontrol$trace <- FALSE ### check that the required packages are installed if (is.element(optimizer, c("uobyqa","newuoa","bobyqa"))) { if (!requireNamespace("minqa", quietly=TRUE)) stop(mstyle$stop("Please install the 'minqa' package to use this optimizer."), call.=FALSE) } if (is.element(optimizer, c("nloptr","ucminf","lbfgsb3c","subplex","optimParallel"))) { if (!requireNamespace(optimizer, quietly=TRUE)) stop(mstyle$stop(paste0("Please install the '", optimizer, "' package to use this optimizer.")), call.=FALSE) } if (is.element(optimizer, c("hjk","nmk","mads"))) { if (!requireNamespace("dfoptim", quietly=TRUE)) stop(mstyle$stop("Please install the 'dfoptim' package to use this optimizer."), call.=FALSE) } if (optimizer == "BBoptim") { if (!requireNamespace("BB", quietly=TRUE)) stop(mstyle$stop("Please install the 'BB' package to use this optimizer."), call.=FALSE) } if (optimizer == "solnp") { if (!requireNamespace("Rsolnp", quietly=TRUE)) stop(mstyle$stop("Please install the 'Rsolnp' package to use this optimizer."), call.=FALSE) } if (optimizer == "constrOptim.nl") { if (!requireNamespace("alabama", quietly=TRUE)) stop(mstyle$stop("Please install the 'alabama' package to use this optimizer."), call.=FALSE) } if (optimizer == "Rcgmin") { if (!requireNamespace("Rcgmin", quietly=TRUE)) stop(mstyle$stop("Please install the 'Rcgmin' package to use this optimizer."), call.=FALSE) } if (optimizer == "Rvmmin") { if (!requireNamespace("Rvmmin", quietly=TRUE)) stop(mstyle$stop("Please install the 'Rvmmin' package to use this optimizer."), call.=FALSE) } ######################################################################### if (is.element(optimizer, c("optim","constrOptim"))) { par.arg <- "par" ctrl.arg <- ", control=optcontrol" } if (optimizer == "nlminb") { par.arg <- "start" ctrl.arg <- ", control=optcontrol" } if (is.element(optimizer, c("uobyqa","newuoa","bobyqa"))) { par.arg <- "par" optimizer <- paste0("minqa::", optimizer) # need to use this since loading nloptr masks bobyqa() and newuoa() functions ctrl.arg <- ", control=optcontrol" } if (optimizer == "nloptr") { par.arg <- "x0" optimizer <- paste0("nloptr::nloptr") # need to use this due to requireNamespace() ctrl.arg <- ", opts=optcontrol" } if (optimizer == "nlm") { par.arg <- "p" # because of this, must use argument name pX for p (number of columns in X matrix) ctrl.arg <- paste(names(optcontrol), unlist(optcontrol), sep="=", collapse=", ") if (nchar(ctrl.arg) != 0L) ctrl.arg <- paste0(", ", ctrl.arg) } if (is.element(optimizer, c("hjk","nmk","mads"))) { par.arg <- "par" optimizer <- paste0("dfoptim::", optimizer) # need to use this so that the optimizers can be found ctrl.arg <- ", control=optcontrol" } if (is.element(optimizer, c("ucminf","lbfgsb3c","subplex"))) { par.arg <- "par" optimizer <- paste0(optimizer, "::", optimizer) # need to use this due to requireNamespace() ctrl.arg <- ", control=optcontrol" } if (optimizer == "BBoptim") { par.arg <- "par" optimizer <- "BB::BBoptim" ctrl.arg <- ", quiet=TRUE, control=optcontrol" } if (optimizer == "solnp") { par.arg <- "pars" optimizer <- "Rsolnp::solnp" ctrl.arg <- ", control=optcontrol" } if (optimizer == "constrOptim.nl") { par.arg <- "par" optimizer <- "alabama::constrOptim.nl" if ("control.outer" %in% names(optcontrol)) { # can specify 'control.outer' to be passed to constrOptim.nl(), but when using # the 'method' argument, must escape " or use ' for this to work; for example: # control=list(optimizer="constrOptim.nl", control.outer=list(method="'Nelder-Mead'")) control.outer <- paste0("control.outer=list(", paste(names(optcontrol$control.outer), unlist(optcontrol$control.outer), sep="=", collapse=", "), ")") ctrl.arg <- paste0(", control.optim=optcontrol, ", control.outer) optcontrol$control.outer <- NULL } else { ctrl.arg <- ", control.optim=optcontrol, control.outer=list(trace=FALSE)" } } if (optimizer == "Rcgmin") { par.arg <- "par" optimizer <- "Rcgmin::Rcgmin" #ctrl.arg <- ", gr='grnd', control=optcontrol" ctrl.arg <- ", control=optcontrol" } if (optimizer == "Rvmmin") { par.arg <- "par" optimizer <- "Rvmmin::Rvmmin" #ctrl.arg <- ", gr='grnd', control=optcontrol" ctrl.arg <- ", control=optcontrol" } if (optimizer == "optimParallel") { par.arg <- "par" optimizer <- "optimParallel::optimParallel" ctrl.arg <- ", control=optcontrol, parallel=parallel" } return(list(optimizer=optimizer, optcontrol=optcontrol, par.arg=par.arg, ctrl.arg=ctrl.arg)) } .chkconv <- function(optimizer, opt.res, optcontrol, fun, verbose) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (optimizer == "optimParallel::optimParallel" && verbose) { tmp <- capture.output(print(opt.res$loginfo)) .print.output(tmp, mstyle$verbose) } ### convergence checks if (inherits(opt.res, "try-error")) stop(mstyle$stop(paste0("Error during the optimization. Use verbose=TRUE and see\n help(", fun, ") for more details on the optimization routines.")), call.=FALSE) if (optimizer == "lbfgsb3c::lbfgsb3c" && is.null(opt.res$convergence)) # special provision for lbfgsb3c in case 'convergence' is missing opt.res$convergence <- -99 if (is.element(optimizer, c("optim","constrOptim","nlminb","dfoptim::hjk","dfoptim::nmk","lbfgsb3c::lbfgsb3c","subplex::subplex","BB::BBoptim","Rsolnp::solnp","alabama::constrOptim.nl","Rcgmin::Rcgmin","Rvmmin:Rvmmin","optimParallel::optimParallel")) && opt.res$convergence != 0) stop(mstyle$stop(paste0("Optimizer (", optimizer, ") did not achieve convergence (convergence = ", opt.res$convergence, ").")), call.=FALSE) if (is.element(optimizer, c("dfoptim::mads")) && opt.res$convergence > optcontrol$tol) stop(mstyle$stop(paste0("Optimizer (", optimizer, ") did not achieve convergence (convergence = ", opt.res$convergence, ").")), call.=FALSE) if (is.element(optimizer, c("minqa::uobyqa","minqa::newuoa","minqa::bobyqa")) && opt.res$ierr != 0) stop(mstyle$stop(paste0("Optimizer (", optimizer, ") did not achieve convergence (ierr = ", opt.res$ierr, ").")), call.=FALSE) if (optimizer=="nloptr::nloptr" && !(opt.res$status >= 1 && opt.res$status <= 4)) stop(mstyle$stop(paste0("Optimizer (", optimizer, ") did not achieve convergence (status = ", opt.res$status, ").")), call.=FALSE) if (optimizer=="ucminf::ucminf" && !(opt.res$convergence == 1 || opt.res$convergence == 2)) stop(mstyle$stop(paste0("Optimizer (", optimizer, ") did not achieve convergence (convergence = ", opt.res$convergence, ").")), call.=FALSE) if (verbose > 2) { cat("\n") tmp <- capture.output(print(opt.res)) .print.output(tmp, mstyle$verbose) } ### copy estimated values to 'par' if (optimizer=="nloptr::nloptr") opt.res$par <- opt.res$solution if (optimizer=="nlm") opt.res$par <- opt.res$estimate if (optimizer=="Rsolnp::solnp") opt.res$par <- opt.res$pars return(opt.res$par) } ############################################################################ .coltail <- function(h, val, tail="upper", mult=1, col, border, freq, ...) { h$counts <- h$counts * mult h$density <- h$density * mult if (tail == "lower") { above <- which(h$breaks > val) if (length(above) > 0L) { pos <- above[1] h$breaks[pos] <- val } sel <- h$breaks <= val if (sum(sel) >= 2L) { h$breaks <- h$breaks[sel] h$counts <- h$counts[sel[-1]] h$density <- h$density[sel[-1]] h$mids <- h$mids[sel[-1]] lines(h, col=col, border=border, freq=freq, ...) } } else { below <- which(h$breaks < val) if (length(below) > 0L) { pos <- below[length(below)] h$breaks[pos] <- val } sel <- h$breaks >= val if (sum(sel) >= 2L) { len <- length(below) h$breaks <- h$breaks[sel] h$counts <- h$counts[sel[-len]] h$density <- h$density[sel[-len]] h$mids <- h$mids[sel[-len]] lines(h, col=col, border=border, freq=freq, ...) } } } ############################################################################ # theme="default" - uses the default par() of the plotting device # theme="light" - forces par(fg="black", bg="white", ...) # theme="dark" - forces par(fg="gray95", bg="gray10", ...) # theme="auto" - in RStudio, picks fg/bg based on theme that is set (outside RStudio, same as "default") # theme="custom" - uses getmfopt("fg") and getmfopt("bg") .start.plot <- function(x=TRUE) { if (!x) return() themeopt <- getmfopt("theme", default="default")[[1]] themeopt <- sub("2", "", themeopt, fixed=TRUE) if (!is.element(themeopt, c("default", "light", "dark", "auto", "custom"))) themeopt <- "default" if (exists(".darkplots")) themeopt <- "dark" if (isTRUE(themeopt == "light")) { fg <- "black" bg <- "white" #fg <- "gray5" #bg <- "gray95" } if (isTRUE(themeopt == "dark")) { fg <- "gray95" bg <- "gray10" } if (isTRUE(themeopt == "auto")) { rsapi <- try(rstudioapi::isAvailable(), silent=TRUE) if (inherits(rsapi, "try-error") || isFALSE(rsapi)) { themeopt <- "default" } else { fg <- .rsapicol2rgb(rstudioapi::getThemeInfo()$foreground) bg <- .rsapicol2rgb(rstudioapi::getThemeInfo()$background) } } if (isTRUE(themeopt == "custom")) { fgopt <- getmfopt("fg") bgopt <- getmfopt("bg") if (is.null(fgopt) || is.null(bgopt)) { themeopt <- "default" } else { fg <- fgopt bg <- bgopt } } if (themeopt != "default") par(fg=fg, bg=bg, col=fg, col.axis=fg, col.lab=fg, col.main=fg, col.sub=fg) invisible() } # convert the string "rgb(val1, val2, val3)" into rgb(val1, val2, val3, maxColorValue=255) .rsapicol2rgb <- function(col) { col <- strsplit(col, ",")[[1]] col <- trimws(col) col1 <- as.numeric(sub("rgb(", "", col[1], fixed=TRUE)) col2 <- as.numeric(col[2]) col3 <- as.numeric(trimws(sub(")", "", col[3], fixed=TRUE))) col <- rgb(col1, col2, col3, maxColorValue=255) return(col) } .is.dark <- function() { rgb <- col2rgb(par("bg")) res <- sum(rgb) <= 384 # note: sum(col2rgb(rgb(0.5,0.5,0.5))) == 384 return(res) } .coladj <- function(col, dark, light) { themeopt <- getmfopt("theme", default="default") if (length(col) == 2L && substr(themeopt, nchar(themeopt), nchar(themeopt)) == "2") { pos <- 2 if (length(dark) == 1L) dark <- c(dark, ifelse(dark > 0, dark-1, dark+1)) if (length(light) == 1L) light <- c(light, ifelse(light > 0, light-1, light+1)) } else { pos <- 1 } col <- c(col2rgb(col[[pos]])) if (.is.dark()) { col <- col + round(dark*255)[[pos]] } else { col <- col + round(light*255)[[pos]] } col[col < 0] <- 0 col[col > 255] <- 255 col <- rgb(col[1], col[2], col[3], maxColorValue=255) return(col) } ############################################################################ .chkpd <- function(x, tol=.Machine$double.eps, corr=FALSE, nearpd=FALSE) { if (any(eigen(x, symmetric=TRUE, only.values=TRUE)$values <= tol)) { ispd <- FALSE if (nearpd) { tmp <- nearPD(x, corr=corr) x <- as.matrix(tmp$mat) if (tmp$converged) ispd <- TRUE } } else { ispd <- TRUE } if (nearpd) { return(list(ispd=ispd, x=x)) } else { return(ispd) } } ############################################################################ metafor/R/escalc.r0000644000176200001440000025234014436371707013547 0ustar liggesusersescalc <- function(measure, ai, bi, ci, di, n1i, n2i, x1i, x2i, t1i, t2i, m1i, m2i, sd1i, sd2i, xi, mi, ri, ti, fi, pi, sdi, r2i, ni, yi, vi, sei, data, slab, subset, include, add=1/2, to="only0", drop00=FALSE, vtype="LS", var.names=c("yi","vi"), add.measure=FALSE, append=TRUE, replace=TRUE, digits, ...) { ### check argument specifications mstyle <- .get.mstyle("crayon" %in% .packages()) if (missing(measure) && missing(yi)) stop(mstyle$stop("Must specify an effect size or outcome measure via the 'measure' argument.")) if (!missing(yi) && missing(measure)) measure <- "GEN" if (!is.character(measure)) stop(mstyle$stop("The 'measure' argument must be a character string.")) if (!is.element(measure, c("RR","OR","PETO","RD","AS","PHI","ZPHI","YUQ","YUY","RTET","ZTET", # 2x2 table measures "PBIT","OR2D","OR2DN","OR2DL", # - transformations to SMD "MPRD","MPRR","MPOR","MPORC","MPPETO","MPORM", # - measures for matched pairs / pre-post data "IRR","IRD","IRSD", # two-group person-time data measures "MD","SMD","SMDH","SMD1","SMD1H","ROM", # two-group mean/SD measures "CVR","VR", # coefficient of variation ratio, variability ratio "RPB","ZPB","RBIS","ZBIS","D2OR","D2ORN","D2ORL", # - transformations to r_PB, r_BIS, and log(OR) "COR","UCOR","ZCOR", # correlations (raw and r-to-z transformed) "PCOR","ZPCOR","SPCOR","ZSPCOR", # partial and semi-partial correlations "R2","ZR2", # coefficient of determination (raw and r-to-z transformed) "PR","PLN","PLO","PAS","PFT", # single proportions (and transformations thereof) "IR","IRLN","IRS","IRFT", # single-group person-time data (and transformations thereof) "MN","MNLN","CVLN","SDLN","SMN", # mean, log(mean), log(CV), log(SD), standardized mean "MC","SMCC","SMCR","SMCRH","ROMC","CVRC","VRC", # raw/standardized mean change, log(ROM), CVR, and VR for dependent samples "ARAW","AHW","ABT", # alpha (and transformations thereof) "REH", # relative excess heterozygosity "GEN"))) stop(mstyle$stop("Unknown 'measure' specified.")) # when adding measures, remember to add measure to .setlab() if (!is.element(to, c("all","only0","if0all","none"))) stop(mstyle$stop("Unknown 'to' argument specified.")) if (any(!is.element(vtype, c("UB","LS","LS2","HO","ST","CS","AV","AV2","AVHO")), na.rm=TRUE)) # vtype can be an entire vector, so use any() and na.rm=TRUE stop(mstyle$stop("Unknown 'vtype' argument specified.")) if (add.measure) { if (length(var.names) == 2L) var.names <- c(var.names, "measure") if (length(var.names) != 3L) stop(mstyle$stop("Argument 'var.names' must be of length 2 or 3.")) if (any(var.names != make.names(var.names, unique=TRUE))) { var.names <- make.names(var.names, unique=TRUE) warning(mstyle$warning(paste0("Argument 'var.names' does not contain syntactically valid variable names.\nVariable names adjusted to: var.names = c('", var.names[1], "','", var.names[2], "','", var.names[3], "').")), call.=FALSE) } } else { if (length(var.names) == 3L) var.names <- var.names[1:2] if (length(var.names) != 2L) stop(mstyle$stop("Argument 'var.names' must be of length 2.")) if (any(var.names != make.names(var.names, unique=TRUE))) { var.names <- make.names(var.names, unique=TRUE) warning(mstyle$warning(paste0("Argument 'var.names' does not contain syntactically valid variable names.\nVariable names adjusted to: var.names = c('", var.names[1], "','", var.names[2], "').")), call.=FALSE) } } ### check if user is trying to use the 'formula interface' to escalc() ### note: if so, argument 'ai' may mistakenly be a formula, so check for that as well (further below) if (hasArg(formula) || hasArg(weights)) stop(mstyle$stop("The 'formula interface' to escalc() has been deprecated.")) ### get ... argument and check for extra/superfluous arguments ddd <- list(...) .chkdots(ddd, c("onlyo1", "addyi", "addvi", "correct")) ### set defaults or get onlyo1, addyi, addvi, and correct arguments onlyo1 <- ifelse(is.null(ddd$onlyo1), FALSE, .isTRUE(ddd$onlyo1)) addyi <- ifelse(is.null(ddd$addyi), TRUE, .isTRUE(ddd$addyi)) addvi <- ifelse(is.null(ddd$addvi), TRUE, .isTRUE(ddd$addvi)) correct <- ifelse(is.null(ddd$correct), TRUE, .isTRUE(ddd$correct)) ### set defaults for digits if (missing(digits)) { digits <- .set.digits(dmiss=TRUE) } else { digits <- .set.digits(digits, dmiss=FALSE) } ### check if data argument has been specified if (missing(data)) data <- NULL ### need this at the end to check if append=TRUE can actually be done has.data <- !is.null(data) ### check if data argument has been specified if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } mf <- match.call() ### get slab, subset, and include arguments (NULL when unspecified) slab <- .getx("slab", mf=mf, data=data) subset <- .getx("subset", mf=mf, data=data) include <- .getx("include", mf=mf, data=data) ### get yi (in case it has been specified) yi <- .getx("yi", mf=mf, data=data) ### for certain measures, set add=0 by default unless user explicitly sets the add argument addval <- mf[[match("add", names(mf))]] if (is.element(measure, c("AS","PHI","ZPHI","RTET","ZTET","IRSD","PAS","PFT","IRS","IRFT")) && is.null(addval)) add <- 0 ######################################################################### ######################################################################### ######################################################################### if (is.null(yi)) { if (is.element(measure, c("RR","OR","RD","AS","PETO","PHI","ZPHI","YUQ","YUY","RTET","ZTET","PBIT","OR2D","OR2DN","OR2DL","MPRD","MPRR","MPOR","MPORC","MPPETO","MPORM"))) { mf.ai <- mf[[match("ai", names(mf))]] if (any("~" %in% as.character(mf.ai))) stop(mstyle$stop("The 'formula interface' to escalc() has been deprecated.")) ai <- .getx("ai", mf=mf, data=data, checknumeric=TRUE) bi <- .getx("bi", mf=mf, data=data, checknumeric=TRUE) ci <- .getx("ci", mf=mf, data=data, checknumeric=TRUE) di <- .getx("di", mf=mf, data=data, checknumeric=TRUE) n1i <- .getx("n1i", mf=mf, data=data, checknumeric=TRUE) n2i <- .getx("n2i", mf=mf, data=data, checknumeric=TRUE) ri <- .getx("ri", mf=mf, data=data, checknumeric=TRUE) pi <- .getx("pi", mf=mf, data=data, checknumeric=TRUE) if (!.equal.length(ai, bi, ci, di, n1i, n2i, ri, pi)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) n1i.inc <- n1i != ai + bi n2i.inc <- n2i != ci + di if (any(n1i.inc, na.rm=TRUE)) stop(mstyle$stop("One or more 'n1i' values are not equal to 'ai + bi'.")) if (any(n2i.inc, na.rm=TRUE)) stop(mstyle$stop("One or more 'n2i' values are not equal to 'ci + di'.")) bi <- replmiss(bi, n1i-ai) di <- replmiss(di, n2i-ci) if (!.all.specified(ai, bi, ci, di)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., ai, bi, ci, di or ai, n1i, ci, n2i).")) if (measure == "MPORM" && !(.all.specified(ri) || .all.specified(pi))) stop(mstyle$stop("Need to specify also argument 'ri' (and/or 'pi') for this measure.")) k.all <- length(ai) if (!is.null(subset)) { subset <- .chksubset(subset, k.all) ai <- .getsubset(ai, subset) bi <- .getsubset(bi, subset) ci <- .getsubset(ci, subset) di <- .getsubset(di, subset) ri <- .getsubset(ri, subset) pi <- .getsubset(pi, subset) } n1i <- ai + bi n2i <- ci + di if (any(c(ai > n1i, ci > n2i), na.rm=TRUE)) stop(mstyle$stop("One or more event counts are larger than the corresponding group sizes.")) if (any(c(ai, bi, ci, di) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more counts are negative.")) if (any(c(n1i < 0, n2i < 0), na.rm=TRUE)) # note: in cross-sectional sampling, group sizes could be 0 stop(mstyle$stop("One or more group sizes are negative.")) if (measure == "MPORM" && !is.null(ri) && any(abs(ri) > 1, na.rm=TRUE)) stop(mstyle$stop("One or more correlations are > 1 or < -1.")) if (measure == "MPORM" && !is.null(pi) && any(pi < 0 | pi > 1, na.rm=TRUE)) stop(mstyle$stop("One or more proportions are > 1 or < 0.")) ni.u <- ai + bi + ci + di # unadjusted total sample sizes if (measure == "MPORM") ni.u <- round(ni.u / 2) k <- length(ai) ### if drop00=TRUE, set counts to NA for studies that have no events (or all events) in both arms if (drop00) { id00 <- c(ai == 0L & ci == 0L) | c(bi == 0L & di == 0L) id00[is.na(id00)] <- FALSE ai[id00] <- NA_real_ bi[id00] <- NA_real_ ci[id00] <- NA_real_ di[id00] <- NA_real_ } ### save unadjusted counts ai.u <- ai bi.u <- bi ci.u <- ci di.u <- di n1i.u <- ai + bi n2i.u <- ci + di if (to == "all") { ### always add to all cells in all studies ai <- ai + add ci <- ci + add if (!onlyo1) { bi <- bi + add di <- di + add } } if (to == "only0" || to == "if0all") { #if (onlyo1) { # id0 <- c(ai == 0L | ci == 0L) #} else { id0 <- c(ai == 0L | ci == 0L | bi == 0L | di == 0L) #} id0[is.na(id0)] <- FALSE } if (to == "only0") { ### add to cells in studies with at least one 0 entry ai[id0] <- ai[id0] + add ci[id0] <- ci[id0] + add if (!onlyo1) { bi[id0] <- bi[id0] + add di[id0] <- di[id0] + add } } if (to == "if0all") { ### add to cells in all studies if there is at least one 0 entry if (any(id0)) { ai <- ai + add ci <- ci + add if (!onlyo1) { bi <- bi + add di <- di + add } } } ### recompute group and total sample sizes (after add/to adjustment) n1i <- ai + bi n2i <- ci + di ni <- n1i + n2i # ni.u computed earlier is always the 'unadjusted' total sample size if (measure == "MPORM") ni <- round(ni / 2) ### compute proportions for the two groups (unadjusted and adjusted) p1i.u <- ai.u / n1i.u p2i.u <- ci.u / n2i.u p1i <- ai / n1i p2i <- ci / n2i ### log risk ratios if (measure == "RR") { if (addyi) { yi <- log(p1i) - log(p2i) } else { yi <- log(p1i.u) - log(p2i.u) } if (addvi) { vi <- 1/ai - 1/n1i + 1/ci - 1/n2i } else { vi <- 1/ai.u - 1/n1i.u + 1/ci.u - 1/n2i.u } } ### log odds ratio if (is.element(measure, c("OR","OR2D","OR2DN","OR2DL","MPORM"))) { if (addyi) { yi <- log(p1i/(1-p1i)) - log(p2i/(1-p2i)) } else { yi <- log(p1i.u/(1-p1i.u)) - log(p2i.u/(1-p2i.u)) } if (addvi) { vi <- 1/ai + 1/bi + 1/ci + 1/di } else { vi <- 1/ai.u + 1/bi.u + 1/ci.u + 1/di.u } } ### risk difference if (measure == "RD") { if (addyi) { yi <- p1i - p2i } else { yi <- p1i.u - p2i.u } if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) if (addvi) { mnwp1i <- .wmean(p1i, n1i, na.rm=TRUE) # sample size weighted average of proportions mnwp2i <- .wmean(p2i, n2i, na.rm=TRUE) # sample size weighted average of proportions } else { mnwp1i.u <- .wmean(p1i.u, n1i.u, na.rm=TRUE) # sample size weighted average of proportions mnwp2i.u <- .wmean(p2i.u, n2i.u, na.rm=TRUE) # sample size weighted average of proportions } if (!all(is.element(vtype, c("UB","LS","AV")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'UB', 'LS', or 'AV'.")) for (i in seq_len(k)) { ### unbiased estimate of the sampling variance if (vtype[i] == "UB") { if (addvi) { vi[i] <- p1i[i]*(1-p1i[i])/(n1i[i]-1) + p2i[i]*(1-p2i[i])/(n2i[i]-1) } else { vi[i] <- p1i.u[i]*(1-p1i.u[i])/(n1i.u[i]-1) + p2i.u[i]*(1-p2i.u[i])/(n2i.u[i]-1) } } ### large sample approximation to the sampling variance if (vtype[i] == "LS") { if (addvi) { vi[i] <- p1i[i]*(1-p1i[i])/n1i[i] + p2i[i]*(1-p2i[i])/n2i[i] } else { vi[i] <- p1i.u[i]*(1-p1i.u[i])/n1i.u[i] + p2i.u[i]*(1-p2i.u[i])/n2i.u[i] } } ### estimate assuming homogeneity (using the average proportions) if (vtype[i] == "AV") { if (addvi) { vi[i] <- mnwp1i*(1-mnwp1i)/n1i[i] + mnwp2i*(1-mnwp2i)/n2i[i] } else { vi[i] <- mnwp1i.u*(1-mnwp1i.u)/n1i.u[i] + mnwp2i.u*(1-mnwp2i.u)/n2i.u[i] } } } } ### note: addyi and addvi only implemented for measures above ### log odds ratio (Peto's method) if (measure == "PETO") { xt <- ai + ci # frequency of outcome1 in both groups combined yt <- bi + di # frequency of outcome2 in both groups combined Ei <- xt * n1i / ni Vi <- xt * yt * (n1i/ni) * (n2i/ni) / (ni - 1) # 0 when xt = 0 or yt = 0 in a table yi <- (ai - Ei) / Vi # then yi and vi is Inf (set to NA at end) vi <- 1 / Vi } ### arcsine square root risk difference if (measure == "AS") { yi <- asin(sqrt(p1i)) - asin(sqrt(p2i)) vi <- 1/(4*n1i) + 1/(4*n2i) } ### phi coefficient if (is.element(measure, c("PHI","ZPHI"))) { yi <- (ai*di - bi*ci)/sqrt((ai+bi)*(ci+di)*(ai+ci)*(bi+di)) if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) q1i <- 1 - p1i q2i <- 1 - p2i pi1. <- (ai+bi) / ni pi2. <- (ci+di) / ni pi.1 <- (ai+ci) / ni pi.2 <- (bi+di) / ni if (!all(is.element(vtype, c("ST","LS","CS")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'ST', 'LS', or 'CS'.")) for (i in seq_len(k)) { ### estimate of the sampling variance for stratified sampling if (vtype[i] == "ST") { vi[i] <- ((n1i[i]+n2i[i])^2*(4*n1i[i]^3*p1i[i]^2*p2i[i]*q1i[i]^2*q2i[i] + 4*n2i[i]^3*p1i[i]*p2i[i]^2*q1i[i]*q2i[i]^2 + n1i[i]*n2i[i]^2*p2i[i]*q2i[i]*(p2i[i]*q1i[i] + p1i[i]*q2i[i])*(p2i[i]*q1i[i] + p1i[i]*(4*q1i[i] + q2i[i])) + n1i[i]^2*n2i[i]*p1i[i]*q1i[i]*(p2i[i]*q1i[i] + p1i[i]*q2i[i])*(p1i[i]*q2i[i] + p2i[i]*(q1i[i] + 4*q2i[i]))))/(4*(ai[i]+ci[i])^3*(bi[i]+di[i])^3) } ### estimate of the sampling variance for cross-sectional/multinomial sampling (equation in Yule, 1912, p.603) if (vtype[i] == "LS" || vtype[i] == "CS") { vi[i] <- 1/ni[i] * (1 - yi[i]^2 + yi[i]*(1+1/2*yi[i]^2) * (pi1.[i]-pi2.[i])*(pi.1[i]-pi.2[i]) / sqrt(pi1.[i]*pi2.[i]*pi.1[i]*pi.2[i]) - 3/4 * yi[i]^2 * ((pi1.[i]-pi2.[i])^2/(pi1.[i]*pi2.[i]) + (pi.1[i]-pi.2[i])^2/(pi.1[i]*pi.2[i]))) } } } ### Yule's Q (vi equation in Yule, 1900, p.285, and Yule, 1912, p.593) if (measure == "YUQ") { yi <- (ai/bi) / (ci/di) yi <- (yi-1) / (yi+1) vi <- 1/4 * (1-yi^2)^2 * (1/ai + 1/bi + 1/ci + 1/di) } ### Yule's Y (vi equation in Yule, 1912, p.593) if (measure == "YUY") { yi <- (ai/bi) / (ci/di) yi <- (sqrt(yi)-1) / (sqrt(yi)+1) vi <- 1/16 * (1-yi^2)^2 * (1/ai + 1/bi + 1/ci + 1/di) } ### tetrachoric correlation if (is.element(measure, c("RTET","ZTET"))) { ### TODO: allow user to set control arguments for pmvnorm and optimizers ### upgrade warnings to errors (so that tables with no events or only events are skipped) #warn.before <- getOption("warn") #options(warn = 2) yi <- rep(NA_real_, k) vi <- rep(NA_real_, k) for (i in seq_len(k)) { if (is.na(ai[i]) || is.na(bi[i]) || is.na(ci[i]) || is.na(di[i])) next res <- .rtet(ai[i], bi[i], ci[i], di[i], maxcor=.9999) yi[i] <- res$yi vi[i] <- res$vi } #options(warn = warn.before) } ### r-to-z transformation for PHI and RTET (note: NOT a variance-stabilizing transformation for these measures) if (is.element(measure, c("ZPHI","ZTET"))) { vi <- vi / (1 - ifelse(yi^2 > 1, 1, yi^2))^2 yi <- transf.rtoz(yi) } ### probit transformation to SMD if (measure == "PBIT") { z1i <- qnorm(p1i) z2i <- qnorm(p2i) yi <- z1i - z2i vi <- 2*base::pi*p1i*(1-p1i)*exp(z1i^2)/n1i + 2*base::pi*p2i*(1-p2i)*exp(z2i^2)/n2i # from Sanchez-Meca et al. (2003) and Rosenthal (1994; Handbook chapter) } # seems to be right for stratified and cross-sectional/multinomial sampling # see code/probit_transformation directory ### log(OR) transformation to SMD based on logistic distribution if (is.element(measure, c("OR2D","OR2DL"))) { yi <- sqrt(3) / base::pi * yi vi <- 3 / base::pi^2 * vi } ### log(OR) transformation to SMD based on normal distribution (Cox & Snell method) if (measure == "OR2DN") { yi <- yi / 1.65 vi <- vi / 1.65^2 } ### matched pairs / pre-post 2x2 table measures if (is.element(measure, c("MPRD","MPRR","MPOR"))) { pi12 <- bi / ni pi21 <- ci / ni pi1. <- (ai+bi) / ni pi.1 <- (ai+ci) / ni } if (measure == "MPRD") { yi <- pi1. - pi.1 vi <- pi12*(1-pi12)/ni + 2*pi12*pi21/ni + pi21*(1-pi21)/ni } if (measure == "MPRR") { yi <- log(pi1.) - log(pi.1) vi <- (pi12 + pi21) / (ni * pi1. * pi.1) } if (measure == "MPOR") { yi <- log(pi1./(1-pi1.)) - log(pi.1/(1-pi.1)) vi <- (pi12*(1-pi12) + pi21*(1-pi21) + 2*pi12*pi21) / (ni * pi1.*(1-pi1.) * pi.1*(1-pi.1)) } if (measure == "MPORM") { ai.p <- pi * (ai.u+bi.u) bi.p <- ai.u - ai.p ci.p <- ci.u - ai.p di.p <- bi.u - ci.u + ai.p ri.p <- (ai.p*di.p - bi.p*ci.p) / sqrt((ai.p+bi.p)*(ci.p+di.p)*(ai.p+ci.p)*(bi.p+di.p)) ri.p[ri.p < -1 | ri.p > 1] <- NA_real_ ri <- replmiss(ri, ri.p) if (addvi) { si <- (ri * sqrt(ai * bi * ci * di) + (ai * bi)) / ni deltai <- ni^2 * (ni * si - ai * bi) / (ai * bi * ci * di) vi <- vi - 2*deltai / ni } else { si.u <- (ri * sqrt(ai.u * bi.u * ci.u * di.u) + (ai.u * bi.u)) / ni.u deltai.u <- ni.u^2 * (ni.u * si.u - ai.u * bi) / (ai.u * bi.u * ci.u * di.u) vi <- vi - 2*deltai.u / ni.u } } if (measure == "MPORC") { yi <- log(bi) - log(ci) vi <- 1/bi + 1/ci } if (measure == "MPPETO") { Ei <- (bi + ci) / 2 Vi <- (bi + ci) / 4 yi <- (bi - Ei) / Vi vi <- 1/Vi } ### Note: Could in principle also compute measures commonly used in diagnostic studies. ### But need to take the sampling method into consideration when computing vi (so need ### to give this some more thought). ### sensitivity #if (measure == "SENS") { # res <- escalc("PR", xi=ai, mi=ci, add=0, to="none", vtype=vtype) # yi <- res$yi # vi <- res$vi #} ### specificity #if (measure == "SPEC") { # res <- escalc("PR", xi=di, mi=bi, add=0, to="none", vtype=vtype) # yi <- res$yi # vi <- res$vi #} ### [...] } ###################################################################### if (is.element(measure, c("IRR","IRD","IRSD"))) { x1i <- .getx("x1i", mf=mf, data=data, checknumeric=TRUE) x2i <- .getx("x2i", mf=mf, data=data, checknumeric=TRUE) t1i <- .getx("t1i", mf=mf, data=data, checknumeric=TRUE) t2i <- .getx("t2i", mf=mf, data=data, checknumeric=TRUE) if (!.all.specified(x1i, x2i, t1i, t2i)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., x1i, x2i, t1i, t2i).")) if (!.equal.length(x1i, x2i, t1i, t2i)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k.all <- length(x1i) if (!is.null(subset)) { subset <- .chksubset(subset, k.all) x1i <- .getsubset(x1i, subset) x2i <- .getsubset(x2i, subset) t1i <- .getsubset(t1i, subset) t2i <- .getsubset(t2i, subset) } if (any(c(x1i, x2i) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more counts are negative.")) if (any(c(t1i, t2i) <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more person-times are <= 0.")) ni.u <- t1i + t2i # unadjusted total sample sizes k <- length(x1i) ### if drop00=TRUE, set counts to NA for studies that have no events in both arms if (drop00) { id00 <- c(x1i == 0L & x2i == 0L) id00[is.na(id00)] <- FALSE x1i[id00] <- NA_real_ x2i[id00] <- NA_real_ } ### save unadjusted counts x1i.u <- x1i x2i.u <- x2i if (to == "all") { ### always add to all cells in all studies x1i <- x1i + add x2i <- x2i + add } if (to == "only0" || to == "if0all") { id0 <- c(x1i == 0L | x2i == 0L) id0[is.na(id0)] <- FALSE } if (to == "only0") { ### add to cells in studies with at least one 0 entry x1i[id0] <- x1i[id0] + add x2i[id0] <- x2i[id0] + add } if (to == "if0all") { ### add to cells in all studies if there is at least one 0 entry if (any(id0)) { x1i <- x1i + add x2i <- x2i + add } } ### compute rates for the two groups (unadjusted and adjusted) ### t1i and t2i are the total person-times in the 1st and 2nd group ir1i.u <- x1i.u/t1i ir2i.u <- x2i.u/t2i ir1i <- x1i/t1i ir2i <- x2i/t2i ### log incidence rate ratio if (measure == "IRR") { if (addyi) { yi <- log(ir1i) - log(ir2i) } else { yi <- log(ir1i.u) - log(ir2i.u) } if (addvi) { vi <- 1/x1i + 1/x2i #vi <- 1/(x1i+1/2) + 1/(x2i+1/2) } else { vi <- 1/x1i.u + 1/x2i.u } } ### incidence rate difference if (measure == "IRD") { if (addyi) { yi <- ir1i - ir2i } else { yi <- ir1i.u - ir2i.u } if (addvi) { vi <- ir1i/t1i + ir2i/t2i # note: same as x1i/t1i^2 + x2i/t2i^2 } else { vi <- ir1i.u/t1i + ir2i.u/t2i # note: same as x1i.u/t1i^2 + x2i.u/t2i^2 } } ### square root transformed incidence rate difference if (measure == "IRSD") { if (addyi) { yi <- sqrt(ir1i) - sqrt(ir2i) } else { yi <- sqrt(ir1i.u) - sqrt(ir2i.u) } vi <- 1/(4*t1i) + 1/(4*t2i) } } ###################################################################### if (is.element(measure, c("MD","SMD","SMDH","SMD1","SMD1H","ROM","RPB","ZPB","RBIS","ZBIS","D2OR","D2ORN","D2ORL","CVR","VR"))) { m1i <- .getx("m1i", mf=mf, data=data, checknumeric=TRUE) # for VR, do not need to supply this m2i <- .getx("m2i", mf=mf, data=data, checknumeric=TRUE) # for VR, do not need to supply this sd1i <- .getx("sd1i", mf=mf, data=data, checknumeric=TRUE) # for SMD1, do not need to supply this sd2i <- .getx("sd2i", mf=mf, data=data, checknumeric=TRUE) n1i <- .getx("n1i", mf=mf, data=data, checknumeric=TRUE) n2i <- .getx("n2i", mf=mf, data=data, checknumeric=TRUE) di <- .getx("di", mf=mf, data=data, checknumeric=TRUE) ti <- .getx("ti", mf=mf, data=data, checknumeric=TRUE) pi <- .getx("pi", mf=mf, data=data, checknumeric=TRUE) ### for these measures, need m1i, m2i, sd1i, sd2i, n1i, and n2i (and can also specify di/ti/pi) if (is.element(measure, c("SMD","RPB","ZPB","RBIS","ZBIS","D2OR","D2ORN","D2ORL"))) { if (!.equal.length(m1i, m2i, sd1i, sd2i, n1i, n2i, di, ti, pi)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) ### convert pi to ti values ti <- replmiss(ti, .convp2t(pi, df=n1i+n2i-2)) ### convert ti to di values di <- replmiss(di, ti * sqrt(1/n1i + 1/n2i)) ### when di is available, set m1i, m2i, sd1i, and sd2i values accordingly m1i[!is.na(di)] <- di[!is.na(di)] m2i[!is.na(di)] <- 0 sd1i[!is.na(di)] <- 1 sd2i[!is.na(di)] <- 1 if (!.all.specified(m1i, m2i, sd1i, sd2i, n1i, n2i)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., m1i, m2i, sd1i, sd2i, n1i, n2i (and di, ti, pi)).")) } ### for these measures, need m1i, m2i, sd1i, sd2i, n1i, and n2i if (is.element(measure, c("MD","SMDH","SMD1H","ROM","CVR"))) { if (!.all.specified(m1i, m2i, sd1i, sd2i, n1i, n2i)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., m1i, m2i, sd1i, sd2i, n1i, n2i).")) if (!.equal.length(m1i, m2i, sd1i, sd2i, n1i, n2i)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) } ### for this measure, need sd1i, sd2i, n1i, and n2i if (measure == "VR") { if (!.all.specified(sd1i, sd2i, n1i, n2i)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., sd1i, sd2i, n1i, n2i).")) if (!.equal.length(sd1i, sd2i, n1i, n2i)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) } ### for this measure, need m1i, m2i, sd2i, n1i, and n2i if (measure == "SMD1") { if (!.all.specified(m1i, m2i, sd2i, n1i, n2i)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., m1i, m2i, sd2i, n1i, n2i).")) if (!.equal.length(m1i, m2i, sd2i, n1i, n2i)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) } k.all <- length(n1i) if (!is.null(subset)) { subset <- .chksubset(subset, k.all) m1i <- .getsubset(m1i, subset) m2i <- .getsubset(m2i, subset) sd1i <- .getsubset(sd1i, subset) sd2i <- .getsubset(sd2i, subset) n1i <- .getsubset(n1i, subset) n2i <- .getsubset(n2i, subset) } if (any(c(sd1i, sd2i) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more standard deviations are negative.")) if (any(c(n1i, n2i) <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more group sizes are <= 0.")) ni.u <- n1i + n2i # unadjusted total sample sizes k <- length(n1i) ni <- ni.u if (is.element(measure, c("SMD1","SMD1H"))) { mi <- n2i - 1 sdpi <- sd2i npi <- n2i } else { mi <- ni - 2 sdpi <- sqrt(((n1i-1)*sd1i^2 + (n2i-1)*sd2i^2) / mi) npi <- ni } di <- (m1i - m2i) / sdpi ### (raw) mean difference (with heteroscedastic variances) ### to use with pooled SDs, simply set sd1i = sd2i = sdpi or use vtype="HO" if (measure == "MD") { yi <- m1i - m2i if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) if (!all(is.element(vtype, c("UB","LS","HO")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'UB', 'LS', or 'HO'.")) for (i in seq_len(k)) { ### unbiased estimate of the sampling variance (does not assume homoscedasticity) if (vtype[i] == "UB" || vtype[i] == "LS") vi[i] <- sd1i[i]^2/n1i[i] + sd2i[i]^2/n2i[i] ### estimate assuming homoscedasticity of the two variances within studies if (vtype[i] == "HO") vi[i] <- sdpi[i]^2 * (1/n1i[i] + 1/n2i[i]) } } ### standardized mean difference (with pooled SDs or just the SD of group 2) if (is.element(measure, c("SMD","SMD1"))) { ### apply bias-correction to di values cmi <- .cmicalc(mi, correct=correct) yi <- cmi * di if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) mnwyi <- .wmean(yi, ni, na.rm=TRUE) # sample size weighted average of yi's if (!all(is.element(vtype, c("UB","LS","LS2","AV")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'UB', 'LS', 'LS2', or 'AV'.")) for (i in seq_len(k)) { ### unbiased estimate of the sampling variance if (vtype[i] == "UB") vi[i] <- 1/n1i[i] + 1/n2i[i] + (1 - (mi[i]-2)/(mi[i]*cmi[i]^2)) * yi[i]^2 ### large sample approximation to the sampling variance if (vtype[i] == "LS") vi[i] <- 1/n1i[i] + 1/n2i[i] + yi[i]^2/(2*npi[i]) ### estimate assuming homogeneity (using sample size weighted average of the yi's) if (vtype[i] == "AV") vi[i] <- 1/n1i[i] + 1/n2i[i] + mnwyi^2/(2*npi[i]) ### large sample approximation to the sampling variance (equation 4.24 in Borenstein, 2009) if (vtype[i] == "LS2") vi[i] <- cmi[i]^2 * (1/n1i[i] + 1/n2i[i] + di[i]^2/(2*npi[i])) } } ### standardized mean difference (with heteroscedastic SDs) if (measure == "SMDH") { cmi <- .cmicalc(mi, correct=correct) si <- sqrt((sd1i^2 + sd2i^2)/2) yi <- cmi * (m1i - m2i) / si if (vtype == "LS") { ### note: Bonett (2009) plugs in the uncorrected yi into the ### equation for vi; here, the corrected value is plugged in vi <- yi^2 * (sd1i^4 / (n1i-1) + sd2i^4 / (n2i-1)) / (2*(sd1i^2 + sd2i^2)^2) + (sd1i^2 / (n1i-1) + sd2i^2 / (n2i-1)) / ((sd1i^2 + sd2i^2)/2) vi <- cmi^2 * vi } if (vtype == "LS2") ### based on standard application of delta method vi <- yi^2 * sd1i^2 / (2*n1i*(sd1i^2+sd2i^2)^2) + yi^2 * sd2i^2 / (2*n2i*(sd1i^2+sd2i^2)^2) + 2*sd1i^2 / (n1i*(sd1i^2+sd2i^2)) + 2*sd2i^2 / (n2i*(sd1i^2+sd2i^2)) } ### standardized mean difference standardized by SD of group 2 (with heteroscedastic SDs) if (measure == "SMD1H") { cmi <- .cmicalc(mi, correct=correct) yi <- cmi * di vi <- (sd1i^2/sd2i^2)/n1i + 1/n2i + yi^2/(2*n2i) #vi <- cmi^2 * vi } ### ratio of means (response ratio) ### to use with pooled SDs, simply set sd1i = sd2i = sdpi or use vtype="HO" if (measure == "ROM") { yi <- log(m1i/m2i) if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) mn1wcvi <- .wmean(sd1i/m1i, n1i, na.rm=TRUE) # sample size weighted average of the coefficient of variation in group 1 mn2wcvi <- .wmean(sd2i/m2i, n2i, na.rm=TRUE) # sample size weighted average of the coefficient of variation in group 2 not.na <- !(is.na(n1i) | is.na(n2i) | is.na(sd1i/m1i) | is.na(sd2i/m2i)) mnwcvi <- (sum(n1i[not.na]*(sd1i/m1i)[not.na]) + sum(n2i[not.na]*(sd2i/m2i)[not.na])) / sum((n1i+n2i)[not.na]) # sample size weighted average of the two CV values if (!all(is.element(vtype, c("LS","HO","AV","AVHO")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'LS', 'HO', 'AV', or 'AVHO'.")) for (i in seq_len(k)) { ### large sample approximation to the sampling variance (does not assume homoscedasticity) if (vtype[i] == "LS") vi[i] <- sd1i[i]^2/(n1i[i]*m1i[i]^2) + sd2i[i]^2/(n2i[i]*m2i[i]^2) ### estimate assuming homoscedasticity of the two variances within studies if (vtype[i] == "HO") vi[i] <- sdpi[i]^2/(n1i[i]*m1i[i]^2) + sdpi[i]^2/(n2i[i]*m2i[i]^2) ### estimate using the weighted averages of the CV values if (vtype[i] == "AV") vi[i] <- mn1wcvi^2/n1i[i] + mn2wcvi^2/n2i[i] ### estimate using the weighted average of two weighted averages of the CV values if (vtype[i] == "AVHO") vi[i] <- mnwcvi^2 * (1/n1i[i] + 1/n2i[i]) } } ### point-biserial correlation obtained from the standardized mean difference ### this is based on Tate's model where Y|X=0 and Y|X=1 are normally distributed (with the same variance) ### Das Gupta (1960) describes the case where Y itself is normal, but the variance expressions therein can ### really only be used in some special cases (not useful in practice) if (is.element(measure, c("RPB","RBIS","ZPB","ZBIS"))) { hi <- mi/n1i + mi/n2i yi <- di / sqrt(di^2 + hi) # need this also when measure="RBIS/ZBIS" if (is.element(measure, c("RPB","ZPB"))) { # this only applies when measure="RPB/ZPB" if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) if (!all(is.element(vtype, c("ST","LS","CS")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'ST', 'LS', or 'CS'.")) for (i in seq_len(k)) { ### estimate of the sampling variance for fixed n1i and n2i (i.e., stratified sampling) if (vtype[i] == "ST" || vtype[i] == "LS") vi[i] <- hi[i]^2 / (hi[i] + di[i]^2)^3 * (1/n1i[i] + 1/n2i[i] + di[i]^2/(2*ni[i])) ### estimate of the sampling variance for fixed ni but random n1i and n2i (i.e., cross-sectional/multinomial sampling) if (vtype[i] == "CS") vi[i] <- (1-yi[i]^2)^2 * (ni[i]*yi[i]^2 / (4*n1i[i]*n2i[i]) + (2-3*yi[i]^2)/(2*ni[i])) # from Tate (1954, 1955b) } } } ### biserial correlation obtained from the standardized mean difference (continued from above) if (is.element(measure, c("RBIS","ZBIS"))) { p1i <- n1i / ni p2i <- n2i / ni zi <- qnorm(p1i, lower.tail=FALSE) fzi <- dnorm(zi) yi <- sqrt(p1i*p2i) / fzi * yi # yi on the right-hand side is the point-biserial correlation from above #vi <- (p1i*p2i) / fzi^2 * vi # not correct (p1i, p2i, and fzi are random variables and vi from RBP is not correct for the bivariate normal case on which RBIS is based) yi.t <- ifelse(abs(yi) > 1, sign(yi), yi) vi <- 1/(ni-1) * (p1i*p2i/fzi^2 - (3/2 + (1 - p1i*zi/fzi)*(1 + p2i*zi/fzi)) * yi.t^2 + yi.t^4) # from Soper (1914) #vi <- 1/(ni-1) * (yi.t^4 + yi.t^2 * (p1i*p2i*zi^2/fzi^2 + (2*p1i-1)*zi/fzi - 5/2) + p1i*p2i/fzi^2) # from Tate (1955) -- equivalent to eq. from Soper (1914) ### equation appears to work even if dichotomization is done based on a sample quantile value (so that p1i, p2i, and fzi are fixed by design) } ### r-to-z transformation for RPB and RBIS (note: NOT a variance-stabilizing transformation for these measures) if (is.element(measure, c("ZPB","ZBIS"))) { vi <- vi / (1 - ifelse(yi^2 > 1, 1, yi^2))^2 yi <- transf.rtoz(yi) } ### SMD to log(OR) transformation based on logistic distribution if (is.element(measure, c("D2OR","D2ORL"))) { yi <- base::pi / sqrt(3) * di vi <- base::pi^2 / 3 * (1/n1i + 1/n2i + di^2/(2*ni)) } ### SMD to log(OR) transformation based on normal distribution (Cox & Snell method) if (measure == "D2ORN") { yi <- 1.65 * di vi <- 1.65^2 * (1/n1i + 1/n2i + di^2/(2*ni)) } ### coefficient of variation ratio ### note: vi computed as per eq. 12 from Nakagawa et al. (2015), but without the '-2 rho ...' terms, ### since for normally distributed data the mean and variance (and transformations thereof) are independent if (measure == "CVR") { yi <- log(sd1i/m1i) + 1/(2*(n1i-1)) - log(sd2i/m2i) - 1/(2*(n2i-1)) vi <- 1/(2*(n1i-1)) + sd1i^2/(n1i*m1i^2) + 1/(2*(n2i-1)) + sd2i^2/(n2i*m2i^2) } ### variability ratio if (measure == "VR") { yi <- log(sd1i/sd2i) + 1/(2*(n1i-1)) - 1/(2*(n2i-1)) vi <- 1/(2*(n1i-1)) + 1/(2*(n2i-1)) } } ###################################################################### if (is.element(measure, c("COR","UCOR","ZCOR"))) { ri <- .getx("ri", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) ti <- .getx("ti", mf=mf, data=data, checknumeric=TRUE) pi <- .getx("pi", mf=mf, data=data, checknumeric=TRUE) if (!.equal.length(ri, ni, ti, pi)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) ### convert pi to ti values ti <- replmiss(ti, .convp2t(pi, df=ni-2)) ### convert ti to ri values ri <- replmiss(ri, ti / sqrt(ti^2 + ni-2)) if (!.all.specified(ri, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., ri, ni (and ti, pi)).")) k.all <- length(ri) if (!is.null(subset)) { subset <- .chksubset(subset, k.all) ri <- .getsubset(ri, subset) ni <- .getsubset(ni, subset) } if (any(abs(ri) > 1, na.rm=TRUE)) stop(mstyle$stop("One or more correlations are > 1 or < -1.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more sample sizes are <= 0.")) if (measure != "UCOR" && vtype == "UB") stop(mstyle$stop("Use of vtype='UB' only permitted when measure='UCOR'.")) if (measure == "UCOR" && any(ni <= 4, na.rm=TRUE)) warning(mstyle$warning("Cannot compute the bias-corrected correlation coefficient when ni <= 4."), call.=FALSE) if (measure == "ZCOR" && any(ni <= 3, na.rm=TRUE)) warning(mstyle$warning("Cannot estimate the sampling variance when ni <= 3."), call.=FALSE) ni.u <- ni # unadjusted total sample sizes k <- length(ri) ### raw correlation coefficient if (measure == "COR") yi <- ri ### raw correlation coefficient with bias correction if (measure == "UCOR") { #yi <- ri + ri*(1-ri^2)/(2*(ni-4)) # approximation #yi[ni <= 4] <- NA_real_ # set corrected correlations for ni <= 4 to NA_real_ yi <- ri * .Fcalc(1/2, 1/2, (ni-2)/2, 1-ri^2) } ### sampling variances for COR or UCOR if (is.element(measure, c("COR","UCOR"))) { if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) mnwyi <- .wmean(yi, ni, na.rm=TRUE) # sample size weighted average of yi's if (!all(is.element(vtype, c("UB","LS","AV")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'UB', 'LS', or 'AV'.")) for (i in seq_len(k)) { ### unbiased estimate of the sampling variance of the bias-corrected correlation coefficient if (vtype[i] == "UB") { #vi[i] <- yi[i]^2 - 1 + (ni[i]-3) / (ni[i]-2) * ((1-ri[i]^2) + 2*(1-ri[i]^2)^2/ni[i] + 8*(1-ri[i]^2)^3/(ni[i]*(ni[i]+2)) + 48*(1-ri[i]^2)^4/(ni[i]*(ni[i]+2)*(ni[i]+4))) vi[i] <- yi[i]^2 - (1 - (ni[i]-3) / (ni[i]-2) * (1-ri[i]^2) * .Fcalc(1, 1, ni[i]/2, 1-ri[i]^2)) } ### large sample approximation to the sampling variance if (vtype[i] == "LS") vi[i] <- (1-yi[i]^2)^2 / (ni[i]-1) ### estimate assuming homogeneity (using sample size weighted average of the yi's) if (vtype[i] == "AV") vi[i] <- (1-mnwyi^2)^2 / (ni[i]-1) } } ### r-to-z transformed correlation if (measure == "ZCOR") { yi <- transf.rtoz(ri) vi <- 1 / (ni-3) } ### set sampling variances for ni <= 3 to NA vi[ni <= 3] <- NA_real_ } ###################################################################### if (is.element(measure, c("PCOR","ZPCOR","SPCOR","ZSPCOR"))) { ri <- .getx("ri", mf=mf, data=data, checknumeric=TRUE) ti <- .getx("ti", mf=mf, data=data, checknumeric=TRUE) mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) pi <- .getx("pi", mf=mf, data=data, checknumeric=TRUE) r2i <- .getx("r2i", mf=mf, data=data, checknumeric=TRUE) if (!.equal.length(ri, ti, mi, ni, pi, r2i)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) ### convert pi to ti values ti <- replmiss(ti, .convp2t(pi, df=ni-mi-1)) ### convert ti to ri values if (is.element(measure, c("PCOR","ZPCOR"))) ri <- replmiss(ri, ti / sqrt(ti^2 + ni-mi-1)) if (is.element(measure, c("SPCOR","ZSPCOR"))) ri <- replmiss(ri, ti * sqrt(1-r2i) / sqrt(ni-mi-1)) if (is.element(measure, c("PCOR","ZPCOR")) && !.all.specified(ri, mi, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., ri, ti, mi, ni (and pi)).")) if (is.element(measure, c("SPCOR","ZSPCOR")) && !.all.specified(ri, mi, ni, r2i)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., ri, ti, mi, ni, r2i (and pi)).")) k.all <- length(ri) if (!is.null(subset)) { subset <- .chksubset(subset, k.all) ri <- .getsubset(ri, subset) mi <- .getsubset(mi, subset) ni <- .getsubset(ni, subset) r2i <- .getsubset(r2i, subset) } if (any(abs(ri) > 1, na.rm=TRUE)) stop(mstyle$stop("One or more (semi-)partial correlations are > 1 or < -1.")) if (is.element(measure, c("SPCOR","ZSPCOR")) && any(r2i > 1 | r2i < 0, na.rm=TRUE)) stop(mstyle$stop("One or more R^2 values are > 1 or < 0.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more sample sizes are <= 0.")) if (any(mi <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more mi values are <= 0.")) if (any(ni-mi-1 <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more dfs are <= 0.")) ni.u <- ni # unadjusted total sample sizes k <- length(ri) ### partial correlation coefficient if (measure == "PCOR") { yi <- ri if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) mnwyi <- .wmean(yi, ni, na.rm=TRUE) # sample size weighted average of yi's if (!all(is.element(vtype, c("LS","AV")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'LS' or 'AV'.")) for (i in seq_len(k)) { ### large sample approximation to the sampling variance if (vtype[i] == "LS") vi[i] <- (1 - yi[i]^2)^2 / (ni[i] - mi[i]) ### estimate assuming homogeneity (using sample size weighted average of the yi's) if (vtype[i] == "AV") vi[i] <- (1 - mnwyi^2)^2 / (ni[i] - mi[i]) } } ### r-to-z transformed partial correlation if (measure == "ZPCOR") { yi <- transf.rtoz(ri) vi <- 1 / (ni-mi-2) } ### semi-partial correlation coefficient if (is.element(measure, c("SPCOR","ZSPCOR"))) { yi <- ri if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) mnwyi <- .wmean(yi, ni, na.rm=TRUE) # sample size weighted average of yi's if (!all(is.element(vtype, c("LS","AV")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'LS' or 'AV'.")) for (i in seq_len(k)) { ### large sample approximation to the sampling variance if (vtype[i] == "LS") vi[i] <- (r2i[i]^2 - 2*r2i[i] + (r2i[i] - yi[i]^2) + 1 - (r2i[i] - yi[i]^2)^2) / ni[i] ### estimate assuming homogeneity (using sample size weighted average of the yi's) if (vtype[i] == "AV") vi[i] <- (r2i[i]^2 - 2*r2i[i] + (r2i[i] - mnwyi^2) + 1 - (r2i[i] - mnwyi^2)^2) / ni[i] } } ### r-to-z transformation for ZPCOR (note: NOT a variance-stabilizing transformation for this measure) if (measure == "ZSPCOR") { vi <- vi / (1 - ifelse(yi^2 > 1, 1, yi^2))^2 yi <- transf.rtoz(yi) } } ###################################################################### if (is.element(measure, c("R2","ZR2"))) { r2i <- .getx("r2i", mf=mf, data=data, checknumeric=TRUE) mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) fi <- .getx("fi", mf=mf, data=data, checknumeric=TRUE) pi <- .getx("pi", mf=mf, data=data, checknumeric=TRUE) if (!.equal.length(r2i, mi, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) ### convert pi to fi values fi <- replmiss(fi, .convp2f(pi, df1=mi, df2=ni-mi-1)) ### convert fi to r2i values r2i <- replmiss(r2i, mi*fi / (mi*fi + (ni-mi-1))) if (!.all.specified(r2i, mi, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., r2i, mi, ni (and fi, pi)).")) k.all <- length(r2i) if (!is.null(subset)) { subset <- .chksubset(subset, k.all) r2i <- .getsubset(r2i, subset) mi <- .getsubset(mi, subset) ni <- .getsubset(ni, subset) } if (any(r2i > 1 | r2i < 0, na.rm=TRUE)) stop(mstyle$stop("One or more R^2 values are > 1 or < 0.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more sample sizes are <= 0.")) if (any(mi <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more mi values are <= 0.")) if (any(ni-mi- 1 <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more dfs are <= 0.")) ni.u <- ni # unadjusted total sample sizes k <- length(r2i) ### partial correlation coefficient if (measure == "R2") { yi <- r2i if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) mnwyi <- .wmean(yi, ni, na.rm=TRUE) # sample size weighted average of yi's if (!all(is.element(vtype, c("LS","LS2","AV")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'LS' or 'AV'.")) for (i in seq_len(k)) { ### large sample approximation to the sampling variance (simplified equation) if (vtype[i] == "LS") vi[i] <- 4 * yi[i] * (1 - yi[i])^2 / ni[i] ### estimate assuming homogeneity (using sample size weighted average of the yi's) if (vtype[i] == "AV") vi[i] <- 4 * mnwyi[i] * (1 - mnwyi[i])^2 / ni[i] ### large sample approximation to the sampling variance (full equation) if (vtype[i] == "LS2") vi[i] <- 4 * yi[i] * (1 - yi[i])^2 * (ni[i] - mi[i] - 1)^2 / ((ni[i]^2 - 1) * (ni[i] + 3)) ### estimate assuming homogeneity (using sample size weighted average of the yi's) if (vtype[i] == "AV2") vi[i] <- 4 * mnwyi[i] * (1 - mnwyi[i])^2 * (ni[i] - mi[i] - 1)^2 / ((ni[i]^2 - 1) * (ni[i] + 3)) } } ### r-to-z transformed partial correlation if (measure == "ZR2") { yi <- transf.rtoz(sqrt(r2i)) vi <- 1 / ni } } ###################################################################### if (is.element(measure, c("PR","PLN","PLO","PAS","PFT"))) { xi <- .getx("xi", mf=mf, data=data, checknumeric=TRUE) mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) if (!.equal.length(xi, mi, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) ni.inc <- ni != xi + mi if (any(ni.inc, na.rm=TRUE)) stop(mstyle$stop("One or more 'ni' values are not equal to 'xi + mi'.")) mi <- replmiss(mi, ni-xi) if (!.all.specified(xi, mi)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., xi, mi or xi, ni).")) k.all <- length(xi) if (!is.null(subset)) { subset <- .chksubset(subset, k.all) xi <- .getsubset(xi, subset) mi <- .getsubset(mi, subset) } ni <- xi + mi if (any(xi > ni, na.rm=TRUE)) stop(mstyle$stop("One or more event counts are larger than the corresponding group sizes.")) if (any(c(xi, mi) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more counts are negative.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more group sizes are <= 0.")) ni.u <- ni # unadjusted total sample sizes k <- length(xi) ### save unadjusted counts xi.u <- xi mi.u <- mi k <- length(xi) if (to == "all") { ### always add to all cells in all studies xi <- xi + add mi <- mi + add } if (to == "only0" || to == "if0all") { id0 <- c(xi == 0L | mi == 0L) id0[is.na(id0)] <- FALSE } if (to == "only0") { ### add to cells in studies with at least one 0 entry xi[id0] <- xi[id0] + add mi[id0] <- mi[id0] + add } if (to == "if0all") { ### add to cells in all studies if there is at least one 0 entry if (any(id0)) { xi <- xi + add mi <- mi + add } } ### recompute sample sizes (after add/to adjustment) ni <- xi + mi ### compute proportions (unadjusted and adjusted) pri.u <- xi.u/ni.u pri <- xi/ni ### raw proportion if (measure == "PR") { if (addyi) { yi <- pri } else { yi <- pri.u } if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) if (addvi) { mnwpri <- .wmean(pri, ni, na.rm=TRUE) # sample size weighted average of proportions } else { mnwpri.u <- .wmean(pri.u, ni.u, na.rm=TRUE) # sample size weighted average of proportions } if (!all(is.element(vtype, c("UB","LS","AV")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'UB', 'LS', or 'AV'.")) for (i in seq_len(k)) { ### unbiased estimate of the sampling variance if (vtype[i] == "UB") { if (addvi) { vi[i] <- pri[i]*(1-pri[i])/(ni[i]-1) } else { vi[i] <- pri.u[i]*(1-pri.u[i])/(ni.u[i]-1) } } ### large sample approximation to the sampling variance if (vtype[i] == "LS") { if (addvi) { vi[i] <- pri[i]*(1-pri[i])/ni[i] } else { vi[i] <- pri.u[i]*(1-pri.u[i])/ni.u[i] } } ### estimate assuming homogeneity (using the average proportion) if (vtype[i] == "AV") { if (addvi) { vi[i] <- mnwpri*(1-mnwpri)/ni[i] } else { vi[i] <- mnwpri.u*(1-mnwpri.u)/ni.u[i] } } } } ### proportion with log transformation if (measure == "PLN") { if (addyi) { yi <- log(pri) } else { yi <- log(pri.u) } if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) if (addvi) { mnwpri <- .wmean(pri, ni, na.rm=TRUE) # sample size weighted average of proportions #mnwpri <- exp(.wmean(yi, ni, na.rm=TRUE)) # alternative strategy (exp of the sample size weighted average of the log proportions) } else { mnwpri.u <- .wmean(pri.u, ni.u, na.rm=TRUE) # sample size weighted average of proportions } if (!all(is.element(vtype, c("LS","AV")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'LS' or 'AV'.")) for (i in seq_len(k)) { ### large sample approximation to the sampling variance if (vtype[i] == "LS") { if (addvi) { vi[i] <- 1/xi[i] - 1/ni[i] } else { vi[i] <- 1/xi.u[i] - 1/ni.u[i] } } ### estimate assuming homogeneity (using the average proportion) if (vtype[i] == "AV") { if (addvi) { vi[i] <- 1/(mnwpri*ni[i]) - 1/ni[i] } else { vi[i] <- 1/(mnwpri.u*ni.u[i]) - 1/ni.u[i] } } } } ### proportion with logit (log odds) transformation if (measure == "PLO") { if (addyi) { yi <- log(pri/(1-pri)) } else { yi <- log(pri.u/(1-pri.u)) } if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) if (addvi) { mnwpri <- .wmean(pri, ni, na.rm=TRUE) # sample size weighted average of proportions #mnwpri <- transf.ilogit(.wmean(yi, ni, na.rm=TRUE)) # alternative strategy (inverse logit of the sample size weighted average of the logit transformed proportions) } else { mnwpri.u <- .wmean(pri.u, ni.u, na.rm=TRUE) # sample size weighted average of proportions } if (!all(is.element(vtype, c("LS","AV")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'LS' or 'AV'.")) for (i in seq_len(k)) { ### large sample approximation to the sampling variance if (vtype[i] == "LS") { if (addvi) { vi[i] <- 1/xi[i] + 1/mi[i] } else { vi[i] <- 1/xi.u[i] + 1/mi.u[i] } } ### estimate assuming homogeneity (using the average proportion) if (vtype[i] == "AV") { if (addvi) { vi[i] <- 1/(mnwpri*ni[i]) + 1/((1-mnwpri)*ni[i]) } else { vi[i] <- 1/(mnwpri.u*ni.u[i]) + 1/((1-mnwpri.u)*ni.u[i]) } } } } ### note: addyi and addvi only implemented for measures above ### proportion with arcsine square root (angular) transformation if (measure == "PAS") { yi <- asin(sqrt(pri)) vi <- 1/(4*ni) } ### proportion with Freeman-Tukey double arcsine transformation if (measure == "PFT") { yi <- 1/2*(asin(sqrt(xi/(ni+1))) + asin(sqrt((xi+1)/(ni+1)))) vi <- 1/(4*ni + 2) } } ###################################################################### if (is.element(measure, c("IR","IRLN","IRS","IRFT"))) { xi <- .getx("xi", mf=mf, data=data, checknumeric=TRUE) ti <- .getx("ti", mf=mf, data=data, checknumeric=TRUE) if (!.all.specified(xi, ti)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., xi, ti).")) if (!.equal.length(xi, ti)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k.all <- length(xi) if (!is.null(subset)) { subset <- .chksubset(subset, k.all) xi <- .getsubset(xi, subset) ti <- .getsubset(ti, subset) } if (any(xi < 0, na.rm=TRUE)) stop(mstyle$stop("One or more counts are negative.")) if (any(ti <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more person-times are <= 0.")) ni.u <- ti # unadjusted total sample sizes k <- length(xi) ### save unadjusted counts xi.u <- xi if (to == "all") { ### always add to all cells in all studies xi <- xi + add } if (to == "only0" || to == "if0all") { id0 <- c(xi == 0L) id0[is.na(id0)] <- FALSE } if (to == "only0") { ### add to cells in studies with at least one 0 entry xi[id0] <- xi[id0] + add } if (to == "if0all") { ### add to cells in all studies if there is at least one 0 entry if (any(id0)) { xi <- xi + add } } ### compute rates (unadjusted and adjusted) iri.u <- xi.u / ti iri <- xi / ti ### raw incidence rate if (measure == "IR") { if (addyi) { yi <- iri } else { yi <- iri.u } if (addvi) { vi <- iri / ti # note: same as xi/ti^2 } else { vi <- iri.u / ti # note: same as xi.u/ti^2 } } ### log transformed incidence rate if (measure == "IRLN") { if (addyi) { yi <- log(iri) } else { yi <- log(iri.u) } if (addvi) { vi <- 1 / xi } else { vi <- 1 / xi.u } } ### square root transformed incidence rate if (measure == "IRS") { if (addyi) { yi <- sqrt(iri) } else { yi <- sqrt(iri.u) } vi <- 1 / (4*ti) } ### note: addyi and addvi only implemented for measures above ### incidence rate with Freeman-Tukey transformation if (measure == "IRFT") { yi <- 1/2 * (sqrt(iri) + sqrt(iri+1/ti)) vi <- 1 / (4*ti) } } ###################################################################### if (is.element(measure, c("MN","MNLN","CVLN","SDLN","SMN"))) { mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) # for SDLN, do not need to supply this sdi <- .getx("sdi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) ### for these measures, need mi, sdi, and ni if (is.element(measure, c("MN","MNLN","CVLN","SMN"))) { if (!.all.specified(mi, sdi, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., mi, sdi, ni).")) if (!.equal.length(mi, sdi, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) } ### for this measure, need sdi and ni if (measure == "SDLN") { if (!.all.specified(sdi, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., sdi, ni).")) if (!.equal.length(sdi, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) } k.all <- length(ni) if (!is.null(subset)) { subset <- .chksubset(subset, k.all) mi <- .getsubset(mi, subset) sdi <- .getsubset(sdi, subset) ni <- .getsubset(ni, subset) } if (any(sdi < 0, na.rm=TRUE)) stop(mstyle$stop("One or more standard deviations are negative.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more sample sizes are <= 0.")) if (is.element(measure, c("MNLN","CVLN")) && any(mi < 0, na.rm=TRUE)) stop(mstyle$stop("One or more means are negative.")) ni.u <- ni # unadjusted total sample sizes k <- length(ni) ### (raw) mean if (measure == "MN") { yi <- mi sdpi <- sqrt(.wmean(sdi^2, ni-1, na.rm=TRUE)) if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) if (!all(is.element(vtype, c("LS","HO")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either ''LS' or 'HO'.")) for (i in seq_len(k)) { ### compute the sampling variance per study if (vtype[i] == "LS") vi[i] <- sdi[i]^2 / ni[i] ### compute the sampling variance assuming homoscedasticity of variances across studies if (vtype[i] == "HO") vi[i] <- sdpi^2 / ni[i] } } ### log(mean) if (measure == "MNLN") { yi <- log(mi) vi <- sdi^2 / (ni*mi^2) } ### log(CV) with bias correction ### note: vi computed as per eq. 27 from Nakagawa et al. (2015), but without the '-2 rho ...' term, ### since for normally distributed data the mean and variance (and transformations thereof) are independent if (measure == "CVLN") { if (correct) { yi <- log(sdi/mi) + 1 / (2*(ni-1)) } else { yi <- log(sdi/mi) } vi <- 1 / (2*(ni-1)) + sdi^2 / (ni*mi^2) } ### log(SD) with bias correction if (measure == "SDLN") { if (correct) { yi <- log(sdi) + 1 / (2*(ni-1)) } else { yi <- log(sdi) } vi <- 1 / (2*(ni-1)) } ### single-group standardized mean if (measure == "SMN") { cmi <- .cmicalc(ni-1) yi <- cmi * mi / sdi vi <- 1 / ni + yi^2 / (2*ni) } } ###################################################################### if (is.element(measure, c("MC","SMCC","SMCR","SMCRH","ROMC","CVRC","VRC"))) { m1i <- .getx("m1i", mf=mf, data=data, checknumeric=TRUE) # for VRC, do not need to supply this m2i <- .getx("m2i", mf=mf, data=data, checknumeric=TRUE) # for VRC, do not need to supply this sd1i <- .getx("sd1i", mf=mf, data=data, checknumeric=TRUE) sd2i <- .getx("sd2i", mf=mf, data=data, checknumeric=TRUE) # for SMCR, do not need to supply this ri <- .getx("ri", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) di <- .getx("di", mf=mf, data=data, checknumeric=TRUE) ti <- .getx("ti", mf=mf, data=data, checknumeric=TRUE) pi <- .getx("pi", mf=mf, data=data, checknumeric=TRUE) if (is.element(measure, c("MC","SMCRH","ROMC","CVRC"))) { ### for these measures, need m1i, m2i, sd1i, sd2i, ni, and ri if (!.all.specified(m1i, m2i, sd1i, sd2i, ri, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., m1i, m2i, sd1i, sd2i, ni, ri).")) if (!.equal.length(m1i, m2i, sd1i, sd2i, ri, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) } if (measure == "SMCC") { ### for this measures, need m1i, m2i, sd1i, sd2i, ni, and ri (and can also specify di/ti/pi) if (!.equal.length(m1i, m2i, sd1i, sd2i, ri, ni, di, ti, pi)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) ### convert pi to ti values ti <- replmiss(ti, .convp2t(pi, df=ni-1)) ### convert ti to di values di <- replmiss(di, ti * sqrt(1/ni)) ### when di is available, set m1i, m2i, sd1i, sd2i, and ri values accordingly m1i[!is.na(di)] <- di[!is.na(di)] m2i[!is.na(di)] <- 0 sd1i[!is.na(di)] <- 1 sd2i[!is.na(di)] <- 1 ri[!is.na(di)] <- 0.5 if (!.all.specified(m1i, m2i, sd1i, sd2i, ri, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., m1i, m2i, sd1i, sd2i, ni, ri (and di, ti, pi)).")) } if (measure == "SMCR") { ### for this measure, need m1i, m2i, sd1i, ni, and ri (do not need sd2i) if (!.all.specified(m1i, m2i, sd1i, ri, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., m1i, m2i, sd1i, ni, ri).")) if (!.equal.length(m1i, m2i, sd1i, ri, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) } if (measure == "VRC") { ### for this measure, need sd1i, sd2i, ni, and ri if (!.all.specified(sd1i, sd2i, ri, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., sd1i, sd2i, ni, ri).")) if (!.equal.length(sd1i, sd2i, ri, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) } k.all <- length(ni) if (!is.null(subset)) { subset <- .chksubset(subset, k.all) m1i <- .getsubset(m1i, subset) m2i <- .getsubset(m2i, subset) sd1i <- .getsubset(sd1i, subset) sd2i <- .getsubset(sd2i, subset) ni <- .getsubset(ni, subset) ri <- .getsubset(ri, subset) } if (is.element(measure, c("MC","SMCC","SMCRH","ROMC","CVRC","VRC"))) { if (any(c(sd1i, sd2i) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more standard deviations are negative.")) } if (measure == "SMCR") { if (any(sd1i < 0, na.rm=TRUE)) stop(mstyle$stop("One or more standard deviations are negative.")) } if (any(abs(ri) > 1, na.rm=TRUE)) stop(mstyle$stop("One or more correlations are > 1 or < -1.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more sample sizes are <= 0.")) ni.u <- ni # unadjusted total sample sizes k <- length(ni) ni <- ni.u mi <- ni - 1 ### (raw) mean change if (measure == "MC") { yi <- m1i - m2i vi <- (sd1i^2 + sd2i^2 - 2*ri*sd1i*sd2i) / ni } ### standardized mean change with change score standardization (using sddi) ### note: does not assume homoscedasticity, since we use sddi here if (measure == "SMCC") { cmi <- .cmicalc(mi, correct=correct) sddi <- sqrt(sd1i^2 + sd2i^2 - 2*ri*sd1i*sd2i) di <- (m1i - m2i) / sddi yi <- cmi * di if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) if (!all(is.element(vtype, c("LS","LS2")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either ''LS' or 'LS2'.")) for (i in seq_len(k)) { ### large sample approximation to the sampling variance if (vtype[i] == "LS") vi[i] <- 1/ni[i] + yi[i]^2 / (2*ni[i]) ### large sample approximation to the sampling variance (analogous to LS2 for SMD and SMCR) if (vtype[i] == "LS2") vi[i] <- cmi[i]^2 * (1/ni[i] + di[i]^2 / (2*ni[i])) } } ### standardized mean change with raw score standardization (using sd1i) ### note: yi does not assume homoscedasticity, but vi does if (measure == "SMCR") { cmi <- .cmicalc(mi, correct=correct) di <- (m1i - m2i) / sd1i yi <- cmi * di if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) if (!all(is.element(vtype, c("LS","LS2")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either ''LS' or 'LS2'.")) for (i in seq_len(k)) { ### large sample approximation to the sampling variance if (vtype[i] == "LS") vi[i] <- 2*(1-ri[i])/ni[i] + yi[i]^2 / (2*ni[i]) ### large sample approximation to the sampling variance (using corrected (!) equation from Borenstein et al., 2009) if (vtype[i] == "LS2") vi[i] <- cmi[i]^2 * (2*(1-ri[i])/ni[i] + di[i]^2 / (2*ni[i])) #vi[i] <- cmi[i]^2 * 2*(1-ri[i]) * (1/ni[i] + di[i]^2 / (2*ni[i])) # equation 4.28 (with J^2 multiplier) in Borenstein (2009) but this is incorrect } } ### standardized mean change with raw score standardization (using sd1i) ### with vi computation allowing for heteroscedasticity (Bonett, 2008; and JEBS article) if (measure == "SMCRH") { cmi <- .cmicalc(mi, correct=correct) vardi <- sd1i^2 + sd2i^2 - 2*ri*sd1i*sd2i yi <- cmi * (m1i - m2i) / sd1i vi <- vardi/(sd1i^2*(ni-1)) + yi^2 / (2*(ni-1)) vi <- cmi^2 * vi ### note: Bonett suggests plugging in the uncorrected yi into the ### equation for vi; here, the corrected value is plugged in } ### ratio of means for pre-post or matched designs (eq. 6 in Lajeunesse, 2011) ### to use with pooled SDs, simply set sd1i = sd2i = sdpi if (measure == "ROMC") { yi <- log(m1i/m2i) vi <- sd1i^2 / (ni*m1i^2) + sd2i^2 / (ni*m2i^2) - 2*ri*sd1i*sd2i/(m1i*m2i*ni) } ### coefficient of variation ratio for pre-post or matched designs if (measure == "CVRC") { yi <- log(sd1i/m1i) - log(sd2i/m2i) vi <- (1-ri^2) / (ni-1) + (m1i^2*sd2i^2 + m2i^2*sd1i^2 - 2*m1i*m2i*ri*sd1i*sd2i) / (m1i^2*m2i^2*ni) } ### variability ratio for pre-post or matched designs if (measure == "VRC") { yi <- log(sd1i/sd2i) vi <- (1-ri^2) / (ni-1) } } ###################################################################### if (is.element(measure, c("ARAW","AHW","ABT"))) { ai <- .getx("ai", mf=mf, data=data, checknumeric=TRUE) mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) if (!.all.specified(ai, mi, ni)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., ai, mi, ni).")) if (!.equal.length(ai, mi, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k.all <- length(ai) if (!is.null(subset)) { subset <- .chksubset(subset, k.all) ai <- .getsubset(ai, subset) mi <- .getsubset(mi, subset) ni <- .getsubset(ni, subset) } if (any(ai > 1, na.rm=TRUE)) stop(mstyle$stop("One or more alpha values are > 1.")) if (any(mi < 2, na.rm=TRUE)) stop(mstyle$stop("One or more mi values are < 2.")) if (any(ni <= 0, na.rm=TRUE)) stop(mstyle$stop("One or more sample sizes are <= 0.")) ni.u <- ni # unadjusted total sample sizes k <- length(ai) ### raw alpha values if (measure == "ARAW") { yi <- ai vi <- 2*mi*(1-ai)^2 / ((mi-1)*(ni-2)) } ### alphas transformed with Hakstian & Whalen (1976) transformation if (measure == "AHW") { #yi <- (1-ai)^(1/3) # technically this is the Hakstian & Whalen (1976) transformation yi <- 1 - (1-ai)^(1/3) # but with this, yi remains a monotonically increasing function of ai vi <- 18*mi*(ni-1)*(1-ai)^(2/3) / ((mi-1)*(9*ni-11)^2) } ### alphas transformed with Bonett (2002) transformation (without bias correction) if (measure == "ABT") { #yi <- log(1-ai) - log(ni/(ni-1)) #yi <- log(1-ai) # technically this is the Bonett (2002) transformation yi <- -log(1-ai) # but with this, yi remains a monotonically increasing function of ai vi <- 2*mi / ((mi-1)*(ni-2)) } } ###################################################################### if (measure == "REH") { ai <- .getx("ai", mf=mf, data=data, checknumeric=TRUE) bi <- .getx("bi", mf=mf, data=data, checknumeric=TRUE) ci <- .getx("ci", mf=mf, data=data, checknumeric=TRUE) if (!.all.specified(ai, bi, ci)) stop(mstyle$stop("Cannot compute outcomes. Check that all of the required information is specified\n via the appropriate arguments (i.e., ai, bi, ci).")) if (!.equal.length(ai, bi, ci)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k.all <- length(ai) if (!is.null(subset)) { subset <- .chksubset(subset, k.all) ai <- .getsubset(ai, subset) bi <- .getsubset(bi, subset) ci <- .getsubset(ci, subset) } if (any(ai < 0, na.rm=TRUE) || any(bi < 0, na.rm=TRUE) || any(ci < 0, na.rm=TRUE)) stop(mstyle$stop("One or more group sizes are negative.")) ni <- ai + bi + ci ni.u <- ni # unadjusted total sample sizes k <- length(ai) p0i <- ai / ni p1i <- bi / ni p2i <- ci / ni yi <- log(p1i) - log(2 * sqrt(p0i * p2i)) vi <- ((1-p1i) / (4 * p0i * p2i) + 1 / p1i) / ni } ###################################################################### } else { ### in case yi is not NULL (so user wants to convert a regular data frame to an 'escalc' object) ### check if yi is numeric if (!.is.numeric(yi)) stop(mstyle$stop("The object/variable specified for the 'yi' argument is not numeric.")) ### get vi, sei, and ni vi <- .getx("vi", mf=mf, data=data, checknumeric=TRUE) sei <- .getx("sei", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) ### if neither vi nor sei is specified, then throw an error ### if only sei is specified, then square those values to get vi ### if vi is specified, use those values if (is.null(vi)) { if (is.null(sei)) { stop(mstyle$stop("Must specify 'vi' or 'sei' argument.")) } else { vi <- sei^2 } } if (!.equal.length(yi, vi, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k.all <- length(yi) ### if slab is NULL, see if we can get it from yi (subsetting is done further below; see [a]) if (is.null(slab)) { slab <- attributes(yi)$slab if (length(slab) != k.all) slab <- NULL } if (!is.null(subset)) { subset <- .chksubset(subset, k.all) yi <- .getsubset(yi, subset) vi <- .getsubset(vi, subset) ni <- .getsubset(ni, subset) } ni.u <- ni # unadjusted total sample sizes k <- length(yi) } ######################################################################### ######################################################################### ######################################################################### ### make sure yi and vi are really vectors (and not arrays) yi <- as.vector(yi) vi <- as.vector(vi) ### check for infinite values and set them to NA is.inf <- is.infinite(yi) | is.infinite(vi) if (any(is.inf)) { warning(mstyle$warning("Some 'yi' and/or 'vi' values equal to +-Inf. Recoded to NAs."), call.=FALSE) yi[is.inf] <- NA_real_ vi[is.inf] <- NA_real_ } ### check for NaN values and set them to NA is.NaN <- is.nan(yi) | is.nan(vi) if (any(is.NaN)) { yi[is.NaN] <- NA_real_ vi[is.NaN] <- NA_real_ } ### check for negative vi's (should not happen, but just in case) vi[vi < 0] <- NA_real_ ### add study labels if specified if (!is.null(slab)) { if (length(slab) != k.all) stop(mstyle$stop("Study labels not of same length as data.")) if (is.factor(slab)) slab <- as.character(slab) if (!is.null(subset)) slab <- .getsubset(slab, subset) # [a] if (anyNA(slab)) stop(mstyle$stop("NAs in study labels.")) ### check if study labels are unique; if not, make them unique if (anyDuplicated(slab)) slab <- .make.unique(slab) } ### if include/subset is NULL, set to TRUE vector if (is.null(include)) include <- rep(TRUE, k.all) if (is.null(subset)) subset <- rep(TRUE, k.all) ### turn numeric include vector into logical vector (already done for subset) if (!is.null(include)) include <- .chksubset(include, k.all, stoponk0=FALSE) ### apply subset to include include <- .getsubset(include, subset) ### subset data frame (note: subsetting of other parts already done above, so yi/vi/ni.u/slab are already subsetted) if (has.data && any(!subset)) data <- .getsubset(data, subset) ### put together dataset if (has.data && append) { ### if data argument has been specified and user wants to append dat <- data.frame(data) if (replace || !is.element(var.names[1], names(dat))) { yi.replace <- rep(TRUE, k) } else { yi.replace <- is.na(dat[[var.names[1]]]) } if (replace || !is.element(var.names[2], names(dat))) { vi.replace <- rep(TRUE, k) } else { vi.replace <- is.na(dat[[var.names[2]]]) } if (replace || !is.element(var.names[3], names(dat))) { measure.replace <- rep(TRUE, k) } else { measure.replace <- is.na(dat[[var.names[3]]]) | dat[[var.names[3]]] == "" } dat[[var.names[1]]][include & yi.replace] <- yi[include & yi.replace] dat[[var.names[2]]][include & vi.replace] <- vi[include & vi.replace] if (add.measure) dat[[var.names[3]]][!is.na(yi) & include & measure.replace] <- measure if (!is.null(ni.u)) attributes(dat[[var.names[1]]])$ni[include & yi.replace] <- ni.u[include & yi.replace] } else { ### if data argument has not been specified or user does not want to append dat <- data.frame(yi=rep(NA_real_, k), vi=rep(NA_real_, k)) dat$yi[include] <- yi[include] dat$vi[include] <- vi[include] if (add.measure) dat$measure[!is.na(yi) & include] <- measure attributes(dat$yi)$ni[include] <- ni.u[include] if (add.measure) { names(dat) <- var.names } else { names(dat) <- var.names[1:2] } } ### replace missings in measure with "" if (add.measure) dat[[var.names[3]]][is.na(dat[[var.names[3]]])] <- "" ### add slab attribute to the yi vector if (!is.null(slab)) attr(dat[[var.names[1]]], "slab") <- slab ### add measure attribute to the yi vector attr(dat[[var.names[1]]], "measure") <- measure ### add digits attribute attr(dat, "digits") <- digits ### add 'yi.names' and 'vi.names' to the first position of the corresponding attributes (so the first is always the last one calculated/added) attr(dat, "yi.names") <- union(var.names[1], attr(data, "yi.names")) # if 'yi.names' is not an attribute, attr() returns NULL, so this works fine attr(dat, "vi.names") <- union(var.names[2], attr(data, "vi.names")) # if 'vi.names' is not an attribute, attr() returns NULL, so this works fine ### add 'out.names' back to object in case these attributes exist (if summary() has been used on the object) attr(dat, "sei.names") <- attr(data, "sei.names") attr(dat, "zi.names") <- attr(data, "zi.names") attr(dat, "pval.names") <- attr(data, "pval.names") attr(dat, "ci.lb.names") <- attr(data, "ci.lb.names") attr(dat, "ci.ub.names") <- attr(data, "ci.ub.names") ### keep only attribute elements from yi.names and vi.names that are actually part of the object attr(dat, "yi.names") <- attr(dat, "yi.names")[attr(dat, "yi.names") %in% colnames(dat)] attr(dat, "vi.names") <- attr(dat, "vi.names")[attr(dat, "vi.names") %in% colnames(dat)] class(dat) <- c("escalc", "data.frame") return(dat) } metafor/R/summary.rma.r0000644000176200001440000000065514434121616014556 0ustar liggesuserssummary.rma <- function(object, digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma") if (missing(digits)) { digits <- .get.digits(xdigits=object$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=object$digits, dmiss=FALSE) } object$digits <- digits class(object) <- c("summary.rma", class(object)) return(object) } metafor/R/plot.rma.peto.r0000644000176200001440000000412714465422261015007 0ustar liggesusersplot.rma.peto <- function(x, qqplot=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.peto") na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) .start.plot() par.mfrow <- par("mfrow") par(mfrow=c(2,2)) on.exit(par(mfrow = par.mfrow), add=TRUE) bg <- .coladj(par("bg","fg"), dark=0.35, light=-0.35) col.na <- .coladj(par("bg","fg"), dark=0.2, light=-0.2) ######################################################################### forest(x, ...) title("Forest Plot", ...) ######################################################################### funnel(x, ...) title("Funnel Plot", ...) ######################################################################### radial(x, ...) title("Radial Plot", ...) ######################################################################### if (qqplot) { qqnorm(x, ...) } else { options(na.action = "na.pass") z <- rstandard(x)$z options(na.action = na.act) not.na <- !is.na(z) if (na.act == "na.omit") { z <- z[not.na] ids <- x$ids[not.na] not.na <- not.na[not.na] } if (na.act == "na.exclude" || na.act == "na.pass") ids <- x$ids k <- length(z) plot(NA, NA, xlim=c(1,k), ylim=c(min(z, -2, na.rm=TRUE), max(z, 2, na.rm=TRUE)), xaxt="n", xlab="Study", ylab="", bty="l", ...) lines(seq_len(k)[not.na], z[not.na], col=col.na, ...) lines(seq_len(k), z, ...) points(x=seq_len(k), y=z, pch=21, bg=bg, ...) axis(side=1, at=seq_len(k), labels=ids, ...) abline(h=0, lty="dashed", ...) abline(h=c(qnorm(.025),qnorm(.975)), lty="dotted", ...) title("Standardized Residuals", ...) } ######################################################################### invisible() } metafor/R/print.ranktest.r0000644000176200001440000000105014305043430015251 0ustar liggesusersprint.ranktest <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="ranktest") digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) .space() cat(mstyle$section("Rank Correlation Test for Funnel Plot Asymmetry")) cat("\n\n") cat(mstyle$result(paste0("Kendall's tau = ", fmtx(x$tau, digits[["est"]]), ", p ", fmtp(x$pval, digits[["pval"]], equal=TRUE, sep=TRUE)))) cat("\n") #cat("H0: true tau is equal to 0\n\n") .space() invisible() } metafor/R/plot.gosh.rma.r0000644000176200001440000002515114465403725015004 0ustar liggesusersplot.gosh.rma <- function(x, het="I2", pch=16, cex, out, col, alpha, border, xlim, ylim, xhist=TRUE, yhist=TRUE, hh=0.3, breaks, adjust, lwd, labels, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="gosh.rma") het <- match.arg(het, c("QE", "I2", "H2", "tau2")) if (het == "tau2" && is.element(x$method, c("FE","EE","CE"))) stop(mstyle$stop("Cannot plot 'tau2' for equal/fixed-effects models.")) if (missing(cex)) { cex <- par("cex") * 0.5 } else { cex <- par("cex") * cex } ddd <- list(...) if (!is.null(ddd$trim)) { trim <- ddd$trim if (!is.list(trim)) { if (length(trim) == 1L) trim <- rep(trim, ncol(x$res)-4L) trim <- as.list(trim) } X <- cbind(x$res[,het], x$res[,6:ncol(x$res)]) del <- rep(FALSE, nrow(X)) for (i in seq_len(ncol(X))) { del[X[,i] < quantile(X[,i], trim[[i]][1], na.rm=TRUE) | X[,i] > quantile(X[,i], 1-trim[[i]][length(trim[[i]])], na.rm=TRUE)] <- TRUE } del[is.na(del)] <- TRUE x$res <- x$res[!del,] x$incl <- x$incl[!del,] } .start.plot() lplot <- function(..., trim) plot(...) lpairs <- function(..., trim) pairs(...) if (missing(alpha)) alpha <- nrow(x$res)^(-0.2) if (length(alpha) == 1L) alpha <- c(alpha, 0.5, 0.9) # 1st for points, 2nd for histograms, 3rd for density lines if (length(alpha) == 2L) alpha <- c(alpha[1], alpha[2], 0.9) missout <- ifelse(missing(out), TRUE, FALSE) # need this for panel.hist() if (missout) { if (missing(col)) col <- par("fg") col <- col2rgb(col) / 255 col.pnts <- rgb(col[1], col[2], col[3], alpha[1]) col.hist <- rgb(col[1], col[2], col[3], alpha[2]) col.line <- rgb(col[1], col[2], col[3], alpha[3]) } else { if (length(out) != 1L) stop(mstyle$stop("Argument 'out' should only specify a single study.")) out <- round(out) if (out > x$k || out < 1) stop(mstyle$stop("Non-existing study chosen as potential outlier.")) if (missing(col)) { if (.is.dark()) { col <- c("firebrick", "dodgerblue") } else { col <- c("red", "blue") } } if (length(col) != 2L) stop(mstyle$stop("Argument 'col' should specify two colors when argument 'out' is used.")) col.o <- col2rgb(col[1]) / 255 col.i <- col2rgb(col[2]) / 255 col.pnts.o <- rgb(col.o[1], col.o[2], col.o[3], alpha[1]) col.pnts.i <- rgb(col.i[1], col.i[2], col.i[3], alpha[1]) col.pnts <- ifelse(x$incl[,out], col.pnts.o, col.pnts.i) col.hist.o <- rgb(col.o[1], col.o[2], col.o[3], alpha[2]) col.hist.i <- rgb(col.i[1], col.i[2], col.i[3], alpha[2]) col.line.o <- rgb(col.o[1], col.o[2], col.o[3], alpha[3]) col.line.i <- rgb(col.i[1], col.i[2], col.i[3], alpha[3]) } if (missing(border)) border <- .coladj(par("bg"), dark=0.1, light=-0.1) if (length(border) == 1L) border <- c(border, border) if (length(hh) == 1L) hh <- c(hh, hh) if (x$int.only && (any(hh < 0) | any(hh > 1))) stop(mstyle$stop("Invalid value(s) specified for 'hh' argument.")) if (missing(breaks)) breaks <- "Sturges" if (length(breaks) == 1L) breaks <- list(breaks, breaks) # use list so can also specify two vectors (or two functions) if (missing(adjust)) adjust <- 1 if (length(adjust) == 1L) adjust <- c(adjust, adjust) if (missing(lwd)) lwd <- 2 if (length(lwd) == 1L) lwd <- c(lwd, lwd) if (missing(labels)) { if (het == "QE" && x$int.only) labels <- expression(Q) if (het == "QE" && !x$int.only) labels <- expression(Q[E]) if (het == "I2") labels <- expression(I^2) if (het == "H2") labels <- expression(H^2) if (het == "tau2") labels <- expression(tau^2) if (x$int.only) { labels <- c(.setlab(x$measure, transf.char="FALSE", atransf.char="FALSE", gentype=2), labels) } else { labels <- c(labels, colnames(x$res)[-seq_len(5)]) } } ######################################################################### if (x$int.only) { par.mar <- par("mar") par.mar.adj <- par.mar - c(0,-1,3.1,1.1) par.mar.adj[par.mar.adj < 0] <- 0 on.exit(par(mar = par.mar), add=TRUE) if (xhist & yhist) layout(mat=matrix(c(1,2,3,4), nrow=2, byrow=TRUE), widths=c(1-hh[2],hh[2]), heights=c(hh[1],1-hh[1])) if (xhist & !yhist) layout(mat=matrix(c(1,2), nrow=2, byrow=TRUE), heights=c(hh[1],1-hh[1])) if (!xhist & yhist) layout(mat=matrix(c(1,2), nrow=1, byrow=TRUE), widths=c(1-hh[2],hh[2])) hx <- hist(x$res[,6], breaks=breaks[[1]], plot=FALSE) hy <- hist(x$res[,het], breaks=breaks[[2]], plot=FALSE) if (missout) { if (missing(xlim)) xlim <- range(hx$breaks) if (missing(ylim)) ylim <- range(hy$breaks) if (xhist) { d <- density(x$res[,6], adjust=adjust[1], na.rm=TRUE) brks <- hx$breaks nB <- length(brks) y <- hx$density par(mar=c(0,par.mar.adj[2:4])) plot(NULL, xlim=xlim, ylim=c(0,max(hx$density,d$y)), xlab="", ylab="", xaxt="n", yaxt="n", bty="n") rect(brks[-nB], 0, brks[-1], y, col=col.hist, border=border[1]) if (lwd[1] > 0) lines(d$x, d$y, lwd=lwd[1], col=col.line) } } else { isout <- x$incl[,out] hx.o <- hist(x$res[isout,6], breaks=hx$breaks, plot=FALSE) hx.i <- hist(x$res[!isout,6], breaks=hx$breaks, plot=FALSE) hy.o <- hist(x$res[isout,het], breaks=hy$breaks, plot=FALSE) hy.i <- hist(x$res[!isout,het], breaks=hy$breaks, plot=FALSE) if (missing(xlim)) xlim <- c(min(hx.o$breaks, hx.i$breaks), max(hx.o$breaks, hx.i$breaks)) if (missing(ylim)) ylim <- c(min(hy.o$breaks, hy.i$breaks), max(hy.o$breaks, hy.i$breaks)) if (xhist) { d.o <- density(x$res[isout,6], adjust=adjust[1], na.rm=TRUE) d.i <- density(x$res[!isout,6], adjust=adjust[1], na.rm=TRUE) brks.o <- hx.o$breaks brks.i <- hx.i$breaks nB.o <- length(brks.o) nB.i <- length(brks.i) y.o <- hx.o$density y.i <- hx.i$density par(mar=c(0,par.mar.adj[2:4])) plot(NULL, xlim=xlim, ylim=c(0,max(hx.o$density,hx.i$density,d.o$y,d.i$y)), xlab="", ylab="", xaxt="n", yaxt="n", bty="n") rect(brks.i[-nB.i], 0, brks.i[-1], y.i, col=col.hist.i, border=border[1]) rect(brks.o[-nB.o], 0, brks.o[-1], y.o, col=col.hist.o, border=border[1]) if (lwd[1] > 0) { lines(d.i$x, d.i$y, lwd=lwd[1], col=col.line.i) lines(d.o$x, d.o$y, lwd=lwd[1], col=col.line.o) } } } if (xhist & yhist) plot.new() par(mar = par.mar.adj) lplot(x$res[,6], x$res[,het], xlim=xlim, ylim=ylim, pch=pch, cex=cex, col=col.pnts, bty="l", xlab=labels[1], ylab=labels[2], ...) if (missout) { if (yhist) { d <- density(x$res[,het], adjust=adjust[2], na.rm=TRUE) brks <- hy$breaks nB <- length(brks) y <- hy$density par(mar=c(par.mar.adj[1],0,par.mar.adj[3:4])) plot(NULL, xlim=c(0,max(hy$density,d$y)), ylim=ylim, xlab="", ylab="", xaxt="n", yaxt="n", bty="n") rect(0, brks[-nB], y, brks[-1], col=col.hist, border=border[2]) if (lwd[2] > 0) lines(d$y, d$x, lwd=lwd[2], col=col.line) } } else { if (yhist) { d.o <- density(x$res[isout,het], adjust=adjust[2], na.rm=TRUE) d.i <- density(x$res[!isout,het], adjust=adjust[2], na.rm=TRUE) brks.o <- hy.o$breaks brks.i <- hy.i$breaks nB.o <- length(brks.o) nB.i <- length(brks.i) y.o <- hy.o$density y.i <- hy.i$density par(mar=c(par.mar.adj[1],0,par.mar.adj[3:4])) plot(NULL, xlim=c(0,max(hy.o$density,hy.i$density,d.o$y,d.i$y)), ylim=ylim, xlab="", ylab="", xaxt="n", yaxt="n", bty="n") rect(0, brks.i[-nB.i], y.i, brks.i[-1], col=col.hist.i, border=border[2]) rect(0, brks.o[-nB.o], y.o, brks.o[-1], col=col.hist.o, border=border[2]) if (lwd[2] > 0) { lines(d.i$y, d.i$x, lwd=lwd[2], col=col.line.i) lines(d.o$y, d.o$x, lwd=lwd[2], col=col.line.o) } } } ### reset to a single figure if (xhist | yhist) layout(matrix(1)) } else { isout <- x$incl[,out] ### function for histograms with kernel density estimates on the diagonal panel.hist <- function(x, ...) { usr <- par("usr") on.exit(par(usr=usr)) par(usr = c(usr[1:2], 0, 1.2 + hh[1])) h <- hist(x, plot=FALSE, breaks=breaks[[1]]) if (missout) { brks <- h$breaks nB <- length(brks) y <- h$density z <- y / max(y) rect(brks[-nB], 0, brks[-1], z, col=col.hist, border=border[1]) res <- density(x, adjust=adjust[1], na.rm=TRUE) res$y <- res$y / max(y) if (lwd[1] > 0) lines(res, lwd=lwd[1], col=col.line) } else { h.o <- hist(x[isout], plot=FALSE, breaks=h$breaks) h.i <- hist(x[!isout], plot=FALSE, breaks=h$breaks) brks.o <- h.o$breaks brks.i <- h.i$breaks nB.o <- length(brks.o) nB.i <- length(brks.i) y.o <- h.o$density y.i <- h.i$density z.o <- y.o / max(y.o, y.i) z.i <- y.i / max(y.o, y.i) rect(brks.i[-nB.i], 0, brks.i[-1], z.i, col=col.hist.i, border=border[1]) rect(brks.o[-nB.o], 0, brks.o[-1], z.o, col=col.hist.o, border=border[1]) res.o <- density(x[isout], adjust=adjust[1], na.rm=TRUE) res.i <- density(x[!isout], adjust=adjust[1], na.rm=TRUE) res.o$y <- res.o$y / max(y.o, y.i) res.i$y <- res.i$y / max(y.o, y.i) if (lwd[1] > 0) { lines(res.i, lwd=lwd[1], col=col.line.i) lines(res.o, lwd=lwd[1], col=col.line.o) } } box() } ### draw scatterplot matrix X <- cbind(x$res[,het], x$res[,6:ncol(x$res)]) lpairs(X, pch=pch, cex=cex, diag.panel=panel.hist, col=col.pnts, labels=labels, ...) } ######################################################################### } metafor/R/fsn.r0000644000176200001440000003145114477366156013110 0ustar liggesusersfsn <- function(x, vi, sei, subset, data, type, alpha=.05, target, method, exact=FALSE, verbose=FALSE, digits, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) ### set defaults if (missing(target)) target <- NULL ddd <- list(...) .chkdots(ddd, c("pool", "mumiss", "interval", "maxint", "tol", "maxiter", "tau2", "test", "weighted")) if (is.null(ddd$pool)) { pool <- "stouffer" } else { pool <- match.arg(tolower(ddd$pool), c("stouffer", "fisher")) } if (is.null(ddd$mumiss)) { mumiss <- 0 } else { mumiss <- ddd$mumiss } # note: default interval set below; see [a] (based on k) if (is.null(ddd$maxint)) { maxint <- 10^7 } else { maxint <- ddd$maxint } if (is.null(ddd$tol)) { tol <- .Machine$double.eps^0.25 } else { tol <- ddd$tol } if (is.null(ddd$maxiter)) { maxiter <- 1000 } else { maxiter <- ddd$maxiter } ### observed values (to be replaced as needed) est <- NA_real_ # pooled estimate tau2 <- NA_real_ # tau^2 estimate pval <- NA_real_ # p-value ### defaults (to be replaced for type="General") est.fsn <- NA_real_ tau2.fsn <- NA_real_ pval.fsn <- NA_real_ ub.sign <- "" ######################################################################### ### check if data argument has been specified if (missing(data)) data <- NULL if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } mf <- match.call() x <- .getx("x", mf=mf, data=data) ######################################################################### if (inherits(x, "rma")) { .chkclass(class(x), must="rma", notav=c("robust.rma", "rma.glmm", "rma.mv", "rma.ls", "rma.gen", "rma.uni.selmodel")) if (!x$int.only) stop(mstyle$stop("Method only applicable to models without moderators.")) if (!missing(type) && type != "General") warning(mstyle$warning("Setting type='General' when using fsn() on a model object."), call.=FALSE) type <- "General" if (!is.null(x$weights)) stop(mstyle$stop("Cannot use function on models with custom weights.")) if (!missing(vi) || !missing(sei) || !missing(subset)) warning(mstyle$warning("Arguments 'vi', 'sei', and 'subset' ignored when 'x' is a model object."), call.=FALSE) yi <- x$yi vi <- x$vi ### set defaults for digits if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } } else { if (!.is.vector(x)) stop(mstyle$stop("Argument 'x' must be a vector or an 'rma' model object.")) ### select/match type if (missing(type)) type <- "Rosenthal" type.options <- c("rosenthal", "binomial", "orwin", "rosenberg", "general") type <- type.options[grep(tolower(type), type.options)[1]] if (is.na(type)) stop(mstyle$stop("Unknown 'type' specified.")) type <- paste0(toupper(substr(type, 1, 1)), substr(type, 2, nchar(type))) ### check if yi is numeric yi <- x if (!is.numeric(yi)) stop(mstyle$stop("The object/variable specified for the 'x' argument is not numeric.")) ### set defaults for digits if (missing(digits)) { digits <- .set.digits(dmiss=TRUE) } else { digits <- .set.digits(digits, dmiss=FALSE) } vi <- .getx("vi", mf=mf, data=data, checknumeric=TRUE) sei <- .getx("sei", mf=mf, data=data, checknumeric=TRUE) subset <- .getx("subset", mf=mf, data=data) if (is.null(vi)) { if (!is.null(sei)) vi <- sei^2 } if (type %in% c("Rosenthal", "Rosenberg", "General") && is.null(vi)) stop(mstyle$stop("Must specify 'vi' or 'sei' argument.")) ### ensure backwards compatibility with the 'weighted' argument when type="Orwin" if (type == "Orwin") { if (isTRUE(ddd$weighted) && is.null(vi)) # if weighted=TRUE, then check that the vi's are available stop(mstyle$stop("Must specify 'vi' or 'sei' argument.")) if (isFALSE(ddd$weighted)) # if weighted=FALSE, then set vi <- 1 for unweighted vi <- 1 if (is.null(ddd$weighted) && is.null(vi)) # if weighted is unspecified, set vi <- 1 if vi's are unspecified vi <- 1 } ### allow easy setting of vi to a single value if (length(vi) == 1L) vi <- rep(vi, length(yi)) ### check length of yi and vi if (length(yi) != length(vi)) stop(mstyle$stop("Length of 'yi' and 'vi' (or 'sei') is not the same.")) ### check 'vi' argument for potential misuse .chkviarg(mf$vi) ######################################################################### ### if a subset of studies is specified if (!is.null(subset)) { subset <- .chksubset(subset, length(yi)) yi <- .getsubset(yi, subset) vi <- .getsubset(vi, subset) } ### check for NAs and act accordingly has.na <- is.na(yi) | is.na(vi) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { yi <- yi[not.na] vi <- vi[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "studies", "study"), "with NAs omitted.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in data.")) } } ######################################################################### ### check for non-positive sampling variances if (any(vi <= 0)) stop(mstyle$stop("Cannot use function when there are non-positive sampling variances in the data.")) ### number of studies k <- length(yi) if (k == 1) stop(mstyle$stop("Stopped because k = 1.")) ### set interval for uniroot() [a] if (is.null(ddd$interval)) { interval <- c(0, k*50) } else { interval <- ddd$interval } ######################################################################### if (type == "Rosenthal" && pool == "stouffer") { zi <- c(yi / sqrt(vi)) z.avg <- abs(sum(zi) / sqrt(k)) pval <- pnorm(z.avg, lower.tail=FALSE) fsnum <- max(0, k * (z.avg / qnorm(alpha, lower.tail=FALSE))^2 - k) target <- NA_real_ } if (type == "Rosenthal" && pool == "fisher") { zi <- c(yi / sqrt(vi)) pi <- pnorm(abs(zi), lower.tail=FALSE) pval <- .fsn.fisher(0, pi=pi, alpha=0) if (pval >= alpha) { fsnum <- 0 } else { fsnum <- try(uniroot(.fsn.fisher, interval=interval, extendInt="upX", tol=tol, maxiter=maxiter, pi=pi, alpha=alpha)$root, silent=FALSE) if (inherits(fsnum, "try-error")) stop(mstyle$stop("Could not find fail-safe N using Fisher's method for pooling p-values.")) } target <- NA_real_ } if (type == "Binomial") { kpos <- sum(yi > 0) pval <- binom.test(kpos, k)$p.value if (pval >= alpha) { fsnum <- 0 } else { pvalnew <- pval fsnum <- 0 while (pvalnew < alpha) { fsnum <- fsnum + 2 pvalnew <- binom.test(kpos + fsnum/2, k + fsnum)$p.value } } target <- NA_real_ } if (type == "Orwin") { wi <- 1 / vi est <- .wmean(yi, wi) if (is.null(target)) target <- est / 2 if (identical(target, 0)) { fsnum <- Inf } else { if (sign(target) != sign(est)) target <- -1 * target fsnum <- max(0, k * (est - target) / target) } } if (type == "Rosenberg") { wi <- 1 / vi est <- .wmean(yi, wi) zval <- est / sqrt(1/sum(wi)) pval <- 2*pnorm(abs(zval), lower.tail=FALSE) vt <- 1 / mean(1/vi) #w.p <- (sum(wi*yi) / qnorm(alpha/2, lower.tail=FALSE))^2 - sum(wi) #fsnum <- max(0, k*w.p/sum(wi)) fsnum <- max(0, ((sum(wi*yi) / qnorm(alpha/2, lower.tail=FALSE))^2 - sum(wi)) * vt) target <- NA_real_ } if (type == "General") { if (missing(method)) { if (inherits(x, "rma")) { method <- x$method } else { method <- "REML" } } tau2fix <- NULL if (inherits(x, "rma") && x$tau2.fix) tau2fix <- x$tau2 if (!is.null(ddd$tau2)) tau2fix <- ddd$tau2 test <- "z" if (inherits(x, "rma")) test <- x$test if (!is.null(ddd$test)) test <- ddd$test if (test != "z") exact <- TRUE weighted <- TRUE if (inherits(x, "rma")) weighted <- x$weighted if (!is.null(ddd$weighted)) weighted <- isTRUE(ddd$weighted) tmp <- try(rma(yi, vi, method=method, tau2=tau2fix, test=test, weighted=weighted, verbose=verbose), silent=!verbose) if (inherits(tmp, "try-error")) stop(mstyle$stop("Could not fit random-effects model (use verbose=TRUE for more info)."), call.=FALSE) vt <- 1 / mean(1/vi) est <- tmp$beta[1] tau2 <- tmp$tau2 pval <- tmp$pval if (mumiss != 0 && sign(est) == sign(mumiss)) { mumiss <- -mumiss message(mstyle$message("Flipped the sign of 'mumiss'.")) } if (is.null(target)) { if (pval >= alpha) { fsnum <- 0 } else { fsnum <- try(uniroot(.fsn.gen, interval=interval, extendInt="upX", tol=tol, maxiter=maxiter, yi=yi, vi=vi, vt=vt, est=est, tau2=tau2, tau2fix=tau2fix, test=test, weighted=weighted, target=target, alpha=alpha, exact=exact, method=method, mumiss=mumiss, upperint=max(interval), maxint=maxint, verbose=verbose)$root, silent=TRUE) if (inherits(fsnum, "try-error")) stop(mstyle$stop("Could not find fail-safe N based on a random-effects model (use verbose=TRUE for more info).")) if (fsnum > maxint) fsnum <- maxint tmp <- .fsn.gen(fsnum, yi=yi, vi=vi, vt=vt, est=est, tau2=tau2, tau2fix=tau2fix, test=test, weighted=weighted, target=target, alpha=alpha, exact=exact, method=method, mumiss=mumiss, upperint=max(interval), maxint=maxint, newest=TRUE) } target <- NA_real_ } else { if (sign(target) != sign(est)) target <- -1 * target if (identical(target, 0)) { fsnum <- Inf } else if (abs(target) >= abs(est)) { fsnum <- 0 } else { fsnum <- try(uniroot(.fsn.gen, interval=interval, extendInt=ifelse(est > 0,"downX","upX"), tol=tol, maxiter=maxiter, yi=yi, vi=vi, vt=vt, est=est, tau2=tau2, tau2fix=tau2fix, test=test, weighted=weighted, target=target, alpha=alpha, exact=exact, method=method, mumiss=mumiss, upperint=max(interval), maxint=maxint, verbose=verbose)$root, silent=TRUE) if (inherits(fsnum, "try-error")) stop(mstyle$stop("Could not find fail-safe N based on a random-effects model (use verbose=TRUE for more info).")) if (fsnum > maxint) fsnum <- maxint tmp <- .fsn.gen(fsnum, yi=yi, vi=vi, vt=vt, est=est, tau2=tau2, tau2fix=tau2fix, test=test, weighted=weighted, target=target, alpha=alpha, exact=exact, method=method, mumiss=mumiss, upperint=max(interval), maxint=maxint, newest=TRUE) } } if (fsnum == 0) { est.fsn <- est tau2.fsn <- tau2 pval.fsn <- pval } else { est.fsn <- tmp$est.fsn tau2.fsn <- tmp$tau2.fsn pval.fsn <- tmp$pval.fsn } if (fsnum >= maxint) ub.sign <- ">" } ######################################################################### if (is.finite(fsnum) && abs(fsnum - round(fsnum)) >= .Machine$double.eps^0.5) { fsnum <- ceiling(fsnum) } else { fsnum <- round(fsnum) } res <- list(type=type, fsnum=fsnum, est=est, tau2=tau2, meanes=est, pval=pval, alpha=alpha, target=target, method=ifelse(type=="General", method, NA), est.fsn=est.fsn, tau2.fsn=tau2.fsn, pval.fsn=pval.fsn, ub.sign=ub.sign, digits=digits) class(res) <- "fsn" return(res) } metafor/R/points.regplot.r0000644000176200001440000000135414135066471015274 0ustar liggesuserspoints.regplot <- function(x, ...) { .chkclass(class(x), must="regplot") ### redraw points points(x=x$xi[x$order], y=x$yi[x$order], pch=x$pch[x$order], cex=x$psize[x$order], col=x$col[x$order], bg=x$bg[x$order], ...) ### redraw labels if (any(x$label)) { offset <- attr(x, "offset") labsize <- attr(x, "labsize") for (i in which(x$label)) { if (isTRUE(x$yi[i] > x$pred[i])) { # x$pred might be NULL, so use isTRUE() text(x$xi[i], x$yi[i] + offset[1] + offset[2]*x$psize[i]^offset[3], x$slab[i], cex=labsize, ...) } else { text(x$xi[i], x$yi[i] - offset[1] - offset[2]*x$psize[i]^offset[3], x$slab[i], cex=labsize, ...) } } } invisible() } metafor/R/transf.r0000644000176200001440000003300014436350160013566 0ustar liggesusers############################################################################ .chktargsint <- function(targs) { if (length(targs) > 3L) stop("Length of 'targs' argument must be <= 3.", call.=FALSE) if (.is.vector(targs)) { if (is.null(names(targs))) { names(targs) <- c("tau2", "lower", "upper")[seq_along(targs)] targs <- as.list(targs) } else { targs <- list(tau2=unname(targs[startsWith(names(targs), "t")]), lower=unname(targs[startsWith(names(targs), "l")]), upper=unname(targs[startsWith(names(targs), "u")])) targs <- targs[sapply(targs, length) > 0L] } } if (any(sapply(targs, length) > 1L)) stop("Elements of 'targs' arguments must be scalars.", call.=FALSE) if (is.null(targs$tau2)) targs$tau2 <- 0 return(targs) } ############################################################################ transf.rtoz <- function(xi) { # resulting value between -Inf (for -1) and +Inf (for +1) xi[xi > 1] <- 1 xi[xi < -1] <- -1 atanh(xi) # same as 1/2 * log((1+xi)/(1-xi)) } transf.ztor <- function(xi) tanh(xi) # same as (exp(2*xi)-1)/(exp(2*xi)+1) transf.ztor.int <- function(xi, targs=NULL) { if (is.na(xi)) return(NA_real_) targs <- .chktargsint(targs) if (is.null(targs$lower)) targs$lower <- xi-10*sqrt(targs$tau2) if (is.null(targs$upper)) targs$upper <- xi+10*sqrt(targs$tau2) toint <- function(zval, xi, tau2) tanh(zval) * dnorm(zval, mean=xi, sd=sqrt(tau2)) cfunc <- function(xi, tau2, lower, upper) integrate(toint, lower=lower, upper=upper, xi=xi, tau2=tau2)$value if (targs$tau2 == 0) { zi <- transf.ztor(xi) } else { zi <- mapply(xi, FUN=cfunc, tau2=targs$tau2, lower=targs$lower, upper=targs$upper) } return(c(zi)) } transf.r2toz <- function(xi) { xi[xi > 1] <- 1 xi[xi < 0] <- 0 atanh(sqrt(xi)) } transf.ztor2 <- function(xi) tanh(xi)^2 ############################################################################ transf.exp.int <- function(xi, targs=NULL) { if (is.na(xi)) return(NA_real_) targs <- .chktargsint(targs) if (is.null(targs$lower)) targs$lower <- xi-10*sqrt(targs$tau2) if (is.null(targs$upper)) targs$upper <- xi+10*sqrt(targs$tau2) toint <- function(zval, xi, tau2) exp(zval) * dnorm(zval, mean=xi, sd=sqrt(tau2)) cfunc <- function(xi, tau2, lower, upper) integrate(toint, lower=lower, upper=upper, xi=xi, tau2=tau2)$value if (targs$tau2 == 0) { zi <- exp(xi) } else { zi <- mapply(xi, FUN=cfunc, tau2=targs$tau2, lower=targs$lower, upper=targs$upper) } return(c(zi)) } ############################################################################ transf.logit <- function(xi) # resulting value between -Inf (for 0) and +Inf (for +1) qlogis(xi) transf.ilogit <- function(xi) plogis(xi) transf.ilogit.int <- function(xi, targs=NULL) { if (is.na(xi)) return(NA_real_) targs <- .chktargsint(targs) if (is.null(targs$lower)) targs$lower <- xi-10*sqrt(targs$tau2) if (is.null(targs$upper)) targs$upper <- xi+10*sqrt(targs$tau2) toint <- function(zval, xi, tau2) plogis(zval) * dnorm(zval, mean=xi, sd=sqrt(tau2)) cfunc <- function(xi, tau2, lower, upper) integrate(toint, lower=lower, upper=upper, xi=xi, tau2=tau2)$value if (targs$tau2 == 0) { zi <- transf.ilogit(xi) } else { zi <- mapply(xi, FUN=cfunc, tau2=targs$tau2, lower=targs$lower, upper=targs$upper) } return(c(zi)) } ############################################################################ transf.arcsin <- function(xi) # resulting value between 0 (for 0) and asin(1) = pi/2 (for 1) asin(sqrt(xi)) transf.iarcsin <- function(xi) { zi <- sin(xi)^2 zi[xi < 0] <- 0 # if xi value is below 0 (e.g., CI bound), return 0 zi[xi > asin(1)] <- 1 # if xi value is above maximum possible value, return 1 return(c(zi)) } # transf.iarcsin.int <- function(xi, targs=NULL) { # # if (is.na(xi)) # return(NA_real_) # # targs <- .chktargsint(targs) # # if (is.null(targs$lower)) # targs$lower <- 0 # if (is.null(targs$upper)) # targs$upper <- asin(1) # # toint <- function(zval, xi, tau2) # transf.iarcsin(zval) * dnorm(zval, mean=xi, sd=sqrt(tau2)) # # cfunc <- function(xi, tau2, lower, upper) # integrate(toint, lower=lower, upper=upper, xi=xi, tau2=tau2)$value # # if (targs$tau2 == 0) { # zi <- transf.iarcsin(xi) # } else { # zi <- mapply(xi, FUN=cfunc, tau2=targs$tau2, lower=targs$lower, upper=targs$upper) # } # # return(c(zi)) # # } ############################################################################ transf.pft <- function(xi, ni) { # Freeman-Tukey transformation for proportions xi <- xi*ni zi <- 1/2*(asin(sqrt(xi/(ni+1))) + asin(sqrt((xi+1)/(ni+1)))) return(c(zi)) } transf.ipft <- function(xi, ni) { # inverse of Freeman-Tukey transformation for individual proportions zi <- suppressWarnings(1/2 * (1 - sign(cos(2*xi)) * sqrt(1 - (sin(2*xi)+(sin(2*xi)-1/sin(2*xi))/ni)^2))) zi <- ifelse(is.nan(zi), NA_real_, zi) zi[xi > transf.pft(1,ni)] <- 1 # if xi is above upper limit, return 1 zi[xi < transf.pft(0,ni)] <- 0 # if xi is below lower limit, return 0 return(c(zi)) } transf.ipft.hm <- function(xi, targs) { # inverse of Freeman-Tukey transformation for a collection of proportions if (is.null(targs) || (is.list(targs) && is.null(targs$ni))) stop("Must specify the sample sizes via the 'targs' argument.", call.=FALSE) if (is.list(targs)) { ni <- targs$ni } else { ni <- ni } nhm <- 1/(mean(1/ni, na.rm=TRUE)) # calculate harmonic mean of the ni's zi <- suppressWarnings(1/2 * (1 - sign(cos(2*xi)) * sqrt(1 - (sin(2*xi)+(sin(2*xi)-1/sin(2*xi))/nhm)^2))) zi <- ifelse(is.nan(zi), NA_real_, zi) # it may not be possible to calculate zi zi[xi > transf.pft(1,nhm)] <- 1 # if xi is above upper limit, return 1 zi[xi < transf.pft(0,nhm)] <- 0 # if xi is below lower limit, return 0 return(c(zi)) } ############################################################################ transf.isqrt <- function(xi) { zi <- xi*xi zi[xi < 0] <- 0 # if xi value is below 0 (e.g., CI bound), return 0 return(c(zi)) } ############################################################################ transf.irft <- function(xi, ti) { # Freeman-Tukey transformation for incidence rates zi <- 1/2*(sqrt(xi) + sqrt(xi + 1/ti)) # xi is the incidence rate (not the number of events!) return(c(zi)) } transf.iirft <- function(xi, ti) { # inverse of Freeman-Tukey transformation for incidence rates (see Freeman-Tukey_incidence.r in code directory) #zi <- (1/ti - 2*xi^2 + ti*xi^4)/(4*xi^2*ti) # old version where transf.irft was not multiplied by 1/2 zi <- (1/ti - 8*xi^2 + 16*ti*xi^4)/(16*xi^2*ti) # xi is the incidence rate (not the number of events!) zi <- ifelse(is.nan(zi), NA_real_, zi) zi[xi < transf.irft(0,ti)] <- 0 # if xi is below lower limit, return 0 zi[zi <= .Machine$double.eps] <- 0 # avoid finite precision errors in back-transformed values (transf.iirft(transf.irft(0, 1:200), 1:200)) return(c(zi)) } ############################################################################ transf.ahw <- function(xi) { # resulting value between 0 (for alpha=0) and 1 (for alpha=1) #zi <- (1-xi)^(1/3) zi <- 1 - (1-xi)^(1/3) return(c(zi)) } transf.iahw <- function(xi) { #zi <- 1-xi^3 zi <- 1 - (1-xi)^3 zi <- ifelse(is.nan(zi), NA_real_, zi) zi[xi > 1] <- 1 # if xi is above upper limit, return 1 zi[xi < 0] <- 0 # if xi is below lower limit, return 0 return(c(zi)) } transf.abt <- function(xi) { # Bonett (2002) transformation of alphas (without bias correction) #transf.abt <- function(xi, ni) { # resulting value between 0 (for alpha=0) to Inf (for alpha=1) #zi <- log(1-xi) - log(ni/(ni-1)) #zi <- log(1-xi) zi <- -log(1-xi) return(c(zi)) } transf.iabt <- function(xi) { # inverse of Bonett (2002) transformation #transf.iabt <- function(xi, ni) { #zi <- 1 - exp(xi) * ni / (ni-1) #zi <- 1 - exp(xi) zi <- 1 - exp(-xi) zi <- ifelse(is.nan(zi), NA_real_, zi) zi[xi < 0] <- 0 # if xi is below lower limit, return 0 return(c(zi)) } ############################################################################ transf.dtou1 <- function(xi) { u2i <- pnorm(abs(xi)/2) return((2*u2i - 1) / u2i) } transf.dtou2 <- function(xi) pnorm(xi/2) transf.dtou3 <- function(xi) pnorm(xi) transf.dtocles <- function(xi) pnorm(xi/sqrt(2)) transf.dtobesd <- function(xi) { rpbi <- xi / sqrt(xi^2 + 4) return(0.50 + rpbi/2) } transf.dtomd <- function(xi, targs=NULL) { if (is.null(targs) || (is.list(targs) && is.null(targs$sd))) stop("Must specify a standard deviation value via the 'targs' argument.", call.=FALSE) if (is.list(targs)) { sd <- targs$sd } else { sd <- targs } if (length(sd) != 1L) stop("Specify a single standard deviation value via the 'targs' argument.", call.=FALSE) return(xi * sd) } transf.dtorpb <- function(xi, n1i, n2i) { if (missing(n1i) || missing(n2i)) { hi <- 4 } else { if (length(n1i) != length(n2i)) stop("Length of 'n1i' does not match length of 'n2i'.", call.=FALSE) if (length(n1i) != length(xi)) stop("Length of 'n1i' and 'n2i' does not match length of 'xi'.", call.=FALSE) mi <- n1i + n2i - 2 hi <- mi / n1i + mi / n2i } return(xi / sqrt(xi^2 + hi)) } transf.dtorbis <- function(xi, n1i, n2i) { if (missing(n1i) || missing(n2i)) { hi <- 4 n1i <- 1 n2i <- 1 } else { if (length(n1i) != length(n2i)) stop("Length of 'n1i' does not match length of 'n2i'.", call.=FALSE) if (length(n1i) != length(xi)) stop("Length of 'n1i' and 'n2i' does not match length of 'xi'.", call.=FALSE) mi <- n1i + n2i - 2 hi <- mi / n1i + mi / n2i } rpbi <- xi / sqrt(xi^2 + hi) pi <- n1i / (n1i + n2i) return(sqrt(pi*(1-pi)) / dnorm(pnorm(pi)) * rpbi) } transf.rpbtorbis <- function(xi, pi) { if (missing(pi)) { pi <- 0.5 } else { if (length(pi) == 1L) pi <- rep(pi, length(xi)) if (length(xi) != length(pi)) stop("Length of 'xi' does not match length of 'pi'.", call.=FALSE) } if (any(pi < 0 | pi > 1, na.rm=TRUE)) stop("One or more 'pi' values are < 0 or > 1.", call.=FALSE) return(sqrt(pi*(1-pi)) / dnorm(qnorm(pi)) * xi) } transf.rtorpb <- function(xi, pi) { if (missing(pi)) { pi <- 0.5 } else { if (length(pi) == 1L) pi <- rep(pi, length(xi)) if (length(xi) != length(pi)) stop("Length of 'xi' does not match length of 'pi'.", call.=FALSE) } if (any(pi < 0 | pi > 1, na.rm=TRUE)) stop("One or more 'pi' values are < 0 or > 1.", call.=FALSE) return(xi * dnorm(qnorm(pi)) / sqrt(pi*(1-pi))) } transf.rtod <- function(xi, n1i, n2i) { if (missing(n1i) || missing(n2i)) { hi <- 4 n1i <- 1 n2i <- 1 } else { if (length(n1i) != length(n2i)) stop("Length of 'n1i' does not match length of 'n2i'.", call.=FALSE) if (length(n1i) != length(xi)) stop("Length of 'n1i' and 'n2i' does not match length of 'xi'.", call.=FALSE) mi <- n1i + n2i - 2 hi <- mi / n1i + mi / n2i } if (any(c(n1i < 0, n2i < 0), na.rm=TRUE)) stop("One or more values specified via the 'n1i' or 'n2i' arguments are negative.") pi <- n1i / (n1i + n2i) rpbi <- xi * dnorm(qnorm(pi)) / sqrt(pi*(1-pi)) return(sqrt(hi) * rpbi / sqrt(1 - rpbi^2)) } transf.rpbtod <- function(xi, n1i, n2i) { if (missing(n1i) || missing(n2i)) { hi <- 4 } else { if (length(n1i) != length(n2i)) stop("Length of 'n1i' does not match length of 'n2i'.", call.=FALSE) if (length(n1i) != length(xi)) stop("Length of 'n1i' and 'n2i' does not match length of 'xi'.", call.=FALSE) mi <- n1i + n2i - 2 hi <- mi / n1i + mi / n2i } return(sqrt(hi) * xi / sqrt(1 - xi^2)) } transf.lnortord <- function(xi, pc) { if (length(pc) == 1L) pc <- rep(pc, length(xi)) if (length(xi) != length(pc)) stop("Length of 'xi' does not match length of 'pc'.", call.=FALSE) if (any(pc < 0) || any(pc > 1)) stop("The control group risk 'pc' must be between 0 and 1.", call.=FALSE) return(exp(xi)*pc / (1 - pc + pc * exp(xi)) - pc) } transf.lnortorr <- function(xi, pc) { if (length(pc) == 1L) pc <- rep(pc, length(xi)) if (length(xi) != length(pc)) stop("Length of 'xi' does not match length of 'pc'.", call.=FALSE) if (any(pc < 0) || any(pc > 1)) stop("The control group risk 'pc' must be between 0 and 1.", call.=FALSE) return(exp(xi) / (pc * (exp(xi) - 1) + 1)) } ############################################################################ transf.lnortod.norm <- function(xi) xi / 1.65 transf.lnortod.logis <- function(xi) sqrt(3) / base::pi * xi transf.dtolnor.norm <- function(xi) xi * 1.65 transf.dtolnor.logis <- function(xi) xi / sqrt(3) * base::pi transf.lnortortet.pearson <- function(xi) cos(base::pi / (1 + sqrt(exp(xi)))) transf.lnortortet.digby <- function(xi) (exp(xi)^(3/4) - 1) / (exp(xi)^(3/4) + 1) ############################################################################ metafor/R/fitted.rma.r0000644000176200001440000000254314401667252014343 0ustar liggesusersfitted.rma <- function(object, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) ### note: fitted values can be calculated for all studies including those that ### have NA on yi/vi (and with "na.pass" these will be provided); but if there ### is an NA in the X's, then the fitted value will also be NA out <- c(object$X.f %*% object$beta) names(out) <- object$slab #not.na <- !is.na(out) if (na.act == "na.omit") out <- out[object$not.na] if (na.act == "na.exclude") out[!object$not.na] <- NA_real_ if (na.act == "na.fail" && any(!object$not.na)) stop(mstyle$stop("Missing values in results.")) if (inherits(object, "rma.ls")) { out <- list(location = out) out$scale <- c(object$Z.f %*% object$alpha) names(out$scale) <- object$slab #not.na <- !is.na(out$scale) if (na.act == "na.omit") out$scale <- out$scale[object$not.na] if (na.act == "na.exclude") out$scale[!object$not.na] <- NA_real_ if (na.act == "na.fail" && any(!object$not.na)) stop(mstyle$stop("Missing values in results.")) } return(out) } metafor/R/selmodel.r0000644000176200001440000000006613716753101014105 0ustar liggesusersselmodel <- function(x, ...) UseMethod("selmodel") metafor/R/misc.func.hidden.evals.r0000644000176200001440000000404714313415473016535 0ustar liggesusers############################################################################ ### to register getfit method for 'rma.uni' and 'rma.mv' objects: eval(metafor:::.glmulti) .glmulti <- str2expression(" if (!(\"glmulti\" %in% .packages())) stop(\"Must load the 'glmulti' package first to use this code.\") setOldClass(\"rma.uni\") setMethod(\"getfit\", \"rma.uni\", function(object, ...) { if (object$test==\"z\") { cbind(estimate=coef(object), se=sqrt(diag(vcov(object))), df=Inf) } else { cbind(estimate=coef(object), se=sqrt(diag(vcov(object))), df=object$k-object$p) } }) setOldClass(\"rma.mv\") setMethod(\"getfit\", \"rma.mv\", function(object, ...) { if (object$test==\"z\") { cbind(estimate=coef(object), se=sqrt(diag(vcov(object))), df=Inf) } else { cbind(estimate=coef(object), se=sqrt(diag(vcov(object))), df=object$k-object$p) } }) setOldClass(\"rma.glmm\") setMethod(\"getfit\", \"rma.glmm\", function(object, ...) { if (object$test==\"z\") { cbind(estimate=coef(object), se=sqrt(diag(vcov(object))), df=Inf) } else { cbind(estimate=coef(object), se=sqrt(diag(vcov(object))), df=object$k-object$p) } }) ") ### helper functions to make MuMIn work together with metafor: eval(metafor:::.MuMIn) .MuMIn <- str2expression(" makeArgs.rma <- function (obj, termNames, comb, opt, ...) { ret <- MuMIn:::makeArgs.default(obj, termNames, comb, opt) names(ret)[1L] <- \"mods\" ret } coefTable.rma <- function (model, ...) { MuMIn:::.makeCoefTable(model$b, model$se, coefNames = rownames(model$b)) } ") ### helper functions to make mice work together with metafor (note: no longer ### needed, as there are glance and tidy methods for rma objects in broom now) #.mice <- str2expression(" # #glance.rma <- function (x, ...) # data.frame(df.residual=df.residual(x)) # #tidy.rma <- function (x, ...) { # ret <- coef(summary(x)) # colnames(ret)[2] <- \"std.error\" # ret$term <- rownames(ret) # return(ret) #} # #") ############################################################################ metafor/R/vif.r0000644000176200001440000000005414276764412013073 0ustar liggesusersvif <- function(x, ...) UseMethod("vif") metafor/R/print.list.rma.r0000644000176200001440000000737314441013035015164 0ustar liggesusersprint.list.rma <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="list.rma") digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) attr(x, "class") <- NULL ### remove cr.lb and cr.ub elements (if they are there) x$cr.lb <- NULL x$cr.ub <- NULL ### turn all vectors before the slab vector into a data frame slab.pos <- which(names(x) == "slab") out <- x[seq_len(slab.pos-1)] out <- data.frame(out, row.names=x$slab, stringsAsFactors=FALSE) ### in case all values were NA and have been omitted if (nrow(out) == 0L) stop(mstyle$stop("All values are NA."), call.=FALSE) ### in case there is a select element, apply it if (exists("select", where=x, inherits=FALSE)) out <- out[x$select,] if (nrow(out) == 0L) { message(mstyle$message("No values to print.")) return(invisible()) } ### if transf exists and is TRUE, set SEs to NULL so that column is omitted from the output transf.true <- 0 if (exists("transf", where=x, inherits=FALSE) && x$transf) { transf.true <- 1 out$se <- NULL } ### objects created by predict.rma() have a 'method' element ### properly format columns 1-4 (for FE models) or columns 1-6 (for RE/ME models) ### leave element tau2.level, gamma2.level, and/or element X untouched if (exists("method", where=x, inherits=FALSE)) { min.pos <- slab.pos - is.element("tau2.level", names(x)) - is.element("gamma2.level", names(x)) - is.element("X", names(x)) - is.element("Z", names(x)) - transf.true } else { min.pos <- slab.pos - transf.true } sav <- out[,seq_len(min.pos-1)] for (i in seq_len(min.pos-1)) { if (inherits(out[,i], c("integer","logical","factor","character"))) { ### do not apply formating to these classes out[,i] <- out[,i] } else { if (names(out)[i] %in% c("pred", "resid")) out[,i] <- fmtx(out[,i], digits[["est"]]) if (names(out)[i] %in% c("se")) out[,i] <- fmtx(out[,i], digits[["se"]]) if (names(out)[i] %in% c("ci.lb", "ci.ub", "cr.lb", "cr.ub", "pi.lb", "pi.ub")) out[,i] <- fmtx(out[,i], digits[["ci"]]) if (names(out)[i] %in% c("zval", "Q", "z", "X2")) out[,i] <- fmtx(out[,i], digits[["test"]]) if (names(out)[i] %in% c("pval", "Qp")) out[,i] <- fmtx(out[,i], digits[["pval"]]) if (names(out)[i] %in% c("I2", "H2")) out[,i] <- fmtx(out[,i], digits[["het"]]) if (names(out)[i] %in% c("tau2")) out[,i] <- fmtx(out[,i], digits[["var"]]) # if (names(out)[i] == "rstudent") # out[,i] <- fmtx(out[,i], digits[["test"]]) # if (names(out)[i] == "dffits") # out[,i] <- fmtx(out[,i], digits[["test"]]) # if (names(out)[i] == "cook.d") # out[,i] <- fmtx(out[,i], digits[["test"]]) # if (names(out)[i] == "cov.r") # out[,i] <- fmtx(out[,i], digits[["test"]]) # if (names(out)[i] == "tau2.del") # out[,i] <- fmtx(out[,i], digits[["var"]]) # if (names(out)[i] == "QE.del") # out[,i] <- fmtx(out[,i], digits[["test"]]) # if (names(out)[i] == "hat") # out[,i] <- fmtx(out[,i], digits[["test"]]) # if (names(out)[i] == "weight") # out[,i] <- fmtx(out[,i], digits[["test"]]) # if (names(out)[i] == "dfbs") # out[,i] <- fmtx(out[,i], digits[["est"]]) if (!is.character(out[,i])) out[,i] <- fmtx(out[,i], digits[["est"]]) } } .space() tmp <- capture.output(print(out, quote=FALSE, right=TRUE)) .print.table(tmp, mstyle) if (is.null(attr(x, ".rmspace"))) .space() invisible(sav) } metafor/R/blsplit.r0000644000176200001440000000216114467156004013753 0ustar liggesusersblsplit <- function(x, cluster, fun, args, sort=FALSE) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (missing(cluster)) stop(mstyle$stop("Must specify 'cluster' variable.")) if (!is.matrix(x) && !inherits(x, "dgCMatrix")) stop(mstyle$stop("Argument 'x' must be a matrix.")) if (!isSymmetric(x)) stop(mstyle$stop("Argument 'x' must be a symmetric matrix.")) k <- nrow(x) if (length(cluster) != k) stop(mstyle$stop(paste0("Length of variable specified via 'cluster' (", length(cluster), ") does not correspond to the dimensions of the matrix (", k, "x", k, ")."))) res <- list() clusters <- unique(cluster) if (sort) clusters <- sort(clusters) for (i in seq_along(clusters)) { res[[i]] <- x[cluster == clusters[i], cluster == clusters[i], drop=FALSE] } names(res) <- clusters if (!missing(fun)) { if (missing(args)) { res <- lapply(res, fun) } else { args <- as.list(args) for (i in 1:length(res)) { res[[i]] <- do.call(fun, c(unname(res[i]), args)) } } } return(res) } metafor/R/metafor.news.r0000644000176200001440000000006613457322061014710 0ustar liggesusersmetafor.news <- function() news(package="metafor") metafor/R/BIC.rma.r0000644000176200001440000000225514014250111013437 0ustar liggesusersBIC.rma <- function(object, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma") if (missing(...)) { ### if there is just 'object' if (object$method == "REML") { out <- object$fit.stats["BIC","REML"] } else { out <- object$fit.stats["BIC","ML"] } } else { ### if there is 'object' and additional objects via ... if (object$method == "REML") { out <- sapply(list(object, ...), function(x) x$fit.stats["BIC","REML"]) } else { out <- sapply(list(object, ...), function(x) x$fit.stats["BIC","ML"]) } dfs <- sapply(list(object, ...), function(x) x$parms) out <- data.frame(df=dfs, BIC=out) ### get names of objects; same idea as in stats:::AIC.default cl <- match.call() rownames(out) <- as.character(cl[-1L]) ### check that all models were fitted to the same data yis <- lapply(list(object, ...), function(x) as.vector(x$yi)) if (!all(sapply(yis[-1], function(x) identical(x, yis[[1]])))) warning(mstyle$warning("Models not all fitted to the same data."), call.=FALSE) } return(out) } metafor/R/confint.rma.glmm.r0000644000176200001440000000031013770362453015450 0ustar liggesusersconfint.rma.glmm <- function(object, parm, level, digits, transf, targs, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.glmm", notav="rma.glmm") } metafor/R/cumul.rma.mh.r0000644000176200001440000001352514440116146014610 0ustar liggesuserscumul.rma.mh <- function(x, order, digits, transf, targs, progbar=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.mh") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL ddd <- list(...) .chkdots(ddd, c("time", "decreasing")) if (.isTRUE(ddd$time)) time.start <- proc.time() if (is.null(ddd$decreasing)) { decreasing <- FALSE } else { decreasing <- ddd$decreasing } ######################################################################### if (grepl("^order\\(", deparse1(substitute(order)))) warning(mstyle$warning("Use of order() in 'order' argument is probably erroneous."), call.=FALSE) if (missing(order)) { order <- seq_len(x$k.all) } else { mf <- match.call() order <- .getx("order", mf=mf, data=x$data) } if (length(order) != x$k.all) stop(mstyle$stop(paste0("Length of the 'order' argument (", length(order), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) ### note: order variable is assumed to be of the same length as the size of the ### original dataset passed to the model fitting function and so we apply ### the same subsetting (if necessary) as was done during model fitting order <- .getsubset(order, x$subset) order <- order(order, decreasing=decreasing) ai.f <- x$outdat.f$ai[order] bi.f <- x$outdat.f$bi[order] ci.f <- x$outdat.f$ci[order] di.f <- x$outdat.f$di[order] x1i.f <- x$outdat.f$x1i[order] x2i.f <- x$outdat.f$x2i[order] t1i.f <- x$outdat.f$t1i[order] t2i.f <- x$outdat.f$t2i[order] yi.f <- x$yi.f[order] vi.f <- x$vi.f[order] not.na <- x$not.na[order] slab <- x$slab[order] ids <- x$ids[order] if (inherits(x$data, "environment")) { data <- NULL } else { data <- x$data[order,] } beta <- rep(NA_real_, x$k.f) se <- rep(NA_real_, x$k.f) zval <- rep(NA_real_, x$k.f) pval <- rep(NA_real_, x$k.f) ci.lb <- rep(NA_real_, x$k.f) ci.ub <- rep(NA_real_, x$k.f) QE <- rep(NA_real_, x$k.f) QEp <- rep(NA_real_, x$k.f) I2 <- rep(NA_real_, x$k.f) H2 <- rep(NA_real_, x$k.f) ### elements that need to be returned outlist <- "beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, QE=QE, QEp=QEp, tau2=tau2, I2=I2, H2=H2" ### note: skipping NA cases if (progbar) pbar <- pbapply::startpb(min=0, max=x$k.f) for (i in seq_len(x$k.f)) { if (progbar) pbapply::setpb(pbar, i) if (!not.na[i]) next if (is.element(x$measure, c("RR","OR","RD"))) { args <- list(ai=ai.f, bi=bi.f, ci=ci.f, di=di.f, measure=x$measure, add=x$add, to=x$to, drop00=x$drop00, correct=x$correct, level=x$level, subset=seq_len(i), outlist=outlist) } else { args <- list(x1i=x1i.f, x2i=x2i.f, t1i=t1i.f, t2i=t2i.f, measure=x$measure, add=x$add, to=x$to, drop00=x$drop00, correct=x$correct, level=x$level, subset=seq_len(i), outlist=outlist) } res <- try(suppressWarnings(.do.call(rma.mh, args)), silent=TRUE) if (inherits(res, "try-error")) next beta[i] <- res$beta se[i] <- res$se zval[i] <- res$zval pval[i] <- res$pval ci.lb[i] <- res$ci.lb ci.ub[i] <- res$ci.ub QE[i] <- res$QE QEp[i] <- res$QEp I2[i] <- res$I2 H2[i] <- res$H2 } if (progbar) pbapply::closepb(pbar) ######################################################################### ### if requested, apply transformation function if (.isTRUE(transf) && is.element(x$measure, c("OR","RR","IRR"))) ### if transf=TRUE, apply exp transformation to ORs, RRs, and IRRs transf <- exp if (is.function(transf)) { if (is.null(targs)) { beta <- sapply(beta, transf) se <- rep(NA_real_, x$k.f) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) } else { beta <- sapply(beta, transf, targs) se <- rep(NA_real_, x$k.f) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) } transf <- TRUE } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] ######################################################################### if (na.act == "na.omit") { out <- list(estimate=beta[not.na], se=se[not.na], zval=zval[not.na], pval=pval[not.na], ci.lb=ci.lb[not.na], ci.ub=ci.ub[not.na], Q=QE[not.na], Qp=QEp[not.na], I2=I2[not.na], H2=H2[not.na]) out$slab <- slab[not.na] out$ids <- ids[not.na] out$data <- data[not.na,] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(estimate=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, Q=QE, Qp=QEp, I2=I2, H2=H2) out$slab <- slab out$ids <- ids out$data <- data } if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) out$digits <- digits out$transf <- transf out$slab.null <- x$slab.null out$level <- x$level out$measure <- x$measure out$test <- x$test attr(out$estimate, "measure") <- x$measure if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(out) <- c("list.rma", "cumul.rma") return(out) } metafor/R/vcov.matreg.r0000644000176200001440000000025714434121130014523 0ustar liggesusersvcov.matreg <- function(object, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="matreg") out <- object$vb return(out) } metafor/R/trimfill.r0000644000176200001440000000006613457322061014122 0ustar liggesuserstrimfill <- function(x, ...) UseMethod("trimfill") metafor/R/qqnorm.rma.glmm.r0000644000176200001440000000023113770374321015324 0ustar liggesusersqqnorm.rma.glmm <- function(y, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(y), must="rma.glmm", notav="rma.glmm") } metafor/R/print.permutest.rma.uni.r0000644000176200001440000001464114503332506017035 0ustar liggesusersprint.permutest.rma.uni <- function(x, digits=x$digits, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="permutest.rma.uni") digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) .space() ddd <- list(...) .chkdots(ddd, c("num", "legend")) if (is.null(ddd$legend)) { legend <- TRUE } else { if (is.na(ddd$legend)) { # can suppress legend and legend symbols with legend=NA legend <- FALSE footsym <- rep("", 6) } else { legend <- .isTRUE(ddd$legend) } } footsym <- .get.footsym() if (!x$int.only) { if (inherits(x, "permutest.rma.ls")) { cat(mstyle$section(paste0("Test of Location Coefficients (coefficient", ifelse(x$m == 1, " ", "s "), .format.btt(x$btt),"):", ifelse(x$skip.beta, "", footsym[1])))) } else { cat(mstyle$section(paste0("Test of Moderators (coefficient", ifelse(x$m == 1, " ", "s "), .format.btt(x$btt),"):", ifelse(x$skip.beta, "", footsym[1])))) } cat("\n") if (is.element(x$test, c("knha","adhoc","t"))) { cat(mstyle$result(fmtt(x$QM, "F", df1=x$QMdf[1], df2=x$QMdf[2], pval=x$QMp, digits=digits))) } else { cat(mstyle$result(fmtt(x$QM, "QM", df=x$QMdf[1], pval=x$QMp, digits=digits))) } cat("\n\n") } if (is.element(x$test, c("knha","adhoc","t"))) { res.table <- data.frame(estimate=fmtx(c(x$beta), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), tval=fmtx(x$zval, digits[["test"]]), df=round(x$ddf,2), "pval"=fmtp(x$pval, digits[["pval"]]), ci.lb=fmtx(x$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$ci.ub, digits[["ci"]]), stringsAsFactors=FALSE) if (!x$skip.beta && footsym[1] != "") res.table <- .addfootsym(res.table, 5, footsym[1]) if (x$permci && footsym[1] != "") res.table <- .addfootsym(res.table, 6:7, footsym[1]) } else { res.table <- data.frame(estimate=fmtx(c(x$beta), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), zval=fmtx(x$zval, digits[["test"]]), "pval"=fmtp(x$pval, digits[["pval"]]), ci.lb=fmtx(x$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$ci.ub, digits[["ci"]]), stringsAsFactors=FALSE) if (!x$skip.beta && footsym[1] != "") res.table <- .addfootsym(res.table, 4, footsym[1]) if (x$permci && footsym[1] != "") res.table <- .addfootsym(res.table, 5:6, footsym[1]) } rownames(res.table) <- rownames(x$beta) signif <- symnum(x$pval, corr=FALSE, na=FALSE, cutpoints=c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", "**", "*", ".", " ")) if (signif.stars) { res.table <- cbind(res.table, signif) colnames(res.table)[ncol(res.table)] <- "" } if (.isTRUE(ddd$num)) { width <- nchar(nrow(res.table)) rownames(res.table) <- paste0(formatC(seq_len(nrow(res.table)), format="d", width=width), ") ", rownames(res.table)) } if (x$int.only) res.table <- res.table[1,] if (inherits(x, "permutest.rma.ls")) { cat(mstyle$section("Model Results (Location):")) } else { cat(mstyle$section("Model Results:")) } cat("\n\n") if (x$int.only) { tmp <- capture.output(.print.vector(res.table)) } else { tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE, print.gap=2)) } #tmp[1] <- paste0(tmp[1], "\u200b") .print.table(tmp, mstyle) if (inherits(x, "permutest.rma.ls")) { cat("\n") if (!x$Z.int.only) { cat(mstyle$section(paste0("Test of Scale Coefficients (coefficient", ifelse(x$m.alpha == 1, " ", "s "), .format.btt(x$att),"):", ifelse(x$skip.alpha, "", footsym[1])))) cat("\n") if (is.element(x$test, c("knha","adhoc","t"))) { cat(mstyle$result(fmtt(x$QS, "F", df1=x$QSdf[1], df2=x$QSdf[2], pval=x$QSp, digits=digits))) } else { cat(mstyle$result(fmtt(x$QS, "QS", df=x$QSdf[1], pval=x$QSp, digits=digits))) } cat("\n\n") } if (is.element(x$test, c("knha","adhoc","t"))) { res.table <- data.frame(estimate=fmtx(c(x$alpha), digits[["est"]]), se=fmtx(x$se.alpha, digits[["se"]]), tval=fmtx(x$zval.alpha, digits[["test"]]), df=round(x$ddf.alpha,2), "pval"=fmtp(x$pval.alpha, digits[["pval"]]), ci.lb=fmtx(x$ci.lb.alpha, digits[["ci"]]), ci.ub=fmtx(x$ci.ub.alpha, digits[["ci"]]), stringsAsFactors=FALSE) if (!x$skip.alpha && footsym[1] != "") res.table <- .addfootsym(res.table, 5, footsym[1]) } else { res.table <- data.frame(estimate=fmtx(c(x$alpha), digits[["est"]]), se=fmtx(x$se.alpha, digits[["se"]]), zval=fmtx(x$zval.alpha, digits[["test"]]), "pval"=fmtp(x$pval.alpha, digits[["pval"]]), ci.lb=fmtx(x$ci.lb.alpha, digits[["ci"]]), ci.ub=fmtx(x$ci.ub.alpha, digits[["ci"]]), stringsAsFactors=FALSE) if (!x$skip.alpha && footsym[1] != "") res.table <- .addfootsym(res.table, 4, footsym[1]) } rownames(res.table) <- rownames(x$alpha) signif <- symnum(x$pval.alpha, corr=FALSE, na=FALSE, cutpoints=c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", "**", "*", ".", " ")) if (signif.stars) { res.table <- cbind(res.table, signif) colnames(res.table)[ncol(res.table)] <- "" } if (.isTRUE(ddd$num)) { width <- nchar(nrow(res.table)) rownames(res.table) <- paste0(formatC(seq_len(nrow(res.table)), format="d", width=width), ") ", rownames(res.table)) } if (x$Z.int.only) res.table <- res.table[1,] cat(mstyle$section("Model Results (Scale):")) cat("\n\n") if (x$Z.int.only) { tmp <- capture.output(.print.vector(res.table)) } else { tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE, print.gap=2)) } #tmp[1] <- paste0(tmp[1], "\u200b") .print.table(tmp, mstyle) } if (signif.legend || legend) { cat("\n") cat(mstyle$legend("---")) } if (signif.legend) { cat("\n") cat(mstyle$legend("Signif. codes: "), mstyle$legend(attr(signif, "legend"))) cat("\n") } if (legend) { cat("\n") if (inherits(x, "permutest.rma.ls")) { cat(mstyle$legend(paste0(footsym[2], " p-values based on permutation testing"))) } else { cat(mstyle$legend(paste0(footsym[2], " p-value", ifelse(x$int.only, "", "s"), ifelse(x$permci, " and CI bounds", ""), " based on permutation testing"))) } cat("\n") } .space() invisible() } metafor/R/rcalc.r0000644000176200001440000002507114436372575013404 0ustar liggesusersrcalc <- function(x, ni, data, rtoz=FALSE, nfun="min", sparse=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (!(inherits(x, "formula") || inherits(x, "matrix") || inherits(x, "list"))) stop(mstyle$stop("Argument 'x' must be either a formula, a matrix, or a list of matrices.")) if (missing(ni)) stop(mstyle$stop("Argument 'ni' must be specified.")) if (is.character(nfun)) nfun <- match.arg(nfun, c("min", "harmonic", "mean")) ### get ... argument and check for extra/superfluous arguments ddd <- list(...) .chkdots(ddd, c("upper", "simplify", "rowid", "vnames", "noid")) if (is.null(ddd$upper)) { upper <- FALSE } else { upper <- ddd$upper } if (is.null(ddd$simplify)) { simplify <- TRUE } else { simplify <- ddd$simplify } na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) ############################################################################ ### in case x is a formula, process it if (inherits(x, "formula")) { if (missing(data)) stop(mstyle$stop("Must specify 'data' argument when 'x' is a formula.")) if (!is.data.frame(data)) data <- data.frame(data) ### extract ni mf <- match.call() ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) ### get all variables from data options(na.action = "na.pass") dat <- get_all_vars(x, data=data) options(na.action = na.act) ### if no study id has been specified, assume it is a single study if (ncol(dat) == 3L) { dat[[4]] <- 1 noid <- TRUE } else { noid <- FALSE } vnames <- names(dat) ### check that there are really 4 variables if (ncol(dat) != 4L) stop(mstyle$stop(paste0("Formula should contain 4 variables, but contains ", ncol(dat), " variables."))) ### check that there are no missings in the variable identifiers if (anyNA(c(dat[[2]],dat[[3]]))) stop(mstyle$stop("No missing values allowed in variable identifiers.")) id <- dat[[4]] ### check that ni has the same length as there are rows in 'data' if (length(ni) != nrow(data)) stop(mstyle$stop("Argument 'ni' must be of the same length as the data frame specified via 'data'.")) ### check that there are no missings in the study identifier if (anyNA(id)) stop(mstyle$stop("No missing values allowed in study identifier.")) ### need these to correctly sort 'dat' and 'V' back into the original order at the end ### (and need to order within rows, so that matching works correctly) id.var1 <- paste0(id, ".", as.character(dat[[2]])) id.var2 <- paste0(id, ".", as.character(dat[[3]])) id.var1.id.var2 <- .psort(id.var1, id.var2) id.var1 <- id.var1.id.var2[,1] id.var2 <- id.var1.id.var2[,2] rowid <- paste0(id.var1, ".", id.var2) dat <- split(dat, id) ni <- split(ni, id) Rlist <- list() nmi <- rep(NA_real_, length(ni)) for (i in seq_along(dat)) { if (any(ni[[i]] <= 0, na.rm=TRUE)) stop(mstyle$stop(paste0("One or more sample sizes are <= 0 in study ", dat[[i]][[4]][[1]], "."))) if (is.function(nfun)) { nfunnmi <- nfun(ni[[i]]) if (length(nfunnmi) != 1L) stop(mstyle$stop("Function specified via 'nfun' does not return a single value.")) nmi[i] <- nfunnmi } else { if (nfun == "min") nmi[i] <- min(ni[[i]], na.rm=TRUE) if (nfun == "harmonic") nmi[i] <- 1 / mean(1/ni[[i]], na.rm=TRUE) if (nfun == "mean") nmi[i] <- mean(ni[[i]], na.rm=TRUE) } var1 <- as.character(dat[[i]][[2]]) var2 <- as.character(dat[[i]][[3]]) var1.var2 <- paste0(var1, ".", var2) var1.var2.eq <- var1 == var2 if (any(var1.var2.eq)) stop(mstyle$stop(paste0("Identical var1-var2 pair", ifelse(sum(var1.var2.eq) >= 2L, "s", ""), " (", paste0(var1.var2[var1.var2.eq], collapse=", "), ") in study ", dat[[i]][[4]][[1]], "."))) var1.var2.dup <- duplicated(var1.var2) if (any(var1.var2.dup)) stop(mstyle$stop(paste0("Duplicated var1-var2 pair", ifelse(sum(var1.var2.dup) >= 2L, "s", ""), " (", paste0(var1.var2[var1.var2.dup], collapse=", "), ") in study ", dat[[i]][[4]][[1]], "."))) ri <- dat[[i]][[1]] if (any(abs(ri) > 1, na.rm=TRUE)) stop(mstyle$stop(paste0("One or more correlations are > 1 or < -1 in study ", dat[[i]][[4]][[1]], "."))) vars <- sort(union(var1, var2)) Ri <- matrix(NA_real_, nrow=length(vars), ncol=length(vars)) diag(Ri) <- 1 rownames(Ri) <- colnames(Ri) <- vars for (j in seq_along(var1)) { Ri[var1[j],var2[j]] <- Ri[var2[j],var1[j]] <- ri[j] } Rlist[[i]] <- Ri } names(Rlist) <- names(dat) return(rcalc(Rlist, ni=nmi, simplify=simplify, rtoz=rtoz, sparse=sparse, rowid=rowid, vnames=vnames, noid=noid)) } ############################################################################ ### in case x is a list, need to loop through elements if (is.list(x)) { k <- length(x) if (length(x) != length(ni)) stop(mstyle$stop("Argument 'ni' must be of the same length as there are elements in 'x'.")) res <- list() for (i in seq_len(k)) { res[[i]] <- rcalc(x[[i]], ni[i], upper=upper, rtoz=rtoz, ...) } if (is.null(names(x))) names(x) <- seq_len(k) if (simplify) { ki <- sapply(res, function(x) NROW(x$dat)) dat <- cbind(id=rep(names(x), times=ki), do.call(rbind, lapply(res, "[[", "dat"))) if (sparse) { V <- bdiag(lapply(res, "[[", "V")) } else { V <- bldiag(lapply(res, "[[", "V")) } rownames(V) <- colnames(V) <- unlist(lapply(res, function(x) rownames(x$V))) if (!is.null(ddd$rowid)) { rowid <- match(ddd$rowid, paste0(dat[[1]], ".", as.character(dat[[2]]), ".", dat[[1]], ".", as.character(dat[[3]]))) dat <- dat[rowid,] V <- V[rowid,rowid] } if (!is.null(ddd$vnames)) { names(dat)[1:3] <- ddd$vnames[c(4,2,3)] names(dat)[4] <- paste0(ddd$vnames[2], ".", ddd$vnames[3]) } if (!is.null(ddd$noid) && ddd$noid) { dat[[1]] <- NULL } rownames(dat) <- seq_len(nrow(dat)) return(list(dat=dat, V=V)) } else { names(res) <- names(x) return(res) } } ############################################################################ ### check if x is square matrix if (!is.matrix(x)) stop(mstyle$stop("Argument 'x' must be a matrix.")) if (dim(x)[1] != dim(x)[2]) stop(mstyle$stop("Argument 'x' must be a square matrix.")) ### set default dimension names dimsx <- nrow(x) dnames <- paste0("x", seq_len(dimsx)) ### in case x has dimension names, use those if (!is.null(rownames(x))) dnames <- rownames(x) if (!is.null(colnames(x))) dnames <- colnames(x) ### in case x is a 1x1 (or 0x0) matrix, return nothing if (dimsx <= 1L) return(list(dat=NULL, V=NULL)) ### make x symmetric, depending on whether we use upper or lower part if (upper) { x[lower.tri(x)] <- t(x)[lower.tri(x)] } else { x[upper.tri(x)] <- t(x)[upper.tri(x)] } ### check if x is symmetric (can be skipped since x must now be symmetric) #if (!isSymmetric(x)) # stop(mstyle$stop("Argument 'x' must be a symmetric matrix.")) ### stack upper/lower triangular part of x into a column vector (this is always done column-wise!) if (upper) { ri <- cbind(x[upper.tri(x)]) } else { ri <- cbind(x[lower.tri(x)]) } ### check that correlations are in [-1,1] if (any(abs(ri) > 1, na.rm=TRUE)) stop(mstyle$stop("One or more correlations are > 1 or < -1.")) ### check that sample sizes are > 0 if (isTRUE(ni <= 0)) stop(mstyle$stop("One or more sample sizes are <= 0.")) ### apply r-to-z transformation if requested if (rtoz) ri <- 1/2 * log((1 + ri)/(1 - ri)) ### I and J are matrices with 1:dimsx for rows and columns, respectively I <- matrix(seq_len(dimsx), nrow=dimsx, ncol=dimsx) J <- matrix(seq_len(dimsx), nrow=dimsx, ncol=dimsx, byrow=TRUE) ### get upper/lower triangular elements of I and J if (upper) { I <- I[upper.tri(I)] J <- J[upper.tri(J)] } else { I <- I[lower.tri(I)] J <- J[lower.tri(J)] } ### dimensions in V (must be dimsx*(dimsx-1)/2) dimsV <- length(ri) ### set up V matrix V <- matrix(NA_real_, nrow=dimsV, ncol=dimsV) for (ro in seq_len(dimsV)) { for (co in seq_len(dimsV)) { i <- I[ro] j <- J[ro] k <- I[co] l <- J[co] ### Olkin & Finn (1995), equation 5, page 157 V[ro,co] <- 1/2 * x[i,j]*x[k,l] * (x[i,k]^2 + x[i,l]^2 + x[j,k]^2 + x[j,l]^2) + x[i,k]*x[j,l] + x[i,l]*x[j,k] - (x[i,j]*x[i,k]*x[i,l] + x[j,i]*x[j,k]*x[j,l] + x[k,i]*x[k,j]*x[k,l] + x[l,i]*x[l,j]*x[l,k]) ### Steiger (1980), equation 2, page 245 (provides the same result) #V[ro,co] <- 1/2 * ((x[i,k] - x[i,j]*x[j,k]) * (x[j,l] - x[j,k]*x[k,l]) + # (x[i,l] - x[i,k]*x[k,l]) * (x[j,k] - x[j,i]*x[i,k]) + # (x[i,k] - x[i,l]*x[l,k]) * (x[j,l] - x[j,i]*x[i,l]) + # (x[i,l] - x[i,j]*x[j,l]) * (x[j,k] - x[j,l]*x[l,k])) ### Steiger (1980), equation 11, page 247 for r-to-z transformed values if (rtoz) V[ro,co] <- V[ro,co] / ((1 - x[i,j]^2) * (1 - x[k,l]^2)) } } ### divide V by (n-1) for raw correlations and by (n-3) for r-to-z transformed correlations if (isTRUE(ni >= 5)) { if (rtoz) { V <- V/(ni-3) } else { V <- V/(ni-1) } } else { V <- NA_real_*V } ### create matrix with var1 and var2 names and sort rowwise dmat <- cbind(dnames[I], dnames[J]) dmat <- t(apply(dmat, 1, sort)) ### set row/column names for V var1.var2 <- paste0(dmat[,1], ".", dmat[,2]) rownames(V) <- colnames(V) <- var1.var2 #return(list(dat=data.frame(var1=dmat[,1], var2=dmat[,2], var1.var2=var1.var2, yi=ri, vi=unname(diag(V)), ni=ni, stringsAsFactors=FALSE), V=V)) return(list(dat=data.frame(var1=dmat[,1], var2=dmat[,2], var1.var2=var1.var2, yi=ri, ni=ni, stringsAsFactors=FALSE), V=V)) } metafor/R/print.escalc.r0000644000176200001440000000415414305075547014676 0ustar liggesusersprint.escalc <- function(x, digits=attr(x,"digits"), ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="escalc") attr(x, "class") <- NULL digits <- .get.digits(digits=digits, xdigits=attr(x, "digits"), dmiss=FALSE) ### get positions of the variable names in the object ### note: if the object no longer contains a particular variable, match() returns NA; ### use na.omit(), so that length() is then zero (as needed for if statements below) yi.pos <- na.omit(match(attr(x, "yi.names"), names(x))) vi.pos <- na.omit(match(attr(x, "vi.names"), names(x))) sei.pos <- na.omit(match(attr(x, "sei.names"), names(x))) zi.pos <- na.omit(match(attr(x, "zi.names"), names(x))) pval.pos <- na.omit(match(attr(x, "pval.names"), names(x))) ci.lb.pos <- na.omit(match(attr(x, "ci.lb.names"), names(x))) ci.ub.pos <- na.omit(match(attr(x, "ci.ub.names"), names(x))) ### get rownames attribute so we can back-assign it rnames <- attr(x, "row.names") ### for printing, turn expressions into strings is.expr <- sapply(x, is.expression) x[is.expr] <- lapply(x[is.expr], as.character) ### turn x into a regular data frame x <- data.frame(x) rownames(x) <- rnames ### round variables according to the digits argument if (length(yi.pos) > 0L) x[yi.pos] <- apply(x[yi.pos], 2, fmtx, digits[["est"]]) if (length(vi.pos) > 0L) x[vi.pos] <- apply(x[vi.pos], 2, fmtx, digits[["var"]]) if (length(sei.pos) > 0L) x[sei.pos] <- apply(x[sei.pos], 2, fmtx, digits[["se"]]) if (length(zi.pos) > 0L) x[zi.pos] <- apply(x[zi.pos], 2, fmtx, digits[["test"]]) if (length(pval.pos) > 0L) x[pval.pos] <- apply(x[pval.pos], 2, fmtp, digits[["pval"]]) # note: using fmtp here if (length(ci.lb.pos) > 0L) x[ci.lb.pos] <- apply(x[ci.lb.pos], 2, fmtx, digits[["ci"]]) if (length(ci.ub.pos) > 0L) x[ci.ub.pos] <- apply(x[ci.ub.pos], 2, fmtx, digits[["ci"]]) ### print data frame with styling .space() tmp <- capture.output(print(x, ...)) .print.table(tmp, mstyle) .space() } metafor/R/weights.rma.uni.r0000644000176200001440000000315714245746531015336 0ustar liggesusersweights.rma.uni <- function(object, type="diagonal", ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.uni", notav=c("rma.gen", "rma.uni.selmodel")) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) type <- match.arg(type, c("diagonal", "matrix")) x <- object ######################################################################### if (x$weighted) { if (is.null(x$weights)) { W <- diag(1/(x$vi + x$tau2), nrow=x$k, ncol=x$k) } else { W <- diag(x$weights, nrow=x$k, ncol=x$k) } } else { W <- diag(1/x$k, nrow=x$k, ncol=x$k) } ######################################################################### if (type == "diagonal") { wi <- as.vector(diag(W)) weight <- rep(NA_real_, x$k.f) weight[x$not.na] <- wi / sum(wi) * 100 names(weight) <- x$slab if (na.act == "na.omit") weight <- weight[x$not.na] if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in weights.")) return(weight) } if (type == "matrix") { Wfull <- matrix(NA_real_, nrow=x$k.f, ncol=x$k.f) Wfull[x$not.na, x$not.na] <- W rownames(Wfull) <- x$slab colnames(Wfull) <- x$slab if (na.act == "na.omit") Wfull <- Wfull[x$not.na, x$not.na, drop=FALSE] if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) return(Wfull) } } metafor/R/vcalc.r0000644000176200001440000004153314501047573013377 0ustar liggesusersvcalc <- function(vi, cluster, subgroup, obs, type, time1, time2, grp1, grp2, w1, w2, data, rho, phi, rvars, checkpd=TRUE, nearpd=FALSE, sparse=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) ############################################################################ if (missing(vi)) stop(mstyle$stop("Must specify 'vi' variable.")) if (missing(cluster)) stop(mstyle$stop("Must specify 'cluster' variable.")) ### get ... argument and check for extra/superfluous arguments ddd <- list(...) .chkdots(ddd, c("nearPD", "retdat")) if (.isTRUE(ddd$nearPD)) nearpd <- TRUE ### check if data argument has been specified if (missing(data)) data <- NULL if (is.null(data) && !missing(rvars)) stop(mstyle$stop("Must specify 'data' argument when using 'rvars'.")) if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } subgroup.spec <- !missing(subgroup) type.spec <- !missing(type) obs.spec <- !missing(obs) grp1.spec <- !missing(grp1) grp2.spec <- !missing(grp2) time1.spec <- !missing(time1) time2.spec <- !missing(time2) w1.spec <- !missing(w1) w2.spec <- !missing(w2) mf <- match.call() vi <- .getx("vi", mf=mf, data=data, checknumeric=TRUE) cluster <- .getx("cluster", mf=mf, data=data) subgroup <- .getx("subgroup", mf=mf, data=data) type <- .getx("type", mf=mf, data=data) obs <- .getx("obs", mf=mf, data=data) grp1 <- .getx("grp1", mf=mf, data=data) grp2 <- .getx("grp2", mf=mf, data=data) time1 <- .getx("time1", mf=mf, data=data, checknumeric=TRUE) time2 <- .getx("time2", mf=mf, data=data, checknumeric=TRUE) w1 <- .getx("w1", mf=mf, data=data, checknumeric=TRUE) w2 <- .getx("w2", mf=mf, data=data, checknumeric=TRUE) ############################################################################ # to be able to quickly set vi to a constant (e.g., 1) for all rows if (length(vi) == 1L && length(cluster) > 1L) vi <- rep(vi, length(cluster)) k <- length(vi) if (k == 1L) stop(mstyle$stop("Processing terminated since k = 1.")) # could also do: return(matrix(vi, nrow=1, ncol=1)) ######################################################################### ### checks on cluster variable if (anyNA(cluster)) stop(mstyle$stop("No missing values allowed in 'cluster' variable.")) if (length(cluster) != k) stop(mstyle$stop(paste0("Length of variable specified via 'cluster' (", length(cluster), ") does not match length of 'vi' (", k, ")."))) ### checks on subgroup variable if (subgroup.spec) { if (anyNA(subgroup)) stop(mstyle$stop("No missing values allowed in 'subgroup' variable.")) if (length(subgroup) != k) stop(mstyle$stop(paste0("Length of variable specified via 'subgroup' (", length(subgroup), ") does not match length of 'vi' (", k, ")."))) cluster <- paste0(cluster, ".", subgroup) } ucluster <- unique(cluster) n <- length(ucluster) ######################################################################### if (missing(rvars)) { ############################################################################ ### process type variable if (type.spec) { if (missing(rho)) stop(mstyle$stop("Must specify 'rho' when 'type' is specified.")) } else { type <- rep(1, k) } if (anyNA(type)) stop(mstyle$stop("No missing values allowed in 'type' variable.")) if (length(type) != k) stop(mstyle$stop(paste0("Length of variable specified via 'type' (", length(type), ") does not match length of 'vi' (", k, ")."))) ### process obs variable if (obs.spec) { if (missing(rho)) stop(mstyle$stop("Must specify 'rho' when 'obs' is specified.")) } else { #obs <- ave(cluster, cluster, FUN=seq_along) obs <- rep(1, k) } if (anyNA(obs)) stop(mstyle$stop("No missing values allowed in 'obs' variable.")) if (length(obs) != k) stop(mstyle$stop(paste0("Length of variable specified via 'obs' (", length(obs), ") does not match length of 'vi' (", k, ")."))) ### process grp1 and grp2 variables #if ((grp1.spec && !grp2.spec) || (!grp1.spec && grp2.spec)) # stop(mstyle$stop("Either specify both 'grp1' and 'grp2' or neither.")) if ((grp2.spec && !grp1.spec)) stop(mstyle$stop("Either specify only 'grp1', both 'grp1' and 'grp2', or neither.")) if (!grp1.spec) grp1 <- rep(1, k) if (!grp2.spec) grp2 <- rep(2, k) if (anyNA(grp1)) stop(mstyle$stop("No missing values allowed in 'grp1' variable.")) if (anyNA(grp2)) stop(mstyle$stop("No missing values allowed in 'grp2' variable.")) if (length(grp1) != k) stop(mstyle$stop(paste0("Length of variable specified via 'grp1' (", length(grp1), ") does not match length of 'vi' (", k, ")."))) if (length(grp2) != k) stop(mstyle$stop(paste0("Length of variable specified via 'grp2' (", length(grp2), ") does not match length of 'vi' (", k, ")."))) ### process time1 and time2 variables if ((time2.spec && !time1.spec)) stop(mstyle$stop("Either specify only 'time1', both 'time1' and 'time2', or neither.")) if (time2.spec && !grp2.spec) stop(mstyle$stop("Must specify 'grp2' when 'time2' is specified.")) if (!time1.spec) time1 <- rep(1, k) if (!time2.spec) time2 <- time1 if (time1.spec || time2.spec) { if (missing(phi)) stop(mstyle$stop("Must specify 'phi' when 'time1' and/or 'time2' is specified.")) } else { phi <- 1 } if (abs(phi) > 1) stop(mstyle$stop("Value of argument 'phi' must be in [-1,1].")) if (anyNA(time1)) stop(mstyle$stop("No missing values allowed in 'time1' variable.")) if (anyNA(time2)) stop(mstyle$stop("No missing values allowed in 'time2' variable.")) if (length(time1) != k) stop(mstyle$stop(paste0("Length of variable specified via 'time1' (", length(time1), ") does not match length of 'vi' (", k, ")."))) if (length(time2) != k) stop(mstyle$stop(paste0("Length of variable specified via 'time2' (", length(time2), ") does not match length of 'vi' (", k, ")."))) if (!is.numeric(time1)) stop(mstyle$stop("Variable 'time1' must be a numeric variable.")) if (!is.numeric(time2)) stop(mstyle$stop("Variable 'time2' must be a numeric variable.")) ### process w1 and w2 variables if ((w2.spec && !w1.spec)) stop(mstyle$stop("Either specify only 'w1', both 'w1' and 'w2', or neither.")) if (w2.spec && !grp2.spec) stop(mstyle$stop("Must specify 'grp2' when 'w2' is specified.")) if (!w1.spec) w1 <- rep(1, k) if (!w2.spec) w2 <- w1 if (anyNA(w1)) stop(mstyle$stop("No missing values allowed in 'w1' variable.")) if (anyNA(w2)) stop(mstyle$stop("No missing values allowed in 'w2' variable.")) if (length(w1) != k) stop(mstyle$stop(paste0("Length of variable specified via 'w1' (", length(w1), ") does not match length of 'vi' (", k, ")."))) if (length(w2) != k) stop(mstyle$stop(paste0("Length of variable specified via 'w2' (", length(w2), ") does not match length of 'vi' (", k, ")."))) if (!is.numeric(w1)) stop(mstyle$stop("Variable 'w1' must be a numeric variable.")) if (!is.numeric(w2)) stop(mstyle$stop("Variable 'w2' must be a numeric variable.")) ############################################################################ ### process/create rho if (!missing(rho) && !(.is.vector(rho) || is.matrix(rho) || is.list(rho))) stop(mstyle$stop("Argument 'rho' must either be a vector, a matrix, or a list.")) if (type.spec) { if (obs.spec) { # both type and obs are specified if (.is.vector(rho)) { if (length(rho) != 2L) stop(mstyle$stop("When 'type' and 'obs' are both specified, 'rho' must specify both the within- and between-construct correlations.")) rho <- as.list(rho) } else { if (is.matrix(rho)) { stop(mstyle$stop("When 'type' and 'obs' are both specified, 'rho' must specify both the within- and between-construct correlations.")) } else { if (length(rho) != 2L) stop(mstyle$stop("When 'type' and 'obs' are both specified and 'rho' is a list, then it must have two elements.")) } } } else { # only type is specified if (.is.vector(rho)) { if (length(rho) != 1L) stop(mstyle$stop("When only 'type' is specified, 'rho' must be a scalar.")) rho <- list(0, rho) } else { if (is.matrix(rho)) { rho <- list(0, rho) } else { if (length(rho) != 1L) stop(mstyle$stop("When only 'type' is specified, 'rho' must have a single list element.")) rho <- list(0, rho[[1]]) } } } } else { if (obs.spec) { # only obs is specified if (.is.vector(rho)) { if (length(rho) != 1L) stop(mstyle$stop("When only 'obs' is specified, 'rho' must be a scalar.")) rho <- list(rho, 0) } else { if (is.matrix(rho)) { rho <- list(rho, 0) } else { if (length(rho) != 1L) stop(mstyle$stop("When only 'obs' is specified, 'rho' must have a single list element.")) rho <- list(rho[[1]], 0) } } } else { # neither type nor obs is specified rho <- list(0, 0) } } if (length(rho[[1]]) == 1L) { rho[[1]] <- matrix(rho[[1]], nrow=length(unique(obs)), ncol=length(unique(obs))) diag(rho[[1]]) <- 1 rownames(rho[[1]]) <- colnames(rho[[1]]) <- unique(obs) } if (length(rho[[2]]) == 1L) { rho[[2]] <- matrix(rho[[2]], nrow=length(unique(type)), ncol=length(unique(type))) diag(rho[[2]]) <- 1 rownames(rho[[2]]) <- colnames(rho[[2]]) <- unique(type) } if (any(!sapply(rho, .is.square))) stop(mstyle$stop("All matrices specified via 'rho' argument must be square matrices.")) if (any(abs(rho[[1]]) > 1) || any(abs(rho[[2]]) > 1)) stop(mstyle$stop("All correlations specified via 'rho' must be in [-1,1].")) if (is.null(dimnames(rho[[1]])) || is.null(dimnames(rho[[2]]))) stop(mstyle$stop("Any matrices specified via 'rho' must have dimension names.")) if (is.null(rownames(rho[[1]]))) rownames(rho[[1]]) <- colnames(rho[[1]]) if (is.null(rownames(rho[[2]]))) rownames(rho[[2]]) <- colnames(rho[[2]]) if (is.null(colnames(rho[[1]]))) colnames(rho[[1]]) <- rownames(rho[[1]]) if (is.null(colnames(rho[[2]]))) colnames(rho[[2]]) <- rownames(rho[[2]]) if (!all(unique(obs) %in% rownames(rho[[1]]))) stop("There are 'obs' values with no corresponding row/column in the correlation matrix.") if (!all(unique(type) %in% rownames(rho[[2]]))) stop("There are 'type' values with no corresponding row/column in the correlation matrix.") #return(rho) ############################################################################ #### turn obs and type into character variables to that [obs[i],obs[j]] and [type[i],type[j]] below work correctly obs <- as.character(obs) type <- as.character(type) ### construct R matrix if (sparse) { R <- Matrix(0, nrow=k, ncol=k) } else { R <- matrix(0, nrow=k, ncol=k) } diag(R) <- 1 for (i in 2:k) { for (j in 1:i) { if (cluster[i] == cluster[j]) { R[i,j] <- ifelse(type[i]==type[j], ifelse(obs[i]==obs[j], 1, rho[[1]][obs[i],obs[j]]), rho[[2]][type[i],type[j]]) * (ifelse(grp1[i]==grp1[j], ifelse(time1[i]==time1[j], 1, phi^abs(time1[i]-time1[j])), 0) * sqrt(1/w1[i] * 1/w1[j]) - ifelse(grp1[i]==grp2[j], ifelse(time1[i]==time2[j], 1, phi^abs(time1[i]-time2[j])), 0) * sqrt(1/w1[i] * 1/w2[j]) - ifelse(grp2[i]==grp1[j], ifelse(time2[i]==time1[j], 1, phi^abs(time2[i]-time1[j])), 0) * sqrt(1/w2[i] * 1/w1[j]) + ifelse(grp2[i]==grp2[j], ifelse(time2[i]==time2[j], 1, phi^abs(time2[i]-time2[j])), 0) * sqrt(1/w2[i] * 1/w2[j])) / (sqrt(1/w1[i] + 1/w2[i] - 2*ifelse(grp1[i]==grp2[i], ifelse(time1[i]==time2[i], 1, phi^abs(time1[i]-time2[i])), 0) * sqrt(1/w1[i] * 1/w2[i])) * sqrt(1/w1[j] + 1/w2[j] - 2*ifelse(grp1[j]==grp2[j], ifelse(time1[j]==time2[j], 1, phi^abs(time1[j]-time2[j])), 0) * sqrt(1/w1[j] * 1/w2[j]))) } } } R[upper.tri(R)] <- t(R)[upper.tri(R)] } else { ### when rvars are specified ### warn user if non-relevant arguments have been specified not.miss <- c(type.spec, obs.spec, grp1.spec, grp2.spec, time1.spec, time2.spec, w1.spec, w2.spec, !missing(rho), !missing(phi)) if (any(not.miss)) { args <- c("type", "obs", "grp1", "grp2", "time1", "time2", "w1", "w2", "rho", "phi") warning(mstyle$warning("Argument", ifelse(sum(not.miss) > 1, "s", ""), " '", paste0(args[not.miss], collapse=","), "' ignored for when 'rvars' is specified."), call.=FALSE) } ### get position of rvars in data nl <- as.list(seq_along(data)) names(nl) <- names(data) rvars <- try(eval(substitute(rvars), envir=nl, enclos=NULL), silent=TRUE) if (inherits(rvars, "try-error")) stop(mstyle$stop("Could not find all variables specified via 'rvars' in 'data'.")) ### get rvars from data has.colon <- grepl(":", deparse1(substitute(rvars)), fixed=TRUE) if (has.colon && length(rvars) == 2L) { rvars <- data[seq(from = rvars[1], to = rvars[2])] } else { rvars <- data[rvars] } ### check that number of rvars makes sense given the k per cluster k.cluster <- tapply(cluster, cluster, length) if (max(k.cluster) > length(rvars)) stop(mstyle$stop(paste0("There ", ifelse(length(rvars) == 1L, "is 1 variable ", paste0("are ", length(rvars), " variables ")), "specified via 'rvars', but there are clusters with more rows."))) if (max(k.cluster) != length(rvars)) stop(mstyle$stop(paste0("There ", ifelse(length(rvars) == 1L, "is 1 variable ", paste0("are ", length(rvars), " variables ")), "specified via 'rvars', but no cluster with this many more rows."))) ### construct R matrix based on rvars R <- lapply(split(rvars, cluster), function(x) { k <- nrow(x) x <- x[seq_len(k)] x[upper.tri(x)] <- t(x)[upper.tri(x)] as.matrix(x) }) R <- bldiag(R, order=cluster) if (sparse) R <- Matrix(R, sparse=TRUE) } #return(R) ############################################################################ ### check that 'R' is positive definite in each cluster if (checkpd || nearpd) { for (i in seq_len(n)) { Ri <- R[cluster == ucluster[i], cluster == ucluster[i]] if (!anyNA(Ri) && !.chkpd(Ri)) { if (nearpd) { Ri <- try(as.matrix(nearPD(Ri, corr=TRUE)$mat), silent=TRUE) if (inherits(Ri, "try-error")) { warning(mstyle$warning(paste0("Using nearPD() failed in cluster ", ucluster[i], ".")), call.=FALSE) } else { if (!anyNA(Ri) && !.chkpd(Ri)) warning(mstyle$warning(paste0("The var-cov matrix still appears to be not positive definite in cluster ", ucluster[i], " even after nearPD().")), call.=FALSE) R[cluster == ucluster[i], cluster == ucluster[i]] <- Ri } } else { warning(mstyle$warning(paste0("The var-cov matrix appears to be not positive definite in cluster ", ucluster[i], ".")), call.=FALSE) } } } } ############################################################################ ### turn R into V if (sparse) { S <- Diagonal(k, sqrt(as.vector(vi))) } else { S <- diag(sqrt(as.vector(vi)), nrow=k, ncol=k) } V <- S %*% R %*% S if (.isTRUE(ddd$retdat)) V <- data.frame(cluster, type, obs, grp1, grp2, time1, time2, w1, w2, vi, V=V) return(V) } metafor/R/forest.default.r0000644000176200001440000007714414503014744015237 0ustar liggesusersforest.default <- function(x, vi, sei, ci.lb, ci.ub, annotate=TRUE, showweights=FALSE, header=FALSE, xlim, alim, olim, ylim, at, steps=5, level=95, refline=0, digits=2L, width, xlab, slab, ilab, ilab.xpos, ilab.pos, order, subset, transf, atransf, targs, rows, efac=1, pch, psize, plim=c(0.5,1.5), col, shade, colshade, lty, fonts, cex, cex.lab, cex.axis, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (missing(transf)) transf <- FALSE if (missing(atransf)) atransf <- FALSE transf.char <- deparse(transf) atransf.char <- deparse(atransf) if (is.function(transf) && is.function(atransf)) stop(mstyle$stop("Use either 'transf' or 'atransf' to specify a transformation (not both).")) .start.plot() yi <- x if (missing(targs)) targs <- NULL if (missing(at)) at <- NULL if (missing(ilab)) ilab <- NULL if (missing(ilab.xpos)) ilab.xpos <- NULL if (missing(ilab.pos)) ilab.pos <- NULL if (missing(subset)) subset <- NULL if (missing(order)) order <- NULL if (missing(pch)) pch <- 15 if (missing(psize)) psize <- NULL if (missing(col)) col <- NULL if (missing(shade)) shade <- NULL if (missing(colshade)) colshade <- .coladj(par("bg","fg"), dark=0.1, light=-0.1) if (missing(cex)) cex <- NULL if (missing(cex.lab)) cex.lab <- NULL if (missing(cex.axis)) cex.axis <- NULL level <- .level(level) ### digits[1] for annotations, digits[2] for x-axis labels, digits[3] (if specified) for weights ### note: digits can also be a list (e.g., digits=list(2,3L)); trailing 0's on the x-axis labels ### are dropped if the value is an integer if (length(digits) == 1L) digits <- c(digits,digits,digits) if (length(digits) == 2L) digits <- c(digits,digits[[1]]) ddd <- list(...) ############################################################################ ### set default line types if user has not specified 'lty' argument if (missing(lty)) { lty <- c("solid", "solid") # 1st = CIs, 2nd = horizontal line(s) } else { if (length(lty) == 1L) lty <- c(lty, "solid") } ### vertical expansion factor: 1st = CI end lines, 2nd = arrows if (length(efac) == 1L) efac <- rep(efac, 2L) ### annotation symbols vector if (is.null(ddd$annosym)) { annosym <- c(" [", ", ", "]", "-", " ") # 4th element for minus sign symbol; 5th for space (in place of numbers and +); see [a] } else { annosym <- ddd$annosym if (length(annosym) == 3L) annosym <- c(annosym, "-", " ") if (length(annosym) == 4L) annosym <- c(annosym, " ") if (length(annosym) != 5L) stop(mstyle$stop("Argument 'annosym' must be a vector of length 3 (or 4 or 5).")) } ### adjust annosym for tabular figures if (isTRUE(ddd$tabfig == 1)) annosym <- c("\u2009[", ",\u2009", "]", "\u2212", "\u2002") # \u2009 thin space; \u2212 minus, \u2002 en space if (isTRUE(ddd$tabfig == 2)) annosym <- c("\u2009[", ",\u2009", "]", "\u2013", "\u2002") # \u2009 thin space; \u2013 en dash, \u2002 en space if (isTRUE(ddd$tabfig == 3)) annosym <- c("\u2009[", ",\u2009", "]", "\u2212", "\u2007") # \u2009 thin space; \u2212 minus, \u2007 figure space ### set measure based on the measure attribute of yi if (is.null(attr(yi, "measure"))) { measure <- "GEN" } else { measure <- attr(yi, "measure") } ### column header estlab <- .setlab(measure, transf.char, atransf.char, gentype=3, short=TRUE) if (is.expression(estlab)) { header.right <- str2lang(paste0("bold(", estlab, " * '", annosym[1], "' * '", 100*(1-level), "% CI'", " * '", annosym[3], "')")) } else { header.right <- paste0(estlab, annosym[1], 100*(1-level), "% CI", annosym[3]) } if (is.logical(header)) { if (header) { header.left <- "Study" } else { header.left <- NULL header.right <- NULL } } else { if (!is.character(header)) stop(mstyle$stop("Argument 'header' must either be a logical or character vector.")) if (length(header) == 1L) { header.left <- header } else { header.left <- header[1] header.right <- header[2] } } if (!annotate) header.right <- NULL if (is.null(ddd$decreasing)) { decreasing <- FALSE } else { decreasing <- ddd$decreasing } if (!is.null(ddd$clim)) olim <- ddd$clim ### row adjustments for 1) study labels, 2) annotations, and 3) ilab elements if (is.null(ddd$rowadj)) { rowadj <- rep(0,3) } else { rowadj <- ddd$rowadj if (length(rowadj) == 1L) rowadj <- c(rowadj,rowadj,0) # if one value is specified, use it for both 1&2 if (length(rowadj) == 2L) rowadj <- c(rowadj,0) # if two values are specified, use them for 1&2 } if (is.null(ddd$top)) { top <- 3 } else { top <- ddd$top } if (is.null(ddd$xlabadj)) { xlabadj <- c(NA,NA) } else { xlabadj <- ddd$xlabadj if (length(xlabadj) == 1L) xlabadj <- c(xlabadj, 1-xlabadj) } if (is.null(ddd$xlabfont)) { xlabfont <- 1 } else { xlabfont <- ddd$xlabfont } lplot <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) plot(...) labline <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) abline(...) lsegments <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) segments(...) laxis <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) axis(...) lmtext <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) mtext(...) lpolygon <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) polygon(...) ltext <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) text(...) lpoints <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) points(...) ######################################################################### ### extract data, study labels, and other arguments if (!missing(vi) && is.function(vi)) # if vi is utils::vi() stop(mstyle$stop("Cannot find variable specified for 'vi' argument."), call.=FALSE) if (hasArg(ci.lb) && hasArg(ci.ub)) { # CI bounds are specified by user if (length(ci.lb) != length(ci.ub)) stop(mstyle$stop("Length of 'ci.lb' and 'ci.ub' is not the same.")) if (missing(vi) && missing(sei)) { # vi/sei not specified, so calculate vi based on CI vi <- ((ci.ub - ci.lb) / (2*qnorm(level/2, lower.tail=FALSE)))^2 } else { if (missing(vi)) # vi not specified, but sei is, so set vi = sei^2 vi <- sei^2 } if (length(ci.lb) != length(vi)) stop(mstyle$stop("Length of 'vi' (or 'sei') does not match length of ('ci.lb', 'ci.ub') pairs.")) } else { # CI bounds are not specified by user if (missing(vi)) { if (missing(sei)) { stop(mstyle$stop("Must specify either 'vi', 'sei', or ('ci.lb', 'ci.ub') pairs.")) } else { vi <- sei^2 } } if (length(yi) != length(vi)) # need to do this here to avoid warning when calculating 'ci.lb' and 'ci.ub' stop(mstyle$stop("Length of 'vi' (or 'sei') does not match length of 'yi'.")) ci.lb <- yi - qnorm(level/2, lower.tail=FALSE) * sqrt(vi) ci.ub <- yi + qnorm(level/2, lower.tail=FALSE) * sqrt(vi) } ### check length of yi and vi k <- length(yi) if (length(vi) != k) stop(mstyle$stop("Length of 'yi' does not match the length of 'vi', 'sei', or the ('ci.lb', 'ci.ub') pairs.")) ### note: slab (if specified), ilab (if specified), pch (if vector), psize (if ### vector), col (if vector), subset (if specified), order (if vector) ### must have the same length as yi (including NAs) even when subsetting eventually slab.null <- FALSE if (missing(slab)) { slab <- attr(yi, "slab") # use slab info if it can be found in slab attribute of yi (and it has the right length) if (is.null(slab) || length(slab) != k) { slab <- paste("Study", seq_len(k)) slab.null <- TRUE } } else { if (length(slab) == 1L && is.na(slab)) { # slab=NA can be used to suppress study labels slab <- rep("", k) slab.null <- TRUE } } if (length(slab) != k) stop(mstyle$stop(paste0("Length of the 'slab' argument (", length(slab), ") does not correspond to the number of outcomes (", k, ")."))) if (!is.null(ilab)) { if (is.null(dim(ilab))) ilab <- cbind(ilab) if (nrow(ilab) != k) stop(mstyle$stop(paste0("Length of the 'ilab' argument (", nrow(ilab), ") does not correspond to the number of outcomes (", k, ")."))) } if (length(pch) == 1L) pch <- rep(pch, k) # pch can be a single value (which is then repeated) if (length(pch) != k) stop(mstyle$stop(paste0("Length of the 'pch' argument (", length(pch), ") does not correspond to the number of outcomes (", k, ")."))) if (!is.null(psize)) { if (length(psize) == 1L) # psize can be a single value (which is then repeated) psize <- rep(psize, k) if (length(psize) != k) stop(mstyle$stop(paste0("Length of the 'psize' argument (", length(psize), ") does not correspond to the number of outcomes (", k, ")."))) } if (!is.null(col)) { if (length(col) == 1L) # col can be a single value (which is then repeated) col <- rep(col, k) if (length(col) != k) stop(mstyle$stop(paste0("Length of the 'col' argument (", length(col), ") does not correspond to the number of outcomes (", k, ")."))) } else { col <- rep(par("fg"), k) } shade.type <- "none" if (is.character(shade)) { shade.type <- "character" shade <- shade[1] if (!is.element(shade, c("zebra", "zebra1", "zebra2", "all"))) stop(mstyle$stop("Unknown option specified for 'shade' argument.")) } if (is.logical(shade)) { if (length(shade) == 1L) { shade <- "zebra" shade.type <- "character" } else { shade.type <- "logical" shade <- .chksubset(shade, k, stoponk0=FALSE) } } if (is.numeric(shade)) shade.type <- "numeric" ### adjust subset if specified subset <- .chksubset(subset, k) ### sort the data if requested if (!is.null(order)) { if (length(order) == 1L) { order <- match.arg(order, c("obs", "yi", "prec", "vi")) if (order == "obs" || order == "yi") sort.vec <- order(yi) if (order == "prec" || order == "vi") sort.vec <- order(vi, yi) } else { if (length(order) != k) stop(mstyle$stop(paste0("Length of the 'order' argument (", length(order), ") does not correspond to the number of outcomes (", k, ")."))) if (grepl("^order\\(", deparse1(substitute(order)))) { sort.vec <- order } else { sort.vec <- order(order, decreasing=decreasing) } } yi <- yi[sort.vec] vi <- vi[sort.vec] ci.lb <- ci.lb[sort.vec] ci.ub <- ci.ub[sort.vec] slab <- slab[sort.vec] ilab <- ilab[sort.vec,,drop=FALSE] # if NULL, remains NULL pch <- pch[sort.vec] psize <- psize[sort.vec] # if NULL, remains NULL col <- col[sort.vec] subset <- subset[sort.vec] # if NULL, remains NULL if (shade.type == "logical") shade <- shade[sort.vec] } ### if a subset of studies is specified if (!is.null(subset)) { yi <- .getsubset(yi, subset) vi <- .getsubset(vi, subset) ci.lb <- .getsubset(ci.lb, subset) ci.ub <- .getsubset(ci.ub, subset) slab <- .getsubset(slab, subset) ilab <- .getsubset(ilab, subset) # if NULL, remains NULL pch <- .getsubset(pch, subset) psize <- .getsubset(psize, subset) # if NULL, remains NULL col <- .getsubset(col, subset) if (shade.type == "logical") shade <- .getsubset(shade, subset) } k <- length(yi) # in case length of k has changed ### set rows value if (missing(rows)) { rows <- k:1 } else { if (length(rows) == 1L) # note: rows must be a single value or the same rows <- rows:(rows-k+1) # length of yi (including NAs) *after ordering/subsetting* } if (length(rows) != k) stop(mstyle$stop(paste0("Length of the 'rows' argument (", length(rows), ") does not correspond to the number of outcomes (", k, ")", ifelse(is.null(subset), ".", " after subsetting.")))) ### reverse order yi <- yi[k:1] vi <- vi[k:1] ci.lb <- ci.lb[k:1] ci.ub <- ci.ub[k:1] slab <- slab[k:1] ilab <- ilab[k:1,,drop=FALSE] # if NULL, remains NULL pch <- pch[k:1] psize <- psize[k:1] # if NULL, remains NULL col <- col[k:1] rows <- rows[k:1] if (shade.type == "logical") shade <- shade[k:1] ### check for NAs in yi/vi and act accordingly yivi.na <- is.na(yi) | is.na(vi) if (any(yivi.na)) { not.na <- !yivi.na if (na.act == "na.omit") { yi <- yi[not.na] vi <- vi[not.na] ci.lb <- ci.lb[not.na] ci.ub <- ci.ub[not.na] slab <- slab[not.na] ilab <- ilab[not.na,,drop=FALSE] # if NULL, remains NULL pch <- pch[not.na] psize <- psize[not.na] # if NULL, remains NULL col <- col[not.na] if (shade.type == "logical") shade <- shade[not.na] rows.new <- rows # rearrange rows due to NAs being omitted from plot rows.na <- rows[!not.na] # shift higher rows down according to number of NAs omitted for (j in seq_along(rows.na)) { rows.new[rows >= rows.na[j]] <- rows.new[rows >= rows.na[j]] - 1 } rows <- rows.new[not.na] } if (na.act == "na.fail") stop(mstyle$stop("Missing values in results.")) } # note: yi/vi may be NA if na.act == "na.exclude" or "na.pass" k <- length(yi) # in case length of k has changed ### if requested, apply transformation to yi's and CI bounds if (is.function(transf)) { if (is.null(targs)) { yi <- sapply(yi, transf) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) } else { yi <- sapply(yi, transf, targs) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) } } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] ### apply observation/outcome limits if specified if (!missing(olim)) { if (length(olim) != 2L) stop(mstyle$stop("Argument 'olim' must be of length 2.")) olim <- sort(olim) yi[yi < olim[1]] <- olim[1] yi[yi > olim[2]] <- olim[2] ci.lb[ci.lb < olim[1]] <- olim[1] ci.ub[ci.ub > olim[2]] <- olim[2] } if (showweights) { # inverse variance weights after ordering/subsetting and weights <- 1/vi # omitting NAs (so these weights always add up to 100%) weights <- 100 * weights / sum(weights, na.rm=TRUE) } ### set default point sizes (if not specified by user) if (is.null(psize)) { if (any(vi <= 0, na.rm=TRUE)) { # in case any vi value is zero psize <- rep(1, k) } else { # default psize is proportional to inverse standard error (only vi's that are still in the subset are considered) if (length(plim) < 2L) # note: vi's that are NA are ignored (but vi's whose yi is NA are NOT ignored; an unlikely case in practice) stop(mstyle$stop("Argument 'plim' must be of length 2 or 3.")) wi <- 1/sqrt(vi) if (!is.na(plim[1]) && !is.na(plim[2])) { rng <- max(wi, na.rm=TRUE) - min(wi, na.rm=TRUE) if (rng <= .Machine$double.eps^0.5) { psize <- rep(1, k) } else { psize <- (wi - min(wi, na.rm=TRUE)) / rng psize <- (psize * (plim[2] - plim[1])) + plim[1] } } if (is.na(plim[1]) && !is.na(plim[2])) { psize <- wi / max(wi, na.rm=TRUE) * plim[2] if (length(plim) == 3L) psize[psize <= plim[3]] <- plim[3] } if (!is.na(plim[1]) && is.na(plim[2])) { psize <- wi / min(wi, na.rm=TRUE) * plim[1] if (length(plim) == 3L) psize[psize >= plim[3]] <- plim[3] } if (all(is.na(psize))) # if k=1, then psize is NA, so catch this (and maybe some other problems) psize <- rep(1, k) } } ######################################################################### if (!is.null(at)) { if (anyNA(at)) stop(mstyle$stop("Argument 'at' cannot contain NAs.")) if (any(is.infinite(at))) stop(mstyle$stop("Argument 'at' cannot contain +-Inf values.")) } ### set x-axis limits (at argument overrides alim argument) alim.spec <- TRUE if (missing(alim)) { if (is.null(at)) { alim <- range(pretty(x=c(min(ci.lb, na.rm=TRUE), max(ci.ub, na.rm=TRUE)), n=steps-1)) alim.spec <- FALSE } else { alim <- range(at) } } alim <- sort(alim)[1:2] if (anyNA(alim)) stop(mstyle$stop("Argument 'alim' cannot contain NAs.")) ### generate x-axis positions if none are specified if (is.null(at)) { if (alim.spec) { at <- seq(from=alim[1], to=alim[2], length.out=steps) } else { at <- pretty(x=c(min(ci.lb, na.rm=TRUE), max(ci.ub, na.rm=TRUE)), n=steps-1) } } else { at[at < alim[1]] <- alim[1] # remove at values that are below or above the axis limits at[at > alim[2]] <- alim[2] at <- unique(at) } ### x-axis labels (apply transformation to axis labels if requested) at.lab <- at if (is.function(atransf)) { if (is.null(targs)) { at.lab <- fmtx(sapply(at.lab, atransf), digits[[2]], drop0ifint=TRUE) } else { at.lab <- fmtx(sapply(at.lab, atransf, targs), digits[[2]], drop0ifint=TRUE) } } else { at.lab <- fmtx(at.lab, digits[[2]], drop0ifint=TRUE) } ### set plot limits (xlim) ncol.ilab <- ifelse(is.null(ilab), 0, ncol(ilab)) if (slab.null) { area.slab <- 25 } else { area.slab <- 40 } if (annotate) { if (showweights) { area.anno <- 30 } else { area.anno <- 25 } } else { area.anno <- 10 } iadd <- 5 area.slab <- area.slab + iadd*ncol.ilab #area.anno <- area.anno area.forest <- 100 + iadd*ncol.ilab - area.slab - area.anno area.slab <- area.slab / (100 + iadd*ncol.ilab) area.anno <- area.anno / (100 + iadd*ncol.ilab) area.forest <- area.forest / (100 + iadd*ncol.ilab) plot.multp.l <- area.slab / area.forest plot.multp.r <- area.anno / area.forest if (missing(xlim)) { if (min(ci.lb, na.rm=TRUE) < alim[1]) { f.1 <- alim[1] } else { f.1 <- min(ci.lb, na.rm=TRUE) } if (max(ci.ub, na.rm=TRUE) > alim[2]) { f.2 <- alim[2] } else { f.2 <- max(ci.ub, na.rm=TRUE) } rng <- f.2 - f.1 xlim <- c(f.1 - rng * plot.multp.l, f.2 + rng * plot.multp.r) xlim <- round(xlim, digits[[2]]) #xlim[1] <- xlim[1]*max(1, digits[[2]]/2) #xlim[2] <- xlim[2]*max(1, digits[[2]]/2) } xlim <- sort(xlim) ### plot limits must always encompass the yi values (no longer done) #if (xlim[1] > min(yi, na.rm=TRUE)) { xlim[1] <- min(yi, na.rm=TRUE) } #if (xlim[2] < max(yi, na.rm=TRUE)) { xlim[2] <- max(yi, na.rm=TRUE) } ### x-axis limits must always encompass the yi values (no longer done) #if (alim[1] > min(yi, na.rm=TRUE)) { alim[1] <- min(yi, na.rm=TRUE) } #if (alim[2] < max(yi, na.rm=TRUE)) { alim[2] <- max(yi, na.rm=TRUE) } ### plot limits must always encompass the x-axis limits (no longer done) #if (alim[1] < xlim[1]) { xlim[1] <- alim[1] } #if (alim[2] > xlim[2]) { xlim[2] <- alim[2] } ### allow adjustment of position of study labels and annotations via textpos argument if (is.null(ddd$textpos)) { textpos <- xlim } else { textpos <- ddd$textpos } if (length(textpos) != 2L) stop(mstyle$stop("Argument 'textpos' must be of length 2.")) if (is.na(textpos[1])) textpos[1] <- xlim[1] if (is.na(textpos[2])) textpos[2] <- xlim[2] ### set y-axis limits if (missing(ylim)) { ylim <- c(0.5, max(rows, na.rm=TRUE)+top) } else { ylim <- sort(ylim) } ######################################################################### ### set/get fonts (1st for study labels, 2nd for annotations, 3rd for ilab) ### when passing a named vector, the names are for 'family' and the values are for 'font' if (missing(fonts)) { fonts <- rep(par("family"), 3L) } else { if (length(fonts) == 1L) fonts <- rep(fonts, 3L) if (length(fonts) == 2L) fonts <- c(fonts, fonts[1]) } if (is.null(names(fonts))) fonts <- setNames(c(1L,1L,1L), nm=fonts) par(family=names(fonts)[1], font=fonts[1]) ### adjust margins par.mar <- par("mar") par.mar.adj <- par.mar - c(0,3,1,1) par.mar.adj[par.mar.adj < 0] <- 0 par(mar = par.mar.adj) on.exit(par(mar = par.mar), add=TRUE) ### start plot lplot(NA, NA, xlim=xlim, ylim=ylim, xlab="", ylab="", yaxt="n", xaxt="n", xaxs="i", bty="n", ...) ### add shading if (shade.type == "character") { if (shade == "zebra" || shade == "zebra1") tmp <- rep_len(c(TRUE,FALSE), k) if (shade == "zebra2") tmp <- rep_len(c(FALSE,TRUE), k) if (shade == "all") tmp <- rep_len(TRUE, k) shade <- tmp } if (shade.type %in% c("character","logical")) { for (i in seq_len(k)) { if (shade[i]) rect(xlim[1], rows[i]-0.5, xlim[2], rows[i]+0.5, border=colshade, col=colshade) } } if (shade.type == "numeric") { for (i in seq_along(shade)) { rect(xlim[1], shade[i]-0.5, xlim[2], shade[i]+0.5, border=colshade, col=colshade) } } ### horizontal title line labline(h=ylim[2]-(top-1), lty=lty[2], ...) ### get coordinates of the plotting region par.usr <- par("usr") ### add reference line if (is.numeric(refline)) lsegments(refline, par.usr[3], refline, ylim[2]-(top-1), lty="dotted", ...) ### set cex, cex.lab, and cex.axis sizes as a function of the height of the figure height <- par.usr[4] - par.usr[3] if (is.null(cex)) { lheight <- strheight("O") cex.adj <- ifelse(k * lheight > height * 0.8, height/(1.25 * k * lheight), 1) } if (is.null(cex)) { cex <- par("cex") * cex.adj } else { if (is.null(cex.lab)) cex.lab <- cex if (is.null(cex.axis)) cex.axis <- cex } if (is.null(cex.lab)) cex.lab <- par("cex") * cex.adj if (is.null(cex.axis)) cex.axis <- par("cex") * cex.adj ### add x-axis laxis(side=1, at=at, labels=at.lab, cex.axis=cex.axis, ...) ### add x-axis label if (missing(xlab)) xlab <- .setlab(measure, transf.char, atransf.char, gentype=1) if (!is.element(length(xlab), 1:3)) stop(mstyle$stop("Argument 'xlab' argument must be of length 1, 2, or 3.")) if (length(xlab) == 1L) lmtext(xlab, side=1, at=min(at) + (max(at)-min(at))/2, line=par("mgp")[1]-0.5, cex=cex.lab, font=xlabfont[1], ...) if (length(xlab) == 2L) { lmtext(xlab[1], side=1, at=min(at), line=par("mgp")[1]-0.5, cex=cex.lab, adj=xlabadj[1], font=xlabfont[1], ...) lmtext(xlab[2], side=1, at=max(at), line=par("mgp")[1]-0.5, cex=cex.lab, adj=xlabadj[2], font=xlabfont[1], ...) } if (length(xlab) == 3L) { lmtext(xlab[1], side=1, at=min(at), line=par("mgp")[1]-0.5, cex=cex.lab, adj=xlabadj[1], font=xlabfont[1], ...) lmtext(xlab[2], side=1, at=min(at) + (max(at)-min(at))/2, line=par("mgp")[1]-0.5, cex=cex.lab, font=xlabfont[2], ...) lmtext(xlab[3], side=1, at=max(at), line=par("mgp")[1]-0.5, cex=cex.lab, adj=xlabadj[2], font=xlabfont[1], ...) } ### add CI ends (either | or <> if outside of axis limits) for (i in seq_len(k)) { ### need to skip missings (if check below will otherwise throw an error) if (is.na(yi[i]) || is.na(ci.lb[i]) || is.na(ci.ub[i])) next ### if the lower bound is actually larger than upper x-axis limit, then everything is to the right and just draw a polygon pointing in that direction if (ci.lb[i] >= alim[2]) { lpolygon(x=c(alim[2], alim[2]-(1.4/100)*cex*(xlim[2]-xlim[1]), alim[2]-(1.4/100)*cex*(xlim[2]-xlim[1]), alim[2]), y=c(rows[i], rows[i]+(height/150)*cex*efac[2], rows[i]-(height/150)*cex*efac[2], rows[i]), col=col[i], border=col[i], ...) next } ### if the upper bound is actually lower than lower x-axis limit, then everything is to the left and just draw a polygon pointing in that direction if (ci.ub[i] <= alim[1]) { lpolygon(x=c(alim[1], alim[1]+(1.4/100)*cex*(xlim[2]-xlim[1]), alim[1]+(1.4/100)*cex*(xlim[2]-xlim[1]), alim[1]), y=c(rows[i], rows[i]+(height/150)*cex*efac[2], rows[i]-(height/150)*cex*efac[2], rows[i]), col=col[i], border=col[i], ...) next } lsegments(max(ci.lb[i], alim[1]), rows[i], min(ci.ub[i], alim[2]), rows[i], lty=lty[1], col=col[i], ...) if (ci.lb[i] >= alim[1]) { lsegments(ci.lb[i], rows[i]-(height/150)*cex*efac[1], ci.lb[i], rows[i]+(height/150)*cex*efac[1], col=col[i], ...) } else { lpolygon(x=c(alim[1], alim[1]+(1.4/100)*cex*(xlim[2]-xlim[1]), alim[1]+(1.4/100)*cex*(xlim[2]-xlim[1]), alim[1]), y=c(rows[i], rows[i]+(height/150)*cex*efac[2], rows[i]-(height/150)*cex*efac[2], rows[i]), col=col[i], border=col[i], ...) } if (ci.ub[i] <= alim[2]) { lsegments(ci.ub[i], rows[i]-(height/150)*cex*efac[1], ci.ub[i], rows[i]+(height/150)*cex*efac[1], col=col[i], ...) } else { lpolygon(x=c(alim[2], alim[2]-(1.4/100)*cex*(xlim[2]-xlim[1]), alim[2]-(1.4/100)*cex*(xlim[2]-xlim[1]), alim[2]), y=c(rows[i], rows[i]+(height/150)*cex*efac[2], rows[i]-(height/150)*cex*efac[2], rows[i]), col=col[i], border=col[i], ...) } } ### add study labels on the left ltext(textpos[1], rows+rowadj[1], slab, pos=4, cex=cex, col=col, ...) ### add info labels if (!is.null(ilab)) { if (is.null(ilab.xpos)) { #stop(mstyle$stop("Must specify 'ilab.xpos' argument when adding information with 'ilab'.")) dist <- min(ci.lb, na.rm=TRUE) - xlim[1] if (ncol.ilab == 1L) ilab.xpos <- xlim[1] + dist*0.75 if (ncol.ilab == 2L) ilab.xpos <- xlim[1] + dist*c(0.65, 0.85) if (ncol.ilab == 3L) ilab.xpos <- xlim[1] + dist*c(0.60, 0.75, 0.90) if (ncol.ilab >= 4L) ilab.xpos <- seq(xlim[1] + dist*0.5, xlim[1] + dist*0.9, length.out=ncol.ilab) } if (length(ilab.xpos) != ncol(ilab)) stop(mstyle$stop(paste0("Number of 'ilab' columns (", ncol(ilab), ") does not match length of 'ilab.xpos' argument (", length(ilab.xpos), ")."))) if (!is.null(ilab.pos) && length(ilab.pos) == 1L) ilab.pos <- rep(ilab.pos, ncol(ilab)) par(family=names(fonts)[3], font=fonts[3]) for (l in seq_len(ncol(ilab))) { ltext(ilab.xpos[l], rows+rowadj[3], ilab[,l], pos=ilab.pos[l], cex=cex, ...) } par(family=names(fonts)[1], font=fonts[1]) } ### add study annotations on the right: yi [LB, UB] if (annotate) { if (is.function(atransf)) { if (is.null(targs)) { annotext <- cbind(sapply(yi, atransf), sapply(ci.lb, atransf), sapply(ci.ub, atransf)) } else { annotext <- cbind(sapply(yi, atransf, targs), sapply(ci.lb, atransf, targs), sapply(ci.ub, atransf, targs)) } ### make sure order of intervals is always increasing tmp <- .psort(annotext[,2:3]) annotext[,2:3] <- tmp } else { annotext <- cbind(yi, ci.lb, ci.ub) } if (showweights) { annotext <- cbind(weights, annotext) annotext <- fmtx(annotext, c(digits[[3]], digits[[1]], digits[[1]], digits[[1]])) } else { annotext <- fmtx(annotext, digits[[1]]) } if (missing(width)) { width <- apply(annotext, 2, function(x) max(nchar(x))) } else { if (length(width) == 1L) width <- rep(width, ncol(annotext)) if (length(width) != ncol(annotext)) stop(mstyle$stop(paste0("Length of 'width' argument (", length(width), ") does not match the number of annotation columns (", ncol(annotext), ")."))) } for (j in seq_len(ncol(annotext))) { annotext[,j] <- formatC(annotext[,j], width=width[j]) } if (showweights) { annotext <- cbind(annotext[,1], paste0("%", rep(substr(annosym[1],1,1),3)), annotext[,2], annosym[1], annotext[,3], annosym[2], annotext[,4], annosym[3]) } else { annotext <- cbind(annotext[,1], annosym[1], annotext[,2], annosym[2], annotext[,3], annosym[3]) } annotext <- apply(annotext, 1, paste, collapse="") annotext[grepl("NA", annotext, fixed=TRUE)] <- "" annotext <- gsub("-", annosym[4], annotext, fixed=TRUE) # [a] annotext <- gsub(" ", annosym[5], annotext, fixed=TRUE) par(family=names(fonts)[2], font=fonts[2]) ltext(textpos[2], rows+rowadj[2], labels=annotext, pos=2, cex=cex, col=col, ...) par(family=names(fonts)[1], font=fonts[1]) } else { width <- NULL } ### add yi points for (i in seq_len(k)) { ### need to skip missings (if check below will otherwise throw an error) if (is.na(yi[i])) next if (yi[i] >= alim[1] && yi[i] <= alim[2]) lpoints(x=yi[i], y=rows[i], pch=pch[i], cex=cex*psize[i], col=col[i], ...) } #lpoints(x=yi, y=rows, pch=pch, cex=cex*psize, ...) ### add header ltext(textpos[1], ylim[2]-(top-1)+1, header.left, pos=4, font=2, cex=cex, ...) ltext(textpos[2], ylim[2]-(top-1)+1, header.right, pos=2, font=2, cex=cex, ...) ######################################################################### ### return some information about plot invisibly res <- list(xlim=par("usr")[1:2], alim=alim, at=at, ylim=ylim, rows=rows, cex=cex, cex.lab=cex.lab, cex.axis=cex.axis, ilab.xpos=ilab.xpos, ilab.pos=ilab.pos, textpos=textpos) ### add some additional stuff to be put into .metafor environment, so that it can be used by addpoly() sav <- c(res, list(level=level, annotate=annotate, digits=digits[[1]], width=width, transf=transf, atransf=atransf, targs=targs, fonts=fonts[1:2], annosym=annosym)) try(assign("forest", sav, envir=.metafor), silent=TRUE) invisible(res) } metafor/R/conv.2x2.r0000644000176200001440000001570014430165711013657 0ustar liggesusersconv.2x2 <- function(ori, ri, x2i, ni, n1i, n2i, correct=TRUE, data, include, var.names=c("ai","bi","ci","di"), append=TRUE, replace="ifna") { mstyle <- .get.mstyle("crayon" %in% .packages()) if (is.logical(replace)) { if (isTRUE(replace)) { replace <- "all" } else { replace <- "ifna" } } replace <- match.arg(replace, c("ifna","all")) ######################################################################### if (missing(data)) data <- NULL has.data <- !is.null(data) if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } ### checks on var.names argument if (length(var.names) != 4L) stop(mstyle$stop("Argument 'var.names' must be of length 4.")) if (any(var.names != make.names(var.names, unique=TRUE))) { var.names <- make.names(var.names, unique=TRUE) warning(mstyle$warning(paste0("Argument 'var.names' does not contain syntactically valid variable names.\nVariable names adjusted to: var.names = c('", var.names[1], "','", var.names[2], "','", var.names[3], "','", var.names[2], "').")), call.=FALSE) } ######################################################################### mf <- match.call() ori <- .getx("ori", mf=mf, data=data, checknumeric=TRUE) ri <- .getx("ri", mf=mf, data=data, checknumeric=TRUE) x2i <- .getx("x2i", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) n1i <- .getx("n1i", mf=mf, data=data, checknumeric=TRUE) n2i <- .getx("n2i", mf=mf, data=data, checknumeric=TRUE) correct <- .getx("correct", mf=mf, data=data, default=TRUE) include <- .getx("include", mf=mf, data=data) if (!.equal.length(ori, ri, x2i, ni, n1i, n2i)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k <- max(length(ori), length(ri), length(x2i), length(ni), length(n1i), length(n2i)) if (is.null(ori)) ori <- rep(NA_real_, k) if (is.null(ri)) ri <- rep(NA_real_, k) if (is.null(x2i)) x2i <- rep(NA_real_, k) if (is.null(ni)) ni <- rep(NA_real_, k) if (is.null(n1i)) n1i <- rep(NA_real_, k) if (is.null(n2i)) n2i <- rep(NA_real_, k) ### handle correct argument if (length(correct) == 1L) correct <- rep(correct, k) if (length(correct) != k) stop(mstyle$stop(paste0("Length of 'correct' argument (", length(correct), ") does not match length of data (", k, ")."))) correct[is.na(correct)] <- TRUE ### if include is NULL, set to TRUE vector if (is.null(include)) include <- rep(TRUE, k) ### turn numeric include vector into logical vector include <- .chksubset(include, k, stoponk0=FALSE) ### set inputs to NA for rows not to be included ori[!include] <- NA_real_ ri[!include] <- NA_real_ x2i[!include] <- NA_real_ ni[!include] <- NA_real_ n1i[!include] <- NA_real_ n2i[!include] <- NA_real_ ### round ni, n1i, and n2i ni <- round(ni) n1i <- round(n1i) n2i <- round(n2i) ### checks on values if (any(c(ni < 0, n1i < 0, n2i < 0), na.rm=TRUE)) stop(mstyle$stop("One or more sample sizes or marginal counts are negative.")) if (any(c(n1i > ni, n2i > ni), na.rm=TRUE)) stop(mstyle$stop("One or more marginal counts are larger than the sample sizes.")) if (any(abs(ri) > 1, na.rm=TRUE)) stop(mstyle$stop("One or more phi coefficients are > 1 or < -1.")) ### compute marginal proportions for the two variables p1i <- n1i / ni p2i <- n2i / ni ######################################################################### p11i <- rep(NA_real_, k) for (i in seq_len(k)) { if (is.na(ni[i]) || is.na(n1i[i]) || is.na(n2i[i])) next if (!is.na(ori[i])) { p1. <- p1i[i] p2. <- 1-p1i[i] p.1 <- p2i[i] p.2 <- 1-p2i[i] x <- ori[i] * (p1. + p.1) + p2. - p.1 y <- sqrt(x^2 - 4 * p1. * p.1 * ori[i] * (ori[i]-1)) p11i[i] <- (x - y) / (2 * (ori[i] - 1)) } # note: when x2i=0, then sign(0) = 0 and hence ri is automatically 0, which is correct # (i.e., we do not want to use the continuity correction in this case) if (is.na(ri[i]) && !is.na(x2i[i])) { if (correct[i]) { ri[i] <- sign(x2i[i]) * (sqrt(abs(x2i[i])/ni[i]) + ni[i] / (2*sqrt(n1i[i]*(ni[i]-n1i[i])*n2i[i]*(ni[i]-n2i[i])))) } else { ri[i] <- sign(x2i[i]) * sqrt(abs(x2i[i])/ni[i]) } } if (is.na(p11i[i]) && !is.na(ri[i])) p11i[i] <- p1i[i]*p2i[i] + ri[i] * sqrt(p1i[i]*(1-p1i[i])*p2i[i]*(1-p2i[i])) } ai <- round(ni * p11i) bi <- n1i - ai ci <- n2i - ai di <- ni - ai - bi - ci #print(matrix(c(ai,bi,ci,di), nrow=2, byrow=TRUE)) ### check for negative cell frequencies hasneg <- (ai < 0) | (bi < 0) | (ci < 0) | (di < 0) if (any(hasneg, na.rm=TRUE)) { warning(mstyle$warning(paste0("There are negative cell frequencies in table", ifelse(sum(hasneg, na.rm=TRUE) > 1, "s ", " "), paste0(which(hasneg), collapse=","), ".")), call.=FALSE) ai[hasneg] <- NA_real_ bi[hasneg] <- NA_real_ ci[hasneg] <- NA_real_ di[hasneg] <- NA_real_ } ######################################################################### if (has.data && append) { if (is.element(var.names[1], names(data))) { if (replace=="ifna") { data[[var.names[1]]] <- replmiss(data[[var.names[1]]], ai) } else { data[[var.names[1]]][!is.na(ai)] <- ai[!is.na(ai)] } } else { data <- cbind(data, ai) names(data)[length(names(data))] <- var.names[1] } if (is.element(var.names[2], names(data))) { if (replace=="ifna") { data[[var.names[2]]] <- replmiss(data[[var.names[2]]], bi) } else { data[[var.names[2]]][!is.na(bi)] <- bi[!is.na(bi)] } } else { data <- cbind(data, bi) names(data)[length(names(data))] <- var.names[2] } if (is.element(var.names[3], names(data))) { if (replace=="ifna") { data[[var.names[3]]] <- replmiss(data[[var.names[3]]], ci) } else { data[[var.names[3]]][!is.na(ci)] <- ai[!is.na(ci)] } } else { data <- cbind(data, ci) names(data)[length(names(data))] <- var.names[3] } if (is.element(var.names[4], names(data))) { if (replace=="ifna") { data[[var.names[4]]] <- replmiss(data[[var.names[4]]], di) } else { data[[var.names[4]]][!is.na(di)] <- ai[!is.na(di)] } } else { data <- cbind(data, di) names(data)[length(names(data))] <- var.names[4] } } else { data <- data.frame(ai, bi, ci, di) names(data) <- var.names } return(data) } metafor/R/blup.r0000644000176200001440000000005613672736517013257 0ustar liggesusersblup <- function(x, ...) UseMethod("blup") metafor/R/robust.r0000644000176200001440000000007313457322061013614 0ustar liggesusersrobust <- function(x, cluster, ...) UseMethod("robust") metafor/R/influence.rma.uni.r0000644000176200001440000002240714440116113015613 0ustar liggesusersinfluence.rma.uni <- function(model, digits, progbar=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(model), must="rma.uni", notav=c("rma.ls", "rma.gen", "rma.uni.selmodel")) na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) x <- model if (x$k == 1) stop(mstyle$stop("Stopped because k = 1.")) ddd <- list(...) .chkdots(ddd, c("btt", "measure", "time")) btt <- .set.btt(ddd$btt, x$p, int.incl=FALSE, Xnames=colnames(x$X)) m <- length(btt) if (is.null(ddd$measure)) { measure <- "all" } else { measure <- ddd$measure } if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (!measure == "cooks.distance" && inherits(model, "robust.rma")) stop(mstyle$stop("Method not available for objects of class \"robust.rma\".")) if (.isTRUE(ddd$time)) time.start <- proc.time() ######################################################################### tau2.del <- rep(NA_real_, x$k) delpred <- rep(NA_real_, x$k) vdelpred <- rep(NA_real_, x$k) s2w.del <- rep(NA_real_, x$k) QE.del <- rep(NA_real_, x$k) dffits <- rep(NA_real_, x$k) dfbs <- matrix(NA_real_, nrow=x$k, ncol=x$p) cook.d <- rep(NA_real_, x$k) cov.r <- rep(NA_real_, x$k) weight <- rep(NA_real_, x$k) ### predicted values under the full model pred.full <- x$X %*% x$beta ### calculate inverse of variance-covariance matrix under the full model (needed for the Cook's distances) svb <- chol2inv(chol(x$vb[btt,btt,drop=FALSE])) ### also need stXAX/stXX and H matrix for DFFITS calculation when not using the standard weights if (x$weighted) { if (!is.null(x$weights)) { A <- diag(x$weights, nrow=x$k, ncol=x$k) stXAX <- .invcalc(X=x$X, W=A, k=x$k) H <- x$X %*% stXAX %*% t(x$X) %*% A } } else { stXX <- .invcalc(X=x$X, W=diag(x$k), k=x$k) H <- x$X %*% stXX %*% t(x$X) } ### hat values options(na.action = "na.omit") hat <- hatvalues(x) options(na.action = na.act) ### elements that need to be returned outlist <- "coef.na=coef.na, tau2=tau2, QE=QE, beta=beta, vb=vb, s2w=s2w" ### note: skipping NA cases ### also: it is possible that model fitting fails, so that generates more NAs (these NAs will always be shown in output) if (progbar) pbar <- pbapply::startpb(min=0, max=x$k) for (i in seq_len(x$k)) { if (progbar) pbapply::setpb(pbar, i) args <- list(yi=x$yi, vi=x$vi, weights=x$weights, mods=x$X, intercept=FALSE, method=x$method, weighted=x$weighted, test=x$test, level=x$level, tau2=ifelse(x$tau2.fix, x$tau2, NA), control=x$control, subset=-i, skipr2=TRUE, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=TRUE) if (inherits(res, "try-error")) next ### removing an observation could lead to a model coefficient becoming inestimable if (any(res$coef.na)) next ### save tau2.del and QE.del values tau2.del[i] <- res$tau2 QE.del[i] <- res$QE ### 'deleted' predicted value for the ith observation based on the model without the ith observation included Xi <- matrix(x$X[i,], nrow=1) delpred[i] <- Xi %*% res$beta vdelpred[i] <- Xi %*% tcrossprod(res$vb,Xi) s2w.del[i] <- res$s2w ### compute DFFITS if (x$weighted) { if (is.null(x$weights)) { dffits[i] <- (pred.full[i] - delpred[i]) / sqrt(res$s2w * hat[i] * (tau2.del[i] + x$vi[i])) } else { dffits[i] <- (pred.full[i] - delpred[i]) / sqrt(res$s2w * diag(H %*% diag(tau2.del[i] + x$vi, nrow=x$k, ncol=x$k) %*% t(H)))[i] } } else { dffits[i] <- (pred.full[i] - delpred[i]) / sqrt(res$s2w * diag(H %*% diag(tau2.del[i] + x$vi, nrow=x$k, ncol=x$k) %*% t(H)))[i] } #dffits[i] <- (pred.full[i] - delpred[i]) / sqrt(vdelpred[i]) ### compute var-cov matrix of the fixed effects for the full model, but with tau2.del[i] plugged in if (x$weighted) { if (is.null(x$weights)) { vb.del <- .invcalc(X=x$X, W=diag(1/(x$vi+tau2.del[i]), nrow=x$k, ncol=x$k), k=x$k) } else { vb.del <- tcrossprod(stXAX,x$X) %*% A %*% diag(x$vi+tau2.del[i], nrow=x$k, ncol=x$k) %*% A %*% x$X %*% stXAX } } else { vb.del <- tcrossprod(stXX,x$X) %*% diag(x$vi+tau2.del[i], nrow=x$k, ncol=x$k) %*% x$X %*% stXX } ### compute DFBETA and DFBETAS dfb <- x$beta - res$beta dfbs[i,] <- dfb / sqrt(res$s2w * diag(vb.del)) #dfbs[i,] <- dfb / sqrt(diag(res$vb)) ### compute DFBETA (including coefficients as specified via btt) dfb <- x$beta[btt] - res$beta[btt] ### compute Cook's distance cook.d[i] <- crossprod(dfb,svb) %*% dfb # / x$p #cook.d[i] <- sum(1/(x$vi+tau2.del[i]) * (pred.full - x$X %*% res$beta)^2) / x$p ### compute covariance ratio cov.r[i] <- det(res$vb[btt,btt,drop=FALSE]) / det(x$vb[btt,btt,drop=FALSE]) } if (progbar) pbapply::closepb(pbar) ### calculate studentized residual resid <- x$yi - delpred resid[abs(resid) < 100 * .Machine$double.eps] <- 0 #resid[abs(resid) < 100 * .Machine$double.eps * median(abs(resid), na.rm=TRUE)] <- 0 ### see lm.influence #seresid <- sqrt(x$vi + vdelpred + tau2.del) seresid <- sqrt(x$vi * s2w.del + vdelpred + tau2.del * s2w.del) ### this yields the same results as a mean shift outlier model when using test="knha" stresid <- resid / seresid ### extract weights options(na.action="na.omit") weight <- weights(x) options(na.action = na.act) ######################################################################### inf <- matrix(NA_real_, nrow=x$k.f, ncol=8) inf[x$not.na,] <- cbind(stresid, dffits, cook.d, cov.r, tau2.del, QE.del, hat, weight) colnames(inf) <- c("rstudent", "dffits", "cook.d", "cov.r", "tau2.del", "QE.del", "hat", "weight") inf <- data.frame(inf) tmp <- dfbs dfbs <- matrix(NA_real_, nrow=x$k.f, ncol=x$p) dfbs[x$not.na,] <- tmp colnames(dfbs) <- rownames(x$beta) dfbs <- data.frame(dfbs) ######################################################################### ### determine "influential" cases is.infl <- #abs(inf$rstudent) > qnorm(.975) | abs(inf$dffits) > 3*sqrt(x$p/(x$k-x$p)) | pchisq(inf$cook.d, df=m) > .50 | #inf$cov.r > 1 + 3*m/(x$k-m) | #inf$cov.r < 1 - 3*m/(x$k-m) | inf$hat > 3*x$p/x$k | apply(abs(dfbs) > 1, 1, any) ### consider using rowAnys() from matrixStats package #print(is.infl) ######################################################################### if (na.act == "na.omit") { out <- list(rstudent=inf$rstudent[x$not.na], dffits=inf$dffits[x$not.na], cook.d=inf$cook.d[x$not.na], cov.r=inf$cov.r[x$not.na], tau2.del=inf$tau2.del[x$not.na], QE.del=inf$QE.del[x$not.na], hat=inf$hat[x$not.na], weight=inf$weight[x$not.na], inf=ifelse(is.infl & !is.na(is.infl), "*", "")[x$not.na], slab=x$slab[x$not.na], digits=digits) out <- list(inf=out) out$dfbs <- lapply(dfbs, function(z) z[x$not.na]) out$dfbs <- c(out$dfbs, list(slab=x$slab[x$not.na], digits=digits)) out <- c(out, list(ids=x$ids[x$not.na], not.na=x$not.na[x$not.na], is.infl=is.infl[x$not.na])) } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(rstudent=inf$rstudent, dffits=inf$dffits, cook.d=inf$cook.d, cov.r=inf$cov.r, tau2.del=inf$tau2.del, QE.del=inf$QE.del, hat=inf$hat, weight=inf$weight, inf=ifelse(is.infl & !is.na(is.infl), "*", ""), slab=x$slab, digits=digits) out <- list(inf=out) out$dfbs <- lapply(dfbs, function(z) z) out$dfbs <- c(out$dfbs, list(slab=x$slab, digits=digits)) out <- c(out, list(ids=x$ids, not.na=x$not.na, is.infl=is.infl)) } out <- c(out, list(tau2=x$tau2, QE=x$QE, k=x$k, p=x$p, m=m, digits=digits)) if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) class(out$inf) <- c("list.rma") class(out$dfbs) <- c("list.rma") class(out) <- c("infl.rma.uni") if (measure == "cooks.distance") { names(out$inf$cook.d) <- out$inf$slab out <- out$inf$cook.d } if (measure == "dfbetas") out <- out$dfbs if (measure == "rstudent") { if (na.act == "na.omit") { resid.f <- c(resid) seresid.f <- c(seresid) stresid.f <- c(stresid) } if (na.act == "na.exclude" || na.act == "na.pass") { resid.f <- rep(NA_real_, x$k.f) seresid.f <- rep(NA_real_, x$k.f) stresid.f <- rep(NA_real_, x$k.f) resid.f[x$not.na] <- c(resid) seresid.f[x$not.na] <- c(seresid) stresid.f[x$not.na] <- c(stresid) } out <- list(resid=resid.f, se=seresid.f, z=stresid.f, slab=out$inf$slab, digits=digits) class(out) <- c("list.rma") } if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } return(out) } metafor/R/regtest.r0000644000176200001440000002005414421561271013754 0ustar liggesusersregtest <- function(x, vi, sei, ni, subset, data, model="rma", predictor="sei", ret.fit=FALSE, digits, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) model <- match.arg(model, c("lm", "rma")) predictor <- match.arg(predictor, c("sei", "vi", "ni", "ninv", "sqrtni", "sqrtninv")) ddd <- list(...) .chkdots(ddd, c("level", "method", "test")) ######################################################################### ### check if data argument has been specified if (missing(data)) data <- NULL if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } mf <- match.call() x <- .getx("x", mf=mf, data=data) ######################################################################### if (inherits(x, "rma")) { .chkclass(class(x), must="rma", notav=c("robust.rma", "rma.glmm", "rma.mv", "rma.ls", "rma.gen", "rma.uni.selmodel")) if (!missing(vi) || !missing(sei) || !missing(subset)) warning(mstyle$warning("Arguments 'vi', 'sei', and 'subset' ignored when 'x' is a model object."), call.=FALSE) yi <- x$yi vi <- x$vi if (missing(ni)) { ni <- x$ni # may be NULL } else { ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) if (!is.null(ni)) { if (length(ni) != x$k.all) stop(mstyle$stop(paste0("Length of variable specified via 'ni' (", length(ni), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) ni <- .getsubset(ni, x$subset) if (inherits(x, "rma.mh") || inherits(x, "rma.peto")) { ni <- ni[x$not.na.yivi] } else { ni <- ni[x$not.na] } } } k <- length(yi) ### set defaults for digits if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } p <- x$p if (inherits(x, "rma.mh") || inherits(x, "rma.peto")) { X <- cbind(rep(1,k)) } else { X <- x$X } if (!is.null(ddd$level)) { level <- .level(ddd$level) } else { level <- x$level } method <- ifelse(is.null(ddd$method), x$method, ddd$method) test <- ifelse(is.null(ddd$test), x$test, ddd$test) weights <- x$weights weighted <- x$weighted tau2 <- ifelse(x$tau2.fix, x$tau2, NA_real_) control <- x$control } else { if (!.is.vector(x)) stop(mstyle$stop("Argument 'x' must be a vector or an 'rma' model object.")) yi <- x ### check if yi is numeric if (!is.numeric(yi)) stop(mstyle$stop("The object/variable specified for the 'x' argument is not numeric.")) ### set defaults for digits if (missing(digits)) { digits <- .set.digits(dmiss=TRUE) } else { digits <- .set.digits(digits, dmiss=FALSE) } if (!is.null(ddd$level)) { level <- .level(ddd$level) } else { level <- .05 } k <- length(yi) vi <- .getx("vi", mf=mf, data=data, checknumeric=TRUE) sei <- .getx("sei", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) subset <- .getx("subset", mf=mf, data=data) if (is.null(vi)) { if (!is.null(sei)) vi <- sei^2 } if (is.null(vi)) stop(mstyle$stop("Must specify 'vi' or 'sei' argument.")) ### check length of yi and vi if (length(vi) != k) stop(mstyle$stop("Length of 'yi' and 'vi' (or 'sei') is not the same.")) ### check length of yi and ni if (!is.null(ni) && length(ni) != k) stop(mstyle$stop("Length of 'yi' and 'ni' is not the same.")) ### check 'vi' argument for potential misuse .chkviarg(mf$vi) ### if ni has not been specified, try to get it from the attributes of yi if (is.null(ni)) ni <- attr(yi, "ni") ### check length of yi and ni (only if ni is not NULL) ### if there is a mismatch, then ni cannot be trusted, so set it to NULL if (!is.null(ni) && length(ni) != k) ni <- NULL ### if ni is now available, add it (back) as an attribute to yi if (!is.null(ni)) attr(yi, "ni") <- ni ### if a subset of studies is specified if (!is.null(subset)) { subset <- .chksubset(subset, k) yi <- .getsubset(yi, subset) vi <- .getsubset(vi, subset) ni <- .getsubset(ni, subset) } ### check for NAs and act accordingly has.na <- is.na(yi) | is.na(vi) | (if (is.null(ni)) FALSE else is.na(ni)) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { yi <- yi[not.na] vi <- vi[not.na] ni <- ni[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "studies", "study"), "with NAs omitted from test.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in data.")) } p <- 1L k <- length(yi) X <- cbind(rep(1,k)) method <- ifelse(is.null(ddd$method), "REML", ddd$method) test <- ifelse(is.null(ddd$test), "z", ddd$test) weights <- NULL weighted <- TRUE tau2 <- NA_real_ control <- list() } ######################################################################### if (predictor == "sei") X <- cbind(X, sei=sqrt(vi)) if (predictor == "vi") X <- cbind(X, vi=vi) if (is.element(predictor, c("ni", "ninv", "sqrtni", "sqrtninv"))) { if (is.null(ni)) { stop(mstyle$stop("No sample size information available to use this predictor.")) } else { if (predictor == "ni") X <- cbind(X, ni=ni) if (predictor == "ninv") X <- cbind(X, ninv=1/ni) if (predictor == "sqrtni") X <- cbind(X, ni=sqrt(ni)) if (predictor == "sqrtninv") X <- cbind(X, ni=1/sqrt(ni)) } } ### check if X of full rank (if not, cannot carry out the test) tmp <- lm(yi ~ X - 1) coef.na <- is.na(coef(tmp)) if (any(coef.na)) stop(mstyle$stop("Model matrix no longer of full rank after addition of predictor. Cannot fit model.")) if (model == "rma") { ddd$level <- NULL ddd$method <- NULL ddd$test <- NULL args <- list(yi=yi, vi=vi, weights=weights, mods=X, intercept=FALSE, method=method, weighted=weighted, test=test, level=level, tau2=tau2, control=control, ddd) fit <- .do.call(rma.uni, args) zval <- fit$zval[p+1] pval <- fit$pval[p+1] ddf <- fit$ddf } else { yi <- c(yi) # remove attributes fit <- lm(yi ~ X - 1, weights=1/vi) tmp <- summary(fit) zval <- coef(tmp)[p+1,3] pval <- coef(tmp)[p+1,4] ddf <- fit$df.residual } ### get the 'limit estimate' if (predictor %in% c("sei", "vi", "ninv", "sqrtninv") && p == 1L && .is.intercept(X[,1])) { if (model=="lm") { est <- coef(tmp)[1,1] ci.lb <- est - qt(level/2, df=ddf, lower.tail=FALSE) * coef(tmp)[1,2] ci.ub <- est + qt(level/2, df=ddf, lower.tail=FALSE) * coef(tmp)[1,2] } else { est <- coef(fit)[1] ci.lb <- fit$ci.lb[1] ci.ub <- fit$ci.ub[1] } } else { est <- ci.lb <- ci.ub <- NULL } res <- list(model=model, predictor=predictor, zval=zval, pval=pval, dfs=ddf, ddf=ddf, method=fit$method, digits=digits, ret.fit=ret.fit, fit=fit, est=est, ci.lb=ci.lb, ci.ub=ci.ub) class(res) <- "regtest" return(res) } metafor/R/rstandard.rma.mv.r0000644000176200001440000001201514441014603015450 0ustar liggesusersrstandard.rma.mv <- function(model, digits, cluster, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(model), must="rma.mv", notav="robust.rma") na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) x <- model if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } misscluster <- ifelse(missing(cluster), TRUE, FALSE) if (misscluster) { cluster <- seq_len(x$k.all) } else { mf <- match.call() cluster <- .getx("cluster", mf=mf, data=x$data) } ######################################################################### ### process cluster variable # note: cluster variable is assumed to be of the same length as the size of # the original dataset passed to the model fitting function and so we apply # the same subsetting and removing of missings (if necessary) as was done # during model fitting if (length(cluster) != x$k.all) stop(mstyle$stop(paste0("Length of variable specified via 'cluster' (", length(cluster), ") does not match length of data (", x$k.all, ")."))) cluster <- .getsubset(cluster, x$subset) cluster.f <- cluster cluster <- cluster[x$not.na] ### checks on cluster variable if (anyNA(cluster.f)) stop(mstyle$stop("No missing values allowed in 'cluster' variable.")) if (length(cluster.f) == 0L) stop(mstyle$stop(paste0("Cannot find 'cluster' variable (or it has zero length)."))) ######################################################################### options(na.action="na.omit") H <- hatvalues(x, type="matrix") options(na.action = na.act) ######################################################################### ImH <- diag(x$k) - H #ei <- ImH %*% cbind(x$yi) ei <- c(x$yi - x$X %*% x$beta) ei[abs(ei) < 100 * .Machine$double.eps] <- 0 #ei[abs(ei) < 100 * .Machine$double.eps * median(abs(ei), na.rm=TRUE)] <- 0 ### see lm.influence ### don't allow this; the SEs of the residuals cannot be estimated consistently for "robust.rma" objects #if (inherits(x, "robust.rma")) { # ve <- ImH %*% tcrossprod(x$meat,ImH) #} else { # ve <- ImH %*% tcrossprod(x$M,ImH) #} ve <- ImH %*% tcrossprod(x$M,ImH) #ve <- x$M + x$X %*% x$vb %*% t(x$X) - 2*H%*%x$M sei <- sqrt(diag(ve)) ######################################################################### if (!misscluster) { ### cluster ids and number of clusters ids <- unique(cluster) n <- length(ids) X2 <- rep(NA_real_, n) k.id <- rep(NA_integer_, n) for (i in seq_len(n)) { incl <- cluster %in% ids[i] k.id[i] <- sum(incl) vei <- as.matrix(ve[incl,incl,drop=FALSE]) if (!.chkpd(crossprod(vei))) next sve <- try(chol2inv(chol(vei)), silent=TRUE) #sve <- try(solve(ve[incl,incl,drop=FALSE]), silent=TRUE) if (inherits(sve, "try-error")) next X2[i] <- rbind(ei[incl]) %*% sve %*% cbind(ei[incl]) } } ######################################################################### resid <- rep(NA_real_, x$k.f) seresid <- rep(NA_real_, x$k.f) stresid <- rep(NA_real_, x$k.f) resid[x$not.na] <- ei seresid[x$not.na] <- sei stresid[x$not.na] <- ei / sei ######################################################################### if (na.act == "na.omit") { out <- list(resid=resid[x$not.na], se=seresid[x$not.na], z=stresid[x$not.na]) if (!misscluster) out$cluster <- cluster.f[x$not.na] out$slab <- x$slab[x$not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(resid=resid, se=seresid, z=stresid) if (!misscluster) out$cluster <- cluster.f out$slab <- x$slab } if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) if (misscluster) { out$digits <- digits class(out) <- "list.rma" return(out) } else { out <- list(out) if (na.act == "na.omit") { out[[2]] <- list(X2=X2[order(ids)], k=k.id[order(ids)], slab=ids[order(ids)]) } if (na.act == "na.exclude" || na.act == "na.pass") { ids.f <- unique(cluster.f) X2.f <- rep(NA_real_, length(ids.f)) X2.f[match(ids, ids.f)] <- X2 k.id.f <- sapply(ids.f, function(id) sum((id == cluster.f) & x$not.na)) out[[2]] <- list(X2=X2.f[order(ids.f)], k=k.id.f[order(ids.f)], slab=ids.f[order(ids.f)]) } out[[1]]$digits <- digits out[[2]]$digits <- digits names(out) <- c("obs", "cluster") class(out[[1]]) <- "list.rma" class(out[[2]]) <- "list.rma" attr(out[[1]], ".rmspace") <- TRUE attr(out[[2]], ".rmspace") <- TRUE return(out) } } metafor/R/qqnorm.rma.mh.r0000644000176200001440000000471514465412602015004 0ustar liggesusersqqnorm.rma.mh <- function(y, type="rstandard", pch=21, col, bg, label=FALSE, offset=0.3, pos=13, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(y), must="rma.mh") x <- y type <- match.arg(type, c("rstandard", "rstudent")) if (x$k == 1) stop(mstyle$stop("Stopped because k = 1.")) if (length(label) != 1L) stop(mstyle$stop("Argument 'label' should be of length 1.")) .start.plot() if (missing(col)) col <- par("fg") if (missing(bg)) bg <- .coladj(par("bg","fg"), dark=0.35, light=-0.35) ######################################################################### if (type == "rstandard") { res <- rstandard(x) not.na <- !is.na(res$z) zi <- res$z[not.na] slab <- res$slab[not.na] ord <- order(zi) slab <- slab[ord] } else { res <- rstudent(x) not.na <- !is.na(res$z) zi <- res$z[not.na] slab <- res$slab[not.na] ord <- order(zi) slab <- slab[ord] } sav <- qqnorm(zi, pch=pch, col=col, bg=bg, bty="l", ...) abline(a=0, b=1, lty="solid", ...) #qqline(zi, ...) #abline(h=0, lty="dotted", ...) #abline(v=0, lty="dotted", ...) points(sav$x, sav$y, pch=pch, col=col, bg=bg, ...) ######################################################################### ### labeling of points if ((is.character(label) && label=="none") || .isFALSE(label)) return(invisible(sav)) if ((is.character(label) && label=="all") || .isTRUE(label)) label <- x$k if (is.numeric(label)) { label <- round(label) if (label < 1 | label > x$k) stop(mstyle$stop("Out of range value for 'label' argument.")) pos.x <- sav$x[ord] pos.y <- sav$y[ord] dev <- abs(pos.x - pos.y) for (i in seq_len(x$k)) { if (sum(dev > dev[i]) < label) { if (pos <= 4) text(pos.x[i], pos.y[i], slab[i], pos=pos, offset=offset, ...) if (pos == 13) text(pos.x[i], pos.y[i], slab[i], pos=ifelse(pos.x[i]-pos.y[i] >= 0, 1, 3), offset=offset, ...) if (pos == 24) text(pos.x[i], pos.y[i], slab[i], pos=ifelse(pos.x[i]-pos.y[i] <= 0, 2, 4), offset=offset, ...) #text(pos.x[i], pos.y[i], slab[i], pos=ifelse(pos.x[i] >= 0, 2, 4), offset=offset, ...) } } } ######################################################################### invisible(sav) } metafor/R/misc.func.hidden.fsn.r0000644000176200001440000001064014477366360016220 0ustar liggesusers############################################################################ .fsn.fisher <- function(fsnum, pi, alpha) { k <- length(pi) X2 <- -2*sum(log(c(pi, rep(0.5, fsnum)))) return(pchisq(X2, df=2*(k+fsnum), lower.tail=FALSE) - alpha) } ############################################################################ .fsn.scale <- function(x, k) { if (k == 0) return(x) if (k == 1) return(0) if (k >= 2) return((x-mean(x))/sd(x)) } .fsn.gen <- function(fsnum, yi, vi, vt, est, tau2, tau2fix, test, weighted, target, alpha, exact, method, mumiss, upperint, maxint, verbose=FALSE, newest=FALSE) { fsnum <- floor(fsnum) if (fsnum > maxint) fsnum <- maxint yinew <- c(yi, .fsn.scale(rnorm(fsnum), fsnum)*sqrt(vt+tau2) + mumiss) vinew <- c(vi, rep(vt,fsnum)) if (is.null(target)) { if (exact && fsnum <= 5000) { tmp <- suppressWarnings(try(rma(yinew, vinew, method=method, tau2=tau2fix, test=test, weighted=weighted), silent=TRUE)) if (inherits(tmp, "try-error")) stop() est.fsn <- tmp$beta[1] tau2.fsn <- tmp$tau2 pval.fsn <- tmp$pval if (mumiss != 0 && sign(est.fsn) == sign(mumiss)) pval.fsn <- 1 } else { k <- length(yi) if (is.element(method, c("FE","EE","CE"))) { tau2.fsn <- 0 } else { est.fsn <- (k*est + fsnum*mumiss) / (k + fsnum) if (is.null(tau2fix)) { tau2.fsn <- max(0, ((k-1)*tau2 + max(0,(fsnum-1))*tau2 + k*(est-est.fsn)^2 + fsnum*(mumiss-est.fsn)^2) / (k + fsnum - 1)) } else { tau2.fsn <- tau2 } } if (isTRUE(weighted)) { est.fsn <- weighted.mean(yinew, 1 / (vinew + tau2.fsn)) zval.new <- est.fsn / sqrt(1 / (sum(1 / (vi + tau2.fsn)) + fsnum / (vt + tau2.fsn))) } else { est.fsn <- mean(yinew) zval.new <- (k + fsnum) * est.fsn / sqrt(sum(vi + tau2.fsn) + fsnum * (vt + tau2.fsn)) } pval.fsn <- 2*pnorm(abs(zval.new), lower.tail=FALSE) if (mumiss != 0 && sign(est.fsn * mumiss) == 1) pval.fsn <- 1 } if (newest) { return(list(est.fsn=est.fsn, tau2.fsn=tau2.fsn, pval.fsn=pval.fsn)) } else { if (fsnum == maxint) { diff <- 0 } else { diff <- pval.fsn - alpha } } if (verbose) cat("fsnum =", formatC(fsnum, width=nchar(upperint)+1, format="d"), " est =", fmtx(est.fsn, flag=" "), " tau2 =", fmtx(tau2.fsn), " pval =", fmtx(pval.fsn), " alpha =", fmtx(alpha), " diff =", fmtx(diff, flag=" "), "\n") } else { if (exact && fsnum <= 5000) { tmp <- suppressWarnings(try(rma(yinew, vinew, method=method, tau2=tau2fix, test=test, weighted=weighted), silent=TRUE)) if (inherits(tmp, "try-error")) stop() est.fsn <- tmp$beta[1] tau2.fsn <- tmp$tau2 pval.fsn <- tmp$pval } else { k <- length(yi) if (is.element(method, c("FE","EE","CE"))) { tau2.fsn <- 0 } else { est.fsn <- (k*est + fsnum*mumiss) / (k + fsnum) if (is.null(tau2fix)) { tau2.fsn <- ((k-1)*tau2 + max(0,(fsnum-1))*tau2 + k*(est-est.fsn)^2 + fsnum*(mumiss-est.fsn)^2) / (k + fsnum - 1) } else { tau2.fsn <- tau2 } } if (isTRUE(weighted)) { est.fsn <- weighted.mean(yinew, 1 / (vinew + tau2.fsn)) zval.new <- est.fsn / sqrt(1 / (sum(1 / (vi + tau2.fsn)) + fsnum / (vt + tau2.fsn))) } else { est.fsn <- mean(yinew) zval.new <- (k + fsnum) * est.fsn / sqrt(sum(vi + tau2.fsn) + fsnum * (vt + tau2.fsn)) } pval.fsn <- 2*pnorm(abs(zval.new), lower.tail=FALSE) } if (newest) { return(list(est.fsn=est.fsn, tau2.fsn=tau2.fsn, pval.fsn=pval.fsn)) } else { if (fsnum == maxint) { diff <- 0 } else { diff <- est.fsn - target } } if (verbose) cat("fsnum =", formatC(fsnum, width=nchar(upperint)+1, format="d"), " est =", fmtx(est.fsn, flag=" "), " tau2 =", fmtx(tau2.fsn), " target =", fmtx(target), " diff =", fmtx(diff, flag=" "), "\n") } return(diff) } ############################################################################ metafor/R/plot.permutest.rma.uni.r0000644000176200001440000003701314466223705016665 0ustar liggesusersplot.permutest.rma.uni <- function(x, beta, alpha, QM=FALSE, QS=FALSE, breaks="Scott", freq=FALSE, col, border, col.out, col.ref, col.density, trim=0, adjust=1, lwd=c(2,0,0,4), layout, legend=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="permutest.rma.uni") .start.plot() if (missing(col)) col <- .coladj(par("bg","fg"), dark=0.3, light=-0.3) if (missing(border)) border <- .coladj(par("bg"), dark=0.1, light=-0.1) if (missing(col.out)) col.out <- rgb(1,0,0,0.5) if (missing(col.ref)) col.ref <- .coladj(par("fg"), dark=-0.3, light=0.3) if (missing(col.density)) col.density <- ifelse(.is.dark(), "dodgerblue", "blue") ddd <- list(...) if (is.null(ddd$alternative)) { alternative <- x$alternative } else { alternative <- match.arg(ddd$alternative, c("two.sided", "less", "greater")) } if (is.null(ddd$p2defn)) { p2defn <- x$p2defn } else { p2defn <- match.arg(ddd$p2defn, c("abs", "px2")) } if (is.null(ddd$stat)) { stat <- x$stat } else { stat <- match.arg(ddd$stat, c("test", "coef")) } ### check trim if (trim >= 0.5) stop(mstyle$stop("The value of 'trim' must be < 0.5.")) # 1st: obs stat, 2nd: ref dist, 3rd: density, 4th: refline if (length(lwd) == 1L) lwd <- c(lwd[c(1,1,1)], 4) if (length(lwd) == 2L) lwd <- c(lwd[c(1,2,2)], 4) if (length(lwd) == 3L) lwd <- c(lwd[c(1,2,2,3)]) # cannot plot ref dist and density when freq=TRUE if (freq) lwd[c(2,3)] <- 0 lhist <- function(..., alternative, p2defn, stat) hist(...) labline <- function(..., alternative, p2defn, stat) abline(...) llines <- function(..., alternative, p2defn, stat) lines(...) ############################################################################ if (x$skip.beta) { beta <- NULL } else { if (missing(beta)) { if (x$int.only) { beta <- 1 } else { if (x$int.incl) { beta <- 2:x$p } else { beta <- 1:x$p } } } else { if (all(is.na(beta))) { # set beta=NA to not plot any location coefficients beta <- NULL } else { beta <- .set.btt(beta, x$p, x$int.incl, names(x$zval.perm)) } } } if (stat == "test") { perm1 <- x$zval.perm[beta] obs1 <- x$zval[beta] } else { perm1 <- x$beta.perm[beta] obs1 <- x$beta[beta,1] } if (x$int.only || x$skip.beta) { QM.perm <- NULL } else { if (QM) { QM.perm <- x$QM.perm } else { QM.perm <- NULL } } if (inherits(x, "permutest.rma.ls") && !x$skip.alpha) { if (missing(alpha)) { if (x$Z.int.only) { alpha <- 1 } else { if (x$int.incl) { alpha <- 2:x$q } else { alpha <- 1:x$q } } } else { if (all(is.na(alpha))) { # set alpha=NA to not plot any scale coefficients alpha <- NULL } else { alpha <- .set.btt(alpha, x$q, x$Z.int.incl, names(x$zval.perm.alpha)) } } if (stat == "test") { perm2 <- x$zval.alpha.perm[alpha] obs2 <- x$zval.alpha[alpha] } else { perm2 <- x$alpha.perm[alpha] obs2 <- x$alpha[alpha,1] } if (QS) { QS.perm <- x$QS.perm } else { QS.perm <- NULL } } else { alpha <- NULL QS.perm <- NULL } ############################################################################ ### function to add legend addlegend <- function(legend) { if (is.logical(legend) && isTRUE(legend)) lpos <- "topright" if (is.character(legend)) { lpos <- legend legend <- TRUE } if (legend && any(lwd[2:3] > 0)) { ltxt <- c("Kernel Density Estimate of\nthe Permutation Distribution", "Theoretical Null Distribution") lwds <- lwd[2:3] lcols <- c(col.density, col.ref) ltys <- c("solid", "solid") #pchs <- c("","","\u2506") # \u250a ltxt <- ltxt[lwds > 0] lcols <- lcols[lwds > 0] ltys <- ltys[lwds > 0] #pchs <- pchs[lwds > 0] lwds <- lwds[lwds > 0] legend(lpos, inset=.01, bg=par("bg"), lwd=lwds, col=lcols, lty=ltys, legend=ltxt) } return(FALSE) } ############################################################################ # number of plots np <- length(beta) + length(alpha) + ifelse(is.null(QM.perm), 0L, 1L) + ifelse(is.null(QS.perm), 0L, 1L) if (np == 0L) stop(mstyle$stop("Must select at least one elements to plot.")) # set/check layout argument if (missing(layout)) { layout <- n2mfrow(np) } else { layout <- layout[layout >= 1] layout <- round(layout) if (length(layout) != 2L) stop(mstyle$stop("Incorrect specification of 'layout' argument.")) } #print(list(np, layout)) ############################################################################ par.mfrow <- par("mfrow") par(mfrow=layout) on.exit(par(mfrow = par.mfrow), add=TRUE) if (!is.null(QM.perm)) { pdist <- QM.perm if (is.na(x$ddf)) { xs <- seq(0, max(qchisq(.995, df=length(x$btt)), max(pdist, na.rm=TRUE)), length=1000) ys <- dchisq(xs, df=length(x$btt)) } else { xs <- seq(0, max(qf(.995, df1=length(x$btt), df2=x$ddf), max(pdist, na.rm=TRUE)), length=1000) ys <- df(xs, df1=length(x$btt), df2=x$ddf) } den <- density(pdist, adjust=adjust, na.rm=TRUE, n=8192) if (trim > 0) { bound <- quantile(pdist, probs=1-trim, na.rm=TRUE) pdist <- pdist[pdist <= bound] } if (lwd[2] == 0 && lwd[3] == 0) { tmp <- lhist(pdist, breaks=breaks, col=col, border=border, main=ifelse(inherits(x, "permutest.rma.ls"), "Omnibus Test of Location Coefficients", "Omnibus Test of Coefficients"), xlab="Value of Test Statistic", freq=freq, ...) } else { tmp <- lhist(pdist, breaks=breaks, plot=FALSE) ylim <- c(0, max(ifelse(lwd[2] == 0, 0, max(ys)), ifelse(lwd[3] == 0, 0, max(den$y)), max(tmp$density))) tmp <- lhist(pdist, breaks=breaks, col=col, border=border, main=ifelse(inherits(x, "permutest.rma.ls"), "Omnibus Test of Location Coefficients", "Omnibus Test of Coefficients"), xlab="Value of Test Statistic", freq=freq, ylim=ylim, ...) } .coltail(tmp, val=x$QM, tail="upper", col=col.out, border=border, freq=freq, ...) if (lwd[1] > 0) labline(v=x$QM, lwd=lwd[1], lty="dashed", ...) if (lwd[2] > 0) llines(xs, ys, lwd=lwd[2], col=col.ref, ...) if (lwd[3] > 0) llines(den, lwd=lwd[3], col=col.density, ...) legend <- addlegend(legend) } for (i in seq_len(ncol(perm1))) { pdist <- perm1[[i]] if (is.na(x$ddf)) { xs <- seq(min(-qnorm(.995), min(pdist, na.rm=TRUE)), max(qnorm(.995), max(pdist, na.rm=TRUE)), length=1000) ys <- dnorm(xs) } else { xs <- seq(min(-qt(.995, df=x$ddf), min(pdist, na.rm=TRUE)), max(qt(.995, df=x$ddf), max(pdist, na.rm=TRUE)), length=1000) ys <- dt(xs, df=x$ddf) } den <- density(pdist, adjust=adjust, na.rm=TRUE, n=8192) if (trim > 0) { bounds <- quantile(pdist, probs=c(trim/2, 1-trim/2), na.rm=TRUE) pdist <- pdist[pdist >= bounds[1] & pdist <= bounds[2]] } if (lwd[2] == 0 && lwd[3] == 0) { tmp <- lhist(pdist, breaks=breaks, col=col, border=border, main=ifelse(x$int.only, "", paste0(ifelse(inherits(x, "permutest.rma.ls"), "Location Coefficient: ", "Coefficient: "), names(perm1)[i])), xlab=ifelse(stat == "test", "Value of Test Statistic", "Value of Coefficient"), freq=freq, ...) } else { tmp <- lhist(pdist, breaks=breaks, plot=FALSE) ylim <- c(0, max(ifelse(lwd[2] == 0, 0, max(ys)), ifelse(lwd[3] == 0, 0, max(den$y)), max(tmp$density))) tmp <- lhist(pdist, breaks=breaks, col=col, border=border, main=ifelse(x$int.only, "", paste0(ifelse(inherits(x, "permutest.rma.ls"), "Location Coefficient: ", "Coefficient: "), names(perm1)[i])), xlab=ifelse(stat == "test", "Value of Test Statistic", "Value of Coefficient"), freq=freq, ylim=ylim, ...) } if (alternative == "two.sided") { if (p2defn == "abs") { .coltail(tmp, val=-abs(obs1[i]), tail="lower", col=col.out, border=border, freq=freq, ...) .coltail(tmp, val= abs(obs1[i]), tail="upper", col=col.out, border=border, freq=freq, ...) if (lwd[1] > 0) labline(v=c(-obs1[i],obs1[i]), lwd=lwd[1], lty="dashed", ...) } else { if (obs1[i] > median(pdist, na.rm=TRUE)) { .coltail(tmp, val= abs(obs1[i]), tail="upper", mult=2, col=col.out, border=border, freq=freq, ...) if (lwd[1] > 0) labline(v=obs1[i], lwd=lwd[1], lty="dashed", ...) } else { .coltail(tmp, val=-abs(obs1[i]), tail="lower", mult=2, col=col.out, border=border, freq=freq, ...) if (lwd[1] > 0) labline(v=-abs(obs1[i]), lwd=lwd[1], lty="dashed", ...) } } } if (alternative == "less") { .coltail(tmp, val=obs1[i], tail="lower", col=col.out, border=border, freq=freq, ...) if (lwd[1] > 0) labline(v=obs1[i], lwd=lwd[1], lty="dashed", ...) } if (alternative == "greater") { .coltail(tmp, val=obs1[i], tail="upper", col=col.out, border=border, freq=freq, ...) if (lwd[1] > 0) labline(v=obs1[i], lwd=lwd[1], lty="dashed", ...) } if (lwd[2] > 0) llines(xs, ys, lwd=lwd[2], col=col.ref, ...) if (lwd[3] > 0) llines(den, lwd=lwd[3], col=col.density, ...) if (lwd[4] > 0) labline(v=0, lwd=lwd[4], ...) legend <- addlegend(legend) } if (inherits(x, "permutest.rma.ls")) { if (!is.null(QS.perm)) { pdist <- QS.perm if (is.na(x$ddf.alpha)) { xs <- seq(0, max(qchisq(.995, df=length(x$att)), max(pdist, na.rm=TRUE)), length=1000) ys <- dchisq(xs, df=length(x$att)) } else { xs <- seq(0, max(qf(.995, df1=length(x$att), df2=x$ddf.alpha), max(pdist, na.rm=TRUE)), length=1000) ys <- df(xs, df1=length(x$att), df2=x$ddf.alpha) } den <- density(pdist, adjust=adjust, na.rm=TRUE, n=8192) if (trim > 0) { bound <- quantile(pdist, probs=1-trim, na.rm=TRUE) pdist <- pdist[pdist <= bound] } if (lwd[2] == 0 && lwd[3] == 0) { tmp <- lhist(pdist, breaks=breaks, col=col, border=border, main="Omnibus Test of Scale Coefficients", xlab="Value of Test Statistic", freq=freq, ...) } else { tmp <- lhist(pdist, breaks=breaks, plot=FALSE) ylim <- c(0, max(ifelse(lwd[2] == 0, 0, max(ys)), ifelse(lwd[3] == 0, 0, max(den$y)), max(tmp$density))) tmp <- lhist(pdist, breaks=breaks, col=col, border=border, main="Omnibus Test of Scale Coefficients", xlab="Value of Test Statistic", freq=freq, ylim=ylim, ...) } .coltail(tmp, val=x$QS, tail="upper", col=col.out, border=border, freq=freq, ...) if (lwd[1] > 0) labline(v=x$QS, lwd=lwd[1], lty="dashed", ...) if (lwd[2] > 0) llines(xs, ys, lwd=lwd[2], col=col.ref, ...) if (lwd[3] > 0) llines(den, lwd=lwd[3], col=col.density, ...) legend <- addlegend(legend) } for (i in seq_len(ncol(perm2))) { pdist <- perm2[[i]] if (is.na(x$ddf.alpha)) { xs <- seq(min(-qnorm(.995), min(pdist, na.rm=TRUE)), max(qnorm(.995), max(pdist, na.rm=TRUE)), length=1000) ys <- dnorm(xs) } else { xs <- seq(min(-qt(.995, df=x$ddf.alpha), min(pdist, na.rm=TRUE)), max(qt(.995, df=x$ddf.alpha), max(pdist, na.rm=TRUE)), length=1000) ys <- dt(xs, df=x$ddf.alpha) } den <- density(pdist, adjust=adjust, na.rm=TRUE, n=8192) if (trim > 0) { bounds <- quantile(pdist, probs=c(trim/2, 1-trim/2), na.rm=TRUE) pdist <- pdist[pdist >= bounds[1] & pdist <= bounds[2]] } if (lwd[2] == 0 && lwd[3] == 0) { tmp <- lhist(pdist, breaks=breaks, col=col, border=border, main=ifelse(x$Z.int.only, "", paste0("Scale Coefficient: ", names(perm2)[i])), xlab=ifelse(stat == "test", "Value of Test Statistic", "Value of Coefficient"), freq=freq, ...) } else { tmp <- lhist(pdist, breaks=breaks, plot=FALSE) ylim <- c(0, max(ifelse(lwd[2] == 0, 0, max(ys)), ifelse(lwd[3] == 0, 0, max(den$y)), max(tmp$density))) tmp <- lhist(pdist, breaks=breaks, col=col, border=border, main=ifelse(x$Z.int.only, "", paste0("Scale Coefficient: ", names(perm2)[i])), xlab=ifelse(stat == "test", "Value of Test Statistic", "Value of Coefficient"), freq=freq, ylim=ylim, ...) } if (alternative == "two.sided") { if (p2defn == "abs") { .coltail(tmp, val=-abs(obs2[i]), tail="lower", col=col.out, border=border, freq=freq, ...) .coltail(tmp, val= abs(obs2[i]), tail="upper", col=col.out, border=border, freq=freq, ...) if (lwd[1] > 0) labline(v=c(-obs2[i],obs2[i]), lwd=lwd[1], lty="dashed", ...) } else { if (obs2[i] > median(pdist, na.rm=TRUE)) { .coltail(tmp, val= abs(obs2[i]), tail="upper", mult=2, col=col.out, border=border, freq=freq, ...) if (lwd[1] > 0) labline(v=obs2[i], lwd=lwd[1], lty="dashed", ...) } else { .coltail(tmp, val=-abs(obs2[i]), tail="lower", mult=2, col=col.out, border=border, freq=freq, ...) if (lwd[1] > 0) labline(v=-abs(obs2[i]), lwd=lwd[1], lty="dashed", ...) } } } if (alternative == "less") { .coltail(tmp, val=obs2[i], tail="lower", col=col.out, border=border, freq=freq, ...) if (lwd[1] > 0) labline(v=obs2[i], lwd=lwd[1], lty="dashed", ...) } if (alternative == "greater") { .coltail(tmp, val=obs2[i], tail="upper", col=col.out, border=border, freq=freq, ...) if (lwd[1] > 0) labline(v=obs2[i], lwd=lwd[1], lty="dashed", ...) } if (lwd[2] > 0) llines(xs, ys, lwd=lwd[2], col=col.ref, ...) if (lwd[3] > 0) llines(den, lwd=lwd[3], col=col.density, ...) if (lwd[4] > 0) labline(v=0, lwd=lwd[4], ...) legend <- addlegend(legend) } } ############################################################################ invisible() } metafor/R/misc.func.hidden.selmodel.r0000644000176200001440000002332014430730740017217 0ustar liggesusers############################################################################ .selmodel.pval <- function(yi, vi, alternative) { zi <- yi / sqrt(vi) if (alternative == "two.sided") { pval <- 2 * pnorm(abs(zi), lower.tail=FALSE) } else { pval <- pnorm(zi, lower.tail=alternative=="less") } return(pval) } .selmodel.verbose <- function(ll, beta, tau2, delta, mstyle, digits) { cat(mstyle$verbose(paste0("ll = ", fmtx(ll, digits[["fit"]], flag=" "), " "))) cat(mstyle$verbose(paste0("beta =", paste(fmtx(beta, digits[["est"]], flag=" "), collapse=" "), " "))) cat(mstyle$verbose(paste0("tau2 =", fmtx(tau2, digits[["var"]], flag=" "), " "))) cat(mstyle$verbose(paste0("delta =", paste(fmtx(delta, digits[["est"]], flag=" "), collapse=" ")))) cat("\n") } .mapfun <- function(x, lb, ub, fun=NA) { if (is.na(fun)) { lb + (ub-lb) / (1 + exp(-x)) # map (-inf,inf) to (lb,ub) } else { x <- sapply(x, fun) pmin(pmax(x, lb), ub) } } .mapinvfun <- function(x, lb, ub, fun=NA) { if (is.na(fun)) { log((x-lb)/(ub-x)) } else { sapply(x, fun) } } ############################################################################ .selmodel.int <- function(yvals, yi, vi, preci, yhat, wi.fun, delta, tau2, alternative, pval.min, steps) { pval <- .selmodel.pval(yvals, vi, alternative) pval[pval < pval.min] <- pval.min pval[pval > (1-pval.min)] <- 1-pval.min wi.fun(pval, delta, yi, vi, preci, alternative, steps) * dnorm(yvals, yhat, sqrt(vi+tau2)) } .selmodel.ll.cont <- function(par, yi, vi, X, preci, k, pX, pvals, deltas, delta.val, delta.transf, mapfun, delta.min, delta.max, tau2.val, tau2.transf, tau2.max, beta.val, wi.fun, steps, pgrp, alternative, pval.min, intCtrl, verbose, digits, dofit=FALSE) { mstyle <- .get.mstyle("crayon" %in% .packages()) beta <- par[1:pX] tau2 <- par[pX+1] delta <- par[(pX+2):(pX+1+deltas)] beta <- ifelse(is.na(beta.val), beta, beta.val) if (tau2.transf) tau2 <- exp(tau2) tau2[!is.na(tau2.val)] <- tau2.val tau2[tau2 < .Machine$double.eps*10] <- 0 tau2[tau2 > tau2.max] <- tau2.max if (delta.transf) delta <- mapply(.mapfun, delta, delta.min, delta.max, mapfun) delta <- ifelse(is.na(delta.val), delta, delta.val) yhat <- c(X %*% beta) Ai <- rep(NA_real_, k) for (i in seq_len(k)) { tmp <- try(integrate(.selmodel.int, lower=intCtrl$lower, upper=intCtrl$upper, yi=yi[i], vi=vi[i], preci=preci[i], yhat=yhat[i], wi.fun=wi.fun, delta=delta, tau2=tau2, alternative=alternative, pval.min=pval.min, steps=steps, subdivisions=intCtrl$subdivisions, rel.tol=intCtrl$rel.tol)$value, silent=TRUE) if (inherits(tmp, "try-error")) stop(mstyle$stop(paste0("Could not integrate over density in study ", i, ".")), call.=FALSE) Ai[i] <- tmp } llval <- sum(log(wi.fun(pvals, delta, yi, vi, preci, alternative, steps)) + dnorm(yi, yhat, sqrt(vi+tau2), log=TRUE) - log(Ai)) if (dofit) { res <- list(ll=llval, beta=beta, tau2=tau2, delta=delta) return(res) } if (verbose) .selmodel.verbose(ll=llval, beta=beta, tau2=tau2, delta=delta, mstyle=mstyle, digits=digits) if (verbose > 2) { xs <- seq(pval.min, 1-pval.min, length=1001) ys <- wi.fun(xs, delta, yi, vi, preci=1, alternative, steps) plot(xs, ys, type="l", lwd=2, xlab="p-value", ylab="Relative Likelihood of Selection") } return(-1*llval) } ############################################################################ .selmodel.ll.stepfun <- function(par, yi, vi, X, preci, k, pX, pvals, deltas, delta.val, delta.transf, mapfun, delta.min, delta.max, tau2.val, tau2.transf, tau2.max, beta.val, wi.fun, steps, pgrp, alternative, pval.min, intCtrl, verbose, digits, dofit=FALSE) { mstyle <- .get.mstyle("crayon" %in% .packages()) beta <- par[1:pX] tau2 <- par[pX+1] delta <- par[(pX+2):(pX+1+deltas)] beta <- ifelse(is.na(beta.val), beta, beta.val) if (tau2.transf) tau2 <- exp(tau2) tau2[!is.na(tau2.val)] <- tau2.val tau2[tau2 < .Machine$double.eps*10] <- 0 tau2[tau2 > tau2.max] <- tau2.max if (delta.transf) delta <- mapply(.mapfun, delta, delta.min, delta.max, mapfun) delta <- ifelse(is.na(delta.val), delta, delta.val) yhat <- c(X %*% beta) sei <- sqrt(vi+tau2) N <- length(steps) Ai <- rep(NA_real_, k) if (alternative == "greater") { for (i in seq_len(k)) { Ai[i] <- pnorm(qnorm(steps[1], 0, sqrt(vi[i]), lower.tail=FALSE), yhat[i], sei[i], lower.tail=FALSE) for (j in 2:N) { if (j < N) { Ai[i] <- Ai[i] + delta[j] / preci[i] * (pnorm(qnorm(steps[j], 0, sqrt(vi[i]), lower.tail=FALSE), yhat[i], sei[i], lower.tail=FALSE) - pnorm(qnorm(steps[j-1], 0, sqrt(vi[i]), lower.tail=FALSE), yhat[i], sei[i], lower.tail=FALSE)) } else { Ai[i] <- Ai[i] + delta[j] / preci[i] * pnorm(qnorm(steps[j-1], 0, sqrt(vi[i]), lower.tail=FALSE), yhat[i], sei[i], lower.tail=TRUE) } } } } if (alternative == "less") { for (i in seq_len(k)) { Ai[i] <- pnorm(qnorm(steps[1], 0, sqrt(vi[i]), lower.tail=TRUE), yhat[i], sei[i], lower.tail=TRUE) for (j in 2:N) { if (j < N) { Ai[i] <- Ai[i] + delta[j] / preci[i] * (pnorm(qnorm(steps[j], 0, sqrt(vi[i]), lower.tail=TRUE), yhat[i], sei[i], lower.tail=TRUE) - pnorm(qnorm(steps[j-1], 0, sqrt(vi[i]), lower.tail=TRUE), yhat[i], sei[i], lower.tail=TRUE)) } else { Ai[i] <- Ai[i] + delta[j] / preci[i] * pnorm(qnorm(steps[j-1], 0, sqrt(vi[i]), lower.tail=TRUE), yhat[i], sei[i], lower.tail=FALSE) } } } } if (alternative == "two.sided") { for (i in seq_len(k)) { Ai[i] <- pnorm(qnorm(steps[1]/2, 0, sqrt(vi[i]), lower.tail=FALSE), yhat[i], sei[i], lower.tail=FALSE) + pnorm(qnorm(steps[1]/2, 0, sqrt(vi[i]), lower.tail=TRUE), yhat[i], sei[i], lower.tail=TRUE) for (j in 2:N) { if (j < N) { Ai[i] <- Ai[i] + delta[j] / preci[i] * ((pnorm(qnorm(steps[j]/2, 0, sqrt(vi[i]), lower.tail=FALSE), yhat[i], sei[i], lower.tail=FALSE) - pnorm(qnorm(steps[j-1]/2, 0, sqrt(vi[i]), lower.tail=FALSE), yhat[i], sei[i], lower.tail=FALSE)) + (pnorm(qnorm(steps[j]/2, 0, sqrt(vi[i]), lower.tail=TRUE), yhat[i], sei[i], lower.tail=TRUE) - pnorm(qnorm(steps[j-1]/2, 0, sqrt(vi[i]), lower.tail=TRUE), yhat[i], sei[i], lower.tail=TRUE))) } else { Ai[i] <- Ai[i] + delta[j] / preci[i] * (pnorm(qnorm(steps[j-1]/2, 0, sqrt(vi[i]), lower.tail=FALSE), yhat[i], sei[i], lower.tail=TRUE) - pnorm(qnorm(steps[j-1]/2, 0, sqrt(vi[i]), lower.tail=TRUE), yhat[i], sei[i], lower.tail=TRUE)) } } } } llval <- sum(log(delta[pgrp] / preci) + dnorm(yi, yhat, sei, log=TRUE) - log(Ai)) if (dofit) { res <- list(ll=llval, beta=beta, tau2=tau2, delta=delta) return(res) } if (verbose) .selmodel.verbose(ll=llval, beta=beta, tau2=tau2, delta=delta, mstyle=mstyle, digits=digits) if (verbose > 2) { xs <- seq(0, 1, length=1001) ys <- wi.fun(xs, delta, yi, vi, preci=1, alternative, steps) plot(xs, ys, type="l", lwd=2, xlab="p-value", ylab="Relative Likelihood of Selection") } return(-1*llval) } ############################################################################ .selmodel.ll.trunc <- function(par, yi, vi, X, preci, k, pX, pvals, deltas, delta.val, delta.transf, mapfun, delta.min, delta.max, tau2.val, tau2.transf, tau2.max, beta.val, wi.fun, steps, pgrp, alternative, pval.min, intCtrl, verbose, digits, dofit=FALSE) { mstyle <- .get.mstyle("crayon" %in% .packages()) beta <- par[1:pX] tau2 <- par[pX+1] delta <- par[(pX+2):(pX+1+deltas)] beta <- ifelse(is.na(beta.val), beta, beta.val) if (tau2.transf) tau2 <- exp(tau2) tau2[!is.na(tau2.val)] <- tau2.val tau2[tau2 < .Machine$double.eps*10] <- 0 tau2[tau2 > tau2.max] <- tau2.max if (delta.transf) delta <- mapply(.mapfun, delta, delta.min, delta.max, mapfun) delta <- ifelse(is.na(delta.val), delta, delta.val) yhat <- c(X %*% beta) sei <- sqrt(vi+tau2) if (is.na(steps)) { if (alternative == "greater") lli <- ifelse(yi > delta[2], 0, log(delta[1])) + dnorm(yi, yhat, sei, log=TRUE) - log(1 - (1-delta[1]) * pnorm(delta[2], yhat, sei, lower.tail=TRUE)) if (alternative == "less") lli <- ifelse(yi < delta[2], 0, log(delta[1])) + dnorm(yi, yhat, sei, log=TRUE) - log(1 - (1-delta[1]) * pnorm(delta[2], yhat, sei, lower.tail=FALSE)) } else { if (alternative == "greater") lli <- ifelse(yi > steps, 0, log(delta[1])) + dnorm(yi, yhat, sei, log=TRUE) - log(1 - (1-delta[1]) * pnorm(steps, yhat, sei, lower.tail=TRUE)) if (alternative == "less") lli <- ifelse(yi < steps, 0, log(delta[1])) + dnorm(yi, yhat, sei, log=TRUE) - log(1 - (1-delta[1]) * pnorm(steps, yhat, sei, lower.tail=FALSE)) } llval <- sum(lli) if (dofit) { res <- list(ll=llval, beta=beta, tau2=tau2, delta=delta) return(res) } if (verbose) .selmodel.verbose(ll=llval, beta=beta, tau2=tau2, delta=delta, mstyle=mstyle, digits=digits) return(-1*llval) } ############################################################################ metafor/R/hatvalues.rma.mv.r0000644000176200001440000000345313770364101015475 0ustar liggesusershatvalues.rma.mv <- function(model, type="diagonal", ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(model), must="rma.mv") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) type <- match.arg(type, c("diagonal", "matrix")) ######################################################################### x <- model if (is.null(x$W)) { W <- chol2inv(chol(x$M)) stXWX <- chol2inv(chol(as.matrix(t(x$X) %*% W %*% x$X))) H <- as.matrix(x$X %*% stXWX %*% crossprod(x$X,W)) #H <- as.matrix(x$X %*% x$vb %*% crossprod(x$X,W)) ### x$vb may have been changed through robust() } else { A <- x$W stXAX <- chol2inv(chol(as.matrix(t(x$X) %*% A %*% x$X))) H <- as.matrix(x$X %*% stXAX %*% crossprod(x$X,A)) } ######################################################################### if (type == "diagonal") { hii <- rep(NA_real_, x$k.f) hii[x$not.na] <- as.vector(diag(H)) hii[hii > 1 - 10 * .Machine$double.eps] <- 1 ### as in lm.influence() names(hii) <- x$slab if (na.act == "na.omit") hii <- hii[x$not.na] if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) return(hii) } if (type == "matrix") { Hfull <- matrix(NA_real_, nrow=x$k.f, ncol=x$k.f) Hfull[x$not.na, x$not.na] <- H rownames(Hfull) <- x$slab colnames(Hfull) <- x$slab if (na.act == "na.omit") Hfull <- Hfull[x$not.na, x$not.na, drop=FALSE] if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) return(Hfull) } } metafor/R/plot.infl.rma.uni.r0000644000176200001440000004552514465412563015575 0ustar liggesusersplot.infl.rma.uni <- function(x, plotinf=TRUE, plotdfbs=FALSE, dfbsnew=FALSE, logcov=TRUE, layout, slab.style=1, las=0, pch=21, bg, bg.infl, col.na, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="infl.rma.uni") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) .start.plot() if (missing(bg)) bg <- .coladj(par("bg","fg"), dark=0.35, light=-0.35) if (missing(bg.infl)) bg.infl <- "red" if (missing(col.na)) col.na <- .coladj(par("bg","fg"), dark=0.2, light=-0.2) ######################################################################### ### check for NAs and stop if there are any when na.act == "na.fail" any.na <- is.na(as.data.frame(x$inf)) if (any(any.na) && na.act == "na.fail") stop(mstyle$stop("Missing values in results.")) ######################################################################### ### process plotinf argument if (is.logical(plotinf)) { if (plotinf) { which.inf <- seq_len(8) } } else { which.inf <- plotinf which.inf <- which.inf[(which.inf >= 1) & (which.inf <= 8)] which.inf <- unique(round(which.inf)) if (length(which.inf) == 0L) stop(mstyle$stop("Incorrect specification of 'plotinf' argument.")) plotinf <- TRUE } ### process plotdfbs argument if (is.logical(plotdfbs)) { if (plotdfbs) { which.dfbs <- seq_len(x$p) } } else { which.dfbs <- plotdfbs which.dfbs <- which.dfbs[(which.dfbs >= 1) & (which.dfbs <= x$p)] which.dfbs <- unique(round(which.dfbs)) if (length(which.dfbs) == 0L) stop(mstyle$stop("Incorrect specification of 'plotdfbs' argument.")) plotdfbs <- TRUE } ######################################################################### if (!plotinf & !plotdfbs) stop(mstyle$stop("At least one of the arguments 'plotinf' or 'plotdfbs' argument must be TRUE.")) if (!plotinf & dfbsnew) dfbsnew <- FALSE par.mar <- par("mar") par.mar.adj <- par.mar - c(2,2,2,1) par.mar.adj[par.mar.adj < 1] <- 1 par(mar = par.mar.adj) par.mfrow <- par("mfrow") on.exit(par(mar = par.mar, mfrow = par.mfrow), add=TRUE) ######################################################################### ### filter out potential arguments to abbreviate() (which cause problems with the various plot functions) lplot <- function(..., minlength, strict) plot(...) lpoints <- function(..., minlength, strict) points(...) llines <- function(..., minlength, strict) lines(...) laxis <- function(..., minlength, strict) axis(...) labline <- function(..., minlength, strict) abline(...) ######################################################################### ids <- switch(slab.style, "1" = x$ids, "2" = x$inf$slab, "3" = abbreviate(x$inf$slab, ...)) #print(ids) ######################################################################### ### plot inf values if requested if (plotinf) { ### set layout (either defaults or user-specified) ### note: could also use n2mfrow() here, but this behaves slightly differently if (missing(layout)) { if (length(which.inf) == 2L) par(mfrow=c(2,1)) if (length(which.inf) == 3L) par(mfrow=c(3,1)) if (length(which.inf) == 4L) par(mfrow=c(2,2)) if (length(which.inf) == 5L) par(mfrow=c(5,1)) if (length(which.inf) == 6L) par(mfrow=c(3,2)) if (length(which.inf) == 7L) par(mfrow=c(7,1)) if (length(which.inf) == 8L) par(mfrow=c(4,2)) } else { layout <- layout[layout >= 1] layout <- round(layout) if (length(layout) != 2L) stop(mstyle$stop("Incorrect specification of 'layout' argument.")) par(mfrow=layout) } ###################################################################### for (i in seq_along(which.inf)) { if (which.inf[i] == 1) { zi <- x$inf$rstudent not.na <- !is.na(zi) if (na.act == "na.omit") { zi <- zi[not.na] len.ids <- length(x$ids)-sum(!not.na) ids.infl <- x$is.infl[not.na] lab.ids <- ids[not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { len.ids <- length(x$ids) ids.infl <- x$is.infl lab.ids <- ids } if (any(!is.na(zi))) { zi.min <- min(min(zi,-2,na.rm=TRUE), qnorm(.025))*1.05 zi.max <- max(max(zi, 2,na.rm=TRUE), qnorm(.975))*1.05 lplot(NA, NA, xlim=c(1,len.ids), ylim=c(zi.min,zi.max), xaxt="n", main="rstudent", xlab="", ylab="", las=las, ...) laxis(side=1, at=seq_len(len.ids), labels=lab.ids, xlab="", las=las, ...) labline(h=0, lty="dashed", ...) labline(h=c(qnorm(.025),qnorm(.975)), lty="dotted", ...) if (na.act == "na.exclude" || na.act == "na.pass") llines(seq_len(len.ids)[not.na], zi[not.na], col=col.na, ...) llines(seq_len(len.ids), zi, ...) lpoints(x=seq_len(len.ids), y=zi, bg=bg, pch=pch, ...) lpoints(x=seq_len(len.ids)[ids.infl], y=zi[ids.infl], bg=bg.infl, pch=pch, ...) #if (num.infl) # text(seq_len(len.ids)[ids.infl], zi[ids.infl], seq_len(len.ids)[ids.infl], pos=ifelse(zi[ids.infl] > 0, 3, 1), ...) } else { lplot(NA, NA, xlim=c(0,1), ylim=c(0,1), xaxt="n", yaxt="n", main="rstudent", xlab="", ylab="", ...) } } if (which.inf[i] == 2) { zi <- x$inf$dffits not.na <- !is.na(zi) if (na.act == "na.omit") { zi <- zi[not.na] len.ids <- length(x$ids)-sum(!not.na) ids.infl <- x$is.infl[not.na] lab.ids <- ids[not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { len.ids <- length(x$ids) ids.infl <- x$is.infl lab.ids <- ids } if (any(!is.na(zi))) { zi.min <- min(min(zi,na.rm=TRUE), -3*sqrt(x$p/(x$k-x$p)))*1.05 zi.max <- max(max(zi,na.rm=TRUE), 3*sqrt(x$p/(x$k-x$p)))*1.05 lplot(NA, NA, xlim=c(1,len.ids), ylim=c(zi.min,zi.max), xaxt="n", main="dffits", xlab="", ylab="", las=las, ...) laxis(side=1, at=seq_len(len.ids), labels=lab.ids, xlab="", las=las, ...) labline(h= 0, lty="dashed", ...) labline(h= 3*sqrt(x$p/(x$k-x$p)), lty="dotted", ...) labline(h=-3*sqrt(x$p/(x$k-x$p)), lty="dotted", ...) if (na.act == "na.exclude" || na.act == "na.pass") llines(seq_len(len.ids)[not.na], zi[not.na], col=col.na, ...) llines(seq_len(len.ids), zi, ...) lpoints(x=seq_len(len.ids), y=zi, bg=bg, pch=pch, ...) lpoints(x=seq_len(len.ids)[ids.infl], y=zi[ids.infl], bg=bg.infl, pch=pch, ...) #if (num.infl) # text(seq_len(len.ids)[ids.infl], zi[ids.infl], seq_len(len.ids)[ids.infl], pos=ifelse(zi[ids.infl] > 0, 3, 1), ...) } else { lplot(NA, NA, xlim=c(0,1), ylim=c(0,1), xaxt="n", yaxt="n", main="dffits", xlab="", ylab="", ...) } } if (which.inf[i] == 3) { zi <- x$inf$cook.d not.na <- !is.na(zi) if (na.act == "na.omit") { zi <- zi[not.na] len.ids <- length(x$ids)-sum(!not.na) ids.infl <- x$is.infl[not.na] lab.ids <- ids[not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { len.ids <- length(x$ids) ids.infl <- x$is.infl lab.ids <- ids } if (any(!is.na(zi))) { zi.min <- 0 zi.max <- max(zi,na.rm=TRUE)*1.05 lplot(NA, NA, xlim=c(1,len.ids), ylim=c(zi.min,zi.max), xaxt="n", main="cook.d", xlab="", ylab="", las=las, ...) laxis(side=1, at=seq_len(len.ids), labels=lab.ids, xlab="", las=las, ...) labline(h=qchisq(0.5, df=x$m), lty="dotted", ...) if (na.act == "na.exclude" || na.act == "na.pass") llines(seq_len(len.ids)[not.na], zi[not.na], col=col.na, ...) llines(seq_len(len.ids), zi, ...) lpoints(x=seq_len(len.ids), y=zi, bg=bg, pch=pch, ...) lpoints(x=seq_len(len.ids)[ids.infl], y=zi[ids.infl], bg=bg.infl, pch=pch, ...) #if (num.infl) # text(seq_len(len.ids)[ids.infl], zi[ids.infl], seq_len(len.ids)[ids.infl], pos=3, ...) } else { lplot(NA, NA, xlim=c(0,1), ylim=c(0,1), xaxt="n", yaxt="n", main="cook.d", xlab="", ylab="", ...) } } if (which.inf[i] == 4) { zi <- x$inf$cov.r not.na <- !is.na(zi) if (na.act == "na.omit") { zi <- zi[not.na] len.ids <- length(x$ids)-sum(!not.na) ids.infl <- x$is.infl[not.na] lab.ids <- ids[not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { len.ids <- length(x$ids) ids.infl <- x$is.infl lab.ids <- ids } if (any(!is.na(zi))) { zi.min <- min(zi,na.rm=TRUE) zi.max <- max(zi,na.rm=TRUE) if (logcov) { lplot(NA, NA, xlim=c(1,len.ids), ylim=c(zi.min,zi.max), xaxt="n", main="cov.r", xlab="", ylab="", las=las, log="y", ...) } else { lplot(NA, NA, xlim=c(1,len.ids), ylim=c(zi.min,zi.max), xaxt="n", main="cov.r", xlab="", ylab="", las=las, ...) } laxis(side=1, at=seq_len(len.ids), labels=lab.ids, xlab="", las=las, ...) labline(h=1, lty="dashed", ...) #labline(h=1+3*x$m/(x$k-x$m), lty="dotted", ...) #labline(h=1-3*x$m/(x$k-x$m), lty="dotted", ...) if (na.act == "na.exclude" || na.act == "na.pass") llines(seq_len(len.ids)[not.na], zi[not.na], col=col.na, ...) llines(seq_len(len.ids), zi, ...) lpoints(x=seq_len(len.ids), y=zi, bg=bg, pch=pch, ...) lpoints(x=seq_len(len.ids)[ids.infl], y=zi[ids.infl], bg=bg.infl, pch=pch, ...) #if (num.infl) # text(seq_len(len.ids)[ids.infl], zi[ids.infl], seq_len(len.ids)[ids.infl], pos=ifelse(zi[ids.infl] > 1, 3, 1), ...) } else { lplot(NA, NA, xlim=c(0,1), ylim=c(0,1), xaxt="n", yaxt="n", main="cov.r", xlab="", ylab="", ...) } } if (which.inf[i] == 5) { zi <- x$inf$tau2.del not.na <- !is.na(zi) if (na.act == "na.omit") { zi <- zi[not.na] len.ids <- length(x$ids)-sum(!not.na) ids.infl <- x$is.infl[not.na] lab.ids <- ids[not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { len.ids <- length(x$ids) ids.infl <- x$is.infl lab.ids <- ids } if (any(!is.na(zi))) { zi.min <- min(zi,na.rm=TRUE) zi.max <- max(zi,na.rm=TRUE) lplot(NA, NA, xlim=c(1,len.ids), ylim=c(zi.min,zi.max), xaxt="n", main="tau2.del", xlab="", ylab="", las=las, ...) laxis(side=1, at=seq_len(len.ids), labels=lab.ids, xlab="", las=las, ...) labline(h=x$tau2, lty="dashed", ...) if (na.act == "na.exclude" || na.act == "na.pass") llines(seq_len(len.ids)[not.na], zi[not.na], col=col.na, ...) llines(seq_len(len.ids), zi, ...) lpoints(x=seq_len(len.ids), y=zi, bg=bg, pch=pch, ...) lpoints(x=seq_len(len.ids)[ids.infl], y=zi[ids.infl], bg=bg.infl, pch=pch, ...) } else { lplot(NA, NA, xlim=c(0,1), ylim=c(0,1), xaxt="n", yaxt="n", main="tau2.del", xlab="", ylab="", ...) } } if (which.inf[i] == 6) { zi <- x$inf$QE.del not.na <- !is.na(zi) if (na.act == "na.omit") { zi <- zi[not.na] len.ids <- length(x$ids)-sum(!not.na) ids.infl <- x$is.infl[not.na] lab.ids <- ids[not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { len.ids <- length(x$ids) ids.infl <- x$is.infl lab.ids <- ids } if (any(!is.na(zi))) { zi.min <- min(zi,na.rm=TRUE) zi.max <- max(zi,na.rm=TRUE) lplot(NA, NA, xlim=c(1,len.ids), ylim=c(zi.min,zi.max), xaxt="n", main="QE.del", xlab="", ylab="", las=las, ...) laxis(side=1, at=seq_len(len.ids), labels=lab.ids, xlab="", las=las, ...) labline(h=x$QE, lty="dashed", ...) #labline(h=qchisq(.95, df=x$k-x$p), lty="dotted") if (na.act == "na.exclude" || na.act == "na.pass") llines(seq_len(len.ids)[not.na], zi[not.na], col=col.na, ...) llines(seq_len(len.ids), zi, ...) lpoints(x=seq_len(len.ids), y=zi, bg=bg, pch=pch, ...) lpoints(x=seq_len(len.ids)[ids.infl], y=zi[ids.infl], bg=bg.infl, pch=pch, ...) } else { lplot(NA, NA, xlim=c(0,1), ylim=c(0,1), xaxt="n", yaxt="n", main="QE.del", xlab="", ylab="", ...) } } if (which.inf[i] == 7) { zi <- x$inf$hat not.na <- !is.na(zi) if (na.act == "na.omit") { zi <- zi[not.na] len.ids <- length(x$ids)-sum(!not.na) ids.infl <- x$is.infl[not.na] lab.ids <- ids[not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { len.ids <- length(x$ids) ids.infl <- x$is.infl lab.ids <- ids } if (any(!is.na(zi))) { zi.min <- 0 zi.max <- max(max(zi,na.rm=TRUE), 3*x$p/x$k)*1.05 lplot(NA, NA, xlim=c(1,len.ids), ylim=c(zi.min,zi.max), xaxt="n", main="hat", xlab="", ylab="", las=las, ...) laxis(side=1, at=seq_len(len.ids), labels=lab.ids, xlab="", las=las, ...) labline(h=x$p/x$k, lty="dashed", ...) labline(h=3*x$p/x$k, lty="dotted", ...) if (na.act == "na.exclude" || na.act == "na.pass") llines(seq_len(len.ids)[not.na], zi[not.na], col=col.na, ...) llines(seq_len(len.ids), zi, ...) lpoints(x=seq_len(len.ids), y=zi, bg=bg, pch=pch, ...) lpoints(x=seq_len(len.ids)[ids.infl], y=zi[ids.infl], bg=bg.infl, pch=pch, ...) } else { lplot(NA, NA, xlim=c(0,1), ylim=c(0,1), xaxt="n", yaxt="n", main="hat", xlab="", ylab="", ...) } } if (which.inf[i] == 8) { zi <- x$inf$weight not.na <- !is.na(zi) if (na.act == "na.omit") { zi <- zi[not.na] len.ids <- length(x$ids)-sum(!not.na) ids.infl <- x$is.infl[not.na] lab.ids <- ids[not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { len.ids <- length(x$ids) ids.infl <- x$is.infl lab.ids <- ids } if (any(!is.na(zi))) { zi.min <- 0 zi.max <- max(zi,na.rm=TRUE)*1.05 lplot(NA, NA, xlim=c(1,len.ids), ylim=c(zi.min,zi.max), xaxt="n", main="weight", xlab="", ylab="", las=las, ...) laxis(side=1, at=seq_len(len.ids), labels=lab.ids, xlab="", las=las, ...) labline(h=100/x$k, lty="dashed", ...) if (na.act == "na.exclude" || na.act == "na.pass") llines(seq_len(len.ids)[not.na], zi[not.na], col=col.na, ...) llines(seq_len(len.ids), zi, ...) lpoints(x=seq_len(len.ids), y=zi, bg=bg, pch=pch, ...) lpoints(x=seq_len(len.ids)[ids.infl], y=zi[ids.infl], bg=bg.infl, pch=pch, ...) } else { lplot(NA, NA, xlim=c(0,1), ylim=c(0,1), xaxt="n", yaxt="n", main="weight", xlab="", ylab="", ...) } } } } ######################################################################### ### plot dfbs values if requested if (plotdfbs) { if (dfbsnew) { dev.new() par.mar <- par("mar") par.mar.adj <- par.mar - c(2,2,2,1) par.mar.adj[par.mar.adj < 1] <- 1 par(mar = par.mar.adj) on.exit(par(mar = par.mar), add=TRUE) } else { if (plotinf) { par.ask <- par("ask") par(ask=TRUE) on.exit(par(ask = par.ask), add=TRUE) } } par(mfrow=n2mfrow(length(which.dfbs))) for (i in seq_along(which.dfbs)) { zi <- x$dfbs[[which.dfbs[i]]] not.na <- !is.na(zi) if (na.act == "na.omit") { zi <- zi[not.na] len.ids <- length(x$ids)-sum(!not.na) ids.infl <- x$is.infl[not.na] lab.ids <- ids[not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { len.ids <- length(x$ids) ids.infl <- x$is.infl lab.ids <- ids } zi.min <- min(zi,na.rm=TRUE)*1.05 zi.max <- max(zi,na.rm=TRUE)*1.05 lplot(NA, NA, xlim=c(1,len.ids), ylim=c(zi.min,zi.max), xaxt="n", main=paste("dfbs: ", names(x$dfbs)[which.dfbs[i]]), xlab="", ylab="", las=las, ...) laxis(side=1, at=seq_len(len.ids), labels=lab.ids, xlab="", las=las, ...) labline(h= 0, lty="dashed", ...) labline(h= 1, lty="dotted", ...) labline(h=-1, lty="dotted", ...) if (na.act == "na.exclude" || na.act == "na.pass") llines(seq_len(len.ids)[not.na], zi[not.na], col=col.na, ...) llines(seq_len(len.ids), zi, ...) lpoints(x=seq_len(len.ids), y=zi, bg=bg, pch=pch, ...) lpoints(x=seq_len(len.ids)[ids.infl], y=zi[ids.infl], bg=bg.infl, pch=pch, ...) } } ######################################################################### invisible() } metafor/R/qqnorm.rma.uni.r0000644000176200001440000001263314465412617015177 0ustar liggesusersqqnorm.rma.uni <- function(y, type="rstandard", pch=21, col, bg, envelope=TRUE, level=y$level, bonferroni=FALSE, reps=1000, smooth=TRUE, bass=0, label=FALSE, offset=0.3, pos=13, lty, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(y), must="rma.uni", notav=c("rma.gen", "rma.uni.selmodel")) na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) x <- y type <- match.arg(type, c("rstandard", "rstudent")) if (x$k == 1) stop(mstyle$stop("Stopped because k = 1.")) draw.envelope <- envelope if (label == "out" & !envelope) { envelope <- TRUE draw.envelope <- FALSE } if (length(label) != 1L) stop(mstyle$stop("Argument 'label' should be of length 1.")) .start.plot() if (missing(col)) col <- par("fg") if (missing(bg)) bg <- .coladj(par("bg","fg"), dark=0.35, light=-0.35) if (missing(lty)) { lty <- c("solid", "dotted") ### 1st value = diagonal line, 2nd value = pseudo confidence envelope } else { if (length(lty) == 1L) lty <- c(lty, lty) } ddd <- list(...) lqqnorm <- function(..., seed) qqnorm(...) lpoints <- function(..., seed) points(...) labline <- function(..., seed) abline(...) llines <- function(..., seed) lines(...) ltext <- function(..., seed) text(...) ######################################################################### if (type == "rstandard") { res <- rstandard(x) not.na <- !is.na(res$z) zi <- res$z[not.na] slab <- res$slab[not.na] ord <- order(zi) slab <- slab[ord] } else { res <- rstudent(x) not.na <- !is.na(res$z) zi <- res$z[not.na] slab <- res$slab[not.na] ord <- order(zi) slab <- slab[ord] } sav <- lqqnorm(zi, pch=pch, col=col, bg=bg, bty="l", ...) labline(a=0, b=1, lty=lty[1], ...) #qqline(zi, ...) #abline(h=0, lty="dotted", ...) #abline(v=0, lty="dotted", ...) ######################################################################### ### construct simulation based pseudo confidence envelope if (envelope) { level <- .level(level) if (!is.null(ddd$seed)) set.seed(ddd$seed) dat <- matrix(rnorm(x$k*reps), nrow=x$k, ncol=reps) options(na.action="na.omit") H <- hatvalues(x, type="matrix") options(na.action = na.act) ImH <- diag(x$k) - H ei <- ImH %*% dat ei <- apply(ei, 2, sort) if (bonferroni) { lb <- apply(ei, 1, quantile, (level/2)/x$k) ### consider using rowQuantiles() from matrixStats package ub <- apply(ei, 1, quantile, 1-(level/2)/x$k) ### consider using rowQuantiles() from matrixStats package } else { lb <- apply(ei, 1, quantile, (level/2)) ### consider using rowQuantiles() from matrixStats package ub <- apply(ei, 1, quantile, 1-(level/2)) ### consider using rowQuantiles() from matrixStats package } temp.lb <- qqnorm(lb, plot.it=FALSE) if (smooth) temp.lb <- supsmu(temp.lb$x, temp.lb$y, bass=bass) if (draw.envelope) llines(temp.lb$x, temp.lb$y, lty=lty[2], ...) #llines(temp.lb$x, temp.lb$y, lty="12", lwd=1.5, ...) temp.ub <- qqnorm(ub, plot.it=FALSE) if (smooth) temp.ub <- supsmu(temp.ub$x, temp.ub$y, bass=bass) if (draw.envelope) llines(temp.ub$x, temp.ub$y, lty=lty[2], ...) #llines(temp.ub$x, temp.ub$y, lty="12", lwd=1.5, , ...) } lpoints(sav$x, sav$y, pch=pch, col=col, bg=bg, ...) ######################################################################### ### labeling of points if ((is.character(label) && label=="none") || .isFALSE(label)) return(invisible(sav)) if ((is.character(label) && label=="all") || .isTRUE(label)) label <- x$k if (is.numeric(label)) { label <- round(label) if (label < 1 | label > x$k) stop(mstyle$stop("Out of range value for 'label' argument.")) pos.x <- sav$x[ord] pos.y <- sav$y[ord] dev <- abs(pos.x - pos.y) for (i in seq_len(x$k)) { if (sum(dev > dev[i]) < label) { if (pos <= 4) ltext(pos.x[i], pos.y[i], slab[i], pos=pos, offset=offset, ...) if (pos == 13) ltext(pos.x[i], pos.y[i], slab[i], pos=ifelse(pos.x[i]-pos.y[i] >= 0, 1, 3), offset=offset, ...) if (pos == 24) ltext(pos.x[i], pos.y[i], slab[i], pos=ifelse(pos.x[i]-pos.y[i] <= 0, 2, 4), offset=offset, ...) #ltext(pos.x[i], pos.y[i], slab[i], pos=ifelse(pos.x[i] >= 0, 2, 4), offset=offset, ...) } } } else { pos.x <- sav$x[ord] pos.y <- sav$y[ord] for (i in seq_len(x$k)) { if (pos.y[i] < temp.lb$y[i] || pos.y[i] > temp.ub$y[i]) { if (pos <= 4) ltext(pos.x[i], pos.y[i], slab[i], pos=pos, offset=offset, ...) if (pos == 13) ltext(pos.x[i], pos.y[i], slab[i], pos=ifelse(pos.x[i]-pos.y[i] >= 0, 1, 3), offset=offset, ...) if (pos == 24) ltext(pos.x[i], pos.y[i], slab[i], pos=ifelse(pos.x[i]-pos.y[i] <= 0, 2, 4), offset=offset, ...) } } } ######################################################################### #if (envelope) { # invisible(list(pts=sav, ci.lb=temp.lb, ci.ub=temp.ub)) #} else { # invisible(sav) #} invisible(sav) } metafor/R/hc.r0000644000176200001440000000005713457322061012672 0ustar liggesusershc <- function(object, ...) UseMethod("hc") metafor/R/plot.cumul.rma.r0000644000176200001440000001544214466623031015166 0ustar liggesusersplot.cumul.rma <- function(x, yaxis, xlim, ylim, xlab, ylab, at, transf, atransf, targs, digits, cols, grid=TRUE, pch=19, cex=1, lwd=2, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="cumul.rma") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) .start.plot() if (missing(cols)) cols <- c(.coladj(par("bg","fg"), dark=0.2, light=-0.2), .coladj(par("bg","fg"), dark=0.8, light=-0.8)) if (missing(yaxis)) { if (is.null(x$tau2)) { yaxis <- "I2" } else { yaxis <- "tau2" } } else { yaxis <- match.arg(yaxis, c("tau2","I2","H2")) if (is.null(x$tau2)) stop(mstyle$stop("Cannot use yaxis=\"tau2\" for equal/fixed-effects models.")) } if (missing(transf)) transf <- FALSE if (missing(atransf)) atransf <- FALSE transf.char <- deparse(transf) atransf.char <- deparse(atransf) if (is.function(transf) && is.function(atransf)) stop(mstyle$stop("Use either 'transf' or 'atransf' to specify a transformation (not both).")) if (missing(xlab)) xlab <- .setlab(x$measure, transf.char, atransf.char, gentype=2) if (missing(ylab)) { if (yaxis == "tau2") #ylab <- "Amount of Heterogeneity (tau^2)" ylab <- expression(paste("Amount of Heterogeneity ", (tau^2))) if (yaxis == "I2") #ylab <- "Percentage of Variability due to Heterogeneity (I^2)" ylab <- expression(paste("Percentage of Variability due to Heterogeneity ", (I^2))) if (yaxis == "H2") #ylab <- "Ratio of Total Variability to Sampling Variability (H^2)" ylab <- expression(paste("Ratio of Total Variability to Sampling Variability ", (H^2))) } par.mar <- par("mar") par.mar.adj <- par.mar + c(0,0.5,0,0) # need a bit more space on the right for the y-axis label par(mar = par.mar.adj) on.exit(par(mar = par.mar), add=TRUE) if (missing(at)) at <- NULL if (missing(targs)) targs <- NULL if (missing(digits)) { if (yaxis == "tau2") digits <- c(2L,3L) if (yaxis == "I2") digits <- c(2L,1L) if (yaxis == "H2") digits <- c(2L,1L) } else { if (length(digits) == 1L) # digits[1] for x-axis labels digits <- c(digits,digits) # digits[2] for y-axis labels } ### note: digits can also be a list (e.g., digits=list(2L,3)); trailing 0's are dropped for integers ddd <- list(...) if (!is.null(ddd$addgrid)) grid <- ddd$addgrid ### grid argument can either be a logical or a color if (is.logical(grid)) gridcol <- .coladj(par("bg","fg"), dark=c(0.2,-0.6), light=c(-0.2,0.6)) if (is.character(grid)) { gridcol <- grid grid <- TRUE } lplot <- function(..., addgrid) plot(...) laxis <- function(..., addgrid) axis(...) ######################################################################### ### set up data frame with the values to be plotted dat <- data.frame(estim=x$estimate) if (yaxis == "tau2") dat$yval <- x$tau2 if (yaxis == "I2") dat$yval <- x$I2 if (yaxis == "H2") dat$yval <- x$H2 ### apply chosen na.action if (na.act == "na.fail" && anyNA(dat)) stop(mstyle$stop("Missing values in results.")) if (na.act == "na.omit") dat <- na.omit(dat) ### number of remaining rows/points k <- nrow(dat) ### if requested, apply transformation to estimates if (is.function(transf)) { if (is.null(targs)) { dat$estim <- sapply(dat$estim, transf) } else { dat$estim <- sapply(dat$estim, transf, targs) } } ### set xlim and ylim values if (missing(xlim)) { xlim <- range(dat$estim, na.rm=TRUE) } else { xlim <- sort(xlim) # just in case the user supplies the limits in the wrong order } if (missing(ylim)) { ylim <- range(dat$yval, na.rm=TRUE) } else { ylim <- sort(ylim) # just in case the user supplies the limits in the wrong order } ### if user has specified 'at' argument, make sure xlim actually contains the min and max 'at' values if (!is.null(at)) { xlim[1] <- min(c(xlim[1], at), na.rm=TRUE) xlim[2] <- max(c(xlim[2], at), na.rm=TRUE) } ### set up plot lplot(NA, NA, xlim=xlim, ylim=ylim, xlab=xlab, ylab=ylab, xaxt="n", yaxt="n", ...) ### generate x-axis positions if none are specified if (is.null(at)) { at <- axTicks(side=1) } else { at <- at[at > par("usr")[1]] at <- at[at < par("usr")[2]] } at.lab <- at if (is.function(atransf)) { if (is.null(targs)) { at.lab <- fmtx(sapply(at.lab, atransf), digits[[1]], drop0ifint=TRUE) } else { at.lab <- fmtx(sapply(at.lab, atransf, targs), digits[[1]], drop0ifint=TRUE) } } else { at.lab <- fmtx(at.lab, digits[[1]], drop0ifint=TRUE) } ### add x-axis laxis(side=1, at=at, labels=at.lab, ...) ### add y-axis aty <- axTicks(side=2) laxis(side=2, at=aty, labels=fmtx(aty, digits[[2]], drop0ifint=TRUE), ...) ### add grid if (.isTRUE(grid)) { abline(v=at, lty="dotted", col=gridcol) abline(h=aty, lty="dotted", col=gridcol) } ### vector with color gradient for points cols.points <- colorRampPalette(cols)(k) #gray.vals.points <- seq(from=.9, to=.1, length.out=k) #cols.points <- gray(gray.vals.points) #cols <- colorRampPalette(c("yellow","red"))(k) #cols <- colorRampPalette(c("blue","red"))(k) #cols <- rev(heat.colors(k+4))[-c(1:2,(k+1):(k+2)] #cols <- rev(topo.colors(k)) #cols <- rainbow(k, start=.2, end=.4) ### add lines that have a gradient (by interpolating values) ### looks better this way, especially when k is low for (i in seq_len(k-1)) { if (is.na(dat$estim[i]) || is.na(dat$estim[i+1]) || is.na(dat$yval[i]) || is.na(dat$yval[i+1])) next estims <- approx(c(dat$estim[i], dat$estim[i+1]), n=50)$y yvals <- approx(c(dat$yval[i], dat$yval[i+1]), n=50)$y cols.lines <- colorRampPalette(c(cols.points[i], cols.points[i+1]))(50) #gray.vals.lines <- approx(c(gray.vals.points[i], gray.vals.points[i+1]), n=50)$y #cols.lines <- gray(gray.vals.lines) segments(estims[-50], yvals[-50], estims[-1], yvals[-1], col=cols.lines, lwd=lwd, ...) } ### add lines (this does no interpolation) #segments(dat$estim[-k], dat$yval[-k], dat$estim[-1], dat$yval[-1], col=cols.points, lwd=lwd) ### add points points(x=dat$estim, y=dat$yval, pch=pch, col=cols.points, cex=cex, ...) ### redraw box around plot box(...) ### return data frame invisibly dat$col <- cols.points invisible(dat) } metafor/R/residuals.rma.r0000644000176200001440000000561214401676656015067 0ustar liggesusersresiduals.rma <- function(object, type="response", ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) type <- match.arg(type, c("response", "rstandard", "rstudent", "pearson", "cholesky")) ### for objects of class "rma.mh" and "rma.peto", use rstandard() to get the Pearson residuals if (inherits(object, c("rma.mh", "rma.peto")) && type == "pearson") type <- "rstandard" ######################################################################### if (type == "rstandard") { tmp <- rstandard(object) out <- c(tmp$z) names(out) <- tmp$slab } if (type == "rstudent") { tmp <- rstudent(object) out <- c(tmp$z) names(out) <- tmp$slab } ######################################################################### if (type == "response") { ### note: can calculate this even if vi is missing out <- c(object$yi.f - object$X.f %*% object$beta) out[abs(out) < 100 * .Machine$double.eps] <- 0 } if (type == "pearson") { if (inherits(object, "rma.glmm")) stop(mstyle$stop("Extraction of Pearson residuals not available for objects of class \"rma.glmm\".")) out <- c(object$yi.f - object$X.f %*% object$beta) out[abs(out) < 100 * .Machine$double.eps] <- 0 se <- rep(NA_real_, object$k.f) se[object$not.na] <- sqrt(diag(object$M)) out <- out / se } if (type == "cholesky") { ### note: Cholesky residuals depend on the data order ### but only for the Cholesky residuals is QE = sum(residuals(res, type="cholesky)^2) for models where M (or rather: V) is not diagonal if (inherits(object, c("rma.mh", "rma.peto", "rma.glmm"))) stop(mstyle$stop("Extraction of Cholesky residuals not available for objects of class \"rma.mh\", \"rma.peto\", or \"rma.glmm\".")) out <- c(object$yi - object$X %*% object$beta) out[abs(out) < 100 * .Machine$double.eps] <- 0 L <- try(chol(chol2inv(chol(object$M)))) if (inherits(L, "try-error")) stop(mstyle$stop("Could not take Cholesky decomposition of the marginal var-cov matrix.")) tmp <- L %*% out out <- rep(NA_real_, object$k.f) out[object$not.na] <- tmp } if (is.element(type, c("response", "pearson", "cholesky"))) { names(out) <- object$slab #not.na <- !is.na(out) if (na.act == "na.omit") out <- out[object$not.na] if (na.act == "na.exclude") out[!object$not.na] <- NA_real_ if (na.act == "na.fail" && any(!object$not.na)) stop(mstyle$stop("Missing values in results.")) } ######################################################################### return(out) } metafor/R/print.rma.uni.r0000644000176200001440000003752614503332332015012 0ustar liggesusersprint.rma.uni <- function(x, digits, showfit=FALSE, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.uni") if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } footsym <- .get.footsym() ddd <- list(...) .chkdots(ddd, c("num", "legend")) if (is.null(ddd$legend)) { legend <- ifelse(inherits(x, "robust.rma"), TRUE, FALSE) } else { if (is.na(ddd$legend)) { # can suppress legend and legend symbols with legend=NA legend <- FALSE footsym <- rep("", 6) } else { legend <- .isTRUE(ddd$legend) } } if (inherits(x, "rma.uni.trimfill")) { .space() cat(mstyle$text(paste0("Estimated number of missing studies on the ", x$side, " side: "))) cat(mstyle$result(paste0(x$k0, " (SE = ", fmtx(x$se.k0, digits[["se"]]), ")"))) cat("\n") if (x$k0.est == "R0") { cat(mstyle$text(paste0("Test of H0: no missing studies on the ", x$side, " side: "))) cat(paste0(rep(" ", nchar(x$k0)), collapse="")) cat(mstyle$result(paste0("p-val ", fmtp(x$p.k0, digits[["pval"]], equal=TRUE, sep=TRUE)))) cat("\n") } .space(FALSE) } .space() if (x$model == "rma.ls") { cat(mstyle$section("Location-Scale Model")) cat(mstyle$section(paste0(" (k = ", x$k, "; "))) if (isTRUE(x$tau2.fix)) { cat(mstyle$section("user-specified tau^2 value)")) } else { cat(mstyle$section(paste0("tau^2 estimator: ", x$method, ")"))) } } else { if (is.element(x$method, c("FE","EE","CE"))) { if (x$int.only) { cat(mstyle$section(sapply(x$method, switch, "FE"="Fixed-Effects Model", "EE"="Equal-Effects Model", "CE"="Common-Effects Model", USE.NAMES=FALSE))) } else { cat(mstyle$section("Fixed-Effects with Moderators Model")) } cat(mstyle$section(paste0(" (k = ", x$k, ")"))) } else { if (x$int.only) { cat(mstyle$section("Random-Effects Model")) } else { cat(mstyle$section("Mixed-Effects Model")) } cat(mstyle$section(paste0(" (k = ", x$k, "; "))) if (inherits(x, "rma.gen")) { cat(mstyle$section(paste0("estimation method: ", x$method, ")"))) } else { if (isTRUE(x$tau2.fix)) { cat(mstyle$section("user-specified tau^2 value)")) } else { cat(mstyle$section(paste0("tau^2 estimator: ", x$method, ")"))) } } } } cat("\n") if (showfit) { if (x$method == "REML") { fs <- fmtx(x$fit.stats$REML, digits[["fit"]]) } else { fs <- fmtx(x$fit.stats$ML, digits[["fit"]]) } names(fs) <- c("logLik", "deviance", "AIC", "BIC", "AICc") cat("\n") tmp <- capture.output(print(fs, quote=FALSE, print.gap=2)) #tmp[1] <- paste0(tmp[1], "\u200b") .print.table(tmp, mstyle) } cat("\n") if (x$model == "rma.uni" || x$model == "rma.uni.selmodel" || inherits(x, "rma.gen")) { if (!is.element(x$method, c("FE","EE","CE"))) { if (x$int.only) { cat(mstyle$text(paste0("tau^2 (", ifelse(isTRUE(x$tau2.fix), "specified", "estimated"), " amount of total heterogeneity): "))) cat(mstyle$result(paste0(fmtx(x$tau2, digits[["var"]], thresh=.Machine$double.eps*10), ifelse(is.na(x$se.tau2), "", paste0(" (SE = " , fmtx(x$se.tau2, digits[["sevar"]]), ")"))))) cat("\n") cat(mstyle$text(paste0("tau (square root of ", ifelse(isTRUE(x$tau2.fix), "specified", "estimated"), " tau^2 value): "))) cat(mstyle$result(fmtx(.sqrt(x$tau2), digits[["var"]], thresh=.Machine$double.eps*10))) cat("\n") } else { if (!is.na(x$I2) || !is.na(x$H2)) { cat(mstyle$text(paste0("tau^2 (", ifelse(isTRUE(x$tau2.fix), "specified", "estimated"), " amount of residual heterogeneity): "))) } else { cat(mstyle$text(paste0("tau^2 (", ifelse(isTRUE(x$tau2.fix), "specified", "estimated"), " amount of residual heterogeneity): "))) } cat(mstyle$result(paste0(fmtx(x$tau2, digits[["var"]], thresh=.Machine$double.eps*10), ifelse(is.na(x$se.tau2), "", paste0(" (SE = " , fmtx(x$se.tau2, digits[["sevar"]]), ")"))))) cat("\n") if (!is.na(x$I2) || !is.na(x$H2)) { cat(mstyle$text(paste0("tau (square root of ", ifelse(isTRUE(x$tau2.fix), "specified", "estimated"), " tau^2 value): "))) } else { cat(mstyle$text(paste0("tau (square root of ", ifelse(isTRUE(x$tau2.fix), "specified", "estimated"), " tau^2 value): "))) } cat(mstyle$result(fmtx(.sqrt(x$tau2), digits[["var"]], thresh=.Machine$double.eps*10))) cat("\n") } } if (x$int.only) { if (!is.na(x$I2)) { cat(mstyle$text("I^2 (total heterogeneity / total variability): ")) cat(mstyle$result(fmtx(x$I2, 2, postfix="%"))) cat("\n") } if (!is.na(x$H2)) { cat(mstyle$text("H^2 (total variability / sampling variability): ")) cat(mstyle$result(fmtx(x$H2, 2))) cat("\n") } } else { if (!is.na(x$I2)) { cat(mstyle$text("I^2 (residual heterogeneity / unaccounted variability): ")) cat(mstyle$result(fmtx(x$I2, 2, postfix="%"))) cat("\n") } if (!is.na(x$H2)) { cat(mstyle$text("H^2 (unaccounted variability / sampling variability): ")) cat(mstyle$result(fmtx(x$H2, 2))) cat("\n") } } if (!x$int.only && !is.null(x$R2)) { if (!is.na(x$I2) || !is.na(x$H2)) { cat(mstyle$text("R^2 (amount of heterogeneity accounted for): ")) } else { cat(mstyle$text("R^2 (amount of heterogeneity accounted for): ")) } cat(mstyle$result(fmtx(x$R2, 2, postfix="%"))) cat("\n") } if (!is.element(x$method, c("FE","EE","CE")) || !is.na(x$I2) || !is.na(x$H2) || !is.null(x$R2)) cat("\n") } if (inherits(x, "rma.gen")) { cat(mstyle$section("Parameter Estimates:")) cat("\n\n") res.table <- data.frame(as.list(fmtx(x$pars, digits[["var"]]))) colnames(res.table) <- names(x$pars) res.table <- res.table[1,,drop=FALSE] tmp <- capture.output(.print.vector(res.table)) .print.table(tmp, mstyle) cat("\n") } if (!is.na(x$QE)) { if (x$int.only) { cat(mstyle$section("Test for Heterogeneity:")) cat("\n") cat(mstyle$result(fmtt(x$QE, "Q", df=x$k-x$p, pval=x$QEp, digits=digits))) } else { cat(mstyle$section("Test for Residual Heterogeneity:")) cat("\n") cat(mstyle$result(fmtt(x$QE, "QE", df=x$k-x$p, pval=x$QEp, digits=digits))) } cat("\n\n") } if (x$model == "rma.uni.selmodel" && !is.na(x$LRT.tau2)) { if (x$int.only) { cat(mstyle$section("Test for Heterogeneity:")) cat("\n") cat(mstyle$result(fmtt(x$LRT.tau2, "LRT", df=1, pval=x$LRTp.tau2, digits=digits))) } else { cat(mstyle$section("Test for Residual Heterogeneity:")) cat("\n") cat(mstyle$result(fmtt(x$LRT.tau2, "LRT", df=1, pval=x$LRTp.tau2, digits=digits))) } cat("\n\n") } if (inherits(x, "robust.rma")) { cat(mstyle$text("Number of estimates: ")) cat(mstyle$result(x$k)) cat("\n") cat(mstyle$text("Number of clusters: ")) cat(mstyle$result(x$n)) cat("\n") cat(mstyle$text("Estimates per cluster: ")) if (all(x$tcl[1] == x$tcl)) { cat(mstyle$result(x$tcl[1])) } else { cat(mstyle$result(paste0(min(x$tcl), "-", max(x$tcl), " (mean: ", fmtx(mean(x$tcl), digits=2), ", median: ", round(median(x$tcl), digits=2), ")"))) } cat("\n\n") } if (x$p > 1L && !is.na(x$QM)) { if (x$model == "rma.ls") { cat(mstyle$section(paste0("Test of Location Coefficients (coefficient", ifelse(x$m == 1, " ", "s "), .format.btt(x$btt),"):"))) } else { cat(mstyle$section(paste0("Test of Moderators (coefficient", ifelse(x$m == 1, " ", "s "), .format.btt(x$btt),"):", ifelse(inherits(x, "robust.rma"), footsym[1], "")))) } cat("\n") if (is.element(x$test, c("knha","adhoc","t"))) { cat(mstyle$result(fmtt(x$QM, "F", df1=x$QMdf[1], df2=x$QMdf[2], pval=x$QMp, digits=digits))) } else { cat(mstyle$result(fmtt(x$QM, "QM", df=x$QMdf[1], pval=x$QMp, digits=digits))) } cat("\n\n") } if (is.element(x$test, c("knha","adhoc","t"))) { res.table <- data.frame(estimate=fmtx(c(x$beta), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), tval=fmtx(x$zval, digits[["test"]]), df=round(x$ddf,2), pval=fmtp(x$pval, digits[["pval"]]), ci.lb=fmtx(x$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$ci.ub, digits[["ci"]]), stringsAsFactors=FALSE) if (inherits(x, "robust.rma") && footsym[1] != "") res.table <- .addfootsym(res.table, 2:7, footsym[1]) } else { res.table <- data.frame(estimate=fmtx(c(x$beta), digits[["est"]]), se=fmtx(x$se, digits[["se"]]), zval=fmtx(x$zval, digits[["test"]]), pval=fmtp(x$pval, digits[["pval"]]), ci.lb=fmtx(x$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$ci.ub, digits[["ci"]]), stringsAsFactors=FALSE) } rownames(res.table) <- rownames(x$beta) signif <- symnum(x$pval, corr=FALSE, na=FALSE, cutpoints=c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", "**", "*", ".", " ")) if (signif.stars) { res.table <- cbind(res.table, signif) colnames(res.table)[ncol(res.table)] <- "" } if (.isTRUE(ddd$num)) { width <- nchar(nrow(res.table)) rownames(res.table) <- paste0(formatC(seq_len(nrow(res.table)), format="d", width=width), ") ", rownames(res.table)) } if (x$int.only) res.table <- res.table[1,] if (x$model == "rma.uni" || x$model == "rma.uni.selmodel") { cat(mstyle$section("Model Results:")) } else { cat(mstyle$section("Model Results (Location):")) } cat("\n\n") if (x$int.only) { tmp <- capture.output(.print.vector(res.table)) } else { tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE, print.gap=2)) } #tmp[1] <- paste0(tmp[1], "\u200b") .print.table(tmp, mstyle) if (x$model == "rma.ls") { if (x$q > 1L && !is.na(x$QS)) { cat("\n") cat(mstyle$section(paste0("Test of Scale Coefficients (coefficient", ifelse(x$m.alpha == 1, " ", "s "), .format.btt(x$att),"):"))) cat("\n") if (is.element(x$test, c("knha","adhoc","t"))) { cat(mstyle$result(fmtt(x$QS, "F", df1=x$QSdf[1], df2=x$QSdf[2], pval=x$QSp, digits=digits))) } else { cat(mstyle$result(fmtt(x$QS, "QM", df=x$QSdf[1], pval=x$QSp, digits=digits))) } cat("\n") } if (is.element(x$test, c("knha","adhoc","t"))) { res.table <- data.frame(estimate=fmtx(c(x$alpha), digits[["est"]]), se=fmtx(x$se.alpha, digits[["se"]]), tval=fmtx(x$zval.alpha, digits[["test"]]), df=round(x$ddf.alpha, 2), pval=fmtp(x$pval.alpha, digits[["pval"]]), ci.lb=fmtx(x$ci.lb.alpha, digits[["ci"]]), ci.ub=fmtx(x$ci.ub.alpha, digits[["ci"]]), stringsAsFactors=FALSE) } else { res.table <- data.frame(estimate=fmtx(c(x$alpha), digits[["est"]]), se=fmtx(x$se.alpha, digits[["se"]]), zval=fmtx(x$zval.alpha, digits[["test"]]), pval=fmtp(x$pval.alpha, digits[["pval"]]), ci.lb=fmtx(x$ci.lb.alpha, digits[["ci"]]), ci.ub=fmtx(x$ci.ub.alpha, digits[["ci"]]), stringsAsFactors=FALSE) } rownames(res.table) <- rownames(x$alpha) signif <- symnum(x$pval.alpha, corr=FALSE, na=FALSE, cutpoints=c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", "**", "*", ".", " ")) if (signif.stars) { res.table <- cbind(res.table, signif) colnames(res.table)[ncol(res.table)] <- "" } for (j in seq_len(nrow(res.table))) { res.table[j, is.na(res.table[j,])] <- ifelse(x$alpha.fix[j], "---", "NA") res.table[j, res.table[j,] == "NA"] <- ifelse(x$alpha.fix[j], "---", "NA") } if (.isTRUE(ddd$num)) { width <- nchar(nrow(res.table)) rownames(res.table) <- paste0(formatC(seq_len(nrow(res.table)), format="d", width=width), ") ", rownames(res.table)) } if (length(x$alpha) == 1L) res.table <- res.table[1,] cat("\n") cat(mstyle$section("Model Results (Scale):")) cat("\n\n") if (length(x$alpha) == 1L) { tmp <- capture.output(.print.vector(res.table)) } else { tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE, print.gap=2)) } #tmp[1] <- paste0(tmp[1], "\u200b") .print.table(tmp, mstyle) } if (x$model == "rma.uni.selmodel") { if (!is.na(x$LRT)) { cat("\n") cat(mstyle$section("Test for Selection Model Parameters:")) cat("\n") cat(mstyle$result(fmtt(x$LRT, "LRT", df=x$LRTdf, pval=x$LRTp, digits=digits))) cat("\n") } res.table <- data.frame(estimate=fmtx(c(x$delta), digits[["est"]]), se=fmtx(x$se.delta, digits[["se"]]), zval=fmtx(x$zval.delta, digits[["test"]]), pval=fmtp(x$pval.delta, digits[["pval"]]), ci.lb=fmtx(x$ci.lb.delta, digits[["ci"]]), ci.ub=fmtx(x$ci.ub.delta, digits[["ci"]]), stringsAsFactors=FALSE) if (x$type == "stepfun") { rownames(res.table) <- rownames(x$ptable) res.table <- cbind(k=x$ptable$k, res.table) } else { rownames(res.table) <- paste0("delta.", seq_along(x$delta)) } #if (x$test == "t") # colnames(res.table)[3] <- "tval" signif <- symnum(x$pval.delta, corr=FALSE, na=FALSE, cutpoints=c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", "**", "*", ".", " ")) if (signif.stars) { res.table <- cbind(res.table, signif) colnames(res.table)[ncol(res.table)] <- "" } for (j in seq_len(nrow(res.table))) { res.table[j, is.na(res.table[j,])] <- ifelse(x$delta.fix[j], "---", "NA") res.table[j, res.table[j,] == "NA"] <- ifelse(x$delta.fix[j], "---", "NA") } if (length(x$delta) == 1L) res.table <- res.table[1,] cat("\n") cat(mstyle$section("Selection Model Results:")) cat("\n\n") if (length(x$delta) == 1L) { tmp <- capture.output(.print.vector(res.table)) } else { tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE, print.gap=2)) } #tmp[1] <- paste0(tmp[1], "\u200b") .print.table(tmp, mstyle) } if (signif.legend || legend) { cat("\n") cat(mstyle$legend("---")) } if (signif.legend) { cat("\n") cat(mstyle$legend("Signif. codes: "), mstyle$legend(attr(signif, "legend"))) cat("\n") } if (inherits(x, "robust.rma") && legend) { cat("\n") cat(mstyle$legend(paste0(footsym[2], " results based on cluster-robust inference (var-cov estimator: ", x$vbest))) if (x$robumethod == "default") { cat(mstyle$legend(",")) cat("\n") cat(mstyle$legend(paste0(" approx ", ifelse(x$int.only, "t-test and confidence interval", "t/F-tests and confidence intervals"), ", df: residual method)"))) } else { if (x$coef_test == "Satterthwaite" && x$conf_test == "Satterthwaite" && x$wald_test == "HTZ") { cat(mstyle$legend(",")) cat("\n") cat(mstyle$legend(paste0(" approx ", ifelse(x$int.only, "t-test and confidence interval", "t/F-tests and confidence intervals"), ", df: Satterthwaite approx)"))) } else { cat(mstyle$legend(")")) } } cat("\n") } .space() invisible() } metafor/R/predict.rma.ls.r0000644000176200001440000004642414430657527015147 0ustar liggesuserspredict.rma.ls <- function(object, newmods, intercept, addx=FALSE, newscale, addz=FALSE, level, digits, transf, targs, vcov=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.ls") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) x <- object if (missing(newmods)) newmods <- NULL if (missing(intercept)) intercept <- x$intercept if (missing(newscale)) newscale <- NULL if (missing(level)) level <- x$level if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL level <- .level(level) ddd <- list(...) .chkdots(ddd, c("pi.type", "newvi")) if (is.null(ddd$pi.type)) { pi.type <- "default" } else { pi.type <- ddd$pi.type pi.type <- tolower(pi.type) } if (!is.null(newmods) && x$int.only && !(x$int.only && identical(newmods, 1))) stop(mstyle$stop("Cannot specify new moderator values for models without moderators.")) if (!is.null(newscale) && x$Z.int.only && !(x$Z.int.only && identical(newscale, 1))) stop(mstyle$stop("Cannot specify new scale values for models without scale variables.")) ######################################################################### if (!is.null(newmods)) { ### if newmods has been specified if (!(.is.vector(newmods) || inherits(newmods, "matrix"))) stop(mstyle$stop(paste0("Argument 'newmods' should be a vector or matrix, but is of class '", class(newmods), "'."))) if ((!x$int.incl && x$p == 1L) || (x$int.incl && x$p == 2L)) { k.new <- length(newmods) # if single moderator (multiple k.new possible) (either without or with intercept in the model) X.new <- cbind(c(newmods)) # } else { # in case the model has more than one predictor: if (.is.vector(newmods) || nrow(newmods) == 1L) { # # if user gives one vector or one row matrix (only one k.new): k.new <- 1 # X.new <- rbind(newmods) # } else { # # if user gives multiple rows and columns (multiple k.new): k.new <- nrow(newmods) # X.new <- cbind(newmods) # } # ### allow matching of terms by names (note: only possible if all columns in X.new and x$X have colnames) if (!is.null(colnames(X.new)) && all(colnames(X.new) != "") && !is.null(colnames(x$X)) && all(colnames(x$X) != "")) { colnames.mod <- colnames(x$X) if (x$int.incl) colnames.mod <- colnames.mod[-1] pos <- sapply(colnames(X.new), function(colname) { d <- c(adist(colname, colnames.mod, costs=c(ins=1, sub=Inf, del=Inf))) # compute edit distances with Inf costs for substitutions/deletions if (all(is.infinite(d))) # if there is no match, then all elements are Inf stop(mstyle$stop(paste0("Could not find variable '", colname, "' in the model.")), call. = FALSE) d <- which(d == min(d)) # don't use which.min() since that only finds the first minimum if (length(d) > 1L) # if there is no unique match, then there is more than one minimum stop(mstyle$stop(paste0("Could not match up variable '", colname, "' uniquely to a variable in the model.")), call. = FALSE) return(d) }) if (anyDuplicated(pos)) { # if the same name is used more than once, then there will be duplicated pos values dups <- paste(unique(colnames(X.new)[duplicated(pos)]), collapse=", ") stop(mstyle$stop(paste0("Found multiple matches for the same variable name (", dups, ")."))) } if (length(pos) != length(colnames.mod)) { no.match <- colnames.mod[seq_along(colnames.mod)[-pos]] if (length(no.match) > 3L) stop(mstyle$stop(paste0("Argument 'newmods' does not specify values for these variables: ", paste0(no.match[1:3], collapse=", "), ", ..."))) if (length(no.match) > 1L) stop(mstyle$stop(paste0("Argument 'newmods' does not specify values for these variables: ", paste0(no.match, collapse=", ")))) if (length(no.match) == 1L) stop(mstyle$stop(paste0("Argument 'newmods' does not specify values for this variable: ", no.match))) } X.new <- X.new[,order(pos),drop=FALSE] colnames(X.new) <- colnames.mod } } if (inherits(X.new[1,1], "character")) stop(mstyle$stop(paste0("Argument 'newmods' should only contain numeric variables."))) ### if the user has specified newmods and an intercept was included in the original model, add the intercept to X.new ### but user can also decide to remove the intercept from the predictions with intercept=FALSE ### one special case: when the location model is an intercept-only model, one can set newmods=1 to obtain the predicted intercept if (x$int.incl && !(x$int.only && ncol(X.new) == 1L && nrow(X.new) == 1L && X.new[1,1] == 1)) { if (intercept) { X.new <- cbind(intrcpt=1, X.new) } else { X.new <- cbind(intrcpt=0, X.new) } } if (ncol(X.new) != x$p) stop(mstyle$stop(paste0("Dimensions of 'newmods' (", ncol(X.new), ") do not match the dimensions of the model (", x$p, ")."))) } if (!is.null(newscale)) { if (!(.is.vector(newscale) || inherits(newscale, "matrix"))) stop(mstyle$stop(paste0("Argument 'newscale' should be a vector or matrix, but is of class '", class(newscale), "'."))) if ((!x$Z.int.incl && x$q == 1L) || (x$Z.int.incl && x$q == 2L)) { Z.k.new <- length(newscale) # if single moderator (multiple k.new possible) (either without or with intercept in the model) Z.new <- cbind(c(newscale)) # } else { # in case the model has more than one predictor: if (.is.vector(newscale) || nrow(newscale) == 1L) { # # if user gives one vector or one row matrix (only one k.new): Z.k.new <- 1 # Z.new <- rbind(newscale) # } else { # # if user gives multiple rows and columns (multiple k.new): Z.k.new <- nrow(newscale) # Z.new <- cbind(newscale) # } # ### allow matching of terms by names (note: only possible if all columns in Z.new and x$Z have colnames) if (!is.null(colnames(Z.new)) && all(colnames(Z.new) != "") && !is.null(colnames(x$Z)) && all(colnames(x$Z) != "")) { colnames.mod <- colnames(x$Z) if (x$Z.int.incl) colnames.mod <- colnames.mod[-1] pos <- sapply(colnames(Z.new), function(colname) { d <- c(adist(colname, colnames.mod, costs=c(ins=1, sub=Inf, del=Inf))) # compute edit distances with Inf costs for substitutions/deletions if (all(is.infinite(d))) # if there is no match, then all elements are Inf stop(mstyle$stop(paste0("Could not find variable '", colname, "' from 'newscale' in the model.")), call. = FALSE) d <- which(d == min(d)) # don't use which.min() since that only finds the first minimum if (length(d) > 1L) # if there is no unique match, then there is more than one minimum stop(mstyle$stop(paste0("Could not match up variable '", colname, "' from 'newscale' uniquely to a variable in the model.")), call. = FALSE) return(d) }) if (anyDuplicated(pos)) { # if the same name is used more than once, then there will be duplicated pos values dups <- paste(unique(colnames(Z.new)[duplicated(pos)]), collapse=", ") stop(mstyle$stop(paste0("Found multiple matches for the same variable name (", dups, ") in 'newscale'."))) } if (length(pos) != length(colnames.mod)) { no.match <- colnames.mod[seq_along(colnames.mod)[-pos]] if (length(no.match) > 3L) stop(mstyle$stop(paste0("Argument 'newscale' does not specify values for these variables: ", paste0(no.match[1:3], collapse=", "), ", ..."))) if (length(no.match) > 1L) stop(mstyle$stop(paste0("Argument 'newscale' does not specify values for these variables: ", paste0(no.match, collapse=", ")))) if (length(no.match) == 1L) stop(mstyle$stop(paste0("Argument 'newscale' does not specify values for this variable: ", no.match))) } Z.new <- Z.new[,order(pos),drop=FALSE] colnames(Z.new) <- colnames.mod } } if (inherits(Z.new[1,1], "character")) stop(mstyle$stop(paste0("Argument 'newscale' should only contain numeric variables."))) ### if the user has specified newscale and an intercept was included in the original model, add the intercept to Z.new ### but user can also decide to remove the intercept from the predictions with intercept=FALSE (only when predicting log(tau^2)) ### one special case: when the scale model is an intercept-only model, one can set newscale=1 to obtain the predicted intercept ### (which can be converted to tau^2 with transf=exp when using a log link) if (x$Z.int.incl && !(x$Z.int.only && ncol(Z.new) == 1L && nrow(Z.new) == 1L && Z.new[1,1] == 1)) { if (is.null(newmods)) { if (intercept) { Z.new <- cbind(intrcpt=1, Z.new) } else { Z.new <- cbind(intrcpt=0, Z.new) } } else { Z.new <- cbind(intrcpt=1, Z.new) } } if (ncol(Z.new) != x$q) stop(mstyle$stop(paste0("Dimensions of 'newscale' (", ncol(Z.new), ") do not match the dimensions of the scale model (", x$q, ")."))) } # four possibilities for location-scale models: # 1) newmods not specified, newscale not specified: get the fitted values of the studies and ci/pi bounds thereof # 2) newmods specified, newscale not specified: get the predicted mu values for these newmods values and ci bounds thereof # (note: cannot compute pi bounds, since the tau^2 values cannot be predicted) # 3) newmods not specified, newscale specified: get the predicted log(tau^2) (or tau^2) values and ci bounds thereof # (transf=exp to obtain predicted tau^2 values when using the default log link) # 4) newmods specified, newscale specified: get the predicted mu values for these newmods values and ci/pi bounds thereof pred.mui <- TRUE if (is.null(newmods)) { if (is.null(newscale)) { k.new <- x$k.f X.new <- x$X.f Z.new <- x$Z.f tau2.f <- x$tau2.f } else { k.new <- Z.k.new addx <- FALSE pred.mui <- FALSE } } else { if (is.null(newscale)) { Z.new <- matrix(NA_real_, nrow=k.new, ncol=x$q) tau2.f <- rep(NA_real_, k.new) addz <- FALSE } else { tau2.f <- rep(NA_real_, Z.k.new) for (i in seq_len(Z.k.new)) { Zi.new <- Z.new[i,,drop=FALSE] tau2.f[i] <- Zi.new %*% x$alpha } if (x$link == "log") { tau2.f <- exp(tau2.f) } else { if (any(tau2.f < 0)) { warning(mstyle$warning(paste0("Negative predicted 'tau2' values constrained to 0.")), call.=FALSE) tau2.f[tau2.f < 0] <- 0 } } if (length(tau2.f) == 1L) { Z.new <- Z.new[rep(1,k.new),,drop=FALSE] tau2.f <- rep(tau2.f, k.new) } if (length(tau2.f) != k.new) stop(mstyle$stop(paste0("Dimensions of 'newmods' (", k.new, ") do not match dimensions of newscale (", length(tau2.f), ")."))) } } #return(list(k.new=k.new, tau2=x$tau2, gamma2=x$gamma2, tau2.levels=tau2.levels, gamma2.levels=gamma2.levels)) ######################################################################### ### predicted values, SEs, and confidence intervals pred <- rep(NA_real_, k.new) vpred <- rep(NA_real_, k.new) if (pred.mui) { ddf <- ifelse(is.na(x$ddf), x$k - x$p, x$ddf) for (i in seq_len(k.new)) { Xi.new <- X.new[i,,drop=FALSE] pred[i] <- Xi.new %*% x$beta vpred[i] <- Xi.new %*% tcrossprod(x$vb, Xi.new) } if (is.element(x$test, c("knha","adhoc","t"))) { crit <- if (ddf > 0) qt(level/2, df=ddf, lower.tail=FALSE) else NA_real_ } else { crit <- qnorm(level/2, lower.tail=FALSE) } } else { ddf <- ifelse(is.na(x$ddf.alpha), x$k - x$q, x$ddf.alpha) for (i in seq_len(k.new)) { Zi.new <- Z.new[i,,drop=FALSE] pred[i] <- Zi.new %*% x$alpha vpred[i] <- Zi.new %*% tcrossprod(x$va, Zi.new) } if (is.element(x$test, c("knha","adhoc","t"))) { crit <- if (ddf > 0) qt(level/2, df=ddf, lower.tail=FALSE) else NA_real_ } else { crit <- qnorm(level/2, lower.tail=FALSE) } } vpred[vpred < 0] <- NA_real_ se <- sqrt(vpred) ci.lb <- pred - crit * se ci.ub <- pred + crit * se ######################################################################### if (pred.mui) { if (vcov) vcovpred <- X.new %*% x$vb %*% t(X.new) if (pi.type == "simple") { crit <- qnorm(level/2, lower.tail=FALSE) vpred <- 0 } pi.ddf <- ddf if (is.element(pi.type, c("riley","t"))) { if (pi.type == "riley") pi.ddf <- x$k - x$p - x$q if (pi.type == "t") pi.ddf <- x$k - x$p pi.ddf[pi.ddf < 1] <- 1 crit <- qt(level/2, df=pi.ddf, lower.tail=FALSE) } if (is.null(ddd$newvi)) { newvi <- 0 } else { newvi <- ddd$newvi if (length(newvi) == 1L) newvi <- rep(newvi, k.new) if (length(newvi) != k.new) stop(mstyle$stop(paste0("Length of 'newvi' argument (", length(newvi), ") does not match the number of predicted values (", k.new, ")."))) } ### prediction intervals pi.lb <- pred - crit * sqrt(vpred + tau2.f + newvi) pi.ub <- pred + crit * sqrt(vpred + tau2.f + newvi) } else { if (vcov) vcovpred <- Z.new %*% x$va %*% t(Z.new) pi.lb <- NA_real_ pi.ub <- NA_real_ } ######################################################################### ### apply transformation function if one has been specified if (is.function(transf)) { if (is.null(targs)) { pred <- sapply(pred, transf) se <- rep(NA_real_, k.new) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) pi.lb <- sapply(pi.lb, transf) pi.ub <- sapply(pi.ub, transf) } else { pred <- sapply(pred, transf, targs) se <- rep(NA_real_, k.new) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) pi.lb <- sapply(pi.lb, transf, targs) pi.ub <- sapply(pi.ub, transf, targs) } do.transf <- TRUE } else { do.transf <- FALSE } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] tmp <- .psort(pi.lb, pi.ub) pi.lb <- tmp[,1] pi.ub <- tmp[,2] ### when predicting tau^2 values, set negative tau^2 values and CI bounds to 0 if (!pred.mui && x$link=="identity" && !is.function(transf)) { if (any(pred < 0)) warning(mstyle$warning(paste0("Negative predicted 'tau2' values constrained to 0.")), call.=FALSE) pred[pred < 0] <- 0 ci.lb[ci.lb < 0] <- 0 ci.ub[ci.ub < 0] <- 0 } ### use study labels from the object when the model has moderators and no new moderators have been specified if (pred.mui) { if (is.null(newmods)) { slab <- x$slab } else { slab <- seq_len(k.new) } } else { if (is.null(newscale)) { slab <- x$slab } else { slab <- seq_len(k.new) } } ### add row/colnames to vcovpred if (vcov) rownames(vcovpred) <- colnames(vcovpred) <- slab ### but when predicting just a single value, use "" as study label if (k.new == 1L) slab <- "" ### handle NAs not.na <- rep(TRUE, k.new) if (na.act == "na.omit") { if (pred.mui) { if (is.null(newmods)) { not.na <- x$not.na } else { not.na <- !is.na(pred) } } else { if (is.null(newscale)) { not.na <- x$not.na } else { not.na <- !is.na(pred) } } } if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) out <- list(pred=pred[not.na], se=se[not.na], ci.lb=ci.lb[not.na], ci.ub=ci.ub[not.na], pi.lb=pi.lb[not.na], pi.ub=pi.ub[not.na], cr.lb=pi.lb[not.na], cr.ub=pi.ub[not.na]) if (vcov) vcovpred <- vcovpred[not.na,not.na,drop=FALSE] if (na.act == "na.exclude" && is.null(newmods)) { out <- lapply(out, function(val) ifelse(x$not.na, val, NA_real_)) if (vcov) { vcovpred[!x$not.na,] <- NA_real_ vcovpred[,!x$not.na] <- NA_real_ } } ### add X matrix to list if (addx) { out$X <- matrix(X.new[not.na,], ncol=x$p) colnames(out$X) <- colnames(x$X) } ### add Z matrix to list if (addz) { out$Z <- matrix(Z.new[not.na,], ncol=x$q) colnames(out$Z) <- colnames(x$Z) } ### add slab values to list out$slab <- slab[not.na] ### for FE/EE/CE models, remove the columns corresponding to the prediction interval bounds if (is.element(x$method, c("FE","EE","CE")) || !pred.mui) { out$cr.lb <- NULL out$cr.ub <- NULL out$pi.lb <- NULL out$pi.ub <- NULL } out$digits <- digits out$method <- x$method out$transf <- do.transf out$pred.type <- ifelse(pred.mui, "location", "scale") if (x$test != "z") out$ddf <- ddf if (pred.mui && (x$test != "z" || is.element(pi.type, c("riley","t"))) && pi.type != "simple") out$pi.ddf <- pi.ddf class(out) <- c("predict.rma", "list.rma") if (vcov & !do.transf) { out <- list(pred=out) out$vcov <- vcovpred } return(out) } metafor/R/weights.rma.mv.r0000644000176200001440000000367114204412667015161 0ustar liggesusersweights.rma.mv <- function(object, type="diagonal", ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.mv") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) type <- match.arg(type, c("diagonal", "matrix", "rowsum")) x <- object ######################################################################### if (is.null(x$W)) { W <- chol2inv(chol(x$M)) } else { W <- x$W } ######################################################################### if (type == "diagonal") { wi <- as.vector(diag(W)) weight <- rep(NA_real_, x$k.f) weight[x$not.na] <- wi / sum(wi) * 100 names(weight) <- x$slab if (na.act == "na.omit") weight <- weight[x$not.na] if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in weights.")) return(weight) } if (type == "matrix") { Wfull <- matrix(NA_real_, nrow=x$k.f, ncol=x$k.f) Wfull[x$not.na, x$not.na] <- as.matrix(W) # as.matrix() needed when sparse=TRUE rownames(Wfull) <- x$slab colnames(Wfull) <- x$slab if (na.act == "na.omit") Wfull <- Wfull[x$not.na, x$not.na, drop=FALSE] if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) return(Wfull) } if (type == "rowsum") { if (!x$int.only) stop("Row-sum weights are only meaningful for intercept-only models.") wi <- rowSums(W) weight <- rep(NA_real_, x$k.f) weight[x$not.na] <- wi / sum(wi) * 100 names(weight) <- x$slab if (na.act == "na.omit") weight <- weight[x$not.na] if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in weights.")) return(weight) } } metafor/R/confint.rma.peto.r0000644000176200001440000000364014160126153015461 0ustar liggesusersconfint.rma.peto <- function(object, parm, level, digits, transf, targs, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.peto") if (!missing(parm)) warning(mstyle$warning("Argument 'parm' (currently) ignored."), call.=FALSE) x <- object if (missing(level)) level <- x$level if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL ddd <- list(...) .chkdots(ddd, c("time")) if (.isTRUE(ddd$time)) time.start <- proc.time() ######################################################################### level <- .level(level) crit <- qnorm(level/2, lower.tail=FALSE) beta <- x$beta ci.lb <- beta - crit * x$se ci.ub <- beta + crit * x$se ### if requested, apply transformation function if (.isTRUE(transf)) ### if transf=TRUE, apply exp transformation to ORs transf <- exp if (is.function(transf)) { if (is.null(targs)) { beta <- sapply(beta, transf) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) } else { beta <- sapply(beta, transf, targs) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) } } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] ######################################################################### res <- cbind(estimate=beta, ci.lb, ci.ub) res <- list(fixed=res) rownames(res$fixed) <- "" res$digits <- digits if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(res) <- "confint.rma" return(res) } metafor/R/plot.rma.mh.r0000644000176200001440000000412314465421611014436 0ustar liggesusersplot.rma.mh <- function(x, qqplot=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.mh") na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) .start.plot() par.mfrow <- par("mfrow") par(mfrow=c(2,2)) on.exit(par(mfrow = par.mfrow), add=TRUE) bg <- .coladj(par("bg","fg"), dark=0.35, light=-0.35) col.na <- .coladj(par("bg","fg"), dark=0.2, light=-0.2) ######################################################################### forest(x, ...) title("Forest Plot", ...) ######################################################################### funnel(x, ...) title("Funnel Plot", ...) ######################################################################### radial(x, ...) title("Radial Plot", ...) ######################################################################### if (qqplot) { qqnorm(x, ...) } else { options(na.action = "na.pass") z <- rstandard(x)$z options(na.action = na.act) not.na <- !is.na(z) if (na.act == "na.omit") { z <- z[not.na] ids <- x$ids[not.na] not.na <- not.na[not.na] } if (na.act == "na.exclude" || na.act == "na.pass") ids <- x$ids k <- length(z) plot(NA, NA, xlim=c(1,k), ylim=c(min(z, -2, na.rm=TRUE), max(z, 2, na.rm=TRUE)), xaxt="n", xlab="Study", ylab="", bty="l", ...) lines(seq_len(k)[not.na], z[not.na], col=col.na, ...) lines(seq_len(k), z, ...) points(x=seq_len(k), y=z, pch=21, bg=bg, ...) axis(side=1, at=seq_len(k), labels=ids, ...) abline(h=0, lty="dashed", ...) abline(h=c(qnorm(.025),qnorm(.975)), lty="dotted", ...) title("Standardized Residuals", ...) } ######################################################################### invisible() } metafor/R/update.rma.r0000644000176200001440000000302614305423114014331 0ustar liggesusers### based on stats:::update.default but with some adjustments update.rma <- function(object, formula., ..., evaluate=TRUE) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma", notav="robust.rma") if (is.null(call <- getCall(object))) stop(mstyle$stop("Need an object with call component.")) extras <- match.call(expand.dots = FALSE)$... if (!missing(formula.)) { if (inherits(object, c("rma.uni","rma.mv"))) { if (inherits(object$call$yi, "call")) { call$yi <- update.formula(object$call$yi, formula.) } else { if (is.null(object$call$mods)) { object$call$mods <- ~ 1 call$mods <- update.formula(object$call$mods, formula.) } else { if (!any(grepl("~", object$call$mods))) { stop(mstyle$stop("The 'mods' argument in 'object' must be a formula for updating to work.")) } else { call$mods <- update.formula(object$call$mods, formula.) } } } } if (inherits(object, "rma.glmm")) call$mods <- update.formula(object$call$mods, formula.) } if (length(extras)) { existing <- !is.na(match(names(extras), names(call))) for (a in names(extras)[existing]) call[[a]] <- extras[[a]] if (any(!existing)) { call <- c(as.list(call), extras[!existing]) call <- as.call(call) } } if (evaluate) eval(call, parent.frame()) else call } metafor/R/print.fsn.r0000644000176200001440000000612714475640273014236 0ustar liggesusersprint.fsn <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="fsn") digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) .space() cat(mstyle$section(paste("Fail-safe N Calculation Using the", x$type, "Approach"))) cat("\n\n") if (x$type == "Rosenthal" || x$type == "Binomial") { cat(mstyle$text("Observed Significance Level: ")) cat(mstyle$result(fmtp(x$pval, digits[["pval"]]))) cat("\n") cat(mstyle$text("Target Significance Level: ")) cat(mstyle$result(round(x$alpha, digits[["pval"]]))) } if (x$type == "Orwin") { cat(mstyle$text("Average Effect Size: ")) cat(mstyle$result(fmtx(x$est, digits[["est"]]))) cat("\n") cat(mstyle$text("Target Effect Size: ")) cat(mstyle$result(fmtx(x$target, digits[["est"]]))) } if (x$type == "Rosenberg") { flag.left <- ifelse(isTRUE(x$est < 0), " ", "") cat(mstyle$text("Average Effect Size: ")) cat(mstyle$result(fmtx(x$est, digits[["est"]], flag=flag.left))) cat("\n") cat(mstyle$text("Observed Significance Level: ")) cat(flag.left) cat(mstyle$result(fmtp(x$pval, digits[["pval"]]))) cat("\n") cat(mstyle$text("Target Significance Level: ")) cat(flag.left) cat(mstyle$result(round(x$alpha, digits[["pval"]]))) } if (x$type == "General") { flag.left <- ifelse(isTRUE(x$est < 0), " ", "") flag.right <- ifelse(isTRUE(x$est.fsn < 0), " ", "") cat(mstyle$text("Average Effect Size: ")) cat(mstyle$result(fmtx(x$est, digits[["est"]], flag=flag.left))) if (x$fsnum > 0) { cat(mstyle$text(" (with file drawer: ")) cat(mstyle$result(fmtx(x$est.fsn, digits[["est"]], flag=flag.right))) cat(mstyle$text(")")) } cat("\n") if (!is.element(x$method, c("FE","EE","CE"))) { cat(mstyle$text("Amount of Heterogeneity: ")) cat(mstyle$result(fmtx(x$tau2, digits[["var"]], flag=flag.left))) if (x$fsnum > 0) { cat(mstyle$text(" (with file drawer: ")) cat(mstyle$result(fmtx(x$tau2.fsn, digits[["var"]], flag=flag.right))) cat(mstyle$text(")")) } cat("\n") } cat(mstyle$text("Observed Significance Level: ")) cat(flag.left) cat(mstyle$result(fmtp(x$pval, digits[["pval"]]))) if (x$fsnum > 0) { cat(mstyle$text(" (with file drawer: ")) cat(flag.right) cat(mstyle$result(fmtp(x$pval.fsn, digits[["pval"]]))) cat(mstyle$text(")")) } cat("\n") if (is.na(x$target)) { cat(mstyle$text("Target Significance Level: ")) cat(flag.left) cat(mstyle$result(round(x$alpha, digits[["pval"]]))) } else { cat(mstyle$text("Target Effect Size: ")) cat(mstyle$result(fmtx(x$target, digits[["est"]], , flag=flag.left))) } } cat("\n\n") cat(mstyle$text("Fail-safe N: ")) cat(mstyle$result(paste0(x$ub.sign, x$fsnum))) cat("\n") .space() invisible() } metafor/R/rma.glmm.r0000644000176200001440000035110014434105430014003 0ustar liggesusersrma.glmm <- function(ai, bi, ci, di, n1i, n2i, x1i, x2i, t1i, t2i, xi, mi, ti, ni, mods, measure, intercept=TRUE, data, slab, subset, add=1/2, to="only0", drop00=TRUE, vtype="LS", model="UM.FS", method="ML", coding=1/2, cor=FALSE, test="z", level=95, btt, nAGQ=7, verbose=FALSE, digits, control, ...) { ######################################################################### ###### setup mstyle <- .get.mstyle("crayon" %in% .packages()) ### check argument specifications ### (arguments "to" and "vtype" are checked inside escalc function) if (missing(measure)) stop(mstyle$stop("Must specify 'measure' argument.")) if (!is.element(measure, c("OR","IRR","PLO","IRLN", "PR","RR","RD","PLN"))) stop(mstyle$stop("Unknown 'measure' specified.")) if (!is.element(method, c("FE","EE","CE","ML"))) stop(mstyle$stop("Unknown 'method' specified.")) if (!is.element(coding, c(1/2, 1, 0))) stop(mstyle$stop("Unknown 'coding' option specified.")) ### in case user specifies more than one add/to value (as one can do with rma.mh() and rma.peto()) ### (never apply any kind of continuity correction to the data used in the actual model fitting for models implemented in this function) if (length(add) > 1L) add <- add[1] if (length(to) > 1L) to <- to[1] ### model argument only relevant for 2x2 table data (measure="OR") and for 2-group rate data (measure="IRR") ### UM.FS/UM.RS = unconditional GLMM with fixed/random study effects (logistic or poisson mixed-effects model with fixed/random intercepts) ### CM.EL/CM.AL = conditional GLMM (exact/approximate) (hypergeometric or conditional logistic model) ### BV/MV = bi/multivariate model (logistic or poisson mixed-effects model with unstructured covariance matrix) -- not implemented if (!is.element(model, c("UM.FS","UM.RS","CM.EL","CM.AL"))) stop(mstyle$stop("Unknown 'model' specified.")) ### no need for CM.AL for IRR -- use CM.EL if (model == "CM.AL" && measure == "IRR") model <- "CM.EL" ### check if user changed model for measures where this is not relevant; if so, issue a warning if (is.element(measure, c("PLO","PR","PLN","IRLN")) && !is.null(match.call()$model)) warning(mstyle$warning("Argument 'model' not relevant for this outcome measure."), call.=FALSE) ### warning about experimental measures if (!is.element(measure, c("OR","IRR","PLO","IRLN"))) warning(mstyle$warning("The use of this 'measure' is experimental - treat results with caution."), call.=FALSE) if (is.element(model, c("CM.EL","CM.AL")) && is.element(measure, c("RR","RD"))) stop(mstyle$stop("Cannot use this measure with model='CM.EL' or model='CM.AL'.")) na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (missing(control)) control <- list() time.start <- proc.time() ### get ... argument and check for extra/superfluous arguments ddd <- list(...) .chkdots(ddd, c("tdist", "outlist", "onlyo1", "addyi", "addvi", "time", "retdat", "family", "retfit", "skiphet", "i2def", "link")) ### handle 'tdist' argument from ... (note: overrides test argument) if (.isFALSE(ddd$tdist)) test <- "z" if (.isTRUE(ddd$tdist)) test <- "t" if (!is.element(test, c("z", "t"))) stop(mstyle$stop("Invalid option selected for 'test' argument.")) ### set defaults or get onlyo1, addyi, and addvi arguments onlyo1 <- ifelse(is.null(ddd$onlyo1), FALSE, ddd$onlyo1) addyi <- ifelse(is.null(ddd$addyi), TRUE, ddd$addyi) addvi <- ifelse(is.null(ddd$addvi), TRUE, ddd$addvi) ### set default for i2def i2def <- ifelse(is.null(ddd$i2def), "1", ddd$i2def) ### set defaults for digits if (missing(digits)) { digits <- .set.digits(dmiss=TRUE) } else { digits <- .set.digits(digits, dmiss=FALSE) } ### set default for formula.mods formula.mods <- NULL ### set options(warn=1) if verbose > 2 if (verbose > 2) { opwarn <- options(warn=1) on.exit(options(warn=opwarn$warn), add=TRUE) } if (is.null(ddd$link)) { if (measure=="OR" || measure=="PLO") link <- "logit" if (measure=="RR" || measure=="PLN") link <- "log" if (measure=="RD" || measure=="PR") link <- "identity" if (measure=="IRR" || measure=="IRLN") link <- "log" } else { link <- ddd$link } ######################################################################### if (verbose) .space() if (verbose > 1) message(mstyle$message("Extracting data and computing yi/vi values ...")) ### check if data argument has been specified if (missing(data)) data <- NULL if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } mf <- match.call() ### extract slab, subset, and mods values, possibly from the data frame specified via data (arguments not specified are NULL) slab <- .getx("slab", mf=mf, data=data) subset <- .getx("subset", mf=mf, data=data) mods <- .getx("mods", mf=mf, data=data) ai <- bi <- ci <- di <- x1i <- x2i <- t1i <- t2i <- xi <- mi <- ti <- NA_real_ ### calculate yi and vi values if (is.element(measure, c("OR","RR","RD"))) { ai <- .getx("ai", mf=mf, data=data, checknumeric=TRUE) bi <- .getx("bi", mf=mf, data=data, checknumeric=TRUE) ci <- .getx("ci", mf=mf, data=data, checknumeric=TRUE) di <- .getx("di", mf=mf, data=data, checknumeric=TRUE) n1i <- .getx("n1i", mf=mf, data=data, checknumeric=TRUE) n2i <- .getx("n2i", mf=mf, data=data, checknumeric=TRUE) if (is.null(bi)) bi <- n1i - ai if (is.null(di)) di <- n2i - ci k <- length(ai) # number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) ai <- .getsubset(ai, subset) bi <- .getsubset(bi, subset) ci <- .getsubset(ci, subset) di <- .getsubset(di, subset) } args <- list(measure=measure, ai=ai, bi=bi, ci=ci, di=di, add=add, to=to, drop00=drop00, vtype=vtype, onlyo1=onlyo1, addyi=addyi, addvi=addvi) } if (is.element(measure, c("IRR"))) { x1i <- .getx("x1i", mf=mf, data=data, checknumeric=TRUE) x2i <- .getx("x2i", mf=mf, data=data, checknumeric=TRUE) t1i <- .getx("t1i", mf=mf, data=data, checknumeric=TRUE) t2i <- .getx("t2i", mf=mf, data=data, checknumeric=TRUE) k <- length(x1i) # number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) x1i <- .getsubset(x1i, subset) x2i <- .getsubset(x2i, subset) t1i <- .getsubset(t1i, subset) t2i <- .getsubset(t2i, subset) } args <- list(measure=measure, x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, add=add, to=to, drop00=drop00, vtype=vtype, onlyo1=onlyo1, addyi=addyi, addvi=addvi) } if (is.element(measure, c("PLO","PR","PLN"))) { xi <- .getx("xi", mf=mf, data=data, checknumeric=TRUE) mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) if (is.null(mi)) mi <- ni - xi k <- length(xi) # number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) xi <- .getsubset(xi, subset) mi <- .getsubset(mi, subset) } args <- list(measure=measure, xi=xi, mi=mi, add=add, to=to, vtype=vtype, onlyo1=onlyo1, addyi=addyi, addvi=addvi) } if (is.element(measure, c("IRLN"))) { xi <- .getx("xi", mf=mf, data=data, checknumeric=TRUE) ti <- .getx("ti", mf=mf, data=data, checknumeric=TRUE) k <- length(xi) # number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) xi <- .getsubset(xi, subset) ti <- .getsubset(ti, subset) } args <- list(measure=measure, xi=xi, ti=ti, add=add, to=to, vtype=vtype, onlyo1=onlyo1, addyi=addyi, addvi=addvi) } dat <- .do.call(escalc, args) yi <- dat$yi # one or more yi/vi pairs may be NA/NA (note: yi/vi pairs that are NA/NA may still have 'valid' table data) vi <- dat$vi # one or more yi/vi pairs may be NA/NA (note: yi/vi pairs that are NA/NA may still have 'valid' table data) ni <- attr(yi, "ni") # unadjusted total sample sizes (ni.u in escalc) ### study ids (1:k sequence before subsetting) ids <- seq_len(k) ######################################################################### if (verbose > 1) message(mstyle$message("Creating model matrix ...")) ### convert mods formula to X matrix and set intercept equal to FALSE if (inherits(mods, "formula")) { formula.mods <- mods if (isTRUE(all.equal(formula.mods, ~ 1))) { # needed so 'mods = ~ 1' without 'data' specified works mods <- matrix(1, nrow=k, ncol=1) intercept <- FALSE } else { options(na.action = "na.pass") # set na.action to na.pass, so that NAs are not filtered out (we'll do that later) mods <- model.matrix(mods, data=data) # extract model matrix attr(mods, "assign") <- NULL # strip assign attribute (not needed at the moment) options(na.action = na.act) # set na.action back to na.act intercept <- FALSE # set to FALSE since formula now controls whether the intercept is included or not } } ### turn a vector for mods into a column vector if (.is.vector(mods)) mods <- cbind(mods) ### turn a mods data frame into a matrix if (is.data.frame(mods)) mods <- as.matrix(mods) ### check if model matrix contains character variables if (is.character(mods)) stop(mstyle$stop("Model matrix contains character variables.")) ### check if mods matrix has the right number of rows if (!is.null(mods) && nrow(mods) != k) stop(mstyle$stop(paste0("Number of rows in the model matrix (", nrow(mods), ") does not match length of the outcome vector (", k, ")."))) ### generate study labels if none are specified if (verbose > 1) message(mstyle$message("Generating/extracting study labels ...")) if (is.null(slab)) { slab.null <- TRUE slab <- ids } else { if (anyNA(slab)) stop(mstyle$stop("NAs in study labels.")) if (length(slab) != k) stop(mstyle$stop("Study labels not of same length as data.")) if (is.factor(slab)) slab <- as.character(slab) slab.null <- FALSE } ### if a subset of studies is specified (note: tables, yi/vi, and ni are already subsetted above) if (!is.null(subset)) { if (verbose > 1) message(mstyle$message("Subsetting ...")) mods <- .getsubset(mods, subset) slab <- .getsubset(slab, subset) ids <- .getsubset(ids, subset) } ### check if study labels are unique; if not, make them unique if (anyDuplicated(slab)) slab <- .make.unique(slab) ### add slab attribute back attr(yi, "slab") <- slab k <- length(yi) # number of tables/outcomes after subsetting (can all still include NAs) ### if drop00=TRUE, set counts to NA for studies that have no events (or all events) in both arms (corresponding yi/vi will also be NA/NA then) if (is.element(measure, c("OR","RR","RD"))) { if (drop00) { id00 <- c(ai == 0L & ci == 0L) | c(bi == 0L & di == 0L) id00[is.na(id00)] <- FALSE ai[id00] <- NA_real_ bi[id00] <- NA_real_ ci[id00] <- NA_real_ di[id00] <- NA_real_ } } if (is.element(measure, c("IRR"))) { if (drop00) { id00 <- c(x1i == 0L & x2i == 0L) id00[is.na(id00)] <- FALSE x1i[id00] <- NA_real_ x2i[id00] <- NA_real_ } } ### save full data (including potential NAs in table data, yi/vi/ni/mods) (after subsetting) outdat.f <- list(ai=ai, bi=bi, ci=ci, di=di, x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, xi=xi, mi=mi, ni=ni, ti=ti) yi.f <- yi vi.f <- vi ni.f <- ni mods.f <- mods k.f <- k # total number of tables/outcomes and rows in the model matrix (including all NAs) ### check for NAs in tables (and corresponding mods) and act accordingly if (is.element(measure, c("OR","RR","RD"))) { has.na <- is.na(ai) | is.na(bi) | is.na(ci) | is.na(di) | (if (is.null(mods)) FALSE else apply(is.na(mods), 1, any)) not.na <- !has.na if (any(has.na)) { if (verbose > 1) message(mstyle$message("Handling NAs in table data ...")) if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { ai <- ai[not.na] bi <- bi[not.na] ci <- ci[not.na] di <- di[not.na] mods <- mods[not.na,,drop=FALSE] k <- length(ai) warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "studies", "study"), "with NAs omitted from model fitting.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in studies.")) } } if (is.element(measure, "IRR")) { has.na <- is.na(x1i) | is.na(x2i) | is.na(t1i) | is.na(t2i) | (if (is.null(mods)) FALSE else apply(is.na(mods), 1, any)) not.na <- !has.na if (any(has.na)) { if (verbose > 1) message(mstyle$message("Handling NAs in table data ...")) if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { x1i <- x1i[not.na] x2i <- x2i[not.na] t1i <- t1i[not.na] t2i <- t2i[not.na] mods <- mods[not.na,,drop=FALSE] k <- length(x1i) warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "studies", "study"), "with NAs omitted from model fitting.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in studies.")) } } if (is.element(measure, c("PLO","PR","PLN"))) { has.na <- is.na(xi) | is.na(mi) | (if (is.null(mods)) FALSE else apply(is.na(mods), 1, any)) not.na <- !has.na if (any(has.na)) { if (verbose > 1) message(mstyle$message("Handling NAs in table data ...")) if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { xi <- xi[not.na] mi <- mi[not.na] mods <- mods[not.na,,drop=FALSE] k <- length(xi) warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "studies", "study"), "with NAs omitted from model fitting.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in studies.")) } } if (is.element(measure, "IRLN")) { has.na <- is.na(xi) | is.na(ti) | (if (is.null(mods)) FALSE else apply(is.na(mods), 1, any)) not.na <- !has.na if (any(has.na)) { if (verbose > 1) message(mstyle$message("Handling NAs in table data ...")) if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { xi <- xi[not.na] ti <- ti[not.na] mods <- mods[not.na,,drop=FALSE] k <- length(xi) warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "studies", "study"), "with NAs omitted from model fitting.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in studies.")) } } ### note: k = number of tables (and corresponding rows of 'mods') after removing NAs ### k.f = total number of tables/outcomes and rows in the model matrix (including all NAs) stored in .f elements ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### check for NAs in yi/vi and act accordingly (yi/vi pair can be NA/NA if add=0 is used) ### note: if a table was removed because of NAs in mods, must also remove the corresponding yi/vi pair; ### also, must use mods.f here, since NAs in mods were already removed above (and need a separate ### mods.yi element, so that dimensions of the model matrix and vi are guaranteed to match up) mods.yi <- mods.f yivi.na <- is.na(yi) | is.na(vi) | (if (is.null(mods.yi)) FALSE else apply(is.na(mods.yi), 1, any)) not.na.yivi <- !yivi.na if (any(yivi.na)) { if (verbose > 1) message(mstyle$message("Handling NAs in yi/vi ...")) if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { yi <- yi[not.na.yivi] ni <- ni[not.na.yivi] vi <- vi[not.na.yivi] mods.yi <- mods.f[not.na.yivi,,drop=FALSE] warning(mstyle$warning("Some yi/vi values are NA."), call.=FALSE) attr(yi, "measure") <- measure # add measure attribute back attr(yi, "ni") <- ni # add ni attribute back } if (na.act == "na.fail") stop(mstyle$stop("Missing yi/vi values.")) } k.yi <- length(yi) # number of yi/vi pairs that are not NA ### make sure that there is at least one column in X if (is.null(mods) && !intercept) { warning(mstyle$warning("Must either include an intercept and/or moderators in model.\nCoerced intercept into the model."), call.=FALSE) intercept <- TRUE } if (!is.null(mods) && ncol(mods) == 0L) { warning(mstyle$warning("Cannot fit model with an empty model matrix. Coerced intercept into the model."), call.=FALSE) intercept <- TRUE } ### add vector of 1s to the X matrix for the intercept (if intercept=TRUE) if (intercept) { X <- cbind(intrcpt=rep(1,k), mods) X.f <- cbind(intrcpt=rep(1,k.f), mods.f) X.yi <- cbind(intrcpt=rep(1,k.yi), mods.yi) } else { X <- mods X.f <- mods.f X.yi <- mods.yi } ### drop redundant predictors ### note: yi may have become shorter than X due to the omission of NAs, so just use a fake yi vector here tmp <- lm(rep(0,k) ~ X - 1) coef.na <- is.na(coef(tmp)) if (any(coef.na)) { warning(mstyle$warning("Redundant predictors dropped from the model."), call.=FALSE) X <- X[,!coef.na,drop=FALSE] X.f <- X.f[,!coef.na,drop=FALSE] } ### need to do this separately for X.yi, since model matrix may have fewer rows due to removal of NA/NA pairs for yi/vi tmp <- lm(yi ~ X.yi - 1) coef.na <- is.na(coef(tmp)) if (any(coef.na)) X.yi <- X.yi[,!coef.na,drop=FALSE] ### check whether intercept is included and if yes, move it to the first column (NAs already removed, so na.rm=TRUE for any() not necessary) is.int <- apply(X, 2, .is.intercept) if (any(is.int)) { int.incl <- TRUE int.indx <- which(is.int, arr.ind=TRUE) X <- cbind(intrcpt=1, X[,-int.indx, drop=FALSE]) # note: this removes any duplicate intercepts X.f <- cbind(intrcpt=1, X.f[,-int.indx, drop=FALSE]) # note: this removes any duplicate intercepts intercept <- TRUE # set intercept appropriately so that the predict() function works } else { int.incl <- FALSE } ### need to do this separately for X.yi, since model matrix may have fewer rows due to removal of NA/NA pairs for yi/vi is.int <- apply(X.yi, 2, .is.intercept) if (any(is.int)) { int.indx <- which(is.int, arr.ind=TRUE) X.yi <- cbind(intrcpt=1, X.yi[,-int.indx, drop=FALSE]) # note: this removes any duplicate intercepts } p <- NCOL(X) # number of columns in X (including the intercept if it is included) ### note: number of columns in X.yi may be lower than p; but computation of I^2 below is based on p ### make sure variable names in X are unique colnames(X) <- colnames(X.f) <- .make.unique(colnames(X)) ### check whether this is an intercept-only model if ((p == 1L) && .is.intercept(X)) { int.only <- TRUE } else { int.only <- FALSE } ### check if there are too many parameters for given k if (is.element(method, c("FE","EE","CE")) && p > k) stop(mstyle$stop("Number of parameters to be estimated is larger than the number of observations.")) if (!is.element(method, c("FE","EE","CE")) && (p+1) > k) stop(mstyle$stop("Number of parameters to be estimated is larger than the number of observations.")) ### set/check 'btt' argument btt <- .set.btt(btt, p, int.incl, colnames(X)) m <- length(btt) # number of betas to test (m = p if all betas are tested) ######################################################################### ### set default control parameters con <- list(verbose = FALSE, # also passed on to glm/glmer/optim/nlminb/minqa (uobyqa/newuoa/bobyqa) package="lme4", # package for fitting logistic mixed-effects models ("lme4", "GLMMadaptive", "glmmTMB") optimizer = "nlminb", # optimizer to use for CM.EL+OR ("optim","nlminb","uobyqa","newuoa","bobyqa","nloptr","nlm","hjk","nmk","mads","ucminf","lbfgsb3c","subplex","BBoptim","optimParallel","clogit","clogistic","Rcgmin","Rvmmin") optmethod = "BFGS", # argument 'method' for optim() ("Nelder-Mead" and "BFGS" are sensible options) parallel = list(), # parallel argument for optimParallel() (note: 'cl' argument in parallel is not passed; this is directly specified via 'cl') cl = NULL, # arguments for optimParallel() ncpus = 1L, # arguments for optimParallel() scaleX = TRUE, # whether non-dummy variables in the X matrix should be rescaled before model fitting evtol = 1e-07, # lower bound for eigenvalues to determine if model matrix is positive definite dnchgcalc = "dFNCHypergeo", # method for calculating dnchg ("dFNCHypergeo" from BiasedUrn package or "dnoncenhypergeom") dnchgprec = 1e-10, # precision for dFNCHypergeo() hesspack = "numDeriv", # package for computing the Hessian (numDeriv or pracma) tau2tol = 1e-04) # for "CM.EL" + "ML", threshold for treating tau^2 values as effectively equal to 0 ### replace defaults with any user-defined values con.pos <- pmatch(names(control), names(con)) con[c(na.omit(con.pos))] <- control[!is.na(con.pos)] if (verbose) con$verbose <- verbose verbose <- con$verbose optimizer <- match.arg(con$optimizer, c("optim","nlminb","uobyqa","newuoa","bobyqa","nloptr","nlm","hjk","nmk","mads","ucminf","lbfgsb3c","subplex","BBoptim","optimParallel","clogit","clogistic","Nelder-Mead","BFGS","CG","L-BFGS-B","SANN","Brent","Rcgmin","Rvmmin")) optmethod <- match.arg(con$optmethod, c("Nelder-Mead","BFGS","CG","L-BFGS-B","SANN","Brent")) if (optimizer %in% c("Nelder-Mead","BFGS","CG","L-BFGS-B","SANN","Brent")) { optmethod <- optimizer optimizer <- "optim" } package <- match.arg(con$package, c("lme4","GLMMadaptive","glmmTMB")) parallel <- con$parallel cl <- con$cl ncpus <- con$ncpus if (con$dnchgcalc != "dnoncenhypergeom" && con$dnchgcalc != "dFNCHypergeo") stop(mstyle$stop("Unknown dnchgcalc method specified.")) if (is.element(optimizer, c("clogit","clogistic")) && method == "ML") stop(mstyle$stop("Cannot use 'clogit' or 'clogistic' with method='ML'.")) if (package == "lme4" && is.element(measure, c("OR","RR","RD","IRR")) && model == "UM.RS" && method == "ML" && nAGQ > 1) { warning(mstyle$warning("Not possible to fit RE/ME model='UM.RS' with nAGQ > 1 with glmer(). nAGQ automatically set to 1."), call.=FALSE) nAGQ <- 1 } ### if control argument 'ncpus' is larger than 1, automatically switch to optimParallel optimizer if (ncpus > 1L) optimizer <- "optimParallel" pos.optCtrl <- pmatch(names(control), "optCtrl", nomatch=0) if (sum(pos.optCtrl) > 0) { optCtrl <- control[[which(pos.optCtrl == 1)]] } else { optCtrl <- list() } ### set NLOPT_LN_BOBYQA as the default algorithm for nloptr optimizer ### and by default use a relative convergence criterion of 1e-8 on the function value if (optimizer == "nloptr" && !is.element("algorithm", names(optCtrl))) optCtrl$algorithm <- "NLOPT_LN_BOBYQA" if (optimizer == "nloptr" && !is.element("ftol_rel", names(optCtrl))) optCtrl$ftol_rel <- 1e-8 ### for mads, set trace=FALSE and tol=1e-6 by default if (optimizer == "mads" && !is.element("trace", names(optCtrl))) optCtrl$trace <- FALSE if (optimizer == "mads" && !is.element("tol", names(optCtrl))) optCtrl$tol <- 1e-6 ### for subplex, set reltol=1e-8 by default (the default in subplex() is .Machine$double.eps) if (optimizer == "subplex" && !is.element("reltol", names(optCtrl))) optCtrl$reltol <- 1e-8 ### for BBoptim, set trace=FALSE by default if (optimizer == "BBoptim" && !is.element("trace", names(optCtrl))) optCtrl$trace <- FALSE if (optimizer == "optim") { con.pos <- pmatch(names(optCtrl), "REPORT", nomatch=0) # set REPORT to 1 if it is not already set by the user if (sum(con.pos) > 0) { names(optCtrl)[which(con.pos == 1)] <- "REPORT" } else { optCtrl$REPORT <- 1 } optCtrl$trace <- con$verbose # trace for optim is a non-negative integer } if (optimizer == "nlminb") optCtrl$trace <- ifelse(con$verbose > 0, 1, 0) # set trace to 1, so information is printed every iteration if (is.element(optimizer, c("uobyqa", "newuoa", "bobyqa"))) optCtrl$iprint <- ifelse(con$verbose > 0, 3, 0) # set iprint to 3 for maximum information pos.clogitCtrl <- pmatch(names(control), "clogitCtrl", nomatch=0) if (sum(pos.clogitCtrl) > 0) { clogitCtrl <- control[[which(pos.clogitCtrl == 1)]] } else { clogitCtrl <- list() } pos.clogisticCtrl <- pmatch(names(control), "clogisticCtrl", nomatch=0) if (sum(pos.clogisticCtrl) > 0) { clogisticCtrl <- control[[which(pos.clogisticCtrl == 1)]] } else { clogisticCtrl <- list() } pos.glmCtrl <- pmatch(names(control), "glmCtrl", nomatch=0) if (sum(pos.glmCtrl) > 0) { glmCtrl <- control[[which(pos.glmCtrl == 1)]] } else { glmCtrl <- list() } glmCtrl$trace <- ifelse(con$verbose > 0, TRUE, FALSE) # trace for glmCtrl is logical pos.glmerCtrl <- pmatch(names(control), "glmerCtrl", nomatch=0) if (sum(pos.glmerCtrl) > 0) { glmerCtrl <- control[[which(pos.glmerCtrl == 1)]] } else { glmerCtrl <- list() } pos.intCtrl <- pmatch(names(control), "intCtrl", nomatch=0) if (sum(pos.intCtrl) > 0) { intCtrl <- control[[which(pos.intCtrl == 1)]] } else { intCtrl <- list() } con.pos <- pmatch(names(intCtrl), "lower", nomatch=0) if (sum(con.pos) > 0) { names(intCtrl)[which(con.pos == 1)] <- "lower" } else { intCtrl$lower <- -Inf } con.pos <- pmatch(names(intCtrl), "upper", nomatch=0) if (sum(con.pos) > 0) { names(intCtrl)[which(con.pos == 1)] <- "upper" } else { intCtrl$upper <- Inf } con.pos <- pmatch(names(intCtrl), "subdivisions", nomatch=0) if (sum(con.pos) > 0) { names(intCtrl)[which(con.pos == 1)] <- "subdivisions" } else { intCtrl$subdivisions <- 100L } con.pos <- pmatch(names(intCtrl), "rel.tol", nomatch=0) if (sum(con.pos) > 0) { names(intCtrl)[which(con.pos == 1)] <- "rel.tol" } else { intCtrl$rel.tol <- .Machine$double.eps^0.25 } pos.hessianCtrl <- pmatch(names(control), "hessianCtrl", nomatch=0) if (sum(pos.hessianCtrl) > 0) { hessianCtrl <- control[[which(pos.hessianCtrl == 1)]] } else { hessianCtrl <- list(r=16) } #return(list(verbose=verbose, optimizer=optimizer, dnchgcalc=con$dnchgcalc, dnchgprec=con$dnchgprec, optCtrl=optCtrl, glmCtrl=glmCtrl, glmerCtrl=glmerCtrl, intCtrl=intCtrl, hessianCtrl=hessianCtrl)) ######################################################################### ### check that the required packages are installed if (is.element(measure, c("OR","RR","RD","IRR"))) { if ((model == "UM.FS" && method == "ML") || (model == "UM.RS") || (model == "CM.AL" && method == "ML") || (model == "CM.EL" && method == "ML")) { if (!requireNamespace(package, quietly=TRUE)) stop(mstyle$stop(paste0("Please install the '", package, "' package to fit this model."))) } } if (is.element(measure, c("PLO","PR","PLN","IRLN")) && method == "ML") { if (!requireNamespace(package, quietly=TRUE)) stop(mstyle$stop(paste0("Please install the '", package, "' package to fit this model."))) } if (measure == "OR" && model == "CM.EL") { if (is.element(optimizer, c("uobyqa","newuoa","bobyqa"))) { if (!requireNamespace("minqa", quietly=TRUE)) stop(mstyle$stop("Please install the 'minqa' package to fit this model.")) } if (is.element(optimizer, c("nloptr","ucminf","lbfgsb3c","subplex","optimParallel"))) { if (!requireNamespace(optimizer, quietly=TRUE)) stop(mstyle$stop(paste0("Please install the '", optimizer, "' package to use this optimizer."))) } if (is.element(optimizer, c("hjk","nmk","mads"))) { if (!requireNamespace("dfoptim", quietly=TRUE)) stop(mstyle$stop("Please install the 'dfoptim' package to use this optimizer.")) } if (optimizer == "BBoptim") { if (!requireNamespace("BB", quietly=TRUE)) stop(mstyle$stop("Please install the 'BB' package to use this optimizer.")) } if (is.element(optimizer, c("optim","nlminb","uobyqa","newuoa","bobyqa","nloptr","nlm","hjk","nmk","mads","ucminf","lbfgsb3c","subplex","BBoptim","optimParallel","Rcgmin","Rvmmin"))) { con$hesspack <- match.arg(con$hesspack, c("numDeriv","pracma")) if (!requireNamespace(con$hesspack, quietly=TRUE)) stop(mstyle$stop(paste0("Please install the '", con$hesspack, "' package to fit this model."))) if (con$dnchgcalc == "dFNCHypergeo") { if (!requireNamespace("BiasedUrn", quietly=TRUE)) stop(mstyle$stop("Please install the 'BiasedUrn' package to fit this model.")) } } if (optimizer == "clogit") { if (!requireNamespace("survival", quietly=TRUE)) stop(mstyle$stop("Please install the 'survival' package to fit this model.")) coxph <- survival::coxph Surv <- survival::Surv clogit <- survival::clogit strata <- survival::strata } if (optimizer == "clogistic") { if (!requireNamespace("Epi", quietly=TRUE)) stop(mstyle$stop("Please install the 'Epi' package to fit this model.")) } } ### check whether model matrix is of full rank if (!.chkpd(crossprod(X), tol=con$evtol)) stop(mstyle$stop("Model matrix not of full rank. Cannot fit model.")) ######################################################################### ######################################################################### ######################################################################### se.tau2 <- ci.lb.tau2 <- ci.ub.tau2 <- I2 <- H2 <- QE <- QEp <- NA_real_ se.warn <- FALSE rho <- NA_real_ level <- .level(level) ###### model fitting, test statistics, and confidence intervals ### upgrade warnings to errors (for some testing) #o.warn <- getOption("warn") #on.exit(options(warn = o.warn), add=TRUE) #options(warn = 2) ### rescale X matrix (only for models with moderators and models including an intercept term) if (!int.only && int.incl && con$scaleX) { Xsave <- X meanX <- colMeans(X[, 2:p, drop=FALSE]) sdX <- apply(X[, 2:p, drop=FALSE], 2, sd) # consider using colSds() from matrixStats package is.d <- apply(X, 2, .is.dummy) # is each column a dummy variable (i.e., only 0s and 1s)? X[,!is.d] <- apply(X[, !is.d, drop=FALSE], 2, scale) # rescale the non-dummy variables } ######################################################################### ######################################################################### ######################################################################### ### two group outcomes (odds ratios and incidence rate ratios) if (is.element(measure, c("OR","RR","RD","IRR"))) { ###################################################################### if (is.element(model, c("UM.FS","UM.RS"))) { ### prepare data for the unconditional models if (is.element(measure, c("OR","RR","RD"))) { # xi mi study group1 group2 group12 offset intrcpt mod1 dat.grp <- cbind(xi=c(rbind(ai,ci)), mi=c(rbind(bi,di))) # grp-level outcome data ai bi i 1 0 +1/2 NULL 1 x1i # ci di i 0 1 -1/2 NULL 0 0 if (is.null(ddd$family)) { if (measure == "OR") dat.fam <- binomial(link=link) if (measure == "RR") dat.fam <- binomial(link=link) if (measure == "RD") #dat.fam <- eval(parse(text="binomial(link=\"identity\")")) dat.fam <- binomial(link=link) } else { dat.fam <- ddd$family } dat.off <- NULL } if (is.element(measure, c("IRR"))) { # xi ti study group1 group2 group12 offset intrcpt mod1 dat.grp <- c(rbind(x1i,x2i)) # grp-level outcome data x1i t1i i 1 0 +1/2 t1i 1 x1i # log(ti) for offset x2i t2i i 0 1 -1/2 t2i 0 0 if (is.null(ddd$family)) { dat.fam <- poisson(link=link) } else { dat.fam <- ddd$family } dat.off <- log(c(rbind(t1i,t2i))) } group1 <- rep(c(1,0), times=k) # group dummy for 1st group (ai,bi for group 1) group2 <- rep(c(0,1), times=k) # group dummy for 2nd group (ci,di for group 2) (not really needed) group12 <- rep(c(1/2,-1/2), times=k) # group dummy with +- 1/2 coding study <- factor(rep(seq_len(k), each=2L)) # study factor const <- cbind(rep(1,2*k)) # intercept for random study effects model X.fit <- X[rep(seq(k), each=2L),,drop=FALSE] # duplicate each row in X (drop=FALSE, so column names are preserved) X.fit <- cbind(group1*X.fit[,,drop=FALSE]) # then multiply by group1 dummy (intercept, if included, becomes the group1 dummy) if (coding == 1/2) group <- group12 if (coding == 1) group <- group1 if (coding == 0) group <- group2 rownames(X.fit) <- seq_len(2*k) if (.isTRUE(ddd$retdat)) return(list(dat.grp=dat.grp, X.fit=X.fit, study=study, dat.off = if (!is.null(dat.off)) dat.off else NULL, const=const, group1=group1, group2=group2, group12=group12, group=group, dat.fam=dat.fam)) ################################################################### #################################################### ### unconditional model with fixed study effects ### #################################################### if (model == "UM.FS") { ### fit FE model if (verbose) message(mstyle$message("Fitting FE model ...")) if (k > 1) { res.FE <- try(glm(dat.grp ~ -1 + X.fit + study, offset=dat.off, family=dat.fam, control=glmCtrl), silent=!verbose) } else { res.FE <- try(glm(dat.grp ~ -1 + X.fit + const, offset=dat.off, family=dat.fam, control=glmCtrl), silent=!verbose) } if (inherits(res.FE, "try-error")) stop(mstyle$stop(paste0("Cannot fit FE model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details).")))) ### log-likelihood #ll.FE <- with(data.frame(dat.grp), sum(dbinom(xi, xi+mi, predict(res.FE, type="response"), log=TRUE))) # model has a NULL offset #ll.FE <- with(data.frame(dat.grp), sum(dpois(xi, predict(res.FE, type="response"), log=TRUE))) # offset already incorporated into predict() ll.FE <- c(logLik(res.FE)) # same as above ### fit saturated FE model (= QE model) QEconv <- FALSE ll.QE <- NA_real_ if (!isTRUE(ddd$skiphet)) { if (k > 1 && verbose) message(mstyle$message("Fitting saturated model ...")) if (k > 1) { X.QE <- model.matrix(~ -1 + X.fit + study + study:group1) res.QE <- try(glm(dat.grp ~ -1 + X.QE, offset=dat.off, family=dat.fam, control=glmCtrl), silent=!verbose) } else { res.QE <- res.FE } if (inherits(res.QE, "try-error")) { warning(mstyle$warning(paste0("Cannot fit saturated model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details)."))), call.=FALSE) } else { QEconv <- TRUE ### log-likelihood #ll.QE <- with(data.frame(dat.grp), sum(dbinom(xi, xi+mi, xi/(xi+mi), log=TRUE))) # model has a NULL offset #ll.QE <- with(data.frame(dat.grp), sum(dpois(xi, xi, log=TRUE))) # offset not relevant for saturated model ll.QE <- c(logLik(res.QE)) # same as above ### extract coefficients and variance-covariance matrix for Wald-type test for heterogeneity #b2.QE <- cbind(na.omit(coef(res.QE)[-seq_len(k+p)])) # coef() still includes aliased coefficients as NAs, so filter them out b2.QE <- cbind(coef(res.QE, complete=FALSE)[-seq_len(k+p)]) # aliased coefficients are removed by coef() when complete=FALSE vb2.QE <- vcov(res.QE, complete=FALSE)[-seq_len(k+p),-seq_len(k+p),drop=FALSE] # aliased coefficients are removed by vcov() when complete=FALSE } } if (method == "ML") { ### fit ML model if (verbose) message(mstyle$message("Fitting ML model ...")) if (package == "lme4") { if (verbose) { res.ML <- try(lme4::glmer(dat.grp ~ -1 + X.fit + study + (group - 1 | study), offset=dat.off, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=do.call(lme4::glmerControl, glmerCtrl)), silent=!verbose) } else { res.ML <- suppressMessages(try(lme4::glmer(dat.grp ~ -1 + X.fit + study + (group - 1 | study), offset=dat.off, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=do.call(lme4::glmerControl, glmerCtrl)), silent=!verbose)) } } if (package == "GLMMadaptive") { if (is.element(measure, c("OR","RR","RD"))) { dat.mm <- data.frame(xi=dat.grp[,"xi"], mi=dat.grp[,"mi"], study=study, group=group) res.ML <- try(GLMMadaptive::mixed_model(cbind(xi,mi) ~ -1 + X.fit + study, random = ~ group - 1 | study, data=dat.mm, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=glmerCtrl), silent=!verbose) } else { dat.mm <- data.frame(xi=dat.grp, study=study, group=group) res.ML <- try(GLMMadaptive::mixed_model(xi ~ -1 + X.fit + study + offset(dat.off), random = ~ group - 1 | study, data=dat.mm, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=glmerCtrl), silent=!verbose) } } if (package == "glmmTMB") { if (verbose) { res.ML <- try(glmmTMB::glmmTMB(dat.grp ~ -1 + X.fit + study + (group - 1 | study), offset=dat.off, family=dat.fam, verbose=verbose, data=NULL, control=do.call(glmmTMB::glmmTMBControl, glmerCtrl)), silent=!verbose) } else { res.ML <- suppressMessages(try(glmmTMB::glmmTMB(dat.grp ~ -1 + X.fit + study + (group - 1 | study), offset=dat.off, family=dat.fam, verbose=verbose, data=NULL, control=do.call(glmmTMB::glmmTMBControl, glmerCtrl)), silent=!verbose)) } } if (inherits(res.ML, "try-error")) stop(mstyle$stop(paste0("Cannot fit ML model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details).")))) ### log-likelihood #ll.ML <- with(data.frame(dat.grp), sum(dbinom(xi, xi+mi, fitted(res.ML), log=TRUE))) # not correct (since it does not incorporate the random effects; same as ll.FE if tau^2=0) #ll.ML <- with(data.frame(dat.grp), sum(dbinom(xi, xi+mi, plogis(qlogis(fitted(res.ML)) + group12*unlist(ranef(res.ML))), log=TRUE))) # not correct (since one really has to integrate; same as ll.FE if tau^2=0) #ll.ML <- c(logLik(res.ML)) # this is not the same as ll.FE when tau^2 = 0 (not sure why) if (package == "lme4") { if (is.na(ll.QE)) { ll.ML <- c(logLik(res.ML)) } else { ll.ML <- ll.QE - 1/2 * deviance(res.ML) # this makes ll.ML comparable to ll.FE (same as ll.FE when tau^2=0) } } else { ll.ML <- c(logLik(res.ML)) # not 100% sure how comparable this is to ll.FE when tau^2 = 0 (seems correct for glmmTMB) } } #return(list(res.FE, res.QE, res.ML, ll.FE=ll.FE, ll.QE=ll.QE, ll.ML=ll.ML)) #res.FE <- res[[1]]; res.QE <- res[[2]]; res.ML <- res[[3]] if (is.element(method, c("FE","EE","CE"))) { beta <- cbind(coef(res.FE)[seq_len(p)]) vb <- vcov(res.FE)[seq_len(p),seq_len(p),drop=FALSE] tau2 <- 0 sigma2 <- NA_real_ parms <- p + k p.eff <- p + k k.eff <- 2*k } if (method == "ML") { if (package == "lme4") { beta <- cbind(lme4::fixef(res.ML)[seq_len(p)]) vb <- as.matrix(vcov(res.ML))[seq_len(p),seq_len(p),drop=FALSE] tau2 <- lme4::VarCorr(res.ML)[[1]][1] } if (package == "GLMMadaptive") { beta <- cbind(GLMMadaptive::fixef(res.ML)[seq_len(p)]) vb <- as.matrix(vcov(res.ML))[seq_len(p),seq_len(p),drop=FALSE] tau2 <- res.ML$D[1,1] } if (package == "glmmTMB") { beta <- cbind(glmmTMB::fixef(res.ML)$cond[seq_len(p)]) vb <- as.matrix(vcov(res.ML)$cond)[seq_len(p),seq_len(p),drop=FALSE] tau2 <- glmmTMB::VarCorr(res.ML)[[1]][[1]][[1]] } sigma2 <- NA_real_ parms <- p + k + 1 p.eff <- p + k k.eff <- 2*k } #return(list(beta=beta, vb=vb, tau2=tau2, sigma2=sigma2, parms=parms, p.eff=p.eff, k.eff=k.eff, b2.QE=b2.QE, vb2.QE=vb2.QE)) } ################################################################### ##################################################### ### unconditional model with random study effects ### ##################################################### if (model == "UM.RS") { ### fit FE model if (verbose) message(mstyle$message("Fitting FE model ...")) if (package == "lme4") { if (verbose) { res.FE <- try(lme4::glmer(dat.grp ~ -1 + X.fit + const + (1 | study), offset=dat.off, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=do.call(lme4::glmerControl, glmerCtrl)), silent=!verbose) } else { res.FE <- suppressMessages(try(lme4::glmer(dat.grp ~ -1 + X.fit + const + (1 | study), offset=dat.off, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=do.call(lme4::glmerControl, glmerCtrl)), silent=!verbose)) } } if (package == "GLMMadaptive") { if (is.element(measure, c("OR","RR","RD"))) { dat.mm <- data.frame(xi=dat.grp[,"xi"], mi=dat.grp[,"mi"], study=study, const=const) res.FE <- try(GLMMadaptive::mixed_model(cbind(xi,mi) ~ -1 + X.fit + const, random = ~ 1 | study, data=dat.mm, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=glmerCtrl), silent=!verbose) } else { dat.mm <- data.frame(xi=dat.grp, study=study, const=const) res.FE <- try(GLMMadaptive::mixed_model(xi ~ -1 + X.fit + const + offset(dat.off), random = ~ 1 | study, data=dat.mm, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=glmerCtrl), silent=!verbose) } } if (package == "glmmTMB") { if (verbose) { res.FE <- try(glmmTMB::glmmTMB(dat.grp ~ -1 + X.fit + const + (1 | study), offset=dat.off, family=dat.fam, verbose=verbose, data=NULL, control=do.call(glmmTMB::glmmTMBControl, glmerCtrl)), silent=!verbose) } else { res.FE <- suppressMessages(try(glmmTMB::glmmTMB(dat.grp ~ -1 + X.fit + const + (1 | study), offset=dat.off, family=dat.fam, verbose=verbose, data=NULL, control=do.call(glmmTMB::glmmTMBControl, glmerCtrl)), silent=!verbose)) } } if (inherits(res.FE, "try-error")) stop(mstyle$stop(paste0("Cannot fit FE model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details).")))) ### log-likelihood ll.FE <- c(logLik(res.FE)) ### fit saturated FE model (= QE model) ### notes: 1) must remove aliased terms before fitting (for GLMMadaptive to work) ### 2) use the sigma^2 value from the FE model as the starting value for the study-level random effect QEconv <- FALSE ll.QE <- NA_real_ if (!isTRUE(ddd$skiphet)) { if (k > 1 && verbose) message(mstyle$message("Fitting saturated model ...")) if (k > 1) { X.QE <- model.matrix(~ -1 + X.fit + const + study:group1) res.QE <- try(glm(dat.grp ~ -1 + X.QE, offset=dat.off, family=dat.fam, control=glmCtrl), silent=TRUE) X.QE <- X.QE[,!is.na(coef(res.QE)),drop=FALSE] if (package == "lme4") { if (verbose) { res.QE <- try(lme4::glmer(dat.grp ~ -1 + X.QE + (1 | study), offset=dat.off, family=dat.fam, start=c(sqrt(lme4::VarCorr(res.FE)[[1]][1])), nAGQ=nAGQ, verbose=verbose, control=do.call(lme4::glmerControl, glmerCtrl)), silent=!verbose) } else { res.QE <- suppressMessages(try(lme4::glmer(dat.grp ~ -1 + X.QE + (1 | study), offset=dat.off, family=dat.fam, start=c(sqrt(lme4::VarCorr(res.FE)[[1]][1])), nAGQ=nAGQ, verbose=verbose, control=do.call(lme4::glmerControl, glmerCtrl)), silent=!verbose)) } } if (package == "GLMMadaptive") { glmerCtrl$max_coef_value <- 50 if (is.element(measure, c("OR","RR","RD"))) { dat.mm <- data.frame(xi=dat.grp[,"xi"], mi=dat.grp[,"mi"], study=study) res.QE <- try(GLMMadaptive::mixed_model(cbind(xi,mi) ~ -1 + X.QE, random = ~ 1 | study, data=dat.mm, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=glmerCtrl, initial_values=list(D=matrix(res.FE$D[1,1]))), silent=!verbose) } else { dat.mm <- data.frame(xi=dat.grp, study=study) res.QE <- try(GLMMadaptive::mixed_model(xi ~ -1 + X.QE + offset(dat.off), random = ~ 1 | study, data=dat.mm, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=glmerCtrl), silent=!verbose) } } if (package == "glmmTMB") { if (verbose) { res.QE <- try(glmmTMB::glmmTMB(dat.grp ~ -1 + X.QE + (1 | study), offset=dat.off, family=dat.fam, start=list(theta=sqrt(glmmTMB::VarCorr(res.FE)[[1]][[1]][[1]])), verbose=verbose, data=NULL, control=do.call(glmmTMB::glmmTMBControl, glmerCtrl)), silent=!verbose) } else { res.QE <- suppressMessages(try(glmmTMB::glmmTMB(dat.grp ~ -1 + X.QE + (1 | study), offset=dat.off, family=dat.fam, start=list(theta=sqrt(glmmTMB::VarCorr(res.FE)[[1]][[1]][[1]])), verbose=verbose, data=NULL, control=do.call(glmmTMB::glmmTMBControl, glmerCtrl)), silent=!verbose)) } } } else { res.QE <- res.FE } if (inherits(res.QE, "try-error")) { warning(mstyle$warning(paste0("Cannot fit saturated model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details)."))), call.=FALSE) } else { QEconv <- TRUE ### log-likelihood ll.QE <- c(logLik(res.QE)) ### extract coefficients and variance-covariance matrix for Wald-type test for heterogeneity (aliased coefficients are already removed) if (package == "lme4") { b2.QE <- cbind(lme4::fixef(res.QE)[-seq_len(p+1)]) vb2.QE <- as.matrix(vcov(res.QE))[-seq_len(p+1),-seq_len(p+1),drop=FALSE] } if (package == "GLMMadaptive") { b2.QE <- cbind(GLMMadaptive::fixef(res.QE)[-seq_len(p+1)]) vb2.QE <- as.matrix(vcov(res.QE))[-seq_len(p+1),-seq_len(p+1),drop=FALSE] vb2.QE <- vb2.QE[-nrow(vb2.QE), -ncol(vb2.QE)] } if (package == "glmmTMB") { b2.QE <- cbind(glmmTMB::fixef(res.QE)$cond[-seq_len(p+1)]) vb2.QE <- as.matrix(vcov(res.QE)$cond)[-seq_len(p+1),-seq_len(p+1),drop=FALSE] } } } if (method == "ML") { ### fit ML model ### notes: 1) not recommended alternative: using group1 instead of group12 for the random effect (since that forces the variance in group 2 to be lower) ### 2) this approach is okay if we also allow group1 random effect and intercepts to correlate (in fact, this is identical to the bivariate model) ### 3) start=c(sqrt(lme4::VarCorr(res.FE)[[1]][1])) has no effect, since the start value for tau^2 is not specified (and using 0 is probably not ideal for that) if (verbose) message(mstyle$message("Fitting ML model ...")) if (package == "lme4") { if (verbose) { if (cor) { res.ML <- try(lme4::glmer(dat.grp ~ -1 + X.fit + const + (group | study), offset=dat.off, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=do.call(lme4::glmerControl, glmerCtrl)), silent=!verbose) } else { res.ML <- try(lme4::glmer(dat.grp ~ -1 + X.fit + const + (group || study), offset=dat.off, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=do.call(lme4::glmerControl, glmerCtrl)), silent=!verbose) } } else { if (cor) { res.ML <- suppressMessages(try(lme4::glmer(dat.grp ~ -1 + X.fit + const + (group | study), offset=dat.off, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=do.call(lme4::glmerControl, glmerCtrl)), silent=!verbose)) } else { res.ML <- suppressMessages(try(lme4::glmer(dat.grp ~ -1 + X.fit + const + (group || study), offset=dat.off, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=do.call(lme4::glmerControl, glmerCtrl)), silent=!verbose)) } } } if (package == "GLMMadaptive") { if (is.element(measure, c("OR","RR","RD"))) { dat.mm <- data.frame(xi=dat.grp[,"xi"], mi=dat.grp[,"mi"], study=study, const=const, group=group) if (cor) { res.ML <- try(GLMMadaptive::mixed_model(cbind(xi,mi) ~ -1 + X.fit + const, random = ~ group | study, data=dat.mm, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=glmerCtrl), silent=!verbose) } else { res.ML <- try(GLMMadaptive::mixed_model(cbind(xi,mi) ~ -1 + X.fit + const, random = ~ group || study, data=dat.mm, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=glmerCtrl), silent=!verbose) } } else { dat.mm <- data.frame(xi=dat.grp, study=study, const=const, group=group) if (cor) { res.ML <- try(GLMMadaptive::mixed_model(xi ~ -1 + X.fit + const + offset(dat.off), random = ~ group | study, data=dat.mm, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=glmerCtrl), silent=!verbose) } else { res.ML <- try(GLMMadaptive::mixed_model(xi ~ -1 + X.fit + const + offset(dat.off), random = ~ group || study, data=dat.mm, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=glmerCtrl), silent=!verbose) } } } if (package == "glmmTMB") { if (verbose) { if (cor) { res.ML <- try(glmmTMB::glmmTMB(dat.grp ~ -1 + X.fit + const + (group | study), offset=dat.off, family=dat.fam, verbose=verbose, data=NULL, control=do.call(glmmTMB::glmmTMBControl, glmerCtrl)), silent=!verbose) } else { res.ML <- try(glmmTMB::glmmTMB(dat.grp ~ -1 + X.fit + const + (1 | study) + (group - 1 | study), offset=dat.off, family=dat.fam, verbose=verbose, data=NULL, control=do.call(glmmTMB::glmmTMBControl, glmerCtrl)), silent=!verbose) } } else { if (cor) { res.ML <- suppressMessages(try(glmmTMB::glmmTMB(dat.grp ~ -1 + X.fit + const + (group | study), offset=dat.off, family=dat.fam, verbose=verbose, data=NULL, control=do.call(glmmTMB::glmmTMBControl, glmerCtrl)), silent=!verbose)) } else { res.ML <- suppressMessages(try(glmmTMB::glmmTMB(dat.grp ~ -1 + X.fit + const + (1 | study) + (group - 1 | study), offset=dat.off, family=dat.fam, verbose=verbose, data=NULL, control=do.call(glmmTMB::glmmTMBControl, glmerCtrl)), silent=!verbose)) } } } if (inherits(res.ML, "try-error")) stop(mstyle$stop(paste0("Cannot fit ML model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details).")))) ### log-likelihood ll.ML <- c(logLik(res.ML)) } #return(list(res.FE, res.QE, res.ML, ll.FE=ll.FE, ll.QE=ll.QE, ll.ML=ll.ML)) #res.FE <- res[[1]]; res.QE <- res[[2]]; res.ML <- res[[3]] if (is.element(method, c("FE","EE","CE"))) { tau2 <- 0 if (package == "lme4") { beta <- cbind(lme4::fixef(res.FE)[seq_len(p)]) vb <- as.matrix(vcov(res.FE))[seq_len(p),seq_len(p),drop=FALSE] sigma2 <- lme4::VarCorr(res.FE)[[1]][1] } if (package == "GLMMadaptive") { beta <- cbind(GLMMadaptive::fixef(res.FE)[seq_len(p)]) vb <- as.matrix(vcov(res.FE))[seq_len(p),seq_len(p),drop=FALSE] sigma2 <- res.FE$D[1,1] } if (package == "glmmTMB") { beta <- cbind(glmmTMB::fixef(res.FE)$cond[seq_len(p)]) vb <- as.matrix(vcov(res.FE)$cond)[seq_len(p),seq_len(p),drop=FALSE] sigma2 <- glmmTMB::VarCorr(res.FE)[[1]][[1]][[1]] } parms <- p + 1 + 1 p.eff <- p + 1 k.eff <- 2*k } if (method == "ML") { if (package == "lme4") { beta <- cbind(lme4::fixef(res.ML)[seq_len(p)]) vb <- as.matrix(vcov(res.ML))[seq_len(p),seq_len(p),drop=FALSE] if (cor) { tau2 <- lme4::VarCorr(res.ML)[[1]][2,2] sigma2 <- lme4::VarCorr(res.ML)[[1]][1,1] rho <- lme4::VarCorr(res.ML)[[1]][1,2] / sqrt(tau2 * sigma2) } else { tau2 <- lme4::VarCorr(res.ML)[[2]][1] sigma2 <- lme4::VarCorr(res.ML)[[1]][1] } } if (package == "GLMMadaptive") { beta <- cbind(GLMMadaptive::fixef(res.ML)[seq_len(p)]) vb <- as.matrix(vcov(res.ML))[seq_len(p),seq_len(p),drop=FALSE] tau2 <- res.ML$D[2,2] sigma2 <- res.ML$D[1,1] if (cor) rho <- res.ML$D[1,2] / sqrt(tau2 * sigma2) } if (package == "glmmTMB") { beta <- cbind(glmmTMB::fixef(res.ML)$cond[seq_len(p)]) vb <- as.matrix(vcov(res.ML)$cond)[seq_len(p),seq_len(p),drop=FALSE] if (cor) { tau2 <- glmmTMB::VarCorr(res.ML)[[1]][[1]][2,2] sigma2 <- glmmTMB::VarCorr(res.ML)[[1]][[1]][1,1] rho <- glmmTMB::VarCorr(res.ML)[[1]][[1]][1,2] / sqrt(tau2 * sigma2) } else { tau2 <- glmmTMB::VarCorr(res.ML)[[1]][[2]][[1]] sigma2 <- glmmTMB::VarCorr(res.ML)[[1]][[1]][[1]] } } parms <- p + 1 + 2 p.eff <- p + 1 k.eff <- 2*k } #return(list(beta=beta, vb=vb, tau2=tau2, sigma2=sigma2, parms=parms, p.eff=p.eff, k.eff=k.eff, b2.QE=b2.QE, vb2.QE=vb2.QE)) } ################################################################### } ###################################################################### if ((measure=="IRR" && model == "CM.EL") || (measure=="OR" && model=="CM.AL") || (measure=="OR" && model=="CM.EL")) { ### prepare data for the conditional models if (measure == "OR") { dat.grp <- cbind(xi=ai, mi=ci) # conditional outcome data (number of cases in group 1 conditional on total number of cases) dat.off <- log((ai+bi)/(ci+di)) # log(n1i/n2i) for offset } if (measure == "IRR") { dat.grp <- cbind(xi=x1i, mi=x2i) # conditional outcome data (number of events in group 1 conditional on total number of events) dat.off <- log(t1i/t2i) # log(t1i/t1i) for offset } study <- factor(seq_len(k)) # study factor X.fit <- X if (.isTRUE(ddd$retdat)) return(list(dat.grp=dat.grp, X.fit=X.fit, study=study, dat.off = if (!is.null(dat.off)) dat.off else NULL)) ################################################################### ############################################################### ### conditional model (approx. ll for ORs / exact for IRRs) ### ############################################################### ### fit FE model if (verbose) message(mstyle$message("Fitting FE model ...")) res.FE <- try(glm(dat.grp ~ -1 + X.fit, offset=dat.off, family=binomial, control=glmCtrl), silent=!verbose) if (inherits(res.FE, "try-error")) stop(mstyle$stop(paste0("Cannot fit FE model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details).")))) ### log-likelihood #ll.FE <- with(data.frame(dat.grp), sum(dbinom(xi, xi+mi, predict(res.FE, type="response"), log=TRUE))) # offset already incorporated into predict() #ll.FE <- with(data.frame(dat.grp), sum(dpois(xi, predict(res.FE, type="response"), log=TRUE))) # offset already incorporated into predict() ll.FE <- c(logLik(res.FE)) # same as above ### fit saturated FE model (= QE model) QEconv <- FALSE ll.QE <- NA_real_ if (!isTRUE(ddd$skiphet)) { if (k > 1 && verbose) message(mstyle$message("Fitting saturated model ...")) if (k > 1) { X.QE <- model.matrix(~ -1 + X.fit + study) res.QE <- try(glm(dat.grp ~ -1 + X.QE, offset=dat.off, family=binomial, control=glmCtrl), silent=!verbose) } else { res.QE <- res.FE } if (inherits(res.QE, "try-error")) { warning(mstyle$warning(paste0("Cannot fit saturated model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details)."))), call.=FALSE) } else { QEconv <- TRUE ### log-likelihood #ll.QE <- with(data.frame(dat.grp), sum(dbinom(xi, xi+mi, xi/(xi+mi), log=TRUE))) # offset not relevant for saturated model #ll.QE <- with(data.frame(dat.grp), sum(dpois(xi, xi, log=TRUE))) # offset not relevant for saturated model ll.QE <- c(logLik(res.QE)) # same as above ### extract coefficients and variance-covariance matrix for Wald-type test for heterogeneity #b2.QE <- cbind(na.omit(coef(res.QE)[-seq_len(p)])) # coef() still includes aliased coefficients as NAs, so filter them out b2.QE <- cbind(coef(res.QE, complete=FALSE)[-seq_len(p)]) # aliased coefficients are removed by coef() when complete=FALSE vb2.QE <- vcov(res.QE, complete=FALSE)[-seq_len(p),-seq_len(p),drop=FALSE] # aliased coefficients are removed by vcov() when complete=FALSE } #return(list(res.FE, res.QE, ll.FE, ll.QE)) #res.FE <- res[[1]]; res.QE <- res[[2]] } if (method == "ML") { ### fit ML model ### notes: 1) suppressMessages to suppress the 'one random effect per observation' warning if (verbose) message(mstyle$message("Fitting ML model ...")) if (package == "lme4") { if (verbose) { res.ML <- try(lme4::glmer(dat.grp ~ -1 + X.fit + (1 | study), offset=dat.off, family=binomial, nAGQ=nAGQ, verbose=verbose, control=do.call(lme4::glmerControl, glmerCtrl)), silent=!verbose) } else { res.ML <- suppressMessages(try(lme4::glmer(dat.grp ~ -1 + X.fit + (1 | study), offset=dat.off, family=binomial, nAGQ=nAGQ, verbose=verbose, control=do.call(lme4::glmerControl, glmerCtrl)), silent=!verbose)) } } if (package == "GLMMadaptive") { dat.mm <- data.frame(xi=dat.grp[,"xi"], mi=dat.grp[,"mi"], study=study) res.ML <- try(GLMMadaptive::mixed_model(cbind(xi,mi) ~ -1 + X.fit + offset(dat.off), random = ~ 1 | study, data=dat.mm, family=binomial, nAGQ=nAGQ, verbose=verbose, control=glmerCtrl), silent=!verbose) } if (package == "glmmTMB") { if (verbose) { res.ML <- try(glmmTMB::glmmTMB(dat.grp ~ -1 + X.fit + (1 | study), offset=dat.off, family=binomial, verbose=verbose, data=NULL, control=do.call(glmmTMB::glmmTMBControl, glmerCtrl)), silent=!verbose) } else { res.ML <- suppressMessages(try(glmmTMB::glmmTMB(dat.grp ~ -1 + X.fit + (1 | study), offset=dat.off, family=binomial, verbose=verbose, data=NULL, control=do.call(glmmTMB::glmmTMBControl, glmerCtrl)), silent=!verbose)) } } if (inherits(res.ML, "try-error")) stop(mstyle$stop(paste0("Cannot fit ML model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details).")))) ### log-likelihood if (package == "lme4") { if (is.na(ll.QE)) { ll.ML <- c(logLik(res.ML)) } else { if (verbose) { ll.ML <- ll.QE - 1/2 * deviance(res.ML) # this makes ll.ML comparable to ll.FE (same as ll.FE when tau^2=0) } else { ll.ML <- ll.QE - 1/2 * suppressWarnings(deviance(res.ML)) # suppressWarnings() to suppress 'Warning in sqrt(object$devResid()) : NaNs produced' } } } else { ll.ML <- c(logLik(res.ML)) # not 100% sure how comparable this is to ll.FE when tau^2 = 0 (seems correct for glmmTMB) } } #return(list(res.FE, res.QE, res.ML, ll.FE=ll.FE, ll.QE=ll.QE, ll.ML=ll.ML)) #res.FE <- res[[1]]; res.QE <- res[[2]]; res.ML <- res[[3]] if (is.element(method, c("FE","EE","CE"))) { beta <- cbind(coef(res.FE)[seq_len(p)]) vb <- vcov(res.FE)[seq_len(p),seq_len(p),drop=FALSE] tau2 <- 0 sigma2 <- NA_real_ parms <- p p.eff <- p k.eff <- k } if (method == "ML") { if (package == "lme4") { beta <- cbind(lme4::fixef(res.ML)[seq_len(p)]) vb <- as.matrix(vcov(res.ML))[seq_len(p),seq_len(p),drop=FALSE] tau2 <- lme4::VarCorr(res.ML)[[1]][1] } if (package == "GLMMadaptive") { beta <- cbind(GLMMadaptive::fixef(res.ML)[seq_len(p)]) vb <- as.matrix(vcov(res.ML))[seq_len(p),seq_len(p),drop=FALSE] tau2 <- res.ML$D[1,1] } if (package == "glmmTMB") { beta <- cbind(glmmTMB::fixef(res.ML)$cond[seq_len(p)]) vb <- as.matrix(vcov(res.ML)$cond)[seq_len(p),seq_len(p),drop=FALSE] tau2 <- glmmTMB::VarCorr(res.ML)[[1]][[1]][[1]] } sigma2 <- NA_real_ parms <- p + 1 p.eff <- p k.eff <- k } #return(list(beta=beta, vb=vb, tau2=tau2, sigma2=sigma2, parms=parms, p.eff=p.eff, k.eff=k.eff, b2.QE=b2.QE, vb2.QE=vb2.QE)) ################################################################### } if (measure=="OR" && model=="CM.EL") { #################################################### ### conditional model (exact likelihood for ORs) ### #################################################### if (verbose) message(mstyle$message("Fitting FE model ...")) if (is.element(optimizer, c("optim","nlminb","uobyqa","newuoa","bobyqa","nloptr","nlm","hjk","nmk","mads","ucminf","lbfgsb3c","subplex","BBoptim","optimParallel","Rcgmin","Rvmmin"))) { if (optimizer == "optim") { par.arg <- "par" ctrl.arg <- ", control=optCtrl" } if (optimizer == "nlminb") { par.arg <- "start" ctrl.arg <- ", control=optCtrl" } if (is.element(optimizer, c("uobyqa","newuoa","bobyqa"))) { par.arg <- "par" optimizer <- paste0("minqa::", optimizer) ctrl.arg <- ", control=optCtrl" } if (optimizer == "nloptr") { par.arg <- "x0" optimizer <- paste0("nloptr::nloptr") ctrl.arg <- ", opts=optCtrl" } if (optimizer == "nlm") { par.arg <- "p" ctrl.arg <- paste(names(optCtrl), unlist(optCtrl), sep="=", collapse=", ") if (nchar(ctrl.arg) != 0L) ctrl.arg <- paste0(", ", ctrl.arg) } if (is.element(optimizer, c("hjk","nmk","mads"))) { par.arg <- "par" optimizer <- paste0("dfoptim::", optimizer) ctrl.arg <- ", control=optCtrl" } if (is.element(optimizer, c("ucminf","lbfgsb3c","subplex"))) { par.arg <- "par" optimizer <- paste0(optimizer, "::", optimizer) ctrl.arg <- ", control=optCtrl" } if (optimizer == "BBoptim") { par.arg <- "par" optimizer <- "BB::BBoptim" ctrl.arg <- ", quiet=TRUE, control=optCtrl" } if (optimizer == "Rcgmin") { par.arg <- "par" optimizer <- "Rcgmin::Rcgmin" #ctrl.arg <- ", gr='grnd', control=optCtrl" ctrl.arg <- ", control=optCtrl" } if (optimizer == "Rvmmin") { par.arg <- "par" optimizer <- "Rvmmin::Rvmmin" #ctrl.arg <- ", gr='grnd', control=optCtrl" ctrl.arg <- ", control=optCtrl" } if (optimizer == "optimParallel") { par.arg <- "par" optimizer <- paste0("optimParallel::optimParallel") ctrl.arg <- ", control=optCtrl, parallel=parallel" parallel$cl <- NULL if (is.null(cl)) { ncpus <- as.integer(ncpus) if (ncpus < 1L) stop(mstyle$stop("Control argument 'ncpus' must be >= 1.")) cl <- parallel::makePSOCKcluster(ncpus) on.exit(parallel::stopCluster(cl), add=TRUE) } else { if (!inherits(cl, "SOCKcluster")) stop(mstyle$stop("Specified cluster is not of class 'SOCKcluster'.")) } parallel$cl <- cl if (is.null(parallel$forward)) parallel$forward <- FALSE if (is.null(parallel$loginfo)) { if (verbose) { parallel$loginfo <- TRUE } else { parallel$loginfo <- FALSE } } } ### fit FE model ### notes: 1) this routine uses direct optimization over the non-central hypergeometric distribution ### 2) start values from CM.AL model (res.FE) and tau^2=0 (random=FALSE) ### 3) no integration needed for FE model, so intCtrl is not actually relevant ### 4) results can be sensitive to the scaling of moderators optcall <- paste(optimizer, "(", par.arg, "=c(coef(res.FE)[seq_len(p)], 0), .dnchg, ", ifelse(optimizer=="optim", "method=optmethod, ", ""), "ai=ai, bi=bi, ci=ci, di=di, X.fit=X.fit, random=FALSE, verbose=verbose, digits=digits, dnchgcalc=con$dnchgcalc, dnchgprec=con$dnchgprec, intCtrl=intCtrl", ctrl.arg, ")\n", sep="") #return(optcall) if (verbose) { res.FE <- try(eval(str2lang(optcall)), silent=!verbose) } else { res.FE <- try(suppressWarnings(eval(str2lang(optcall))), silent=!verbose) } #return(res.FE) if (optimizer == "optimParallel::optimParallel" && verbose) { tmp <- capture.output(print(res.FE$loginfo)) .print.output(tmp, mstyle$verbose) } if (inherits(res.FE, "try-error")) stop(mstyle$stop(paste0("Cannot fit FE model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details).")))) ### convergence checks if (is.element(optimizer, c("optim","nlminb","dfoptim::hjk","dfoptim::nmk","lbfgsb3c::lbfgsb3c","subplex::subplex","BB::BBoptim","Rcgmin::Rcgmin","Rvmmin:Rvmmin","optimParallel::optimParallel")) && res.FE$convergence != 0) stop(mstyle$stop(paste0("Cannot fit FE model. Optimizer (", optimizer, ") did not achieve convergence (convergence = ", res.FE$convergence, ")."))) if (is.element(optimizer, c("dfoptim::mads")) && res.FE$convergence > optCtrl$tol) stop(mstyle$stop(paste0("Cannot fit FE model. Optimizer (", optimizer, ") did not achieve convergence (convergence = ", res.FE$convergence, ")."))) if (is.element(optimizer, c("minqa::uobyqa","minqa::newuoa","minqa::bobyqa")) && res.FE$ierr != 0) stop(mstyle$stop(paste0("Cannot fit FE model. Optimizer (", optimizer, ") did not achieve convergence (ierr = ", res.FE$ierr, ")."))) if (optimizer=="nloptr::nloptr" && !(res.FE$status >= 1 && res.FE$status <= 4)) stop(mstyle$stop(paste0("Cannot fit FE model. Optimizer (", optimizer, ") did not achieve convergence (status = ", res.FE$status, ")."))) if (optimizer=="ucminf::ucminf" && !(res.FE$convergence == 1 || res.FE$convergence == 2)) stop(mstyle$stop(paste0("Cannot fit FE model. Optimizer (", optimizer, ") did not achieve convergence (convergence = ", res.FE$convergence, ")."))) if (verbose > 2) { cat("\n") tmp <- capture.output(print(res.FE)) .print.output(tmp, mstyle$verbose) } ### copy estimated values to 'par' if (optimizer=="nloptr::nloptr") res.FE$par <- res.FE$solution if (optimizer=="nlm") res.FE$par <- res.FE$estimate if (verbose > 1) message(mstyle$message("Computing Hessian ...")) if (con$hesspack == "numDeriv") h.FE <- numDeriv::hessian(.dnchg, x=res.FE$par, method.args=hessianCtrl, ai=ai, bi=bi, ci=ci, di=di, X.fit=X.fit, random=FALSE, verbose=verbose, digits=digits, dnchgcalc=con$dnchgcalc, dnchgprec=con$dnchgprec) if (con$hesspack == "pracma") h.FE <- pracma::hessian(.dnchg, x0=res.FE$par, ai=ai, bi=bi, ci=ci, di=di, X.fit=X.fit, random=FALSE, verbose=verbose, digits=digits, dnchgcalc=con$dnchgcalc, dnchgprec=con$dnchgprec) #return(list(res.FE=res.FE, h.FE=h.FE)) ### log-likelihood if (is.element(optimizer, c("optim","dfoptim::hjk","dfoptim::nmk","dfoptim::mads","ucminf::ucminf","lbfgsb3c::lbfgsb3c","subplex::subplex","BB::BBoptim","Rcgmin::Rcgmin","Rvmmin:Rvmmin","optimParallel::optimParallel"))) ll.FE <- -1 * res.FE$value if (is.element(optimizer, c("nlminb","nloptr::nloptr"))) ll.FE <- -1 * res.FE$objective if (is.element(optimizer, c("minqa::uobyqa","minqa::newuoa","minqa::bobyqa"))) ll.FE <- -1 * res.FE$fval if (optimizer == "nlm") ll.FE <- -1 * res.FE$minimum ### fit saturated FE model (= QE model) ### notes: 1) must figure out which terms are aliased in saturated model and remove those terms before fitting ### 2) start values from CM.AL model (res.QE) and tau^2=0 (random=FALSE) ### 3) so only try to fit saturated model if this was possible with CM.AL ### 4) no integration needed for FE model, so intCtrl is not relevant if (QEconv) { # QEconv is FALSE when skiphet=TRUE so this then also gets skipped automatically if (k > 1 && verbose) message(mstyle$message("Fitting saturated model ...")) if (k > 1) { b.QE <- coef(res.QE, complete=TRUE) # res.QE is from CM.AL model is.aliased <- is.na(b.QE) b.QE <- b.QE[!is.aliased] X.QE <- X.QE[,!is.aliased,drop=FALSE] optcall <- paste(optimizer, "(", par.arg, "=c(b.QE, 0), .dnchg, ", ifelse(optimizer=="optim", "method=optmethod, ", ""), "ai=ai, bi=bi, ci=ci, di=di, X.fit=X.QE, random=FALSE, verbose=verbose, digits=digits, dnchgcalc=con$dnchgcalc, dnchgprec=con$dnchgprec, intCtrl=intCtrl", ctrl.arg, ")\n", sep="") #return(optcall) if (verbose) { res.QE <- try(eval(str2lang(optcall)), silent=!verbose) } else { res.QE <- try(suppressWarnings(eval(str2lang(optcall))), silent=!verbose) } #return(res.QE) if (optimizer == "optimParallel::optimParallel" && verbose) { tmp <- capture.output(print(res.QE$loginfo)) .print.output(tmp, mstyle$verbose) } if (inherits(res.QE, "try-error")) { warning(mstyle$warning(paste0("Cannot fit saturated model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details)."))), call.=FALSE) QEconv <- FALSE ll.QE <- NA_real_ } ### convergence checks if (QEconv && is.element(optimizer, c("optim","nlminb","dfoptim::hjk","dfoptim::nmk","lbfgsb3c::lbfgsb3c","subplex::subplex","BB::BBoptim","Rcgmin::Rcgmin","Rvmmin:Rvmmin","optimParallel::optimParallel")) && res.QE$convergence != 0) { warning(mstyle$warning(paste0("Cannot fit saturated model. Optimizer (", optimizer, ") did not achieve convergence (convergence = ", res.QE$convergence, ").")), call.=FALSE) QEconv <- FALSE ll.QE <- NA_real_ } if (QEconv && is.element(optimizer, c("dfoptim::mads")) && res.QE$convergence > optCtrl$tol) { warning(mstyle$warning(paste0("Cannot fit saturated model. Optimizer (", optimizer, ") did not achieve convergence (convergence = ", res.QE$convergence, ").")), call.=FALSE) QEconv <- FALSE ll.QE <- NA_real_ } if (QEconv && is.element(optimizer, c("minqa::uobyqa","minqa::newuoa","minqa::bobyqa")) && res.QE$ierr != 0) { warning(mstyle$warning(paste0("Cannot fit saturated model. Optimizer (", optimizer, ") did not achieve convergence (ierr = ", res.QE$ierr, ").")), call.=FALSE) QEconv <- FALSE ll.QE <- NA_real_ } if (QEconv && optimizer=="nloptr::nloptr" && !(res.QE$status >= 1 && res.QE$status <= 4)) { warning(mstyle$warning(paste0("Cannot fit saturated model. Optimizer (", optimizer, ") did not achieve convergence (status = ", res.QE$status, ").")), call.=FALSE) QEconv <- FALSE ll.QE <- NA_real_ } if (QEconv && optimizer=="ucminf::ucminf" && !(res.QE$convergence == 1 || res.QE$convergence == 2)) { warning(mstyle$warning(paste0("Cannot fit saturated model. Optimizer (", optimizer, ") did not achieve convergence (convergence = ", res.QE$convergence, ").")), call.=FALSE) QEconv <- FALSE ll.QE <- NA_real_ } if (verbose > 2) { cat("\n") tmp <- capture.output(print(res.QE)) .print.output(tmp, mstyle$verbose) } ### copy estimated values to 'par' if (QEconv && optimizer=="nloptr::nloptr") res.QE$par <- res.QE$solution if (QEconv && optimizer=="nlm") res.QE$par <- res.QE$estimate if (QEconv) { if (verbose > 1) message(mstyle$message("Computing Hessian ...")) if (con$hesspack == "numDeriv") h.QE <- numDeriv::hessian(.dnchg, x=res.QE$par, method.args=hessianCtrl, ai=ai, bi=bi, ci=ci, di=di, X.fit=X.QE, random=FALSE, verbose=verbose, digits=digits, dnchgcalc=con$dnchgcalc, dnchgprec=con$dnchgprec) if (con$hesspack == "pracma") h.QE <- pracma::hessian(.dnchg, x0=res.QE$par, ai=ai, bi=bi, ci=ci, di=di, X.fit=X.QE, random=FALSE, verbose=verbose, digits=digits, dnchgcalc=con$dnchgcalc, dnchgprec=con$dnchgprec) } } else { res.QE <- res.FE h.QE <- h.FE } #return(list(res.QE, h.QE)) } if (k > 1 && QEconv) { ### log-likelihood if (is.element(optimizer, c("optim","dfoptim::hjk","dfoptim::nmk","dfoptim::mads","ucminf::ucminf","lbfgsb3c::lbfgsb3c","subplex::subplex","BB::BBoptim","Rcgmin::Rcgmin","Rvmmin:Rvmmin","optimParallel::optimParallel"))) ll.QE <- -1 * res.QE$value if (is.element(optimizer, c("nlminb","nloptr::nloptr"))) ll.QE <- -1 * res.QE$objective if (is.element(optimizer, c("minqa::uobyqa","minqa::newuoa","minqa::bobyqa"))) ll.QE <- -1 * res.QE$fval if (optimizer == "nlm") ll.QE <- -1 * res.QE$minimum ### extract coefficients and variance-covariance matrix for Wald-type test for heterogeneity #return(res.QE) b2.QE <- res.QE$par # recall: aliased coefficients are already removed hessian <- h.QE # take hessian from hessian() (again, aliased coefs are already removed) #hessian <- res.QE$hessian # take hessian from optim() (again, aliased coefs are already removed) p.QE <- length(b2.QE) # how many parameters are left in saturated model? b2.QE <- b2.QE[-p.QE] # remove last element (for tau^2, constrained to 0) hessian <- hessian[-p.QE,-p.QE,drop=FALSE] # remove last row/column (for tau^2, constrained to 0) p.QE <- length(b2.QE) # how many parameters are now left? is.0 <- colSums(hessian == 0L) == p.QE # any columns in hessian entirely composed of 0s? b2.QE <- b2.QE[!is.0] # keep coefficients where this is not the case hessian <- hessian[!is.0,!is.0,drop=FALSE] # keep parts of hessian where this is not the case b2.QE <- cbind(b2.QE[-seq_len(p)]) # remove first p coefficients h.A <- hessian[seq_len(p),seq_len(p),drop=FALSE] # upper left part of hessian h.B <- hessian[seq_len(p),-seq_len(p),drop=FALSE] # upper right part of hessian h.C <- hessian[-seq_len(p),seq_len(p),drop=FALSE] # lower left part of hessian h.D <- hessian[-seq_len(p),-seq_len(p),drop=FALSE] # lower right part of hessian (of which we need the inverse) chol.h.A <- try(chol(h.A), silent=!verbose) # see if h.A can be inverted with chol() if (inherits(chol.h.A, "try-error") || anyNA(chol.h.A)) { warning(mstyle$warning("Cannot invert Hessian for saturated model."), call.=FALSE) QE.Wld <- NA_real_ } else { Ivb2.QE <- h.D-h.C%*%chol2inv(chol.h.A)%*%h.B # inverse of the inverse of the lower right part QE.Wld <- c(t(b2.QE) %*% Ivb2.QE %*% b2.QE) # Wald statistic (note: this approach only requires taking the inverse of h.A) } # see: https://en.wikipedia.org/wiki/Invertible_matrix#Blockwise_inversion #vb2.QE <- chol2inv(chol(hessian))[-seq_len(p),-seq_len(p),drop=FALSE] # take inverse, then take part relevant for QE test #QE.Wld <- c(t(b2.QE) %*% chol2inv(chol(vb2.QE)) %*% b2.QE) } } if (is.element(optimizer, c("clogit","clogistic"))) { ### fit FE model ### notes: 1) this routine uses either clogit() from the survival package or clogistic() from the Epi package ### 2) the dataset must be in group-level and IPD format (i.e., not in the conditional format) ### 3) if the studies are large, the IPD dataset may also be very large, and R may run out of memory ### 4) for larger datasets, run time is often excessive (and may essentially freeze R) ### 5) suppressMessages for clogit() to suppress the 'beta may be infinite' warning ### prepare IPD dataset # study event group1 intrcpt moderator # i 1 1 1 x1i (repeated ai times) event <- unlist(lapply(seq_len(k), function(i) c(rep.int(1,ai[i]), rep.int(0,bi[i]), rep.int(1,ci[i]), rep.int(0,di[i])))) # event dummy i 0 1 1 x1i (repeated bi times) group1 <- unlist(lapply(seq_len(k), function(i) c(rep.int(1,ai[i]), rep.int(1,bi[i]), rep.int(0,ci[i]), rep.int(0,di[i])))) # group1 dummy i 1 0 0 0 (repeated ci times) study.l <- factor(rep(seq_len(k), times=ni)) # study factor i 0 0 0 0 (repeated di times) X.fit.l <- X[rep(seq_len(k), times=ni),,drop=FALSE] # repeat each row in X ni times each X.fit.l <- cbind(group1*X.fit.l) # multiply by group1 dummy (including intercept, which becomes the group1 dummy) const <- rep(1,length(event)) if (.isTRUE(ddd$retdat)) return(data.frame(event, group1, study.l, X.fit.l, const)) ### fit FE model if (k > 1) { if (optimizer == "clogit") { args.clogit <- clogitCtrl args.clogit$formula <- event ~ X.fit.l + strata(study.l) res.FE <- try(do.call(clogit, args.clogit), silent=!verbose) } if (optimizer == "clogistic") { args.clogistic <- clogisticCtrl args.clogistic$formula <- event ~ X.fit.l args.clogistic$strata <- study.l res.FE <- try(do.call(Epi::clogistic, args.clogistic), silent=!verbose) } } else { stop(mstyle$stop(paste0("Cannot use '", optimizer, "' optimizer when k=1."))) } if (inherits(res.FE, "try-error")) stop(mstyle$stop(paste0("Cannot fit FE model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details).")))) ### fit saturated FE model (= QE model) ### notes: 1) must figure out which terms are aliased in saturated model and remove those terms before fitting ### 2) fixed effects part does not include 'study' factor, since this is incorporated into the strata ### 3) however, for calculating the log likelihood, we need to go back to the conditional data, so we need to reconstruct X.QE (the study.l:group1 coefficients are the study coefficients) if (QEconv) { # QEconv is FALSE when skiphet=TRUE so this then also gets skipped automatically if (verbose) message(mstyle$message("Fitting saturated model ...")) b.QE <- coef(res.QE, complete=TRUE) # res.QE is from CM.AL model is.aliased <- is.na(b.QE) X.QE.l <- model.matrix(~ -1 + X.fit.l + study.l:group1) X.QE.l <- X.QE.l[,!is.aliased,drop=FALSE] X.QE <- X.QE[,!is.aliased,drop=FALSE] if (optimizer == "clogit") { args.clogit <- clogitCtrl args.clogit$formula <- event ~ X.QE.l + strata(study.l) #args.clogit$method <- "efron" # c("exact", "approximate", "efron", "breslow") if (verbose) { res.QE <- try(do.call(clogit, args.clogit), silent=!verbose) } else { res.QE <- try(suppressWarnings(do.call(clogit, args.clogit)), silent=!verbose) } } if (optimizer == "clogistic") { args.clogistic <- clogisticCtrl args.clogistic$formula <- event ~ X.QE.l args.clogistic$strata <- study.l res.QE <- try(do.call(Epi::clogistic, args.clogistic), silent=!verbose) } if (inherits(res.QE, "try-error")) stop(mstyle$stop(paste0("Cannot fit saturated model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details).")))) ### log-likelihood ll.FE <- -1 * .dnchg(c(cbind(coef(res.FE)),0), ai=ai, bi=bi, ci=ci, di=di, X.fit=X.fit, random=FALSE, verbose=verbose, digits=digits, dnchgcalc=con$dnchgcalc, dnchgprec=con$dnchgprec) ll.QE <- -1 * .dnchg(c(cbind(coef(res.QE)),0), ai=ai, bi=bi, ci=ci, di=di, X.fit=X.QE, random=FALSE, verbose=verbose, digits=digits, dnchgcalc=con$dnchgcalc, dnchgprec=con$dnchgprec) ### extract coefficients and variance-covariance matrix for Wald-type test for heterogeneity b2.QE <- cbind(coef(res.QE)[-seq_len(p)]) # aliased coefficients are already removed vb2.QE <- vcov(res.QE)[-seq_len(p),-seq_len(p),drop=FALSE] # aliased coefficients are already removed } } #return(list(res.FE, res.QE, ll.FE=ll.FE, ll.QE=ll.QE)) #res.FE <- res[[1]]; res.QE <- res[[2]] if (method == "ML") { ### fit ML model ### notes: 1) cannot use clogit() or clogistic() for this (do not allow for the addition of random effects) ### 2) mclogit() from mclogit package may be an alternative (but it only provides a PQL method) ### 3) start values from CM.AL model (add .01 to tau^2 estimate, in case estimate of tau^2 is 0) ### 4) optimization involves integration, so intCtrl is relevant ### 5) results can be sensitive to the scaling of moderators if (verbose) message(mstyle$message("Fitting ML model ...")) optcall <- paste(optimizer, "(", par.arg, "=c(beta, log(tau2+.01)), .dnchg, ", ifelse(optimizer=="optim", "method=optmethod, ", ""), "ai=ai, bi=bi, ci=ci, di=di, X.fit=X.fit, random=TRUE, verbose=verbose, digits=digits, dnchgcalc=con$dnchgcalc, dnchgprec=con$dnchgprec, intCtrl=intCtrl", ctrl.arg, ")\n", sep="") #return(optcall) if (verbose) { res.ML <- try(eval(str2lang(optcall)), silent=!verbose) } else { res.ML <- try(suppressWarnings(eval(str2lang(optcall))), silent=!verbose) } #return(res.ML) if (optimizer == "optimParallel::optimParallel" && verbose) { tmp <- capture.output(print(res.ML$loginfo)) .print.output(tmp, mstyle$verbose) } if (inherits(res.ML, "try-error")) stop(mstyle$stop(paste0("Cannot fit ML model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details).")))) ### convergence checks if (is.element(optimizer, c("optim","nlminb","dfoptim::hjk","dfoptim::nmk","lbfgsb3c::lbfgsb3c","subplex::subplex","BB::BBoptim","Rcgmin::Rcgmin","Rvmmin:Rvmmin","optimParallel::optimParallel")) && res.ML$convergence != 0) stop(mstyle$stop(paste0("Cannot fit ML model. Optimizer (", optimizer, ") did not achieve convergence (convergence = ", res.ML$convergence, ")."))) if (is.element(optimizer, c("dfoptim::mads")) && res.ML$convergence > optCtrl$tol) stop(mstyle$stop(paste0("Cannot fit ML model. Optimizer (", optimizer, ") did not achieve convergence (convergence = ", res.ML$convergence, ")."))) if (is.element(optimizer, c("minqa::uobyqa","minqa::newuoa","minqa::bobyqa")) && res.ML$ierr != 0) stop(mstyle$stop(paste0("Cannot fit ML model. Optimizer (", optimizer, ") did not achieve convergence (ierr = ", res.ML$ierr, ")."))) if (optimizer=="nloptr::nloptr" && !(res.ML$status >= 1 && res.ML$status <= 4)) stop(mstyle$stop(paste0("Cannot fit ML model. Optimizer (", optimizer, ") did not achieve convergence (status = ", res.ML$status, ")."))) if (optimizer=="ucminf::ucminf" && !(res.ML$convergence == 1 || res.ML$convergence == 2)) stop(mstyle$stop(paste0("Cannot fit ML model. Optimizer (", optimizer, ") did not achieve convergence (convergence = ", res.ML$convergence, ")."))) if (verbose > 2) { cat("\n") tmp <- capture.output(print(res.ML)) .print.output(tmp, mstyle$verbose) } ### copy estimated values to 'par' if (optimizer=="nloptr::nloptr") res.ML$par <- res.ML$solution if (optimizer=="nlm") res.ML$par <- res.ML$estimate if (verbose > 1) message(mstyle$message("Computing Hessian ...")) tau2eff0 <- exp(res.ML$par[p+1]) < con$tau2tol if (tau2eff0) method <- "T0" if (con$hesspack == "numDeriv") h.ML <- numDeriv::hessian(.dnchg, x=res.ML$par, method.args=hessianCtrl, ai=ai, bi=bi, ci=ci, di=di, X.fit=X.fit, random=!tau2eff0, verbose=verbose, digits=digits, dnchgcalc=con$dnchgcalc, dnchgprec=con$dnchgprec, intCtrl=intCtrl) if (con$hesspack == "pracma") h.ML <- pracma::hessian(.dnchg, x0=res.ML$par, ai=ai, bi=bi, ci=ci, di=di, X.fit=X.fit, random=!tau2eff0, verbose=verbose, digits=digits, dnchgcalc=con$dnchgcalc, dnchgprec=con$dnchgprec, intCtrl=intCtrl) #return(list(res.ML, h.ML)) ### log-likelihood if (is.element(optimizer, c("optim","dfoptim::hjk","dfoptim::nmk","dfoptim::mads","ucminf::ucminf","lbfgsb3c::lbfgsb3c","subplex::subplex","BB::BBoptim","Rcgmin::Rcgmin","Rvmmin:Rvmmin","optimParallel::optimParallel"))) ll.ML <- -1 * res.ML$value if (is.element(optimizer, c("nlminb","nloptr::nloptr"))) ll.ML <- -1 * res.ML$objective if (is.element(optimizer, c("minqa::uobyqa","minqa::newuoa","minqa::bobyqa"))) ll.ML <- -1 * res.ML$fval if (optimizer == "nlm") ll.ML <- -1 * res.ML$minimum } #return(list(res.FE, res.QE, res.ML, ll.FE=ll.FE, ll.QE=ll.QE, ll.ML=ll.ML)) #res.FE <- res[[1]]; res.QE <- res[[2]]; res.ML <- res[[3]] if (is.element(method, c("FE","EE","CE","T0"))) { if (!is.element(optimizer, c("clogit","clogistic"))) { beta <- cbind(res.FE$par[seq_len(p)]) chol.h <- try(chol(h.FE[seq_len(p),seq_len(p)]), silent=!verbose) # see if Hessian can be inverted with chol() if (inherits(chol.h, "try-error") || anyNA(chol.h)) { if (anyNA(chol.h)) stop(mstyle$stop(paste0("Cannot invert Hessian for the ", ifelse(method == "T0", "ML", method), " model."))) warning(mstyle$warning("Choleski factorization of Hessian failed. Trying inversion via QR decomposition."), call.=FALSE) vb <- try(qr.solve(h.FE[seq_len(p),seq_len(p)]), silent=!verbose) # see if Hessian can be inverted with qr.solve() if (inherits(vb, "try-error")) stop(mstyle$stop(paste0("Cannot invert Hessian for the ", ifelse(method == "T0", "ML", method), " model."))) } else { vb <- chol2inv(chol.h) } } if (is.element(optimizer, c("clogit","clogistic"))) { beta <- cbind(coef(res.FE)[seq_len(p)]) vb <- vcov(res.FE)[seq_len(p),seq_len(p),drop=FALSE] } tau2 <- 0 sigma2 <- NA_real_ parms <- p p.eff <- p k.eff <- k } if (method == "ML") { beta <- cbind(res.ML$par[seq_len(p)]) chol.h <- try(chol(h.ML), silent=!verbose) # see if Hessian can be inverted with chol() if (inherits(chol.h, "try-error") || anyNA(chol.h)) { if (anyNA(chol.h)) stop(mstyle$stop("Cannot invert Hessian for the ML model.")) warning(mstyle$warning("Choleski factorization of Hessian failed. Trying inversion via QR decomposition."), call.=FALSE) vb.f <- try(qr.solve(h.ML), silent=!verbose) # see if Hessian can be inverted with qr.solve() if (inherits(vb.f, "try-error")) stop(mstyle$stop("Cannot invert Hessian for the ML model.")) } else { vb.f <- chol2inv(chol.h) } vb <- vb.f[seq_len(p),seq_len(p),drop=FALSE] if (any(diag(vb) <= 0)) stop(mstyle$stop("Cannot compute var-cov matrix of the fixed effects.")) tau2 <- exp(res.ML$par[p+1]) sigma2 <- NA_real_ parms <- p + 1 p.eff <- p k.eff <- k if (vb.f[p+1,p+1] >= 0) { se.tau2 <- sqrt(vb.f[p+1,p+1]) * tau2 # delta rule: vb[p+1,p+1] is the variance of log(tau2), so vb[p+1,p+1] * tau2^2 is the variance of exp(log(tau2)) crit <- qnorm(level/2, lower.tail=FALSE) ci.lb.tau2 <- exp(res.ML$par[p+1] - crit * sqrt(vb.f[p+1,p+1])) ci.ub.tau2 <- exp(res.ML$par[p+1] + crit * sqrt(vb.f[p+1,p+1])) } } if (is.element(method, c("ML","T0"))) { tmp <- try(rma.uni(measure="PETO", ai=ai, bi=bi, ci=ci, di=di, add=0, mods=X.fit, intercept=FALSE, skipr2=TRUE), silent=TRUE) if (!inherits(tmp, "try-error")) { gvar1 <- det(vcov(tmp)) gvar2 <- det(vb) ratio <- (gvar1 / gvar2)^(1/(2*m)) if (!is.na(ratio) && ratio >= 100) { warning(mstyle$warning("Standard errors of fixed effects appear to be unusually small. Treat results with caution."), call.=FALSE) se.warn <- TRUE } if (!is.na(ratio) && ratio <= 1/100) { warning(mstyle$warning("Standard errors of fixed effects appear to be unusually large. Treat results with caution."), call.=FALSE) se.warn <- TRUE } } } if (method == "T0") { tau2 <- exp(res.ML$par[p+1]) parms <- p + 1 se.tau2 <- 0 method <- "ML" } #return(list(beta=beta, vb=vb, tau2=tau2, sigma2=sigma2, parms=parms, p.eff=p.eff, k.eff=k.eff, b2.QE=b2.QE, vb2.QE=vb2.QE)) } } ######################################################################### ######################################################################### ######################################################################### ### one group outcomes (log odds and log transformed rates) if (is.element(measure, c("PLO","PR","PLN","IRLN"))) { ### prepare data if (is.element(measure, c("PLO","PR","PLN"))) { dat.grp <- cbind(xi=xi,mi=mi) if (is.null(ddd$family)) { if (measure == "PLO") dat.fam <- binomial(link=link) #dat.fam <- binomial(link="probit") if (measure == "PR") #dat.fam <- eval(parse(text="binomial(link=\"identity\")")) dat.fam <- binomial(link=link) if (measure == "PLN") dat.fam <- binomial(link=link) } else { dat.fam <- ddd$family } dat.off <- NULL } if (is.element(measure, c("IRLN"))) { dat.grp <- xi if (is.null(ddd$family)) { dat.fam <- poisson(link=link) } else { dat.fam <- ddd$family } dat.off <- log(ti) } study <- factor(seq_len(k)) # study factor X.fit <- X if (.isTRUE(ddd$retdat)) return(list(dat.grp=dat.grp, X.fit=X.fit, study=study, dat.off = if (!is.null(dat.off)) dat.off else NULL, dat.fam=dat.fam)) ### fit FE model if (verbose) message(mstyle$message("Fitting FE model ...")) res.FE <- try(glm(dat.grp ~ -1 + X.fit, offset=dat.off, family=dat.fam, control=glmCtrl), silent=!verbose) if (inherits(res.FE, "try-error")) stop(mstyle$stop(paste0("Cannot fit FE model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details).")))) ### log-likelihood #ll.FE <- with(data.frame(dat.grp), sum(dbinom(xi, xi+mi, predict(res.FE, type="response"), log=TRUE))) # model has a NULL offset #ll.FE <- with(data.frame(dat.grp), sum(dpois(xi, predict(res.FE, type="response"), log=TRUE))) # offset already incorporated into predict() ll.FE <- c(logLik(res.FE)) # same as above ### fit saturated FE model (= QE model) ### notes: 1) suppressWarnings() to suppress warning "glm.fit: fitted probabilities numerically 0 or 1 occurred" QEconv <- FALSE ll.QE <- NA_real_ if (!isTRUE(ddd$skiphet)) { if (k > 1 && verbose) message(mstyle$message("Fitting saturated model ...")) if (k > 1) { X.QE <- model.matrix(~ -1 + X.fit + study) if (verbose) { res.QE <- try(glm(dat.grp ~ -1 + X.QE, offset=dat.off, family=dat.fam, control=glmCtrl), silent=!verbose) } else { res.QE <- try(suppressWarnings(glm(dat.grp ~ -1 + X.QE, offset=dat.off, family=dat.fam, control=glmCtrl)), silent=!verbose) } } else { res.QE <- res.FE } if (inherits(res.QE, "try-error")) { warning(mstyle$warning(paste0("Cannot fit saturated model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details)."))), call.=FALSE) } else { QEconv <- TRUE ### log-likelihood #ll.QE <- with(data.frame(dat.grp), sum(dbinom(xi, xi+mi, xi/(xi+mi), log=TRUE))) # model has a NULL offset #ll.QE <- with(data.frame(dat.grp), sum(dpois(xi, xi, log=TRUE))) # offset not relevant for saturated model ll.QE <- c(logLik(res.QE)) # same as above ### extract coefficients and variance-covariance matrix for Wald-type test for heterogeneity #b2.QE <- cbind(na.omit(coef(res.QE)[-seq_len(p)])) # coef() still includes aliased coefficients as NAs, so filter them out b2.QE <- cbind(coef(res.QE, complete=FALSE)[-seq_len(p)]) # aliased coefficients are removed by coef() when complete=FALSE vb2.QE <- vcov(res.QE, complete=FALSE)[-seq_len(p),-seq_len(p),drop=FALSE] # aliased coefficients are removed by vcov() when complete=FALSE } } if (method == "ML") { ### fit ML model ### notes: 1) suppressMessages to suppress the 'one random effect per observation' warning if (verbose) message(mstyle$message("Fitting ML model ...")) if (package == "lme4") { if (verbose) { res.ML <- try(lme4::glmer(dat.grp ~ -1 + X.fit + (1 | study), offset=dat.off, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=do.call(lme4::glmerControl, glmerCtrl)), silent=!verbose) } else { res.ML <- suppressMessages(try(lme4::glmer(dat.grp ~ -1 + X.fit + (1 | study), offset=dat.off, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=do.call(lme4::glmerControl, glmerCtrl)), silent=!verbose)) } } if (package == "GLMMadaptive") { if (is.element(measure, c("PLO","PR","PLN"))) { dat.mm <- data.frame(xi=dat.grp[,"xi"], mi=dat.grp[,"mi"], study=study) res.ML <- try(GLMMadaptive::mixed_model(cbind(xi,mi) ~ -1 + X.fit, random = ~ 1 | study, data=dat.mm, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=glmerCtrl), silent=!verbose) } else { dat.mm <- data.frame(xi=dat.grp, study=study) res.ML <- try(GLMMadaptive::mixed_model(xi ~ -1 + X.fit + offset(dat.off), random = ~ 1 | study, data=dat.mm, family=dat.fam, nAGQ=nAGQ, verbose=verbose, control=glmerCtrl), silent=!verbose) } } if (package == "glmmTMB") { if (verbose) { res.ML <- try(glmmTMB::glmmTMB(dat.grp ~ -1 + X.fit + (1 | study), offset=dat.off, family=dat.fam, verbose=verbose, data=NULL, control=do.call(glmmTMB::glmmTMBControl, glmerCtrl)), silent=!verbose) } else { res.ML <- suppressMessages(try(glmmTMB::glmmTMB(dat.grp ~ -1 + X.fit + (1 | study), offset=dat.off, family=dat.fam, verbose=verbose, data=NULL, control=do.call(glmmTMB::glmmTMBControl, glmerCtrl)), silent=!verbose)) } } if (inherits(res.ML, "try-error")) stop(mstyle$stop(paste0("Cannot fit ML model", ifelse(verbose, ".", " (set 'verbose=TRUE' to obtain further details).")))) #return(res.ML) ### log-likelihood #ll.ML <- with(data.frame(dat.grp), sum(dbinom(xi, xi+mi, fitted(res.ML), log=TRUE))) # not correct (since it does not incorporate the random effects; same as ll.FE if tau^2=0) #ll.ML <- with(data.frame(dat.grp), sum(dbinom(xi, xi+mi, plogis(qlogis(fitted(res.ML)) + group12*unlist(ranef(res.ML))), log=TRUE))) # not correct (since one really has to integrate; same as ll.FE if tau^2=0) #ll.ML <- with(data.frame(dat.grp), sum(dbinom(xi, xi+mi, plogis(predict(res.ML))))) # not correct (since one really has to integrate; same as ll.FE if tau^2=0) #ll.ML <- c(logLik(res.ML)) # this is not the same as ll.FE when tau^2 = 0 (not sure why) if (package == "lme4") { ll.ML <- ll.QE - 1/2 * deviance(res.ML) # this makes ll.ML comparable to ll.FE (same as ll.FE when tau^2=0) } else { ### FIXME: When using GLMMadaptive, ll is not comparable for FE model when tau^2 = 0 ll.ML <- c(logLik(res.ML)) } } #return(list(res.FE, res.QE, res.ML, ll.FE=ll.FE, ll.QE=ll.QE, ll.ML=ll.ML)) #res.FE <- res[[1]]; res.QE <- res[[2]]; res.ML <- res[[3]] if (is.element(method, c("FE","EE","CE"))) { beta <- cbind(coef(res.FE)[seq_len(p)]) vb <- vcov(res.FE)[seq_len(p),seq_len(p),drop=FALSE] tau2 <- 0 sigma2 <- NA_real_ parms <- p p.eff <- p k.eff <- k } if (method == "ML") { if (package == "lme4") { beta <- cbind(lme4::fixef(res.ML)[seq_len(p)]) vb <- as.matrix(vcov(res.ML))[seq_len(p),seq_len(p),drop=FALSE] tau2 <- lme4::VarCorr(res.ML)[[1]][1] } if (package == "GLMMadaptive") { beta <- cbind(GLMMadaptive::fixef(res.ML)[seq_len(p)]) vb <- as.matrix(vcov(res.ML))[seq_len(p),seq_len(p),drop=FALSE] tau2 <- res.ML$D[1,1] } if (package == "glmmTMB") { beta <- cbind(glmmTMB::fixef(res.ML)$cond[seq_len(p)]) vb <- as.matrix(vcov(res.ML)$cond)[seq_len(p),seq_len(p),drop=FALSE] tau2 <- glmmTMB::VarCorr(res.ML)[[1]][[1]][[1]] } sigma2 <- NA_real_ parms <- p + 1 p.eff <- p k.eff <- k } #return(list(beta=beta, vb=vb, tau2=tau2, sigma2=sigma2, parms=parms, p.eff=p.eff, k.eff=k.eff, b2.QE=b2.QE, vb2.QE=vb2.QE)) } ######################################################################### ######################################################################### ######################################################################### ### heterogeneity tests (Wald-type and likelihood ratio tests of the extra coefficients in the saturated model) if (verbose > 1) message(mstyle$message("Conducting heterogeneity tests ...")) if (k > 1 && QEconv) { ### for OR + CM.EL + NOT clogit/clogistic, QE.Wld is already calculated, so skip this part then if (!(measure == "OR" && model == "CM.EL" && !is.element(optimizer, c("clogit","clogistic")))) { if (nrow(vb2.QE) > 0) { chol.h <- try(chol(vb2.QE), silent=!verbose) # see if Hessian can be inverted with chol() if (inherits(chol.h, "try-error") || anyNA(chol.h)) { warning(mstyle$warning("Cannot invert Hessian for saturated model."), call.=FALSE) QE.Wld <- NA_real_ } else { QE.Wld <- try(c(t(b2.QE) %*% chol2inv(chol.h) %*% b2.QE), silent=!verbose) if (inherits(QE.Wld, "try-error")) { warning(mstyle$warning("Cannot invert Hessian for saturated model."), call.=FALSE) QE.Wld <- NA_real_ } } } else { QE.Wld <- 0 # if vb2.QE has 0x0 dims, then fitted model is the saturated model and QE.Wld must be 0 } } QE.LRT <- -2 * (ll.FE - ll.QE) QE.Wld[QE.Wld <= 0] <- 0 QE.LRT[QE.LRT <= 0] <- 0 #QE.df <- length(b2.QE) # removed coefficients are not counted if dfs are determined like this QE.df <- k-p # this yields always the same dfs regardless of how many coefficients are removed if (QE.df > 0L) { QEp.Wld <- pchisq(QE.Wld, df=QE.df, lower.tail=FALSE) QEp.LRT <- pchisq(QE.LRT, df=QE.df, lower.tail=FALSE) } else { QEp.Wld <- 1 QEp.LRT <- 1 } } else { QE.Wld <- NA_real_ QE.LRT <- NA_real_ QEp.Wld <- NA_real_ QEp.LRT <- NA_real_ QE.df <- NA_integer_ } ### calculation of I^2 and H^2 wi <- 1/vi W <- diag(wi, nrow=k.yi, ncol=k.yi) stXWX <- .invcalc(X=X.yi, W=W, k=k.yi) P <- W - W %*% X.yi %*% stXWX %*% crossprod(X.yi,W) if (i2def == "1") vt <- (k.yi-p) / .tr(P) if (i2def == "2") vt <- 1/mean(wi) # harmonic mean of vi's (see Takkouche et al., 1999) #vt <- (k-1) / (sum(wi) - sum(wi^2)/sum(wi)) # this only applies to the RE model I2 <- 100 * tau2 / (vt + tau2) H2 <- tau2 / vt + 1 ### testing of the fixed effects in the model if (verbose > 1) message(mstyle$message("Conducting tests of the fixed effects ...")) chol.h <- try(chol(vb[btt,btt]), silent=!verbose) # see if Hessian can be inverted with chol() if (inherits(chol.h, "try-error") || anyNA(chol.h)) { warning(mstyle$warning("Cannot invert Hessian for QM test."), call.=FALSE) QM <- NA_real_ } else { QM <- as.vector(t(beta)[btt] %*% chol2inv(chol.h) %*% beta[btt]) } ### scale back beta and vb if (!int.only && int.incl && con$scaleX) { mX <- rbind(c(intrcpt=1, -1*ifelse(is.d[-1], 0, meanX/sdX)), cbind(0, diag(ifelse(is.d[-1], 1, 1/sdX), nrow=length(is.d)-1, ncol=length(is.d)-1))) beta <- mX %*% beta vb <- mX %*% vb %*% t(mX) X <- Xsave } ### ddf calculation if (test == "t") { ddf <- k-p } else { ddf <- NA_integer_ } ### abbreviate some types of coefficient names if (.isTRUE(ddd$abbrev)) { tmp <- colnames(X) tmp <- gsub("relevel(factor(", "", tmp, fixed=TRUE) tmp <- gsub("\\), ref = \"[[:alnum:]]*\")", "", tmp) tmp <- gsub("poly(", "", tmp, fixed=TRUE) tmp <- gsub(", degree = [[:digit:]], raw = TRUE)", "^", tmp) tmp <- gsub(", degree = [[:digit:]], raw = T)", "^", tmp) tmp <- gsub(", degree = [[:digit:]])", "^", tmp) tmp <- gsub("rcs\\([[:alnum:]]*, [[:digit:]]\\)", "", tmp) tmp <- gsub("factor(", "", tmp, fixed=TRUE) tmp <- gsub("I(", "", tmp, fixed=TRUE) tmp <- gsub(")", "", tmp, fixed=TRUE) colnames(X) <- tmp } rownames(beta) <- rownames(vb) <- colnames(vb) <- colnames(X.f) <- colnames(X) ve <- diag(vb) se <- ifelse(ve >= 0, sqrt(ve), NA_real_) names(se) <- NULL zval <- c(beta/se) if (test == "t") { QM <- QM / m QMdf <- c(m, k-p) QMp <- if (QMdf[2] > 0) pf(QM, df1=QMdf[1], df2=QMdf[2], lower.tail=FALSE) else NA_real_ pval <- if (ddf > 0) 2*pt(abs(zval), df=ddf, lower.tail=FALSE) else rep(NA_real_, p) crit <- if (ddf > 0) qt(level/2, df=ddf, lower.tail=FALSE) else rep(NA_real_, p) } else { QMdf <- c(m, NA_integer_) QMp <- pchisq(QM, df=QMdf[1], lower.tail=FALSE) pval <- 2*pnorm(abs(zval), lower.tail=FALSE) crit <- qnorm(level/2, lower.tail=FALSE) } ci.lb <- c(beta - crit * se) ci.ub <- c(beta + crit * se) #return(list(beta=beta, se=se, zval=zval, ci.lb=ci.lb, ci.ub=ci.ub, vb=vb, tau2=tau2, QM=QM, QMp=QMp)) ######################################################################### ###### fit statistics if (verbose > 1) message(mstyle$message("Computing fit statistics and log likelihood ...")) ll.ML <- ifelse(is.element(method, c("FE","EE","CE")), ll.FE, ll.ML) ll.REML <- NA_real_ dev.ML <- -2 * (ll.ML - ll.QE) AIC.ML <- -2 * ll.ML + 2*parms BIC.ML <- -2 * ll.ML + parms * log(k.eff) AICc.ML <- -2 * ll.ML + 2*parms * max(k.eff, parms+2) / (max(k.eff, parms+2) - parms - 1) dev.REML <- NA_real_ AIC.REML <- NA_real_ BIC.REML <- NA_real_ AICc.REML <- NA_real_ fit.stats <- matrix(c(ll.ML, dev.ML, AIC.ML, BIC.ML, AICc.ML, ll.REML, dev.REML, AIC.REML, BIC.REML, AICc.REML), ncol=2, byrow=FALSE) dimnames(fit.stats) <- list(c("ll","dev","AIC","BIC","AICc"), c("ML","REML")) fit.stats <- data.frame(fit.stats) ######################################################################### ###### prepare output if (verbose > 1) message(mstyle$message("Preparing output ...")) weighted <- TRUE if (is.null(ddd$outlist) || ddd$outlist == "nodata") { outdat <- list(ai=ai, bi=bi, ci=ci, di=di, x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, xi=xi, mi=mi, ti=ti) res <- list(b=beta, beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, vb=vb, tau2=tau2, se.tau2=se.tau2, sigma2=sigma2, rho=rho, ci.lb.tau2=ci.lb.tau2, ci.ub.tau2=ci.ub.tau2, I2=I2, H2=H2, vt=vt, QE.Wld=QE.Wld, QEp.Wld=QEp.Wld, QE.LRT=QE.LRT, QEp.LRT=QEp.LRT, QE.df=QE.df, QM=QM, QMdf=QMdf, QMp=QMp, k=k, k.f=k.f, k.yi=k.yi, k.eff=k.eff, k.all=k.all, p=p, p.eff=p.eff, parms=parms, int.only=int.only, int.incl=int.incl, intercept=intercept, yi=yi, vi=vi, X=X, yi.f=yi.f, vi.f=vi.f, X.f=X.f, outdat.f=outdat.f, outdat=outdat, ni=ni, ni.f=ni.f, ids=ids, not.na=not.na, subset=subset, not.na.yivi=not.na.yivi, slab=slab, slab.null=slab.null, measure=measure, method=method, model=model, weighted=weighted, test=test, dfs=ddf, ddf=ddf, btt=btt, m=m, digits=digits, level=level, control=control, verbose=verbose, add=add, to=to, drop00=drop00, fit.stats=fit.stats, se.warn=se.warn, formula.yi=NULL, formula.mods=formula.mods, version=packageVersion("metafor"), call=mf) if (is.null(ddd$outlist)) res <- append(res, list(data=data), which(names(res) == "fit.stats")) } else { if (ddd$outlist == "minimal") { res <- list(b=beta, beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, vb=vb, tau2=tau2, se.tau2=se.tau2, sigma2=sigma2, I2=I2, H2=H2, QE.Wld=QE.Wld, QEp.Wld=QEp.Wld, QE.LRT=QE.LRT, QEp.LRT=QEp.LRT, QE.df=QE.df, QEp=QEp, QM=QM, QMdf=QMdf, QMp=QMp, k=k, k.eff=k.eff, p=p, p.eff=p.eff, parms=parms, int.only=int.only, measure=measure, method=method, model=model, test=test, dfs=ddf, ddf=ddf, btt=btt, m=m, digits=digits, fit.stats=fit.stats) } else { res <- eval(str2lang(paste0("list(", ddd$outlist, ")"))) } } if (.isTRUE(ddd$retfit)) { res$res.FE <- res.FE if (!isTRUE(ddd$skiphet)) res$res.QE <- res.QE if (method == "ML") res$res.ML <- res.ML } time.end <- proc.time() res$time <- unname(time.end - time.start)[3] if (.isTRUE(ddd$time)) .print.time(res$time) if (verbose || .isTRUE(ddd$time)) cat("\n") class(res) <- c("rma.glmm", "rma") return(res) } metafor/R/vec2mat.r0000644000176200001440000000145514401677770013656 0ustar liggesusersvec2mat <- function(x, diag=FALSE, corr=!diag, dimnames) { mstyle <- .get.mstyle("crayon" %in% .packages()) p <- length(x) dims <- sqrt(2*p + 1/4) + ifelse(diag, -1/2, 1/2) if (abs(dims - round(dims)) >= .Machine$double.eps^0.5) stop(mstyle$stop("Length of 'x' does not correspond to a square matrix.")) dims <- round(dims) R <- matrix(NA_real_, nrow=dims, ncol=dims) if (!missing(dimnames)) { if (length(dimnames) != dims) stop(mstyle$stop(paste0("Length of 'dimnames' (", length(dimnames), ") does not correspond to the dimensions of the matrix (", dims, ")."))) rownames(R) <- colnames(R) <- dimnames } R[lower.tri(R, diag=diag)] <- x R[upper.tri(R, diag=diag)] <- t(R)[upper.tri(R, diag=diag)] if (corr) diag(R) <- 1 return(R) } metafor/R/confint.rma.mh.r0000644000176200001440000000372714160126136015125 0ustar liggesusersconfint.rma.mh <- function(object, parm, level, digits, transf, targs, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.mh") if (!missing(parm)) warning(mstyle$warning("Argument 'parm' (currently) ignored."), call.=FALSE) x <- object if (missing(level)) level <- x$level if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL ddd <- list(...) .chkdots(ddd, c("time")) if (.isTRUE(ddd$time)) time.start <- proc.time() ######################################################################### level <- .level(level) crit <- qnorm(level/2, lower.tail=FALSE) beta <- x$beta ci.lb <- beta - crit * x$se ci.ub <- beta + crit * x$se ### if requested, apply transformation function if (.isTRUE(transf) && is.element(x$measure, c("OR","RR","IRR"))) ### if transf=TRUE, apply exp transformation to ORs, RRs, and IRRs transf <- exp if (is.function(transf)) { if (is.null(targs)) { beta <- sapply(beta, transf) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) } else { beta <- sapply(beta, transf, targs) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) } } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] ######################################################################### res <- cbind(estimate=beta, ci.lb, ci.ub) res <- list(fixed=res) rownames(res$fixed) <- "" res$digits <- digits if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(res) <- "confint.rma" return(res) } metafor/R/print.tes.r0000644000176200001440000000465714305063253014236 0ustar liggesusersprint.tes <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="tes") digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) .space() cat(mstyle$section(paste("Test of Excess Significance"))) cat("\n\n") cat(mstyle$text("Observed Number of Significant Findings: ")) cat(mstyle$result(x$O)) cat(mstyle$result(paste0(" (out of ", x$k, ")"))) cat("\n") cat(mstyle$text("Expected Number of Significant Findings: ")) cat(mstyle$result(fmtx(x$E, digits[["est"]]))) cat("\n") cat(mstyle$text("Observed Number / Expected Number: ")) cat(mstyle$result(fmtx(x$OEratio, digits[["est"]]))) cat("\n\n") if (length(x$theta) == 1L) { cat(mstyle$text("Estimated Power of Tests (based on theta = ")) cat(mstyle$result(fmtx(x$theta, digits[["est"]]))) cat(mstyle$text(")")) } else { cat(mstyle$text("Estimated Power of Tests: ")) } cat("\n\n") if (x$k > 5L) { power <- quantile(x$power) names(power) <- c("min", "q1", "median", "q3", "max") } else { power <- x$power names(power) <- seq_len(x$k) } tmp <- capture.output(.print.vector(fmtx(power, digits[["pval"]]))) .print.table(tmp, mstyle) cat("\n") cat(mstyle$text("Test of Excess Significance: ")) cat(mstyle$result(paste0("p ", fmtp(x$pval, digits[["pval"]], equal=TRUE, sep=TRUE)))) if (x$test == "chi2") { cat(mstyle$result(paste0(" (X^2 = ", fmtx(x$X2, digits[["test"]]), ", df = 1)"))) } if (x$test == "binom") { cat(mstyle$result(" (binomial test)")) } if (x$test == "exact") { cat(mstyle$result(" (exact test)")) } cat("\n") if (!is.null(x$theta.lim)) { cat(mstyle$text(paste0("Limit Estimate (theta_lim): "))) if (is.na(x$theta.lim[1])) { cat(mstyle$result("not estimable")) } else { cat(mstyle$result(fmtx(x$theta.lim[1], digits[["est"]]))) } if (length(x$theta.lim) == 2L) { cat(mstyle$result(", ")) if (is.na(x$theta.lim[2])) { cat(mstyle$result("not estimable")) } else { cat(mstyle$result(fmtx(x$theta.lim[2], digits[["est"]]))) } } if (any(!is.na(x$theta.lim))) cat(mstyle$result(paste0(" (where p = ", ifelse(x$tes.alternative == "two.sided", x$tes.alpha/2, x$tes.alpha), ")"))) cat("\n") } .space() invisible() } metafor/R/reporter.r0000644000176200001440000000006613457322061014142 0ustar liggesusersreporter <- function(x, ...) UseMethod("reporter") metafor/R/leave1out.r0000644000176200001440000000007013457322061014200 0ustar liggesusersleave1out <- function(x, ...) UseMethod("leave1out") metafor/R/print.vif.rma.r0000644000176200001440000001053014503332350014765 0ustar liggesusersprint.vif.rma <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="vif.rma") digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) ddd <- list(...) .chkdots(ddd, c("num")) .space() if (!is.null(x$alpha)) { cat(mstyle$section(paste0("Location Coefficients:\n"))) print(x[[1]], digits=digits, ...) .space(FALSE) cat(mstyle$section(paste0("Scale Coefficients:\n"))) print(x[[2]], digits=digits, ...) } else { if (isTRUE(x$bttspec) || isTRUE(x$attspec)) { if (length(x$vif) == 1L) { if (x$vif[[1]]$m == 1) { cat(mstyle$section(paste0("Collinearity Diagnostics (coefficient ", x$vif[[1]]$coefs,"):\n"))) cat(mstyle$result(paste0("VIF = ", fmtx(x$vif[[1]]$vif, digits[["est"]]), ", SIF = ", fmtx(x$vif[[1]]$sif, digits[["est"]])))) } else { cat(mstyle$section(paste0("Collinearity Diagnostics (coefficients ", x$vif[[1]]$coefs,"):\n"))) cat(mstyle$result(paste0("GVIF = ", fmtx(x$vif[[1]]$vif, digits[["est"]]), ", GSIF = ", fmtx(x$vif[[1]]$sif, digits[["est"]])))) } if (!is.null(x$sim)) cat(mstyle$result(paste0(", prop = ", fmtx(x$prop, 2)))) cat("\n") } else { res.table <- do.call(rbind, x$vif) res.table$vif <- fmtx(res.table$vif, digits[["est"]]) res.table$sif <- fmtx(res.table$sif, digits[["est"]]) res.table$coefname <- NULL if (!is.null(x$sim)) res.table$prop <- fmtx(x$prop, 2) # if all btt/att specifications are numeric, remove the 'spec' column if (all(substr(res.table$spec, 1, 1) %in% as.character(1:9))) res.table$spec <- NULL # just use numbers for row names rownames(res.table) <- NULL tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE, print.gap=1)) .print.table(tmp, mstyle) } } else { vifs <- sapply(x$vif, function(x) x$vif) sifs <- sapply(x$vif, function(x) x$sif) if (is.null(x$table)) { if (is.null(x$sim)) { tmp <- fmtx(vifs, digits[["est"]]) tmp <- capture.output(.print.vector(tmp)) .print.table(tmp, mstyle) } else { res.table <- data.frame(vif=vifs) res.table$prop <- fmtx(x$prop, 2) res.table$vif <- fmtx(res.table$vif, digits[["est"]]) tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE, print.gap=2)) .print.table(tmp, mstyle) } } else { if (length(vifs) != length(x$table$estimate)) { vifs <- c(NA_real_, vifs) sifs <- c(NA_real_, sifs) x$prop <- c(NA_real_, x$prop) } if (is.element(x$test, c("knha","adhoc","t"))) { res.table <- data.frame(estimate=fmtx(x$table$estimate, digits[["est"]]), se=fmtx(x$table$se, digits[["se"]]), tval=fmtx(x$table$tval, digits[["test"]]), df=round(x$table$df,2), "pval"=fmtp(x$table$pval, digits[["pval"]]), ci.lb=fmtx(x$table$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$table$ci.ub, digits[["ci"]]), vif=fmtx(vifs, digits[["est"]]), sif=fmtx(sifs, digits[["est"]]), stringsAsFactors=FALSE) } else { res.table <- data.frame(estimate=fmtx(x$table$estimate, digits[["est"]]), se=fmtx(x$table$se, digits[["se"]]), zval=fmtx(x$table$zval, digits[["test"]]), "pval"=fmtp(x$table$pval, digits[["pval"]]), ci.lb=fmtx(x$table$ci.lb, digits[["ci"]]), ci.ub=fmtx(x$table$ci.ub, digits[["ci"]]), vif=fmtx(vifs, digits[["est"]]), sif=fmtx(sifs, digits[["est"]]), stringsAsFactors=FALSE) } rownames(res.table) <- rownames(x$table) if (!is.null(x$sim)) res.table$prop <- fmtx(x$prop, 2) if (.isTRUE(ddd$num)) { width <- nchar(nrow(res.table)) rownames(res.table) <- paste0(formatC(seq_len(nrow(res.table)), format="d", width=width), ") ", rownames(res.table)) } tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE, print.gap=1)) .print.table(tmp, mstyle) } } .space() } invisible() } metafor/R/confint.rma.ls.r0000644000176200001440000003203014430657056015136 0ustar liggesusersconfint.rma.ls <- function(object, parm, level, fixed=FALSE, alpha, digits, transf, targs, verbose=FALSE, control, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.ls") if (!missing(parm)) warning(mstyle$warning("Argument 'parm' (currently) ignored."), call.=FALSE) x <- object k <- x$k p <- x$p if (missing(level)) level <- x$level if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL if (missing(control)) control <- list() level <- .level(level) ddd <- list(...) .chkdots(ddd, c("time", "xlim", "extint")) if (.isTRUE(ddd$time)) time.start <- proc.time() if (!is.null(ddd$xlim)) { if (length(ddd$xlim) != 2L) stop(mstyle$stop("Argument 'xlim' should be a vector of length 2.")) control$vc.min <- ddd$xlim[1] control$vc.max <- ddd$xlim[2] } if (x$optbeta) stop(mstyle$stop("CI calculation not yet implemented when model was fit with 'optbeta=TRUE'.")) ### check if user has specified alpha argument random <- !missing(alpha) if (!fixed && !random) { ### if both 'fixed' and 'random' are FALSE, obtain CIs for alpha parameters cl <- match.call() ### total number of non-fixed components comps <- sum(!x$alpha.fix) if (comps == 0) stop(mstyle$stop("No components for which a CI can be obtained.")) res.all <- list() j <- 0 if (any(!x$alpha.fix)) { for (pos in seq_len(x$alphas)[!x$alpha.fix]) { j <- j + 1 cl.vc <- cl cl.vc$alpha <- pos cl.vc$time <- FALSE #cl.vc$object <- quote(x) if (verbose) cat(mstyle$verbose(paste("\nObtaining CI for alpha =", pos, "\n"))) res.all[[j]] <- eval(cl.vc, envir=parent.frame()) } } if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } if (length(res.all) == 1L) { return(res.all[[1]]) } else { res.all$digits <- digits class(res.all) <- "list.confint.rma" return(res.all) } } ######################################################################### ######################################################################### ######################################################################### if (random) { type <- "pl" ###################################################################### ### check if model actually contains (at least one) such a component and that it was actually estimated if (!missing(alpha) && all(x$alpha.fix)) stop(mstyle$stop("Model does not contain any estimated 'alpha' components.")) ### check if user specified more than one alpha component if (!missing(alpha) && (length(alpha) > 1L)) stop(mstyle$stop("Can only specify one 'alpha' component.")) ### check if user specified a logical if (!missing(alpha) && is.logical(alpha)) stop(mstyle$stop("Must specify a number for the 'alpha' component.")) ### check if user specified a component that does not exist if (!missing(alpha) && (alpha > x$alphas || alpha <= 0)) stop(mstyle$stop("No such 'alpha' component in the model.")) ### check if user specified a component that was fixed if (!missing(alpha) && x$alpha.fix[alpha]) stop(mstyle$stop("Specified 'alpha' component was fixed.")) ### if everything is good so far, get value of the variance component and set 'comp' alpha.pos <- NA_integer_ if (!missing(alpha)) { vc <- x$alpha[alpha] comp <- "alpha" alpha.pos <- alpha } #return(list(comp=comp, vc=vc, alpha.pos=alpha.pos)) ###################################################################### ### set control parameters for uniroot() and possibly replace with user-defined values ### set vc.min and vc.max and possibly replace with user-defined values con <- list(tol=.Machine$double.eps^0.25, maxiter=1000, verbose=FALSE, eptries=10) if (comp == "alpha") { if (is.na(x$se.alpha[alpha])) { con$vc.min <- vc - 10 * abs(vc) con$vc.max <- vc + 10 * abs(vc) } else { #con$vc.min <- vc - 10 * qnorm(level/2, lower.tail=FALSE) * x$se.alpha[alpha] #con$vc.max <- vc + 10 * qnorm(level/2, lower.tail=FALSE) * x$se.alpha[alpha] # using this now to deal with cases where the SE may be extremely large con$vc.min <- max(vc - 10 * abs(vc), vc - 10 * qnorm(level/2, lower.tail=FALSE) * x$se.alpha[alpha]) con$vc.max <- min(vc + 10 * abs(vc), vc + 10 * qnorm(level/2, lower.tail=FALSE) * x$se.alpha[alpha]) } } if (!is.null(x$control$alpha.min)) { if (length(x$control$alpha.min) == 1L) x$control$alpha.min <- rep(x$control$alpha.min, x$q) con$vc.min <- max(con$vc.min, x$control$alpha.min[alpha]) } if (!is.null(x$control$alpha.max)) { if (length(x$control$alpha.max) == 1L) x$control$alpha.max <- rep(x$control$alpha.max, x$q) con$vc.max <- min(con$vc.max, x$control$alpha.max[alpha]) } con.pos <- pmatch(names(control), names(con)) con[c(na.omit(con.pos))] <- control[!is.na(con.pos)] if (verbose) con$verbose <- verbose verbose <- con$verbose ###################################################################### vc.lb <- NA_real_ vc.ub <- NA_real_ ci.null <- FALSE ### logical if CI is a null set lb.conv <- FALSE ### logical if search converged for lower bound (LB) ub.conv <- FALSE ### logical if search converged for upper bound (UB) lb.sign <- "" ### for sign in case LB must be below vc.min ("<") or above vc.max (">") ub.sign <- "" ### for sign in case UB must be below vc.min ("<") or above vc.max (">") ###################################################################### ###################################################################### ###################################################################### ### Profile Likelihood method if (type == "pl") { if (con$vc.min > vc) stop(mstyle$stop("Lower bound of interval to be searched must be <= estimated value of component.")) if (con$vc.max < vc) stop(mstyle$stop("Upper bound of interval to be searched must be >= estimated value of component.")) objective <- qchisq(1-level, df=1) ################################################################### ### search for lower bound ### get diff value when setting component to vc.min; this value should be positive (i.e., discrepancy must be larger than critical value) ### if it is not, then the lower bound must be below vc.min epdiff <- abs(con$vc.min - vc) / con$eptries for (i in seq_len(con$eptries)) { res <- try(.profile.rma.ls(con$vc.min, obj=x, comp=comp, alpha.pos=alpha.pos, confint=TRUE, objective=objective, verbose=verbose), silent=TRUE) if (!inherits(res, "try-error") && !is.na(res)) { if (!.isTRUE(ddd$extint) && res < 0) { vc.lb <- con$vc.min lb.conv <- TRUE lb.sign <- "<" } else { if (.isTRUE(ddd$extint)) { res <- try(uniroot(.profile.rma.ls, interval=c(con$vc.min, vc), tol=con$tol, maxiter=con$maxiter, extendInt="downX", obj=x, comp=comp, alpha.pos=alpha.pos, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } else { res <- try(uniroot(.profile.rma.ls, interval=c(con$vc.min, vc), tol=con$tol, maxiter=con$maxiter, obj=x, comp=comp, alpha.pos=alpha.pos, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } ### check if uniroot method converged if (!inherits(res, "try-error")) { vc.lb <- res lb.conv <- TRUE } } break } con$vc.min <- con$vc.min + epdiff } if (verbose) cat("\n") ################################################################### ### search for upper bound ### get diff value when setting component to vc.max; this value should be positive (i.e., discrepancy must be larger than critical value) ### if it is not, then the upper bound must be above vc.max epdiff <- abs(con$vc.max - vc) / con$eptries for (i in seq_len(con$eptries)) { res <- try(.profile.rma.ls(con$vc.max, obj=x, comp=comp, alpha.pos=alpha.pos, confint=TRUE, objective=objective, verbose=verbose), silent=TRUE) if (!inherits(res, "try-error") && !is.na(res)) { if (!.isTRUE(ddd$extint) && res < 0) { vc.ub <- con$vc.max ub.conv <- TRUE ub.sign <- ">" } else { if (.isTRUE(ddd$extint)) { res <- try(uniroot(.profile.rma.ls, interval=c(vc, con$vc.max), tol=con$tol, maxiter=con$maxiter, extendInt="upX", obj=x, comp=comp, alpha.pos=alpha.pos, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } else { res <- try(uniroot(.profile.rma.ls, interval=c(vc, con$vc.max), tol=con$tol, maxiter=con$maxiter, obj=x, comp=comp, alpha.pos=alpha.pos, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } ### check if uniroot method converged if (!inherits(res, "try-error")) { vc.ub <- res ub.conv <- TRUE } } break } con$vc.max <- con$vc.max - epdiff } ################################################################### } ###################################################################### ###################################################################### ###################################################################### if (!lb.conv) warning(mstyle$warning("Cannot obtain lower bound of profile likelihood CI due to convergence problems."), call.=FALSE) if (!ub.conv) warning(mstyle$warning("Cannot obtain upper bound of profile likelihood CI due to convergence problems."), call.=FALSE) ###################################################################### vc <- c(vc, vc.lb, vc.ub) if (comp == "alpha") { res.random <- rbind(vc) if (x$alphas == 1L) { rownames(res.random) <- "alpha" } else { rownames(res.random) <- paste0("alpha.", alpha.pos) } } colnames(res.random) <- c("estimate", "ci.lb", "ci.ub") } ######################################################################### ######################################################################### ######################################################################### if (fixed) { if (is.element(x$test, c("knha","adhoc","t"))) { crit <- qt(level/2, df=x$ddf, lower.tail=FALSE) } else { crit <- qnorm(level/2, lower.tail=FALSE) } beta <- c(x$beta) ci.lb <- c(beta - crit * x$se) ci.ub <- c(beta + crit * x$se) if (is.function(transf)) { if (is.null(targs)) { beta <- sapply(beta, transf) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) } else { beta <- sapply(beta, transf, targs) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) } } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] res.fixed <- cbind(estimate=beta, ci.lb=ci.lb, ci.ub=ci.ub) rownames(res.fixed) <- rownames(x$beta) } ######################################################################### ######################################################################### ######################################################################### res <- list() if (fixed) res$fixed <- res.fixed if (random) res$random <- res.random res$digits <- digits if (random) { res$ci.null <- ci.null res$lb.sign <- lb.sign res$ub.sign <- ub.sign #res$vc.min <- con$vc.min } if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(res) <- "confint.rma" return(res) } metafor/R/print.profile.rma.r0000644000176200001440000000073313770405224015653 0ustar liggesusersprint.profile.rma <- function(x, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="profile.rma") ######################################################################### if (x$comps == 1) { res <- data.frame(x[1], x[2]) print(res) } else { x$comps <- NULL print(lapply(x, function(x) data.frame(x[1], x[2]))) } } metafor/R/trimfill.rma.uni.r0000644000176200001440000001360614473075360015504 0ustar liggesuserstrimfill.rma.uni <- function(x, side, estimator="L0", maxiter=100, verbose=FALSE, ilim, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.uni", notav=c("robust.rma", "rma.ls", "rma.gen", "rma.uni.selmodel")) if (!x$int.only) stop(mstyle$stop("Trim-and-fill method only applicable to models without moderators.")) if (missing(side)) side <- NULL estimator <- match.arg(estimator, c("L0", "R0", "Q0")) if (x$k == 1) stop(mstyle$stop("Stopped because k = 1.")) ######################################################################### yi <- x$yi vi <- x$vi wi <- x$weights ni <- x$ni ### determine side (if none is specified) if (is.null(side)) { args <- list(yi=yi, vi=vi, weights=wi, mods=sqrt(vi), method=x$method, weighted=x$weighted, control=x$control, outlist="beta=beta", ...) res <- suppressWarnings(.do.call(rma.uni, args)) ### TODO: add check in case there are problems with fitting the model if (res$beta[2] < 0) { side <- "right" } else { side <- "left" } } else { side <- match.arg(side, c("left", "right")) } ### flip data if examining right side if (side == "right") yi <- -1*yi ### sort data by increasing yi ix <- sort(yi, index.return=TRUE)$ix yi <- yi[ix] vi <- vi[ix] wi <- wi[ix] ni <- ni[ix] ######################################################################### k <- length(yi) k0.sav <- -1 k0 <- 0 ### estimated number of missing studies iter <- 0 ### iteration counter if (verbose) cat("\n") while (abs(k0 - k0.sav) > 0) { k0.sav <- k0 ### save current value of k0 iter <- iter + 1 if (iter > maxiter) stop(mstyle$stop("Trim and fill algorithm did not converge.")) ### truncated data yi.t <- yi[seq_len(k-k0)] vi.t <- vi[seq_len(k-k0)] wi.t <- wi[seq_len(k-k0)] args <- list(yi=yi.t, vi=vi.t, weights=wi.t, method=x$method, weighted=x$weighted, control=x$control, outlist="beta=beta", ...) res <- suppressWarnings(.do.call(rma.uni, args)) ### intercept estimate based on truncated data beta <- c(res$beta) yi.c <- yi - beta ### centered values yi.c.r <- rank(abs(yi.c), ties.method="first") ### ranked absolute centered values yi.c.r.s <- sign(yi.c) * yi.c.r ### signed ranked centered values ### estimate the number of missing studies with the R0 estimator if (estimator == "R0") { k0 <- (k - max(-1*yi.c.r.s[yi.c.r.s < 0])) - 1 se.k0 <- sqrt(2*max(0,k0) + 2) } ### estimate the number of missing studies with the L0 estimator if (estimator == "L0") { Sr <- sum(yi.c.r.s[yi.c.r.s > 0]) k0 <- (4*Sr - k*(k+1)) / (2*k - 1) varSr <- 1/24 * (k*(k+1)*(2*k+1) + 10*k0^3 + 27*k0^2 + 17*k0 - 18*k*k0^2 - 18*k*k0 + 6*k^2*k0) se.k0 <- 4*sqrt(varSr) / (2*k - 1) } ### estimate the number of missing studies with the Q0 estimator if (estimator == "Q0") { Sr <- sum(yi.c.r.s[yi.c.r.s > 0]) k0 <- k - 1/2 - sqrt(2*k^2 - 4*Sr + 1/4) varSr <- 1/24 * (k*(k+1)*(2*k+1) + 10*k0^3 + 27*k0^2 + 17*k0 - 18*k*k0^2 - 18*k*k0 + 6*k^2*k0) se.k0 <- 2*sqrt(varSr) / sqrt((k-1/2)^2 - k0*(2*k - k0 -1)) } ### round k0 and make sure that k0 is non-negative k0 <- max(0, round(k0)) se.k0 <- max(0, se.k0) if (verbose) cat(mstyle$verbose(paste0("Iteration: ", fmtx(iter, 0, addwidth=nchar(maxiter), flag="-"), " missing = ", fmtx(k0, 0, addwidth=nchar(k), flag="-"), " beta = ", fmtx(ifelse(side == "right", -1*beta, beta), x$digits[["est"]]), "\n"))) } ######################################################################### ### if estimated number of missing studies is > 0 if (k0 > 0) { ### flip data back if side is right if (side == "right") { yi.c <- -1 * (yi.c - beta) } else { yi.c <- yi.c - beta } ### create filled-in data set yi.fill <- c(x$yi.f, -1*yi.c[(k-k0+1):k]) ### apply limits if specified if (!missing(ilim)) { ilim <- sort(ilim) if (length(ilim) != 2L) stop(mstyle$stop("Argument 'ilim' must be of length 2.")) yi.fill[yi.fill < ilim[1]] <- ilim[1] yi.fill[yi.fill > ilim[2]] <- ilim[2] } vi.fill <- c(x$vi.f, vi[(k-k0+1):k]) wi.fill <- c(x$weights.f, wi[(k-k0+1):k]) ni.fill <- c(x$ni.f, ni[(k-k0+1):k]) ### add measure attribute to the yi.fill vector attr(yi.fill, "measure") <- x$measure ### fit model with imputed data args <- list(yi=yi.fill, vi=vi.fill, weights=wi.fill, ni=ni.fill, method=x$method, weighted=x$weighted, digits=x$digits, ...) res <- suppressWarnings(.do.call(rma.uni, args)) ### fill, ids, and slab are of length 'k.f + k0' (i.e., subsetted but with NAs) res$fill <- c(rep(FALSE,x$k.f), rep(TRUE,k0)) res$ids <- c(x$ids, (max(x$ids)+1):(max(x$ids)+k0)) if (x$slab.null) { res$slab <- c(paste("Study", x$ids), paste("Filled", seq_len(k0))) } else { res$slab <- c(x$slab, paste("Filled", seq_len(k0))) } res$slab.null <- FALSE } else { ### in case 0 studies are imputed res <- x res$fill <- rep(FALSE,k) } res$k0 <- k0 res$se.k0 <- se.k0 res$side <- side res$k0.est <- estimator res$k.all <- x$k.all + k0 if (estimator == "R0") { m <- -1:(k0-1) res$p.k0 <- 1 - sum(choose(0+m+1, m+1) * 0.5^(0+m+2)) } else { res$p.k0 <- NA_real_ } class(res) <- c("rma.uni.trimfill", class(res)) return(res) } metafor/R/plot.rma.glmm.r0000644000176200001440000000036313770373156015000 0ustar liggesusersplot.rma.glmm <- function(x, qqplot=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.glmm", notav="rma.glmm") } metafor/R/methods.list.rma.r0000644000176200001440000000743214205440260015471 0ustar liggesusers############################################################################ "[.list.rma" <- function(x, i, ...) { # removed j argument (see below), so can only select rows, not columns out <- x attr(out, "class") <- NULL slab.pos <- which(names(out) == "slab") if (!missing(i)) { # for X and Z element mf <- match.call() i <- .getx("i", mf=mf, data=x) # not sure about the consequences of using this out[seq_len(slab.pos-1)] <- lapply(out[seq_len(slab.pos-1)], function(r) if (inherits(r, "matrix")) r[i,,drop=FALSE] else r[i]) } ### catch cases where user selects values outside 1:k if (length(out[[1]]) == 0L) return(NULL) #out <- out[j] ### this causes all kinds of problems, so left out for now (TODO: check if this is really a problem) out$slab <- x$slab[i] ### slab can only contain NAs if user selects values outside 1:k if (anyNA(out$slab)) return(NULL) out$digits <- x$digits out$transf <- x$transf out$method <- x$method class(out) <- "list.rma" return(out) } ############################################################################ as.data.frame.list.rma <- function(x, ...) { attr(x, "class") <- NULL ### remove cr.lb and cr.ub (in case they are there) x$cr.lb <- NULL x$cr.ub <- NULL ### turn all vectors before the slab vector into a data frame slab.pos <- which(names(x) == "slab") out <- x[seq_len(slab.pos-1)] out <- data.frame(out, row.names=x$slab, stringsAsFactors=FALSE) ### in case all values were NA and have been omitted if (nrow(out) == 0L) return(data.frame()) ### if transf exists and is TRUE, set SEs to NULL so that column is omitted from the output if (exists("transf", where=x, inherits=FALSE) && x$transf) out$se <- NULL return(out) } ############################################################################ as.matrix.list.rma <- function(x, ...) { attr(x, "class") <- NULL ### remove cr.lb and cr.ub (in case they are there) x$cr.lb <- NULL x$cr.ub <- NULL ### turn all vectors before the slab vector into a matrix slab.pos <- which(names(x) == "slab") out <- x[seq_len(slab.pos-1)] out <- do.call(cbind, out) rownames(out) <- x$slab ### if transf exists and is TRUE, set SEs to NULL so that column is omitted from the output if (exists("transf", where=x, inherits=FALSE) && x$transf) out <- out[,-which(colnames(out) == "se")] return(out) } ############################################################################ ### like utils:::head.data.frame and utils:::tail.data.frame, ### but with nrow(x) replaced by length(x[[1]]) head.list.rma <- function (x, n = 6L, ...) { stopifnot(length(n) == 1L) n <- if (n < 0L) { max(length(x[[1]]) + n, 0L) } else { min(n, length(x[[1]])) } x[seq_len(n), , drop = FALSE] } tail.list.rma <- function (x, n = 6L, ...) { stopifnot(length(n) == 1L) nrx <- length(x[[1]]) n <- if (n < 0L) { max(nrx + n, 0L) } else { min(n, nrx) } x[seq.int(to = nrx, length.out = n), , drop = FALSE] } ############################################################################ `$<-.list.rma` <- function(x, name, value) { if (name %in% names(x)) { x[[name]] <- value return(x) } else { slab.pos <- which(names(x) == "slab") out <- list() for (i in seq_len(slab.pos-1)) { out[[i]] <- x[[i]] } names(out) <- names(x)[seq_len(slab.pos-1)] out[[name]] <- value for (i in (slab.pos:length(x))) { out[[i+1]] <- x[[i]] } names(out)[(slab.pos+1):(length(x)+1)] <- names(x)[slab.pos:length(x)] class(out) <- class(x) return(out) } } ############################################################################ metafor/R/methods.confint.rma.r0000644000176200001440000000166414254337225016171 0ustar liggesusers############################################################################ as.data.frame.confint.rma <- function(x, ...) { .chkclass(class(x), must="confint.rma") ddd <- list(...) .chkdots(ddd, c("fixed", "random")) if (is.null(ddd$fixed)) { fixed <- is.element("fixed", names(x)) } else { fixed <- ddd$fixed } if (is.null(ddd$random)) { random <- is.element("random", names(x)) } else { random <- ddd$random } if (fixed) { df <- x$fixed } else { df <- NULL } if (random && is.element("random", names(x))) df <- rbind(df, x$random) return(df) } as.data.frame.list.confint.rma <- function(x, ...) { .chkclass(class(x), must="list.confint.rma") x$digits <- NULL # remove digits elements df <- lapply(x, as.data.frame) df <- do.call(rbind, df) return(df) } ############################################################################ metafor/R/cooks.distance.rma.uni.r0000644000176200001440000000020213457322061016547 0ustar liggesuserscooks.distance.rma.uni <- function(model, progbar=FALSE, ...) influence(model, progbar=progbar, measure="cooks.distance", ...) metafor/R/qqnorm.rma.mv.r0000644000176200001440000000022313770374357015024 0ustar liggesusersqqnorm.rma.mv <- function(y, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(y), must="rma.mv", notav="rma.mv") } metafor/R/print.list.anova.rma.r0000644000176200001440000000140114305043357016262 0ustar liggesusersprint.list.anova.rma <- function(x, digits=x[[1]]$digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="list.anova.rma") digits <- .get.digits(digits=digits, xdigits=x[[1]]$digits, dmiss=FALSE) .space() res.table <- as.data.frame(x) if ("QM" %in% names(res.table)) res.table$QM <- fmtx(res.table$QM, digits[["test"]]) if ("QS" %in% names(res.table)) res.table$QS <- fmtx(res.table$QS, digits[["test"]]) if ("Fval" %in% names(res.table)) res.table$Fval <- fmtx(res.table$Fval, digits[["test"]]) res.table$pval <- fmtp(res.table$pval, digits[["pval"]]) tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE)) .print.table(tmp, mstyle) .space() invisible() } metafor/R/coef.summary.rma.r0000644000176200001440000000310214275750461015470 0ustar liggesuserscoef.summary.rma <- function(object, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="summary.rma") ddd <- list(...) x <- object if (is.element(x$test, c("knha","adhoc","t"))) { res.table <- data.frame(estimate=x$beta, se=x$se, tval=x$zval, df=x$ddf, pval=x$pval, ci.lb=x$ci.lb, ci.ub=x$ci.ub) } else { res.table <- data.frame(estimate=x$beta, se=x$se, zval=x$zval, pval=x$pval, ci.lb=x$ci.lb, ci.ub=x$ci.ub) } if (isTRUE(ddd$type=="beta")) return(res.table) if (inherits(x, "rma.ls")) { res.table <- list(beta=res.table) if (is.element(x$test, c("knha","adhoc","t"))) { res.table$alpha <- data.frame(estimate=x$alpha, se=x$se.alpha, tval=x$zval.alpha, df=x$ddf.alpha, pval=x$pval.alpha, ci.lb=x$ci.lb.alpha, ci.ub=x$ci.ub.alpha) } else { res.table$alpha <- data.frame(estimate=x$alpha, se=x$se.alpha, zval=x$zval.alpha, pval=x$pval.alpha, ci.lb=x$ci.lb.alpha, ci.ub=x$ci.ub.alpha) } if (isTRUE(ddd$type=="alpha")) return(res.table$alpha) } if (inherits(x, "rma.uni.selmodel")) { res.table <- list(beta=res.table) res.table$delta <- data.frame(estimate=x$delta, se=x$se.delta, zval=x$zval.delta, pval=x$pval.delta, ci.lb=x$ci.lb.delta, ci.ub=x$ci.ub.delta) if (length(x$delta) == 1L) { rownames(res.table$delta) <- "delta" } else { rownames(res.table$delta) <- paste0("delta.", seq_along(x$delta)) } if (isTRUE(ddd$type=="delta")) return(res.table$delta) } return(res.table) } metafor/R/AIC.rma.r0000644000176200001440000000273414274451750013464 0ustar liggesusersAIC.rma <- function(object, ..., k=2, correct=FALSE) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma") if (missing(...)) { ### if there is just 'object' if (object$method == "REML") { out <- ifelse(correct, object$fit.stats["AICc","REML"], object$fit.stats["AIC","REML"]) } else { out <- ifelse(correct, object$fit.stats["AICc","ML"], object$fit.stats["AIC","ML"]) } } else { ### if there is 'object' and additional objects via ... if (object$method == "REML") { out <- sapply(list(object, ...), function(x) ifelse(correct, x$fit.stats["AICc","REML"], x$fit.stats["AIC","REML"])) } else { out <- sapply(list(object, ...), function(x) ifelse(correct, x$fit.stats["AICc","ML"], x$fit.stats["AIC","ML"])) } dfs <- sapply(list(object, ...), function(x) x$parms) out <- data.frame(df=dfs, AIC=out) if (correct) names(out)[2] <- "AICc" ### get names of objects; same idea as in stats:::AIC.default cl <- match.call() cl$k <- NULL cl$correct <- NULL rownames(out) <- as.character(cl[-1L]) ### check that all models were fitted to the same data yis <- lapply(list(object, ...), function(x) as.vector(x$yi)) if (!all(sapply(yis[-1], function(x) identical(x, yis[[1]])))) warning(mstyle$warning("Models not all fitted to the same data."), call.=FALSE) } return(out) } metafor/R/coef.rma.r0000644000176200001440000000156714303075042013774 0ustar liggesuserscoef.rma <- function(object, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma") ddd <- list(...) coefs <- c(object$beta) names(coefs) <- rownames(object$beta) if (isTRUE(ddd$type=="beta")) return(coefs) if (inherits(object, "rma.ls")) { coefs <- list(beta=coefs) coefs$alpha <- c(object$alpha) names(coefs$alpha) <- rownames(object$alpha) if (isTRUE(ddd$type=="alpha")) return(coefs$alpha) } if (inherits(object, "rma.uni.selmodel")) { coefs <- list(beta=coefs) coefs$delta <- c(object$delta) if (length(object$delta) == 1L) { names(coefs$delta) <- "delta" } else { names(coefs$delta) <- paste0("delta.", seq_along(object$delta)) } if (isTRUE(ddd$type=="delta")) return(coefs$delta) } return(coefs) } metafor/R/cumul.r0000644000176200001440000000006013457322061013417 0ustar liggesuserscumul <- function(x, ...) UseMethod("cumul") metafor/R/plot.rma.uni.selmodel.r0000644000176200001440000001464014466623113016437 0ustar liggesusersplot.rma.uni.selmodel <- function(x, xlim, ylim, n=1000, prec="max", scale=FALSE, ci=FALSE, reps=1000, shade=TRUE, rug=TRUE, add=FALSE, lty=c("solid","dotted"), lwd=c(2,1), ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.uni.selmodel") .start.plot(!add) if (is.element(x$type, c("trunc","truncest"))) stop(mstyle$stop("Cannot draw the selection function for this type of selection model.")) ### shade argument can either be a logical or a color if (is.logical(shade)) { shadecol <- .coladj(par("bg","fg"), dark=0.1, light=-0.1) } if (is.character(shade)) { shadecol <- shade shade <- TRUE } ddd <- list(...) lplot <- function(..., seed) plot(...) llines <- function(..., seed) lines(...) lrug <- function(..., seed) rug(...) lpolygon <- function(..., seed) polygon(...) if (is.logical(ci)) citype <- "boot" if (is.character(ci)) { citype <- tolower(ci) ci <- TRUE } if (!is.element(citype, c("boot", "wald"))) stop(mstyle$stop("Unknown confidence interval type specified.")) if (missing(xlim)) xlim <- c(x$pval.min, 1-x$pval.min) if (length(xlim) != 2L) stop(mstyle$stop("Argument 'xlim' should be a vector of length 2.")) xlim <- sort(xlim) if (xlim[1] < 0 || xlim[2] > 1) stop(mstyle$stop("Values for 'xlim' should be between 0 and 1.")) if (length(prec) != 1L) stop(mstyle$stop("Argument 'prec' should be of length 1.")) if (is.character(prec)) { if (!is.element(prec, c("min", "max", "mean", "median"))) stop(mstyle$stop("Unknown options specified for the 'prec' argument.")) if (prec == "min") prec <- x$precis[["min"]] if (prec == "max") prec <- x$precis[["max"]] if (prec == "mean") prec <- x$precis[["mean"]] if (prec == "median") prec <- x$precis[["median"]] } else { if (is.numeric(prec) && !x$precspec) prec <- 1 } delta <- x$delta steps <- x$steps ps <- seq(xlim[1], xlim[2], length.out=n) if (x$type == "stepfun") { ps <- unique(sort(c(ps, steps))) # make sure that the 'steps' values are part of 'ps' ps <- ps[ps >= xlim[1]] # but only keep ps >= xlim[1] ps <- ps[ps <= xlim[2]] # ps <= xlim[2] plot.type <- "S" } else { plot.type <- "l" } wi.fun <- x$wi.fun ys <- wi.fun(ps, delta=delta, yi=x$yi, vi=x$vi, preci=prec, alternative=x$alternative, steps=x$steps) if (ci && citype == "boot" && all(is.na(x$vd))) ci <- FALSE if (ci && citype == "wald" && all(is.na(x$ci.lb.delta)) && all(is.na(x$ci.ub.delta))) ci <- FALSE if (ci && citype == "wald" && x$type != "stepfun" && sum(!x$delta.fix) >= 2L) stop(mstyle$stop("Cannot compute Wald-type confidence intervals for this selection model.")) if (ci) { if (citype == "boot") { if (!is.null(ddd$seed)) set.seed(ddd$seed) vd <- x$vd vd.na <- is.na(diag(vd)) vd[vd.na,] <- 0 vd[,vd.na] <- 0 dsim <- .mvrnorm(reps, mu=delta, Sigma=vd) for (j in seq_len(ncol(dsim))) { dsim[,j] <- ifelse(dsim[,j] < x$delta.min[j], x$delta.min[j], dsim[,j]) dsim[,j] <- ifelse(dsim[,j] > x$delta.max[j], x$delta.max[j], dsim[,j]) } ys.ci <- lapply(ps, function(p) { ysim <- apply(dsim, 1, function(d) wi.fun(p, delta=d, yi=x$yi, vi=x$vi, preci=prec, alternative=x$alternative, steps=x$steps)) quantile(ysim, probs=c(x$level/2, 1 - x$level/2)) }) ys.ci <- do.call(rbind, ys.ci) ys.lb <- ys.ci[,1] ys.ub <- ys.ci[,2] } if (citype == "wald") { ci.lb.delta <- x$ci.lb.delta ci.ub.delta <- x$ci.ub.delta if (x$type == "stepfun") { ci.lb.delta[x$delta.fix] <- delta[x$delta.fix] ci.ub.delta[x$delta.fix] <- delta[x$delta.fix] } ys.lb <- wi.fun(ps, delta=ci.lb.delta, yi=x$yi, vi=x$vi, preci=prec, alternative=x$alternative, steps=x$steps) ys.ub <- wi.fun(ps, delta=ci.ub.delta, yi=x$yi, vi=x$vi, preci=prec, alternative=x$alternative, steps=x$steps) } } else { ys.lb <- NA_real_ ys.ub <- NA_real_ } if (scale) { #is.inf.pos <- ys == Inf #is.inf.neg <- ys == -Inf ys[is.infinite(ys)] <- NA_real_ rng.ys <- max(ys, na.rm=TRUE) - min(ys, na.rm=TRUE) min.ys <- min(ys, na.rm=TRUE) if (rng.ys > .Machine$double.eps^0.5) { ys <- (ys - min.ys) / rng.ys ys.lb <- (ys.lb - min.ys) / rng.ys ys.ub <- (ys.ub - min.ys) / rng.ys } #ys[is.inf.pos] <- 1 #ys[is.inf.neg] <- 0 } ys[ys < 0] <- 0 ys.lb[ys.lb < 0] <- 0 ys.ub[ys.ub < 0] <- 0 if (missing(ylim)) { if (is.element(x$type, c("halfnorm", "negexp", "logistic", "power", "negexppow", "halfnorm2", "negexp2", "logistic2", "power2"))) { ylim <- c(0,1) } else { if (ci) { ylim <- c(min(c(ys.lb[is.finite(ys.lb)], ys[is.finite(ys)]), na.rm=TRUE), max(c(ys.ub[is.finite(ys.ub)], ys[is.finite(ys)]), na.rm=TRUE)) } else { ylim <- range(ys[is.finite(ys)], na.rm=TRUE) } } } else { if (length(ylim) != 2L) stop(mstyle$stop("Argument 'ylim' should be a vector of length 2.")) ylim <- sort(ylim) } if (!add) lplot(ps, ys, ylim=ylim, type="n", lwd=lwd, xlab="p-value", ylab="Relative Likelihood of Selection", ...) if (ci) { if (shade) { tmp <- approx(ps, ys.lb, n=10000, method="constant", f=1) ps.int.lb <- tmp$x ys.lb.int.lb <- tmp$y tmp <- approx(ps, ys.ub, n=10000, method="constant", f=1) ps.int.ub <- tmp$x ys.lb.int.ub <- tmp$y lpolygon(c(ps.int.lb,rev(ps.int.ub)), c(ys.lb.int.lb,rev(ys.lb.int.ub)), col=shadecol, border=NA) #lpolygon(c(ps,rev(ps)), c(ys.lb,rev(ys.ub)), col=shadecol, border=NA) } llines(ps, ys.lb, type=plot.type, lty=lty[2], lwd=lwd[2], ...) llines(ps, ys.ub, type=plot.type, lty=lty[2], lwd=lwd[2], ...) } if (rug && !add) lrug(x$pvals, quiet=TRUE) llines(ps, ys, type=plot.type, lty=lty[1], lwd=lwd[1], ...) sav <- data.frame(xs=ps, ys=ys, ys.lb=ys.lb, ys.ub=ys.ub) invisible(sav) } metafor/R/print.hc.rma.uni.r0000644000176200001440000000172014305415051015366 0ustar liggesusersprint.hc.rma.uni <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="hc.rma.uni") digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) res.table <- data.frame(method = c(x$method.rma, x$method), tau2 = fmtx(c(x$tau2.rma, x$tau2), digits[["var"]]), estimate = fmtx(c(x$beta.rma, x$beta), digits[["est"]]), se = fmtx(c(x$se.rma, x$se), digits[["se"]]), ci.lb = fmtx(c(x$ci.lb.rma, x$ci.lb), digits[["ci"]]), ci.ub = fmtx(c(x$ci.ub.rma, x$ci.ub), digits[["ci"]]), stringsAsFactors=FALSE) if (is.na(x$se[1])) res.table$se <- NULL rownames(res.table) <- c("rma", "hc") .space() tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE)) .print.table(tmp, mstyle) .space() invisible(res.table) } metafor/R/gosh.r0000644000176200001440000000005613457322061013237 0ustar liggesusersgosh <- function(x, ...) UseMethod("gosh") metafor/R/logLik.rma.r0000644000176200001440000000132014300732074014266 0ustar liggesuserslogLik.rma <- function(object, REML, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma") # in case something like logLik(res1, res2) is used if (!missing(REML) && inherits(REML, "rma")) REML <- NULL if (missing(REML) || is.null(REML)) { if (object$method == "REML") { REML <- TRUE } else { REML <- FALSE } } if (REML) { val <- object$fit.stats["ll","REML"] } else { val <- object$fit.stats["ll","ML"] } attr(val, "nall") <- object$k.eff attr(val, "nobs") <- object$k.eff - ifelse(REML, object$p.eff, 0) attr(val, "df") <- object$parms class(val) <- "logLik" return(val) } metafor/R/to.wide.r0000644000176200001440000001577314436372212013665 0ustar liggesusersto.wide <- function(data, study, grp, ref, grpvars, postfix=c(".1",".2"), addid=TRUE, addcomp=TRUE, adddesign=TRUE, minlen=2, var.names=c("id","comp","design")) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (!is.data.frame(data)) data <- data.frame(data) ### get variable names varnames <- names(data) ### number of variables nvars <- length(varnames) ### checks on 'var.names' argument if (length(var.names) != 3L) stop(mstyle$stop("Argument 'var.names' must of length 3.")) if (!inherits(var.names, "character")) stop(mstyle$stop("Argument 'var.names' must of vector with character strings.")) if (any(var.names != make.names(var.names, unique=TRUE))) { var.names <- make.names(var.names, unique=TRUE) warning(mstyle$warning(paste0("Argument 'var.names' does not contain syntactically valid variable names.\nVariable names adjusted to: var.names = c('", var.names[1], "','", var.names[2], "','", var.names[3], "').")), call.=FALSE) } ############################################################################ ### checks on 'study' argument if (length(study) != 1L) stop(mstyle$stop("Argument 'study' must of length 1.")) if (!(is.character(study) | is.numeric(study))) stop(mstyle$stop("Argument 'study' must either be a character string or a scalar.")) if (is.character(study)) { study.pos <- charmatch(study, varnames) if (is.na(study.pos) || study.pos == 0L) stop(mstyle$stop("Could not find or uniquely identify variable specified via the 'study' argument.")) } else { study.pos <- round(study) if (study.pos < 1 | study.pos > nvars) stop(mstyle$stop("Specified position of 'study' variable does not exist in the data frame.")) } ### get study variable study <- data[[study.pos]] ### make sure there are no missing values in study variable if (anyNA(study)) stop(mstyle$stop("Variable specified via 'study' argument should not contain missing values.")) ############################################################################ ### checks on 'grp' argument if (length(grp) != 1L) stop(mstyle$stop("Argument 'grp' must of length 1.")) if (!(is.character(grp) || is.numeric(grp))) stop(mstyle$stop("Argument 'grp' must either be a character string or a scalar.")) if (is.character(grp)) { grp.pos <- charmatch(grp, varnames) if (is.na(grp.pos) || grp.pos == 0L) stop(mstyle$stop("Could not find or uniquely identify variable specified via the 'grp' argument.")) } else { grp.pos <- round(grp) if (grp.pos < 1 | grp.pos > nvars) stop(mstyle$stop("Specified position of 'grp' variable does not exist in the data frame.")) } ### get grp variable grp <- data[[grp.pos]] ### make sure there are no missing values in group variable if (anyNA(grp)) stop(mstyle$stop("Variable specified via 'grp' argument should not contain missing values.")) ### get levels of the group variable if (is.factor(grp)) { lvls <- levels(grp) } else { lvls <- sort(unique(grp)) } ############################################################################ ### checks on 'ref' argument ### if ref is not specified, use the most common group as the reference group if (missing(ref)) ref <- names(sort(table(grp), decreasing=TRUE)[1]) if (length(ref) != 1L) stop(mstyle$stop("Argument 'ref' must be of length one.")) ref.pos <- charmatch(ref, lvls) if (is.na(ref.pos) || ref.pos == 0L) stop(mstyle$stop("Could not find or uniquely identify reference group specified via the 'ref' argument.")) ############################################################################ ### reorder levels and data so that the reference level is always last lvls <- c(lvls[-ref.pos], lvls[ref.pos]) data <- data[order(study, factor(grp, levels=lvls)),] ### get study and group variables again study <- data[[study.pos]] grp <- data[[grp.pos]] ############################################################################ ### checks on 'grpvars' argument if (!(is.character(grpvars) || is.numeric(grpvars))) stop(mstyle$stop("Argument 'grpvars' must either be a string or numeric vector.")) if (is.character(grpvars)) { grpvars.pos <- unique(charmatch(grpvars, varnames)) if (anyNA(grpvars.pos) || any(grpvars.pos == 0L)) stop(mstyle$stop("Could not find or uniquely identify variable(s) specified via the 'grpvars' argument.")) } else { grpvars.pos <- unique(round(grpvars)) if (any(grpvars.pos < 1) | any(grpvars.pos > nvars)) stop(mstyle$stop("Specified positions of 'grpvars' variables do not exist in the data frame.")) } ### in case the group variable is not specified as part of the group variables, add it if (!(grp.pos %in% grpvars.pos)) grpvars.pos <- c(grp.pos, grpvars.pos) ### and make sure that grp.pos is always in the first position of grpvars.pos grpvars.pos <- union(grp.pos, grpvars.pos) ############################################################################ ### restructure data set into wide format restruct <- function(x) { if (nrow(x) > 1L) { cbind(x[-nrow(x),], x[rep(nrow(x),nrow(x)-1L),grpvars.pos]) } else { # to handle one-arm studies unname(c(x, rep(NA, length(grpvars.pos)))) } } dat <- lapply(split(data, study), restruct) dat <- do.call(rbind, dat) ### add postfix to outcome variable names names(dat)[grpvars.pos] <- paste0(names(dat)[grpvars.pos], postfix[1]) names(dat)[(nvars+1):ncol(dat)] <- paste0(names(dat)[(nvars+1):ncol(dat)], postfix[2]) ### fix row names rownames(dat) <- seq_len(nrow(dat)) ############################################################################ ### generate comp variable grps <- .shorten(as.character(data[[grp.pos]]), minlen=minlen) restruct <- function(x) { if (length(x) > 1L) { paste0(x[-length(x)], "-", x[length(x)]) } else { NA } } comp <- unlist(sapply(split(grps, study), restruct)) ### generate design variable restruct <- function(x) { if (length(x) > 1L) { rep(paste0(x, collapse="-"), length(x)-1L) } else { NA } } design <- unlist(sapply(split(grps, study), restruct)) ############################################################################ ### add row id to dataset if (addid) { dat[[var.names[1]]] <- seq_len(nrow(dat)) ### make sure that row id variable is always the first variable in the dataset #id.pos <- which(names(dat) == "id") #dat <- dat[c(id.pos, seq_along(names(dat))[-id.pos])] } ### add comp variable to dataset if (addcomp) dat[[var.names[2]]] <- comp ### add design variable to dataset if (adddesign) dat[[var.names[3]]] <- design ############################################################################ return(dat) } metafor/R/rstudent.rma.uni.r0000644000176200001440000000021513457322061015514 0ustar liggesusersrstudent.rma.uni <- function(model, digits, progbar=FALSE, ...) influence(model, digits=digits, progbar=progbar, measure="rstudent", ...) metafor/R/confint.rma.mv.r0000644000176200001440000005572714430657045015162 0ustar liggesusersconfint.rma.mv <- function(object, parm, level, fixed=FALSE, sigma2, tau2, rho, gamma2, phi, digits, transf, targs, verbose=FALSE, control, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.mv") if (!missing(parm)) warning(mstyle$warning("Argument 'parm' (currently) ignored."), call.=FALSE) x <- object k <- x$k p <- x$p if (missing(level)) level <- x$level if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL if (missing(control)) control <- list() level <- .level(level) ddd <- list(...) .chkdots(ddd, c("time", "xlim", "extint")) if (.isTRUE(ddd$time)) time.start <- proc.time() if (!is.null(ddd$xlim)) { if (length(ddd$xlim) != 2L) stop(mstyle$stop("Argument 'xlim' should be a vector of length 2.")) control$vc.min <- ddd$xlim[1] control$vc.max <- ddd$xlim[2] } ### check if user has specified one of the sigma2, tau2, rho, gamma2, or phi arguments random <- !all(missing(sigma2), missing(tau2), missing(rho), missing(gamma2), missing(phi)) if (!fixed && !random) { ### if both 'fixed' and 'random' are FALSE, obtain CIs for all variance/correlation components cl <- match.call() ### total number of non-fixed components comps <- ifelse(x$withS, sum(!x$vc.fix$sigma2), 0) + ifelse(x$withG, sum(!x$vc.fix$tau2) + sum(!x$vc.fix$rho), 0) + ifelse(x$withH, sum(!x$vc.fix$gamma2) + sum(!x$vc.fix$phi), 0) if (comps == 0) stop(mstyle$stop("No components for which a CI can be obtained.")) res.all <- list() j <- 0 if (x$withS && any(!x$vc.fix$sigma2)) { for (pos in seq_len(x$sigma2s)[!x$vc.fix$sigma2]) { j <- j + 1 cl.vc <- cl cl.vc$sigma2 <- pos cl.vc$time <- FALSE #cl.vc$object <- quote(x) if (verbose) cat(mstyle$verbose(paste("\nObtaining CI for sigma2 =", pos, "\n"))) res.all[[j]] <- eval(cl.vc, envir=parent.frame()) } } if (x$withG) { if (any(!x$vc.fix$tau2)) { for (pos in seq_len(x$tau2s)[!x$vc.fix$tau2]) { j <- j + 1 cl.vc <- cl cl.vc$tau2 <- pos cl.vc$time <- FALSE #cl.vc$object <- quote(x) if (verbose) cat(mstyle$verbose(paste("\nObtaining CI for tau2 =", pos, "\n"))) res.all[[j]] <- eval(cl.vc, envir=parent.frame()) } } if (any(!x$vc.fix$rho)) { for (pos in seq_len(x$rhos)[!x$vc.fix$rho]) { j <- j + 1 cl.vc <- cl cl.vc$rho <- pos cl.vc$time <- FALSE #cl.vc$object <- quote(x) if (verbose) cat(mstyle$verbose(paste("\nObtaining CI for rho =", pos, "\n"))) res.all[[j]] <- eval(cl.vc, envir=parent.frame()) } } } if (x$withH) { if (any(!x$vc.fix$gamma2)) { for (pos in seq_len(x$gamma2s)[!x$vc.fix$gamma2]) { j <- j + 1 cl.vc <- cl cl.vc$gamma2 <- pos cl.vc$time <- FALSE #cl.vc$object <- quote(x) if (verbose) cat(mstyle$verbose(paste("\nObtaining CI for gamma2 =", pos, "\n"))) res.all[[j]] <- eval(cl.vc, envir=parent.frame()) } } if (any(!x$vc.fix$phi)) { for (pos in seq_len(x$phis)[!x$vc.fix$phi]) { j <- j + 1 cl.vc <- cl cl.vc$phi <- pos cl.vc$time <- FALSE #cl.vc$object <- quote(x) if (verbose) cat(mstyle$verbose(paste("\nObtaining CI for phi =", pos, "\n"))) res.all[[j]] <- eval(cl.vc, envir=parent.frame()) } } } if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } if (length(res.all) == 1L) { return(res.all[[1]]) } else { res.all$digits <- digits class(res.all) <- "list.confint.rma" return(res.all) } } ######################################################################### ######################################################################### ######################################################################### if (random) { type <- "pl" ###################################################################### ### check if user has specified more than one of these arguments if (sum(!missing(sigma2), !missing(tau2), !missing(rho), !missing(gamma2), !missing(phi)) > 1L) stop(mstyle$stop("Must specify only one of the arguments 'sigma2', 'tau2', 'rho', 'gamma2', or 'phi'.")) ### check if model actually contains (at least one) such a component and that it was actually estimated ### note: a component that is not in the model is NA; components that are fixed are TRUE if (!missing(sigma2) && (all(is.na(x$vc.fix$sigma2)) || all(x$vc.fix$sigma2))) stop(mstyle$stop("Model does not contain any (estimated) 'sigma2' components.")) if (!missing(tau2) && (all(is.na(x$vc.fix$tau2)) || all(x$vc.fix$tau2))) stop(mstyle$stop("Model does not contain any (estimated) 'tau2' components.")) if (!missing(rho) && c(all(is.na(x$vc.fix$rho)) || all(x$vc.fix$rho))) stop(mstyle$stop("Model does not contain any (estimated) 'rho' components.")) if (!missing(gamma2) && (all(is.na(x$vc.fix$gamma2)) || all(x$vc.fix$gamma2))) stop(mstyle$stop("Model does not contain any (estimated) 'gamma2' components.")) if (!missing(phi) && c(all(is.na(x$vc.fix$phi)) || all(x$vc.fix$phi))) stop(mstyle$stop("Model does not contain any (estimated) 'phi' components.")) ### check if user specified more than one sigma2, tau2, rho, gamma2, or rho component if (!missing(sigma2) && (length(sigma2) > 1L)) stop(mstyle$stop("Can only specify one 'sigma2' component.")) if (!missing(tau2) && (length(tau2) > 1L)) stop(mstyle$stop("Can only specify one 'tau2' component.")) if (!missing(rho) && (length(rho) > 1L)) stop(mstyle$stop("Can only specify one 'rho' component.")) if (!missing(gamma2) && (length(gamma2) > 1L)) stop(mstyle$stop("Can only specify one 'gamma2' component.")) if (!missing(phi) && (length(phi) > 1L)) stop(mstyle$stop("Can only specify one 'phi' component.")) ### check if user specified a logical if (!missing(sigma2) && is.logical(sigma2)) stop(mstyle$stop("Must specify a number for the 'sigma2' component.")) if (!missing(tau2) && is.logical(tau2)) stop(mstyle$stop("Must specify a number for the 'tau2' component.")) if (!missing(rho) && is.logical(rho)) stop(mstyle$stop("Must specify a number for the 'rho' component.")) if (!missing(gamma2) && is.logical(gamma2)) stop(mstyle$stop("Must specify a number for the 'gamma2' component.")) if (!missing(phi) && is.logical(phi)) stop(mstyle$stop("Must specify a number for the 'phi' component.")) ### check if user specified a component that does not exist if (!missing(sigma2) && (sigma2 > length(x$vc.fix$sigma2) || sigma2 <= 0)) stop(mstyle$stop("No such 'sigma2' component in the model.")) if (!missing(tau2) && (tau2 > length(x$vc.fix$tau2) || tau2 <= 0)) stop(mstyle$stop("No such 'tau2' component in the model.")) if (!missing(rho) && (rho > length(x$vc.fix$rho) || rho <= 0)) stop(mstyle$stop("No such 'rho' component in the model.")) if (!missing(gamma2) && (gamma2 > length(x$vc.fix$gamma2) || gamma2 <= 0)) stop(mstyle$stop("No such 'gamma2' component in the model.")) if (!missing(phi) && (phi > length(x$vc.fix$phi) || phi <= 0)) stop(mstyle$stop("No such 'phi' component in the model.")) ### check if user specified a component that was fixed if (!missing(sigma2) && x$vc.fix$sigma2[sigma2]) stop(mstyle$stop("Specified 'sigma2' component was fixed.")) if (!missing(tau2) && x$vc.fix$tau2[tau2]) stop(mstyle$stop("Specified 'tau2' component was fixed.")) if (!missing(rho) && x$vc.fix$rho[rho]) stop(mstyle$stop("Specified 'rho' component was fixed.")) if (!missing(gamma2) && x$vc.fix$gamma2[gamma2]) stop(mstyle$stop("Specified 'gamma2' component was fixed.")) if (!missing(phi) && x$vc.fix$phi[phi]) stop(mstyle$stop("Specified 'phi' component was fixed.")) ### if everything is good so far, get value of the variance component and set 'comp' sigma2.pos <- NA_integer_ tau2.pos <- NA_integer_ rho.pos <- NA_integer_ gamma2.pos <- NA_integer_ phi.pos <- NA_integer_ if (!missing(sigma2)) { vc <- x$sigma2[sigma2] comp <- "sigma2" sigma2.pos <- sigma2 } if (!missing(tau2)) { vc <- x$tau2[tau2] comp <- "tau2" tau2.pos <- tau2 } if (!missing(rho)) { vc <- x$rho[rho] comp <- "rho" rho.pos <- rho } if (!missing(gamma2)) { vc <- x$gamma2[gamma2] comp <- "gamma2" gamma2.pos <- gamma2 } if (!missing(phi)) { vc <- x$phi[phi] comp <- "phi" phi.pos <- phi } #return(list(comp=comp, vc=vc, sigma2.pos=sigma2.pos, tau2.pos=tau2.pos, rho.pos=rho.pos, gamma2.pos=gamma2.pos, phi.pos=phi.pos)) ###################################################################### ### set control parameters for uniroot() and possibly replace with user-defined values ### set vc.min and vc.max and possibly replace with user-defined values con <- list(tol=.Machine$double.eps^0.25, maxiter=1000, verbose=FALSE, eptries=10) if (is.element(comp, c("sigma2", "tau2", "gamma2"))) { con$vc.min <- 0 con$vc.max <- max(ifelse(vc <= .Machine$double.eps^0.5, 10, max(10, vc*100)), con$vc.min) } if (comp == "rho") { if (is.element(x$struct[1], c("CS","HCS"))) con$vc.min <- -1 ### this will fail most of the time but with retries, this may get closer to actual lower bound #con$vc.min <- min(-1/(x$g.nlevels.f[1] - 1), vc) ### this guarantees that cor matrix is semi-positive definite, but since V gets added, this is actually too strict if (is.element(x$struct[1], c("AR","HAR","CAR"))) con$vc.min <- min(0, vc) ### negative autocorrelation parameters not considered (not even sensible for CAR) if (is.element(x$struct[1], c("UN","UNR","GEN"))) con$vc.min <- -1 ### TODO: this will often fail! (but with retries, this should still work) con$vc.max <- 1 if (is.element(x$struct[1], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH"))) { con$vc.min <- 0 ### TODO: 0 basically always fails con$vc.max <- max(10, vc*10) } if (is.element(x$struct[1], c("PHYPL","PHYPD"))) { con$vc.min <- 0 con$vc.max <- max(2, vc*2) } } if (comp == "phi") { if (is.element(x$struct[2], c("CS","HCS"))) con$vc.min <- -1 ### this will fail most of the time but with retries, this may get closer to actual lower bound #con$vc.min <- min(-1/(x$h.nlevels.f[1] - 1), vc) ### this guarantees that cor matrix is semi-positive definite, but since V gets added, this is actually too strict if (is.element(x$struct[2], c("AR","HAR","CAR"))) con$vc.min <- min(0, vc) ### negative autocorrelation parameters not considered (not even sensible for CAR) if (is.element(x$struct[2], c("UN","UNR","GEN"))) con$vc.min <- -1 ### TODO: this will often fail! (but with retries, this should still work) con$vc.max <- 1 if (is.element(x$struct[2], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH"))) { con$vc.min <- 0 ### TODO: 0 basically always fails con$vc.max <- max(10, vc*10) } if (is.element(x$struct[2], c("PHYPL","PHYPD"))) { con$vc.min <- 0 con$vc.max <- max(2, vc*2) } } con.pos <- pmatch(names(control), names(con)) con[c(na.omit(con.pos))] <- control[!is.na(con.pos)] if (verbose) con$verbose <- verbose verbose <- con$verbose ###################################################################### vc.lb <- NA_real_ vc.ub <- NA_real_ ci.null <- FALSE ### logical if CI is a null set lb.conv <- FALSE ### logical if search converged for lower bound (LB) ub.conv <- FALSE ### logical if search converged for upper bound (UB) lb.sign <- "" ### for sign in case LB must be below vc.min ("<") or above vc.max (">") ub.sign <- "" ### for sign in case UB must be below vc.min ("<") or above vc.max (">") ###################################################################### ###################################################################### ###################################################################### ### Profile Likelihood method if (type == "pl") { if (con$vc.min > vc) stop(mstyle$stop("Lower bound of interval to be searched must be <= estimated value of component.")) if (con$vc.max < vc) stop(mstyle$stop("Upper bound of interval to be searched must be >= estimated value of component.")) objective <- qchisq(1-level, df=1) ################################################################### ### search for lower bound ### get diff value when setting component to vc.min; this value should be positive (i.e., discrepancy must be larger than critical value) ### if it is not, then the lower bound must be below vc.min epdiff <- abs(con$vc.min - vc) / con$eptries for (i in seq_len(con$eptries)) { res <- try(.profile.rma.mv(con$vc.min, obj=x, comp=comp, sigma2.pos=sigma2.pos, tau2.pos=tau2.pos, rho.pos=rho.pos, gamma2.pos=gamma2.pos, phi.pos=phi.pos, confint=TRUE, objective=objective, verbose=verbose), silent=TRUE) if (!inherits(res, "try-error") && !is.na(res)) { if (!.isTRUE(ddd$extint) && res < 0) { vc.lb <- con$vc.min lb.conv <- TRUE if (is.element(comp, c("sigma2", "tau2", "gamma2")) && con$vc.min > 0) lb.sign <- "<" if (is.element(comp, c("rho", "phi")) && con$vc.min > -1) lb.sign <- "<" if (((comp == "rho" && is.element(x$struct[1], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYPL","PHYPD"))) || (comp == "phi" && is.element(x$struct[2], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYPL","PHYPD")))) && con$vc.min > 0) lb.sign <- "<" } else { if (.isTRUE(ddd$extint)) { res <- try(uniroot(.profile.rma.mv, interval=c(con$vc.min, vc), tol=con$tol, maxiter=con$maxiter, extendInt="downX", obj=x, comp=comp, sigma2.pos=sigma2.pos, tau2.pos=tau2.pos, rho.pos=rho.pos, gamma2.pos=gamma2.pos, phi.pos=phi.pos, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } else { res <- try(uniroot(.profile.rma.mv, interval=c(con$vc.min, vc), tol=con$tol, maxiter=con$maxiter, obj=x, comp=comp, sigma2.pos=sigma2.pos, tau2.pos=tau2.pos, rho.pos=rho.pos, gamma2.pos=gamma2.pos, phi.pos=phi.pos, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } ### check if uniroot method converged if (!inherits(res, "try-error")) { vc.lb <- res lb.conv <- TRUE } } break } con$vc.min <- con$vc.min + epdiff } if (verbose) cat("\n") ################################################################### ### search for upper bound ### get diff value when setting component to vc.max; this value should be positive (i.e., discrepancy must be larger than critical value) ### if it is not, then the upper bound must be above vc.max epdiff <- abs(con$vc.max - vc) / con$eptries for (i in seq_len(con$eptries)) { res <- try(.profile.rma.mv(con$vc.max, obj=x, comp=comp, sigma2.pos=sigma2.pos, tau2.pos=tau2.pos, rho.pos=rho.pos, gamma2.pos=gamma2.pos, phi.pos=phi.pos, confint=TRUE, objective=objective, verbose=verbose), silent=TRUE) if (!inherits(res, "try-error") && !is.na(res)) { if (!.isTRUE(ddd$extint) && res < 0) { vc.ub <- con$vc.max ub.conv <- TRUE if (is.element(comp, c("sigma2", "tau2", "gamma2"))) ub.sign <- ">" if (is.element(comp, c("rho", "phi")) && con$vc.max < 1) ub.sign <- ">" if ((comp == "rho" && is.element(x$struct[1], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYPL","PHYPD"))) || (comp == "phi" && is.element(x$struct[2], c("SPEXP","SPGAU","SPLIN","SPRAT","SPSPH","PHYPL","PHYPD")))) ub.sign <- ">" } else { if (.isTRUE(ddd$extint)) { res <- try(uniroot(.profile.rma.mv, interval=c(vc, con$vc.max), tol=con$tol, maxiter=con$maxiter, extendInt="upX", obj=x, comp=comp, sigma2.pos=sigma2.pos, tau2.pos=tau2.pos, rho.pos=rho.pos, gamma2.pos=gamma2.pos, phi.pos=phi.pos, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } else { res <- try(uniroot(.profile.rma.mv, interval=c(vc, con$vc.max), tol=con$tol, maxiter=con$maxiter, obj=x, comp=comp, sigma2.pos=sigma2.pos, tau2.pos=tau2.pos, rho.pos=rho.pos, gamma2.pos=gamma2.pos, phi.pos=phi.pos, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } ### check if uniroot method converged if (!inherits(res, "try-error")) { vc.ub <- res ub.conv <- TRUE } } break } con$vc.max <- con$vc.max - epdiff } ################################################################### } ###################################################################### ###################################################################### ###################################################################### if (!lb.conv) warning(mstyle$warning("Cannot obtain lower bound of profile likelihood CI due to convergence problems."), call.=FALSE) if (!ub.conv) warning(mstyle$warning("Cannot obtain upper bound of profile likelihood CI due to convergence problems."), call.=FALSE) ###################################################################### vc <- c(vc, vc.lb, vc.ub) if (is.element(comp, c("sigma2", "tau2", "gamma2"))) { vcsqrt <- sqrt(ifelse(vc >= 0, vc, NA_real_)) res.random <- rbind(vc, vcsqrt) if (comp == "sigma2") { if (length(x$sigma2) == 1L) { rownames(res.random) <- c("sigma^2", "sigma") } else { rownames(res.random) <- paste0(c("sigma^2", "sigma"), ".", sigma2.pos) } } if (comp == "tau2") { if (length(x$tau2) == 1L) { rownames(res.random) <- c("tau^2", "tau") } else { rownames(res.random) <- paste0(c("tau^2", "tau"), ".", tau2.pos) } } if (comp == "gamma2") { if (length(x$gamma2) == 1L) { rownames(res.random) <- c("gamma^2", "gamma") } else { rownames(res.random) <- paste0(c("gamma^2", "gamma"), ".", gamma2.pos) } } } else { res.random <- rbind(vc) if (comp == "rho") { if (length(x$rho) == 1L) { rownames(res.random) <- "rho" } else { rownames(res.random) <- paste0("rho.", rho.pos) } } if (comp == "phi") { if (length(x$phi) == 1L) { rownames(res.random) <- "phi" } else { rownames(res.random) <- paste0("phi.", rho.pos) } } } colnames(res.random) <- c("estimate", "ci.lb", "ci.ub") } ######################################################################### ######################################################################### ######################################################################### if (fixed) { if (is.element(x$test, c("knha","adhoc","t"))) { crit <- sapply(seq_along(x$ddf), function(j) if (x$ddf[j] > 0) qt(level/2, df=x$ddf[j], lower.tail=FALSE) else NA_real_) } else { crit <- qnorm(level/2, lower.tail=FALSE) } beta <- c(x$beta) ci.lb <- c(beta - crit * x$se) ci.ub <- c(beta + crit * x$se) if (is.function(transf)) { if (is.null(targs)) { beta <- sapply(beta, transf) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) } else { beta <- sapply(beta, transf, targs) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) } } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] res.fixed <- cbind(estimate=beta, ci.lb=ci.lb, ci.ub=ci.ub) rownames(res.fixed) <- rownames(x$beta) } ######################################################################### ######################################################################### ######################################################################### res <- list() if (fixed) res$fixed <- res.fixed if (random) res$random <- res.random res$digits <- digits if (random) { res$ci.null <- ci.null res$lb.sign <- lb.sign res$ub.sign <- ub.sign #res$vc.min <- con$vc.min } if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(res) <- "confint.rma" return(res) } metafor/R/plot.vif.rma.r0000644000176200001440000001226214465404004014616 0ustar liggesusersplot.vif.rma <- function(x, breaks="Scott", freq=FALSE, col, border, col.out, col.density, trim=0, adjust=1, lwd=c(2,0), layout, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="vif.rma") .start.plot() if (missing(col)) col <- .coladj(par("bg","fg"), dark=0.3, light=-0.3) if (missing(border)) border <- .coladj(par("bg"), dark=0.1, light=-0.1) if (missing(col.out)) col.out <- rgb(1,0,0,0.5) if (missing(col.density)) col.density <- ifelse(.is.dark(), "dodgerblue", "blue") par.mfrow <- par("mfrow") if (!is.null(x$alpha)) { if (is.null(x[[2]]$sim)) { plot(x[[1]], breaks=breaks, freq=freq, col=col, border=border, trim=trim, col.out=col.out, col.density=col.density, adjust=adjust, lwd=lwd, layout=layout, mainadd="Location ", ...) return(invisible()) } if (is.null(x[[1]]$sim)) { plot(x[[2]], breaks=breaks, freq=freq, col=col, border=border, trim=trim, col.out=col.out, col.density=col.density, adjust=adjust, lwd=lwd, layout=layout, mainadd="Scale ", ...) return(invisible()) } np <- length(x[[1]]$vifs) + length(x[[2]]$vifs) ### set/check layout argument if (missing(layout)) { layout <- n2mfrow(np) } else { layout <- layout[layout >= 1] layout <- round(layout) if (length(layout) != 2L) stop(mstyle$stop("Incorrect specification of 'layout' argument.")) } plot(x[[1]], breaks=breaks, freq=freq, col=col, border=border, trim=trim, col.out=col.out, col.density=col.density, adjust=adjust, lwd=lwd, layout=layout, mainadd="Location ", ...) plot(x[[2]], breaks=breaks, freq=freq, col=col, border=border, trim=trim, col.out=col.out, col.density=col.density, adjust=adjust, lwd=lwd, mainadd="Scale ", new=FALSE, par.mfrow=par.mfrow, ...) return(invisible()) } ddd <- list(...) if (is.null(ddd$tail)) { tail <- "upper" } else { tail <- match.arg(ddd$tail, c("lower", "upper")) } if (is.null(ddd$new)) { new <- TRUE } else { new <- FALSE } if (is.null(ddd$mainadd)) { mainadd <- "" } else { mainadd <- ddd$mainadd } ### check if 'sim' was actually used if (is.null(x$sim)) stop(mstyle$stop("Can only plot 'vif.rma' objects when 'sim=TRUE' was used.")) ### number of plots np <- length(x$vifs) ### set/check layout argument if (missing(layout)) { layout <- n2mfrow(np) } else { layout <- layout[layout >= 1] layout <- round(layout) if (length(layout) != 2L) stop(mstyle$stop("Incorrect specification of 'layout' argument.")) } ### 1st: obs stat, 2nd: density if (length(lwd) == 1L) lwd <- lwd[c(1,1)] ### cannot plot density when freq=TRUE if (freq) lwd[2] <- 0 ### check trim if (trim >= 0.5) stop(mstyle$stop("The value of 'trim' must be < 0.5.")) ### local plotting functions lhist <- function(..., tail, new, par.mfrow, mainadd) hist(...) labline <- function(..., tail, new, par.mfrow, mainadd) abline(...) lsegments <- function(..., tail, new, par.mfrow, mainadd) segments(...) llines <- function(..., tail, new, par.mfrow, mainadd) lines(...) ############################################################################ if (new) { par(mfrow=layout) } else { on.exit(par(mfrow = ddd$par.mfrow), add=TRUE) } for (i in seq_len(np)) { pvif <- x$sim[,i] pvif <- pvif[is.finite(pvif)] den <- density(pvif, adjust=adjust) if (trim > 0) { bound <- quantile(pvif, probs=1-trim) pvif <- pvif[pvif <= bound] } tmp <- lhist(pvif, breaks=breaks, plot=FALSE) ylim <- c(0, max(ifelse(lwd[2] == 0, 0, max(den$y)), max(tmp$density))) tmp <- lhist(pvif, breaks=breaks, col=col, border=border, main=paste0(mainadd, "Coefficient", ifelse(x$vif[[i]]$m > 1, "s", ""), ": ", names(x$vifs)[i]), xlab="Value of VIF", freq=freq, ylim=ylim, xaxt="n", ...) xat <- axTicks(side=1) xlabels <- xat axis(side=1, at=xat, labels=xlabels) .coltail(tmp, val=x$vifs[i], col=col.out, border=border, freq=freq, ...) usr <- par()$usr if (x$vifs[i] > usr[2] && lwd[1] > 0) { ya <- mean(par()$yaxp[1:2]) arrows(usr[2] - .08*(usr[2]-usr[1]), ya, usr[2] - .01*(usr[2]-usr[1]), ya, length = .02*(grconvertY(usr[4], from="user", to="inches")- (grconvertY(usr[3], from="user", to="inches")))) } x$vifs[i] <- min(x$vifs[i], usr[2]) par(xpd = TRUE) if (lwd[1] > 0) lsegments(x$vifs[i], usr[3], x$vifs[i], usr[4], lwd=lwd[1], lty="dashed", ...) par(xpd = FALSE) #den$y <- den$y[den$x <= par()$xaxp[2]] #den$x <- den$x[den$x <= par()$xaxp[2]] if (lwd[2] > 0) llines(den, lwd=lwd[2], col=col.density, ...) } ############################################################################ invisible() } metafor/R/leave1out.rma.peto.r0000644000176200001440000000773214401667637015753 0ustar liggesusersleave1out.rma.peto <- function(x, digits, transf, targs, progbar=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.peto") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (!x$int.only) stop(mstyle$stop("Method only applicable to models without moderators.")) if (x$k == 1) stop(mstyle$stop("Stopped because k = 1.")) if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL ddd <- list(...) .chkdots(ddd, c("time")) if (.isTRUE(ddd$time)) time.start <- proc.time() ######################################################################### beta <- rep(NA_real_, x$k.f) se <- rep(NA_real_, x$k.f) zval <- rep(NA_real_, x$k.f) pval <- rep(NA_real_, x$k.f) ci.lb <- rep(NA_real_, x$k.f) ci.ub <- rep(NA_real_, x$k.f) QE <- rep(NA_real_, x$k.f) QEp <- rep(NA_real_, x$k.f) #tau2 <- rep(NA_real_, x$k.f) I2 <- rep(NA_real_, x$k.f) H2 <- rep(NA_real_, x$k.f) ### elements that need to be returned outlist <- "beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, QE=QE, QEp=QEp, tau2=tau2, I2=I2, H2=H2" ### note: skipping NA cases if (progbar) pbar <- pbapply::startpb(min=0, max=x$k.f) for (i in seq_len(x$k.f)) { if (progbar) pbapply::setpb(pbar, i) if (!x$not.na[i]) next args <- list(ai=x$outdat.f$ai, bi=x$outdat.f$bi, ci=x$outdat.f$ci, di=x$outdat.f$di, add=x$add, to=x$to, drop00=x$drop00, level=x$level, subset=-i, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.peto, args)), silent=TRUE) if (inherits(res, "try-error")) next beta[i] <- res$beta se[i] <- res$se zval[i] <- res$zval pval[i] <- res$pval ci.lb[i] <- res$ci.lb ci.ub[i] <- res$ci.ub QE[i] <- res$QE QEp[i] <- res$QEp #tau2[i] <- res$tau2 I2[i] <- res$I2 H2[i] <- res$H2 } if (progbar) pbapply::closepb(pbar) ######################################################################### ### if requested, apply transformation function if (.isTRUE(transf)) ### if transf=TRUE, apply exp transformation to ORs transf <- exp if (is.function(transf)) { if (is.null(targs)) { beta <- sapply(beta, transf) se <- rep(NA_real_, x$k.f) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) } else { beta <- sapply(beta, transf, targs) se <- rep(NA_real_, x$k.f) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) } transf <- TRUE } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] ######################################################################### if (na.act == "na.omit") { out <- list(estimate=beta[x$not.na], se=se[x$not.na], zval=zval[x$not.na], pval=pval[x$not.na], ci.lb=ci.lb[x$not.na], ci.ub=ci.ub[x$not.na], Q=QE[x$not.na], Qp=QEp[x$not.na], I2=I2[x$not.na], H2=H2[x$not.na]) out$slab <- x$slab[x$not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(estimate=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, Q=QE, Qp=QEp, I2=I2, H2=H2) out$slab <- x$slab } if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) out$digits <- digits out$transf <- transf if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(out) <- "list.rma" return(out) } metafor/R/forest.cumul.rma.r0000644000176200001440000006220414503014713015501 0ustar liggesusersforest.cumul.rma <- function(x, annotate=TRUE, header=FALSE, xlim, alim, olim, ylim, at, steps=5, level=x$level, refline=0, digits=2L, width, xlab, ilab, ilab.xpos, ilab.pos, transf, atransf, targs, rows, efac=1, pch, psize, col, shade, colshade, lty, fonts, cex, cex.lab, cex.axis, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="cumul.rma") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (missing(transf)) transf <- FALSE if (missing(atransf)) atransf <- FALSE transf.char <- deparse(transf) atransf.char <- deparse(atransf) if (is.function(transf) && is.function(atransf)) stop(mstyle$stop("Use either 'transf' or 'atransf' to specify a transformation (not both).")) .start.plot() yi <- x$estimate if (missing(targs)) targs <- NULL if (missing(at)) at <- NULL mf <- match.call() if (missing(ilab)) { ilab <- NULL } else { ilab <- .getx("ilab", mf=mf, data=x$data) } if (missing(ilab.xpos)) ilab.xpos <- NULL if (missing(ilab.pos)) ilab.pos <- NULL if (missing(col)) { col <- par("fg") } else { col <- .getx("col", mf=mf, data=x$data) } if (missing(pch)) { pch <- 15 } else { pch <- .getx("pch", mf=mf, data=x$data) } if (missing(psize)) { psize <- 1 } else { psize <- .getx("psize", mf=mf, data=x$data) } if (missing(shade)) { shade <- NULL } else { shade <- .getx("shade", mf=mf, data=x$data) } if (missing(colshade)) colshade <- .coladj(par("bg","fg"), dark=0.1, light=-0.1) if (missing(cex)) cex <- NULL if (missing(cex.lab)) cex.lab <- NULL if (missing(cex.axis)) cex.axis <- NULL level <- .level(level) ### digits[1] for annotations, digits[2] for x-axis labels ### note: digits can also be a list (e.g., digits=list(2,3L)); trailing 0's on the x-axis labels ### are dropped if the value is an integer if (length(digits) == 1L) digits <- c(digits,digits) ddd <- list(...) ############################################################################ ### set default line types if user has not specified 'lty' argument if (missing(lty)) { lty <- c("solid", "solid") # 1st = CIs, 2nd = horizontal line(s) } else { if (length(lty) == 1L) lty <- c(lty, "solid") } ### vertical expansion factor: 1st = CI end lines, 2nd = arrows if (length(efac) == 1L) efac <- rep(efac, 2L) ### annotation symbols vector if (is.null(ddd$annosym)) { annosym <- c(" [", ", ", "]", "-", " ") # 4th element for minus sign symbol; 5th for space (in place of numbers and +); see [a] } else { annosym <- ddd$annosym if (length(annosym) == 3L) annosym <- c(annosym, "-", " ") if (length(annosym) == 4L) annosym <- c(annosym, " ") if (length(annosym) != 5L) stop(mstyle$stop("Argument 'annosym' must be a vector of length 3 (or 4 or 5).")) } ### adjust annosym for tabular figures if (isTRUE(ddd$tabfig == 1)) annosym <- c("\u2009[", ",\u2009", "]", "\u2212", "\u2002") # \u2009 thin space; \u2212 minus, \u2002 en space if (isTRUE(ddd$tabfig == 2)) annosym <- c("\u2009[", ",\u2009", "]", "\u2013", "\u2002") # \u2009 thin space; \u2013 en dash, \u2002 en space if (isTRUE(ddd$tabfig == 3)) annosym <- c("\u2009[", ",\u2009", "]", "\u2212", "\u2007") # \u2009 thin space; \u2212 minus, \u2007 figure space ### get measure from object measure <- x$measure ### column header estlab <- .setlab(measure, transf.char, atransf.char, gentype=3, short=TRUE) if (is.expression(estlab)) { header.right <- str2lang(paste0("bold(", estlab, " * '", annosym[1], "' * '", 100*(1-level), "% CI'", " * '", annosym[3], "')")) } else { header.right <- paste0(estlab, annosym[1], 100*(1-level), "% CI", annosym[3]) } if (is.logical(header)) { if (header) { header.left <- "Study" } else { header.left <- NULL header.right <- NULL } } else { if (!is.character(header)) stop(mstyle$stop("Argument 'header' must either be a logical or character vector.")) if (length(header) == 1L) { header.left <- header } else { header.left <- header[1] header.right <- header[2] } } if (!annotate) header.right <- NULL if (!is.null(ddd$clim)) olim <- ddd$clim ### row adjustments for 1) study labels, 2) annotations, and 3) ilab elements if (is.null(ddd$rowadj)) { rowadj <- rep(0,3) } else { rowadj <- ddd$rowadj if (length(rowadj) == 1L) rowadj <- c(rowadj,rowadj,0) # if one value is specified, use it for both 1&2 if (length(rowadj) == 2L) rowadj <- c(rowadj,0) # if two values are specified, use them for 1&2 } if (is.null(ddd$top)) { top <- 3 } else { top <- ddd$top } if (is.null(ddd$xlabadj)) { xlabadj <- c(NA,NA) } else { xlabadj <- ddd$xlabadj if (length(xlabadj) == 1L) xlabadj <- c(xlabadj, 1-xlabadj) } if (is.null(ddd$xlabfont)) { xlabfont <- 1 } else { xlabfont <- ddd$xlabfont } lplot <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) plot(...) labline <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) abline(...) lsegments <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) segments(...) laxis <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) axis(...) lmtext <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) mtext(...) lpolygon <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) polygon(...) ltext <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) text(...) lpoints <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) points(...) ######################################################################### ### extract data / results and other arguments vi <- x$se^2 ci.lb <- x$ci.lb ci.ub <- x$ci.ub ### check length of yi and vi k <- length(yi) # either of length k when na.action="na.omit" or k.f otherwise if (length(vi) != k) stop(mstyle$stop("Length of 'yi' and 'vi' (or 'sei') is not the same.")) ### note: ilab, pch, psize, col must be of the same length as yi (which may ### or may not contain NAs; this is different than the other forest() ### functions but it would be tricky to make this fully consistent now if (x$slab.null) { slab <- paste("+ Study", x$ids) # cumul() removes the studies with NAs when na.action="na.omit" slab[1] <- paste("Study", x$ids[1]) slab.null <- TRUE } else { slab <- paste("+", x$slab) # cumul() removes the studies with NAs when na.action="na.omit" slab[1] <- paste(x$slab[1]) slab.null <- FALSE } if (!is.null(ilab)) { if (is.null(dim(ilab))) ilab <- cbind(ilab) if (nrow(ilab) != k) stop(mstyle$stop(paste0("Length of the 'ilab' argument (", nrow(ilab), ") does not correspond to the number of outcomes (", k, ")."))) } if (length(pch) == 1L) pch <- rep(pch, k) if (length(pch) != k) stop(mstyle$stop(paste0("Length of the 'pch' argument (", length(pch), ") does not correspond to the number of outcomes (", k, ")."))) if (length(psize) == 1L) psize <- rep(psize, k) if (length(psize) != k) stop(mstyle$stop(paste0("Length of the 'psize' argument (", length(psize), ") does not correspond to the number of outcomes (", k, ")."))) if (length(col) == 1L) col <- rep(col, k) if (length(col) != k) stop(mstyle$stop(paste0("Length of the 'col' argument (", length(col), ") does not correspond to the number of outcomes (", k, ")."))) shade.type <- "none" if (is.character(shade)) { shade.type <- "character" shade <- shade[1] if (!is.element(shade, c("zebra", "zebra1", "zebra2", "all"))) stop(mstyle$stop("Unknown option specified for 'shade' argument.")) } if (is.logical(shade)) { if (length(shade) == 1L) { shade <- "zebra" shade.type <- "character" } else { shade.type <- "logical" shade <- .chksubset(shade, k, stoponk0=FALSE) } } if (is.numeric(shade)) shade.type <- "numeric" ### set rows value if (missing(rows)) { rows <- k:1 } else { if (length(rows) == 1L) rows <- rows:(rows-k+1) } if (length(rows) != k) stop(mstyle$stop(paste0("Length of the 'rows' argument (", length(rows), ") does not correspond to the number of outcomes (", k, ")."))) ### reverse order yi <- yi[k:1] vi <- vi[k:1] ci.lb <- ci.lb[k:1] ci.ub <- ci.ub[k:1] slab <- slab[k:1] ilab <- ilab[k:1,,drop=FALSE] # if NULL, remains NULL pch <- pch[k:1] psize <- psize[k:1] # if NULL, remains NULL col <- col[k:1] rows <- rows[k:1] if (shade.type == "logical") shade <- shade[k:1] ### check for NAs in yi/vi and act accordingly yivi.na <- is.na(yi) | is.na(vi) if (any(yivi.na)) { not.na <- !yivi.na if (na.act == "na.omit") { yi <- yi[not.na] vi <- vi[not.na] ci.lb <- ci.lb[not.na] ci.ub <- ci.ub[not.na] slab <- slab[not.na] ilab <- ilab[not.na,,drop=FALSE] # if NULL, remains NULL pch <- pch[not.na] psize <- psize[not.na] # if NULL, remains NULL col <- col[not.na] if (shade.type == "logical") shade <- shade[not.na] rows.new <- rows # rearrange rows due to NAs being omitted from plot rows.na <- rows[!not.na] # shift higher rows down according to number of NAs omitted for (j in seq_along(rows.na)) { rows.new[rows >= rows.na[j]] <- rows.new[rows >= rows.na[j]] - 1 } rows <- rows.new[not.na] } if (na.act == "na.fail") stop(mstyle$stop("Missing values in results.")) } # note: yi/vi may be NA if na.act == "na.exclude" or "na.pass" k <- length(yi) # in case length of k has changed ### if requested, apply transformation to yi's and CI bounds if (is.function(transf)) { if (is.null(targs)) { yi <- sapply(yi, transf) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) } else { yi <- sapply(yi, transf, targs) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) } } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] ### apply observation/outcome limits if specified if (!missing(olim)) { if (length(olim) != 2L) stop(mstyle$stop("Argument 'olim' must be of length 2.")) olim <- sort(olim) yi[yi < olim[1]] <- olim[1] yi[yi > olim[2]] <- olim[2] ci.lb[ci.lb < olim[1]] <- olim[1] ci.ub[ci.ub > olim[2]] <- olim[2] } ######################################################################### if (!is.null(at)) { if (anyNA(at)) stop(mstyle$stop("Argument 'at' cannot contain NAs.")) if (any(is.infinite(at))) stop(mstyle$stop("Argument 'at' cannot contain +-Inf values.")) } ### set x-axis limits (at argument overrides alim argument) alim.spec <- TRUE if (missing(alim)) { if (is.null(at)) { alim <- range(pretty(x=c(min(ci.lb, na.rm=TRUE), max(ci.ub, na.rm=TRUE)), n=steps-1)) alim.spec <- FALSE } else { alim <- range(at) } } alim <- sort(alim)[1:2] if (anyNA(alim)) stop(mstyle$stop("Argument 'alim' cannot contain NAs.")) ### generate x-axis positions if none are specified if (is.null(at)) { if (alim.spec) { at <- seq(from=alim[1], to=alim[2], length.out=steps) } else { at <- pretty(x=c(min(ci.lb, na.rm=TRUE), max(ci.ub, na.rm=TRUE)), n=steps-1) } } else { at[at < alim[1]] <- alim[1] # remove at values that are below or above the axis limits at[at > alim[2]] <- alim[2] at <- unique(at) } ### x-axis labels (apply transformation to axis labels if requested) at.lab <- at if (is.function(atransf)) { if (is.null(targs)) { at.lab <- fmtx(sapply(at.lab, atransf), digits[[2]], drop0ifint=TRUE) } else { at.lab <- fmtx(sapply(at.lab, atransf, targs), digits[[2]], drop0ifint=TRUE) } } else { at.lab <- fmtx(at.lab, digits[[2]], drop0ifint=TRUE) } ### set plot limits (xlim) ncol.ilab <- ifelse(is.null(ilab), 0, ncol(ilab)) if (slab.null) { area.slab <- 25 } else { area.slab <- 40 } if (annotate) { area.anno <- 25 } else { area.anno <- 10 } iadd <- 5 area.slab <- area.slab + iadd*ncol.ilab #area.anno <- area.anno area.forest <- 100 + iadd*ncol.ilab - area.slab - area.anno area.slab <- area.slab / (100 + iadd*ncol.ilab) area.anno <- area.anno / (100 + iadd*ncol.ilab) area.forest <- area.forest / (100 + iadd*ncol.ilab) plot.multp.l <- area.slab / area.forest plot.multp.r <- area.anno / area.forest if (missing(xlim)) { if (min(ci.lb, na.rm=TRUE) < alim[1]) { f.1 <- alim[1] } else { f.1 <- min(ci.lb, na.rm=TRUE) } if (max(ci.ub, na.rm=TRUE) > alim[2]) { f.2 <- alim[2] } else { f.2 <- max(ci.ub, na.rm=TRUE) } rng <- f.2 - f.1 xlim <- c(f.1 - rng * plot.multp.l, f.2 + rng * plot.multp.r) xlim <- round(xlim, digits[[2]]) #xlim[1] <- xlim[1]*max(1, digits[[2]]/2) #xlim[2] <- xlim[2]*max(1, digits[[2]]/2) } xlim <- sort(xlim) ### plot limits must always encompass the yi values (no longer done) #if (xlim[1] > min(yi, na.rm=TRUE)) { xlim[1] <- min(yi, na.rm=TRUE) } #if (xlim[2] < max(yi, na.rm=TRUE)) { xlim[2] <- max(yi, na.rm=TRUE) } ### x-axis limits must always encompass the yi values (no longer done) #if (alim[1] > min(yi, na.rm=TRUE)) { alim[1] <- min(yi, na.rm=TRUE) } #if (alim[2] < max(yi, na.rm=TRUE)) { alim[2] <- max(yi, na.rm=TRUE) } ### plot limits must always encompass the x-axis limits (no longer done) #if (alim[1] < xlim[1]) { xlim[1] <- alim[1] } #if (alim[2] > xlim[2]) { xlim[2] <- alim[2] } ### allow adjustment of position of study labels and annotations via textpos argument if (is.null(ddd$textpos)) { textpos <- xlim } else { textpos <- ddd$textpos } if (length(textpos) != 2L) stop(mstyle$stop("Argument 'textpos' must be of length 2.")) if (is.na(textpos[1])) textpos[1] <- xlim[1] if (is.na(textpos[2])) textpos[2] <- xlim[2] ### set y-axis limits if (missing(ylim)) { ylim <- c(0.5, max(rows, na.rm=TRUE)+top) } else { ylim <- sort(ylim) } ######################################################################### ### set/get fonts (1st for study labels, 2nd for annotations, 3rd for ilab) ### when passing a named vector, the names are for 'family' and the values are for 'font' if (missing(fonts)) { fonts <- rep(par("family"), 3L) } else { if (length(fonts) == 1L) fonts <- rep(fonts, 3L) if (length(fonts) == 2L) fonts <- c(fonts, fonts[1]) } if (is.null(names(fonts))) fonts <- setNames(c(1L,1L,1L), nm=fonts) par(family=names(fonts)[1], font=fonts[1]) ### adjust margins par.mar <- par("mar") par.mar.adj <- par.mar - c(0,3,1,1) par.mar.adj[par.mar.adj < 0] <- 0 par(mar = par.mar.adj) on.exit(par(mar = par.mar), add=TRUE) ### start plot lplot(NA, NA, xlim=xlim, ylim=ylim, xlab="", ylab="", yaxt="n", xaxt="n", xaxs="i", bty="n", ...) if (shade.type == "character") { if (shade == "zebra" || shade == "zebra1") tmp <- rep_len(c(TRUE,FALSE), k) if (shade == "zebra2") tmp <- rep_len(c(FALSE,TRUE), k) if (shade == "all") tmp <- rep_len(TRUE, k) shade <- tmp } if (shade.type %in% c("character","logical")) { for (i in seq_len(k)) { if (shade[i]) rect(xlim[1], rows[i]-0.5, xlim[2], rows[i]+0.5, border=colshade, col=colshade) } } if (shade.type == "numeric") { for (i in seq_along(shade)) { rect(xlim[1], shade[i]-0.5, xlim[2], shade[i]+0.5, border=colshade, col=colshade) } } ### horizontal title line labline(h=ylim[2]-(top-1), lty=lty[2], ...) ### get coordinates of the plotting region par.usr <- par("usr") ### add reference line if (is.numeric(refline)) lsegments(refline, par.usr[3], refline, ylim[2]-(top-1), lty="dotted", ...) ### set cex, cex.lab, and cex.axis sizes as a function of the height of the figure height <- par.usr[4] - par.usr[3] if (is.null(cex)) { lheight <- strheight("O") cex.adj <- ifelse(k * lheight > height * 0.8, height/(1.25 * k * lheight), 1) } if (is.null(cex)) { cex <- par("cex") * cex.adj } else { if (is.null(cex.lab)) cex.lab <- cex if (is.null(cex.axis)) cex.axis <- cex } if (is.null(cex.lab)) cex.lab <- par("cex") * cex.adj if (is.null(cex.axis)) cex.axis <- par("cex") * cex.adj ### add x-axis laxis(side=1, at=at, labels=at.lab, cex.axis=cex.axis, ...) ### add x-axis label if (missing(xlab)) xlab <- .setlab(measure, transf.char, atransf.char, gentype=2) if (!is.element(length(xlab), 1:3)) stop(mstyle$stop("Argument 'xlab' argument must be of length 1, 2, or 3.")) if (length(xlab) == 1L) lmtext(xlab, side=1, at=min(at) + (max(at)-min(at))/2, line=par("mgp")[1]-0.5, cex=cex.lab, font=xlabfont[1], ...) if (length(xlab) == 2L) { lmtext(xlab[1], side=1, at=min(at), line=par("mgp")[1]-0.5, cex=cex.lab, adj=xlabadj[1], font=xlabfont[1], ...) lmtext(xlab[2], side=1, at=max(at), line=par("mgp")[1]-0.5, cex=cex.lab, adj=xlabadj[2], font=xlabfont[1], ...) } if (length(xlab) == 3L) { lmtext(xlab[1], side=1, at=min(at), line=par("mgp")[1]-0.5, cex=cex.lab, adj=xlabadj[1], font=xlabfont[1], ...) lmtext(xlab[2], side=1, at=min(at) + (max(at)-min(at))/2, line=par("mgp")[1]-0.5, cex=cex.lab, font=xlabfont[2], ...) lmtext(xlab[3], side=1, at=max(at), line=par("mgp")[1]-0.5, cex=cex.lab, adj=xlabadj[2], font=xlabfont[1], ...) } ### add CI ends (either | or <> if outside of axis limits) for (i in seq_len(k)) { ### need to skip missings (if check below will otherwise throw an error) if (is.na(yi[i]) || is.na(vi[i])) next ### if the lower bound is actually larger than upper x-axis limit, then everything is to the right and just draw a polygon pointing in that direction if (ci.lb[i] >= alim[2]) { lpolygon(x=c(alim[2], alim[2]-(1.4/100)*cex*(xlim[2]-xlim[1]), alim[2]-(1.4/100)*cex*(xlim[2]-xlim[1]), alim[2]), y=c(rows[i], rows[i]+(height/150)*cex*efac[2], rows[i]-(height/150)*cex*efac[2], rows[i]), col=col[i], border=col[i], ...) next } ### if the upper bound is actually lower than lower x-axis limit, then everything is to the left and just draw a polygon pointing in that direction if (ci.ub[i] <= alim[1]) { lpolygon(x=c(alim[1], alim[1]+(1.4/100)*cex*(xlim[2]-xlim[1]), alim[1]+(1.4/100)*cex*(xlim[2]-xlim[1]), alim[1]), y=c(rows[i], rows[i]+(height/150)*cex*efac[2], rows[i]-(height/150)*cex*efac[2], rows[i]), col=col[i], border=col[i], ...) next } lsegments(max(ci.lb[i], alim[1]), rows[i], min(ci.ub[i], alim[2]), rows[i], lty=lty[1], col=col[i], ...) if (ci.lb[i] >= alim[1]) { lsegments(ci.lb[i], rows[i]-(height/150)*cex*efac[1], ci.lb[i], rows[i]+(height/150)*cex*efac[1], col=col[i], ...) } else { lpolygon(x=c(alim[1], alim[1]+(1.4/100)*cex*(xlim[2]-xlim[1]), alim[1]+(1.4/100)*cex*(xlim[2]-xlim[1]), alim[1]), y=c(rows[i], rows[i]+(height/150)*cex*efac[2], rows[i]-(height/150)*cex*efac[2], rows[i]), col=col[i], border=col[i], ...) } if (ci.ub[i] <= alim[2]) { lsegments(ci.ub[i], rows[i]-(height/150)*cex*efac[1], ci.ub[i], rows[i]+(height/150)*cex*efac[1], col=col[i], ...) } else { lpolygon(x=c(alim[2], alim[2]-(1.4/100)*cex*(xlim[2]-xlim[1]), alim[2]-(1.4/100)*cex*(xlim[2]-xlim[1]), alim[2]), y=c(rows[i], rows[i]+(height/150)*cex*efac[2], rows[i]-(height/150)*cex*efac[2], rows[i]), col=col[i], border=col[i], ...) } } ### add study labels on the left ltext(textpos[1], rows+rowadj[1], slab, pos=4, cex=cex, col=col, ...) ### add info labels if (!is.null(ilab)) { if (is.null(ilab.xpos)) { #stop(mstyle$stop("Must specify 'ilab.xpos' argument when adding information with 'ilab'.")) dist <- min(ci.lb, na.rm=TRUE) - xlim[1] if (ncol.ilab == 1L) ilab.xpos <- xlim[1] + dist*0.75 if (ncol.ilab == 2L) ilab.xpos <- xlim[1] + dist*c(0.65, 0.85) if (ncol.ilab == 3L) ilab.xpos <- xlim[1] + dist*c(0.60, 0.75, 0.90) if (ncol.ilab >= 4L) ilab.xpos <- seq(xlim[1] + dist*0.5, xlim[1] + dist*0.9, length.out=ncol.ilab) } if (length(ilab.xpos) != ncol(ilab)) stop(mstyle$stop(paste0("Number of 'ilab' columns (", ncol(ilab), ") does not match length of 'ilab.xpos' argument (", length(ilab.xpos), ")."))) if (!is.null(ilab.pos) && length(ilab.pos) == 1L) ilab.pos <- rep(ilab.pos, ncol(ilab)) par(family=names(fonts)[3], font=fonts[3]) for (l in seq_len(ncol(ilab))) { ltext(ilab.xpos[l], rows+rowadj[3], ilab[,l], pos=ilab.pos[l], cex=cex, ...) } par(family=names(fonts)[1], font=fonts[1]) } ### add study annotations on the right: yi [LB, UB] if (annotate) { if (is.function(atransf)) { if (is.null(targs)) { annotext <- cbind(sapply(yi, atransf), sapply(ci.lb, atransf), sapply(ci.ub, atransf)) } else { annotext <- cbind(sapply(yi, atransf, targs), sapply(ci.lb, atransf, targs), sapply(ci.ub, atransf, targs)) } ### make sure order of intervals is always increasing tmp <- .psort(annotext[,2:3]) annotext[,2:3] <- tmp } else { annotext <- cbind(yi, ci.lb, ci.ub) } annotext <- fmtx(annotext, digits[[1]]) if (missing(width)) { width <- apply(annotext, 2, function(x) max(nchar(x))) } else { if (length(width) == 1L) width <- rep(width, ncol(annotext)) if (length(width) != ncol(annotext)) stop(mstyle$stop(paste0("Length of 'width' argument (", length(width), ") does not the match number of annotation columns (", ncol(annotext), ")."))) } for (j in seq_len(ncol(annotext))) { annotext[,j] <- formatC(annotext[,j], width=width[j]) } annotext <- cbind(annotext[,1], annosym[1], annotext[,2], annosym[2], annotext[,3], annosym[3]) annotext <- apply(annotext, 1, paste, collapse="") annotext[grepl("NA", annotext, fixed=TRUE)] <- "" annotext <- gsub("-", annosym[4], annotext, fixed=TRUE) # [a] annotext <- gsub(" ", annosym[5], annotext, fixed=TRUE) par(family=names(fonts)[2], font=fonts[2]) ltext(textpos[2], rows+rowadj[2], labels=annotext, pos=2, cex=cex, col=col, ...) par(family=names(fonts)[1], font=fonts[1]) } else { width <- NULL } ### add yi points for (i in seq_len(k)) { ### need to skip missings (if check below will otherwise throw an error) if (is.na(yi[i])) next if (yi[i] >= alim[1] && yi[i] <= alim[2]) lpoints(x=yi[i], y=rows[i], pch=pch[i], cex=cex*psize[i], col=col[i], ...) } #lpoints(x=yi, y=rows, pch=pch, cex=cex*psize, ...) ### add header ltext(textpos[1], ylim[2]-(top-1)+1, header.left, pos=4, font=2, cex=cex, ...) ltext(textpos[2], ylim[2]-(top-1)+1, header.right, pos=2, font=2, cex=cex, ...) ######################################################################### ### return some information about plot invisibly res <- list(xlim=par("usr")[1:2], alim=alim, at=at, ylim=ylim, rows=rows, cex=cex, cex.lab=cex.lab, cex.axis=cex.axis, ilab.xpos=ilab.xpos, ilab.pos=ilab.pos, textpos=textpos) ### add some additional stuff to be put into .metafor environment, so that it can be used by addpoly() sav <- c(res, list(level=level, annotate=annotate, digits=digits[[1]], width=width, transf=transf, atransf=atransf, targs=targs, fonts=fonts[1:2], annosym=annosym)) try(assign("forest", sav, envir=.metafor), silent=TRUE) invisible(res) } metafor/R/conv.fivenum.r0000644000176200001440000005517014430165651014725 0ustar liggesusersconv.fivenum <- function(min, q1, median, q3, max, n, data, include, method="default", dist="norm", transf=TRUE, test=TRUE, var.names=c("mean","sd"), append=TRUE, replace="ifna", ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (missing(min) && missing(q1) && missing(median) && missing(q3) && missing(max)) stop(mstyle$stop("Must specify at least some of these arguments: 'min', 'q1', 'median', 'q3', 'max'.")) if (is.logical(replace)) { if (isTRUE(replace)) { replace <- "all" } else { replace <- "ifna" } } replace <- match.arg(replace, c("ifna","all")) ### get ... argument and check for extra/superfluous arguments ddd <- list(...) .chkdots(ddd, c("verbose", "seed")) if (is.null(ddd$verbose)) { verbose <- FALSE } else { verbose <- .isTRUE(ddd$verbose) } if (!is.null(ddd$seed)) set.seed(ddd$seed) testarg <- test ######################################################################### if (missing(data)) data <- NULL has.data <- !is.null(data) if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } ### checks on var.names argument if (length(var.names) != 2L) stop(mstyle$stop("Argument 'var.names' must be of length 2.")) if (any(var.names != make.names(var.names, unique=TRUE))) { var.names <- make.names(var.names, unique=TRUE) warning(mstyle$warning(paste0("Argument 'var.names' does not contain syntactically valid variable names.\nVariable names adjusted to: var.names = c('", var.names[1], "','", var.names[2], "').")), call.=FALSE) } ######################################################################### mf <- match.call() #return(mf) min <- .getx("min", mf=mf, data=data, checknumeric=TRUE) q1 <- .getx("q1", mf=mf, data=data, checknumeric=TRUE) median <- .getx("median", mf=mf, data=data, checknumeric=TRUE) q3 <- .getx("q3", mf=mf, data=data, checknumeric=TRUE) max <- .getx("max", mf=mf, data=data, checknumeric=TRUE) n <- .getx("n", mf=mf, data=data, checknumeric=TRUE) include <- .getx("include", mf=mf, data=data) dist <- .getx("dist", mf=mf, data=data, default="norm") if (!.equal.length(min, q1, median, q3, max, n)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k <- max(length(min), length(q1), length(median), length(q3), length(max), length(n)) if (is.null(min)) min <- rep(NA_real_, k) if (is.null(q1)) q1 <- rep(NA_real_, k) if (is.null(median)) median <- rep(NA_real_, k) if (is.null(q3)) q3 <- rep(NA_real_, k) if (is.null(max)) max <- rep(NA_real_, k) if (is.null(n)) n <- rep(NA_real_, k) ### handle dist argument if (length(dist) == 1L) dist <- rep(dist, k) if (length(dist) != k) stop(mstyle$stop(paste0("Length of 'dist' argument (", length(dist), ") does not match length of data (", k, ")."))) dist <- c("norm","lnorm")[pmatch(dist, c("norm","lnorm"), duplicates.ok=TRUE)] if (anyNA(dist)) stop(mstyle$stop("Unknown 'dist' value specified (should either be 'norm' or 'lnorm').")) ### if include is NULL, set to TRUE vector if (is.null(include)) include <- rep(TRUE, k) ### turn numeric include vector into logical vector include <- .chksubset(include, k, stoponk0=FALSE) ### exclude rows where n < 5 include[which(n < 5)] <- FALSE ### set inputs to NA for rows not to be included min[!include] <- NA_real_ q1[!include] <- NA_real_ median[!include] <- NA_real_ q3[!include] <- NA_real_ max[!include] <- NA_real_ n[!include] <- NA_real_ ######################################################################### ### determine cases case1 <- !is.na(min) & is.na(q1) & is.na(q3) & !is.na(max) case2 <- is.na(min) & !is.na(q1) & !is.na(q3) & is.na(max) case3 <- !is.na(min) & !is.na(q1) & !is.na(q3) & !is.na(max) ### set method method <- tolower(method) if (length(method) == 1L) method <- c(method, method) method1.options <- c("default", "luo/wan/shi", "qe", "bc", "mln", "blue", "hozo2005", "wan2014", "bland2015", "luo2016", "walter2007") method2.options <- c("default", "luo/wan/shi", "qe", "bc", "mln", "blue", "hozo2005", "wan2014", "bland2015", "shi2020", "walter2007") #method[1] <- method1.options[pmatch(method[1], method1.options)] method[1] <- method1.options[grep(paste0("^", method[1]), method1.options)[1]] if (is.na(method[1])) stop(mstyle$stop("Unknown 'method' specified.")) #method[2] <- method2.options[pmatch(method[2], method2.options)] method[2] <- method2.options[grep(paste0("^", method[2]), method2.options)[1]] if (is.na(method[2])) stop(mstyle$stop("Unknown 'method' specified.")) if (method[1] == "default") method[1] <- "luo/wan/shi" if (method[2] == "default") method[2] <- "luo/wan/shi" if (any(dist == "lnorm")) { # if any dist value is 'lnorm', force use of 'luo/wan/shi' method if (!(method[1] == "luo/wan/shi" && method[2] == "luo/wan/shi")) { method <- c("luo/wan/shi", "luo/wan/shi") warning(mstyle$warning("Switching to method='luo/wan/shi' (since dist='lnorm' for one or more studies)."), call.=FALSE) } } if (method[1] %in% c("qe","bc","mln")) { if (method[1] != method[2]) stop(mstyle$stop("Must use the same 'method' for estimating means and SDs.")) if (!requireNamespace("estmeansd", quietly=TRUE)) stop(mstyle$stop("Please install the 'estmeansd' package to use this method.")) test <- FALSE } if (method[1] == "blue") { if (method[1] != method[2]) stop(mstyle$stop("Must use the same 'method' for estimating means and SDs.")) if (!requireNamespace("metaBLUE", quietly=TRUE)) stop(mstyle$stop("Please install the 'metaBLUE' package to use this method.")) } ######################################################################### means <- rep(NA_real_, k) sds <- rep(NA_real_, k) tval <- rep(NA_real_, k) crit <- rep(NA_real_, k) sig <- rep(NA, k) dists <- rep("norm", k) for (i in seq_len(k)) { ### cannot use bc and mln methods with non-positive values if (method[1] %in% c("bc","mln")) { if (any(c(min[i] <= 0, q1[i] <= 0, median[i] <= 0, q3[i] <= 0, max[i] <= 0), na.rm=TRUE)) stop(mstyle$stop(paste0("Cannot use method with non-positive values (found in row ", i, ")."))) } ### when using qe method with negative values, data are assumed to be normally distributed, so test for this (if testarg=TRUE) ### note: this is reset to FALSE for the next iteration (see [a]) if (method[1] == "qe" && any(c(min[i] < 0, q1[i] < 0, median[i] < 0, q3[i] < 0, max[i] < 0), na.rm=TRUE) && testarg) test <- TRUE ### check min <= q1 <= median <= q3 <= max if (is.unsorted(c(min[i], q1[i], median[i], q3[i], max[i]), na.rm=TRUE)) stop(mstyle$stop(paste0("Found 'min <= q1 <= median <= q3 <= max' not true in row ", i, "."))) if (dist[i] == "lnorm") { ### check that min, q1, median, q3, and max are all > 0 when assuming a log-normal distribution if (any(c(min[i] <= 0, q1[i] <= 0, median[i] <= 0, q3[i] <= 0, max[i] <= 0), na.rm=TRUE)) stop(mstyle$stop(paste0("Cannot assume a log-normal distribution with non-positive values (found in row ", i, ")."))) ### log-transform inputs min[i] <- log(min[i]) q1[i] <- log(q1[i]) median[i] <- log(median[i]) q3[i] <- log(q3[i]) max[i] <- log(max[i]) dists[i] <- "lnorm" } if (case1[i]) { ### case 1: min, median, and max are given # test for skewness tval[i] <- abs((min[i] + max[i] - 2*median[i]) / (max[i] - min[i])) #crit[i] <- 1.01 / log(n[i] + 9) + 2.43 / (n[i] + 1) # Shi et al. (2020b) crit[i] <- 1 / log(n[i] + 9) + 2.5 / (n[i] + 1) # Shi et al. (2023) sig[i] <- isTRUE(tval[i] >= crit[i]) if (test && sig[i]) next # mean estimation if (is.element(method[1], c("luo/wan/shi", "luo2016"))) { # Luo et al. (2016), equation (7) weight <- 4 / (4 + n[i]^0.75) means[i] <- weight * (min[i] + max[i]) / 2 + (1 - weight) * median[i] } if (method[1] == "hozo2005") { if (is.na(n[i])) { means[i] <- NA_real_ } else if (n[i] <= 25) { means[i] <- (min[i] + 2*median[i] + max[i]) / 4 } else { means[i] <- median[i] } } if (method[1] == "wan2014") means[i] <- (min[i] + 2*median[i] + max[i]) / 4 if (method[1] == "walter2007") means[i] <- median[i] if (method[1] == "qe") { if (verbose) { tmp <- try(estmeansd::qe.mean.sd(min.val=min[i], med.val=median[i], max.val=max[i], n=n[i])) } else { tmp <- try(suppressWarnings(suppressMessages(estmeansd::qe.mean.sd(min.val=min[i], med.val=median[i], max.val=max[i], n=n[i]))), silent=TRUE) } if (inherits(tmp, "try-error")) { dists[i] <- NA_character_ } else { means[i] <- tmp$est.mean dists[i] <- tmp$selected.dist } } if (method[1] == "bc") { if (verbose) { tmp <- try(estmeansd::bc.mean.sd(min.val=min[i], med.val=median[i], max.val=max[i], n=n[i])) } else { tmp <- try(suppressWarnings(suppressMessages(estmeansd::bc.mean.sd(min.val=min[i], med.val=median[i], max.val=max[i], n=n[i]))), silent=TRUE) } if (!inherits(tmp, "try-error")) means[i] <- tmp$est.mean } if (method[1] == "mln") { if (verbose) { tmp <- try(estmeansd::mln.mean.sd(min.val=min[i], med.val=median[i], max.val=max[i], n=n[i])) } else { tmp <- try(suppressWarnings(suppressMessages(estmeansd::mln.mean.sd(min.val=min[i], med.val=median[i], max.val=max[i], n=n[i]))), silent=TRUE) } if (!inherits(tmp, "try-error")) means[i] <- tmp$est.mean } if (method[1] == "blue") { tmp <- metaBLUE::BLUE_s(c(min[i], median[i], max[i]), n=n[i], "S1") means[i] <- tmp$muhat } # sd estimation if (is.element(method[2], c("luo/wan/shi", "wan2014"))) { # Wan et al. (2014), equation (9) xi <- 2 * qnorm((n[i] - 0.375) / (n[i] + 0.25)) z1 <- ifelse(dist[i] == "norm", 1, 1.01 + 0.25 / log(n[i])^2) #z1 <- 1 sds[i] <- (max[i] - min[i]) / xi * (1/sqrt(z1)) } if (method[2] == "hozo2005") { if (is.na(n[i])) { sds[i] <- NA_real_ } else if (n[i] <= 15) { sds[i] <- 1/sqrt(12) * sqrt((min[i] - 2*median[i] + max[i])^2 / 4 + (max[i]-min[i])^2) } else if (n[i] <= 70) { sds[i] <- (max[i] - min[i]) / 4 } else { sds[i] <- (max[i] - min[i]) / 6 } } if (method[2] == "walter2007") { intfun <- function(x, n) { alpha <- pnorm(x) 1 - (1-alpha)^n - alpha^n } f <- try(integrate(intfun, lower=-Inf, upper=Inf, n=n[i])$value, silent=TRUE) if (inherits(f, "try-error")) next sds[i] <- (max[i] - min[i]) / f } if (method[2] == "qe" && !inherits(tmp, "try-error")) sds[i] <- tmp$est.sd if (method[2] == "bc" && !inherits(tmp, "try-error")) sds[i] <- tmp$est.sd if (method[2] == "mln" && !inherits(tmp, "try-error")) sds[i] <- tmp$est.sd if (method[2] == "blue") sds[i] <- tmp$sigmahat if (dist[i] == "lnorm" && transf) { s41 <- ((max[i] - min[i]) / xi)^4 / (1 + 2.23 / log(n[i])^2) phi1 <- 1 + 0.565 * sds[i]^2 / n[i] + 0.37 * s41 / n[i] btmean <- exp(means[i] + sds[i]^2 / 2) * (1 / phi1) phi11 <- 1 + 2.26 * sds[i]^2 / n[i] + 5.92 * s41 / n[i] phi12 <- 1 + 2.26 * sds[i]^2 / n[i] + 1.48 * s41 / n[i] btsd <- sqrt(exp(2*means[i] + 2*sds[i]^2) * (1 / phi11) - exp(2*means[i] + sds[i]^2) * (1 / phi12)) means[i] <- btmean sds[i] <- btsd } } if (case2[i]) { ### case 2: q1, median, and q3 are given # test for skewness tval[i] <- abs((q1[i] + q3[i] - 2*median[i]) / (q3[i] - q1[i])) #crit[i] <- 2.66 / sqrt(n[i]) - 5.92 / n[i]^2 # Shi et al. (2020b) crit[i] <- 2.65 / sqrt(n[i]) - 6 / n[i]^2 # Shi et al. (2023) sig[i] <- isTRUE(tval[i] >= crit[i]) if (test && sig[i]) next # mean estimation if (is.element(method[1], c("luo/wan/shi", "luo2016"))) { # Luo et al. (2016), equation (11) weight <- 0.7 + 0.39 / n[i] #weight <- 0.699 + 0.4 / n[i] means[i] <- weight * (q1[i] + q3[i]) / 2 + (1 - weight) * median[i] } if (method[1] == "wan2014") means[i] <- (q1[i] + median[i] + q3[i]) / 3 if (method[1] == "qe") { if (verbose) { tmp <- try(estmeansd::qe.mean.sd(q1.val=q1[i], med.val=median[i], q3.val=q3[i], n=n[i])) } else { tmp <- try(suppressWarnings(suppressMessages(estmeansd::qe.mean.sd(q1.val=q1[i], med.val=median[i], q3.val=q3[i], n=n[i]))), silent=TRUE) } if (inherits(tmp, "try-error")) { dists[i] <- NA_character_ } else { means[i] <- tmp$est.mean dists[i] <- tmp$selected.dist } } if (method[1] == "bc") { if (verbose) { tmp <- try(estmeansd::bc.mean.sd(q1.val=q1[i], med.val=median[i], q3.val=q3[i], n=n[i])) } else { tmp <- try(suppressWarnings(suppressMessages(estmeansd::bc.mean.sd(q1.val=q1[i], med.val=median[i], q3.val=q3[i], n=n[i]))), silent=TRUE) } if (!inherits(tmp, "try-error")) means[i] <- tmp$est.mean } if (method[1] == "mln") { if (verbose) { tmp <- try(estmeansd::mln.mean.sd(q1.val=q1[i], med.val=median[i], q3.val=q3[i], n=n[i])) } else { tmp <- try(suppressWarnings(suppressMessages(estmeansd::mln.mean.sd(q1.val=q1[i], med.val=median[i], q3.val=q3[i], n=n[i]))), silent=TRUE) } if (!inherits(tmp, "try-error")) means[i] <- tmp$est.mean } if (method[1] == "blue") { tmp <- metaBLUE::BLUE_s(c(q1[i], median[i], q3[i]), n=n[i], "S2") means[i] <- tmp$muhat } # sd estimation if (is.element(method[2], c("luo/wan/shi", "wan2014"))) { # Wan et al. (2014), equation (16) eta <- 2 * qnorm((0.75 * n[i] - 0.125) / (n[i] + 0.25)) z2 <- ifelse(dist[i] == "norm", 1, 1 + 1.58 / n[i]) #z2 <- 1 sds[i] <- (q3[i] - q1[i]) / eta * (1/sqrt(z2)) } if (method[2] == "qe" && !inherits(tmp, "try-error")) sds[i] <- tmp$est.sd if (method[2] == "bc" && !inherits(tmp, "try-error")) sds[i] <- tmp$est.sd if (method[2] == "mln" && !inherits(tmp, "try-error")) sds[i] <- tmp$est.sd if (method[2] == "blue") sds[i] <- tmp$sigmahat if (dist[i] == "lnorm" && transf) { s42 <- ((q3[i] - q1[i]) / eta)^4 / (1 + 19.2 / n[i]^1.2) phi2 <- 1 + 0.57 * sds[i]^2 / n[i] + 0.75 * s42 / n[i] btmean <- exp(means[i] + sds[i]^2 / 2) * (1 / phi2) phi21 <- 1 + 2.28 * sds[i]^2 / n[i] + 12 * s42 / n[i] phi22 <- 1 + 2.28 * sds[i]^2 / n[i] + 3 * s42 / n[i] btsd <- sqrt(exp(2*means[i] + 2*sds[i]^2) * (1 / phi21) - exp(2*means[i] + sds[i]^2) * (1 / phi22)) means[i] <- btmean sds[i] <- btsd } } if (case3[i]) { ### case 3: min, q1, median, q3, and max are given # test for skewness tval[i] <- max(2.65 * log(0.6 * n[i]) / sqrt(n[i]) * abs((min[i] + max[i] - 2*median[i]) / (max[i] - min[i])), abs((q1[i] + q3[i] - 2*median[i]) / (q3[i] - q1[i]))) #crit[i] <- 2.97 / sqrt(n[i]) - 39.1 / n[i]^3 # Shi et al. (2020b) crit[i] <- 3 / sqrt(n[i]) - 40 / n[i]^3 # Shi et al. (2023) sig[i] <- isTRUE(tval[i] >= crit[i]) if (test && sig[i]) next # mean estimation if (is.element(method[1], c("luo/wan/shi", "luo2016"))) { # Luo et al. (2016), equation (15) weight1 <- 2.2 / (2.2 + n[i]^0.75) weight2 <- 0.7 - 0.72 / n[i]^0.55 means[i] <- weight1 * (min[i] + max[i]) / 2 + weight2 * (q1[i] + q3[i]) / 2 + (1 - weight1 - weight2) * median[i] } if (is.element(method[1], c("wan2014", "bland2015"))) means[i] <- (min[i] + 2*q1[i] + 2*median[i] + 2*q3[i] + max[i]) / 8 if (method[1] == "qe") { if (verbose) { tmp <- try(estmeansd::qe.mean.sd(min.val=min[i], q1.val=q1[i], med.val=median[i], q3.val=q3[i], max.val=max[i], n=n[i])) } else { tmp <- try(suppressWarnings(suppressMessages(estmeansd::qe.mean.sd(min.val=min[i], q1.val=q1[i], med.val=median[i], q3.val=q3[i], max.val=max[i], n=n[i]))), silent=TRUE) } if (inherits(tmp, "try-error")) { dists[i] <- NA_character_ } else { means[i] <- tmp$est.mean dists[i] <- tmp$selected.dist } } if (method[1] == "bc") { if (verbose) { tmp <- try(estmeansd::bc.mean.sd(min.val=min[i], q1.val=q1[i], med.val=median[i], q3.val=q3[i], max.val=max[i], n=n[i])) } else { tmp <- try(suppressWarnings(suppressMessages(estmeansd::bc.mean.sd(min.val=min[i], q1.val=q1[i], med.val=median[i], q3.val=q3[i], max.val=max[i], n=n[i]))), silent=TRUE) } if (!inherits(tmp, "try-error")) means[i] <- tmp$est.mean } if (method[1] == "mln") { if (verbose) { tmp <- try(estmeansd::mln.mean.sd(min.val=min[i], q1.val=q1[i], med.val=median[i], q3.val=q3[i], max.val=max[i], n=n[i])) } else { tmp <- try(suppressWarnings(suppressMessages(estmeansd::mln.mean.sd(min.val=min[i], q1.val=q1[i], med.val=median[i], q3.val=q3[i], max.val=max[i], n=n[i]))), silent=TRUE) } if (!inherits(tmp, "try-error")) means[i] <- tmp$est.mean } if (method[1] == "blue") { tmp <- metaBLUE::BLUE_s(c(min[i], q1[i], median[i], q3[i], max[i]), n=n[i], "S3") means[i] <- tmp$muhat } # sd estimation if (is.element(method[2], c("luo/wan/shi", "shi2020", "wan2014"))) { xi <- 2 * qnorm((n[i] - 0.375) / (n[i] + 0.25)) eta <- 2 * qnorm((0.75*n[i] - 0.125) / (n[i] + 0.25)) } if (is.element(method[2], c("luo/wan/shi", "shi2020"))) { # Shi et al. (2020), equation (10) weight <- 1 / (1 + 0.07 * n[i]^0.6) z3 <- ifelse(dist[i] == "norm", 1, 1 + 0.28 / log(n[i])^2) #z3 <- 1 sds[i] <- (weight * (max[i] - min[i]) / xi + (1 - weight) * (q3[i] - q1[i]) / eta) * (1/sqrt(z3)) } if (method[2] == "wan2014") sds[i] <- 1/2 * ((max[i] - min[i]) / xi + (q3[i] - q1[i]) / eta) if (method[2] == "bland2015") sds[i] <- sqrt((min[i]^2 + 2*q1[i]^2 + 2*median[i]^2 + 2*q3[i]^2 + max[i]^2) / 16 + (min[i]*q1[i] + q1[i]*median[i] + median[i]*q3[i] + q3[i]*max[i]) / 8 - (min[i] + 2*q1[i] + 2*median[i] + 2*q3[i] + max[i])^2 / 64) if (method[2] == "qe" && !inherits(tmp, "try-error")) sds[i] <- tmp$est.sd if (method[2] == "bc" && !inherits(tmp, "try-error")) sds[i] <- tmp$est.sd if (method[2] == "mln" && !inherits(tmp, "try-error")) sds[i] <- tmp$est.sd if (method[2] == "blue") sds[i] <- tmp$sigmahat if (dist[i] == "lnorm" && transf) { s43 <- (weight * (max[i] - min[i]) / xi + (1 - weight) * (q3[i] - q1[i]) / eta)^4 / (1 + 3.93 / n[i]) phi3 <- 1 + 0.405 * sds[i]^2 / n[i] + 0.315 * s43 / n[i] btmean <- exp(means[i] + sds[i]^2 / 2) * (1 / phi3) phi31 <- 1 + 1.62 * sds[i]^2 / n[i] + 5.04 * s43 / n[i] phi32 <- 1 + 1.62 * sds[i]^2 / n[i] + 1.26 * s43 / n[i] btsd <- sqrt(exp(2*means[i] + 2*sds[i]^2) * (1 / phi31) - exp(2*means[i] + sds[i]^2) * (1 / phi32)) means[i] <- btmean sds[i] <- btsd } } ### reset test to FALSE for qe method ([a]) if (method[1] == "qe") test <- FALSE } ######################################################################### if (has.data && append) { if (is.element(var.names[1], names(data))) { if (replace=="ifna") { attr(data[[var.names[1]]], "est") <- is.na(data[[var.names[1]]]) & !is.na(means) data[[var.names[1]]] <- replmiss(data[[var.names[1]]], means) } else { attr(data[[var.names[1]]], "est") <- !is.na(means) data[[var.names[1]]][!is.na(means)] <- means[!is.na(means)] } } else { data <- cbind(data, means) names(data)[length(names(data))] <- var.names[1] } if (is.element(var.names[2], names(data))) { if (replace=="ifna") { attr(data[[var.names[2]]], "est") <- is.na(data[[var.names[2]]]) & !is.na(sds) data[[var.names[2]]] <- replmiss(data[[var.names[2]]], sds) } else { attr(data[[var.names[2]]], "est") <- !is.na(sds) data[[var.names[2]]][!is.na(sds)] <- sds[!is.na(sds)] } } else { data <- cbind(data, sds) names(data)[length(names(data))] <- var.names[2] } } else { data <- data.frame(means, sds) names(data) <- var.names } dists <- gsub("log-normal", "lnorm", dists, fixed=TRUE) attr(data[[var.names[1]]], "tval") <- tval attr(data[[var.names[1]]], "crit") <- crit attr(data[[var.names[1]]], "sig") <- sig attr(data[[var.names[1]]], "dist") <- dists return(data) } metafor/R/profile.rma.uni.selmodel.r0000644000176200001440000002536114413113707017116 0ustar liggesusersprofile.rma.uni.selmodel <- function(fitted, tau2, delta, xlim, ylim, steps=20, lltol=1e-03, progbar=TRUE, parallel="no", ncpus=1, cl, plot=TRUE, pch=19, refline=TRUE, cline=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(fitted), must="rma.uni.selmodel") if (steps < 2) stop(mstyle$stop("Argument 'steps' must be >= 2.")) x <- fitted if (x$betaspec) ### TODO: consider allowing profiling over beta values as well stop(mstyle$stop("Cannot profile when one or more beta values were fixed.")) parallel <- match.arg(parallel, c("no", "snow", "multicore")) if (parallel == "no" && ncpus > 1) parallel <- "snow" if (missing(cl)) cl <- NULL if (!is.null(cl) && inherits(cl, "SOCKcluster")) { parallel <- "snow" ncpus <- length(cl) } if (parallel == "snow" && ncpus < 2) parallel <- "no" if (parallel == "snow" || parallel == "multicore") { if (!requireNamespace("parallel", quietly=TRUE)) stop(mstyle$stop("Please install the 'parallel' package for parallel processing.")) ncpus <- as.integer(ncpus) if (ncpus < 1L) stop(mstyle$stop("Argument 'ncpus' must be >= 1.")) } if (!progbar) { pbo <- pbapply::pboptions(type="none") on.exit(pbapply::pboptions(pbo), add=TRUE) } ddd <- list(...) if (.isTRUE(ddd$time)) time.start <- proc.time() ######################################################################### ### check if user has not specified tau2 or delta argument if (missing(tau2) && missing(delta)) { mc <- match.call() ### total number of non-fixed components comps <- ifelse(!is.element(x$method, c("FE","EE","CE")) && !x$tau2.fix, 1, 0) + sum(!x$delta.fix) if (comps == 0) stop(mstyle$stop("No components in the model for which a profile likelihood can be constructed.")) if (plot) { if (dev.cur() == 1) { par(mfrow=n2mfrow(comps)) #on.exit(par(mfrow=c(1,1)), add=TRUE) } } sav <- list() j <- 0 if (!is.element(x$method, c("FE","EE","CE")) && !x$tau2.fix) { j <- j + 1 mc.vc <- mc mc.vc$tau2 <- 1 mc.vc$time <- FALSE #mc.vc$fitted <- quote(x) if (progbar) cat(mstyle$verbose(paste("Profiling tau2\n"))) sav[[j]] <- eval(mc.vc, envir=parent.frame()) } if (any(!x$delta.fix)) { for (pos in seq_len(x$deltas)[!x$delta.fix]) { j <- j + 1 mc.vc <- mc mc.vc$delta <- pos mc.vc$time <- FALSE #mc.vc$fitted <- quote(x) if (progbar) cat(mstyle$verbose(paste("Profiling delta =", pos, "\n"))) sav[[j]] <- eval(mc.vc, envir=parent.frame()) } } ### if there is just one component, turn the list of lists into a simple list if (comps == 1) sav <- sav[[1]] sav$comps <- comps if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(sav) <- "profile.rma" return(invisible(sav)) } ### check if user has specified more than one of these arguments if (sum(!missing(tau2), !missing(delta)) > 1L) stop(mstyle$stop("Must specify only one of the 'tau2' or 'delta' arguments.")) ### check if model actually contains (at least one) such a component and that it was actually estimated if (!missing(tau2) && (is.element(x$method, c("FE","EE","CE")) || x$tau2.fix)) stop(mstyle$stop("Model does not contain an (estimated) 'tau2' component.")) if (!missing(delta) && all(x$delta.fix)) stop(mstyle$stop("Model does not contain any estimated 'delta' components.")) ### check if user specified more than one tau2 or delta component if (!missing(tau2) && (length(tau2) > 1L)) stop(mstyle$stop("Can only specify one 'tau2' component.")) if (!missing(delta) && (length(delta) > 1L)) stop(mstyle$stop("Can only specify one 'delta' component.")) ### check if user specified a logical if (!missing(tau2) && is.logical(tau2) && isTRUE(tau2)) tau2 <- 1 if (!missing(delta) && is.logical(delta)) stop(mstyle$stop("Must specify a number for the 'delta' component.")) ### check if user specified a component that does not exist if (!missing(tau2) && (tau2 > 1 || tau2 <= 0)) stop(mstyle$stop("No such 'tau2' component in the model.")) if (!missing(delta) && (delta > x$deltas || delta <= 0)) stop(mstyle$stop("No such 'delta' component in the model.")) ### check if user specified a component that was fixed if (!missing(tau2) && x$tau2.fix) stop(mstyle$stop("Specified 'tau2' component was fixed.")) if (!missing(delta) && x$delta.fix[delta]) stop(mstyle$stop("Specified 'delta' component was fixed.")) ### if everything is good so far, get value of the variance component and set 'comp' delta.pos <- NA_integer_ if (!missing(tau2)) { vc <- x$tau2 comp <- "tau2" tau2.pos <- 1 } if (!missing(delta)) { vc <- x$delta[delta] comp <- "delta" delta.pos <- delta } #return(list(comp=comp, vc=vc)) if (missing(xlim)) { ### if the user has not specified xlim, set it automatically if (comp == "tau2") { if (is.na(x$se.tau2)) { vc.lb <- max(0, vc/4) vc.ub <- min(max(.1, vc*4), x$tau2.max) } else { vc.lb <- max(0, vc - qnorm(.995) * x$se.tau2) vc.ub <- min(max(.1, vc + qnorm(.995) * x$se.tau2), x$tau2.max) } } if (comp == "delta") { if (is.na(x$se.delta[delta])) { vc.lb <- max(0, vc/4, x$delta.min[delta]) vc.ub <- min(max(.1, vc*4), x$delta.max[delta]) } else { vc.lb <- max(0, vc - qnorm(.995) * x$se.delta[delta], x$delta.min[delta]) vc.ub <- min(max(.1, vc + qnorm(.995) * x$se.delta[delta]), x$delta.max[delta]) } } ### if that fails, throw an error if (is.na(vc.lb) || is.na(vc.ub)) stop(mstyle$stop("Cannot set 'xlim' automatically. Please set this argument manually.")) xlim <- c(vc.lb, vc.ub) } else { if (length(xlim) != 2L) stop(mstyle$stop("Argument 'xlim' should be a vector of length 2.")) xlim <- sort(xlim) if (comp == "tau2") { if (xlim[1] < 0) stop(mstyle$stop("Lower bound for profiling must be >= 0.")) } if (comp == "delta") { if (xlim[1] < x$delta.min[delta]) stop(mstyle$stop(paste0("Lower bound for profiling must be >= ", x$delta.min[delta], "."))) if (xlim[2] > x$delta.max[delta]) stop(mstyle$stop(paste0("Upper bound for profiling must be <= ", x$delta.max[delta], "."))) } } vcs <- seq(xlim[1], xlim[2], length.out=steps) #return(vcs) if (length(vcs) <= 1L) stop(mstyle$stop("Cannot set 'xlim' automatically. Please set this argument manually.")) if (parallel == "no") res <- pbapply::pblapply(vcs, .profile.rma.uni.selmodel, obj=x, comp=comp, delta.pos=delta.pos, parallel=parallel, profile=TRUE) if (parallel == "multicore") res <- pbapply::pblapply(vcs, .profile.rma.uni.selmodel, obj=x, comp=comp, delta.pos=delta.pos, parallel=parallel, profile=TRUE, cl=ncpus) #res <- parallel::mclapply(vcs, .profile.rma.uni.selmodel, obj=x, comp=comp, delta.pos=delta.pos, parallel=parallel, profile=TRUE, mc.cores=ncpus) if (parallel == "snow") { if (is.null(cl)) { cl <- parallel::makePSOCKcluster(ncpus) on.exit(parallel::stopCluster(cl), add=TRUE) } if (.isTRUE(ddd$LB)) { res <- parallel::parLapplyLB(cl, vcs, .profile.rma.uni.selmodel, obj=x, comp=comp, delta.pos=delta.pos, parallel=parallel, profile=TRUE) #res <- parallel::clusterApplyLB(cl, vcs, .profile.rma.uni.selmodel, obj=x, comp=comp, delta.pos=delta.pos, parallel=parallel, profile=TRUE) } else { res <- pbapply::pblapply(vcs, .profile.rma.uni.selmodel, obj=x, comp=comp, delta.pos=delta.pos, parallel=parallel, profile=TRUE, cl=cl) #res <- parallel::parLapply(cl, vcs, .profile.rma.uni.selmodel, obj=x, comp=comp, delta.pos=delta.pos, parallel=parallel, profile=TRUE) #res <- parallel::clusterApply(cl, vcs, .profile.rma.uni.selmodel, obj=x, comp=comp, delta.pos=delta.pos, parallel=parallel, profile=TRUE) } } lls <- sapply(res, function(x) x$ll) beta <- do.call(rbind, lapply(res, function(x) t(x$beta))) ci.lb <- do.call(rbind, lapply(res, function(x) t(x$ci.lb))) ci.ub <- do.call(rbind, lapply(res, function(x) t(x$ci.ub))) ######################################################################### if (any(lls >= logLik(x) + lltol, na.rm=TRUE)) warning(mstyle$warning("At least one profiled log-likelihood value is larger than the log-likelihood of the fitted model."), call.=FALSE) if (all(is.na(lls))) warning(mstyle$warning("All model fits failed. Cannot draw profile likelihood plot."), call.=FALSE) beta <- data.frame(beta) ci.lb <- data.frame(ci.lb) ci.ub <- data.frame(ci.ub) names(beta) <- rownames(x$beta) names(ci.lb) <- rownames(x$beta) names(ci.ub) <- rownames(x$beta) if (missing(ylim)) { if (any(is.finite(lls))) { if (xlim[1] <= vc && xlim[2] >= vc) { ylim <- range(c(logLik(x),lls[is.finite(lls)]), na.rm=TRUE) } else { ylim <- range(lls[is.finite(lls)]) } } else { ylim <- rep(logLik(x), 2L) } ylim <- ylim + c(-0.1, 0.1) } else { if (length(ylim) != 2L) stop(mstyle$stop("Argument 'ylim' should be a vector of length 2.")) ylim <- sort(ylim) } if (comp == "tau2") { xlab <- expression(paste(tau^2, " Value")) title <- expression(paste("Profile Plot for ", tau^2)) } if (comp == "delta") { if (x$deltas == 1L) { xlab <- expression(paste(delta, " Value")) title <- expression(paste("Profile Plot for ", delta)) } else { xlab <- bquote(delta[.(delta)] ~ "Value") title <- bquote("Profile Plot for" ~ delta[.(delta)]) } } sav <- list(vc=vcs, ll=lls, beta=beta, ci.lb=ci.lb, ci.ub=ci.ub, comps=1, ylim=ylim, method=x$method, vc=vc, maxll=logLik(x), xlab=xlab, title=title) names(sav)[1] <- switch(comp, tau2="tau2", delta="delta") class(sav) <- "profile.rma" ######################################################################### if (plot) plot(sav, pch=pch, refline=refline, cline=cline, ...) ######################################################################### if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } invisible(sav) } metafor/R/print.summary.matreg.r0000644000176200001440000000276514434145307016420 0ustar liggesusersprint.summary.matreg <- function(x, digits=x$digits, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="summary.matreg") digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) ### strip summary.matreg class from object (otherwise get recursion) class(x) <- class(x)[-1] ### print with showfit=TRUE print(x, digits=digits, signif.stars=signif.stars, signif.legend=signif.legend, ...) .space(FALSE) if (x$test == "t") { cat(mstyle$text("Residual standard error: ")) cat(mstyle$result(fmtx(sqrt(x$mse), digits[["se"]]))) cat(mstyle$text(paste0(" on ", x$Fdf[2], " degrees of freedom\n"))) cat(mstyle$text("Multiple R-squared: ")) cat(mstyle$result(fmtx(x$R2, digits[["het"]]))) cat(mstyle$text(", Adjusted R-squared: ")) cat(mstyle$result(fmtx(x$R2adj, digits[["het"]]))) cat("\n") cat(mstyle$text("F-statistic: ")) cat(mstyle$result(fmtx(x$F[["value"]], digits[["test"]]))) cat(mstyle$text(paste0(" on ", x$Fdf[1], " and ", x$Fdf[2], " DF, p-value: "))) cat(mstyle$result(fmtp(x$Fp, digits[["pval"]], equal=FALSE, sep=FALSE))) } else { cat(mstyle$result("R^2: ")) cat(mstyle$result(fmtx(x$R2, digits[["het"]]))) cat(mstyle$result(", ")) cat(mstyle$result(fmtt(x$QM, "QM", df=x$QMdf[1], pval=x$QMp, digits=digits))) } cat("\n") .space() invisible() } metafor/R/misc.func.hidden.funnel.r0000644000176200001440000001103014476605052016704 0ustar liggesusers############################################################################ .funnel.legend <- function(legend, level, shade, back, yaxis, trimfill, pch, col, bg, pch.fill, pch.vec, col.vec, bg.vec, colci) { mstyle <- .get.mstyle("crayon" %in% .packages()) lopts <- list(x = "topright", y = NULL, inset = 0.01, bty = "o", bg = .coladj(par("bg","fg"), dark=0.00, light=0.00), # avoids a transparent background studies = TRUE, show = "pvals", cex = c(1,2,1), x.intersp = 1, y.intersp = 1) if (is.list(legend)) { ### replace defaults with any user-defined values lopts.pos <- pmatch(names(legend), names(lopts)) lopts[c(na.omit(lopts.pos))] <- legend[!is.na(lopts.pos)] legend <- TRUE if (length(lopts$cex) == 1L) lopts$cex <- c(lopts$cex, 2*lopts$cex, lopts$cex) if (length(lopts$cex) == 2L) lopts$cex <- c(lopts$cex[1], lopts$cex[2], lopts$cex[1]) } else { if (is.character(legend)) { lopts$x <- legend legend <- TRUE } else { if (!is.logical(legend)) stop(mstyle$stop("Argument 'legend' must either be logical, a string, or a list."), call.=FALSE) } } if (!is.na(lopts$show) && !is.element(lopts$show, c("pvals","cis"))) stop(mstyle$stop("Valid options for 'show' are 'pvals, 'cis', or NA."), call.=FALSE) ### can only add p-values / CI regions if 'yaxis' is 'sei', 'vi', 'seinv', or 'vinv' if (legend && !is.element(yaxis, c("sei", "vi", "seinv", "vinv"))) lopts$show <- NA ### only add 'Studies' to legend if pch, col, and bg are not vectors if (pch.vec || col.vec || bg.vec) lopts$studies <- FALSE ### if neither studies nor p-values / CI regions are shown, then omit the legend if (!lopts$studies && is.na(lopts$show)) legend <- FALSE if (legend) { ltxt <- NULL pch.l <- NULL col.l <- NULL pt.cex <- NULL pt.bg <- NULL if (isTRUE(lopts$show == "pvals")) { level <- c(level, 0) lvals <- length(level) scipen <- options(scipen=100) lchars <- max(nchar(level))-2L options(scipen=scipen$scipen) ltxt <- sapply(seq_len(lvals), function(i) { if (i == 1) return(as.expression(bquote(paste(.(pval1) < p, phantom() <= .(pval2)), list(pval1=fmtx(level[i], lchars), pval2=fmtx(1, lchars))))) if (i > 1 && i < lvals) return(as.expression(bquote(paste(.(pval1) < p, phantom() <= .(pval2)), list(pval1=fmtx(level[i], lchars), pval2=fmtx(level[i-1], lchars))))) if (i == lvals) return(as.expression(bquote(paste(.(pval1) < p, phantom() <= .(pval2)), list(pval1=fmtx(0, lchars), pval2=fmtx(level[i-1], lchars))))) }) pch.l <- rep(22, lvals) col.l <- rep(colci, lvals) pt.cex <- rep(lopts$cex[2], lvals) pt.bg <- c(shade, back) } if (isTRUE(lopts$show == "cis")) { level <- 100-100*level lvals <- length(level) scipen <- options(scipen=100) lchars <- max(nchar(level))-2L options(scipen=scipen$scipen) ltxt <- sapply(seq_len(lvals), function(i) as.expression(bquote(paste(.(ci)*"% CI Region"), list(ci=fmtx(level[i], lchars))))) pch.l <- rep(22, lvals) col.l <- rep(colci, lvals) pt.cex <- rep(lopts$cex[2], lvals) pt.bg <- c(shade) } if (isTRUE(lopts$studies)) { if (trimfill) { ltxt <- c(ltxt, expression(plain(Observed~Studies))) } else { ltxt <- c(ltxt, expression(plain(Studies))) } pch.l <- c(pch.l, pch[1]) col.l <- c(col.l, col[1]) pt.cex <- c(pt.cex, lopts$cex[3]) pt.bg <- c(pt.bg, bg[1]) if (trimfill) { ltxt <- c(ltxt, expression(plain(Imputed~Studies))) pch.l <- c(pch.l, pch.fill[1]) col.l <- c(col.l, col[2]) pt.cex <- c(pt.cex, lopts$cex[3]) pt.bg <- c(pt.bg, bg[2]) } } legend(x=lopts$x, y=lopts$y, inset=lopts$inset, bty=lopts$bty, bg=lopts$bg, cex=lopts$cex[1], x.intersp=lopts$x.intersp, y.intersp=lopts$y.intersp, pch=pch.l, col=col.l, pt.cex=pt.cex, pt.bg=pt.bg, legend=ltxt) } } ############################################################################ metafor/R/cumul.rma.uni.r0000644000176200001440000001343414440116123014771 0ustar liggesuserscumul.rma.uni <- function(x, order, digits, transf, targs, progbar=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.uni", notav=c("robust.rma", "rma.ls", "rma.gen", "rma.uni.selmodel")) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (!x$int.only) stop(mstyle$stop("Method only applicable to models without moderators.")) if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL ddd <- list(...) .chkdots(ddd, c("time", "decreasing")) if (.isTRUE(ddd$time)) time.start <- proc.time() if (is.null(ddd$decreasing)) { decreasing <- FALSE } else { decreasing <- ddd$decreasing } ######################################################################### if (grepl("^order\\(", deparse1(substitute(order)))) warning(mstyle$warning("Use of order() in 'order' argument is probably erroneous."), call.=FALSE) if (missing(order)) { order <- seq_len(x$k.all) } else { mf <- match.call() order <- .getx("order", mf=mf, data=x$data) } if (length(order) != x$k.all) stop(mstyle$stop(paste0("Length of the 'order' argument (", length(order), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) ### note: order variable is assumed to be of the same length as the size of the ### original dataset passed to the model fitting function and so we apply ### the same subsetting (if necessary) as was done during model fitting order <- .getsubset(order, x$subset) order <- order(order, decreasing=decreasing) yi.f <- x$yi.f[order] vi.f <- x$vi.f[order] weights.f <- x$weights.f[order] not.na <- x$not.na[order] slab <- x$slab[order] ids <- x$ids[order] if (inherits(x$data, "environment")) { data <- NULL } else { data <- x$data[order,] } beta <- rep(NA_real_, x$k.f) se <- rep(NA_real_, x$k.f) zval <- rep(NA_real_, x$k.f) pval <- rep(NA_real_, x$k.f) ci.lb <- rep(NA_real_, x$k.f) ci.ub <- rep(NA_real_, x$k.f) QE <- rep(NA_real_, x$k.f) QEp <- rep(NA_real_, x$k.f) tau2 <- rep(NA_real_, x$k.f) I2 <- rep(NA_real_, x$k.f) H2 <- rep(NA_real_, x$k.f) ### elements that need to be returned outlist <- "beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, QE=QE, QEp=QEp, tau2=tau2, I2=I2, H2=H2" ### note: skipping NA cases ### also: it is possible that model fitting fails, so that generates more NAs (these NAs will always be shown in output) if (progbar) pbar <- pbapply::startpb(min=0, max=x$k.f) for (i in seq_len(x$k.f)) { if (progbar) pbapply::setpb(pbar, i) if (!not.na[i]) next args <- list(yi=yi.f, vi=vi.f, weights=weights.f, intercept=TRUE, method=x$method, weighted=x$weighted, test=x$test, level=x$level, tau2=ifelse(x$tau2.fix, x$tau2, NA), control=x$control, subset=seq_len(i), outlist=outlist) res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=TRUE) if (inherits(res, "try-error")) next beta[i] <- res$beta se[i] <- res$se zval[i] <- res$zval pval[i] <- res$pval ci.lb[i] <- res$ci.lb ci.ub[i] <- res$ci.ub QE[i] <- res$QE QEp[i] <- res$QEp tau2[i] <- res$tau2 I2[i] <- res$I2 H2[i] <- res$H2 } if (progbar) pbapply::closepb(pbar) ######################################################################### ### if requested, apply transformation function if (is.function(transf)) { if (is.null(targs)) { beta <- sapply(beta, transf) se <- rep(NA_real_, x$k.f) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) } else { beta <- sapply(beta, transf, targs) se <- rep(NA_real_, x$k.f) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) } transf <- TRUE } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] ######################################################################### if (na.act == "na.omit") { out <- list(estimate=beta[not.na], se=se[not.na], zval=zval[not.na], pvals=pval[not.na], ci.lb=ci.lb[not.na], ci.ub=ci.ub[not.na], Q=QE[not.na], Qp=QEp[not.na], tau2=tau2[not.na], I2=I2[not.na], H2=H2[not.na]) out$slab <- slab[not.na] out$ids <- ids[not.na] out$data <- data[not.na,] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(estimate=beta, se=se, zval=zval, pvals=pval, ci.lb=ci.lb, ci.ub=ci.ub, Q=QE, Qp=QEp, tau2=tau2, I2=I2, H2=H2) out$slab <- slab out$ids <- ids out$data <- data } if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) if (is.element(x$test, c("knha","adhoc","t"))) names(out)[3] <- "tval" ### remove tau2 for FE/EE/CE models if (is.element(x$method, c("FE","EE","CE"))) out <- out[-9] out$digits <- digits out$transf <- transf out$slab.null <- x$slab.null out$level <- x$level out$measure <- x$measure out$test <- x$test attr(out$estimate, "measure") <- x$measure if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(out) <- c("list.rma", "cumul.rma") return(out) } metafor/R/qqnorm.rma.peto.r0000644000176200001440000000472114465412611015344 0ustar liggesusersqqnorm.rma.peto <- function(y, type="rstandard", pch=21, col, bg, label=FALSE, offset=0.3, pos=13, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(y), must="rma.peto") x <- y type <- match.arg(type, c("rstandard", "rstudent")) if (x$k == 1) stop(mstyle$stop("Stopped because k = 1.")) if (length(label) != 1L) stop(mstyle$stop("Argument 'label' should be of length 1.")) .start.plot() if (missing(col)) col <- par("fg") if (missing(bg)) bg <- .coladj(par("bg","fg"), dark=0.35, light=-0.35) ######################################################################### if (type == "rstandard") { res <- rstandard(x) not.na <- !is.na(res$z) zi <- res$z[not.na] slab <- res$slab[not.na] ord <- order(zi) slab <- slab[ord] } else { res <- rstudent(x) not.na <- !is.na(res$z) zi <- res$z[not.na] slab <- res$slab[not.na] ord <- order(zi) slab <- slab[ord] } sav <- qqnorm(zi, pch=pch, col=col, bg=bg, bty="l", ...) abline(a=0, b=1, lty="solid", ...) #qqline(zi, ...) #abline(h=0, lty="dotted", ...) #abline(v=0, lty="dotted", ...) points(sav$x, sav$y, pch=pch, col=col, bg=bg, ...) ######################################################################### ### labeling of points if ((is.character(label) && label=="none") || .isFALSE(label)) return(invisible(sav)) if ((is.character(label) && label=="all") || .isTRUE(label)) label <- x$k if (is.numeric(label)) { label <- round(label) if (label < 1 | label > x$k) stop(mstyle$stop("Out of range value for 'label' argument.")) pos.x <- sav$x[ord] pos.y <- sav$y[ord] dev <- abs(pos.x - pos.y) for (i in seq_len(x$k)) { if (sum(dev > dev[i]) < label) { if (pos <= 4) text(pos.x[i], pos.y[i], slab[i], pos=pos, offset=offset, ...) if (pos == 13) text(pos.x[i], pos.y[i], slab[i], pos=ifelse(pos.x[i]-pos.y[i] >= 0, 1, 3), offset=offset, ...) if (pos == 24) text(pos.x[i], pos.y[i], slab[i], pos=ifelse(pos.x[i]-pos.y[i] <= 0, 2, 4), offset=offset, ...) #text(pos.x[i], pos.y[i], slab[i], pos=ifelse(pos.x[i] >= 0, 2, 4), offset=offset, ...) } } } ######################################################################### invisible(sav) } metafor/R/conv.delta.r0000644000176200001440000001642714467675162014364 0ustar liggesusersconv.delta <- function(yi, vi, ni, data, include, transf, var.names, append=TRUE, replace="ifna", ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) if (missing(yi) || missing(vi)) stop(mstyle$stop("Must specify 'yi' and 'vi' arguments.")) if (missing(transf)) stop(mstyle$stop("Must specify 'transf' argument.")) if (is.logical(replace)) { if (isTRUE(replace)) { replace <- "all" } else { replace <- "ifna" } } replace <- match.arg(replace, c("ifna","all")) ######################################################################### if (missing(data)) data <- NULL has.data <- !is.null(data) if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } x <- data ### checks on var.names argument if (missing(var.names)) { if (inherits(x, "escalc")) { if (!is.null(attr(x, "yi.names"))) { # if yi.names attributes is available yi.name <- attr(x, "yi.names")[1] # take the first entry to be the yi variable } else { # if not, see if 'yi' is in the object and assume that is the yi variable if (!is.element("yi", names(x))) stop(mstyle$stop("Cannot determine name of the 'yi' variable.")) yi.name <- "yi" } if (!is.null(attr(x, "vi.names"))) { # if vi.names attributes is available vi.name <- attr(x, "vi.names")[1] # take the first entry to be the vi variable } else { # if not, see if 'vi' is in the object and assume that is the vi variable if (!is.element("vi", names(x))) stop(mstyle$stop("Cannot determine name of the 'vi' variable.")) vi.name <- "vi" } } else { yi.name <- "yi" vi.name <- "vi" } } else { if (length(var.names) != 2L) stop(mstyle$stop("Argument 'var.names' must be of length 2.")) if (any(var.names != make.names(var.names, unique=TRUE))) { var.names <- make.names(var.names, unique=TRUE) warning(mstyle$warning(paste0("Argument 'var.names' does not contain syntactically valid variable names.\nVariable names adjusted to: var.names = c('", var.names[1], "','", var.names[2], "').")), call.=FALSE) } yi.name <- var.names[1] vi.name <- var.names[2] } ######################################################################### mf <- match.call() yi <- .getx("yi", mf=mf, data=x, checknumeric=TRUE) vi <- .getx("vi", mf=mf, data=x, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=x, checknumeric=TRUE) include <- .getx("include", mf=mf, data=x) ### check length of yi and vi (and ni) if (length(yi) != length(vi)) stop(mstyle$stop("Length of 'yi' and 'vi' is not the same.")) if (!.equal.length(yi, vi, ni)) # a bit redundant with the above, but keep stop(mstyle$stop("Supplied data vectors are not all of the same length.")) ### check 'vi' argument for potential misuse .chkviarg(mf$vi) k <- length(yi) ### if ni/include is NULL, set to TRUE vector if (is.null(ni)) ni <- rep(NA_real_, k) if (is.null(include)) include <- rep(TRUE, k) ### turn numeric include vector into logical vector include <- .chksubset(include, k, stoponk0=FALSE) ### set inputs to NA for rows not to be included yi[!include] <- NA_real_ vi[!include] <- NA_real_ ni[!include] <- NA_real_ ### get names of arguments to transf (except the first and ... in case that is there) transfargs <- names(formals(args(transf))) transfargs <- transfargs[-1] transfargs <- transfargs[transfargs != "..."] ### get ... args args <- names(sapply(mf[-1], deparse)) rmargs <- c("yi", "vi", "data", "include", "transf", "var.names", "append", "replace") dotargs <- args[!args %in% rmargs] ### keep arguments in dotargs that are actual arguments of 'transf' dotargs <- dotargs[dotargs %in% transfargs] dotarglist <- list() for (i in seq_along(dotargs)) { dotarglist[[i]] <- .getx(dotargs[i], mf=mf, data=x, checknumeric=TRUE) if (length(dotarglist[[i]]) == 1L) dotarglist[[i]] <- rep(dotarglist[[i]], k) names(dotarglist)[i] <- dotargs[i] } #print(dotarglist) argmatch <- pmatch(names(dotarglist), table=c("func","method","side"), duplicates.ok=TRUE) if (!all(is.na(argmatch))) stop(mstyle$stop("One or more arguments in ... (partially) match an argument from numDeriv::grad().")) ######################################################################### #ddd <- list(c(yi), ...) #yi.t <- unlist(.mapply(FUN=transf, dots=ddd, MoreArgs=NULL)) #deriv <- unlist(.mapply(FUN=.compgrad, dots=ddd, MoreArgs=list(func=transf))) #vi.t <- vi * deriv^2 #dat <- data.frame(yi=yi.t, vi=vi.t) #return(dat) yi.t <- rep(NA_real_, k) vi.t <- rep(NA_real_, k) deriv <- rep(NA_real_, k) for (i in 1:k) { args <- c(yi[[i]], as.list(sapply(dotarglist, `[[`, i))) # use [[]] in case yi is a named vector #print(args) tmp <- try(suppressWarnings(do.call(transf, args)), silent=TRUE) #tmp <- try(do.call(transf, args), silent=FALSE) if (inherits(tmp, "try-error")) { yi.t[i] <- NA_real_ } else { yi.t[i] <- tmp } args <- c(args, func=transf) #print(args) tmp <- try(suppressWarnings(do.call(numDeriv::grad, args)), silent=TRUE) #tmp <- try(do.call(numDeriv::grad, args)) if (inherits(tmp, "try-error")) { vi.t[i] <- NA_real_ } else { vi.t[i] <- vi[i] * tmp^2 } #tmp <- try(suppressWarnings(numDeriv::grad(func=transf, yi[i])), silent=TRUE) #if (inherits(tmp, "try-error")) { # deriv[i] <- NA_real_ #} else { # deriv[i] <- tmp #} #vi.t[i] <- vi[i] * deriv[i]^2 } ######################################################################### ### set up data frame if 'data' was not specified if (!has.data) { x <- data.frame(rep(NA_real_, k), rep(NA_real_, k)) names(x) <- c(yi.name, vi.name) } ### replace missing x$yi values if (replace=="ifna") { x[[yi.name]] <- replmiss(x[[yi.name]], yi.t) } else { x[[yi.name]][!is.na(yi.t)] <- yi.t[!is.na(yi.t)] } ### replace missing ni values with ni attributes values from the source and target variables ### and then add ni attribute to target variable (if at least one value is not missing) ### note: values specified via 'ni' argument in conv.delta() overrule existing attribute values ni <- replmiss(ni, attributes(yi)$ni) ni <- replmiss(ni, attributes(x[[yi.name]])$ni) if (any(!is.na(ni))) attr(x[[yi.name]], "ni") <- ni ### replace missing x$vi values if (replace=="ifna") { x[[vi.name]] <- replmiss(x[[vi.name]], vi.t) } else { x[[vi.name]][!is.na(vi.t)] <- vi.t[!is.na(vi.t)] } #escall <- paste0("escalc(data=x, yi=", yi.name, ", vi=", vi.name, ", var.names=c('", yi.name, "','", vi.name, "'))") #x <- eval(str2lang(escall)) x <- escalc(data=x, yi=x[[yi.name]], vi=x[[vi.name]], var.names=c(yi.name,vi.name)) if (!append) x <- x[,c(yi.name, vi.name)] return(x) } metafor/R/rstandard.rma.uni.r0000644000176200001440000000602014245746507015641 0ustar liggesusersrstandard.rma.uni <- function(model, digits, type="marginal", ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(model), must="rma.uni", notav=c("robust.rma", "rma.gen", "rma.uni.selmodel")) na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) type <- match.arg(type, c("marginal", "conditional")) x <- model if (type == "conditional" && (!is.null(x$weights) || !x$weighted)) stop(mstyle$stop("Extraction of conditional residuals not available for models with non-standard weights.")) #if (type == "conditional" & inherits(x, "robust.rma")) # stop(mstyle$stop("Extraction of conditional residuals not available for objects of class \"robust.rma\".")) if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } ######################################################################### options(na.action="na.omit") H <- hatvalues(x, type="matrix") options(na.action = na.act) ######################################################################### ImH <- diag(x$k) - H #ei <- ImH %*% cbind(x$yi) if (type == "marginal") { ei <- c(x$yi - x$X %*% x$beta) ei[abs(ei) < 100 * .Machine$double.eps] <- 0 #ei[abs(ei) < 100 * .Machine$double.eps * median(abs(ei), na.rm=TRUE)] <- 0 ### see lm.influence ### don't allow this; the SEs of the residuals cannot be estimated consistently for "robust.rma" objects #if (inherits(x, "robust.rma")) { # ve <- ImH %*% tcrossprod(x$meat,ImH) #} else { #ve <- ImH %*% tcrossprod(x$M,ImH) #} ve <- ImH %*% tcrossprod(x$M,ImH) #ve <- x$M + x$X %*% x$vb %*% t(x$X) - 2*H%*%x$M sei <- sqrt(diag(ve)) } if (type == "conditional") { li <- x$tau2 / (x$tau2 + x$vi) pred <- rep(NA_real_, x$k) for (i in seq_len(x$k)) { Xi <- matrix(x$X[i,], nrow=1) pred[i] <- li[i] * x$yi[i] + (1 - li[i]) * Xi %*% x$beta } ei <- x$yi - pred sei <- sqrt(x$vi^2 * 1/(x$vi + x$tau2) * (1 - diag(H))) } resid <- rep(NA_real_, x$k.f) seresid <- rep(NA_real_, x$k.f) stresid <- rep(NA_real_, x$k.f) resid[x$not.na] <- ei seresid[x$not.na] <- sei stresid[x$not.na] <- ei / sei ######################################################################### if (na.act == "na.omit") { out <- list(resid=resid[x$not.na], se=seresid[x$not.na], z=stresid[x$not.na]) out$slab <- x$slab[x$not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(resid=resid, se=seresid, z=stresid) out$slab <- x$slab } if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) out$digits <- digits class(out) <- "list.rma" return(out) } metafor/R/summary.escalc.r0000644000176200001440000002150114467675115015240 0ustar liggesuserssummary.escalc <- function(object, out.names=c("sei","zi","pval","ci.lb","ci.ub"), var.names, H0=0, append=TRUE, replace=TRUE, level=95, olim, digits, transf, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="escalc") x <- object level <- .level(level) crit <- qnorm(level/2, lower.tail=FALSE) if (length(out.names) != 5L) stop(mstyle$stop("Argument 'out.names' must be of length 5.")) if (any(out.names != make.names(out.names, unique=TRUE))) { out.names <- make.names(out.names, unique=TRUE) warning(mstyle$warning(paste0("Argument 'out.names' does not contain syntactically valid variable names.\nVariable names adjusted to: out.names = c('", out.names[1], "','", out.names[2], "','", out.names[3], "','", out.names[4], "','", out.names[5], "').")), call.=FALSE) } if (missing(transf)) transf <- FALSE ######################################################################### ### figure out names of yi and vi variables (if possible) and extract the values (if possible) if (missing(var.names)) { # if var.names not specified, take from object if possible if (!is.null(attr(x, "yi.names"))) { # if yi.names attributes is available yi.name <- attr(x, "yi.names")[1] # take the first entry to be the yi variable } else { # if not, see if 'yi' is in the object and assume that is the yi variable if (!is.element("yi", names(x))) stop(mstyle$stop("Cannot determine name of the 'yi' variable.")) yi.name <- "yi" } if (!is.null(attr(x, "vi.names"))) { # if vi.names attributes is available vi.name <- attr(x, "vi.names")[1] # take the first entry to be the vi variable } else { # if not, see if 'vi' is in the object and assume that is the vi variable if (!is.element("vi", names(x))) stop(mstyle$stop("Cannot determine name of the 'vi' variable.")) vi.name <- "vi" } } else { if (length(var.names) != 2L) stop(mstyle$stop("Argument 'var.names' must be of length 2.")) if (any(var.names != make.names(var.names, unique=TRUE))) { var.names <- make.names(var.names, unique=TRUE) warning(mstyle$warning(paste0("Argument 'var.names' does not contain syntactically valid variable names.\nVariable names adjusted to: var.names = c('", var.names[1], "','", var.names[2], "').")), call.=FALSE) } yi.name <- var.names[1] vi.name <- var.names[2] } yi <- x[[yi.name]] vi <- x[[vi.name]] if (is.null(yi)) stop(mstyle$stop(paste0("Cannot find variable '", yi.name, "' in the data frame."))) if (is.null(vi)) stop(mstyle$stop(paste0("Cannot find variable '", vi.name, "' in the data frame."))) ######################################################################### k <- length(yi) if (length(H0) == 1L) H0 <- rep(H0, k) ### compute sei, zi, and lower/upper CI bounds; when applying a transformation, compute the transformed outcome and CI bounds sei <- sqrt(vi) zi <- c(yi - H0) / sei pval <- 2*pnorm(abs(zi), lower.tail=FALSE) if (is.function(transf)) { ci.lb <- mapply(transf, yi - crit * sei, ...) ci.ub <- mapply(transf, yi + crit * sei, ...) yi <- mapply(transf, yi, ...) attr(x, "transf") <- TRUE vi <- NULL sei <- NULL zi <- NULL pval <- NULL } else { ci.lb <- yi - crit * sei ci.ub <- yi + crit * sei attr(x, "transf") <- FALSE } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] ### apply observation/outcome limits if specified if (!missing(olim)) { if (length(olim) != 2L) stop(mstyle$stop("Argument 'olim' must be of length 2.")) olim <- sort(olim) yi[yi < olim[1]] <- olim[1] # note: zi and pval are based on unconstrained yi yi[yi > olim[2]] <- olim[2] ci.lb[ci.lb < olim[1]] <- olim[1] ci.ub[ci.ub > olim[2]] <- olim[2] } x[[yi.name]] <- yi x[[vi.name]] <- vi #return(cbind(yi, vi, sei, zi, ci.lb, ci.ub)) ### put together dataset if (append) { ### if user wants to append dat <- data.frame(x) if (replace) { ### and wants to replace all values dat[[out.names[1]]] <- sei # if variable does not exists in dat, it will be added dat[[out.names[2]]] <- zi # if variable does not exists in dat, it will be added dat[[out.names[3]]] <- pval # if variable does not exists in dat, it will be added dat[[out.names[4]]] <- ci.lb # if variable does not exists in dat, it will be added dat[[out.names[5]]] <- ci.ub # if variable does not exists in dat, it will be added } else { ### and only wants to replace any NA values if (is.element(out.names[1], names(dat))) { # if sei variable is in data frame, replace NA values with newly calculated values is.na.sei <- is.na(dat[[out.names[1]]]) dat[[out.names[1]]][is.na.sei] <- sei[is.na.sei] } else { dat[[out.names[1]]] <- sei # if sei variable does not exist in dat, just add as new variable } if (is.element(out.names[2], names(dat))) { # if zi variable is in data frame, replace NA values with newly calculated values is.na.zi <- is.na(dat[[out.names[2]]]) dat[[out.names[2]]][is.na.zi] <- zi[is.na.zi] } else { dat[[out.names[2]]] <- zi # if zi variable does not exist in dat, just add as new variable } if (is.element(out.names[3], names(dat))) { # if pval variable is in data frame, replace NA values with newly calculated values is.na.pval <- is.na(dat[[out.names[3]]]) dat[[out.names[3]]][is.na.pval] <- pval[is.na.pval] } else { dat[[out.names[3]]] <- pval # if pval variable does not exist in dat, just add as new variable } if (is.element(out.names[4], names(dat))) { # if ci.lb variable is in data frame, replace NA values with newly calculated values is.na.ci.lb <- is.na(dat[[out.names[4]]]) dat[[out.names[4]]][is.na.ci.lb] <- ci.lb[is.na.ci.lb] } else { dat[[out.names[4]]] <- ci.lb # if ci.lb variable does not exist in dat, just add as new variable } if (is.element(out.names[5], names(dat))) { # if ci.ub variable is in data frame, replace NA values with newly calculated values is.na.ci.ub <- is.na(dat[[out.names[5]]]) dat[[out.names[5]]][is.na.ci.ub] <- ci.ub[is.na.ci.ub] } else { dat[[out.names[5]]] <- ci.ub # if ci.ub variable does not exist in dat, just add as new variable } } } else { ### if user does not want to append if (is.function(transf)) { dat <- data.frame(yi, ci.lb, ci.ub) names(dat) <- c(yi.name, out.names[4:5]) } else { dat <- data.frame(yi, vi, sei, zi, pval, ci.lb, ci.ub) names(dat) <- c(yi.name, vi.name, out.names) } } ### update existing digits attribute if digits is specified if (!missing(digits)) { attr(dat, "digits") <- .get.digits(digits=digits, xdigits=attr(x, "digits"), dmiss=FALSE) } else { attr(dat, "digits") <- attr(x, "digits") } if (is.null(attr(dat, "digits"))) # in case x no longer has a 'digits' attribute attr(dat, "digits") <- 4 ### update existing var.names attribute if var.names is specified ### and make sure all other yi.names and vi.names are added back in if (!missing(var.names)) { attr(dat, "yi.names") <- union(var.names[1], attr(object, "yi.names")) } else { attr(dat, "yi.names") <- union(yi.name, attr(object, "yi.names")) } if (!missing(var.names)) { attr(dat, "vi.names") <- union(var.names[2], attr(object, "vi.names")) } else { attr(dat, "vi.names") <- union(vi.name, attr(object, "vi.names")) } ### add 'sei.names', 'zi.names', 'pval.names', 'ci.lb.names', and 'ci.ub.names' to the first position of the corresponding attributes ### note: if "xyz" is not an attribute of the object, attr(object, "xyz") returns NULL, so this works fine attr(dat, "sei.names") <- union(out.names[1], attr(object, "sei.names")) attr(dat, "zi.names") <- union(out.names[2], attr(object, "zi.names")) attr(dat, "pval.names") <- union(out.names[3], attr(object, "pval.names")) attr(dat, "ci.lb.names") <- union(out.names[4], attr(object, "ci.lb.names")) attr(dat, "ci.ub.names") <- union(out.names[5], attr(object, "ci.ub.names")) ### TODO: clean up attribute elements that are no longer actually part of the object class(dat) <- c("escalc", "data.frame") return(dat) } metafor/R/formula.rma.r0000644000176200001440000000073613770400422014523 0ustar liggesusersformula.rma <- function(x, type="mods", ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma") type <- match.arg(type, c("mods", "yi", "scale")) if (type == "scale" && x$model != "rma.ls") stop(mstyle$stop("Can only use type='scale' for location-scale models.")) if (type == "mods") return(x$formula.mods) if (type == "yi") return(x$formula.yi) if (type == "scale") return(x$formula.scale) } metafor/R/nobs.rma.r0000644000176200001440000000035013770372731014022 0ustar liggesusersnobs.rma <- function(object, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma") n.obs <- object$k.eff - ifelse(object$method == "REML", 1, 0) * object$p.eff return(n.obs) } metafor/R/llplot.r0000644000176200001440000002565014465360442013621 0ustar liggesusersllplot <- function(measure, yi, vi, sei, ai, bi, ci, di, n1i, n2i, data, subset, drop00=TRUE, xvals=1000, xlim, ylim, xlab, ylab, scale=TRUE, lty, lwd, col, level=99.99, refline=0, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) ### data setup if (missing(measure)) stop(mstyle$stop("Must specify an effect size or outcome measure via the 'measure' argument.")) .chkclass(class(measure), notap="rma", type="Function") if (!is.element(measure, c("GEN", "OR"))) stop(mstyle$stop("Currently only measure=\"GEN\" or measure=\"OR\" can be specified.")) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (measure == "OR" && !requireNamespace("BiasedUrn", quietly=TRUE)) stop(mstyle$stop("Please install the 'BiasedUrn' package to use this function.")) if (missing(xlab)) { if (measure == "GEN") xlab <- "Observed Outcome" if (measure == "OR") xlab <- "Log Odds Ratio" } if (missing(ylab)) { if (scale) { ylab <- "Scaled Likelihood" } else { ylab <- "Likelihood" } } level <- .level(level) ### get ... argument ddd <- list(...) ### set defaults or get onlyo1, addyi, and addvi arguments onlyo1 <- ifelse(is.null(ddd$onlyo1), FALSE, ddd$onlyo1) addyi <- ifelse(is.null(ddd$addyi), TRUE, ddd$addyi) addvi <- ifelse(is.null(ddd$addvi), TRUE, ddd$addvi) .start.plot() ######################################################################### ### check if data argument has been specified if (missing(data)) data <- NULL if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } ### extract values, possibly from the data frame specified via data (arguments not specified are NULL) mf <- match.call() subset <- .getx("subset", mf=mf, data=data) lty <- .getx("lty", mf=mf, data=data) lwd <- .getx("lwd", mf=mf, data=data) col <- .getx("col", mf=mf, data=data) if (measure == "GEN") { yi <- .getx("yi", mf=mf, data=data, checknumeric=TRUE) vi <- .getx("vi", mf=mf, data=data, checknumeric=TRUE) sei <- .getx("sei", mf=mf, data=data, checknumeric=TRUE) if (is.null(vi)) { if (is.null(sei)) { stop(mstyle$stop("Must specify 'vi' or 'sei' argument.")) } else { vi <- sei^2 } } if (!.all.specified(yi, vi)) stop(mstyle$stop("Cannot construct plot. Check that all of the required information is specified\n via the appropriate arguments (i.e., yi, vi).")) if (!.equal.length(yi, vi)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k <- length(yi) ### number of outcomes before subsetting ### subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) yi <- .getsubset(yi, subset) vi <- .getsubset(vi, subset) } } if (measure == "OR") { ai <- .getx("ai", mf=mf, data=data, checknumeric=TRUE) bi <- .getx("bi", mf=mf, data=data, checknumeric=TRUE) ci <- .getx("ci", mf=mf, data=data, checknumeric=TRUE) di <- .getx("di", mf=mf, data=data, checknumeric=TRUE) n1i <- .getx("n1i", mf=mf, data=data, checknumeric=TRUE) n2i <- .getx("n2i", mf=mf, data=data, checknumeric=TRUE) if (!.equal.length(ai, bi, ci, di, n1i, n2i)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) n1i.inc <- n1i != ai + bi n2i.inc <- n2i != ci + di if (any(n1i.inc, na.rm=TRUE)) stop(mstyle$stop("One or more 'n1i' values are not equal to 'ai + bi'.")) if (any(n2i.inc, na.rm=TRUE)) stop(mstyle$stop("One or more 'n2i' values are not equal to 'ci + di'.")) bi <- replmiss(bi, n1i-ai) di <- replmiss(di, n2i-ci) if (!.all.specified(ai, bi, ci, di)) stop(mstyle$stop("Cannot construct plot. Check that all of the required information is specified\n via the appropriate arguments (i.e., ai, bi, ci, di or ai, n1i, ci, n2i).")) n1i <- ai + bi n2i <- ci + di if (any(c(ai > n1i, ci > n2i), na.rm=TRUE)) stop(mstyle$stop("One or more event counts are larger than the corresponding group sizes.")) if (any(c(ai, bi, ci, di) < 0, na.rm=TRUE)) stop(mstyle$stop("One or more counts are negative.")) if (any(c(n1i < 0, n2i < 0), na.rm=TRUE)) stop(mstyle$stop("One or more group sizes are negative.")) k <- length(ai) ### number of outcomes before subsetting ### note studies that have at least one zero cell id0 <- c(ai == 0L | bi == 0L | ci == 0L | di == 0L) id0[is.na(id0)] <- FALSE ### note studies that have no events or all events id00 <- c(ai == 0L & ci == 0L) | c(bi == 0L & di == 0L) id00[is.na(id00)] <- FALSE ### if drop00=TRUE, set counts to NA for studies that have no events (or all events) in both arms if (drop00) { ai[id00] <- NA_real_ bi[id00] <- NA_real_ ci[id00] <- NA_real_ di[id00] <- NA_real_ } ### subsetting if (!is.null(subset)) { subset <- .chksubset(subset, k) ai <- .getsubset(ai, subset) bi <- .getsubset(bi, subset) ci <- .getsubset(ci, subset) di <- .getsubset(di, subset) } dat <- .do.call(escalc, measure="OR", ai=ai, bi=bi, ci=ci, di=di, drop00=drop00, onlyo1=onlyo1, addyi=addyi, addvi=addvi) yi <- dat$yi ### one or more yi/vi pairs may be NA/NA vi <- dat$vi ### one or more yi/vi pairs may be NA/NA } ######################################################################### ### study ids (1:k sequence before subsetting) ids <- seq_len(k) ### setting of lty, lwd, and col arguments (if a single value, repeat k times) ### if any of these arguments is not a single value, it must have the same length as the data before subsetting if (!is.null(lty)) { if (length(lty) == 1L) { lty <- rep(lty, k) } else { if (length(lty) != k) stop(mstyle$stop(paste0("Length of 'lty' argument (", length(lty), ") does not match length of data (", k, ")."))) } } if (!is.null(lwd)) { if (length(lwd) == 1L) { lwd <- rep(lwd, k) } else { if (length(lwd) != k) stop(mstyle$stop(paste0("Length of 'lwd' argument (", length(lwd), ") does not match length of data (", k, ")."))) } } if (!is.null(col)) { if (length(col) == 1L) { col <- rep(col, k) } else { if (length(col) != k) stop(mstyle$stop(paste0("Length of 'col' argument (", length(col), ") does not match length of data (", k, ")."))) } } ### if a subset of studies is specified if (!is.null(subset)) { ids <- .getsubset(ids, subset) lty <- .getsubset(lty, subset) lwd <- .getsubset(lwd, subset) col <- .getsubset(col, subset) id0 <- .getsubset(id0, subset) id00 <- .getsubset(id00, subset) } ### number of outcomes after subsetting k <- length(yi) ### check for NAs and act accordingly if (measure == "GEN") { has.na <- is.na(yi) | is.na(vi) } if (measure == "OR") { has.na <- is.na(ai) | is.na(bi) | is.na(ci) | is.na(di) } not.na <- !has.na if (any(has.na)) { if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { yi <- yi[not.na] vi <- vi[not.na] if (measure == "OR") { ai <- ai[not.na] bi <- bi[not.na] ci <- ci[not.na] di <- di[not.na] id0 <- id0[not.na] id00 <- id00[not.na] } k <- length(yi) ids <- ids[not.na] lty <- lty[not.na] lwd <- lwd[not.na] col <- col[not.na] warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "studies", "study"), "with NAs omitted from plotting.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in studies.")) } ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ######################################################################### ### set default line types (id0 studies = dashed line, id00 studies = dotted line, all others = solid line) if (measure == "GEN") { if (is.null(lty)) lty <- rep("solid", k) } if (measure == "OR") { if (is.null(lty)) lty <- ifelse(id0 | id00, ifelse(id00, "dotted", "dashed"), "solid") } ### set default line widths (4.0 to 0.4 according to the rank of vi) if (is.null(lwd)) lwd <- seq(from=4.0, to=0.4, length.out=k)[rank(vi)] ### set default line color (darker to lighter according to the rank of vi) if (is.null(col)) { col <- sapply(seq(from=0.8, to=0.2, length.out=k), function(x) .coladj(par("bg","fg"), dark=x, light=-x)) col <- col[rank(vi)] } ### set x-axis limits ci.lb <- yi - qnorm(level/2, lower.tail=FALSE) * sqrt(vi) ci.ub <- yi + qnorm(level/2, lower.tail=FALSE) * sqrt(vi) if (missing(xlim)) { xlim <- c(min(ci.lb, na.rm=TRUE),max(ci.ub, na.rm=TRUE)) } else { xlim <- sort(xlim) } xs <- seq(from=xlim[1], to=xlim[2], length.out=xvals) lls <- matrix(NA_real_, nrow=k, ncol=xvals) out <- matrix(TRUE, nrow=k, ncol=xvals) if (measure == "GEN") { for (i in seq_len(k)) { for (j in seq_len(xvals)) { lls[i,j] <- dnorm(yi[i], xs[j], sqrt(vi[i])) if (xs[j] >= ci.lb[i] & xs[j] <= ci.ub[i]) out[i,j] <- FALSE } } } if (measure == "OR") { for (i in seq_len(k)) { for (j in seq_len(xvals)) { lls[i,j] <- .dnchgi(xs[j], ai=ai[i], bi=bi[i], ci=ci[i], di=di[i], random=FALSE, dnchgcalc="dFNCHypergeo", dnchgprec=1e-10) if (xs[j] >= ci.lb[i] & xs[j] <= ci.ub[i]) out[i,j] <- FALSE } } } if (scale) { trapezoid <- function(x,y) sum(diff(x)*(y[-1]+y[-length(y)]))/2 lls.sum <- rep(NA_real_, k) for (i in seq_len(k)) { lls.sum[i] <- trapezoid(xs[!is.na(lls[i,])], lls[i,!is.na(lls[i,])]) lls[i,] <- lls[i,] / lls.sum[i] } } lls[out] <- NA_real_ ### set y-axis limits if (missing(ylim)) { ylim <- c(0, max(lls, na.rm=TRUE)) } else { ylim <- sort(ylim) } plot(NA, NA, xlim=xlim, ylim=ylim, xlab=xlab, ylab=ylab, ...) for (i in seq_len(k)[order(1/vi)]) { lines(xs, lls[i,], lty=lty[i], lwd=lwd[i], col=col[i], ...) } if (is.numeric(refline)) abline(v=refline, lty="solid", lwd=2, ...) invisible(lls) } metafor/R/conv.wald.r0000644000176200001440000002043014467675147014212 0ustar liggesusersconv.wald <- function(out, ci.lb, ci.ub, zval, pval, n, data, include, level=95, transf, check=TRUE, var.names, append=TRUE, replace="ifna", ...) { # TODO: allow t-distribution based CIs/tests (then also need dfs argument)? mstyle <- .get.mstyle("crayon" %in% .packages()) if (missing(out) && missing(ci.lb) && missing(ci.ub) && missing(zval) && missing(pval)) stop(mstyle$stop("Must specify at least some of these arguments: 'out', 'ci.lb', 'ci.ub', 'zval', 'pval'.")) if (is.logical(replace)) { if (isTRUE(replace)) { replace <- "all" } else { replace <- "ifna" } } replace <- match.arg(replace, c("ifna","all")) ### get ... argument and check for extra/superfluous arguments ddd <- list(...) .chkdots(ddd, c("cifac")) cifac <- ifelse(is.null(ddd$cifac), 0.1, ddd$cifac) ######################################################################### if (missing(data)) data <- NULL has.data <- !is.null(data) if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } x <- data ### checks on var.names argument if (missing(var.names)) { if (inherits(x, "escalc")) { if (!is.null(attr(x, "yi.names"))) { # if yi.names attributes is available yi.name <- attr(x, "yi.names")[1] # take the first entry to be the yi variable } else { # if not, see if 'yi' is in the object and assume that is the yi variable if (!is.element("yi", names(x))) stop(mstyle$stop("Cannot determine name of the 'yi' variable.")) yi.name <- "yi" } if (!is.null(attr(x, "vi.names"))) { # if vi.names attributes is available vi.name <- attr(x, "vi.names")[1] # take the first entry to be the vi variable } else { # if not, see if 'vi' is in the object and assume that is the vi variable if (!is.element("vi", names(x))) stop(mstyle$stop("Cannot determine name of the 'vi' variable.")) vi.name <- "vi" } } else { yi.name <- "yi" vi.name <- "vi" } } else { if (length(var.names) != 2L) stop(mstyle$stop("Argument 'var.names' must be of length 2.")) if (any(var.names != make.names(var.names, unique=TRUE))) { var.names <- make.names(var.names, unique=TRUE) warning(mstyle$warning(paste0("Argument 'var.names' does not contain syntactically valid variable names.\nVariable names adjusted to: var.names = c('", var.names[1], "','", var.names[2], "').")), call.=FALSE) } yi.name <- var.names[1] vi.name <- var.names[2] } if (missing(transf)) transf <- FALSE ######################################################################### mf <- match.call() out <- .getx("out", mf=mf, data=x, checknumeric=TRUE) ci.lb <- .getx("ci.lb", mf=mf, data=x, checknumeric=TRUE) ci.ub <- .getx("ci.ub", mf=mf, data=x, checknumeric=TRUE) zval <- .getx("zval", mf=mf, data=x, checknumeric=TRUE) pval <- .getx("pval", mf=mf, data=x, checknumeric=TRUE) n <- .getx("n", mf=mf, data=x, checknumeric=TRUE) level <- .getx("level", mf=mf, data=x, checknumeric=TRUE, default=95) include <- .getx("include", mf=mf, data=x) if (!.equal.length(out, ci.lb, ci.ub, zval, pval, n)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) k <- max(length(out), length(ci.lb), length(ci.ub), length(zval), length(pval), length(n)) if (is.null(out)) out <- rep(NA_real_, k) if (is.null(ci.lb)) ci.lb <- rep(NA_real_, k) if (is.null(ci.ub)) ci.ub <- rep(NA_real_, k) if (is.null(zval)) zval <- rep(NA_real_, k) if (is.null(pval)) pval <- rep(NA_real_, k) if (is.null(n)) n <- rep(NA_real_, k) ### if include is NULL, set to TRUE vector if (is.null(include)) include <- rep(TRUE, k) ### turn numeric include vector into logical vector include <- .chksubset(include, k, stoponk0=FALSE) ### set inputs to NA for rows not to be included out[!include] <- NA_real_ ci.lb[!include] <- NA_real_ ci.ub[!include] <- NA_real_ zval[!include] <- NA_real_ pval[!include] <- NA_real_ n[!include] <- NA_real_ ### check p-values if (any(pval < 0, na.rm=TRUE) || any(pval > 1, na.rm=TRUE)) stop(mstyle$stop("One or more p-values are < 0 or > 1.")) ### if level is a single value, expand to the appropriate length if (length(level) == 1L) level <- rep(level, k) if (length(level) != k) stop(mstyle$stop(paste0("Length of the 'level' argument (", length(level), ") does not correspond to the size of the dataset (", k, ")."))) level <- .level(level, allow.vector=TRUE) crit <- qnorm(level/2, lower.tail=FALSE) ### apply transformation function if one has been specified if (is.function(transf)) { out <- sapply(out, transf) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) } ### set up data frame if 'data' was not specified if (!has.data) { x <- data.frame(rep(NA_real_, k), rep(NA_real_, k)) names(x) <- c(yi.name, vi.name) } ######################################################################### ### replace missing x$yi values if (replace=="ifna") { x[[yi.name]] <- replmiss(x[[yi.name]], out) } else { x[[yi.name]][!is.na(out)] <- out[!is.na(out)] } ### replace missing ni attribute values (or add 'ni' attribute if at least one value is not missing) if (!is.null(attributes(x[[yi.name]])$ni)) { attributes(x[[yi.name]])$ni <- replmiss(attributes(x[[yi.name]])$ni, n) } else { if (any(!is.na(n))) attr(x[[yi.name]], "ni") <- n } ######################################################################### ### convert Wald-type CIs to sampling variances vi <- ((ci.ub-ci.lb)/(2*crit))^2 ### check if yi is about halfway between CI bounds if (check) { # |-------------+-------------| # lb yi ub # |---| (ub+lb)/2 # # if the difference is more than 10% of the CI range, then flag this row diffs <- abs((ci.ub+ci.lb)/2 - x[[yi.name]]) / (ci.ub - ci.lb) #x$diffs <- diffs diffslarge <- diffs > cifac diffslarge[!is.na(x[[vi.name]])] <- NA # when x$vi is not missing, ignore diffslarge if (any(diffslarge, na.rm=TRUE)) { diffslarge <- which(diffslarge) if (length(diffslarge) > 5) { diffslarge <- paste0(paste0(head(diffslarge, 5), collapse=", "), ", ...") } else { diffslarge <- paste0(diffslarge, collapse=", ") } warning(mstyle$warning("The observed outcome does not appear to be halfway between '(ci.lb, ci.ub)' in row(s): ", diffslarge), call.=FALSE) } } ### convert two-sided p-values to Wald-type test statistics and replace missing zval values zval <- replmiss(zval, qnorm(pval/2, lower.tail=FALSE)) ### convert Wald-type test statistics to sampling variances and replace missing vi values vi <- replmiss(vi, (x[[yi.name]] / zval)^2) ### note: if both (ci.lb,ci.ub) and zval/pval is available, then this favors ### the back-calculation based on (ci.lb,ci.ub) which seems reasonable ### TODO: could consider checking if the back-calculated vi's differs in this case ### (or if x$vi is already available) ### replace missing x$vi values if (replace=="ifna") { x[[vi.name]] <- replmiss(x[[vi.name]], vi) } else { x[[vi.name]][!is.na(vi)] <- vi[!is.na(vi)] } ######################################################################### measure <- attr(x[[yi.name]], "measure") if (is.null(measure)) measure <- "GEN" #escall <- paste0("escalc(measure='", measure, "', data=x, yi=", yi.name, ", vi=", vi.name, ", var.names=c('", yi.name, "','", vi.name, "'))") #x <- eval(str2lang(escall)) x <- escalc(measure=measure, data=x, yi=x[[yi.name]], vi=x[[vi.name]], var.names=c(yi.name,vi.name)) if (!append) x <- x[,c(yi.name, vi.name)] return(x) ######################################################################### } metafor/R/rma.mh.r0000644000176200001440000006211214421561336013464 0ustar liggesusersrma.mh <- function(ai, bi, ci, di, n1i, n2i, x1i, x2i, t1i, t2i, measure="OR", data, slab, subset, add=1/2, to="only0", drop00=TRUE, ### for add/to/drop00, 1st element for escalc(), 2nd for MH method correct=TRUE, level=95, verbose=FALSE, digits, ...) { ######################################################################### ###### setup mstyle <- .get.mstyle("crayon" %in% .packages()) ### check argument specifications if (!is.element(measure, c("OR","RR","RD","IRR","IRD"))) stop(mstyle$stop("Mantel-Haenszel method can only be used with measures OR, RR, RD, IRR, and IRD.")) if (length(add) == 1L) add <- c(add, 0) if (length(add) != 2L) stop(mstyle$stop("Argument 'add' should specify one or two values (see 'help(rma.mh)').")) if (length(to) == 1L) to <- c(to, "none") if (length(to) != 2L) stop(mstyle$stop("Argument 'to' should specify one or two values (see 'help(rma.mh)').")) if (length(drop00) == 1L) drop00 <- c(drop00, FALSE) if (length(drop00) != 2L) stop(mstyle$stop("Argument 'drop00' should specify one or two values (see 'help(rma.mh)').")) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (!is.element(to[1], c("all","only0","if0all","none"))) stop(mstyle$stop("Unknown 'to' argument specified.")) if (!is.element(to[2], c("all","only0","if0all","none"))) stop(mstyle$stop("Unknown 'to' argument specified.")) time.start <- proc.time() ### get ... argument and check for extra/superfluous arguments ddd <- list(...) .chkdots(ddd, c("outlist", "onlyo1", "addyi", "addvi", "time")) ### set defaults or get onlyo1, addyi, and addvi arguments onlyo1 <- ifelse(is.null(ddd$onlyo1), FALSE, ddd$onlyo1) addyi <- ifelse(is.null(ddd$addyi), TRUE, ddd$addyi) addvi <- ifelse(is.null(ddd$addvi), TRUE, ddd$addvi) ### set defaults for digits if (missing(digits)) { digits <- .set.digits(dmiss=TRUE) } else { digits <- .set.digits(digits, dmiss=FALSE) } ### set options(warn=1) if verbose > 2 if (verbose > 2) { opwarn <- options(warn=1) on.exit(options(warn=opwarn$warn), add=TRUE) } ######################################################################### if (verbose) .space() if (verbose) message(mstyle$message("Extracting data and computing yi/vi values ...")) ### check if data argument has been specified if (missing(data)) data <- NULL if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } mf <- match.call() ### extract slab and subset values, possibly from the data frame specified via data (arguments not specified are NULL) slab <- .getx("slab", mf=mf, data=data) subset <- .getx("subset", mf=mf, data=data) ######################################################################### ### for RR, OR, and RD: extract/calculate ai,bi,ci,di,n1i,n2i values if (is.element(measure, c("RR","OR","RD"))) { x1i <- x2i <- t1i <- t2i <- NA_real_ ai <- .getx("ai", mf=mf, data=data, checknumeric=TRUE) bi <- .getx("bi", mf=mf, data=data, checknumeric=TRUE) ci <- .getx("ci", mf=mf, data=data, checknumeric=TRUE) di <- .getx("di", mf=mf, data=data, checknumeric=TRUE) n1i <- .getx("n1i", mf=mf, data=data, checknumeric=TRUE) n2i <- .getx("n2i", mf=mf, data=data, checknumeric=TRUE) if (is.null(bi)) bi <- n1i - ai if (is.null(di)) di <- n2i - ci ni <- ai + bi + ci + di k <- length(ai) ### number of outcomes before subsetting k.all <- k if (length(ai)==0L || length(bi)==0L || length(ci)==0L || length(di)==0L) stop(mstyle$stop("Must specify arguments ai, bi, ci, di (or ai, ci, n1i, n2i) for this measure.")) ids <- seq_len(k) ### generate study labels if none are specified if (verbose) message(mstyle$message("Generating/extracting study labels ...")) if (is.null(slab)) { slab.null <- TRUE slab <- ids } else { if (anyNA(slab)) stop(mstyle$stop("NAs in study labels.")) if (length(slab) != k) stop(mstyle$stop("Study labels not of same length as data.")) if (is.factor(slab)) slab <- as.character(slab) slab.null <- FALSE } ### if a subset of studies is specified if (!is.null(subset)) { if (verbose) message(mstyle$message("Subsetting ...")) subset <- .chksubset(subset, k) ai <- .getsubset(ai, subset) bi <- .getsubset(bi, subset) ci <- .getsubset(ci, subset) di <- .getsubset(di, subset) ni <- .getsubset(ni, subset) slab <- .getsubset(slab, subset) ids <- .getsubset(ids, subset) k <- length(ai) } ### check if study labels are unique; if not, make them unique if (anyDuplicated(slab)) slab <- .make.unique(slab) ### calculate observed effect estimates and sampling variances dat <- .do.call(escalc, measure=measure, ai=ai, bi=bi, ci=ci, di=di, add=add[1], to=to[1], drop00=drop00[1], onlyo1=onlyo1, addyi=addyi, addvi=addvi) yi <- dat$yi ### one or more yi/vi pairs may be NA/NA vi <- dat$vi ### one or more yi/vi pairs may be NA/NA ### if drop00[2]=TRUE, set counts to NA for studies that have no events (or all events) in both arms if (drop00[2]) { id00 <- c(ai == 0L & ci == 0L) | c(bi == 0L & di == 0L) id00[is.na(id00)] <- FALSE ai[id00] <- NA_real_ bi[id00] <- NA_real_ ci[id00] <- NA_real_ di[id00] <- NA_real_ } ### save the actual cell frequencies and yi/vi values (including potential NAs) outdat.f <- list(ai=ai, bi=bi, ci=ci, di=di) yi.f <- yi vi.f <- vi ni.f <- ni k.f <- k ### total number of tables including all NAs ### check for NAs in table data and act accordingly has.na <- is.na(ai) | is.na(bi) | is.na(ci) | is.na(di) not.na <- !has.na if (any(has.na)) { if (verbose) message(mstyle$message("Handling NAs in table data ...")) if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { ai <- ai[not.na] bi <- bi[not.na] ci <- ci[not.na] di <- di[not.na] k <- length(ai) warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "studies", "study"), "with NAs omitted from model fitting.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### check for NAs in yi/vi and act accordingly yivi.na <- is.na(yi) | is.na(vi) not.na.yivi <- !yivi.na if (any(yivi.na)) { if (verbose) message(mstyle$message("Handling NAs in yi/vi ...")) if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { yi <- yi[not.na.yivi] vi <- vi[not.na.yivi] ni <- ni[not.na.yivi] warning(mstyle$warning("Some yi/vi values are NA."), call.=FALSE) attr(yi, "measure") <- measure ### add measure attribute back attr(yi, "ni") <- ni ### add ni attribute back } if (na.act == "na.fail") stop(mstyle$stop("Missing yi/vi values.")) } k.yi <- length(yi) ### number of yi/vi pairs that are not NA (needed for QE df and fit.stats calculation) ### add/to procedures for the 2x2 tables for the actual meta-analysis ### note: technically, nothing needs to be added, but Stata/RevMan add 1/2 by default for only0 studies (but drop studies with no/all events) if (to[2] == "all") { ### always add to all cells in all studies ai <- ai + add[2] bi <- bi + add[2] ci <- ci + add[2] di <- di + add[2] } if (to[2] == "only0") { ### add to cells in studies with at least one 0 entry id0 <- c(ai == 0L | bi == 0L | ci == 0L | di == 0L) ai[id0] <- ai[id0] + add[2] bi[id0] <- bi[id0] + add[2] ci[id0] <- ci[id0] + add[2] di[id0] <- di[id0] + add[2] } if (to[2] == "if0all") { ### add to cells in all studies if there is at least one 0 entry id0 <- c(ai == 0L | bi == 0L | ci == 0L | di == 0L) if (any(id0)) { ai <- ai + add[2] bi <- bi + add[2] ci <- ci + add[2] di <- di + add[2] } } n1i <- ai + bi n2i <- ci + di Ni <- ai + bi + ci + di } ######################################################################### ### for IRR and IRD: extract/calculate x1i,x2i,t1i,t2i values if (is.element(measure, c("IRR","IRD"))) { ai <- bi <- ci <- di <- NA_real_ x1i <- .getx("x1i", mf=mf, data=data, checknumeric=TRUE) x2i <- .getx("x2i", mf=mf, data=data, checknumeric=TRUE) t1i <- .getx("t1i", mf=mf, data=data, checknumeric=TRUE) t2i <- .getx("t2i", mf=mf, data=data, checknumeric=TRUE) ni <- t1i + t2i k <- length(x1i) ### number of outcomes before subsetting k.all <- k if (length(x1i)==0L || length(x2i)==0L || length(t1i)==0L || length(t2i)==0L) stop(mstyle$stop("Must specify arguments x1i, x2i, t1i, t2i for this measure.")) ids <- seq_len(k) ### generate study labels if none are specified if (verbose) message(mstyle$message("Generating/extracting study labels ...")) if (is.null(slab)) { slab.null <- TRUE slab <- ids } else { if (anyNA(slab)) stop(mstyle$stop("NAs in study labels.")) if (length(slab) != k) stop(mstyle$stop("Study labels not of same length as data.")) slab.null <- FALSE } ### if a subset of studies is specified if (!is.null(subset)) { if (verbose) message(mstyle$message("Subsetting ...")) subset <- .chksubset(subset, k) x1i <- .getsubset(x1i, subset) x2i <- .getsubset(x2i, subset) t1i <- .getsubset(t1i, subset) t2i <- .getsubset(t2i, subset) ni <- .getsubset(ni, subset) slab <- .getsubset(slab, subset) ids <- .getsubset(ids, subset) k <- length(x1i) } ### check if study labels are unique; if not, make them unique if (anyDuplicated(slab)) slab <- .make.unique(slab) ### calculate observed effect estimates and sampling variances dat <- .do.call(escalc, measure=measure, x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, add=add[1], to=to[1], drop00=drop00[1], onlyo1=onlyo1, addyi=addyi, addvi=addvi) yi <- dat$yi ### one or more yi/vi pairs may be NA/NA vi <- dat$vi ### one or more yi/vi pairs may be NA/NA ### if drop00[2]=TRUE, set counts to NA for studies that have no events in both arms if (drop00[2]) { id00 <- c(x1i == 0L & x2i == 0L) id00[is.na(id00)] <- FALSE x1i[id00] <- NA_real_ x2i[id00] <- NA_real_ } ### save the actual cell frequencies and yi/vi values (including potential NAs) outdat.f <- list(x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i) yi.f <- yi vi.f <- vi ni.f <- ni k.f <- k ### total number of tables including all NAs ### check for NAs in table data and act accordingly has.na <- is.na(x1i) | is.na(x2i) | is.na(t1i) | is.na(t2i) not.na <- !has.na if (any(has.na)) { if (verbose) message(mstyle$message("Handling NAs in table data ...")) if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { x1i <- x1i[not.na] x2i <- x2i[not.na] t1i <- t1i[not.na] t2i <- t2i[not.na] k <- length(x1i) warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "studies", "study"), "with NAs omitted from model fitting.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### check for NAs in yi/vi and act accordingly yivi.na <- is.na(yi) | is.na(vi) not.na.yivi <- !yivi.na if (any(yivi.na)) { if (verbose) message(mstyle$message("Handling NAs in yi/vi ...")) if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { yi <- yi[not.na.yivi] vi <- vi[not.na.yivi] ni <- ni[not.na.yivi] warning(mstyle$warning("Some yi/vi values are NA."), call.=FALSE) attr(yi, "measure") <- measure ### add measure attribute back attr(yi, "ni") <- ni ### add ni attribute back } if (na.act == "na.fail") stop(mstyle$stop("Missing yi/vi values.")) } k.yi <- length(yi) ### number of yi/vi pairs that are not NA (needed for QE df and fitstats calculation) ### add/to procedures for the 2x2 tables for the actual meta-analysis ### note: technically, nothing needs to be added if (to[2] == "all") { ### always add to all cells in all studies x1i <- x1i + add[2] x2i <- x2i + add[2] } if (to[2] == "only0") { ### add to cells in studies with at least one 0 entry id0 <- c(x1i == 0L | x2i == 0L) x1i[id0] <- x1i[id0] + add[2] x2i[id0] <- x2i[id0] + add[2] } if (to[2] == "if0all") { ### add to cells in all studies if there is at least one 0 entry id0 <- c(x1i == 0L | x2i == 0L) if (any(id0)) { x1i <- x1i + add[2] x2i <- x2i + add[2] } } Ti <- t1i + t2i } ######################################################################### level <- .level(level) CO <- COp <- MH <- MHp <- BD <- BDp <- TA <- TAp <- NA_real_ k.pos <- NA_integer_ ###### model fitting, test statistics, and confidence intervals if (verbose) message(mstyle$message("Model fitting ...")) if (measure == "OR") { Pi <- ai/Ni + di/Ni Qi <- bi/Ni + ci/Ni Ri <- (ai/Ni) * di Si <- (bi/Ni) * ci R <- sum(Ri) S <- sum(Si) if (identical(R,0) || identical(S,0) || identical(R,0L) || identical(S,0L)) { beta.exp <- NA_real_ beta <- NA_real_ se <- NA_real_ zval <- NA_real_ pval <- NA_real_ ci.lb <- NA_real_ ci.ub <- NA_real_ } else { beta.exp <- R/S beta <- log(beta.exp) se <- sqrt(1/2 * (sum(Pi*Ri)/R^2 + sum(Pi*Si + Qi*Ri)/(R*S) + sum(Qi*Si)/S^2)) ### based on Robins et al. (1986) zval <- beta / se pval <- 2*pnorm(abs(zval), lower.tail=FALSE) ci.lb <- beta - qnorm(level/2, lower.tail=FALSE) * se ci.ub <- beta + qnorm(level/2, lower.tail=FALSE) * se } names(beta) <- "intrcpt" vb <- matrix(se^2, dimnames=list("intrcpt", "intrcpt")) ### Cochran and Cochran-Mantel-Haenszel Statistics xt <- ai + ci yt <- bi + di if (identical(sum(xt),0) || identical(sum(yt),0) || identical(sum(xt),0L) || identical(sum(yt),0L)) { CO <- NA_real_ COp <- NA_real_ MH <- NA_real_ MHp <- NA_real_ } else { CO <- (abs(sum(ai - (n1i/Ni)*xt)) - ifelse(correct, 0.5, 0))^2 / sum((n1i/Ni)*(n2i/Ni)*(xt*(yt/Ni))) COp <- pchisq(CO, df=1, lower.tail=FALSE) MH <- (abs(sum(ai - (n1i/Ni)*xt)) - ifelse(correct, 0.5, 0))^2 / sum((n1i/Ni)*(n2i/Ni)*(xt*(yt/(Ni-1)))) MHp <- pchisq(MH, df=1, lower.tail=FALSE) } ### Breslow-Day and Tarone's Test for Heterogeneity if (is.na(beta)) { BD <- NA_real_ TA <- NA_real_ BDp <- NA_real_ TAp <- NA_real_ k.pos <- 0L } else { if (identical(beta.exp,1) || identical(beta.exp,1L)) { N11 <- (n1i/Ni)*xt } else { A <- beta.exp * (n1i + xt) + (n2i - xt) B <- sqrt(A^2 - 4*n1i*xt*beta.exp*(beta.exp-1)) N11 <- (A-B) / (2*(beta.exp-1)) } pos <- (N11 > 0) & (xt > 0) & (yt > 0) k.pos <- sum(pos) N11 <- N11[pos] N12 <- n1i[pos] - N11 N21 <- xt[pos] - N11 N22 <- N11 - n1i[pos] - xt[pos] + Ni[pos] BD <- max(0, sum((ai[pos]-N11)^2 / (1/N11 + 1/N12 + 1/N21 + 1/N22)^(-1))) TA <- max(0, BD - sum(ai[pos]-N11)^2 / sum((1/N11 + 1/N12 + 1/N21 + 1/N22)^(-1))) if (k.pos > 1L) { BDp <- pchisq(BD, df=k.pos-1L, lower.tail=FALSE) TAp <- pchisq(TA, df=k.pos-1L, lower.tail=FALSE) } else { BDp <- NA_real_ TAp <- NA_real_ } } } if (measure == "RR") { R <- sum(ai * (n2i/Ni)) S <- sum(ci * (n1i/Ni)) if (identical(sum(ai),0) || identical(sum(ci),0) || identical(sum(ai),0L) || identical(sum(ci),0L)) { beta.exp <- NA_real_ beta <- NA_real_ se <- NA_real_ zval <- NA_real_ pval <- NA_real_ ci.lb <- NA_real_ ci.ub <- NA_real_ } else { beta.exp <- R/S beta <- log(beta.exp) se <- sqrt(sum(((n1i/Ni)*(n2i/Ni)*(ai+ci) - (ai/Ni)*ci)) / (R*S)) zval <- beta / se pval <- 2*pnorm(abs(zval), lower.tail=FALSE) ci.lb <- beta - qnorm(level/2, lower.tail=FALSE) * se ci.ub <- beta + qnorm(level/2, lower.tail=FALSE) * se } names(beta) <- "intrcpt" vb <- matrix(se^2, dimnames=list("intrcpt", "intrcpt")) } if (measure == "RD") { beta <- sum(ai*(n2i/Ni) - ci*(n1i/Ni)) / sum(n1i*(n2i/Ni)) se <- sqrt((beta * (sum(ci*(n1i/Ni)^2 - ai*(n2i/Ni)^2 + (n1i/Ni)*(n2i/Ni)*(n2i-n1i)/2)) + sum(ai*(n2i-ci)/Ni + ci*(n1i-ai)/Ni)/2) / sum(n1i*(n2i/Ni))^2) ### equation in: Sato, Greenland, & Robins (1989) #se <- sqrt(sum(((ai/Ni^2)*bi*(n2i^2/n1i) + (ci/Ni^2)*di*(n1i^2/n2i))) / sum(n1i*(n2i/Ni))^2) ### equation in: Greenland & Robins (1985) zval <- beta / se pval <- 2*pnorm(abs(zval), lower.tail=FALSE) ci.lb <- beta - qnorm(level/2, lower.tail=FALSE) * se ci.ub <- beta + qnorm(level/2, lower.tail=FALSE) * se names(beta) <- "intrcpt" vb <- matrix(se^2, dimnames=list("intrcpt", "intrcpt")) } if (measure == "IRR") { R <- sum(x1i * (t2i/Ti)) S <- sum(x2i * (t1i/Ti)) if (identical(sum(x1i),0) || identical(sum(x2i),0) || identical(sum(x1i),0L) || identical(sum(x2i),0L)) { beta.exp <- NA_real_ beta <- NA_real_ se <- NA_real_ zval <- NA_real_ pval <- NA_real_ ci.lb <- NA_real_ ci.ub <- NA_real_ } else { beta.exp <- R/S beta <- log(beta.exp) se <- sqrt(sum((t1i/Ti)*(t2i/Ti)*(x1i+x2i)) / (R*S)) zval <- beta / se pval <- 2*pnorm(abs(zval), lower.tail=FALSE) ci.lb <- beta - qnorm(level/2, lower.tail=FALSE) * se ci.ub <- beta + qnorm(level/2, lower.tail=FALSE) * se } names(beta) <- "intrcpt" vb <- matrix(se^2, dimnames=list("intrcpt", "intrcpt")) ### Mantel-Haenszel Statistic xt <- x1i + x2i if (identical(sum(xt),0) || identical(sum(xt),0L)) { MH <- NA_real_ MHp <- NA_real_ } else { MH <- (abs(sum(x1i - xt*(t1i/Ti))) - ifelse(correct, 0.5, 0))^2 / sum(xt*(t1i/Ti)*(t2i/Ti)) MHp <- pchisq(MH, df=1, lower.tail=FALSE) } } if (measure == "IRD") { beta <- sum((x1i*t2i - x2i*t1i)/Ti) / sum((t1i/Ti)*t2i) se <- sqrt(sum(((t1i/Ti)*t2i)^2*(x1i/t1i^2+x2i/t2i^2))) / sum((t1i/Ti)*t2i) ### from Rothland et al. (2008), chapter 15 zval <- beta / se pval <- 2*pnorm(abs(zval), lower.tail=FALSE) ci.lb <- beta - qnorm(level/2, lower.tail=FALSE) * se ci.ub <- beta + qnorm(level/2, lower.tail=FALSE) * se names(beta) <- "intrcpt" vb <- matrix(se^2, dimnames=list("intrcpt", "intrcpt")) } ######################################################################### ### heterogeneity test (inverse variance method) if (verbose) message(mstyle$message("Heterogeneity testing ...")) wi <- 1/vi if (k.yi > 1) { QE <- max(0, sum(wi*(yi-beta)^2)) QEp <- pchisq(QE, df=k.yi-1, lower.tail=FALSE) I2 <- max(0, 100 * (QE - (k.yi-1)) / QE) H2 <- QE / (k.yi-1) } else { QE <- 0 QEp <- 1 I2 <- 0 H2 <- 1 } ######################################################################### ###### fit statistics if (verbose) message(mstyle$message("Computing fit statistics and log likelihood ...")) if (k.yi >= 1) { ll.ML <- -1/2 * (k.yi) * log(2*base::pi) - 1/2 * sum(log(vi)) - 1/2 * QE ll.REML <- -1/2 * (k.yi-1) * log(2*base::pi) + 1/2 * log(k.yi) - 1/2 * sum(log(vi)) - 1/2 * log(sum(wi)) - 1/2 * QE if (any(vi <= 0)) { dev.ML <- -2 * ll.ML } else { dev.ML <- -2 * (ll.ML - sum(dnorm(yi, mean=yi, sd=sqrt(vi), log=TRUE))) } AIC.ML <- -2 * ll.ML + 2 BIC.ML <- -2 * ll.ML + log(k.yi) AICc.ML <- -2 * ll.ML + 2 * max(k.yi, 3) / (max(k.yi, 3) - 2) dev.REML <- -2 * (ll.REML - 0) AIC.REML <- -2 * ll.REML + 2 BIC.REML <- -2 * ll.REML + log(k.yi-1) AICc.REML <- -2 * ll.REML + 2 * max(k.yi-1, 3) / (max(k.yi-1, 3) - 2) fit.stats <- matrix(c(ll.ML, dev.ML, AIC.ML, BIC.ML, AICc.ML, ll.REML, dev.REML, AIC.REML, BIC.REML, AICc.REML), ncol=2, byrow=FALSE) } else { fit.stats <- matrix(NA_real_, nrow=5, ncol=2, byrow=FALSE) } dimnames(fit.stats) <- list(c("ll","dev","AIC","BIC","AICc"), c("ML","REML")) fit.stats <- data.frame(fit.stats) ######################################################################### ###### prepare output if (verbose) message(mstyle$message("Preparing output ...")) parms <- 1 p <- 1 p.eff <- 1 k.eff <- k tau2 <- 0 X.f <- cbind(rep(1,k.f)) intercept <- TRUE int.only <- TRUE btt <- 1 m <- 1 coef.na <- c(X=FALSE) method <- "FE" weighted <- TRUE test <- "z" ddf <- NA_integer_ if (is.null(ddd$outlist) || ddd$outlist == "nodata") { outdat <- list(ai=ai, bi=bi, ci=ci, di=di, x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i) res <- list(b=beta, beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, vb=vb, tau2=tau2, tau2.f=tau2, I2=I2, H2=H2, QE=QE, QEp=QEp, CO=CO, COp=COp, MH=MH, MHp=MHp, BD=BD, BDp=BDp, TA=TA, TAp=TAp, k=k, k.f=k.f, k.yi=k.yi, k.pos=k.pos, k.eff=k.eff, k.all=k.all, p=p, p.eff=p.eff, parms=parms, int.only=int.only, intercept=intercept, coef.na=coef.na, yi=yi, vi=vi, yi.f=yi.f, vi.f=vi.f, X.f=X.f, outdat.f=outdat.f, outdat=outdat, ni=ni, ni.f=ni.f, ids=ids, not.na=not.na, subset=subset, not.na.yivi=not.na.yivi, slab=slab, slab.null=slab.null, measure=measure, method=method, weighted=weighted, test=test, ddf=ddf, dfs=ddf, btt=btt, m=m, digits=digits, level=level, add=add, to=to, drop00=drop00, correct=correct, fit.stats=fit.stats, formula.yi=NULL, formula.mods=NULL, version=packageVersion("metafor"), call=mf) if (is.null(ddd$outlist)) res <- append(res, list(data=data), which(names(res) == "fit.stats")) } else { if (ddd$outlist == "minimal") { res <- list(b=beta, beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, vb=vb, tau2=tau2, I2=I2, H2=H2, QE=QE, QEp=QEp, CO=CO, COp=COp, MH=MH, MHp=MHp, BD=BD, BDp=BDp, TA=TA, TAp=TAp, k=k, k.yi=k.yi, k.pos=k.pos, k.eff=k.eff, p=p, p.eff=p.eff, parms=parms, int.only=int.only, measure=measure, method=method, test=test, ddf=ddf, dfs=ddf, btt=btt, m=m, digits=digits, fit.stats=fit.stats) } else { res <- eval(str2lang(paste0("list(", ddd$outlist, ")"))) } } time.end <- proc.time() res$time <- unname(time.end - time.start)[3] if (.isTRUE(ddd$time)) .print.time(res$time) if (verbose || .isTRUE(ddd$time)) cat("\n") class(res) <- c("rma.mh", "rma") return(res) } metafor/R/rma.peto.r0000644000176200001440000003241614421561360014030 0ustar liggesusersrma.peto <- function(ai, bi, ci, di, n1i, n2i, data, slab, subset, add=1/2, to="only0", drop00=TRUE, ### for add/to/drop00, 1st element for escalc(), 2nd for Peto's method level=95, verbose=FALSE, digits, ...) { ######################################################################### ###### setup mstyle <- .get.mstyle("crayon" %in% .packages()) ### check argument specifications if (length(add) == 1L) add <- c(add, 0) if (length(add) != 2L) stop(mstyle$stop("Argument 'add' should specify one or two values (see 'help(rma.peto)').")) if (length(to) == 1L) to <- c(to, "none") if (length(to) != 2L) stop(mstyle$stop("Argument 'to' should specify one or two values (see 'help(rma.peto)').")) if (length(drop00) == 1L) drop00 <- c(drop00, FALSE) if (length(drop00) != 2L) stop(mstyle$stop("Argument 'drop00' should specify one or two values (see 'help(rma.peto)').")) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (!is.element(to[1], c("all","only0","if0all","none"))) stop(mstyle$stop("Unknown 'to' argument specified.")) if (!is.element(to[2], c("all","only0","if0all","none"))) stop(mstyle$stop("Unknown 'to' argument specified.")) time.start <- proc.time() ### get ... argument and check for extra/superfluous arguments ddd <- list(...) .chkdots(ddd, c("outlist", "time")) measure <- "PETO" ### set measure here so that it can be added below ### set defaults for digits if (missing(digits)) { digits <- .set.digits(dmiss=TRUE) } else { digits <- .set.digits(digits, dmiss=FALSE) } ### set options(warn=1) if verbose > 2 if (verbose > 2) { opwarn <- options(warn=1) on.exit(options(warn=opwarn$warn), add=TRUE) } ######################################################################### if (verbose) .space() if (verbose) message(mstyle$message("Extracting data and computing yi/vi values ...")) ### check if data argument has been specified if (missing(data)) data <- NULL if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } mf <- match.call() ### extract slab and subset values, possibly from the data frame specified via data (arguments not specified are NULL) slab <- .getx("slab", mf=mf, data=data) subset <- .getx("subset", mf=mf, data=data) ### extract/calculate ai,bi,ci,di,n1i,n2i values ai <- .getx("ai", mf=mf, data=data, checknumeric=TRUE) bi <- .getx("bi", mf=mf, data=data, checknumeric=TRUE) ci <- .getx("ci", mf=mf, data=data, checknumeric=TRUE) di <- .getx("di", mf=mf, data=data, checknumeric=TRUE) n1i <- .getx("n1i", mf=mf, data=data, checknumeric=TRUE) n2i <- .getx("n2i", mf=mf, data=data, checknumeric=TRUE) if (is.null(bi)) bi <- n1i - ai if (is.null(di)) di <- n2i - ci ni <- ai + bi + ci + di k <- length(ai) ### number of outcomes before subsetting k.all <- k if (length(ai)==0L || length(bi)==0L || length(ci)==0L || length(di)==0L) stop(mstyle$stop("Must specify arguments ai, bi, ci, di (or ai, ci, n1i, n2i).")) ids <- seq_len(k) ### generate study labels if none are specified if (verbose) message(mstyle$message("Generating/extracting study labels ...")) if (is.null(slab)) { slab.null <- TRUE slab <- ids } else { if (anyNA(slab)) stop(mstyle$stop("NAs in study labels.")) if (length(slab) != k) stop(mstyle$stop("Study labels not of same length as data.")) if (is.factor(slab)) slab <- as.character(slab) slab.null <- FALSE } ### if a subset of studies is specified if (!is.null(subset)) { if (verbose) message(mstyle$message("Subsetting ...")) subset <- .chksubset(subset, k) ai <- .getsubset(ai, subset) bi <- .getsubset(bi, subset) ci <- .getsubset(ci, subset) di <- .getsubset(di, subset) ni <- .getsubset(ni, subset) slab <- .getsubset(slab, subset) ids <- .getsubset(ids, subset) k <- length(ai) } ### check if study labels are unique; if not, make them unique if (anyDuplicated(slab)) slab <- .make.unique(slab) ### calculate observed effect estimates and sampling variances dat <- .do.call(escalc, measure="PETO", ai=ai, bi=bi, ci=ci, di=di, add=add[1], to=to[1], drop00=drop00[1]) yi <- dat$yi ### one or more yi/vi pairs may be NA/NA vi <- dat$vi ### one or more yi/vi pairs may be NA/NA ### if drop00[2]=TRUE, set counts to NA for studies that have no events (or all events) in both arms if (drop00[2]) { id00 <- c(ai == 0L & ci == 0L) | c(bi == 0L & di == 0L) id00[is.na(id00)] <- FALSE ai[id00] <- NA_real_ bi[id00] <- NA_real_ ci[id00] <- NA_real_ di[id00] <- NA_real_ } ### save the actual cell frequencies and yi/vi values (including potential NAs) outdat.f <- list(ai=ai, bi=bi, ci=ci, di=di) yi.f <- yi vi.f <- vi ni.f <- ni k.f <- k ### total number of tables including all NAs ### check for NAs in table data and act accordingly has.na <- is.na(ai) | is.na(bi) | is.na(ci) | is.na(di) not.na <- !has.na if (any(has.na)) { if (verbose) message(mstyle$message("Handling NAs in table data ...")) if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { ai <- ai[not.na] bi <- bi[not.na] ci <- ci[not.na] di <- di[not.na] k <- length(ai) warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "studies", "study"), "with NAs omitted from model fitting.")), call.=FALSE) } if (na.act == "na.fail") stop(mstyle$stop("Missing values in tables.")) } ### at least one study left? if (k < 1) stop(mstyle$stop("Processing terminated since k = 0.")) ### check for NAs in yi/vi and act accordingly yivi.na <- is.na(yi) | is.na(vi) not.na.yivi <- !yivi.na if (any(yivi.na)) { if (verbose) message(mstyle$message("Handling NAs in yi/vi ...")) if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { yi <- yi[not.na.yivi] vi <- vi[not.na.yivi] ni <- ni[not.na.yivi] warning(mstyle$warning("Some yi/vi values are NA."), call.=FALSE) attr(yi, "measure") <- measure ### add measure attribute back attr(yi, "ni") <- ni ### add ni attribute back } if (na.act == "na.fail") stop(mstyle$stop("Missing yi/vi values.")) } k.yi <- length(yi) ### number of yi/vi pairs that are not NA (needed for QE df and fit.stats calculation) ### add/to procedures for the 2x2 tables for the actual meta-analysis ### note: technically, nothing needs to be added, but Stata/RevMan add 1/2 by default for only0 studies (but drop studies with no/all events) if (to[2] == "all") { ### always add to all cells in all studies ai <- ai + add[2] bi <- bi + add[2] ci <- ci + add[2] di <- di + add[2] } if (to[2] == "only0") { ### add to cells in studies with at least one 0 entry id0 <- c(ai == 0L | bi == 0L | ci == 0L | di == 0L) ai[id0] <- ai[id0] + add[2] bi[id0] <- bi[id0] + add[2] ci[id0] <- ci[id0] + add[2] di[id0] <- di[id0] + add[2] } if (to[2] == "if0all") { ### add to cells in all studies if there is at least one 0 entry id0 <- c(ai == 0L | bi == 0L | ci == 0L | di == 0L) if (any(id0)) { ai <- ai + add[2] bi <- bi + add[2] ci <- ci + add[2] di <- di + add[2] } } n1i <- ai + bi n2i <- ci + di Ni <- ai + bi + ci + di ######################################################################### level <- .level(level) ###### model fitting, test statistics, and confidence intervals if (verbose) message(mstyle$message("Model fitting ...")) xt <- ai + ci ### frequency of outcome1 in both groups combined yt <- bi + di ### frequency of outcome2 in both groups combined Ei <- xt * n1i / Ni Vi <- xt * yt * (n1i/Ni) * (n2i/Ni) / (Ni - 1) ### 0 when xt = 0 or yt = 0 in a table sumVi <- sum(Vi) if (sumVi == 0L) ### sumVi = 0 when xt or yt = 0 in *all* tables stop(mstyle$stop("One of the two outcomes never occurred in any of the tables. Peto's method cannot be used.")) beta <- sum(ai - Ei) / sumVi se <- sqrt(1/sumVi) zval <- beta / se pval <- 2*pnorm(abs(zval), lower.tail=FALSE) ci.lb <- beta - qnorm(level/2, lower.tail=FALSE) * se ci.ub <- beta + qnorm(level/2, lower.tail=FALSE) * se names(beta) <- "intrcpt" vb <- matrix(se^2, dimnames=list("intrcpt", "intrcpt")) ######################################################################### ### heterogeneity test (Peto's method) if (verbose) message(mstyle$message("Heterogeneity testing ...")) k.pos <- sum(Vi > 0) ### number of tables with positive sampling variance Vi[Vi == 0] <- NA_real_ ### set 0 sampling variances to NA QE <- max(0, sum((ai - Ei)^2 / Vi, na.rm=TRUE) - sum(ai - Ei)^2 / sum(Vi, na.rm=TRUE)) if (k.pos > 1L) { QEp <- pchisq(QE, df=k.yi-1, lower.tail=FALSE) I2 <- max(0, 100 * (QE - (k.yi-1)) / QE) H2 <- QE / (k.yi-1) } else { QEp <- 1 I2 <- 0 H2 <- 1 } wi <- 1/vi RSS <- sum(wi*(yi-beta)^2) ######################################################################### ###### fit statistics if (verbose) message(mstyle$message("Computing fit statistics and log likelihood ...")) ll.ML <- -1/2 * (k.yi) * log(2*base::pi) - 1/2 * sum(log(vi)) - 1/2 * RSS ll.REML <- -1/2 * (k.yi-1) * log(2*base::pi) + 1/2 * log(k.yi) - 1/2 * sum(log(vi)) - 1/2 * log(sum(wi)) - 1/2 * RSS if (any(vi <= 0)) { dev.ML <- -2 * ll.ML } else { dev.ML <- -2 * (ll.ML - sum(dnorm(yi, mean=yi, sd=sqrt(vi), log=TRUE))) } AIC.ML <- -2 * ll.ML + 2 BIC.ML <- -2 * ll.ML + log(k.yi) AICc.ML <- -2 * ll.ML + 2 * max(k.yi, 3) / (max(k.yi, 3) - 2) dev.REML <- -2 * (ll.REML - 0) AIC.REML <- -2 * ll.REML + 2 BIC.REML <- -2 * ll.REML + log(k.yi-1) AICc.REML <- -2 * ll.REML + 2 * max(k.yi-1, 3) / (max(k.yi-1, 3) - 2) fit.stats <- matrix(c(ll.ML, dev.ML, AIC.ML, BIC.ML, AICc.ML, ll.REML, dev.REML, AIC.REML, BIC.REML, AICc.REML), ncol=2, byrow=FALSE) dimnames(fit.stats) <- list(c("ll","dev","AIC","BIC","AICc"), c("ML","REML")) fit.stats <- data.frame(fit.stats) ######################################################################### ###### prepare output if (verbose) message(mstyle$message("Preparing output ...")) parms <- 1 p <- 1 p.eff <- 1 k.eff <- k tau2 <- 0 X.f <- cbind(rep(1,k.f)) intercept <- TRUE int.only <- TRUE btt <- 1 m <- 1 coef.na <- c(X=FALSE) method <- "FE" weighted <- TRUE test <- "z" ddf <- NA_integer_ if (is.null(ddd$outlist) || ddd$outlist == "nodata") { outdat <- list(ai=ai, bi=bi, ci=ci, di=di) res <- list(b=beta, beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, vb=vb, tau2=tau2, tau2.f=tau2, I2=I2, H2=H2, QE=QE, QEp=QEp, k=k, k.f=k.f, k.yi=k.yi, k.pos=k.pos, k.eff=k.eff, k.all=k.all, p=p, p.eff=p.eff, parms=parms, int.only=int.only, intercept=intercept, coef.na=coef.na, yi=yi, vi=vi, yi.f=yi.f, vi.f=vi.f, X.f=X.f, outdat.f=outdat.f, outdat=outdat, ni=ni, ni.f=ni.f, ids=ids, not.na=not.na, subset=subset, not.na.yivi=not.na.yivi, slab=slab, slab.null=slab.null, measure=measure, method=method, weighted=weighted, test=test, ddf=ddf, dfs=ddf, btt=btt, m=m, digits=digits, level=level, add=add, to=to, drop00=drop00, fit.stats=fit.stats, formula.yi=NULL, formula.mods=NULL, version=packageVersion("metafor"), call=mf) if (is.null(ddd$outlist)) res <- append(res, list(data=data), which(names(res) == "fit.stats")) } else { if (ddd$outlist == "minimal") { res <- list(b=beta, beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, vb=vb, tau2=tau2, I2=I2, H2=H2, QE=QE, QEp=QEp, k=k, k.pos=k.pos, k.eff=k.eff, p=p, p.eff=p.eff, parms=parms, int.only=int.only, measure=measure, method=method, test=test, ddf=ddf, dfs=ddf, btt=btt, m=m, digits=digits, fit.stats=fit.stats) } else { res <- eval(str2lang(paste0("list(", ddd$outlist, ")"))) } } time.end <- proc.time() res$time <- unname(time.end - time.start)[3] if (.isTRUE(ddd$time)) .print.time(res$time) if (verbose || .isTRUE(ddd$time)) cat("\n") class(res) <- c("rma.peto", "rma") return(res) } metafor/R/vif.rma.r0000644000176200001440000002773714441016301013647 0ustar liggesusersvif.rma <- function(x, btt, att, table=FALSE, reestimate=FALSE, sim=FALSE, progbar=TRUE, seed=NULL, parallel="no", ncpus=1, cl, digits, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma") # allow vif() for 'rma.glmm', 'robust.rma', and 'rma.uni.selmodel' objects based on the same principle (but not sim/reestimate) if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } ### determine for which types of coefficients (G)VIFs will be computed vif.loc <- !x$int.only if (inherits(x, "rma.ls") && !x$Z.int.only) { vif.scale <- TRUE } else { vif.scale <- FALSE } if (!vif.loc && !vif.scale) stop(mstyle$stop("VIFs not applicable to intercept-only models.")) if (!is.null(seed)) set.seed(seed) ddd <- list(...) .chkdots(ddd, c("fixed", "intercept", "time", "LB", "joinb", "joina")) if (is.null(ddd$fixed)) { fixed <- FALSE } else { fixed <- .isTRUE(ddd$fixed) } if (is.null(ddd$intercept)) { intercept <- FALSE } else { intercept <- .isTRUE(ddd$intercept) } if (is.null(ddd$joinb)) { joinb <- NULL } else { joinb <- ddd$joinb } if (is.null(ddd$joina)) { joina <- NULL } else { joina <- ddd$joina } if (.isTRUE(ddd$time)) time.start <- proc.time() ### process 'sim' argument (if TRUE, set sim to 1000, otherwise use given value) if (is.logical(sim)) { sim <- ifelse(isTRUE(sim), 1000, 0) } else { sim <- round(sim) if (sim <= 1) stop(mstyle$stop("Argument 'sim' must be >= 2.")) } ### do not allow sim and reestimate for 'rma.glmm', 'robust.rma', and 'rma.uni.selmodel' objects if (sim >= 2 && inherits(x, "rma.glmm")) stop(mstyle$stop("Cannot use 'sim' with models of class 'rma.glmm'.")) if (sim >= 2 && inherits(x, "robust.rma")) stop(mstyle$stop("Cannot use 'sim' with models of class 'robust.rma'.")) if (sim >= 2 && inherits(x, "rma.uni.selmodel")) stop(mstyle$stop("Cannot use 'sim' with models of class 'rma.uni.selmodel'.")) if (reestimate && inherits(x, "rma.glmm")) stop(mstyle$stop("Cannot use 'restimate=TRUE' with models of class 'rma.glmm'.")) if (reestimate && inherits(x, "robust.rma")) stop(mstyle$stop("Cannot use 'restimate=TRUE' with models of class 'robust.rma'.")) if (reestimate && inherits(x, "rma.uni.selmodel")) stop(mstyle$stop("Cannot use 'restimate=TRUE' with models of class 'rma.uni.selmodel'.")) ### check if btt/att have been specified bttmiss <- missing(btt) || is.null(btt) attmiss <- missing(att) || is.null(att) if (!attmiss && !inherits(x, "rma.ls")) stop(mstyle$stop("Argument 'att' only relevant for location-scale models.")) ### handle parallel (and related) arguments parallel <- match.arg(parallel, c("no", "snow", "multicore")) if (parallel == "no" && ncpus > 1) parallel <- "snow" if (missing(cl)) cl <- NULL if (!is.null(cl) && inherits(cl, "SOCKcluster")) { parallel <- "snow" ncpus <- length(cl) } if (parallel == "snow" && ncpus < 2) parallel <- "no" if (sim <= 1) parallel <- "no" if (parallel == "snow" || parallel == "multicore") { if (!requireNamespace("parallel", quietly=TRUE)) stop(mstyle$stop("Please install the 'parallel' package for parallel processing.")) ncpus <- as.integer(ncpus) if (ncpus < 1L) stop(mstyle$stop("Argument 'ncpus' must be >= 1.")) } if (parallel == "snow") { if (is.null(cl)) { cl <- parallel::makePSOCKcluster(ncpus) on.exit(parallel::stopCluster(cl), add=TRUE) } } if (!progbar) { pbo <- pbapply::pboptions(type="none") on.exit(pbapply::pboptions(pbo), add=TRUE) } ######################################################################### if (vif.loc) { ### process/set btt argument if (bttmiss) { if (x$intercept && !intercept) { btt <- as.list(2:x$p) } else { btt <- as.list(seq_len(x$p)) } } if (is.character(btt)) # turn btt=c("foo","bar") into list("foo","bar") btt <- as.list(btt) if (!is.list(btt)) btt <- list(btt) spec <- btt btt <- lapply(btt, .set.btt, x$p, x$int.incl, colnames(x$X), fixed=fixed) if (x$intercept && !intercept && any(sapply(btt, function(bttj) length(bttj) == 1L && bttj == 1L))) stop(mstyle$stop("Cannot compute VIF(s) for the specified 'btt' argument.")) ### get var-cov matrix of the fixed effects (location coefficients) vcov <- vcov(x, type="beta") ### compute (G)VIF for each element in the btt list obj <- if (reestimate) x else NULL res <- list() res$vif <- lapply(seq_along(btt), .compvif, btt=btt, vcov=vcov, xintercept=x$intercept, intercept=intercept, spec=spec, colnames=colnames(x$X), obj=obj, sim=FALSE) ### add coefficient names if (bttmiss) { names(res$vif) <- sapply(res$vif, function(x) x$coefname) } else { names(res$vif) <- sapply(res$vif, function(x) x$coefs) } ### add (G)VIFs as vector res$vifs <- sapply(res$vif, function(x) x$vif) ### add coefficient table if requested if (table && bttmiss) { res$table <- coef(summary(x), type="beta") res$test <- x$test } res$bttspec <- !bttmiss res$digits <- digits class(res) <- "vif.rma" ###################################################################### ### if sim >= 2, simulate corresponding (G)VIFs under independence sim.loc <- sim ### but skip this if all (G)VIFs are equal to 1 if (all(sapply(res$vif, function(x) x$vif) == 1, na.rm=TRUE)) sim.loc <- 0 if (sim >= 2 && any(x$coef.na)) { warning(mstyle$warning("Cannot use 'sim' when some redundant predictors were dropped from the model.")) sim.loc <- 0 } if (sim.loc >= 2) { if (parallel == "no") vif.sim <- pbapply::pblapply(seq_len(sim.loc), .compvifsim, obj=x, coef="beta", btt=btt, att=NULL, reestimate=reestimate, intercept=intercept, parallel=parallel, seed=seed, joinb=joinb) if (parallel == "multicore") vif.sim <- pbapply::pblapply(seq_len(sim.loc), .compvifsim, obj=x, coef="beta", btt=btt, att=NULL, reestimate=reestimate, intercept=intercept, parallel=parallel, seed=seed, joinb=joinb, cl=ncpus) if (parallel == "snow") { if (.isTRUE(ddd$LB)) { vif.sim <- parallel::parLapplyLB(cl, seq_len(sim.loc), .compvifsim, obj=x, coef="beta", btt=btt, att=NULL, reestimate=reestimate, intercept=intercept, parallel=parallel, seed=seed, joinb=joinb) } else { vif.sim <- pbapply::pblapply(seq_len(sim.loc), .compvifsim, obj=x, coef="beta", btt=btt, att=NULL, reestimate=reestimate, intercept=intercept, parallel=parallel, seed=seed, joinb=joinb, cl=cl) } } vif.sim <- do.call(rbind, vif.sim) rownames(vif.sim) <- seq_len(sim.loc) colnames(vif.sim) <- seq_along(btt) if (!is.null(joinb) || is.null(x$data) || is.null(x$formula.mods)) { attr(vif.sim, "type") <- "X" } else { attr(vif.sim, "type") <- "data" } res$sim <- vif.sim vifs <- sapply(res$vif, function(x) x$vif) res$prop <- apply(vifs >= t(vif.sim), 1, mean, na.rm=TRUE) } ###################################################################### } else { res <- NULL } ######################################################################### if (vif.scale) { res.loc <- res ### process/set att argument if (attmiss) { if (x$Z.intercept && !intercept) { att <- as.list(2:x$q) } else { att <- as.list(seq_len(x$q)) } } if (is.character(att)) att <- as.list(att) if (!is.list(att)) att <- list(att) spec <- att att <- lapply(att, .set.btt, x$q, x$Z.int.incl, colnames(x$Z), fixed=fixed) if (x$Z.intercept && !intercept && any(sapply(att, function(attj) length(attj) == 1L && attj == 1L))) stop(mstyle$stop("Cannot compute VIF(s) for the specified 'att' argument.")) ### get var-cov matrix of the fixed effects (scale coefficients) vcov <- vcov(x, type="alpha") ### compute (G)VIF for each element in the att list obj <- if (reestimate) x else NULL res.scale <- list() res.scale$vif <- lapply(seq_along(att), .compvif, btt=att, vcov=vcov, xintercept=x$Z.intercept, intercept=intercept, spec=spec, colnames=colnames(x$Z), obj=obj, coef="alpha", sim=FALSE) ### add coefficient names if (attmiss) { names(res.scale$vif) <- sapply(res.scale$vif, function(x) x$coefname) } else { names(res.scale$vif) <- sapply(res.scale$vif, function(x) x$coefs) } ### add (G)VIFs as vector res.scale$vifs <- sapply(res.scale$vif, function(x) x$vif) ### add coefficient table if requested if (table && attmiss) { res.scale$table <- coef(summary(x), type="alpha") res.scale$test <- x$test } res.scale$attspec <- !attmiss res.scale$digits <- digits class(res.scale) <- "vif.rma" ###################################################################### ### if sim >= 2, simulate corresponding (G)VIFs under independence sim.scale <- sim ### but skip this if all (G)VIFs are equal to 1 if (all(sapply(res.scale$vif, function(x) x$vif) == 1, na.rm=TRUE)) sim.scale <- 0 if (sim >= 2 && any(x$coef.na.Z)) { warning(mstyle$warning("Cannot use 'sim' when some redundant predictors were dropped from the model.")) sim.scale <- 0 } if (sim.scale >= 2) { if (parallel == "no") vif.sim <- pbapply::pblapply(seq_len(sim.scale), .compvifsim, obj=x, coef="alpha", btt=NULL, att=att, reestimate=reestimate, intercept=intercept, parallel=parallel, seed=seed, joina=joina) if (parallel == "multicore") vif.sim <- pbapply::pblapply(seq_len(sim.scale), .compvifsim, obj=x, coef="alpha", btt=NULL, att=att, reestimate=reestimate, intercept=intercept, parallel=parallel, seed=seed, joina=joina, cl=ncpus) if (parallel == "snow") { if (.isTRUE(ddd$LB)) { vif.sim <- parallel::parLapplyLB(cl, seq_len(sim.scale), .compvifsim, obj=x, coef="alpha", btt=NULL, att=att, reestimate=reestimate, intercept=intercept, parallel=parallel, seed=seed, joina=joina) } else { vif.sim <- pbapply::pblapply(seq_len(sim.scale), .compvifsim, obj=x, coef="alpha", btt=NULL, att=att, reestimate=reestimate, intercept=intercept, parallel=parallel, seed=seed, joina=joina, cl=cl) } } vif.sim <- do.call(rbind, vif.sim) rownames(vif.sim) <- seq_len(sim.scale) colnames(vif.sim) <- seq_along(att) if (!is.null(joina) || is.null(x$data) || is.null(x$formula.scale)) { attr(vif.sim, "type") <- "X" } else { attr(vif.sim, "type") <- "data" } res.scale$sim <- vif.sim vifs <- sapply(res.scale$vif, function(x) x$vif) res.scale$prop <- apply(vifs >= t(vif.sim), 1, mean, na.rm=TRUE) } ###################################################################### if (vif.loc) { res <- list(beta=res.loc, alpha=res.scale) class(res) <- "vif.rma" } else { res <- res.scale } } ######################################################################### if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } return(res) } metafor/R/rstudent.rma.mh.r0000644000176200001440000000543014440115117015324 0ustar liggesusersrstudent.rma.mh <- function(model, digits, progbar=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(model), must="rma.mh") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) x <- model if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } ddd <- list(...) .chkdots(ddd, c("time")) if (.isTRUE(ddd$time)) time.start <- proc.time() ######################################################################### delpred <- rep(NA_real_, x$k.f) vdelpred <- rep(NA_real_, x$k.f) ### elements that need to be returned outlist <- "beta=beta, vb=vb" ### note: skipping NA tables if (progbar) pbar <- pbapply::startpb(min=0, max=x$k.f) for (i in seq_len(x$k.f)) { if (progbar) pbapply::setpb(pbar, i) if (!x$not.na[i]) next if (is.element(x$measure, c("RR","OR","RD"))) { args <- list(ai=x$outdat.f$ai, bi=x$outdat.f$bi, ci=x$outdat.f$ci, di=x$outdat.f$di, measure=x$measure, add=x$add, to=x$to, drop00=x$drop00, correct=x$correct, level=x$level, subset=-i, outlist=outlist) } else { args <- list(x1i=x$outdat.f$x1i, x2i=x$outdat.f$x2i, t1i=x$outdat.f$t1i, t2i=x$outdat.f$t2i, measure=x$measure, add=x$add, to=x$to, drop00=x$drop00, correct=x$correct, level=x$level, subset=-i, outlist=outlist) } res <- try(suppressWarnings(.do.call(rma.mh, args)), silent=TRUE) if (inherits(res, "try-error")) next delpred[i] <- res$beta vdelpred[i] <- res$vb } if (progbar) pbapply::closepb(pbar) resid <- x$yi.f - delpred resid[abs(resid) < 100 * .Machine$double.eps] <- 0 #resid[abs(resid) < 100 * .Machine$double.eps * median(abs(resid), na.rm=TRUE)] <- 0 ### see lm.influence seresid <- sqrt(x$vi.f + vdelpred) stresid <- resid / seresid ######################################################################### if (na.act == "na.omit") { out <- list(resid=resid[x$not.na.yivi], se=seresid[x$not.na.yivi], z=stresid[x$not.na.yivi]) out$slab <- x$slab[x$not.na.yivi] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(resid=resid, se=seresid, z=stresid) out$slab <- x$slab } if (na.act == "na.fail" && any(!x$not.na.yivi)) stop(mstyle$stop("Missing values in results.")) out$digits <- digits if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(out) <- "list.rma" return(out) } metafor/R/print.infl.rma.uni.r0000644000176200001440000000200114441014751015720 0ustar liggesusersprint.infl.rma.uni <- function(x, digits=x$digits, infonly=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="infl.rma.uni") digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) if (x$p == 1) { out <- list(rstudent=x$inf$rstudent, dffits=x$inf$dffits, cook.d=x$inf$cook.d, cov.r=x$inf$cov.r, tau2.del=x$inf$tau2.del, QE.del=x$inf$QE.del, hat=x$inf$hat, weight=x$inf$weight, dfbs=x$dfbs[[1]], inf=x$inf$inf, slab=x$inf$slab, digits=digits) class(out) <- "list.rma" if (infonly) out[["select"]] <- !is.na(x$is.infl) & x$is.infl } else { out <- x[1:2] out$inf[["digits"]] <- digits out$dfbs[["digits"]] <- digits attr(out$inf, ".rmspace") <- TRUE attr(out$dfbs, ".rmspace") <- TRUE if (infonly) { out$inf[["select"]] <- !is.na(x$is.infl) & x$is.infl out$dfbs[["select"]] <- !is.na(x$is.infl) & x$is.infl } } print(out) } metafor/R/confint.rma.uni.selmodel.r0000644000176200001440000003457714430657250017134 0ustar liggesusersconfint.rma.uni.selmodel <- function(object, parm, level, fixed=FALSE, tau2, delta, digits, transf, targs, verbose=FALSE, control, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.uni.selmodel") if (!missing(parm)) warning(mstyle$warning("Argument 'parm' (currently) ignored."), call.=FALSE) x <- object if (x$betaspec) ### TODO: consider providing CIs also for this case stop(mstyle$stop("Cannot obtain confidence intervals when one or more beta values were fixed.")) k <- x$k p <- x$p if (missing(level)) level <- x$level if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL if (missing(control)) control <- list() level <- .level(level) ddd <- list(...) .chkdots(ddd, c("time", "xlim", "extint")) if (.isTRUE(ddd$time)) time.start <- proc.time() if (!is.null(ddd$xlim)) { if (length(ddd$xlim) != 2L) stop(mstyle$stop("Argument 'xlim' should be a vector of length 2.")) control$vc.min <- ddd$xlim[1] control$vc.max <- ddd$xlim[2] } ### check if user has specified one of the tau2 or delta arguments random <- !all(missing(tau2), missing(delta)) if (!fixed && !random) { ### if both 'fixed' and 'random' are FALSE, obtain CIs for tau2 and all selection model parameters cl <- match.call() ### total number of non-fixed components comps <- ifelse(!is.element(x$method, c("FE","EE","CE")) && !x$tau2.fix, 1, 0) + sum(!x$delta.fix) if (comps == 0) stop(mstyle$stop("No components for which a CI can be obtained.")) res.all <- list() j <- 0 if (!is.element(x$method, c("FE","EE","CE")) && !x$tau2.fix) { j <- j + 1 cl.vc <- cl cl.vc$tau2 <- 1 cl.vc$time <- FALSE #cl.vc$object <- quote(x) if (verbose) cat(mstyle$verbose(paste("\nObtaining CI for tau2\n"))) res.all[[j]] <- eval(cl.vc, envir=parent.frame()) } if (any(!x$delta.fix)) { for (pos in seq_len(x$deltas)[!x$delta.fix]) { j <- j + 1 cl.vc <- cl cl.vc$delta <- pos cl.vc$time <- FALSE #cl.vc$object <- quote(x) if (verbose) cat(mstyle$verbose(paste("\nObtaining CI for delta =", pos, "\n"))) res.all[[j]] <- eval(cl.vc, envir=parent.frame()) } } if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } if (length(res.all) == 1L) { return(res.all[[1]]) } else { res.all$digits <- digits class(res.all) <- "list.confint.rma" return(res.all) } } ######################################################################### ######################################################################### ######################################################################### if (random) { type <- "pl" ###################################################################### ### check if user has specified more than one of these arguments if (sum(!missing(tau2), !missing(delta)) > 1L) stop(mstyle$stop("Must specify only one of the 'tau2' or 'delta' arguments.")) ### check if model actually contains (at least one) such a component and that it was actually estimated if (!missing(tau2) && (is.element(x$method, c("FE","EE","CE")) || x$tau2.fix)) stop(mstyle$stop("Model does not contain an (estimated) 'tau2' component.")) if (!missing(delta) && all(x$delta.fix)) stop(mstyle$stop("Model does not contain any estimated 'delta' components.")) ### check if user specified more than one tau2 or delta component if (!missing(tau2) && (length(tau2) > 1L)) stop(mstyle$stop("Can only specify one 'tau2' component.")) if (!missing(delta) && (length(delta) > 1L)) stop(mstyle$stop("Can only specify one 'delta' component.")) ### check if user specified a logical if (!missing(tau2) && is.logical(tau2) && isTRUE(tau2)) tau2 <- 1 if (!missing(delta) && is.logical(delta)) stop(mstyle$stop("Must specify a number for the 'delta' component.")) ### check if user specified a component that does not exist if (!missing(tau2) && (tau2 > 1 || tau2 <= 0)) stop(mstyle$stop("No such 'tau2' component in the model.")) if (!missing(delta) && (delta > x$deltas || delta <= 0)) stop(mstyle$stop("No such 'delta' component in the model.")) ### check if user specified a component that was fixed if (!missing(tau2) && x$tau2.fix) stop(mstyle$stop("Specified 'tau2' component was fixed.")) if (!missing(delta) && x$delta.fix[delta]) stop(mstyle$stop("Specified 'delta' component was fixed.")) ### if everything is good so far, get value of the variance component and set 'comp' delta.pos <- NA_integer_ if (!missing(tau2)) { vc <- x$tau2 comp <- "tau2" tau2.pos <- 1 } if (!missing(delta)) { vc <- x$delta[delta] comp <- "delta" delta.pos <- delta } #return(list(comp=comp, vc=vc, tau2.pos=tau2.pos, delta.pos=delta.pos)) ###################################################################### ### set control parameters for uniroot() and possibly replace with user-defined values ### set vc.min and vc.max and possibly replace with user-defined values con <- list(tol=.Machine$double.eps^0.25, maxiter=1000, verbose=FALSE, eptries=10) if (comp == "tau2") { con$vc.min <- 0 con$vc.max <- min(max(ifelse(vc <= .Machine$double.eps^0.5, 10, max(10, vc*100)), con$vc.min), x$tau2.max) } if (comp == "delta") { con$vc.min <- max(0, x$delta.min[delta]) con$vc.max <- min(max(ifelse(vc <= .Machine$double.eps^0.5, 10, max(10, vc*10)), con$vc.min), x$delta.max[delta]) } con.pos <- pmatch(names(control), names(con)) con[c(na.omit(con.pos))] <- control[!is.na(con.pos)] if (verbose) con$verbose <- verbose verbose <- con$verbose ###################################################################### vc.lb <- NA_real_ vc.ub <- NA_real_ ci.null <- FALSE ### logical if CI is a null set lb.conv <- FALSE ### logical if search converged for lower bound (LB) ub.conv <- FALSE ### logical if search converged for upper bound (UB) lb.sign <- "" ### for sign in case LB must be below vc.min ("<") or above vc.max (">") ub.sign <- "" ### for sign in case UB must be below vc.min ("<") or above vc.max (">") ###################################################################### ###################################################################### ###################################################################### ### Profile Likelihood method # TODO: could also provide Wald-type CIs (ci.lb.tau2, ci.ub.tau2) and (ci.lb.delta, ci.ub.delta) if (type == "pl") { if (con$vc.min > vc) stop(mstyle$stop("Lower bound of interval to be searched must be <= estimated value of component.")) if (con$vc.max < vc) stop(mstyle$stop("Upper bound of interval to be searched must be >= estimated value of component.")) objective <- qchisq(1-level, df=1) ################################################################### ### search for lower bound ### get diff value when setting component to vc.min; this value should be positive (i.e., discrepancy must be larger than critical value) ### if it is not, then the lower bound must be below vc.min epdiff <- abs(con$vc.min - vc) / con$eptries for (i in seq_len(con$eptries)) { res <- try(.profile.rma.uni.selmodel(con$vc.min, obj=x, comp=comp, delta.pos=delta.pos, confint=TRUE, objective=objective, verbose=verbose), silent=TRUE) if (!inherits(res, "try-error") && !is.na(res)) { if (!.isTRUE(ddd$extint) && res < 0) { vc.lb <- con$vc.min lb.conv <- TRUE if (comp == "tau2" && con$vc.min > 0) lb.sign <- "<" if (comp == "delta" && con$vc.min > 0) lb.sign <- "<" } else { if (.isTRUE(ddd$extint)) { res <- try(uniroot(.profile.rma.uni.selmodel, interval=c(con$vc.min, vc), tol=con$tol, maxiter=con$maxiter, extendInt="downX", obj=x, comp=comp, delta.pos=delta.pos, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } else { res <- try(uniroot(.profile.rma.uni.selmodel, interval=c(con$vc.min, vc), tol=con$tol, maxiter=con$maxiter, obj=x, comp=comp, delta.pos=delta.pos, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } ### check if uniroot method converged if (!inherits(res, "try-error")) { vc.lb <- res lb.conv <- TRUE } } break } con$vc.min <- con$vc.min + epdiff } if (verbose) cat("\n") ################################################################### ### search for upper bound ### get diff value when setting component to vc.max; this value should be positive (i.e., discrepancy must be larger than critical value) ### if it is not, then the upper bound must be above vc.max epdiff <- abs(con$vc.max - vc) / con$eptries for (i in seq_len(con$eptries)) { res <- try(.profile.rma.uni.selmodel(con$vc.max, obj=x, comp=comp, delta.pos=delta.pos, confint=TRUE, objective=objective, verbose=verbose), silent=TRUE) if (!inherits(res, "try-error") && !is.na(res)) { if (!.isTRUE(ddd$extint) && res < 0) { vc.ub <- con$vc.max ub.conv <- TRUE if (comp == "tau2") ub.sign <- ">" if (comp == "delta") ub.sign <- ">" } else { if (.isTRUE(ddd$extint)) { res <- try(uniroot(.profile.rma.uni.selmodel, interval=c(vc, con$vc.max), tol=con$tol, maxiter=con$maxiter, extendInt="upX", obj=x, comp=comp, delta.pos=delta.pos, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } else { res <- try(uniroot(.profile.rma.uni.selmodel, interval=c(vc, con$vc.max), tol=con$tol, maxiter=con$maxiter, obj=x, comp=comp, delta.pos=delta.pos, confint=TRUE, objective=objective, verbose=verbose, check.conv=TRUE)$root, silent=TRUE) } ### check if uniroot method converged if (!inherits(res, "try-error")) { vc.ub <- res ub.conv <- TRUE } } break } con$vc.max <- con$vc.max - epdiff } ################################################################### } ###################################################################### ###################################################################### ###################################################################### if (!lb.conv) warning(mstyle$warning("Cannot obtain lower bound of profile likelihood CI due to convergence problems."), call.=FALSE) if (!ub.conv) warning(mstyle$warning("Cannot obtain upper bound of profile likelihood CI due to convergence problems."), call.=FALSE) ###################################################################### vc <- c(vc, vc.lb, vc.ub) if (comp == "tau2") { vcsqrt <- sqrt(ifelse(vc >= 0, vc, NA_real_)) res.random <- rbind(vc, vcsqrt) rownames(res.random) <- c("tau^2", "tau") } if (comp == "delta") { res.random <- rbind(vc) if (x$deltas == 1L) { rownames(res.random) <- "delta" } else { rownames(res.random) <- paste0("delta.", delta.pos) } } colnames(res.random) <- c("estimate", "ci.lb", "ci.ub") } ######################################################################### ######################################################################### ######################################################################### if (fixed) { if (is.element(x$test, c("knha","adhoc","t"))) { crit <- qt(level/2, df=x$ddf, lower.tail=FALSE) } else { crit <- qnorm(level/2, lower.tail=FALSE) } beta <- c(x$beta) ci.lb <- c(beta - crit * x$se) ci.ub <- c(beta + crit * x$se) if (is.function(transf)) { if (is.null(targs)) { beta <- sapply(beta, transf) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) } else { beta <- sapply(beta, transf, targs) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) } } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] res.fixed <- cbind(estimate=beta, ci.lb=ci.lb, ci.ub=ci.ub) rownames(res.fixed) <- rownames(x$beta) } ######################################################################### ######################################################################### ######################################################################### res <- list() if (fixed) res$fixed <- res.fixed if (random) res$random <- res.random res$digits <- digits if (random) { res$ci.null <- ci.null res$lb.sign <- lb.sign res$ub.sign <- ub.sign #res$vc.min <- con$vc.min } if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(res) <- "confint.rma" return(res) } metafor/R/rstudent.rma.mv.r0000644000176200001440000001466414441014516015355 0ustar liggesusersrstudent.rma.mv <- function(model, digits, progbar=FALSE, cluster, reestimate=TRUE, parallel="no", ncpus=1, cl, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(model), must="rma.mv", notav="robust.rma") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) x <- model parallel <- match.arg(parallel, c("no", "snow", "multicore")) if (parallel == "no" && ncpus > 1) parallel <- "snow" if (missing(cl)) cl <- NULL if (!is.null(cl) && inherits(cl, "SOCKcluster")) { parallel <- "snow" ncpus <- length(cl) } if (parallel == "snow" && ncpus < 2) parallel <- "no" if (parallel == "snow" || parallel == "multicore") { if (!requireNamespace("parallel", quietly=TRUE)) stop(mstyle$stop("Please install the 'parallel' package for parallel processing.")) ncpus <- as.integer(ncpus) if (ncpus < 1L) stop(mstyle$stop("Argument 'ncpus' must be >= 1.")) } if (!progbar) { pbo <- pbapply::pboptions(type="none") on.exit(pbapply::pboptions(pbo), add=TRUE) } if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } misscluster <- ifelse(missing(cluster), TRUE, FALSE) if (misscluster) { cluster <- seq_len(x$k.all) } else { mf <- match.call() cluster <- .getx("cluster", mf=mf, data=x$data) } ddd <- list(...) .chkdots(ddd, c("time", "LB")) if (.isTRUE(ddd$time)) time.start <- proc.time() ######################################################################### ### process cluster variable # note: cluster variable is assumed to be of the same length as the size of # the original dataset passed to the model fitting function and so we apply # the same subsetting and removing of missings (if necessary) as was done # during model fitting if (length(cluster) != x$k.all) stop(mstyle$stop(paste0("Length of variable specified via 'cluster' (", length(cluster), ") does not match length of data (", x$k.all, ")."))) cluster <- .getsubset(cluster, x$subset) cluster.f <- cluster cluster <- cluster[x$not.na] ### checks on cluster variable if (anyNA(cluster.f)) stop(mstyle$stop("No missing values allowed in 'cluster' variable.")) if (length(cluster.f) == 0L) stop(mstyle$stop(paste0("Cannot find 'cluster' variable (or it has zero length)."))) ### cluster ids and number of clusters ids <- unique(cluster) n <- length(ids) ######################################################################### if (parallel == "no") res <- pbapply::pblapply(seq_len(n), .rstudent.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate) if (parallel == "multicore") res <- pbapply::pblapply(seq_len(n), .rstudent.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate, cl=ncpus) #res <- parallel::mclapply(seq_len(n), .rstudent.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate, mc.cores=ncpus) if (parallel == "snow") { if (is.null(cl)) { cl <- parallel::makePSOCKcluster(ncpus) on.exit(parallel::stopCluster(cl), add=TRUE) } if (.isTRUE(ddd$LB)) { res <- parallel::parLapplyLB(cl, seq_len(n), .rstudent.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate) #res <- parallel::clusterApplyLB(cl, seq_len(n), .rstudent.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate) } else { res <- pbapply::pblapply(seq_len(n), .rstudent.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate, cl=cl) #res <- parallel::parLapply(cl, seq_len(n), .rstudent.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate) #res <- parallel::clusterApply(cl, seq_len(n), .rstudent.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate) } } delresid <- rep(NA_real_, x$k) sedelresid <- rep(NA_real_, x$k) pos <- unlist(sapply(res, function(x) x$pos)) delresid[pos] <- unlist(sapply(res, function(x) x$delresid)) sedelresid[pos] <- unlist(sapply(res, function(x) x$sedelresid)) X2 <- sapply(res, function(x) x$X2) k.id <- sapply(res, function(x) x$k.id) ######################################################################### delresid[abs(delresid) < 100 * .Machine$double.eps] <- 0 resid <- rep(NA_real_, x$k.f) seresid <- rep(NA_real_, x$k.f) resid[x$not.na] <- delresid seresid[x$not.na] <- sedelresid stresid <- resid / seresid ######################################################################### if (na.act == "na.omit") { out <- list(resid=resid[x$not.na], se=seresid[x$not.na], z=stresid[x$not.na]) if (!misscluster) out$cluster <- cluster.f[x$not.na] out$slab <- x$slab[x$not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(resid=resid, se=seresid, z=stresid) if (!misscluster) out$cluster <- cluster.f out$slab <- x$slab } if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } if (misscluster) { out$digits <- digits class(out) <- "list.rma" return(out) } else { out <- list(out) if (na.act == "na.omit") { out[[2]] <- list(X2=X2[order(ids)], k=k.id[order(ids)], slab=ids[order(ids)]) } if (na.act == "na.exclude" || na.act == "na.pass") { ids.f <- unique(cluster.f) X2.f <- rep(NA_real_, length(ids.f)) X2.f[match(ids, ids.f)] <- X2 k.id.f <- sapply(ids.f, function(id) sum((id == cluster.f) & x$not.na)) out[[2]] <- list(X2=X2.f[order(ids.f)], k=k.id.f[order(ids.f)], slab=ids.f[order(ids.f)]) } out[[1]]$digits <- digits out[[2]]$digits <- digits names(out) <- c("obs", "cluster") class(out[[1]]) <- "list.rma" class(out[[2]]) <- "list.rma" attr(out[[1]], ".rmspace") <- TRUE attr(out[[2]], ".rmspace") <- TRUE return(out) } } metafor/R/funnel.default.r0000644000176200001440000005162414473445045015227 0ustar liggesusersfunnel.default <- function(x, vi, sei, ni, subset, yaxis="sei", xlim, ylim, xlab, ylab, slab, steps=5, at, atransf, targs, digits, level=95, back, shade, hlines, refline=0, lty=3, pch, col, bg, label=FALSE, offset=0.4, legend=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (missing(subset)) subset <- NULL yaxis <- match.arg(yaxis, c("sei", "vi", "seinv", "vinv", "ni", "ninv", "sqrtni", "sqrtninv", "lni", "wi")) if (missing(atransf)) atransf <- FALSE atransf.char <- deparse(atransf) if (anyNA(level) || is.null(level)) stop(mstyle$stop("Argument 'level' cannot be NA or NULL.")) .start.plot() if (missing(back)) back <- .coladj(par("bg","fg"), dark=0.1, light=-0.2) if (missing(shade)) shade <- .coladj(par("bg","fg"), dark=c(0.2,-0.8), light=c(0,1)) if (length(level) > 1L && length(shade) == 1L) shade <- rep(shade, length(level)) if (missing(hlines)) hlines <- par("bg") if (is.null(refline)) refline <- NA if (missing(pch)) pch <- 19 yi <- x k <- length(yi) ### check if sample size information is available if plotting (some function of) of the sample sizes on the y-axis if (missing(ni)) ni <- NULL if (is.element(yaxis, c("ni", "ninv", "sqrtni", "sqrtninv", "lni"))) { if (is.null(ni)) ni <- attr(yi, "ni") if (!is.null(ni) && length(ni) != k) stop(mstyle$stop(paste0("Length of the 'ni' argument (", length(ni), ") does not correspond to the number of outcomes (", k, ")."))) if (is.null(ni)) stop(mstyle$stop("No sample size information available.")) } ### check if sampling variances and/or standard errors are available if (missing(vi)) vi <- NULL if (is.function(vi)) # if vi is utils::vi() stop(mstyle$stop("Cannot find variable specified for 'vi' argument."), call.=FALSE) if (missing(sei)) sei <- NULL if (is.null(vi)) { if (!is.null(sei)) vi <- sei^2 } if (is.null(sei)) { if (!is.null(vi)) sei <- sqrt(vi) } if (is.element(yaxis, c("sei", "vi", "seinv", "vinv", "wi"))) { if (is.null(vi)) stop(mstyle$stop("Must specify 'vi' or 'sei' argument.")) if (length(vi) != k) stop(mstyle$stop("Length of 'yi' and 'vi' (or 'sei') is not the same.")) } ### set negative variances and/or standard errors to 0 if (!is.null(vi)) vi[vi < 0] <- 0 if (!is.null(sei)) sei[sei < 0] <- 0 ### if unspecified, get slab from attributes of yi; if not available or it doesn't have the right length, set slab <- 1:k if (missing(slab)) { slab <- attr(yi, "slab") if (is.null(slab) || length(slab) != k) slab <- seq_along(yi) } if (length(slab) != k) stop(mstyle$stop(paste0("Length of the 'slab' argument (", length(slab), ") does not correspond to the number of outcomes (", k, ")."))) ### set y-axis label if not specified if (missing(ylab)) { if (yaxis == "sei") ylab <- "Standard Error" if (yaxis == "vi") ylab <- "Variance" if (yaxis == "seinv") ylab <- "Inverse Standard Error" if (yaxis == "vinv") ylab <- "Inverse Variance" if (yaxis == "ni") ylab <- "Sample Size" if (yaxis == "ninv") ylab <- "Inverse Sample Size" if (yaxis == "sqrtni") ylab <- "Square Root Sample Size" if (yaxis == "sqrtninv") ylab <- "Inverse Square Root Sample Size" if (yaxis == "lni") ylab <- "Log Sample Size" if (yaxis == "wi") ylab <- "Weight (in %)" } if (missing(at)) at <- NULL if (missing(targs)) targs <- NULL ### default number of digits (if not specified) if (missing(digits)) { if (yaxis == "sei") digits <- c(2L,3L) if (yaxis == "vi") digits <- c(2L,3L) if (yaxis == "seinv") digits <- c(2L,3L) if (yaxis == "vinv") digits <- c(2L,3L) if (yaxis == "ni") digits <- c(2L,0L) if (yaxis == "ninv") digits <- c(2L,3L) if (yaxis == "sqrtni") digits <- c(2L,3L) if (yaxis == "sqrtninv") digits <- c(2L,3L) if (yaxis == "lni") digits <- c(2L,3L) if (yaxis == "wi") digits <- c(2L,2L) } else { if (length(digits) == 1L) # digits[1] for x-axis labels digits <- c(digits,digits) # digits[2] for y-axis labels } ### note: digits can also be a list (e.g., digits=list(2L,3)); trailing 0's are dropped for integers if (length(lty) == 1L) lty <- rep(lty, 2L) # 1st value = funnel lines, 2nd value = reference line if (length(pch) == 1L) { pch.vec <- FALSE pch <- rep(pch, k) } else { pch.vec <- TRUE } if (length(pch) != k) stop(mstyle$stop(paste0("Length of the 'pch' argument (", length(pch), ") does not correspond to the number of outcomes (", k, ")."))) if (missing(col)) col <- par("fg") if (length(col) == 1L) { col.vec <- FALSE col <- rep(col, k) } else { col.vec <- TRUE } if (length(col) != k) stop(mstyle$stop(paste0("Length of the 'col' argument (", length(col), ") does not correspond to the number of outcomes (", k, ")."))) if (missing(bg)) bg <- .coladj(par("bg","fg"), dark=0.1, light=-0.1) if (length(bg) == 1L) { bg.vec <- FALSE bg <- rep(bg, k) } else { bg.vec <- TRUE } if (length(bg) != k) stop(mstyle$stop(paste0("Length of the 'bg' argument (", length(bg), ") does not correspond to the number of outcomes (", k, ")."))) if (length(label) != 1L) stop(mstyle$stop("Argument 'label' should be of length 1.")) ddd <- list(...) if (!is.null(ddd$transf)) warning("Function does not have a 'transf' argument (use 'atransf' instead).", call.=FALSE, immediate.=TRUE) lplot <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) plot(...) labline <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) abline(...) lsegments <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) segments(...) laxis <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) axis(...) lpolygon <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) polygon(...) llines <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) lines(...) lpoints <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) points(...) lrect <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) rect(...) ltext <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res) text(...) ### refline2, level2, and lty2 for adding a second reference line / funnel if (!is.null(ddd$refline2)) { refline2 <- ddd$refline2 } else { refline2 <- NULL } if (!is.null(ddd$level2)) { level2 <- ddd$level2 } else { level2 <- 95 } if (!is.null(ddd$lty2)) { lty2 <- ddd$lty2 } else { lty2 <- 3 } ### number of y-axis values at which to calculate the bounds of the pseudo confidence interval if (!is.null(ddd$ci.res)) { ci.res <- ddd$ci.res } else { ci.res <- 1000 } ### to adjust color of reference line, region bounds, and the L box if (!is.null(ddd$colref)) { colref <- ddd$colref } else { colref <- .coladj(par("bg","fg"), dark=0.6, light=-0.6) } if (!is.null(ddd$colci)) { colci <- ddd$colci } else { colci <- .coladj(par("bg","fg"), dark=0.6, light=-0.6) } if (!is.null(ddd$colbox)) { colbox <- ddd$colbox } else { colbox <- .coladj(par("bg","fg"), dark=0.6, light=-0.6) } ######################################################################### ### if a subset of studies is specified if (!is.null(subset)) { subset <- .chksubset(subset, length(yi)) yi <- .getsubset(yi, subset) vi <- .getsubset(vi, subset) sei <- .getsubset(sei, subset) ni <- .getsubset(ni, subset) slab <- .getsubset(slab, subset) pch <- .getsubset(pch, subset) col <- .getsubset(col, subset) bg <- .getsubset(bg, subset) } ### check for NAs and act accordingly has.na <- is.na(yi) | (if (is.element(yaxis, c("vi", "vinv"))) is.na(vi) else FALSE) | (if (is.element(yaxis, c("sei", "seinv"))) is.na(vi) else FALSE) | (if (is.element(yaxis, c("ni", "ninv", "sqrtni", "sqrtninv", "lni"))) is.na(ni) else FALSE) if (any(has.na)) { not.na <- !has.na if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { yi <- yi[not.na] vi <- vi[not.na] sei <- sei[not.na] ni <- ni[not.na] slab <- slab[not.na] pch <- pch[not.na] col <- col[not.na] bg <- bg[not.na] } if (na.act == "na.fail") stop(mstyle$stop("Missing values in data.")) } if (missing(xlab)) xlab <- .setlab(attr(yi, "measure"), transf.char="FALSE", atransf.char, gentype=1) ### at least two studies left? if (length(yi) < 2L) stop(mstyle$stop("Plotting terminated since k < 2.")) ### get weights if (yaxis == "wi") { if (any(vi <= 0)) stop(mstyle$stop("Cannot plot weights when there are non-positive sampling variances in the data.")) weights <- 1/vi weights <- weights / sum(weights) * 100 } ######################################################################### ### set y-axis limits if (missing(ylim)) { ### 1st ylim value is always the lowest precision (should be at the bottom of the plot) ### 2nd ylim value is always the highest precision (should be at the top of the plot) if (yaxis == "sei") ylim <- c(max(sei), 0) if (yaxis == "vi") ylim <- c(max(vi), 0) if (yaxis == "seinv") ylim <- c(min(1/sei), max(1/sei)) if (yaxis == "vinv") ylim <- c(min(1/vi), max(1/vi)) if (yaxis == "ni") ylim <- c(min(ni), max(ni)) if (yaxis == "ninv") ylim <- c(max(1/ni), min(1/ni)) if (yaxis == "sqrtni") ylim <- c(min(sqrt(ni)), max(sqrt(ni))) if (yaxis == "sqrtninv") ylim <- c(max(1/sqrt(ni)), min(1/sqrt(ni))) if (yaxis == "lni") ylim <- c(min(log(ni)), max(log(ni))) if (yaxis == "wi") ylim <- c(min(weights), max(weights)) ### infinite y-axis limits can happen with "seinv" and "vinv" when one or more sampling variances are 0 if (any(is.infinite(ylim))) stop(mstyle$stop("Setting 'ylim' automatically not possible (must set y-axis limits manually).")) } else { ### make sure that user supplied limits are in the right order if (is.element(yaxis, c("sei", "vi", "ninv", "sqrtninv"))) ylim <- c(max(ylim), min(ylim)) if (is.element(yaxis, c("seinv", "vinv", "ni", "sqrtni", "lni", "wi"))) ylim <- c(min(ylim), max(ylim)) ### make sure that user supplied limits are in the appropriate range if (is.element(yaxis, c("sei", "vi", "ni", "ninv", "sqrtni", "sqrtninv", "lni"))) { if (ylim[1] < 0 || ylim[2] < 0) stop(mstyle$stop("Both y-axis limits must be >= 0.")) } if (is.element(yaxis, c("seinv", "vinv"))) { if (ylim[1] <= 0 || ylim[2] <= 0) stop(mstyle$stop("Both y-axis limits must be > 0.")) } if (is.element(yaxis, c("wi"))) { if (ylim[1] < 0 || ylim[2] < 0) stop(mstyle$stop("Both y-axis limits must be >= 0.")) } } ######################################################################### ### set x-axis limits if (is.element(yaxis, c("sei", "vi", "seinv", "vinv"))) { level <- ifelse(level == 0, 1, ifelse(level >= 1, (100-level)/100, ifelse(level > .5, 1-level, level))) level2 <- ifelse(level2 == 0, 1, ifelse(level2 >= 1, (100-level2)/100, ifelse(level2 > .5, 1-level2, level2))) #level <- ifelse(level >= 1, (100-level)/100, ifelse(level > .5, 1-level, level)) # note: there may be multiple level values level.min <- min(level) # note: smallest level is the widest CI lvals <- length(level) ### calculate the CI bounds at the bottom of the figure (for the widest CI if there are multiple) if (yaxis == "sei") { x.lb.bot <- refline - qnorm(level.min/2, lower.tail=FALSE) * sqrt(ylim[1]^2) x.ub.bot <- refline + qnorm(level.min/2, lower.tail=FALSE) * sqrt(ylim[1]^2) } if (yaxis == "vi") { x.lb.bot <- refline - qnorm(level.min/2, lower.tail=FALSE) * sqrt(ylim[1]) x.ub.bot <- refline + qnorm(level.min/2, lower.tail=FALSE) * sqrt(ylim[1]) } if (yaxis == "seinv") { x.lb.bot <- refline - qnorm(level.min/2, lower.tail=FALSE) * sqrt(1/ylim[1]^2) x.ub.bot <- refline + qnorm(level.min/2, lower.tail=FALSE) * sqrt(1/ylim[1]^2) } if (yaxis == "vinv") { x.lb.bot <- refline - qnorm(level.min/2, lower.tail=FALSE) * sqrt(1/ylim[1]) x.ub.bot <- refline + qnorm(level.min/2, lower.tail=FALSE) * sqrt(1/ylim[1]) } if (missing(xlim)) { xlim <- c(min(x.lb.bot,min(yi),na.rm=TRUE), max(x.ub.bot,max(yi),na.rm=TRUE)) # make sure x-axis not only includes widest CI, but also all yi values rxlim <- xlim[2] - xlim[1] # calculate range of the x-axis limits xlim[1] <- xlim[1] - (rxlim * 0.10) # subtract 10% of range from lower x-axis bound xlim[2] <- xlim[2] + (rxlim * 0.10) # add 10% of range to upper x-axis bound } else { xlim <- sort(xlim) # just in case the user supplies the limits in the wrong order } } if (is.element(yaxis, c("ni", "ninv", "sqrtni", "sqrtninv", "lni", "wi"))) { if (missing(xlim)) { xlim <- c(min(yi), max(yi)) rxlim <- xlim[2] - xlim[1] # calculate range of the x-axis limits xlim[1] <- xlim[1] - (rxlim * 0.10) # subtract 10% of range from lower x-axis bound xlim[2] <- xlim[2] + (rxlim * 0.10) # add 10% of range to upper x-axis bound } else { xlim <- sort(xlim) # just in case the user supplies the limits in the wrong order } } ### if user has specified 'at' argument, make sure xlim actually contains the min and max 'at' values if (!is.null(at)) { xlim[1] <- min(c(xlim[1], at), na.rm=TRUE) xlim[2] <- max(c(xlim[2], at), na.rm=TRUE) } ######################################################################### ### set up plot lplot(NA, NA, xlim=xlim, ylim=ylim, xlab=xlab, ylab=ylab, xaxt="n", yaxt="n", bty="n", ...) ### add background shading par.usr <- par("usr") lrect(par.usr[1], par.usr[3], par.usr[2], par.usr[4], col=back, border=NA, ...) ### add y-axis laxis(side=2, at=seq(from=ylim[1], to=ylim[2], length.out=steps), labels=fmtx(seq(from=ylim[1], to=ylim[2], length.out=steps), digits[[2]], drop0ifint=TRUE), ...) ### add horizontal lines labline(h=seq(from=ylim[1], to=ylim[2], length.out=steps), col=hlines, ...) ######################################################################### ### add CI region(s) if (is.element(yaxis, c("sei", "vi", "seinv", "vinv"))) { ### add a bit to the top/bottom ylim so that the CI region(s) fill out the entire figure if (yaxis == "sei") { rylim <- ylim[1] - ylim[2] ylim[1] <- ylim[1] + (rylim * 0.10) ylim[2] <- max(0, ylim[2] - (rylim * 0.10)) } if (yaxis == "vi") { rylim <- ylim[1] - ylim[2] ylim[1] <- ylim[1] + (rylim * 0.10) ylim[2] <- max(0, ylim[2] - (rylim * 0.10)) } if (yaxis == "seinv") { rylim <- ylim[2] - ylim[1] #ylim[1] <- max(.0001, ylim[1] - (rylim * 0.10)) # not clear how much to add to bottom ylim[2] <- ylim[2] + (rylim * 0.10) } if (yaxis == "vinv") { rylim <- ylim[2] - ylim[1] #ylim[1] <- max(.0001, ylim[1] - (rylim * 0.10)) # not clear how much to add to bottom ylim[2] <- ylim[2] + (rylim * 0.10) } yi.vals <- seq(from=ylim[1], to=ylim[2], length.out=ci.res) if (yaxis == "sei") vi.vals <- yi.vals^2 if (yaxis == "vi") vi.vals <- yi.vals if (yaxis == "seinv") vi.vals <- 1/yi.vals^2 if (yaxis == "vinv") vi.vals <- 1/yi.vals for (m in lvals:1) { ci.left <- refline - qnorm(level[m]/2, lower.tail=FALSE) * sqrt(vi.vals) ci.right <- refline + qnorm(level[m]/2, lower.tail=FALSE) * sqrt(vi.vals) lpolygon(c(ci.left,ci.right[ci.res:1]), c(yi.vals,yi.vals[ci.res:1]), border=NA, col=shade[m], ...) llines(ci.left, yi.vals, lty=lty[1], col=colci, ...) llines(ci.right, yi.vals, lty=lty[1], col=colci, ...) } if (!is.null(refline2)) { ci.left <- refline2 - qnorm(level2/2, lower.tail=FALSE) * sqrt(vi.vals) ci.right <- refline2 + qnorm(level2/2, lower.tail=FALSE) * sqrt(vi.vals) llines(ci.left, yi.vals, lty=lty2, col=colci, ...) llines(ci.right, yi.vals, lty=lty2, col=colci, ...) } } ### add vertical reference line ### use segments so that line does not extent beyond tip of CI region if (is.element(yaxis, c("sei", "vi", "seinv", "vinv"))) lsegments(refline, ylim[1], refline, ylim[2], lty=lty[2], col=colref, ...) if (is.element(yaxis, c("ni", "ninv", "sqrtni", "sqrtninv", "lni", "wi"))) labline(v=refline, lty=lty[2], col=colref, ...) ######################################################################### ### add points xaxis.vals <- yi if (yaxis == "sei") yaxis.vals <- sei if (yaxis == "vi") yaxis.vals <- vi if (yaxis == "seinv") yaxis.vals <- 1/sei if (yaxis == "vinv") yaxis.vals <- 1/vi if (yaxis == "ni") yaxis.vals <- ni if (yaxis == "ninv") yaxis.vals <- 1/ni if (yaxis == "sqrtni") yaxis.vals <- sqrt(ni) if (yaxis == "sqrtninv") yaxis.vals <- 1/sqrt(ni) if (yaxis == "lni") yaxis.vals <- log(ni) if (yaxis == "wi") yaxis.vals <- weights lpoints(x=xaxis.vals, y=yaxis.vals, pch=pch, col=col, bg=bg, ...) ######################################################################### ### add L-shaped box around plot if (!is.na(colbox)) box(bty="l", col=colbox) ### generate x-axis positions if none are specified if (is.null(at)) { at <- axTicks(side=1) #at <- pretty(x=c(alim[1], alim[2]), n=steps-1) #at <- pretty(x=c(min(ci.lb), max(ci.ub)), n=steps-1) } else { at <- at[at > par("usr")[1]] at <- at[at < par("usr")[2]] } at.lab <- at if (is.function(atransf)) { if (is.null(targs)) { at.lab <- fmtx(sapply(at.lab, atransf), digits[[1]], drop0ifint=TRUE) } else { at.lab <- fmtx(sapply(at.lab, atransf, targs), digits[[1]], drop0ifint=TRUE) } } else { at.lab <- fmtx(at.lab, digits[[1]], drop0ifint=TRUE) } ### add x-axis laxis(side=1, at=at, labels=at.lab, ...) ############################################################################ ### labeling of points k <- length(yi) if (is.numeric(label) || is.character(label) || .isTRUE(label)) { if (is.na(refline)) refline <- mean(yi, na.rm=TRUE) if (is.numeric(label)) { label <- round(label) if (label < 0) label <- 0 if (label > k) label <- k label <- order(abs(yi - refline), decreasing=TRUE)[seq_len(label)] } else if ((is.character(label) && label == "all") || .isTRUE(label)) { label <- seq_len(k) } else if ((is.character(label) && label == "out")) { if (!is.element(yaxis, c("sei", "vi", "seinv", "vinv"))) { label <- seq_len(k) } else { label <- which(abs(yi - refline) / sqrt(vi) >= qnorm(level.min/2, lower.tail=FALSE)) } } else { label <- NULL } for (i in label) ltext(yi[i], yaxis.vals[i], slab[i], pos=ifelse(yi[i]-refline >= 0, 4, 2), offset=offset, ...) } ######################################################################### ### add legend (if requested) .funnel.legend(legend, level, shade, back, yaxis, trimfill=FALSE, pch, col, bg, pch.fill=NA, pch.vec, col.vec, bg.vec, colci) ############################################################################ ### prepare data frame to return sav <- data.frame(x=xaxis.vals, y=yaxis.vals, slab=slab, stringsAsFactors=FALSE) invisible(sav) } metafor/R/df.residual.rma.r0000644000176200001440000000031513770363257015265 0ustar liggesusersdf.residual.rma <- function(object, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma") df.resid <- object$k.eff - object$p.eff return(df.resid) } metafor/R/rstandard.rma.mh.r0000644000176200001440000000273613770377025015461 0ustar liggesusersrstandard.rma.mh <- function(model, digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(model), must="rma.mh") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) x <- model if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } ######################################################################### resid <- c(x$yi.f - x$beta) resid[abs(resid) < 100 * .Machine$double.eps] <- 0 #resid[abs(resid) < 100 * .Machine$double.eps * median(abs(resid), na.rm=TRUE)] <- 0 ### see lm.influence ### note: these are like Pearson (or semi-standardized) residuals seresid <- sqrt(x$vi.f) stresid <- resid / seresid ######################################################################### if (na.act == "na.omit") { out <- list(resid=resid[x$not.na.yivi], se=seresid[x$not.na.yivi], z=stresid[x$not.na.yivi]) out$slab <- x$slab[x$not.na.yivi] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(resid=resid, se=seresid, z=stresid) out$slab <- x$slab } if (na.act == "na.fail" && any(!x$not.na.yivi)) stop(mstyle$stop("Missing values in results.")) out$digits <- digits class(out) <- "list.rma" return(out) } metafor/R/funnel.r0000644000176200001440000000006214167240043013561 0ustar liggesusersfunnel <- function(x, ...) UseMethod("funnel") metafor/R/print.summary.rma.r0000644000176200001440000000107114434141762015706 0ustar liggesusersprint.summary.rma <- function(x, digits=x$digits, showfit=TRUE, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="summary.rma") digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) ### strip summary.rma class from object (otherwise get recursion) class(x) <- class(x)[-1] ### print with showfit=TRUE print(x, digits=digits, showfit=showfit, signif.stars=signif.stars, signif.legend=signif.legend, ...) invisible() } metafor/R/hatvalues.rma.uni.r0000644000176200001440000000377114245746344015664 0ustar liggesusershatvalues.rma.uni <- function(model, type="diagonal", ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(model), must="rma.uni", notav=c("rma.uni.selmodel", "rma.gen")) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) type <- match.arg(type, c("diagonal", "matrix")) ######################################################################### x <- model if (x$weighted) { if (is.null(x$weights)) { W <- diag(1/(x$vi + x$tau2), nrow=x$k, ncol=x$k) stXWX <- .invcalc(X=x$X, W=W, k=x$k) H <- x$X %*% stXWX %*% crossprod(x$X,W) #H <- x$X %*% (x$vb / x$s2w) %*% crossprod(x$X,W) ### x$vb may be changed through robust() (and when test="knha") } else { A <- diag(x$weights, nrow=x$k, ncol=x$k) stXAX <- .invcalc(X=x$X, W=A, k=x$k) H <- x$X %*% stXAX %*% crossprod(x$X,A) } } else { stXX <- .invcalc(X=x$X, W=diag(x$k), k=x$k) H <- x$X %*% tcrossprod(stXX,x$X) } ######################################################################### if (type == "diagonal") { hii <- rep(NA_real_, x$k.f) hii[x$not.na] <- diag(H) hii[hii > 1 - 10 * .Machine$double.eps] <- 1 ### as in lm.influence() names(hii) <- x$slab if (na.act == "na.omit") hii <- hii[x$not.na] if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) return(hii) } if (type == "matrix") { Hfull <- matrix(NA_real_, nrow=x$k.f, ncol=x$k.f) Hfull[x$not.na, x$not.na] <- H rownames(Hfull) <- x$slab colnames(Hfull) <- x$slab if (na.act == "na.omit") Hfull <- Hfull[x$not.na, x$not.na, drop=FALSE] if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) return(Hfull) } } metafor/R/selmodel.rma.uni.r0000644000176200001440000013204414442615224015457 0ustar liggesusersselmodel.rma.uni <- function(x, type, alternative="greater", prec, delta, steps, verbose=FALSE, digits, control, ...) { # TODO: add a H0 argument? since p-value may not be based on H0: theta_i = 0 # TODO: argument for which deltas to include in LRT (a delta may also not be constrained under H0, so it should not be included in the LRT then) mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.uni", notav=c("rma.ls", "rma.gen", "robust.rma")) alternative <- match.arg(alternative, c("two.sided", "greater", "less")) if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } time.start <- proc.time() if (!x$allvipos) stop(mstyle$stop("Cannot fit selection model when one or more sampling variances are non-positive.")) if (!x$weighted || !is.null(x$weights)) stop(mstyle$stop("Cannot fit selection model for unweighted models or models with custom weights.")) if (missing(type)) stop(mstyle$stop("Must choose a specific selection model via the 'type' argument.")) type.options <- c("beta", "halfnorm", "negexp", "logistic", "power", "negexppow", "halfnorm2", "negexp2", "logistic2", "power2", "stepfun", "trunc", "truncest") #type <- match.arg(type, type.options) type <- type.options[grep(type, type.options)[1]] if (is.na(type)) stop(mstyle$stop("Unknown 'type' specified.")) if (is.element(type, c("trunc","truncest")) && alternative == "two.sided") stop(mstyle$stop("Cannot use alternative='two-sided' with this type of selection model.")) if (missing(control)) control <- list() ### refit RE/ME models with ML estimation if (!is.element(x$method, c("FE","EE","CE","ML"))) { #stop(mstyle$stop("Argument 'x' must either be an equal/fixed-effects model or a model fitted with ML estimation.")) #x <- try(update(x, method="ML"), silent=TRUE) #x <- suppressWarnings(update(x, method="ML")) #x <- try(suppressWarnings(rma.uni(x$yi, x$vi, weights=x$weights, mods=x$X, intercept=FALSE, method="ML", weighted=x$weighted, test=x$test, level=x$level, tau2=ifelse(x$tau2.fix, x$tau2, NA), control=x$control, skipr2=TRUE)), silent=TRUE) args <- list(yi=x$yi, vi=x$vi, weights=x$weights, mods=x$X, intercept=FALSE, method="ML", weighted=x$weighted, test=x$test, level=x$level, tau2=ifelse(x$tau2.fix, x$tau2, NA), control=x$control, skipr2=TRUE) x <- try(suppressWarnings(.do.call(rma.uni, args)), silent=TRUE) if (inherits(x, "try-error")) stop(mstyle$stop("Could not refit input model using method='ML'.")) } ### get ... argument and check for extra/superfluous arguments ddd <- list(...) .chkdots(ddd, c("time", "tau2", "beta", "skiphes", "skiphet", "skipintcheck", "scaleprec", "defmap", "mapfun", "mapinvfun")) ### handle 'tau2' argument from ... if (is.null(ddd$tau2)) { if (is.element(x$method, c("FE","EE","CE"))) { tau2 <- 0 } else { if (x$tau2.fix) { tau2 <- x$tau2 } else { tau2 <- NA_real_ } } } else { tau2 <- ddd$tau2 if (!is.na(tau2)) x$tau2.fix <- TRUE } ### handle 'beta' argument from ... if (is.null(ddd$beta)) { beta <- rep(NA_real_, x$p) betaspec <- FALSE } else { beta <- ddd$beta betaspec <- TRUE } yi <- c(x$yi) vi <- x$vi X <- x$X p <- x$p k <- x$k ### set precision measure if (!missing(prec) && !is.null(prec)) { precspec <- TRUE prec <- match.arg(prec, c("sei", "vi", "ninv", "sqrtninv")) ### check if sample size information is available if prec is "ninv" or "sqrtninv" if (is.element(prec, c("ninv", "sqrtninv"))) { if (is.null(x$ni) || anyNA(x$ni)) stop(mstyle$stop("No sample size information stored in model object (or sample size information stored in model object contains NAs).")) } if (prec == "sei") preci <- sqrt(vi) if (prec == "vi") preci <- vi if (prec == "ninv") preci <- 1/x$ni if (prec == "sqrtninv") preci <- 1/sqrt(x$ni) if (is.null(ddd$scaleprec) || isTRUE(ddd$scaleprec)) preci <- preci / max(preci) } else { precspec <- FALSE prec <- NULL preci <- rep(1, k) } precis <- c(min = min(preci), max = max(preci), mean = mean(preci), median = median(preci)) ### compute p-values pvals <- .selmodel.pval(yi=yi, vi=vi, alternative=alternative) ### checks on steps argument if (missing(steps) || (length(steps) == 1L && is.na(steps))) { stepsspec <- FALSE steps <- NA_real_ } else { stepsspec <- TRUE if (anyNA(steps)) stop(mstyle$stop("No missing values allowed in 'steps' argument.")) if (type != "trunc" && any(steps < 0 | steps > 1)) stop(mstyle$stop("Value(s) specified for 'steps' argument must be between 0 and 1.")) steps <- unique(sort(steps)) if (type != "trunc" && steps[length(steps)] != 1) steps <- c(steps, 1) } if (type == "trunc" && !stepsspec) { stepsspec <- TRUE #if (alternative == "greater") # steps <- min(yi) #if (alternative == "less") # steps <- max(yi) steps <- 0 } if (is.element(type, c("trunc","truncest")) && verbose > 2) { warning(mstyle$warning("Cannot use 'verbose > 2' for this type of selection model (setting verbose=2)."), call.=FALSE) verbose <- 2 } ############################################################################ ### set default control parameters con <- list(verbose = FALSE, delta.init = NULL, # initial value(s) for selection model parameter(s) beta.init = NULL, # initial value(s) for fixed effect(s) tau2.init = NULL, # initial value for tau^2 delta.min = NULL, # min possible value(s) for selection model parameter(s) delta.max = NULL, # max possible value(s) for selection model parameter(s) tau2.max = Inf, # max possible value for tau^2 tau2tol = min(vi/10, 1e-04), # threshold for treating tau^2 values as effectively equal to 0 pval.min = NULL, # minimum p-value to intergrate over (for selection models where this matters) optimizer = "optim", # optimizer to use ("optim","nlminb","uobyqa","newuoa","bobyqa","nloptr","nlm","hjk","nmk","mads","ucminf","lbfgsb3c","subplex","BBoptim","optimParallel") optmethod = "BFGS", # argument 'method' for optim() ("Nelder-Mead" and "BFGS" are sensible options) parallel = list(), # parallel argument for optimParallel() (note: 'cl' argument in parallel is not passed; this is directly specified via 'cl') cl = NULL, # arguments for optimParallel() ncpus = 1L, # arguments for optimParallel() beta.fix = FALSE, # fix beta in Hessian computation tau2.fix = FALSE, # fix tau2 in Hessian computation delta.fix = FALSE, # fix delta in Hessian computation htransf = FALSE, # when FALSE, Hessian is computed directly for the delta and tau^2 estimates (e.g., we get Var(tau^2)); when TRUE, Hessian is computed for the transformed estimates (e.g., we get Var(log(tau2))) hessianCtrl=list(r=6), # arguments passed on to 'method.args' of hessian() hesspack = "numDeriv", # package for computing the Hessian (numDeriv or pracma) scaleX = !betaspec) # whether non-dummy variables in the X matrix should be rescaled before model fitting ### replace defaults with any user-defined values con.pos <- pmatch(names(control), names(con)) con[c(na.omit(con.pos))] <- control[!is.na(con.pos)] if (verbose) con$verbose <- verbose verbose <- con$verbose optimizer <- match.arg(con$optimizer, c("optim","nlminb","uobyqa","newuoa","bobyqa","nloptr","nlm","hjk","nmk","mads","ucminf","lbfgsb3c","subplex","BBoptim","optimParallel","Nelder-Mead","BFGS","CG","L-BFGS-B","SANN","Brent","Rcgmin","Rvmmin")) optmethod <- match.arg(con$optmethod, c("Nelder-Mead","BFGS","CG","L-BFGS-B","SANN","Brent")) if (optimizer %in% c("Nelder-Mead","BFGS","CG","L-BFGS-B","SANN","Brent")) { optmethod <- optimizer optimizer <- "optim" } parallel <- con$parallel cl <- con$cl ncpus <- con$ncpus optcontrol <- control[is.na(con.pos)] # get arguments that are control arguments for optimizer optcontrol$intCtrl <- NULL # but remove intCtrl from this list if (length(optcontrol) == 0L) optcontrol <- list() pos.intCtrl <- pmatch(names(control), "intCtrl", nomatch=0) if (sum(pos.intCtrl) > 0) { intCtrl <- control[[which(pos.intCtrl == 1)]] } else { intCtrl <- list() } con.pos <- pmatch(names(intCtrl), "lower", nomatch=0) if (sum(con.pos) > 0) { names(intCtrl)[which(con.pos == 1)] <- "lower" } else { intCtrl$lower <- -Inf } con.pos <- pmatch(names(intCtrl), "upper", nomatch=0) if (sum(con.pos) > 0) { names(intCtrl)[which(con.pos == 1)] <- "upper" } else { intCtrl$upper <- Inf } con.pos <- pmatch(names(intCtrl), "subdivisions", nomatch=0) if (sum(con.pos) > 0) { names(intCtrl)[which(con.pos == 1)] <- "subdivisions" } else { intCtrl$subdivisions <- 100L } con.pos <- pmatch(names(intCtrl), "rel.tol", nomatch=0) if (sum(con.pos) > 0) { names(intCtrl)[which(con.pos == 1)] <- "rel.tol" } else { intCtrl$rel.tol <- .Machine$double.eps^0.25 } ### if control argument 'ncpus' is larger than 1, automatically switch to optimParallel optimizer if (ncpus > 1L) optimizer <- "optimParallel" ### rescale X matrix (only for models with moderators and models including an intercept term) if (!x$int.only && x$int.incl && con$scaleX) { Xsave <- X meanX <- colMeans(X[, 2:p, drop=FALSE]) sdX <- apply(X[, 2:p, drop=FALSE], 2, sd) ### consider using colSds() from matrixStats package is.d <- apply(X, 2, .is.dummy) ### is each column a dummy variable (i.e., only 0s and 1s)? mX <- rbind(c(intrcpt=1, -1*ifelse(is.d[-1], 0, meanX/sdX)), cbind(0, diag(ifelse(is.d[-1], 1, 1/sdX), nrow=length(is.d)-1, ncol=length(is.d)-1))) X[,!is.d] <- apply(X[, !is.d, drop=FALSE], 2, scale) ### rescale the non-dummy variables } ### initial value(s) for beta if (is.null(con$beta.init)) { beta.init <- c(x$beta) } else { if (length(con$beta.init) != p) stop(mstyle$stop(paste0("Length of 'beta.init' argument (", length(con$beta.init), ") does not match actual number of parameters (", p, ")."))) beta.init <- con$beta.init } if (!x$int.only && x$int.incl && con$scaleX) { imX <- try(suppressWarnings(solve(mX)), silent=TRUE) if (inherits(imX, "try-error")) stop(mstyle$stop("Unable to rescale starting values for the fixed effects.")) beta.init <- c(imX %*% cbind(beta.init)) } ### check that tau2.max is larger than the tau^2 value if (x$tau2 >= con$tau2.max) stop(mstyle$stop("Value of 'tau2.max' must be > tau^2 value.")) tau2.max <- con$tau2.max ### initial value for tau^2 if (is.null(con$tau2.init)) { tau2.init <- log(x$tau2 + 0.001) } else { if (length(con$tau2.init) != 1L) stop(mstyle$stop("Argument 'tau2.init' should specify a single value.")) if (con$tau2.init <= 0) stop(mstyle$stop("Value of 'tau2.init' must be > 0.")) if (con$tau2.init >= tau2.max) stop(mstyle$stop("Value of 'tau2.init' must be < 'tau2.max'.")) tau2.init <- log(con$tau2.init) } con$hesspack <- match.arg(con$hesspack, c("numDeriv","pracma")) if (!isTRUE(ddd$skiphes) && !requireNamespace(con$hesspack, quietly=TRUE)) stop(mstyle$stop(paste0("Please install the '", con$hesspack, "' package to compute the Hessian."))) ############################################################################ if (type == "beta") { if (stepsspec) warning(mstyle$warning("Argument 'steps' ignored (not applicable to this type of selection model)."), call.=FALSE) stepsspec <- FALSE steps <- NA_real_ if (precspec) warning(mstyle$warning("Argument 'prec' ignored (not applicable to this type of selection model)."), call.=FALSE) deltas <- 2L delta.transf.fun <- c("exp", "exp") delta.transf.fun.inv <- c("log", "log") delta.lb <- c(0, 0) delta.ub <- c(Inf, Inf) delta.lb.excl <- c(TRUE, TRUE) delta.ub.excl <- c(FALSE, FALSE) delta.init <- c(1, 1) delta.min <- c(1e-05, 1e-05) delta.max <- c(100, 100) H0.delta <- c(1, 1) delta.LRT <- c(TRUE, TRUE) pval.min <- 1e-5 wi.fun <- function(x, delta, yi, vi, preci, alternative, steps) x^(delta[1]-1) * (1-x)^(delta[2]-1) .selmodel.ll <- ".selmodel.ll.cont" } if (is.element(type, c("halfnorm", "negexp", "logistic", "power"))) { if (stepsspec) { if (length(steps) != 2L) # steps should be c(alpha,1) stop(mstyle$stop("Can only specify a single value for the 'steps' argument for this type of selection model.")) } else { steps <- 0 } deltas <- 1L delta.transf.fun <- "exp" delta.transf.fun.inv <- "log" delta.lb <- 0 delta.ub <- Inf delta.lb.excl <- FALSE delta.ub.excl <- FALSE delta.init <- 1 delta.min <- 0 delta.max <- 100 H0.delta <- 0 delta.LRT <- TRUE if (type == "power") { pval.min <- 1e-5 } else { pval.min <- 0 } if (type == "halfnorm") { wi.fun <- function(x, delta, yi, vi, preci, alternative, steps) ifelse(x <= steps[1], 1, exp(-delta * preci * x^2) / exp(-delta * preci * steps[1]^2)) } if (type == "negexp") { wi.fun <- function(x, delta, yi, vi, preci, alternative, steps) ifelse(x <= steps[1], 1, exp(-delta * preci * x) / exp(-delta * preci * steps[1])) } if (type == "logistic") { wi.fun <- function(x, delta, yi, vi, preci, alternative, steps) ifelse(x <= steps[1], 1, (2 * exp(-delta * preci * x) / (1 + exp(-delta * preci * x))) / (2 * exp(-delta * preci * steps[1]) / (1 + exp(-delta * preci * steps[1])))) } if (type == "power") { wi.fun <- function(x, delta, yi, vi, preci, alternative, steps) ifelse(x <= steps[1], 1, (1-x)^(preci*delta) / (1-steps[1])^(preci*delta)) } .selmodel.ll <- ".selmodel.ll.cont" } if (type == "negexppow") { if (stepsspec) { if (length(steps) != 2L) # steps should be c(alpha,1) stop(mstyle$stop("Can only specify a single value for the 'steps' argument for this type of selection model.")) } else { steps <- 0 } deltas <- 2L delta.transf.fun <- c("exp", "exp") delta.transf.fun.inv <- c("log", "log") delta.lb <- c(0, 0) delta.ub <- c(Inf, Inf) delta.lb.excl <- c(FALSE, FALSE) delta.ub.excl <- c(FALSE, FALSE) delta.init <- c(1, 1) delta.min <- c(0, 0) delta.max <- c(100, 100) H0.delta <- c(0, 0) delta.LRT <- c(TRUE, TRUE) pval.min <- 0 wi.fun <- function(x, delta, yi, vi, preci, alternative, steps) ifelse(x <= steps[1], 1, exp(-delta[1] * preci * x^(1/delta[2])) / exp(-delta[1] * preci * steps[1]^(1/delta[2]))) .selmodel.ll <- ".selmodel.ll.cont" } if (is.element(type, c("halfnorm2", "negexp2", "logistic2", "power2"))) { if (stepsspec) { if (length(steps) != 2L) # steps should be c(alpha,1) stop(mstyle$stop("Can only specify a single value for the 'steps' argument for this type of selection model.")) } else { steps <- 0 } deltas <- 2L delta.transf.fun <- c("exp", "exp") delta.transf.fun.inv <- c("log", "log") delta.lb <- c(0,0) delta.ub <- c(Inf, Inf) delta.lb.excl <- c(FALSE, FALSE) delta.ub.excl <- c(FALSE, FALSE) delta.init <- c(1, 0.25) delta.min <- c(0, 0) delta.max <- c(100, 100) H0.delta <- c(0, 0) delta.LRT <- c(TRUE, TRUE) pval.min <- 0 if (type == "halfnorm2") { wi.fun <- function(x, delta, yi, vi, preci, alternative, steps) ifelse(x <= steps[1], 1, (delta[1] + exp(-delta[2] * preci * x^2) / exp(-delta[2] * preci * steps[1]^2)) / (1 + delta[1])) } if (type == "negexp2") { wi.fun <- function(x, delta, yi, vi, preci, alternative, steps) ifelse(x <= steps[1], 1, (delta[1] + exp(-delta[2] * preci * x) / exp(-delta[2] * preci * steps[1])) / (1 + delta[1])) } if (type == "logistic2") { wi.fun <- function(x, delta, yi, vi, preci, alternative, steps) ifelse(x <= steps[1], 1, (delta[1] + (2 * exp(-delta[2] * preci * x) / (1 + exp(-delta[2] * preci * x))) / (2 * exp(-delta[2] * preci * steps[1]) / (1 + exp(-delta[2] * preci * steps[1])))) / (1 + delta[1])) } if (type == "power2") { wi.fun <- function(x, delta, yi, vi, preci, alternative, steps) ifelse(x <= steps[1], 1, (delta[1] + (1-x)^(preci*delta[2]) / (1-steps[1])^(preci*delta[2])) / (1 + delta[1])) } .selmodel.ll <- ".selmodel.ll.cont" } if (type == "stepfun") { if (!stepsspec) stop(mstyle$stop("Must specify 'steps' argument for this type of selection model.")) if (precspec) warning(mstyle$warning("Adding a precision measure to this selection model is undocumented and experimental."), call.=FALSE) deltas <- length(steps) delta.transf.fun <- rep("exp", deltas) delta.transf.fun.inv <- rep("log", deltas) delta.lb <- rep(0, deltas) delta.ub <- rep(Inf, deltas) delta.lb.excl <- rep(FALSE, deltas) delta.ub.excl <- rep(FALSE, deltas) delta.init <- rep(1, deltas) delta.min <- rep(0, deltas) delta.max <- rep(100, deltas) H0.delta <- rep(1, deltas) delta.LRT <- rep(TRUE, deltas) # note: delta[1] should actually not be included in the LRT, but gets constrained to 1 below anyway pval.min <- 0 if (type == "stepfun") { wi.fun <- function(x, delta, yi, vi, preci, alternative, steps) delta[sapply(x, function(p) which(p <= steps)[1])] / preci } .selmodel.ll <- ".selmodel.ll.stepfun" } if (type == "trunc") { if (length(steps) != 1L) # steps should be a single value stop(mstyle$stop("Can only specify a single value for the 'steps' argument for this type of selection model.")) if (precspec) warning(mstyle$warning("Argument 'prec' ignored (not applicable to this type of selection model)."), call.=FALSE) deltas <- 1L delta.transf.fun <- "exp" delta.transf.fun.inv <- "log" delta.lb <- 0 delta.ub <- Inf delta.lb.excl <- FALSE delta.ub.excl <- FALSE delta.init <- 1 delta.min <- 0 delta.max <- 100 H0.delta <- 1 delta.LRT <- TRUE pval.min <- 0 wi.fun <- function(x, delta, yi, vi, preci, alternative, steps) { if (alternative == "less") { yival <- qnorm(x, sd=sqrt(vi), lower.tail=TRUE) ifelse(yival < steps[1], 1, delta) } else { yival <- qnorm(x, sd=sqrt(vi), lower.tail=FALSE) ifelse(yival > steps[1], 1, delta) } } #.selmodel.ll <- ".selmodel.ll.cont" .selmodel.ll <- ".selmodel.ll.trunc" } if (type == "truncest") { if (stepsspec) warning(mstyle$warning("Argument 'steps' ignored (not applicable to this type of selection model)."), call.=FALSE) stepsspec <- FALSE steps <- NA_real_ if (precspec) warning(mstyle$warning("Argument 'prec' ignored (not applicable to this type of selection model)."), call.=FALSE) deltas <- 2L delta.transf.fun <- c("exp", "I") delta.transf.fun.inv <- c("log", "I") delta.lb <- c(0, -Inf) delta.ub <- c(Inf, Inf) delta.lb.excl <- c(FALSE, FALSE) delta.ub.excl <- c(FALSE, FALSE) delta.init <- c(1, mean(yi)) delta.min <- c(0, ifelse(alternative=="greater", min(yi)-sd(yi), min(yi))) delta.max <- c(100, ifelse(alternative=="greater", max(yi), max(yi)+sd(yi))) H0.delta <- c(1, 0) delta.LRT <- c(TRUE, FALSE) pval.min <- 0 wi.fun <- function(x, delta, yi, vi, preci, alternative, steps) { if (alternative == "less") { yival <- qnorm(x, sd=sqrt(vi), lower.tail=TRUE) ifelse(yival < delta[2], 1, delta[1]) } else { yival <- qnorm(x, sd=sqrt(vi), lower.tail=FALSE) ifelse(yival > delta[2], 1, delta[1]) } } #.selmodel.ll <- ".selmodel.ll.cont" .selmodel.ll <- ".selmodel.ll.trunc" } ############################################################################ ### checks on delta, delta.init, delta.min, delta.max if (missing(delta)) { delta <- rep(NA_real_, deltas) } else { if (length(delta) == 1L) delta <- rep(delta, deltas) if (length(delta) != deltas) stop(mstyle$stop(paste0("Argument 'delta' should be of length ", deltas, " for this type of selection model."))) for (j in seq_len(deltas)) { if (delta.lb.excl[j] && isTRUE(delta[j] <= delta.lb[j])) stop(mstyle$stop(paste0("Value of 'delta[", j, "]' must be > ", delta.lb[j], " for this type of selection model."))) if (!delta.lb.excl[j] && isTRUE(delta[j] < delta.lb[j])) stop(mstyle$stop(paste0("Value of 'delta[", j, "]' must be >= ", delta.lb[j], " for this type of selection model."))) } for (j in seq_len(deltas)) { if (delta.ub.excl[j] && isTRUE(delta[j] >= delta.ub[j])) stop(mstyle$stop(paste0("Value of 'delta[", j, "]' must be < ", delta.ub[j], " for this type of selection model."))) if (!delta.ub.excl[j] && isTRUE(delta[j] > delta.ub[j])) stop(mstyle$stop(paste0("Value of 'delta[", j, "]' must be <= ", delta.ub[j], " for this type of selection model."))) } } if (type == "stepfun" && is.na(delta[1])) delta[1] <- 1 if (!is.null(con$delta.min)) delta.min <- con$delta.min if (length(delta.min) == 1L) delta.min <- rep(delta.min, deltas) if (length(delta.min) != deltas) stop(mstyle$stop(paste0("Argument 'delta.min' should be of length ", deltas, " for this type of selection model."))) if (anyNA(delta.min)) stop(mstyle$stop("No missing values allowed in 'delta.min'.")) for (j in seq_len(deltas)) { if (delta.lb.excl[j] && delta.min[j] <= delta.lb[j]) stop(mstyle$stop(paste0("Value of 'delta.min[", j, "]' must be > ", delta.lb[j], " for this type of selection model."))) if (!delta.lb.excl[j] && delta.min[j] < delta.lb[j]) stop(mstyle$stop(paste0("Value of 'delta.min[", j, "]' must be >= ", delta.lb[j], " for this type of selection model."))) } for (j in seq_len(deltas)) { if (delta.ub.excl[j] && delta.min[j] >= delta.ub[j]) stop(mstyle$stop(paste0("Value of 'delta.min[", j, "]' must be < ", delta.ub[j], " for this type of selection model."))) if (!delta.ub.excl[j] && delta.min[j] > delta.ub[j]) stop(mstyle$stop(paste0("Value of 'delta.min[", j, "]' must be <= ", delta.ub[j], " for this type of selection model."))) } delta.min <- ifelse(!is.na(delta) & delta.min > delta, delta - .Machine$double.eps^0.2, delta.min) if (!is.null(con$delta.max)) delta.max <- con$delta.max if (length(delta.max) == 1L) delta.max <- rep(delta.max, deltas) if (length(delta.max) != deltas) stop(mstyle$stop(paste0("Argument 'delta.max' should be of length ", deltas, " for this type of selection model."))) if (anyNA(delta.max)) stop(mstyle$stop("No missing values allowed in 'delta.max'.")) for (j in seq_len(deltas)) { if (delta.lb.excl[j] && delta.max[j] <= delta.lb[j]) stop(mstyle$stop(paste0("Value of 'delta.max[", j, "]' must be > ", delta.lb[j], " for this type of selection model."))) if (!delta.lb.excl[j] && delta.max[j] < delta.lb[j]) stop(mstyle$stop(paste0("Value of 'delta.max[", j, "]' must be >= ", delta.lb[j], " for this type of selection model."))) } for (j in seq_len(deltas)) { if (delta.ub.excl[j] && delta.max[j] >= delta.ub[j]) stop(mstyle$stop(paste0("Value of 'delta.max[", j, "]' must be < ", delta.ub[j], " for this type of selection model."))) if (!delta.ub.excl[j] && delta.max[j] > delta.ub[j]) stop(mstyle$stop(paste0("Value of 'delta.max[", j, "]' must be <= ", delta.ub[j], " for this type of selection model."))) } if (any(delta.max < delta.min)) stop(mstyle$stop("Value(s) of 'delta.max' must be >= value(s) of 'delta.min'.")) delta.max <- ifelse(!is.na(delta) & delta.max < delta, delta + .Machine$double.eps^0.2, delta.max) if (!is.null(con$delta.init)) delta.init <- con$delta.init if (length(delta.init) == 1L) delta.init <- rep(delta.init, deltas) if (length(delta.init) != deltas) stop(mstyle$stop(paste0("Argument 'delta.init' should be of length ", deltas, " for this type of selection model."))) if (anyNA(delta.init)) stop(mstyle$stop("No missing values allowed in 'delta.init'.")) for (j in seq_len(deltas)) { if (delta.lb.excl[j] && delta.init[j] <= delta.lb[j]) stop(mstyle$stop(paste0("Value of 'delta.init[", j, "]' must be > ", delta.lb[j], " for this type of selection model."))) if (!delta.lb.excl[j] && delta.init[j] < delta.lb[j]) stop(mstyle$stop(paste0("Value of 'delta.init[", j, "]' must be >= ", delta.lb[j], " for this type of selection model."))) } for (j in seq_len(deltas)) { if (delta.ub.excl[j] && delta.init[j] >= delta.ub[j]) stop(mstyle$stop(paste0("Value of 'delta.init[", j, "]' must be < ", delta.ub[j], " for this type of selection model."))) if (!delta.ub.excl[j] && delta.init[j] > delta.ub[j]) stop(mstyle$stop(paste0("Value of 'delta.init[", j, "]' must be <= ", delta.ub[j], " for this type of selection model."))) } delta.init <- ifelse(!is.na(delta), delta, delta.init) if (.isTRUE(ddd$defmap) || any(is.infinite(delta.max))) { ddd$mapfun <- delta.transf.fun ddd$mapinvfun <- delta.transf.fun.inv } if (is.null(ddd$mapfun)) { mapfun <- rep(NA, deltas) } else { if (length(ddd$mapfun) == 1L) { # note: mapfun must be given as character string mapfun <- rep(ddd$mapfun, deltas) } else { mapfun <- ddd$mapfun } } if (is.null(ddd$mapinvfun)) { mapinvfun <- rep(NA, deltas) } else { if (length(ddd$mapinvfun) == 1L) { # note: mapinvfun must be given as character string mapinvfun <- rep(ddd$mapinvfun, deltas) } else { mapinvfun <- ddd$mapinvfun } } if (type == "truncest") { mapfun[2] <- "I" mapinvfun[2] <- "I" } delta.init <- mapply(.mapinvfun, delta.init, delta.min, delta.max, mapinvfun) if (!is.null(con$pval.min)) pval.min <- con$pval.min if (k < p + ifelse(is.element(x$method, c("FE","EE","CE")) || x$tau2.fix, 0, 1) + sum(is.na(delta))) stop(mstyle$stop(paste0("Number of studies (k=", k, ") is too small to fit the selection model."))) ############################################################################ pvals[pvals < pval.min] <- pval.min pvals[pvals > (1-pval.min)] <- 1-pval.min if (type != "trunc" && stepsspec) { pgrp <- sapply(pvals, function(p) which(p <= steps)[1]) psteps.l <- as.character(c(0,steps[-length(steps)])) psteps.r <- as.character(steps) len.l <- nchar(psteps.l) pad.l <- sapply(max(len.l) - len.l, function(x) paste0(rep(" ", x), collapse="")) psteps.l <- paste0(psteps.l, pad.l) psteps <- paste0(psteps.l, " < p <= ", psteps.r) ptable <- table(factor(pgrp, levels=seq_along(steps), labels=psteps)) ptable <- data.frame(k=as.vector(ptable), row.names=names(ptable)) if (any(ptable[["k"]] == 0L)) { if (verbose >= 1) print(ptable) if (!isTRUE(ddd$skipintcheck) && type == "stepfun" && (any(ptable[["k"]] == 0L & is.na(delta)))) stop(mstyle$stop(paste0("One or more intervals do not contain any observed p-values", if (!verbose) " (use 'verbose=TRUE' to see which)", "."))) if (!isTRUE(ddd$skipintcheck) && type != "stepfun") stop(mstyle$stop(paste0("One of the intervals does not contain any observed p-values", if (!verbose) " (use 'verbose=TRUE' to see which)", "."))) } } else { pgrp <- NA ptable <- NA } ############################################################################ ### model fitting if (verbose > 1) message(mstyle$message("\nModel fitting ...\n")) tmp <- .chkopt(optimizer, optcontrol) optimizer <- tmp$optimizer optcontrol <- tmp$optcontrol par.arg <- tmp$par.arg ctrl.arg <- tmp$ctrl.arg if (optimizer == "optimParallel::optimParallel") { parallel$cl <- NULL if (is.null(cl)) { ncpus <- as.integer(ncpus) if (ncpus < 1L) stop(mstyle$stop("Control argument 'ncpus' must be >= 1.")) cl <- parallel::makePSOCKcluster(ncpus) on.exit(parallel::stopCluster(cl), add=TRUE) } else { if (!inherits(cl, "SOCKcluster")) stop(mstyle$stop("Specified cluster is not of class 'SOCKcluster'.")) } parallel$cl <- cl if (is.null(parallel$forward)) parallel$forward <- FALSE if (is.null(parallel$loginfo)) { if (verbose) { parallel$loginfo <- TRUE } else { parallel$loginfo <- FALSE } } } optcall <- paste(optimizer, "(", par.arg, "=c(beta.init, tau2.init, delta.init), ", .selmodel.ll, ", ", ifelse(optimizer=="optim", "method=optmethod, ", ""), "yi=yi, vi=vi, X=X, preci=preci, k=k, pX=p, pvals=pvals, deltas=deltas, delta.val=delta, delta.transf=TRUE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, tau2.val=tau2, tau2.transf=TRUE, tau2.max=tau2.max, beta.val=beta, wi.fun=wi.fun, steps=steps, pgrp=pgrp, alternative=alternative, pval.min=pval.min, intCtrl=intCtrl, verbose=verbose, digits=digits, dofit=FALSE", ctrl.arg, ")\n", sep="") #return(optcall) .start.plot(verbose > 2) if (verbose) { opt.res <- try(eval(str2lang(optcall)), silent=!verbose) } else { opt.res <- try(suppressWarnings(eval(str2lang(optcall))), silent=!verbose) } #return(opt.res) ### convergence checks (if verbose print optimParallel log, if verbose > 2 print opt.res, and unify opt.res$par) opt.res$par <- .chkconv(optimizer=optimizer, opt.res=opt.res, optcontrol=optcontrol, fun="selmodel", verbose=verbose) ### estimates/values of tau2 and delta on the transformed scale tau2.transf <- opt.res$par[p+1] delta.transf <- opt.res$par[(p+2):(p+1+deltas)] ### save for Hessian computation beta.val <- beta tau2.val <- tau2 delta.val <- delta ### do the final model fit with estimated values fitcall <- paste(.selmodel.ll, "(par=opt.res$par, yi=yi, vi=vi, X=X, preci=preci, k=k, pX=p, pvals=pvals, deltas=deltas, delta.val=delta, delta.transf=TRUE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, tau2.val=tau2, tau2.transf=TRUE, tau2.max=tau2.max, beta.val=beta, wi.fun=wi.fun, steps=steps, pgrp=pgrp, alternative=alternative, pval.min=pval.min, intCtrl=intCtrl, verbose=FALSE, digits=digits, dofit=TRUE)\n", sep="") #return(fitcall) fitcall <- try(eval(str2lang(fitcall)), silent=!verbose) #return(fitcall) if (inherits(fitcall, "try-error")) stop(mstyle$stop("Error during the optimization. Use verbose=TRUE and see help(selmodel) for more details on the optimization routines.")) ll <- fitcall$ll beta <- cbind(fitcall$beta) tau2 <- fitcall$tau2 delta <- fitcall$delta if (any(delta <= delta.min + .Machine$double.eps^0.25) || any(delta >= delta.max - 100*.Machine$double.eps^0.25)) warning(mstyle$warning("One or more 'delta' estimates are (almost) equal to their lower or upper bound.\nTreat results with caution (or consider adjusting 'delta.min' and/or 'delta.max')."), call.=FALSE) ############################################################################ ### computing (inverse) Hessian H <- NA_real_ vb <- matrix(NA_real_, nrow=p, ncol=p) se.tau2 <- NA_real_ vd <- matrix(NA_real_, nrow=deltas, ncol=deltas) if (con$beta.fix) { beta.hes <- c(beta) } else { beta.hes <- beta.val } if (con$tau2.fix || tau2 < con$tau2tol) { tau2.hes <- tau2 } else { tau2.hes <- tau2.val } if (con$delta.fix) { delta.hes <- delta } else { delta.hes <- delta.val } hest <- c(is.na(beta.hes), is.na(tau2.hes), is.na(delta.hes)) if (any(hest) && !isTRUE(ddd$skiphes)) { if (verbose > 1) message(mstyle$message("\nComputing Hessian ...")) if (verbose > 3) cat("\n") if (con$htransf) { # TODO: document these two possibilities? if (con$hesspack == "numDeriv") hescall <- paste("numDeriv::hessian(", .selmodel.ll, ", x=opt.res$par, method.args=con$hessianCtrl, yi=yi, vi=vi, X=X, preci=preci, k=k, pX=p, pvals=pvals, deltas=deltas, delta.val=delta.hes, delta.transf=TRUE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, tau2.val=tau2.hes, tau2.transf=TRUE, tau2.max=tau2.max, beta.val=beta.hes, wi.fun=wi.fun, steps=steps, pgrp=pgrp, alternative=alternative, pval.min=pval.min, intCtrl=intCtrl, verbose=ifelse(verbose > 3, verbose, 0), digits=digits)\n", sep="") if (con$hesspack == "pracma") hescall <- paste("pracma::hessian(", .selmodel.ll, ", x0=opt.res$par, yi=yi, vi=vi, X=X, preci=preci, k=k, pX=p, pvals=pvals, deltas=deltas, delta.val=delta.hes, delta.transf=TRUE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, tau2.val=tau2.hes, tau2.transf=TRUE, tau2.max=tau2.max, beta.val=beta.hes, wi.fun=wi.fun, steps=steps, pgrp=pgrp, alternative=alternative, pval.min=pval.min, intCtrl=intCtrl, verbose=ifelse(verbose > 3, verbose, 0), digits=digits)\n", sep="") } else { if (con$hesspack == "numDeriv") hescall <- paste("numDeriv::hessian(", .selmodel.ll, ", x=c(beta, tau2, delta), method.args=con$hessianCtrl, yi=yi, vi=vi, X=X, preci=preci, k=k, pX=p, pvals=pvals, deltas=deltas, delta.val=delta.hes, delta.transf=FALSE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, tau2.val=tau2.hes, tau2.transf=FALSE, tau2.max=tau2.max, beta.val=beta.hes, wi.fun=wi.fun, steps=steps, pgrp=pgrp, alternative=alternative, pval.min=pval.min, intCtrl=intCtrl, verbose=ifelse(verbose > 3, verbose, 0), digits=digits)\n", sep="") if (con$hesspack == "pracma") hescall <- paste("pracma::hessian(", .selmodel.ll, ", x0=c(beta, tau2, delta), yi=yi, vi=vi, X=X, preci=preci, k=k, pX=p, pvals=pvals, deltas=deltas, delta.val=delta.hes, delta.transf=FALSE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, tau2.val=tau2.hes, tau2.transf=FALSE, tau2.max=tau2.max, beta.val=beta.hes, wi.fun=wi.fun, steps=steps, pgrp=pgrp, alternative=alternative, pval.min=pval.min, intCtrl=intCtrl, verbose=ifelse(verbose > 3, verbose, 0), digits=digits)\n", sep="") } #return(hescall) H <- try(eval(str2lang(hescall)), silent=TRUE) #return(H) if (verbose > 3) cat("\n") if (inherits(H, "try-error")) { warning(mstyle$warning("Error when trying to compute the Hessian."), call.=FALSE) } else { if (deltas == 1L) { rownames(H) <- colnames(H) <- c(colnames(X), "tau2", "delta") } else { rownames(H) <- colnames(H) <- c(colnames(X), "tau2", paste0("delta.", seq_len(deltas))) } H.hest <- H[hest, hest, drop=FALSE] iH.hest <- try(suppressWarnings(chol2inv(chol(H.hest))), silent=TRUE) if (inherits(iH.hest, "try-error") || anyNA(iH.hest) || any(is.infinite(iH.hest))) { warning(mstyle$warning("Error when trying to invert Hessian."), call.=FALSE) } else { iH <- matrix(0, nrow=length(hest), ncol=length(hest)) iH[hest, hest] <- iH.hest if (anyNA(beta.hes)) vb[is.na(beta.hes), is.na(beta.hes)] <- iH[c(is.na(beta.hes),FALSE,rep(FALSE,deltas)), c(is.na(beta.hes),FALSE,rep(FALSE,deltas)), drop=FALSE] if (is.na(tau2.hes)) se.tau2 <- sqrt(iH[c(rep(FALSE,p),TRUE,rep(FALSE,deltas)), c(rep(FALSE,p),TRUE,rep(FALSE,deltas))]) if (anyNA(delta.hes)) vd[is.na(delta.hes), is.na(delta.hes)] <- iH[c(rep(FALSE,p),FALSE,is.na(delta.hes)), c(rep(FALSE,p),FALSE,is.na(delta.hes)), drop=FALSE] } } } ############################################################################ ### Wald-type tests of the fixed effects if (verbose > 1) message(mstyle$message("Conducting tests of the fixed effects ...")) ### scale back beta and vb if (!x$int.only && x$int.incl && con$scaleX) { beta <- mX %*% beta vb <- mX %*% vb %*% t(mX) X <- Xsave } ### QM calculation QM <- try(as.vector(t(beta)[x$btt] %*% chol2inv(chol(vb[x$btt,x$btt])) %*% beta[x$btt]), silent=TRUE) if (inherits(QM, "try-error")) QM <- NA_real_ QMp <- pchisq(QM, df=x$m, lower.tail=FALSE) rownames(beta) <- rownames(vb) <- colnames(vb) <- colnames(X) se <- sqrt(diag(vb)) names(se) <- NULL ### inference for beta parameters zval <- c(beta/se) pval <- 2*pnorm(abs(zval), lower.tail=FALSE) crit <- qnorm(x$level/2, lower.tail=FALSE) ci.lb <- c(beta - crit * se) ci.ub <- c(beta + crit * se) ### inference for delta parameters se.delta <- sqrt(diag(vd)) if (con$htransf) { zval.delta <- rep(NA_real_, deltas) pval.delta <- rep(NA_real_, deltas) ci.lb.delta <- c(delta.transf - crit * se.delta) ci.ub.delta <- c(delta.transf + crit * se.delta) ci.lb.delta <- mapply(.mapfun, ci.lb.delta, delta.min, delta.max, mapfun) ci.ub.delta <- mapply(.mapfun, ci.ub.delta, delta.min, delta.max, mapfun) vd <- matrix(NA_real_, nrow=deltas, ncol=deltas) se.delta <- rep(NA_real_, deltas) } else { zval.delta <- (delta - H0.delta) / se.delta pval.delta <- 2*pnorm(abs(zval.delta), lower.tail=FALSE) ci.lb.delta <- c(delta - crit * se.delta) ci.ub.delta <- c(delta + crit * se.delta) } ci.lb.delta <- ifelse(ci.lb.delta < delta.lb, delta.lb, ci.lb.delta) ci.ub.delta <- ifelse(ci.ub.delta > delta.ub, delta.ub, ci.ub.delta) ### inference for tau^2 parameter if (con$htransf) { ci.lb.tau2 <- exp(tau2.transf - crit * se.tau2) # tau2.transf = log(tau^2) and se.tau2 = SE[log(tau^2)] ci.ub.tau2 <- exp(tau2.transf + crit * se.tau2) se.tau2 <- se.tau2 * exp(tau2.transf) # delta method } else { ci.lb.tau2 <- tau2 - crit * se.tau2 ci.ub.tau2 <- tau2 + crit * se.tau2 } ci.lb.tau2[ci.lb.tau2 < 0] <- 0 ############################################################################ ### LRT for H0: tau^2 = 0 (only when NOT fitting a FE model) LRT.tau2 <- NA_real_ LRTp.tau2 <- NA_real_ if (!x$tau2.fix && !is.element(x$method, c("FE","EE","CE")) && !isTRUE(ddd$skiphet)) { if (verbose > 1) message(mstyle$message("Conducting heterogeneity test ...")) if (verbose > 4) cat("\n") optcall <- paste(optimizer, "(", par.arg, "=c(beta.init, tau2.init, delta.init), ", .selmodel.ll, ", ", ifelse(optimizer=="optim", "method=optmethod, ", ""), "yi=yi, vi=vi, X=X, preci=preci, k=k, pX=p, pvals=pvals, deltas=deltas, delta.val=delta.val, delta.transf=TRUE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, tau2.val=0, tau2.transf=FALSE, tau2.max=tau2.max, beta.val=beta.val, wi.fun=wi.fun, steps=steps, pgrp=pgrp, alternative=alternative, pval.min=pval.min, intCtrl=intCtrl, verbose=ifelse(verbose > 4, verbose, 0), digits=digits", ctrl.arg, ")\n", sep="") opt.res <- try(eval(str2lang(optcall)), silent=!verbose) if (verbose > 4) cat("\n") if (!inherits(opt.res, "try-error")) { fitcall <- paste(.selmodel.ll, "(par=opt.res$par, yi=yi, vi=vi, X=X, preci=preci, k=k, pX=p, pvals=pvals, deltas=deltas, delta.val=delta.val, delta.transf=TRUE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, tau2.val=0, tau2.transf=FALSE, tau2.max=tau2.max, beta.val=beta.val, wi.fun=wi.fun, steps=steps, pgrp=pgrp, alternative=alternative, pval.min=pval.min, intCtrl=intCtrl, verbose=FALSE, digits=digits, dofit=TRUE)\n", sep="") fitcall <- try(eval(str2lang(fitcall)), silent=!verbose) if (!inherits(fitcall, "try-error")) { ll0 <- fitcall$ll LRT.tau2 <- max(0, -2 * (ll0 - ll)) LRTp.tau2 <- pchisq(LRT.tau2, df=1, lower.tail=FALSE) } } } ############################################################################ ### LRT for selection model parameter(s) if (verbose > 1) message(mstyle$message("Conducting LRT for selection model parameter(s) ...")) ll0 <- c(logLik(x, REML=FALSE)) LRT <- max(0, -2 * (ll0 - ll)) LRTdf <- sum(is.na(delta.val) & delta.LRT) LRTp <- ifelse(LRTdf > 0, pchisq(LRT, df=LRTdf, lower.tail=FALSE), NA_real_) ############################################################################ ### fit statistics if (verbose > 1) message(mstyle$message("Computing fit statistics and log likelihood ...")) ### note: tau2 and delta are not counted as parameters when they were fixed by the user parms <- p + ifelse(is.element(x$method, c("FE","EE","CE")) || x$tau2.fix, 0, 1) + sum(is.na(delta.val)) ll.ML <- ll dev.ML <- -2 * ll.ML AIC.ML <- -2 * ll.ML + 2*parms BIC.ML <- -2 * ll.ML + parms * log(k) AICc.ML <- -2 * ll.ML + 2*parms * max(k, parms+2) / (max(k, parms+2) - parms - 1) fit.stats <- matrix(c(ll.ML, dev.ML, AIC.ML, BIC.ML, AICc.ML, ll.REML=NA_real_, dev.REML=NA_real_, AIC.REML=NA_real_, BIC.REML=NA_real_, AICc.REML=NA_real_), ncol=2, byrow=FALSE) dimnames(fit.stats) <- list(c("ll","dev","AIC","BIC","AICc"), c("ML","REML")) fit.stats <- data.frame(fit.stats) ############################################################################ ### prepare output if (verbose > 1) message(mstyle$message("Preparing output ...")) res <- x res$beta <- res$b <- beta res$se <- se res$zval <- zval res$pval <- pval res$ci.lb <- ci.lb res$ci.ub <- ci.ub res$vb <- vb res$betaspec <- betaspec res$tau2 <- res$tau2.f <- tau2 res$se.tau2 <- se.tau2 res$ci.lb.tau2 <- ci.lb.tau2 res$ci.ub.tau2 <- ci.ub.tau2 res$dfs <- res$ddf <- NA_integer_ res$test <- "z" res$s2w <- 1 res$QE <- res$QEp <- NA_real_ res$I2 <- res$H2 <- res$vt <- NA_real_ res$R2 <- NULL res$QM <- QM res$QMp <- QMp res$delta <- delta res$vd <- vd res$se.delta <- se.delta res$zval.delta <- zval.delta res$pval.delta <- pval.delta res$ci.lb.delta <- ci.lb.delta res$ci.ub.delta <- ci.ub.delta res$deltas <- deltas res$delta.fix <- !is.na(delta.val) res$hessian <- H res$hest <- hest res$ll <- ll res$ll0 <- ll0 res$LRT <- LRT res$LRTdf <- LRTdf res$LRTp <- LRTp res$LRT.tau2 <- LRT.tau2 res$LRTp.tau2 <- LRTp.tau2 res$M <- diag(vi + tau2, nrow=k, ncol=k) res$model <- "rma.uni.selmodel" res$parms <- parms res$fit.stats <- fit.stats res$pvals <- pvals res$digits <- digits res$verbose <- verbose res$type <- type res$steps <- steps res$stepsspec <- stepsspec res$pgrp <- pgrp res$ptable <- ptable res$alternative <- alternative res$pval.min <- pval.min res$prec <- prec res$precspec <- precspec res$precis <- precis res$scaleprec <- ddd$scaleprec res$wi.fun <- wi.fun res$delta.lb <- delta.lb res$delta.ub <- delta.ub res$delta.lb.excl <- delta.lb.excl res$delta.ub.excl <- delta.ub.excl res$delta.min <- delta.min res$delta.max <- delta.max res$tau2.max <- tau2.max res$call <- match.call() res$control <- control res$defmap <- ddd$defmap res$mapfun <- ddd$mapfun res$mapinvfun <- ddd$mapinvfun time.end <- proc.time() res$time <- unname(time.end - time.start)[3] if (.isTRUE(ddd$time)) .print.time(res$time) if (verbose || .isTRUE(ddd$time)) cat("\n") class(res) <- c("rma.uni.selmodel", class(res)) return(res) } metafor/R/weights.rma.glmm.r0000644000176200001440000000024413770400276015464 0ustar liggesusersweights.rma.glmm <- function(object, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.glmm", notav="rma.glmm") } metafor/R/regplot.rma.r0000644000176200001440000005770514466626524014562 0ustar liggesusersregplot.rma <- function(x, mod, pred=TRUE, ci=TRUE, pi=FALSE, shade=TRUE, xlim, ylim, predlim, olim, xlab, ylab, at, digits=2L, transf, atransf, targs, level=x$level, pch, psize, plim=c(0.5,3), col, bg, slab, grid=FALSE, refline, label=FALSE, offset=c(1,1), labsize=1, lcol, lwd, lty, legend=FALSE, xvals, ...) { ######################################################################### mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma", notav=c("rma.mh","rma.peto")) if (x$int.only) stop(mstyle$stop("Plot not applicable to intercept-only models.")) na.act <- getOption("na.action") on.exit(options(na.action=na.act), add=TRUE) if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (missing(transf)) transf <- FALSE if (missing(atransf)) atransf <- FALSE transf.char <- deparse(transf) atransf.char <- deparse(atransf) if (is.function(transf) && is.function(atransf)) stop(mstyle$stop("Use either 'transf' or 'atransf' to specify a transformation (not both).")) .start.plot() mf <- match.call() if (missing(pch)) { pch <- 21 } else { pch <- .getx("pch", mf=mf, data=x$data) } if (missing(psize)) { psize <- NULL } else { psize <- .getx("psize", mf=mf, data=x$data) } if (missing(col)) { col <- par("fg") } else { col <- .getx("col", mf=mf, data=x$data) } if (missing(bg)) { bg <- .coladj(par("bg","fg"), dark=0.35, light=-0.35) } else { bg <- .getx("bg", mf=mf, data=x$data) } if (missing(slab)) { slab <- x$slab } else { slab <- .getx("slab", mf=mf, data=x$data) if (length(slab) != x$k.all) stop(mstyle$stop(paste0("Length of the 'slab' argument (", length(slab), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) slab <- .getsubset(slab, x$subset) } if (missing(label)) { label <- NULL } else { label <- .getx("label", mf=mf, data=x$data) } if (missing(targs)) targs <- NULL if (missing(ylab)) ylab <- .setlab(x$measure, transf.char, atransf.char, gentype=1, short=FALSE) if (missing(at)) at <- NULL ### grid argument can either be a logical or a color if (is.logical(grid)) gridcol <- .coladj(par("bg","fg"), dark=c(0.2,-0.6), light=c(-0.2,0.6)) if (is.character(grid)) { gridcol <- grid grid <- TRUE } ### shade argument can either be a logical or a color (first for ci, second for pi) if (is.logical(shade)) { shadecol <- c(.coladj(par("bg","fg"), dark=0.15, light=-0.15), .coladj(par("bg","fg"), dark=0.05, light=-0.05)) } if (is.character(shade)) { if (length(shade) == 1L) shade <- c(shade, shade) shadecol <- shade shade <- TRUE } ### copy pred to addpred (since using pred below for predicted values) if (inherits(pred, "list.rma")) { addpred <- TRUE if (missing(xvals)) stop(mstyle$stop("Must specify 'xvals' argument when passing an object from predict() to 'pred'.")) if (length(xvals) != length(pred$pred)) stop(mstyle$stop(paste0("Length of the 'xvals' argument (", length(xvals), ") does not correspond to the number of predicted values (", length(pred$pred), ")."))) } else { addpred <- pred } ### set refline to NA if it is not specified if (missing(refline)) refline <- NA_real_ ### set lcol, lty, and lwd (1 = reg line, 2 = ci bounds, 3 = pi bounds, 4 = refline) if (missing(lcol)) { lcol <- c(rep(par("fg"), 3), .coladj(par("bg","fg"), dark=0.5, light=-0.5)) } else { if (length(lcol) == 1L) lcol <- rep(lcol, 4L) if (length(lcol) == 2L) lcol <- c(lcol[c(1,2,2)], .coladj(par("bg","fg"), dark=0.5, light=-0.5)) if (length(lcol) == 3L) lcol <- c(lcol, .coladj(par("bg","fg"), dark=0.5, light=-0.5)) } if (missing(lty)) { lty <- c("solid", "dashed", "dotted", "solid") } else { if (length(lty) == 1L) lty <- rep(lty, 4L) if (length(lty) == 2L) lty <- c(lty[c(1,2,2)], "solid") if (length(lty) == 3L) lty <- c(lty, "solid") } if (missing(lwd)) { lwd <- c(3,1,1,2) } else { if (length(lwd) == 1L) lwd <- rep(lwd, 4L) if (length(lwd) == 2L) lwd <- c(lwd[c(1,2,2)], 2) if (length(lwd) == 3L) lwd <- c(lwd, 2) } level <- .level(level) ddd <- list(...) lplot <- function(..., grep, fixed, box.lty) plot(...) laxis <- function(..., grep, fixed, box.lty) axis(...) lpolygon <- function(..., grep, fixed, box.lty) polygon(...) llines <- function(..., grep, fixed, box.lty) lines(...) lpoints <- function(..., grep, fixed, box.lty) points(...) labline <- function(..., grep, fixed, box.lty) abline(...) lbox <- function(..., grep, fixed, box.lty) box(...) ltext <- function(..., grep, fixed, box.lty) text(...) if (is.null(ddd$fixed)) { fixed <- FALSE } else { fixed <- .isTRUE(ddd$fixed) } if (is.null(ddd$grep)) { grep <- FALSE } else { grep <- .isTRUE(ddd$grep) } if (is.null(ddd$box.lty)) { box.lty <- par("lty") } else { box.lty <- ddd$box.lty } ############################################################################ ### checks on mod argument if (missing(mod)) { if (x$p == 2L && x$int.incl) { mod <- 2 } else { if (x$p == 1L) { mod <- 1 } else { stop(mstyle$stop("Must specify 'mod' argument for models with multiple predictors.")) } } } if (length(mod) != 1L) stop(mstyle$stop("Can only specify a single variable via argument 'mod'.")) if (!(is.character(mod) || is.numeric(mod))) stop(mstyle$stop("Argument 'mod' must either be a character string or a scalar.")) if (is.character(mod)) { if (grep) { mod.pos <- grep(mod, colnames(x$X), fixed=fixed) if (length(mod.pos) != 1L) stop(mstyle$stop("Could not find or uniquely identify the moderator variable specified via the 'mod' argument.")) } else { mod.pos <- charmatch(mod, colnames(x$X)) if (is.na(mod.pos) || mod.pos == 0L) stop(mstyle$stop("Could not find or uniquely identify the moderator variable specified via the 'mod' argument.")) } } else { mod.pos <- round(mod) if (mod.pos < 1 | mod.pos > x$p) stop(mstyle$stop("Specified position of 'mod' variable does not exist in the model.")) } ### extract the observed outcomes, corresponding sampling variances, model matrix, and ids yi <- c(x$yi.f) vi <- x$vi.f X <- x$X.f ids <- x$ids ### get weights options(na.action = "na.pass") # using na.pass to get the entire vector (length of yi.f) weights <- try(weights(x), silent=TRUE) # does not work for rma.glmm and rma.uni.selmodel objects if (inherits(weights, "try-error")) weights <- rep(1, x$k.f) options(na.action = na.act) ### note: pch (if vector), psize (if vector), col (if vector), bg (if vector) ### must have the same length as the original dataset so we have to ### apply the same subsetting (if necessary) and removing of NAs as was ### done during the model fitting (note: NAs are removed further below) if (length(pch) == 1L) pch <- rep(pch, x$k.all) if (length(pch) != x$k.all) stop(mstyle$stop(paste0("Length of the 'pch' argument (", length(pch), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) pch <- .getsubset(pch, x$subset) psize.char <- FALSE if (!is.null(psize)) { if (is.character(psize)) { psize <- match.arg(psize, c("seinv", "vinv")) if (psize == "seinv") { psize <- 1 / sqrt(vi) } else { psize <- 1 / vi } psize.char <- TRUE } else { if (length(psize) == 1L) psize <- rep(psize, x$k.all) if (length(psize) != x$k.all) stop(mstyle$stop(paste0("Length of the 'psize' argument (", length(psize), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) psize <- .getsubset(psize, x$subset) } } if (length(col) == 1L) col <- rep(col, x$k.all) if (length(col) != x$k.all) stop(mstyle$stop(paste0("Length of the 'col' argument (", length(col), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) col <- .getsubset(col, x$subset) if (length(bg) == 1L) bg <- rep(bg, x$k.all) if (length(bg) != x$k.all) stop(mstyle$stop(paste0("Length of the 'bg' argument (", length(bg), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) bg <- .getsubset(bg, x$subset) if (!is.null(label)) { if (is.character(label)) { label <- match.arg(label, c("all", "ciout", "piout")) if (label == "all") { label <- rep(TRUE, x$k.all) label <- .getsubset(label, x$subset) } } else if (is.logical(label)) { #if (!is.logical(label)) # stop(mstyle$stop("Argument 'label' must be a logical vector (or a single character string).")) if (length(label) == 1L) label <- rep(label, x$k.all) if (length(label) != x$k.all) stop(mstyle$stop(paste0("Length of the 'label' argument (", length(label), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) label <- .getsubset(label, x$subset) } else if (is.numeric(label)) { label <- round(label) label <- seq(x$k.all) %in% label label <- .getsubset(label, x$subset) } } ############################################################################ has.na <- is.na(yi) | is.na(vi) | apply(is.na(X), 1, any) not.na <- !has.na if (any(has.na)) { yi <- yi[not.na] vi <- vi[not.na] X <- X[not.na,,drop=FALSE] slab <- slab[not.na] ids <- ids[not.na] weights <- weights[not.na] pch <- pch[not.na] psize <- psize[not.na] # if NULL, remains NULL col <- col[not.na] bg <- bg[not.na] if (!is.character(label)) label <- label[not.na] } k <- length(yi) ############################################################################ ### extract values for moderator of interest xi <- X[,mod.pos] if (inherits(pred, "list.rma")) { xs <- xvals ci.lb <- pred$ci.lb ci.ub <- pred$ci.ub if (is.null(pred$pi.lb) || anyNA(pred$pi.lb)) { pi.lb <- pred$ci.lb pi.ub <- pred$ci.ub if (pi) warning(mstyle$warning("Object passed to 'pred' argument does not contain prediction interval information."), call.=FALSE) pi <- FALSE } else { pi.lb <- pred$pi.lb pi.ub <- pred$pi.ub } pred <- pred$pred if (!is.null(label) && is.character(label) && label %in% c("ciout", "piout")) { warning(mstyle$stop("Cannot label points based on the confidence/prediction interval when passing an object to 'pred'.")) label <- NULL } yi.pred <- NULL yi.ci.lb <- NULL yi.ci.ub <- NULL yi.pi.lb <- NULL yi.pi.ub <- NULL } else { ### get predicted values if (!missing(xvals)) { xs <- xvals len <- length(xs) predlim <- range(xs) } else { len <- 1000 if (missing(predlim)) { range.xi <- max(xi) - min(xi) predlim <- c(min(xi) - .04*range.xi, max(xi) + .04*range.xi) xs <- seq(predlim[1], predlim[2], length=len) } else { if (length(predlim) != 2L) stop(mstyle$stop("Argument 'predlim' must be of length 2.")) xs <- seq(predlim[1], predlim[2], length=len) } } Xnew <- rbind(colMeans(X))[rep(1,len),,drop=FALSE] Xnew[,mod.pos] <- xs if (x$int.incl) Xnew <- Xnew[,-1,drop=FALSE] tmp <- predict(x, newmods=Xnew, level=level) pred <- tmp$pred ci.lb <- tmp$ci.lb ci.ub <- tmp$ci.ub if (is.null(tmp$pi.lb) || anyNA(tmp$pi.lb)) { pi.lb <- ci.lb pi.ub <- ci.ub if (pi) warning(mstyle$warning("Cannot draw prediction interval for the given model."), call.=FALSE) pi <- FALSE } else { pi.lb <- tmp$pi.lb pi.ub <- tmp$pi.ub } Xnew <- rbind(colMeans(X))[rep(1,k),,drop=FALSE] Xnew[,mod.pos] <- xi if (x$int.incl) Xnew <- Xnew[,-1,drop=FALSE] tmp <- predict(x, newmods=Xnew, level=level) yi.pred <- tmp$pred yi.ci.lb <- tmp$ci.lb yi.ci.ub <- tmp$ci.ub if (is.null(tmp$pi.lb) || anyNA(tmp$pi.lb)) { yi.pi.lb <- yi.ci.lb yi.pi.ub <- yi.ci.ub if (!is.null(label) && is.character(label) && label == "piout") { warning(mstyle$warning("Cannot label points based on the prediction interval for the given model."), call.=FALSE) label <- NULL } } else { yi.pi.lb <- tmp$pi.lb yi.pi.ub <- tmp$pi.ub } } ############################################################################ ### if requested, apply transformation to yi's and CI/PI bounds if (is.function(transf)) { if (is.null(targs)) { yi <- sapply(yi, transf) pred <- sapply(pred, transf) ci.lb <- sapply(ci.lb, transf) ci.ub <- sapply(ci.ub, transf) pi.lb <- sapply(pi.lb, transf) pi.ub <- sapply(pi.ub, transf) yi.pred <- sapply(yi.pred, transf) yi.ci.lb <- sapply(yi.ci.lb, transf) yi.ci.ub <- sapply(yi.ci.ub, transf) yi.pi.lb <- sapply(yi.pi.lb, transf) yi.pi.ub <- sapply(yi.pi.ub, transf) } else { yi <- sapply(yi, transf, targs) pred <- sapply(pred, transf, targs) ci.lb <- sapply(ci.lb, transf, targs) ci.ub <- sapply(ci.ub, transf, targs) pi.lb <- sapply(pi.lb, transf, targs) pi.ub <- sapply(pi.ub, transf, targs) yi.pred <- sapply(yi.pred, transf, targs) yi.ci.lb <- sapply(yi.ci.lb, transf, targs) yi.ci.ub <- sapply(yi.ci.ub, transf, targs) yi.pi.lb <- sapply(yi.pi.lb, transf, targs) yi.pi.ub <- sapply(yi.pi.ub, transf, targs) } } ### make sure order of intervals is always increasing tmp <- .psort(ci.lb, ci.ub) ci.lb <- tmp[,1] ci.ub <- tmp[,2] tmp <- .psort(pi.lb, pi.ub) pi.lb <- tmp[,1] pi.ub <- tmp[,2] ### apply observation/outcome limits if specified if (!missing(olim)) { if (length(olim) != 2L) stop(mstyle$stop("Argument 'olim' must be of length 2.")) olim <- sort(olim) yi[yi < olim[1]] <- olim[1] yi[yi > olim[2]] <- olim[2] pred[pred < olim[1]] <- olim[1] pred[pred > olim[2]] <- olim[2] ci.lb[ci.lb < olim[1]] <- olim[1] ci.ub[ci.ub > olim[2]] <- olim[2] pi.lb[pi.lb < olim[1]] <- olim[1] pi.ub[pi.ub > olim[2]] <- olim[2] } ### set default point sizes (if not specified by user) if (is.null(psize) || psize.char) { if (length(plim) < 2L) stop(mstyle$stop("Argument 'plim' must be of length 2 or 3.")) if (psize.char) { wi <- psize } else { wi <- sqrt(weights) } if (!is.na(plim[1]) && !is.na(plim[2])) { rng <- max(wi, na.rm=TRUE) - min(wi, na.rm=TRUE) if (rng <= .Machine$double.eps^0.5) { psize <- rep(1, k) } else { psize <- (wi - min(wi, na.rm=TRUE)) / rng psize <- (psize * (plim[2] - plim[1])) + plim[1] } } if (is.na(plim[1]) && !is.na(plim[2])) { psize <- wi / max(wi, na.rm=TRUE) * plim[2] if (length(plim) == 3L) psize[psize <= plim[3]] <- plim[3] } if (!is.na(plim[1]) && is.na(plim[2])) { psize <- wi / min(wi, na.rm=TRUE) * plim[1] if (length(plim) == 3L) psize[psize >= plim[3]] <- plim[3] } if (all(is.na(psize))) psize <- rep(1, k) } ############################################################################ if (missing(xlab)) xlab <- colnames(X)[mod.pos] if (!is.expression(xlab) && xlab == "") xlab <- "Moderator" if (missing(xlim)) { xlim <- range(xi) } else { if (length(xlim) != 2L) stop(mstyle$stop("Argument 'xlim' must be of length 2.")) } if (missing(ylim)) { if (pi) { ylim <- range(c(yi, pi.lb, pi.ub)) } else if (ci) { ylim <- range(c(yi, ci.lb, ci.ub)) } else { ylim <- range(yi) } } else { if (length(ylim) != 2L) stop(mstyle$stop("Argument 'ylim' must be of length 2.")) } ### if user has specified 'at' argument, make sure ylim actually contains the min and max 'at' values if (!is.null(at)) { ylim[1] <- min(c(ylim[1], at), na.rm=TRUE) ylim[2] <- max(c(ylim[2], at), na.rm=TRUE) } ############################################################################ ### set up plot lplot(NA, xlab=xlab, ylab=ylab, xlim=xlim, ylim=ylim, yaxt="n", ...) ### generate y-axis positions if none are specified if (is.null(at)) { at <- axTicks(side=2) } else { at <- at[at > par("usr")[3]] at <- at[at < par("usr")[4]] } ### y-axis labels (apply transformation to axis labels if requested) at.lab <- at if (is.function(atransf)) { if (is.null(targs)) { at.lab <- fmtx(sapply(at.lab, atransf), digits[[1]], drop0ifint=TRUE) } else { at.lab <- fmtx(sapply(at.lab, atransf, targs), digits[[1]], drop0ifint=TRUE) } } else { at.lab <- fmtx(at.lab, digits[[1]], drop0ifint=TRUE) } ### add y-axis laxis(side=2, at=at, labels=at.lab, ...) ### add predicted values / CI bounds if (shade) { if (pi) lpolygon(c(xs, rev(xs)), c(pi.lb, rev(pi.ub)), border=NA, col=shadecol[2], ...) if (ci) lpolygon(c(xs, rev(xs)), c(ci.lb, rev(ci.ub)), border=NA, col=shadecol[1], ...) } if (ci) { llines(xs, ci.lb, col=lcol[2], lty=lty[2], lwd=lwd[2], ...) llines(xs, ci.ub, col=lcol[2], lty=lty[2], lwd=lwd[2], ...) } if (pi) { llines(xs, pi.lb, col=lcol[3], lty=lty[3], lwd=lwd[3], ...) llines(xs, pi.ub, col=lcol[3], lty=lty[3], lwd=lwd[3], ...) } ### add grid if (.isTRUE(grid)) grid(col=gridcol) # grid needs to be at x and y tick positions also if using y-axis transformation ### add refline labline(h=refline, col=lcol[4], lty=lty[4], lwd=lwd[4], ...) if (addpred) llines(xs, pred, col=lcol[1], lty=lty[1], lwd=lwd[1], ...) ### redraw box lbox(...) ### order points by psize for plotting order.vec <- order(psize, decreasing=TRUE) xi.o <- xi[order.vec] yi.o <- yi[order.vec] pch.o <- pch[order.vec] psize.o <- psize[order.vec] col.o <- col[order.vec] bg.o <- bg[order.vec] ### add points lpoints(x=xi.o, y=yi.o, pch=pch.o, col=col.o, bg=bg.o, cex=psize.o, ...) ### labeling of points if (!is.null(label)) { if (!is.null(label) && is.character(label) && label %in% c("ciout", "piout")) { if (label == "ciout") { label <- yi < yi.ci.lb | yi > yi.ci.ub label[xi < predlim[1] | xi > predlim[2]] <- FALSE } else { label <- yi < yi.pi.lb | yi > yi.pi.ub label[xi < predlim[1] | xi > predlim[2]] <- FALSE } } yrange <- ylim[2] - ylim[1] if (length(offset) == 2L) offset <- c(offset[1]/100 * yrange, offset[2]/100 * yrange, 1) if (length(offset) == 1L) offset <- c(0, offset/100 * yrange, 1) for (i in which(label)) { if (isTRUE(yi[i] > yi.pred[i])) { # yi.pred might be NULL, so use isTRUE() ltext(xi[i], yi[i] + offset[1] + offset[2]*psize[i]^offset[3], slab[i], cex=labsize, ...) } else { ltext(xi[i], yi[i] - offset[1] - offset[2]*psize[i]^offset[3], slab[i], cex=labsize, ...) } } } else { label <- rep(FALSE, k) } ### add legend (if requested) if (is.logical(legend) && isTRUE(legend)) lpos <- "topright" if (is.character(legend)) { lpos <- legend legend <- TRUE } if (legend) { pch.l <- NULL col.l <- NULL bg.l <- NULL lty.l <- NULL lwd.l <- NULL tcol.l <- NULL ltxt <- NULL if (length(unique(pch)) == 1L && length(unique(col)) == 1L && length(unique(bg)) == 1L) { pch.l <- NA col.l <- NA bg.l <- NA lty.l <- "blank" lwd.l <- NA tcol.l <- "transparent" ltxt <- "Studies" } if (addpred) { pch.l <- c(pch.l, NA) col.l <- c(col.l, NA) bg.l <- c(bg.l, NA) lty.l <- c(lty.l, NA) lwd.l <- c(lwd.l, NA) tcol.l <- c(tcol.l, "transparent") ltxt <- c(ltxt, "Regression Line") } if (ci) { pch.l <- c(pch.l, 22) col.l <- c(col.l, lcol[2]) bg.l <- c(bg.l, shadecol[1]) lty.l <- c(lty.l, NA) lwd.l <- c(lwd.l, 1) tcol.l <- c(tcol.l, "transparent") ltxt <- c(ltxt, paste0(round(100*(1-level), digits[[1]]), "% Confidence Interval")) } if (pi) { pch.l <- c(pch.l, 22) col.l <- c(col.l, lcol[3]) bg.l <- c(bg.l, shadecol[2]) lty.l <- c(lty.l, NA) lwd.l <- c(lwd.l, 1) tcol.l <- c(tcol.l, "transparent") ltxt <- c(ltxt, paste0(round(100*(1-level), digits[[1]]), "% Prediction Interval")) } if (length(ltxt) >= 1L) legend(lpos, inset=.01, bg=par("bg"), pch=pch.l, col=col.l, pt.bg=bg.l, lty=lty.l, lwd=lwd.l, text.col=tcol.l, pt.cex=1.5, seg.len=3, legend=ltxt, box.lty=box.lty) pch.l <- NULL col.l <- NULL bg.l <- NULL lty.l <- NULL lwd.l <- NULL tcol.l <- NULL ltxt <- NULL if (length(unique(pch)) == 1L && length(unique(col)) == 1L && length(unique(bg)) == 1L) { pch.l <- pch[1] col.l <- col[1] bg.l <- bg[1] lty.l <- "blank" lwd.l <- 1 tcol.l <- par("fg") ltxt <- "Studies" } if (addpred) { pch.l <- c(pch.l, NA) col.l <- c(col.l, lcol[1]) bg.l <- c(bg.l, NA) lty.l <- c(lty.l, lty[1]) lwd.l <- c(lwd.l, lwd[1]) tcol.l <- c(tcol.l, par("fg")) ltxt <- c(ltxt, "Regression Line") } if (ci) { pch.l <- c(pch.l, NA) col.l <- c(col.l, lcol[2]) bg.l <- c(bg.l, NA) lty.l <- c(lty.l, lty[2]) lwd.l <- c(lwd.l, lwd[2]) tcol.l <- c(tcol.l, par("fg")) ltxt <- c(ltxt, paste0(round(100*(1-level), digits[[1]]), "% Confidence Interval")) } if (pi) { pch.l <- c(pch.l, NA) col.l <- c(col.l, lcol[3]) bg.l <- c(bg.l, NA) lty.l <- c(lty.l, lty[3]) lwd.l <- c(lwd.l, lwd[3]) tcol.l <- c(tcol.l, par("fg")) ltxt <- c(ltxt, paste0(round(100*(1-level), digits[[1]]), "% Prediction Interval")) } if (length(ltxt) >= 1L) legend(lpos, inset=.01, bg=NA, pch=pch.l, col=col.l, pt.bg=bg.l, lty=lty.l, lwd=lwd.l, text.col=tcol.l, pt.cex=1.5, seg.len=3, legend=ltxt, box.lty=box.lty) } ############################################################################ sav <- data.frame(slab, ids, xi, yi, pch, psize, col, bg, label, order=order.vec) if (length(yi.pred) != 0L) # yi.pred might be NULL or list() sav$pred <- yi.pred attr(sav, "offset") <- offset attr(sav, "labsize") <- labsize class(sav) <- "regplot" invisible(sav) } metafor/R/ranef.rma.uni.r0000644000176200001440000000640714401676426014757 0ustar liggesusersranef.rma.uni <- function(object, level, digits, transf, targs, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.uni", notav=c("rma.gen", "rma.uni.selmodel")) x <- object na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (missing(level)) level <- x$level if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } if (missing(transf)) transf <- FALSE if (missing(targs)) targs <- NULL level <- .level(level) if (is.element(x$test, c("knha","adhoc","t"))) { crit <- qt(level/2, df=x$ddf, lower.tail=FALSE) } else { crit <- qnorm(level/2, lower.tail=FALSE) } ### TODO: check computations for user-defined weights if (!is.null(x$weights) || !x$weighted) stop(mstyle$stop("Extraction of random effects not available for models with non-standard weights.")) ######################################################################### pred <- rep(NA_real_, x$k.f) vpred <- rep(NA_real_, x$k.f) ### see Appendix in: Raudenbush, S. W., & Bryk, A. S. (1985). Empirical ### Bayes meta-analysis. Journal of Educational Statistics, 10(2), 75-98 li <- x$tau2.f / (x$tau2.f + x$vi.f) for (i in seq_len(x$k.f)[x$not.na]) { ### note: skipping NA cases Xi <- matrix(x$X.f[i,], nrow=1) if (is.element(x$method, c("FE","EE","CE"))) { pred[i] <- 0 vpred[i] <- 0 } else { pred[i] <- li[i] * (x$yi.f[i] - Xi %*% x$beta) vpred[i] <- li[i] * x$vi.f[i] + li[i]^2 * Xi %*% tcrossprod(x$vb,Xi) } } se <- sqrt(vpred) pi.lb <- pred - crit * se pi.ub <- pred + crit * se ######################################################################### ### if requested, apply transformation function to 'pred' and interval bounds if (is.function(transf)) { if (is.null(targs)) { pred <- sapply(pred, transf) se <- rep(NA_real_, x$k.f) pi.lb <- sapply(pi.lb, transf) pi.ub <- sapply(pi.ub, transf) } else { pred <- sapply(pred, transf, targs) se <- rep(NA_real_, x$k.f) pi.lb <- sapply(pi.lb, transf, targs) pi.ub <- sapply(pi.ub, transf, targs) } transf <- TRUE } ### make sure order of intervals is always increasing tmp <- .psort(pi.lb, pi.ub) pi.lb <- tmp[,1] pi.ub <- tmp[,2] ######################################################################### if (na.act == "na.omit") { out <- list(pred=pred[x$not.na], se=se[x$not.na], pi.lb=pi.lb[x$not.na], pi.ub=pi.ub[x$not.na]) out$slab <- x$slab[x$not.na] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(pred=pred, se=se, pi.lb=pi.lb, pi.ub=pi.ub) out$slab <- x$slab } if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) ######################################################################### out$digits <- digits out$transf <- transf class(out) <- "list.rma" return(out) } metafor/R/misc.func.hidden.tes.r0000644000176200001440000000176214433151070016210 0ustar liggesusers.tes.intfun <- function(x, theta, tau, sei, H0, alternative, crit) { if (alternative == "two.sided") pow <- (pnorm(crit, mean=(x-H0)/sei, sd=1, lower.tail=FALSE) + pnorm(-crit, mean=(x-H0)/sei, sd=1, lower.tail=TRUE)) if (alternative == "greater") pow <- pnorm(crit, mean=(x-H0)/sei, sd=1, lower.tail=FALSE) if (alternative == "less") pow <- pnorm(crit, mean=(x-H0)/sei, sd=1, lower.tail=TRUE) res <- pow * dnorm(x, theta, tau) return(res) } .tes.lim <- function(theta, yi, vi, H0, alternative, alpha, tau2, test, tes.alternative, progbar, tes.alpha, correct, rel.tol, subdivisions, tau2.lb) { pval <- tes(x=yi, vi=vi, H0=H0, alternative=alternative, alpha=alpha, theta=theta, tau2=tau2, test=test, tes.alternative=tes.alternative, progbar=progbar, tes.alpha=tes.alpha, correct=correct, rel.tol=rel.tol, subdivisions=subdivisions, tau2.lb=tau2.lb, find.lim=FALSE)$pval #cat("theta = ", theta, " pval = ", pval, "\n") return(pval - tes.alpha) } metafor/R/rstandard.rma.peto.r0000644000176200001440000000274213770377076016027 0ustar liggesusersrstandard.rma.peto <- function(model, digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(model), must="rma.peto") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) x <- model if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } ######################################################################### resid <- c(x$yi.f - x$beta) resid[abs(resid) < 100 * .Machine$double.eps] <- 0 #resid[abs(resid) < 100 * .Machine$double.eps * median(abs(resid), na.rm=TRUE)] <- 0 ### see lm.influence ### note: these are like Pearson (or semi-standardized) residuals seresid <- sqrt(x$vi.f) stresid <- resid / seresid ######################################################################### if (na.act == "na.omit") { out <- list(resid=resid[x$not.na.yivi], se=seresid[x$not.na.yivi], z=stresid[x$not.na.yivi]) out$slab <- x$slab[x$not.na.yivi] } if (na.act == "na.exclude" || na.act == "na.pass") { out <- list(resid=resid, se=seresid, z=stresid) out$slab <- x$slab } if (na.act == "na.fail" && any(!x$not.na.yivi)) stop(mstyle$stop("Missing values in results.")) out$digits <- digits class(out) <- "list.rma" return(out) } metafor/R/permutest.rma.ls.r0000644000176200001440000006111114440115352015515 0ustar liggesuserspermutest.rma.ls <- function(x, exact=FALSE, iter=1000, progbar=TRUE, digits, control, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.ls") if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } ddd <- list(...) .chkdots(ddd, c("tol", "time", "seed", "verbose", "permci", "skip.beta", "skip.alpha")) if (!is.null(ddd$tol)) # in case user specifies comptol in the old manner comptol <- ddd$tol if (.isTRUE(ddd$permci)) warning(mstyle$warning("Permutation-based CIs for location-scale models not currently available."), call.=FALSE) if (.isTRUE(ddd$time)) time.start <- proc.time() if (.isTRUE(ddd$skip.beta)) { skip.beta <- TRUE } else { skip.beta <- FALSE } if (.isTRUE(ddd$skip.alpha)) { skip.alpha <- TRUE } else { skip.alpha <- FALSE } iter <- round(iter) if (iter <= 1) stop(mstyle$stop("Argument 'iter' must be >= 2.")) ### for intercept-only models, cannot run a permutation test if (x$Z.int.only) { skip.alpha <- TRUE warning(mstyle$warning("Cannot carry out a permutation test for an intercept-only scale model."), call.=FALSE) } if (skip.beta && skip.alpha) stop(mstyle$stop("Must run permutation test for at least one part of the model.")) ### set control parameters and possibly replace with user-defined values if (missing(control)) control <- list() con <- list(comptol=.Machine$double.eps^0.5, alternative="two.sided", p2defn="abs", stat="test") con.pos <- pmatch(names(control), names(con)) con[c(na.omit(con.pos))] <- control[!is.na(con.pos)] con$alternative <- match.arg(con$alternative, c("two.sided", "less", "greater")) con$p2defn <- match.arg(con$p2defn, c("abs", "px2")) con$stat <- match.arg(con$stat, c("test", "coef")) if (exists("comptol", inherits=FALSE)) con$comptol <- comptol if (is.character(exact) && exact == "i") { skip.beta <- TRUE skip.alpha <- TRUE } ######################################################################### ######################################################################### ######################################################################### ### calculate number of permutations for an exact permutation test if (x$int.only) { ### for intercept-only models, there are 2^k possible permutations of the signs X.exact.iter <- 2^x$k } else { ### for meta-regression models, there are k! possible permutations of the rows of the model matrix #X.exact.iter <- round(exp(lfactorial(x$k))) # note: without round(), not exactly an integer! ### however, when there are duplicated rows in the model matrix, the number of *unique* permutations ### is lower; the code below below determines the number of unique permutations ### order the X matrix X <- as.data.frame(x$X)[do.call(order, as.data.frame(x$X)),] ### determine groupings X.indices <- cumsum(c(TRUE, !duplicated(X)[-1])) ### this turns 1,1,1,2,2,3,4,4,4 into 1,1,1,4,4,6,7,7,7 so that the actual row numbers can be permuted X.indices <- rep(cumsum(rle(X.indices)$lengths) - (rle(X.indices)$lengths - 1), rle(X.indices)$lengths) ### determine exact number of unique permutations ind.table <- table(X.indices) X.exact.iter <- round(prod((max(ind.table)+1):x$k) / prod(factorial(ind.table[-which.max(ind.table)]))) # cancel largest value in numerator and denominator to reduce overflow problems #X.exact.iter <- round(factorial(x$k) / prod(factorial(ind.table))) # definitional formula #X.exact.iter <- round(exp(lfactorial(x$k) - sum(lfactorial(ind.table)))) # using log of definitional formula and then round(exp()) if (is.na(X.exact.iter)) X.exact.iter <- Inf } i.exact.iter <- X.exact.iter if (!skip.beta) { ### if 'exact=TRUE' or if the number of iterations for an exact test are smaller ### than what is specified under 'iter', then carry out the exact test X.exact <- exact X.iter <- iter if (X.exact || (X.exact.iter <= X.iter)) { X.exact <- TRUE X.iter <- X.exact.iter } if (X.iter == Inf) stop(mstyle$stop("Too many iterations required for an exact permutation test of the location model.")) ###################################################################### ### generate seed (needed when X.exact=FALSE) if (!X.exact) { seed <- as.integer(runif(1)*2e9) if (!is.null(ddd$seed)) { set.seed(ddd$seed) } else { set.seed(seed) } } ### elements that need to be returned outlist <- "beta=beta, zval=zval, QM=QM" ###################################################################### if (progbar) cat(mstyle$verbose(paste0("Running ", X.iter, " iterations for an ", ifelse(X.exact, "exact", "approximate"), " permutation test of the location model.\n"))) if (x$int.only) { ### permutation test for intercept-only model zval.perm <- try(rep(NA_real_, X.iter), silent=TRUE) if (inherits(zval.perm, "try-error")) stop(mstyle$stop("Number of iterations requested too large.")) beta.perm <- try(rep(NA_real_, X.iter), silent=TRUE) if (inherits(beta.perm, "try-error")) stop(mstyle$stop("Number of iterations requested too large.")) QM.perm <- try(rep(NA_real_, X.iter), silent=TRUE) if (inherits(QM.perm, "try-error")) stop(mstyle$stop("Number of iterations requested too large.")) if (progbar) pbar <- pbapply::startpb(min=0, max=X.iter) if (X.exact) { # exact permutation test for intercept-only models signmat <- as.matrix(expand.grid(replicate(x$k, list(c(1,-1))), KEEP.OUT.ATTRS=FALSE)) for (i in seq_len(X.iter)) { args <- list(yi=signmat[i,]*x$yi, vi=x$vi, weights=x$weights, intercept=TRUE, scale=x$Z, link=x$link, method=x$method, weighted=x$weighted, test=x$test, level=x$level, btt=1, alpha=ifelse(x$alpha.fix, x$alpha, NA), optbeta=x$optbeta, beta=ifelse(x$beta.fix, x$beta, NA), control=x$control, skiphes=TRUE, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=!isTRUE(ddd$verbose)) if (inherits(res, "try-error")) next beta.perm[i] <- res$beta[,1] zval.perm[i] <- res$zval QM.perm[i] <- res$QM if (progbar) pbapply::setpb(pbar, i) } } else { # approximate permutation test for intercept-only models i <- 1 while (i <= X.iter) { signs <- sample(c(-1,1), x$k, replace=TRUE) # easier to understand (a tad slower for small k, but faster for larger k) #signs <- 2*rbinom(x$k,1,.5)-1 args <- list(yi=signs*x$yi, vi=x$vi, weights=x$weights, intercept=TRUE, scale=x$Z, link=x$link, method=x$method, weighted=x$weighted, test=x$test, level=x$level, btt=1, alpha=ifelse(x$alpha.fix, x$alpha, NA), optbeta=x$optbeta, beta=ifelse(x$beta.fix, x$beta, NA), control=x$control, skiphes=TRUE, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=!isTRUE(ddd$verbose)) if (inherits(res, "try-error")) next beta.perm[i] <- res$beta[,1] zval.perm[i] <- res$zval QM.perm[i] <- res$QM i <- i + 1 if (progbar) pbapply::setpb(pbar, i) } } ### the first random permutation is always the observed data (avoids possibility of p=0) if (!X.exact) { beta.perm[1] <- x$beta[,1] zval.perm[1] <- x$zval QM.perm[1] <- x$QM } if (con$alternative == "two.sided") { if (con$p2defn == "abs") { ### absolute value definition of the two-sided p-value if (con$stat == "test") { pval <- mean(abs(zval.perm) >= abs(x$zval) - con$comptol, na.rm=TRUE) # based on test statistic } else { pval <- mean(abs(beta.perm) >= abs(c(x$beta)) - con$comptol, na.rm=TRUE) # based on coefficient } } else { ### two times the one-sided p-value definition of the two-sided p-value if (con$stat == "test") { if (x$zval > median(zval.perm, na.rm=TRUE)) { pval <- 2*mean(zval.perm >= x$zval - con$comptol, na.rm=TRUE) # based on test statistic } else { pval <- 2*mean(zval.perm <= x$zval + con$comptol, na.rm=TRUE) } } else { if (c(x$beta) > median(beta.perm, na.rm=TRUE)) { pval <- 2*mean(beta.perm >= c(x$beta) - con$comptol, na.rm=TRUE) # based on coefficient } else { pval <- 2*mean(beta.perm <= c(x$beta) + con$comptol, na.rm=TRUE) } } } } if (con$alternative == "less") { if (con$stat == "test") { pval <- mean(zval.perm <= x$zval + con$comptol, na.rm=TRUE) # based on test statistic } else { pval <- mean(beta.perm <= c(x$beta) + con$comptol, na.rm=TRUE) # based on coefficient } } if (con$alternative == "greater") { if (con$stat == "test") { pval <- mean(zval.perm >= x$zval - con$comptol, na.rm=TRUE) # based on test statistic } else { pval <- mean(beta.perm >= c(x$beta) - con$comptol, na.rm=TRUE) # based on coefficient } } pval[pval > 1] <- 1 QMp <- mean(QM.perm >= x$QM - con$comptol, na.rm=TRUE) ###################################################################### } else { ### permutation test for meta-regression model zval.perm <- try(suppressWarnings(matrix(NA_real_, nrow=X.iter, ncol=x$p)), silent=TRUE) if (inherits(zval.perm, "try-error")) stop(mstyle$stop("Number of iterations requested too large.")) beta.perm <- try(suppressWarnings(matrix(NA_real_, nrow=X.iter, ncol=x$p)), silent=TRUE) if (inherits(beta.perm, "try-error")) stop(mstyle$stop("Number of iterations requested too large.")) QM.perm <- try(rep(NA_real_, X.iter), silent=TRUE) if (inherits(QM.perm, "try-error")) stop(mstyle$stop("Number of iterations requested too large.")) if (progbar) pbar <- pbapply::startpb(min=0, max=X.iter) if (X.exact) { # exact permutation test for meta-regression models #permmat <- .genperms(x$k) permmat <- .genuperms(X.indices) # use recursive algorithm to obtain all unique permutations for (i in seq_len(X.iter)) { args <- list(yi=x$yi, vi=x$vi, weights=x$weights, mods=cbind(X[permmat[i,],]), intercept=FALSE, scale=x$Z, link=x$link, method=x$method, weighted=x$weighted, test=x$test, level=x$level, btt=x$btt, alpha=ifelse(x$alpha.fix, x$alpha, NA), optbeta=x$optbeta, beta=ifelse(x$beta.fix, x$beta, NA), control=x$control, skiphes=FALSE, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=!isTRUE(ddd$verbose)) if (inherits(res, "try-error")) next beta.perm[i,] <- res$beta[,1] zval.perm[i,] <- res$zval QM.perm[i] <- res$QM if (progbar) pbapply::setpb(pbar, i) } } else { # approximate permutation test for meta-regression models i <- 1 while (i <= X.iter) { args <- list(yi=x$yi, vi=x$vi, weights=x$weights, mods=cbind(X[sample(x$k),]), intercept=FALSE, scale=x$Z, link=x$link, method=x$method, weighted=x$weighted, test=x$test, level=x$level, btt=x$btt, alpha=ifelse(x$alpha.fix, x$alpha, NA), optbeta=x$optbeta, beta=ifelse(x$beta.fix, x$beta, NA), control=x$control, skiphes=FALSE, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=!isTRUE(ddd$verbose)) if (inherits(res, "try-error")) next beta.perm[i,] <- res$beta[,1] zval.perm[i,] <- res$zval QM.perm[i] <- res$QM i <- i + 1 if (progbar) pbapply::setpb(pbar, i) } } ### the first random permutation is always the observed data (avoids possibility of p=0) if (!X.exact) { beta.perm[1,] <- x$beta[,1] zval.perm[1,] <- x$zval QM.perm[1] <- x$QM } if (con$alternative == "two.sided") { if (con$p2defn == "abs") { ### absolute value definition of the two-sided p-value if (con$stat == "test") { pval <- rowMeans(t(abs(zval.perm)) >= abs(x$zval) - con$comptol, na.rm=TRUE) # based on test statistics } else { pval <- rowMeans(t(abs(beta.perm)) >= abs(c(x$beta)) - con$comptol, na.rm=TRUE) # based on coefficients } } else { ### two times the one-sided p-value definition of the two-sided p-value pval <- rep(NA_real_, x$p) if (con$stat == "test") { for (j in seq_len(x$p)) { if (x$zval[j] > median(zval.perm[,j], na.rm=TRUE)) { pval[j] <- 2*mean(zval.perm[,j] >= x$zval[j] - con$comptol, na.rm=TRUE) } else { pval[j] <- 2*mean(zval.perm[,j] <= x$zval[j] + con$comptol, na.rm=TRUE) } } } else { for (j in seq_len(x$p)) { if (c(x$beta)[j] > median(beta.perm[,j], na.rm=TRUE)) { pval[j] <- 2*mean(beta.perm[,j] >= c(x$beta)[j] - con$comptol, na.rm=TRUE) } else { pval[j] <- 2*mean(beta.perm[,j] <= c(x$beta)[j] + con$comptol, na.rm=TRUE) } } } } } if (con$alternative == "less") { if (con$stat == "test") { pval <- rowMeans(t(zval.perm) <= x$zval + con$comptol, na.rm=TRUE) # based on test statistics } else { pval <- rowMeans(t(beta.perm) <= c(x$beta) + con$comptol, na.rm=TRUE) # based on coefficients } } if (con$alternative == "greater") { if (con$stat == "test") { pval <- rowMeans(t(zval.perm) >= x$zval - con$comptol, na.rm=TRUE) # based on test statistics } else { pval <- rowMeans(t(beta.perm) >= c(x$beta) - con$comptol, na.rm=TRUE) # based on coefficients } } pval[pval > 1] <- 1 QMp <- mean(QM.perm >= x$QM - con$comptol, na.rm=TRUE) } if (progbar) pbapply::closepb(pbar) } else { beta.perm <- NA_real_ zval.perm <- NA_real_ QM.perm <- NA_real_ pval <- x$pval QMp <- x$QMp X.exact.iter <- 0 } ######################################################################### ######################################################################### ######################################################################### ### calculate number of permutations for an exact permutation test Z <- as.data.frame(x$Z)[do.call(order, as.data.frame(x$Z)),] Z.indices <- cumsum(c(TRUE, !duplicated(Z)[-1])) Z.indices <- rep(cumsum(rle(Z.indices)$lengths) - (rle(Z.indices)$lengths - 1), rle(Z.indices)$lengths) ind.table <- table(Z.indices) Z.exact.iter <- round(prod((max(ind.table)+1):x$k) / prod(factorial(ind.table[-which.max(ind.table)]))) if (is.na(Z.exact.iter)) Z.exact.iter <- Inf if (x$Z.int.only) Z.exact.iter <- NA_integer_ i.exact.iter <- c(i.exact.iter, Z.exact.iter) if (!skip.alpha) { Z.exact <- exact Z.iter <- iter if (Z.exact || (Z.exact.iter <= Z.iter)) { Z.exact <- TRUE Z.iter <- Z.exact.iter } if (Z.iter == Inf) stop(mstyle$stop("Too many iterations required for an exact permutation test of the scale model.")) ######################################################################### ### generate seed (needed when Z.exact=FALSE) if (!Z.exact) { seed <- as.integer(runif(1)*2e9) if (!is.null(ddd$seed)) { set.seed(ddd$seed) } else { set.seed(seed) } } ### elements that need to be returned outlist <- "alpha=alpha, zval.alpha=zval.alpha, QS=QS" ######################################################################### if (progbar) cat(mstyle$verbose(paste0("Running ", Z.iter, " iterations for an ", ifelse(Z.exact, "exact", "approximate"), " permutation test of the scale model.\n"))) ### permutation test for the scale model zval.alpha.perm <- try(suppressWarnings(matrix(NA_real_, nrow=Z.iter, ncol=x$q)), silent=TRUE) if (inherits(zval.alpha.perm, "try-error")) stop(mstyle$stop("Number of iterations requested too large.")) alpha.perm <- try(suppressWarnings(matrix(NA_real_, nrow=Z.iter, ncol=x$q)), silent=TRUE) if (inherits(alpha.perm, "try-error")) stop(mstyle$stop("Number of iterations requested too large.")) QS.perm <- try(rep(NA_real_, Z.iter), silent=TRUE) if (inherits(QS.perm, "try-error")) stop(mstyle$stop("Number of iterations requested too large.")) if (progbar) pbar <- pbapply::startpb(min=0, max=Z.iter) if (Z.exact) { # exact permutation test for meta-regression models #permmat <- .genperms(x$k) permmat <- .genuperms(Z.indices) # use recursive algorithm to obtain all unique permutations for (i in seq_len(Z.iter)) { args <- list(yi=x$yi, vi=x$vi, weights=x$weights, mods=x$X, intercept=FALSE, scale=cbind(Z[permmat[i,],]), link=x$link, method=x$method, weighted=x$weighted, test=x$test, level=x$level, att=x$att, alpha=ifelse(x$alpha.fix, x$alpha, NA), optbeta=x$optbeta, beta=ifelse(x$beta.fix, x$beta, NA), control=x$control, skiphes=FALSE, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=!isTRUE(ddd$verbose)) if (inherits(res, "try-error")) next alpha.perm[i,] <- res$alpha[,1] zval.alpha.perm[i,] <- res$zval.alpha QS.perm[i] <- res$QS if (progbar) pbapply::setpb(pbar, i) } } else { # approximate permutation test for meta-regression models i <- 1 while (i <= Z.iter) { args <- list(yi=x$yi, vi=x$vi, weights=x$weights, mods=x$X, intercept=FALSE, scale=cbind(Z[sample(x$k),]), link=x$link, method=x$method, weighted=x$weighted, test=x$test, level=x$level, att=x$att, alpha=ifelse(x$alpha.fix, x$alpha, NA), optbeta=x$optbeta, beta=ifelse(x$beta.fix, x$beta, NA), control=x$control, skiphes=FALSE, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=!isTRUE(ddd$verbose)) if (inherits(res, "try-error")) next alpha.perm[i,] <- res$alpha[,1] zval.alpha.perm[i,] <- res$zval.alpha QS.perm[i] <- res$QS i <- i + 1 if (progbar) pbapply::setpb(pbar, i) } } ### the first random permutation is always the observed data (avoids possibility of p=0) if (!Z.exact) { alpha.perm[1,] <- x$alpha[,1] zval.alpha.perm[1,] <- x$zval.alpha QS.perm[1] <- x$QS } if (con$alternative == "two.sided") { if (con$p2defn == "abs") { ### absolute value definition of the two-sided p-value if (con$stat == "test") { pval.alpha <- rowMeans(t(abs(zval.alpha.perm)) >= abs(x$zval.alpha) - con$comptol, na.rm=TRUE) # based on test statistics } else { pval.alpha <- rowMeans(t(abs(alpha.perm)) >= abs(c(x$alpha)) - con$comptol, na.rm=TRUE) # based on coefficients } } else { ### two times the one-sided p-value definition of the two-sided p-value pval.alpha <- rep(NA_real_, x$q) if (con$stat == "test") { for (j in seq_len(x$q)) { if (x$zval.alpha[j] > median(zval.alpha.perm[,j], na.rm=TRUE)) { pval.alpha[j] <- 2*mean(zval.alpha.perm[,j] >= x$zval.alpha.[j] - con$comptol, na.rm=TRUE) } else { pval.alpha[j] <- 2*mean(zval.alpha.perm[,j] <= x$zval.alpha.[j] + con$comptol, na.rm=TRUE) } } } else { for (j in seq_len(x$q)) { if (c(x$alpha)[j] > median(alpha.perm[,j], na.rm=TRUE)) { pval.alpha[j] <- 2*mean(alpha.perm[,j] >= c(x$alpha)[j] - con$comptol, na.rm=TRUE) } else { pval.alpha[j] <- 2*mean(alpha.perm[,j] <= c(x$alpha)[j] + con$comptol, na.rm=TRUE) } } } } } if (con$alternative == "less") { if (con$stat == "test") { pval.alpha <- rowMeans(t(zval.alpha.perm) <= x$zval.alpha + con$comptol, na.rm=TRUE) # based on test statistics } else { pval.alpha <- rowMeans(t(alpha.perm) <= c(x$alpha) + con$comptol, na.rm=TRUE) # based on coefficients } } if (con$alternative == "greater") { if (con$stat == "test") { pval.alpha <- rowMeans(t(zval.alpha.perm) >= x$zval.alpha - con$comptol, na.rm=TRUE) # based on test statistics } else { pval.alpha <- rowMeans(t(alpha.perm) >= c(x$alpha) - con$comptol, na.rm=TRUE) # based on coefficients } } pval.alpha[pval.alpha > 1] <- 1 pval.alpha[x$alpha.fix] <- NA_real_ QSp <- mean(QS.perm >= x$QS - con$comptol, na.rm=TRUE) if (progbar) pbapply::closepb(pbar) } else { alpha.perm <- NA_real_ zval.alpha.perm <- NA_real_ QS.perm <- NA_real_ pval.alpha <- x$pval.alpha QSp <- NA_real_ Z.exact.iter <- 0 } ############################################################################ ############################################################################ ############################################################################ if (is.character(exact) && exact == "i") return(i.exact.iter) out <- list(pval=pval, QMdf=x$QMdf, QMp=QMp, beta=x$beta, se=x$se, zval=x$zval, ci.lb=x$ci.lb, ci.ub=x$ci.ub, QM=x$QM, pval.alpha=pval.alpha, QSdf=x$QSdf, QSp=QSp, alpha=x$alpha, se.alpha=x$se.alpha, zval.alpha=x$zval.alpha, ci.lb.alpha=x$ci.lb.alpha, ci.ub.alpha=x$ci.ub.alpha, QS=x$QS, k=x$k, p=x$p, btt=x$btt, m=x$m, test=x$test, dfs=x$dfs, ddf=x$ddf, q=x$q, att=x$att, m.alpha=x$m.alpha, ddf.alpha=x$ddf.alpha, int.only=x$int.only, int.incl=x$int.incl, Z.int.only=x$Z.int.only, Z.int.incl=x$Z.int.incl, digits=digits, exact.iter=X.exact.iter, Z.exact.iter=Z.exact.iter, permci=FALSE, alternative=con$alternative, p2defn=con$p2defn, stat=con$stat) out$skip.beta <- skip.beta out$QM.perm <- QM.perm out$zval.perm <- data.frame(zval.perm) out$beta.perm <- data.frame(beta.perm) if (!skip.beta) names(out$zval.perm) <- names(out$beta.perm) <- colnames(x$X) out$skip.alpha <- skip.alpha out$QS.perm <- QS.perm out$zval.alpha.perm <- data.frame(zval.alpha.perm) out$alpha.perm <- data.frame(alpha.perm) if (!skip.alpha) names(out$zval.alpha.perm) <- names(out$alpha.perm) <- colnames(x$Z) if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(out) <- c("permutest.rma.ls", "permutest.rma.uni") return(out) } metafor/R/profile.rma.uni.r0000644000176200001440000001457514401676275015333 0ustar liggesusersprofile.rma.uni <- function(fitted, xlim, ylim, steps=20, lltol=1e-03, progbar=TRUE, parallel="no", ncpus=1, cl, plot=TRUE, pch=19, refline=TRUE, cline=FALSE, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(fitted), must="rma.uni", notav=c("rma.gen", "rma.uni.selmodel")) if (is.element(fitted$method, c("FE","EE","CE"))) stop(mstyle$stop("Cannot profile tau2 parameter for equal/fixed-effects models.")) if (steps < 2) stop(mstyle$stop("Argument 'steps' must be >= 2.")) x <- fitted parallel <- match.arg(parallel, c("no", "snow", "multicore")) if (parallel == "no" && ncpus > 1) parallel <- "snow" if (missing(cl)) cl <- NULL if (!is.null(cl) && inherits(cl, "SOCKcluster")) { parallel <- "snow" ncpus <- length(cl) } if (parallel == "snow" && ncpus < 2) parallel <- "no" if (parallel == "snow" || parallel == "multicore") { if (!requireNamespace("parallel", quietly=TRUE)) stop(mstyle$stop("Please install the 'parallel' package for parallel processing.")) ncpus <- as.integer(ncpus) if (ncpus < 1L) stop(mstyle$stop("Argument 'ncpus' must be >= 1.")) } if (!progbar) { pbo <- pbapply::pboptions(type="none") on.exit(pbapply::pboptions(pbo), add=TRUE) } ddd <- list(...) if (.isTRUE(ddd$time)) time.start <- proc.time() ######################################################################### if (missing(xlim)) { ### if the user has not specified xlim, try to get CI for tau^2 vc.ci <- try(suppressWarnings(confint(x)), silent=TRUE) if (inherits(vc.ci, "try-error")) { vc.lb <- NA_real_ vc.ub <- NA_real_ } else { ### min() and max() so the actual value is within the xlim bounds ### could still get NAs for the bounds if the CI is the empty set vc.lb <- min(x$tau2, vc.ci$random[1,2]) vc.ub <- max(.1, x$tau2, vc.ci$random[1,3]) ### if CI is equal to null set, then this still gives vc.ub = .1 } if (is.na(vc.lb) || is.na(vc.ub)) { ### if the CI method fails, try a Wald-type CI for tau^2 vc.lb <- max( 0, x$tau2 - qnorm(.995) * x$se.tau2) vc.ub <- max(.1, x$tau2 + qnorm(.995) * x$se.tau2) } if (is.na(vc.lb) || is.na(vc.ub)) { ### if this still results in NA bounds, use simple method vc.lb <- max( 0, x$tau2/4) vc.ub <- max(.1, x$tau2*4) } ### if all of that fails, throw an error if (is.na(vc.lb) || is.na(vc.ub)) stop(mstyle$stop("Cannot set 'xlim' automatically. Please set this argument manually.")) xlim <- c(vc.lb, vc.ub) } else { if (length(xlim) != 2L) stop(mstyle$stop("Argument 'xlim' should be a vector of length 2.")) xlim <- sort(xlim) } vcs <- seq(xlim[1], xlim[2], length.out=steps) #return(vcs) if (length(vcs) <= 1L) stop(mstyle$stop("Cannot set 'xlim' automatically. Please set this argument manually.")) if (parallel == "no") res <- pbapply::pblapply(vcs, .profile.rma.uni, obj=x, parallel=parallel, profile=TRUE) if (parallel == "multicore") res <- pbapply::pblapply(vcs, .profile.rma.uni, obj=x, parallel=parallel, profile=TRUE, cl=ncpus) #res <- parallel::mclapply(vcs, .profile.rma.uni, obj=x, parallel=parallel, profile=TRUE, mc.cores=ncpus) if (parallel == "snow") { if (is.null(cl)) { cl <- parallel::makePSOCKcluster(ncpus) on.exit(parallel::stopCluster(cl), add=TRUE) } if (.isTRUE(ddd$LB)) { res <- parallel::parLapplyLB(cl, vcs, .profile.rma.uni, obj=x, parallel=parallel, profile=TRUE) #res <- parallel::clusterApplyLB(cl, vcs, .profile.rma.uni, obj=x, parallel=parallel, profile=TRUE) #res <- parallel::clusterMap(cl, .profile.rma.uni, vcs, MoreArgs=list(obj=x, parallel=parallel, profile=TRUE), .scheduling = "dynamic") } else { res <- pbapply::pblapply(vcs, .profile.rma.uni, obj=x, parallel=parallel, profile=TRUE, cl=cl) #res <- parallel::parLapply(cl, vcs, .profile.rma.uni, obj=x, parallel=parallel, profile=TRUE) #res <- parallel::clusterApply(cl, vcs, .profile.rma.uni, obj=x, parallel=parallel, profile=TRUE) #res <- parallel::clusterMap(cl, .profile.rma.uni, vcs, MoreArgs=list(obj=x, parallel=parallel, profile=TRUE)) } } lls <- sapply(res, function(x) x$ll) beta <- do.call(rbind, lapply(res, function(x) t(x$beta))) ci.lb <- do.call(rbind, lapply(res, function(x) t(x$ci.lb))) ci.ub <- do.call(rbind, lapply(res, function(x) t(x$ci.ub))) ######################################################################### if (x$method %in% c("ML", "REML") && any(lls >= logLik(x) + lltol, na.rm=TRUE)) warning(mstyle$warning("At least one profiled log-likelihood value is larger than the log-likelihood of the fitted model."), call.=FALSE) if (all(is.na(lls))) warning(mstyle$warning("All model fits failed. Cannot draw profile likelihood plot."), call.=FALSE) beta <- data.frame(beta) ci.lb <- data.frame(ci.lb) ci.ub <- data.frame(ci.ub) names(beta) <- rownames(x$beta) names(ci.lb) <- rownames(x$beta) names(ci.ub) <- rownames(x$beta) if (missing(ylim)) { if (any(is.finite(lls))) { if (xlim[1] <= x$tau2 && xlim[2] >= x$tau2) { ylim <- range(c(logLik(x),lls[is.finite(lls)]), na.rm=TRUE) } else { ylim <- range(lls[is.finite(lls)]) } } else { ylim <- rep(logLik(x), 2L) } ylim <- ylim + c(-0.1, 0.1) } else { if (length(ylim) != 2L) stop(mstyle$stop("Argument 'ylim' should be a vector of length 2.")) ylim <- sort(ylim) } xlab <- expression(paste(tau^2, " Value")) title <- expression(paste("Profile Plot for ", tau^2)) sav <- list(tau2=vcs, ll=lls, beta=beta, ci.lb=ci.lb, ci.ub=ci.ub, comps=1, xlim=xlim, ylim=ylim, method=x$method, vc=x$tau2, maxll=logLik(x), xlab=xlab, title=title) class(sav) <- "profile.rma" ######################################################################### if (plot) plot(sav, pch=pch, refline=refline, cline=cline, ...) ######################################################################### if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } invisible(sav) } metafor/R/methods.vif.rma.r0000644000176200001440000000233614277371247015321 0ustar liggesusers############################################################################ as.data.frame.vif.rma <- function(x, ...) { .chkclass(class(x), must="vif.rma") if (!is.null(x$alpha)) { tab <- list(beta = as.data.frame(x[[1]], ...), alpha = as.data.frame(x[[2]], ...)) } else { tab <- data.frame(spec = sapply(x$vif, function(x) x$spec), coefs = sapply(x$vif, function(x) x$coefs), m = sapply(x$vif, function(x) x$m), vif = sapply(x$vif, function(x) x$vif), sif = sapply(x$vif, function(x) x$sif)) # add proportions if they are available if (!is.null(x$prop)) tab$prop <- x$prop #names(tab)[2] <- "coef(s)" #names(tab)[4] <- "(g)vif" #names(tab)[5] <- "(g)sif" # if all btt/att specifications are numeric, remove the 'spec' column if (all(substr(tab$spec, 1, 1) %in% as.character(1:9))) tab$spec <- NULL # just use numbers for row names when btt was specified if (isTRUE(x$bttspec) || isTRUE(x$attspec)) rownames(tab) <- NULL } return(tab) } ############################################################################ metafor/R/weights.rma.mh.r0000644000176200001440000000350414247653652015146 0ustar liggesusersweights.rma.mh <- function(object, type="diagonal", ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma.mh") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) type <- match.arg(type, c("diagonal", "matrix")) x <- object ######################################################################### if (is.element(x$measure, c("RR","OR","RD"))) { Ni <- with(x$outdat, ai + bi + ci + di) } else { Ti <- with(x$outdat, t1i + t2i) } if (x$measure == "OR") wi <- with(x$outdat, (bi / Ni) * ci) if (x$measure == "RR") wi <- with(x$outdat, (ci / Ni) * (ai+bi)) if (x$measure == "RD") wi <- with(x$outdat, ((ai+bi) / Ni) * (ci+di)) if (x$measure == "IRR") wi <- with(x$outdat, (x2i / Ti) * t1i) if (x$measure == "IRD") wi <- with(x$outdat, (t1i / Ti) * t2i) ######################################################################### if (type == "diagonal") { weight <- rep(NA_real_, x$k.f) weight[x$not.na] <- wi / sum(wi) * 100 names(weight) <- x$slab if (na.act == "na.omit") weight <- weight[x$not.na] if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in weights.")) return(weight) } if (type == "matrix") { Wfull <- matrix(NA_real_, nrow=x$k.f, ncol=x$k.f) Wfull[x$not.na, x$not.na] <- diag(wi) rownames(Wfull) <- x$slab colnames(Wfull) <- x$slab if (na.act == "na.omit") Wfull <- Wfull[x$not.na, x$not.na, drop=FALSE] if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) return(Wfull) } } metafor/R/print.gosh.rma.r0000644000176200001440000000276114401676066015164 0ustar liggesusersprint.gosh.rma <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="gosh.rma") digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) .space() cat(mstyle$text("Model fits attempted: ")) cat(mstyle$result(length(x$fit))) cat("\n") cat(mstyle$text("Model fits succeeded: ")) cat(mstyle$result(sum(x$fit))) cat("\n\n") res.table <- matrix(NA_real_, nrow=ncol(x$res), ncol=6) res.table[,1] <- apply(x$res, 2, mean, na.rm=TRUE) res.table[,2] <- apply(x$res, 2, min, na.rm=TRUE) res.table[,3] <- apply(x$res, 2, quantile, .25, na.rm=TRUE) res.table[,4] <- apply(x$res, 2, quantile, .50, na.rm=TRUE) res.table[,5] <- apply(x$res, 2, quantile, .75, na.rm=TRUE) res.table[,6] <- apply(x$res, 2, max, na.rm=TRUE) res.table <- fmtx(res.table, digits[["est"]]) colnames(res.table) <- c("mean", "min", "q1", "median", "q3", "max") rownames(res.table) <- colnames(x$res) if (ncol(x$res) == 6) rownames(res.table)[2] <- "Q" ### add blank row before the model coefficients in meta-regression models if (ncol(x$res) > 6) res.table <- rbind(res.table[seq_len(5),], "", res.table[6:nrow(res.table),,drop=FALSE]) ### remove row for tau^2 in FE/EE/CE models if (is.element(x$method, c("FE","EE","CE"))) res.table <- res.table[-5,] tmp <- capture.output(print(res.table, quote=FALSE, right=TRUE)) .print.table(tmp, mstyle) .space() invisible() } metafor/R/deviance.rma.r0000644000176200001440000000105214300732073014624 0ustar liggesusersdeviance.rma <- function(object, REML, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="rma") # in case something like logLik(res1, res2) is used if (!missing(REML) && inherits(REML, "rma")) REML <- NULL if (missing(REML) || is.null(REML)) { if (object$method == "REML") { REML <- TRUE } else { REML <- FALSE } } if (REML) { val <- object$fit.stats["dev","REML"] } else { val <- object$fit.stats["dev","ML"] } return(val) } metafor/R/cooks.distance.rma.mv.r0000644000176200001440000001271014246125171016405 0ustar liggesuserscooks.distance.rma.mv <- function(model, progbar=FALSE, cluster, reestimate=TRUE, parallel="no", ncpus=1, cl, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(model), must="rma.mv") #if (inherits(model, "robust.rma")) ### can compute Cook's distance also for 'robust.rma' objects # stop(mstyle$stop("Method not available for objects of class \"robust.rma\".")) na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) x <- model parallel <- match.arg(parallel, c("no", "snow", "multicore")) if (parallel == "no" && ncpus > 1) parallel <- "snow" if (missing(cl)) cl <- NULL if (!is.null(cl) && inherits(cl, "SOCKcluster")) { parallel <- "snow" ncpus <- length(cl) } if (parallel == "snow" && ncpus < 2) parallel <- "no" if (parallel == "snow" || parallel == "multicore") { if (!requireNamespace("parallel", quietly=TRUE)) stop(mstyle$stop("Please install the 'parallel' package for parallel processing.")) ncpus <- as.integer(ncpus) if (ncpus < 1L) stop(mstyle$stop("Argument 'ncpus' must be >= 1.")) } if (!progbar) { pbo <- pbapply::pboptions(type="none") on.exit(pbapply::pboptions(pbo), add=TRUE) } misscluster <- ifelse(missing(cluster), TRUE, FALSE) if (misscluster) { cluster <- seq_len(x$k.all) } else { mf <- match.call() cluster <- .getx("cluster", mf=mf, data=x$data) } ddd <- list(...) .chkdots(ddd, c("btt", "time", "LB")) btt <- .set.btt(ddd$btt, x$p, int.incl=FALSE, Xnames=colnames(x$X)) m <- length(btt) if (.isTRUE(ddd$time)) time.start <- proc.time() ######################################################################### ### process cluster variable # note: cluster variable is assumed to be of the same length as the size of # the original dataset passed to the model fitting function and so we apply # the same subsetting and removing of missings (if necessary) as was done # during model fitting if (length(cluster) != x$k.all) stop(mstyle$stop(paste0("Length of variable specified via 'cluster' (", length(cluster), ") does not match length of data (", x$k.all, ")."))) cluster <- .getsubset(cluster, x$subset) cluster.f <- cluster cluster <- cluster[x$not.na] ### checks on cluster variable if (anyNA(cluster.f)) stop(mstyle$stop("No missing values allowed in 'cluster' variable.")) if (length(cluster.f) == 0L) stop(mstyle$stop(paste0("Cannot find 'cluster' variable (or it has zero length)."))) ### cluster ids and number of clusters ids <- unique(cluster) n <- length(ids) ######################################################################### ### calculate inverse of variance-covariance matrix under the full model svb <- chol2inv(chol(x$vb[btt,btt,drop=FALSE])) if (parallel == "no") res <- pbapply::pblapply(seq_len(n), .cooks.distance.rma.mv, obj=x, parallel=parallel, svb=svb, cluster=cluster, ids=ids, reestimate=reestimate, btt=btt) if (parallel == "multicore") res <- pbapply::pblapply(seq_len(n), .cooks.distance.rma.mv, obj=x, parallel=parallel, svb=svb, cluster=cluster, ids=ids, reestimate=reestimate, btt=btt, cl=ncpus) #res <- parallel::mclapply(seq_len(n), .cooks.distance.rma.mv, obj=x, parallel=parallel, svb=svb, cluster=cluster, ids=ids, reestimate=reestimate, btt=btt, mc.cores=ncpus) if (parallel == "snow") { if (is.null(cl)) { cl <- parallel::makePSOCKcluster(ncpus) on.exit(parallel::stopCluster(cl), add=TRUE) } if (.isTRUE(ddd$LB)) { res <- parallel::parLapplyLB(cl, seq_len(n), .cooks.distance.rma.mv, obj=x, parallel=parallel, svb=svb, cluster=cluster, ids=ids, reestimate=reestimate, btt=btt) #res <- parallel::clusterApplyLB(cl, seq_len(n), .cooks.distance.rma.mv, obj=x, parallel=parallel, svb=svb, cluster=cluster, ids=ids, reestimate=reestimate, btt=btt) } else { res <- pbapply::pblapply(seq_len(n), .cooks.distance.rma.mv, obj=x, parallel=parallel, svb=svb, cluster=cluster, ids=ids, reestimate=reestimate, btt=btt, cl=cl) #res <- parallel::parLapply(cl, seq_len(n), .cooks.distance.rma.mv, obj=x, parallel=parallel, svb=svb, cluster=cluster, ids=ids, reestimate=reestimate, btt=btt) #res <- parallel::clusterApply(cl, seq_len(n), .cooks.distance.rma.mv, obj=x, parallel=parallel, svb=svb, cluster=cluster, ids=ids, reestimate=reestimate, btt=btt) } } cook.d <- sapply(res, function(x) x$cook.d) ######################################################################### if (na.act == "na.omit") { out <- cook.d if (misscluster) { names(out) <- x$slab[x$not.na] } else { names(out) <- ids out <- out[order(ids)] } } if (na.act == "na.exclude" || na.act == "na.pass") { ids.f <- unique(cluster.f) out <- rep(NA_real_, length(ids.f)) out[match(ids, ids.f)] <- cook.d if (misscluster) { names(out) <- x$slab } else { names(out) <- ids.f out <- out[order(ids.f)] } } if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } return(out) } metafor/R/dfbetas.rma.mv.r0000644000176200001440000001177514246125221015114 0ustar liggesusersdfbetas.rma.mv <- function(model, progbar=FALSE, cluster, reestimate=TRUE, parallel="no", ncpus=1, cl, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(model), must="rma.mv", notav="robust.rma") na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) x <- model parallel <- match.arg(parallel, c("no", "snow", "multicore")) if (parallel == "no" && ncpus > 1) parallel <- "snow" if (missing(cl)) cl <- NULL if (!is.null(cl) && inherits(cl, "SOCKcluster")) { parallel <- "snow" ncpus <- length(cl) } if (parallel == "snow" && ncpus < 2) parallel <- "no" if (parallel == "snow" || parallel == "multicore") { if (!requireNamespace("parallel", quietly=TRUE)) stop(mstyle$stop("Please install the 'parallel' package for parallel processing.")) ncpus <- as.integer(ncpus) if (ncpus < 1L) stop(mstyle$stop("Argument 'ncpus' must be >= 1.")) } if (!progbar) { pbo <- pbapply::pboptions(type="none") on.exit(pbapply::pboptions(pbo), add=TRUE) } misscluster <- ifelse(missing(cluster), TRUE, FALSE) if (misscluster) { cluster <- seq_len(x$k.all) } else { mf <- match.call() cluster <- .getx("cluster", mf=mf, data=x$data) } ddd <- list(...) .chkdots(ddd, c("time", "LB")) if (.isTRUE(ddd$time)) time.start <- proc.time() ######################################################################### ### process cluster variable # note: cluster variable is assumed to be of the same length as the size of # the original dataset passed to the model fitting function and so we apply # the same subsetting and removing of missings (if necessary) as was done # during model fitting if (length(cluster) != x$k.all) stop(mstyle$stop(paste0("Length of variable specified via 'cluster' (", length(cluster), ") does not match length of data (", x$k.all, ")."))) cluster <- .getsubset(cluster, x$subset) cluster.f <- cluster cluster <- cluster[x$not.na] ### checks on cluster variable if (anyNA(cluster.f)) stop(mstyle$stop("No missing values allowed in 'cluster' variable.")) if (length(cluster.f) == 0L) stop(mstyle$stop(paste0("Cannot find 'cluster' variable (or it has zero length)."))) ### cluster ids and number of clusters ids <- unique(cluster) n <- length(ids) ######################################################################### if (parallel == "no") res <- pbapply::pblapply(seq_len(n), .dfbetas.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate) if (parallel == "multicore") res <- pbapply::pblapply(seq_len(n), .dfbetas.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate, cl=ncpus) #res <- parallel::mclapply(seq_len(n), .dfbetas.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate, mc.cores=ncpus) if (parallel == "snow") { if (is.null(cl)) { cl <- parallel::makePSOCKcluster(ncpus) on.exit(parallel::stopCluster(cl), add=TRUE) } if (.isTRUE(ddd$LB)) { res <- parallel::parLapplyLB(cl, seq_len(n), .dfbetas.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate) #res <- parallel::clusterApplyLB(cl, seq_len(n), .dfbetas.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate) } else { res <- pbapply::pblapply(seq_len(n), .dfbetas.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate, cl=cl) #res <- parallel::parLapply(cl, seq_len(n), .dfbetas.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate) #res <- parallel::clusterApply(cl, seq_len(n), .dfbetas.rma.mv, obj=x, parallel=parallel, cluster=cluster, ids=ids, reestimate=reestimate) } } dfbs <- lapply(res, function(x) x$dfbs) dfbs <- do.call(rbind, dfbs) ######################################################################### if (na.act == "na.omit") { out <- dfbs if (misscluster) { rownames(out) <- x$slab[x$not.na] } else { rownames(out) <- ids out <- out[order(ids),,drop=FALSE] } } if (na.act == "na.exclude" || na.act == "na.pass") { ids.f <- unique(cluster.f) out <- matrix(NA_real_, nrow=length(ids.f), ncol=x$p) out[match(ids, ids.f),] <- dfbs if (misscluster) { rownames(out) <- x$slab } else { rownames(out) <- ids.f out <- out[order(ids.f),,drop=FALSE] } } if (na.act == "na.fail" && any(!x$not.na)) stop(mstyle$stop("Missing values in results.")) colnames(out) <- rownames(x$beta) out <- data.frame(out) if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } return(out) } metafor/R/forest.r0000644000176200001440000000006213674405412013601 0ustar liggesusersforest <- function(x, ...) UseMethod("forest") metafor/R/misc.func.hidden.glmm.r0000644000176200001440000001233614401670622016354 0ustar liggesusers############################################################################ ### density of non-central hypergeometric distribution (based on Liao and Rosen, 2001) from MCMCpack ### Liao, J. G. & Rosen, O. (2001). Fast and stable algorithms for computing and sampling from the ### noncentral hypergeometric distribution. The American Statistician, 55, 366-369. .dnoncenhypergeom <- function (x=NA_real_, n1, n2, m1, psi) { ### x=ai, n1=ai+bi, n2=ci+di, m1=ai+ci, psi=ORi mstyle <- .get.mstyle("crayon" %in% .packages()) mode.compute <- function(n1, n2, m1, psi, ll, uu) { a <- psi - 1 b <- -((m1 + n1 + 2) * psi + n2 - m1) c <- psi * (n1 + 1) * (m1 + 1) q <- b + sign(b) * sqrt(b * b - 4 * a * c) q <- -q/2 mode <- trunc(c/q) if (uu >= mode && mode >= ll) return(mode) else return(trunc(q/a)) } r.function <- function(n1, n2, m1, psi, i) { (n1 - i + 1) * (m1 - i + 1)/i/(n2 - m1 + i) * psi } ll <- max(0, m1 - n2) uu <- min(n1, m1) if (n1 < 0 | n2 < 0) stop(mstyle$stop("'n1' or 'n2' negative in dnoncenhypergeom()."), call.=FALSE) if (m1 < 0 | m1 > (n1 + n2)) stop(mstyle$stop("'m1' out of range in dnoncenhypergeom().")) if (psi <= 0) stop(mstyle$stop("'psi' [odds ratio] negative in dnoncenhypergeom()."), call.=FALSE) if (!is.na(x) & (x < ll | x > uu)) stop(mstyle$stop("'x' out of bounds in dnoncenhypergeom().")) if (!is.na(x) & length(x) > 1L) stop(mstyle$stop("'x' neither missing or scalar in dnoncenhypergeom()."), call.=FALSE) mode <- mode.compute(n1, n2, m1, psi, ll, uu) pi <- array(1, uu - ll + 1) shift <- 1 - ll if (mode < uu) { r1 <- r.function(n1, n2, m1, psi, (mode + 1):uu) pi[(mode + 1 + shift):(uu + shift)] <- cumprod(r1) } if (mode > ll) { r1 <- 1/r.function(n1, n2, m1, psi, mode:(ll + 1)) pi[(mode - 1 + shift):(ll + shift)] <- cumprod(r1) } pi <- pi/sum(pi) if (is.na(x)) { return(cbind(ll:uu, pi)) } else { return(pi[x + shift]) } } ############################################################################ ### density of non-central hypergeometric distribution for fixed- and random/mixed-effects models .dnchgi <- function(logOR, ai, bi, ci, di, mu.i, tau2, random, dnchgcalc, dnchgprec) { mstyle <- .get.mstyle("crayon" %in% .packages()) k <- length(logOR) dnchgi <- rep(NA_real_, k) ### beyond these values, the results from dFNCHypergeo (from BiasedUrn package) become unstable pow <- 12 logOR[logOR < log(10^-pow)] <- log(10^-pow) logOR[logOR > log(10^pow)] <- log(10^pow) for (i in seq_len(k)) { ORi <- exp(logOR[i]) if (dnchgcalc == "dnoncenhypergeom") { res <- try(.dnoncenhypergeom(x=ai, n1=ai+bi, n2=ci+di, m1=ai+ci, psi=ORi)) } else { res <- try(BiasedUrn::dFNCHypergeo(x=ai, m1=ai+bi, m2=ci+di, n=ai+ci, odds=ORi, precision=dnchgprec)) } if (inherits(res, "try-error")) { stop(mstyle$stop(paste0("Could not compute density of non-central hypergeometric distribution in study ", i, ".")), call.=FALSE) } else { dnchgi[i] <- res } } if (random) dnchgi <- dnchgi * dnorm(logOR, mu.i, sqrt(tau2)) return(dnchgi) } ############################################################################ ### joint density of k non-central hypergeometric distributions for fixed- and random/mixed-effects models .dnchg <- function(parms, ai, bi, ci, di, X.fit, random, verbose=FALSE, digits, dnchgcalc, dnchgprec, intCtrl) { mstyle <- .get.mstyle("crayon" %in% .packages()) p <- ncol(X.fit) k <- length(ai) beta <- parms[seq_len(p)] ### first p elemenets in parms are the model coefficients tau2 <- ifelse(random, exp(parms[p+1]), 0) ### next value is tau^2 -- optimize over exp(tau^2) value or hold at 0 if random=FALSE mu.i <- X.fit %*% cbind(beta) lli <- rep(NA_real_, k) if (!random) { for (i in seq_len(k)) { lli[i] <- log(.dnchgi(logOR=mu.i[i], ai=ai[i], bi=bi[i], ci=ci[i], di=di[i], random=random, dnchgcalc=dnchgcalc, dnchgprec=dnchgprec)) } if (verbose) cat(mstyle$verbose(paste("ll =", fmtx(sum(lli), digits[["fit"]]), " ", fmtx(beta, digits[["est"]]), "\n"))) } if (random) { for (i in seq_len(k)) { res <- try(integrate(.dnchgi, lower=intCtrl$lower, upper=intCtrl$upper, ai=ai[i], bi=bi[i], ci=ci[i], di=di[i], mu.i=mu.i[i], tau2=tau2, random=random, dnchgcalc=dnchgcalc, dnchgprec=dnchgprec, rel.tol=intCtrl$rel.tol, subdivisions=intCtrl$subdivisions, stop.on.error=FALSE), silent=!verbose) if (inherits(res, "try-error")) { stop(mstyle$stop(paste0("Could not integrate over density of non-central hypergeometric distribution in study ", i, ".")), call.=FALSE) } else { if (res$value > 0) { lli[i] <- log(res$value) } else { lli[i] <- -Inf } } } if (verbose) cat(mstyle$verbose(paste("ll = ", fmtx(sum(lli), digits[["fit"]]), " ", fmtx(tau2, digits[["var"]]), " ", fmtx(beta, digits[["est"]]), "\n"))) } return(-sum(lli)) } ############################################################################ metafor/R/coef.permutest.rma.uni.r0000644000176200001440000000176714221147207016621 0ustar liggesuserscoef.permutest.rma.uni <- function(object, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(object), must="permutest.rma.uni") x <- object if (is.element(x$test, c("knha","adhoc","t"))) { res.table <- data.frame(estimate=x$beta, se=x$se, tval=x$zval, df=x$ddf, pval=x$pval, ci.lb=x$ci.lb, ci.ub=x$ci.ub) } else { res.table <- data.frame(estimate=x$beta, se=x$se, zval=x$zval, pval=x$pval, ci.lb=x$ci.lb, ci.ub=x$ci.ub) } if (inherits(x, "permutest.rma.ls")) { if (is.element(x$test, c("knha","adhoc","t"))) { res.table.alpha <- data.frame(estimate=x$alpha, se=x$se.alpha, tval=x$zval.alpha, df=x$ddf.alpha, pval=x$pval.alpha, ci.lb=x$ci.lb.alpha, ci.ub=x$ci.ub.alpha) } else { res.table.alpha <- data.frame(estimate=x$alpha, se=x$se.alpha, zval=x$zval.alpha, pval=x$pval.alpha, ci.lb=x$ci.lb.alpha, ci.ub=x$ci.ub.alpha) } res.table <- list(beta=res.table, alpha=res.table.alpha) } return(res.table) } metafor/R/bldiag.r0000644000176200001440000000361014160074151013514 0ustar liggesusersbldiag <- function(..., order) { mstyle <- .get.mstyle("crayon" %in% .packages()) mlist <- list(...) ### handle case in which a list of matrices is given if (length(mlist)==1L && is.list(mlist[[1]])) mlist <- unlist(mlist, recursive=FALSE) ### make sure each element is a matrix (so that bldiag(matrix(1, nrow=3, ncol=3), 2) also works) mlist <- lapply(mlist, function(x) if (inherits(x, "matrix")) x else diag(x, nrow=length(x), ncol=length(x))) ### find any ?x0 or 0x? matrices is00 <- sapply(mlist, function(x) any(dim(x) == c(0L,0L))) ### if all are ?x0 or 0x? matrices, return 0x0 matrix if (all(is00)) return(matrix(nrow=0, ncol=0)) ### otherwise filter out those matrices (if there are any) if (any(is00)) mlist <- mlist[!is00] csdim <- rbind(c(0,0), apply(sapply(mlist,dim), 1, cumsum)) ### consider using rowCumsums() from matrixStats package out <- array(0, dim=csdim[length(mlist) + 1,]) add1 <- matrix(rep(1:0, 2L), ncol=2) for (i in seq(along.with=mlist)) { indx <- apply(csdim[i:(i+1),] + add1, 2, function(x) x[1]:x[2]) if (is.null(dim(indx))) { ### non-square matrix out[indx[[1]],indx[[2]]] <- mlist[[i]] } else { ### square matrix out[indx[,1],indx[,2]] <- mlist[[i]] } } if (!missing(order)) { if (nrow(out) != ncol(out)) stop(mstyle$stop("Can only use 'order' argument for square matrices.")) if (length(order) != nrow(out)) stop(mstyle$stop(paste0("Length of the 'order' argument (", length(order), ") does not correspond to the dimensions of the matrix (", nrow(out), "x", ncol(out), ")."))) if (grepl("^order\\(", deparse1(substitute(order)))) { sort.vec <- order } else { sort.vec <- order(order) } out[sort.vec, sort.vec] <- out } return(out) } metafor/R/rma.uni.r0000644000176200001440000031665114475617343013676 0ustar liggesusersrma <- rma.uni <- function(yi, vi, sei, weights, ai, bi, ci, di, n1i, n2i, x1i, x2i, t1i, t2i, m1i, m2i, sd1i, sd2i, xi, mi, ri, ti, fi, pi, sdi, r2i, ni, mods, scale, measure="GEN", intercept=TRUE, data, slab, subset, add=1/2, to="only0", drop00=FALSE, vtype="LS", method="REML", weighted=TRUE, test="z", level=95, btt, att, tau2, verbose=FALSE, digits, control, ...) { ######################################################################### ###### setup mstyle <- .get.mstyle("crayon" %in% .packages()) ### check argument specifications ### (arguments "to" and "vtype" are checked inside escalc function) if (!is.element(measure, c("RR","OR","PETO","RD","AS","PHI","ZPHI","YUQ","YUY","RTET","ZTET", # 2x2 table measures "PBIT","OR2D","OR2DN","OR2DL", # - transformations to SMD "MPRD","MPRR","MPOR","MPORC","MPPETO","MPORM", # - measures for matched pairs data "IRR","IRD","IRSD", # two-group person-time data measures "MD","SMD","SMDH","SMD1","SMD1H","ROM", # two-group mean/SD measures "CVR","VR", # coefficient of variation ratio, variability ratio "RPB","ZPB","RBIS","ZBIS","D2OR","D2ORN","D2ORL", # - transformations to r_PB, r_BIS, and log(OR) "COR","UCOR","ZCOR", # correlations (raw and r-to-z transformed) "PCOR","ZPCOR","SPCOR","ZSPCOR", # partial and semi-partial correlations "R2","ZR2", # coefficient of determination (raw and r-to-z transformed) "PR","PLN","PLO","PAS","PFT", # single proportions (and transformations thereof) "IR","IRLN","IRS","IRFT", # single-group person-time data (and transformations thereof) "MN","MNLN","CVLN","SDLN","SMN", # mean, log(mean), log(CV), log(SD), standardized mean "MC","SMCC","SMCR","SMCRH","ROMC","CVRC","VRC", # raw/standardized mean change, log(ROM), CVR, and VR for dependent samples "ARAW","AHW","ABT", # alpha (and transformations thereof) "REH", # relative excess heterozygosity "GEN"))) stop(mstyle$stop("Unknown 'measure' specified.")) if (!is.element(method[1], c("FE","EE","CE","HS","HSk","HE","DL","DLIT","GENQ","GENQM","SJ","SJIT","PM","MP","PMM","ML","REML","EB"))) stop(mstyle$stop("Unknown 'method' specified.")) ### in case user specifies more than one add/to value (as one can do with rma.mh() and rma.peto()) ### (any kind of continuity correction is directly applied to the outcomes, which are then analyzed as such) if (length(add) > 1L) add <- add[1] if (length(to) > 1L) to <- to[1] na.act <- getOption("na.action") if (!is.element(na.act, c("na.omit", "na.exclude", "na.fail", "na.pass"))) stop(mstyle$stop("Unknown 'na.action' specified under options().")) if (missing(tau2)) tau2 <- NULL if (missing(control)) control <- list() time.start <- proc.time() ### get ... argument and check for extra/superfluous arguments ddd <- list(...) .chkdots(ddd, c("knha", "onlyo1", "addyi", "addvi", "i2def", "r2def", "skipr2", "abbrev", "dfs", "time", "outlist", "link", "optbeta", "alpha", "beta", "skiphes", "pleasedonotreportI2thankyouverymuch")) ### handle 'knha' argument from ... (note: overrides test argument) if (.isFALSE(ddd$knha)) test <- "z" if (.isTRUE(ddd$knha)) test <- "knha" if (!is.element(test, c("z", "t", "knha", "adhoc"))) stop(mstyle$stop("Invalid option selected for 'test' argument.")) if (missing(scale)) { model <- "rma.uni" } else { model <- "rma.ls" } ### set defaults or get onlyo1, addyi, and addvi arguments onlyo1 <- ifelse(is.null(ddd$onlyo1), FALSE, ddd$onlyo1) addyi <- ifelse(is.null(ddd$addyi), TRUE, ddd$addyi) addvi <- ifelse(is.null(ddd$addvi), TRUE, ddd$addvi) ### set defaults for i2def and r2def i2def <- ifelse(is.null(ddd$i2def), "1", ddd$i2def) r2def <- ifelse(is.null(ddd$r2def), "1", ddd$r2def) ### handle arguments for location-scale models if (!is.null(ddd$link)) { link <- match.arg(ddd$link, c("log", "identity")) } else { link <- "log" } if (!is.null(ddd$optbeta)) { optbeta <- .isTRUE(ddd$optbeta) } else { optbeta <- FALSE } if (optbeta && !weighted) stop(mstyle$stop("Must use 'weighted=TRUE' when 'optbeta=TRUE'.")) if (!is.null(ddd$alpha)) { alpha <- ddd$alpha } else { alpha <- NA_real_ } if (!is.null(ddd$beta)) { beta <- ddd$beta } else { beta <- NA_real_ } if (model == "rma.uni" && !missing(att)) warning(mstyle$warning("Argument 'att' only relevant for location-scale models and hence ignored."), call.=FALSE) ### set defaults for digits if (missing(digits)) { digits <- .set.digits(dmiss=TRUE) } else { digits <- .set.digits(digits, dmiss=FALSE) } ### set defaults for formulas formula.yi <- NULL formula.mods <- NULL formula.scale <- NULL ### set options(warn=1) if verbose > 2 if (verbose > 2) { opwarn <- options(warn=1) on.exit(options(warn=opwarn$warn), add=TRUE) } ######################################################################### if (verbose) .space() if (verbose > 1) message(mstyle$message("Extracting/computing yi/vi values ...")) ### check if data argument has been specified if (missing(data)) data <- NULL if (is.null(data)) { data <- sys.frame(sys.parent()) } else { if (!is.data.frame(data)) data <- data.frame(data) } mf <- match.call() ### for certain measures, set add=0 by default unless user explicitly sets the add argument addval <- mf[[match("add", names(mf))]] if (is.element(measure, c("AS","PHI","ZPHI","RTET","ZTET","IRSD","PAS","PFT","IRS","IRFT")) && is.null(addval)) add <- 0 ### extract yi (either NULL if not specified, a vector, a formula, or an escalc object) yi <- .getx("yi", mf=mf, data=data) ### if yi is not NULL and it is an escalc object, then use that object in place of the data argument if (!is.null(yi) && inherits(yi, "escalc")) data <- yi ### extract weights, slab, subset, mods, and scale values, possibly from the data frame specified via data or yi (arguments not specified are NULL) weights <- .getx("weights", mf=mf, data=data, checknumeric=TRUE) slab <- .getx("slab", mf=mf, data=data) subset <- .getx("subset", mf=mf, data=data) mods <- .getx("mods", mf=mf, data=data) scale <- .getx("scale", mf=mf, data=data) ai <- bi <- ci <- di <- x1i <- x2i <- t1i <- t2i <- NA_real_ if (!is.null(weights) && optbeta) stop(mstyle$stop("Cannot use custom weights when 'optbeta=TRUE'.")) if (!is.null(yi)) { ### if yi is not NULL, then yi now either contains the yi values, a formula, or an escalc object ### if yi is a formula, extract yi and X (this overrides anything specified via the mods argument further below) if (inherits(yi, "formula")) { formula.yi <- yi formula.mods <- formula.yi[-2] options(na.action = "na.pass") # set na.action to na.pass, so that NAs are not filtered out (we'll do that later) mods <- model.matrix(yi, data=data) # extract model matrix (now mods is no longer a formula, so [a] further below is skipped) attr(mods, "assign") <- NULL # strip assign attribute (not needed at the moment) attr(mods, "contrasts") <- NULL # strip contrasts attribute (not needed at the moment) yi <- model.response(model.frame(yi, data=data)) # extract yi values from model frame options(na.action = na.act) # set na.action back to na.act names(yi) <- NULL # strip names (1:k) from yi (so res$yi is the same whether yi is a formula or not) intercept <- FALSE # set to FALSE since formula now controls whether the intercept is included or not } # note: code further below ([b]) actually checks whether intercept is included or not ### if yi is an escalc object, try to extract yi and vi (note that moderators must then be specified via the mods argument) if (inherits(yi, "escalc")) { if (!is.null(attr(yi, "yi.names"))) { # if yi.names attributes is available yi.name <- attr(yi, "yi.names")[1] # take the first entry to be the yi variable } else { # if not, see if 'yi' is in the object and assume that is the yi variable if (!is.element("yi", names(yi))) stop(mstyle$stop("Cannot determine name of the 'yi' variable.")) yi.name <- "yi" } if (!is.null(attr(yi, "vi.names"))) { # if vi.names attributes is available vi.name <- attr(yi, "vi.names")[1] # take the first entry to be the vi variable } else { # if not, see if 'vi' is in the object and assume that is the vi variable if (!is.element("vi", names(yi))) stop(mstyle$stop("Cannot determine name of the 'vi' variable.")) vi.name <- "vi" } ### get vi and yi variables from the escalc object (vi first, then yi, since yi is overwritten) vi <- yi[[vi.name]] yi <- yi[[yi.name]] ### could still be NULL if attributes do not match up with actual contents of the escalc object if (is.null(yi)) stop(mstyle$stop(paste0("Cannot find variable '", yi.name, "' in the object."))) if (is.null(vi)) stop(mstyle$stop(paste0("Cannot find variable '", vi.name, "' in the object."))) yi.escalc <- TRUE } else { yi.escalc <- FALSE } ### in case user passed a data frame to yi, convert it to a vector (if possible) if (is.data.frame(yi)) { if (ncol(yi) == 1L) { yi <- yi[[1]] } else { stop(mstyle$stop("The object/variable specified for the 'yi' argument is a data frame with multiple columns.")) } } ### in case user passed a matrix to yi, convert it to a vector (if possible) if (.is.matrix(yi)) { if (nrow(yi) == 1L || ncol(yi) == 1L) { yi <- as.vector(yi) } else { stop(mstyle$stop("The object/variable specified for the 'yi' argument is a matrix with multiple rows/columns.")) } } ### check if yi is numeric if (!is.numeric(yi)) stop(mstyle$stop("The object/variable specified for the 'yi' argument is not numeric.")) ### number of outcomes before subsetting k <- length(yi) k.all <- k ### if the user has specified 'measure' to be something other than "GEN", then use that for the measure argument ### otherwise, if yi has a 'measure' attribute, use that to set the 'measure' argument if (measure == "GEN" && !is.null(attr(yi, "measure"))) measure <- attr(yi, "measure") ### add measure attribute (back) to the yi vector attr(yi, "measure") <- measure ### extract vi and sei values (but only if yi wasn't an escalc object) if (!yi.escalc) { vi <- .getx("vi", mf=mf, data=data, checknumeric=TRUE) sei <- .getx("sei", mf=mf, data=data, checknumeric=TRUE) } ### extract ni argument ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) ### if neither vi nor sei is specified, then throw an error ### if only sei is specified, then square those values to get vi ### if vi is specified, use those values if (is.null(vi)) { if (is.null(sei)) { stop(mstyle$stop("Must specify 'vi' or 'sei' argument.")) } else { vi <- sei^2 } } ### check 'vi' argument for potential misuse .chkviarg(mf$vi) ### in case user passes a matrix to vi, convert it to a vector ### note: only a row or column matrix with the right dimensions will have the right length if (.is.matrix(vi)) { if (nrow(vi) == 1L || ncol(vi) == 1L) { vi <- as.vector(vi) } else { if (.is.square(vi) && isSymmetric(unname(vi))) { vi <- as.matrix(vi) # in case vi is sparse if (any(vi[!diag(nrow(vi))] != 0)) warning(mstyle$warning("Using only the diagonal elements from 'vi' argument as the sampling variances."), call.=FALSE) vi <- diag(vi) } else { stop(mstyle$stop("The object/variable specified for the 'vi' argument is a matrix with multiple rows/columns.")) } } } ### check if user constrained vi to 0 if ((length(vi) == 1L && vi == 0) || (length(vi) == k && !anyNA(vi) && all(vi == 0))) { vi0 <- TRUE } else { vi0 <- FALSE } ### allow easy setting of vi to a single value if (length(vi) == 1L) vi <- rep(vi, k) ### note: k is number of outcomes before subsetting ### check length of yi and vi if (length(vi) != k) stop(mstyle$stop("Length of 'yi' and 'vi' (or 'sei') is not the same.")) ### if ni has not been specified, try to get it from the attributes of yi if (is.null(ni)) ni <- attr(yi, "ni") ### check length of yi and ni (only if ni is not NULL) ### if there is a mismatch, then ni cannot be trusted, so set it to NULL if (!is.null(ni) && length(ni) != k) ni <- NULL ### if ni is now available, add it (back) as an attribute to yi if (!is.null(ni)) attr(yi, "ni") <- ni ### note: one or more yi/vi pairs may be NA/NA (also a corresponding ni value may be NA) ### if slab has not been specified but is an attribute of yi, get it if (is.null(slab)) { slab <- attr(yi, "slab") # will be NULL if there is no slab attribute ### check length of yi and slab (only if slab is now not NULL) ### if there is a mismatch, then slab cannot be trusted, so set it to NULL if (!is.null(slab) && length(slab) != k) slab <- NULL } ### subsetting of yi/vi/ni values (note: mods and slab are subsetted further below) if (!is.null(subset)) { subset <- .chksubset(subset, k) yi <- .getsubset(yi, subset) vi <- .getsubset(vi, subset) ni <- .getsubset(ni, subset) attr(yi, "measure") <- measure ### add measure attribute back attr(yi, "ni") <- ni ### add ni attribute back } } else { ### if yi is NULL, try to compute yi/vi based on specified measure and supplied data if (is.element(measure, c("RR","OR","PETO","RD","AS","PHI","ZPHI","YUQ","YUY","RTET","ZTET","PBIT","OR2D","OR2DN","OR2DL","MPRD","MPRR","MPOR","MPORC","MPPETO","MPORM"))) { ai <- .getx("ai", mf=mf, data=data, checknumeric=TRUE) bi <- .getx("bi", mf=mf, data=data, checknumeric=TRUE) ci <- .getx("ci", mf=mf, data=data, checknumeric=TRUE) di <- .getx("di", mf=mf, data=data, checknumeric=TRUE) n1i <- .getx("n1i", mf=mf, data=data, checknumeric=TRUE) n2i <- .getx("n2i", mf=mf, data=data, checknumeric=TRUE) ri <- .getx("ri", mf=mf, data=data, checknumeric=TRUE) pi <- .getx("pi", mf=mf, data=data, checknumeric=TRUE) if (is.null(bi)) bi <- n1i - ai if (is.null(di)) di <- n2i - ci k <- length(ai) ### number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) ai <- .getsubset(ai, subset) bi <- .getsubset(bi, subset) ci <- .getsubset(ci, subset) di <- .getsubset(di, subset) ri <- .getsubset(ri, subset) pi <- .getsubset(pi, subset) } args <- list(measure=measure, ai=ai, bi=bi, ci=ci, di=di, ri=ri, pi=pi, add=add, to=to, drop00=drop00, vtype=vtype, onlyo1=onlyo1, addyi=addyi, addvi=addvi) } if (is.element(measure, c("IRR","IRD","IRSD"))) { x1i <- .getx("x1i", mf=mf, data=data, checknumeric=TRUE) x2i <- .getx("x2i", mf=mf, data=data, checknumeric=TRUE) t1i <- .getx("t1i", mf=mf, data=data, checknumeric=TRUE) t2i <- .getx("t2i", mf=mf, data=data, checknumeric=TRUE) k <- length(x1i) ### number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) x1i <- .getsubset(x1i, subset) x2i <- .getsubset(x2i, subset) t1i <- .getsubset(t1i, subset) t2i <- .getsubset(t2i, subset) } args <- list(measure=measure, x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i, add=add, to=to, drop00=drop00, vtype=vtype, addyi=addyi, addvi=addvi) } if (is.element(measure, c("MD","SMD","SMDH","SMD1","SMD1H","ROM","RPB","ZPB","RBIS","ZBIS","D2OR","D2ORN","D2ORL","CVR","VR"))) { m1i <- .getx("m1i", mf=mf, data=data, checknumeric=TRUE) m2i <- .getx("m2i", mf=mf, data=data, checknumeric=TRUE) sd1i <- .getx("sd1i", mf=mf, data=data, checknumeric=TRUE) sd2i <- .getx("sd2i", mf=mf, data=data, checknumeric=TRUE) n1i <- .getx("n1i", mf=mf, data=data, checknumeric=TRUE) n2i <- .getx("n2i", mf=mf, data=data, checknumeric=TRUE) di <- .getx("di", mf=mf, data=data, checknumeric=TRUE) ti <- .getx("ti", mf=mf, data=data, checknumeric=TRUE) pi <- .getx("pi", mf=mf, data=data, checknumeric=TRUE) if (is.element(measure, c("SMD","RPB","ZPB","RBIS","ZBIS","D2OR","D2ORN","D2ORL"))) { if (!.equal.length(m1i, m2i, sd1i, sd2i, n1i, n2i, di, ti, pi)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) ti <- replmiss(ti, .convp2t(pi, df=n1i+n2i-2)) di <- replmiss(di, ti * sqrt(1/n1i + 1/n2i)) m1i[!is.na(di)] <- di[!is.na(di)] m2i[!is.na(di)] <- 0 sd1i[!is.na(di)] <- 1 sd2i[!is.na(di)] <- 1 } k <- length(n1i) ### number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) m1i <- .getsubset(m1i, subset) m2i <- .getsubset(m2i, subset) sd1i <- .getsubset(sd1i, subset) sd2i <- .getsubset(sd2i, subset) n1i <- .getsubset(n1i, subset) n2i <- .getsubset(n2i, subset) } args <- list(measure=measure, m1i=m1i, m2i=m2i, sd1i=sd1i, sd2i=sd2i, n1i=n1i, n2i=n2i, vtype=vtype) } if (is.element(measure, c("COR","UCOR","ZCOR"))) { ri <- .getx("ri", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) ti <- .getx("ti", mf=mf, data=data, checknumeric=TRUE) pi <- .getx("pi", mf=mf, data=data, checknumeric=TRUE) if (!.equal.length(ri, ni, ti, pi)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) ti <- replmiss(ti, .convp2t(pi, df=ni-2)) ri <- replmiss(ri, ti / sqrt(ti^2 + ni-2)) k <- length(ri) ### number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) ri <- .getsubset(ri, subset) ni <- .getsubset(ni, subset) } args <- list(measure=measure, ri=ri, ni=ni, vtype=vtype) } if (is.element(measure, c("PCOR","ZPCOR","SPCOR","ZSPCOR"))) { ri <- .getx("ri", mf=mf, data=data, checknumeric=TRUE) ti <- .getx("ti", mf=mf, data=data, checknumeric=TRUE) mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) pi <- .getx("pi", mf=mf, data=data, checknumeric=TRUE) r2i <- .getx("r2i", mf=mf, data=data, checknumeric=TRUE) if (!.equal.length(ri, ti, mi, ni, pi, r2i)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) ti <- replmiss(ti, .convp2t(pi, df=ni-mi-1)) if (is.element(measure, c("PCOR","ZPCOR"))) ri <- replmiss(ri, ti / sqrt(ti^2 + ni-mi-1)) if (is.element(measure, c("SPCOR","ZSPCOR"))) ri <- replmiss(ri, ti * sqrt(1-r2i) / sqrt(ni-mi-1)) k <- length(ri) ### number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) ri <- .getsubset(ri, subset) mi <- .getsubset(mi, subset) ni <- .getsubset(ni, subset) r2i <- .getsubset(r2i, subset) } args <- list(measure=measure, ri=ri, mi=mi, ni=ni, r2i=r2i, vtype=vtype) } if (is.element(measure, c("R2","ZR2"))) { r2i <- .getx("r2i", mf=mf, data=data, checknumeric=TRUE) mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) fi <- .getx("fi", mf=mf, data=data, checknumeric=TRUE) pi <- .getx("pi", mf=mf, data=data, checknumeric=TRUE) if (!.equal.length(r2i, mi, ni)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) fi <- replmiss(fi, .convp2f(pi, df1=mi, df2=ni-mi-1)) r2i <- replmiss(r2i, mi*fi / (mi*fi + (ni-mi-1))) k <- length(r2i) ### number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) r2i <- .getsubset(r2i, subset) mi <- .getsubset(mi, subset) ni <- .getsubset(ni, subset) } args <- list(measure=measure, r2i=r2i, mi=mi, ni=ni, vtype=vtype) } if (is.element(measure, c("PR","PLN","PLO","PAS","PFT"))) { xi <- .getx("xi", mf=mf, data=data, checknumeric=TRUE) mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) if (is.null(mi)) mi <- ni - xi k <- length(xi) ### number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) xi <- .getsubset(xi, subset) mi <- .getsubset(mi, subset) } args <- list(measure=measure, xi=xi, mi=mi, add=add, to=to, vtype=vtype, addyi=addyi, addvi=addvi) } if (is.element(measure, c("IR","IRLN","IRS","IRFT"))) { xi <- .getx("xi", mf=mf, data=data, checknumeric=TRUE) ti <- .getx("ti", mf=mf, data=data, checknumeric=TRUE) k <- length(xi) ### number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) xi <- .getsubset(xi, subset) ti <- .getsubset(ti, subset) } args <- list(measure=measure, xi=xi, ti=ti, add=add, to=to, vtype=vtype, addyi=addyi, addvi=addvi) } if (is.element(measure, c("MN","MNLN","CVLN","SDLN","SMN"))) { mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) sdi <- .getx("sdi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) k <- length(ni) ### number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) mi <- .getsubset(mi, subset) sdi <- .getsubset(sdi, subset) ni <- .getsubset(ni, subset) } args <- list(measure=measure, mi=mi, sdi=sdi, ni=ni, vtype=vtype) } if (is.element(measure, c("MC","SMCC","SMCR","SMCRH","ROMC","CVRC","VRC"))) { m1i <- .getx("m1i", mf=mf, data=data, checknumeric=TRUE) m2i <- .getx("m2i", mf=mf, data=data, checknumeric=TRUE) sd1i <- .getx("sd1i", mf=mf, data=data, checknumeric=TRUE) sd2i <- .getx("sd2i", mf=mf, data=data, checknumeric=TRUE) ri <- .getx("ri", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) di <- .getx("di", mf=mf, data=data, checknumeric=TRUE) ti <- .getx("ti", mf=mf, data=data, checknumeric=TRUE) pi <- .getx("pi", mf=mf, data=data, checknumeric=TRUE) if (measure == "SMCC") { if (!.equal.length(m1i, m2i, sd1i, sd2i, ri, ni, di, ti, pi)) stop(mstyle$stop("Supplied data vectors are not all of the same length.")) ti <- replmiss(ti, .convp2t(pi, df=ni-1)) di <- replmiss(di, ti * sqrt(1/ni)) m1i[!is.na(di)] <- di[!is.na(di)] m2i[!is.na(di)] <- 0 sd1i[!is.na(di)] <- 1 sd2i[!is.na(di)] <- 1 ri[!is.na(di)] <- 0.5 } k <- length(m1i) ### number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) m1i <- .getsubset(m1i, subset) m2i <- .getsubset(m2i, subset) sd1i <- .getsubset(sd1i, subset) sd2i <- .getsubset(sd2i, subset) ni <- .getsubset(ni, subset) ri <- .getsubset(ri, subset) } args <- list(measure=measure, m1i=m1i, m2i=m2i, sd1i=sd1i, sd2i=sd2i, ri=ri, ni=ni, vtype=vtype) } if (is.element(measure, c("ARAW","AHW","ABT"))) { ai <- .getx("ai", mf=mf, data=data, checknumeric=TRUE) mi <- .getx("mi", mf=mf, data=data, checknumeric=TRUE) ni <- .getx("ni", mf=mf, data=data, checknumeric=TRUE) k <- length(ai) ### number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) ai <- .getsubset(ai, subset) mi <- .getsubset(mi, subset) ni <- .getsubset(ni, subset) } args <- list(measure=measure, ai=ai, mi=mi, ni=ni, vtype=vtype) } if (measure == "REH") { ai <- .getx("ai", mf=mf, data=data, checknumeric=TRUE) bi <- .getx("bi", mf=mf, data=data, checknumeric=TRUE) ci <- .getx("ci", mf=mf, data=data, checknumeric=TRUE) k <- length(ai) ### number of outcomes before subsetting k.all <- k if (!is.null(subset)) { subset <- .chksubset(subset, k) ai <- .getsubset(ai, subset) bi <- .getsubset(bi, subset) ci <- .getsubset(ci, subset) } args <- list(measure=measure, ai=ai, bi=bi, ci=ci, vtype=vtype) } dat <- .do.call(escalc, args) if (is.element(measure, "GEN")) stop(mstyle$stop("Specify the desired outcome measure via the 'measure' argument.")) ### note: these values are already subsetted yi <- dat$yi ### one or more yi/vi pairs may be NA/NA vi <- dat$vi ### one or more yi/vi pairs may be NA/NA ni <- attr(yi, "ni") ### unadjusted total sample sizes (ni.u in escalc) } ######################################################################### ### allow easy setting of weights to a single value if (length(weights) == 1L) weights <- rep(weights, k) ### note: k is number of outcomes before subsetting ### check length of yi and weights (only if weights is not NULL) if (!is.null(weights) && (length(weights) != k)) stop(mstyle$stop("Length of 'yi' and 'weights' is not the same.")) ### subsetting of weights if (!is.null(subset)) weights <- .getsubset(weights, subset) ######################################################################### if (verbose > 1) message(mstyle$message("Creating model matrix ...")) ### convert mods formula to X matrix and set intercept equal to FALSE ### skipped if formula has already been specified via yi argument, since mods is then no longer a formula (see [a]) if (inherits(mods, "formula")) { formula.mods <- mods if (isTRUE(all.equal(formula.mods, ~ 1))) { ### needed so 'mods = ~ 1' without 'data' specified works mods <- matrix(1, nrow=k, ncol=1) intercept <- FALSE } else { options(na.action = "na.pass") ### set na.action to na.pass, so that NAs are not filtered out (we'll do that later) mods <- model.matrix(mods, data=data) ### extract model matrix attr(mods, "assign") <- NULL ### strip assign attribute (not needed at the moment) attr(mods, "contrasts") <- NULL ### strip contrasts attribute (not needed at the moment) options(na.action = na.act) ### set na.action back to na.act intercept <- FALSE ### set to FALSE since formula now controls whether the intercept is included or not } ### note: code further below ([b]) actually checks whether intercept is included or not } ### turn a vector for mods into a column vector if (.is.vector(mods)) mods <- cbind(mods) ### turn a mods data frame into a matrix if (is.data.frame(mods)) mods <- as.matrix(mods) ### check if model matrix contains character variables if (is.character(mods)) stop(mstyle$stop("Model matrix contains character variables.")) ### check if mods matrix has the right number of rows if (!is.null(mods) && nrow(mods) != k) stop(mstyle$stop(paste0("Number of rows in the model matrix (", nrow(mods), ") does not match length of the outcome vector (", k, ")."))) ### for rma.ls models, get model matrix for the scale part if (model == "rma.ls") { if (inherits(scale, "formula")) { formula.scale <- scale if (isTRUE(all.equal(formula.scale, ~ 1))) { ### needed so 'scale = ~ 1' without 'data' specified works Z <- matrix(1, nrow=k, ncol=1) colnames(Z) <- "intrcpt" } else { options(na.action = "na.pass") Z <- model.matrix(scale, data=data) colnames(Z)[grep("(Intercept)", colnames(Z), fixed=TRUE)] <- "intrcpt" attr(Z, "assign") <- NULL attr(Z, "contrasts") <- NULL options(na.action = na.act) } } else { Z <- scale if (.is.vector(Z)) Z <- cbind(Z) if (is.data.frame(Z)) Z <- as.matrix(Z) if (is.character(Z)) stop(mstyle$stop("Scale model matrix contains character variables.")) } if (nrow(Z) != k) stop(mstyle$stop(paste0("Number of rows in the model matrix specified via the 'scale' argument (", nrow(Z), ") does not match length of the outcome vector (", k, ")."))) } else { Z <- NULL } ### generate study labels if none are specified (or none have been found in yi) if (verbose > 1) message(mstyle$message("Generating/extracting study labels ...")) ### study ids (1:k sequence before subsetting) ids <- seq_len(k) if (is.null(slab)) { slab.null <- TRUE slab <- ids } else { if (anyNA(slab)) stop(mstyle$stop("NAs in study labels.")) if (length(slab) != k) stop(mstyle$stop("Study labels not of same length as data.")) slab.null <- FALSE } ### if a subset of studies is specified if (!is.null(subset)) { if (verbose > 1) message(mstyle$message("Subsetting ...")) mods <- .getsubset(mods, subset) slab <- .getsubset(slab, subset) ids <- .getsubset(ids, subset) Z <- .getsubset(Z, subset) } ### check if study labels are unique; if not, make them unique if (anyDuplicated(slab)) slab <- .make.unique(slab) ### add slab attribute back attr(yi, "slab") <- slab ### number of outcomes after subsetting k <- length(yi) ### check for negative/infinite weights if (any(weights < 0, na.rm=TRUE)) stop(mstyle$stop("Negative weights not allowed.")) if (any(is.infinite(weights))) stop(mstyle$stop("Infinite weights not allowed.")) ### save full data (including potential NAs in yi/vi/weights/ni/mods/Z.f) outdat.f <- list(ai=ai, bi=bi, ci=ci, di=di, x1i=x1i, x2i=x2i, t1i=t1i, t2i=t2i) yi.f <- yi vi.f <- vi weights.f <- weights ni.f <- ni mods.f <- mods Z.f <- Z k.f <- k ### total number of observed outcomes including all NAs ### check for NAs and act accordingly has.na <- is.na(yi) | is.na(vi) | (if (is.null(mods)) FALSE else apply(is.na(mods), 1, any)) | (if (is.null(Z)) FALSE else apply(is.na(Z), 1, any)) | (if (is.null(weights)) FALSE else is.na(weights)) not.na <- !has.na if (any(has.na)) { if (verbose > 1) message(mstyle$message("Handling NAs ...")) if (na.act == "na.omit" || na.act == "na.exclude" || na.act == "na.pass") { yi <- yi[not.na] vi <- vi[not.na] weights <- weights[not.na] ni <- ni[not.na] mods <- mods[not.na,,drop=FALSE] Z <- Z[not.na,,drop=FALSE] k <- length(yi) warning(mstyle$warning(paste(sum(has.na), ifelse(sum(has.na) > 1, "studies", "study"), "with NAs omitted from model fitting.")), call.=FALSE) attr(yi, "measure") <- measure ### add measure attribute back attr(yi, "ni") <- ni ### add ni attribute back ### note: slab is always of the same length as the full yi vector (after subsetting), so missings are not removed and slab is not added back to yi } if (na.act == "na.fail") stop(mstyle$stop("Missing values in data.")) } ### at least one study left? if (k < 1L) stop(mstyle$stop("Processing terminated since k = 0.")) ### check for non-positive sampling variances (and set negative values to 0) ### note: done after removing NAs since only the included studies are relevant if (any(vi <= 0)) { allvipos <- FALSE if (!vi0) warning(mstyle$warning("There are outcomes with non-positive sampling variances."), call.=FALSE) vi.neg <- vi < 0 if (any(vi.neg)) { vi[vi.neg] <- 0 warning(mstyle$warning("Negative sampling variances constrained to zero."), call.=FALSE) } } else { allvipos <- TRUE } ### but even in vi.f, constrain negative sampling variances to 0 (not needed) #vi.f[vi.f < 0] <- 0 ### if k=1 and test != "z", set test="z" (other methods cannot be used) if (k == 1L && test != "z") { warning(mstyle$warning("Setting argument test=\"z\" since k=1."), call.=FALSE) test <- "z" } ### make sure that there is at least one column in X ([b]) if (is.null(mods) && !intercept) { warning(mstyle$warning("Must either include an intercept and/or moderators in model.\nCoerced intercept into the model."), call.=FALSE) intercept <- TRUE } if (!is.null(mods) && ncol(mods) == 0L) { warning(mstyle$warning("Cannot fit model with an empty model matrix. Coerced intercept into the model."), call.=FALSE) intercept <- TRUE } ### add vector of 1s to the X matrix for the intercept (if intercept=TRUE) if (intercept) { X <- cbind(intrcpt=rep(1,k), mods) X.f <- cbind(intrcpt=rep(1,k.f), mods.f) } else { X <- mods X.f <- mods.f } ### drop redundant predictors ### note: need to save coef.na for functions that modify the data/model and then refit the model (regtest() and the ### various function that leave out an observation); so we can check if there are redundant/dropped predictors then tmp <- try(lm(yi ~ X - 1), silent=TRUE) if (inherits(tmp, "lm")) { coef.na <- is.na(coef(tmp)) } else { coef.na <- rep(FALSE, NCOL(X)) } if (any(coef.na)) { warning(mstyle$warning("Redundant predictors dropped from the model."), call.=FALSE) X <- X[,!coef.na,drop=FALSE] X.f <- X.f[,!coef.na,drop=FALSE] } ### check whether intercept is included and if yes, move it to the first column (NAs already removed, so na.rm=TRUE for any() not necessary) is.int <- apply(X, 2, .is.intercept) if (any(is.int)) { int.incl <- TRUE int.indx <- which(is.int, arr.ind=TRUE) X <- cbind(intrcpt=1, X[,-int.indx, drop=FALSE]) ### this removes any duplicate intercepts X.f <- cbind(intrcpt=1, X.f[,-int.indx, drop=FALSE]) ### this removes any duplicate intercepts intercept <- TRUE ### set intercept appropriately so that the predict() function works } else { int.incl <- FALSE } p <- NCOL(X) ### number of columns in X (including the intercept if it is included) ### make sure variable names in X and Z are unique colnames(X) <- colnames(X.f) <- .make.unique(colnames(X)) colnames(Z) <- colnames(Z.f) <- .make.unique(colnames(Z)) ### check whether this is an intercept-only model if ((p == 1L) && .is.intercept(X)) { int.only <- TRUE } else { int.only <- FALSE } ### check if there are too many parameters for given k (TODO: what about rma.ls models?) if (!(int.only && k == 1L)) { if (is.element(method[1], c("FE","EE","CE"))) { ### have to estimate p parms if (p > k) stop(mstyle$stop("Number of parameters to be estimated is larger than the number of observations.")) } else { if (!is.null(tau2) && !is.na(tau2)) { ### have to estimate p parms (tau2 is fixed at value specified) if (p > k) stop(mstyle$stop("Number of parameters to be estimated is larger than the number of observations.")) } else { if ((p+1) > k) ### have to estimate p+1 parms stop(mstyle$stop("Number of parameters to be estimated is larger than the number of observations.")) } } } ### set/check 'btt' argument btt <- .set.btt(btt, p, int.incl, colnames(X)) m <- length(btt) ### number of betas to test (m = p if all betas are tested) ######################################################################### ### set default control parameters con <- list(verbose = FALSE, evtol = 1e-07, # lower bound for eigenvalues to determine if model matrix is positive definite (also for checking if vimaxmin >= 1/con$evtol) REMLf = TRUE) # should |X'X| term be included in the REML log likelihood? if (model == "rma.uni") { con <- c(con, list(tau2.init = NULL, # initial value for iterative estimators (ML, REML, EB, SJ, SJIT, DLIT) tau2.min = 0, # lower bound for tau^2 value (passed down to confint.rma.uni()) tau2.max = 100, # upper bound for tau^2 value (for PM/PMM/GENQM estimators) but see [c] threshold = 10^-5, # convergence threshold (for ML, REML, EB, SJIT, DLIT) tol = .Machine$double.eps^0.25, # convergence tolerance for uniroot() as used for PM, PMM, GENQM (also used in 'll0 - ll > con$tol' check for ML/REML) ll0check = TRUE, # should the 'll0 - ll > con$tol' check be conducted for ML/REML? maxiter = 100, # maximum number of iterations (for ML, REML, EB, SJIT, DLIT) stepadj = 1)) # step size adjustment for Fisher scoring algorithm (for ML, REML, EB) ### [c] for some applications, tau2.max = 100 may not be enough; use an adaptive max instead con$tau2.max <- max(con$tau2.max, 10*mad(yi)^2) } if (model == "rma.ls") { con <- c(con, list(beta.init = NULL, # initial values for location parameters (only relevant when optbeta=TRUE) hesspack = "numDeriv", # package for computing the Hessian (numDeriv or pracma) optimizer = "nlminb", # optimizer to use ("optim","nlminb","uobyqa","newuoa","bobyqa","nloptr","nlm","hjk","nmk","mads","ucminf","lbfgsb3c","subplex","BBoptim","optimParallel","constrOptim","solnp","constrOptim.nl","Rcgmin","Rvmmin") optmethod = "BFGS", # argument 'method' for optim() ("Nelder-Mead" and "BFGS" are sensible options) parallel = list(), # parallel argument for optimParallel() (note: 'cl' argument in parallel is not passed; this is directly specified via 'cl') cl = NULL, # arguments for optimParallel() ncpus = 1L, # arguments for optimParallel() tau2.min = 0, # lower bound for tau^2 values (can be used to constrain tau^2 values but see [d]) tau2.max = Inf, # upper bound for tau^2 values (can be used to constrain tau^2 values but see [d]) alpha.init = NULL, # initial values for scale parameters alpha.min = -Inf, # min possible value(s) for scale parameter(s) alpha.max = Inf, # max possible value(s) for scale parameter(s) hessianCtrl=list(r=8), # arguments passed on to 'method.args' of hessian() scaleZ = TRUE)) # rescale Z matrix (only if Z.int.incl, is.na(alpha[1]), all(is.infinite(con$alpha.min)), all(is.infinite(con$alpha.max)), !optbeta) ### [d] can constrain the tau^2 values in location-scale models, but this is done in a very crude way ### in the optimization (by returning Inf when any tau^2 value falls outside the bounds) and this is ### not recommended/documented (instead, one can constrain the alpha values via alpha.min/alpha.max); ### note: the tau^2 bounds are only in effect when tau2.min or tau2.max are actually used in 'control' ### (if not, tau2.min and tau2.max are set to 0 and Inf, respectively) } ### replace defaults with any user-defined values con.pos <- pmatch(names(control), names(con)) con[c(na.omit(con.pos))] <- control[!is.na(con.pos)] if (verbose) con$verbose <- verbose verbose <- con$verbose if (model == "rma.ls") { con$hesspack <- match.arg(con$hesspack, c("numDeriv","pracma")) if (!isTRUE(ddd$skiphes) && !requireNamespace(con$hesspack, quietly=TRUE)) stop(mstyle$stop(paste0("Please install the '", con$hesspack, "' package to compute the Hessian."))) } if (model == "rma.uni") { ### constrain a negative tau2.min value to -min(vi) (to ensure that the marginal variance is always >= 0) if (con$tau2.min < 0 && (con$tau2.min < -min(vi))) { con$tau2.min <- -min(vi) # + .Machine$double.eps^0.25 # to force tau2.min just above -min(vi) warning(mstyle$warning(paste0("Value of 'tau2.min' constrained to -min(vi) = ", fmtx(-min(vi), digits[["est"]]), ".")), call.=FALSE) } } else { ### constrain a negative tau2.min value to 0 for ls models if (is.element("tau2.min", names(control))) con$tau2.min[con$tau2.min < 0] <- 0 } ### check whether model matrix is of full rank if (!.chkpd(crossprod(X), tol=con$evtol)) stop(mstyle$stop("Model matrix not of full rank. Cannot fit model.")) ### check ratio of largest to smallest sampling variance ### note: need to exclude some special cases (0/0 = NaN, max(vi)/0 = Inf) ### TODO: use the condition number of diag(vi) here instead? vimaxmin <- max(vi) / min(vi) if (is.finite(vimaxmin) && vimaxmin >= 1/con$evtol) warning(mstyle$warning("Ratio of largest to smallest sampling variance extremely large. May not be able to obtain stable results."), call.=FALSE) ### set some defaults se.tau2 <- I2 <- H2 <- QE <- QEp <- NA_real_ s2w <- 1 level <- .level(level) Y <- as.matrix(yi) ### mean center yi for some calculations to increase the stability of the computations ymci <- scale(yi, center=TRUE, scale=FALSE) Ymc <- as.matrix(ymci) ######################################################################### ###### heterogeneity estimation for the standard normal-normal model (rma.uni) if (model == "rma.uni") { if (!is.null(tau2) && !is.na(tau2) && !is.element(method[1], c("FE","EE","CE"))) { # if user has fixed the tau2 value tau2.fix <- TRUE tau2.val <- tau2 } else { tau2.fix <- FALSE tau2.val <- NA_real_ } if (verbose > 1 && !tau2.fix && !is.element(method[1], c("FE","EE","CE"))) message(mstyle$message("Estimating tau^2 value ...\n")) if (k == 1L) { method.sav <- method[1] method <- "k1" # set method to k1 so all of the stuff below is skipped if (!tau2.fix) tau2 <- 0 } conv <- FALSE while (!conv) { ### convergence indicator and change variable conv <- TRUE # assume TRUE for now unless things go wrong below change <- con$threshold + 1 ### iterations counter for iterative estimators (i.e., DLIT, SJIT, ML, REML, EB) ### (note: PM, PMM, and GENQM are also iterative, but uniroot() handles that) iter <- 0 ### Hunter & Schmidt (HS) estimator (or k-corrected HS estimator (HSk)) if (is.element(method[1], c("HS","HSk"))) { if (!allvipos) stop(mstyle$stop(paste0(method[1], " estimator cannot be used when there are non-positive sampling variances in the data."))) wi <- 1/vi W <- diag(wi, nrow=k, ncol=k) stXWX <- .invcalc(X=X, W=W, k=k) P <- W - W %*% X %*% stXWX %*% crossprod(X,W) RSS <- crossprod(Ymc,P) %*% Ymc if (method[1] == "HS") { tau2 <- ifelse(tau2.fix, tau2.val, (RSS - k) / sum(wi)) } else { tau2 <- ifelse(tau2.fix, tau2.val, (k/(k-p)*RSS - k) / sum(wi)) } } ### Hedges (HE) estimator (or initial value for ML, REML, EB) if (is.element(method[1], c("HE","ML","REML","EB"))) { stXX <- .invcalc(X=X, W=diag(k), k=k) P <- diag(k) - X %*% tcrossprod(stXX,X) RSS <- crossprod(Ymc,P) %*% Ymc V <- diag(vi, nrow=k, ncol=k) PV <- P %*% V # note: this is not symmetric trPV <- .tr(PV) # since PV needs to be computed anyway, can use .tr() tau2 <- ifelse(tau2.fix, tau2.val, (RSS - trPV) / (k-p)) } ### DerSimonian-Laird (DL) estimator if (method[1] == "DL") { if (!allvipos) stop(mstyle$stop("DL estimator cannot be used when there are non-positive sampling variances in the data.")) wi <- 1/vi W <- diag(wi, nrow=k, ncol=k) stXWX <- .invcalc(X=X, W=W, k=k) P <- W - W %*% X %*% stXWX %*% crossprod(X,W) RSS <- crossprod(Ymc,P) %*% Ymc trP <- .tr(P) tau2 <- ifelse(tau2.fix, tau2.val, (RSS - (k-p)) / trP) } ### DerSimonian-Laird (DL) estimator with iteration if (method[1] == "DLIT") { if (is.null(con$tau2.init)) { tau2 <- 0 } else { tau2 <- con$tau2.init } while (change > con$threshold) { if (verbose) cat(mstyle$verbose(paste("Iteration", formatC(iter, width=5, flag="-", format="f", digits=0), "tau^2 =", fmtx(tau2, digits[["var"]]), "\n"))) iter <- iter + 1 old2 <- tau2 wi <- 1/(vi + tau2) if (any(tau2 + vi < 0)) stop(mstyle$stop("Some marginal variances are negative.")) if (any(is.infinite(wi))) stop(mstyle$stop("Division by zero when computing the inverse variance weights.")) W <- diag(wi, nrow=k, ncol=k) stXWX <- .invcalc(X=X, W=W, k=k) P <- W - W %*% X %*% stXWX %*% crossprod(X,W) RSS <- crossprod(Ymc,P) %*% Ymc trP <- .tr(P) tau2 <- ifelse(tau2.fix, tau2.val, (RSS - (k-p)) / trP) tau2[tau2 < con$tau2.min] <- con$tau2.min change <- abs(old2 - tau2) if (iter > con$maxiter) { conv <- FALSE break } } if (!conv) { if (length(method) == 1L) { stop(mstyle$stop("Iterative DL estimator did not converge.")) } else { if (verbose) warning(mstyle$warning("Iterative DL estimator did not converge.")) } } } ### generalized Q-statistic estimator if (method[1] == "GENQ") { #if (!allvipos) # stop(mstyle$stop("GENQ estimator cannot be used when there are non-positive sampling variances in the data.")) if (is.null(weights)) stop(mstyle$stop("Must specify 'weights' when method='GENQ'.")) A <- diag(weights, nrow=k, ncol=k) stXAX <- .invcalc(X=X, W=A, k=k) P <- A - A %*% X %*% stXAX %*% crossprod(X,A) V <- diag(vi, nrow=k, ncol=k) PV <- P %*% V # note: this is not symmetric trP <- .tr(P) trPV <- .tr(PV) RSS <- crossprod(Ymc,P) %*% Ymc tau2 <- ifelse(tau2.fix, tau2.val, (RSS - trPV) / trP) } ### generalized Q-statistic estimator (median unbiased version) if (method[1] == "GENQM") { if (is.null(weights)) stop(mstyle$stop("Must specify 'weights' when method='GENQM'.")) A <- diag(weights, nrow=k, ncol=k) stXAX <- .invcalc(X=X, W=A, k=k) P <- A - A %*% X %*% stXAX %*% crossprod(X,A) V <- diag(vi, nrow=k, ncol=k) PV <- P %*% V # note: this is not symmetric trP <- .tr(P) if (!tau2.fix) { RSS <- crossprod(Ymc,P) %*% Ymc if (.GENQ.func(con$tau2.min, P=P, vi=vi, Q=RSS, level=0, k=k, p=p, getlower=TRUE) > 0.5) { ### if GENQ.tau2.min is > 0.5, then estimate < tau2.min tau2 <- con$tau2.min } else { if (.GENQ.func(con$tau2.max, P=P, vi=vi, Q=RSS, level=0, k=k, p=p, getlower=TRUE) < 0.5) { ### if GENQ.tau2.max is < 0.5, then estimate > tau2.max conv <- FALSE if (length(method) == 1L) { stop(mstyle$stop("Value of 'tau2.max' too low. Try increasing 'tau2.max' or switch to another 'method'.")) } else { if (verbose) warning(mstyle$warning("Value of 'tau2.max' too low. Try increasing 'tau2.max' or switch to another 'method'.")) } } else { tau2 <- try(uniroot(.GENQ.func, interval=c(con$tau2.min, con$tau2.max), tol=con$tol, maxiter=con$maxiter, P=P, vi=vi, Q=RSS, level=0.5, k=k, p=p, getlower=FALSE, verbose=verbose, digits=digits, extendInt="no")$root, silent=TRUE) if (inherits(tau2, "try-error")) { conv <- FALSE if (length(method) == 1L) { stop(mstyle$stop("Error in iterative search for tau2 using uniroot().")) } else { if (verbose) warning(mstyle$warning("Error in iterative search for tau2 using uniroot().")) } } } } } else { tau2 <- tau2.val } } ### Sidik-Jonkman (SJ) estimator if (method[1] == "SJ") { if (is.null(con$tau2.init)) { tau2.0 <- c(var(ymci) * (k-1)/k) } else { tau2.0 <- con$tau2.init } wi <- 1/(vi + tau2.0) W <- diag(wi, nrow=k, ncol=k) stXWX <- .invcalc(X=X, W=W, k=k) P <- W - W %*% X %*% stXWX %*% crossprod(X,W) RSS <- crossprod(Ymc,P) %*% Ymc V <- diag(vi, nrow=k, ncol=k) PV <- P %*% V # note: this is not symmetric tau2 <- ifelse(tau2.fix, tau2.val, tau2.0 * RSS / (k-p)) } ### Sidik-Jonkman (SJ) estimator with iteration if (method[1] == "SJIT") { if (is.null(con$tau2.init)) { tau2 <- c(var(ymci) * (k-1)/k) } else { tau2 <- con$tau2.init } tau2.0 <- tau2 while (change > con$threshold) { if (verbose) cat(mstyle$verbose(paste("Iteration", formatC(iter, width=5, flag="-", format="f", digits=0), "tau^2 =", fmtx(tau2, digits[["var"]]), "\n"))) iter <- iter + 1 old2 <- tau2 wi <- 1/(vi + tau2) W <- diag(wi, nrow=k, ncol=k) stXWX <- .invcalc(X=X, W=W, k=k) P <- W - W %*% X %*% stXWX %*% crossprod(X,W) RSS <- crossprod(Ymc,P) %*% Ymc V <- diag(vi, nrow=k, ncol=k) PV <- P %*% V # note: this is not symmetric tau2 <- ifelse(tau2.fix, tau2.val, tau2 * RSS / (k-p)) change <- abs(old2 - tau2) if (iter > con$maxiter) { conv <- FALSE break } } if (!conv) { if (length(method) == 1L) { stop(mstyle$stop("Iterative SJ estimator did not converge.")) } else { if (verbose) warning(mstyle$warning("Iterative SJ estimator did not converge.")) } } } ### Paule-Mandel (PM) estimator (regular and median unbiased version) if (is.element(method[1], c("PM","MP","PMM"))) { if (!allvipos) stop(mstyle$stop(method[1], " estimator cannot be used when there are non-positive sampling variances in the data.")) if (method[1] == "PMM") { target <- qchisq(0.5, df=k-p) } else { target <- k-p } if (!tau2.fix) { if (.QE.func(con$tau2.min, Y=Ymc, vi=vi, X=X, k=k, objective=0) < target) { tau2 <- con$tau2.min } else { if (.QE.func(con$tau2.max, Y=Ymc, vi=vi, X=X, k=k, objective=0) > target) { conv <- FALSE if (length(method) == 1L) { stop(mstyle$stop("Value of 'tau2.max' too low. Try increasing 'tau2.max' or switch to another 'method'.")) } else { if (verbose) warning(mstyle$warning("Value of 'tau2.max' too low. Try increasing 'tau2.max' or switch to another 'method'.")) } } else { tau2 <- try(uniroot(.QE.func, interval=c(con$tau2.min, con$tau2.max), tol=con$tol, maxiter=con$maxiter, Y=Ymc, vi=vi, X=X, k=k, objective=target, verbose=verbose, digits=digits, extendInt="no")$root, silent=TRUE) if (inherits(tau2, "try-error")) { conv <- FALSE if (length(method) == 1L) { stop(mstyle$stop("Error in iterative search for tau2 using uniroot().")) } else { if (verbose) warning(mstyle$warning("Error in iterative search for tau2 using uniroot().")) } } } } #W <- diag(wi, nrow=k, ncol=k) #stXWX <- .invcalc(X=X, W=W, k=k) #P <- W - W %*% X %*% stXWX %*% crossprod(X,W) # needed for se.tau2 computation below (not when using the simpler equation) } else { tau2 <- tau2.val } } ### maximum-likelihood (ML), restricted maximum-likelihood (REML), and empirical Bayes (EB) estimators if (is.element(method[1], c("ML","REML","EB"))) { if (is.null(con$tau2.init)) { # check if user specified initial value for tau2 tau2 <- max(0, tau2, con$tau2.min) # if not, use HE estimate (or con$tau2.min) as initial estimate for tau2 } else { tau2 <- con$tau2.init # if yes, use value specified by user } while (change > con$threshold) { if (verbose) cat(mstyle$verbose(paste(mstyle$verbose(paste("Iteration", formatC(iter, width=5, flag="-", format="f", digits=0), "tau^2 =", fmtx(tau2, digits[["var"]]), "\n"))))) iter <- iter + 1 old2 <- tau2 wi <- 1/(vi + tau2) if (any(tau2 + vi < 0)) stop(mstyle$stop("Some marginal variances are negative.")) if (any(is.infinite(wi))) stop(mstyle$stop("Division by zero when computing the inverse variance weights.")) W <- diag(wi, nrow=k, ncol=k) stXWX <- .invcalc(X=X, W=W, k=k) P <- W - W %*% X %*% stXWX %*% crossprod(X,W) if (method[1] == "ML") { PP <- P %*% P adj <- (crossprod(Ymc,PP) %*% Ymc - sum(wi)) / sum(wi^2) } if (method[1] == "REML") { PP <- P %*% P adj <- (crossprod(Ymc,PP) %*% Ymc - .tr(P)) / .tr(PP) } if (method[1] == "EB") { adj <- (crossprod(Ymc,P) %*% Ymc * k/(k-p) - k) / sum(wi) } adj <- c(adj) * con$stepadj # apply (user-defined) step adjustment if (is.na(adj)) # can happen for a saturated model when fixing tau^2 adj <- 0 while (tau2 + adj < con$tau2.min) # use step-halving if necessary adj <- adj / 2 tau2 <- ifelse(tau2.fix, tau2.val, tau2 + adj) change <- abs(old2 - tau2) if (iter > con$maxiter) { conv <- FALSE break } } if (!conv) { if (length(method) == 1L) { stop(mstyle$stop("Fisher scoring algorithm did not converge. See 'help(rma)' for possible remedies.")) } else { if (verbose) warning(mstyle$warning("Fisher scoring algorithm did not converge. See 'help(rma)' for possible remedies.")) } } ### check if ll is larger when tau^2 = 0 (only if ll0check=TRUE and only possible/sensible if allvipos and !tau2.fix) ### note: this doesn't catch the case where tau^2 = 0 is a local maximum if (conv && is.element(method[1], c("ML","REML")) && con$ll0check && allvipos && !tau2.fix) { wi <- 1/vi W <- diag(wi, nrow=k, ncol=k) stXWX <- .invcalc(X=X, W=W, k=k) beta <- stXWX %*% crossprod(X,W) %*% Ymc RSS <- sum(wi*(ymci - X %*% beta)^2) if (method[1] == "ML") ll0 <- -1/2 * (k) * log(2*base::pi) - 1/2 * sum(log(vi)) - 1/2 * RSS if (method[1] == "REML") ll0 <- -1/2 * (k-p) * log(2*base::pi) - 1/2 * sum(log(vi)) - 1/2 * determinant(crossprod(X,W) %*% X, logarithm=TRUE)$modulus - 1/2 * RSS wi <- 1/(vi + tau2) if (any(tau2 + vi < 0)) stop(mstyle$stop("Some marginal variances are negative.")) if (any(is.infinite(wi))) stop(mstyle$stop("Division by zero when computing the inverse variance weights.")) W <- diag(wi, nrow=k, ncol=k) stXWX <- .invcalc(X=X, W=W, k=k) beta <- stXWX %*% crossprod(X,W) %*% Ymc RSS <- sum(wi*(ymci - X %*% beta)^2) if (method[1] == "ML") ll <- -1/2 * (k) * log(2*base::pi) - 1/2 * sum(log(vi + tau2)) - 1/2 * RSS if (method[1] == "REML") ll <- -1/2 * (k-p) * log(2*base::pi) - 1/2 * sum(log(vi + tau2)) - 1/2 * determinant(crossprod(X,W) %*% X, logarithm=TRUE)$modulus - 1/2 * RSS if (ll0 - ll > con$tol && tau2 > con$threshold) { warning(mstyle$warning("Fisher scoring algorithm may have gotten stuck at a local maximum.\nSetting tau^2 = 0. Check the profile likelihood plot with profile()."), call.=FALSE) tau2 <- 0 } } ### need to run this so that wi and P are based on the final tau^2 value if (conv) { wi <- 1/(vi + tau2) if (any(tau2 + vi < 0)) stop(mstyle$stop("Some marginal variances are negative.")) if (any(is.infinite(wi))) stop(mstyle$stop("Division by zero when computing the inverse variance weights.")) W <- diag(wi, nrow=k, ncol=k) stXWX <- .invcalc(X=X, W=W, k=k) P <- W - W %*% X %*% stXWX %*% crossprod(X,W) } } if (conv) { ### make sure that tau2 is >= con$tau2.min tau2 <- max(con$tau2.min, c(tau2)) ### check if any marginal variances are negative (only possible if user has changed tau2.min) if (!is.na(tau2) && any(tau2 + vi < 0)) stop(mstyle$stop("Some marginal variances are negative.")) ### verbose output upon convergence for ML/REML/EB estimators if (verbose && is.element(method[1], c("ML","REML","EB"))) { cat(mstyle$verbose(paste("Iteration", formatC(iter, width=5, flag="-", format="f", digits=0), "tau^2 =", fmtx(tau2, digits[["var"]]), "\n"))) cat(mstyle$verbose(paste("Fisher scoring algorithm converged after", iter, "iterations.\n"))) } ### standard error of the tau^2 estimators (also when the user has fixed/specified a tau^2 value) ### see notes.pdf and note: .tr(P%*%P) = sum(P*t(P)) = sum(P*P) (since P is symmetric) if (method[1] == "HS") se.tau2 <- sqrt(1/sum(wi)^2 * (2*(k-p) + 4*max(tau2,0)*.tr(P) + 2*max(tau2,0)^2*sum(P*P))) # note: wi = 1/vi if (method[1] == "HSk") se.tau2 <- k/(k-p) * sqrt(1/sum(wi)^2 * (2*(k-p) + 4*max(tau2,0)*.tr(P) + 2*max(tau2,0)^2*sum(P*P))) if (method[1] == "HE") se.tau2 <- sqrt(1/(k-p)^2 * (2*sum(PV*t(PV)) + 4*max(tau2,0)*trPV + 2*max(tau2,0)^2*(k-p))) if (is.element(method[1], c("DL","DLIT"))) se.tau2 <- sqrt(1/trP^2 * (2*(k-p) + 4*max(tau2,0)*trP + 2*max(tau2,0)^2*sum(P*P))) if (is.element(method[1], c("GENQ","GENQM"))) se.tau2 <- sqrt(1/trP^2 * (2*sum(PV*t(PV)) + 4*max(tau2,0)*sum(PV*P) + 2*max(tau2,0)^2*sum(P*P))) if (method[1] == "SJ") se.tau2 <- sqrt(tau2.0^2/(k-p)^2 * (2*sum(PV*t(PV)) + 4*max(tau2,0)*sum(PV*P) + 2*max(tau2,0)^2*sum(P*P))) if (method[1] == "ML") se.tau2 <- sqrt(2/sum(wi^2)) # note: wi = 1/(vi + tau2) for ML, REML, EB, PM, PMM, and SJIT if (method[1] == "REML") se.tau2 <- sqrt(2/sum(P*P)) # based on Fisher information matrix #se.tau2 <- sqrt(1 / (t(Ymc) %*% P %*% P %*% P %*% Ymc - 1/2 * sum(P*P))) # based on Hessian if (is.element(method[1], c("EB","PM","MP","PMM","SJIT"))) { wi <- 1/(vi + tau2) #V <- diag(vi, nrow=k, ncol=k) #PV <- P %*% V # note: this is not symmetric #se.tau2 <- sqrt((k/(k-p))^2 / sum(wi)^2 * (2*sum(PV*t(PV)) + 4*max(tau2,0)*sum(PV*P) + 2*max(tau2,0)^2*sum(P*P))) se.tau2 <- sqrt(2*k^2/(k-p) / sum(wi)^2) # these two equations are actually identical, but this one is much simpler } } else { method <- method[-1] } } if (k == 1L) method <- method.sav } ######################################################################### ###### parameter estimation for the location-scale model (rma.ls) if (model == "rma.ls") { if (!is.element(method[1], c("ML","REML"))) stop(mstyle$stop("Location-scale models can only be fitted with ML or REML estimation.")) tau2.fix <- FALSE if (!is.null(tau2) && !is.na(tau2)) warning(mstyle$warning("Argument 'tau2' ignored for location-scale models."), call.=FALSE) ### get optimizer arguments from control argument optimizer <- match.arg(con$optimizer, c("optim","nlminb","uobyqa","newuoa","bobyqa","nloptr","nlm","hjk","nmk","mads","ucminf","lbfgsb3c","subplex","BBoptim","optimParallel","constrOptim","solnp","constrOptim.nl","Nelder-Mead","BFGS","CG","L-BFGS-B","SANN","Brent","Rcgmin","Rvmmin")) optmethod <- match.arg(con$optmethod, c("Nelder-Mead","BFGS","CG","L-BFGS-B","SANN","Brent")) if (optimizer %in% c("Nelder-Mead","BFGS","CG","L-BFGS-B","SANN","Brent")) { optmethod <- optimizer optimizer <- "optim" } parallel <- con$parallel cl <- con$cl ncpus <- con$ncpus optcontrol <- control[is.na(con.pos)] # get arguments that are control arguments for optimizer if (length(optcontrol) == 0L) optcontrol <- list() ### if control argument 'ncpus' is larger than 1, automatically switch to optimParallel optimizer if (ncpus > 1L) optimizer <- "optimParallel" ### when using an identify link, automatically set constrOptim as the default optimizer (but solnp when optbeta=TRUE) if (link == "identity") { if (!is.element(optimizer, c("constrOptim","solnp","nloptr","constrOptim.nl"))) { if (optimizer != "nlminb") warning(mstyle$warning("Can only use optimizers 'constrOptim', 'solnp', 'nloptr', or 'constrOptim.nl' when link='identity' (resetting to 'constrOptim')."), call.=FALSE) optimizer <- "constrOptim" } if (optbeta) optimizer <- "solnp" } if (link == "log" && is.element(optimizer, c("constrOptim","constrOptim.nl"))) stop(mstyle$stop(paste0("Cannot use '", optimizer, "' optimizer when using a log link."))) # but can use solnp and nloptr reml <- ifelse(method[1] == "REML", TRUE, FALSE) ### drop redundant predictors tmp <- try(lm(yi ~ Z - 1), silent=TRUE) if (inherits(tmp, "lm")) { coef.na.Z <- is.na(coef(tmp)) } else { coef.na.Z <- rep(FALSE, NCOL(Z)) } if (any(coef.na.Z)) { warning(mstyle$warning("Redundant predictors dropped from the scale model."), call.=FALSE) Z <- Z[,!coef.na.Z,drop=FALSE] Z.f <- Z.f[,!coef.na.Z,drop=FALSE] } ### check whether intercept is included and if yes, move it to the first column (NAs already removed, so na.rm=TRUE for any() not necessary) is.int <- apply(Z, 2, .is.intercept) if (any(is.int)) { Z.int.incl <- TRUE int.indx <- which(is.int, arr.ind=TRUE) Z <- cbind(intrcpt=1, Z[,-int.indx, drop=FALSE]) ### this removes any duplicate intercepts Z.f <- cbind(intrcpt=1, Z.f[,-int.indx, drop=FALSE]) ### this removes any duplicate intercepts Z.intercept <- TRUE ### set intercept appropriately so that the predict() function works } else { Z.int.incl <- FALSE } q <- NCOL(Z) ### number of columns in Z (including the intercept if it is included) ### check whether model matrix is of full rank if (!.chkpd(crossprod(Z), tol=con$evtol)) stop(mstyle$stop("Model matrix for scale part of the model not of full rank. Cannot fit model.")) ### check whether this is an intercept-only model is.int <- apply(Z, 2, .is.intercept) if (q == 1L && is.int) { Z.int.only <- TRUE } else { Z.int.only <- FALSE } ### checks on alpha argument if (missing(alpha) || is.null(alpha) || all(is.na(alpha))) { alpha <- rep(NA_real_, q) } else { if (length(alpha) == 1L) alpha <- rep(alpha, q) if (length(alpha) != q) stop(mstyle$stop(paste0("Length of 'alpha' argument (", length(alpha), ") does not match actual number of parameters (", q, ")."))) } ### checks on beta argument if (optbeta) { if (missing(beta) || is.null(beta) || all(is.na(beta))) { beta <- rep(NA_real_, p) } else { if (length(beta) == 1L) beta <- rep(beta, p) if (length(beta) != p) stop(mstyle$stop(paste0("Length of 'beta' argument (", length(beta), ") does not match actual number of parameters (", p, ")."))) } } ### rescale Z matrix (only for models with moderators, models including a non-fixed intercept term, when not placing constraints on alpha, and when not optimizing over beta) if (!Z.int.only && Z.int.incl && con$scaleZ && is.na(alpha[1]) && all(is.infinite(con$alpha.min)) && all(is.infinite(con$alpha.max)) && !optbeta) { Zsave <- Z meanZ <- colMeans(Z[, 2:q, drop=FALSE]) sdZ <- apply(Z[, 2:q, drop=FALSE], 2, sd) ### consider using colSds() from matrixStats package is.d <- apply(Z, 2, .is.dummy) ### is each column a dummy variable (i.e., only 0s and 1s)? mZ <- rbind(c(intrcpt=1, -1*ifelse(is.d[-1], 0, meanZ/sdZ)), cbind(0, diag(ifelse(is.d[-1], 1, 1/sdZ), nrow=length(is.d)-1, ncol=length(is.d)-1))) imZ <- try(suppressWarnings(solve(mZ)), silent=TRUE) Z[,!is.d] <- apply(Z[, !is.d, drop=FALSE], 2, scale) ### rescale the non-dummy variables if (any(!is.na(alpha))) { if (inherits(imZ, "try-error")) stop(mstyle$stop("Unable to rescale starting values for the scale parameters.")) alpha <- diag(imZ) * alpha } } else { mZ <- NULL } if (k == 1L && Z.int.only) { if (link == "log") con$alpha.init <- -10000 if (link == "identity") con$alpha.init <- 0.00001 } ### set/transform/check alpha.init if (verbose > 1) message(mstyle$message("Extracting/computing initial values ...")) if (is.null(con$alpha.init)) { fit <- suppressWarnings(rma.uni(yi, vi, mods=X, intercept=FALSE, method="HE", skipr2=TRUE)) tmp <- rstandard(fit) if (link == "log") { tmp <- suppressWarnings(rma.uni(log(tmp$resid^2), 4/tmp$resid^2*tmp$se^2, mods=Z, intercept=FALSE, method="FE")) #tmp <- rma.uni(log(tmp$resid^2), 4/tmp$resid^2*tmp$se^2, mods=Z, intercept=FALSE, method="FE") #tmp <- rma.uni(log(tmp$resid^2), tmp$se^2, mods=Z, intercept=FALSE, method="FE") #tmp <- rma.uni(log(tmp$resid^2), 1, mods=Z, intercept=FALSE, method="FE") alpha.init <- coef(tmp) } if (link == "identity") { #tmp <- rma.uni(tmp$resid^2, 4*tmp$resid^2*tmp$se^2, mods=Z, intercept=FALSE, method="FE") tmp <- suppressWarnings(rma.uni(tmp$resid^2, tmp$se^2, mods=Z, intercept=FALSE, method="FE")) #tmp <- rma.uni(tmp$resid^2, 1, mods=Z, intercept=FALSE, method="FE") alpha.init <- coef(tmp) if (any(Z %*% alpha.init < 0)) alpha.init <- ifelse(is.int, fit$tau2+.01, 0) if (any(Z %*% alpha.init < 0)) stop(mstyle$stop("Unable to find suitable starting values for the scale parameters.")) } } else { alpha.init <- con$alpha.init if (!is.null(mZ)) { if (inherits(imZ, "try-error")) stop(mstyle$stop("Unable to rescale starting values for the scale parameters.")) alpha.init <- c(imZ %*% cbind(alpha.init)) } if (link == "identity" && any(Z %*% alpha.init < 0)) stop(mstyle$stop("Starting values for the scale parameters lead to one or more negative tau^2 values.")) if (optbeta) fit <- suppressWarnings(rma.uni(yi, vi, mods=X, intercept=FALSE, method="HE", skipr2=TRUE)) } if (length(alpha.init) != q) stop(mstyle$stop(paste0("Length of 'alpha.init' argument (", length(alpha.init), ") does not match actual number of parameters (", q, ")."))) if (anyNA(alpha.init)) stop(mstyle$stop("No missing values allowed in 'alpha.init'.")) if (optbeta) { if (is.null(con$beta.init)) { beta.init <- c(fit$beta) } else { beta.init <- con$beta.init if (length(beta.init) != p) stop(mstyle$stop(paste0("Length of 'beta.init' argument (", length(beta.init), ") does not match actual number of parameters (", p, ")."))) if (anyNA(beta.init)) stop(mstyle$stop("No missing values allowed in 'beta.init'.")) } } else { beta.init <- NULL } ### set potential constraints on alpha values if (length(con$alpha.min) == 1L) con$alpha.min <- rep(con$alpha.min, q) if (length(con$alpha.max) == 1L) con$alpha.max <- rep(con$alpha.max, q) if (length(con$alpha.min) != q) stop(mstyle$stop(paste0("Length of 'alpha.min' argument (", length(alpha.min), ") does not match actual number of parameters (", q, ")."))) if (length(con$alpha.max) != q) stop(mstyle$stop(paste0("Length of 'alpha.max' argument (", length(alpha.max), ") does not match actual number of parameters (", q, ")."))) if (any(xor(is.infinite(con$alpha.min),is.infinite(con$alpha.max)))) stop(mstyle$stop("Constraints on scale coefficients must be placed on both the lower and upper bound.")) alpha.min <- con$alpha.min alpha.max <- con$alpha.max if (link == "identity" && (any(alpha.min != -Inf) || any(alpha.max != Inf))) stop(mstyle$stop("Cannot use constraints on scale coefficients when using an identity link.")) alpha.init <- pmax(alpha.init, alpha.min) alpha.init <- pmin(alpha.init, alpha.max) alpha.init <- mapply(.mapinvfun.alpha, alpha.init, alpha.min, alpha.max) ### estimate alpha (and beta) values if (verbose > 1) message(mstyle$message("Estimating scale parameters ...\n")) tmp <- .chkopt(optimizer, optcontrol) optimizer <- tmp$optimizer optcontrol <- tmp$optcontrol par.arg <- tmp$par.arg ctrl.arg <- tmp$ctrl.arg ### when using nloptr, have to use NLOPT_LN_COBYLA to allow for nonlinear inequality constraints if (link == "identity" && optimizer == "nloptr::nloptr") optcontrol$algorithm <- "NLOPT_LN_COBYLA" if (optimizer == "optimParallel::optimParallel") { parallel$cl <- NULL if (is.null(cl)) { ncpus <- as.integer(ncpus) if (ncpus < 1L) stop(mstyle$stop("Control argument 'ncpus' must be >= 1.")) cl <- parallel::makePSOCKcluster(ncpus) on.exit(parallel::stopCluster(cl), add=TRUE) } else { if (!inherits(cl, "SOCKcluster")) stop(mstyle$stop("Specified cluster is not of class 'SOCKcluster'.")) } parallel$cl <- cl if (is.null(parallel$forward)) parallel$forward <- FALSE if (is.null(parallel$loginfo)) { if (verbose) { parallel$loginfo <- TRUE } else { parallel$loginfo <- FALSE } } } #return(list(con=con, optimizer=optimizer, optmethod=optmethod, optcontrol=optcontrol, ctrl.arg=ctrl.arg)) if (link == "log") { optcall <- paste(optimizer, "(", par.arg, "=c(beta.init, alpha.init), .ll.rma.ls, ", ifelse(optimizer=="optim", "method=optmethod, ", ""), "yi=yi, vi=vi, X=X, Z=Z, reml=reml, k=k, pX=p, alpha.val=alpha, beta.val=beta, verbose=verbose, digits=digits, REMLf=con$REMLf, link=link, mZ=mZ, alpha.min=alpha.min, alpha.max=alpha.max, alpha.transf=TRUE, tau2.min=con$tau2.min, tau2.max=con$tau2.max, optbeta=optbeta", ctrl.arg, ")\n", sep="") } if (link == "identity") { if (optimizer == "Rsolnp::solnp") optcall <- paste0("Rsolnp::solnp(pars=c(beta.init, alpha.init), fun=.ll.rma.ls, ineqfun=.rma.ls.ineqfun.pos, ineqLB=rep(0,k), ineqUB=rep(Inf,k), yi=yi, vi=vi, X=X, Z=Z, reml=reml, k=k, pX=p, alpha.val=alpha, beta.val=beta, verbose=verbose, digits=digits, REMLf=con$REMLf, link=link, mZ=mZ, alpha.min=alpha.min, alpha.max=alpha.max, alpha.transf=TRUE, tau2.min=con$tau2.min, tau2.max=con$tau2.max, optbeta=optbeta", ctrl.arg, ")\n") if (optimizer == "constrOptim") optcall <- paste0("constrOptim(theta=c(beta.init, alpha.init), f=.ll.rma.ls, grad=NULL, ui=Z, ci=rep(0,k), yi=yi, vi=vi, X=X, Z=Z, reml=reml, k=k, pX=p, alpha.val=alpha, beta.val=beta, verbose=verbose, digits=digits, REMLf=con$REMLf, link=link, mZ=mZ, alpha.min=alpha.min, alpha.max=alpha.max, alpha.transf=TRUE, tau2.min=con$tau2.min, tau2.max=con$tau2.max, optbeta=optbeta", ctrl.arg, ")\n") if (optimizer == "nloptr::nloptr") optcall <- paste0("nloptr::nloptr(x0=c(beta.init, alpha.init), eval_f=.ll.rma.ls, eval_g_ineq=.rma.ls.ineqfun.neg, yi=yi, vi=vi, X=X, Z=Z, reml=reml, k=k, pX=p, alpha.val=alpha, beta.val=beta, verbose=verbose, digits=digits, REMLf=con$REMLf, link=link, mZ=mZ, alpha.min=alpha.min, alpha.max=alpha.max, alpha.transf=TRUE, tau2.min=con$tau2.min, tau2.max=con$tau2.max, optbeta=optbeta", ctrl.arg, ")\n") if (optimizer == "alabama::constrOptim.nl") optcall <- paste0("alabama::constrOptim.nl(par=c(beta.init, alpha.init), fn=.ll.rma.ls, hin=.rma.ls.ineqfun.pos, yi=yi, vi=vi, X=X, Z=Z, reml=reml, k=k, pX=p, alpha.val=alpha, beta.val=beta, verbose=verbose, digits=digits, REMLf=con$REMLf, link=link, mZ=mZ, alpha.min=alpha.min, alpha.max=alpha.max, alpha.transf=TRUE, tau2.min=con$tau2.min, tau2.max=con$tau2.max, optbeta=optbeta", ctrl.arg, ")\n") } #print(optcall) #return(optcall) if (verbose) { opt.res <- try(eval(str2lang(optcall)), silent=!verbose) } else { opt.res <- try(suppressWarnings(eval(str2lang(optcall))), silent=!verbose) } #return(opt.res) ### convergence checks (if verbose print optimParallel log, if verbose > 2 print opt.res, and unify opt.res$par) opt.res$par <- .chkconv(optimizer=optimizer, opt.res=opt.res, optcontrol=optcontrol, fun="rma", verbose=verbose) ### back-transform in case constraints were placed on alpha values if (optbeta) { opt.res$par[-seq_len(p)] <- mapply(.mapfun.alpha, opt.res$par[-seq_len(p)], alpha.min, alpha.max) } else { opt.res$par <- mapply(.mapfun.alpha, opt.res$par, alpha.min, alpha.max) } ### replace fixed alpha (and beta) values in opt.res$par if (optbeta) { opt.res$par[seq_len(p)] <- ifelse(is.na(beta), opt.res$par[seq_len(p)], beta) opt.res$par[-seq_len(p)] <- ifelse(is.na(alpha), opt.res$par[-seq_len(p)], alpha) } else { opt.res$par <- ifelse(is.na(alpha), opt.res$par, alpha) } ### try to compute vcov matrix for scale parameter estimates H <- NA_real_ if (optbeta) { va <- matrix(NA_real_, nrow=p+q, ncol=p+q) hest <- c(is.na(beta), is.na(alpha)) } else { va <- matrix(NA_real_, nrow=q, ncol=q) hest <- is.na(alpha) } if (any(hest) && !isTRUE(ddd$skiphes)) { if (verbose > 1) message(mstyle$message("\nComputing Hessian ...")) if (con$hesspack == "numDeriv") H <- try(numDeriv::hessian(func=.ll.rma.ls, x=opt.res$par, method.args=con$hessianCtrl, yi=yi, vi=vi, X=X, Z=Z, reml=reml, k=k, pX=p, alpha.val=alpha, beta.val=beta, verbose=FALSE, digits=digits, REMLf=con$REMLf, link=link, mZ=mZ, alpha.min=alpha.min, alpha.max=alpha.max, alpha.transf=FALSE, tau2.min=con$tau2.min, tau2.max=con$tau2.max, optbeta=optbeta), silent=TRUE) if (con$hesspack == "pracma") H <- try(pracma::hessian(f=.ll.rma.ls, x0=opt.res$par, yi=yi, vi=vi, X=X, Z=Z, reml=reml, k=k, pX=p, alpha.val=alpha, beta.val=beta, verbose=FALSE, digits=digits, REMLf=con$REMLf, link=link, mZ=mZ, alpha.min=alpha.min, alpha.max=alpha.max, alpha.transf=FALSE, tau2.min=con$tau2.min, tau2.max=con$tau2.max, optbeta=optbeta), silent=TRUE) if (inherits(H, "try-error")) { warning(mstyle$warning("Error when trying to compute the Hessian."), call.=FALSE) } else { H.hest <- H[hest, hest, drop=FALSE] iH.hest <- try(suppressWarnings(chol2inv(chol(H.hest))), silent=TRUE) if (inherits(iH.hest, "try-error") || anyNA(iH.hest) || any(is.infinite(iH.hest))) { warning(mstyle$warning("Error when trying to invert the Hessian."), call.=FALSE) } else { va[hest, hest] <- iH.hest } } } if (optbeta) { vba <- va vb <- va[seq_len(p), seq_len(p), drop=FALSE] va <- va[-seq_len(p), -seq_len(p), drop=FALSE] } ### get scale (and location) parameter estimates alpha.val <- alpha beta.val <- beta if (optbeta) { beta <- cbind(opt.res$par[seq_len(p)]) alpha <- cbind(opt.res$par[-seq_len(p)]) } else { alpha <- cbind(opt.res$par) } if (any(alpha <= alpha.min + 10*.Machine$double.eps^0.25) || any(alpha >= alpha.max - 10*.Machine$double.eps^0.25)) warning(mstyle$warning("One or more 'alpha' estimates are (almost) equal to their lower or upper bound.\nTreat results with caution (or consider adjusting 'alpha.min' and/or 'alpha.max')."), call.=FALSE) ### scale back alpha and va when Z matrix was rescaled if (!is.null(mZ)) { alpha <- mZ %*% alpha va[!hest,] <- 0 va[,!hest] <- 0 va <- mZ %*% va %*% t(mZ) va[!hest,] <- NA_real_ va[,!hest] <- NA_real_ Z <- Zsave } ### set/check 'att' argument att <- .set.btt(att, q, Z.int.incl, colnames(Z)) m.alpha <- length(att) ### number of alphas to test (m = q if all alphas are tested) ### ddf calculation if (is.element(test, c("knha","adhoc","t"))) { ddf.alpha <- k-q } else { ddf.alpha <- NA_integer_ } ### QS calculation QS <- try(as.vector(t(alpha)[att] %*% chol2inv(chol(va[att,att])) %*% alpha[att]), silent=TRUE) if (inherits(QS, "try-error")) QS <- NA_real_ se.alpha <- sqrt(diag(va)) rownames(alpha) <- rownames(va) <- colnames(va) <- colnames(Z) names(se.alpha) <- NULL zval.alpha <- c(alpha/se.alpha) if (is.element(test, c("knha","adhoc","t"))) { QS <- QS / m.alpha QSdf <- c(m.alpha, ddf.alpha) QSp <- if (QSdf[2] > 0) pf(QS, df1=QSdf[1], df2=QSdf[2], lower.tail=FALSE) else NA_real_ pval.alpha <- if (ddf.alpha > 0) 2*pt(abs(zval.alpha), df=ddf.alpha, lower.tail=FALSE) else rep(NA_real_,q) crit.alpha <- if (ddf.alpha > 0) qt(level/2, df=ddf.alpha, lower.tail=FALSE) else NA_real_ } else { QSdf <- c(m.alpha, ddf.alpha) QSp <- pchisq(QS, df=QSdf[1], lower.tail=FALSE) pval.alpha <- 2*pnorm(abs(zval.alpha), lower.tail=FALSE) crit.alpha <- qnorm(level/2, lower.tail=FALSE) } ci.lb.alpha <- c(alpha - crit.alpha * se.alpha) ci.ub.alpha <- c(alpha + crit.alpha * se.alpha) if (link == "log") tau2 <- exp(as.vector(Z %*% alpha)) if (link == "identity") tau2 <- as.vector(Z %*% alpha) } ### equal/fixed/common-effects model (note: sets tau2 to zero even when tau2 value is specified) if (is.element(method[1], c("FE","EE","CE"))) tau2 <- 0 ######################################################################### ###### model fitting, test statistics, and confidence intervals if (verbose > 1) message(mstyle$message("\nModel fitting ...")) wi <- 1/(vi + tau2) W <- diag(wi, nrow=k, ncol=k) M <- diag(vi + tau2, nrow=k, ncol=k) if (weighted) { ######################### ### weighted analysis ### ######################### ### fit model with weighted estimation if (is.null(weights) || is.element(test, c("knha","adhoc"))) { ### if no weights are specified, use default inverse variance weights, that is, 1/vi or 1/(vi + tau2) ### also, even with weights, if test="knha" or "adhoc", need to run this to get RSS.knha ### if any vi = 0 and tau^2 is estimated to be 0 (or is set to 0 for a FE model), then get Inf for wi if (any(is.infinite(wi))) stop(mstyle$stop("Division by zero when computing the inverse variance weights.")) ### don't recompute beta and vb when optbeta=TRUE, since these are already estimated if (!optbeta) { stXWX <- .invcalc(X=X, W=W, k=k) beta <- stXWX %*% crossprod(X,W) %*% Y vb <- stXWX } RSS.f <- sum(wi*c(yi - X %*% beta)^2) #P <- W - W %*% X %*% stXWX %*% crossprod(X,W) #RSS.f <- crossprod(Y,P) %*% Y RSS.knha <- RSS.f } if (!is.null(weights)) { ### if weights are specified, use them (note: RSS.f is recomputed if test="knha" or "adhoc") A <- diag(weights, nrow=k, ncol=k) stXAX <- .invcalc(X=X, W=A, k=k) beta <- stXAX %*% crossprod(X,A) %*% Y vb <- stXAX %*% t(X) %*% A %*% M %*% A %*% X %*% stXAX RSS.f <- sum(wi*c(yi - X %*% beta)^2) #P <- W - W %*% X %*% stXAX %*% t(X) %*% A - A %*% X %*% stXAX %*% t(X) %*% W + A %*% X %*% stXAX %*% t(X) %*% W %*% X %*% stXAX %*% t(X) %*% A #RSS.f <- crossprod(Y,P) %*% Y } #return(list(beta=beta, vb=vb, se=sqrt(diag(vb)), RSS.f=RSS.f)) ### calculate scaling factor for Knapp & Hartung method ### note: catch cases where RSS.knha is extremely small, which is probably due to all yi being equal ### then set s2w to 0 (to avoid the strange looking output we would obtain if we don't do this) if (is.element(test, c("knha","adhoc"))) { if (RSS.knha <= .Machine$double.eps) { s2w <- 0 } else { s2w <- RSS.knha / (k-p) } } } else { ########################### ### unweighted analysis ### ########################### ### fit model with unweighted estimation ### note: 1) if user has specified weights, they are ignored ### 2) but if method="GENQ/GENQM", they were used to estimate tau^2 stXX <- .invcalc(X=X, W=diag(k), k=k) beta <- stXX %*% crossprod(X,Y) vb <- tcrossprod(stXX,X) %*% M %*% X %*% stXX RSS.f <- sum(wi*(yi - X %*% beta)^2) #P <- W - W %*% X %*% tcrossprod(stXX,X) - X %*% stXX %*% crossprod(X,W) + X %*% stXX %*% crossprod(X,W) %*% X %*% tcrossprod(stXX,X) #RSS.f <- crossprod(Y,P) %*% Y ### calculate scaling factor for Knapp & Hartung method if (is.element(test, c("knha","adhoc"))) { if (any(is.infinite(wi))) stop(mstyle$stop("Division by zero when computing the inverse variance weights.")) stXWX <- .invcalc(X=X, W=W, k=k) beta.knha <- stXWX %*% crossprod(X,W) %*% Y RSS.knha <- sum(wi*(yi - X %*% beta.knha)^2) #P <- W - W %*% X %*% stXWX %*% crossprod(X,W) #RSS.knha <- c(crossprod(Y,P) %*% Y) if (RSS.knha <= .Machine$double.eps) { s2w <- 0 } else { s2w <- RSS.knha / (k-p) } } } if (verbose > 1) message(mstyle$message("Conducting tests of the fixed effects ...")) ### the Knapp & Hartung method as described in the literature is for random/mixed-effects models if (is.element(method[1], c("FE","EE","CE")) && is.element(test, c("knha","adhoc"))) warning(mstyle$warning(paste0("Knapp and Hartung method is not meant to be used in the context of ", method[1], " models.")), call.=FALSE) ### Knapp & Hartung method with ad-hoc correction so that the scale factor is always >= 1 if (test == "adhoc") s2w[s2w < 1] <- 1 ### for Knapp & Hartung method, apply scaling to vb vb <- s2w * vb ### ddf calculation if (is.element(test, c("knha","adhoc","t"))) { if (is.null(ddd$dfs)) { ddf <- k-p } else { ddf <- ddd$dfs[[1]] # would be nice to allow multiple dfs values, but tricky } # since some methods are set up for a single df value } else { ddf <- NA_integer_ } ### QM calculation QM <- try(as.vector(t(beta)[btt] %*% chol2inv(chol(vb[btt,btt])) %*% beta[btt]), silent=TRUE) if (inherits(QM, "try-error")) QM <- NA_real_ ### abbreviate some types of coefficient names if (.isTRUE(ddd$abbrev)) { tmp <- colnames(X) tmp <- gsub("relevel(factor(", "", tmp, fixed=TRUE) tmp <- gsub("\\), ref = \"[[:alnum:]]*\")", "", tmp) tmp <- gsub("poly(", "", tmp, fixed=TRUE) tmp <- gsub(", degree = [[:digit:]], raw = TRUE)", "^", tmp) tmp <- gsub(", degree = [[:digit:]], raw = T)", "^", tmp) tmp <- gsub(", degree = [[:digit:]])", "^", tmp) tmp <- gsub("rcs\\([[:alnum:]]*, [[:digit:]]\\)", "", tmp) tmp <- gsub("factor(", "", tmp, fixed=TRUE) tmp <- gsub("I(", "", tmp, fixed=TRUE) tmp <- gsub(")", "", tmp, fixed=TRUE) colnames(X) <- tmp } rownames(beta) <- rownames(vb) <- colnames(vb) <- colnames(X.f) <- colnames(X) se <- sqrt(diag(vb)) names(se) <- NULL zval <- c(beta/se) if (is.element(test, c("knha","adhoc","t"))) { QM <- QM / m QMdf <- c(m, ddf) QMp <- if (QMdf[2] > 0) pf(QM, df1=QMdf[1], df2=QMdf[2], lower.tail=FALSE) else NA_real_ pval <- if (ddf > 0) 2*pt(abs(zval), df=ddf, lower.tail=FALSE) else rep(NA_real_,p) crit <- if (ddf > 0) qt(level/2, df=ddf, lower.tail=FALSE) else NA_real_ } else { QMdf <- c(m, ddf) QMp <- pchisq(QM, df=QMdf[1], lower.tail=FALSE) pval <- 2*pnorm(abs(zval), lower.tail=FALSE) crit <- qnorm(level/2, lower.tail=FALSE) } ci.lb <- c(beta - crit * se) ci.ub <- c(beta + crit * se) ######################################################################### ### heterogeneity test (Wald-type test of the extra coefficients in the saturated model) if (verbose > 1) message(mstyle$message("Conducting heterogeneity test ...")) if (allvipos) { ### heterogeneity test (always uses inverse variance method) # note: this is unaffected by the 'weighted' argument, since under H0, the same parameters are # estimated and weighted estimation provides the most efficient estimates; therefore, also any # arbitrary weights specified by the user are not relevant here (different from what the metan # command in Stata does!) see also: Chen, Z., Ng, H. K. T., & Nadarajah, S. (2014). A note on # Cochran test for homogeneity in one-way ANOVA and meta-analysis. Statistical Papers, 55(2), # 301-310. This shows that the weights used are not relevant. if (k > p) { wi <- 1/vi W.FE <- diag(wi, nrow=k, ncol=k) ### note: ll.REML below involves W, so cannot overwrite W stXWX <- .invcalc(X=X, W=W.FE, k=k) P <- W.FE - W.FE %*% X %*% stXWX %*% crossprod(X,W.FE) # need P below for calculation of I^2 QE <- max(0, c(crossprod(Ymc,P) %*% Ymc)) #beta.FE <- stXWX %*% crossprod(X,W.FE) %*% Y #QE <- max(0, sum(wi*(yi - X %*% beta.FE)^2)) QEp <- pchisq(QE, df=k-p, lower.tail=FALSE) ### calculation of 'typical' sampling variance #vt <- (k-1) / (sum(wi) - sum(wi^2)/sum(wi)) # this only applies to the RE model if (i2def == "1") vt <- (k-p) / .tr(P) if (i2def == "2") vt <- 1 / mean(wi) # harmonic mean of the vi values (see Takkouche et al., 1999) ### calculation of I^2 and H^2 if (is.element(method[1], c("FE","EE","CE"))) { I2 <- max(0, 100 * (QE - (k-p)) / QE) H2 <- QE / (k-p) } else { I2 <- 100 * tau2 / (vt + tau2) # vector for location-scale models H2 <- tau2 / vt + 1 # vector for location-scale models } } else { QE <- 0 QEp <- 1 I2 <- 0 H2 <- 1 vt <- 0 } } else { if (!vi0) warning(mstyle$warning(paste0("Cannot compute ", ifelse(int.only, "Q", "QE"), "-test, I^2, or H^2 when there are non-positive sampling variances in the data.")), call.=FALSE) vt <- NA_real_ } ######################################################################### ###### fit statistics if (verbose > 1) message(mstyle$message("Computing fit statistics and log likelihood ...")) ### note: tau2 is not counted as a parameter when it was fixed by the user (same for fixed alpha values) q.est <- ifelse(model == "rma.uni", 0, sum(is.na(alpha.val))) parms <- ifelse(optbeta, sum(is.na(beta.val)), p) + ifelse(model == "rma.uni", ifelse(is.element(method[1], c("FE","EE","CE")) || tau2.fix, 0, 1), q.est) ll.ML <- -1/2 * (k) * log(2*base::pi) - 1/2 * sum(log(vi + tau2)) - 1/2 * RSS.f ll.REML <- -1/2 * (k-p) * log(2*base::pi) + ifelse(con$REMLf, 1/2 * determinant(crossprod(X), logarithm=TRUE)$modulus, 0) + -1/2 * sum(log(vi + tau2)) - 1/2 * determinant(crossprod(X,W) %*% X, logarithm=TRUE)$modulus - 1/2 * RSS.f if (k > p) { if (allvipos) { dev.ML <- -2 * (ll.ML - sum(dnorm(yi, mean=yi, sd=sqrt(vi), log=TRUE))) } else { dev.ML <- -2 * ll.ML } } else { dev.ML <- 0 } AIC.ML <- -2 * ll.ML + 2*parms BIC.ML <- -2 * ll.ML + parms * log(k) AICc.ML <- -2 * ll.ML + 2*parms * max(k, parms+2) / (max(k, parms+2) - parms - 1) dev.REML <- -2 * (ll.REML - 0) ### saturated model has ll = 0 when using the full REML likelihood AIC.REML <- -2 * ll.REML + 2*parms BIC.REML <- -2 * ll.REML + parms * log(k-p) AICc.REML <- -2 * ll.REML + 2*parms * max(k-p, parms+2) / (max(k-p, parms+2) - parms - 1) fit.stats <- matrix(c(ll.ML, dev.ML, AIC.ML, BIC.ML, AICc.ML, ll.REML, dev.REML, AIC.REML, BIC.REML, AICc.REML), ncol=2, byrow=FALSE) dimnames(fit.stats) <- list(c("ll","dev","AIC","BIC","AICc"), c("ML","REML")) fit.stats <- data.frame(fit.stats) ######################################################################### ### compute pseudo R^2 statistic for mixed-effects models with an intercept (only for rma.uni normal models) if (!int.only && int.incl && model == "rma.uni" && !isTRUE(ddd$skipr2)) { if (verbose > 1) message(mstyle$message("Computing R^2 ...")) if (is.element(method[1], c("FE","EE","CE"))) { if (identical(var(yi),0)) { R2 <- 0 } else { if (weighted) { if (is.null(weights)) { R2 <- max(0, 100 * summary(lm(yi ~ X, weights=wi))$adj.r.squared) } else { R2 <- max(0, 100 * summary(lm(yi ~ X, weights=weights))$adj.r.squared) } } else { R2 <- max(0, 100 * summary(lm(yi ~ X))$adj.r.squared) } } } else { if (r2def %in% c("1","1v","3","3v","5","6","7","8")) { args <- list(yi=yi, vi=vi, weights=weights, method=method, weighted=weighted, test=test, verbose=ifelse(verbose, TRUE, FALSE), control=con, digits=digits, outlist="minimal") if (verbose > 1) { res0 <- try(.do.call(rma.uni, args), silent=FALSE) } else { res0 <- try(suppressWarnings(.do.call(rma.uni, args)), silent=TRUE) } if (!inherits(res0, "try-error")) { tau2.RE <- res0$tau2 if (identical(tau2.RE,0) && r2def %in% c("1","3")) { R2 <- 0 } else { ll0 <- logLik(res0) ll1 <- ifelse(method[1] == "ML", ll.ML, ll.REML) lls <- (ifelse(method[1] == "ML", dev.ML, dev.REML) + 2*ll1) / 2 # based on Raudenbush (1994) if (r2def == "1") R2 <- (tau2.RE - tau2) / tau2.RE # like Raudenbush (1994) but with total variance (including sampling variance) in the denominator if (r2def == "1v") R2 <- (tau2.RE - tau2) / (tau2.RE + 1/mean(1/vi)) # model component definition with tau^2_RE in the denominator if (r2def == "3") R2 <- var(c(X%*%beta)) / tau2.RE # model component definition with total variance (including sampling variance) in the denominator if (r2def == "3v") R2 <- var(c(X%*%beta)) / (tau2.RE + 1/mean(1/vi)) # like McFadden's R^2 if (r2def == "5") R2 <- 1 - ll1 / ll0 # like Cox & Snell R^2 if (r2def == "6") R2 <- 1 - (exp(ll0) / exp(ll1))^(2/k) # like Nagelkerke R^2 if (r2def == "7") R2 <- (1 - (exp(ll0) / exp(ll1))^(2/k)) / (1 - exp(ll0)^(2/k)) # how close ME model is to the saturated model in terms of ll (same as 5 for REML) if (r2def == "8") R2 <- (ll1 - ll0) / (lls - ll0) } } else { R2 <- NA_real_ } } else { # model component definition if (r2def == "2") R2 <- var(c(X%*%beta)) / (var(c(X%*%beta)) + tau2) # model component definition with total variance (including sampling variance) in the denominator if (r2def == "2v") R2 <- var(c(X%*%beta)) / (var(c(X%*%beta)) + tau2 + 1/mean(1/vi)) # squared correlation between observed and fitted values if (r2def == "4") R2 <- cor(yi, c(X%*%beta))^2 # squared weighted correlation between observed and fitted values if (r2def == "4w") { if (is.null(weights)) { # identical to eta^2 = F * df1 / (F * df1 + df2) when test="knha" R2 <- cov.wt(cbind(yi, c(X%*%beta)), cor=TRUE, wt=1/(vi+tau2))$cor[1,2]^2 } else { R2 <- cov.wt(cbind(yi, c(X%*%beta)), cor=TRUE, wt=weights)$cor[1,2]^2 } } } R2 <- max(0, 100 * R2) } } else { R2 <- NULL } if (.isTRUE(ddd$pleasedonotreportI2thankyouverymuch)) { I2 <- NA H2 <- NA } ######################################################################### ###### prepare output if (verbose > 1) message(mstyle$message("Preparing output ...")) p.eff <- p k.eff <- k if (is.null(ddd$outlist) || ddd$outlist == "nodata") { res <- list(b=beta, beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, vb=vb, tau2=tau2, se.tau2=se.tau2, tau2.fix=tau2.fix, tau2.f=tau2, I2=I2, H2=H2, R2=R2, vt=vt, QE=QE, QEp=QEp, QM=QM, QMdf=QMdf, QMp=QMp, k=k, k.f=k.f, k.eff=k.eff, k.all=k.all, p=p, p.eff=p.eff, parms=parms, int.only=int.only, int.incl=int.incl, intercept=intercept, allvipos=allvipos, coef.na=coef.na, yi=yi, vi=vi, X=X, weights=weights, yi.f=yi.f, vi.f=vi.f, X.f=X.f, weights.f=weights.f, M=M, outdat.f=outdat.f, ni=ni, ni.f=ni.f, ids=ids, not.na=not.na, subset=subset, slab=slab, slab.null=slab.null, measure=measure, method=method[1], model=model, weighted=weighted, test=test, dfs=ddf, ddf=ddf, s2w=s2w, btt=btt, m=m, digits=digits, level=level, control=control, verbose=verbose, add=add, to=to, drop00=drop00, fit.stats=fit.stats, formula.yi=formula.yi, formula.mods=formula.mods, version=packageVersion("metafor"), call=mf) if (is.null(ddd$outlist)) res <- append(res, list(data=data), which(names(res) == "fit.stats")) } else { if (ddd$outlist == "minimal") { res <- list(b=beta, beta=beta, se=se, zval=zval, pval=pval, ci.lb=ci.lb, ci.ub=ci.ub, vb=vb, tau2=tau2, se.tau2=se.tau2, tau2.fix=tau2.fix, I2=I2, H2=H2, R2=R2, QE=QE, QEp=QEp, QM=QM, QMdf=QMdf, QMp=QMp, k=k, k.eff=k.eff, p=p, p.eff=p.eff, parms=parms, int.only=int.only, measure=measure, method=method[1], model=model, test=test, dfs=ddf, ddf=ddf, btt=btt, m=m, digits=digits, fit.stats=fit.stats) } else { res <- eval(str2lang(paste0("list(", ddd$outlist, ")"))) } } if (model == "rma.ls") { res$alpha <- alpha res$va <- va res$se.alpha <- se.alpha res$zval.alpha <- zval.alpha res$pval.alpha <- pval.alpha res$ci.lb.alpha <- ci.lb.alpha res$ci.ub.alpha <- ci.ub.alpha res$alpha.fix <- !is.na(alpha.val) res$optbeta <- optbeta if (optbeta) { res$vba <- vba res$beta.fix <- !is.na(beta.val) } res$q <- q res$alphas <- q res$link <- link res$Z <- Z res$Z.f <- Z.f res$tau2.f <- rep(NA_real_, k.f) res$tau2.f[not.na] <- tau2 res$att <- att res$m.alpha <- m.alpha res$ddf.alpha <- ddf.alpha res$QS <- QS res$QSdf <- QSdf res$QSp <- QSp res$formula.scale <- formula.scale res$Z.int.incl <- Z.int.incl res$Z.intercept <- Z.int.incl res$Z.int.only <- Z.int.only res$coef.na.Z <- coef.na.Z res$H <- H } time.end <- proc.time() res$time <- unname(time.end - time.start)[3] if (.isTRUE(ddd$time)) .print.time(res$time) if (verbose || .isTRUE(ddd$time)) cat("\n") if (model == "rma.ls") { class(res) <- c("rma.ls", "rma.uni", "rma") } else { class(res) <- c("rma.uni", "rma") } return(res) } metafor/R/permutest.rma.uni.r0000644000176200001440000004263214440115230015674 0ustar liggesuserspermutest.rma.uni <- function(x, exact=FALSE, iter=1000, permci=FALSE, progbar=TRUE, digits, control, ...) { mstyle <- .get.mstyle("crayon" %in% .packages()) .chkclass(class(x), must="rma.uni", notav=c("robust.rma", "rma.ls", "rma.gen", "rma.uni.selmodel")) if (missing(digits)) { digits <- .get.digits(xdigits=x$digits, dmiss=TRUE) } else { digits <- .get.digits(digits=digits, xdigits=x$digits, dmiss=FALSE) } ddd <- list(...) .chkdots(ddd, c("tol", "time", "seed", "verbose")) if (!is.null(ddd$tol)) # in case user specifies comptol in the old manner comptol <- ddd$tol iter <- round(iter) if (iter <= 1) stop(mstyle$stop("Argument 'iter' must be >= 2.")) if (.isTRUE(ddd$time)) time.start <- proc.time() ######################################################################### ######################################################################### ######################################################################### ### calculate number of permutations for an exact permutation test if (x$int.only) { ### for intercept-only models, there are 2^k possible permutations of the signs X.exact.iter <- 2^x$k } else { ### for meta-regression models, there are k! possible permutations of the rows of the model matrix #X.exact.iter <- round(exp(lfactorial(x$k))) # note: without round(), not exactly an integer! ### however, when there are duplicated rows in the model matrix, the number of *unique* permutations ### is lower; the code below below determines the number of unique permutations ### order the X matrix X <- as.data.frame(x$X)[do.call(order, as.data.frame(x$X)),] ### determine groupings X.indices <- cumsum(c(TRUE, !duplicated(X)[-1])) ### this turns 1,1,1,2,2,3,4,4,4 into 1,1,1,4,4,6,7,7,7 so that the actual row numbers can be permuted X.indices <- rep(cumsum(rle(X.indices)$lengths) - (rle(X.indices)$lengths - 1), rle(X.indices)$lengths) ### determine exact number of unique permutations ind.table <- table(X.indices) X.exact.iter <- round(prod((max(ind.table)+1):x$k) / prod(factorial(ind.table[-which.max(ind.table)]))) # cancel largest value in numerator and denominator to reduce overflow problems #X.exact.iter <- round(factorial(x$k) / prod(factorial(ind.table))) # definitional formula #X.exact.iter <- round(exp(lfactorial(x$k) - sum(lfactorial(ind.table)))) # using log of definitional formula and then round(exp()) if (is.na(X.exact.iter)) X.exact.iter <- Inf } if (is.character(exact) && exact == "i") return(X.exact.iter) ### if 'exact=TRUE' or if the number of iterations for an exact test are smaller ### than what is specified under 'iter', then carry out the exact test X.exact <- exact X.iter <- iter if (X.exact || (X.exact.iter <= X.iter)) { X.exact <- TRUE X.iter <- X.exact.iter } if (X.iter == Inf) stop(mstyle$stop("Too many iterations required for an exact permutation test.")) ######################################################################### ### generate seed (needed when X.exact=FALSE) if (!X.exact) seed <- as.integer(runif(1)*2e9) ### set control parameters and possibly replace with user-defined values if (missing(control)) control <- list() con <- list(comptol=.Machine$double.eps^0.5, tol=.Machine$double.eps^0.25, maxiter=100, alternative="two.sided", p2defn="abs", stat="test", cialt="one.sided", distfac=1, extendInt="no") con.pos <- pmatch(names(control), names(con)) con[c(na.omit(con.pos))] <- control[!is.na(con.pos)] con$alternative <- match.arg(con$alternative, c("two.sided", "less", "greater")) con$p2defn <- match.arg(con$p2defn, c("abs", "px2")) con$stat <- match.arg(con$stat, c("test", "coef")) if (exists("comptol", inherits=FALSE)) con$comptol <- comptol if (!X.exact) { if (!is.null(ddd$seed)) { set.seed(ddd$seed) } else { set.seed(seed) } } ### elements that need to be returned outlist <- "beta=beta, zval=zval, QM=QM" ######################################################################### if (progbar) cat(mstyle$verbose(paste0("Running ", X.iter, " iterations for an ", ifelse(X.exact, "exact", "approximate"), " permutation test.\n"))) if (x$int.only) { ### permutation test for intercept-only model zval.perm <- try(rep(NA_real_, X.iter), silent=TRUE) if (inherits(zval.perm, "try-error")) stop(mstyle$stop("Number of iterations requested too large.")) beta.perm <- try(rep(NA_real_, X.iter), silent=TRUE) if (inherits(beta.perm, "try-error")) stop(mstyle$stop("Number of iterations requested too large.")) QM.perm <- try(rep(NA_real_, X.iter), silent=TRUE) if (inherits(QM.perm, "try-error")) stop(mstyle$stop("Number of iterations requested too large.")) if (progbar) pbar <- pbapply::startpb(min=0, max=X.iter) if (X.exact) { # exact permutation test for intercept-only models signmat <- as.matrix(expand.grid(replicate(x$k, list(c(1,-1))), KEEP.OUT.ATTRS=FALSE)) for (i in seq_len(X.iter)) { args <- list(yi=signmat[i,]*x$yi, vi=x$vi, weights=x$weights, intercept=TRUE, method=x$method, weighted=x$weighted, test=x$test, level=x$level, btt=1, tau2=ifelse(x$tau2.fix, x$tau2, NA), control=x$control, skipr2=TRUE, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=!isTRUE(ddd$verbose)) if (inherits(res, "try-error")) next beta.perm[i] <- res$beta[,1] zval.perm[i] <- res$zval QM.perm[i] <- res$QM if (progbar) pbapply::setpb(pbar, i) } } else { # approximate permutation test for intercept-only models i <- 1 while (i <= X.iter) { signs <- sample(c(-1,1), x$k, replace=TRUE) # easier to understand (a tad slower for small k, but faster for larger k) #signs <- 2*rbinom(x$k,1,.5)-1 args <- list(yi=signs*x$yi, vi=x$vi, weights=x$weights, intercept=TRUE, method=x$method, weighted=x$weighted, test=x$test, level=x$level, btt=1, tau2=ifelse(x$tau2.fix, x$tau2, NA), control=x$control, skipr2=TRUE, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=!isTRUE(ddd$verbose)) if (inherits(res, "try-error")) next beta.perm[i] <- res$beta[,1] zval.perm[i] <- res$zval QM.perm[i] <- res$QM i <- i + 1 if (progbar) pbapply::setpb(pbar, i) } } ### the first random permutation is always the observed data (avoids possibility of p=0) if (!X.exact) { beta.perm[1] <- x$beta[,1] zval.perm[1] <- x$zval QM.perm[1] <- x$QM } if (con$alternative == "two.sided") { if (con$p2defn == "abs") { ### absolute value definition of the two-sided p-value if (con$stat == "test") { pval <- mean(abs(zval.perm) >= abs(x$zval) - con$comptol, na.rm=TRUE) # based on test statistic } else { pval <- mean(abs(beta.perm) >= abs(c(x$beta)) - con$comptol, na.rm=TRUE) # based on coefficient } } else { ### two times the one-sided p-value definition of the two-sided p-value if (con$stat == "test") { if (x$zval > median(zval.perm, na.rm=TRUE)) { pval <- 2*mean(zval.perm >= x$zval - con$comptol, na.rm=TRUE) # based on test statistic } else { pval <- 2*mean(zval.perm <= x$zval + con$comptol, na.rm=TRUE) } } else { if (c(x$beta) > median(beta.perm, na.rm=TRUE)) { pval <- 2*mean(beta.perm >= c(x$beta) - con$comptol, na.rm=TRUE) # based on coefficient } else { pval <- 2*mean(beta.perm <= c(x$beta) + con$comptol, na.rm=TRUE) } } } } if (con$alternative == "less") { if (con$stat == "test") { pval <- mean(zval.perm <= x$zval + con$comptol, na.rm=TRUE) # based on test statistic } else { pval <- mean(beta.perm <= c(x$beta) + con$comptol, na.rm=TRUE) # based on coefficient } } if (con$alternative == "greater") { if (con$stat == "test") { pval <- mean(zval.perm >= x$zval - con$comptol, na.rm=TRUE) # based on test statistic } else { pval <- mean(beta.perm >= c(x$beta) - con$comptol, na.rm=TRUE) # based on coefficient } } pval[pval > 1] <- 1 QMp <- mean(QM.perm >= x$QM - con$comptol, na.rm=TRUE) ######################################################################### } else { ### permutation test for meta-regression model zval.perm <- try(suppressWarnings(matrix(NA_real_, nrow=X.iter, ncol=x$p)), silent=TRUE) if (inherits(zval.perm, "try-error")) stop(mstyle$stop("Number of iterations requested too large.")) beta.perm <- try(suppressWarnings(matrix(NA_real_, nrow=X.iter, ncol=x$p)), silent=TRUE) if (inherits(beta.perm, "try-error")) stop(mstyle$stop("Number of iterations requested too large.")) QM.perm <- try(rep(NA_real_, X.iter), silent=TRUE) if (inherits(QM.perm, "try-error")) stop(mstyle$stop("Number of iterations requested too large.")) if (progbar) pbar <- pbapply::startpb(min=0, max=X.iter) if (X.exact) { # exact permutation test for meta-regression models #permmat <- .genperms(x$k) permmat <- .genuperms(X.indices) # use recursive algorithm to obtain all unique permutations for (i in seq_len(X.iter)) { args <- list(yi=x$yi, vi=x$vi, weights=x$weights, mods=cbind(X[permmat[i,],]), intercept=FALSE, method=x$method, weighted=x$weighted, test=x$test, level=x$level, btt=x$btt, tau2=ifelse(x$tau2.fix, x$tau2, NA), control=x$control, skipr2=TRUE, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=!isTRUE(ddd$verbose)) if (inherits(res, "try-error")) next beta.perm[i,] <- res$beta[,1] zval.perm[i,] <- res$zval QM.perm[i] <- res$QM if (progbar) pbapply::setpb(pbar, i) } } else { # approximate permutation test for meta-regression models i <- 1 while (i <= X.iter) { args <- list(yi=x$yi, vi=x$vi, weights=x$weights, mods=cbind(X[sample(x$k),]), intercept=FALSE, method=x$method, weighted=x$weighted, test=x$test, level=x$level, btt=x$btt, tau2=ifelse(x$tau2.fix, x$tau2, NA), control=x$control, skipr2=TRUE, outlist=outlist) res <- try(suppressWarnings(.do.call(rma.uni, args)), silent=!isTRUE(ddd$verbose)) if (inherits(res, "try-error")) next beta.perm[i,] <- res$beta[,1] zval.perm[i,] <- res$zval QM.perm[i] <- res$QM i <- i + 1 if (progbar) pbapply::setpb(pbar, i) } } ### the first random permutation is always the observed data (avoids possibility of p=0) if (!X.exact) { beta.perm[1,] <- x$beta[,1] zval.perm[1,] <- x$zval QM.perm[1] <- x$QM } if (con$alternative == "two.sided") { if (con$p2defn == "abs") { ### absolute value definition of the two-sided p-value if (con$stat == "test") { pval <- rowMeans(t(abs(zval.perm)) >= abs(x$zval) - con$comptol, na.rm=TRUE) # based on test statistics } else { pval <- rowMeans(t(abs(beta.perm)) >= abs(c(x$beta)) - con$comptol, na.rm=TRUE) # based on coefficients } } else { ### two times the one-sided p-value definition of the two-sided p-value pval <- rep(NA_real_, x$p) if (con$stat == "test") { for (j in seq_len(x$p)) { if (x$zval[j] > median(zval.perm[,j], na.rm=TRUE)) { pval[j] <- 2*mean(zval.perm[,j] >= x$zval[j] - con$comptol, na.rm=TRUE) } else { pval[j] <- 2*mean(zval.perm[,j] <= x$zval[j] + con$comptol, na.rm=TRUE) } } } else { for (j in seq_len(x$p)) { if (c(x$beta)[j] > median(beta.perm[,j], na.rm=TRUE)) { pval[j] <- 2*mean(beta.perm[,j] >= c(x$beta)[j] - con$comptol, na.rm=TRUE) } else { pval[j] <- 2*mean(beta.perm[,j] <= c(x$beta)[j] + con$comptol, na.rm=TRUE) } } } } } if (con$alternative == "less") { if (con$stat == "test") { pval <- rowMeans(t(zval.perm) <= x$zval + con$comptol, na.rm=TRUE) # based on test statistics } else { pval <- rowMeans(t(beta.perm) <= c(x$beta) + con$comptol, na.rm=TRUE) # based on coefficients } } if (con$alternative == "greater") { if (con$stat == "test") { pval <- rowMeans(t(zval.perm) >= x$zval - con$comptol, na.rm=TRUE) # based on test statistics } else { pval <- rowMeans(t(beta.perm) >= c(x$beta) - con$comptol, na.rm=TRUE) # based on coefficients } } pval[pval > 1] <- 1 QMp <- mean(QM.perm >= x$QM - con$comptol, na.rm=TRUE) } if (progbar) pbapply::closepb(pbar) ######################################################################### ######################################################################### ######################################################################### ### permutation-based CI ci.lb <- x$ci.lb ci.ub <- x$ci.ub if (.isTRUE(permci) || is.numeric(permci)) { level <- .level(x$level) ### check if it is even possible to reject at level if (1/X.iter > level / ifelse(con$cialt == "one.sided", 1, 2)) { permci <- FALSE warning(mstyle$warning(paste0("Cannot obtain ", 100*(1-x$level), "% permutation-based CI; number of permutations (", X.iter, ") too low.")), call.=FALSE) } else { ### if permci is numeric, check if existing coefficients have been specified ### otherwise, CIs will be obtained for all model coefficients if (is.numeric(permci)) { coefs <- unique(round(permci)) if (any(coefs > x$p) || any(coefs < 1)) stop(mstyle$stop("Non-existent coefficients specified via 'permci'.")) permci <- TRUE } else { coefs <- seq_len(x$p) } ci.lb <- rep(NA_real_, x$p) ci.ub <- rep(NA_real_, x$p) for (j in coefs) { if (progbar) cat(mstyle$verbose(paste0("Searching for lower CI bound of coefficient ", j, ": \n"))) if (con$cialt == "one.sided") { con$alternative <- "greater" } else { con$alternative <- "two.sided" } tmp <- try(uniroot(.permci, interval=c(x$ci.lb[j] - con$distfac*(x$beta[j,1] - x$ci.lb[j]), x$beta[j,1]), extendInt=ifelse(con$extendInt == "no", "no", "upX"), tol=con$tol, maxiter=con$maxiter, obj=x, j=j, exact=X.exact, iter=X.iter, progbar=progbar, level=level, digits=digits, control=con)$root, silent=TRUE) if (inherits(tmp, "try-error")) { ci.lb[j] <- NA_real_ } else { ci.lb[j] <- tmp } if (progbar) cat(mstyle$verbose(paste0("Searching for upper CI bound of coefficient ", j, ": \n"))) if (con$cialt == "one.sided") { con$alternative <- "less" } else { con$alternative <- "two.sided" } tmp <- try(uniroot(.permci, interval=c(x$beta[j,1], x$ci.ub[j] + con$distfac*(x$ci.ub[j] - x$beta[j,1])), extendInt=ifelse(con$extendInt == "no", "no", "downX"), tol=con$tol, maxiter=con$maxiter, obj=x, j=j, exact=X.exact, iter=X.iter, progbar=progbar, level=level, digits=digits, control=con)$root, silent=TRUE) if (inherits(tmp, "try-error")) { ci.ub[j] <- NA_real_ } else { ci.ub[j] <- tmp } } } } ######################################################################### out <- list(pval=pval, QMdf=x$QMdf, QMp=QMp, beta=x$beta, se=x$se, zval=x$zval, ci.lb=ci.lb, ci.ub=ci.ub, QM=x$QM, k=x$k, p=x$p, btt=x$btt, m=x$m, test=x$test, dfs=x$dfs, ddf=x$ddf, int.only=x$int.only, int.incl=x$int.incl, digits=digits, exact.iter=X.exact.iter, permci=permci, alternative=con$alternative, p2defn=con$p2defn, stat=con$stat) out$skip.beta <- FALSE out$QM.perm <- QM.perm out$zval.perm <- data.frame(zval.perm) out$beta.perm <- data.frame(beta.perm) names(out$zval.perm) <- names(out$beta.perm) <- colnames(x$X) if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } class(out) <- "permutest.rma.uni" return(out) } metafor/NEWS.md0000644000176200001440000025312014505062034013007 0ustar liggesusers# metafor 4.4-0 (2023-09-27) - added `getmfopt()` and `setmfopt()` functions for getting and setting package options and made some of the options more flexible - removed argument `weighted` from `fsn()` (whether weighted or unweighted averages are used in Orwin's method is now simply determined by whether sampling variances are specified or not); added `type="General"` to `fsn()` as a generalization of the Orwin and Rosenberg methods (that allows for a fail-safe N calculation based on a random-effects model); can now pass an `rma` object to the `fsn()` function - further improved the theming of all plots based on the foreground and background colors; within RStudio, plot colors can also be automatically chosen based on the theme (with `setmfopt(theme="auto")`) - added additional/optional argument `tabfig` to the various `forest()` functions, for easily setting the `annosym` argument to an appropriate vector for exactly aligning numbers (when using a matching font) - added (for now undocumented) `vccon` argument to `rma.mv()` for setting equality constraints on variance/correlation components - `replace` argument in `conv.2x2()`, `conv.delta()`, `conv.fivenum()`, and `conv.wald()` can now also be a logical - added `summary.matreg()` and `print.summary.matreg()` methods for including additional statistics in the output (R^2 and the omnibus test) and added `coef.matreg()` and `vcov.matreg()` extractor functions - formatting functions `fmtp()`, `fmtx()`, and `fmtt()` gain a `quote` argument, which is set to `FALSE` by default - for measures `"PCOR"`, `"ZPCOR"`, `"SPCOR"`, and `"ZSPCOR"`, argument `mi` in `escalc()` now refers to the total number of predictors in the regression models (i.e., also counting the focal predictor of interest) - added measures `"R2"` and "`ZR2"` to `escalc()` - `addpoly.default()` and `addpoly.rma.predict()` gain a `constarea` argument (for the option to draw the polygons with a constant area) - `plot.rma.uni.selmodel()` gains a `shade` argument (for shading the confidence interval region) - `plot.permutest.rma.uni()` gains a `legend` argument - `vcalc()` gains a `sparse` argument - `aggregate.escalc` gains `var.names` argument - made the `legend` argument more flexible in `funnel()` - made the `append` argument more flexible in `to.long()` - added a few more transformation functions - small bug fixes - added automated visual comparison tests of plots - improved the documentation a bit # metafor 4.2-0 (2023-05-08) - improved the various plotting functions so they respect `par("fg")`; as a result, one can now create plots with a dark background and light plotting colors - also allow two or three values for `xlab` in the various `forest()` functions (for adding labels at the ends of the x-axis limits) - better default choices for `xlim` in the various `forest()` functions; also, argument `ilab.xpos` is now optional when using the `ilab` argument - added `shade` and `colshade` arguments to the various `forest()` functions - the various `forest()` functions no longer enforce that `xlim` must be at least as wide as `alim` - added `link` argument to `rma.glmm()` - `rma.glmm()` with `measure="OR", model="CM.EL", method="ML"` now treats tau^2 values below 1e-04 effectively as zero before computing the standard errors of the fixed effects; this helps to avoid numerical problems in approximating the Hessian; similarly, `selmodel()` now treats tau^2 values below 1e-04 or min(vi/10) effectively as zero before computing the standard errors - for measure `SMCC`, can now specify d-values, t-test statistics, and p-values via arguments `di`, `ti`, and `pi` - functions that issue a warning when omitting studies due to NAs now indicate how many were omitted - properly documented the `level` argument - added a few more transformation functions - small bug fixes - improved the documentation a bit # metafor 4.0-0 (2023-03-19) - added `conv.2x2()` function for reconstructing the cell frequencies in 2x2 tables based on other summary statistics - added `conv.wald()` function for converting Wald-type confidence intervals and test statistics to sampling variances - added `conv.fivenum()` function for estimating means and standard deviations from five-number summary values - added `conv.delta()` function for transforming observed effect sizes or outcomes and their sampling variances using the delta method - added `emmprep()` function to create a reference grid for use with the `emmeans()` function from the package of the same name - exposed formatter functions `fmtp()`, `fmtx()`, and `fmtt()` - package `numDeriv` moved from `Suggests` to `Depends` - `model.matrix.rma()` gains `asdf` argument - corrected bug in `vcalc()` (values for `obs` and `type` were taken directly as indices instead of using them as identifiers) - improved efficiency of `vif()` when `sim=TRUE` by reshuffling only the data needed in the model matrix; due to some edge cases, the simulation approach cannot be used when some redundant predictors were dropped from the original model; and when redundancies occur after reshuffling the data, the simulated (G)VIF value(s) are now set to `Inf` instead of `NA` - `selmodel()` gains `type='trunc'` and `type='truncest'` models (the latter should be considered experimental) - added `exact="i"` option in `permutest()` (to just return the number of iterations required for an exact permutation test) - `escalc()` now provides more informative error messages when not specifying all required arguments to compute a particular measure - added measures `"ZPHI"`, `"ZTET"`, `"ZPB"`, `"ZBIS"`, and `"ZSPCOR"` to `escalc()` (but note that Fisher's r-to-z transformation is not a variance-stabilizing transformation for these measures) - the variance of measure `ZPCOR` is now calculated with `1/(ni-mi-3)` (instead of `1/(ni-mi-1)`), which provides a better approximation in small samples (and analogous to how the variance of `ZCOR` is calculated with `1/(ni-3)`) - as with `measure="SMD"`, one can now also use arguments `di` and `ti` to specify d-values and t-test statistics for measures `RPB`, `RBIS`, `D2ORN`, and `D2ORL` in `escalc()` - for measures `COR`, `UCOR`, and `ZCOR`, can now use argument `ti` to specify t-test statistics in `escalc()` - can also specify (two-sided) p-values (of the respective t-tests) for these measures (and for measures `PCOR`, `ZPCOR`, `SPCOR`, and `ZSPCOR`) via argument `pi` (the sign of the p-value is taken to be the sign of the measure) - can also specify (semi-)partial correlations directly via argument `ri` for measures `PCOR`, `ZPCOR`, `SPCOR`, and `ZSPCOR` - when passing a correlation marix to `rcalc()`, it now orders the elements (columnwise) based on the lower triangular part of the matrix, not the upper one (which is more consistent with what `matreg()` expects as input when using the `V` argument) - optimizers `Rcgmin` and `Rvmmin` are now available in `rma.uni()`, `rma.mv()`, `rma.glmm()`, and `selmodel()` - improved the documentation a bit # metafor 3.8-1 (2022-08-26) - `funnel.default()`, `funnel.rma()`, and `regplot.rma()` gain `slab` argument - `vif()` was completely refactored and gains `reestimate`, `sim`, and `parallel` arguments; added `as.data.frame.vif.rma()` and `plot.vif.rma()` methods - `plot.permutest.rma.uni()` function sets the y-axis limits automatically and in a smarter way when also drawing the reference/null distribution and the density estimate - added possibility to specify a list for `btt` in `anova.rma()`; added `print.list.anova.rma()` to print the resulting object - added `as.data.frame.anova.rma()` and `as.data.frame.list.anova.rma()` methods - documented the possibility to use an identity link (with `link="identity"`) in `rma.uni()` when fitting location-scale models (although this will often lead to estimation problems); added `solnp()` as an additional optimizer for this case - optimizers `nloptr` and `constrOptim.nl` (the latter from the `alabama` package) are now available in `rma.uni()` for location-scale models when using an identity link - added measure `SMD1H` to `escalc()` - for `measure="SMD"`, `escalc()` now also allows the user to specify d-values and t-test statistics via arguments `di` and `ti`, respectively - `aggregate.escalc()` gains `addk` argument - added (experimental!) support for measures `"RR"`, `"RD"`, `"PLN"`, and `"PR"` to `rma.glmm()` (but using these measures will often lead to estimation problems) - `replmiss()` gains `data` argument - `cumul()` functions also store data, so that arguments `ilab`, `col`, `pch`, and `psize` in the `forest.cumul.rma()` function can look for variables therein - fixed issue with rendering Rmarkdown documents with `metafor` output due to the use of a zero-width space # metafor 3.4-0 (2022-04-21) - added `misc-models`, `misc-recs`, and `misc-options` help pages - added `as.data.frame.confint.rma()` and `as.data.frame.list.confint.rma` methods - `permutest()` can now also do permutation tests for location-scale models; it also always returns the permutation distributions; hence, argument `retpermdist` was removed - added `plot.permutest.rma.uni()` function to plot the permutation distributions - simplified `regtest()`, `ranktest()`, and `tes()` to single functions instead of using generics and methods; this way, a `data` argument could be added - added `vcalc()` and `blsplit()` functions - `robust()` gains `clubSandwich` argument; if set to `TRUE`, the methods from the `clubSandwich` package (https://cran.r-project.org/package=clubSandwich) are used to obtain the cluster-robust results; `anova.rma()` and `predict.rma()` updated to work appropriately in this case - results from `robust()` are no longer printed with `print.robust.rma()` but with the print methods `print.rma.uni()` and `print.rma.mv()` - `anova.rma()` now gives a warning when running LRTs not based on ML/REML estimation and gains `rhs` argument; it also now has a `refit` argument (to refit REML fits with ML in case the fixed effects of the models differ) - setting `dfs="contain"` in `rma.mv()` automatically sets `test="t"` for convenience - elements of `rho` and `phi` in `rma.mv()` are now based on the lower triangular part of the respective correlation matrix (instead of the upper triangular part) for consistency with other functions; note that this is in principle a backwards incompatible change, although this should only be a concern in very special circumstances - `rma.mv()` gains `cvvc` argument (for calculating the var-cov matrix of the variance/correlation/covariance components) - added measure `"MPORM"` to `escalc()` for computing marginal log odds ratios based on marginal 2x2 tables directly (which requires specification of the correlation coefficients in the paired tables for the calculation of the sampling variances via the `ri` argument) - added measure `"REH"` to `escalc()` for computing the (log transformed) relative excess heterozygosity (to assess deviations from the Hardy-Weinberg equilibrium) - `aggregate.escalc()` gains `checkpd` argument and `struct="CS+CAR"` - `rma.glmm()` now has entire array of optimizers available for `model="CM.EL"` and `measure="OR"`; switched the default from `optim()` with method `BFGS` to `nlminb()` for consistency with `rma.mv()`, `rma.uni()`, and `selmodel.rma.uni()` - `rma.glmm()` gains `coding` and `cor` arguments and hence more flexibility how the group variable should be coded in the random effects structure and whether the random study effects should be allowed to be correlated with the random group effects - `rma.uni()` now also provides R^2 for fixed-effects models - `matreg()` can now also analyze a covariance matrix with a corresponding `V` matrix; can also specify variable names (instead of indices) for arguments `x` and `y` - renamed argument `nearPD` to `nearpd` in `matreg()` (but `nearPD` continues to work) - `plot.profile.rma()` gains `refline` argument - added `addpoly.rma.predict()` method - `addpoly.default()` and `addpoly.rma()` gain `lty` and `annosym` arguments; if unspecified, arguments `annotate`, `digits`, `width`, `transf`, `atransf`, `targs`, `efac`, `fonts`, `cex`, and `annosym` are now automatically set equal to the same values that were used when creating the forest plot - documented `textpos` and `rowadj` arguments for the various `forest` functions and moved the `top` and `annosym` arguments to 'additional arguments' - fixed that `level` argument in `addpoly.rma()` did not affect the CI width - `points.regplot()` function now also redraws the labels (if there were any to begin with) - added `lbfgsb3c`, `subplex`, and `BBoptim` as possible optimizer in `rma.mv()`, `rma.glmm()`, `rma.uni()`, and `selmodel.rma.uni()` - the object returned by model fitting functions now includes the data frame specified via the `data` argument; various method functions now automatically look for specified variables within this data frame first - datasets moved to the `metadat` package (https://cran.r-project.org/package=metadat) - improved the documentation a bit # metafor 3.0-2 (2021-06-09) - the `metafor` package now makes use of the `mathjaxr` package to nicely render equations shown in the HTML help pages - `rma()` can now also fit location-scale models - added `selmodel()` for fitting a wide variety of selection models (and added the corresponding `plot.rma.uni.selmodel()` function for drawing the estimated selection function) - `rma.mv()` gains `dfs` argument and now provides an often better way for calculating the (denominator) degrees of freedom for approximate t- and F-tests when `dfs="contain"` - added `tes()` function for the test of excess significance - added `regplot()` function for drawing scatter plots / bubble plots based on meta-regression models - added `rcalc()` for calculating the variance-covariance matrix of correlation coefficients and `matreg()` for fitting regression models based on correlation/covariance matrices - added convenience functions `dfround()` and `vec2mat()` - added `aggregate.escalc()` function to aggregate multiple effect sizes or outcomes within studies/clusters - `regtest()` now shows the 'limit estimate' of the (average) true effect when using `sei`, `vi`, `ninv`, or `sqrtninv` as predictors (and the model does not contain any other moderators) - `vif()` gains `btt` argument and can now also compute generalized variance inflation factors; a proper `print.vif.rma()` function was also added - `anova.rma()` argument `L` renamed to `X` (the former still works, but is no longer documented) - argument `order` in `cumul()` should now just be a variable, not the order of the variable, to be used for ordering the studies and must be of the same length as the original dataset that was used in the model fitting - similarly, vector arguments in various plotting functions such as `forest.rma()` must now be of the same length as the original dataset that was used in the model fitting (any subsetting and removal of `NA`s is automatically applied) - the various `leave1out()` and `cumul()` functions now provide `I^2` and `H^2` also for fixed-effects models; accordingly, `plot.cumul.rma()` now also works with such models - fixed `level` not getting passed down to the various `cumul()` functions - `plot.cumul.rma()` argument `addgrid` renamed to `grid` (the former still works, but is no longer documented) - `forest.default()`, `forest.rma()`, and `labbe()` gain `plim` argument and now provide more flexibility in terms of the scaling of the points - `forest.rma()` gains `colout` argument (to adjust the color of the observed effect sizes or outcomes) - in the various `forest()` functions, the right header is now suppressed when `annotate=FALSE` and `header=TRUE` - `funnel.default()` and `funnel.rma()` gain `label` and `offset` arguments - `funnel.default()` and `funnel.rma()` gain `lty` argument; the reference line is now drawn by default as a dotted line (like the line for the pseudo confidence region) - the `forest` and `funnel` arguments of `reporter.rma.uni()` can now also be logicals to suppress the drawing of these plots - added `weighted` argument to `fsn()` (for Orwin's method) - added some more transformation functions - `bldiag()` now properly handles ?x0 or 0x? matrices - p-values are still given to 2 digits even when `digits=1` - `summary.escalc()` also provides the p-values (of the Wald-type tests); but when using the `transf` argument, the sampling variances, standard errors, test statistics, and p-values are no longer shown - `rma.uni()` no longer constrains a fixed tau^2 value to 0 when k=1 - slight speedup in functions that repeatedly fit `rma.uni()` models by skipping the computation of the pseudo R^2 statistic - started using the `pbapply` package for showing progress bars, also when using parallel processing - to avoid potential confusion, all references to 'credibility intervals' have been removed from the documentation; these intervals are now exclusively referred to as 'prediction intervals'; in the output, the bounds are therefore indicated now as `pi.lb` and `pi.ub` (instead of `cr.lb` and `cr.ub`); the corresponding argument names were changed in `addpoly.default()`; argument `addcred` was changed to `addpred` in `addpoly.rma()` and `forest.rma()`; however, code using the old arguments names should continue to work - one can now use `weights(..., type="rowsum")` for intercept-only `rma.mv` models (to obtain 'row-sum weights') - `simulate.rma()` gains `olim` argument; renamed the `clim` argument in `summary.escalc()` and the various `forest()` functions to `olim` for consistency (the old `clim` argument should continue to work) - show nicer network graphs for `dat.hasselblad1998` and `dat.senn2013` in the help files - added 24 datasets (`dat.anand1999`, `dat.assink2016`, `dat.baskerville2012`, `dat.bornmann2007`, `dat.cannon2006`, `dat.cohen1981`, `dat.craft2003`, `dat.crede2010`, `dat.dagostino1998`, `dat.damico2009`, `dat.dorn2007`, `dat.hahn2001`, `dat.kalaian1996`, `dat.kearon1998`, `dat.knapp2017`, `dat.landenberger2005`, `dat.lau1992`, `dat.lim2014`, `dat.lopez2019`, `dat.maire2019, `, `dat.moura2021` `dat.obrien2003`, `dat.vanhowe1999`, `dat.viechtbauer2021`) - the package now runs a version check on startup in interactive sessions; setting the environment variable `METAFOR_VERSION_CHECK` to `FALSE` disables this - refactored various functions (for cleaner/simpler code) - improved the documentation a bit # metafor 2.4-0 (2020-03-19) - version jump to 2.4-0 for CRAN release (from now on, even minor numbers for CRAN releases, odd numbers for development versions) - the various `forest()` functions gain `header` argument - `escalc()` gains `include` argument - setting `verbose=3` in model fitting functions sets `options(warn=1)` - `forest.rma()` and `forest.default()` now throw informative errors when misusing `order` and `subset` arguments - fixed failing tests due to the `stringsAsFactors=FALSE` change in the upcoming version of R - `print.infl.rma.uni()` gains `infonly` argument, to only show the influential studies - removed `MASS` from `Suggests` (no longer needed) - argument `btt` can now also take a string to grep for - added `optimParallel` as possible optimizer in `rma.mv()` - added (for now undocumented) option to fit models in `rma.glmm()` via the `GLMMadaptive` package (instead of `lme4`); to try this, use: `control=list(package="GLMMadaptive")` - started to use numbering scheme for devel version (the number after the dash indicates the devel version) - added `contrmat()` function (for creating a matrix that indicates which groups have been compared against each other in each row of a dataset) - added `to.wide()` function (for restructuring long format datasets into the wide format needed for contrast-based analyses) - `I^2` and `H^2` are also shown in output for fixed-effects models - argument `grid` in `baujat()` can now also be a color name - added (for now undocumented) `time` argument to more functions that are computationally expensive - added (for now undocumented) `textpos` argument to the various forest functions - added a new dataset (`dat.graves2010`) - added more tests # metafor 2.1-0 (2019-05-13) - added `formula()` method for objects of class `rma` - `llplot()` now also allows for `measure="GEN"`; also, the documentation and y-axis label have been corrected to indicate that the function plots likelihoods (not log likelihoods) - `confint.rma.mv()` now returns an object of class `list.confint.rma` when obtaining CIs for all variance and correlation components of the model; added corresponding `print.list.confint.rma()` function - moved `tol` argument in `permutest()` to `control` and renamed to `comptol` - added `PMM` and `GENQM` estimators in `rma.uni()` - added `vif()` function to get variance inflation factors - added `.glmulti` object for making the interaction with `glmulti` easier - added `reporter()` and `reporter.rma.uni()` for dynamically generating analysis reports for objects of class `rma.uni` - output is now styled/colored when `crayon` package is loaded (this only works on a 'proper' terminal with color support; also works in RStudio) - overhauled `plot.gosh.rma()`; when `out` is specified, it now shows two distributions, one for the values when the outlier is included and one for the values when for outlier is excluded; dropped the `hcol` argument and added `border` argument - refactored `influence.rma.uni()` to be more consistent internally with other functions; `print.infl.rma.uni()` and `plot.infl.rma.uni()` adjusted accordingly; functions `cooks.distance.rma.uni()`, `dfbetas.rma.uni()`, and `rstudent.rma.uni()` now call `influence.rma.uni()` for the computations - `rstudent.rma.uni()` now computes the SE of the deleted residuals in such a way that it will yield identical results to a mean shift outlier model even when that model is fitted with `test="knha"` - `rstandard.rma.uni()` gains `type` argument, and can now also compute conditional residuals (it still computes marginal residuals by default) - `cooks.distance.rma.mv()` gains `cluster` argument, so that the Cook's distances can be computed for groups of estimates - `cooks.distance.rma.mv()` gains `parallel`, `ncpus`, and `cl` arguments and can now make use of parallel processing - `cooks.distance.rma.mv()` should be faster by using the estimates from the full model as starting values when fitting the models with the ith study/cluster deleted from the dataset - `cooks.distance.rma.mv()` gains `reestimate` argument; when set to `FALSE`, variance/correlation components are not reestimated - `rstandard.rma.mv()` gains `cluster` argument for computing cluster-level multivariate standardized residuals - added `rstudent.rma.mv()` and `dfbetas.rma.mv()` - smarter matching of elements in `newmods` (when using a named vector) in `predict()` that also works for models with interactions (thanks to Nicole Erler for pointing out the problem) - `rma.uni()` and `rma.mv()` no longer issue (obvious) warnings when user constrains `vi` or `V` to 0 (i.e., `vi=0` or `V=0`, respectively) - `rma.mv()` does more intelligent filtering based on `NA`s in `V` matrix - `rma.mv()` now ensures strict symmetry of any (var-cov or correlation) matrices specified via the `R` argument - fixed `rma.mv()` so checks on `R` argument run as intended; also fixed an issue when multiple formulas with slashes are specified via `random` (thanks to Andrew Loignon for pointing out the problem) - suppressed showing calls on some warnings/errors in `rma.mv()` - `rma.mv()` now allows for a continuous-time autoregressive random effects structure (`struct="CAR"`) and various spatial correlation structures (`struct="SPEXP"`, `"SPGAU"`, `"SPLIN"`, `"SPRAT"`, and `"SPSPH"`) - `rma.mv()` now allows for `struct="GEN"` which models correlated random effects for any number of predictors, including continuous ones (i.e., this allows for 'random slopes') - in the various `forest()` functions, when `options(na.action="na.pass")` or `options(na.action="na.exclude")` and an annotation contains `NA`, this is now shown as a blank (instead of `NA [NA, NA]`) - the various `forest()` and `addpoly()` functions gain a `fonts` argument - the various `forest()` functions gain a `top` argument - the various `forest()` functions now show correct point sizes when the weights of the studies are exactly the same - `forest.cumul.rma()` gains a `col` argument - `funnel.default()` and `funnel.rma()` can now take vectors as input for the `col` and `bg` arguments (and also for `pch`); both functions also gain a `legend` argument - `addpoly()` functions can now also show prediction interval bounds - removed 'formula interface' from `escalc()`; until this actually adds some kind of extra functionality, this just makes `escalc()` more confusing to use - `escalc()` can now compute the coefficient of variation ratio and the variability ratio for pre-post or matched designs (`"CVRC"`, `"VRC"`) - `escalc()` does a bit more housekeeping - added (currently undocumented) arguments `onlyo1`, `addyi`, and `addvi` to `escalc()` that allow for more flexibility when computing certain bias corrections and when computing sampling variances for measures that make use of the `add` and `to` arguments - `escalc()` now sets `add=0` for measures where the use of such a bias correction makes little sense; this applies to the following measures: `"AS"`, `"PHI"`, `"RTET"`, `"IRSD"`, `"PAS"`, `"PFT"`, `"IRS"`, and `"IRFT"`; one can still force the use of the bias correction by explicitly setting the `add` argument to some non-zero value - added `clim` argument to `summary.escalc()` - added `ilim` argument to `trimfill()` - `labbe()` gains `lty` argument - `labbe()` now (invisibly) returns a data frame with the coordinates of the points that were drawn (which may be useful for manual labeling of points in the plot) - added a print method for `profile.rma` objects - `profile.rma.mv()` now check whether any of the profiled log-likelihood values is larger than the log-likelihood of the fitted model (using numerical tolerance given by `lltol`) and issues a warning if so - `profile.rma.uni()`, `profile.rma.mv()`, and `plot.profile.rma()` gain `cline` argument; `plot.profile.rma()` gains `xlim`, `ylab`, and `main` arguments - fixed an issue with `robust.rma.mv()` when the model was fitted with `sparse=TRUE` (thanks to Roger Martineau for noting the problem) - various method functions (`fitted()`, `resid()`, `predict()`, etc.) behave in a more consistent manner when model omitted studies with missings - `predict.rma()` gains `vcov` argument; when set to `TRUE`, the variance-covariance matrix of the predicted values is also returned - `vcov.rma()` can now also return the variance-covariance matrix of the fitted values (`type="fitted"`) and the residuals (`type="resid"`) - added `$<-` and `as.matrix()` methods for `list.rma` objects - fixed error in `simulate.rma()` that would generate too many samples for `rma.mv` models - added undocumented argument `time` to all model fitting functions; if set to `TRUE`, the model fitting time is printed - added more tests (also for parallel operations); also, all tests updated to use proper tolerances instead of rounding - reorganized the documentation a bit # metafor 2.0-0 (2017-06-22) - added `simulate()` method for `rma` objects; added `MASS` to `Suggests` (since simulating for `rma.mv` objects requires `mvrnorm()` from `MASS`) - `cooks.distance.rma.mv()` now works properly even when there are missing values in the data - `residuals()` gains `type` argument and can compute Pearson residuals - the `newmods` argument in `predict()` can now be a named vector or a matrix/data frame with column names that get properly matched up with the variables in the model - added `ranef.rma.mv()` for extracting the BLUPs of the random effects for `rma.mv` models - all functions that repeatedly refit models now have the option to show a progress bar - added `ranktest.default()`, so user can now pass the outcomes and corresponding sampling variances directly to the function - added `regtest.default()`, so user can now pass the outcomes and corresponding sampling variances directly to the function - `funnel.default()` gains `subset` argument - `funnel.default()` and `funnel.rma()` gain `col` and `bg` arguments - `plot.profile.rma()` gains `ylab` argument - more consistent handling of `robust.rma` objects - added a print method for `rma.gosh` objects - the (log) relative risk is now called the (log) risk ratio in all help files, plots, code, and comments - `escalc()` can now compute outcome measures based on paired binary data (`"MPRR"`, `"MPOR"`, `"MPRD"`, `"MPORC"`, and `"MPPETO"`) - `escalc()` can now compute (semi-)partial correlation coefficients (`"PCOR"`, `"ZPCOR"`, `"SPCOR"`) - `escalc()` can now compute measures of variability for single groups (`"CVLN"`, `"SDLN"`) and for the difference in variability between two groups (`"CVR"`, `"VR"`); also the log transformed mean (`"MNLN"`) has been added for consistency - `escalc()` can now compute the sampling variance for `measure="PHI"` for studies using stratified sampling (`vtpye="ST"`) - the `[` method for `escalc` objects now properly handles the `ni` and `slab` attributes and does a better job of cleaning out superfluous variable name information - added `rbind()` method for `escalc` objects - added `as.data.frame()` method for `list.rma` objects - added a new dataset (`dat.pagliaro1992`) for another illustration of a network meta-analysis - added a new dataset (`dat.laopaiboon2015`) on the effectiveness of azithromycin for treating lower respiratory tract infections - `rma.uni()` and `rma.mv()` now check if the ratio of the largest to smallest sampling variance is very large; results may not be stable then (and very large ratios typically indicate wrongly coded data) - model fitting functions now check if extra/superfluous arguments are specified via `...` and issues are warning if so - instead of defining own generic `ranef()`, import `ranef()` from `nlme` - improved output formatting - added more tests (but disabled a few tests on CRAN to avoid some issues when R is compiled with `--disable-long-double`) - some general code cleanup - renamed `diagram_metafor.pdf` vignette to just `diagram.pdf` - minor updates in the documentation # metafor 1.9-9 (2016-09-25) - started to use git as version control system, GitHub to host the repository (https://github.com/wviechtb/metafor) for the development version of the package, Travis CI as continuous integration service (https://travis-ci.org/wviechtb/metafor), and Codecov for automated code coverage reporting (https://app.codecov.io/gh/wviechtb/metafor) - argument `knha` in `rma.uni()` and argument `tdist` in `rma.glmm()` and `rma.mv()` are now superseded by argument `test` in all three functions; for backwards compatibility, the `knha` and `tdist` arguments still work, but are no longer documented - `rma(yi, vi, weights=1, test="knha")` now yields the same results as `rma(yi, vi, weighted=FALSE, test="knha")` (but use of the Knapp and Hartung method in the context of an unweighted analysis remains an experimental feature) - one can now pass an `escalc` object directly to `rma.uni()`, which then tries to automatically determine the `yi` and `vi` variables in the data frame (thanks to Christian Roever for the suggestion) - `escalc()` can now also be used to convert a regular data frame to an `escalc` object - for `measure="UCOR"`, the exact bias-correction is now used (instead of the approximation); when `vtype="UB"`, the exact equation is now used to compute the unbiased estimate of the variance of the bias-corrected correlation coefficient; hence `gsl` is now a suggested package (needed to compute the hypergeometric function) and is loaded when required - `cooks.distance()` now also works with `rma.mv` objects; and since model fitting can take some time, an option to show a progress bar has been added - fixed an issue with `robust.rma.mv()` throwing errors when the model was fitted with `sparse=TRUE` - fixed an error with `robust.rma.mv()` when the model was fitted with user-defined weights (or a user-defined weight matrix) - added `ranef()` for extracting the BLUPs of the random effects (only for `rma.uni` objects at the moment) - reverted back to the pre-1.1-0 way of computing p-values for individual coefficients in `permutest.rma.uni()`, that is, the p-value is computed with `mean(abs(z_perm) >= abs(z_obs) - tol)` (where `tol` is a numerical tolerance) - `permutest.rma.uni()` gains `permci` argument, which can be used to obtain permutation-based CIs of the model coefficients (note that this is computationally very demanding and may take a long time to complete) - `rma.glmm()` continues to work even when the saturated model cannot be fitted (although the tests for heterogeneity are not available then) - `rma.glmm()` now allows control over the arguments used for `method.args` (via `control=list(hessianCtrl=list(...))`) passed to `hessian()` (from the `numDeriv` package) when using `model="CM.EL"` and `measure="OR"` - in `rma.glmm()`, default `method.args` value for `r` passed to `hessian()` has been increased to 16 (while this slows things down a bit, this appears to improve the accuracy of the numerical approximation to the Hessian, especially when tau^2 is close to 0) - the various `forest()` and `addpoly()` functions now have a new argument called `width`, which provides manual control over the width of the annotation columns; this is useful when creating complex forest plots with a monospaced font and we want to ensure that all annotations are properly lined up at the decimal point - the annotations created by the various `forest()` and `addpoly()` functions are now a bit more compact by default - more flexible `efac` argument in the various `forest()` functions - trailing zeros in the axis labels are now dropped in forest and funnel plots by default; but trailing zeros can be retained by specifying a numeric (and not an integer) value for the `digits` argument - added `funnel.default()`, which directly takes as input a vector with the observed effect sizes or outcomes and the corresponding sampling variances, standard errors, and/or sample sizes - added `plot.profile.rma()`, a plot method for objects returned by the `profile.rma.uni()` and `profile.rma.mv()` functions - simplified `baujat.rma.uni()`, `baujat.rma.mh()`, and `baujat.rma.peto()` to `baujat.rma()`, which now handles objects of class `rma.uni`, `rma.mh`, and `rma.peto` - `baujat.rma()` gains argument `symbol` for more control over the plotting symbol - `labbe()` gains a `grid` argument - more logical placement of labels in `qqnorm.rma.uni()`, `qqnorm.rma.mh()`, and `qqnorm.rma.peto()` functions (and more control thereof) - `qqnorm.rma.uni()` gains `lty` argument - added `gosh.rma()` and `plot.gosh.rma()` for creating GOSH (i.e., graphical display of study heterogeneity) plots based on Olkin et al. (2012) - in the (rare) case where all observed outcomes are exactly equal to each other, `test="knha"` (i.e., `knha=TRUE`) in `rma()` now leads to more appropriate results - updated datasets so those containing precomputed effect size estimates or observed outcomes are already declared to be `escalc` objects - added new datasets (`dat.egger2001` and `dat.li2007`) on the effectiveness of intravenous magnesium in acute myocardial infarction - `methods` package is now under `Depends` (in addition to `Matrix`), so that `rma.mv(..., sparse=TRUE)` always works, even under Rscript - some general code cleanup - added more tests (and used a more consistent naming scheme for tests) # metafor 1.9-8 (2015-09-28) - due to more stringent package testing, it is increasingly difficult to ensure that the package passes all checks on older versions of R; from now on, the package will therefore require, and be checked under, only the current (and the development) version of R - added `graphics`, `grDevices`, and `methods` to `Imports` (due to recent change in how CRAN checks packages) - the `struct` argument for `rma.mv()` now also allows for `"ID"` and `"DIAG"`, which are identical to the `"CS"` and `"HCS"` structures, but with the correlation parameter fixed to 0 - added `robust()` for (cluster) robust tests and confidence intervals for `rma.uni` and `rma.mv` models (this uses a robust sandwich-type estimator of the variance-covariance matrix of the fixed effects along the lines of the Eicker-Huber-White method) - `confint()` now works for models fitted with the `rma.mv()` function; for variance and correlation parameters, the function provides profile likelihood confidence intervals; the output generated by the `confint()` function has been adjusted in general to make the formatting more consistent across the different model types - for objects of class `rma.mv`, `profile()` now provides profile plots for all (non-fixed) variance and correlation components of the model when no component is specified by the user (via the `sigma2`, `tau2`, `rho`, `gamma2`, or `phi` arguments) - for `measure="MD"` and `measure="ROM"`, one can now choose between `vtype="LS"` (the default) and `vtype="HO"`; the former computes the sampling variances without assuming homoscedasticity, while the latter assumes homoscedasticity - multiple model objects can now be passed to the `fitstats()`, `AIC()`, and `BIC()` functions - check for duplicates in the `slab` argument is now done *after* any subsetting is done (as suggested by Michael Dewey) - `rma.glmm()` now again works when using `add=0`, in which case some of the observed outcomes (e.g., log odds or log odds ratios) may be `NA` - when using `rma.glmm()` with `model="CM.EL"`, the saturated model (used to compute the Wald-type and likelihood ratio tests for the presence of (residual) heterogeneity) often fails to converge; the function now continues to run (instead of stopping with an error) and simply omits the test results from the output - when using `rma.glmm()` with `model="CM.EL"` and inversion of the Hessian fails via the Choleski factorization, the function now makes another attempt via the QR decomposition (even when this works, a warning is issued) - for `rma.glmm()`, BIC and AICc values were switched around; corrected - more use of `suppressWarnings()` is made when functions repeatedly need to fit the same model, such as `cumul()`, `influence()`, and `profile()`; that way, one does not get inundated with the same warning(s) - some (overdue) updates to the documentation # metafor 1.9-7 (2015-05-22) - default optimizer for `rma.mv()` changed to `nlminb()` (instead of `optim()` with `"Nelder-Mead"`); extensive testing indicated that `nlminb()` (and also `optim()` with `"BFGS"`) is typically quicker and more robust; note that this is in principle a non-backwards compatible change, but really a necessary one; and you can always revert to the old behavior with `control=list(optimizer="optim", optmethod="Nelder-Mead")` - all tests have been updated in accordance with the recommended syntax of the `testthat` package; for example, `expect_equivalent(x,y)` is used instead of `test_that(x, is_equivalent_to(y))` - changed a few `is_identical_to()` comparisons to `expect_equivalent()` ones (that failed on Sparc Solaris) # metafor 1.9-6 (2015-05-07) - `funnel()` now works again for `rma.glmm` objects (note to self: quit breaking things that work!) - `rma.glmm()` will now only issue a warning (and not an error) when the Hessian for the saturated model cannot be inverted (which is needed to compute the Wald-type test for heterogeneity, so the test statistic is then simply set to `NA`) - `rma.mv()` now allows for two terms of the form `~ inner | outer`; the variance components corresponding to such a structure are called `gamma2` and correlations are called `phi`; other functions that work with objects of class `rma.mv` have been updated accordingly - `rma.mv()` now provides (even) more optimizer choices: `nlm()` from the `stats` package, `hjk()` and `nmk()` from the `dfoptim` package, and `ucminf()` from the `ucminf` package; choose the desired optimizer via the control argument (e.g., `control=list(optimizer="nlm")`) - `profile.rma.uni()` and `profile.rma.mv()` now can do parallel processing (which is especially relevant for `rma.mv` objects, where profiling is crucial and model fitting can be slow) - the various `confint()` functions now have a `transf` argument (to apply some kind of transformation to the model coefficients and confidence interval bounds); coefficients and bounds for objects of class `rma.mh` and `rma.peto` are no longer automatically transformed - the various `forest()` functions no longer enforce that the actual x-axis limits (`alim`) encompass the observed outcomes to be plotted; also, outcomes below or above the actual x-axis limits are no longer shown - the various `forest()` functions now provide control over the horizontal lines (at the top/bottom) that are automatically added to the plot via the `lty` argument (this also allows for removing them); also, the vertical reference line is now placed *behind* the points/CIs - `forest.default()` now has argument `col` which can be used to specify the color(s) to be used for drawing the study labels, points, CIs, and annotations - the `efac` argument for `forest.rma()` now also allows two values, the first for the arrows and CI limits, the second for summary estimates - corrected some axis labels in various plots when `measure="PLO"` - axes in `labbe()` plots now have `"(Group 1)"` and `"(Group 2)"` added by default - `anova.rma()` gains argument `L` for specifying linear combinations of the coefficients in the model that should be tested to be zero - in case removal of a row of data would lead to one or more inestimable model coefficients, `baujat()`, `cooks.distance()`, `dfbetas()`, `influence()`, and `rstudent()` could fail for `rma.uni` objects; such cases are now handled properly - for models with moderators, the `predict()` function now shows the study labels when they have been specified by the user (and `newmods` is not used) - if there is only one fixed effect (model coefficient) in the model, the `print.infl.rma.uni()` function now shows the DFBETAS values with the other case diagnostics in a single table (for easier inspection); if there is more than one fixed effect, a separate table is still used for the DFBETAS values (with one column for each coefficient) - added `measure="SMCRH"` to the `escalc()` function for the standardized mean change using raw score standardization with heteroscedastic population variances at the two measurement occasions - added `measure="ROMC"` to the `escalc()` function for the (log transformed) ratio of means (response ratio) when the means reflect two measurement occasions (e.g., for a single group of people) and hence are correlated - added own function for computing/estimating the tetrachoric correlation coefficient (for `measure="RTET"`); package therefore no longer suggests `polycor` but now suggest `mvtnorm` (which is loaded as needed) - element `fill` returned by `trimfill.rma.uni()` is now a logical vector (instead of a 0/1 dummy variable) - `print.list.rma()` now also returns the printed results invisibly as a data frame - added a new dataset (`dat.senn2013`) as another illustration of a network meta-analysis - `metafor` now depends on at least version 3.1.0 of R # metafor 1.9-5 (2014-11-24) - moved the `stats` and `Matrix` packages from `Depends` to `Imports`; as a result, had to add `utils` to `Imports`; moved the `Formula` package from `Depends` to `Suggests` - added `update.rma()` function (for updating/refitting a model); model objects also now store and keep the call - the `vcov()` function now also extracts the marginal variance-covariance matrix of the observed effect sizes or outcomes from a fitted model (of class `rma.uni` or `rma.mv`) - `rma.mv()` now makes use of the Cholesky decomposition when there is a `random = ~ inner | outer` formula and `struct="UN"`; this is numerically more stable than the old approach that avoided non-positive definite solutions by forcing the log-likelihood to be -Inf in those cases; the old behavior can be restored with `control = list(cholesky=FALSE)` - `rma.mv()` now requires the `inner` variable in an `~ inner | outer` formula to be a factor or character variable (except when `struct` is `"AR"` or `"HAR"`); use `~ factor(inner) | outer` in case it isn't - `anova.rma.uni()` function changed to `anova.rma()` that works now for both `rma.uni` and `rma.mv` objects - the `profile.rma.mv()` function now omits the number of the variance or correlation component from the plot title and x-axis label when the model only includes one of the respective parameters - `profile()` functions now pass on the `...` argument also to the `title()` function used to create the figure titles (esp. relevant when using the `cex.main` argument) - the `drop00` argument of the `rma.mh()` and `rma.peto()` functions now also accepts a vector with two logicals, the first applies when calculating the observed outcomes, the second when applying the Mantel-Haenszel or Peto's method - `weights.rma.uni()` now shows the correct weights when `weighted=FALSE` - argument `showweight` renamed to `showweights` in the `forest.default()` and `forest.rma()` functions (more consistent with the naming of the various `weights()` functions) - added `model.matrix.rma()` function (to extract the model matrix from objects of class `rma`) - `funnel()` and `radial()` now (invisibly) return data frames with the coordinates of the points that were drawn (may be useful for manual labeling of points in the plots) - `permutest.rma.uni()` function now uses a numerical tolerance when making comparisons (>= or <=) between an observed test statistic and the test statistic under the permuted data; when using random permutations, the function now ensures that the very first permutation correspond to the original data - corrected some missing/redundant row/column labels in some output - most `require()` calls replaced with `requireNamespace()` to avoid altering the search path (hopefully this won't break stuff ...) - some non-visible changes including more use of some (non-exported) helper functions for common tasks - dataset `dat.collins91985a` updated (including all reported outcomes and some more information about the various trials) - oh, and guess what? I updated the documentation ... # metafor 1.9-4 (2014-07-30) - added `method="GENQ"` to `rma.uni()` for the generalized Q-statistic estimator of tau^2, which allows for used-defined weights (note: the DL and HE estimators are just special cases of this method) - when the model was fitted with `method="GENQ"`, then `confint()` will now use the generalized Q-statistic method to construct the corresponding confidence interval for tau^2 (thanks to Dan Jackson for the code); the iterative method used to obtain the CI makes use of Farebrother's algorithm as implemented in the `CompQuadForm` package - slight improvements in how the `rma.uni()` function handles non-positive sampling variances - `rma.uni()`, `rma.mv()`, and `rma.glmm()` now try to detect and remove any redundant predictors before the model fitting; therefore, if there are exact linear relationships among the predictor variables (i.e., perfect multicollinearity), terms are removed to obtain a set of predictors that is no longer perfectly multicollinear (a warning is issued when this happens); note that the order of how the variables are specified in the model formula can influence which terms are removed - the last update introduced an error in how hat values were computed when the model was fitted with the `rma()` function using the Knapp & Hartung method (i.e., when `knha=TRUE`); this has been fixed - `regtest()` no longer works (for now) with `rma.mv` objects (it wasn't meant to in the first place); if you want to run something along the same lines, just consider adding some measure of the precision of the observed outcomes (e.g., their standard errors) as a predictor to the model - added `"sqrtni"` and `"sqrtninv"` as possible options for the `predictor` argument of `regtest()` - more optimizers are now available for the `rma.mv()` function via the `nloptr` package by setting `control = list(optimizer="nloptr")`; when using this optimizer, the default is to use the BOBYQA implementation from that package with a relative convergence criterion of 1e-8 on the function value (see documentation on how to change these defaults) - `predict.rma()` function now works for `rma.mv` objects with multiple tau^2 values even if the user specifies the `newmods` argument but not the `tau2.levels` argument (but a warning is issued and the prediction intervals are not computed) - argument `var.names` now works properly in `escalc()` when the user has not made use of the `data` argument (thanks to Jarrett Byrnes for bringing this to my attention) - added `plot()` function for cumulative random-effects models results as obtained with the `cumul.rma.uni()` function; the plot shows the model estimate on the x-axis and the corresponding tau^2 estimate on the y-axis in the cumulative order of the results - fixed the omitted offset term in the underlying model fitted by the `rma.glmm()` function when `method="ML"`, `measure="IRR"`, and `model="UM.FS"`, that is, when fitting a mixed-effects Poisson regression model with fixed study effects to two-group event count data (thanks to Peter Konings for pointing out this error) - added two new datasets (`dat.bourassa1996`, `dat.riley2003`) - added function `replmiss()` (just a useful helper function) - package now uses `LazyData: TRUE` - some improvements to the documentation (do I still need to mention this every time?) # metafor 1.9-3 (2014-05-05) - some minor tweaks to `rma.uni()` that should be user transparent - `rma.uni()` now has a `weights` argument, allowing the user to specify arbitrary user-defined weights; all functions affected by this have been updated accordingly - better handling of mismatched length of `yi` and `ni` vectors in `rma.uni()` and `rma.mv()` functions - subsetting is now handled as early as possible within functions with subsetting capabilities; this avoids some (rare) cases where studies ultimately excluded by the subsetting could still affect the results - some general tweaks to `rma.mv()` that should make it a bit faster - argument `V` of `rma.mv()` now also accepts a list of var-cov matrices for the observed effects or outcomes; from the list elements, the full (block diagonal) var-cov matrix `V` is then automatically constructed - `rma.mv()` now has a new argument `W` allowing the user to specify arbitrary user-defined weights or an arbitrary weight matrix - `rma.mv()` now has a new argument `sparse`; by setting this to `TRUE`, the function uses sparse matrix objects to the extent possible; this can speed up model fitting substantially for certain models (hence, the `metafor` package now depends on the `Matrix` package) - `rma.mv()` now allows for `struct="AR"` and `struct="HAR"`, to fit models with (heteroscedastic) autoregressive (AR1) structures among the true effects (useful for meta-analyses of studies reporting outcomes at multiple time points) - `rma.mv()` now has a new argument `Rscale` which can be used to control how matrices specified via the `R` argument are scaled (see docs for more details) - `rma.mv()` now only checks for missing values in the rows of the lower triangular part of the `V` matrix (including the diagonal); this way, if `Vi = matrix(c(.5,NA,NA,NA), nrow=2, ncol=2)` is the var-cov matrix of the sampling errors for a particular study with two outcomes, then only the second row/column needs to be removed before the model fitting (and not the entire study) - added five new datasets (`dat.begg1989`, `dat.ishak2007`, `dat.fine1993`, `dat.konstantopoulos2011`, and `dat.hasselblad1998`) to provide further illustrations of the use of the `rma.mv()` function (for meta-analyses combining controlled and uncontrolled studies, for meta-analyses of longitudinal studies, for multilevel meta-analyses, and for network meta-analyses / mixed treatment comparison meta-analyses) - added `rstandard.rma.mv()` function to compute standardized residuals for models fitted with the `rma.mv()` function (`rstudent.rma.mv()` to be added at a later point); also added `hatvalues.rma.mv()` for computing the hat values and `weights.rma.uni()` for computing the weights (i.e., the diagonal elements of the weight matrix) - the various `weights()` functions now have a new argument `type` to indicate whether only the diagonal elements of the weight matrix (default) or the entire weight matrix should be returned - the various `hatvalues()` functions now have a new argument `type` to indicate whether only the diagonal elements of the hat matrix (default) or the entire hat matrix should be returned - `predict.rma()` function now works properly for `rma.mv` objects (also has a new argument `tau2.levels` to specify, where applicable, the levels of the inner factor when computing prediction intervals) - `forest.rma()` function now provides a bit more control over the color of the summary polygon and is now compatible with `rma.mv` objects; also, has a new argument `lty`, which provides more control over the line type for the individual CIs and the prediction interval - `addpoly.default()` and `addpoly.rma()` now have a `border` argument (for consistency with the `forest.rma()` function); `addpoly.rma()` now yields the correct CI bounds when the model was fitted with `knha=TRUE` - `forest.cumul.rma()` now provides the correct CI bounds when the models were fitted with the Knapp & Hartung method (i.e., when `knha=TRUE` in the original `rma()` function call) - the various `forest()` functions now return information about the chosen values for arguments `xlim`, `alim`, `at`, `ylim`, `rows`, `cex`, `cex.lab`, and `cex.axis` invisibly (useful for tweaking the default values); thanks to Michael Dewey for the suggestion - the various `forest()` functions now have a new argument, `clim`, to set limits for the confidence/prediction interval bounds - `cumul.mh()` and `cumul.peto()` now get the order of the studies right when there are missing values in the data - the `transf` argument of `leave1out.rma.mh()`, `leave1out.rma.peto()`, `cumul.rma.mh()`, and `cumul.rma.peto()` should now be used to specify the actual function for the transformation (the former behavior of setting this argument to `TRUE` to exponentiate log RRs, log ORs, or log IRRs still works for back-compatibility); this is more consistent with how the `cumul.rma.uni()` and `leave1out.rma.uni()` functions work and is also more flexible - added `bldiag()` function to construct a block diagonal matrix from (a list of) matrices (may be needed to construct the `V` matrix when using the `rma.mv()` function); `bdiag()` function from the `Matrix` package does the same thing, but creates sparse matrix objects - `profile.rma.mv()` now has a `startmethod` argument; by setting this to `"prev"`, successive model fits are started at the parameter estimates from the previous model fit; this may speed things up a bit; also, the method for automatically choosing the `xlim` values has been changed - slight improvement to `profile.rma.mv()` function, which would throw an error if the last model fit did not converge - added a new dataset (`dat.linde2005`) for replication of the analyses in Viechtbauer (2007) - added a new dataset (`dat.molloy2014`) for illustrating the meta-analysis of (r-to-z transformed) correlation coefficients - added a new dataset (`dat.gibson2002`) to illustrate the combined analysis of standardized mean differences and probit transformed risk differences - computations in `weights.mh()` slightly changed to prevent integer overflows for large counts - unnecessary warnings in `transf.ipft.hm()` are now suppressed (cases that raised those warnings were already handled correctly) - in `predict()`, `blup()`, `cumul()`, and `leave1out()`, when using the `transf` argument, the standard errors (which are `NA`) are no longer shown in the output - argument `slab` in various functions will now also accept non-unique study labels; `make.unique()` is used as needed to make them unique - `vignettes("metafor")` and `vignettes("metafor_diagram")` work again (yes, I know they are not true vignettes in the strict sense, but I think they should show up on the CRAN website for the package and using a minimal valid Sweave document that is recognized by the R build system makes that happen) - `escalc()` and its `summary()` method now keep better track when the data frame contains multiple columns with outcome or effect size values (and corresponding sampling variances) for print formatting; also simplified the class structure a bit (and hence, `print.summary.escalc()` removed) - `summary.escalc()` has a new argument `H0` to specify the value of the outcome under the null hypothesis for computing the test statistics - added measures `"OR2DN"` and `"D2ORN"` to `escalc()` for transforming log odds ratios to standardized mean differences and vice-versa, based on the method of Cox & Snell (1989), which assumes normally distributed response variables within the two groups before the dichotomization - `permutest.rma.uni()` function now catches an error when the number of permutations requested is too large (for R to even create the objects to store the results in) and produces a proper error message - `funnel.rma()` function now allows the `yaxis` argument to be set to `"wi"` so that the actual weights (in %) are placed on the y-axis (useful when arbitrary user-defined have been specified) - for `rma.glmm()`, the control argument `optCtrl` is now used for passing control arguments to all of the optimizers (hence, control arguments `nlminbCtrl` and `minqaCtrl` are now defunct) - `rma.glmm()` should not throw an error anymore when including only a single moderator/predictor in the model - `predict.rma()` now returns an object of class `list.rma` (therefore, function `print.predict.rma()` has been removed) - for `rma.list` objects, added `[`, `head()`, and `tail()` methods - automated testing using the `testthat` package (still many more tests to add, but finally made a start on this) - encoding changed to UTF-8 (to use 'foreign characters' in the docs and to make the HTML help files look a bit nicer) - guess what? some improvements to the documentation! (also combined some of the help files to reduce the size of the manual a bit; and yes, it's still way too big) # metafor 1.9-2 (2013-10-07) - added function `rma.mv()` to fit multivariate/multilevel meta-analytic models via appropriate linear (mixed-effects) models; this function allows for modeling of non-independent sampling errors and/or true effects and can be used for network meta-analyses, meta-analyses accounting for phylogenetic relatedness, and other complicated meta-analytic data structures - added the AICc to the information criteria computed by the various model fitting functions - if the value of tau^2 is fixed by the user via the corresponding argument in `rma.uni()`, then tau^2 is no longer counted as an additional parameter for the computation of the information criteria (i.e., AIC, BIC, and AICc) - `rma.uni()`, `rma.glmm()`, and `rma.mv()` now use a more stringent check whether the model matrix is of full rank - added `profile()` method functions for objects of class `rma.uni` and `rma.mv` (can be used to obtain a plot of the profiled log-likelihood as a function of a specific variance component or correlation parameter of the model) - `predict.rma()` function now has an `intercept` argument that allows the user to decide whether the intercept term should be included when calculating the predicted values (rare that this should be changed from the default) - for `rma.uni()`, `rma.glmm()`, and `rma.mv()`, the `control` argument can now also accept an integer value; values > 1 generate more verbose output about the progress inside of the function - `rma.glmm()` has been updated to work with `lme4` 1.0.x for fitting various models; as a result, `model="UM.RS"` can only use `nAGQ=1` at the moment (hopefully this will change in the future) - the `control` argument of `rma.glmm()` can now be used to pass all desired control arguments to the various functions and optimizers used for the model fitting (admittedly the use of lists within this argument is a bit unwieldy, but much more flexible) - `rma.mh()` and `rma.peto()` also now have a `verbose` argument (not really needed, but added for sake of consistency across functions) - fixed (silly) error that would prevent `rma.glmm()` from running for measures `"IRR"`, `"PLO"`, and `"IRLN"` when there are missing values in the data (lesson: add some missing values to datasets for the unit tests!) - a bit of code reorganization (should be user transparent) - vignettes (`"metafor"` and `"metafor_diagram"`) are now just 'other files' in the doc directory (as these were not true vignettes to begin with) - some improvements to the documentation (as always) # metafor 1.9-1 (2013-07-20) - `rma.mh()` now also implements the Mantel-Haenszel method for incidence rate differences (`measure="IRD"`) - when analyzing incidence rate ratios (`measure="IRR"`) with the `rma.mh()` function, the Mantel-Haenszel test for person-time data is now also provided - `rma.mh()` has a new argument `correct` (default is `TRUE`) to indicate whether the continuity correction should be applied when computing the (Cochran-)Mantel-Haenszel test statistic - renamed elements `CMH` and `CMHp` (for the Cochran-Mantel-Haenszel test statistic and corresponding p-value) to `MH` and `MHp` - added function `baujat()` to create Baujat plots - added a new dataset (`dat.pignon2000`) to illustrate the use of the `baujat()` function - added function `to.table()` to convert data from vector format into the corresponding table format - added function `to.long()` to convert data from vector format into the corresponding long format - `rma.glmm()` now even runs when k=1 (yielding trivial results) - for models with an intercept and moderators, `rma.glmm()` now internally rescales (non-dummy) variables to z-scores during the model fitting (this improves the stability of the model fitting, especially when `model="CM.EL"`); results are given after back-scaling, so this should be transparent to the user - in `rma.glmm()`, default number of quadrature points (`nAGQ`) is now 7 (setting this to 100 was a bit overkill) - a few more error checks here and there for misspecified arguments - some improvements to the documentation # metafor 1.9-0 (2013-06-21) - vignette renamed to `metafor` so `vignette("metafor")` works now - added a diagram to the documentation, showing the various functions in the `metafor` package (and how they relate to each other); can be loaded with `vignette("metafor_diagram")` - `anova.rma.uni()` function can now also be used to test (sub)sets of model coefficients with a Wald-type test when a single model is passed to the function - the pseudo R^2 statistic is now automatically calculated by the `rma.uni()` function and supplied in the output (only for mixed-effects models and when the model includes an intercept, so that the random- effects model is clearly nested within the mixed-effects model) - component `VAF` is now called `R2` in `anova.rma.uni()` function - added function `hc()` that carries out a random-effects model analysis using the method by Henmi and Copas (2010); thanks to Michael Dewey for the suggestion and providing the code - added new dataset (`dat.lee2004`), which was used in the article by Henmi and Copas (2010) to illustrate their method - fixed missing x-axis labels in the `forest()` functions - `rma.glmm()` now computes Hessian matrices via the `numDeriv` package when `model="CM.EL"` and `measure="OR"` (i.e., for the conditional logistic model with exact likelihood); so `numDeriv` is now a suggested package and is loaded within `rma.glmm()` when required - `trimfill.rma.uni()` now also implements the `"Q0"` estimator (although the `"L0"` and `"R0"` estimators are generally to be preferred) - `trimfill.rma.uni()` now also calculates the SE of the estimated number of missing studies and, for estimator `"R0"`, provides a formal test of the null hypothesis that the number of missing studies on a given side is zero - added new dataset (`dat.bangertdrowns2004`) - the `level` argument in various functions now either accepts a value representing a percentage or a proportion (values greater than 1 are assumed to be a percentage) - `summary.escalc()` now computes confidence intervals correctly when using the `transf` argument - computation of Cochran-Mantel-Haenszel statistic in `rma.mh()` changed slightly to avoid integer overflow with very big counts - some internal improvements with respect to object attributes that were getting discarded when subsetting - some general code cleanup - some improvements to the documentation # metafor 1.8-0 (2013-04-11) - added additional clarifications about the change score outcome measures (`"MC"`, `"SMCC"`, and `"SMCR"`) to the help file for the `escalc()` function and changed the code so that `"SMCR"` no longer expects argument `sd2i` to be specified (which is not needed anyways) (thanks to Markus Kösters for bringing this to my attention) - sampling variance for the biserial correlation coefficient (`"RBIS"`) is now calculated in a slightly more accurate way - `llplot()` now properly scales the log-likelihoods - argument `which` in the `plot.infl.rma.uni()` function has been replaced with argument `plotinf` which can now also be set to `FALSE` to suppress plotting of the various case diagnostics altogether - labeling of the axes in `labbe()` plots is now correct for odds ratios (and transformations thereof) - added two new datasets (`dat.nielweise2007` and `dat.nielweise2008`) to illustrate some methods/models from the `rma.glmm()` function - added a new dataset (`dat.yusuf1985`) to illustrate the use of `rma.peto()` - test for heterogeneity is now conducted by the `rma.peto()` function exactly as described by Yusuf et al. (1985) - in `rma.glmm()`, default number of quadrature points (`nAGQ`) is now 100 (which is quite a bit slower, but should provide more than sufficient accuracy in most cases) - the standard errors of the HS and DL estimators of tau^2 are now correctly computed when tau^2 is prespecified by the user in the `rma()` function; in addition, the standard error of the SJ estimator is also now provided when tau^2 is prespecified - `rma.uni()` and `rma.glmm()` now use a better method to check whether the model matrix is of full rank - I^2 and H^2 statistics are now also calculated for mixed-effects models by the `rma.uni()` and `rma.glmm()` function; `confint.rma.uni()` provides the corresponding confidence intervals for `rma.uni` models - various `print()` methods now have a new argument called `signif.stars`, which defaults to `getOption("show.signif.stars")` (which by default is `TRUE`) to determine whether the infamous 'significance stars' should be printed - slight changes in wording in the output produced by the `print.rma.uni()` and `print.rma.glmm()` functions - some improvements to the documentation # metafor 1.7-0 (2013-02-06) - added `rma.glmm()` function for fitting of appropriate generalized linear (mixed-effects) models when analyzing odds ratios, incidence rate ratios, proportions, or rates; the function makes use of the `lme4` and `BiasedUrn` packages; these are now suggested packages and loaded within `rma.glmm()` only when required (this makes for faster loading of the `metafor` package) - added several method functions for objects of class `rma.glmm` (not all methods yet implemented; to be completed in the future) - `rma.uni()` now allows the user to specify a formula for the `yi` argument, so instead of rma(yi, vi, mods=~mod1+mod2), one can specify the same model with rma(yi~mod1+mod2, vi) - `rma.uni()` now has a `weights` argument to specify the inverse of the sampling variances (instead of using the `vi` or `sei` arguments); for now, this is all this argument should be used for (in the future, this argument may potentially be used to allow the user to define alternative weights) - `rma.uni()` now checks whether the model matrix is not of full rank and issues an error accordingly (instead of the rather cryptic error that was issued before) - `rma.uni()` now has a `verbose` argument - `coef.rma()` now returns only the model coefficients (this change was necessary to make the package compatible with the `multcomp` package; see `help(rma)` for an example); use `coef(summary())` to obtain the full table of results - the `escalc()` function now does some more extensive error checking for misspecified data and some unusual cases - `append` argument is now `TRUE` by default in the `escalc()` function - objects generated by the `escalc()` function now have their own class - added `print()` and `summary()` methods for objects of class `escalc` - added `[` and `cbind()` methods for objects of class `escalc` - added a few additional arguments to the `escalc()` function (i.e., `slab`, `subset`, `var.names`, `replace`, `digits`) - added `drop00` argument to the `escalc()`, `rma.uni()`, `rma.mh()`, and `rma.peto()` functions - added `"MN"`, `"MC"`, `"SMCC"`, and `"SMCR"` measures to the `escalc()` and `rma.uni()` functions for the raw mean, the raw mean change, and the standardized mean change (with change score or raw score standardization) as possible outcome measures - the `"IRFT"` measure in the `escalc()` and `rma.uni()` functions is now computed with `1/2*(sqrt(xi/ti) + sqrt(xi/ti+1/ti))` which is more consistent with the definition of the Freeman-Tukey transformation for proportions - added `"RTET"` measure to the `escalc()` and `rma.uni()` functions to compute the tetrachoric correlation coefficient based on 2x2 table data (the `polycor` package is therefore now a suggested package, which is loaded within `escalc()` only when required) - added `"RPB"` and `"RBIS"` measures to the `escalc()` and `rma.uni()` functions to compute the point-biserial and biserial correlation coefficient based on means and standard deviations - added `"PBIT"` and `"OR2D"` measures to the `escalc()` and `rma.uni()` functions to compute the standardized mean difference based on 2x2 table data - added the `"D2OR"` measure to the `escalc()` and `rma.uni()` functions to compute the log odds ratio based on the standardized mean difference - added `"SMDH"` measure to the `escalc()` and `rma.uni()` functions to compute the standardized mean difference without assuming equal population variances - added `"ARAW"`, `"AHW"`, and `"ABT"` measures to the `escalc()` and `rma.uni()` functions for the raw value of Cronbach's alpha, the transformation suggested by Hakstian & Whalen (1976), and the transformation suggested by Bonett (2002) for the meta-analysis of reliability coefficients (see `help(escalc)` for details) - corrected a small mistake in the equation used to compute the sampling variance of the phi coefficient (`measure="PHI"`) in the `escalc()` function - the `permutest.rma.uni()` function now uses an algorithm to find only the unique permutations of the model matrix (which may be much smaller than the total number of permutations), making the exact permutation test feasible in a larger set of circumstances (thanks to John Hodgson for making me aware of this issue and to Hans-Jörg Viechtbauer for coming up with a recursive algorithm for finding the unique permutations) - prediction interval in `forest.rma()` is now indicated with a dotted (instead of a dashed) line; ends of the interval are now marked with vertical bars - completely rewrote the `funnel.rma()` function which now supports many more options for the values to put on the y-axis; `trimfill.rma.uni()` function was adapted accordingly - removed the `ni` argument from the `regtest.rma()` function; instead, sample sizes can now be explicitly specified via the `ni` argument when using the `rma.uni()` function (i.e., when `measure="GEN"`); the `escalc()` function also now adds information on the `ni` values to the resulting data frame (as an attribute of the `yi` variable), so, if possible, this information is passed on to `regtest.rma()` - added switch so that `regtest()` can also provide the full results from the fitted model (thanks to Michael Dewey for the suggestion) - `weights.rma.mh()` now shows the weights in % as intended (thanks to Gavin Stewart for pointing out this error) - more flexible handling of the `digits` argument in the various forest functions - forest functions now use `pretty()` by default to set the x-axis tick locations (`alim` and `at` arguments can still be used for complete control) - studies that are considered to be 'influential' are now marked with an asterisk when printing the results returned by the `influence.rma.uni()` function (see the documentation of this function for details on how such studies are identified) - added additional extractor functions for some of the influence measures (i.e., `cooks.distance()`, `dfbetas()`); unfortunately, the `covratio()` and `dffits()` functions in the `stats` package are not generic; so, to avoid masking, there are currently no extractor functions for these measures - better handling of missing values in some unusual situations - corrected small bug in `fsn()` that would not allow the user to specify the standard errors instead of the sampling variances (thanks to Bernd Weiss for pointing this out) - `plot.infl.rma.uni()` function now allows the user to specify which plots to draw (and the layout) and adds the option to show study labels on the x-axis - added proper `print()` method for objects generated by the `confint.rma.uni()`, `confint.rma.mh()`, and `confint.rma.peto()` functions - when `transf` or `atransf` argument was a monotonically *decreasing* function, then confidence and prediction interval bounds were in reversed order; various functions now check for this and order the bounds correctly - `trimfill.rma.uni()` now only prints information about the number of imputed studies when actually printing the model object - `qqnorm.rma.uni()`, `qqnorm.rma.mh()`, and `qqnorm.rma.peto()` functions now have a new argument called `label`, which allows for labeling of points; the functions also now return (invisibly) the x and y coordinates of the points drawn - `rma.mh()` with `measure="RD"` now computes the standard error of the estimated risk difference based on Sato, Greenland, & Robins (1989), which provides a consistent estimate under both large-stratum and sparse-data limiting models - the restricted maximum likelihood (REML) is now calculated using the full likelihood equation (without leaving out additive constants) - the model deviance is now calculated as -2 times the difference between the model log-likelihood and the log-likelihood under the saturated model (this is a more appropriate definition of the deviance than just taking -2 times the model log-likelihood) - naming scheme of illustrative datasets bundled with the package has been changed; now datasets are called ``; therefore, the datasets are now called (`old name -> new name`): - `dat.bcg -> dat.colditz1994` - `dat.warfarin -> dat.hart1999` - `dat.los -> dat.normand1999` - `dat.co2 -> dat.curtis1998` - `dat.empint -> dat.mcdaniel1994` - but `dat.bcg` has been kept as an alias for `dat.colditz1994`, as it has been referenced under that name in some publications - added new dataset (`dat.pritz1997`) to illustrate the meta-analysis of proportions (raw values and transformations thereof) - added new dataset (`dat.bonett2010`) to illustrate the meta-analysis of Cronbach's alpha values (raw values and transformations thereof) - added new datasets (`dat.hackshaw1998`, `dat.raudenbush1985`) - (approximate) standard error of the tau^2 estimate is now computed and shown for most of the (residual) heterogeneity estimators - added `nobs()` and `df.residual()` methods for objects of class `rma` - `metafor.news()` is now simply a wrapper for `news(package="metafor")` - the package code is now byte-compiled, which yields some modest increases in execution speed - some general code cleanup - the `metafor` package no longer depends on the `nlme` package - some improvements to the documentation # metafor 1.6-0 (2011-04-13) - `trimfill.rma.uni()` now returns a proper object even when the number of missing studies is estimated to be zero - added the (log transformed) ratio of means as a possible outcome measure to the `escalc()` and `rma.uni()` functions (`measure="ROM"`) - added new dataset (`dat.co2`) to illustrate the use of the ratio of means outcome measure - some additional error checking in the various forest functions (especially when using the `ilab` argument) - in `labbe.rma()`, the solid and dashed lines are now drawn behind (and not on top of) the points - slight change to `transf.ipft.hm()` so that missing values in `targs$ni` are ignored - some improvements to the documentation # metafor 1.5-0 (2010-12-16) - the `metafor` package now has its own project website at: https://www.metafor-project.org - added `labbe()` function to create L'Abbe plots - the `forest.default()` and `addpoly.default()` functions now allow the user to directly specify the lower and upper confidence interval bounds (this can be useful when the CI bounds have been calculated with other methods/functions) - added the incidence rate for a single group and for two groups (and transformations thereof) as possible outcome measures to the `escalc()` and `rma.uni()` functions (`measure="IRR"`, `"IRD"`, `"IRSD"`, `"IR"`, `"IRLN"`, `"IRS"`, and `"IRFT"`) - added the incidence rate ratio as a possible outcome measure to the `rma.mh()` function - added transformation functions related to incidence rates - added the Freeman-Tukey double arcsine transformation and its inverse to the transformation functions - added some additional error checking for out-of-range p-values in the `permutest.rma.uni()` function - added some additional checking for out-of-range values in several transformation functions - added `confint()` methods for `rma.mh` and `rma.peto` objects (only for completeness sake; print already provides CIs) - added new datasets (`dat.warfarin`, `dat.los`, `dat.empint`) - some improvements to the documentation # metafor 1.4-0 (2010-07-30) - a paper about the package has now been published in the Journal of Statistical Software (https://www.jstatsoft.org/v36/i03/) - added citation info; see: `citation("metafor")` - the `metafor` package now depends on the `nlme` package - added extractor functions for the AIC, BIC, and deviance - some updates to the documentation # metafor 1.3-0 (2010-06-25) - the `metafor` package now depends on the `Formula` package - made `escalc()` generic and implemented a default and a formula interface - added the (inverse) arcsine transformation to the set of transformation functions # metafor 1.2-0 (2010-05-18) - cases where k is very small (e.g., k equal to 1 or 2) are now handled more gracefully - added sanity check for cases where all observed outcomes are equal to each other (this led to division by zero when using the Knapp & Hartung method) - the "smarter way to set the number of iterations for permutation tests" (see notes for previous version below) now actually works like it is supposed to - the `permutest.rma.uni()` function now provides more sensible results when k is very small; the documentation for the function has also been updated with some notes about the use of permutation tests under those circumstances - made some general improvements to the various forest plot functions making them more flexible in particular when creating more complex displays; most importantly, added a `rows` argument and removed the `addrows` argument - some additional examples have been added to the help files for the forest and addpoly functions to demonstrate how to create more complex displays with these functions - added `showweight` argument to the `forest.default()` and `forest.rma()` functions - `cumul()` functions not showing all of the output columns when using fixed-effects models has been corrected - `weights.rma.uni()` function now handles `NA`s appropriately - `weights.rma.mh()` and `weights.rma.peto()` functions added - `logLik.rma()` function now behaves more like other `logLik()` functions (such as `logLik.lm()` and `logLik.lme()`) # metafor 1.1-0 (2010-04-28) - `cint()` generic removed and replaced with `confint()` method for objects of class `rma.uni` - slightly improved the code to set the x-axis title in the `forest()` and `funnel()` functions - added `coef()` method for `permutest.rma.uni` objects - added `append` argument to `escalc()` function - implemented a smarter way to set the number of iterations for permutation tests (i.e., the `permutest.rma.uni()` function will now switch to an exact test if the number of iterations required for an exact test is actually smaller than the requested number of iterations for an approximate test) - changed the way how p-values for individual coefficients are calculated in `permutest.rma.uni()` to 'two times the one-tailed area under the permutation distribution' (more consistent with the way we typically define two-tailed p-values) - added `retpermdist` argument to `permutest.rma.uni()` to return the permutation distributions of the test statistics - slight improvements to the various transformation functions to cope better with some extreme cases - p-values are now calculated in such a way that very small p-values stored in fitted model objects are no longer truncated to 0 (the printed results are still truncated depending on the number of digits specified) - changed the default number of iterations for the ML, REML, and EB estimators from 50 to 100 # metafor 1.0-1 (2010-02-02) - version jump in conjunction with the upcoming publication of a paper in the Journal of Statistical Software describing the `metafor` package - instead of specifying a model matrix, the user can now specify a model formula for the `mods` argument in the `rma()` function (e.g., like in the `lm()` function) - `permutest()` function now allows exact permutation tests (but this is only feasible when k is not too large) - `forest()` function now uses the `level` argument properly to adjust the CI level of the summary estimate for models without moderators (i.e., for fixed- and random-effets models) - `forest()` function can now also show the prediction interval as a dashed line for a random-effects model - information about the measure used is now passed on to the `forest()` and `funnel()` functions, which try to set an appropriate x-axis title accordingly - `funnel()` function now has more arguments (e.g., `atransf`, `at`) providing more control over the display of the x-axis - `predict()` function now has its own `print()` method and has a new argument called `addx`, which adds the values of the moderator variables to the returned object (when `addx=TRUE`) - functions now properly handle the `na.action` `"na.pass"` (treated essentially like `"na.exclude"`) - added method for `weights()` to extract the weights used when fitting models with `rma.uni()` - some small improvements to the documentation # metafor 0.5-7 (2009-12-06) - added `permutest()` function for permutation tests - added `metafor.news()` function to display the `NEWS` file of the `metafor` package within R (based on same idea in the `animate` package by Yihui Xie) - added some checks for values below machine precision - a bit of code reorganization (nothing that affects how the functions work) # metafor 0.5-6 (2009-10-19) - small changes to the computation of the DFFITS and DFBETAS values in the `influence()` function, so that these statistics are more in line with their definitions in regular linear regression models - added option to the plot function for objects returned by `influence()` to allow plotting the covariance ratios on a log scale (now the default) - slight adjustments to various `print()` functions (to catch some errors when certain values were `NA`) - added a control option to `rma()` to adjust the step length of the Fisher scoring algorithm by a constant factor (this may be useful when the algorithm does not converge) # metafor 0.5-5 (2009-10-08) - added the phi coefficient (`measure="PHI"`), Yule's Q (`"YUQ"`), and Yule's Y (`"YUY"`) as additional measures to the `escalc()` function for 2x2 table data - forest plots now order the studies so that the first study is at the top of the plot and the last study at the bottom (the order can still be set with the `order` or `subset` argument) - added `cumul()` function for cumulative meta-analyses (with a corresponding `forest()` method to plot the cumulative results) - added `leave1out()` function for leave-one-out diagnostics - added option to `qqnorm.rma.uni()` so that the user can choose whether to apply the Bonferroni correction to the bounds of the pseudo confidence envelope - some internal changes to the class and methods names - some small corrections to the documentation # metafor 0.5-4 (2009-09-18) - corrected the `trimfill()` function - improvements to various print functions - added a `regtest()` function for various regression tests of funnel plot asymmetry (e.g., Egger's regression test) - made `ranktest()` generic and added a method for objects of class `rma` so that the test can be carried out after fitting - added `anova()` function for full vs reduced model comparisons via fit statistics and likelihood ratio tests - added the Orwin and Rosenberg approaches to `fsn()` - added H^2 measure to the output for random-effects models - in `escalc()`, `measure="COR"` is now used for the (usual) raw correlation coefficient and `measure="UCOR"` for the bias corrected correlation coefficients - some small corrections to the documentation # metafor 0.5-3 (2009-07-31) - small changes to some of the examples - added the log transformed proportion (`measure="PLN"`) as another measure to the `escalc()` function; changed `"PL"` to `"PLO"` for the logit (i.e., log odds) transformation for proportions # metafor 0.5-2 (2009-07-06) - added an option in `plot.infl.rma.uni()` to open a new device for plotting the DFBETAS values - thanks to Jim Lemon, added a much better method for adjusting the size of the labels, annotations, and symbols in the `forest()` function when the number of studies is large # metafor 0.5-1 (2009-06-14) - made some small changes to the documentation (some typos corrected, some confusing points clarified) # metafor 0.5-0 (2009-06-05) - first version released on CRAN metafor/MD50000644000176200001440000006144414505073402012230 0ustar liggesusersa7f7c8f4344362d02630c98c81f3a402 *DESCRIPTION d41f878a1a2302936503d322cea9f91a *NAMESPACE bb376506b75c23800bc0b68ac6de1622 *NEWS.md 24db85dd05c8e7120c6ac0f0308bb1f5 *R/AIC.rma.r 7a4e9b442e8435829bda5c163d6d0eff *R/BIC.rma.r db7a23373954826777af3479d30ae1a1 *R/addpoly.default.r 6b69403c8e93f1446d313b7afdaba903 *R/addpoly.predict.rma.r f74a85ebb8b2bc60c9e4fe43b2c182ee *R/addpoly.r ec244a750631eda5c56be7ebe98f62c0 *R/addpoly.rma.r 374c579c2d480cfd8cec4f8bd73f32cc *R/aggregate.escalc.r 66f10abb73507e62e99869be2739f190 *R/anova.rma.r 9b7c6d4219b7239aeb940a93f9b9f3ff *R/baujat.r 64e59b7cb68f3f36d041c381bf42df07 *R/baujat.rma.r 334514c78c041e8e6ecf4cee83b2b4bb *R/bldiag.r ae57b2f779d0a6774d872b984016d39b *R/blsplit.r 30b9c7c5d4eaab44326f97bd3d2776af *R/blup.r ae562387db23f7c795fb31938f3c6115 *R/blup.rma.uni.r eebf4ce6637cab16cb601c4be8d209f9 *R/coef.matreg.r 63c4e6e0e79a101e05213c89ffc5d116 *R/coef.permutest.rma.uni.r 74c0c2052e329404a35f6383d02af9f8 *R/coef.rma.r 806ecd236fd10a3b63173571b0db681c *R/coef.summary.rma.r a05604a0e6097b9faacd69c341e3a5f9 *R/confint.rma.glmm.r 77cef219911fdb89039115144858f6c3 *R/confint.rma.ls.r 4da1754a7d66f9813645e2661e5abb97 *R/confint.rma.mh.r 5b379601a823fa2f513b1d77bc2da4f9 *R/confint.rma.mv.r 973a09c1d251e7ccef2909b9fd509a25 *R/confint.rma.peto.r 059cc83f2b8964025a14af2db73f51b8 *R/confint.rma.uni.r 25cff0301ae440df9b36c72e3ee4f63e *R/confint.rma.uni.selmodel.r b70459de134dc5ea247f59042bb72e6c *R/contrmat.r 25ee3845f8c9e4d0cbde9f46c7a34214 *R/conv.2x2.r e001250ef7573f7ee4b7456478ad44bd *R/conv.delta.r 62c34fb99f636d8f73c9ff2bacf08d46 *R/conv.fivenum.r e7ef2a4b556ce27b1989e474b595bad6 *R/conv.wald.r 2e280732cca4ebd28b8f531fb9062768 *R/cooks.distance.rma.mv.r 3e67396d29e02b21bd712216e6964794 *R/cooks.distance.rma.uni.r eab5a85465f21f2dc9a58055ba597d10 *R/cumul.r 64b58e42db3ec666839011eb217b1e09 *R/cumul.rma.mh.r 60cd6fbbc0a118bbe93f511dd6490830 *R/cumul.rma.peto.r d35b821291355bc11c942ab082de1341 *R/cumul.rma.uni.r 9ccec440d7453d2d0571a65e6ca68194 *R/deviance.rma.r 377b151eee408e788262f0082a471d40 *R/df.residual.rma.r f0cc2b7605326407e3407b1d9eb75a2f *R/dfbetas.rma.mv.r be52077ac7b9873d44c4594a0759610d *R/dfbetas.rma.uni.r 97aca658300e35287a8aba2a28d5e527 *R/dfround.r fe8447a54d2e984cb7758ab2a5e2ab20 *R/emmprep.r af72adccdd8c45971d1694eb525d2f4a *R/escalc.r 23c9fbb02e78031973d913c70aae0b10 *R/fitstats.r 6f1a43f62eb0f8b8e0d510463efa9ac2 *R/fitstats.rma.r 4340c1cf21174422475a069867d09b70 *R/fitted.rma.r d2ea69f49f44a340d671dbab95d977cf *R/forest.cumul.rma.r 84bc89bfe23d1888c687651e0c29fa4b *R/forest.default.r f5148247e2bb84f6c3cd524c72cd06c6 *R/forest.r 808b5951eb441615b56ac8a11a7d432b *R/forest.rma.r b18368e9e713b8fdc3a8e6da8337db39 *R/formatters.r 6d8d5aaf14c77664a30f297142570573 *R/formula.rma.r bacd271d5f6072d4717407b5b42a2e15 *R/fsn.r ec7ac30e645e49ca6380e34a3ec9d3a2 *R/funnel.default.r d1cbb7d3ab050ed099679e78af50aaaa *R/funnel.r 699e09a4a2bbdf05c75343bb14ab5950 *R/funnel.rma.r 2573a8e03e9331881bef8089ac03af1d *R/gosh.r 38658e6c1d96d650a4fff81c90257592 *R/gosh.rma.r 7825ee9e5f1b4764d1c1ee2658bb3822 *R/hatvalues.rma.mv.r 8a9bf46cbb4d48eb5f4433c67f97665e *R/hatvalues.rma.uni.r 41d410d818a21e7bbcb798cecc8b57d2 *R/hc.r a9190522e8a941de379487bf54bc947a *R/hc.rma.uni.r 9edc1951c25cab63d3183a486b24564b *R/influence.rma.uni.r 79a9a5487b16c86b53c7c221028ad2f4 *R/labbe.r 7360e93dbaeaa441d35c8b91ca32c82d *R/labbe.rma.r e9309f3a06c035f07723140e4e29952e *R/leave1out.r cbc3a1f5e87659896f53e48f2bed53e5 *R/leave1out.rma.mh.r 750c262e970ce893e9a103654cccd736 *R/leave1out.rma.peto.r 0d9597cd97d210fc7d41b5893b0e8cea *R/leave1out.rma.uni.r fae9bb490ef57accf0a84afa7d06bae8 *R/llplot.r f314c6db04861b26fa116193447c4e0f *R/logLik.rma.r cbc80f4e6269e0614347ec11cb928e2b *R/matreg.r 072c5707ff325600d0763dd1d40262b2 *R/metafor.news.r c71bda52ead1738943724a190eb25680 *R/methods.anova.rma.r 9be987717774cfd27c973cb6d596ecba *R/methods.confint.rma.r 0d2ba5ee1eb8538d3f0faa49f1084712 *R/methods.escalc.r 5460406eb08377edc03886254f032a34 *R/methods.list.rma.r ea059b12928048bbae8eb19bb62d45c8 *R/methods.vif.rma.r ebd7006c372e1409d0811b83a2c1feb8 *R/mfopt.r c17359cf8a5998de97f683c2e4ae5a32 *R/misc.func.hidden.escalc.r e27bc28eac3965815f8d055c46df36ef *R/misc.func.hidden.evals.r ac59129053397447547b490c4920fa70 *R/misc.func.hidden.fsn.r cf3a3d698206720d63df6f3eabc1fafe *R/misc.func.hidden.funnel.r 8986485f0b3aea8254c0c20b04b37982 *R/misc.func.hidden.glmm.r c916911eaf24e7768dbf8041c4dbb494 *R/misc.func.hidden.mv.r 647b90bd7cee4cf94e84bf2ed1e36b67 *R/misc.func.hidden.profile.r 444286caf580f2d42fdd57e60d1aa7cc *R/misc.func.hidden.r b4d2848aa84fe265ef90f6f864b02ba0 *R/misc.func.hidden.selmodel.r 480d42f955c1b6bd896eaee0c2ef89a2 *R/misc.func.hidden.tes.r e3d829f02e8a01bae40da594f48f3e8c *R/misc.func.hidden.uni.r e5e285cd17f50971c0db507ecf38b153 *R/misc.func.hidden.vif.r cd80ce3700016fb46adb10c48470d60e *R/model.matrix.rma.r 6c444e7b706b46a7d4836920a0d058f4 *R/nobs.rma.r 3376538a20fd1ea72c6cc0c76abff14c *R/permutest.r f34b1286d93cfb0d28fd2bfd779cda47 *R/permutest.rma.ls.r 41013b28088d7f06a30a4606e8972f7f *R/permutest.rma.uni.r dea2d67b93edbaf5e4c400f95067cc48 *R/plot.cumul.rma.r acb77580d36b8b4538ad37d58b6d6f78 *R/plot.gosh.rma.r 6a04679673a23b3f6f5d53386afcc645 *R/plot.infl.rma.uni.r 62a64d3a807ee8e607dde9416c6e2d53 *R/plot.permutest.rma.uni.r 119d76c9a35e3fb5f09cf7ba60980a27 *R/plot.profile.rma.r 4157c16ae5f6ba991a68e83cab89b114 *R/plot.rma.glmm.r 638464cacdff5cba7f39b90fa9e68a0d *R/plot.rma.mh.r baab5ff76cf9af7d13b9934764bd18a2 *R/plot.rma.peto.r ed06b5b170485bd526a93364aa41b8df *R/plot.rma.uni.r 60edacfda85d51b301afc34b0a9505f6 *R/plot.rma.uni.selmodel.r e05f05f96759316d47119b54e0db9409 *R/plot.vif.rma.r 8c7ad88f5a5faaf22e8388d4c8308694 *R/points.regplot.r a8a31b6529ec8e9b242185dc8d09a1f6 *R/predict.rma.ls.r a017dbc5fdce01906a34e705771aaf20 *R/predict.rma.r aebf427662f5aed4230eecb158b3dd43 *R/print.anova.rma.r 465f7099666b172de2fba181bae0473d *R/print.confint.rma.r 9637d3288a440f92e8b3fc4eefc818da *R/print.escalc.r 63531ccd7644697677f01a1b46217d70 *R/print.fsn.r 3093359827c4b7189df6eccff9ff98ce *R/print.gosh.rma.r 5762740d39e23e3c9a72ff3b6aaefb8b *R/print.hc.rma.uni.r 18c3888f3ae7d7df2f9f03beea690854 *R/print.infl.rma.uni.r 5ca3e6bb243a5619d4b106d6dcf33840 *R/print.list.anova.rma.r 10f12b37c1b94b753aeeb6d48755d97b *R/print.list.confint.rma.r 7d51a7466a38e99892e1501f18ab6227 *R/print.list.rma.r e5f0b04d0244ebcadec18f4a40679765 *R/print.matreg.r b545b8fd3b4d1b946d7169b6e06399a4 *R/print.permutest.rma.uni.r 2a0a4ae76cc6258a4b0daa03054e21cf *R/print.profile.rma.r c5775a31e3dbfc4088a9eb0d40e31047 *R/print.ranktest.r 7df296979b738baaa74bc541fb6191c0 *R/print.regtest.r 2484b6c71a377266565e1eb3f6276a0e *R/print.rma.glmm.r 9f35eed42004b2650934bb1c9581ba6e *R/print.rma.mh.r 75c329837a92d7f0166b94570777749e *R/print.rma.mv.r 2d7d7433dc6f77742dfe8f773e22beb2 *R/print.rma.peto.r d811b845a8bedb94eb46c2a8e2ab0da7 *R/print.rma.uni.r 7dfbaa3fc9337ca5731b870401d823c1 *R/print.summary.matreg.r 11c3d363143a25342282937096a04094 *R/print.summary.rma.r 0fadf7495e86f4b7ea2f6429f0ae2793 *R/print.tes.r fab0e462b6bb93fc3aba4e11431beee3 *R/print.vif.rma.r b8ed6a641acc7f90b30799b083297f93 *R/profile.rma.ls.r fb9e41c4915c959164f4bd8b0e991a9d *R/profile.rma.mv.r 289023a891bc2d21a775caf227335476 *R/profile.rma.uni.r f8da9d20cf9104f81c48557e1529eb99 *R/profile.rma.uni.selmodel.r b21968963ade773ffc54aeb10a96cda4 *R/qqnorm.rma.glmm.r 26a927ff97fb3f1015688ba08b5d332c *R/qqnorm.rma.mh.r 550fb927d4cf60fa8359559a9fc9a5bf *R/qqnorm.rma.mv.r 315b2fd731a2424d92dab2626ad3d828 *R/qqnorm.rma.peto.r 163dfa9575fd5f9785d8e9abbbffa668 *R/qqnorm.rma.uni.r 708901230afb921438232ae1dae2f5de *R/radial.r cab578106337e1a7da41ce1ba4aeccdf *R/radial.rma.r 01407207a4d2d999c2c8c251dac91a0e *R/ranef.rma.mv.r a0926c13bea1b921a1f174dfd43767e3 *R/ranef.rma.uni.r c849998c59e88348b98380914c3e0095 *R/ranktest.r 897442ae5913530f22c0cb9fd8dcc0af *R/rcalc.r 48adb556610afbd0ac47307d9346e443 *R/regplot.r e039ae07392e147c543593da967dbdb9 *R/regplot.rma.r 20be5eda5d752b571f64ed37c3f3f989 *R/regtest.r a9b74fda41d448daeeb4c1eaf0b9a186 *R/replmiss.r 91777063e31189d96863dc3a8c9de213 *R/reporter.r a37eac1edde5c96aa1b0bb0c5b7ed19a *R/reporter.rma.uni.r 2705c431f7da171641640e0d432ff01d *R/residuals.rma.r 9585f9a03c112d8cd3b03ad242de2f60 *R/rma.glmm.r 6862d9adbf638c39b4ad2bec9d9ca006 *R/rma.mh.r c921e45e3dc96fd4d9d5e972f0c8fbb6 *R/rma.mv.r db7612635da6d4bdaa9e3d4b21b78f93 *R/rma.peto.r ab60f1ec3d50a2e80ad62433e30b3204 *R/rma.uni.r c7549400ef048f329f3bc18433c9a32a *R/robust.r 89dfbc905ee72b5c6dd088826ca608b6 *R/robust.rma.mv.r bb4742fee93f532ebfc8ab2bf3fe3d8d *R/robust.rma.uni.r 76b26904f1cd31186b2284d94cebb190 *R/rstandard.rma.mh.r 6169894ce6cf71a34488a4b70d205c66 *R/rstandard.rma.mv.r 35e85f6e717a9c3abe516ae96b3e1add *R/rstandard.rma.peto.r e76ef3983e980a5cd303248eb1032a0a *R/rstandard.rma.uni.r 8a7eca519a8091a568193ba0f83e41b6 *R/rstudent.rma.mh.r ecc545faaa404c48104a5cab6cdc0f6f *R/rstudent.rma.mv.r 3fbc8fb29a7aa1b2a8fb6125df5a3cac *R/rstudent.rma.peto.r 07a1ef1722a6eab8f6522afd21ff9ac4 *R/rstudent.rma.uni.r d31b9a1f07c093dac4a38e92edb83040 *R/selmodel.r f63f90ae4723c80e297200f6efd1ec35 *R/selmodel.rma.uni.r 5e566c5877d82f429d68bd2c4eccbf8a *R/simulate.rma.r a5c0fdd60498db1f4915759892e6e8e0 *R/summary.escalc.r c56e8a3c486c94b8b6f94eb83dd25f25 *R/summary.matreg.r 9b6b3d46d660c5af595b7f921dab3e37 *R/summary.rma.r 23eea97808ff7a585d9a42c7ac823a43 *R/tes.r 200068df08e6aae0a0b9124ecdb56434 *R/to.long.r b97fd9215a2aab992522db50f48e2a34 *R/to.table.r d81ae46e8e68158600e3975d7597537d *R/to.wide.r e063bcb1e08fa45d01ab304d30c010e9 *R/transf.r 362bf474245dd51425ef3b345f298778 *R/trimfill.r f852b9aa86440f750d986e3e208b77fe *R/trimfill.rma.uni.r 41fb86d80459202fae71d533a4ee7343 *R/update.rma.r 60344b469c831e98c0ff5196f5f13de2 *R/vcalc.r 0030b43015ee35407634828ef8b7eedd *R/vcov.matreg.r 3bdc0faff2a74c9f37958dcb0a1bb7a1 *R/vcov.rma.r 2851e6101f925cf769dbe9615f8ca624 *R/vec2mat.r 728fdc925021f89708a4031cb4f0b5d1 *R/vif.r b8a0a9eebc3a8378a4c54ca6f1ef9960 *R/vif.rma.r 0de86d84a752b52051992c19e006b068 *R/weights.rma.glmm.r 7dce0258983b59da0cf907b74015b884 *R/weights.rma.mh.r 9e663d706d1097266263a226ae0f0f31 *R/weights.rma.mv.r 104cdbff08bc93fdc0855af3d7a33a30 *R/weights.rma.peto.r 7dec38b41033e8b9b575ead6e5d5bef1 *R/weights.rma.uni.r 61d4027bd166c3b713846be0f8297954 *R/zzz.r 8a76bc44ab560b65f33e6ee168f3322a *README.md c4b1cf80edf0068c65279d1bf12ff3d3 *build/metafor.pdf a822bd00c91778c7133a5640d02e8976 *build/stage23.rdb f5fa564eba926b1cd8b50bc6a6b2bcef *build/vignette.rds cf049154d8986ccb436dfd244bfb7994 *inst/CITATION a51ea3b42f56cc765988747d2a880be0 *inst/doc/diagram.pdf b438c769739c3d868cfd5766f72f7c2c *inst/doc/diagram.pdf.asis ab15425ad7959e47c27b548d9a427fa3 *inst/doc/metafor.pdf b22e3397f4cea09c48a2c785ff0cae6a *inst/doc/metafor.pdf.asis 674a1e37b84b08e97e1ab7a866d71189 *inst/reporter/apa.csl a465957700e1a9f1922183ed0ea7adba *inst/reporter/references.bib 31e3f3cf074667fc82591cb68c3bb9f9 *man/addpoly.Rd ec80a66197ea60245d1f4197baab2ec0 *man/addpoly.default.Rd 404a8c855e23dc388781f639ff92de92 *man/addpoly.predict.rma.Rd a71d030dd2722992f6d783849bd7b56f *man/addpoly.rma.Rd f5a1629af3abac8684b214f3f1ae37f6 *man/aggregate.escalc.Rd e9ee92883359ce4fa099f401a48778ef *man/anova.rma.Rd 24e7b5684d969bb3d760a3964b41cd27 *man/baujat.Rd 38f5eaf996bccd271dc134f1f5b7b2e1 *man/bldiag.Rd 08a1f1212e6d2da799b8ba23e85182ac *man/blsplit.Rd ce97b1a839a326616703b290badd4607 *man/blup.Rd b29a3e3b3e60a5ace2d4941028add6e6 *man/coef.permutest.rma.uni.Rd 225fb5ea12c19131785ab7c0f586c0a2 *man/coef.rma.Rd 452e83511022258ac396d35577b182f2 *man/confint.rma.Rd a2c4d9f0d40d2d9fbba53c5b3c9faaac *man/contrmat.Rd 228ca273877cb323327c19f1d632f094 *man/conv.2x2.Rd 30c24db0dce26cc1c615a12db790a5be *man/conv.delta.Rd f2db79cce2ccea8458dc118ae3b65484 *man/conv.fivenum.Rd 2bfd4b7b34b85acdec071c1bd6412fb3 *man/conv.wald.Rd 72bdb1e9672621e64cc25c3283ad5fb7 *man/cumul.Rd 388f141ffdd0cd201a7aae3bb9fadce8 *man/dfround.Rd 6989748e9e501a011ab80eb516279a5f *man/emmprep.Rd 099eb4d32b5ff6e5063e1a4a865bc25d *man/escalc.Rd f4ecbc3e59130a72054fc9d9af4ca276 *man/figures/crayon1.png f1588a41de5489b7ad30492939ce6722 *man/figures/crayon2.png 84fe447358193ac37a47d07a9423b716 *man/figures/ex_bubble_plot.png 678e9886d9b768bc5b9c931fa34cd4b1 *man/figures/ex_forest_plot.png 2c33e137ba318b677154c0850dd9d843 *man/figures/ex_funnel_plot.png 86f85cafb00491a5d7f65d321182cd7a *man/figures/forest-arrangement.pdf 96b34f9567aac1bcd8b384b489f0006b *man/figures/forest-arrangement.png 80aacd60015a52d9d47b8f672207d444 *man/figures/plots-dark.pdf 7fba99da558d03de53420da5176043e0 *man/figures/plots-dark.png 20d456e282610586f05c683165b497f7 *man/figures/plots-light.pdf 76ad453a4a4ca77536612221c2a4d62b *man/figures/plots-light.png 721e846ff389d961e74d5ba09d831398 *man/figures/selmodel-beta.pdf ac3c7430bb215450e7c0ff169b6d1c6c *man/figures/selmodel-beta.png 6420c7e58ff64e5041d64b9ee1cc2c85 *man/figures/selmodel-negexppow.pdf 6c5ba3e80208948dc5027890de3445c1 *man/figures/selmodel-negexppow.png 35162f6b1ade95bd19a6d9b1e41a6198 *man/figures/selmodel-preston-prec.pdf 3c25dc5449669416496b843cddedca4e *man/figures/selmodel-preston-prec.png 21a49438a82db2f862124fce6cbd369f *man/figures/selmodel-preston-step.pdf 7d493ecbf905e007a4f7750d3d652987 *man/figures/selmodel-preston-step.png 1552fb20609bdfb14aed1f360d277d14 *man/figures/selmodel-preston.pdf 9554c4cd81533d40bf269af3533d1ec6 *man/figures/selmodel-preston.png 0db3d2a76003af4269d1b97485f58fbe *man/figures/selmodel-stepfun-fixed.pdf 051bbf978d4b8c4221b8b8f5aa6c7804 *man/figures/selmodel-stepfun-fixed.png 9bfce87bd2afe8cdfe93ffe1a69b0d37 *man/figures/selmodel-stepfun.pdf c1df1cd51ce96c6d59107c7ce80a6d5d *man/figures/selmodel-stepfun.png 481f63d023e8e13ebd18819dc9b7c885 *man/fitstats.Rd 39368afe2e3d88fa162e5dde9c2c37c8 *man/fitted.rma.Rd d8808bcfb177a5bc3919dfb24d7d6bc6 *man/forest.Rd e1db58d9d4ee4c5293575dedb346f8dd *man/forest.cumul.rma.Rd 52a0433ffe3fbae6f3f97b63121065d6 *man/forest.default.Rd 8bc0a621ab12bade209af7fcefbf5716 *man/forest.rma.Rd 06636dcf9a4d988299590dd51acbe47d *man/formatters.Rd 68066441613f2a41c4da6baa2570b4b3 *man/formula.rma.Rd e66297642d52960cc62f0459254b2935 *man/fsn.Rd 2f44c39533f7acae043e0164fe308bad *man/funnel.Rd 16724f6f0383b919d6e29f1982f06aad *man/gosh.Rd fad706901481d27d64bd87c6863f2a45 *man/hc.Rd 8560d4ea64aef2ba1b6e4086a668016f *man/influence.rma.mv.Rd 98d90baf1a6cdb021acddc401cae83e5 *man/influence.rma.uni.Rd 6a7cdd3e5d4b17a2da19421bd8a788b9 *man/labbe.Rd 7bf71a014b152ee735e1a56ee2fd9e66 *man/leave1out.Rd b957366547386a7243518b1973311bdc *man/llplot.Rd 20563d95cbd152a9abe16faca5db037a *man/macros/metafor.Rd d57528316f6058bef872112fe931c0de *man/matreg.Rd 1a0a3b3347e82309dcd8bb7e7c2dd3c7 *man/metafor-package.Rd 022457426198d0d4ff577284888055ca *man/metafor.news.Rd 4578fbf3f7c23a42fbf41de698cde504 *man/methods.anova.rma.Rd 410ec00943ba6ba1e58f1fe8a10ab8e4 *man/methods.confint.rma.Rd bdc9bbec5d8bd7212376a99ffb825642 *man/methods.escalc.Rd 64a90ef5d5363bb153b253e129435454 *man/methods.list.rma.Rd 50b3618549a09a360d8f8422f49a3b42 *man/methods.matreg.Rd 099fc3bee04c9a0cc2522ea793251435 *man/methods.vif.rma.Rd fad57c8cef9754d7fd194f5c9961f411 *man/mfopt.Rd c3872dbb103d6960c922d2b27d7dd61c *man/misc-models.Rd a0049dde8069e8e2387f113c28a2b7da *man/misc-options.Rd 942dc6a80de51c9a2dbfdac65ab1780d *man/misc-recs.Rd 99caccea8a46483a51ffc6e992b5a49d *man/model.matrix.rma.Rd 11fc8137da8b3ff0f9c5afd8865249f9 *man/permutest.Rd 0847caabbbe6d530ebf63a2eecbaaaa8 *man/plot.cumul.rma.Rd 40bd62b85f8014c3cb0f2a965ed27347 *man/plot.gosh.rma.Rd 300069c7069144dc86729103c70499b2 *man/plot.infl.rma.uni.Rd ce521ab087500178cdfd4bb74086092b *man/plot.permutest.rma.uni.Rd cd06fd6a353bb9765dc2f8289406bd2f *man/plot.rma.Rd 5c7e8f7f70d040c5b6aa0023aa8b5091 *man/plot.rma.uni.selmodel.Rd f48b5d6750cf2e24f12bdf03965ad8a9 *man/plot.vif.rma.Rd 513b9f4335594c40ae0e86276d2646c0 *man/predict.rma.Rd 5b9d15097abbbf2a127c7938677b0b68 *man/print.anova.rma.Rd bfd9e6ed5d707e7e8ec6367585661330 *man/print.confint.rma.Rd 10ae758aabb26ba540792715e8748625 *man/print.escalc.Rd 40bb1ffc9ac8b3a76cfaf73e28706c3f *man/print.fsn.Rd 2dc2cc8fa8600d49b775fd31f2a8a5fe *man/print.gosh.rma.Rd b4a7c68c2347322a3c642f2de9f53299 *man/print.hc.rma.uni.Rd 73651d2a6c852b59d706ad2f31dc4151 *man/print.list.rma.Rd 6f363526270c5e8ccf120a9dfd01486e *man/print.matreg.Rd f2625f92172c94ef1f650e996be2ba5a *man/print.permutest.rma.uni.Rd 2b5e9a5655c2556c5b9f180da90e3329 *man/print.ranktest.rma.Rd 41797af1785b424dbd9ce2b0548207db *man/print.regtest.rma.Rd 57e5bc1b51132dc22b073f6cb8dd8332 *man/print.rma.Rd b7c933a180907c6ef66546c41099cea1 *man/profile.rma.Rd f0f32d1390a01ac0a493544da49ede1e *man/qqnorm.rma.Rd 521ee078fb6966451889e4cf93d5cbbc *man/radial.Rd 0a1e18914bd608e9ca8a897ccedbb795 *man/ranef.Rd 5e6f2cb80363d1d22b7a089af493b1e4 *man/ranktest.Rd 658caffa2890484aae14007f5bf79836 *man/rcalc.Rd b92a4af7c8f70fbc037946b8c8266797 *man/regplot.Rd 7cf98cb777fa229c7ad3491cb5436139 *man/regtest.Rd 079fb35717ff94d918205a4f2e614c54 *man/replmiss.Rd 449d36b819ff8be567ea82f7efef35d4 *man/reporter.Rd 73729caf566cda1c73e633da9240f73a *man/residuals.rma.Rd e783937ad779df70e9a2088b9a76fba0 *man/rma.glmm.Rd 5db8b1ed9ce75a3d92df417944c42c57 *man/rma.mh.Rd c77f44ed95c5add6de663f3492363969 *man/rma.mv.Rd db280cac475ea3bdeb0228fa8e33e69f *man/rma.peto.Rd bca2e45443737cd629ef2f956460b454 *man/rma.uni.Rd 59f6e966ec80ac1513da932c7bf08064 *man/robust.Rd 154f0b3b246cb03876fedb1b486dfeef *man/selmodel.Rd 213a9563b09d95a9f5281b5fc832f786 *man/simulate.rma.Rd eeee7a7696cfaf35990bfd5c4370940a *man/tes.Rd 4791bfb90d99c966b83a9a7eed5e267f *man/to.long.Rd 2ff180e0dd7f845dc7b7d2fae2e31528 *man/to.table.Rd 50eae7c3536924738d684f8159d28a0d *man/to.wide.Rd f83a1249a1e802dfb3df6c84c7f4465d *man/transf.Rd 3be11755c44ae7de4c21510edbe48e60 *man/trimfill.Rd 9e1961e516aead24aa84a915fa4ff525 *man/update.rma.Rd 9c0bf8b8a247dc702c677e525973f9cf *man/vcalc.Rd 526a0f51000036eb26f305888db5f31a *man/vcov.rma.Rd 24c2c1bc11abd86ce44b647db4cd83b9 *man/vec2mat.Rd f8230815844989fa8b7a14dd0f5877e6 *man/vif.Rd f1e574367fbd3f0482caf91f3fe0843e *man/weights.rma.Rd df74e87ff286619152915b3b02417856 *tests/testthat.R 8b6c6ab9e0adac2efe8171a698fa6981 *tests/testthat/settings.r 5521f16ef5b1db9217ad0a81c2f795af *tests/testthat/test_analysis_example_berkey1995.r 456d9efb335092b9760ee89adedbeabe *tests/testthat/test_analysis_example_berkey1998.r 73d98dfa6cd14f402f5da647648c7ea9 *tests/testthat/test_analysis_example_dersimonian2007.r 90aec23c38fa275b6abd38d0354e644a *tests/testthat/test_analysis_example_gleser2009.r 78591214216598fe240a8f329ea0f8b4 *tests/testthat/test_analysis_example_henmi2010.r a84768dd5e79f5e135573302c7a9a893 *tests/testthat/test_analysis_example_ishak2007.r f1fbf5be71e61265fe69f395e1d91c79 *tests/testthat/test_analysis_example_jackson2014.r dc43f547c72db963705cafbfabe18a3c *tests/testthat/test_analysis_example_konstantopoulos2011.r a1b0a4cfd1da9f5a3b7a2249a9fc2556 *tests/testthat/test_analysis_example_law2016.r 2fa65a318ff2deb9147a555cd326a64d *tests/testthat/test_analysis_example_lipsey2001.r 7eab8f0bb3431bcf052a06e89e554a47 *tests/testthat/test_analysis_example_miller1978.r a92a648eb52151e0cbb9d5e4cfd9bb27 *tests/testthat/test_analysis_example_morris2008.r ce1aba2e1069d877cd03ce512e847b6f *tests/testthat/test_analysis_example_normand1999.r 2731bb000c742475370850682c579f4e *tests/testthat/test_analysis_example_raudenbush1985.r 81a93da71054a2c878eee5e0758436c0 *tests/testthat/test_analysis_example_raudenbush2009.r a3101796973c5e05688927ccda8eb1a3 *tests/testthat/test_analysis_example_rothman2008.r 506f5ebbcc303f4e8062e490076cfc54 *tests/testthat/test_analysis_example_stijnen2010.r 3f6ca5723d5088171c307862d671ab21 *tests/testthat/test_analysis_example_vanhouwelingen1993.r 68bf335ca8715c921576c684b94c6c37 *tests/testthat/test_analysis_example_vanhouwelingen2002.r 79fcff31381f0cb5318487995fb468bd *tests/testthat/test_analysis_example_viechtbauer2005.r 7cf6270bddd54c053999de59f98bc910 *tests/testthat/test_analysis_example_viechtbauer2007a.r d6239209916a3ee71a513f37514000cb *tests/testthat/test_analysis_example_viechtbauer2007b.r e34a6d0c3ba69c0b5344c1c863948a3b *tests/testthat/test_analysis_example_yusuf1985.r 1fd4b039ff5923aa3b75253a26d9db20 *tests/testthat/test_misc_aggregate.r c7b6ff3e1ae7faf40b8939eb86567094 *tests/testthat/test_misc_anova.r 875e75829323dbd1dd64b692143dcb41 *tests/testthat/test_misc_calc_q.r b5284a131e4edca4839a5fd2090f4464 *tests/testthat/test_misc_confint.r b2d1171b94c8f58bf74ffcc1df148487 *tests/testthat/test_misc_dfround.r 36b48c41c0fb24ac517dc047994c54ce *tests/testthat/test_misc_diagnostics_rma.mv.r 903c4428740236a9b1538e762ceddba6 *tests/testthat/test_misc_emmprep.r 34bb3193b2ed9064979790872cf66fc2 *tests/testthat/test_misc_escalc.r 65d4f8e9e6fc2f781e80749ff3bebcbf *tests/testthat/test_misc_fitstats.r 98caa54cfee59809bd6d9fb0f9f9bd6e *tests/testthat/test_misc_formula.r 93c541d180db55355bd78b0bdb734452 *tests/testthat/test_misc_fsn.r dbe4085deec32977932747b1918e47ef *tests/testthat/test_misc_funnel.r 4cd561c3bf653df4021dcadd66828119 *tests/testthat/test_misc_handling_nas.r 242c4a09e6f2fe74fdb39caa650080f7 *tests/testthat/test_misc_handling_of_edge_cases_due_to_zeros.r fa74768a22ddb42f881971bae81c759a *tests/testthat/test_misc_influence.r de0dc59dbf0d05c2d9f2d110e27ebabd *tests/testthat/test_misc_list_rma.r 8bec2dd3ce7052017f9ba9cf59483471 *tests/testthat/test_misc_matreg.r 3fa9587d254d07b638f8fadf70fb9aa4 *tests/testthat/test_misc_metan_vs_rma.mh_with_dat.bcg.r e4b9fe7fe1b7fd8a72ebdd543cd6ef6f *tests/testthat/test_misc_metan_vs_rma.peto_with_dat.bcg.r 406a2b5efa513fe9454890af5f52db9d *tests/testthat/test_misc_metan_vs_rma.uni_with_dat.bcg.r 9db796c455ea281591242d7460e1cb8f *tests/testthat/test_misc_pdfs.r 778c4cad3cb1e2dc8d762db3e03f3db7 *tests/testthat/test_misc_permutest.r 5af3fb9e67bb12ffe4f4533aa8669004 *tests/testthat/test_misc_plot_rma.r 23efd147783ab59462544b86b5d0d12a *tests/testthat/test_misc_predict.r d34328228e0bc5dde78f62b2d2bf10b4 *tests/testthat/test_misc_pub_bias.r 45b57eb0869965be014c30bba76de560 *tests/testthat/test_misc_replmiss.r 1b0508a29bc375e2edf8f5b58d7f1329 *tests/testthat/test_misc_reporter.r a53d849f1db99a321ef6011f25e24fca *tests/testthat/test_misc_residuals.r 438d39bc462fbac4096d36e35df868cf *tests/testthat/test_misc_rma_error_handling.r 8db20fd7336c918f17286f50af377c18 *tests/testthat/test_misc_rma_glmm.r 657c9fa9f49bf7d91a1335f4317702b8 *tests/testthat/test_misc_rma_handling_nas.r 7bf9a9553b9eb2019442fe5df2c495f4 *tests/testthat/test_misc_rma_ls.r 91cf0f6c19055b6b10a467024245beed *tests/testthat/test_misc_rma_mv.r 519eda6abe12b33afd069eb1f4ead73e *tests/testthat/test_misc_rma_uni.r 22ecb25ef7a2cb74ba7f60c3b3e9a661 *tests/testthat/test_misc_rma_uni_ls.r e1113502582f99bae23b92cbc6846b99 *tests/testthat/test_misc_rma_vs_direct_computation.r d4ae338fde7c0b28171478a77d9a39e9 *tests/testthat/test_misc_rma_vs_lm.r bbf50601150c30be8148b5fd4732e266 *tests/testthat/test_misc_robust.r c3ec0a316fb11a6052c2c244100f0dc7 *tests/testthat/test_misc_selmodel.r 0f150a6918b62937139ee480f8e7bd4c *tests/testthat/test_misc_setlab.r cdd8e4b5f8c3843bb08b1cbb4e8f4bcb *tests/testthat/test_misc_tes.r d7e8445ac502818b6157e5b6cd76457c *tests/testthat/test_misc_to_long_table_wide.r ed458786aecc6c44eae3e76b62a037a7 *tests/testthat/test_misc_transf.r 7e9e38921620b56eb204f918c46c8ace *tests/testthat/test_misc_update.r 4f491cdd7c8216cc4af2f760d7242447 *tests/testthat/test_misc_vcalc.r b8b4c24a506dffc746be6ea3bdd56566 *tests/testthat/test_misc_vcov.r c7a4b0f3ef18fabf0235da2b1d39dd0f *tests/testthat/test_misc_vec2mat.r 6c7330a5fa564dad6d2068d31a470e62 *tests/testthat/test_misc_vif.r 5fad8ac147f57b6cdb5058bf744a33be *tests/testthat/test_misc_weights.r a995e21c36c4a73985dbcebe8e379d69 *tests/testthat/test_plots_baujat_plot.r cd80ae5df5640a295100acd756b86775 *tests/testthat/test_plots_caterpillar_plot.r 241fbcc517fcecbec85a1c49f377fb4d *tests/testthat/test_plots_contour-enhanced_funnel_plot.r acdb89f3d4cda68ed3a089340889cefd *tests/testthat/test_plots_cumulative_forest_plot.r a32f3c806b439a498c3cef49e6029667 *tests/testthat/test_plots_forest_plot_with_subgroups.r a48dfa40dcdc3c4d843a608c7378c0b8 *tests/testthat/test_plots_funnel_plot_variations.r 6e32d81ebf6892ea63fe0755c0497c18 *tests/testthat/test_plots_funnel_plot_with_trim_and_fill.r 52c8673e67f0cd72eaa0bc4478d22dd6 *tests/testthat/test_plots_gosh.r 2bfa5eac58c713ef517c06644894e870 *tests/testthat/test_plots_labbe_plot.r 5760cb9e0cc212f6d97bbd9cee3bf9f8 *tests/testthat/test_plots_llplot.r a61a11d4b2561c97cc206dc143f988d2 *tests/testthat/test_plots_meta-analytic_scatterplot.r 5d07154171fe516c60fb8320ede6cdf7 *tests/testthat/test_plots_normal_qq_plots.r 8c4f42165a921980f5ca6efbd21bbb87 *tests/testthat/test_plots_plot_of_cumulative_results.r 298dd817b5d06d0c6a8f03bd17a23beb *tests/testthat/test_plots_plot_of_influence_diagnostics.r 22c5761f4b8d76779c692979731eab62 *tests/testthat/test_plots_radial_plot.r ea243541b152b96e76e617ee37cc22ff *tests/testthat/test_plots_regplot.r 145154676c05490a4a1feab3cb922184 *tests/testthat/test_tips_regression_with_rma.r 600ddf3b8bd11d1a81eb130de1512cda *tests/testthat/test_tips_rma_vs_lm_and_lme.r b438c769739c3d868cfd5766f72f7c2c *vignettes/diagram.pdf.asis b22e3397f4cea09c48a2c785ff0cae6a *vignettes/metafor.pdf.asis metafor/inst/0000755000176200001440000000000014505063374012673 5ustar liggesusersmetafor/inst/reporter/0000755000176200001440000000000013713320160014522 5ustar liggesusersmetafor/inst/reporter/references.bib0000644000176200001440000001761114222557326017343 0ustar liggesusers@article{begg1994, author = {Begg, C. B. and Mazumdar, M.}, year = {1994}, title = {Operating characteristics of a rank correlation test for publication bias}, journal = {Biometrics}, volume = {50}, number = {4}, pages = {1088-1101}, doi = {10.2307/2533446} } @article{berkey1995, author = {Berkey, C. S. and Hoaglin, D. C. and Mosteller, F. and Colditz, G. A.}, year = {1995}, title = {A random-effects regression model for meta-analysis}, journal = {Statistics in Medicine}, volume = {14}, number = {4}, pages = {395-411}, doi = {10.1002/sim.4780140406} } @article{brannick2019, author = {Brannick, Michael T. and Potter, Sean M. and Benitez, Bryan and Morris, Scott B.}, year = {2019}, title = {Bias and precision of alternate estimators in meta-analysis: Benefits of blending {Schmidt--Hunter} and {Hedges} approaches}, shorttitle = {Bias and Precision of Alternate Estimators in Meta-Analysis}, journal = {Organizational Research Methods}, volume = {22}, number = {2}, pages = {490--514}, doi = {10.1177/1094428117741966} } @article{cochran1954, author = {Cochran, W. G.}, year = {1954}, title = {The combination of estimates from different experiments}, journal = {Biometrics}, volume = {10}, number = {1}, pages = {101-129}, doi = {10.2307/3001666} } @article{dersimonian1986, author = {DerSimonian, R. and Laird, N.}, year = {1986}, title = {Meta-analysis in clinical trials}, journal = {Controlled Clinical Trials}, volume = {7}, number = {3}, pages = {177-188}, doi = {10.1016/0197-2456(86)90046-2} } @article{dersimonian2007, author = {DerSimonian, R. and Kacker, R.}, year = {2007}, title = {Random-effects model for meta-analysis of clinical trials: An update}, journal = {Contemporary Clinical Trials}, volume = {28}, number = {2}, pages = {105-114}, doi = {10.1016/j.cct.2006.04.004} } @article{hardy1996, author = {Hardy, R. J. and Thompson, S. G.}, year = {1996}, title = {A likelihood approach to meta-analysis with random effects}, journal = {Statistics in Medicine}, volume = {15}, number = {6}, pages = {619-629}, doi = {10.1002/(SICI)1097-0258(19960330)15:6<619::AID-SIM188>3.0.CO;2-A} } @article{hedges1983, author = {Hedges, L. V. and Olkin, I.}, year = {1983}, title = {Regression models in research synthesis}, journal = {American Statistician}, volume = {37}, number = {2}, pages = {137-140}, doi = {10.2307/2685874} } @book{hedges1985, author = {Hedges, L. V. and Olkin, I.}, title = {Statistical methods for meta-analysis}, publisher = {Academic Press}, address = {San Diego, CA}, keywords = {meta-analysis}, year = {1985} } @article{hedges1992, author = {Hedges, L. V.}, year = {1992}, title = {Meta-analysis}, journal = {Journal of Educational Statistics}, volume = {17}, number = {4}, pages = {279-296}, doi = {10.3102/10769986017004279} } @article{higgins2002, author = {Higgins, J. P. T. and Thompson, S. G.}, year = {2002}, title = {Quantifying heterogeneity in a meta-analysis}, journal = {Statistics in Medicine}, volume = {21}, number = {11}, pages = {1539-1558}, doi = {10.1002/sim.1186} } @book{hunter1990, author = {Hunter, J. E. and Schmidt, F. L.}, title = {Methods of meta-analysis: Correcting error and bias in research findings}, publisher = {Sage}, address = {Newbury Park, CA}, year = {1990} } @article{jackson2014, author = {Jackson, D. and Turner, R. and Rhodes, K. and Viechtbauer, W.}, year = {2014}, title = {Methods for calculating confidence and credible intervals for the residual between-study variance in random effects meta-regression models}, journal = {BMC Medical Research Methodology}, volume = {14}, pages = {103}, doi = {10.1186/1471-2288-14-103} } @article{knapp2003, author = {Knapp, G. and Hartung, J.}, year = {2003}, title = {Improved tests for a random effects meta-regression with a single covariate}, journal = {Statistics in Medicine}, volume = {22}, number = {17}, pages = {2693-2710}, doi = {10.1002/sim.1482} } @article{morris1983, author = {Morris, C. N.}, year = {1983}, title = {Parametric empirical {Bayes} inference: Theory and applications}, journal = {Journal of the American Statistical Association}, volume = {78}, number = {381}, pages = {47-55}, doi = {10.2307/2287098} } @article{paule1982, author = {Paule, R. C. and Mandel, J.}, year = {1982}, title = {Consensus values and weighting factors}, journal = {Journal of Research of the National Bureau of Standards}, volume = {87}, number = {5}, pages = {377-385}, doi = {10.6028/jres.087.022} } @incollection{raudenbush2009, author = {Raudenbush, S. W.}, year = {2009}, title = {Analyzing effect sizes: Random-effects models}, booktitle = {The handbook of research synthesis and meta-analysis}, editor = {Cooper, H. and Hedges, L. V. and Valentine, J. C.}, publisher = {Russell Sage Foundation}, address = {New York}, edition = {2nd}, pages = {295-315} } @manual{rcore2020, title = {R: A Language and Environment for Statistical Computing}, author = {{R Core Team}}, organization = {R Foundation for Statistical Computing}, address = {Vienna, Austria}, year = {2020}, url = {https://www.R-project.org/}, } @article{riley2011, author = {Riley, R. D. and Higgins, J. P. T. and Deeks, J. J.}, year = {2011}, title = {Interpretation of random effects meta-analyses}, journal = {British Medical Journal}, volume = {342}, pages = {d549}, doi = {10.1136/bmj.d549} } @article{sidik2005, author = {Sidik, K. and Jonkman, J. N.}, year = {2005}, title = {Simple heterogeneity variance estimation for meta-analysis}, journal = {Applied Statistics}, volume = {54}, number = {2}, pages = {367-384}, doi = {10.1111/j.1467-9876.2005.00489.x} } @incollection{sterne2005, author = {Sterne, J. A. C. and Egger, M.}, year = {2005}, title = {Regression methods to detect publication and other bias in meta-analysis}, booktitle = {Publication bias in meta-analysis: Prevention, assessment and adjustment}, editor = {Rothstein, H. R. and Sutton, A. J. and Borenstein, M.}, publisher = {Wiley}, address = {Chichester}, pages = {99-110} } @article{viechtbauer2005, author = {Viechtbauer, W.}, year = {2005}, title = {Bias and efficiency of meta-analytic variance estimators in the random-effects model}, journal = {Journal of Educational and Behavioral Statistics}, volume = {30}, number = {3}, pages = {261-293}, doi = {10.3102/10769986030003261} } @article{viechtbauer2010a, author = {Viechtbauer, W.}, year = {2010}, title = {Conducting meta-analyses in {R} with the metafor package}, journal = {Journal of Statistical Software}, volume = {36}, number = {3}, pages = {1-48}, doi = {10.18637/jss.v036.i03} } @article{viechtbauer2010b, author = {Viechtbauer, W. and Cheung, M. W.-L.}, year = {2010}, title = {Outlier and influence diagnostics for meta-analysis}, journal = {Research Synthesis Methods}, volume = {1}, number = {2}, pages = {112-125}, doi = {10.1002/jrsm.11} } @article{viechtbauer2015, author = {Viechtbauer, W. and Lopez-Lopez, J. A. and Sanchez-Meca, J. and Marin-Martinez, F.}, year = {2015}, title = {A comparison of procedures to test for moderators in mixed-effects meta-regression models}, journal = {Psychological Methods}, volume = {20}, number = {3}, pages = {360-374}, doi = {10.1037/met0000023} } @unpublished{viechtbauer2021, title = {Median-unbiased estimators for the amount of heterogeneity in meta-analysis}, author = {Viechtbauer, W.}, year = {2021}, howpublished = {European Congress of Methodology, Valencia, Spain}, URL = {https://www.wvbauer.com/lib/exe/fetch.php/talks:2021_viechtbauer_eam_median_tau2.pdf} } metafor/inst/reporter/apa.csl0000644000176200001440000021037313713314420015776 0ustar liggesusers metafor/inst/doc/0000755000176200001440000000000014505063374013440 5ustar liggesusersmetafor/inst/doc/diagram.pdf0000644000176200001440000061371514505063374015554 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 1466 /Filter /FlateDecode /N 19 /First 133 >> stream xn8)xݮy&(4vi7"M:V J1B9!盡,g4S1ô2c=s̊yfgha3bB0aL$ Ij&aY[&pLI)ca2e9{9U:J) I(V|8 E,8â{}Ɠt>a߲0V"o]y/{Srxʩ-8q9#m[q;ZȚ4p.nxКZ}mM}EvGO7(bgv8˪mŒ? yV`Ü ,1;ẊesVMA:WLQ6*_@v: KyUɤrFY8 gFs=H h; e(Df>*Z7H0L8ԑ/Y`3ɽuZYK^ܤ39BΏXU,BrRB|̪7$+9ʯ=,*r ~m7eE:P|+꧍Lڍ8#%G_3(&:q'{gwenqԍ[Q_,%Fl1%%=>!Ir 8]&M@VF*1;9BK8ߢ7BL&6rPmCqV(1lsČ0|oH]O_FOwO_0*c=$jV=|YNkBSkC7Y=%QrNQk()%]^jJ y=jq++`tLpD6jmGnjԌ&6Q[hP/ ?[ۏs3S]6u>APg_WxsȚeNڈ NVoәnK`=q 2`y7\ "䋊V2AuE܉ť)6y#M[B%0o"xug1(Q5K-;gR,=gs_pԜos}? ݧ Z2aZ3ќ/S"endstream endobj 21 0 obj << /Subtype /XML /Type /Metadata /Length 1475 >> stream 2023-09-05T18:37:39+02:00 2023-09-05T18:37:39+02:00 Microsoft® PowerPoint® 2010 An Overview of Functions in the metafor PackageWolfgang Viechtbauer endstream endobj 22 0 obj << /Filter /FlateDecode /Length 99777 >> stream x̽ˏ_ɕ&VlΊ7BITiba,ۚƠXYfRQ^hc}_Ddm `'ox9'~;[w?/3w|lެ zϟ}vo[ -|SwS7|</g7Oyn~~4m-px_|>i;rO\CNm,7/^[(?os }5oq/}:n=|wo1VKM7o>GKyew-ݼ}i-}cSSwVxFh4ާx7Oɏ byOa|%ڄg>ԛ]ےO7;EWs_>s rc铧O۠7OOGO3ŧv7)|4o:(2dP?N}N\!V/s.\JL}9/o~so.(LwNTKk5}F>oz.-D\r-%#0?oK硓e|B76Pj9_fW[lE|wp~7̩P''ܿInjWϿy5͋ww?گj7*'=y7IosĎG5OsAg)OƧ6Uwp. OC %Õp["_<"粋NbLfL~M7x Y'Om޿3xͶ˔DŽ9=גpSjxн|, k}{0؅]}gC:Zw6sm:Ó)i\ OCXN{ޏz?=1s)a#'O?OO~ z蓟>h4]ԇiGŭzzXΟ}?ߘwxOh:VCۅ~ᢙZFx9=Nы_\ulTw/>xwe5}=NM՝7Cr=:n0's{oWg>#OiG7}dLU"EP8Nv7O~C}nAțwx^u#w/З 愿n,bG|z8ujp;*j3Ruo[x>ؕSߧ{ q:5PƷ_ EA~U]}m)bl# fe:wOΝ(jn1Z'ØFhpF^"x7 -{p<ћ{=Pئ10U:Rڛh1֓}ӿ8vT&=HN-vس0ht %6X_ڲ]Yނ*u!&l @ݎ F\ >s玤3و .FHÃ0m@QD#zߗB}я7Cb>1AIڻ5ʻI,#r#-tԧ`Kzu՘Y#t2 }gn%^xn> RC(.zu,&l~>⋻˻?Q)MEoD^ן3+=sH {۹Hw֛l:lFA+㛿DGtXNLtۡs(n6-tK¿KWhwA1RǩhaB'P-i>D0䒉Zwc(͆6zϟf`CнМ3I٬ 6dK￝}3R9; x@b'r TMy0sT;=t_+% b% ϡ^bcnce%sZ[{[զڈ/jݭR_. <6Iϱ ŎN> *z]s =6zqټ즇&cO X\NN ֯4w{w[wY'7}!];*|7!\vdh?Â=cP+}7@<ȉɷcgw k\X?$r$5my]t̄cHH}?$l{9'Hs~l{Bu%_/OOn._=W0FbC? -y9+`YkF6sF?=sebҵ}W߱h;?/Ͼ 뾾[MEWpL-h7rK}wu3Ͷ%5vqXgl=^k?杅_^PnO,js!}Cv̝Y}[kJo 9OW(~v7wfGe#9俅) ӥM[%jun9͝X.ڌ@j8\13Emiz7uGkm[ȋ{Fv\+Oat Ȩ[-Hx.}ɑ쳣5~@lw!Q1SϮh %GYҭC2LHxtLI?%)ߩ?p\]. nǃ^ F2ˢ6oZPwv>8`>TCgFQ}+}|yl5e!6di#5%tFoc}4\oRJ"_4hz軎S׾t=v>ZZcxv+9-}A\)־M#﫻y,|,لMpwi Ooׇ;)-aq;Df??(<6Pxl@c =6{l @>'8gءu{:' eo?~`?a_mmM=sx??>d||!CLJL2?>d~|!C}Ļ# v*Iiw!ǷUcS)Zo1ݿ[o^c)J"ցtH,=t-SYCq+ZOH}ĭXJ-AÍy 6?f)rWO~<>ӿK$">>.vl|(aV74Gin{>f~nl ߼ޜпןQ1sO~ycf5,2- /f?*9 A>/Xca}dz};hgTk1eJW97(X#v376i2yxN708_zgv†Z>\|fX!GQ.:lHtO6 z[5ވn_wnc=bEN Gx1NNt3o:9%8QX,#;{VBvbcQ7nxqlpςr&&.*犌%BG. :2yqFc<+?yuB.|gEewL02p"|o?X8bb oT}V,%ϽJ?~ccF!O1ġwmGqZGrkr,ۃ };INynKQ6K=wp2|-@Fٿ}}0s8"&kٵ7_d??LZ־z2F#nrਯ^~srqһ͋/cĝ2++ۓL]Bc^?{,Zo^qv`j5FS#Ͼoy=pk2qtD%jl _ WY4?ʾ'F tvN+|dS?j:(3+ e]N;{(lev>P.1s°CWꍯh{3=AД_a3 ۳ 2vJmZQo^T5:(<ҁelӾ{ +oG~֫Mˍ:>[9pgڊvjY;k,;L`)C]##An g^α{v >R&c_𻂙bL<}YUbNhǰ>u~}#fVʜpO?mI]81Uv/Lrݾ52 e;R2/=>]v9LϨwwߑ:a>Z>5~bCdzMI[lXz@bι wU/Q;=t/-#SPFĥHwiLal.Q%b]|?x2A7~l;1Br_m=(ĿV۸H>uqlRʑ&|_L\F[oӀmJQV(uИACqZ۱U1Aq@(c1j[玏cc鴹[Uݠke /9: Иx±ˁvRZ;f\v'1^hG{סjZ-f<8Og;np>v(^ [ceV'lD9@i˂JA\# F2` #@ aiDž P(b[8_mkW?6o69/LlgmdHy!58xdG@>B 3ұt8@( m ÂOmaۦqF?k^֪bj$_~{Ej swLLNVvs*PU\ygڔ:MaiS5D6bZtw/æ bMpbfQnk7 )M?gXA>ٚ3t~uK|X*9 Rc%֮ڨEK}ijͶ`PPKۻri)-ogMs:a%vč' Y[X>YmrRfhS ^/As*\eܴ6*ߍ笯;o+'&n #Z *(m_c""92&Q$CHQvAl2}&=1} /5zѣ a}>j [:5hҋGHcevAm?U@Umk]u(| `etH|g1U4Y/ivJjhvnw1mP֗+4z.PTԶh6gmWF \Sn͠AlM+E{/)h--2|$ Z7-iN9M㓣Im$ŬDYKרeS; *rZTq]fe>ٗ V` V@y|y )["Mkߠs "&-c"1 O2${ zAw!*.mO5(9d88w}r Jڦ.ŢiS3Y[9&PV)Қ  cQ(P% E J]͞:@2Ԗ+5zOWW} ^ܱJ 2LE*^AE2cF("e*.|g_1ސOR!+#[hr|~i`d7hEoz*(·Y.htL7pP@oM;;Lf2,ϓ7Kk K[jYpBԜB~V˄/ٶx4f\\< \`,!/Mme13Nj .H/6|r ^f/!Mu'=@Mpzk t`zڳaD/ :hS^g;v +*l\.oٌA<Ҋ/nd8;6ТFuݡpܥmƵ :oAQm`2'A*Ec׈I'v9qf3ʪ9o&ڬMYڑ_O](ZiIaV&k.mMZRpEa~Mm)oxam"qM(=hTVsN(g]Ԓ/[rlI%q̖ P@K5h5M(\z=siЙOy-*WeQ hu vܳhRZ#n+W$ƭW(89:ƗMUh̶֬Ce% x܍~<%$y\0(8){'lz =(hǠ+x˶4EP  xwP<&Ai{S.ز6pms>RN/v>dxIx@^;cb)'dANm !vrPT._:(mspx_8~jN #h H J$g$-Ғ8$Z$[höEL*&b}Bu49yp"576h1n&g7d3vr9Ӣ5t4m˳oP@/o~CKІ=5l o_RO0"lڕu:Nhm j so6悘k~aǺPa0w(&ቲO~ F#&i.@%8Z$I/q E(_Uh[mx!SŀQX1WiۦSm 4c9j>/aG- *fcau*'ŬW9v@Phgʩx rB/o3crF 6H`gKDbnˋ/&BY Eth3/\ʜeV=x+ +h?Q s U5пCjZ/F*2_J\n3-=84-PKPyܫn\O,Vfۤo 'EKVI3Т:۱%ưiT'f-  m7,(]p%n_y碃4Q|Ў+Č_I19t+Bo bI^f!jL&D憻r@.<|_5 oݢI&}+ )y=श0qA^Fd- Ҵ-M0m =EAIaE6ó";gĬQp%zqem/S೥rZR Pj#_,apm~fұ> VΤٙ/T$Oݬ#E>G~p>)Mjs9_sz Lۛ=ϯٮw3gn1='\V9iKK4rẐJyAU{j-pL)Y)RAwr.o+"S5*nZ1(l:25bAIC5kqӊ|bĠ^a7cAP,)b%jFAm6C[DuZ[&pLF%\[( mzQ+ hz3֖։NW.iłBd{NCQIPU/IM[?Uma+//45iUbԩes,ǃ :VKop[(r@m(`;\ãq7H6wfS[0\ cT6}Si'짯[Jлۊ PSΦZwxjÞx7܄Yw8ؿClSQmPU򫰨ֲ%{qoHC늍hE䨝-'8 "Ysl[DѯȋWlFd*˶;$R6,9\I#2u>]9HbW`Ws*<68IVnݥ=9 =E̞?rZXƥFY^ǾX<4[ì$S4Q!2'іbl,xkNn@~+qE'c~GY|-,Jxkv\9Yo./9a˲nB\<; pXτ]@hpҐh^M!JY`'' $e}&aį8p>W(CDD,}AaS"gM.v71"o_P%@|nqčD5-lRݠC R4~6v{j 3Hz*;!X$=H>Ӟ.,IC"=ERĩ:n9fJ8{F|QpBd;V5K(9e:}`TwJ3`,$@Kzgmӂ 2&PŶQ \~2[=rO9B?290:$ תЕ@'FN;`N2TrB>n٪ۖZP"CH .×)f!\t #I ܥh:3z${ !бE娗FKAeh|_)*֜yA/kNjjW"zY`w+xl6E-IpP@Ҷn.(%i_5 ^VTؙPDx}kPݠQނ(6 G8%}X'~8B|BXW[OC7zDs~G@QN?GV|~ub~4R>+1hǦN _Z&uӘנ1(΀­;w1K`'j1Ɓ6يX오 -Ɉb[zUm P3MwW]nD:wT6,TԖub8۸;o4̾'f]h8 P J^v1ى j[9>Ͼx\P/wTdU@ a f y`WIn8U%,xR 㭍ic8)0[x'(\ wm3`A}r4 X<`s:yzaÍiBX=~'ZЫdz}aښ pu:1v0語@+(EDf- ='ɢ,ge\ckuo$8.r|N)[fo+ mKq 8~pWaN-%k b`g;cM7̗C h悧sZO!pbE!F&2{ 9CiC$eSZ= bXߠPdm4F@ PĶ~6`& *Z"@TְcaDHNw9^-#`%@Um N[˄5פ5qĤ^ ~aMpIXxkmxwH)@abM"^ f1SVkW?;dP4y[<8GOHm;֗-!VARe{ 򂬗 Ş=@;䤂AGt6Y{2_a\}$Wj.h3./֗f5*s&_YsC;d!'3K\DWlǧziNJ/Hiy]T[ f0==;Oo.ʀ8_kY`mrKoAHE8n -moy|W]MA@ L'M~)]\[a&85v_GΝ>4WM]E=-vc7A|MoyY~=jfs[Q y r6: t\Yӄ+6 #x\G1HۗXeQpJ'yիqMH'j.a8T6@)86}d$\:WTf>v/П+-i[K Q6! cr$uFcXpZ2FQVb3e42FTP{(q k@:R`f /B?[fV NuiyC/j10NT4 kʃPV[R=m$j-%smmZ29 3[R  8=P.J&E!䗄،|xW+RfۘIIsu d$/q?(?PPJ])̵h2 JVeoyag@IN'Qs41&rҪ;£GAM|BU(ҩ seF~)3BP-n3jE1WPQKl(ҧCfT@e+uBymUFhކe8Ԓ֑Xt̹ᴹC1@EsfMSM~avڥ-4.W$e _B`mz A ?z!Khmg8p\0׼AJV{DnFā_gWD6ZVr{ 4y V\5nfHx /٨I5\o"UE{#٤xUp{wHy 'T˟Aɀ0wɟ3ִA-"wQ1(+gT<'d6J]RTAhy.o1z͜Ȁ!f6-OMCNx #q51( lK8r(ykij {ڮfV\?2,8>G y|hOF41PE<S-wISYA%FQkhҗieMrfM0棶Je=1C^n~aEf>LZ5YL0vh~ j+ cEM!Z[yvjܲ1Jn+ѪZ ?z V4M(% ,>e#5m9"ԝgoL~,fϤmYK7=b4Yt+K<]m}" U~SyUx! ޫ%p~4Rb zUm9jGCl=qj9; _u)Kxm+tjY$oJضH jCU},omUWVy'oz߄ gR,-&/mOMɚChmi5sUEn,b!2xāM|Gʒ" @'p #$aPoIe0+<6HbM h[2T~϶z#mTV['(I/(>N~{Y?OqZ4-iKK_u`s0#myQ=OR䭥 셧>6N1_ۚ(_2n# ^1u#y; h.bAPG"}0FXWSA:iPo5.aE(/E.:#i2RN$zug); QaX4ӪE?Z[LI\E/kH 4:}z c<4>z+W$H 1JS(IAN\!X@Ri"c/s[;X{xްnwjd/x6R2m~ h  kH#BTh !/~XF>P M ڡ_E!RynPi s>`z{sSY^%>!ři֧4m3$ N_>h۶6;CS鸑65nP&q\1ssg1({uazߦCzHG%M'o`:&!̄!E>Y* EQ [i(C]ř |swKGoMKWNoMElIh%o g4t1{Xx{| #A BNS[vX''&Bd #fjϜ 4\u+8|/2UQ5U ̭ᙺؾp:95;󔮪XӦ)^4;Yx'@s z0D>A?.!8(Th5tG;.nwr!a4j֒u{ʊ:+q^K9ǽtv[4̻_H8$ >d7?~dI~d)~+X6h{&optw&,X\Ujgw&*JqOdwp+ `*˙3Z*t6])ÞvmP-o6Jlq }<Ā} نU&0ȟ w9#(۟¢CR+[k`uq]:Gι-tji3`$6DCVYWz:GV8 g4Ma{& tq;s9VoZ;m6[SEȽh (+~<ȣ'"Bģ' kۭ^*=k6{6rBu}:9e<{$eyP4BV[mxJQ+W}>[F)ŀ+<< `/:P7m3:*kD =FH@ ygtSq-sg=gʑЄ el;^~X\[['z䖷G|;nZD l%g!iE!Fl%n@c7+ Gvn>փ}|78s7aBzcBB>h@'6Rad )ŶHOFdV%s[`B,6wpAX|%1{^8(?xi[;;ɏ~l{X=FNw£Wbˢp۶Azaä;Ŧ2lehz(%oOؑI^zR$:TӮUˀcVćjb?.TDZ8j"d"1KmWw.}dmױ[.N׹lfv9r{IM~+7(.8{%yNر/=xz>ӄ k!]Z"*P?QcRI7 Y:T)'dXƶ`I ʂAciڹ( ҏ))HqIj ,η$TN jIk={%iv4yA gyEޔf+u| $sK( W= a/R w`7͌XBz;d`(t̃ i,GJTX.8g$[p+,0Y102gM/XV-虉# PYQk$.l/>ҲO0ftZb1j\YvxUޤGeםԲNƛ<=1`Art 8^7GL1ۆ+Yݒc˰PW$ژNmay e 2f=,,Jx] zE+؉p :Xd64-~ŧ))J#w^**E#&l< .FeM{{MmH3,4I((`Ijy$8՞/M"[JցUg!?=92#Knv5C&J7%mxBXF#,yAp;㚜-4ˈR \KpQgjYm.jE$~4 K B,rfJ`1}$9 PR3k10#boWa u){_$?ݡb+,\ɺ7.x8r=t'<}hZױG#w!L*Lj*3fM)̢~/[FzV~/%V;;/*Qd-Y;g[c_l|Ì7 ~skNU`Cqu1s/_UQ|Nl<%8+#pkOh(NO_"º w<. lU_ęw)PeY3nA|HA#eλUH?-fGub@-1]Z7Pd`=`ɲ8QyVuLV*}*eGFEV]J  :-wn9^uϒT`1ዡ/'f[ls҆ IT(/zj_ΪmE4W~0{g2I,a,Gep*v?VPn^:*knXT~{[/x&" LPA|Nx^MebɹjQm/͙]{)TēYڰ|0҂;P{uc3"=؁lw\}3 p$6Sy>PFEfVJm):YIrK#ĸK8w&{eeSKAr,#=n:RjY)XԋUYO^$#o)t/B-Qfi f95rûqgY:{9DV Quuĭo38kQ!C/o^Ã`MJBl NW[sd*u\_a̙W^ @O(ϪzSY`1Hw|Y]4OdaY^ Ug( W蓲&ЋD43YYD)GAq=+wf?vrX5HZ,6,<+[tph,3ϓ<"]ԲH j XXD]r5٤OX[8K%KPO)oQ,Zl-uۤ3ee;ϳp(4v 6OąԿ?4ఁ ь~e}ER~jˌȔ͍thԯ6AJsW:ʉ"I懶󮅜teCpKc@XFO:Yv6ktJ1w406.Hriۈ y3 帙ڲIqiE4(<\^$3ɖj8s-}<$3DH8Y68o ƐT7i{vhNc@Uzn5c>F;Lj#@}ظgH ҂ Y (k1X{ V @# 3*Igh#a݃XzC}3OJ S`3$Q$fdgEyUm:ԟ3zdIVi_l 0cvkTͿgqm$EHBHB!K0H HeOu!Ϭ ) }nkqh_ FRY%{S86J)ySVaûO}Enl6>rܖ <7)CNPiFя:L LMLYvѺ1X?̐l;@jm%҄v\ڬ9 mP\~,?eZ?<~͂ya8Zӛ:zܳr4zk0+S]m4y@\+^_Ggl sҝա3;wKJ]I .:Kzl(#-.H3`ܹofͽOG֩4Oͽlc_=owIG&Q”Lxu13YuX e4T> ǿC>2NhryB;A3?Hh'`DJyF0})p$‹ -v {U#T}TH(cY@E;i8+L ~S%oJ4̰}84Kui:OW@wވo c ;ܵ"HK3>$V4Ɩ3Ȯ59uk}N+ƻ(92G7F*#t7Qz=FN24Rv߭وF+ [m:ߝޅKn25NX?aW'̞Ɍ{\15wf([gVT%> H,ջj9J].Ikgݵ>[F$$qU{֧ӏau1փc&\c]c>J&yQ3?>[: MxjφA;>C]_6~<['W*JCIq`@P;pa?܆9~ȭ?](NЧCHF %3{Ӌp|AX$h ߗD/^"~$'l)X3͞$ʊfFnPƵ|~gj80tb&5%rT;ޅ!F0Ux[7RBVY%hro`Bʖ_:,#6r2 ה8oC:RN|̿E'PlWvy8N<,SC:_^.NHMg o45zѻEmrP:mTgdXB`Yʽ䧱e:k@>oH]H=浑5`J_2ۉ xs0yENBםM~GyQXYcȚį]2.'CArdޙx 3żϫm7IfbgBG*L=o KgzȭEG̑KPGMFA5*(QuxRˎ|=Ͳlev՚\ WaskFUP0TUcp6‰_a3.P8,z8օys >ednC4ɯGcp*hNl\>G/'+McLn =EF/<Wq9T5=x*04 K:Buw1!1 gǣ[2hy ?zM #P{pp*g׍Z \?@&A4Tv]e|D?pcFsʊq΄ GO+F~AK6vbZ=|\2|]* 2|>~o Q8(_6ή>j?e{p>ٓ?)tNlpH:eSyjQJnt,xc0!k_Es# ApdMup'%"}Ya욢xf%%2I(~Es@x(-W9i\vo ic* ܶWus] 8u8wFsJÃS֜! &5o ͞ q 99aEea9b|'v\M#}Y4Ʀ(;Mϕ_f%jY6%ٳs7N)0 %қw"oHx-A J*Egm{iP2MVlcLx^f+:)n2`p+q/ˠBYUWH-3H>>ԏ_ RyJ#%R(%ny$o0tNbRmf؉UL[~`{2tF *r~- ܑe1ѳv!q|$Βl]iYGx䱸P)ۼj^q|krڈ\絟Mk@Xp`HM@^L { U GZ̯晱wnUȔAM6p\k:_%u%ʘM.fv/)8Ђ.k*'S% "Yb/Tl7t׻h>K3+D;uuS.l^f]USG5#цEq$S +lS b3tC.E7C!dR?AR`e׻t/2 - H}jU| |5v'PϷ_cp=k;#סQ,3{}svdԒAZTvvnljXOIZAm9Fk&Tr[3K8Pk9{%qdn.drUkIg^SbVα_txyH§DsPfM6$Shw™<֌,_운v5k-"ͭm 49vԬ><ݯ%k`1N%!\wf&ЮDIq+G&` vr }#!I0tpqp̬;i4[תbyO%\55JI"nl JESKD~ex,st-KZ( :,pf8ȓΘg碞M?_b&涞r֜ЮyX'K 8nzʉ#)jm˜\BXfLREf;P3H0x;f[ qCS sDvNgWx@̩bNg "p#l{q.Hc$4k^֧UXyzjl~42]^;S'a-U咍˼I̼W~Kˏv37)5 y=Ze%IvXu=EgCY9rg)4E*n9;dzO A!bY'9J"Xcs[Ĵi_}3(UfY^Қ遒Qq7ksŸťTKx)F|_Np8#/;h}h'$7`, qn|'' a0g*oʖ]+)MY!ÇSb1M?2)NDtca\`9Z)Q֐LC9UX%QjAzGN"5;0NeOyS+cc 0P*^^][oRc>r%ŪŭU#=v/2=;:q #M%׼QT.rP dИx3| ӂV|s;^?{H{/d֚xyN״>rA"(:E¬I%獪Td`\~ѯ!#)(1U%chޕ=z|ը nt yO* 3[MvuiC$6Ӳ8ekV2Jsvq[߳|"RyInRv>Y$T.)<TmrvIrй\an;&9Xwe߾*hȬZw HE[o䖫>IAl0),@I\ݙ[r K9􋠢wonHYҕoJ.T/1;+gJilj'AIN{\x6Bh_y]:L"qDկHF?%#M pD*rNl]pȇŮCsD_CJ Y<$kKIEgc'+4urhDtVܡIdNaX./w@l.ñH,e`qUҒh,C^ÞÞWۂ /? |K@kLS`)c"sNRPLGusaphKd6TVh]?jL͏EK \=+ 6 }I]K;ʐ.Y~n t`;N)Vc%L*WjeUϮ?0%.bHxHa[S8\LJ47=;8{R̊O%C9)u-;ډ Vz6gͦt8A͜}z}RcӈVnR*ޣ÷dHͲ%<~Ls+rþéٟ'tE"o@kבmuIa2hF<#KtIR9 5&8o.*jY %jb&͌z2DXPID%`٤XS5Iߕxw>G0Oz՞;dp9@[ݚJB? /;~ ֦d .q3S'v?;K1tZodhZV{&M^7Hw .ۙ -1Ǜ+x@r*E vI)u-܁p6zur+{K֞!dݬ Wlk*/O ީ뎪Lry$o{yqnb!wYR.5n7+pV+^̠3L~~~YZ*zKuxA%%N!8 b7|^yS#yEIIe7& y[XۅTz 2 7F0nyhv[)h% 3AFBQV+Eor9;YMAHTN"Y>v;=t*?kXyJ2j-;([2X.ȵqsR萔;CqHs {.=Z=O;Py<dzHi~kx1'NiD㰉s8NRӋhR@e罫zUqգƻwlBY7 \~@nhxR~dz |vI\sp~m?Oa\äy\WRt3` 2}>Z#]ʶq@[;ڮZ:t'.[>NtaIacH֤iNi^KS$YxHygN>[֛Lے>1'xjl`5K(d 4Ξ#{twϺ"kxwun>qq^sa|Rm͍ԸQA\JsPjEJ}<y⒱i/HFl{/#qg6\J9WŘ٩,m]o:_wm^2?p9M% @l$hBQr\ME>NDO Qt"H6`it^NI' "c0jIf(D7'ՖgvC?-\YQ#s,Xg0f%VʪX/5$a+:Yԃ|U_Sv*VJdT%afB?NcyTJm=4lJ͚3Z@<|IƼKUHq٠==i׹GF,L֌B[OJBBһ3h&L,%!גۼY`Fj{?)As억nNͫ#{UGPq5J&3YQ=rqb.5[;ġJdZ+zr׊q{ *[k\,u!vդRF~&=JfB%+eIiPпC3`d̗~"l~pVJ"^igsSvy?[xGCN TyӐiB?d}q>T?[+fU ꧬ$s+߈k<,vz@PvXr#3W`LVn:ka[T 4aZcdYC13gcjJϭډlV)H3ZKJ!Ydq S d~]uW.Xh.x+=M@NAɼ;(G@%ec'XwƜZqdDMliSo|[NIVG%ilLf&.߽%4%@7Pr[i&GYpM~9=J $+Q>;NYۤN*3YbH{b$= >Nqnsj?ok"a߈aQ̜'h^"[MY\Į?huZj\ӑɎ5ČL 4eW#]fֶW][Tک*JKme2UsnOrSP%KjlЦnPIyĉ, *˵j} j R feBv([Zu+3VcV`%Kcuﯸ)Z"Mn.eY]-mA2.G-2_~du,|ICR1Ǹ(Le *e^{ɂ=%m\̑58 F>&^%< )>NZ?JHIts[t#Q<'0GMp) :v%c\;SB=|3Β y&Es#s&sϦ`6d )ǏP݂!xN޽OT0"7u3\呗䰪(i cI|/2mp]P'JayBEI߉/Vw,\19\(#wٷMles."ȜL2wO߲#E'" g%^%@E'kK|fxӹ]XymGc`t*ZVQKR; .)Aiֲ:S%־_ҞbJ-JUZLk.YwO|_|tBꀍGYRt򍹿/ .dUJHS5Y'OKV5֌3W.j zzV@Ar8Ji~gלMYbU_e";uI!^p٫gv_(%Qb+|fݣ-2-<'jb!M\4U+jOXN|#yFY9q2loJ(Oo3i*Z oO\,4Տ(+v<dY:'梛KٟHzP &gNŤ$zEߟ-bcϖJ8rIF9Mx Ŀ4YX%6ۦz:N Avjwt P)&w|, E(_pqkQQ띴=£^K¿}p3Fh{ADž֟^VK(l͆m(vJ%0mE}(a0YÊodfD$Ubɩ4vImC-۔]ixyzUk:o 8riQ|V)I OɊ$m-{p(]ZjeHӢ ^RC >rƧ*G"؅IƢdWZ%]زmؒRꪠ+߲sMx@+D 8+a?^W:֯xFB|-M!|2 y,l6ŁnAeZ]xo; ,X9$#yT@PZ^]>FÌ_׻xm|%TsdcWYW =,K 7Ҥ- Ņ腢] Y֖B`ov=Ka1.P*Xl-_4ݿd䚵cF+дv[R[Bk|n[Q)]cyI"Y$At0]f8 ]0E&SW f_Ċhֈ_ kn~hlmVeyۤޑ)X7k ɪ84zU\oTݵ{y[ɢ4FYR|+۫ҹtz,MjL3c, g޹L^QIn5ȆtEVLB $;M`Eֺ#H/I Èy&Rt%~;$8z$ߗЂ'~7@/fF'ФB%'cP?wXZʈ >ߘ/퐛gӫ _7E]eoZܘY9jD=jKYٍK4%i*[օ\iQ* P^UVNY5gכjfX%v*yr=GUn!Ժ"f{TpԾ 큺G3QIYi|3k&&1?7MxZ$ǾP}W!84 \-[T6B?ц6_UBW='SU2XRuPLrn$*zv#U$< Yٹ˲.N 䴸ezaqP>5A)_6by^=zgQJN%Ѳ|hd$&Ίˌc-H\<ן-O1LkP[R]+L #) `E֊`qQy_1 ϰ&0(g7ȩ$Ӡ}&Mʖ]k^Tf6^6+iֳ ?SO[vͩ\3 M40%QdNh9}Q*jSkNKu [UvROAfŤcrw,q;:ѻzQ:Oj먧WQ2h##q@?c KpǨ 2X$tM4]$nǦ;!n,o: "ho5KNFl~|ÕksHFFzspy[D;5v{<Еgot[:U ƪZe]]<8JqB $]i%!:Lh߱QqIIQ)k9|dTkDQjgq鴟>!wcg^.9/*ҨMO#.zǬF_%zOK3}b=Re_3r8Sn]ڼQ +gm]fw^L6l#f.6)MsK瘷dhR34eY]@ ,Kշ q. %71.yW@ս ܬ"ȯC-@;w <[9Z_^ѴΨQM#^ I5vJ7sz\P5ZtJ7ar9)[_+^&iݑ>##XzpKuR' kW욦kJ׮[hőxfM3\J. s`i:Ho|vO26}sTFk^-Qf黨7[TT7kՊ]Z/%dͮlm꽂q\+?޹_7O{@լ-!I8f>D2$7_񱝸r r-|9,K,6^^d8෧WNפd|g839~S6dd6rhDFNG-Ya%˫M]R, FQN|޶_S+5w^j&rrcӯʣn@ q/wȟx&ؚڧWF's=6-cz/~}LKcͱ:b{4j4~ ZjqZE{Z2wӎc 0Ãma։ Ev{?0- ՅsJ^Xp#Y+);}nT~Pw=Іlڑêm˖.𼈱l.L:wDqN ^TA $m34> .TT?hJD6ÿhngK/Y9"s$O}f ?J[/˳P6*~WL˿ R6fѬ2:*^U1ZQvτZR_/#Ւ~A ߬z'Z4%ּ}S0akW0./m[^}i4?]M ۈ"ZL8d CTvgۆfO}sԱKBˈ.Vrj ;VuV#xmJueamˀ [ْB[ƿ5b >mDZ,9Nk-Tlja(#e7 7 oKe+Tb~fiAlI9cO4hu`O 6hy-{Hҏ4fo♡@nEʷxѦWh| gjpSVBn[\d&YeE4KɖwXgujkNpϪwrAwyYsиu.Md# ruIS*"eOngak!ݖ F6EͽUM'oB({oo\24:q+GЅWW+Vdh}9k?5Ѻ, =<Ey$󁠏$#TyVLTm)}KmݽpI0X '|9MT/Zț8GIVZ-FRu}T9䬱?P4\6ꌯ5.)H:FlI:ZZ$-~ &_kAYJYiҏ^i .ԍT-wtD6X':h u]oy՚j?-b *បLQܔS M", $s 7Hɼcv](.eکiP_nZh$xٺK MLϬY= EgEK%WdV}se;3㣕xWC^Km{Z74P/p@ȝ(kUc '8W>ܴ^)XY,RE{lĿ(;PC 00}vT%q' NT9񱶿Hk y;_yA OR{ڻ";hsi9=sԱ~/juz&to%NY࠳x7޳m<. ^"}oY^ԘPٲ:}ԷN[9 T8ӀWd?s"*^52GU,Xkp݋()]X~ΏxclTx6+=XCǻu< #ʼn5uGƃf]k/GD{4PAД{AA"<; Z^#g%͑9r/rS_G?Eok}f^k/}Lt}G7}YѶgKfGv̀I38Ճ'uC=˚|qL>8N{ o,ת1BF:#ʠ" JrǮS.#}2bOka,kA-ϕg_o }O87zQk(JDO9p'|8 Ը OcbVD"s'{_# :[$Naw>cGJ\FF+~xԩ\N)[804[wQDpln~>jsw'eG{c5Ԥ:5nf8x_6FxD<|˷dɧࣣnA5)U6!c6/a:o9OM [kq65dE< !(#!q9w=ܕ!#ق©RP8 P YʼnNUv{ZsX9Caç~icXKxtv/y/C*ugIi9u<5t8bTF@zz EĈƝoQEXFpf}@兽8e$ƃ* SAg1^Jn?-Bķ 扅:spzg&Dex^YPdN E#YYPs?clPp44kBڜKZx.?x]hEȺY-hyFIq9FW>^D`Y‰fz7W(1NjK}'.d{4GfW%0O-pB 3;i0dSzGR^޷ p}KGn}_9 כ)cFhx0ZRRO:g-}VNpp\g+X#oE>Y s4Q 'Ey.#}H?GݻCdMTh oQ@ok1LPW<o[姽ϢhQ)ܽnͅXȴ&jnw>QNf+ Lv{|Flvٲ({ υeK֎HEPqxE{UQK8 4-Ři6dޅoCI嫎 ~z^}Bҿu>22G5J7cc:1oAI]NW>&az. <7-&AmaX-mG ճ\6},MaY;Gqv' R={k=hk?ָ5D^_D[qmFY1v+[xa3Iө;3CgĠoY7mskYF{lL yՒ:I5Ixڎ氵]$՟ϖmYJVzYBM-( pzo%GO9qEP^g7:\Z"d}D^{jDdaHvP8ą'o\n<3]|8C;w@*]K쮧ƻ}a-^ψmfR[MC_y`apZC358AvPvllCmzQ8ޣ c[m͍RΨyl;kau5-QuI*[i,Uż4d8%К^L1[j;=mOMQFBq/frAuvvqϞ)ZPܥ#!4wcyb5JգY_VkCz%31d6E1pkU[FLާ}n#׮=`8%;#V?{=5|*=kONfx#L!:1ܪq)o\(HWӫ)Iu&Ƅs)_Mz.'~/z nmuP\bʅ:ݯ%ᩝX0.`~𐝏Js X\JњWq?;>dd(kK;>Ƃ+={pb Mt[#~Kʌ4ƲQ󽷥e;bp,NHk4+x-w$c1>vFQUV§i>.~X˚X鳵?LXt 4{i˪tʙpaP^V_DCY= }6JJr½n'KlJw[O*p,f c^t;>?eҥLm" D`f&F= _g_RQ/BVkL@tK;qɬջwUv^._D) ~S-t;c~7uY9%x4J4\BڥSkS1y:Ar5p>E|ОH]4q,c n3KLaC+|Ҫj88W]t5sJo;qh!ے%Ѥus]XnT{Һ.m' U洽/DZҚ8n&Y\<#Qzҍ3_ =>hٴㅏf%".b5#L{Y~Wh/ ^2A"Y76ZBrǬGzw޶o9JVpmJ κ}yMwFL2$<\fÎO|[ɮ1!%ȃ8G24Bڸ\MEfk~Q͹zQR\GgC[ύrEH]nBR+B9}5^Zٶ.+^ߋWޑW6?rϖU\[wv=^wʖ*{'mAIyZb}SkO?pC0-'rT9ArODInYQsdemE6#"ٿl2"b39A@B>?eְTiFNF4dbc|_=ݳ#|"uos2%Mlv6?wmu͏-U-X;z |&R jlP5FXOtd4UXTի62Õ쒭glQV|Ao@#i*~V>e!F"}>(f:xf-N:c) d7AJ7z$1ތ{+cמ(PAyGlG%\Oώ9аp0ΧȘ4e^k L^uzE\ݚ^he7;~|σu%Օh[ٱCA_܏[j R-C)zNjrv NOE^?\.QST9TOMt4]_gxK.Z:Y ♒>%I pȐ?un?˜]tVlG$ϚSWN[hѺ-Ox! #ιhuܲ~>[u *\Ω5}rf).1^'g9\Mc5;skƃѱnG\$N+gӿCj706ȣ =?zS_HC6矒.4їHX֖agIcbֳl+5`I:ݤuDzp3">K=YuN]uy"cc|^GX>GLztBMx+ ng|mI/S3K't]WyzG{xxCZ]2.3igJ+"&!`w,bܺ垳,lD5p-X3N':]L{>;0 (O 'dΓoNp1:g"Nek@}dCpfYlڥ3*%w[h4ƑЖܮék|jӬEM{q<3m',8=F;uFg]-S}K3 jE"bm.j^*.r0ѽ4 iie]IW+h~ WF%'3\u1JWYiWEdq Nz{L?Ǽ_ĥ$h)0xz,2$^<ܒ1?^#޶ZٵHg\l˂gb2HsCs4U'K#^IzW=pʘ=VT8`Lpy[P)\]"U6ڇt1?23\dJh}2Y'"㉾CO;6R9?]["\>ٲː%Pou-7WŖrDތ;ųd^X$ٸ(6XW&@pe/TT)W$G/c]%ϱ%iO{LI>+C_Qrѕ*+Σ}H;[; O] Z[ 9/ y+K[/r5$m;+ y 鉷qƟ2CV4ߵk˜E. $E(:ϺN${[Y3>u%3^dJJ_X3s̹^EVW= 9ujzTѕ+̅2H>sCЕ/Ⱥ_ߟUud.;sLC$;3Q\=Kmf5s</ɺ5],-}l{z4}<2B\8Y^tA $+ l3%n\vsLCCMxW0e^8RR2;g͇w;P5P.PmëZn^ZbU (I< PiAU6]SZe?7~V[mK'_K.g]\e|ui)||.F-c/yI]@@S;cow˦磫NvC3eQ#˹)m ƒjYosl*f}jşN 8qfdiC6$[ݽ߮g 66VzoX,D{)VoB'δrR]SUO/c7hR?[qZh-'[RZ?|}=y?-]dd/s^TjΒ=k-K NuL%cDK^Hp=96=ahU=vxrDI.+.cw_iJOX݂)/y(yz1n*c7M$:Svڤw\%uթ7냮+mysUO;UR=2'{ q5Ow[.KnjQK&ql*>PGC~Z7+[_AX1жOun ]C@'Z9v5]̍k0㳵22 [iôZZn+{MϮ*~~k:У{|{z* #E/չ֚m/Vm~衪1;->؈㨽j;z-}['\@kkcU8S=3vw7b=yD<#.U;I+֬5֬=RgH4= fo=<]̂KY[?t>[y꼩CjMtﲆ~ceQ Wv˹ֶzh=|J¯?G$qwN="߲~|=r6s-R;i6RkKjIm[RމR$9^,ߤgW)拆Ѷ*7pr(zeam/Β+WIL5_/_-$'xW#YGXz"1RQoW7K켎xRrjiM;Q'##s̜3Ә!4hUZ'6=]'[Gp֏܆OO~Җτ1p}QGryOFeʢ9s:G;(Oyv?L۪ |" K3:J՘ΏJ+>9p@ޑ;Pu^t|_ ~/5;(ܱkgmvVQvc aWdk1rPt9xUU|TNZp|o Ȝƙ_h756mnM7/tX%u\G-~FOKwv, MZd5YeAk}d_H_!lYS7B[4 i/G#cjãkJG3'ҭ\x'oT5.ym{R9ܞ])$~>bUx>[c}iv:SuGxTew.Z*襳uF)}C"crڵTR;޺KKiam~XϞ56[4Yro)'Ѭsk!{,|+b:%S  /Um">/j_(޼8%~r*WS8E`e6/gy|-#i*'>:Ջ;]6.2nS vGG] :U\s,եK!crwFZw0>z)Q(nKW^ JsO{-PK^:CezzkzsٖG/.=ҥ9Y˿ȿY'\m:߅qYq@jMKCZҽg ~e9y!gy "2dH+wC3hm obOJ3mqh]k-OKJ`rTںʣ38G.x>Yҙʴ @2'M@W3]eMuNz?4Gz054K7F5n ב90:-yUNFWI 7Ϧ0T:3tj*=i3U>'jgο׆hR)n3YAYorĥV4kN}Uk-ZuSj" #ZYO߼m-]h>tC륪_TXm#n~X֙𣚩Qd^Oj$qGR94~=xB㷝nkԭ]-Юu?yc- z4H6>,WgdgD!+ϗ_*z>SuYٶ.i:,S!KW0?ҧr {]MRH:(^O_OZ{S<^?O?翔?|~Ϣ㿼@ݵC"kFwz z.% O!?5/?(k?ϧu}dak_o_>TO_?#T8yr}RGA% QQ^];#itT{䬮}Z\pHИ)^EV*l5+Cx̘ gHa!B`R&MG"(LJdǦDFwxsFOKUeIvxfHƵylzw qfQlKu3e ْ ǧd..[pK0"_z}Vq;ۤEI :e]G!0;(b0'<{L̫Qyz5y#/ F S݅iNDhϘbi6Ĩw`k*2N> %=<{+K+(d+p ` kB@:zș0Shp[o~޴!h їH"ԞQh4/*1rl KYj:xg{З4Nl\Qh˪M)l@:/p,4avEEпBwF!O6us噝筳ZGAT' +Y؊jB933 Ԑ:d+dlc漢W6LEnTϕ+M'\gBa&/ !CZqSKnM@e]RO 5S@=V5ZQ\=rR>z HʄÛ} q׷Ik.4jFUM=Rr+<^AΖ(B$Y̠H[-n'/=0R%.қң,3}EUJ#IJ߻|Q{o-HFSKͳ@-ˤjUyu^ޮGM="-zm^AgoPyݖQmwHMizu@J^EO: VߟX(]F}c#բY:{n-yio=hʘ[T"0 9DXDcp'9>ԙ:MR@m|yj!9.|rD m_>iCrk[32/R%]rWYG2g{9 ֨e9:6W6c5QT <ǽ{72ê= MKPDa1ҋKpť]gdKk#\43LErq&OӳD Ĭy\yǴBW/ȇΌ88&*|~ݏuBW݂yVIze"E3o~=?z}k[M oZ~4C\Z\ɹshkYmȾ^65n}>bmrR]kqʡ9Wk 4m;{o~nyw ڻӚt޹P7 Z[*w9s.+.ZEvz|QFAeO筠A ,~W Z|1<6ؾfHŔެ`zN,@/+R.g]aG-X]nK3MSf8w_h鷷 P:Ti8j!+B*t?ο+χ-ԾPq]ji܏6q{2$3L'- K3֮Et%Ӈإu<>'~qJ]|a?H^a"{'+(h7l=ȱʓPf}ov&BN$SfC6&~ٷiRK'se3"sȾߕ;mCzlGʚpsf;߰:|.;f!"._|/F3ymrh$i3f9G 9o>0Op>Qou1S]J +LA,f&觌4B5FZM㐴)α5RG*Λx褷,Wzj %"WYi?g1|H8Eߌ9*-P8J}ڎ 4Ӄ$8L'RVkqD7i5\Gc~]1V/*;\ m.7uC]mҺ-^o0:cWߜChuhFzk:lwls3B153̃AU\,?nRKtY 2YbxQ%/+u]k ݦqM_YǞ~v7M]3VSK"d5WQ1.#}ã;iu@c<;y>4,jgas zj“t.:YiYub%~pQқ\m'|i޷6 Ҟ}l] }fl5B0[֑e"' D:hUu5?axʩgx]nUjdj1nUU];Eeբs}u24-ogJS<^)Z$;y)XC??orȅi.TdJzi qHcg[zr솴gEJfڮ\'ڊǷ[GD]Ĝ[Sg3Zs 9Hgl*oNWyQ3;UxwIfXIʾż@ # :A :S}-UOf)gC(|/{zO3x{^U\-SOvHKDdҎbYr`V7CzO~&% nibi|d){)x=Vׅ|,R ;<[+ZO賬;/Zxő&=,<[3GqIlj<@؃g0ojMIŧ%<:M*m^6%v,iY81A 0i΂&Kފ_-:R :Ug2/*H 5 ͞8}^{ 5^n~uˣ $B\%3{7:+7ƍ1m !)F6_17i6Ke'KstHVd-#?mnGeIm +x 8"(@sf>cڥd~.s;>i:(klΙ4}z\64uԜ#\%=du1g(^#ۧOXoQC t;3)+ܩE5^Jy(apCYepCY+iL[GM,PS~,)KZ.X/*fOb6+l-cxeȆ5$GHyMcr:H|\*H\_H4٧Wƌ FG|\+Fy/Uzh*>i[ZE;q-WC==ڕf\;aHݠ!}al Zd暲dhMN攮D?斏O^N07ܝ2e1% /n)X*gV)RcmZO>@] +ڹ806'I]/ha=)̭)}e\IIߒ!( ͨGԎzє킦HVni$ۆNO([tiXH,wbMbIB-ݞy}Zȉ4ܑ&_'@zj SLxMB1g~[l&کD=X@=j ;6^#;#5כMư6~n2M)Q ]UyxXyxT8Bܡ$FX-'T/vm]nwW͔Z~AzͮSAx9/=fnv:`/4EbZT͒H 1ͻO7bɒEJe1 Mf^$|9Ldah˲=eiY[^ |UL@|p[NH,xt̔k^);@hA҉ r]1ߕ$(s`h}gϩH+op?-7)I1 肺''PöԐH?Ή(9ig@Ëh1JZgģ4g).15ȳDD;̙KpRlۢ}BQ̑{ kR#{{zQ8T]NuZRY뜬6pωlz|#|䵅D7W F lWMh qՔ3T\()Z\h# #@G;]ACC[\ຼ艜@A9& "{Ԏ^@U<Ngfx'tKQŴ9i4hiyW8ϋ.p^[r9 G kn̈?Ҧw4uOFnԉ|O+WbPJy~iL_&jd#D7˙h:rR7i 6!ͪ+˛|.1=/oZ/҅˫֍7móOhyt/pΜr˟;-}re_-%%W^BÏO(k:Z}U?9 zDzkhJjP\SW,t!Ixgᄒ S#['l"Uq'Ν#Tr 8 ݯ~'_%J_>kC; !_:Pe+obWE:f~CcH{;Җkw {? ౵-#o{ ?)'Oy&ںW]Ɠ3u饝;^Cw8Mgt|7W*8)5ͭFҺ bKg]c$dw5Ҕ2wH_3^etr_9Y& KDk7heJ+^rn-J'Δ,CsYwޒY/O`?NTh| +T7~Mjx-n&@N_[]+7hw+@gJ˔?H+pʑv`9w-z׸ͭ y+ziH-)3n}_qȚN]郞J<-#b5~^ztCdV069Qvp|NԾr)ljA{[;W笌R5Q͜\7Cw_y~Ւm h79uL^gwLP@=]:IH Abl{m2K0`=ov?ʩӱe )s-v2EwϳaMJhfq>*Y pxջdr]rj/2Ƹ1cy֗WJ1IhC[k+AkC^4,fFnUa=;W=~ ⲗvνs]w*8B)>[Du O*{s?cB\~1 ?$f?eMvb ]6r;|c@i;D7(s›%uqQ[WA]O8@ߵc?/K_&uWoI\ci3C5/O|˷Sߐj[Aghp4v<}Qޏ +Q97܊ZdZ{ ѽk5-_5vpԺF쁞 Zod5PVH;]ַ@tnZinYnWoYL=e߷ŴeoD%шknh`e,ٛ\穵(z:E<)ϣ]3sf9rF2\jiHҢZes^k- z2HyQ?JW[ivW4L 2+_>q_;7=VSYt>󌀪ۛjܴo^c?!\jNTcaS)jiu@˺$; )H69odw3>ڇyxs_p<#4Kο= qzc`BXh FF{V95kNI#ve8͠ n-$#''j[|.zOe-pϹ7NX$W?ЬsC|{Kp-Oۖƛ8YgkK{bύ2>5~c4S2Cz7z:5n2Ui=c[i^ռLWުY6T] SD+4_\/0*e'j|=uז$/[Yfy5K'0>=~GakT5/(uk-ϐ:*1NE/ ;RTVfQ/u%\4Y^륙 %1GZ y'XGe!y E\Suwݱ3^Yh4ṳ;Nupd{LɯYB8$l[Ymj6sn^o;?~f笾}i{s<?hh8S-"CWӊ[s "|@|<~ >V΋ڋ9@^sӧq^nkMke1 wx_cN:jA6i-17M rb[A(Iց,bڣ LLd wrbN[v$okڭCexР:.Cx)nteN>rYt/;[S#'+wYkAbP!abWTqjŊ1DMS$tmYQ@w;0氚R94vܚyl'Z/zni9oiP4/e:3li~#]pvWL pJ |>'lp _h{𣍎\.C[zhgbC fZ=m>d1̇穥Moj"xDR̨,'0;yG+YF _~WE1%7Z& I=F">yC'hac^F>/cCaM鹑SƲ<#ݿFCBPn]r^Cs禄Bf;Up/&V[p-߷mܰ"Y";n9[essF9~MS͚EЩ2*wKbdRH48f)]95A%('H(xirA*N;Xn=?i}q>_'q~cE>Xy[{;JuJ|޶q>Z(%/C0]/aEޛy0i\O,`|b}Ї?n}R#7ZAIx-hܱwiW0Λ%\thImXȮ%gix:͖U2u-p]MVɖx<[m7o֩ݖfulW`*^,r&Ԛ^6}5^_ IDǼ;1hQs]ٍ=,;E fP/fڇ\W0%56/um :wJμ] tۤG!}'k O P(䣔/NDzOʞ;dpm ш_88W I vXe]@Ι(u٥wR (h +2b<ϯ9Kf7n{Ә8G k% reYPQbs9˛tр>w}=d5]ʇ='sAE 5q+) }*xe*aebPB_!.fpնg,x%( 2O:w6^gN: jQ^ڃན ^<`M8y 6n,qÛ}ՐMԀiҀSڦRSr[7xrOZ?n_jTޢ],d׾Fb};.v׃YYN]rdE+ou^Q8XoJm`n/PmѭZEm-q׎cyWW, c\~Ω_캺{~۫Q;Q=Z{q=ʭ֍׳c΅QjXnܖ~ k/nH~R-Ɡ; ѮLZ{e]8yTG>n 0ԾaIi*̽ߖ.yܟ+wY.ĩDmoKW1Yy2?$] A v;߁&jI8iAҵLp]+ 0 R4>`xO,d\NYQR*^o}kSZ>Fwz w)iZ[ N>ߺGZK=(N}wmD7H$valLj-EA6Ԋ{5֫yQR PwNw(3A4ynMuLRS˒hdkuR-ݺtI;֬ZFfՈUӆtLzJ(!c bmx`8ۑ9$wȑߴ e?|d-󥰩}N#<٥s:k`wϬ{T8 ^۩_Bx*Fy7C2u`<9"B57F ٤WUy2fՆ|>c%4=SJޔA6f1z&5@Ay'B m_jC9Z,[F7nU~pI"frRs>YFe5OAǫ&.#Q fg2͍^c≋iW@}q\-kYI H,3{8HB} Mqrg}8`͉?eNWĂLPy_Dٸ{'E92o@R^gWH"~%/1/]7tW_&q&gy}.fLPle1hq.8 n^&2W{XT|Eeh~n$n_}{;L=1wC< nOO <G\+ߤr3+q{4Qķ2݉UIG*=܂G *Yr |Upf36G W 0WBG7tSnLOĩd5fx#zD2Ʀ.xݢs&%WzfWR: Pr](ϑ8N+T͡Z)-焬ZPq^boc_WgDH+7hNl{m\c/K٢'MFV;xET;Rp-@^, S7G }/߮7vyoE$_q#Y@{$&W_C*2ex~\P{WYt m~iBf;Y6ϣX#yK!Q@7ګM'DBn: J{s,gy6OŻeNS;SFZ\ٽ|K"y+|Be=68WZpY߃֜T^ {7dMH>%܃rn=#?Yv_g̕6g=MneyR*H|٫,Y_FAZ/w9SWh&QhKr-5G 8y?]@ $ޅ<^Ђvy·5<ӈf9W#BP+{jB4$̩Y@_-˱*{-S.xͯJP{W%tX dI*WkLz^́BxU˓wز[Dž0BSZ(=cпudә'Ȟ3Nσ3c;фL/.\ۈ]ڧB[I<|V}| PsZUrr%=Х7mK]6i3{J^9u6e6N ?HRA{Ζ~Q}g3Ǯ@$ VuC>5 ֮·z(O3_ׯ$x ,kg1q 1W_^㍖Z#%8dNyKZ$sM_-4Fq=PX~?b̉}V),_/JޠܶCj*UV $Y`|*i<뎻FJZr7Z/-1Sy`j'jo^^i9D*)W m"M܍::~vS:]DZ㬛9zji.цq[`k(#~Y=sb2)W[kl7cn ~ʵɭ66Pk<1MIhFŸO%7V-WCb.?P8~[s5Vj:TbΫnH.*VvTzFUsF6}[=]3s#FO֛^t9iU].uZzeQy^JnYj2ڷFdyReQA]UzH\Ax _uZWmiޏ܉ir@W܄:o%'g2UjNnJo[Rn8n *nڴw&v]kl;o~֚? ^'{Q1\`dErɉ͕ L@(1JyqBD+o*~ayiս>QwNaf%*(!@kL%D3%!>D]&Fjιq-4i9c,+3Z]&s\ֽ(gI{ErVLEٌ'p# _SSw/-![ 8"WutN%S!`Tg8X~;/[H-_[׸R]Mטm_OC[DDN~[W)QRϤ#.p7"q^qóNT}\a+:bZF^<K J~ZL韭V :WQ5#z[)ґ k]ՠO1EyZ^DїKv~ ֡vguiDe׾$e߆%w&?ێroB^(EHHutC9ߦ2]4TRj8i{{α6}NkG3ʐ!mm uڣ}Y@w9Q+qmMj>B \>9rZRIh*P3:^ZNn@Rx0i{3M *hHFzVyWv;]8c?\N-2zJg!כMv{:V"aK+ eC7 i6U5lOZ VIkzh a>z ;`'z^u:HMq޹݁j_Ϳr_`!jCEۮ,ۜЌ /7׬,*Y˲ũQ=#KIj75kb{Y Yxsk8Mއ* 8wlm"tޗ)^ {/S|y&-Ru3~_:le =k7äMK\Z3{yGO0KWNonW5+'99S"׫xx3~t2b}ˮ◉#/P L+;@Yq1緂|TR^5} 5?{dTfFחYC{R.W sGHrn5P@{;٨{n%#U]ҷyDTY*yÞ/Ke6q1EI&j=(vF~12كg:G<=%KQ[/gX9/ܽA|*/eTI/ V7@7J9WΦvUT[(g'P% 5P TN+ö@Y'M$oHK+uM: m-8S9Ibۖ wH*~7`X8Q5 큖G+cT>2I1r;2xVF1=4_ft'h:aiR:}uב:_io٣=iO=%qt^H3=h:~:[4R64%ReW6Q䜔/qreWGfV(&m|LS)?w *~>/Y"?\PKfzR eeC}Atr.h} 7" w54A;V$uE; Sזף ⮇Bn-KCn }?}o4yt< tkʹ~xce9A$>k~i;~%yN"lUXJ }9ߢPΏ%π*(=iwyiHio.ǫ68+*~M ^yҰ (6d(D_궸ܠvn_uJT>c?)2oYOpKP[e҄?^ڼ`TҠkfn4l,ܙ"mSD+wJC;!ݨG8d @2>)Xm 観|;~,Q?̫k{y3bǚO-xRwJKjKAeR.Cg(ėxVCߦ5;UJTߎm- (Z ?{ay9ƼQ):ŗسRѼK1 L+!sT~ Zm[rޒ[>SC^6%aqEL0 xěW>GwݖDnl㳥cpWgq$YU 2goqU\V~Еڨ8x{;JOW}enwg7/GS=C2ϕw})Ž-ǥJ-H?XH:i:::(nkblJܠWW+Ooyt^ӼO髋GZРwkZYJXeh>/iao=2O|]wTxE91¹^rye=]zgXo=)SKT%QC(ooJ"~V'Lܠf-b4OUtF-PMϨWyQ5Ҩy5/jgՊo[+ќ:7A=bsz ʦ %mYK7Z}P \# W߶\/y]բcY+wen=m\'׉J]=)[Uo) DHv^ /+Az\G7D9?ʈ9ȷr$ܽ{r'e"2(]:x <>7\d='_tSo>$e?oV:(XΙu/zRiެRU~9:[ʼ_(}|+ cq]haa&ʹ\Qhg:-4~3k,VY{ S)NeX`߲.dȬLEżJM WXRSciM#g8)li~ٽ%^ypLP՗zJatjV~hvsmg)N/>J_^H˼E^bfIO^n,uEOeY E\{Smon#!Ijx=T[5zOUI5/gլ VƂ[[o(GV`{8LRÔڭèn=~NT^T<'-Ӂ&|!׊4XYqG^ qL$wInse;B*r(idfk"$wՌӬ]uWxk4ɼXF5S4έۥzZP, p.DnukKRj:/(ǀHWit|%Kq.Z#h(a^k1^E78%ATɚg&_RI)񴁷tMG.h<$CHd}0;Nĉo!y?JswǑ8#EJkwgKkoU{58͊,tX]CvfȫvQx:No|M34f0{4vOqfs,XF/\;Ѕ Z)'r LY} <2Jʙe&5?$Ng8@ $n @1MR'&+Av$e|.C5(*[(HXLqLTA5 K|ƀ[^ūf^ӾrZI6KMc8zu֓WsuJ|wU-8u7qMgO}! Se51´>NZz23L~o>7'ʭ95salsw|4˾ymW޵ sjGtbXqsOp{NF%B$[*)G-UPux'ܥ=Xv\)O}o0S9]?h|Ϝ.:VT׽hhx;~;odk/zrv uLk[ԣԵ-||ՠ[l _x́OoEX砗@7e|CzKF>qy?9?5NcLvsiY3Ed8;4Z7z땱H) 5̷gb5F!v!S/R&k]*+Ҁ8snSpc.tLnw\Xˆn+ҫoxx5!UD)~FHh 3g\' ?=$E=fjŜb|Ƨ㨼hFg֐81;:sg^Wt޴,:^CHY)nfXNhuKhhY ɔrZa٩u;K94 l#z< W#@PHHQEYLI|̻׀^'?++ZgCsƼgnE'IݖN6w\_嬷NDnO' \ FӹXq~1`гj٘iev% V?ewsKrxh{<3`R,yP],6)Cdˏr_[О5 uw@gyGI׫ ԴŨ53uNFeۇC[|gT暻;8n[ oNّj+-Uͨ7rѻQ?;Q/A$gx_-Z:iXDDNme\AJ3ϜӳjzxcݾKԵ"y%!Wnb4׈q[9kGz.5zr9gXaPwu8O|GΧ%P~4ܣcâ :P%PHMp/dS87X!O5]fu}1-Y8ԣ MT#N>w#) lw8rCfA ǂ8mStF@Mo͌Gߑ-F 7yzS(12[D> @,5F^E#ݶiYVCPsTm%(o6yPU#XDK~Vxk(Eoegg|'9'?SP5o]vIR\2/fD'Y'θ)~ٙU2FFICsj=^Hc`։V+U9/,G_WPbՆjHO {Hw;=7!+x-Cc'[ E pgAe*9)sۺ"V_xѳ{ܤH/i6^}(E",~I@Qbe'!ѵ-g/܍ߨ /_1;}.7JIF'Z#+pRWptwڋFevsQCTS $ %g2w J0ab: }$2]EL? ijƁ.PGW>fZʋ*+^Gr31jOq>-``nXP=J_X6bTx@n܈\е(.=MQ4*%P1DL󈞞A!b[$X>!P؃Iw89s=X&)Fa9ZTu Wb7GfŽA,j/PV^a~[y}m噒/Oo0%;B굏1w85wJw E) -XC7k~N似SږOi2{L%7m9۽F#Nήoj\)/yR;žQr9C飤_F-# Wguo)7)CK/hrt\?ڻhM, 7R{{/>rFίh!o5dy(Q,-.)V?v &)^u4t( kNdWL]$M]'ZI[jN،ܼC[؛ܦ.[/yФ+uFQx%й[4k畦Ɩ{}@QQxr[uԏK B̟>KM>Z-FiIȉqi#Ke:/٣UG=_Cqԥfk^Л.* շCʻA,w "(ud؅8Pz!t֓u ͵G>zJi{▩LŻBB>b%@k;#;[\zQ@gy]N&+7=.y}W*c,s*F7*yGIտ-M[ص TMPa{,9.|$76=Wp"5~ /VpSlN 7hߦwI:[LZn{%z*x emb IY.d ^{`Li$$}OZwm}/Q%~aM~b\&tNF_h4ޘ8+.E}qÍB/:qNv8s/1]xй]^YWmxй]x+#Ա-aN:wʊkrJ?yR9?wA;ZO/ouQN,$0LpުSMudY{Z{nOt[k$|iւr6${.3~)7V<,KZ^ dw|cPUgX<Z8"O<~/ލE41eu?u;مs4]ssy˩7^WI.*X{~%Sd;7Nh4NB"H™[}[MP7ߖWE=<[#22SsN~6PܶTdSG.U:oYPͶQd;2dx_rgtb.;3s<ލ% [P~wP8,4vl_.V5ecnNk|:nGhٴ$)]0-^)Ѱ;<)i-ȍ:76}}jnbe}#t zG['xC, 5KU,uO [Y_Ȅܿl)RRZyȴD9RuݷgdE+s{;owai<nk*iOEce hya5.?RCN9SAmgIQ~ҏ-KkX5nf4λ4Ch)N4DPe e[Գ}oi$-$k k`ՙ">z&8:4 $ IDjoT>Prgw9տܚݪ8|.@ *ٔƠHrR: /IMxӋ֝]έ[%.9ARlu m?wڳ _;n .N]+{Ζ왳w#S6ojKUW v9= [>('w(|ꔚ[=EQ:L0~ANY^yYԓ)ovUxIu7"t<({vy%QޭU3@xgpw{7ƯNdԾ+De)TOc))i4R_i,JLCk,=({V#o1$p>cynZFāD-W81QnUl_}\,ei_ĕښo~*gpYJ3,mT^xtM5|U۵m.xjʨ毊-j9}?ۭOD{RI^Οdxմm@SaщOK cܿb[Ԩ5q&}iy竜|h:`ŕe 5W ukGC_P+9i=Yb[7VK]){x՟UWh(U+!t{}[;'[\D=Fsy,wW9r9FsʻZOT3 0uX6F27hWEN.0z,$PMmf3m*mj [T)i#wk"-Ǫs7rJnlO*J ;"_K%( ?:w~^;Nn>,8h<ýV]OtH ?c(3?sxj%uXh@om.i3nqЪak;PuPU6J(S;s-BjP%JD[;mMYkY+9w>l56m6%z[zʯq(Y0ţ,eÇ[cNZBM獺[4A4yg~Q1T;-~x?&=E oTF+M-T)] 4k 7voF܌l $wgLx]k3׍rb^#$|_ô\Rf4r4%%RGlgG⁵i~.[& i$>i*G7b<.kܽ%nA:8z:1|/.%c7b}9NܸAQ~R'.P/G;c-@}`HB2U<1㾹fu㰅nYy|Ws]t/4K^%Wu P @1mHU.vQ ʽ=;v߫3/:;4sZlayx|ƃh߯6oxQCwXُ [uY7.Yb5{%hn+A;Of=фP);lxer&Rѧ!oOH4(nAMC(r"ociSh6Zа뺄&dY;N {ŖkUN:]XO N-\ϗ 4a%rvreγ-DeVP{َF[6v+F酶5t=3kV^VcumgMPu#Yh \I-(iF%eAP^(f6rʮ[>9‰\pTVjLp>xڸq쓥g_tѿlI_r⻽Un={x ގ^va}ƕ>ާC[Nhkb^朸 owjZ^OhZVOі0b,'gb]Rqڪ#iF+&=yԻ_Sy,UPï[^ Ej|uaUR/۳G{6lHq܆$a0GKֆKֆƋKVc~׼z}ƒF w|W5gj;D)Y!XNVoCtSh~ Ae+Xm;dW dwږ/ >jmyshۣ,3>҉ܩkڧHM4گGmռC9a|Gi mյP JZa SrMFJ٨}6UN~ {ѳ̩X;FcHVb.֞h mcxjFhx:6E= ?,ʓ]Ӻ&tZi՘4e65N6ѭ܊soqg'gmAp3H7 (/߀nx~l TA7e5lČ[?ܠ#'4zkxN^#(9ڇG%,a+w[Xk3%aX>;6UikVDp錅(Yʚ7kI ^b<.[ mcn顙Ectx! #Mm_̈4Њ5㷸 z}wEfpF&yLQ@68soQ+=e\-@أy Ch9%7*h:{Qggؚ$l>6H7WT̤Wy{*uܡ3]W*q<6dVYӷMvI_co!ܖFaN?[rdyZB5u p֟Twoݼ*{]9CZ%{7ާfҐjXh7N@.[l;v*i_ύsBKN_M8$Kі[Q7p脘]׷tIkWG]=ig(۪~zgchAdG\'&ms &ۦS"5gV.$BY[k;WW%Ba*ҒJCS9W9[v疣v vuj sQX0Ez=;wtƌgFG9{M}1fr&,сUDETΌ"[$z?Xh{0޸C"ߚ̕bުkh&⅒Kcڒ8e!6p!5ɻO>✺`%NHM*=ԘNݪDFH{gSyFIfUISCA^Z5Ha^ݶK+{=uӃ_[nvmΐ)D}]IȾ 83k7^mǞ9:Sk^o */Ej,^|wʯ݊8܁ծ\x_3'vN3;^ͻv]gIİ;48Do\wԜlȖz[i/{$/;@ompt̘z%ltIJdv&gmrm՟́ӝ;L|sz))h\{5.RHSVW^E]hJd偧ʮ]B_xdž(k Dk*hu}hBjz 2;S[wȼB9OmW'UuKzy}Jz>%pLlGôqoL9E) ,j}{ *7_pGv8& \PqV5VRq(Vک^N]'ic)c-G~nϲF.iO,vG8#qYei]'AX\F @ rYitmuRN?YO^hIKN^EV jkW]tu+5R׍-i;(r "5ҾW2:&/h8mZ -p-KF̏?ƆWr.n {K>A(h]'ѭRP1)jE>@dkEj]'+JЬcԅm(oLq;Kw(y"/(zi7y珼rUNm8bu_-RkǽA/Ǭn?n'|{ڞx@ݿdR5lƵsNuz2nF2Ǻ"O3m9?RNw2{|O'BxfSxC&׉$|&PȒr7,7QKv "gr!Z)W<7 ºH|O-9XGTn__YLJOkXl\w)Z|;6UpH!|}s"PeP7/~^QۥG9ɿ:g3 ík^~TاcϦ=~:o3Bk_&x>jwiWi_2$W-sT3QBI]e9x{Cr:goظ\ N>i|',n,Aw;Iy{pIˎ,~яZU QtɅ˭oI{/쐟ZۖGG^oЍ(5=Nj n:s3a-{E\#"/Б ;Qmצ-n[mZFYuS{Q2៷NhUI5\}k9~щjisV/աUz2׸QJEM% QJ^/̥m{y˚^\iUN&{m^g].!6 NI&/bp'g]{$)kB2~T˨8j/[7vh =[4[WSi6gNE}4t?3T" FY^s&MH:O .oZDPQ+ MѨ]_i.eTKQ?JNl|Vx:mnyē'-x.~8DɌpQJuG.4]"U{7'hhA2Uy`Mm}CRgҤ SGs'8:>,S8_@xG`+U~?KZOp#b)\KsG+U"k"d6Rˡ(w(qrV1Efz츖su:|+nFՏ{:Ky#Z8Xkg)GhKE٬цhF=]QR[ywGq봌sk,%G)DZ*xwtt(Ԝ_r(ZS#M!0ɾ/[^ >Ȏ"Ʈ8J Z2**pvfDW)3QF3K7՝mjkhK|]Xǫ$Pݭ!-$H"G T@і)OqB,jo_ ͍׼^H!y$r#<ɃHH=I C3!9:ڋ[bĮvN|oI!aW$]Qo\l1q bS|0ZP@PU_^PFwL5ƆC0ŚAXlĜ_H270wS2d śD[E ą`b'pb\bю=<)F}!ǣ "֞ݴHi c 4:y?|G롸7ꖜ9FH2yt"qS_)eMߴu*NCŘ~(Z'W-wh۰lFM#5KE ײI6)Nݖ1$y5vn5^2*Ώl#t{<~+o?!ND 썦tD9n;5ʆeӯY>4 sKOnTɉ>5,ǎ|c\Qr!K9eAhy#u!8dZXӍm>V~4MԌWEN ߍJ⍐t䢱$CϜzʚ#saѷ碘Œ#&-U|lƏ"=/ߨYHqNx/)WT+r7RTf(ێ Qߍc%PH(˃F)r /.z̿7*%=JbnYa)&S'z3*zkg&TڢwsZ9uʡAõENG ;5([r|MHmej(QQدFY+AfTL g!uyԚŨ 4E4CZBQ/G I %)E,W" W-Yk˰.V<>kg}X#8ߌo籣 2%;I(S'mH=!"QS K⡞'  *'8J1qԨo?@OgzT8o*P=5J _cmZxf?~ٟZD); *ESϪ{MS|0l^<-¬Y׼f' R66dn R1'mjlk*Ro)u**yl^wlj:,QtwvmǖBeV%;Wy/:J ZtZJd<Ҡ3z^RymߋTW] i̴_ly?xJ.qbٻ5W~:Qɥ5ǯT/ ׫O{@~nJټ]IBHy{X|I,}lUUo ^C=r$[r_ν$vVfx릦Q9<{Cשx fKʇWxc5e.[Zh^q­j-Xw+ LKH-;c)5#U"%DKc'Ytt}8-Ѓh^18;nkGÃVA=*xITZ*n>Ru؟L2Ŕ^ˏt4AzTɎP<`V#%tk~]&*H@(/-7˝&j^nmu;=ua2[?)V(3ucٳ%m2A#yvY_ּo[Ɗ,묫XnHeVU9+G~7V[\3J?U\b/[: {ZwKf_:jpxNѵ uKۑ/睇bܨ?ֽ~pzR9BSyE.P;v}]إ+},i.GLu(o"aU|֚d׭GkJםK^Z4u[E,ť+kҌ$kgskzӽ@˫.;`߫佾caݿ$o^O&kJ~^jQcLG*ecfUwO#%VP"җ{m< =)/qo誊5rHȳuxh͢.K !:wV~ZS{F͢kH Y<%ekD3_h|^6_O퐿ep|'s }(;}5Jc??Eq ls1\Or/ZNN@j{ztT>S!=c%ȷu^ +ECQqTR\z9* T])Z3:9zpzH73j=be|^5St;UWZc8~avNZ;*,ԡʞN#yq 좸Qj^TnWv)͒SM3BjG ##5FT, T3Һq6y~~8*l A*vK鱕bAgȯil&tDT/zm wtH!]FԾJ > u {hY$Җ54^ʈ~[Z:2x.:oy̎ xr_FzW_f_S^˩oՎ曆 W╝3d7~ FOkȯF^tcKkNv.[KŚC6/ŹloFǧ 7ŝV{Ei}vVqwIaWQ4ɽX%y9!P֗娴8"k쨑Wslr:h+u0D^G;g! v8~M\;zG6uFYejw]"B⼲aPROmZ#zU'әeϭʧ4m݉omU7..ٽ2iMX|iѣ)kW]tJ[J{Ϯ%~CCCe\bhZm m(o*a+yf>Iz˚VbrwθKu.;yEh$ =} wٶrEZϬe[gE }:p*gj+=PUsHÌlbʜiljP)5+zOy G9&\+$o{&dY-CY;9qqtU(U˼>*z֑%в$o+1˻S#^#o?-l̂ViljX UAJcZ/;&5Tɵ˗:vY;(4uqpr-[:bt(-6g:U>4^׎uUu*XUg5UY~ՊuP- hWėȣ~%v(h?#T{==E %I!/ֶˌګh5b )#zSC.07>myɎ|X2xA?2#EMTlzzٿܮxΫfRKWݽ_qŒq{;Y]tK0q)PUSwmѽ~^OLj{hRۓt>J-hnKv5{?QEgT܏w+ ֪dJ?Y>)W Y^Gu:蒎D-)/CH_''&uCKEuXJCwad:$/ Nt$K<{[b-$$H\8G_i ִBG:RlQ[Z9pzWW޴&C>]h>5b,c_;7簟?C+xSƊQZ *9o2{D8"J䝷ʅҪb]UN2eIi \Ab/Z'Vu2L:X8Jae^lIc*/ TY%Hb#ڙ^%)- jOUsW/cq9W9YF孤P~׻o*䌺_@2 YNR]Ts7g )䫒WTI3u5իD99-R%!U3dQҾJ6Z;2E=Gh՞.kAȇq!Jƿ@n}6gs2iXgWLIM$UysXߤW>ն%ƂQŻ$4bcJq^s j5.G@E?B:b(2Iq18 :jP?ͽCQumEk!F,?^\ԝbQv^8&hi[˞/ Vx[!X% ;[y5s\UvX#zIՎĈ)#gv _"reyKmG|kANמ*ZZ{\;Jt"-)*1b<6GD?m^j >Pȋ-uMP,%'-(Oj~%= iX_ F#|r^r>Mt@o r m!tY^ccskwH2wN[WmI Fj"9,J^u_ַXsukV'a\n2{'Ek+[w*B ) +ׂP (F hM,{ /"-)nag,8֤;Q {I(Vd Aszt*iy[c*zTv$g[ i{>InI!!S%Itzf#٣LhHE{/>}znyT .dLlzrF@<~"F;ӣ$ۣNlE<`TS6rfx[sܑ4CzSƢCy5R8-PgH%B(F(J_TSI|x'\b?n$oK7'ȥDrVۉ]؛Ox&+{+?3ض'=Ǭ?Jm zlef U, HiVMB36۫Bi-EWd8"вd`.A2>~)9[,]e-.CIV骞U$ƝjWt'y.jF tnlfxZ~9'do4^9-R;*(K:?{tKXA{To˅DɿT~B.hΚ%̡B+Dn9o<;9vO⌻\Z'] R_\F)6 H2UjUj@%ϭ)qT'Le@D.Y3r&≈#'艳2bN-ʨ|'#B tt8qSsSu7 @oP'n[Gu$o䭦J|fj-xYQly螻YM.x2 䄫4kh^s 4d!E'ɔƬF7ﴔ_fdHaXòg~l"-$pe[e$9zbMkɸg3U QJ{^+܋\m(ҏjowu p 2@$e{%IRL2-ȕ\rEcב.}眏 ̒gѨ,Q*W_RKMW qu-?z[bJd}ӣC;RѢj M껜{}TYZm̉hۼhot%vOe$Gsޚ#J9Xm-BtNtBٴ^smG_UeGxYgF[UeZD S-T131=h@CC穉{ zTшZ5k'nEV҂eR[,clɺֲ}D"4*Ϋ݃O2AY /;~.Oߦ|f+Ɗ8tͼ_~7Ǐ_4j?_jz%i巑k2D:d~|_'/__e=iݻt]_mǟ~q-k:?|_}_~_ޒeX~Nɯ^w?1~U}nw?Dƻ|ulחNVM~߿-J2es0У.)ֹ-˗voWTn6[GK?_/P?+9/W>vL??Ct.wZ^}mz|hy|?:{rM90[j_~ӯ|r+^Mމ,w{*㟾럭[ZlE&nII=vtm<ڬ-)W6Ugb?"H7 _CA8i d"MQb nfWa"9^w7!蕩j_2^&-4荋h,8LNdmn-ToW jJ}㽣u"5y`~tX؅8,X#$xwDήbi:o/d3N96ݎN:S]`lޏezo$1đwtW-]";yCjs2ƚHRkNø )tTycaփ1+ZʧIC?sPX\|"G^\4 N6텨%yI9Kf=5S-I;r¶b\.e‚\$k8g%?zV-#I6~kC# $CY~k'.˒.|f$Oͩ]<6Lc:M&r~oxilZ_ѧqA! Q >TjW{usfj*-9X?MDK89) % c"mG8v`\P$)n@7Gl2TzZ9BU56 @` *dN]l֍KHk\jn>U{&s9|!wW\F0ڧ<NJYI:TzA0 ÀMpQVJ ^.SԶH*+Dq?c=#}j/d "Pu~ޠm L!dE^&koo4x](Nέ$wpgZ|endstream endobj 23 0 obj << /Filter /FlateDecode /Length 416 >> stream x]An0Eta6M\LHgۏ)HUE]<-n4/f-Z9+9ޏ'0~kqyۯo߫u036G݊I>L–ߍcj~^jdSAUNO65dsj!G "[J¤jL_S)2BN3ųcZ-k*jY5SJ\1,׶rb8;{{L?> stream x`P```d````b``@ J V ' GP C#JB3%@yxHendstream endobj 25 0 obj << /Filter /FlateDecode /Length 12731 >> stream x|xT̽{/ZIJZI i;B HHT $eƱq nqIKqUb'Fܹ#Dɓ|y~Μ;sB*ӻn'v W.Z-?CHK"?4=} ^8BAab(>( !!x K.^CW"} Eh׈9rlG!m@hڌ녒pd؊cZ]v]]Uj7]Zt3rCft } 莳JoʿBwØ!nE>~`5jf W 6Cwi1Qkm{wbhGrN8BeY@-BOו2{12 9. 3x'V%;[c=w.bӒAG߃t|cXE!pbhAt#ʿђQt F8xAb%?'B, )xg/s)=+ rϣ/ѫX BKt`;\47R7onלٳ:;ۧMmP_W[S]UY)/\:ibIqQpvVfZKq;,F^V)rTsej=@wLg ztdb:hރ(uƸnr8;b#ّ˻}^rjſu=Y`}p{YW]M6#Z3{K:baʘWIOK;KbkI<5iI](䭁`>*@1[ܔ@1wBOt:} :]boyOu6;\Wx:8IxjWY  p,B4 Ψ2ɥU.oI.MRL1.~F& J,3* k;;9b  eT#TOoc(2ZMYG3rx1Ő Wc6bU lYan}7'V<0Ӳ@CŦ|=>Sgpd5݋':| }}.:62&42+|O_6W8jqsUݕpPʑRRH2!5MB8u4vD( e VQ G 2 -e7ɱL GnŻ;B6cWbls2ML[PS*Iy9)/2R.mC|n)PȅPIޓN/ 9Y1e|tCq]l{oivkNB8!b pFp pQ/! X) gC &muJM_S~HJƾ$DOHRCF 2H;3GW\{)N&v0q)ۙV&0MLld&60uL35Lbb%+X2&.f"&2L,bb! cL0<&2&f31N&: &LLgiL11V&0D3ML42D=uL2QD5ULT2QDr&ʘD)D L1Q& g"\&r3DL`"4&L3ʄ&Lxp3DLH`Ʉ ;6&LX03abȄ =:&LhP3bBɄ 92&LHL Q&8WL|LϙO0W&L|ğCL|L{L;L?0{&~06o1[&d &^g5&~į2 /3dE&^`y&cY&N2 &~3L<Ϙ)?a)&N0c&~ēLg &gL<1&e(La&3qLę`"L<ăL<&~2&abw3qw2q3m&2-&ncV&naf&nbF&n`z&cZ&0q W3+]Lf????????????????????????????????===E;E;E;E;E;E;E;E;E; 5Ǔ3Ǔ@;hxD4xh mFJē*6ēSZG[Ksk(I@+)Ŕ.'-bJ(-'V->JSMi.Ci6Y:)uPIi()MFi*VJS(PjD1jjTw5QjfjJU* z]R9dJI&K(S*THiR>%R.ZYR6.R& J(iJ~Zg*%Z^禔L)R"%x '%G<NF ,LDH(iSSRQRc JrJs*4lPi!GsPNh+J_R;}N3JR[1蓸4JS3(O ߣ.w(=۔ޢ~KMZ)F7_ܯ(z%n2h/)HJS,-  `?|އ{w[n6[7 :k~ "\+/k/v  x ڐysgI(v砟4i]v)" PߏO"# jVӬvӬq?Y> G!8v@ C՛>{}w ;@u} u} n p3&p P)TkU{TQwbN\[-Xŵi˦-%b6G7F7$>h!+R]w?*?qu?7{yhWVK&VCjpծZZC+...)^]|`Qtaq_thohOqwt^qWtYfE;;3ӣӣmiڢSS)|)X\m8P+@Q!ѓH$BK W"\$sw&};K;qUpns^\đY?gv9bOϮE6c㭤oWSΝ Xou[#[Ə sNztέۈrjZ#o#ZB 1:VvhUEUuVN-c @=Z|#E_hZSL1uv _H۬Κ1/={PReS,#ۗTNt$"M(v.]6$A\5k!ORG}Ӏ歁ZV1Cwvv.lllllll\XX,,\ s]9ـYN@`&` hLZS-f@j5j@PeɀR$D@ P(Ly\@ d2!@ ?  H$.@ p 0@ @ P@ T;P2< 8 % >| _| gCx?~o& +W/^"N~9Ӏ~ ) ?< 8x8G@ 0!?|=~ >݀w6`/[n p#\ p% ]b;ac?ac?ac?ac?a|`|`|`|`|`|`|`|`?ac>ac>aci?_O77hx Tx$G%MACZ64>lVd! xUIH( P|Soz6|!SIxxͷ ?k, ۹95 8"ds2nBAㄲ¢2>?/-#y̿,+/MN[2)0e Ir^. yZQeJ5)$BaJYSIu_EJr7IsSoD&Lv83&yfl0rQV=DRGJ:f|!*@wE#poPA窏" D ]+kHÙjܒ ?Ѩ5$Jm 4þ'|xƧ1%M3EQT^^n*) #Hca(Ϙu Ѻf &^^R"Llx_ ~oVJVR^e%&X3HI6Mt^QIO+JTIjzSȯzF>h0LDB`A ==9pyQgc8M@98{@9KC89+'rslPYšCՒ̑1F*pR%2oS֟_~ ۊΪu)DVZWW4-k r?bptkyWϱz2\:sɒhV˟ܼ*̘ =` Š)H={/VOI{(DTGEe&^ўtٔ0sŠ;ӑbQ(^kQ$(4rTQH~`"e6'y b%K0#ɩa -ԓ78QT8EEzIZئvصaGn̝掲![n}{IXè2L1<>L-`360q>̂Ed!{ n8W[,d 噮ŞT se֜6ܢ/on?8gj\_Op$+XndzQz(\!P`SV rP^ly#U>$7g.s>&N{|TL"Lp9V"ܐJp&V-llN)ӐQhr‚+SWZbC4Yڅ+S'|I SLJ%3[g׶WVuu_Bh2uܲ[(Bq"y^2CV;b!rYUi >htK@H[ȼ,K`6ݨͺY FEɍ6wjk jI4f1)Қ_=3!k,R\UQDPZ XBf? SvkvM6eT mYڻ ,_EWĕCdkOP\{b@ > 8ȩ#ڰ#*m;us̍dTIJe BCwQ V;_ J66L=T,mܺ`BŪ 3iۼҒ! Y(ctN)`'6N2$8tf)y<4sgG(5S<!]1c :.ծ2;K*ZB~ %dG¢¢ 2{k%ADAFr4TԵHS éEOR;v 죣TErcu{g^33-o ZwF7STU :Z2e.r-Y`S50voTXc*X Z"&L`6{3*II̘)7 ?\7đ0mqI1&S'!z3]r;.KD~=x[R' KmV3F6(5 ;fXY|5X(T :OœkWEZs\]8cUdKW]zKw%')K8.m0#ۚ`&YQ;沍z7g7/(" r6s^żKtg.q0fr2_5TXʩ4I7Wα]2ߘ <$尲t{ZVJM \Sl3_L7uRZo8_nL0z,$筞TsQ5Z"BfMUP'&([CVބ[]}/cu</wYbH1r.G~}/n]>Sٿ"d ++O!  'Cbo`c. nOc`y@lo F2\u2/%umR2+ ?Z9-W-;?Ԃ96׹h^ЕS/[k{ϓP^iA_s OОd3e'99le4,;͙ʖӳ sy:O͝X)Yi֊22|9]rgkf,l8dY'U&C- 59BP1V#Yf}HF3̄Dn^6|OW)gU?k dBreX{4ENU*5~U lfEafWsc~Hez,͜36Mlyq#..tp?66s,j%'@&'ѽaFؠܜ dajYPvLY`198Yś!EeY Y1,a,,w%lxK_2/C38XSWjVX2KԐc̪쒵UfJے ;s YmMu35OX_Y>2Lx^V&+r3|w0;H$BgM򰘬&?]H@)a}Gą,KUVc3D +41k-OFY0NiM"8̈́Ӎd%q9,>$KV'K&zrXUDm!沐 y޶YTd$7Q|&Oأ"U {f@zP+!4hhυI1MV8F$Vj +2?Yd1:λuu:iWroM`L7mnyq2&*t0'Id#*DF44)NI)85{,T/A=^^e4Z^엑^R.5x j׍;.a ?mm2V#$|?nů7aOJ iiNdY+n{Ϭ K/9'J# BgjLJp8xSJh?*5 SkÊE.b)Nwa:;p@WJ@\,ܠj&1d-h'Ig<EE@ _ܘg:Eo%xl?0&'XReObQ6|`j,:\"19VN+S+f z1&^B.Iasr95oykd:*4*,٥v&8SYg*X=<!Wo;j9ƵtXH(|>KoPGLs{J#Ns*eZJ4 M۩:4tծLOJS-BcP%drgb[5,ܦ#dĸzT~$qyo9}gmWxY08 ڳ| SGa@SBO[5~y4`Y]8@voLzԁ|( 6d6!܆Gd^ҥ'u˃;AҙUK/pll&M'Xŵzv ߏ_nqluEkJ7kN2Ә&]-nsy2J.v<+RP~]Ҁ;?xVN<&$+| EH{Hb˃O^wjHaj`l*,]UlEBr>䓬C8@Zs/V珶v*@iHk,Ҙ+%Z4Le9>zc@%zi qTɄ+mKOZ~f R%p3;smeEN53ssgv ^ ?%bI`7y[ anӟ 1G wFy]fK.iJ0kiʼniXiH tÝ:<Z҅/U^$2/S-zZEG&1#|$B-<-F!g*4M(q;mƜ`JHb霹sJ8CݚhTp97~BBIF3xO+ *hLrr\\7 -CH'*$AFxw ؋K7f<#iןhb>1YjOsRSRgٟB{hIo{įt$BI#}$k'&mR'K]T;餾_StFzI;GH/ӤܤSiai> stream x]n0D eSMCYPC3㤇Exxzy~Y[{_˯zke~Km/uY㩝r$mܚӷqg-󝿏o3uxSS}Rq}͹ysS鿿zw\GO|T:1!>C|pqpk&MN!);$CcvEHju\mh` ; ;DqNq%_ggp քBuaH|+f9> stream x|E?~fgݛ{'rC B ! H $F M(6@bCTT,`A!3;1A|y?Osߩ;sf0XNi0@֡Šj~o?ypv}o ư]I3gF#x(W"/oH|8藦{.lRp=-êLQusayUaX?:W&v̺Uu͡p @23s/cf_d8y57rXT_W 2~\47?`v >=70yXXB(*V~hQ `," 0Vja ~zA_H a!\p9̂9p-:f6nH7L7 wZ< !k` 0v A C ̅#C8!B )02a)펇lX W Z[-:@(t `(P6ûG**{m!4Kz6׋ 5\:7rb~w>Šj?ZU=\)*/fq=qEUjӸ.z&\zAIM~빾 \?N`~]WWG\\_0MuQnsru1ugru?ӹRe3 \Oz:%\s]SUSTi"U+۸^}\?Z#N9sזU>sq?q}\;=ױ\wޏ Gp=\n/纎\/zנa_Fr맸އ:os!ןp}S\wSk Ym}uunc{ZRKz\z .EA_@<}ܿm1lE5r]!'.֮)9}zKk>" jok￭vR6{:SMq 9Sp_H/a4 \s[6p_a'w(DTGH H#$Ȼ(IQeRY<<R+gδF'әt>]Iчq r9KG].(|EZՋ? ;چږgg7mwQ8C. O(|Q ^sQxn6=쩶 ¸^>=WqbXx£TIpڶʶKnN6bNpF{I\~ߵ i5ː$]Nn?9. (<(e ɭPBso[J]e{؍Ec0NN9@~L~Al|Ph&5KQ|{SfdiËp?l[gbC=d7>-tg~P >i)}P0!! u/~E9s㋭rr~iSw8oޑ2eOSƴNa[oL9S)4/\fQ/?ZY`^ئR vX,{KH,ed2 WrR+HdJn$wp9MN- 99r֘SnUnS ŀoPX*NT"N +]1pRe2* ELYrxAYە%e.5$h:̀f:% EZKT[tۊI d+Z[-II/b{ǾvwuB.^F2Ϙbܭ<*rT~t-v]e sP`ԓEHŢY4fYG:Nԗű8Ǻ.ԟ%Dn4%$ĒY2 f),> eX?ڎ `hKci=Kg4e fCi+bE4JY)fư*VE;Ylevbsڙch[xv%vaWi[VD]*vc7iwv `kncўvMf:ڋgi M{ lcѾl#Hl3da0Me[Vƶmt ζt.fl7di{=I=lžeҡy<^`/%^f/ӑU*^gM&boѱc4fD)Nb'INS4~O':aЩ8y9K΢k&=l >ufי(!P:(CUbIwm0lE"pJl%lRjVgollan_ցu5ŢŰ`,YgX<` ue]!`=zBzA{֛p֗7CKeLoC4cy Y!tdŬb 6:rVY%8Vͪ!ձ:fِ油EЕ-aK[ƖAw-Zv-$Гndv3zl5[٭Лn>l-[ }ٝNw?ؽ^He!mb` {=! b[`G 5bl' a`(kbM0=i4o$w;_1l?zϱkmdz7N`fNd=#}{F.;{d Le߳!fas/|E N8l$at1)Vwb?o?11Cg;>:-Rf?994Ljm&H%f9@: q0f}>,W-xp~=;1<DZc>Wp"u9{,8Js"[dYde,3ӰVx)Z)a;VU9q_?_ P 5X QCv*TCuj.j~ޥbc#2_:P Ӓ!nҭQ@_/e }F_O& k|>mBQh~o[j߄`I}нY}RckL7ct+(E-|k7a֞~6ܲYo.^Μ XV섫`\ rX⺾7&WjXmp;kq . p/za#l<?[BlGv.x vC>׾Ўj_j_i_kǴoڷ vJ;ik ZDۤm~~~h8:9;p.p.t.r.v.q^\ʹy }P_/֗WKe5r}~RN^_ߠߨߤww{&}EDߦ?7F}Sߥ?՟՟ӟ//ooww//ooOW7~N]7`C16n|a5426ǍoI;{q8cbjf5 F \ĥKu\vr<\N2\.sy\. p\W+r"\\(W+uk.ݮ{\\sz ?c_ܣ埜Kt24zǴV'] [-G%߷|:oct7; ڇ^9mNe"gٿ"ǴZsNEqnr>:_vt矺7nx@t=3B2g[93h/>֒dςAOŷGA3^?Ucԯ럢~S?idf,5Zw4z9Q6)<ŋxI )<%(.EIUd)Y@PPh9W;Wݹ۹4))O=?Ƕaa={Vh;g&#n6w>{;o ~p-쀭wvÖ;pn+Ӈy'1OYsxq8⬝32s^ʽSho^c~`AFb0niDFш5:/^}y0'֮.d^OK~ev]܇O~X ߓO|2 b,_ڝ(| !GƐ ɿs%H1đd e z*2Rr+du.Fv7@Q`2[YKʕBJY)*&F{VMAoϟ{4vhE<}oc|,vrS6K)bkCحG i0}^ކMVi }MY@pK!)X`27d8rf?Blv0[{[muEڢlѶ[G[-obK%ںںٺzwȻ=>|HC0|L>!#39%_'ߒ*UUzBѳhbWTҠZvxhx0KKˁV~x9a^:d@&0/\ix@^PB<`\ OFC '=;&pz [|FrRQ}hROfC YH⚾\ uzLn"7A 낖 S)Ę$1C0e)8I6<OmхdL#9N#}8^FrNq'9 I*"\y&KH2űwThl&ق89tmDFqÓy o1Փ$x>`(dͳ%Ac7Iw[OE$u1酺~A/'`&CQ"PאבדQGf~q΁=YTQ?nP_p8P7;<@Ǒ pUM 56V O>  \y8pG\JI?MC(%؋ZB[8摭G8^FqNX@8I#"c1ɱf"pO;8"8wtxɱe"8c*=|6𑻗}|c&>=GA>ro-N@V7J'`(N},tǽ$HyoJ͙d^'µ BiD /גl22:sp,>VE V>D<ѿys^}>|sΗ/LaLcoγsߝ:=f}FUM]C_?֛''=!#~TJ?O p p4x`$]nFwd4^Fc5Ff 4ҍAF b0_~e,cw1 OqO]Ot\gƟ̾ AO܇a$߻G{4߻{,߻{<߻';=9ܵs /ܩ NK?Wa?gD'9BNnMvv v={{>|?LO~6W00?Mų磘;X7)g #lxzӇ/O?>|<x 3-B6֪ ϛ֊5<)TZe gAx*irsW6>5>)&g94(J҉ڊm3leZ[m`,udXY7ĒY , 6McE Vfz6cٕjd؍`zv7cf {mevbI=˞g/U:{aAv}NS;; xᙿស)ǕHf?j|Wz# ֡W<3B~_SI0n2V*S"Ui]2j}a-m?_^/;K^.o\|ߦ/q~>r/uB+pE fU}K]|աeO& !xʞEK(+& ~a><{E|z>DuWuʿG+v7o ̄ZX}eg0p5 xO߅y 0n|Jh>|f&<Cf.f Mvp.mo>d3PvG/

i/S\EGJXʙD _umG0F0E[ yڭsgfSzv7,D HpV `jba9-Z}7\_ڪlˎfΫ0EY‹,qA?z$B^6ƥs߸cww=Zqu-y7Lٌ{#[[L඿|wvV|c%YDXb!M˛z?||<礁']6-oɹ9Ə;f#:dpVfƠiۧwJ䞉 ]cc";y{ytCTό̚nޠD GcD~ nj=gs͙9K.ʙ&r$^~ЯK;3zFL|UFd$#9Wcx, *p7̆٥+3g`}uA.ݩ#Ց5FVo''JlfxTumљE cdfFD8jjx]2p{{ޕ7yA8((jNB+iʕ:Ef4t4\ r`t'Oɷb^?I. %la度4(@Ò9"솂FHKmP){eDaUtҠ%.h}/aL/(,51xedFۄ $iV_3wMӱe4$FV7E 6Ǡl|/bk R fܙ+guEyz4ٞ lGC ̕9E% Cp~sB#r|9Ź(Ez5t:w䥰o喙͞kwJsw~Ń戦sP.V4z3E ȍIVl VuyaDK}i"٠NV lSjUۥ۩n%pI4W.)X 2G1c9ő8}3mwc'ѶfɄ6!"B 2 9*pKpECe{#rfV Ϳ.' fzȬH;ke~S󒂕VVgN/c9he~r7o ]o$+nO#+Oy bBNBAsGaZn4fpqp,*&`HdvQ-ƼQbJ|mRpF/7sDL(fH-/Ĥn q _ 1՘b.P+nhlH sIڢ\xZne{{5آV u0ijf}֬fll4IW|t1)U>=74zBS"Zu47sbB8!w S;.u+KrZЌtg!U Ν=sjl<,o2uQ_q-gW[AMU(; r`)gq%QYcqr*0(Z)_ӴuW@s8iנUYZfG^[aC5m1o1.5|6(hnh +O-[a/n|>G1Ml.ĖZO3v+3kϟz=њ9e뉵B3߳D.ͥ k^W6gJ_Qܦ0Oo0/[ëa:_ |M_U{"y|୮aicsUƗOj|>Y2n-oaǵ|݉ns ,(cXJkeB6{UUX?E&9'`q_6s̱"^gȼVҚYb͕rqt"c9Rl(hӥZU]zEx ?]zշ̞/+]}V%]Sa66+ҢWWKo3g9_5hk"\'𱪆w==&2==lFi]{\qmq⢄Ae5eZw]_YwI~EYN-Md+AMʲAd$Y*ɕ,d$$Y(Id$$+IfKR/I$̒Z*I*%\%)I$̐DbI$)@|IKr$$ɓd$S$,I$9Ld$ْLd$$+IFK2Jd$$*IK%I$ $]I*IKO$)$Y$ICt$$HExI$,I'Ib%(I$ђDI)II"$qK.I{I$i'I$!K$I$K'$>xK%$L$$$NI<$qHIb&* DH!͒\$KrN&ɯ"I~'I~INKrJ%N[IK$$Z$R|!|&I>I>#IKrH|(/{+;-[MIސuI^UI^eIK$/J$$y^$yV<#I)I IIݒ<&.IvJCFIK ɣlIJE%yH%y@͒ld$Kr$JA{$[$Y/ɝd$wHr$Ir$k$Y--,M( zId$JB\#Ւc"=D{<y!C䱇c"=D{<y!C䱇cR#<y!C"?D<y!C"?D<y!C"?D<y!C"?D<y!Ci"O;Dv<y!Ci a<57gKE}b Eh+01l ưAsP/DV@P-J@R!\2f (P*`v"T$P@|\&`('BSL0Y@L-` +`F )`5E*`Hc0C#d6@0H@H(ʥ H/W@Q$ )*KC]@7]EeD. ,XE1EQ"tUGpr N@ƐQCF# D"Kd\ p i{c[cXU4 "sΊDW8#Ơ ?5GQ~pZ)}'ऀ"[E7 ZW"˗"tT|&HT'"c 8,rP>Ac$'"']%7D^WD/ xQ  x^|NW3"mES4E11 1` v M# "!Q˃ilQp -jKzvu C]np5"m7(\/r^'B+\+`iGѿaK ?aI?:c?aQ s0[@:Q|FB*QYY!\f (J-+ŋ  .2DD˦ ":=YT+n#`hDqlQ0/ aLyэ~wF.#D5Ṁ !ȬFE~2# j[蓅0P@T}p'E_w.B_}ͩ[@J`^9ɍޓz$=͎um6fQC8QYgDe: mZ)J@3BT h/ʅ h' T@FA!F9rC<]WL;(o#~M70u{U*W|kfK]/fòc}ϡ<ּ3({P6f?eԄ?iԆ?aԅ?҄Cمi;1m5lGi@yTM |0|(aPDye3&KFQ2"n/BYNkֵnG V5(Qnr7c}79G~sF*_M×єHJ%WnY8{a- D_p+nYxxaݹ {~[g˞=w˜'kD:_-j_}]=l'k=Qޫ]O-5P3fIMCڷH5ԼwGMh,Ĵ5.YU[+K*gbRfdn]R](0 ;?eze)yӶeOM=eܔIbʄ-ǧelQ٣0~d[gK=tː)Yٙyhݎz [$khZS*6 >!!J'`2ht0 ^|c0 z3HI fুi +@;15C`#"c<O)oכ^'lT<1' gMczey]]4 ͅ1f1A#(P|((o@y Q^CyQ" (PGyY(ϠAy)'Q@y e7c(PvGEe;Jʣ(PAيaPwfM(QG^ (܍rz;Q֡EvPnEYQnBU(ף\Z(QA.! ' ' ' ' R> > > > > > > > ' }k' }k' }k?݀.fj6} zHSNCvpt?<n<JT=P|ߙBWzo$Oē$>޽{|gݺo.~L4?{dgǘ=Pz&Dv` KJ5^~2fb }ty(2ub[O?ݦ /k~ ab{w^pykl j;55t(>(s߈=}T;xS_άH4VFÜEFzys1P騞 |j.gv!OAhdcCHvH=vu3!wRr4DFzfUo vHA"4LF"&pja5ܰnX 7vQiݴt'M;MWZ k*/oi&vD<A 'lO-RSSq:J%={Y'] ?IqEw pu s(#~ d!C4á 8!ΟU쒛ڏ3tۣL녙 2\dD̯;8wFdw5LkXKNL?LFd 9]lvsݻw"N<^Q]>"A.=" J$Y -Û߯soI}ua8X1 >t\e7O4]U]Č>cBY9s|r ;EG:F5GQ}0a豋'v ս|}z <_1ꀫWuTE9РQ$ĘHb\$>&k91`1I>.3/Jީ>D4呼hFMKu$11ɦIbzVYpǰ oCr'CRF~Qã\^gJTCwL3jocʛ0= ܞTL2p%*ɜJI^fo/i :vb⠏5Gse.[OH|{$HhC5x°#UH4Nzs5-Oz}qz'ڽwgqcnozLȊQĴ =Mjvq2$I&evX0h@N`u˲ctDGm)Us%SJר3^kn2ZM_pvWyq_uĴs  A ~geLfMJdt R;~5[|o@7$W$1Ompk:Y GL1~r+6-ۊ{67nlF /ϜiyzOL34FvG]g ||:GF6骜HoN]* Ϟץ%zhosu6 MۜI-c%ZJVleDsB9}#CU2%h.uuian|:^tz vlU4&Rzͻy<vJb|4psNyl0#gΨӲ: 4gđWm/{rA ֥ĹS -ci1ΥAAZk-z8HmiS|i7"%Mkśf o26)qh]jKRɧZsu""_Zޤ*{Ur@%.aAǧj0˳|۬Ժ'&F[T{dDiv)A5cYcӊ&n 䉳Ҫoֆ™NﲙΛt>wbƂ}\;`~ǯ̨3w隄ŽItY\E^ /Z[Z,ԚLk#];G75H1ϪΓɃCbNv5}g Hθ2`e60:`gVgɅLUϯ^wO4=WemU 'T}ou腂ˑ!Zc!D$4t=umA_yÂMt# GGRz`|p y`\h$ "bUDL,&Znw\[VFx#CHs]<7\ 0d(_DPn&gn'D-^!LʚwԤ;T:m3E9^Q?rӒͯ/ܵqۣw@h͵[#-މ.g3 D#Ǻq˯RlElExeOHK$MTa! ZVIQN}T3 0-a;e嚸9/-sяVk;ué+{kD}eyĪwL[@,mBQ]8c9z*n]:h3n\R.S.UWRtBd1TT?ӭYr3ѱP%R;gTuOB@s2 #>RSx8jO,@kdٰ'0-뉜CPy\H(W|>T_MX c|2.:eU- xV-jta z"y/4s'Z2Q)n:xe,d8֙-t!=hD]8[ < tWGFoU[՝(:pj<"h*YLb\Vq [ݫ>'e)4C90vCf%Ľtx|+_당xX:YD!h_l{OS^t] Nvy<;=4҇?M6t1AZX9B]5 ,E(E$y2x4pD]]U 0ȗ @O.%uikEo̊U@g`d%lzoSsqMպ5K)&S"e2/fC]z fJm"=¹V}xҲwP)=)oec/ByCJ@ ֣ 6IwGgIBg$!$ZDV?oqK!WKГa3ka:ڗ\=MqO3DW! ]YqL*/)+NqÕ4R8'9!nBz `=T#`I2j'I'ɷ3iJ U"#;ľ8dzzM2DrHl 儺ѯp]s/텶+ktG]^uݩر=A{xƶu ݲqR[(OؐMmt)t)GG/AK++vU+*+!#/+7^PHL+wBZVX>su[{XcYk 34 άkcݼi]XWU6Rg@3:ZWؒ# jr$wD 4Ԡ[]t@ٕ,ZŒTMrg_+ɝAΝg`$Iy4]zF\D5]C7?N+^/ǫBYzLXky*ODL/͓؜i{bd  5T|_1+eQT^/iRs\S^z!k;JSީFoYRrQ[`Hi=uUkew} ]Xb.;,۞uq4DG5k* YWlBmg pěL8j^ӆbᒬ[}xmE)U#7 Bv0_Fh,y>y}.Bu!zlsޠ휧DߜfLj5իg3waf].P;R$[Y`6Gˁګv_m$*fg1Λ{Pv0 j ${ɸ'u>i +!CZ5RiI ;'4M 먄uT}[Mr@` 5h*/-;U#YW"5go*WMTsT3#eZT8@7l&0i![TB @T!㴄3,eNpvEq"#NDpZ8J\F@kdQ #9#3%oF3Ũ_hP]ʍCNGF4:PN]ǚ{Hi.B(ALTi3PggJ3,6+aO0Lߥ%d V/% lVOCNH?Zf2[McWN0Oahm-MVT"8ƩNqgq{hy< JzU7H~+q$䲸% I;%F*8ܽRC1Yl WתՔw֪뫨Ep3_"H<5HjxO-iKmC432 ȧmdBJgzpJ dLLQQ>0Sg),hG?W `dR'vXjy38n`KdV,l1nEy21k&0jKH*Ts ZT&t8wYe,XE0)c{KoN{p tP|*be!;@CVŎO#v&+CЌ)|b|h)6l{ًSf;江v?|8\ JQgPv4%(HNҭVuNjTWȔ/ѥD(s,&9HȦqIfN;nc嵳YMTS㊅?AڳIC#q5攺^oyOʐ<j'z) VzqTQRgMfyb .() o)"[9r?jJ@*1퓨kIn9bzăFZW^@O^S}1q(֦ۘ#`67%<{y`V+7"$EH[1~2=pP ^8x\jYՌ/O>P]e‘ h7 g|?>ڵ[ ]#O Yocy:s-i8OQO 8b/#AKܽ>_v!̓<fǂ,DkQ/V;Ҩ ,~' R!ot QࢉII0NjC–PW mX1Au,X5j{u#f=s+ݼ"ܶRS!QoV-Un{_VdDn @^EQ)b8CݬcQ)=5\ٮ6;tJwWn~u*~?hQ*< LmGvšM M|8> ^w&f4ނ}00Mr8pGpE=ިywB+96 ҞC(ftNH iRthI6y9 E~Y;%Gڟ9U"M$ CԘNTKI 248 (.'{ Pv~:2SūB̴䞡ln>n ֮v;`soԝ膕_|R/m-xz'uS{b[{?(w l3΅p6H"Zn[~wD$jԍy.q$'ܦRS8st_F- BB@j;}YvL7Xa0^'.kMK-;5{;Vo{s1,Z>Bngaa}7lcL qo:؞qޡz ~0{ *dkp@#XVGp{j*K,B&P @ ޒ"j =`ʹ@D].b \ =.D$,wuS`d)L׵zb!–P\^H-M{M{5ڤ}{֨y^v.M*St56@ŧ]5Mܶ`vl6i+6ur?2x3Y+)MӁTW,H皎;liqv;xDE$uoYUqߥD.VXݒ)68+ܢG+0Wp⚖ny k=ZnfLzrBS]ZHm[NS2!﬿{3i!ݦW }椺֬x]kUo#d?[51a#Ȅ4ӳ#/jS)Ѫ9Q!ϤttW6&r@ 'T\ӻppuzUW* 5, Q Ƌ;نl}^U;l}VT/)=RM?[Ed/x 9i, EdxޱY.-8?')Su8t&$bJ'c1</ *=޹Ttqb'ٮ9h\#s_^TϹFH`U"Krz:Y{/B?vM'/$OIg5 Y%SD49^\+r~_8 2 2 2 2 2Ƞwj'"2g>$tuڃ~}zCӿoNk%}B̂mլ[TTGsSXx x'އ;]^i|?F 2@07? }3?`"G^"\9c@o aS3KqL܉b0Z{4hͥ0wtE#nKfYt)L*3G]xudӦ5'|\O}v=MthR 1Ke(>f3}=ҟY` 6`b|UR |bC'bj/ZtY|Yt?Cޫ:o6Og=4jAdAdAdAdAd6tN qg^?Dvӡw0qK/S endstream endobj 28 0 obj << /Filter /FlateDecode /Length 404 >> stream x]1n@E{7z$4 i(EI.`rHO"_1kͼհ:NxW5[=SK}.T7u?̗nVn~K eSw)Zk_>.Kuh8 CTeRs<\*48P;>Cfb Xu(M &TՄJR5 %Z(@#b1H!i1 ·6ZzzzZ m(LS2D> stream x|E?|ff{nrHB:%[ 4SvDQ"Vx4ذ!(bA $ylB{|?d3;mg9sU`EoԴL?.E2^yYɕVد`Vۂ5} `<V/[ /H^TYZMYεj6}ӱju2}GN)]Zn aLWmiM凅S/t"sv}]cSg\PqQ^PYpy ^dk`aCYp^uiS-).  ` x` ̀9d8·r:hKNP!b [cbS\*`1X 68t!A  Sa\p -p+4L8eӦu ;DAc0Fh3a>jL"XKa.H63a(HE~0x!,`D8(p1,hep9   ! ă2@_u ,Zh,l,g+Ak]"yMAt[OJ {}OЃ5sATz )h**tJEm]R,\A+],hK=wACirWzWН†K}UнW]\sA aP[`A#+h:D\A v&:MЙtՂ65TZ zkZE͂-}8G>"ӂ>/諂k]`y_ORo=&ƚz+_HAllLϰ4OqNtH3Ղ6 z z"Ͳ"A Sݍ4o  zHЯGY RAmF_PA] "hfJR 0A#$A :M EO u6_!ZbXЊ`qVt{1/S*fbF :24/S)HzPyR*}? 1)B7zГu$I12!1K4wM-v^8LjBI,&yd M"r-Bvd/9DQFqt9]C{#Egʒ 6drg4IeNK=iV\Jzٽ{?w:zZ:g>zOKO:-7.xw:.tj4/iWr0Ib\A D[on{&2j'e8EҚ\&NvV;q,df>-i7OK>-mto-His>|iq'ŁcrL9[- p^ mz!ߣI4Xr%G@O'`| G4Q̘/J}i`ߌaN3Ӂxi[``Q듁Twh]xZH3%0cJ'-ob]{{HG^ ~$~,piL*pO̚5?7k~aX1qbxJ&dRbv.J%{E LMQ(UQO'cz%ŀx"^XEI"\Dfp1&5ԑ:XC&Mp9YCUFr\M'5g3#' P Z:C}FH&F`=uS7L>p MVDam-$Z]AσE"M/³Zz-793'j,eCey Y!Vv+aJrQ,riT,BBmT~FK#ɱ4[IK e]M::JwK5B:to}]7GJ8l`|>a|a<(,W E,xKgY"oͬo-,/X2_W~>?Y*_W4a|-_2U*ɯװ,~-erz[o`& f6o[~' w0~/ 6og|F,?ba史| S)Vȟϰ1Y,˟ϱq_/  _㯱I o)m6i|?ϊ~M ~a(?J6,3F- "89VtP<uf*֙JCi(h ;M04K tK-,`ioK |,K,K x 5c!x<xO`S T<xςpޏޟH>(>ʇB4·2[X>8>ρx^!WJH Bëy5$Z^ ɼC oMЗ/K /K!σt ~2R _~J~%A:~ 7`f׷[a(70~ w;`~[VQB>om0;?Ba ?cq'xa& vIyhmN寢_G+[D+;E+;CQEQC1?Y0? w;ÿ\#O⹗<_ꖅ!s0TQRj=i= 66 ־P}InTYWc!#Ÿ&14+ Ÿ_;5p p/#4o{ | ?&2b_؄6W l~X"M6/~eKM6ۯľV`*w&6ۯľN`\XzfjKW"m7$r~)LhJ&S2MlJS"hJd)Ll6%r);LiJ.S"wǔVS"Lݔ}D7%r-h $EHS"MaJd)LS"oJ=S"L]yߔd>4%)d>6%)CD>3%)/L,$ȻBS>7%)M|cJ)#D3%rԔD~0%)LlJS"͔ S"9iJԕN)H8J8)/D9&$rxV }țt#&l![bel[.ck OO!}d_70;¾e߱{c?9s]/:y;@7acXlUJP"VVƚXwKRع\yBpax %RR\JX%NW pD?rn>H6우fP$>ٯ*AJ*aJ8=/XR|?ŢXU)všh8x)ފKAV {2T2Br fl7{aϱ E{r&Ol.ve+ۊ򾏡E=}¾nKal{=ɞbOg4Ǣ;ٝnl}ۆ:_ >S!OLEڀYjN.Ve/+7p\ Uznp 6& -;.A{>Za;Z!hV< ')nxs |S8| _=Z?/+':Q LЩt- ZLKL:Φs\:Χ ZIЅtYZZGt}}~Dҏ'Sz~F?_/Wk =i;z~O?c'3J ;=I;h' (cLafe*1;̦lհEbv c7[X+v=^eMf;]C;>V+C7>]er@y_@PH9|||R>S>WPTRVQ+Goʏ1'gW7rB]9t(W#0ZH AD89ց!PGG=j;oj@]gl2z+,FixG+W<?zÛ=ۼaCx#^q>yIw]G 86=FqG:.IkzM[}u?_ =XC0=\#(ݥG1[x=AOIgr;wp/ym܋{s?x~^G] ᓏW>G̃ys/߬_%x %O&i\R d!YYTA69@?RGr.zr+%נ6&XAjz!.ѵp5^׉7)Z{qt ?;Y KX KX˃'+$gb+ 'aV ^f]K"WYבuIuVlhYYw{HyȺϺ̵ X?"e78I*7@Qvu:%l)4-ÖAr󶁶yyK\[.yٖo' mU88mmy66aiI޴ͳlU*dQNsT:Mcc 0'Og%fQU-Fҹֹ>#o}yGA`5;2}+CzL=2I&ɨ5$2MFsKƂBn$7lRK%nDZ,.K%Z,K%ɒlIZ, K%E>y'}|D'Sr|F>'_/Wk 90Ea?_د7v`u;y PAZG< ƋA8^ J.9M㻴4l(AOAa^^P3q8/_ C+W'PE! h(DH (\u&D1bI5XLi&K +pM_F.>rr$Ր+x='SF L^,)[#:Ow? m> 닒4w94wy4wc1NSp8 {*;pǸڱl+Wqx;ql_>;x9>Žy"5<Ap$vЎ @?AO?`h˿AhϿhӏ yy%y@:1: 2"8n&/!r |_QA<1/_Awȗi4Cp#8<܅Q~Nਐ.6߾Y!8J3x$Sĺ2)YDplBBBABB!BBaBB/_u3a+@te 7|E  66Z!!ݱE&BW5ސoP@LC%¾>-.#Ed)!d:Y(F3S><^ֳ{X뭎 M;}ndz=_8+­\6o'N ͞7mvvvvvv֮=====>jhϵ/ڷQ]m]w蚮N^zS4=]3,=[@}>XՇu>BGy(s'ܗq+a< ũIς;jMx <9\߼ĩ[<{avom?Cև ܷY o>t|} fVg`$8eF?2O]3!Mcc༯Yp>MQfȓaqU8纹SO?G;؂ [|r1^b>|'_g@1Ab>| y 0s=b5/T)3-^= ]IZrU 4"4YlX=0w>4Q7 -JBKlixÓy_3x6 >x+:~6o-|_| _˯kF7M|3w{6~wCa(şgso;|???GQ?7?%o/oq%{|l31۠C3K11&t:-iڪzz+wZgX=/l5֫e#;5+xxB^BB{_%gPJ:8Z?ti/ZӮޗɟh&A__it/z<<O< Ż:S"?bx>O NR'ODžp'y{:̩u ROtv9=c]G{ǫV =q7} s#p#ݙcqc5>W7t߱pqޛqg Ԁ+z71.'2#EQ{40OZxxoԒo{ߗT;Sg9]?WJ9Wum? 7g (R= ~"N@'Ʈژ<gΖ/)n7."eכa|ϸ%%3K^_;>u Y%]_\>#˕)QnllH%ZG)5sq?5Xwdž#D\2L\,.( kOZrI+ohѣ y;vWes5*aĘ-p#qo.4f4wAW5Ŭaz 7(bƭ# ¢K00sLV[1{L?m kTe^jbl㤆,̎1]E,W.QlFdjIbwč:TlfZةg6dZ, S] :u0?9kZEzHw' N+.*vN]c46 d_Xzl\hn+Mi{窲5=5/d.XZ<$LuJFW07mOv7Y=y:a˺VO+n[=ˊvxD.5rL#2FKS0av"֕G<߅V|*0S&QfӜV{*6F\K5%N-)K طw#!JcKqFէf&R,ƠEK*: K5qflcU u;y{Yt)n9 abCɚ3Zg%Mk؜gAF_XqHv;6x%@zYٷFW-"xҗ)+6R/06)&$3 )f\`j-4V1*,aefI_/w͸nKW3C2;R3ΡZ5S=g)(v3 av3nxb<ڌ0׌ @Ќ۾Ȍ;Ȥ4H/5:o7N2n9h}b7,R2.,R2.,R2.,R2.,R2.,R2.,R2.| !alS\58z4W7Uc5 XI4oq֫Z\pப&WUGjaQS&TfBvnZWJ*do,q5` 1j9VoC,ZJjd_6*RE?OWn]ut 2ڿ%Ҋʚ҆ ^qDž(z#EP[U٘:<5iQSSԚRzZӲ 7-mj4YFf2Wsc%v2]8 5UMMebXƍhsҲ|Q{j˫+V]EUc}5v`H +cڦTWWu8U}\5eM|R565TKP$Va/h0Tg8R9RTdelDꛛPK+:*Oc̅ RK뗚g* 6?lv[[dDT;-2ᗶ%$,Q~𽄣yDa%|%K _H\gE>O$|p-"᣶4%| } ddjw%#a%7%!u IxU /KxI‹d%<'ag%%<%I O6wIx\f>&Q HxXB$<( ;%&a{[x&B³w $lpo[x=%N wH"v I$a nplf 7IQ pZ $\#op+ekWH\ IX-oT%.p %\pUVJ8O J8Gr $,"af M%4H8[B~j$TK8Kb UIX(aJ %I(0_< s%̑0[, 3%G(0Ct EI*a&I(aI+aB FKȗ0JBr%0\0 C% 0X ۂ" _B~%dIȔ!!]#mJJH,!IB $Kk +d(tL[ h%!RBp aB%H$!PB_'3}%H%KpJ%hMUfZ%X$(*HSB~pBq IU/[$3IQpTwpDa HZW@7gO%|8c G"|$8 @[`>{KxW6}ec{%%M%&U HxYKe/Hx^9 {d϶"7<#;zZ)ؓKGd˦eɦ$lݶJ_}K&a{%v0. wG-`–LAAMV$lU6*ʲ[d͛ejy 7H-`uk%pdͫeͫ$\0ay%i/FͿaulK \?6Yɲ e d=#/:OzS6= v pc؆a+{1܃n wa`f a؄a# EQ1܄F 7`uŰ5j0\a-+0qQ""+x^ZM| jpz uj%HpHm % _B~%dIl24CB_ >%xIm8)DIpHKIPۜT[=pa `W8ap{㴼 0<1 bxí8`h'*L g K$4K)!WaI*Y/πcenfEc9GT9S&K$a K'a1 %H-!_( yb$D$DI!!\BP !%A=7#;c 'W `Oag c>pç>1+^1y a؃Y 1<C8bxN ;0l>=)eB¹|p+DIX(Ų@B $J/aH-aJ$K!a" $IH+!EB$ }$$JH/!NME@%"C/Q0a/0 cx ë(1\.bQԨ VuUʂEm]Qb C8gVX-X^tErԱh֖"K 5j>5W475_ۼ3-;w7'=jc9fedG7k4A|6P6z&zΫKߋϟq6uyq#ͼ=<5#Ns!iΉNvxglBp}>OgutP wi.Bx#0Nђ%mW;mMJVM5gVV(9x;!Wl'tVxZ1m[2uxDӈV)IؔܘFij_)bsQX%O~4J ,Fm*ϟrCovysof:- an'`yig^ \%_[=~ u w^&W`?؃߁i;}r#{dh9UUJ%dee1XVf$e]9è&٨tYgHg\kxwNbEYŦ&事ZļNHv F#|`'f(y'_,k]Ԩn512 6#|XÂBUw$)4. 3ڊ;i{3xذ=ECl;5/2'҈Nw 7qǡ;Dz4Љ/X; wL1ŷRÇ 8'%;oG2IH9dftn{HG{䒸@9o ,Zӟ R,Zٮ[dd ԕSgDlNze O>M"ueIfv$kP[9'@cL s=ǵJjf$$%(P- @ynJ|S MM͎ 5d<7B`#ml<4dJ~$;2L;J;4lLFz *⎎瓝" 04=Tvjw*ďSrB}FQ-w=$8udr9;x##,eWEKKHQ$$N>wZԼloG䣄a};Z҆Ў4[ܸ/k ]9LJ!M6}T7K_}d# ۋJؿ*ΟK훓c 0׺a#!"CYg5]I>8(/ae۽R +/+JIqiNnSvC|b~lÛ\pWuD-p8+GMK~ZO3"#D/2^ ֝da2:>q?k{X*4qVLPCIIZnz ەG>].٥Ȣ%dkoԣ2"}ilwlq'FF&jf"QKIBuh kM{4 $ ,ʐS59:gux;V$ʞ6 ]h` -8yݫb ]r?32K܀>a:.Fv;-&u~e ājr|O?}": \ !x:MuKl2!!Qwtz'i,!6|u _?qoq5~ &Eƭ*5^[97zֹ6ZF.}{/88 }`Fbu)|($Zuw{!;=n5,&rXs7v1>]K.x|U`zF"H2-Hz>K儳knQޭuWA,+N: c!;bK;Ǵv:k'$$v:ÂȏA$]&gl|i7vvvꈤv ;C؊13)f~ 󊉊DBpY&#jzȣW 8kΓW3gޜ#Ns9ghшel3z~f3QIJSfegKvCl0"}x,oG: n~/N =_IjVUo>zpn\auƱ9IÓcyh|PTl;үO%͊6>+,Czs^9hؒE~ъ%K#џ8DŽ{(vcߵ&rFŝ#]]] zeW;aXՑQ}BzDz\\zWXfFb Y!Y9Je'[v]R?OPfq;wtŤGhxJIx7ot$㯱t~͢>v.v&Mho) F ]\F`?xZ鱏$$wo3vgی^ !>nXnsXAcf.X-eG [O|vAf٢ЬYc;C=+v6]̪a<82+2( Uk jEG9’ }veK uҹ)h LSxRZ-؃t= wzx˸.(5er6zk630[X||OҟJ F0{ڒĬk]>D*)'/;4#+ӥ^cFj7t0KNfdL7`LtC;x&)~~)lݐ\4KKa)( rx+t$eB7) U42:i ܛS:o <]J9{#s`n,X=6vӀ1O*{Oɏ[Qem*6砙M-;c楏N xj9#bT@/3d#+Z8?y\eC!1Aa vݮgfDh~~̪29!?TSAN{AcHL;YN/gHX:ֱ-`R.^*51,j  :_J"d+ `ې$WJcrI+x"lD(P73wpy '9)ٳ6O=$\Fks<NJ`_ VAA,Ƕ?s&:3dw ss|Bgfm .lZ/+uɃonmaOtzTrZN;)IIO@ N? opQ~'C',qF<=3S/zH̠iKe)밧tV0)$y`T'M?+;3;(>8g7q 5]kLowD&xww;{' s~װ4P>h q h3b2u؁e ]8Y+t)=99bL'O rf'ĵ Q]g@p(rB9}8S?gpCsPeG7lZEӆt-G#E. P8n@:֑M8XHy]GhKmΐLm'H*7ޤz,w'+ئqOz.|c u(6Koh||)Utߠ@[G6Mm|1ʺ#g"t7Nph|nhlj }2a^3U1Y g>0Ds"2dE>fΈˊҽ:NT]vx-p_GI+r5w;GHr?V@p9l7aKVGl3'lGWdAb809w2`ޕQvWǮd]+YuY-ua1vPZi$ptNCL iIKJ!Sd`:f:@jvmٱi:?߾϶s8q3GU}W_ou(]γ3mBO5UaaQIԝNOfs0qaqӍ5b%k4a 或TYEyJmJ)+l5dr._f{.yf){;A–i"cH$Ԉ,5UxY%xybV4& YH3a|OC2'zcVGP(: tƠƭ.# ; d%*Kvk&M6u5a5dJJ= {+WiQ4 [f2 Ԛfs4 D٠:Aephϋ/@2^R3!!pNO{ nk+o8E?=& 9;;[ _Pgi_pd` Gu=\bڣx% VV{iO)֦[o*O}l>Snrj8de<$}pśCJQE$beAU V-bbEx2 ikPh5KՑ@F  òIP})K%^uG]Гo+Bޖa}zFj1*Onwjn$i1-,tc'x_c45Q/1H/$N[DoE ZTfE:IDS>wx@Z[6,EΛ'),Bw$4֞y㯌e-e 0O ]ђk!PKHȏpW'g+K+_E[> {wUb JPpU>?PGccgX~HwQHgc}{Q}<$A R.zyrIz?E] GVЕ#ǎ 7 @6FMʒJtג_83zll-ɝFn^|yG8 #e vtݕG_;6Hʼnʳdžs~A?eوC*™wJ0DBT6ez}:4DO}*Tʈn?&iA1үPyI@V*f6zhCh ʍg+/7@$F{Fn^g7Z)mp̆'iOh>C-!upZhf!D=LT a.CgxXnOiSqf'[رVЧh1A'muxe8T2yw=Oɘ;hY!G-CT,TR)΃l2"o 9J|)~/2C+'G=b[1,zUfT^?dC„*&_ 1槎xa̖WO)*OʲF]W~ApKڋLޤ,"[|:F~0oO( V7b{NyT/zABy 0\ k5Z Cp7 +p_?>ރ}מuL: xiǧBe :el4 dF}q#/=uWS1j>E7ݾF~9Uf3CM1蝋wWȗw. ~֜[!UCј[&5q*6o:\md#(ň2TjI3$馛n6W#4i+6} i2:tСC:tСC:tС㴢;FO3+Jٳe<<ٛc[ E۲ߙendstream endobj 30 0 obj << /Filter /FlateDecode /Length 197 >> stream x] w76.-8h %H:8||pQC'{"}.{E93DѴ[Vh_& u8$~y=4KM|{W~`Ht_!uU=0k[`HtǓl=Pumi1>XW WJSU_ fendstream endobj 31 0 obj << /Filter /FlateDecode /Length1 52524 /Length 18035 >> stream x|UŶ?fgs>INH!!$ $H I 4Sh`G,xbbū"** AH${awzYk͚L@2P0tBnzZ'a1:{SJ1xtiE/:W>* Tw80|VVDKj} e<}s>CEnqZfה̅K *a=LTF0`:1aTFd(r`C ,2Xci:ll9~(/? wvB'D@;@ a4LBmgȅPp5Mr:aݡ L pi> !A`,L8.0J`jp hB!=! pӠ4HIPUPp%\ 7Ek2A z zA7YmntWQam = aA zSUUTTQ.hA -DAfՂtqqeUzNЛ]%轂>8H}Lg$[~$AbÅaA zSM-\$hA; 'hrM4[XFt\AT.2AWzzWWj OU nuAA %t=&iNڲYSP?AC 4ZεEՎ4Cт :k7Gu.2A&w Z}JЍnF = ='9A AGK +hA GЁ3k A :VЉNtfm}u^*hu.tW!kA[Ղ>*h!mO࿁Wwt%DЪ+s-5Тb0Aך"hMϛR!*v!N y?Pb@Ҍ7O%cBDH)hܛiy7>E{>xvz^8F BHMH)Y@d=yl'{1PBJrrM١$:i%^G憐6\?C6lUV[75㺡h2@'-汖-hhز9[U|]񠮭?*;m2U|E8ۘkZqa$UmhZXlyҝqmlߵe -Zq'-=jn*]x +Ɑi*eGZ[IﱖRM=!0)vDnh^F5fj^(Bƒ8̕i^g,e`$!r&A!_+ٕUSs Rh&#Rޟhh'i M]1QŽP 4`δ3PLq$ጂa''8` yyҕHGEEj%U|pM+b ƻ 4`,iyrqoX8_Ii!h6+.`bLK6ob7(۔sȹY<## #l 9!"ATu+n @<51G!JQvЎ %8K0j $ mL&SrRN*`9"U\@jCדp9J97q[S1VW۔ %nWBPXD)QpÝJWe,ܥ)2_E"xYY\()fJJxMI ^WnUn-jSx5Iړ4f@#FE"TS#VUZVEzhhZVKziK%$E[-%I+ vC'VPrڜh^,43w+Ox4(x^|gl45l6ZQ6ͥUP?VŪ?]@X- 6ͧl[DCbch{-v .c0vl9`+ eױh$[VӎQ(bh4{=NcؓI˞fONY,cϳi<{@;K4^]&4mch2{Gه}Ll;>gӞK%v4d;io}ne߱h?>~d?ҁ;D0McG:~w;N4bh&kd4 Сj4-ܖtGX:P8֍8ZF҈CS4P::su+`(T8pq-VUjѪj`>-vvj˴efYJY)9lrVAUB0fjX cuڳyll!t` !-aK -eK!]./] rv9t6:Jhv-b!=Nl [qֱuЙ=Ş { l$l#$ً6Е^n-tg[VeBOzG>eBo /З}ž~k5g߰o }˾l{~`?@`vt ϐ~a@&;ʎB;ƎPvlva4; -~laQHaF 7m Ơ4az|ڎNXAheshe'YpȳqȷgLhbuT Y0kV?|]F/8D|˽%pm;ѹU w7bnp/y7:?c'78?s|}mH7:?B#_?W6gv؜N3es[#{l|gs{#{m`sd͑6GO6G~9r/6G8眻G /r7#lns͑6GN9mJ $g\DrƥHθKqi#.]reH#.-9H˒qH|m95q5%G\#@W+XrNr^rjs͑0#6G6G":ڜ9ms&L͙N6Gmt9`s͑D+Dp$k+ȑd#]mt9H#lms͑6GI92@#l 9nsd͑ [W2mdٜjs&03I#=G qM=qwtyO>P#:Φs\ZK|.Ut^Cŧ][^G Dџa =B,v-y;[AGBG@i1-2pZu<< , M`ҋw;n[!sB@)ĥWT;QjƪpDw~7|Nhqv$cjSݬ7@ T`5DmWCXlKSUMujNեUS F}T_m)Q@0`o`R >H'f}no7[mz.7j}DzA~?Nmb3?`Gw{}~D?Ov~A_k~WSՏԏOOgWkuKVݭQSW?zHY=QU zJ=6jZ>Rcqx}IzO֧Sit}^3"X/gRL ]5tuz>O/ "}LXDTLݕr*}~~~~R^~~~~~~~~JCSK[GWO_Z@PHXDT_?C\BFV_?oП7///WWk M-m}MWO_@PHXDT߮пwo;{}O߯??/W~L]?O jf8 0 2܆7kuSiEKM]^umvzݵM[]_v~սu7oqouos~?qtֽ۽{^}?v>}wq S3ntn4}L_ 0 3 1ۙPnv23L6f_L5Af9L73L3jfs'ٓI$y=]=<==<==<)ޞ>~T@ Og'3ēdyz=<=#<#=<=cCP74FjZ&ޱwww"{ xkEqwkJrT3q? NF h/u.obY"tXw4>LLBi55`;&~j8:onF"51H&[dSyloQ5DjG`"q-rrED3Et3C((>J J?(J'He2 Te24g::;ŝ)M{l7; J@կcqϜ$v3."#(wո.vóAqŮ8O!O1Ela8Q'GęQ}NDMiT*ZDsg曓)Ts9ݜaL,6KYl,3sr¬4so{ecX6vwY.&a̴w]8 3Ҍ2cc6M{r?ݕq_f Vv{y QH >ʶ'q@ƒ߹Ǒl2z2R=\RHY}br3dU.N&LF%b,67R&e\a\A6;55dXI77wU*qqy߸׸|`<`40 ۝Ýg]]k\/] dkk#ُ7[#n;vgStݛBs'NYгSyUބg.,;f)! $O6=1t>g v}I ;I$ 7>9 -f*&Zj8-^%h]D-IKֺjݴZKKzk}Z? )N>#/ȗ+|Mvo.-Md/#*=J8=AOS4m8UTqcW AG:UԐ{]@dtrSѹ` :7d@&0I,ȇxJC):a)v~T{bŕH8 pqG&Bܘ⪝ ݎbFrRL ' ,!Kpe_Exr5:*Hu4$MeH&-ЍCށSORzx4]{*8FlF,9tS1EIscp<7Wq2 4<=sAwms'vpO w#cw{[{HњwnhãHAKњ'@|JhѓZn-{)_zf.osw[̥Qe,>ѨbFOyA2 w8ż\b^1/?1QqsP1GcGw;bܽp^|IbLSL.Rq< Ĭ3Ŭ #po'|FÔ9w#q}us$ź3)BJIڙ4mrT%y9 k/]|qwwBu`|,|ێ tpGDN5%x xf0\'p3pz!p ;/PC ;UhIۨW(EpIgҝ#d8cIj21:r}/y!.dZ!{XH.+8)8Qp@>r5z2RN6N3ndad ,0C48*~p/1FeXfXn 228"9"Jn1f |ØyV*i ts8" 2p=a_I ~nR4q)T.Kc1Kĥhq)|U|U5gן1?#?c$N"iw&TgwgqnvDPM*= H >W)b⧞;mqwe>F_H5AFn 12L#jdÌc1m1#5&<#I$䑉u7wG(Erf>BiZ"Zn 2tbe)Tc1ݘaLcQd%,cQjsx ֵ۵{^}x"݆vnq3kfp6dh<-CLw{Svg_t}}}h" MŤjz͎fkƙ.fn4S>(s9k3Ǜ3׼1k:ޜg7 Ebsy\f^l^b^j^f^n^a^i.72WWlay,MZ4Vf"[e*AJaZV]jKl6+csYbZVEl1-cl9[c٣18{=͞eϳK5Ͷ؇c}ξd;Nf߱l;~dav~g')hKti-eYh[P+̊"bYm55Y$`k0.?@{A8kvkڙj؆2@~捘Lv鍒BoK%`e2QW*hQ6ʿ7>7wJK珎醴rY[nƺù]9tr˵pȥnpgŭltsUMlfr-=?1ZBۛ?yG`x"ῗ#~{.݂Ϻ8>nM:>~ۑ]}Kt_|n7O5\\O _CKxw[H<>/*C7^0@N?0X1ƞMik<:ןp(oc!r2SxOg+<} q%T!7.0c\a),K0W_waM1vD "^ԥQ'sEԻ1ߢyĮ%oМ]X%9;fNs5==M{y(!s坟 7Ag_bf be'ïp 9ljCI$I$$H2 s`!uJ_*ԇGWaזQL<^+v򜻗uj+aO(bx7aKqIڢ5G֊7/e7Hcl{0}a yۂ_ .W\ (Oδ (ťz^M,%](8Wn,Ch^M7{SS~Aq@F9a'a "QCb 7I5b`A21t!)s|v+{ƈe4,X[s;iY3O:er~^n΄Ǝ=jòfef I6h+9)K\lLtTLj_v9 ݡT!%3*[РFeg'xT!&6K(hbRV2 Q۲dժd,v$BjbofakFw=<.fD{(VcEăH )6ofCּZkHԐWbXrcЍ$n %.Z|rnhLfaqqy" Ctіi5}`fAYU\85b4sŊ+|2)4tlHF?ib|+~|-S Gϯ|g؄Maq~|,WOiX6.Oƽ03t%'7(s=)4K YHS1%\< MŰh#4fH6ϢH'C Ǥ43cdi>xofIFhThvq*vXnʢ1r1MfDbzJPq^ 5bb஋6iEA)T<%R)oһ1'/rkHT'58k1ñP 0yhòB>uaEM ba Nli%DXeaaY~C~4,_OdGC6XQr bmRp\c y2%Ydnȋ0VhPR&Q-jgq{\ $l;/I-Fϗ+طOGیvf cWPyїy3hYEK:f7xbݘէmncLM;YPf.Q|s ϡbC SS="y s _ b;%q@V5?c;x&]ԛϳ  %* *o-10o0Tabi{;AMyvXyt6Nvإ{/7LT R;QnSo @wo;7ng *;3;ϙnu̱wa'8Wa{/7$8&:߲2fN7Tg|ag|ag|ag|ag|ag|ag|aG ݡ+t^eP5PgA P T Z)׽+! sC9:/ǴPy"VX!-ƒC^9ieXL+D_mŴJ' \c1T}2b`Fx%VthnKT}^cR+2Lu9czQ#RŨyaNrH)-"dzS/NX=JL6<뚍X-"m9vSr磪ם+^iϫJv(yvgĹ@ԓ$ͥIV!ZX(PoK9K\j6p=rY{3cm":м3R*:R-դE8B9t+ k m*iډgj7NX-3kVl{T)\G%/6KA@<) uDu誑| l_z2 }-F]-,TY+\[ڔ׶39HZ(tVNh}XẂ!2GLQ[l׭i#W[4_U$Vعq^%X/xX|F#E>_rMZX-fZilDPZϛ6<ӹFUϟGg[o^ ։qF{i=8g""mrӮRsƾ W),]TO} ͫ5)9/Y.V?j]]b4| }"IȪ<޵[/免ڪYu!U5U5ueUIeKjKjKj' ),/YS-z+Kj*^/UXQV;[[?[SU_Y\V9[EJ*fe6;;[SRX->jxk+ qEU*ʪ,Y[R'VTR[VaoyY%U5;lhXvTW+-IT(\-qוb%5826V,Wn٘R[U)zTȾ8J kp`%5IgX߯OozUy1N3a"rԻȳen YT<+(j\T,+MY_WX-.+<zIX%'aޑ𶄷$) [$.aW%"e rxw]`.sKxV3'%s]D"B %tUB-M1Ϻdĺ%𛄣~pD/K|]I.S KH‡c1=+ KxFSKU_}𴄻%|"N HmFµ v].JP!\\ sd\ $L0Q $pK+aQF 0BBP"%PB$K+G%IH0%%$HpJ$%uR$t* T7*{6I#a-RC^R ^ IX#uxdO/ Eb4H"PB ~|%H r (ᔄv~#a%/%|!9%l% a%l$dn7 +%(U $,@| K'^BZ 3!ai %R!nJ(,!IB %K#!ZBNr)RH>*ሄ_$C~𣄃H/a$$KgԺ.$t/!NB' 1$t)!BKS!A*C~𣄃H' {%+5rޓU;Rߒ7䂍uR$( 3$L&a)&Kȗ'ar%H aqJ#!ABgx q:I#!ZB"%"$Ei6?O?j;cߏ~E=P=ߍ[߆~+wп-o_YTg?~=yBJq wKKR"wHX% MBLrR HX2 K%\$a.HB $̗0OB: j$\ ZBJ % &6H@ $J/H-E"G%IH0%ErIpJ0ҒD>E C{( \9i8iLe4)RqI܋,]$5KrK/"\d͒/8g/ʽp͢\uQ"ŵ0{~5s9/>7~wzPS_\_WSG~s=]߸)ͯOe+@=xͲkrk5595Ր =Y ֤ՌdWVʭ̮ v\=J֨@yu✃-K[fvܒ5ŹEI3s rg$M˝fZԤɹSLO˝'&ɝ4.wqcFQI#rG;<);wؚܱdhRVn&M_uC᪻ :Lv(Vw8AYJKۯlO-$$"ڭlwO'iPoRWN_|U=cͰ~- <^b2:`UZǩOKeyFDx=4533CWzH'{V'S s9ä$͌R\MDKj "YqWB#S X%D[^ a#&䭣?ap#O^[_PP[nz-?)b}ϩ^-JEZ-o>Ǹ}/o!=ӟRӵtra"y:1(1HR0I(UeB֦JLoGeJ jWv|q+I'}N}rЯon]oLu#cһwJJ*z&)Q^=*QTXҝ'ЬS;,"L :ڎ~ ͛7l: {fW} z4ٿS 4rXg~l?<OQtd\BȠAGtp24/I>W{9۷oiv1M"`fڣ{PdƢ@p 7-V{+I > ˺`^x\~?*O笔P3$.ԱXdgJ~}f,2曮3(3}L\7$oFa|xJv,7@D%A*<ݒtۡsrc3 Q땕i 쾯sHsu8z(u8;7Gqfp^Mӧ%,L )}1,Cr半r88\sܓsYy >aLK/4]L\ݯ`eAv}.riNoRIM-OW>Ϯ%8x`fvIu!K' & 2$W Ɂ݀4?}#M*fF<,@EvKN?mXPа*t6iCS~)<)-zL6z< I>9|6)s`w*g.YFEQD\=Ml/ڣm>h 73!~!ueRdw|Y.M9lR[M]>JS.ݾggái=#ï.oLtC.M1 U%*|C\0e40)`Kg$&& 9)np079: ')2ASFge=1HM.A"ofݷ0Jɿ7Rq{$)]%!!0k([LtN:WuD%M33N&&w*sZtĈ1ɡ M+aYe}SΚѯattY.MC''?f݂mH,MЍQD/S洔1hRц(aRK)6j@4RAx<>?>(O 4&MFdwUBMYzvɍ3 >i@c%!&--<ٷ]q<81S2p?jzV:XflRu?#'-q_߸NÂH 9-w:UZ?Ӝ ji~A};m=֤B cE:1=k.S=s/x2.!Wpju-dޫR$NH7{; ]ӳ{N5{ڙm'Ll=}k߾ __%Wn9y7ĩ(맜~^tμWsұa ݭO)#M=onrVM%e_슈?=͊NtzTw7C +vǭinז y6ݑ):;Ϝϝ\ksm͵6\ksm͵6\ksm͵6\_H#~tG,CT GD-~SMmklDZ)o;q_@8ǧUCpEͷ6+G;*!yUɿ.6\ksm͵6\ksm͵6\ksm͵6CM 3_PpiS׺@|lendstream endobj 32 0 obj << /Filter /FlateDecode /Length 267 >> stream x]=n0 FwB7O .钡ED" 3H':|Dd}<Ҽ,KVܖ{rSv.~}UrUߦšAUnvK[)]}/9>Z;jطliT``c px` س+l-@ (¨7^dΤ#2+R++BLT`Dfz.FW7x{)V;B0'e^N9|endstream endobj 33 0 obj << /Filter /FlateDecode /Length1 54284 /Length 18962 >> stream x`?={f; !!$@@:j: 4;b^Zc!b#*v`Cل$[3󛙝33gs J&䌾}?|PO ss+ZDr}Պvﶵ?eP۲/&0p/iXU+ʟ@غ"6,xUL M,`ӃOoc54WU#"?l8%5MX뀷y؆jO]Ks[a8`ɳ֚[=8_c%@V6@֚epJCE{lȬ p0 .$HQ0a3B p lPa Ht `2b,eV8΂Ak1 b!C^=<( fC-4@+k4`iZ8}$$G?>wzބ`?H'd)%u\Jn$[ɓM/iR*KIWJIJKCHDҩtmkyJz}>׾&t6K/}Q;zq{]h2@%ƾistM~~_//at~K?߷?=7_zc4sZq?1ogdAh9D;䣕N^`?>; Sz}iғK7Rt\^Zw-O+~w~~f!SUb%s/SE" Jy2芩xD"XW<2L%eoyn, s\d/ً%b}dHG#Pv&;dv; =AͧI~}=PN@HcZP 4`&d=!I8 jq HDñ<ϼe(/@|Gx)˶J>d51)M+$LE4-/J1[`ǫ[9Vτ3a ꤄!@$ kK<51{CE۱wHNE,XGXϵ42,Ii 4Fd#磇 . ߑB 6_ɯp>p\pdJ&U|R)H ˤp)6K1R M" ˥tBj:AivH'J'i-<"&;331""x\WxBVzDMbIG!:aZH DW*YiTIҬ4re9)m$MY!:ePNVN&{ I~~FΘHs̳U5v͞N{clJ5-gԇ-c˨/kdԏ5fϖ46:X b+JNd'l-[KzS)4N 6 4mdΣZv-nf7v bh,In:~v?`{&ct({=Ag34=ϞE"^a{7ٛt{MGwٻ4bh:v !f=lbO(f_/h6}Eǰt,}KDZ}la?x3N`_h.JAv0-@$t%[2dJ -EaX:bZtoiVH[V0aZtnYkmEYQĊ+֊sZj[ʴ2fX)Ʊþd_x  wǾgC>l?v&oPCPdbZ&s7ۿh;uӄC9Ak;Ck; @k; B+[bckE("gY^A oZJ`ae"+ʂhk4d4ȥ`LwKq~",7…7ClGixކ ؇;{ .bϽ;8nw?06cw?q B=q/ nr/r~9nwk`9ns~(w?rUG~]fv9̼0aF>raOF>saKF:|0w#FwaGqpF|2~_F80ra䐣+3:ft"%N3, FtM0#. L0[G0:e3#`D聂=H0 FP&F"F8D9xFfbf9:9 v0002ad`DC8#!##FRFRFF89;d8d:d9vv02adx ##y;8Lt0S0ɱ5}6͟ѕtLZ.h+*ngэlz=?=c ~F?_/Wt/~C}{ѳ۵ȋEҕ@h1-NSjZ2ࢭ4NMW8]MWISCFt}<'yNU܅r%{hy#c8y=2яYدD8&簎xNhCOxD6X:^W=q9P9T,{7'ˊUYݲ.){d7>mvҮ#c``?Iz=Bo;cq}>EgsGc~Fa7/[6zh}!Lmy-lvz;E[Ozqp>t8vz6`=I Nt8΄ p8΃ Mp .p .+J kznl[V nNÝp C[q?lAxvh9<OڑgYxEx +*&6xރ]>|{c>s?_Wo[?ϰ~+F5& i4K-HsRT&͓K "iT.UHRT-HNJˤQjitKz_-} }(}$>>>>>W7ҷw>{G'git@UM:($TT.R :΢ H z&D/NzE"}L_ &}Mߡ.>M?G+k[;{.}yGXDTL\BRJ+-#+'˿_!)Tu:]Tgu:W-Uy|uP].V RRV]֩Ruڠ6MZ0bhW;JuzzZ]UשՓSS1nPR7gQ/T7U/U/S7S/WPTRVQCVN^AQIYݢޢުަޮޣޫnUSՇ#N1q I)iY9yE%eU5u M-m]=u[@PHݣ~~~~~~~~UVQUS߫????_oAjh.M4ͭ隡jzڥީޥޭRkMw;''ggGGcƓSƳs ƋK+ƫknC#cob0~5efM4L1}M3 4`3 5p3Œ4CDslife2Gs91Ǜ<3,0'B,6'{x|Sg=_x|nxϟЂ'")ߠ|x.Mߣ-v;ާ #z)p1[p)[q9 _p%"K S($?cOu}|VǑ$IP`2J{%~=z}Ca*6x3^x$}gJ9>g3r~F7pL)4Z T R* AI@~P?nc{ra;7'}fڬ.W3ٞs:̹ܛ-@tU#m(|c1z3^~]GFч_+N݇;{1_bߡpQ;fuAM]leMs9,5y|s\d.6 Ҭ2\b֙Rs`6MfrTo-Ʀu6̴;~8ʌ6cn'C{Ŭ}}swF$a$t2bwdD,H4Bi&'B&YM.<\ZvX#zit2lN΄s|B{~t֞_IMW70A4nCi2l)4vp*/JHB\\ sm3 wIkd2d*`׵H&]$uA2ڵ"szvvE\ŮO]Jח*UR5ruZ@"֬VΓP Rb8e QDe2LIRJPF*iJd*Y(e!WkuyE&w{dy&Gd|B>%KLeD/FC'Pd?o P d> 1h(-fca, L(`. `aj P!ڠaC(?*XqI"!#ߘ⪝݁|Ɛ[38}9 9@. P\Ǜa! C2y<)Y,OFwE"쩼NX225@JRpߘ.1O}cTƙL7Ε悂pg/믃}2bC NF4  A)$њG@ HC; hɇ@ZD;a=FUOhGoig,b}ƒ%eaY{DTw42G]>t>L_B6}0:z"zl(Fߔ' wq}Vc$3DHNODfۀrE\،|΋r^4΋w A|MΑGJ ޟ Ĺ["/A!C[X# 5xq:{}p ~G|`5~۹<5Aq ؁= FυGѫOq^؅;&3kc̅ӗƣ 0~3췷`y6o6ip|(u-$[ auۮ.k 7{^wajRj ԥ$d6M"SNq(nF6#C[8.$p\Dn帘Ʊαtr"wp ]ɝk]k!6mmیL6㓚}qIZ2G]n#8J>W񙻚5|g|ήsvgF>s7y9ќ x,g<3>3:#2@"dQ8n%'4m%'7]dZR6mگ/ȷ'mP q6B-"-b-cVBȱRıJ+QӊxF+XMXMؠpl8n֪lDmDj8>r|R[b#rVѭsԵ6"s8٫p=a^O4{%-="-˞Em=h{l{.1\jcYٳس٫^W2mfOe?m9|O+ן6|> /sb>|+W' kAvyl|w*7p.PK(Xf*xyO,IC~[$=:{wFs #\ߤa@ޗp_%qdz.gTm6RKҵ -SFilm6Vh\-O $P+Ҋm6MfjZ6Gje%e!u߹Z|!uHk t3v)JUJ5ʵTbkmH[kZ6^ҪV[iRm>_@54ma`6"V&)l*r#3cx8h2H)ԔM9dƙf9L2H34Sits9Ӝe6Kff sy<<\m1ך)i,sy6f٬yXk*X%yz2~*1 Ÿ#]*5@.HiYCɿ'Ȣw;`>r>6z0=_} e=6TDXfiC<9Wnt3 wf4=_B=|y s9/{sͿspy-a>w| G s?0s=ss6}|3g >|>C| y[N-ůW'9޶D\sk.+qͥN]ſWMa#|n'wZZr}jj#Lo۳ޖJ%fx/q |U[xFD#?_]$K1Z4*rMYSNfKX=[Y3[X[NdZNcg l#;]nf؝nv/=b'3y"{dow.}Og }+;[Ē-r[,`+ XQVkҭLk}5kHj`kf漹OCyW ېHzbO$iR&żi iT&-Ѣm~hwV!_(>X8?sPv^O@E<IW K0,ro/,g|O]qGb^lKw;6&7OKNwQ.G&K s:6CT© &脇q?V)`{{]Vل){$}}haC[]~e<|@giܝl+~>)ɨ%0e0 5b2BX PPZMxB3rXv'GOq$XU(O䱵?O#99˾yNw抷z.fϑzMM;u0uoo-k0'[?aI$d"õ_ۜpYrI+nf"c}yX|y>KqJ:g1٣Geef%' ;(f`TH1tJ{;;帘I ̨QŬe:弘o,Yۯd(Sx!{Po~V2oF)͋)v)<.XÛR$΂u; =7&F6 댏iď%<"珺w46s2NWn}w ݱ>PYhVTW,(Xi#߸N!1yCNCߙTb}b|ޯT89XC w=EG}9{kTbsRBex$'uJgK3T/*.s}wPdxI+l'x]ڙ gw O8z1-1DsP?WquvByS39?7cyV̌`w9FBݏΠ\յQըΜ2,̞!r_X[*2{0["fB6I{F'd{KI8të8%Xv0Acs'٧]5wRxtY.;}Rb;^m`FOukݡ!^Өtil. c ͞Iݧh,\̓eb{KcjbbPrc[<+xƼR>ێ3EtwBE,H V=INvnbgmq/ +L4 кTx}+^_񎜜-u6b 7*}Y&DR~PLgO6mτ;bȆw 0K"Rn;91{b PRjUc Pm"nl% x[R N :틖֗quI1pEJ}䲍~1|mRcϴ}Y"'x2AjbϫbTUٖjzȩA(CwN=,kxNw6츑d/I%V-+3xmN{׋J 3vчffl1'e;[Rt'o`NLfweͶN#7w;{bVE c;[1!>Tl(?s~ⰡZ\޸QK fwT\pN#zds&hZ`(<~ꕌ&ٿEyZTmS,M)RىAÜ!4݉0Wa]5Hp~;^ۉ=2`9N#]*w  NSӠw5U'.)]N\u ('D'hw P=ۉu2Z$`Bv'!;8t~Iv; / >JbUxf(o4+#}Fl3 sUE8{b ໛mwJȀ?YYӑvG33q/{3fm%/yǽGdv'F I\z`Z#oaÙ|3&_o_K+b-=}\iԉN8 1C+zfH6W6WaO*'EGnb~9a+(֧vޟjvߖO7oG[Ko)mkІ&,_j2x,Sۛ6Q<$zIN_ŵs u sm6k9m;^bz+c|a;6&Em/>jkuʇxnk3bmUsNZU|="mV_5?op1nk#mrNUå>/Vk<ֲgֆʞ+WMk9:z:6ػ-M~ŀ=1a}Hk5۵?๢4;RJ;u6أi.W?ֺ8&WHs'MR_\mnminhonJohά_RYVӺ:)[66W״6y*ڼx[[X߰ʻQPmmhoZmƢ5X[Tږ-lTwִy[k*x޶ AUE * -dSGcM+li y[Zv:츷[mǁ=*ކ&Vs~ oX\v\& spi/^ׯYm㰱bEž sO8*++Zŵl*Zc5I=ԏ&$MKHs gLA{kEuMcE2{5*ZN[GsnNUZ%Ha]:"m]Z" h9I@ `Y׀Kw P5 aZ5T BrqnE] ,0_<eJ0G@f !`ivE!L (0IDu"v!L0^@NWx18c'#-`Qf mf  H0R9B@"`dIƆꉢ^87D@dXQaQo(-+ J@]aS"wMC* D $2L0` 0]E,PpHA^&R 8 ,৮Y? +d6 N7{|%K_" L'>GGȇ>/` +o xKd) *QezI^|^sEɧ<)2 BD #< `lUd+w K!u.R UE7 I ": FpeW`%. B[W`5˺k.WXE6 +/ D6phQlEɳD ]%g.4QT) X'`5V 8I]h*qD+W}i&*/"Y@F ,׫PD@mW)5]VwC ŮrXd. X+T]#G'LuG" ( nt'0<収L0.)&bE"P$oQ$_d 0^|Kr|uC+`LF % 7!w(BFoB._B#ŅFHL0&2Y@0CEE ]0Xt"N@AbDdWt"J\/RQ2B@& T@(, Ht0P@觿_QG% "H]> .E.UK"Jʢ$"r#rq~13?#?XQϪΪo_/09)`xGۍ؅{x;x͖D <^5{<^%L OOzE=izܓNШG1?i9ó4!O}ԃvOJxl>syV5^-=nvF`O L;p;wS?+,*Lbi9t] y!D 2 ~!oe!I ؂.8.O`J딠+XQR~T ݾ|^,XaKʱŢdÌ气lqCr2 d1͐rq9ư&{ @5,{ *HB.ى[3;;ɆY̙1ӵJ/ R>saJWPVܹގa;X,qQ[G[bb"?L;hg1m᧽;݁?!dP}[Ta4wÂiu A% c mAflޮz9H{{_s~YY)Éo/?.W$)##=}ĈԱR$)f #.mX)c,)$v.}tAtRT~ART8 0U1Ӓ(UwI/j70oѨCwSPuoPPSdPP&*P؁} 5Wn"2rtR]dk{xpDc2?ϥqc>;$$Hs.`&5^}sIPh;Hչ+nph ov+ӸRdN?Gх aSĐq¦w_pIE ;w^߬AP1exYl7:#RrU5.'B ɠCA a>ج'oacSV._+ɍyssSИ'f42Y57{'$d.hyE4N7߇QT1{YkИ1 oA^T0e-̊Ȋ$_=+sepQ!69{:=t{r^ݛkLS|g/[AQ3e\;2W2: AAȣL_ J)ZvyS 2%w`thHL+̲\> 2dh2[ʋ}FKN˦)e>,8S<.7i!c7ͽ>Kڿ̂ΡOAO#"&r@ȟ?%yPPIrb u{apgVM^ĿZUP( (& .(0m,2xTNUHϼ 'hn ɞ 嚫S^R_4>mJE Vд$nRAlڸ,gd \Iݟ{R3\2J,kFҀ䭒''b\fd$D/%D( .d_佶!g  yqp"W+j8]v zEΆW/Z*U9ny4sԲ3ʆYyy7M/_=%÷ܒc cë{L=b@ 7g= Ϩ0aFƈq&d rx̡M4E9yt/7~1:_qNLa9AA9eH0?:12Q&MJ(gдDpp8dkg0zddǦy՞ؽcrL 9C#ۭM w4ݥF'i>exd`[|Gn2z@1kӣ .i >$r)o`pz-,cv< eI33b겿]RFTgyt)/;||$? }9kHT@$ZC " (9 Ck^_n^um{ͧPn/#G>W|#"I/cҡ%= :$4W$ (EBu=8.""65E3leh4U/~whab?Fz!+>,Ss#Rm%1~ɑv(_v=u|a>Я?YyÆ%e :p>Nj3|),L!h1pԼ,6bl /p8Tc̞-ۯwOSzzc?rXQ5 0*K两fEMw$2}\YURG,ݔM- 4fe 2sehj#r&YiΡ#BͤP{p@DDgMK<.!nBȘA,NQpRYK P^0+%N&z' g7?jکQb #Ǥ5/.C6-cs(>ʢF) -E+2KR0$Ci_C/ɟ 79G!u6{mRߟexnL_*]ׅg&ce L̮25sLڊ6vQFRE[(#t3#*[A:EE[ ':-yB+ 2t凿o|O׆MHǻggg 2gkC?r'FOD5`osYYLIB`wo!v&?w#kJI.`OjdWA=y3gfKBkM$F I&w`P~H;"٭ pnz9gޠU-nS}=ylA!ݎ.xh@JvjJ̠0Bd¡s|(G vDwP׎IBz@wq5L20oendstream endobj 34 0 obj << /Type /XRef /Length 80 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 35 /ID [] >> stream xcb&F~0 $H'?; Mh/c7v`7tH#V'H6f"ټ XM0HW6 endstream endobj startxref 202349 %%EOF metafor/inst/doc/metafor.pdf.asis0000644000176200001440000000015313150625652016523 0ustar liggesusers%\VignetteEngine{R.rsp::asis} %\VignetteIndexEntry{Conducting Meta-Analyses in R with the metafor Package} metafor/inst/doc/metafor.pdf0000644000176200001440000161472014505063374015603 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4748 /Filter /FlateDecode /N 90 /First 750 >> stream x}R>E?I^NE Hx4@|PCA_W5aP<='؞b4<5? no\o:*է)٣^O_k|0^.y~1/'Ղ-T8-ޡ?7M' 9jt:'q4Fg.}l>^\y.>2sX2sS*mߙ\NUCާyEMsop.p\!cKtNEj*x> $bʓ5L8) <3.Mɓ'w'ЃU=[x:;vMqbڕT0v {PP"}w4izb!#*dĔQIA: Tr iՠKTNSTj;K,$"!K,|",4hwDޭ=zn*1,Dr" q9NgRpq`wvZ;}.1{<Y̮R{Ҥ탷O/TLOGs BQm_T3Fɨf)R%E!"jsQjUzl@nWTTnxg=mldu`f ؟ ,u|@'``} }:;4a 뚂7 -ofh30~(eQ}4Ah^DO`7o#C_ ǫa>b[1fOS=g/{^]kvްCvĎ[+cbYŪEͪ˫z6&#;a'ٸN_^V씝Y=Y"V Vy];ÿjv9`]]6b?ؘ]d],e6e`Ʋ+v:j<.86+2y}9Jcן q, 5[|k}f__??lsTq.Iqu}dI=^| ˷'Czl4qbf  (s_#UE}+u[[ 'Y=wVEKIE(Z,0DO ޸ wUƚޜF G(\%4L+Kf/w[uT$@tKvɫ3C Lo^ێӗ]#zeu~rjӒ\k+\BҤآdVl"Qsv9oqҜwfa)v}s2-dTү~9$*)/JԂ E:PEE::G!r"Rsgy r N]9!xv9OVEiQbBNܟeW_V"ǃDȐ=W! Q2:em0uQ(E]j]O)0MT(=l]fsv9]ۣPw[C0Kca` F* ) P%:Cr :+IGuX I%LQ$)C-9A:-#{Fx,?MçbMlfoYb@Qo%V&WCnNgm ~N}xJ\t9r4"D}z4%K+qDuôT`Y#ud{ѕaw7wz뷍pTjR}-lʘKdQV(Qh|Z% `Ղ}dY/t:&$VIWz>62LWf 1` NIT-Iaͮ qU,z~כo»VU/n%{]~z* lM򶅢sY$7J~^ \Q/ 7í}zj6ōq/UuGu^o87sn;SjBj@[oG7.ָ;84tLQzn)[,5v]_ipRDtAhTp\U܁ٴ[&VמߢdO]F7.e}CdЁY<ҡɻѱI[VPQ llkKd)xsn7ZW^}IRHn~cr%c3SEM3u#nChvR>P?a(~k`{Q`ߌ1M⸢ {u^m .fm+E5XV`P+g%DV6uvwRk>LYyy~ Dٿ0ZK=endstream endobj 92 0 obj << /Subtype /XML /Type /Metadata /Length 1337 >> stream 2013-02-06T10:52:28+01:00 2013-02-06T10:52:28+01:00 David M. Jones CMR10 endstream endobj 93 0 obj << /Type /ObjStm /Length 3241 /Filter /FlateDecode /N 90 /First 829 >> stream x[r7}߯cR)~u⍕8&ZIL$RKR9 ICjE$r0Ff/AdE"шc.fa\‰0а4 'npZHOEaKh$acaČXB0xM"{GQe02 (`0JƐUH~͓Y- 7>;QSdaX-g)`=EjBDIJ&S1Q^WqIB EѳEF]Dȡ(#"YgQ HSY=Ki4d*̇F| N:א +FT^E+1wGp;zc-x4kG/}`2|2אXAr4Hh'8l+74K_ & (*v:Sۗpv7O0ѯFeK-NW*\僯|uW>x_c=VJWz ^BWyG5^B*XJ/$~Y1AOӶ<~{_:l0:n'?"g9::Ne8z<O L`:,ߴr6[P_ͬ@! p2|;;`?Z~;;[|$]#&빶N)wl&,`ԿK5PǪU'jHDML] En# UOSv:2'"<)$h`\~:m$5Q60.X:X b!^@!GQ2ME+<&[T!ToTwo w+dHVmcLTj/~!Y(2"%{dȉ1!@/8N'[K0)v@B]kd\R8ٰ6n"r~PYI#J#GUs@o_eU2  B`x^栠APp-}6a XdGHRF jIy1K\*"dj49:d2=.;9aeSZ[X 'ۤud1@][iy7߫Q,Ka0k@9,` /gźbdL'$,uJS+n * ۀ:*ʾϢX:8-+Q#wk$Yծm25i*q זNӹ?VOSzWաQP?Wjިcu<UauN?T3PTBh1.R]{ޞ̺֤Pl'DpV]_Mʢ|0=+K7{A}T6I+7.wW9ʕW'5Up"tzH0z*L4`;8YuP)J y qGd a@#uZOŀU8gPe-ֲ9Knb2~@Df] A&wjJ*[:CD)rD@ewj]6Dă]Ճu6kU5תxI6dyq7X L"g5b1B &8th'ҽb4ק-o7`rQr"t۱  ;1΃`mfBbPSv'Y12n\I7j}U_Jh*BŸ-v6hϵrQcU5 N&`vé-TΩ AtvϠ9A@}j@< P.>β3PGDaz%_+ TqZf.ԇdX*WRn)]phTucI ,X`Y'IĞݯXҝ%X b/}{uqK^=Kx6f/:8zhgϋ,okA.pq0.8R GҙQAh0+"Gl}jdp.d7*+{s2HB,nh\A~wj/.:F͆H6W2Ȳ I6 c0¤ LfTLIF0ʆ=&NdtBFӪl0O:WCmOnK[Ԝ~+f؀rQE ڔͣ^oXKl%K2d eäevw`:2w}`N7_w!D~k*7i,?Uj{: qr/'qok$8ϭ_W7xo''Gwi_ÙKX^g:9gH\ endstream endobj 184 0 obj << /Type /ObjStm /Length 3395 /Filter /FlateDecode /N 90 /First 835 >> stream x[ms6~7$N.Υv&զm58_ςDrJՑe"x> *:&iq ,8cd)QHzIEw94R *%˴x:9}{ 6H'0M@!2PJep#TXcH*3.* 3A',31P1+-]j 20keb6\R9eQR(xԥ4sP292={cɖ.A6̼>rh#{C57\<|Xz%5ZK<_k7W)2[K;fQ5cɗχ~ox Y٫谚Cx)/s'^T$jr)G[}9rXtѓ.t<]"OyE)Lg}⏺.m> }U/>-h0? OGYp6.fQPΫF2'jZBf'>dMzjTǗyPѝQr  "E{ix$w`[&b8Ԁˣŷ1TT)=o]=xqKp kw 'BZxg??;D??-wgKk;z/r+fٲyy31zj~s9bYE$4IѴ=x*Ł'q!.U3((v2o̕yGX^4C+-D4 7(IƂ3rl9CS]iɩ`S&M6~\Sۃѭ>."kNGۜ)=(d`*j(YX 5b6Q8 h^rl)tW$0nAT;2)HZ &xnS7R%ժ;~wDո=R š썃o޿ʤ0ϗ1 u4 N!°\ƨQˀit>.0Q4ekaabU=jw?yIɻ5F&VM7Jve[`>,˼Юgb3-zUEH{jz>(Z+Zo2!_,{ifq9ͷ>.ϰt?6o|0Ob>WC_o ojfa}68FvJ!ΐl5S4Cmt,oM.<ޗU@V y_pdf ro@BA=a`:dAd-P#(dTz͍Ubk'Jl|6"B3ws9Kv&X#+bp ~A6PKP.q# GBk)P{Pt[PGS-PI  c)QS,K b /AYi.@/v'(Se崲ӒAZ.A5vnה7Ae.&dO(^y#w fZb>O&8 H&7Sb[="\tJ*\@VeЛ(07I /F'z;AM.@Y7uV0DX?#Bi;O4 &/Rp;eWmPHW Pe (<@w(<ڀ2&qZ])(cmMd'V{_精ObpipZ㼚N&֢UVB]:J[|o7NXf OQnbi/>aosZ/h˵L3G\}y'Gu+/} m6]4>Fڕ^L)0$2z831]r!6e#F.iil4!}aK]6|m}}еև#'gx!ſ+8đ'ıĉ88gY5.{F\D\`VQu2KSYLLFٙKY\/f"6M=]竉v [KZĔ_jyQ~i%xԝ;wDf ,Zendstream endobj 275 0 obj << /Type /ObjStm /Length 2891 /Filter /FlateDecode /N 90 /First 829 >> stream xZYoG~_яXv \%)R!G__eJ(tU]]gd:#]#sJX2?K㪘R/fa9ze ֢ᘊɠRg ӖSoUR4+:'3~(Yfvh8fɣE 8O_Df!N'FJfh(fcVa@u90tG_y朥J{j$E`6J1$54Q01Qa*>`R|#|R' =TVЃB#dYp^e!DIgQ;PD>Eo 8j 3%u0`h4HJD1D}Wor[WnSC駍J?$tV؃NRғ(=K tŃҥ]++.-ti]f <(]v@}]=>,> _NgŬ!U߼.U6vп(vMcyRSO8\b \Cµ <¶{Tӻ*xSN>\?($p:ProSf\ ,.Rr k0R J+' 05֦:QbVq|&ɕ&L-&/8OI 6PG Rb7pp2R`B8%-&yD pLyRJIR@dzHy e%Iu ɨ>^]fk#1BԎmO/UqjQ}E~mC^& ,~vTl.UMuB7HVBip4)1{]fK\^TXl2='௟(ia*nnb{)6pQ&$g'R;3lY[@̽ ̳P5vGebwl%OXeV-%,9Do }LJnC\p&b'Ѽ~;;br4jlm|VVYweP/Ba9M?֭E1w}Ư_wq餿NouP,Ufu!^n/ʫk6Gx%^ıAoŏD'A*Fb4?/˪_hVŬgl4gy1..5scQuѮ_x:H\xA qϻX\S!.s+q5+kĵr{]LD)>1)')~o--yܪ'-f q;?şwӪ8y #b>ͯE%YQꯩ_"L~?jRذk5e67ɻMf?Pj\so5ߖ96giU|7b6Y~k6+ኙѲQZUw &N_k'Ӷ)߇ыi\n?GL# OZ[jmt0Φ'*.Ux4U["w)DG,,w &Bk'3{#>%֘~ MnKC`nTyb/i*d%iw?wvw=T篱OK˄UE%-͒vTY{}r7-&gpV=;&[#fLpK+.m\URvZ[M gD`hL.j^ښDR+y0v xhuۈM}dDq $-SN WW!Hfzmmwe,J4%rn~` qG-lѲnGlIGb0aq@-YN>3.,3 t)p夡Φpy-:unhodsmfMq8ew۰R_re<`t㡠~ڝSg4WtrɫK )CnN j92tr ,Z_k % yX| vxWT3}1TTh4[rzr:r  CaM>@|$ⰰbO%]wi!XTt*'Nz/pE@j|zzs`g:Ҹ.laHWm=SfV AOԔY:lVV=T Ou +&):X.owԩO>{ߧ= 5 5"ȆwBζ2S"2(rstq.eL7/n1(XT]i˰Tj9 En9S%"į" A9Q{}y<"&ߔoo3<[i5vWC˻|Zћ[s<hr˒X{:KvTtj﹄eОx{W?]0endstream endobj 366 0 obj << /Type /ObjStm /Length 2498 /Filter /FlateDecode /N 90 /First 824 >> stream x[ێ7}߯P o@ $1E[޻5ل?r:ǯ d&wxn`/qav@ݰfzx?w-ofYbz{n7߹? טԨ6־JW>>>=oE⇑(}>>>>~NB0߲9Aqct> ct~It~I'tzivzivziuraSI^$H{×o'>g?7pF1=R.; H).gGrH/hQ7ָ uΫ8 /Lwb]!*<>~oۃE=[OkTUw,~D,D,r:Jp[D}-j>g :W#ڈ~GڣBأr٨@Qs|#ԍm%}Z/f}-У O>Co ]s ywW$Ї|O hWj48)bS´WuN֚sQ| as9``Õ  ,TL>P@qLPVJ$'=?I Kט|. 5Pi 2Wń(XAy׿.̏.R7}kEf^ &: Ŭlg=3?nRZa5_VDq[4}X J@`&0%^4]K3Xzk`~8Xo#c^!\FP$Jq5%)ZXzY E0liKs-[U*"PN&B܁b:~Bf4{ƞfIc}Sy퀮ΰtKkة#T0hVfQOBSfBB,x]L};QC]tePQa&#Жt"R&o0AZ ɬT_rū`bԄ>{ E!S?"VH?{JV7[*b'offitw0c bߺ902ro[;D;a}ECDo#Fp<[>BId7r ɵ=)-==)֔]ak&xĻjڎP}3 (.XqbZԎ&CZþC@"KUeV$Ϯ7Kڧ1{ X@q ղƂQgtDk̹j:6|UrŮF٩QnCO}|T wdG"v0kߕ ua P>aT CC#* ޾a-S="u@iHi U <G֠ƳgQ d&Yp1] ԍ 3X***^+PlzoHu/H"xS<}v'@I*֘*a1mg9s=i@}!-Oy'`S *&Dp\j85(5'jӔsƬy \jF[ϚVԮ|%|۠JhV_\ B:!" *WDDCy0bW5Ӯ)tSafFmkLdZ[޽o*Y`L>^Nd^@v(a> stream xśmo$ SȒ(PH.M4i_-¹$nɷzaw_g3#D)*kHrRস p-!RqC! njVCnqp:n$dѐ{jPmUR( > -5E >"h!bh h*i $JzE=SG BS<& p^*n:~%p&:d+n2>FS| 9248QhLN M=zAᦢA.4{ԃԌs b0 ^0pCM-ڠpnAmPU KľAUhse7zީO}j]D\$j{;T+IvgQ]NvŃF.I7^DнbLP>]r t'ڠe*Pvh*a&fUn|3۝ɠz> ?I׾5Oٛ뫻|v׿;G~К#/[X{AWq C]vtnqO}n1W2z*}su}WoPg k:uAdA4kWQtԧ>i"|T9*Ǟ_$^??e1~}__~1m~_oS2kWW5kWQ_-rGyt_;ͼh9ۄPs?šy ^TQ+!x{}Gf1`pWDG5ƫ3T\mzZ9³0m1[`U쾸yrHbN,|. s?wu]}<7-7[,6sRRd D|駻I^^wdz/jUcZG*@j\H̱'99X4CHr;E^ 62As,DIm3g{czy.Z:QTErL0u5Tp4y+BэQ ס Y2E r )r PspjE }\bB|[2 rl`CZ/t"0ZR o0m6DLt0z"!0: P9k=RSCr$R%'E,zIGB*6so Wq".:q)mmhqF|b%aۤ7@L\mxpM1MS\ԖmSri2H4CaLi3 `xcMs\N㖋):@NOK|K(Q&54{FγGf{x@LʦI]^Q Lh)BbM ?[|k 87#͸o?p "ޜj4CҰIt%ʁ`U+\SY T[lyـZwҥz/7yɉ ?Q=#|*[@SElቡ1m_IPY[z4YWWWloyo~u_Pm]~y˴l> xuje?2dOٙ=rcLy9o/Vr0FWh}.ٳ\u4k&kj޶ mQcj |+im; zTɫ;noQ!HcKq ,XJmHAcRY%dxrL[,U\HkVnYXC.\) io ZxP5(m[  sl'$0,d믂GBR Cb6;UbGxasj}]ej^ȓ8cXk=Rf$ʖMލ_owa~|Ρ7on,|ƻg.ƣ__dضˈ}@R #`dRȁ]H`Q%;&I^(́ #qJTzq:c87 rr>kcS|m,,r 9 !g: 2` s ,Yΐ: dg,Y+KuTg@2 Y΂Rg_}݅ȠO'RD׷jYŢ$}T0<0E"IK۫_`X+HcbH媃rHHMƚDѳGt9^;M.˶-o4U0 km~ƥTx}]5xwY7&__)83p-Cp6f|خr^|mӤxCHf$e"2{-~_m>S\gM$yEl2mZϛebI*,AQ̰@ ==ϼ)pEO6@ud9|\@HH5ӓ<~US ތq{5S_N\n"}#gJj2_˄q<;cV~>_߬xt)yycJ$T\!dbjq>krqS,$f$#EF`"KɝNP IfAr]o 1ɨ/!hG)R1N󶸪r⢛E{7%E#039PRDZU~s}iPzvӮhJy}@aHy'w A/+v6>&!O 1Kט{W@E,|X͇6sOA cxݔ먃s|b*85j:D8(x.Oؓ5K&}"N҂^GrڦIZy^<?Uy]pH*crhaрm^=N ٸCj(I9I q{Fʪޖp% Գ&k mt/`xX\W1.rf'p`58ȍ9_˝:QaR}6wIdNI߇Eqp;רh D-?e.iU!A'd7|Ov|o^@;6Aw >E~e Ҝza /<w,w^lmy~{(fpVU@zqQ O^}}퓝@8pSWEbl30\&ؾ.oXm7#wyV7ux!v& Xdqp'{OPsܖ .O^ڡ0b|^Vk'(1dvՁhAP t*VaI<(Xу4CPR@O+9zj^X4$mGdmcz{aBNx~y~ON~)զ{kdh%ϾC!DzKl)t:.f6w>o+ʫR8VՆ,Ǝ?U.=fY*D?bF߷<B._ A#E[f W5PHsT]q G=.| CymA|\\7oH*铂.NBY^1`hikO;ԴAՔ{=ۦ6@.vߟ$4¡ UG(/@昣nsoo?˜/GRZp31!s::iBj;&Z(A!ǼES$)8#=]L}aE}㢵T}VCk[[}a< ˨ 7cNO@tQ{PNeLT;Xj?Y@,QE};}l9-F آ xtOf%&Vl1Iޢp/Jon9"BXyGք e`g&݃RcR>w({T8HfzTa'4aM#B-{][e2) Еc <99~ :cRty)̠xP|Zck #cBۯ/~X4oN"q?ty3}N fr L@!PӃR Gb޻5Coa")M2q<>zCdT=&!Q)@؃À:2 j#z#91HI(}DŽlG,Ls.k/{ 'c\λ̠S`e>=@y-҉5$mM`R&}L,|źQ@)2-(*u+Toޅ>f a8٤GQF|{5G{d6ڬEoz=R+$endstream endobj 634 0 obj << /Filter /FlateDecode /Length 5924 >> stream x\KsGrҏg"8z?cZM`@@;jLCAfuUf֗_fǍF.>tp7S |מiBǛ?o/_jsSwa۷87SVYo޾&M4fR!o~vjR9Ĭxv:ژq&s_^ŏS ,rГIE# W NOlOvacsSJ[6qy'0L:a%Ϗnotrvl? n88?^Poj ^> 滂5x>L.a'3!lOULov{dtVEUrR^7q"|_;cT*lb,dNĜR kA0"-}10Zr@ 3ͬT ͬ'26hב:X31፾aM6m J+]ĘߠNʦ߈# qL֪W2t!.-?Hu &=!qS\~܁Y+FWS^ ufefT-'\rQh q''9`b~WRFL*ĶX Qi--{~CGu~·9jSP}T~īGX &mk pRo:N!{vl*G+;]:}&aA@lVU\%FNeBkR',g*D7 Tu}:C9ex?Q!]мY*]0bKۦ2h u !tK`Q{C<3Sp?ﲅM`Vk ?v#K #X  rmMB\yOsObw4uj?A"CT1ze |"ZT4LAG['` \鴣0byO1=A_ca3<7I%/2.4$[ȁ#D] % 1w?ǜt& AqŠKgh 8? Il`H~bL*I Y`.[V{C: 6-}*Kz> |<>׳ hsFd*Y23L;=${9ȔWc)磫W<)(j_] DhB&R}u)zhme }:&F1-?$1ygS*kSkl)^! F'JnO Z" <[e`vϴ˼3W W909#%qr`6ł+B9s8W|"} Aң[m|хՉ쮵e 8Hh!DPmI9Sv"mw6~ >EL7"uS@@PrrMp:A|Tbm ^Ge]3VM))XG/v_lK]ˠ3y_=~ ) HQ{,Fp˅iZMòDr 5-"[[KLPPJYp_r܁;Z8 Zpd[X$!{#-wE04 .}憲*m~26-+&->Rq;920QQrd"6.3$op?-x- :.DkE7Շ+ңw,F?Kd[ᚅ1n &4pc}j- P-Z= ﮃDl_wĐrc{ƂcܯO#<3e[m/K*N RA1Ij'ۀ"Zk"rx0P$9a5dtx^̉c̥מ VAZp|iCucrfP(5V|_P:Px,4:VߕN=%a]"&/~YoPW' d 7ۧ]X3EluP+ppS uY7Jt\pB |&[7hpq"po %]kﾶ(hZ_zj.#d5l(X~/lѯ9H12\{"(+y摿)&b-lNJ O D*Dg!jQ ָ!8NDwg]E(V$,$A/G4PmeRփt2,N {lm3#H"X˰6ِ*'*t~դOB=c8w《{Jߔɱrk@ |ȫ0B&Q@͊$Q6$y-%aMApCXH#1:zT Trynx?Gytt`>+æ7`B >JJIZ)+06լ)da̰'>%UBj12 K#W kt؍[tS(ML //,9f圏,j;=;TP_=3f8sq2o MƖ=Z փ^5I!u[2ߦxNs`t0^@)*UY%2kL%ȩEJ6"b> \@*5//('kGv`JсcҔLA_#Z\J\Mo@o( l`3&˅G!S:7~X% +MECw:y#էģ&MԪu y_2CY- }  dvCE6iu+L9~-<V_-04+]* aP f\6ȄL/B&(e܊:s,`|bNU^XNҋ1>2r2Tȱ/hęǫ:52yw3TeL:^gh85NT,^覈d/"- \yb:AZp&KL(j T;SJVsZx?0)Pbd =嬳d}Ȼݼh05 =;{>-j&$S*!^}Q!k1O~@,bYDKďGtgXa#G[:ۯ[w@oC9:3M~g}wKf2/o LQJ>b~䩣bCӱk=5|is5L&<]]-E?+Z9$h4T=$ax;Bp`-$y`,Jg|QJtPWYOYȎYҿ7Z pka#n{ v`eIrYV1X{P4Cc-TabgؾpYj,DZGMU& K30iJ\_X 7/YѰGehǑT_$;E??g6|5:rM*̓MSvVlt*ׁm8lpJ <I]R-b' -*(YNĦ crvseEf;['~9 ȃCy WoE%%0Re`2|`yMoVAkqXבsЏI]][X<.5ߚWU\ٷ*y5R :w}ű'd7b$M沙)A: toBr#S~U$d]bx+y*HdE`"}юR'}'s?o$kDN{ܽɼ+{%eNY2UT1(B!~S آ. Kti\-Y#,)hZ?@NFG䪬q'%#6EG<p20*Wqy02aZj+*%+>-Xגd1&(ڙ<=d/.;C' S9XMRvUv=lTɠYVwzh w"EW]sQ/{I8xO,;' 2L=.]mw``g[DZ",:W"aB Qbgi!'Pâ o2V/ba:3ƃ(7m zoiArE ǑW#=쎢J?r)xfyP=PdO ~Zvh 1e؇*{j=pvCpHq٦hA~L_I^u@Ik1 k֗-Hs+p A,NSdב3YMN+H8;vWlܳX]&Hd˺K槒^i/W:+z}4ێ[_W:zW} FuLq?wB^}66/Я⫥B AXr+uqCjCI^rD#Rtyg%kg)}WkC+:'м߽={kw^/`\}I @eN[)E}vCO#gF_, e/ endstream endobj 635 0 obj << /Filter /FlateDecode /Length 6426 >> stream x\[s7v~WaJl7R)zQlǑh+fFM&9ZQ!=0ݼDҦ ;߹LL_ݜ_?p%|QѪ8&06W~MrShWy 4%yQmNQ~\q~mqJ^=t4iq&ڤ㰻Ǩ԰f. o)LPS :Nzxe&pmW*JɎ zۭk4ûcTvodTYm?>•wrtң͘6O_<l>jsd? 5_C.xZ@R~x=&AwF.9*;\ a` fb&qر4MPßh)\8.G᷺b@8L?Y ߱.l)X!5N.E; J<䇓d+y,Mf0q4NnD 4QQԢ+% I6`9`=i. *mB C+wM"Ԍ,n:DTp^ ,)jfߑ<ႈlabF)GhX)A [؛§B,y'`qUAӨ)3j^㭶(j)$\Y~Ob`tpT1'0߷Zqd"ˮOZa JFYSWؘQ򃮟 q Q nTLp heE`@vQf88⍥¡V M0TY׊W=V@ģ`)N \*X؍!I+ma $*w ď}K'қX\Rc&o$^T~FV@TėwZųZ|[^U-^^lw1Lvc#)֦lKcb#n 7@)8n|c wuPP͑֨'4(r )ڽ|~ld@*Yq"@&#?xN#JrTYW #Brk+BGqO Ja8aWS#q .AK]*y Jz;֥V,Cݍ՘:Ec ෺+0_OQCa  ur7/ _@٬Ev*#5r@Sj-0xV œjXY-Uq1$d3 lm_gMAqiP0So)SuպP9j J+VGkb ֽTef;bƿ,Rzlӭ=fq1}Dir'ؤXY"l+0ѩtrh ؞ jGSGS(Rv/n+x]ů.C9EwxYИQuz٣ "O>NrMuvQrONfB۔(hO^O1V|Փ;aƠ R~=Pφ\p qR|54#1 ] =SǏ;==AXAÙwl@-ϕ_Wڱ\O tϰ;G *`7jE\=FkkI~,8A4Lj]17V('Ѩbܥ ny%E>q-~?.,u@EZ<뱬Gq.M]- uhnZElP`:k+-=GR9e#Wݎ\?*׏#ezJBch<[Et~V!WPLafeylw4 0+SH X>^tF, `XS򙤣D@+p-ɫ%J_Ϧ:p\ֵU1t*'\mm$\t-߫&xFJ8mqA83 e&y5FJ:EF%2 50n&T &g^ݯTTƺƨ+Q;b8ے&~U4m&"0a8&*Oe! \]ކt;:F9ONLr] WDOi=>@ɤ"C>ҏ:?2Փ MF#%P\'P lS 'ɒY|]/Uxfs)$3yRɡ!XB_Q3ٕ)MPK":7gȯz38"jٽbd8ܺCJ'\C WCEi ?0&ͫa`G-XrzLEA >djf)8 ?=? ~1؂LZaalû85 "qi\Ԝڊ`\\78T{zF}z4H?z ;zG9 H2VU+s(B=#!oaё/a`}*ncכ"?]J._HXW1-S$4voJcrOt/dv8oMvчz+qDz X־/ҨI~ .rVg/A)ɵ2 <[b&bT+7#]q>,4]bmnW͓Sw6 Id2J2;|AG1@ڬ"/E2xP Yu9\9,Y{ߴhtUS3Dreh4 &@pWgoFfnTTX9[@iam3SPA1plP`^6<ڽ}ס%/1{YB7QE)3WȨnJIV@.@-}_ J| 1MG;̽aP]#UWz8+.V1`dy/ό)!h&`?xMbC/rNieq5I/Ir3̷c010MLS7Yx; M4_Ēt[5wws*1 eܼߐM iS9f&z=؋ ڥ{ (?wg ]@4 qe!rݨU8?' )1_MuX^%L!u5Fͦ݇TA#]]Վ^p_6/bv/7?WhۿɍL"5o$^5rs՛rPpB:QQ}c?KP_s$|y%J9ci>oiMGLFF-FVB!8ȯk[)i;)K`Y4gℷ5}ܻ&wNxjV4%v{>[χ.K꽩b]qJRFャ3}:4dK] ЇK7XZၭX|K.1G.oJ6X%QZMtw//\K+I, 4H]l|tfi|j%E{pI}K!7`>ls,^pE3(zq0Y=C'Q%#74RL,ϯ7-֟@)֚T[zb6Zhs"AY6 =gf#l*'+9_oZWmQׇ['D_G 8t|-DƲ٩}k\.) sbxtYX\K6cl ֱ_ t9wp)ʭ±6Zy.[@=JjycpdBIwζi>)zaԇt] m#C L1I/Xkmٵ{Drl1&/";MfWŒ^K /O_񎁢D4bEo_ Ƃ*Qڽ@&;uˇWw3?Pk1Ҳ n=ЇuR4Xp2G\Mix|Zu9X&Q?mʋϪ!kjs{kqaT|М1*8ZꆳyHJ,1|d 04}1&Đ])cU9ɢ- _pb2H>Ã% 󩜻lR_O@ۮurcl-M@עH-שj lz$\Z S> stream x\r7}D70:B]*E%{fl$[;܇IQxI ~*$UMҗ"@rD7jo j`ܼ,]rzuFzom\%ѳ48`П@0Ɓ& MNwvpjC뺇&Q>tZWج'+HhhoyQ;yr1USwD+sk;XAàojq~˝br<if;9mb/WNAY&/[pb\$`W~+70|\'}>E KsRB4T` „:xAۆvcyJptFLf 5 J{%ޜ |/_Й6X}AZvQ {kAɇ3 TwZ9ֻRoaǥJk;8X]Wq"bK:?&h .y姴sK#NihMG[b6tnpaĊL\r3CM> im}*9\ij}\9G#J++y .-Q'@ la؀Kӽ؍&)X]rk~>^.j|[mj| }  ?HA+xR|Y&z@Y̼`X[9hsE)TǥxXץ϶ =)G(ưln8Qx6[7b7ܛae8=y9[+&g/l 9*|{S RrZ1q]#8~Ć&?cUv+2QNE"XN7aZ`迶Vi?xu0 @58yF ;Ͽ٩'0ÔfsY, zIw\wB:@٠SkFL䮸5$<8edPQ}u%NZ kbN[P !\4$zTƖ'lÂi\ŭlSy"Ouy3ؓ|ܗǣkȦ5㬾EI턣Tp&*(jb &y 8J@gvGe ʾf՗f`z@5c]=aiXpm*ͧ>ג3znlΝvSyJϑBpGh Pwi0gFzjRW=ՎܓOxM^pht^iYkČ8:po?sx%7PyFKlJGn}gSag[;W03&ٍCchp)?nH&iIft17f`ъzPk۫j~&T掼P9&˻MS?qӜ~+z:'T_<[ =$͘`#]~JƷ r~cZ4Q[mY5$Od7?;D5sRˬ@o `a1(#x$j m -ջ,daJ7[ `4lH@X|S  pXˇ\FɅ?s&̋(2TnqzcBa> U-]?|U(䣛}+ƀSe|1ց~J 2ToС=wQڀ`"Y6˲qENYn8TKi?6[ Vڜ܍PpfkhKXȈO[i+1Qɱ ͌s>Xrgg]?9; lr <,TVޗ]]SR#l$'L:dFa{0**Ayux[zZffi=,NxNz'xH_jvd+ov'G&ja ^Bl k1bk3=^2<;F<êPڊ0%5EL:-͠ EٔY 5)]F 5=a`()`cpI?p<K $Va b x(h8`HC1i檀]'c"2B+&"k5I GL}49o34(%I=pVj1BJE!>.G_o+ m)~d|*~JpjN`bOK/R(E>*EUlQ#SQE[}xTf6E#k΢!.MܵƟZ!4:? *idʳ{piIqOVYlx V֢-`|F$迩ЇBizSs/IKwЁ4>%8 ʨTM8"l൯+_&"Cq6+HGBD Ʌ# 4Jbn[L n#ԬuR@鸯 Pk qh%(V"( >jṔ}yROP([Vs+EYVߥ+<[ʼn*L\b+5yzjQι%dG{.;abayNua_^68MpV<\^Hc`FM/tK,wKBj YT1ek^*da"ĺdV=J0Ndd i0:ۺqI9B5`jJ8(RKc.eZm)0iX*GnQ0LlHS_z$o< ^CaKMí0(&\ju-&Y:gWz>hUa-cŌ <<5J.B7<_V0FMG`Ok u6&%&EIsֲk:ʕ/^Xc"/%^w'rL,N=@'+gnz[0j89? A%61ņC1B?*;LL5= > j >Ed74 L^xXPht#g^~ۭ* 4իBoIwt8gJ/}sLv`O} RV@QE_VSB %IknV͙\[2L?J>3 IsKD{[i7򵉞&+YnZF;*'V&I7zv.&ѶU,xSV(s]Z?h Koղ:Rl7`CRZ{ÏW a޲~/Q¿\ȄP3So[᡺l4 IxJ}jLfkS|aqSHZ橔n8"Ub\λ ">׀]1'.;-ƴ&_ꯈt %n|D'+#C o_;<?^2\(f!NⱰs[Νk}Uɟu:TSbD: Okc MŸٻ~NкFnٿKLD4[>:l3_z! j_{Duf:e2TZ<"!;]O݅`=rsT#^ՂILAuPںF?チ$DW09I(]P*|IHDڠL: ?Eh3,XAR'L ;?³#~8ۏԇq%1xLGiaz` v,qZ'9~"4عR㗉6 J UN+ ʺ횏, &ܰh+dې pXqVU<1/HPP\U:[M'tAhbR<_KYEun{P-'`úWӡRbX#7qHR~l2(&E P oa]s?T"7Alv dS&ElWvlT ḽRa",S~S!׈[>c%BƏHp?:S8a}Ϫ"V2awqK˝{㡏m'bTL@/}`*(nWx@=|.9g|Ŭu9ϲF&u()ɀYMzüڦF OaAF6/IX8E9͢ip_xp +Jsxq }*1C g^TG9-~rjv6Q';%0\}n ag,atgiI׼.邽I@C#5,wBTxܥ흚&SJ2SڈzKW>oRw=þ9Lg/T ody'B"͆Ȁ֘9֚>AY#i6D]qhx]FrƼ*_ג}({+!7$^ $y4~x8 "nDމ T_8 vUL99v<lŻOp.#P۞H8u:v;zR ` kךnDu3%- LcЄnXONScVo;v5>wdaa,F-wu~n:ݘl-endstream endobj 637 0 obj << /Filter /FlateDecode /Length 6152 >> stream x\Yr~׽o!tޗ6X G;l(SK]$gQAGTתGjG _^<;z}Gތ1wr:ͣ.kxSSG寗G?~=<G<>J(8f돞_<=`秏~.v{5S V98Sc8^caQlc4ka0흳ct:Fqʫ8ކ;Φ4#T~ ?V6z<5cN~xE\5a[G=hJa/}|Ip8HJkn5vuwLǴnR N{CƏAc/i;TQR עqvxF{-L-mHNÁ֘iMPa8s4ONSco>˘!)b-wq2.tNdN&)YS3So;8<g-50.cM[)=.xX%܂|`U4=@:v,YIٰLŬ8WU`װ^{ms!gfd耳sb^oIB  k}T9fzY[]BPk uqn95LUG{mGPvF"MIx#1Y8]A"R?Tm}, ZjNLgeZA8cSqt9207 vr6B\^70聎 x35XI)N5JK x#  5rs 3;i6[Krav?T!jFT쬃`ߍ  1.<->AМjG."[y{6V̮@+(ݭ i岔*Ězc*]j1YaANU ~u~/ ćD0&_%:<`e+(N5Xvw͍H@5"ROi7aq<8-Pq0^ AG*1cBxŔq9;+ֲ<?Ӆ*+a[2W(َ!C_W#EnMPY~g`^)%*_Qw C%}P_''%0 11=%$㦧 q<둬7"l7|7Bd_az:7p̃p8h3h'DCl]@@WtLp2 B ez 8*C( 5OթK `wq`+ kӾ[E8ɻ?-޼LoyPkQoRf8;)_W9XZkoj3n2}PApa@ZsAnDciVHX]Cr2L`dO`iv'jTz 1ufJP]ݧŧ؄<s~YUɊX5囼TAb}I$[L*m$m%b4ss%P  Q mSN4o -Co1 0sc)tk 1a\}4g %NeAy&%OE~)zC#m!U*hN3P+ Lqjtu3"Xl]"@'fL.^k@Y6&U?@HR7,R!ȉV! 3I225<@ջ,X68bHaɎ-1y5`5&1Nѩ({4k< ň2&7&ŸsֲFќM5=ME 9h"ema; 25dmF!,y@xȒ^EE2IQgB3saSޞlfn'-Bi59ؖq%%r@u-zOpk$q!`UV&}/7L! x,KezIA-qIuȤد6з)[= _'kg"I<2$B'Dd+fѦ45JVa64yh0Hpx<NI(ak oY{@'q5֨V`~+F:h0P䫱p+gf;ف7E'vz<Ė"#FSP?A S͖M)$Fܕtyi;{. pUn4ZТM 3$y֌`I>ttd*w`8a AIFz3|p݇9zO;հL@H 26kACܵ r't-i33Kɔq]H΅'&}ΉuzAb֘ڜt^&3)%1WL M +6b_[>z!ma"q؆HuցB3.2Vֆ%p(F Nk:xo4je 7:yPr,L afͺC8ˠ|h Lv3!\#E0`&/8pr"/PQXаd :* !xf(j鸪|ŕ(klՇ e[JO@{qg'3>]P,0();1y/Ek*cfQda~c|znܼnu!Rt`R0fN ˏ0l"23`Rsuhr3yIu(`B7s*\Q.Yヨ/8U{BBC²QKS3kCS(! #犍kfjs&qd 3*@WHURpfUZ,ͭƬk{b[{ՉFkn@uzmOdBSGVugzrYS.tfO(P/R5YY J]NM[A{ZmvRnXdTϒSVtݔjل\Rlt[}tJKYm@jL7xcӞazf#WcRG{İK:* Y \W^0LdB,ԆIMq`vrSvhX*RWo-e#Z^cŷ%u֏)TRG@y-\f NfM=!Т B :L@x Eo \Bitԅ SLy&okק0Ը_rLR꯵-@u''5:gՉYsZn`5N"vT#o8ĀET!C+!`j&^"Ձ|Inm) zbL[e"ڤf2e'^r$T:mA\͑*~󻮞nźn]=+6F^~UAM`b[*O54ܙ8vڭ0ɡnЛg,Taڶ{yE3eAF3tònKN4U v)~kE}uKENo@FΖ#e,:C evS&tK訽+e/ zc`\w,iFf'Ҝ5ČښUS s&rj3(cqv{Ԕ =VvWvǧQkmE96@UМ\.TՂ#P"E䴼9[M5/ޚٔ{[/bѷkGJB}BJ!Y~ClZ0U0Qs‹ =%FH{%jf_P.a`c0@arHsfI>,\AO 7g j:t*YXVWRA>5:[l 9V."<%wۨ\k, ~ެiyh+U :79ٌV Bw˴`j ,0: S{Ib~ "Y{/nDՄ7*IbLXfh,;aOz>n繴J=tm]) bPݢ'k<%KQO_[/1trr%Z\9e7\B _Ϲ¥H^TW{ ֽᘮ\ė5BYuޜx<:kj7FUCȇ[Uu x}=W4 IgHHNc_|j\ =J^yYjIc3?.*L*F7=Z+]M`9UJ|̏ #Ei;I8_5"S[2m';/2C;mb9Zs,v@+,/HsCc3[7K+|^*ykWFb^{JP rktr:.YG5S{5O-.OU66 M*%*w+SJv;&^ʙm* PQmaYx6bC׷EUdv,mbi},wTK_Xxc(O{E1? +&lKBeθ S Sj]R)B8gh!`-n50K:< td,V qW(_EI+y)@."DXNIE6njC56R-w$nul}+,8tA׋Z{ik(۷r&DH]M+hڭ`3ka\W|'?tCSn2/P? y[[2NG\V:o|Φ&Fv^|Nawob1)n W"R͆ @KW#se2f~ ` Hm 2W\z:go,V0M_xПRSendstream endobj 638 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 8700 >> stream xzxWaМ`e ddJ轄B ƽބ-YHrE-dciL@N MHHH:ߕl|?<Tf=={ս%D V8a?~@o!{v{_&%#RƄt9q8N0a +##ɛ@!;#cG 9~|TT8q!#qwwNo/E!܃g}]*w\LQylYua؇"G..ݹ,}yNJϕ^W]nz N6N=ظq&L4yM>cw\ wܑl)j0A P3Zj.FS5H6Q|j Z@R q6Cj<@-&RKIRj2B-R+4j5MRAT*B77yT_ʎSoQ,6E)?5H)bTJF9R==-TwJ#/xͯ'­/~fMh(-&=~R/UێMy ٛތۭ/oܮE<>oeWm~>A|<0vwޑ~8̽;r spC %}wְ^ vdGL~Z^iۖf/ m+BUvāR=ۿf ~m#UU>{ni4Z!8QhpZ\ ݨ ~8nQY.WCBF>E6 lV06-Rvy_'>,6.2XBnԠ9*r|uNŠ4<s`cB~-gO4$ ?I*fM`TYn]H`Ϊpm#wRd*MEx=fJP`,ݯa̴r>xC h-W'<<f{<'Dm$em=4IhTZw][ eG=S $uԦAw$uI;3w۶ͤƗhI3'Q8ߍEj^}Co7qiX(y>/|1os+E72_I{%-W%{G}8:HV[,+rVeKPZC2nM3JlyO0 j]|g[_>(,}1h[$pvfz(F '*T:l`ʭ ֒TUClu@TՆij.r x)(-`0e̴/)vPe#+ C>k{_ԨBt)~_Wh6mK>!OŞ=<BӾEAv j.q›wcm} M6E At)d HJi|t48x*H[F3cZMv.{|oZp~%[*ijݚVmT1Uk6KgƵ8} 㷈EQ9%etEt#ǀz~2}>6[*I0-`77ಉ_ilDQ\ KmLldN(jwhi2PCCl&8]T6T,Wl2:=/ msJ ]H&BF5h&֯x!.K-ܿ&w*,^5*ta^|egNGvPw7ϳx!ZJ{O?I0kfoχ!T3hoet(Ńh F$&:3#D^ݻveFII34jBM: vyMԂI"Ά?'1pTY(n"Ju>+BczC 0&Qڴw[~@-A? 4 }ɢn4XpdeKHz氶ag퉝"%~]-lL)ͅY|x/s=[is7 !?=`s+J_(HU:"`6cR6#!RT ]c:y!֡j/p׫"!<5AYI_ ya }V6 !#7#"Oj<;͂f| D'v/Z1D"ݑ:G?\zDCk"@VtUyt o!яУOGXew-;j.l%%aI!\a51TpT(P[@^Г5՛U]Q5A*/1S=ۏA+:򠀍ߎ+B 3t/%tt_O&m[uᘦ^Q 8k1KbKVғa=""OA ʹ>"QytCȢNZt9#%LUtId41ȥӧ+9[~ `OLibz`Mr<ڷPʃ +җtqor[ߍ p_z%0\[8y?*eDg_9wH6M1* ;ߜzP}m9E=4'عM,37dr6rp,e)dD;"qrhAn_ Xo=AٶEJǍlHl^ (0򴵠1.GH^$+o7Xt_Ke!ZBd`Î=K`x6{7fݚ,OAJIBp %޶~C96yewՇU,vI0+MuJ£ ]iZ+a !аPcd#UjnPcw*"FޞoW{382.YFN_[gZ hDpAӏϿ*WK,?NەVc#,ܲ`Z#'ՍTPvvgkh9t;.>"oQ7*Xzw &%_֬x>mi%K1},ycˍ\r]R.O08C_LU>$$&*lө?qk#*#"+#jk++k!Ya@&嘄mfHm=+BSh(#S H`b$ <EͺCnX'+*'.'ExCKWn-}}%}A-!!:VM~W95q[H8jmzW\8֢5XDs2B=XMx<$BTB=BӯCi-J3ŃG{:n![ 3$*tzȅ} JA UoS?ئ 6B0}ض._'&2~*)۶M&EMյj:Ϡ-^tFt^R;z^+/Z`C/"m~b(Le!63kzqk&<˝׏]t!eI`y{-f H&~w%/j?D\J8O,w*k[4=SyZG$_:d 6{].H}3 >lСSn@CzoOȏEVTz}4$HpAyTD'p E*A(z(/"/|g+BҐfCNoH!AQa]5Fc я-'hS iED 4KS? V alD=H=硒@_X^QQ솖ypXa??^ݠIa'N:`-RU^h + m,)ZFXtLvzFl\su*.6{`=sOȻ,Nwm73Ja5(}̂2&6?j8_|]w9&b/zS7sEsk"RL0VN_,[?f]Թ|@/@ׄp[l%h#'C0ܪi/&]4 C샇b?oHz~{џ%z& xDoc[l3oGAWP\S嗪D`9c֖VJ/O<-AMJsMOK]JƣeҚ+ Mv-{?YO'ڏ~bVdS]=]kk:Cr҉Iam;Tu* RijHf2Y6rDw}PzOҐn61T:R$@OC  Fͼ;$h;"=q;-28)3:6>׾92Pac u0~~͌;,5rhק-gO ij(%Q)['lv6T$L2I:R .hlaĿ:='l;:Ǟ'TYkOK>(]"1?|+7Gk~⿡\A.eŪh4h!A`JIR١R@=92k#y.{O܎&c-F.\+%rsh:~ ,z,|_\' r9jz :'/9 Yq!Xi|`3 `KoDZAl?!8e_00X!¶*T3"A$BaAvM($fc"%.)ˡCp0;FIɜE|)/Q)hTu 4~;}b72?ir뼶MGZt guiqM\f;ޘS}8V9`ӌ >w◇;~?ԒeOc l @!:iwrrjKҸ%'2bIƸq.~5u?斊3 ~}6C&8 .+`;3}ǨɜuPY7hX-r݃WgB9祥o#Vuͩ ÙZhlM6'ۢ?6Su&4*lGUVVYi&,^:> ѥ; ]8 }>yG{*hz#|Y}ӯS!2R9F--D3ѬO ǏM 6I R,<\ִʮlF<*!߫7LYLYLL&Wp7[cc9B3̨(h`Bjm+PV9{ 8c{[{/YlI-'BcZCpRabĴ>@Pܽ+m䞵a7aPprrww__]^}6# vŏV3s_]9Z:sJD65:_YҸgi!L|~Vk2i"b)"ݲ2KaOpmmw oDBX77^WQ|ĵ.b}'9ƃeyde貭U9e\F )֌ $2^1O>5ڝzjxQ( iY@vϯ4TU œGbje;**,Cg>~{,] 2O[Ɖ݇ őh[2gYޘI20rBNdhydހMlQFy"+H|; !'CgD\zPoL#zx{WoE:ܴ>31لT#?=y&lw[>9R NMǪ,rMxu2R 4iŭi}%tad6KU j&"[{O?p> stream xy xTUue bTBL2( LBy2I\)PS!!! *EuC[Shi/_@ssk\8\.w [.^lv*}l+^26J`=؜GQ(S,NIJΝ67n޴K>7Ӌ-"-!;%.&}چ䄴\i[2RrMrnn沧*((X0#;y&Oۜ?icnȗiy 6d'ds8W2Uٯ[ f}aEq7&&%%oNٲ{h[qZE~K.;Ag'3ƙy333'$g|Ng%gg'UB*S8899k8k9pq:g g9F4CtN0a#G99! I)1ܱH8p<-oFu'wCcGce =l성>X<. ^|GwY!C',gc'-tx\1eԔܩWG~_̓zFqZߝQ2sLf-z}b^vM!ڊ/Ekr Xꦛ ^еนru+Aid$Z款OF|7^T#ˠPVfz={uö2)W8\h3>c0A(J-R1OЀo~0{Jax(imbR`ꭞ`nhPM8F+|*5hե%ZZ9oPʊ&W;އ[=;Z(UGRڣ! riq0S XˍF\{ T3źBy׫  厒j{m!|׃ydzI!_vXk=@[թK^|A yp >{e:N0Cu5*,:o(Iߺ#r'PhBNJIgd'#˲* Ve0r3ߵYL_ȲWjl4LO ^^*PCmO&<4s_':F?o^ēq9ͯƼԬ[Fyڋtr}yL`4`2Бn-7a:y~(|K53E8Se(Q3׫AG\`sM5- L2hWӅ-j{GӔj^a C)nT-5&27!IbIPwPiK>>>!_6UP N* )_p@Ձ!b L6H3VVҕzܯ)}TXTd=C{>o8PK F/Ls#coW'ruY9LI<*kSϞL?qv@] PT);I%[ _O* Z*ֆP;l"R)+Z&bt Xȁnl#Փbc}ݥ5 /"]otC]o E~IPB` (n U vKM͕U6ݘe [m=';>kB[l?3;K Ba\)D!S@"5iMe[w,Tyw: O UVczj͍ˑ,MdMBA9P\p6A%՜ofgߟ;pxOO{5])uw/0 XqRKsdcW "$[zJ74zzDw7=h'*JP+<-j[v-6f'ܯ0Rw GPy"[ؓzW?5N.lIEJԦ3iyXCLe1Mf$Yml m*U%j1>.6>|Mzyp'~A#lofK >{H/9Ȅ5Qo ['u@&%vC! Z=~7º7U6)sڡ2 "H1C׌Э9w *իJ6ISهwN;S#~f !;AOP,/viKeho9M5u^INNK%uNJc^.[vN>:sjmۘ@P{3J]~? *qWJt-|VԊ![9zTjtt4Q*Pifs17XB=GFj"9Mx[1O a-4Sp_3$YRJ-{ʻs%WZ𭄦)x)ui2 yI{^[F>-7*1؝= ; +h*pH3 2umĉrQEo?5Uc҇1|l?tud-qAh_~y7 D .L0'Ujf7\]*vPyh ߦ`2BkScJ,>wNY66H5yuҜ| %ɤat ]!TAu(=j!ɔW4D?t{ ,Cor;N?xtho5&ɑ 6SdwPHdy% ("'T_9ƟnK>C;mwVMqswO{--u:K ,kT(պRzYIZ^ЪRfty| 9ΟXW&bva~(sa4^ OS4;}tߗ=iIc*(?@0tշ7mUxo|&oWĎp2zb2[e#}{LP[jDF8k*]}1ERyucӕ"b9#E&3)s }{1K(5F6hv*}$Хh|/j-3r)J;Ԯ`N,u,U U8Z"!ZT͍FD3>(֋Ho~X } [<=7G~vy_}K#:>Kf*BvkjIK,cUIx"%=Ug^>Ц-K 5pq(n ~L4 ]0+h=5{ext4\+s$ZoIvz] BjdEzyPHڸ RR`<юK'OyÕ]ǩ<ҍrLU>q =ƍ8ǍpQendstream endobj 640 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4474 >> stream xXXT׶>0srגXP$ ФtbJoEԨI5EI3nrh|){߆2kګFX`$ 2o7̿I=!R -BLI2" }Dv j?fX3gN`L>[U.PoOU(~eV(1o{n!""b?dR`;c'Gzۯ w WiuI]?zۻzx0 07 i`аH.\W[z$oLioZ00=ƕ,gF1+*f5Ǭe1Lb0Bf2YLa0`1.t]f0>L??3 ĊqIe,dt==HKYh ϓ`9ti=zvXl`aa/^Dޓ{Q 竾[}}-UL1#:%qi&. `ФHF3[u4hӃ (|,B |UZ7a e['J>Ch}4oh9,#r ARfHŽx=Gb9,SCA>uVU`/=/; *Bf LXLJARXRyL&ӧ'q2N,7?>(5‡и$ ւ7Gxoĵ帤ݍs8ThMS* 8k咟h{j8F2W1ncƤs Л]m=uUhWehh\osOw_9iO %ο"})YUa2ޔ\ȺB#9QV{My0ʽ4AEh2(Ѣ!PBch* R+D(E>(+TwĎQYJ˧)OIqnOJgr61ŀ58 i%r7#CW}Q5uMe!ʀsb+K S#r8Z6yETV$AbYCG$ӣ|7L;Z:Vi !P\G]9_]ICӫU)h4c`/Yˋau ţc`dtPOGvMd QUPGn_@Ay(d@}Fj5ZEzz\ s+vIXj⼀Kqr=rق;D-OmN·b%9iAiQmpJyNbCYsFB2Pɉ'3Xlg>J@3L=l3:R`=z@MۇIνZhsz3<=6{ Oٰ-4a{24;ypPE Idzw]Ekǔ+諠Z [hRqe-ӥ&KuWawڦ# U]8m$Gv8%E1MKQ-YF-Fjq)E9`EcپFx:c=g:g C@=k&D3pˍg :F/$&pn뾨=E^-ԓpȹʫ_b.}zQ̈́P)%<#Ƿ32n ; 4 jC`08()!!øIM y)?t svOY%T.={ *Q{G:'a; [|;")*UD "\o:qz)L v f((dJOˇoMyq?4nr*rlN5]8EV"OGmo?_oyjo76u֣ #Lm4|'nC O: ˋ1}Au>T/ǽMm%p?+,IΌԪ㴊~ၰԗscRW c QΓH3gN%o)l"GaF)|~>> O;LWp\4*;%%%~]:~- y.Jrnnt!뺟]?^s9sIN@fy)F~*Ͻl Ml X ]\PFi,!dcw/+:[\P{Gd^Z.1b%[A!tS4D@BFlfZfB!י5a[W?]ήt:J/K0YQmbx~'H<1E$TMH%o'&ʾ3}5: c ZFjͪ&r+8^ٻt}KMis8N,Fm\-D^XZp7o/b 7LXڮ <.ot=U+(M΃RށX-hҒd'ޜI4~0L2!࿌X 0;EXL4,8OT٢SJ2ؙ]u>?9ZWU},Ȉ,#y!NK n[MHaoUͧG9Cz ~ߕv^ uqV8ۥxIk2:p#?J ~; əWKΉbi@ǕEǦOu.0qWYV~F(r ƢLL,__aR"5,v]\G%Q(/p@wo@KvmF)CW|M*Зjטd,0 oQ'mCK+eNXco8W%:ܞU9N8+ğD$&!0?t({ ]3`fJř n cnQ=qg~cNG+y 3]\0zOU O@]pODUcOSЦiRA i=wҷ' p28N+߭ @L@v'S/%[{D!uqTޥw5iTˁjt"#(21מI4DI14ȲW|蚋[ dS6kD`i1ܺgC5J{eX02endstream endobj 641 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3083 >> stream xVipSW~B{` !d6ӄ}_2%AxlKFW xòt/lwa&MB[&I'>\gfdә饪kҹ|ߑ1^#L͟6]$^!*}nW|z^=cpXF.M,cb|Y3#槚˗/Y0or11&J 2'RGf!&Qgx=lN]1wnFFƜ1d$4oL:c.VjЛ5RtOrs<4Ψ 3zaԫ; kB&sڛQY1a$l0Mr&lf1ә-L oVf31o30k9Lʬed2ELY2 0,1#>ϗ?ZP+:XMy{wGzQ|>ыG}, $QZ+,R7 Y$ ~Wc+gX͐kz,km]"r!P-vG 4"Xe]C/#pp)9 Y_]%KY\\ĻGt@e(~a89{jz ,kJmڻ!މLniT5 ΁ `ls_EC4M+?pើccÛarSdҖ0})tXDu2zZ6$c&YTc( Rةe,TiX scċd<l|JS9Oga,=~x]QMSپ`Ɋ;]})s>ԋcj1UUO\)@E2hYRa[{#v+u_>TQe,NQ\pluT5G؅\/ MnŐ2ȅBZb qӍ#ЯNoDbsg8Hio_䒬Ѷ,0vPTlBf Ewqo[cxN ȴ{kVe&7! c2FK˶ M筝n%e'K!|PJU8h+z 1>܄s  (H3;o_ y`,±cw Xmw_^PSk+;]i2 w`uoa<Ճ~\Q6/y5gO#*߇3?%ogCnK^{/m˟ $0AlKyZ Ϫ),ljKd@FCl~|NX׶z+'5B^`Rއd_"#DΨ ww%;<"H0ӭ?hp~tuaRK/6'-ͬJMub3q! W3ywIZ}QO^rډ!'c5ħ5*[ u߫zթS7#?*/‘3/;Q7b+8 則sK軩]jkIT)">l~C%GSei7ι}w?r'v{*JGÎh&i/9狤AyGncL,R=5C'%W@)T;.jaGY2v È}q5ʕe% _e(3 Ua[0HOjfrURxF8+XG"3J5kiwo2>_73endstream endobj 642 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2206 >> stream xE Pg{58g!A ^H18$1rOThT$Ҭe5bGn~Q.(L,]$*0`K*ˡxë*Wi5XI/b$J.f]fHOk|b|5!!s5h'e$R4td^z@>5&1No,Lޜ7/''_韚\MN>AY׬%i|YЬJH(mqF^#& ׃/~#^Sj)r)5⨗(ej IK O}'ʾ޸C.]FkF&hRނ^9|J. q'`¾={ :|ӞP`W pΚ.sYkV[1WXW!MZ$VR:)ROQh|!oQh6U˵S NXAQݺ~yŐ)쎶K[60٢`C< ƣo[Q {G8vә[KmFT!7OK6OߥHpo!fZE kF`W_z ^MdL. &]z`[л+ǞЬV݊mIzNt#`h 8A?gp.ozK(&<)3u\kExz-cg#Y5ކA7 BC-N}~XVFeHz=Tk[ùӹGLe|sU7Pu"xyI/yU:cwa 730#*ލvB9vi;pݨ4VdU>8eHDy$0(T?qh*>yjRsXJ ô!=Vc[qA݇F7v/vȜ8G9!Ϝ %x [/& aɔ?.8`6X̅|z(`pv1JFC!dxop,BJ|}$ w=I)xXp"p>&8 Ǣ3 C AA4 2,lXb3-߉ho;rLwS8/]O{ 3Irp ˑ1Ҧ{ O"M z>D5 Voj8~p~u{7|ej 9S є]m臊8އ~d$(ӥCE(lЫR^4gωog[Gʝ1Өa6[J--`dU#ņ8w((-xL\qz'Ij%E>Z>C}(0ŃMu=^CSl%'EN"#.ZYH#>"@#g1OqrS®@ao|/}}6OxW⾿&`U3{vwgp1k@:lyPё=%/SQ~ mIh8g7itg͆l_^oGo_׏v5y>`F:kpEA"+kŵ^CM-Ma/\]w\]nvhuUR%(yendstream endobj 643 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 763 >> stream x%{HSq׻-[˔V1#6_$Jj[Yخvթsv$(I=(0TSzh"{@/Vup·@0D*=3''.0y%)ARҐFq#X K`bȋ@$A8]ӝUuTd E1l\rr:6>66Mud39wpb(T9";/ֱ Xb29G)lYR6~/g3t% !*U9FPC (BXH,@j|T4J_)/ Z {-k)G6,M&)[צZtMTsCnVka Ly$KiX5WATJ̚^jgp%%޿P+nkeq'|衿L|A=]Iw(UoSp'%mWRf<o0%/Ua-:x]-`du|i gh"~Ŝfyz(`; aw߰݌UuApOr?:H/k|d2 wﭲ7D@=dݼyhCD8'e>hs^HXcynNS;o9sCh+ljs90Hs0mǒ~{eMYˇO9J>޲.Fj | ϩ2$f ffB Vendstream endobj 644 0 obj << /Filter /FlateDecode /Length 9007 >> stream x=ےu+߰ٔwh zĪr$&J!Z18D} fe* {q98z5Մ?'_DwuwOO|>,U'_]w1p8'4%s'<*O_=n~?Yfa'_~sJ1.{JхilC6E)y#>)0y{W>LkM~ :5Ngc=3㊦0K9.qG#}]X;S0M.žpୣ4)7b۟ a 'c`e8L\s {¿Em@#W|AM1y~[a.^X0}͎7`_ica7 #0๸Osf>4Fw ^c%(/YaSbYvZM s,\xR`7G2͓Y$BhD1(2- .-˃4&@H(B ޘ$ y:e%C|e۰^>57i 9/% bvrv_+1&05 KsTC36"fC wi#[1vaX3Àu s;~˿}jH !3 BQ2:5OL!"ǼK@f`<9Bfk` PpCe +:pS&DNLɦ<tbs$!K!h""H`XU0}GskHfgdAob1SZ Z: rAjӳVxT a w24gz5Ah ö2 h8h=Sq`TpxOY P)(oit#<k3;#k?4Jp + ޞp3NpI^TWJbd#߀:= Q4#U*:! fKax oIcGj@9_1qXb uN)h&w[O7Y‹,UQ#b6Z3^oۺ-eB)b e?9`xb7hz!`MV3j˳ahxpaѐDKM^(1[=l 6n"E(Xi{QSE_Ѧs,?3Yi}kC, i#gdCQy_S/T(eVP~Wr|O C@gW:<9оMgC qr(t}6һ*HJL`$z]W!=r\sQ" A{KF>D|+"0iLM}@Zmʋjj(u#SVByfV:࡭r MWE:/[e,œ\ŗD31L84qͻj~81z@2(VɆJ"@r+cˑ&rbqeB8< z.Yo{?7~C rtvA )ᄌrb~Z~&ˆ )(UJυA>C]ٲzV 8tn`7=Xĸlo'zѵ)?E Ey`s`'cTr6]D+ퟭhVF.k2Zc= j՗ ~_u5< <[HAN[:ȟWbqZ걱=k$))-s0u 3N#)b`;炔ÂeEJ$4: sp:RPY?–8^ChD|rHp)1:B5M| ޿`By`xEd#j-JL+K¿;͵ArrQZ &| 3&;Df2k^<?#-X=? uYj Z vvQX){ʀῪ, /-A+fSZ.%ENDPf h{o@aYl41`ϓb@;Cpn2RЏmy@k]6 mP꫺lyZDᙬn{½<k@D2gm(o4Zu#u8Nެ~PV͌9%\sRFR%e[/H="YΩX4%I1Tx\3yI+&zYH&v!((mX.bp(ѦCJ6JgY3zԟoy X(`KΞ siIF EIyh W`#{9fe2i?cO4 1AQ Ff]YoD' i Vw5@鴢BFFPEGς0Y BN. fLR0a4`F:$Gla%wD?Y:^ZC~#E$B X'0aZQMG2wJ^L&I'xnRr h'գ/8M&Iѩ,)Sf^fNؤF&8 ,Gt#U\(4Ay,@`CS}(Cec0ʜ ,"S(f g+~[y i>HO!SJ}_az8jyo4&SFY8%ehM8]Iw<  gotڅ2Ak̕i1JB=VID0V`MaUz3\_`Ӳ tf2F :ʸ_)6%GV[EI.&Ĕ,?DSa6* TH|+`p @1_Jb~ZH+fz咒]Lr9gȡ?aԯ-8\9f.oBYD5q4]zq\o+2ąJ5Mz0-0@0i7uqg,`8;z_)~R[s .'?X"2g6NʒGK`G  >  mb] 7S":By2c]m\{&T"_C,xIO& \/;eMQ;|P$bn?ZDE/(Mhjo53I2V@GÏN(B= rJl@Ʃx@~YZ3&¾<}?tì#{,Pn|lS&_Il6GU,0Z01CC=`+.[ey.-6)QM{+ U{[YLkv$K!ci  }ў\ea+k*g#>m.>_W<^-t "$sFeE,mS!.p 2c"YN brhP}H2urySN"Sw^jt1 ߷52?wQ7<1|WP (UmQ7:vA8 ^gB]i1R_V1Co1?y[*Kjb7 Gx3A/~?樓CfFzޗ!"??y_x] H~NI29rrX]mA ثLt?h4|w5VC/R8r;"f} ɤ~B.FK*="oYOֵMN-ӨxB0f\'MҐ.=:gD02VYy>8KA9f-6 x0rۍ{MjQ2iN봞΋dME嚔1ftfbukL~Q3Xqy`Nĩ?s`Ϳ; ^{*d(|[ (\ U7M0j.S2hE޸M4s]b'0^RMߑ%#yފ D0greܫ5ƇNΚ=`*U:Ľ CΉ', }ZДF3#hOG "e=b*P ֐V ָWΌT{9Ù$Eۺ~QB0sb~YxQ<2>sD s652-*yHlEM|%c7:$I,K21̼L8poJ:4ц𕢷~1ڠ L(#(y¤iI{<%AlO,KELi^`Ŕr® ҡYnK됏ҥӬlCޘM 4ﾪJˊQ}[fm3!K,*;6uӠÂnmVWˎK] W~`r]u[VE &vPh//_uPK/#tY`xҨJ (%4cn,2%U&+:qSP=JgE1w rQ,/Qk7EuC_W$ Lh_j٪3s[TEЂaː(/٨ GbD..G`ˎf%*"b/*VCTc*Z;gE_# ;T=HT{T1bF: ƿ1Xm]%2tu FQ1W-N:LvA j(I zM ,`;_!ޒ.ϊ{ԁ>$8Τ#ؕcY z-L9:olvP|` OjSV7{lўrlΑ9Zl4īYIRme#o¤Kx+hݜHqqWUOԮbbj4PtBz;#%,s UKIY .%F}EʅDӶ-RX( D2U~1:XMQޠen~Y= y)ef:6CV9r,Ւ _*(h*z`567Nd9`r`x_oSы)hm?FiVHGx3lA%檶mdJe{X5Qcݷ=*4Ehl7ܻ{HA3}2Uг(ikyC:(e6MV#1F86k|Nn[LZ^J '+䟮~<E,; #q~6So'$ A*H%7 nrz:{(EdܞhWB+=1&*I!yQVLT1K'~Qt0&i5[ux\Xot]Ġ4Zh,"mP;3VZ^ʱz^3Y܉.OB`cQ$_!uLї(y Ơ|{{-c6{g)۔~9q4 Șh##c~WEƬٛLl(|pX5 JDܿ;aN~mF7p \Pљdz=9EO_twVOD.bVqJzWܴ}j^w=mŸy4rǴgm ،: H^>NlB-Sw֋to:vT8ڎ83&/rxKM)ܫfÍóߵm$7(~ܭ0b0Knk=qToTfY',_1T(qFv^ZsW _151֦5<ڤ86yDT$n{%S5To{W-DYָvq5ѮjU.0̩ۖJLi'Nɋ"5)¬T!Vٖ)۾7ėFx+L#Pe"{Qɢ{㸓E׻TWwf? ߟ a=gʺy/E903vķ+NAÍlCu2]uN:8l\`pO~7ɰ4z%}U䷊u7㶁GD@%T U~b~b! kX#25jZ[g\4|'D&}lĂBrUѤwYMe;Š 5P{R> ip/8q+MaG~5Eӻv?2c^OR5M[Sl4"0>4ڦUFu/:umR ͧ6 U +m{ ]v :['QR{wWBF%k_"XMuk9*)v]_6NEծ췐bH{7q𙉘۪eC< ʖ=~:vQ/(ͯ5%0c 8QA=_N*-RrB<Li\X8KGtVޗkCj.-sӿPWiIb|KZ:x; BYKkk &u{v)fN\=:vӬlznGSE?C5]=t,-3~xtsn#&7h=k&YN?՞c%B(*bvnoX7u7P~[7{+7/7/QAt闅j mnSEC0 NvotAq΢cܦ j{-<`K:jԼز$/ ڶ.F&b}>wScW<<ͷ cʸ7\ Պ._0^>Ʈ`ؔ!06q nrQ̻?k b0<jev&5ѻdlHWyDc"Mm̝aLn=F83<_#pK60Faa?Q\pIɡE&m}PcNڱ >G dyC}럯K#MpA\ELlk|ըpGa%]LZ6quUaq϶ym[ۦb=imt5dO)/N~Prl NHb+mxvW@'E|$E:òIn*;>*Cꂽ@=`Y< Z]D[X`Nܪ ;T{ƽx6[1]v) ֯Vr#BqLN\8LLZΗb4D{o@VЀ,߻xy4۶&n|/.~&EG&-ޕN7bK0v]'_ lyxP6CqU͸۝||,]-^ &nendstream endobj 645 0 obj << /Filter /FlateDecode /Length 6236 >> stream x\[sr~WCjJ;Te>#1vNyXQIꐒY>} 3$%It==.}4{.Mvr:<%<875W9>^1:ElŽ_VW9k[h;eVkG\.M.mWkkM/mt _ܽV**mItg6Zِkd} pVv9]^N+oV&¬vV&Implu4q~rL6}P{/uή~>i[ Yzc>]*0&7Q1euR: ]Z' d߫tco+x3'c=zLۘ ϓ n9vHS{oyx'ۮ;?;:vJFCŌChm(JX*]ie;[\dk!j +!jICwx mFwF. Otu]HP0)TZYV ^ %P(NjH?i 6kq0,Nr)k5 a K{> ߪ/Qb텐gBG)])}4/c)ģ9=k#Ȍ](1cOGaQmx+vfֵ؟}B oZxJä`n J5OiS.pA5Dyq*A&%n3(],oR7|)Yy)@gȳ+}CR=\+›'!HeCLl}Ee 0>V>N:V4@``ԉhuH0)>|f[@1"ǂ=] uЀ2N&ۻrŅ!m캩]OFqd l"B}cFpq=lqԄȟc$ 'B@Qr/)5Kb#v9໺502k@bl̝EgA$`[3l+[Cd HOjQEvvsr^!lTK4aEACp̓" e[SlE3Fsyjն^(bՒlT-9YEna0pr}~D""BylђFWI E ]#G߈8œl"0bgUŦ1"!k3wrBlq|Y!`9ah$r3Ski\["=@_y_3?Z0)}~<3(UOC:9a8E!M/=27عM>s`@A"cʼ=q7"ID:at3A!wHc&nѲ)u4 X)'$&pos{;16Xpl|_6f~\n$ɜlL{ S&:-[V)K^X%mcƹCK)J.Ƨ kFX+>6&(I1c#TDIz/Yn!rCb22FTm1BgRM7GaSĩĶ@Ih58guD_3qͯy<D?;D:JcSa3;ū'+Rh=_M<";umnjs;Z6Zw%JLa4H$b[wh󖛈6?AG(:ف眝p:@yBvJ5|ڸZrV8|w ܇*JXNӯŔe$ wcm%_ֲb"8#\ %?-G@VPwq4F>io8j$EěD>˓EpNxxqq8k@n_=p\&\Wx/seb&ak1{< L4]<7{楊:o!Ho,ӤʚJ*"Y\NASi%U("ڡĆ'Z[bV1.VBz̥Jbt-; 9}zqm}6""P!$apR)ǯf=I낕1 wgqz0m"䷰6my*_>m[>L!\HE1",0 `%I54koT,`(yJ:/HRQ&~qjjy% NprKZ[Yw^{+*^\~p6\A7bUme| ӖqnXDyǿcbjb %luSnX-~z+ EI³P&vG.W߅7 d} x9^ƢDžK0 Q9,O2eȸ U cEb[t/p/UF}/W\NN-dljLKKޯ#/5?"k&Rs?{[;/Q tЩ4/GWxUGS"D}S=0z0'LnKW w#g 5x|] bx;^uYe,XEpU;}?pH>%C@p5/~1V*1N UH.Wjm^^Mړ}bz+?~9](z)<܈ Y|Mix";V*BqDaMfx%&K>,+ }? B( 7:27Þ4, p*-!2_SV:V$,#9?[+G:B9y]Ob.fA朆w^I 9 PR_?[8(쩎Z/xٴH  b6 dt0Qy U"jt!_||8;N$dh#@dJ\}B @OEXV.y`f)ވfڏd aR܄?fkjrH""uB~BBƭ?^.GL|w+Mr].^~ܮendstream endobj 646 0 obj << /Filter /FlateDecode /Length 6439 >> stream x\KsGrG/UA2%JKɻeGxH WF GuWVu`@al{嗏uˣϟE{|qs#l .<<9M:~GTZQ8I?{ YOҏy2k*ӝμ&GLΆyoHڴF Rۈ[8J;<>Kf!Ը(7 G )(NНx#QG=ŮJkFuNjJ^K@4jaZg3Qq˿neLe#Gk388^8`,gb<)H<ވ&Ug%aYgh;_FrȭVxe}iq'WRVi-Y7dI@F@tn#<9hScꡤ]7 a{@x?5Ƀ,8gJ5aMp:HHdx^` GrSNd ;Wg0v7ڃl&Z]4߁F_)γcd3@7Q KN\O=# 8ڡ XzC. |íp|y3}H7!^Ry ό<#*G3E#p>9o02R0L2=f1&3=1D2-@g;ZZc]ոtmURzyanA)jfz # b眦0h's+4ӻ/@ Ey8sň7"$Z^I&j,%Dӣ[ E)Ҩ] p|=hk̡ !هa+k!˜FƹG@c79M0ƶc" **#>K`)QEP강]`q/(FV>&G ̡EJ,~7B@ (^I|9 gcKX2.cG]z("#pkTx)"F~ 6(ǵTu.)̋Qk`ް;ȡ I%XIzϋu v_pN. 'oY5n8V67@+^I#3_`7S?YC׸TxBuDNdX PEϧZ@lu6`uk N/ir{d irIkǶig8;b!`""AQ"{+i^ Sg‘1._;ukqBצ:8Hӓghl8 1CLYrB^4RGEv]sZTJ@LKPNQ2]d\ ~>\CgBpϏ@oCO0/ܯkT)8`F{V2bx,^7Ώei;fP™Z6N5W0&$iCwǬN`Q#du '!2>JRA px"exE'}{\_]8cU:fVCP c8CXPx CY(* ,/ve RDu` 1lsX82@Gɣ'm߀C,Ǿj6=_ϸ6['M0 }p5sN/} 7VIU5R%CUwj3 o\ Υ`.FU.TP#n#xoU0JQ0@4QD vo *lnUɅתT wqxvYT<$P}VN?jZuZy`0LH!؎_bEv2H1kЭ^& rBŽ(eﹼ);Iu蛮b;ks)P,)m)"e Ufj4 ĺH:EFp Fv,*zI`Y"M)6T&{C-X Ն6}=bsǒt KvIyZC z}#&,UNdXq0甀kGtK!>lr|!UvItNq/*Yo7zĭm1w1L}ĺ8iZ4Xo_نR{,GVeI0,7 <|%L9Ǻ,c$c==d.sݭ@)Y}`'|l>f ۚ(_Vx =%{`vypg]:݉nAߥ?t^P/bZwZn5j WcpI,L8Y簭B :E}>bgojs Tdç לW 0BiUe|ΝLk]]ZJD)` 2e,KئgXaNkDlلnd'7 ="t("cuM m&.Ri<=nQQ*hWٽg8HeFmopR8Iu=+)JbȊ 1䩱m2Ȯ pe,XbSF`1p9s_G* %GbNR)^[~~(c .B\%/ŀNZڎW }TbzQyVU|E\*C2j)A٫OҌ7گ @3VT_4D-eEA$lyN~FFGx{/Jhge^8IWIWjIi**0X8,"{2vBNn'`3f,AuxՐ q[r `ܚEy&~s ff]2 d ]sWf/5zK=ݥxUUz(F&/[bzxR>&\#TlR`(QѨ|#bKaY<"wn(lf{H\bɔ3}`{OhM[|IIil"xYhg\C~T>ѯّ^&ͻVnzWٯI6N#m͙p4r(0CR(zLPSKsy.w*&h6?}; ^VLI\YM\[aB^WŶ_!qx(pP?c"h*C.i!X=te~3l ͳl|);{i1d:̐G*^o=+`,=wх_TˌWN,' 儮sS /?Mwdĺ;7- iBh#:lo)ҷED)[e゘Ձ L<|86aIE&cAPڽPQ)渓E?"d xKxMV9Du7 ~2ʍ5N^y r{Ù#1v] BLsـ8KR)Ոju&^p#a>qg}lax@8B(phO4b lxH)-M4Dgx-Ƀ>70X*7ʴÅh>dgM2MٶsETJZdU1I„}jMմ+cSg8B5$- 9dL ݂WW9lIG[cN_3usSNê:NDl ϧiR(2bװ1)1iVܲtO1WKIvVkڠ 3Us~G"s2UM-jV;2Q%lʖ(*ʷڌ_s3Rs7D\ؤ ?9endstream endobj 647 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1037 >> stream x_LSwEK-3A61CaC60Pn-*0&PZڞ,D SH1%aHEϕv]s{CSMi~Z ^c,[Jၵ/am~:G`3(>!99)?̟0EU|fXf0P ?|LM)qq%X+Kߎ-bc6k %|P%YEF^&]0jDJ *Xdhl*ʣҨ $EqT 7'&ɡ6m >zCqqocFt$Z.'1 ,:?A ? l$3Z1?8d?AZ P;}l*♫#sK+Gu]xB3ZuOFYOR˶SU<,*u(^+^gURmc0!`'P!ۯ iU؆L>[X='K7gݚ9OoOWo4\a<Z͇SxG?`tR+C7`r-:@27EOoH4r 7H|1953sz=V܎ps:go~ I6Qa;SMT=Y\,lux4. v.mZ&~ m]*E6ZX>03;꽲[r"g0G)#HNROxaVKƒHBMZJ0??C!T>/npCSs\VTOw%d&6j(2o3d?p_b|d(\UB'sk2HpVb]cR=f\6Io]9Edl(qunKy؜W:r^R5HQ?aɅ .T LVzJREQKendstream endobj 648 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3049 >> stream x}V pE؀qsi4Z'4\HHCcb%ɶdc[Voo,˶lk̫Iڒfh\h>RәIH+w!I37l~eBR 1 6NO$ſ;'0EU| yhߠ/3UhҗXrUO?bu:u@~i|CZohӳ4j)}blu_\tzPTWT 7K uM6ueF"}P]QJu |Ӂmꢃl3k bI|&^%v'v\%b2Dl&ۈTb!&aA$&{ 3. IIOsgfS GTO!SI+h fDɍ2i2CtrZV~p'͘_\X Z.D=;O#{)>gx+0C[B٘Ü›pcZ>iT|a0~8De3ߗ!3^&,ZfL 6mA .É|Bz88< ?mxzohIk^R:Om1QP~۸l׺:U4+;dbH'OTLc)P zR]_F)Z <=~u8`DqzUTdQ|F qO6ܢ:<2'ږfǁt@p9؄"%NAUa7OUu^ڱcwYzJrez (}gwB)ߐ84o JNݹ%CKj5q9Θ%>p=\,שRC^eQ5톈3g4vJS㹙hCŵ,1ɀV`Eٽ#]*iF-%|޿0ZkK]Pvxy VԳ!;@K#A#w~q+,,qdXW0gcwh* uhm9)KJ-PN{ t -Fcj2ڣиvy>tnM[a03T*aRS{X\ r,8ځgeԋ={֠j㛖ˑU>?F5>SԪ*+@/?ZҐ{p~T.M@995&eC)Ӏ]%zƏcWltd!Je| w j7V^$79M͡hostR`Qo.*)ɍ?J M3{%߿yY*Po+1K-GsBAiЦC;6hl&IH.&rHO0C dj/a ( =ORzxtm16]eT.W /6DQ53zo)u?K,3A4< /Ƴ?}΍Koe+R[Eү`j3Wi0><~p$P7;5d(uǨVѓNOOYkn q~[?GVV8U/_(MGZ(9nT]JE7+^9$ofUq9Qipô(g0Qé_3z͊էihIpG:V;j<Տn!7sPRhH4ICEN܃EdH _:F$f$oꗡU#rdtDx}Oޑfhm^3W CUbJS: !6J5F ¬kUVERRR﫧endstream endobj 649 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1039 >> stream x-RmL[Ux Lh/EP>FE 0KCq1h--愬Zz:pT27EBPL0p Dz,&n;޺>}ДRA4eJLᴸY!F0KJGXbJ9`(6Bz(@14mq4[U6!,ZHLI1!d*3 F[h7sY DUlG.lx!:FpT*|SZo/dkm+hG9\cLV!׼d(j]͸go~AaQld{]YY34yO?@I 7ɒHBm)]D;6qߍ?uMUX+obMuvx< [=;0b){q7>]-L,u׺x\#gMyq 7)w`;MwѶq78Q1lR7>c`k5&?{ψ2;(z/==֔ ^  ZTC6~qHe)4ȭ/N424A]`ķWgyn9" ӒcЏp$%B~jΗ $RG"^_^!y3_R\I_Hz.}b:stշ]~Ê빌tÖ=;Sq:@,pҙ0Xzb)|2 ky) ^!MR0bT/#y| eWFsXV[-D4J/e'eD,3R,J>s;e7=Y}9-Avc,DE8 1xդ?4q~SɈ7uwVҮ|O6m4M=CSZ"Ǧ^[]4Uk*Eendstream endobj 650 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7123 >> stream xy\SWͭR-^ꮶ]WU\ *W 0NQĺ'jmmms!}aݜs(>H$/pqu8(aHGx"G {tBڲiFX6H (8R0f;g]I&pp ltp #xE:u-W,YlNĴ8C/f1SZF}k 冀~;U p0hĠ2G* 77;ysٛmg*mkl͵˰koa8`7qCo[\>_u(s1oG- + HwE 腻j2"Ry׻4vJ⒒Q P*_ZԴK߬`]3KjQ% ]QJ csp@g3+XohСs<ՃV`Qvn>Q)w>dK;,%Gwti5g>/~lN#3ƽNOp% VfUMtנ~!5FYkЮ&i( գ2kqU8%{בW3-ǰg*,Cº=7wzo"N`pA7.#hX^>| u07P9Х%/\N;MWfVNi+d$|CB%?’ޅ>x*rwW\qyxy%tBN_W/Zr["#nQ'agɺ3^ / ̷v8U Lߙ 1cw^%x{jT zw^A3X\}Q[RoqQێ2KN<6lL)Sa,籸+(U;I>f~e L Up`MGyrWX|KBG[k4<(6&|-(EXo6Θ|knęR7\p7TZ.w}1V%]mHѲUWqO8l MBޢk2xOJ_^2B+duV7cN_4r+/bi)܇9]1 J{[tk0, _iPW>#fu˪XVNB>-˒fT>awui@H@bC텦(8w; J^-᫘wyu)\RCDb6gsm^Ӵp&5}=6c zݼuPg%xGDq.3͠X@N6;cvRJ{_,)ao!5K9QS2%%f6O*s.3:\ɻ=ژ[I†gF9sF=Nz^9q Pf5Rby<`y) |&3{`-E6m+f81~RFd_jPnS :NXLb3X^uH'lB\vNv*gjjiXx߲O7?{;C2hQ:Qg!l1!녢Htd6z>IZJ}RQ<)K1:8ifCaHv j/찬~?*=(ͪf2uJTZQVyv52ut6g[;@Ч?1jJ_|}},0j?]2݁F 㨹ϭ3tK4c@HI*\k7;TmR}_I]AvIrG':)'fgRd}:\$VDW.?QJGi1@WtJJipTdǞmώ]Q6ףn!(@O%rI1͎wǵ !OR"VSxs8r>C'cG {~Nzh҉C]X/U`R )c8-7VYm:5]J_DaL?^m]cJBq xE7'7p1yN@1(!ĖƕQ&,.dĎwpeAs+/@7 Vhm <fa-@Uq|BIĒÕ-wsϠQ RҌ2ܘӣ3ScP9ѓoJ֏d3*:KVN*r.XOaO2723ѥ%]}Qgꬼ3XngpdFZZb>s"]#AZ-x Q7p52ɘ貨_@ݎOܷy6JwedVkva0kugS2IӴ]^9R Ǧq'脄$ffswTr}mas^*;6`0HDdw:րz?OΦ}uv,3L-:/k!9+@('F$q-NT#`Y++h =|B 4 ޖ[[6^.B|$7p:C_?ߺy<q}?4_ M2ݗdsں8y"=" 1䲪s]3'{-7I&=2!lO\5WlGdSQoyV~Ǧ[˃8/ڏ^F_1`=6Ξ1m6BSS-N.QqeG:{_lhJ'Wӵ9d^4\ M<,۾W{an M}jbIYܮ] ^n_4+mUJ4BWrGO.Y|  srHs2J<~I/85*Bk+6W[79[]KJNJBJR 11%2 FA(Yt`8deܜ\cd Ű _/bD9tC:q$س=q[8 մoʏUH\S54X=$:.mvtii Bو|e tzxz^ZO|~ǩN:a9RpƎxFD-E\{0_wA]JHI呆".=eDUDLl!)w5|`| ew9~wmZ}>?UÑ6t7?=s _p_E,]1o'a<~G 77ӝ{|nN1~u?p:(0.˽eDgEhQʩ̨0}1:-ڂ~#ɿO ɱ(!AS[ ܷk5h$Upb'f\Bs1k E'; 0V\0|KdcxʣRHadπ͞^!A>AmFtHɏAlvafۅ& -JOKFrEUm^eQ6yaÆ+[W8z7e!+o8|*]L{ ;;7m\9OVowiʦʀmXC&kwIlQ^I>bj UjJ{x*)&QL~\a"|=JUYʫkȫy<NV7u">~;ؑ#~ ^}N ^vIv t^ kFo[Y%$\.Ux-c >?uy.\~h=AOBBwyDGUŚ:/lDJޓDa5'Ölʷ4zG"tZd%b/5/*>vXݻ&'Z.-MN䉈W$hAﲥd c}H+ѭd?C ;>Yâb<G`W^ʘduH ފpwtb۫kS7[l/Q&/ߖG'ޜi,!(1'XT>zN!IIh&!WV[ LnbOꠉn("L<[~fj 8^A P<%#s yo?8қRca_~_^/?z+gt[pGa~r \*a٧eu>;<(1ʲ؂ ^ZR.,F9> stream xWiteY AgN;KUE BXcIwN~{ߓtJ:Ng%"(Up.Ez{9_b8˽3ѧt}= JB٥:c֙x?B&spF;9G "ott4cM@zߨ]Y 룣d7¿9ttġBa,ް v,vv/Zv}vȜZm6,ۨuf,[ٍEЁ pT]?{}<2o6|\2T?Z2Af᪹C kk]ۋUM5 2CB[@\@^(/Zs;6r}] u}x@ ]ς:Af(@ySto|QJO(N @1]twլ*csG}zo XmJ,{LF]㤟 ךߗ? ͍4[ 4fR ށKI3^3hQ(z [8Cc*VֳKG/0an+hM$`A(_W)Z4~A io+8Ӆ~ &xu/7%|B]i0Nr^Pyo'y =#GFG[kN7} %±=%hoVUUɫ5==hF2|F,; WTн!Y[x%ܑ7v甽Sv s˨$y>TIURMcmG2ٕ$mZ".߲a#*u ͆*Edz+M6hO7.:r^|+=e2q6ǾҨl|8qF ٮZav A~HPvI{=Dk5~GyD?,`C|HdM$"<׬PrQ{;ͤ7^o[z{;:ڻ ΨA Nc e*MJ=ms DXg~?Țwz.wt?AS.oS׿|fj3,/)dX(+EW 6L's~jGo6E!s͇J7>\9캈>m o(vp7Z[5no0<>$G1uϘ]l(Nۖ'Y^*!1ً&iila(i"$`uOX! cO](qPd.T>F*mg¢Kԩ+o}Vl1sh wAK}5P ;Je[; A?ΧGY_خm}&ZJۙ6E06AAf(Xﲍlmx$D,>A#׬L[Ў~EFh3]NsZpKerfɛki^! C<3('v,{7 ̣HRovJp9X~jNe:<x|StBnM6 z\nYѻŁ'8f gVoxҡp΍1)K'c>QHqB!DOjɍDbHJf#swc撶 F7t_endstream endobj 652 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1318 >> stream xyPSW_x$y"Z}"/QiT bqNq4@@ L@Ąb5@@AFEܐ.2jKLh 7sw9G<ae!7qsIqIQ?( IAf$a פgiSS8 q8(44D" Q˵4qU2U5r6K`K%2u6e"X*rN$Ф2\<ڒ#\Nʵ(M\FĔ>ӐP"wIل+Nn>n]z{g9tq)}Jr9h7~'k6MZslu>;VGOaөQ3R˻epno @an~D(78#v2#ѵq/\lKɐ6EH-& F[AKJL孢c:y7ᬪE^3,08[``n^?ԳkWarJ3 88$njϡPۓ|%:Eϸa!K!TCXJUsp5ǧAd(r;I$'s;B^Olֽ}f3^[jlMU[l|1KPUb)*)fmm=CpR 5DU |_PpKkZ>k{nB@$D^G D[N&{| lEE#$bП4<]cHZ i;[V>hl?~~A:˾؂$tWpҔT *tz Ne> stream xVkpSe>!m8.YZ.dA..qQJbH(Ioi6m.M/iHzޓMzI6%%-k(7[EuUtEvT"wםZf?̜}y?1)IR*d5˖.f-U=DRȗKd*d2;_U%#K2+ _lQ leB*/_-lɷ)2"DYbDl'vD Hl"D'q1R*.jީw/Lhzᨓ%&t AnGZ'tZlYPeW oĕjJ5 YlnzaYd||-02r6"sB/'m!hZxAT:0%Vt8KwH" Qp̷B* /ydE{qf]LɤSgAsZ /: 3eY ZӍh:^7Qc T CaԐf )G_~ JYGof=T̎Vqi'}:A6v$rP pNY34BDL Z|w󻃝({1w ȣ'N:{sR. cBok!QPV9;B\`l,=SY *A3XEO}~C;mA-.-n.y d^;hu@xyCYTzx "zBkxجg, %uZ zm>8 ?C-+kк^eh7|fU/y람<辦?V;X!Wm;8TI+] rP#cJc+jCd Oy37ѻxt{ՌKV {f^3JnX4~+I}ks*]Y2a忴=eg`/Ltnr@C{HB7ف~mCvUκ'YV]y2bޚAG)Dp,jnxQqY8v[iPixajX .'qY`<8氹 FgS4@n|=V~B4'H~(--Hyj"R|G$_}VC39oaè*(c/ K*'\$ cܿM2_8v(_quUPʛU/Є=q_BS.vY5ٓנ64P xRbgyZ~+muAz~fQ2Q&@1_c*Ze:(|enr ӡIH߿}4 }3ApɱzƛEy|qrMN5"f'mzd,Sœc*T[T@_̶f`,wG{ŠiPGy\0]6Aj\<8s1hFǔYpwkCze0uk'ץ Den5q$@+yWNA^#([|%9gᥘxhFk6)l 4Ž2**.b ^ktm@xχxl% D~~] -)fp)MjZa(`XQ5GO4P5UoWN } QOgrh QׇM]WI4 ?@?qrPp'eGո|q.ZQQ ɕ%4w;'i M.%7;ȴ&p8IۏAԐz(sċEo)wͰO`Z@\MH1M;P#CŝEmY yGRX7.6,Ɵe稼WNCc v7MF3G^It>0^Tfm~ZטRj>^G7翆+U(KA?`_57¢m  wClfn7JȴdC* XȻ.][p;ܶNۛB [v^ʋ&n'S0ȪNG,.L"M 7lpWGgU&@4vFnkܱM6Dc]^>F _ )PX[MGUl$.pH L)E-bܳ$c;Excjp(jzF=-PF8lIendstream endobj 654 0 obj << /Filter /FlateDecode /Length 7258 >> stream x]Kqú>l;zWBRXL!B҇!Xv ,@ GuWfu.;tа]||t0׏~u׷~Jw& <rqKCc^{7O`\=<:'rp&^Ņ'}~:L%ZgwO6鐦 fǰw%LS +ZQr)ϳN>\,lw:,|_3~}v}G$XSx3i:I@S SUL!0Z4? o@1u|?&qa#6"PIW/G{ŏCq?){c`/p%HE:-l-?uO0HJIL]ב}s9x웶0siFȲ; ~Ucwb9Ԙqz/;|^o'[!v<{m/:#ٱ8\ #^~0vNmi@K0:MYRgϚm>QMݛ&ԾW,d'ho-(O\+ɿ5}.-Ϟ'p1Fh)~ux 9@s,'hM74yL#ئyŋюxXzYrev'b<0"+`T~OSvcx fK<2tNObD`F6T)<}nbJy.u%HYg(fjtw EJ&Quĭ8riwWlQ*Wa׾of5&X[W!Yf{*x}#$Uu}$^:3s^K8C]6 &{1o2`*xY7>VO|!j?y8Հ߷̯ 'MY(| =V-(0`oǮmٌƃYKn[x$9:3u 8BJ4 J&v&."28>sHGCn##xY@3*941vW^5`{Xf!)DHh @$K{i?EXdX<txT'ܖP4^2zΏ-#L<6שaH Dl-}o]/w&_EM p͈@BDV ^KbG3~Qb}T:$oy2FE:׽T0N1nx4O(r:;b\Mlǥҁ0"#;B<k_e+D4$4T7h"Z 4) $X ~s nS100G"V3/" 1!/X6dաgju'We4`fWG:bKWZrvf=< 7KG_g~zQ.|b am5x&FA)K;/$҅"3tIqbT)e\*q9X>'(lr]r *x.zK)9&QK MGQeQVH+U@&Wd,GQJPk;CdDڋ)uLY"b(i*vH֭ 0O&:PYCMH&$Ty)Ӧ"g`o~;B ahh^0+`Apz]r׺2ZeMZU7V1 f!#|/ru2<\O}"0U@9JQw`\) Lv ;/7zy6(Tء#SW<,uG}#bqV:6sԄ2>2hwaήS<;A%H368. )/',#<}B-Je{'#?#wl߭9'KsŽUݮl#dqe)0G>V F2̎L,?_ sFnEjUP h!I'S"Vpf6 JG H. <@M uZO5P>XR[7e>R _:3do YBہ4zSNV٧X:". ^̼rJNΦm`" .I~P")QT2 ^TV}*HGf3QqtΉ%ãOxfݺg.;Qgw$&"$yT@`U_@[Vj˜gT ^1a(a/VGA!탰IQ4 Z\t4PB^R|_8987V0N^ͺbK"#质YH*FnNp2v -q}q%a1a%1o.YR8>+>z<{Ey>%'y;PTڀrw:5q) I3Viw'[/2TrrMϗ#X#ƨeSlV=qyxy[LaCWG.l< z\f۰j^._IuʝKin;.IzJ7 v,qkS?}ӛ񂀮eyV :qnyZ)>GtWӟ( ,Flӊ<4C c|Fkqe]Z& NTʺtMol (󮱙X ox!=[/CBKUDZ}tʄi*&1i˧8_l~2߷Jhٜ9KXơU@&@K|=`D?aY:M? \F{[tXw5aQxL N.!uF<:?mh']Y: Q{\+5RI]>X}X]\A0JKqVy\U3U2\2't7 }8x`P9a2λ?6>}c z7W'%;88Ko1~c붰t[8\@(n sE$ sC9gY%D/Д5"Z6~6?*sdÐCW#3Yu?J/da7p|ITT(?>\uK-UQ̌l{҈V781=cd7-I .g?^( )܄-B+YH}E=یr67c؋>")ڙEiMkSڅdff*lLM1Q$ @G^PtQ[_Ѐd`~9bkDr򧮁aKY?u.è.ȱ%* ڵsLf`~E1R@H7IX^q?"M8*D V_vO>ʟ>K%k BY˰ހoX]?^T9-Vv!̆&9݀4^j5dߖW!l//zɔaqO WB03= ]]Km-//v Jխf wX/%{oܗvrЦτwuK9wDY% !qDm)Y4,/Po-N_K> stream x][q~} '/ьw yvb%c=Xy.ȝ.)٩ (C.哣5{@P_Ϧ:7O:ڳ'}/nKOm4s~3zP9Ĵ^Ӏ@^ a;zDoe.epLZ7+K-Fq=G̎bڼ$p;c4 i%9"?tPqs#8'Sunᯛ-6LV'%9ȏὟ*=c4P'Zmi :Nz{D25rͤhim+%{s^p*_Q8~dX>l1Ǎ}u6!M |0J3Ý8YM̘E/wY #o&0KޗA/#VZ^*堀LT g!w0.^sZv9 ^V%'Shyq@?~uV4Jv-BCï,PUK] X R/ޯ`$Ola>(-e K:`tDBMc][Jjlґ!C;~.ʚMVfkź}a?{Wb*V{/n]t0ބݰ& ә7aU䯓fyn>͈>LtUcv]fsx^{~jh}:,#|n"!Pʛ`;yhH[m `yYiBehqZ2FkIo߂Lu]{YF@P:UeKy0d(ǻ- rժ+f$ؚkmywr,5;Py(5Ru5obւ5廮eƧ 3; AnrN =clUR1&V4͛/9@&r/{IjV{@5!mŦ90f/e}D7):Z5$ h Agz9i hJl ΜU [L z @Mo6hq; fh|ŠpT|io*+|زM24~b+ޘ.Tx>ШUDL$ah4#GEL`O;p- >jyҌlHvO=i)(dy]:Դa4AQv=A6ЖDRf~Dյ5;.d;-9=X7Qr)Y!Wkh>sExfA9j?1FyYآI|MK~!>s6O>ר:c1[ʧp@ܐZ_QKQxG+ʍeri0J{[H.bk+wI}ɯS΍\ >wA게nX v5^u ~Y-<^~Mjx(fcPԔMr.KLR.ʠL@|Qzp-|H@`Q쁎=QB3&`ctJCd1en^׿;}*U@u2:\"Y+0 gI (+M q 2y~2F¬- Tk0a=FKq#mP'n? z٨-4mִ%pXs~>M#; P6NҒM0UuXͬ`MDiyJ0#$\#o+5x"qŽzwWCkNP!V#Cf RB %X4A@? =Qx,sy^,60+9#eSFxƁ%(!Ԅ k XRK"m(yUBD]n'$=K'*(UK$dso;c:`U.xhyӻ̦f^lz޷iL =5B秵%ZQc^:0 q Z$@SDA2ݑ =*SѡY(BUr[=c_ID 抒ꇛj[nf<ͥeOGSnHitи|UڻFΒMd0Z;³HY\G#KjZ_TvD fJrZ`Ij_lb/1zz& 5%AB;Ǫ CWL&&JoAarطTr{}+ ,H>&qƌiVR~OY}P+Bj-wēLD:Y>EŇBujUJ WB;y4-nK7Vy+n&Y>Rfmy]7,ָEt1B D:g02v22!lIJm֩ ",׈^qP0' "-F|OPY1inxkydmzE) ,hˑ 6E0TDV')>vpDyp96y2Y1dzb8#,` A##.%pP_@;=-3SZp`dAT<),2y&@3D0Qd""ܤ9R).K@pQMJ#Gjf6em&cNE/b_U"5VtQ0^E9XfE&^a[B| JQSSy7@u\2_٩6Aa5}KV[>|R9xci Lh˯Aު0m5+ZGaH[0Y|aQo=ɓ0pb]rqvyAq$n谭e֣2<1(~YSa_ sBpm4X3$Ҹa^=[{MqW %heaBjCTOAd!ֽu`Xda AB*/t `et%δ lE*- 8Lyf Y3Fpr;'0?>%L{_=e0M0ǰ#I $cET\ds^fq"lK`4!L7ɷ)#=(2{ Z]( {eJ5B S>&LN_gm/XZs2{<? H޴pJ.#Kfnu)? . "^~K )υDH .S Qՠ.z$c"ܭ' 9ϔ(K ԺRDU9ߥ2(K)Wa8-'n7l^8생]wU211 5{ Oz3 -N^Qv+l?$`,EQ c ݁Uk#CisOH j ~]r/u8C`X(P] is W؇ڸ,CjF H!@'~d- ڱAr/صT[?.uo;~޿D6(g7 􋙸m/^]ګYpei0+f\X"^e6ZuJ$ҵ< c(aG1Q8 vg("]/"K-C=ڢdr䑅|ʼ;ۦsy>`~w2zK,1 CL`fFSW ]x]vyL%E*LubRM nвė;J|XD%(1w;ȋź}wq ü@}2̭"@ErI *0S9xzd-<>wDrWؖNrz +NeW/-$_*zzHyGc"VitYt6NY [t=`Ȟ P'-SL@"SAJ,$Ujgvu#t ҪC 4aMx6o_6?PV$?  ]uq_gδs"%!m|/IVfm $ {n x@m"F ~-voT6;'1J yNbbv"-r; dT{Euu8f(zU=OuքuI%ދ"9ҦB2G>Ógg+;8yGߗMXR08BCQ8^|gK ȸA]{7t7\sjؓH˺ -{DI=ӌA&,peF-QS̮RV{BYxǨ4ubը]b|\Sm}߮Z%b6֛|D=Vܭ}ԀEs֩>^Mij #vSYez|[oof}F,J&鰞D{f aZMo^yN7g>d 'Htg{4]8ôQ o8D+CF)6>R8c=2#߰~,xsOG?o X.](4? =B?k:rp&=3vo0.ý"EqB]Jj aqrԎfvO7=2 2ȹR:\G KW8G2ilku|qT:0C8uøN ifGj۰S:'VJ7s8fU۪}2R|^mki}Lt:7.\JI+Y]X$F{Kʦ VU|XN@k,Tfއ2N9):?5׌ľMrVzĴhH7x~'i2E^,MLy&{`ǻܾ-$N2^i%\ }TL.#5;>sB( $(PIg5FP&ԟgc$TU k}^-nVA=FaS*8 i],Il6)a Ky8)4 ?CV߄ZWA}$W4>Ph4k|_{_]>@ޱPHqq VkuK">lģ ^k]>F۹tqqף٨r?BΣ|c_VdKy'Fiֱ|} Qz/=ݯsgǿ}➽yl7|3\ּy֕s*ذv`ה}Qi_*6 SfuGV(iB)X'p?).H aiZ*Q SkaCQ ]tOYj: ]\i\#>mcp'@la0VT eEDxxy0WLF*fމЎ6Q1% kdq6*pT5g"q!MϷ &R>3ԩ}i&o߲\~8$ ۚ{U& z`J;j |~Mu;Y4/-e1zW6yERG+Hm֞6)kph'+iQf shK_ޤQwt6+Px![Vyeg7rau݈"K;QM3>KMn3TKm5rA~|Naam1x]H ϗhޮ/v4exSM)Jm,kR_uz endstream endobj 656 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2429 >> stream xUkp^auyL$Ӑh4<3 y%KkYXd=lɲ]=dmْc0&ghH M1@$mI;m\Qu&]C;Ͻ{=9[|p*^jë_#%]Z|T],Hڜ +| yb}wx_ޟ{|YZ|ו(ULZ%~i&@|!TA|]4rTh7H֓DLN%JڻXsoTj(ebUTh':bB"ʔ b)HT-9*R(h5!RH%%VIbN~S*Jd Uh5bL%X;娭ip52M(ؓXT7>HZR]©% L ,.JMA)ߢ#ԤTIݸK]>⿪Trݻʻi5np?K%e}a+jVE$&d+`2{;möc;nl#hX3gڲ\^<\5+_ UAƘ>瓼dA>jvAQ(R u:[As01N pcY#`nٵRZV9 pXKꪷ w;aOSFPd7Ϣ۳-"beEicUZ|d~h(7#047yis_;].8T rڦ+/,@coqWxod2z#g4UzdRސ1ox;?+p. |P 8L&[ y ~zjmkFϞ OpeLILJG{VeF0>K#J߸KלV /ƥ"3c8ݞq+E1N; @16Kb1۴jU &ƁtWbq.o0w@cҷ6p8)tL{f(V8 ǝf95˹oH'3ק>}NTMNCjv h%(pegs'+A[NEgϒn^(.NCYfd0o0fԣ>-w@^蕦jtгT5*P;.1 *إ~vO}aSrpPevZ4\M'G2ՖN\Og._#+>On-ϫkV;8[mm-ڭxAys s漬=rΊ ueP0kw@-MFiHn6ՉDb،7gRU[%# nPN_ CxWZjhEf&==p9EzZͨ&0v\hZ!*t\yܹw0AL~kxi`H[*mZeYsA̹[? |s>>m}LIg7F g/II]^gdZ5d,-D‡S}$K|9s{DUsDHXj>8&..| ]C3C^+X\C {oS"+%6/8^8}wؽEv=: 馜s!-2UrCڪbvjR+ Sd$zƟ {:X1Y;ox;x5?ær9mnYsA]ؘiocfMDړpE&Np?IV.Y!( uԶ_X+a5cWb06>/Hv ÁH}5go.yżU?vbVw zZ [nbI4~兩nÞYr(z<wmU[Ue=*_ܲccMurD%hٯEzx&]RE9Y;*@e!~ bh0[RJl.ɽЬxxcBL ՟-lq =➻w_cؿ,endstream endobj 657 0 obj << /Filter /FlateDecode /Length 5586 >> stream x\YsF~no'PF,}ǡmhڔH&GH8&T22_^W|qɭNo~.|89 T:x 9Wώp^W^z*gWGK룟fLs-&xߺF&B*'۵66n{mNևnֽRٚc4{ -2aGsOY.a݋:[wlJݱXwr0 V6f;]o5}No|.*u4V*m7/iAؿ߬ǭ4)XXJeS7M6'М=uuI=ݍ5ʬ6 f~]{Xr6dXt_&Db^E)x۝]rʞ6 zE^fן=w/GDԠ*H y 6̖mTGggu79REX;9c| n"ҮV;VpHFEX#5eg8LӦ*=< ^|2E՜ݡޅQFpz~rPc Mx߮ e;1Tm0m, CQ0mLAh*]%XS CsN!K?Mh;hTM{h+@"'Sv_@euoHɎ|ߔ"J  `0Iy8:C-NeXZ7Uжdo\B@b/aFsa[zidīj 1DS<%d^Q{.w$dS$2~I^&ƛ%`mn| 5<+}0I '(T,Xjp7i>⻊N !P1BiM3‰|E/ϸy/x`2g&;] ω)~/6t(88v6a(޲gڌL0z݈0VLs6Z٥r5b;  /wovoˆ0eoDS(~Û?qpUm(h><4Si'jkN^T}.D65}L ʳoaRZceWΊ 2&cϴy փ98Ȑ!بo-=l݃ۑPtSߒR|r${P/%< N듺nNA)z>ۭe@DJ(AWy% ({6fR(Hnxy<"fyˑ4:$:YQ'S=_X DŽ_|w B42k6B9`ܑ:EGngWu?~h^' _2rUs'nɇqOԠυe*sĖL=82&bg\g][Yuɮc%8QޔyN#7+oX8Dm]MhwN3qE@ɗkb^$ew:M.}j~ Ȉ<ߓlÄ*l=L9arᄽ1^iX!rOߊ1ѽD D(1SqL juƿS##=ƫ5Krmbq%^ePP56dmKN\?@~ރ+GO';d%{џdFDP9It ̱,H#>3o qc \O g;0R*PLȲXvEq!0C8jM ׄIR1L -V M(RUo([dhGczCXŖaI 5!D,TbL+>)ӱar1DCE=z'BoެGF$}§6u U&j|Cd\?v{,BoQzOB@&Jd!OɗDm޿ rB %}CH&p$3c@e\Wj!Ė9|aNY>EU16Ý">cN#`y'-CP Xz~NP0 QQg(!Ιi͆hCJNQ@XR&dY +JgTD=B)d4imiτ@2{bw{MDks\چ~sNRD>c139Q;*6nBvNV =-.A.j>{dH{Y],;3Ɖ2RC.(l{} 2cJDEȑiӱ c3qO͟E.,<πPO =ULyA%5r#w]vԽ=Z;<-7vq锧C/:iy$ 5Mӻ`@rt_MoFWķ&rFz v3gt=+mOE(ՕVb dEIBZZPh\Lxe \K| aozZ=tdp %ɕ@īٛ_WK *|i:~qos}a>)dF㼧E_ sK؊ng& ϣ}#O# | 0eG6$Fiߡm v2JK{ط`NmRzٛN7co) >h|^Ljq>ZTfL7᧳ :Yfs og{wux2{o+Π2{PKiE:uf-1:+B6 w~srѫG CfhK 4ذ`xryK*bV-Ms{o헏?f[y j,|Œ"׌JTNiKO>x"Vm߭m nTޮ,#n|d"K+"@&TÇ1gK1y׮k's7CԘ]Z|˭+qQ(Sjwrk~×ҶaL.qVCc~-g ?r^짟 ]"5)G}ՒيgBИVF׳~z A.q}u)NTZ81'KRBQ3R|w68oUA3 < Rh_ fB,>O |HގDj-ۦޯ*0.P&mFjPQ|b, %ZXQ> Ő7Ze׳::|m:hC98E̯8\jlzC#G,{7VtYYM2 /<=XO< %:S 461ꏴˏǮx}O{]->Ѐm@⑅*~$EF? ZR JW. m/jE(;,gK~LT.yЖee 'E?O407p5hZo?1ŝ-N-meW>IЃsj>`.~q?fq,Ҋ> stream x%}LSgmh'9o6!n|m3 2`,-%XJ(0+mqޑAf2eS3]^u99y~$xIޱI!Bro|0p7Gy"/?H2}W >IJc՚ RQg1aёLΝ̧*V'-aJw/L:O)W0AJ*vo fʕ&Uk r.3R8 XJSk$L-!B"" ŸXOl kFbA3^D 1M'Gx㸺u6 .~+AE'$(p0QX\`i.k\at9%S+DcɟڟQ"WV]U@5toaľn(䇽oױ8,bG=}?9w:P.~W{%؄U&ś<".8տ+;y Y{4͗r$l70Dti⥡(i7Z;ܦn"4zGGz5M.@{J*,0Y-p%Lr6#؇KCXC/ehC7Oc$]"Xa,%HtJn w_<,|~QYvsSbgͨ'ߘi2}TjVTeTLHo15@UAu_co>w-|o/ե˳+s!.ohf2 H mG[!AS,wР)wX\u:/7L4.^}y@_[[ Tio~\D x Vb3Fk͗h~y!yqh4 CB vyʔP4 A| JeNUTR7!V]㞈ڡ)!8 5jl8>@ X~yD D]v8.zX؟:Fl7R CȮYZK񊴉|-"R jendstream endobj 659 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5343 >> stream xXTT־+"x;()J4&^+(R4)3g0C c4Q/%1FcM4}e%yo\0u>0{1bβΦ/#%KĿI=Iσ,J V^zo 456ҟJ$!9AQ;||jt_kʬ`*f5Œd0k:f f19xf3lf1If2Y,f02KטerƊ `1֌ ӟ fӇXJ22T$_+JK?vwdtv5{+[˹X~y{zMoKq?}A}9_4n}C#n6 J$u]%|r*+b@CoTplSj4B=iNZ9h#C.]~y{NiZ$;@϶hT\e.ev|5GZ(ehZX(Zc UjgێQ۴B 1шtp4'zBAcp CMP+o#Lmc8 WZ7I H r.? hN_󾵳1BDNyH-opx9,Cp93b/tsk:V+g 0x;^Hr\編3XXG/ark1GY-1Hjn` ;xsd(AGF d V F4;ZW]Vn rupf388]=U,ag|ݙS%}rv2al˯yUև+Cv^bhGG,n %=p%LyM'y.bX] l_%%v(zTP֕t)Cnқhϯ}1m u/@{rMcߒ#Q&hX&&¸n+ݗ)~` ] yj"٪F )HQ'A[Z*wyghO=G ܆zsRrTb&Ƣ kJ1dLp ǃ\Z4$up1)>_Av\juBBRZ7凔%ߧ*k/;<˓q*G\,썒Al4$3"!-#7/=u{@`vb{DUx|Y!_zi:AIyCf1=' o[#N+t_'0H V3waI'.ֿwY ZY7e{x̞%E'1V֨˽&en*p Ҍ4p9W30ϓ?{K,cd&ZeJC,[믜&:t~%s% 5{oMDKA8Gkri2kad$d#>c(cĜ)FS`mW-mY͋2|LQMBe->żPvZ`KeQR"We3 lbnS+4[=D%GψReC6d2K}z}3*7PCktQ5}!5I~:m*i/{%4C3c&?" ^JHRG`UrUTJU*?]_ψPɍVy J8pqT@y-͡ټ7W7:W G)F߁<>=.5 -7-1HOSCp&6Dԣna`'Wl7+>ݽƧ 8O姃ְJ Rsk>`#pS//*.lۚWUήXm%VVB9s~|Qs|M򫹄1olݲq|`uWświR&uкK`D^DrkBEɢ5e8KEԣTR;f~] ~d~iOqhfjI+3'f>Oee*A0=./OQKLNZ2o:t}4K1q5xtꎕ>RZPwZrrj}0NfCW \B!:OVgAWY vk>~ۙS.Vs0~*=t6:*ϳfqQlL%ZEgp6" _- .H(~Ϟ(ij{K4`p 3قd66qJ=B}Nd*jQO&}OZr!=;-l TIߥG<\tsMC@!SiղEhA[F껹gc>\m$'=j~fҬ.SheZݻ\#=xTߡ%s(D- wUyc@\|rۉ7h`ф'}?jo+-]gJ'TlId K$[r| 򛘋*t: *K/[cOS:-.Z'V/ZSrj9C(CUQqeׁ5o8)vuLJ{C x"s-Bpg>mGY0cCOnZK9gGOUԆov5BO\k|ۻBp_(^]`FdZazAv8˪tu*%U݂1 , 3hy}Lg:Usᆼ4ZcѤk1 vYq7gBl0a2?R*5ԏzSQѮѠ>Ș= {)RKǕd7;Z8*Znf{.==rK^UĢ ftIZM4#ť84Gw/>_;#d>9zT?/^~ꝍ*<06{ǣa*LMwri{KD,mҮuTK,b eP v 4kx1ʑ'WF_6 ܭ5PxN|>FC@Q^#K0q\@EtyUiqu#ZGX!*{(cv9)7^,=nBF wiq~sNJ2B.9#13khAHodpppqp@KrbpT-3&2Rp 3 )姖R"|j.+2bRq)yu 8'fLii)D\bg-oBeK&ތZbxNVrݴVMLL5- *}N,%nsɱ"#ߒ(Pgeg+X&vw􄕰12ԙ5ËwyLx"J?{["ټ)Wctq줴d55H -{ݩqr-OWS?A|tlhw20V9ig{ 7Ŋ*hµsk[ 1ъg&u~kWOE/2#7g+;0Dž {UhܒvLvd^ZZ=sa`nFl׳F˫}SK2Zc\rendstream endobj 660 0 obj << /Filter /FlateDecode /Length 159 >> stream x313R0P0U0S01C.=Cɹ\ &`A RN\ %E\@i.}0`ȥ 43KM V8qy(-> stream x]O10 P ]ZUm?eB:gׁm_Xց$i, x> stream x]Kq| taBa;lKɲeu}b(`"_|TWgUwp)9xlYY_oAoW͗MnspٛC MN 6?=~=<9dPoDͳ7[{ 4;Dg7߾Rؾ*'wꐴ1n/=Al>9hٿ8Nn=?k:gt8Uνm?p8gr00ki!mXۻZsoE\5a[G=hJ^,i@?$5 yWݤ`c*I=& Mhh[mNsvs,\?$hm4*w3:"LVfo[r ʛω|NX6 ᧜i76@2b15ݽAfoWq{w&BcaƀX؞n:ن@?FRLw {7{}6kf'[!p;?h}v&ˤ(:ly)R:+ʶE?4-Olf;h_rVau_XcR‹Y-)C$~zytkน 9-4FTY;Nv9KF@ޘ`R^Y֧e:P>6D/SĞ>6W2csmAz?=0bY;"ZPeg2WݤW;|1+7J,tƷ$2P&v #XYyh>rDnP0iɎTN7vLb8?|C)Е0x,^$9Nw=%&(_FG$Qd#2ZgX9 S`:7'R( F&l6 ^oNCɁj{<9I€Zjщgfn!y(h>{&Jd5Y""[8 ZckoE |7e<j:&~-"U[ G9Y>z>V,u݁Exy,;G0YB jN* gC'u6.\R]n%dzL ki}U=G4s(ơ,`I rvaBvU4Gy2~ \YR8"yкvr_ e3Dמ|- _ Ͻ`/x 6 +laxiBvۛYL@;yF`(fP| RTS'mJT Stw(.}rꗙ-53Ae4NAOPMGPf`_aW.E\w3S$ono/*a.,Z!:/#1s8lr1.`fp+0@"mnO45Iύ5i+yjlp+ k m_.t$"dq MD`qW7F4P 둯sb/ΰ]ɝ=Q @JZ5¿0{3^_$H⁗"~d,9dfrX5u&`j5$F΅??p+ 񙬹ՠ)W,T2U;Z,D\54i@2&9fSetռѳ-)v.STD~"b g0}|v͞(;~ǒɀeK̎jWIo9u8pD(_k +ZQ"ʻbN{.5Ӣ lÐNnJ'bJ)[/mfl^%m {W86G1^Dd a*範F1e.uyr+MɅ9gWȇ$MF#޳T=aF') ܸgxG35&F&3ԇDj:="em.K~8ޢ1'R V0$/e"9yWnd7qٌ݂),S)s27xS`dY҈%/ḟB$"Wg-<~XF[ OYzl#*J;"0iB=ց>,F;Y'}γcXѡA];'tYD׏A!BPz aʴW e"d霨@B{ʴψP΁5G3x($}$oQ2.q)xhJ7{X|-qq%Σ %;BP|83Hhj[Ryr9)6j}}Nr}HdNoonoty{cS}濇a7΃Z|W /V:\Iyk'uHwUto7Nv?HHQf Qt6 !A+ nP#we n l =z 4Πq`$ﷻApgsӪ'x(­H Ǫ|'&!\+8MӦ8N(<غ7[Zd: WL;(g'(RT23ez̸IǣB]ϐI6ՙצ麩I\g(!GWYgSMu6+@RGd#; ED.GZj]fƷ0[D?"(jK= :Z)1s,N)ZmI%u:9RZ-:p e`+_T_ DD5OGUc|l`kJOc YAV\"cIsȧj> &>QUopk$/ x~g.L铜˞8AJӀ 8l;SeZ$_}g=YgI@i[ǕQs=-m>=aJ}$EMrHka ` M-ua4l$NaO~߅JA@ Te1RtRr5=pͰyQ&S92xs#&[-fܔ4 R~^50;B\=7Q•ŊWHmILpĄLTu/KX,|˕HvfI8~ ". kHxj:4n-' 5Մ44s}揜jnŸjoT(}N!TJkaW Y>D} rӂ\@wj-:r#`.MxS|,?5<${.FI}3cBs \ 0zIb,gO;جl•lW\~0 hd|j[j FMo9"a&Jĉ.ZI6CWz-0bPS\8:9UmCx$&۬Qgeutlۆr.9? 0r\T߉Vu[|ic{U+2/saF#Nұ%HDxD~0E^2f;IaDxuR1afR>1LEKlN/UqZx ku@`xc"U&Ƨc]ǏYfb&*jn.+ (|F`'CvUS+'%`(e=mծI7uI3+E$~(cv, ׍E Guq\PKԥ C9 1>kp]<՗ `L<_v\Y#FܖMɥXj~@7:- %-1;D.qjM(M3we#w%!ϲw)x3GJ3em`|;=ٖSqB4r}q$!mZ4rX>:u `{z.:$XO{@F;j3F4+m˴5 :UKzd@Y_$"-J#^)* `hQ; u6"{V.xȨrb M,Wy~Muy8ҢD 5Tkzf 3:Og3}5%,3 V5I' Z_͹o"{SSF S>/",&s)ِ[-hli2rD;O^pLy/{moxM(L|';+Fw \<;iپ+g{ԃikSh @<,5:, 涟rɠR'vR"4VW@d52$&vXWzq!Fzk߽XMph@iLՁlYWW@#Rk[u~,?Q}X\Uts;i+p\Oy|5"]pMyt-\ۏc{]JGw̵3o=`_հ*dQm;mO{.-pkztUִ>,\;I8 EFPj׺I4{\0LSJ\T4V &`pmxPwHaop\;"^361VݛhuФqMbJTY4H-]ؠt,q>.m-kb>=o4n;NI]'/QQP`G~'C~;._ڂ*l_g uBc&ژ HQн> :[teJ>sW&sLmnΗ?:MYwʷgo(4=8FyN9Z5ٝ3&KڥSDL#.ԉP @{{jYh o+yy tnYiO!˴KcݕS,$HO%Q!}RʤEs4l$U Ҫ[cIYYDu_W /҅o*'z` ފo{HH= #בܨP%T,"_SMz Ix6EolS*:5{˷&K(,D[ܶrˬݔu٫-mcjBRNSh0p}uѲ: |R&0[đϑ\AE'eGO.o}ޔ;eM+4 gEN9:w隀]} qO`Af+Ѻ?TCJE('}KJw*0!sFEM+W9cq+tImTƙ~/&&Ha\Qg)u9:KS:;ؓv l^#O@wJlߜCd}\ȶ4;~cV])j8N[ＸbSf~5/!nkwRX#q(͑jsO\`~_ E=;Ię%8IAk, UKOI6/u;bPlY̫.z߆6aؿKVHX'C4 t0|`X@É*Nf*mFq05:T_6ǩ&x`O*0Z"&agǒytU'z '=5ި ؠ%/隰:ќnvg<$1`9hXSȖY ',U,nQ4oM ( jݥZݔ+X#LוRݧ[XKa;[2tP!Gf/Q > 8aghb{0h9,jF2%}=)gcnW[l~\O_>Ĭ2 ;͓~YZ.L|Bʹ5FBsa$̧r?mipb3'5-|0c29DfCчlM'`B z}͟bqlnX;8 2dh5}"7<9@㧁~/{$>=Z .5Uhendstream endobj 663 0 obj << /Filter /FlateDecode /Length 8866 >> stream x}rɕ*K'f,ߗPL#M8z, I==0A:"=|y3g_{7%]=>x,9A.}f4_?5<7-y{쟟ø6xڳ篞̹6dzms759v7+о=0lL(kxKo/wb> hu֘l7Mɮvz/]ƤQN]YxҾw[z>B>J Ü=|"{v㾤OƫhzA's[tnZcףs[R 9p0u{ &#FG+r~ZN.@죽&@xO]ֳ{%$8^Xk.-%?HXS9Nhs}h~V |MsnhA㖇Vͭ;(6ڻe_#!DF/q*N **JZ.̧3XlyGo%8+91`D;~g%Jk)a,飓^{00"bku8K[ɜ+[*!x^$xP7+knGM띉x$i%VqjWm9&n@㾚Ath,--Xȣb.iۘ a2#>e G.Ʋ9*9O4qB"Uj!~ .j0AkLsŋL-!oҥx0:h'}+LLg!Vd +0晗&awCL =_ⶈ!PԺ @ A/?G`2MP*~T< ۟_dc_40Nģ\H|认۶es CuܵAG"4zeFdDTA/Aleo^s8&Dى<Џ}v4}i,M hzBQ-L3laDEzȣ *+у7Hw?HD}6F뮀QD1)~baAs P1 އKLhf9f:u>̘ -s~+"? &3bX~I` Rt!co0 ,!"pZX G%8 J&1煇3c&౤CjjC4|mom~K 0PEiRR)\&.K?WI_j.GU |6RpJ{=,[`;";]=4 * 6VҞ2ml7} ƞ.Coz,8-TwSqtlptxmVذC_ڙVήHjsHf<7^7ZȊ:QKq$?{x)uuGGѯΗ}|!c95U`$2kHfznz^usQLKaNސ}5WGj Bb6YZd+ /% WFwxP=}m%6NP6s~6 Çv5+/˶/臙 *OJgIg\')M]7vNp%t92NE3 Zk1 oGIMж /ǩ i#ZҀҠ74#lu95?mnQh+^- 6soi/yJ`Fm@ pߌdPap{B'caR@qdr?  t}- |FBqq|;)lJ(Ѕ ?^3>BCDI9N7!lLd@W`(^>ޚ)@n #TJZ0d.DFH]nSK8߈HNl,jqVy֢:Tn)!N1dwy/w(`?)t xe/$xk+ ,Twڃ/Q XEԍf}Uʃ%_`uSa1M&W уU=DPM c0+˾ߓh䥫qz$/1 u߀І t%s#&oP*>^$>Q傜QΰC@@נI#QUhTsZ$8 0O؎#r(ؐU\ U2,I 22V욤EoA BcaW+'SD6nvrJ"M+!r+͆M]!cLŞۂ{h@Eu``8p֦>obd`#3^M#_cM G"X!-jQ$R-6dZ t8`Bt~|\ pG;; Bs$#Xvc;T pXhLn?Ͱ} DEai죑+::tRA"r3X .r0vcR=N֊.`$jM(E~_M垨)M. ¤SxK(Qb1(IJ<3L)H@P%Uh7=v#X)]?-'jz`}Oj:˘ kǦ3Rk0|}Bfޓ07 A}Q65`*cRÔ`'W &e6fE[`e;划&]xאޠ8wp|K%]S$JJV̨CVx{gPVc L|is^>EBB1d+ †40H@@gEzk{-7l˅$%r8S .7zSSzVԉ`+ĮLTŻE +~Y1siEhM{1]ZںERKJbWHA:}q~$LXu+vē?FA 9@6M8,jU\E$*6}T& tvXPԪJ7kI#c:̛M)m55:nr> ZiEkLkڋqQt,E YqJus lk{k].e D/ΗO3)Z~ 7acAo$}?MJ~7V.IJQxAk:RRU֮ml|ᆁ(U,7.yLM%p]֫,&&6Q%r4`aϺAN/iuC. V 0 J>jݶD&YeGRMl$JI~ _ NP s)ى&&r9䌽,RH$O,SWFx_*#TZ ?7 +<]xv3Y+JgbF1 _k`;NL@z!qR3(K2%:dyZƒ@LJW>0ʅb=n޾B x}NIqR ;+^j\y}]D`G:9'Ħ?VZ@-: 9綉eU@ qMt̀0EA(6WT۝> x)qdpnb_yllSAeuJx#Y颓>Lo %srHڄGI 7}t\]i僊 @7`M_ D A$Z&Asx}Us0t 4pB?UJHvSL}T[ֻ;Z_j/}>Ju\ +_%ɾK:FU+BrpK܆%&*!r" ?Z KTx6jWT]6if{vLj"Irbfq|զH{L ֶ>`zU>E 1lf=tL-V!鲪zۣm@x~7hܾFkm\(Q{q+;be?R1̕8aw-rY!f9Yxú3un{49Ȼ5v+.9RgOVi2l2[ryv` {H|M{`G'$o:3 q :ڟeG"cotLwx&WLU&h~KEar"7ӊÎ8v͖:q潌SZ# |Rk6\gຑ/NО %{FP^U_v|'8sG}E)DF5}{/_Rƥyf_:JejVK~ⰀS1fcrӳDŽfͣdȪT!~g\OC)BF̀nl/3o :Tz7a*I/.M3)PAxO/bIS3ue"bE>/B_=%46hv71NI`U%``rB% '¤:n6NZ,񣬕b"=L>\&Nw7>kÑUpwPT{bFu(@U-rjwӑק6/_}$#+G@X{7SM=07 }m'\4>8x J[;!yZS۵ wQ>>]أOHa{B.+IIu ijV:̛B9y1BP5F6#~ov<ppL8xeTU-^Gpai > &-qc;pɩJ$mV|Z#k2F~Šd*ʂ)V =3 N=U~#eYwt/B;X: M؜ޚvAKra!^Q=o ˆѶmMrE_˽ 7=XL=F@=Ǖ" OY# @;>mo{EceyCo[(wȌ7z K`45Oegt,1x+:n dJ GX #9`OsZBLc?)%q""/@OW\a(N/?]KMu~>Z>㜷5yw f-%:-nl?KhC\lDM/Bu]МGv?O,{lNH԰ Bu Sr>9p`$aSV} ]կ/4VpuP6e#aw(v]S%fU$ArO| L6hІL"u=߯!enἩm u"S.o|U&򋒶 gt)|K~J,Z|8_χӚՙ ]+}·u-?T=j~ÏQ{zPrf&VuIGZ~U>+"Zi~˓L:2R}ߕ Ƭ^74{~:+R}1C$Qϡ{#=Q]t 0P#xB1f.k#GC5C>G;_S~ IoA湪GqFcF2zr¦7s8+`Ć >mI>^WuUs1#ʉwYqN.۴@[-.WvpG"GGNw.q܈" *k<ϯylKLɺ0huXW"&u} !9G~!h|f|E }7S Hg5b/0m- c-l 846\pz -1 4zہ}5TJ r7dR!4 Ks u$߿ 'Rfytǯ,931ʣC1!V(g9fP4 a+I{ܱ(oZ@"*uf/XhIl\j{UudN&; /HxcbVtC< Ŷ} q@h<؃/;[wu5Pn I BcϬ^v4>RmB 6acprQE%KX=D\aMh\ibX#/kY"Ŵ`•xaF0RqClIu8`pd!~n#:7<{)qoUħh p zdPiu\\L)v wLtcgT;qJO HNL Oqg* endstream endobj 664 0 obj << /Filter /FlateDecode /Length 6929 >> stream x]Ks$qҏ`Դ7$[Rر:>X$; H MrF=,|~H`z:Ot/N}7'=N\rz ڷSO |h˻_]~ҜŇPFu\qw';vWytv W'ݝϓN)F yJvI8;iѻOK)AX9ՓZ3ݿg*%pawUG=t&ݥ)0Ghj5w4Хٹ1zJ~߅yքg,9q?=Mg`gG&zc-s)sk|0›)&ǽ=7ܸ)@͞Yg*$ϳO8?d[HN6J# 1O^y?B.Gٹ0I;ۉd:mŴN^FO rna>.( TT);+kM轫`̳I୲, ~iI{('1rjSA Szܯtb) Y:$6;UrX7=@Pq"ju SI4)`pAV13SeZ T2{T>LWgb23lʴVw0}BAuЮ"`Ӏ*XKCpWOq96]l Nf:uYEYdygO| ? ZSMabMg؈\H6*-Ī:[mzN&eR3LfB) |YChcuf'nJ? wDZbR,T-VƗs~oս$Np{d@!a 3wߟ9G auB!..F"h+a^3zR! o/!M025S,, 7~w֩&bjlT.: .'6qfM 5 x%CJ7M|xӀ'v)b)DcM֓cKyK[B$C?۱"-dz E8`*#w 5aD.m뒮dQm4G#D{ɝ& 6]Anch"P6N{9\`1䤍Xr+sҿڗ">Pު)+(0!1JAJi_yM =InKm齠̀t=0+6aB.^4q~zd#O.#6€P-Ɔ!٘Y$&1K(q0w^,iXEVn%3p^3i|&PdZGPSqJWf@&Dz.͸%"j&di9 /'4NoCI Hؒb- ^I ai7Q0VEugYXw7 Ԩb{ҖfBdWi=ޭ5p:5L ZȤqֆ&k2RyE}8˴AN O:PpeIGa,Xft[ͫѱw<5PS뺘Ӷ9;E :F ;A5ϮIe#uA︽`NWz5C̑a߬J36XEiz.O/~p) \A]WS-YK̶tP@͕?1trlZ.Q|&`Dz&2yHE} '0n8GJG0ťM[T}HY*FTΨ0>mߦ¦D#r٩4#hQX3>4ڸԔr\s޹(i;^_Hu)"z|Zڅ:W̟@.nʭ` `A_BDFz qq^Iq YoE拦/":. eFblE>|@'#vFm)2&^:0&Y#R"(5Y@;CD_c-\rO76> X">iH2"?tɿ N'kN[.$ ɯzV*VP@¥[RE.p]3=l|<±u8W֋'V: guE2,<@7nR֙K'uS8'8D[}qlCQHY,t)<Ԛ ud:@} ZzE [L쁹/)-ZzBJf?VaŖ|E%qV=siMTܷyGk`r"[rԭ$3ZiUf`HA"T(V}s~$0̸Fljȇg.;8Շ}ZJj%Ch2-c6?g)Inj}h::t'M9} 5'= e#OU9F~A ~Y~N}-=|#lQRVpb%@ՆtN^XXV3FD5|O!BΫem%=!6P|b M0'ogBL0u&(Yiж[eL.a+d:f*\@{÷2C%]}xYS_GVTn+ֺ:T|'šFo{0I{+II>%une$I?QDYh<"dj:i} +k@bn6 M=9bCTӑ|!53vK`8aƭˮ`m\N2Y/կNI-͈<N:@H#wG-XV:®wtm+,TkR9h+Bys|~YIC0ʇXCߖ%ۼoɣw52csȂMQ]&{?֓C1PyF^рk R~GbcjۭSyS K~ 4yxI .%^*5ҠॵO#>\%-p?V"? /mb Oڑ4dsD;qTw=_&%6T#uF2za*HDM]Xgx졹+ ^F3f#xߣ #,Pc/fN@%VNfPA=8Ov5}SLt]};6ơCmeMƊa"ncL\'gJ4_'{ y摲&-&@FXT#VMB|4խl a7z>]yF#cpg9g9m zIg.ũ1^l?^AFiY^|rchr^(ޤ->m,cZ#r%-ǥɌ -Q,qS_+ A-/fo$27A5)rN`y@ތnВ?Bֲ x@SwՌ Sn7 II7f+;Tg3́Nѷ&KoJbNuC~JaK3J˅iz jݤKQQ*lljtuvvu*ޱGx)tag1B (H_Q -)^+oC|Կ->+= AWvHoudM[N ^B+Kkx݄P9聿Q$Dž;<.jX{U 3CJ>$s0a(T;DXf9oyuF8]endstream endobj 665 0 obj << /Filter /FlateDecode /Length 6983 >> stream x][\7r8>bbMlFM֌4z4-i$+K^SU9,=Z<ՅԫK1K_`.o/^]/.ljڷK;?|vp_J2i"GO/ҌR8i.Sы6ڊIDBz„*l۝j RnO''P:e 4^@olUjJ 1h6 0wb]ʤO ]oìAom~E-<)ǣ?!-'jrpobgi;ן68^ԴP{1Bm6?owguuCd6D\?z×sw携Cyx;wvs[(6g? >/ʹylIKXcEE:KD3nc8/c *w\2Y5l>ßU;˸>Mxx# \u e=-<$QSwpRlIFLKI@`6IJ'.Y{ڊZB|H˰p"/zwW:ma#GS^j4jӇ$4I=YP%$%p 乲 M$_ ;js348ܗ q?>Q.%}V+%dU҄H }-wE4uw2N+#3e}+.㥳 L|FvrwihXYܲ?t (ovL`(24Sy>Zq,1=x3R%7zRed#h/ql0DŽI"D6C·-ҏ1v|Q,Ը`}$>73"=#p1(ْ.TvK i,-.8H8۞r2r/jÃN+h^ 6w:kx3d=Ji;Ϊ(45jfpf$@l0Lb8k@[^3 ~o' bwMN[UX:αձ n(%YyZx:ѷ(sLΙy))lᄠ{@ѐ8"g`¹LpTx#MߡyZGaEs͐o`)e/v4Kmi$qŅ1 wQCh& m1誠tkpATW(r+J' RNE<>/}yRؘ Rla(Ɂ&)nuW)#Cc9'1tչ."RvdRqxfцQ4*͑ZILB4K&T8s:H('+_皐qp^I%3UoiXUEO`J}ĠF٩: [{>SQɏObcϾ̾u~;=#C8dG x?ay.{ZϚOlho 8:*ߕ湊D&Ap-C-B4=mipF LaU=Wh"Y+S2q׾1ٱ0+ (pq2D¬AIv2Wg!x#Yr-18&/yWymW4NUw>ˍPFÔ5>q A]Iqp0?K&ߔ;!1~<}5`G |^HNL.\c 0" L1a|S5GRӺ"p0tkARkrrY3vzO`=6B #t|,{oEڄiԒ [S"yẁ.e]1I )IM2 8{2(`(#F‹LBP}ီ-P)2KߵU?؜;\"kSN8(uϿ<%OEZ,Gɼ>T4p;bfㄈ,ѩM}u'˔#ě)W (ޱrʵ:k8蔯FKj ~;^ׂAMѩY˅Ju_[G7.Uco ܖ7joMaSjf|`8eǂѸSj}9 `4ô&BY~b>6ur ѨmbAN8FD ).~Q #"{>~QoNuy'So?Ƚ/M%46(,#t%oO:t9hYOdk͖]z}Sϧ+͓5+'Ò*'k%&0Dl};BY_I>hk]s43їX}o ;- $h$x; ^dj i YHIDpxY7{V 8|qߧ@Sr XALި@龖arq♲O+M?5밀ݞ-!}7ٕu{Xjv֜9]FI$1 ]tuh0~)PthFT# ~~0Уht`~L{΋0rK )XyMw+a:mGRuڔ(s^ڴ5V#H,+mTcZ<T񲣖er amlޝRq%l^ UDRN[銴Ȫyr僗J#ypʠ u'+^5Cβi78PhL# `ѥXvZe"R="C:Y[ޫP~\aʆTA9ѩ#.74АUG]ŬYU蠇6U*ayE\LYvܲ2Úa &o&3"zG_I"Z%+`\``8B:nFr|z8IK*M\hC-@m"t<+)'w0Z׻+,%q-j Gj8u R"Tp-,8}Lꑌ`Q!AttI` 78#ЄcjSڶd"6vw&BJ0L( SntsRހ4+ =I#a9=,0T[5HH`]v3Sʍ Wh1jEBzR>/XiidmU8'Um0P$544M5ՎhS:y͛#R 5FLk΅*n sh(x@m_F}K SmuĻ-R:7,zc0V!W CQ(yqhu6XM3t]6+q]Z|N胴H՘Ir GBIS= 퇾.G#$`|mmHtP5̾gոᨈl1ʮ@0ހ/r]NAުEF'.f1$H;o2? Wnе؏a :PC滠2m R5i˔'&ʊWvLY3E[W*k5^`) -@k/,>i2Ϊl[Y{7ј2\M5*jG Gi#o=0] +S77J"ce\ òͅzj,`_G},%Ĵ*NI]=q"&y%0:f֚_G_۪A4rCZI y.皸ߧ\KPxYk,8QX>͇ĊIްՇ[6j'W:H$edt/*(=)Njz~b,*嘖Հ<5!P.z"KbDD67g9Z$Rɏ!ןQ$9pN>/?bA.):9v_#6wr}[IX:x🷽`Q̗Uޖ^^%3q%!0Qۏ\vƵ_a&edwy}{2ͣUZ=Z| ot֖j֬*TƱ7Ai?,֛ƺ~ WHL0Ϟ=*R<5X9;CsG 1tSC\r Sw⑱Syp[e[&սZbzlrc_FNJm uNBɑ9P3oB`eyO3nhm8-GD}7"-?@.yl ŶuǞwkNKętț=8.&e 3L_z\/sTi-Bַ&"eWiQעWzu!ZhB_b>-̰&;lQݡ5^@ΗUASOF|Mnʀ ^&Q[j)Y]_衾4Զm.'l!TR,F3^~S׍ί/pUm@8UJՋ5XDU u!*z[%p}LlM$a;5e%ϖ޺D7,eBPZI-bku2b 0_cK*cVVcՔu@PفSs#f*_(C73tuHds0}O ?sC;JV/?d<>1ߐl~A/$w(U&xQ?zgE2M\$8t)|SsH 񶒓9~0,}$0#d;|NX$tG0 ̗q`èGI aey3/΃z4 Q_v.v>[8k9 Wy~pO4B 2l}Ij!sf1z_|J/`-y8hu*OKXꥅLAlK1f_ c G_ Q6qgG,8A~WJ걫ж<ϟLN'nɟJtl~prDKLF`zMV8 )?q;L4*BSi3'1l/l7P@*Բ\ߑ?p_J~L\um]/=O.^@=.h[lkekW)#XNe%uD* *xlO8E0< EzGM\cKKo-qNRp˛|6O 4?/\?W7'$βADjnendstream endobj 666 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 778 >> stream xU]HSawlXlX۹ ti]}QFTcr6;;vRΚdz/1u6cK/"EHAtS]FYҵt,:˒}è@0ƅU5upTi~s}`(+XKא+0ALUTV(WR4r:u [uXbP^Fȅ؉Y^(Y;&ZI9 Y!KBKWU٫E'[8hNt`F O Kg5'! >'`1ȑ92ҲV*#LdBt6edu0q*da8n R62V&uKZOg$wI<8%$b2d|l&ӘH H&LJxtw_ >1`# JZ AK y-9 CCVR>‰P,Cޘ-,(IEcr5#7b~!^@ ^eZy˔E4ڤ fo|拮[&LK{u:%㟢Yfqfs$akϖ#O:3}z0|Bє_b$E݃6=jz5 ~N46/#﹥S\Qn`ݹ.ܨJ~1Mendstream endobj 667 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1944 >> stream x} lmWHV5nٝVJ1膄"( ށp۱}qݝGb8$ІBC[(lP-+ԗ&Mጴ#mӝ~'BqIik?{p5?07wF"-WyǠP)]T=m@$*U^S_[G,rŲ˖Q55UJYiY'WTUM$W-]ܼJ]Ԯ^X\OZF''[RMU l nԹDhl"Yj\3׮kj.-o/l,l,$ (`PP f\px9OQnۖE?N爴0]I}^-Oހk D}qHL` P0Q=ADCso6^zWJBzB-hHro`=JxT(`}ARkukvA&8:>l"kM2zr^5 2LEIȢYNZQ0(O/­ 1 3L /zܲCEx]Ǣhs,|{HNliw)G oEe#{hfFAQQK:ZKC] @i?14f=iBoal:)L>[l{k{ h'Y46"DWЧo JXjrS`Gph-yffܤ~9`//"#b4kHΥVXo1]47gܞ6N?ne@8IxO%7tv`He|q(Yf^f!R^]#!}l̞<˴ka0`$mgZl >8#x[AR;qN}Y5`- @_/q@d:I!h5o^{Ωc-2RJpvpaTjvx'u-<V=o~T`.\[/Z.,1|0za7[RM{ЅwX3JbvΆUԧ>cg{~g*rHo2"lD07xyb }0~R41C_,mi%t2K;d>c&%!U= |!#Af~1G%S }5v6Kx;&ʥ#Jk ՗n: m›UꔀNg,@p~nݟ!E+٫"tj@c$JӐ?ԛyd+. Jw}Q$uX=8Ju5_7@P*2]D8M@XإR&(ʭ*ӹϧp_ ci2pm&>˯X`2<'zGz7n.WKjg@SuBQbGHP$z#'! Ouʁš=!+e6+uJ[U?<,|fO}Q:mendstream endobj 668 0 obj << /Filter /FlateDecode /Length 164 >> stream x]O0 VB,tahU8(Nп/ СY:ߝ|]FEehvK@Fˢ@[;'nʿ?`5]M$%-NRP> stream xcd`ab`ddds 4H3a!ì=<<<, /,={ #c^qSs~AeQfzFFcnjQfrbobIFjnb ZRaQRR`_^^[_nPYZZTWvt-(-I-ROI-+(Me```4``b`bddqӂO|܏,IzuOX4+>]֎vɪ=SL+^~ os_ļ 4liendstream endobj 670 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 361 >> stream xcd`ab`dddwu041H3a!Wu7kc7s7˲ ~!Ș_29(3=DA#YS\GR17(391O7$#57QOL-Tа())///K-/JQ(,PJ-N-*KMQp+QKMUOB9)槤悌M(a``` ``b`bddkCd73J?͍] S{/k[Y^u[on?lp4_u?$~(}g^r?6u/tug]9}.n9.|͓xxȇ8endstream endobj 671 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 675 >> stream xPKSqua )Z=B$DNR[e}`;tsknε!sNM,RECP|hr8<9(".@P;p "0$-RJN$l?QrJ4ZTUWdj}hSNEj)= QX+Q٨eY:RKZ#i!,:VK<[FKz8V{rdf)P)fAD}=iA}Gs12I+N^ģpv ftGpѽ& :z-9&;Xv7>Li,^V B\(2k4eku1j.l- /RNn:?"vPY?`a~mdԂ>09"`jtyNJ(rh11oY(nl>/gN=qunv1󫱭|8vS<O1? ^ ML*ͦ7Vp=:T2l"'JQbB > stream xY XSg>1ikrmժ[kmUҺ+첇ٗ/ Y! A@vYTPۂKWvwZӹw:?a@]>yB?}~81d};-'#C\P\[03 }{/{.Z'LJHEN9o瞊|z܅ b"WGREMJ8Q^E͝5;]hSI qYqœei5ѩqO7{eIzjF(N:=6NFܴK2˲D+WF!޷*/fu~lu 7$mܿ)9%5LqWA%'SF bAl!f[mb)b;E k2b.G &V7gUjb JL$҈b<13s1J%9/rcwXX[^ո_L5="p<&ѓNWz?u5~|+`ǃ,z롉z8."+x8~[\d@|O@{BU@`j4lWVh)ERƼ@(jAt&.Z+!j?Ni "ȔT3vPeM@@Tҋnm!A+ڤ>GLE}A~N`*_)@,B:AǨi#Dr F~ir}CqK뎾QUp;,b9idZh<{]<]?Mophv02wǞ(ЍƜE%g5jۯ$Qv:K<@hG'5S4Eof׆YlX&zmD #r9~~l.LI F տ6MdE]B!KV}/CRW(v;@]x=\D/>ꝯDStbCб[h(7V~Wq@ VZbZ@S yٙPf7X{*!<؋wFS~g٪o4h7H-z-{sZG h5+B/ϸEŨo*FwPdNo5}w\xJ1,M^IAD8 % ƕ١i4LH搃KPK_E;e?d54`*:uPL!0Y^ U^|`0 Jȧ_IPudn`[ piJ$QG=>B{8]Bo&L*hIsW4Ĵ'N_cSnIO Ȍg1 ]2og$lEX5o%~"Kw: K W:9V*]²z؏ceM8E4<3Kv4`4(BE6Xv^ޏ[vhrA+6䟏!ǒx;V3vQn |{vH LC1!RkYZ: Ҍ._WV  -֪`#촱j CuXg35~n ovd^%l'&rwn<,mlj17}B`r)[}7oYd 9䧋A,9o h!O{=s/&rEj*yqb:ٚu ?&u*>t<2W5@6Ofd Z jro 1@+3-?"qz-`4[n 4~4*7 L扅b¨eABffK n;E٪oMtrEI'zus'E|U> dasˎ7u:̎k<.H g|WdlkOk"W{=ɑ9wn2t:kmi?m`[8x6*!v"qHL⛜`T%bŽI%yqq1M{w5ݭsMwXWg]-̥c hBy;]s0֧Uz ,m(Egh $pYMeC&#TH6ԧ¦7ӥz O*Su^:^el+h[6[}Z@1olkw 5bp\ivAJlreo g >ػə=e_F%kL9'cy1xH>dHL5ICR$Ȇ6/nx eT[4)2ry9h1_h91q/_[ݟػZ0LRgn-ַI!@a9a~at-Ȣ@ BCQE\CǶ:iك8j6%PwvzؑN.Kʭ+et^KUrzm\$^ɺ1:`2[@HN2ru7BHRKYmٍ\6_JV0Wet>̮ Jy e0R4 ("v9Y,oi P%˔xxtUu@"y;){*ʷ4;.X_vw?+֬.v (3Sҫ䕾293@_ pOr|4̮ z&Op6b'1j!yTF |⛊֐\k-ׅAt[x\&pQj{~m9@4||V|c֝a;uҰڱ,ڷjbChS?"PW*O> stream xcd`ab`ddds 24H3a!.kc7s7W ~.ȘW_PYQ`hii`d``ZXX('gT*hdX뗗%i(gd(((%*]&s JKR|SRYt+uwRꖦn߾l8tw wnp7ow ӈ} Zb^~SgwWܼwxE,1[w2|e ~8?u߉Wpb19 ϙ< hendstream endobj 674 0 obj << /Filter /FlateDecode /Length 162 >> stream x]O10 @ ]ZUm?eB:gׁm_Xց$i, x`JSendstream endobj 675 0 obj << /Filter /FlateDecode /Length 5904 >> stream x\YsGr~ }qϮY~6:䐬bÖ0$@! P+g;3+z,TבǗGS1S/ޞ<>'퉍VAF1QNzz.MIc^= ǵd"ӳ'iBy䩷~ڞ=쿡t蕅O~nbT1 ln6b RiK|c Z {_gJ>Q)q5Fa&c> ++p^F>np:͌+)54څF8\nZ1;0z " -W4!_ 7CRy8LpژDkS_͢qmm]VE5oOڎw#fؽnax.(5l (ᗍC!&vDm&/qI Vq&AVǹEe ?/zG BUpFw +8ypN8|1FΣ: M<Up`ጰCwB F6jwD@)Q dK9d_5J#H ?9N Jiox=ca _0jlʹ{9`:Ǽ I ā$##(ͧW- 3o7Af.l%l-̑V<WU/gdW8z:|zAa+lc<\' -=|:A_eZ30꼭#N l*Q䔹*ůZBUzDou۴Pm xpW0өD7HEc򩠁zԱMm~_E Tɴmi+MXU̜4W:P_6='Nkx]ZE{4֟n~j' a"rǰh+ V0n>l,3/2 o/7@s8Y04x*ov7QLsHhD4(΋ػ/^_\\wIk9=?N6 ى&-5_TG%i#֔Uk$xPH%of чj5%%ц?vYEшh:%]s1 4z:?eP"0pсfPBt4sHBuS6:[~'(T".YjE,TZ>1N:R]B*Ym3fdSoPsT0bZXdBH EM+WᚓӁl үjmFsߧ1`V* J:7qAqa}J5TzF5Ůzz ? DQb5& B\ ltY-D`Cy,n n7D :jmUt( [u :p~:a&Ys)IQQ@>!C$3y$3vCA`TӔB8@ϻC }PvYxHJ$ErOoO?KF)X1$"0ZpVW2qϝԞ~:c:vHqۀwܰ-vxpIvY9Uk~ d'hAR pF5d|^vjDi8>Lcuׅ8a<%B+=6CG.3AiAEw~,kjfvЙI A`Ѵ6Z3J+MZI^ǛҼ-w9G\,tߔ_J@zn5Uu#<3g@4nksDp~-GIx 'pM5iL=j|LOWr1%FFNoJ"w!{*[>?2.[Dj|Y70L MԔʻLg*ڿEl6(a1qM>]<[6.;ƶKOܻr +I"ٺUCTeGCZ#]| 1 xP*!#ۥ#"zZd:/йwQ ?MSF{Ej vJݙzyL֑s(B>=OS46&tM"Ӣ@ އemȞܔmi+͋bv.;ըu4{|0AʞZtTK!kNѢ3Qa L%P"مeZqlJ?Wna)ucl׸ -GMyGC_@D@A\h;q(€H?3M?D)b fT?sy>g$n!FB1(eit*g?CI 2_`+-mtحI"CpJy%,j W8#yyy;0M{iã"RzCMũ5;ə,,% @b꓀ctr,7؟laT4[h0r^!´( se*m` |i:X7%&%>ȴV_GsR*9[&F4nNQfSFN\KN)`25+jO1?.uOXW~[^AS!C*tӷ 'k` UFF{8jܨf<w>UunʝܲLd&:tvA̾;IuI@*&͜dgU|Е Zm[7zK7Ōf~Kt s**Q]ʤ WhYPӝb2 )|( -ڱ T[3.Ak$1Zr-{-Bh#} eUL [ns-AJtK#=wy+-29DV#>M'ĸj(ɫr0 r0X|9Scy|@G4^/XT56k3s(΂YEڮ!:شpFJn@1@wd#敮Em `n0YZkս5a3IT}~d L{ @Ev*{Fqc>ceA#`]4RgL_q_+౅5v^ʀڤ# 83>q>(AXin2R/\O7SԽ{oA@4:Ol 0.>A1{gI*+zΊ֣RQͥ"iR\ `ʂZw睵ɪ܏R!ډ*,\Sj]oIp;n 庬^)tvq-ô:+B{m\jňs^v(Q-КK(%BhCEi+M5{ƼLvZ} LZ Vuq>췈U FP!Z a'S/JS8Ⱥ}H|#bBc!?5p=ŐO%.~-HJV4c=%kHЉ|;kXwF2/R3Ы~xK. )DHB!d~ M`_,T{X!cBsXԸ0L?7(mUi{*fnYְ+;Ն\2]/c`]Y%s]֜A61&ݗC~q*ŭW+@)Ry\ODn|OEʪr-x=PxO)v,]v9YaOF:}0 !k듲^}[/R.\djE4ʱJy(WLož̑SL2',KK@DWD0yFD>0PF bc.]KY=u掙O핪AXL~%#`I&6+BBrKY79Kz,)ǡ8q.F^1”B`y6Y;OaZ%.ܚq­Yu#[u()|'1=X([k.uN Jta?}8J1ik5R {$ jwh/}Qu Ǧ>J6l,^7 r+H3C䜱B~_^ꘝ=e3(XibTh]i}3UM}oDncK*a&FU9}a/f-k}rQ?Qt/~'/Uev0G(`gMi~{'TUاVd 7zR>x짒-B}̫QPs/U.gS@ԾmK?J(}LV|*M(_>=/J/s~‡xxdV)n!;SjI%X'ںVLm]V GipBWoۆ93=tY+j<(I{yz/iNR:|YeȆe\)2+ǰu˞bQeffbp&b(FYRfߗ&L;r܎%Ӥ0Ft<;^a+?0TlWUbM^JCzc4J?]ge~8#^hln~`+IPiesvpyb8r4ת$3عDV(]G[e#g8rHtY-WEo>l\}J T o TK}+Yu{9З&V蔕_fٽTb;/KiIY~~IAg%sɝyIJ22GS(t#k~⿭B'[q(@X#:Ǯ4 ޹B-@exq-g)K}ٻˈOqXG/>1v_\Tendstream endobj 676 0 obj << /Filter /FlateDecode /Length 5717 >> stream x\Yo$GrH BFa XDX%?hH6&5owDfVedvT79CzJyőTT?7'6ӫ'FF`|=aAᛓOoR5O˿oNde 3Y= =~}${SZ aE Xc KϖA~ۧ *m.r1jP,$YblV0NvD7:i|nav{6rKh?%Sl|;r4N5pYPdxm wONbӄ[:zYE^e崔.cE 6_TWz1ճ;p!! sUs<QØm-DR]CTݔln.*LylauSS7* e('p4T&|&fi=6HaoV0E[(L@xۇ$RDfDΎWv=Ie] ?ds(ӽNXMqJ4dQV+7RK2TP66ݑ}R.⋮B$ h|wy] mS4$TJ!)R䁛H6:G8M^Hښ&>tyQp42oG;ע9l@S2 ID\! `Mw: `sJ2 ݬrDcҦ ӡKX$>ĔL!$O-UL.(&ϖ`P(cdǤ$@w-?&,|ۓYxHBaz蟶SI"4+ 鲀7 )K*A}Wu,SFkb#\>=+x]nٟݰ }8}zI<7uHqO Zd:T,=(=>c ~˒v)d;ʑ#?w u=;)Cԥh.Ɯ+fL\f#3K?šŅJQ ^QGoR55^Ax 01%+wDrvs4.8m$X D+ ah+QpM`sp߽B"1(mP6Dg^2i :j%Rk mӃm) '"~ c=F1M^ b J'fTN;bR%h|)!芜j DgphME#j?-8)S _!zs*V"coknijșvNX+UuB!di :g'qrKP,Ax`?2nzFP$jlԸL /"_F--VsRc,U4&%t! -든v ,Vڈ;,!Ɲkj$ҔLU AgCuxUoݒׁw^I޸0ZX9!* #pE|?w1[<*79uss~vΕn#eF2 אA}ɡ*|1 *R2xQ1}oq‘"r@9T;Fl[&YFZI;9^mfƩ/v"`;+bX*%J t:8͹d8Q^Mb!448uS7od/6LVJAY)RZ N1VΖV~,5W}|_ Bw 9LT0+Js)dr/@ǭ^"=̉IEl%ƇN6nTq^!q1l[;;BȊm,qH,MIX:$uxW@w ?#oiڒ籽.e(+RSGGGIuCRm$j^h}0b!S9&S)Ky~r\u1O+hjhtb0ާU./j Nh/\d73Wl8ItT%PZb3DrItR7"$`^ XQRқ Hi i<H4*+6&@aATQ$ ? xqكiI-Iq_a]v"&?g&E m|Lj={yb0Ԗt ([R,6PJև[}v.,$dgy]؍ȈYJ DTTdYv#+t| *sRKi;!JBsu|Ztaι pUîUYR#g'J:gm%eJ3&kj7 -XO3Z*̖ŪR$I_6C2F.Cw[xH)iL\?Kt9IGxggcJhHI+9yhUiGՔ$ B4-^S9?v\k){ZwMsX!ôum }:wiY0ɉy|,i0{$'TRo^3Z&%$_bTK ݩD<2xg;Iʥ%XxуҔN`k^*M~55m$kɤk\ D25Y!54D_n0Ge]T.1'œ_(%)]VB{|0U.U|M⢉Ws#KyvRA Z>ʺ\A.R2y/W9ո9(#]m5zH^<!,`(CSw&@R4&幖5:|ņ}WK嚫gղ ^C3z=6{̕L0v|8RgCOA[T-ntvTݜ.;,Ox]fkgM׈^O֟y.;/+ȿb BkܶLa!-h;y'ARe@8V?[|sMvo|U-y[O:Vg 5~kh0JRIHPǯ׫:V,{N @ЀxC44jj b9TgkN7F2e='#4oدE[I8 ]hg?YsWF-/ؽ,\#K>0]t߱[My pu~NBb&+[// r"}ux9F˗o/xn<('j^}@tZXlعd;v]ƏBҹWug{u-{WTrb<8zIQ5!Y{7lm44u*C {uԒ }1HoKp~wπa4`eW [hWRڿv ϴ{)9vZ={l6@ CMȗ}Gy s>%IJ肆ȺcIɛcx#la`%d]旎W`|6LȀ{1߳Ƹ?]HIVmag3Q*&Hp[icgWhu]9۩`kendstream endobj 677 0 obj << /Filter /FlateDecode /Length 3546 >> stream x[Ko #a`("QAafLJ\R =U3SZ.i'*7kzu~Z^/7{rsۃO8ps7} @_Otr:?.0p_"s1srPU֋:^{"gG7Ur0t{2 åR.ukeZ'9ҶJwCZiItW@lHeۜ]eg9 cI=W0MY'cEqh3d 8:=><89XZߧC&98?.=;-`ܭ#'"K{.l-t%:)|J%N>#|"E+q}z?ZB&m"" UvoSSLQwlVR&!yAzc Ԑ;/k*yqrT`i&&̡o`1tXB͔8;P[>1gb)ʏY1Y̌kVl CBGe,5"uX <2պTт3*0yV֒|O:hUWS,ޟp%0B_|ʣMY6HC-S`С4%"\aQƲ7C 1}$V.P=#xn{ivHj5<"ZKԹ"hr f%bdQJeCUYn,YACd*bQ'YfUҴ(ʒ-cq'i$E"dqCŁ?g!(r2YBt܁9*Y/pɒ)bM /bngKl[ b æ$Z*cPJa6ʎU-V`˺XzoE%OX,ZvHNQ1T"9S渤`>Pzn4XS]HXY{ ,_K}rOMSZюfI$3,^rr4y6"DuDF"^ F4{4|3Y3hnH>*%g5D3͗ng\ yr/0{^dhwبG\nYIa1V4Pnځ1JRKBFGz=hŭba#zN?aP-imM$M^cLɦҞ7iE#cw9@χҙk6xhVV ї%htɾy/?5:Fg㠙]ET|R! :G[H=:IZ Ӱ֓T,`l]Mvesk xc`úRқ١ؽnxOJzvDeQCegZa<(!';c_@J5cmK!@LÍAQ?;_h jrb],(P=Q7#4Nxc< 0Е2>:VA't6^ˊ>=aa\W曺Mp`5Y<,DغIk T2+C]ð^V%`4MUWvW@+o ^daǒFפ˂ʵDW /*[f^]L;I?yC4$t z XS*aV5 zro`"1ڸqfꄱ`<Cgy]n5FS=#"tQa)F ]wAeY3\(:G_!nX$%koXxa/ٶaH&OG^9'#|4?%DpOnը̈$` WiKbkG=]n_khpOdy!{ʩ;ĵRw _<ѶGP&Br,ө¦YDqSg["j-ص%U2Gu2&jS)z3FecgasD03a!6%k@P.)k~^ls~}׬$I*yK#8 c 9K8aRn˥St Ul{kYe=:4jH5q,L>h؉xD=4 1]edW jj!@bc0tʶ.UF&&.W%wٕڊ4a;Zo(0NNwX8<+^i }06( pjFt)b>:Ç5A|FrLalQڵ4D"_ى=>nNX zf (,e3fO[m.a0x u']Sst,5u}s]<1zW[BvXl:0/ 2'ø}JmVa;jGu+ :{A]ɮ@ؽb:M:CnqWi&i3XHkzɒcW=[,G7Dz;ldiz›v :ȶ aSp&r'Z5Py` ̟V0Zmx8SwwlIgB-2g>d۝⳷lBgCLc {4 2U#|!\Nf+V` ]3kJU='Jl0'x5M8,;=UԖW&|/ShTR帶J, mH5]%|*eY%v/?8 X"/5xo^ r})+"_y0|br ASDf\=[7D@}OOC~l[6{ª# )yD oE}GF|Ebx_AuԺ3rD-c)2=7")ÑMuwL/0?(`x=4W_I~٧:{~އ/| #(mC;",<ƠMh%!+bxKDU#QR~;JdQɊ_+:19`/b ~QWlߑi(w2J݊2E([Z/Nt\endstream endobj 678 0 obj << /Filter /FlateDecode /Length 6424 >> stream x\KqC 6t9z?Ё @ P\tvfVuUVu0zk/3 1 _yO_squ'F)Q/|{q Ƽ|s3—)(/x&A^x맨ų7OvR:KώO۽Ĥb c[`^LA*n~u ںi/'!Vwgi ƨ(L1z ş5b~w>q:͌+)4څqw?h+64‹l۟_ӄ~_ݗ0ic)E-ju4zr6_)SvZ uqv 0/!T` ipO9XW#%kw?Mt,>hwsxS>q1_EpVpNLjҖS&¡)ZPpLg{ !Y%]zqɂ?~tJL.İ l|8R?!J]#T*egs&ѱRKN3 4us $78}FCGw." ؑhty%ϴhI*s^?9\.ާuNCBK%Q4Dᮁ&`,H_Ӌx- $mC_ Aп֌#O/HVhY1ycl zqSY]\10EY7JР {ter~a`챈G˻SUHXKÓv#!NWD א @M {Y 0-u:*ceK4㹨>!dc(Rb!@jεySj* ok76oN`YxNBNkPP*͢2~±\d }̜J{* !VopK`>8np9 gn㜺ˠJPݐ s]2 $urm)y8{cT0͡?"/}s ]Q=ߧsbTڼ͹6_;-_ +s&xʇ42& y N& ($E1?lnmEM9,9L ܦyY L(]goL^51o!M>|+Fڝq9\~Z\F[#LæmԴyuV\aUl!si>-ؔ*i B,+qZD|^\ko<_{q-%\* gu>79EPY[o?:4a0qZa2\WWXx ~6A"Qz Xkj@ψ$FesK¤]wbka)->;aԠzۜΆ\ Mɕ&~5)6uvV@d~E;<4ԝX!J l/ ަ99ӡ%t0JVhOތ50^ q9\&"?;d34s1o c!FGBg`/#!vj0!FTt:i<.塑LHcSP.&&czPR),'aM.:K/";0&a2 CRY7?b8<u 6S 2urXT{BNq'9 #&Z#YJoz=YLVcRJqr~!CFp: D{%HãėyR21 }g .FQtlCmz\:4qlv$z=ICk+4Å1n nxX_}P3B+ֻ|p gU!\ͪ`?mceYfyUMPP7R3WDGKR s2R݈-1u#d{ja?<P]m4eLǻjK0M_ƌ{Cn*'9!&xJTQ@jrcE~ĝɈ#be`V*CN<XK%?I[.UljvZ6D \AC.U_-Lko+6荱R'@{! LۦT. mWU1!h~ ەgx\y\wR8#ɸyO}`0B՝pOϓrQ'';"O[xlR99ao¹ k8E<>PYjއu0^Yh\VڔU`FK<+b~9tN_)1|ѻD(e+2ඥMV="&+i0RѴXC{eq]jY?K! w}[^XW6,M5b֍)foY5n*xvO%iuN^V# t_F0vH2#j|X /n & P\/)%]'^Nx=XHr aLzʓ! \yܦ 9W1؆`L 8P&9s1Zz`DsIFo`|:JlC늑&aLN9q66^!K]0F)x&,{99ǰ$c6Y6r8;g2BzȞӵdJgdIAA6嶟gy|bhETǹ+j O|_>׊{daRڠTU 2?*!&1hºEnIav 7K-]s^I֚h*oS=8-:'0k<,ԅ.x]iy<J<̓阑prJWJaqa^ b0N)?VEhɑ>吞/ Ua KK^J pF-Y@C3*gKKq&&)gl=rx=T*$YKzSF=kYw-V:旵Mm>'ɰ3"Lɧ}z$VKO\G>&!ZflgeLl>}H m >ګ{DWbz=I칏®q.`]fB1.Qux)Z.1z$.\ϟ%9' {} GT8<#<XJ=x{9U|GW4]P D4rHh=zx1_W矜Xgbˈl%aLiw00(Q8%Uu5' FokۧcBݯe\̡G= QJlqVNb};^/{oEm2m\pa8<wHB,sV:{ŋMK?1 ծvFk˫`in>Q潧?tKblzUs{ԴG= ,#Tgމ=|Wy_' psysZ2;3[ƃUy|ƻLWz[z9.<`rkG%ZNlBR:yc}LGd6Oם`Mi@csoN_v<]j"AĨm քؖOqZa6BZDҶ갿Ρ6k1,NYw6 =G{\)k|1qTSpVѣ vJ#OR;Ua8=ޗp+1J,4i9Ѿu>H>Ѡwc%Es}q FkḘjN0wyڬc_7BfBQɛaUy㘣sױ-h;YyYKHXNsRL7N*Ze{6~H1mX Pt̔0''v_>Ybw]#Mݰp9Oa3??dH[˕'H u`捃ænZ4F1a/_?t~)J_Iqz'r-at wAF7 ۳gTi${fE*cFW]ĸ}"a<q5endstream endobj 679 0 obj << /Filter /FlateDecode /Length 6429 >> stream x\[s7v3/HUXyI<Hũn]j+ SÈ(9$GIߞsAnr(ɕ҃st7'_psCо.hU|k_NoRјߝ[41ӳW'<:: F;=9q8k7hQGh![jM:n۝1zJmm?.m1c :zZmR4o Fv9]NN0:l~ ;.gB;I 0ӳ2۳Nv֪ӝqC?S$0K)+R\ݶ4YSLns櫼d>Dc3<6稱ap6@2:'g!jbڼ\r <[$UƔ $oNKz)=/(>= t88LZ6j t@~6 yY?fו.gGo`)^E$&.2KPH!?o-= _U@#-&2mX_E=&7:hC3@NЛ: QJJ򃵦l~RT:lyQppNakΎ>)38P*T34 T[#T}5pB3CjΫ }ۡ,'8| ,JH}?1;A6I|S_Vs˯B(ڼ+ZM6EE `MPL?zY686tꕱh" á `Vȣ2#Ɗ49SQ6~DJJ5m9Hx]FyIhqAvM^/V!] hyccB a7V .xX s &1YXA3QO|g=if%'s~U{{%H j%P'7z{a]e"KKӋll#1F ZY]@g~QZY5  7yUk~g|]gË.]T pٴP߇s\ĕҗ)P'tƊ4"mSwLj٦qoya0bc5hݫ{^&McnGfw,3&ާ] ( ]}[ 5&˚I.&~837;HHK؅23KE6~%i+F {KG_VCrN``ӳ?97}F_O,ۄ\0N\_@vkW6a_+YF4e@u$ٸQl-i\񘳯E&W< ^=!vFA5"ad6Iž x(x6,9$mz@I^s\p# >-I? '62|AVF~ALi!@,D /KچX:pⴴ 59vӖZɫD^}6iT20Uv/mQ`|)˚MZpzܻmN[zbҬAoH ?9o174,hd2 tV 7ͽYPG,Ϥ 5UED2Bw.6të4uqWh!x%FT3&xad&BoP 8n 7OEDJ>] Rx% [y߀,lPC't~.DՈN=8XZ]5 4e] yԄe{낔+C7cznGo3+:ϡ'gS~\u&*)$:V2jh $UUV!18ᣴ( OVDpW9 OiTN)!-EEh<6aQwđtǚ Rt@t: n-z f"8+6Uδ 8 \qT~ƨ2*M=Mtr/jLd|3>d˚{_0VsYMXVu: fAT W ^| *F*oK>gm=BH.WIZ윂%R GhJ ;K }%DV8 L/ @E^89`v0;NƥVgZQpv +@8j~}j\kX -aKqB] ;.4Ǟ/Rb~-thB9pP茣95 f,L=\;ski8p]ՌSwp`MK>u:rʎڦ6 = o9w<ݖJK9LܷCaJ\6prʢk;2u)?b^sy9нnjݓ6υ@jlZnCwevicK);xfI?fm,|c ;j3C 6Qq:I-1ڏ|2@/k()UΡŶ6M1tކո>-e&(Sai$+^P2\pՃ׺?#}ENRkXM1 VvN+{m,0׎Pbi ͢ogC8R?$LsBOi-[be^eFG'R6_RhawhALϷ!RKSsD>|m({ ODJ;GHAQcn)9z:"ڤd6%-id d~:G8p\X(dkd>{)]1eqi4.LB|}XGo ~{MLә/8X Fkզ.UV4 `*5igDAtlI8g#,tWIM(&/ƃЪ(C$<.:BJDTej9`nLTO܈q,Ti7>5Ǚ.ZbUgɼ߷`.ӠDGUBE!g]yFDQq RZ݇DT xeHaJNϔ4/ C'2?#dAɛڕ Q'?380ښ&́YH#o*;1P9?X؍J  bzc&/~ KsLQ/Tu!,`\#.=wgH#_iqQÏY#׬G+Ѱ8\1=mV|暋5% CG+h-_)uH\ %v́n/I IrKrzzt0V ${VRp)V+K+=GրX&t'Dm q 䶆*G4NR*#8 *(HW#y]L+&"DAK'.#ŠnH"M@hzwl$8Ł#% *FHwu_6cs[fVTUWt@}ut*5rEb. ""ZJ9dѻ8NP۷K{Q!SQ{Yyp{E?/~z]Ƀi' KwfͧW]W\2<׏gz0`R`+ ֕^5zA3<-YWh7Q,1L`a>O߻I" ˌT@[ykyVf*FG#"@jߒS,c9v^=Q* ˶4\9͔^P֎@▬8[rPC-`iXgQt"x^1AC%ƱdQǞJY"ᄍpže>(/Dʰ<6bsbj[ɭ0lNP@u\e RȔ Qvfeq{ jgw㑓o=+9?i^Fx?jZڅxj4"iz-^GMyAO*t1~,-Febvl9'ur@b+9e|%-{3fTT_uej1y!Lslqk VsPPS2}Z*S-jW*1 )z V2hŒ~yt07UËvp rR{PUџHAz[=;~ŝ[B;JT_aOXܿ-zѴi|,;/^U*v +-];7 *Oظ6ǧ(m,-%H6//jɛ+3)Ti[{g4TjpmD?]-TZ2c_P5:m_R%KhqxHRUA&Z]IEϡ+5Z = W&Mhv9 uTnGJD.2|'1т\ۆvl*×{7kLYѶ5Rx@+^WzmJʕhK?N,Ka)덣>DΨňW+l@'C|S8- gJjd]`ρTm=fnjaJח,(6e}tEuy︷UjA3K @°XسFVV'NY\:DMJq> h,X$K<,ux$u䳊\edk 2b&Y(DY;98ݝ}ve:'&,~1v9{LF,` OSCG;5z3s;1z:BD)`' z'W>V `>6XfLKy%`OD1QR!|^ְs4d:2vmGhJ0tfyBX9gt_N,sg|6 z%f^:ruۖ8ԧZL.0MX+ , cdx0O04*&r*t0&y^vz9L=_ZTW -FX(ⓚ}T"_ؐ,PzOɵ[m.NMRrǿ (DL .y6()?*> stream x\Ko$Ǒ3C_Nz ؂9H&dP&69YY$=2 &Gd~\/{zsoY\na͑VAzl#CC滣,nfJZs9Y׵G(m(A.}vq|sI<KH 0f1םc[`|}J{߭/[Ǡ6K i÷17|\v1 ߝպ%nCNHNWTRh:Zhcw\ily!L3jC+H!zŎ[WH NoBk\upׁ7ߖ-pezeU8|P}h[:QvWϗwg/ݝ> &v,ίiI f^,xƃJDXYQta肼qf4 Hfm.h'K6]x&iR˪wBI\+o`bp"GG +YY'~\)kUHն4Ɂ|@=,6pr[oR?-g+;pjHRGVX{67~Zw=1~=ˠaXbrHt'ZFX# kWBWRք!5ތŕLepVw_LgF) /6-v!`=lb %!EyH-bP CZ ?,@Oن 0ZsIe6A|D N* -TѠl\pUKSk06( Nyn s@J~;興z+ʷ]Ҁ9…=_y-#3`}BXY*IS:A)' cR'slLn 2 BU\J܆`C(L)-,U?@pW!d4`t`yZ0caF/:wsQIr'nJ*K'pq_D uW-5`ض?~|7N Q^ڀ<30}d½K3Ѻ;lBYg7)ၶ"A2)⸱lLd~T }j]8 K? t`#4%fMJp\:wI!](+DW'l5|ǢtOؑhϙM}W}s|Q`|\8zfSglSr8vCÒ\J)~Y.So0$h1frv$ufѠh5q#R@p4Z8!I1&@d"J HrVóV3$=8(u;JP!!g 4<n>/6WCv}XJ'rSxe,m<|4ԅgaQ츷 O4Zs`_ЃȐr3S d&6Yф83xW͜]z6["jD'^X.v?+8,XɃz( h*~}dV1ObYJ.9C_ ]eG=J'%͑!&GtIϖ͠:M'w7ҤE53(LQSђ`/m6ц0JZ$>d}e}m#Zdi ,uۨr2H gsԡ;[*d}p)J$994l4p u*~ͫ ̳M() k9W-[rxCmQsZ rV^A4).Nd'77J/vSwil*ͫ|UVph@B<+͑н.24JX7ݳ%mngZiԄAcxE++. 38Fۓ| EH7Na'tφ5UpJ*C,ԝ>hzϓ=  Uo'f-?zɂdÜ*-[=.se 4;|i(o˝\dwrƥml)͋fpZM~[z7͍be7!+ 8uioP~l>JSiLڶMQ`F覹ׯnߖ74#( qr|,ͿF6+!m]'Ӓm`};OcMl[~Y lE}TƗͱޫp?H޾4%oenfC si)#^&[/jiJӖfjmW ߣHf}_ qɐ p~||lK/PX/ZO" !$W|8O "5ɠLC}!e@LcS2+us݇iꚾj),f'f4e J@ʈP}ijnƦ-M9W$>Wl2V9l+]LA9vv'N8h6NmLE 44J!6;w3}Ii  lWY0fʾir eȧƦ;7l"gք9 02vx}(m/yݶ,|<)[idYJyxyb[&S(Lsq. L.7^ ׸ bS(Ҵw\l՜vU-^!6мE;D;oiʺ1s/ReIi^f%TہÁivD {LvZLWMN&<ڊT²Y)$gbӈ1t~Yz`0|iw_tkgMfTˮK4yyCsݵj.Ò=ǮʭUFwf3.cjyYlaVتrkCc/*AN;?>|Y֯}/Q1[_^o԰6=~9t(/e}(Zs$ht̐Bo~Uw$Ә2Y)xk0I`4"TENEJ|E> ")J%LNl/x'ugmg&K m#„@ rhqtAN?\!@Q:"J̈́}4sIDuH+nsy>I )9 *Hk2qy6/*m6!*shLƈ 2Z=f yIF;"jD١)*kM"4-V|  EOΌT}5٨{5kR aZtԼlMe3KJψ9i yXN,UV*['q!baM.miUEBM>UJFE3Xi{,AepY`6FvX޿CM`EĈszQTi;g#Kbo'Ɋ<^eUه)?/uy,_Sf8[3^ymO|n(NqaMEN8=gikLz$i1sT*/p '>;}orW Ot{*y잫M*2;ڻ!iK[';"Jeݱ|Nt( Z՗SI,*BX;fTo:W'P❺adoہ7k5X^3:&@.i5̤zٲ8p$x b/;o΍.wϦYbSE$b ؚ蒪W,^y]9 d˺22+?9)0SgMBWDxpi]:856-CU:y`dZa{B{ކeGV:h XU~0.aQ#jŻQE )P)0d.FvﾥSO"|DhjpCʈcm<}xH `˓/ 6}_O4TkB;W3 y|tKkT':ғI?Y>9"sE2I6be!+߹!h7m_endstream endobj 681 0 obj << /Filter /FlateDecode /Length 5182 >> stream x\Yq~OCC0j]X` Ɇ!z?ꡇ3͝"2*C.`CdLTq|qdZQW|s{ɭn.~ ތ1`4f<|w_;n9W7y=(cVY.^*Uq֯.o/֗ fLmń./n5S Î*'ǵ66a6'pXQlpOTsOe\ƙߖzqΎi }s1 ;WqgִMix#V ~ʆ4 8zcs軨K8u&€z3e?QBaW3wSqApxW?î~ W0WCgamG7bˣh\6|nY`jCf.@ 1dsƽa#P3~ɰVM1Ѻ')ucPd>b:i-Йv)j؄8ɬdx+Z7*PV'sQl-1FhԂccØ]:tcp͜9¶61.Y*4)t&3oʌVFaЬ|7ubaVgܐD(%}5S8's62VMP]skh;1J2sY>D$W(hr_3 : jV5yQɍ vW l&ѶvE\dr¥)W4it$OPZ05JeunHJEF%w(WfTFrUJ|t\U6KH ը> Go=Zy$fv-a!D\HC!k) "vW]X1L%օ뭯0q= Wpr1 0ox aoǧ]jC_i X[Bd0^|rF[~1~Ģ( l 92Rbڂ-dIŔXyqEdD@|f 9x;bA8R̃`EweO ,S,<"2g =3E a"wCLHH<u?!s0Bxi :(h"_cu5&WL$  x+v'O@D7̬pAކy4ɛLN2)XVO$ƒQnIcxJH"V-8G# Y(RZJ` 0 R'*0 A &UI h@˶-,Xƕ]#a~4xE PUwm3u@l(|: "vc ѹr .Hk v&\@eZ}DBogm`x=^,6Xp6'Xl&X2v#1)=a9 Wb*LPǔ o +0A&LPzEo{ PpY2oC&*8Bb#Q%WTp# l,ThXQM)2PGrX%d &@ϊZ"@Ɗ4HE/ hYP(< BNs;KKjn ߖxbF^'G-;0(D.xKTQ e*U:Fy 4{  sh Gm.0ᝳw]Cx@7Mu9@<$ rt'1'~j.IÁlkܘp Sl0*;:&Hr )P0$0+f RΐH[3$ C42;HT$ۥɘ &-5 8e 9 ^Uw*DDY 3]/:QŵFSrCc?˥G\Zۅv\E0";Ṕu@c.1 qXz*''"/ V)YsG  \LhUΰ,n)#, }6n42N b`k@;`nvÏo6lhf?z=zFԟ{$A,cJ*T*5ؑy0o\#y] lG'8'/PN0@jnW64$B `)^tN[9ߑׯ .Y0cCU1A3T#1RTy fjfVNÇyxX\i>ݼwLq_>yj庨R _ͼC1Ֆ'[>G9ôEއy㙳EAm/SgW3jQ/%UnSdFm{ZnU:-?(#694V|A&NyW?P4 _3ZpNzuԞ\*yo[[..RmWti&A<0* 9M)# wgeA[gJA d}ri$b]9?Z_uYWVFd*ZZ? wQF<ТΜm;,B;b:ɖUSQǓ VcԢ=`PHNq t );տx.|iL)OjtPU%΃ .u4`dƹxc!Up]H/X:0蟉zZl+"BL7L WTs"%t[!;)aie¾#*$^qYa Jl8xkBUQKۉBw)䦤>)7%>sHˈuwHx6/ߟf@qTBѾfKܶNUu ژ F~)8#3 ޱAAʽؤes.F  gII#Z>>=0f >" WQ;1 UVz]ܑ(b)@,nFtѢ\vePΦ wݱfR[[[XMGq:YXp31y? ޲:dBgMWN(E΁IJ?Ėm3$]g}kv2*(s8̾@,ْ2D[RZＫP6D;V>BI-L5rщw&ؠl+\KKYOG,v|sue ܈9 BS]&{*p X5ZDfOGpr[PWa~a!:>Pt:dy}/1\/(K]>^V,NNk?^y8=fq(+K6d?/]n {I&wf 7 Eo_|PNf02%) O?JK,sR=CI8G9/#dkfԎ2L)}n]3R*p>Yگ!bf ӳ SQ.- =,}~QnʔKǒW=49]UiJQj^q2K盈!.=F+-KJf{܄BYzMX0B;3׭@D͹u᭗+Y4q9@ߔii̚.0s gK;/?|i'՟5x}ui:ax| ޙQ?WGU'>衈ò8f=4)32JrVD*"Rt4ۢMk^¦J otMR:0u0*-zGsL׭-GQ.xT?3o{n{60G<<&{{iI;'o>NFwpiYRBy3 LzahM!AD]9ReǺ0|Gx f{6R7OWhBH5+[(=a:}8 X5_D>ϛdi<6}7j >FrD*W |A}ǚ}TtI]a C3bJ:K0f&2Cm*ka q֚t&ӿ4,4{!*+ ­)WJJj}t޵w&D,t('C ^W_!p>Q53!sZwg}xOx?4endstream endobj 682 0 obj << /Filter /FlateDecode /Length 6259 >> stream x]Ks73wc~ku-oh#f7</~wo9]?|w'6Z{۱ } Q'85|)aj(<=:I O}SbqKH b)zcIJy! []aA[m"j=b{?ga ƨ(; biCQma#E{Yp: }E%v`6vRk`o;/ 0'[m)[-ٴtO[/I}nƤUD=~4z6oːyKl:]j>: ﮑ` 8#>bhr` j*$H5=,ߩHIc欠+Jeot~+v焀zA_^z))|&}$|ukQB?kaQsrX?LO7 y:ќ518\ Ѷ=lClȭ8gk[ _ 25 K`w x$)x:H}2ur(Ie  c_Q XZ@aCnBz w;`ZN@)~'i0TE!*gw D$6]Hj/cT Ų^#t$N{٘4+;t@P颒&#9)#669%mj5VRk/=*؅%0De%PV?ڌ!uMxF xVlU3=Ԏ~D#dį 襁:~ 0$C-׾1U ġiXGWA+RD4z[rf{<Ǿl\e8@?B8v8CWZJ+hF+tԵ`0޿a4g&8kD->zU0ѻ^ykٳzoק7_Ԏߗpp`mG31Ɨ5+ČCڨhŬQnk+Wiy3NpYL`X}0_ЌӨE^;?bGgīD|T8p$ L9.sx vncUQ@UQL v D#jP5xRMO",^Kb"^4P8Oʖ>CکL05O֚CkL$qIg_4`E <$z",KCώ:phSW}E-JVF*yI&H6w( 'ėK./&!߫" ɔ3X"Y;O9:o_9(JSjT W{v,=q4JNuQR1W ؍r d?Kg4I'gI#`QGkQQք|&}l\" aIAXýlā~:"tlԡsL.kF[ x1-@8FM.nӌfJH)nsE = }3o>P5pH5|DXW.t%o͓%q1cSRg NéSsGpV-IS YpQ@=%wxAL>t[ &Lk!o.6nM*J zD5WZ蠨WӲ Dj(ԷT󦩩@#Uǿyș3u5iE7@ >@\(͹q,ԫ=|4|Z*v@sg\Ff. Aw)Jc,8: [b5l !>Ǭ"Me74SHDV,;ݏ:E%Ղm*OFTH.h6:O\^)q_l %9WUlդ\a2 gNt(T]Kuy5I>RyEFNUae9|s7Ok|eK[<4]#҆€ָwqBo W22~ ppʢɃvד~P1hH&oȊ*E[Ju/k[]yz^0HY G7h,b @NlD?g#ghj $dBOi@( ./K\f}6h7  C5ozGK8cJu#(V{$᭴`-]TVh&cH*]x"N`k ./95{gN~c'f\'/W}dAR9nH c [> BYkTkQrNfs)2{ǝL}쀇}۶p#3S3Do߫!HZGJut|BS)2Vaqciv2` L imwSj˝7kLؓ! kJ&Z3Ja٩`C6'J\iio*>]\W7ؖl[v2 %#mf=&0եH;A̐B (ۛRdFm);Yu0_#XdoR 1MP{o$Oť^A>l3F+=,·xW˄dF-*ϧ۾CKqTV"qN/݁:P(}i=vf_3f:Dʼnm>bl<ڃ}FVOlڗm~[:d*Cv]8 2F4߫^{82Qu;:hu;CXuv8v/ȁqVm[<0l> O+)Rb^x=@cb.D+o\ ћa?3VfD`TxtV^ h:j.k)]2I9Yb[jbQ%U96Jĩ>8٭fޗN*H>tV:%`\.y%FՑ ڌ-=8Uc)g%7؃5VI['d|y#s)'L1q S~rxs_FYEdKx$a*l.3wrM9IuHCR*m9D`Ti6 N>ӪLӠ']Ljӑ,Aq1(f5V#'R()wbd  Nh; zj]Q.RkG"·@ZaKT9*?d!zԘF,CbD;uQ/kG|HRHYEEPJ[mdiӠűsGxLӜ_'E^V9m AYX`~Ov#l-^i=qEff)65DW8_;rH4!fZnf >JllC \hl[,mO1I`{X7{ǽNn]a*bT:ccv0MM;FS,EJCC1,V4uxzf,H!=0 `D1˕8*TU^ KOƬW);0<2/{9xdŠTG:|Dq2|sՑ o^"h>&mqG_@d)Z89T [,/w[!lDOGEjr>P')-JyJ|@">AؕiuS8 r-i9PrI)y36وr^lgLy~߇g[56N, ,K`bүƼQ/6c3zYxd4@6 DX؉ȳ)sK͜P:ͬ\Wf8[ќg)kE,؉Os*=T xEq fTy|#뎩Fڑklb8mHn;IpJb [xVL&(v17/EGMZIiQ@)zg}ȳ~CdjBW(y EJ^]I$es5$c:Xvs]ߌ6B<}غȩئwjt=*(^1b :Te4i MUO g3q?L9>f^⹣$+6M/m=D5}XїI? :d4ʲZ!뻺9UBzd:RF4. ^ld@AvŘ{hs!-'=;9"z7A${/L:M$FW |ȋp ss,p~;9;wrk)ik dhFoW'(N2_{՛9brP* 㵦]):;q[vendstream endobj 683 0 obj << /Filter /FlateDecode /Length 162 >> stream x]O10 TЅUqP(/ Ct;,:\<Fn,逫 pk i[SITa )榹I*` xS`_LrSendstream endobj 684 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6423 >> stream xYtW!4 % ȌB5@B :؀E.r,Y,YY,KrSl!,t&s' }nw+q5K׮76?Ў{$/.|Хo@Onz nNytn(M'AaM22zرӢgg$K^'NO_׈v&Ƌ%/HӦ3:.%s(cϬa#s ѫ33wE/ǥG?oe3vgpvƹig,g-ΉݱTst{V'Y.#Fn5zؼq 'M2uд/ 1sÆ bC$/jbJ%oÉbK"6fb>1X@N,$DbL,#ˉDbѕFt'z[VMl'hї"G'IH0Kt$:EHD{Bļ7ۍjW̗mok@A -t4O}qgǯ:tsgT/XEףWmOaOFɽ~=57=D;}6iU}EeD~u{Oh@̀G/_tg62ȕU/~*7tx@H){'LR@tՃ}@E'A6)KI}`C&HfQ?:9VROH$FERF!!^\{?=pCRHO"]~vX *{}lnL6`'9C%K#- ŇϞxInڐoа!_pvg5>Ajr )¨o/vE} bӰy׾"g㖹Cft>EkTҵm?~lNnB=PdW ;)Vzv>{75+f\gNǝ}']٘gy,=0Wh ^=(j}~R4r;t!-y ;*8C6%|ϕy}ݦ (w+GZTT3ETN[Ph4HΠ/`7SIUMCd@Mp'8:kcbƬb7 ?B6\9 /.#ۿvslp3&\_F`js$|Qxř썺ۯ>q樻M@{o4X,fm:sE9dڅ =yp/laP"*ë-kULIhU&%j![vԑ,.2+M 㼆]7|1` X 0ZgLe6PLe1T.aצp n im<2;c`٨uW #.YR!P=`oS` *ؚLGSi0{Iz"'h#!~|>Ƅj+ `?d: E7sôyXJ^ACn,d^;} }bPSR\ys NΩObE֙΍vi8ό2#c(R:Y|RWr )B,:&UU<nCI* d:&o`l8O]H*/.|kfh2y|@-d.g]Ƀ$n YK;g#Z6R'۳eb@-{m%oZ|`mpވW@ƠGJACc9xu3m/ C9Xa$(qk8G/h1k u*Pcx֐h  {:#ϣ @4S èw'`)P0"LuSu`O@[x#D;eߺĀC]A\x`kA?ꀗ5 bR:XJau{8!m?@$(9Wlo ZTg ~-\Tx MC|03+Z0P_-+eZ}A!{@é%g<|wH_tP&WkZۓ0P|v={t:Az5B!+4E_4I-\-Hrǰ5M SJhc;K V[U*MTn(:z405h'˅<ڥredi5y*F P7_v `% G=ͥGѢh䠗9}e)h{Eq23 N.(w|Q- Խ K6Uj3Vُ9HKK6;_-N5g7qSTeA;PG<="SAVlP6ٞL% aO(0 3x&uf\k}!Ыc)TCFФݍ+k.Aoypk(2耊 rF j ~vlmQJfV>mτK$U*rie4 08T*wh:ח+ZVRD{O?f'٤esXh@[Օ=oWq;Zwkn"?p\rjיG-MQU.*Of덟b~Pd 1T۲ʮ;:RkeT/ܽBz^ qV/zw;]ksEbQF7XWȠQOL43a8 %orRhPĺEwF ^ss5" @/h]k߅oUe i>ǹERTs'.; lL`QRɀѪ2x *p%sl[xh_@䗱i\kMcJvfցCԅ߆j|ʂp^ & Q h|a;Z{B/ׂx)d|,ꋮ(Ӷl!^~Uܟ~Iyw9hj|l_zU~:#z4 "ڌɥWr {T&8қe77m@1PxfNQI* M lOߋ lÌr_}=>h86J @6%#%QX03.@x68w[ˇZ% fY #MryEvJQj@#h(H L4 .0a >oE7˥!Wr(EiMNZŦIn.1 G7hXlb haԇG@ˆqkxqc\2,ɇMĔ괃--MxW~F[mpPy\@!k5CQW_ZAn%hg?å?/o4  U-̓rv&gly>$cMCu٪hN0$j n/-t]>IPrj4좸05Lq6g85֧_n.yz*պq#KΖ-#:{FfփJY,jnb<,6|R(+ܰFфrR1?@K@T)C>tp; ޹ >yof3ޚ:Ʃ25G >Hzm(8Y_ސ) \d9ŵ&G!P|N`7q0ge 0E bbuyh\hhzɊԂXm^%zNޡٍ)e2{᩼a>;\|jDO—͔ؐiǘNL%Ms_[rߦ޿zٳJ'`-fPwf`_}o|ԅuWQG4bݼ ҚFg -mF7.MەNK'Wj\`ΰv9 k>+%EZ)v$A! yDP&ee@B$bq! )R)z+*eF%lI~ޭ`-N)t:KfABR2c6̩ӗMjk^vĨ9c6zNYB^/pwװ#p혴ڬ!.i.> ox nHbJWN^ܸo:4oa[8֚Z.3%E ՞(V^9L'xU@}Q3ow̸3r[)Z:~7"Y OcfZ_8 ql)\bOHG ty:^މÀrUSQpw ŭ U< nQ_APa_hMȞcl_ xv;3|&zηW]7O5'޻4g oŘfA{Ps~h6ف*ϯM) Lڤ X(T(i r 0.4`ԉ8 {An:zʫDY-f_Ct8a:MACf )'f8}͠+ ZV( g{-su]S]Ds}5MYrUaQ2qi[m[q0Fs0~NeJ]A z!g+`Xqd$rw!yDyb4M2 #×Vƿ鮊)aŨ$NeRe72*\ە~%x>Y~aZTzJ)ji.2ry@S/Aă=}p΃A*]U6E'tp}ۧmT>g?Х-Xtd^@4'h$ ȚD*IؗXCWJ T; 9XRy Yh+bSm@#/aVE~yl- fLTܯXa|;F> (g'k'*C#q &0 ;/hT]qU 6565B/W3u_ MNDT?ͪD<mDFONZs|p̄nrxpoYŽ]D5Ju^\& \"F|/^a4G"/VWΫd U ݮf!J'<_$Kkl Vh1W]x(UVvEAWe)7_-UzH$uw֙^"ґ endstream endobj 685 0 obj << /Filter /FlateDecode /Length 5050 >> stream x\_oQ!&i\]l.H;G}a}H6YTk$ﮱ\bկUbp*Fy*_{}o/9;OljtлB{#ATw7p O8io{}ke "ӳW'iBy婳n ڞ] R@g9=&C+p^GW8~ؒ#&S_Г@Zk5o?sNaM8Na&&Na*0~$)epN uLfj4_gټSvZqta׍p:BdE**2 ^ld+K7XM_݀H[&d1#h5)(9\N6QnXUaʃډ^ ?j;y0~ X,$;;>E=y&!^ʍJ(@jQV&Y||QДU[arDTM ė7SwX+LeTEs^ `'ëP;iᤒH3D *-s`g>2< ჌k 06 @Ȏ3@a*֛֢5 -U1DyPVւJ4`h,QZr B?6dJIX547D;]wIf曬;G7xK^`}Z뾎Jr]x~`QibNJoLZn]W pӽ"{χB]EE -PUR]dH+I} p# =nFh[$ӽJ)7pdD!L`^m 6J`Wj'Wq̓6 ~ijDL?E6lu{6? qJDsBt+'=mMy-:A$95 -aQ#}:8X~W[#uk(z>@6f[;[:> r|V;^r{]MrƻrЀ0ԡFC5B]%K: 3'FO}%PU;OaSo tȖ'gIVJ-; d0ߴ&X9֓wcR30lΩLv@]HS#xL 7/S\`7e)MXƐڛ}u!À " sgxXO) ьm p`;4Ik:yC^:Ǒ6MYV.s +ik1Ғxvc'I5:uG80qJMA>?: µp8[b8%VOM}Mjї5)sS . H{磃aS^uO;ȀLKRTY'rʱ0)!?=|ȹde5]/V ^xٙp^ fkrv0Sc&g"߀q.~ߞ~<y:mӧ' ޸NpqDȋS 8 /Ɲ5#[G3~piAc A΅町B6GW2I[Ga*SFBPM%/*yIr,L YLs†Ӿ=F>1ݽnZC6CcNY~ S ~z+S- ҭCTj*+"yw*U0N}w&lJ'1&,x^"Bcco<yWwTv* a=u38 fwĜײgJ"1}N!,6I NR5'tiȮƺ=jC'ov:e¾=/ аt))EbhKAg…}^`m0)$ŪqjhySsiں[v!:L_Wq_[{eJvxóئ^>"}qJnK2WϢ 9Ԋ`G(\*~[G( Il>?WNF8VH{LVXMZ=c>!%/oZ8IR;*勇#8fѦ+HUX7nY}ݱJ]U%P?=×~}_x[ɫJ6r<yJkVFuYXlؾnZ,أ;$ml!Un@P]#A:ZG_2 U:M]:AC;Մnay8gycP?ilJ6R,LYH|I!4Y;*#Nقa$FY yVGhשe0T4羾@D / L6d#;ATL٣)H_&_bW?W=D9L!?|\}EP8E|BEBVE#P,I#H!ILUuF;JUemiʔħ "ٿOZy)ȃ^P zPM޻6L6g;\} oX}BDNMٹ/zjbX 9LD>+ #slkqc\aG'楸\JHC6($s> g@KۗϽNx`/M5q1+\66)tעp'8_pM$}"h{%/La7' 4KǼ}=Gq 1n* goUmqK$n?{ڿ}g#r0ˮH93AEȅhrѷ6آ;`leΚ٣m8.%Cw} 9]7!wX奄ʍ`RZmozsbg`e)%W]H|S-ڰśjtS>A.3r+M[Ş)bY^B9grbۤUܛfo1rIln %IYCE=_rE.QZsye(J&e"E4pMIb X0\/6kZBEƢkOoy u/`adT<,Ǟ.ރQ+MR9ŋ0++ZW;*R`|LȸiEBӋ4gZ%r*XEkVzccwKc)W\rZ@r2B㲚O "$6w2>\x1Bu K]ISV]TmD)a'FL BE W^Un7^"6sԞsasMWE[̤;zt%W+ fm?PF vɳ"gdWlQ8Kߗq64oG9g)>qӆbݭ{nRg>L@Y(=x^[Ř6SޭZu> ]ZPfׯXwO7E_*> }g۶VX=j͙l/(3&sK==@߄s߳?M Z^IrL l .q\^\Ksrf/fiB>v{p 7ɰk%ó~X f};C$î+R^j*k@&.UpsRȟ?{Jn%$k'oXHϛ8)?wocU%Lqk;GH5y!ŊwˎgDe9~w&&+/'lfWGs>q P ~b׬;W,[Xa )tƶ=~fo~t_~ۣ=vHEaThכ,#J/xDuendstream endobj 686 0 obj << /Filter /FlateDecode /Length 161 >> stream x]O10  ]ZUm?eB:gׁm_Xց$i, x> stream x]OA  ~@Cå^zCPzxMfwf3> stream xOkAgnqJAMoiִ r9ғ LfAUH96#Eչˎz,Rv\j/:egZ!$!5g%0NdEK~ hBx:?u /?B/ĿB72NqEr,kZ@2AX靝z~R(T*ŌOO!ʛ;.|N񪙎o~݂-؆6~Q'#9N+p4$Hgendstream endobj 689 0 obj << /Filter /FlateDecode /Length 5295 >> stream x\KGryO> -kEBex^9p̐KzGDfeFVeuOS̩GdfϪO O9`NN~<oNljw C6oNpza9OoN d"ӳ< [?DmOޜY:KH 0䏫7T!%E ƯbRiW+|c֭vk9Zç6F-c2F FqcVa2Fjwa_]VOk\N:g+#E":KBSI]X AWjq^`O8 R/ja{ZWu! NN)kjkBh\spx6꒩whe'F!TyΘ* V)l=saVԧ {SӪN6k !iW㰰z]֧/jvڼ{~h^mmy7 QS?}m].Cat`-l#`MTeQ"A( ͧlX\;6Y?~"1ӳߞ}y,'j!SA QȮ5IEHnw$6 JpquCH䵧qHq*eW "X!p%nmpC N8HlL[GB6Aok6/=Mm~[W&|X a$m?tU6 @|?צØ3$a/wu]U}mm~_,^ʣ/ؽs=`5;y䓕5؅_un:(Im=2{Ut]wn߾.t2~__År~PXۮP6]ij3f\UaK[gTƝ?vuwea_b>TefM3"5UM946w;0vx=ʻ3^oMի.Ǩn b䍗O;u26?:nv[61rw]wmg1^BrPgU͇dY5/%֛t59Dm6&AɺMmw}MQ̯f=>1Mm2.x#uﹼ^f^1u44׵sS0V?=S& 7,@OO|}İ'> Obrݹ%jMs~)Cw,f8stT7 9tB0!gX'sfNvЍa34j8KzJE$\5InTy] ]++Hb#C̗9nBB ! ՘8hBvpy5y_f~?H<}K9h8blUmڔ͹9Ov"Ulf͝g2 Rl?/K;ƱJc /r&%zڀF|E(0cEYV$VG'e=r+oW[ -zcII6a =.iբ9tdh#G) RԦ.̀ü0MW4lPRzHsO+h@P5s|>:gפ#]v-Mu|`6("0O뒘Ĝ"$z:&13ׅఌ6##ݛpTDiV MïM{sY[G" d,oFgZƎ,~Zʔ0NcL' D'hA%҃sBJSh\-_i:`?%Y 4`,ȸctU==/HSI)'gDc) 윞cS;3ƵZTeЂa&B\)Rff+FَHeFkӘy}k?8?Y 6*"`!q30I*i1VDi1I߯YeTQ^X_Ke0&=ݧ,l.r9S 0Bs^0SqŖdv=Na{AK7Zj-3nS*x&?h~`r-Yd U0YAŶ {DBrN^D|6\5 ,>^y9 D@n4p![U!qf@#C^A6 E*@y 8dfQ|%j)8j܌ĉupBI,A@ hx ` aev5[^vZ؍FrVE)^ymև`z?{cQ/z=GYH57L֩"o?=}+1'񩔃Hҡ%g7X!; IE'(@fŏ&HK  [‡VJ-Gɠ~wM~4Z9=mQ1/!@l=,VɨYP 6㒻HѝcqF%"MtfOZ05R#ڱȗΜ]>`Iǁ zy5p6H?U t aVb k0piƼ@r=9Cˎ9*˄<5G<{P(5ZfFEɍ]$h%`k+Kg^h!02yI!Z='tkOlXtMLL֗ezd*C$>{;Mt-瘘ǒ4;\^1+@/n@/49l͏5-so`=S1A7J{iH9t3"r VDI3>"sMłTcBqDg#ߞ$hO@J`i/,q,(oo ȳR/4qBJ=;D78qvz[=]Έ,w` Ʀ&;;ܠ|KКA͹)*藩fޏj(ߵ[`T5f M}E6&aij&A[ntQ9&&X Ao϶-ݒ٠|$]b3d}]TRN&tV6ߡ353&pa SLMyJ9׈Ѐ53 owFx-S{iٔkÊ)͇FGL1:ó!4 "ՠΓ;.(a\\ nL|_ɟJX2H: `&uǼhVYȂeQwn&p-5~ؒpR³k K^~6j r:D Q%.[-!1E['7+Ѥ_v/ mOpfG ֓ /cSGB`̤oqM쨛,7ӳimxLb.?0:0)`ob򱟝 ʱƊꈗ!+'AfMnex坨XE1Ũ96(:6|M,b$5'!ђ1 xE5hDSlo36~wUUsa깢Bm,Nի PFqyJ9?OKu^j5&wPJSi`"B i j&,jgKu,d&$Ap!$4W'傩Y5૊%8`E$1V}(A=cRD-I"2 JU1HiyOt“7#I) 8VΓZV2q˺ >b;Ru [ Er&5jz c1V,QTVu?sk|n.mL'2Cr;̭T;DZ[M5nYbKm1Oa,JaĀ|d!e7q"+\dr8okK_1Y,En3?a1'ȶZ{6U,IfA1 Vzc9 C{/6}Id<1a<&lZ877 @'֣?5}ޝX޾;M׬/o_goS_w }2Ceuyi{/~j|O6[І 7š 7&X.T8j.~ 5+C=٧F|dwu;g?=4~Y >簏D *14,ps'EkpПendstream endobj 690 0 obj << /Filter /FlateDecode /Length 151 >> stream x31ӳP0P0T06P0P05WH1230!U`aS027i`9'O.}O_T.p .}*.}gC.}h\nn@n.P9?47XΎEAmGTa?ߠ pS! B)endstream endobj 691 0 obj << /Filter /FlateDecode /Length 161 >> stream x]O10 TХC 8QC_Bg|wY˕m_Xց$i,XX8+/pSj&lOm^{+x"UU b'h9 fh*q\C in X3 FJSsendstream endobj 692 0 obj << /Filter /FlateDecode /Length 6171 >> stream xU$,vg$?""/X IgxpNܞiEo wyw Vg_/` vs>.o/.7 z<_>BKnVK8=>_y#0VL8/W)t ׭w˕ww8a 7r#` V9+ gҸwR..J%dIA)"KaKazǸKnE-99)azyٟϾ?^Z ĩ<3%L D5c-~|~wg߃jx_VXVN,w2`ŗ ՙtZZ+Y:{8VLi^pfWHP>3&+ htB3fW4<0f!bP]V%vX~xtϋ/Q"ʁDFJ62Jmؔ'~:)KI&/L@ GJ2\yua # Hퟤ&R]T@;\x\ CXuUC*ßЇt  _qѽ7pnﶋ77Wn8\wW˰?Ό,`?p)1:Nf 'wg"A-Ρ#:fNb9zO8,bYak`aC @h׳Nv| +$w \%Q9m9N-ZtGJ4-@ @bA~G@r\Z[ d9ꈜ 4s{)3Ǚ#yR@0™HS0p[B,(XR:/2Pr4caNbv4̜$#$-@2%'(xDfN @/2Pr (07El<9c،7) DkVh0(wN z+ᾹoV_w/aDW[%7 0MBd5@A*m vqj Z9)Yq.a7*cЌZ'J7G:L= _|*YYAPdytFN5p`8A`$r *y8ōi嫄>,8pJUME iҎ2L4 ۩$pS` VDOlhT1 }d J @S|,J)=JϨSig3{cRvGϻEea\' &U+uB(tӓ a-qS qPD! _@3drf mT OVG5ԑUK$)>-vjjj 7c㖴nO=Yp n~7fľzmia鵬$2$\*q W)9z##>hb)4/""\p`a snBbxE&$!i)ڧStM"6PiR3T\F8d?O$<}TN(<*p5 !&I'v=۳g3ݛX`.%c8,^vKܿO4"ΩFt>$n:``@aa`/#زEC6'Yy5 2:XEHt@ ]-j?A1Z/$^EJ"~g G>^r-\,8ˁW)JLp .Aؕ@6&v XH>CAt%FrHMW|zNwKAӥRDjxGV! a-OI,7& N` euxᴔ]xOrFKSP{]˝ H vh&ZAtt`az PEd{j@كT|rN:*/lCr㜁6b{dORC܇? EZcB$P=uuЛq!u[Œ*Xx=U,*+aK$2:#UEkJSj " I5uc=a6RϘfZqX]0qhZr6 7xjq T5PPcc[/~wA]3#b_Y4,ov[xnWusD $*($JI||–<&bS14G e:&ިq]MF z}C-7A\ KԱSzI<Vt]JQV'>>C5!Vʂ[S$!S 8^q}WBnr ߒ2?O2z_s.dZd.=T#|N Iay-u4)їK#~ ni]CVQ)FzLmzǼErIc+Fe)+H"7zDdo{;X2G.y?Z eqˁMdӵqtU9QKj20n1u߰R֌($[@ḯZ1. f J^ER w+ RiI8B ;AU)T]50^JϰRB]6|qʌPk Y:_;zIbTEzR|jp9S6;i5 Wa f?*"C܊ylF=1xRс1S{5ߑiR&GxmaUWz0'7\ͽ/ /(@i'.bF` ^XdG/%=ڕD}<voCLP΃m[!;x' 2 7~ֻx}\u#vT^6B!:| Sb(josERmLF051" 2%]'}`KIm) %JF?c$UK+wLGm(E7dbB n,z i?*jM$9VnW!B-4?aaW,R^*AзPؑ~>q˙_j 98oeF0 TIH#KDuҚaPɿOB`NjXm]Ӄnj gOѝHv:цNV@ W?xy}ؚp lǖ42~WBi&\8c'jCCQ pHy+%MNWE}ᯎȧ$Yخx1g aAp4SF5b_"qU'>|̊@ٗ}nPePe+w $y]Ngu/6Pkdh} a1NO~:bӳfi,^~i"G>N*XX *A[/1ZsCN &ˌ*`69 "$ԽMşUJMafz3WarUyTܬ]FWhqwUK.U\%ÝQ-s< )w iuCKng: Hw,B P ^=xAGABbQ;C!^y /8 EY4U[],Ǵ?n^?GP@VhzpK3RV}&3 )Q*$9aJ,/-IL;`.I!SxYY|\ᨅBp~ϫs^9nPAzwAy3pr@X3SP%Duߏ!_G!z\N 43tlq z a9 v>}}@ӛ&rQ3ZM--!##jCSE[$CSZ՞<b 9$-n)>s, zۺ\ͦӯ!ѕZ-xğ!Ƞ[\!.ϴb'uP?ӉjougNuJ י}D)y`h2&# ~6t뷤\.`;#=[^XUx!AC$\+ة&{L DѻlL[ݝ],.QeHK©ðߟi#">Ap~&[ʹG} hQHrJMV6wuj]RZx)|Y C@7,Cj@{ᕳMM&Iޗ ePIrܾ̆p]ߖeoHr6Mdo k˰eGv'!~<9涷e'e vm qEo@Bb*2m Z2ehEf Wś]SWmlO2웳)66ޜUe{<ǖܕ _E ee6j`.0WGz[DNqtAK%pMm-ONqdiW?NQnR=MI/C6'-?F5ʬ{nynqm3)An!pDɵ=Ff(GXmy\ǦlYSQڇ#k@ o1<{fNL3?V[P7©s ~5mωc&L4 _G͵V?‘4z^WeHv/(&XqJx͈x4E;߼i"n+g{> stream x]O10 VB,tahU@p' aKB,N>~l#GpƲ5 HeQ7-Yy!' dv~W3RUiZB 'mUu1 R 8SW`JM5☛&e=O) CSoendstream endobj 694 0 obj << /Filter /FlateDecode /Length 7336 >> stream x=n\q~|A`C[~J!_oQySqM' ܛ&qR> c} xKrʾ77hc^rކb]lN,?9G@ L) 6<;>V^XX~IGV缹~%qW°*µ^ Ё_6/%m.B=^ghe\frI"6sI9#('Br˓Xk|#_Ze[@mhZY{@~WMIj< J(^tqR`WB@k2::=&dBc: }g/:_FJy2uBF x4;mdLv6Ft66Ě}mx-8ƴ,[2-(y-U/6JYvsz $4o~ ],t"Xq k>dSE삱Bmo}WlX\ؾߗ_*)$x" ԃ69ϙMkI7f>fklazɚȦ]y8 n)`a d@b @щts/Ddlm_BhJ~Af3JT@VtRgo﫡kYLe6jL 7Iު6͈x|}xNEdD 4~i9T 1[D bP}Gp5ptl0$zҶoYpt, U04R7ũ" 7@1g.!E+́SV XUݗPHxɈ75j 9J؉-)/C={(Yx"kQ-ϰa== Z&v\B}/p@(ϗKVvޏG-gOUr5w"㿈ΘnΠc93"3^F~ˌ "VF\7C+`r f'Tuaα-:!pe! <9,~PBR%S"P@($A#ámowш qpKuv=ެ`|Gh4XuÛ: yYs}&xQ98(6reP4FkyTDό>'^!B P\gh d|愮c^y ƈ!fw}ິiGbG2 S<K`wV$ YLc{BpWe#F玱ﻓ,Ytq668-zqK yJTѕ`>($...|Xpuk8ud>ZDOl0+7C5/L*PzP%0*ZpV7tdcYɑ-wuXi[M,aUK> ݉tfmMZ_~eH-{DXPBTW %nyj{ĒHp TjZ~@S!mNlĜiem9` W˽&ƈi-?`.jE^%W M1kU~3~/Nc3`R/@@pZ"þ+H]wdD=P렢X[F1Ϙl2{p4Ix׋>73JP"ْ$?獘BP%AQ=7͛-<ճ\7}Z )oxb;^9s2V$hYƴoq`APWU]&Z937N7m k  LF>2.s:l {?7C>yA:b:|m)`*TvI^:!VQoƓ_SaM]':|Q'F1:^WmX`|iȺ /:tϕEZ3IC0[C[աb~HhnH:u:6`71oA]6.r I_6?)eg,?v3;%#K\Up0?ա\bpH#6juUuoC[}e|0 BpIcڊ:5r`4@px"!|$R{8E)"˝Ŀ]k:Tuhx'H#쐎Ftd,kgx `cha34 hf3LPuԴ)I#m alBY헲0Mzͺ{d,8e tO (W-c1\XޮM;;ZwJZgbv '|^', Z0K`GNQUǥlD%$7cnW  C|ܗ|;Mߤʼnzc&ZBp^)>5.ORqĖ2Ot#q Z.t`Y=`Qepf.F#ZJwaw 7*Ŭm mD(jPc:,9\Maxm&zNdm'oñlmTSmJwͷ}P+gR7 DdQ2%yy[ݑ%xHs)4N;\x4eI^-ZO6ڐ6c|5%n{EWѧrUZo xYKqn }ɏu V/EW8[y gg6Vuoez%t"I(2٪Xsn\w)^j3C&2o57fZځRUVXݱj9IP51:8BzDTzD:hނp\xD43g(ѠI }+VR?H Dç;!/UY=PԦqM֪xՎ,tsL/8tnZ9+N/75^^7h$k{vJBc&BK5M8Bڼ1BjZLOYkk 9O CW0ҵ %wDx51y/.MeI*hQ5LyguOWJewBCS&g,?aFZSF5< L7NX~yÐ K6O x[9e\8z5mPUJ]:w5u<3X !=^rX}۷7T8U.r㛋5S,ku1\’eZu]-+D徉f>',bEwS{W$z֟xAF>xZD\5~~%!;r\T\K,=NLs'UlIf'nyw;mN&Α )4 ,a]r:a_0e0A:1?蹓-ws/_w{Ո!j[O1`x='uu}La ^M7/8FGB>t`#j=`QmcI.dcX]ҍ*o`B:0HfaC$?d f~(`u;`]Ӣ[[CMX Nߓyt> t)45\RI"t؀WLP|7/H뤎x[tfJ7NST)9Nu&}Hi1Cs>La Y쬌Dk[T>aF:Xɘ:a˒aN{ Z 1+rC#wUGfJ@{/>\J|U&6m(#jdJ8?Y!3fe5b}QBSs.&j%~1o/ǻjGp礷9(Q/|fN NY+ jjNC„3 on)/֐h M>K P+tu7`]o14*{n-zgZ}F}ˆ:|.v\Vt]Kۊ+rWTsbuX2E2*ָKƚR` uw VJ֞ 軾B"-Ű]mDю8}b-h ypB~)0W";(Vu5kʧ*RGejυ/5㈏ͲVt@P1=Vt=Jyf OŽ7efdw'@75I۸bK_B+7h[Ar=~2\`r!( R"Wʋ+VZ͋@YR_l|EmM x֛Xl | F7y;b+)XttOW-1ZՖϷHBdLݏ[VBϲ7L)/l4 Jfg)d6cFw4 v  KJ>KUea0y}W[$;0-NfYuNQACD?tu OrpDqWzLBҢ[Zo'y*np.Fwy K&K֥]J/|h,?myMQə/^_q}Uh.>;oh;&?+m=ͨ~W(@2gF}(Z+coqhde͐VLp۞g/xhޮ@ÿIV?rvePt%w y[9ۯB| D(xg9^Q+:;o /ˍ!=N!q~:JzB9lE]?oCP ?ߝ%εzR_z%Ĺ1+ ս,X=]nH 7hRUSMRf8'<I`FTVnL0)e/@lGa!"FR}g.e8}Ν -RjyJCbɔ9tRf#I[5-puxʖn>n9 JCnRCI]@MfI%&byl=wN.#s)<s>{?JcE5kүů$O: Q6!1;5Q"T  r]O3ߛ99/ x8P/6 )|c̡f5= D)0g0 G: I < t%‰f/,~{LY3G1ca 0)=/w^ew G5R"y+` EA`u.ZʫVSx=neߴ`8:| V9#zo3pWUe'o:I)Fy''e14OZ9_-_jYT$0,ZK~$%v׈oSBKW߅0 \b>dƟ8f%T|?=$nWZ8b]neawC蠆"BԮ˦/8zIB,oDl D-C+P/CI<8mvB;hZP hQx"zVY~lg9@brR@CXS~+AC> ~k K(:E;B5ܧ@IfYJ"8a{W#+ oz唴v2ke˫rS[̧0:*o֚ig|lQWORz%E?Tendstream endobj 695 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2448 >> stream xU PSW Rץ堢Uk+V!$I $~P<#B"-.>S꣑jmj۵quvθ7`Ŷ;;3;9sI$yM$E ?=51(ʘ I2 Ԛ,2)Y' ͐hт iܹrRF:a&ݠ),i:f/ 9sڤ%3.Y^!f+*tM|\:n7LZi:QUJ3dr2-=hg-pADk F"&&aD xXIAb21Jl&D7>/@ !&tD?8Eyy-5M> '))@ݓHH%?ҫu>o}C|3q7ZV̑Eq)rQ֘.ՐVmXT]0sQ(,HdSϩ|%.4"?v&!1-썽gbc&#ȟ2|;OŜAjFEb5D<9< D?1;GX:XmAaz_dYF20}T{|o}Ocwh&;Mm SdwfM&>a1a/Y.DB?8t-jNV#4fby!4Y5X\^/@,B>O5½6Oi?W)kg #?:(OoF3̀N[s@`B2sxHzH Wl,6J T8񸋳#_4D(PL>K'c{YŠ֬&cH<8MOQkz- 5~+ ;S{z( #T^{ƃO˧޴T&-Uѩqw:"~ܢSLaQQiOXwzW7!cH|moKoυEIG'$d̙o5ZJ*ҽף"e)0 *49EE9[ a{qwn 3Ow-j5TkVhsﭨ;9+?_#~U1; v[*չ- [i)׾u )H 9]םD~9PglH(.),L:m^m?-= )1 &o Fhi$Umc>ZUY]{L֔V%l`z,W8oMڭBs5LzfCml7|= ;}[ 6%nz+gH"~5HlߤAZALA8Лy橼$A1'/ݪhvWXp]zRYU tMM[n6z1V A ]+ *[kI\/4HU7b.vb0K􅦚b;Yxfߕ-IK+,.ɇ*᫟x ӓj]hY-UI\I8Ks=B7Gendstream endobj 696 0 obj << /Filter /FlateDecode /Length 162 >> stream x]O0 R_b CAp}Ilk6|/`,@4XebX8*/d{Sj$<.yU!t&D]MmL#z9dT\~p8榹I*`~xS /vTendstream endobj 697 0 obj << /Filter /FlateDecode /Length 4482 >> stream xˎG zMGH;a/h{v%G>S"^ȑ TbެoVb+/vg[0wgߜFF`d# 8L\.v?úru~}F;ʕRqҭcvu;jl-Fjؿ>7bB0¨&0lo 9|S6J!lE*5XI]pmn 0\0vWZy5۵rc.j3 RQ.C/:#WmK"J}&iˁ%pEkC otLG4 $]< v<ȯ խF mβ"p4ZC{ĜCH Rwi l.l腵p N"EGr"N/|u\8ik"_;߲is#E 2Nk3}5l>C]?&E[E(+= 8Ԗf ʨ mՠ7"CȦzD9@Hٿ tv.p6 @c>h̋t >2HZoO"yǤsEʖ㨁 D)y ;2Q ;s%}F&[4 $(_YlV1,G%鈋Jo *Ń(({KsΡadgO^NZ8ԧ2ΫHV;s؈O e-'ͬZiZ6Yt}€9fDgQ ~̈m Vj!\WvA c kX~vW`f΀zc>BdO}E+x"VmM}YG+x@pm19 U!ce௻7]p_Bpѧu:znq%m [IBvGc:i$W Mw4I' ONbwigu{t6HNށ /µ)m4쮂o}yۘY- Q;ڗ1_rr \8"d $#z\qS$OߦXB-U5ޒUa5Mw;_!W ;hsfN,E2<`aЁS5a 7.: 04O`X"OJ>΄<+Ac*EҗPXVc@n_ Χ*{< SA|h2.u-ڲRQ,u&T˭ieͣDbдIm e=Pze=^&{6 7G˛:O+x&M[l.(/vSpxRL_ͬm_MMţns'G>( RA O=%]{Z+I#e*JǶ󳿞W@vuxW~ }RmI~c(2cާA7veeϫ^Uu ?Ӭ:1 })/7ysgqew0Mg͓ y+['{̼"X`eUVGtQVeFbIb-`TvK4V/r0SxBNJ?)\8@fŽ^^+~+QKC_tuP@i//?b>*ꮩ9HqaG,[oe%C[yI]K"SԪAkWBA Aoٗfe;F=q. 8B%dILd.>uQb##M ߱l <+d' c34-Dia@@w~8!Dz>P H_JW.xp m2dAјq4I8$vb %=^%>T@LGek/fTAoc<Ȫ|s?)WF(~Hp kͅ+N+1` 3$zxpvFCēi&^`fk,U7` p7 ,EQe;` =U+B_U; &e3>w8e΢N$WĶ  }rهI'"Kr´{pQ}?=MHN0Jptn^Rp{y!it#ֻ{U!JH<s6-\NaJOO9kKؙmK7|YAV}@$bMGAs_}YR SDNull 2AZc/*f .\ii?lڶҳGIqG{T.M)"7KY9be#Za§ImHЀJĽ?; d:G'C,iu\CsলH%XG>] ^^䉹Imal#ĒI? 7yzzRAF c 1!GIy"STT~9(uF>]z[^6` }of8t-~j*jz78*޿д1K6̟U+4aJ펈 Q2t=9Xk-K}mdTQ9̮$h'ܗ>wtFrdxΤendstream endobj 698 0 obj << /Filter /FlateDecode /Length 5491 >> stream x\Yodu~Oy?T%]ח;3 %~hOjZ-v𒇷x̌ a/ó|ga}<xO~mGaՑKNCUqH1滣?_C9|hӫ_[Ҙ#^QkqpaH\^n=cv78qqu &ڤj{jfZ~viuM5acqԫ hk5W8I8!09T :?ֿ[FzXk?QKF:}w;I.c<>Z 堍xcqW)yk^}^ ]Z}mm^֦>SP1AJCmqU旵j-Kke,u|,m=ƾ6ov_ګj+(M8FDx]o.&Ҽ{Xua]v2-D w]Mse.}|jU6o_槧3lkN}Ϻc--n4 *VͯkS 6)_ǘ#F|96yYkSw4fwxș9>g(ܳzU;UmW,_wYkSw@jaߥowuUA"),еklc`Dx< |gkG^$Lx̐V ӈ ~CFo`k2VfL^LO19nuPqn ȰEg!,["L%%~-[{X)}3o{-@[P!j-_ᇉ܂7`B<*6P ~_<L(o+ưц:zP̦,Hnd]jc4(sVB%$Go8*ayLZ2hCf0ڥ /go`;y{vUsiw)ηFc3x3+o'B*v܏q~/'" M$gogLW *,ßRt+tVOj[6,L h=c(^h2z (e~kdz4!֭xk/,j b;zLRn<%Syog\Es& Ɓ ?0DlvmA{M_xK^$UR)~-#^&/G6䏟򨌶$s~ O_ș]bOYh 8/|r{2:Ҁ'qqe:"GZsfPwy^C龾#5@k4IPWέI2F\7Kd ɷuxN?Dao([6&D1̝P!!o s3 Kd/YĨf6<>V0ox 8bA]LD`p>ECn醊br8wB/ F<:<#dăo]x_򀤠0y2nt}x2+\^g&?0c/\P40SkIt;`ڠC+"C |QYU iz80&~kp+)MocTLz>N,_ ͠uJKy04i8YȲ܅)EL }V00 Mݔ,h@Ir"wb\EXiZ0nK O-Q䖏QRqhm: p~ꇄFeb6xCS2i o+ڔ"4/h}ل6ϭQb6D凛CQ?@ G$~q{yv_NPZtZ璔‹nS|w) HsgI*9"ψ9.q*aYN_*UnzSeR'KG)nI.(-t黎+\w23_Y mt}zPw9OVEP6:w@h; ~s"c0' 5@|_j<]WNb-hˋƶxଜS.: 9 #l`*4|K6mxPwI,Onv$ፑo*zAg8Bư/dL;"i!5 qˬhPP["mf,_-j>Bc#,zL⽉Whaz}&+f EX8RR4}_aD\׬,"p3/Q~bAGY{Ud9r\|F0+8<(ɫ>ZC_Rcx; 3,>G_1:\3J\sXFX]?m1?9 !5gܫC۞L}:z鉾+՛{I7=~: A:N:C^:en{ z)ڢq*lJ#)}yo?[KVs| X-P\W0W`Yq ڟl/3L̕0TZ/RD})0%,Iy..6h &~[ pb3}MKĵmʁ˰_6qBhȐ0i ./D)-ʶ,ӱ[YT޳ pJm{ FDXjcXlog4>@hEbtOׄt9C->֜1F<7'/S=(p)<٫5>#՞BWT>+)?F}|j_iO"K#]m1.q&~@8t6^yWC 4*Hܖ,;ގx.ygϢtoW<Ԧy|v/?+K1X)2ԦTM/اƆc?]Xd[c: Uml@+z;kz(|n!O1o/vGzj)Ɍ*-K9,AiNiu/MV(Vdy"Z5 ea򊧸2/%X䌛3Nq3^-Eaz|*QǕGkIYxS#Tj)=q&qu>W,񆱘fdF5!.ەz ̉2gBX *|5u8{} LL[R[\"=XqQ:28۲h]>^^%5UԼ2fO^BˏśMϹ5Pa!g)YbJ t5LWcːQN$hh$/I7B8_T-MkDzZۖʹ6.ERnc|D•NlF?;XrBC^L#e)!5VJ򄠕DjhZ^,ܟyIS*;~қ ;-BYE~TF`__°\(BQx6]vS<2hU IW l}Mxu.٨[>e.`m酿W*ͫ]?(%endstream endobj 699 0 obj << /Filter /FlateDecode /Length 4780 >> stream x쐊 O71 M=*P9`nXH*ttr 98) ,0PuG{@~)Ek {@ٳ[T@v @/*ڎ#AM).錗"r# 0o#NXe g N]wGZ1 K^ow A-y.]4W4* N $$ܒK6> >AtZE(0Fx!M߲:-4矶MMHU؞JcdhJsג  cuFi& N ̀W^=/'K6u-ďׅIM1ف7)/h ѿM3 }liiAB/DuG٨ ȼPbʝ"|!,-A&#a04Qi7M'n2?B;qYHsVtNd_J #2=!iqӔ+:eN`:+îqe59o8 5a,4)Wg\:Z<3Pd"dӻTbA'ß;ϋ1՘e\p d g.72oFҒ*#96m{Cqiex]"pl7<#S46m~u"R{G[!Vd2׫ͫ<= b2s8;A()QraAMgLgc^*$FЬ H CR. گb>*ʳR\% }lIA=w/]^`%= C8s>4{A3lrU?b-x+A; Y?y <:l;Trԅ5 `bw@i l[#_erOlCd`EKOAA'rڶ-uo k²=.ZKRm5#[X[ WbQ^: )|[>`"~ٚS#x.UoEDDPh(ȗ,8 oaDUU m''T Ad}JE]9z ŗ.=?r߆Vd/]M:nY} o^ ? )UƏmx׆i_N-;8m8jëM޵a;G_]Іmfu'qnSW_lKIJpjLFoÇ6܆׫LuX&eb9='¿pdq; 1?\ G^zw}[mМ'6tm00O@̐0a" L;p1{І~aN8 k6Trbi_=ex WvŭyuV('q85M !dPElj VV_񩧛ak1O6 b\jXϹF wi;i*QWP`ڼ:kNfW ^efZGZ[1Y ra : u;FsO)d^?>fhI.<%ϛ.l+{ :4ά\+<_X.%pr\jQDu[>M0JNsW ,Jb`C ,QA} 6Jq $^NW o1abeoa(| S#.(BrBF\ W<@r{)?Nl)҆ǹO.X6rW͎")jl#"VQ*5hz ߭Ode7q0p%aJ S$$ Bp>2,SqKַ"^ 6j(u %=h:$[}#TsSUZcF=\{zάh9UO.c!&q\}fTwLHil.p:=4 \TSLD~gG! D3lK\G8wSQW'*Mg|jsvI.WQ[uQ9QA5bJ 7ĶW^cSi̍M@ۜ@7]T: g&]t(~|sxW3>=VtsSAou5&:} ]̤džz;V| ]2U:ґ[Әf'4g)xjNzeV #'fL?w0WΎnüE1UK( BJtIo&a+ lе?|2*lj WzFYBmJ-'BgyQ\TzE @y`kf,12@镆#QQO,IOJunLs|wi [٩R܉-#7'r>eXfBu?\l~&G`}f6]FZԣ3>uףW5V$;cNٛE[!%QNW- bm TdP9lcD+j8J?t䈁ǵ2۞DfG/lh(=&SԟV)<9UC\f !nxrљBY괌w. Dղ>l}Ժڼe\eC KS׻dqDEJ ֍z-/tCOV(ԣ5aPiq \`;rá꛾}>!Va.vϘ=aժkGQͣUs_'>%$7fŚr7=uBml$nEL4$bpӅVj_6g}rnpVCmm oV].(d.k$Lu&IvH%yyX 4)Ǝ Z8ܙe_ꄖ1c/Y>d~ l4~k-y|]ߩ^;[!Wc){q|'*0D t2׌j:JB}$IoϹ`?jS3]d)?G{XX58' .vcQa_$JʐnMueQmXwTouLj?1Qכ`Cvhd%|@5S]ɏrܢï &[she/M?tnf. gN@"GpQ/M}ɒeeҌgr gQ*ZY $[n;%> stream x=]o$qKhBH8;p@+N@y&wOǓο>U]=ս=˥rᚳ=5]UO(O;^N?w'6Z5zy c ߝ\Û2y;s\“1(OϯNhCy䩷~ڞߝ ʭSl xnu&FcnxcǕTa}u ںaQ>1zxi÷1j4Nruf|M(}+pYVWa`;#D":[PI] 6׫3&7jVBx엛!-  NCX@pO 5@Uïn^-izM3:=v Rzi/!|ػFa(( PdцHI=b)M0"C87}g4ަwY{F[DP^wMWVe]Kl(&nwYȾ|VqL_Lwê8s؊tl1Vj %cFv[x1}:I 2_#8B B I,F*hUiCfAҏ̢_9/,ͰΛD RJy8 +Sh{s?QZ=+\!qjpS2ZuE0I X*p?EzJyD̜i'}&Na}NtQ8Pt$rK\\;)'$36CB86$ j|H dϸ/Z)("r~@#s⑛g@H$j ̚IlsL$/lNE5Rz|@x1ĭ"-:X9ap\ 髥p/2ɴLL="S>iBcж_WMee%38])=fC[nAY͍ CA&v?f"r |P.rpt*!+^jtRHRqGzKZFY23a3P1(.#EWѪbĺ @])ߴw84zQYx<x Vbϣ̃nQ W7 "`=(Z/pz@&j7 z.ni 9lH7i{lCR'pw;mF\C,w`tM>{Rm`u jP &gR/b&L"akd4E̙53'|JM;[)9Znж*$57Ȁb[ :nZX-ȀⰮX]V:7=eHւԣ߆h ) x ˸F x:Ty|†L*4u(EIUQfIOb#LITmԑ[*[kn'N_L`aMDt6APwBp ~γcb|ՔK> < $74%.۷p}3J/l;m4DV73Mg!ĥ%s1uw] p*q歓mSs})[3 Ms:r]f'Rg'K hjh ^Y",Mma#i}x: ćvٻf-&Az4uDЫЀBe we S,;>|A"4HǗC#? PmTxޑ+?֑#'1@lqV*yi 1269%[z4[#k0W(?5'29A51B2I|]% |UWa'j$W eNmIrX R|rCu_\2dpP(?Stp9Lqi8i`YD!$Lkb\mM.) uQ%UpGO1˽+63l&.=+J|&+sr sU}< 7ܺS yC6 l)|o3f[B9Y]^U= 0(g"9CNrxyKbl@eg(g5-o~){ w=:HIŽ*}[;*"RCN&luBQpї3i:4J}nv5*}.x!6\ Yccr7ocW~3f .W+Y9 ;GyRRc0W$n)'1UJ䓃r1]H_HKI;%)E.:c3j`:yZRH<2s23{ƒRk2k$)11"O=r_'YYgb^;sޔ 4wbɉT7e8/s ?!)]^~]o˄su(2 ueh@U.<~4@>#G`E(TMV..G]X}j#xP@ {jObl1{q?vKMMqLti;/Iigzߕwe"]L]veb}}_vWO.%E>Sӳvץ ܃Cb=$o".h];cau;|A23SI׃bL/x{&˧ fD۝(a]wQ̆2̴2EDZGqƒK3}VѶyBJkN1Sit R Kzŷ;.sR_ZU?W~1~xUj}"R "'7T"'T \_z5˧ ♥?)At^e y0W-:(G,_j TĜK1Set({jR,4/fܿ;\ahκg>I,5C]:a)%JӜJ[tuдWخ01p50*0ȍYu:F-қxga.j4qwB2T|f5۱:@gR+>/Hٲh^+qv4ϰЁ3?FN56;ctT(AJ^Ǐy;3!FT[ D>OT6+3vER@hRk"*QM)dz@VA#XJ6?˅b`Vei8}+OtZj-JH: 1H<3i6ۣ96NZw!ѵ&9LL2 ^zOuذ߇+D [>Uij/H`WLR`3B+^K2R6uW>TB.{tՍ ew_ ] `}\t8Ed5.7^lVjo׹8F3s1!7H[DSۙ- ^%?&D\XպnǶ{'j\rЬPz.k10HVx9zm,`2U^*>AxJma. l?`z=BYVtfHz_fLP[u*w׆Eauå؁C{ta,t8<Sm`f|?Δ?{{9aA<,_H2mzI&z2n`ѪviIP׮1}MKp m}"_"!Xh*1[*LH*,d&`YOέ羉|SmQyV?\![h)MN,rId#~/&\\v{:n4 YOT٤h%gʿ%`x/lNq]E,V̉_6{M:vZL8]?@spE DK:)Őי@2%-[-y*>Fr6愨e9s-~qSH^)$S.wpYK;/v֒zad)zwNhϷ'l+N8J4bn΄`k*֜}$sbxAmYǙ/~Yϟo+DZbPP0.bH3ƧEf n=U#%ro+Ρu> stream x\[s7r~g#NiNg<lUŵeV݇#&yd}ٿ_1Ɯ4TR `F/_wcЫ@ϮOz>q>xv* Cm9 :.snή7;ż[tiHjsWTSodevvЇaA6;ctmz?{zPyRw0`4ttmcwKsk31.B5ֿU~jAnKF]t qI{6'N?|}z*mf\W8(0(ƞǧ3>U{c/Kſ"8oߟAnc{=ky*>ZJ[:W4&w6i7`V 3P⇝3J|r'5^gY0_MRB˟©gPAL7 O+3>΃;kqP읱} ݧ`bɚA X(̰( gxf!)NvA~SSQǞf:Ɂ2X)gC.}08?r1QS뭗: YGҰ6QSe!)QSn[𡎙hk6]05 r`T;5$1?W/>^a:5@m%eg2qp, | `z(?toĨ Qt2bTiFZ(ASyX## BC0dA; RG{}d }M$m#?`|&(Xׯp*]n=_\mQz09}sqxql-yυ5|Egr^Yq!uJwʼ~0^ ۷²*W =Nx=Ԣ'i01`rM`/re*یd '+4.訉@4G[C>z@+;ifB Z}P>YIɟU{ 3E+5G+ d9Wo^-heƽdǞW 5zZ5‹( bArbw}Θ;U$?Jhc7Mf`N+!` pX XcXRZKas! zـhZ``C0N4;c r B8e $_FpH?{ 0(S l`Rl& 4L3>pd`]U1$d&LS! VSGYpM#FiA#N,4v1*9hf|x:h2)2hzj2+I5M#s ˝<ԃ,N|wFyN#i"j)pg?ȈsmkJEB+ \)pmlNDhfF3p %8;Jhs:D<Db#(at{G#*C@:LʄIwsJ2(䞛)])9l)7kPxR3u#Q^f5߈}%aĀ vPD+K5/oin?v>`SrSbȣ{--K5gG9ZU,/b2Ԥ;}921q;2-@ٍV 0[:d*ned4+ ?6r Go1`Y6S dQQ01ϔ!J9h7`wdMRejHޣDeRm[:a&eLN~R Y'R+ٻapz&nR iiAܸ"qDRƦYr)I?^9=<zc0$De鎈9 Mky%&?P󓁚ӄo}|S=dvʶvM`<@9Tany*E!7ºVY)I.yXMeޓ)ܻ gWƮA7l ] "ۑ#K q,H)Q}%[9m]K.4&]e#G{W ŴѦbrs M1HYڭ~*0UHe)/^M ؐVO93<)(% Lb=6˟QF>3KZl#Kce#  /z_ t{T@>FIHʘĻ:\xF* dv4,ES[fva%5eT53z0h.#.͏.0< :9 * a{m>YdgZ[;*v/<|Ȗ;*RXwlꆿsYSS.ɛi3;N f=_H6L~39`F3*4r KdL0dA N5༪YqO?\AЈԏ2ѼCm.GdK_[I4u/qSSڼ]m~]yzD..|8Um3.ןb ͷ:B\"^-2{Uwй./ X^;\.e' 68:֋;3h,׽pssA ]lux}}q R.C&"ò`9K%Y>хB@(&W$n3'*6PEz0htrxH{:"YDRh fQ&d=OGQu;0]  &I2shH ] TO]iIⰚ$܄G}ق=o%1q!.s/o䌋[U!Mrl2qE}Rl8|ԅ6CG)嬈.'sV|,9<# k !&5>f7$]wUI aBwcKC6]tTȸ.b#< sPrĆȫy&ck?21aA.P \^h յbۋAI4lj~r@a0,"H~9N ;"9,'M -QosllD 9r-GI̢*}W5!ҾqcRҼ q&'Ғtz2|RUl c $ϴ\eׂTe[tklS#SbK7zoB ștӈDOu kG]h r+4)Ƌ#C%N sroj6+J'S &NSP iSӃGl!9̷"!ϜVS#9,R->,c8: cCVR+8!S8Rۏ W -8C,tTIAj<"R*1hzcjCT;=K pؗo5$NzZcqSlcs&7?6.4bX>gj!+Vl{t)okz:'Iiǚirc#osn픷$mȒiSmєmiO,v@q}%r Ʃ -7iWV23u_Hü%hX.q).P̑?"_bW~Ai+W%Opfg1a-\ 8mUPeMaRd3TE VňcSoE&K`VN1Ad wQ9P B_G(5ӛ&6 /+3.`sS.,WP_k$9\|'6>+V?݄͡h/^ Q(IE9Ӏ D'pK?a p*sk0)˅eEdL7z!! bW:2 LzL~Z|u4],$Bq8 -Sغq/3Ou75ɎC'e\ё#,HVKt0p8Z;һb M9AlF@I{hok7H$ܺ2|?駭sٲ5̨9jƗ},șЅbbvDͮkMs(ZΛ$ XiE ~keOKĐǏG/1hKn?M#5$G. |2v?Ϝ!\'΋s-{ wvBG:z)zrx)9i8DI+orR-T5})`x\ ޟa 6wcXi7#g\˕K>邷7]ӖU)g)Ɉ{+ # N1å:eˬQz[ֲzGyAȳ5xL?%ǫ%O^-95bgF VZ:̉/Q4m[ 1̿eXJ85; ih ֔ Oe~iyCVJ8Y"i$glf4 z \\MN4X9q=e(ӄ'!0>0^2>kҠ lT&w@HA.Vs@PYGP}e`b7KY):#p+ 5@DUMP= JS\S}}+?p uߋOӰ4zhMI0?R bO$u>qsHO KrsS̖_;N ʜ7cAMٮ UxopL&y:+x+95TU0@n8MƐluRR,.kn)|?4l<}yz-7r"X0e7+H]-7ԷuC)d2:> stream x[[o9v~WF^RkyI ^dǣd<-ɲw$Dzfa5˭LE~aW~^_U0Nj/hFF00FL:|w&nS&~%rs"# 71jt^Sj#lx=owbT1>m4c Z i7 hc~Cd҇,FX mx:p0ӉDt c. .hpi0w"j H!~Ǯ뇄W@y;T*z$-uDp_'ڼ(iחXoXܨFјQǛ ɉBm~|Ȳ?Bqu+x*0rrcզxhB_ݐގe}x(|#7;9Z>kZךhl77xhG`BaU~ß8zxyݼzVAi5ۼzöQ)%@5jĎinJ{Ugh@N#L̐ٴr uÜ=S&(F4P`yPu@τXÁHL2A0r($8 aԪm3ML[PRq <(QD%B3MY16rt3HX "%3gԣ8^O^C홌9鸴WvM'Ba9zT!:J &9z(~EK8vSdnӈ^/J0k@dl V~Ԉ.\B"ZB1` x8ȭUUċQ}7PԵ(#uD#=wPD'ǰh>aroS(`u1qV X8FO+Purb+ĝQG"I=ɡClq'S龜J/iU l "jT*'SEG Lk&~S\'|D%&<xIj.9M}mƒ14I}q""H͋`$/C*wE!AS!046-9|^~AŀSATjzȼќpz4e= y" m}bldzqiBQi)k$铦pٰV,3a&N% >.'zlg};XZH3쯪mwz_CiE֙r3S|6sëdZvXԈ,*@[ч?28BOH\,*zs=Yf8tD.cCƢ;?v^/L4m\9Z@n-e0`ֳuk-Eӂ B hGl:Ý 3V+I9Iu3_Cwס]JIQK0S *aLdwm-UZT̡bج6宭)הf}1=V$Qg& ʃM\ &;{d\2~zpp6ݞEn)ؙw-[r-V" ɞ}H,mdGNeZ | }Mo^(\o's.j3_!QS)asTQ $MZ*I}Xwuf-=m9*(h ¤jîDX U>p#\C]Mti$NAPr$KTZN Aw)}8tKF26(&3D2 4[3H&L2s.$]`F6\\z$HD2{1 S$S]24쑬GtnO>'PNG !⧖i;Θ*/ywƘU%qOODՅ;yץ['(Cl{YP D_ զyՁ)ͧ V$o>OSss@s^eㇺlC H*dG實 4esMzBa̲r:;"R[n|L);R5W2,W-Yd5h0=}X&E:Vn҂[^lsBzR*T _8ڳ3P*)S|d`p Mjޤ8;{H]]a0L4oFKV2_Q' T1JL=pac!ת%"@V%$]2iȕTCgҚ9Ri&+e1FjŦCfoє3KjraBZҞkٮR@/8[u7y^)Wda?o1XE1:nzج`ʹqc}K:C4׷S|46#JňŦ۸]8B?s1ڬ綾s ~rHTdP鳛jp2nX-7ݯM ]D1 bjZ%6qFò}͠LHl+e,6M= jGO5a*L1a1yf'eNo'Qf hq(wGUn 3\N }})ZG)'>GȎ'^T@Ow+=Lz,V|\zV7mjӡNkIx* jwkmE kHi!nL T|H}>xC1<צ ĊKaPN~79Yz1#JzTZ˪Hi&u.  Us縢%ѹ',@h\-宿 zkP*.})ӂ{׉^= p<&2wUľɋCїcH'd偆ygwCMƏ H$,u5G*QfKyS"]m!&vv1뾜Gk>,4m$~4&M =C d *6ɠ +]}]4w^>(,&_ow!_Ѭ)f5ݞ[}v(PӼ{()Zz6Vhߝ|f,G5!Rn07@NzUhHKsg8L+KZҖ#Be!deUet^uY<{)|{?{*endstream endobj 703 0 obj << /Filter /FlateDecode /Length 5611 >> stream x][su~S |Iiz4vSުQMFDKr$Q7HI9b{q9T Tv ?:1ިaԾLm<=/^r ^xyIP:y:i9}yuQjx{):ϛN {5wz|ڊI5Nfލn[9GOӤ必a4ՠYv83齜pMhaĴ9Ͻm>oyѹ3*5u-v7jl~&!5quA 1 `?^ijݦp7ΎZG*͓1GjR+bhׅ6CݍjQ4Gu㠄4DLK]-z23팔ywŽ(+'Kf|qJSLkټn"?A˓8iNp!ZIz58f`?!ktHd-~Has]hh|v*) M7W0>O87{E''?f؞G0[l]rZU`SyV\LD[%ڼ#;DH%-kq0ګes*S O4-#R#^! ٷfq-nfFX>n: poa2V{f^%:d؆сL?+Z/=e3CɇG2I>ŧ^*B 1κi=_hڠ{?v鎄<Ëjd_%O,e @%lKeQ 8izSm;պ)l")7Mv#H},Rғ8RA[lRbMl r %$Ldyߣ>,I(fWhD scY!9W7/#^d8Hv;Xdf/F2+9$UR8瑶ǚZYtnҰ ~pNuF3m m$)BA/P7[ۆ섲v+mvnn&d:IfWwz{p0xȓ"h搑(\2r+پoUFiajyIN3^z̤p/o3xMCĪ-_W4E7$; wrrθn4?5#ch`%朾' MC|u.|#2F, .y#d[Y7* 2)"${pȖI[<&[3s2J ЉgJ` vE3mѥGzd%D[є]?g! ]1[xP _[&s'Y?kC+f y D[XR9_Bc*- =+!s%6Л߾Q-IǦ!2rk-j%oe۰%RI$oցcCrtzǻKb C&Ӵ/dzǛm[9U Wg9RPJ|0Ep (M\>e,߯{R:9=źF4hy`imK), qt8+W]KcEaYpT҇LMdFz MG2ps0p>d[p|GtP[EB 9:<1uXX OjͦYAއ_ԥH/w# G㍔0wX`_`Cf#j3 =kg2kRNdžVZ݀j{2i3pRI±9j27M29A>7WJ FӬV _<,Cp >\}j32{>Vϸɓqߩ5*g:W$;z0rF2u䪪DCqѣvELU:TRv9q^-zޖzo M%jX9n3xJdUVMtMm)C} 7+ ki{]&UDN[Q-!@d*Ҟ0ooW+Յ'XX?.U:G VcB/SFa)ZQcĚΕureR ܙSb-'j`yOD8\t6^:$ y:SʟN^S xGִzVB[nvZ@W M'U0-{\ HxX;i!z73eX} O5ua\}a6l \I>4@pgUEÃAzq{LB~,'!!$ejJ+}v|w~gx<~u:JyB~[ɕzHO'U8.K T+ 5O?5bISPxOiP)dl'FIUT#'\Idwk~9*U9zcimݓ8j*VūY͆PÏwngF][\!AeS  tNZ&.$y\C8+*UK p˓<&jryu!+LL6J (oXXloI&SqoFht nA[| ?e}q[#ri*X/6R8ŭ,U2,o;kqStZN"#i1 搛s:7,b-ֺ2?; GˣsV`(Ô;23\PkD)؜qofg_U!9E*WYlѳyp֌Eq{,n\fQ sX;VA%\:3E$(G gvHoOyΣ 9kP#E 2I"5\B֩ T%qn*^Wa{Gk.kV ( Ih4Ild>mEcr4rCI]6J9Ob{Z!F.᳕mF}iLV!zp:>=f6)R1d_ > [\+Kk:.v,r,mbyKHuy -ǀTdCS8G˨,/2݊eMI174L‘=&1IXqL\:yA #M@ \R{_z~ !"J[\&@9Adԛ؟\ONc"kEhuGay$$H[KH].e4@E7G^oV99 ,6w7IisiddKm",ǛF0($8г qqU:`1GsQ5mѐ˽;i5]g QAf\rDA.iB7(szFErϬ(ͮ%;ORa:3ܤ|8lF?Χtb,܎Uho4{) qXq\uj1KJGߠZ)H'_ėE|+dZi$caF* `E]3O5g墯1Y]$|%|L(ZMNQ}eu{ qlE+`Q++&ŕ"Z( fK3-RMc!: Jt+/ܘfC^pIaoN>;E̳t» vyb@}*(]a\>:spIo<c|qތա2_ '4KaS< pǖ $smGIٜ~<d؄` ;g)Ƚ:2SW^hE86d ūvE^m j t8R{S9_3WivA1\#cB 4BfİF&#miF0LХH]ebct\*ڵ}0j0ӲUKDf4"vΤ<2K 6F p~ު"̀.4*X*|BA$/b{! R'D ٸ\F'&c>{0knh梔"2|G W&Bs^Clw@"JB;W?uN`*hW;wTu2@ hPV6{"r2p7۩%(V[|i7Khtw|Wn8]M]LC(lb_YQ7i,/N6\R#UM c,iL+ڊK|,]螓gtHU|cʶyy}*w>Hfijt, ΏyPH70{n~pӗ"-N6~+|xyn Aх@5mDB/"2ʔ2jp)0vLikNC_ck Y<ƾ!qs*-u)M4n9 Γ`jU !P1CT<(̰2A8(iw]2ԱB QWD&IytJ rY+ebr(XLL  ԐVyC5ҫRmendstream endobj 704 0 obj << /Filter /FlateDecode /Length 161 >> stream x]O10 . 2D! }I.|D/J`H_#49ua:X8 d z&T.z75O$ڪZk;Al#0éTW\.Xyp8I.~r 6/ISendstream endobj 705 0 obj << /Filter /FlateDecode /Length 4763 >> stream x\r$G}="lc&0jVYdVUwedh}VUɓYn!z}\|wޜhU_`d#|䯋+2\,>;EQD88E o}]9Y*Kߺ7˕U!%E w7K?uv){!V;jc^wC17b2F z1 ߝWk!tggNAחPTRhd&hcYV} BsBj,H!zEUƯkARBwqh&8mL^2kSÿ&Yl=tXojV_i{VLAyo'@;>p^hC^u㊤1)aǯib[oaiEp]ԣ{`[5ga|TttՃ^^l +)(`^'3io0!Cvtq,2 U{߷a;VjxR9/jWyݷ]"7O)Yoe%XL.A*kBm[fm_=&G p;ӻzE2&=t Z.,m PYqpTGKD֮RI`r2fJ;8 &l}Tˠa[ཤo.$]a#- nwQvs#w5V&& F_֓M9//* tBhmy#IoDPhѡ # pP'1rM-r)پH%@x0RjnGKBH&{~;)}c}"Hqɿ = Ve:ghpYC'o'RYu]_R@2&<=8nv?PѨ(e=R{h I; hҰLp)"7leddכ$sN׬"8:&#'iiO<@h6aiýN+T &ߟ $:cb* ק- "ɠx=Tp/UJu-&O\wxYTkU}',8M%D D'l4J{pT!aj`_V8DR}KvIY܄yND"úp\[A= _8RDo߲ h'vL笱9_jӰ AHuq:#IEqWco+6vR1&"|Hÿ  >w0rh{ci& %֤ aXd&ɃF7#"MF4ck$F55G0)c{͠)%B0n@wIZa}2 2ϭ8Z i-٥\ngp3_FyjxwlYJ k&L3kLhGSS{k,Ke ͜i6M+Q4.%m@d"D*{Hl.rJ=dMK:Zp@y2K"0b`ݰAr)9|>!NLSB%0;6&_Ye\鹃1|q_|*gqsI]hTڍKB) ]Q%G~'=!3]FK?MP BI>8oFnBS(JZG^Zb =sr C, ѷHg2zBrAX&Fj״u?jlr =@27y-0g=nsCUӹcJM8VelS+ێyic%;~YSl-v_ w.Hيl]vvX$Dݟƨ`mfbahh sdl>,Y&In$-oe_v`26Aӗ)?zcrCc,LᮔCǃmPgBP5y7"[φ$blGCL)N(@}WQKb~V@Fgn6W`?h#xuši<ѶqȲ}zr$`߳Tƙ񑈫<zd4K hNMߥNmp43̝>& ͰC/ǴQKL+P?^ϕ9ijmv]egrƄ3I8fdޮh9x &O7p0=_zLoKYmIFP >9l6|im *(R17ۄ%= \}!'/F%Ƒ}5F/H hg۷4Xݚ8nfBI}:ݫgYsMpAt/FxzΪYS5* y4ը {W90)l;#u6JYI~&GZAͼWdps šN{QA^x'Q?a+<1؃KH~ҖgZe-QbM:[{rk#5.iݼƻ*8\3#~w59.{]jMR)g^r5.^zj?3Ds[C-V·})gBDt}q-Ӽ¼8gIoMnR)M_/sɈ)i~ 92_\7*%q垇;ħ@b=jB?.GBQlwè_Dzx8do>{θ: g+Z$Ȼϙwus- ی <%C/%#C-Dx~c: {O4( W<Ӑn+iK_vh9Ka0B.l,YOMfM3\EɃiWү {GF94עXnOXѺ]_++3<+\mFZnVtd>-Ce7560-Y֖Cr!d)RQ|02̃Xpd:#Z41fቐIp`C&[2 L2ݮ@&`Y9ӑq97FFœs&< d#8TSp9?vZ|*"Ii"sVx*N F&OVC Xy-M떗X G{tp$JH-pj9\e*l3pc6i}t A"(6(-ygO,D:7bH<1c`+F87332yX ZGLV:eϩ'WƧ,E~ٓ{mfD&+YɃJ;LV7oIzPwἴ$]D!J^> A:2Uwc癔%p m^=ҧAj@jX[AJs})J)endstream endobj 706 0 obj << /Filter /FlateDecode /Length 5646 >> stream x]˒qݏsO]e2EDxic@0 %}OVWVe?Ź3$ }tΪُ̪oNj'E_?$wz+^vr:ok 74gWWɘ<[N9[zk55v$lQsTʥP\6izqw}chAK:P Z7mMRfF+mNևi{8+wy)v'Dt~ӵ8kw&I8@thWO~O@&93d?_݌tH'g uNq9{=%7 K7J)xT~FX'/O_g!q1QKgc%IEFHRs"$lN6Mw&^Mr" Uv8{s}#<F_̜'-klzg24$p;*Zcz0lH vH;, O9ڟb z> ?V\&eGchja[}8uջOO}p(LB>C [Zm:?,(# 8qGvt813~v8rs9PKF 8LTy3 b|4`#X' `qvL3r!`:W&S6ݬd&Bw\B!R!cdDr3ixuN6e;Бڮ"2 .D0]ݜ1YOW'Ѩӟ`ۇMdSj.Іz3+Ɂ.vKL p֐Os4R}v_z:69B8 6sLKYi!ْZtUk#hCGXG*= B~>XjI D֢Q< !|#O>uxχ鎄-LXN:a4HF[n`Mu ?]s#@E1.UY*.}{{=Skd/JԗIJ 'ZBj!.F"YRÖ-FFHlƼ$IEFH+ATd$kP뾢lp;Wv}+;4}fܳ]!zc]mc<>u~nsj~LnA[%kei*S(NDB-QЪR -D@ijh7gͼ,V$Ҳ>%M,ߪ&D(`{ `˭,,FNI/y1'iJN* FHjR02@RS$  a|Ωv 4 adfn #$5+H bAI) F'ٺ@.)rUr+Z]N1SSjw}RZ˔uo]٠]Mmҵ:B<)kQvw(xUΛf-.>XțD N x5㥨_I.ULcw:eFŽ耍UWZXAQAF巇 8nȨks:V8wH@AFg w9lG-|ԏ8AT(Had{ήt02B0 IEFHbJO"#$9x("#E:,Ud YU3NLϦMt]9_/7X$ HZeYzY!Me̪T^cV)]23:jv‰O/>zt< ׼xc ,ٵ1IM FHjbU02@Rs$ Ԍ a|NQI+ FHj*Z02@Rׂ$ lM +9,Pn`+0Fzm !9>R"ׄlH5!Z}bCH\̝),ՄIKՄ ̪&dMcU.VԄlrU$jd \NM=+SR3Q+TmP9Gfߗ@/$A< }YP!@`Ya vB]%J "4Td),12BQVV!Iޒ T<ˢ_EFHʰa\l A.dhƥ{)ۘd\ML[_p VkJbV[g2^]Fo+uoXqR|I =IC_rT02@R$ t ad #pָ4d& #$57-H lAÌ FHj\0r>rIyƵg?Z[g\YUXʳ>@ rꌴ ^|@,ڝƹpX- KfY 1´(,uмCy:ű4^]偷VV>:a)#^jI.UkCqR{s_^q(o/q?p Pa9:*jq78C6Yy0q% R:x KT zu#(`¶[ԦSKER:u{.12@b™ˍǂ"#$&/Bcddf}6NY{h\SHO {𜢔L\OyzC9#x7|(OmNн-mRqHgI WݖO W_g!Қw- awjf<}bK5[}q 6,/+^']V;ҁZuLӗKo!C>/*Su45@ 6/Z"nbLӐk|v}m1=Q':Vs'(5- EXS>rxw##GUgNL!X)G.3&v̵X7?o'Ai9%_8s*"b8PۚǩHܴ?[,t=|<^urz\OV/Hqv3}'MlȻeD] xIty9ԁ0:e6eS.cmDhclnTqRkݑ2NZD՘׾-I7]|r:*:kr ɚewb-Н!\>SwMK+(Xh^GXy^3buΛ..{qnYw@X{ψ ~4qk/ޒ[5bWip\N/wцU@#o÷w[@Lsţb#ɦ-`tvE{X߈)ee/9?>œ)WŬYQ|f\v0uv_Ѩ2%b*cޘ^Oj=xyL}P٥{/> stream x]O10 . 2D! }I.|D/J`H_#49ua:X8 d z&TJUZF'mUu 6T+h.,S\ HJ$pLg9NLSendstream endobj 708 0 obj << /Filter /FlateDecode /Length 7450 >> stream x]msHq.#KU *ua̭,ʯfmK \Qiz_ߞ%yOn.|f~?ߓi7ݼ =/o6?y:8@޼pc갉>7_ny*c~w$~wSK7@mr٤rg'_wJo=~JE]h2heCھ%ma[sSό_K5/M'l^3 2Cm^\_lM|񇋟5koJ?o.\~rHT3HYJ3V.=ş6z(M[ A 1}2] ۑMYYi; 9v$D=E6u"İٹ=Z7T*14SXyDy~O`&gdR:Id@[1,S-6ܙh,2K%2߲땷h(= eq_nW4Pͳo|=޾ڼ}yu<|u)6FV'yZv*Ӷ9w*ySƣO֓TB؁ØTNOud9ٰ:sa4*.qEz$ιS{c|rnY*4*NH en<ǣeR\U)h ǚʶh`ۢKP0IhDY <\kHmрG0v6mt乶x CwkVx :`k^22x mvYGƷ,"Xc ,[QOebXm'ёG0 'N=< q`:@D.> NJ~$yPǰOo~_^ 4Wm])w @@ȽOae AZpN (B$B9xirlE.fV0.Si{8*ip|+GzThy#13r+c,aU82_3̄Ep E$ 8-Zk\g~>Ǽ+|Y4҈HlR0AMO_ "D C#/ta s4D]Ǚ*,J8Q1%g!xbdgUVәbU1-Cgg4ߞGo{]+jTb_49: Jm'h/jvXx^ c:{q&FCGYJ23Jaq~I_=.4Ww})dСXc/ قL7U^h•1@j1UΕGjy9oBXZ״}\^Vd/+~~OQ9| `ooK NvAn{O(Gy6Q· tqvma q?ѽ\󙠂\-WEZ:LPX9wzȫ$n0@)7s{mNpPr"fARD .łK3,#h{u7Ӹ i/^r+bzӂdL_2L0_n_J0ѝ$3L2a@bOm:8'6TCL%=S$y{h ۫c)rvBE>eSVPHp|-wQ ?Nk JFS pmO}^_ û/wt%&],6k)ǡPn/b|/w^1 /]̌ LWVqjGc.<ڛi&b]9G Ω0/Mɖ*2]j˗@nck=v6)jHiB-򏌹p䏄?ͨ+U-^v{U2hb˔oXWdnC#f*k=AIe>d\R+3k!'= 8(3bmJ"+Mf=.}eXi!4*G}Ss;v֤ۛBpR.14wl# suJ'WKXY,a|e#ǎ2\&?fEȳdcYj38r7}f s}xyvxYs_2rSR=XҠ2 ~uj /S+j~J8=@!fGC`O}2 -D`QRA\ddH LAA$]ԡUʅ <q)Jh5b,/qڳlg8!>eadXazN¢y1 /U6R/K 2fKJdƌ~2fJnZ#JiatVYl Ywm*ܻF~EE:/_44ܡ_Zt " `x;8*o$1g.@`fyoWX7#4چ {}yn cThTJjz`ь@s)-3x(z:7zLWz^wzp888˺8ۻ8Ƌ8׋8 xK K0kDF-kdF?kFQkFckĶFukFkFg"чўzx{H}׈LV`م5f)Lƚ8Y&kfe;3Y5t&cfdԚ:Z2aklͨY3%{fdLM~ϱ>{n7ޯa#X@9Z*tjՑ ;q/M;2z ,h ^!(fwo`/w]nwZ /dVy~oyXF@0`gؾAs2`c$ e) w#Av, k'fqzvN@u5lfݔ>|~PqÊf͎*[7>±gx<*q.`GDvO,f v[?V7h;p,pyY >dG0xO\= ;2vs*$T}/Rr_dG+]wWo.$pZ~dq>"?Ei&ʏzoѧ]&ѨL#5 Zy;#'zJo5կV~7+M_鍦VɊrKR'Hɦ0 eO{(@ZVZC }p` YdZPOMs2m7-Ct))ٚTz5z&5Z& &iû6e>0xqvcȗچk%aH„[$yjhis[Xpn5=w"չL  -D@X)(2)L6PaEEWl(k:"+NRB ـ߄r ~[#JGۻ#jaeҝ2H='`m#J˰BBN QգR0wZҫ6*]zjAxJ8Hi˷7G8^2XvHX(OO!eW4=3R6C 庨4, |ѷ=u6܉Y`Ϯº_l7㔢"{gqҤy] ~}Cش\&g,=tRMޠ2R6đ|JԬer #-Zf̦TrgѲk6Y8o6+#):|~y>hz:fgtVR-sf,;LcP(#W#zNW2(K*H&nB$/ BO\O7(Dz~+ա0UK!~5NjӴK/)%_團Di՝#mjK[ ?a`7;LeBbl ݢQ; Dv/Lc ԎYhJO4j#%;%ioGrTk1;NhWhʵ6[O U|GW>}*7Z:yX'n7]7>JXNh'r^Zy^NO\ |pRF+',ʋg9淸n֌H3ϯC͐⺿mw;wdb "XyY6= "Fs3Bk]{uErWuƠ=^#j{ITlN^5dg]zvgy_̍+/ ¤[>3,c}>ןF^; 2޶{L," ģ'6V_اw@hw~:ys:[OWlCX}YQendstream endobj 709 0 obj << /Filter /FlateDecode /Length 9257 >> stream x][\q~'aƞI/I l"? K:\IO}U}Ϝ.%: @0|XS]}Ksv_py /b=ߍl9T/_޴T/_\zGBM؞H,ӛ/wW{spvlj yu> }->Õ=S۽4֚=Mpb!C3^\vi`ɻe+LK=S3"S_ѣƧhn޻C-q[ քqsGdSv{_ ~XK0%KӿVD&M;@[Ov|L _>E@/DAɏ76ɞ63E 9-OBk' y?Ԙ!T_~+Z{W ޽+Y2cXH _m(o.vߋ51?DB;bLaWP=!{`h̟/*xx+>bzl:!;ٱRXUIfsX`9ᚮQX+Z5 #LqUa2Ydr>"l2A;K`Oj )윹fx 1*&"O6@6d[^$Oh=i 9?` DE@`y%66W670--S [D (b]߃vF %cЊXf@B ,$>uJi-$cZ .x4(6 10,P (7 ײ r03i*K, D @c@ :BxX.LoY>!M|aUq4މBya#a !b=쌁q SR p/ǀ d-ӄd4y}" e, L4^9+w? Hl!i#%x!h:p~fpkgVm$) qdKD>BxdRds#eOCI*$_Bh[,R ٰH{G?C E$gyʿ.c'+$6PdCTc5 .Ph'WD?NP;Oda$IygH-ҥbp [*V2*TSf$Tf=Qmv6>Lk|lym.1s %`)Je)1Kh-,)>)O!80/  mK9XΐG>JK$n)/w?[ ]ٽS{&(8c\+R*"Д! \LY@ NNvf֧[tD5 cB-'-Z>y=i*!QM{=%O'PyceYh%4Gjg8F5Mx >w[I4CdL\ HEU!rcBl4 \fBvn(d#HBٛ I)!BrIiŁ4F s,Q&H)lHɟk$\(*(sN eԪv$[y"yBFFdHw(j3)f k#'ްm cqgTڹ EpP{8C LY~̞e/R"H`+qѓfSZ,b-U5)\8`l/R!rD_+؇i&!LO"]CHfpEs$N2Fv!$[!(^'HQi8Y(L Ov IR 8K̀0=8h8ǡ\R|`G3RgHaH%;P u' i^'.d0jA?hÀALU*툃!LB-+|vt: P8Ȑ+HUoAZ\H}Ø-NLsBO-Rt r`0$qSN+ x(n Nf~@-*kX'm =Y>{z*aޚrEX􇥗![]̣xlAu_,SjŒ=[[{q]Uhp惾{{؁u`9{Od=︑dg-5p %iU)l ( RkKgoQCVx 0:Uxtbd~ s4]1_U6&.] @ p]1S\^n j5;E3K}] 8Y =štwb ຜ2?#D1K\y8E:;!7pL.Ն"6Waw2,4[rݙ!hӍvT Eb=1 +2= z"< ([g(o}z=Jd򞎨z=b.qdJ6zDJauk8F#1jI<\$^GdU)~!;AI+]KQ[<{Fv#aoh\Ĭ#60xMvǢM=׹`sxplz7Z)Yw߾WoJoH[yϽ]=ȽI;)(e#n'Z="j~`*2:͔W+sU{b2K+&bbћ%S.iclnlVbX`X/WZ-.Ƚ2)d2i8>4MK;O ٓL,q{rR=_Րߏ+.+(D_J79Xv[{.Vhadٮ>kaUܐzq>z X\Tp۫{#BQ\p"iUrj8,FG L[{23'/|dVϾ(9 $aвgWz5[Ø@b嘄"JrAѧ<"*Ha̾.݃:ْV2dG'qkLlƑq[kz\.*j3ܨXWwkOO7FuG C:Vn|CCG'9%W=i t@kjy2ڷCP6Bqxk?[pMܗx9_-Z<*vT>G&e56#T+lWߋG5³=|loOl`x_tMP;i\o_lnMYWLW{^֑<<⶧c^Mn0%of7asj8AyDlSGlq-QJ6EFFKQQyVz {^Sa0Ik :YZmt,$zʔy:AԔ"4 b6^H1_c i<lpB^mU<& D I~^{H[lYZ,>G'=%sU/.O ZDqzj) d1t ˡ|r@Lr㏼r{Tmui.݂(?*vzEo@`k c! \U}rp2g-5_G^dzjէ>n$9ʼ[~7UgJؘ$eoFewjj8A7U+:]W\W-eG,[73lPqExoWx&٘9'%<1݊JI(2UddٜkĄ(K^~m FѾĚn.E1h"cNe?^TGh>aK>}\%K5M?,z% m}'~v$#QKdl`a=65?=N1N-}[☊U_$3–ʨ+6'D[=j U"0E3_jkjȋIࣃ5'Ŭq߳I1KkOR}T7$|ŦS/Ft>umB!ugќ6K{2jm Gӝ"bl_ ygnu$02Jlv4 D,ͭ$gI4=m%LomxP4taG_SOлo5-!쬑6S{at֧s[+Zx{rUS CIՖT:`xhwݭj۾^zO5=@jt%^zJVGڴKĭ:~g"irغ?*L =gcqG_G){u|9qSe.l/%YcJ-0!pI^!Ԋ)Sˁ_\_y>UIOK\"ӧ?o+KeFKdnץkSM@>[Ѫmisа[E qe_9gW]fG (yǪ:@,'}u5SzU#‘ocYF@ۏ[M0 q, l9r$s& KR׌}"k3<݉juQ`/G>By<<{ |˯N\7:;?xvǦ=p虘>3a_suendstream endobj 710 0 obj << /Filter /FlateDecode /Length 5723 >> stream xt_~n p_.bEw52[{z쿾_-О8T X}#ftXt'$v孴L>M#"q@p&gz\CYk[Tm_b^uW|ߒa%RϚJ{Cje4cTEC%h )$\F.ZBCTD{n# j~.բL&|,G jZ.  !hFlSPIRyx_+{նoQ@4y\TJ*w /aTBd lIݦ(*[:xXy;xȤ4d0@|D&Q-;&>p $JOy^e3&ݰ庰%o7J\%aRf˯j%儾̗VYh%)&+tO!l}|Vy!@ź⤍"ys*wXt08:s\J2JbfRdAӀ{taCx(^\0Q*FxT3 "xoZF]qfn>TZن_OeL,;Į n]dOwJ(]VQA>k_ʯ(k>*i l ҋ!sz_biecO<CbK*Qn"]1T썎G2nP@Ф>S>ِcYsuR#Q pH3Pz'?5mZP%uh&Cđ,4Bݰ6QYOJ a~ 5r, rƼ ;_8 %vUra0M2)FFEC_[٥h1s$T[g0xʯšJ& qن6*0G}|))P-FIbB8ɱ8IĵD nۃ\LMU|;!ND0)'nz:2y,UWc–`*QWUUL䢮>q*v/%Y[<$$ҭPd]ܓK)9" 5 mcr=P:͋#4XD{h* C Z2#͸Ȍif@4}MPx1{9̪|d}]r%_Ge B[ki{!79]U;*NRDŽ2hQt x&\0,@ІE2u8Kⶖ])>MSN}(##cPG{. bXsb z3Բhf@Fuhp8Gh)Ud @Xz8Տ #~>L8tPW?@I(b`z_Xe'BW4If&oj$ResqU<(utDr ܜAJS\$C#_ERsoG<X!5 00_a*1OMTFtWgAqX9a zg#U#MX1$S uRWا]/+()*T8R&͒+F]( R4bݑ. OnK1ZVJ}>;YҘ(-ʃUUMz S YYX򵆯SX:bQ{ŀ"z*rTXGz;|& )xnaϐ\>PN= cȥ^8yO!JJ9Ж*l?xKLTtj׹g5K|U""1w]-U`8U)xENIAºlZ祽̱#§, rXe5bw ?E먟AmEٰ\V8pan&`Isi5Vm']l؋cj$w키A&x-{ ΉE d ۚ,x;x 'u}dJcHt_bLDFKR]JX E|bhKuӅ QDER" ؄ usLZ‹ksb^I J%3Ĥxe! nԎ~)|b9@~ϳar:;UŌMN e<^nw%ncUΥ.2(ewLLҘS iyyoR'Oi$"+x9}t{"\ `ݗwJ֚ojq x F1˂=fդ)Gr>8C?b!0N`96ݪ~qsRcS(<5liQ:$z(=ŽޞžV 太e#9JQ}iJ L¬[1뽑){㤒r]%LtRDm39zW@$ ^P$X%*.:]1Mڶiu |W@{vt}l_'NJ1k V(.EmIy*/5/dʅeL6QZE,9^m%n"GҢ.kw!p$# GqFvWZkVjUۧhԝO8]sF?yJS^d%<+ B8Ug *Xl4w T4qݲ+P'6|#5o1U ! R,ٛr'NׅM;#3R%xwv֐=uJǔ%}y?1uRl++DQ+=ʂIX ZYI g;PcU$ڝ7[JfA9U>v4Yuv7׺Z N7 U9Knj%L۶7" FS)aI_XZC%HOUo$+ ݫ ārDB?NtS)qKw k_oa%ZD6ԥ|#]-Wϝ%/нH>?sy򅽗eCE4 U4/O ڌ}>My_n'ɮɪ> stream x[[o$~Gcu~I xb!3FhHj[=w;$<֌,m0f~sXFr#_{qw7lg?ݙVa|[0FL6p=&L{nʟӾ3cQnߟ&ȍ~n?`t[Abgw۝U!"㇏[1u ںaQfmޫ9c1FF?lw1 d҇aSmqK v2Q$S8C%vaH;ANk5`s^6i)avoӁ_ -}8Ӷzmd)tƧQGqz|;M;{~Wף,DyF=:q;Ox j|)ѿ(VH J9jpɪ_o\No~*;\m%=+~Ʒr,2  &n L)A9x'ɨ'y:{ʲ/7ݨVL|WwvlvuVyG2W9NjV)TUe[Uhe5jCJXH6vZlwJi3*cG,V?maixz'8/zR3}Oo^ELy-ըH.)8Dhh~}3e[{,6Isa/GG{l4wGw{lzP2>Ϭj3VU!u{δUZAvN3lՂ NW[t8C~:;5,n)@6yvgG!+KU!N-m:X@ C #|\6g-ΗF ` ĐpzR]!>4A֫9"Et' 870]4 W>@qH.f , Zwn`AM8r fv vJg`N|}Gg\2 a sif `%Ku$}*I=$ycqXZ=6z|l2_lHsIaa)jHʈb@n J"+u#E(]=׏xj@xHH9T0MěJ#rAA9yRHJj-1D;?FuNҺ"0(5|k5W&QR%xūT@D~ݙxՊw@ˍ6t`e#NX^}hTR㲸;i4q_L)"A-Nm ȝ&X!!`f0hJ bz cC)ۈ)5\ !O9< p*Ԏ>^:"edZ}uXCgߴKOFK4}o4yȰt`S:u91e&,G1KMM}v vy!o_X3KR!>n}JΉ' h@SrKF#h7C->keY6A[l& S0KZͳ{/@`s}i.V?xܰYUu,w3)|2Ez҄ | Ϩzg9Gvĝ@[wuzŽ:҉c/?*oh }ViE;Cx{WmvqOz0*bO‚WkGW׳%DxwѥgS%E+P:b=GK 6WRWz[CXZ U&2Z!mEDKѺzΧ@˙/Yo{aݺ'` j;S"-4vEN!JU*U܌$]~\V%(c$pw{秊R݅!P @u:7{ةg\X mN)d=,wC{2QڠVK^S0R6޻WUQo]2*sKzץ$)k;T2]Ee9DuX_ԟxDFxL5s@;*EȬТ%wˇj}e"zl@ 5\~Mgx{_ZHMor~Ĕp"IaofY}y*Qs2~/AKBtpI}\å #oȋW B=ӻ.)No*-6OR4Jn\P`&Ly@Q%֮GwVX{Rq@KhU]As \[!KhtP|%HuQ,ܰ T|~yl) zxVhs/* *Ԏ؉=f[\)OmZT7Ի)Jc-ɵpU"(HuөT˂ }M * ]S5Y}jƁ]nRz(0LvAxRLM'`;['lC<[\ikg1cUnܾ ƨ'fyPM}K8X4=D1: D|A^3D'ab)u >mClC*+Qz{LR61nn?n ^S9u#5^Q-ZsOEw%Y# Hv3pH"8- l2\ A2wK0#/HsWm9oO6Tn &x0Þ cϾԗڨkvʒtې*d'./%iS챓Eiv!&wWX|&Os>zΫZ;ᆛυQO5tELuϯѴ9鯷)) >/&Ap|.q*BycQzu,Є]UXwf_Ь h,a{: $ī]~Y|>pȦ#%+uDP7][!Փ BU}m#$^dWjnz,1/IƖ䏯ulbB)],5NP Q(]p2S])$3Iξ \[,w:T쒡xG4&53"Ct),JxtUA&IQX8wpO0IE3Ҧ &uazhK%TX{S~n5/yϋ-"ī[iZHM9xTf:ү]0I\ԅ '^s,gDR vRt-95S¤z ז_>NX>80a:˒qlOb1D==g'`lVz~{mو9 7lf9Hv7̮n/(]7Hw5jo, H{wꝼ:.ީ5wWc 8, O1DB'NoVj2ҏ[YiMK1"W/TzV` endstream endobj 712 0 obj << /Filter /FlateDecode /Length 5420 >> stream xնR./^v?YϼRtG+&-cu0+u|! eo~w{r,8f Dwc4!lԦK`tYR6t#ܟυ]~ ;m"8/ݪ{}R^S /z`N/3szgZgefg,Ki׌q?xEd܋?]AL<уDxjf<-eFBO0arи uR&Cy ^D#HH/xy %p2 }0s\<2̜HMAʰq2L-8'<Ǎ)X.xq2`r mwHa|=Aɬ0g?E(tBENJu1|>ڃbh44d<Jt1l:@ByS@$->Zߟ=O?ϙE4nЙ󠀵uÌ7=U3-PZp׭V;Dy٭uAbL,d-_=϶jI!f| Fw#Eݯ+Ui}H:\\8y RH)YqN!+ V(v)zfOgX㚽>$qA/qXkX|X%*H*q/W X=`BÁj j|/^0 %_} _ݧ ?&рSE$xZ l2JX\0m|#p\, LtKEUb#6ǀ#][8-MtN6 ^;\$z L bp/a90p=SiUXZ HSh'WT[+duUV)C8w<8!B6-΀D9Z8!0Oo4ؒ0o`]A2%H8xbI:WJеeߟs02I%x]&u3pNd"R9 qyT#[,Rd$ Bh4TYx0ABXjH~xIC$igN3ZpR'x”\GY&a S;lCtZ F-[$$2aʊA~T10a"@7ge#x7&dlʭ0?hxQm2c@57{mg4:jƈWJZoBImhXpΏ).Nb&SY"Ŵ${Bh͂ZsSEUDOL]pbA#SS&%㸠U9 ؀ѐ)y˻_ۼUWH|F#>s:Fhh+ZCc=:YAqug!TXΣJuHehB-G;AzӜ0>D6-B|兯 F6->SBT2 {l?hOG d] *@ U! W)B lI!mD,WAi:[nSl1F "iYHc"$aueX]uQ"9Gbm,6Hy{$ȪC)c]:e,%H`}$<mnF;OllB6Au肦߇?\CKT*Ybnbfo!;Eͳ *>-DWE~2bǀ!y= BV JTkIgQ4_BXJlDx>&΂o=Cש 9^3G5d] 20)YŔ4SM1s]?MbAD7wU"P%^KħglSX#_,pQ46R& 6s6i$l6J1IyC|Bp& ^oz]YPkOgC]ս-$m٫H%DN5U'-@3zDpGk):9!(}]r9GH8 (kTɑ}<skjb{\Fc *׃Xy7NBIU]0_qNzg*K>d>+Gm+OwE/c )4%-Qum@)BDT'T3N~RՏP|[->3V^ DKR\󃸉jGbRA*2 yi++Y^PӁ [N7/D|`sP2(2\SޕĈO;7{:ֺ2cO]]7Ż]sU&{l>w[26]"e 0-7eU7B-uY*Ig%dvݖ{"m\79mJyRYY2<&${̫10{)>tJZd.1,e7c9 MSdVdE&FMSj>;.=0k$7)n͡4+þ ys!+PnRX{-oΊ671- L#|l24M 悯쳦Ɛonj>fhv%ZBNd,F&odo(>-PMo&Z(=Esg&wp(_;J<|[־,/ko) ዤ؍ZI um''uP!PXYtHUlcZeΈ:9}&-nh 5ºճq^]+ؐĚ4/!򻊱Ukn byZn8ޡ}64UZK|z71<^GFMKBcf_?tOA2U}]%݀N 9v{Oܒ]țIC(z{-G=7*\UeUDju"Z?}J SUēj%.+LN҅xxo_V.ON'Le@ή.{u1Hx qt+TS7g҅IKkMqlU'M-zg$zhXC ,Q-ӛHŃiXYs ­_Ub Q4[ yD?ExyiupUVQsK3<`}Xm\LjT |H+ Hc {ch'j Ѻ$S~cGM9u؊>S=&`q{r/A<pғ-k"-K?"Mf`м75vZc@`U<.o[j)Kwvܮ5[,JnnGwSl/ K.:e͆椰tmQsB3Ɋ& -붺_.mv$6tvu268,{x~S"TM4h!6C6`+Zm-v#\z CIxCi*Q4Fǁ4i{!G 4V]hXQZC7ͮsD:+y swP}I[la!1`b8&wsk PaXxb_v];dCGzߊUӞ{w-DџQ 10uo45f@ hɄP 2X58!kA ZBz\!SL x79?ZLxu@wIfĝ14ė T)2k(u"&(1v6Q4Tțj}sN ͐YJBwmX / e@Fil;2 T7D4έp㜐*'ğ`(?un7/yNDZǝxlSl׾WJ 3{ƨb(,vTV-y K>]`zF0 FF,otޡ @-^TQ}% Yl."F[6FԊN1[Fm?_s>endstream endobj 713 0 obj << /Filter /FlateDecode /Length 7310 >> stream x=ێ\}T;{>9:lHnl xfҴd.Wў]>#KNOCڎV)4}}v`9.^}r:29gxAuYpaJƝ|1v{-tV^W l1€GݼI< yJ6g٤hjd{R A2V.cd[vgSRR!n76e͛-.gb\qGs~MffSn'F840~'!JVoq荵 [\MW7W]`UY׷3M~g;3Ѡs:<6׸hR!Uj?pm0,:=A w+dzp!qgQ;׉p/ \WyVzCp)&kћ:6GS̰ ilr-elUHXVQfF`㶎b#oʦo$O aEgb;FAHw^Pؿ"e&m}%B< N c22\ &Eo>© O,]p֒vQw$'D?M #^m:YKZBL g@V< >On )6_`o'y%YEw =bqֲ p]ۭn+.yI:pE{ZLi45jkqs Ȗ{8yfArYsf&Z!VO{d\I:ia6?)Y$^l?.  #!4A$6x)y҂9JG A,eۃ\Vg %HMo@bu'!t@A"ᚊy}Yi3\) $9~j8߾̙? ͌y M|Lz~+A86e 'Uw\MU/!AXFN<5S:e:Jn;ʽv@ $GW$x~}‡Qt'\h/ }zv#{  >i.]DL*#L]U `UA[*&Z9?6_oA.M_ϐx}%Wp|`{Q!Ԛ.h'5N }O:<&(s /aĊMak6+`-&R/͏loOwy]mqi^OJyc$owxbk[q9mT:Լ.Ci^qZ6.]T_na%3g\ez@]:4(M!_*N<;/wE@ܢ4ʔuS0s:-lݮgȲ1?n,OKO XAҒkކ`R3 DJ,|}eӷ| f-v)4V/ |^Mi\T4Co2NFKwnWҜbi:9lMD'PN6Us4WSV6Z .tyYऻOw]h] @fW1w@e*ywܫh;CGyp u]6fD% Dӥh(B{W隲eO畾l( c}^,ld3l׮\d7b]xߦ59̲"ƪa ,'&o|ȧޛLܔ I]t9g zdyIUj5JhS:z[ SHgƬ0YnOrn]V%OPYvuw;@->dBLQQN>+k:B_ΝQ }y=_=; %QkL'Ra2Un 5hoe'MA->$Gry+ V?S4lm1[Cd=s;=a)`){{5+oW{at1ZWWOFH6 eIT,tUXΜ#`xk{b,ͭܫ|'Uwm8t.=-:j7z;H1GOidŽ3M O@¤P3{gYIeJis%}o0xtN(2u r8G]։h^ F x'ݾJUuD/xy,qj0vYmYWrN7z(a$*Ɏ@2ҩ%~\1Y9u[6Iѧ'p!'fFcƧ*?t'_@_c壘bYl ꬃ=bjrj_қ@ڗg2faUz4Or𢢯 yC+`#`JX+_hrZx~;Ô%ڮwW kgAgJ67$.,~UX48쩌3P vW*gJvO@lKcëi^(8pQ@=N}x~ǁ́?)' *B|naS\O '0XNC ` OAWUjGx`d&rMO|QAI#b0a (t @0*a}舨-c(MC9SoW+җqҟQKC84wVp9M3*ꆷ,G: Fŀ2ԚP=T)ilJ}tg߫jr V1A|Z7)2)½tץy]"e=, r}wm̠R}>V`~~ s=ב/DA־}$bJ}yl]QTE24kg!ѯ%q/?/hYiDg}R(d}'ucQjM%N|` u Z k%iBa)!Bvc"zjҋQ(X}!q/8Z/˽jg%~J9v1"9 PB*? -h/CĄtR4zz uIȑAa#BS*IrF ^fD j} ֗eWȲR1-| gf9*F`O*n&Wb8*z;sRl*x"dTJi/*'ȃl|F2_U *[qP(HHD@9dS3iaA/kvCAl3 lAalH׽*W}qY& s@Ys,fed_yɂO+? 0VsTTkTw ȴ)Q 2h^H Ъagt[jp_{OUp_iǕ9LKlX 3sZQz@E/{F0) WWP.yG1˘@CqaҼfT0.b&Xt0j ~0D;0FvIZI-R+xoVkX NEcMnrdft,u kUC'`WY;<Ȕr.'9=h٤8|Fe\1o4r:ow$LO;*GIikl\ *`2ƛ7%8:ʉ1r`4%,ҥCd}"dv P]kyT[o> stream x}]s\ɑ] G~CuW+{G FhrFdVݛ3&NʏYY-[_}7/yA%(o5zh ,Ƿ/iw<rЖv/z=\ޕT-/rXZ?s\|ˡ,K;PCePt٧nYʂٻ% jHyM"iulGAְC]\_} \? W>26cٽ~忾X]r3kبC:RnWJ 0Z c߇;bÂu%+ضvC4l Lnv_^^85uaqW=||B'v dRl;,y/o}~]rH^} }Vov:bE]޽ P.1\HWǕr=FYgsɱj\Vs .A%Q%S6s9^KK[NRE.eJ_z|N0 $cyz*ږ]:F(.C8Z#!xdP`tʳ+K(j~{<|Cn|C089yp΃s\28 ep.s\:8ups\:8 mpns68uШ~|CLJ2>apvg78 npvg?8~p089 aps089qps889qpNs48Cnθ!(msYV%C!J5 sNRBǂ$!dO7!}u3H((626<$!Nhn$iӇ{,! +x4 hpEwf`CBDUU"!ŌaD,a?b9i8}F|($$sČ)B/ )ah4,@#.XT$ />Eh4C6 s=xȲrc%`c,nEp`XSڂO$ \QV{A!)bT4, FX@:5GWhB-(KVJI>[ {-D΁YU\l"aS]aeqbM'>chW U;0f'r`maB]3'H&z[#fB̉6*Dlkf3CBwH`D;^#5``Mpl<+OdP)ƆN:A|sȝP-<# !G,!IHۢX ) /m\ZD# \+v9YoKyUՙ#i}P5+443 K9TXz)YMlPti{ꄬ9e1em޸F M6^E_a:Ss?,G.0+~50 |k[v+:%Kups 3GR,G{ 2`/AbuNP0e1:p+yy ͵HV;VS S}=%C1f"v'C-З~`SG0H- DBH}pʡ#WΣhnYxEba4\Q'&$E}<JFO!;P{)j ,pWiOl,mNy>5ToB*WƎ\# =y!}wBW괨o.>wK^u #tMb젞{(Ȣ^"rM pe(_ƃdzZ1ΧW kXxs"G"% eP‡R0OORiX4)OјȊ|J2cD*-J%ʢ|T!Rw>§h>1Z:O^Ý'ޗG1tlӖ@g/qg<')"0RJ%~u)U@%8?Rꈧ1RC5d|OU̔|=RI)qAkde[R.S fJ>QўPIVW,|"R~;wf*OfF|Kc]$HAkIMB̔|DZ}6tX2K⿤`aRIM7Є;%9cY# DгFS˝ROC+Ja|C p d)˓¤}4%6%Kl SJsȌbS0'՟J2L#kHI6O,L))U0ElC"F3 6zgM> )Os2K4 @%@)+*Yg6qfԆ]OY$K)6O#hC ׹xYpιiA(Uй3P{R j m!VT):3O`Spzs\)ROR>@j:)ΩuMC2{ʴb*J2F$ L`)6èP)sgzGȇQ|Z P*C!?+zVGjb3Z&R0SIUC4C(D>< =AObjE1I6բV4DHΌSlbX:)% >$zJQ+ uQ)>dn- eE &3itnx$Hf)!9#-#>E'x8,ro*|1hJ(^!WUL<@L0 1b44E =eZHG =)J4R%h)=%֩h vP2[J!&纀<$e=V$V5gȼWx vJՄx \!EcfC)؍$&l ,1"E`%E|C.= Hpu2a,+ UX%|imz y|V t`=G%doz: Y'#%t?NHJF:*_&}_`)[0=$cjASPG9,=) x&z^ ړʭHLy`j٤'L[ y(Kf ҖalDĉGj[sVFZGN N$K@/GPB]yȊ2>x",=Mίɭ 즄9䞓&+ J-+07Ir5X$8PkwM1ɁTk.&I>ε5A< rAgђxp3lmi!'\(B(8aXd| xy >ްB SxN3 a\"F"̃p$Ұ߭G53jʢUˠ^}fAb6(G;c^>}>bl7ްw7^Lu틗U7 > r'nw4R#pڿ{uD"Zže=֮_㛋sNwjHT픕[p/::'sqJuXPY͊t8Ž[e!oy%(oSAJ׋^bQlzy*̕niN@<\ ^#>\ ;@^ ,~dd *Ȯg ݤ'm̲f%ӲԲ$?$$ ɔ&*S8nZ8?>oO9>uOH]:=}U&}hn*{\?~>y(.}|8ynTÑI 5E,n7t5+ZѸ=9::16ղZ i>eЯo03"%EKmݷ:@0 g]p#-v)LmZbY ;/DZ?~iy 2$ ϲL0}gۧy BKs̳:Ok~lby$ȩ㇈ !,{AEGlyoȘ @<(Z(HZW"<|Q>OVf5ƁMuYl[ۼ _NZ2Aߑԫh7q0է2>yZo7uѿMlw)ly9zӜًlQ |Pq+2:ӣ{fA3/faɮZyiO-Ze6? <'ħBB+g;Zَ9B9Wi€Rb݅4+V0e~)}a\^{XW<յXBd\țg,n)S)gO'ז|j3DERIR=FA]3)gg.n7KY=㥜C|E*%z;n3\UB$ި00%CǪ8^Bv0.8oVY,LƤHس[j#:oJ>N8'(X$& %ݹќ  R 㣵e/^ ;Qb^`SN'.ćc4L0i?eFj,],(iNXc翍93e=5)>(lM 3͎/LdIar%*@fLf+bs<dIECӣ !MsLTmG2TT'N fJc} 6^iP,5f4'yC+ZWz6' Clo޺<~=Y;~*+y칟+zB{m߲!9MϜ+O*s(,^hbv_cW)J^홨 Be3w !a 0Vbuܣ2o$-#=72ÛJwU2@GvF5<3 W}9r&c'CVP:@{RX$̯X5M>oxNX #M O9+`G.z]Jų0_h5{.μOe4)犫t8ǬQ4Rd6L, vԥ=eyC"ե k`p9-n(n-|5g|ѷy&n~oXYFi$xVbyMzf݁.\urjyHm~?GJH)Y9 $sma)jIkN顮e$0cՐoD95xMgVsg pm=(O]QܠW!B#IiR{i/<Ӟ CD;usQӟzH6:s5UB72gI[tu{d/{q0))9*eǿm" KٽIa5V^c>N+{6}hKr|\"ՔTVZohVPcv^}F'в{ y$(Ô ]\ d6˶=}ad5&&wYbô']\I Ye=Ԁ*_1nWr?}C=[maIϐ,#hn\q& 53XfN`Y zLvir=I\ӽ~t$B||~?q=7D2sݙƧ^shڟ?o1.y-Ir\<;+?)81H5bd%خ* *'nI?MRfbF7Pǽ]ctΓ!5 !:k&rqZxӭ%Iī1-~zV;rؔd6q~Ƿ$@xK_%ib^# rkۅ])| //z_㛩|2ҳvLZGےKK;g Cd6[Bd# +G}xmd:1;BkNFSM-!p7jΝM F|eMNwgή&)1 NAܙcQhMt_4=B!d<Xs8)й?3ˋ3YГm]?AsP@'IqKnifo'=$;V]2h՗36}{#>!û@LժMMۛi|ky9uT#BvJ`iQMՔ/36UF")foٝ$dSO"]krulx|yytpf$vט*߱XEɽY,DI՚k^O ޓ꣸h_u-2OBG yy\aMǜ$hR&lXGrȯ}J9kj:tvaT(3mUlsX$}Ʈ&dX1:.Oܔx#9M\cW{CuN !j~7E?\qk°Uoñ.hԞnhKIe 2?ʠ@znr?6W?UKpn*QPW.dGͳJe Rt\Rg6mJX3vh'9iP58dQacV-፞HNd{1QKb*JozNuy%Ǥ:IשmάX@ OdXz;x۵2x9 [e51|2v&)"&Ta/8჌%ڇ(~:xz*I)"c c"<; @VMwOhxX䓜lk{f?z'b8Z!t4G]O~C^ ULǝel5k/M^]3Z[KVav4ȳWg _JU3>%"xUtw=dk i61pQ#c[5,52ΟyZajs,d{ NXu6%۠9=zT.7F} !/ R>ߌZ`ij9cpewЮbx &&97,fi`o j;` ㅘ=vj}z"&*vPil aNKvuh8G[#R"9bY7(O/ nNK7(2W^^܅,[>oX2=yzFHD- JCY`~mo`\mAn%/&0?R5qOL/ Vc+C[>~))L@9bZV;o&&;z /'fjs9cwLƌfbM3 /M_> dqeZvxpGφ_'V,*iNidߛ> Z/tjiWCendstream endobj 715 0 obj << /Filter /FlateDecode /Length 5769 >> stream x\Ks$7rq?bBn[]w#ڵc+zHN="gFzUHPݤ+s G"_&ۗj//߼ѽ<<>x'o1@nnG*͛yy1_?o^ɐT//^ ˨_~//޼X:`ᅋݼ`R1lRtV Q;k|lS>l[=(&Lc|K-6=|42@},o7{"&*֌Q b]$adS'`0h聡6}K`=lf Ô"yÝ6G'3iZ5 r|mɣ@ Sp*p'3T9l*d0s ]< mal:By"vE& ޻$xybW<JĶ)?n>AhF &s *GZ/i{bPNnNdx(xYUI)8q}UIH{48q;PǁxO#sLRh4'횇I{,TAUU,[#__9݇6`(Gac! |\IicveL&>uڨP =);Y\8YWUrtb.Tpjfҟ^9c[#twDF q6[5f2#\{i&^+R"4(oZUQ/@ 4}[L8X|h('ؐS OՁ.$4$WALNPp.F]J6DgLӷs՟9 1IV< >;__u"-_D+!!5?uv#U$fc̽ iG! Nk~Ǐ]U y/ox`EA%Lҷ.UxFU z+d`xD 즁H#jk ;[I}ԑKsV6wZt¼ԣ+/xN>2& ^bb\q 'ԳDC kt1 v}64kN851XKcmAWAS9 y4rWi#OP++M=SC-C\Yq7 x\$s4r4᜼ҼqW^4?)S4?)y O4oKkryJS;˾)\:wi~mqQQ6WO܍κYZlj5&d^=B@A YB~"HV6+'M>贆M@0z][Gn)fó! (r-'!0S3O31}ET0IA,~9+.,HA3۸YOjY`_JMci^uiumF&M0&C$26UY~4pR"gqsOWJS(O i3K-cbZ؁1$]mݡ]DZ$S HPr֔HQ*vF}IDH9`D~oQE._Ѹs8N#YI%f3-r iJr=yU{MA'>>k783|N/д ˧AO6,@'!˯;q\ W<r߲H 3=*rՇ&YN{ƢB [V`G s|^:ڟiE2᳗šc}H4:~wsħ5 @*Yl#GX{yOU Jko:fIanVVOmcE[o zw.8M7"V[>]vNj@igM}?h-\ZtSNSN~,3&yJS6~yxZٔb.s$݇njhT>pj.~S+[Z7'bGYd;c14^Lr P#bs x'CQ642Vr_FjdD, Q] /uB1hlVq\24ݺS%ȱP^CJFTrծWN8w|I1bz >D׎+*5J*d ~ћLx* "Ķ r&rJL : T+wSCTXBY69bz?ˌI PU@"W7Ya9`%v9v_4aDnnSL!opjՌl=2x͞24O"<3 e/R^03俒,bpLx>҇)uP{|zmٛUfX8; K[Y'TqrYHU_Vty^1 G]G XBzyT.^.E, 19}88P\r!!Wa%S<}{'H0Li ~*p`\7㝵+ HP#Oh<,~f jU:OyhVEd3+wMEik"6F?xΎr3~ DUc|p`s}W{Zu.r֫"l˫GGp3ǯ.QqS!rk9P a-ۄuJΦ㪫s鉬2k:><~ʼ|y5ڙY1&y1]˄=jH?Q ?xզK{.Y5$wFO >2|ρ^K ]Y$^V!g.wא*06-"D@b/}L͊bo}Ku9lFyQ>r-6>ՃF8a\\9^r?H?.+KG\h ZR+7yi̾bicI,5C^{3ȧgэPz;5Zgp0[7fT|_ ]V"E ׌QǴn- 4Q,CLMβw Dfb̚7ta2B!q*yo)[Ro70"zTr⎳~H@bJ NqAо]䁔Fw ]>W,8(`xuu1fп |WD!ߝkк%&wJWB -ǬCCWEsLS`ϸq;[җQNUԖ15[gS~Iu9Vq!/dƕc)ZtW_ҽȇs,$;gϾ3{|J ŵ#[ǧ[;,:CѼ<羯=(OKxm^K.=6}=7+xAD /ꕩy՞Uf;t6h.\l)-H0ﵫ[;tֿ+]+yS v&{H 7Se]:(@kt@;KTb/t.{T2)9p┾_Svxq-ipY+fܕQuiJSu֏^,oQM4c9~&Y#5 #eU -?N xxxu!3blS }$'F?^`}>B'8ηӂsc@).Z”7- (,SUh0ݵ\xB2x~1[O}6RY4phλX%'NI~p׆ۮ$ɷCںK Oq/ύ+:Oz1s+ D|+Z{`d(ϤG!?q"~xߺ3u6E8̕<3GPW``;Uw{5QEeA=Dk؟hzh//M endstream endobj 716 0 obj << /Filter /FlateDecode /Length 6109 >> stream x\I\9r |n%(_s_c`31`wCۇEˌTVIjɿA>2$ZՀC^q ӹXg|3ZF%Q7%y~{/0t-QDy~,(ϕ[Dm/ߞ˅XDtJ#P/bB:fbZ l _NٸM)"xڼBDZu ںM=]Y:fW0 a֠7?_(!fZz_HE88 q~ysog[cV%8dC6g .b[ 6{l;N[цyE\uM\35Sw<# D(1\e!DU!oN \ (6oj+bA5%`{~oz7AU̝1Bԅ$NcaryqJ$F4^Iו=V;LK@Oُ.FX . {s 2pI/I<#`-a |3!>]v圄uAD" $a*['qcEgr yxlzE犻tmI( ,;Dԏ2$[0 =j !?Lw몣v$AMryrDN5"H3)*U I{QU64j=]>,{ِ*2B^ޱcͲKb>&^sarX;yՌxt#$S>!c{sdkX5T82x"`#i|: >/f$*;¾j0 c- Dtyz0V:a O&q崄d dqF3~^W5XqZ&ͽ?]X lGWh\̃f M! # I4 g3K4|skGqr̘\6rXѩrN/]>ySOPsȥp%9 ztӰ:E+crp`n'iT2 aF#NC#?bsq-OI"~ՆDx|'vPY\E56R(h uK ]#@n^td\衣 5c&љIc-S;6H1ޤ܃f7@͜W.I)oVUSG׎'W{ ,D` k=`0T,98vj FF!Ch«a #1 #dZzO;)zܿ 0%P<]4~{W Y5)@d aҙ7:"#ɞ6)o{4g_"{qK_"i<oK8muQ6 N#7xAeg' Fs"|*rsdqSؠ?{X#ů] >햳tO""|g,ȘLuĄTs% S[F`v9S\Fb$  clj y@W`^SzdOQ,$iV>D[ƞ )B l ^/Zx޸e.TKGdZ;Qd(q] Ԑ׺\'LmY\g=eī<)Kĵ_{0ɑEpm]%l0kHty8⨃bRyap攋eԶBH!Jdd&/S5 + *(2* #N l!Eo;Z}.rL.R2_<j2\sĨwm\TKp+`{sTA\7.%x_)Td!;r'\Q0Ћf̷%M$ҠB6u)CQpOaCJAk(G"qNҽMrbS/i E"dөܓ۾۴TJU3e',lؼw%濫@̀ ̿9{@mJ)VK>cbRZec Sc^`kQ-eY&{x&]zVα~"^0ӻT=]82e ♌rV]u9IvM0KUPZͲ zFAZHݑʵz2VenkAtT e[)~M@Wkx̝\ p(g*01:+.l7PF.bT7VbW[mf̜*֑G (K;#.BEC6. "8 ^C!>*p_|;5vB9ܿ"ۛ4ng-^^469]OG $ -bKV'r?.@ĽEt<_s*k#BCWF5A;(zu?< (]$1IP6߯fU6:xd0B1WE, u8вD:S{#jKqbίhsnaMc-9rJcEn4?[>ERU:<6GwiIjuJxqc|9 9a`Ǐ M>R[w&IR#*/"k̆5Aײ T`8 d)|i|˶*^WaG}" cVW%6ԑAe*BDQ|^=߁<*/%MLa/|jDŬYk(zaƃ<'Nhd+c7t\.+n#,c:io:4~Ï}V9K5kSQ`YqZ TzG7ad4<|< 0K@5YcP4h@Ws]+Yڼm}^{[%RkyCnptx\|[ )5&0!'`Fa>O).+M3~Xw}?ueaO"jF+e݅r/=/}}_{W'~L!{yS$S!~_-pF GAH!;nkj%->iOh姟G$%[` -ɜ^vukXW)#TPW2f.&|Y(OԦSKI'#ȺW_6Ca[!ep0Ûrİiˑ 8l2ݏ@x >}v摶f؊^>d+^.q7oQ%go=W0F.N\]gugAAzh2(VY]qpVmO:I=_yN&@P/L}a,q'X'Z2]uW<#,p3%$U4'0Q#zZx>J k U9OewGW[d^q9nV+8<@7Kbz )c5 KeWv? (\Z+^nBaF ;vd 6HD McK іA֯FݥI//+n}|ݩ)߬(ͯI͉2T(ھi&OA-͛;VxW1<}1Kf,4[4+TK}Eg{ FY\>>v !%55U]Q_FcrW!+ %uS}CE3U).W'\=-ap,LXORN/^._cmxHN:WP>WmS%h*ZN J8Βd,B,w?m1G6{7_ x3#"ԧXdҚC> stream x]O0 Rb CAp}:t8K结ϲ.>)-n H0dY h> stream x\s7r#r]*sW.U]~Kt$EJw$%ٺ KJri4ПnO NG/~p=1adiOc_ \ӗ" MVV胳˓f Gz'wn-qJ^~Ѹf^Fk5g{1Vѣezs X)+u6hzQJޙw4ўd8N[m7‚D\monΤ>0gQ5D8@gCY2Nf<(38BjW/>}y_; sfdvetSFYXA} g7(g'*P<>;h#>W* ؓ{<|؃7b#-V} fdg :d} {cK.xajYt8!ZֹhE xSJl;CwpB= r=t={z.qD6U,?gt]r! |ьYfu&(?`xn{u?kt ؚ Tѩś¶ V?n}Eq98 CUL@(=u9U]`|}V?[@JnR)y)QFQ6W"]U8v2 Q$;ƝGd|Y"9iИa:JV|",,I5Y|!4d!! ߐ#kNY?p^Q:kXi9KV?$8J?L4GL+mĤ&BkNH5Z;BLs+1"Ւ吂Hxj6X:[g{aj{|i}!cޑ\kvj&$[)n8DU~7.!Ԅ'x)B rΘRstc p.ω*MFsD(h+$/Ӂ "21s)"3fRї1cH`s> LNJpIxK%`Mj}oP/R:tWDxǑ@x;+ k yrS(A'jM@"I hXPÂL,҉vZJF1vABL,m 3Oef(QJ@_c$Rs3U1e; XRvS[hJ[oLMt68O #j&'"Zx0Zڑn +5i{(7CYG*r3edeGnmL'.e>Jဳ{jj&߂HȊ"3A :UF86%ڂȁ!RnM G2K ҒӉ`T2 }'C(e1ضtR.z/kk ǤI/J-ID܍v"x=V6& $pu$csDGWs?&;} "=KjjE)0ZwlH+zE7p2)GPW{CB)՜=H{Qf6R$D mFyҽ_:bmz(<!)Ue.?zݏ!y<':>'Lʤ׿saHI`Y6) W.RwUh&ُY=hM!0^b+w{ ̸]h 02 FJ5|/ )Y;쳘KMq3nUdSl1$^ci;h1UބD\{c:dQ"Om~7+n] m }D#T9QT>EB[L}Y~W\/@gTG2䨌oz$J߬YȷՁ볓Ob9}FyITYA2C|L.&OFHq$""|QZT]%CD GNςNjRĸFa V2Qb0IG1 AxT4raU™=\C$鲘s㞩.[JC,ͯa;--(,JV鼵nҖjќ$c]%eY'-l!kΉ/B '}5Q"J9Ǝs&4 Z&gȃaziAfWt^|#[qRel6H1Z9 sd6s9J!!wAf(,&k։:3QR+aP7ѧΈJ?U[^\y (]WY,!s7I4Z"OQab3}|CϸWM$C{+pX0<*W3Wf01o.aϊ$b}˕v,p"{곲5j+WWg3,ؚ IY0pD[`(k\J2NP/6epʗTMKf!ԋ= I|`\.Ѥfz Iill>HgrmG^a \R:W(Bu)po[P_h\N-M=9_i[ ;/v.z"BW L8OءXFUV^7$[R j_~ɏrS+Xcn`[rX#JU̞#nƗu,dM}}O)rKj Iɏ)ks(cGE½julY("#??Jx Hpms:څk@LLOvs^0C6R(|z_*ClPlz^W<}mx(i;Q$weW1eP0eYl92>1}^\-e,~MrfG3ZrV7d-ñB ?uL~ ǚlƗME)$|d'~Q4HH[nkyt+-ՋRx]ah .SLS>w?1>zkȺO$_q4Q?F7$FKߦځв(n;˜P7bЍnq2x%8.W3BSU' H\h5u,圮fhf/DMc]`߾fjk[.~ Τ\O4QuRbuk(|kT7*@n;bqeDGʿ }p|𨮶yMl,*a jM9?_z> stream x]O10 BBVUAp$6|/`,@L4[ub,,O\r)x@w|^6#NRP<說J`2ٴ}A*)J7cnw>`FStendstream endobj 720 0 obj << /BBox [ 1366.23 5611.96 1399.33 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 721 0 obj << /BBox [ 1391.83 5611.96 1424.93 5623.26 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 722 0 obj << /BBox [ 1417.33 5611.96 1450.43 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 723 0 obj << /BBox [ 1442.93 5611.96 1476.04 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 724 0 obj << /BBox [ 1468.44 5611.96 1501.54 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 725 0 obj << /BBox [ 1494.04 5611.96 1527.14 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 726 0 obj << /BBox [ 1519.54 5611.96 1552.64 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 727 0 obj << /BBox [ 1545.14 5611.96 1578.25 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 728 0 obj << /BBox [ 1570.75 5611.96 1603.85 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 729 0 obj << /BBox [ 1596.25 5611.96 1629.35 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 730 0 obj << /BBox [ 1621.85 5611.96 1654.95 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 731 0 obj << /BBox [ 1647.35 5611.96 1680.45 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 732 0 obj << /BBox [ 1672.95 5611.96 1706.05 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 733 0 obj << /BBox [ 1698.45 5611.96 1731.56 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 734 0 obj << /BBox [ 1724.06 5611.96 1757.16 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 735 0 obj << /BBox [ 1749.56 5611.96 1782.66 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 157 >> stream xeA@E &ZhiMZ^_ډ5Q ?:Մ&: 8BXHF J\|T_r>Ɋh̽4R[`PjXd/pLʜ @u%=L(aLtc V} m`X=b -5endstream endobj 736 0 obj << /BBox [ 1775.16 5611.96 1808.26 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 155 >> stream xeK@ Lsw `ƴ&m^_iЪFfAR2ʂꄂQLR(qvU|e2uUI0(,52N7C"e xxFbfak5A#ߎ365+endstream endobj 737 0 obj << /BBox [ 1800.76 5611.96 1833.86 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 158 >> stream xeM@ &ZhiM /jMt L 9AuBApĕ +A8l}x&+qAj|+ A ΐIS'> stream xeQ 0 ?ALfmO D' o6q&ڏ$dә%Hs.\A1RXY**9TW.tK-)?=i`OeE0nD':SfIOR켮$e Wb8P{ f0c[aݣ^5endstream endobj 739 0 obj << /BBox [ 1851.87 5611.96 1884.97 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 156 >> stream xeA @ E9?ALNօH+.+ɮ54V@ѪZmH j,Kntƒ={ԑVWRLRb/RJI0WR ܖ<\ \Y7^PCo5endstream endobj 740 0 obj << /BBox [ 1877.37 5611.96 1910.47 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 158 >> stream xeA@E L8օ0ZcZKk~B/|N5c V# G8Ia%5{K.p0[n {b&$ &ªx?*)sv|. st[PCiL2]W,{-^Be|[h5endstream endobj 741 0 obj << /BBox [ 1902.97 5611.96 1936.07 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 158 >> stream xeM @ 9;ALf&s]V ﴥ@Ȯ5 ^4(v7o$95R \ró#-99XpQ4BЕH(xPN=P*7Rm^Ò˒1د{{0}{DC }4endstream endobj 742 0 obj << /BBox [ 1928.47 5611.96 1961.57 5627.16 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 165 >> stream xeA @ }N$3LN k]xi;mmL<טEl0тMM{5Nx9G AI*$FKst| m0Lsv=V7@ k9endstream endobj 743 0 obj << /BBox [ 1954.07 5611.96 1987.18 5623.26 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 165 >> stream xeA @ E9ENLr]H+ ﴥU@#ZՄ  VBApIF J앬/w`2 gZj"2KH\PHuo8M qUW<.ŗv X;op{9Xendstream endobj 744 0 obj << /BBox [ 1979.58 5611.96 2012.68 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 158 >> stream xeA@E &ZhiM.ښ(?kT 9AuBAčtA8YU_r>Ɋhߌ-HHѝ+WeTT8^ 9|s6{P=2׭so=b 5Yq4qendstream endobj 745 0 obj << /BBox [ 2005.18 5611.96 2038.28 5623.26 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 164 >> stream xeM @ F9EN@p׺- Յ7*a ۵'L )e*jA}!6(q1ށ)|сc5GK%AY"zN.pD @`k0۸*M Ӿgҕ.+ px 8endstream endobj 746 0 obj << /BBox [ 2030.78 5611.96 2063.88 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 156 >> stream xeM @ 9;ALf&s]V {dӚtIS\V ;@|a+WKdq}Ʌp.9ޑjrpQ4Bp?љH(xbWJ-PZn¥VYO;6cQXܧ_hOg4Iendstream endobj 747 0 obj << /BBox [ 2056.29 5611.96 2089.39 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 156 >> stream xeM @ 9;AL9uD+ L@Ȯ34Ƙ8+v5ȰXr!KntƒSNI果aP\Qጃh`Е"xPNZݞ&(K[p.J,q&-\]sRKo3endstream endobj 748 0 obj << /BBox [ 2081.89 5611.96 2114.99 5623.26 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xe] 0 "'I״ 6S ͏5<@r6*BApU!VWA|Stp;0YX?-6Q`%aEƜIc7ހq<(^ae:5a.tE ,B4#P9oendstream endobj 749 0 obj << /BBox [ 2107.39 5611.96 2140.49 5623.26 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xeQ 0 "'I۴ 6> stream xeQ0 ' L|> stream xeA @ }N$3ifN k]xi;mL<טEl0'ʂVTph!MM\ňs5NxS T*%hUIU,:99f| m0rd<,iO8ArJ?l5@G709lendstream endobj 752 0 obj << /BBox [ 2184.09 5611.96 2217.2 5627.16 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xeQ 0 "'I, 6> stream xeQ 0 "'Iڬ 69Wendstream endobj 754 0 obj << /BBox [ 2235.2 5611.96 2268.3 5638.66 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 164 >> stream xeM @ }N$3Z@EZu feךy0Ę( ZRL66*Fp;0K2PZQPK@ɤ \!1O<{Ph\&Y s].<8q-h ?8endstream endobj 755 0 obj << /BBox [ 2260.8 5611.96 2293.9 5638.66 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 164 >> stream xeM @ }N$3Z@EZu feךy0Ę( ZRL66*Fp;0KOfhI B$c x(k0 LL纾'\ 38q-h8endstream endobj 756 0 obj << /BBox [ 2286.3 5611.96 2319.4 5627.16 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xeQ 0 "'Iڬ 6> stream xeQ0N hYn16M4B]c}R"h.D $loTS_w`%ǐx_WV; Cq+$2X?7`ÈB30lssٞq(?0ludXC o9bendstream endobj 758 0 obj << /BBox [ 2337.41 5611.96 2370.51 5638.66 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 164 >> stream xeM @ }N$3Z@EZu feךy0Ę( ZRL66*Fp;0KBBiEA5 \dRvɘ}'ʿ=L(eS. 8q-h8endstream endobj 759 0 obj << /BBox [ 2363.01 5611.96 2396.11 5665.57 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 165 >> stream xeA@=33ĝu1Iuk[MK>F5a$B.U(4:I\_%QboTXeCʂAX *pLʜ sw7[Qk V8 ^ ( Kd=9endstream endobj 760 0 obj << /BBox [ 2388.51 5611.96 2421.61 5673.27 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xeK @ }N$3 w  "кNk3&Z3&eA+B*87I\JT1\J'SɻuYIZ((F̎ɘ}'J߀qy&RS.lݽrz* ?2jd@/9endstream endobj 761 0 obj << /BBox [ 2414.11 5611.96 2447.21 5700.17 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 164 >> stream xeA@=3ĝu1Iuk[MK>F5a̩j $$үbATYR_7`):/B#ϨL0(edlx?9|laD!&`*\4RB%NDf{ 9dendstream endobj 762 0 obj << /BBox [ 2439.61 5611.96 2472.71 5700.17 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xeM @ }NN@pg]xi;ֶ & $0,}HR械*կүK7%?[r!xk*)qIgPb OR껒͖F(K-7pmZN|g!?@l,::`O{z#9jendstream endobj 763 0 obj << /BBox [ 2465.21 5611.96 2498.32 5692.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 164 >> stream xeQ0wN  L|s>x[f2}ֹM!$~6j#H)F.U(4:I\_Qbodn)?-k**A)d, ( :W`|w.2 9 nO+?`6a/s9endstream endobj 764 0 obj << /BBox [ 2490.82 5611.96 2523.92 5727.07 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 168 >> stream xeA@ }OԶ33'0q.)CՂ*)TPا_71nj<5GQK LTyaٞ!j! ;:8c 5|9yendstream endobj 765 0 obj << /BBox [ 2516.32 5611.96 2549.42 5742.47 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 165 >> stream xe;0 ݧ ur$ hZqK,%;F5a,ST $$nobA]:r)fZP+O`PX*Gnp#eN? x~TFc30?YuX$`~y%Bg/9pendstream endobj 766 0 obj << /BBox [ 2541.92 5611.96 2575.02 5742.47 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 164 >> stream xeK@=3C9օ0ƴ&Յח>2!shToA2Au 8@XH&&D˚ڥ >)bϫI2S&|bPB$f_9k0sxe\'0AżY3P:9endstream endobj 767 0 obj << /BBox [ 2567.43 5611.96 2600.53 5834.77 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xe=0 ݧ 9[B-RqKIEr>C{R"&G 2TINRp'0咃8MBQS,o HC7>q9&bSɺ>(Raepb9endstream endobj 768 0 obj << /BBox [ 2593.03 5611.96 2626.13 5857.88 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xe 0 {"Oi'@tC6azu Y HNEЪ -dhUTYRp;0yJh%D|\ 9| ?}„B\Kg`*ym^ѤJ/L=o9endstream endobj 769 0 obj << /BBox [ 2618.53 5611.96 2651.63 5892.48 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 165 >> stream xe10 ݧ Lĉs$ hZ듖8?Ъ^0d A}&U*IX".=\ ,["$K*1RtQe7C"u.d|.=„L(2]] DVad-S36e:endstream endobj 770 0 obj << /BBox [ 2644.13 5611.96 2677.23 5957.78 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xe 0 {"Oi'm| ل̓o7gw0|zhUv/@R2ʂZA}&U*ɉ".=\ L-xaŐ 5TtJ%F|;$R t{ [)2] $O°C.ʖh6h9endstream endobj 771 0 obj << /BBox [ 2669.63 5611.96 2702.73 5996.28 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xe 0 {"Oi'm| ل̓o7gw0!~ZՀ &2!'8BPo$P%9Qb+K-;p1y*ƒJN)D)Rv89ATKGPKTq{<VXaQtl*=>:9endstream endobj 772 0 obj << /BBox [ 2695.23 5611.96 2728.34 6046.18 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 169 >> stream xeK @ }N$Mq]H+.cca@Cnؾ`1Q"Wڤ$8q.vO`J9YZАK*XZt;DrfSy`vsK%\T>QW7lJ_Y2tpjwK:endstream endobj 773 0 obj << /BBox [ 2720.84 5611.96 2753.94 6030.88 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xe0;O Җ'0yn1MBtי0'iU{_jNx94G49Z,$F%b \!1ʻfRʶ.{>3.`LRaYƚd#b@9endstream endobj 774 0 obj << /BBox [ 2746.34 5611.96 2779.44 6173.09 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xe;0 ݧ yeZe-"9ۇV5` $LEPM _e(q1vO`%;pIyRI)Eh> stream xeK @ }N$3 w  "кNk.|rhl]z8c |l/9endstream endobj 776 0 obj << /BBox [ 2797.44 5611.96 2830.54 6496.01 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xe0;O O`mb6̓oiwB_shUv/@eA-BNp>*CsĹ/K|S)܁K,$5 :1Y$ `!Oet{ [)J] pP!U.=>l9endstream endobj 777 0 obj << /BBox [ 2823.04 5611.96 2856.15 6434.5 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 168 >> stream xe0 {OPmݺ'0|&w.K/Tl&@R2ʂZ`A}&t$'JlCZ,[؀3)eXRI)EVEKOH!/往q>2n\ty_3#7vo"kXA_p:endstream endobj 778 0 obj << /BBox [ 2848.55 5611.96 2881.65 6469.11 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 168 >> stream xe0 {OP۱nx>Q[ .K/ՈFP jUH]]r%..[n&++ej!,KBRTL ~Ai0kyеp)&%3tpj89endstream endobj 779 0 obj << /BBox [ 2874.15 5611.96 2907.25 6492.21 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 169 >> stream xeA@ }OvN;'0q.> stream xe 0 {"Oi'm| ل7p;h>Cj H)LP](4IdؤQbsvO`VSyu#%"2KF3!Kܡ2aB! 0Weg~9sY3p9p9endstream endobj 781 0 obj << /BBox [ 2925.25 5611.96 2958.36 6565.21 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 165 >> stream xe 0 {"Oi'm| ل̓o6;R|:Ո f P jc$MJK2TĦg!X0,KB*.7C&eo<}z#(^a&*5i+Za\w]8c -|9`endstream endobj 782 0 obj << /BBox [ 2950.86 5611.96 2983.96 6772.82 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 168 >> stream xe 0 {"OvI'm| ل7۰;Rh?C`$LEP](Nh,$X%QK2KnbëP-T Jb(wHM|?qYfbSɺ^֮g\ 3I%U.k:endstream endobj 783 0 obj << /BBox [ 2976.36 5611.96 3009.46 6830.52 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 169 >> stream xe 0 {"Ovi'm| ل7;Rh?'Щ6ؿa٨  $V J\\.\ LVW,KB " _7C&en ~@0? +0/r~ݽ#T+$ l-gl/^9endstream endobj 784 0 obj << /BBox [ 3001.96 5611.96 3035.06 6684.41 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 165 >> stream xeQ0N Bn1u/zՀeA-BNp>&SDs.#\ L)7> stream xe10 ݧ qr$ hZIZ8> stream xe10 ݧ Աs$ hZI[؊<;N 3S"'h4fXebA8vO`MtzJRbI(F9w0R&OӶl 9.c2[h l:endstream endobj 787 0 obj << /BBox [ 3078.57 5611.96 3111.67 6892.03 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 168 >> stream xeA @ }N$4Z@EZ ?0֬ {P"#T2IZeXU86w`U $huI,59>.p'c2@P ?aB!.30Rar(IN°Bff6 4e:endstream endobj 788 0 obj << /BBox [ 3104.17 5611.96 3137.27 6953.53 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xe0;O -O`mb6׷[cwB_sUoX@RdZ A&SD/|S|5Nd5TtJ%xnpD ? x*Ƶ#,(ĥLV*v\== Sh05re3vd:endstream endobj 789 0 obj << /BBox [ 3129.67 5611.96 3162.77 6938.13 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xeK @ }Nd2 w  "P]x}.LH>z3eA+BNpoI$:1\e >)5@EC %Q` (*B ɘ}{Rn\*ٶ\z]cp+l05Y=*5g젃/f:endstream endobj 790 0 obj << /BBox [ 3155.27 5611.96 3188.38 7026.63 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 169 >> stream xeA@ }OvfJgN`\x&[ 6/͜ՄFLEP](4KQⲥo`%Z8V2T*Jb#1#eN xƹ3(^auY|d3D7w0ËC:b 5i^: endstream endobj 791 0 obj << /BBox [ 3180.88 5611.96 3213.98 6845.92 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 169 >> stream xe 0 {"Oi'9>l׷sL)?tטEl0T B! d#.U~M:8x Bjs,F%& + 1ǂ/<{4{QJ2,K׏&Y_!yT<7I'<d9endstream endobj 792 0 obj << /BBox [ 3206.38 5611.96 3239.48 7011.23 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xe10 ݧ M|$ hZqS8<z7, )e2Au 8CHbJ K2-715@ ¥T J-KM(%|1aA! 'k\筝֞q *Lo"[fA_]Z9endstream endobj 793 0 obj << /BBox [ 3231.98 5611.96 3265.08 6826.72 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xe=0 ݧ 9[B-RaHlYJ>Coqxc,hEHg2k25*FRp'0Kx J* Q` (ʑ4wd>Onn$>׹T $uUjfA_cR9endstream endobj 794 0 obj << /BBox [ 3257.48 5611.96 3290.58 6907.43 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xe10 ݧ ԉ}$ hZI[8q9f2a&/c~..`rBrkfB _kH: endstream endobj 795 0 obj << /BBox [ 3283.08 5611.96 3316.18 6822.82 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 169 >> stream xeM @ }Nd2?Z@EZVۅf>xkS=a)Ũ & #ĤDWV)Aqu6w`jQ 4X&"eXI3>.pB9V| ?ÄBf`>y\ڋ-拨J ]aX!>|3pxi=:endstream endobj 796 0 obj << /BBox [ 3308.58 5611.96 3341.68 6807.42 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xe10 ݧ 7s$ hZI[زɳ7x*42)$qu;E&OlwLX)~|kw\@X!9+ev-gb9endstream endobj 797 0 obj << /BBox [ 3334.19 5611.96 3367.29 6769.02 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xeA@=aN`u1IuqB/:ՈfL.E jpPeb(vO`ʞcz!yDM%eRbI(4w0RS0.aF!.լ䥲uھg߾g\  ɒRU.q:endstream endobj 798 0 obj << /BBox [ 3359.69 5611.96 3392.79 6715.22 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xe 0 {"Oi'm| ل7۰;h>Cj 3H΅LP] j0PeQbsvO`*Vb(yB #jTlKBa9wȤ'0.;ŒBլd^E:mۃm .P cEH*[fB _o:endstream endobj 799 0 obj << /BBox [ 3385.29 5611.96 3418.39 6669.02 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 170 >> stream xe 0 {"Oi'm| ل7L)4!u' 92AuFpHBJnDdށXCň#jTlKBh \!0.ÌBլd^E<-}'L/%V+B^d#p:#endstream endobj 800 0 obj << /BBox [ 3410.89 5611.96 3443.99 6588.31 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xe 0 {"O.i'm| ل׷۰;PH>Cb$%,hE(NdX%1\e >ɳk?zhTŒJ(D-wHd̚twTX)r[]]w\@X!U.n: endstream endobj 801 0 obj << /BBox [ 3436.39 5611.96 3469.5 6507.61 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 168 >> stream xe 0 {"Oi'm| ل7p;Ph?:ՈfP#8APH&&%...\ LV,˫#D,(%f2)s,0.aF!j*0/NtKn@$@E]8c -|i9endstream endobj 802 0 obj << /BBox [ 3462 5611.96 3495.1 6380.7 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xe10 ݧ q|$ hZI[ 8C{bV F' X%*['=\ LKbJL0(ew0RS`O{ NX]u\g_▇-hF p9endstream endobj 803 0 obj << /BBox [ 3487.5 5611.96 3520.6 6326.9 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 168 >> stream xeM@ &ZhӚT^_B{_x$ՄF : 8@h$q#Fr%6'kj'\ LJūL((j,*V̙!2'|# Wyu׋?U*W_)X;5K9endstream endobj 804 0 obj << /BBox [ 3513.1 5611.96 3546.2 6199.99 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xeM @ 9;ALf&s- vaB Nf͋Ҕ2UNS0_Xj$RYRi' 璃ƆilXSIጣheaFwJl"MC =iq.uj-Ϙ88 w G-}DKgH9(endstream endobj 805 0 obj << /BBox [ 3538.6 5611.96 3571.7 6130.79 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xe10 Ew'0v' ZjJOZH;`˒|hUv3L )e2A-A IN p'0eg_^x JN)DT9ATKGPK0YoxEDVPugjAgl}&9endstream endobj 806 0 obj << /BBox [ 3564.2 5611.96 3597.3 6034.68 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 165 >> stream xeM @ F9EN@p׺- o:vaB ZՀ &2A5CNp INYSO`%;EJN)D yopD Ade#L(6 bu3.\<ʑ*j`=>\9$endstream endobj 807 0 obj << /BBox [ 3589.71 5611.96 3622.81 5938.58 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xeA@E0 3 Lܵ.<6FMZ^_ZۺB]{\J%cT'TX6rHN@j؁ URQx+>78uWA :cIWC2۪2Idqz8b |8xendstream endobj 808 0 obj << /BBox [ 3615.31 5611.96 3648.41 5938.58 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xe10 ݧ I|$ hZ' j;(Ojn $L&E e%9Qb+o`ʖ(FQci%AY"" > stream xeA@ }Ovv:'0q.> stream xe0 {OP[nx>Q[`%j#H΅LP] j0IIDڥ >Xcj!$ 5y* VJK$>e2)s4|aD!`2Ks^p[֬PD{fXC h9endstream endobj 811 0 obj << /BBox [ 3692.02 5611.96 3725.12 5800.17 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 168 >> stream xe 0 {"Oi'm| ل7L)4u' fP#8APHB5dށ)Cǣj 6J%dVq+)s,0.ÌBլTyN VYT-m:endstream endobj 812 0 obj << /BBox [ 3717.52 5611.96 3750.62 5746.37 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xe;0 ݧ qr$ hZ'-} 8|S`1K9Lwv1'JlCZRN'|Y'gL)E"e8> F2~@R0r 0RIϽ_zBCwG٠+VPf9endstream endobj 813 0 obj << /BBox [ 3743.12 5611.96 3776.22 5707.87 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xeK 1 }NĤm@tDatXPH>ݵ 7 fNEPP!i,$q*DK% N&/ Z䆚kRfNs`̩݁qv q0S:-~.#Xc 78b |9endstream endobj 814 0 obj << /BBox [ 3768.62 5611.96 3801.72 5704.07 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 165 >> stream xeK@=3CN`u1Iu>2! _shToA2 8@$q~ ^dM=j!Z œT ``^sTKe\ KdXC _O9endstream endobj 815 0 obj << /BBox [ 3794.22 5611.96 3827.32 5692.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xe] 0 "'I, ߦ@@6a[7-Gw@̜BPPhH%QI}{ߌgFaMM`RjXL9p< >@pS ]ÀRLQ8i#S&].Zx9endstream endobj 816 0 obj << /BBox [ 3819.72 5611.96 3852.83 5704.07 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 162 >> stream xeK@=3aN`N]xmLkҺN /9\ )9eA+BAI&&)"kjn&Ϯ3=D҄VT F<> stream xeQ0wN  L|s>x[f2}ֹM!$~6j#H)F.U(4:I\_Qbodn)?-DKNl`P,9:pBʜ sw7[Q"skN0_o(  p{x 9endstream endobj 818 0 obj << /BBox [ 3870.93 5611.96 3904.03 5665.57 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 168 >> stream xeQ 0 "'I۴ 6MM%E]Z,[o)P4XRI)E!*7C"e_ x*sGPKr)q3G|f&AQh^z+ 9endstream endobj 819 0 obj << /BBox [ 3896.43 5611.96 3929.53 5650.27 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xe]0 '&(Ā -hb%/wZ5`3R"&{ ߥ%9QbK>elf-RdmCwH̡ Ov8w}-T.knwgHq-B g7:9endstream endobj 820 0 obj << /BBox [ 3922.03 5611.96 3955.13 5638.66 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 164 >> stream xeQ 0 "'I۬ 6> stream xeQ0wN ڲn16M!)_5 ' 92Au 8@h$q~DeM}ށXIB4 Zy* B \!2'o8f# WɼyXDߜa,k 9endstream endobj 822 0 obj << /BBox [ 3973.14 5611.96 4006.24 5642.56 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 166 >> stream xe]0 '&(Ā -`be뗶jf$LEPM IIr۵K |S.9_R5ZWtJ%$99|Ua@!p 0Kr3=J t?{ - 9endstream endobj 823 0 obj << /BBox [ 3998.64 5611.96 4031.74 5642.56 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xeQ 0 "'I۬ 6!m@ϰF5H9qendstream endobj 824 0 obj << /BBox [ 4024.24 5611.96 4057.34 5630.96 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xeQ 0 "'I۬ 6.p3'܀qFb_a*<,^F q5@G79endstream endobj 825 0 obj << /BBox [ 4049.74 5611.96 4082.84 5642.56 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xeQ0 '&(Ā -hbeۗͶkTOAr.dBApH&&9˚J'Sbͣ)j,* C$I >o8f# Wɼ·teg#ޠ诟a,k 9endstream endobj 826 0 obj << /BBox [ 4075.34 5611.96 4108.45 5627.16 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xeQ 0 "'I, 6/2O<}Ʋ=(y L)Orvn# 8OZF6-9xendstream endobj 827 0 obj << /BBox [ 4100.95 5611.96 4134.05 5634.86 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xeK @ }Nd& w  "v fL>9fH!'؃$~nĈs-.Vh3 ,ˤ<7C$c֌/<~# (ĥLTeiC<ۡ/"hT9endstream endobj 828 0 obj << /BBox [ 4126.45 5611.96 4159.55 5627.16 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xeQ 0 "'I, 6> stream xeQ 0 "'I۬ 6> stream xeA @ E9ENd&s]H+.Z0!]}QT'Zj%Jr%.Nw`b2S QLȃ`PJ, EH*8] 5ǂO<܀Fb0e:/a qI 75*9Dendstream endobj 831 0 obj << /BBox [ 4203.16 5611.96 4236.26 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 157 >> stream xeK@ 00k]x55i]x}mBH ?]n=aI)SJH0$lHRqRG%78r2'S]:Eș 58{.T˾am4(ߎ#64endstream endobj 832 0 obj << /BBox [ 4228.66 5611.96 4261.76 5623.26 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xeQ 0 "'I۬ 6> stream xeQ 0 "'I۴ 6> stream xeK@ &ZhiMZ^_5Q |TO@r6*ꄂIc!6(qqQ} N&+2ERո* AWȤ̩ w`aB!v `*nKq׹I׹V_\70vsB o5endstream endobj 835 0 obj << /BBox [ 4305.36 5611.96 4338.46 5623.26 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xe] 0 "'Io@tC6a:)G/', )e*jBNp&SDg+#L37g˱M%AY"zɮ\ 9| aA!rUz8[:떞׏x(6~PF6tc9endstream endobj 836 0 obj << /BBox [ 4330.96 5611.96 4364.07 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 157 >> stream xeK@@ 9օ0ZcZօחi(/|wj 3HJ!'8AP_H|#c#ɉ#/ K> lW.N)Dd\.pD @`vƪfbbuM6767|dr #vy4endstream endobj 837 0 obj << /BBox [ 4356.47 5611.96 4389.57 5623.26 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xeQ 0 "'I۴ 6> stream xeA@E 3 Lܵ.<ӚT^_ڦ5Q^vj#H)FUPP i$q#FJ%NV՗`j)<)Y@ͮ*A)dd|^ 9U|{Q ܜeoeM/$yth5endstream endobj 839 0 obj << /BBox [ 4407.57 5611.96 4440.67 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 159 >> stream xeA@E sw `ƴ&Յwڦ5Q `ך)v/Arv*V b!7qdU} N&/yv*B1ʂ($d|^ Y APS{Qk0np`O/hLith4endstream endobj 840 0 obj << /BBox [ 4433.17 5611.96 4466.27 5623.26 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 167 >> stream xeQ 0 "'I 6> stream xeM@ ]1IKX Z3 #H΅9 8Z$q#Fr#N>/ TjX:PMԝ`0J,  \!1k8g#,z[ƴ-ߍ#65endstream endobj 842 0 obj << /BBox [ 4484.28 5611.96 4517.38 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 159 >> stream xeA@E 3pw `ƴ&m^i5Q `ת&fAJ1rAIč)A+'|hLdF\sUY22NB!eNO<ԺFaL^t[$nX=b 5"endstream endobj 843 0 obj << /BBox [ 4509.78 5611.96 4542.88 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 156 >> stream xeM @ 9EN@p׺i o4!|=CaI)ST# $9QbdW}.\r3MRd89| KGQ- Euoo_ ߍ36f5endstream endobj 844 0 obj << /BBox [ 4535.38 5611.96 4568.48 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 155 >> stream xeM @ 9;AL9uD+R @]cюԓƘ8+vy2kn%ѩBFnt“SNJ/v+*q  Rd/RJI0ERf {4> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 846 0 obj << /BBox [ 4586.48 5611.96 4619.59 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 847 0 obj << /BBox [ 4612.09 5611.96 4645.19 5619.46 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 82 >> stream x255QH/*247г4T0*r[Er"Fz@.HWB&(+ Lendstream endobj 848 0 obj << /BBox [ 2174.59 6938.33 2744.34 7176.54 ] /Filter /FlateDecode /FormType 1 /Group 526 0 R /Matrix [ 1 0 0 1 0 0 ] /Subtype /Form /Type /XObject /Length 161 >> stream xEA@=:3'0q׺FۘD]x}i#d'zw2A!)$MJRq2 sh bJ[%5Emș;rx7`\8JW`*Qymvq&cr2UI PA5endstream endobj 849 0 obj << /Filter /FlateDecode /Length 8719 >> stream x=˒\uYӮ|AS,zN GRY9.Wl&YY4969MqHIsiTJ ]By{#|c99^_‹RӜ\ ̫Wx/{EqxvT{fwN.>*I+k>i;gJ~`|޽GTT0U&){F+9Yv<F8+<Cڢ^.+X/MU}i>)ww8]:6<bKlC]<~ɟ]9/ߧvopsJӟid"̭>-n̤:Xv!<&}ЉOyG#C#L%mN͕6qш+ )X:' 9g=RuL]x]z]m&)@G"ѻíuCևD!X]5}lq'WV{gu-2}QnmF}d[ƶ#DNm wnc_7~"LNt"O#Zb:tG%717".E xDψӰKߧf@m;J߸x6_IP xqɡ 鈹3rTF:zO/h@¸۶o E%,7|zm{Ԫrllr ?P]7LH\Uh_Ɏ,\3fEhH'jcmZ;-x%cmr$|:9 K"XR$dHl;PIV̈́uW 󈬬Ա ySGCƪ EjU(%0`e6l{qbDl{}'go_ص? \M3h09{yAaP:\|)4%t`gE$ ,}Np.Np0֒CN2(P@="XDT7 EoCTqs}ŝʙˣJ#]5)~$&@=3قJҡ8FOhnYO<9Z&9MIhgӹr Jf.,;߂cvOifxB DOȃ<8,' d!.uX3!A#@k3uT *JP+Of`PX^2\(%:弑|>||5y. sV=>vƦ;c ݎErI~؅;z27UFcVͭty #gz2݄)MeAItbyJ*V&Z8q63aG3͠BrӃ&cY$>T>6x-,QP^ ,^+K:%:be%oi+MQ&LlT~;^QϚJ:VUy;Iފ \&0ebۇKfb+8s06(hm"1<=oc__TE-#yW2PH MlXw;x:}}hڣi Oi{K7R2=~h6e{|7n:8]'t8Ǥ)K Uaw۴ ա=nt5lA5߳IQ, t$tS/˂'m> }?M=e@ cLL ]#(>B "ɐ2@QI5'S9#c(Thoy0ί` T >;$(0&Hꝅ]1hl\0Ѝ~&ޣv2 }i,b Y,켳B eO~ő5F LH$ Ÿ;S 4x%V6쭻-/d*؟P Dte AbWas"w}g +nYt6.}41`ó0ٯƨ1M|Śצ)$[.BL(wӱC!s!Nu{vIrpiGgDg$ClTg7{ƩjFhсGGaAkA\h}1l "CK^<0VoG-ڭ"s"tso湇l Huew!~}F!.W1ܕ  mr:,Om^,\EyNvK4o:BaIN"1Ij(p9≢`Se(OH5;ITqc2?/ɐpʧIa {[SY}'?'mǯ< Ux_7^pa0hA)&@1La hZ2,ɾ\;AJ§ǛgQ(Z!5^ h5sًz(: Rw'/YE7_!2hz_Mѻ%|d StS5+0Ѻ}- ;R߰:Y*R0ܛma >VSx`zrfʅLS:Avm1Bвc $e1]1^ٰ%VD{JA@5Yׇ#.%.MV~l9S1gW{>آ|ͪkz BhHSq8IC|*$0.$r}.w a`mE+k^֓y.#?VYUf(Y"=Wqy=S 0 1ٕ}oMV&sy:ݭ}d㇪t]DgK Ɨ/cYE\,܊AB Jף2fRFL,"Gqe!VP۷%P@}ml?/2yXxI:f=?+MsQr94 bqd刾I# שm\ s+ɵ1!+:}TCK{6f?l=]|e)Tg]*b:/U`қW6O=m˱|Z&:LaG6XDZ@=7|~2y<)H.G9Q*`=.w% i8csezF"쵳XgwdJ(*X˳>d՗(8j oDcVw6N!nPS;KS87=H@ZuSIa1HMsiu 5?AdFjЬͫkUj/] @ K\(O4X\XZbGJq ē 79>mאdy8?s@& j*|D6fdv G;B}5 ]LWR|\-]P2p" JdJ16V5r9! E͕pId"_TzIPT;2 daJqB )ЀU]- u_SIk{k=.}K 0˟ q EC\<> =̢`ս>UFTsDN+;l2x>sZ.$yl3elע%`ZSM A"vXeVL`Dž908emSwoSG;z|e(Z|Vt+Fwۇ^LMHcg (f(}hR]][)ۓx$Rp3NGqSJ辢N&X1dSͦ|Ꭽ,(#ė*JH6?&dU[CI1 )V//fYKO6٨Ɯ$`B4jn_ha[~\uf,lmSCP:Dmx%I$v9qhoߴGQ[bLvw+ v+pS] r~K9gu!{XoNn/5_n:#b}ު$Iw.$r h8:e) 馕jtEF(@%\NcwCo,EE[A%sQ~,0Vh87e/cY}ԋd]uN{̋W ݝ/'}&ĦQ&@۟RӔ⁚<< |NՏh*jy8IuSFn<A7ld1WH6-zcJ&)zg " `| `6|[omT]W: %N5LRЁu gx(rHإOon|Zq7֛clZ:GP!z\W:` dN.[|d^O)X2ئX=)pF44Gι=0OİJޛO|QOgg9JQ +O{џoKBg lZy}PuWL\I]i/Y-hT>#bC[O]H[vdpo4x>9ٽgVkhOP3 ZlOWi+'fzAɀ³}ego,V~VSQ$=uelokuNca5j$ G}xG na˵F8!n%ϹO @Xǽ~ hݬTR(`A[/vG^%FeJj @q免!gw>f;_20{Z$@8c׽Ji@EZ_m<_=\5 f^DN2{ZiDʊmlĸtp: D@mXdwF-P,ă7p{2߃u CQH# vu\%:LpŻRL^bQX 4vIfIu HӬ*BL-h/^7%#>|dzi8'5[O"5([< 3ҜAb)Hc-NÉ+tt͓<40xl?!p%_+䇵AWWÔl%Ajͣ[;U)R2d]̃҂ ]=`R,V߭g4=†Lcf|cqj#L W*ʥhI]B&.Yz(AC^:pSR^J o Jqin,uz1F,vG5EDrQ<`ndnq[9z|e@D xcPI/2Z7}+Yv]zK{J"p:$'xj4VYso-8U?̄yas>Vj'"kO{^Kơ7L79掋)13?JQZ$" A*7zxJBw팋>Qvp+W>//'5W*c&T3NW#YeW'uU +j攈~;)"h:jQD] ӝ"Pm:w fIc)%cgnj̫W~WU6ڋ0lqc,vqfKS|LD pƜq'#N$ݒH*C ~]y5 yKa9;vˮ+1@ӓ7rI>=`kPKշ [SqFXȎ]9x0~Կ=_}RSaD\=)OEc_f98T_P]cHa(['TCP\|H]ۣՅvFxG_6{{}ap #dƛMKT6*\}/r|pMO}ɕZ;p2Eg*p]*lŖr[.2`ޛ\0\hrDw* t[p8(,8qH=$qßлuԧkV@X_p2$)֎;49}zx$DͷeGYDe)na?bpr-#evA rcfp=H 3r8#=դv|tH9t W":zI\:(;t&Ind1K@7j!*Trs] ,C o@͊~H `Tw ZSJX{b1Z+ Rn:!Ȼm ͙03X%"k=,ɢEW7 7rAI,YcXc<]xƀ˕ő=vf:-Jٛ0H%XIW{e]cݫ&8h\ͲH& 9RHrjg¶Wa9⦞MQLcGMMeMA6PC{4o 7l)_˩У&ϟpr>h',d׬9ڛ&q^"+;ݐqcd=SfUI2M rEv.vymO|}{tھؖ\U"Oa vG KS'_txe(T+Ose~QmN'h˾m P H׌W;L7-F`^JV^!()rNf2>׃@R4]|K׆%vQ F:rJ *faYyBDrcc.8VNp#NQEOR̘Lr1q0՗ЉMB 5+rQgS FIr/J{'ID ŒH'@tt~k( FN'% CdMwO9J"Usd#|NTkbmT6bGUDډ; gF3lEj3wr*z8RHѢk 1 F<}Eendstream endobj 850 0 obj << /Filter /FlateDecode /Length 7739 >> stream x]IsuWpSCݪ3X^$[aIP8F>4 C DSI*A4 չ{kb: ??1E||cSÓ_+1/8n'2s\dsB:.~vV`tw/TOw阍u)N/+م;q4Ax9GoZ3w4l0=v4 {qSpF0Ӕ;Ķ avw?~Y-O.tnQMɯ=8qF/tpWtEầ2L 쭅cjOOL%䲵4.;~~{w@Cqo`&@4>&wtb:(G <Ze'z1ڃ-Q^-Nk6jF Wg'r]aö$a2psIdOS(~fpDH۬8gpٵj34b1ƬI)>~ML i|zSݟ!;c/$o/c;ɡg`ܿ𫦄A1%arWq^ ALx~4Ixj1by_t:MB$Ѕ;"dOGlC(ĂR'J3[41UиJ 0EL9'9w(Qs@dkW4vĤdWoR^.#T+oFT).Cr)s'FlĜ.2aQO| s $+@&? Z`uLO~)鄂L"N5kzdn 4?' [vpx[Uf-( %^6\R̽+dX`kYz_6 Nng HvtG|NHl~/$ m zW@Rihp|򺝧$i,ݷ=~@/}5`%@!#0@eX*2V(Xeψ׍/zN!΄P+p I _ӬɺT(ЀPTN$QB7:xv;iAJ- ]SJmL He$۬dk~cQ8<)UK/vi>;ހ~$t1W4n)@G*l HDdF, +aB- Dy:y߿4oxnVzg94#Z9]ǀ@ ɕ|:Y$3tTRg 7+Gƀ9__޽_Z0sX)eJ @Ch*na 6r zdiӼGeB/ Vвk̦8.?`FVD>: S:5+~v\ϩ ,mΈiI@BOr[q*mkvMc\E]M{'} a$*['4!h/G%5〦`K${~l$Cz[Z5ԽcGy҈O6X$R:^"D*VI\  CP0֚ts]lh$+&B@ 7ٕ[/x-CʣX#6X8d2ŝzhLƕ&Ams!3;Rqb R+1̀~j̠MJ@I})LP5O:,2 $U(mj\S#&ьJ:gr O +8AŃawk%8ŀ8ʼno/>#iAVܺ)X[ "eѷnW4:A!6O2!sl뺈4/( %$~Оxʃ%-O_p^6cÁv8Z>(o'XxNUM=~cMk}f &ꬢ<*%3_ش"%ng{f•pzD|'') y#=Q sqۅҧ7Ld1Dgk 3z=ѱFE1BlQIO$:wKymZ7|Wr/=/Қ_=+S `{{4#.yiO4l=o!'DLr,_?yﾭ xˮtR>L4?j/,_JQ̈́FU bl^}u ! uP5[x!Nͱ'&S$vU9ץY2B3 Պˉ,rS7Y>r;Ҕf ʶ2J TaiOhGسAyd;"wP}D|9=.7<'0Տo! $ v1 3/hO67ϯo$| L>5d#sٰ¡ ;cy>`(5!SG!z4S?`0*GR KBxyBo'BMq=tW"uT"]F׼NrnJnCmr{q IXWl) x%S+?.W%Sz"2ʾK0 ʰ[r3Í0Ph]rSew ]݈ H@w6>N:mM |$v Ծ_,óxų07ܗ/T96+;Н&B A[i;}h!#.4S^͒Eǁy%RRT5LE]gaI1T>_n⦠#>"{*ΏS;Kl 9C>ld\D)Bp~nށf*Jw~#eӫv*YW׃~LEE<+,ZX exubsp6|Xr[Q{E lu"5.Ho1CFA\6-x DyʀAVyߏ۔-rptA6XRio֍vl7-<,Z* A; [apuvءDM|eJ9O|z$! L`+и+L"F2Bd_Gi7gNEK~`R 1F* b9=fW: |1$v=zsw׼l ] X?lzL 1eBjGz1z7%a'nd?q:}\mg>@̋bDR3K^ 2:j`J.,[vx+3eΠKƍH+SPAW)[w  T_ȱX(k,O99R,C]⟫ o…&/,$NJY7C3-T6o!ټc}2Uc|W£yW)">#g00B^.0!曞OTy*aR+:g);Wx" Td͇섈~^ف:G@CLBDy$\Ҧ3xl˂ot9Ik~b?yS"#B~,`O ltS']H^83tb</ uQY5#4}.!v; ;HQW-.w}6WDFd uF@ SS7DgWOuy(W3ESCSϡ)%9FEI~ ,{Ji>MZ w6:.{YO ؇p_mيdŻ/z_Sc]c!ŵr:U[WsA["?_<(Uw4ʕn}"9j_zj%a3=P&t CkK˘v]>i(q,JL2w᷇xߴ/wy?ri"xr_WcjPG IehP#ɴbiokkitlp⏅Ė?P3EP*4^^U|^C{·;b$=`p>sG}!yڃ3Q=eg++7v| fa,d/}'b.)F݉[(i?k`Ucʺ*+^ѮҦYY&\0jr #d'_i:$QA|h͂~-\6]^NԷX6`epx$EV4|qNOFꢹІBwgk΢53yxSc6cR:#2w\Tf]S P>$8DEjwtص;?ߜc|u3*Tn)̡|A%'4+sQs_W€e4_ xWEt =!TI">> :{2ܬV aC߈.M $y6verV%d \2BQW &ݼƮ ^E=E+, 4Jj~}TWJQYD! 'JYV7nNMb-Aalqu.!1SҰfQF~H-vbMwIu򠤞/ψpQz[=Vyq~īNyuVWyz!xYk/݆D5sdW-Ajw.fh7SI+D3?(Pݪ~EcqCT3Om4jJ4endstream endobj 851 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 363 >> stream xcd`ab`ddt v04qH3a!Skc7s7˚ﷄ ~O XX_PYQ`hii`d``ZXX('gT*hdX뗗%i(gd(((%*c8)槤1000103012ԽK2>}wy߯jcws~7yŞ>~nSg>;3wߛgO^-ym̾^];ǂXπ| wt\eXp~`:endstream endobj 852 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 196 /Subtype /Image /Width 269 /Length 6121 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK " }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?RP #8CB۽o̎RAX}E# S,@.5AC])#Fsҗ#kPtQP*}Blu/ֶHRj?f̣nè쯎ѷڏj̯?\Rְ_h)@2_kdQ ^#2> VҐGClSkLGp)PfrQj4{Q{3?Ҝ 8WA\t 8}+CbPTv~ iaK0iZA@JW!7'ޕ) J= %(8W=vړ>C<@/ p1j}TQZeªDzR1U,\Tz͒Xf.-u:WYO\jNf&BkR3JL#4+/hÑڌ iwH.WM|FzY&_?xȣ˩0)U*^c8 8 p^ѓvߥ9(ːԚڅ剃0;y~чDvSlmnE$Xx—r"A*jin Kh"22f٢}oeK |I w˟(6lL|Ou" lO}=Jn]-`.9Lr VبI%}fv#3u95bM<%O7#zK^cko⑲ kJVLI<֊.sL5+FRV"?V^MfxOI!RFp3\{ pū:VwB@ye6BIiuXjR4]!V݌~)֭Wa?% cu ZE DAQRR ڲhgq꫑SY)w1RDu!+H!\?4 IMRyMQg~#4)E3Oϰ{n8&$TsH&Ta{X$[r~arewCwj;! 2Hd gdһ)J\E<jr͈$J~5'$pGLEuu.$`wT6Ywnq  s2m- 9ҫi?k\B0$R&葥LI[wdU]03$VxmߴXT[ڼC a":=*utΊv#a*Q"Te#8djvil;G{rUGDV~%.74gbqM9{ϡn F/GƲ%82Yjrw#4﬐ܬխOw$-']r}j>ƽ^DyW2`};wesU{oIEAJ${ jldd/o1]I^t?FCq/C͸*3UrG3;պ,*Tb4cq/vmT ZREIe_k9%\:/m5tY* s5-,׵g2E]ih ?qꡥW,AVg[.NOjCp]ҭ<pyV~+$E|2Mdudzi5B>)zO+&Opx&,tHb4s[3'?SLj-YMX=+8 b(?ʼn&/mqzi"\A椱2-yd WO%"`6 _XV3ٛ-0u2qL$t1cv$hF[Ċ$GUc}iEbd* {mZƉD zbqxmF#Ӯ%p<>P1T)p\:#m8ښ'(x9>ƽ#e<#k2 ##{>{03RYbL_%ߞaY 򦗉P`zJ+[Хtz*͔}U3Zı'L(?1T.nFz[)t.WMEhrIIH`?O&lѺydv0=G.aȍ !+6+Vm~ÚN3Yp1`&Jٖ̍7l'L{fs7Y 8aFSrA!2,I$OSL)ǭ)Ԗ4 \@2QCU3KS@j#F; SWJǞK1*` 1Pg$fܝU<ՙOȾ?ʡIDzPUGju4@S™A^h %u4ZZwQs'D 0(H.<_KqUJ;ʇ.*œnݱU^ԬDi~~} GLlSBc_Zi5_"|9D~7m^if̸ uy "bL=?Tg{ޓ4iu!jnyT+74?5bF0F{5S4X FF$9E(4mg54XcEFZiӁbX.K\! EEQ)AKѻ4XDQNrmh&4sM@Z(w8q횒HT$?) Da՝o1=SҞzE?ZO*?O֌PhLymJsE 7MqH*y}bvHҌZ4P1sK)G4҃L?8q=2}EySB$qRM^Y$@+&[W>Uʲ'X%1HPZzsLCi J (٢i3IHx ҡmI\QXRCjc \Knc"@e_7' rHj\U_a)r'Rg33*^U݈֕1LҰ9߿'Ull0WE#[/嶶f#ɡ"I3XevHClc"NiSz@V+FП2HRRGzЖ%-!:W-4xUϮ(TZ1=T Ԟ ;M|<@1X*Ͷn+ڻ5FP7}}+XSs&@3Im$ێzUm٫SKr~o*6j )7FQ":Ef:lAFeP2@ѕwiIkiZ |²~_y3l~W>&VS2t3ig!d>aM,r=6Mqw?"9p+/b$ )h'$YJsZݩ6?!]D2rߦ9b0>mJVf,iȹچ -.n"GVݞGHGJ qUoHQN2jV#G[\Mq^jƘ*UA="S-W+)'\q7nJ_<˅T?JRRX|Csބ\vO`O[ =) `Gc2½֔E^Bccz)A.rX ˀ,0pj`~gLPkEa\r?_{NV4ǥS+fu%nZ]JNSB0 :|gJԿ(T\UYͼ;qM9bI9'.xTH)bڊRQKI@-%-0,8;@zQ\` J UžxLU% sY\ܚ`1vL~u~0zTyIE#;}j66B*>\~c}*>t9cZ.C*Au(Jv\ow hO8Sr\A໭]{v΢їF}rH91$nnzEW?TKY3JJFiƐPz+c6> ?hn CYu,O8aКΙ$fｎ?iD۔-P`dV!$ZūhQI4ߖ8Lr9:kM#E%f1nvHTTՁ9>Fi1b{Z"8/Q{ƪ"dFEBtJ\PPKIZ yq5RϜgQ{ QKq$1V* ubXG*I>ъey7_դn#ɥi֐y5KɆQԺZܷJQΚ#]Sk=nijrd`۳va?{y8JHtQDNȂElbҀh+94FKv3T= fC@vF#6*nf#-yG9CU{)bH9=MM[lzq: lJ*RzPҊRR(i -&iE+NBTOb"iAE2NEbZ͔F'֊+Ha(QVf%-PAE SEv14Q@1(QK((Q@z^Q@endstream endobj 853 0 obj << /Filter /FlateDecode /Length 162 >> stream x]O10 @2 0~ 8ʀ0%!tpw'0^GGpȍ%pu[ΖXpm!',31ܔ<݀wxJyɫӸzȺ;czLqJg4m *)J79l! 47I,|J K6Sendstream endobj 854 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 399 >> stream xcd`ab`ddds4H3a!Ckc7s7ￄ ~.ȘW_PYQ`hii`d``ZXX('gT*hdX뗗%i(gd(((%*]&s JKR|SR3Yfظ" g.qcu~.]RWW4f%+(?u)}Sv8*R5Di[̙}-s`nJ[k:[uweJuWqDL?aw]+k*Z##9*/?q֌U|e ~8O6{ Sq=b1ùjendstream endobj 855 0 obj << /Filter /FlateDecode /Length 4388 >> stream x[Ksʑ-`Ol;;CaEڤljW&)O743|I|04FJ'/>:GőVb#ၨoV;xpoʴ*oǰtQD:ሾ(WJQK֏Qob)+/1z!LvTUj RpG'_N8\P Ʊ^0VRh+\[Ǡh 0O9aSG-~_|z<|5Z1%.j.P HE5:PX F99 Wm`)S^*|(۩O8! ?Aک0-aґ kpst:2*Ӆb&G_1-`,h20E bB + ɾ>Ga)nMhCQ&jn! ؼϒ`c􁬅cSsvb &HmIC8yS~ 4i)|3!\Lڲ1z0t<$xa'm4biJrh^X~;AF& Y5\pN.z&8=|u,G _g{Y+M#=YqM# zL9 Br޺w&>6®X-=ņ `>)F[j3|2+mc ¡5a%%z37jܨE뵵 LfA>N_rxg P` dؚEKCRf(3b^Zɖ®ǯIyY'r=([w h ) +ѩfnv{C}T~譭Ё?f ^h'as'.9TNѽ45ߘ\jNIEQM׉Ծd2HTQ`q嬊[[Vа$0%X[&ÍzxY-9&gpMw&d7N}v9_2D\VC?٘y:!JbÀR[itBiN{~B8a$)@p? pܹΕCM@|vJ"_;1ܒ,&1JQBi8wU0ûxg(뇲˵ S hQ8732JPzV8g0CJ@ q>rlR(HN.`\ 2ׄq s$Sޞvy|AL>8i:CLyMQxIa8HaŕDD[Anjєezp09݁ iamg@` LD'!& ,j/gebKL[*CT# ˹dH:'Cj9a ~.)c3lb11 iA27`r˓GC`&V>n1HG[ٔ)0׳ e?j;Dz3/М)Z{ i"m:f*DVQɋn7FRjWfɌ=jH`™/6JV: "%Z#x )АN& Hc -LC}A01B`,PIm >y^OS5 b 2kSJϒz!_*o 8:̑$N|GdlAcĎdQ=( _|4VýѸ$k*_$@X qްQ'<c($_3$dLxUM4Pjc䕫iCT'E|%9"UOCߤ!iD@f-\)eU>;j)]\p]wl*X kPMDAVoϨ<޷Af3JwQ"t\:utFHՔ>--I\Me~I=<~T7 wF8( f-\aCoP?X5oHW'ЍԞf*ٷAKY9Dӓɀ9cJWƁhGYf{@nS: [9F#Ln5gi3NB1(x|X!dFL DmJt{(̴Me3gU%WM:þ(\V_3Vm`2y/AޓL .ˠ5As_cؔYf!1~N;mRM9\} ͪ8L+^t)Pvz[!話2TS-cemiӹXiL*# ߐ18/A?F[vik xURI \pm?T9a-5 !募O:J ؇ Ji3rL[K1< /{aCBIxi#%j; Aq$Pр]In)ڦEMɌPcV4[&f>C lY0yU"`큪.!v5i\dXmouݮJtъvaSOGܭA&%_lOy8{xUCȔ=2tފ{d۩'6ȒXHȖe>"gJ0 88G׌TQ{^\x1:U!}~CSYBA. tЁh1xjn}>i8Ȍ<{TInX]0 Z/tIӱ!~VȇfgK:퐥catP`Mom|&mmp MK5ӥ~4}$[#-LԀt%c]7o)]oʡڼ$u60[Q>lS~^nVAVQ29aWFnsѴ0糯k2L~[Vx%骇Գm70 p[gswu_]&)gWĸ31vĵ4bѦ]%]̍MWaW/V]A=^:WubvVffx^m 7mc^Y@a:R ma2%"KNE؁6#d}r6XXrZZUv).7*1&杛|(b )djY5Hɷ8ٸ.E`ҟDu_mFo&X]aGZ Tҋv8M{g` Mb/sIh}io[w8Z/e&F,{* ] TC`"\rʅ0+g@cX)jTgM|hmf2S$ȚĭlJi;R$b+k_e(cy)}WuNDw`|V!:E:9"]N^3n-eY;BX"'u%Q]U| AjX c/gOa!g{w!)77]_q?çuA ߃L*yoI?Ony Jendstream endobj 856 0 obj << /Type /XRef /Length 577 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 857 /ID [<56c577c7ca28943dd532144d90f4d889><05d0980cc2471b847a2896b41ab8f883>] >> stream xMHTQ߽::M\D-ZQse CEm\֢r3 RID6mmj $ީ\{gsm᧕e#KCP \OO }rb!C rab,8!ݫpCރC2A3+,#ixy[rT+wX,=a{X8 qX^y `[oOen0 +x#;~X%'ENW5T,F5l)F v VRYS ݩ)+soF}"y^{PuUnrfz(Whg)Xgo}LXWfGj{;vw~5 ly^QB_)RnϧKULJ\I1\{:JJĎ8JRd&DȷŴr(!͉nWb3:}'Ą?gw؞2ss'Yu1%aj:el >}~/_JE:uϏM endstream endobj startxref 464508 %%EOF metafor/inst/doc/diagram.pdf.asis0000644000176200001440000000014013150625652016466 0ustar liggesusers%\VignetteEngine{R.rsp::asis} %\VignetteIndexEntry{Diagram of Functions in the metafor Package} metafor/inst/CITATION0000644000176200001440000000133514402657721014033 0ustar liggesuserscitHeader("To cite the metafor package in publications, please use:") bibentry(bibtype = "Article", title = "Conducting meta-analyses in {R} with the {metafor} package", author = person(given = "Wolfgang", family = "Viechtbauer"), journal = "Journal of Statistical Software", year = "2010", volume = "36", number = "3", pages = "1--48", doi = "10.18637/jss.v036.i03", textVersion = paste("Viechtbauer, W. (2010).", "Conducting meta-analyses in R with the metafor package.", "Journal of Statistical Software, 36(3), 1-48.", "https://doi.org/10.18637/jss.v036.i03") )

]`hI߉hBF_^A/nEyr@ȏ|p?YKG4ādǙt{;q3[ϑt`>low 2 &NjHu. I@hO ϱa$AW.J3䮰3돎Q:2^yڋ']T[ne}X#3LZ{x[MV:_~e*;u˙b+lY8 ǶȒmV z[p[Jެ:{`tBMirw:6$b#7uM to=!/p6/4S?5T*C.'YFCh 49yZ?ym)J4+Žߛ۵OT<Պ-xk3#D DaդQ+ lqQ&N@ceOc9<vzOo`"?i#^F{7UЃ򥑥dXLC$xݲc:ŵ&Z٦sT0yTi֍ "'Z: eQ7[uxEذ"2KiѪ_ jͻ;W'p񲴔Gwvy)1C}|hl񉋌hv>OxVamGT[gW`=2F$hB:'ԑ@g޲,+j#A'uZ4:v& @cLy> stream xYo6_!I!kÆa=&˴M<}4NDyǓ:u~}'D!#Y캈z#FCgrO0~\y0 ;jNbfOJ QQ˅#lR' `,q 8(64H+Qd`b:]wryUI?>~{R83r\Pcf'־g䊝ʺ% 4Ll'}}h2<"AzYj.++cvjo}`ZNE~;K%xtHpzpS/7E^xQwb>+ Ud K$Zn8LJp;n%0pnԝ-q8unF6rTd!6y)A<:9Vnj0.6SN6Ŕz0TE|AV>5zZĕo%6PG>8YoSߟ$6̂^%x܀F?'n{!E}| Q)^d v,Vkg*ËBjd 6f &fL>ۘHld^,A4"u9VPL;G}H4w&91G\IL*M2uE,?I&VZױɄKa{&oh#{?z267гgԩ!QmiTT_ySZv^b=0DB);3 $y& HD|ԫg* 3̗ߙgYu\ǯn,6*ۤ!l|+Ͷw+?=պ(P3 lRD iMRYG>EVFY>ڍ.. ŅNdUyLA{@4!|GS ;014 Ecdw+ ~+WɃ|W-{';܊9Ek$ڠƌ$=Ӿ3iWLn%G.+^IIy"^+;YnE6o{ ={J/Cb;(E֠!޼?)ć9AN௧$a *2)+@c[b[2IRۊBXiM&Ҡݠs˃G{q {;FAw H- /)݇"܃qq>>{ԃbPIC5Ik"x$#*poHe!Ź]C5H>Ŋ[#LFj yQ"{of۳:SDdP@J0]OP۟.D֥Bt7;ʭU1 E'4rTu @<}y\mTDqPr+X7RcA9UktypLn'-Ӣ2%qț[U >{*7?~z%X-e^nVɁ@3̜vpq#kG^O04kQEIZ>??z 'T(h)F?z-#*! ͟5tw`B±mM?@nz*QP A_"Oaa? 0[@Pj؃! h C+v7IB{Ѱ;y endstream endobj 830 0 obj << /Length 2766 /Filter /FlateDecode >> stream xڭYoܸ_ad %*Їk/nSW+p\F+ w3ԗ( x!9$g~E7oo!7'Qrx 2IOD~XSSo;ƞM?r~o.LqʛwsB,܉Lࢻ(O:]l6K?"Yݞ*8- _:>c'z8F PUC͠{1vKpD $h'3݁8gxpwn#XW)H#/.~ Jc>ކzʐWb SI_'fIK {?|ϟ6RDAnILdu{Mt#p7XÉaq.κ]$!4&hZ̰`3xFNPUa8QAo{h 8TC ԿAT'(H؅b_n5\S{+톪mGH@-ך醻mO:"gj/ ։-&FV`2ڽAߒ»;vlJbΡjM38f a¡w:hhIs #R xCRa+\%X covixϚDR]׷}+:OdGvDId+[{X5-R>aD(k0i4EsDtLL$QȄ#71St̬7ڱEă؜-ܦW^ao^q dj$b$MH'kgw!Νա)}Ќc8Rh+`:,ChgP~{;I\-T gY}{Ş.Ğ]G-?RҎL07I k< ɿB+.+p""0l1ݻ.ߺIfNJ8Xa.H=N͏tAwjpsTQ-w8-*~cWE%̀.S; 8Gi 9#5_9Ancqɾcx>n01E+Q\4;CRuDB:CH`Hրʙ5;~lTig+_ĖL~1d <;)N~Юc>BydJvnG"lYOiEcS|Dgǫ |0s39 acBMSьŐyPl5G;bؓ]FomLso?U] endstream endobj 836 0 obj << /Length 4035 /Filter /FlateDecode >> stream x[Y~%E9I^‘8w%RקlRH6EfYu|]vw^}ͻ$Mezt'8R:3BDwۻDvχ?y%Tfa&^$}ʻ"*M~`W1O7kdXKDEmWaMwXkaCˊݾBjcA͡oXVŖZXՎvy͛-uzM[K)jc}(ݾ$U'qLbMEKC_zXg =wX۶?~%=,/F}\0TCM-.PXKF˶TUQGqtO‰6CWԪx}z*6} jGwDBBWUXkDD?`9:ǢPլK4,[W?W5ClDP(!T<~|,oS{A#nsJf{f_Sc"-}1 &s9ʨՇ}SoB[͑y,.3*i1N>P8eÂ8@&R'R u&IG)` .\2B$C 77 "J`ZhYl*9pW|<]Sn VfρH7k6=)MyY2JC6)3X ~ŗ㍛y74fAFÙqՖ` h)-fWTtK[XH3L\A΃燖gnOŦ|zf ^Qi9}δ˨(U-md^rA3O`b$ p6ծ9v֬ꏏEv2: wvl"i s|䱡q6c\9^\X_-;^TA(+nw[ Rˉw'u{!$ 8%7a"E0UO5jG~E@-F-n c8^26%Ы6E?ܔɺhSbL2X:̃VP` Z6"T/TaX_ @Y)L,T0uP` {Y=U:pHBNG<`W55"8m4qXsRσ@σ1x3hΐ DKMqh mЋpFبL· &Br C@-T; GS~  L|ma_uux`aBGz|&vh݄Bi5T,ِ\E5 m0c /(Md`CY|q.<04vylAE` kPHA(UWIr=$㥖 BH-)Rg >{  1Yr s(w D|v K8HCӟ)F$l)8HބpG~ $-IcAMaǾj m ߫+<~Lj;ԋs&HDpK:ʌ%_ ¥7Aׇp0Ȝ©Z@d~rԴ}8' O2R`(l;ǣGr8"q.Xqؘ®zlƼ X\Pe)~7&aEyX\ 6B_ 8ɕXc. p}Ӱa5j|-"2#F1tX`fUedډ((BxT ބ^JfƝ}wDkG&2vhJ}Gsaaږ,kAt\1-E9ku oA0<i1R0n Q_<|nRȲ^N*edo*33*Mxt&tF$lr`cMnV4xg^FӞoD%b2r2RXZu>$Mtz-&fk f+bH']1^02-c[$0=0}Bs\ m8f%`:|fJp4ӆO_\̯zI'C(pݜMC5NC_ j &쇋VUB0wdϝӹK Nil"GIRɹ9L·$5y30_X/e>Ɍ.]YLq:E,Ы%&O$k1˥woXNc_'vϕoa]zC=1ۊWtq)]o9 ө?bsȥSaSOGNaH(]lS cTS~$|.{\P>N ,O*N}zbB(?1cTSOPG$X^AtvH.]S'=&ݶQ#῞&7{*K!cDz1 `D;Z4 qcEicy(gj ~{{O~!?5N%3$.ߗ~(ك~to# #NJ}d̉F!۾vϧT~]-lO S3%&fBC  rp+ t)KcQl&=T崫Q*otV5M?7A,ggiYE>@w eXj4kzƩ݉h\d§ lOO#ߝ18A .: A,ߥ/;wU,_KCeL<>-?9;syza8=) myz6Џ[n1U۔7# 7]91 /V*e*ˢtuw%8֔ zsY8O.3xSݰρ$3tex.hd`b*F沂700f7 jp=`ӦAfn"_z>#m7zEHh]T@m瞸x+ds([ Fl1"\\TLa> stream xXo6_a&nÀ=0mEC?dQa}Dy;wǓd5_/-.fp,d0JIƓ1dQL>{bj"oG$m.{q!JO$zPZki< gmdApENc-H N*WuרSo|y|aަl۲^=.j'dV0uQɂӀRݽ-g™5dVdە@E'8#K&S8" p}7m/kF=Kb,LG_`epb8ݺ͚ծdGNBo4b#nsXK|3Ow345d!?j+ j彝v:SV'Y 2/Zּ-{ NIOq{q:e+}4n8gj^Lp4ZG~FL#:S*3py@ ^)^̔(LO~I=,#4p2O~8hۑ&1IcB#zie!:A H$}֢ խ0M%pRZ^e?/&6p t0py_*MvTqLqٚ'e])~@#5q$$h?A8λRգ<zdcjt(\d_ʶ:4. >1&uw+vCePso۟6t(Df$7gmjulv8OuLz50sQ Rr%ܔrAH=$CbJIup(S1b$j*jQݷ:`^Vtmp`nҵg,+i:0ە j׀A J6'7ȶj\زw*}%uPgj!RxDG&+ޕϾp)oN#ǛBHq̾- &% FkuL7Vx-y5D1I2ze-G4捄":Wh;i#ZA8anGl#Y04B:R+Lv8ޛVfTSi)CQ" }#JX$=r@$^d !BjeGZʹ'wn;BZ(N–+1WQC C-BfW"yso:Yɽ-h1v]L 𯶢-GMkZ(5unW@=k:8ax=b"#2vsʹ@ݞ_˥(?ߟbn4$; sL2gOV|=r0]a*-3*w=O8V_gmnMXz>](Xԟva k%X׮NlU9O"5cHbh+hgCA71gg#'H> stream xZߏ~_\r~6@ ghkzkm q;Iή^\,9f>U搂*אkCkHж@גg\K-$%AL*KPRC7tAp[nGĥEOڜs4ǥDAdwPb|w:5,&|2$>@`H4BG$-$w}~,.ֵb~:Yy)A 8ed{ 4PBlH i.joiBR\pQ!zk@UsL_{vݽv/]ӧav^U|󷧲 A#EЖb]F^OXEan@&81k0KŌvG&V}$zuajg[qt,F۲PR>0ט+ VQ&)tc  Mwa}>"yʦRSͥusWdJQO>h"?].5_h$ڈLbuF=N> stream xXK6W!6`3'P6[Xhv)䠕h)y!)Yz۠h.Cy~3u6N)aIi񡃍|Es5oEGCZ{Bop={$v)>=c!u & [' EGLҸ}OeKAf_Pg7 :0$O?qI(KPB_ hYsqf L) HPp*3G4#]V@@ HL@L[ԐwI >G)^,!q*3y/[Ҏ( T%|i9܀3!AhpqSOiVT biDe!KeˣS]6f,L!5CqqؓZj|S:{_ ]z$3̨v< r籫ǴB mce?!p,kɻY/+s dZG5>-oE @K>Y*6> stream xڽZ[~-`9Lᇴ) $ $HR \i+*Iy=E-ag6Z/_^ūiUvQL.*5vuYT7]97۫6-L"\ҊXWoYUfxi}ίx,XE0[mN뮬a7z]ׇcєm]ɌjÝ}-յКη^=~r~7oJy3_@9A 6$cզ\?H;˶7޲PWs>î\x[oQK_u}O I!0N6i7[w~ɀͪ{<yS!}[hط2nZ +Oe9.ljm8{ fZKpj`bΧzs 6vY)1U 6Y `minՍPe ܕCDb~,a2KAz)Og+:Q&7_g;3BgFԩ:1B FuHȠg^fyYY#ly-%s4NԘ6Hl0&WVnO՚FcQMsS7cPr?BcNpX$qwF'Q*!aӂP+v/c 1bQZ s,ƚA 2! j'f{1V98fNN * ZC ~ $x5u&@2UGMq|OǦKB4 ݍAzav>&Wz-ߢ7"-7ܟg\r`ˠo(Jd|hdA $`L"fFN7(5@FoqLQܴ2rqLPVU%,̂@'Box,pm0H]je%Np 0Non?X\>oNܵ׉o/] h,ƥ;/S1jT1Rע@9*p:Etp{tQL"fY75ϼL贙Dٽ/\jDl6r[*b@Q̒ߏVuzitw)z}ϝ Rj*h+0}0T=R &iD?Ѩ㠝@(>WUJF2qy؀.P>2@Ylx]Фx> stream xڽk/k3E>^"qRĘ";3˗F8pK\՟n_yg\JVU(QJP$:_WJu7hrRp2=S:khO~JE[6ZKūJaMSe}ho>8Mn쏆(zJB屣hth`&8na]N_HMm]QphZ r8+>ҙzs@)|RJ@ܹvdAVPg"Ao@y9Mg>o𩃂^EۗKU~X2(v=ѧ8|f+GCGDA NWե奨{TjF2﫮9Gz$ Å@+%3Vk\ j:u,wG:+:CcG5@U*:}m~f/PQwc|-)4;4 jA슾lM+PvjB"Ís_GجkV-:Ї֞H!|t"8r.iDY˜iEb.Q>υFZ"r|0|\i}BD8LE]T]sH]M6sfd`ZdUCp#z $Y #_t:r.<.DGĄcSD"JW#ґ0EN~e\e)=%J xԠq;P_)sK`*ʦ#}•Chiq:Zx:5U,٘LO53xzM h1=%6 ./A? W|`Q`v=eoA0?y۫0R Zf*ApH*NK@?ФcL$Y2׾B&-0" S(N&1:#N9!xTemlxלem3.Jp=)`:ZK'[>HE 'K'Π&< 6#W\9 OLEAg`6i!(& IQNCX0)B̀TYz^ "6~$_۠Qh3 5|81T?v{K)B@H\gi:rVཡR * pŁYY=⾴4,p6'B6Wtl 2xWw >/^/X\œbAVa΢zv8x87YTx6=c-w|Y(M#_Bh ?wF[xY6(i q^OՆ+1kYI\̖qlOIJt bYFu#qዻҟEGAG `__nE"`*:;WicG౱3ax;= +vZ| Ix2Ptr2E 6cdY<ZS$cD5jzJ@<jO-Q "Oab[=Ʋ;w"xSylhI[s(n?Q2^/}CPǞ jm)3Kk<51W q"(EfJ'kе4t9Ċ&رƢŮSoސuȳܪk2x6i޹Q|\tAKb G {"h5&0" T-`Œgr5Q]'nG 放NHf#ۣ.Xz@+7tr!xH: ǩ4uc+V˲9q}eQ)ҎRב{]㍔F7-8W_E"ԋ󭪉\S7=a:=*8tm\dZ=Rǣ8ɥoLD8S.MiMQ7/bh$bc:2nKC͛sZбҲ!-> stream xi cT\ C-6:0%zDcv'|$%y4^;;)ݗ~EW{՛QJIhݯUtWDݬY=y Vb?޼ ŀ2'UyE{?_]|J=yO4=]Sy^ESe)+Yd6Æ%$khY)nЈ>I@ZȎSSwAǼf@ 4a5J`Qv0.B+Ј~semIB|! xb$x]Ļ,K'F܉% v .Q$?FʚE]'MY6?M<'n6w'Q̽]u"3OYbaeffb%2+j@Gγg@X fMd;R}+e7'v[yS]AoI:~EǍ xѧJ9ED1\IIu.Zd6$Ȕ_^ǫHTM.Kr[]wYR t;RRGfes),Mc4=Τߚ7n3P{`c1Xke>d;GVW)lnHD%{i#HQfd_1ww+df"N ^0Z㺼~!_!ڋ|%›{YˢQSퟀϗ5JJ@- cDqd!S?@x(b?ѭ 3M_m ٫t cK_/uќa`Ax@$$RplF~iDt8:PQxKU􌹞J$ ٧俤uZ>=_"Q5CC͠Z \BnȟFf"h¼K,S2PSQ8ҳ"g#v8U|,!Idz@p^/Q'#IS ime3l|\gC4P'Y Whםw$ :ifIb-;16c*5㔦ـ3x^V2Xد#.@ Zs 63@Y#R9C]J;Ɉ_ϋ);jfX&ǔ9_6y퀮$(s Q:wvl ( ʁܶ nAf S٥VZF$Vq˻'R` ԥ=@:=:Slz[5{kDi"'1t/fE/j)9,jM+j7ŬG*8QsbƒТ㙅 I@ek\16(H7 `Uv n o&v`Su=ۺ[A:M<ѹBZ ]W,fΊ݅shlO ySmCdv⣎OFU7Gzdd7m{ݡJ~1xKyD q4X&w0sb}nKVF]+׌-d2o} 6 |ȴr+$I ^#N5_?7Iǫ.ދو\_ ~wFjM2<琖[x$s1s}+ <Y~R>S pݒhG 5M7>` &+S"RBp_HGq'@qdC l B'%;=xQd^@PK.Os.P>8lyI/ O@=W;e/sˡJh>ϹZ=ģq*x}|Q6Ǐj檎zڒ ڿ*uӱ\j}(.ijEk ]hfY̵g2 Ht'ݼ\;xsBJԵltۏB:n_]^ endstream endobj 902 0 obj << /Length 2361 /Filter /FlateDecode >> stream xڥXmo8_aBE _k-! =l,ӶZY$9YP({ 93̐O=0,d4^LL$E*\'x2(8T1pF ȱyԪ> y6Bp/#nWWzjU,Y3N;ܻbM9K_̺nM;UzFiR#p(S=]+cDjtUm[D+:dܬ>vFaiV`Ŗ9HnYL$iÏ]mW䰆}/ȋJ͒8CW=GdЎemҋDz#eɔ`0#SD<;@e~Jq;E?װYVX$IQUوS!K"gMMW6p{x(0p 1z/*Gz$>i;B8p).i /HeG7YY ȝi,^h1e#NIA h\t-L5l-_N= 5@OR͂.nԼ?m:Li0ԖJ20SYž! pV,FB0& S9.$&"|7*R DS Wz#\f͍ ʇFg[;޷Xz7*U:vNHS"o4N)I}#L].8!"~8Ԩh]@z)w< EESşVālJ gS:mP$f܆0A &UTD69H" 5Ѓd++vDBzBjm oi)VӍYJݖX 740XQ vCtc46;xlD :W,NONIN>wd3A(XҁJ"xGEצor:)(-Ͳ+l'Zg R4z&@oX|@"E "px`P2rm#~OQNE]~&pO=T|m-Xp5z_PQc.CqxJtJ;A r_xLnӃ߂5Q<*=1;W\Og4ղ[X^KjW*^}TWT1SEئ*? 1buɥ$_Q*G㣀6"|ᲣMnU=x/Zp&`}ʹmkMcXb3ˉE'CtΜwrJp8L }U$/NPm.B9QBr] ^v5q=VB\1|Ԥ(>b'Po)~mكrdŬ2vϸwQpqnl;\u^,8bn+=U>7#Ն?'l|HG3ЛgB endstream endobj 910 0 obj << /Length 997 /Filter /FlateDecode >> stream xW[o6~ϯ%%SW[ ˰`t=eD(K,;.k!ssx _~Z^MI4 gY8>^%$Le.oJx}<Rkw"0vḁ%ep*a Gnnnی2xMWkE"xCi@\([Ҏ/[7O1[Rvd/HrWj4߭hbdr•U],'a<P`akAU3L( ! Մĕۘ~%ޢEE2k[*BD/Ć!. 2>O ܏](zЏO&+M |>fB3&.? >jRٰ|?$M9hȋ@ň "?9FfVFlЄi%"!X }^ /Ϩ,%aTUMBkj*IuKmZm)i{LBetش@ ,> stream xWKo6CրEHN{H5SIRZ(;I$&H`sD gy2ֆe|xq##Fqmnؖ\/0BFvgo ȍ}$x7oa)WkD r `AIN;===3}ZwR;2qC$R7$Y"vsT]ܰT &9mWqR[[SVbT޿|smHR+y-[ɣnY{Aj) 7xgM%vVx:?scj3ؿ?ח֬?86hZdz &g $TbKV9A'lL&{Ҍ9I糤Pn(VZPnu&^x}%4U*EIQyȋ\͐i7dFk#74c5 _δmYу=:c>|U|~*Jm<gb Nt'D/ʊ}U+{[ՏN:|&Nk%n{$n]nDph.?vP0 ǛP2^z>XЄc z6CK&y9&Ѫ?I8|sWTW0~-:!v\&)_VYׂh $-g'Ķ-#?r͑XKÃz~On.1X PEO,hGn//炉/.Ex&?J>&>;(OqYFnHr]ws_6նJ;Ώ37DC(63P0ȕu; 0'mdBͅ |d$, ag&H*Ш\(qܸõ`tށ&&6x O(1mqa}#su徠"/pdJTݖ +V'4O՚Ӭ9{:|uu㍾`: 0̶mWύ~Fy‹q0ÏKP1gcv"'3@Ф؛x/0TJ+L,U!)}gYKr !&3;Jb`J&0K#L/[R? rM¡b~ G'Ц .BVJ|h(|gWY!,tw/n?p|an[/3_7O[ ,O:>a; endstream endobj 932 0 obj << /Length 2413 /Filter /FlateDecode >> stream xYY~ׯ ;s qɑ! CsI1aSU=5]? tW_U_VW7`4Rv' ZROWNno>dvI'bOlE[ͧ崫HrG;fZ :dB`]dƔfw۟me"d9wu:z0 t>uՁ9׃)f 2mw}1L; Oli-Vm]_ }CE~PMK̀4vP ao}ՙ3W4ҌB)YR|$'x>t X7ع?R9h3hKn OswBo/@</jduI'h$բ;ݼD82wtF@GiLRuNRH4 龢DЙ(vAUU /laIYzSeOpYBˮf.d>'SuѰ2Z `dtQ >HNun ~׭4XPmWdDfXO󀒛dLkLKT**:ou 4hX:b5JKU=f[~`hRLlC;g]d RN /?-P,xmg sQY`s VܴD۫IEolA Ш2B\ X487BU׍jogNtXp4AIw:ZZϐ3hM>꾛2kGϿVc.#lq0Z_OwDέ˙iCLn;R/#MkhdgzrR>e:5 >8PUB@=d<:KAo8 q3| QGLd?Ǚ ^t8rp"xh r5+uےLC1~L@vj8 sS_ ?N/!5!qI0H,Ԇ5"1;\iS_/=O}/AG299 1g T}77,X̯wIR237hcxO9I\ᤠrӔR &f肖.9@!$ ɛ؜5i3쎼MlcZC 1GI[Ra4 ^4p j:nښ"1E=}5/>% G^DžT?g ֪_%ɖΕO O7:Ú"7'Rq?I}9NC%ww5s5W[/LO;O뢲XqI Hoc(8 OoQ( /˨(zxsp vY!ORFIo>EIzb PL( R`4j $0N` IM%J#ׅ1jWöٰ%.H!Kjt4w۴ ; @CIUA%JH9*A0 揹E>/"m0T[>^+nRE;?BrH}C! ZŘ< I)i{Sk &Xw7E*.D y1c XYgP.̿$]mm16VW#ZgxXk `\\ɜ(C᫿ZcYQ Ӈ(MKW0="_\ѬFEejءP{`&s!Tra92 +L( SQ ?+J,C@uy]ހ~Jx曶8 Բ~}_c쩲 endstream endobj 945 0 obj << /Length 1618 /Filter /FlateDecode >> stream xڝW[o6~0b&E]y@&k뒬}h@KtF]QNa?~R*;`<"ϝzǿ^]~4Qj5&#x|?;n4zn~xN(!<<صa+ "c0I;;Omy53<;&ɌH`*SQۤk:ٌ,I.ͮ4KfY|i%*3a :۵Z/gM\ 9b6o}p_֬d%s)V&4tQ T"5aCqD Ȉu-U^d+Eu]o<`DoR[La:}F<F|zXSM}jT)Wyrcr:0g'3i˧Vd\&"KI5/[K~k/t 4~Zg5,D"=VK!n^( =v8%7 l@$Vu}NM 3/X-k\f*9ѥJN<#BOH%O?F>p}Ł=|K?+i -}ՉD[K ev >wĞwb}The5} 1epvaMv-&E)'ڐ:_vvΒ!_7fy7-kJC,mNP`za(royކ˲5[W R( nj_ ȳ{Vlr.e~E Ȧ C(H{={ CfgPJymF#C`43Yi b~vqD޳:Gm)1AAr0m/O~)uBI08,O9Sx#*TA\\bfjFR%N_Ub-|}>A֦flQGEA௧L67o0e֪ۆPո[ E89;;32g˅4j0tV1dR(G$E;ȦXº+"Ԁi{Wꁴtu'& \ QC½v>+^ I\{L+t#L dR<t}g"Q> stream xWKo6WI@%7=$dM92%wdk{E/֐gy:K:'Ww7Q$x-F)ȉ#:wsțndPFdi>"˄Zx=|srRm*615(1R~FΧKc_'Y]ITܖTƻa 4K<ZIhUdDDJM=3v&ԭr\iD\fO悉\ = pteQW{KI(\ T+AV]_9 R}Q Н<:>$MD>&~4/g.,@p0G:< Ojpk+ZXG2Y}(z_j]@V.yP!d-tS/`k~3\4PZS<%Cb. o <&c'H@̤[aZ^[2Y4Msns> ,},/FYcGH⅔NP$6B̤Ui|hVѹjVKZWmA9:Gus]cb.tE}Ȑ8۰l3̮Nj@WQ51q5o=A\З+C^fD#߯"[tFr&i:AI&;ACYH iޛPr/g/R1k>DSS"D7 QAm-$boEh,:&(ѠL?3*bG M0:Om g>>G4df*;^B{zmS}50=a'~%&ԙßpih֕@ˏĹpn'lTzW < S(=є8I vۼ)ܟr3Ӡ{Wp;fZz/+R՟d|7ߧ݁Z,AC1_mg< +ꢖ%J5o.B{^*>뱙4 Ly_9Nr8ܳq6Ml,ttC6d/޺!پxPfŬX͸I־7?nQr8bA[R'0;v} [ endstream endobj 854 0 obj << /Type /ObjStm /N 100 /First 877 /Length 2069 /Filter /FlateDecode >> stream xZo#~_\3$g #%-]=(>ŭ-K~Z,[Ր8gVIN1E”Eyuc)@MR+vRI'Rɕɕy.//g`.ƈKv1,8N,D*𠠩Uɶ]Wu`WY/;_O CNz XOЀamMyrqfrgS׽rsq=ӏI0?ҽ,n糛>{1~; xQ`DU;3]b-zwy[,~ݥV'e`U7F"Ɲ#'_Bv(S;\ByBt:냓a72k݃ԯtonY];_,ϖ]O 9n E#xP1Ã="^|~㺿,.sq96\ gEo#$R"-t@PX^Mb< b_-NR$[.<XC0_fe#7[UWq1G!v=6zJ,G/ei yWJHHՏ^ ܥA2x*A}26I= =_qLT;1Z}'qT>(!9F{a~5>08 'g tɳP \(|oq׾E#q%U< hzOWSa9} `P0Ϩ(_bfWݷA 6xvk)I}i"m@CoV?wzøy>t䳃Ear>zk1G붔ڠ-tNNW立ż{Oͯ͟ӧOj~X,t\㷣IH)p dGVTO_@V OCHkOdmpI4Kڈ,I"C:Jǯ_wRuHyH3T*EF(/1"͞lbs+ 'nrys}yoch_%&A::AN endstream endobj 971 0 obj << /Length 1531 /Filter /FlateDecode >> stream xڝWKo6YMVRu8@i'eRC+ٲ"pHCחӋ8u2sq|JI*̜ҹ^zb8,"41e]-2-mӋ0dۼ PoVN6Q di`jڎ7u^ #.՝=ʖ|skj׏,C2ИJzi#uL_ytʃzűV ++k'XYfgzɢ;(M "!]-ӱ-/?@Yu ӳ,^,>E&*Kif׷h{o8-o ^UϤ^vltU793(gckOof`2X.~b) SB_q_Y4~|Rƌ53fFkowLΫN57L U'&| t/ԟk#P9I~Jf^U*!Q`Bpn4!t#TW5b@U1#b׊1Z0S'CvF3O}SeћqqU*tF!ZUO/0Р59T<4TſMT[qw棶RoQA>@}> dg 6xQ^ӣ 0)*(d3mv@!Z+M<3~lE$ ҋh;16S=%;P5UFe!E ȚBpt)cPR07d:!M9ϚoEA?:^O endstream endobj 990 0 obj << /Length 1886 /Filter /FlateDecode >> stream xXKo6WCe f$R{6EbQۃlѶZYrEiwCŵs)|Аy|3Cw[_ޅ"aIv.~<"Ygκh? z,a#$,W:1j` xyC, d2UMĦHGs=g DYw !em$|ɩV^3{@x, , 廼Qfiv;\7SZyba^zklI;d6zЍTƭ*rT?1<&z__Ϲ,]tgX'yID܀oS|\ _8_^W>m2 si5ϼ/\5 j"US75RT%2/wS/ˆ~TcU=]`EBi] r(4JQc7U uwV @^ZAd]WEYH /EU(ZGUȱ'w M-|!oD^^Tf%Y>2`S6eX2$t/&zL\/a6Aސ2/ǙP@m NqCm~b(ǟA1u0T1dUpյm:bl2m\穲NUӴ 4T[pDe4U {HKyhAa-QhvC[(>p~\Tb~TZK"֤#zhU5j,"}Խeط LH Lg?:_Ms: NgD0D"ۨ>8N47o%.8V\ >"FK ck\FƪKg2Ve6\@8'p=1 DRl_z)09`H&B'#=txluMty )AWmsl'R_mi endstream endobj 1008 0 obj << /Length 2287 /Filter /FlateDecode >> stream xڭXo6]23|Yԇmh{Cvh[,͐,9JF| t٧7\ij$!gw?EP$l|߅R$>u u/.E"G&R0ej`ԓm\ =i7t#L֙U; NɫҮ~[5]IicNVY8AP^F4@8H}`q|d*RڎM"0ijoK[Km`DKIx»۩>M+# :3}5a"Ix F'|#11P8 Pp.""~?2a%>Cog{Y]%1k*BF$6'[:V62gvTia %#n+pC}7+\u_g9A dB sI#ڽ=J,(#sU[;AΏYk1 iwjy&#S} ` }n7Q# $؇0rFa!rS u^4%'WH,sxD&y&:KnR7H;VUf]^nF:]F$P^ Y@ȜF?$>61N! ?E8L}IG=[3k"X§_^>.._{ck`8]Poܦ1(:uc?5wlfƒAmOz25 bjƘ76#dySHG&iƗjDڟvetmS1U>C˧[*&+,T2u`0nZutxK==*G*5$툻㏻> stream xWKoFW$`A(QRMQ2StIJJ}gDvbTr3|{+{''<RroƈE Δ7_x~ZfKI* H쯂/Xm0AB™f=cz[.擿'#\$Y䥛-fƋ1xر# rŪg {{)R\|k*u6AHLU.{GDw4ϊIkoBTyRY w.ov(ˍ6֞3AWg#_n~Mԋ6bH`a =*lz"1ۯ\֍eYA/KLI][ !I;1~3BS"ŐP^KOuF;o۷o0؟18G~?":냃 R I|!pmpέ!#cT:ߥ9gOx#yW_m7F w(c (VՂ0)S2|Y= "%V ;XwuTZ_"$~,1(t>`D~H6T)P(7%]9џ&೅}ݸK=4WXDA.a 6L>l*a+F1(I4PDBB0c-*b+;Ӹe5-)hcJ(i"l,eMrًxE~F ֶ=,xv{my$:w7N+[Jk`݊Ks r)mn,övz1I iۡ^3P=/5mڣJ#[Y490;Mg'{=!@u>^g| =b w72 LL5aQh m/%u]> ICb7nc0W15ם)THX_ɱ[]iB~_KB endstream endobj 1033 0 obj << /Length 1374 /Filter /FlateDecode >> stream xڽWKo6W!61Hm7 ,nawLjp%9zroRp746~|yw}kJ 8Yd-W˟o|ޓdND|(keeU2d'xlB1Fi5oDKe58xnc 0Be;Cjn{I7B/ܔ"Yzwiz\fJ``; EZ qXՈ"'a=GE%k@2FJ"1H!X(RDˠ$#Ta'rMLVPqC +HjD2:˲(in+T'`.n2||g?9yYfXA-3t _+]@[MqgJKEn>M,eil>_w) bm4ډqNMO*l qCH <60LȗUp=3t)m2|];as#᪩(! {#zmH Ã<1AEBNu2^E:#^eA(ûX0p-e/Os&~" JC endstream endobj 1044 0 obj << /Length 1484 /Filter /FlateDecode >> stream xڽWKs6Wp 43SmI L(RHɾwiRǡ>XroWo%$ к-꺄QJBXNkˏίx$ﻔD1(Y" רh$aNj`#k]-?NttRPCay9@E矔";pٌ 0e/^`Cʴ-y#z ٌ0ǘ2}R-ߕ\R0qY𾼁G܂$0dR \R\\_E`VEq !tݿ?)<8qiS܋yDAu5ZlLvUBlLˌĵEJ 5E 0=&]?=FB,{x/“r)n q/'C[mNʶz9 QBd!߹՝TN*ʢyUwS膒quM E:_ǁ J/F#hb+,t 6A9aIl;эC||Jf5y Q>aUCM7~/hO*<߼0U`L Qeaܟ˷ؠ) 6zv-8{4j NQfÁA`}+Oݽ=/ ߒIiи(bv;Z9I=G4Rm`*p<.6P3=55 `qfP$3jXɕin8ꮲ! }2;y^a/yB΢QN83bN8$zt7`yp{'! endstream endobj 1063 0 obj << /Length 1471 /Filter /FlateDecode >> stream xڭX[8~_Q /vAj 8M6U IN 8}.szFgoZ YB gwQJF[gvjFV,! "R}l;Pno2~晖\)DgĈ^58|mVM{^dsB$J9*ܓG>A9rq"iЄ$fBqz#!ֲɑ&~u$qNyيy̸S|]X>w pDNai7ŒEŵk%3QM )u\Lr.㚛0#\D^UT/ B]O?S'o8Ìi:3P)J:㍵Q4l~K;^^dtԜbAriAEvXmM3{ǭi:3EEc̋2/w{p0U>n F(lp+t'L'F:$֧J&ΖF|Me}7'+J%s0ҍЧ\7$ rH<.y.*,)/KL`8R$wy;*RhЬwn g#t}]1%oT>Yb+)7+g|{fpB0Z8uK(4fJhfm$v6D6?E0o^>u6ZoՋrߓ^\uscӠ)݊\tM\! |iAA Q7g `$F28ȎB;NK {a#U##qe;kŹb$&>MU@"6:6Ը $I=XVhy!ѺEŇT=]%d| YPF+lm?"݌8uYD"h'qVKW%+KcWo)竊Mj[7ICH=cg0]eږx^K6P_TfGgM[.RhM$ /z0O4ms[ joiqev UKj%,>!/IUMd P׶áU+%v @m&`ڶ272L fH8@,H5BM@ <,{8p@); ~fs?OFm^] endstream endobj 965 0 obj << /Type /ObjStm /N 100 /First 935 /Length 1974 /Filter /FlateDecode >> stream xZMo#EWtuUi- `I6ۑ=amcc'0Y!7Uկ)gJ$#b\p ʆދ!qኋ&x8l2%#M)WqI d} WU 2$ #\! $I B P5 wjsf0"x B4$LJN'// >KaÎBagK}*a!7@[R%(!#1$|&!JR*o >0,H¤s_Ch %CJ RX!spJ~`3/S" V#/C"Bb! 1Gv 0nr=Cmg-A@BFu$$TTI2"8RpQ݇$: 1YєI6yA{:P08)y(*9l:_`$ZIȐ*%շ٤֌5GNb%f/:\fMnȄּ)̡~wM ˘R󷓯yƢmm`6M`M-|0{ g!ן_` ;7p 7Pgo(kw?/G1߾4\ߋ/6aF&aZ\.zOJ qr6 ȑZ%ƅ =29;:X)Zd &<q]b2+lKe_^ob6$25I@ ,^'>"i]xe^>-Swl0N'ChIkdhF!%DHeG:gS{9?Xi=ځF:|l" [cEZy"GQq GlllAaèV &l )̍h񄲝XSVN_Nzі"͓iEp3.~EC"TsMezgqcZ > stream xXK6Wam`͐^<䐶٢AY@˴B]=6Cm(|ЈxxQ!ǃ{y`'>b }zU*Vk?_Vwh^ՖZ_߶my30L"ڧ'ѤE g`YK< 1d؁u!jL8b@ u),x](](>Ju=YQ/\T{UFx(2f(Ə$:c7(^`YlE/:M87 d79Jڞm+i'-('SͤǏax0ag}r`3JZ\ 1*9I?I=¬U gZu9 CLcpC09MpT*q02X4ێ`otCM>+^8BBՔc:5O'0NlC'y>-(1wO?m}S$ڕ RvBO[Y.}mn)3k"I?xua"2TPWgY@ە%n (Hi钛vu q:T-vCPpLi~z( ɔC R!΅)>+VbE jcw1a^LX&W]1{u7Chz,.A<7p qы.[K0> stream xڭYY~_ڗHU+,q!:ړa7U$HbL*ק Eig)=Cf|wd4a;3DXt}dG7REI1̹,[V2~&|w7,14*Z}:|qDMcWeV,*J}VgVٴu^V ?yzP}[p< n=Fk#)Ȳ0$$x\pr.VCu*[W[*?׺7ֽժ.u>k4Z*ba:| jSۉuBDqʇ?~ZG,Iϔ!&!ԉgq[DnF,rSE)n$iV|>9 wҒPq ZDDDˮg]R3"a,%ۏ:}9ɗ !թPJS[ZL.;KN7C yA*Q(<ȃsȁٰ1x s%b96<1:axULޗ1խsr᳜;k,< 3aRu7G;-+NUt`11=GYG W!fu|0A>G'~Ѻ>NEVnIUȷi6#'~xRQA7e=cɬPwBa4!T6-ss˖zNԛFi]TԐ7vDeWG<,uuV'msS> F}PF>=Vn$&e* u~plRt A6P֐ nvDEaXQr;@@Q؀҈e(OR1ިf{$^djRdkӛ$mSÑ$AUl!.m]"ani=x '6'g;6'1a]D@};NXiѹo`N5mMuJ|2&R^uD >gLTtS!3AK3,Q:dd7X99E)6K!8؄7FbA;xL2 g|6졭kXϼD@$y-o=yD=1ь BiB ُtRCh;aP,_$g)qjr>G[@)5cKȚ)ӚJe}S2v*G{TEj\F!SAPٽY2$wߜrX=(r`CvybHvGPJ?bGP2GP|G ̙vA0C._t/`Ad_PD΄rsD NQm%^!f\ 1!(J#1pAe gnxa8S̳,!Y Ո;S,=cE_"}\6-Ӵ#ܪ..44{Zf#@ey,"8^Uv| 9>[EXr!oˇӸ~Ȳtb8-(AZE֚&4"E]$bߩpKoxC%ljhG|` endstream endobj 1108 0 obj << /Length 3844 /Filter /FlateDecode >> stream xZB0X>|u$cqڦWC"wb* Iٹ3;ԒQ(8}7# ^IEJ7 )DtIX\o?EYUq/y7&>JftuC ^K8Ob2foS!Ŵv,[ڦrȢB0cL Y5z0&Vkc[#o=Ru۲lLye_55U:f;XgJ,3Yq+IQb@x;^O?MM]IUej֡r*Q F!OPj`\g-;E?,-ă60DFEΊM4]0E>JD Ҥm6)ߑ$ۧZ@E-X;nĩ;WMrȳ6+=z v]+Uۦƶ7Z}gR:S 0o0 y>hmmwhMUR7PE/-9S. ,TjŔ ZZoqYYľiWU]oE bW-'|y"1Q<:SN_Yz1Y,Rms8Q@MJ]G%=n.qΈVdH5Ȗۓ LJg!1hH?T~ɧ&%EsS$p]M ́.1?"Sw `A-=y'![g*=;e~:A7 ѱ!c]0p#:= l= $H_16DF]$ ,!&N!ЉgZ`ۡxтP& 3Yރ>¸nZ0vG!e9`V|Eh2"G?YB92YI.\F4ZI{g>s ξkC YgP3ߜRBug᪙pu+wѺ`Ȩիznd\ gc2NnO $)q{NOv t =.v:/yӔ nDnA4}ҸKs1:.@bȝ˟:7 &aI*Dad29xHR]8&Jjn_iQ 5UFR9r8x~X|ދz^"Ms?oU9Eĩ&Y;֥OI' 4&ӱ>%HhZ$g̓iu.J@#b/g9rA}6HIsfsn"ڰjaN J6vf3qfC*N NkaEwzzq|+T$_*ٷծz Hī oXvfy4VBy'UQ])vؽoZcח8jxw3 *5DCl/.ň Y5O B4&Xk5BQ0'`oh'ci+\C]o|2Y!gYIQ X#< g)Q[?=)rW|N:=M}mG10CGE@F~Uj`Qj=t ~OuƂ @ʼn|rً<ܰT1uutѱ嬰:\ڊ4VNBTIڼӜ{3|leR#glpE@!c!SN/8^ǭfo}z6OqYTa:}yG[ )SBH)9;=$z6c8 )] C2>A+\f'0s2Dٖ"!ݱ4 q5nn[͢@Ѵoy珳eT3{> sBd)4_䞱@2Id΄'g+o,>oi,jb`ɇp%&([D cg endstream endobj 1120 0 obj << /Length 3099 /Filter /FlateDecode >> stream xڵZY~ׯ``҃HRb9J\)U%l`ק{gXY4=3==_huV>zի8[adaQ*R!DՏ?իDO8UQ:g?E=(Mv(ى fyth GCweU՚nzIp,oh(f Vy~xfV"ux )mZ;ZDA0uLͫ`)Sy޵ٚ+Zzz_籃!X85ewDz(J:y<]h`$sWem'&q&HP xUuj@וPC:;L+*rv:p Ģqу۲lfjQ?f L %m0^, }WxjD8j^S5w<3-La3+]lvmD=TՕ9{=[ uo V,hjvGsjMvq[KF{WZ*;L"ydb’ǟ/С=y DJ嗰nNWlAc͡jP{ֹ9676}C#/B3":B%is  j\y(sg`J1\b=҉5 VE-gI? ܗԔ0=ԂA)  zTe?Ѕ N ܆9+s4A-g#Usۗ8T Al)YSs\Z*,; 13o*"oP: {`XSPI'1nd7LE1{=z[x 0_hYo4 ]37^aKqk٦PnW v78?:E9vmVןisD♅;@R%@RY8CÒ}Q4u Lhn$•ʸl FH A])APa؅Ȅ/ey$>mS=ņ^x_ 2<b߂' Bw(y9Qs⯊H[1x+$##-{-峔EH pƮ_?)ҥ(:E}K̕[3do8rR,21l|19|8YjaKoDؤE$ADPA 1d$nGt^ʡ{x`gB+BI}YF:]$JU(i9vuGAnt2qwMs@ R~ r}[C雵\ hKA endstream endobj 1136 0 obj << /Length 3124 /Filter /FlateDecode >> stream xڭZ[s6~ϯtj& vgl$M>4@KĄ"U=Hn_,sbH?<:],B/.$h/ޜ}Ki™`DrTy9$v\"Ѱ-l%Ѯ]r]rMˎv|e?TbK>D}mS6ÇDqDD[%ڡ9.iZƁ黪Itպ%^a1+W67TX`Պ4k(lm>: 9,C_@aGIp6F`.930rv!6b%C,jZ@5 \9Pua{#<o{UpH@HOXCyTؓ•/03 z a:s"X9TIN]}ºRնm4¸ g/I@irI.O=@|\1pΚR2]Z߂Zt|Yn FH,M_9ᦩ{շnnIkW jqX0Ĵra,\vWgAe|v+@ABU[C_::{{{vݻ831Bő{ ꛥencq{{Jdu%3-uUj;\2ļ%z,;`mYhĐo" ,:Xk7;vGO0}ݱ ORf9/`<  LFmU`A[bPsWfS5{y9ҤW$;4E$ J3&ґL}& bHoESԷ!->!.r ˆ9q]iK*Uѭ'9Cbsb žmSJk-z$ь4b%Ԥ֡)?S"uvT0d3o)n Kya1d}u8>ŕ?f| ,m aB=y60IitX[e01 Vo>#SC` Ts p[ ՎAhs )L!}3/[-g[<2U-ft8`ӛ0'k;lCdC۩ԃȦ)bW* 9ǰ `qU”Qs)Vurl˸U w]N;x7ܔeGD'(0 $j :I6O=0KNI{ث)Tѫ&xBxm-4fj{Q oY@98lGy+Tl`w976:қ0߷W %uKOAR?) BGA pxљc߳k(7 DNh=5DV /}Z ߸_12_FoەE{0yIjQ(߅{X PJ(,_CN|O+~0Sܦ*x>]Wij.2}loCwox9?9Q>T|L{8n4@#dy>!lgLwG'LGMgowOg?М)+XtӣHAj! eϾ(qX} wnr6 endstream endobj 1144 0 obj << /Length 881 /Filter /FlateDecode >> stream xWo0@Tj\&m*;=`ƎIi߾gl@c]]<~,}XG3f`,rG g$99dN&#}R k=d7AD^47 wppn0]":z٬" pWleXq˪$tp`7Z iK8YZ+Iz-xx&O;:Dasn%dEnFz8ܲW%yNRe ' VZ>!v }%2PlѸpsjPۦ13V}ZPG\8+ŒpBmz?4`hx!YbR VmҠlK4뚘G&ˣ@44 SГ7]^ I{s*ie u s%֢bB%\<0@I>5 萄&DE\?s\y)I5]͵UJeoLE2B&!P7+=N쯡6 3EqGᅅf6dB) ^> stream xɒ4>_cR"$KފE<;xy=jI^ͅZ՛z N~bɻX0@pΤD,_7ES%﷿]N+.X2QI-<s$L"(.΃,~R7( ( pǷ^_p+1gRgtv0dY*#_6u׷Cowao"䝝>oMK~ͭ}nUi;}mNsuq}X Q8LtW/z&Q34؉0GwMX\mrX'esYVEyjA`|{Gk:o zZO[KYw= @`Y#MVOeMjنF͑ƜCw(0f"K>7ܹԝ#oet#ZiX;7m}oܥ+r.l/n=^u}03@N<˦}ޢNE},ϳ-rfI N::^_\W6;'"& e;J&6Bw*ѶȘцZi(yU' ,_> VidKcQDnjq3nJ{ [X-.t*mm/Fq8'hL+ +X!q%ᦻ<~I)p1eU䣦k p0m]rjׄjԫiƆ32@1&3qljx|fw::ToKrfSoXz4Yk7`(JiS*;\Fpr _Qxb0y;kqa!muwVs#=0G'W ǣFЉ d7}0Uk<$ʌI~+WP]d)ϩ#TdP*ruuNFqFrqTIl@_^ }S&FdqJyZ[d/Ü?:kx t5݇W9̚XUh\;8civWyk &J?J ~, S`ا2 9u뽍 y?KZz# ﱘ^0NB˓[S SI7X)`p}jOqo8V0'㑹ΕmRlOcܼ/sZA,"#ϥ#|HC!ԣ\հ,e)O^iB,mTh2$3;)b'9K-*5äVC /j 78JyYu5ͭ}vyA7Y??s<;##ebҏ!M'3:&LJ-=yKljYx̪d,RP ԉI'6B,cJx\s|p$KU}yߘݹyD xLSمulqu઩[uh-Hr]1ӹ%5U~HETO*Tj05<Х` JqHӰl""9Z§ s= ^{ŗ1[-MTy=)zZbît(Et(hm6z> stream xڵWs6~_$[Htz&7soׇ\lsNwI}1Vtqt0#'F1̙.1pBcg:wn ,hI- QcHyՉ`{bD:>箎i$r=TZ+| Q af7"S,k;öA5eVlK)Z d8 *Thi]b|J f#kNi|c#ϡufRDnEF̼H5<ƀ1UaG((;XϪ*E5pq@@t.۩G.w gEL(7)P?tQBS2P4|WFQAsRa8gXFˡz*21'qg#gVl_bv#'Jl[N>w;miߋz~o/A3<^W5[<0un)CG[} $Y,vt`C 2"F{Sn}0C: L64.ϙ[3Z檙-lDΊNep ;M]Bj)WiK gAFZQ []׭Y/7a}3-4_.Jw]c ~j (=hbbd~9zei RQr(Owؙ"@~9Zt@/xr >?ۼ@7XcǑa@6HP22,5haqC>XF%8|d2>5!;hZKf_FQy{񞷗1EVInjz|KVb1,Sp[P ܺgc, z-JܫR}_> stream xڵ]o~/yy"%RR{h\>N)PZJ}pH}YٛQr9n?ç/*ڤ,UBm,&朩0nEa䖉b~"ɽ(,NIDxw{YHW~jzKN9BfuYǟ~pGM}^"(bI(R)ݰJs|hss{s28掚\*TS\Jo̡i|E%臅bRK؟k_Z--8vXoҙn/$z []Nu:[ Wlu^*7ݨ7;}_-[6ds҈8S8"3`F0g; t"Nhϲٷq8m6l;\ZK^N0l[CofWw>_Jwܚ_̝5w=?owY}/z+B;w{Y7YkO"/>@ d9ˁZi 9^Ug}J|uul$Զ&/T2~q>Pڃ2]Ao144-2\SwENӷC"(o]~r;͆JZ{gtOe0xe*K癦8S!#镇%uWPG1S2kkK7G'JM5V/4  Ņ+t캞ʍZ2/غ xlL*HIRdm--:G@ڮ j d5e-SUfSݗz>w.ķk4;FÏaD<#SfwgEYxs&T($>7rm"7乢֙z+бax^KAd#(8\[p<$ks91Bp9 34&Nj+Q$L3>-8Q쑦ıKGۀ Rgx!>%[nVN& SW42hl*CtC-rcT %B5MrQG2jM#<akc}¢!B| Dhb|69_Vpd*譁DE FS F <,|Õ9K1we+ǝ9s5rz7p/☥\eSܵ:Wn>WQ,p:wt[:!n% zaVӺLg <]^.L1̨cr{(>_1B%` "3!Iʡ?9V@a\|BgB:0CXIwv{ckzVuGģ)Lnq ! C$˅L \%J! `hmXrށo,) “< n >; m1VG{tbg\0s(IE7җQun ݋a> T=9oB2F c`肸]?GVCnp…뿾pNc$0~۱L5H60==3 qq"fzF\q0-)KOnR^!(9A y ZIȉI# HM+"f# :]@[@ׁg-8M  fPml ia{ lE"[FJ EHX.d |FDͧ7p*ˆx7@Vr>`-ǫ YδߞX~ULU5 0Z4WCYFrR}EH/:A\kE@)eq(pAyi2j{KہM_.`Gft]8M~M۷twrM]:ApNʗXmf endstream endobj 1071 0 obj << /Type /ObjStm /N 100 /First 970 /Length 2076 /Filter /FlateDecode >> stream xZMo#W> m(1v$@KԮb#\_WM EvHrɩzUGh.&#Qk13 w/hÜt@FB4RĄ:)E9B11$٤:(&{,39xST8ӏTq-aR'@Wxb$)ٌ8mE@M[}Xj7jm$yK)-]'n o ͯ"fKQߛFIiJ=IuHBqto~)}qS>#53J0!xSEز烙`vGޭnr;)L%N&H(C*rR,:j1/oCRd&,I9b6;Y%^;@U.uc'6©^wdP}@(n@݀t0d%ATaV{(bKq@ԣY9k =#Sgq:m8=`9X`\I-3fionA&Aa\6YNz2C%8 "gȶYWPK<kUXt; N$!0~t3Eȸ_b/M@2ڀ]OȇFYj@EPrܗ BG@K%h"ZUԢW :T(*'ru OC)Nyε$Hʗ*};2ΖY$?$X tK{=^b<Ҭbȗ4Epds)=!Qaqrr.A qDŽӂ}rI^qz ^I^͛CJ[m𢡊MVv'$a.>|=QP6l12 o?B) RdqȂjA"njD{'&Tɇl6&9\&+toCuzҽQ%/ѿC›N=( >d5ֈP^e<z4^4<:Ŭ.J}z@϶𦪃L/CAwSI~7q}D>MlAΖ; m ?OUXt@/{Jf{JSI^d=|1` )))XAaZӆ,rӥֻZz2 +[! /S筧í2T!DS65y}8^2_R-}IR4m&Nzԥd(J})h SKB6WIo/!/KyHGmcsvo4+I31PD$:,- endstream endobj 1190 0 obj << /Length 3275 /Filter /FlateDecode >> stream xk )"gE(QjIkSIzY(.k5^ɧG6_yQdy(Kj8yqamxͧlyFEQtc 87onS3m:S6D4 B7Xd'4iz_E.k& NEWp, }<:綪{׺Cܦ,u{A u#x?DI‡|<ػ?`_GpV5u $oUqha/ZAp[=f A Ex?]>c53>Wdmũg|*Fߣ Uys"cgkohp [ CqWwreCiGIZF;ڸz !xb0L|Fl29.>Gj:#@fП dйRΒ_9=* MvQWb+4Oָ {L:@D DzDS6/tl2Y0~@[)_0> Su[W҈N:p.]%ZXnV2R`l`ĢAu|xlR>uNcKN`F:K܋I@: M.R.G+u^ߴR3kfBBȎoaFa䥔eT|FMnA8C$).x>MB ^ WI,$uͻENEmbP%&%f`i|>m7~+X>[0&1fT^#5Ȅi|1AmSRYK.y݃X~"0܉:qd}Ԯe Emɢ[D(lv?Y(d+'[0꣧l+WMBv9DzaP#'<0ה; #0J(6_R$G~lGSJheŜ^RV #M^4H|a9fn2 לVOZ h/- ciA++y%RfZaX 1.%hVo'c\b7$J}Hj{.={{X0C≫UƣvxW ġB-jqޏ8{riM"|8ݚ$o# ;w>ֱyS(/U&1XI(Ws_q_b)"j׽2*Fq|Ƚ^''$ :.)G#UޝKY|0; ċ@(!q#WšJF˵[n Ycbe\TbsI0t+C3GLK(;¸SZCdxvq:a1:n22|Id L@gʃ?9V*\GhY.Bk֤>bɧK>3X+NJ'[uC :!a,\hr/R3؊,mϮ,46 ^6'@ O7PzgYPSҕn<$fk?u#u"/",DsXF:5]xRq Y$,EvǠI9 PD:ޞ)F٧bn1:3wz׍O,EY `򽪇okC}tZjS7ɹZED?{_jEZ ,"dݕOp:ןWU)RW!Eԃc\>@^OQi^<ҫSRwEnb g՟b|/\9w=_I3%cڰ/#3J f&RCTm*}QPVrLC RGRg \g/r}`}gD}dµ[nɩڴW-ˇCs?T eUTom- c]b5;Q(G0:ͧlR9-¶ jՑ+-4.Ao(H=mL "1E)*ʥL{ʈ? endstream endobj 1200 0 obj << /Length 2482 /Filter /FlateDecode >> stream xڝYms6_I27Ԝ n}sniڌk?8@G"U )/m⍋vi:ɇW?\:~/IJRr>a0a:,&WA^ӈwS_཈2"j^$.yE6V0W<Ȗ5zs aYJhdy>4 څ`1H"XZGIwkzʒfRek%oY0(+7ڬU?SUaڳ?"&{*g^(DJ->r3 lj]yݔp ]/Ucl5՛ 8e5)akIBv*yLMV7y\-5_UZ5$diCUS"#b7p +}p[:+"r#+P-ۨj}li{֍<;7vJ֪ԥ* Hǽ%z_]~(9 :r4sɭ}E{!x\Švs/$MzAM28=;`@CS18RY{1vˊ?1GCe{j^f:}e# Ge483 1>$h#{rP0NU.J7.o.nlDHW;^Vӵا,!8V֮$a&ۅ+P6[ d[ݨu ۚ=C1_wa7QQtV{)M@aNH,"|GwWG\ `iUވP^nr:.&P`M)Ie>Y%=70|lй.8!Y/q3x8:w)u4Ǎ^&^ ){yW3UWQ*3p"KcxOS9 oR]` eTj7۾E$i'[eqdmJV_a׃ebKnv(by]lzZƥ+axEU9ޞXeńQΓ=L }`uطC~ )$143f_x(`P2(Pzf#w< B?|xu`> Tcfۿ#t'~B*IJP)`Ǫ,:DRb)B2qٕ{fb0 (./Q_jj{Uu#o!ռZ(rh?KtiH)Ӊi 41'\(W-ʛ`FIb2<Ǥh\"Հ]ll$Bܹ,o޼tTP+8.k)|XAčj;bOmUmz>P=iw@Ŷv[֍# ؈äͺUV|ըZi_|?O7in\vf\k7xgs7˩opi7J&4kWq),Z//t׮[J6p#_&MY~m$9Zw(6o20oW!qiTzJNIlwJ띒8)iJTx*z̚fiY[{3bG$26إIݪMwIĎ'%ԨixCxn}\#EGgIνa KhpN)5*^/mx<G)DSAr7v`pcRX~47 Xf. endstream endobj 1209 0 obj << /Length 1642 /Filter /FlateDecode >> stream xڵXYo6~6j6#R@m7Fcpvlgw 9$?m޲? .К|faQ&[wMl͇n8w;N@=l$NҊ㜁wr+0&Oϑ',NG ' dJC}vv6x=,*QTWT3wuGQ-%iEM%Ë:/*U{NV\{?׉Ss8|;%J0M  5^ R#H)*G?-#֥&E@56l70wJW WvWr(qBvh!IzhgP#aU#Vq[1uǔixkp%sԑ䙮<;<(?`r=¦!='U%ZTzoe /1UnP.8}{g]D:l ){z0ߔ}RF{mZ@ʧ:mՑKꎗpѫ/dӺݭYoL1s21&r- p-TvIGi"h,9< (l[ya^H|Zj0as]Y.$p1ǧ=f/A 8.\ ݣ{{HiHMh݌ 'FSWPq^p -qC 8G!tYk0)U%{&>`@-FrS`gH!&v,p7lHˇ:S /?d[4&5&@ˠP Ỳ|)>'"UE mc p ̥̀\i 6hwzIZmV *T7s3 SՃ݋{ܣp1nYI:N4mdf[6)u#0BH endstream endobj 1220 0 obj << /Length 2983 /Filter /FlateDecode >> stream xڽێ|q^xDC)Hy9 -Ȓ!ɻq3!u7DoùaowU&D%JF&YRDgz7&Z?$Zlo~Wb;Zi")R ۺ%&)">榣Fh͖ti[ $ǯC9eS{Zڵ!к (W%ˆ"lY aB%*Mu﹵V(xr5ؖV~c)wgE:J䯃[<oDeqLu9b"oN+gV޶hP׷Nz=-̀]*ΣZs4y+jW6rCθ }Rh-OhU"(H/ 6a ΧtE4%B"j)'lW$ˍ o׼AA-{|]6HcCmjM 5PG4F,ln[e~N{5}\{GMwq6MN ‰:6M!`%Ve0L:yeAZԒ([(F 2msG:xUOeW&mAt`T9S Cx%* |nvð!^H'0:D1_K$n;ĕY+L0 _-KAj*BfĻkQX!֩sK Kr,vYqo砰~}gZbBV#ɫȷg{? r=SYLE1O7]/)B qwEXxPl &$) apޜCW[L&`"OUB =] F֮!Ʉ&!M8I0 :O=y@^LC.Kfw77QP ª/88IQwNaa3Jf]}^^˞F a]ޞ7t75OG޽/k$eqPF7`ޑGY#E]>=kŶ7 7AVY+|X(蛥=!bKBCG=WU 5wE{JI9pyFNuAX \)M(ҫ!Vpho('<%HWt!1orsrcN|3N>._Xe_/f%UIT Ed`:EX:x⭃];.t)?^:n_<|pe({@%i"CAϗ?.$=Ї%/{^}uK䟼; +)7@_Ne9ZsT{q ˋC9J^bRa ۗҴ;2B UV;yK |{z endstream endobj 1232 0 obj << /Length 2006 /Filter /FlateDecode >> stream xY[o6~ϯ0bf3EȤ݇>(H."K}>T$M}璡]0^$$\.6 F)\D)] ꧻo`SDB힬*W]W2\\mg.irZœ^qv\[uZ6~T9.Q~¥]KYpQYkE5vXPfգ_M|rKVյjvUi]fWN Qk0QVO4pŮkZ!]j}/W}b$7B Dyj-<1,$tX1_6;Or 7v8%$^@۩2ea@${T0jُ젪.Ό0M>-)YKZ09o${KӚ ~Qr-I%!O0L}p*gn0Ahz E$k+L\M^ΈaO5 {F*CH}sޓhE5 xxMcpV)gD]ڒ\) eb̑y 8y8$(\1pa %zwSWU} c ETxNOŕ,- 5 Ihe7# yVa[]l#C7 BFR,Bdϩv|k%\ϵ?kS5pr G1py`9Ԥ:ErPz. Y6P%AN˫Nxr ~#"<1œǕp|jW|Κa9:5 +v$~eځ DĝU@%mU#Ox`18 &b |yXLb\I0ʶ}ک9|'c;aGզ~T߬F-D5(䆷/U۶5_^_%@̴mUКŀ"AmWN-@4 ,K,ПSFmg?tjM'_ޜy|uvWkb񶗠v=\)azaEi~>2vUg~qp!ikz;L1H_yV,N[, 3:Ju`anh'M˫=~΢gk-&4Q)lC-gdY7l=^G\DŽ'Q{} /Ɩ>qOR<_܎ζ0^K S7xcjC\W͆~ endstream endobj 1240 0 obj << /Length 1398 /Filter /FlateDecode >> stream xXKo6W 8zkQvME]lrk{%:*H9Wd'{p8~qhgqp?; Eb'. 8燋;]cw0X9-Ez/W7A<;Ďb0+U=Ս-bЅ@b-7>O YnWҞWbZJĴѭT:0+*$vT kkVEuJz-qtc'YZf0.kWQR_xM 2q";H ~vͪkHeWC,H$rh̻NH4y˖S% Rq>>3[MhzpS-mhQ:C!v䎚۴THv%}ـ`҈q \m )q(m&oBs7ȝ"sȵo4)F׫@Dk&˜ir py Ґs.I9.iFkwf|=ʴ'7S >fU 䩿SȟZ8 dtF+u=ذOm ӡ=wRDĬZVO>w)ɤI㱦I x5^&;zЬfpZ^cf<[C=^_&[@TȦs@Q崦U6,Ai[}Zq۬sRz,}]X~g;&^.QS]UZ,C lAUݖBtZAZU2_N|ŗhR_bK@UE3SuJIzӇ`pP-7Tz\]CquZpM+aUO4m8uvݰ̈́g{xS;I>l IҚ>;r)0 hH]Mx߸!o_XܟfKAe=7I|w/j endstream endobj 1244 0 obj << /Length 1131 /Filter /FlateDecode >> stream xڽWn6}WN&͈u+nRHh$e_R$u8颁cp!e[[˶~iuV"Ƃ ܥoߍUjq9~}xM73IhqwRq$mnlÓZ0xznmp1* ϶+ ʒ?mP ))ǨVDN՘|_qOJ8sʔP*=)q)7 _@DNEzb&Ց9"1"Z^xmĉS8ŗ>C ><}s0v `I*RE:#6rZ<ƌɝ6EH56*i$8*m]WA RBoc1eMA3zĝjW}3\^APQn`希ϲ|vG٦V1ÊS7VөOqeu! QCIBrbф-b֑imGh))C>QE ECFi-l uue@5(X8Kъۄ< aL2a?Nz-QH$fxƍ.F޾+3]JZAbx>ab5C_=$cLYe<:MI̷pD^Q6\43ߌ<4_‚{Vн*C_W,C(ȈZBJQ eK ~Ma(Z(Q(mln*wlp9pk*Αsw4g.nG7dvnhk*yىMWcӔww|g6 2M5nZZjZ 2GcIm"݋k,bnVr?Ka@N͜gM1$!XΚlNu,O4Q] ,ˇG>k.PB*4Fc'2+MaXBh0/*g:k2f#:^.XA7evr w!(7QE@Ew~$9m[8xthL<^^=CGg;@͛aޠ y7_4 endstream endobj 1248 0 obj << /Length 1365 /Filter /FlateDecode >> stream xڭXKs6Wpv*X4ߢ2I47j/I I!媿)2H9gNA:YiN)AĬVě4ϵȝVR`G)Nn~n|2ykې]!xY/O< c+ 63P$T}WxBUPMz(hP̭!0/q7Q h_tըK E$AIVNI6`${V >(Ϻxp=.yΏw=\<-fb#" (}7tV ==XV68*>ԫN5l !he6EiST*甕^Z!7ᜣa%) ߒpw:ك@ȀxDw};v}[Lè=~!= )8F* ߋŽciz)aG}k1q3Z ޞ?2aH|kue]$:܍od` I[BPs#@Uc,i3CUYջQ8e,b(N]k»o`F xjX^F,dm?q-oYQ #K56%.l/ }X % E +pDL详;w& @Yٞ7WOQܙً5qtQ=@r'{bʓ54'[fb%Y.TPY?8% L]꒼VAxSvϿNO endstream endobj 1253 0 obj << /Length 2020 /Filter /FlateDecode >> stream xڭYYo7~ϯ]=})8}i ڥ,"{({I}g82؊p洷Yy_r]2<^]W W8VM^{8}D)|7yS_"6 ʏ6*3‘ɌrMvy3& Ϙgv\o U%zIJ t=LEkVԗPYOmSly-r'[f*~-~$Avqy{.$NH@<[WȫTbyo&,ff*D/Ty9 CDxϲ(c+j]Ƚ~mYZM[YJﯮR@=fܽ%[ѲZT:kͺ+ְ7ǣ9VK˫žM.m4mnJ}fh Nb91S`jU d5l1/U6(˝l/Bڮ'A*K}ٷ$?5GzG__חA*>W;G tO!K&^7y\s/xaZ%v4F28ttPD5=͟s'tesrK@H*B (sfxQMv =qPZH[>w\a传42(q`$A"13 x~\‰9 CXrKv:.^|\1X91Y#%ǓDD,M rh.D} K|_Ĵ g$hlmhcF)A/wƣ@_KtME]~6(TebCyf˽qܟ_d47b$7ܙ];Z<'}<>&ɕ3.$gOh8cOhM2]Юdi ٖFnƷ /o03?wLA'$Yxlop4P=:Ⴧ'o | l]C3D`EX`dDZnedУ 3`!x?w,2tM{wQCIϟ1S"/ZYOYN]8ŻiPCs:EC00aɧavӑ\(ۖÓ 0V3qXң?AC7{uagYhd.LsQ>&7,A"GG3lK$$>\x(U:P;G8 cG?u?Y /.6F0:#99%0?9q]H觾ܹ iTGd*I3B>]kH fr6gV]-´HnjxNn&t t@Q Kx?1}LR-u28/QH|M%Kyη$:E |+5c’|<ǥP0P0†P&L-u2Rʑ,`&g^8YˆK^ c-ajVC[Dn}9 *wNÀAtF~ A4AA> stream xڵYݏܶ_C|:&q @ZVZR_P{ZCr8p6|Do}umlʰd?lDqmr!,.7mI |Er+Sh4poobJ0/` 7=MYěo>aC_LS^.0U@S4_[!D:v{gQ(AW=MufNL5ܯ=OTک޴}Fwo,|Ӝ~4"* ǼiFGܰ 'Ry7|N7, BYm'®[ꁓAtM44֬| M''4AL (LrmsxNGz,xb đ =aD*!@ , g$i{Zn4me =u,g{SPy^ imo@?3%oyns-Vq[ >Kwn>0Zn;$N1nqⶠqP]oj͌'7MfG㰿`^K>2' e B8T;əZ4!@: BNH+"yEtx矏htYΟl^PWD=?hi-2fX#U']ٻdy=GsyZ̶]vf<*2ok"2*E)ʲ/ѺQ4lwr$h$L˂Lܲ.b2&/GFSC nS] AXg`B;#MFX=m"nчsǎ]ix,PBq@Đф[i 8)-$F9NN^Ą5 $kJ lɊ\{dMFAXS!I!xBq4>U9A9Y.,sKp0l7>I>!{։ H8`C# bdhbC | @8oKG p ʬ ;Ĉb/j5]s܇R..35P#+NwڛNWMYMc{4=uܽyl=u\َ)CL 8Bs]9,AyY-K@ /dH\rv<]keymYlJ|g 9'Qw`YQᢆ=aj=x_O1MUt%c1VpޏcX-WG]2P@!+o2 (_q}_^X+A}]5oӏDi`,8qW]|uu@;DCp[ZR͡ނnÌK{d OJ(+Hw-b)@^_q=4'$d"eh++TUA.E84lhr"YWođ]-g -'dQ :):&%|& <ڡRT俪@4JTiQD&kRjXbW/6w|}MU Nd {1` B4S^GCv/ {k 9' 'pI<WK_p_>s~Hc9=S!n~}j[dOFdC ]<9X?$7k&L<:я iy⭥υ$V0r,k%A{z'^4Zޡ겋}&.zr& o8E2G..p^rX+l!PbaneXwh4ػ= n/9XT~0r,IH0Ұ, "eDg۶bECAWE8ņ9J!2gzKѝ\-cjc jnșrB }N'ZDp_q endstream endobj 1273 0 obj << /Length 3352 /Filter /FlateDecode >> stream xڵ]6=ȓȲ")RICڇf{CZdKk $w3,g="=C&|݋oޛd*0:XJau7co~7m4M"l`7g7QqcM ~ Cu t_ $ēo"VŀԴfSV0ި08eSH&J-RĿE (芾/=}|6yaߗ+Tı_JM OH<3g]w:9t7oAwQq$H4A@ư@jfjm 2A^t; z~<=* @G254kégEחǬRs;B4\<_t0`6{`n?BEf|h 3ٶA "iй(("~ݚ"N C OUiF:=rT:-Nx;|z3 [J˓Dl͑F7\'g*9 6Jh=hשC۝OߖYwkڶع9 MvꝆ3NY;RW`mv]Y!Dh⠻gx,.^̪!hmAs/#%ً$`BԃGsaP/N:EڙHhΠgdC-{Bt Έ 4AGxW78pO\-98|92>zTXM3w~cw#p8-V.Uq,j2DjhYp6xym' <$M\";kHŶ8@E$s1'\tC4bguj~ѱ3p02&y?Mc6`G.d,@.p@KM1$w3kw XM˗_<]؈J7ns0/=Lt'2έz<]SqHrty<W{xJ{!HR (FsgP%T;A!88Ⱦ9NVh|h)-s+ꮤ4 %څӚ#ULyf"_XFœFeN-!a`2ӭ}IShUM{/P*SM}-fLi zGC!5T~1=I&[f`wjӂ5}ZK]rM5T4+y q|A<l`Ewz^xϮ*GCV ˡC=՝pv|cCXjd:yf O-iW싺Sr h7#+iȩs[wt0DFM~A\L2\r}i9F|+,5^K,cÛP]&VT" $L$b zdOUJ%^d}OŸEx!Em(uL[,r\#H3\9.tfsN|Gp#kL45y,04%8ە"Q1UlL >c GeLd>Fmb08CLgqz$%ap!jC *3MbiBjXPP Ny*Sq5n}"Jv,vK2 "y]URSTK˅ bWMSS>ڵR~7>׈e<@ܷUH6pnlh@-t@/(\^܁mO5uˬI6^Tz8Ktk^U:c6KpzHkdKGc&!)LpHY,\H)DZn4Bm?J@' +8"3 t+3k, c覑XW|DLd[.rAZoWSkcHMƨgFPDEWhu&KPpiP/:[DIb;'>[s: f "DdDZ 6r**cE(eӜJ =9p LC]r6 O|h:W౹JǒJIIw!sBE?>RA4NTdyESA@L Ld屬vHuԊ.XngcadO 0R͢i|\e":e"D3\҇o".ZG U&KR #KŬUL*}2vf 0r#dg6vb#0XzlD%:>k5SBGوk^4+5쒕 'V+Xk6{x:KEƫ[JU)Xd@&](J>H =-O%y MF*0ZD;"5dMF !6OZN!B(,E[fVt(h"!@l1e`9/s>qA_ ׀=Zd$A@cn,[̅,)AI3n!qad&E#U,U} jZ"R N?dvL&]"VktrᰴzLNU/w.)2G q(:s+ ;_{{=R'Н!N(e'3竘9 x[6o.4)@3KJϚ4yw⿠w' endstream endobj 1285 0 obj << /Length 3029 /Filter /FlateDecode >> stream xڭYY6~!Pn G# Vs^3q~Vji8 /T*#W'n\e".2W7WRX'*26_$"ۘ4 6*/FNo^]U!,-4!Oozչ`A_c_6JDhV)Ue=b}y?泀|Vi`$Όשz3Cp$.,g̣ PXt^p_AŴPV6C-= .d<6J>n˓|ʪ{;vűp%Xa )ҔF2~M4- 0hXWԁqr0@;]L:oxoy#Edq}kmhaV e=*֮>5*=X`uFF9 ɲ/ov E*`q_8T^@n ]4~wHsmCRVƎ-7e.G%h*cSV"X?Ѯb )9S髻ߪt"ༀʹG=@{aAtdM$u|F *e8˚l<<:D 4L:"= NZP~ {̔Il[.$ҽnBH|_7 `P#ȢB(=.qrZ X #泑 Onc*H{[&mJ+ODPZو=I]vՄZDZ1.9n#DJ(V$ѷ<&-yv$8й!ooK-?]l'̖۾;q4 k@q -j3>C :_Japp>>O ]3$IRxo  3Dӣ$Zy}{4.i43nj% 9=k $EZkA+h0CpY.  %??pޱ5܋!\l(v~'bjnt ]?FF rc;.!)1Kde@h:kx]![˛8s8 fA!H3߹8 i6A{8պnsY\8SboCԟ} iky+ݒ΢s֙O˵OB_$Mw>9:&q!0Uy\P/8CtpK~ ( t*{R.J3:0z[e4 $ [h=lLղQq`q&׹ Vk+hՃ/nVŃU:vRru5(Xo?o JT Jcyy|plގ"_9+.i^)c8i8I)=>]P!ĵ,Tt!$26}eYw%}̍jW^9}*[I fK ")hx(aЉ-}L@'E\w@x\N45Ir|qFtqsYU_ G@N'ɧy:Zk K)Ɯ$'YspEYv-`ʅR@I(?o_;$K'eDaij)ÿwugҷdzHz͖8@Sa:* ~%7c(9oA4$N^?3#jtpB!PէadoZwtV<4rs-L⿘m:)XTM 2^8IC9ܡ ~n\Nx&K"10TaU_,g]gτmX"h`W{&GΘav}>`ӽ!)yÜ'`zYryi|mA= qHFuY"e L,cNc +/`"j XvsKoi7֊0{;5@s7/eI+E9W0M}Akr>`+1xAK?(5sTq9 ?Ꞻ=PE9PKzD6PdPAfhՅgQL}:Z1Qg > stream xڭYms۸_vԌE?$;75M4YL(R!)%ί.Hy:;b.}vvgQri, g,*>ќLO'dX $eu5S,(?1&f"S68s-9YMsSw&֧b< ]oYTm.[f4"ͥ2Eg~vƔ5ޟq. ^,MG:? &$<ď(ϸj5KOX`n\M`6ДEEeʻh^QveaZo̶nӖEV;}%S?(QWyVw[KV1Ae?d獾cgMkf&uAijQڧNB$T&:R 'a->=H-? $q.`jChvs]m/˺vYȹ "aBe*Ĝ+ư9Cɕ3溰H ]Xy]v, uxяzUk)*_Z^w,5kT_*#=42\J}+;@$M[ʃ6lK[DjY3vzC1%́nKInɚ;s긺`)2sy$Cdr pDFHuc;Ɗ#LHMP!Nܴ+Nթ$!Ze 2M8facq"dX^⍩rWz8ű .h22@`YE]-/Y걸z(KzR*:(yU7Klнl`Qm?Hu%U~ZRkՙf5`c2EtɣO'=p%9[EA=Ra2C [ N®su]ms_E?#H*T0DmQ03'NItQ/08Aj6k%TD2Q1Cc=.000ql$Ä-%f{6+Ln $u̇XOb̧`0򪮖;i=<#zoH}S4@DXmɦ [%8_ʆ{ _W73 SN^NM>>()c$zm=qXN *~|Jv0QuPO4ؤ{|{myӐI ?Z'\{T)ֹ#y>tv5lwN2ջF0e4a56-~N h 6mm0N@YzS'`t B86UmLO 6bA$:? 8B3#喞^8নhD@~4# ~n apHƻ$ħ3&{mx#wE\蔏c+u@~u0 a #@L}m7şyP՝Z^-`D=字tS3<:rY4)5mn^ Ի*vŠluܡRcy81bu>aㅕD9vVM7Ih֫WaMs0~G5zZNti nTǴؚ_N~>gR?]6EE? !b \OԎ8a.f".x , | [')s9hoGťYq7w\ܿtta:D_ l_ajᷘ0!ä(LY (@ @!3TT5D'X'j^OԤ(igYtJmy%u R> stream xYK6W{ YRoC&Ezkⶇ@eʒ:_X%Y/(|53o^4uu~X}[}&$:a1z˝n~qzp#yt} 5l]eVToz{`Hf 0:iwG>%s'Q"7*zT0JB9a Ae.(71sI3+o֣M⢂&g~yqxsbH\wo;MjE~Υˆ1NEYA-" B%T Rez*8D pi@\/P۬NU6l9T r$7}ɩ[Պ‡kee % $7MYHрzƒ)2;n&WK;v"k8n4בLgMq{s*gkOg#QcoRnD\mz~l):fP)ø7zx~iꡨ4/)=/=?XwMZ~Ɏ%V˲e!qA*P(k}WNJf$p+b* g!_TT`@z\_Zq|?3\]݁1<\s!9 _msh 4W]** e+MbҨqHS NK!6*Ҿ)jP9Z{n$}YDf*G dlDfjxrȠ*hݞy&MTP{^P+cU¬s9TSBʸ&je$arRMFz dtsj;A8)2[KO|> 5=jQSkfȝM,˝׳Vy7˦Yhk> stream xZo~_C$3$ R' B'o7J2| %9-5+ȃ!9̐>)s2AD&(L^ 2h8eF*d1%d:H) R|T HRl|t~EK9TQ)E7cTl83^Jate":/TLQ =hdaߛPXgӽE8DP͆< .WTC\Cc ؔtP*N* SQTEQ1e"l2eWJVCd XC_u4tkIz{+XmuZ:F- J'^=!@ C)U.\9أ_|@fRO&v "lFXS(ʙ$JQ Iո))^boR&MN]-]Q `[)5r0- $q/NI:6Rwx-ΤRGd_}0(V#Dr j/PdҰkM&UkfV%,E ;x o uv6j5/a6]B!/FE'bwNJa9F&/f{ ZZr7-OOl~*kc;_TҼlac5B#l4oLۙi^.Omo&/ d'ƾu?Y׫V"o)ǝԍ4/z6m4^?}\.l|(ˎI;)—l5EB޶َs88`tVKc5dg=ⷺbeJa+;r3@Gwb5wF=`wdF~i(ۉډىۊTEb"iKAZuvGmr0x6ao#r#A4 :x9 j]x!Sj k7lVjB%X4Vtd+!ȱuqB& 5'y<۩}t}j>5ۛ6: ]{PoE*6??AP9Ϣ>.w!lv@:МhwP"iγ;|>9l/w JܑsG2lm'Trd$J9 1p VG[SrPʟK9ҮYEBZ.2Ş̏P ޑ[ȍOUG&I[)~p=z&=t.豥E껿=#6z6āt wOG9\*sU=Lx+7<8] wE&g)AlExx3=Ѓ>ѵ;Dl'\n7teJKʚH̫aպ'?m4hIJ,B׋֪$vq.ɓU8cAV)c<%69,^ MV&Dx^):p_l/o∳oH[k.̴R\bwMa߉m9f"x5zѬz`sP3`FխN_ ?[J@M []J{86c @h7MTa?7$# C`/{*rDQNZ!OEs%} >BL-ۓweRI̿M]{c)hS\$6%Hp5u؋⣝)b./Kg_a~DĖ_)] endstream endobj 1314 0 obj << /Length 3264 /Filter /FlateDecode >> stream xڥZmܶ~bᠨ2|DuvWS'm$]/3|v^jH3/ȫlL'R0':V.'싟pp5 u%ڲI7p69 3B0 ,s"=TB]ؘ̈"@ `Hh|5Þ`|c@U4nItc S ˜q|{|RC^悘qA&Lv<5XHz3gG>`-?D f "B"]Y3.HY3LՒ%=qq/ׂ ,@h4qjO# iЈ!hkGW ~}]PHqHR0U`&_#;8Ivzp`$м4xpNE - 0NAkZ*$ :vU w߇ݛ-I{-gYƙH&,`@laO+ 1~qLuD-a vUl^/NA'lt2p+:o%ȿ[c(?ApmI ~.)e-V Gpk\.rH]&.mpVp=@itVL %:e230-&1( /knd4I;œ5ZCN|6AvnE&y$$C¨!@Q#v\5 z8Rj ª׬O (y^% xW0(HjtO)̇Z z:V󡛲j̳msiO9*4AK -R)r [!B*q.H A{&"#+"3AHo4R@2e9Cg3EZ*Q?R7ۮ; 9'fxƘ-S-&ZCvz6ц|ua@\rm/ܬmDs.ె[n 'A3,GdeqN#^o e\ xC5_=+tߩ;E聕*3MJ$_P eS9VC<]_ hbhXQĝpGaNC?I`65V2',V6CN5Q7φg,G(akK& AZ-BXgl XoJzvXtF.ReІ$ vO_e6-"<{)~8 iDq2́\7!ܑ,44ǭUeHtS;[eټjz1,ϧ-D?VZ| P,#Zt9QD7\ix~`z)Ѓ "L?'n\f zaᒙ02d&WX+GH9 7Hpi`0uclz'`.I 5X {\EHpH;fj-L'`h`qH0Op L+` pD|i\ûP VIOpC_y 5)/Gy$M<2 0"v$8^s.rIqWEҸwQ{* ٤tpy/ ]!\0fXѕ=gs(k$B-_J/NrH*<3FOSu8 ,2Z~jK~MGD2FƔ5l|([8IryiIy;Q>2pEʃOu2݆~qw"kP?aI;G1T=@ˬENm?CNorrzy|oS0?vL>_>,8IK5.?̷24oe/fO/,7y;qh>?ϘytZO ey)7BZ (𗞁%~9xLUu]G߻ayq%21YkS3Zb#~4sO8jᦊ {ɪ,rou!k.8#MCW'S',kfəƤo ⨡aBm  sduV |sbV%)ǝei0{L [* w/mk_kSذM C6N4GBrkgސ"0,<^Pp01}ꎸsc5@j>Kq7Y}\o'@Bxb!8} )*hpޔ[Ğuל7>s;s$T xNMʳ. b` endstream endobj 1322 0 obj << /Length 3522 /Filter /FlateDecode >> stream xڵZY6~h X@ ^(#"`Ɠ݇$zFZI["u5Y,,ů6=ﯾwe,Kd?Ld DǗ%z1R0"Q@ǎ)fyO∽^qf,t"wB"2xԑϱ-{,ijK۹TRhf3yѬ~T6i=mI?tc1|X kj=%*j7 =8t aH]>Eueic tEyITͩ`ɼ;R*a^Jjy)B>P iOE{C[mWGj鋼vd>wTLk<=ẸcOek J<@@@+`~eTƦ "w7vqWX[T:6,R0?QW5xf/ n{nR?wbÝUnJƇ;wU.oyW'pg z jb:t&@"}ٳHg!o4T4&,8\]GۄJ;Ω];>>qҗ^~@4v[*.-TNUR`qre?TgnR&{Z *S_DOy}`/%]_NQ@WSQ;ÝBO!t fpU}6;+]?tQ|t$HГ*z9kCY_gI؅;t bZ/W`o>hh^݄Ƴ=V]fܰ=K U1yGcnOڸy̎a`_MV{E{O AD( yqk.EZ;ϘJC`FOZ:zĘ}&`U O6%dg L# Kձt&qc |T#tγ=XL(E@cN3{ޒMF9jdC܉HT'?̏אϔ];ۉAxT67e(KkM(K ",+VAcPw[&!PlG QIп~H׶~Tm'6 fc(ҵpZG"<xA>+&=yh%N&ן6kW~:Z1dަfZdjڰc>$ۇ \B<p̰:׋*:2P檷xB3rKcͷ|Bmg22> j>3..9U7VېL$1f2P^٧gH<P=Y/M3LSx+ cOdӸM u{zg]D\rp+`lfw9`拸Y$&goׄSYTz(k,՜>2YBK멵 &NRG:26(M\q~M)&H-'@c–_,!o24YKHJ KT걱4g)7OqR @B%{kA< ("ENq@By'Q?#79}|n}f#s}v;OW //F5Y¤+1ÁE1-墩c5Bls!k9K}ҤO I.V Nf^? Dyvdf"q'Smo}v'w:{SBX|q/pZoһm_ mDdUfa4:g ,(X$\Լ`F۳[yl>4goG˿SLFֱ+!x)v=g,g]V>TK C;Uܳ㥶/B/$ R"$dBfK!Xiհmb\er qy*rU7&WqYqL@ݼ0=߽嫴[p}{ٵys~A&&ůT ^ tod endstream endobj 1329 0 obj << /Length 2458 /Filter /FlateDecode >> stream xYob^)k+R%ɃVjei!i8}g8C}-}v6,jDrfȕ_o߽TQmn%aN7m6Pnwي۬.vGR8Hcwu?j=q$LnA BMsٰ)8vC43}Z_MVu: !907B+n7A* J0qh?L:Y꽃Fn|-ˆi*E,8=fx1 [}ϲϳNPf+o|uMf85if~r]2#pnhN4لԂoh*2 @3Xvc+'s({W{*]@ ҐE:aE>KavK&*A$`mz(u h&lݚ.m v kIsI7"yecUos8ϸq,i,XȽ(+؆3} mCrL)X2 !] UG7* Vvol*adܕ1,ba 푬Vjfu=&ix"hSd3Xe)g)%d%N]y,,Wa)KN..k m'Xmm- ~:4@Vn}w~:y[RԟOyeC;Ł̲WCl{zYұ_q{C:Ǥ,K t%kIlVFzTᙞf z t>7ڀ݀PH#̖u;/3"-dgDCEys_eC]=WWK3CS{ /wf?lYm3N^T<&Sҽ&ü,hأ=m6X3u,6e{F9זP-)qrQ{ *gUQ|hxZHAvHʌqw`0~+!idKB@Bq bVp^>E<5M;+HvT5SF;@aVvp,ݠhP1&~ctī)@i[,cN|ix|cH5阆ak>JaZFV [>U=z^VN VIޞłjM(f 䛁иp c2*'P=Y[Z*<{X f@DTj(C:LN/4I~OHG:yKHƥOAi qis#qnq>1\ǍYH iwƔb35Swq+)w,iceQ/z4]ѕD{E+ endstream endobj 1336 0 obj << /Length 1655 /Filter /FlateDecode >> stream xڭW]6}ϯ`6y)xɄNLi&l6&XI%JWY&!qtOL4qڻ]0 qˢ(Hi7hg4?vO!8olQgUǞ "eGG(87Sۋ(dv0PRn&klڝIY?y}_8 89[;ki;m]!L *:+[6Rk10;D %7\EM~ވL'FbX.ƊRZ/Qҟť E[kf̬il`Qӂ. Bm}f0ܛ,Ӭ] v`Ma<ġytݘ%hO_QО$fYr ȝ`Jj6,\߃vdv>ry (B9/;E(6JpvR0lMs fGKHd6>q![oŽ1J7-0p(*ti>}֬BT\NZ-r=$ R+3g-TjI#78A_l70@h Hed1)H7 &w6ʘF?n0!7JX6 _@QR\N!]eS@lFYnIQ)W.[hp2ɲ>5b5v%x ;ng+-X*Cmhml 'blj'y*!dj9uoZOraL )w> O4$=cj_ځ&ŏ>q:΃3AM)RXi]:؄I09G8C|/+-Y%1 oDOI"rJA #9<G"Ru~JȖ/в!Ui3ݪ 2 m"T^߳uS]蟇PzC$WO>Ŷg΍ n]Ľ@UJdy1r_0`@S3+Aj RNjӰxs9^ $g3nZG ۗÁqTcGI6l@ڀ8F y%W`1` oŵ53B ΃[ZfMb^̠@B$Î9i'sGMMhWo۬(HG)̋В1~!f_~4ɑ&foْ`TH}V0c mVhXOl1u;8&-]ysE013Sfs|٬80;y=¯Q\ES{6[cck sa#OWk%'\Tj%1mFlk}L6+pW[tPF}"liKw֚sO|!JnP7 1(bZ5$^^FQ#fռ\qǞݮLp/Z!Ŀ $@ŗb)ŏHFl#\~Ls'޿GgDc(Nw$^+{ endstream endobj 1345 0 obj << /Length 1416 /Filter /FlateDecode >> stream xWs6 _ŹXQg6?d]n[oknEã$,%r}A@rZ?~ }+!IڢKZ$duZU[__@w)bФEf1+Y ;^> stream xYKϯP%TKH&æko*SIU S̎}\hK7ۻ?>޽(M |Pm `J$l~Q"V,бkww ۍ;Y~fYXUNekƁk+h.&/ndh~eu {zBz>iAR DJb6MWHÏTuEFdl lJ?|8wi LsG'\\z\PW5z.}ۤ-[hcE]2E@%r%<]o;vgS8Zpf"j;te+>a+4V"9ոU=k ,boMQDoؑ=AGLʰ8|,a@K:PM@75bKͿ~{ѮZhH51\41KH-c Q9k=X !w Z6=95Ei *j_0@o.dI.$j5rPcˮc!BB:0mqQT?<SC=<9/e0\R @ެq‡8/?|X.d?D2۫JcSr,9qIH%\wڟLBЛ5S  YWk>K(an芓">H,rFy䈩d85-ѳ&{[0qmU74&3&jC2hwy:]\Hp=#7@Xhr4Xu Fpn +H1W03>Bd4P.qˆjj,7Mϊՙipj^k#h]\^Sͼf9ȳ}Z|ro[ݘv~2HPZG"dXԹ&Rͭ f+,mq/ &*jЊYF,!YmYb2_WpqyT /|hI4JĠ1W(<ۺw#uz@`]@H&$ HxZX[%LMgH//=A}٭% 7"޶rHiy;֨Ko?DڟOr5`¦Dk+ (^'M1BUkYƙaӊ 3gEYh**8>_ n5s_@ZmN=D\ƶ-0Vba$k}_M ?bڶ:W#J!Tsd=ZO6cyd`ISOqU%/%՗0q>sX0,.tZ/U)ﯥj>82M vk^;=Y^8%ƢD@[inB0 <bk-8];M]CsItjAy,.ngRYc>O=̔o xnൻ\~>=k6>"@i4%d/[%0AoM J ªxYzpi^aaf9I`CO}i'ZmPI1VH,Pl_^YA?..YO⹦/E8yh*I6 ˣw/Da*&otL9C)pu ]}[#C5'SykdȢ$T\TRTDPENjYI}44~UZҾxY]0d܏󺝿֦Uc(g&Am!i[q%{RXKC/pG{pݷȑm `N<Ճ>U,}Y1)< *ܩqJ19!+Om<.}dVi 7Ǡ> vʱ/Ptp({Mw*F)^Z| }ރhBx4#|4*bp9 W} *У n)o:]?7?<3~fduǻ+ endstream endobj 1371 0 obj << /Length 1699 /Filter /FlateDecode >> stream xWmo6_a@'1CQ%mͰ.H[k18EmV 1yWû,'t3M2q'$$A@xMWx{ H&d9N7&{SQ՘QTY(#ј_u[z2PƐ@`|ėhE]cR6_mFu +YK?~ h!(;$tDIfZ*_#d g0JSeр_4P8"Ai@ӈOpE8G3ِnWW+;]/mI,+(f+{` dp6/>Kl5' QfUP{,+i7rl#@*$? 7E&Jr1*;UcR&"rRpnjDAǺnxZ+9ڰoR63lc.1H!n hnLvsB)y)ܬecQbVYk4"jxem:Qͩ`ÿKY&VɦR0Vy.X)63d"k4]̡~a<|\{ru0#R6.#GIh+2MƅJ(vm[CXE= ebfl?.|Frƈۃ[[::{ *z"l\<JGbҧ;.-%Δwt.ُ[x핼x=?*& endstream endobj 1383 0 obj << /Length 1686 /Filter /FlateDecode >> stream xڕWmo6_!&1^0X~%fI^d~wAkK]&K Y_/NKKE_e)+pD,h|9NH1hA=;ۏSNM1x &7]ë3 Ń2{w3w%XPZa$H~u6) 0k(Q/t~(p0*hTd(k%B4w]֥Қh4`jv3wCtD*`KXj2y+ڬ[]iNYse46P(I՗{C"È`FY/^ >ޠ38Λz\\|g`g); "PuIO;vQfb3x<Ƨ- cA] V){e c%%Edcf%pfRbf՛ sY Mld E~s`N7^nvbK!e΁A=7ˍ^DSZqщF`q-Fi(yT>a_j]hp_Yc\} Fl/EXG`7> stream xڝWKs6Wp|4<igK4d6|j]`Id:"nHD}NtT2Ef]{c*յO?3/qG |~$w 0΃a-  2,j 8#J+ 燓sEkP\ǝ^,ÝhS&RKm=u\vW&]VϘFyLxkLcL0 27!7' \{|})]wU8yҐ`-C"tk:ki! ,tӓw=,bSd4VFLFC<!R'?-M lwռ #,]H@yeID*IN7.N]C0|SnUon?1|IBvW{>{ s^ |8{%.mTucmk<S{uIE| ;irR-E%c^J^m3(8Dc[$^;J"ą~l+@зz!cISIˤ.+-]Zz,?gd%\` rM$=G l0%RAĻ[`EwϻLDxUY_4-b!sKIp۲"KH683O P'm/%sNAG= }K!Xjj j9@dN6[(_TWث]7vmNiIg:OH)]G;6P. y:+!PO- S2:/pGg(=MP饐^3W#A1yOK֔6H2Nѧ3oc@z=qT&&뀉m1@'Ki| ]k)v~x:_Ujl8M34!o8\uxbBC./RA% 11GV#%C k \y>#j  rY_Lp5`oˌbc a2`ӴlX H^OTCeo{JLk: %}C+┍+(l$1-Ta[Qxq I-,6&6k6I|@ :E[ ЇE].4O@kj;jz57Ts%̷s_'޹H $"(+(3I:4<uviwz2b 9G9~}':0=|eԳ endstream endobj 1422 0 obj << /Length 2840 /Filter /FlateDecode >> stream xڭYKoϯ%=jg0Q]]]]UU[7?}ƋD%-v yj",_[Q046PZh'$| {mG+nڷ0hx_.H/:VѼZ.&Oc/^v|7y؀e0 R@ݢjy@ TM 0}B瘧m6r0\\KViԒ 0|("e`l|=T,BzT1U$#`A/ZUf/%$ɐtOB\ !|m pfa5wMA6k<@*@ɬ`0[XRp|/LeL"FEZά<ς]j) }XA. J:9ck:¦;fR棬H SdK4;6cijd2'-C=?׹DͬkGk%<ǜ M #Ҍ/̠jT۶體I%TΙeV3pu|Fv(l%-P}-хt2Nܜcfh'V$[l D-&_TפA>0F5k: ^Ҵ|'ފ{ۻ=ǠߢK`6xLjۿ΁!G GG56PB5f:%$/9XƩnbSMK)Ҍ1u6jI5 CƄV%d} 1^R2@۾f# t1biH(6+I2P=Mhӧ 1 `K*H8a1Y5jL(*xЗ[Z8%Z~5+7Ө12lV#q["7GY=Bm} !#14 (} dg2nQ_z^epraxhM[R}AKYSy\<,b_@E=WL΅ZcF@m^ 0K͚Z&Kw,BZ\i'\SY2.eNL7 ;H^ ~J;ՌZ8LzǽFce-=\wH y{VH]\P 9\fBML?5%ҮSmaTce(e_]=@nW۔JU7n/.Dg_)t OQw.sY1 .sMcx#$8J)Qdqf݋ 7F=g3l!ԘIQxo{|W;[ƜINdrp%n0h-dh; _V1Zn'(gn+z+/wyק7%RB(FRiB$]B[~{{{>7Z{$D9=0qUNF: h R= )s]m̽AYZ^.)'0u/"4'ċv.> d)bv.Ocu0rX+ t1ĸ }m)ugӬU ?SH!!2\H?E#p1WlM@ǑV=z&Rgf(Ug{=O r@.0Y^o߾E/5eFS5dmhY[ҖlZn=brvMpQe3S}/ٴzU^Ve-.s?yP|=}L+D$r&Zwd&;ɵi4jRQT P1 9kBzǟ;`۫㎏zX(WA.-vR(\lǫ{dhMn1o6P_Û5c endstream endobj 1310 0 obj << /Type /ObjStm /N 100 /First 976 /Length 2177 /Filter /FlateDecode >> stream xZs~_8b,:jfgfL[XJՈJQu[P'S")铛{w `o_Q G1lU߈?%v]""Qv,Į|Ba0 \@q\OI6+C,tӢb9S0kIX"bZmȎM# Ħ6iu\dc, XC@ZW*k.[RCm ,P^6^lD*-^F$(Kj%ʛ k); Ԟ'i&'keՔfH0$%S@,|hj#fY`D E\ↈ@5%5JUL m `$Fօr Q6f(ӂ&=SCX Sj3Kg6 Q k)FR5ًB}nB%׮Ajrd/|&0@+@OT`w0ڢizBCk"AS2 \F)9&9e4½l(is3-t߹3_'0xm oޝ|@@nV~4|NO]0m^eqR.+,0|u?.o+w{康_V~^O`{eՍ6Izz]OoA/,FU,1˚|lge hģI_v'ݷ鲭u~^Q0W%Bs-E ^4=q ;|b7瓫M?ȁ8+4{dsрB#Pjm8),>Q|ؚ|{QH G̋.`?і <` 04PNImLr8=&똘t =D9|Kr/l 9Y-mF9ޢj1>a]DhÖN2H*0Dѽ8=m t/WyV7>t5X,p\ .dY$3Bh(Mv1M'~nBi1;e̝23ja܂:18>8e>}Da>"WvTPOӳp[Ь,зB>|fhc F4qyavI)ޅ$=z"D5!C}N+ԁ[8؟Wbm gTͭ3!t(O|.oV~9'!)h0:4FoE([grOV̦ g&^Զ|j{8iBո&Z ^K@W=pwcDyq eO9<G" m\[&$qJW9j?mg/YyŕE%ϟTBu'7[:h-P(#5|иJ{uwάaZ$TLۙW4!;F͐Ydr * y|l2* Rd-Ȗ*r ʍs(v;ԢM^:yuԾ}P>;uatv*](jt671/") WveK=cg4PC KMXY(9& tד󟁨?Ma9iD ӕA÷dA6SASKЗH0c SvbQde_ g 3-ٱZԁW;R|9n lC}Nn]Mcpk@n@qȌ:W-X` 虪ܣCO|蹝È컈;.UWwD& FZCpd~1ӢmZ(9 l/DxI"ТFETej .Z]jD }|?bR{-p<7dcy~1z endstream endobj 1433 0 obj << /Length 895 /Filter /FlateDecode >> stream xXn0+dJ TI)́(_%KvK Q,36qNZL !Om[Swa,qHv}܋}F># %wѧ*̃[~v~WҭibS]S=Y9;vB*tKNSH5>RP(UQ(ľHYWV`B-XNZ9aS`kć5AIYaoZ.-ZdLa>}7G%qЏNSR 6 J_eʥm$ގҚg|&i]ފj7yb)2F)'66҃0RmxGwδ_"#w(LݻOYt6 Ӕ?tsOg ;qQ3yXy-VjE,UtgIPLقJ5)joC-p]u\N*رW¦(dC@\KģOND`Wn\=(e, zN[^DyvW+J ʏ|/N+;m ]{<7~O3kVIKOhg&nx _-7/8, endstream endobj 1437 0 obj << /Length 1139 /Filter /FlateDecode >> stream xWK6WK-4-P9p%&CJxw,n=Ԁ5C7ϋW0qRF^J` rbBPΪp]/׷Q08u9rv[w0;0p(g?;z$׿tC/v7RA;j$tO=MBD2 ha P7Q>%ּaO(F09~pGuTm8HC\(U `oFKSG5 2[*Ҕd|vٸ@%n/xTXheΪjo0=qNvFY]ڿ&Cy0_Nf'rb(Dtأe,-Ԗߞ.7WxX)|E0c BUK>PB["1s8#&脟q$F|?$_tfCX5k:iz(/Q}c 2^ 1gK/W³i TP]yt7R[?qng$ ox!rqZ|\;;vxCy^/޽N/g䧉sUk'F'TUocr:V *j*QAymPtaM>=twl/7%I.<Jxwy[[_ҏ/ Aba/}I Lo$P[?b Sa[m6ܐBM??]z!|xKjDI)H%%^CԤm"rcuN8v)աB[4 u: fܨۦڛ'8lycƚuԥP{$ "oXt endstream endobj 1441 0 obj << /Length 1217 /Filter /FlateDecode >> stream xXK8@l"5CVsΜfVZ6@KgVe*x[/~uu7}g,0V@K 1Zx<& _W FYB!|.~",̴-t?![y.Q.u# pѣzFbhPƈ(ԊBҀΝAY\(vB'pl# d|J dIKHKM 3%q(jm$?傦=o0jXXzdxׄdohpk%/+?ē>47Wxz0z(co)}o6`$g~9=-x*ל0g o0,zJ~$4H5THݿ% endstream endobj 1449 0 obj << /Length 2514 /Filter /FlateDecode >> stream xڽˎ_јmHx`Zbw+PKm=v2Tz-Ab*֛nΛpͻ}!82ܟ6" śD V}iD8a4 P>tyV.Gf *>ؕ{PΔ+88i'}RۇШMۚEY Y]dmAL6m]RʧE0^Nis˦*:ӮS]GJ>+̑O;Y[ft:#kFoV˲v'yeٱ%,wUv|+O_lj*&G.~(JӽؙM&rsê9X[<2yAc|#-;%hÈECYGl{ƃDpYPV^ Ϋc釶vk5Q &-V2Y(M.ĭd7";! eqJ9q㏓R旅c"td:4C Pe)SY vBmV Xڸ Nzʊbz_y.yFGJxa uDLˣTU!t?@"?Թ KYWw@k$&c/Y=DVK#@pfP@ Y:a2@IZ : :~{^Ji]VUwse؝޳_4]SWo#i|xn#1nT'HR bjGcU I- G0M7T2j{E7yKAD<3EaU^19=@؋ມou`fIEϸ# o6g H||l\m3pt*9XD23 $As֤p 4[WoǔYv\4{uysSȧf^{u4$Jѓ^׫ ԞfA6ˮW)}s+نcc,YdmPCѽ\sAUNy!?\֦l \VC8C|7ډM xrg#G>+mRhF{wT$&J`D"pƩyA@pcQW LI%02φj,)ZiDKCA$F$g8H1}n$`(3*q 1p9s*>w5,Ga&##I^1.Rw#{UYvI>VN(oODj%BB& Ö@acS ?|lJL)^#t;tR eG@4|h _f6 p</NS f4cp{q;NhH Ò!/pbb -dS2 ?Fնva'\ [KO|*i'ە)dzn$.p`rɬpArA,IRXax<;`;ʱ%s-239|\`>_QGΛ@N7~ݿciԾܪ,gTL̳[(YDE]'AƂ 0Iedkp:5kP6%+ᲢȣPձxmA?mN( k9 (Lx*1j Ze^F!9ZL[{v|0 +&*>wusW@-(DnvRayC2D3+ccgƌևl(+>2%+[`@X@pl8 Ҫs[>eߛ+ JEk?~GAyGz(o|tm. $muQ˾{ÜuT=5l꩸Q=J"=z` ^~VXr+.7xr enHԚJ5߶0P,t-?4jEb\9Ļ|yi3-Ћ5O3P6&,ܝPq~LY@UN,ɪu/H7-^5 '2tZNCx6+ XQ/ |:V*T.?Rn_@)a)/wZ2&\J^Q3tX6Jؚ-jp5ΫAy[.r(>z> @dyweGּ½ի7 })XQanu߯) endstream endobj 1455 0 obj << /Length 2732 /Filter /FlateDecode >> stream xڝ]}E`xEEbp}ADYf}Is[)ě&OlSEU!iqf$QVf2ֻs^YDHYC(b&٧e{q/RBz("U#*iA\QeOܞVunV-E@[3;z TOwsvOcݷqX".skC#f.j :1Iy5=Ѕ* F@V~(ƤP B;>F&/V% ǭd;K78>DyN79@ByPލ6X(4/37Xl@RQ"+gT ա,mӃ 4Ώ(ݾ(xBy)B(FX[AZ=K.BAX*4/ZHJ*o>Y8x>EzV-So{.«T`>9|-}eهawgm/W[um I"][o `ΡNJR;4\اoNW^uz/sux*6jh^Ckxõ፲ic|$;Okc*._  PVIeMW;GEh 3[ѯ#e$B[t0 $PI3 J0[,&ۋ>_ S=9?0 15ڎm) =ꡲ}WzJSRJ8/5 ez;RI8߂gA8q4q!r"ҠJάKGg<_\c,\9M;\Vڮ\ePM?VeV8b[v&R=pbkҿ2"Փ+miRo02p˴lo0u3:LaL:b]#|j-{]J23<p4j Xc/u`u!v- ѲÙ2:}C!ڽҕIӂ5 MX jl8؁Ef@?Q#h!:G'0|^~`:Xw(܍x7@ӱ^ endstream endobj 1463 0 obj << /Length 3480 /Filter /FlateDecode >> stream xڵr]_ҋ1qJqYI*KovRw$]`C,=38RJ qs}l|u_}ۏ޼KL&wW"#dWQϛ<ǿy%JQp[c]qW1>;z4j+s*`K+5Z kb?Lq̯)1&p\='<tx=mmZ'UCfk{㾩S{ط'Je"'{#ln i$)EdfoeT]YWJ+HI5~ wT9{[՝%0mh8%ڗ}_ŦpZgWJ?)zD,[Z֜,4ht NQ=Ǝ#r4y L (I4!9 .j?b+[7r7bYQΛ\yt{-M 43hl)(1ұΉ_C vȩ sA E3Y m'm`L# /mʶ ,X zZNFQC gQq-Ӓ%&ʇ_Cj I{{)<01 0q"ځI#Dns$@g7ݟi,wL2Yv-L4.ԐnoߚAuL)i׬މP&;! $:# 5.t+2!!u73lapkx053*Da;I 7,p[<7 lY0]iE|rEmr)VcbP@ T A6ޜoYFLcJ-wyWBJ$KQULB"lI \,L\G.20#:\&э!3\Һ,yG*Tȱb7\&LIL=pb(;\\XɃU&_[QVYI-[\ۓ݁!w+̋%<էѭ>.+H#(hٺNAc|| TeGѣS#ޖEK#,(e >DY 02_\҂4ݰͬheleJ:Tw Ωꦱ;W񓂫,U2_΂پڡbSi{* gZ"R-Cy,E%-Pu]`#:y8dxq:J|~h!KұlVN=I Мds"\J&Q;SN9<\b#cf 3Ja4+W"3CL$]+T }4B @-_Csf= NNC(*x;#Z7$20b!'URiG5T@] bU\hl:>Q|R,~NL `Tt6K:PvNw1f#kh_zx~슪ra6["}rw]<΍+r蜇Q8E8'1\iC(vݍNGTU~;F([vbk< zClX$n~.U wP408wdɅӪx֬4 |(2f{ J4 Gqn_/ړկUDž18Xc+2ރgB.1EY(pWK@q@+ikZnЃX90I6O|{kTBwyFtÑ ]ƞꆴp`v1؀av 'i07 AaD3RWo-iq!OӡCGww[`YWbEU_b"1ۗdjoOs @rfnٶey2x8p4H&w/GݻEϼH;c $}!*Ϛu@#ʊ`"Flr Q^Ů*Lp!^6[tx 3: Hî,ab gMo5ą B ߬ӓgw {RroͶź; 09m'ңΙعt~HMtI7 ts,f,<ˋ&E@0(Y,' 9o"a8w/r.2RAlf튙(>:ϴA0sNb.uucXHHo(n44O++$X́SuA6 IUTs/;aKpߚ)]ZsS²GL3" S}BHp_sˇU}_24 )4D!ACo2wPf!cA߰d s80TQ, <[JJ֗B}U@HdzWxU&_u+c=|JRx\eR0ZjZE8_5W~w~v DZsZ±7B_%,2QSlaD*1Ʌ|2!m?oC;tŕ L9^i]4 HXvn˵mhd F}O㤷zmdXyX9kJ.|닍DN#\3͓\͏k副?1W8> stream xڥ]~jN$%RJч%)HylӶYr%y7_P_][,"3o:ٜ67_?y^".ԛF$IR1BZe߽4f Ny0V"Vl%fe d}yakV]ʡj -}zxpv4rDEeWdm0Od&E.axKT*52lEOዿ}E#f9H BGfW=Аڝ푾D'̞ 5Z K pt l| vpsy<=L_~Au9]&DL " Y^ʞ |]Cv!Bmg~d2dKiltyHX"5,KW\ T,EfTtv[-ZsoeM;Mr : װ x^Ҩh 6PZN'-n x<ˀ^(Dٮ<QD6N\xN b 6}t [s[S}˭~&lqqR{ev_0iF y?d2&F83:xʎ_b[__PpJ@䐐L 1ߔD^ pms`ILэ+^BB-wtleƓ=U4 /77k)EddqvYTEH>PN.wL,Qnz.vKQ +y8j׷ ĨɧBXk ag q)_Avvsvr~nE CQʡ:b %(C;":jz}݆"rWh tT*sp&E/|N3D+b~CkH<:`OILl MHkXSR4n0[j 9҈Rdҷ$8\V#M# δMbm܈V'I1D+ DTok6)>Y|4 i\a?.M n=ylI\x%j1zAMb%cg>L6VfjӲۅ"._x ?:?Rf+G8MSt)}BvQkO/&箮 :)Y/~ƖO3]€*7c@:(쑩`:?ŸW#T=0=siP&`0Jǐ~R& rs1u ǡ.6Xbb -$ژwQێ0 0`!Z$Pk=lϔE8wTkSF'OJ{9r JE+*QӺD/dXIbU%k c +crt(t Z.q؞wd^R`΋̧e_ŀFbQL_V1Oսe,b,"Z\6n60nT2TP^hʼ_DBr)H%qe]qI7REqr9 @z0X;c%DX<=;`lbE,|q1`?$Jh}Mm !jLV_E0PhLv! U?tK.Y&'x 5T9+vp Y rH{#/!1)gѷiY`5Cp@#Z " 29PRE}SQ^ }ʒu"{&߶aed)=7ҪLٖS? @쟀VS!+X?u͂Sb*p5ՁqԬ&l3N 1$yW5eϜ~+geki샠c^$/>t\(tKR0.cy(#]=*tC,NH]" yp/K˺S/}ռ$yX>06&'Y%vۧ 5/FFo H+,@dlq㳝'wN$A > O)5‰\Q?h`_0L|`]6"ۺf{A(FTШbãkiir=uA<’' 4 ,Po?8?d>@<:E¯df_An#lt_]yf(* x?"feQ(͏^U~^`?BJ G!f3*>#mxlHqG˧G5@-W=ؤ0ѵ.v׾۷е5ݎ蘒—ganJ[j%#'#^_cP:' J-`P"Ns$ ?݅J3`rɩ.fU ;͇UtAn^Fal2[> *s{F2;(m{۱UǶmUnC==Ė$W)_|K\,W9HҕN"t^@fC>$]i6]e9, G_hbXAgidğai5G{n&+0|:!'fXxo/5r+,E(U endstream endobj 1491 0 obj << /Length 3655 /Filter /FlateDecode >> stream xڵkE>42Q)%kSIp٢(J\Yr$y/_yQl_rhr<93^˷QzY㫛@)߄U~l/I7˷q84i*uE^BGK_( uFmun`D{C߾Im6mv򚻻[w@yy1Y^V)bĠӴ|C$M;](b*6^^h ;q|ao&[~Q)mKAتʿ~lktFG{Az7%Ro}B ^0T5 o(R^ijk [a_M^?U] áx+ݷ@$P2,`ݴ \~N 5CsMm {J8IYhofP[+߼G ҆i(S~eKH*A4F5:058Č`l+؅ZruDִi@7:}RCeԱ.u~!Pcm)7BQEuXR+,-/NE|&0fn80jt >[Y$đۏ^8V fz=]Jk? RZ- #=3PH֐97qvKSv$8[AY)9q]9pM< ù(T9!OQ^]ʂ-8n|!S;[N9I($4/&ؤ)>xGN}'+qWO)dEǶ wa ՙΓ؀ĪώQa DoT"Hdf&2M| zf"'iz a' 4oR-&?39#aN0Ht m2,5x 1#uR?r1[u:7߽vF cDzJj[١tE, }+Pl]x;I8%Lk.](gq&K9V"%t{(eAp7e0Y:M\@-r]{7U(΅@<8U!$J2,쥤EAm8o%$F+@aAiyn{-SVc(5 (9GlMJ@8ru99'"'!6X? t`%ɋ)U yUP- -0IilRtR#^}F$?q- !%v-w AFjGZVx9Ğ@'02FjbR98^(E2C[ORIޛ~iaFfF@s!9+2Z|! ‹sϔ9.*٥Pmk29Xdy,(7J s8=>iQ)q╖+h`r.W4h!y}crB.`}ƼS[6<o7?x/łE{+8#Sx9-%Kb?2/msؒ:DGё%FUfJQO(tNJ:g-FY$?&Sy) Wa0WI0X$n<_@9KgJG0Ri'X_85{ة5Iz%" #8t&ay}0MSb@˹T;uB0Qr4O7`v`G?.y{)1ɘDK&kI}5':qK`Чpy` 8LL()+F3W?H] Vp{9wPhRTfi(3Xgv%Où6@†ܦn+A ZJ坐EE#sCK8%[6HkH/$/wvF쵷"s!)H>CGͲ&kbH#vyIWT*{wPRlLc'u+n2r3.QPE7oɥͪdJo DEqf,t'I%iږшCqXD4y},z\e(-ò=ST)TȫWEox9ၦxZ*O.9 Xl` hr3LN:5LiQ*v!4ΐ[|,ihʲk{'pGΞwp6*{^ ՎqBa;P^mU#Sv_ BO`AftߒQ6ry%HRnͩwTSı@=*qXǭQ)RSy[j',Y 4E ﮕrSogqWa`' SB/"nzZ{-yCEǞ7=U sOLqq0A0ֈhTX9 d*xf kHnJ`ѳj,#9yϫ۶mDpb8, Q*B^<..S4䩆6۪Ht>Ne:'"B7 G)숞ǂJޠqR9\.G\*MH$k-q%V 9H|U˦n\bCC1ؒN@I`̞]-J c bLUf2?̂e(pwh ,r({5=0)sTRYr]B'3s Dt)`lbNB t+-Jp/{@ܼ ;-\5)m9nѣ 袛s:ҏM29eT]uFBl9 FC-lA2$I;ʖ%QBM0 /}>w7J?$q1 ?!k@&4ǥ=ӥ%&# OQ-?wlexāǮU/pLVDi~f)" ):dno7㋌/|mGuvC5sWnt#(hL_ǪwUgOծ,|pj?kVy| % 'n|?4O@`> stream x˒_C©xڃcu9dSJSLR} DfRs4F{q%V}Ͼ* Xū"&^%RNW?fMdGF0ʁ%)|BJ*tYH0j=hUcM7F&`t~p4NPOP jilDaӦPB$0Y[0Nx0NdyPq@72 kiW  ook?}8hob8|Z'ihP˙+|QiuES*.+ix̛]q[:Ziؑে.5 xG;iCy֞|GZ2X3P?YҸGFIr':8eN6.+ۇ a$7ITj-h'.20j@Gd+rUPM͘>o1Φ~ 886E}-jP]Έ) mQmc87[ur쉦2halCKT$Vn3-~9g+&P(Q;eeHUw! ]Si 7P"wD"=[Y1ZsBKE<{8]q,~/"Z"m/Нm}X7olS1 Bg1KQ~gWx2X7qnTtWr#Ԏ.őۜA}DL=H,ɺaT_>zYpISLZ_ODAS&Z$FɡIj9;މH|=-}~8[STh}u$%D&*Iu2% ,$Qc|:Ư'pB;ugpS`‡L G(8-o]sdqȱϝE D/2<;o4`(Ո(QjD$c}5"J6x<|@@&;yG3ͽGd)gȏ )ꀯrbNm3?=[hZ_+a4, WIr|J,n QS*̓} 򻻻 p]}TsNj<.```}dlP_nU H5DĽt l( .cQZѠbhx 6XM;.U\vƑ6`kގ082,>4 /̪ȈBmR#7eATi[ɜ3À?6~]JS8ϣW8^&k7 bn `!%DX=wnFDU.fFs #\. ]#75͝1Eڻ~jB7n307e1Zx)JVEqͮ~{-,$=`MŎ r )i1h9_iW Ĩ _2ppτե ~ s"\ lG˺*ĒT(:c`ey ǹ4"ғ>JO~!*4jȻweW'bd!CAJ~΀pV6CH1Z-)aʩ] s1{F67vm#i} I5i 7eAC 0+k)%&i:OPEovE!FLbod҉PR|*WeҨ>xp"ؽ\N&#D]}+3[q̽@._|Wm(iΪ|j]dݢ3Mx{6tG`Gn7N$q+v,$U]M!`0t)؎ ~zH CD⦝A1 bMOk|'_i:sF7fnC 3#Ba9hs8(tbPvڰYvō>B,\|9l*&Ӈo%?DBW8{pW)Ax8"!,KQXٶۖ|1.V'gUNsHCHXeM[-Mj8Uv\r3ćǐU)cbVyYRQ5AXUӀ_YTK|)rX҈߾FV}|0z<Ƥ,7r5{(f3QQsPAR> stream xɲ`U"< Vt(rʎ$U|y|(4קTr⁃9mOy8adssB:J6aqK7E0ua1PT{"w:C!NԼ릻T-'AwgaPm+26[oˣEv%`v 9-ϵ3рZڎ k/e}{@@y36Ak5yt[)Nms9#΃u5r\Ut,mז3G$7R]Yc"At+ EpTUUq : <ӄ pm˯δ5y7f$%+rOHz$A#KQwe7A6p9@eǰZTaȹ$fkx~0=Δ,a^lWǢ=; poL[ִ>6I D.9 EK"̤~-gafL]q,\؀1W{g2rhe6gX7V\SS$4(D.E,Lx |Ӽcg6UEs"yE2V%J6վ*n8xi'c _kpg~}o#UVq!47N^xym;!{cP>0:51`C! N~.j~i;Li==I&5+P\[p'uhML$s1QDJų= \`[Y 48hKfoun7i &B@<4XVYĒP|⇟_C1gYc)(E]G=} E'W\22_N2٧J |TFCӔQ< \BqV-V$ű9Dv KKҧk>)2ᔢ&Ʌ&%ivf wjCOY@ sw9~ g02x1 0chB<>OXv3 W+ZSetƸ ;% Q PyK wdx@}RZc U?uyTHeM[b.V5',g2R 06#cDž衤a8ҙt=pW o{)"Ȉ!" FK e$ D6|!@f> *\PQWcbP젲A~a3VgʣóY*q# 89r/:x<{͉%ւ|,t俊9Yȸ٦Q[ݙ!z¯n} ?tarv # / VLO%.拧2g\> #BkǢe0ٻXA(KWJB Okv ߶淋w0>[uWOQ"9Ab+gїi߽}YDMS+n›Ao@S R!Fܕi!uw_1Jƽ@Vj'za]3(Dm _@зrXPi 1ݣBЉpv!@&fMG I T} =bby*gUaCJ z)}Y(J0"~^+PF"a34ND뛵@!u(9a] ZZg qu X"^#7:,ClU:֔Ԇ@D# B{x9MlLΒZ:AW]\To3Ι C 6.Z{ s\]+͟OVp6TXpA z)-f~'z6̝g2`)_75>i,Exq̥܅,f%زg9HI<‹ cЄTʹe%ImF8WC `˳" ^;k|LAio7O~{" 7QKiSzs˯bsIFo$1^yy'~={KʽWC/:@܌@RXVa?Ҟ+|5blT$BT_H:ϧBo5\a? e>~&VX$h 6FZN3"T'u̾8!v;i>*4y)Kp˕+}#@u3g$ xgK~CXQ0tl_yժX~0wQS:ڐ-p Xq{k-G]k:;pBJC*9q ArqLMĠڒ?#u,JȀc㩯u̖\J._)l {˿\:A)Q0wǟ@Z6)OiZbLTp Irނ*S{J9bXC X^:%o$*ʘ+Ncu:} \jTnEJ0ȒKS[{TZmpWon0 g8Z+I0*QJ#qYzC.6ʩL&Q/+}lxw Ob85T>2WI(UY[lI?ݫcbR-9--KyU`(X$ޤ zOV9hv}#mޕ?I؛ԡ?_񎴘{Jz-& eh3" NXmђd%L endstream endobj 1525 0 obj << /Length 3280 /Filter /FlateDecode >> stream xڵZݓܶ _qV;*"tP7qv2Mu:Z˩VHZ_}>bOgH&݋/Mg1ovw7,|7 c~,]y/OvE^ś(')RC^Vę/fDШQWy'mѴ,zYBlYx{ԶAmxP;jWu%3릕uKUly=NDb$@GVY~+o-*"WOK/y$.掚s5@Vua@vRR[Ydy,K3M~қtFnXE@܉y߉t[|Sżl~АmJzK5 `qS塤$?]W&81B.yEmUnXVs:q:su9J&|ŶS {CsEpkd7]"ܡoP԰t(l'BOfiLں;7u%&% $ MF w5(JTc+ӛ }13+.D?e^+Y, 'jfe),_}ެ,3)!>&}Gjފ,M i;>u^=t tXZ>K+ؔ줔gYd"<1jXSۼ sMw6'DY1R0wcMd̋4yՍB?JP4 'K]8v Ɠ0ȓ@~&Ͼywi7sq;.$v$_xl\П71\ 3(ѝC" +lґ9u{LJvc匫5ԵԳ# THp8*.Lp R+CBőDyMD~Je6j=C,F24DJ!OL& }!bk3F1ZJ;޲Oeldw `=hv.?Ma P%) nz"'GQɼ%TGPB*63xs꾲k}ͥ#Z.?{ipcEfϣCi!iPhvR˨/}3usRye}:qX'#Y7j)GG[2b"E x6=-NClN:ߴJj?A:p^>v``mq:.RV )@c]?b \ }xCNGsrg';|kӆhéc>;+X8:s&W{ M=PHbfj-~BO/p )BՅDICd&m$Yc?b$aE3b-M Dv>,4W4v\ci C$f91n2.5&j崗-50Ã:*aaɪ!X: W|͡iFh=2W%X7e%NuK|ܑ$Q fQ8NfGES32a5eQS kes:5u@o]@a4_jtu]S(Сcj(S>X! X1 xAd JpA[mxo*@ײ..バYJAA{m@+`DlK|uy3`P47~ E2|rci!o I"GFu;. l.]{}CYQ/yG=p@p"[8ޭN.&<Տ48|O8-=pnׯK42ƍ[#DY*&CnҌqk!^3N̮ƙq=fLӚM?6ÑZe!=P$%@DpVtƃd$]9vQ2Fj\%KthApY]uԫO,01zi{TѕB:+K]c?b H',-[Vzk-zPC !2ՇnÂcod[ 0SW J{CiSdB$T@ )kdu`>6B$;h2ArE3S6bIJαiU\j\6BX,LU_ךrCKJ<c;[uYnO}iԇ1aS=B=8~K & >|D6X$A>t~,omgҙ.dT; *pp8뉱h(Xh 2iYW>K2?r,'.a~fChvsބ֝)\f9&؏su=ǀ %o[YHp6^,Y/gipᇉ3a 4hv5 48LYX&ܭ`CδYٌ/oxϗ\WW{>[ooTdhnfFT;ĺV>0Ќ** lUT>|:w*s[禢O8.ti A;?lqQ;?r`L2YO\IK^"̄EOVYʮeAa8:NyF,xy''UVJ;r} ^~[ a Uf endstream endobj 1533 0 obj << /Length 3349 /Filter /FlateDecode >> stream xڭ]ܶݿV x()ANmZ M[V|=Z >3_՛$*{wpGQK8:?+?~ƚ D C0=½[$aJaR?m*Ccߴm.M}GG̓+'K#?siMCyZPav"<z:c)]ӷsESyF@-vΞXYm$i[HKY3M+K=qmUN’Mj`rna$|?7Y< E4(Nvі盾7g>z,uǢ[$@ʯwǒTtx.+w\"=mb F%=˖M]^PMל^&=BΙps v/ڮR9Pn^m,b[˶r]7[[i=t)M)N{MyzyI2YݱieGzҴ~G>q2b<d n;{jYBEK_)"`!sYwrS&^ m_PE\yЩ<9fR=̔fêFDϵ1͖ B/+žz͹H'EZG4eOJ9Q Ϛ~.i#ey`ff#^hjq0;c#?4SOr O Pc=>&JZ5Yyא Uo W4 )N r3 N+w.{ hfv:Tu~*֑LG7<|\(b#K?f'-[p.~OEqʦc?B\f93A] srr_=<56)j%"0D`P:WJCAY<'0 P&lY/<^Ah!]̌QYVSVI&N̾M*DÁ*"5WNE,y~ z|fJ} Gju6]uQed`!vgj`V8aaDDbo}?Z"E$3Yׄ4vOР?_pK,,p.S0СI*,ZYhFUxO_ sfO * txEX0R- v[:}[ytcB y _Ey7~9߾[Vd* H;m]I#%ͼ;\hJ _nJCϪp4_n5ɜ r@7I8^o1v#w-!v] OJaVjC{vnG xGJsJ/ǐmQQODUKM /)Ggq~Ai@ _}EG@qvM)LKq!A]XYuc@1WryiV ;$wM؏̀!p#=/3{3y,^op}&[z $M u>.TaM>D5g)4! p`V kU - Ύ6k^A|+f|j֡lٍZHAgxK%`-g:|DfN 8)26VYz(q( ʸҶdѐa:D- =v,6HS_2w6J%΂LˌLcMuTXWAIaI0|Xk#j߅l$q{I-D]|Q'_>+ Os ¢#tv4;L qB\*)G6tt⃖d(HNR&#a8Hr un hY,zdJ";Q䈥sDd6Tkc͖8H0OK'ѻk > stream xZ[ܶ~!<4/")ǭ E )fFJ;_sxJn`ġ/\?W|'xV K4Ǫ̃̄du[k,g_k#.a*O+$ysUDVZg)ks,2I;>Y_J ]f+5_77͈8fʖN?ҀKU"ٍx6j$[VLeKIz>}|}E SƖYĪЖ)*^5+F9Y+z~H"CxD5gb}܋Ek#1:]:+So{'SP-=O~ԛC?ED"H e# K.44Ad\uU8fe Sd2}BS|(Q3+7곊eሬpnWhLHRVlHL40cmKSM[|2ckXXpp٠_*< 6UF_ 7b f#x&FMvtn]܄C7Цl")%n[W  "XejX rܰhjn^Ƣ՚ADר^)ƥ;5Ag伤A>FHҰiHMfwVwꡦz@v)QtrwGI]I>TCiCߘ3ǞFċ"Κ$p&6j($4ǁ,e%`{5|B R|3) b5΋VKjj!!iX əO %=_9˵1KXd"*_y50`~ B-wKr$}:| ٳJrQ\T,'v]C@MB2)z{Wn@r^ns3'@a>vuNGŬwZ(.a'/OtH"C!%NYnUz)?`UL:M٭!Y%Qr 3øqڅEAk*T$<yЄ|l&W o=pP-@՟g#` f|}I@j0-cu4Rs`FӥrġD4jeEgY&s ږ;3q%q/-aVY GUD$YH_@aa١^0Z}d*L>UgP.U!5@xRqh x*+)f÷/) iW 5>/*C.> ]Q ;ɋÏū rjK nDwf*o>$~\eYЉw:<ܒPM9,ìǨ,O`yv/my*@b.CçCly@~Sھ#mv<oƀӺv5$d%1Z;=hte(p'V莤8ЍM}nD70RCKt+⡫qƅn?!PA_ual 1P#r( 5߿yWK'!ߨA4;.I65IO'7|B57⟵y7byFЇEHE4bQtLڳ/>"#I2%^T _i& HhLi@E"Z=W7ǣyT=PVa5tCd." MfDش #S ~xC|U B৚ȌI 9 ԊGp/Gl ć; ^|"8j endstream endobj 1546 0 obj << /Length 3701 /Filter /FlateDecode >> stream xڵZYܶ~ׯKU 9IEvb8Upvhϐ^} 䐚U'">n@=܉o^|eaN FqrJ&Qvaox422i 1EO;B쳩7֡F~_F(x,{[T*~:(U.s[Påwdt)ve~:=шC/ݑ9U bO=e+E+ɻ"6@Lk}YI Ǐ3,I-j4O?o:ϚeK}|+*Ji^V:+S%2 ~82FxYW'NUqG=N{)?u. Q$N(%BabK F*C)7GB;#hi"<jcʁS* ur`> xd!؊,6't9G"x$>aƪbSyb]\kXNZ$x_tk(؉1/+Xj@-HCKi:ba5cgf\K93_fB1osa}Ujȓ@;*hmi5x/([k}A9߃D ..EŎxQZ |>Wϯ(]? B9^ CM}iw\Caz~@ =C吝wixMтbQkP˾B*ѷ_.- 'hlұQKOɡ)-v@e=hEmbb+9umnwbX]6g g@RġL!%\R\!I.U~zj Hf88$`$mun\;w hCKQVT.+'1>?QCSvH"|QF@'@Lͫ]Y- 5ETQ0en`D/YPn&fO$l-".yf-邬#N|51Kƌg5Hr/c,VQʉ_{eKySnWi2aCkv- 2!֡ +P+糖@thְ$^Lk@fvٸt5Oע-_%?b}(f oq#U`J$<}&b6h[jN>T +)VIY.:\a lXL5lA! ߷d#E֣u*v?&^ł0df"n C,#t NKfY9Y??}r|Rr߻iʖQB2-u+ Z*}KErlkOK๊}2K<2GCoPd?fj;n7cfjLN`@oD3aavj`"G/[Y}c_$RT `ܣDjujdI@bVǸp`v tҋ3 ԇrn#=l@XfO9gg[tEQM1CZ2p<3z A,6o=O_fI" x[1sX|92l__:6c/HFa<27C2 zho7N~e,Iѕ;kx^\Ԑw34ӌx ЫEaݛœj<)xGVytro,?xjg&gڧH!IESLe2@ipPj 4c Yg7oխ0Lxyv!ZJhPP$yQVXq\솁']|io PEdm.@Oymr͖.SMлe#ȧ,mmkKm'2Pæ4&NUlGG|Cծl3|-i6=%8hog;pJ8CW{̀>W7 w.O`ӣ8/O~ZO:9cӀoBC#]]To)}CEwnЇQ8(~K̍͘v#nG[ poӞiճxo1 endstream endobj 1550 0 obj << /Length 2571 /Filter /FlateDecode >> stream xY[۶~%Ă?4&3}&m:SHtSJR>9.xKivEr__}$Z"Ot-"EH|q]#Ɣ?o~z2FԑT"̀#b$y$b&|)l h0JSk42n% [K mhTwԙjkmڝ h5՞I?.ud_d,؋'$Hp4$$0n8XӞWϟ?v[A^8=J '˕ePb ,Ԍ޲H$Y}amK oK%(G[8p^4]"4WYla$ԓXtR$:eQ_&qӠ:ضY= L8]!I]mCYv{ǂ?:)̺(O@ Pl1# $( -hh@nZ7umnhݝM| "PDu—}S-vq7v<̫1UzK;}"f?qljzSH#^%< f$%`4g?]ݟ9f;Ȣ]`8}h6z@*hbr?Й! mҖ]Hj\,:xߪYsqrn/u:XAuXBo8O:ar!\ݫpH#vT>D'"~4<`Bt0H:I,ԕ{Q:}5-G)vs >[U=\hTsͭ.G)!i&{LI i* '^,P2DEf&gD? hmu.%L4Xh{РnaASeSД ǀ)N?cJ)ZZMli CPP5 tqh$#a>U_!K9AAIg54}xx;)$Ɩ%-ta[A0zD^ T}Ccc\ORȐx,1'ŴK 3D ͔jZ@D \r.-;njCCdXDhw@= \X8 brcwPBcEL Ǻp$Ɠ+ X0aȍ0( $`M{% ѮDמfgJ.*gٖ5Maa{ ysb'!S Y ,g9WUHt(I -x}]Nwab3A*x|\yj*HVnFDr7IZ˓|l[SHɺƴKXcvJB(jQMy˟T>*hqR(\)hPlmh]#NR p2T#8[_qTpY' |\\X?n}aa&elp;7Lp4)1>|̥j!2р!D> YVU}+D?S`Y02 9eĀ*I+{|o7TbLSwLi 1Y1ciӮ7\o 4EOMwD;bjmVm3$"fC(m]}R۪uŷ`hk׎Ds@Cp WK5j?v)ᘴճy޶h7ԥ Yvh1=E~ɢk}p(Gn?fCBⳚOotdi8:bZ} E]mC~_x͜ pZѡ:o9=LڮfA] `Bfjj-c;Wr`cyF{Eͣlu endstream endobj 1558 0 obj << /Length 3439 /Filter /FlateDecode >> stream xZܶ|"l]q Mhwuwwk Z\Ep-ǐ7Cʫ+yGϯ=}ҫLdo*QJ&]3JտelG=M+}vd3k㜐^uƽY͢!oV*n*SMoEK)2m]{uwE=>8m[n}4%jևc0 N.,f_.akQ`FMޕ57y[XW ۂl*ʦvEbcqs Jbe̒nzzT \ O[̺a㾬nKmʼ7ng𛍣_ǻ2478),fEm7M}ROvD?n?ڎJ"T+6hw1N|6^2F'BF΋ڢ#7f&Z(}懷|C&ŸBIW,fpja 0)fPFXB7mygmL&S6h3>P Gt:^WmW; L(<@@[JSZ!A=:;^J ǀn C0Qo7{ȓb&߾_?њrjNyU:WQ?i]ධܿNBhрhԝ&v6 sIEͮKPƌO.5]E]x9)IY5v dOdހgSmD &:Xй~nXUT1e:[Ik0$r"r"T$Ke"cم3Ùa^'cx3r%@ұQ%@싽o7jț ]~:-ocӊfi Nj<Z؎<¹ky TE{j"OsC6P:(m noj"yXF`4C Ԕ#H2|LCDp,d\c ;m/p`׼j}#I"$tĔ7=rˑZ;̈́0ڷRmۆXEwBW]ᠱ]&#p!}Wv]Ih\9ĆH 8ȅMqS4 (C <$_y%mQM/? FZzuX)"e~32Y4ʲ&z!GjصT?2q22s"N@؇<}V4XtכOjYoڢ!}QM(U&Ck`7 2C)oImcKaB6QOp ֲVڀɠw$<-?b':43Fb+J6P dO@s%ό pM5ifah xuOV}RɿPU移|_TBިQ}}ϥ*+= `y:k8zN,šz=FPC[W:).a$G9ܜQ'Ȍz8'݄nnͧnGyɥ, %_Y}<2SBͱ8܍Blr'ҫ+ߝ9YmPCor~2$A;ȎE?Z|?,0|HپF2Y,% QKñA3=m?؅^o-x\j'Yȁ{c`M@EMV}Z[6]77xk<@| 7{X| pU)}7Os-IF!p {/µ݂}$%">$"wMIDVlMZ  n@j[|}K5ܛbԄԯp&q¥,t.KcXT2iKX{->f a%xYd}) ̿ 6ŮvuwY/pRjtTuHj#ifw32U Y,vC_pCF&"zE/ASi&Pr(5+θlF\6dĹvo@[HZjP}fR(zKË.<$JHkfF82mpR]#|5\oFhdy!\ 7ʦ>T$e;($s0 */dQRP|ye>>$R^KҥWh^ (!0Kk0, kベ`9J.NX.2XߑgӋd!Gמ,B-oA4m:¯mj#g/N\~qb83Gs(+ד~jqIK1٩zCeo|2,`%=Iv-xRB9ay&z%+ NPf csot~5#oR:~ٵC) k@xɑҟ(5}&F_ٜ6\z? ` endstream endobj 1430 0 obj << /Type /ObjStm /N 100 /First 984 /Length 2287 /Filter /FlateDecode >> stream xZn9}Wqa$ 3Af' n` dckR_(K=- n^NȶFe6)KA\)I|J"b"Iz^Ψ9 ]@*Ī쥍 oЃ F,0CFeu<.8LLE v 0.z XzdHA{4NFĹ dr֖" +bcyN9spPHhNjvI`COȤ\4]2#`\0Y' )gYV9+\zE(QQHX)9y(0e'QްA]lV`1^h)l擗vYFIN%U". Fx`"l=LVVUݟP#HM9t ^KUSկFUWz2ѧO?]q lhp191FW]FN!}H`r9k!(#dW*k^]^WٰW^&ϟ?Q=}l&y4,`EF]_L)X5g냍1uȬJZfDv]ZHܲm~ӌgroTe)?@w\ ,~o%/~ l#ELT4w5ߨ}e7w[_TO=Me')|үm)bD5n *q 0?s pZw!G(u$2նu>ӥ,،®S1=$Yw+z@2HX9!rfS΋ s+6=r*GB#UVI`&JÉcD9)wɬj$ʦ%)z$I \āV}[g3U s&l?Fn}vbr- &YJElg'!ѯm%wv& 3 X3`_ fT F&xU?z]g> ޶DbwM@؀0Iw wFq*Rg9W\n Q|7|4CSλxzcZg\z7{ 7iD`~@ NSdŎa2FR#c-3o&ly5{3/yȋ7itZW\Gmiq7v9>|>ؚ[fNpC⾷뽄(L#$D[ɸ͐0>涹( endstream endobj 1564 0 obj << /Length 3913 /Filter /FlateDecode >> stream xڵ:]q+kHI$`|E[3#X-%z%J;{ 0MdXd{%?lWąfa$N3J&-vO?Ep,ϟ DT,%2"Nm;h CR:O4aĖr>2<*n4tv˹\W{G}5 ur籫:}v\۱pԋBdwp0s0^Nu55^''!/We; :V+K50끮=#n5!3d`h t"ɣcrcx>Ƨn nhA~%7~\x9#7I,4"/qzCt1&&dW d$ÇnB`%62ynƱWn-<#Jݙ];:QSl[҈J¹lɧy(# Iw?uKB_}wV?C״ək칽6R;w,zjQY1H*1`r ^vGp<ޜT;v# &cfla a)vvKoR8Cbs}JAqS@[A5#w5L8jOeWQ0FDi|mܪUa }o]1oA2Ph 6;TmN꬈\lndIov-IP+#QŰ\PQ;0| Qr"`TSvYrA&ܗi c}jo4y9(޲Z D`l݈M܆AƜA_7WA/jZmொI'Al`&mE2݂|((g`Q:AQ!&Нƅpjw?|띢bځN:m;dw>0"e aqJOwj~"ʚ \Y*ֵ|&s]^*}vG^@'Y[C/?o" I+ ^tybq~*]@aӅ8©ORHcEwmA.l(+S@ˋ_sX)ZS8I?cs&fD=$༉54ی7;,f%7ng =\XVg17SG[ |N VcOuKx#U95 1)8\v&(be @%VupD28 /qs`_X-[=Lbٓ]&ajܗꃘM&j0\(! Ef7^$6.чHghx}CKE;d?g |SAS0 lWe\a䅽Tq_bJ﵉C͕W2xFi_f*lS O7x\ i:J SWW|ѷ7I`YV6nFhQ&0[k8C:P|k)b-HoA@P۵UQs c@y N+ط+w6]M.Lqz8)pbnOlӥlcԝH/æB7֓< endstream endobj 1577 0 obj << /Length 2976 /Filter /FlateDecode >> stream xڭZmo_q5|[uQj$)PI_}gvf=YJ 咜y晡~嬾{WZ"eY#7w\cSqٰS W'ԪG ޹G{p]߸+,-nC:z,C_DAd^G'D3p'"p.8!z0H a|;In K¬til>\?t,(ofV8㈑>5EL<)QI`멀 UhG_*Oqm^j"nB@*47WTigFfQ-pÈ_!xsio*. aJm$s\rk.`^s#vA \'>WI [ֶf]8NlQr VkjRSS!);1 4|ˬz w|c[bKazgC9r7hPrycST,pOL)c E>VtN&r Gc<Iszli,&?GdMLFI7}~ڄ@%cR8ᐑr0{{ljn%D)/2_]JuHH`Xe~]| endstream endobj 1587 0 obj << /Length 3240 /Filter /FlateDecode >> stream xڵZ]s۸}ϯSY&v:{$n;>"lq#*I% )=.@s/EOOɛ_>xw(%Bꓔ19X'"_-fxuZe#kII3ʙeM^09ئ#y0ڄfƲV Nߒ ,# jUfsdy+US&ȠIj0]oʦe54R "D3Gټ2v!W?9sYO[16TI"LbY`G0i8&Ii"yHQTiFцA$A%D̃ bDpqY7m]V\83 >" FX>T:Kt‹ ƘX8(_gp p<un8efxR7C͛HO>1k%Ɗ|X46 ED*PQ\K ":y~_D`ۺ.;FdX|E4=o^AHo7Eiݗ[E]]^ua|㏟ql<սo((0,/l}emSA%KshA+='K 3Os1R8,N 8œ>҅{:e}~R׫**ͫbWvhhMaD)aϸ&&8q >\D!j},H΢ȝ=ΔEվ+r ,#-pHF5ɲ02'=֗<_]ކ֋`=~L( 4ia8ނAMݶ奺@"YȌlP߁Ӛ0T W~2D8'Ceb^Mӧ6;SBsi OgZW'?Sh!kXVH(|YY _ۖ] x)F&O΃?`#C}$< ~YK-&^< gYeNo ώ"J%. J(%t.P 9OEI7/1j}G  G}AtMvagzbI\ںtqL^Od -"J 1>:3M9OQ6P\Xpd_)l6e T=4>OS/4 i(lWqw9m{L<$]}EnF- 7xc.FNt.FsJ,lJcf;2:ӅA3n6.tyT0=uu`8޷5rUBU"/,'0yܵcGL#&ɦvu ?^,^Fc<&M<쇶%$fk%eF%X0sym ^f*o6᢮7Z[_=mqo[g*$v@&;='S6EKr&hIf )n^yy(_p=-] [Wɴ{PffBX[_d]"0jH1Q?Y`{OgXmU˹5SjEBޭ8˲B|ztJ^.7pU=.% IYw7 -e5<ӕx]?~Nxj,B09^ 2sT68N.ULDIqФs iYRƄs+3gorvfoPx˜o/rQ/,~ MaJ7Lnק*vOcg)|Qߝ e|dwb[crj `j*ߜpWI4AֻlVv/^-JW=8,;\`Ƣ) /Ö`w`sac̈́"Z ծB1TwUB^UQW.f6oժ:Azl9uHxruٟ }?pKZup7:#V}+Z `װ^ Q <]+X6:Sה9yEwB&}vpe/g3Xvej\b+[̖,gƩ1 BCCj h{ojUjxqP#pp ^M{aB 8`> stream xڵZr8}WCUE4n V9׉LIm-!)On4@ Kv7 F"/ ;Z/^]8y%G&4Z裫#X(>94GW&\Ӫ)8T,yNbz/}oƎƽl/'S`U& B',$I.[h5 hhơ~_:ˆI $i)\-\T&߅JP+4''*zyYW'inN8X8#?%CX(LdLϯ:$2/b ~!(XiݨAݩat3OH1!^8x N!4n&" nyK&QM]I<묯dBl@omC¼7'\42֛X1tBms|j[*b;oHq%L=70_,O7&En"6cpJ}4;əkI4 cfy6D܏-;13d- K(8UZd^j+K7ZoS=HvڤM^/w<-NfMK@P$EfR߼nE~ia15`ro_9pUoӑLȢa1I7zO5Bk{9N5q'=@5'1! Oc#p><6o.>1. 9hd'iRHlD̲6!-xh+F19Y鲬pRиJjE$ j[Yn]yxdl1Bv1!Lf]q7pŻ1ʭea*xTH[d޲im/?L(h'#"(8ʉ*4r.~@{x=wr0 ( cno+U"<eTv;x.˽>˚}0G_j/lcEVP% @F B Y)094,G`3%a $-[2IМDcT,T<Ü09\v^ko;Gޚ4AԵ-d U]&|09NPw%`䋼'2+:-nʦ.A2׏~YzC#+m(O f bSS:hGSA~ 2]WN|n~p\!i7"XE^6o64\ x4BgqK[ě"bU'"aM9,U!C2$a .FGIY~Ofg?_\!Bob4wj2P1rYf9+HTҝKRyPtՀ^_ pZo*]sr?n~@!ˬ&q71?c*+ 1t+E:i@밒#\,+>auůZহoZ&Q@m}_ ur\;}kuvż1|btٵjy:ky||bp}JmˬiqY-3($Ӟ}]I5f/tD@0.tD\.ܸ(f~?me]m7 Kģ@\gĖE9YE'$<[r>eJȐEgiwW&VX jU6iqW]͑CU[H`6$T`B@>}-\=0̨TeѨ0 !O +!,[o3k~rS('=,E`b}Ǽ0N{3Oriv>OO>^~i)!]2<(` DgLS\H}0 HY5T\/8z 1JԥT@-B1 i6!&3fii(ѝ;xUM2<9d:'ccT{T҄.B(u D#=ZR%pd }`X_U~],E*K&p"uޙp5psuRs:'&+JWԲ Ϝ 64xtHҏZO+$Ӓ>g| IB"~Jo|qQҗtvq_mA'иY S7ݙGq%,5;rae|z1J_fe^ucY@#fvX6 zsr|2ZTُ.*U/Ø6=ozTMd Bϝ{P»GCC~}ɑ@!b_ MlD {>p1 ȜFh2Em:wT̗`MJ 1^Aݩӯ  33w% :8z]Q`?Pt tȋ{je-/_/D@8{4OVw_g+s^EնvMc c> stream xڝZ[w6~ϯSuND=qinEkTI*wR¶ @a曁 ;٫gZdq>9I'&Ib-#yULwnV;ڒ%Ia(%O"<zRNjn_LIG1^K,k"aDtZ$Qg R,c|a’{~7UG~ jvqn/UWoGMaU2KMۗM I2MMu^lyL+wW0Iبa/,.ʢmUƇ^x kX11($&0F5p9ǵG0q-'AW1 B6I,q˾_w/gESM{;KX 3NXfttK/|"S"fهY`S+8FLkŇꮬayo2-+똚|G&:kV4*M7lɹcw_ ZMemY pW=X7` w*{̞G{&i`DƙMAh2T4fnAw403Ƅ@ d1$Nb;0`7`f6{/BoX3O&Rs<~%>TV^mbkA`S@RR1qXӺ&7CA1TV"烓rD&= fP1{z@hcL64O,oV v1L[8efmvM|?~Bԛkqhoh7$;x,mӽ3?\]]uoOC}0.HGyw?'MO l/n\=lm|^`THUѧ~\U5 zTy۽{@es?j;l7`mi;? ZPh}g7;JB`LE)YAE`Űy෌VTRefH#@SN >hql`ׅʺoIזl%8#EyDs^'zAW7/~l-I(7k[U|n7 tJ"E|YXJHPcb^U[ LZ9nwPp3"툓'P] $ ca6_XOnzܑřlmyXGS/v]Ji o"}|c}ɔC 2D3. mGGW1. LE;'1N4~JO"eq*Um"9 , mrAKy@ޗuYMߓa~WUU+%5%:yH/? #;98fEd lbkX,oޝFgyN5mO=2 ioˉ9_,$I"~Y-ɑsv?i Ƣ0{} 0CQ[N>ܑ|+C}WQ`"OaH e؏r6WۧvI1A8Ýs0}+W@|B=WLbiN/l NDP=mWvhPEΖy h9ti8oƈ!1VxCf´+Z4 (]BNlf}ͦ/ 8`*VOTAbx,!=: eRjcGQ)R>_qKpIrXC4Q9W]"~ MDEf6sLɶ+㤻rAGTudtڮ# i;Aa d@=!YbGfDA,`NdH~|*b1Yr@zDAeEL9egw-o9R3_ Җ+?©͈ohz Φ wG%O$c.q[p.2@ؗ>S"h[RK*Bv,ncQl1KuY24z4-J-CTdIPGAR21ň`p YnghCك##'n}N[%mJ.)%Hcd(ۖZTt$# @x y9(9; N5HX$PhB#&24<4(_~,wJd_'IdXCh9*@e ѭmWW0)TH^U::щȎB'Bcؖ͏|QP\ɨݝQco}24C4A ̣ܧ'$F;tV,4\%I~'c RRxxIƯ--<ߌFl<f5Cq[CYSÊE1VX.>1P٥NDnA΋ֆ- .^qgyGM%'VFo-PM8HѣTLd"Hk JIu@kǦrswZ- ⯞!N#Dcw$u-]B\kG4F7+4^8~slgy"Űaj:R} Sc`Է e2G`ߓrXp|`3IE p?SG7rʺ;4Uee? ^SGkq^5OUAAa~Ţ]7E.WB>a~ZS.\(nZx]LJLFŶNUD1 kRrZNs*o5+&ٷ^B|kQF?'YIsG bN4xfSږ ]5 an&-R>f[Unr) x;I"/G+9L+JEolr"e:W)\cᦢ(z2ҁ< Ys F0*@.-͵U" sk]!K8SJe=>?~`3 qpyCH~x|hf]”̦@t5$4>>?iuSk16JԶA^Zvwt7D b-[Lw6b6SHCr4|8y9tͦ:oӘ+8gHa ]l`kTf7*ȣN&w*F.!>퐅'F2c$yffCg endstream endobj 1614 0 obj << /Length 1818 /Filter /FlateDecode >> stream xڽXKs6ϯPykUYoƇIj&U&l ٬H$q~}hK8ģk4 ouV?ۏQDn'0^%R8Vwu8Ii"B/=VFr{vPl?zGmE2إ'TsF"bR{0e-o|t^ _b+iK~W霭lІ9jm Zmgh.nR _pGy0VuޕMMo|m4hn;O؍A#U+u^Q  Ob9ϵd"Ig@B?:{l`/,`OD|εʶ+?)yvQ\b_xAУ8yNPM7_~,}To?7 'Q9ՁyB"{=XoN_] r|M.T$4{89=dǹ؛n{Lv:ؿeUpx4y[e%q>Sl(k$N"~i{xMu/(fg&Y\LYU_/H˽1o|;"w3d|b ût20xT^_(MV|S^ OG,L a `+&X7 VsašqWUUsusW3ӿRW%I]??ܽ7 l endstream endobj 1620 0 obj << /Length 1393 /Filter /FlateDecode >> stream xWY6~6Ec+ԭ~ȱ[lA]}H ˴ͮ,9"d;CE%]ˏp.GY9mz6zqNe;C 0vJ8Ȝ0H/̥|:J{;BB$q5 eD/I^7Hdvh޲čꑉ"/$"]æwwz1SaV|Ztk 5Pȉ}/#ǥˢ=8?o^X m.$#x~1k#`SggQ^FM~ d\ՒDiZ۝ԸYO"ιek [yxWFr&E{ nRxj"4xZ( $30#>`["M| 1(!aBmS*mu,ApP:`AB0 QG&8B:\y`P=JrXpr-S8:AFxc4=J::ɂ'TC(6qQ#=7v$$LJ6 lb/?q}ɏnB&x}\}SU]tomF̴kDPŽyaK+/=VK1 xTZGWcCv /C،>|"AeEn:$ĊZ:?pT=+T^J:R{/=]Ft{= 1`fK!\5nO94\zd'~4z* Q-R{@QBB6|4{ʠ͵m9АD=8 _e,`DžWn&zq x'{W3W7o.-2NphrnjCTRE >ix# H[v8E^F }NS>0> stream xڝYKsϯPy, STƛq*[lgrɁ(;")kߧ PMl<=?\$,czv ΙfoQwՍ3U0#c|\vmw-Jj! t*ZOEyt-u$zU7DmI3R%O4%,'4|jǯm*fq,Ky_EwI2ƠO HI!hf.xxؖߑ4HNi?|`XA 02~+4/@C>ɍ^0I߄iw1}Wջ|Y( Ǯ\e!NY`_P{~lDUE(ǥ+e3 \N`HzaP$i[N*K^wl^7J_Uӿ>oMX9Av_;uefK& &w#uڮ 2ooMZ׵[vbq[ׇy(Qt.Ckw$ Y‹ UUEKCh;PPqr,^PRb9`!v{N *zJzBWdSHzD$=Ijjw>6RtGnBXu DB7~ pܔt绩ネ8w=Vm8|wARt1eFOsDPR{lڍKwh79hIqy ԁ 1F2{|YNh.̥6=$(By!!(!C d#tڃKg *g7DBk|lԲif:cE4̧(f{8EIaCEGQ260+j7fͧxea$SeG#}?<glAPqž LAj`4Z来*@!F(K9_#zf\OU+JT}IR.yKb@opDžc̋G1>@gJ[9aI&QH\}J&4 t-m PKRB\Ë+FM'y9S/20e(ii c2YY,%nd xQ"̖E;LM, g>}R )a#8 1ޑ)53j\ןs7kTZ= 2u j:S坱Eb0ԀFն\.(p܅ ziZ?X4;׊,t/b8EY,tR-Î$ĔRg\V@syPCU/ɱ*J3wOzuSP,&}ܴ5M:Nwġ yg{C/9\5< vL8*{*,r w;AmCd4a'}[ \Bf80ڗQU!?Sy+p//ǧsP`$3fYnx<2>;FmƎEp+Jrb QEP1DŽ uפ6@I.8/ #@9<1x98Z\eCqU8 "[bcaBQƧ2W_}h+RƲ5W[DSe[%Fπ-wi_\jBչ$JM=0J&x> stream xڥVs88ӠHB MӝM^0 /ഽ'$xp^-"jr9 q36]#A)yV2eͿ]/' " si &Wx0\#r#wo0!3...G,xE4dRՃEu*sĊNIZXJ{QQFElJpY6\/sJx$Q/bzw7FES@rk8]Oh0CcC ܑkmar~Ld.{,t)Oḍ=->Je.zȃ,u* ⧌JSV0gA3;3fPdU.oh&œT]Tڈ75QmUh ft:֬=h'Kd+z`y>rǑ\S6N[}Uwx Os_N\/Vwo)yv5gBA qW00Wz{Ú#^p0m޲|Nyުm?2]9fa}SJgFr9gnKC p?:Z2b@l/]3xlUϊ/ElVL彽 P1l1lAl`;f` NG;8$~˅-`3e \0~<mn|ډ(ʱ'*˰jΟSPcpAN-kcc!:EnGF9d粨;:Ɓ~@6ȨWy%(v|ĠP\' c$0>? d{ hB9Z!oDeiOjەz3@RsVQ0~2 endstream endobj 1667 0 obj << /Length 1694 /Filter /FlateDecode >> stream xڝWo6~_!Ha (K-0Y䉒ax,N#;?~wί'oN/IYȹY:>L>d,n>ݼ=J.5˺Qu'ZH5<ä$VMF@OXm,qT" uPME$8!ۢf䁛&i3?tBi ]f"k]5MhUɼ>r.)ULhA2Iho ӶjA*vu40/X Ȑ0$_yx" ܲT֠]5/2i#޿ fN^`VJvѲn3 Zhc jKŧ$[ @:amb>`^5`^O$#YEܮma=x1=ey xBxuU>!CS1M 8PLkSf*Niġ `#|8fA¶!IL/,?xiUݒGE5 8(EzrFtT )keYYj<+I -D7>ڴfmBuV"b\Xz5 ugJ,-W3R?gxvu9pک`۞˻j3f#9bfmnwww0̓qe+EJߐ EO!appf$ ^_~E쇩qbL^Ve6ZEE\~*_&˿d+5] hRV` J[^5MNu]Y[e{.cWxAyuvK耍I" vq`>X͢.!?d|Yk2boQ(X\,\+{W_a!>#{ k Tl5 Ue[( Xv|O̗),i~4i=2? ]Bؗ\qn+a!E8 5ȣB}羹֛Fa v: $:lʼ+3 zEBS/VkZkMXFn=) mYpȭZ\ң_kQWWgvڎ0ʎ"}[h v.竾@'Nُ,K^-< *"jIjKӦ@pEx0}Y32N¡L5JO3 顰An{إ_gg{)*=>Lsl @kfܜsBWؗN>; L,];\8@*?)8ep* |G$šx7)r/uzBnB,SRĻpX"d/YD,iˁ&w%u lCTAT5 Gԣ{ XXGW`]uk蟟̧ `ch JG.> V^cϘ4es #Ѯw Qg mu5 ٴr ߷6 endstream endobj 1567 0 obj << /Type /ObjStm /N 100 /First 983 /Length 2125 /Filter /FlateDecode >> stream xZMo#W{,d`,`I9hmY[2d3R˒e-!Wzd3>7!B&8DN1q&JA?׆&q@bCz/O# q:"c>x֧PNgLP)RߟQ;7䃎(W$K2r}Z qQP$<D2ˆrTJV4pz/JlBQhBE/0?dO /a7&H3!*y%G:HED%u>gz<$;5 `g%}b4EH9PG$H56a>N:>c5 SE Ai&:3,x/D#\&H l$:YV4ւ 'c4QHdR|J!*LH$M4E2IBn>vj@]aSS,yfD[D X$X.Y#y YP' \Dщ)k%CDkI<+3 88:4~hмgN1c~z>/zϓᆦ<$S5|<O0ټp<駕VAYAdz1͇ݙ|f΂(AF05X&d-wlL4|^ gvx=G( 4͙S_*f[]%x~'iN|0їv2/{j!´Pye4M2 ZGO ҧ%yB`n~N?6i>ϞFb#6 W$@xjWXB+[d *MX`vf˗p9WupD[ࡀ ]ִ%pnWݝCgE}k_Bsws3?qPEg =V7]p| [.TZkCފgxy9]g=G]=K@q*J,'74糫ɸlv{ke2tN?>I etɪfݴIȢGuunKe^+kez23 e~P= 媵yg\#HM[{7oNbU[t)ݟmc1ONUVORqrp|03=]6RFf}vtԦ+YCC9-------OO?I9JYLDݎ+ ^;6o\,#tx~<,TR8x]?ig%Hb^W~R,qP6 GIMh7<'=몭[+ϒ׺ovcl1N;#3/#zmmYcW+k>X.v9X&zZn>6;cևؒؒ=Y -^? m+ 4AJzv<'@kG9@dݡf̯=G VyJBb\9?6v%l ]- 75嗋s1'tFr:W:j36HQM;J_E_ endstream endobj 1693 0 obj << /Length 1739 /Filter /FlateDecode >> stream xX[o6~ϯa]R kfb[mʒ'u_Cw/Cмxx$8مAIep ƈqD ɒj UAv-PNg~;`E1,LH";{706soMY4/h`S!Lf>ֵ*Mq7"<ͩZUЮfD6 qYJynj:7U I)_KKXD9ƴn|@#K$b28-|eI@6 m|aЌ~W$zu MPǽZ;C"CeC.L0'@P"?223ëTV.*NuBUuL@5I?L8H$'9eL#0.A3*Oܨ\s bSȺuϻܬ\OuUO-mKv΀p"=5RˆNY L9DLPĒ=I2NCy=EOcEN.QDPdm0n3]qt(eRE"DÑswӍF"9L7c G2៻rIL2'ʁ7LFJޯh#+kdAn!X?Y r-73p5V:ݪzbˎv S|SWVo~tM/x۸ZяvjW͡cB܄+I2SGLs/͜\[(D!Yg +DÒA1&<6%7CD)*۾81wN0h>a&QTz%"IaoFW],Fo 7))Aq_jsaB3׿dnTwzp[ϯN>!M{Mg!}O޾:M$vuA,˓?'|  ${GG: ܼ־a gڳr@ ף#M ڗ`Fci0v1*#8=V:Xr*z)TpUjTMOWdED! W7L*Eu_SfL:Q}leoeyv}k v }TNq{h-Q补@X4Y%ߞhӲQW^?TPœϛ迚-uFoVy7`sq},XO8yZyαo/s·w¬ƫ6&Tzn:-°e]v!gďdֲ_UN 0)iҴAd궷PaJovBޗR6M' endstream endobj 1707 0 obj << /Length 2233 /Filter /FlateDecode >> stream xڵYo߿¸S"㶸-ZpMч'K[Y4$y_3!E)$N{pH3t9l>lm&~GQ(lqlsx2aoA^ cX]N6O%:HMsoEDI>7q.'Սl,bsoCg$q< .[F{j:l<e[ ߹G<Ejyn,N$SŦ SgIQYIfї)p=\$ߊ",c9CCS-M`gU5'x8zHf=K[S-Zs [=(,ZьKˣ͚#8lnӔ~ӿXV82@n3Q5ze3pGmyF%XDw9̭v!mN3}pyN+;=CC?tP4L7I_QsΞ¦<31L9T:/4G۰jiWվ]- 7@!(EԐC4LLGbUbJӍ64(j ;(BiBaI§lroiYX~AC/TO ^[(ޡFb>nԦiuU`#aJ?rY_as5{;5"(_\ [5X`?:Yp~'&G ,9 >RB"⥦jV"t F񊈉bdS&TS`;)2W4Pm\žQ#50ܖ\qjK{86ՑIV_0 /k䯨ދwÍΪn$2;tT( ?<֋xԭ+ŏP\ ?)$:L219dIPR㗀"e%`)uH|1IFk)416>Z H_!d44(5>N8%=En=PnSJƽ7Ը 5Պ0ūfj 6@QB \{xJhI xgz׌?ݕV@[h^.`LƋϮ",3rU1'^bΰ/ _IR(̷~{hjx]$˸r&Vu5!hoLSQk *;R-mm1&َA.N[@aE;F ik磿]Q4C V]18^$M[Ho䓸*ˆr&glm˽RwS7¢osȿ;^qW-Y)cnqpVGOuȽwKU6}Ȓ(@=zG /KԈ6Tf#+4X&ȰӗƾQ n+KN^i /d |]~_4:'BZh f ٟG kՂLe[M֊^?9 Wcd2r Zp+> stream xYK60z5@K&HޒdȢ+J:3Rd-4gyb^?=zċI,Y'4X勧rVmC_P,z[9b?`i yC|zEΜUE8ihjڎOJgJJ6E\Elyk7ޏ>۱GHNA |r\A)aPJe%LZp€-WIzﷴ\hE<H!5FD[C{oD&z(~yF+% ^(=>gGr/xAyU<]kQZF΢*2x/MvHA$ D+U~Q4Q;ш2,SʦY!\nDkuU8O}otеYGa 4C4a;qp%bd%5GE>燭L/p֊CQ5$@E3 >sBp}Bd4+Q4̭ɛĶ|?0 F# <# Y1Ti0vc;rPi49|$ZjP,P ڭ9 : ӄt ߀>j/$W6kІ:'"6mGRk*,(99+z@yO_ĥ*r.'S\ #BatXK(MDD%"r{){})ԁkaJnb^O!D$&8 1 x npnPGG?Fx$o2s%cs?~mHE[mH13sJ-0RwTeҩ8oG 1MsFS{A%յ=L9 58Q:)>הkK*lq3^zz-#νE)x@Dˆ.\-|,ܙx4s\1R:幛=Eq Z_8۸~imP2 `A]uw)i7u Sj ՝+&Yp,Cߌc5ыJ"ls:9WbĜPld]?)k3VJ$p, XK[b1)0> stream xڝYm6_a$@!bH=\Hz a~h,k%zqEiͯȖ 1I Ù ~~~ݳaJEhu[I:V"Xwo^GDTZDq ЮE>C%:|^V'S7܍aP͚̞٘62 iެ7Jnhli߳4nۚ%il I74hO`Ź!(m77]:e}րbq4'^q0 zĞ:]c [eɬm{fOz[p' N=I Dg?MH?]es?*l~kvCE2Wt{֡5ه=v*yr.FGUu0xKBq ?~(JUDC󜊱d^@Nʪlk*i{rYSX1-p!Kv4XZGLV@Bxz@KsX6:&˦h G?er˜Q7Ʌ ]ed, r$C%Umo6@-r74&~ 0vg,zVBN֭V~rc8Ml_r1.~ԂMd4&$0:==e a -ok=(I$4@A0ʼ\P %vH"z] a*%+ 41sCh'Gc3&GL7>tfφOf i]K5~.qv cΫS}ەڦݨ$ 횪1pI$b0r^* }5q¥|.ЦRTMatⰿ3st5y9:*k>|uqO8qCڟFRD W8rmvN#0~ P<}Θ?M64Y$0] V}_]G1j%Q/~RΔsn8&A/7M8pލk6q!i.4|z {dp{<(f;X]~v QaNؐjkwX[wĘ m<[㷦a@:r~%P^xX">xjiFtb‹`X*`%航-@W/A\%J5> "Td}_E/ҏ{T.P"h*=eF|p9Pϑ~,=%-~Oa&Q rwPK,!)$YjU>d7|^QG{#f\G½m10Ւ:c4u%06 }op,b endstream endobj 1732 0 obj << /Length 1567 /Filter /FlateDecode >> stream xXێ6}WCmbDQ+R$ۢH6<%JKMD\QZ;- ")r8sxhh;ŋ(pD~\yc"8ij& {K/.`%I"' Uk夅gzqAٰvIQ]?A=|冞kz֭=m}nrJB~; =XCU:aq J5x >F 'YC]ZFpaܼʖjZpY ^'KѲa eƊnC!>RtoMpg!&7u٪3g͚k&75-Ůpkh,f.dSv-1Ct2YvfmlD} (vBȊ4oB_Qm:jY#+uԉg##LJ``9h1,B_gKNh:U7#P >pF:&LۥPB)2#JȪT*T$+ 9-Dž ٓ  O-mBP뒱\[qby>SDYc"o 8 "} RLOJ̌YUJ rɠp:G =g[eITnnA|7s$A;@ClQ@:6pq̑$84{XVě~^SL|9<{,c)g15*_XeV9,*L6 +N0`Fw> stream xڵZݏ߿ogHE6lч@dՓ%Cϻ;RW{ަ8`I3 ujVcHezܭD*NWac%?>U%EE&2v]1^DAynFsR|7Z̲ue}fiXn۲_, 4Nz[Ix9Sۮ9[Rux̡;7l4eUʟʃIkD(=î_$;J {wkvnE^iοx$fHdeIPv4 @" vzjyt;|VTxNP2 <ֻy+4=5j:\saE&YJ=5sh\ջekDm_w-wpn n)h;д e7vTݑt;ԛ}欇 ˛ ӤY.j^jqERI`A`er큕:R r>H90 eSn;ᩌ2Eȃ[TdEBuAGН-OF(["hFhfΠʞ9 c3"xvJR"#zS9GN㩿oN™ʠP7c퀝(tӿaj1yՎeiD v=\٧E&QSnt&DdR(W)ryhKYa wgh? > 7ZhǍ?2cX::@ f<:V+=ES߷^UL;;o+够! . ;e'uhjQѕ^Y7o Cd NQA=PNAj@ZD%u;Z>n3#`No uT$FqO߭~1 3X!VDznER5uߡH_2һ{C鶥 Id`G Ql gQΫP|F tēQ JSӠ+8j2I\4ßRa ;Cr*T7&OA1Hmu_'Je[1 xk6"8MsUxp~XJ7$ p.(ww5;ĀRs9@)9kU}w:a8p4 ]* Ix6YQB»:H P2Lg r'Pʐ 1VȬZ%cK]wq|y=yiYQ⅍kdٱu8I5^'#CqM]o;MmfӖi'*LWC:^,jpx-@_u{{tm1K2Ec2йM)bh0K>-0ZFi\ژRdRgI6Zue-$Le2xӈ efgAQ)zZ<$fAsͫSiiٌX+^/`TARo r#;s2p/`2~p); QdGB-915(9h> stream xYK60r J) E/I ={K Ti[Vt%9_)QZ[|zwsLyX.nv'rFQ(y.>;ݨ jXPnͯo?sy1(tR}soԊS`rܞ֭F'2̳-]Z, 0*/7`n>ݪ@DoHj9NSզ\Fv wםjiPO\:s!hkL7iZZ cpVQFɻEqP4( 9zJ>Pݩ$@7Ӝ kH[OF6u-=H /[Uop:;9 Ȭ޶ԋP>&؎,,u3O0*F)ZZm0[4~"xlfBHgQt=$`X\^m &qj/ ZjOڞ%ZXJ)c%R/)FXBX҈!Kz5#? 4/x" @ 0r|x H2Td(t;FR\?L Noe1s{q,B&YE8o .w0: YǞwTN~dYtQ FkIE-DzVMQUK)DtC)u?4feB<GΣ&DuEM|c:Ftm% jZ,ON;;~JkN\<:e jn!9c!)}@rw i;Kgr=b-ʚ04YX)ʨ4D.Q8߂˞ɹ)ko\>s!+%.b옄vLB;p4hrH4Հ&iTzTҝBQc8Cړ1qs0:'"Ԍ [yյjZ3OԒ'.Uds!r^ZWD1*As=4D;LwR!srۿNEc綑ͅHp,]gDQQXu%CQ-H[pNN{ >ȄWs/t$0Ln˿es}vYlHxpev7< >QlIYg\~m [ EA9JUR#cKOC]BFPt3{{ֲM&IIb |݁x15CACYh`iw(aP_kHYĸÈ9 T\<$[YU}3WN̕^%wN<=YUEeCZyz0vu훐ሧ!mrke轷` K;G(=Z$xv8sOqlIRdhV;~dB®(MB&9uwfc*<\RBWR * w?c[P*źR\"T'lm=="ݕ]&M Rc#0xP~1.Jy _$G1Y#2a.ˆ?> stream xڥZKP%L|ʇu$I`*DͰL AקA I@ģяJ6Odo})+7roO$BR<7?me>>i0TgH Aal$A&M8][>E0yfTs3mg,E^*nem|-1M3~~ٶ9R Olk ip~igjؾ \W3pvl{ԝ;]Clہ,#VNSb=]>`zL^#7О^ jd綞gٓ:*RKN,y ,/yᩁGzs"nOЄR dKi8ٚ|ulkKP"sI*g-֏ij8'Qʧ?ޚqFCDK=:LJN2QT{|>`;Ѿ5qtyEFt^u;V+uOف^ eZ$:T, zB#p폆ڳJJ(gVt4_1EYJ׻+s1t0diA"Њ?Rت\SBdi{sP(uO>qYy= ,ݜ|[ z,E:TѳgxWӢBeZZAB9!]euWDNmu+׵pxo1j`YlPps뱵1 ^{،6iԚks}DmjE#;vLxzMHxH/]} -JYVA 1>tp!]Pފ}B!RYaQx+fId=U)Ws "Bnr>fQd9ghb̔V y?^ &LQXCn!u=V@'V q U[;9}VCRl~+c.Ӣ9);-Vˋ 7 탐5 i}'|8B™v i;)~%D.eNfŵJ;ѴUҲ}5= hu]˃Ǟ' 9/aXXy(笸gX,zG_v14Yz:MCk&XOu;v 8CO79(XoQ#^#|y~B.pVCT}Ckȿ\\@9Di&ļalxeM_¹{h388wG{%4goRrSZݦ$oOg)%$2cS;͙\egƮr(=A&#K jsA s 8Y֌b6pL 5$b !|Vv%R.XAkzVNo[3e<T@rV!i]gɂ;hsL8L+^Y栲|Ӳtd !%]9 4^;{~;ay q oB(adz8c2E!kAz+y0{OSQͳB~)8|Y+)EU9UX\^9;z\\th,v˯8]s0|v r<=*L;r' &cJ Q*-~C@ ojRNly䬜~313$ ^][y_@|nao7d?i0zT6݄|h^W0cP{32O !H!Q,#/e\lv lroHE_H01fwuBDnpE"l_P^fzlS[%۷h 'I( \0Hy7et9$]^G?<#GdF%%|kc>n.Re ֯M0rrPPaHކX|hdjmpp o^;Ok]E9aeis5 5i@o9 [-KsRCwϏ6!rx5$JلN|QP\Q[I[H*Gwڮ- endstream endobj 1760 0 obj << /Length 3142 /Filter /FlateDecode >> stream xڝZݏܶ_qKH}EQרić5V{X+m$_]Cr8^xsw_o_~7*Rn0T&No(R)nn7C?ԣU ZxܛiTeE|iN&8E(Ku÷:Im}6˛7(WinV"8L]e #(#ƺ][e;2 {/#+[&&ʃXwv|#L0,o,< q,!^F&s 2/;qnL;s8ڲj搨8K=,Sٶ3PiFbVӁ(7ki D_`|&M٦y|?4m;Ǫ<`iSRh%(挽Spd %Oy>Y=lƻ怗HhtqW$A/G;֫?O9Rdf֖e劂zKre\eo[ V'j|M~>%&[ЖoOgDQX<=j?o$m*:]"uzJ سa&3 $;[d@ۀe k.^tZ h5Ewop8o6-frHԩP}{8ry{BJEHmi4uH]_V0\`\ į5jKw4^-*TǺIs rdvEШ@Yp( D@n念 N"a["!]mjيNn#0(Ā! 57 !̛:›&g B~d8tN0\WhʀBms\mTkZ#{T 3@*K; K5΃gwc=0ȭZT׾GũPetE۬uUz!yv +*y *Y}\Å\źxBSn{n!r DOBqE>zLeN.2Y"1@Q up,S]5GLn ]O'-x_m0P 44apfx+r5 Zf3[;K@3[gSԑv_#wJ$)FRCKY>'EH 8M 1&?Xp-|ZbMt/2Gz W.kӯ4GNHsHl\.":UQ(9ʛS 0· 0CFאhI_p?$-6gh#ؗ#(ֻᲐi@sS\d*N#'c:x tJ,7UkӅy̝ w; u)!!(r [εPDtcvPMŝ9Onw<[n3JBTy*+bi:SY?{XuijDA[Ȋ]:ӿ P<"J~ ̙=0J@k,n#qlA`F%>]Qs7-w[;{4?i/VY!BTʊR)c}* Ԅ42co̚Azp[hGH 2s1c2?whj_m|x){%)޵g `\ U;eClSm IsDŋH"sr)} S6@86J7cyjTLgW IfuL\\fW*q1 ׄ83bM7bȉ6,y `v+:kŹָ1mq+Voĉ bﶈ̴mUGq8@v:wS m8D ybR@ώX<:4.McI̜\ʩ%E?eG&rၢkk-|J>pJ +32Zo4~&سj%e&dϞ "ߓ7~2H?ɆQȱmf WO`:r_:SZM &!g lB Ŧ|rs_&R@kY'p9,l:60. X_$+_53*q vBT04b.JC.q).#4.:.V8 oAQalY'߂wC96 aQq>jKsD^R}? ޗPJt=S&fn/_=Yŧ#nw&]-5KߓVL[y򠡯~j=֯~׳E01<R773 F]aw>0]dRVVp9qR[Hs~lu߁{P'邺"B>G@L"[ $VG.L!_~H@C+X |\$s*s 57hӾl@k 0HHJpw<]9ocs5i*kd_`O6ו]s&֊,-guD*^"}Z,JmRe2-Z-/ zE#_)7V^*Q,5,3+7yu)Z}ި VHubf3! θ`.VwvVq}YL*gbW]f/$EM^Ja ϡZAS'~>{M#G˸U㥍(ɩklR*.uF˃ x͇Z{zDxQ*pҌǦmς,\k9 C *PdJ3 @z2tŴ'댦`rVfܠs(ѥۿM5f({+'ײ-/?=|X4i O`٪RI(MY{~A9جoB* endstream endobj 1771 0 obj << /Length 1545 /Filter /FlateDecode >> stream xXK6W&VP4[ h붇$Zm%w;|i%[lz| )lm-l:y,ȊQ8Xcz7V&8[Z\^ a$ѦoPv ?1 aUKaD6;{rzF֜D(#!76u|6BN`?L &x[cc-)FvU &"{5u}>凭boJrNwnne=dgMG׾iKi\ybzͲ<(5|"%p(`s1 =߈i<G3"`b,&^uxnO@$u]Tb9*`D,@B8"GTAB'@8Ŀs5m!< =p?رH{`V^M]7 =k'a)ZZ6ovjA:0A2ي薍}I9FY |PF4F C?X&ln^4nA;rw=oN|y` ";炗?FU.E9x^NT1;/d3¸x Ԑ.>H7ﰕ"xqdJҽ:˭n&>x_.Y(r?n q)⣊|7y UYwVu{=UYtLP;%,F\|%Ϋ%_z-Lޭ?(z Gߎq^W#OG{Qu) endstream endobj 1779 0 obj << /Length 1912 /Filter /FlateDecode >> stream xڵXKo8Wuqȡ(Цvmk+(5IpHR]:p8oYl7gQHYyfpA]E~)pٲf{uX34bq>%:1 9z -_y10}Qf[>P{yvMY໤U8>{DA4ʤ#en5'yE"&@X cJV pYF6ȟй}fu-ڬW7?1ؔshxqur PZ{HNrkTw<+xcOvroVH1@ gV~So*k~~QnKبNoˢ=lm@c;X4lv͚׈ۉ.mZ+WKdP /\if];t4[ټ܁U vj/L<ԭz a/+c (CO9wsX~(=miFOALz&޲|xjzCbCT~10!יdgĶ̳ 6VP+R`]:aTxn%=P!DF^$v[•ӵ@bTx4AqEa۹B4fQ"ʍ# v$&r-n4v `̺E37 ~W(^˟Jz"€9`y O ( ,Aw(BS{P4P-o}Ӈ+#+zӛC/P'X > L?a'q3U#;GvLLK2% VRk* Nf-шpLM)k tm.*ʡWtMYo'TI9FƬ(aO7*E{IW^37>8JTcJe}@)kq)P9&C:CCU m2ϔ}c[-J4S?@;-ͨwYV]#!%8lBvFo> "t~2175WRuX]OAt903@yDS~פ \HV9ێsS%@AԶ.]mhn 7]m2>, ݬ漇8fB}H,ו fGAJ H\#@bom`ErPHD8Pْg8 qS)c DiCB;\Z #ξIziJla.`.iI5Nx?gZFu)1 Q0>2c&I9Yq|7R.>N2De(x|$@ xh..-O.)~,xR&ӎĦ$/i_LR|kujĤ1Nh~joJ 揫5R#tm-U2} =̨1,>3a~W7ǂ T韲ęD|9xS怅g:m O{N0PCsUxYEh5gZÙ}_Wr>,<ߞM TAO,S2TJz汗(+ I$ZxHп{էk143o<,MܩeQ9w[j9@7D`w8@Ε&}#wT%Qgqv^ĩZ~ endstream endobj 1676 0 obj << /Type /ObjStm /N 100 /First 978 /Length 2095 /Filter /FlateDecode >> stream xZo#~_\3!#%-@\[skK,PZ:K畼ghw W1 .f%>d") \Nh,lBuZ t>] ,-jF! 6M虚ii0vec&/ե01&R]hV큚]hST`L0= *pWm ,]Kݤ∢T!`8`FvXbF4=\S cRtx AJ옸I i¶?'d#c͜TTnp\3ؤڞ؉#m[ն0Q+VJ4EHj$}Ѷ-xYΏ16ITl4lV[ 3TmRv9r6 (ejFh89b&kp6 C2ӫ$U0#صеah%:5gZ5uZrt%T/'W"~cK47VL^RH =Z!EIvV#CO0+=Z)p`Om/ŦjMMkmV%GGO ٧׿E0oEpv-jGa&g@NfӅ;>v Vɉ`_`F,,R~.Nutwn=ջ?n'qN;aq;YCj5SAA@ɇ|r0@aAF@JOJd=F_C}b<8#7H!Pީ T}~k4-S3*h$Uo g8PRVDfS\g k'mPj]|0eϘZbĕ N~q{sM?Oo>.wuݧOdqYl۷E[TzEʈ6^P*++~$FXFR2VwjܥRk.aP8EQJ88 vJwp1$ABk b;I,/H_y'+`p /xR=(u6t*CSl]0R21T;3D4f)Nq>V^ IWf4XAPmb ێH 0Cb'jS{jyE ޴ى*v~yy;;>lI+l<|W9+^2[JMro:jGUA~xп=%@}C9z}H6mέ Ԏ> stream xڥMs~nflCe:Cҙ"$Hb H3~::X,~c)9lOt9-6eXf27ad<,.7 _%jG3 ^c؟~|m>DZ6NcVi>0[/²̺6J2Iv8]AGMrzݞ OQmaӱd#mR#Boefy,V=U[aGLmQu2p.MEM}wi+D*J﷑ԥ P$d&ä,-/?gȆ1( U-S (4 5_PXz7v=Qv:߄0`NHtN2 (l=Ii,fiC Bijл (n'a9蟞t}87?݊2Edܐ<( e>&cAb3RM}E/[EӐ.DäYq ^{큷f  ;l`s|TfPF œr ڠ@Uߝho50GyJ$i,%ÈȜIdƢ$ ( |o3+eN ߁2pۉW8b^z>ף[] =w.Rf&QDrkE&r$"@ 0=bmTjTfs"?na Dx.#ͱ[:evIJۄ}a6+g2M7^}U=%;q UkG-3p@DOL^಩2ZƮtFte>R[DIRHTVrs|2-5b{Y_Pԇ/ cv~d^Pd6fKʢBҦ'L ߏ|d^#l+Lɡ+b"&NJ!O=.A侮LA* }08v(' #IDv"vqSq#^WuǪo`U|6sOu̝O;qY@k"A@^ѠQC)vLD@)XA{tOW12nքO@6IJcO HgkHNP endstream endobj 1795 0 obj << /Length 2389 /Filter /FlateDecode >> stream xˎ_!,z||cO d0%#)|}ɦę( YKqnwhUhMxCVXx]BfQy p+& >tM %dpe=H )2hfc1<ǩoq;2U۽FwP-hK"$lp{.aI}jf B'ح+&6XE̡(oHziE:KT cwG{>-,\"|nq0Hj+œynp';;vQ&NqpNlE۩hHSO0 lYMdz3"ߵ; Іj2IS$9Wmh$(XL;^7}۔׊۶c1zBx)Jr˖A.\A.󃜫#y͌Ůj rYAuXB@VݪhZq((cl:xXp&/5=M&8ROh9I)$J%}*uQ=*-\h+HqV T_n;K+ F NEg.`K5/jg_kUَ][]{`ɿ9%O$b߂/ ҅[@{)T*Qq'0nV6aɸBԦL.8r.:Hdҹ̹lsY'Nm ? NkyD)(tFpBi2@4փbΦxyQ\l!=\jfWQsC_O-cm3 9'qNʣy:X팹3w.E%>P>^lisZ Pkɺ?w* )+jB#șmcCOHQ Lʦ8;.aoYc3p Hi1'm!)IϬd_3~@=@8TBX5V \w`(Ǿ()nsL+q|VAꓻt&mUl:wU>R *ng.4;OfCrmh\l8Tkݙ,:3\_y*,r{8L AUs:LMׅFJDֱx\=ħ"RgasK"'T|VčI!}j^﷖+$t1-C\Rfi$E,ge݌?Xtd1B/x9-Up0;j^{Hu$?е eO]|9&#ĞG4eMZ?,3ӡt&sW2v2=/" $2h_h#jZ[vyf:D"'jFaz٨R-PÙgs/H ^V1FJږ !HGVJɮ)Q *{*SS}[³ S{8~^#%HyZh_d?'=Zr_Rrq fGS˚ w8\=TuD{ $)o``"F° ͩ@6M>/^G1Sva뽊$k>H$Gb07M57*!=G^5g56p 8ev\=­gZmI OC/,cn5M/3lXW{eu8id0YL 5I#1IdBKl7Fʩ"pNH`WxQ¡)A%MVъ_UF?> stream xڽY[۸~ϯ020È}͇4-2,hѡ\?dqP>J"d@[mu<' {Alz_kp;ǔk# V8}uxQ>$ǭNW<ɛ孒j1a`Cj{4^[~*t(4F٣h$UQy;WVKڊb Lb6`"Ixӱ#IT=?ޕ<"sߞxt fpGTkǦql$6|\ NnC#F&ڒ$SwjTla ?V΢[MF-C3 ( L-RnTT]Ao~{^P%{-XISGuܞB0_SmȈhqq 3U(ϬƐ뾭WD$mʵR_k;p"̴,5,6<\OtӖAhGYqgbT^mnCrGYOY"}GQ,2^5$SOJg&c"%zOjx~yٟD)me朊+7L*ͧ;tksf+rTiw=!V/HȮx:WC%Nvp27 $L3EuF pUwq=As2ValH*טFɞ5*d >dLoaP2hKFPS$cFC5GԹ*h oy J )ILbcdG{P՟$"&ib-NE4jE5@AmwY#߳`0R73 Qr{; 25~- aM| v-|>}P*ۦiTe4Tԣ[E5cSEôN@@8V]5A=*2:!Yc*č]I%&UviBHS LOus_]НBw_MR0$d* @sr*KrI\_yM#kA3IDP Fۭ ǐ1&g֔/_@K]7zuY|७#: 8�ΑPQ~$^!q )g5UYIMY9/k; xD)Tnd ;3 .[pqה$;RS -?L7W$bpN\@GZ|/wN_0e[+ z<53 6A]7#CCf>Vq;׬Y8ӗ&ce/s+w3 |*kk0t/wQE:D7WQtHWq[W;4ˏ \-GFZ;mv2lpI֡EtlKO%D3SӚ"i/'Ø;1'h!u!v0+QO+`jo\ycr g -iEq5=ISV{D9v@J<}n X>`ޫah>46厣KǑZ$&/]y4O\hƏZ~\H@e#l摻7oOmۺNRdtgFx7%狀:|jEjwY5YWAekMh'k> stream xڕW[4~﯈*$Zm; ч]؃C!im tc_ό/mR+V{<3D.&o֓tHY"/ qٶҤoI>dE /&zBa447$#Qe30!Ib#<|nQ赅uƞ˝KJB\B^839ˁLOt#Wmk`y\<~)j$~ܑ~؏v y6N.  CO}NMqyGb0 x(eB1=8Y(P=:)!c( XpD S]&< }$T!  l >a IĄ΄4Ox(8rIcw@e ǎFXVwJQ_YICƂG>NA}dS(x'T"r!|RjҔr,l~l۫[?~zTC!WI#7`/2ʒx 49xCxv6b?;]IXGuǶ.i`2dX'Tdl]=9GUX.(\/<_IEЍU\cy#x"\ UᬰM_܍U ad{FQzp{w3)sf=''/9yH  N ka("<GI$qIq72TI@jeHN ^JXϰ枥+ 돫rwZ=+Nj"w~vr;V[^5.8xI U¿RYhl$c+^U:G"\AEC9K$bq?¨mj+HHObexr,V^\Qw 7Gٲ`h އ/ɁrC|la1HIC;3ovly)v'+fae 5zmuzV; |X}(jIP+J ihO)ii?4?.x{߸mxC {(Y*F\WL4N8) $!++3"QT I5ɨG?A4B=҆uk6 w#ۜfky--C0C)[:=|Lo>7ӛcz1||%~z1|Lo>7ӛ7ӛcz1`ӛyӛcz1||UN}쿣5 endstream endobj 1818 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 1822 0 obj << /Length 3395 /Filter /FlateDecode >> stream xڝZIsϯP%TEפr>RR9خ d66p:{?݇oTwO;EӻL05S}}ߤjTe)Eal׾G34GmҠn* k7@%Q6vө&Ƭy]b_^9IV9^!tSéJNN O_x җ(%׾ڡpI!;ʎ4w2/Ki\Q$u+ӅCt0KOM|lxh Ԧ*F&Dw:HA"sucܛNVPG^ѣ!& URue_U<j"E!-CG&hr?0006,$]9xTb n9}{&,>5|N  =9@ 5)G텿yz] B0)Y!buƥ&TB!\$B HN .uu|/PD#Nȁ `a"6|7X.,7(_*/6v\WFo H=ѼG;toEm&"tWO8#M+I ~2:*T=]~z;kf\{z&3$49};v֤2O"f/jkopddo0FAŹ$ws[4jBN-kSU9ޅᣛwp0[`tsڡ5bxd:)0+7qg%zl+l_K<:oxEp{_ ?yh:jnF|~]9C6h_[\od- n:MmP+**sT7Lͦs`*17Jβm) F֑&n5PRWɩ[I`C -G&bWj'VX݊xfʹӎ @l+`b͕Lzt{S)ljaNܔj r Q\3 E~_!KfRc;k*`"'6 S$Y!pbI#syh F/?gYsX]yE 8"Y#w_%Co t)W&Eu ? %'ӀѤb©s#No=rUȭ`+-xsekhZE$TQ8FaܔTg$anШ@Yp(r(ȵ v>gGW;v#YކaxWG,)WVɇۮ%dИiSGhhC,ǥ9 0%hY*2Cמ>J^ɷDr|8Po=v 1CTDYPīԭ$惘-Txujr7&rHRYГCW$`LM%q41(YU:|& U(rT pVrw]!7t͒bR?Ԝ/1T!-v0onŹC\R1F=LaPй ?lKi+i/suf:_=v2U,ZvS+h p\XN,D$d$|IMǡd-.vEU"헋s ;@_)M*.!RaZnR/Ew n` ]CJ]V-:mT3L|bؙ͍~_XZͿo%s P#jǚK0m yu'h4:> stream xڥYY~f8MO'u$ Ak`[jJj/1קUluk:xzhxXVdzݾU"PJz~NVwzWE[Wܾ "JΕRg7FE@Դe}^Wiquos3ln)K2^X$5W7Zu]]:pʹx%6{y&:MvCŭw4JJ'M!ĂnT[sSA¡/"OH&!2X?D7l@6*@z%MzBO1˸g,L˫}B um-uXDrטm{iYUOzG+&0%xin:Ӟ1|u[ ¤W@ƊY /26eӳSe6@F}-d;dO> iLq3,`4+6;ntdktI iQ6,U.:9L0 L?99V,?3nN:[TsGOϭ=(>a1 OfNm1dg` Ac441C_o۴ϑ0ZǼ(t`7f#[l2G %lg98cקA.f1EyGdujZ̉0QBv$e!ј*avЧ0B['ЉGcqq7AH7xߴ96&cġ6*}`hR_ ̑Nzhc;iZDy 1%}><* Y2@U3kN: ܶD4 wV/}I~R^;d޾8Ll`55}F` /^̨hKDN) >_4Մ^h k%e0 $@O)"YD=@1$ٺt)~xMnM*KC2Hʩdf<hLo sd nɡnF3E^=|O'+Z= d>n5q[ȉMG~&;S`BTX(?-+SXMV3 zEЋk-'j_arʽ/ڵܰm0QGHaRǏ[Kfط٩ԣ}#Mfv HsCmp+>(h5`JNP7)& {Wwi[ߦD+2e~`ܾw4hcrEy!?i9TG ordcvCA41OU%9T61A]BGg?uH~ߞe@=xA[B+@3- JUjBUȻ5x,/Y(=̼p:Np*| 26DjѾ|H(=8% 7+I"#8W/0>(=U RWj oc&j*?7-M)@~\[/đP)>Rxn0Zo="HaeY!Ĝ+#[;6]4̛<ᝠԆ2L8p2:e[5c g8 !#ԂuZd\i3|rYGȹ^0^_$XJ-9!i7ף %H?Ă5Xr&9Z-o7g \ +*=yaFT~Vj7}n0\ێeGeHɖɖ #mPper݂Q% ֦P0ue39KwNf pfb;-" Dp*}"o[[AXzS;,*`sG,0?r([b"Uȫt@h.yZe G(0CI_ҽYtn8֏G.lΛZQןTG:k^t݆Ka&::z/iWBz꒖PGN{^ 2P‡bYKf.E'e1g"π^d%9E$ -Р2Nr>%~F!s\eOϊ$(Uh_$I{%2#!$[P5vn;x)~`StCY-þӯ1~p9419% I<(/;OE /T.5ؓ`>VU`_RQẬ3[lݲ!F"b1/='6kX)/^=:{g&8)[3/:j> stream xڵWs68)gKI:c=m óMJ"vzl!AB}Oh3"?n~_=['r=xt> (bLF_?Q:m|`j5 'rfdoB%I_ÞeyyP+k6qYO9(沂e2+nj "f!RlWLW2-" 5J"<,!^1FLrt,u՝u`ˡczslztNͲJ*SP,$S򅉔W Ħʡ8P*&9.`+NRb%K(6n5xJjlÉGTFi!dPgLڀYA`jzҩtUc!bC1zM'A sO=mш 3.l.uGN,`WusPfoEv.]9ufbo?vڞ ):ckI[KllKC_Z=d,c3N&mpsz>usayR>> endstream endobj 1850 0 obj << /Length 1409 /Filter /FlateDecode >> stream xXK609$%K E[Hs%&BIyCJ^׻X3Ùٝl'䷫wp6(j3p2 hJ'_o(C\8,o ~:(jӕUd!wK5r ۛI> \nrk&l"gF_i D#'e=sz4Ic׉}bיZxz[eJWGEٴWm8˥EW~6PF6:tBW_z-jtTOȱ畘1 e8Qa 6{2JjѢN=׵ Pj%)"Rx9%@2osAA٘Iv(W6fxzoqص|$-;yʷvM:][g,r|-Kq։| R&*Qم K/3: C_5GlR6X3s-\-ڸMw*J5";CgKP0ME3m:n`2-`͌16F>Sz2&$ sHTM;`Unz4yJ1rU;#kB6QjʞQBa<>hA-37NGdb6%s<c MR)1b@S" /8bІ\ TV32t["'hֲF7iަl1A{DnaYwc1 endstream endobj 1856 0 obj << /Length 1740 /Filter /FlateDecode >> stream xڵXKs6Wp|3Su&mtzi N{wVtz,}~X:[:~]]$tCf0JN Ĺɜ9c߮CՋ(M-yߋý3E\]{!8 ^SK7ξzrP:zUf}Vl .l}P㶭M^m͡wU+9&M[Rb߁ hd$BƵjRW]M/ΥMmps|Eʻ?i@B̤UfT\505]iե.V|R2]׫x &D0c'/-ɱvaf{!Et @F4٭gt(P%onۗR)EՒʴ{mcES ]` ]ɏ"^Ex ol >%^D, K%OA(wN<_y%pβ O*GnẄ́MUEVC5.R@n̆/73ÆB!ô~Nع[KLJZ 쏡tZB5UKP( aF! B\TKF9yt:WiC9cILXj~4Qhz/oq4Ǿ7bNLBGե%XqTQK76fӡzZo}uXJ/Q/"?u|+&U}DzdS 6ﻕM”>uϋ?$DcyQu_BQ,p3~8 saZMGF4s0pE㎛ G0a5AO%GY! 5*NHyQ9\`(88q(z}A QM'l琙'!W=*!wBt~zBvi߃D]6n #ÚFj/$|m$k&q9DEUSxr(g Muԛ`lu+N:mMdnῷ+cLjϘk5wHvoUk1WgYg2N8Ve֯ 8tf$vڭc> stream xYK6W(1WݤI!Ydؒ+뤿3Rnv-`7pb_=zt*T%.I."!X(f˫W/^`LB% g Ggd+?NI.륌˶Y{QgA:\v8Wж4it&'F; Ч~f(dI[ݴmM[ \/K'MmEkx!el,Ӄ. Ĭr+Y֦U員>\M~c[T%cN7Emu3A]CkvܤN[\WV\0pgWkfU]X|_N/.9cs{J_)-{t4\; Uь$pZ:H`gN m庤ik J30x/٩GHTb]I iR:M3.ݺޔ> HNi+1wE KYFEA#ݦžx"A>9ω 98*q̐gQצ{1ЫJMFqsǽЕ]@& {'wƕ+JaN3;X9|P%=PSV@}-P'ZʍڄD5if:ڦ_ZQYj[[OOvЪVҟ W=}5"\Z3읙 Brd0x| hNMg&>p ^ KHUnmG3YpC8_f!/HqkC Yw׽%>!L:۵oBtOPŃ"VǺƪzI"c mMQ=6O..3s;,WmFrhtozX@q)'1XaGa[ NY*n2^jKc"%hCo? E{1>[fG#Xx1LT8:K]捼qmSiQ3HU]3{$FÃwm8_|j Qͦ*(heti5!+˫Gd endstream endobj 1881 0 obj << /Length 1147 /Filter /FlateDecode >> stream xWKoFW`I.Q萢VEZ%Ɂ!W RE; EI%w7C{y|t3ҋQЛ/<1b<"BPboy|BY;KYH%1(2 ^<:f[@#x]RsUvofy6;eD"¤f}ը43 E@c@0y?1v܃mYA_ՔT=nܼ܃Ji7M pK;C]FBm(ňw;99hvK4įঋ<E M^ (فpOol]ǽEe%FU TӨJY6b<٪9:륊}NdBK5f tL}f|lj4,EL4I#-vE Rnj)]/^)I;ѫo@L}j˦Rn#.>&#,A g@P\q80b|V:EMנvpNL.'̫\|#JPcIQT]3&V9%_Zs%{iLH?d)ww+m]%J_ _%kV8( "ՎIӴzrb[lZ.e슼aw[*#KmeP?5m@~zj&xAKO\tB?ua* ՟gb_G4 Mi$ .f;t>&E< P}J(=ω(iGThlt 7 p?p?ś_  ҷ#X@=d8A=r~ۓٳmǥ qۆAf܂&KKj7jL;t5.׿ _y3i`֏kA nKW1YΤـܻR-XrsJ\7!q틗a 孩r]Jx !\_A^3J_zٌ(Uӄa|Z`T:eS<9bD! ty@>O #(h<@nӁ?!j$~ԤkG $} NIMYhgsogqǵr{m:~56'o$|օ#AԆ\/sf] endstream endobj 1783 0 obj << /Type /ObjStm /N 100 /First 983 /Length 2321 /Filter /FlateDecode >> stream xZnG}W_!,!{d?ɑ4mT#hQkNץIg"SI6DLGKo"3IaSǼs da=X4~7%WLIG JR;Gd0@%Jw6>M4`d **ɴʣ0I,鯉rL[ yrIfQb4,#0#C=kEZ)͌qj1u2xR-j *ZJ$xfBlxY78IW*?e9n7 lJ9S&2cf₽YIH dLXJgA[^f%eƑvNqzf_) 0N<{oz͘xsw݉ZMqS9ĖvIQ1|^5rݿIU? d!oh1;w 9$>9$caukxYNpH{mzOSLp\)j|#%=Nvh = =F2=@#Aa}M!%^Py6XZim%(.w]~rU+mS\%iY.O 2`7jyX޼V+±VOLT[Ѧ1i;>...iC#tGD(|p`wхAwF7J_{cb%p/ʚ.<" X P"f'y#4KgcJkmmq]7- #(:t:LP\68L=d/=8R_'r[rC{E|Ef'O(zgztIT9Kl6 f%J`77)dȤaUF~(άNc9@fS1V_3NO|b^g>d\0}}J}F;4N>b4釦IV?p̙A+(E*Jr\ k)yVss ?RԨIuSICŔOlF0Ixx1wZߵ(> yB6נٗTl{9 O(tQRH5jkuph`ӷb1[vfkT<MW>c>ѶN/Tmn%ˍOAA?nBs;∏\t|fv%E> UR4}~y'%z>!&vIBw}]}k{`Ǥ@@L)]uQ&pKT}ؾs?, endstream endobj 1907 0 obj << /Length 2899 /Filter /FlateDecode >> stream xڭَ_1s@r؋`w=T; &uibBN']V/'Fc†KYLRxrdϦKJQݥ.Z KUj"UE?3UQ:2 rJ7C{!.~,TN(~ =O[D ^!i{Ʊ2Δb Дc.g]r^4OZlM'ƀ=ْ? kyrru) sv };. =2ړVcJ 5HebU/%uaU|Tl UFU`5[n<1z)]cGOQ ? ɏ5'~4%~35g .*W*7credo:ۏq3>qEd; 㠆Fy9`4lTf`J^,Z'73>=,fDaW;l_sr9(ܚPEWD~ Y x, uS $ |Շ2c8"e ԖNp`&: >p_u8T&QO߰0.s,'F&p5 2 LO?cdt/|À,eTsP)H/96ZexJ`T_up)S Oe7jyq7yk/,\> } 32H= 113'`b*">LL<lJ.K4Xb%c;^!:wxr:"NAFI^RRg%JgUADiM1Ii-[EXd*wĦKn pҊ78"^6 uf f3;Ae :|#g:Iy4_ [,w8Җ[y/ҕ) gUAԊA+ 6*\{Az5 ibdW_z_oLN"+&ѩ`_ 4oCWY28(3, z0ɚAR5$#aQ- F5Q<Hl᲌G~| VZ9Me[#Q?b[EוWn1 P ew'Ma@P9An&F&E lO8\'^ɮS֧`wS0e5gQ-0!GLn/eW e2S j9NЈX I gE׬Y,Qf(/|17t3\fO6b[vå< {ȡ=ǵ(AAu_w2xއ܆l"ZC5нg@@]`m)tsp3cBi!'w]؈HI;-j\NI['-plRt߅?-1ߖYi/3q:f\?Hbo d-Wuڗdxij1&gB/r>p[EF#p|<]񻈨7fz?X(ʧkpYzP(htq51>uq1uqFbj|㬧+K ?U7DS`3FP3)l VvYZ>4Sh(=5?nM$󒆤zXx>z*$/*c-_A 9UZ>Yn o \ְ"ez#GksL|}HxpT_/'9{ jzK-CˆCmc &!$_H)oOhI/"!63Fřmf|?Q~E H_B-ڏ8 X3HɯY_oS كiNFsOW)FPdfy~! v秔8UFp왩ϕ|Ue+8Ų'윧LP_Xm״mpRPswa"۹Ćb}q"2-? ~nP%>iN`fh%M{?lFF endstream endobj 1913 0 obj << /Length 3272 /Filter /FlateDecode >> stream xڥZK|8nI&pX5LC%HD(R!}d7kWuU}_5oNx훯<~cMVFqdɔ)6OͿ}刺=~AWS(+ :)ӛXL7; ݆㹌 M`OUs"OoOkqGqʅNAVЮ삚e}P WT/{w,7 Ag!Ms+}N&n/cKThHS>ug+q[l)hXqtŪN}.kƃ"+InߵF6~4tKU>׹^fqAU?]u\m;Wmb6p3-PT\{W(. C mS{]?΋U_H>vQʦ?x:e5 x:Z9EL]yfvS,eX](1C'Q*CJlxGX<\y3XY2-,3*4ʃrp]x˘'nNJ£nPuzP[0Zl:*۲IhXkkVON(Gw7n@xlÝ{7p,;Kּt*pRK] $r\ /Dr~_呓6rJ{ʒAflsCskзzrmPc`%\e=tkŋ"n:~@afJBD̦3 E H@end%Og׬Rd~𥉉((inu$*dakx9X |)1?No8N H@Xӹ$CE\W@DLXF9(CX%{? TC]90y;5M&z'@Uespk&<~<1SN )0{%8Ge꜄,pkfP =^r{h WmL~8(pu,Kfn= hyyFGؘY4h.ÙxRV1Е %Dn=jt׮QFa/oLzחώqⱋ ٢k7J֠5JC['lhdABԳ0Q ujv΁zr-0Ai%, LA, 9T$b.Dn(PԧsRO{څsx`q xf2#/Z=Ҥ6~U;q΅K!lYi׶)@P].;In\$ qLX r3^!$xꎟCW)AK;}m6 &ikP&W8NtZPXa?<`0XF=4󃺉dq1;qYG!z,$X\`X3Yb%`YDl*b!V#+{&; *lwzxH]VFBs Ly%e[Ce/QůvF#Bn5ᨆӲȿVQ]- -&?@:.egB;6ႃ0)#/霄C&ھF3SUP{zO = yn"\<ZR-TY>pgb0sììczF+!T18*F EDCjpo%3j PA&CV!+^ؼ]OKIOO mOcl Rޤy owu`s73u [|aȬXv\dk±`_<]w!ɪx0*b~]x?skƇSH:"tC&ei T znr'"6FmeӋ,FHLQU҅ae ]$0~(++S|tbmu͋QG0_o:b<[/I#eF[SͰ|F~|@+2A;Ţ*gW. =߾]WX22[Pd#me:x}% *W{2[+SyA?cC I n[{("5}*H>T{ᩞ󊩓xED@Nyxy W2ah`Z&ZƦ;Z}J Lvc&JΔ"G8z u_A'U#|a '4.n^qOjQږ5L>v[Y{wn endstream endobj 1925 0 obj << /Length 2017 /Filter /FlateDecode >> stream xڽYK6W9@L%J i-д,CӃ,SRY2$z Ii%A9 M]waHHZ\ F)R-"ƈz3`/yNHYq4^u+p~_&ᑀ~_d{vMr.@$!E:l̹#݉޿94D#)r fayv6~x,,ݔ~w ׭;뉫]IA$O dnz_C#E?ay͎|(Z%ٮ"~:\ J٩Lϗ W6= |lj˒.9 nвIw~R藹wn?~eUx2KNRWכV7'ii[6_p>JqSuzO^;]~#u&;ޤg:n>-G'y@F<_iyܧuV|wY8/,c;Ȁ8qk8# a*gk<̤GQ|_NE#9ɉ#c{bOOdBH3(At} SL1t.=lyuvџ "f,3"H`q0X1K†jRN > k"lS3jGFy>ma9 (KuwߴUgxMy@VKKgJ'=X݉,ˇeH"7?UpTsGܖj Vy' kWٔU(5zooV@Nn2Ը&t 453EMK'K4,O ^a)ߓDFíy^j ՜D^985xs{LPgs z@6Qj\,|a:}@ &=&oN(t>9lf#_FR7o@$!ҋ?]ij̱}^gqX,NlVnt5Y{Z3J.+,6LE\:ĵ;Kf.,k^{Tn4,kPf!"hu{+f} ^ftQ\{6E5 cwÔvQ*GGΕxWE"ۺ@oXњR!hBbE3RF\T( ֲ,, oafW&S Cwv8OU )-f'FI D]Ɖ^$\>dѕH!;ɜNGG}eYeY\dY(g$VRqΰ'q hvBIV4V`JCo`A#_Ȯ&[ }%Ȣ-y B.Ytc);bw\Hd5W=`KDc~Gpֽ8עS!|{S'9I$Ҟ LPH%MguoP$$`Qb6Q*9$Nf(41E\+\Q2 V~+@h,|ytn|x9lܲ{G{O7 jC3D}E5<!ėR5! %7T(RP1[1xK\oʶ ؂F#דUa@,|&>-\,df<J "\ÉMKt> stream xڽWo6 _a$fնa~pamtŖ6GYc'NbER?R$8Va9ևۀX1/ruI`[*V+}~x}Gi(cɹB3Gp mq ͎7%#S[DY Ҷ;w鶤-S˲.p)Z(VVM]eBWOJZ@d}JG[}8r|gͨ6,ͿׇBXW)O^BA˴ӮA(xs }fyV{3u~4k*1p}?8Z/׬]Y2_Byi {ٶ&Ɉ:dx)E\/ߚg^ 6k(MI۝n1S>[ެ՗(mS%$v$%|:^ZX(NGq8,#/q"S)QDȴPyR\+bժ05rGL|VsÜtZofguJu* -ž}c:rZ&/oz;V!I $ߊ%Ju"x$[GN,`CkzWvQYSd\=r&˿KE\Hu0xY¤Qaer`<߷g`B8NtmB"gU a0[܀`!@^LgD#5őkV)؞\^֪ zoC=ڌ1F9=L6 ߘlbLݘ{hoڰn^t>q#}DzҬ סSЂ~ 2L妁־$XӛtPҌ$ 88_繀f Ǡ`U6foKqg9ݖT08M gm˧SیG8gsO?A endstream endobj 1949 0 obj << /Length 2403 /Filter /FlateDecode >> stream x]o=ؗ:+DkosCݼXbueɕ ԗ r(<G͙Qf,~է)Kc/na0ŋ$ Y,mu|P1*B~_UDʟX\rʴ!*T,VD0}P$fլ^q,q{zˬmIے z mFDx!=CzSahe \.;>?uȎN7z[6UH,;Z˕6> &7 X@T9YA&C?˘EQNVB5Hf=fܪB7$d >ґ,DGqJK./TsDTy:s 6ԪNj&:&# {)\O'ČFɺ& ^>YSon daT*P YWu^nSj5.MkԻZjl_:my,yae 07 IL\91hM6dZoCwO3s)nx8OCG]KKSxE?QwU:3Au!ԌUvbNAlOT.׫~m\81}̈́Xv ɟj}-کZ4ZůdS-r i =ƇѾ )B,Iخ&k6[jEX0;z9vS϶`/5 Vu¼QX{#l(sJp $]A.Jȑbٲzz(B>?H3)P.)`qX8 mG*G_[%dÞ0!fsX8U! |ÃQ5ګA@U, S1*ƵF) ?i5*Ζ2{6:g3mznpN]? ՗H>ǠZ'MYdTk-$IJx`uAfw寧wWˆb')~K>FOnKr x _5?9Bu04c Ú8~;"8tPLSX> stream xYK0ndE{If  +[t[,y%yz<>U^i!|0Y|֓_*Xۏ^a0^W2*Rʬlyݟ~leb{y2pMڨ$u6aDE?ճX4Gէ݄Q&un5EuOf E~6v*i쭌p(M}r1WF Wf=d} *HƼ y!< yE$K֧֞ϫan6֙D1]p8؊e"(AܳUϋFFBg-[>Iv9iEZstwm Abml;:N-m*"n-DnT *f8K|lNdan+ơ,*_9¡nuC뤺aw+hVmKG-]֑B7&jb8ʯ=xSʪ167VSa{TH8\1["8Xڬ\9Nx8wJY7 ࡢn?hY in@ qcvus[+YǛ8jZ@ =.۰'5m 1 ? t@$q$آȁYtmIAqcE[NzۢNќ8:nW_ewyoV`r֞}|0( )7P]Xar0 ;K IL= Cm n2>vOD͟IX@$sʚd+O.@QEAL Y`b̊aКBùlPxw :oyZh}՝^lu#7z^C ? GL *yd2o"'P@-KzW4uv>.~0+ 13 =>]eq$L{wϾ**1Sk۰5bym 3We*zCI{F:GHC^fEooNjT/:oM=;Y |,Q sJ)gPת0l ee gm D];g۠<$q"#&ڷt!u߄R)tY<)`MGp(4PAP Mnzf2M|3T什q$>|p"6j$$:~1䧼N6(h|sh %ss*bFy}lk0%xe}PIM``rDVᶧlYͫ_7-HeQ!Mwa)lkG˹gS9 YQ_/zomzr}GҍEe݃Er 8a49aW7OuPfAnX{ U" ݎAЧwq -밽u:sO7fP7bk Ya-[,=k хb%&) " @flr_X3DWl |'JSd5"EǏ'R^taBqBoh]*5#3hur7K W,W݀Pc+H6RAkTO~2n2< =<a& 5g I{@BH1jE,Wߌ85tU(\CeNT\L՚<|M*.=b!R3 +!UP+%"崲R>dx*Iw5swiyޗŬ")P endstream endobj 1969 0 obj << /Length 3227 /Filter /FlateDecode >> stream xڵZKo#7ϯ0|Yqd?7Cd qdmII[nbQdb=*:ywEҫ"*R]*}HRBldOMcj\&{u/*AM&VpY"Z CGi==*xR9tei uNެUܘvیgumɳ;)WtxݛM ''loۮ3mv9v]XOL1IܬSY~4<_} "P7o~yE= H85f~cRHUYgukBmj lzOMDϦL Jejc]n!P6㵦ڮtde꧵ZLӕ5,摯𫚬7O2#C"MOVgΕ|.`ηWRï`oRhE3R_?Tח,=]]U6[ܟF"˔~^Aho!Dk/ GNz3WF^ˬZJ ,SJ_ 4{M>]6F'MJ/N~߻!i xӿ!mϽI^/IX(PR( `zI @}}wgX[*$ߪ]·^ %_Àba]H6Z{-|"Wm!;ižkM/d $٘U{4gXHIn 8=o]E!I%_yB׵3$"Ɋl%/q@%PЈy;xA،Z١ f֝?ozw[/90<۬zvTZͷ|*}P$9d, tB)W_NS/DbۆΐW56%ũ36wmxGlmFʥuv\iυe.bv;Ӎ\i"^nړO֜vӛbnͳt*[WHb."yUCC z…#l=KRq /=ۤ}\TA 6T"*<RPQr$_Q Cυ(\N++L;*0Uy#}*%ȟxx2TV"|jA {l*l!4@D~@Ng^tSO~)Jf_9BbMx'7wmOCE\ m˶S U除/)cv#BtF뼿.:tb(Dyx`U8Kַ?u(A(qki;`ZĉZf[湑Iy 3yN5` *zFE~^ @ZH c b{ 4>[^19jj4Bn^l"cjNK8NjKi`D?1QiѢ z%giR#J"ƅ%=dUs7.>:83~)~̽KԝnxOx_#[z&1{[%x, 1?J23f{jr]1s[hQjHf."-tbb6T"W~F"4`);tsyAxMuKgshdC!F[o.%δDpM^ ;we{ϧܕBRp ceR^G%2h? at<=bYYN[ d\ Ķ-㾰$W\"a|~)>ˆZуLʭ8Ck1X_r8C#dP7(m}g,Gc97pP+E\=%ğbgf%L)v#77k> stream xYY~_1U Ab+Ne|&;ڝ8v( H̎}-g?񎠫cP.+{[t✷m p zqPIJ1 sZ'D.8)uFefGKO #l޴[$r[$=;H_a; rZFi]eW ]xV<}FI^b!aD7f7an\bvsA0y09frϟ9]炩=JTϊ)%Q8:ǮD}y<Ҩ;" 6E)v~Lq|URa {Y{_(bWm[BRg>(&ƀ].xǃLC|{f%hߟ+B3YPdc$ [/ۤgD 18a2 8l<8iqLPdp%p81*:Py ~/=PGTkMIBcZpN1A 8 o&*DECNcNp(3-٧8\ƒC'Zʲ=R8\Vڋ|Iu]TUcsux qQq^QݻBKǤ,MY~zٓG4eN H .zW BW[,,jf+u@ڨe~ߔTK`m?,=ڛxyhi㹱T8Δp 7&X'sxL2µbfk/5N8&}F{E{ VFVeGyb_1RH4KLz|b=F6@*XN}X$Y BF/jmEHM6G6~Q\E3-R>$ ,WfJ> ixoiʙknVA LfcJ0Aځu )85<e2$J$cZ.S˅5ZÁMqpȗ +l],2X/5b3I״u0!$QcO5(Ms%mi!O Vz}wS ;՗BcTîֆ>OP8l;6 w+Ǖ m.=#?nrXLUXx!W?]wn_]_߳a6y!evg>mU >M+cدx`)ef~sz`OpL##M/0Y<ݟH$SxW4unmQuh!&J+~@K8(pq1kf 9iWiӠoCk hS.72|U”ߴe +˸h"i=3se6U וm=~mX@ w<gNxZPrVLD:R0QS%cC>&e/-bR 2̚D 2'nhN L3BϿA!7B5-S.rw Z ͹SYkL`% (>e`1K@:\~RsZhH1g)Llz6`C(%Fk, }/y: epR[(PkUn+>o1Cq(M}`Hil 8"%fxnw= /ij š. ;7>v>K'kۀ?;JDgc'?;#x,'n|ZdDdBU% Ibye>&|@646.Vm{8qjrW.WG[zP/oa$.)xuڎ y]s"dɆOHJ?*wa#rs,vϴJCJhk endstream endobj 1996 0 obj << /Length 1454 /Filter /FlateDecode >> stream xXK60k,CS$@KFER-;APX`9fH/v ݻ~Qip0F 㠀ċlq~y1F$  cڶuJwx6펵GR4(Zp5NbyEQ[]%BkA~RSsZED͞fP;@Ѯ=k+Zg+t q4 aVbwYA'RY4P`>ؕpm9/Ҽ` qBb @ڗ)51p8wsnն(9=ؙl 24R* +&&08Tv 9e9SQq&,H/c8q|ͺkS24Ћ |!m8g%tȺ҇t36V m:v~F e{Z֛7o>6&4MIF%TQnc8LZNL{ȋeg ϟvŎ `ƃθֽhcU':ui 0N #4$N:+jCS0,eB bT%QZ$r3f;3K$2 k*[ l YSvRi\ĉ֮:Vyp,Cqbn=)vB fȨ%'6KU7c>ܤtV\b42 PYXo5Ka)5=XE,*$dKlj(ҵFRA~c׺:Nڬp x˟qv}#%|Jx FEvk^*MS4^'0k9zF{]l񐽤l/d*Otpe|n7\ FP0GqToUV=2WBXi k"=4C̙<-BȀIOgVepԊn Gp5 2"?ɐ]leI<&ֺ7\݊S )P yU՛U[ʊ]!z8Ep|}S@*C4Pp$>LȯN~@mo"5s.3Ef. o M%n` !=v~|}K& j"r1͹wdKqz4=z;VgPvʯ>buMwd|\ oC1656Wӂ8}xb*3zfNgϤ|m;ۈ?i )˄B\%BB MBc\38NZpd ǘd&Y^⳵]%H}టE5멗] kC2Л}c*fKҦ͒WoOwޞ^ endstream endobj 2002 0 obj << /Length 1155 /Filter /FlateDecode >> stream xڭWKs6WpClׄ %-{hk'ɌƧ EjRI{H'^o?, ^O~\/ ϼC̼9B`Fb>ޟ/kpmtI<8V:-c4-!^Uyԩx1T^!fU' ] yڤS.$m-J* C h9XuJXAKIM|dPls;g+E b-S'/ʖNn/F F{vvfi[&M%#*h@-묭(oh~efYE8ڢq!i#R.nZ+?Glv+Yt~zw_$b[(h1Ě%f!miÚ63fYѾZ:V.jbr_ܮ_L_벶[G:i)_<&/FjP:RUc65,;dBZ<@;{LknW^RNYKS(Y7 άsJI4rfP6TCZmg5BB9]w]-^!M[tTv%IS@X=ȑ+ե-߿B1w1uzKN>jH5M0 p=BjVo0%4gG ժw|҃Ep` Ħe裇Yպt2v};lzHaiO\_ZwMેE? uAFk$@`׎UyVdOwYfend[٪Γ gfh%?EsI# /{-TR65ۜdiN#0/:-#nyZOq1i!hzY5yzS$NzDɥnI~kQH 282lݽ|C/˭M1RZ>!IaTJ5d:'@ N XJ endstream endobj 2015 0 obj << /Length 3044 /Filter /FlateDecode >> stream xڭZrWtP#5`bVxF#qx"·uf5v(]lfEחgH>;(xL*˘r H[[? 1I{ '|sޜm3OprI0}y@k P NjS8Y[ /0xA'F&ڝX3F f=5M'eŷ\{D+Ap<>/kI{Gs qP2h*_ [ .x#!cm=*3 .;>: sFDyU"mϹܶ Gqa:21oL6@&RR+Va(BHpɨULI{?>*2M[-nPu(y5v dcɮ]pὅjhU8mWޕ{b(lhiA;>+e"P4ZfѬr\C657`xz؊/bc̭R<lG-+6ny0dð4TVTO57F<5Sj+ftP/ruF*B7޿>U }q>(y 5Xo y s:U|2FY=JHKix)LoN;L脋d%Vs]t@LXTA^2_kfkl. 4M~/aբa9k*4Bt -ݜm%y!k"ȣ}SZC}(Ba(=;a4I4x"y@nc$`B|-r!Dx\y1B1@B߾!K,;y ܖ3XƖ)Sy8|-cr V . $8KΔ$#pk&/">z lx9)jn 6΀?/ڼoA~T63\w/SvQ˖f]Ħ|z\,댕DcTMt~{E3ט˄N ME/nH| vGЮw#IBF*!wߊl[L?_t&r;!s*X;w>g2a.65J=y݅P#*bS2fH?*[Bȩ\5t)34`OȖ٣RьB] 61?m̫, Th,ƨkQa$p8{?Ͳkn*TS4iiи-Іes.dDh׀V+YG-jS.lR' HfK4b}1's$T _2~_RaBo%Sj »nU DlI:|Jhd.n%0]e-+Z>jH&upPp{RܗrÓBS c# c}٭\5FP]I=-1d8f0dN:ǔۙ|b0&r/s,أ /y>IYgAt?'tӉt3tE~akU`3&ppܟo,H% {'haY&`k߼ endstream endobj 1903 0 obj << /Type /ObjStm /N 100 /First 977 /Length 2158 /Filter /FlateDecode >> stream xڽZ_o7cp\r@ wI^"ro 8~Mv !뾑M[ &h*^ҋzpҜK󉈭>03:V%TƜi183[ίG?|1fJE(8v2;WD+p! ÎYpU-_!ާ$*6a）n6]V yFA z!K#)C 3Lki]U{ry"zv~.Vw{18T#h jߏXiXdkNR~u8&¨+G` =v:օ4uv ;F7 %n Xlz֨4QըwXI(Bal% O}TE@ǩⶺPjkr5@|АJfG]!N봪Bt;P+jf>.bPE{ؠU˖Q704oNO͛x6m>4}Y.oo_v9v3=,,dM9Up jmxFhbWP;&\AXbc4cX>w|U'Yחd8FD!EflJ('b8&ԚW܊ N&5'XE; ]"?YDF+W=ѥV W1e;s:,?<:i6"- a3Ǿ!ICja )0_Gk: V[q- 6#@d"v#}4]\Yj:6;%Bz8g;ъab!.qAl ;,,aaq51[(Gtї|Ͳh>`"jE 3#'8Z(v3CA<`9A(#t"Gg3?G^ 2OtXCᑲw1Mny^<ϣM]vM2\S);\UqծCK2hz`tYQxz!l%iHNUuEyd zY75Ot夽jJ#:uLC+@'СMY.mureeP|( Ck "ջTh*]&C RD@SF ' 8lwdh A=z"[X^sb "t`tALlGLLӝ;>@~݅5 fM"Bw9ώVEU GDnhqƹnh\.ƭo d"}n4*[by0r.dـעNcXZ/6nl.z;FF\M }7f >K5^ CAb-Wv^`Ȣ=0'9:A c}7|O1RCSNlֻAG0֓sm\9(^T7"2^| A:ٺo.15 G_ R(k`}cwbZ endstream endobj 2034 0 obj << /Length 2411 /Filter /FlateDecode >> stream xڥX[o8~00I]v2v[$thȒG9$%[Ivax=/ ۳_n]EJ҈E͂>A)%O7oۨbod-O#)dVQNq3X81 V,M.SZI^,WO<]zi=$ަ3]6nXt ]f킦˚ZlpG޾Q\W@w;hH7T7uoaUCn" dI3;y1bDL,"{)}dL@B ȓvZ͒FfM\VvEӺOwD2*aB.~x>B~-*7J},iݕ ԩV< ñT dwAEZ". Iǡn 1]$6=,Cl:eݮBxo-np%,Y.omW*]lP)=5F@W Icɓ N"nf3NV}C_$7,j me &:14֮SKCPI)h^M #!5~LwN } :СڡmU54q'ԬhǓ%L'N[Nx'a/WYQW f/iwbNtAJ:XJn RQJiQݛrPZ#aLX!mJ54 yЦGM+ЀpP,0 gwq01:RdVmG#Bܛeh`И zjdzy rVvNRY4!=Bw:E҈-Bwy):.d#DpxqxV4_8JV`.bo0#PPM}[ֺ̙%~$YH^=`>ȃ;=ѲZd ߬(k&~Y8cZ_Yp&3(w<ӷtA@v%Ƽ②%=&seA)LeA0n6 ]YR&2.~ M5*Y\a.|1cp3gÇG5Υ>#Csx F"}fd`9* n~V]ۢ|Y.gTc88uS@U0m|0exx}~k'WvͶ`ϼTJ?؁j.論h(h ]n}+$F{@H^׀`MŮf G7a8'+ZO3|k~+z5h G[ޔ t[v ._Ѹ(x/'S(Qqkwڍ`沩.s)b[X R`N8uedVuq~Vpm {tLMךϱGFJrwOF,">^y)9H 9 ԜD<yDJVḖW5yo0 }8*A#ܾwnCbWޙk]~ef~߹+2vq)+b%Dapduܺ y/p+{MI> DE{Ѝ>|xi/.m3V5pd$2/8qaTr-]~Uf6<.v'HW2>&xrdzxϮ8[˧$9DžǗ/ 09q/us6K horxc֔'hl<<^E~ۡ&g')Oo(+!9'σy)J"g endstream endobj 2050 0 obj << /Length 1538 /Filter /FlateDecode >> stream xڝWY6~6Imh4>JKFRd}"r@!rof=xůWA$( I\yaB8Wi)Y}z2G} Jc:³An48v]&5w6Yy*<7ԉ2X-Y8Bale={lLY6Y`&"˔IVYkBJNPں~udΪX CI`!XmN⚑+m?^FŇ/|r;p?Ju!t+0ǝ-#Q򚹬bōʭbo-( 3~̫hn}u}3oT*׆.yZ[x1 ;GLcsyw=uEQd^wfhqSL> ]aD5;;/aa` E =)rT?Tz AVXgORvL/_ݜS Q/y?lX7k&yW{!g]J Tn3m#mbQáo{k0@ΜT3~weZ|]`9'V?0NZ.>} >pD-7) g,! 8`o1!I|cw,^Sƫ2H`0sCOEep=yߖ=wc7*s3mSBO~'fi{`>"$y LE3hfw`fTmguۗ͘MW]'-Qj=fGl+=7v K.n+ ]iTILڔقHơ9:.W$74Uƥ $(%d][ SF/Z`w+cp !јh=p6Ƕ7૭zШ);҄҂)e\U K922 FT$(8L~$Łq6y5¯݂CR =Qz%W:\SrO1ygtY|oAxF*#- P^5CBNtTl@;)aҰjM]F-|c7umݪ)wI`;LfG8tZs6G$@EMzRESdffBsMV[m&k$%Ī+$k `VEk}Zkr/E9guO_&M~HQM<%$K;#dfoq'Bvi<]Gk2wߩi(z7NGRM8:3儁ܹn ]粒JPiwg-_*΍]",Ŏ<8=5 e o&v`t$$˪UH(bH840f޲{5J'FS<>-[7 OloS .F'^tc0loy8E4v2/뉡K}μ6+B |߰a)?S}GLQ1ɇRv_?> ?"{9@h+[FH endstream endobj 2063 0 obj << /Length 2510 /Filter /FlateDecode >> stream xYݏܶ_0B xy )b;M#n<-^pHP܃䐜qon6|g]DH6ׇM9QIÐ%2\Wr7W?ٌR Kα4H􌻣:QXۈ^m Xs gBmD? cM CG)bIZZ6̂`We("l5T֬P$u|hhG5Q-x=-Uaa?aҝSЧZ@(x/pڵVL:,n xÞ5Ղw;YW, ثhul+.(obh Sq_YA(<Vk՚΍]*r`0-(Nn^ S6("N@=U)>"xݝ<0r<K=؁b&vħ֤U^ѭJ4筮l`fz/+=|]LD+'FC)}-B)  LBچy<{ `2e.apw"Ak3Nd&b`b -R8xDSk#$wnĵIkV(hr({t-vsj띓9lןޞߺpfE\=VH \c=p-9;R]̩k#iT4 U(p+G8jk#Vkfm)qBn4mcXC5YrF@<Aax5%,c P4< $u$i L!<K:J@p[ {Ҡu~Be0X5"x$05zh[v-{+87++``DhdݗcX`̥n#%n.%L&M&Y@3FC|mPk0˖t>i2aǒ=q^4 0^\,SkS>}up7Aj؇5\h|!`ar&M); bdeپLV*A{+wk]澘s/cB6Jsb.ܻ2V-k2EvFGeg-_l@t?W7h";U13zH+'Lj [6kg"!uyQUW&0,b/=)@vyY  dd !fMi"&8t2~&dY8n}= 3N{b ,`q$Puo()n QMX\Vj1h.{[Gݪ?TS'/KjKB%~& 0hflGc[vTB/0^U?Pu;ˆE[q&ƉkhL]ShB}#IQ0p}`vRP\'D2$ nUgJgEq43Y_?,鹈C3 $ΈrӹO𲄳}.0wH_.+RT3/-1B7/M[U!̱aG"Ưhz\Gk2F [q0ܟ:<-< ApO_{t2ķh}=kZVvl X*'i`tNUx]9۷In[yi`<Jmcݬ/ə͘,_`p|suUu |길2gZ[A,Iq ǎRsx8.}"ɱ;kܰ .T+.+uoDw~Aަu EЇ[dm4x;2 LiS dϥ4lȑ3 )h 2ag endstream endobj 2074 0 obj << /Length 1341 /Filter /FlateDecode >> stream xWKo6W!3CMZ-M=0WEɉ}б=-y|7ΓC_g??̮nIHrC'b^<_݆Vw e6 ^/L33@OwxiO/&=#^uHzhwZ;;K06R5}%wۋZOVukhΪNNצ3R$ҲEnAŢnPONn^xBAi .>uvvv (]dw t_[%G4j*.}sWIDaMQ#K47QzMRF!h]`yb_JJj3ǹV :DJqR2|]zZ=[ G%ՉFr$;G}KkىJ.x]׏#2Knk`MY;Z^)HW%ƎP}ѡz&&NQg4⥱nfؐ~َ/|MdWt|`_8檁 }4!QXY'&sI3jԩ֤_0xjLa F:u/dw`88`/ 1dV6 MCG [d0b 6˦^6]u+h`~}'yaT[%C&t42\my 60 ieFZ9"I\CeLJ!LICBݧ:'s!idw("QӿQE(~ endstream endobj 2091 0 obj << /Length 2705 /Filter /FlateDecode >> stream xڥZYܸ~jM·< fI^-(yvS"uf cb!77_|{m,ODrswadܤD7w5 堛Bwpg2OX@2EoBwo?J9۵ifE 6`z-KgŸ^mTۋ$ xo;AҼ:>@o{ERZ 펃#э=_mcNnwm.7 <ײ2QXo?r|&zІߎ؋N.ij-{Y+3t41K6x+!/U9X\{0#ٖ4GZ=wX*s 6ޠ6<zuEdRl;(-\#Z:n<~j˳(I{;7ϭg<guo_O9]-Y#PvZދs6T;Whǡ^x_x8ĻίM-)+uO Ox|ji2Ezo=-G9˸3v|oչ;Cf8&,;6q ؋=2wp tFdy. 1 $=⑪,0:?.衉̆WUm =sd9O~KwgA;tb@Nug܆ZE P-;v#*x_+r[:%,g mKr"@{Dž} `f6gZfLN1CgkzGEk!AVage,%ڲL| _JIJ$_;H2%jrH1{A't<?.b.:7)ZAd`"fbv~T'U=TtuƊ!ϙX!i ʪ .d<2:zE#vHFr!#d= c,Ȍ%ϰ`cl#L\0g+LLX왍&<;JU = &0-֝<4 bwd>Ru%VV6404{,rcfPTܜ+N׫Y9jϦ<Aџ>2d˅ҫR>)#X϶2l4R):MA!  5*Q=ljRev!9\j-Rة~ wa 20zʍg9r?ھfQcgq2?Qcl,Nm妅`UmN&l6tzihП"-g& 6D%qVP-LDK ';r vވ嫕q gQCN}э 2Wv3U0\=PN5 ֞#٫hF~=Twq갩Z&@Pn@-΢C3%X' Xvӡ{/O (N&?[9˦7ҧ_Pn~ ST5TS&)F"hh~ #,Ne١TF=*-Pwԇ )zɈ+Rp,XQLQBv:Z1ӘWW~ #byO"wTS!K)?DP#+tsLxU,cD8A䁱o{ˣA ce3*x,>a h P`}2ka(ʧgu[Gf$X<2d"9??_`2+u_ L'L,?`\R[^Ųrkc<eD3Jq ugQ?غxޕ endstream endobj 2101 0 obj << /Length 2393 /Filter /FlateDecode >> stream xڽYmo_!8D+.c;%vXKkkcTɕ%٥D%(62;; gM^ gy&&dr_\$\4yDKE. kU-pϳutX=ScP%$P( A+YˢPd.U:MG7,n7} ,h`XHcTMtU;6#}'Ro'tގeqjgqGQ0f'7y$˗se̜)@n}7S# l0qLsU 7 `8#jvOd(aC ySx~(lj& "rХbVdK@xN F# *>C9ka0j*z]Q嫺g@ȢhCLh QuXJ5F/Qק.z, ½r%D$hгh,jQ \h Ba7U\4 k7nIJ#*"k7VVZ[H>e`=燦3p|eE xu$ɹ40m$WV8Õ8Ӫ74*1[ 2d]є;ϪQwn ݲxQ.W;mkC]&r׳H܊B. bF[Oۗڗ4a$ sqbmuD蹪!nhäl3鈮9F`tz=Q-yvDXKGFsUAX@o6t A9xrz% [,CG?@ mIK 9mlFrڗyBŭKGVOPFa0bOX RFhCFh|kK'JYL|e`Km]5sZqwap2.52?D o0A G^l=ja̪y9l690q`A(JKu bll\\_y%mj=OWG .0/{4ϳP;R1TX&#1_jb% fM-zEMnG*4I̹H, S{ )^uD" 7{$ V q`\(=kytջWl!WK_#. q7v*7DA@=6,*Ü}9I3Cy=M4cYb lQSh[9p |YA+${ypz/~BP:Uln]+׹W6)&L)؏|>*UuvC]-?aZ kЌ}=cӼ&ixtiC sB5q׸C4Cޕ"Tk y+ЍM9o1-zξ?Ph[7y ۏ m\?_FH?68bo D &uAMCͮV y 蠯|«^*/8$O3.xy1T_aa⃀{ l֥i0|h߹ףz6X@G2I0î%J AجȽg<w%W.~,ɡ qQ%}C;\7Ky_sT R.bW`YVI*kG[ݘ/}$Q F[vľ_ p`7\[8Q_#l"Xw |IT2"z;> stream xXK6WˇDIR$hQٞhIȒGvwCiEC?~󠹷vJ^b-wL `Zu_UIa]>^yD*,cPl w{]^)E0kFvZٳguroZ>Zւ8pV;^0{b8>%K#hd*;pW ޻σ[fإ}qx'Ddq$z~ҬXes|+͓UM Nsi[P" { !J,ݕΚΏm^zykYjLp-2T˶6Ǯͨlܬk!M{&qc@bD`xb1wt[O2s %r` RB36hUGyzjpQlR9PFV*3~hYo W8Zv ZCX^^U"(d\+T})ɛں4K #zٕd,aOIhtJ,[Ll'V K◺ۺ:Y=ԟľndBtF~EBӳG ;7{C n7 if.N)Ж?Ҍmx§7L%?%${Cg;V9͵{X o܊34[j2ke(Y@nPGN@$tM""wQ['ʈ΀7vo;1BOng ;ݒ a\Y$9{Sa4 ^{Q;ZBo!ʏX @Zq1> stream xZ]o}ׯcP.gH(&p[5hAu6[E2u{NPgw! UvN3\2 p* 31dH**)~pteHL H%;o.!yRP $6$c_3A JеX'Uu5P/51AEDGxL]] Kݕƻkx1|t>THu@52JYWlb $TG].Έ ul0Վ؞x0 =1H\Rԙ A) f)YSR 51ד*ɤPdjO)@3W0Kul1pB W&ݯ6]'Aݜ,9_!H87H`%]Vɢ@:G:"C: dѤyek'4Wuu|Um]%ՇI=K8eRt6EgH stdS|x037s|7WW_M mQhsA@ޝ#e]#Cp\b<$H}fH,H6jn"$?irm40E@P !8F6 -Z*BQ Y,& tea2M<7ϿjJQ73iNe䵪$lUp6Q0E|wuZPum'SnJL͹Z\-~l__L^eHP* L RZz Wx*B/^^H{lza=7&8 ! g6Y{wbuNdΠ)Am[ 8킦Tѥ7i'gbޜ6?=N}vu/]M,_\.cX|4?GdK-khO!l cr488: c\ x"*I 6r13jgN2dr_# Ejރ8ڜ#P$l )wmrd w،(ic g !?4&O#.ݦ@#5l.r:_瓡mA(8H9F){qq64˘_avu(urAN.wXt{wf*'l/VA\ ƣzN{x8%뽈 _x]8aXt2M;0m- aڔ]:5(liKC*nԸ\%f[9$pmIqJ"RN E<,{p0%ӈ8^e`;-GtV'(1+Zo& endstream endobj 2128 0 obj << /Length 2598 /Filter /FlateDecode >> stream xڵk6 )jU$<Ҧ{z][R Eۼ豕n~pHMv"Hp3J9no~.7EX<6,B0|owi1# sH7HUWaWhtY\(no-`Qwjg=3J͖aj}^NU-OGS[)I?\Ɏt`hrUIPu8Whà&IO4Ն-HzPS6, ڣN4 f, L $CeJ'g쏳PpN~mCHޠ,Uʊ^K< m@[ǦA@ɡf‹+ #ad~6t;Ȧ]g$ +uys4P%gXK$s4;_b5)_J0#*!"\%C@,XM`$^8L#dX*n(S4},xt#MFp>5c1AH&Pz1NZIɑt'M$Ըw\2p0K8!Q+yEED$Ju "+)-n~ZR3ּ0t+OC&5yy\s&{(f@UUZRFpq{:=[aŜ'%Z^c|ފ_+7cWΫܝWf מV,O%Qc$b:mҰD0E@c&Y6[I 漝z(_~{_0"##,7 FNU 34{]Jv(j[ThVԨK ' "Z+^K)3`-$nf Uj NZ H\{O%͝L3F<96s"a ґާ\/4w(V-4UD2 ch HaD@h15ATD#V&-ΠA§̯wJ`9;+s?Q_JԦRr=_!%yf&NC_%+b˿ b G&i _;ݟÔL@m).y)}^J,4)Sx`4(؛"b&D̓NPSB"Qe]5;<5sILL.i1$Yr/pXB~w"] p#?||dI):NӇOj1;٢y2t3-E`? oL hlQ6!M}0.p؀&QfK[ 5sG4xk}X!˪34E5a8mq3OMakccHn/#b 顓IL-}1&@ d55X=W eES{cf(k2CWmϿ'ϿJA:jXxw  endstream endobj 2140 0 obj << /Length 2605 /Filter /FlateDecode >> stream xڝY[s۸~ϯCJD0Av:uxmؚt6}HHDLRL;=8|y[u,RF~XmE9DXU?X=NDQ&d@ ͡۩GՕ5]Β.v"k ?Y*YվUox\\x, Bhp!sau.E9V%\(/ngЄBa0k䇖5 Gh^uJӤЩd̂r rZCG|ty?,L_=ЬxBEbbC[ƹ{9͒mvY 8f<8D4gO0^Bڜ`-%Boe-UwO-be$ږ]a ë7 gnzSĈSQ=i#Vd( 'º '05|Zl-ֲ;Jiq>T@ըhoN T,lT1?U œȪ̶nb&'_0\4.24k2YkIn'qR˝J[^ܢf]{@:HEקZЧDz"Pzeޑq'mݎXT-8LCIx1o <Luٺ7*͍ y٭lf&"2}Mfwb&<6!Zn*n߾8]h'68X02FnHG؉QDx49T̬EKP"ujgJşT[ܹ58hV[^._erNj#( BH;ӹА:!N ǭ-#yrJ/1BaWf }-Ltr(ﲭC Nu]CcjxJoAЛYpbE`+";ѳFɿP($l>ޠ.B7}'/<{suT3-$lZa ;%I ۮ`mr;UسW.Qvmղ#/i;x/:{Srqu( X?mF1=ըx~^;hgrAl!aɣٿ*bUL> stream xWKo6WIhĥD=Ƌ-MfD;J*YER;EQp746>N/'~d(Z-cD $yxxeӻETIoRjŤk:vCxIU݂+c", Q1&4O9mZ|:_D %2fxf2nH댖"b_Fi`'2{QRo͛ ZdJyr-7؅ vL$bc:!َ6[Y \߲AGyT]P >I>hչze bA"< /.ɒǜa"2 vl\4UΛQ(<B*󯪙~+ czBi C^50P]?Q>VU+aFK=?.볽clpʓD!jiRGyzc)ԟ#."alu'Q ,Uyob  endstream endobj 2171 0 obj << /Length 2737 /Filter /FlateDecode >> stream xڭˎ q8&=i-0E*$קdSYsP?]Wۛ޼b+^ƫD/Su]Notr8b/2eP7>Co?6HRsm+X r8wgRi}z<(ruiُg2yE4tE@XDU",^ _|`ߴ485S:o叔T1{ZUwYԜUm"ת݈t}0,`:/|~WLOM{)ͥϛh;x.d*= "T+̼T r OHcE̙*憤W:\3l?\jÛ|_f3[N˒" fjݏ׼|"^ֺw3kqtLBK "/*9#U͋ ^~Ώs\5}_ =77Pg}V֘5:JBZK?oDyo]^od.D#~w&WM r;١Ѽy0T! O@A2ëL|NH00@AGwisS] $:'!Fa"j'afii򾣹Q $B^Uy_DrdP֤kXy<0_&*pA _^pQz+{*;wp=U2RLc/bc'fc?4oCQ#[Gժ'N]ߒ-d- e oa`M0 ҥl/I$G6w >9,,cHQD2 X?4(18豹T<6\CeSl್,'4 &P==F  bhI.@zx (v],ߩN3xU=\U(q{U?-Sb뾣Q,!ɢզIxkxx|(TwŃq z3a$orD> d?&J_z4;rDW yD@Xy1u'iOȲL $ :L8OJ7(RRE,^ng@@:,9tH`N'p;F0-{px*&ou\CH5\T 89qN$ WFC|>Y/G3H):|Ny xR7+K ( N7Zh_^ FD[)!pdl!Cu0&&YgfŠv#7| ྣ4el8"EţHNc{:Q i]g 1N[t('542VAK/! Cj #6uܘi~lbIjaE E_´`IeLz \vL wQh ST;r>I Ǎ4Ucm/.UM#;҈ f:f?]oQu͸EF $3ʆ[=, $̄L8~%#YT( ,g6q J&H+Sc{=5 FYv ۃ ”rTKhvuKJ?RZK187h5ly~Z1r$*"ϩ#c<14ӏfzS>v޹ ]/~]PEw}\ 6mrξGKæʿ G֙xk`*^ m# _9)7q(C_wAUV&om\W?h*I=>*}$#/EDCx́駦4^+ᨢIU@>E(A~vOK5I =L"L : ЗPzf0f͒dzLc7@J* )'dk g5YL0G1p`%, Ì3ê2X$T͹pS'MN?64)dp]T(?J&e%6ȿ&RgeR:z۠K>/_z endstream endobj 2181 0 obj << /Length 2192 /Filter /FlateDecode >> stream x˒>_SLU0 \)$vQ5;ev}$H"F|hKN~w|w7~gHfY9d2KÐ%Q>6(,'RVn~EzX2_D<6z;yNe X1/foW EyȄȽ GSOֈ522UbYՎ9us75t۽&c]T--Cqۊ>SnzKОHh@$Wby x[l|7Da7Ϻ'ՠҨJń#ͰnN]Ƒ4fJd35}۽j!D(majjJxZcbdUp]D2ʮA\M*(U3`-a3e2H% `XfiE0TYr2qKR#/G}h YqূE)X&AYW;Fnx RhB6@Q0hNQ'y`W2L0H 2 ]XlM s"r<)ׂ(~kS&き&hG *z&2hK8)`jotMEt4bl.?"N;’AUMi8Q G"(1hQ q}/ E@q.5(}|RR)xR\ׇwP0`YF]>'4`2/}x>8CcD(D'DAv-`XR>@cwȾ\K5R]$%%;c"wJ\|v i%UuA˟s voS^BQP)](bmٷgk)~vM}:4je4=vn u4e_uEF 脀.FMG(tـF"_AZB(J(fj2yE<0WU6:VK9x|y5".sa 1EB}(jud}Z@[7~F ({N腓 %y.!ZO .TWE5iA֗ê.+SWW]jy̋ywӞ6WŜ+nJ<vY*~[}&m_'OFՍ؅)Vcu9v_7x5p2<Pnws|:O@,޷+u}K0޿[űk+g wYV=/oo3[̵vq4\'k^cbZۛi?^`5Z^XQowy]FQ$< UblmVໆ54]Vz&mqsӲz}jQʨ-zI𓆎a7~Cy:A$  ! ߢMn [4-> stream xXYo8~@Ċ~IŦS[`iH3$%K^hZx oZ[˵.]|+&qƢKX!$`uZ\wKmI]~5F Y0AZB}B H/A]De3Y5cV~4< 2ϗw]pD)&kPv'u#QgWmVJ# 2 Gn62iTQ2G<$Z]R4]-Wg77gF}jUczkrkzIJs)sh #d ioGI LIFty;jz-JY,GuSXDpTW7q6 4u>g5DJ3hևߏUPvk`tS>bnكh#qD`{k%:&K ,͒FnZ7.G^Ə;`Pǝ -#jlП$^}ݕ .En+zv"AU $9@fD CK4Ъ>׶*#]h2pRZP'5ozB qwMۥ)̜П6+$1 xR/ 5|lV<>H B$+0 }RؐwXE@r44$|ÁZdb?f>pte6$ 9MmNsIv-wqR;b7ȋIEOC:LHf@q (,Kkut,ۧkᴒ0Q3MjuKch=rSHY@)e(9AmJ2P=EsXWp0YJԶƁP݆8̓ GˮX KAs`6Vu˒݉};s  fWuykuՕLp+G7)y@튤u WL(cV KSw7uUYOxDy50[@F&hqe A6Jj 0D0$0T$('Jzr֕adw(mll\DF!zß߰ SK7ySPzk͛ 듒taS OYE.+}?,CYHXNQ)ؒk?D, G1VR 妎#`9)[scĕ3nVϤAxAs xg‚:(a~5f;m A5u&MA9!KEk,i0G8/ Oc球 {)M'уR EU5F?Z͏<𶚿rz8KE> stream xXK6W4|ԀIb#^;$x5{ZZH fVW3A)H㫪 V`\x%JvŃPbΙzawT8d2a#+Tl-n#O3ENcZ_&%m:^VvztLdEaHTk_DW|ֹq-eֶd=,ְf$qalKx;ТpSE]ꖞMz[ew?teG~s!!?rЭ)+&_?Q0fj΀ve's\$t8jQ^7n'ɪM8uhe>3\qj;D fӝ9xN7uWmy X Uf),U'}@>_%9sMiгՕ.ZEޓ]C:첔!'1T*|@ޢ[(zӣ ƌ^,miSMXrK>Db@ĸ+wK͊Z'B4i2 ?ײ-KALLd6z;@.``M5 [ \L4~ik6 X*[}v# Y꘠I¶"di8hC!X^p>ȳz]"`0d"`L4#h5U7ǴrS! #31)$@UqlB@d`JQ28aJ q[$࿑b4 |x GjsWBv82zdƍMׯ"P'4][Z=zlt2ԁO@ŐUcf&,tw%/.l~aRaoqbx@W-`*bagUV>HRp6(|uITEȲG=d;TYña2ԯ0{jh\!A4ޚY cT1H'C ja~rq={EOuC %mXȅ}.Ł~i(ce"-t#9)tB6O hN;=ݾ8qثpeϕܛH{y9RIPt5)1M2vS_h-x]*i| O1" q:h~>}&^O,%\py << !`gC¸]usq}d4I\` ݆;:*;ߦn-U4R8ĥn5x_v.*(>mO?jh,C*oRiqÅxG1 Bu*@G.>7qF>GJflnq?!XW'ԣ$9L 7x~w,V$H'OJ&FFNL^L%UIe w+>p}5MKwȏgո'H[/( endstream endobj 2217 0 obj << /Length 1189 /Filter /FlateDecode >> stream xWY6~+P?n@<%JKM]Q;d^Ea3t୽ybry^4LA82Qޢ>L9r>-~NvT(+ p(I`̓v6f ̦{Ro9Q@+cO`Z^8aXeHDŽ44i*M-[T;Bs{2Ҕ- qĺ"7+ jJ䮥W77Cټ i%p ][d N!sLc$ĨDՊm-*ᇫ5Qg'wXM]@j 9;mO虝׻{(P/z*4D|#SR+1KIێ0kjKA<He쟫%S;^zI?+1R寷0 k;e2&ْ[-=@bwU=K-mŏA*@bH8Eal݁=? wۜ%=wĄgPۢ?inIq{upۿǫ&S;H7Ҟ$[af1 endstream endobj 2227 0 obj << /Length 2032 /Filter /FlateDecode >> stream xYA4_Qq+ѼI$ 7qۈ4.3c}l- Nuc{癱p͛/o߼}"(8* N*Z~woda &2JMsjF7!M~߾M13r2vve<(q(]RfpOwgz>OI<*Ds *R> I c?omdZliMuAe-{+xp:I;m[l茂 P| < (FYd享G"٨_`5]8McߩD 7޸hf"]g%vL8Ӳ,U[^U+KGr ӢnvZ) KkYZqn|4Llw/r:P hנmm\_ChmXr*vXL[HATXrHSJ[ݖP}]:u C7Up͎|$YY[Xvr W9[Q 4Δ/FlIV&OĿ~%M{ólVK$D*9# [Ƹңhq(Tu~٣ M@A^vʦ>(UYpWڣk',A*4bw5DM}|>BP<㏵q|-Ck P]8V4*L3 QGeט@pq H?FlXE@t > || LrG$D p.΁d_]J/= s]bNcvQ.V C֡lNv/p_\@ٚr3X?G9SñnnW8l j%[|Jfl5etVC9ؐR_4eTp l*YXdIm”iM.,7 c܏NT n37,NNG#8 lYAÂcDlT]e*cӣh*2uI=.PΙ 澺#i8ChIIF34VjI=I8 ZČSL"%s8²̅,#pl3juۋǫT[J\ Q0OzՇ.Qu=}LT9եziks `z L~8O6ϝ4ى> K*]'T1h f*q,MaӅ[ FFQNU8>!mͣ).kF3 '' (P!͓A̙Dّcﮭ y'!]0S*( ؊QH7|u][Ajo1(⽌uJy> {]ԃj-w@jq@%whW4Xl_:3V_3,e~Z4gt 7U W2#`8@+';S0q(.:tڲHxxr׳縺6&ZyR_,D4{Cg_\Aps+.2,/W$BD5G74 }q" W^R`I G< ??YYxtK3A&ǥRHYo!%(L;;} fAZ $9ϰw< v[|  ^06; Gqqa; :P^% 4s0fdLFFAr4cp`򋷰Z8B><0I.s^.'j[m- 7]<ZsQ.h[0 . ‚_> stream xYKo7W%9pX@-$)Aeǭ-PZEWڸ9`kvw8{g >xY)Ax/QdCD|PLa_?avxSxG'~ )mJXIl|&(z] ƗP߁J"s^و PRzzR A1:oDŽ} #95΄dY2hW vD&S"ADB.CUJ (JR qD)W9R`)&*Q@b"9]KeWLLUfuzMG 3}8lR"" rHW* O\W`Q9v]a9D'\X7*0x5b_CHT)@$@.AذCɀ1|]*+Ǣ8 *{&;RC?YL&=O(Vd2@9c#@"jls@2TZ6B]88TKu#pRk*ʓE; H.I)]YRVp#,Vrx '14pצ?wڲ YM/.<~|v*&"֞ء/9<4 Eee/pE qyh>9,lzf0Gyiގ?.z߷\at6>hd1hV8h^xp/Gs"JxF3F@nd22p*?m[7.瓿xVwOّ1NB!Y#:1ۂYWxO,ߘ۩.{}:<^O6Y ZRmm*Cȭn$p-Λ EÄ5pN+X x?Gw[$sh5lb lpa[mbӋ.cُ#>:EَD\$mei4'ȞFc{q>.Fs$bD"1-`$V<9<;4OIKbq5i>|`/Njtlv٣$ > j-aC֥rőm1>{E}͝,O;8y'GgKииyع'6zN_l6c[P{7r#wJ#wG ƞSjѸV:-LqD(cFk gK}!=)'6!חQSI(Ho8=lܯ*Ԗ)zzzzs 0Z_+y_ُtZ֡Fi]NH1 oc1Mf6MP3;Ư<U@ڞ0呴rnjD]/P|kF"$>\P1_ mGa j OMlr89xVy FвzƕWnd-]st䖼Gnmmmm_۸T6.dH7ơ5QcV犞`.~jiӖ)nn> $ز^l =C"?Am}> stream xڥYmo8_aBbFzI..Ym举_3J%"@4!63woW7?KXpvqe"Y%|٥M%viA: Unj.\ШvQ5[*߉>_2Qs84Xhw0`In& =ݐq !a^`$J kH!T(t=L*$`YQL-QusO0p9(1׷AE`cxD[;ևJ._rjB aQ/q|m9CUe'j՜氓eSOiƣS6HLu>0H0{1%sy͟&FŽ[E.\fmdQ ;Jq-ˆ C3SC1/1 !%b~2H`atUȚ!MKE}hMQ#O|; ċE|H,s^% R|[읔ų wE<u `!Z I23M@,a4 <&UB}4fZifӎ-ԗ9$,V0PJ5G@=)}`^(\g"*;@]q%9 #v4".@p ߰aީ_@-_TXn £sus9S dy'q%ZSxY_ǡ]}kz!S7^G؁EYMQIxQ>v(ճ|8WZb{n10^0 \v:\l6CHDjIST7U%=Nθ*le/fe?N`Ah=V7^~uu( b\YTRX"K Kd|>}V_h_=b_8%W˲ketLflG4y92#-^hg =/xe` %hf>G0*fw|ѽeA6dmU Qr.se̅^]@dn'N~ L)ҦCwE{蟥Q`OMb:cFvPЎhR}BM d.@&aiۨ:B߮5`Ȗm3+(Mn,_Uy endstream endobj 2247 0 obj << /Length 2672 /Filter /FlateDecode >> stream xڭZ[o~_1o;\tC)[Hq5X,M%/{o"ezf~ <"?;MW]_}䫂)OWW7+F)2]eT|JTpRMtWNC}iQymW::g!|vՆ$7Чi/Mۙi}Whߦ~JHg!#E `ۏEb~n]3 !h$\-SR(<'`yZ^YJklNj OʻZvOHWwzMjͧ44N]ot;ݚTv{\ɂ%0fUmzu|Y5is~x~Gd hֻ{L!bK'nCS[%*_Y9lo*)'b̔AFACeFlpj[k++$Ȼ SUD]ŜP!=g$SRӀ&5EnDVx!|/aB>kiܥ82ЕeKHuو1Vz~0+f<|CONX0[M}V_9K|Ī\<) `H"z4`f2A[ 3$Յ(0РlQ(o\ /2ԃ C /Qz*uc}.R{{%bA+I@'"#eE.]cO*H|aàp4.gU]Tå .)U->$ sx`…uR%g J%(|~KFrɖȨ6$ A*VF5/dɞUƪhUջ jM endstream endobj 2260 0 obj << /Length 2855 /Filter /FlateDecode >> stream xڽZK8Ws{>޽L nؒW;"G'S*ֻ>.t7ݽyQEJR~(%Bah.?Sˇ՟wzQ"Ĥ)274X$X ~]e+Ow{^i|I06" v~0(݊}J3uz>~Λ>o$+sS4_a0[D~olJA,͚- p\D[„\$ T)s*,2"iO/I!%nA*s{joxr?1? ΃PpYVYɓM*OEh)?F)+NJ4S!D:~:us|Sw*a,lYF,e+MiM;s hA#ZVxpQK?Љ"JD۩A_8$d5co=h{1>cjɇh|iRhCkէhP zk`m̺D\E8{qf&u7@Uv63zLZ5F}IFL$Xhm{oe_B6"o!T)/_ŽDvNbFA bExKt "0҇0y 0'eIJ>$'LlX4:HՋHskВQS1f?MvDRʦS\B-_FUĪ\NcLC䑺C*BͥjsUNɑet$IB.Hح=N86>C r+|jF [ |SJa5(RAq*<9L4-(1IF)Vehl|U 9ISP;c S%y<.1tI` F8cE'XeBřM?Yc M}9%}mamfSkO87`mPcw5Q AΥz `-gse6ߵxB|h^҃qc^8`ÇQkg5;^W|TV2x "{OW#-dr^9s53Mty2& M[lcE ;&#A0p^-D)T7~f}FP=Cu}V] )3OQ n;_D:)g9H؉ˆ[ѣ,8,29CY+>ͣ=a^qL*uV6# MDb!< YlH\ZLuq.sBG!:ec!PF&մcE.guD>xs,._Bf[wP 8o"4aoU!H(`6Щ(uu'毤?v h\R(|b'TKn`D!8uI.?nޥBىİ{,ΣhFݛMW+elvg0[?D-Rrb\ QM"z%(R5xU G@/p5&h>Ua l3&YPGpyJu`t_*=iPa]gu%^b[XP-'Дi:+J"'_pu^"<>2Oy첦HUE3{%qu'&+COWKV~b>( E|)%6XpgMRe{ĩlI(@t b4;'jT m^![r:<=}kkr۽'6ǀ/df ?vK[gmٱx% {5eHd"~՟iS=]"My:|&Aݛ9z endstream endobj 2269 0 obj << /Length 2163 /Filter /FlateDecode >> stream xڭXoBpB}=MRwAs-K?ɕ3~ޙ%Eʌs̓͂/ݫwaHYhq^ΙDX._≐/y]H$`*յz)BoǣCJưNONNOK+(cJ붚ewЭ[o Uorj;5kR}8znd"B̂XxUpt`ӗkpfRpnJ}bvNuESݢ@ dt B$KY(X F!0bh4X.FdV{umWܗr9TMm,itic:gU {wdZkh'@C$f_麛qIoZv_x3p ^$`2D Ga[d[4B7R4%cX> O#p,#@\B`;%tmXlFDXb>@ONejqѽ[q{z"x2t45 nC541UʵYtOœC0= /M̆蠤i,0N4$9=ٷ*$5 2ߖvs ,20Zm`<os,c|i O*g.Ov*倫,>|C{ctg[aj/`؝o\ץifkWG0v/mX7 q!׶H|,`fSԲ3itXJ70x0k͈]VڦNdUPԶp{nȵs^%'}k Ism4$7}H86Sev2aN'}!\ER|dKd[N\wOb Zw9ƎڴrrO|5͓'3?m ΰw _@%h%?6[->5A}=$n9Yf 8L\W֟uŀs9b %i;UqkTFCb S$}" fXݓk?NVG,0?bx Džušp'^~)Y~ΚqLmӭAyȊ7whs endstream endobj 2278 0 obj << /Length 1221 /Filter /FlateDecode >> stream xڽXKo6WN&hHҢh8`l#ѶZ@Rv\,wDE~vx83f8cm-s[Zm,qlڡ[x_ Fo>~}z /y>!.qgϳ"3 =ۇi8IU%vX=f7R0~i%=Ў:pjRLyV(cs#J\Be*= HD,(%G$C/91ܷ#?± |ME , E?~2ir8,>6s؝y&c@r!xK0YU}Q8!c;IW/t=_ C:؋@::f%.u$ ^ٮs=^0`c b3wëմz17#w1.R["G.eW3xGbm"GnxM sD}d6]yyi]7P3,QT( ᠄'mm7tG f"H8s'P1ZRQ$|b0&nRz"QԮjժi(UJH(~- X>j\k.< 4S*xh~v>t/I/TȮI}mܦZ4!߫ e+S[cmB@ j n4JkS׹J+Uz~bBsvInrkj\ɬ2wa-7l]&؄D3]7=B{tۍwr\ ;!hfb w5XQh-$3 00fI~](ݭƠo%UN5.`wN ȨA $MN!!@+bbF gI\L~m8d'~: *Y#_}\8{ “%TLSٟb59G(@Mq?2>i]x?Ev8{87*Y?{ɠ2=`yzE'h endstream endobj 2283 0 obj << /Length 1341 /Filter /FlateDecode >> stream xXmo6_a8`[6$-,)\7 -Q.1(N}|9ʒ#;Y~XGx1ˁ7x{j<n`|sQ4` ~?ٟ_.Q5@a*.W\\`*r(RN(9?͉0K0j%pa 9f?Sdΰt.ih*>57CZ&20;Ml%RVbA4QnN_lJh9QѶy3jVtY])㌤Z Ȣ #wO8nUoґoF@͒Pw:ek% W.z'؟]I53T]fFE͎V_yCUC''CF ]_aZon0_7}f5nr\axl bucG0D8ux3pq $$6#U)GT+"X Q$[&wyjj^;FBDZ#TUfՏQ-7.>ܓDlEzຍAo t՜'KVվmƙCOj|e`^}3 HkJt&ϐAiځPevhܝKtXIJd6NGH& ϲL#_2eݎe=dV#)ٙ B= b_eO6E|4rA uNRN QV+K.E3% MA'UpԣXE } ݎ% d}9vC Э;7Tz*FCG@0TxxEv97D2X88:M22")Hg#^e͛)攲!V5ކY^}- % H?DvLw endstream endobj 2289 0 obj << /Length 1094 /Filter /FlateDecode >> stream xڵVmo6_A&w:- ti뇤T[8+uw$%Ur)Z)x{BO~MgJ b ͖PHS7h@7CZ'ˢ pL*|;ɸw1ٝ[ i.;MO(L =J L G[y`hDS0ߠߝ9yJ)| 80&7Wi#&Ip!B!lbz,@>^1 yHp+/uV#Z<#!U ɕϴٶΊ|g,1R58sw;[ dXb7#\ O^-!l i+N ` :>YBZ1Ez]*=6>so$csp=1 vd[=.AVջ]UY} [^ӠlN_rljIUXvܯ߶M*InO+%(ePP@7 X MoWw(-JUcCb\Yy+  t%t,Xa/E~mm.׸(WxvIhsB.wպճtVCY$>9L!*Pխ)=h%M 7A0^AG\ǁ2QEk4JdqОru}V#A{ȽvsoS&SǍwpelW½^#Nꬪ1.>qU0h:?\3JXOoS"# FY@cM%ɰ|1yne4Ǡ'0E'."@@Sí Oe`R`EpCŸEҲ֏ڧώc|ږ+0KG}&j(5mS:v}jY$D1#]t`4m#䑷Ǟ3?i,?xb/e/_xO~ݪz0G_@`"z endstream endobj 2313 0 obj << /Length 2589 /Filter /FlateDecode >> stream xYݏ۸_aKm JDIˡi\h/E{+P٦mdɕl gH}( ïo>8E^ܾE&2-n@H/0ZeeGSU,Rtxw:_k _hfd-~o*54]TdAH}=VEJѬ2U~Vo^qu%Vk=mkH{ rej64ى wuE`vf_1sᓻz H@LO ߣ;jU/?mB<uhn9DA.^EW:I5~^?Q&D٣[ Rx(&gvvv9\hHR"L[4fGwy»WdՕ+/_N¾.ߓ\7}TXh=eHz_% 6 s4xC>ѕ%Nfڻv o MS&֗:`\yV#L"U2|g Trwff!4e<4pƇ'{.ʌt\Gp8wǢ.*DO\ęOo[cccpt%A8O?YAqyͤЃKɽ } Wo_u&H4H :ڢ< ; ԓ.o˙:#qa ӊm@`G=sG`%(J^<{=I_V 3◐Qzw"2An@t\"*wBWeI Ю]_e$ȍr;mBE}ROѡU0)p TIz *| {# ќs$z iߒȤ,bbhoVgD% PN߳sNEe"P1&Pʛ~AӃiP'Pt;ij`w2mg9!2O`ґ;DA/Jv-M5cN_8S)ox/q Tgq1PKi:$0c_C// I 51D .q16踖ڔAc$p>ToMpy^B$V|(EnqҶ V8cL2z&ئ 6&**JyKs&/憎˺=c # 0tj8_ smyo#u2Z{g2+wK| sY[3oj"a1͙[_fh->[AjeZNsW8+[a5Z˜T"$nv3gQmn1@1-I_[(WoA竰PC&ǻW\㈴Yh5 DTFI^gT.0 m Xz9pޝ4"n?t]QhišՖJGܫ[@*ZYSQF%Vx6 &?PDvwlCuNV^R!yEL.V` <լB⿎8r̲ha"O/zS'B\axBpOxSOqgQ`:+/VJ~T?B?zJKl&fqax>7An=b7u`'s⿅9 endstream endobj 2323 0 obj << /Length 2430 /Filter /FlateDecode >> stream xڝY_s6=` A2>}N{3MCәPd& >}wMڴń]0_]g]_dUBjuuX ΙL*)Y?Mc?~:LY(t"M{M7}g0)i}ZnwOL|9S9 Zһc-z"}][odGxc.8|L)|oY})۲j>U$BS)5#W@mU?42CH9"@4%}WvrX6"YobrlNY8k`_9H,YAxY׺oԣihs?~/X~>do/Dz?xvqu Wb,4Njל'_Ҙ,խcmV ^`۳_ÐYI%beB-b$@ "&:Io.-e_iFy )sc,a7UwevOR,?qs,{GaJ1"A]Wʴ_rs 2_ azk$<CDݻli{`=;ᛛ= TF#>q[M&l̜``V];OkFVKCx`? _kHstOse1?d, ༁U k'#t+~Qacl_߹ssjLؙBD5 f74E7-MY0x>g405&d6wp/W  ֙3uKGr9}XiZ3ӽ!ҕ4(PvReJiJ T(Ahs4n<4Z k0Q7(Sk)t3h,!ptA!iO]*LK<ƴRse82;_mSN CSdW b͔ rE–Fg8  jl*S[Qy>-n S!5FlKY^Hud;UQm/E?7P5e= %y(2Hnh HߏΗ0Gy)X#KHZNkRlߝwH㤣BU$_o ^H۠A[}6mE/ RW9=` bx:,V#SgiOS4K#^tmV/%E"27",0Z2`( Evm5\lUC8sЌQptT|0f*3bV;Y}TSޠ4͖4{UCOTCD/'z oԎJ@"%%8yR^+"(~Dž"vB+cm_cib,,iw"Z՚\DK[)Д:ϡ0fXd*Rq_O:><=10XjD1+?Ykߺ%чAеNՏ:=R:D=1)0;}B>.NCw2 O4Azk=tz?yl&>k }WK_z/!)^ܭ͍,ΞLXz?@\_. 4ݮ.EBK߻_c ¡-~'`K!\c5U2լ-H,IYRd}E蓅74yto㽡O \ ?(ZK`@uY8Sd2ר.4Of 6a; }#m}Ĵ*AO1qo EFSGH=u @y?TdZ<,c] 4Z$*yi²BܿU}ߐn%{ۜ;uڞL ]h"pRq3\>q\̱4c\dZ:\$3K&L-Y/w3㰩 ;."B)`Yջ9CCsCZNݿ/9ٽR{8zECJ'6&tp> stream xYo6_alq[qM)<}C)b k[$'!)o|>ؐ9ot_/xsYF2n(%BahnOs2*4%)W@nV2Eiqw\rpY+:H)`j^Iyj~W.}ݰKm<->9 ߨ &%,#pA4ɌHq$i`r*+|&4`UJJӽ>RΣict"J?GW@ɑ&d̄w}6Mʙ&:^^ Fp({DM5Հt{ ;lYNGh`i0e~G[{Seuؼ;.N m/%Df ݠ)| Wp=2,h&dHZwEU^dzZv`K+ྩQ0U1|sE2K;Sf! 8㲌AT o1f` +;P)IJ-7,|@#Ѷ$<P 4>,0#jrDzZ;mR  P~ӹENGY ?`"("2M6ۜwթ+ !="V\ :Wy+ILFV ͖1<{1:Wqy:>')=G怮k=L1xavt9!ų3C0g=F Θw>G3٧Oizt%MpΆp{b9ws- aB3C7ů̚? j@f % <|g:+#<xݺII( p _k` *? Ʉf-WTh]ܘr439I6F8w4>vխ'q׽MfxkSœ8v2$A_cpetY8>#UJ 3?ːY?yoc O8Ke$Bi [l>*qW+n;?'0}$L\q GG i|޷ǰ@=8ұ{AqS3Efꁊ.45$c=|gK}o@ݕo1Sh6};l bƖe#B6ε$ߖ6/ٖ>GmcSliiurWXS0ǯ.0hג ,Xc؊ro2 ;1bMX|8<¦/'aitV:%1KM.Wq6Ċu/V(dz_ Gю/hGɉLb4___arٟ2\UM07mF%$ sM.HྠsutPu8-AFqu?u7X9 5pyM[9͙jvϴu*&eոޗQǍ &8C㡗R0=^Фnsk9pO;rj %%NR ?h"Qk:_yւ0n->Q[WwYg~vC4}iC4FIDXax&0CE49:^+pn }(} F5aQ^[W us endstream endobj 2230 0 obj << /Type /ObjStm /N 100 /First 980 /Length 2163 /Filter /FlateDecode >> stream xZQo7 ~0$J"5d@t f۰(2۳swGE~$%q&JS ,ƛI`'%Ȱ&o$}FJTBL"iYSx 1ʈx_e(u"ʇE%D1L\D&U:a: 4AtXΗr>vJe]+cR, 2>VfrE͐*2$6Dr4T2ľ>QP0Tź&:T*4;_gfP!JӯAU]`pTEe(զP792Pa?T7VJ=jR+m%(5uTTLr#0o{U$⋘$u JrZ|Q JV&;80 GkJE A̩RfPl:B a&52yg8{3Ȁ͙5gP9PEJþwTni [(?fU/jdYAA 3RCLUY0t''t4''y̙Sr!_g4v>/V0P߽_^7/2Kht2b`>DhhTߗ_rbTZ" YHlxu- Ya6$h(V\| fC&\5/l/+d%)jMCB"EkȞ^LWcvM6\`Rw&Apܨ8O{bqe[U;9 ӭEBvjݏ$Glj5eGJFQuhuP!auz7U 4ok۶R&!8ITf4]4Ggpاl@)v4}C 3k+0:E?%y.$$k"Ѳֻv=8k%v!2%"wrD黓m:GzF 5cmbLSjG6Hg>-I|9'[u!;-[\~ӶhE󻢩\ՋG)sѴfs7KVyqMv]D=M[Î(IMM]NM£pGal)wf]%slmk\pk"6}mۆbZzw42(#ģ8T$'C?]j<_^Χ&\Q-ԥ돡XwqH^1Oo[>  endstream endobj 2341 0 obj << /Length 1798 /Filter /FlateDecode >> stream x]o6=6bF$4lcѱVY D)iw#eɖ: Cx"}fw`w8e,E<[mf< Y9e6[¬:ץY&JWd$ˀ=̣zq#R&EY:[|XFA0-?|7n XvX=nڴNE]l ޗEqk#rIkSo(x*i\ N:zqsa<۫ozs D)-$7G$+ZM Nv\^{m*G[wED ZTSۢ#r䈎b70Kveo 4ӂ!KՍmiuڃfl`Axsڗ0OxMWSIXЋD`nOP& ]4p2%=i$H2j Ӡ])j4-1wSr"5W5 *ZL(E]huj˴U1s!f,Pd<Y'$k^lP ZcQ` u#L `Ja̒d̹Lzoe·I=`)!XdINeLY$H2̜/u€h68!&tLK)/ ~ C; D4p"p/:2E4TέtTijֵqZa *xPO0ZýcՇH0c^@Ɣb$@1)@&C55n0d@)Y2~F™ qnPE5 ﺝډdETst&%tП+*-Kg 6I>8&4)Qu*di2%h j$ :5sAOWF/IPtvzU2&S>. YQ`ȢFqCEX?:uaKhr ǧ Ty2F TMHMǭj){jӇt'gx:8S_g -XMܛjW0j2-RJC6:X0JN{bχIhu =iDCO6#.'mgC}#a3é|\Uũ៞K\$%ܲI_W}:PfA??'CnG5,^PrBcBƳTEbq7$0qBUSr킥le;>NN \ǩw m޾<}ڊ& .58B7@ƯY- zI Bu׮^U*?=PAz!dYd(ei qYvmwRKUp2EwFh~?B$wxަXwtnh_w%m\zu'"3 endstream endobj 2347 0 obj << /Length 2887 /Filter /FlateDecode >> stream xk ア6DR{|h4EҢנZK^ %Gl~}g8CL] P9S<9/n[ًwQJEjYW2*Rn?2J6w&,& T΋cc`u$ W[Phftu٪Ĭ)pwY[_8֖݁EhIF˶YےGgώG|SO~YhE`o bJc Z{0GokČ\,j9 'M6rmTH&mQ0SckiYS DwdUnvMTܗyY(ڡdd}G3x(Weꊦhy%33~#K+@F+M~bMv@F8y6pYPHOՑX@`z vSf*S뀬2p̠҇dc)ٰSYxIk^cqɌGOT:s)M 2LAjZ3^ٜhD&S#42ٿ!PM}WTE=M@.. \\ 'Oc|q;0,'͢hMvlk,vi!A+FGLe4sSMɚ7>s*%Đz#0.1z#i9*P=GP-&^yLPi:H/gIaBbzK_|$"?`켼W[d|AIE]ʘ8=݇ d\b]S[Tt68q 'Ɗ@6_>K)ŐZ%#a;}zxsis)r돝s[)x-Spc%}߻ry$+mԔ)co'L^1'Y!;Ǻak|.D pqIR*Liשu?jXc_0a:hJzq!{n( (:HrJ{}Y%OYÍۈ=K۔OKZd W鼽wܾj3ܟE }#gEl)-z8b óZJqdV'S ^N*p3uLB5|h|•Reh6&=xhr@/3Ԯ" O,`,؊ʌqbE؉0p)C8tKp8ˬ_w'~BE 7=7' .=4- gyAO0L l{hiŢF9RKO I}2wP"W@z9meW{ Hà5C1Y}?&=pWr|= fOs>݁zrQ;b Z!i@Q6o:p`0cucad.P8Xפmt NN+S6Ѽoc+)wP_I&߼3 -&} u "o!850GrekI y!DXTqd`Oy4pq!}U>ث@P?MZ[mBf7  Ή~7+yPWv;( ELV;=rHtb6/ $a5S{_f֣8y<Ӿ~G2>gMv”ЫN!G$A;4:HLxnSjAaRyHŃ_cѢdEH#|^a0FC%2ygn)6'F]6z_>[~^VN)+!Դ)/pnLI]睓j򱏥 -%K"L0i+' &p/]\pvGŰ'2\Wd0esFpJ4Re:(߄ ] fc z}}>^ 5 0`r[篙ۛgE3| endstream endobj 2352 0 obj << /Length 3221 /Filter /FlateDecode >> stream xڵْ}B'j%8gT6ɃhSL+o>}_F`4ěM՟߾zelʨty{ڨ8Lmr̔KK{t__%̢,aCBViHb9c7Ҳu \n7*V ,X;iz#Rxx=ШMV^߇Ν~/m㫣a_hqD*Ve aP9k3dQ1(QEI0me3v:#1q qŜ3WEb)HsQYA4%r'nx{Ł}˿CE E @W>++䘿ͱ꫶rλ];?xgsG9غ+CTb:lze"(3xԻAK\ Y>~HSˆk0l;g.fY@FDFLW'ؔ['vyz0W(iǛ uJP78h{88`rn/k\; :*rrLs+YfE-@Q\.6s$!|]ށkq&^* #ļogqGp!QO ًXc}e͐AD n6I] Ps{qp| AM8F,ӭgtre\QL"- %*~ A؆>8pN^5c| Om߷dɄ*ks4VN+2&y ,Z.0`+X\ki/K׍)pM]Hc`a5k@㟑Zsz%,?0`@p) |ǵuV(_(hM,) )Ҕ_咥Ԡ<2lC9e鐇9هO9()έJ +EO0u]O$#K\P!ײc^Q^#@ڋ $ıD$ [xŔdv]!λjAf #丄%zݪf'H Rbx& O_,R0: ġ׆G9OT+'YF_onơ"*) .Gw" DۏK:vbLxka՟5ڂ-h'z8Kƅ58e*h{נly}%T ^IqJH@ ~߯y;Ty !IrNnK>zj8hMfi:f<ۍ!ZjCilR)ͥ#hYo:b,oZU^#sq}2S[j4RZz= =7:lt3 &yt\ALE v} j-V}TUEJܲk\6k)z\kiL8i HP X|u[wV(dgE)Yk Fq$ ːK$Ha%3zA?Ux_Ydu&a|fifcL?ɠaU€Y *f㿕X? ϩ-il'+3`TUSW"v&$8bA%͉2v;zQx ;@ PDKW""v8Ǧ oBvn·Ҹ>YY9nRى_ԉ?Ud`1KD fw/-W9\px8j/.7x q.;N$DZW@!^*_Z5AmLTY'H'#ČI'Sns#fO F;ޏ|X 3hJ,G kI]ӻ~% a{,05YyU}PUA+tabgͰmʂ$ĸt=$s2_v S?bf*@-$!> stream xڭY[s۸~v@$3δٸLmc϶>$$u}(Ң6z88|j⫿\*V9˕TJp΢XR!M9y{yHq&U I/Csj8Ct,BBgD?" t[>3IU(2ɄvxmybF?0_V!w JB恟Sht;ԭvco݊׶LO7\53hOg}2Pt ;& :GΓW=yw.]'K JsDzyͥR_Eω0=)9ր.wmq}#yT(:צ`m4!UfH}Ɓ[d{E@p8w87CԚpӔŧTƌ<1w4 掳EsK03HgwjEp{m} g "\ G3dC֟TPtJwĄ}]9vŒOg؄ oC̼gcU,Q;F| tWT{W+A`ˇ@*?eLTfH=ڍ?[']hO}"@\5OU]9ϒGq|Y6a)'!% o`!4y p% gkzNx}ѢA=$?20~#'%,9OI<%ᩋ) #TtcnY0ƠqSvNڱDf0yjG B=R4⁜0u6L akCS凮n!) ڒ'DM½k-(L\so ӺITz=לS;昡 Pr0~q63d$DJ \uf)^O[z; u  &I0t! 9O8юSo=މY!Ұ!YV,]mI=4t<ƛ{gl+|$W~ |R&c3K1Oh=y`[e9Oku9WB4ѽQn'QFٵa ~R|:gqKJ~@ò) yBdg{ǙHgE:SE)kJ.OOůޞUϏ, Qx阿7[H`y8I-! $+y=䩠四 9 endstream endobj 2366 0 obj << /Length 2089 /Filter /FlateDecode >> stream xXK8W}h3".0&=L3DDd+bQd˝N7 ETǢf~yϻW%,gy"zƃQ2K9gI[mjݿ^;a4A GWߤg0, RrH쟄G߅@zƢ$doU;OAlMX8@f՘nd[j2* gK8ZVܬimuIՖ(,x6vniE4*YlZ}GBV-BMp-5`7r33T٭!8(F{Kc )?Tkz:g,8x,c Uz戼}҈b *D7y۵[v: )Sc\rikA ̱fV {M'.`>fzL._of[ߌrXtCiaakYufᗃEYD`EKbVwЭgWR |:m$qkP2n }/N 9OdӽRUݙtkv.Nb[0)@RϜB!O~pL˃7 nA/~޽8Y@c=Iɫc#<n8~#4>UM=כq¡L]nt7i~q.]߈Ҙ+]w}_ȅW}Q+Sj.a^dJ:mLn 6_jkӭQ=Y3̪dŢ66tMS,:L еTɠ$Vb?~n՗=p?eQ׻8n IE/p>\vx*LM]yCi]PǶftG1Ӊ|#\ yMO'e8]f;sܾSJO44UYt.C*T9(Ǔ2ecCS˧WowFёG| Q7.mϲN9jCͅ"xR_:kOYW/.q..8tmN [AS,[b>/YiA+{^r ċ$yzvzٟW}(t&QG'(@"GD2D> stream xXo6_ad{X/R 0yCW DB(Q ~߾r,q E*wߑ?)'糷˛h1I4d0$xqNVÔtqM8A=S]|.[SF[3) msJ#/L$nss6|O.j_l^*]DpIQ\XmfQ2 lfs?Hٝ'(;"i )*"@F{z" ̬##rcp8P pK!/pTk \g[f$rԛOKj'{ wN *Qa"F'ًSW:ιp^\ ) KHyr{``1Ɲ5N7=b7S4 j4Y\(@:U`苨{ѽ[Z9$z9ɀ{DJ3c)")hH'D| Cv JHx\5R18i);>-1/ޤQ\HmK6 u;TRh\PO}Ig+sf4x8{F;-Dg|5 ݱ9oE KRd̬ ٕ]l[fVD373՛T= rR^ϖioz$.gu @cο)(@8DX]yڄdG dShjcJ7 /x8+[EѷF郟K GcSnm]A<=m%]޽n)_I'&PAB?뷆Q F*d_[Yn!sI#sA+T7Q.1(׉EԷ,Qr;̢+R.*TQg{ȠF-ӉH6n|Ɍn}|BC#1V{wfTi3ĥ񭳚S  |p-yN7jB'=0X;v{ 6z4. X$qAѮ^$k> /ExtGState << >>/ColorSpace << /sRGB 2383 0 R >>>> /Length 19440 /Filter /FlateDecode >> stream xM-Gr,6@bRƗGuCz34&FxٯUHj_?anyTE-xAʌs2<<=Szӿ~~͏u]OOSsO?|O_wzHzCӳ\O9zs<_۟o|^OobxϽO۟~eNWy~?os^}^~ޣJ2kyTnK[חi73Ͽ3&ҟ|uOgiO`/s a}_}&dO0Ga׳>?}~˗O__Yw5?|.W| 1y Ytp<ߙa#Hv:\򟟾۷w䟹Է09z?~O%F9z}o\>㽟_WO v\8Sx]oF{]ʼ?}g?|ݏZyW>9"f}_//ҡo.s|%d*nr]&0Ӿ 翭B}oP5fݬ:zHEV1 25Ogzh_9F>.N4+Nim'yyWL~oCw/3?p_^8sW ϋ@J\ּ+7#S?SWheXZ/G&yщPuOߢ]̿x.}}VO/ݢb-'v-0_~vDF;`!XqQ=TjͺO_6x G|ݤ< l8~ ı1ke|;1V$]kR~8g_yU5֫r.w ʺ]$9}aaKK`VKoX0^>˅^_xX//>1تcǜᗍgx;3 ؽK;3qaNw@~ ,%7)Vpαn%pGȽ1Ց!QQAߥ79J~??ӗO_s / =t3ƾmlӯǧ/ =u5dxWO.xM}D?.`/}ӷ{@bjէt|_i/{7O.%]B 6`;7?=?  vwÊʊB.ۛ?^¶ُ4~ʎGWm(=?|{z\ňܲncEVtn!CʷC ?r5<!}bӥuy+[f/z5dFwΓuR3?2|] 跴_|=#~fZ凼\{!?3EDCn)jY"*?+\}A ׇZX Q&ϣ*thnp%A,$\{2(Z0 ןX+*Q5 Jae•$ps(. 5. QJ7_Y+f zi{5n݂S x%Ue\}bpQ$XF/«~'O[Bd*E+0nwUZp}U/pj5 Z6dpXE̬Zp]ނC ] \V>쀝#*C.(1j ap4n#\RZ`pd#?`:kg~ n%vA־d{0P]^nVA@MX/T{z (.Z hǠ^@<\y2("[Z xOO^0V.X}G^{#>Vۍ[2\7 PẼV,Q">QR8 2,Sj`+״ob _ךi#o >98r^1 2\鋏n1XmA +[ ۰\ku,uymX ,\p~4br|#vO<+״G̑2 \ h\?_p^cRĖd1XVu,x.\0i~ ۽ cp K\pݬG3.o-3.bp[qdS;;\1:K*#ud πAW&^T 2N\{A]0nn xf+xG^{#vw{ \tK0o 18Ta X}d1suA&HeLAe2h 2`^0`A.[ cDdz\pd VK{Fd Vs#ݵpBd16'2>zb1d2lnpݝG^7A$-2*^+[X1XU߲ ca A R5Tz lp ހY r b1HȂA?g+(d "Za-ѓ9]k[ [K q%Jȝ2 c*U  RVlb*b*«HӸ,Xp 2wb7ט#Y V],}urd4bpd "I-k< =`ջ`p 2 qAٸ`?% 8ǠnAM#ՒW034aZ&U߭y -59bI~i`Xr!oEsut[ nwzDΰq b3p KπYcZ .=-g cp3,}֘Ɯ rlJU/$)  i&A=fd;%bpzjSI b̖` -b1VynC> 2{W0`LcA+grd .R#eY-ݳY 6݃X1DZwʘ`hkݙb1zd4{#=`u"4Q>2Sbp%I[A$Ib92l$)z>D7}LH |h*Y2f6l7\9p3C,_8b EՓ[,vL%`f ܞE ߍל7"a 禘 C@[TT¶V1-Mj|!L;-4'R pj3h,\آ[ [xN's*[\M;2)1\b rq>85 pu+LJ2rJL PŪ+f"0f/g$q>8-&az`aNaa4?+%ר&dȊƁ0W(0v:o-S>~x!KN 9dmu'ɰ*R4V.;O&eXz)}[ɹ|HN--â 9]pmN-f.,SQ2?fJcfI0W b:fhfҸ c>$OCEٳsWSǤu_79$p+ϻI4'q8#p-~;&0A):SiXVG]v2 TJi-~*)7[*Wm`$|N?YWkG-~'uBmvbMt)l;w_Eέ"e'׺:\Ut݀]!]wSv+N-Eq!NaMM oE`./:KUl]oZ uj=W]+/k鶅u>8ֵ(I(θufvӁ :tY^8:]3O'0~x`oj7Xڍc>dN׊+d[ #)rZ`o׉8 Nv$(>>_y0`_ppG1~A<$|(NƁ`9񑿔fːd0k ]8#g9%9'").>>茦۵~|N\ŃVT)#-Nρ-~t I03t`IbߡKqIS}|Y:(\tMtC:Q5U$w.\-~/:w:]׵t_1T2Y80E󝡫_,h1v pb1vC9H%0~qB5:u*f˜ٻ/2#)N bPJK  bP#N-:*)+zeaՙCIԜ5ls~oaupD+,М[Ksoh)0,Pĝeǟ,`|iy5b3]dBc>4Fw?;rЉ|gBe2jXC|gβ|poP3҆;C?-~ nA\Rs2&烳cr>87&ô_3Sq(^8 `߅1Y@8 88_ĉ3bD>a088u bze&ꁜ#ggE/HȬ08)8F0qZIq񑿈S)Tn&R y`; R;u w0 i w@?i3||q'0wa/-ߙߩ mgeX' AN|LQj8Yp󝅑ϊӅ Us|g*1\||/BҮw.tSwRwpȧlbv*fMg[Gҝ/]mWD0Ub땩;hJKw|oSl;4^[Z9_0|!(⡸_Sԝ/$iS!-~·|T"wjҝ/L9l;%`|a. uJ##7J5F>ۍ/`|!·|tݢ* 1 gZE0a|!0a|!p3ߨfa_0/|@Z3gďb NbB`̇a|!0`)A ۥŁF2/F>;/|`̇a|!00 <0]Z$gGza_j 1*V3000OB`|00000X9K8/`|! 5R ##c>L 6vN/|˼<~0#|W(ء]_.`Յ:t_fJ0H,~·Yc>;t>ՄF2ǯ[jA!dØz*f8_ft3qX`/B`B`̇)\c>L 1_$F2/lI ݰ u>_B`/B`/B`/– u>_ e|!0ARWk"i? pK 7iš*\ax. %.(>i3~ B`7;(fb)f&wg|!LINv j|GeJY1GU::1%G̗(pn-~;`W~ǯ&[VØ:ʼn9_ܓ㏢)<~ e|HWw!O^>?\'%_l|UJJȧd|aF,.Yks2Ō߬_p{EL}f5ffUj3~,. i$|Hc>$ u>tw.s2q fx1' u>_aX3S3~V0fLdvB`]L\8/|WŌ\Vc|!9'w*Yu_ObW&N>4+Y9_^R6nOboVޜ/Vo {S<|zT 6iMJl3~JFȫYm|!pϔ_|6lL\`cZ䘳xjZ'íW?|=~DNV07"i6>|aZWժG`;Bry*%c> [0h0ŏߢՏP3~:3djḃb|!0򗅧_ f,7bE} 6lWJQb__8_b/>襘n3~____؊s/B`|0K1K1K1l1z u>_ƍc__gB`̇zY橘[JRهa/5YSN-p_P/lfCIzZ'__P #c>T 1j|-W [zI0~ȁo+ůVfc>u>wK[j$ůKLW_`_XGRǯ>Hv[hbcW+zI`_>>|azI`/6bW|!U:_ȍyu_4 .,Rg ɊUP/تj^ #i2|9_XZu;>nO'oףɴ؟7C_$K'oߧO޾o%2oe߯g>>=_O|Z?Vs|D+ 61߫OFQZ+^jdO-ޗup>޷u2qg}]'p# *EBO@ZoFEv|BSOOѴ~2g4 f!M7/a!O)mp>8Ҕ >;Чqj69OjmkojZ?|TD"_|\k@e, >M.sηuEI"_|$J"?|Ыm:(|:_)|:)Z|( /LTkoERZ)kϕB^)kBb"Bm6-|R:-|R:.|R:.vJ/+_|4K#_~8i #D'cB~23Dj":bD49~ b?Ft3kD'c?G~2{ǹ8"QO&t(د8,Iw ~D엉ZM~}$bM |?N~2D'c?z(c?P؎tO~)iF,$JQ?ϔ|Ю_ڵ~2SO~khCmh/횸~p†/"႑n(\+Xٝ{~rwOɽ3|g~<4bg~~gײַ^?`¸r7x+~r;tOz]/+WxE?z zxDFg謟zrA!^Փ7鬟(^~r׳P/]z|zNg]/Ӆi:'wMg鬟:kѨ@]! '꬟F~r+с$PxꝺWD=TW犨꬟Tު~rcuOz-6|z.ژDWW!rԃuOz]OY?:'w= [ZWڨgcn~r Oz]o7xC ϣ^oE?%'w=`mBo#q>8_8t3tpXcOV'#s>8_82 cktpXt~r׋[=`o]o: i/u~r׻%aGz?ӎw'Xi/z^`upT:_H ]/8w=10'޸ Oz=2p.Q Ig=ꝁۭ~`c[w;^ \oMXFԋ7>v=90'޼ Oz=:pQo5E; '^^Om~ӭ^8K-X[R8_8X?zCo>F~riF~%pq7 `>F^DHn`'o~#5 p+WL 0CK'_~*YoXCkrG~/gxb$-~3E+l{qmIp?`aD& կB`k2Xn~?#,$'~M7~M~Eg,~G~I /V& կ~M-{-կBI~M'%~SG~MW~Ve|!5h~MJjk2-F6.ojUİ5_ܯ9€OL1'7B`s33n-΀p~jBcZ~m ?7 X_|1ON/o8F~u_K ?<^/x=$os>`/|?@~_ '%k#ntoB;n-_"p)~~r1#qF<^rA/I@~_%png ~ ?j~sA:>k?P`5XG/6h/N7?S`5XG/VQ e*oxcL kN~?j|!_JK ?Y`>ݏV-7kl[2Xh/`~ <$x_6~Gk~o`f€=ma5K܈p s 71\x8\ k#6ɀZp=7^e2KI7mNn,sg4`+,pVҀ}liRqj)Z&Հ),lka_؀l 6X[+mgrKQ \7 lov3psp5Hp8mB.E)p(۹D7\i%Gڶꀸf.E+ ݒano` +x@mǶ6ܠ R4g5pc|@20|@'E+rfî_Xful@v#@8n"8n1 E  zX{Rv@20pݼ9- z87\.`vmx+v@ `&e<ݕ7<ԪFo]%ol(n8n!E *`ʻ`n`U,p={pno8n "U7L#k&{k*q ` `vwK5߼aT_v*;f+XUިPn8p o#jc2y3ڍi[mk%!yCJd{aGh (i7 em7}!@oR na op,,ǀv{sduu2Ȼ2z{eR)3o Xn Xn n (}n$ 8n3-{ބpbD~ ?:ǿ~=?z\qGח=?z\|qǵG/=?z\qGk=?z\qqǵGG=?z\_?z\qzqGnG=G=?z\GqGmCJ}h'?A~_ ??(+U?M8>kG8oypmxp8>~[%q8MPKCpz?uSU{ub=xfZ7ëp:|A앿>vxezvx=8~j/éq;\?=w8uywr;'çp;<WޯaU=i7{{xr=|Sp>/|x(ˇ|8;}>\Q>ܨ'W>ׇ }8hڇ7p><Op"?_.~ݙm~x_&x?8>\?o×k8vg;vg; vg.lp[xlpkxlp8E$v(vY.vgnٮu;lr9ۍ<#9ەngr;9ۡRv*gcv/g;]Nl7sylWsyls9vv<zv>?lt : vDvFvIg;َll.l'u:QY^:ev[g;]c;v`gnlGv+{lgv;{lvS;ۭvmg;vog;vrgٮlgl]Nlw;_ < vg³cóvg;ųَlxs|hxvg;ɳَlWy<]> n7|#>vg;vg;vg泝l.l'َlW}>]vُvۯqvg.Nl7svg;lNlٮl~{?ɟ_?՟v8VF ĖV5Y[Z %.|pi50KMz->JTI iuliu#˲CZ ZHki5pBZ FH/ iuK%g|RY9n=*RY)6X^*9+^*I͖Vj`zKi5pV直X^*9 ^*IMіV#qi50V#qi5]Z l4{*RI+3Vj`VXRV4K%'\ZݨF:uK&n=.|pi5pBZ |V7PjqV72[Z K%X..j`/.N) xV|RAKu>xՠK8ݤg]Zݨ)j`VX^*9hj|Vj`VAK5[Z ,#MBZ \oj`.|pi55BZ.65w4JTћV#ui5p.!VimP*F V7n mi5JTrPj2BZ g/ºؤӌ_l_ݥ]!niwK[Z= ^*9 ^*92^*9(5A)V*{0)J iЂV%CZ=wK b{0J}Їzh]`Hzhe`H[Z=(5A)Vs?5CBZ=E VJ巴zPJ՝R-oiu*Vw- iu:VwZliuUVwZ liuVw%CZmVw%BZiu՝V[Zi՝V [Zݵf0]CZݵj0ܱiuÖVwZAliuUĖVw} .BiKVbK;. cK;2 .BK!+՝V[Zi՝V [Z.R\VFK;HӪdK;L5!!RbVJK{٥՝V+[ZiŲ՝V-[Zi岥սTۋKԺ&>uVwZliuU͖VL)KY)%wiuϔJgK;vӊgK;z'J]Z.RzV(0 iu׉ꮚVw% CZ%] CZݵ0]BZJ)]BZݵ0բU!-; i5V+բ/VZIZjÐVVZ0բVW! i5BZ-ZjĐV>CZ- iD iWHEBZ-jjRĐV"Z1բVe!|piKi5 CZ-XZ ihQbHE8\Z-բVo!F)KQjiZ.FKQjκZK^,R)uiTJw]Z-^VKץR) viJ]Z-bVKإ\x!BiKPj)FZ .(LK%Sjɔn!]Z2.LK%QZjIZK%q>ZK%QjIƻZ.zVRkߋ$:BZVEK5󅢉xHZ}hHZi)cH2i1cHV3) V7!nSHCZݴ1MZCZ5M^CZTꦕ!nZt!f~H!n iuSېV7!nZ%!nZV!njuZ!nZꦅ!nJ̇B!$:CZK[|p,MCZݴ1M+CZ*K[|pDnH[}VV)uiu+:_ B)KZQJ/lRcVB)P|a˔2eJ//$CZ2L-S)v%J/lRoVD)-Q*|aK;_H!QH[–(Mv%J/lRSvQ*|a(w]v&͞>oꪥ!jjFCZ͍V|a|a ɐVW- iuɐVW- iuUdHQjJBZ]P2U"!ńjbꪭBZ]UAH2iuzɐVW iuzɐVW iuRҐVWM\CZMrHqj*CZ]!J"U[Mj+VW iuzɐVW i5Ő!iuՅoHk|pVV󃅴jdHKjdHk|pV k|pZPՅR-&V&V)7iRIxVkMZ7iKޤ&VMZMZ7if~b〧~z7OｱIPf}??)bZ=.˂ }"乎tlm?Q}>b؊h{.p|:^miӾOhXm"u2ֽ٤uchZ.VGxug>.do?`_2kQumoqORm?@GyQP1!yxvG34?9;!dO:Dctk?בͣ'vR{lEq{.p,T&'j))5t\D:RߛkH[7v%ug):|s 5Ho 1o{tlm?Ͻ(}cW2zޮν_;KK~kzDhCҺr(߽մvG߶uٹ2laSϴj CMFʖs <~k}f{lEؕsm }OtKY>MB{ g:{O7emaveD(IEWn/4~75$~_O4ZAǮ~_߶uٹ"T|DJ]'=цMO7v#O& \RqieޯEe#-^Q]+a=T)PZy>oJf޿׍ߟ__#lƿS?}"aw$&Zq\_K\IXcg!G>p><`O>`+kv~`04x;~)_}e_7?fݺ~G!ӯ I>?}e?}t_<{~OF*\~.ۡĹg 3nƙ\3~-pr)Q÷OݛnT_O'V@d.o}yڗ.Q endstream endobj 2385 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 2410 0 obj << /Length 2288 /Filter /FlateDecode >> stream xڽY[o#~=$Zwٶɦ>$E:P(3#{]=䱭]d r.x.?YMɻ'Wa2IYh2_N3Dst2'?z< * Se3ŰTv17g ?.B$2,ʓ_NXa5Dߗrfn`OF t&#t", B&)%(Z4ϚSsZϓKƓUR*ǒI<QI؉>wӗuCʭrU96^eCdlcu:JxYQ LlY dmkabzFeʩsƍ EstVhlcO~4K/|gÒХaɉ{ PXij[FRΪ]Hсi v…7_A z4C#ۻ%JЀ3UImՇx{}÷?_~NXq ՛ݼI, b+7ۑ\Dkn[P=U0.~-b +Ʉ#gDT<.󫛋B&Sl1Qo[@WH #,v$aON gx$v+O;`ǘOnn/pIo\ݫt5S74G.db9mKbKE-$WSUKćf 'JXݚ2cJ}I4;fB)^.'"OF)LFrhUboOI x ,qL3ں_b8RÍohl#;~<wyZB rYD]lW˘Xɪ7ݦP_tMms!!kEA).(IhTspoD@ZKJ Ix2 2ZmdNvQ*5 3`;R݅ːFRl+j9bi-QmJ ~CeW څ-zk3WgqBU_?VφU_XP/{4%7٠.+LF܃ǬGr'\D;,5+tp ?|KtkIj- ѮVΌh4 !`,}O3RA<3"ݻ0/+}@3O3"k QfH[PfqZ%*'5pO u>nT'筱hMG@~.+m?BU[Mִ5KJw텴;W, >,Vѣu4eu-vٝ5֝>!*S!&;'Y1}ڗ\1HsE܍.4tHұCg#LF M$|(w_6|J{o騼 P~rB !} Kx2A}o*rJhPb!mE|]C"ڛw|l ] endstream endobj 2374 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9RzswN/Rbuild15811326fd38ff/metafor/man/figures/plots-dark.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 2412 0 R /BBox [0 0 720 308] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 2413 0 R/F3 2414 0 R>> /ExtGState << >>/ColorSpace << /sRGB 2415 0 R >>>> /Length 19439 /Filter /FlateDecode >> stream xM6Gr-EolU+2syg3C҂p̨_")w8dsniE/*2"O9)=_?ozOst=|=_SsO?|O_wzHzCӳ\O9|է3ݯޞO")=ϟ^}W)=wYӯ*ϹGm]N/~կ׿kn~'LQ,O_oW7_ag}Eo<Hϵx>ap ۷`۠ߓ5dg!Mxeݜu׻~[~J̱kYvHiTC;./tCIߴ2|uǏưEq{n1dgC Iy5yNM? 񐆫\8zY~!{{<.jMÏw~uY~C,@tگ3Ïl(җ:;1|?$K_\߻Fhv00 ?q|;$LOhϗ~hw~=q|;$u۸>Cx]uɠg!o䂜 /֍i8!㐷%xq?7OO_$o淐5`krמoiE\߾}tu#¥֓60~/1lP]WEGxz_zﰭ>a/:z7Z;z0U歿?}>~; ;ə OOw߿|Juk ^wӺOVt󕐩uäN&,~W\>{ AH֘vx%"Yy(0Jo?UQt<YTN@8xʮ8K+Oo|hދ^1]/KB^|ߕW7@}=zy˛]f7X;?/)qY?k܌LM{O]aixqϚdcNG'B6?}vwD06aYmgGD>#&Fvx{0ٷ(o*r~T;N_F7N)BDlOYw; -BVaL}]߂C̶s#4;EG`wĤk8?h<=GDw<{o-3+yn0wW÷7Fozc}ow텑u/'#B<{bd'^oUqVpm)"Α6CEBحJ/V;ҍfEV;=TpmPaDja|=&wu:Tj>`{UpzUm F{M(|<~;ԍ;@ y5A|]wOMp,];cwS7up+.\= ^SYiˆ}?>ah=Ϻ ^/`z~86!t lx:Ɗ4׳kQ*8\/>1zU݅⎝UY80;/L5l~ ,تy ygg%mtM<~o P~Ze<};u[uR3,/x#cb;9;~ \ug&71h/C;E N9V 80ư:<$**c4{#G_QO~~4\~#CKC팱{8 au` >^ ^3'՛OnS<4Qkb#-  ow_|3؃Zc;×kZ?} So)KI XGqk7?=?  vwÊʊB.ۛ?^¶ُ4~ʎGWm(??|Nz\ňܲncEVtn!CʷC ?r5<!}bӥuy+[䟛pn3ޓ);OuK{2+X$ xzy-헾_Ͽ=-숟{r!'מvL=Dͭ1ܪY"*?+\}A ׇZX Q&ϣ*thnp%A,$\{2(Z0 ןX+*Q5 Jae•$ps(. 5. QJ7_Y+f zi{5n݂S x%Ue\}bpQ$XF/«~'O[Bd*E+0nwUZp}U/pj5 Z6dpXE̬Zp]ނC ] \V>쀝#*C.(1j ap4n#\RZ`pd#?`:kg~ n%vA־d{0P]^nVA@MX/T{z (.Z hǠ^@<\y2("[Z xOO^0V.X}G^{#>Vۍ[2\7 PẼV,Q">QR8 2,Sj`+״ob _ךi#o >98r^1 2\鋏n1XmA +[ ۰\ku,uymX ,\p~4br|#vO<+״G̑2 \ h\?_p^cRĖd1XVu,x.\0i~ ۽ cp K\pݬG3.o-3.bp[qdS;;\1:K*#ud πAW&^T 2N\{A]0nn xf+xG^{#vw{ \tK0o 18Ta X}d1suA&HeLAe2h 2`^0`A.[ cDdz\pd VK{Fd Vs#ݵpBd16'2>zb1d2lnpݝG^7A$-2*^+[X1XU߲ ca A R5Tz lp ހY r b1HȂA?g+(d "Za-ѓ9]k[ [K q%Jȝ2 c*U  RVlb*b*«HӸ,Xp 2wb7ט#Y V],}urd4bpd "I-k< =`ջ`p 2 qAٸ`?% 8ǠnAM#ՒW034aZ&U߭y -59bI~i`Xr!oEsut[ nwzDΰq b3p KπYcZ .=-g cp3,}֘Ɯ rlJU/$)  i&A=fd;%bpzjSI b̖` -b1VynC> 2{W0`LcA+grd .R#eY-ݳY 6݃X1DZwʘ`hkݙb1zd4{#=`u"4Q>2Sbp%I[A$Ib92l$)z>D7}LH |h*Y2f6l7\9p3C,_8b EՓ[,vL%`f ܞE ߍל7"a 禘 C@[TT¶V1-Mj|!L;-4'R pj3h,\آ[ [xN's*[\M;2)1\b rq>85 pu+LJ2rJL PŪ+f"0f/g$q>8-&az`aNaa4?+%ר&dȊƁ0W(0v:o-S>~x!KN 9dmu'ɰ*R4V.;O&eXz)}[ɹ|HN--â 9]pmN-f.,SQ2?fJcfI0W b:fhfҸ c>$OCEٳsWSǤu_79$p+ϻI4'q8#p-~;&0A):SiXVG]v2 TJi-~*)7[*Wm`$|N?YWkG-~'uBmvbMt)l;w_Eέ"e'׺:\Ut݀]!]wSv+N-Eq!NaMM oE`./:KUl]oZ uj=W]+/k鶅u>8ֵ(I(θufvӁ :tY^8:]3O'0~x`oj7Xڍc>dN׊+d[ #)rZ`o׉8 Nv$(>>_y0`_ppG1~A<$|(NƁ`9񑿔fːd0k ]8#g9%9'").>>茦۵~|N\ŃVT)#-Nρ-~t I03t`IbߡKqIS}|Y:(\tMtC:Q5U$w.\-~/:w:]׵t_1T2Y80E󝡫_,h1v pb1vC9H%0~qB5:u*f˜ٻ/2#)N bPJK  bP#N-:*)+zeaՙCIԜ5ls~oaupD+,М[Ksoh)0,Pĝeǟ,`|iy5b3]dBc>4Fw?;rЉ|gBe2jXC|gβ|poP3҆;C?-~ nA\Rs2&烳cr>87&ô_3Sq(^8 `߅1Y@8 88_ĉ3bD>a088u bze&ꁜ#ggE/HȬ08)8F0qZIq񑿈S)Tn&R y`; R;u w0 i w@?i3||q'0wa/-ߙߩ mgeX' AN|LQj8Yp󝅑ϊӅ Us|g*1\||/BҮw.tSwRwpȧlbv*fMg[Gҝ/]mWD0Ub땩;hJKw|oSl;4^[Z9_0|!(⡸_Sԝ/$iS!-~·|T"wjҝ/L9l;%`|a. uJ##7J5F>ۍ/`|!·|tݢ* 1 gZE0a|!0a|!p3ߨfa_0/|@Z3gďb NbB`̇a|!0`)A ۥŁF2/F>;/|`̇a|!00 <0]Z$gGza_j 1*V3000OB`|00000X9K8/`|! 5R ##c>L 6vN/|˼<~0#|W(ء]_.`Յ:t_fJ0H,~·Yc>;t>ՄF2ǯ[jA!dØz*f8_ft3qX`/B`B`̇)\c>L 1_$F2/lI ݰ u>_B`/B`/B`/– u>_ e|!0ARWk"i? pK 7iš*\ax. %.(>i3~ B`7;(fb)f&wg|!LINv j|GeJY1GU::1%G̗(pn-~;`W~ǯ&[VØ:ʼn9_ܓ㏢)<~ e|HWw!O^>?\'%_l|UJJȧd|aF,.Yks2Ō߬_p{EL}f5ffUj3~,. i$|Hc>$ u>tw.s2q fx1' u>_aX3S3~V0fLdvB`]L\8/|WŌ\Vc|!9'w*Yu_ObW&N>4+Y9_^R6nOboVޜ/Vo {S<|zT 6iMJl3~JFȫYm|!pϔ_|6lL\`cZ䘳xjZ'íW?|=~DNV07"i6>|aZWժG`;Bry*%c> [0h0ŏߢՏP3~:3djḃb|!0򗅧_ f,7bE} 6lWJQb__8_b/>襘n3~____؊s/B`|0K1K1K1l1z u>_ƍc__gB`̇zY橘[JRهa/5YSN-p_P/lfCIzZ'__P #c>T 1j|-W [zI0~ȁo+ůVfc>u>wK[j$ůKLW_`_XGRǯ>Hv[hbcW+zI`_>>|azI`/6bW|!U:_ȍyu_4 .,Rg ɊUP/تj^ #i2|9_XZu;>nO'oףɴ؟7C_$K'oߧO޾o%2oe߯g>>=_O|Z?Vs|D+ 61߫OFQZ+^jdO-ޗup>޷u2qg}]'p# *EBO@ZoFEv|BSOOѴ~2g4 f!M7/a!O)mp>8Ҕ >;Чqj69OjmkojZ?|TD"_|\k@e, >M.sηuEI"_|$J"?|Ыm:(|:_)|:)Z|( /LTkoERZ)kϕB^)kBb"Bm6-|R:-|R:.|R:.vJ/+_|4K#_~8i #D'cB~23Dj":bD49~ b?Ft3kD'c?G~2{ǹ8"QO&t(د8,Iw ~D엉ZM~}$bM |?N~2D'c?z(c?P؎tO~)iF,$JQ?ϔ|Ю_ڵ~2SO~khCmh/횸~p†/"႑n(\+Xٝ{~rwOɽ3|g~<4bg~~gײַ^?`¸r7x+~r;tOz]/+WxE?z zxDFg謟zrA!^Փ7鬟(^~r׳P/]z|zNg]/Ӆi:'wMg鬟:kѨ@]! '꬟F~r+с$PxꝺWD=TW犨꬟Tު~rcuOz-6|z.ژDWW!rԃuOz]OY?:'w= [ZWڨgcn~r Oz]o7xC ϣ^oE?%'w=`mBo#q>8_8t3tpXcOV'#s>8_82 cktpXt~r׋[=`o]o: i/u~r׻%aGz?ӎw'Xi/z^`upT:_H ]/8w=10'޸ Oz=2p.Q Ig=ꝁۭ~`c[w;^ \oMXFԋ7>v=90'޼ Oz=:pQo5E; '^^Om~ӭ^8K-X[R8_8X?zCo>F~riF~%pq7 `>F^DHn`'o~#5 p+WL 0CK'_~*YoXCkrG~/gxb$-~3E+l{qmIp?`aD& կB`k2Xn~?#,$'~M7~M~Eg,~G~I /V& կ~M-{-կBI~M'%~SG~MW~Ve|!5h~MJjk2-F6.ojUİ5_ܯ9€OL1'7B`s33n-΀p~jBcZ~m ?7 X_|1ON/o8F~u_K ?<^/x=$os>`/|?@~_ '%k#ntoB;n-_"p)~~r1#qF<^rA/I@~_%png ~ ?j~sA:>k?P`5XG/6h/N7?S`5XG/VQ e*oxcL kN~?j|!_JK ?Y`>ݏV-7kl[2Xh/`~ <$x_6~Gk~o`f€=ma5K܈p s 71\x8\ k#6ɀZp=7^e2KI7mNn,sg4`+,pVҀ}liRqj)Z&Հ),lka_؀l 6X[+mgrKQ \7 lov3psp5Hp8mB.E)p(۹D7\i%Gڶꀸf.E+ ݒano` +x@mǶ6ܠ R4g5pc|@20|@'E+rfî_Xful@v#@8n"8n1 E  zX{Rv@20pݼ9- z87\.`vmx+v@ `&e<ݕ7<ԪFo]%ol(n8n!E *`ʻ`n`U,p={pno8n "U7L#k&{k*q ` `vwK5߼aT_v*;f+XUިPn8p o#jc2y3ڍi[mk%!yCJd{aGh (i7 em7}!@oR na op,,ǀv{sduu2Ȼ2z{eR)3o Xn Xn n (}n$ 8n3-{ބpbD:wqGk=?z\ ~qG=u=?z\~qG=?z\qGkG=}=?z\N?z\q2GG=?z\w=?z\q-?z\qZ߷=?z\M=j?VnWC~(=6?JCJ~h?A_pnDp)8\ ^{?px+  k+O8"/ipxaq8\;q8k}xr<×p-<< ?-x0.xC<%Õ<-.7W^ypp| z8Iz8~n+GpY=^pE=x |‡G|?xNǯ|CpX>w }xF҇FU}8Y>\A>ܷWއ ~8~Tp9?<?pW?okWp?7kbx?x?8\Op 8 <8nWp38v g;c;]vg.l'qxlGqxlwq8e4v8vy>v gnٮu;lrS9ۭX۵\^{9bv2gcv7g;]Nlsyhsv?g;]Nl7t#zlWt3zltK:)vLgvNgvQg;َlWlw.lu:qy^;ۅvcg;]c;vhgnlvk;۹={;nw;͝vug;vwg;vzgٮll]Nl7x#< _K<)vgƳCdzϴ=ۅn'z=ۑJvgvgTvg;ֳ]llnlG{=ٞnvrvxvg;߳]Nuٮlg|;>!?K>)n|c>5vg;vg;vg곝l}~l}~ݎl}>}vvgkG~+?ۙvgvgvg;lNl7ٮlg/=8V7j Mj.!|pi50K1\Z lkUMJHeKY-jBZ \sHj4BZ |IH۬^*9+烗J`p!V)JJ*RY)RIjnxVK%'\Z \GH8ߤ*MRY(]RIjKKj`^wߤW鶗JNZVݤ*-긴X^*9iFזV7ҩ[Z ,7i5p!|pi50KjkV)j`^*9(ri5pV#qi5pJ!nݤX烗JJ\Z K%]Z %&F>FMVc>X$*RAEV直8Vc> J]Zݨj`!njzV#ui50K6(ti5IQЌޤKs i5J/lRQV7jXqKhKU쥒RUVj`>{֥&fb.Fߤ iTwK[Z=(Q( RQ(Rɑ)-RAVJzTK%ITrh=`Hz(q걥[j|gK%ITr>CCZ=00C+CZ=(%AVJѷ!Z/V]zP*ՃR-oiuKV k`H `K;J`K;+jnk+N-BN-R5!Z4U!}H; bK;"(](uiuJ{]Zݵz0՝V[Ziu՝V[Zi](MviuJ]Zݕ(i5\!N-(uiuo⺴7Ju]ZiE՝V%[Zieլ iuWJ]Z+.ZN+-jN+-ťҌ^\Jť7)v񯻴ӊfK;jgJ]ZҜVL)K{ܥ՝V:[Zi՝V<[Ziճ=Q (wiuOһGiuׅaHNԐVw$+Qj&.!Zo!jVJ!jE!: ihaH_!}хZJ*բVZ0բ! iVHYjĐV Zjх]HE'ZHEBZ-jjQV"Z1բň!* iKE8\Zͅ@HY^j*բPHECZ-ji.z i4J]Z-TVKtե(mui4J_]Z-XVKt֥R]j f!JiKRjZ*.JiKP:j)Z .3,` iJ]Z-gVK4ڥR(viGidJ]Z-lVKtۥլ iB%Ւ) widJ]Z-rVKܥՒ8\Z-Ւ8\Z-wVK4ޥՒ(wi\ֻZ.Z[^.&jHZ.J]Z-/MCZ3M@CZ*4MKCZݴ1MCZݴ1MV7]hiu-$BZEE!njV!njRV7l iuƐV7 i5CZݔiugHZ݆D iu ǐV7-q iuǐV7 iuSސV7 iu:ǐV7-t iuSb>M !&8\ZM_d!nZ!nZV9\Z*$rCZꣴU^7_JK[V(uJ]ZԊ:խPJ|a+J/lRe [٥-S|!5|!&)veJ/lRlVL-Q|aKz%J/lRq [B BZDi-Q|a(uwʐVRy E)zV˥7i|VW- iuՍǐVS3jn䄴N |pN VHjdHHjdH%CZ͍VSꪅ! iu/&UVWmEꪭ BZ]AHKjdHKjdHjjjCZ͍ÐVS1֐VW iuV!j"U[QjdHKjdH) iuGH.|CZ]+r>,U%CZ]^2U%CZ]+r>8_X 󅵸ڤՅR-.joi&7ig7iJIMZƛZ%ojI^&V/7i*gnj%ojI0V?<=g~z͎OOj0|IuXdX&uchsVG߶u܇ӯjO5?EjcA;90-~&v#GOr="=6s> iv!|RO O]l3{[jy:*7 ;k'?Yݹ &{!^tlm?sc+⍳u܇g2?Q LI il޼%\C:6>>W N؊+5~oeޯ>KiOt[OAz[TL`=}5ch ~E鵍v]v=Iu]D_^];#B{ptG֕COM?אhD}{lE<ޮν_ݗΐ6f{ O4m}u5Tn5WdkH]s5c+Ʈd]{n,Nsk7]BWRgo"{4[o8;Qs>WW-{m]}n /'ZGN.>up}Q+~Ͼ ~!Ѽ =vޮν_5~'oU*v=驏6oz҅s|2O粗cM̸.;~,*QmϷjD,]9U JokXN~(䩟 PUͮ}5vZVXоE?Hbᴂk !yYi:ұyDK!}cW2_}n|_=h_oS?"aw$&Zq\_K\IXcg!G>p><`O>`+kv~`04x;~)_}e_7?nWxkׄWò}՟?W:/=}?'#X o?P3eqf~C7Xgcq(ۧxM7z \o_|1 endstream endobj 2417 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 2428 0 obj << /Length 2807 /Filter /FlateDecode >> stream xڝYY۸~_KoWSx`o%1ӍnPSzPnu7(W+͛(X"tۯUtu[}7ɻw?ݼ ?D']I>ac%4Ymt | a*o&khۮ􆞆CTD&`+["k )X{X3)k*yZQv]_#LSeG]l?gձ4U3%ɥaHp'wrNzyk츗'$JMGq BB__+ȑ9;'u EsUQDyέ]VwhJ5ך~hkPY PitF ΜxoPC Ϝc%L3yQޘk-7Cc`WYa#V >ْJrk3\Tt_<t! rzD\V,#vÀͲT l_ߦTH o&'{BoA,Tn؀}TPjпޓL@Ң.<|ʲdtcӹlPHp.<(@I:e Q>rd"&͍Nцaϛ9ƶIu)0>E/؊'!إJ9h`Ԯ/DLyĠO;Ê聧uȶ;efJzbη2[6Kr<( BM$0㿩Q;jXXhϏhnܾkp 8엹h"7LzJ8Fj j 6K q'q[cTJoEb5̓ymԻnEp 8x"=OCr5rK/", mҜIC|;4:J0SV">5xt5ܹ0fi WFcagvF4#[GAaetnQ63BVH85{c_ T;wɅ_K/Ey5ֽ)H,XLJ:τ@6۔5duV~!HU6[(Ƽlp`fy'vAEe߈1wݸy3}rq]g>y2 ect=R}Λ@WD,hαͮ)>nTo]'$䘅_]~ͩ]'U^]}Uv0n-4Yj(a\#93QVP:w?12{!@D\pֽ|0 {t:n#8^:)<"vv{\Ӻۜ:p{R˅D^5&K0O!uwoj,\1܇)p,̑XUːw¨"\7;ڻsQ 54<5@տPlR52fm;gw~J:f&b'˸xi4ɣ :#X^璄?7]ZI~ 2Z]!,a|Q/:z@{~~ue9=e¡9(䏦Lkشƾm%oq; endstream endobj 2456 0 obj << /Length 3693 /Filter /FlateDecode >> stream xڥZYo~_!Cv(G3k X![Z<&]늊G۾XznPȒv=Bfڳ:pI@9mc[|o_ӐԏI߮7&zoNiN*S="Ij :F+t@.%-wusY82F[wG} ӟK0s px0p%eK!:2PHwklꡒm  %ϞcaQg8MS cCz9J38G{uQe=VdM6*;2U VT4Q#7" "$je:Ni3NtK7i:O`,P[=b_L Gƭ;7B< |VUP: "ۣLa5%cyBPSbUh)UȃS<*8Rre ]4ל@b.8ĹdpPIX 9yfzC iQp<+8 D2~ m&jZL ,pYehCۀGc`ģd ,KL,yM6jӚ8kn%)3  & @pye*sCمd,EJnxh#KdrSZ~rJCxX+Tb-_tERmI5NA[rX(LNUn@Á;L/>L9掴F:T sJПVD}Ϥ K? PCYM~}+C~^whv){Ҿ7>leKhAEB'Ba|U ,-{R<о%\}ceEtyVig6w.}Ud`A6]PJzЍ:M[+`!簺_'OP7$D endstream endobj 2337 0 obj << /Type /ObjStm /N 100 /First 995 /Length 2711 /Filter /FlateDecode >> stream xZKsFW:d0GJImW9MV B$AChATjQZ+&F0" (f78"0$뉰,&+6*2)=d5(*ФMs`tB2 @9F`lҋgI!5`Bvr<5u0; A+ OE$EpS$(|} \SJ|xTj;>f+xDxzV<KkЃZ=kjF ;qyEzQGTꎝ⏓Wx_؇_/k4x y xIGz,۪^V' ;xC>Xl1l=?,:wˏ]z~3/v\irx]<%*F.P[y'c/'۳9og%_'G$#'2Ͽᄻ^dtZ[R6[pp)TXf̐ s]#&DJnr>^Hry-Mn:."H+Eަ9#kix[Ḟ1$[(U7iŻo_߳\X?泺+Ϛ˶7VM{~􍊭O7:So@1|~c[fi*XG:aֱ%9M1hCޯ7R"v3r#={Q`lm$ہ|ʮFM# ~b{~R:?`P@%U D\$ fge4Brd< Ö^rUY(G-6,OOh̿ŶC$= sf~$(c6e|9lk$Ex1\1"nPK2ޓٳPZT0ŋ:|xgI7E[K[^^L}].]eUjhVC?qz)G)(\Iů&U9*6d~ǜ9xL;&>-^|Ic:jyL?z⟓br|29; R)lM ?˦Y],&y[^EY-&mM/E7bVV-c[U% XL+볢E˘Nˋli漙ןz;y1h;9ǟ$L󽞥 1R8s6!,U >!qED Pc9c9f]!323a2a3ahQ `cM0?A9Hl5sC;*rdvʀR3֐G B 5m'.0z%RAJI;䔦V<\iik-WEP3ăSdi#={t 88pZU>\bbWͬ|5c1TT;愸dD lg=4c̈adv1 .rd͇g81t9|: ȉisI$|܏p|HJ"PBqJDȄcdcQOg͸h$Aȵ r[fnЂcn ] tmke<* f⿧ q{0r X:Q2-񷧕;{r$DooTt+l2?㟽yj9Ol=ar 49M&BWŵgEÝ98)TQ 8rXsf4nYTChix th# tE Q LGFl׳.݈EXeW/ܪ,$2Ae}*ō4OÆ5ZC1;(oZE tƄlAWy\{`tYbM.gFpt71Gkrư`*me%tr^Ur,wB{ wrnr_"B endstream endobj 2473 0 obj << /Length 2662 /Filter /FlateDecode >> stream xڥn}@BbE"%J/]ltZc5J3هeq2C/t4EG̊0n׳8BYǡv5%V}\}i>٠ fEjl2Dz 0-BeIˉnش~FidY7\CËgp.* "ٮMCC6p`X:l|aLn* -m6rC5l,8Ya>Crz"h iHT2rTa^}S"'W2 MUnp2*uyt=ØZǸv 1ϭ>x<v:a%x,qf= A7mf/81_JUwH (5v9X ,I=0!{]0 K$4ٞ L礆"B~|Mh cغ~Pi , 'lLL8v5.`׹UUqXF ݄:fU5w4!'ܲW z75ڟָ,+0sn;p< $/S { A:sJ#zMf^"zѭ0S[!㯿,6ǭtp`c g/haȂ Niu w;iP]"T+!kT,vvr}UK9=E#F]kggh{w?d:}ph]+#5˷ 硪eCl(|&D2"ۗõA1e{ w7#=]k-Jr%8Y٥KTvk٢tX'+9~ꀩqp4ղKpDh?[]w`Vh^]y9t4w[nHcuŠWWN0>yY`V']MRSN)a,&  M;A'lO}Vcf#⏙GQlNJSc3 33]/i*3Ro} u%9|s2W0c߹r֤c^A%g_z &f+;5NК9PORdtUI6x1=c!z+̳Z!oK,TIo̦7ZB|{KY+x!an.@Gu%P݇i64Z@ _3_y->WxMۊֿ $ RHq彬RYH ]Vu5<&vL_,t8]xJL"ZC40uΰw{ -X6vŲ QvjK:F6uFçx7'*tt<$ }Sw/KyҾ9"HĉNP(B;.Lh"犉&t 1MG$Q*L%Z {!Q@ƙIl.@UQ~5 5<2D#1Ȉ"3Y tiA!rS4:ICePQ8 h*,,=9S$󳧃[!*b]tmsE]*J0ʱ k*Ʈho-/}'#\,c 4v"g=Ozh` U0D 9I1IhR1rwc_ G1Cʕ> stream xZMs6WTy(|MVrDz,%9{f "9_n|Pf* lׯ1&W݋?@*g%$Y~ )MsΗ%4/f9?99F\TYV/:4}AϹ9ݣu`$K.4^yҷQ4m=ɽ/k43*[Gս{hԝnogL$eo _ 'Mwmܭo,MWpSyh{ԭ3u-LجMtJiYNw,t4ޮOfwZ:m}[צrQelj]镮{ûlHR9h!2݋'| 뾜MyqqVW|B&Hut˦"hR6ur ZX0s4g6ťbԹs.jeEp>rXJr6w,}ڴW?>_wa6m5]JT&YZh'K.KNRwťJ)U8vCOBmg9/벺 ۇ<OeY |lx5 ظnRf/<`O$e*@J`шe[~M_@末Tӓl b7=32SF_?;_>z S_lgd5l魩*/',#{>R*jr㕹AZ֕nl<mP7Qqk)ȢY(7+KSaK8"ꪴFw] 3YB"Ւ06VU3[kB-c@}0ŀ2" M7ye:oKPQr3#HJPCFժ8M]? *΍`upo 趹ҵ6{V #s;m\zE3D:b8ARA? &]ISM&` Taכl6Aֲ5g:dHv&$w}.8.oe،P\Ir+O\}5cP\u xo\%L|i9AmTRߕRWqDP*|O o![Xz""4c1asb\A#~',( yO|՛yzO*]Z΁ k{P:gE 0@Zy ,>s foZ[)`u[.Z~|=V^15`6^ހzFͅ=A zu Ιǥu՘~@}8N8lT EᄂZDnW#Yz"sw]Ëɇ^k(xX,@1g_xFk(8O|夝%DeTek Qϡۖ-oVemm_Fwd}/2boiOXe(?Zyl{K`2,xbMn49񿶁FHoVUJĚCCS8Ѹt{6ZZPaO~QY(!ACiV<{vY% ؏Ʊ.o k'GQ(@U{MWYGeOV)wq* JdTN1zhJx2$" (Xe'j=e!CU80rynM=@]vMN15]KH) (Q{Su?ʦ=,rK_.%ǚgi Dxh~w2B|Þ\;Z `hb8ǰr s-> stream xڝW[o6~҇HXŐ$JC3ےņaI=}%VK"r) |"l,l}Xr8 }+FqMfCB[7uku* TQSrdz G8Sr.n."!c(/JaSqdmA S zxaBCFO0O?d<&x(qH`s\/vZCjDu.un1Gk|C\B}!AC>k*6͌i2c7^ UʁN6gqc(;h_FǠ=Qԫ<҉"_{CzvgzxƬUNR0v"KJҷQ끔wF^*O%5L?4= >ya#U/~}"{/@A:X{FnU۴?m[4 Ïw̡=@ U`s%2)D!>!*8q)'x`MU7_*!}J()c2/pWxhA+ԕnyʩM* OA20nhGY2ȣj,wX73@n @-f9` K'i3gH8~dY4=Dm: 9(kۢ;LCc:E|xhxH_CLf,6p9b@*ҽ|E"z==F"yWw^ 4qhgJur3^E mΓ{ˌhMdE e.[]xC3UҊ̇=+/`AY<CS(V`u*CNz@I+ /y)D{|c3>SBbH f$6ukI4@T!SRwǛQ\AvàZѫ޹CRoPݦnMo JL/ϓ\ ݜ-Րf&`"E,>jHV:+m]#nRקM, Lkȁb,RhHKrȻAss7Y heGQ3O8n'=Y3 endstream endobj 2507 0 obj << /Length 1850 /Filter /FlateDecode >> stream xXKs6Wp>IIӦrJ2eTlw R(ә'ĝÝ_g,g/B$,Y^9s "?q1^}~V?X dZ[dq{ y#zQ Il3;9,u`)΍a8>Krg/k4(NJ3R]x,>撻f_u5_x!wsAUlnIٮ*Έ/#8B1{ dx^X +ꯔΚbk=TxY"]UnkfiѰ޵4N`S[ hreT#y~֓XLA|8*8I+0?a2eÈEI,:]IC>Wyxࠟxo!.c 僌Dӧqw:q,{??-5$c" X ǴUi֞_j㶬X&+<›zJXڦ.'0^tO)A\L@gqjFQ[A wUt =#@z- OL~ ^28erjb=<VCԱ${LY,- '&\zꎈ7 _5kN2Spmm0°weN㕢/Bt)0HEDžú8t\]ߤگ2'^9 {/軌d^*E/T>;nƥ tUk\c# ZmV'z05LmnB%Uu;}]Tkt:iFoг`j0v4:|䏣j#ÓFug΋Uő ^L |F W{F|JQ b,-5Jh*xn]֚ dVGic ErRE!B_ݿ^Jo:ܸ1,U^dJ65Z@ #Ccx\ٵ5 "Ya y>_opR]|PYܠwNpLU.@CpnGGp>ۄ b} 4 Qq:zyGՏ)>"фP D@ˁqۖ)@m'O- E<ؖm]-)7x \=Zx[[ơ ܅O`}67S_|@ 8IIfa&5ͩ ИMm"קGLnk麇 DYs i ?&ft 8<<>˦nP76*U0ŞMi&uZ)ldSg$bơUgwwx= a R9;b]ۘ`'SHaS¥ez8?i] QE;n z H6aiK !/FyKlkLq}[7_7oJW.w=b/ ypRw=`!#nHaF>_MFqZg "IrCu^4O&d,^Ae endstream endobj 2515 0 obj << /Length 3481 /Filter /FlateDecode >> stream xڥZY~_1KLRw?x I u3C[jίO(Qxἴ(xww<*WÝ"N2ΓWty0}/e7 *ΒB"++퓢{Udun,:w> h'lǮ^cGOhh;h:l4Ǻnhn⯇?iyv 0gO<lNs|<~0_x81̪Y" `*yE7q'Ee_&}@cfq:McpBHN| Zj_nj2e8֜ݥ띤Oh4glѵ45Н@;j GF*gR04pLZP )|wSR%*7xԨן^qQÇs I ha;y8OW? VJ<ޜ hA*h4`,vJD:rǦI7Ҝ:Ӏ Xr-%]v/&lS Ʊ9-I$J$%;́.O 31`Oc4!ߚG>z}HV9  @ɌOIhq6!^{1L 2~VDt?XT˥IOPW+ nyTBA416C[};* Ѽv?ΔTbh%}JYtGBcc IgRwo}(@")Xm&1:!@t5FTU(%{.J.c1ߓ%zVr9䍐p2R|v%ܗ6+_Nz=nn b#W2b~.6Bj:B2vێK9EJb ?akU!U9s*InpٝB?#JU'\H{pU:&BR4$8sX!p@h zP7Ge\0Ɨ3^%RLWr}t.ZcFTk]k)WQ0Z z,<͙];Th( >+'`]!E!6<;/lC- =M ,Bݰ爅YQkƁ+'*R:V89ғbFh{ ,z_ zɅ/br'|@8~> ?ے5uWU3+)R=sVRXh1kKw~k?쩸&xENtm4Q5Kc|TPәmQ0\6 >mkN>ش&:$VTm|pI#6Afa)$|^ + I)ȠFKCAW: ʵn}a޿ϔgӚN4~C&>U\? Ph\u5wU7e{D*+9ϊ;]x1j.f\t?Pcòe%`̏9k`A>L}~\+}Ybu1d}ӵȘFGcWwq x d!Q-L2e"P$BI ХS;Tա࡙<zoޓKfR8@-U9a.@p̒F Wx0y=-e6У9uWte:ۼ&;M' wCT,mΙm/*Z4??LAjs4I,g1q&[3]1TBĕ:yg 3'};L? QJ'ݑ`  o2Dk *J,T>jmNM9'{"xNzEʻo {; p.`A|K\ܒŇM@ܖk i&$^ _bژjN;UY4AAgӺA/?Y,ϩ4SYmؽoxG'87>LY0k_89 endstream endobj 2526 0 obj << /Length 2823 /Filter /FlateDecode >> stream xYmo~bQR pMsM\KC]VD ԛ}€Rp^śM_x&69˵Л c&ޤ3-q}S^jTFnٴ3å/bK'{JH6;MN݊8r]۝HzvxIԴMsp+wms4-=bqt!n@I% <~4q_vw4Qc-'w,'5XiQ 4!3!Zu9.2c"|4]QVal2 qA*p'ګa H8/ G2=m[#M7}GT 5N~|> E}A+8m6 ] []mU]Mͥ+:kŋ ^x 湴 7ϙKoΤUoV}k¨ǜiЧ{5ȕ|ylůrg&w-O/- JTm9jjݺo鹣 PUEԦ']f>ŔA`[CQ=ZfZ)t49 [3(Gy@߽= 3jNuGȕͳ-Kp_u3?p6"+Rq,%XKe7}ϼ !k߽%@Ѡzt3{BM^ kmfGn-o|4%OgNEciJ $ ,r>*δ,-"WbcD7=A(| oJ^HK!/ rN]`󙄪FJ/TU> B^ J6'@>ʜP/x@Jgc34':j+6#Su["szK'coLq[>&;z$:R{JzRIgy1%HI]&)KevwzJŇ2> :tP^H(V7M /z/ $t.Ӧ.lP5d@ *R2*5bw+L%KUƊ9ED>L0^BOgnp~Batњ_UbuFZ T Ŷ]Mup"E"v "q>NhWL 9ij BǫG3}TʏuF&x@ɧ~KK#=SQU_xy"RyC O0xHHa| wwYtn-) 骣^ΖGs 5ZYT$q 2^k.t ;%d&3=Qnr,H <1j?v%&xր̕ aZbY(mAs+ǎR(>_આ(:h[սknD X @I'fCɩ`VO'q rɌә|t,gn(`+S=%@S2f)h4&3os GbU, .[81ڛ@rX $LJ"]<9?]#i h$y<.G,eq-A?#lCYtkcyBH`bѵF"b2[]ٺ+J~#(e0\8!O -8!M~{O7P%腐& ^}i&_Q]v^>H wQ_j$LcL ^-4*td[gE2Lr6I"%fBN`h0F냓[z(xԡ5÷#z,#ƻ֜#mͅ%5>daI-]oC$iTXi)Œe㇜_ K!.F 0@i]u$2f#6`'cdLLeܚCi ¤/Ha\UAvUjjec*x7Q(e7V`0 ao?Aͱ95k?ҷ#V8諎P1]t#nL_q4 "y'b3q@(Ud߷x|,Eh ^՟*QDB s2G4z;|Dz ᚯ==Ǟś|Æ)osE}}t,K묥ǻ> stream xڝX{oF?BHD}\2h\&lC}PJbJ*O3;KTM d7/>y}M/b2\\osp`7`}ך]ś }8, pwbtd VRG3rue^nq)UIWj4aHtedDO~_ ]㨪cX+^ٕ"DKҕy]UDs}鞞-WAxtqf6Ps ?TP W::k+t$M:I"x5 G4m+D$!}{?$./߲[C?d0cW!S`פtL0'Ce_~'JNEEY{yb |Mž?5iZ{uLcRQo= P0Bjx4Ys״|;Ҁ^pvf!^*ۺ*f]R/Em)|g@rv"oZmRt+nb9;D!L4`ޫ_d_q//ۥ 'NwTAobm#Hꪢ2 [g]R{I2zy J揯dOC`{W2XObe&{= vj hjQZdK}Φ2o&InNYx+ c{iB^ghY8Youn3o4}g LDrP@$X)@L@X,OS ~p,O(D-Lz#w0d2ك͊H6\DDLLFqKRsBu>QO*:ߴÖ#dM 唄,OYpRA5 DGTpg !b%sAįH5P DNHlq*6%=u MkIgpK!Lxw޴ ա>eU;qĴ"Mi.m{h^\\ݱsnr.d4ߣ7٪(IYb'&^1!p{Y /(? 4D.?jϯK!>ψ$/c_XCRi%|4Z%eRq 뼂OC\BfPbWMh%o 5@q{TdUgV  K8Lh*݈~[UFd-搐ّ<D:`p ԸHnӖx"hŁ._1x J6fTR,b:Md{ *{@`lPLC Z oy]=^#ez Us?]?4#ؽro;}pݟ [A+ljG2J0wY:?K(Gך1\0}jcR=DŽ9C^,L׼ v{&t J pX;Lw|s,}Cz%BXpg~g]J7vEBWwsQ l<Wl͜!0GC{NRuui5xd-Y@WզΗ*ӘG]5 48s ʯ; 4얫\͆R yX8/7*T窟})n\@X/Fs@&6@jM(ILZ;N|؝C2RC`,ɽ(7$c d]}[iǂUUHmH6jÑ"~zNgY]A N=ڧh6v_G9 \^jT>N?TRUJWp*(?9T1G!5#56p bR:){T)`6`CddGPp[e!h\l1diXbِ7}.zZdʹj }z}T* Gcm=¾֐> d sM,=iT{ AW 4?GqKUk)O0sNG W4ܵ- [I0qG8S RB|ߨovJ6vwn0x.}NOjfM6/Ll8+HH4m^>D=&?&݀~O⁖tnB{{pw>{ ;u_vEZՖ&TACUS,n5ݰM<x9Hj pnaho˧OKjj l*_2X~[[9{遚u.Yq[O swm~l-cUw勹'17rK{C5e/\H (~段nb4p|y{OdN endstream endobj 2548 0 obj << /Length 1406 /Filter /FlateDecode >> stream xڝWKs6Wpiuh'q8$3IBC Hr]EJbwe5 ?Ȍr!.!2^Nvi_VV;aUY<~Xi8EZ|kޠ~I8H`9o3B4tSE[h\W~ jBЬDnHmtN9bJay QTi录gEO8/xܯ/i&wz2ɬ?^ʜܢĐVe-|%/3~]Eq'ds0t %r2}hrlH4Ֆ=A-ȟY!5Ş]Sc^{v qL?l`iHX5kW慍L\.Dc_h"søK/R|cʎ,*|啇w톗:vb(cU)("q(U \D~phOŎs,(FЄq80 2z*{.#0@5DrF_Idga-JL8@Oԛx;{-.y5!~i("8LjR EvpS꧗:"\]Rpoa)L nuqGpx*Vkw[ʚ ̃ѐ’I\[%!L|˜|B)Vc4 {Ĩ7 6V+Ṇɱj endstream endobj 2560 0 obj << /Length 2310 /Filter /FlateDecode >> stream x˒_%T C|&q*uݩMU(hF|}P;$6~?0jW?݇8\e"e߭*WIXerw SsEt!J'T$ˀ&IH|{F%)_ꪙ+EJwe?Vz#cjzq@K]GX 'v*2jKiDE0i,f۾Y6,ɇ>i`n.\VM$x1TC E3/XX<0g~'&/X9vU>V[H9y߁ra;Ğo CqhWM3Bޖ +Lhڲj  Rc1%epX"]DF}74ty^usDdR/AOnd+v{W a2k'YSt?T YO>^T<ZJ t񸐵Lrrv]ƪ DP[ûld^kh`㏜FTr٘PdwM~Y)K(y)ڼyqlʆK-`'\y4*;׭joӱA`5L]p5oN_/_-MP8/$@vUD^E< PH|}R&sR-SrT`Q8^;b"[m\s# X9øTf2Hg; T.)ai%ߐ ]&PܸxzTE_>aרqlbAviFCK`|w>4ep}F\"y@<x tRIzk)P <Ժ4O7TBh򲲭uBnB-ơaڰQb5&Ͱh0,#~١}q2|o[Z_<쵥DznYY@4C?|ZP Զ``p5>ww>u<(榔'Aaf0iɽWǼ9ֺb\0_/c Mw5hտc߫tqI/=dX$|X!+mj_!P nק0?ݝg(ࣼ7!s[* |beG mBJ=d,d sv3my*xPI2![Sܰ|ȾR@x ^[g0/A`N'Td)-9Yt~ )ܳ'*K'M/8)cFVy}>%Xp:LsJS܁i_^<*FĎ endstream endobj 2459 0 obj << /Type /ObjStm /N 100 /First 986 /Length 2424 /Filter /FlateDecode >> stream xZmo_@@6@ 5NjG;}fɣDѴNIMCrvyyfsYeEpbYog'UɕX!l` Y,+zH^Q^(c$ cE0$F`$sD(2B )f, s*&ˉ!ySl326b%yŞeL2GTʳ8#Cc2|b!a5VRr @tA] Kʘ/#`7@E k)SHPv G.b$ƾ^;kd\20vL a0ykT. sb|.gCE0^775KU_RVm] YQɂ,|\/Vɧ|jc*k%1[\1/0qIҵ`;BtB:q;!tB g=+HM*AHcA;5cc4clĨ)v'Ƅs^IeGNON 鸽jf՛g?]Gu|=o t3X]ƟOތf_Ɨ/ ~x±@Bh$)=/_@h eet#E}Ϩy` rglptlw]8~. p8{8{8{8{ʏa80_G yeM/y Yr~4M>-Gxf '鐄e3,rɠb3(YhDMqqնR^>RmMJ|mg5fо޸=Fozk;灻/}km_VS ѣ7q'9_Ni<^N(%]Is4ѹ|o^!9iD&rS't/nMh#E6&b::O e}>3|=zvjAk(*k!k:1%6#AH%HdZrOIav:os\Z}]ϧ˶^O{9\.2X}M}񴨌^N (B F k;@K9K K{ÃCμb62H._y`# 4{X!8kyָX.E{p_8K}[yꮩ6zYf\%zju}V*C\v uq*'9Xg΄rG`~_[N;/roߵn+o?ʆ>L}mL:DM9aus̮#q ߽#/^a9m:4Z@rhj ^TN"z+ BmN`p8y' ꅼH <Ӂ_7(([mȗ_F\ 8J9QN7<45r endstream endobj 2571 0 obj << /Length 1559 /Filter /FlateDecode >> stream xڝXێ6}Wއx(Q~HME)IZm&k}78+"9ggFv:>^#$ġu~4=CGs#!i(U4yh79O81Z ]q"Mˁta7~FќrËj͢G dJ!h΢ 5_ ALɉXcS΋Ŕ@PfOE,]D.-c/ϟ5gǵ^ |W3VΗM2x,]mfwgI(r_]'Ҟ'5p(;g^T8 >;z9!$I矬Wbί얯t7u_!?NљGWP+2izwgˡ2$ pm& q g@j(-}tǮI/:noGS@u̲Yw4S-@$L,!lCŝVI ;$k\=kpHk//ֶ鯲MxaOmSk\p#c\'% Y?kԌ~Nh:d[trBVe1XCM}빋][\\&RA=c{^N!'ūC0N6 %3 ězEJ"ᐥ`$K%"^tOk62qb, j)9v`)ߞ̠*aڱ椇L7^Rw⎫ TpF:;s ,ϪA?wY;xr%M𜏐.^Pۏ)=' PڲOTK?O ^ӊلӗ9gK1@</ĩTlx 8,ޞ 6$ DT$t]"48H|,~ dhDD S :^[-0ZTc,hڬ.8`AІ &p #nQ9gӴ^ J̈o!ڍ`"*e.0O$֙֏6H<͓\[s)\J(mI9B9C O%J endstream endobj 2584 0 obj << /Length 2205 /Filter /FlateDecode >> stream xYKБZrTͣ=vDRBRߧ]όkx4in>4J7Ǎ@&"Hey|rʗYnQu3[*K"N2ԺU֏WS{퉦MR(aOј>v0 k&׏a8ZZAEvRЩH[K|Coר'`/*[RLeB@HV! MNވ)n[RӸ9{OR6߱SҀUa>,z":d噑 (rh,CuחF0dp=iNX3wl4_ qr@ϙ3JYTLB=JBj健ôEɡJƻ*99m%Ta;m 03Ap/ nW$QPQ7?*vJpdz.+ endstream endobj 2595 0 obj << /Length 1629 /Filter /FlateDecode >> stream xڝYs8="SfiItS([6 JֱeÎCb} wc<~3z.`УxxcxX&fQB Jۨ3TDa i>>ښȒoy9!~NO(`zpݦdJj]!?لX ۔<1'WgCޯ'k-Ҽe߱ +u _GvXoWoT2ٕ쐤6N!czSl5%e1SEZyZ=L<N zNAԣO\pVNlߊ&ĵbkW JXhb}B6 H׍ 4$@+-uYS| /.Au}6:Y\(w3+ݔb+w B2jB䟉GIa5Z'!^.6:|'A|k+6e9Js}ԟJX-J}z`-AO['Mkut ldxL^*V2'}^l{ |P@w7@#Ti ١>37n@wP]M 7\mvȔWc}(b. m;VV`j2[dƆwSL$Jor\.P  | -8\il(n5;ۉt `EAP&pu"bU*ƘZ_Ë^|,9t " Gj,$ 3gNAc 6,zif+uHD1a0cK˥;}OήiZRֈH!TYmCe)rs\oTrV4?Ui?Rx&VrhZ?dOAH\hZϞ=L :ˢ:SmVרU 50kLV*䑐ҵ;VTj`H ܘUꏩr!1L%]/ tRI:E> stream xڵZYF~_!X6vYd`E$)rcߪn^.Wuuqa~mV KB+LpqBwOCQ,/?d)e]Ǜ MIȢ$$%8Ʒ{h4zoDDIk{˶L?J9;^mx˜B{9B1|[gmiY'EIʮC^ 'D &D/jۦywc-Uh6\EuȳXod §3=ڎ8jj|]K顬6"4Ǫ+vj?+{DYHzeB?.(CS=9%2FZ4MC5<\Uӻ<zfbcjqu3 1ώDq6A‚(JL}\c#A2wZSߟ4@h^ 2liK eZ7U˃X&Ltˠz~\J?$T@P =J~}~H54"m@tP4=c-`s Aolnn BPX(AHH @gO0DPUpN `Q r/d)&2@`3Q€#Tw`G)U-t::FH+5Hyg:p p:ԖfdD$sla,Y){Ds'fs^h"r$.59^DԌ4z1#QLQͫ.co5T%=Sz/v"pv>x{Bs{Zk/}*`˔>!+"^ZK9/exueSCCrG*SiW[ ^DSujΨ)-ks/ȶdZV[6hyDΥC߷M-o qQ %Nnnw; 4+O7).dE Mr,тPHMN(C&ډeX<-.0#m8%+ӫ 9Xؘ4;aD]l&ZB'tyi]5"t3 n):+~Ğk97oJm6ThNOc,Sb}2] ~1T_eV\l="di[Z= Sr}& 1D}9k]!X鍊^pWz=X}3BQִL.QS7.tRR=Q |9}* 8O x8[2<~/k|]dv8_ W\0ZdSD-,L}hT4E26`*+BnO&,FOY )<"py;Xľ.uޞ;>c*Eɩ8X30fL0MRD0kONw@0ۧV2θ_ Yc,J EEY~\.&W|zifS,z9TO}1_@yvp>aN)!ڄp&Gهi!BP׈+^Rb->#%ٔ+Ͼf|ՑO-uEH F 14̀<_W=.vTd#^@U' 3E]!&gQE*U 9lj&Ø9o7U/_mv endstream endobj 2613 0 obj << /Length 2226 /Filter /FlateDecode >> stream xڭXݏ¸C ]sI [r+4 h>mN\Zgп3A^l~g~P|__}C(_w+9 ZEB0$|'bw, dP TֆϜ9 􊻳7YjG0}?^ 9zCRCziٹ2m"90V$W~oB@+ʈ$q=, XBLbq$>-2ȉAkfhİ9B&L5D4J>j-Bۇo?{G I%?z"2{xEvfhl(/us u2EZm9F'6〝zG+A:mE:Wy['6Zc8 dEV U(Gv&`T >{br 4n-v{}r_Ư<ֹӗ ~h^t}e@]K#nZTK5i-P6O.^8F"BDZC֕AV`;`M-eQ閭7O8yi%ָHPhC$Mi*-gZԚ&/~f*Xwi`_5 jL3 4&ţN)]`WdHe3朅вjh aSc|53h F@/TX]L{( v8!79P\bL, kvXPsO #Q0*0FkR2>fPqRΈA742R/l%@1e?*>tS̶ +1q U g]ƒQIKFd##ȗ(8 g xB J9XY`I՞te,cøptY{F ʖ 8bP.~P%ӐU=f<6f~8L}L ) m(vC) ت+g+$ Y9`U;ֹ.i s1ҙlr<@YKrr2&eҋ'@\J(dC-yXe>n-073Di * /;ԭ\"ˋ> u[5N&]-L6cJb4.Bcu=,rnT c]/ N:ۺi],ֺ/,MEXTD/7,r܀ >3!\u.6a)ܚh41\Z ,&ޮaC>i,|KO,I9)?cУޚX٦nA9?mz&75_H!5>݌9_ޞgKXÛěu ITH{ X%c<ߖQlys(yqˌ%F23=]`^.?$\704ㄚp<^ʒ Ջ[7fk#'yޙ3<Ka;b`)!jA8@n|S%c@73Ds& -0@*n?-{bN߈@2WO>j/ծ' wU{[p{FpO׽E*ΔM8*t64BA[Fepʣ]Eܺ7+2hBsKY헞bll᣻.;s|{i*] ^M9څY΋Acg UybE'8"LͰ?0ʧ2|^˕>&1MQw$KH$B N a:lPm+=`!I֛7oD+STeFS\ ORm^P '0<탺%=9VX kl2rs;3u-*wƹzf>&>\?]+JonIYMJVm[݀d\_t%>,cp/; m ) kTsL7 lYhy+xK ǎe8=͕ }Xz|*z8\LoOeC]yϳnл_/x馧3w6~N0~v(??1TI endstream endobj 2626 0 obj << /Length 1776 /Filter /FlateDecode >> stream xXKo8W6P3|yȡM(IOdJGdV"r8|| fס%( iݭ=1b~E%]}Jѡom*E}],޽l(JX[#1J3lf̋A%b~qzv 0V]^j$׫+P]~=2ŔxY5{9 `({Zy>X ڥw;|UF">B$y_#W EILD/,X?n+r^F7F|\}Y>O^eyM0%K@mcl/$cG~י?c7+Ӷdt d|uW N|3s۽>E&Ibpܦ>i SkM[^129r "o&+GbY3% !_&bWKM3-w[۾ͭ>ȬuW On3u̴u8d&^Dߍz _z9ۢ{лcנ)KlMȿmwIL/3i-}ϗKu!d!Ӏh|E4Ïw͂xmBD3u0B 8N 'ډ!B;GI{E5'?{ƳOG1)}Ō8+̏.Io* ~OJi xsA9Vvi"|gA ErɿRd\XQJ)d4QLBFۭ\\q-1>ϟ1N;\*HH<B=)Ғ` 2 CO|ȆڰO/"Y%r^Kr~: TKtUc@p )44.o>`)6E$cC$[:r񙚛Dh!ۮ{+5DU֌?ҝ@q"Td.Xs%MNr9}*/ %f0&R!d(q ( w# Z6 C)`FFw*)? nb Mp0#.p x8$ N.rSR@KʠJkU0eVJe PĦvLfQ4A"a2Ŷf(eixp=vi`=)5e(Zڞ>bM΂H0[0_QUt6d$nW+m؉b7,Ϻs=$>O;~t?$jЭ3k*]%TZv7*m`HcKHGp  "xU^ɫn6iYFT-b_c.qØ4ie6/ Kdش}jdOFϱa:Uv 3Zlm>IK(RژJqpXULp]XNi \^ˮIvexMs8b,b"kJ&P07j[bmcǠptZkEݗ,5$toC9WT;oT+vaCq0o3"p>d%t()5)r駽3]7573HQQ58%Sx!a\AbWxKNzd7-S{,WeϏ߫?ٰ[ endstream endobj 2637 0 obj << /Length 2590 /Filter /FlateDecode >> stream xڝ˒>_᣻jE=S5d'UeL@mhw?>)-6(8<62JM.Tyl6"~>|ʒSlq6h;R[{">ԌNEQ9x{iI?T^l}UJ;H`4{t[ۖv53}dzsa?ڳ]U}›;k,1'h۴h{{}0u;XZp݈fd&"!^7;^ Fٖv =?_+kPj펴Wn!DQZ|w8SRp;ߺp)8_dEٻ8U]6É _d}Ϭvf=ﴗjhoW#:LcСL,IAW]g:mKg=m]ivZͳ@Kf*%if Kxf[ Cڳ] =>/|Yŝ^tZn3!͌t  ^G 5{k);`O+C@ǽ-= ϡ;9sZ7)OPI,v阪h+o[DQ|Out6GEyܶ3jgK}:i3=Tq(fwۓy.@< h! eT9a-n'YÄퟫZQ]3N"xggBWQ%J>m/D(.r28~_q R,%-+W2!TgXj秕 4p)cI ˢFK,GQ[WO]+kD﫮ti|}Q0` u)wm>ZUb4l?YڠȉԺB}!BI?iک5domEEwIqR`mby9Nm\]&Ͻdg\b LW.?FJM^Mλ~uK5(# wS&WY ,2-'gRwMp!Ċ+XvF{1B>RBՃCJD٨CV%ʻA3J<(M2cwuՆrއͣҡ׿@({TG"8I2A\!>$X@hc=8@r۫sI!A1@}3",Cn%×"6(O?gLF(F[cBq ":nUapzWCPLi6*.G*4pisۭqEdWL":@lih4|hpKjvs摝!EwA`D+(!(~3JZJ. B `EӮ>[;e <\i YW 2'qp޽q8,Ξeq}ŮtPGCkW?_ـAť@\·@ss'( -{HD2B56i,t*!K%tmŷ iȲ.w m5]B9 Vta9w,V >Vti_Z?4~iL[ɝm9/^{-l9K(Y z!E[],O@]"K6&;Un"Bbj e 5JEzըwXIu7G%WQ"vhǟ̊#TaGf(]QnL+IQh Ds%4g}gB .b({syaJ*7fN@G~&`h9`5wM76cglv3c^~]R ːrYLݪyC̺u+#0vC r1Vr6 M? -llETphd86\IE7|9J0#lm5 bp~xy]w!V ?͠.Bj %M&qtTCYLB-T qa:*M3y5M_&$gHFCԑޓpqV/yl`lU;̺ˡI~iy[GjXdK\?0+E@+D$zi۳,&8ҷe }|ox3UBj}s&`*3y/!SP"‰'3;UU>NlZ%Kfg<,q 0 u_z-r]7 02{tHJ?ynpp endstream endobj 2643 0 obj << /Length 1241 /Filter /FlateDecode >> stream xڭWr6+4񆚊Oiq2E..@P%;~{/(Rs(oy7.nh< b9=Q2J}%a>ZTOζfm ߴ㬷:9,Tn<fn7 R ͢wsZf{'Az x( }q9^Ʊ s()ײ-ᦂ0!]ˆHdr1 B)LFNr+~cza:rd !MIrNA9y90a9=>t%0kTqrq'H*ژy\&E+^d!9ۇ vX!Öjpc[(c3AbI-q:d@i.oF&@\ P셊$Ѐޢ^-DS11 Y/B&z>׏A$PX1Ղ jEICVmΕN X7\}> j,̳K2@ XQ"?=`:s q!䔻G#`3@:P˶VךLSն@L6n*qNΟ>|K(tw\M[4޺I¡4!Xo&6)-[Igqd3rYB386.Y.զ H=q\6a?ԇuߙ%~?l:i-<"YIA0j ҁf6-pMwM.RorZkb W5V6,+n-ȥ|H-8 =Z\᮱*n!CSanQ5 ekH#|:f|{hX]ӦSAW2hwV*Y¬}5LBTsvVɆ>j8 `8 VǸ8 Pl+rf۶a U>̯9Sg b;&}-|)>-A!,+7ZZ)Jgp'{k)鴶 ¹v&92BLm@FE̯H7rWZ MoPs/nנ> 8zƌ$nf}Eۿr/л_ endstream endobj 2652 0 obj << /Length 1436 /Filter /FlateDecode >> stream xX[o6~ڇ@͈DR6Cnm!,Ѷ]\]f~ɒI0 s9o?pB2œ1b4t։sb/?ߝ_0prH }萕 H\xsp/y؉'I`;pd:)ЙsxߋZJc1;,($ᘠPΚrEY621 q$ 篛dZ~8MlLl(Jq,FW8+,PE[nm iJzKkؚ5΢6{RDEg!3st6/f2$a)gQdic"J0*FRwY]*']QQbC8)3'?NAaϗKjBZҊĔ3G#uv63(w ZG>@`)} ϊ˟._[BN`%E!Od|DBm;ӟrVsqW wݣ븫2eZK^VK칻6S%_&MtT8ڨJm!Mm{( t .c# ZG^;(*Ѝl4#@1*ID9IبAm_s#Aq42pz"Qk}q1=xPVꃸ%a/oV3CoT0ll^DnUDmfsnѹ9A끣Rn/bn1"$]X2_t?;|f@ՋWҬ~HZ*:!&LX&>ۭaÝLdfxI)k XqYnBn̎WEMYՐJbwΜlus̞۶E/.2ª&Э$U#B Vm"GU-&M(gjWp2:M(NBCTlX8Bx8*tCݠP4t>F [a*yȢB 6th8EK~A}PCD' EZtԧDpC !b1ab1hEn~>nnV7-WO,G`y :Lq/e#SǸ.|Pu&B8kf -v(5HukFY5jlojyYu=Fн%oaT߯9!cBmu6wd7MʹQ2$c}r|{Ca\ujCeh,¹OPs~~<Q'A8pb_ endstream endobj 2566 0 obj << /Type /ObjStm /N 100 /First 975 /Length 1976 /Filter /FlateDecode >> stream xY[o[~{v.[n@ @[LjeҠ(8fI%:[sgwf΅B WB#@ KAYBnD xjx9 eN7:(/2˶8U@վw ČI)@9JWg6AA_ ۳6i*>X77,5\2VkVavэ bZ 6K]&;MqAQA]Wĸ8eA*SدY\K] JR *@iPe *w&wesM-@!-5e;c{mp J!s&`Yj -%メ]v)ٵ[M],%|"`.A A_ ??7+ZPA@5P}?8X4)XrG!0 sia^`LǦc1]2\ܢ,+ Y*T@k(p.çMSk@'P{`|z@*ݏ`@xvr2~ g> ?o]t.c苛W{RܒkLp8nj56͝5"s?_.$ = +ea Elrն vka`|r:spv>~>1!t6ί7__%%HƯ |Θ7%v;tKl"}lxqu|ťW_Ψ?83=Fd`{ " Y\87xq*ޟǛnIˈ$D3Si%zb IWw)"'pUuI>,/jt@v2f@i9:i 4R5J 8nE}Ł{c2 *vvfCtKД =2|zBH MCfGE3A.i{x=_\_JJxEQ^/W%&'A o=RĢC/Hމ^d"inO2<;9gbx1'ͻǏ|}fӇ~U@];h)rm# άuGG ,aIM9jt~hzw@>ƍ Xn{3:̤O ,FqS؛B+B| Yh'-æ}p^AB^rfO/ksw |"s\QZMY0hvbUK /h8p(7[G Vr|tKG^j<(H&C8haA h&)mM/Rck$G|@`2_c"ˍZ\%4T7\]gn쿺py)2Hz)t)nÓE]3-n` =g~zO:1 cK7_%-/~iZaPQ+ 5"%78~L){q>*vj`TS0c:FAw0[ FOcU!xH>eތ?X~ٵox endstream endobj 2672 0 obj << /Length 1568 /Filter /FlateDecode >> stream xXIs6WpC٩ikgi$$&\dK{RB9r:Eד'W7kD(m߸_c举|'2㽹U9EM"βLX6x {GAj`H=i薭X5#Ɋ$4,"?T LYU.63ő,M4 4?`ۘ`a槲HN ̜Ԣ BMݪ.7jްUY-?5C*T Tml, vSzʕX1r#<%}W:u i]w9Fok~.\pLsDj}7Ԏ:N_ۅﯮ2Ee"wOG(Έ}l#׸cL*(T0bAO;HpN۶ۅ- k%{( P'&fBSY$b^7r\b"ܖA^යʿL9!NF~ O۷ @P4 Pa.P 4fgKB,i{06MFkYV*u |U[R-++hKrºH4 Yp"OJK}v3ʛ-ӹ4]ےz[^.\BZFk I IViݺ[$enՊŵvtN:9^RmczbW pкoz4BH"ZÃ[߾<ݳdUTWYaQ7 ;ĶYfp-X 5p`p-(rSYLУEwkg"뻣 _@e`r}?yI6o`7 FOF9@";).E;/3&oϞrYD /0w>Z9[DbP"bo?dDYM:x9}I|8<9pH\)$f R[s7M+0 7֪UjTgqF9)E!tEt4bӑڇv5a6@lCq裧 yu|a|c5Zgu@e?"Qlm^}y86 ζbb}{K-n^zw-kvHZBSȖ M$VY4I;Y}Xkr &4)%S]Kz%Jƞ0BSrWYQ?]q ,<u&> stream xˎ>_a%6f!dL6ۋ9vm,9`,m[,B,[PeJleRD,yj7ܩ^Exp8u7°l Мo:⡭C=Hc۴(udĎ 0&[4!dQ@v@uyS$[uh JAc& Sƒ"T,kI/sB1X֧=u@ͭC; `:o1rW?ȃ riTvϯgvЙܨ{>UdCr*d$gFN&_$zu2^+3W"]!:N&۲nSPjg!p ύzyRwƅ#!!p`- ۧ"0c\߲V7<9jʼP u.\)v9F,J/i4/c) F>Gͩd̴8)6\ + 588P-CKBwxpԊMp7,ĩ#f參ރęV@$>(w ^SgxjljdGw8}iyZ9ŀM|wAMѫB6uB*hX 0mB&c^@ ͅ"5$hmw= /x>FbJI2v%jcs\KkMkZ|" |3MUC6dU+5R.;LWkq kE5fY^⚔VK3l 1aۍ6BL3-)[]8ԥ(f5f0#4)"l_Brp9ɧ { W@ E}:UXdh\89+wV FW=)awFzwMVAT\%*S]#fABil%eo }յiD &dzM>T9Ǻ,Z(x(x FPHJh&>ңQāבZ=EŨäΔ.v1\";w71X0*mK,jp͖[/W Pdž6X6.(n>[s$XqвAI'Vա@'lnCDrcn^.L0;ɏ#+ 3Zls2B 5:Z&T нBUei Sw?;k =z{&VA;'yylW_*[ Cڻj/ bKѨ*`ugBY©6 |mY}]B&)'D%] y>rxpa6 jٿ_P HܝW(j#g}vxV4b,Ts?*\MC"f}ލV+\\1JCmnS;{+өx%Gutu&@U)jr/+>5v\ާ~8NYՋI;t@9M/(M9۔ 3N%;$nG<_ِCx.4o=(~Q\2̧ Ĵw#Au4i|X)P7({9Nf~i|_O=tle>>55bXO1t|Anӏګ]wj{\9wG endstream endobj 2693 0 obj << /Length 1238 /Filter /FlateDecode >> stream xڭWKs6Wp胩 w:i&hPB@HT(ǞZ2-l1m5zxV*+$nl2볳-DEM2zΏz2n0A&Q&1a{޲ia9$rX21[%5'1hw``Z%;ag6{8vAӹF-1/UKeQ+0̓*)ݘ}!\PksMү=C&V V`֋6VwkFϕ;~`2E%>n谑 C[[#2XQá͌}rKiE Pk` ܊_2^ ^_HՃ*;ߜy#&oJGs_"VGCި xA4{!,`W7d9syh'MdJ|g_X)l3})B #P d|Щu]\\L>`,JrT]*^vu L}#J M I`/*T !a C FGyǎPbIGZClnIthk7sܙNnH(ysóLZ DkQt욉йU9??ؚg [9/)$61yHGT֤r 7^Ö-l͉E81~s wߒ_cF(G`(!冂:=-V73_Y[^JIҗ%I$ٓ`mr>@:R.rdGMO|9&׫ɷ st DW/#hGnY{ͺ> stream x]~'8H};h^\CH>2m+GPd'k괒}ç8[. qaRDV/ke<ç$@$) cqm']ҭmVHw?%קke꾛\?| ClUa4,pz bny*fa 'oEA6^9[џN'UwƩ2vXTE3 mzطF^!D[zl4Y }Dq0mMwiCQss|ЂX sT I:HQ~WK$0ՂfWܰvMKM[5mZqHk73j ϫkؚ_9.Y5GBA30g#~5u^6>^h`.[wZhol*Y1D΂ʐ 9^?H" :9CNܖ H|X5ne6*^ѷ2Kw뙈}gGzݏh?v7A ZϺ%)jb۷.@o@YT9| E&T:`*hx֩8cًlh>XL[~hMdrwAk)o"Nz&z1mQ]Ωrm./ /SLM6+ R7b<,nj}!%Js X#&H=UVnp6o;Eɨct~h.yNs{skEwpjIo! H{(SZ\I\I.dVrW٬,P.Bk `UfP*HfcbH}(ח}hCyޢ8XSD{PbẼVYf0=UxTB\K_f\X S#5Gm_uOʏnz-Ч >C{?ҲKjeӤr]ޝHuՊsuPbC H? xbDrFkhڗ~9K@}\m nP`2뵪sۻjE\.{Rkk^-;!+ݑD0G|1hCdL+Sy{?v1b$ ‰&$Prlڹ'j[my"tEr" 6L!ȦL' 4֢4Pc,#HxHb,ic-rhWݺk*\eanڍnpk'Uq:4Ig5}$ǧAhH-pםXc{ -S1TbC]s1R d>R}u`=6G|3i^ =CrmJx)cE؋y扢 `/'y[gZA[X`,dHI"sˍ9tt}%g^P8I,*;O.]$3N&hIY$`M!`mU&&JW/'$&&I3&<-{~{l ,hlIțIآxoIKr5[!ΣM(. 9Xd5g==!̞H/u<]`]ҐD z`:)q1 E4]iϿ7顥Tsldo/NCRHCAGtp#՘ CH8t-,Ʉ!i) 7pe*-5:@x,Ƚ;`ZX,`^d"?!jԱ'Tn0TSI;x-xaB"[E`E-9Ij&mMZ:7->ѹ^{uAy> stream xWK6 WhC%V>$nNNzHr%ʫDRwso/%Mf:Œ@>g4y\\E4"gY8c"?u~,/ }\ F(NSpIJ 6{vv 5+dꌉ}OW8.IQif,mWt<?g7E3׏b OV~l|e*tZҚVQVePzeGZgfHC m$PyqMi i=־ii[̤MSg~ KQczhF[/F~ 4eqڶv0&j-CP _] MFgm>]VȪ5O,kE*Q uyG7yzx <<$O}=}trj--oo6׌kjeOZ!!d/iIYN+AѱuHU8(UFNX! R@:o*.a *?:\Q% XEi\l;(dHN֜ :G U֥ `.QD* 0r{.VYh_Qz-'\yE2/ϵ`,_ #M Y끉Lmd,G1vu(76t nZcrV}hkE0SK~c@~mL~1U $Pyby~ A.Cg[٨NaiNxIķne2,펬e[vIf 53B47k9tʴ-6& &hO!_dj=s;ha܋`_.{țFسhqКu.ŚL./.Q*KNB'LNp ྏyV䏳Z Eq|emA?$x}Rv!0wr^$o:&I@Ru(@ok&2^nհ~TDxk\~efk  +Pu|/m` |RI-9Ƃq6 rIx2<ƫՒĞ4t|c`zR#GaIE%an{ +8j4E |^dl1Dx1xxRmb1z x̉K|&i4Z999taܩA1]mC۳jfCOd0W/Td XqxZ~|mY^!F7)A%ǿZ R`F[uq[G 4z endstream endobj 2731 0 obj << /Length 2171 /Filter /FlateDecode >> stream xYKϯ0XsAd:H`lvDiYr$g:>U,R"9$E-X,U_(9m~Co V2<7st RUl#Q_!=V 2L^jdD@ڹe;Qz8˗ϏJ7;Q0$]Wr t.N&ܭ#=:x`*Nwp+8*2+gYaͰ&J, $LY *YJ ZoIw-ЂV$NcѓGrD; ]K|NLJ82rtG7婮H1IY I0kcvIU6յ)a 'mg;=u3}[v}/7 NuJWyjdV( BC/Fe_%sW2ڌm:+0cdvH}źƻ3~}2229L&G19PR{I%T 곓wiʸ'@Х_>ڸ]]f.(WͱηЈ][@2ψf^Ccf#ݗpψ}!PbnUEd:8i]C2T=d(lWmh xϵhF5Ч5;W Wƾȴa|KLi/OnAwlBҠGz6jAUyx=Ԧ-)j%&Ծ+!Ҽ 5"LNgJԞ˩Fgś+ZʹKAAZYgRiucyD@|>sv<^.lža.܁۝CؓeYr3ܯDl3 ߄NCN+),A> stream xZݏ88M@.m.IQ!ٶMhmYr$(w%^o)o~CVt͛n߼*'zu{b!0FW?ևUہt柷zQeQkbYΰXml 7IfoZFP޷UypڦtSۮzuv;'JrF l ?REۻ1zЫ+cnыRC/rq'\Pa:'RARn8l} r4,|j]wvb΢㔽6(9oۆ>m_cX`.)sVsJ'DA? f"Rr(6ES}{}Ȍh*T$?~R>XE㤟/\Ӝq4L^^ZPIxN8UPPDffiNYddƌ[&P³]{Є mtU]]_lDixlf6q+P m__h(iÈ̽tMX@b{QC 8T[e%mBpIlۢ[ߕ? *x/a7jRǝev 8WP0xuZlԆdYי7 _<)ƖW ]٭ݪJf]W p:,/X'3:F ޵kpUOO,e-:8J~c{}\;?WPWj"c{&[XOʴe#$c; һQhjDcXSvAxߕ7c{@ ?X=/?~_UB( ?};5!SfD-3:*N-FyWA}4GC9]=ákض! [^ 4XS}Db;]{#t#"fWyR+e6:ÁkA_t`!ذ5,("e>}nc dCqĆ=U, %e{ls8^!se?=Vhй=gCsg@g@0㲡>b5 3Ulg!`]Բ MЌ-)``[ldF-+ޠDvwǖ$m幍.U8}d Ls.3}ғtXDmug5[dDJ 1{, 8c8EФ:P5&1hx ¦&Y؜2(wz%&^A?CGҦƽrydGPn9#0d8i(hKML7D.]j,%Ɠt:rjR<&1IPX#@<E1j/ IH 5QC/}=cRj ڟEab<2ؒ=$Cl:Thz2 bTOD<lhz}K}%aF&,JrG’5D$g+< $VH]5?3 aG#Kc""_yo$8]8%~Y~>L(Xщ$a[///`ں _Y1 1 <$ vMm#9LʞA~>h{>u;oNhhLo޾{[W+iOwA< X(=Vk6}Wp7 iPk]0f s"@#D(^~4fwes{n ;/I E*.A^/̶"} 7-wٝăwZbZx8_=z f9Wy&gbI ڏY1ۆK>@Ś T70f endstream endobj 2750 0 obj << /Length 2809 /Filter /FlateDecode >> stream xYܶbq-pIܺĉ45KS4i튻X+m ts~+89$YuX~v:W KP>ZE3%uXkJ@,::w-O).~3굔fFD0(-u"ŒX3YHo[ueFj_GMjyUR?/[]߬EO~7v# R2NW㚇6zz6Te8\mK C5}Ն+&h[vFO7^r75av( al澗Zpg06&{"mғlj(;\sDy{N]gxuBIH5eO hqE2Ƶ! bLqL,"'~"N%HK XD[F/0r:85:V[wH[K'h=[>w{ e,_.1`\ | Zc3Zf.!a Y+G,3GK 'lh2Vdĵ_ƭhrjS{(hBv){y әT'{ <)KuOl_pYD~ioOU7OSK@lZٷQ붫K#80 }Syc'v<WWnOQnvuhVL }79pfDUnp vmBr M$:O˝)ÐաgFd 8H5Xmr%P "@hkZcŠzW5j)5SoL)9L r EI]i`[#ר4t p#ӨuKm/I<ISBI%5] ! *9891o|dvypq.j~+ct*Ѳ2mO 7vmi-Ci&lF[:n6|Vcώ:Y괠iJi-!5~e>DGiviK0I~+}E&EAB ~`aU<),IzO[!S5Hb2aqȧEf䉑+5гqT rf ҍٶi_\Rg62MXH~(Upѐ^j7jÛ& 4T_ ˃Hp7# ;yӻtm5veƀCR)%@8SP=T3ᇳ3ckSw/$_p19'- hoذ]UȪ14d`iu1?D 00N%slcf9ovQ [BCLKMEsm.D/?K\<PfvжLkH'N}RMaǫrj3m-GA$/E@7H8]cȨ\5C8es,c{yA9d`N~F1GsV/(ՆbtR9(1 'F; k P'!*k1e<&5CY{w/.:wKX-/gsN3V)qI M;`eФ K_hf̖lFL 8]֘]͇‹$Xc|eٚa 4aHr%a#M}~fY^ 4Kљ:g_5 H_H:ipz4 V6M4'DȢOۢ;?Zn6dt(]4FgRx!*̞P}#)1f.,&xzv#,N(}wH>$CM4Q7@u0xTdv)Sz_EN%#[R|9XAwZuH6 `t9cs̼P\ p`v麮@u[\ǖ|(] ~۞x%W,)ԍ[;P.I]Os ey E)Z d0NO/xXCSQ?b_?A][#4һcM;T>HUjx{I)!Z.ßF,2=mGYh:y~uu{{Xw]˔9*9^CZ{ C *-z̎~v]n굚VC;D̍qFMZ]7K.P{ߙ*"ԠwsxK3}w6c9uj,ջ0BS@x_0;u~8ec{o53(~?L7~dwJZ.aIra86-䈫?,Rjs$C zZ[\u54t_:I@)&x{ʓ ĢY \B[r88C˪m ̆^mO?3h%_^? T endstream endobj 2760 0 obj << /Length 1566 /Filter /FlateDecode >> stream xڽWo6_a4 cB,懶h0쁖h,"{߾HQ']ȻHbF^_]KQI#P@db$$]?uJ^Y_W.ٞ ɓ sذ[s!{'i-Y8AgRh˚q؏P1C/k5(DAa(7.Bzފ)ӚV[ɤⵙ4 WK3l4]+]FY|0cO fs.u>DZYIQť^$6czl4 wĮHVDAa${vFh&||IYG 9 0 R|yqQ fqQ_ 6$Gdt('AF: u k5w]!0+jQ} 3l%JVI#wwr8iP\2L؊1y08ej)J9kdYw08{arOP'{NT;PrI@ /4r8 C. J_UR] 5kgGaGjvsXyq0Թc:= m]hVA%Lt$oUC e3{wb7) ɉ'$wFgAM} t_[jJ`0S,y{KW{P\HvhlK؏!P [.ZIFi.h5\}mhi]k"CwA cGJQF3 r/~ԁe|Jk߻ﴷWgB endstream endobj 2769 0 obj << /Length 1746 /Filter /FlateDecode >> stream xXYo6~_!$ X /]uѠMd<8~]5:6:8K+ɲE!Eo{;{?/^ςKP[o=1b<"BPoΗ$᫋g!2 $H l( W+, .c^ @h#ZO#dNdi0^6i؉Ze~0Hwi 9H,bq~ L`*k-Zxq{?¡BNQ9P‘EIL+xlV<Ӑ rcg^~L(q5(>E3| b K͙~MZg6GDƜ=$bueZ$ʴ#R=ؚ6EB#<%'`Q8z}w+8C}c&RW#vrۈ- ̴fkhLx7 "|QLtqb{T$@K ėJ l*dmN?}g:v!21B0ČP%~ hB9)?D{Q YڌH}dq=d 5c"<<EWqLITJiuz[q9 (@\nlpˤw"%T'a6f;SvťT>T C.RٌU]t?Q UPtz;r4m]uƹCň֪>6r-@&WK+>(+ޯ3UNm] C^f;Ţ; R  $f7ּy}R$R-߭b$AV6v..!PL~1M3u0Hb3 k՟im4"GvK[B4g;9xڜc'jZ;}4t\LHzMVlr\zCx*Ƒ,c@{DMMU֢ K&5B )#Hz'v*1%5Rw;n-`"j kcH]zGq: vw^\D/lUjRvPL3sJ3ߏ RNo#j9Ii0:wxe- V (cdݸ&l< "xu˖Xl4˾cIyWs/NrW)-{]~q[rB|_&FЀвI7mHmG(7YlDa`p啗+]?.R#B' +q Xo`g!nL]{В6uh̥{W<Oso? 0կku}1HZE!ǔ20_"a_F%Qqh U~=3?fzp ar2\z endstream endobj 2664 0 obj << /Type /ObjStm /N 100 /First 980 /Length 2133 /Filter /FlateDecode >> stream xZo7~_r? @ w r;[r%9i~CimZE+e >3ȐW!ITIF8M^bF`9@*IECx,@JX.R&ct\ E3KD,tY3L)(.IxQP.QtQV@ST8+!} u.\T`ރ?/zLpQ8owN`BI%60U!IMIp|Hx«X1!- ݛDjb{Ga$KG`EbYA)̬ 6E<^ t?B%c/F\E#T ^Jp: WGaRQKH&QC 0wuT!H >|L&{!i8eDpƬ v_7΀h kp2] $/iC &j^&x3pcdWJ$ulh䵥EdƋw\)acsv*\-.yqYFgg|2ggy%?\ƈ6@}D}7!^ ?j~^/_OVi~~4o&t7&x0m2j~ jr~, 5a x*  ŰQ|115I=6Bj 1N2j^?j~/&jh|%JoG Dsڋצ4/73{=_Los)ZZ;> stream xڽXKs6WhNCX0i;u8i&ISM@Ę"T E*Ћ/, IB/cy8<_fκ˚dyy f*u?^<> +OB% L4 hٳ:PO `wnœ؈kGD@'4!!er) O;/ 9%vuZ] ('0=C6tWܧl "_Yڊ;2޹Rd4ojZXFO wa` Amu':QKQ9TRZ$s3j+k΍KGZN[LfejD̑yVp0n/*s2tSwc|)dwn86®p5}Ru%!!&,5xpˬIL.jXVn/e!]9,|0ކ@Š!!XIѓ  :~ߘM f2ǘ;DJ ett@$aԆ]N]I-Acma`K,>}1!C埅:)3ڧSPCMi4/O\7ᡕ{ecL\Baš(1YƧv[Ka2EWD"c[R^/ #G(ꉁQw%S|jhDGQVŽ2q@a1cƒpb*5Z ͒a֑F\`*?`/<(%l^ [,>rSf:wn`k0AHv&yVv2@Ȃ$ױ dœ[fl0Ai2tv d?n * Zc>Pi]Q}K<$ Go&V~IWcb|1k68/)@9{ <ߵ;e]ܽE^cz6íMWb i uN>'}=zm].Ԭ `Y$>;KY؏Z*54\e CO? -;̆D$VbCbc. c8 p[`?zH܌+63`IdžQ> r^{'-i6F#n/ZrUBHW#b@d4aK$l>+ݓoVШx nږ&|n9O2-d5XM7ErBDzTfFk?"dY$^+$^`E1OM|rh1baRnVӆR?àp;XL7Qe>[ F> stream xWKs6Wp ƒLixV҃D6STPj @iԋBػlu&^҈F޺ƈ"zܻ]4?VQ0eQpNh'Z#2^eFz-sK"(Qb]?IChZkuVPG=P`-$( BPr.{c&f(|.0Y)jB#7{\*keS|+c$ "4~ɪ1™4m?p\}lO B41BX)V|Dm=>oqIBms76"hQch[;b?K ٪!BuAD7xY]26PRD]A~uoh˝lK4kA{r.ԃ;z:/ ZռXΕQpEndaE~/eSK' z 6чvk꼅̛X8^K-yͫO@*kumCFPaڬx;kf$pep(8qr-@@=wrpcmO4@iBzMH;v&z̄'PQ L=h4XHxQ),B%fER(]ϹdTĊ,FI`76x AsK=S q̡GrRf4H( HnD&R9P%qTҔdLu].~ Q3/n?`/+/KЉn 3w3u"7{EanaTY!1zvnd?~@Ź1gЙp4DP'U44&Geu 2KR> U\)XAmxq2 sαڷ}<-N"/ I˼h֔nR/e) 1)t}ZT}_tw 9̋,=n +$@a|lN%mhJϒ) q8;ynR s2w] ǎy=RRBPN̽-}.27W2?=`JTmnsivcXHVIsxc["Ů.Ub/4읫(wCK^iƞxoXe endstream endobj 2807 0 obj << /Length 2242 /Filter /FlateDecode >> stream xYKo80dmF$%QAz],v^ft]Y2$9*WNc4ATX$nW/~~w)WTGqRTnؖuLWUoWl2G)AZ!ӻ-j½[(ivã`꾛M_>>I9p\zQ2 ϼlEw==*::l5ř̸什Nbj>/k#e ?Z- ~rD(JRheg ֙hbF &,߬ǟzF=r/blx5D sC^˱ E=ܕBn);UkN_wל*C϶9;o_$Reg9H#Bb7"Yɽ ?Fqڝgu~0ۼQ"u: 92=,&Df: PmTB{s"āzqL6mީtN0/,'@L{u:0\(;SN3=\yMG@7je}j8q>ꌞh^t Pm U~'5Bx_<՚@ñGD򰿺Sïe5>F_emo3͹ǦJۢst@3mYZ6 ־:w&lK~g fuO2]R*wdxlM9Dq;_Us[TdꤡXl{3_0H6?tj25S`MC1u1gYpX@#X('XM56jޔ! LDZy‰!vtdM@Dj$b RO3%B)dYğ:.|H|OW|!1:lSգ5C&{=kRhP9W8Gkh8`F}"ńB3r 8 @ `W# lS0"=U5 !>eߛ+a+ 丟>_L%S+] ,Ng,]gzzr̽ހ;IM ߢKFДʳB'?ۀ1/ܗWX&H$脈ma7^pPs:g_8ayx'}0av;R{/C ۼoR*)'^g-x4  8 )ipP`HK% e( 0h̗cuYV .mfy9+`b.DLyBEf/p$OڦP.>>E}b}76cpl#֮eR;S?$j OǼ<f{U(qbόmNw6kRBUp [>VPzyy_: 3&'J=lI(+l0r-ZyHQ DTH .5*2 YPjHɥm1?&Y#jlz1KO͢U{kZAb{/YJy[)Ɗu൷5ρ84YbT[g; 80DxI7lT)fsQse n B+<zv3\Xw0;\q5xñ11"OYH.X^sg~<ƻ[5`F==^0C>e,6)5`7h۸7d4|_/Ds_dv,(:+ f؄ũ^Mx'Χ~[B8hZRfOWKY>q>Ԣ%3A0&Mﾏ_^(6I2,?>ɭy; sXKa<(I<.P˛tzJ~Oƒ endstream endobj 2815 0 obj << /Length 2079 /Filter /FlateDecode >> stream xڝXK602 clRsvI6r2{%V"KH")YI.Ud=h."'y&͂QJx,RHs5`yh' y ̢CW5HUw)аQfN6Qw*|+ I.݉Fm척pIDdYVv #,a$YK\<$AKkZÊ{0%}2XD(b!:?%hJ4f^DE'V[;VMQ,GSCg4+ӓ\hKNzɴ! چ34Ɲq;mW&eH|XA$&l :!]'kfu R jcgפ6C׮fvevNbQY*CxgȒ-mnugbv嶮膚Z (F]!ZFXa^?Z}48|s8~K;=켵? _&\|fh쳒S ~* ]O/jo+!vj?fpiag&QAeqxN7Ǘm'iD}N5[jT>><G2HX`b"򯘹Y5Ga@Or#MxISb]\0#Xbif)F3n/,4E`+шLT.$8d?͘>` % ~_s.<DK~\%!h|_nnGD+ldae/0R0oJRQͦL,>HW(֪ .7OJ|bbd=7C΄O_*:)P $2sM݀ |?>!߻\@ $ C+͛7p%8i_RݺFW] +mfXuh݋l{/.nRW}_k1IWzz)U^#WTyyCvkIp ?,M1><2B yGp{} endstream endobj 2827 0 obj << /Length 1166 /Filter /FlateDecode >> stream xڥW]o6}&EmX.+񺇴Lje8b:jvKs=lq"/E) ,<18![--Wqr4 4pڕra/ٿ3&фznv{kx4uE>(ؕw;kw: (=΀`"8E&B31DiBLTs 7m50">p" aX'Jp8frߕcNH!^u<ƌy(̘W .4D |L YTc)ơ[f1Ӭ}dowUQWb>&y1Cṭm(E P20Joq.6þE6RU<;Q[ )N˩9gI8:\@;[^ͪZ=~(ڍ77Oҋ9,}n_9D'n]È#|'|#4 uQE^˭0FVYkpeyWY.-I M?zh+kؗCSm¾fl^PQZD3/J R}P}wTZO`٪zcgeoU=Z"Fp `6:`v+ZRۮoဆ(9e \VpnD!4E+p9 s8"b@J!&4jM Kʹ: B|1wȕtv>2HaQ V=PBDPO%wgTCveUUn;P>ֺsl"p K>y,Jnx>TLYH(_cPd;!@οy_UĕT>w4M+p:1uv<=+ɌWH endstream endobj 2842 0 obj << /Length 1364 /Filter /FlateDecode >> stream xڝW[o6~!E]mX6 {H@KV]ËQ4op p"΂IM@0F4J᠄wYpuiDa^~Uc5FID$Q%ߔTY(60?7uW=Wn3//LQD{twJ'\ 8QpUblF ):vw,CN)]n/jnqcQ1B^!7 G;$QFhO<ű qj,)w꿊mU w˗e6si394-Bq:hj1AxŠ!G9-IS?ߜ9YKZ|])u xjx0?Ӵ7'6r|a^_i0K P'kD}8yACYn~q0Nap83SuOw#BOw'}`WYW.kX+|.; #l<`sPȯܢ0,y.}8Ɓ-Ӛ{p 㥺HYSuڞJ3-r 8ZZpz~Yjш*vբ=%/+#ȋ 51m*\3Їqk&#T]kb*mN)e*vw\VnyÅu[NAowL  ]]Pw YV*/@{խ ah5:jFJ}7g$)_/*ޙj]",ŋ^~Ct^ --JvP+Np8#6yjlh(#noL DQsAD| v)x);%MSӉ%kXul [qG`K=p_1ivmGŨէleޙ*[ā eObثxi$Cm|q)7s>~@e&@:i2̆>Xӝ0L M!f(G=hJ) >$KhzY)tiA-T9lKCuzS} A2`N }Pi>h##rF"48 endstream endobj 2856 0 obj << /Length 1671 /Filter /FlateDecode >> stream xڝXYF~ׯTYTYs$MʕsWql? 4( X ˮ.=Lc/+x J8r 8K{7?y٠]}2?,\\qoK8v+(&j ۃ^/g#9dGaʳ8#Lt+&mkP=k{d103ѐt gp}RCjYZ CJB#{/ύ|7/E$2D/k݋Z'}d37-T;iA,>h"#7Z5i^ ǼYUbzNcd!ÓK2RIl[PȎa ~Bx| '|+,:("7Nl+7S5Lܧy8i&p.v4-᪵֠G-zWEv3/r9QMIMӻu}Ӣڏfxx)]RbUL~{%r0mmcd i% {;_2u`=|BZcZK"]|z7h)|p p'A败UȪuu^nVYاV4Z8$C>爬VJ@1!2 )2P`p8n8dlFufnx0vko+= guk_E-wKSB߇M-0eE>+eVk!GPpBC#p8.y}Zr">+z lu9@A<8PҩMR3bTc Ѩ#̫ߦ"cT2ё"L dX !ӏjN4ys; O"CQ^ѸvEbV8Kx%JvI컋_uq'ʩtNn괔{~w]W$Y^ Qf#]Iti=;HEuy8bkUN r2bC!n[kJR;R-.lj잤\Vh#1l}Uڊ|PyW}?~^ 48ԕjPUo4 Hʪcv&S䋋22m3nO2\мU hz jY^B@%"UVEZŭM2w뿮`Z)i"}ToiI%'h1$ sتژ 7 .347զ9Bijh.&2\?w QF0S=7%BꬣͺC.$,(%1P%pHa#=3n}#=| ;WQ3%Eׅ #{ w 4r?+ endstream endobj 2775 0 obj << /Type /ObjStm /N 100 /First 974 /Length 1850 /Filter /FlateDecode >> stream xY][}ׯcP^g"`- Eڒ!u{vW^ɡmҝ{H3gƜsN]hWqBʎXKu$@6 V-UQ̅\U(0$14FPGsPZuu@M MR VG)( )[Lʐ4)IX J:TuTQb v ]%s sims+8AǤm6̌E J6u,XCa)lZ[r\ HU'ĦA iI1d`"lE8=D6qbb .6Ӱ:6Hm@4鄮Y╛UX!ՊU*b=#0Q41f3 (̝Ȝ3Cl{Sd Cjc@'6(Xf"R +ͲMjnQ4@*B1Jn+-vE <Ȅ6dn#`(iA,M;-.+*6:̖S.o^\KhAP_bgݻWo2ZU-~970f6?.ӕ{tËo+wЋ}t4|妳H&Xp5]?.&Sk[+89}}3v{i CؿDzul6ck65}n܄i]F÷颍^ ~ 9ze*M}RVF!*p?˜?nf]\g|6<~~_]>,: >}匿|1/| iݵ+Lf0Qt7f Ÿ ^¦_}uu=cx?ڝK)٫gF\$LUg7)?n+Ԃ6jm11}s|U=x-[Ck;ޱE+ fYY]%5Nt4MwwTSk&{|v2mU}H[OR7lUYJ`C놭E8>YBQ" |.x@Uߧ}hŧZ{QUC}hNtHފ>4CQШ| 6Aщ(R:衄q2=TZv8:ǭ[Y5! QGw>dnrao)Z(.D18)GF>($f9W˷~huyƒ UX ,d X3IZgϩNT]܋m#93d(}pX0ųd|NPl3>gf'{%G{r 47#6!#T m@Pr':u_I͖aw^<9J;_ J6mwB"{˞EQ1(2b:ARوmF&O3fQ&JWp󙕚3cRNܗrPh&c/Z4}hɯw t^MXګI}~4kDG>׻'2dZKRN')nYI Z尔 f|{Bə8 &?e_ɼ6W-Jͱ;a/ʏHY!ua[C -6C FډÖUF*>4=|&'sr:GۊJeo|,uMR PɾR!N@͵>]žGDh"G9|u|@8hfoG>TI>CG#c[ ~ً5ݫIT endstream endobj 2870 0 obj << /Length 1329 /Filter /FlateDecode >> stream xڵW[o6~E"avö$>0m;HH~ iw>hW󗉌RrʣMD0F, qFWyfI1]zu#Q)JENhu*յzEXpoW S .e;URh`rtt06v`c$AXCm&s8pN޹՚&xvM盦~{uƝ0{Oc|3X odm8x42ZX 鷿<ԙ?ook~cV*c5W%c2m.v2TLD FhT!,7mSH|[d~9)! ߲,㤱?UE^AD/p^jDb73@yڵ\oer3TZ: }6(MR CW3Vw(ÉclMDILgJD"O\yɕu!@NRUұv'+`Q?w!_ԫ0[⺼Y󄫜l*=dn~zq9bhbkE&It@rVyaa®qcni0P@<|0~fzZZ1E.ߕz{:kusa>,QYƺv N0FoQۛoϏ#5u9RsM 5e юtm) q9 %)D HV)&ؓ×_:?Rl,CjR7 *jRa' wИhLkRyxe]q(H/7!KK+ͦ;33:f:ag-1@D-CR eNP E/)K^L" }g^Rk=8$2E䶟g)|=3>=~"|> stream xXKo6W!`Ѥ^A{)!)PժJ[=ɿCi%Y^۽4HIoKܢ.oDD^dm-F)⌑]f}MQudttXhw\߆d/"…zG}%tAF ' z^6lCO- x![ǽvum$-œ2$/Qd_@D< hXEX,$`dD4Ьȋ5mWŖ]Ҵrz芺R>KxͮԾ-QR^M!JV<y8}'\SS9qxc,yH Ăx _e-"ϧ+nQ;ڳWn) &z!1^|ӳ8#ɏ !pe jۃLr'qR TcćC:tPDfȶ/jœ}b{#qldF6#̀?ƭJE#c0OIٛmSOSsiqmSF{:/R葺dS)d5놅5'Ǵ?tW*|huU*KR6M  G^ǔ{ڤ,lԑX,@* ~[e0w?*˰>hSZR+`e /@QH61 Ixi-AZDЏ$bFrHIJ!aRbxS/F/r=MeP,J\Z#Y9ݕx %Fͮpۿ 2%ZAcL-h9ch^yNbib):T9Z Ȯoy$+o(6\{;1l[nsrC%2Q$\Uhl=~|W8=4>DߡEjB >v]wh>dРhDvS)3pJㅛ=/:]nMNj<*6tF8+QKV?ۙy endstream endobj 2900 0 obj << /Length 1593 /Filter /FlateDecode >> stream xڝW6޿"LtkI1 @ؠ4qli&mz~I}||0v2;-~Y/_܉Pz:cDaF:u>,=>_ݿ+% E4AnCh}'5e..zyA Ed ;)lr`+Aa>p.䝮JB8a"s`/C'+rrVUU۳+n?"ZuO(A%e11u~&ڤ.ʉGx`rXdDUvt^#*c5)FzSb!ts}hRCD{g!:V86`A=zro^&Vd66|;_!ͦJOdrDȣB(>Jyw퓯?hYoQM$kyU4޿ɝs͍u('.0Tiy*OˬߋҤCcj}=I Xr8gkng4N9|sfl.D'SlQ M]hli]U@X` H yȵEo?wBeXN| Qq"ک.Ov'THʏF}U}azmLmHd>(#[ ?vZ1_`؇s_V^|nj¡Q'srPw'1),O[Ӯ_hNF׸NureR)_򶏋RVJ{$$Ɯ$.e-cgGz}'~մщ:ցc(dVEbX(d]aPHR!*$4ܥUoplb$X@Go2ArgS :DQϛoG>< 4QiOKc~vA(uAt}g]Uޖ2)T'aC0(=/2}PM_cHx[Շ*w}oV^C5/[4qW57k Sr8' }5Ĉ,mAJU5 xR΅)W@ P؈jv\u&u8Ȳȇv@AIå1 ѵ"RM4@U{W+5C7,jup)M`gTZQMmmrյ>)!v)&uW_p4vեYJG>5*Ӽ4;mƍ9,RӦL ̂;dwCZRTıy6r`11aSeCM($$\G@/3Ōz_ϔ1x^UG(Rz'{~)0@߼{>s%Ԗ4vu4Un5юJzPFNOWP0lr#1t׋nG endstream endobj 2912 0 obj << /Length 1311 /Filter /FlateDecode >> stream xWnF}WI A[4m./%BO߭uj,dx(Hg XHTO) lgĵ|U9՜`DOM0 PD|.)`R,QzESMj/FU˿B*h⾂޴Ɵ"F{@2%lKRUJ?Ӛ'O$3.GM2 $  O<b`v1<#jǤe? b+̮>b+Uwtcy Г> r1 U·=H3!د o:*ƿhMeY5ILQ/&d("TQ,ƹO퉜l{q} 50.ep; wz2U^#W z"C!ebHTǚ\4?_(BHhUhB h0`œC' 2 {J$yMZSTzDq0SUĎ~.CSIpHlR[x< .kӊ6 ly/A1Knn:K|f`QI:O{%O͛QC\#6- 7洪:Bs,K遼)JwmwfBKM7`H18l: 4'GzKZ.jZx^7j^mŶ ,Ӣxj682E~`,J=uI!H":@9,)5CTQV?̾Ƙ96ifN[sRn&$?]ܩ+)X/ *8}`Vq[Y\@o9Zmӝ1ύrȦPz|ᠯ?n~17 w[Wj#B벼 Tw1v N{mRv2ۤC/ϿP>".96 endstream endobj 2928 0 obj << /Length 1427 /Filter /FlateDecode >> stream xڽXnF}WN^.A[4m >J+ E*ܥ}g/-%5;;se7k/4"7+9o|'2q7'7?.]^nO]Ю *j|)b j6[$RqKi_lBjy#;N߇аDiӔ=}]^ƕUY);Fge?T4TA3PF]߀sF\Mΐj1bb% UWHm}.^p#A*)^ؔ~|Mu滺AH:@!Yzp0A!=!PN?MAFǣM+a 릂qQLe*f oN ha%OY_twbj }d y5}7]"#b<Y2|яH5[!sI߅)mOG >MԎx4}}2KQڎXoRI17?+aJPXp\C=bS^aWDҲsQ&;5 A{8M38TA F+=ՊQ/a 5#^;w SxUad:uipjZ3M}0}xl2T6췡~ .1U?*P 672Qw~Gq͚8]-fs endstream endobj 2941 0 obj << /Length 1007 /Filter /FlateDecode >> stream xWM6Wae`MR=mE]=$9(2-+$Ww(˸ؤ%Q77ofdd~,%bK*: #eAr wu^Tfq-KZS5X7Smk]H2hgD@!!18u1=`q^៳h6g* b)&$*WefMTXh̓2~j vW^W򐛍{a6Mv$+4r\WGQ͌Tk H搄Xg}g7&O58!gLړuY QހIF樳1KݥOR*y!2E~Ƙ]tXU9lA0"dji=fyACBgۦj/FQPGw{k4 XAΌṉxGSPmm z_[5ub#[i=n!:5Mr$#L -&o`/oGCkZ608!y@P"iF'q %({]Mj:j{/lɀ ‘q  pўy+ݤuk K{@ѩ;*Rh]LIECgEh_S@G}a&fcb3~ 867*"qXٶ(΀eATq2$F:׈&!Oh _70ky=y2 EܵhݷgoS!C0jvN$) Po N.UMkyVkԘn2m^l! OسɧhL:jN==e(&g"xNrR?ۏ|2UdT`6Vͅg-I%y?gM~ܟz 'yYcy4 7}Nj)bq"a\}Ϭ} 2CA endstream endobj 2957 0 obj << /Length 3025 /Filter /FlateDecode >> stream xڭZKϯ0j`IQaѳ9v,˶=bQe{A|UA_WÛީh8~d4,~~tޅd̠S- }YBC{mLo卵rĒl+ _|_dw7@~xܡL`jMv0F(/):[q. 8 >g0MD1h*hUfÛok!3GqUTjXVYECB~[CiUuUƃפ4SDuk/"'q>O 4'miNh|7I㩭 W(IZV`Eo^$E\0T]]OFv{&1, qcC&tMiM-fX5zYYN-0^]_Ρ=6iqhhMP@CЙ`cHe2uNT6&V஥\qU]gEBQ5MYNMʽ;dXGXoCE؁ʸ4q8r61P . x7P#AkCRvv/Y"`~oP&GS i׾jVU  @R@lDwpj;&ZP?{rk :O3˭Cs+l,zr9 "eL6ma]%AbpcƲa3DY}n;ZGW$֖JЀ qA&n;tY~HXA#S@j CkKr'YO1М=cx5]Jisd4eVXҸ8$h@*KÒ˄PTpzD 1 c Maf7ExpblеxfW6MV? [@UWaoH5!΂;1JOڙ'1E[wi_~j{]&sj?}|a$`ZW0dC4{El.{ǣ wy8*;{pt"47c쪐<_k8(|XK8cgzFapԽH d3^{10- >5R$'aRAV2׿}Ⱥj8D_#@.&k3,P[n;UIr` 3V&*A3?)o`I#`@f41]AJBNI --y*? sg05x=PƓEbG.Uڬ,M>b6y1 ox/GMJN9RA֐ S#s\ԝ3h mAr ./>a Ě,o)8O a*7hˆ3m֤u1FlF41/ o|k 2S[~67 Pio> stream xYMo7W 9C0n@`@[#V7d2d'WZz5z>CFM.)>%\lbFvfrf MD]Vk% vFtV35,hHf`0P(pq/3<GLE ""Rl95D9D4j#R>$\mƌ 7.q)@$6f\‹C b0 Ebq  !.2e",pц'Q,D Z`tUkvX%U (%J",c] 3)%KFdS b6N _·I꒐Hւ 3,i-Z*K6b9YB #FAHWF sRa"bNe@E%𛥘NJaYbN`]dXn81`iDH^M"5YWLJh M$#"DB5R ͖UVH*-l@Rf-l%T+,K.c5F3wy,XXG\jѿIȃ*z:=T`]fesZ>"K柯  v Vvz^̦';r݋g{98w7^u1oƣ)ȍ'K[xڏjv2wZ~?~tGRb+BG3iҀ')-437;cޞ:uO^u?vϻG D1y q6$yxC0}9u'|<;=.~v~ǧ էMOj:!5nԆ=k=tOgIwr/.>wOgo~brp|˜m+suvbxJ }cZrXXЉ }HCis!@0!="E NNVDkE` UBUB*X6ɤʂ&'BRJr JE%rT(c|Լ BmQzP_dR߼^ۏһ=Zk߇X|U>t@4KoE@4A0yokuwYS/(SjZ.*׆nuSvC#J_$WhgY}1_Njr_M ƂR?Q@N| A–.ABRN;+}JuTRЇNEdCX5ة% ZF 庢R;R`,sOWXe'n-XT勳vK$bچ݃aZJ;c i1yHK^JZi2` e7hBCϾd?'b@4'$TPRjEU"Ǻ٭Bۖ,۝DN1!"PŲא7W -ȥT|fTMA;[1g2~-iU]=wK[/LA 2: RQإs&GP"'٠Z[ѢmOFPfLϭ g,6I)c}{ ђ[?/Xh7]H_6ԉN$mS0eڏ5#ܬ(OHX9?<ǗoUvG ̟2o endstream endobj 2967 0 obj << /Length 2898 /Filter /FlateDecode >> stream xڵZݏܶbazK)("[i_'Et+j>\wCj狍ĥF|f8<_Wz&V+l,n%8gW,6[_XsH7 >lka9G*E+wXm"3cj#("}}-zq>{;zv*nSM|ҦHiþ-=X˰vEvJKϻ*W;e75ܦcYT@)#kZ]Ni5ݵiH xn ̎]ob%rO]wuCA6B m$/Dbf f" )Ll%LU`{XՄZGA S1jfMB?HT7ڛ.>0oX'IXlHK Su$s>]%wKoέٿ]wL7w`,]7^ǐ%I4Vuv]/Ȫ4 Mէ fuDБqv/yed ICޥ&7mQWPgyy`I}YܨYZzuo;sߍ̬h-ɱܫe"X"-+buZ:X 4%k N$Cp#fA"Ya?iv҆0, :ǥ!˴m(ZR7v +LC .]@)aIE HOr({Bw{wyq! vz|&|\\CDMK/j[5& \Zy"J'q/3ylSV/<e'R[ tq11(SŮ>q+JŊc߫865pr>j\v2L5Cҭ'ջmv_,..`t<"(7 ZyG]*6ao7 :׷'Wq~E<^$CVg<9+Y{lKȭ,ƚH+(gf/G(y g{NՓ(b2WMBў8ZaD4Zv쑆eYԼBIڅѩ9 dwcq4)wGL',TV|6IB> v q{*?ʈ[FdlAgpOrGڧ' Tݿ[bTY`r!I#Y<[ZXzZD+_2.3q<LQT}LYWa kwآ@FqʉNܱ{i $b4p$źVIWV\a4\}&Ɲzv K_!-Mx8}T`")d>58U^BTj?oFv&L *'BO_PSgY;Q?f8ˡϼ,g7 g&%bق[ƅEdda߆jRM0iXX0LX~TmQî)GF*aɻSSѤCOѝKh]6KXM۪4yL}Z1}YcAan3I˳]lfzR0Ŋ%{>fp;ox / gnp.5~KCr|v_.K<1a#<'+ńFL2DnւըgS5%g;Gp9% f+/-ԷvYj{z#_e YzpH`wWu($vSJX?{%,h.jܠD Qh KE {։`IkDgc٫z+ee{UY5; PuC:$׍YDv¬6-_> stream xZ۶B 5='4ԙIN;bpj\nޙL #u=߆ޟ\a9?u^5WY|TD/PV$,j33†^N(68rFN?I*kVZfƨ+ڼOCˏ4%I|=I>I5!F"xg^8 1rLJBK$8'켣y(! [A y§oiGZrDS]ΛMlf':&0&~(ӏҎE^V1=|PckDl:/[m^W˼̋bH}DZm.s7EaFv zQeGuT` 1[]ɴ5jo7E9_'KoYf7M` w#0nJ^p 90y\?l>[N h ޠ@>tcǦ-lm_U6QX)t1-v:*1 #pl'[Ș# CФbuJX(L(>2sDL3=VݠB:G`OK0iM{ĊC[,^BC G܁2R2d$Qh>wd@]8óbV?B5O⊞ĕDNN9MT_"7@/0%;{D`vg,yC٥wmwˢ􅳃hS 3|p/%Ma0yJZx}hZv7v ’b۝F4wA^\WyTeWYQ/lOR #&hXDP喠1n`f0 [ m~f @^|nghYOaJCt|Y}L)XRCSX[8_Z.y%ǜ rȃaj9B=Y7 "Eg+5EGVMW_z&TwɔSSk["vKCΏc\P~Xb- ˉo~PDNhȮ,n9(j6^9n+Pwh41Wna Oٓ0MZCZ̭6D:ݣml|B&C~h0 8<3HKLEvq8u}1Y?:?h ! 4W~93=V  8Ex]'#_Og@!Sj"\2o+0mcaD0`%=1bE)Ir#-X"Kz\JY91Ål ρ>vW9h Rd|\c! GH!Rzd.Ƴxa~mՂ7[`|MC(#BveG؝5ep)cԃ@`x5aM`>P 4kݒ& Q%UPprհFCe:`aCEΛbWlH~d@@{ۭ58WjĀjW&u>/SWΛja*d_wh+> FxsT8Px~-],M@dog&ג47Lk񬁋~5ln+OWg&U]܃EVi#nqCQnHnjjs-Zx _j6C7<q8vL 2uOu .n.T +X1R/,G$1^ksdZ Ȏ0^~/2"+vsܝME(5j>f_)ˢ4Mhs^ ԡyH%""KpST{֑~GQ10#>m~W76SQ/m"{~E* yXwJޚc7}l^ejތ5u(E|8: (nhΙ;v\sljJc $} ޭkТ*PY=ʘK"`(Qd5z7N55R#|ɢgĽx3hѾ޾SW0|uÝ~0ʔ [aUukcO~8: 9-F^|2K$z޹K^ 8ЄQzM,<s6~r$0ԨB\_|Z3D7)> stream xWmo6_!*1I C5b"ӖYDiw)[R$ /w瞻drvr@"\{cĂㄠ o^U`L m2|vrƽCLD *ioxnXPvVStv<_0FJ78c#IS^nn_˴'tIE0SvOۍ[nRN>uwxT%y}wB 8 .*֩r8 #7qBe42>[>ĄExsxwԕRk;s}e 霄~fWDzɤεV&Y$Uy)>ĝ6"QB!a TA` lp4Hkbz`wZˢFZv*irU"AWL2c`q v`*W⼏T^ڥs;\MfZvJ+:*AGBjf@8v׋M&@j\ۈˉrΖX{;$bm`фfoOLt9X_3E`4~prR9R`DwZc6q?0EhjPw#PӊOf+ol8jBve>7zϻYc>6 (>pJ6FPvЂ2[l" |EFL"FHU]K]Ayo`Efޕ;%r猴%Ko5PػnwnR& bg{zHTH( ^`qП{@ *6Ws3VvEL4VwmS2"c(?_It}ƥORu^L& 4?9_}Hv?xtS)M\g Y#| ~ՒrSբ@1:*4jh 7ʻhK!hmLu,DXa3s?zLˣifjm ^Ӷag P-:l>d׉uIU9·1SNAJ.fzhƏ%`|7~U|/adG6h\71,ecaw}oQ`@VXr?I^Mz}h?B*G endstream endobj 2999 0 obj << /Length 2003 /Filter /FlateDecode >> stream xZo+5?ET Hgm'@bqnhߌ{K]R/̶`퇯>|YƲXij͌aB1Kdp)]z)d{Erh t\vuhuUԂGi9BoѲ.v$ cyÄA4"%Jfpy"S;$y‘OS06<7G۹bQFjxUG+g dmSd#Bm]xpjwջ 0v &D:m~#5B]D'vݙcK7G~ߡiwgׅE=f ${IeI~0z`2-((-"R^0?$ 強q l%q+1#_o^ڪ'J%J0F뒙`ElHy:r֗kH h^ gL*҉g6 vg|n'p83V gIZtՐVi:J'K+{E0cH`rqB1*4LR9]uc-Mz\vqO5Lj8CJiXDž' J\\ݳbRXo_ӧk'42N֨})bT?;Uk^M,n_E7WR @ij?|6- endstream endobj 3012 0 obj << /Length 3127 /Filter /FlateDecode >> stream xڥZKoFW |6>`]/$pCjG5aY[UM6)JaG}Ճ6hW?_z>ћ\L6MEBdƱHT>l^Sʊ\\oߛ,Dy"p+*U`t;BI}QVlb \.68IF3Oj'd{}_65>-Ul\/CU4mK#$lV,>/y}s _[9_s^Lڮo}o9l;:HUmmUg'S|qGiցFkEY->fY:y\wW;$۟|WcKPQZZ r%ͶLY9mEc*zjቋ&PO=‰~;v %/oj4$BBF1`7Z2[ ;M^ptV S4!/jjbkn7bpf !D¦uJ$sghHRI:|N}عS+: ]{Fy #|r?:ZI?(O6"۴Oj~DOԋ䵗6#@O<Uf'Ѩw|6"Kxf!"ˍ_S4 J7S#t6J$1˔+ inPDа EG#)s܂6; %s,R`m]>,g`9YŊbVpa%_C< B@EdQ lʑR6y- UJ'YpvE p )mY{aV;ژ\ lvBy#|SUl\6V_%fnxIHb+dИ"해І+o%M69F$fI_ kRri-=5kBj&#zvEvr9k,AZ8u;I5b:`wrM36S ;5CԐS>4 dx[]K6͔,[ߒ e3gZMn=*Vֽsȇ,=\p=o| Ι.Ҙonc(!Vc o&"~2m($Ym5Nck 0'/dGşbe Jf#xB..6w\@tyƆ2=n=ӻ'{Th`]0 ɟzIod[7% =Z\.ʊD lnBfd>F4&M%$8' L ]o؀DH&c P- ?@-\C""%$^˻A> KYLT=*I4^ _UT|յ-4N I5ynr]|IxczJHRjc4nn5UkDs"'/$DD慉P&薸b_'OzelT zJwF8d*ݪǣ2҉fz8X&R3 vTg2QLkC&GϨ:]ECq@Ɔ8S M嗕K+9;*T.;TApFm;SpP->K) 80_~|/{zB q£(S Xf Vfs(Lඏt"E }&D_8c gY4v`nnan;' *{Nm_3*5({V04$SӖߚ/dkr@?,$o3Fm7AG3Ido4"ݕ =ZŸj;D5"Cqj! |51F}uڢ9:^DoGB:Uxo|jmpB gR={ si|`Pt`!*X eP톖8lσH"v*WCx,]O.9`[;ܟ$tNICJiL^,u 0dL;2<'IeRΖcG)Xf.X;ܷ)A;ߧ&]Xe^ %]H:~+U]ЋM?ђ=<uGs~+.n2+j3Go3 qJntWYT"X^mq;iCac믽s4ۢgK>LUD&jΞEc-YHJyX7JXd%ؘ: wm \d\\.UiYL߬}r܂y7X:(pm-|U׌!cwr$ERgO)WS8=uF㷊bJǚwlqhk ?7j4ct2zz @-K.{sO@1P"Æ+ _}KCi]h)plA~݉К8WnJź ď{5_PW endstream endobj 3021 0 obj << /Length 2152 /Filter /FlateDecode >> stream xY[o~C!/(mEtiI>p$Έk4ųίEIV-Xqx9<;9 =QtIem(m ơO`5ÎllUȃ Qg&F1APV jgm.ūZoWA46)Wwb/#_ELPׂ])mbMIBNGc d +VUec->\ ךQOvoSV%J*"F϶E(ش}"Â0őHQBѷ8Ě#ƪBtV%(hZ'k4QT7U}^B=t1L{͗RDFss./3ʴ}hIXK[~55er/AOi䥹Ll*1_wa7;;(|M)B:ふR@!CdCRQA*%rF1Ii(&& JOgcm *֠Z RZBj 0t f)3 $Ý'3fpƘ=W5+P^Ձ5l4?294Ⰶ]Uv)`8b pmsifaK;ؙ L!GYfC#hJ0/Z2&uDv?3m,eLSh F>cxxȼù Voñ4Jd8b$Yņ+ȵLX-HI>=<\OȥBU-w =՚@p>ux+W+xјu!UkõGQ0as'SF%!sԉ9AI0!E+^9b$bHP9ABՑ`H0y]$bQ<= eJ_`2\Je2{IP[7PݶJ[[u~?}32cӬ>:xNN %a)#`g>Ki4zSdfWy/ieSeh'"fF뮳} :PR010mt9>O(͙,Sig vnq_àъ{8v/đ'gp3{ht@h[H[9z>|ok,A[rtYr~u)jvu)>g{ը-â[뻶/o}XڵyUdϾV>8*v{Z2ۭҳlB?]U4ҷpTZ7U5Xb\n6 =z1sNq!ب2Jy4o+0NHC-rokٵ  e"s7>~;Q燾:UQ@t+ 0az~On|zpM'Sqxmݿ6OyE~iҾ_AhqUjxh zǭr 6:&=C)p;}XR|,*NMOҍ?he NUAT JG|2@4\p j7 S$R7AKc12,% plٶG @z4w˦'I1ǎC;E0r8V{:זӫTi:0`hg^(R;'m%/2P :CWP5D[-͛Fծ=gܓKW)CIx|D3'A{SΏ#7)tXiHsx"v[$'J>Y @.!m|o:QͲ9:qJ6Һ-9"}nL]PۚN©-;WǾQ /x||%\{pݡ~uL7Hc7ϝ endstream endobj 3029 0 obj << /Length 1253 /Filter /FlateDecode >> stream xڭVo6p lF˒C%RӺ D\%Ҡ$'; y^:g9W?nQ⥷8_,G뢥VN/O_|sD=%?^0J%r{s+>BgBs/p&ԻP4佼#Aah`0zg~b LhI;/FQuvN0.7y(\^HQl.@i4r.ű;֔JΤz[Ƹ[H[-M}RЯSיn9ޮ1b&Q`uQ=x.WE \}UYNY}6! C`Mykjb!H,l^ JIH@"S/B1q]A' c*'EpT) 7FadGHJM,4%0x2UrZn^Vȁpp~T'pJFd~<3FiRxe5pl $23v-1CNk\rN򜤵y1E6UDV$z#QqO> - 7x|mU@3k/٬H}|tنt859mX@1~"H!ך]%^r]%^q۫v;² ++Rk {%snovT9|Ę<ƚMDВ7{Ae1Yg?҄7kRqa25zQ[S닗rŽ ]°v*q<#F:˿ZFX+pR@SMmfiѤu2\HdŸkj+L}դ:$:Ee5i ->*׃8D> stream xXY6~_!$V !AiSLjt8;CRW{6GX3ߜu6u~=yɳOߞ_Ho*$' @fE'zy:.xIw9& p<8?sm/-blDpēV(dEOl}}kUۘ庪.o4o' 28*qdƯTٮͪrb`١`!dQؗ3U*.g @RY fmqӘ@xsF(faG}=1=wfycjQvNHA0.Ws1`Sm5Hec%c췅p\Zǽo⍚uuNs!7>=[< nYkb`:ӻൎ$O2MЂ8##ѵ=i7qzbɻt{ΙݤUnWFDŽ\LeJH[{nv~E?--ʵ/^~ٱjלCQojca zNX>`@'pX'խFɝYm0-yI^/38tHϻϑ7M HEtf*:ɟ(jX*V㻰C@"tP(fid.WD/ 3[01l9FuJ0b}u|Gbi/ ~,tq*Em:+7fyv(4l9x$aB+dyS7^9մ}@۶Si>׭,8te@ %LRM9FP:lUV*W&k#`V%X=xvkTZ_ B|*iT}u|W@۴*T}y0hxn4 ΚQdl?:ﮡA>zwUvCfSB`tsLw%:nD_kR+Uªk}^%qySWruY6lYa:abwyRS\ዾ7y_Y*?RʡBP &6ZNW#MVKL%5jLj d HF=ym6ۂ!7MΔ}ab)9$")@q {E&b~tUZF%LubyqWfAjƷ`Rg`HHZPyA )CȎy$(gbzvt;4#4,/+ l ˮ&LCY3-%mQ-GUqak=Fph%bW`O4N,AeMOxNىP3?4c2Z@A0%Lnqڼ3W4fs`;7$bk'u4hlD"3?7'E{g?|.|L=uǂб`3t,@qs2hƳ3yo{ʯ]uh]՝8]/~@Xݧq!^/Ox$ endstream endobj 3052 0 obj << /Length 2891 /Filter /FlateDecode >> stream xڵZK!^{cO ;ֈ^I*_"٤gnn?ۇd"U|󸿑Q$o)EͿVZQ4|ǿ}iBgH sLpқ>hIݫ:5-m;Y=;+E|tM]+VvgG!卑˶ ;v8;}(X_hK޻]#&Ō)L4"ъ(+?߼Yt\WpvW/ȝH.6Bduks`?&lbGҽO8R&QbzCEI?pw|~pEA@_Ӓ.//[}= #|j_=;WKU^f;lqv|I \A1• tۯe߫J=QEWT{a/{WD4' Ǜ1f=M\zv C&;=@txr}Lfii:D@q&3p3i0F]pvS-2jBIU(ˆ1uDzӠ fJ"i8|F`bzґ; \xܾf8@OAVK߱9 *P:Jt|2TN#ƑkZCf4cᗹV+jK 0U3:KY.Ʈ]@@X63`({?2 d&ԃ>TJjV\ZG?MMvǼf ,ЩR)V'׼]:ˍzE=_*`-%1Bb#:'0]%{7XPŬ( -N?*rM@26fK8@bBO -{]D3+@Gn ,Kd,El͂(\\Ķy?"A;eeLU vbz"Lj#v_OKZU>Đ͓C=ln>id>)Hl E x>86 5(8``sQ yLslē`F@fXl":o@D&AMaS  []Us.ĄD^"$6 ?yggtyGo7E że1pBZ7 + u hdfW+yR:؝R l+d4fel5)t\EAS»'Dް!r_>he_2ۀ5wԪ=x .iAݰlsocR%KaZ=/|ڙYE* C<' D{igq O6 W9&@chݷ^%aF_ƀFƩdp-WtAia eKVMC `2vs*蹜 V{ ?s) )cm}3O`|-&߲>}PtOtj݀o< Ƴk*{ —w|/7^N^w2>ؓԸTDA9G1ZN= endstream endobj 3063 0 obj << /Length 1656 /Filter /FlateDecode >> stream xڭX[o6~0R&E]fX6Z'[}%V"(~!)J4ņŐ_N.0$hx12J ax:ȇ<%/o&gQp')E Quqc0gzf4~X球:1z/F'há"2[635CRPYt{3}%1Wx]K5DՋ߬> _ `ɈZ6Z?L-iOa;]5OxZrjēU&{TSbωxh?q3+hfr KB:dZN.(-63|f[xQ@mj] $Ow8[Uzb;K^j/No= Fv+Q8omȀb7bxŧZ#9M6YS x{DMC.-hr cG" ubdyoF~M 9jnmoY)2\mbVH|8&`+[qހ<9#5V8a}ۓOۍm|@ʰ$RkrCyD {H 5}yB30 w*hxRfW66#AymV: =<[ܩp1V󦸬dfկt\ `6_X0 +ț 820/9!~xF>K1~8ʄ=z*O6@}`J߅ HI'4Gwa8n8g;C6 C^߸bG߸Ֆ9ӤޟBVٔeW&maz#(̺Tm5|-ҹshM2-K%).yo YRR{x'rB)?AY`Z%OIH)o ZPZ6.KiBomG #`c*y{ݴxe-.`;Pͤ!Ƽ˞y-0  _j]<\%pz,`8<@hmJ$R-l.k-m:lS50j48Q]FԅhINvlaW=ۯԨJ tz -Ү7^%~.~9~,[>jCXriͅJo59Tl!RK5@V|+7-e~`bk[+~~} Dq \_egibѸ}UPlroY!ߛֱӪbuz +Շ/0[ >}&8d5KW2;n3< JEK ms}16 KQj!5֙ix > stream xZKsW{R-'[٭$j7*SI>_=Ie(T9f>k gL(\ 133XL,QpT!#h#M1(i(6%g4&3&o|(`<թR4T )62ZI">.ZBF:s0_e 0Rap, "Sl>`!X(΁tFE.DYpDKU4qh+nHA-50i\NJɱ.2ymῼMza5r\{!EC;C Q[`C#ЛH{Rݖwr ױb;up:s]:7ذ5p%c:zAGȩF`D1.uf/FB'#zYz k@)$19U/a"މIM $EŝI]$K6$ՋJHW(h& HQEu-, 5PG0Z;nb-.,C6cgkt>OpYYYʱ39 (*-!Ѩj_eJP9 Y"/g.읫R 4h [#ёi(V7R5'DPnCH7W6n.tmNM7y7}m}u1EtԼ|R'?jr96yzv>ݜ:fc!?j^-f;DSmUc:dԜ\{]:5߷˳.7k~l^'[f,V삅6@U=}\7vy1gQ 3Y)".;@Db'WlXNL@ &nx>_WV訮мI7M3YqXZ,`.?63/οZ^l! |Ͱ$˰;(uE8=BbkIr <$a0+)IBl3r q@Bג-$,P,"&h +-yX@=ke=R1TtD3˗/bh> hNl߽]N$#N6+E'.oz+p],wr~M`B XzAr)8r4 BR"k bnÁH"Xc$ִcCcqZ~ ۂfU*=*噤a?v6d)M1q?Zes IN/(/(龠Ƞ{"EbZ_Დˋ{mG6:_hu:?V~߀`YnY^F[puX]\>0O[_ʀHOilWDdUP]]q(g_? endstream endobj 3076 0 obj << /Length 1886 /Filter /FlateDecode >> stream xXK605 zhZʢAY{}g8$Z(>p49<8;YLɧwWnp,s]$<䮘|s/J^Mm,fI.-{ ]F=H' 0Wbos n5̼p^Og:1P7̟EYWsvyBX۷$5q%ڥ,MC %{B%W3%dY 2axJ Bfǰn}GVʐO="ibi >1 մb$?DuEWmn1ͽlZ4^߳HlfTΔhn GEȖߖqTsk,Q^M=YlVrs20y0 ^Og~:r[C8ʽ}Ƚ{3>X)vKcdD,S 1TrQPi R4uVrtpוDÃirSĝipROnyUu+Yj,fDӖ+ YEsz 132\/ŽYȒ(3'& G~;Ðǁ!3t)MݬE^~w]_ȋ ^0~Sm)kmDk4uzߨ7L+#و)Cԏ^mDscOd8#pFz8CO>[p%g%5Heo, Q.Le&$hS)w]2QWf:*]=&8sN%6w; WiF fcL+: ( ֶ9h0,Ȇ8O \> sm2_eKH9D<*)[ESnG.50* QٕѿI f޻pop$iMV$R:Th@~2/I§U߈zpK= DwT#lP5Ҁ?NbD䟟&(A9/v(M7 ۔ۨo|5.-8 g6Խj|{~(<ۃP!2ln582RÎ4"}$(jKcHP8_8Y@>t {>qh3?@w|ŭ4+ 7ҠϠ c \B(ECV\[3_co PLiK]|Qޫ B3 i4KY@ ocV;P-fa'3ȩzTTa*?R> Z(#.191dKVT+/'ǚSQIZR4M+ LkqԿ=[Xz)z#~m'AMLNcӓ&NU߆T#8%z`|أ6y9!*GE1wi5M>jBԹCS^7XwYvxw/o/" endstream endobj 3084 0 obj << /Length 2475 /Filter /FlateDecode >> stream xYKoW@LӤ(1 3ArH]avۭ@-x~},R/A"b=*4h׫?\]ET2K1J O(gdnS$t߯?f鄔%0"U-KwE#瓉[37sq^}M^g,ܟv]&jD,[Sw-v6rwz#DL΅ oYF2d!=_QjsDА_j-iQZV\ٶ]/{b^aBcU +I=["$Lx En#9pKVQ8Ս|`~fDF$>ujvH{n[ wzMJϖwvL/JKuB] =vڵl9`[2g*hMyz!IE0C&Bqmvՠ앙Mg"|%cX"+&ڳ߈N^y?J?m l'V=iY*Xd (`ENx}H Bs yaEiS21*8D,3_Y4 \+gS'ybJ#aN}0ڼmm!]XBIϑ7ePf5zOD ֤=ݪV*aH>Is'Mh:4{[$,JtcxV=VH`By nS(k1Sba=ҧC Sn턪q}U<7}NR:m6'4JcdX?e i%]=P^,[^2c$ _(TWUQ&lRTEq]PФRYqfu2尖RF}VͻRK Iuv!@䮑&>dSƜ0MhS~ *= l!!o۞vCC\N@ir +8$يJg#h+{6Ӝ4r:{>T9dNBopj~P%B`YU</{/ﰱX:BկbݥM_i,ɃG&,$V"'9+ёA:W|Çl xB[-D)\7T7բT p Y) we.MmYAT0âP:Y[db Պfm\5@c@B8v;uMu a백o:B wQ:gtql!|n\R߄gUy$8x/}N隱{ev42n/H.(>n^w@`Q(/GHF݃K}8^g姮YND6䤍g<\|,%Y6qz% - ˜'asG aBSyaoކQݎ$Z^O׍7!#>}ｴ^P-E }syS{gjϓ/xv|awTѭ׊!̔y }^W›Ry=NWtRO?D$w(n7̣Ol^_ݑfk}o\fu_ 9 endstream endobj 3096 0 obj << /Length 1519 /Filter /FlateDecode >> stream xWKs6Wh @;8L/`PKPv_]D~5 /a͌޿]*f9Sή3F)E:#iϮǨSey")l99 !]A>oB[K1 [O~ г!jZ %.Yu9:tPIPK}֓VvypZu_ބZǽ{EROE!=9iu"տU. nj)=lUzbgcki.Ad z6 GOO-t-ngh' _iK[0j7.p⹆{k# bc}y7[S5$Bn' D}b?2O0$`Z> stream xXM6W!2fDR9$m4дAh[,m}Zޢ-|А77Cz񜷳WoȉI,pn<}ᄔc6u\oS1%,;FJ Z3};sFAaHD80΁8ra /,GO!<R>[m6Jz` TZO2KLqC5+lUgePe]V8l%Pdp,)h~^.W2+̏H@ NU0JVjUe{@P؈gP[]X" :0@Bg/^A@uw˵dk Wr2@]Mzb b'Jatb1 '9IESc4$^ SxL:=2_?U%վ,ҬVBU5̓TJB*Qس,EevC% d#'4؆ "<#N2Eٸ[ =_C^I'ل>XgOX>D|Ђ>ACB:1"op|Qe+`BKYKYs=3Hx(輤j/WZ}f45r[GM{v@U5ȩ6N#v6>[Y Yй3LB*$MӴQ0+yL7؇im#696j2e5,aZAC,2xU9)? \5YtBt,QSSP5yjh~#CJϜN*^@WBWmCtpGԸ{m1;6n},S[ϙVĪb9,3Y#A ?k[I5qeMUYz 6I7럨WDK!7A}>qU/_)v-~c )qBSF;5$w|{Lc7"av16K%MwlmˆM%>67̭og ? endstream endobj 3125 0 obj << /Length 2402 /Filter /FlateDecode >> stream xڝY[۶~ϯ0 &4'٤H۠lۇ<m+>vPUA%9+_||C,D2Z\ms"E~zuZWB5bIKY6)}dzW=J@igɬ^B-VBXy"L\I6Y AYT:U"mtN_΋-LvI9l`^ODʹl[. 촛9l @YGZ9 !]P7mqHi.6Kɽ͖Z:Un( Z(k^}$r @)9{fN+)AB W Yg~܃IHKDŽZS]Sw}w\(0NٞM9\ 2?L&20&腰-}3 BCx^+?N@Tm83`*>Éh.ץjAHqP[4 ZQU~vuG+21WޕU^~mhm(mQCWs&k8ظot?&Վ,τ)Ǫ^ Wlf=ςku]UW]`q(P/#pcYXEFs: CÉE\TFkM9l_vec*G("ڴGZ4umd]9f:>T+HX&!exjۚC 5(!)9B*sksk];-AҮJa$Umĉ mGL8F &tYKC^[a)QRi3a n˹wk/I2zh3(`A8+ ke|q1|\cD&9a |PX\x[B?ˬ^-L*$-hLV4EDm+h -*#ĵ*wHN#/ >PqbWrmtp2$qIVtoc*x\{R@$ʈER.voaޓ[BŰp,txߗ M9cJ$Ѡ?l}m eu_swfd.$?V=6[֯\YeL5e"K6js=iOiv 4hK!b}fǾcZ@?-H \WQxZMCL6/Ѭ4ԇZ"'FlIoP7mQA6%Θ׈p ^ QI3~3u>9+Ѓ!<)h.e91XHf-Ds!9J,r|Q Hpa$ !ohhZ/Cv/=u]]ctzg ="<CUcYW;"~҃$j &(3 [| [ қh-AXA0' ">tKr*!qىDz#9WƈA?@i{/gO| ( <;=ol 8ŠN '^xu$ʹ̺2E4;EszY5ԷWӦHjtƅf8Hs?贁ܦśh7;7ʊ7[7%}&} endstream endobj 3136 0 obj << /Length 1721 /Filter /FlateDecode >> stream xڭXK6WbFԛE{H@Ѣi렇$ڢm6z8ί JZv$Crm~y6a"s9}028':Lsf@ gVZV%R;*&n?ۙtmϭ,tU^k߫]g:W BDl5mamOWnN?Mgg^}ʐl4wzӪ=o6/ {"f!mW.>|66̻6g(ywt4 2%4eq?d*0q?jiVaT"f%%hVsU]Q4lM@o E:q XRjw>чߚa[@bFp:njwm̴>[- `pہFfl?0٩7MKF=uFVԬw5#f bfQgmA>讵 Ƙ{Yqy8{7ܛ&>J2ՊKkk'>Aنr*hꯘ sCcWSܕ1mZ#,ei95P bO3p)\ohd'd5$MǽV®bl(- I;} '~ b:Ynf1DAx3>j()XJDl-rG8ЏqHυSxB8bi^ a9M-4 9ĠnZAwTu[%Ხ 1Օ"4HY J_ŽzfPR {:3%uU<:pA9YTގSFz{R;qrѩg\8e>W n*莾N k3PDڰA| nho.վ   -b>=htiM$!  \s Vbq,JqQr,$ /NMOlnDIo9rKodG9L1sQ}9b=_EFld endstream endobj 3151 0 obj << /Length 1880 /Filter /FlateDecode >> stream xڝXmo6_a&1CzaHCD;jd_dYV`w=w ,'t($hr0J Ix:'FTTwoäN+}?E'^[>cfӧi{Ƚ#d2c) u5!W0߬J9|;/HILgQF^Z(SNduՊ*n.z޶պdժ;)0c>Nvd$c#]+6CU#&S/Vޡ@=SòEY< C*WЩ4mQWn@.pJQլ3$;QjZ;gu3E{pq;:?m@h6ﲩ;-unBoSpmFE{٘ H2iryu`u G,QՔݘ(loܴZbUukZVvZ!L:iOI17,`:A ,SK5:(`؉k X!a$ }e;- {CGݬ42 iAmG#rp+ G /д#F.]Vx?vĚ|VuY&L8$ٷP+@h(s\88@eUK45&$49(I{"~"h{tH( IwQw'4Ͱ!uHDbRY 5i۵zy~n;a:3&v-Z=6 .LKK@3;qzDO^|߬r8].EXX a @fٍheY)3| 2 b ilכyYd=BYߊG l粨PuylQ~ґ3t˭@3iٸa4I~22yQLur=>C΃ P%O*}pihY}ʨ4ߡd8F3Q^iʅ]EeD8ӟۤSE6eޭX18$Si*(pgvݞC|l\^[^ph9ƫ1 v~qxؼ6Hΐ7̒_"wG|5CaOXc_e'֨#3z4e3ϞSN W ,Ǝ4L 0-]`Tm3$d b8蜢03# 2[פL6v3 9H˪/@9҇4v.iԛV ]"% ;|0jpp+7tS(X7@=.J:T4E1$N}P@*M}g cnr86N|5z D D.8N}e<*MYֶ0e*?qHWt]N4pNM^W*]I68:=-7^%n.nnC( S6âhU^frڝ iWY ⾰2aIizceQar큈g({~HJ.of3i깒>p(7Vvx$8s\s=K>zD}oO~w endstream endobj 3163 0 obj << /Length 2124 /Filter /FlateDecode >> stream xڭYKsܸW|1IW!urBr,˵=eeז4F?d/W6NLd6.PR ml(%΂m>"pwLXu ZDL&?lJ:?]JRjl+t2˟IGb=N!xwAIk=^Ia l " yWQfnO8J)MWb}S ?Zmq*mQuLfe]1M]V* 2Zvp.1)A@Kz k N<2Ei:5hyȤx*\m5,j|fbT$QiŃM7`xFbc5g@6:O@N4c<]_yKT4a|<)6]+81fF]E"g?^S^vsR$,cz -ye_}w?LscYr7m1B\˼i0!<2)9),V9B r<_-?;5R%W~@*^a D;oY8iI/WHmͫ{S{ۜki"]u~ʶ\) xWо άv^X̝V/w'THKؔ'GDe/EKDsq_npы_ọ:58*_^ v Ef@ v A0j`qXl@y%C !h,cIX@stM^L\ ۲1Wqܬ"zIAޠԓdX!M_eA,iCz!2"AN]d#WA$f7C;kz52iCq_cP>: (`YuL7C@1e"U}}>@ઌ!}eouۖ>9㏼)gXN\!wY( XGӵ$"^6w@|&d>uڄ&b:6*t4^ZDγ/b ҹU,1rXW I>.܃ :g[Qi+]ݹn3o}ւFQ7RN"%R=Qq޶93i"7M`YΫԖXu_z1&\?1X|:p N%KK ">w[ojjq%0$lmLݧVE50iQJ`^'$fB0 ]n`y uĬNG%LnFP6{@jDgeB=nQ }T:s[ *4L-:a5d\T$b}Ce{A&>1.Wڢf:=~XIJ^_@6E{-wP~s~ױv^"/рXDX{o3;7#^Vnr>4A\ EClH dXZ%4rX2[=+=Ja=$| u/bgs C(p .ol30={#MC3ohT*v,,$yp{;.?2(]AdXAUL"@JݟBDMDs$D`F<3qrD`†wy4v,/;O{KMT%nbC(~PXEq5^p}vZct }/{'tċ vH!c3`y WmƐ7]A(9$^L[`y\-Iڡ3M'iBR>& o䥙b!'"C3`7s &>_Sݝ)ZhGoB)ߢe{& E.")2-& =(ĵǂyGe0a& endstream endobj 3071 0 obj << /Type /ObjStm /N 100 /First 975 /Length 2138 /Filter /FlateDecode >> stream xZߏ6~_9$d(4ػw@m<8WXK7ck-A&ICΧpΰQF:VΰW6Y""D͊8qJۢ !ݬq#gQgcUB *TrF2g bl"r2WrԼp62"e#=w(O1sb16RkE֔x-b"o ld(dKkDɖQQI 2 ƬYg@K"%?r)&a neyTƼ$ Bp$EA$ )d@ERwT1(#5Ayߠ)*0HIHXjo%kli;KYLFg7>BZob[SL`s ?gBv^q0|  8ULα, IFKيLEϪhTt,xdݬ*":5IRRdUmbK\y3MX(,0 ۂ%CbR tJO!?UoUb>_4\k2cT\,o;}w\QȒz`luDx& C녺PUcvW껫۹^n߫~J'~_qx01Nw*c mA3"Sۧ}}$"$Cۆ%E{ ju.%e= S"w}6NҎoՒK|MPSWz[٨uG0[ϛ^ Cf2~Sf$ zh('V0\)EH?yPJ#c,h s4|upk/%DR>BelH8{oXCځYlbp7dw bc`11&7Qg5'*y~ CVAZujMҁ!Zo_GX^\7żzSݧ[XU?ֳ.?-X~L| MPBOmJzj6h":=NTK.lK!܎³0B؇ | 3/:sm63A338,223iPV6Ml236¯{}gFUnq[o>8fzgL(L$Yp8 l64oZ x2i?$U|J'UC^~rgn'i=5Ѡz%i^7Jߌ]gAX䘧Q#///VI!P[EIG*x4L 9 vc۝aP9uu ^ Z~# bEr;۔P+hߖZ%}Ң#i|5K@(#hq r2L6 fLz5$Bb/ON5DP j>',N[rdhM=SPU*S|91wn.?觍?'&9ʾX*ۧWU6~y)J_du@U3 E JzO<}~_ endstream endobj 3172 0 obj << /Length 3266 /Filter /FlateDecode >> stream xڭˎ_CFe>$JLxIr XӭQ-u$bǰgfT"bޒoox&e67w)D3)LWǛo|3dmMZX R"L?7;mlu٩kFO؛wɇv&`]{@8OPI۵ݭV|ܪ<= U}ө[t]jl<ʾB}Snw-[']'Hf@d6p5RGdXi 5BE".dqOIPs+*wxrvCJTPImK;<2B*rRMZtC eήg݂TXbx;(^ InPx9;eT"S=6_AϏn:JP$XM{_3԰ilZ3_o[;z/TKƟ*$W.?NsI"7}LI¼RE,Ȕi ۝4EbZ1( Y ٖC}@/$ׅJwz.WRU*|^򳎥r[iuBl˥H rmSDę}aﷃ|R%ey|jp_1K{p[ڭiioc׌ȅ$(/7geLOiY{udҀFz-q\ 'RSSjDt9Xwvţh?C[Φ P|B鵢ǡSâjՙܯ\ FP"C)r]!S[1:D(^8b&bGȜs$1)kX2 ދH i=#hph~u >!%0hW#L䈴kq:+siSϏɮL:_ \Z)4~E2ne_N5MH"|K*Bu+sI.F.-5ݜDa6 (Ck'(gZgby2i.QE$PJ 5kbđ@ a%OsZ拼F]P#`FMX H x}Us(ޝӆ@¬2o\E eaKڐΫ}IWM׸x HOSΈ56;&ǼsEHISc_)<6Xfx/i[؍_\& .KO%[pȯi Q-!G`b%".} (`|NߜZ./>t`9Q+]H^8%T} RֽsU%ɿZb*>B-UL*X./xlB~гD8ɧ Y ·*3E/γ1Д~=5+c9/D8 e$<-umNv -Ֆ8ɾ@gLoEJ&DطU4}йJ<zh؂"RiV*S]*4wW[\c|QY)sva.7{0~Cx94 Rċ~Ii7oD4^yKuv]=GI5_U$Ѥu7ؠAy\)#e"H)wu"FLG$zϧ._cPkvrנ)p :~#.-EL CYFb |BZhqOc %Ö(v]7_c H࣡-bU QFM;V?jaNZX;p]!Tl`烽|aTX_Aތ rʐyyզu;d[Ap2Ay:%h,E;V<@g<8 WT0&z>ȥ.{Ef_u̞ H ǠIc @TXb|q*K SFcC )iX8y( ȴГ@[YXfmv7|ﰈqlvNLqeSr~F VA.[NӔibɚAv%x\PSs#Km;nF楘Դ@Ǻ(U,BHEZ|)#Y^@NQX9whV⯘{R|Z[GJt)$0-xϡW 3wY܏;X7xK[[}Nk[^[]C>WM 1 zeENq^g*>ȲSh/ V}}"\R?E J.~16B| jX} V$f &:,liI\Cd#FX!bө7:>/dJ&3l/0ե TL {PR{] Э  Hwp|I>6+ս~}O\~. HIѓ554rJ Pc+\eᎦ)iMr<xGk~%[䧇C'U@HYtzTlTAEb:WLEIv=LNs??&M0 ·G|6,oMלtMmXO[:iCd \N"_3MbEF((Գf̥RB\r%Eei?=pluFwHkC]3i <6 a 0ſW zab˂=,7f_߼E endstream endobj 3182 0 obj << /Length 1641 /Filter /FlateDecode >> stream xWYoF~PPq".qE pɕŖJ(;HV"-b@ٙcIg73:{qdyGf/@ijl<|<9QP&EN~g^py_K[%+5wy:\(pZҶ&DuUݠhZʫ\lrSsI2?'2u &zQf#@+zYRw!tgLe~cRHN >SʆQn~H|8gܟ28x\_KET ם4;Ѕ}daaoʄ.P}02tS֙,pEie0]mFڴvx#M7"}ˬPmBs*)L&7ʰtdڬDGXw?.:.YH$+ŁcA^4M_o n_y*F꨷J=~?HBC+9ʷDa!$tz'-NP`ls#5Q^6lo/A+M(ax1f ˹6Iy%qbn2z}=CԻ~0 jX)^Ɉ=q{ǑdBmZ&@ NnG@ #J;]MFIQǺ6)U{ejM G2}/XćVY/.CEW#GF$|o|P~3+x7uGƃ^1:*cOwj! 7_'*ucvS\*|7 >pEp8dTB ?i|Ц_ 2 endstream endobj 3192 0 obj << /Length 1018 /Filter /FlateDecode >> stream xWKo6WN:'P@6 PZmz7/IQOfq8pf_f6۵X!=Y ,!コ.eZT7O_onBBa(j0ơ͠9vMH[ : VrgH7g&":u x&V<"ұ#he lo0\Clja#$ў1K0>i[i=ngAl)aP pPF<y);Q#M%xGTӏ*ģ8"1sIʇzt)mf%gjsYGIU&O8ИS7  endstream endobj 3204 0 obj << /Length 2124 /Filter /FlateDecode >> stream xYY~_aX7fNIf i<,ѶdHrOT>7@X,:Xj?݇OAJDznRR 퇫H)du~Z{Z^/7BĪc-0A1W*XOe!k|z4k@*Zm&?jH~W=tt۳ݴN^싮>_&v5i9.m-KsoۇvQ);8EWm5tduɽ;~A)O9+-@x۵յ- ޭZ\*=(M5>-HB\ Dāj(Ehj;9wuiےEc_QA}G,wE{IҾ9AuQu-bpch"!BK͕h@$&LbE1IF! ๝ u: Dnx$[FJF,^ \4h`XSj,-SK]ʹɊ#} 芺/ )qýM iSےjaFҚLifa]>$Ic#nRG3u~h-|} x*e/tXXFh*bx`Pbuzlf=;'}cږ 46h7xis"uȺ>=PUaǟLe`Q{=.+o P:lg)T3An3 OI<\--֖Q`sO.?!aٟt,_yC=g OBAA.c1oxb 8cA|a Rę))`b [.P9 S[471G_`ȝ]3!kfpԊ[|S2 Gs-cCɧͧ()|JM74XMq|R{4$]{5WzJj2qH:ɕ~_R `Xyʩ3vS; "_6Kˑ*5h{<|ikj2X`+gWz.n3"-#&)8ifک";`BcMʑJv8b'O ^0m4 ;+*;e{ 녉wqB5n{bwФEh|=쯦qkPf;u[7~0C I维1#!& HCxilõ)XA-ʎtpa8Ci|5St H`6?{Nf)٨3)w >3v3YQ6A〯PQܽ"=@D [pZu"bտRZ$쿢=} :ze|Ĭ꫑0H:d~w"^;x_j endstream endobj 3213 0 obj << /Length 2239 /Filter /FlateDecode >> stream xˎ_aem`̑D lH!۷+K,=_*)QjM? U`s﾿9Il0& C|s_m~j ڨ~}g',sGk& 6{cǓQ~.1>RP4l?m4rxP-+la둶#A$k8Pw/7:Yxr y4 fA 5}O{RhdE^lY5pp|'!bATQ׍k{@sꅭ(o$X t/3g R>ej#dv@]A}E1M G)[ۀpE[>4cBjvĖE6W-姫Um붗WF#iŎҟ3'=}Q7gNW*y5T{g $3g2PɲYV@^e.rP 0@/gQe,GHηT!tzLBW UZu؍nI: \W#+v~UN8{gE [f3{U5zm}AЁUu/X>1 |bƌ_3 lGA_ai>L;v%) Oub8НB}7"Q8MEU"(ӹ YHZUHpKws"114'c1vc4 д<({i%R6 u8gy4DۇK"cavB7vre O4,cLa90M2xA(pZ]vjº g亳ȮSfRkFB dkCqp. &u+|qS_V0'ʅsT.ٞ3 @jPg XaQS4&"*h96.>˟ڗ,L:6W> sfBWoL8[41 srBnߕhZAG_dv%WuBQ4ae#mwhhTDrt;^K*N}&FwӤe0L xmt}A:sqa{\5iUO+o>4$hFA B1Htӓ'?Vk$bV [ǃ$0IQHO̙T-;#XWTe(F˓ld6"yE/ ;8)!Hui3<vl욕P\)vX9y.qJ+ 2HSzk4x#:^eW+u Wն- 3t> stream xڝZ[o~_aKƀH$u+ Cngıj=7RkmaC\&Ço>|}ZܔQxqMv'I桺yO_YW]( :6IwXր٨{?^@V^V-x0eJ;{ihk#/I @@;DTxS\* s3F:!ѻu8=r并\-'LREq{pʢ2:IqZ0AUem,npe.yZ`OdJaAfs ՙIB{ m\T5PWbwI^)Nr) m-\$WUwn,TwsnjjyE0hC&Ƌ#qQ$CP!grǕ0wI@㌤Gp^:F ~.-/g k5_z ]j[U6!*w 8}Ǯ?x'ي+ZɊE"PN3r[*a9J& Tty/-`4҄W@(؞Ih]mQZIWayYcj"QFNgCFBH[!/"}Ѷ7G3#hrX@iGO-b8%" _А⚒X%g!JƵjD kz ¥S:=k!I͊/arI-l)4qp``*~x|m"gE?1Б3aAa1+Tԯ"Y *ŀg{M9CHm'h> 0wI,mEI6v߷1p>y ug,BТB׎}pohI9ŽXۉ9n'6UMg8-#*(8˖wJYM(˓᧿~1)"suIǤ3_;f4 Bggdtu[6+l{`r5&ӅqM0{/#/W)xJ:4oVq+rRVOQgŎ2Pgj:)Ug#-RqcHM[]\- c#8j̳0b5Q*oFSLc[0,̚ L&|Ayx.oCc6۳$ Y]IPj}|`|~=)FTllzz yVrD~K=p NaR :ez<+̬Ԣ. hŅA9~,Ph(+𢏿;oBl 8]Q\k *PEߧMI;Bh2pbN4Whcpaȱ5ĝ[uN>`/ڔJ(s^\D=יэ,OP,LgK:?ny &fFL5jyb9|͌UOygoJV( a^]Nbrх$<Ӳ7jR7 =PwI IGg IY(t^ԫw\b Dh :vyƏv5U[c"g*V)~s=xk1"T>i5 6r&JҐ;n+<4iONއ߭TbD%F~hW,*'E3x'S派{) endstream endobj 3228 0 obj << /Length 2086 /Filter /FlateDecode >> stream xXݏ۸߿Oƴ((ڦ%wZɶ},Ѷ.hzݿ3Rf }4 7C_]2A߯3ƫslu_~:w8ժ_]^mY̒,9|=ڵIjm6WmQ,K?&|OCyקZ O4rW|䏕BڼOj{yOogٹupm/Kն_^cSq|F]l/NȚYA7wyWX Tm^a./:5:ɯptUפV,%,N>J8]̟ýle, BEBzC^_q!leQt6 |vGKj I6{Ed=dW5'6%%F zu= &K,e'|(䛀T ~LQDR*~WP@H& >~P#̲ahbsg%aƾղ=G+L߰yo>|Y,% DCK|uL-,JNr6X!6f-Q<1]阺1(tۛ:n0'`$r3p Y& aeGc|Q)`[sOrL$qtO8 {;v01tor=doBڌ2\%R:rO+fpC t:Օx9ӯTK}3\DLxyj eFzM ST褝#ɜ([us˝wf,!H) 2"NTge26Vτw̠LfA[8*jU0?V-E&xBw; R5U'Oa smTl5SI`UYVʶĄj,Z/=XHfIx{,@ng&F3"u 5b-޿cXY]>ȥ̏ns(LuߒA,FՁ=ՏFձO|fNzubnomspߘ2G&0tn?Uu' xM%}u-5ܳ$t(H Sg$Q uI茍I@Vj D)/`!|O,hٿ`sjO Qh.fI8::ik6OX U4p7 83?Mj6oVd ǰGՖCABNq]W\Hꪸ@SdROynO-DRa:45tfA L-,] Ծ?<[z0QRD t1aʖ/W6i,OZ_Ĭ"FTgP]Z-" RoR759g̟/xr"9M󬢌 nE/W-|ܢY˂{PRx1iҼM$`ݶ*Ī便(fyحh;'b⠩Bd7S;̺~Yl17F endstream endobj 3236 0 obj << /Length 1058 /Filter /FlateDecode >> stream xWKo6WΡ R$a"YtCh]JԊ#߾C-C4$3}3\C[ g"k> stream xXݓ4_I!a.m=@\;みrl'LxZvq'OE4#~xKh9瑈}鼞q6Z2!o~~&Wh8MAi&.R'i84NI m7nr&nug̦9[Ln<2.E[$3dNdRD.<=kb)؅KIϞ=3˼c!yވU7'[)8Λ V@#aL%i0h{hH(BzƎi[wT~o[hte/.O=B.Nۏ.X [dF3aXɋuw[)a&AnƱ8@Ϋɯp5~@FE7{H8 ;(4Tl4.~3Jt#Qݮiݤ_4⊺ O8,a|a^@G(xjKH™A9J=3lw ~IUW4 7+~^3< g7#-Q^Pv(Q8#8Y(P]kvs5 JxNRM-aM8$ =P UFu)L!X[TOTRk֕]bqJsi0[!tGPi1zk3DPGǍ\i8lod6x0ycU^VN'y a'1iby$u#+Eο {!IJBجǃGiP^dPSPW۶)fmD2™->ׄaMju %G- `$+PvRjWve>jx2"dpQT5\S6(xBqds915>r^y˅}EшM]?aFBn˃*ji23wnB q]ܘ:k+]lYQq]W ǏkhTߵ>cq쀥+ mR+@ķH;[@:`w̰clgCDo-89-`' /v endstream endobj 3250 0 obj << /Length 2556 /Filter /FlateDecode >> stream xڭˎ_!%_|18 oP"%1K2ISU͗8ɞԬwU׌\Wr7?ܽy1WHB+%06\EJ$lZp󯻿aB7*X;ƌNoM[kQ(tE]fc$YbOڨ)p#t5|_lSĘ[u׬[;ݞk qCb\վfyЭPXM{ CLTQ`NTkFҊ|qݗi.KSzۜӷ i+c̦3_QPaHDzK_ ;V&=^uեEUTǙ7:XMʜus,FnSώF#VyjCtd4`cPa11m!,ijw)=1S?]9[V]׾khkFUB艜⦾ h|[b6 2RDp0Q' F):]RCZUx)뎠ix>]Ht%aBXq^G\P Ժ,I1sI\߀IKMi粁CخwHдS }aR:A$2O>B.X8(gNS"KԷi8?ty[G0 C7,60ph.X܈b{Q`7mrO7ؤ-Ikς1C^1$UsQ\x~@`Twy+j)Re_`?ի?5mvuN^GYO3dF'Ҷ2di >?>?o o;N9Mz|Lȳ$w' b4 nM2v U^2x-%LB-ќ'DとoFM}ǓK01"$$L.~q)==9p/5 B`"_6g..Hۛ( @`\w2opSd Yq7r/ə i # }Jk9MiM~`&Gq5]p;RTQ sNNm+RHk B# :и>)şI}UA|MFij (c@K8YWw*5g,;;,%孅{,ߟm1!K> ;ȶs׆?ߖqQ(oDy Aɓ$Ia!-DDa01FG~mf hYW ;c߭v?Şwwy'B9vYG-P#cJWdyJGvr dDcep{2r{P}=:>~= 42wCnN:njoݽ2tG rmiY>G1Fq0 ZS^ 9#Vq!?aM;Iihgi n 3~~;#~rF({ǣdbA١4NilRkIOm62 IAI]%Noߵ_̱/)&yrf I+$=FsS=7b>1B Ğ_Ļ$q B ZA'/jXAnЮG߆5gY _Rk&9CSOk׋(QI@ xF_Üu< M! b-IIˬZqݛa endstream endobj 3256 0 obj << /Length 2778 /Filter /FlateDecode >> stream xڵZKoϯhQiDR{ EqC`hmkzקU;|hH-G]ݟn}.U",Rn8B]a*MWЛ}wn$_lEfE b!3\.w2킃`e7fitXv'~8=L}4ǮvHky;(C}:74hS:+"Ic7/P$tԖ#ɑP$bTG"?(@[;8[뻺 *Ӹ IpoX o̳ٔHtR.WI_m\?\,rw쑇C݁w$,-R2Y q!%@]N;DaipMU#RQAEYе΃dZPB MYhE*D FRE |*VaI'ׯbe^pk;ovf,6P4%Ti]ES戶t$UsbҔf?JĈ/ihJP `y /bہ0}h]b0N<&f(uS֥a{PCN8fE}75,^ IvG ;;n!%H]"4}}>FEhOu@ g*P[o)R(3~0U=?vp u8cu]@UR@yƺ:q'&aPꁙDv/c'aqLIXUN~I*x1bM"dT}5_L|>l\ >Cd*LV`7/8|E|D 8>s8TYאtuC lZb{r[ Ľdڒ…lU8{Sݣwʷ<ʽiTF+U&$|`JTSo >m=֘hy=osŹN! ~8^ zG4H+Ye3UPyBQ0.)ꙂL{ .y@ E~CD7&Y8/{ޣ+2`sjBkڅ 6ǡxYy~/8N>/1.R]1rHO<`yeAy8(oԶV5`|n: g2te7V6mT޾̋t;9tbh>cx|&-rX-vYymj*G}`-e0tat`Qn=OM}0!1%yqk7(a`r'L?ƥ|{HF[C82/Fr=✘J5h["l Q06{2{,HF>%{EWDOqyZf\; m 4f/(4 eP Q毗2= <5*|+ 7 ?"J%$u7 #W1(5ntpRḦV8ER8 ;yFgޓsWуuz٣gC-'R$?=ULքho|OaN4ЕpSaYwMmq:I.uE8d5#AB %mì]򺝲􎒈$w ٠_/2o[g)G|Aa `MP+0 ZZ!" p3D0qR}81nQ1F+ru& [9niJC|s`ـ{z|Ýq;LVk͡:SJs8~*$sH'VlmlU {Ws鏳Pr0~W_QV;Nvܵ~&"sI˵̒u:Ѧ42-Σ U4}yPw>"T_a/̗A*ؙ9u~qT4oqegjZl"ŎuxN_o>p@kO})!rgt݋vž{B|}9Jx#,_W߭rmͬR(BS˟-YEHRH:;Fc`y=m,H!'V]M~iQg|s՜6 BN3z!ǺѿVansߡkAÃ/w -uуé>cTq ˔S$  p> stream xڝYKs6ϯEUh 23)۵9dQDEHjϯO7H~$ﯿ~Oɇ7nߜ'Y%"9]pH&'0o?ȑha Ō/0(Qf\(hhp)fHDA}&@sۯ;*wm,iS*f<(u1?mE_n *TSf"pGY vm=\,m^וj<}ϛ}Uuӽ&ē*䉽͊J+Sl6mAjn\eSSâf?I,f̨nSȢ/hw͢+x~Nϕ+|ɠ+7`q+bSfZufzh7Mg^H8gsdie;5Lπ 4 LED<ŕj7Nbn,(ĸkֺJ&u]TTU , \➇!쾵ζډ.o 28q t3xiz/L.XA ;=k?zċW~(zeEYxY8 +ZE othˮ/QTfQ 5c g@&>IawDcQQN239 &sGnq_H]yAz27gٔ3:qIxW!S|j/끔hUh*Q^"rvmoȇ7u4^aMY'.Ed)<&i(Fu]ˢ5A^32S3`D \`]Q,cuF[e!WhH Xh =EN gȒrYGJDI"a35B3ܢ @d2Ȼz*}ц 'k1a䆈b/b#"$K#0J,Uu1t }~v}2Fb OKJ ҄-hC\.ZzOivCoޠ A6 ˃(uO"U uBwgȢXzyBΒL6m_o`*PmAؕh0{o F3c!\l7^k >K9Q#kO%ɳ*K< b(tT1KȲDXAA1S 7uFh0zs_ѧ{m Q-aqx$ ı Bh'nl !Q ^Vږ W+fƮק6 ηӘ8fRpҞ5Pbz "{ØIZ%{Ia0 a:$̲) FJxŖqyq Sv$7ACbwhM?yX3ԆM=qz InsX#R{žeg*^ƣBID^$5\d{yKƀd qZ4=X]ѥQz>ZQ%X+|ȩI$Y۵͟喲f%DrTŃhV=Y([+{PP+5^ IkKFD 2 fp 2Yppv[y [Fqv mBC(4d)8'q&4_Y9@ vqze{m(t R Dā/ƒhqDeX(] v}Q-<% ȼ}'6/rم.YzlXN9˩\݆*s;vv' j|16h]W]Cm3bɐIۅX$/K\ ֳ{{xv 062&Rr6@ESDRǹeuM?j j@NL4z/8x/Nn56?Ӭ{m_(J:ׄ8=*#WMpI.΢$,Y!O7o>,LMV1>~]A<\)8:f(C20[;kv'oA$L1ubۿC:l迍Gt~s7DI~}O!?s(Rnw^݃FW]Yc`m}qD+-ռ+ViRjha]R>a\yzW}(LE=ҿ7t endstream endobj 3169 0 obj << /Type /ObjStm /N 100 /First 976 /Length 2023 /Filter /FlateDecode >> stream xZo~_ǻrpH;=N k{dHJs %9rvMqqfW3cpƙa1 B4>d*$CЅ M UNL@`#h$F$'gR*{KwT\+؟tg]b]68VUT"!f!D]@[XCHMK E{P$W d5 9a8Hdx  A%x5"XTŸ̈́DY%lE?U増Bavr=~ u_B]ًav/\ " +&TusB[Q,R@X0!Gb"{X%($F)S61c~aŋ Kz 1hjň(A50)g+c `%z[N"A?;%I]97b2gEIT &JUM+ 퉫)aDLJu!FUOW=Zk!rJ)=RɓIy$i" |>LnTmrVr_(b}}6Ԧw}FNi_.ksqaKA%`dnIVjm/b^NpF'626m~^.߶k4?xiwok[|0k'+uIsծj^뽿7zaRhP b=٧jD p1HP6M}}dvO9pZӎYw}z{xaz<,K>¹ts%HeKXdу}m H;6U 8JETDA`Q~d:kOóf}͞ Y(xc#(G:^Fŀez.[&tTY/lZ:PڙlH7|x,Of[fwŽt~TQF4&p[l:u}3qCbI.!~umn_Qx0ۄaZG=jxxy\܃#6۬ Czx4k͈B;gB"Rr=14=H/- .{鱝;b[NmG[pӁlx)f=T#oxyi@WĨmts֞{d$A"~61ؒ K;/"iWc`Cg/Lv51Z)d_İjgv"ɐ!DR.~}{POm/2f{ endstream endobj 3275 0 obj << /Length 1056 /Filter /FlateDecode >> stream xڭWs6`i )$.5+ ;~}W_`c'I6+8o뛇e$^/u҉[ΝSt#0OՑH,8I@bdqݝǰj7TmKO$/=Y0 W+u{{{.|AS9HSTX-`X~'D^ -P^ӡ(ˀ\C`;Rt {>^HsۯnJg^N4Ce֔H`,F4ϹZSb1̷Im$ U!FPa#_a4́_}F RgxF%vˆ7 ?KDRD ]$Ye$7sx3+̒7/ ǐ^F`c Z(p&ޫh! IsЮo +K9w M=רZ#KIYM#)pw f'm5ǞWߕT?ӛf6B N7ʴfɤH@i4UD8N Ȟ&Qɩ٣h IVLgHXi}$q/71hLyՊOw c =ƋhƠF[T׹㦭EPm?Yǻ0 qa&C(qiֈY֥:F؛G5\e8|}0-*e.{q|wknPa$'=#V~!Z7\܂X6vmIMMq.L^/;KNcAUqBM -;5lbؼFpq@鋍2(χ-.O7p$J,V'%PiQ\h6w0KI̟؎ٖ(y~2MwvqnKTu%q=|\( endstream endobj 3282 0 obj << /Length 1288 /Filter /FlateDecode >> stream xڥWYo6~>ح͈b]4E tn!MZm:\/Yr ۾v:G?<ȉQyX9u'4vRiBQMgx27/r6`_bш2N+SV(n뺪r͉1:&>gdIr;1 )P[ë&EE}4˕KTr@Ĭ\;ZE=Uk rYې#W0I13хÑڈL\,q^ߧfFG]ʇfSIӳ! D У0ϝѯm:UG鈀*>rɹ^+ 30-⻓AWV. l6z#+Ⱥyb9́A})]S?&=) "U}+BMWuKLlβ B%Ӎyեb$T()`w?ž!'2Ǟpbෆ ! 'Ȗ cl*㹩؝w/E&t0&u:&LJђ$*(U=Tω~<^ @(d-PB'MrfZ1*e r-6p3Tq̰/^u4V9?PTɌ΂?@\,xR =: endstream endobj 3295 0 obj << /Length 1695 /Filter /FlateDecode >> stream xXI6Wh1E+v&HQhfrJVh[,Zf}#iɣ fQoQ(RF@.:mb%ES Y3~m1Ҫ(%@[lġqʾr6p3WJGY{Vl'g1-i]Tڷ283b#Zx iQSKu P:KV*y /~mB,Umd:kYuG8h F|aW"J[o2FV꾫!CĄrLqv "d]`е8! l;""H~|]zj0%qWszRwۺ_~J3UCb)?i)[,ڳBtƇy/P/N_϶*Z/纬ʵAQt&yIbO'~ AU_HԩHV}PZT,Pe|*Ҕ J/M*N;:U``1zW1=ʑtRZ$b,BbRVva-U=V v]-e;^vS,7 s>Z@\AcǹǦ\r0SԢPpn` to:"q}S+b t Qy+H[c }jTPnx!̳<lA(Tso* >_x҄0>Ii||N)4o> {:Wa:@aG]S1ǫ}\3_O \X\}St0$I垤/N1Wlf3sq=4 endstream endobj 3310 0 obj << /Length 2534 /Filter /FlateDecode >> stream xڝYYܶ~ׯ9U,ީ()\r)G6N!1;r1jXova8w=vip4Y}SSm{Ņ$xK#5헝-۫n*i@}eMC":Zno M 5ev`"IIjFxSI" ʽ YZih yP:2890eh7`mx6pC?nAWa+: K^ W$5 9!",i@E7CΑ#}O- $?._{iZqij: ĩ'\Q,i4ڂ 19+#;Ӕ-| nlaҡAsq =)EQVO@δ2x~-M6Q"3 uC#.;s5Nέ24*tn$_]]she )f1thFs/[Z+Mm7M;Za`p>@ڟ_ݺ4 h@"XH_}^U*ܝ?<-Q@8iZ?K3)X4ѻ;u! nj  ֆ3i1Z9&QUќ0EFʝU n N `)۫A9H#n3Uw2@jU4̠|tJ%2' |2N.8ġ5>Zw4[? Qx]<ҍA:ޞgq5ZDxmeh7=(_?5)`L6)^ɢ c@5Z,meN32 AL/Z:s0@ބ@>`f`Ye91G C ~}!Yy{QsE|[>lPd,eLdKD$XŊvjk$΃ B߬nכEpUmTjhkb$*0v .`bL>|U ka6Gsf7xR>}cKJULTĀE#,)<]380SgrPGC+A&~:ΎX~XFFd=+&4M:B 9i9J%,c鋇8fy$y8=qtip:l *r"ſNxZ!45i.@SO§׳G)}V@kU5Sv".SP@mͥ7ktTd#5IUhjq >˪A{ط9+her eG"(Xj[5Tf˒Vd@y]I9(n.0{lIX56\6 ~}sSAƛ5=Q) 1sFjV[7OS0 kQJ25|DM?aKU8R|X:VXkȻԗY*V|E}hla8^R9|'#=kh;)=&xLM4xgq.Wсꭽauiʱ%h W$XހJjidI6B/c\J+ 2È"(9΍ͬ)Ip2NohT *O;K,zʸFtbs1~_4jpy+>`2W:1`+:pw\eҾUՓ}gԇ!Ms w> stream xWKo6W!61Tԇn(uhG^%%o_ߡHɒ"I@[2elf׷5B- 9.1|qBc$i*[/)9!A~f:r^`mMۇRfe@q!vt`G$ж...gY(;%h%9SVTII^*3`2T[]_ NZAwΆ=Bl` ƚ6p6K`ʹ1i)tiWOoZUR%z>2~\码oclObK<.2v,4Yt $w&c8$Dpbm jߏEG5岋xrƻ,x5¸ }@0 &~f3}A2pG+n mDˈ#GN0ΊZ -ˮǤz4u>V\ߍ^u=0Γ`1绂 ^PsP;tS~f%Sdj;:jT^w:s= ؅La'[ARսPCifTnp9Ea)p)+u11QLrlЉc U lڑ: 'mdixhiPHP2IN4f+`dhHӠ!LeR-GBR-bY~죴0C:Eɋ7?|iB4I*άc/.LTIo6뷭ZI9MSyN<*k᧐?R endstream endobj 3340 0 obj << /Length 2682 /Filter /FlateDecode >> stream xڵZY~_a˺1Gv׿_I9?q%~4ay&ܱ~'ȭM1 tŖ)g2f-$ *;}:8Q/*w! tF[{J Cd)yyt'2r/cj;tY^U>hE_FWyDtRwj,hlNP#EOh gDF]ۼP3fu")`z>U-{K:jK^7ʞFQ"]k[c$[;eLq@!DƷRa%s''Xy yUɔSGhVfnj7 hTÔd7,ҥ-(LZih;Q0>_C`KpCP@g}'XRM Brn9%ņWR3C+0N)q \*|JB*:cTqlitO!4TK:cS7G K NWh{]h.f]Pk@^1uK:,& XLT {tg,`-+fv&*AU4\WP2C5KM*F'~9 +TUQ Vlf}v`g/ > stream xڥZK۸WĩZ|؇ĕuųTes(hO7I#KN@ģϯ Wp^~U$JVwC&dRDAcbge˚}v~$&L),iG2ABj-֑IqP7S"jX6e}U,,K߸]’Ba`vY͚a)]Gqt&mu70/lUʒ/CߙV"̧bA(&#Z88xz(l k uz6EW՛4fK94-4=1zƴnvYT&sjSd-G g:4f[0@n׏e"a0h~n&/~(w}%Ц1N#AŤ?~~u*`QjS:k4FYD4$,LEJ/gJKDQʃB6(ȳTrrLϲo;=uFfMmJC#ieesJo ,\` ߛ#fe&:CRR풉 ȗSu8,Fd~K] OXx g,6 uIm- u2&ES˔1P7q,qfrp/g -߮EpQcbaTtEc8}Au$3%UTа^/99:!?_ 'SsYָSK׬}+): bѓ{mrQأǣR 'qtG7$\%,UB4_0&SI A-j2hk|Aז|:ħӘx2hsڪ̉;p^iNwg3]bދjW sH\8Њ#>r' iM#&B/3x8t rd[&dA{nA[=d`(bTs[K_Cݚx-*~ /WzZo5x Ŭ/D)|شmu^XFaA$lHMEp@7SަнEw]$Izвs J"C~ ;V|n)a+u]'݊)V"R,}y#"%$Lj?~RPf7iL7m9:)] 䡰c%i:>-j; ^ GDnU7T,Tj<W Iִ9l{2ԨI\W5|Z@FfJ]٦c~1D+"N3t>(񤾚f+wIFd4>!Yy{$]]3:rW O]ݐFm W84 Fp p]ӱj|j`Ljt !s'6\k׀E٤^JtR% } S\~h9-e-CGR#E9;VTQW.zq0Vܖb:G;zngeޗYG`~ǿM3E\Tz萺'iI&d$jZrܾ>?Aÿz^`a;Krതf!R&x:p;DXz VŗYpo*Eۭ e<3 ޼|ڗ ;FV&[LH}t|t 5*>B]Fےhӵ㤬^Ÿ}iQw7ߥv.ͳ-t.޻W䥽OoMD#z,`>[2O J:=b[RZK- 8L/>r3 I> stream xڭYo6b")4KsM"qeB;_3JZ3ÙֻN;5.rǥ5)؀EFcE+,E@?V"UV~uۚmf]M}_8B s]0)`kfnd0W7*횺X)d$ [T H>E0/ ͂\@j^vuCv4rۮKHUhڮvKVKX:†'xh7E[#jتPX|! "€:Z$A%?v%Z6):B Bw6|pDr@ xS7"~@jmzT+hPui6.!Y;-DgE9Ţ /ni? J]B2]L 3ڒIC:;t۴KX"؏wK!lMau)" W ㆗<[iEؾc(@MlYgfVURKRD6^{mPУd]8̘[joōGʙ4 G^uLZOh?XPkVM 5RkPiÝ{WiEe4v}> ͊`q,Dl!.!r\ym0. Tx x_.H@jR9W >a}rU h|%w,ꭓPܩpA|t@KT8@ķ9o!TfL}!ob}߿TGᩃGW+TL?YJ/Ӯ޻h[L*2 @/ )W'22$ Lq9o!! &x}ǵ>1Z$G7=K:TIq!rõ% J;e)KaRcQa<࿯ K>G|9%69M\ PPKWp ͋/M[B˶o$ ɳz]NJo5u;lwKs4ΛʜYf|$`ͮINurS9ث~@*'eIB-D ~7ݽ)P0H۸}=v_s;{ŻeȮ 7撅@) \NyͶ02:0Kkö~͡&} 3p*ˍ蚎k丅4`7N[s*2\5.71NՊ<@U/W/`]mb_ݷ||hA endstream endobj 3278 0 obj << /Type /ObjStm /N 100 /First 975 /Length 2095 /Filter /FlateDecode >> stream xZێ}W[1 XLj Dɴ$ZTýR {fTT<'1xNєɐxxC`pz`K&@ OurHFds29u%(/":p.bՌKb >eC(l(z+bT`\u@,{]z Wxz+]#o%0BE!ֹp]@#y¥*xȫ>%#瘱5g̕X^ԧP bDF{8a=FT^aE#^t}Ne]Qe]%X!$JT8Qi-(433%Kusk@KF1շ1բ/3FEwl4"׹'zO P" d"=Ai0f;J HsLuHvSz ГJQJk\+B7 =J%aV'#bj<7cORޟ->̟ /eeV]gɭ2~ (l!t!Zht d z4MAm?ۏcEPݱ"dq)XAe<~XFi+{-^Χ ϒ!c '=fW!TIΠRFKyEl I۠t4!U֮xp{m UZ9,_a\pp}p,b8$ t6hwKu/D/)K}"τV(>q0Ca@f~I{lXLqV UCxx9i[|wwwd'njwjwnݠ뤂 ZUkym xԟr=x>FCNe;#ͩCz~Uq|v0-m$}e&=ޠ{ S^f}fMޏcv6|<[.٦Kqžcv5>o'β|fg.-j*dA;я?.ǫl'@E dvyn<%h]WOriȬ''m(;u*f2R`ׅw Sm%G]éG(C(C(CHHHH̃|TTN {(ǩXC9Ψ_4JȠUKPmq藪3Iywt~[$;oo~ 5Vnqr=0yJZ@@=%w@.kczSEvH?x endstream endobj 3396 0 obj << /Length 1459 /Filter /FlateDecode >> stream xYKo8WaebH=( Xh`ڸn%JI^Jخm}! |32[{ػ\QNC-VE1RBroQzfh-zymG9Ei5ƩR`myh&DiՃ0Ț,H0ޚg'miUf l):%lQAHPN2ۛ7ob֛Ar ˡ䍬:1Q8drݞ mS n+ɧ+a (ϼZb@=#8y?x<{qhL Ň7{ߊ`K'˞˷(rNBQ;ᩳ׵wx O.t8Om9>ܻ-!6.n~{}vI=K^s}~:Gyl{~`֕=Urc Ba LםJP×3U&S6]Dbzom=c/]\e8tb`OkG!jj\?i2 $(K_vn!wp Kq1N^wqgָ ngV_p;/Q/#yy.9~VwQS}wәQ3Ĵaj 1<:eV31v{ySh$Y_)6G1m /^XW*ϺlXoy4khB[7kd:V6I<_NY(N ~ËjӍoeלSoD1ci$B) dnD]О{kW+˝Y #2dWm$a^"CY26;z=_"GG-SwÄSQڙ٢C%f11}F1`ހUl)8L-$݌&?!wKyṊ^MEc 6ʌCneQril<`wJNvQoe endstream endobj 3410 0 obj << /Length 2598 /Filter /FlateDecode >> stream xYKo6ϯh60MDJ0,Ihj8_*4neч&K%XϏ%ouV~훫aY,\ޭ1?+9~VE]?We0aB/ SO}#n_}ɫ?ݍP@iNֳ)H[NVח`n:/q:i4 M&~[bu}zWՋM6IM0ـ0$~&/`]ڼ*$t>"Eu1.p3pE#B-Nx::dN@Ix3ă(?޸e;˲rƂELGOu^yWQ1Jqy}B_g؟ ˒7o-psCU-ҹ \CJhO?Ba/% F .ùC64D. H4>Z`nX)nH03,>1戉u~Cf0|rWVԨKHm~ !MZS(T$vX qg9}ՕeڎR][07i"D޸W-9f;LqB3)Ү#ؔ`Pj:TFw`yho|Zzyl.$);{Pφ p/ږB iRd*keV୐mгd`ahUixGҭsQ!v&?",41Q-/p^p)Ա %\ Dr$W4ARthf|Еv! ^ gClY"$Q:7v9+*GωhѸ\Ȕ@ERNؓ/yGVcBpdSO 9# ֋9QLNMd#H䲢4itsǒIx+z32%,(ul>3S07 f>Aaz!pGŝ(L Ȉ)H W>λpkڎp Gc1#SQșRo'pj \ٖxzc>a0H}ۺoko> 9rK =n8)kx1{CwxA CDE^dڔȜj+zcTDP3UY6= 7\ᆋY}j͗ u0UŇ) Q9+,OOXQ$ K/^̅(44]rS )&c8LUvj~3悆ج c+mkȴ|`n-_6x):<p7ޭI.] ƋQ}QE*cd0>R->Gǟ鋡b"~~*,h*xwnm4ۇ0wԔ1|,;K5 |mPF:_,uG7>\X6\]ښ<>2r}7ϥKvB!h  +PA2 Ș7Y>;?U(Z,?58PG,{),??y_󬷽ܶȉؗV;QUT3 GA $ZoL $b,_ d}숙%7/X`e!E9*4\4or}k B2ߴD ݴ6|+>Ϙ_`bv#M =2lL;RGim.hYES<4`:*Ax$ֹ%%^Zg}whO o"k 4/,%|+T[(3X<;.OwS@4{ wi̒>,zo  FhIEZiOl$`mݔ}-kMdhC)5eU=s7Zn!]練Nu  ~O6C̎\kp,e=,9` >\误M@0v[QCYeEe\L:-e<i,LNM/<y|Q6ni &6|yZQ>Cݧ9ïie_.j_@j\=tH,ήCb&|j xzRF,?𜦅`eJ}"opa endstream endobj 3416 0 obj << /Length 2496 /Filter /FlateDecode >> stream xڵ]6=@̕D}6a6{pEDeɐnf8CIf/+zH{Co_x/v: ^ ƋE,]es/qu2Eeͬ rk-l[ %m^{rV, Q՝^-jxNϽj,&ړfqC+e$--fЮΆyy;]Ӓi kgED_mjcP~:5'}\uEP~R* Z2Xl~.;Nʏ@a)4G5}}lQ<T[WreX%PQTw/bbH$!j6un; 4K8> -D&ryPBC3;;^ueA㍢{U&QW= 4Mͮ.T"z^YED3XD0 J2H~d9~}͌ȼĮc|A@C#okmC*=9VdZZWZ/+3ڗd* \loe?}'^c?Ӑ#9qȑ6* Ԇ;-CAQ0Atjb΀(G%dksU( w;+C2ڜ*^, 8t qi2K!aŸH ʔo_,~1\5v].%Cˡƨzơm]uM]NRqq&=ٲB @nѵӈO:$a0I &nXKy-~TS)i!fM:m[QdBM;Wo XB:/ KP|Td|dґA,BʞwD"|9qJ?RZy7QRwSQۄs;(ºq|s1O]V=}NmYênzo ;}O1j/qA}NAj=/g"cxgI ٟl򪅩*01eMʥ{x"vDa u^}p?||g8zT7hI %^^+9 6JPcqwPɤJTD*碡 Cm7 lpJWN$xw;lQn@P#6J<%5TiE $ ${,e_ \h=eڊCR**Rd0\2*^I$PT`I7lZ/1ҡtHRkzQ4 Ƿ4a<1FGHx| T{EuX=԰'NIulr;!8\`AOסH"4t .~:4_뽸8K6a"7y|AB(l:~ ZSJ?a!ٷrhs\<.4G#Ml??pT*V2̌;AIL>,( (3E! GȂ!Rf6)$^e0VGגZ- Ɨ, l#5~94M-NL#.wLDon;{Ȼ,"o.eQƈ*Dnƽt~EW#Mε$\>,]_2ы|d, Ǹn/hP Ae@Q%H?4҇[%W-je%?UUKw*OlPP>{m.3z_yұ2Rt 1ǰZ-1vb(ƍ{ٚ|d/PFh>/vO{5o==pd|pi#^M%%lqot;^S9 i QBܷw~ۦnyh;M<-;rãW{'RAј`E߇~@ioZA]t1SuޤN@/l"=qsנ*ʞF_6Txi@Օa`./ 5I'8Blғܿ.Y | ݱp4&CY2~5J]}.cQc*zg[~fzY崋7@C8x?K^@@x,F&$B!f\yYQUQ `ΖaBJ!k]Qr;;nVWՈW_7j:6o71B:_[.УfBJQB'=HB޲m^J@?hO؍P%4NA!=.gQGXk^ǒ}!wid̯%yz NkeNAAZ,i0""yoA09 sݕ7w/^I endstream endobj 3423 0 obj << /Length 3606 /Filter /FlateDecode >> stream xڥZ[ݶ~X%g=2/.vN@ $=ёNC{g8C9 qgS\Iͅ"ivKdP_SF\_ҀT"1pxDg̾שI/*FM#ܫR4USwU>@cQ4OKevM.*w?َNwȻե܍vpGcT?p'G--k=pb8XVCg=Rn+;KJu?c5Oa϶R®k~InT-u8 6sÔG^Jp+A~FO snaCҘj#ڎ}me>0qQe^܀.y9+KbbT{ClC9Vi/~j^gEŚh`t.UVֺ}NVT k%~ ULwN衕Z:NGNMw '|qPEu4 2sb_ Τd (7ZCƒdQ +:~gKbjX5y ڇ;6rx2g*"pRI*3wOiZn;[vhj,}l*LD~E予%?W,4 h6ɮd-Љ(v=7~?Ճo -נoi87MQ{X"pNiAxOV pY2h~U|`tehi#=7#Sy81T5]IԧHw7CĚ@FRwhw[i^"\ĚU#wD_ü; kP5o$gO~ *Xb-Y##w:7+$dD-^`ί*0;{F;9z..yJ.z:_ǔԀ(g' U&#(3C!KE:! A,?s;9':;yOvv+3bN:v1lhFC'_s@6zm\.6cY_G2s-u9T Gaqm ;XYeV@n2D2+Gg9 =q[iUg#58Ayӱc 4a.-;B,Fis@` %PFW֞3Ơ"۽;{f(6`|j_Z|;Ŋ0b,`NqD%"ni,Du`(s|+$M?b6:ۀ0XΙ|Y"Lk&0xn+l!Irn# <`&>*.[n']4ﺵn6bW%D9!þWPKU;ޝC|IUƒ+Sdg":5TYf>n+]YP2IǬg:ܡC'bUGwAPEe^[a{\ M0X& ~;*@ND~;h{U=q.|6>6" @#Yk5:4V^y1S"1Y oa䠵``Jiqo/).̿Q=_&7u<wD;fvؐs<:c.vtlehq* `_p h>c\GN:^@:zKLA|:ᇲ"%>.|f$ޘ@m BY&Ʌ t?3uHLԬkY\RO6LIF9כ[\:σˎ\Q$w߷> ;}s<;9hrr=ڠشʏLxkbF|,\*9 ]+RP!LE 3%T&'`EBv9[UۆЂ]jnڅ%8٪ƭ(zĈ1E38('=)>atuvȜDžX->,w4AN`;}@<* gHDJi>g99h!NT=EO’U7$~nI^`9ާͩss/ z)?YS7"96eV KlS"YE1OB_h 1 䀼" S]aou_dKǏA:8x"⁖g^ɋy)"ު==qr!is}Mql5ŔqSr魶(XS,o؇#moT: Is1)Ua.Yrd.aUon:1rH7`DYmJ\Ɉ2>G~3ιeV¹9NbzlH!gC0y _A2>~Az鍞 z-ssYX%0HG)NsbTo +|l#5kp"/n9*KLrNOrmC_$_G0L2ba2mVt@襜fVVC-X%=إ7B5 "~MP\ٌ+4~LI^ &ZdRtR:{ %o}k]f ^)oi"ep^}>OˤXnnXVlPSܻipԣg 74OMN吉Φ]rP' |v% k +& <}-~M\s$KngsYp|Ýy()rN}vW*.Cj R;){lmx~YiʮV))i w(F{~I endstream endobj 3430 0 obj << /Length 3287 /Filter /FlateDecode >> stream xڭZY~_ا`[+: mHۈ3I5{Z^%ǿ>U"u4gv Q*~q{fɮLfNql ew*zl/ih,F-e*ћ'T.,vC'Es5Jue; ؓ?).ef{u5F8)#y>5mK>h|f#Ռ==LS?P{}q,Fwh²@YtARy12X`2MYcYo =kˊeF ~sU`<*r(JʄZq-fiE8mۣr>|y\~lP'c{M5C:OxJq$srJPʽHW4K֟H*I#6>AcAI0t?#FR3Rr{qGXlݍJGIP;W|=|1rPǪ!Q,݆ m_Qu($>iO@!$-֓TnN͹pq=j/6sPg $c?wH?jE[()Y>4CK`Quۜ\M2fj Վ~oV<6 ۍFr5 jX:(uEQWȼy2cK23O'_r\õkZf @%$P84n6^ds~. (4F>6fPĽ)s\-=3)Q ˰̩<=x+-9pVW\jj@TaU(~(ezVXӃYN ߜФTsfw 4Ӭ3N!!]*@P+v…[RΆ#.9c3pW1S[93qͼP'fvijjK>1 aIH)8ݩ>汢S`܇CM\ [<+8*'֤txa?f TM$@y07aPS7\C\C1R~ڴpHZ=ᫌ,Mţ XV ׶j:\0>YHe:g4yK !)H <q͇bsRoƊb1|80X zq37|MH`du2uM+%wԝQz L4eZ%k2$^ E_3EqV%lPa 6$n+:r!Mk$o] @(U+le l1\=[YMlNmEP;ܿU]{ endstream endobj 3439 0 obj << /Length 1794 /Filter /FlateDecode >> stream xX[o6~ϯ0dc5#tyC;$kfC Ah[.D%~EfK6XQ V(;߹Ӛmf엳wgܝyȳ=_ϰe!왃17g 'Yg)u,-6剏6qg9rR}$a%zc#%yQK.[ ϖEHlV$ E3-qq8Z!4sLy9=1Ͽ~|:8 5& <.K(hǥ(-P:8Sg=\4%'U" $J XC:_SPT =LF#`.lyOdܗyuDg3t7~I^"`?[܂HҏkVAHE$6Œbk6^G*t&zv Ks[mÐe{Dm^_]r<^=N)u<`w"$eeclGZԸ*!4~j] EU?oC wʺϰ O=/*8fj,-˓,~S;Bk]z?0fLvC6[pL{U0΁ ٸF/pfCݪ@SX89PbX,;+ F55{,Okf}f@߳T.Tu!&Mq׾KbYW~ruWBmS4u6zޘ~kB(+\ UԮSɳRY" ؚr]MJT.6{ÄCFSpCƍc:H"9M'թ1=S,pRӈl5O~=.ˠ&OǍ (`?" #(i"j.vN4 6t[M-5U2LŒO+<*cտQ j\ēzs "%a "mzs!w+zbj-N\&ѭ4Pdl ߬;ZiX#K9ì bq=ŅbVƢRke1AG mL??ݙ9R6Qs2g!-F/#ц*s? WBqpceRĻ?6-~Qі epXwswf`?KGAQ^swraƒj :Q*`wU:NIJ@/F"2Vcz) niY{+jDA,B=㮡"<@U>tʨz/Z*N KCuu YEn]9@2R:/*ʾricɟ1xڰK`n,O٨@ł,\Izk(rmW}mVaZ UwPlLԴBb?P WQn4ry'ڒrr+řeԣRI;cv"mD!2Jz6n0 9ps Vu+1]:7뉫P0r7 Al01rq] 8a-&<*o%tT[uX]@v0~&31kns TŲWHAa&c.@%{]NF!)7DX?am1 endstream endobj 3473 0 obj << /Length 3917 /Filter /FlateDecode >> stream xڭioF{~O4M9d$m.EAIĖ"J}o /Q. siͻWgwϾyUb談}& 9gZW˫_juo^^Ěq o02 fA?MZfB6 4*t{me^}x=q[ˉy;ͦ\^OITofAzeB#MRc#"[/9삍rK/i>][Jך gRby^KX.@oRQVU' KlJ *;Anf—#-Zd77_KEhY [ d^|9m)Y$Z9]ņ"b~n &<^nvU2vםs>𷈺/b}˿ Z\C*>=g*,3K*-ͽzI)ʊ?wINvS @S7 -&D3?mOj)>fG9xC¢PLFrVߊ1 hEȞ򇲧@6@2ɣ<|[/Mg;`O,*]mZ,%!?C#_eMCRT]qfȵ;>܊:şK$1s" L7Y>_m|p{"$.u|{MrXШ:fTϟ4*~v {1iV4͊`htWSiiR74]'t G23v,b`A'fw,k  KPVσo0tAzgJ;f)ҪyRQna hG zIGw䒁NRxoS :5s}`HУ ~ bi-?Qq,ΎPՆ^L^dIHd& ;e>SQ yp?iH=8(TgoSԌ{R d#EݤA;u6{Kַ1ȄQR؎rg6z0bV.% \d'E͊)">x Z΀h(VF;Mc0=#݁VHŪ``"mХ=EZ!iQx1ց(LsTpӳ*Lj%uѽq#d4e>%w*L{ YdpQ dC1V[[АB6.$"eVVm̊І3. 9mkl m3)k;g! l]g%S<tяd <yDrL k.wGR#Fvʶ{1# 6T=ƒd AG6͗i5{m$~<*Ψ{wi-|*J ^C^|*A eeAӭP.cB.4IttSIpMi$:.dG䲸% CU˟\0kK. ;u*yv}9C `zU(4]0˾jvubKϻa8 WB:"i S4.jDԷ. ~|AA'nRZWh |H]6iiRgFڔvE3P\@"'0 rPo8 W8lɷBjMQYu40#iH|jmY&Z~s?Øbv7C/u&o0gZM*`О.¨{06?`d `nMEi]l6Ç%.¸ sF`Ӿle1b4 S.1[r[nͽz.2N }tLt*0]SIx.M_j81Gczzp( X(?<xrmm=fYx:RGaP&Y:1O+ԝ] b}}pr%K+ٌJ9Z'!v ww lՃo)7~X+8XNB ajI ӍluUhQ!뚑\g#CW4JpU؆N //׳<#g8 _vgpCq)INmE݈,`2ctXm GAY5*T|ѽ j}F L13RR$V,Ǣ^߿_?@0)$/ҭOHw(Y8m岭 F4.Al@ObwAbS@6o@0B'5Vfh}H01[ǣo.뼒Eij.s:4|8q?&u9|8?~A6˗\wo`w"hHns"-$t'Q]ZRh)c&Wu%w!w&#=vT-x#,/6+>rߗ$u endstream endobj 3508 0 obj << /Length 3348 /Filter /FlateDecode >> stream xڽZYܶ~ׯ%ܪ8xjS%;ڎNT Kbgs1HJZt!WRF_l{}<]ߞ( LRDg?]7-iQEfm;`Fܾ) z;B$}ߖ|UKZ|s%~jʕ YF/_nm8t(f*A"E VlzD7]O}Km{ӫ~t2}lqo&gZǴs4.8m ̠%ut,=,a3n ]Ki}H%vS&|ͪdD 9(vӑ"0B2 ;"# e2B׽Y%ʹ  - [j`T(h=!NYyB{P]GA 5'xwD94&e= @;Vۡ)P.2$q&22 jsB2n|L !bY]s,CX }h h,׬ːxF$_Pqa!"Xb=cGff% aj5 q aPkh`Fa>NxA^᦬>T0{4^;4͸@,]ܳԃ0JQ~HG$4I75cfJAߡ%;ujNhJ@i 0{yck;zc5 c֐a;5';JfB̶{Vpiϓrr! }Hƨ<_8<ȌW-_TCkzGkp)\ C2؁!g]U:* :&IP{sGmoPAi~jؗML!1sak/R Y3< G|c jڞdA6!s<ܲݩ̝ ydP8sCBLOyQԔCq͸7cym7kK %rMqH9et XZF)vN& >BENdEYK X>9ɓXB\o^;"tF -F.;z W[o*kArN;Zpdσkf7 "Iq&i2hJ)<p۵C]hҽ V1+*RpUE1U;C&v4PtcuկH]ۖ>ro,wΣ`psʶ8~:4Cd(#]E&;e.FEkmSvne8:Ԫ\TfB)F^0Uin+jB\zYfYCkw'd8VvV;:[Ԇ4~\](?2P Xs'^hۈ,Kݲ%wO!Lⰸk\bnз{0–]pQDŦ1Y~\rShXGa($Mʍ9p sia$B>eB.mqqkڽ#aճG1~JW^ pCTں >M8)Z,P__}`iSm*>loj,\[ߖV=12Ct&c٢v1F˗s<p%l. 2CN TvGC6Cch0$1'1 cApt[C~1. \TmM ^qoPއD7. :-(!0R 67`~~h}&͢Glq9mS혹V0yar/frA܃. ێ,t03 1o@86fa/aoY24Ew8d-` !?/Ӧ 6I(Y9.аJi6wKwm=}{@E׹*B `T5ڎM䭻u|ͧIelhLsy*=pO55@YN3/7ȗuKG"H{dS1&9w4cA+ȓaPC={fOD`Eye-jpӴͦP0;)I-*p%\jQ"?)!_H9;<*cOb2FYJ ` X5 yY_dI ׍4 I,l ֘J[)Ẇ&5@Οxc^o6 w^5D[.iB˯O`/R7{Ă2MwOﾔ'N endstream endobj 3377 0 obj << /Type /ObjStm /N 100 /First 1004 /Length 2710 /Filter /FlateDecode >> stream xZn}W1yVE0XIX~Hba$dsQfF9#JۣkoVtw4YSEƘ8Vr1)NFPN(xSR%p{(%C*GxRvi:Rv&8MP &H-53qS]>RT|HvgrjHmJl19qIGrH| _AUD)O-x-yN`r7_ fP3IS K.ժ㍜o R7*n7L%#>s%.g0rD"G bDF4zɣ0BވsMBTPR3֡4-5D%R)zu4ռG;WY U[1˫O?߬[ꕙF{63NyLwe;0oּ7~}c&f_fw_/g1=M~r2TMgtٹto׫/=?vmr 0tn BBBBtA5v͵k]siΣ۫mjqn>L<]pZN1K!0n ٖ)-[3$p|vzZ'{9=#kXQg3mT+)5ۜN秿 _ jG*xCu|1Zv#y9>/z#u1y]"{w#dCa(Tł_C|hƇ餷ZM{ ;[BDh^z-2J/78|ֹ݆r.Dx&PȐn=v-Xi<q5b[)%[!Yl;T*Y`Q=ihݨ,x=|~ÉPrw%s91JY _ BB̬xKCڄ4h@{#%gK /bmբbou-aE6z0i<Qڠ&A囲Xh =%YN7 "x0߱FOThuX-ɷV. \9fp8_.Ml=*?1` 2hY1zOe?T*\ؘ:o &_8|~!qx@{HUw³viyA,cKw8ޮS{DPeZVVeC}Bp>abK잣~s7޺~1?9c/jbwΨC$ Xhqkrl|X HUA"&M 0FRAzG uIyRl)wtz+{B5Hg5K,]t5K,]v5k׬]v5k׬]v:,#,<2Rˊp~/,aQ̗=;q009caZi",j=-a1);<%aRBGf=a9_\,O4u-= zpR2%],Çfs1]6E.2cp `#Hʃ6$ABGŒʦ> k6Uvr2SGxJ;fM6ϭYPɲBeh깆!0V'_= qKsBniF\ pW!q`E5c~rv9CX;d6i#r>2 piZU;=ì -rAǧ簑{hF=?aqh^eW'suvG9zV%t>͇\ ;X5Xtt<:ԼKE1>!1yp^d>}VZs!?N.3r/k/k/u/uw!t!v!uAmֽR!Ш0Sf Qa`Xњ dHRȻKejQU3"U$VVYvYE{nZ4X,Q { _Eƕ,Z5ʍffJ+jXauX>i5S endstream endobj 3527 0 obj << /Length 3115 /Filter /FlateDecode >> stream xڵZYs6~Pũ@8TjJ$6>P3m$NJ4Rr냢'zN_$!rs(%"V'1Drr>5jʔl\ i&"QD' h\JzD'KXr / 'KN%Qw`4H]_\n\WYu15)´ yŊ$Tri)S$TyXWLb+oͫ*mOΪ.hWZ7 oU^eh K]%RƐR\F7yd5FOAN5q 7ywZ0uy,mM"tYE{eJW@tED\()H&ԯ$#j]@Sek*&w1pNp͂hk– krvE[:oUgނuvZ;W.^ ymv(q<:B/Jnxbw۠&LA5i PӀB.Wä].Jɦ9[E+J?Ͽ )\ G'n_H̱CW>߂ "G;nw*1PPB9TR+-Q `OC{}"C[<|6AۛOޅQh1$銬m `^ؠJة/}w]7hP8~T¨>, b]H.8tDsBՀn>_M[{gcj]KCjy-g Pw@UBm$Zn.saEVxmy W GA{ٝ`={{KWBOuQ]nV1xb`:?S`΅8>CqJ4lv]?o_s23O QS-(>\[ $:]]گ4-y hF%WkptOOYm3sEtedD<Aenmݢ/&z`E%IA{ngzLI@̉Hߨ[*BTn}k݋m-dᡱ6 y1+;Q%Wr,nprs]m_癗)ͻ@zߤAHC| /+ zk(}Goy6-z骽#a}I2FC2b&g:"dUz^]9R)9LJo(B0 ='T7,[xG9#CF2%~z'?V˅#/iך$igG|b \FjOkj3HN.#rouʫ,&?xIۚO{[EyĹq8[ 40 6/aBv`.ML<PK~J4n~h$?Ŏ'F9띗;@X.FU _`]{v=hLi+nbˇ`tEݱ( Ģ!(1>sW6+9I{9N;"xRP N$ 76}}Mz\kl 7YM;CG23+לYM.m" Ό2P/qdBG+^ס@\)rNg }<~x/)c]њ+;> ޴> zdakD rP=QPJ˯lY ;w_YᰇLܺ57>6.?7nhBRA Wye@*j8_Hc$: q,!OO1Q3>1A9xA'^R.M {,ypg| +/%/|Y |{ws` [ vC/cO<T-x>5a*,{i5En7#lB=4b 6bBF"(O?-L"9"$FTN ŕpP0K+}ن>tq4,[Ԇ{GxCcH*ϊ,o3$}dhğ8 d`)ͽSo1.Z،:!N HDߔq$_Y]|8߾7B?C[o_~#3 b)$$q2N&a=I~-uT endstream endobj 3535 0 obj << /Length 943 /Filter /FlateDecode >> stream xWKo8WamR(ɲ:.P$iầFl%q]$Ap|2Z[z7k5Z3+r7V3#kZw#/_-'3iVbtyQ(0~{l/޹w CZBc/}Sk=B_KG5s%AڹJb2#. ;mp/D3_d fDGG8DOЬs)0J(I0+9]c.pGMQlB (4 G|l{PNէDz,FP-&k-c!H+}]<&|2~ [c;P3HRZ(P"3*5dEI5Bڀ,3(15XQKve@W kǢ܌删%8NT5EXqf@bCxxs=Q2~uPaa 3MEدDaCbLfF!/IYQR(Cfo{Sy n0VͩhUd?,6ZpQZYVw(U.ΰEoŧR84ţe Pxr4%s%v0%T7Am0br [4aq.Z$Zl)u^sk9IUDt%|=4M-r~CSC݆{&g?/w)|S@y;JTxZ%:ZbUxDgDŽ6J,n{vlT{wO$NP;ﰑ > c<-Jq"ᜐ7-bqp\][/aיpK"vej?R endstream endobj 3549 0 obj << /Length 1503 /Filter /FlateDecode >> stream x[s8)ř)3lҝ^v[f:{t@u;Mr蜿~[y{>}>B/FqD| #"{{?7 ڬ/?aךq cvn()OC!5(fnoy%F ܟ}n2Β6ͳeÔVA15!,ۺZhmf{{ric>?:/^kx].-dg['emU\EQZև9]qyUڵơ*1jWd,F}dύ|?ZY 4T/[U枺=L2S_U6Lb{Y+0pa>q2 K |,h( uZ f}au`_D0ل`~0 ; r.ã{|GC @Zc!ccL<Ќ11U cOl2㐉 ʈ4eXp\4a1S PCC :Ԅ &FY泀v[S_UƔ:7SsiMǦr{P>L2pܝq@ > stream xYKsﯘӨ*Cۛ8'nvѰ!r_nt|#KT6@(=ݟ8ADaHR!D滻j>Cf2Ae0UEp>޻w 7;lŊh}š͠7nI,r,ch膢!EkC}ֆ:yTp`}wE_({͕K28IvpA>T c*MҾh u4J=?lX" ޔ|)",Wxm }WU[5=i!r ,]XKP,q U{ݖzk\%?\ >16`I| @櫨K3} b3]yF{PߝhlBјZzv#2hy_~wxᾣrAUirYw5LC6 %jwV׮l8mZvara20aܙNZ$-M'9Ǣt\R|$RSWaQcQc+|"cW> H{P"ڢ$dWrX{L6fG.<3$DT@ CP4#Jo(CE, Ċn,šm.EH2}ߵpKo.[.;Ȣi6y 0}412̃,LP+- T4M 7M 3[weҜ3;&9=GkZʰfO8F1a~o|^!aOa)>wҽ P26Teh=&͏A˼2!~6Ͱ&؛fgQN"msW\3/$ @]isaQM$3T!D̢ՈS,6RE8x>_ZANwV|;Nef!gE"LE) (f =CCp^24zuʮ1lǮ(w$@kaCG$Qc=-m4<_FyKķ]ya  uzO0o@sRãv5!K6ohBbZJjy+r3+ Q<4vVO6yG~~Jvy7\>'wFڦ~'rVm NkzQj|CԽsW#7U3밧(O]ez7DXQ7׾I؃jeJas$˳.(Yg7ߥ)J[LfS=j.=\mEB58 h#$R8[Zk2OWX35e6bP`Y÷ G jKDZg rӼGdkV?j ~^_ > stream xڥYK۸W|H* wV\*$I,S,AyҐ [VɝXoBw|~oxWYN:E9'f0Ґ} ;Zп91a{[u-AƧ !+@b-#1p Gd^L&B!C2Exjh#mԩ0zL[UU>/"!$ 9Nl]XDfڲ990'8:嬥_cv+s49Cџ>ѓb!nՄS*t߲5Odg.MaL'ޙ+ʴ)L-KL~OťSBWa jD;f` `I5D3Q~f΅Mء!vVJ2$u]Kפ/5+Gk¢zX7`ecK:f{hMpt;! Zf v1z:X/QCx!sYq+̺YwBu VaV(!욽m=9dq/GQV!j0]jĝWIEN T-Q|Rs'o<yv{';}.!;ʿHh)3f@LkEe,P>yF:gnc(|U ^"١/㖊4ɖI??; ,QaX|x]jl$O ) I(S]tK~;8ilV CyOOʿn5JQJ(%=P%0j rS]#v++^$k]k1}4p GW9Ys%2r$\A!\E5*ɘ,!q2h֑oD/t^=PhxYkͳNe endstream endobj 3578 0 obj << /Length 2638 /Filter /FlateDecode >> stream xYm۸_a@HDI!w5)pwhnY׺%C/l~}g8#fKq2<3vVw+gݾxCb+On+q*t]dVY{~Ph\x2c"a3[" SҺћju{T+ǍurՕm#6[D뺢u8ohARIJjinBߧH9qTx^^>j,itMxg߂ >4*r tVl[ߢްF$([bԩn~dQeh#+Ve&eA 4CMhPKj^7,k7j!*0#8 l]mj(rjE91hj.,)IQ, g'DvU737ό# r 0uC(em1`! @ZC+޸;jk/ ?h@j@B p̓N#E7Tcw@s"9 !#\,L%ʌTY@B^AH7R #vgaj90q#֠Nl  ]l%Ϻ AG*LK~̋.7*Dz!DZx8 x= KP~ c|=@G(CUBCLY@~cr4̪ʂeXX& ;.Pr)C߂O[J0*MwV z+@ៈV52Hj~@"9, b))PuW_mHv"ˆt w) IorAVF۟UsaaVVzy/-`ؑM[-n 4ŝc&l|soCq27w _(R."eWKpan?vAr#:{$yHE*/ly u=`^0uuN׋6DlRKN;]:{yw:P>O> };,ԗBVOoT 5J`S§n5nOŀx ̒X_VۚH=}Ӽ5 f!O$] [$ʆ,v|7Y>\T1)&P:DoRe[OXSC_=^0ߘ"wYwCyT' Y:N_:iz9_M+fKAd7HKHzqUrYⅫ,S$6 yMw4wT]i}5TOD%ؠ*m ]O$tzB"c 5s{1s]a$TDkpũveo)ܞoi%6n]r@dU䍲4y_>O7 yy^UQ'ciu7 Ee70rn725 F s4WwTG͜s9] 7:Z>5WA̲;UӢ*j^&c7W%W "mhiMrKmj~u>y+0+/L[6ݶYG2wu<+Qt7Ib ?7oxLyj5|`fB\}s+r!ᛠ.y|5V,޾; endstream endobj 3606 0 obj << /Length 2775 /Filter /FlateDecode >> stream xڵZ[~WpO-mR%L%ݶY2cNA>\dz=~tRɋ.4cDzq[To2YO{efTIfi>:[δj 6X -^Tpզm/4 )m;aYM0kfqܲmÔmFyo(I.j$5?"B*%4MvCF( ӗrUI&Әw+GVfm޴rxjb BLcϬf] iMZ3㞫|fȔO\߮9@0InvMVD03iUϵ,%蘖ȕfAyѴbp՚(zy: IM;Q%IK#ӎE50\d✣5ӕޡ9-\Yz 3u/la|OY#oM6q*?udZTV;/EٚgВYft]P1* W/Lvc}Z2ɡRċV(R-M_ n^5Gy:}1 *=v_2ţmQYԅnl pl=)I,B񉞪GN1pfyT\3t/So6)4?8p{ $F/_y vi诿YNq A6SzE$j(9ok0X3&Dw@ʁ:7ܹ'N|`|bՇ>׾x"j20U`1~#OiiVf]7ܘdE^a@7v} )77`Aoer:wSr9dZM׼My+Tr3dz &32+ d5ucO,X&` 3Q`fnUXWL97#@,2oGz7GіY3]fZ Qoi3b#2`GYܜ=Kj3>ȧW)-B)]3 q6>o3eѴ)WD^.Rdl6Ռ =A\Ph7KCܔj|QA| '":Uw|rX[0)=0ńHFGHmţZ>ù!4Pnd3皇N]%آQ.AcRP#S#L6, @)$M+1>K,/m:zN[k}z{YbK3O^B6xKSmVg th8k50 pA,]nOײ6cOHv1Q*Q'e 1&e4]V.q؆2*gfn8z?~^܅*ژ\BYŗm6F}s`>9w XubUlo!2Bg8VD^i>ZOAn{r4B؛S1Vdi25I`'fvZ1Fٕ°$J2KxִlMOBsI }?꾟Q~& endstream endobj 3617 0 obj << /Length 2298 /Filter /FlateDecode >> stream xڽY[o:~ϯ0܇uEQ%GI'o=xHpN_ZFFBXa\nR%3U!v*aQ{_='QT٧~2ϟ \qd>_MtgICW_ C#arՑ.JJ[ᚏZ4m-M:C_]/>-ޝ(+=Ȓt6qX!.U!WhڀEyNf+ts.dP\ڦr|f2_kPFLcrGEÐp}&=>@P@ޝlH<\lM1<cl;J1{ID2j<6 RB)kpc5r 8"oiԫT#3d}Vq(ag7]z04 GzItdP!*| 6N"$!oRԕ/ nsLNVxB{-fHOQS>:Y- ?dzA4[d4@$۟|s єl{97hk8o joC`28°b\-v+MWY&tr)^B:?yD@ sh`EeYzN7թT;٘(f+C(׉^$"l{y`(E\KU0>n *١&ŗADq&躌u=] oߴiKӽmbA4s+Yyre& 8- M mSa"$bm*l!t%N.?+M-HI]hڂvh+dixN[? }Fֶ }(EEDTwyg-娗$ytɁh"@0[&zd xz1ǡ7釷2ʠg/j+|EVy綥Cx"vΌőTU#CH0h(\[ϩhtmơ'5hjpݫ:;44 9bSH?I? QdPpTT0 |I<#r,g`g4ol{,%ލ^vln]?B0>Qt̴h ݇=_EE?|zE(9p >bzHG4fJ&v?wBIg endstream endobj 3510 0 obj << /Type /ObjStm /N 100 /First 1003 /Length 2629 /Filter /FlateDecode >> stream xڽZn9}Wql/Er dw 8Y`w?tv|EَHr)IaU.rxE.Y(蜕^(vMHXыpt||Լvѩl/7Q󬟟uw6j~k9FKDZbJI;[]1:>V۫|?L#? gXAE܉b:ڝDOn2:qZifWϮxxߨS9k]-T!f~ϖEKmqKy%G \~@O~dռ~R5oKuz Qʻr!I.|-.mUw6n_U$eů9FŶ L\)c-*pbRZ T[Kͧ5A6􃬢m[zNǓo[Gc;+o@F !k)a( d;ݬ,yz|\fh~ּi}ry{|EOe{v1,xrg눇4!g-ZDۙhGxs [ FN(SufWVfF@I)@Rdq@j)8k9f[{Ì I AV29Yl0k6VK~+vgn/:kL2&4Q:) )++P} d<[PNH]yF2!QV1_15İ}ÞlRM26Zp h~d+{~ۄ5;+:s2jl6Zݴ}]9@]\̨nxϥJt?7|>ͮR=WTW+Dz?$CۦE]WDs ۓȚ]铳vQal4:tFx6$$-F6b8k9[0=Ca0:sb&rI{ ?0lǷ6L{Hx\8 5s|Ѡ1=G l` yݯ_+ߕ!e4~J_BM:&l3P IC( i3!^3;>b^H\$DKD9y{<.~}r.88!pj]9<!3FcN[rNi8K|: ]qN㐾۴!Ǭtr2KأJ;yb&tc&4Y".6JAazcT vJ!\l8"\r@a}GVN$/-{\ȇ9zv OQk._Q~&1¡2"+S8|SG4wd+o JbdRTTT:8mW*KzA@s՜\59W͹jUs^kײk`0$9Qfv;GD|<[~/\ֹ(53j4kQ߀n;j:mϐsI[7``dYxXŰhy]P,tN޹#H'^۟U;X4%h`Y;?>tx(>6hu=D,'2+}-bZxo?tFrAc"G ]G - &ы1*赳n7lM"W*Kc"d]X-Xly*Cʭ'Bw#advG;pXl:` N,9w6:4#$s7b)4IOy/&lii}M@Ö aloFj2aѓ8*swGLd-Dv)WU~<<]8~v#~c-WV7Xu󸝍N0(QWh""މoȹA. vFU½B՝$zR(xpw*^@z㐥cEb#{!rcDN~ιyMI7@E&$4y׍#]tb+S׋LI׋zmo0 H?LCK endstream endobj 3628 0 obj << /Length 2907 /Filter /FlateDecode >> stream xڭZK $֛ 1|{FԮ'SդHz}Ua[}71jfuRUy`dOW" Ϸ7:얱 8Zn07a|׾F626"II?;{hG$&&#ѝW.o7Bu[Q'vok$%7꘧W[Ԧc@:P֟Ӭ_J-g䘻U7Xkʆ8bHpGqH,rHl+9A@PP1Opr $1\ӤM^.fUd uRXM2+iLnCuLqn|8;TmTw§9Mż±Um51l3XqWKÜqv*uBy,lPia܀böcvQn.FT=&ZF2gH765zX_W8DtsZIZx#o?6"dK|zjRWҗKeOdע#1>΀390ٻMñ:y=G?[K~cL*=+KgB616ĔD 7KnR$t ;Eeq oŗn5'}(/Ȋ-xo`}l0Nf1Ek]p tLtG\!;ib51j" d4pGM \ZIʔ:-wfF*IЯ):Y~w Gk`:8>:,:S\*Ь^D[}KA\{ߍo?7Wi>. grAyiNG2 <"Q͆|뤶ԩ6 B/ln&νݥ_TI!H)oɡ8'm)Bt~x3}kh ]~LmG(=4se70B`OV8󲔽.k7ER9N .n.-57@@ȉ^.y(opGgSIXSvbkw4ǐ#N+rs@Sk{Eۡ'iNQ!9kSΔf GU̡`q oy~.:))xJxe`CXUlf)­B o7Sh|aI!qRL$6g ; 7~^+1HU {&WBO+a/#B;I3hxu}Y7+J%GF0qeh@w)W]6H&ךZJ^wϡ8/mx(ӄQJ@J\h0~I"vsL֫D~:8^2Bҵ]c|6t~b4om[bO<2Lܒm8\L Rx .hwnQKQfǠ3x Vp0/3oM`B[Ɨ,ϩ3Pd ^4 RZ׺Q꿏]ҫ׏g:t>`23%ǫܣ0ƈ B"&@c;H?4iN3t\sʇy2BЛa%hJi-u O^0Vc #k} e4_jfxa,7هH7?x*1`U=^'ȨGrhuΫ1f@YW=fdգ-m>0EA:\9<^T@HhV]chщRL/hqdܕ*j"F0em_}H _GK,B @ƓBD.Åy.>/+ VT !3pF-՚"|cCRV( =yuD:Pds0&(2(r5es>6 1TBX-lR''3|%i/ |_br\&/8 Wc~M4ȾaԤcU]/*hXe T5R&p_Y@7KKUi5ߢ`A,K0?'e*pLWU_fM-]2T{KJ,GE4vWgܳ#sm@D2~OpZ1Op&6MjW9?Pڏok[ endstream endobj 3637 0 obj << /Length 3152 /Filter /FlateDecode >> stream xڥkܶ6_ xi>R@A Ć!.c+mE{g8^ICr8 o޾xuMƲD&(٤BDe旭LݿUM*-I9g[{J½J[)ai2-fyK D4g~>t4`ivBoT>z'v{n%LJܶrmg0.2[[Uң;<$*LDU?s{1}Ϲ4%lEƬp@űgE^yec%J;"1Dߚ.k|{3x,!mr=G[^xp'ݍ74B3x!Np,WN3>]c?҂=q*1+\·E}>MY´ǼvmW+d<4ۼ)ۯV$ *U7kJ\WKeLD8pJv,zΓ/Ԙ8Mk@kON(GA5n  !SI}kGE7St-M-`x0w;Kݶ|Ѩ8D#\DVGmWO{<W4ѡhIp{NH+ug@^L`)9>Gj"0yq>g); N>`boi[?|W'3~DZÉc9AQB_xzd2 mwTm`2ݾΰGB} +NJ{oȷK81ǃSڣOם&G͏o00j Ъ?_NJ]Ny<ѥ5M@5NI]}U(@оzFv086e=cqb@b&4Sz_r0:vcŃ]_P-wlkxE 2p')ϛ }f@$0d[4mϣC"-  ]tݜ[Z$H8 4)9- b\0q72fr=$ȉ '6oV5 C4Mi[7?'~Q4 6L׶5wӇӼ4C; \i}wϾD!DROMϐ(IǾi"\D(SoTNQqy:WtYdVc Qi\N@m>獏:HBl'F7 0twƙt 4tDqJNs1LCnL%!*ɬAN{ 鏊Hp 4"1n( F; *Lƕ< fʴ7Ob~i0o;_9?h+AȔ#WHk@n`mP ~$Ի4OU$eXR ;(<]T܀P&A9|3_yupH"[AD95cAlm9 c5<$D.-='& %JYR trUәB+ S7"w+}C)vM_˥? . 5h^ga}X^LU ch14&X:'.lp tTf(lSgMqE'4SZ3W/)!ؓpvrpIdo\fKƒeՆ .t듏̅) /(_#:a5߬dx"WcN>OƳ`" F/iw.?# ysqRR)ߏҜ)WA1vRT} +01Uݙoлycp*g1 o+idz<FʷP`_t$yx7=pR/W(> stream xڭ[~FcZC $AH!U#K[Ie"{g8Hɴw/(wp囇M_޿y2+5כ癐zc˴(7nS~_~(ufVMa*͞$w]s!@~5Jz~PuTsCОѰ3떊4n]h\orq|jرbp>ݔ"/hh 8\,f-칄\ˆCjˎm횪*)WcTÆCߞO43Io奄X|H3%? :gs>4pdZRVU+f>\E%}qn )*D !܃k;)92V=SGN"[rȧjn]Wn:,A.a1I\\nVؤo2- ewpL06rIC)JC{W<q 6.J!p_wn<.DL=Ws95'Ae&3HQ /I+9qub4:y_1 I5\QdYM4H)%r\~+N=NU'+f2Ŷ{7p"?8ԮJ1N״Ŝx*Y}o4\lMp&鸢:^"!^ XFqc}*Tq`1EBgyy+} 31^e.DЏha"=>ﴲmo^I+%LΛ}JuM5_ΈGh4Ȋfni`F^@4E$rA͢_3Q7Vd#Lz׈~71SjC0k5u-3pI54!܄O\8AHdGe< cb2x=[ۏu8QyV@cXߎjoqveRcZJz677+k1^D~>*)R&~@˂,~Hr\ 1hyQvΫdSU`ޒ9x5|BsA(bq1bһپԟ=zS,;(k"z~Nwܓ%sSgk'FM.C㱚*tY]WR9^1ˍp>Lg.;42jF1n0ȕ*L&Wi~X[w0"$x2gnav.iW,`X3":P;^ 1=?jrjD;״JHwSv=-jI-ϚJdMe2sǔ.[oߝmy;~ @9p5}_5ПٹW+0SQqB.yPP Zͬo%A6m5;Or}>3p a75Pj )'lsql;PKm@G2 v 2T*,cdC]58@X:6n@9_8k v]ަpL  wt. 6Yn@*cT?.wdX;CKFAE8q$02't>P&SmdC.=a(A_xDjk1pu8+VbkXj;"mXmb4H"$ %ڬ&#9rC=8ZMi23[hV~%V3@u +ל09kL!wxbdyCkQ\wEw&{({ۃh "Ά[𙉕|X^:IrX,B /Z0@`c@<:V.>VM29^CR(yi]VT1cN&vD.L5lu.eY'&NSٷ<<:_׊w>Ep Ӄ6PH){B Y[D:Ɍziɍ`!S{BKz됑]/\mGZ# v3(W$]q [J̸ԋX$R9s's^x疚-=-*L@aǚpw}@P@Y759sP}rz'<ÂKnXnp0*%΅S^VHm;W٫8%PuŒ ETk9[|SVUʺH jzm#=z,c\*Sb:m^Uh '΋ouSյs;W7m'Фm?Hgϔlr =ysGQi)Vzv\\N pL<jx[orqluK, xW=<7EcrXӰ(#.eou sEqPk m~k=>4xO˪+Tf_uU> stream x[Y6~ϯPCJSHqI9*>p$ 3Tɯn4KԌ;҃@>n\|q>g^&v,BpΔNFlfe)o~|2Ճ ƥ|zX3RAJfYLE횶>ۯ #zL_\d*9%r]ա]6wkbMvY4T+om(W96:*mhDžLy] -]B 9"PFjJS-HYf3bڪbHwgRV2nb%A5U]@Jmo AVLHoTc8acWГK13+>X,ĿL{N?Iq/ pXDžHn$dF꓀fFEYzfP-;R;]zB߹L_'mH{nʘ᮰_9b^+ܑJ,I:2);ꋕ♟/$,t[IM᩺r5bmυˢa v C̘1TCƵM`(+d-# krY.z˅r!-m7Z ? >LR&y62LP )_iʪ% Rp,K|y{։L1muh l`R!w6R Bs3ҞΤeIck$Pvhz<#; =A A;2 bzjX6kS 8NzɡqJŁDС,jC\^HaYKtSD ~nқjP+;EMOR,V2ň/_^0Ï?~оMY3R1Уw'$Ho sPSjq_P&O.$;0jzjE#d ,}1V0d@H1FCVdO2yj~CҌIC$̄){e4C@D,q)B`eojP}ANthVpNJ)A{ꪽ .u)iL=6,e>i.ɡYfL(P RsFie@V2e6>t pm@)2&Q4 Yɠ҉(!6G!3;!0ɻsB}pNw4 ދʼ WF2iJ'r⤨;JpQ}Rs |?]3V`J#w?̊h.=?~OHfn$ws=%dzMKmq{!rnS>=ĩṔCÓL,x Knew"M ¶Uk>#IC%h<=+ Fn[G9ho\M<ݭ-;`ظ-;'+X CM_We Va+&DZԚuv!/V*=u6zTauv^?(=l(I'bOOQ,!39rxӰ>B=&!`MTY78 lk;:}h% P7w=]6MȣZ5LQڅcus]}:?4^p*4jb)X?vM֪^d '=Q erTus!2pn]Lf@C&AیO;yRjRt^):x*`?kv#+~ ejc:06@ X%]Y~E[8|5A+ܖ$ A%@@P,MU6YRq;P jE1c~(ˀ2350g#2c6˦2=loc܆15{'2}06֬6 xhZR[-Y2li<稄<~[I5 (X,[^e+fy;].IȍH?P>o\hC CK%lKl;$9,4ƌPZAi?׳'f )4J>v.o=xD]z Dhx(c L-o6 /f;lc%5v"!Rw4OrxCEϯ]:PPśS2,e$^U~LHMJz6 !_;.EC)蚨HcM޲K!UBCe5K7MQJ.˞b[b2 Sp}Y=RYj02F-93}8ίZFu!3]*JRD'X9?o|dC1lkmwʻ8v#~d&= GGPo@TqڴXi \#o0^+Gnjv,*O1'^^j ؤN&b pt ټ6`0\g\4BX+7Wcr!7.yόf_ &F<:^=e뜂W4T.z D 1ObaV<@>0;[z!19Lqh&JCI Wv )56taqۯB+x^qҚ~um/AX߭zX鑯#{ޏq[_ cqy'̎ w R (9ѤY&' 0ҵ]2qF.?K?]JPX^3vhQKT`oš/﫢l;V-MB,*):nߐwzUBjC0 oiRgoCL²| sxh@|6nFK@?hn[vO)s.ׅx. 諡ۂV 2.`L5a}ոЦ*=a ^-λ[K$-k%aQK9 'PEOo =کŽ$%=ZA6JV$%n4KTӋûކ㞒 ;}GVC&`=<CXkM@0f1,=OV0Hs4P|dƷzЄ2UHUT.5" YC9|w#u5/+ l,Bޖ`̃VCC_CADP3DPIX_m0NI`9Whyԁβj)R~l,(wU+$@Vc?{xy~qyP4={aƏ6ء.pzkgk4w{GJ=Y$xtTOV~1@ᓕ-nSmJjc]?cXeˢ6ŏ"'Lv)`et9 vbPsW\ߴ#, 6.aҘ9 7GjͼxGGI[= - Psk'$N'Ёe~uД&\'A=L@) dӎtKz`o' 5BzOnn~f@9^7ύ NpvQM|`= endstream endobj 3688 0 obj << /Length 3738 /Filter /FlateDecode >> stream xkoDFQBahkC |9dT` @'{@G)blQ("{0i$įgR>)S4`;vG)\:#z-Oҹ|\9ՉVOn>U@y_fjBq(OD K<ԏYYȓa e?y 9L讜 l :u1w&3"klNja'vmƏlf4'wОyPP˯ijV?rL+K-7K.mWwBESMRy)%9/E'ulǪouSdJ#QYTeu~c[mqf#iKU<&6ܦ| 9Sgi|(- ~lU,9"i_DNN%N#|I}Rr  MjlQK dpIId vb̊xGhX1,Sп@Q@TYA&ZAVV{,_gNƿ10̫(YPFaʮ'`[K+!H5uV7k Z ZqPqZLtMC!ggХ!!l`lGAenD u;6iޚtsV:9{߶ߥuT}}o.sơ<=4073؆:}2vNZʸtyIhl9 ѺѧZ8[ұ7343#8^Ka |`2l\@"EĘ*<̲1A^>JI)0>gDRR9w1#]jGpu#㨵D<1j'j:޽6>|Ve/<5ף#ځlpP{_9CjYG@Q=1P RLpdBo],wƎi!$ ُZ3'Ev6ZSo 6PZMf0:lbati /4c'V kބG- g/o *z-A(X=ذIy/dVOQSJ7D7`moҬ,h Gw$u2_jG: @&-+zktuNWJ֮:S"5#{lKs\3 ` #G5UŪA}c !qpg էW@q{k iHixj'.٬+$n Rx TR¥h{ je /J A6q,cX,Āl>JdVf|0! ,׶q!&0h|g+-%ª.ʪ Q !@#GxV13;ήWpvHu&r+*fO]bEom̟086;tcQ7w>Él9'hmQOjV9 v:]e6_D[c/F,o|ʮs?? jE]ԛVˈiA.=1A8 v/Xgx-Qe`6I偷-$Cպ#1R\DW6B]q՛̏[NȊ0u|(ݦ.ѻ(6g{ېtPy>Q< 鲃Ƒ9/J6E]ӘbO yW`ks ,[[qmŰP1~9t5],i,nUw)M`9-Ny]2{BI-bzD+L{sBSN*^!fIߒ<^1z9~*~Ī%e59z] $?(t|Idj[}@K g]: B1.8Bkv=yZ5 0N.)t++fgrL\J^ӠH=ʢtYx+M^"N+7p'd9 3yp7\bQŷg'[՘6"˨'QݾqZ.LzgKF0^|}3Lf[gfn* ngdB=;vɥp4n\%(z{JtPm}Z}X``3TxɞPZh[(UI=C~K_ 3t_FYMv@ɹ\TorUIjA-['c>[_3Zxaڧ(F뙶N&f`6 ]n^̪\$HpDWb Uu HޒwuM3 ~_TY!H__"j rN*ʒ1j7|L?12=R _5ȁ$&x.*>8l`=|Ae~RT> stream xڵZoK׀㷤{H\"M++{J={g8Di]€p8__?ͫoM~QJ{qsw!8gJۋLfUqqF7|ꨫ2\PGWs_+cX.kAq7&W*#g.]wn)bJЭ/E?vVZoeK:_յcYj*Q7tw;Sk\4SD/᛺m8B>2lᷗo~mcS\^\PCW!Ago$ '@%)Wz@d7Tl>۱y]5l_yaϏiء}Ϗun+v/71L F<>+XfY) u.,+2c2!//%SgDfs vmUSuRDH(TL4*X߰B63gEj-c܎)eN+ >c#A[9Y .֩!7Mޏ{,+५;m}+~`,[/=hn' ,?q.a4XFUJ k\vl9u~, +%J YP,ȏ],r%ϻ WqzJbH.M&}V!P=6 " U,Yx ?&ĽM o6r`Wz-C9'j$x)6<+Ww8 F&ԬbWm) L3K650 w}b5LTq_)Ud&ML(26yg1RB n2Gf]SH !hh5Pc<cEB1 oZA|b~RaR5vBۦj[Ehh%b4>IT0of:\ű}r{iΩəKIBdT_v+";'xl LX?6.^u ܒ|PN/_cPUXXל[w!":"@4͉=lh0P-Zъ3?Ai]`?ʇ og(45㤋}O#;JWY`?W[Աt/8q6׎8CQ;O|L/_jƺ{f|şs~ȮuSLϱ8F)39Nxh VS7~ Iw1;s;tdxlb|\y7È0r (,[t HCٓ+m_ +4U"JzxO5 ƅ \a+C*`h;F ?+9RVfDm6o}VuBSJ e0]L@َj\T7Կ𾬜\"v [Ca؃fƇ<5}Vc=GasŎ'(z8"Jm hZmwveӡl)>)8q̩vd`y::Z &9MUTKTUPB-2Š29 OT"u@B$ZYy>ufc'^o/G{Hy/vڎTj]tI"'lq 66ۼ*Ct=\2JA]َ@e5ɅXLtKJSiV6|=PDz0.+2!".$2JRzkWCVːSAl~0:㶩y]>$D/Cj`LS_'vcԷ}} :0 >j2>0ܮ( =(:s"\6y 0GK?1βXy_ YÂѝ8ǫq*7KP3}[ܕl$8.jK3G|SñyΛ]DNx9x Y,"# @Q.͹ 뱢]^dj({_/s817 I̖7ʟ'v1y*BVUFe&|LHer#gKKD}=0:;n-[Y.:HTRmq8ţڴ8, ~k) LP@d,%9u̴;gA8_9d*"/*=_ic"S"Bm G%T3JTrJqMW ~> TF@Rcԣc;]7RSmᡯ!@zx,)t8jPmݺ%i#Oc -X߂wLjRYt-- 8z9mTRL c~MO?Y q_;=,Dg+K;Y~NY5]K@ ~‰GА^ c^fh;wx<00]9CwKɥx~I]%M}\3`/gKїq©(B2Kڿ29*K:Xx!<$79@}E) @cɝ*^|%% -fpzԟ9>fqNyrEk-@9|Am]f*D}r8B||`hDδ)b޼V- endstream endobj 3711 0 obj << /Length 3979 /Filter /FlateDecode >> stream xڽ[ݏܶ_K,~J S'M}i TS+]$ E{o>ȋWwx틯o^~g*2+fq)mWUf9?nΤ*Qe@ˍ6A/b&?JDdt t*"TVwWi߮2Λ2u\t]+>>UQuWFH)Mw#JkTմ124^EL! h4ueH Bv"~/Cl%NBɘHN45wc4l[ЪvϢ]hxI$mM[ =.k_ M|c^~:CF%E^D;*hɔz<h҂S3U[Fwng4l58m4157[$~j$2U~DO\U5(\]vdLFt;A/dG2ذb"7~^GZ3I3Q( #)x# 4*(ACr] 5+<g0YqԷue\!?Bp=Dpʪ*өO]8Y5 G0z/s##3 cpb6Xlmw_d$Q2Kۡ"XiX Hڅ]?+"-|zvͼymA4}пKXRҳ//rT`Bz{/o럿Fڙd__ ӓ$$j ++AT Fi~e%RgCu0L|1SU~*kB&0K }ϰ@ˇwh/+Xwwa]s˰Ok߼Hg`?^mS#eV`H]m`c}Ӹ$j$q ?1DR>>Ɇ35ٵ+j#f'RrnYpt,_:k2 !S43%EdR\CtKy,!Wj @q6.,Tj0ğn ̞KT fā^OPײn$:`EA=idC̘1( \cOOwc&m:P>|OC& * W=!ƕlJ d4JMoΩZhupYg\^\bۄa~ FIKcWTuRyTjފ]{aApRvwWUV,NŠ4҅לE6FE2͞ticغ90C >%`)ku $ ) N hSC"p ƒǔEFf>+"Jq}IQ5:j4UU|tjiKf;?6]C%%Ӎ BrDFyBdȄsJn-gPGt\yAS ~}N/hN1rvjd6 IAŰRD-Wf KV([("$emׅU?o.s4Jc;MU#Q HߝHPDq m*m$Rp"!OţhYC 5d,gstJ!Mkf-9$E iG=N*J't-xO\oAs(F*Ir}qKD?ԋ`qt^#u ^pG:J/6fGM:φ&0. #4$.9x !UI5=eEvZ6@y;=G~{5^IaLd(153j(~_;zJR{Pyi'U[+."h'0x߃|`ySv@gcJ34/A9T4\4 S@Qj0M Q)&暜<ڧ|RT.ҥ. y#V |t;Ob^ܮ>j8\Iba:9bg lS8 _ ^5T`WA s8(_>+hX ߗޕ(?K7aS{ Qx`8 ֦mqG Aabg \ Pt{2vtHX> ۜfBY?>-a9|$VqehfU9;Hd&{Jӷ tD2x˽ͻnP>'kN-z )8Q22.JZo0.$xWZ _2õY,b]:A%l]6?N5?<4+\$NwvϠ#G͹8s&?W9Wk7m_PVޞ6Qȧhڻ->68ӂQ.WhS_> stream xڵk۸{~/bE"ER*piҦ@wX l˶.#-pzI>XQp87mNhJ7Yi7MELqe?l~ ut2CiF"B#⽈V*lPwrw'`˦$ ~TdAkb|VG:#f/:;_ASw]Ӟ(DFr{ꋮe0Y!2%8[] 1f9HtlARDcy p Mq}Eb_%lj; HY<>Gy[_9k L?sA&LD$Q暒R$x;4=&ˮh l9'dy{8 f@yؕ?az<[NS3n.͡oLpwqNѮH6+fŵg#{G׶V 6=ϹUfWPIK/^2< v01)GPs`oI< 6' MQ?`Z,M2nC]>d:MV6K5A׃ފmڎPHq}+;R8JC&P&^ܰ ZchhpӢBҁ g΁0Vos8ZN-f[M} 2>%'|8v߾+קJ: &C%P+/ Bw 0*r0X.9A?<uInjwi<^yz 20bZr2 VBo҅Tw-cMC:U O^[r5syMyY{τBώo"7`J%uȠCTWXүNQs^e|T8tGdREBok551G-pa'V/)1 Q;F6:̌L(`0L2_,̐PX3WdPN6{d6y$x{8*Z I~pB%_ĩp: { /(bϾK=?cG +Uy2wϖJP(Ff <LʷP$1T^j21"v810K8 a8HdRB`u!-}iG7?T(_zNB+[B2[w&}gq[r8PHP8(|*(V1u*fFy\e!L !,^IkIb;O,r,y)4(b*GZu:F+,ٔ!iMS YW`\$QFN%l\`4' R`cGR<Y| MTE PLUNE=zhN0N}rwE%q̻-&!(׀^^˒S5s n"VHI&sϊa>% V)gȈ<`k 1Jrmr9~bL%Kp' s3TC(Q`;ҥThWp@mZ#7S*d!CLE\բbAsU9GF 6@*Go*.R!(J8Ж ,nl~X.ʎ]Ej&+:`yZ.PB8)L.Ų_h{ROxgwxZhز@+\ƁQGIM(TE%Ҹ Lٯ[1af *N4[9Ԁ1B鱮]}Uq[]KPu1k$e(d@-E;lyskxsc pُvmgVZ ?F>H0Ba[זz<ڵ?ׂKq cGfG]~ž-<)'2|E-̸>.Ag6T}y ьe` qۿuQAljU[T幱:$nL<ǡޣNͲDnBf[03m.hC*%$*;m ~ݶaj~|̟4$"MӺjlAfAF74gն F|WA6I3s$@NJ@QK!邕 αs0镮F) m2]D{sX׸ <㣛ljl ?;W}?Yǵj9uDړ! ^5!3Dɥq+>vƍ!.U\E_ZEDz*lڣ㳌v8  _%Wpbuo=w+dOo8nH JS f =q OIl8ξ }G2}m〕i3窭}޶P`dzp͹X@v6~<7F 5 tO"n wtpWm^:~(ә![_-*CDo|Lw{5;u=22:FUI0fſSVÕu]1e2޻cd^K(i8jv\+ J;~d Oy,l3#3ސ$iv SFh"4nb^[Lwh &5sֆ<փ@FKm p:"^Iш!Yzvڵh^c.~.͚s4gQ"sD5EcѺ AIGZ©Kd.B#73-K2sm´ ugUK)a԰A#Jou-ͱ;E5%Z9Zyޑ>:ljX8̥p1;-R/˕8m\דVLū[WOY,~ x[mXZ> stream xY[o6~ϯd1#C݆@;h.D9MoI (\y:+u^] }'AI|`EcęgN|*{I(I,΋\t0 ؙyl"zYJͩ`әXFIAE?5+5EB(:v{=œȋʏnV>LY)iL.3$x(-Ӫ>( u3xO3JXɓ6#7pf$. /W,=?ᴔ2dZdl VsUtPg&m38WPRz4^!Z2}ˉKaٖUI/0G >k򍙩!KlCOtŐTv8yS);$ŽXc&ӪشJ=S;=(+|aF<k6,廏ʜao V+ aPJ$`O1CQozjCkZ0j̞Pf9_WU6m45!fƁ5*{ ]R&w( %&\c<@!o( :oDݦ7c>%QIOܕsIz)-54o*=01B3 ɈoG"[ܐ*=fcqd0 VjJ"۟a#d߯W=UڏJp(Cx0tde#5ѢZt_Hw˨^<Cs>L Ɂ!כ jK/ ?9mqwrx~!K}Ɲ3@E~xRy#,DTQX {Yy%Ut}^FK(&>!`݂ P|BĞRfK 8rm!}`;*c9z;ChCF {:kcˌֆ3VU}l]lit l62)ŜL(Lj33%Q˚Ֆr/NسQB9᫂z ^*dcܯ ]FJ'D/8""J*jb*Fw:GcGiУmO%_PY%hA e^W'sL?(d'H)*޿b r'S8VP2zq`OOns mX ҲҶ gˮkfS (,/Ӽv^KZI_'ڡC}#/XU>KF<1iSI UQs'Y+R 2/^Ux VvT v n fg]LwB`a[ 'Inep%{[_ӣq]bwj bvjMxo͍ռ|-h=U RZ>f@qMɍ,p/*+uAp?ɒ $EtlpnXi j6fL6fe7M{v~+ IvW@Ixdz6aYүv|lCH86rO|*џc7^:l !˸hB7>gNN endstream endobj 3775 0 obj << /Length 3516 /Filter /FlateDecode >> stream xڵZYsF~P 2ǘ׃:U{f+C kqHv~vOEqAsŏ.| KB^\/3‹s*'"/߄jUƜ"L搲{ah2`FlEDIP}]V 5ˮ߫Dܿ tNC뒚iiԾuI+۸mR}nicE/o)'aD9I))b}*늺bm ~mҮh"3R&I, mM*؈ %_7)\4VIYD0HP,(T/l(]fI tؠ'/KLkXGhtgQNՇ۴)ںjPTts$m|ͻ\l =]7umi ݬmgd] ,Ңr{4Z1snӪKO*!H{>hi@~VVYbd:B3ŕrxDTq}BTvB8FYIF 2&.f[o!}늠ѦۚZJMGe8HUuف莚; HնQ_x9eeB_Tpn;*u:XK+v'*+U"?J=# !n96>-Icgk) g .Vrã%IO1 `DNZ5Jxo-wAWO[!gRVB٘ RV2aA4Ķ&BWxP<*\ Y!0knhC8ݮnzB3R}Q]`I|H7<9D:ˌDuZ[g%ע[1b)}'P lJu mkq4՟Fڒ&_ {X%C d=<34Eb?`ѻ{r{W} 6{6);+Ed<,r'.2I;JրYዕ`gјntYf̂ C2C2=ם#eK)png:a 2[f540{Q(4l)bCP۹KA.4h0@2?YbPF2')Fa8PD艹->PD Kb+MQvcej_diYJ"z0c 0թh΄sVM{uX"$:- +e#t%a` =m(8JIإnrm7ǘ:#ZlDn"5& bR"U` ʏ^ۮ8I PL(vѐA6mA@JR ]RSӗ %B5$nw҉Uzi& IXVS)P r3hn)=ac0dNm28|g'L 7sxeRx(ꚺ<$̩P0 X@4Ws$l=Fc^p}GI\\pb{͏;LtVݑ{pX9{]in4tbLAKM|lXR"9G+^NÖ!omizך&E)fk!(pR}%Spr$}j5K2 p14 hekp"g0'nr7ZQiy]7sK=וY$U.]lJa*d w^+w}#Zn p" &^eM1߬ku.6:\f<^VwfۗJ QE1H +X(N*C!'3X35A箬5U?k=隢O" :<~(͔u9q <dbBMn|;}SR4&'6 U~t}LҧmMz@ ˜ g2Nlr}Ub~r8rnw2{h`Lߵ`$zaRf}=Ĥ*k8=̀k B=w4{, ׊&]99^9"D%FPg&^OhEQ"Cx% ֢3>^o.?skDLy789oWd%KgOEvJƗu ~ ŢŵC7KA#sXw*w^OM;w{Ċ|q::3@ú})eWz! endstream endobj 3622 0 obj << /Type /ObjStm /N 100 /First 1001 /Length 2950 /Filter /FlateDecode >> stream x[Mϯ1Pd"c `xC[kIc#%5m/`x|E8|0> g3qerh6aOz+Y_P&>Cx~1GZVpQ[xN\'oR0B`C!{P̮^h^d(P_Ro C%{m'*Zz7.'E N{k3f1aڋÌ%#au"ùG &Mth+HEGȡ~+f& ˺I03yw+|i9k*RLX/`NhI}UoRz _K芗ljaA%F +Q~G+z7ʼn d2Ik@Z\e`t  HV4U>B d"uaJzMLщ JvxJwA+ztˠTNM} w_j+0Sr_f܏3366///zܭ~?yH?5XX6c-өD*11"&@x#^l=^~ؙ{{:W_ﶪf;mvڿŲiT%P_2EMVn1p%C#'@.5h 4"z0?]K"'i}E}k7|OC)Oqenwa=!&xTd AJL\;LR'1 :?#*QiO*v$`.Ip^&{fB4"#CE ^nnհE &\%'#p6n&dBG @|@ͲW8aB]|qݢ:Q3 ?䞚$eŚ!f|f355rkC#5IMiRSԔ&S9L)B̈́6eĎ쭆P&6o|)yB}fݬn1 H&ēas鷎(e}۽6jSCH|t f"Rk!}OvM?68ީbr-}"\/y~|nÇwkRZ{Z6BI+ŵOr雚S*yzC=2~-~^lTekekLՃ(uR;=͇̈́.sؒ%H}# E ڼF5GY7X[MяdHQQpVjZ3>b3W.6>=PMM(Lg54EEBtTQ6? n ߚn7[Yewɝ.\_@p :=[r9rGZ niR>DXc"q ,467[/'d f fF0#tOdIxi)VD->zֈwunOW$^rb(wNw fZ'} DQ9,p\j| ) @2N$#qvglL tnQ-=U T"-h=L< 60nUѿzvbWE$HUVl R@:Ua&0_fx}99XSˇQk!ĜQLF)&[GCÐ&̦[Ӈ]kGY)9on51AC~Yt$$y1F-o&G6>q=(f> g^y?9*p]mb:spyMt8:9Bl3L3W#n7AD> stream xڝZے}WVX`׍Z,qjW̒Ȃ Ogzzzn=O]m_]\nwem\~lm:EOξٛJYۗkNȿ㑷"2piyvP[]g-_K'xxi.t7ᢩ pv\4ɯZf0N}Wj~bp^7Lw-Pn81)>vҩk8F`BO'up!66M! ɸWȂfEcZ5ڈK] P(OkJ4 l/%xeNͦEMڏ6v\9вYsb!,|M !w vJ"=/mBʱ=@poCGBhM-$#J}a:ꄥM]zXf<<; sq\uֽ.U|kΐX"NSx}U&[GUuplpHDd2&HЭ"pҥەӢDKSߏ9`p3y\jE?qURq t^~3Q|Zt;qab6'l[{pIXi)m/j 甗|V$BRDzm(=!#ȸmܭKyGʳΜw Md]qCSs^3xVLN%Ix;pBN V`/lڈ݊+ gi$09bv,t@a GeDzC#[SśƢH|:L-qY%B D.`*Y*wLḃ(em3Ŭgr}NVt&eΜl7em0wG=csdvW;2Wl%`ѺX~a u @Md[8[hu`QD,o$VUiPm[jyɸ:AF6\|;s"8ȵ?R?4AϮDY:aLTT l/4H4:4)F+ {nr_Iɘujʜ۽dUc̟ᠰ#XB*eKC !VkB7 9OxWrBB$hm(X g![8| ?F Xf (`7l:/,byP,V,BGl{/ȏl Wt fY',.X J@A0τ$jZ&U~r|O'+/C#xYv^2ZXi,`Cj5?9e#֮wzz`ǧ'kO-=78O.l |w/ۂ7E6g9@%SO\p۠MgZKN>%g9>G z\+MV`CPp=h<Φj5`!yBO9CMUc1зd |ߍO}O/)MF-Kp8#Oʼne 2Hϖtܐ2y2S} '|ΌjGꌌ:'JJ^8%(gBNa=/o  Dvurlk&s xx ټ|I= (F+ߕ|c,ڼ| ]`RVkF+A>xBy1d4Gdzxy,8MMiӄM\,F)I˗R~״x}cB3~ozKaU3dYzEOEOq7%2ا5,]m_>ڮ?t7Ϯ9 zL6GڽybmBT7.?}mߥmsmfm:w+*|#F("Q_t?M,* ;"ti]bq2GLQ)c{piB7=~`#oR (0ܥ7Z.8)ѕ[}k2x0G7J}de}yWΗș?K]~Lwr v~A "gWϯ2KǴd[ ^3g=5}8<ĭ!WB˿ PmWÐOڽ+o/[yXŁ#v%]B3 pw 6gKwkbR`Lqq |y~ xh'_ S%ӧt_<5u/I`"WG׀ 0 u>oS endstream endobj 3796 0 obj << /Length 2536 /Filter /FlateDecode >> stream xڭYko_a$<8|'u6&v--0$)E{g)Ӳv[.u}ꄞՓd$y|rus(%"OH,D\HH  ]#D8*Z;Ss qqy41& 3I<Ň #||7D)p w!jA}mZG tb3Hs JS\e36؅t ^BcxS俙feUiLH5l#&$\UeuW W$RIp m 62y l j[A=Ě(C9)Cp3҈ ¦3ZV3PM7<$hm%v.hj?xN|/|;D^}n; b[]3  ~Ț(߫No˼EcY2iLMSkzbS0. ?;ɼf4p)2|@#;ϦXk2`{o_@;_ԁ~Y$42Wҡ>~{^2ϗSX Erl7یe%j+]agw %pb|16(QJB֗.IiGz& pLGqA Sk\o:\L dh|6`ǾCj\7p!"{&pM]d#[~d?qF3&'\4Bۢ1VGKpp5ojew#,g` |PNl;3?~ލ=ww* 4&}(,<;($Ѝ5@MԍTNʍOvj30d= .X"3K l]r'q/Rהę8ڜ(&'֙bLQ %Oy @DHLR*1î0W9'< *])૱閌wV`0SarfC o_ڵ@y+msz!֮[I/G';sO'm8۪Thr~?KyM옴k|cF-{=ȖT)l _xFl,MҋusD]uHҎ auY,EclwBš Wp\?r7nA=cW}V"Z7ɍȐX_^4ߜw@FS+& *J'S+>cpA_܂C'm^,Jx콪 cGH2 Y\PN 6"$H gϳZ;u9zݕGғ zo1TP^z.Ʀ,Fh_ׇ V7Jr@>8zI`ы*l CD>U[ r.yZB[,0fHxp~WPK{&o1$ٳY() J/ܪ?6!vrֺ~) ,큰t6 ?y,10A?5rUV駋/ [*ʷtk7SG+Tv%{sc !,ypɽaZDpޚ-?J?V?{Q6Gլ65Rc R] 8> stream xXK6WCm`%EQM@K-D=vEKd1rjNQCr| {+{FG7wa(Л/=1AqBPHcozFlo7w,ӧqxjZL)R/mGZ}Jaͤ/^L q"E#k^Pim$QV*Yo" U6E"lbfJEҩ<5OY+>a7Rm%gWo_qumʶ!m|뉙[ '7|b!XfŢT.2il06e*s#uJ^y!ɔƁv\=wSk5F&V{fUU[c; 6}vr&WvYLRG#pYP}/ٌ>~^ aD{Ъ/l󀂜{Gv`>uu~ B8caԛ8"LFL_"30IPlʟ&`ڌLO8Mb-Nk?R D1W*6YY۹cAʾkDυzc~~o("TO|6Vu7KNoGjDZ D!#v< `*`Ez(i"&S#)NccNL9N\ȼT>WMgɵHa #YȊ*ֆRBR?ͼ1FW<'{5L0s :e5|<݊X{E0Q)+ir ֵTyE6MIQ9 FEO=:Qq"vk  I>H*5A"XWbvQ溣.5rHqFSή"Irlm/2̪jQrv΅U!Hto Ye5ڍ,dD[d'QEP Lf$ݯY`اg >au KIP0Rn>Hs{`0`>a:)⤏LtRĎ#`NiwNe[vd6~a_02pnzť |ʖ G% NÅF.`Q.0ln̗=Y>^e,E &3L3 A{2$m} 08&sL8&wqL%bO̮Q|e<04h] Lp騆&&jiӝ˚j"0V2X(IjVSP 9e#t7 (Tuc>ul)F5QqS6=^~> stream xYY~_1؇D lkH궟K`AbQK;E]u RX$XUR7uÛo~қbܝnR~7~d7w/I?r!gA@1ܿھA7Jp`6uD)ݛKȋb1y5X.K[n}mw:λrg"_=\wkcyzd^K3Խ07B0~9ڪpok~:q`'݃( ZY5ζӂ)?# v|qvY|ԲJ(may5kxA&<]-kvc[ïJeT~zeǴx玪kj&Ў&ZiBiU&5+Cu0QO;RfN"E)k"c `V9تM>l퐷mC{ C~~zbOKOT"vޗ"+0~4i'rx4ۧw[\F1/:PK 4}mh.ȦB2)IPy5'P lY_GȘ:7CU؃,~U%ldk9Ѝc𶩫Gvc 8s+ېfWՖJ^/ڶyoFe6v _͂:ASV}=j0C2"sj m$ #۠bHܔ s(z*@D(P]D' `8y*?u4p_u5tmqbaXZ,墌(%lv%Bd '5mmg HH0*E~(Rh@ۋaӷ g>Xih%"NETۦZc-?6 !/n_UPίpͼy+'W4vl5x7C"=c:.6" S#ԼDJ2AA2m/h1TצSa=BB}EN(T"e3GM0vOKw9\,KͰT/RD#ľETfNSM}gpChtq̽L{n%ٕnb\l# \\1 y޺~?l˺Zdc6vE_!bo7pbK\XfT,GMOjW23AqnD}m/ 2ͶM'ݶRθvJ2v}@, FjO~VVJ@F`z33$HǪ̆-sN`*?{ bM7m/ 0mc.lHSH%=ٓ&Iڼ{qmbPiá{<ЦCLC] n$ @f\A3C7K飉Qc Iɽu(A}ދLRm@5".mW=: jHy?2]JQ=S,Ϊ6C*@U8>)]l4=pl&A^ F/p`w:b [Qw{%(KoF>_l\oIAGE1Krv`S@v,ߨ|I띈mS o$B٧Cj|"CD`Q&r7ThuONk4xjF* 8hvֶsE5wBx%Y#[{E6 H/|2 5('qE<-6NPK[.O!Ռ/"NC1@m_bw.& >?f>iǮn(2'6\ bZ_QY7.c򩱺q>F_Sx]k##uf]EƩ ˄t4W]W^JPrf^4H#Y%P=AA[uxc^@! 25> stream xYKܶWLnDoW X9رN!18Ą ^t 9˕Q%9F_wc.7/^}%Rv7]"N]E"MG0*qV͟_}q,])>#n/s0 H\0ӣ$ƻjĖyhQ5Pxm{%U'B=d3A5x>^[VP!{L}ã*Ӫoރ4"yPc5;/ |!V"cQLQw +4 S2ԴLiɏKƻi-ɶS*Ն^SIWiTaxjTwv]!^44M-;lUWO B %7DҪN5 1 ҒAdF>U" MNFQ I0P#^[u6Y/^J[fd݊VDKO#0"YRs`2%j4ŸE!28c% %8'꠻(o:[CI0GN(s (0S}G+Cw77X×䎍{ԏzv=,^ӎ[B9WJYrdܩA:k\PhHZCߩUX44`jݛG>MϜT~XLp`NQ7 `-Qn+%ajʢBa 6r8=:f\V h䊚ǩ3[C{a?~b(ZE^8S[zD ]t$w>~é 1M.,U$(a[#C@+#W>ûLHfBLG&E)zE*dRA%elI0z3 ;a ft"a}\FL)a'[N XSM E^,:㓣\\L{")߰\IyT 64,9hsVu{| 2tD;=u Mx I 89dUz4uDX΅PO'6'^wosܥNم#Y9ξr]Ъ^fJHNmW a |~4Y9 7w mm8 L/:.rj!(ϸ4;-f6RC$h{X,C0l0غtfl7KetkE @4)F./))-dnD?b>,\$uWf_1[1@¹mhp%a!\~Q&27Ȥ?-t<}O %Y_n( f={Pcݑj"+)ZB t)e֍'٧|@k ;+ը#rVA&2)m^(|2&NА 0 -3aXH]& 0J ԃ y0J]^ͯ-i:-tT&NUh{X+d𦃲ǫll=Y.2y>32]&UVwY19DB rww^E`beSTENa8E(1 RfìPV:FzLo(CzI|(yb$*S8LDsuo7D?@k8IX2#3"ȅB`DαΦ?Q,,>m9ҨuzSj텇m=l?yRu9,Đ|wHǫ|**7ܫ%+b.Ć/Σ sy5\l>gà1{C=kVT8ozcCRc&V.M[fl-ETlLDE2O((Õ itwwlqHC @}J z„u.]ԾcpnjlѼ²zfmcVYv|uL'N9z!eJrW[ p˿)..|=:{',j,ffzUJ2'^LW Ś J|5>F%8Vw #(̗56_ڌ{ù%»eIU#РpOɊ/ v[b$! iQj}:WyJHd Dj>}(9S^ӏO!(?L(TgkҦ5 l{z?}tT OYejy׭<۶bMq'$U(lӐaa^#Ngp:S.~xEfʣs;l[իv1gx?~:vX8_lK|hٿg՝Kx=^eyOA ΀7`${rlGhtt!>zZF&]vߵW\iJ U IٵCQiJb!^G؍iAtX/'ּ>_BgJ( )[/ۛw_ endstream endobj 3863 0 obj << /Length 2532 /Filter /FlateDecode >> stream xڵY[~`hv.!mw8FAGTx=gfx2B9\Hg")f_ƈ> KE2]L.p .ӃEgv;]om0"/0ڭ[=_μRWMVWء^u;R^sDgZnĹk4w{Hm~$Hm~@UDh䷼2G3jNFY|:-r2_HνփWY:ӪNW( ,>#)1նh2xԋtΥw3[;T&QDWnORDvG*iQEL}"}1-+)|jo]ƫi2X+6*MI} nI;<䒫1󕟒 KDV͢#@ȃFڍt;9؎U& |B^ƛfVq>bYi8_- ۧg:>hw-V-X)C B RC:s2fq-w7bŽ}Vԅal p^$iO"fD0|E(0>1P5ȳөe܃"\1grO瓈C3ԅf`KliM_@8#~p"h4h4ʪ;NcC&ppp,P%sp͟n'|Ƅ :I ':7ܹ#N-'b}}x".Ӣq@2Jaש1d]7&P5qgjɕ4%&N4ߴu]Ғؽ(iπB}4 +V> [ڨjG < W~V^"A'(Q.Vnl$+6oߟGI!AOlI>Tnm"g@eǏ3G(32"Zdͺ2,y7s 5W`zUFO8?p Y@#EY3~3Wmz_}wu@ i3b#2bYJ?){0d!pSb'h3n^+׾5eY] ^UY(XNi`3+]8)xioˋz  4ѐ]TڅOץG+zqv'LU s+jdTBF]RG;+p+@'HFȄ?&Lex3d)>BNd$ngI _hJwHH8qB :~ν;Aջ8%8J(Nyxz7i\ITRҸ{۳RŶEf`6]yiR@F~M҆H' #Y%R~b1MI 9AHiD1)Al }K]SׅuhE "w 迍wK]n1湥݁Z|׭ |WE چ`-nD@ ̘&/ H HKF= e )T#YٝQz򒸎x@B?ė-%)} \ E1)[yTt\Mi'}" '#SWB,虨=$ITp(j{tFFܖKBqu f^yҬjD + eSd"v1FO;?F>-E* DĭźvH6JŮpWSJ! K.xg >dACPOUET(R1 ܭ/; XKϏ{ T'6ċ6nI-^^m^kn<|3SP_l-+HurAy)p4de=Yʞ 9ݸOHBJE+*=:|bֈd#Xl/t&ϦNAGدǬC0_#qE3 }<6J(5O(UC>a>@c*&=˗XxT^!d`14+6TjV$[[buյh=6w T@^NTtC::1r&# r> stream xڽ[Yo9~a<;@dw pyhmGvt8ɿ߯آrm K-vcn6J@^h„LDA:1sS'ÄF&H1?BkƙP,#30w÷Ah(tHELi52[똲$B8ޫ H1兏kAi֋x41[3,x6,UhU kYP~.C 7C焕 T@ w)Ѝeu9c 3IDGy7IDyynu')C<f,LSVNYE"&Oi WZpex{D"pC䩕A.Z$ ymIeƤM)Tk!MtX֞2bga! 3ڨdw;<_,AvsΟ.>4/I| ԇ_:8hZ75!e$Fd$%ahފ^4oG y1/r>~(56VIHɬ?s.k^a $-tb Iw1m2%%d% $yi i+ p7Һخ/٦[19(jH]"B\ >b nzqxpp4Q!@e8$wYqEK.V{Jxin'|=C4E"0N=Z $z2IX w 9$Ac0*K( 25}U&(8]F}cC6/5=!*8r"ñnM'D+yXhC6㸲<#I,JmXE{LDw()cY\ p0jhqU9!h>WTuK o>a1A 0IKdU7ufFQl&pa1J /N OVvR3SD*@P ntjs|>U 10WlyxƋɥ~l\~89DuXn0 PiHrS;¿ilD90UeGb٠|b,jyԫO$b# 9D:!Bb3}9X+G{rM^#_ukD{>6Ͳ !ѼyZ4okߴgA3u{Kgٮrҭ~S~Ww2m_D} Rh00o >m-1,CIА"-z'\u?κ6J@<&*$8 !kKj_4o^4e˿'L YsN>cW^N={0Vk;`ׯrޭg?XSt냋}pzw4*i54ùZ 7ftH<_3tѥ_0b}m5G\dngzDg;g,54T[{#ɍ- N0λu_qV$7]ۙ|S@L1tQݾmɸkX?:F2T>xJ6K>^TW_ՆwJ$^9B^<:iW6DU`dħ8H) 23TvVv66Hmp(>=ǁR,7ӣ@B( Z`q(+N>c\oզpXt no'{cpq#qFڔs4!~-X$Ϳ-=8(sPB(~>n ]<U( 8c7%+OnM.-=5d$t8gB4@&=Cȑ1!`_5<]Maf6D7DH%W(w_>}_ŋpԄ}Gk,kb9{{g1{zn'Y?2W'aC/d9b,?s7mW2u o]awK0%JIl!lc{9DJuB:RPL3T8SL+] gW8ήpv+]P yhŒ=负/cTH)Ji8CcTh>o+Q@0Tь9WvR)KN]A (jzigDPAc,Dh I;],% '\X6E7=[,N+d7e"UƲ6O8BG ʬ=>|aR{$&H&. "7|j+kQr-XCd(/_r֭" F -̲ns>Ů=`\߂|!kx&f(y.&|Q͡tŶOߝVV.+$LԿH8ǹͷa'#Xb6^+|MjIt endstream endobj 3887 0 obj << /Length 1352 /Filter /FlateDecode >> stream xYKo8W THIt&dmS2%i'K\m=`p8f8A`Dɟח4 TPBe 2 >DЦo߿L(+ PfIVhI_NN0Q4g4(ɧQPIeVRk9fqs+{Ǜޮy{'PwJզQqAՁY7ؠ <~zQZ#e}^}0>Րio#$WJ_̳Ԡex"ž[Ys`/kʾR m[|T7&\8Vlwm40]7ïFu TӐ 1A&C)!Cњ 2Z2zM*ҮAW"xcN]==dJ5]^;B45©Axc֛Y^ܤlќΰ"׼ON̮nbqgcr*dqw@ Fz@Lfd B;\$ O~Hݹ%uSZW}ifvf-&?UEF(S\1cÒrZ/*a#1A~wpsVq; IsS2q'wθӀS;ƩsƝq9n?aaH endstream endobj 3910 0 obj << /Length 2045 /Filter /FlateDecode >> stream xYK6W{ z!EEh-zh T+kRR zy}{შ!5~|3C͊޼^XKu[ ΙrU UJW92?~xwGCU(!(2!fm/_+5r|e>EflwZKHqRil&JUa ?4NLww>g;:>d*L vơҝYENTN~B?XmZ9R˶hcz?X:0ιR깾 T7:DY,daS ^mw]OCC*n`E;tKҤ*CihA̬w`y|]d37WE|8"/) VSx?9็u' &g[gEU'ꄷ:Q;;[b/ !\~vЁ%qG *p:tDl̄?ch[HL&_c? ;Q'+NjW};xրj JrIFui$0\qlLu/mI [`#cU"2fozj(C"nIQ|3Q/`FgqD'eQm>P,}#B&ۍ0) (:B1vGOIe^M$0 Q˰1 *pn<]v!|fn`ݱYLk6cY gg9 gq_< ?THD:PQg܆!a?ۈ+3:q9%,)/7a<Xo"2V_mfdTg6i3|B⬘Y)Kx~ɞI\gԢ,n3-&@ m)m,b\yC$9uuwhltxŰFy$^ Io4}cIYJ#怎Tmf8GQi0z#hJ oJwIP{,t{̺ t :щ=SR6՜yB/u|;Gt闽Mzbƥ+,zL fE}R}Z"uG}5Qh6ͳxz~ƭQɋ 7CncpJ%'xI0%'EDgiST2ifn3~xooog@ .H#P;upA03)? רE @AHTJ^dFdAņdCCS6C^Ӱ.AwiѤk,et$1M;U^5ȭS@Rys5,|cՀB tg#Meo+?4pTo>6s+7X5 2/rb`G8I-"L vUakΦyŷo/>WѳQe2vv6W߽_ikNtY4E1x0~Xv^ϴzXXӛ??ǚ~vsHwIyf5~4˖JM^f >/ُE۫虯' endstream endobj 3919 0 obj << /Length 2902 /Filter /FlateDecode >> stream xڭZYo~rM6 7NXk!{4y̲I)O]cLɲW_Uݏym27U9|s0%A)w:}c[}7otdd,F*'AuTĀ'/~9f> is*rC[@ Hޖ(YLZWkóOlR߽9,u@0 !ZA+|`F|-`owWt/7^u`_)lTyw\(#AԍbwP8iFw%,*Ks92q2PP[ EsJ0XPv_ =$ XK ʅg8M^S5QI=v&? ОcE!Zxu.rhܯ,fsDO6\/y??@ERf0]x9O{56_sW I:qgs]^͟~|=gM5Ib*yzEVS;gCO;6 8XˆҀQZnhtk"7 a$vo؍e!_n$H@\f˟@2~$s̕@IRᆠ}9EB7LҚL;ƖԏE^g27{nfB@W|aQQn3S5WEUΆõ4 %(tpIeff/F,| XF v(C/F5q Z nHx[>h ,G5YT]RlK\v /XDlQ DG U4%][Uu Qf#Bo\4썋lXlA2bnwX,SF1N۫ ޞmY4fI*( %|L@o[(j@'抆`Q Iy}pn(50 FqxֳxhNlmԠ*mB^դ:O[ u>Y[ ҄WqaS )9ug+!FaQ;db|7D%r\8k'P*5Ǫ9`܂`G!L"zR# hsB}S},P#uk0 0gzHZdz}e>H odǻ4󴲒n`#b@(0*7G*ȼ v3c:&8pg }ZNPMme'N1eZ"4:l:Y ט"͆jrN9>éfBϡNh3iD _Da:CJpmO+\:(L\W9MJ+ w}^WDžtG @nWl *B&lKqh!CT$?U9%+BU)Wȇ_}p5[{]`VCAz# _ɝNoМ+7c Sz7 33HoށFOhóJ}T/k3F|ܾzTR#FZt ?8~ޡeH&ˑi?D\ޔ~fY$hG8pU4U;OTToGJE&HDf=|:XEǴ2>O9 IYuGqˤ'7AXT!*άϾx'Xv-ſ>^]V[fts#[Fq᧎< MWG2U/5-l恋lH`6{O~Db9=FfnÒ5~9 *밵4[[GEF~ !uَ!dɄQֆ6~2dLGLt&zbOc7^V0)Zɋ]0Uo|tp ~E+Wp7 n^q% endstream endobj 3927 0 obj << /Length 2896 /Filter /FlateDecode >> stream xڵZsܶ&ތ&dx\+u,%LS$cDž_],@<&<],~],mn7'-J7Bo|@usMFG:ybZR @;]z+--^h ,$p\Kb1Te mH@dtzMvWGvzpˡϚ*}Jִy}}zvbvdݣq4Z;9Y(\CCF_\ҕ9E"0ʩpt*X*~(9M'S7oξQV 3^↌{w)7Xs 웕 6oM-T @yd\j?34fyuR~7*v{Ny(*ˆО; F 8ƞ#=Bš*'B Z1Y{i8{P@I2~9<ɖ{.yM#S"WZz#,#ʺHhfm5_Xp~ j6 @XQCA 8=ImN5-c œwBA}LaA#lf8J` 4\Od+)=uFnL?6w~ (Aӊڙ,׃kΤxIh[ \w~[j7[/Momo$ h>};!@ǚ뚑|qh[{98ٯ&Gy`ᾰo?o_ؑLN~t/hao{df V7: KQ5I+c-V,QLgb=6fW5*}5[aV=(84 K*k{J_L:OrJiF7gTw_\qLj;w,suZu髺=,_bIA|^-q1*͜XCK=Ʌ#(`[#?="گ8(\+/HHʽ4rF'Y51u2[U VE6+fs?kv;1g1HwvpNUV"/:`NMDG S5xy*+bdLqoBϰPy;HC5FQ@+N=U%K)FqYH@њ|L[')κmp=u/5P]h&H8oKc%z̍n-t ә3|h0!zKԗo<2o!"4n*7&>hPGC3%тB8d$r?V`h>hR 1QkǐvO\e,R뫾Ҝ.{> stream xڥ˒_%Re$qoUv93J䘤v=9/5nR:F76w˫/߽z}M.vwTdI7TDwm67<dg^)ژޤ:y) ^tjK@[!\RK XƩmєt83|ڮɶC+MqznMn.n<0 ,V>7{ý2ypتm Uw-ʲ*/m,7-۝ <7@ObkŞe#)o,N(=v4/b#jF|i;gUmF܏v$qo?IF+9"xs!LA\tl{w>U \I춿oG$T2Vd۹8r}M[!eH!qyd|q7\X(U*.(}Xl.95mq ^lIF:53@p aۦ{ΒC{|lSM` 2?6ݲJV<@rtm0P} *Bc8L7gGi셴qEО7ͽHfh#vւMoq_5<%^7w/d4hZaюb^8n.W4J*;`RڱT5mWoUQ")q,Jx_Wh~c@A >%5Cd |]/JY>8,- scxY3?E9O00I~~DAg+ nN-2ݦ84j̡ d=*"Փ髎O#a0p]F/NphO~ Op{oNULV*_R*nԩPc0ģ) GP> X<¶ JM'fȭvU DnV=y=Gc\ӫ0 1s`F-/(Wx_uU&ܔL?8+2rlx_;TT, +220 =ഢ0tI=t,Tqy%oY0ϔX)( Le'yI33k;ݒi5ň3vWK8$1!J5+"6KU4*{&;+2 zM"JEif*Tv*kCŕd,˶uC ?%Jp%N,xKP!hr FeS޴Dמ_{_' endstream endobj 3939 0 obj << /Length 3316 /Filter /FlateDecode >> stream xڽZ_۶&CA:ㇴ48iz<ԝ %NL(BR.ON8y","\_o}Ni2^.D*F VfR&7|UHU"P&0%jYp $|J f*u<ݾޭRe滗XL ǎnOnSۮ)]QW%f4c53˪]ְy Kx*_I|{Dzl׀X5ͩN*r#.` l{49CVȉyD+2VfYWyKwۜɾɶ?5w2t 2omC.@",hha)ܬR%nú-vǬ뼃YdYU^t^M4 U1&eg`y`y4 n7m),Sņ[iA籲uU.A]z!7YG$)|iT%W^bi#k-VL[7Yb%̄o$ ߯jĎ`pЈ"oEK߇}ݳЋ|VyF8HMe4=*F٦(yM";z m5VnAY->m l냫-[fV; ZV"N%s0zwd6oe:Eu)beV¾QA-ƪwa(tTE+!AlRN]s̩j|2m탩^$}ǖEaW4>SX"-; &rz,#ǖN5VFIiq AFDƣq`bDwV"K2kKLiAު0ru}L8uzxLtzb Z0&/ -](XbF4[B88dԉ$y?o^Sj-SO|u:$DG~n+ c[Z'-s%#%qmI3%.TF럧ؤAAt% )70]=Al뎧lwhc.Zj`sF.UcO>9\X5OoG4;Dd29p0fZ,(jN+'jEi@ddGթt1⴯bv7H*|j}ռ8msʹԓugGLK~bi2S~xPgˉ RK~l#$|9eH%3o2M#A~RlzfG鉵{3{yHMeD(&RB+,(Py -gVIh+LMń>/!#p9 ӁP:dsVٔg35ύ%$ӌ gzɁ*a9OFr[eu;ŽLgM8.xx`(a.-8acga*Nd sܻ]^OABxP LP.@ۚ{6[U׺d9owv)vX79:t>O6{щ vt/pwrLWjCF}a>3DLO d džHqI Y!J޵Qڳ%fbEJN6er4dL# "%C^l쒡'TgˠZ]g emo3"H3G*D\4?x]`~]Ztv!gmP;^ .{z&UÐΘض \Ք伽Q1؛V_7f^7VFz`DmN*l ZiqCh ¨?09c`8665:`DwK, #,6>1;>$ b |8^\t)x" o x7&1My{-:!3T)~bHo܉Q:ߚ"IU]ιڜkCbJ\pe3}Ⱥw5sdNcHU%qMA<<\lb 1=R‘JWA<{1A$A&.'\Ɩo- m>:e!,8ö,>¶O^}> stream xYKo6W>@(ntS`P`wDJ+QIC,ˉlR|L,ް>ޝ]\8pnaؖ\/0BFwuZ}ʏ8@afBR+][ea,3&]8^(z"t|k:gu![o$re9))5C NʇOqVɩ+7kJ ^F iȷla6OI146ޔc^v(J*NAǵs 8S},*IEg0{Rʟf?E3ӵl?Uz;@`@C-%)m!+hm8'|_'-eS1 mOq%Ah8.R\*VIYj[}^tcM u>'*^TAN =Ut=+W/R;,%YGԇ&%dI>>sAq+(YHۮ4g5OXN*N~TU~G@T>l\dBd4>XP}X(;ͨI!73C2$KR- =5){syJs>\P үI]@Kn>coT%“SVh!Ejz)۽qEr+ac` 2+pfHZ0&'ES6 W~&&vlIH''OUjѤI/7CpSVEpD%k"X;2&yl!6DSb xEŽ[Vp_Y"Td%>w2e#Iz|$-y&%?%G E|, > stream xڵZY6~-`guRfVVw+11_%3rj  Tpu ͳotri$_U,fwoO&ny& *~ t;> x~xPEDRİoHHoBV`ʤY0yݮd? C 1vWf0xPQ=*4 G pDFx2TFYؘ} Ac˃79.}SabŲك8qa6vB)Ndv*HI=vDj Tۡ;"Bo6O}#^-Dڢo 8n쒟B 1s`Ry:ɏ >]Q6,A(8 "Yf ˰= gsW^t|_8>{AbX(l‰nfAN=|JpxCpo8 _v{"7igQc0)VU-dhfHʢԱ2ʐ͍l1J˄@'%F?d܃J Rgb#rH?_ rm7/F0%*cs:EJLgo*[[E8m1|,!qL NW(P*';][o,s ;aFZT턏=RGcΘN6"]f֡RvVen4XfSn`J\oV|n1 =l̏u&O#(lXsB,uE)UO U1!hDŽ +H11tJ o(Nb%ʘ: CLh]UUYbVe?wy…<1K?N]6sKH$'3ypX^KێoH-WIq‗g ʬS ވ;wQh꒚یJ.'0 VJ1^dO c^L_|ɊAƋ6SHb+a) ,_OEr<ԚTV>3W@mY%6awNNX'EE0ƞqjpCG߬d {ʛ[{Ptsķn?#sq*E](;i伩4l Y&7[l9':9xab N"MZ+hL~gI8e]-9G8xh\ccո[c4 ![{J@sS"tU]ҁwpu:JP ]_= ZD_4]@,V>x#SII⻹g`ciB^bQxmT{o_߽ #Z;:$:_ATzj A rzeb=2o^@}Dj } 9:0hycJ߄UׯwxDBO&PWT_G/ai*rk?*9\I"){mGkncE3g«jjmk su4+i0ØUXƇ$ u*v qmAT,=ߩM4j۾mޑ"^yW9 cؾȓphtŇ5b~ƵJf2aؑF&_3D9\pOts vG8#c "bA A$CCO*F~ ٭*-P`\͗YC?3&Lg C^#@cOEytkor*wd6cSg>A9W8X6$$P'u3K@֠0/%(]qYᤷ%uT9~Jk>ȞR)sؔkݔݞرOqRφzOpҏg<}Wt[5_g^~Gn{lL!E>Yrm\xN bLgV} <}YT;N@ rv7#,z8Dh\g0F|{f\wc-rb;/NεɌ7X} endstream endobj 3870 0 obj << /Type /ObjStm /N 100 /First 1001 /Length 2670 /Filter /FlateDecode >> stream x[[o~C9!S Z HRmEQwmɐ;ВcˑH3c\?^ {L(LƇB0$B41 l8ɮ*믊x,GCRwIv)}mW %R }<$=R}E]\T \ SdFfC\9TfCRڣ%P&DMx␏.MHTLV e)U;ި**MjE8Jz%`fQěAN]֑!I2N$(+8?gsjqTh.DR4)ĩH&e4it x soda\}G&Z@|09YU'C!g:).ԑeNg$L{ Y`*}SMJ3"khJ՟@_E}JDba|#VLUS T =j\.R /_חߏC2pﺿw/go}}8^ͦk6l1XM0U3 E'tMś鞛_^}ۧ/WoGwm_\rɪx`Ύld\' ݓt1^wzByX|bg/X~u{ 'hssګ)h^Oj88[B_xOg!!J!&C5k h8 ۄ9Z[bQ0YtB>ɰuGD%ZFݾ'! І(d D_/W.ye翠.H#(AF_ NA85S9Yc85X-ćYl>YU'$%v;D?1ݛٟkg|uπa6_eZ\.ՆEw}8<]i$Bp%zaVp厊R^&&&pRrJJB$8F}<X1`9OO}1>LVd;T;`()CX2X#`bCE#R∨1qP8uw0 _`^\Ǒ1e Geh`˜qšͲ[NƇA [0F:w,4H ZKm|h:ߣvpcgVju[kEt`>%b[sr1ҭ~w7ӟNid4#Ik#\iH!F" n0o5!4!6dO-R!NWyCۖ$~<@6=O@ۢ@@AȺcB?AX:c'\., s|0Ȓ]P-[de18O v(.n|;1n)#IƏ΢yEhI Kzd΀\GO,?<tE ;)KbzbOI?.gՀ.a= HJNO 9hqǀb 䓞h=K+v>-gáC#:. TёMwB>fHLjtQg'Eo'Pѽ/z%݉U=PbSX5} }U b2͝'1y)Ĩ~.՛ ֋/Ў%İ,vBBz(P2Xr 6pH0/>V7|p!jb7)a$!tV8=T"֛eעP28χÖ`R.'0'FG~',XEx[oJŲ^'#-yq?zrtXFV":w[wВ\!7L"m7Ukm#UzѮ=蝼x E ~xMqᖊHs~ yW]*tS|ǘ9:mcb6!_Ta2],O/QRkgT|A?,c]Aᄚr"F8R.`z+>ؙo:p~p҄V깕zn֋[/nEAEPj"S9S9s+vHڽ"i+vHڽ"i+vHJI;ēv'\ȥ\ȥ,mv'Pļ`A'y,?0.XqMnRڬ+pV;o,?h3L709}j=YE=MPAzk tt qd A=wGjgGphp{Lo$$tr1P蠇cE?t`PA<]ű\S],p.s̹ endstream endobj 4006 0 obj << /Length 3689 /Filter /FlateDecode >> stream xڭZYܶ~ׯrR=%Ɋʊk}Ljv\FF_77/{$^SQK0Uݗol1</sY^2 8)na+s IPiy'.QB; ùՕMiƆh{N4t1erQ^ti~@W<)g8kx.6 6K7|emC1i*YP+.J :ێYG~kpJ[s_?(_C'|1Nŝ7IbڤVX`)XXjI\$UXy=qh5&AI>Y«%%p`bil.tU݈G{+~d7*?ëgy'-",QsÁ.}YcCuǛz~La 3afBbv,±Mdr[HC Zȳ/L2򸮽|Dom%j޻{\yi]Ӆ=~#O`*cόo^'V #rcjt%Otcٔgkh2h#nqecy9CnXgilK;b_4;Pb~0ưQl/^8v،E*(Z/i MC8 CQ;]K"[C*kSeJi¾Tt "i`S8Իbբ0N8КW*'Qx#̥ଡ଼\t,dM@̍@@-fLˣbybyQ%jazڱnbڣ6zE䜉:D2@d1ђQ1px+%uA  W "jEM<,-dÌP*}x[$!Es&N@c8LBqફ9P2*]3p2o' u]+ σ-nmЯڀRȡ!r~&Aw#d Rp̹zoԅ{}*sM(~rHQf0利n4`3Y|Q<b2y=.M!]BD9f,5V]`mJrW?|<ڏ 1Z42-YP]e?Vz1/ k7yFk&ȚK(tχ88ƒUO6 IVZph:-AN%D|p-DBf qP 'ޕ ;L[:#,>Pe-hm>/5 հi~C~bogYnZrU$튪t1CC'')M`'W/J@1)agc#\S ԪfsEtD ҭ$з_&6_~/POI9F%=#/I !A7Zfji.!U\.a c/xMͤy`=X3l:;-fiiM+)jFx;VP*4uGɾ%[WGsxOq2xHLZoo^G ׻!J'C e#,eb Lc\)^}ˌMubJ:xCڼ)7%8WfhlFå3ۺ\v7#ws& {鬹ՉB]O~9 +:B;Fw4DmF|f/?bol*벉jhWFĥO;%4M{#u&U(ZXE^`]dw E;ωyN'~kN*Ќq O`c|0{S`1ΰV u]%UKUny+FadoՄ&4/!P.@;@Q'EW5U Q%gj0LB<Vm? 8d[*%. F Pmb-]@-mb/4 OV̀v|Pt:y*c H5bpwFp ='> stream xZێܸ}W4 0%-&`7Il5[kS"ux CSŪS 6Mg/t,f2$abmw<XN4dOa Ө9*W6|"]}>o+ݨ>_W7UuEj[DmQ7"!7Gھqqҥ3g}h?vuG]_ME*ۍnHD$dˢ=OPlmG[jD (ۄ6\CE&OpR_% f^GV5&F.T0H .<9CH١;(`O$ù p c::bE z5(9bSrrh0Le9hHpuV¡zgLZX^%wEnN$KzC ̸D2~0Rw! n-v-rŔvs!sͧgG_lq5s[괵97W{S]֞@QD.`Pia0'^b~^Yf~R;&FyĜ~0+'k> ISvONB`zԆ@"A2+(;:z՗ݥjt bS-ff.3 X U J}(c$`AܺH,m %;k`# +&Z7S۹=JU#&5,@ j&,ͦ.5`#RNbiXa-`A/r"n-&w'Âw7,ݵTN< T8A g.AlUSYOXq{)g!d87f@-D :Ad2 ^,#8] pJ^ݧAbN .bVM~0QFثGCk1 bEѰ>Gs LpSL |Pr{o"h.Y2b˪߶`Hoxu&nŌ զ a0 Ar]j\A}s$Sb:11c$nK29RעTU7+7jWPܖcK<;hxZ(fbTo/q6c $X@Z gFhQ㰋8߭\:Bo"`*3reKhɶߦW>!UO1>j%,a;{L9دv#w9d%f34]n5%4rn並rצUT]W+T*akşl&ݞ?uC%F`$]5|#UD¸~J OW9r 2fP3rp&M I#?i9Lz(f(e$b8G2ٜd| mV)i))T3J{Qv«Cт鹨h(B\-]<,oGeuzQQ?4S_ga ugf%!Hx%&K? ).-f ~?x0U]5; [mU @|b;(2]#&UeՃИpKhKE|aڪZhɝϙ=|~uMD4"ұ7k<<3R?c&:O`xdF? A#4ax#e <.gx+j:Xu? <`7Ra7Î0KG:hj?'7/$RqO"(vishQkسH8 c7Ѝ/Uږ \/rp8֞Iܹn`))jR Zp /&5/o^tcKGjǹvbn@Jʻa/֤^Y @Yz7"of yMRfe][Mp 7lˀ0f})Dအ]}k*CD5 .h1x kO} я?}ͯ׿z__5nC{@n1i1?V?ׂb>H#ѝpe`|/p/}q[T&5:X5Ȼ/i#x<(^X[o09f<LhH,C]xѮ[H qs9c/($W%m^ AC7:;9EAMD6Y[UVҰw٫Cwa/Or endstream endobj 4047 0 obj << /Length 3305 /Filter /FlateDecode >> stream xڽZYs6~P!ũځpƩȮ<$@q03ɱlF-aK"}|58lu^?{v* V2=[ ΙӳLnq{%5f߻_%^wU,+ vyq7\e0 Rml.  -=\k*4^wTnNa:*,hmٕޘ`چ* lFRj@2S,N?P6Cn^lL?v;|݋ OI "IhƋY vbJY#3T%r?BQDGV"fI6.\E6 iT Z=յ  ^5qIuLLBl4=`+&' q(&;Ѧ ZF3;C平7 XE8LW~(ʮ 5ֺZ e&灺5HkWfDU.f"tjOEkvӖ`m=w{XY[X%Nv4)hУ iΝAe8Vz=\VF7Z@lxea&ڧNY 'BKEgfa=צٹ"ۍ1 .۠n$(@ZSc,lt8\w۵ M`teEa$W/:[$°~So~P%<ʀ8IŦ AU3cPUn뒁_rʍ:А[~|sL u: z!S,c74өD$Oǩ޾>Ug5"p۵f[)]O $/vlXxLe 5h'>.̏ķjXAxf-TY(nzӻ.b讳c,ʃք]|{D( ytbn–iVCqClpRy' Leea+d?$]?uH'?HX*Fi+<^2U,wMEwm0*38N!`ˋ#6- B FdJ&VOyr~X^AX1 Y_]GNXqVK ]a`nAN87OYFfȼf=Nƍۘ+FSt^k[B̛f q1&>)>)VQR Up˴ƛ4? -<\hyw? 9?Hqnn0<0˂ 架@0;^̽E)mi7[ޮfpA{a~G7lx!řb *:sƊ4 L)#' 'd'" + xq5uНVBUn~fTG*S8?y3<+r~73R^cJ9d .hLw$l!71ve!wH![>! ?YLTgqR(/"@H3fQ`z[ȷm/){:8zB9IlFkvb~*\'Tgk|Aϋ#L=HQ @:@5Js޾~B\\& W~E=vqq qv2"9a׬,IDz+!xeCM)^ U8 ĸ`SR7a~I ѨX<ūeTP.DR\i|j)4 [X,E=Iz{L-}~Af2D*)?zWSgv-Տ,~<n,7fǍte L8MfB~3璾":2@&/w_I^%~.*-W**R%%DH?=4 endstream endobj 4054 0 obj << /Length 3414 /Filter /FlateDecode >> stream xڥZ[o۸~Sak7T_-`N fb5d4 %I_yTV7s"Τ3& d$"X2j3֌L8mtM!mk29M6ˊl}_Ampe"XU:5kY~ࢁۺu0I)RSԅH.$yB3WI׌)X1 b.`QBN%^m^^[]Lz D&}zӸ8cU}N!$Ң[XEV׹E+)E|Av!cRٚ>nM+, O(Y>xD4̑q摬+cbi%hlk̀F羰=r_N9Y!O 6i릀/%7%]:'Ӡ< [9i~f"/l@l&HzЪě!-xǁ]&R,xc%BS*5q |K'&_6Gm+#8L 碯`J#j*P76ˊ9 a@-]#Lz\ !FGD8CԼ\mM dβIv ƒ #|ue)w$njqsFL~٩F'tBY@.9]wYմcm] >dWWS>,]$܋آN n&,Mk&i?03\تBk#G>aPa 4Y&T`܅AxL$izHԊb9+TmQTbpR,C up]7[m2OtMP'dsה<ۮj+ N.}f<%46|nB]dA|UKr>cw=r- @0fk%%V*T!t`)&$s.!d<Qrn.[%޵NǨe`YKOoUqz:i]hdt44 bL {= }¿GIcC(Pg=PR=&{Atٮ-.j@dtk yl9`V^Զۚ$f?) o8`-lS%%({yTeZy@}O o]&3d9V2'QH<-oDRUAAr3JqKq=:PSxѡFp 'E{xJy/zAGn1<41柞6Dr4Q)P[O=Ǔ̅X(o?; 0~pD In4'8R:l?#}%M};1n3t Zn AW| t_w/I"[gV}~ _YNi DB<i2$hd`מm@ShMM~ g}-h9Ŏ,-^J^ i#._܋s/E|jY> stream xX[o6~ϯ0a;[D]E i=,{`d&H%wxղtR<ϝ!v3gǻП%vzn;sF~8\Q2~uAݽ_ ;JB;JĕLW?[(V K/MH<t/pMX \yYxַz= QIZ6}oσх%bAY)Έfنd\[VE"8;pmh8p4lp9t^n_5Bx(ĞPDZnس d8Ƅ q6l0]4!BQ F(CК$0r#v f^Z6ڬڭ\džVW< &/]? |~NLc2l>#-=ސl#W(%BQķرT]/n`wbzTu9R\dCXJ6uE^L …^ѕK*,XeXia'YJd$۹X[ â"TpʊNV6](o?BepL΁6rFbL};s.SԫS:NQahs䏇&[ BsJ:laxVɩ&o]scNt9@(^>2U8K=%&/T<^bsJ q_gxVgEgz &0NOubI\;a2#D GZ 6CZ֋/q,8iaA4c;MTa(˸e86V&(ֵG\Q\Zet7Xhz$SPs@(kQ2nf0+RNou@ ^CGҜ@<8om  "O&TmMة*vr,c'.PrJņe-bf`dbõ^&c: u&Llm $Ln3IF!Y;P#l2$JJ}Sd(:4{i!s$̌TjŌD5:psRdVЩ` Rd 剳r'tZs26RQ8kd~N~pNa0;fWEGƪn .mp'*zQ<1w#MOr@ޘi`,뇌ꗜrץ!8k1z>0Ǽ$)#8JSk=m i˯apkI?/w+Dݡu]D{~x?7 endstream endobj 4068 0 obj << /Length 1127 /Filter /FlateDecode >> stream xXIo6WN&hhe鵺HZo]Z-6蒔|op%yKӼ887 G9?\}N&Q9{N"gn&"w~ OѤs4} b MM+ȿ C'`qefh$ oV(M=r nj*FqsM#׬@ x1g,y6D#hPY ' +PP-A[¥/dnJ wv<%*sMzS/fF/;XoEˆɑ@i>.HOXn:؅!XJ8O9Y0u&aD-?Y~:q'q{ȭ(hiTI6FP&oVS5h9")q4s'QblP2k@q',yMo'>U蜗/@Zrd[:$٥hÒIiD?t'>;o dYR1$*)T`O2OP UX#G7biHGN)6i NGFJWfy+ S'RokFI&xccRU9%nKMӱ~f#j2z @o^?QV}0Zb֗E=, a$F ہoU@>z׶wbv%u/%bk `#s!΢@ bG~KG nͱHޔUtqI!0.uI):I3O4520>'X9(ܽ зMs_'4~a1^P "kg1 >t:ağ*sj&QU ꄽNk;TYzV0f 5unԾʎգ _ b[NfMhlC!xT-ZCi:z|uӦmdk8|ZV _ޥN;rłBT[O [Λc)`SD~zN Z;eWnRȶɷ:?Ǥ~u< Nb~pN}jB9R7;])л]Ȯ28 endstream endobj 4073 0 obj << /Length 1240 /Filter /FlateDecode >> stream xڽWY6~v V\ i Z(u%f#}oP$W8I 9>s֎缜ޅ$$X9C'4qfZW;-~ 4 Q$% UBϘԉÀKw)l?MYG~d6zQ̡*eJW̊UselCI`\X%~th5$/ F N|Zf`_6XU pjF~›ˡ7uzQ{;7~w:>t1IV W_i=醧}m6} Y4lDZUd?ɘ/ۚg"Uz@%F \qۿh~,;qw~vu foJT@muebJlߪ H-9ON_kgjuQ\#meB?BIް0|<'/&N=w|ფNZL޼ AIZD0| ܹ1ؒF@yc|$G= W%1<y\x,!Hl&ϫ瑌);cr#ٶ 5@EF/_o,^4ƈ> !kx i\ضG}C- w2թN:d"ia/GQ!!RcxU@Q.ys_'UԛBm!E5M+RשesDw)͙}4H^܈M+Hg!BFmE"#S%[8?NIhY!LF.%i׈6UvB=tai("W1vD0yJ@`eg{X^x8_CzD=db-9X?9b~DI pNۤ7aomm>xBX|?eaDqerwQ;z| ?d(𠓜zfC@%x 16}D4LZ֠C<fSuZ51ER]_|N \"z eJacg]>m}"qJ][Cǧ4h8MꂸͼZTh(%l60_0' ҪVbSL-cm.Զ$;C_<+R endstream endobj 4000 0 obj << /Type /ObjStm /N 100 /First 1015 /Length 2754 /Filter /FlateDecode >> stream xڽZn9}Wqa)V 0 ,Adm+])JrBHR7<]˩b2f9!+NB0q 28XB)2dEȗAg)bNfLE)EDbddsSX HbPM1+$Ź X2HYgs _P%XS62N&pnP$Y#Eh\KP74CO2)eYnPޔ5rT\KVy6㕷;Hx6-!9Hx'2\*dTIFYbXS!Sɫhhؘ,RT}!%/3g} )ψ +1APzW.G1r-*2&Fi,,OXVF5UYt)*ؠRPv[fvxVNMGSX/ 5[a:1b!3e1d^fE^&e\f&. 3@UF&[",Wů(FQ@qT  1q-`CeIpU h@=ydNdz}*?n 4w^d;[0X[qt+:qƸ#5zFjLbOkz>U 5@fuEl5=f1wGc.v|`@YPn8rrO!䴇3T8h) Y⼽NCYxy7_,H2:!dzwNǰd~1]wVDQK' aFF47c()v-Br)iICn&m-Nr8B?[ tuLv'~~19X &. Zr^&m< QёN8=BЪ^9FcYݴ1dJNfx~Z@lR?1X+tY+fgt?Jt^nE1!Cڕɂ`U{1P! kT%@{,˺[ͽ"I %{BpC Z( ]!$e[ *¦AݪT@V 2=:I@`=N@WgGmTҤQ;,( .[HI+xݝF,w aXvYM[6bPI:wӹl}C]peh+IBg}ךxG'cd01( Ha!$ɇX0ahyw3oKdžh4H+h<~1iܳ=IkLIoxu3Fq<%o!yB}f jM@DaWj_-2Idǩz:}s0! ]6QVgUܣ GW{./vҷo夂4f\g;U^>{FoO+z9NFOB>\K^𔮽6`0тFH(m!lc ɛҐ%)HytanϿ0rqsߪj;m.b\\TP-l\|BbR\g:3יuf3s\g:3:3۶֟`r`'E a-w|:OskF|SX׫ɬ! J,锔4 6c1?O U) h IfY`d}=?PCa%}8uߒiIze 8mB|A99 6+sFRgEˎNeC^aFC (-a[ Nr} pCCE0 5: C2 wKA^-t64TBQ◱@ eWrR-pLO/.eYdRV QYOݧ=m ing2yu~oIOv引; vxuv ik  ?fr, #``C6w[M?^_VG?Y_]/XE_p9n~>IcЬG[ek6}n ggz]T~恿~`?nk#5$H&U[a4A0U߲U Kk;tֲ哎G6:cv9HuI탔$  J\1M*#//_6' G7/{r endstream endobj 4084 0 obj << /Length 2446 /Filter /FlateDecode >> stream x]oݿbN"Y 4N[4@{I&N+q:k%U93ZkD {(ouV?\^ UꦑV^Bڬoǣ8Ҁ V`U%Fndp ~\ v3.96&IM Q{|W~1l67` M%/Qrd8m״rXqVtׁ|MKyslA1r3y,Y,Xo)"Nz^"2 @ihr~=>AY7hU2^tw@S6HQ0?5'xث~!Te}k䱭thD jUµGZ#;elo`+w_0MxnO)k (:kwrѷHӗv((#?yԢq_,RjYj#9luOY&\}NQpJr98?Á[^~fd5إC 0f c_Pi {VEsD)&JGhkF-l Ƭ&%qqDa4pB*\D~PKBV Ut(~FLP,g隋ጅ8q@]dB X[eb}bU DSCJ;'ӝMuhJyy&^='!W/nPp%CC&esb- ;ͷѩǑm&.gD@2K!5{X+FCnvjC͍D7x|ͭOAc.'!rɥ$rY4ͽګS{ F4eϼPN7# #{A\5A*SOJqMpJiᅎ8+t"N؁R]Smk]~WL/hc9+Nx]N17`UY;Kn2,ѸR60+Jamg/]+UU#х2} ] KKU 'RhT;~i Amp]CRGD)hIA36PoF;AtLM3Z1 ?MLùN k&BታɈ`+EaapL HvMK1"}!i8?+`bM%@E)s]S̼T@c 9 X5 &kQPm&lY)5w*_.w0D$$ SNtbSH0\ R$CNN7Y,->13*B?~㷵:/*dNW*.7_0=v3yU*M jz7UE`w,쫰rs¶i Òĵ6xf7vg첎9U]t[z|oY̚$Z/?9c*LLu_ tki6? v/pe\_qm_/Frrg{ `ѥY^gžub01mWHA endstream endobj 4093 0 obj << /Length 3019 /Filter /FlateDecode >> stream xڝYm۶_q.5cALSDZ8c_N~("U뻋]PvoL`,gߠj^}䫛'WItbʾ#eQ󎆷cDUn)-U^jLQ:W*sENxS |JY6E/-O\h) x$9h8!ǒU/9d";UQ7wŧ fV2'^7hMo>tg[: n7cŶbJw2E;a[,8meYM$Riu7bK3GnU;( <.튾`݃'2큰gBwGG}_\V"NfrM$7)TMYO/9><$:> S'"ɝo`|dd~%C6l7oBϓQ󆛓HJ$K=+p̤g0toZ[t`Σ؉@m Nē]O.(x^d<0'gzݛzt3ӢP;Lⷹٚ[Ko#wM𾆈rbkMo jty;w+[j>(uPa]&^1 [ÀLhr#;q]ԆǴ8)R)a,AwLhZz6MO$>n6FW p׶8v* C= VF -b礰& Jag"4K^pfɂ㽵9A, wIǁP/ FNu2KMP|aǯD{5 g44^{g 7UL{&JtLʨ >؝8zeTL !LF0UZ@ydr wźޒJY 쮹FivG:qs9ATR)3 ÝㄭPeߏc2;Je`o6nVe5fGstLwkۛunVRSL BMs;_26ñ: V @?^VBVH\%p9Sm18W"L Ym\x B"I!ӱyH T#wo<$2V*N̯Mơ Ažeԛjf#: _8xlg'sA 8 /ӿoM+ 9 KiBG@ + U4VLdI:Q"GA7C# ^i@ MV22K(q& 3' e ѩZI*(ɮ|6_ d_- U(̖ H fԓt :g@J kQ ԭ{$mG]wp {;OPܖYmMķ|k5k*0R1FP{w[|4VR"I_!ށtW1OEE"|:_D[ySH>ulr`hy`"`AVX .> stream xڭYmo8_a 4)-tw}C}Pl9VjK$'P([\ 49|kr D1ѱBo? @`Pn6R#Jn^_"DONvMϽD Z)d"h46x>`CD,1W!0c3%Y.O]>qz@5'l!jؔHI%j4\l_xB~QXyӛf"pwdGjFZ '& $On SF|(P &4eeѧ=%zegl\tJ=EIDF=&mpnL(qvڦlP(=gF= >2(^*ehXp_?/έKF'"VɐÈe؈ h+$s?AY ~SnӖިO lh9r7]xi+GT7OE9GW_P.lQ/SA,a:Ù10L$׶&ae}׶h9m=h[_,WXP 3<gs*=;v2q\^;Rq7 DŝkfECpׄȮ)fuw<ﶠ`itto-`<\oj!LͻrHٶ'L ,MB> 7&O5:HcB43`Ak>hA9 ́TRU&m}xncv* W_qtcc1)KE B. ^a)-bܲc'C>kX7{g<AK#@BkDzQ &iYiT5 ;<غK_ҫl?'tCiڍ+u^۴*e#˓ŬziJF(-! CǐpXo,o4y cXW7DfSS>'B)cHԕvU"bfU fw运3(GXBk!?,-fޟ~8 }*Rxz, GyڿV~z ]j켼B{(EMbWW*2t󈮾hᯉPv/BD)\w%U:3t|2 >S Ɠ.Z"\cfm}aMty e9_T2$1|w9͚;LXX\Z=̲Uc*S{vN>uPÃeUt:t}Ə)O_,Sh?T>簓cK>_]|Y;Gy endstream endobj 4109 0 obj << /Length 874 /Filter /FlateDecode >> stream xW[O0~ϯ@"l LڴIƃI6"- !~NPc7vssmhlh&D>F!໑=IݚKiw>0:n FG60:r];ˆv lW,b69cwWrTtVѺX ADc OH)w|cx+3*h;5䴜J ''Te@˚I/kN+bbֲrJ+Z&ut.1m3~qnkP0&T+VQ^2ʒZYσڿ1|=9:P|deIق-s#%}NgfMcVF@آp0:ZY# Κu˜g9] )¡)Mx bJ6&XjwWYGu2g,&AÿOP@{2YEZ]R꜑I(|> stream xڭYKϯh\Q&ٝ ``:d,ӶYRT?}X=nGHV}UQn~?M.$Ln72TJ~wUg$4i"'t%a&LaPuWlY,)YLsߔn&m -5`z& t9LDG]q#}}Dיq.zF 0r1 8U;k4pw6?~WQ7,&%c2WRh;lOCUuɁ:Bjsi&| &DwXԽ{+E_[F>XƩP,XP&Ƌ@XK?¹@ތoOI|Gy4#)9S t(H,7qYFR Rue@:mj^j k⟢4'k LS< KeUS cUbɍ=W%QLlD@Y<!ԒAm^-a|jW8"NEm/)[6LHahyWξ٪zT%uJ;`*8q%P݅$jV5^k/^Ѧs56^ c1;cYi( ' G)$Eu iD{;.2)dk;ų"joM 얐#l)a=_X́?EBR”+ xdjv4uI)Gh߲ E^wT$>˅rX5`Y=xqatʳTkI$|\'ȫӥJspb YrBǶ8FKRŢ㩭&Q0dKmk,5d,1!ވT*"M;P @1y-K۾Qۙц V|i~쀍;p~b ňx( },uw#\`bgV`@I\Q뾠Rq.6]KCT/x06LWZPO$-7K@zi );|_Zߎ < u8:^tHPXt9Sxㅢw>#f=if瞖Q&WS,Ћa6jȅ,ݽiOS3bov#|q׺.?ıBDɐ؜F+Ck*{{0vvac6L7ј LcG.n狧\ t iis$VgDL,^4M3d-@eiʥzjKiG?kѻQL~s%s #͐nN a ?MM endstream endobj 4122 0 obj << /Length 3070 /Filter /FlateDecode >> stream xk #_*C !VAhv~S"gpLL' %n$1u 0D%Y2!W*WuՏk;'  Ƀ4+wѺv=pZy%xxQ-nS,IME x||S5wD ;t8ŇjC]? ۿaѳ _ӿʎ tm:R /"gdw\b2e 5rrNOfDOiBV)3e0mJTxR2'lO$lن_3&\Nrc-eΔ\AgZ ׳!d{?>ѤdY6&;q.`SϨfн@j dGpGBaA=%В'ߎHtCH F.R2\鯕1s9ؕrQJDQ<Xkt-0Y -vmAxhsN[09p-0 d8] H ;$j YrgS*̣n\!(vA.\fD 1R%*BD!  mԊK_eDsϔbf@ZKU/s%\,V@IW|<䗫ꇟj/21ՃCݯ,PUTyHe*xvvO\*Z Dzwt>#N2lg!8oѥh 8ΤP9<q_Ca&梉?7tJq>l*Aq5\ ʁy Hsp B+aKDؒ6A"8H72%cAD$ Z4WW,CHkH 0OO"V XF37 AC)]%>+i|58kH}Cemsz.m($3,.;}ʸ &O+)<}W"셛7%ڟc*f ^Fg*g*Hy;`;>vsB33Eq_lȢ419d J oKdڍcSpBʈEtK‚[T`v{F %u-q U7ԟ|ЩNZ*z$fWtu%BinFmȓwتF_J%$}4CMhej[l^̓> .uʉnE}Ply`pv0Ar붰"6V@)c]~L<,#G׎0WPd`PCzRn Q8POڪ }C`rc\<HQL%ղXCE<,wp840bY#r~2K|vu.z 0C28X[).x|GQsWTtN}8]ZNS|MiFh[ص]?z:]CݹbHs" o"ǔ6cďy)̥qJ)*n)Rpn|ȹ&܎j\ Ep;}EBJf ~1gpsvp;ғjoN,쪎XbQa02fn@Xls"n-}A5`2~r{Do4#6SL0_7kCO DuCOk=|$؟QhWm@Eϵ,uY/Ut OPNU8nx!hz!#y ~91e!f.7盛#!~ !XTJy;CbpF MHSM6R&DP5g.r3Vzą :;70fb4^9RM:革&_HU.Tp3pFBnjY~>uIDϕ s#ٹtrSD<1kYò}e x+剶C[g okx99 q*ڧub3žR'&9l]?¥~[^%H2ӳ'iSߦVfCф6Mjȃ_C9R?tM_zXMl$MN3:>;PddKm #t^г6ƌP0~AbYG4K0lO(qȔ>F \:¾e_>x~¼~l?u&zw|v7ߺc*HO4$zOܚ[0Ӷ1X<}A endstream endobj 4127 0 obj << /Length 1198 /Filter /FlateDecode >> stream xXo6_!I* eXn؊ۺ%maIJ=Lt  @$~:;dյ2Ym1b\&$NV䏔asյ)ALo֦[-$ $J8% $|@ã=/iϓo7j#4ȂM*ѣXΐ"™6هeFN?mїK{d>}9A~ieח~YkwqIqطLDeS6TY0湳ck~|~ -3?a)=[xxKq70m׏xy9njTe:oa57HQdхi Q,Gѧ8 83$Ō`CZ$l!17{ea dփ+1,Et0+>bb ށ|'QI\Py]C`%13!(\1DF)4`3ܝNeKFB6c}1qA8" @{HOU$".EjKޮM6 f q?P?:Q]܍R &Y܏З}Iv$]2FXoDbQ<{;t>˲ > /ExtGState << >>/ColorSpace << /sRGB 4133 0 R >>>> /Length 22841 /Filter /FlateDecode >> stream xK|u9@~?=aHEm_Z%R57XN܏+?~>1,HU+}O~Sz~?*(7Wl49~ozl\oQn9rVռmnu[_%onZzeUnr[۪VjUmo~[jV㶚ռmnm///o/G^V*UmUov[۪Vոm5ny[jVz~9={-u|ٙJ+jkzoFoV{)Gt {W_ ~%W_ ~-׃_~#7 ~3ෂS۾.=޺<}|=+jZFoV[xAO=nA_~5~J+jkzoFoV{1GS[З_˷ߣoJ+Zkzofoz~x#ۯJZkFof[oz=z<}|=+jZFoV[ob޿AϷ97ۯJZkFof[oz=P{З3ŮA~%W_ ~5ׂ_ ~=7~#7 ~+=(o#L;݃w +jZFoV[{~k3Ag+jZFoV[G{AϷ~9kз_ ~%W_ ~-ׂ_~=7~3ෂ ~O=[?z3A/g>^J+jkzoFoV{1Gw}=W_ ~%W_ ~-׃_~#7 ~3ෂSO=o̿s=נoJ+Zkzofoz~|gA_~|}W_ ~5ׂ_ ~-׃~#7 ~+cS[?t{5ۯJZkFof[o}̚nAy3.AK-ۯjZFof[o];[̿KЗ3NAoJZkzofoumgnA73.A_~;݂J+jkzofoֵ[w =./?-ۯjZFof[o][̿KЗ3NAoJZkzofougnA3.A_~;݂J+jkzofoֵ[w }=t +jzFoV[~n}){>̿S-ۯjZFof[o][̿KЗ3NAoJZkzofougnA3.A_~;݂J+jkzofoֵ[w|}=t+jzFoV[~n}9{>̿s=ۯjZFof[o]{kЗ3AoJZkzofougA3AKt+jzFoV[~n{9{=̿s=ۯjZFof[o]{kЗ3AoJZkzofougA3A_~;݃J+jkzofoֵ۞wn|}=t+jzFoV[~n{9{=̿s=ۯjZFof[o]{kЗ3AoJZkzofoug]~a-oJ+zC_-?__ ?Ρ@9E _=/Pa߿/^{w/We7I0ן=1&'dĘ`sbL熜'dx‰1pbLS'd8{bL3'd8"wbL['d8@tbL1e((cLFBAc^c2 QPƘto:1&}1 eI_((cLIvbLDAc' +'Ƥ1&1eI((cL081&1 eI((cLzEAc=Ę2Ƥ1&OI((cLzBAc ͉1ieI((cLBAc*PRŘ*ƤMU1&m1ieU v?'ƤuV1&1iUIkbLZCqc*1cՁω1iVI+bLZAc2jQdŘ*+Ƥ%Y1&?'Ƥ:91&uҊ1 VI]bLBcR'cR[sbL`cR݄cR;YoƘz3Ƥ6֛1&ތ1fIݱω1fI-7cLjfcռω1fIM7cL>'Ƥ&֛1&eތ1)^ω1)fIY7cLbcR&2YoƘz3Ƥ891&eތ191&ތ1)fIi7cLJccR*RYoƘz3ƤxĘz3Ƥd֛1&%ތ1)fII7cLJbcω1ɛfIެ7cLbcXoƘz3Ęz3$֛1&٧Bc;YoƘz3$7֛1&?'$stĘz3$sȥ1bLrfc3abLrbcđbLwC|NIڬ7cLbc8RI7cLdc8SIդω1IfIL1&0Řz3$5֛1&0Řz3$U֛1&C1Ř$?'Ęz3$q8YoƘz3$qDG1&z#ƤncbvQoĘFcbϨ7bL|w_/bL|:Sf1F~F;8>c51&QoĘ^_ecb3V1&> Fuވ11z#Ƥ(4Ii1& 1cbFuWވ11z#Ƥ(ĺ5PoĘFcb:Euވ11z#Ėïވ1a7G1&ޭR4vOi]+7bLLވ1K5ĘXwӨ7bLF674BcRQu#ވ11z#4nBcbyifRcLLވ1+1&QoĘFcb]7bLLވ101&(Ļ2y7G1&ޝowu z#Ļu7XoĘԩbLLBm~cވ11z#ĺPoĘFcbFI!4.DcbFܩݯވ11z#ĺQoĘx7$^_ccݔx?'>1nNޭtfcbFi76&EcbFuވ11'uFcRQi1&QoĘX,Ө7bLwEi1&kEcbFu ވ11z#4>FcbFu3o<ǘxws^oƘxwt^oƘxwuwcL؝Qwoofz3t7qbLLg<k11|~fuÏJ ¯ތ1}cb:-jG1&+cL cb ތ15Ƙf 1q!S_5bL{*k1qbQdcbF\oވ11z#ƤӨ7bLLވ11Fi1&QoĘ݂z#ttacbFi1&Fߠވ11z#h1&QoĘFcR k11]z#DݡQoĘ81&N75 z#IݡQoĘ8]x1&QoĘz#4PoĘFFFcbtJFi1&Fވ1XF(71&QoĘNzcb}7bLLވ11:FIeQi1&Fވ11z#A1&N& ]|~F iŏbLfXoĘ8 ӒzBw11z#hL1&5s9QoĘFcbFѢ7bLLވ11z#ƤbӨ7bLfEcbFi1&FǢވ11z#ƤkӨ7bLLވ1u1&QoĘ z#`<.tecqiP_actv?cbFi1&5qӵS?~Fgވ11z#tbcbFI1hr1&QoĘz#t[F7bLLވ11zFi1&QoĘ?'uFcbt?3FciCވ114I=QoĘXNFImQ%ވ11z#PoĘFcbF9ވ1)K5ĘN:Ө7bL,mFi1&QoĘXzӵP_acbfi1&z#4K@cbL<ݣPx 1&ҩ4OƋ,j7bL_7bL_7bLawoވ1EcbFi1&ŘFFFcboӨ7bLm_|11z#425^Ci1&vYވ11z#t׋PoĘFcb-Ө7bLLވ1Ө7bLLXZވ11z#4أވ11z#n#7bLLEQoܸ춄z#4Ө7bL춇z#4mވ11z#Ƥ cLQoĘmRh1&0oވ1G1&S~5z#4ꍅrZ[zA{cbz3Ĵכ1&fi7cLL{wcLkӵSkhtocb:ojx1&1&S6cLLAm~mތ11uN&| u2QoƘ0qQh7cLlXfi7cLlfi1&QoĘذw,z#ĆѨ7bLLވ11z#Ć7&QoĘŘFcbFMPoĘFcbFMKPoĘl+~cb1&QoĘȟ1&>mFO*uFciG1&>7cbFMQoĘFcbN1&QoĘcLlz#4ވ11|>7z#Ħ٨7bLJx1&6mGcbFi1& 2FcbF-3xlM(Ė)PoĘFc*_&)Wп.|c08^c/lz#Ė}PoĘ.fcR2k11z#ĖPoĘFcb\7bLLވ11z#Ƥdcb7cbp7bLLވ11z#ĖPoĘFcbF-zcLLވ1eG1&ۦШ7bL|Y3S7h1&\(ėM;FcˮAވ11z#ĖqQoĘ||cb¨7bLLވ11:\(ef1&QoĘزo04[GcbF-ވ11z#Ĵo0ĖQoĘFcRk1m1&QoĘ6Ө7bL|"Q?~MtDƷ9خQoĘ6ɠn}ЋzAވ11z#$cQi1&̓zcc4Ө7bLlFi1& z#$#-Ө7bLl[k: &Ccb4vCck11z#4DmFo+&mZ5Ędvz#ķ5;u Ƙ^Ę馞Ш7bLlFi1&mz ƘFcb7bLLވ1H(4Ө7bLlFiyFcbo5z#$eӨ7bLLވ1mz1&QoĘ6046bL SOh1&ކШ;4oc׋osXF锩ݯވ11z#0PoĘFcbFuވ1ɸ?161&Qo,΍ٜz#4kcAcA3~cm/4^CE4j7bLx 7&oYFi1&:11z#ڊPoĘxzږPoĘbLLވ16(1&QoĘX[i1&QoĘXכ1&ތ1/7cLL{cbk#z3Ĵכ1&G1&ތ16D~1*Nx?cmv o:'2ӵRkl431ȍ5ƘnzC{cbm^oƘz3$ތ11fIn1.1&QoĘX'Ө7bLLވ1P1&QoĘX)Ө7bL-?Wпok+7bL-Soh1&V?ncb:glm7Mވ1_1&ێŘFcbmŨ7bLLވ11z#ڔQoĘ.:iG1&QoĘX5Ө7bL-F;WYoĘX7\9^cވ11zcmz/oCoSF ?16Im~eވ16MݡQoĘX>bFIFG1&QoĘFcbӨ7bLLވ11Fi#0ŘFcb:& Ө7bL @cbFi1&puR?_܆ވ11z#ı>Ę8VR;4b)Ř82'4 PɱEݡ1&QoĘVz#4rPoĘFcbFa?sSOh1&Qo4zF4*FcbXӨ7bLLވ11 Fi1&MycLLވ1ɉ5Ƙz#4úPoĘFcXvz#ƄG1&uj7bLScLLވ11z#091&kvz#4Ө7/ CcbFi1&ŘFc9\c|YldZ#dk ? 0ٓF~8 %{m%{/!dkYb$(dkܒX_Ėb5:Ch.h`f.-"KvaiX52C`,,Jvb]5,CZNaX,*Jd@ŗdH*YEPZ,(rJc!ϔV'HŁ7މ ["?Bbn q\PfAB㝝s;BL5Nlxc3qmoo$ 7v<oo"4^7 WFl!4^;׆B㵠xh 4^DƋ y@] ՄKÞ5–3B6q~_htrwh~  ,AGox oS4n5❮-(B㶖8_=иC o4^A@g_D?'x[P Pq !ޡq[hи%(<5jn͛6&и,jkܔ"4n{77?Mƽ)~Q4'A M(WmJ!HPN^&qiT 6_иR674{x?[~.H'K}vz 9/snRc!4nM&Hڡqk"Ҷ; hA(T@ԇP@{ƽWдˁ[S :@ބ7ݯ7$~{/02?߀ƽ)N?7}hܚ;4^hMhܛ&!Gޤ1{?ˁ{xn{/: ?.:&1hoJ[ߐxN/hܚ~&~; 4!?nZ/e/и5Qи5I и5EhtDn~U!ƭ %@ԴDhܛ:qыx9'Ƌ ;ͯ(иi\?ƽH6&E~ !4^Ba[/@1>4M@ @q=>;݆Ө/и5h!4M9n0^4^Fh!4M64n_৐!@4#HB#dи54~b[LO qoz&1;;4!;qkRи7޿?AƝ]ֲ|^{ fݰ|K'4OHqgݏF[7@&iwyPoh^@Gи5yhܛ>R qg+и|>MA)EhBmKߏ1|#m"Dw ӔAh&|C4ne h/De4w贩o./i 4n5M'AǦ Bh4! и& 4 ۄ>Pm*ti 4-AдC!HWO ~"U6e ?@6 h4-?M OqoZ$~\$g7snSPz$h܆^{ ?"E  Oh|Ή?ޏ N/hܦQCPxhܦe[mʶ Wh@597 uUX7'qu;CEs4M zqojqF~oȿï  Wh@aMz4HhQBи7&ABޔRtt7ӄ'иm[4nzJ/h|7]4*}h^Є,(Oq@7qI Om4H7MiӸJݲ7`|hܛl9;4nz"и~>804M9x| hܛt|~lB$4m7& mL%AOu?~?"4nq4n qg7g@Tԩ4/@㦋 rahܶY 1x~84MJ~oh46Gи!|A "4O qo|x>!+ƽIjP?7FncxxVh+7|1Ι8!4胺AS<|-, X&m}=Nl1`Ʒ< $ʗ%/A':pY1딬>h"a #';&T{+✚b9Ŏ/bڋ>@ڋ{dսLD{mՕV8^l= 48hF+\ހϒ ֦Vvًfɀe/L^E`g[DHd/Z^Ad]{6oFc/f^'|{qM a+Z>(@kux1>D:tZgDOZV`^K("}@z1ܵ]/NV(?D2K@I\% |r=\i"{Dz1Z5p19ŘgbKgP`?S=i ~m ֋s WxN7 ]vՋm]di/ՋAGÃEXIAUbr8"k Dz)o <\8Z={McS/dAͽIɎ$ R) k2v bC)u iY\!C)MzMșVkR,Z/|%H O/f푝D&[vY%JX j-a57OZ-2)+%+,\~Y(7䋕~KZ,β9LE T<('BoIA߲H.FoI+CVy)4z$緜oe%I-$[VYI[J|s|.+~jVVM`se~E#;շ/ -i7JreeUoz[۪VUm5d%y唕d~u[[:%1 [[^V*UmUov[۪Vոm5oy[jV-}% [[^V*UmUov[۪Vոm5oy[jV>\/.[[H+eUnr[۪VV̶Q˗l?L+: D+ -SV.Z\ץA+\a'he_z<65޿D+Nl>K1gqdV%Z$[Diev+o 8%Z4$A+{{?iҘ Zٚ{ db?hek551ʞk ~=YUZڮ| ZٺlM`8i{*c|&؛;D+R^) SY lIՅyE瞀VR0l}8=4V.jlR[/ʞڿD+[C\V~FV"V%Z$`ozmlV:u7km݊,7?9_"SA$iekjF5hek&M뫿DtʦI6}o:҂5}/|Ag<gH+;=RMo'rz?ie|s޴/yAmoBm~KGV6nyFp/t$lNFN /Z9die:^G0#vDz@W79&uiebVnN=AwV:RiO4h|XD[CB/Zٻ7uZPGGvgngV6Mo'␴r9"wZٻ;u~fuie ~@+;/h>O*1q{vHNr?he/AZ١Im~}]GV]=heV|yMN#h ?&3MOh/xޭ¯ Z4n Zٻve=__}=YGVvR_[GZ'~b9t[n|Hm tq_woj Z4.ShܸAOZ#+7NZٻu ~A+|gЃw'E'_%MAZ9zw'jl!u$ie/V|i}GVI~J엕}hd߁VJϑw㑓;S/H+{w>?}V|?M~xʦ}Z4A+meJ[t=tʧ;'췱BݠAcV|з~#EM~ZnzʦˋVa׋V}9l^ФmA+M/m.Z9o:}ʇF'9_uD;iY+iyVքPrf$hDVM~NZ93Lq&ZYGVVV7ḧ}ʇ'*Z93LrmMZ9_H+#A+,rf$h$i}KZ9+EVIG@VΌ#Z9zIcISIʉ*L'A+'VVhʉmD+'w$$(Z9qBr:/^_olʧr-H+!rbĴhs(iʩjʉNIG’VN]7zrꢱA++RTrbhuFIG0VNsH+#HVNE+:rA+'щHE+'MZ9aTI6ie"Z*Z9'DVN_VN:brFZ9q}FrDZ9eڠ=@Z9n&x#Z9xʉ)DϑVN:⒴rIZ96"&,:~E+o.>VޛX*oImvT[\UU\ʒFy/Un"ր^|P1O޼OޢA'oNKPZIX.0yOq%oa9ک=uRC[ +s߁$D N y3<|'#+4>'`;U]"okA" {Nya¾μRC y+>2"ț$NuH*݅L|3Ǜd-Lx8O[vǻwuv,m:{ъl{W|ix D"mGx%kx1bp%rƻ ӭx+> 3Z4'b,䁄:UצwաNʋxzVoxxTzѪ$Uh=(]uw8 U9#TŰ)RXCG'ExoQ*5~ZJ&$K,\(VRHbmM$V59]#L$E԰x=i&S +I` Â)Ho@xx71vCÛ [ApXlͅOb;/hX725&1`G>gXwZ-`A+' +jf4I 'y1Ec}s22o I@kWwN[hEz +\i+H`Xm/.xk`,x+5 Tf#`Adq މ5ZV~'p@[7hp<'Q`!$$FXɑB VBkfgϹ@F} BWߥ!"6R ؝VS/Z:zҊ?OZ6/Pki'# #6@~-wQGx(ҁ`}f+>Pߵutz- D8ߥzp-t.8_4j!Mb9p1r<绖Pip| *PbO9ŌcrK1pK]"绖Ψn w`pZ{pZt:-8ߵH?= 8ð] "绘@ -|w1| .|.XG>P]px绖Ngj/W |wq^F/|υ!{ppGuʟ5 |=+0|O;8_lO_|ɟש&q Ϝi:Ǧ1{ZZG/q.@ ܿ9_w5ÊI|^ z ,_|ĹVlB;`7:Idb 8_'yg̣!$mp>ztU VդTClz1iq p :drI7Tb. H/$y9ߴ71MoZ7相!7Mq|N1#相 $7!xv8_AMC2MC'8$No&:IW)|.7urF|NE$盺8ap[-+zoҩ|n&oGW|Sc:9$oj?9T݂MJR&e/7UqK~݅{zsm>o;oseAp t[AsCXbI#aLWDrl_'uZ7x\eU;;iͣn nE:$ր b# WpNwD72[C [  pw w7ao}+aA[Do7g$ow Gܭ3]yչdnB@n΃q&{[$0]msOvWV샵U >Q]9bi# áZf}Rc5TbElEOվOZv@vvҊlQE+U@n hr'L\#p}^u.BB3Qs5B`q]DVZV2\`XV((03`I#n2dhws6@Vڝ9?~읾lhг;[oY쪳[a$g7o B HZ4Bf @fKE=xYA\v$вf,uN *{:dfN9Y9ALV)ZdHv&2Ddwh6z:|" ұ[&؃I݉t XfA2Pcu't؝I mIOZPk0YD`u Ck/V8< :+|_AŃV@ˆ2xG⯌=tՅ&1_u` W_u Ip _rzkB+`{_&|P"_q;CDaH-wjv:q䋀!L.NÉNxKG8BU Cڈ G!*pkYm'ڂr;xPoWXU %A!*vE!cQ e!*b#WBUd W-_7.A_BU'BumU Wq/__!BU ץ偿.Cu **Z**8WA2_]B! L+xeȪPJ4,*10_]K6Yy %Ļ }kq|U W6_`CU W ?_oCU W6_] *o !*o !*i_ECU4W8_ECu- !*8⯂s !*8⯂s !*8⯂s !*8[ d CUpW9_CUpodU)9_CuM1>P:vg(KD_+%i:J4, z&LI+VK4l%0"ʼnꔴKX߇Bv>GxGfZ!*둅Vl!lG6Y5JZU\o9d)[NYG.Z!z$Wa0__r}#%Q=__}#"J9޲ʪP[lʔ-e%}V L$#$ͻ[$*YVGYIvdz&B9޲JVr吕x)+-$xISl0ח\/I%[ˊz_,oYe%nyY5YM]V-m5ny[jVZD:)7#-Kȷ_lmUnz[۪VjUmoq[ m7zdzKGz$N+G =r#ao-ILR둴w*v_yb.5ݒVc[ =H'=H'ψz$8햴#iVVMz˃f-:nf_;EҮ=+ލJY]%M )5VS4,0T;둴{W z$̓R H_1=+ϵzs_y&W_)?WWE_@pWu+X"4ைT8+1Hg8"sdsmz X:cn?t-+E9_aFI+?x䉹?umy㯊9"@ssm[$cncroU([cnBUa+_BUU WeՉ_CU2_L\(U5\sCrN+r%P+ rQQ+C|rAR+W/2HV_wK1,<9_wЅv'1HU_Mu_7{_ĨW{"$t[[௛tW >_7C:'4K'"zCK a[u6P؂KXԆmA:K,in?aX?E:⴨Og3{ ͊ ??ׯݵ_OOf}H?J_ u/~ocZ=|357[3B`=H߃Gů~ϻk_NzL=ۯ???e^c]ҵrCymoy*_~܅yxό^}KeÇKU32;|vCgV<.<Ѓ<ƒ]<T<\~8Cg-/?ty~?.??}y~.+/> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 4139 0 obj << /Length 887 /Filter /FlateDecode >> stream xڅVK8WpUk@UrIe[|Kr1`䀘zaLUE׍IrIHEĥdrzN(!qb$ШiT8ExVJ%dPt ?O IhB3NdfI}=:`S}Jhx*~8<65Q`jPnjQd[5*3SsT ѮR*Vj˚੺Τ@18} V6 ILf2>#B}x~'`s$Y&40/yҏ0(u(Ԟcx&dr9<_5oojoXG8 sj>ۑq  ?@^BB) q0<2ET7Et]afs6*Y^{+!ǂsT5@z xNιN 9Zw($C> /ExtGState << >>/ColorSpace << /sRGB 4145 0 R >>>> /Length 23531 /Filter /FlateDecode >> stream xKmUWPG#F7 !. %ak̜{@\@Rʵ櫪fU}9ǟ~䏿H|OUW?>~go#}?/#۟GoOݷ?՜lsͷ鑟&e\d^($29d:$Rt}?:CJw^Wl.g3ȱ u7$}veYIƑJnUoVyUX`U [US򂤕5`V gc*'2wo#*}rs<C6NvM Y}nuqq# eLҭ8j}r@V;ϻjta5,:`5pڏlC.?cj{':n`տ K9 &Y!99%;-t3}ݫ ;?mǻ8iAI~7, ~I/ɿMNS6p6n;|R>Gϴ\ω4?:waمtCgzA/g=6~~4oj;aR/h¯2~ O ~YwM FpvNӢn-S_: -z:yZ;pi\ߣg+oL'f;zA~E+/~|vRݯ{Shos޳Չ3?ݯG>{^k?иʂ_Ut}~{R0}ъ >h~E헍L{ ݠ0~\^Cfh} ~L>' ;x΅ps$jK|^^h΅5ٞVڹ7rٍ20^˜rnbz|cj΍}gV*shWx?Ai[A%~I\\ wq~G< L_g{o 4ݯ}Wy?N(=q>ӉF@~?*~ /cHkA}?#gXi~g4h hっo >]g¯qfFиvWo8?:?:NρdSm'=1ް,ӃLw>zg=ƫb=o{)»rjv.ef`IOh kF2=fo¯~]ǻw~v"PϹ9~7l-fpm~Uytkm~Dz \|92~~did5/G_f{569fs]x#o`|p6xhkO~?k(}NL= Oa\Ӊz8Qm~g4w 8/~:uG_xh5;5ݯ ~s9/8ӑ_P7tty4|GDM5MOr*t9)ikx>M_YR_E{i ϒ~hN.m~6_w۔ϧ<ʹͻ7u~];0^-i{ݯy4}.z/eeb7ѓSOD97Y6?ўv }~4~GnLwh~M_xllSV'>?ot΋iϧ]ݯ,qJشqe|Q,;2>`zBx+N/> EBm~?r w'b/^G)hoLۯb/rХQ_>K?͟QQn_w~m~/~lܯ}дqb 5̦s 'zG^Zn =oͯ,iS_Lj;=Zy=<iLo+v2s~R@/;o_?L鷁_/(LOӍKiG'N6m\ ..q`Cy:2F1XI֬7 wq~Դ5vcgh1~j/vx'8?g8޶;t˺ <_$[YzB;lA7bi܏G'4O/k/{F+ Ӧ/cl Y7zeÆ-4~` i.d`и^6nmݏmpg"~M~VbbH'l؉c/>+XXa,^>ۋ6;WzB /zgZcTq>;Jꏎvk|>mtcy%%U787+41(_YK|l-}kZi60B@L<3op|qFad![5`V5OXCtM.f_?;eAJ~:_hv GӂqDiv_zȹ_ ?!5' 4>eist4Ɨ#p?כh_0=8;AwM?OÑ10lY`/m fڏ^ԋiMh>A{{c8jzAW?6=;>_e˦w61QӢ6>l vj Ϸ=p<0h,jhl"%AIݠKvA)нRǷƳeըtO w)O8J~?v?]?[x//+=g`3ݠv ~6p(stH.g럋z@<:t61{> Y.K'mwI7.}m!ק-Gv?=돶X} и^g q{/\BE=?Z he_gtQM='biGwt/QknS_?m#"4Ηx@x+S}|mz@x4ï۞NhE~Ol[HO_Ƅ_h7XfhoZBFd{qq򫍚~h/g_b۸Ѿؾlho7=hUu]~}{eW/ZJؔG6u#;={|{%9]<.$|BvJ gUZeIX%I\m.t_[4;r\vIXa`w\?8Wk Ϩ-DrY @m>@u=#}fsR.qo"KZ; #ikgZ_߅V7W-l{UvF}-BoY.m)%:igwZak=hl%&;ᐉVxRpCXn0ԪKmF]bкlm[uJómo@tV~DVyS*WZAiVܺirCgmW LNHVDNL$݆.{UNZJ :)aUah]627LnH"SəNҿvd!{a +_43 VZybVЙΆ!%pm*dU_aUA+ NZM )apD֞Ny|gmo;\m;\mxCPǿVĩ+VldUUZB (a3yދaäGx R(a%pb]2Q*WMZ&N|C؉ WByFE{mxl2Sn8b (a;k7VhjUB󅩤0!`V(G yUK³YxjioVhl?:ig %2~բn. !e̔=YܯoCҿȦ9!ew2|hh|aVh[.wB*Н\XF+\iuZB + mЪ/JX =½&᳋V)͖9Ҵ8QcD|pm9JiV> p2S ]U+[iUUɔm+2r )awZ&V>iF&i(͊Ȅ_rRaZlA3B!VG zi|G yY%JX$==T9o>~vۿ;t?m§ۿU ^_Z:kX> (X;6W?g\b=8o-?|_k?[b>ŵGo?‡I?m{OWo+|V_n+~_?§ܯbCa4F4ߍoO㡾>G/>N$Xُݏtw/WQ}:2HԌ:Fz N0OH9HνDC.HƍOhdG1ң*Dz4B0ңJHZi3ң򕋑ӥ(caFznczQHWDzdGnx{cGJ0]vH0# \AFzvEz³H<(æL";ZBnpҭ %H<"=dYM΀" 3)H[KH[۔aIXL tXRFddWCGH_iFGz5QDzwUćU!SpnS_iHZh"v.B#s3DzNw8)Hۉ/?!a;_wY3'jޟGGՖsFzN!DJL,RH۹ QA6}*WH &~$"=ꃔ#vC[ԭ9BHۙH$9"=l'aRćq⍑E]9#=淄D"Ah3#=T,eO8(KH="=l,?DzZߙ;ov/x^Q H8&FzNfiHI z"=lT nQaEzrF )r"=l{}EzNzEx$ TUզ^*02$"=zEz#fv?]?Dz)Qa~m kdbDz8鱩ͯ ?0poS "=d E /z!\ODzT#N sDzIH'^AzMG"ңhK"#=Nr)£MGp}a#><Ñ%E| Jp^QDZ#= Q!ңn`!IC H#22ZDzaH#@q$ Y8CVnЌ񽪆 '";&d#Ð#W0HDzr NV1a "= 9BHCA1H _;*OH->0;"=LG#F҃t_D!FQe%qyE!EHI HQUG!R4"|߂ߐ"]a;"= !BD"=DGDGzF$ ^lEz2 ">"Dz!#kꞑBH''2_$ ݠ^ [Ó ;t鑗"+a  D!BK3"=<ǿgM'ExT C<,IwDz+Dz" 1"o Ó4^#!"1(HLpM1@,\ODzF{SC?@wgM'(x"N<4CV7"ˎ d٧"=6~"=2>a7"=Fd"=LW=0XuIoˊiK ~\8e#DzBW#D_#4Dz'Bl>ܠMތ H f8Sw"EқHt_lEnDЌ) u o"=L!N=_#=Lx0##c"=)ve!0;|XaߗQ9zEzdʟ0 dYa -DzH9҄H&LݡQWp!Æ]@رw5;Çm92H=~YÏ_ad@>0&>P1 >! vPwh _pD _\Qjz"=LW7$"=|.=,!+O+DnT1bZ1ᑉ0UB+#cS+4oD#MH鑱SD@0_HG)q!4eDzk$#)<#+rS'4#LYi" ?!x+Fzd2ç^6Mňq}J "=8HIdm "<:4#. A=Ѿ!Ñ-E|th?"=rV ֧'~Gz8U;4#CDz4d@";24"cHצH,$  ^iBݡHG^HGQ^6m"#zEz'Yx0Fzش1#@0#ߌ[b页)EzKHcEzhC9~bH'#gȌVG<RHLD\TGJEzd"HEz$n=TGH[Ez$_2顈[Ez$(㉠aGR#=7Z)#q"=#HH&FzIߊHlTG~Fz,c>=H$>!MIQH `G_HDCi|0C"=ƃH8HEz߃HDhCI8HU"!dNI1HTbGR#=4HFz*,M$~HTH7*#U>DzSG|1Ez$(#UEtLeib^>HHEz$E1#E #E^ #=eG*+#7{e'#)Ȯ"=Ez$E 1#qDX"=HDX@x"=Ez$ߌHa@Ez$EN2#$"=*#qC"=#鑸BI1#=RRE_V1#q~{+y] ,籹qXTVr,E3csI۸9#cs5c0c^nnl cP49 Od=x̱rH"c3 J+"a5ȱz@ݕ:9DZ4D1c?YV@ű;v$ql c39͍KL؝ ! P#8  @9 E~0|̵n-vxQ$ol[2xc78 2ucsЍUWXiܶƸ4m즰J+XdmlYIA ʜ0ll+3B661cC*#6 ɀ]y"_csZ+O;56'"W#YC+5rʧb5vUJGpqjeV$ "5veb56G P54D2Ncsi[*؜XeƮl7!I* ]x)he ;346ǟr w}gezȕupFglk!ppp܌1/c3vQ Hz:fef"<I+LZ1oc 2672-C 026k0+cEu f,&eGA"3Gج `HV2260"cg !C8126ߙ!;+j(,V㕍O4Ɠ1h,FcdF'0enұh$eX܃2YEcdvmLa`4FVrDAYYh e16h q11XUE|Q47*#6c4hEcp1h ҊPX15h Dc( ba4+C1HJȴJʀFc(҅IVCh )#}eaj()V UGc X1c 701Hq+C3 ԭh N(*롊tEc$%t C/H)C819^Fcg4!> Q4)C81^Fcg4F"h H h .+C91+&1iFcpE4h 3x0uDch2h(aV0Xzhŕ"Fc &D /hźh#XLAb4$(hG4\81xzDc,n{b4b1xhEh zFc,F3cmj4ZW41h[S8chZx~DcI+XLb4ڊpXhnFc-"} VN*̝ m"Ufi@L ?bn+H喙}R٫$ .UxA*K Ri7"bA*k)e#mUPfc$RyHM&^$H*UlD*+M"A*DT^;I*<& I.+s;I%R}  Ry8H9HT OIn+MŐA*JPn݋UlrUʶ|T4 }=MNwʾ;I*bv"ITоkW֗62/RsN*JTEYA*>ΖTmD m5H寤ʶ -ӓd_/槝$בT$ CR9djRj!Ieۏ$2T W@* }Jv? mK}ʾA~OdIefTKRTFZ{f[1Ie-TE1Hb"7wTHeT^d!Iŝ"i Ryq-]j"A*/kT^9 Ryl#Hbs <dS|H*OnAl@d0Hb$g Ie%YTx)Ryp"R)KRyt%TnIGRM{M.IzI"Tn;IƤNʍ$ E*I*οT."[I**Rr)H*"2raHeuT.H*,?%~$\8/RI $mT.d,RWrORh|CR5$&R9s}DrH}c"ٓT&3D*gzTDR9/^YI3$UYrfRHSY5ILOrBRI $oTLRTTΝ$5"R9y"o*,RY-"s!5'$5?#R97]~$A*g_T/T/H*gI*g7H*R9}r&$R9HSr._DRYI"!R9sWr,Rٗu}~* VtL?ms\ٖMعÏ7eO+eE2 f'rNNMn9k[eOHuЀ8v??_eBݠ6`6 sN\7's$j$UL{G ۸W'J b MBdt 2AN"tidtViԎd4gDFr$!2j#,[D'DF3I]dt! F2S\{"9t͚)"9q 2ZхhJ!9%Gd ]Ȩ\ # Sћ"HFk7&]{G2z w! 2zsM2zsޝd.0AFoIFoNޙ$6mr$w ; <$7oIF,> $wⵝL%\' I2z3d΢ HUZ"7]iҰ­2zgЍV;;wZn",RN59p.7]9] +ef4k87W g;ݜݜ@fas$PE"$} 5y~@fՐ%pI5cIF!dt$kTù}ҬEBj|P.\_dm0Ҭ dtQVSù2k8T gTY 15"Frɍ1ɘ5Ad L}K j,t˨<S$k8ϦS5FYy,5S5 .2:)Ɂdt|TdvvNI2H2:;$rdvfz0yf$μ go0sz6XeVe4̚#ɬgU.iG aފ¬$Y_ĉ/e#]|&Ev\Y +0OZ5aeU"|ڼGdYH,e"BZĕŎNl+ofˑU*˱ETF8FNY[݈)k3)e^#jdSӊDqU +̃Vħ'N>1[2`pr2<&*HZ:@/N(^KnoTgX˖U/Nf*J'I#U @%[~vjVZպmo}Y~v˷ᗼmUnr[۪Vj} xK/nrVZպmo}YtK[X:%/r[۪VUmn+$-~v󶚷պmn}[ˊ[# %W_ ~5ׂ_ ~=9 N\.oV[o}t  |ۯJZk?_ɃKץ ~+o?—nA_~/}W_ ~5ׂ_ ~-@K; |—V[o@-oJ+Zk |—^ov۷K/?—J+jkzρKץ ~+ස߾_}W_ ~%W_ ~-׃_~z—nA~;[ЗK~%W_ ~5ׂ_ ~=7ޗvҾo=o}t |ۯJZkF K;syiVt߾_}W_ ~%W_ ~-׃_~#$K; |yiu߾_}W_ ~%W_ ~-׃_~#KKKwۗKG@K+jkzoFs _/߾_}W_ ~%W_ ~-׃_~#7__^/d/?—A_~/}W_ ~5ׂ_ ~-׃~#7|ib|—_}W_ ~%W_ ~-׃_~#7 ~ztz_KϷ |@ҷ_ ~%W_ ~-ׂ_~=7~3/݃ޗvH _}W_ ~%W_ ~-׃_~#7 ~3vN_z5K/? ėJ+jkzoFokST[_Z|W_ ~5W_ ~-׃_~#7 ~3pKK$/=.o?@ǗJ+jkzofoV 3AKט"_z\:~/}W_ ~5ׂ_ ~=׃~#7 ~+Kכ(_z\:_Ĕ/}W_ ~5ׂ_ ~=׃~#7 ~+ස߾֛.i˗5K~%W_ ~5ׂ_~=7~37 ~+/ Z&|ۯjZFof[ovz3qKKkoJZkzofov/\pЗ5QKKW_ ~5ׂ_ ~=׃~#7 ~+ස~ }q|7t ~%W_ ~-׃_~=7 ~3ෂ ~;oz3KKkKW_ ~-׃_~=7 ~3ෂ ~;o? ՗~7tz_\_jkzofoVo}=}r_~jzFoV[oҗ0K˵~MkZFof[ovۗKK׃˵~MFҾtkzofoVo}۾pf/]f/]kۗZkzofovo~/}tLZ&}ۯzFoV[oҗPKͤ/=/]kߗZkzofovo~ /}tL Z& ~ۯzFoV[o4җKor7z7t ~-׃_~#7 ~3ෂ~;/?PA~Zo&9Zo&;~}ZFof[ov۷`K_~/݃RZon.nT/>~oّW?}Hv{,L#P?| Ocџ`y8yBmJeg+]Ax_Fa8A>8 >Jt>Fj/~?#+?mb{~`WM_wׇ˿ᆅ7ׇ ?'|??_w?:~OY nǟK%vL_|h6=~g:u~ҏҊ endstream endobj 4147 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 4150 0 obj << /Length 1718 /Filter /FlateDecode >> stream xYK6W{\>E*^6}ٞmf+K$>$Kv=hD|8ZG8yPQ҄&*"#ƓHFM0E{L $RmԹ՜OHD@ˈcYNOsT0p6~,'௝6g=#>-OJx/+]7e1QĺOg9![,0ŘÓx,KTk^ [/ӚZ V{i6At5fJE|7%")n6eU KQZel;],v?=v;|3;"LuJ/LmZK6>5kbUK?B[<FRgʴ*6嘏u_ 1Mffk=j@@4~j0?پ6\Y]&ks٥:xe|Zp0&A2ؘƙyWlnr}vT! "ۍv8ح\w>aQV-ve4:(m(!ºG};g$E"¦d솶4(9W ZgjD&NSfEYm| H.ve%{__"I;o4b!%y 8JP* aB9_!Fd *aC0 a1uH2bHҞNtR-B4q{>M017~rw?J=]MRX]RP4evHJ Xʋ;-a^A6E(^O^ǀ GS w#.r c?%F1H#w&rVV] sJdO 0oGf.W밍5[_^Z=Stm 9h w͝Mg_G^f .t5V,}I .j k{k;&VU7a¿ouV0邜A&QXfopg2C3 u[7xCdHhU0e-vr6|}(A!)R*j'XܮTU`AVT#} B(8R Fr(R}`6l׫2Yg8@2%OYn4Q%.#5Ŕ-ns/B'{QKH<ґ|Uk>ȽPnRڧʸ.s+7mʣy+[~>P_!]k eGnR LͱX] Pr^2-Z+ !(4e)oqbn ﲺn] #e <r; Nm"Bdk2eCA:t endstream endobj 4136 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9RzswN/Rbuild15811326fd38ff/metafor/man/figures/selmodel-preston-step.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 4153 0 R /BBox [0 0 504 504] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 4154 0 R/F6 4155 0 R>> /ExtGState << >>/ColorSpace << /sRGB 4156 0 R >>>> /Length 22751 /Filter /FlateDecode >> stream xKvu;~E Ɂ>2m@86` eQHʢl;׊]; [3:`}ɝ'Vwo}~c)}eǏo??Z쟭_|?_~?dF۬foG~l\oٿ[ոm5oy[jV/[\{߲meueUnr[۪VjUmo~[jV㶚ռmnsK~[[vmUnr[۪>VdU6drA=H*߷tV{] w*_r@ir꜅ pts![}s:C K/R\g u^R/W/'t1=kkvM'ݠ{^~7]sq"t;d~Novt^r_=t_^'nR/ߟ;P/S76#9e-|o%ٍ`MfzG/h~F=q]uy~Ig/xm ]yt{G p]d깿uΓ\3*BSA|ps>+s?A9pLw; :9__.~=Ήth;~ ~[];~~< s|yCsߧ_s#$hGKKw;*~1d7wtN:kBy04wM~c݄v/Y5틘aZiȒb7t3iO&: k` Hy~~+3:xx=`h+}/~IKNϫ L/r Md/ZӝM/t?ݠq~y?~ӑHиߎ6s!OJ=%\OȘghO_<=9)9z@y>3+~ϣ/}`4E6kM<:;z'4'UJO9p<'4s뱛N|~6s?=w9Qwn;/jxlaztOe%y?eOv$Ȥи?wyapD;IG_xz 44tn}t~ϝvfGj^lwkx4gEm~}nڋt~W؞８2t:3~w<sԤyVӍA{񚮸?JzMn:?gzC{pǯ[cM?f8^:_|ߙv?L7t+hL_FVΉrtI8~,j[OsI~}g`S1okhLgi|ڍa`hL__K;&rnLfT]uq7ihyܯa|g*c74:e<ݏrDڴzSo茿7o}2m~}Ｏq_<< hx9SNCMǦ/cXJ_Bn4t:uj;oGG5:8 uM_Cd*0ߦ'4Ӱs? /t}L={4iΗv?=?E~'o &U66~UPM8]}vmxf#`fhq0i{~ п?l&~ύa@{CbKOӃ9q:Kw2wݏpW0> O i;1sd蚨4_4m~|w<<ܨ~]??W؃Y+ڂ޿6\n;QzB:yQkfQw E_먛^G_X￣ݯ}o W5? Z9 SW0c2ӰUܩݏ㉂a{4ڃ upM"n70?jCsa}"t>ѳn&]ݏG@l"tf{n/ӉQ؞Bvw4ϣo?p^|w3߆Ong=:1ހ_|^Wy~\ղ}Fe A"44kޑ0sr^xGd{bKfиֱ1v<Xauv?η[Ǫ@x;Z+-:f6 o'Lش3Ghq?s/y>Qeω)Y46MŸot3=~.L1=AV_2:?97JY~:FKи3]x?+>ǕRݏi4ͯsm;suA.hO|Z?КFfxcjiH 4g(nϞ(Axa2]y^xb Ӹz@}~٣ݏK>ЃkKO?ܦ<@ 0G{'8k_S]}DM/oBil]L7<_wn~^>a}+/~nޟ1Ă%̇ ޳Lx|"t.q0mt 4m@{-10fAΉ!~đP4߯ " i+ߚv#w2ݠKv??DY~|lbl>qS7豨t^Jӧeډޗqt^'.=q@4d ?m"@дum2A{tP*8{ ~ )>Q '[_zAz?|":x& g+X0q􄿿LJݠ^schoOMh|_B{{n2k zci~_t߯[xDzi~ OÏ 6_Sv?R'_/ i8b&l g# h/-ÏۦM#l@}d=e + H7Ԩݯ`>j и^". :I_- !=7yڄ_c/z\ߵ@ҷMBi7h6E}NmB{:*K4$hnhzB Lh|KЭQ7hoC{&7_!t_ 7!?> _ytD2O4ۍkf%\miFKq&=I_BaD?q6#Q]&I".dw.Α%q$aoêH*K o)[K\%^M6rJvPGr Ô#ae 5[VxDϐVx,_܃ ͼ󳼡\2]mr'Z Vw#a.™܅VhϰVۇLnx1vuݪc$>|ѺշNZ)aVAXB 6(awj0 +# )/{TZ5;VG3h:[KA&JX A+m$Ф9c OʘZJgN$B.hz{KGFI+C3*S. +G ݏYig/ ~i4p/467-??>~~E~8)_`^@[x ;B W?#7MR?gG?a'OmcUtڷߟ?ųOyB튅aÎg\b<8~(_M_ {c_xƵ{o?‡?mO_'V{בۊmO/omWc&}JZύPx/~?~~ßů\O8`?~?v?~?󟟿?~7_/LsmmRcHLΠ0cp`L11e ~Lfz nfGZ3=:0@9LA3=Xafђ2%Q26Q9OL5.ezBUL#3= Ms( LR1LLsdz=ȍEȉ3=bF3='#5er #qQ{֘a3`ȁsޫ&a=]0 0Ѩ[c,m~k1F-03=_|dzzVyT3g&'m~c)7$oL\dzR)2&aK%fzR6>IL_VƇu1vh{A=|*ö0sgl2=*>a[/"÷vj¶3=|+_dzYkfz8#ͯlexmbfgz֣+*2=l+Ydz*| n+ö|p> &dzT1t~Q dzid ö^EmsL~c'Su]7;zdzVyx^`|[ 0 2=Mh73Q0qLG)j4e|_O)ia3L0pF0S`yez#Ù@i)fzJ2=LC kSQL"l7 0fW]_7'c1O2= ]{2;̯ycipViO03=<"涐LcB  LGqntc2?̯(e1yx#æLLcQLdz8ڪK_ +dz'^7/dzF~C1wapS7hfxCS2tə:|< ;}dz8cFjK2=1Ø L ?_pT=E3u| M=џ@1tCȉ _%CG- gpN;SGС}@G5 Mge|Wdz3^qLEAfzdV1#kѨoMO 2=S2=ckb3sG#Ӄ_Sy ~IWLz`a.ϯÅ~0 Odz v#42=Y dzcݯ"42eݠha-'2=LW7Q|"Ú!֢'_T|{3szB33=#X֛J~baL22=_L̼(+dƑexThfrTe2d0~IǭO2=reƆo7 FY&kSļ"û <ލ@c{7#QO `00]ݯ*"Ï/3=L3Cw2ÇLU L?ǘM֍LaЭ  &'2?&9L ns>/jV3=Lz#úH|]cuy"#?aĦU:2=lX߯x> 3=LyDiftDѡq~L<#׭ oL.2=|ש;42鑕Lg'43(M;4;nFG|3=A3~C#p#3=|%SOh0a~e~K[|olHzC}EG.bΑL+aXzC#36 }A3CWi7iF=^"432v?wa 2=!_2H v?G24idzpS6L?wӜ)#CwGLezdzTGQ{LLAL3=2r鑷2'鑕!LY$L2=wfzQTG&LL'ÉHSHKez,?|fzTGxTi~ex`I|H|aGz2=L42>WA?fz$鑘QL53=2d\1#u2=ה鑔)L0ezNڊygGP)AHWG|2=ғR嗥闤ݏHb鑘LĝH*#1X2cIHUG"'Le)#ex #)gG*dXE?H?TG*ʬLT2?eGL2#ee~ #ee` CH WGxaü2#qXxXfzL柙-ez<"Qyw<.;63c+L{9AvFwl&)1c?V,؎T:vlN 0cs̎H}Fvl2cs[@Pyu؊AS53Tcs[#ܝD53OcW6/46 P4+K _, *K(xY,PdiƓ4dF%cFJˀQeiVZak)KCQ_,4XFYEVB{, 0KCafisWw*KCefi%|LZ2K|EkX>D3, e0K(xYP7)KsP 4XIYWY3KCS O, +Kx48բ,4n,4m, `?fip [YYVMjְ|dihx, `/ei0_YVx!Y(K#+L h/42^fidEMTZeFUV;KCdyfidt K{ifip'4, f*KCqબ48RFR48%, 0K4ei({Y\.Tw+K9ei;KCJ4T, Qr iYL-43, 0K#\gBP4&+fi$T$Cdg7+KfiPqQi fipECY,*, )0K#)*+<VR ΃VaF πfi(YdiC YON4N0Km@|8 Kcq6Y,!KcqrYO4di 4di,N,0K @LaAƓ,'YXO(4+2KI@ڊيh(-5qgi0jBY]<, Ob, YLPZ,N9 Z?Ȗ, Ek0KdiL~'m0K, o(K-ғALyr,r4di0|XYOh48ɦ, ex0K**BZFUd‡3x4, OZ'KWX4N>YQCf`4 $Yy4֝,ugi;KcY@dixls>Uʇm.>m#mgDhsAh<"63(Xh3l6kK2QE'h(;O6[TfEڼRm, y=OYaB57+y ڬi mFSKh8ŵKy6/NQ m^ڼT.h3JmV;̓[6y mG# 7.^@ ,ݍi/)GLو<@*W'?@(lD7416фht ]v?6;q/l_ͦ g/6;Q6ͯ m6Mtf#mvNCe/# m6/f'\m.B[6 hsyl6;a(2g6H4p'@ QBݯɿOQW@l(OQX f*g@I~ m.ښOXgf#h mvgMD/__2xf(7=F)fI,f׃:w"~\'l:IP͛s)y/歭D76k<'y'FBcͻ6o&ڼ+#y@տڬ|ʱڼ"y ڬz Vڌm^*NYQ B1͋'B7 m^MhUnm^*oJy !ڼj͋?6?劉6/Dc6<m*My|)fE) m,(y~?͓6O[Dgو mMh5Ym,."yܔYRmEh6Bm*Lyr]h@6zm_m6wDThB6n<:?Ch:шm:)y4=Cx6Ch'!hh̓E.6$hjIYK}hs_}%'Q"O> m( >&m?m߉6w]ͽ"U~hs:HW}ͽhs/B6"hsZK7~mܓh6?哉67. mn[(4@ q׿&4hs{m]$8+ >Oyeͭ}J|8}B+67]O͍[y67DʋmnEh6V<mnFA $6hsK!ڬrBm+# '\3Ahs:ZB* |9*thse9Iu \JAhsU UE͵A6Wn\m?6WvB+ mU6ZPh3mU=rB+ m~!6\3f\>K&}e~'\hsB6D 0zKhs!$,Ee \tmFAVE(+GOT¨@e\_'\MBt@ iͥhs!** \8?!cڬrB5\5&~%\*wͅ;6 ͅÅ6p=NhsB6?Dͅu6W6Em.66xڜ}Phsf&Yh9漿P=B3wm6g6C9s>WhsVK9J<&ڜ)9+hSh_6rD 93Ph6+JBh$6.͚ڬ`Y0rD(A6gF mΌڜ_ڜ9 9W|DY槼6@sڜżm*K9}"9(!ڜ%&9 ڜhm,D(9s~@hs@9\/ mΙPB"mVfEKmB6gnڜ9_!9sK6 MڬBU[h mvm_(3p mV%^-1͜nhMM?&?OSGM$ o ߀!=7I!sLM?B*ˇO6UNĻv 0ʾ޷$jmŅ8g[1B5O) SܳGM)n UWg&$==^GOHӏkɯJ t~QоIzMDOU=!=  (GOH`iOо xpA*?=jO\ h@W[wC*ڣ'}TQBr@}_f85Bݠg^hH{Ĥ"H~1=Q Jڣ'5<Ί&&(EJ6<5%Q ~Ir..z~Ķ>0Q8)?߁LEO 4 Bz{ViEOV-7ъ u iEO_4~A[tUCmV\P4悦f@*Oh9HYQ$>h>iՄT 9iM/}A@ӌo4]AӜ4oAӌ*4ͤcAS 0inv4=PT]iKhznKhMOR +2MsyC㋒.MOhz1$4=x Ms,h+킦tBӜ4m<&4=x{;`Dhz0h\ib hRYC4ךMsj_4G9,h Nh ohZcBӬf#hGhZI;߄GдzK/hZI;>BJ 4$ BJ 4x_(д:-DAhZIC +IB톦DAhZBJ 4$ BJ 4$ BViMs^4eM7ʙVē3#fi&Qi&QfA\4͡iM3Lt%WHhZA,!hF"hK9#%hMW瀦+:B\4]IfAӕ4(M3Lt%hFh#4Y2AӅ׈4MsB4􂦹S4@A+TZ&4]DvOZ%4]r/Z .`m@ &JAӜ4.ix .3HXZ$4]TWZ= 5.ht%h`Ѱ3Hh$$4]>Zt46f2A&h:μIhZ1ML8ޙ7靅gZMQҰ hzgQÅV7MoN3Dhzsʇ|Mof_ޙ> BӛGwhzPiQtZ!ݡЄteB(@I4!]@eUDHWA뭢zKA/NK= ])e&=ՃܤzгbW=hA-(So MQzA^/Aw#Fkhj{? |oOofg@9^@m~KnM>YAӕMWAkSe@UX MWգ#4]'.!h<7RUtQ}@BEG MzրOU͕PGq@Y ĄQ4 4 ˀpM'ζN4#4e1r MM. $4]jHhFh:^sEUz2 $փ^A?Yz/HtXzrSCӨz̨?<94'zFY]Sw{~2BXz,B=1誏zCYzp~L7xGQ^9Aw՛d=}ԃ `={V}jԃtzMYZF@ӨwzӀtRFwh zǀX.A[ o3FzUtYr]kic i+[QZ6Mʀ.#h4AɀUJt유PB'h:/Pыqz vBӅk _A y4] $h<1=΂^ M?KMg=_3W h8Mz̀ dBhZ5!D,h: "'4YDtDh:W;4$4a@YP~&y@Y-[4IMg3 MgDŽQN Mրt H72iA~QN7iA?BiCvMkPBӉ[Ai|A~M~I84:GBO}GBөN 4 NMMk| uFTBө 4:Ah:U74:'h:=q_$~ 4XFд6 NESaOhZM'h4~BTM'V4 .?^Bs՛`!*k Gba.JI+ĴjL+Ͼ.UXdNxM(hhCŷU$55xK%h=kVɷ3H5Uܸ%p]V-i0d(a5_[ -/h5 hJVV\uy:ikz-d\oN$~UV-a5^[ *᷄kwYAY &o9e)-[.Y5[VrL*<|Ie̔-rzKZӭ췄reNG)+~KVr喕d%@&YIηtz--7pzUV/z-i7ᷜoe%oyY YSV-mdoo_Nm--7$xYredenv[۪VVMp|IG[^VZվmVNre~[^@/`[ηtz--/v[۪Vոm5oy[jVڷվe&|,+&~KrooyY۪VUm5ny[jVZվm/../rv_r/eenv[۪Vոm5oy[jVڷվjjjjXr(-Qr%-/v[۪Vոm5oy[jVڷվeeeeeŒˏD嗜o/oyY۪VUm5ny[jVZվm/..//~v\~(-mn~[۪Vռm5ou[jVڗHHȗȗȷJ.|K\~~jUmoq[jV󶚷պmo}[jjjjj> z%Ǘ4z8?:av[۪VW_r%l\o9oy[jVڷվDu z]:_vt ~%W_ ~-ׂ_~4nAK;=|oVo~,-ˏ%+jZv-ui/}ෂ ~;[ЗK~%W_ ~5ׂ_ ~=9Ҏ^.oV[o}t =|ۯJZkp=@_.ǥW[oz-oJ+Zkzs-ui/=. ~+o?×nA_~/}W_ ~5ׂ_ ~-׃_/.ǥ}g[з~=|zҷ_ ~%W_ ~-ׂ_~=oܸto~/݃@_+jZ=N_z^\}o?×A_~/}W_ ~5ׂ_ ~-׃~#9N_z^1Koz=oJ+Zkzop=@_z^ڷ]/߾H_//?/]_ ~%W_ ~-׃_~#7.]AKo?×A_~/}W_ ~5ׂ_ ~-׃~#MAK;=|{ЗK~%W_ ~5ׂ_ ~=7~#_^//}t=|ۯJZkFo=|×o z=oJ+ZkzofϷ_/[t=|ۯJZkFof |k×A_~@/}W_ ~5ׂ_ ~-׃~#7 ~+rK[,-ۯjZFof[/\ƗnAI_z\:~/}W_ ~5ׂ_ ~=׃~#7 ~+෯fȗ~1Et@#_+jzFoV[/\ʗ~7Qt֯)_+jzFoV[o}7]Ҁ/=.k˗J+jkzofoV/\@_Tǥ~Mҷ_ ~%W_ ~-׃_~=7 ~3ෂ ~;෯fΗ5K~%W_ ~5ׂ_~=7~37 ~+ස_/=.kЗ^.jzFoV[o@Zo&#}uJZkzofovo~#\/fӗ^.5问Zkzofovo~@/^o&T}t֯ Vt ~5ׂ_ ~=׃~#7 ~+ස~k}{Z&q5W_ ~-׃_~#7 ~3ෂ~;/?`ؗAKk(KW_ ~-׃_~=7 ~3ෂ ~;/?ٗKKkK;}ׂ_ ~=׃~#7 ~+ස~}D_\̈́_^ķ/}ׂ_~=7~37 ~+ස߾s_}{P~Mҷ_ ~-׃_~#7 ~3ෂ~;/?ޗAכI{_z^^/}ׂ_~=7~37 ~+ස߾@_~{~Mҷ_ ~-׃_~#7 ~3ෂ~;h/?A~Zo& Zo&"~}ZFof[ov۷K_~/݃ʵLrLv-׃_~=7 ~3ෂ ~;o?䗾_}.\ܨ?_|߲#W毷>ڇv{,P?| Oc|LJa ?ODZv}:/Ah~vj5Ah~0>m$)ɉïB~7?hCw?@?>xzm;we𛏟?~o}m>\nXp |>/8av=pϿrß4?Q /w׿_ͦ'~q?sH?sHF3 endstream endobj 4158 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 4163 0 obj << /Length 1852 /Filter /FlateDecode >> stream xڵX[~_!!M ٷ@6"K$gɯ %X`yq ͳCƳo||x)2ǜ&{|L&B0\={n7_rAa9-P*GVY+"oJ|]Z/= ~G4g9 jɤSp1+&&!aΖ4#q|նq^m}5O{3m6GߌM/\fnhFj~$]? ~<ݾQߞi_K8ôpCೲ̿hV 6qط~Қ 6Sqb¹EI\~]1~bVzບɫt& tU*Γ^\)S\U2]\v +*qKXF0S®ol)+\ ,wSq"x-3qӍ|,g|v 󮦃t eX!Gح__R I3~O 9ſQ`mylE^u/t4IuAׄQ%8I_2c ]:kod0 O/Ȧ_)oQg?}SnrƀB!U0g]KU%2mfȺaA[Òa،ێ0x& 5*P0D;>i+"P,h.nh?|.. -^QIg朱.@)JN[YRg,g,K@X_a#p>X@&H<CE;l?).JăQ \ܼnhj YD3TwWdx1NU ;DK.P2o}: 6C,-t]ǵeFCyShT WI; k)Zj^) (]!dPמS5iطhm+]6bu T1DPxWMhm6~DHAH[?/@aK.A Ks<Iwc/U{tW3/n](ġX2}/͒-1 ,.6?tߝN' u) N䴨 \,gX5hriIva!]{OY)T B2|CRb; KAOsإVWiyJZC4vBƿ\+S\&_XGaoj0E^6 +3s\tL܄a\C$a7y| :I1-#@,(}p uB JyaHZ'e3CR@Oi|CS9¹"Nv&0hmaT O~h~j3Y\*_[k$v`m^,"4y߼4cceٸ.J W,D:tSM0M{W]PyR*2xƃ endstream endobj 4159 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9RzswN/Rbuild15811326fd38ff/metafor/man/figures/selmodel-preston-prec.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 4165 0 R /BBox [0 0 504 504] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 4166 0 R/F6 4167 0 R>> /ExtGState << >>/ColorSpace << /sRGB 4168 0 R >>>> /Length 41605 /Filter /FlateDecode >> stream xM5Kv7@2#lm< 8DHZl}YYyZ͆}]]UɏȈx._U?}~k_՛Uoo~~5_?{~o[򯾮|\aZ8#FWE^X];5$dZ_'yCr"y˪C#.)Wy~Uɹ%'2y[rt.٧$V-v[K*-iUMVUǼrwY_cIv%jqUْXySVϝ*֔ܒ:KVdUVy32_gJri}%{ⲇCK^ȰS9%{rM[VddZ=q&k)<./x˴Zn%uCV+B)YSVS]r-0&d5t{-kl.喻ܧ!d;\Wź-=Z"K_~SmίsS:RmsݺK ~m,uoZ:)t Ct/u[Oi?u˯q-?,t#tQszJyi}y'W[oi}ïVJw-B_6סFSʿ˯D:˯)L'ZZ}!_.t]':vwz^]Z ?oD'=yN|6t=¹uߟXC }=o'(}|w\[oiW~/[xV=V{777[ߜ<dz[_q-ƛy=kωMIEtYame//y(zi1޳^oKV7Ѓ3^Bwc*/:_zWníӯą}ѾK~]Holq|K~r- -0:í./nBߧ9Ά-t%ovw3n~ݭi|pAZuă闷y&?&B'˯Ҿ: ӏr74W?vXhϝvz~wÖ~::0_c [' OwBzwC|a'5u=w~xAW|?A ڇ[_gɏ W?J_QzH:.`_̝teo~P rE:ϖS¡ӏVd} Rx)PԘެwפs:R{^+|*&t~x~W]~WC~Ǵ^NU/['{]=wG~CӏJ{T}D ]5>-;ڋGBݑ-t5zwE:ؚ뭗׹??B3 }>ȯr:7WԟN=&nCo͗^Uz}8~u}ȼ z@)Pz/=8TG&nk=kzB.BCZӭï07JݏuC/iH^Hfc~4tuqc霿 ~n/o~]c~.t1ގ+.[Wtz{HDzIv hA|q#nҏKZgTu ʯq>?F_x:t!+|~8_1Qbآ/[ѐj=B/(̷N?ۢ.:v4;bH#'bة/9ZXao8J;s/M~qiݟZaG,Hav|}>fQvt.@;字,)n~S~DžN?ߢoo91PHdzwŲ}fNkޡ?DZ7 C3>ρX =9o2F7x4P PƆv:֐5]7&VBWWא[toJ~/ry\9ZoX9"bXyh>DC0_4@C%1?1%!n i=1Q5UZѭӯ2M~Whn.xpDmL˩91ZΉ;ˉSZC<=K~-&&C/6UZgiL;r[E:z%?֣Eq*ȏxKS<ގ44OBOi'cZ[ϭ55;c>VGx]zXoi|o}7EÊйM FwiX^C3~ =yK:ۛk-WGzJ}_W4^*}mtȸ@_zCo FR{)X.]+:c"J=5čb[:;S:Ϙ8~~~$W5WUX^ӯ}Kg \$&RKCNIWύҺb!OMt~X:-?ڿwCVʉX]zXoO5-LƲq>9(E~OĤtӏȬ_9Bw[˿ˏ lӏd1zI~֋Vh=uȯj_BOiݯuɯro~gɯ|Ƌǭкt!cBs~sTn[7tο~Y|ݥ~s*^zJ|%51 ~u?UzUx?tWET UzLXHu:ϫ6N}ޖߠ}ob\tNokqu<^׸>9s| /UZO|_KO--::j=՟iLl;]zZo.)BЧoB[oi1%|b[w/™jF~pnJI|D.̅}i Z3u}FzD.IW0X*\Xu1^ʅKS%?kCwi[Wѭ5{}Is~r$Om ̎.]ht"{.-36"J|ŋOH~ޱ12t_ttCO/% 5V{z$6zKZ\n|/UZ̍"rsXiQJ^V{}c〴U:?:c86.i//[Z[;COu}5~M~~jְ[F?oRJl()r̹'eGot%bʣTúr-99z ya_n/I-WJ;wI9-Ga)P-j b)2kM4-\)9R䉿ܑrXJÄؿR@,Թ +=XR]-jjgt!e#eɎ~CHYUTVU?XfwItauեoisuub+oHY76*:u`)vH>a+RVm#e3y*I],Z*)+xחtT +݄X8`}%`dGɂۓ~D.攼#o/X0 Y# .woX +=t[t{JW|լHYfzJF_X %en\S܇'Ҵ 9Ra9Aw9RU,HY+X龊IY5jAJhXYu@Jw*RR<V J]X 4 Յ +`BðiF~8Ͽ}X_*~zW3O܀zu =|B5| z~_pk;wJ VױW J+ϑ ?_'ۊ෮d8 hԚw7an}//WϟןW_??W/ג>I\wo|ҟv|m ;"=2Nd5si@GdH͢?RH`6H}"=h(wY"=:LчFDzQ)ңQѦn%"=;hU6W."=*ӥDzԩ0vDzxH+eSEz/HGz{#ң$|Ua"=+H?"=Pruy&s{y5YCsFzDH5Y9f*#gg 툋;)H.Ӫʊ(EzĤx$aUG,l2¯RG"w~9"ˏ'H֌h*#v.RG"s~Ո"=b';#vzN?&(:󅈎Κлg*$^[ΉȝBșY$XsI"=r"*2ңlvG"hH%[:*"=ڃ+#v SG!2#v|*#v IVGbHIx9#x#ң+'#m$R^-Dz$SHIQzEzNYȝy93wo EzN`=/"ң:Hl~-\DzNj!Њ;#:AEz dRL"=DG"=h~@!XIztIH IQH$Q.?G(#ODo'RG9vG"N[sEzIH$^AW"LBfQ%Ha"#I.Gx"=Y"##=YrDF5jLFc7"=QSGl #KH]~V,"=I"$YDtK {UA/ Gv,VG GjZ:H"= m1+#EzrW ׃H\;OH->DzR]+## b$׸H"=Q/xHϫ"=)"b$#=B_B#<*HBO"}ޖߴ#]Z"=!RD"=DWDEFzV$^lEz2K#>"EzSG=BDG = WG& Xwid!?_oEz EzRG Cz>vGVHLj+>-˟/Gx4!C\ɤ"=r"=VH@(\Ezd+#oEz"_}q$&ŁDzdvGx@qXHlS~M!ɞ?'(|"N2#CVGEzeH"ۑqi|H^E ߎ[q[+L+# ]EzH|z]~ő#]~ˏS"=!%_9cHk|Hк?QAEzЌ};#ݑZٌV&R"0.Rd}@|j+BvH&*zHR"=%^o;!Mu鑈@bDGh^{EzvGtz?ՎbHк.H6s5WGHBQAHG cl)#t{Ez0(&Ez0i&ʯp)#]BصwHur$dZ9!#HF6b/9D@%CEzD䃔ډB鑈t$Kz"=B7!}Y!I>aYRDGpE#W鑯 h#bHxX( L =^0"="=B*"=izEzHM/ߎ(O$"=BWGx'"=qRDFzHBDRdGq<)"#=BB~&o.H|MvǑVĂ"=BPG"Q ΊtG~i!ъ|"D4JDOEz^L+|;#)EN."#NHBrزHGh!i71FGN#E~)#m+#qzIa2n6"=/i"%?#x+"=GiWGLS7nN[9cIQ\ߎ}9#|+#^z9cHqQ u,hMVHD1QW9-KWEi"C&"=rB/!ZۑEZ1H#"tyEz<9MZCZH _Dz$HjӶz>Z"=JiS{G?= >a͑#@5";MHkr>0HA"=.Dz\;b}(pH"=."|bGzs"=.G*q9H: WwG_N?*}8jPq5"=9jJ8 ׇ$.9CLSH8OhGt28Oz;̖q̓q>sVq9U68VgrqsH&VZqH"<# ?_Er<9gr58Cz;i^"FsI8\ 8^ ;Dg$g%8T'8y8) +t 0Kf#<8OŠy +u8l%- 0aZdeꨎ|?T")Ie&'F8T %;8QFa  d0]L<)XMej15x?&V "@4enQұz2"WDc0?hBF4F!h +h v9DDco3A\Dch AUGch 6:pA1v41015G4 Ec8h qGc8hˉ YO!Ñ.Dc\XM_j1X;r4! ~!Ƹ~3dEJ70P܎p @ݎ`B:ƸСh qi h Dc\pDc'@Gc'`GcPʼnƸz0=N4O4ar1.P DⰣ1q9baE`J Dch *M9r1.].[A4ƃ+cDc<Ժ1IBJ 16VxvEclY)"cIt[]HY-}JH16u0A4> xxEc(XU'eJ1EclV6Uh';@*1(Ecl$ (cY 0Hvl +gaJl# )P4RDcz1YDc q9)JAP[G4v1w@4NP4شDc8 hJ9mUX V eEJ&/2A;Dc8Xh "1@4#Na ) Dc0hG6 1u4Kbخ?vE*7 T-"c5L[r,~piwC*璟H.?vC*bE_+'"xt暩uïR9s$s%E*"sy KjD*ǂH"ʱMORHXxi%R9!s&9+:Rxrl>$caR99tܼR9c2~T "WD*"sJGIwʱH 3lgTV ꯾Rk&lR=TISMT>;4|dRSL&cRy/BHND{YK7IaʛuM!E*om2I,RyHKL|>D*؂`Ry9RyS٤j&wE*/VL* 77LoC֫fRO ntr`Hz]&E*{/Ieq5|4|A*{7IhO Ǜʮ`RL*{ϚIC@ʧE&ƤT ^7| )M*o dR&7Ix̤6bʛb~&+Hm RywHMIe'=T Ryןi~.Ry\.HʛjʋKʋe%ʋq~!2I-Ry-HdRjRTn$٘TnNJTv_md(jR\T~3 HR+L&CRTno@*7 Tn.flR1nRăTn& eRTn& 'HnA!$ H"t7]*nF&Z •cHx!3C?bbCWSCIfl\l[.IF/nK}8,#r.Wt 9zxj?,q2B'DO1idҢ26ɜοXܦ0Μŧ zKМ}8e2>/'Qid"v41\.j 56 78͙qz͙qSL0Ό{͙a8g2Kz,nm rΤkt9gR5~?`ʤo.$I[*7;LOOs&sXL@'Ks&uT4~'9:Dw>I/9vzzzOܶd9HփΤ}ޖQ?1?ŸA(C]Z 03cX)XP",t&u3}&:qɯϔxb3C7LH7^Lt?Ptq4Tt&ux^}DF>ƨEF㘌>EFCd1FѮkhF&A*LFAV0͊hfmXd; ͆mvpd;2hw@Fj2fd; kːѼ}^tFѮ_M^|_hLF8j2_,vsEEvfdCFO}__d4&]2,P2Mi\d4MF3k2EF4=AFd208чuy2$d!2S+u naҲҭ"2+` y`<_X,/AiYF} б&da 22¹XS .вm&2P2 2P2ڱю*#dhDFCF@!C5dP>瀌>CYBm2ڱюvdc= }X5>G>Thz@F;2ڱ~pXhz@F{+da&2z>`/O'Cd2z~b=DF?"Xчc'Cd!2j z>O'Cd!2z~b=DF?юvdc= Xhz@F;2ڱюvdc= sюvdc= Xhz@F;2oюvd4ULF;2ڱюvdc= Xhz@F;2ڱюvdc= }>IFZV}ƪ!*H + z$}ho?"G gR~j8wdpu%DwvKXK$qHGny/!%Dwm" Pz +6 M /~j8l*p./2]y]ÙUpf5F̔*dtnt g6H3U\ù+Z AtIA %2H*&Xbž*& vSÙ0C gjj8SPÙTpz]Ù΋Ppviej823ݮΓ&s p ganr]jv'Q:$2;ZfƼhVѸՀ#wcF N` 5;!l5O?O5EF72kLF7#&\Ù s$#[,25μ'ݓ\ݓp-aOR$%DD%P`-! }"/׌I_׀q CJSsyN?8 P^dtl08\#2:+\]S&-]Ùk8;!5f?$tH&U3x?5U3x[LTSYIQEg[ZTcY[Q_p^&ἺϏj8/lYOCj8O,4K M$45]kk8c?pN:XXLM"_UR\4I\#Y׫.Hvbɗ魚"IܻϷj8f2W5;1~ EFW#~?55 .\ù1ͤ5kSù54\Ϗ}[]#ĭ<q[?_$n}O$n>դkBD]LCF.6]k".2.Ltv5!"]cd#HLF_&_!/Έ$U2 UުI/ jv eRjċNJ\X$D^sMY Yob:_.ZNm2 ]J7dt dtyueEFm\dt\ ~66~j/45~f ܦf0ѭIF$NKZ5-ἜTB 2k8/_2Y5?5 p^Ϳ5|Z5˪<=^<5'5kN $85]SvR3CT]I6mEZkRy5@<SyE -1dthi?[$ns2B?t-לV g#2:&t7)=uaIVH/dtn~n&[N:Mэ%6э)э!EF5EFdGu{7I^iP kuHdt&EF+P!+dt}dt􇌮1]$dte':\Xdt5]] 2 &kā#26H9Jeѵs2dt}jB~ȎK$n-,^&EVZNd]OeCCF{h'C.ˤb2dt2M"~jBF{>dtaWdt,2tԺXE6OM"4b2..Ґ"kBF?5A! A& & uLFprMh!EF . "/VYLF_&m!}LAF?58!/GV!o_Z$|ES;/ }-LAF_ 2RїI^h7}.dS2;MF_5EF?5-!/JP\2Y }􁌾(d2b{ї:hd7}5"q=^ձ>x}17}쁌~jDBF_NZ4CF_1}92*&EF_Ԉ1}Qd> n2rd|rMhm2y"їkCF_& 32n;%hm~aч P D#BDD gv΋y/,1 +!ԴY?[@AЮ! ho6bʺ4.LlϮ|;RP |tcPq]a){0Ϟxy>ÄtJVIwۂ;{{-;{-ŵ:{,k:q 0~ =ӍH!QN |:,t㼉7kC8pm>.+&E.bybEU7 xA-bвU{ȲwA,j+A+]![Vh.1.R N[ Jٻ׀] F<ʼnVn YV+酕#'|-#6[MO $볹 0US8y\oЂJ,d﹂I&+ͼ.DQ y3IOM޿+0w,+q / A^$S'T?v]c>v}g@>+ ر@ б԰$J4 .=qZ3ᥓ7vpc6vE`c|5vPcm4vSiV3Ou(cO2vcWH1v cW90vYb./vib".vb-vb,vb+v]b*֦o3{s )CDfxo+ުΰMcfUa3a JBH]8Bqě7ަt6!L{ ~x]>]\xxo  F$tx9 ކ" mxT0V bmRvt{ qnuli6`mTSvuon e y`vCXm#òzj%c+}m~c_Rf9@x ]r##?lea^[b%2wo9me^xՅRV +-J O#oϽl[vɁo[beX5~n+K[YOi+VVrS B9!-s[l)[v[Y)[N[Yb%wr|VVV 9>y}re|?2\ole9>U VSVj}ZOe+S<m%-Vr|ʓ6\oٰzVӪZOi5>ZVVyrrʗUŸrey[yZreo9>UVj|ZOi5?r|V-ϧ:V*ׇU)VN~*-U:%ǧVj|ZOi5?ZVjZOiu>·U>aUˇU֧ڟV|ZOaծv}Xaʇ/R_r|i?ƧVj~ZOi>:V|XJۺ~dÊɏT\o/9>UVj|ZOi5?֧ZVjZOiu>a5Q>F/R_r|ӪZOi5>ZVj}ZOiu>ΧoY>fJK SVj|ZOi5?ZVjZOiu>·պ>aʇ*V|Z}vG ~#wݵ' S巿uܮ_}]_*L,*Jw>VPO@I*<)(G?`?,// IM`Ƃ!Lċċsī=lqG&^MSċ]Fċu`Lp&^Sfy`QfyPfyOE,.l37{j c5`2ˋx',/ hPfyDEeW?eW-.Iz,/){(\ JE̲SfyJEbeWլ-eMY^/X2g)ab:eW}bTy۪CcS2˫j2˫rr3ĩ Kk`bڤoĩ_0qYL[W\ʏ0"`D7M fLZ~.}.is,G}XXy2M,4z}4m]1߆CLZ0`̧,,sġqs~]b%0qv/8#*?3Mg &Rkuކ`(QޡUf}!L0q52`X&=_0q<Vz &.CL~cs^0qhox K"Oesϛf+ ܉2ˡ)S7|>rM>&ġ_ &!a`Д)N8F|9<[׹C LRyLx`%-E0q oi~C,`҂kTf9[sY@Y MeCy 36LO0qh}?]Q)~{{BwixKL9/84poSV9Jġ> K &X>03ջW6ݏ*p=u?2o|.ܟ2CLKġx`Ђ-qt*LZϯ`|5<\)`SC LZχ`>L]֍2"_[8zϻ,w}2.z` 5.*54l֋9 _rCCyLuY  6l՟ &%)^0q/8&!e<^LXQf94~ wܑl2ˡ/.K;z7.2y`L^jV%84eϧ`̭7_ &}Ls[ġ0qNU,te%{0qhߔ9#*ܻ2Tf?,^xġ)SCs< T)ppġ &ff0qh"?K&I0qnxH?LzL&?L.҂3'a✂%MYㄉspPv YM%?6Qf9Wm zA,0qN`✫C&^0qh=CL 粃%wy|&81#9\B0qhʯ( L%?)1:[~̼W S';:|qşcxIOEZ(Д=΁S.*8ʴ & 0q7 LXM0qhC L+C NLxw"O `2˱*7(#2˽,,jF.4qЂbڤ`D 8W:#LU~e &eV&?CsVwlrĹc8V" lgcY0`Ђ{TfoYe\Q0qh>/\?ڜ`~stLr-ı迭`pq1~&= sCϐ. &S0qh)?C`pnL,}=0q˰𖟱aMxĹw=&]!O#U0qn"N?LzZC7l``ġ &1z>C~.++8GO1&έ::ϒġr\O0q_}&$`ۄC L[^0qp-8 1 g>zfVfzġ)k/8Η`"7Ĺ,=` @]%ݍi*\8+šˋ(DU1IMS\8vUxPXqsp{Cۉ,nN-n-nb&998w- ͉f8<3EZf8wPoRfm3V#IK7Y}ƱT/ڸm?CxT~_s*߯.粺C|:-~m3<+8rsXqn_NT/8zɾ摇ȱ12Iۚ!Ǯm(yJJHBS6oO,rhRaxDK^]Z4b3x4C)wim09ju}y~XK2&Yprz trn)>94eXPx`IҺ>bC,7H u)GKH UjBX S~5,dp$6^r, T)e`aCZx`Os!0є.ز*wfyK:W-U~yˡu?_NDG q CS&zk1́M1?9`S/9lE sJӯ| e98u nJ,oC#̗k iNkL 6%)9;qAZ@ՎI)M! (97[]f9tyA-̈́ a~ͨYn,s.$hK  t-Es̷:_sh(& #ewL4_҂<'F[ZɄ< gGss"=-s]f/fK 0>˯ρzǀ%]ҔN9:48%?@u+Pth "?J!A~-W tBEEBg8Boj9* C?%-W8t Cx\ZDtK7}K~ǻ7|[~Ǜ|nӲ,x `|m yD^BG~Yˢ2U~僐n&mD:t1ҡnfǟዓtt3~FJxwoxwoxs) #& 꽲ίMⲎC676)]LM&?jNg3xpٌ.y/~:aH=^us7u4@`l9xQmIF݊>EnUi9%}~NtnJXyB*2񢩣-:4ŋHMn޺ʏ] ٍ˯ɯfn#: Tesoqա<=duhI[SZyC^&܈P5o9"@%ȨZ0ק 02 Y0Yg1 ݥ5>iPOZקԫX\lZOD[קp&SE˯~Յ*!>\WL-u]]f:q5IA^k@_,}'gCՙ5F3^qv1u ȏB|\z6vh]?QYld'qء< ĎDDbY(6f5Ԩlء^]_@v&k<*";MƮK)BKKVД.1Mbg4B/³cCsOqк?Dh41iN?Cik.<~@%?{ɏҩ9i&<ᘆUץsh*XYl&!L}ٮ ZvS%l;η9GZUзzZv_iKϒ uJ@icTi&* TWsN> shUUD{łC=紱}C} ݡG^ Pw~=y`1mNi!?wC:(?ڝ=)`;4hTq,#I2CCij@Wwts=%ȯ\ Wwh~7ڱL8 옪{]=?];!2 ߹KwWՋKm;W2t.mucY]:gUйl7CZϋЪ* 6Zϣ\F#v !B.~.B,<5/Fs,BCS:Y*k+ѡhrCŪTVVECFѡ\7\ȏᡩ$]-4lx._XqnkxxYO""CjX,k}J< |-@,Uke.JK'zHW5Wkݮ|^ұBU,>TQT փZTlnc4xh?sۈwȯ uܦ3w=fSGZ|5q2Q܆c=thݟ3]],B"4Ьï!?`sVcQCSzɏU^Xdy"]^:!&Od7`'9mi TTUnr|Q |.PmiP哧|2U5o?ɎU U> l*T&|V fg'uŠ'g|p 6w=T'/TX+QWPcBoPc*TTa@]TAہ*D*EPh|\j¡5P,Tyg~\ UwN;N >"UއnBβ>TywISMy*ZSڽȒ]&`YxB@2 %(>@?'KkBivʌ{Y7ʛ0PgVʛhP@rP\r}\U^7j[Ж*>rvyQuj*u.U^ ^(*>*'JĦUy%rЪ|TyEZWUyEYWw+V]Ǩt*7Zz=\.U^x Ul*/k*/¶*/Q*/BPF~Ks֍*/ .U^ *,U^*gWU^ Zxk⻚”򂪵*/L**DZ *Ϩ%x~Ry3|#gUx*DgVف+rv]Qtʳg3ͪP啬 JRUytȋڷj*(ysW{rԵS#O_lx!U^O-u+U]PTyl޽TytWnU^R'U^f{zQETTylf6S'}Kݑq:#Vx؜߷u|*?hjFwՎNZ/ro6c3Z*h(ſo:J:̧ҭ#"Y<6Q[]鎄ZϻnV]T򳙯Tyeժ)KR,]OzJZO|QR姶R118ʣOS/QS[gT ӌTySsA8|ު5^]wu~u[G{u=Ů~h?ލZ)1R;^YZ/,ThB/Ӝs#QY#]jU@/UfTytKiԎt.ZV9Ih^juݴ_Sgyu{w=_]V]kU~j}ޥʣbߨZڙ U~ˬc2͚*:ڇN4?SKHG[w=>_R R) VNyR5@Z*@4*?Ty4u7Zo=D7Zo8Nʝ*ZƉ2節CGPyŗj&S*w3Ԋy*?uyhlj*?ͤ}ʣTuzDvK.z.Uy4ROuoxVT V׼ԬTy4RORRvz*ޗ*.{e/ԝ.Ա1R]YW]YIU[yWG$TytK]7GT+Vȫ*ϱ*溫~QoRaR]ZZK*麻KO#8E4'SuGt[fwDu4KEgS[UGJTyS+O-%U~ثCJGWuU;BiZSQOT(*?ojWd|u[Xj~O_RMVb}S*?]CHIg)cU*O"@'TUy)<ԹTydUPV$dIs*Oʓ:Q]#TyB['TyJBY$KOOm<0OPuSH$U~UyRe;G˪ԅ_~*? CP1Jcnr P6롺ƓR8^TyF@rUnU~jR偟Xϣ˝ʡoVO(˓= ZTyK*/7YΗj+9w V,ySϟTy!ժnjUC MU{zK;CNZ*֪<^:|]e>T$U~jώ:*?ϤOx( ] eΗ"/+|ΨXkV_&]E}z2fVE>P\7*/ U-UeTKAHRVqXj*]"8|ic2*ʼ8 J*?uGVYMBQg*?yz(7P6uS<ʪkEk^J }hJzQ歽TyaU_6Ԏ~[HC*/$XAJGoP=RYe?23:k=T9-X/U^bU~j[WV>2S[G#*Re,izPBPH*?TT9͒*?ãp۪eKIZL_*?@RMR兩2VV)V/UI9TēDsg%LA/z㲆7:>q]7՝z/U~j+]y?Ǫ<.˨j+D*?yʯ*?zLM*/S MV奿yS-u(U~j}/Tu_<uSݨj+odU~.^zs׿U~*EĪ<uSݨj??^y~RQ`^uT{=^x{FKwʻsbU9[ߩ>V=YqZU9SQwʙz*oߪyj&}`U|X7>V oUN'-ԺTy[JdU.qUy"o;|z*o.UtT96H*o-UPVmhU~Y7C*oݟg*oV孡ƥ[# [_U<U8?*o.Uުʛwʛ李SYSuUR lU"*_UuTy(g)fzTdUTuTyA*o@7ߟCb*V*Ty(qUy* .U^)PRu|'JW+TyǪs:yRSPuҪTy>*\_XWʫkvURwUyJ?ʫ2Ǫ/৶*VjZQR啩+V쏡+SXwFW%TyڪTyuBkA}KWkFuKW_kFyK3EU^3*[ U,TyM_CQf[TUyq<:TyzʋȠʋo˶*/DDQyTyAYʙ*/G&˴J*U^<U^PZVeTyVVa2X_t֗*g?U^:KR'y}x}K*/Jͪ4^⩸**/BUyU^|~*/E]X*XʋPgKy/jUm S KFKX*/_@3UN>~8U^ʼêxTyr)WU/P僟gU>TMK(X*(p~*xQ?U~UxBoyĭʛ?oƯ*(3Et<2|;ϫrAKe{rE{1nU^G#'@=?^86US{iIVoLUt(ʽ-AVy_ U5=.? STQ1V@U^T ʧTrʽ`UNU9YV6*A**A*]'V)VTVdZf)-UނUpU9V'VʇMZOUpU [|EϪ1VV#U9ߪ|Ӫ|^UH([w_9ZoU=bUcUQV}ƥ;jΪlUu*ӪN֣Uy'+Ϫ{vͥo6UywW DoUygT9P/@wʻwuQYUXUw;yV]sTyGYwzAwTU9PoUɒ*BwBw;Vlv**o7+]].U]{T**oG9 Uv*.=ʛ"ʵqUy2oXlRATyVVm8k֪^[yQls2*oL)*o"D7UR孑=.UՅ*odm[#U*TycʁUy+>RH#UPV--U,;TyXTys1%%åYV-M.Uά;Ty}+ΪnTy]u}+ٺVC#U@u*5/U^QVzUFATyEiYWwQ+YVgJU9wQ TyEqYWw} Z*kZ}*#2YʫgU^JVyU,Y'd׫U]gkʫgU]fk uVyMgesWrʋ*/>= p~nVyv"YyQ15e>YyxTgEvʳ*Ͼ"كdT*ϨugerU*Ϝ:R:|\Uk*'UZ|;KUPV7{ת)E٪fZ/V˻*kUj*_B*׍֏DK/]5PRkoUVQV嫣ԥʗϏQ %kU*_F<ª|y|lo*_Lm*_dZJvTvU *_.U՘UbUB=Z/ZG/fWr*_dE[/w%ʗP(TJZ/w'VsUVo)w.!TnT\dKOgߪ|$ʧg3$K\|TdKOϪEϫʵqUzè)rwPU|eOږ* G3U U>P7٪|lsrPl{yΥ'Skʧ'olU>y[O\'o򉲴* .U>}=*zEerX&]|lT.9|.KwVR僩8V僬_Hr|XQ@´*G*ت**GQ@ѿr|*Ӫ*G٩CP( TgmU>*R( Tp6|?Ǎ*7+\|p~r6*o;|pgOe#|~3YdWVygʻUޝeFVyxr**(cgwgUpY)@*5Yo#G7~pVyw6/YY[dDVyg*U* 7Tʻ.*Vd륬r*g9Yqgwg=U+Y"wֶUrdGzdUΔ2ʳ_dgԶ3*wW*Od;;7<=Ysgg7gUެ*gx;Y3d7gUn& <ȝn%VVys6 Y/7|U>eT;-}Qdx=Efx*GUvV7U@V7'ȝU^2U'QMaBYYFwVy"SKnVyYV9ʙr{*dK6)Jv[";]Y-}QVYQnd*ߨA˝Uz&SnVWoVVwVݬrYr߬r*ԝU>P*d;uCVܬrT+Y*QK+*JAVU6*|U^<86Ըk#|^<νTyk*(6g3JVka=eWU^ [YQdIV9)d)*7\Y5+S,U^)&SVyMr*/U^6)MYOYeQ1dz*/U^ 2pVy![Ye~QN ٱ*/9>U^P*/BVyJʋ*/gg>*/|>U^|8pVya F#P JY%Vd3gԙ S1U^U^u Ycʋϟ*GU^r*/{gd/R*/|8]򼭚UB!~V姮Cקc TyL{SwyQ]_R5Gy*EEy*fO*zQaU~wVy|/ױ^CwPC5ׇCmJ:Szn*)֫(h<>YR1upުإO-SKKBj'.UYREy˪:kYUe{zL*Ӿzn(򬺠Ȼj]b"y*?uSח*–j维S#USQ]_81<^O8.jϥ4|L< NSrHZRMoZx$USQYuGwV]yrbU~jڣ̻jgO~S$U^*uW?nZTyLY̮cBvxz~*?u;uѪ<..^YUy*[e~^zN*Txݮ"}$U~/|LĪ|oԥʷQ7$T^(xPR/BMKoOGoU'J]fTF1Y"*~Bo7Ѫ|{|7Jɪ|]jUm2PGwGKoPYYoUF1Z35U*CxTF-ZJT~V|*ת|ʷwA7KoUN*ߨDyRS=PlU*`U޶*d1[*B*_.U6]|mVfwg֓Ҵ*_oEvU9ߨPRk9;ת|GoVRfK3U&.UR)N5.*_N!AU/'WGK/﷠WGK/OA/OF/SWTe*_*_ .UUdyK/?GT~=W*_C/U*VVSQ+*_,uQR lU}*_&?*z%ԾT;TJ>[/X ϬPg=u|nTDZO_Ϊ|.Tt6|z?U> P: |y*gU>Vk)p TYR峓-U>=uUNJ|~rQ!T9S@Q峑=.U>}U>}*%.U>}=*|?ZO>VϧU,(ti*_U>aU>aUNr4|fgFIKL6wa=}<%Ǫ~T9SEQM^UnU>cU>cU>cU>cU>WUN|x| \xX_|,[>VϫU9T9SIQ`TyT^ߪ|8 U>KRWrpĹ8Yo*72*W)|)xX8-ތ.s~sX>͛-_Y$U.tdobs8>Y=**7oV*W*ɾYqdV*I=0&Y[q7w#%m2yߢ˼y^sr 7<ןx?YW '<~=@*vIWx@VyiY>=Yq'OVyʛt+/噛p5ni-ܦeυ(3#$s*w͹EߝUa6d{V*' rbݬB=+fmIVpnVy"Y(dYRu[)XKz%|;eY&As%0 ť0sVoi-.RmI*'Kr߬rz*G-U*G%UB$Pܨ.˶*/WiWŭ_Tyxgo'[̇| DCBΗj?Is/U*p?_gYuV9/YY弾VljrvmPoUdK*ϼ3_rvMnV"#ܳnVy3ty+RZ*Wߝ^*wpM}dnRַT/YV/7Ud'3mӪ< U|E3U,p)|r߬rڽY+ʝmwʫYK\VRYj߈PPVָ83NvT&T٫Ty 7n+Lvvzu](X,YZji=Ŵ*?._*gjYj:7tT 5AlPҖkmO}׀d/ԫS\UJV [Ykxꀳʗ*_U8;|}wV9ꃬrYㅳW(|eʹKtYʕsu7: U,:EEV9wQ*5 |,U>Q*#|5e>TrzU>+ZY哩4*&|:뒬gOg[UUU+ Yce3뜬 ٟVţQeIUyA ZIϓ*g7)/[t%I1ϓb.'lmTy!+ڪ^OtT9SWPwQ]aTyIk򌚰*dZkr3قVf}KgfEe*kVyHTyFYZݞ.8Tyy]kR& ~s5tIYgLs&]<*>s**ٷV) V]ȨJ*O*gj<ͯ<|UNITynU<%UNW)lTyYRtAy=)]P媥~ZBߩVɻ>PR]VU"ܥʣKH:Tyt5}]O@tXGv+<(X]oVO6Ty`:k"Ϫ *>!SO]^lHuF_Z%۶+doǔ/4^<RuSQK^/,P姶bU~j/6OS*?tZϗTyl̗j+|תl#+U~j?ߩbU`U~j?ߥѷ֫r~[_[ө_dU'_<ӥnU~y} Ui3*?_RF@6 UP6O}y)V]U;+k=0IZ&=PYѧj+PN(^z*?O[z UZϵ ;}k=SvzU<ʲq#ᴥ'Ui߶*?E։MɡcݴOSKK6=]e3>VO׫RYSY2ARvvw|~*L*?d̷jPRCTF??|o~~o߷XX췿[b%w?R\Qų~?O= ׃z_A~=?ȯ;zp!:>QϏrI  _. endstream endobj 4170 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 4173 0 obj << /Length 2110 /Filter /FlateDecode >> stream xX[~_a2"RAhNEQd<֦jeɑlwCɤsvA>ù|3CzZ7w|{AUF~%8g*7BfTzح)wL,Uf) hWqO; +!5yʹj{B[4ԼXyj3 MɯR`áYq "k}?`4seBg4ML/hz:XX˜mvjzg\K:{\K'OfctBqj6(dTiM7:tſݮ麥S7}ƫn=G;ݏ\en޺QsxZy?cnHH̻G`S7#ad:zDQ(%h4"i'N!Bq-gȅUʰP%.Y.z˫IZORESO9LAu{(d*zu}{ˉL:bӪT!'7/7{1qKCbMW$"!f3+9چtw(Q1^T@w6A@-2;l$w~{ c1S AHVf*BZ]r덀D p2`$ʱ :'~k jR DDÖ5H@߲ I)I(AvnSf&B |K>xT%DɁk"ztڽl\?(dEQ|6L ag_ Ř|k ٺYcż{wYwnD&#,0` ]_=BrݠõDt~8T/W7? 6kpGU^bN%U!fqc uuye-K/r_`E*ũE\cACqEBǿKw4B/Mqtu1T:/vv| ʰR屖{30 C7ݡwNJ@OTenAAٷvlC ?]`k!LH\W:ؿ{%aSv'KεW< _F$Ry> /ExtGState << >>/ColorSpace << /sRGB 4178 0 R >>>> /Length 26217 /Filter /FlateDecode >> stream xK-u?b7.;s6C2 T`0( )٦+Lj/r"{N"gzk>~G?~y~*ctW/~wVOm~oՏǷ8O喟!ǻw~;]cJ;~oz=u=7V._٩n=Mwo~'z|盞z;>qYo>o?E멯ぞԽ?|=目z=hg*z|:O;o_{E<~C/O?o?k-yH{MtGo~ m}FWG߭;a@w.7[_Gۯ~9wl4~ljHj}xzr莶_~Yo_~N4~@n5-}q5*~ziyzéo_EOwohƁN~@B[%nԩ zHƯ_ϿzEۯkW_[hZ~5VUMՅO㛵y|it?]tt5_EZ׎"uC|QZKODyit]?]oOד8 BύO|ͩп_οK|4~MΧKһrͮ;zt>ׄJ|DwtUw'@˯ɯr|/=g9uit4~:>d?_.?._av}Mwq>BL zJ ϗKn~^pt?~}ƯM4~:Y8~=.Ə;ۄίKOtCoi~q[9Z紟wƏ{@(k> }Hx}U:)]75/wziJzJ;uB7D4~_Η5ƯTtCoSߡ/!O_o 5p ?|f}H]*]gm-wǻa}H]*h?~|Cs75=&ah}[_O[k~.k}/^?{it=\kk>ޥu=^n;W: K_Ї~?Lhw BUZǧ>>͸ޥCzJ/K~ǡoqki>)~) k\ӠMi]?J~v)74moh~q4:o:˯ր!_9kܯxuƒKOo{ȯp\^NBO:^p]/ҫiϙк_]z>_]ZYw}g})1~Xiݯ>߯oiB zECZO\eӏXk ZQti>BW4ݨBǍMZK_?n9^ }Hi[yb+'r5~X0ZʅzA7GzPZ&)ЇZ$?O Bx@K?7^:Xj1-vnvOm[yi1q]EZCLs} t>_LLuDzl΅кifB>hh]N5.Һ~.~__K/i!)9Yرmϴk[0FۥߥcUkݤs: ʯh)t)5zj=55l<[߇op>]/yx.uC~Ϳ!?~N{Ϳ~3'REZ3'v^:6MZΉ(wU~{Wy&7.?wOi;\zIyj 3ӯMyh uk_>RS:~PWt|C_?t~:C~&]:=t?7uNa%?KӏIS+~C_~0ׅPB~zH73_R t^>ʏkKg=.liߥӏ^*_c-tzzF:u^hKb*coM~C_k>˯Z~=8ӏj۟o:ơyޤ_:o50H~XcS~տ:?ZN$5u }rP zYKFttMB&!rصM/}Jx@Ǯ ~A¯Z~&Eoߍ"?t9W9?2;] ;.l}ȉb\em~C8~!7o'N?_G.\qWy56ïLG׉~c-t5%Wy>iՊⱫgYLC\>h |v#q0&q#hY~Q8Bo,,\:i~׍IH_v2YR + sC1 ~M㯼Qo$Ǚ -wvzJk<vtϸхW6å/ҹp|WsLtBO߄:OSun\ FzpQ۶׃>|4&zUZǥg7&SHy?w[{ݝqY;OCr&z_}Hz}KU9Qʏz+?tc"e&C3ͅЇ?XQuM/C߰_z,tT'BHqN?֗C ~~ޅ>^7(s1t-CZbaK~SXJ~!?c),KߎM }=,N?OBy|s,4W~D,uj~Co,ܥt>*CW]Oiuʏ7Bo鼾sa24uo UsȏArTZ륯eSc#3`wEOvwrbe~'o޿U~XH:-oLYf,ӯSzJNA,lwi1 x)oyzJtu%?sX2C~W ~{:ᡯ[=B2qghο QFЇ~^4? =uMoM~]~Gw-~N?bJڿߥ~i %㫍:tc(׍?Nb#=[G^ʏSZ٥u'~g?>O/;}oNy=0b%-SGNIx+$ï;rJrScPNfW)aƆ)ai9%T^89%]Oi0pN ԤsJ S蜒!sJqN sJuN G)5SBsJsJ@SʠsJ:[u$VrJ)2;?T+SRS)ZmqN )a-9%;9%,4;h [LNZ$DwN%rJ+䔈sJ~)1NDNɢzՀ9%rJ䔬S9%(rJGEN甘qN甘qNfS;d-1rJք#dQ'뜒5)Yy8dM83rJQNaS:,HS̥SIS S_)Yﯜs()qsJIrJ9GrJVxSSSXGuN*PN^ JN~?LS2OrJ& )'19%x9%x)9dRw^):d뜒$9%sVN{rJs )ΐsJENI_p$O(OrJQNIpsJs-)A 7n(SW㜒^nn^sJ:sJچ[')i'29%|$.꜒꜒vp?#DxS甴I9%Ϳ'9%m)i!#gu+5rJWrJZuNrJ䔴TsT~T&)?SRምSRYGvNIqNIsNSR'9T8SRNNI󘜒rJj~NNp;r)QySRXKuNs?휒G;~INIPNI9QNAwNI\c✒߇s;T)Ѱ))9%Q.rJ-@9%Y)I@~X%$%4;9%Ҩϯк_)!V0tUNIh]_ r=ϕS(sKtss~*$ty$g  4ooMQWLNI,}w唄D9%YnC~pdsIҏ}|rJA?}QNIW!rJ\K^S^:Sb-9*{*JNIs7S~#$rJ|PrJP{$鷸SҝS@NICV5pSZK9%c~:$LiwSnTzTQ7ONI~csIo|?d>G9%Q~{[ZH)r^rO :~)rῧ'))rfSBsJB+WF9%]sJZrJBSNIs=lliq)rGNIґSZ\rJ9&G.9%cINIhq)r|qf)r~($88@IE&&:xS83$l$Qb9%+$>FrLS\F_7C9%]*) MGNOQHg!O9%sLow 8J唄!I?) B94) Ϳ+($49-q>rJH>Sx>o!8 q) ]cr t͜~s) ]KRgn-39%m(C9%q(wʏrJzeߝ5c>rJW :sqS\)MNȐ߄TNIr}HCWNIp ʑD$9l&C~.V9%]O$\/q) .DrJqnɱQrJُnM8^唀~:$8r?ϓSDgrJ+CZ׫& 疄߹>SZ節Lt*$qd}xN~؇Vn&($8ܒ)F\KNIܒxq*䔴nк?*$t;_>rJ?S$~\S\ "C~ĕS<h-$9g^tSҜFNIp0:~)i#$t{d܂}$3SZ9)iSrs2'CnFXO9%5SZ/霒v($D2g[9%QNS4tNIhWNIh])iwn>h,S\,`u=rJB+7I9%qsI~qS ])9!rJⶳ9%#$ncS=qD?*sJB 9%#$n)iZtNI)JE/\"IS4SrJZ_9%sI8%]) rJ1[[S}S i])a\&rJbآ㧜8ds)[9%=%IWIӜ[2AzTNIh)asJBG:9%9 Sܔ:S^MMNIܒS[) rJb~:Y9d]9%Mq )iDC>rJv)isKΖ\s) ]9%9MRF[rJ+o0^QNIhĴOe唄61!9%yIO}rJbKҤ#$ ?7 >||VNIN}2$tqnɍiSR]INIhrGE*$t?)e\&MNHe䔄WX!˯iP_9'0Z )e"qg) MJnƲ\&Mʒr!Ź%HNIrm}M$bYMrJrnH΍ܓ\ / *$r SˆSZW9%)W\rJrRS˚dNI=*$8f28lT) MɔÜrJrX|)e>%*9%9T皓SR朖Hߏк^SZrJb^rJa.\9%7GNIh?唄.᷸PZܯrJb^ù$E8$ףrJB唄6r)M) չ䔄w:9%7gHNIl+QWcRW9ST }J+B9%uO`) MITדSzq9$oSz;,hs.rJ[+%$|ܜ)9%Qֱr~S[i=Se#ޔSe%}jwNrJSunɐ,cy䔄({,!]9%QVCF䔄/@;=Ou#=9%5RNI7)2wn)]~K~͟wɏ>䔄\9%Yƴg_9%u~*$rSDϒr*Srs䔄I9%YgNIm9&[ZC) MIQNc?(CWNImQNIhrO:SzZOܒ-ߋ~sJ*)ν#9%d|@NIu.9%FNIe=9%KNWSR}?%|'z~ANI])SR)SR}SRJsJ*}SRrJ*\sJpNrJ*):r}8R휒J5T9J.sJ*m))IrNIe9%rNIe?9%ڏT8:gZk園JsJ* Bn9%9%f9%Tr:SUTSRqNϜSRSRؿrNI✒rJ '))W:P䔔9 )){NI1MNI9;rCNI9~))O9%sJwڏrhSR()qnsJrrJrrJ )sJʝ#+:W.I%뜒brJs ))ӹ!))לSR_9%w9%Ź=89%eS9%rJ `sJ }SR+蜒\ rJ E甔!O99%=ꅝSRsGSRUS\iƛ)) DNɝ@NIsJWx}9%b)) 霒;W9휒BΠsJ 9y)) Ĺ))w:з9%ŹSSmn90vNIBsJspSSꢔ;B!%{;%3J֦M% %{8/|1HdEIVlzl&'WILL;\ቀt*CL %dܒIZI$d;0K$AH6eđl)d&0MH(}89ea7RVC}8epbW ;2C$O%l i ˉ!@ (~d/G6Ea>C>"|Ĺ1><g2> Ln?V4b9#HMbH+H%y}Y$ )"Qb/#d;|Q;|DWHEEya,8=5͂ Â맻Y8| n*FXE3"XUXɔ +İsb',K`'eXp7% >^`( >M{a`&,xY ,x'sÂwV`;AoH76a=g&`[u /w\*,x=bS _WXJ,xe ^.ed/SC9XBZX ^ WS5H -<ł<XX\7HnU#OO\fsłI0 K.bzLܬtQ ~r(kłF1,x,qm Kbb/Ă=$`8gVG,x,  ޽ KbĂ'k`Y{KbĂwĝeJE}Xp?͂ Kbł璹11ǒ?/VOE˱E+<n- X&+!Zbs w U /Q,xhSbvk=`c`d ='Qⶭ}9]obnZbI,xֺnB,xz %u!_jo Z,XE-T[Xf<vO =5=$<4,vQj`Cy%x~Z>U.ѱw{NE~fł.,‚&*+,X:_ł0Q׳X?S?Xv#[:,x]a.CcU_3+<U?w܇)fͶ@9ĂֱB=,xfł ކw=raYYXF+,/͂7̂7୿3 ޚO,xk~?,xsyX,xYVzodUolX7[ ̎‚7/̂7ky7zof`+_7 ^?1 ^Y4 ll>,xfχS5,xR,x=a`#,x5 ^Oa?XXYz,WY,̂e[,x]fłWߟ`+,YJ)YpgwOH,',xu,x5k ^ٯ5 ^'l,xf5Y$X:yĂWu dWus7f+@f+Yf+}ޟ0 ^‚WgmWf̂W)̂ ^,Ê2 ^o69X`KahE՟O,xfł^,K ͂Wg'{,xebe:kV7XjbǰYZxkfk1,x%,x-wY7,xfł2 ^|?/Ә/ ,xa|h80^4 ^6Xb8Z6 ^wffˇ</dwVf̂ /?xjO ^~f̂ß_,x04 ^~~‚͂g[̂eZ,x,YlX`f$` fY ^a?XB er‚i\,xa=,Y9e2/~̂̂g,xft;;,xfłM` ,xYBe0/*wO`lJp{z(}7*{8}y$7 @4ܰFeݱ*Ên}g;t]pvh&{ ؽ7FfuoRoVP&#jto'&@"wϽ)9t߀i{Vz|$Bro67cHqSl{ƽ`{X. ͢1nqdcۘ/7|ƸMq/¸ q;8L07mAqSj&Ƹ'?7LƸPƸ'a-XcNfnRc ߍq;1n֦qOVnY=yqSdUyclfN`{.qSj7c7\uM11njq30N16Lu˪cܶt1bP[V:`ܬ6] = [qn}`7{]`u|oqCf%yc܀Ƹ~aeo1zknEq;Zw4HSZ㎙ziRmL Teͦ1X&0>)oƝ5 Va܉%ݝ ';Z;1n/Wrqwz 0Ȱ*=㎝ ΍a,;5c܉g%˶{|=cr0_Ƹ+3q'ش?qGzxzIrLvƸ2IQW0 ꎴŹ*;Xʇ1(Q[FMZ "VsAf&T ΊعTywƝL51Ƹ8l0lL՝V~)+vqGVzmaY?qSDh;kLJ1,aמQ ' gN;7&wV(4Ɲ-*:&F_R`D`Y]7^wkX_36GYyn) #Z\؀0>^ T`ܭ|\n||cc$ lAw4-6q7GqW'qWQRSwh}~a80 Q`0+MOƝX%K~Awh/aYKZX0;cޱMz~ߍ2iۮ2V(UwOcQ>qgF/i¸ ̻0(3 n*;O(;S-"[zg7G^҇0VTe:_qgټ&=[g=gFwtlݘubܡ!]w=*.w/tzR=VF c0ߴƝe¦")sun*cS2RzW<)}GʃqgO12ZWwE0ljDi;iҊ>) 2T.Kwnl{H}7_¸CMwE-"o z(œh20F>~Cc1;zHOcݧ0(#+;z`ܡ5 -ׅq',ܯ LhZTjփ2Ɲe¢:KwFK7ubqDz<wwzqgYDaYw|m{I~K~ޅq`YF.,P$:AS`>0:rVwW2q¸Cy7~ayzHcݧt5(% aY6q0<zQ6nlP6>у>- ˨~Eރqe0Ї1SZX0;;gayƼMQ6iWčuOio?mJs-xpܑ`Y&nl{R&~7eDIwØvSZדqm{[`K~[l/.;#Ű0c;t*w|և0qbwF Qw [nc ;;zS6Uw>?0,7ֽe`ܵcS~7ֽ0F l\?׍O¸Ck+;wcqxDwWܘ~qq;Iwc q!;ȅEw];`YV^ГL|L;;zRVC'ƸG0X 0v2>n1panY`c~g"w3& c¸c܍w;~~>ؾ1 cmZ~oilS^/ cnunDtna܍"M(ݦqa.K7݌qaZKqa[wn]׍m'l %9w~aw~aܭlZ,q7wƸ[wra܍Lc͘ ؍q7ƃƸ0於`܍2Lcܭŷ0nnHƸ;cwJ0x܍qjO#wsT0Vyq#an9a0R0n0~4_+֛2x}~a-[+ c.7]ՀqW4㮌Gq eƸ0|jj㮧[f7q-Ļ|~+[e]+]c¸`xa|㮾߂qw=qWjPqWߏ[.qe1nv1J>17qW2q¸qi \wn-wi?Z/']k4]RseN<2~cX!wqƸ]o}]oc~㮃7q1X0j1J1nUG}w`ܵs-ɗt<+-qk?]¸O`ܵ㮎㮴X3]ɃqWu-!q{?wmܿd-[q61ncƸ`w~~qwد?1nc Ƹ[qj[w56 mL[v̧1)w1maܵeux4֍v0֍-V`ܵp?q,.-qN19`e]qیqm]wqd00B 1Y1W'Vcܢ1?o-uq\01VgsƸ `t i?Pq[6va-X7~qŏ1nǤ.'s0w1ba?w9u .`Ƹ %ƸaLn፟`܅Kc܅9c܅ncI0BY1ncƸa|l[c܅7cnadx<]x3]raBq1^vCW4~`~;~ˆ[q1▕`$wYn)>'wƮqƸݒw1F ]~ yceii;s :Ƹww[V .VM0qe1B1B 1Ba12 .Ԃ.-qbqc`7UƸ 1Ƹo,+.Ğ.02 ..P[qbq%128o5UƸ Yc7f]:Xwawćh=Gi?0iĸo,-qq1ci10"[wwqKp0nן10[cЍqwi0Bc- uc7] 2];ƭqbqf|b܅ c7FPcX1wqf0`ƌqfhƸ aƸ3o-ӌq@qf[w1fa܎95]kƸ[q[2]6ƭe. -یqk2]~:~`܅X2c1`b01]nZwacTˮ8&To66e8V-q¸K1F-X1nm|w![v=1ncWƸK1~ﭥwaƸ cm1SZ/cuf\mn6mwyO c܍qƸ2[.n=o^w6]^X7Qܛ` nSc0{s.ޛSA'o)ޤAo1lr a[Mc mhpn+ 7]O44#`ۅڛuop9-Dk!vvXmG=j=%|p1´7- ioaho:g '%go69a6+dOtާ{/tPٮ^m${nUdo +84>غb5,>Fbiݰiu cİ7PF7 0tĪЖ_8ª+aT 1 7Q`p̠뻑!r+q4ýV7N-+aSNlM`E%EZo0oQf}z𳢬aHj(9!N|އs'yIFo7oQpV]+V൬9jY6V΂އ!莕;1՛ DfezS ONjS/LMMajB6_ L8c[S2l%0riԆ1Y㊕N``wJ\0rꆕ0@`j Sh '02<X'Lm-02-~`잽 S/'V"^FS,05,MSfziY6O LԁSbzv cUMOJ'?05z S/xa`jªluX\ ajs6 LMajS9+Vi*RVŁݭH,05%AZw[X-ղҝ,0|=M@/[@f0[`j6 S0\`j SF+V Sk0tU7=UA L{`g 0afw0u5.- QkY颻aStlXc]7L]LO S+fYcqͬBrL}V䁕.I`SXiLmlJԦi`P S^0.{t7L SC@^6Laj[})i|+L}]ޱ=@Iǭ`jJ4 SGEOpSGAd}[YQ&aU n*4VA|sbdQ0u=dSGX\"SGeX ;΂ǹ/:ۑAaf NH*,I}0uy Nc~N(?dx0DL=*j2Ox>CV괢\0ur9k I߼`lNt7$3_j(:B NLiN|0LIN1-: a:ɒa tO zIKV ^0u0d*%=eE_S8? S'=$i*aLpul~= NfS'ӧ7-n3#:zjwMNDaʏbcvqC ~LpBE >0u Nt` 6:6+{%LNX@0o&#jxzHW֙aM 05a,SmY0u3<L S7b=ڂ{S7R S7.G0=0ucf11LݘVva|mO0uL}n7+Z0usQ`6 3 nkp 0up 0u3\L S75ԭqS03 S7zndnL}n'v7x S;0us]`jn0u3\Ltp90u+`a Rf۰`"`jgZv&ajgv&ajgv&ajgv&aꞍ-ㆩт+K|{`zУ\ou&L])2L]Yb2L] ^ y5~:+Z2-~`Nォ+V{2S LouLvG`0u{> G [ va-0u0uA\ Lnw 0u+2+,wZ`JqaꞪ=ف+= S;0u%30ud6_`jg{w?f?zX77\W O@>)SWΌ7L]#V^놫+큩kz=SWÚԵIvGoSW S;s0uu]`G10ue30uuOx`0`Z sSbyO6l-cnL]ni e .=S SS?/qoleY0u1 L]NW`jg.l4=Ga?ԅizOL]Nt~S?ρ_7߂ ;'ۆ7Z`js..0Q7L]fL]~L]44L]<vqajw.eڙ t I a[03 SԅM3冕Sl.7'x 0uan?eSaj.퀩 [H;`j.tjp0uqJ`Bax0 S80u,Nb03L]&p0ua[0uqO@`jvO=4 O'xㆩ|Ư .?P.&7L]X7L 0-p`..7Lr=jVg90u1Lbsp#0uak ~ݣ0u1<L H`28^ԅajt0L]G2L = SÕԥsKS܂{S SX0u1 L]. Lu.^7L]S8<t9`jv1a`ҁ뀩aP`j.'v ԅ =5]nt>-=- Sæ.~7L]afya41] oj=1 SfKsOap5~wl`bc4~~ށ݃0u!x0 SfX[0uq80ui.7L]ւ 7ԥ Lb{ԥa0u1 L ]o.Zm7L|ԥSajvabxg<0u!0u1\ L]X4L]{T v1a|0L S0 S~:]o0ԥL]nyO0uoԥrSvԅ bT`Z``0abډӆ .ɂ g 6L`=[ SupKaLm0ui? S;l0 ae? aj'nˁ >тbp. SN7L] '77ᆩn?zFw|6L] 7ѳ{OaԬ05[7L] C/S_5<a?߆_aj6Lm05p0f9-u@J@Ro.9}qF'z;tG6/y@ V@PoNٛG*{Tezzo^X-Բm>/rz8+̈́MoRҠ eMI/D!b-~ӲX^ݰtJuB77!buos+a^¤EېĊV fd+9XMh-}oDt&l8]`vG<6WހoTDk-Eo77}#P &ID !@͕mI4vo&XM4(Mv&@}%!aЛ)(}΂IS􍨈Л%MX|+77"X>oC>۫ Έra9}r q$z@8&O l7ߔ}GJ}r mާV`5Hռ_A7#m@o`GD hv/x78vry2oL@4ɼ d6lyY(MH}IH 4eEՓ^6(Y]67lnry6nn0j-π[Y6dhf+]$he#HnnBazb@}pl^ Lټf_H%}>}C&dMɛ dNɛoxuU}0\]E\I( T(d1zfI$@ưUEbeXV4Xi{a{$2y&Qh!Kzj&>Hd5NDvqHŝ ,pq@fnn`IdRA">մUGbՐX=ƪ eU$2&a:GDvuHdL";9 S $2&A"ǃD^nmՐXLJJ$D6lvyòHd|>aĪ!҇m5z+! ]+ٸ%$-+VI"ƄDvOUHdf3!q! ;zH_oï?~o[>˷*~(e1NX#džuǯߏH\?bRZn|yCLm?G_8zP^3@kսjҼ ^H[^GPn$zt?_7~_?G\d+'?//?~o_7|Z`,ъ}cs}o}ċx|{7Nj'_YUn?ſPXB=UU> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 4184 0 obj << /Length 2216 /Filter /FlateDecode >> stream xڭYߓ۶~` 2g&m\ugJQD"łIM X,v1ѷx|x$Q2#MxL%&B0q#\unt:Wa6`6F 4J ?RFmqwu_~\ʽBa?;\Ok 1QTa\ҲaU)*%,6 d RZoT6輅um:v*4aQ*.Ǔ[1P*&{_ؗa:ΫAɵд_˦w5FUi$k+WeSèoc<eZOh0޵ j]%6B $ lt/fMss5u8}zv`#P1LY 9^߹hU⶛ZUdiK#FeGޔ0ܛ[f> ,|ʹ; s fFOWoêx+10hI2 ךσQ9f Ŋ2eY<_cNn; !$[H _C#~Ow!NFׁVjX@7ҽ->p)hmCKʪ܌{ +0,ytSreY 8 @{6,2d!NX3  +tkcp5H| /M"juRfD и`y Kg'BV_n&EAE}'tش?"e3fv~Da2Na]4%;w6}sJ1{MQLU: s)A YDe|X>U NLDi[]z_Ǡ:tz~`6TvW-dũV>γߚX%Iifs7g #8?>WhCsy+ CadR_y5h2/뱅GO<+]H:,{;#?]^H:<64%B-hIR?,q 5(qjI-n[{.}]IuW1A-#NS)bd'vo7kx1i]׈.[y=]s4yc}-6;`RyUQȁ$tLA6&j6:wR-DD,sqEyx) AHT\K҈Pムh`E_p .T-Os޺thf4DHUgtIUቋLe(Wj^6?}B%i~۫0 ut<.ЭЕ2i=tYe"~ˍk%CU΄Tr<MUn!Po'ZBLHf=c'v|;2ą??7i! z\do#??ڑR3EMP#H} i$'KPm!ir7C) ) S6Ǟ' D&5HBb?kiya+䌢]@>|W> 1Va;b|[\&Yk b9"ۺ"=RE<0ɘM|e B[Ky5lxhƥSH\8X C>/ X s d8u{ZɁ)3S9Viz<ؚd!P8=Nk- QڭBNJoX~{*òpZn+$[}PW^A=q7 /2%d1',9֚.(D'CE%BꥲߎԆ_V!B;W endstream endobj 4181 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9RzswN/Rbuild15811326fd38ff/metafor/man/figures/selmodel-stepfun.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 4186 0 R /BBox [0 0 504 504] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 4187 0 R>> /ExtGState << >>/ColorSpace << /sRGB 4188 0 R >>>> /Length 2962 /Filter /FlateDecode >> stream xMo~ɢ _|n@bY]$6Iۿ_rfdC=Ft% 4?|5{Ryq'Ys?>||üm/m<׏ca-X7G~ϔBP3B~a3ByBi3R(p2F3B1hr e1hv e1hq e,s;)yvzS eCcP(p=f@]Kޕ=P(PHB#cP(Џ@#cP(c}OisX8Ԝ٨҃AQKAK҃6j+=hi^zF-Cؘ7A=='6qP},{/4j{JZQGAKPܿ36e[/qPcωz)=hikA4j-=h҃AmQz8y[yCcisb^JZZzF--ZKڨqP{Au4gCccm=4A=='6qPmRz8JZQGAKm=46fCcisb^JZZzF--ZKڨqP{Au4dCccm=4A=='6qPmRz8JZQGAK㜙qm>?8DZN6NZJZ'S[Ak҃v(=hmy[9X'8ة҃ISKAk҃vj+=hm^zNsaCcgm=4I=='vqRRz8JZ'SGAk\؉y_6Nq9S/z-=h҃IVz8:JZ0o롱3m=4I=='vqRRz8JZ'SGAkTm=4ve[qRcωz)=hmkA;6Nj-=h҃IQz8y[yCcmsb^JZ'ZzN-ZKکqR{A;u6NgCcgm=4I=='vqRRz8JZ'SGAk m=4vfCcmsb^JZ'ZzN-ZKکqR{A;u6dCcgm=4I=='vqRRz8JZ'SGA+u8}ާz{N,z)=h^KZۼW栖ڨu稜Amm^z8m0>K-9}ڨDZ8҃6qPKA4j+=h҃Am ss8sgz{N,z)=h^KZQkAK㠶҃6j/=hiQzж2>K-x}ޘڨǡ8҃6qPKA4j+=h҃Amœ.41F=='AQ-ZJڨqP[A4(=hSuq0/>OLmsbiKAZz8ZKZQ{AK㠎҃6c}^Z:F=='AQ-ZJڨqP[A4(=hsuq0˼S8XRzF4j)=h҃Amm^z8-sץ>OLmsbiKAZz8ZKZQ{AK㠎҃d}^Z<1QcωqP/mkAK㠖҃6j-=hiVzF-:Jguq2S;8X'RzN6Nj)=h҃Im^z8}0>K9}کDZ8҃vqRKA;6Nj+=h҃I s8s物z{Nz)=h^KZ'SkAk㤶҃vj/=hmQzо2>KXy'vq96Nz-=hmRzNJکqRGA0>Ky<1ScωqR/kAk㤖҃vj-=hmVzN:Jڕ9y]jm˼S;8X'RzN6Nj)=h҃Im^z8ݘsץɼ<1ScωqR/kAk㤖҃vj-=hmVzN:Jڝ9y]jm2N=='ISZJکqR[A;6N(=huq2S;8X'RzN6Nj)=h҃Im^z8=sץl>OLsbmKA;Zz8ZKZ'S{Ak㤎҃Eaa^8DZF4{^WK.~ųC^j=.OOϝunm i|./ƻ.d|wxm/oѷ_O?cūׯ޾߼_n$k6g|vXiID\+t9e?\p?Zj{Ή~?ߍ~~5}3Гzk|sӺ{~~q~q~JD endstream endobj 4190 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 4194 0 obj << /Length 1672 /Filter /FlateDecode >> stream xڵɮD𞯰8 Gzvs @ ;&|=U]%oFڗכū& l(9S: b!X& ~ o6TG rH-NUf \p 2(V2uzJ=-LXZyXE߭۴)mc;6oziQ\~ma^#і-5=6mA@hfm O).-W:2W%+ť4RS ܤȱ2ldByp{!K!r»eê<ɹAFBI@ΨBL,QsM/xuL4ZueI. #JJE)_ԱA' uU\Uhw'TY^&ӌцBO`+Ogzʬ۵W|M-9H˴4ؙm!=cAwmv`w{PJFh4 DtOHL@"(MH Ӊ \λ\G$R/;0PVv*]Nȗqjr)Q9GPRܓmGQh@OoLxASש-[LB*:5rCZFU鳓1&sBHʈx8ڥ[f (3ed"aI&Zgc1OoxQjr߬TgMg^ JQ/E ԺB}rل j c&O`ɵ'dqBjyFQB/i8}9-gN{m]v޹%Y'B,цR6 amЭӍsphEL=>Y 5V oMGDaWع\Gc1M_\0ϩ"\ ŧ _g蜁k1.GRP5.͈x\G,{@{2h4 ĽbVpfVO[KaR4㥘g}af 81s@[OD%٢Yɵ\K-`|bV K4M  CWgH1G -(Ӕ9þ,@Pq8`H۝-ctG=x jj3UOt5:3Bz,@͠ LJ((]Wj"4[^Juo* *uEFjitjwĎ0FI@S.-5-pїJoJJkЈkܛ*{]JvKb!W ӶPs/j/gl$4Qq<(tx4L6GzDt,-?KE~ z>l3{epw%UIv<:+6zymlMRd7=n]H1m] ! eN}V3 )MsDcVrv&]מ*$WM0!:7׹ɴߞsUaG[jfzTL[G|`)?=神 ^(_fH endstream endobj 4077 0 obj << /Type /ObjStm /N 100 /First 982 /Length 2090 /Filter /FlateDecode >> stream xZKo#WquHl@"{86 bGa4I%9ʐ]|դ E*gheKY,S&ᘊϴD(`e4X@DCDdAE˥!у 5(J$Se)h6Fͳ DI2-U^kVfcZkZ 7حh+ (!HLgJB^0yO /<ye>ŌȌҎyؐ¶@y[ V*f!f6 4xh́ry0Vy!%`6ђgy̛{K>U8&ﲯ-?ߑṠWh}8: Y[F~}h]$#,;GȄ ʒd;h,QZ PDwGd$ lEw>[b̧ ĤX`IfD||@V2C7&8T2,9@KĄϙ}lVg?l6A~n9zOniDZV)r}֌舉3JM^vpڈ@[06zp[۔Ք]2/Sß&@jo[q_q.ߗE1|˻CX6խ_G)rx: L|h͘I䎷U99dk ' 2{0Ur fD!)emK'HɭCںuୃ:xC#/Pf@u1@L'S|ÊH " >ҥ[ˑs4SqF}[|6$%`uS[3?kGynQc2G[T=fџ %{1km)ͧb%=9!M КQ>}iqt2ҷ'-OZQe~T}ԥ'tRR܌;ӓD7ggH;tcy(o2qX^k`4n@ inё-.._ [emiKİ]e7˾"t@W|{ [k}[cvu^pt1}хZ{ j+a PsjjK6,oVV;~7I+?m.вm endstream endobj 4191 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9RzswN/Rbuild15811326fd38ff/metafor/man/figures/selmodel-stepfun-fixed.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 4196 0 R /BBox [0 0 504 504] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 4197 0 R/F3 4198 0 R>> /ExtGState << >>/ColorSpace << /sRGB 4199 0 R >>>> /Length 12740 /Filter /FlateDecode >> stream xMǑ;E9q5ڊ0ALЀĬ̪ݳ_ҁ@?DfDwn۟o{7of־q}׭f/oo?o7۶?~/M|?ܶ_op/Tuʹۏwg':+7c5<*͈zXB7?i} s_4#N\uz,(hF"g, ͈sεi1͉)LBdesD݈)Y8ќ"{, Cڈp1<(֓:7[#KxCڈ6)2Pbda!DmDĩScda,JFIL CdPvMb Y" ?Sdmm_н# Cd0v-b<Y9h"[,<_O'Fܗ:%N߈^g?:CdposY81E?- 1D'}#@Uވ)2bda,BFuz, cUވ)2iQ!pL*1EY;qL*;1E9YyJNuY" "SdCdXD5b 1XD5^Y(Q胘"5FBوDx0DFT'Sd.DوDjsY(Nt!'I ҈:.yBd9RQ'ѕ"[,JFIt%:{, ҉:xķ!P:Qѕ"%Fv#J'"SdY(F\uZ,<!dqߞ4 ⾄F\u7m#BDۈn8cdaw mDwb \10Dm#ʶm+ٹ7};Vٹ7>"lkl=Roue[cd/%KꭎբllߴΎբll_m/(:;F{ꭎbll_ezco;F?vc`ύ{{/<6{nzco8{nSoug^m&},6aνђzGcMس$kꭎ2&ع7{eMٳso}/Y&۔=;;F[{eMٳ={[-mʞ{v& bggzdYl3Sou֍mƞ<=[=[7;FKnۜ{5V!l)dKձz[ۜ{ MC6ٹ7z6C6S+Vlml<{{llݎ[=m{{n=m=i*;{.[={5Mνv&jlzIMν3Vjjl쵑Wꭎղ>ع7Xc89^X6:ۅ{[–vazco4:ۅy[-νr''jillWv[ݕ-^l:VKgdso[-νNٺnRou7t.{ >iCeuع7ɱZ6;F[ݝ-m۝{Wxd׃}_6;{ YRouavgh{co۝{-Va[cdhOձZm퓽\k#{agTVc`DKꭎղ>ع7ZSoullu ;F[ꭎljdOձZ['ۅ{{u]ٹ7zlilly=}pXυucveNni=q=|nS~$mʟwAݾGNj?}WOG|y|ͦq:!jN_/~onox{`x)^xUq:qϏ/~z޿k_۳o[?gm/}&C~~۱dQ>1<ӿzHȏzܥic!!ggE^zI6cνmG`sU9V֍$z`6g#0_Hձz[79;FKꭎCL9;^/S찐InƶνіzdakcdO%{ꭎC6ٹ7"C6ٹ7z[=m{Cٶ-Vall[ݏ[=m{G/#6wG^<W=G^9VG^Y7t[=;F1"{Uؾso*lo=SouƞRouνze Ve{cz{gVe{gzcoXlUw\zcoXl5wvcD&9VVc`hM}b}F[{ec}so[-[택{1"{ec]ع7z.llj`bC.}|S{u]ع7[-ν#VweKcdW'Kꭎ:ٮLjLr쭖vehKٺn:VKgb [ޔ>ȼ.{ #2{emcsonWν-V+vg/![{EWvgFd^9Vٹ7ZRoyDE>ٹ7ZSou>ȼ5OR[->ȼOv0"ʱZm}y=Sou_lQu/v^:VGd^:{+ #2식{[y[-ƶ>ȼrzll1 #Vjq ع7ZRougGd^ynK^|]NcD&y_Ymž{-Vggc#2_[-mž{[-mʞ{WGLeMٳso>^١2٦Rou쭖6eνIղfٹ7z1زf9ع7ZRou֍mƞLjLrی{-V7g֍mνўzconlsLձz[ۜ{1"{mso{6C6S-VlmlSouζνICٶع7ZRou[ll[idMձz[;;F1e{umso[=;F[70ozcopoܛڏmw#腽=Ro>"<ν=Vl7>"u[{dso#2ɱzL*;Fkېdso[$"{ꭎcY0d=[=[흝{WG`b}sٲm+Vc`Rou쭖νIղ.=Roullu ;FKꭎljdMձZ['ۅ{aI:ٮ+[['ە:y[-ν+Vjl]lWv -v轰t.;F[ݍ-^Sou쭖vcq&jln-;[6;;j;^[mcޯRouavgh?{co۝{g{E>ٹ7z[&[cd/;^Xm퓝{۱ߛ{E>ٹ7آll_=Rou{}%Vj1 /vc79Vmνіzc`ύ{=Vjq 3Vjq {n[-6aνc-6a^Rou쭖6j=>uc=2~ol=[-m{so2٦k5VjYlSm~or쭖6cνўzco,{Mν3V6cA^~orی{e{`6gzconlsrOձz[ۜ{DZߛ{ٹ7ZRou!lml:VekcdO%[ꭎC6ٹ7ڏ[=޿p-Pv-v^:VckgbO{/z/c>ع7ZRou{>k#k꽰zec}z-Vjl [6:ۅ{gꭎljzco4N ;v' KcdsotK]:ٮz{ZOu\Ot̮#:oޟoim~K[ڏNo/rȋcxC>⏽ytr۱[>iy|HX7'^p_x)_u{/_"?p|N_~цgy:}zu߰юx{z-ϫ1p8DSy8Dd!ϛE|<C C[]|rwxr{|B~~/~ot;>ߺ߇/oo_T"e}!W}~no~_m}Ƿ۷|O>p۷o߿w~5z7ۯn {{jOo~mwp ,[=611> myv7=>_&9pº͞|I8;qyn^;2%J3ĵ^=َWQ?h} s_4#N\uz,(hF"g, ͈sc0DAԍhNLg"+ F4'Ny-F!D݈cda,B4'xM:M} sQ)"%FIBFI:5F¡DmDh `,JNIL# CdPvR8cda[ġDD[trY8h"`aDD[bd~j/x_7yEDD߈_爑!p8Q7b <Cdp 7b Yq8Q荘"-F1*Do9_Y8&Q荘"=BY8&Q荘"W,8&Q蝘"Ϝ[)2p>cՈ>k{# CdlD5b Y" e#}SdG" e#])2cdalDu q9cda,FT'Sd1" u])̵sd4N+1EYؕ(J\uY" u])2p!P:Qѕ"%Fv#J'"SdY(F\uZ,<!ˬ(/uxo#BDۈn8cdaw mDwb \10Dm#ʶm+ٹ7ѱZmν=Va[cdzco('{)YRoue[gdhG#co(:;F[-ʶνўzco:{y[-ƶνkbl칱sopbc`ύRoug`ύ{{ꭎlثUq⧝<ш}=dq {6v[=[mž&YSou쭖6aνZt쭖6eνўzGgdggzcoL){vZzco,){vv G;^Xی=;;F[=[ی=;F[{uc U([=[7;FKnۜ{5V!l)dKձz[ۜ{} C6ٹ7z6C6S+Vlml<{{ll[=m{{n=m=K3VjQ5Ov^qco(:';s:;(:;F[{~ [gb/#[{a}so/{6aso_bl칱so[_{ndKձZ^/pṱsoɱZmž{g-6a^Rou쭖6&xa/2٦ع7ɱZ&۔=;;F[=:[&۔=;{-HձZ۔=;;F˱ߛ{eسso[-mƞ{-V6cAc79V֍mν3V7g֍mν+V!l) akcsot;{co69;F[}|!lml=RouƶɞJ[{msoɱz([;;F[n=m{=V+kgbO#[{ͯl{W~[=;ݷ-^<:ؾΫ[ꭎ:ؾsotϯ{UؾsoHձz8[}~-7p /x9= нdsoѱzL*;F{=&[흝{gꭎcUsWꭎcUٹ7xCbsotK}b}sotOձZ6{mz//7[6{mdIձZ6:;Fk–vahKձZ[^쩷:VKcdso<2O:ٮRouW4Nͻ~ܷݕ-vٻ]٫c=l9F۔[)?6}?ޞOS_ _~O_x:q[>l93϶8{ɛn496o\oXcC_^d_~L/<x#gggǗ}M=N^k>zOVzxg_SϳqO>>'5 ppAaϟ{OOy{1 ~%wo_wWM~&N}zkk|:o߾wwv?}o߾}})>ΠO?]LJ廟|uq>|}ݻoxk}Mڷ^[k|OQĸɎ llf?ggE>͢G_c=`3䗿 6lYl3+V6cνm֍mƞ܎[=[79;F[ݜ=[79{ y[=ۜ{%V!lmlsv^k_6[YC6ٹ7Rou!lmldOձz([&;F?6coPvMv^:Vekgb:-Pv-4rKձz[;;Fc3 9Vc`bz˰aW>+y}cO#aWaW=:Vg`νa^9Vg}chOaWVa{czcol7zco0+{c}ؼCdsotKaWν=V0+"[{ba^;;FKy[=[}yXl5yd[-[택{=VjaWν3 ür쭖>ür^ [6:ۅX0+ Kc]ع7aW:.Sou쭖>ür+[['ە}Y-:VKgdsoaWٺخm< ٺn:VKgb0g_o>1/6^a[-mۍ{uΖν-V}&6;{ [-އIٹ7z0ɱZmνђzad5Ov[{adkldKձZm퓝{Iբll_=Sou_lQu/v^:V}mc`bv $j1 ع7걱6sc/'[{6schIձZmž{qICggchKգ&0:Vdgcc5:VdgczadlSWv轰L){v> u[{eMٳsot?aco,{vvzI6cνђzconl3d}r {`6chKcucso[=ۜ=(:;F[{l틽,:V식{5rc`{_9F[=7v[{l=7rLձZ}~ν؏Nll<{ll5-Vjl_~y=O7~<[&۔=;Fc:9VdgghIգeMٳ"kꭎղئٹ7ڎ[-mƞ{=VjYl3N9ν3V6cA^~orی{enۜ{[ꭎCغS=V!lmlsv~or6ghIyWƶνњzcoP6MT[=m{دNC zbekgbzcoymu>σ-vnaco0ysotO}cc`>σ:Vg`ν_9Vg}chMձz8[}m7p /xTdu?@CνMcUع7z}7yL*;;{/z/<&[흽~-Vتlݏ[=[흝{G=[택{%V}7Y탽6 {1-[탽6[-[택{=VwaVgsoLձZ[^Rou쭖va`{aillWvn+[['r?z^qtWtοveNozm-Kni oGxm>c߸8`/xe'?SÓ3Op_j)q͏/ۛ?owg7_gsy>[>u i8m}==?OgOv[?ޞ|ߴr1M~xǿ|:oC񯝟y|ȳ!niNj6?{[|5<-} Q>*{9}}e< ='^|Ov|u󧿼?o&/~}r?&?ӿ>׾n~|wxW}=ۿ}~Hq>}#}epooƠnvy<؇7{.r{ endstream endobj 4202 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 4205 0 obj << /Length 2455 /Filter /FlateDecode >> stream xZݏ'83)#H&E҇bї\dʒsΐC[jK"O+ңp8P__|!b/7s&x!e/?M/JG2YeJJN ,V2 J$tbCta>r.t-W2wk&30Udӣے:&Dy# E̲D(4`!e2OבLb$;X[\FGZ) `8olfTEۦDM88c$g9b'*+Y(;&#NzĤ=䑏\Ds˙ +fv2c S藺nz gxrTij7 hӵS/y!i̫^uޛnws> rC@,d%&iIO%6iYuUΪ!KU_ꪜ͘}@0T X鮛˾L01N gֈlva)u9<9mV!wMl䣠?4jG 0@O1~ bq;jЮ.WQ(EPF#Zb~·yWhRCwn2^#ҕ5M 9&ȉcҝLYw}X*ХIoBvjFM5C_4{7+]P9hO^UNzU=z1]ChLMﷺwEbcħQ WFúA5^ Ĵd+'v{.zRݔix\,{]"J-Up<4KBHO 28ORdHۙVLIʠp!'+:9P9R7\9D1 DobZSPYGE[1Z$3JQOͺ P<'n2 qNw=iBw4@f3Ҕn]Jޣg ߉;GWtoPeY5G- jW$rϼ1qԉCx5VldNG7t=M"сgQ!(ID EI/0E %Ptgs?Vd9[/d ݰ2ݠay ޿ EqExKeE 1nXr&`nȏd<(.y 豲Г ֹVxEpR:` ҥ@(Q:O-BմP{()d7 >r[(ȝy.C%)2ü~i~;+3akS~`&,>sɹ Y%V~vJz:|~-@3<5Ө!7BCG~;d\Ѵ S`V.7a)+4aisEy}˰YcU} np8^7Dpn|cUo=OQ}k>="A%mc0A&r+~O ;w6^:ydRf'g|Ysk mה޿"QKAxɣ2XKeyuu /e]HT4X/k#qOϗi [qپ/nٹ"O@ s߂7)m endstream endobj 4237 0 obj << /Length 2835 /Filter /FlateDecode >> stream xYmHίS"mm@]``qBNp`; 뷪OH4Ҥ]^gdyK?E,Rnfs&=5 `JFd⿷?{T,P!ld&U:pnh~ԑ~`:nD`}v(ns(K]8O2']Evdvbt/q'0Un٫ӪN׏a9 Q~Z0,+ +v KKCafNE~^Vds^-nd8CG]|{Ws^*lbnx@kxג7\ 8d̸T4yNsMRLb};>g^(g)h{|Tȸ+ *v#!:b" C};ipSIιy1 rsR@V!%X4;?lYB4帧ccX;J$)غ8};ճV Dqvi׺+|kxאilF˷)tuڤ!Nl2KT)qЄ}Rȸ3 ,- )f]9&sH7;RUޣleCwѤ1f[l!1ogI#ٌd ņ rA O bUǩ$#8xa[ȀqeEKczrQl&E,Cf.wgw̅HDn AE`.9NwnTS-@j(ף(6[j疇Fcm'+nВ U!f ؒ؊\"[KT-UoZ?#WDN\K)?t\K= :/ل$|x~ Q/ы"+>NS w-ę×,Ds&lEJM` W RDM D nQ>Lj`crA+wEe6+)!MYתVguzVN548 L.lJz߸\lÎ{heO'P>U33qU%t^82h" =&yD!s7/u&B^dLܥ~pz .M"}.]ȩxȧ LP C&,`0#Jmzu.%Ў!ܝEEM|uRa8!?&-߄لGEFc 3?q1RxkODL \37js(V>Ǘ( huVCq9 S6p&r!P` Ck͛_0,:ER&P1'IC&Q悭JF+z&袼@p@,O$fC$=aB{z4==]&!"ļAd>M@4^2-bH*tmȾI85d:vXpf wtRC!D.3ـ? [QPus@ݗ|X~lv?2 MDc >G@1xTُ <&^׺l]EIGKW7q3 Oxjx@v:s*ڙM &$,_]|YCxܑs\7ס0̷ ,eKr";q]7UuIǍz ISCQk1 j ג-mi9LujS,Dq|o)xH0/&gԾP%k_d+]_ZpΟ:N`,X(F00da0^5^Tqpq~|Txe&!5|mY=Tv]Ηo "nFj8Z >P G1Z{xM M4njk(@Icjn4}Jt!^v_b:T kfCA~sɽMس3OzjIyҟ0G<Դk}ga(el^ِ,|ΤIcQmDL]z&Q?3_s%cSN+cY?hM <њ"Cڅ.^_ݼz㫛o_7hŒw1U]nɒcɃoPyi<0pN3߼{ZC5%8 kƭqEou nQ 4M(J] S vr~%B78A h$WLh} P憾2?ec!u{#牮 >qF}@`G=7僣OD+,ɖp$d~cJ k_e~t]ffnRvlgb|Xh6-Oє6M endstream endobj 4250 0 obj << /Length 4331 /Filter /FlateDecode >> stream xڽ[KP%*ƃ8sX;v*&9$9PgD/E$5_n4@8;[Nj h6ӛo߿n$Bo?l8cLpho7e}ne}e0)Y07f'Mf;섁$u{Ww;!\mcYn+~<ڎh2YȔat)Cyy6o#4<1r$ȈiMh6h F3z ۢ9F[{\UX@ 9ZLX <',@4`qP$US 1^f/#aQ9uX֘D`Cq_6-Ivq &\3Apf'"͜b/ddt3- 0/p_WUEUIU ۢjКbкNK E V@Z>mA| 5p_kE:i%[GY bvp:HA~^ƚ d\9 Xg|15c% ( m {<(s"nHpdͻ2MѢWVS}%°(8wJN(W^(<;+lvVgga<Q1\*KقlUF)[l}9e =B+̔g0%{`'@K~pYJžA8.eԼbe߃RR"` Vـ#|WMG+8GrgKd"&|"R^:u"=%©<#&*-,ߖ߾#DY OqcM<_a5w1; =Y;{ cfjRZP .Wan1 ےY9nsU4j$`3̯sP;6);y/-f_*k⦣kpjI=UW(` Oi'>5_+GgFCFR /G&bRtmkmeK|XN;IՏy6RV>0:%Q.^ M î8+2ӉQƚ# l_fvӲEmMpH;pLAdcD"$_\Z[x:~P9H1eKV5Kas*f|bReFXM Tc{kʂq2 8wRpuiFHW$gkjhBGOzΘS91LS,ǔBã|tTC7T u6$g"mRhQLG:<,)C;'2OX2r[NV1C$s0:Himm_/5TIOr_D2 D1 ܔ?hp=~*:ZogYxrH:Xй{iسpZ! | Ts(掖r `V{'1ŵX YƎzzKx klwq"I0{:]Zdkv- s>hds @5nfpaXK y#/T\& l ypmwv2"럫}e9\e&9 ٟ3Od(>va֜}lɦC}LI-2=C .IxD2۷}y5SM"1'֦ƛaUPj]HE Æ.vhCű!DPu][GRB.kMdALTdr/͒/槪=] 9tCP\̥P.jGC 3'JNwkl!W=0Iֆb7tI]S r_:;d8tJa(o+o-;`vl; 0xuzൌ <cZCklP ̺񟁳5K(Q k}*TYOV;C[~95W.5s9fbgހ|3ݰ™,sP~Q_KX^ E2+C ʧihz28&dJl T?ʗ LӅ#|]b;c^B{+ǯҘ\n`h߾\DLsMo#\sYlR8B]C=>Obym n>hvšO6Fr^1> stream xڭYQs۸~ϯS` 2tj'q\<ľkg.})b"O4@.m2 pRoON⓷ί^$c1>13-?O/t22F1SXvvbzs3Yl.d^㨜Ͷ+W+m[ެu5\EmLnyW֕om筺%Mk_-ٖ״*_YzO{*&a l[O4a*sb m[w}ȹ%9x(Sjd\aW|G}*_V}{wK,_}~J޿NJaiܱĸu 7 `zaI<ؔU.#`]Z~&T7e oQ䫕]c8rOM7y( Us&31+܄,ˊ0|QVzVi2#I v5΢ƶK߭o`^,V~pآl@ymzFoh_U,a( xo`k{?^_^}zP03l9#3j&b.9S1 6r- @p$ 2qۻ@7Lb[~#P Fׇmg7M7b=?5!O~wZvݦ}qzfs1Zf&[y^e9-6O#[ f__θ+x܀em^,#2$St ϲ|nTscxb7y٦b.Z?@ _Ju1 v6yͪ,z=)?^0i`O4Fc5~Ծk²t@kVoXiY ~,ܻ؍іdZo\?T<;`U]uv o(eػف]QF4";D,"#",H |\~a!d$ !r;$*ka$(ҨC*E2\ "8czq C( !_JB񪃇r! <<5E W.H4zO(s.xrڶHR=AKtʋ$˜ʕ&E&Z[2xsz}K2f=I!%{*pcj6ãEc=rrt,Meȱ>Y.H{ yDqf^pNVG;Y<42Feq+4N0u%HMt^.WYʨ[+(qi/ ‡ڔ5a ?g_-1?XxNPOc*iI~E/3P$3:&xD#G|ȷhU EPP'd:# u!m?QJVOhM P"md2K&Q:kHdPrH#~lD$YnjtcM6,H_=>k9$g UEM UG8;){pm^V /9!e~TU-F2Dr`ϟ!dd0 DfՈiRN_j܊+^C'/)@2zEѧ4LӺA:]^^NA_`c[UvجΏn;pAQ^~'Yۜ|(I5)&#Xpd[ ]a2W P3vW0 (w`F(%\hO /M`.%j|@ljgLPvI^7_r ߓdO7̦L&}6"?{I \O8FB a˜6'ir Sɠa_.l3=DxTA}1Th=wzIܡ޹m\^7kOq34, /Wb,eIT~2(%ӣ9BNN:i1,i)0bxOJY~Ev'uuA'h4Ҹ- jˮt/Yv;o4>6Im";ҷ#8lGpAp= ZS7%cIZ"?myf.KLC' 86ҕOg~?:׶j?xQ霊ǟ}W+;*zh?,KAE87 Zȥ?:[-3_r*dmxs쿏D endstream endobj 4263 0 obj << /Length 875 /Filter /FlateDecode >> stream xWo0_xv& "/B T!ZK*NucMڴ_B0i]}>W;3;/zOG0pb^茦ADЏQ|:,ˋe^] {?Q୶ QF=l.aZs׋C_:"cuzvC*! _~㏊t=b0>a:hL"3^]|rU*R-|d+FI+1NjR cV#M*^nߋGOZK). ]X" lj 5N >DI5P5BU9@ ( 7vO܍=Sy2z\܊RSnTl:eM%Xʜ:<=nJQsV͋4_[>Lv$e-/mTܺxLgP]nvn2:N*@)eZ{ 7_/7%Z]Ҧoa p^BZ]j:s[{eias*&"7@lɝr5AV7c3C 2 hؒ-m kI+ΚC D(ls/mÉ^V^, ]A3.7)IVsKiWag6Kq1lfX{V ٖ&G;fW56ֈٮPM;_=S#ϔ9 tuϡ-@Tl-b9+fۗcZ&v.X澤L[;!x|߯R+0'*Q,av޾W6)O(7 <_Mx2xYA3Ton;t?Q;> stream xڽWY6~_!()|CZx{ H}jHM&]Zw}"i[^i#üfsqU_/~^^\^g2qYf%_*1+5S&Vv JّĚ 7ƼrbBJW; 7[]cI1/2̀Ud>vW(o4FU#I~F1OinVҢd [?qrYiL5u f1kRjgNUהlxY^U.1ݖ׬k+IEKM^١Q';!S8F8i s+Uðn8XL>@{ob]@xSmJ~"C7n {29.^cV\-s^N-`Det [#%a,TpMȆ;nd:pⳛ-d>&*BF f〕>%n|o]gt>NA{Q2y/5 v Fܰ2Ù* `E5Mftw耊Act$g5tygw `VZP\]@a``Gخ*#Zm0FGG&,#v(.S:OB9\XZj-vtv50]r_icxC#©݋៝. #p J<9Id1#k\,/vg! endstream endobj 4272 0 obj << /Length 956 /Filter /FlateDecode >> stream xWMo6WWH oեEm]{`$&"H_R$eɱ,"zy}{(0 QzB oY{i;^$"YQ(k2B]A>\,A&,&H k7#"$$¼<o@jR'bYMLq'i.G ( V'NJk^OoeKt":̈́\r"2#$M<"8qO\j9{ E0=3y03g-~m0w].>tGY0I'UƉKyՖ]N!gIM+Il+VX){*H1~TU)&Hkc&RrJQ0siWK3ۘL%fe6}6w&i۲ÿ H`ۃNX}jRɹ8=g:x֡#kN** PLW|s8Q&lY B8i fz8@;cE Q(ϸL`e=J2XQE~- aj)ňwIMFN ]qD =P[;7;*?5o/뛲 -cͦ9 '˲+t0!H|~X]i ϺyBȹR:vG&Oc\(\<\25dyؐrY)>V \z.@͟9d5$cΩZm%K Vp@4xB| Lf}!0W}!R㭃Q6-IvĪڢ7BPP5aj.#%kC>~zR endstream endobj 4278 0 obj << /Length 1216 /Filter /FlateDecode >> stream xڵWn6}Wm#KEvm-4NT⊲wx$5"g3g89"L9= rbQDRg;קg7/`JBJ%j+*''33Xڹ~ DY9sC;]r!WQ5|ٴ˵nӶ tj)j꼨ժܾmh[z@ (]4SZߺɸz|ݲlOLge" )|#}#jFz9?.EzLME/ᬶֶVw cc>mឨdYJ|(r.bFL ` M_hpLzPV V~+%=*˶042Z\pMR jA2rs1\e>0 gB~~v 9Mw>.x- 4H";`%HER7<d~>{a܏RAG&7$ Az@ҹmwDv#Ght}>JlWCl) i3?MztjNR5[Nl4E1Wo\C{W7%UTq*m~tzl)}}BfA[ʙfL '# S rFXEh.Ut#m3Eq 6hm5>U;lܺ"n%\AG4@a=e'b1ԇvw q1 PF @8DMPdpKA!S?h3I endstream endobj 4291 0 obj << /Length 1993 /Filter /FlateDecode >> stream xڝXmo6/q1#E~Ȧm2m@/~pH%J^hCgpoܾ*c~aD,W)Llu[?f9_vDdD&YeY-xބXVoMKAB5CUNBVQȤTQC\dyDIhgqۖ.<93L(vx Vy`(fYUld ORx*$*0ߣ[LotPW_kpǺiEWӹ~&Nyfk9LbXZI>Q._C^Վz%Ŋ5 4vtAǺ?ٍVʮOT@ZdIBjӸZczh#88O?RD,Lp < =h;FtkKpo|||-`1IKR0L_5~ HlhTtc1\kID+ʉ-+ h@;Xe6&$4Jߺ2+وeN&zO4Y_Dc/Ї@kQ˙]})[{pNgǣ;/@.`l3S8Nn@X_/9H ƣv\0HQOB*0}/s~D"PnL]N}m/p˘ɁK;S>mp,BC{-\ )Ry218qc9xiix)Oð|N BK7x) p1T>=" fՀS. ysFߐz0ی<1ex1Ι`PS4RYEWNr9FCfZ; !VS) /ek%ˎ$Jn'OFj N5EHoZZsć?y-yN|>Glrʶ.x4-TOZ9B~;%eRRx΂۳۾3UDMR9РZJ engQ7xyŶh]̆/b1Quno>ޛЮtʊAbb<ZsBDb1!@VXlBL=Ӄhff||ەqZX1- ngڭ%И]r"ر_0!Q;.HPaƨryN߁!On"9_g AV7F,5`o_QǮ{h\.MgyjLN %]qŀsa5Q4U$|[W@i6 ((9p"X ۇ3?hr ~Fd .6dU],nnC`. Ӿ?)(@/jxoB.쑙vZO81HƊ-[ w .hvuq !mC e((n dG8;3_w?t)S| 2!FĔbk9uI] MofXGN:t4w:a Hu&3μw? endstream endobj 4303 0 obj << /Length 1543 /Filter /FlateDecode >> stream xڭWKs6WpT|gCD9%9@$$H e;EҒzzX,ەm<{?yyR/CYLbo c,/dzo?~E`V| Tj9+.fws^+Oi };{֬>q /'.2ga6ߊ=څ3oE%ɬ+mqg/LR ѝ3 LVr`,A{n :Pޣy!pP*ާɟgyA b`Ib/L}9̇ Re4DD& {Xfo*Ir8>"11&x|N_C[vxPs6^뗤/f8!@@ObDY :Ʃ/3L5+(!-&*VX# Vt-] ?sL-`"X8lfQX   ެX,?~wcc o&B~`G3FS`y5rº~K*eWQ51c62axIPOQʳOBaiwj 2iA,H:UziDCOP#^툁a0q;շ,!%.%7W5v \ahjCwf=rz%J+ދH%A쾁zc3`Х̓4C]V>x04QDM-$w쓔AŰz@PV'T@"P$N#EtV RꂯH4ٌ`jIH'v9)@E%uY!Irط K=@GEafGb,Fo7GEݩeu湍-A b~ OQal4zgpVA&H{̊+ötӥu'BK>:7flT皳 0׎W;0]yQ0=ISkM[pPb;jnˢO{AvaU^#h)f`6 cXÓ4|RlZzIU 8EcUʆ5F%;5ÚKW sTzPY_QnT\{̽^&},,Q/[fڳ,60֮}40WYia=sO[Lnڲ&h;BfBז6N h endstream endobj 4200 0 obj << /Type /ObjStm /N 100 /First 991 /Length 2617 /Filter /FlateDecode >> stream xZs7_\gә|\\یkiv]i@T[do< ?:y)m0Z R2J 2f#aʊ,. "pd o uKB[f`#-t,$:f8{Y(500X Ba\t0. 0JXL6,,ų C( r'{ ؄e( ,#Rb̏0aC~Gu!9&bʳve^t]:lNXVAu˰9['2y :@Mra@gSymp9>b g:EXy%K;Āq 2`@ya5 Lwl u`&17)0DTe`"jdBbEI1zO<"feYj#KH*r""! 3V$2'H}ieG?yvAx)f_7FJ M)0H)GJIao"5% ^K\!҉7?ryQrk_}#{Q[P ?;~;O)fNOd-en5s~v-Wώ~1U#]U}~9^ԋiDs3Q}TuI{AJnn:z%3׆_mH+߬9TE3oQºj6i DHissLXLyѲod>Z.͗LM5G hI=5m_',*v]d:/?,zMe_u]|F5[\գ8ER'^~U!~t&&=>s"5<:2KyPxr8o2;\z7zokҋx[_6Hh -اYQu,ݓT~ ,W辈Sy%$sA5<ٯF8eۙ 9~y,e-"[wbvΞYM+;'c.ST \2eˠp6)Ml gS8Φp6)p™ gZq97?'Gdn>nhzS<]rJIe1h#md b% Ȟz'@L~wr+^g\gAA5C1tFv3E3uf:ZdaE6\C Qw16R/*#bԫ5[Q^lhf:rœ&h0$Nͺ~2@:H2QZ)TOPXR OYr{`<Yɵh`OѽjS 3䳓Cvʲ;z@=z`[kգm>/!@Euoޣ@}zQCp|(Bq _@+o{psmA*62 uܰ tE e8^ـ:h8 Q>,\@ %N%fx1H]0C2x- jRŀ[uAu1ܫrqNc,'.-hX_Gr5BȰܝx1t'#s~'KȀZ`G_^=>͆%i9zĄ5cݘ]U= TF&OVZYIfHstQrNn~t(hvҞdl5m9]S7zSimimimi횦קgvףgT{ q5o̾ >.`iZCE{úR(Ҁ_i8aB#{:EtR[FE#!%O!ҹ.q{#*,34Q=)6ʼnF%:]_ii8v嶆H!1qZ993tCѭĸwfɭR>3.=6e)هL[]ɔn#D>}bQݚM՜b';7ss}A`o/oTpfř?bဠ$.Ao|QoCm"z;/Ǹ'Χ-Im#mo:;ÜBbibizh5bsʎTBkB^8muCN}U( ^lOΗIP6DB;9'uAF/5dH' v?j.8 (MMJ?P:Eo;RdP endstream endobj 4312 0 obj << /Length 2393 /Filter /FlateDecode >> stream xڽ]}q/:RH@k H?CDjdɕpFn>f=6b|M:ԛF HoV>\{>U:0i <n?|Tj՝2.4T-;T+>K4 {66o$޶]ST\Gۮfe6i[.\/Ώ\þ-*rm7O@sik>xr@baݻHA_\KGuÿ.O `_-vsWaGf)8IWһ߭0AD="t#RvWX݅:8 VYEAN5m (XkOz4P`+"skw;P(Sw awf}g]c%԰] 7Gͼ&^x {kkh72c"FW=< {kUf{\1k:[}M/u\/~qjhQ q>:֠}BW tSd`P-/Plx9@{hj0O F8h/1k-g\ܫ*Pqt&˜*!R{(DrPo$;xζU4+涳sg,;:3zcg7ip%(њ]&P2ݿAχz2H%|kZGId{/UG@ N*Wtk&.VaHfZg4qr4c{Vn#lY<ǃvXhѶ|&f}O^X c X֯I$ ~ΨUPyeܫ)~GѬ ؄E܄@dz#B×j{iJ&q՜;, i C XAЬnj*:ykO璪6:YˠUI0rS1]/@̽mviYR@a>l*_PQU [PԀ޿zOYivuԈ0I` =6dh?an~;-*ZHs#72:B;.0 nwYNYO"4s w~4^K}uὟAǾ>A<~(T:(AeQ ER {T[I|3pw.I5v2JNŊ[U&3f7O࣊ȍ0{ &;p > stream xڵZ[ۺ~ϯX@"REsCӢZU#K$g"QZ:{ibQ΍ Mn/~w\]i ^\]DdŕdB_]WWEf@Z&Ds& -KvoʺikSߝ}Ǿz_6w|9?wa,۪+v1LP7[N7Z׋rK޸xDQQŻDf*0? Fp"i WXjFF@S6rw ue׉w"(Vyo )5Nw;BĬYF6f9;,{Vبa`܌VdG3&Dʘ$R,`Q0}ٗ 3%@p&3)B)l1Cr5A:@d (O[3(TGǍV3J !ۇĂ%ڟ{+mn!4nG;m_nah^!~ć@v=E{_[єm#@5,"pHR)Q9ŞjZWfIg?AD[ kvȉ?V XO읟bIH;_&vd* g 0 ql48Ql X\R)'Selq6XPr;QEr+{`9_된co5f|;7Sn{:%a1҇֘j{px=UcCׇ`L%ّMXѿigX?Ke!{@}=`3rb?aa/e3j0VsPLχS(TMAw8bʬiK"iCt?iq}y]d†hұ9ݕ)&ԎԐЩ0Ke 29RNf:Q flJNj}˦ސ4h#Hd]0 OH2vV)RNƢer@9Ŧ>dYmTx-}l.S OITvA3Q ] 8MCXL]Ld4)f >fQ+|AP⪶*XW99"anR3 eDDyu!qZ 48%y&`b!݌6~7uotB-m|j\/":x|@4|z{[=/z芕S3O(ss ܤOυ?gn/$qXkNwiC/yl[w`-~ n+5/|vzg} 0 5 |Se}+ TeD)tN'vۺ(^`3KeF01Ҩ5ڌuz K8>n2/Ub;[bqu)]4m"UYg/TG3Er(آsO϶2Z_湅m-zQӰ]EU( l.?d.庤lW|ASA⢖)'|.~JSjOn;j }z56WGj;Scʵ7Ʊknut{tx6s&RsHOy.mA ;B ֽ9s+`C"wEy,U}sI 0j9NVZoǮԪ,]pP-r{;],ܝNUE g0c?Zj] IJR%u2pN_c#@` 'J>򷪂E&{ XR21 ԓ䣂EAνeպOS3kwl (_ ɥA4/5rJ(ٚvy;G HyjypN˝/Ox*zkB9%:ʾHH~_ endstream endobj 4329 0 obj << /Length 2285 /Filter /FlateDecode >> stream xڥ]o}=23Un-!}-f"K:J!G(?o\OE$H}F"%a-{Fo?\j',s dB#h/VaYU¥Сr몭Qu;mc!{fW[Qm風 w e΁MAP$6B˂XSCW@CZ䱷_ƞhRjklicy1ܡL;5nnPG)tҦs' –(pK{Ȣo!!i: 0JYW{8}GN)X<*sP yr-MI"-&(K60NX'񯵓5q+}Da!1vđtRm#o,ǃ Zұv4 ,ږ] 3Nw;n,X[AlZa\Ap'Ww0!DpFcZT*#>8{I}ӿe{2.8D9~J]Pd)V=9kxa D@#|fS%0 =2F5E97c$xu\D3$&hpAcX@T[X4iiQg" XӨ8Y/P8y9{N~Kjֶ<=il!xKU}p.t4{Q~0jq7fDY6["+7)>;Ezrdi|"]Q6(, ӫ;ك&L `=E{+u=<,-7R&"VmV5<[^Q-h^We, ]kBEe_ (8жn[YRɰgʴSe!}XIHI @OHFP\/!axаK|;lB+-v}0K".Za,8*(V) !,u!숀dp`4g0/<J@%0 ɗBoX %޸-[J cX{ [7md6m!?}F9Г⒘g&hSq(~<~XQU?k<;7Qn&\@ae!NGA;=ۃ .PFJ!']3y}le?)A)x3M3Mږ18Z}]Oؗ3GzpMӱ܌hUpj}q}}[WmQxP|;mZ*Qz:*㎀ FAt?p6gFv׭$:5}flEm1/e)9GU>~h$K:0h#^PE-k3F&{@QlA6'pzKvA/qajL1mOJ"0H派(jcd Zv_H-5D0CsIa s0)[YΠSOmg%8a&㞪wf%M2لq}X endstream endobj 4339 0 obj << /Length 1270 /Filter /FlateDecode >> stream xXKo8W )YMmܽh[$GER٤t c9^MMLAͣI%$vZҙpn&v|=pNh<%1ƫL {E%FLKהTr$׿Ԃ  ( }(:YG5"*T(WIE^Bpb$F11-UK >SF;,xYXnld01yǢCT["]f}/D e}0p09Ҿd fFX[!BftgnݘTc_T`});3m2rtV ιq Ͼ-ڊu仮'^+w_%P3|_${{k t(:tOA(ٛ?#iG3Y?2gվ\ۤj7ze?m`gHz9 ᄍ GfMsaL%z齲#]7 \ey%_}!=fuC5F v6o̎q^q;9ؖi zP`pǕϯE?< BQ4\˺`eo.(p6`ȷmU?c1.ǂ*އn):T]>zm=z5% endstream endobj 4351 0 obj << /Length 2707 /Filter /FlateDecode >> stream xYKϯh 9"dw`9es%-,9zL뷊Utb/ 7W_ǻ83*{8 :)ECq]߈t6\X$bnV x}ֳY{n^%ШirWɫXThgi* vOeRT.ZaURf}ԝXHeٲfpKv^/Xsgkұ,X}V%R/-Ce;jz,JikެeLw=O Nyo>qWeo=틁Em}̒|Hv8t&qS)y,sjvN0AmC{;>s;v`NI[S3T,("i:+6~y589fYɝ:t&C+Ow-n@WI .\Z B?uW*pݿ۳ms cxV:ލT菐}/` @eFW>X:-bM] ;wRjD.rF9g+&')*`R="L&l!#ő=z EnRio@Ȅ<;TFq#<<˘*C0i;J!(5+AAsnAkG*7 (O"ٜ[)Ga"wRrkFƴS#8S2!w -^YX/E*|x/>  ]m(2Æ> =J(Ţy%TȪ;r8@j~,L@$TTY`a=/t*]Q,E'|س+ylƑf/N(1O7ۊ%c xY A-Ljp3ŵW~ ꨂ^ Ǒ^Ek /X 5ؘ)ۑ_.A~#>Ȝl\%&0!1?pbTݍsi)8qʯM@7w-R;hքp.o˃FOeaueg;@=sKyHKM͙:۬Z?H=Kr`P:]@X2BIa K>~J B/̱̬ ߃*,fPQ&6̗cWI]@M2{[o'l̛v4R #g4C8yH{ZĈ@̞"rD`g| tu@K4֡!fu1].9m|'z1*Od2A.0ϥ8P*Ốa7CGCTXnˁ[V-(lV.l Pֹxq6ގaOlOż5}s%e e$0R8%n ks𙀤,q/Z -Z9\=||tW0*[D=I⶿?fODO$ äqtQqc`NЦ_'RDz4+cBZ[;wNŸIFPS& m(*4\/kD" Fu%I_\b b+i0[InPVC3RXRS"\e1奋!s HwDnP"ڶ ./Z{¢1\+$cm(p-l#cx\g$mxy>ؙ>s<dPKhQ3WA F ^MlJH] D5EKNblC^"$0 \GFp.AzH_F^ho`gz;%Z8@B{ضR6}&{tlXѭH $ߋAlޢ \pLQMB>:k%vuA -bx*Y)d3%jD#y#8+3Z*-ۚ,3%e(z- sY;Y;C/*8?z'T@L)ZA8?A$e cCbSOI_“\ e"^8h̶Z hrV?~bbkۜu8X%dv) Y-(Y^+HEWYq'K^3ϱ:cL]YGlН0'Lσ;Iɮvu SX{t5tOk[9_K !ceܴ> Љff>z򉰲B X\J+rFXtoK3V@#ȀDA/[a ew4FF@*xc \X*,'wK/kŧOb撂[I/~rON~xLt8-̉[DVH hD@+Y-;)072>ֆ$JX rE,Rݟ@k1}`tsx 5\P\XAyG>{ Unn&|x û endstream endobj 4360 0 obj << /Length 1803 /Filter /FlateDecode >> stream xWKs6Wh 5 ;M;ItqCDA2STbLMzhOċ]_t՛X.R@,n ,"ᜉ0]n0߾z#P, EMeÅ?1 El~Y cU.ػ QWHi7K{ϱzK{*kʊ&TΦfM uЄ* >a":Td,A "[𱛛pr93labqLwUaa:yHFB?r7h<8ܫi;UlX!:}:NIAl qbIK&Ip%E 8E z6.@ hqi758\0" q553UPcm愗ݩbg5}T{e lq&$L."̛Z9306E{XYXVCaM8t'EFW>-CԳH\! ôeuP $vF$x*(Dps'9I]gGZt^M+Ps<(mD>fb#&̞3Yj^zfd$kQ) 8ZGj@2PN9WV./~jH{g"5E*6Jj嘖-bwZ 6we.E~[J`-$N/j8 筗(8 5+wC> ͛.VwMs_\]3gai}> +6zee1Hx_iܧS[ ,6mFS$Z) CB }^8a~sG j.P7N[~QmD-l+CnXn-gi5P }{"rÝB "1IRc]v $36R3?te*?$a^Ϧ̑)W@.E\}kvCr?N1=Cڼz,k>˶y\߄Kf_ze.;PIO)چ( ZWTqohX-LyҨi ϊ k}h+.GZG4xlBNN]X|ਙ?擄W|cJ/XF.Gå9kwz w0 +#v<z P=Ƕ&ֳgP@}8⤫:ܰR'lt5'vݹ˕3ncD/7iVͱmo Bl/˯~n~D#'ع$$3<+ > <=Px8^ 15#߾{s}/zŝeʐ}pKeZU.J3F?@OA ^_j X\ endstream endobj 4371 0 obj << /Length 1291 /Filter /FlateDecode >> stream xXo6_!8o`~xX=4,юIt):IuKA"xG'2q\O"%! NOI]/GGpܶFpj0 "/Z9>tO{0.۶Cz>v?AZa<0$(mğY=U\ґ5UZs1L0_ʒ4!S삕@( PPFȋLZh: С1%CVcZŮΔ ̀4UU?i!oQ+V2m7XWQٲ:/dRm !IIK4 a= a%4GjqeY۠:ᎃ;W# p\hTan퀷;ts}feݪcGi%Kf5suo XXXjOgHtQͮߎ=R=ntC]K q4kfr-6űcnKbI a$5j-fc;XX{=!fǒ7 ^o%xQMg4-5]Qeᣢ1I2|jHغXq $QyZ Nbf-ܲeMSt5[ޤzl^|}qC!:RS7nhVepXKIQpEG}YABT5Ηtm9e)4x8PK[TxLe/ Ij|8g/ [΅ˆ9,‡ϸo EZFֹ4_m@&2򿉬pο=03U+[UKO*Ӷv"IOJ#~!diYg΂*saL ~ xDw2({,j A;%g pI:M[sgG^Clϐup> stream xYˎWZ|] MI#$ Y•%TH,w;Յbԩryڄ?}㗇Qɂ,aaoƂXdrr??|dHy젮 P+%tw!&S"v'(hs5,,~;mUѵzs՝ԝQ)*e=Fmў/:WԎGn+3.RضVwq2݃("t_v{۳,:׏;EA&iA,٣aA8*Ejߠx!6v+ovyMŋҦm]uVh/S~`˛2%J2~5,[0=SG/Vwk/xx[v-u~V޾.yZH՗ PS5yrcǷмOl߾XTNXR_V2`T!qSo< *!H SW3j k.@<P5pa5-uǛxypzXD ǒk K֤q3[h|"jw7O.s> ɂfxqx)7!Plew}Jf5v*>o.b3s+ 84c9'f?ἑF Q q+?V#aA$A @5FEmXrvk'NߩĝĢ$ޭ(=zVa02z}[Y# pí%(!^‚ʑxnb $jjZn܃ UTeϸ*PbQAi* A>/#>np6sDmUccH; p9*:w}?G[K¼n\_Š3]g@1F4wr3Q,XXk=,v)\D4=!hnu7XH8k(o ()3[؇}8DX[R*BʇH&e + TbeLD.@`كtnՖ|ZKΜ֣S`Y)xlrVW7xSno7! UmH7nJW*4 [:zm@qYCyvGEpXdNgQl92UB A)'ݟ+[$HbvKTҶt)jZ( 6Őt5 ۨ' Adxí9ƍ% ,#kkb_h2 -He; 1?Y<y:E SV*)OFKtԡ!&h8ʅ{Ԓh?*KX~ L$4hDn[Awh3yMF[s1d=r`Đ^S/aR2)G#4Sj 3-{MsqSU#xFI昖2!IzJMn}aTjeVX1?yYhm (mcHFrVt,(a2P!3gۓTeU9}}vH!.^teU > YG6Md!bzwl?>~/5b_ endstream endobj 4392 0 obj << /Length 1381 /Filter /FlateDecode >> stream xڵVKs6Wp 95!|wNr>e%9$9@$$ iҖ$$bbl~^jQ^FJ[U;_ t+|X_$H=*R3M ;^=LFvӓ A] '?21226>^H  ǾmAv̾ R׼Rkv Ff 0 .xm RK`=B(bOCn|9ޙwFfl\ i$-&ےw_mba @> (} =ka*g5QR!kS]uksՕ]PWf agm9aH'Dc<*/NvFo9=@ @JbT]jmKQG&(O6ܿ?i"'6 C`ы4t|4 L=i*Qk~́$Olgסk BPI&dܞd׉\є(7 våf [$zep)og>ӟZhv$> h lXG(; f] )ydyd=4r]~j& 0׬3N];&Pp9|>_ Ǧ(]w>ot /g/H^sWv֦ Sv\1(tIG =nd`s yg^JãGt ~)9\cμAюvY<@F[s;H8myvnYP{9i R˷N*EyVdAYDeo۱b:eg¹OÎ?g6nQj;goXY-Q ~ޣ5UĮ߼zݰk44Z}{.;D᭐F^(HaMk+&)d|:u>yrHkc%_9TV%nȿa ~ỳuW܂ؒo 8 NAnAliSO[P \A{^lբkϘCP3ꖏV>?{=#&Oi0!e3{{,(*rhT/źWy?ͅbp#GHN3>Jf:_ne瀴BLCUI볍t {Mhabä p[=D{S-8Y5KDѶ-]m"Pq*SSP]wWvD_ķE5}!6G9;?Ct UjZ~ݪ߭wO6udq$jΗ6 kjt8 endstream endobj 4402 0 obj << /Length 2347 /Filter /FlateDecode >> stream xYɎW$ҙ@Z64cJf&-e-]SFZt00D be(]worؕAlwEaIˣ(rwEv?>ɒԸA'LQN2`/V풣ȁŸCSqX-~?Y1* >g9˫YPW" ii]z(jꖾu^y91J(3 t~zo?cQE֜ [ixtZ${9аOuFg{^aiDn;fݣ1~])ӔNI"]kAbpky7Ȼ|ß/ÿW= >pd $ T/OLC#Tj+Et1 44p]k[h@82F*H3 WD@n%K9!} <ҫL'j ft\=A%xH9!&,*S: 6jz *3s|Yvij5vH붛XcwtؔuS/lS?7qˌ=/"qCU{o4.8ԄM4Ǩ PjY% ?!^37t{# n[QR\g_‡٬njj %=< t7UZ?80So嫞=]f8+;YA:ɄGL5->Fu]I+SȨӨMRHFNRDXe7tGⴁݡ-KAc.AXhB JeT+#sN5ΘHn^YƲ]A\]#`q˨t i'jcDwЧYSU*wGsQg~2 F+lԞTœ7cW;iʔXJlE 7jzV.&JQkFCR#S߇GqU?hT:k"XeziT?Jr j}ˠiSٗh3+/@9wV+t[YmާwK4IN^Vft黆f8sg ă/9/C.VQPtUK>I ܋޻ǁCe^T_m-b/ƾNQu~נM4c',5Lϱ _^!}{R/e endstream endobj 4415 0 obj << /Length 1698 /Filter /FlateDecode >> stream xXK606 z?lѴHY$(hʒ*Q뤿3Rfcr);YeRF^ݭ\a~benջ٩ȅ0i4tW'bJum^E@ QtDֻپ.; עԜc|[vu;J,wxm'r":ՆV/YTh,jXijqnE'>}+P69rl БԾ8T (|c|'0>hNOKΊRQTV)yF:NAai=g?c+ A?;g9 x[%'삟+p']b݊sdWT7R*xJ,:ZؔV_`;mUq} t 4*I4ρ[cDllHj~{ t(*pMN2tFadR:3O*AƆ; IlWAh崀}ي5jDZ†GCJQW@?Ў$"ț~+pUA8(YkIk)8P^r,RT KY$',:}+94/U{y M *jHI,](E*ё;m7xS0D4.B8uM`~␢ 6يr9YeEkViEκbx&PC#ORj(Bus|RzraT(átmQ z bReb$T4dצi"?V< \4ҙ+/O 0L 3 5=Sr?HTƸVQ&ǜhg/G!9Mg҈ZPH70SOlWWӉ,FL캇(U&`l}.sl$V8Q9[D'Z e󊗟;A K9BI*Ÿ/nA%lZG4@\_cL}[auۆoo$8g\z'OZx4}1$[p Xt-ܑ\s > [< A>y]`\A0IW9~ _Lc? 7BaeM`,M;,Tu;r9dj fQEzS l85~- F`0˧KM}>gZG `ks&S6<D-yi Iʢs> stream xZo7_ΰ0$-|W I 5ȃboR_)jבUe] 9? t3)lR_6%E o$ޛ*MrX P/@M1sPEF e #DebT!O(k>G?dKwљXqaཎT AŘ@QE&ĺ,0Pl%o2`  cJdE AΛ N( U"%ԱdQf;@,u,$+*+:0,XH\@1U P+peѩ) V%I5x&PI jv|EE,R(*AFT-TGCZr1> cD>(bf"XLEdF@̹EdƲ& JW5 )H }E0*d@8'X7XAR:oP(%f@f STuP v8(T4u `%[$*`u#EX껌b# vURvi_˜UGp'O`q$cz:,aoq_g+syi+]CaWE0A:t^3@KZaE2LWy2wr_Ňɻjqhu\vly/୰kx AFWX[zJj5v+ qW)m[OӆjP'd"xXV?`Lt0j9,kO>jvLJbwnvSCBgHb֡ v [ srn<;ݪ]5J$Hd~?-QHm/AZܾ{;9yu.>Q @.g'Ԇx+kz 'Cl72j r@dCU sVPэN c2\ʎ%ѡ4P.:[  cԽX',׽.'׊VhpnVK܈9HK'S_G;%]LxL}O}#䔎FtWT- p$4p;f'[;p6ԥS`x_MKVOڬG"\l8\ףEsopi396I8=7z{}M$pBr|8>PEO$?;v=A. _oGͣOhdAη;؂2j3YI ܮ&o.*2ņDc]HZRő.XWd$7zg+`Qލ~S0(J,QBrWF5K84!q"7<=s7J7#O]JI$|}ڭ^;6~$?tGў| r%Nxq";MExt W#'JGx'i&2{|.u+>jH0du)=e6q3Y&e;}3RD> endstream endobj 4425 0 obj << /Length 568 /Filter /FlateDecode >> stream xڥVMs0+t43EvZw&N)Alk|DM__aNJIZv] F`|Mu&PnFƐ HsI>wk\@8HRUr4:O!F!Lb yxD ~็ ţr~?{)#H hi'iLzI Õpqꈵ(uz$Du[e76PE9Ds8f¾2\ye2!o{'Ό qºUC%ڼu{b gc &!hemCCPyb,$u wdbu̕00ȆBկP^]^X04VC ?RD&yeuَ忸^ЪM~K9|v&5i9-o d%hA%LWj&p%,\-r!5ҷEn b|qk4K4sD|{Ć|=]v;f&isZ9Gij %֑K%^_? endstream endobj 4471 0 obj << /Length 1788 /Filter /FlateDecode >> stream xڽY[o6~ϯS++"%vÆ-i#6Yr%9iwxղ$ހ#;߹3bxˢGlZ/p E1b/V/DQ~xK4 Ŝ^F\ n }'FcX$Q^UdRTuY|hUXo SzLm_N f7ZvhDfj!-KKL=+aROYwj'3tf93ĨcZS'Y/pu+lAVuco6Uyؿq"eZٛ7W:FZ±X嘀*[@*̡-Ŧ%%XW['WUbL *2A> >\t$4itЏΩsi(S^Jr+i%E#zm◙JeSԓЪ+E/g-Wm>L w%%MaM`EjdI6B{4W;xdl7R{£sx顪YLD٧&( ssv=Yĕ[O3}VVzt oJ錞 OR5O:R]HQ[|#U8e:(S4 %IB2ј5>{!XFmj9MP"T=7 Ia"PYỮb%4([]3B gbv>r9B9^cBp:N6<}~;ѨcQ/Hx?oO"GBG>Cxg #T7#Kmoe,9T#? >D o18d# 9`2̻܉_-#u$5~]1yb2+wu{g3,Ğ3,[# ##\GܧM;pr ;WAe sX Lp1IWv!ȰwR=͟We3q<{'bEfr^`vTvlȸi5 CkXuѼ;w<&Sd.1H\G7] ( #̍) 1.z I8yzۊjW*;) {5-̬x>bDz0PΈ\.&[ʍܪݪáU#I:؃|ZigVn4|tOX .J!O)LvNj(B cgc3 %A_;ˢ=iim|7Eݝf*e]D|T)Njˠ~TeH]DӭRҕb+ήĬ7rI=!!e(zH't(JzŜoWcF@}X7'0 # GwH``fcŗ]H>Z#(-`]e&z2Kauc0N% +.t_ru0p2!5{@9ǂF@]F.<;E 8D'd`n8:ar-qa$1%1]! FB> stream x[KԮhu${l(3òD*$O7=왭r$h6F@d _}էoYYZ_PB2.BS)/m?.9'w?ӷJ#ۢ+.uYF1}[΃L&lXnbgw+iE_5݊lW/7My'Bئ*5c;ʮ/u1#oeyGMy$cMCW \J/B% ]cGj2nbEiċ=P~:($M]e԰q1Ζ%8RjJ=g~c9,M۽wMUiˢGy7nieq**2`e,'hIHAYF8,3aW*Rd:sJ@&w@ʶCJb r9SY9o>&gZpDz1UQoˮ/ծV4f$W?K5Cv_Ֆcˇ ?p9d ?0,r\J4r͍E&TԀL[J(h@#^@r䫯޽+G eF_3Yl|nOt4~[|_-D δW]ax iv̓BlW=T[e"_@ PNe,U1\pf*E#+P:wAn^NI,hV0w.2e`uF2C3*y@8hshVA9}s?#xs|l|3iLUu<^_=~~Vxy.w/OU8Cb]rI!23(NAa&%u wMߴI7> n9/(MƄxIgUr<;voˇ4um_v\lQV}jS_i8y~Sz8F{H N*fZ [J/Xgl  N*-ka%}NoHoAQX097>f9‘ _MVE-tG$1Ls0I&v "V_7ci!hr3ElqZO'Vj_X<'}т^v0$>)l~-OKG-Wȁl߁7 * U{ xl|(۪ic̹}'j u=[p ef{v#olW ܸ> bbl o?#9`? &'Ƶ:jQAHK~!R*ejނ@ϞeUp SOZmt,#o%oΆJ #GʂNoMcԩUHѹuT_7FJ>~p%T BZ%_;L( ƜY> stream xZKϯi!c`ldO d Kr[[2$y&>E'3IN%U"yGwy7>rgIy{:Dt#0rd?zʹI6rzB0wRelw>yS]?p!^틤{NP j\%V%_ ݥhY #HԺFZTfJo:t3QhpPpmxj;D,#R`2@Iɴ :4a]Ew,>M!e<(! $3|vH%(eմC<&96eḃLWKriYX¯1,aHXwy{ 6?SUqaC2m!&H3P5 #jD~BJqh#Lm,|;U'l]` h8%C}=KA|Y(7fr/v*8QtLk)\T4$lʓk^>A^7emcc]g# Ƌr;& w8lᓝܵkΎ@~$dMƗh]Km'A <KKpmlF@deF!#@cNzC0F=bpÎhS 8/ /ŵkU>ثȥ(J=)*nMb$ygIl)(&#Sb`+, X%Az hݭU FTe7.\ᮙH f2E-],6`'e@tafL2F8[MymRHp1:qMw7"zcl}I3TG9L`,ʻeV ֱ>ńBBd3,|E(6[.'YmS [\vFGQ)&*w̲W7e$K9{JK] Xa{1ʄ?6jKVAej.ibpbjfG'ԌF>Nq39ZE8hѩ#}1E%9ZG Ȉ;-m#i-8fG +_Ebl+" ,ϰAx!9K6Y;3t9(-Ϥ3r_\/?cG# 6zg* ۨ%tRppKY(CenThԜٜ[bv$dAՆ’ĺj;8GdKCގ=Ң=nײpԓeSĵ Ձ'e;HuNXծkRVpI9+JjX4K3(FƢH4S 0Ѻmmmu9KFP-pbBGl{fiZL֛|)n]tb$ ;TiC3ѯ%{ݍ%iԬ"-n$FʉYߑ"_T _Wfw6%Ti_&6[Q^YQH N,6ǪSGr>gnBD|eJ Ux74IĜ>7|{bFe2iKWVPgz(ٞ.ŒsTPKWgysx[ (s @t]o'KJ{/霁PΧ2"p "^XNػx0ݗD@65R't4n%8joKv(Gݙx(2KMDHP?1<%/$\jzZ|'p|r:v՜r5!!K3PkzӾwo[S].oLf+uۛTG@8Aw8p!jkܭq8hgpw; 2ux!WDU â~ |xߤ iE>xZLO?j WL;T$QSi#ܾ7#ip@ T R϶` rMC_ߞ~ї[)gY?0Ꮇ|Rg,)7!ވ%2vA6:܂H ˗8r>ؘ^<^Cea~(F$'DW#2~"w*P/ ]O Ϳ߿ endstream endobj 4488 0 obj << /Length 3070 /Filter /FlateDecode >> stream xZKs6WTy AzSۉ6N\*d 5ØCNHeo7H Rd64@_ mћ'/Ο6Q2+)m̪|}[\QfdNB}%=ayXM&,KSѼ͚̞ 扔ٔoR5&ٴyE=}Է+m6 Q#_P/BL6"d˜ỷ$2ݪaNÿs#(|-!Hd˔QvM&)·\\ Lm!fB:lhZ?[,˜JQ2ZJEɣfZ=9hHp ܹA{ww[#3m?G̼`*3hX&uCWʒއIUʾ%zbV1RvjF^g2dzYOX-7:4s7|նh2tb[%M6 Eݕ56iFk]v}[^,$O aBC 2We`*A[y񬉘̤2>πFM-e^ǽ+E>}~wꌥb?[,MJݾ;־mpc.&/# k`z,Hm"“AmoݣEʓ,@Q>`_6\E~\}L2noſ Y5[G-'4<9ͿjVX,IO2&Z!L7g%l[VEjyEc |\%o-9rt~4IW~.Ho+bW}G=A/P z_i@&D޶*a _y; :FrsC[g!q-2ZV``6^c [ ]up4RywZ3ǀ.e jT3ҌRw)ҜE _0غ)ѝc T%<mX.Vg$!,0;$۲a' Mo *l,9C4  Prm*(q'SED[6CmH?n J&BD:4z㏶!Q,MKy |&ưxM}n=HX*^Γ<0?䛂Ff Ol p@`@-H|š ]ATAB"sC 1Jae S"(IDʌT-X7p2*O9t0Tt}c H|T)˻,˭gU>-0Q8d@Y(; Ό=2\kop%s'*2DSvJ(U;db-^s|eB#:HO%>C `R(GH>)f!~F>~0ڇbSQػ"?Z'Y"e\+=&Jxϭw1'=Jݏ' ҜЪgW%u{*Ԏ4vlƟ-@'qxt)@Q?-p4G2~<`C,APo_%]kuMB"-4 iF0;LuAsvtn_4B .P{u1僚}qUOBs\V*lcV޹踃s2}4tO%-ZuU(KnbN%"{Ke8Kc䀑eU84tnJfk:@oDc>ˌSS<lb~\WT\+cOer Qx71sGױ\YVr|u#3S endstream endobj 4496 0 obj << /Length 1655 /Filter /FlateDecode >> stream xڵXY6~P5#:!mEE6ۧ$DltUv]o"@4$ÙoNmemzs¶Y>ȣuX7mË/M|7n0ACa/T2lp]Ͼ#>lR}]T9o.) Kk}F֫W;׶7q]L/*D7CE-21תaʄ憐 QkmAQ\? ۵ asS <Kl@7%=O\;1`/[5Q>դ;Ϣ& u:?J[wYvu KGBlj[jg,ϿjSmT=}wgAm᡾;bm%p#֭,,:PsrzTI+<[CR-r/]$( pJ \lw5Z[HIj{!1+SMW,ԕ{1ـ @Q\/@}ߠ 4gZji4}+cuUVGMsJEay ifsy%]c:(pI蝹z0 8INd8Cj*ο,jgO'#O&ҝI,S)d*3U|}=o V9wz9gIP§0b(4{Zbf`cH+nYs_9/Е6[lo`e|N=uycDG0O!E8tPb q1Sh1j|-7%y8{l6 N뜥qP1تEQt, p{6-JeYf1Mzײ#:PT!f]J"+Kjy>8.г\ Fj>V]h`Z P UR"+,K.G>QYY&ب i&jJZV a"oTwykd+)82lɀO B[( 3mi`}?XMfBBh eSN}DC k#}zǾ_I2MEXH&c!lAgl]a%arqN縛I|*9ILPiPShALe:ٺ2A3VJܙVmL >T5xr#cwY@Q#%v w:~ttEnpk$ 5\ &i? ?A endstream endobj 4506 0 obj << /Length 2611 /Filter /FlateDecode >> stream xڝYK Kԕm-EiW;a3%IU8- m݌}ԣGqA$HG/o}CVe=!b"I\UzHtۿLcOz{ip[J-TYQjtEW ;d;Af":u=5C {i/H7qpus({f;:SW25c! ((Y8_W:a}RFٴU)&2bm3-"xz*mRK55r}lD]{ѽ=uNA/!z^{TQkYs|h#sKQ'Yuᰊ4vk\Yt/E٘AyBv9Ót+ @S* ni;DlYfK%2jCu'aUu9Swgy,[<: Y{9`/ !$7X,CnQV F[D,J r>PQ"kGj◬[@k6^} :c=Zuw>T]m l&ll+8Lya;jш$5dM8e5n5C'^=8_yC!G34wLo4W/N̖V=  (w,yRq1JSH P$cg۲6 9i,O5 ՜h}$Fss80 n;Sw6/sl+:G=s-e#b\+klX=(1HʷO=69`) '3:7YckcmDfIcHoit}ppEʝd1 n"65iS߁@q@j3_\z#*ަ)Fcbzpk}3}:Xe W_­RĢbx9` u1q "y=bYb01fUS5S)SL)7fumi)jX\=> < |L&? + EH+<Hp M~[S@ưv5}]/2\^%0%_2|'(vP%r`1N+DlJ -&}؅ޤ;+`b"Co~1K`SAUb7?|[VW1j'cp[~ztlr7 JWh_~S`|iVeoa`h2HYL4[#L9n*9Ϯ±AV@2Hhܫ}˥eC@8\Ss&Atk㧵[IB`"%]+9XsMU$ĉ1>oml'ӸӬvX)( b @LH߷H)'=J)pIʐB.K!"IA/< OŠdb8 lD*{wm;ħS*f=/,adĐSOHee,b3<Ђ_.RgU1EY w #J3saGz'~v2PǍfzyՖy$95GS3zGʄhڌh3(8 S}:%XSnɼ}Pv_v% T MLڲJ!i%->)oiTMt$ endstream endobj 4520 0 obj << /Length 2150 /Filter /FlateDecode >> stream xXmo6]J)m[E+˴]YR7!Q^Z80ᐜ3CzgxOI4Yf5 8g"JfiD䳛k#aUpSy< 12/0a l"N<^WK.$Em}7on6Eas?w*YRѡ}K'y[!ؼ%zl]z \k({wpv-ui+k;, ]~B1E"-hQn/, dY)b]$2?qp$ݯ]UR9I][ ֦1`9Cḱ??72 IB^aEm#`t]{ p cIF>5j=wk_n,7ݢeKqK2!Ɇoﷲ+*>./kw$KZv atN=;0csY6#%F5̓̓u)0ˏ-B"Y7ͷr?3@焜ǰJQ8 ķ{ͤV:PVUM/ 96  hԝS@49m'.34ή_T$ Bž?Kl9S ,iU'rS$Xtp q2Gn0&GsKQ%M@9F q(+g>L|w CؖM a,ut,'@ePYp (lW8@-,"KԐ 25q؀bГل,&h =J(S>@$,?[baNj {uKuS! ? i<~k!֢(whgSXY893$a9-Q*r>%j" jZ?PݠuqЂ=b}]ϚWtIUwa7 b5P#SC/\wtRGCmD8tBOYwE!K,n\cxXrj!>6Hqf* 0ۡQa` :eA2V*7J2] @ɡgTeD7e}iNEDgf¥b>C)i\Q _`>Ua9Yf3۽h$QuDqY6r^D:ؓe,pqo2u e+NzGS6aeKo]_te̊}rՓg#E`i\FFf2rR٭,t󓫫S{:vjRsKa:?(׮AIB0aT //0N6z'2gr`@Fi_V)v:ɡb7֬+UUxԺ 2e\ <`Ur-yҲi'Fgm=?v5_ϰk[t&w-uj`tc.F5w-{z9*s/@f'H ^޼(6B endstream endobj 4422 0 obj << /Type /ObjStm /N 100 /First 981 /Length 1527 /Filter /FlateDecode >> stream xYQo7 ~0$4 l@t"nzͲv8h_rvvM;yGLIoBN*ÉUHFBg#"*q;qV?ɬMa$3px D]9R@vȐr] tuty:CX%VoEHbE`CGRlX5`#eՈImDY5%bKRMpj0$QQL q&W5 p#6ᦨ e`2A lT5`SՀ U6Dl$ՆhJjrT \TBU6JV'9 Rِ5ITnBB.bKDI1`awXj@.W sΫK$XmJPȼH $*N/HL,ȴ-2!^d\j vG5/~L2B`ꢇԻ ka@*if9(X"h Y9 qJ. !8!:CMHǠeԠƛQ"ŏFͻ[N&90?^N5Cỳm= e<hRRA&&iNM4o7'&xnߨ¼|9¿=M`5>Cܙ~]Vbx{[lBr I}Jnih|U |Fl~#dCY^pܣOLCZOC'AakvB҉jxVB(VΈ|QLA%{x:м sU}dw!To"̲]GLYNok7ᰀA#s@9!Ű .f9<8tҜ6?տo~ϯok/_|i:z6Vtv=mzYa+9u1 EGo]ۗtu)bڙ_EU*/.,ڒGp?'Ab oAUӨ:-'zzюЧ$ζ}q!*I$gNr=sޕzC;a`~Y?(d$6vrǓ(p =KPGёdwN&핺!藌 ~щvhJIe^L~YL~YLB\ d)19a;昒8 endstream endobj 4538 0 obj << /Length 1724 /Filter /FlateDecode >> stream xڝXmo6_!b#% ͰdhaXvcdV+Y$IɒxI{x?f.gWA$L8ԡG/R"x,W·9biJ\d[Frί8w";a3;_|pϛ7e,vMOޖwvBV튯{lWQA,\s]UdA5Pe4n*d֌i+V0HXUkkתVȏ^}^]nMxqyӁlFCM)X%j5܊2ڙ +W?7ـZN21s':\ξ(o2x$'Y$Bx9p|Ν]!=§NQ`(#qD[Yog۵eeg  gg4 }N(bID h@"*ir-,/R`R?CE;Y}.ҶԝF]],]A}s/q/2y8GYiPTE1m;ArtȐ~A^;rNrBki}-FnךI<7jdg5' m`˟jaN s=WĶClz -U,m?޼\gIk[kHSILuU5\1TjVh iUW &\Άsn;!JٕG"Z;m CDg1eXʞ"&!{TL:tWؼ+k V}gy^@/J6ͭC\`Nq8:)\?pJw?C&.<{夬?MD >]N1(4_Sx2 K}9;`)TV_jը 6( s;t֭He^`8<ZQ162sԷyq'^݉1^D<;i\~XK #Ƕ'Od@n}j$Tコ!UtWD=*Spߋ1V #=̣ɮjo_xp?Df!¤Sc :*M-;|5~Q[,PN{̮pͱغ)#Ƿ}n!Gj7وGlHя ?"S2ʖMWezFy\N\T, endstream endobj 4552 0 obj << /Length 1335 /Filter /FlateDecode >> stream xڭn6C%4b~!&&ٽA($zIΈ8ba!3yP֊iqy9JHBT1 ؎I<;T勺,־=yyb;#mZuˇM[\zT-PϮ+HT Ts#l_ ^ Iy(817X! ~6@k I,ߕ4 ҭ0P"9]ergF> B5ma T0O0F9Oh&wovXQq֖:ʇ 2=b۞C+&QCbh'Ȭ9"(lK)^Zfa^f@3@g E`ZqWK^$7jnQŢ"ڂFi 7]F=Өn+<{x8Bٲ)y-`]K,fxof' Mu[uXAVO!x%QhUŘִĺAlW1x Jdô% #ie<>~~{߲L-OS mA1K*8PKP\LhQu BCY-H( ~TD,3iȏI.hA\qH> }(FƗc˛]jǮ Xsk^k5&5G.8z-ʎ89*ˊfi6'"glyv}OF/n/̮˛͔7CIDaבwpȔ_on:Oy&xbqCo:4Q/ݲH 5 M8!^4USfg4MU6Gk+R58t@^.O>{:[Т3M^1mbY8y6 ̌'ݾbe_%.m"ۍjƣ3w:َ~#1a%^灎e*= (M060T‟4#9LYј4{ȭ?^=[u 7l2}A7 endstream endobj 4563 0 obj << /Length 1788 /Filter /FlateDecode >> stream xYێ6}߯[@cd mQ$@eȒ@Ql3RJb ҦX`Mr3gC]V꧛nd:iĢ~幮*<'n~?Gꧮ3)<+sTq0tloL ѧn/ŭ݉WudR'"I~L'v`xkZP]?Q]9)٩)`p"rRS#Qp]o[.haZ=fW[F`A亓y}3Ƌ]+1 ]ٛkxRk|pC;Fv'h.ߊƠQw[YUV]]M#j*kZ y,, dYhȣ FV=`IЙpZFN'0ּo6u)bp9eTW]7Gh]odNKR6B%!M #.R#6zؙ}Ϡk؁( P413Ä냏8qoȊn86}]lTB+M]٢#c;AD#D@ ʸ8 Ngnʬ԰Na$4;>.$! Y)ӥhT0ɿxjb;Rd-gu@g<^^MC^ŋ(^@Mq"2#T):ȡ*H(8,"yhbXoPms͢C9,P¡Gwb dP3_e~%$Ijjdb4XT4(A;x5=@^vơ0u >X!6A ɕQTTjaxEVB3C go+%[Zμ8u"~GawM]5[>b1b.pY2 LG,e;rc_ܶ:|3slYUjSIftXH2Cޭ~ՇMH,V T6$! FNWJLMeըmg'™UsVn8.ڳ9Ҩ*ݟ3;&t֕vβqlzxY=((i3☃% Y;Qo3̂\|ưa Fԟ'hxsY:!,V/gNz}W:d2>Mjr\.VHOɔ$X7Y1;,J6^;)O]'ACbWQWJS+PՒdI⁔#3L1s_G8_"¤:ajKP z' KQ-_e' j칝4jk< ̭cĀps~'u_у$Q<Ž\q'3QDn endstream endobj 4570 0 obj << /Length 3120 /Filter /FlateDecode >> stream xڭZ[ۺ~ϯ[l VD>%HOO .ڇmzF\]΍U)P93ߌ7tق8DZuIwNji u1:Cu /t}+d%Vħ3<mCs3D P"ɰݞazڋ#\|޲0qOOL7hu2`.ӡצy+*k+BID1IĚ"L:U0s 7N쭝f+#y9/w| O` Yɀ!g8$!,uKo=s}@29nAͶkލ״ϛK_2 @9+%qyFq̧#k}ТX('} |@nT,H %QFBأr ^3:a!SPG eKx"*ʼ4ڦU׳M&xL;WYu԰n2+?L$e @|vp N@1vP5u#\>O!_[* ,  O,0,žRH-ne\ԤW' dT43h|g_]G+GFVS0<RuZ-06QQmnQ`7BrL/TD&x3B|Oޕ8p2 ^JDA< pmN9|ԅMEaa/zt{aw+Lp. ڥ"Q zQD ᫇{s­Gz|#cАW/&V@y ~* ]~ť%Axa$HbVD|'^!{S-)z1?9iS =!ʞ㥬0WSmd?3FZ '> w@7qhJP1xxw|C)+ÃL~ #\(5RVY^X(y\/ݦ !.0/ʄ\(q&.`1Vʃ,ӓb sQ 3Ą Em`>QסB/[QPJuG3zZo?EUxTy}q,;KR޸<*WaAug_wTĵ1Ug 3I .0+SB|V 9$5ș|'-:$J_H/l2ʘdq ?só_xP]m}FCQ1`ĔUbl+U+r.Zb~w>`%9bet+Z^?aA,}AZ̀\ͤ$ f:Y,w vf]$H94K1n7!/)" B57CH;c/A\G)~7S AqA|! a .Q/iVA/>J0 8@7A9Y-2Y^%O ޏ endstream endobj 4577 0 obj << /Length 3205 /Filter /FlateDecode >> stream xڕZY~_1on^0`0E$קnvl`0lVWW_u|Uz:=|8{ʃq3}bG[5CDŽVg]|yYl[Sk[{8]bU6Fu`2 4C&v_>p/\o> jnh}2raihS$5aRweu|rDViEkѷo*X\mgĩB{niZi`bjۏ,ش0ۜXWQ36bỈXy֝Bƙ%S&ל,^{s9N! lؔȑn.E{%h!|]ХX ('a<Ҁ tN,j~3g6'51;uz8NȰg։?*LBϾVz7;-$N8%č;Xw i-#DXAx^8b[1 G1{b++1 t#BA\ U"<IF4 7L\v瞡/$q1q7 /7To`+]5?Ǎ-ai1ƳW5ͨ՝M s4(`yЇ&-nMwͶEtv`'; dZ6;#!$I7&<f;g1UU9XhS`V1Ջ|\Y :Z'̌ Xhbup&TWr1ȱf{,Pi܆w2ȳ<@upԁ̝Nm3ܘrM7 bdp!Lв!*nMUh>68V3=\Guց)4ڢG-NhQH/ pF@ܕn!NtD_ iCyZ9Ƨo~5Fp 2l.kEJDKb23?Ba#h'tџqU mňwk/TTLKBƠ޸ h-AC]rCfKw.Z{&Gh,od(폜yY9Ipuz޵6HY6+cXbL|9p=\O隤4⩠葠hYC5sU0[p3^8 |oI\a@m20sE A 匝bzT*~#\AIGq  [l5{ 73+J7QU1wT qR k_@t -q}GMGwqjFnfcH*jO4 1믇޶|0C-rpࣽCkWBy#'ou,;$Nw҈$])/.Dc fZxCC9V%vAGn[yek>̙j4(®ǡ.N>+]Hh +&!ŧ:]F.EMex>勬+ЧA :ڶ%:|ujw:3XQ7Rc-j n]}׀e|~YHY~U2LM&N3w_uVZmCȐ o6]J+c4%䣒(B =bɅCpӿ;n Z3ee( ZH[j#PAwʃ8u7B"ѻ7k`>4FE[h ( 9p0ȅWRCBY혮v}uow%;5D,9o'i\Iu"BЅ5wd9̔$a_yB.>Hg;딏[B7NjG.7ߞ# 2Ve|=,wnux&%yyP̴fᅿ endstream endobj 4584 0 obj << /Length 2617 /Filter /FlateDecode >> stream xڭZKБS5 $&Jƹ9p(HW">fL\Ir~L`lz=ap'zi˹Z8=`">p'ODXꍆ=MjL_YR@pkMZԹGӺ6'+bйF6yS\z}Eד$07ncA .A6nKGѻ^p24fLN1;?j OE Z;4!P9s L ?׫z,AK$.;.i \zU9gXͣqϱvBLص.@-`pGiEXhVЃP I$ T紘ha5#sMR}j8 g"!/dTX,lbNWp\Is2Fgc٣CߔMۚǭJf:Zt;|%08aX)2cWP*R|L4zi eʽx6}>|;jGx| o/8a4z"ah,WU@?Gk&mtBy3GA#UF۳.~cAq7UY6t;QT͕ q'ߖbhH;S(tlQ'HXLK많"4:KvCղzb)PbCb@'4Y5BkhҒ@u#MoZ-4%"[Zh PROܛK-8)Z.uaGWDꔚ%yRYQ<-FUAFx8Ԇ6<]O#$ř!EOl~]TAIB4Kc]V:eT/V>[]?*0:~YKľk'#.PSM]0 U\wd([HI n0Vke#$fPJh~ѥhN qE'R,%eSu5en 6 v&(q96TֱLfƦL铡Q=mdIoFM WCN.knQ!$vStt!@4VO z%KKF)(r5:B ]Hdkh; mqR!J&7&\O^ '[co5Kd\@^ur^8Ev K9Lzꗐs)~bIm*F-f\l{tHgixy6Ͼ8U{ |ơ&7 4 n9#u =cR˚Z։cPE#'(U-7CJ "ˇc8G_DaqTC>ƧFxUuިPA9sP#8 ^~ @A:OXwI'[=?~ 9,YCd@{nEٳ| Wҧ>/t>X1|V]1P d=#=l5OcJ?HnQ@LE?F)Ia, 7c/M~4'b.޷P{@*[ ]ǔ~nE-@J=WaJ:!%dgwM#;i&S{dSjjnu)[ }^0V )|_eTeTXU*a$ `SI#cn ; eV[wlyT G/q\Zp{b:4a)OΓ+R[n.ͩy/kҫVި󌉩lhɬhv{EOcs,R=7[0b,Utuo6p;t' ]u\a՝ɸqUtMBLx0`W 20u߸q}_1Sv csu"! \QAXA!Z>q`3 zWeSE`6/,(D710KN5MSVx tկyX*Fhǧ}4u%O#trO#>dAS%лcožLAR﶐PT1/l Gº~> endstream endobj 4595 0 obj << /Length 1883 /Filter /FlateDecode >> stream xڵXm6 _`,ao~hAWl_?R;u{]},Q|HnV|ӣ]>MUT*EqQV(7׿\>MhTp m)qTg߰LF7mld̰| Ƴf<-> *i$-J3t3q鏪_s.TEkQٺŇ5I`;rWM,#nI %yeE](͙ pIȊ$!^R"J@%, >y}_j|t4Jݒ4ʌjK):LfS MW6㙵q-v[*mkl;niM6T5a")!GmD)'T7zAWu ]x,3FX]]?ɂϓeY:\.ZqP!ƬC45dM;=YjSFq VJV0C[aԧcAdWOvhTu{JP޽N]r=@mIס 1Ԑ襤 Z5a/sHvʼnS/)FcN$G$9\Cj&"dzb$O7:} ,g n&^Y_ l?QF(La΍3tnk C1ELy:ޤ)bL,0&̞28#Xın1!qUtR¡t)%*Yt%X$m4Sx܃_g(fvEP[Þu4#~NSr@7@"=@{Z8e$P?Uinx8Q{c˻;57褓Xaȭ)31R.!sLK c:(v)ä,8fWJE3gA, HM6?ASQT j݌8~"(;m}R{$;x>٧Wd>k.L@+" #°C #!@;cù~xpUPtXW܍9煺 %YybTCC48өĵ 8*7<]B)YoEʦYV Rk Mf|3Jwzԟ8eP smx(f4gdāQLXWPLi3T_|a$4O+#?(!qWx潛R}]]\zu;A?@|G`$|:ob~n]y4>iA]"p ggQ- ۿˣU{y[{[@xF90 endstream endobj 4604 0 obj << /Length 1005 /Filter /FlateDecode >> stream xWKo6WNcQZ)Z,psI}%:"".)9ER/YvĢǙo'6~usswFb%ض9zɍw ϻ  {IhEI:1Ѝ{4Xŝڍ`ӓnoo߯~P~}:`.t$pI^d t$ `xV(R|v7#1NV,Mf VSmO1'𡾲ZۊԖm%\J҈3(mkmzpu8̅ H% (cD ܨPރۺEgY."kX]Я \hk^g׶.,S[.cb "]=J~%jJ% c0fb3Q.XK AdDNiҕR$?"뽣U sY#YK0\?-'R?%雡˓b332OwKHY/I w2+90- 2c%{FUP )(/U>kU)ˬR̲'+P1(ෆY37ܖ\ fϚ֨p^^HSRYgNIȥmՇ^+CmCS&҇U9H\5.UpAI.W7kp|'jPTF"Cf`ϸ0fߔzj*~1uvl.٬>۷y#53ǦJDP$IuUqJKe `0E5 g0jSL6@뼷ZH8ez~IJLfcO 1ۡrAZ0/H :_S] Z\^ MF+<ڎ[ ]ź c;g|ċq'?oE endstream endobj 4609 0 obj << /Length 1349 /Filter /FlateDecode >> stream xڭXKo6W"J-աlQPAu)XYDʎ/(KCj8p^7Nɧngd.|NA8,pr򴙬0<K]>$ viA08??—5GT/V,6z; *DKb>03odNWdN|QVo0 8)lI!{T )(=wP)oo  Xƕv\CIap4$8JI"*r`,mS-F0[: U1YF*Yq3hXv=z Kz`"uR|n ;B4Kķ9hGSf\s ^sZIaXH"W$$@S[\g,^ex;\l5L@~<7 JSd4Qe%h&ܗ%j-9 ⰊRQ`y@DH0pAp5~1Jj)RR{v ~f&5̝Vn5i" >V }v±'H~g" 奀Mu?,},Tl<+zA 4D.D?wdrgXO-/ApT2hԊeB0ϻsQp@YQb'uΎZ<ٽBIL|VkC" ;BTYam}6珝8RL@E"0m„+ uQܘk]{5nK٠|IcvqgGvI30jٙ9Ći(;v jG<`R*Tv)9iQoӐFQky6[` eQH9ʩ2_Ŧ+yNЕtE|qoj >:ƑY$$ֱZ"~1+đ¥ZM rԒb9#_z ?}۾ۏ2]?+M ן:W_Kv1Wd÷2t ^: &p^ VMmCQ)RWY~5 ,3` Ҽ?|_n>$ endstream endobj 4619 0 obj << /Length 1768 /Filter /FlateDecode >> stream xڵXo6~_!d!EJmX6 l֬{h;@i[%a'wGRd+Sl~Eɻ;:K:o&/o&Wׁp"^,F)"pBH#f|pI1eK,~y{u:$"UG ]]sH@zCg^,?_LL(@Yx"rlu[Ӣ#Ppw:+>0$ <0oۂ#e$k{}Wx~s2- gBf ~*#P,t'牚n־ɟLvݢ -2]P R~VI]=,Z`5~8~GSa~L7uZhbI<">efu'z̭̓ T0AƉ-Zb% 8D|26+SF( ƷEzEpc$ OIH6$.-#y "ә}yY擀yC?"n%S^)38miX#Ss3 k7LY)s5'֨~Ѓ jǁ0ƃ@Zyf^s3^S[g#>$xr &3Q0GSCFU /靚_)BӠ(1 MrOlc9AǹnEPh&L8*?}(BN- ۑbdA#xVҌ`F%Nb!o'ahN߁gvEFs`nı.JܲN '쀢(*e r9cwq[Y?c2 E4f4Ke%a㻿gq;3zRňE}{K $;RNM`^H@6NxG)Z}@"hZT࠾ @̴p <`]q H0OJ|sGʅ܈L.ܪC9 .wMJYC GӞP.sA(7Y20]jjQ#PQ Q/dG|>Vq0BUu UsSؐhr$8M֣eiBٕX\^Rv5BV!547O6 ?0̊ZW:AgJy!BV S`Pf{W|;^$ $~yQ\w6Xޗ٬dODʃ&#CW R@J=}~@ax?+ |c0h-3W+kݠ;"kywp> stream xڽZQo9~a5(!@w- i>gf؁l{>*n시N 4 gHHJLLD4AD`")!oS&c`r%\Շ!UX /PrX];CJ%LNVNbCRITUUT 6U # XC@Pށ3'˘J.C UI#U >ө`Kj`5b))b1s}W`$տ2:s|ʗ!A6+052/:6j KfYK_وTĈ]U]#!Id,)Ab!5;%%#I.aWb>cd)YgrR V |Xur2U3ilF[b E W,IW^{su}|iXwqw~~yä;gk{oե%ۤ1 xEx0+ܞ]]^N_~xp)ZĵWeaݯb7q.[/ Đ#@DP"|Ζ9pc+_|D;xvH`= 1VⴿfKlgNLy*HVg~}q~/wr#LmDq:mKHBm*lq^5U j@`MHrrxuM=0צ{Yz^O:{{ڟM/Fui<#.P؂ãP쇢˩،t'E#J`>L6"hʔ6\w#V Cn!Ҭe-!x/@naZį%dmhCL -ShI~04q -˘y[qZH+XW-^V-\~QB"~sWz1"lRF@Ƚ$,ڹ62.~"A+kkm֚͗G-Mu!}y$&]IYȷr*aX;hG/<(]l'uØS2=cO4iT%;lHФy?]Hvq9g[%;"8m,|KU{ytTW^yɯjs?],?tW'__^|lMl-e>7|l٘B27**jfI_'6=F czFh|<"J*rD19.W3{r:]}~zP3 .$]܄ ҞǃǏ<IϦ}h(*fG5rjῤ-=lZ:[:dn;VzK-xo3gIY3<y8#+CN(CgX¸f:9A{ ?57<_%0x9TVb)M=)5$t)$~^bK#D'Z(5{گfӋWBhW٣K zZHk;2&7+xm2?wq'Cnv:wTIsQ>v36A1;:tF8mdWv(+ߠl>TC1;*d6le33:J|$Pvbc~nTB%E8Z玀s"b'7t:GJ?!v endstream endobj 4630 0 obj << /Length 1602 /Filter /FlateDecode >> stream xڭXIs6WΡԄ pT;iB}o& -[^x;kw~|7R'CYLbn`GA; (2p>1|:A" $&q䲜TTHoxdpʳ#E ^%IVLPִ|@uӍbVMw4B ȆB6LS 9ܦoYC@ Yi[A%5|Y{΃e$A~P u,Ŗ 'Ȕ D/]j!qfOǫiWG8꟮C;? <= 80-fT|Qr7ҀF"P[QtG Q|'9ٟ|)6$CFlhN>8ExѺs8)Ѻx9K +ߔ,W} $\Gm}"V :oyK[i%8@1.&ef >F{BFF&`i'KS`8O%z@mD6 R <&wyfE e֓w_ BWT>ִ-U[n, #LR* (<=N!Th׷lqqssqi6Y-aUY|:|.t?he賒9f89aōH`V+ jeWzj5e @}`4[ kqN"ղn鑛G1 =k,-?d8x#x@`;JZK- $g:QJCGpNZtC@ ym\%,;+v)}5}]HrCY\&Y<y!;ZukN zni:Iff_gXe!/P@g)#0EA:rBI( ҹd@U ;$,?4ic7YF*Iɰx*V; [a1\k ޖji40r@CwDA206=[UqdvxDHsM60/DZmX4405X$4Lϭ=Qj(u~kx /d2[C4-pr;ЍAl$~<3!]/~=EUE>B뾒Ч}8U%1xƾ({Pi#S{JVqI6УVDIA7sA(ce9_=P&Lo ] X\3RtZK4, C ƐPݻMCVh_h#q!~e]*~Om*>:%GXw^;BBm`N.S09A^$8|%o4}Y|oٶ933<5R^tO®5fBX /zJ54W!VL'3Ba]+ tyJ% .6G ;m`;h2AP] endstream endobj 4644 0 obj << /Length 1522 /Filter /FlateDecode >> stream xWo6_!b1}Mņ5Ni[,9w,يeHxH,nωQ.1b^t|= [?j8@a"-ļP aKz\ilz'*f}1Ruɥg[!<͍v1 _NBƘfתŒPDi˔m|ʌr[{9l{6뻴Z7؀J(q!(APyL\>ޭD):sQr%ϸEnd|cT)#R Qc/$0"v/'O7}j=Kc#{ NcZ۵0) EŞg҂F()rHL4j)rY;_\%FGRzR4mJ4^? f~(˳!G3";LeCk AjVRl2(ԁ GY;HF("ܘjlQ۶uܵ jUܤJ9/7҅ȗƌ7lDf| p˘"wO_a# cR Og}Ԫ6nCw ԜvB63_o2OkPZh!NO"2y\*Iw75j ~|MG;NwbUg% :k۱uBN%8^- &n$Mk/$rB]W3_ U17c .=a&)"EI'U;VO/뇦%RtF<vv;ۄq_p#"]@a멀UP[qխ=+  mLc~:/c}u*^19xH~~ ݩԥE>t⏄nzQ}d&1 Z KeeFp/E0=Y ȍHW3vMTFC ս:Iuu5ƾbi50Y?hap Ad \9 "W6 gVsd kf{17 />o^u(q;tBXT) _#P*q endstream endobj 4657 0 obj << /Length 2801 /Filter /FlateDecode >> stream xZo_YH=4i| mќJ\HZ;_rHQZ60`QUz(]e,Eٯx0ƫsluS>en>|:!LI']D>^KTe[@4a,*Y S{7Tmכ|}ZCۙvoUSVEDPW`ZAu <;UTGE^+,Z߈ DQf6p-1"s>CUL37[ը.t#Pjc:;:SMwDhwAl ݹz\?K]:nKW48{(V{JB2`[fp&t l2jH<{'z:=zU)lʳSS=u4uP>l6}giġ1fِj|#۪6F^CAЌ2 P&[eJ[ޚ3{XR6s- M_Je4T0)X moͬ", )5ME:"4 )H)x MX(#oO{ʫW/{2XT}u|TE&TERN'U=C_S#W'p%T9F&}ġ0nө7ot4&=@Z$Ƽ^%s pʪp&Hy@<7&~ l F~h2Ma3* $^8xOHjkNspזUu5<~?3?ľWn]`I1h=<{\ŗ/ Cջ:˜<9r>zh.bUuOC~ӴoPkt:Wuػx:gSU go}X:L "g/߀K(]:2,|TvP{5ݩMw#Dlk99're͌(Lo9-^`N\S?`) :2tR*aԩ8%WAubO~9").s)o$ IHMO;q2 J$z ?p@QFlgl$,RkrDt1vCʤK$6o2cl,x *!SojH>t:5: 4C5K Mm]C3 ©!d|%e(O& G& GZ!lADíLL_/7a& @U~`Ce}_?^M&>@; TY;Mu5B/x38pO5 endstream endobj 4664 0 obj << /Length 3062 /Filter /FlateDecode >> stream xڝYYܸ~觬ֈ(؇!`jO~}ꢤhvMEXWT{o~]r?Otpީ 8i4w?Oyχ%ق5S_9"(ΑM 0[/f"$vP1b!]?Iaw h 6Cۍ$X*oXnV,kj<ٞ t#Hq5m6G+y'VM[aneZ Fe<3剴 nm{x7dꒄi.-;X\ŷM!0LU14S~3p 2"jfX_D$`^F`Kٞ"eށF9]zqAL˔"wS7yɓTFn TôGU_:ҜPˣ| Ff([Q6 4,ti1u@ o3ۍOy8qJ` ha:H\L:F`PWc1^eX[Ol32UYL,Tt@m)*BKr?˒k.mtmn:?KIv 4^ h6&vNL=Zڵ.BaHv`*9P w萏c8ІJWלfrǑv%&5O{ -xixhA,!0;bx-ߝExm#:8=S&hzJd[8eZ*.nyl | |t9Nzs Ч`p/`#LjyИr9tk Xq|>O+Pjy/E܌Y !%*K!c6SA\ X,%n#c=q{|K5c}\NVĊ|!peval WMշL꯶(1#(/Jx6 41ZdjQ* S>Mqr7D  i#ɑ 2٤JU UxG{xem2X&HQMJp0R$F#WUd}NaPce,O\g`ԻsMuv 3 )O%B-&Mh13D78ta]̚y=X1YI5@;[1@ڢU箭ypDb" 0 Ǟdx]ʗOLX1 nX9G0V842}Qa'Tܲp5Tnj 5"9Vp)B8Xiq!4gۑ=&ahUػv-"0DJ*qH+Fc Qp_X&e}ܜ <cmPjKQWQ2ri%< Ag ip@O_LlH"W{O;w0L+aݫ^3qEz֐>E{:YUU-癟OP.(ICǾVSJuqO>=Е+j~9:uA.q)i_" Pɕ:ePqCIBhNG/ z~HirʐGT^ԠUY{TqbZnfպl>7|Yq')c/}~F=JKe^ ̣$O;MQ0JێQVX3omHe$q4\Pd& 2|ZlNmM*$l sKX7"h_Y@9r^dӽgvW$Ex\iK32^/9 TNr?K'꩔ӊ*p*PTUrHJ`-~P!X4%QWb/PHŏˡ+ 8KZVܧfsď:U6 w됵&i?> 5\l>'p'&糑o|lB~spI^LYc,&vΝxsHmH9B_a)4djJtq> stream xڵɎ_aedIrH!&L*k"K(uu}#r@H>.o^v}1v9잞w< ]9Kd{v2~$m`kp~MB{Lc RXtNu?HIAi|ދ8= \CA8,{U uby`Nøzҵo_x*Ћb/p/gC OZӮ=m4x6+J<SAda-86JR+\fhͭTyAᙳ٢ {i-kYJK׼ݹ.X^_UbhlZnĊ!B.&Xw>2(Oc1  Qfu!JF=(Tjje^84$8 Od6xj.{t)g cȜcv-4\H&3< ^F }X<2Xr(fucc~\9YLgrRybU vZFC)gA#= k^P/)X&HG> ?;޺޽[^' 5Ƌ =Mە7fQ;Mܸ"y(mPfng9s)N[ VEת֍ U?J'.Õ%}J)τ3O6ӏ͔yW1w΄Ee%QSѧJ_,u-#Hg*K%U6 \+|v쌊&r#TBeŪ.2g"-vIFN?aM܆6nG.ᚓzgb&LɏikM@Ǧ=yS0q,XZT.-ҞH[2hU'oZgYܕ"L <%*VJP˱C'`=Ι+'HiXnabO`ݖ/p]B=Q)ʽ-pzn_Xfs5fL`Fub, T+a@䶯_jEo_<7^2%&>2Qb7@zUAQ\? kWr y% A 'öb]nnftƾj{KRVdZi|j d )*Vij|,Et2O F8@Dt3d` u&ӱcQ*LWpꪩ2RX5coȧVe*Ui zT4Dј(M;Z c@\a3M8InHj2V)Řfuktb0u z4 'a*k{qڼ?SNåAF?۽A&j+QfĹ>(zb(Q]Tr@T\6Y0$ Ȅ$ ęyF}!bi!H2{'|C b0X#O- JM5jsD(}Qe! dz @`nAlW,r~eC?m;UW܉SotYy2ל@ȡiϼ=r\ '!֍螫5z6PT@P" xhtGK0xd?zZ 4^"~v5W&-|WÜ;NoڞVJӇb@ endstream endobj 4688 0 obj << /Length 2720 /Filter /FlateDecode >> stream xڝY6h;iWn&5͵84Ak6zDy͇oCɖu7K͐'I8yهG󗱚d,E<0dRœsla9=5>#R,2`dđQyOf2IL$HYju3PFSv[ME| Ci5T"UGh,`[GKLu0l~*n:_lk^xR\kuQJipǂSxR J`Ėq-4}E+F*n07賢x,d C3R[@^޹VjњtFW#+"CŅc>ΈA\x0di&ƼDB2oL~½4˦د+:[S>0!H m ud UO.u 9: bQ'JAzlOK.F/n|;Mkծv`|R)"æyS%0"=Sߵ9T~r 8%.MSX:ziC :K櫺"~Ybxt|ǟڴ>=8ֆSj B$Х^itjy KnGO ~FB-0Zt#] PM"$1a P=b%*I ;K#usRw  ]@n{9\- BX&\*Bb B݁P)q:KD8\=`FsΓ$ʐN.2uX-2gHh,Eæ{ŀOwɩi4r] 7؋N5 RE9̠T 9dtNqzjK]g12K7R|d64JA1[VoR.YBxf3(b3wziqhW8X1>9H|e E"$@9? bnM rgvu  Iay]-w $Vvm*qƿ%g<F& GPi:ctEUϩںfN2~?\fWCqi,'km(cfmÔs?47TG˭2:֕ ^Dt0% 3"#>U8x{R:$ER[Mf M~WҎ'4FJp[G?ScKƣX^c0u2%]i(l=zIzkԔ9Uܛ]:?l'XYeyv VN3!o{j +,o(p9~px`/òƸqN̍4b*[I_m P'?M]Z9)OEݞS[R@zzp!_RNY|V[ۜ$jX~ɎqFGj]o(~)3#B $/嶸 G ce,?~*hH,쭚޳Z릝{tVò ۼ`!,X#~Jhc!G RڇH4…KHRxj~^Bp ì?/- ] qDW+Y^ ZqI]Qo<]{$(;aIPw v3#GM5H8= 4zyke?2_ўȏ{]UjymQ#SG ݚ*rYU;W~ÏXB|zm77Es,^|x03 endstream endobj 4696 0 obj << /Length 1271 /Filter /FlateDecode >> stream xڵWKs6Wp ;S]ڝN=$9@$H|H۳ )[vH ezqsFBx:1e! c١OK{>۶AuNRwٶ0i;Nf6m͕Zoe+?x'Ā[(t*;|\f͵$lxZK&TX 8t[BG,fQ<)S;ZsZDLxde! ڲnkxvkfVU]h{5S쬷Jf[ TY;!Zvc`^,כ%'`MYU,#:IymNZZĴ7 =+m\ym?2V+ XޥٞG nCr|"E}"A\9!&IZa*VŴ+pabTL2*#0 ::TyU}/% 74֙=Xg8d hl_*k(_U-`ZE|bXt&JC•JfR0 @L'zYg\ ;h#s@83c;-Uֺ' rFS?WTDjs@Ў4Xmʀ'8 VC -hq/&A BRLsbK0cBqզmW;猢ivR'7m}hʊ: Kboڳ==;r9auQUk{5Le]63ߌzR :S'~ rZC]/Y` < `#XF b47}G&3>,~6pfsNۛ0:?yՉI\򯫐\J1rG"(rov|"%?a|Kgh5z<<;}_'+"+e΋hp+>'`rv/Y1rӰZr%+_u[ =+׻q'+Dټ5+lYm%8Z \$?h = KI9&hYZ|;'QIX[j}+*cN=Rctx꡾J ʏ M,0u ԣ{e|FAU!dCĽ)A&v<JQ2%Pds|鱟|>/ endstream endobj 4713 0 obj << /Length 2211 /Filter /FlateDecode >> stream xYm |[MyA ܇\je֝-gCɢWڢN493%؛bjVo~ F,NSPhUP芻5nnHTX񙌡SѤ/B΃{EߍiW՜ڋFΚ6U Yn_fi 1f5H,IszfBLk g/ӄ1?+%ALr^Eio1P {XC8f<(5vmfN6BAsc=1 y3agKLcpɁI-i WY孁cDM["M}[gܯ4I6.*n]\:SOXd_AJc~ĴJXNYVw63XR҆ t2HHŔ-єa膉n" F\^!x_@US6uSQьe"}Aov8q󏺚0`B^m;#TaߦuC:"Ql4Ш&+lN"i*;3ZP>*$ z *4:0#ӎ`R4hC/C!qA G6$NNت8ޯL9>h v vBVa2Բ@@=);r>ew[7/{,LAgJ.g7v }€6;Ӵ`*L]}c ґ==w}$S0To}mB nTm:'xMNh^"wLYUD^& (, ~htٚr޸Y7KQ£eK\! f6jzY"aTx{H|[" (Xdx"+s3+䰋3 {&.e2u]T2]So׺}U5hTSWHp>{>q״~ZIמb%+SBijT}/''@vMh8'`ګ=8p5Nrǡc!NP_ +Rcekݮ\+Nie!̫lؘ?!]/=©q)kԫnjp /ʌIJQ|p/֮|8o۬'XG-InKۊ՜կrPF:Qf\u$Vp= '5׼jgGYM@U.OEF6ݻg^/SH}6֟1ۙJǿ4CζuŚUm77u#9&Y[lsg\7rlͱ6j[zXPK.H#or% L `,ч/r@6C @GKye6O?"+UF@ŇL-$7y^H$ˌD6OȎhDGj2ЈRF:ac4J23  `A$o>6 {*bW#τB:tj*NWs6_) +|eO}E8n:3Rr6ܭ0u}[|,MF@?;6V!ޯ=F~ P:7sьXQгۭ{΃vo<#wY[[j6MFRM'BP@q!%,%L`E,5^{Su7swg{!vJc9jȱ?<A-xEw `?_v%l觽sNDZ9Έ͎su([!GzFxGc&pE/sv5EXر L`N:(yw$Sl$]j KRFok endstream endobj 4722 0 obj << /Length 455 /Filter /FlateDecode >> stream xڝ0y +Q]\*m*`Xl\C] g0Ԅ/bOv$tH"Jx,4I8,v0K3(7YdM[{@l FY03kFuc1qw$0aju$UYF~;f2~:20PakĴd]݂ a +άUMh+(OTWD1dQqn +JGMc(R+ςxũ[EҞfrHv~84r;pLcΤ8 V"qȧqu0g3xѻxjVa{?{x}JôtNT\?"hY-ϳVXDѼ'.W/<ߎ^i> endstream endobj 4627 0 obj << /Type /ObjStm /N 100 /First 983 /Length 2119 /Filter /FlateDecode >> stream xZmo7_͇maaHS䮸9wF쵣d9i=CRd+i=% EeT6:+22j A*q*۬"Ye xP֘(TvBeO:YXTlpcPQ–RQKYY@E3 )g H, I^U|sl. 82ylKt磬s|FOʰת_a6xma fTggz)ji/Eߜo0'`L e'%a \):r)vȱ^-z.T꧗zSTkoԣP׳坸#G_\w+Ql~W$-e  FWg.VO##ʴϡ!?daT,E`V~^\ /& 4 ](N!y9sUy(wgzq;3ٺapPVlYhD đ6З^y1pH 4$ H2k"A0~gqGqkstX!l{Η#k ==Mlݓهm_x("vڸa:#z9n/b,n f?8qX͢k&(p.ԓ" lK`Fšԗ[xmගtn#;ڃ`Bt !/1̌ CJM Ԝ'hEҬ "E.DI) R.ec/G(6BU;TXN{&iNFRfH)6R{r;;;Zwu []L#K]O]!x=g0 d#J',L~/i=PaMs$l 7ڃzrH'UO_΋/T7(s 97!Ƿɼ&젯 3y4|[b,spEᱪQe=6ܒ7MnKPGĎHfr{JGy/A#{qȖKýW >Փ˻wٻU {w\ӻg'gA., fA.EZOY6! FWN- d(@T7} { pu[i2逰Y>2|21&;MfzvY*PD= nK,աW,b~HŨ܇V$۾'"zsmcLm+⎎vF;gNj endstream endobj 4798 0 obj << /Length 1254 /Filter /FlateDecode >> stream xZ;6Wtf"xf&$e:'D:& A@"'J *sT@ǧx,s8F%QB4z.O~kK0rc_юqLOϲ=f:D!L,OBlYvZ;.NS$ ,OH||>eWX\Q)+1*Z܋a6AK]/˺0oFP8&^ <13 )CFd{gpɡp܆(2mR=gy kį|P7Fy3Gi @oܹ0 \`827MmH0bldkfH^m5j%: \\ Aw'C$ ob3_}h/ƿ Q*Q**! ɾ͜+hp#Aë[r +=|y9EÝ 'i"+n!Nz4AvlӽaePΉ^>j);98W_yl!Z}ka ؅(4׉B يoݰ{!۫7 p> stream x\o6_X~|\0l@aP,"K%;?VlQhѢf ~> ' cb"Og! O'rrM>!7w%IEh_z+XQ#5kǒll"͞) deûkDHEa0Xg $j@aX! wj^Թ'zGqZ 0 I] 0fPCml!U"j.4TY% "XQ2-[]BvEafdHc'*.hE p. ('<], {z'>f5"s"˸}|:fBb>B\QX-NO8Ȼ')37-UMb HEHJ8^X?,|šnvA԰OwPO ONE=w+7 }2A{'i0U"V-4hS#(v"'Ƞ!7@С9PӚ^+Ȕ%D;ͽ&GL`xc)խ Onz %pw8#H"TriwC?Kʢ Dk;.B#77lr4aRvjƚz]G`:ɭ3 ku_!8F; Y"&; 5.*ntHVHNՂ>ps@({i.N; efpX\=5vs0xC,8 #&$Ǩ1/pbwReK?}{OFnD&yGJ%4͗e5p (mW3,0EkqT'xԦKuGf'QAC%b,%&ekr4)}GJ/S❳zĹ"bKST٥} 5Ec#rnlԿ#u9΋f1?|'Ar?o&i(P3e:F\2Lyqv[U! = Xb@wn -sOw̺SQ-ۋ۶]m3 贻%`B:ǟY3" &Zr)j߀(NK//RRoMiellZgںm 9kO i!7cj[k#LCF}SA+\aes=Xg9#M V½[\/iۆˍg<ϐmWN ObVsG;`v0%-~3<Ƅy*~:3Lykkw=JDa 41Dd0M wMpE=)d|sWUn=<^*  f g|Po =q endstream endobj 4725 0 obj << /Type /ObjStm /N 100 /First 1016 /Length 3065 /Filter /FlateDecode >> stream xڽ[M%7ݿ_%l*i) %YY EDD S>2py}\׮S_>t!ҥR3K/h>7zbcH9T<`$!X iy$$̖uL0[Vd@JCa{1lËOK 8g,b=_w>?EO7[O߆/S.}Fqq_< /O> /zN_Gꯏ1?vx׏??7~Oe K +zzA'H{{>gxc1ȑāp9(T(9SrLɅ %J.\(PrBɅ %WJ\)RrJɕ+%WJ(QrFɍ%7Jn(QrNɝ;%wJ)SrNJJJJJJJJJJFFFFɶK'Fpǿ׿n=0nLmk%UBmikX)8 ˖[_o| 6nakx\uPZz NIP ҉ҷ ,\n[*<di5׭:Q,TQƐ"6(_r`yҭVc_P-۞^-#"o#}Ѷ!izyfp%9VMZz,ٶ "mG4Z/'0~p-Z\EZST7$]N)-KiQC4r_.k⪖ƒ*t݊03ۦz 3bj1Q' 8؏+aP*WW{ir &eL+!5k3n䚠*&!HtRȎ2FO}Bzx]iY@}tBIJyw. T,(ueɆ2d ` ZT4nZ쉝s)S  L4UT9) -ETO -tp_!%#{q mi,DtSdӈ`R&?ʹ s<6Jb̯,O>$+ W3%. Iekt .LKi=#>] x Q. XX&DM"ap"N ҴT TRDF D,=Vy+wVfQ. %E"+w$2! ֑׌"lX!x2nj[k16F^ɽ,tO*(6+=& ꞚGp(aTɰe|GT^ߨ,h6DqhJtB(Jd;GB썣2QĎ<}Rdi(w9Q=b]Po^M=+qy2 Jq:uK,w0ywfGQ~@t祳n4@B/{hR&Zuw%_GK]3%.HkE#Jvќms)6KsG+##- 0Jg65G V1lXW$6ʨm`IIs  ZGK:7ş:ؐATu QWg3sKC)WDOMq=FٲaveJBx39ٌͬ !ZjsoloxfZ~"U&> stream xڽA ߯1hEE@Z&7#1 Ρ>/ٓgY7oVz"_X:s*I:DUBp\ŅfzZqEC/V .㛘Zy5o[>9kOL=1$RkU! fo5y"x'ji1TcdTk<[iI8SJk̡Y19.qK9)0h P|>#8}"1o/6դ"$Za]2B,6;ܯvˈMz.ݾO>)_>doy.p4ø!# Q?^r- ~ 2 (4$fDXT 8 l=xE <;e}&E ʪ٠$#3Q`Y}_¹u9Еˁ0q/h,U2 # S+z-lg`aJoJ#[֕lS\)FEr A)vR@ >AQ{'F6:pξAK(v4HgN (fBLb0GXN!(ϸ RÂ-Q)vSN)'̆H; G%-w:eEF 5\4]>B4_N[8C YרF`J YL4 {R[_HP9Ž nїR@9u4YZ_U2~΀v9c඲M0DFl+383 fqїF C(,vW PcJ2>hXFE#sj [BP:T}a!X2t f!sBnG>%9W= u Reg-WB;6o@>l17KN)xѶ[SāT)nQJ8biɽi8ר')U%#;ŌS F&#KK-Fv#gkKMcC-ސGrb=?:_&Slu9j~(7)' .!cS<)ƹ9x;'(bi>X*5B51LGUm%yX K#,whD5\j^[jf8,GnW Og䂄Q̄~N83 Bʷ endstream endobj 5227 0 obj << /Length 2403 /Filter /FlateDecode >> stream x\Ɏ6S)6嚥 0sa$L%C{CeJC72o ~_8])8 A+D7߿_?/LV>&]3O\B*_]>'9h 6ٓyFJI&\A{P`N~C Da{iC Q!,MLQ`74dC( KEzIpI3ڪ{M)=q%9Rio zaod?t&-F2FHP)dK#Hy@J?[F魅 H\aO3 2SZefcs`ecVDymR B9R-6zE`aޘuvNFi]y_nghv&t!o6p; m%ƪu`sŅy̷td%KN.Zpp Z>ꬰيP ҕ&^zJg~fRG^JO$6TB̍Q:R|O:֑N2TwvFOFgi#2اD6KąG/ dOi:)Cz . K0uzru-ʆ36ԅPzlPU`Ϣ*9o '*'*9ed8r6`S/ ^{eƫ':M7ba֕So+mWO8}eb!TDC "ĐBDpI7zTI(S'~f{l:EltE&E/hExL1nOIBS#Yco]G,*K1[-\Aܜx+|M{b|V̮O A;z>. NuE&ɣ5yBOH+5e9:@0_#<\lBL)@uJ6=+NLk+@mT.rbub}X~N*lAfhsqBnZW1\5vm P8JєVIXZmDxAɳcbdM /toM1ʯýh-_L J.g1rr; e NUƇSׅh8d氈MB?9tVNOy } 'p~3ed?að(yI&*DE ܍lqx<t٤Zk>paAW˸XDo._SLI`{E`؟߸e!s6N bd؄#6+a 8&P&bJ[#P(r yk "[Pt'PU Ԏ9s}?{-Ke2؜u`?zE\Ѯ?j_x3y&ģbGzK vL.}!6`W1 Blإ:Q瞚SH,\9q6싃C>.i2s=T_fW*M^xsCk|J/T迠-_ P䞊A 1@K$L\Xq;YW9+dkEۮ9ݘ>ƅ~Z{̀nthDFS1sC wrؽ߂ybSڻ+19%V-O:+/s35Y+e9m f0-mcK[h2"^.aq?K·ote8ijV?KuTW!4f:JX]H]Rs)Z!n)7|tQV;a@$&^;) %SDr';B7?qw7x 2>tكdNLGţo?&c7]*]?pIyvoӃ;D1 =vT?KuJhV6x?+ LQ. ŅqO-2T 6GoYI_]?,䬅1O-Wr@A=^542~JhA2`PLC(:f0S-j!>ރ#сۣ.h5LNCmxq5XoǬx枛xxKH}}[b$~%`|׭:e?&V2ܳbCCRh~[OL?{Bׅz!2^6oih׃ 1BT՟. endstream endobj 4971 0 obj << /Type /ObjStm /N 100 /First 1030 /Length 2885 /Filter /FlateDecode >> stream xڽ[M ﯨcr)X_`$@I {1$οcuA{i@zC򑬏R9H6X}P%A %WP|#0)He 0R@f&> 5 my˻-hxCeAA,]-`St-Q `b%䴼[C-䜝mA!nI!n{- ur.x& me߷k٨)4 Xa4r͡,_YXUxxQEΠ|0Lcʞ ZݲsnxTUsu'Z SbH48U=տ[+g|9?- `NíI Cn1|80,.çv ~Rx-is D>@# ds[020e &8%!LɣUG`iE Gh)C̆Hb6:01l9-`RI\ s q5|M 1[C0`6DDl&v-`6+s l@1-$!r $ؾ8 իw1\|ipOOϗ\^拇7?~ ߛ8#/]٢zKwrѐ-]m,ƈ=cT{3AfMbGNswR r22bcGn (@䁜RCL!bg-JR75yCHdmw0f(WSdO7bvSG#4W4]$Ƒļ Ow$' q#UءИ + .C aN*!)OӞGLno> "w[ռ_b-a$͚$u!!9Yb#]nn(%jfn9$AS8kRяJtk~=5Sd?y$m&IyuqD; Nzc Z<~'@mpxft0 endstream endobj 5229 0 obj << /Type /ObjStm /N 100 /First 1014 /Length 2022 /Filter /FlateDecode >> stream xڽK6Wh9S$4 @VIv,2&@wE%[vo\tlq޺R%PfE}B  Պ8rߟ%YyH1v#&">ԚZWNR\Cr`~k|RD>v/!mZr*Q)4\ c U$Zj~] gAuBA9#ƾZ7,85nBԙ\͙v/l}[)r(\CwT Ebؾ,R_k(ƾZm^ YZ "aǥ8TOr?oPs4glШjhm--,4vͫ0i լ{n\#kXضؤ;+նsYe'5 o MI1d4%lR/!`}  >\6|_@ CFg F `ըF.V1m`5fu^jk_Waݛp ?~"ކ[ S&K/o޼<~?<~뿟7"C_?}G)b7S.Fb%X }޼ ߅c_o_&`A 3V]Q$v0QZ$!D2Tl` 2c@\a-Z= Sx!,`G~ߦkc(?mBPRd_+<kHi@AukE(ob(V?BU?(BwBRTA#;š9ᔣ;(8fWlșhx謱c#2-,+[Tʐ>yEkAɋʄ\T!DR@ V9J ^֫aC@g ˛\8+A8^DN0Q~ Et3'zBԊ No@o2K=i H-,vaAK *Z ]ݓ{!ȝ0ČAol" Dn`@}0\ڜVNq@Ita3hW ՘ӹˆX^0JF!4;@(Ðk_r3PH@0X "! AtKOV/ޑ@Q-5S-JKWb;( P(%Z!tÃb)V~pl68vDgWaijftzu}b@p1`Nq)#\ .KsvCV{ZB|EySi@0^?K&ן Vq5X2X W~>E`OmN!dq@W ڧ+)TEoepGίWrb^?GAǯÀa g&/h XEhKMQR,3[T+Q!bS)'WwSsPbfR 4_Su@Ↄ= ~i+-~KPG+Meڿ;*I<(>pNt}8(F8`<(NK!As;bKKͽFEvEV8鳘u{"#xis# endstream endobj 5485 0 obj << /Length 2405 /Filter /FlateDecode >> stream xn6_Q 3ܗk&I#I#iL| rXR$I~Z%PW/m!o\cr/ ! /B_-~0wV%^h?}cqu@.ïy7 @AB'9,-ՄEi/M'=My<&=K-~ ThdИdN;B=sII1̭_"c[*^MBJHM* `>y}1]èJW*M"k>  !!]B$KܠO&rÅP؇Qm6,@ ⻱Qwji`[+?@7X;o| +#\JTEɂz >X*Bf^L(c5@W:\LkfF<< !B|}xRG4JdiJ{2Lo;b )mI,Zd9 7OF~۽XnteRZ|`#)~Q8bnR:7?.X}=9'A J+fL,0 pJϖ:*"(rbx/*,VuJ!UK8q4O!H$4QQT\5T?.\Z.F^}"+Ɉ!VhXibO"Xo3A$6q]| 6,A7O{RBx:Pk hX'>bQ)8̄ЅN0GUM%@iQ;CNObƔH|ylWa%OU myC{,ae>K w#ҡ1_22Cs0lӔ(sae]qo禙e}\/,w]BݶZv1B<_tMF?NA)WbQD#[B~6VZ< i?dd 4 ߸˲QeJG_OH!St :LY` 0V6MZu&˪}s6iYҝԮ=9뇌t"7<29n%>RM>Z1q85fWCjO먥!OsAQ,<3(QuOI5ݨA$h5]̤h .{pSi Gj?sGP,g'cS,-vo]8hyKU&tW.KLddHTwj`,i=`efӈ9'+D oLXi[qUbQ)H> stream xڽ]ݶW!g_ @ /pE4 HzuJܕ4|D!CNRBRB RZ^CքPj7/H2)% )xRFHCm=T==Őz^JAx]&A$;ib$KFvfASx9Ux9ݯ lA[Qpi.(`]ۂz`xۚHF\-~}xZoAEV> 76TњB٨"UCѕZ(YyԌǷ][B볭5NZ[q;CMC7-"~EH}ncs(<]ۢ%۷j 1Jz&0n4̦h8( "Ǚ6f|m c"B6)fN 7)mf>N_WY3gs) R<,ubs:.EoyN0' i)5+ u 5/Xa5oQ,RpRL,'B >'Y;1f )0fc֐,RpQyYǬ!NK4:: Rˍf !C+R$SXjpȐR)ZMqPC)}bLQfRPZ=3z&>3MtxQ~JS3ߊ?ҔoS s))8)f Ac6 =HGoe3S,#g˾4wdukHyR]=ϓnSTo{|̾Ao-=wN[> Nxq+~80cV-c,?dMXʭ_.A{n3e~rC=yD{r3O Kt[e/L,2()!Nد8(}L1):S:>((A-_ 3:r@tL=)t.jq/1(j*f;U=HHkoEziK ~K0T n?O*KIf{ ^|k+Aeħ'[3,dy`iaߙAb+!=ݘbB}-`тOD}x0lK!B'Wd31O=B !{ 13O:]!v.c25"kv6ol{v5m~ru@l'WO8#B"!vLXm5 C k' ;WAc7\*hLUAAOQI: )~,}f/W3x' CA7{/xLJkUmU/ z l=% .?ϟk ?=~~nO?6UY_ĵ?mY ‚`,d B s(֮]Yveڍ3#gFΌ93rfș3#gF.\0raȅ #F.\2reȕ+#WF\2reȍ#7Fn1rcȍ;#wF3rgȝ;#=BbAXPBaX`dڤIi&MJ6)mRڤIi&MJ60000022T:tPAJ*T:tPAJ*T:tPAJ*T:tPAJ*T:tPAJ*T:tPAJ*T:tPAJ*T:tPAJ*T:tPAF4:htAF4:htAF4:ht 'FF4:htAF4:htAF4:htAF4:htAF4:htAF4:htAFd#A|7'M"wr Pzxo_|anLZ'2kq>1`!fS%_W?2 /b1ZB)-10Rɵ%u ̖m5/sb+Cт뻍QߦrNptLQNtHQ crCKW endstream endobj 5487 0 obj << /Type /ObjStm /N 100 /First 1014 /Length 2061 /Filter /FlateDecode >> stream xڽK$Shl:/=`081$b,lg!0cdoQIwV/T -Uw[!c@>b 48$|&&9P*}v 0x-AS@߫>Dk} >QsQK`56.1-nIqjGDğgD?,u-) 5+ְ5p eIZ_7KМ)xT)yXc |^5_[(X4\!qBC/%db-ҜS*̟R9jFPbǽ9r\-T5v\mRGUBdWcȚσVYmɜӨ~`+PBSlIJp1Њ_ġUF#[ CW ]{ꛌ)Lj485> St?iG Fp/сV#FxVc*CհanвrL昀 >֡n?˧p/_n璘o?}_~?o?#;V< JbCƼoÇ}__~'L?oyÿ Vcb (H:.VN#D@ŮKo@qCZtWtR?AsC;E6R{A 䚢n &Pb( ! m"gM~JH NȠ]SԝzAɢRLwUcnPpJdQ7RVZ$G| ^屦t3/N0`.LWL {F[ =-3!&}$yBL\A o45FWIb*dRp=#3xZBAO@Դw)zB7wz Ԕx>)j(0SaDr5t󴐢Q0,{+^`!bXȒ.IqX B5WD1/3̼q-Mt5f@u߉M V@uNbob j,,i @e)fbv"d{B/bNJao82]0lנ(9SihD}c8Bj9 \!p r L\BzZS- ;0DT,>U{Ǥǚ\gnYդՊ⒢TEyihƏdVI1t_ꄘՒbÚI1S%V%.Js0x,AO. ,2Jk]LT{Z _3"D E)Ѹ>v;@mbĤ:((ńZ<BX T Pbl*Z?Jj yHo+)1*(>CYA)ˆx~5*rW%y#t?'8YS !G@[+I!^"|wXr +j0vQwzT&Ǯ ~5?#^qJ|BLspq܉04b c؄1l͠NK0,F@jvz ѫNcblPw@S񯀨˽ C2nXTKnhGP;-$A7||[ endstream endobj 5488 0 obj << /Type /ObjStm /N 100 /First 1015 /Length 2048 /Filter /FlateDecode >> stream xڽM%WhltT! d{7d!1R܍[ Q^V=-hR-Ph؊7(H"o0~7r0kސPnټaRr IЪ>d K$ *GTۖ8%B$0'^ ,ɭI T-p*ޠ[S 92'9d7ԟАrqJȵ{[R.[&! *g9f[3 Ҷ^H CII|:ܚO]: ^9i`j0z-lϖ`*5z[@{aM%U't%WC1YJQPjz[ m)T6 UzoPu͡ZhPU%BK[o F C%Ќ(ECB+Cٛ&iFr ߤ C dTHBpjDArnCX_RL7q&Q>kHXÛcl&`;an]_vum5 xdX K&e_~~~_~>&ǟy#_#iC_PL.ܷÇ>;:lF)ddss! q\u}$S2(t )2 =!zBvA03b{JR-@O"ʩ_nP ]*q@9Iܗ L+ݕ@Ls9^k EVZy+.V 'zb$z(tyw@bbOkȖ{7XCIm|a*8E2aا"g Y8]A8C86c ؀qlJQ qlPlqlP86FSؠqlF4BSniɞy7$nle ۿY.At e]zLŀBeU_L!'7UȠW!(b S=Ƃwswp)V,/I}za.Vo3q.N<*I%H{R'YŞdM)^ib)4?M;(Ӵ wx-K(ybvSoAD=Blg ,l^X> stream x][o~ϯc 4\ |-zv-m A'VRXW_ږlKu%'v&Moh:f3Cr2("˙ |?/_ }af$Qئc?ŧˏ?ReȎ_dՖ,ī[L4>v%uE.JTտ"?U̱F'^4 McMC1>Yf@ǯB(՜z#=uX] ;N{j"u /Z WdžfoMB*h!lnbt'MLDηŋcU"Rq֔Y]WWkm*jnXW0x? Nw yzbX)$ϯ4ESmTlq`O&EGL2U,$[ /gZiW]?kgPRwjmv * A#sul8&x#nd=iitO{j'(T-g|& cܮĊ( صmHGCj J)ent_QI˳4̳`P[AG哣1 H!8 }jQ˾𠀏 w@{'7#X {'Gb: )2rrmN7T `'c0ch31EuPdVL(qFAv(pN'O6̓:u{u]]]/nПEc? k^Ʌ+q%A,{S-O(?#ܽBGPg.`[0` .؎14OkCm4_Dps BH 5dBGkq'^s>EC|cb'GMČ ,|2)0# <;*c(rq1 ]ቁ a]0.[NotJd93zQ1 Oh9/HB*'E ~p8rv] \&ٮ]yt :fB!"t8| (>cξ *Ĝtc΀s$:Rp%~]R#0O_L"xHX*ǜޔ"ĜCW§1th5a0c$4W{WW*`!^ ({|] 겺`(ACH#䀂#vЁ^CdWt5U/e!ЌS@$Җ*{iQZwݲ h2]ϓe(CWp H0B{bA+;1F'Lߣd`0/uԕ)sU KlI$`:jNp]e\-UʓbSHwxxm٘ںW (ʰ^6_=wD_6俾K}V) /0M`K>{y͗ |F-5&xj"Ertmj8U|QWk|&~Y/I[hBM5WQW:͕%+l0ӡLzzoН :hf%y56ζ__oyc&\ + .MX{OOLp endstream endobj 5489 0 obj << /Type /ObjStm /N 100 /First 1033 /Length 3151 /Filter /FlateDecode >> stream xڽK$Wdg#"ma=B.FX't Bdϭ:y*+g^=4zIZCTբ MBM?PhIG'5#7MR$2%F$ۭ]voI\ޒ̩Q#zZnvL<Jx`dRk5TFOk1FjcԬn*k1 qw.55J|q~JGsk ?QC!ڶyi ۬Cw(%XO*mc$ݡI{0m&yI:[sIV %4p mq,>OԆj&.M*RgBu΁8+ lD=<͈@:خEv%ZjEV2xQ[]ڪIPDmH"jkҷk#L+ŀ }jC 3W&Dmܪ⡋{\%$t!T _qӇ?-Hϧ|+ۏނWWFl0.v4kAPg{hH#&EL V;<|a sK:44g}DP=D_hb;&zAP`,}hb}' xbn&.)D/wH4TE2o˘L\5&k&0/q9WvM*]CC*w& Ec{U0W*]C~P/.;JE+~P邠h}f$uX3ά/KU^th"31֯ f c-0Ao?fEK"ԲϽU9Oӥѯ H2F=h:8:QhsυO"%-@AME~3*YWc˸#zzˏ?ůT_ۮ'#VY7W_?wm70p5=sUϸ?_>|oO`3Rԛo?/7o3*v϶}) ?5: eXp{ۗPYh,t ʂ,PY,T* BePY,TTTTTTTTTTTnTnTnTnTnTnTnTnTnTnTTTTTTTTTTTTTTTTTTTTTV*+JeRYTV*+FeQ٨lT6*FeS S٩Tv*;dpAdpAdpA%J *T2dPɠA%J *T2dPɠA%J *T2dPɠA%J *T2dPɠA%J *T2dPɠA%JQ2T2dPɠA%J *T2dPɠA%J *T2dPɠA%J *T2dPɠA%J *T2dPɠA%J *T2dPɠA%J *T2dPɠA%J 42hdȠA#F 42hdȠA#F 42hdȠA#F 42hdȠA#F 42hdȠA#F 42hdȠA#F 42hdȠA#F 42hdȠA#F 42hdȠA#F 42hdȠA#F 42hdȠA#F 42hdȠA#F 42hdȠA'N :t2dɠA'N :t2dɠA'N :t2dɠA'N :t2dɠA'N :t2dɠA'N :t2dɠA'N :t2d/ [3˔XB_yۡ1ﹿtf#vx3|U8/4&qvJ,&}OYf+ڷMhsA¨.cB.bz"`D%<`+cQ0 Hg[w\, `%(0QZv[bedK7fo/rANDjʈ= %Ξ'*9ι+DEp`BzsŒ) 8'?no#,U9zQT9F1bRyEZwY-֮ @g GA\i!>h 0c#0SKWå#fmHzpF/sL >W[8z<.|@vY"MoO+O>i 902_*L QE,y=EC@IJ*Ɓ{i|yb^x-UІu ml pnrƣcX**۞xӽC@$>;6VfhS,^ :xXx9{k%c_^zFݏquaY顋.ScL1ykЅa\;G 3eK R? N( "<KWD:RއWA.G.zDhX)"rb%sщꢕI]=:tNa~^Fsa M\{[ A endstream endobj 5861 0 obj << /Type /ObjStm /N 100 /First 1014 /Length 1999 /Filter /FlateDecode >> stream xڽM$ +tL.jC", 8 )m,alyYSRe[}P‹lW|IծU8TH"h1I ǠoK͎=y9.K\%Q1%R_0bm%IQo9'=$)q4)IqGKZΒO=cmabma09bz\z~߯ϟ|}~=~ϟyoǂPq?~㗗?kHg̛Z.!ԆO>/?~I?>ef}:f;E94s8nP0_SxH ȫ(#@%am  mR8傤op9~Pޞ > .{A%{g(6c67PP!)ZɆaMac0)fO@lթt89 1(T[& @)Fߦe#߃b%lTjTxp(BP#8Ot~LKe=g=]SQO;&ÂQ]vc)[ԚBtgtf^Ji` U$S P)*@0)%}aWa;5;>m A/_ܤ޳Ul7#q^P&HK 1)F\R\ʹq6;$8; ~7N,] r-u2bzA:FZ1\rlny_3\M"8Z}\R\A1a:$ OQZ.f#,!;ztKt,G9{7Zlc\L[ ? vnd;3 oo (&Bo P: CY̩swTFtPS衶8A`I CѠq6,Q<-zU^b$dK{%y&m?0D gX2d8OK$>0VW11,!bc RW{bkLGxŽ gx缦OPy l{SǤ8Ok1)S"Sk :l )hiO9Eg{ +JctA`R .) %J=)R;{%Sb(uI5]A1y@J-oj*G!zRPNJ]R+zRL(D.xM<)RvRPBb(uIQ7ƅT5$8j5W@ػӥYVb สPacD5m8 ȁ;Ffˆ. J΃e)_zmͰ3MpO΃eB2Qx QgDj٨P="$OTE\xFd!^`=xED?5?(FZRH M]P(#I{^OPM(~bMqEg v goL[^ٰB*T?tMN%{ 1d d 1U+TzB .!Ol endstream endobj 5862 0 obj << /Type /ObjStm /N 100 /First 1015 /Length 1840 /Filter /FlateDecode >> stream xڽˎ%5 Y¦N8q"H ؍Xp!4а]] Z$#%G'q;JmSN(HVPS -UBASk =?5INJęPbk4.{"ުDZizi1̂J#17BeXJ+7بlV: .f6jKVMԞJryқ3RhwE$|mmԓlm$|h>7{BF9)pQ<UUnyF?1Rck0&F)#6:c- 5.b,&{˽%nפb-[?FNv~`%uڟ;5ufu? .awaT|pџPb撆<+i4{Va|30h(d+,7ע0DlAmVBnSBaiJbĽQQ5H%X15R֨k5fN65އT֘w k,60&/ʰm.na 2O^==~7۷?=~xw!״xz|o@OFJHn>O^ߥW铿~>M} 7Zcz։ \/G Qj]dOcV@2c+ߡ$V 1rPL1h"C戍B ۉRpKdNCZ&'YBٺ4 '[)T7Tz2( c" #U` h#4:юy"i!Đ KaYf&$I|#,LG@X]G'aȆ<'B r²fj O ^aB+[ڰA|BKp13%r~N! Iȗ/dS)*2v7(f ,'E/xZљș,BR5o3j/,GHd8W1.XV8>b`)F^pcR!VL.ԊV+f&pIB)|:)Ԑ.ԘIB)Pc>_' 5(eP{P޴.dP B=(\7(:!Ԙba ))z!3O*6r鴗~S4h d q4(S'uW" !dHh 4z@ B"Ն-q`*Uں~W D5S=(NuŚ)\1E. ayX!A/q'CK0UL8 o:`\ <3c 7f>XJ ¥A,8` !9WOY4 ˙kL6>K3q9 @Y4dXp:8ۨD'ѐ/qs )J^0:g nH!+Nq,vcQp@\N׫Zږ_\;)\S)Ԙ/SPC ^!Tp3O:!-CPCi%l3*Y#Bu jH ޙ:)ԘbّSPCBNB(֜9!bP…Rb2m#s*؈A+ +"])62F5"LH['*8.b2 q!tѓ53FO#YF e`1ę臽u endstream endobj 5863 0 obj << /Type /ObjStm /N 100 /First 1015 /Length 1856 /Filter /FlateDecode >> stream xڽM7+tL.=RI*bpH9žVOfOH 6񎤧j9!\S (HRCj 5"VP[B -YubBؚƥd+I*9P{H5'5p{{%-0E)J8>2ZkWВq A.!q4\CJ$r DQbHv (QHZ}0 Ն %BFQ,FRDioib.}T4 7TF JR*nF$#@GjChJQkJS(JF/m l0k5ZADG㠑IPn{TxQl!4#hpiFц"D1Ag1&v[HTf^[kEpKQl(8Ydv( [P"8]BHjE0!݊ Z5FoTcEL1WHtfe CĀWCoiP˪%22R$~z ?>y/<}/.?^@O 0[4#mm[[x1\ޅէ_|R:y?"ޠk[=Pw7d;:M:~ bo &B4F{CH | 4Ab,vj[ O`C$B&BY.6qDܐF D3c"#1 O@Նt*ŢDT1Dzbʛ;EkȆzZLocᖞ 4u jg(&nP`E)23cD D;sԆ3h eHBR&MZP= Y SC Y!AESOESQES:!"::frn,ʽtQV.꘢.袎)QERT^ Sc@T8DB!\1/7HEA{::]S\ Sc Z Sc:!"/!\1Ŋ5ɸQ%"h tEu uLzPtQ3FN)dŌ.bNq:X!CcΤ3*&^+Du uLzPtQ.ꐢ:::!B.꘢-5TޡheNᢎ)Q."ϨN)hNᢎ)Qu1s.b ^̨Q6i|Sc:EuH1sv uLLpQmul&uuL1L[L⼅>)~6&Z> stream xZKo@+|LjR*0@.`kUSU9y~,440x7\ b$h h$BI|}d)jJ0V~o h"d00d~mh09SRo`SpeGhH1n uXbX_hKc{Srt JP$;.e7J! !/<ӘUGeQ8S !X1~mʒ~dmHz;w<[-Ѯ|A4K.K;K!JlyTZB2s9D}?.͞qEnu|b[_Z kOVཫ@_]}Ȯ1\7C9Ț>,/`wrS_R$ʸO=TCLx?SE.+FyhihΘ 8TYiUML7*q/|^U /%Fp| JKWxv1XӦٮ.Y@nNjxYŨ֩!CԔpp"gvWMEBCۀ:Fwj&lW]O+=w&&$##~"yɉD9"EX"n?qP-Qt:5L9L&4M4eYZ>&q8pbޅ7񦔗TR_3;..kH(ȟƫ7z A[c5hUnpLk#dZ ̿9J~B>wdnѬL;V U4u;]W 55& DxOgYhj2 WOYj EqCӦ7cU{ُco}>d^7g;or'E,KDUEt'jXצ & : endstream endobj 5864 0 obj << /Type /ObjStm /N 100 /First 1020 /Length 2465 /Filter /FlateDecode >> stream xڽM+h_3"#@,쮐mAH::,^fodUTYBdOUTV|fWj@窃$K8 r:Z?$QIGZ=aĐ "R+:JJԩ%;-GcZmMql10GbySt\*%C'E:[*aRs1FpSH :R#'Sa]vܜ>ohQpa-(QBT(k!` ˵eZ6_[ҏVr90ڕPJ5Qŕ ,G+Q ~m#WjWnBբ&nX0<~EvXÆ9 WTWbJo5 hkÄt.k)kYɵKBvrV,Ê!-W7 c'5Fbk IQ#cl`u#$$\C$qQ(-'`6} lT m30f1/0`Ʃfc%t]Ƶ 4x F0e=!vWyYF2epfXӫWzqO???ty§9ˣ(}HpՒ},fy߻W;ý;v/>R1F kK"pw(bIQ8/d$Hyא(,NzADX (ʼn1X5hW&RO=Oi͙`M E ` 19"ؒGxk`?]i,yQD el:(<96p] bf^WBl2bd/YS)f * Y~&DcX!u0?(|`Da%8 ˔'K! `s1S^CNZP״|ixRԙK&MH^;2Bgީk8fʾ !j-z}%L@iHPJ&ƴSٴ|E[ЍBPH{3a3(4A]E?{UҦK;ٷ ;|>~?-|_>ox7\c-F q~pwp}#f=~Eu}[O]~T^Qo??j 'e^uؠڠl@6`D Lr1bŔ)WS\Mr5jՔ)WSnLr3f͔)7SnVeGXdA ۠ؠɔɔɔɔɔɔɔɔɔɔٔٔٔٔٔٔٔٔٔٔ)GSM9r4hє)GSSSSSSSSSSSNL9r2dɔwZZ? f58L)WɺcTGىt/\vL4t2\75H7 [kybz(l-F7S(o%oX @-Bz-87YnJ&R0""&)fng)ǑK2jD;Ja&Pm "a~ AwT(Ko BCB `!ɇ$p.Oy(8,‚Ř.V mϩ۬b0C>,RwFN,2((I6B8s"Jh~C%pEh/`ʹLGW3!iC9  `gy-/  &1lvbC<a%M|KF(YnЉ!SFQ 2?p""52FabH15hbH27SPoC=u0ORS7 1%V(q[<5JK)P|Fz꘢Fz O])S[1켴FbZ !_n> stream xWn#7 +xl/) 6H[&F(]؋ Gy'aSyzRXJk#x(JL@ȽPjB]-ÜKPIR9P'+,Wĭj !9\aH gf$IL|X1L WAtT4g .@ \#! 9HJ+jpk $ CWa}pWꃃex9P28X, PӘEj ! i鰬G ZG4(Ybm֖<8(G %( '|4e2sa28280|XQB G!σqD|ġ#n?^J8@QQⲈ"*PbkcECc.E[ .6dtvLJG@ :&ю8{EhEK?ʖE" п%# Mo~5c??=yZgqqi~co>iͥ$ÊvNϽia閾_$қ7+-=ף)w^EU2oV*u$-{k-Y%h ڋ\" IMGHNe33A'j)gYP fk"ئd*p%wmQb\%S=bD8ՓɈu9[B.fs.Ϋ Xz~A.8kO^[]b-}Pz^W UX.DY0_,fsY~EUqVDBQ|\gD,wY3쉎{˸@W+Oarʔ+Ԗ"nim=M>N$|$|˧Ow~Xka!r[Fg9cӻ݇ ?{uXq:|_? \ endstream endobj 5969 0 obj << /Length 113 /Filter /FlateDecode >> stream x332V0PP06S02U01SH1*24 (Bes< ͸=\ %E\N \. ц \.  33qzrrJi` endstream endobj 5993 0 obj << /Length1 3107 /Length2 22640 /Length3 0 /Length 24185 /Filter /FlateDecode >> stream xڜP]%w'AACp {pHM*c)c5^ %Uza3{ =3@ˊ^hjc1SPY'/x N@cE {̜<,<&f8;L-6UKc' < G)5(BP1vݬv2rrv32 dakle`joKM%df+?zـ<+W(#_[P:AٌhJ79+S3 jgtJArHN )&_&U @e+9Ѕ$- `fe0ZX3J 0]<L LL_??郤0 L?t""o&=3''gR%cb(mgny3WlPL`@ؙLA6{~&Ouw#:|{~0)BkmfsF Wu! }!alkeŀBS)ꟍ*b b%lgaYhdbj 07qeW+;կ%h$ؙkM ؛YYX9NNƞLafagx3@<@PmF;{P)`0 28"'Q70FF'Q7b0JF,F߈(e~#E7q@\~#ſoF .ohF .o7q@q#VPe :Կ}@,MLL]m3p{ dlp~%qT7EZ;lN@8m.mknֿohjo7bk[0f&b bfoc'g%[@0Q׺+w?x!5H!Y@VnlgY"u_5?]@6HDKOK D;@^7[:H?v7b]~*mjk*3H.ߤA9bfm2o?ODY>c66ldq=A g?`%q}MFt1],4 Hw?@9\O濮4gS{?eD%zAG3(/6L]@g)Нln@)꒽)o·ZSv׾Rdn~rXk1GDŵ< gh#?zkTOm~HL̗}o\lLlBv4y #PdROź5+*ϚNZ5 -\!kYk8tĮzES˫D?ΧrE"@shE},RL U/I?=(.brjN;Ւ3 >CTY|I.ن.aavVz9]/(-t qRγTh>J*Ivqf nEi^ٞ6zr#[:5}N{^+QD&PM{pM9^E $ٵae:%}Q&3ڏt /i$/Vߋ0OU*CCsTy"on]f|Iw+"|cq([5J񦆶g|Үȯ <,T$z1=v b<: _=E&]>Z(rw!MTθPHa7rl>OgGZX+-2$@;́)[FMKLi&0oIK#:i4ټmrVeoX_^yQuC8/n>/.+(-zW%YY`dU OP "<xE$LN5괢פ+qM}dJۓRq!Qz4G@ ݶgl+q=#:{$ΆzQ!>paHϲTV^ڭO`~bl6 &Zz5˒6dYۇ}4{o~Hƨ :1xҞda}^|3 $M\F#Ʊy赔̡4ʠ&K* ?8R_ EcY+>G([_Ek\\}P$$/˽/LNKluug#8yYؼJq|lؒoYLJtzPb/|,XK>Y81Bj:zybMOGm]#8۸GpluXlAoCxm|8,k`&E|P GrhyLlo|USXTrؚ.\߭!+׋8j89e;H,US[L(:ڪ6!PD mZEvC4}.&DЁgVipn_śٌ>1h4æzߡSse!nIɡY]wd7ye:ON Z[*FBĜߛg2Μh~! иu;#l -A("Ϙ" >f=; ):kN^vRl)fCA_'hlh?& u 1Ϗ  lNpQբy/P-R\)5¡pQcCw%jn$RÇ5e}_ri+:qq"ݼg'aX>#JwJ?QKLv# \yp'q^,SqoG#1qաF1޺eX~~Ys6EJFakV<;DG?z#uSB(O^[vGVL˅{ݗE_dm /N"wg>Wz%t>&]`vA{o mc51\V4=%eOۋH؛eI?K He S׺v^$,Y;1L}P0Jq켡֊X?Gn`cA'<1^pzV okq !>+rQe5zB4ɣ˶b<} Kղ o83VGB4>mjqc`KHkX1мIRi3To - m N.cR*OjkeH_oA~YYpnm~gp .a~*!٭HR;N9%h5b~7VcOC`"OB*V͠aO7` \r~HB7{8PeȗSeզ~j-F uO{=6ʐ'7k6rfT撗Mzr՛YBcbwc| M7N_Z}s%nF)b,gp'\RHu 'ǧ cyg ܏aiOM6ӵޢx,܁Ӛ-  UB- ԣTRhU,,k?2xJNZ*,3o wM1j M^jd#JM:-劻eWdaXK*{kĽ"#hOm3-F _Dl6Dr Eh!*:'o|FzhOݫF8hIa~e Oa-ܶȥi^a2#ʦd6:"f=+6'7>D%F;FE!O'V֕zQxX时(I|fiѴ!*tJHUiKN&ٛw:U6KM"4–uKY`klJ(욅"1ê L[fEigL6`!48_ . SDhfvXԊVѺS V(x#bFhq!ho8zxSN_)uj-OkoԔvܒ'wׅ=VySVEdXOԫPPnBD'P1rIXa݄S~V9r[2Ch0eߒw']?6TUj҅+12*72<+w Xc?l_|&Qu5{%jFeP}Rn=2mȡTpea{Gt˫ۮԷ೦yQВjX|ɼ,du[S2[q].$J(~W8k=vHN Wb1**[AMrΩ%'5s:rg(ax|y [zvsALgE9Se`Нu@T QwE\4fh)&̷ 3Z>'=?D$zKY1'ކi%:uҪg':q 8 JQO`e\ǎh0\dN :6@I̡;l@TiБW,|$^pT-T`A 3ŢZ )1F8^PW(O}]nr㐻G:jǓ(Ԧ"^;sZ4'Rv˧Xa!5 [X nJMrd\!Fn 2( %QT񎨨>J,mUR`v.|,%KO@{'\ۻ#YXPI:QZU.zq#j p"6Zp"Kw&kfxf5XfE&ꓐO4UHdѼ.ǦЛflO肫Rmr-Q:ݍţU[K 'U앞C̲d-iCa2ϸE\vI D \.2h6olSޯ尅EզΛlw{v2ܐ@{ ډlw"~8Ԕ\Aᜢ+}y؁kl| j%u -ޒsN$xyf MY21kD?_H> yUK$ ޘĥv.VqbԠawU?B8!kgZg/z-Vk] Pfe}e$4eƿ @IڈEA|šB%J [/qWk~4x'㎺ %`Rl_6׃.zբLRQ!sES1F1cyfgmW߮W몇}'فV+tїq{45%A{pLo/t&6ָvɓdo=N2)%e{N4)}{ϽYC^`) "*|zJqO\ΰI;&)gO.qQÝp7 tP|,L'fZa).V̳>9f'{EVqU/}20eߔUYNEYCMLeEj"SYo(Q9sp72&?m 62hO&g#ҜrjӶp"Nh/g_' 3Jcp!PԦ1~_rJ53|>p0RrӂrF wC|s̨b̴l΀+6|Щx WBd9 簉(b͏rz: ɘ1E\_em 3w>lnQ]$_دPDe7'75u4d齾nɧ$FAl@{YyrI2*p(f""S` S5r1m ׁTl;ۧBhRbٟpF=AQ}1Z|{}s(z $g+<63u d$X4,NJV/ku뿕vc 7'{}"BEIjZ)r!F= !5%a{pyMփ;H Qo-5MP[0} 7y$^"yWXrccw*4B~ydvA{7+琲ۥ;aSve"C/ OHIlR}%_9Ee?tki B?x;z.pQ&R0w%##$*j:];j3h;fQjյd^'҉,|a`BPb^66 ~t< <@:A:CƢ^#P1^4R;緩e)Đ.D#:]Uu*WLBPS yVd%IgԘ/=ZU`S9= $|)H̙RL=1Wn68>b߯q^XE ޮ`/ e_IE-W ;lj e8vݡir8b}7K@cakǑ3U >ݗ{ dwϦ-kcWl2g˪L=y?e9-&~̉ 17ZEa6M.9z3~wQ lW)g,UsKIxE( n72"]g+}Zѯ:Ujx+ъ,AxTvOZզƂ-H-w r=Mu9`ԞBBc hTش:9Ww:r67Aω}IXh"IN*.v+iyW`f) !zn#O0Xh8|"=3ȶi`k{8fKQx,bBBA d%v=RNit1.%a4QY .D3|2$P}-;Orܔji4gA͖!VNhc_a@1ɬ|l3͈KOd>U__@couIFǚ5Q b~ݞDL_A)[f[(g.#r J1Dcɲw4*3D|^놓rKid䨥fȑyUCə>߼?Ks.;~BTS!Fր{$x'M?/,'Vf@?PÊCRLb VS3uΡn*c/:%E]ْ[h?~E{M.M3^ G|dMzN|{W=z$g}NkndzR;Ewe۰[,śW^tjyD}ԥw%LS~hv@|YfSyҟT3ܛ3 pA}FPwfܿcZ[/) +9.} 0`{+^V\ SBSw:CkdѷZSV /+O]"8_ QqGCq۾ Vg.zZUyN7RI&U@&.^%o59N`'vcoɦ9%@ˏ~ hdYhqZ}v j?n?< lwa`ln}orm>5ǟ`j댼г!Q‘?KNJºBF #錭]B&S ! t79CT*F,d>>q}:!-.>m{(ӆw/j{k}v; ޠ:,2&OS>ڔvc{-^Vһ -|Gm6 9{ժxЭg'րum_&n8ѩyMo2Ng8bHu6T>`NÍ/,Wps2+k\LHwM=uD S޲X@ I͗%4`iy'lXhង(^5u:M&=Cdx`f>"\mA䥯oTKʮ"[>]d٬f$f%2iM٬z B$׭$^zW]ԱV/TKuP2D8_&}>zp!Cf[NM?L> G5D3iЏ1t++OS\֚>[q&?[t^*|nC#څ|6`M(x\t{CAVEj`63VRN2J,t)iݚ<0JZTNzϖj)vgu<Ά;)}< d+Xnz0748 AH*Y"/ct?l))qh9)1;.LF86?%xT#w:!Tf9Q*ɺjkW[mO풋Ɓs-b2PT-%{O0+ "VhJCB%̱-bGZ?XFk b([MxNy\BmI-` y&|Gi0qcӟ޹e7Ru{ ?n1k΂p^47gR)dvemg3 Eؑ|~:˲f4ƈWS֦Z*O Avb̈^ԴFGq~mpU-6Nq+PZ}:"\* ޸| zCrUp ϐײW^ǛgYpIlu՞#*h `6}cjl w_%F lPa JF|E OfRnDӎ+N"~t2y)!sti*4n"s%͗Ԏu~#)(&Ο#6^n}kX<ǥ:dw\!;jQE#!Iꚏ?Q'ӫ9&Aaru zVTj,{ ܨbS?pF4ΒvJZLꋨGFrL9 C.3^JO 9'I@7K`Nt+^#I>GԿXTWԃīۄO;fzuٻHpn'(t.:KTN#35vŨa!^|[iBKg@J|S`/GgxɮzG88^T ~pzNIh} /}؄6O`}'=X[vSFkZSI)U{7'-?%.9 =RFm& qgϓFzEN[Q*z4٦-ȴY$ϾT .Cbh9/h5L6鍤E]N3U$r&>K /Mj~䉳ګ@CO)Op[+veɯ"Ft`33X?G7|wp!>Od -mN3}0zƉ5Θa:T%P-y:Übc.Uܸ=o_O ac C} qH_쁃GM37\riYxi&@P{%8,l D9E;l\iQ$XR`ׄKP8[bM!dH׫>0s Ud)Nҙ2Բ(p)uuI۪},`Yqy֙KKaݧ2LLĦ vg3}mV$?0CS/؁7#;LÜ ﰩr3-כM5Dr[W)}&显fI4>h%9ifA}N?!&b)<[Ę;JҘDvm=.//-Zpzv<(\-ŬIv@H{ |҄i=*3kiZiqXU)U7 jCq>|\vS.WHN;^v_0潮ۉT8`mo}<[}t#<5%=%ˍK"Yتr3@2Srs}!.mwb6 f8׸a*||ݷ*x{y75P~ @:6Zcؑt!Q sROW tk%l/s[20{@Hn1Ɍ䦱EHH!tc+W{k~{ }Nykv|Vo:{:vb "$,+"H&P28oדR1"֚lUBy &Yw bO˼4o}K#1;$⍪"G'vR+8:/ D)ϴ}#!w$쿇 h/RԎS, {ƭ&ȄJW 8[.hmEh$/I_mNB=bXziE/R%L"̤y5ֶ鍖;] '`W6=<*$ F)Z;^IZܾ4úӵ| m`a2$Y c4}[+wd1M#T&)Þr>$|+qZCC=j\*= v{Q"L3Kr_ n*c]1y×B/7I;Γ #Z .{x#Q" ?bkMa73tqL̯-`^mV1=3e=qgSNݞ%hT-XF!z]ɢijfzz.ƌPgsM%$N㞑wR<ݶ9j\!!6]g_q%xPCfa؞ʗ0$@i]ktHTkoZ׵W&@(NȗsjԡPд0Cg:E;L{Vtnayb`?XiY?vω,LФ}폄H )?FsmN YX icUnF_a9PF=e)xڛ3*F8 iB^R`uN '^ ^?OԵ`=d!nSW A4.EUw;<5M 2LPd>r7Y[~p+ߊwt4NQ;oogݑ--j/D0,+s]YDԯ"}Fc]YJ"׸Z 4G)ʽ*3M ',1 =_)( g k⶘T;KO_upuwrLX}!Y=IlL=H;32"B0z~Aap/HwCgqTÕ60/#K]H Y oȮAjK*[LAL?\ >0;nZ\5x Xe舃7Y;_Ձ) &Q[ mѣUf=`ו VW4 #H+0ĀLU1Gv`(Rp?!S7N4cK93_Y#)i u]uOjvw.{~% BcnU곐Q=6PM~>@nt) ӽ6 'l.'sqգAhawjn0,4NP'\P$L@ )Kk̷I$󈝸\i!sidൗZ:)zzp,GoiJ:7_-[}- T[_/e70WjˠjTE}&<.|b01$&]EJ:-y4Jľpx6HU#5JrK8;3etm#L`;pe@)ჲd&Y>9X/VdR: ͼ"H`BmY5~ŞpVS%=TC6{u;L! ƚ,{&(?Ts 0zt>NCInP%{(=.SVmɯ½[|( ԡo㤃jj{_SUgSiD ѵV lZoЏi#rADd.=Wnd9`MIYkGgqƾ|@G|iT7W&a"?.~O78D<-`3>ɶRXVYkhcpDIӟPJ%6S0P*gb:WP }-ie'j"AHh9H6UX –?0 NQN $wB].C)\-Q8n-?/ q)Ƶ]@3+U x. lp]Hh6k C.fhOJm[mc!!LF).Y'Ցз\dfrHIVE) Qg*%-\߀@P.j'/خ\[IUBq>ʇM^fg2GkۺȐ#Au26;>"XJ {'񘒺t3n}[ŤPQ*-cㅝ*2ԘBFՉ ROIc{dhELx-1aT;(a:TG)h!7-܋2o2oLp#`7} 9^a1艃/Uc]26 x%{w"\/&z GP0J'$GxZ0!T 8KX)}-Xd-ɩ.vI&俍gvnܶ^C&{a"zZ? HYg]HN涎\CkFC 'v Vw=?˒(S{Aݗa4[HNeWiْ9$/w~:4[.X`Sӈ_$Gް i"=f|]ΫG:nŁ|+Utα]/DrJ;ҁټ\£E:ihdaN{Y22Sg{Dr+j}J*zja/4ݹSb Mh [v1tyZnσŜ  g\:iǖEh>}S9_!l7g:bD)>?\hCAd\j%Ϟ4g|'`苋F׏s)cb %='o_}ӿ {M3n BՌ򀱴Ej RD&s&I!"KbPЍm!uqJ@=䌚C%6ΙF<49\{yQP; ׫7[%W-b!M<\;ӝאَl(AL 9dn#J,m?TɃjH&w+rW}MݷHD4ZSK`-,P4i:c^*3+)ܨ-~bOOܾy#hs^+F!镅I<#x45};km`@ZGVp؇O@FѬ[H!Q.qR˴h9MN.}HGZyeiK89w|T?D _(ѳv'(UiA^nWYV;RLx:Ί{I,T[|tS@Tq bE*j)'"SRlL<{!һ1#C~Hv+ӈv(].k?p&ChEOUv˨.|(g lUA΋`97 "h塼I$arVR|Byh6mJP2?޳{ >"@nurDu3O'BxZ5G#)a~ !ϳ[`3V95yb;!BBy&*ғ(8`r{WWACNrX`T`!8Y[Ob0y(hσ? 78 #o:ɨQ޺pj:*.NAYqVָ.08raՆ 8%~#1~\M]+r-4L;L6B%4#Y[tZb+t Ku?0}x^aЀ] @T&EuDm$ɝ]B]RyT1R(lGŘZ_K`S2PʧאØeR qC{ov (pŘv3|O 6NKY`U.7,!Q^;H&m(Ǔ[QSYhge%$?RrA;T/Ն@ /trYC*ԝc[Y_%OyH,,& dsj=DzWQŖU#\NC s?D +BY/U>?zky åW15/tͱ(SuL/ 惴v?~̔tgR>\nbB9Z7^]upR8a{uo(blm=}vc #e‘V9L "u3}ᵺrW2ⵜJQJ=\5Oob}RУĄ #OYBxIS|Ox"AmR#gyϿ@'ȓ)0y^WPn 02;`RCsY<Į~C $Fo(B$eǶVoNχqM[ !{V v }8So© 歩kx sI_± AIY0)2дG e Ҷ;\WTl_˷0Qg GM֞\@H!x6)h(ICg}BS>hq5ئfs=MuӼ`5uE Rp06xeŔU3pXqV[*WtThF+rvR^}dMXI7J+]O*ti}En3P_R[}!(\}ݺOk(4IW J]K҃sS@!5YU:mEY&qsɯS#uewTfču7#cv$$Vh3XDrJ.0->8yCtuo2!{8aW҂|rlKQS nƮk̑1nKa(NL0 Z<m5tUBtT2>oEVHCi̴6/R*Nr*w-ɓ>G y;S9m.,+n`R_zOH/hM䊢m7M |<ҢXrt_W$wWv+08^} DɎ(ZV7I]L/[ق\0OE;9GCM|m/Q}mG4ԄCWZX54kw*~6@bI A(kZ'niwe"'t ={$c˹{ e\/T6 i<[l8'k>~t؉?mjm&H 10P(ɼz]4_Z[[mOB_k7X.A!3#ۊO4J5}KyxKLa fHq \&͹UTY޿#f;kv@C&eT_S( -}{qQn-B+B` 3ܸ Blņx'DEDﰩ CW "j,JZ^ziXLDw4\DΦ'NJ[}6~NGzE+yԨ_^(8`uQ>.@lKΆ.ӇfIL88LWA U< /Q= PB{*φN%z"jn9!͇{;*POs-WNr|>AvLd h(;m(&!}@j>ڰPם& 5' Я^k@e](X1 c%r|zMȎ&2[SKsy^ܛ܎iRj (},kI;.kJn_-էߗ5tM 4NtZEsjAUOQ_o{$alxrH?^T!Qpg LmpjrϨeԘC\5Q$"> stream xڍuTTm6 ҈9twH7H)030 ]tttR t׏~w]g9wtVe8 (h*=x HG_rB@G(s5qYC}U 3 \?vOGP/c wr0[ VAz" OE+:n~(@Y+uFBm` p'' 3?E(u=`>l0keX9 .nU?unExl!H0xx0r?ŷ58Ý6e@6+@" ~>~?k( BaxxCl8eq0k8_#5VVAyy'_/& DD~;AL_ƪ08@|oW aK ~K] og2HANPG?5n놼]M2j cw5!P7H:ln$U ց"v0]s :pW v`` R [\4~!ayݎ$n5<08p[9S~a8BlVP[۟?0!1?om!ŗC W,ߡE[vVPO@7#oYտLDossusrws[6p%R޲k'``J9A+i>ӈs"dı\r'7%#+͆ZDݦ 'z#+MxSCr5= dW}\|PԘs\Dt^ztx~ X]Vǿ,62,cεbBrpz;:L=tCω-Pcs6Ԁߵ)-5I1c@[6Ɍ\_>yKΗgWE"0o#{TAZ>z({)S?KIHQ!3H H@O&8V2.~E'p45U"em^LSv%/8D {&*=e,5AƩXf,Wг0VCM7)lȼ+}}7W;|͹`ԙ{Ӏӯ16<^~ &m^wo8=rC6#$W̊5` wvm{G|#hIJ1nS`Y ܾ%DtpVU6W^U=nywGm[GX&K*v r~wVO,RaF\c'؛?1 L-0<2_yv]*n3Ugxz*o'z[ouu^N\kÐ7^R_=@`LVyH'>$[j w}EKl/5ೈ,{7=q*M; іw6Efm4#&L_z0 zJlV(? ~N?i &7.!nPb궻69>jL>%)}MR03ɥBݳ'MO~W_Hٙaѻ)ck^cBWZE8?yF5fz5E6e{6YeéKu>D_>9x2ݭb&n:ϴHg9?zb_8|Y zHFdleʵ2N38m8."95!c4&I䢑=3Ǭ>Q:Fksҁ| d )" a<_q9.9uAMO EC/B<Յ_$]tv^:~,}o=>x׊!NUSMuFr@Ǽ馴mmaX@zH1 Q|ٙOJY6c8(bfyRG}a 0xJTAB~UvWh<<>H9!gK2 %8^lk'!l5d“FVѧΨ4m’7O+wldzd1 ^Nу%9̖ {28ˇ7*ˎGCZvP<1EFR^;q[>/1fp3~Au$`vXl d zňyVM'\DO@{dh*ŋjKUiռ۷  е4p-e#8\ +p˫]sP6&Eks٥S_K#M*-x t] GB*A>iriQc\VWWsW|9=L6-=2u @{ʘc^=7x,$W̄p$ ` ebn7*\\i9K,$Z|Q\qV2EŅ`8!%.AcQNGf^[q}uMs4DP%|K5oj[aI70$CFtS^{15gN7 ]۽JnW 1E# TOPy(GUM]ݷY*GK} Z̻D%>OFYlhAh@6zq}3xXYmb<|&w aG͍ͧ|ԘWO+/jdFkQ,md19Bkwּj)q H$kG!2,lɫHˠǪ.Y$ZBW>8|;0hBP?9{*d&UjPQ͖>b,l03@^w.nҠ4]1Pᮁa$8j/^ # ) Ɔ:\q|#qN˸Krâi)jǢ)tБqbL2vj&&ѣ6!740|ұгoo}Ս14ʑ{l6 P"eHTe:!oq{-/Ӛ+UgȆlXQ2\WwFm^+uBQ+~_1"6uź5̣=y;ԃt}NUuL݇vRJyˍ f97>="7K[>ge8ߌ4ICs3l'\Φm]'b|RE@-Cj>x葖xX]ʃt`}1G2~Q߲4MԆ{ֈlv>.!N%\ʼicEtd:i:Z)~R{P-XC'A(N ؟/GʣNo#o?N-Ta9Dn)? pX ^~Apݝ&Ïi2ZF#מ3uoKWO31ݐ 7U, mv.eN@-29K橗.5j`̋\4O\{zL0&80U[BZ*&(}Bν8 f9P1x,FfsxD^Pj@eJBK'AEI@]E% 潛`5&Es nt]ʖ4=lY.ǁgIob"Kèhi'hbkZw"nXM  >x^ c!WYZwAXz.u'"-9?K,.Gfl7pL#3E2{'9s*bx;>Ua92M t 3֛ s$$2ys~kȑB{=ܢç>&59sgߤ )S>+͇xB/3FDpޣMXkǂ2_Vd46%CsO1*&: 2DJhF.O %ʃ<^/jhR*悶>i6)$UH"cx77ⲬC{}7-T,|mg1j1H)A}uEeb[+)GWq=%b%շ_?z7O%o}^7塭ow?FrɱXȻcuu<̜'nQX613qx73бե7X Q/oD2qKV+g,Y.q:<5TzZr.(⛥Ã̰&fNdyH cƕR_}h]u-!3֭"-X„/w vHVYst1Q(}x7dGd߅^SAh9T /j#Ñ(7?d:$DK:/D-o!(Yߝ.[N 7n#E)ZMT PZfD8;YZ@.-  ĢrL ͋6k\k.R99Uꄞ>$~4.=ijnBe eWh&V\ԅE6rL4#~w> ۊ+kR~c2Njkt$ c hRUEY :M{΍}碊$gtZf/wLi Dۄsejl!U~X \fzpd26aD]+O@w#7:^Iioq7 2>N^\eZejnۻ{FGD{٣ ifD׌XvkASdUf\͑e"S3~1~6unEc>'71O|_YMh'kZ|?=ڠE*&ц|!bN&qB^>؈Ǧl:^ю͵Kl!pZ@rjx&sEW%mvMI]FŜeY\Ub#tb5X,aY`LP(FUdU~XvG[:c=4\uGh{$X Qȃ閨Q?֬^ӸLҋ2w)}zdVJ]!nlre"źB7:TօFǸ,VZ@NN- jk ҼI,{/CLmn ZjU 0q It2#bM^ xXW $o.V)xaWETcB BB*m];zY}8+j K|"E ZApNA@9=fewN*E^5n )?qب= @H/@j~Ϭ~g8ܢƁs/^4Oh" -X7xl߻ ՘<o?0:כPjS$GEx=wI%)S[#354ڇ VC2bBxӾ'f{qf/)ڼ;.˚eaGqݶuC8W@4g#{y 捒)0mZ ytŻm@/AC4+jK D(g놃c*\|v#R#p/R?-=Z#sj+YLVkҍ٥ב+AjX߯롘Ĥ}zMl0ٞ3hN4?'Y韠emP Jz+ #:Dy[QjL0CXvtc"ɨm `%=vRkr^${k* BNNyU0t0d(PJ VM[@Xo6.qnˊ l xa%V^sv ҶH&hq"9Oi6,V!]0c;\sO[Ҝr7o3ESQ_/ $6/߻n't*5O\OF^h?R>`ӆm%`^1" Ȕp:o}*Tiyv;}͠V $ooVCf7goD%j\)Œ]$<,Rچ$nBv\b~8(/Jv`gĤ,fesW{{6<n+LIv5p؏9{9o'IU9sbyˎAv_^89-1p+~Rdl*ӏ0D,cLԑFPb . ';Z}gU9,ʽSgġz|ɭѦ[ri@Er:秺˩/ LaȘQvqP7e7K@Afg!JɇɣrC&[+%M(裵If+H/fE{ꟼLΎ;,R<s8*s/aAhMvpRx")q!UQ'9bt5+OcTKc;^XaDo">ǯkRMI5w)#}Q`P(LQZ<}?o1+3<ďEH1E4ۏN f$z(x\k3x4Kq7LnN79)眒zkҲo.ď#sS Zhp \C%5w7%6em܆](CgsvgmmlZ* Ϩa3|A-{];Wrsv[7H|"~TMgQ4CWز>o^~w_6{GY56nuwxdvFU%pSȽy8+WKEV F3!2A AeZ-vѓ1[go)\ӈ(>F۞^=)xtYmI,U/\l+`?4mcXq endstream endobj 5997 0 obj << /Length1 1509 /Length2 6214 /Length3 0 /Length 7201 /Filter /FlateDecode >> stream xڍ4]6 BD &z7zE(3̌D'D-"NDNDIyk}ߺך>:{s3,uy kJ5M@ /(@bC;B YH /y$)~8@/@H  !P!< C_oO;/..+ E 8@:]9`, rB"8n0@"@!@Nߕ `v}  00pCH}U 3Y7OoI 'gm% ^;C~:Qxd}+s@IN.Oy(0F`?KIseE8DQ?S!{>Y8 gaCl~qu3\\ \Mlh0P\@TDu@v|? <@ |">0 zP^ 00` e6Cm~ s|zt-/SR0~/a_H\ **G`U  ;>''g:8si!e r 0|_!S& f`õj]CO&su_T 9?m`P -vßcCu({v=[`u_ztRF@~ΘD<Rx_#K>^8}.`@? vE"g u '` ʠ 9Z7o}B0^R~ /ur *bBr<@U r;5Bbz{Tt*jf%RusPr}XSb/QjV{y>MoGު2eNR;z~*Ƅ-Ү;f?HYmQ ,)Z!T ﾐ{?=#+;EEچd#fm e^YТ([oI°eRT:i B'۸8N]X 5]|ڌ_wkK}iXyrA@[۸Rr GZNƕ9TH=F:AqpMXVU0lʄ5CYw`&MCK}rBJN)e)0of%ѫ%M^k"{S1tTv̂wɖeU1QC:AHi] ~p|<ɩV m߳ArMdlY` .6gw`|nݫ/!hW:/RS6t`ly3"F9G F}BY.UyDЅU3IY |,n^㘡o..#sȯ%WlTso>Mp|']Eܳ*Ȯ[3VsSV1;I4d]jx狂s=5"$x6Uj:j靶팺kg 7/`^E0Kܭ:mhI|>ұn\NGLA* oֆj_#Ifr^Q[/M4wBM٭''NMx>EG'aLfÖZIӽn5*SJV2Y!>J|OI(**pj\|a:ev''EnȬʲ "/'gsV2hgPTN("0q0 O]qǮ ^OQ^!I'U}ߘ]Jn| ^$KPбMak6\rٯ"KA|Vsun25Sj1|jH Cr=O4OA%'bV &! ÙDUŗFZoKcxK9JXJ^җViFSa3fHxR> 4b6ұ'w)| l;'E.RE+N~u(M0TaXˠ2hGpV_m]b eDö= j\զFPv!W /FFS'\WeWۋ"9ZfμbO׿.9`E; WRE.V[ "!+6 L,EjbXDa锇J_}&t18a)_IBZ P0g)q%F@Sҋȏlݙ) Blhe]sVs!g7I|«t[{8ǯ( e)}w7gmsqyEJgqFjnobd]&#*#뫉M4Dz~:-3q2.b] {X%ydԤ Y09S[E1s GiVtkt3QxxRQا-qt1YbQ8fsg`R>oa/Gb^ƪG{Q ?pIůK=ZדwNsi' v*>mZCp-^6mQ}{[|*j60S9]uo׼׍iIy8Zoncb<Ք#vuPtJ/Dc螅 D@y81l9 ߆iIA6T= & {wԤeʷcR]wK%r6AVz3ҏ,)J'D-ama֩>q*Ul;1]e*680eV1r61+GHיQE=l9P#KUtw7N)ncLsJ߶U>FI p%;@)XՍ͘1腏PЖЄ w;-K!K,kqSD)+9}M/htRRc?'(K FRfBZ \(6G0~IO֡98ϹrDͫhz(7hhcE=y9Ci;t]6oD]Ȭcmo+Ͽ3fC0dn U e~|)WhjblՕw,0V51[uߒhQ08;3;UxL x>ʂtjby]>=s"JyH@@b9w6gDR,}p&T,\} +Q2q#* dե]OP\/}D(A6,h\;+[60rmbFwuЁm!>}zE쉞X,ZO?>a30BגO~,ݲ[B& a +}]kiuZIE٥ mĮclb*27O0?|j] 1VUdeXɿ7U;&z߉)QldI@M~Ax ao(f3 P3&oi0KI#=#yhhApإRN~fZܾEe8TBRl=)m6ٿґ0˴]ғ[-BCoWׯ`uƏLS>F,ޭvƛ ^q6s T>n.8-d#xFNfw\(bkUgHV5{k@OQ,b0-mFV{?8~ uYnss3>I>7_@n*@=b6){cZ'0ݏ%?e(9~LezO(||Ӻl[tvQ`GdBh?:=/*g!(74Zo.^.o +~u\]5=94@yO(FV0m9+{hZ;a|mT;٥*[l&# !'Y6H=/5J Px2>f9uL&KkT9xicEVgz6DAwO]f.(=T05kmuL­:Uޫd>w͡uo@~׈{)9ju!hX(b0OHǩO..M/cqr: ">]K[Tx<*?j~&ԑ(65nǢ_[=oQfkEF|&gFLtg"{ cu/DAmFN' wi&NL }:-\nܔ3:IںX:D}܏BܑgϘ&a좸.{?+%NKdZ5tLWܣ2%^V;dg䤻A-I0jT3`Y8B`*$]K;$]lMsb{+f,YOѳCI`'!?@ {-S Z;'ȅ3j~Un&oqy 56OqP&-Y]jH̼D \=_h5vDPo;C}(lAmBjtfWjm&sJ)^> stream xڌP\,Xp h]KABpww.$ޢckջɈhl @6֎ t! z====#%?r82U5_B }7㛡5@% IO`='@X C9 غڛ:#F;@ dofo w4Ye4Է(]'-'Lo@gcoKIp6s4(@N #oY}+пMP1vtַf k7/F {[v4@d/cw 3 ml]ͬMf 4# @跡͛?Do с7G0om6Y;:OdwW?7 /@k3/ ۼL@zv6&vr14Nj G[`Fif z8y_023tL̬DI6~ }~0#kK?1PNVHUZߔq21hY #o:6޷Ffſ7dmF3Z,o c;ߊDXZ^om dlޖ2 #/VW+&o#MLG/ H_c/48b޼m -ޮJm9T[cda½b3m\o=6p-1(1([L"vzPb| [>?-[Л-mMH8| *09~+쿘B+!., &پkoG_N@VxM~MȦg|Ki|o,QBƷV_j_l~7OB۾-͟0F oLc|~+v_ޜWſM/)y#||4bo\o$2[1 0 踫uݝ:KSg,Ёq݌SX*]`1ZqSO|CK(z`Bh3zn.x,W-I~L?dP S]B39z(d`lWOMI4&-EV]+O[VZɲiR]pqc#+(ᾒN~A("\#xUWP )d/Lw.(zL#~خ -gB4:Un[HJ.Oo<}JМ yHd& eG3?o2s"pNQ=ŴCh#G郓YJ "q}ƍKeW ]uu$jFGZAp06BjƣeS[zʦгҭÊdJT '0;, -ry{ 䚠<D6MSoñ1x@ζ LKuۄu8owo[$ij"S|+{uf*fٗ)9~$SOZe~ #qWᔳs'%<0tWL&/3x 5t _ ^mt1T 7]4em_|u H( ;3bhum>YΌHD8ie0\oR`՚!YeYlMfINop^zgbGjB;sd<ׅĵdvS=0QO/̾CX8fk!Q ;fCAP[Y`bRpOiIf etg 4UeOȧ'E3'vf3ش;ݫN + ]cjq +Wv'jS^qZPgƏ2L4TaN,teEX5Ĭ ( 4RFO)S]bP S^5#-qȚ!H'N4OQZttt"F7 aEGaC󂖁L YYhԫWst=`:X}q*B_8@䢚pyO1E|ؑ`a')mWUQf`־od|_UW\#Δ7~_]P\fY=Ks˄9&ȜEO`tLW]pJrM6@&AYoz5}24(fD8MNuk]"O ]15<-hJ-Ge(aØn#ٳO\XOElh_Qjɼ4%N3B˵-KO pB?0Gme85ժ1 *&,%Yǯ*x&9 n-D8Yǒpx 71 ,7Ҟ@I ԟط< yr/l,O!$?hTt1bǰddn}ě24u9ZA8ŬEQhDX%x.]o8#$I Ҧ~lL+E|IM8/ydr-,]Y/g|q) C4? ຫ%߶)B3ӟ=8V3T11"jr&KIH5⇶{؈0Zn}YsU(LK DUW5)7s&FbY3 _X|=)j1׋)iQ,:[, 7ۥWt >6ۃ CCք쉴?:V_xfp[π4"I†+]Ih+B]5zʊ#~;7e \RDFp$=v+Aj a^3tHmVfVU Y64T)?w8h4̃s:z6vO R!*sq=ܓ k-C(1`RO-~ny%B/Fj )\Z+`p\W5K$'s zJ8םm?0.3SnpDiQjn0{u"Jt-w9Լz[]yR35  ZV> 6{0{>"Gg4BUvAhCs)ZM}~[ =6{#,[SsU߅&1kK[ՠnl.-'Gr)evp~ "߬VNK\ʃwU"F7nxF?nf)pnZl%5"uBLt?QNb/ɭG[ Z鏻6[,;O ]?\ 7Fu+cyL ϟnK;cٰ/̦,OqU. R8()0`O @+O< _33xwO^LJv1„Vm0w}})E\rmɗ2.?ۼBW٥=%XYgPg&_x{E_>udZ~p%Ư<[<wסl'sAl,d#C =j9`GjsBTFH# ;K΅{zsTc"twp=Wv| _ t|<`*e3jMD ~k45aTu036HWbu+B/9 VϰTbVZf;R]P -;MPTt9[;pe[2-!i9^7lmŔ,Dj9-䴃1uZmxxqQ޼;v ~.">08oxܱ tOr؏ejZ!h=sH|iA}ǯ! Oz% I0'M3t]\p~Wv(m7 9M@Bf5,(QMͣq *$Y4}bFv;lj.bnlJAu;_aRe|BI@)W[ӵc!SG]rvvEay\ —>, #?S'Wq xN`jo F@G .m CGiF] ',vR+%3MpD@7r褥T%f's<ܚBC$o?»'^^SO`R5O)p_a389+_Βl$Uodf˶k8=LsE$6Yzf:wU=EKiJu~B:-i[$݋$ATSDWSzLkdPAvKQ$53T>m'266_uR>NfLrHקjG>W8oY ޽)5ȐW ʐ(٧n^#(( +Ũ?g FԮuPO*{yǐl u[&b4 vJ>6QGRax8Fӣ[64|uVmsfI%"H-_Gva)\)7@#G[*.noX'fRN+,6(uk^qTV ›9gs!usGuނS1n.%{J_O;osV>1n9 A},U4 _`\ejtt!OΩ6Б 6)+h6 z֩,'{n>'âu5ʝ9E%f0^)rqp,_% R dy|F2-2v[ֿ}R)֗uQt桽 1`=gC&..MI 7}ԣvf4 hm g mLO9r~Wc}V[EغǃZg%(tiNem;i!j,d2u*ὒNGbqIxQI&mSpAFN.6ͱRUV]>fpqw^2 o<3/ᄑ{LNRGXcݯuT:2lƟ(}׻B_3$x-*z7d Ds4-68lN'Ӹ#{}HIr|.CLX6,$;rĶe(<jSo)JWJ⸿ MKK9 6wI;.ڴU":3ΘxmwǢNu_L3ˠ+T;ٞŅ5T%B+K߽/5{Qh@0J] Nڭ[rO}̮H,/:aqU&4>`v~u.Q.{񳦡ۻc]T76aH Q (`74 UU.|'\ @2'o,kOY6k)짢*Nlx92Bv4t3?_{F V=V $@i1z` D]KLhUZ'blfeA+Y9[e٦Y>9/gsVӥ;R'oΖ2~cf Bm r[jс-o~2G@^f׼Ah@@/aB4[gT1Zq0u ^z 玽/?X !Bjz_.M%ʺxV!M {Dtlz(?/e>&<]}1aIAs*ͳ&QI@8%1V͊V$g 8]cK@ sm0SO:@^q_0.rC8Ɂ˂F)z_t*:2)aw#K97Ǝf)4B)McJuWMl4W`Pjh~}"Mrt$;V`}·85 ^ËًmA\4 2Nqs\ ViL7WB'¬: ' .'4ޟϸiz fg"j\3ĦS?濒W%Y[Ni3N%˖3|V;jHK*-iČe2pP -[ɻ1_iꤐѬ 1F:`.]!n:c(oɂn}:xGJ+-"t9ӲE΃;R@ʳvQ"$Oce6Ҕ]SzDTV_zݬ{5G)cyޝkҩpCS\6.*^Ŷ man-!U=Y`Xs 0? vx8rMLXv bLÊ Bt=IcO}5{q@[Ri)5!:]zIT4-\_~Ƣe✾Do` b}If#(TII;&ybVUhMTɦ TF2PH66GZLhI f?={?X"\~iw+5x GAO|O$TJu!iė\y>Tmh4 jE mt0wљ;>O r L1#-ŷoqb誏:8FOaa?QzN i9cN [ ,}~=$k"s#;\~0aBc:WZ*J~s|6.˴i>h8c:^Tĝ=^B TmBFIdctCAf{{}t"a!]BL 4^IZJ8Z0(,UM]}(Grj`{_y&d\·JRI=3)`xa:nDo%s~^ki-7 7*?Όo(^Ķ[!P.1Z3аTb> G\4vؖx|5L/tHܘy /S?B@(Ӎ\DywY잻p8Fόۥ֖gɢU5UGK^GM/* Ec,tۓm0VŚI- j~6"v[:_{4{sN1(;7xR vb0dn2UV|NtgݼBx\:\jė&eD9h f VpFga;19 y+نWk$ F67=țtX&GA`jWG,OOƒw  ڈ&U1ʚDa9 ͦaOyfB8QP<1$s_#W9^Hs7{WObb 󶕳"@7N7~6?s}`w"#+nH;4\8D",5?l[n6E3?V;`l@OIGvPt .2#pA|Gr}=}*XH`6_ 0vJQè7*˕,%X㚋pU\؜Qw;T6XXk =֬7e 3L'h>Cl<$x ;dh" tZtn`^ӿ?00*-~%HyasXӳ˄^Y.ޔ[zZWYHd }TFdԺJ}i}|LO}bi#|EՄt5X\,kJmu0B4%ٟ|$r[)01PN3nRF%QADa6%I/PzlWCMUa}:XJ4=<<\_\m{ ƜO[qp30sN~2dl_Ӵ>Od v,mzZ|hJאE@ YL|W9ܽ=$Vd'۱l*G>P7v~ Db!66Bh-T|eXT )F;5NB'F4o?~jOZ,p ]j6X>`շ:/EPpPNi !ZRmh&aG1 w ͜=|~/qpϬX،/C3\ $2[4jȡRY s 0MNu^?`cڲꥦ|uS^+[^~?x¼l =HR“p)/XP]Y0qGLiSi!ji!*9ymF0M)L /hFF&9qD( :^co&~HDj2 S8PexL|zT.< 8_lU%Y_L6xU=#L$5Jݚ˲9r9-~ÈpOk4UK (wDb g.Žwy0iӇ{[5>xI>ɖ>ɷH=i~ad(f}|oh Ye" !1TcJYֲ_{ݯVtBAD6e~x{3xJeGXIǺzq}FO yD}K"c~UTjOqy>ï@`o?2&V5ϠK(,xZWfgK ʋy)Z8 ;; #1J]ݎYna'a`&y'p:{>- I@qdKo[ʪ,C صQvpL^PV]eҒyin{,*lXcǪ=O`K?RjL"htB;wUH꧐e2G  '%~!y*v3: κT}ʝ4T.Pcb-E3G̶ں`օm8rjV'g2AXP&N Ra>,~G_ެ|Xw_#a[?/>*76 8@cljR NĖbC\xSM^6`JoIuJ*t!L u;i] uUADNvh?O =vDn]:BUR@ҾA=F؏Q.<ƻkO_?.!+oCLPЩAc=i1k~vdn_uk?v ظ'DYO*Lk5t.)`} +QD+':1!$g%Kp#Їn~!}KD>{W2{A^z(L6×Y0ȴ܀^Вuu2SN5n7h+WŽ+ b+4Z:J `(j$_[~;_ LqNehm|aqzg9)7MG>C}cJ jH)`kLpCIfQAhk8~Tk 1Zv:q{s{r٦ՎN3s8<=o}b;K[VC抭!4(Zg +imRY̼5ѷ3?LXS,q'Q_4ZB5gAOOK"ZW[O n~NkYda;Tw @mXX-p(Kᖂu%DUVA'+>м9{U_Lav2XkN֡ta%i1Ӄaޯ܍ZםbfY%CHHcjD9D/aΊ8LC{uoiP!n2AI%+:r`\N6~Ū@(~hA(:׺0v?Z~O2Joy?dՙ(,BțM>m$; {{EL<rwCMc<=1y c)!r 3]'g;H: RHD+.d8>m%sؽK_ i0Fk>pҹ]*FoDB9FUŎ@u2ԑFp_lUFD{# !c?3r{/يP<ΝÂ$$p[c/:^DF`9^qA#mra-hⱺR{CKsNE}숁zUt8A5Cb[T}72y _: DpC;]5ֻ>?3Z^g@w&v:mr[иdUIr/P2,Z׉$v/H319L>gʏ*Sru;4q.|=|W֯Fvtʵy[i4`?me #tp1+`c{log8|HA'}l7U?Dg)ȋ'CC)ӵEra@eAՕz_i/]S5\Yk @=X86/S(O|+J(\Bxl̫LT(#7ZoE=Xrp&R[ϋgPIz_cD,-cZf2V;2$۞/՜6b jB4F6i(aa,W0Ў`XSSnuP&ȿfB3a%#Rdvqī:4F3$F2?;=h׻5U oˏ6dNLdrdIbүZez7#iFv:X [Fpɟx/b ]b,ivvbWpFws7f$S &dulVL*:&&49&n87Wc^v=Л}G[4~lN 玃픔-ʤ xPrW%Qg1!Xd  Ww h~pe<<.d6w-9CIljԊD7g>4+„SHtYo?+d_ɓaڶĮ?̑[ a/ ɜb::3xOV]"fc 2@ٜcWHOR{~v& k>:b\֞QR0$/C.ˏr t UOq#e%fPp1uB>s)P^>u7٫R5$+nJyiXzS+ypA$o3^̹GgTJm7Cp> La85mg$zA>BIVɵȃ\(v)sѿ\WyL=eH:|LvfgK\b݃.8Gd' 0GҗlX/D=ZX~J %1d j+pwRӁIO~'"rՖ )8'oG0]g֭.C7B:IK3`o@ኸaK`: [@|d0P_$o!ppr,91>K$'5 lX2%Xs &6#*ᱺpFw>Qcp} (}[3GTTvg+Ά$dr "Ws* 53^C\ޑ`@p}/'N@55T?gqrt3kM;YP,9TLvkw8?U ɸ+bB#ϝ^~tktDɥԾ7.6]-!Wqrָy1ErEt_\ipݦx_-gtJ Mj'yk;X<"󿃮|KCOA33| VBM2|JP@j/Xm.$uuTxԥyZlWl< Vcˋ #eÇ@[~QRi8N:j 3~Ln~z[7vTʼkh 0>zT-ZLs3W>rE `v~4E\Ƚ3>$f@sgHA!cڗfS FNWfbkpa#F~Xٸl+,wdTsҪc_m^|\^ bͰ0xubjBaGw'6gW0ܹC ƚ}?v9*kWL ?Z"^ 7֮L0r7g4#=Bw~/D-{}䪠tEV`$X3nH6Vl)ܝ^F{ϝ@bBD^5ɳ%-~2A ore;gVMx}XD7ňTGiA]yw욺qƻLy;,è'MSu>&յTBX |ktnMbEx9 F9{.PR(t$3L&a`,Z<ϐ>>T@tAX@j438]_2udSxx`vs71â1[ăªӼDnHvGiQOdGг큲9r>băwVjx$6d`r5н ov['Oĝ*|]#Oob^qn㜚jp6^oCr{nr4 u PC5_@=܍yHnɱ9na\ķok ǃ,WTwo%nN~0Еk4 f4;G/AhFYuuW8hMK)X|;4zx~xq[U=w9VG`w #>G;\ }'tѤYi,8ͶE&GiY°2tRăωv5'pF=c+_ǒMƸM)mI7H ќ[G4Zb^lQFdM Zg8DpM2iS,{䬨!A.ԺitI7{Dl&XY*YL endstream endobj 6001 0 obj << /Length1 1430 /Length2 6812 /Length3 0 /Length 7786 /Filter /FlateDecode >> stream xڍtT>)] 0t 1Hw#) 0 14%"-4" J#|ck}ߚ~sgs0kr8 A!썋z%E nL g]q^3/Pc x6y,yvk8%?t%QU֜;N^sV Y׋|תjθl,P'|2Lգ+rBѢ&#mmۥDR1LVAX%Y㧊YjE ,{Sdu ^1L`PxYN;OI\#hQD^V|.Mvn_evJ^^Tiحѳt+PSL|۟(3P-t4H;* Ġ'PG{e,f]m=d@Ȑغ M[V8yHR]0!{ۛ]J&V %W $g +J.UJַ,|}7lj(Os=`޳J gaJ'5(_ob5:"ZLt5FNT=exʧg ϮqN^p3tT@(ӺD:H`}o(+Ѝ,BGkX"lok]K->1Vrv'STU.LIqaLv0 ܕd]~BG1Zs8@ dn1B:Ϋ篆^Tg_ w܋dD?=}7t7K,3K$FHY~ߑjd:nBMQL {&e›@J MW [}3y#m%jP--"B0 E{C m _=TѽV;F źrP'IuGrR>bu} Rs<>I[n5?*m l?pO!$ }H⇺i]tȗӶ[N$%Zɹ*Pd61ѭ"j< Ps*d86g˔t,v RP~61L!(z;<I!Q εoRapr-v7~Tx o̅[%նd> (x` ]< ,gQ!ABtVZ+1^LUThk}1NTʫA aoEglPڰfj R^?L~YXD93fzl,ySx\x/f{6w,[ Y T =tSڢ L+Q+=Ѕ5-)$cfu95 &T5T=zSSy%x fXTvo׾1^ejʱPxXZW~s+.OAX-+ "s&ʡJqf>",ss@;l|7Ic{U4az x]>Ft \ U* Dlv:#Kҿ5klR+ wYn6dn؇?tb,fhmLGO\|]S`3&޽}iE3 (?řp&m,@'+ʿݽҬW k02H ?3kKKg)a>UiN"wN+lGJֳ۴ !Čb%Sbz#!p$^zxPZuv5n7 a;_Ay* 40q^jf1ǔiY*< u.-O?f6f*=@!n;XECxߥgM#r8.NƗ>aJշxzz2kZ~0'GEt1ywxPz43')59Y'Y63 2)Lզ({nc*l،>eXX2iV3>bp{Eb`%mIiJ{OZ1_^lɭMc7Z:S^{:zt6o)'P2b3O3@:tzuzbhn(jǥLj"wkA.sh۷tQ(&#8g|,] [ڏLٓ7v`{Z%_w•1LRuUԳņb4پ[ɖgqNqVZi%.~߇πIì%} ^1*OG4[tyЗ.W1/W2v|t@G*KS̊}_na&x-Hk#=Lyr3w`i+z~0 LA5Ȁh2QB>K;"o墎0+Bٸx0\]nя "gg c_I[th/jH, r寈?,o4p)aXq;!v`C oj]~YM{yvܛ "ѸL)3m<|6_љ9m,}oD뻌58s+&miC5fCRMAOh_+{D'1Ŕ`z]Ou zK ѭK kmʷ/nP9߾9_̶l|ɡ)uKщ!Aa˖<{^/k$A!}2A0?2EfI% /Vi$,KP0ɡp'ԕ2}ua#3ف+Ffj:焉naQfb^ij|3b9$q 28ByûGf)0ߡHyڹcvC]6[#Y'R[だR:K05f1O)o5_jg`+T0459SQ#.˗'2QuakE;W Cu%O9Dݳ^ D9-wί2++ i5>Pکuttn%Xٴҿ隍KV5w9?\}AIޭϼkJf:M~ xQ/Dc tp vtyR ]+O3s I>QiR5'O&d FXTua%.cGe fM8FĴ,lsv1z-FiO'7yjض^B)AJ 2E65N~fC|ABo$OZȐ3vAI,A7㢽xiցQCRKu>}X.  fݹpgz5H+U tŶIBuJ"6E$d^auoH*9 hڔQD67-' 4k%ӤA.X'$sQw9ۡysdUSO*[RN7cZQL?FO /EN5IGee-Tqy'$M|Z7M+B {^*%8#9H+־Hܧn,WsGf1~+My,{<Ғ19Ww]:V␪Mĸ8 ǣ[v>ԆVNyc%gOo, )ڷldY 96R}&ByR73Iu`XJnIB<Wळ'dH+&,`>^!gmJη_X?GDyVДz`/;b[,+=TSc*;hޅHo2_R;w쳛ݨ?5q5xTF~HWp(^rڴC $d84%%GďE$1_X M;bn<&)ޘW`s0P|1 w2U."zˆGh9XVceLߴ-LK0'|2n 5N|׏:RVs\@XA|T\xٷ%!mb;fod-;Jˊ"l6:z jjVVҸNfr'D\pc: +uGRJIPbt{߀-wTr3.2Kb>R\-)Ln8j1 vœ'F|'(j##Pm khlcyo˾d{wrs9GyDtDd-dp`yŐiu0K# '4t4qMM,'}nFڪ;@[;6}F@;S|> JQF]+dD_9 ,ߎ GSc/->$ ?m12*Rnt8cOE P Jž.E)zPQ#mQRwz" R ٘>&1 ~ j|O]xE\tw{Mxe<.| , =Xk;6ݓcޝ_b2&s]]!E>&8z] bk]rJ 2;5Gyaghǣ3et㓒-8C]y.=7$X%w|*SZp{mLL7ΞdCR{r@kƆ w̮xB+<`H'+AϮ h71n[q i+X~Kߦے(}, endstream endobj 6003 0 obj << /Length1 1385 /Length2 5996 /Length3 0 /Length 6941 /Filter /FlateDecode >> stream xڍt4oRZ{ڵ{UňR{-1"vQ.fU[.ҢJil:=}Oush{Šāu==mY(%JR"jJ~sF)/u %4Xr YE"(4H8@OF!<)~P_GLRP!0HЃbn0+ C"~H!ź+JHC<GaQ0Fx"08}dS'  +@y"Pp@(0#Pu8 $wѿ!Q0CHW+Ŋ(/G'"]ߝCJx0 )t5į4[Dnn֓WH Fv??uA}P$ k BPQGdrR 9IJom&Lv8@"?O7x!%#aX=OvG&,X ~>% F~%, twDLo@)&)$A9!Y ȿ]r@@?_{_rLM@- e0 !77rumm?P7_h 4@ip[P(G@@?z'鋀"0?7E5W$ aDz[Q@O.a }h`h/I ԏz$C@pod$Qh,!@9PZ3$ Q#/ ! Bɿɍ@"`hRsmx30ʈ򅝌#KI(K&9ssQ>qIqC'r\m"zbƥX%2䌹Mc ?}> 9VJst8̷+2{,n acmVn?L?803&D;t+CUM ij'%ޛYtZL&zOxY( SwXlNx-sSnжfҏd'E:> +/@7`>8ɕXP}`*EbIuY t7=BI<`CS'NY mv}HC2ұ歯P)p&..RUf]Ri0zSYXuli^'0myG1ϧe+{|x!SJ~ҡٿW>AmEQ&8h Q[m6J'N/$[#o&I3uF=@ ׊6s1[*(e g 0[UF~ڈ06EANՌpJcwCRFe?! ʕ EԕT ʹs5r#XϻX]o+oO' n)ƉPE~)D%("4B{7낅Tv-bU99]{].7Oss%mUu8!- jf>./QR3-N_}H iq*ͭ ,VH=s3>R\ȩ!*\z#;7Ғ+M76[)E0 SR`rp!.['I?ǘe]-A E0!ʵFjf=eSVnaCas% ' q%=^ׯDܨ?@;C{|ᛟ4JI2j&Xk{2*iv{\ls y؇g=|#OHTWoyH1}‡ C ,oĒ]}j'q᛼1> + G.o #>cD\ֈ֊:Jz]sš pR0ls +ʔ s~#On*oLh:IV0$>.OY:LǮQu5".]Uپ8Hw\` c0(mQr!uL'{2/ %ǁ{mm%wtK~Rif^;f<<*Cݓ(!`xڴ([#YWsGHTt|{ka%~5MoH9d?"nT"jI&sRG[x]eIv@/ gծGmNٶ9OghuXP~ŏd׭}.?׋&m*n.V$²6ZHwI>ocd2DK.Lpgꆜ}if Iz͘m>q;\+Jj?.B}N蠉SFl3-jvB~jIhI pcByXiN7A7m^BkϤsM3ꀏ9Qs p wf[ma5^t*ղ7ȞuPW[k&[탵eeY ykr nPob3F[>. ϟLBL#z^z tv&Va/;] r(oZ}:Yd_h؅ѓ^t'~2XCwm\{,QrКdۛES =ֈ %|7.;yͿ;0aM0s23̸扜W,uUFǖo2S+GE"{3= L%On-t |ۋL'GVR@U&, T˝{jH3D[j(qIfg3}4 TfQwc}sU>=Mdz! }Z. e0xJj}~̫Û4 J?$#1kN!2xEez:u|p;y*f?B}Z-ۛ/$nNcjtvD/('Dϐ1q{m0P+р $2;OFݢ~ ؃t&Nwݥ_-{{ՁuG"(NՆD'؝K).7]|>bczzȧ~T9_e^M A2߬?E今h'o:Ҥ[u+6V+Yݢv"7p 5hB:e̍4<}y8碣1mOb[nbV#J#>VB|Ӣ]Ip՗zǴV|~;Qvwb`Ǜ㊎M &,ޤvfkgql!Xg~q]E ɳ0(xEaV@Ό=xL=T?TyUBySti1 >\ۨaf]2-=iO{lG^?U_D⸶xX]xS?H0S8F8f^fg"kd>EikPD d ֹp]Y^\hm)LG]b}`f⥞W-ףy hڢ8rV>@|y1 zߔ ('6P&^CZuGM&< yqCFiOkU9[Uyʂzh2xv=Zha-CGE>|O}U+"q)"z>>c$Ikm"-_euEsGMn&_kl/{tH͈پ{]xh,Y F*hmFOFY[]^N2uv8YH3ohm"Rz2aa1S!Q>!>a5zZ\zd}XU Pվl;ک$uk={lfuX5D* ~_tw0;jej7viY?Z4%Qh@=y}8ڄ8e 3*KZ;[e<p-y6V)mYhM,Kqf2㡃T}vkr}gDNS,Kr4=cy~$ ɷqN;ݸ5vC5{6Ե;CG.VR~ЃbF.&}*4NR=켿Aɍi@4kHL{wN_O۪7]j3oct 7(DatwL;yu!gB#L۳ F_UN"Px՝ }O!5⏫?_ /(,*=\\_%Gߎ>~͡JFɆ 1"nxVŐٷG5Uu]g/L%#( 5f$bF>mpf(p{0 -DM_?XBw6ԣ!"es~;1,Vc${Ǎc\.(w.s6WVzFaDq* ʹFvŇ0/\]?)r.=Nj37藍Nto<"N`oLY`& J _p-x< (qt=h;..C9W… ]'cihڙ7D\7mqOEke8~ [j\K%m-[OklxEI.g15Rv4Ni5Ȝ+['i]ǵKdt/:ӚYCl.y'k{wg/]a9&eȜ' oKGZZ˽٨ΉP3?,wum\m$a:E{e!}kJZ:6fMx<aR_fwtG/l~D67S0KPm݅ K*'-MΧVQT/;YL5^.L8 ۸ǭ}(o]<vFݧqg\ fEńJ3/n8؈˜BI^̺vHwwZzd9ٜT̺}M|+虦!PeXZ}B:oaS 'B\9lbGސ p0)]S *,e۷#SLpK-Ln$м>@9 隰I\]PM|& $6~xT1w>.!-:TZI5&\aGɒb/hx-e7nu.,v4t盜Cr"ܲCxe] _d[D M|߳&4 ӇB9|݇{z ,fN^qc 9W;ngSe `CDL|:ۙg7&M}_t NRwVjN:á#8+|9E0גk)Qw8F;I&C ,W#C̑)2,bB{4 endstream endobj 6005 0 obj << /Length1 1794 /Length2 11894 /Length3 0 /Length 13026 /Filter /FlateDecode >> stream xڍP\kиK\h\ I_ @iCeq̟s5䵞\W,;ѳWqפP_t_ :Acu"1Ӡs-jUn,JW'>XS4hnr_eE}\MRNTjEuZX% w < B^x*tO6y%.ˠ7W֧\1hy5W~C؏Z2LtcoG5UσQ'd[I+l{K0Zkw@T9r/-Hҹ &~lcC] x=q?*'oÒ,=ie$ *0!1d4"4ߜLJ`_>C" qLJh};kܲ61.;Hoewօ{~t/y=FOӝg:. g)SyZR<&1|cw&-OQW?-m&;?8اN./zT+zx:Cicyi~ǺoF/tnOdKe6圳V!~-S/JwѴjxĴ0O[cn7lFq0hJcZ܇)lz\ڧZb4_*|| Kx¥IJ-/D3j}$ +~<"bkyD^Yp4[B!'") ,dd'Ce`PT&?g-$Ɇ/|pmHH9J`rPs֧W<7Sofܜ\Qq}暼$+qH qF`dSA zjW?'V%f|?]-yqwoE|E)o:AϚS88l1n͘ 1OUE3X}~ .[1:cA[V4vGK+\DG㺮ޛo쳿;j1M sr& ~WC0Q3cq7c&˄noV""j P7_&UT%~`,D^s}~눮d?eBdZ Zb K>7Fp Sgki81mK) *gXGm|GZ^=~%l5LJ:D(%ި[@=yï>U lkQŷHn1p'W>_Y=daK0?g CǷ. 9c$j,Hm.KI|kdz `e9XÀt~N;{rJKҕywF ?rS"\er6_N[za;hs3-K5Z;{̆w0͖ꊎ4 5&.]v],`7-נ< z14Idap'rdi{W & kl~kX2D{kZZƵ܄ /%Da1U9ItKSm ߓ )̌oPk_ʈ 7'uq8E8&U_Uݳy(/BJ*pLa:vAz׏[NR+jzW`dA ߘdvOKȪsŪ YRpGr Y}w*[Ū ֆ8.-m ?'XC W^U@Uz8x돋&FYu}2PHJ+|䒌74,%O?grTԆm6W!|vmkj}[0e^*b1mIUkHZXeߴIH(z8lSЦY9z$V27[iZt>[RPW8IȪJ;dw8&д^|ZDoΛ*|S߻y_QPDsPߔq5Z-|6Aϼ b'MvebFK>="I~gi@?-x'XT90,zz:}7> 1rwx²ECGIO3nV mP{g-~e gpbW}\kfC Z) lJqe8C-(dLp:s.MyC,Zܡ,iX ?G {)xкGC |q5/qv˲ L2+j~"YG$٩~%uIq׸}T[%蔀i BëwthXSkvTFibʉ6XuP$_W!R񘃲O:4LIB 8E] P6 GNص]aR౥puk8h+^+DqMg77WZR3\T#Gi4O"&GJRq$2 s֬V,OցfW>y_%sq֑KwUpO1ǑQ69]TkmP7j:#ܴYC:v\<KtoڇsՉaJxe\V|g7VCd[㥊iѨL`Ӽbp Obn {  Ї$@1{^R[Ź>Ϣ榴-5ˏy)u9DgwQ!w_z榎;*GPO.zuFnR10yEkʝzmRq3R 3lq.56vTTMa *Ѕb" 1gA.#'6f*N7a|$ r{(vEz\\N ~N^n,Ytk: oToe%R+G>kӂH~0p2nn i:X\ u5ܲW8 le?/!3R* [$3o<WP.$:R>+\Ĩ}5AShEߵ$f/(ء[9tj~?*NnΔ"A(10Btp}'XܙmDHO;`}/Rl_6o\) qZı̔E6(l / 䄙*ML|xȍ,Lł] ۈo{="dEb@1QP%(y*·X5C5A.}HEi&V]R{mX *+EdbdlU}ˁ\R>asr^SF,G7[ ;yP~ʙkL[bܲX <+EHUVYK:y>.t,7$a]9EͶ g]m̩]w8bbPg߽XMҀ0({xʧwZx] ГܒO(dWbgO'B~j 4S8 5.MG :wx$CA}s hhU.NwmCZ֛W^'sVsS5P1,6Mo335)?s" j(7fU O1AwS|<ꧪ&;lR5ˁ)I} y)H&#t]YvʎCoO<҈ }P|#=z:BOer>t}K<@x2ly'*b 2T^ y LT>LU!2TA#^S@^FmAν^罎QgHuuմh+Q'\k =Z/u*4Ōyx_1Ƌ~3AC0B= YcQވ(Uۊapag:`grZM ,qVd/싮ԖΣfueS)φ++ *ITy M^FţJ<eC`d-~N}$+V5Tr+MS¥r㷤oݒҡD}/Mw}xqa&"Qb rd4YtWTrw:SlY_Lo^ f$qbב.97o'owP=ڑ>?w9gʣ6TjtRziԫZTQfٝ ^I#1goN j'um-ƒ7}dz.+{M5jİu帝6جb'S d&-!A[י}h%K=_ ƘRPZr`I/9?zjtMsؚB7dvx}KXie` iEli],θԩM-'*f \LG РVɚ ӪOؖi?sClF>7N"M'4;fСШ}:-irJOϿetiwp81MK$)?,T6g֪#i죟~kb3ؘ Vo]X bX1胠`כk5_:9e;r\.G%nFؖ2sHqqfGs$SO54rO _``{ӆsd%e)d@ W̜bA3ჰG5ōqU~f^(W]ٯ2ȵ/ni^wB/Z > 2ycZ>PPk ?5%n>~K^.Kf=S7{b|D%hTuRyOoSR^Ma E]SM<ۿ"o$Z Jx7c_ĉZ]yT7sRjFEt (z4.lmE'? {uuV%O1ܗ(ԫjhώw'4?ID|*?hʣ5!j;g|[nr?[|(609c ũ19wq0`ZSUY]Ns6>K߆w:ɧyCBlga:M1Y΢„:P:c'!b1xz7 8{fR58[o#=au[ƻe 6zZJ/ϒݮ Vpip~S@ VS+^0+5\uv%&i75Ju`Q`[}q2kv>0-pՃsM>!m ehG(;^s״ݞ׾>Z)J۹#B-Ru|Nʝx?tޟ퐘 ({ * n%u%g2c}9u"ʚ1yzo:y;׿i6AT +Η*iFp {$\Gwiki8٨J8k$ۥ9H>?p dJLeM#x8 1坩[UO>o .EM<3dUSA/KgKznrmNOR> DkPX-E2G{RdJ̰_KDhljp56`e&ܷ0FuF$֪pmfh͇q?c=g)PuŌ檙h]V+ SP(YTj/6>vO쩸*$Ae>S7U%kpj?0HO\+0WvWd?^h -Z4%j}.AmεH^ŪEkb/㏻QT\N]oc A 'txpQv6 3vd]_sXq(H9C@CSxTT2}gT&^WY0%dI0m)3v HEݹG0 ml>99]'lÖ~ԟIلдJignCO>==/CY<+JMbˍY6b;Y)ţyl_nEwApW=eJв#H ,Ehfv-$ #zWR42`L̪ 3aYH=׍Q}T:*16bܔel}MgLbtGBq3ocNp{"I83ar^o k;]ຮc꜑bdFT2u* Bh6x$?( rܾosQ۱+honAWR:Z=l!eB x$DGGcBGL@f;OrO{ĦDJPr8 x@sV,oFKG+iU%;҆O1bY.O!pa (\tRRSA&yf!.THՂocKkREEaYs_۹xm d1;7E-Ư=*aSA[ Gx1 ;oT'Inz@DԐE5BV0]6fi:BǔA:}J)M3X:&wWAQK"?]ssAG">ta p O4r[}]̺AUzV"rjP]LҡǙ6~9XQ:`?cb{c3p$podBC۾5<Zi]btzԵtcA>lgQg]ATD$ joW!"t[\ ʏܨNL#,< xPVv0BY=;-p4;Z%W DBt/v*\g֜rN.dO2&a1 #-YIٔv敽9 9G*ƭK~[89GHw.YXkHjpa R?[C2hL2}ͱH.tzʬ AQ,v WpAkxNQ G xH8il>3~}y(K<%ٵ[zߔ4[7ߏqweSek+-X/T,C,Kً߹rG@n*N:H)fcU 뷯<]3QQWH+F,vr+B NaƯ 9%d:D r< EIm_m>Sj:Ah|Xkf8CٲU0o~8eq&HI=Ŭ[Y2 %IXq*;aџ(hmɜ[Urnr[?KSnKu+Zeܠ.r)HDY=_bRP(Jpr3WՠHqqyOͣKyC}Y5 tpջP['g^y7 5<4 ;Xj{Pd"t a[H{ZBաtP7;XpPy:Zv3Lx?oPt55Aaz }F1}?\$$ǿqlo*Q=j1@SƧXRRRڎG%ca!ؙE-Tyз4hq+N8,2vHO\̇xݻדIUpr'>OɎ^5ڏvc?2&DuM|nF3X8};Cc ԒA8p㵳kcM5հ9vI1vʹ[m0 Rej9WQMh'w0mhb tB|ЩӔv'C;kl9c^G֒ T*Hɲm콁K9J6&eI6e@Ic2@W$ASt Zt,B5BJc-_ H7d:7z@HLof'圲y[ qދUUǼICm…5s!p&ű34^p .X)~!Jnqs?Ưl^bbaa%w,22]3X *P_DO#mT\GdW >Ck99W wR_)R^{!멵ʸc?@/ce3=DKZ!nFx5ps5KI24|eɆ0%휧9g_{ѕjhȝ˝^7/hBK)zXZU47]'v`BWc6;jf1\fF9$!~'ܷvIC9]X\=${Id(9H ǎȪWo(Z쀑 Q\E޵*iQm` I :oK\ٲ>:cϻ0bښ';ҭZt[D?>!:0~#hl%u9!3`O=- 3=e/ssC^)\hhLeZƒp PYnV!c\^rWr,u|'L/d˪'F{a̵-Bڴo*+' Ô~A)hpp:WKБr*ʆM7W|ۖbPD {" U4_ K!(t9-EJ̴[<(]hW:*^ _>1˹N&؏s#Iҳ< qcs(FU s7zc3Kwe, NdǞSV٢.±T[MzV3!sw)n!H2eAvJ K pjr :}G˝*j!J3F5&t_+r<\2(҈|Ԭ{,r q} Y̬b]4%aNFp4] endstream endobj 6007 0 obj << /Length1 1403 /Length2 6097 /Length3 0 /Length 7058 /Filter /FlateDecode >> stream xڍtT.C RCIHw7HCP҂tI(()H*t Jsw]5k}߽<'a UEB@)$89ahg_7)!R X2 Mwg@辔%D #D(2N%7fW7 $));E 8@v`OF0 G ni4UJPS@ ey0"= 80 BBX3 p 0B|wwٿ ࿓A`0v0g(@OU[_@3 y` [,w x(0F `οFU{*p G~ CBkY'8װ!v anP ?>{( @P/ޮA_n~>Wv#A<4Ȅ duC#a^K {B߿߬ ޯSTDx|%b@P\ }g}oj،?b_-{e_uYL-[ŀ`CSoUnHww\`Xֺ A`uoC@!0wjAX%(lP0/(D;/9P} + Aa'BaՆ_6# ',vB"Adc-1Voj46`@Z} ǖAvG"ٿzAd!U! =F wS̈́G{Tl2gT?w >rlUt;^S-zGum!DUNdE}r#N*߻U]=h T5Cu[+ 2$MW эkb?nYq ^zΦ%zBY~}o#2P#hmZA?(q+[4>j7 =ŋC$+eV;]UbIF.M7ݓ:] 9yNƬ, Cւ3e8\7T'%yv3u6|w~fiAUWSۙoA&O吃n'V̤Y7µb;ZEE`Ṫ~qnL=ԭ6_vR n66 [-\Ҡ[^U~۱u6 1{gYƓ?/zS3V)ZpI29m͌ku$adiGk7 ^f_@:!=髡T4 GdBGгT䕅!+i7bFI ű dl8.e9ojN%{YwUdsbq"K V۵z/kc~'T5GLǔ/ YR]/qvťqÅm{Qs|9&K-/ІoV_7I Pii\qaP $Xt("gr_Vmp4XDd̑:0 DS=7Ͳ~MPV8y9ǁ }vtO!CV9K_e&iz{gXyvoJ-p{[l-^3NpЦ} ͚Tz"8>aZi̔0C&o*@@ꂘrfF1T^drI?c.% 'Gg|(;}L|~P{㗧Ϧ>HI t<(x W9DuƖ_iw܂"׻5$׋ը1/G:8KX6E_[~Z_/zmDJ\cװ`UoVLfRxO#^ܐhgc4(=opص(p=)r@]vtKO#w7%T;AD[:gse 20? A:Z^![4b!ZAk]NFr=ַVW*\bcVCq--V "3,j㞋~}[BFԲIaҀ~ 1_&JQcƘ7 - !2y^ 62.GIA׮y;.1JqTRϿqt5~;r)_:-d~Z?q<\bO 0]y4*}2π,Oo}gp45ڛK?km?(#$`D.` GV^d!M ^SQ˞T(ïRVPr6@sΓOи5oe"g!6l8e%ٯkLbyq "'\*=]'42}s s8B)O| B .44,$R) xq[Wd(K˻4[v}_|pba2:fX;GJZ%Q4R}@e[蔊vww% v%8>iذ61,PL =u2z^m ehaek'oIrK|#ǂ -Mrѵ2+h#i$vc_N*a ACGeK. ZXQxڑKJ^uC 鴮խw>hkx>GeX5Zi>"NC2 @'4z ~9mlfM?39e+( ( N<v7٠O_ݢbt2i=R6@*5NS6~Fg͑WcG&A~[1I<!?"lbP^_BWM$\~Qw[pzQEͿ~0]B6c`2!9qbAַ)L=,*CO~$=(J;y#:BL=M;z K&Z~F*iɧ'V c-΃ &[LH6޽pO \jaWo﬿ز}b|Vxh&_s(= k#2ZX޿?Dž|-Rx3O AIs~Ewpþ>&ruw#1g}aq_Qj[+r1 ++\U^cR뵛cڮV<M"gdb;a'+diѲ'#^c!ڵйxd8:rz-]Z/dP`p8O zf'˦'QkCiq!mK=uUf-2~ƹveES5edƾ,zuި '~2JNgURc|t'IR!X'LE!RޏCp{D2ȋ|\.vjy*#d t%8ڱVJbV~M@_2 g0ɬ]PKhUp7a e>!|N{1k6Nss;' ,N}mzz``n4zo>)$v0SRr(=zx$&KۈdewG\n[&o3yѺF--a%ԶX%t<$$$})ot_0,*.Vro2qQtyv_[T4CYۓX oUIǝvA{S;-TWo?ź^Rh~e!OMV&IOLI/UV𢸄Cpkt_I)uOOe<$Kj>c; ?A~Xڸ3Ɣ0;ؖ7ܻ6Ǒn4ibu*mRm9w%_|)(&dY2i[ V~Q|9Х`s]L1?8sER`Lz:>kNrU;s;m';G3x)4SjS{53+t?3Q}ֿD3{]? v. iyqaɉIAu!9)IC-)erW%\w5^#G+Jt>~u0H"Y-y .1acn ɻߊwoǵAb)?,ڍ#-7 k?SFj> stream xڍP -^$Pܥ[q[BSݭ\̽䷞ޥzP*0%l ,<Q,ff6FffV UoBh@h9ۀ2NV6  '33?6<1#g)@ c: Pغك-@mB`8@h21-oM*6& ptabrqqa4v`7-@{g) F*cDZUl]쁀7 d;po*rE[ /c _wa#k[#l0Yr#FV6o獜@VFofnVwy& [GF%2`SQkk @@15/`߂ljGNLj`PZo7`gfff@W ?ܫTUakc 0{+2} x89N@/+WB`aL@so0/m WXF/S?ΗITYAINqx0|b03X ۃQ2ƿJle֦d7^Ryc-@uٙMX?S#7߄$TSQY6x#ۼjZZy)jAln6$@@S%_l Wcˬ@`k6{[-/oW%T6CMlLX1Vvې$v.]$1lvVᏉr,@`ܜ&$h_W `2G&Mͬ޲ ,ofWCszoEXY 29s q7&пķ4%w7gF&Nm:~ѿoiWo.mQ9}yO,VX@_oZ99+[mL@g2~;5`Lշ<]le[݁&Nou8yu?_@+aaƄ7в*B (ŎOV?hSo t-oSZ$y8jydyba~w,HAUhS T#/ ;'.,;nIꞢrYħIp]iL<2XG"8ZsW7Sc$21t^l묑3+%xDP1'(=Dep< r{]rIґYA] m,?Tz1c+ ˛ 0+پDVZn;,'_ZG 5v+ Mw[^=.,:Kcٯ 1߼).>Q?/u*2ozbpdLUgR(T U'"i1 y. _!o}YZ!DR.A}4hWx!z}]Un/{x"U %ܖo?uxYhêp"aet/pZV6f,c)@N!Uʪ\.ll{ITn*ob~v-51jO?']%3}BAqisrp+uҒЯr}hH͂4LmPaWE_|Tb$ dDB_FA-gY}'X˃6ᣟxẋ̬ث0A9s2 ( ~6|{ u|,̅p|g5)kpɂWG80:?ڮ\>];I[DEHllub9`{LR}J©r,q#}6!];mjəT'V)⬺ w$yR^^>]d8كc /nV in7DƆ :%˸,w8@A+9(aUT[D2m%T*UyJ=CZࡤ!w]h82vG/;__.z6E]k2gAi!TLS X\ZxS~7[UrA ]҅hVEd2e@yu( B=uhe%>}jg f>VTV9 _;<<QM}WȪJ2m_ },bbp. <nʷBflRkJFj##X,ĴE}Qt}ƶ+E~l8-#_P1A-\\ų]ABdwƏ?c":R'K#VHfgt7>)V {7ssd9F&Qc:ޗfʥE#f8+KrrKˁ^(c?l8 Bd$k/dwFr#c}V'(jvjFi,Pg1^𱓘@I'x4NQnwaܙt67K GaҢT$[1FO*.qt&œS p bY")v1/n+>֦$ x~,6arcd/50U=)2Õ9@MsZ+T?O~|  ױ5uLDET2x ΗȩD17="ȱ Z,ݎEBo ލQȘn?xEW ̓]5})|<^Fכc3ʡ=V2 YT0H bu[9vT"F{s=(lV{X;;p~QG!.aw_\=YR>J%'B+w]iV3*cEn2żt.Z kL`(LD8x!$Z"Yڵs/ƫCoCl=%LΛgrkMYbY~`[ :콺kA&6:>I2qE#% 5cѮ;>#e#;(4%gн)Nрj\õ8_Gg6V@aP%^6|*< yx{.K( &!~)e=EP:db齕AI,sq`Q~}v+:Xvhu',bdȵ cN+]>zmt ,=fds)jG&˜LRUø#1J BYeFrX=aGx- y0v}<1xٯMiQXA cod; 77b@V$d]ױLRӀ oK6&8g=.6) >~omGhJKC,qjfA&%e;¾/Tihi|vN~Vr,n\?qwQvl%.ob "[L`+ꋩZr8&,'30ԓki~(T*t]qSׯX,5P֏wpZ;S& ď" z|U`Yn-Pu,vU_܌JZ3zЅZp‚}MP ܥ vIYdm9`c.#2v ,ϖg}I([楌/ȷTq 1ؖpO6ڒ6y'"E  ~Dž*O^YseT*Lֲs1EfBzo<&2m̋m->h(oL0tLa4ڳMm}Vwm>HTY+H$}]~HO̦Ls&JGEKT~|*xD'CBxIF%5 X>&V65ԗQ?.΍<, < 2}+Iwj2O)u{e<5G8ReZe{TLnr Į͛yEo&]1})Dc.G2M1{w@$b7#Pⴿ u= -(YJ["Jy1>HfC?^Ѻ`5;)["֜rXόGɿ|1FT:ŚܞH8cq~ϊVXוK:H&]`{Dud F|Y];>~ּn]2:H)~xA>EF+‰ҾE\GsfLD9 /DWWc3"xr*U-o^? &95Uq.|Ygj(A-&.q+tBbb$% XiXn˷|xxx&45izMڇ #=C J6"{3q4F5EAwV: 73@LYiUy'U2[1džH+a"Kc%GL)D~z-4gzVP6mh:{h TPJKqvAUy3=W*+̕|%4~%-U!iU`&.^_ıE!o#>k;oZ&uO^^6 p% ];"<è4J ͢qH#$-< ܔdFPQ[d!E;Kw n\_NasDn~Yj'jRKE<ߧ{TO!6Kd=PaNzYO˚)?ktW:4yMn(+OETع:!"ȺfSUZV 5z`h.%w4ء[AX ]Z| ¦Ң y!0X 8u.QCSd?Ў2ϭh( IRtt/?VOΏK)qvhmk 0TI `%|L'xwJܸ eAu0|\q4e"tHbm;vPѻW2:V hQVUUzhQhڻQJ D7/OP'X,ZK<<BנkCP-kGk%&mj5 zcG_P2E,nϔ^Az3N FbǁCK0II';&(W)g6T&e.|h'QߒgۼXe+ET9Z v@@)j(k [R-"3 n sE;NP?fZ xocV7(qUo: 9{˙@ wl=V[Y.F=up[s7<  Y6΋߅K~;HkZV;q\o50իU%WP,/Or-a-˂,jEgL-o fGெ2_vZ]s.RQnA$ON:Sлvn#}bڂEHS vѧL+:\w#[̮|8k[_}z)(*\0I$c}cx9R1avE8؃ XUз!|BH Z8;?m6<%=f-#-} 14.}EZq)R<}-KJWE?l(3ʅP=UBci\V>BF)*aI6q%5e?p+O[KY{!;,g4'\wOA$.?ax6Ў9"ݲ{'ÒH^Ѓ>sm@GSD@t͆y7sg N%VP;ͷ- ¯̚١ee4&)яx L(wƱvkbQ)aD&&w\2S$R,Ǒ%71 ϊ0( Y;ϙ[o{[D -nN7_ hRd@f.r#"P]=u:f`<@ Bj*7>e2MacIlQa`ZjeEe!7esus!;B1vw 0IwBZsz3lƝ߮ʧ~=^2‡)TJv]Ÿ dFH$ O;")H: $Kt:Mh>N"4XC%T4 ݏk @d\+2nbx+ȳ}f("r|4_#WێFˊ[0`J"-D$ z$,ãt}(G7!b*p~&ؒ-EDtMɝ30)2,0j^6P`*/C )`ֿXf!~( e8i(aq#;F(OCЄjچ&lb91_G,~Gm!XZ.&FaȃF$Q7MCo7M!m<ZMǗxWq>n7rϔ \㴻C1v,|iv憺n÷kkjZT]w(Cps#C/$YqW ͲpUm_&UzE@FCDex< mazLrCHq@8D}\~BGyb.f^fab܁s'y/;%nbdjv0 M&OPN~R.|^^ZGx=멤L)QQh Ghd :eЋGa3*|Gp/k$ave̲Q6O 8P8BW#ɌK%gX[} <ӹ>I/T7 jz#=M-MwO hŊ#+Lq߿yeԛތx7"}p䇕MDg24.]s`#L,f; `,!R'Mb,1Qk!TKp!S/3FC(ϙԼ2ȤaViGbƳ=KS'f"מ Q*hS˛In@vLM=w>rLn4AwfnGUؕWu\4`"I5O:^Ү0dB̻굢^(tyrxb2f6%Y Cu~92d 7v@cHIZ?$eM9^턷_[U|gx1ڬ~ۿL/p|+x=@ஃk@p>c"CȌSKA7B%3N09:=Y" hMmaZwv ; wL_н =5r 7zL4"ϥwAKF1_W|e$FH}ܔ6,l< C]ogEyZTT1ߢPuTtR2 {>%t](~_@:&Mx^!H>OPLY u2 O?|D@jovSaiT!NA%[Dczd Lȝ{}t#JVBn6Lg11ޫWef mS,ʓoR# |_=f)K٩3B9ϵ28m!>b-7߲1=I>ZE}O[:]m1eZӫW5y"htGKvmiw1>;)Dyj$;}̵v``q8ٺy]?e2=#g8" vƾm8.kg?7,K"mjEZ꒐/3Gs%Gr *\+2i=KU6qUq<}KoYծʢNr*sD[4`oHH XŪ6W=kY~ėQOH$(Pןڊ - (x~)ů/ZWD^tUHg&̙ ?# GCCy4#*՚yxؙފEyXT~KhmPK$Dp7Vu^WUpq3s{UftBDmY|d'%3.8p-Os^ ܢUnv0$enm}`5&ODo.QT]䠸I3k2N\umzZ>$+\@[T+5ؔ@GSfG0@j^-A `,[:ʠVCFGvꊵ/ :5H,g Ztxin5_Uh:ؐGAZs,!;js;&:6?eT6Ǖh+EzE c%N3{/iKvˠh(,ܟN;^ F|34s؏( ?(zgl럯vY}{D2UOˆ#>z5*gRJ/ƴXxM~OsR8l s R(D%I B꬝Wn Jq|,4! [ߥ94&_-Z'2́wPEPn8m{5?ڗ~{;`O$dHd. 7+b-1"~K=N * X6kY၏.XܬkFШaCwZ/A_ǪMHhvfiL5˵D^|V]S YT2 rKͤX9>:>v*Mcex&Zwop+^01C1cvj { T"0;MWl`to[yqxʸp 2`9]Muyzi'(S4yNJci~n꣎'Y kwXۥXX)֮( Jyf`MJ{N:  nxW>Z~2{4-7)҈YM7Nv>݆2+Wq>Κ:Qa@aUc%VX'pi1744l ½e!Lz ;^6&,I,#R>E)q(0Ō ՂKp啖D;:#Q-rZU]>NA޲\IO)\(i,簶 hˤZqywz g~cG &5Ki>\ǑڐY9:=k٘rӃ|AEw4qUJ:\ҰCW t0 dFߙ%43Ahb0 V21-߼`<ʌ!eMV"PHq JICj\ 4?dj#:mE?ӄd+PEGU/U؃%R+-@ִ[K+iݶxзq ^1Vv?7FkVCO2 qjwcIo+5g[ORD,^bA&})Orzc0ݪK $B~P2rO-j"0˫Y+\Pm- endstream endobj 6011 0 obj << /Length1 1408 /Length2 6448 /Length3 0 /Length 7411 /Filter /FlateDecode >> stream xڍvT.!RRCKIHt 1C Jw#% (HwJ?};ufxw<]H!i 3 pnN0?y p{_(6 /+g0Ap Ptp@(/C0@paP 6+3_G+[HH;@ A* q "j; sqs\8a/Y @vv[~ x r)eq քYA`X.W% PuC2Vˀwkܜ@g@V{0@UVg A.0? # $J@wtwDe``(w~g\jC:[AVKtu҆B\ [ ``8 x;6\ky:(È}a+D `_rή`_ X`k?0/1yg 71[0 KSUQUGOVII<@?U @qg5,UZB%ҿv{,/+^XCp# ?M?.7v #joG[hA{ϿW!6ߦUl quoIqx- p {!PA /b, T`Jv @ OlĈ?`? pqBap Q/ {<.+o'BS8D ??rpuvFl g`,B$ض&Jʝc{Llq[7{#2#pB2i`yK\b{FHSz/8f/}XO9$9ء6"+28S%r-]y7R@ W$GvQ@4rzt85sSDqlؾQ<3^+eZ<.( ȩQωF&v漋 =E h,sp𼯄hD@뻫Fڸ$&Tԓ:ӫ>l6 WځwڬI4f8ϳ ?2bjFrEuz+.Y"(r(J՘D^۳a=jMm}.V#=a)*9uzz;u1>!%h t]Li^9@UІOj&)C7G- K)u`2>N)/']Ze>Y/GëAw I,r)ƤB|&rV5)]bfRqF}c^RzW[/}7A<I7>x#'EgzQׯ&nj d=bVݘ2|&gKD%\;-Y62H E1AߦQl]3*2¬[>t&Ĥgl pě`,ɞeՈ|gZp CubH8X|'ǭ31E`vEd%*5&f}f);mfU,oGm_qLap Rǜ+fMK=+QS0_QmN+c̳1=+}QxS" ׁmA}o"蛯H*Ѫʵ';kzM| }78sVp4tH<6< UsHdQxF"V2 o%|6bS- JS :2c~ yq#j!;zCyzM z'oea?Uʌlg/tr2t\N!t;c} /?|SrAЊ%YZEb!xzn JfE>[+.f䏨=&KږkL&8`w0 54&saeqq"1D}% E{?L=9+~UpbgaZ7=2zXZ!BE6q(_G)ЊQy4e)r~Rys4 -xjvm}֤bj#?sR$_QOvJO= ☗rLY̸C#𒰮"SU^qu٤IujmRy9@YIjXP`{Q{8Y(`/'O. (hHl+dIV4Tn^—rv= ! gR}n#$A!]13W6t4r 18O}QWՈ:=+eC c6'Kc=tUWr~sm:HvCȲJ^^vJSfF4RdxT̓wxa&FEǦ` mb",L؇dܖ[ !5x"\H KyIJHF ~z򝞰+]7^BZͦp'ar MH}x|,,5v"py)q.ش | 7O+YRArvw qo"?3EpTPxH%>'L;+҂kP`}/ }TU+;1BzϖnægS? j"1>_m8,}A'v=qca YL :~G* %MasqK^'YځqqXKkƜBr2jAͱ=%zfA+:[q-a@!<#\5D$fl-}c.de^O E /K{ ۧY^hWl~rG%KҳrPREG܌[h,oS3 ,bHs77ڽ]ӫ~$:C#2Y05`s@z.2hQj "8}Hé[]~sn&bJފg\u8 Pˉ+T^c&dF:𶂤r}krT\ vC ǩVe)O~7ZʤvEͳSӤfȨ=8/eq *EϦ:Eb : IaZׇƖ'bi[^8O{4+90]Oj.x|?xY]#iK6LhזH٪lIZw#eDQM]ⱗk.FQ:ߗ9ZEM1 `WT6T=>P{+ GwiJVq)ޱ(bN姖)x|ǗdˆZnhZ<0[,~` #־ bhM ;2Q,[;XE>ʎdYWY<͘%[ ~gaK ǬE(P_`3s]c*]=pOyt }JKhEYh~snr(HA-mphOb4,Bw аKp$B2j ! Yzk', i!$N9/K,I٘աUbʷO/RfI5ڠHnr&|ho37-B;̀`\KAfZ4\Jv^7jCp{p4˯vfsתFmBg졟 ;V;,ѻY OIPg,xO_TȺwov ԡu{=Ji' =x=BJ\/eVaV 6,'d>c*$6~xW092*헵:R~fNd hd BxJOy#e M7VP_I&iU %U-"'kL~!R_DT/,liFvM3Ebϩ?=k3eFUNNWr2[]ӚCo( n+]Yr; om>JwCR+QuEm*ԓRq1[OZߖ|{6APي0*U Ae}YkN_pp?5⦭2퍊ih_>U2sJW&Øຎa"Thsâߘc=hz?r1xV:4<:$2C"y\6I<v9ٽ=k1tdnxz\ev9)A-IBcv%9lR7P@n) ?+ S@/j~(A.JRǏkUr6 ^l~dn9x>z[/ J\"yw wXP2D66t֦@/FjYϥyxQFXaRw~}ۦGibv0kxk2cgj)gp e"';x <^/7;Nc:,R2@7=P>FR:ʘ˒+FJBz^kjsP|K{2"gg8}L*͹տELeChY bKhi},*=0&aƒʸoMo;Rs#`. rnA*1cA|LG%,=zA2YhH߽++.r-eW?볖MmF12w7)K&7b-3=du_(%s{b-Q!=ݒ-PcR-;!!;[Q_ZoL8/2[|[eǣJoQa`L5ӱB9%,ล=[f}|Zhx?kW<1V -;tt-rʛcUNkhej#=:Rk&Rl+FZ7Ol.07)yj 36%2Hxbe vY{(HV| t|F>^Dly#~z|zDJn#"4ԛBXӇ ^c4~S/Rg4teoSB% kRۖ;ҽCЫq먮xw zngCp~bjx`㊰T2"*$Tiw#q9켖8}ڷ?_"ﹺhfT* ̼/a'̙Cݍ*%b16ўR|45M1(f[l Jiִ*g}ҊnEK1% 4',z&Kv\u a797t%ovO fϪ4]Z|Y O%HTj6\;d'prRƤcݞq'!|:+$y͏:]/.Ioʬ׀Lu U ."&ψX^mS :G'ε\D`QV+Lﾝ]:\dE<=wV?צD[ɬ4L↘~qXᠧН䰖nB{u{eTEb ?-q9-N(%q2mEor?-:#'rݪ]`vbMZ_׈-kg4/ :7)s,iδ436LP~h>;X{ӔOִN^b3h!)ԡ[t(,j5~quVt]AHn$XhûTnϩ|=z`fq~TW|% e9VP5~!]v_N݋'}ƌ¶ZE*euQ%F:O}>\`*a7ͷ0;gE='*x>]Mf9=f"x\~Ewq`]rB'95ebf@2ic:h*E͝j?J"L8]#$Vַ"g)x$G31#seh`/!22I&{8efx"}eάKż(>\[|ʅciPf>{C'|F}bQB\kL&XPG_>~ N(PolnEXNJjyw}J0P</\Y}H>6pMz++A%hP"H j0#5z$)C76([tPٛs̵w =?|~QcPQ9Wo>#zp-gY.@+PYx^~w;Q,d(b$CSJr]_c,!t܄},϶?X8 endstream endobj 6013 0 obj << /Length1 1408 /Length2 6441 /Length3 0 /Length 7405 /Filter /FlateDecode >> stream xڍwTl7 #F)a l86"H "Rt#%R;w}OnQÐ| )@( J 4  {:;AaNKpDy OPM-00g %$'Ewpo)u`~<^o?%bAA# 8Ca!Nɘ#hCߋg,=8n 9`iQ|Pnnu[+ .65G(H0fann"S 8@.Q/Aa'K*Ẉ4Rw]Bb0!ƌ#1kAa0@Gb\Npy (o " S1@ ao8& &ACgjyN͟s#Qd\١+,r(|bii lM5|6hb-8mXюbDL6`wj$ μ{#f 7ŴI.&MCJ> sX|nqS?aJ!؍.\J8]0g{{B9<Lp4mg4AMNu=3֏G1)Nz:\jظVE{O^荾x^+ {{vV6&FUȄKq2nRΊ~6֗/ٖ?2y5㸆2,i>u$R3o3rY5FHn(oxBLKj w K}W>u%/CT5>':WiYIz /v Pkfq DjO]WpJxd|-(-niRQuϏ:at՞,8 ZmTNg.n4 >UGf)Rz6UÍ}oa"7GJ=|82 ?y ]_b{oH20fmtDȱV+4PV1^G8Ø C,E?ϭ)ӇQ:I7XY!sΡeeCsJ^^Pt^(@VKDy+ӎ3r 5R@CjIf4s|F LnX!mc5xeU8P^1LG­-gSeA$p,PM;ظ!w)d貲⨨Ó;{H5Z~UFDs(P]FOܳ37ʽG>%K.->Nĵw>KՈVu9@)DA&n׸ r67N_q'/&VoY&QFpolJ1w\SsegEkvWX2a{\׫B*mhz#m}3i&H Pˌw_;Ezko̰SsQ/gKhj9Xg3]DL%<>YE%s_eskgJr'diwH %xgJ =2vR^YCBVz( cyDQ:K^ZKszZZX #x'X%P o㥢y̩onz㹊wUtXSЍ,ֲ*DCŵfӾ 5 rO 𶩎J}8<ٍ۱M1JMhN:~Jef\0)=UZm=jm,<\aa}Zy%YmjqEacz*xoE3`Ë,(ϓ 剅G6͍ ?BS4v0Ö(^6'Bt ~Վ瀄bۜodk#on ,pDvvtֿݮ9/{ѸTmoWfsۍ7="KTxTP~:el ժ:|>sR+伲4Jew!,Q$Y%yUa%uxwxWњHgty3#$VaC!$ EgŐ m2ӮP`M@\'~ߚ*owSpaW.YAeA!C?#ν{#sgEU6\'@TYZrwVIG_LEGX5N+$]+b#[/ڲ'w+#kgZLOTOhqr}rlƷdH~'pqG{< W_(y/K~p}u8prܪ -%OG⨺Ӻ`ی>;nݖ ewR#TCI-%`wZf$O;" Kz4A6^eLhZקgGMbI!Jjy{w,fS~ Í 'DkZmV &!դuz1B5/1Ug>PyuyTڤ?b}cUKpLxL\݌7=Y) =ō'SLҨR_}D7cˢYLIZR%DsnB4-|2ZAоJꞁxLGkɧY#q[Luѵ˫X9]B@*F{`UF;WJNUBKk_ (2!lFI+Чmcz8f{-?qTU*~59kl7Tfipl\$P!tFJU&2_ho|ڟ'IkB.!LιWFs XCQw'}%| xk σQ Aѻ*ء/w37?-jE 578ȧ},.[z( l$UR:G^D7X*yEth֋U~49V@|]xPS(WjCS&y`HRi)Ys \u#pVgqڭrX'g^L;u,zYO&ʳE' 'į{7tu3=lGHb>dMyxķd_qz٨D*doB;͵WBK%h[k^1%Mk|{$ 8? 𐚶 -5RѓHkb>+ bWҩ5A//L.1 ^ԐR'j1s3=7P!*><'v#b ݀oOl -Vs($x#kYݗ^ؓE.%_F#-u女6Te&;S dDOF뾕G\IY{m? 5*s ݘqsNy\HM>ܙcT}f`>_;\uR~,gOpT)^r?/BQf߷+R;IcJMX+u|J>1+2tYfaZp9Ew_K5(<9(+Ym4$}iW& +{ŹT=@(h$4':VՉfBnјb+;;"Z#l[ 3+cpږ^5H}o㟗 e bdzF~;xE`޽7]@zU\Ŵ=Wc%zG -<̛ {[uM0ͼg½O]ɆOqVB16vea?ol~VD6rTYvwq"n*bKHqHh7>TjdvT$%SictrX7Xw#%HqY޴Bz>囟6Y]\ſ IW+/5"VLNHfbjQ)ezme-@S<*03.)ɥBƜ3-D <Ӡh" 95}LnHOhrh=Jͬ9뫾z49/^Co]Ѷk AHz~\h[adRsq`TT (g[\̚*pu e)ie(7yZp#c2|m.Ӌ/فcV~A+ǚ&sĆa74Li>Ū4]:+8V"WDH]H͂3x7O&LVnڅi;sldvFçTvyJn]hCd>C5jFn p4]-+bԆW串StrKG덏XH JOY'oRē",:S`7R"A y H\q,f<]*?XLf јl=˃QvRҥL0]>U{GE {5yRf{TΌ@wHyѓ$+a1]%"p*BݪtR?Jzg:B ГUwϑdllSLl-J&ԅJ .fRQoƇ~3 +[,c >W7Q=@u#݇/lV%!fšTn$~XK͚VgKzanxrc`Y!v!Ibw!5J_[ILK=o_Nv,Ӟ4o @4L}o'd)])᱈bwomߪhhﱗI͵eWU&`-{d3iDp4௎}+l/6ZF692)j#NZ?E>ҁx0 \:WxBVS2j~o~#cu u~$& G_*J׃;A6I QX ?Nam? c_b9jtQ49OHQTuq )zQa,m{mcK,q*h鴉7< |ǂӯ?SR7 endstream endobj 6015 0 obj << /Length1 1633 /Length2 8330 /Length3 0 /Length 9405 /Filter /FlateDecode >> stream xڍT6LI CI334()5  1CwH HHKHHKI7s[̻g~p١l(?D, TB` 8Rx8 )BjZ($PBD%!b`0P "CA($r@88zq!b|́rp jA0 C뾣$+u@y8Hs}^@}'nU.P ]h|p pAHO7Diu?ʚ] "_ֿ!0 G 8PGYSϋERxP(jV8,:OSB/7KVB)\]H/OpAD"H;_%ywo_h`1 0A_0:@7]<aG=>p7<8Khym$hnGFw|Fd-;+h.oJ^   P }](,ت!Q@?ɢo? }o_(\ X CAtG7PW_(N1xh»$VSJ}DklM{CH>|UnX"[?yd3w*(kY;S8Ϣ^ Sgc-%u#~އYzY>% D̬GLUgreb)@s岲 ʻa"D}E?Rԭ*1YFXhioa 8nqv,rn侇Ep|/uZ&,k` 5)sV2:mʝ>Lu{v c͸4毚N ( yFdpCaAxn9:RRoF;=;jH[ R.(}ߟ= %2>(MrC848N}nV4F|i09"t׶^j4Lm-f?!{EKT`x5 i>fOApSn|@`B{ F;HܗEg]v!iU:eJcɟvS8A]ʹkh޾~ f)PyY2Q{Y;G_%i{@) Tca7mRfRorZo^sWd'!oN*Y\'|Eo&ۊe@{2up+ 짟2$ެVeFMy.bb8Ûԯ{ nȈ|AХҏy],)sSV'4/p$*n;~OB(ɪ՛A g_2WV.̣I߫^*l}~C>ƩdM\AMgWŖ>SN]*xrp^;UECҼJUބ{m X $2 G]&|{@hW4 "Q1V =?a} # ̝Y,؏2޶=J)ec=hڹJRf*}2Ae$YpߞOSɰ|G>@ozMSoނSpƴ$D ~}\{|~&nj`gԶEDxDZ7, cF'Nۥ(ukKpN /%}27vr-95Y|mYl=}?WmaVM.* _!Yvg檅F}f~?zk2jTXjQdp]xU)~5FI4~9DkؾrKtj咓1:픕?mrv?p&h+77xSrXJmOޔ~7rȻ^I['_9d+#ɌZ'yIW({G P> @lach'8z+S-V΄{"!$yU$OjyY㓷Cw3]3d Ƃ\xj*R뎯]a廹fYۊ;Ķ?v<06=L(jV~1b_TOg?>>A=y|HEkE/dJ*QwPq&[;73"kؒsɃe ԝeKhen~,)K?{فĽ!м,e-Yrr2_?kn,noZEL`P4vR J'nW߮A?,^nPvUALQ <_nwd\i䑎Nwα}p2ʥ(ŋ[a'HOM 褹o┖D%0P ^*Z{ \c&[v:P&rYM֞8%M9k+5P,'(%!sPU?`=x]@)D eCȘ G.{}vĦÚiMմ3 >2M.+\)pf1S<~fHq.\nD+"b!'ˋE/O|R'k}s5* ;mqDq9:?ޕWy,[PJ"ѽѵ4@,qyxF`xfQwWr1/3))۝撋Bb᯦lkؚ0(0WNRZ/>#C+#;҂*(薓:qRq yr0a] 8`Ͼd8\C;ElQkQvQmt t #+,U]KoMئ? Rm,B%$G*(?Ɏ-hKmܛa|r@}jŲ^L-UgKFMHMQN{I+w:2 ҟ奔n0a.cJ툹?S-Odѷj.B%uT7"/o&꼈рB_nOZn$δ )SoSla`\r"bΘKv%^Y9kR:$%e%z*F}Gz ~2^WdfwK1W3!#mqꯝ| GV&b7\ :U=Bi@ 4*w&Y(FAzlMljN'hZ3CXW*GF'(4vm&%qym/m/$s fa j^!yyrf)֘~tI"E&{ abyҲiV[DE!ַX˞B*#͋gǠ`N'ۇK~Gg7:j^a&D/.4%?u_#l0Yze#lLZCO$4B6=tP3P KrDyIJ4xni)}94s,.F*;~UᳵN .i+#ptW-9S3V@3m˨pI lg&;n,c. Ew\;FSԯMe茚+Xn"A\5Jp L{/)ڔF֙(,}w4S]!{¾>t*5CAZ7Wy!Ƨ›&$;K&淈ҼazdWT%[/ /҇ۑgq ǙTfJr^wܑ+/ޣ1C9)+smAz"Jm>57= *]q4M+*(zK>ǰSm-3.V WGsF'Q3yݹB9x+5jՏ{܍:b<؁r2aAH"& 6_Q. 2B>I_-o=O_OYZ?-SjWƜ٭0w`f"4up/20}.5k1};B찚uA 4H `icx]w\X9dukw^NET^Dqb[7ֺ|o,dN[0HV85 8FIXɋZ[(Ǜ}>pwIjnDdpkud~ehۨ E$dK}ݜb@`L ]*Q BWel L9!aѵI =ͭ[.P]eD\5)/"JD4pU=[](9ȃATfY:B^'*U=֭jP*ÐPԜո*GSqP^μ5)YX,ABi lGxnb?CcGU](᪐!mY -=vq]x&#I 8#3O ef>u=Tq[h *2I境<6U}eGʫȑcbX_O[Pdx8&^>+k[KxNLnPO!MbI[92if8?:O ;ݯ*xD9 3dFwbO1U?Ds 2;YB7-=̭̀CkGj 5>Ds+X:OphUhyԃ ˃nBQefDy=8 <zf"TMp)9om:C /`'p)>fzCnVo;dؼ} ےr p{H;%$_),F^;Ł@k_C$]Kµ ۞" FTd~ϰVnlH7:G1-{CyQ5z'Jmj._7`HGn,&>]另t ?|E4Wn\ [ˈVN !+!il^ <|`)Td%m93,~)m.z*Ϝػᨇ[Tď٘aڡ}Kc`-m |3w# Wr j AS ]EÕ$[4]#O?<XtC9w')Wll͕_?aiܗ(MyoE*0,5{usԏFA #L{^ +x0yjgq(kơ]|5Wy7SSiH8nk"EcG0^!\T.׾uP V؜9/l5 ZMn؛ :rX֗*h:oTyy/GD ̀)u'd5 *lKEV;(w"zB޵.| +۔\鈳 l2WDώˀ":Evդ<&YڻOQc?ͧso2L5N9Z|m ba/I\6 1TJkԍָS8w߁pH։VU}ܫ x)3+5HWI v:ׯl$hAqݒia AaVF/~}_z{JCiMX:K)AU)^,DZφGpKwO>gEn nmD,\R_ nzLfo_@~rj1Zce=/̻!r/cq͑mGO=pyc&-lj;م.ְSd՜G:-ZSc|(6;/1LuxA-bF4W#nzj!ʒD8~38e 6#}68 ѲၶrD=Y\rP , {BdciT,cryѺ5W.c]Q=zkST|]]z)2V+GTL#VB_۽1 bn/Di$ '1/?qDT7I m`%US_4m/c9Zh<22pfgp n?y1&F`%L*0?_ BQhRn $gNf*w:d,1FF2m.1HJYS[̻;֮GOrKkt=!#KK q Y6c<~0~Wƒ<vSrֹ~i*ŕUzb}U&;#tt [Ps33x\wr(Nt 4j;/nd5eíQmB9y i$l_?qzA#r"{ew@I)w}bah‘<1 !iy2qp-2Xu\,* #QŴ7O3s߀,zU֍>$Z's/:;PSJ3j XˬծE>4,6˛>ll0)! ɰ׏*-[> stream xڍxT]5"w{@@zo{PBUiR7RJ*{_ޕ3g̞+@vPU$(iBB"BBF0nu!PrPhLBCO8(I%BBe ;iChChO@0B <Pw?!~;`+ C8ap(@WUK_Dy`p;u@UABWg}`w+CU0cVA@..PW~0w(}6F! ʀx #`nP ?9h IP7(k#_Woo]C+`.?=@^P@F0?050Z~@ЯOVhA?-T547俍H?_BL⢀?|5H鯔ן w,$ZP?B$$*FrS(;#UO8c2D@SM6to ZBa0(D;?p_!zHد%$_6ѷZMP {_ 5l¢b;kJDO%[Avk #5V @ pF7ځ B_Iy¼@p(pa @}uGѭp_ Cltd8SѠ  xQ0W?}\ѹ#!kf-] wAZ{C}A>P04,&Zޛ0J[tyO(c慿nڄ-f0]o4b|1=ϣ9Kiy( 5Co'L$èxzA>#%%gUxWm@9 K=*N!m9 j32w O# ķg-|,e|!']@J2!K`R-eb÷J .KXK?& z%x;(}2Y\:fY6&HHӘWΦ^88uaS1pj~jO"K.̵0bqXo\e%Re>TӃ3ڛ_I4tXV< 쁕1'#N? tF")'Zvwj$5QCh ms' r޵IYK̎ƛimbd1 W$!"w/e|=_!6B&Q&AГ[_Ijw~m`~((gfh[u?ְph>|(>xchC^Q}܏ggyf Q5C2:ƾvrn?>$Pc +7ċ6+}ꥌ6i6w7~#Z^H_vު9pQ榨 # Y&2 T&<{@FF`874 v-ٞ6Ɛ~Ws=;-! /Ͽ03de6ObHYˀ3zEi|ͤkwTT9 'T.tr1xO!CyGirwk.r `(J@ 2u02g,wcLIsf@zc4l:W*&k"ٙ~Hj +v= TBIgT-˼ RE 6}9k\gm TJN,_XZqy#o Y{ Rg si&mrs[ɨ z֘esYE~u?g.HϏெz#tU-{_ǏZ7ejb͗TH&^|BW_/[qiJ+t ̂#`M8YNHjї:_&]: !ɍ v;aj'$?9&Uv\<^/\ULܙ;!lϩt⻴ZmzAr N܍3vf}g]꽛ric@R"R3L"q<7,yߎnM>B a{؊<5~GGX{Uk,/A ̕VC|+Ok h|L1E҅/B^ef|h kE) 0`xo|dS,ѭR0hѿV7yʿP4[a.ifEU vPiޱ*H"S7ʫӦ`{V"`Ǣzq}EE{ZuY& g_gTIRt3kd'=`ΘAUŧl;?5%9VO,[5ibqz[lo$~o}rovY0 }Y@\;}"5`x]wуюӹ8I(b"&[KcIC.w[.7g]a^-|rk[~Z\!2kzӜњRaI+bܧ3JlrP gz=Y-ŀڴmڅ.e=QkYv!L.a0bG]BާLYqr3WyL)*ga%iV3RfñԡYszJu^:jbE_ qr )7֛LcJ*!~Ky6{2?X9FiiRk"hk&,7E+bOmEHeϵ!{BJd^TF(x[͈u%QLjvc^4O (4Ⱦ y>R-Wc:ab +2El>y^( kUoҷBV<4@xx0ќuK/FQJKݨ'͉=<{SONU{>Nwp/yo4ZX" ziq+y2+P(6O<8GE^:$YR, ?(fN1u~ W"hz;|sZLD=ܭ!2~rե !4BhNU6]k0@u׎gLIfX ï6 0!@ͼOx!?2׌+nowA~a44͚+Ai uc|c=!IU<%g5K^8+ ,{P*fgm}-Yz0Y'_]pGa"PxUr] ۡJA3U S+9@sU6Ģ"+fngU()'[iu{3z8H̼ܱ4~7)U>=;'|ӆ=ybk-^*L3AK}͏8@ 5ya;M#wRޖP/gkCdh*۳Pbl-6x%?74ˏ*ߥáᒞ饬Tр'넉oK^xRpw KZ{z0Q:uQp7$ Vڗā ?t!q88S%<9ī4WoK/Jhc۫&3Wƛ& jC:x;X•Ŧ XelH'[`v,fOpUDLaܜ^eV;!c9,m%"՘KE@IZ'ajӥի V] $ʁ®s+l&+ts?g6gg6U؇`U$MO~MSOT,Q q/پ2#sXѥL1Lah3tenJ)A^dwwmR8]穒ґG=Q{jJҚ]+qnrlH kgnƯ #thPZ"ѠeQmHKNW=B,پd+vw}ޡ}YD|/TK>+ɹ7Q-ʼ U9;WӜs}Sgو1`whD4agdZJU-oeCΖOlwpCp;NE{촟j.hO.Ǖj[}4 bN'ɸm*u;L9Ntyފ\ѫ(ݷT_΍_&ɌܽN rFTE)a=&lE+9.{RNn=:g KG1=4ϟ1Ifݮh:xxuVa;$UV1cj!MSEM0!Zցq#PC2!+1OOsP&o+*;cj=B^On~N5ʋURswX5&bLx\_$Z*m/\NԨеehh/jĪGsȔ&\w6.ʅH ;mcHi{x7!-JYfGځ\5rLQإ=[:K7cs*RSsV^Ƕ >{*G$Gp]w?.~iG Ti#-K5Ɏ!NhnJuRfp uGDNJ.ueM;bUqg,!6.~3@ qZ!!%ȼGOw64KPJeBbXǺ4={Dne!΋9fy 7ҕt;%S[ﹸfIXb5Cbؑ9gR"yԆz"a]%gϜֱl/A/]E+7gWu,";vmv/zyI:˪-GsjhߔʿbNY&DzFL=k[:6Q9ETB>--d첻TP9ߩ,1kq~4~^_%Vc3s2ZY3M=@\G|>#O=<| sU5I#go9m p[w47 'yHb@d}[ZL2RWtYo=̻f,ZE(EsI$zl7 {^.)WV{@ޔnZoGdxŮI%bJiJX](p ?4uZpH}s[cjRm'a*ɲl{~_2WYqB1jtNq8a1(/)IO~" #krK;V*ϜbkbfoHڕ5tqiGgs9{[dvZ>ٍ~f&Vӷ5Q |ˋƥBs(g߲MbÆ+D! _mzdnʶF~Od_ ]R}`Ci_E;R8 O|mȏx|VGØ)YdD~QwzB=V7Zw0AIgχ]<(SoEՖkw٬3els? ߩG*3D8kǑrtÌw D /6] .:Xi=3TIsǜtx5Mg7НVz t~^$KAO5PDŽm^]PAM'He}&_IN 7f>$6ս>OϣYxN)7Z^%#+NbNYw~pOA1*#w5BhQzI^VW 2Ir|˩a1zPSLGr9sJߍ2wpJjNzGYl~gW_4}H',-'m.X*fz iNlw;2=S{v}HsVCn\7Feŗ-qe5ɺuRU6J!\/E-`mXSQ7F܌J2D0)y]ȗZrZ;OpMyeqb_Q\|k>=QeF]A S'{\s[5lJdV>ndurq71`}T 'ͧ'm9$f-lZŝ\ɠэΒD&c `ÈFumKH+(SSZƼv1>M OOR62NBOa=׀͵_eFK:rӥ?:u8sFtb+M<8 qnA`d6"* KT)S9P Ci_qW9,$):tW(avN;K7l_40NћM5[bDJr sUuPCW qߛDDu~/} hՙhKQ|3CKގhG(< ]!1 j>[-P1-(sC&ɠ5^L|[_8\Ib}NEm}KmOE#f(ΙVUȊ Ӽ&dt=ai;y5`e)+H}ep&c{xX$AMeAXƺ "T<uf4/>yH3`~Vc?&1}·фݚH@X;ǵeo931?'~SD"GY =6a;;?;Vbq|SM)jz9 tҲwlIjvs-:-Ty-՜PtK_Mؑ7dUڝIǃNe:--=V <}AoLSנ0V:U㦨0x{jQ,}SJMH;čG4).t[ߖ֓4r-v>|qfQGQ-o!5:]ҙ> stream xڍvTݶ-H D>CEQz IPJ)MT7Qz"R+H"As㽑1Z{^.] H J]d%-q`" ^^C4 CEPrCqxL@ %d%e`0@&(=H@ h`1(w mgo?BNQnhhq(g`EQ8\dpgw(B};~ hÝQ&xC{k󂻡P|]X U(.?_NsBcPXwG > ^G/!=W"LD\}@0D?a(B,g ln_׊W?>4 o;P($q#ܡ&J bkTIw8o*Yڨ54G& ywd̥t/+n_{2f7,L-QLcmFlv5h,BStbُV5SM(+Wۤ^V,W|J) WX YKΝ4%zi+PxFB_%3aPi ' S() 譤Q)19J+ -4"=@{O)և-=J6 ҼiγA Y^)Xy8tzԻ%m%D;&FԻFf3^uVrYj˭/ߘ|N*cҏmxPTcآs_^081`ʴRBrVȨ:uk)Ac&[34U<ĦRnw;G^JndSf'֮@+yŪyPtX&:l :^p'y;~7&üd'swZa:AmxMxnۍ3Fzqb\ɱ_0@(_`)va9ax例J#6 #QO[9)˭9R#ېvUf;S+[iD-g)){0{ubX ~g=,C#l-* =ԙVlTN=Iֿ/1* lA{ L|18)C~('.g#Y $VEeqYy~* ԻM%VR< QlCSc0'G#E믤tw+v4Qz.crcu="{Ō>{g[^ VxEpiYaRō:*_ 03Gbf (Nρ6Jïզ.W^Hٰy{d?b>|ypOVi^[3่Z{EXٖX#VUyj jtЬcAۈYsUuUoIB˜eNƁ!I uhfI6'#H_[OO#s璓z*ω!H#@33H~;bx^2LrD^l$[?,α&\|:6DNezoIj.o](\ٟ}cΡėtk.a>C:4M_ԎWqe;O=#̛^u xHQ.?/K( TMT&5XOb[shHvZOl\N)݋#I'U$ұd c~;Pa;Аi8v 'j\ߐJ=) E,ʭɞVUQr.*)~*(ZiO FY_֘ |SBzL6}zmN3N[WpqaޑG>Vҭcɫ>sNݰ}VҫgC|7CUHE*# Fm3Lzbuu1\D;,Υx@L,iG`eEbS]Ibսީ5.5"i9-1wUYSϓeg b;}5*4wfABzcĒ\3mG$:f'A__֨U,M'-M!mAa:\D7[9 Qm = VƏ޹|%3y 9@:]=#A2>J,C? MVQ^/ꝳLQ{9 + n*{'҈y1E0Lč쀩8ΖrzX`4ֶm9y? fۭ!Roa7j?6b+ w=nG$EYټfk!!6bjHv+@n#ͥ0Z54Ǹ>fzJӴqoAք (GTFJ(! PQt _\Mk.yjIZH t2+Y_#Yʠ"#l.d&ԄS$tfɢϋld Y'(OOlȷy0C|b!]FF3%haHꤡO8ۏ/HĪ Jw_ L> a67 !'tz4;'u \T)#).ﾳӔ.2~Juy/Mvbr?ʌKtY4x]qkv^ep'Nn˫KW{>tM4N.e:K23QHF/+:QAqweiVmò Xʀ*SqlBO}(G>{Gt˾NV儹| e9߼g0jC+]?+]<Nt ϴ>TJ%lxSr̾2eQgLLm5O敇vTTdz!H"ͫLyԢmByh'_Y=KffhKM:#j^1Znn:w.8-L4bJ宝ݲ UH`Ӎ D89^|dgJQӨAu pGaKy'ʒCD XwIp*|^{!L(00`͊= To1yp=+bgGSD;+dzZ`yl΍rVN3y5EqG^쭗/{2t9$S,u-_{J祋C۫mEޟoEo7}("dkHpp(kC1t=^X-e-J Ñe6vg`E= 9wgHd`.GȡLIWaLx(ug#yql͡ɶr;G׌ˎW4D&yޤYSͧ~UZcw߉#I nE 4EsTx|ccRjg5Y@,J`k!_"~@cDt ed~b'"v5+.).԰6L1th,u&zR|n2 򱫤{W;g,=3X2?aGPU'2-÷)1$D/tڔP]Wk'REt{ZY&ڳ$:o hBEkh h"]C8ղC[JیMFzNd5z[0mcl}`r@3EjH7m{U RU MRP9rq w|/&O Ʈ)J+9xdVdrd#E|+͙pW49\mrY=8NT]~|e&߅YjW"7vj!fK9& +{JJ2B]w3 IKM(3"ewے7 T滚J>QiէmԮb2Tr|{Wk B-.,9~/sZ*+M-G_xde 6E,<=:^GF Q2hrhrw0vVQa;ct'ߞ_ "2< endstream endobj 6021 0 obj << /Length1 1387 /Length2 5968 /Length3 0 /Length 6926 /Filter /FlateDecode >> stream xڍvP-ҫ4Ԑ{E!@J("HETHGT:(ҥ~{}oL;k)Ўp 4 'HIP!p0EQCqL #(;, K˃eA $/"#Pz#`} @cUx G_A'!XNNFw:@ (> GvtLN88B`1p(g2 ?q>P @Npᅂ1Sm= {60rB~'CH( @p@Q_D;MȇzCPGwP1JxX' bFUp(*pX_!0p'±ܬ pF`οyy^pmD@@rR2'*;&@{ Cp? 0^@ N8#Ou w&\> ~}t /hk1/_L &'%K@FV*FP.@IF9r%ҿ{!g-4Ap4n_oN W! /wa# E" zG\o%g08((R@@aF9_B_1,ACp{: e3 4@T $ ?G@GHf 81T ;B1 Dl[>mo8D55vRxxaa2BKdug'᱿y戧r_䳰ovgSpD_T{~W\ˤE~a`E`Kj{=r$TCrbl#@3rbs[։y-z.alӽ̴ߟG#TbetgL.}S)]ÓۗΒS%P>Ke/F ̒ ޲λ}ʈ JW7V(5)&#'1Gq:-dhK`UmiK>f`ըqW䱗J5p}.:gDa yWQf// [^=I(Tr gbRV֫"bi{LM& m|>mJt.YAU ̸+ŒA}q6g)veOOV#BBh/(jtLNn:IIBuCb&5d3C[3)x4.<ŭ. Wh=ԋf\|6-]%y4CҶgt߲yw.lwba[Kf6&/G@%;6dE!/|YGZL0֩D}%i""]&ZѺᾶAw lo/5&@އp'o78<V̦H}h"`ۧ|IWcN{D!UA}!=ɚ̟*|O%T J iL V~ͽƱiZ,[UT)E-+cy2) ȣK|(G R^!0 Bߎ4 YE)n+h *sR5]VݗIV*2*+í@uf{!= =T^ݾRϙ(U, װ N1,%&K2zr ;Lz䓣\~t)Sz~C]6G ] S^\לl!hπم'Nm;Id ,4_) \&o9_LxlO:^,Zw9[G sf o򗗵Ƽ:-npص쭆I@#x鹒[9oc6/|נbdz tVe l_.;*Eـ( el`ZH4KQw. sPlO-pʔ5Wo\Pzg1Dtb/\e`.3^cxsGT|-Ҵ~p2Q\Y9=+/Y_=@EӛW3V7FXO@-k#<t'^jP~Rh ,;.)bfheˣk;i\IYL*7W^7D'{Cc3ܖ=jx-Sn[iORgci'=7&ҿXlϯZ[e-S^b %w|$]enQUjݔ+S]hHkϞdOrpZI^^! {0n0.{3؄"RAX.31nj̥ZJ*Pe%%DVB | 뼺5Or<;בi]{ %'7ÀUDH2ڗjeAyUvto~ OuA5YŶ&S/^QzGIK~{jzi&2aԞ$RDqwAk3|DВ4 N6IV!~?kIpIOQ\{WMmD=hU,vtF=[}n9ܥPr8tQl;6p4R 6amf7!FTL·EsU6,<<%&m:*4I--=IO7F y)tVg4ˀvv/ÂjǬ=OA {O7禑bk2 DfƜnHcPm\b۽ś`ͩ#7+K;1&ZHX81:=6pev==i CDNyW/9s>^n|kנc ;B/WvܩYy3{+&+~90[IOM؟t@KQ,,oǩROO Eh2eG6]ݵ 7J xrt>tkLrVZme 5GOL8&x#HjKOjwB"y>'4~{,f-7f10UӅՊp͔uŀvGz}sR&xhrL3-_c./M5zFQ$6auzY-g -yuõef߻HzR[YifI Z>FRy}Ze/Wy'tM=qCCSGTSo?L[Gr{MiMD;*}#ӿYa8+,X;uT}3|)V+k_>1[ƳF+WxW}ne"׳sD%id ğtM@1wY^%Λ䡔Q~(M:~;~*"h-w&Y_J0#z%?e>jdYbѶ6 b*G+/pGP:٭&ئʂ'҂Ygw%5QZnPwR2,ԹxŴY+[G/vi$mD;W88qBB~Hm{Pb\ AKfs#~xG&ݙ Osfn8vQa)ƢZVh# 緦 J3|`w]/[D2r!kˊ橕Yx^C5J;ݹy4LadV3~Je(&M:U`~qѳS04" %٥O 7Α$E^'X$^lU+fsh?:ֿ G I _}-I̽}"3fb( ژ޲һDNNBml cCnI㜷r?F$Jv9"b JYw߆vW5˺dx6i=x62J"I>ğGy׷j Rl:l{*w$D?d| ˔5!sz =??bK,XH YOBg5xk5R"h*4cy3]4h}S;zt ~?W65q.G,&=waCXG<+#DŽfGCBMeU|[%kزɾU?{v3m $eKj P%ƈג;6,x E Wޒ>PFtRu]!g-tqvEkFq5v]t«cx&eBs%oWdEղ< &m:z,l߂5lafu6M,. UDŽ}PngIzJR9.QL:[zq`v/ýuyǢ ֏_hO7ɑgSįU0ح ?)^3o0jB妧WO(_ͼ(lyROɞ%:#~d(R<Ө#divALNT×h"Ӷx 5;-,M3%[՛2eMlM<Ky&flo3I7 ʴ0Vw[b`MidG)=6bm;Hzg9V~=M1dK;Td+G#pwAMX;Y|8+2#Y]JNTO<U|v@0H|mN\pVAm;o?w=ki.򻈭ݧ`=$#W[Q7ܨ,ת~8pmx~6-uleCI ˦gm *; mT~,˟WXrkھĚ,9 'I*ț(B1>8(ԯ"MtLݶX RWNᯘ"NgZ޴RϾZ+../4=H)/$Truq1}g Mh3e4bݧth^CKTj][IWQLw[hRGU ^N*)UQXK+ RjXS|uc/C @Ibe4'n-e˻<+[en-jdW7.-,-zs_ endstream endobj 6023 0 obj << /Length1 1467 /Length2 6488 /Length3 0 /Length 7493 /Filter /FlateDecode >> stream xڍtTS[-^R$@@{G  B#M@iTRJtRDw{~'g5k=3AYUPHX$ P64@  &1("(P SbWX SP?#fxAXv Gy|NLM{?M vz%{̺F3uK`N%b@ XrYwKK*,2P@)V{( -fX 饢 eJrCv껌4=S8bϺ}(!i5k@to >M>CԉkzC&r|˼.IqӄuԞ0>e١Q+ PM{K}yk=m?Jo#כ6jf=ix⭣/W0'h\`5?ίǑ+45M~WR:W\wSA˂0,$/Ke{0Żo{MJҠS%V.X_iHm&c\0_ Q( 3t YEE=MRO |S]Za×?Jk wur(w&L"pMU^'EKM͗(DqGTW\Z֞jʙ}z$YHPrsՏ\$5@N̪ rIc;Y3O$.('┈%rrd/?ŖMd2SV !j1hc$|ok䮸-5Vg^xf~CO1.сͭlųU}U)KCMgh|id&JS6^5|WM~91iG]Rhnq'IHZpF׸қќ}Yּ;#-Df0t.BOA~?bsjmHbyfxEH.H|m[]{+[Scs(kwe2#>M1.)b%^6!6^{Vg"Bgh3)L|nƓ8Z1`g+.::u~8M{>v? BQ yeF_"#k88aùQU5xofu2~oY.ę[q_񲁭;!ޥj"=#o̽*Z7aWe$i^ljll3p`gWFmR.caQ|W}-y/xXdQ"tÆD8dO?Ki~nU/B(F$ǀ,eD~y*{x<\9Ce)ɢwrƜlBjdQ9Eg2=Vpn#^2!|Y*#o*{a!;GU@)0"yN11aɣBh<~TWkwST8}0\G8逬g Ň~=Ą%`  %ŭ.Y1-+"d9]9!y+0AOp #]3Q̦sU>>JD;OY|UZMU:$]BE(-_UXy:AB+P& vo/R2XDN5xWi6j|@(5\gNdBzVY4LSyr$O!޼ձsjDl>b΀>BL Ⲷ"p&lJƠE%}o0rO_AGVZDe P ^GoXE&SXj3̅L| }aE`08הZi>R|sj6$mb!87DjVVԞtA w }OājgC%f q}$ D}:F=:Oi(GӦ8J4*)Vfuu/-DI8z H3u}8>T[>/[Pvyu3ioR1bzxx& :|IݪS]՞Ǽ ux1wdswrU(QPMj|AUnÎw[>©ݻ,bD|̈́ gі(>s`@bE*#vMo|K7&/+{pX6SƓq]J]*"]W} '{ϧ,F5󵭖Y=]p<Vq9ݿ1e۱-LVA'Ze!y{\-wk{&<Ÿ澻9 OkIx+g>$2J}2i;ö9""ggDWj~`DcQ}5Gϓ8I'ol)JVxA|pa;aǦ$Gk>h6_Uej1E|yv Be?Nm\*ף,)FQ-6ǽ)'o%U ʥM_#kؔlv{E}[x9Owg?^>DCh40[(+:¡lHq&eZa{-Ԇz kv!YB wⓠq ?thIсHH Sj 0-a"C_KD5>^ctQuSO$-j:\˔ʕQ뽕K؋tvh59.^]o/E. E y!ˆu< ~o 'Oڸ$v΀0TT<$ic')jԒO;f gϲa;壙E[,TߒmR,'ʡMցܠ 0'W ?}D^Ywʴ XtDJvC|z,w=(81{2YNa?zp*T(?p C, 6y), 8 X%h#tJT30f=Nٍ@4ˬ~W)PnGF/yaˇxj!nb6R`r-,B ,^]TH-ŧ7쟓y*\(IG~Q훅myijȒ+\qG}˞,YzTi+8txBC|HZzKv,P{!j赏vO4"%Mw&8 XbvlM3ȪU:|mϒ.GFUiSL=}e6]ފeBys j/mFW*,-e`m$%x|k{[k4=i253@TwpnUoH9( T0c~QkwGSjT<:)xS@W+f{ *ҍqQ&W'w"Y'lz:YKq"϶\|)ԫd6?hTMlB(Xʀ'Z}|SBFD2-8oW[n/rE#{-3BAީoDQiGyaC{aKK?=[aq>XIv#!P0AӋ~gLJƊWbޓ}ףG'+xٟ<\5>J ͖N:,J mTmE??*aڒF V`ݾ |6B|/ēh"ֈJOK8"a*V2G۳۪˜tRPFHbFҦu9 )kٴEܿjnќss=W޸E ] T.z!Cc  냽QmV .Xy?oh3)z~΍W/ ch24e㟎3gWEg4 (J1tZo#xM-I^--v h) 1~:릳+I?Uwilˤݒ˒ɕUBf9W`]W{\Bo3m}9Ѷn'$7> stream xuSyQa"AXHx\dDg"B+1+|&WY#]AĆ#t rt&TA>Z4s:¢gBvP#X4L,SB ]3i̜!>@͝[q?,fδ6Ptw'alPXp+c62@gH4Lx`Ѹp;џb B;E`B !@5|SGa5 V ku^(o>H0fn_T06x)"o1WB;Blľ  îWALd3Ep?5wO-47˝dq\xӽsiiWsYw! 10uL 2)5,fμ87 `px.1"`P @7C0sN0aB0 Q̯4xf.=eςAp+P/AIg'ϐc0nYXm,Zn+t^fD6r)m`9o9L{c" j湥i0=gCT~Ф5EkcϝWFWO;T&#񺓛Qz|%1͏(u#%[҅S.x^Ѡ[ꨂJvU}E*&6޼d(۴dzt̬]ӣ뫻5S^ّX}Dkm60dx0t~zli^Kɚv󶞆{k'֩#%ILf=?x$6wjVurhu(237k<]iu4Mтָ'" ^&?S^PZo#fn=q-ޞ'IS 6Ɖg'v5+:+E-%F#/7삯O$1w_H\W8PAݓҨ@BT9>2hZJ?U7[qf*L&\꺪#oXl-Aih\Fѹw)}ʭDءx5{b 2+: M%w:~uxe[ؤ=j*/ާ z:V]q[e"Y)sa@&YDtd[~Lwp[:eMY1uX|ƹڪ~9qluL,a$+o[{$mr>[4|x~p7>Qi\XZT< 0\8e@<2}llDUޭ\Q=D-)p#1ve9k|U\3)J)}AؾގWuЉ<گ4kli3[}!FW7=81&A[%E R9etI犓%?Hd)g֍{}:drވ>~s@ҞhReQ? {#nq69WxKKԇn7r겜p=*VmI.xu$ #c|?M>ՙe:Y`{Yt2C eͺiۍ{6i8U捞5 K֭^]%+ ڍ#VE\~E"Pk~%lLs+ęyoj UVHF`iͶ8QO 6kKZ$M sSC] ąhv~B1Ja:`:>LcKRa-4&w([nR(UK}5*a㧬'R4>o R:`4V̷(2語rnxjo \s͓T҅ اPPhy`#qRãvEjA fR[SiNuC%eNy՝թsG9޷h{cdE>!Gm,)hi|-M7Q21dՈDZêhEm 쩒\h endstream endobj 6027 0 obj << /Length1 1626 /Length2 15640 /Length3 0 /Length 16489 /Filter /FlateDecode >> stream xڭct&vvl۶]1wlbWJŶmIŶoǹ}}?1~kϜ\kMA b`twe`ad(Zٙ:):3(ͬpb@cW+{qcW /@ hXY,<<&eaA bVomNfIUw(6gg2 'G$?Ӵ8NFڂsʤ'ᡞ[Ⱦ|8X >cl3dW/#OWw.G17GU1_ ULtUwkR4E힊UjN뤜 Z AAj>4B=r1s0BʲUֶRGZG0CyǏy r֙q( :z; 㹄r8lV8Fc g?g6|.Ϛ7֨O\4(DoU;&أEO[9 ճ'kְ^pVkK[,*6𿖃q'^@ ~]J"+X $U'hy,90hINr-P߾gRpNCBof|Ͷ9|NxP}KPOQ&Ǵq_ *MW jxoU !$kFP& (t[pc vH`.O uUEbr>|e .2*U$5>L=,N2Q^;K C'k\:pZH{Iw[z׋j<{M8=NUqlmI>E^ujۘr6 WaG<ۺKA 3PMٸ~2]AںG{ "4SR! 'G+uӓG 33:.2Z4wtBUhr<%bL".ln="7Ozq CMn ~JhZ}2Xm\Jq$7Omvl/(hwPpa~wWsPƷ}"t:&I ֹ /Rn ˧ Yr5 |W+ڵ(We{{)0 NQ; ,5 6Dz.+\8dmsaoKY T6=~)!=󤼉!<3? KDτ+ җVv \`zƅp6@P w"&J^N0HW-];EȺv^M1wMTs9󼐶6DW4F`a_2NDoug{xsJ'v+ +Ũ0طST/YǪ>Nte+@.)rDf{۹u~q)᾵i.,/c촯Rp׻^mgۅ 1d }K7!>6L~`C yG꣝G#.-̛+*wy^!&^%)E"ݝ9݁,u&$uzUNcׂg,:-ckl!-3{`0WJ ˃J uo7qpt> I^; Lho(YQ0^sə 3=Xc΁/ob2~Sɵi!@Teź%6HF)?W,S=;?vQBl}~MљX+D~ז-5Z%JNކz T"u/!WUQ]Ԓ-E` rdk71.v^Lj=o6B&~Zev}rJ'z#+Oelj:X:v > T<2-͉9vJR/C~;Sg`JYRH;+!h-t)|܈\kH쪪28~et9›K219KPV4BS5#v;MɪnP"ިD+|V|4F@(S-|! |5%U cq8~77`àĮP[EQ33nI _.Uhdg`qKSxu'rݾ:k9fm舘 MGan `wPeοm,L_}knL"%y@AV2l7X((Xq5\$HAYڹ2j՚=P0t< $K d Bq XcFUݲޝhP ח;Mا5XaZRIm0y˫HUuhIʭP|K!Z/`;5(7JmK[/ ׾b&,go#Z&;ynYͮW +f)j:a&d45" qo*$'VtepiN cfi:~m9$gzZqgKЛ)]8I?ӝL=Yb]{$Zv>RY3=0#|0Xe.NZcgy~N:9JY;| y*&Rr`=O>]Nh!P.>m"9i{ҕ$\mxҰLEpؘ|+%=":ead%*Ǚ6.BGflڰѷ$Kb $? Avq4guSV'F]C5AYcvmXD?~1I'TW'gyc8k\q:8Ar$2vU+`)B{,|F\3+RZ`sryiQ7=JȆ|Zl4dEuMى{Xv-{e5SJA^juSS+^RNg8?##1/bhG*hT`/:fv޺I*^k؂ӗt#Tޟh,!7ڜcYڜpwŵD!KCmR8,u}x^GSK>OwIF20#RB9L#O^F46]ǹQj}{TRD Xy"}S%ۖ;^^?I \me̱"lFDMeh;qOĨdiz#U,7q1EP9#{ƕJN@73]Q1OEȅ>w xVJI`bcg.֟:)ojcM J5QRKl} F^Z)]! ɣ<n@ ~Kbg>b|p&g`K t_=+3jUeϓ,ڪߥTf{#p`0 OE7}5dß1V!ie'uxb keC,uoqJ3pC4ܝqnN\SJ%zD,;bL'I.a o>[A3S(#\B]I&`[қI# tJC߶#'o}i{BR-M\4..@?*%Lptb5Rȑ(\y.l6x#PjLx]tai7YChAv B|d )ok7F0,on/Õ܃ h: y.Z[<;aw.V␊+DY獕S$*co ) {lC!H~ė4qMѫK}1n{تA%Y9lbq{qE= XInɮ^Ky'VEJ1sXo6A8CדIgH}YMr3|g\US!̻QD %zΚjoUАC"'8!X0 Uܽ+%Nդ?`c`cD[F*޹C-m!<@L"n+(=5'VF_ ֕عqXS*Dș엲{\\4t g$͊[:2V6''j|b7.Xc80/SHvt.G/=GiSHkw{AHWKz<<0HO((Lj}C3Ē`񎃉-|W-j&vFWM$ ڣ0iU'b&JG^TSIcrXb@A9WzQk-q]RيhgurK`)2OshwB$:dW If8 uqbRؿ^I{NSMyʏ Ear,rLn9ܖZc2_ 6l]t;^tHSm&56$`5"}K/s 5 .9A-Yc3J5y<:z 6]$̌<@ȽZ!f2mS+8FN.GLZ̸}OYov0+l yO&Vf ZBs#)7-b* v"zmo%ë-->hǜ{{o}STuN ։ ŚVv.\p#vvssEHbUdq c:wׇcbGnț1uG棝LUh=Jddtsekc:su&JdԂmi7+|!?oM~=tC]= yi~'[~ˆ*% wy28新1 ,;ȋ4BC(|Cwwy#ރVPK"V4ܧ| V vf,gd@tibg޴[i6߾d aV9ոYyp`sT MoGfDk[Dqn[2DI׫1>cJ*'R}Xw!FC~Ddgy!֚6=6vs&I.#OZ⵼eE%MbZ4"쒵$O>P [ɺ~^fD . (r"SГעD>jeYb_U0mܐV8\… 9 ZK Ƈ{c @ )W +#g_P*Ҋ*}ַ,_XVjK<.tb'E>_81"IT3{9I؆vBZJOYyry==,1{]TIz_ f8 p&6w'3yRR]۲ Uݽb+l5B rĮ "'@ 8#7tbs #!= 0eAoĻ=#F>WrIff“SA4$B/*k ̒{]iI?m?FbrO =SNYuƩBbΑ]"e䖖&:V`ULoۍ:DZso׭+"< iFR=3 (͈^7H+ϣ56ybBf)Yv:hQfR)Ʒ׵\طm4"|`^FGMØTRE^_/с<8!():A$U=+$g)*Pۧj kpߟ`_ MOg3)fA'f zqi.[2!k!l,iaHpCix=EҾ3]ӡYW&RY;Kl+UEc}+ DS3{R`cvGrӒ,&I:^e7D3 S.h9 YD?mÊM-6oLꠉq@xwuq 7ɝV"b>!%~1g`xqV7Հy"/4rSG8qSUf]=SSc" /73̡E\H,j(0Ǽo[ޗ4rik 5Ĥ]O.2yˇ1x:^*/>7+5ΕY/3،#q"BbE5:'*jG~cW,j̹;3 F8sW\HBYU\Xö Mn8a|q|= $pSyETw(*ŏ>w~kÀe+gApb_:ճ$S0Ϭl=? oGJh讽TPt bHJ u:JIu"$xDZ@KwTCGVP"8)#2AyiBCN~ۄ6.hDmaq$a]k 'B/ Z{tﭲua(z g|'&_u}sdrɣChXz/Xnix̮O\ Ey!D}\De1U*Dτk?;ܼߊ)~_Å f\sE_s{geʆYJ:Sf rAwe"Խ"ŧ4]%WꭎX~f$WCEgԘ>U 1S (Bq78HkҎH^ih0:wH5w}A)Cp9EL ,h$S؏@eN XdUFPh¼539"O+SVS-j [E9Rӷ-F+"&Qg;&߶#i:&aBCHT,|Æ[C!߱r̍5 wxdz0+b'"o 3'fIG5%)Zo &?i3c$[2#PDa9㶁ܦ9wmJ\g1{+l*i(~"iS*ئ>ıMbr>wEDv^Sw<% _0F͌uNp05~!}.6鿮ł6QǬlE\v4vןf:59팝?,ͅ/7W13x'oH@ĸĂ'pD~] !5oZKqW%x>(:~Z R[ف=@;Cz5 Lqlޚ}WRta@9^`f!a,2wG=aXr+ԣ TltlӾErkµTt$r)@0'q zfmBU‹;Վ8!\yפ١0W{_iGt)ݾ-T}Ӽ500lbGVGvK},e6_`H3ؚ҆W) K/DCq\OOha7SEPVy>Jϋwj˶;&zzgɁq w칖gHt)o߉ 1A;*H֦|V[W."l,2FDG0*H$HVfĠž+ K ' "]̺49o0J@VK+FX \Tpc%0O!Ж9NՇ)vY[Dk?n{}0k)JLҪ_-ն(&<"BbWkԡuXF0K~AӰ;.Lq"ItGc2@-N O{5lqga8HB#@4j;,=H%WGKU7 ta9@^H`:<#O;pv=}v\%mx* ;M&uA8i-ZݴR*).{CH}o垷,<'`Lo{Yɂ*y!y\1 tƠd7[&+pG 6OHJ\x͓cN[m^r=F|;7k R H:y϶`<SG~2hzàd'x'EtUyyQ6҉c~-98/?sWJ?@W3.cg Q/f?~W],pN|ZѢ< G^)XV=0[dCC94)LM,؃\EGO&xWU *NpӐ3qKhM{h4F/6~3ϻU.rvf$"fD{~m6= m8uL\ $4p\ k44CTv_ϜI[~xBF$!KE鸽,g"^gu댹֞XW嘅sBC9WHdzL)0S9';-bu;f[WU@PNYaS6l]Yp9 lUKܫ'XX6bϏgdw9GT̆hz"դM R ՑÓՐ '2ЏSB01^^|`FD~6$&z׃2 ;}4ahȞBvaӬpsVM,f9>z">S;SCrp e>(!)A\|q)Ӓ$ϜZ]^ڎZ'#Fk^{t(QNgO4BmEW~@Jug }Yngwd,?F)Yʩ 'ذXH)).d^ %&nXD&56v陲k qtYO`h0O_[Pu8̫6/yԗצgբB6M7g?>GF_ s}D2>z ގG7gG7du." ȕXfX vQ,GH3#Cmea.B^/y؃}>ʔr.#{#ppNiݡiӀ5D`*~GBۂ-Ha!}AX$vp2*鮴{R+'bR^R7^{0KAy,źHׅu48=V<0Җ~c?EJaN(mg\Kf>ݧ4 gQ̇}QDaE_,k!f%9l_Mg2'4"`$"4Ea;qD"Y!!tpTwKՌ'va۟SB&*såؓe[<7M)+㽖9*Y 7K[%hmZi7Hq2gmk+ϗĬ#!W*C)5C%hӚg]jA!=jׂ 0^ZIbԽ4ctup-k-R m./ ʵ؈5WDW~Us6R?8tEW)-2(Lv 'zW.,sί*v4_z<'(!Li4M*wFps?Y؊xM;½J1! 0Jz=z'W )B~Fw13}38c ש,SP>*r3ɣ7FSOI=jtQHsr&8tCwJ]Ab/-v]Z8}hdF~ MNݒL5TՁZWWꓽº~nkb9MɭT/R PO ]ۙ+"s3GB)ef,BGġp\s=P{maYAaa=ZYD(rUj2#J(&<'ez9*: #f64>[$zsB$% h1tj,L FIf릡:ݍ '9($:6B X 3}ջrrgaL8!Q8#=OI%2iւpVb#\髕.c!FU/L/\ѱY x;0yW,}P",i `OKsC((>&|I=iFLmGIutzrZwo߿1LVk NtÞGaӝr2  HƷ]1.CwTq8D^oc:Y+bV!H{!~^}&b{\*^m#@"W,oX6ebx|uSALVt Yx4"*ްfHZQr^'.Td#7 EoG LM'i( Jvv O\UC.|7\]Jo:x@p)2Q0epMX6#WHB]f89cn]䢺q%u˫yS||͕ϕmR_}(y_ zOU_;ٜmN86)LvUホEbC˿] lv62M}8!]YaF>r.&>i_ym谻wx7">*-&Ԍp? Y,b1W:~DkC]QANOK BZnBE{NJ|_"mz@ړSU \到 ZlX #!YԲ^(R- V1x$\&@hV=nL(FnDQէͽgCS:+O8#PĹb3[D^Nr`^Bt>Nnwި`$W$YT#>u y¹)WRJ' !8nGnN ȡ(u/n#պ:'@ @KХRfܓ֤F8" X#q\V8$32TПAtnd8=E@[FH Oplе~SrrS{X" {c+UÐN;] u}u UTs0AfSL[.[/^eC,|_ h|# R ߹ZlG؋6Ŧw+K+=uy̓ Q N}\̐z웪l-f?vyjєn#025R$W^jU[w{a VA=u%m5d>91qڹMY> WU^6cU;(q}E|ٰ{'QWFͧa"켰@C̐_.(I&94ys;}=g.S ,f٘)SqVW߈G 3&alWtw L{lb1^Xwྥ/k/ r!WL_7Ld+D;Ga1:"˩ MXW/64iHel-$qpF*:DzgщvvWі`U,4y soHtGd)m~lƪ DIE6ZdwP&\}Iӵsc59ӽrNtMk$pZgLKKK2'+@m.6$,S,NBeF3}?mT#'e u6]U<Ԃ\Ҭˣf{+ؾYhĨǻ퍅ی8q/9j~{@F$Y9\_Oڰem@M_^Q]5"pm{)B CqfqrdHavƠvSofj7lh =)iv ٛoIB[2uRhҁMٝ0yzy)<҈uջ`i,*CMֻܫJ)8Qг rثx\ f?/ֶ~E9oL9@*I]}.'YYZu#G˪흓 yDQ6Y@p6rj1S YLE;2~V|ڋ@x!B' e*NJo7wE1XVKҕMR`mNOM)KD:x {흳lZ+p+Z~XInAE 1XPfB߫>l-'cyKUz}t ] öL`6u\=;zHcim`:$*8X8[ezM'ki% 3?z!J+NM/ tې/ unAGi endstream endobj 6029 0 obj << /Length1 1630 /Length2 20319 /Length3 0 /Length 21171 /Filter /FlateDecode >> stream xڬcto&ul;;m;ڱmض;:6:?Ϝ9;e|kkMNB/ljo sgf`[:+s+]N@#K{;1# @h XXܰQ{O'Ks 5--Z {MgKs;7-/E bY Z*Iy5$ddPt54Y휁3{'Ϳ{;SJsf% 08;M,^zqNs'#;=pXڙظC_FSwvq6qtpͪ(&o.F.v؛47qY9\.2L-l< d/Ζvɀ47r2:;OwNRn+rtqژ12i7,?"mgf`f?|n@5ꟙK` 4ew@2 "U -jc#odwcY46FN;F6[5Zo0im3+ ӿ@SEK ߞˮfg t_m331?"3_Ei7 _E/Qw{yFDMgbfaߤ8Yzt?OzFQq13;mZ.ٛXgecL 1:5GpWׅ24O|{.9|aPRlRtr1!dkx_-mChs0N()뗾CLu:A_=Q=: hBnA/:;H>yz5:2{67/8۫sbOZd5w/%W"4KVB/a}&%xY?apq,ItDӪ2 ]K+k, 5>=)H۔9#1|D[^H!׍#2jį8۸$`V9.~e9/gnolN/AbXg?yDb|Wb0 _ῘQ=0:lyt|NrzKBkI,ipk,ϷxjJ^Lʆ~ADS^]qlJkRHM*Tr^W4r+ $ ^IY&T!VXPn"'%ٍB}vS\sF\7 {&JdpsS+!vǚ)[#uwi(ubݪK\s< ])^ׯDK64~xz͂z-gt ~C1*΄- Enkڭ*̓eQRfZ"* 0d3h1*'9ge;dvD]Ov1OgЁ`~}3q{FՎ&F$VK?Ʒ{ yf itҨ=GFw6YQ$;.I&jBn+v¯A 6 E"E0님0$.}v NdǟAaùB۹f8P,葙F3&ņg+Qd ?7~ֿ0gy.&H?=o5i[nV_!Ij(UxXxMD/rT/ѻ؀탇Qi c@O4ܒw gĂ(CFj5܍20!+.V_Cn<ټZ9ݦ@czԓIֳ z.Hps*q%ZK`!IGjH}\"]Q@',"o`H̀zbW& vI#ZGXlk{YZDs~>ZURv"1S~kZGr ʭ{䚪Mzz)0b?4sV=³tL%`0ΩX5UԹlBn 6i qH{$V]n$Dנ0@S'؊]VA % #t7fmSVFxu4A$m}6>wY L>~ kW{9r1y&}T'"k6bJ&U)`!#^ BY'W{ fKmqš.%R}]̰"{|o_y$8G1nW`Ch[ ۱fЬ~#mhgPcK\v@+d CAپ"DY/YKWxkvz y9CmBYқ<8i <~6cOH˒F ̓t".,ڇ^Q]V=y,(cDޱxRE\DND6u8R I c#s@:㏺`l3'O@/ FBG@On2K{Xʉߵ%cyw6[sGx#w!'!/o-I\Mxq0EhHjZ-m$;}x!O/hDZ8"M{օ_ xur1e([9t"03! i̦@ngCnWFjǀ$G-o  >Y?϶t5خQ澙fĜ Nb~rƥn8:@k@d29J'S%NoAFkE8PL®2Gt~kڻ7+st\a!VGe(_}LE=N]L7>{0;}﫟gm73&#m$( ɌRAޟ̏_jT(D3.{qe;5ͧ]=zug>5JÓI>􆠧.5VAyfyG m@0-44&խlM,}huf݄XGyfP5zڼ()&~@Q- GfcJGFOP'F.yԼ.)M4@AD& .&e'% ,d_̱PVztSw~;c=AV eWUzWa'􅋊ϰ`{OI!zz[sݼrj9(gs㒃Ӳ^BϴZɥ"4 թ|!XfcSX Iw }W} 3'/V~m=9v}rvtEW':a/ s67+ٚZatXz԰u3wBAHDkUopX6ftEB1xz?lk=M+vQ\ Īh%:,1}/@~9n\=(f~mq|jOxugX h22',^K bm+EQ =pi/'@_ ~=wI_-?) $\vsV~o~$6{hH5b2$>0N7x;J#BBDokCehK)C- *1d^i2O0ymH3wTo4;|flfO7)n{3,թ='cLBZb=r]20NR0vPCQ4ǔ>kr0kz="s+GK^'$zu2Yx!_ڷ696GtF8݇#%'N* NC`(؛shcؽ[t jǨ(>8N[醪gwb%99σ^![m74VHEv pQu06NRI#F# \u}hx +Lhtq*P=kmg@eBכ:att6: Wݹ m&dDS_Kc}?x3u )Ї1lU-qG伹{툢 ;]@^Hi.(::x WlhbtNTgb0Q(̣AF,>#Xb&vń̟-' %9Y#k{ rvSQ"(3ejĊN [x+, *IiFoL8R (.Bdu5nh⟡琶=R %&ҶȐ/‡-P#2+:쒛t+ɝeC1EޫiUA^ӋbsJA"Z鎔J7+Tyװ=4A$Jݸd#炎irH&Q/с= H+m,(ou}-kVAQ.=HhϨeZƈ@|K"a~HvZ솮t"uGc f'̀P|8 ;MΖRIt"Wl#6#$$$ΫpmP~z(׏qD6⵩wr"%;O3ZaT1NJun2 י3HtD\\NV;d#E4K#~ 2Fλ1 [oدPnA,)Dk|h>$6XHyk:=h[Blʳ ƴ1~Ctxb8)w:bXVDSlÓ,|ԩE1Xy+FSAݙ6+Nodb,ݧW0J&Jt?“h3 hr' drX @Tg_<PIHkVBF zoHs]V 2@xE+>%V2t czP`%V$Ԗn6`u~rZ|gBkB_J EMG%[Ӓh]Fz 1cבs ̹h5= bAՒ7ڊ;d,w,7j ξR@WĒ⧍:ؔx٣8Fq` 6'sY 1}c@G΂b/n%)2 2͇C'L5ymc\;r%=_m?TG'/HK(W\:⟿֢uNp*]RٰW@Z-LU{`_|.]p q2lJ8b^sĀ>d+#۱4ed8,gat3{BOf{])/w'佄u 4iYPx)F'ş@]3!6y7dXpdyn3\wSgky6Gܬ^%߹vBGh(!DsrW ؗhi^j+e㧸EFM ~ݟzkW ZyNNuֶ! 9X.CW*)>i{~Ύ8H tk2І4`lw˩wI4\PVQҼVrLswؔ QU<_RHot @*!zaB-D8L݀"?3DN|anIk|;L{gLФSA.i3mYs6II)ylD~0~W1TS (FNz*U` U0/%l<1@" )Yʿ|J+AvID%_ lA0" f=Ng)*{ֈhsL 1cB \ H};%jE >oeUcT1X4jxo mO; )Hk/a{YJ GUүHZܝ]2dXH$BbD<ԨJDF}@ő#JIϽdZ&=Yb{}٭;\.Ia(㘔磒ٷڱ!تT!twős)߭;XZ/sJaXF1HC\6UHâ>ϳ1خ۫q_Հ(1}`|s ndLQRL> *iTVv$ ' MѦ T`@_GbJE#n;9G׬8|eL?G*ݏ[e>a͑*]Ex9'I]z&/Xir$A 82`9*+$ CH46(WYe1ͳ;!)༙aQket5CY@tU,"J^vU1nzУ"&W'4n)%+Qpo.&U%fT0%gdRL} 5~-J uN&Jkpv+. L~F'(Gn>m)s۲tvUJ*g{'Xd;K(" !_`żwB J'DUy԰!|Ǵg&ƻꗍ$zIfETF k?9:Blb}~B f&11StfGcҧ3<$'=ۂeGvV $H@md˓zf( +d ͷZR'ЊdѠ pB[K(r&>wTpt7| y3Gf#0ï>.zcN*7S2c7c>@Su XY5呏J^y)tFWא[h+/ oSjwUjd˥J(;zgyvVz{D)z XSindN;QIa>~a-I.8~| {qWnFN9.3}ޱ*LnN`IFX=p b|zٌ=$є#IW]1PROOHg5|2.WF%r8J7h(!f,wI,?7+.@n lcgc苟ʒMغf tvk.2ㄻ>ُ81x5jc`P g&9<_ȓԘ 7S&,GrR,59NyMj $ $r QK-KrLE@(a0K htG5&*?V^8>Y 3 _="n(<¹֝ f#y@IOTuu^;/M6~IuuΣ7bbÏDl!ٮNةq6ª%Yy#t 0tyq/5d\3xG=5a:g]$# Un7j-w> b/m_V@ !ۮJ~ :C%pQ @:)I鴮L< ,"c?9TRo%B@~xZ`-ۢ%!CNה[aD 3וZYČ8V[r2gʾ>~E2g|r}In:DX"e NЮ_  Q]>uA4&k?Lw5"`,Ec pƍg!6HؾA :V|ɾUf3{N%ha@KxקKH4` ;JaC<*8 }Z7-8Ѳ_&[]`2ŘUG8wn{K<O/T75RV/f. #[*(ESwgs+Qrjn/繯G3PB8DD2+Q0cl3gD?5٪&zzipJ=t* O7:@"蹧*$cw X 5Vy_Z}\=.]i+LM`t\m;oo YCcS@bHsF}Ub*$=[\ÀRgTIWP͎IEϺ(#~r?k@d_Gvvwk=M.ǡ*2}؞ӷ=Pv6T>= ;D `4nƟOa e=ʂ㬆KM5{Dv  r N+\:0%X]99S|V]sfnAT&ىVQh8*9\;S}aAL?e\LѼs~eA:IXR5kupE;bxMJ0{pZc|(d' ݝVa"N~mb?S Qd́lS*TSR|``&`:WloOPS~a'x\Tar;xxft+Op46`'CdZxՆ|G)e|O)O&ebdgK_܀IK`&,@Sɒ3+窄mSImRcbwJk94H-1l=DVpM4S0' ǦQCsG $ g:(e&R@7[ScN֠'\`ud)W}SE|vLIoeME8kf[ŊP߱Zhy w^ү'2Z#M2:)% 'fq$ӫJQ 50q e fl^ꜞcDp Uk^Ct(e 6X06 #H 0ϗ2P>[Y#F42b7Ox5. -Ĵ7[+J+*R1"ogv75vNȝ)b|*&9?f(v d\)[2Ӄ%~a.qa6T) ziAv݇76VB~"I P&ŒmkśKQWYLM w18ItTי̂4͖!W_ @n̯|@FDv=&L]e>XqCzʶ7--2xSO")$輐m%2s{%U9hN2':@t5bT㯯sA"S8,$ݨtI+NRtJ*3a?Tb$;WiZ@tjHMboD4c Z? ,Y0psloaQfPmjozBS~\(iJ8<Zՠ^yca;4<"Bj(X;+#iגrNB#P,8Jwh["2;_&z p<fUֆdMꄎ:8Dpc[g>!|V"8\ XUz,!N H>-I"-19|\) r)7BRNU% ;5Dw;ֈz'V0Ad}hU(Ds!#E.mODD:V7xI}7A 753~#^9MTyy)MdNx``=_; ?Ď)U@Ϭu8pD*n1[ꅩ3ǡ~Bp"O=Lxbӆ?c@AnU~.0GF9LPk=yg=KxRiU 9Ri R5u2`K""lHAϦy1AwB2f?Sb^M[B,La@:0Lj[aB )v1۔(JLC!7.B1Qʵ>Ay;K (Tn<2\i/?LW>vo5:U.e?N-'NhxH }Ӟ„f}^ɉ]ⶂ9PNpW9UfN7 C_ӯ_˰KI"5rUJQNHfoͮ:[ID=nl`lVؘHʛlHգ&G}oXG1vR6r9,)4\,C^ ]H^G#yd,vq7MaA`lbb{5Tm[&ǵ(!yQ"*ۥ}{|$I >̗צxoe'D\J.'% ( 6x2NfP q@͗lQ.PǏ4\v\B=h]wNu.bGb7P_ty34aqPGKW)DfM;= Fr!.\fZE4O=kѢ3IC3/OdVXnMgHri[Lu,9BFbe)ҁ".˹ v?m][ )_bD#tl\=`=lT߽gS,%RFPEvsRB#/*(K5$ڃJ#osS Z#'&d&FnSA[5[rvMuÒṚ7'1t3.e"M&>+ Rmд*{hLl/B;~נo'z]nu .)2Wvb{+Wt/ Q]E6 y.FGuq _5Grd xL ,GT)9 xNڝ=pA5X-D!VߞjiEfwrT"398Cmԁb 0bS$6cIdԑS5[2=̢DۀL^7L})5O)jC1y_<be<%i@z.sM-:p"@PK#@#%BCa^\*w2##-*JÀHòX9}rqCt,0R%uxLdf-aN2r;FKI:2V_iQa]'5|j+͉8`nb0&H0kCy( ᷈G ZITr.Y8l#]SlOt?3NB^C妮n1W\$Z~D>BXo:' jW:ֵ>TTt}$:v9o7#nd4_L+GF螏8Gy4 th#M]:aɨè7iH *S 9o'1:6:&hS0WA 15&:s2 ;0z~/ry^Č0ʱ@NB<]vҥʙц6NޣM j봙V?m3D)\_cz>TbTқ&uMQ俯zHu`طb5~Ю/A  P>VK E%GO'RT><$zU)3/ckNƨӸ0=D*i !/A&wYꐐ o_&kl`qD6&h6[[܌ sL @E7)򡉉[Ob,;@5Öj 8|qY3+i. !55;#RzCåi$uQ0B¨V"rc'k+h.ȟœ60sZL ӂYZO#¾Ş_dԣ%*lśn&i:W5]OraO:6]/ nil)Z9jzpW}0h%"r 3vU *ޏxq.Jxa9%nk>Db3ІTg[ f5}ϳW=h5\`#n` 0`\68 [) Z.r !˗l.= o\FH8V.|0Io A(f1ۃŬ8?"_j%6P9=W񖌀n,5ks{o2f: wx%y]0NIP;Jnon&sꀙo,.OD v\@ƞtgg GUW4UM\"ѡq=XU6?R\N ^;+͸b4E Us6tyP@wqČY9A[KV6uaoHo_'Y{V&~E}z|DD\U#R}JmftSI!H:ZQ')H3!# 3&sB;<yPq &FN1;k6ksPy$0 4fA>z( egYwAD*76RoϨg%ōT:I**!k2h.g]`z~mBr/d)J-7*,M6 [CA{C R -+?޺3XxWYPkYdP.&\xkޱ? ~OG ̫s ̽!0N ))7ܬ;k3yT^ DXf/dO=}A f֌ʦk 0<jU)3u 73g܇碒 V<=d5-Zh;1ebS҅8h% G EPɽّx[!1[5K@.{Ufaår7p;2Zm/%Mx+&NGcV%실Y UXtulм]*d5,FwVUXn%HY5Uj t(}s_3"_kV@ ߀gJoue"BmZ{R?׮NK_Xwnk,a]> Jt}L! S|J-a>\tΚF]mFύ$#ZU6 Y@rM;]zƸ)iO?,~ͭ" 4E Tt]4ÓCJeBbe36N |W9 endstream endobj 6031 0 obj << /Length1 1644 /Length2 11637 /Length3 0 /Length 12489 /Filter /FlateDecode >> stream xڭweT]%iNpw[4 4/֨qx; =C{\;0ŷX(cڄ;ݗ$LY4f~IG/SzGw>׊fw Z$(oc6q8ROȭ_šwc=BQc8 0SHNh*v/.ԉا/آjMy_N^L6]?4RNVvw-(FXMpYXaq;ėI R36XeP%Gč](qz)w1LZD٘]I])A~CKU]uEuפj Ng{2-+؟b)Ka Uua_ c|̊\o?VCI?b1mbݖzh3z3Tmd:'Trjq ]==>z7A3rq) #e$"^䚬aqHH[2L0ZސfcnWgj=y (+K.njGBZF@TF=)3E=U,IӚg,^1v `~ԽOh'|rRU!g$ 1Hd[5^ ~o2IC5RQ~K * 6ܻ@.a գ)s UIa?^LYhzT0'8v"T@HU"ʎn-mȻ,OfsC@**>OQHFoKKAM Q' AK/B`N9At>By[kߘ=LRky?|:ғbzhaFy]^V v,ٕ?Gr]NjT93TSh.x޹w1Vt̖^i~2"Vo?ˌPT%~wCֆDwQmJ97nT *4i& !LhY|ֳho wDGPȎN0BpPv{i6ĪF:ڣ#YkqB0_~f~E<5SYdY7#Z[xp}z/^+@=\ ϥ^.9Dn*y-rLG?޳P%OoLhrݰ^v5E$ WsPΧjffuKO{%|VN _{iG^]{5y6xQҍitMHPX:A=c}ICC1|$lF0?ETnl<*iz{vK*y#7K\飐ك-1롄 fk"?JJ'_ftG\ ̌Ec3NE锴Di m9.ΡЌb$ydzA37<46j}#CVN Tj&Ϋ=É]1-Ըls+J'WrPfO@u:G01$C}$+[]8|X!JWϒ#"y|ˣa'+ JgbTDDj}g2B1HMRߵ,-)|=6ߧc w^=-U4v6"ݥ ]8Pݖ'ѴZvzhXD$]9i>A8f&J\^Xiuw _^wUHevCCYKunrKj.iP,LvG^Xn'CŲ:tHP}3 QR!BuŒ1o=T41 7y;!8ycAerVbGVTiE!ĺ1莨FK{:E I_]4!>_L˰F$H1Kh֪޾v1OQC0\.cWU3;UZ %z|Z %5™4 tJթ~ U# 1Y^"rx<|;fQZ`uO)||j%<-KUy}S@;fMئ.m'iamz&m5 VlK/F>d3'B8lWsBG&)^>>wVg41 gpgvQTEHvDP8x}|~"~L\Th5;`^V FNr5dp l爞4B~o)'gxct>~iN?nDH:Ϩ`bQ;lDtiHN:+^V܌_&R1v*RB_&{l` }jPPԄ)=_XsOZrs B~ܫ f>:㪬LQRFڎ#cguVEj3X|h-Q ]öZ*c/i-~)+ZɆ;tQ>7-g|tD/DFfB&ٸ1]pite>,hJ);m8W3 o|F 1 S8AZ[䷸QZpmU^"oWYND[˂"vL6I <MébpCbXWEI4'4l GuױYSLǜ ?-nBoqq jU X:儋HF+ cE"hϯ)pyYnM#lv&V^7UN4 RDqv#AuN]}-hve(۶cj1J+fd@ZQ@qaiG5Fz#s",6Ď:,a *g%ق/4'9>ر >|~ei1:<GXkkioӐU]1>!anŪ[Z/])l1gogrh[}F]jb_+2FPBP9Aá̽X8Xjq򺦈JzQZFSG:l|͹F9@|WLo#I^JZ;v߇<,_Ǫ6JM7 7c4ʼnC㍟l0QtK8q Mj N;;aEZNY>SlU^ǥSBiRI׼yrjVm|UƓY#Q\׈ `Xy\#.>Z$#y8/16 žfK6pfGmf5ʁϑQ ç]*Χ$׳EceP75LYeB> =auHvh+V̝k_[kBP}&"Rj[a]4L硘M+Jz.t&B[6 C߀{MA@g@~ xY= 4$xY^ QF{v`p),?E)u9KgEJ᝚m\mˮ1# }d }&CNRty"ȼSq& 72>֧  +(MK>WLmߗsyrTJBa&{=*^UZnmq;A"/t=A=~z.? 4qPW)6!ߕdeNN,j3"e@yOO*w!Gg4?vZKwx;POy{ʻVUc@Ýfìc-:|]C-ҶH\vrw]e $e|j ՛@y> T#`s0آNWB{m66Td׋ubDkxkF;ˣe%1Cr|dR}uWYz 9vԋ1K랇`lg8=E,/vy60#A;L!֌x}T4Մ柑`3nP( J:/H?frK#A"@O:dndRCs.1t6zw'+8!6#6JE{h9Tee(5!+g?E#NǠqyWHԜTQ1#Uf.1N@TpHN"|!Νl|y2|!OE3& Lx1ZGZo~G#G/ߌ$2Ѣh/3ԟ$z|'TnNt@%{X5,I/'"VJӦZ$å+>T4Mi{|NEt I_ ț ZCtH/5%Kߨx{D2 P)%n{&fTE*&{ \ 5Zl,W$ z.3'ɝa$ݶ,EAddE>ls(WrÁRR?_';J'ш; ImrMnɈ)K s`VԘ8(/BlS}֧ mEh{6E[[sU4:- %ETyqÃ-|()p{}9s%NLQ6~ kwl/n|S63mUn2& @QnE=fm1iT0m7;Jʢ!ksn2 !;@2k¡x칑O*#ɋR-Ft3xF@]z ؙF-ً)c-z56swZ,ǭD^ bONɚ5M'r/o]l$p'- S1nd򡐋׻xK(p{KԿ_e0gr\UKZo:K7zD<Mn;X =hx(W_#.5↛$*k6GjQPпA2,#kG!nzXztӝ:"R`EH Ty" BV\YNml\W^_! %&E?gDAiT+ 軶 .@IԫL"d'׭eZ/5n= eq퉊{.y ctR2%,sROwqSi+ 1kb$m ^_@RԾ>*obVp=+mmq( .E.[y-DDZ9zU>CgL]W[YTBݣzu!mg{>f4j{_S(: #Ciw ڍ`4&R;p>ll7!b{c>2-81>pL(nGn.8XN/+\#{sDAzl脸AP0 $8V˖-QDk"t$4o+K],d3qgM0Ga27y )Ek0/D'lҧ/J6r6G` z8mЎNRramRBY3!SĴaKZKnD>~wKXsl'27M1!Y+2lF.a fAqunP>"KŬWQz?RQ@KiL=F`Z8T\šMI ?:ЧҜ;D?TaDJUk9_prXu2"JŰF'd6Ϧ& s%|ei\q柠>j@.s[A%1jD%&$v+A͏V _EW挫#ʊA)ŨLy#[de ?~ xm= C*m#¥jh"AV "aKxIuLRHڱg!s e$4o1,J'E vSNBfч묉ԐFWUX?V_p|_y.]ޗD< j1$/h ط$/mR^ 3hb$iY,6S! (iO5mEMlJ&xUϋ bzܧ_PbSlЦ"n(+Ib Wci:Fw%jN ƅ'Ut(PZfOdZ#svTgM [N UP1:@;3h4k!U`pj D>0)1k~,a\dѕ5.mu[^@~Rey|ǥ*Qn|2}?WT\~R=rWLxE\%hb{m$eϿ9^a 2$@cͶ٪ao$<萯.Z3ل޽gN,Fvjz[I->_,56e`<cﯜiWzaQ0D`L3j㩀pu.^q.~| j\_(0fEZb 56z??^㡩d)EQSSi=չc{+)̔U`׫$|uX dH 0 g_ܡ?LG *j<9{۠!?/?hX4ykSV4aP(Bzf̥/|&Մg5(TӋU2uwQJԢ(L[ +sdJX+]]H:ܢvWi^}5>Ϩ0ݢUr%K9ehW 3:4A<;BGA Lyr Ő=*-5f5N~\<<0R*@^+IC"gݴ6̳( rX!5%׏3U7{f (*җtޯ>;T4Jz, Mh$Wʐ ň^|28VN/EaWnc4*u* q7C+v!T08?VKI~UgCRGjXf endstream endobj 6033 0 obj << /Length1 1647 /Length2 16947 /Length3 0 /Length 17810 /Filter /FlateDecode >> stream xڬct]&NE;m۶mض]q**m;ب$w=ۧO}{k^k^su5&'VR6s41pt330M\UU-ݤv;91Ah47XXpQG'/kK+ J]E?-lx@Q2XXۙD$T IssE(YM\ͩ./fK` pu27fijDp2wvu vX;``jfOJ_2%GW7ĿZj8ZihOIE'X&3kW';c9X+ 7Wk̀bnibfg/?uꍝ]+k3ߘ-i G3ӿfnN뀨I9:y-CTfA[j]_%6 1v59?6[ynMg?9+gfg`ULhj0{x;Y;_׉`jV֦oWU(#*-,Oڬ+j^NIS-q3spY8^ƿב'쿈s-o t21011~?WF>R;me6usqcK`nin hjc s*kR+. u Ȍ2z chlZ>w89òM7.#/Bݦ= f4(C̺ЌYۅ`8ڟRV1(}"duy$u/ {rB7hLBiAq~ArD94>:2{GKkvN 2rd 胞F@(HY2'ڴn}3J7H44p ?mVF{VcZ:#Ki{Mc-6V^ *Mlx'7ӀoɅ¹8Fqʤӷd],SR_QiVTPr43KZU F"*{F+N)B?!jP;V"1ѝn <>4Ggq($rY m&UMM! j0rf4VQʈFcRK`$6ߊ0bJt[q0v} ^V>x`qzMM.B4uAM0sj#I3:Uy) q8 :A"tt@iJtV+ uwZ% l}RqhFfڻVL2yUQWcL WLRey!}Msh'OodIEK0 z]<uwƔNu2Y <#:9,zN0LSM᳁3P1{BX A|/毅UsF$Wܔx9N߇]1e8l&p]g1J/k-xVKc[`A䈹_/g0[=7ìu{dBf%<@P\n֬\X""c+(!w,DFx\0[>Æl 4*̸|N+@5~zW-'DQ0lsr9vcr??ͥy>=(%)|7#◵t]E-SA0F6 fBHިZpz[>va-@_t87BH 4ŭMXen˗r|E fD4$ZM ૓@9rPt/IDf5jpLɃx#u48=@qfE:dJN“≽؁Dׅ"fr'u^gE =bQKrIn{[UU-ݥ ,%e^~_! "Q1V{ G;ug1T0Ű{A?QI9ePl^X1| 3{Trv+eeh3\ANJyOq͋!zsbag ֑t^au`KOwEHՔT ) v f-;$ Vv _ IN/,%i>H&^ u-H$Hː.Yjk"b#\ @MY;itxswL8q*t.ŷ~3[vy22SVbdU1,$GJ):xBOET2pΑt2#4*r X8K dɌ η|xJpNˏS.A)YrçϨg= O}YM⨋ފe>u3]Y퓖K.2t+ l\Yͳ9fB!d {wT hCY,A}cI WDa-Mfz2 xrqI WfA/ЈW dEM(|%*@z:Fe&bP8,F-4Kn*ӃyFv2N|nHԃ<8j̪(%6*DHL7vDf\I1kjr3j47\(ac~^[CP g&\?Xg<*)ז$p` "FK1MUp(TI(4,pM19"O #;M^;ҩlE 2tȰMNe-^aΟJ #2SN:h'mEӉ^d\H4P˧t(sС7v+3:bsp}CpԠLqʵ'[=j<^/'8\ ˓'n(~3K{`M0gu)xl&b(Y7{SYR~'|x{r&T)Ļ}nRnuϐ>0o/]7g}HS4aUS} BK꧑C->QzW.cK}tR$"AV:0tU,!Ć>G 8«=`SZ4pb# ]\9Fެ^._҉`E @Wn5x(¾MK  'R`dRLsB| &c#~ U%+f@jʈc.AԚUH^B)&',Ʌ[.{Qژ@)HJ,B8,//m}GA6k]c,gvPMviH.RzH{UT\d񋮋,0~(>$FxMt[GadUc-"}WI2)bGDV~jd]]Т*G9K?'Ko7hGK: y:EePp0Btn8> ޛ.{%vւe~2Uc0SZnBv*'NڼS@41-t3`TEd4TיGΪ19mӞF1=A.0kکB^gxv$tjsh_䝏k:ɾʼA<%%։Ux$qU:doP;YI,[N3Jh-2c# ,0g$WOoeRRToOek|IMqn,c^üT bAQ+2% <ф,DŘAŚ%914Y!,훑a N.ଘm̏aHBV͓:=h}Ԝc]POa}X%>SI >u@H's'8}4o "}Ar.hZ7h%U1IQ4hPdm7tPꥺfg&r; D,tk6V^<%5!ˆ+XrˬW7 2Pz;G$P{):&K ܙ5 WHؓMPZ"UKc]T⬡ɥCMţ|q1oB# ">=]>7>s#:i!rWu,ʭ̦ S:- BȚߴ椎K!IO 7j~4m(ʊ|~v!J&2wl>3̹a8&jMKc dr--iRttE>M'wiG'C~F3/ ;Տ.h-:ؒe5gsu}d#w K!׸j 4w=a>!~ j? g䨠%z-C i($R\^eՌCVP [c:U,9I*TY͍wգ3kkf 4xԡv{!ֲs)c ko: ӗ Ij83{wcr&\P%A䢠o{9^ThztbE6. sA\Ӻu#4Um()ߌfA-p^% L/iV]?)&ᶴI``d.S!w%y<7B鈣+"Ֆ }4StPInlÜJ(#ί%Zi⟧vѱwlV-a4e$ V]w)H٤:6B#T\ Ѵ UÊ^"]9HE?(o^^}8[M&Bl9 _u=ڄaw,F>$7V_,`%,4\C9.xEdpQʹüvߛ@ d DolJbkZ. /}6a3tWf3^E%,{/ # lx?NɖYV'x BMkQcMq2]mo\D2ʘ/ jYᄥN$87c'805׹e"+//9z!p4j;jwWfRQqߍ$f4LN%Y. 3p讂0'p&N4V^7iwy M9rѴ*tq&ڛa5?a 38N&_eذZ( !i9m{sd";Y+ʿUx&v g-MLjw jek FQL؍g(-%wGcs{0$RoHdXz6?J"` ƹqu8W.`ѯd36ѡIsjţmsr+iG Rrb} m̮ lR_]Yr>zVO*xvc~M#qsP<y+HX $c@obg`)_aj&'ʨJҨ>K}YoEj-!T7T,]ꂜM/hiNudQ4+Ld TyJg#?cD[PGyiWN,5'=YUkilUB`a/˓!rb ~J7'h~AZ.HָfؖA~/Z薔2EǨ>!`'u7-%A rS$rSRy<0lMyӎJ!Y$qD/Gh¬b0lF2uYq1X[5j$ Mwd?Q ҿM`݉cr+KC +WH=kKOZxd |셾o-u"d`Ii$$V٥#_ jW#R3ʢ6-'#]J̝eȭu]fΦmxpMJ|܉&%z˸Dž Þ6v X\ U YM>! P:ǭN"jήWbG]7k:yM~,I&en@b7?XJ"ariЃuxVpoe2zÃR<41l=nz(qLXb`l't#66SUZaitQQn\YeeӋa1e>F`]U7rGKz\!qoc +>qVHINI8J[3}{ֆ,µe}e+嗂#ɣ<)3_'DYJX-ڂ U❈9Ă<)Z? &W;. g]ִOD=SL Qh_EP \\ >}= # |\j ^;  &(.A_" /}8p24h9&F'E!yxhz+`${ Xc0Zh˅,C og|;E,iZK`j$[R7RtI3[! Gt"}Yf;8x`E0}ÉiQ=U|碟-d e4-t<ֵ#c,߱baTfMW. -AV/[]@^t?8C850~ք]jO ~n+95LMy,}(qo`'l, gKj 9Z?f8Ֆk\1Ã&J;W3j暏+)g1!**.Oꞡv\|s^P:P0.GW4r􊍉D!뗊QLx6 +4͗vwx1$ njzbFR`w \8=Y{"oŇ@ؑ? 3ċq2dP|UCOejuavߞ/ˎg=iDRX_4Cj&uey;KnJޱd1oD$DB2vN;7b]w,ES$L 4R"7}UL7.Gb snG#SbĦ׋?偗p@Q;Җ WA6Im4s<% ٩u]9UƧSL(N{hT?pINUEyNP߼8 adK =Ps"fMTvR`Ws}lӍm;k?ȯ=R!@2Qvڴe#oпtE].Uhوܳm/{:1}>eX(w?ygu,qfMƃCi5R& 7[7m=|wm* 02 N(K*3pY%U~D3FFve YshpבK"RO5~*<{x Һu'=E 44$'=]xHv76*f$HS Q*cb)9)-zsx6\)*,8*My$ra:*wa 9ٞJdRK>},h 7Dx-O &JIǫ{4Q:P4sFq/82ҧU;a`1y 9`31<4ZG@(QatvoTe\O{"q;n2ϛo}a Wv}-m8#@;`QalƊŻJ2*50(r]ZH=S-ˠ;'muo0-KMLF{M 6WƜ1hyykJ0 3Z]_!ʘTJY$[$ `7*c+.Ojd]/>Q|W~ Bi;wȫa_c]z㈧.Exߚ©5G"@0(H-;ZpWݝID;Iɸ#wx,W/ FqLzӦeVA{6ºb֧46tDTk$'A͢;dB>pB;h`54h/ޭj tIP./>@FtaKy{g۶F!+`|`8}PFVR{xGah} Nw(MM"'#J0.ⳙSPqt4PW 7!`Y-w&(Hpnjt(u*ǀ  ^b`5NrF%%-.T_xrqۆ `ϥb&؏tӹ*zQQ dnRJ7t<gCvz ԭ^vЇ#}VQBƄ}̫l i b›UIW!lQ f="'ԢłYfn"FA? Ԃ-U&ॼ]C`q`UʬTΛ0Ӗ9蜿c#8_tu e58~Yom47Σ&WGqB"B.1y .A⣪ NZ^),mN1+3~Cެ nJхO$nG- RÛ<ѥWfTL V8_j*QYF}ٽydp7dbOg5/e rL-vv8!w(U]4ߡӓA} _Ǩ+OP GNӄF)J P 2#xIX"D&\T8_ڈ]vLTWb']עJܮnzSl\ϙ_IuX2 0v&ǁ_3"Cc0(}D-4ժe9ۨԠC%F <ڥns_>vZg@ b$5>Ma3g->x?|ŕrZ'9ʕpp7BHu΂k%2*/ N1 l,Ѵװt%=m0CRihŷεx%=h4*]}JSY-m=_"5`sol}Xyh<}YK`JT}GH19CO^>`ŧ1nJ l.AHfs~yJn':^8<^iol tP{H߇7`40R*l+軨/ tp2PlFM~]i_TpZký,9 =hg6HlGFm2\VuߜYU #vX\sFpq |v-z8=貀k}ģ~\^YXuG$^M5*sR{lO\S_"ܰ f C0l&B5Ħnٻ#. J?^2+U\l2>j=OEAk> HH)2^*86=fӇtӲu)j D/J*Ģx^V+Mm{f)Kg 0i;BfZ%܂.\_r]*, IΒҬ-7-mJ T_xH<8EF]bIt+Z|qVRDIobẆ8Ӭ;x*x5yL/35L DŽ$T[,>_&&@ڇfjJ&-O-v)z:vKAaӪu(B5 ]H\ #R{'K$ (w~[ʕ!oZP4PTYN+3= ]4YzO̺30%nNtn鋖gӖŪr2VlGߙv$>$B;B'eB+5VE8>EYwY%i54 9l_xj41;c6p?+-bC98 ucѿĘ$_%93!Mܵ?0^-z5 G| n-7G=C]!M&Hč?dkC+ӚoH&pgTlZTC4&(K9zP:k%F4 Hna~Q ت-PQKĞmD.̚i|`v\Z-DR5C9q]m5sMS}> DCtӖd v&8NXqgCeEu?5M7w`7blLlW 14#?cS%C2b Ζ{YKyP>j'^&1Kϩ1U endstream endobj 5963 0 obj << /Type /ObjStm /N 100 /First 964 /Length 4755 /Filter /FlateDecode >> stream x\ko8_$ ngj Vlm]UI=*9$X4QyxI#+hJVƷ÷ ǷEķT,QPB*4Q# }zLP(%PK\ BY.1(U7DB\Cik> 6$( 5c@V0YQ4+]PЬ/LW&+,hTeA*k4K %[LE$ı|& @<9FGiz42`(+3re@Ρ&9Ht)㒬#Uȵ4wx!~02qL/"l$д ΩdD$SXȘr9_8HҠR4GTE%)<9WD0-!CⲔXY,TzYb@##PɠV%u[L!4T& PVApHKHd -l`16 PB gplCv꜂)8 w* %1HIQՎ$(WCmOՇ>?awt@xH 0nQuچ_n~kwi>&6,.6=]AP)A:t 1a%5Mij 16O^r[ I0%ƁF*%@E+a(5z]KG 04Ii7c* s^\v;\% O)ٔ#RfJ5y6xXuhК5pw>[7g+D>/)|<ϫբTZRDCYCjPC+^oB,/'hZ]Nc4U gUX]-S(@^w 2\Ѩxt=E=y亢$oꄶ.REB jj|):d7"ã,fۥvȦ0PI5 cfuX#SzK'.qRb)qMSVNߦi(=)[MN@7B#ZI R%'cBTjbq ! 7W\BXO(\x(Sö <?r4aW>M֗׶p>X->X)IUg4hc3珤ȕQ_I~){帙Sy`I[~(:oMC9۱92oWHCTDA5n*C4XHpV nyx˒.IL6\їɑSj ~:x}Kڎj8qJ (%dF%D+r$l&PlJ)-2 + Ӯt sFXq9ejR5 B40OV)0/Ix>plC9vX6OPr& t@Y|4J%_@[Ҵk'9̖i 5Ł.iUv87BZ"i=ǿ˱iXǢaJ,\P)bu6.̞H+J= RkuH(S8#p,sc#;Mv /ǎ0r$Tmya4c^D޿$b%kc!D2-S00FVܰaH>I4~͏ƴa !kzӵTĺ`Ũd <*Yг Y:=dv=t`K.6{I&  Pm9~*&w_ Y))0('K6lqYlp-G$)>HijfDٰYǺ䨚0^BS ©K8ŋ$J8@`+yGw bN `j1tiQK!b.N _8o0\\oLyz4iGw+#v,r_YV9{63Z˽/8[.=X0Xޑ'edsm}[}ގ_T?4ft3k3q@j=F ;lZh@%d%e&rHy萆AO~JNqSrKЦʦ\P=}yonrzMrOWG#9o=^[۾ vn Ј7DzEZ$>hIgҖt ::&PEC _k(1FΨZE;?P~P <+3ֈrd<;0. {;sd֛zG%؅-aosPn89 "΍9[={|ށE׫+K&ҖmR{r+d|[u'7tYV'_S{Ǚ:/w8/_ku)VUCf.l+}t%]{ZJz]JZ5 f6h6ad]r}|h]}ߧn}7LEs/g1}v4;ϖIl̽fR᤺\&.-{{~8lUauS\^kˏVդ9?|mnOסjq_<#X<?đx*!8'gq*^WZo;^T^׋e5iΛ4W䢦^4Dg:m9W[Eu^Oꏫ[,Vbʧsq>gN KԂ7Dԟ'T|?jq~rQWDWhDLRLL̚Y-f73bSI\"8nzrol2?|M.R,i_HrXբsq#nfD|Q??'Y)L!muw|s{>V;2=<ϫ1133>33-s3u~\^B)Z]L# ̟ԻE5hדZV|_tQ]4ՄbyCfjHՆ>ًGo∶,eCP[jmysB_t>9~c1c֊ēte-M.t& p {͡Xd W*`UFzBe2PF Z]CN\RT yF }К۝b׾6;I=RX>=9~zsvrDqGHQ}8 vM^ӓo~|N"wE x:ڤlʿۛ]J AO!Kc Ac~/GQ'9K{ß_<{J,);o~YpqHY5l |APnEQǝ>mN,BO_c9#nI] R/$0.uGC^NN5w1(4ZC'?FPukT껰ǵvCYm&>bd&-'onБ7R+oR)zNBL$jvQa3̚gRѴĦ7Us=G -Zj$iC Aɏߞzʂ \dH84 FFxh?{a݃&~F+}~jXlȓ X\D{h% nQLui_g<~^==zf=㓥=6!huƾl%g_I=YkΙ?j/:~Wo[Na̅6Qr5 *craN~v6vnVQq~խ8jImYM"a؞Jq-Rm:jJ>:yhCo$B7e20Лtw0H.GͪN>̝dRvi=  a]8lpN6VRq,|^xk㠓2k4NF;퉾,Z?dY{9f ^670DzP~zã??!?8&9l=$l՛KȯwwqnpaTB; ;ܺоDž2wFOB$V<-É+P6~VbɲeY I,1:`KxفbU_QМB ܒS&w8ٚg[\_8Mz6mWn=GD :겾B]֭PVqÝlcm&h(7B~{/k#HipW}z AT5 'ȕ_J;> stream xZmOI>"l]%VJ$ alNAY$V@NwmLIz:}M[.O1SY0$()9@{B!G}90A8ևT}Ɛbb<D@!(@zGI FG 2-)P^1BTdʘCMJV})0&RLTAJQ5äOɁ*f*yrJEM)QbC bHU OjEŨ)*cjTJ QUPUUƨf!'2zCݐI=Pȥ3RQofQCT95cVwLVTSmG5 587=5 H1Xsaa}Z5rՈ-5(?IE1U1"6)H&afJD#@H4#ϨD5 aF$u@u2ej8E!X#du-I[EHFI [jT 5F)U5BRiT 5PE~fj\4+ KKZ\63EjXJֶL*RQ?[K) fFX$m!jLŜҥ}\-5ټQf?8;_aloݿf=lOg?Ȭ{zSUNwDf{GlLJ?5TO?xz~Me_ ];vڞW>gJwN e:Lخ}/m{ҷIz5h{ww)K|ec*vH;;H5ԾFרx_%NbDr_խG#F!*6dl19'% C6`=v~º Es~dzjUg%گ&@@rP}V@y r:1&'EȠtsnDv(v[ʉj!~TveJbL"gc(e6eqDMS!{3M1 XB`Vbj+z!i6 {G.aW3чY#R+UaJqA#߱ݏ<*3De)2R<:E+ndH ܲPV ;jB}hIъS cB$f|bC6fuOQ,YV|НqgY &aϚ^݉2D-X4!,vyߺF߱rŋy)\w^v+#dm+¾?݀o\ٝo4N"YtƐ}G/'`o#tVy!Nawβ1Ixw'l `X쿟-~XSpe+v FQ\En޸O>?\_ݴOߞ5$` ۫&ϟ' ٠s~w`~s͑_R3e,ogfi3Z2K[逞˹,./1fhp;l1[:@;@d,o`&Kvmr, ,]3# endstream endobj 6050 0 obj << /Type /ObjStm /N 100 /First 866 /Length 1956 /Filter /FlateDecode >> stream xڅMoF{Uvg? APAdCebR#'S˗3Pz$yKvOp!'suF}s1 .٥B\ՕP72E1ZB7Bu{D?2"}v"210 X[Ԇ^wBA5,.CrCXRs€=LVHF_Dh "QlGk  !XkE23zM!9HF':$}ߘP]߱z8h =FJ@+ ^5.Bi`@؀]-7\ ؑD))X )'$Sx ftjE2(4`a}} gߨv9E{{@w9*4q!rFh-r?4k*}Vn=*>z*J1tT:[4Tb컌jXptSruP(uhԂp+q+6ƣ2jGKSpਸچ)͵XŻw-y|׮>zhaLAæ:/U;,0acPTPm50 @eP` -a&M&[$$L%LIH4 Kl 0i&0&!a$L,a%LB¤IXdKI0ɖ0 &ab -a&M&[$$L%LIH4 Kl 0i&0&!a$L,a%LB¤IXdKI0ɖ0 &ab Ӥз~i߯iDޞɯ^H+b`˃2>0gU:EoyY֫' +;K~ݟ˙n|Z5E/Tٿ^`o?g;q={t~_=og6-v98֘ϏwO F:/⌱ endstream endobj 6060 0 obj << /Type /ObjStm /N 100 /First 1049 /Length 5479 /Filter /FlateDecode >> stream xڅ\K8qk9K$#&0{؞mALmٖ[/Hă HQ+wծjS!YKk]5>RSS|;)@ qUUTWicN@OzE]ovVc<>qS3AӓX| ;5=E5 ΆA\P7N9ѠvDw.z,xt *B+"!zU@OE||QB0D 1B@_vHrһTOf=Z**# H=$ C"* RSu'hP))î< ( QVG7пJAo`6ۑS.9J8̘xDǁMoFyt+:h=A_ Vd۩lO1-'£.݊9ATuA~Ew=}NE 7`ixyTɩd_q剑E$'Dq&%ɭy&6D !MCQܜV55F؞U6МJ.!zu^ ͅt`ohaTk q-M[[ݒStxH" c%@1 n1nߴk(.Oԁ[w!Mm/Ey?4J@6N}\N :rg Y6k0ZJs_1-v(ɍ䂸"X 1Y#E2{{ٜmZ|V4^ K"1PWؕ΄m>Zo7W:(;Les`ĘL'.1z69j֢T/!Hܩ>BLՊK343x20LjĭpK:f@: |4f%:zbWZFb~ |.)Z\3ծʎ̛{X+wMK|LTպ_,xaom(4wZ,a +,^I3/Eٷ?uaD/e&zj0-ZV.`W=LTK53,qX2$~~hfyżBj\HKB"fy<-~IahtfHŢ"3:gCq uS բV4WTDA_Ă+R1k߽؊:p5xdF_pvnA6M4.xA'󖌥9?ƉK2?lcߴߟd/}?x/1}cZh/cKsi R,AN7q6s}] Ϡ#g(+(hvfm/0v½|e-ã?.mGiBީ@Qt=۔Wb=Es/2Z{)*vd1wQxaЈ)S1FUD齲sSPs5v [Y4ejeSg˩;i15^U0q:l) mſz.DE [{혊Mc YCo: uWcxB^8^~ﴸ|O>'khJqgJ ([Z>4F:-h#h( G@.FGߩyN o*x)PL")jS,b2t2(ܨeQ wkpc8Tʃ0gʚnkfgqz>]FNnDؚ Hc`[[F1$bcQL8bMMyNA%M]'^tG(b ضDXK&Xh56"M@aI8i%}6iE1+jggz8Mld :M/dp41]M!'B$@׌i#Mu%BF/0ֆh% ,`-}#FFy;}s$-pD誓DI^VúzDNQ4^)ۣӜQ1IB_&/ѭ% I q-2 SPe1,cY ">zB0tI$ &<İ,^K1Hd^.JB1)d𰬄F$We!2W%e$ ؑ|&Jdj0B}'HtE+.eARpł]GO"ʼnTJhH_DժW*Tj\Me.8^5R'` eV;[*h*LX*);Qjj@ Υ j&Qk,J+}3H#(/UBT|atl5 endstream endobj 6161 0 obj << /Type /ObjStm /N 100 /First 1033 /Length 4266 /Filter /FlateDecode >> stream x}[͎emSe: Oxm|#3}Z .u$D,IKUGj%◯4"ZǼJiUjkWi?WAĢY*~ի1/+N]Voz%6/_VhjcrU[bUvp!/?įv^5.Ak^/mGOjUfyj_ZAϫ_W66Y|kw|cM:;̝ݏ4kYծWF/7~k'~kbЕEY׌1X/&e[WV%&tSN&-L[k17'Ir-OwfAè2kvtkٵ DP_jb0 F|hAmB5F,DYuf%ZhF1Z=hua,>(^ :F͛^|p"K,1Z+7@)h,ml\p%]b9w-F+ӂXn l "5 :c8-FxApӟ~/o_P`*'fV*0#?ccut3fAXV.`o% x7XmVG~4@3A dW4K:H^m`C˃:l{pֿ %bUv&w 斂!м8s@i-@Cpg&Xt%kZO1Z3#ࡍ͢;h}`cnzMZ>6  wVb}>m#/F7>]5-Rh6#m4V#YHlrA@P{ipؘ#|J!Zk 76rZEYUc'Pkiyd16h]i'1+#jiyG5૨{? ؈?dzXE,7z[yD-,$ z[+;ٴ2Xk)rDo+o?R^G( EYTl%,O/%iqDQT`` l^߳^Jp륤 ^p"GK>!(-Zw6X!b0BOFcb)<6ƽV"q\,g q@Sf|:Y}oo&uZjZ%Ч=geky0֦[i eXiKYg*KWh%HHrA@{2$yТ=gZx Equo%%OR }R m"4{ Zچ*Pȿ҄ M8}B3M@| gi-=s$ϩ;d.2"QiDgS[ R+U@3=H2!(f=_E4~@Am]p WSprkD&rUZ5U,D.lp>C!.>2C!.>2K=p2ު䮷_L ] ] ]@b$o'ǗN92FΧ8g|Y|)dՙe'7N" sc)荇we[Y붓'x~Q~w9 e\ZhV X?8A·H 7\Qr>dT6 'p3j[YivZX?8A1SؗT)K"~os'^ /S×6#_F%\ʼnNΛEc]8!RnB6މ.|~J1eK"KJ)U*ejC8O\Kn/᩶ԧ28Tf,RMejڤh>tPU=/vNPUrʸeg<EVuPqX3X~YE5PU8ii\~cAEXum/r$pV'xkx(AyB9ˏu\T)%}| Ej\pלj|0]Qa(OtVts"\D=d,pru֡,04cy!juN(:Ш1?8;L罪#9bmn僓݉И*6+NEϛ'1{yΩ1{СX]#]'yM71uQRcvQG|Fb9L'e9} KG!Re!Ԋ] 2p"h6>:Ў>Pa%M9nōgb+D> \|Tv/N V J!* kYAFC8y *!8R=g9UD8Nns]|Tc{\Oc?nHu >88A9ʡœZQaNԊչN\n\~cA9uĜRS,N 4ũE8Os15ԀƜPԘsȞC85t(~H<#q,?1($!|o%)&ũɅbq<ԘSs5ՍN\bq"ߥ.!HNbchL-31fj̥YbqiKTc\ZDQb.)1WSHԊK9^\H)P F|9 "5p퇳=gaOk<.`C7/ VM.縨Ǽ>i8%;>57SY{S>57\"QSwxɇvK״+k{R.wZx8zS[ R>5 [% m9jOZߟi|Yw|U/ɹh)!n|i +w=8z^q+UN\8 "{|kz/Wv."JUy^%B?)ɹ>7N""~M7pY/N圄OWIޡ."&2D#Sm\*V)UNʣ"haȹdč_#(Erp#E]$VНB`moe4C)!utqЗf@_VWK3)ek'ZtR%:$|yޟrbq-'M]w퇌7kǻ:Hh:HPsI\5[[Q7S".Nr$&9םks]]k$oEǻ:ɹPVEVŽXD| ~p"ǻ yɚ; USsq5EwxY9oj9 b'w4(>\~s"$i͉b6E.ҡ0et(Ls) 3*x#c"|jA|=E.)1})łnJsE$.I) =E.ҩ1`lAS,69hrVI|,> stream x}[]9n+25@jDfAL,Nv(W7Cl0 CJӪ8*GvɁ6j>rG)9G1([Qw19)drb([ESvŻzĿTav& s4yH9CKh}aF3ihmI[­.ގ]ҖQnUCGxGR0Cj<9aL8LxN~lbToĨ$˩k!t1rYJ9Z(5hn*2 RZ 311l)CH8TNWL?3>R"fFK% hFHVφgC[ @Km 8ȼ`ZVC[2jH$I|@B-"Xx3%ni5ÖxiZlhk^0ohgI7%Ai0t={hk5LZhcЦ! m*[hSdЦ%FQQсDȖ|*%fNZKcbat$$]sT)pӲS sQQQM?O/';coawrBG%r$^"ANXEYCQTrlAfr Kp)xrnX|aDBV`N{V6^9ms$x vnycj,qSD!o,R 's_1 w6 Sw&]s+s:֒>x0î7`lX|aDscY F ٣]s#N LF8T L9 s8N!؁)v6n$'%f^]+d,( B!tmz9z9  ȉ墸' 1] '@/I]:P~?B'6kr6 z9xR$y"3r>sZ9-9-oXcQvu`NYcJ!1Э&) y%ANd1,[_عJ(Ĝ*9favz_`lJ焁'je[qhmS?ڋm/@/f4crnVxᘧڠO ׶i^^r@/At: <4D1|^$Sl"mۋL:0lH٘Z4ՒJ%Slwd[%l>$䗭) ) l- |M7gڋd@܀8[â ݞ[nhMxUkIJpۋ[tԒ^6*X'r%Ol.iۋMʒ^6;(s`NoCSmEڶi; ̕s&C XvGڋm/0Zis̍|t`NwS6^m{69oEV//},6?ڵD 6ڋm/O6(?ڠ<fkyrVx~6k/ҷHO Rh$<)Y<]H7=bwN"=9fkfsJr/y`>i`>=^o{^9TrLXsN $$Sc֓,|^'njX}b O;qOORrQŐ3H"zrLLR^ 9uW\9}Ɖ5H@N. l- l- ldR0N]^ʺ8GTý* H" T^`J_69"ߦe5xUo|E`K SyIa*57TQ+TQS7nH" Sst**T;ڋm/070Ǡx\Qu󙣯H"sꠘJ׶Y*GWsEeZ~l{T*rxq,$F=JYr^c/ v GY4$MM:m/4*q0%U/ԪX%.3%X9iO.ː$})jR+ׇ_>>ޟydyFxL'4wߥh2K"]iw)弸LmAs%(HL6'BWa m&޴8S 2z0-{s rˊixJϷ!ud9_^^^C?>`^??iח##]d86+x 0_y^m`g?045cY}}5H?qEtʦS6 OjROo?xWNtʧS>i4:7/ߜ+:K>]ӥ1Ӯq5V%__?i}Q~y׭d1=1aq5^oo:|: x~2ud\)OKs:'99xÿiXR~yx~p+:׷s`V&?ONꄽNZ]aB[su:Wsu^ejNM{V()NtJ&2Q|%t>=:/P endstream endobj 6412 0 obj << /Producer (pdfTeX-1.40.20) /Author(Wolfgang Viechtbauer)/Title(metafor: Meta-Analysis Package for R)/Subject()/Creator(LaTeX with hyperref)/Keywords() /CreationDate (D:20230927193137+02'00') /ModDate (D:20230927193137+02'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.20 (TeX Live 2019/Debian) kpathsea version 6.3.1) >> endobj 6363 0 obj << /Type /ObjStm /N 49 /First 476 /Length 1375 /Filter /FlateDecode >> stream xڥKo7\6* ͮO*P%5b@}Iɟp ]HK:)\R ot,NgQ\8I6,gaԼiBؿ ɺjSf99/z>;,uURW|Ser>ڕwܕ)4"gS3̗>sάK˯SũÒ?\egb}[#9MAͣ>'ѩJS)ӈHt mzZ] Ԗ1L2:BL BBB':զj-l(M5RwZuMdDA{&fűv/ܽիC0F A4 s s$srD=RxiIIIYHX5v#:6h }JCHMM,Z>hd,=2333ɑأ> WQC<ԅԅԅ+#># U%t%t%te*1aW:p r%rlӄE7_o\|jGV6i"""#ʺlՎҋ"6 (Yeˊ_g^q.g E0aVW+A A>T Y]HRX3fu}k4ͼ_ !D@ogJE<Q*&7R+勒ꯥ!DD566-kKi}aD`` iy{4񩫢 i88 [``ryav(((.smm*oWDDqhhS 0r'&Ȧ3?<N*n`aN4=v+Yȷs{pv.CkyUΨ>a݁}/ endstream endobj 6413 0 obj << /Type /XRef /Index [0 6414] /Size 6414 /W [1 3 1] /Root 6411 0 R /Info 6412 0 R /ID [ ] /Length 15291 /Filter /FlateDecode >> stream x%yt-^Ǔ<<'9< \xцx@p%"4H6ah bCKr#Q7FW&wBt!CD?ϩz{y*Ul,5)lR\e/V@elF UPlfkVieAʞm򲊧ʞmEbfE e̶RhfRe]˕Wv X욲{fWjeO5J@;fze766*{&\*\ت,-`On;˪oRv.ح슲f^eϔ]3]5{Uo8CpX}e2eV)hT]0{ N+{3pT6I9"˳fc-|!/+۩WS?7j*;i6vMeg׍ݦ쵲f#R)!U侲X7vSUvQa!ce'.*hϕ/O4lݦZCex[*;x찲|Tyْaec^o}uʕFw*>V,6ݬ>Vj#<+[lY}QQe˜>HGejc^?kGcbem4-UvN68-WvGzJeoicX7ZZe-b6*WCjAEȱAa[%F^k ᖛSY'D(A,5+ձ)ψn)[lMc%?$e8vXe-fYVjKih[Se}4{e>Rf5xYJ}m[2Y~*яϯ͖PRc_]f+e ʡ* Z`Q*N _4HT`1, X `5`3l  `7쁽80p 8 4p.EhNe?;缟J"\<;.{lpL5'GpeE-\GQ.c&'}p8'/8crOHl7΍t[ ᅳU5NJ :܀p ڠn ><x 9*7{V㊶\~Wk5:p Z!~Tc숻N || C ^hKe]Cx w>Gfme6ZT7f5Y_h6xfOѾ=A19jC#WlOƬ|gY7!6o= -"KGexĜT9,Ogy: =:Dm̙Tg]|n1Eٽ?fg*XR,f)5 s,^`GSٗVH3KY̲d%,m ~2*d %M ҬTgSٗr?+ Y>>Ne?r#,f4ˍٗ짾1K.)_f䞆oS/[T' A9T9q>'bi34AU*zp}7A+Wt 5W/u2p۾*p7+S~sza l]J۱6Nt=fwCL#P2jCpCɍ?zDJ=3py2^p \L/F۠J=~x1)->x 9WGLBmJ+3|_>ʗ XP hIi?%ҨMhVh8h.h$(Fy0ʃQ.Ki_]lNN:ٻہ4;CvGtc|(_F 2JQZg"Jܟei(-Fi1J ΃q*QI^Jll*Te(KFY2ʒQt?V(-Fi1ʃQ`+} } d >2*g' A9T@eJ?5SzQV MZa1>y VX+RXVb' t CpK.նrw-쁽pvm=>;'q&pN8%Oc{4P|p>3]Kdpu ؕd썻݇^Ý~Ǧx 9Wcڨv{`IGcSoʔ`YJ?*2l:y x5XMW rmk\ 48_6A 2lM ݎ*ߜH8ȵA nOm=l0n=fpkJX7Rj\`_J(5ȡ)͍D!ߊ2^ iH'S;c4HTF 9~9%<Ȝ@A g\I_ mCoSXP@>U X*zK?z:f }|!Ljũ'Mѧo)ĉ*}_#V{Q*}U_TaDTK5t=aǗM@>mI*1a}9}|ۑ'sT!R^j_ %GC@#@>ѧ/}|K_w7uʹ[lGЮ=ΦmwKM:QܠR}gl=ǡ*"_479h#aT3Q}>F{A}RگƬ.%ұ+ݢi j*S_hFiǑ2wC7XkbXKS,` /aH_X FS`=l(a lmvX*5vn8{Sy$uL=G@cv pwsp .hө$>*\pn-ЗsxOv#x O%|g+Kcݷ3"*R婗*Т=E-zxÃ,{d#S*&~%6ÈNh{#G=Ronl=QY=2r{F=ȼ]Iv/)0I'Έ~OKG='R#ȼG=2﹐*Q=t{_?jVl*AOC}yz_*@zɷ>=aDO,U9}[0ϗO,-i1_QFyZ`UT<i1_*oC,|tiS7Z̷ʧ1020OyGy6 ~~Y|ǒy"i~%8̯N~%v<7ʿ%Vg><_4`T="sh>3ϜXWSaT9|$fˡ* >UM+l4bX 7K7zؖ X `5J)]al]t_v[H7?mETY[`7쁽p؟*58_8 MX FSl<\yΦ\o6#zq<_F|><]>Ŧn=_h*s'KU+Q^K:Uҷ>+lZ4iI3MiLfAOj_5@i"MDKX@iL3gRӭ%@eiLa1URlHD&44 <*m{GOiR؞$f7vs3ͰiZLݩy5̓i"MG*aXzK94}ͦ94͡iM_Le:}e:F{݁Fi1Ch1M{i^M3bnt(֠4ͦi6͜|> ~;2ojuNwMӟQ ʡ"UvS]UGY s`4C W_XX @睌S 6 +SM6>ۛ`;쀝 v `KG}a8Gg`xkpNir J|2*m}"\+pu7bKb3hKU?9[~~F~~%~r xo-p~?>§Te^pTB{8_P1\ Z aXps9V#00L6ry {8;, xl܄0U $խ];,a2*i &p| S`xo5>Z HUcA 0Ae9|8U0-i1L@a#W1| h1La2 a DnZ bôRud%ô!q/6Z |Ink~឴~ f0PߥS=N5gxU*!=Qݣ{LUC-T#bi CԥñMaQnr,%*X+R}Qo5 6UX>Uw.Kտ;`c8f{M1i3l-UEp t8 8p N8 <\p .u ;S/K^]bwޗjVƝGfoMmPkfĖ}x ΰM1(P7`w`}rS OpYPkb>u@~>F:7A[TH5"pp6a|_j|C[qk\kMRaI5o*`;0'_d"wwslHߟj>o)"sCP?iO̶G~ӧ>OOsn8ϫk:c+,gI?KYCx#o ĮJ?#_)σ'KYϒ~s?s? bv6|@@GnOcQkxWBUX`wu] nW/6+` ,N5Cު^M\ŅK`]6ܛXmlM. aGc=A8'@#Q0p Iէ(p T"6p.AZ}nMU_M5>VmpT{K}x<5$ǖ;)IOj7RmbS'E;)INvR "g]hh -'eR*X hWcAC4B,VX nlM+`%1- a5`Gg i9ڔjnVbR<sȨC9a08j7cݣp I8 scewb8v&܂6ah;p>{jlWl!<sx15d[aCRk  [.Yad[jci-HWҽowhLcSTn wȼW2rXjL&^! 1nɨ;@2ReT;{˃@^IȲWR.z+$^X@/zσ-g碞{k}{e+[/G{ /^q ȼW1Kܽ@Ƚ/R]OĦ(KU5ȳ->WdXPo!}E[(,h dXS7 _hS_q#%/,Iu{5` 6~@SpJ XS@tp.wQ\v~v,q ⑻TQ܅G ccxnBx/-B<<Ս/u{|xY2bp=7rl sǥ?.k;ER_H\'URw6ǣ`P UP 5P uP MZa1M{ba8xi u6F[`u?[ `;삭Xv8`w-셃p1؟r޾ mLEEt6Cڌlբ77I{V5H0zmq>b '(Pu8Tkqc M:acjX.>;\ڽd<|]]m^To69yΡ->0p N¡԰oŖFG =8f|Fe spN}[c˼f/w;lWbj8Q ܀p .܆k1< j,*]ϛz/%;x#.f$JGjꀓ# G9 tG8Bo#+#LaH05|9B0ϥOPoD#\)9~;ƳLaF7¿ndgjt`F4¦px5"xAFJ}ߢsF3" bP`$H?ʤ!AF(0r=2Җ5H3s2—e/#a#F1ˆF0b#a#F>yT CTBTC B+DROI[ReQEG6/eVJXa vVhI _y F]^CpQ8yy0#%<\p /gRWGp#Sz^afc4{sKݨrAAj #x 97'fGlxmg3 0b`#1F H@A3sC<x0 `<:8( l H ,y1=UScC Pe%;SPy Nwi iH3@ f4 i2@3 e/bA2k@F KG:mj3f-vNi9xR˱A:#?LzTas32 0g$ȻmQ/WDxqk,%3ǜ|22Ǘ9Zb*s5F"iHs#i2ל6*shCs9g/sScXCsqa\)5}7vQ3G99M4rcnjё=6)N2G9qhCs;VYj'IMBST'T)5G9J]LM'#殤:4sTcSFs7Sp#_E?[k0bvjK12G96ͱiαiAZg -E\Re jWs{UqHN;Kss ާs?XZ#ROJPXeGLCMjyWM5B,fhVX K`),V*X k`-xیŵmۢ;#Jn v{`/pQ8 RO18^zq$5XzN)8 ljQp15ƂKp eq79oқ//kxemQޏ1q*X|W@;D,/]щ{rj7a0b7IuNj9-*1 nLP` Uj9[&&"y?N ʡ"XZ UP 5P u?UNCCjyŘm,%rX+a5zzal-mQ׷v;a=~8#pq8'\3ysʳpeZ޽:\I-7*xx#pn.܂6hp^?u]O E m+Ejk܎N+Cd>$>G! Q`Sp,mE@! Ip(^%! IpHCǺ,"A2D! d Cqeк27B!2 Q`>ۧC?7T<Ĉ!F Q`C:Z~"0bCbE(11bCː̇.xUX2t1tx0_RCzRT1VU#x0(F~tl*I43d襱QP UP 5X/C|w7>}R,hZS7ZbR C 2P C 2P C 2P C 2P C 2P C 2P C 2P C 2P C 2P C 2P C 2P C 2P C 2ȔX[g$( *:h&XRXaUZXalMVa]^CpQ8SpY8\KpU܄[p]#N]eDdyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYge.wɼK]2y̻d%.wɼK]2y̻d%.wɼK]2y̻d%.wɼK]2y̻d%.wɼK]2y̻d%.wɼK]2y̻d%.wɼK]2yP,~_s#|F32gd>#|F32gd>#8ǟLokL,{JX@2̐a 3d! f0C2̐a 3d! f0C2̐a 3d! f0C2̐a 3d! f0C2̐a 3d! f0C2̐a 3d! f0C2̐a 3d! f0C2̐a 3d! f0C2̐a 3d! f16o[m󾇶F쭱m}m慶m^m۶xWynyAn[<#Ãթk#?{]Xnt~!J:;iA ڍMn7"sIhpBqXhB{v6{ġ=^l4Pg=nD\ۯ>so~1nK1u+-1ՖjOVdOԝnCLMKyyLKK~/͘zΩzV~!;N߉'iE14-S/6tԋlՆz}Wi?(^9D6om3^Ao-F/wC(mt(/Qߧ?qdXViYfyiYfyiYfyiYfyiYfy9QļW] g2Y^pHt1o~H ms䍗97>o4}޸y=y8O<#1y 'py繛ny湛ny湛mygl:>形<ü>!y|^y|^y|^y=C >/ >_ ~ek)A ʡ* j A3@+,%rX+a5zal-v;a=~8#pq8'3py\+pu7A;܆;p}x<'sx/7{AR?CX|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9O?%)O ~JS?%)O ~JS?%)O ~JS?%)O ~JS?%)O ~JS?%)O ~JSӲ8_U endstream endobj startxref 1439148 %%EOF metafor/build/stage23.rdb0000644000176200001440000321017314505063357014766 0ustar liggesusers|u/A쒨. \HEaEDEII Ƀ0jf DErq[\ݒK\IKٽYpܙ>~=ss&Rnks't,cZ)5r׋.cG\}~s߁}o:v6&ձZj,kz@9ѩ7(筂Yj*bˋzpv7tW,sM^0V/v{9_bsġ_WޏnT$[h6)7VhӮBeRepc1gD,l4ui`pI-Ew {fu6h>Eu{=P Nqx$jojz ޴"M/ZF@;!|;k@I_+~xi% ^rnRYӍn(fVJ@eܽk5LfVȡL&"ن2 ^Ɗ;vt!fw@'7%=o[M//Zz%2àQE~W(we"vAM$o+c$eJv1A +oˆ׭.K sl@da 8- oe]EѾ[)xFj?$'#<*D7Xr,, ~$ CkctZzBˀWr]2^2i¸x5c#Y?Rj4լ 'ݗe]ͻ}OƞXp3mf#}x #߮5̩i(;ufȟ?MVYEd{QׄAo-zpf#'Nu1\F.Y`N.@9̬UK 3;xGMZ۝ݠwǮz$nGp갰?R/z}mqYQ|VYs(JP`SvW@<]_w8eOӔ5yK28ι/j+'q6@(kV!; sJқQ a=#Iߧar>e 6 zAVToaNO:#oNysZM|B?à'o`݄w;}K'GēuN{h\"!Lz9JyPv˛}ЋZZ2ˮerqNYD?]mv(Tvymw,rK/>p@tZifW?qVNh:ZؠZY51 rfA*U-y>%_b_ Kny@R6|9藧m;Oݶ'nۚ'.-5-8}A@]0UәfafL|;Umn_EO *ЯRVէw<I{@'yOF^ |/{2bɈē'[-W@wjVd@Iy&*EmNN;4U;LDW@)Z׊H_:=|)aVt :/SEup$ˀπ~&yGz_xwphHnVdOaZQ˭hJkd؇yYeafRkS _Zo銼]Oߡ;"fE>}{_?0<#C_|=+RA=hF |w)"iK?#hT1A\J-> |ʘV~EciKKRH ˾!G?0 GHjaY:aF_3߀eY2[01oAm8=(x߃:J! G)q0 e{ڒBy^ֆy˶5k=22TUO*sD~v$у@|7AN'AO!"Si폪H 8z&Yr+ d*,qЏ?"qz`tŜ2_YT_/kzѱ CE6y q-CO~1j@y%@AA!?L? $ y0 2mJ TnkZiTU@?̭F"=< t=x6DĿ,.? q\9J8hL$@" 8| פ'O~*bG=fh Zb ~4@& u}x\4?)!]/Pt&4g9W̼^W,Y-0ktט8VXZ`U)Ufg@m>P*z jЯV{mTgHoI [Ί~okcx{t$+2,hcOD: 7Aflܘժe߅h:kdkfTov?$'~]@Ku?ē~#L O6 !\/puG3xܢaDf6.nӎ R{X3^_d홮@?CH~'}OTF}343?k#v=ςlN@<61_mlղ`l}h:? rxox&F1ttCLG;ѷ%ASwf=p'\b`U5 gL.3U*ޕhn?xozW]h[+=Dш1kUYulo^n)^eAom'8`%βM/ x"7*/:.r#Q^|ץ_Zn3[OZkrҴYY1lWgy=qXAzWV"w`Toy;%Mmآ3lCtbU'Ldi'!Y/pEG܄cb&'V+B EI%8z\]wƌ I<7$v RC DkěKKn֕dy𵠥NDˀ-mƜy =]ߘ~A$ {k={aD/ lUq#6xm!$I,P4j[}jYS0x:1oEm,Tk5h -'r-ȵ 7/Ul@y>pBWXG-\ ',.&@}Y@<鷅`%xl zjm9nn -k {R9Nycbӟ4ܼ#Xr}RL1VU~#aס~hm:Xm\@<鷥~O--GMs꼩֜!'XHknyLScZBh' k=N*%tݐtǛ+] *(;|d41M*iפ9vnt hv n~g'vmyvM֣_Ojv/|d*Z@kz, oHf}xw+`OU}#Z~=87(A?e^PY+9.nY7 W2ŇY' ~eN;T0#gXYK԰>VۋL OmvwGz*ECKBԺLjS#SR D8oa\iFB:#7 aO ن ?5'e2{pȦ݈sQCkں7c\٭{h'^b?*;Fq]#rcJNwIh>,2-RJe*w\is$$̀1[wڐ8&Ή]?pmu[XF?ہAW?fRsf:ֿG,%ӡ6Z'`dT<|h[-T|FR[l[d"w:0vxqjQcSe1Iy?UqgnbQ\mֲe,4*ks -&;ȧ©ṈN)o^>iLUqNwhð}T??'Ru?lr5Pnͮ'h>Xp9bL|lZ~}jk+h7V0>_̼&o$X!~}5Q40B >3[}B Ý5} 3ek\l֤cǞfKB5 ({-0[HR)=aܿ$M8M$v~ӄ1C4\o7Wp{jl53O"Wt\@HE Ǯ9MHEL]RL#`ӄ1 ~]|ӜRɠ$%vT,l7LsUGތ%=aЏNeؼ>jG-ekIh&l_il{'p?OO%& vo;/SO%C)w%;`}__u~g9B0 ӎn&SC5Q7+4rD+Oж o Ľݓ:z>.S=IG+k߰s6bd#sYˆ "ZPE*ӝRg%i¤[ ӄ1˶zUf]Gժ::imL1PΨz'74*q'Nwp–؍ Nw?a;6jm5pjCtlIqyYrlA~ӝr)28M?* cjt^y 6۴`ϷuNEI5]cthܜ4qn-ϟ7JsY|ni‹xFJ֍g+]P"c~@Gj)x(ҺKu=Br\Դ+;Kwmjg),Kzv緀ӄkA[W"F"K(2W`hS5_@+m;.iP ֑'2gؿ2;kjo W͇=>?Wy8㲽}ӄC}.7V{#zV"ӷ)BԾE[$[*1PM]ں+R:O %> *'_| )f9&gp*4aF>MjU Ns`KS#4ۃ9zv 1/ ca/7 JҒC~W5UG&CR Gkk?G^5q˨S2Q:{K8)" lr0Xٚktu.^iBU)xN)DP9MSCRӭ$-&lcB 7q0 i˜:Oj; 4/h;aࣜ&|k -#wy eb(ǮLHj>v26pǞ'bA]ih=/ DiGW3 |%glO dVӕz2";uuZIhz!LEf{ wq]i5Eqq}}6c qN^]Fn5]cW&]dN5IcW/>㺀WzOcV~2ةl# /?[MD+1r?NAcW/>U#$uAMkjh9( Qm?}Tصӄﺢ.7VՈ>veBFu 5>vocOZy@\[wTu. -V-3L[iݯlUhJwS|/ />}[MD>Nķ%>II"I4PZ U";.ѩi]wArr?wArs]}-]]]A1EA6>}ʜ]$U?0!=T;bw#p;w˂=y$ eJjL"b:KK5'5B"6h[R GF'ss8coGz7ItԩHb7If[A5+}mw~:H&I>5пNIbI *-xw ZM.oAG c}NFc}eb-xZb Q`jrAOG^7T/djVX:Y-}Q~msKEoЏ8v.4;&:J1/2ɢzvjYȳA&Q.}@?OBy*bo-9m&p0Wtg|EiU9ŋ#[9MHQ~G9M4aLM)Xc'uN)xXw:p~(v*vZr*dyN^ #KM[hV"))D8MӤ\1 ]@gC =}[/!_R9}߀ӝ?GFn51U#XCVU,dHN&pן\VPӷ5Qg:6LnvűrN^ r{{#˭ıF9ϮF]Z.lvkW,e[-[cڷ+j8bVѼ`MaH8iKNvm4"ei˜қU2޵ xӄ$;}\C&LCO's0Lv=|]غi6BTK`9p0>ӄ ¤%,Lr^ IJlKY%ITc$u*IѴ0vKx,b5)~:M3DDϦiƮӄh_[U"Fӌjhi%iFB64c wq]i5 5/9X!oͭ/F5]sN^/BFn5]}EmQn"vuzYȷ -Mx1I.4S3 ]Y㖜ipPZ`.t=^OHQ>4"E5vos?Muk[8-w[&lSuexm}4TQ{{78@n{b rHFn%11~_7HNMFr P$EJ #ea\[džidK-GdKj$RJMeHiI/]w LٚuMg(bca@޿vFM_? wom"]˰nZT&^Y=}wO5_p]4aiR45Pg/ͳn"ndWUl=IrRHmѽ3.hz4^'qy'逓ح4arcӌِS':4"}-dxӝQNANuWˈ8Mqr8i44rxӝrek$ 8A4a  ۢuNKT‹$4a 4aL,, EࣜVxL/,1NxӝR*:9Uf\?\7uW2N|NUzL^/%D{?C&T4 aN9)5n+o~ӝ[cOo&7ÄUyP9U6$e 4a[Pi˜jy_61 lfܲ7l,g hsނ4nUecӹ 6+\`Rpr ÐuƱk7 i{遳44¢Ru!@:iBe0νU[C4M;ܘ5ʘ9#/Q6lh>\b)Uֹ:C&̲4uB˧l̍;!FmUQO~JYZs#'Du$ԛ*{-'pu)wvd=M4)Y> IVe-rN4%HntS}wMČ}R,j~f3{VNn[`>ib8̓)Ή"M`N'6()ի7CB}j6^+5ͱqRݬV 2uS?d5e&v5̙F@&B Y]l߃GέBo2srTd@7y@ =п۰ƞ~>]f>gkI0:#7źnyٟNy3:IxJyfS=7m jBN;4kE},bxGv:*9vӄL> Kn&| -)[9MӒO{VF(+OyF^7DL-ϧ V01/N*(vHAreRTk'Y.^䭝ح^ ʸ\Kk[fÕ8ҽ j W-Y h&M<(Y3$tŦD~l"`VV, ]R)mj613v؜?v wL*6aN`r0xytMzAl(^ u[H?iʖ W7N$wtt{b% F48;OZYG Lf.|Qw"-N23tWM̕Gu)$u͠7'R-MB=uDG!)X-%Ĕ(l/*4l*Q9% ?(Wy߼ x/{w n8z,_RGv$ CRVǽ`(0^d88SKOZyL#?NU#i=ᕠ|Aٙ=%J27=P-9˞Rn-Qbn߫@K(hA2:. E:Z?gl.B6דǕgjij!R./^[' GQᗌUwڲC 5ݽmuľK6ʘ}zX>Y+'5emi=F2rZĂ퇊 OVnaj3iy]qiJ;aM }VaXrr؝΁NcskV y> I꘰_ űձΎwb%`iv 1Iկ\N05p¬\=⧢OBvzSS@V\c',2lFn!x;yHx? t,oըH}-5/T݈(ρL0t'W$B(«A_VS{Rgre֙8͙}پ?l.C(Dk1)(f3#٭d6edewK*%T706e ;{_dg, D#@kżRaƐ3eěH=Y>ة#G" w[9XQ_9  7RGw󏁷, G};sAni`闲W]k^ܻ#raG>0w^P, 3q5JdʴeQBcН"+KV]Cml m"v/P""]#p_bÍ%_WJV1fY¹BG5Tt2Ho7ƴN0=o[Bo( ^"42ֱV(tK^\4>_酮1ӕMDb- K2͗'S"ZƯl3M`+3 M>/dyԦ'*FpA[%ec6oJzYy VC[X,tsj)Bز6U76fwm8yۜ&r#[47[:E^XRkj}P7 $TwNubA^U$%ݦN+|j/,cU|50)JfNg~KRy4ͦ22/UZ+˘6u%tf7[w2f0,H?OTQxz.UAzќ,žb 56cUOi`},(j$'6{ی02x576'oME W_@8~7eFׅptY}kUW FKde7&t.{䞱̍ÁF!L|)~x@(ٿJȺyhΟ?eAtZ;qNݦ }ӻRؙ[YIٿ.-fSl1o[s~.ܘi~m.EW"cÀiEfä0ԘA:}>ӤTP!Cq5h k$ݖ7 ﰮE ]ႆ9Ģ#oXD!#a\o=N;tCǏ G!>͢AA΅GC=a/kUp{*q}xPbBtƶ0fD[k}M/HT!nF ]抽cӠhAϹdtF*.nȺM;#"ю_>ZC-Ay|relJ ϋ7h͉A2 ;}Z?kNŊ?/At\-o'C܍#A'.9PWI{V:F:ŗ~ }J 6VTptQb jaX j +C /(4pL8z4OYzV0kPΐ>ǦC=y=rāw@'ܔL_}i_zZctMWF|;О;W6r= g @70Y-}i L_Y?MhL}˞چ ڼr*aE8>.>Ѿg4ݙ+5f} qA5oȽ1Y!2Ǜ86f*>do@6w=iBE-_AYpKSv>L œRpOǼRs ʢ TԠb wqMdbHq3LYTn .ZK.G~U&Eg*Jgo\2`e.rͳw웩5BC !yf) ՔrM[ 再R`:EJӅȸ"7Vk\RkRbx^crtS=\v^f9=Da Q*Ыb4M _}{T9y@; Zu n)CHx&Mmj)p92"rUk" _) Ev4D7_*k"vbV@<} up9vp0[Wگ\@<1kE@q@ b%dꘗ&n.?s^$ZM s^$ϭ缈y[Ϣ9/v`s^nPٜWGgNB)w GYy2@=CI z%$Z/iz3^W g'{a{ }G?1c2ӎsllV4f"D*y'A!K'7iy~ B})ПRzr@~ ?# xgA6>sI_- 7ꐎ ;ECW}6:vqB%?`}Zt\r%9t3mUm6*ƥԜ).񐨚U~[,N4e ~ Qبy@~G/ݯ?cq/m̒H? Zη)Hoo '~[sI[-$d/$kz;[+9+vm6 =NCGxwZw Jy27~c= @/ OF |?hKFdIړA0}OFM@<{2#v=rN`NA<#x;2q;q'@"}5ovz=OdvzS/b{;z緁4z;zK^l 6B闢bp!ȩʛLGλup Shݝ8 ڿ0"`ӝOxuG Zड़3'.K=`{DiK:Ox5s%0yz5I BT)+ooS|KC$a0!_~Ԥj" QgKHB |H~'|HϠ "࿂;Db7~HxvT;~=@}.i\K$ߦ{]a}&6݁iچtBszb;o{̌hh_k!$y :ЯKsW_یF! 7~:OT;tTAan_l;zw@˭FZi ' }?h[+!wA:Z*OēB~4BNCZ,wY/U0&u:NC>]3l6+۪&]]4SȍC&lȍӄɏ܈0p ㆞QobtM8MvMcIg!%d{YboS->4axN~Yb/V:T\mUl Q"u~~ڤmMR9ӠNi]E goZIi]tYMkwXB^ʎڞVɖռEkdYlo5o6,ٟc2S5im# XK^|m/ͧsMYlKivf_U2MmR> "Eq$iq$]/s_ V<蟥_ '}'x9g:A|$F/0kn-ծj$ZKf/m GQnVۿiMi}#Z ׃¼I1`^/S?^un6y3WB[@oI_WjJ_ qX% s jǶGJ4z:ĶgOf%~:`jO>;fJ[Z]I_BnvNoG bk̰QSf^ MJo->g[ۃ 칻?2tn۴ 9wZg]w랛pQm(RĖ8| =пƼtO5{'7U["'I/#yCX$٦#jaTV`!5@+2Tqn)]g$U%#/u)hU\Bͷ bpI񚪆Yh28[q3M 3l|8Ԏ|sdz.ӎ&\"4a ~V:BiBeZ~M/9Kg8M('o~?+&Lv[&w Z>ƭy<~]p,몝@$Wt/b!2ͼu"ءb>vP;{:RۡJ6SܡJr}$~ѯ#9 ICO O!T?}4@tD[ZF&8AfuxWHc&T0: .8NLyWEG^AR&m0אOwˀ@E 7B0@K>#vAE^ < 2,j˃@^N'@OK\yddp.s޵]B;-Q]_OB*')z8/ꎗ eS04>(帎QvXYVcʖ dm|AНJ7p0?whŻ;T&Mzmtة@~ӄ)ظ8{JzM)9e'iV5g1,{31#/{_}^+񆝳Tx#`5f5ǢZ3RVwj994 1U)`-l#:딹K5ʾ$̘0:[Y. =^&)ѹa t^*)~Bv#/Pm<$K /Z$xU H&oJG%tCk-w4[eA_*YTvFT "1ۄ:P?8arQ zDF@yn_WwͼP:F}1'Q#F! &d# }4`O9Q[haRB^ R+xV`LOI;ɈUjϛy3lppLGē=o oIԞ=Zre漮ќ+޹ܨ6Lmx f7o~xҷۭ᭰p`@6E~|W\@P̷´ }gfMx7sbH@<6DͼXQd1iђ1B5:4瘑Cjxp;hlzlp5) z;ly{v]W@v[<ڭQ-]à'oa݄w;}Kǂo o;`;X(;`Մ@Kᘶ;ēUTn7,7hp'p%,o m%th2r{'xS=*#kbxҷCCiY-!`/Pz(TFA 9!;sA?7}' '}? c?/v)? C?{9*2L-5f`OE6}bx70㉛~08x"<NJŏ=‡A?>?O@<[={Ů^J6ԋ뤢A@^iŹe8؇GBoy -зD-E.$^ɋ\|ux6e. rZtk%؝4vL.rmq:?Vy%}PY:7M $A>0& 9H}<yQJddi]s><=bN [2"!1 "b!3@}Y@Bfg- IkUL*ަYCferE *%9 "dVgCy3-Fc>P;f@'1c퉚IAmGT58 F:y8 z}Q3z@[GĮX]I?j& 'y[  Z &yU-ZXP6ﯴ4ob|Ӽ=~ZF+.h} r8n$vUyӇ>!$ˁO~*< |-VLCs^^mcJ)7BkImv oI/[ e?U&F` ^2**VF۶0vUK6Y-LS{$3W FyLg\0ApIʖK^wư(:{Z.ѳ 뼖ӄm,s;n4Es;7 o\U#F]49#qՈ*B7֢6UJMkk,Oo`Q -sĪ xj͑EJ]mzwDAgKb"OuGNiWCn 1z+;7ykCq6L8 z8}&#I[Zc5޼S-<ŤetfLw6Yӝ͈rPus6 hev]4WIգ$Dx 1Y}}SX)!3Rn~SN&Ozհ%mYg, W7NaP N=\~,G5.ft9*QW}qҜѝ!4sQB!W` ظA >!QS}n1àN>X#vG~$imMz7z`Y ݒ^.SDMXBQK |)νU ؚ4I )rpJNWqjw G*rd-OZ[)<%ZD-uq`bvfb !t Tl6O,{JBH Ve Xp*6 GOn988;;Ȝ -.$2aQ:mCGӖd:w +S+VK sYm,e i;V9iw[s^qQIfifڀ^֋s4~xha(ASyu'wdQ0f9 IIcAWFKATH*AZ:&b!ˀXڟն:C<|w(I-X&uCᡡQЎmC#[{~chӦ-;޼i?+ΝYp7o:)7[ ) 险d_Wg {";'m1tn5TQQҳ]9(3y=VQgvFi9t|U`?D xM8=X (9 APYc۹6Y_56m&;|鼘|3ԜD9^ $ߟ o?#_~ g[7Kmw@Kmz֟ ZjaCgY6<003#I#L1lCCCۆ22uI;s01.tgg{by$N0/W'PH x9KeD .O8%!ؕ>&͔M|om:˲l퍾ĸ EEȧ 3Guk+0pJj?UfC+X&Δ Mceh}R2I//h5xMQX?UdM1 NƪfZ:OV;b`;i߮%w{{#@6oKqூ6DwVhٵuHB?Gp֓د?S4q-l<9jH> h@bi_>oI[ 뻆j}P?sޞp^~' 7P3$N0B*EMb׈] kҝ;4³&߱9smXcsϩX6m Un Xqlyf_ٕY I^| SssP}m'73ikW!Q |*g@K sbE-UUh" lEC:ifo_%Ѯf@oQJ/ t+p {;bW qִ+䈕F w4Pq%eN1FDmF騗#<7|MjU!Į|~u DJMU d8#k![:$߆*yklu`mۆHWF}H1 aۥON)7ekԑ- ^Ʒcb!0Ο?⏢_21lSGu¡ԡ2\ľK@<<8S{V$YP amvaP"jٔn5ph0نd+@_mH&bYvlD_uʭB.=t p`:FqpP:Fq=pplx؋^I#iERb-ݯ \RnGek"*DkضϏ9ar>Y*8Zj `SRQGzY}s/p#ɻb̀Ķ׫kxjJNOJN*j:*U8~8 zRY΀IǬgA6m5A.?rWFB~Ǖq0(SȈ: ,b%`qs.TlH#ղodqO1Os hMiA@lfTªCӼ9KB.D'ǘ%9ƌ]54ǚϔ ݩhX_VQb9Ymec*Ѽ#Pce&S UEA>Ն1>i=בP` )#8 -7(?Y0Y93͘uf5!{t힅5$,. xҞ[Zu1kS *Vy1V  :Q46gvtC9˷|JYqmT{OBhz+3!<>rkD}Tcd F, #a?.bud$Yb. |xFCJvYθ^>ab9H,z,pP| k4=0jOB&gY(FGWI]/oը; n-:} D$̀?&|_ aׂ^} }T[=1ݍTf}+%fM "KKP]0xmcgdwlh/Xׂ\^o( )L?MXn^y@,(z2 @x؅ 5_6f)d+!a6hUHᣃi%FjJ-aM3ЋE+, Axa%Ȳ< _ >&otѻDz#:H.lj;yzCx9۠7jtz,;|7 vڔmTY>O}FOx;bfuC*d" UmPG5*T={#kFVo5ݞ=~ $\*'͊%3#MYjVHF6WG5=z"m(QGP >ۻYfOa,@ (rގRƻ maYXˮUEˡܳ|${Ҷ}DL-D[ 1qatӖUG];!:{`o՘*|29* z7%y7'T*z/3sᱽ{P{A\kj]75]B5״> Z0״:}?d' z~L|e~?Y>f5Qhi;JxYmXU8,@]BlX0d# dHmC99p8xn7 b\%еY>3YfXa*/aD.V: An~t0n,aÅ D6h8UZDoBys&OkuohVĥ5:^b}$vn>A$'3f5k5 F((@twIHMx`oǎ`K7yz~ tYLlhi lld? w[ \=lM%6~ {@&?>ɝa#n M#Juzw@,zaV& ( QӐP]Ԫ%ǬϠMxל27OvFԮ5ʹg3vlJiMe5|bwv>gqRBL_YB>h={ yUŠq||ܪv9y۬INٗ_i3WkLk} 6w }~r(xzocL?>lwcCN豨fLo,o~cx PHz$ A2ҋ~;H#b\48_+oˆ׏n5[6ZnP,J "QGn nsC$q2i6C"u G/=g4`l9z[@P׀Ȭ`y/-7f?튾 /-5Hi ҂;!WJR@Cʺ_Crhu8ߕ¸xb[!jgf)y-Dӿy}̕&hYXvf|`amMMGNPz^> =/@/U=B ^?[.㊳'fH NѠ)wW}qK2栤VBy+5x8C-SP$-o)Ӏ5-w$4қQ a=#9PVqs09Cdز55@<;5eNN;4U~K EVW'梷հɴ90DKX-<)հm a>%} z[˜(]Ν4zG[+I ^+j{:tz ` ptQo@IѯMEokakhs7xom `-~m{Zmk0nd@wވ:p)lp9h@ y:c,avsGg 8z(y{6L8 z8}{&#Iߞy17 z:Sh[n0Lmf5I:'w-pN]B%?fah$moSBш&.лb|e̜zJܴ%46 |#4aaL&g@K+y"cMxF:J1JW~2}-dZA1u2M[]Y-e5&jPYGI7 wĮ5_K'_OpA#8Z~@њ2zQg x3mU7 w#w6k9m?䊎}"s_t(j3NJ\'=~3 xo`mKCB^dKh^4>ܲ%Ķ8[h-7qE\A뿽5Qo%=!4?;ZFHxt Įƅb_m Wp{P;EbWvv(W[ȑ$I֒+`7!}%}QTZxiܕqHqŹ -G=^ b\üibk ڌk"5=q}0[՚phKzh%ʎ &MӉ$MAKi*%֨M > a,3!lǀ~$9|Bu8zBI,rM6t,VAWӱ(QT גt SJ,kcڞ'56!I^|;跧 Q,DBNbNˌ $FrXkS*[k1minf6%0&iۚ2ʬ.3\}@/9Cʼ1+h.e6'~=D9&֋ŨZ\%GPqsNReyxGn>W!<~Nr)П*?1iQY4`Vu e| #xloǾ#lX/-UZL2wGfy/G[uV"3lx:B5Ͼjb}M9i)TPv57kpJBe9Nw咏+]pӄIǕZ cOK Os-QR~{z X"n4aӄi1.'H $ %$|ӄiE x]R&b 8 cm / a}2~9ßac*rPok]~]t]RSfp0ɞfkfzɼx߰"aCgGpK -uH!O$v7G@$ߌz&Лb*?P?6|a(~RmDEN4g&(ϣr移̂kUY4Z+EzM6&>OױYfdhd7sN*U{ vXl %V֢!D ̳6w'(WvÑlǜ&LíQ+t[Ţ ji$܌&X[e3?oj{>ˬeee= ?mԙ |%﹈|`R˘Z#3~dI[ɗ&oԛxG$:L*ZLG_z/8v^iBE9F\ ӄ)(2u&Z1dQ9) 4$dnt :-&L*nn4aLҋ*sX^6^?rCRm4JY:^`1_*nO6$]l(?&% ,m.&mZ];y#v;%ɝ0^2fq +ybë%B$ul9B_ Nzw#}@'}f}s&>'!V \&~3tMf5a>77$jf!jM>*Nh7-6 0_oa5'z[OijZK~śxƎ '\wQzzTpvٛ*1i9yn-u72@"^m6. 5 '$o'TRRDnWJWVbvfb.P,{JBH FI7!|n~SFGģHGfggst -!xCJģK;MWk:jَ^b%`<׻.8<OZPQVۗjGi#g=T*gù{؏b>‘Wʴyoq&ll\CHV*En\YE C?Ϭ;ow\GiGY6$d 7@CaHr}۠;%E?KMTa y~!*TDŽU,G[k3#[HL=S,z0+Y +/&)c2NwJE!ʛ19K?i1]C5= G v >hU.Tn΅X}/%BA"ma!<ņ|[ca?&Yݎڭ}6n؝΁kCB/}@+kcKGvjk>Ώ$} 4h)OrΏH;m4exxΏD*AuΏ=!+ Ed'mZ:xi w GhI &-"0"V[:6ېm[B!۪2!^]Jrk>G*ՠVnrI,hﶰұk9й; &QM&qPN]J,6>,<]N֎QM$u탎}N{ vTW~UVn5TH0xY-1x7~Ѽ0Z:'Ll{7ھͽ)Įwk< zbZ{~Vi1.h6m~)nT)ln: D.(d' zor\ô|ӜIL/?!aW3Mw;d" Um='lcSOY,wDWڎn B̜fCrSU/~QOJ 6uo( yC qY; pOLX;1:5SqG5X%||KkLY;!%k:Օd;.HtRS&@:% ~,oXv< r1F Ӵ؆8F؈sſ"CYGn#٢Yg#C5bF=3Df {n:Ն77O=.PdyBFBu=T$r9PsRᬖ7ΎGc_ S75l8Kv;AE. MSQ{: ʎ7LJ1f-;h'=*Ы=xGY+NͮA;d`En`U*e9u/7vxng13Ve_10MD„/,DJx\m|F@䋺hwߕ5e}h}QGrZ<.R`{ ;$ct\OM"kfضes!-;63mªRm/gٶf̂Q ʳ 㕫k׸9_x8[de]g.dYQ۠;]>0ȩq\N9)53ojj:5' Ӻ?5}|;9cʆ;XƝ>ݳip فQk(ek e7qYm6T|χM aN3\>^Ghz !Iӂe}mwdɛGĨYY\k]{.iݭfBjE $^'v(q~م8$|g~&Y1K<|#ؗ^ZČl`:s6t~8P J8T=q^r˄gEcFWp%pU C|jI &B%堥&%JX Po#'qzl:v7s^Z >J|ɳSC竈=$2$ eIKzàq~D@<;Uܤ=LΩ, z;1n&XZ2l3K!Z1n"lkJ%ui a+I=FDT$ ==8bd:W$!|rGgAF`pRN;4UX/2 EHYL vw_#wQ.fMTKz.x|d&![/PpŠ휹OSi/KJQ^[??/hX>ҜiZ,xW -xݴ蝵A?|ZD goZē~Z&٦';$d֢&ZӪi N ]jgz@QPrM"'[Y@8zFY1jD@/_n2/N.M0[P/_u$N |w$cz;A3n¼yRu#U跕~wt]{~C/ ;=LpͬK T?9qan{6N5 "w"ANOv"$̽@ߗ|'B/!'iCzxw>g}*t>R iG{j&wjmR) oHf}xwf8B/G\W T@5lޱ΄1ҹ. sp w FcjWN;YtqQx;ulU,ZSKI 0:ߎ>K`C!!nݨ15S-Q+ZK"v=6_ľO@+ wV&h]Nu+a:(VR2ɸx+[7e!!-HZLē)_*QS^T1s z֟7]4?]kAKmdfW wޑ]I߮-_]Wհ嫓j]_ [:]|u{jزmk!ٳa52Ϫ &M0 ʅn @%on ۸؏'m1f&h5Ɓ4_]?.ͷn(uK&c̆'$hǀcZu{F=s\A-+o<: #"vOƶ}ev҂aӼ%#Yeû~ &oRn+t'GB<%D|M*2+Fc~YہtoGjH+^rnw"ľK@<Ǜ}V=p6O$vk+Yu@$#v I5c{\RKѼ;|ͪ+!@?~\`c*wE$wO[Z`ZZhw}(SSZNj'! =NLr(X"!iVsQ>={xM@bAq AP.Amw~w:|"K뫀oe2{@'{}ۆ~O[x `gЃiӉllz2|Lքc3+ cO)ե݄B}&Zc+ d pCr'@?| vEm^ |9+SZwb 'җ+-1c.^@/}u3Wn ո2uQ(,lZ/ pes3WϚ"kb& 6愴Ya9?6r6@W](d"𫠿I~DE~ גw-Д IoZj>5(+߃gOg^~ ]!9@S]Fn5Te]-l[#ʕ,kAUI$#a^M] \z}lv>]UTtqFtqiӑtKn{ e6sьhO2:W>><ϧc hx%EY%a. 6TȮ|W*}ϕ^C5qILt٣oej\tS?R(y7|3 wymVw_&&|Rp>7 y ЯH_˱$Jk@F^.z9S~$z]ߕjƚ6i벼5wQʶK"WeI(Uϝm8<~h܍o TBoy IeAGBo̻axä6ŋ~ A=l&[RBb;3LaurK2ҠV#HY1j+Zf9o 覩bլ~/O~ ;>mzn5g@bH VFݞ21gj#|UB=_koWw~rm3P39c'Dخ t"wľK@8tnxbg뽛.cXN;jt{,p뎜7ewl!/D8k x7"ox}/k|yP CIQ.e6<Ͳve4μ0˞wX\au7+" huv<_~ ԬgHL3a !l? 2/6Ml ={L| 0x>1?Gqǀ^֋sDn Q»AKl 76g@].p%ڠm d:= wU6,$'߳A??:VdFXDzmR_-.}ʦ۶ر}ж-;u/z {%iR7-TNŚ0ˎUjw活>d'i$x)ˢ <&q72Dm2.u%ԭM{(h3ާmR]Y>;@L?[%9' bW>Zn0UXiD˕)qA޶mhxxHB)@*ؽiПNߏ'm1qmPMwru'dyP;iF̂{6 Û[ V)#r؎-*x2W4t*֤;G|.,h[/*$p\zh#MQ FV~qlu,xS`THT vЦ9shS^D}3i* UkπnQ@򭆔ΞumvFC_|.hP.XjDdyezMoJ)=<}x3蛓oĮ*uD] d >AnOtr5{th֚}$>n% ݛ.P ~7t$'c"b1@><6;=Ck]4ͷu  _ਨ;A 7ˆ}a_8\o7s'fY]W:35٦sY5K"3m4\=P*~cXAw]Pq2%Cw176֗tsԭXNV`D٘jys47}OG.^cYmG5 IV*:Ocڱȅ 胱 sdb̜f̺+Exڠyvh8uOΆ^r zͿ ǖ{DZ^9/̨q]wB u&ub*WHPGIfXuX1L,-L\5|v:_X1=3&rGA}5Ð}%'o7р!xƘgrOT97shFHnsV?dr[ϕldُ@^BaKPLٷkY;Wf;ljE}b'ȉE bŕژv)2fp,&2eg@,}>3esZ;v!*Rn,=@AƊFxG_Y8ff˚pvo2S68M&y^-E/̽(ksćȤ&XXFr[ğp ͝H%|}5κ&QP:E 3Ӻ)UGGKUFf3=jS⹌W>8CL;yp" [Bs*-7H/pv;١2C鍕 |Zk`˚Crh.ATc{̙=686Q5-ۇ7l,l>99]i%mjfa(>Mwyim/dqA5o(.r(xzocL?>Ă[&&|0 3czc^EK/~_Uo^غ$H<"35$-Ƽ廘/^G;[uвt3dQՊ(mUuHGOEY lZ)ogŐH]l/T :xT#IyB:!E,JF`N)^ Zj'61x:s;[37H.e1c|GNbWɱS>Z;.oKZl!ZUbrjW?;z Nwމ]#73N} ]Xdxw=jﭖ[H>=.lh;z lk{'ޅީ5-&͇h!ZxѼ00S9UGWٿզʴ}>*y|i1Al:A9q tʃ]zB7n-R;nk'>}mg|a\="qohuh68.bVE鸮||V9} ^O,k^Bu-beZQWw8* ULGElHQ`,Gvxѧv0B1F^']4qš8exb֊D€Ŋ9I \1/@ncULeEEqd*o-&7IW^s-CD<7ޤ&$v77ۨ&BުL-K­VFw#l-_+wmJo&cAߟ^>69~2#8 z:<4Amigiem_d~lLG?EA8~e5˖QK/r H))A9żrOw+F`-[6gIɵ(QHΉʽ#?R;r:3?KG?%迌?lI GYM(JJx%mF=4u%!Y/pc&t=U%WCgڰ >5'̢o2ʆm Hg5^C qI1> bm$pdw]VzWmUq_3ʖmGm $hAX{$v=Ev%I=̛ɹEdh;!yT:P֔wkiNțN)爧5gڪ tmU5Pˠɷ-VWē~k؀!ְe#rLV5Z{KVMDScPՋ,`oYQP}P_ɷ h/B@<鷏hm=tOB^``zYD/c)7jkk}7B{q}?̮zw1PKmQZV:ֹFE{OY~O!1{+ E%idqߝ+?m')#Ry%_JG#~ckDjD 렿P)wRwt @ ~3Zj9ZFz?0bI?ps0A ? ![/0 y") AW^x Qsso Ȏ=f*{)37_>Z>w^]?V-NAƼSKK&`,!"r#GFtu,ˑ4 ML`!ԪE>k鷫n!Hĵv/Cxu-7@o︈!H={d-(#tʍ1(,RĠV- /C6vMpԐ,Q:#?McjA aeK嵓΂UVI%"QR :}6v I E?ԪenhQzV0&jK+ǬޯNV'Iw4sof~[]bmwx0b: z:TzO-qPp9 [kYb/Vz[&ҐhΪ ,IIQ=~'oRChF-%V"OMjh8&o6I-ji֤jm6ג{[v),s#?gڔeT.ra³:3/ɨqr’֐@/_R`C9Asw>Ilarg jeAﯴHlUJƆE:]/CQ0sMۚbCHܜ@jʲMw{ez>6 D=] (*so;Wz7ςlލ} 9Пݰ0DIZ/2,JMA;V-7L5_/jC( ;b 'g3hxpQpq;wh:Y.D߆ԕX >qT!) ZLUjұC$y A0 /E ~Q^?! > xR[9{KNr}< ?on-~5?j$ZKfN o}C6Kģ5inI }#Z⊳ -G<1k"#^fV'r ׻$bC@SSzw;yG> {8Џ񤷈E!C7ȪSՋz0@wL{(δ5[Vk}5 xLe|~+QY:?_~8qܰ F(hxKս3j1wh:h=ھ }TS.0' ƭcxүQŨzRKc:[IeA_ZZ"yn5ChFحZ^'-uWvXBOS\ %!1I'*+d=<T:6xhE?Q[Iƿy2c{y@?CkSwρ@o} eMt-YR&D rJR>%= >,ǡu gD+kC{H_eo@M\u^iw}u?MiMu✆egL{*5ikZւ{}y]VДeRj#CC[n3;W ն۴zCڏjz1v3JP]:׫E z mY.#Y.SbcW Y ^OrLt]ilӄ1Lĕ$9MH9+E FLѵs pӄqgAڶ2kE/upr<a:m׌z %T?|ӄ]HZ;9MxQ]JBr5b5$WBDk&4$Ok\/uȪD+_7=Gc[[t(Z jS(H=[axg5rk{ӄm݇]w4Eẻw \V#Ftx搜V#TTP# ߮j u rmfCKHzƗ ៵ŏƙssˉ ?Ɖ*C "{PuIh&j wq]}1͆ ;'c 9E'C?dW'zFP:$4d.'՘x)g3J-9rDeUǠ@G 8zD3Dջ l8.sMPEsze7^I"9I<`ӄʔ؜>,p0yYO{?ںkَ. gm2K-2"#[u/[ &TVs>{YK#I69MHQk\;&tJfH4a:Oӄ15ACB2]bDv`nN!7ߺ^6PFp%!1Ϸ+jP)ͷ&Z3p\[Š TK&IjMq1ocVuCiN/X\)nU*C"IuIfV5j wq]I1͆OӪ5YʐG)?>őwoQ?'#GD Ӫj(i$iD%Q&uG4O?'@y}ma}vd^[s]֬1C˖KS6a}L c9(nrц:ײnl=9p nO/8*n cVĝ.aݠBl{϶;]HeA_.t)UYt+s30 ZDPB[zJ(zO,5N.pmIv8zLBnt!vwO>-uMCͿ]%so 9\J8)[ﺿ~mFM=-1T|䴽EƧdEU)࿂We>ecNG˿ 6SQ#PNz\*%^N%NpS$n|t.4"tӖB.4a Y ӄmQȕ8MmM%9թo4a:ӄ1u(+qx+ Uʴ)fN,p 4xt*Fޜ.jA1]r3:UB {آ)y 4D\dDsTp͆ )(ji}&OGV7.?rz OHNP_~ӄ ̛̿ҿaJ_(ïiB2iYׯi˜,}{9-$Zܿ՛/ZyovEC ? &e5Zty$N^{on3p}է`^<nEj8 Zi}b74A}ӠOǶ6xGTg8vN(\/V#G$1 Sλ'8)7p9%(I9MF޸HHx=  Sh]]׺9$-iNw?+{mXw ץ^m>]<  :j/ObC'3+!IoL)bo6!pQPB ضרPD2> *_ űoUsھZ˯/c G紌^O(8]+l+4$I>/> :bZ/%dm (ېP32];YW|SRlTr#[d{-5i]k#{gR$· e9v^iBE\B2$4睓!8ݩ9 &ErMӒ'J  (e8Ρt8i˜JkGUvRF/}ܠF8o^P|k \*MͰNl=e:| }'8)5 y$pfJ/PKZjW,ǠIOiBE^>cL4M$7?4a:2G&?jVխ<ה8& / `sS}்mYXXC+ͬeL*^ɱk3,ZMױfupvb6][&i6F οEpV ,.^p#NNR %<٢C8~x?;#_GEo}~@'q2ebx|LX\CNBZ}*&0Y\[&Sgk)k_#e\&25ͩ ,J^&hug_i1< eN+f- GHW_iBEt`k Sw GZ+KVֱ0ro*Uׁ^aBK8}tc_bwзVn>W uyidzu[sg-([*o =L+2jy!%_ZKce}ҤUd^ vƴ3&^|?Rb\?-Ha)8?Yt5Go=ϗ!I3o2f3&As VBNl :xoG $$\qBB^J+|Z{I̔E5#h@oKެ ޞYI߬”&nըf}|4sܪ(Lhf}|f},1jEi)UY) +#_ɘ7 IG~m 3& yq܋X[( i$xHDQHI<:4C.vV3AegDI|ۉ;>;'Kb'Kl]vMO,>~ VuWuuuwu7{8Z-3F :x -*U_Mof@H7 ɨw?:hkG =B;(_+'InA1yvPhzZ?60t06wOeM .hַ2C\`* 胪@?zO@~0!<L9-~4J}?͠v|ņ Wd ʡc6Z/7ZiEwA7vv9$ȟaqjww~f}xPDB<1k``C*_7{U> U^*et6 5&БW荤H%oV<~ғ614M\C*e'3[]3ӞZu'}*z8.l][ Z+Q }0֊8yOAMG@]ΗΕwUi"wtҺ5ѵ<?}VlzbASF0S3}=ⰴǙ&-7SBvUM,ӪXbNY;e=HjSGҵXЄN]" ~Z1o=rE2Қ -:d򧯩_6e a^?gnf.,!H&|~Ƒڙ!ٮ]0K4mvfdcR7~*= pߟzܷ1Zྵ}SJw+k&}<[ʟ N Ȫ(ԦMo hkK}k]a|E)3<#O< cNh4nܧ-SЄI'`@Њȟn讍h2Kx(}›ݩ>ܾHҝ[Mx^D*$%R#HE\Q#JiYҚ TZuHEʟ^i| !m hyT;Z;GMScWgb볰Y1 MIg+ݵk}JJ{9&LBi/NЄ11eH'G&X`'GJ[Oo̶>^cd`JAwaт݂^}E nIEp-a1EziTJ¢LhXBsE S&K/dXVݩR`SЄ w 0~ ھ{{w798捍﹥,_P,*.@atbJ0 72ݨv-t- Mx<&$;nB(v 5qC, ަ7ܫh+RW)UZ]3{rWgzvȲq!yHl <ءk[4mPlr:BA_Z}=NX_&קv?IzA|# Zh@'*uZ=|<߮ [uQʟn2ҎR;)۞ZZ-s>m{O狋gIV\"F  Za)uVLmy?3Zb \9Q[/0Zd Nul~5k+Ju.7uH)}RW7nV)[IćUANxnI ɭb7']1Ku™dͯPb&-,d(4&;㳆\N軶%| zEYj# eLrs^ &dW5UU'O 0 ^PX nsjQӁgH5ZC/WЄIP 3C=PkgM`}Zo `t.TM7irK^n@/ :~3{N8s&Y1[=̍_(.@A4N-ߊZz#wےV<614Ok9אwJi{k{k1@O;3Fidoz狷;IS\"FUZ-)e~o9ٷf½e-hç+eY?cʸ}^Y"* SxL-bzLZ%ESRs}j&c<Sʟח^w2FAuyLkv+HMt긶ydx$}&A&0ezfAnf?&)Gcje>:u+nNb3fшڃu,F\,yՉ _] &\D UFG7X0tZSdX˫3Y$*k )fAie3'*%ZVb=8.X,RSsx҈Yar/5[x*Z]ЄmДgI!=&<#4^I{UiC 6"EhzҚVL\ijXa#VrY`$rɔ ~HK=ݻy/wI[Vs(O֡e ;L4-ePōuH; 2~$]K˾8ec_g,btC;AߙMl+w& ڕUXibBA#!"Q <_qBfυY-;ׯ__e@'NJSMniKrJ% zg/qka\!=a^յXheD{Sd {s)uG.p?P9d&$ӆgX7i7)0gQݠ-d9~-=mgI gvk߽] I4!v.f/oqEvHwBn=v!V4 ~ r ~!xG> vixNJk~X;HJybↈ"O{4 P7d Ր&7 5k k32> mA_{ dDenC rwJ'q9ހ:PO}Uvxp}SQj!)a/R`U _uǭoBaA,5Q-qk}M)rނ}}ao/&P_{sCU}AoAH›A[૛ BR^ Z| 75;hw@whfŎ,;!Uc])2;j#nhoJ;%T^ o6a=b7*K4x/Jz49UdE;D@ *vyҚrf pLZ)~x*`[͊;(v=+`ajBk|L dM!V,mDwu7wxjM[r^;a{уՠb]I_{ۿ*\@E2,e4?ыS5/;~"~hsP+?/Z6مAj™d(ff"e2W6'eIN{9`%kR .xi -T9M.Λ%l+w&:;vI)دpFQ) gc [ݍVdvǪV`[<* 7(W|ڗGY`'JgΜ;UL>>>K||f}gyߞ`%oG޷crAoZ.zcl8DtD<5Tz}&}ܵ.v:3Գ̧wG/dkΕIu3!v5Gslx[Las6U&@V JHwޝ|WL[WWJ'f ;Ah_+vQ a4V*$=,$Py6}y$Hrߣ"w A-)HЫ RZABk$k97>W0X7WAW y+NUcUK73L1kȵE=~fߎ{#̟s??co']3>Ũj=j+.nZ{t' hI7[rewOn赼Mu@J[{iϷ&|ᯫ? LpZP^t\lnYUŠ!^+a/<#~et`0 ue[2nW| |&3+d_ yukC3Lgj? | SZ:cQ?^-wv/rd#7AK#屹*"#!z–eB˲9V Dh/?t<_ͱ:f L%G/NKSK%3d#XcH;.e9T?LOx]I0"1cBZ2 Z" 4Y8`|2LSvWw0+ՠ4U)ۣ֭eSa(m hq걠#ײ8M'~3Y`frC\qlY+ ,JN^¢*Le5TwfɘdC .}qE/8j`Y(|:;e xmoQf AL$ēKm[h},Bjݡ^[v]:Mp%C70sà'oG$ēɯl/`ᘂ`ˀ=PO{X*vq{j4女PVG@kGЅ[/J' V-3a:jy-pgڽ89 >ݞ[&z{^&́%oľ_BMmhՒo؞.{7kɐ&ÚX0@Hc9ؽaݤ::6GA-~ ǒwlIޱ"ǶV$[&4uw׼f#ߘvBgK1{*3,N;sęܣ_` [V8> O1,* #n>S5O]:l̨]]ëX{tZı⇃z~HK-&3{NT{-g\B:_o}sM$\$ē|sM䒖6 jK -Jᰦ)J3 SۣN5%:텗"8ƪޓݕ3ܽDz^[GM'$[@L^0v#`b\¶ :ǶXd)ȶ c֑ڢ2t LE&mP{A߫5>$!QG[}>mk˯e4Zc6>fϡ=|ӱ a@+:~?= ?-~ aK'2a[8Dpˀ;4/!ԦzLh٤w/dU"]Gzg?(zbx?=LC-hriX&Mࡌ }}r/oo@<| $Wll ^[\{T5? Zm} E_LFe~ bf,Y6S73qȲT[ۗ?#m[tH? ϴnI޻a1[yWm)sq)M9 %&luGl-b:¤8bYGSk9Mx_(lr`N (6֝qŹCĉ8\2RWR#x%Ex-keFѦ|1>8ncaGcjvZ)ot(񪴬|lځustFV7Ւf cf -0r,EȦ'\eb1-j;4xIM&׀9a Kp+AEʞ*IK%SiWaEO &yʎPϜO 5=J%4yb [X$|+Eٍ1731C$:`.-BLlXNKbW!zߺD `ƽYn:ӗY[ΦջT3u #Fsj8RWyLOeZ[-Fk«r.Xv&}ĜU`r=ph O/cNU& ޡx-A x;c;%s~uw9=qI=*b'ŖmqkYך䷔U`t!Ѫ)@>%s~u6t~u*b'ŖmqkYך䷔Uqz=PR%%ģX m7yBt >}ڬ2tO'@?}ESD6mKR ;%IKRP}\(ׇG@+ݚ=<p$2EkLb?.y)B(Sĝ>W3EٶZK GzUu,OKpBkMp`g[JG*af!eLJp%ģ)z9ig=o>JGQ'/h[J֦DN7s z%:Z Eqޤ됸%t-reУ#zڊAOk-/bg[JG*aX_'C\1]ا%ԜS 5u~9CL>]mL!7:$ tZ<%^0v$| 1}e$ԗ)";}Eb&K\1S_+!s?&:ΛLw$)Eζj8RW[kyx䷔UaX_')B\1Sا%ԛ)y6$@+l4g6M캁:!IAoO>oѶLbS&Sxe{$L-r-RÑ}zmUp:\Z\2ؙRѺJ'=3E^gMB:}mLR 7I $ <H Is5IAmpV^[׵u-4u v&} o*>$Z>Ѷ3E+!J:JsӠOk9L=N2YJFP-nδܿ0xbqSL[.5q2)]xp 5Kb j̨"Š/֧{ W}u2x :jr@]-"`t}@ixL},fn`tVN!A6A&^fЛc`[?nT2F]뱪U.ؖgՉ5Q.IX5K1jJvyw ӨoK6 o9tR#|7iSʁl$ۀd4f;A3ƗZUP˻~mjYd7uW~'Q? c{s?D IU_MF)~ Z6okm-j_${sWt[;f͒HYg>g%72hv<0E쵊UI4|_`j 7'A 04aL_gW؟exiK+&Ԥ yJfj c 0VwS;$y~8:BҼjA&=^踆xbs0v3e1QVh2WV1שVXne(Fw-q3Gf^3S]$BWBs&6ƨ7=)˾ d  cƤaT%Du&-Z.Z)s9'|\Q\G::`: MfJ ]$h˜x[B}vQ3HWf*;M$OЄ h3 _j}tr,u *9F=Q% Ѓc&Ԧk20/h˜\ܪNwXQ\*#Y8&T f4);aeYb+;>s%p )KkݩP=_P@u\ .hkWayTP =CAAjb. a>A&a<ݩ ȟ1FʼnFZiāW,S=7RW>, S_ǜ)'ݩg!zA-SK8)hB]]Jg,)Aw&0~&vS 39խ1x~)Czl4awF/ /DЄI z ;ʆ|.(:Ұܵ*7]:65nƍY6Fد*ViZ6UQdi܂\( S 4; 'SQm6TL-苀5v_Ho%ү ۱UHeŁD@Y["{A2:s߂:Z3Ŋ|M|ڛKkGq+?XT3N +4gonqg4Ȫ|>엦 Trȟҗk㲂Y޶U)Ta5.)+ @/PncĭcxnEzmoM_\ ziz+>V,zK *r*W) 4cUul}.,h=V>>wgW6kΘFFwVME7=bTsnR^ <@6,OrIFs |PkK aRl&us![|ZSW!ڜpT_M%}^ͧ=\m'aslSƸAMJ,;SeZMY1".6J-}}Ɓ B9@'I`.?bA7}f|g"=1z |Uξ)]fobqCQ]a AI>ov0L#uJ)kM݆uzPi47IhZs7(0c,ldj-מi,p<H&=vFI_ЄA/x$A6 0fWmBq{J=3aLs<g9bu/Q/}VTiK@+-|Gk KA4 X(]if/%J_.֙c ZF \{)kr3fX[z/;lnq'x`#R7={~!_tc,Ui1ʗ LRЄ5Գ 0L&~X3l*gӎ1=3ԖjFl /|n$YcGs/W=ZG4۝I•yLȟe2=YXE|Ӄ\`H"r!Ojdysv &dn+ ڥ`xpK4ay +&ixY9Wh WVxF-nbY89~0&,)L1&XVm{(2kiM$%l2~.sYQЄ ˂7 0DO#͂^ 6#1V@۔벼Ufev߄7-/'f%D^'$ē=$`38<]a]avY7.gfIW:4@qݢCl]`!ȖYGCy:Y)8,Zce9ҮF4S{hyCX^KӼG]OI 6,2 EEcUV1EOTEe,U ^ƽU4ӹr$^,f[LҨ!bP@+hڡ-cf5IJ!BNS/I Ez9_j~tБX]$kn а`wAbbw'x-=2ZSOچŚ@)K2PԄ8gN>(0u 5dih,ׄhWnhx qšYY+˄Uei Mߌ*(kx Kbkf]} )/歠KA+{6UrfI[ANFmwMMla2/nN`0T`"K%+@s1ЏiLlI쩨_\S6>{?%9_|%߫muF"ʲvv!$ jЫ[on p \{zZ Tt!G"$MVԢk ؚFkԋ))gEmZ-}8v",!zN5SR qx ) n0==4#O~BY`Cߌtޙb Dz}.M[ 쀸.Ӳęg]63/ŋ'L;z!eύJ{O QOoڳ8?qu[HޯHrEETJg|!ji^O4F{8)(m7 B}xtq\q:FĬY0tS3٘mjECO\[ljr 734B ښ0R+AAR hѺ sjj*AW!Sۥ'_GMZa <x?,!M_78juN ^#8w1Uxbʣ,ޙ5ix5s<5؁G5lim7Y퀾 6pɎ ˵) XVֿ Ghy1uu0F׳'[6GVH~gZ߭? sb9 $-ƝB5ӭV=tcG1%H7?Sq%bxFYb1a "k 'iob8}kONb?D h~j)nc}Ւyw*7xk=AF'']^4Wڴu^9AqhL z2"_/G?bAVOOq pSj;)|!Ϊ:O8bwp cjcE:z[zznTi?5kMI1ׅn'\oQy=NA ވݵ@Щ]+zw'i1v MPOvBHƸ_V}锋詤nC׳0iBaV;ѦDlGeQ6nb?rF)Ӎ:j"!NnǨ`40 @}|N.ӳqR#z1hS z-{Ox^vo`0k DUH? ӭUݫ4VΉg%ģ;tg!خ=k}I: Q4%q!OZQ8n0YFxKV/tEH-!l/}F!Jn!2З6|!Ӭ9y>O@wa#OSezU6V7FL:#ȉF_|ňtY V)ҜC<Nr o %y+kc619ʧ늎Tl͹ի MT9c|ogkαS_ˑ?]I9Uq\,N (D$0^4^}o8+@PʚY=Ttmz>])c@лQ:Qlr< ُ"6k#.߆6Bz`0GW[~U_ɿ*үn~P0‡A?{Y"7!&*̑E9'(A]"?NS}ub&i6-gs ?OriZngc`Ͷ*tjdg2'*,`C:{(槭>CL!Q21+raI^dYЀID$$n @cy?2ŏxABR;/d&<bA-A(C/QXP)vUctn,d%́ε!D\w5NE^Bf謉_ȥQB)-fi6v]̓on' .FjDȟ[g_vF7~NSt37).rNlw2{e2Ͱ0kp%PD,ayp+)]ߝ(a=wP O͡qvCМQݹ>dt _QУu~YvKI؏KGQ׋C]J Ĭa~M8R XV@W►ּ=l0=dphՐ[̰5Z?o=wx`#vs?M{1˷ʓwub~5x5וOM7-=k rj՞te-W&X㏟0O>kyz}TO3Z-]xӞoMdMwB! `‹n xMmx1JXQ6|^+a/<#~et`0 ue[2nW| \dfK7a9/wm4T|gφ +SLqЏG5czc֞cQ? z}b$Y^oA3FZomn5dMQoeq_YLLok6j -P[YfNeM]/ZXUt橎Y#sb07@<}an:/O̸h}3$e!/C j 2*njxjW[ 6I}X]:cŮ3$@xqmqq&ĸ/㷹 vK'f(Yt!TB̢uN r-]O. j!;*ȿx۴5Ey0B.[!!{9Lzyk{2ym_yfw(2=պâ z^^FPQųh\ޮ)XwhuZ XX,;YVm[y~hG70:0muބ;$l^ ^R͡k4sHL2&Zfyi) 3lשa8VT_` _tC>?&! }UK  -ZOl?Mё՗^nYW pUVq"XroyNTIkS]ՏTVWZTVy*_MWJ'cuKbaA uȭFSK,D+LnUJ 5ZT;wz;_ & zovN-!\Ji_PUop-ʦ~ >Gf\!r dxgF@F݊ZX{Xi{TE՗ ʪN(it!x?~ch/Y6T[(hS.+KEU?4aO] 蔚j4[Ytͤ/4&#R `rA&|s ATf~odO~F&u)۳4jR ]^ <(hB]ΰkVia :4Z?:]9䁏 PR&Ք2n~ǶYdiF[(1Kx0S}"~!JF~л? ]B@,ޅ\B<.0Z- NAeq.!Ԧ 4F.gܙP(BUǶNw!v{߻7t*ҊF)ُ%kd?EA_苞k+ς~6Qi1Zѽaj}F)A1}%_ ZfqڰN9:#(,K}#?ҦEGə+S@L籕w %|aq)J"5\DЩK4tH] &L:#1x.QoEX\1ؑ}|.XJLj,][ˎj$ooM_ &:~\d&wHGSkjk{L`vv\6 ִ%8vn9nvb,a^p20؈$Vt>RF`WBc ح^ un)*W6YeHRƔ] ?M3v5akV#vwtcIГI~}][6#zͦn#hBmlԔ-|h^AV`O2caj4- FRə"߭Lݎ˅k'P^ˏBռ1O3s;8n?s O/+Y;{69M?b?I$RE/ZzcIK'<~ey,i*|HQ΋Uy{VѴ_O3#XmB5r^HqSU-)zQНR/xLbM'3|KɴJ\@ji'=1(ӎIj#N*zZ-BE42 7vUKmy<Ӕ?lc넲xţ5y꫁ošMm*qZh~fo>-TS٧S|>unoẄ́qǭ1PƔ]*Ѥפ &R{-d_( EpgtPt@tV%G#g(4um$Us.'+uHSKu;C T7y.m:OOȟ|zjK7"VN! w'X= w$ SW PBWi5&4"fP9X-mU 0 ԍoӆ <|_O= | ϋU-oQ\K/G^r>U5K*=)U48+JhW=-:w_xOjҼҼ-u GաAU\C"FSz!6mP#XdO+y ]U6[uDOj?\{Ih߄T\J} |J$?ȭdzjRz$ZRl6!Rm{qi6+ [LdĚL?L?iK#1WЩ{I?"gE Ɉzi5Ɉ-p:8L=)+d &tgE8,ՏDҹSЄ1ZYS74Qw0D Pv]`ɰ*ZAݩt.Fo UFGGM/v|H~ PS0Z@ЄI>%h˜jZ>yw BSxk56Är'%ZY)ۈ %t@;Z- 3 <Lvw>O77Yl6van5y*YA]Y5r"݂O_/-qIŪ]3a˖KgnW7?H6gDOSݗ_舟~mnY}E ~o LYNYD,E=|RЄr,EiAjK0g>%TNzO\߁ rBmϫZ.L$qj?N #EgUS)^Sj~H4rh 5ůc]6TpA)u #\z.9ַbgӠӱw@{V*yY#7=g +<m#;`M`D|!z0qQǏdfcxSVv,]s%lJWcṱ[ ]n@tK'sQ"J)Nf] ZI$ ^#<G|{JviOT=SGx 59E)SO;Mn%)'nVP_rWq"} }8sCN;zig6|0k;tvۑb)!Eۏ}@K%{0*g h08MrI5@|V{bw!Jc3ka 4?-RFkZbh{E>%Dtm:C<5 kH=G@?M_Ea.6˥V(,Q֏%4+!$ؓ7~V;X |%7UHaWpi~)Пׅ\F|e_NF9 VnoH?~7Ztw}7 ?il: W(r3r-%6v+fk{M =B?8V"SNM&?hNXS QRDY ?sDm-&V.H!}6]Qa$M7%ck7#v-iYV$^bC @[ZߊlH%h󝣫qx j\ofg ЯhK|Y&_kckHZ^u7~6m]C]hٌՑPo~QϛA IG#~QզzHO hcZlUn<0Uښ\EtzZl8N1\_nekQm&]_P=̼c |ȵ!v)AkȵwŢG񚴬qȞKK"J|i/ԙ# 0 .&<4a_FЄIh :4U%I}w&Z邗 <X{"r!|FM"]n21h/rr Q\ư&-q8j;ϝV>A<E Пh_+$3?s/ (oVl嬡s1 8| [Z_2A@kCȁwzLnU8d)~ؐu4AR]ӷQ$YcJV7ix44/a0b;rAQ8# (tڶJE|<:$E"i?r]hw"g'cxEF?,e{2e y E!M3$;eF%-S X.n ލR6g<2=K4[jN5w%cf4o |b(\{Q8B}Kb", x?^'QE%,Ҷ1}wnR($NB5k LOl(%gqjO;%V"^APS\wv6 IHkAoD,"H fyHQ B}n0zJӈܡ; T@Pt,f`\q=#g63$!n"~~%ٗ2K"SL-@~e [C/m,/KG1Y}%FȇnezcRq8%q/(xNj7ED9ۙ#9Ku{ n,# lo\d0KY.Eqȋ8#rEy\T kV+<[Ҏ _6OW\BQ!e1k=/HSPn`hr^&GپA M?,3MG8r?УҹlbN>ؤ dsbqZƝ2fgXߗ$6'cZIL&*fV6mQ. HM(%h+AA\6oT.IH}Rk qeAQme(9SOYV+YnʲTFhG-Ybq a!;϶ *d^L@tAJbe'lgzPl;[ßX޶rU kb˵u`q}Og;tgxN=ћTEti鸿y E ԷVp_/g}b..-nEcuqHsF8FvP6W \Ry(%釨Dqw&x)$nٷUTWS0JVD> yO>> E(M,` )VJb~{#bJ_q;f*`?J'L~gfLc q)G.$Fh9z72F6c*Z~<J#-e e rN@3{: ͞U=!'@(LHF֧QZԝ{vuwzZ޹` ߹_^ ڥ8a/h92[;yAXd_46̟7z@qEOJ$?f}xyLbX\=νd>fOp#Gbtf]/SL8[&9r^ -qY :flƠ|.ڌQaNEP_ߨ_ iX-ެb$z{ CvMN̑YRH ;gk360}<'2p7ij/nZՒ2-*ۣt{W\lYE] ̀=\XjW{od~V`U{%yVޯwzlܣ,ƚ1Fֻ][(]!#V(6^pq]-QB u u|3( 0W=a;};@i'+ܱJt~ B/ٱKIaYa EYZ.%~-ؿ&:P o0ʃZCCbB騔үϾuEU*!걹dseG،=,ߪ-\sz+Oy3 @[>7;@=;>X, =ca1߄9йrw'e?ۆvRi-HG(] t{s߆r3ಭ9@Ya#4˱sa~.J߉э]cћnE/y}m"FƆW@:B}Ʀ[6F7վlfeYز^_u /nEG(w~4$Ǚ?kT+ 5asIЭr)wZ ߯s8D-!9S~vdglO> brulژ5io:{s0yrkE/)N*bT\vscElSfK zLAZ4='l@C$~! kb˵qFIZ)ЬF#P:@:>t s{c }QM( m! oۘ~/fxO>,1qZbљlXct2?F4"w| EoVwiv? ޞH3`OH=4wF{LIhv} Px ʟbT${> Ϲ; (as_lsKx%ڐSщ.){[-4ZDk!69}J:__lˇ!:<-5YI=5$(ÛI_Epn0`KjPB}ݠEfxǢ[%z:p#Gb4. . By7mn4@3,}|{œ& 2N6Fh6cu[_ AwǖeV~}}E1éͭO;@=/ 0 ϩ 0aׂ^Gx`V_wzloO X9";cHɻ5ӻ xG/6߃N1oE!a;`u{` ۔&{Z3ľSB< b\$ ΢ lW"wY\ z6,͟9\zU:;  Vp=ݡbJzcEGCԱ~P| 5uY~H3KןTR1iK.7?8Z2:K,e[ez}9n+㸀J|uHK6f,Gw DqTKifjݢY=[ć~jIG$E}gM'v>P+?/Z6Z™dhffףvɚoidY]@q!k$ģ V~h)p5hiuq,fnU4i.)Ѥ;1M}?SLeߌE~޲ofI$ ٸ\ȞY+ X+(rP*KX8CDlT;Tk@,`CJ3ⱱU4R`o0 sKYWo}(oQۅw$܈I޾cEK{D[lNoi<q"?eH}eNx 8}K %ēlWڻdI;O&nL)6JxmUU-4RlPr^7SQ {# zk {pm6EB<jv%a1na4`&ፆټWKmulyI͛!![Nhy b-OFNY9ZwnֽjjgkиēuEmuS귩 2~}×Mh? ߸ieɲ;IdcX sęZG [oka~(y'$ē(8`CAe FWk.9cv՗Qvۀ|UGx?+,ؔNLB_<~Txppt]QE:\A2/KK'fr1-m&hˀgia\BYatlM b6\mkԬ|ڹu-gY*jX,.+avFuQ$>Kvps3]14a{ŢfUSR{7;:Vr?[X`RzQׁ~]([|='E$ēD4:Elˀ:j3n2mA,O~!A}X EX z68ǒphIx0Am𝡹,s)>0am s sN<<x2*9|ñUXGEEj ]jS-'h'X Jl,5Vv,^}JbRΓVikgr?=YcQ- L3FYvpĉi~[iODx.ϱY 2껃)Sl+ZiaA/ ?R9a-ڍ63tHڬT\Ui7KS1bS%.ڹ7Hg9U5VjUǽ%(~Z/E'"/"(_9b_I?O~2a[.+ .!֧i_Y`NS̃,63c X֎S 7Vl؜ksfo4̯*T%o>8Ǻ\$QW}נ:vӻ:%ai,^~࿃wmjZ%RQ>dT䗈&?V]3)8bAj̼r.դV/4aI-^*h˜leIK:qT4[ b)("_(2>Art tJf9ո cqʤ SJj!JTSJ8&X2Jy8.hCtoO!:̅`{RЩɇľTI>D\3.= -ꈻ3sS-EH)Wי,M x/{+YK|L}އZ'+nWOq--nLh'L Bǜ<|ӯ@(anCB?(菶w!v {bq $߻\!̙c qpˀ;/^03>.M8ѤGgs/dU"]R_}Fg?(zbx?KC-hriX&MlT )[A_Hg95 ೠkgTʚWkt~Z} EJ/U@)n6̒ki:e{>1(,K}#?ҦEGə+S@L籕wÄZAnh8@x$ZdHGl-4L@Feu +sv'(c0~wPEYj mf^mwIGSkjiBU@OZɈ[&M=E6U J!`cLCk3xK7kNxg;Xg]23+l$&ۨl=|jVSaصVk65 vW / 9%JAw*xԵPOT} tJ<ao=rj+˰rnH{Al}FvtVލ=ۚۑ ߧ&HNk)(>p R]Ue)jJOj8="y.,hH {sVo?Zi1~aA-{5UɤJ> %O?UHWˬxt|Ѧs/?d]߁j7L62',~e'ZkV= L]$hBMjTN#&q^'Wd-.v :[ +R&neӅۓVi:kf_h 6iC0=Z~5kVk_S렿oVKֲ"۲E3};x" 4j*z)=å)R>Xr_ug1FT$0uPЄlb 1/h"uȟ3Ug 1sv$4&8z&LB cuM7]5* җ~A* ۣtfpm5Q?s߮O/+Y;{s#1duw'ΰvg3,_@ЄDo,ƒ -Y&EMgR$VoUɐZZ)FӦ{E>T0]]M\C.ԫ#iEj( 潢ꕅ,)"3k>v)3BGYe :9]\lk=/$"Evy>Yɩj,SէvNnm] :glO񼘆SjcRw1CbZޱluM*ATXgv ;q iWi}k9 Ϗ_T\OE{riRR_E}>zep:\=)z Oںcn,_Y?h;i>gD'y~xdkbNЉ%Ւ8|-2--Qw7jq-AMmIL:˜cJ lCL5|{SЄ1-r鎏{#'@T W zajQz'E4ACw|WJV2=\J7O4+ײᝇ$k59^ޟ}[Բo@y 'AO&4Xj˟8! ;V1=pugi:dumBބz"\z]l!w^w}&h!?13F֍#}q;rQn@j]Q*z`(f^}9* lE@֢B7z.4/; J 2AR>eQك|-DYC]2i,+gY>`d6\,JDw1Q%w…?"gv,\`Roa֭]cߴaҎZ BxqrAKn ~B}Gÿ=}MXےP(HB4eP(ȀB_ok06~ine7nLQkWK6 q4rGJ'i16.V#2kFm^}C' WV,x-kc+8;[xN$|뀷]O= wޓv[_GA4l&JIcSّi MпMKv(]~2-Vs;=?|WYzω eNӡQ`ә%2ާ9(߭M!HU}6g2Z _ 1{*SR` ?]PLDma$ oa oV95ѦE|d~Qw*YQ8H;O-|QW[-K+eR[vydJ#JlGAؕY{J֤URGJ8 4-j YMJ8z$y)4HQ0zU[ QGG`7Bp׼bMe+ 7ݰ4kDc(Zfi;ke3Ĉ"c5_ 'u@{@ukYٸ*|_wdNT ^W4Ov .7FR35*Mwfit߼OYdb3R -0!.( t GI0.5O;د2-"n{^U$uq&-VYr.tbMncx;knΔ}k)GI˘.2`1XLj_$Ϻy0lzK%,3e<)Mشc U;y]ӕe <ɞߊ׸(zH?j +A&jw*\ ^o]w"M_G2" $-ݨf=qmbέf+S83JAG9[𫁃UBW$V $m[B걭2 |.ze;)Z&%.pC8zIX]V.sCj[&O5 :7)T,zЯZAΚm-9v3jSA2~ Ǵ5N3vZC!sv,Ϸ<~^O?(ZeN0{uLZGVyOC+1\GP8P:mQ$V P۰dO}0b?4aL+SԬ61H['fe^xJ%.AjRЪ03@7r0]9{MSJy$B/hB]J(*e+VA& c*%6Sx cyUiPg *J;0LMԀ`˸gVbS5(%2ijҴKB-"LxiǙΜ6h3=b.{XT3VHKXE#,mb4כ6ȃ0mGU|3_zQj\3xSչ/YO4qV aگfthqҭ#yVoU㣵G_,fd+ya-F3TѦ:j>Q7m;qӚOn{j}$c>y:$7ݲ4&znc8t14zNyG!3hN*h¸1])$$ c$Jξa왆hx](>iJТW/>? 5 ,[x Ioll2cd⓹bmSb&ަl*{RZsz7(9n)1U E1D1w??4a]KЄ1UvyK v4aL"O ԲH`?㌽<*dC(n,`~Qt7L;MϫNX̂_}oq1K&N$7ֶX|bəS%8&7 VqTT'>>K&bjdr*I!JA"_pfJ*i0n#Oi,R`W+McPk3QCݞဩ5жw+ۣv,FOOkB:?S~\ lx. :D@<OkcnIk,֧ ]U[uDOt8*:)}b8LDVApm"wFG O.P|^ƿ =A".}Ij"{_}Ziaʪ :cWS#sFSȧ4Ñq%s Gڹ.8HHT:RZyt.oWՄ:rۑj2Qw1]DDgM?tՂ_5K ]S >wqT`9 W'|^y.& )v QNbm2&yFpx]EޏR +ޢ0>@-. %/>Go%ے.A >5䆧s(ESiɝy8TaΉsrngHs#Ay*> y?,/!O"}r #e٥rgOz\}S^sDb&#n. $-PRGP#t_W߱dC;?z!GӅjpm/FXQ0PC1J/M[b %uF1ʐ4'PZKs݀q㌓(aQZQ}+!(Ґ<Yy_p2,SJ2ir &5 Z fTQ2J_" ПM[ +%@_:*I);Js2FHG -߃{dZ"~WpH H#?C7167ӪJ s?OF%_VɊn-/ (h@Єtx P@xSj6 GI&ԥ9K+PJ޻P+ 0FPW;w/'r IxTЄmY0"y-$AG߾Oo$B$ *k&Fv$fzӢM\CrZjd9 ]<\gg7.-8QS()DnƌZL~WgpY @/f9\`H-6^`HIئ +:f*'] # #\z(U7JA>3@oL3Hh;>s||2$h:JM;ַ[|N?'MgR;?@G2gyQw}'-].m8#HUcA:.YFfﳡx.xG:0*SM*쩆zF8),?S9F"QVW^VB׀^[+sj"ކZ Tt!EDD77ޔn^)q1LԇI|_u8AUAhIp T2j:*hj ЯhK|Y&_kckH>Mu7~6t-fSp|19?V/(E-3G a u&d jc!u8,h!u7 c ?Ӆ:Ą_Ɵ=clM-Bmd> | ϑ% ͂&LBEЄ1y3^.\ ЬqȞKK =я%AUA9+4a*Mx.ğ Nzb# Z&'̄NiMٹZЄI5?cvbRA+g5nA&ˀ7 0v>!l2;sޤNLhu ϑNo$NVW4aL+f8't:/,iGgkYS5wYΊdZ7dbx%(uV$Uu2vTfI9йdcAVΥJ%Rph(}I@?>֞DaHc@rLڋ\C(1I֬h ?YV N+{?"O}П9wZٗdY@+r'`\9&q !jy޺ZRiCN (¸afxb֊~3P aMƔyY$2unqJ WVT'Fی] Vůo 'N2bhհK?M#[]hّ"9*M7Jt٘=).kmE>#=4E7x=>]^7*/ oع3zr.U؋Zt%G5UOZ%^CӶU*+{Vg y"Li݈hG̝7 h$C3.OZylm''A;Z鲩ɑ',d gwLAH8zPc`Mv)͠77hm&wjj*AW!ƐہyymZa <x?,!M_,8jOvN v8/SY+MW "/jȄ=|ӱձ<=Н1r==(56tEǦn7חm{}Yo bJiП֨I a*g@͕ɟFvT .FG5;BǼ%acOY&!䧃JL5=`IWm5J'Uڐ>/}F!O xbVK[(ySoE;!/}P[-{e<'-پwJ >_qBWC^!v Ojrj`N8?/? ٷ\:P!l[q>ݖL  =K4׍; ^غF*+;@=Bq ?V\1OMsvƋm=1oyR JFGbro\ 1D9*<2=Je ;@=o"Q}nvUMVq2FL;+qw켋BV٨yVtC}'z{B\^β#cB{5D"`I_&,x͐¤2Te\=܍Kfɘ2#ᵐp *7~šQ7EF{+rh^R Q"z'\PfRYPt&zc޲hQ.cC>' 8oYBc7MwLOcҮ[[. .ey3P%s+;S\sǓn?o|A )Z%;E6:'p}TO54@jH7gM6Z!.U:=r~M37g ĄNy~ v-h=VHY@TGQڀ:U;"(at1vQx,}߇~c TQ., *ab?5ĢX).*7EWAh~dyNqǘ{C (ᣠ] $6 zϪӧ9ȽFpN pʾÇzgMif<xp@l 4\&d``f\0;".Fh6by ܘG!e }MlӐ@fӶ-\߶q=0 :[5=ve&zXeI ׃^eYvƂ.Xq㳶9rDWxjroșC\XyJw E|hF7r*M7;F.Q(‡@+ iK 걥˨fUFm׋>-HDx s(ὠmC='lCxo?{^;c5l +N䄷-v)5lɉ,93CO(Q,le`~MQhcy1qJw*?l*P[~NT`ts$)PKsiɍƈOYͅy"؈c鞰 e~0R) 1+5)W'Ld待"(gLSt .O(\OXܦl/cMYK3Z'rrMo0v%H JmJY?iMV)*Ыg^x*`[͊9C鍕 |ZK>^˚CrY^;:|ڛ;DƠ;~"~h[oő(6Fk^ U@4ͷR A'6z$ģ%qšv}Ua얷};MxQPUff.5Iw=зh3%yj|[A[{2tkU,:4ͧbkG%nӴf/AP8mfߞ~Hb4㖦ּ=zfܟ(=?d053oYCU.Z3vs9rh; i/;fVy25[گzڣF¸Ϻg}MWP,gOxI7[rez-oSo)PzF{ >o,]Eif-^bv7h*V |53a[߰C]ؗm2Lo\0ֆ^w~+f U,&3+d_ yukC3L>{6Ă/`޷c3~1YzP</wrtXBTa茾@MuP9 ]4o9jHSZYHGHKXCKA+MV Lؠii%O}7IiS4a-n">HahcNJ댍$)z'<^> >pn4h\+[=Obxa[ /⁶hˀ`;|,,دNXe&4w\%];!bLK #K+BLs|Ҳ|69o#%IHy-l#(TAeUWik$Sk$vٷ,Wn#d-ew8{RqϋMx ۥtu\pۡ֨I[luyRc8wp:jӢZ 4Oi]DПIiJ'%>iٖ7E3dOo;0xUpQ`?;̩|O/meDz1-}JY![QeI@2c o1<2t{,g)HVoը[koغ6(Nc}RŅQofy+@+n[B2z1h]H5Aߝ DHGA+}DD=A+uěr!H·->:\GdCOGiYKuWx ~.9c~D)ԝE&_oeCD`bKcDFMB.A+}KQRk7"vǁc7OImu}2ywDKII)ݑR wTDYj mf/^mwIGSkji{ L `9G\W+BTVhhiVihmm}zfɳ .m}?Kݳ݅ o/#Mjv䝾$jS[hΜ]BRC=^|W{GJ`F@\ ok`*;Tw˟]2c/XG>i,XuQk4}V"k`|'ogq,/;uz׷q,7{Aq}b+tu?KFEc1',dqB nH2DXڡԮ|P|)䀿w+hX‡d,}X\KH]^f갦2ՔM'G,-Sk_$;ӆWaC;B23z|sՍͬTJ]U78ȤiӬRigK* R KA&`oJЄP!KE?OAj] GG߁[Є44QBAQgЈ sAjvΕBۗ4C;%7sk\qhozdň;boB邖/4Ҵ _QHwlϧ ®n ֻ]bwp`lݚ5yjP-e~%%FiBu[T#7]n(,Ount6 M,׀^"]S *}r1Ncz"/]@il !Kn!0Zm_idgJ%ē=KcsՒJhk/5|60ݢaF6eq%f7ޔf@g7eb#!M -5內xSAeWʘ}ɢ}ۅ|޻\h| 0 :1^ $o7€ol1W0̗5P3߈nl[m7r 7ސxbV&6۸D[\١; y,7)s60+ VmwLd&qzÖD/a[$ēaKHذQ ; cNưJK ; cN'kis161w԰S)Lx';#fgF>n1vƬeQ-d^ZĢYv7PIElbx`7Բ;(ȵ CS+ϴ;F l0^8CeiaV J`pzwph&o+9DeY~J>>>K||f}@{9oM!/>j Y,O𘔒A,1 SH%WfX"%RkKi|wX݄\M\C.UѫTJ߮jƞ0%-5Me1?ڥ5vF -kk'yϥY ls׾Gk'/W]Ʈ]a]]Pvk7vUK󮽵\i]#-k'7Jض=Dko@b,_{Iht$vCvJC}xV`d}PHVQb(gdhz,.+̘InDkvb$:jY1PX RfS\(rC_vJ S-Gyj9|r!mm̫)!`tQj|E՜AQt@;Ut6Y-nyA鑸[A5<'_C=x793wJdX;Jw {!iukaMȸ  (zn`ӝC{@ߣ*o <Ziu6g]5z7;0ln^ڤ1|P#ׁ~vk_azY:˅V3Z2VPqO6 A== TJNUP#.,t8@":>F- uH)ofHHV=NiR :#7T/SJw53k %rܾKӑo qGM~R+UiKMP0e)Aj J b7| cn;`~"1&mjӖ#pHW?&JM.&|1l9$ľSB XaOO-Jg@?M174\ l=yɾ7W!Q_4OW!v~gwT ˥@ jۄ;nٗDb)!EȳCl Pm JogԛG2A+j[w#4@eّj%dM-JgŴ؍|%RA5dT)U8(fàYDd23u$> $6f /HƼ>Z)("Zڞ j"BAp=ˢ Đzm}:uWԣ;;;Y-;ׯ_O d/Qr N.ٓ3UmR$]w.GIOXWuᮌaC~2#X(C"#oh;';R\(~[gri=א~C#˸r^22+%`Oz0Xit}\{]wwzy;oaK4յt7S*Ց]]̴eѫNx{GmyLY*!B:5Y}K GN3̲ozV;m Ɲb"I~Q渎;(ȁ:F("x"T/@? /~h`MGvEUZk%LwzyS,zN;*,ëX{vMڦ_-)oTf(Y1μP)&,G1tM+G=˿# @G5LuR\4O( ,U/ʬmݣS",D{MwGHJ 7ԫY_?mpb= Qǘb!Rz@"JݝHGkt۔y6] :sy]b)!1 -BP/Pap5h%{oui5=&s BJGf9ܬݡbJzcR-_9GsM]֤kl'*쟭ç<;iK.7?8Z2:ڋD +*}p%}mVRlʰfbMLT\f%!i7TK+@k,-݃,͐Ipɬ&\ph^KI2^'y},9x ~`>GEf2[ک3DQZ2%̜G5+{_vYj u LB>خM)ydzNTDgc$Z[GNw-kpRfڥ,Ym0v#(p+~YRjqےWEwFTߒ,D# pjcjcã QGNAұ1B"Wn?0 }ԢUg}m`ƺI)"v[GAm=\/b;DÜSI/"wޚG;!{ YNCn1L!, };{Ï9kihˎYULw^ǻ|0niY_ hI7[re ׷N|=Ruq}}7DtW)@C]x /s{o4fCT +ʆ|quWpoš}6O_u7].LkC]l/?;o_a2B0Y6d*>dogæ.溌i௃fLo̺kyEԏ)jp#I$3*ʂf<"ݜkm[Z6/-P[Yfċdў?t<_FTǬP1*@<}aU9Y*!A˕lOe +x+0T}+A_\aA]}[*:bOg^:#٪Ǣ: N[n.@[ 0^YWZX.!B~֤N)LݞX\3Ĺ,טJLSuu[J܉[,7o}Lƭ -@b'yFIޡ,̱ue c:lLҒ3&=rt3mL[JL\?9NYb$/;EE|R~Gd~WFjˤP)\ۢ2w~ʈݛ. ZT_F |ޗ~oxeȍP/SK.uwoLqwo #сHy\z{,'tbß }ƶ}Sx7>uv o> ~YZ+ ~X]h%\,.&~ - h*|4ὬCxٕ6N +*LʣF =# j! &w(MX_;ʶlÁ<3d`5JfL\: x;5zqRSK;@mX/-0M4FũTKf>WdoyfRk\lX3<:ښ60嚕 ]޹_9'z篁s:d2..'E;M]Ō{y(vtR~C5 UwckZ}bwF|-v>[Єsih1KW mm#/+K%ԓ0e#,h8Vymwm+.8^ تxU PPe>}Ęg7p/tPBwީ*o oxh-\'H{~XQXﲀ'ALFKKKv)OވNLXhzB(7+t0J tū31‚-n{S/A#ύ# uXs9^&IOM߸X#=@ RN@C^XЈHQ`tE[=,BBajvu@; Gu?>3V֖enivlKle[-mifzݳIB.΄b W JH zUߞYͬݻ0~;uׯ^UWaaաn *gs,~;|u0. er^S2Hi=A'Q7k~8rQ+s)l+4[b*.:o{q:5ff (baݤGt< 3 mwSc{HuQbS~ tcWT,W;^s Uڎ%CTw9H5K&.cyw|iӧCQ+ϫO-̪n޻opkv j,_eHZ}/an* ;?ُ&$ <-7`F +]~F43 N`F [TILׂ|~EpBE!۝z!xMZ}C 0W?0TǂƝ.Tt^'R͵I˛N䑻EXx +6.p1 t~z^D\?}ήΝ^3xL}~k Zyo ztY ;LQߣL[(G )~HFqsl&;DFX5n7n-N^(,I w.@ЈA_ ZfVf,>Y _۲\0ͳ|ӟ8vseL@YϋKLS:VqW/͐bq!Q+Wf[!\-x:gˤzB %<VH~V  ᱽO-pfxdQ7=1b["l= &:oBpBE"~qA;7 NEp„b[PulrjnOM~QpY> b_0}'o' y8`щmǛpw-Z4@)-`' NC%v231 q Cl[QviSۭfTPRWjhB{.~ˁPQǷ靷cuޤ <CCτ{xe`/W74̥#6|ghijn6{saO?/8aX{Rɚ҂URSj3 N8뒙K ℳ;/4!Փ7_*x~pg1^&xT?؜ԕiSіX՘pJ8Mpe]p`7AW$0qO;dW2F jj-DBD6i˴ȏP i{.dFh8F_%gyU[j7}u2-]],fUKm񁵍{;yfT0iiE˿}+LPJb4 FBߴL]C)R/K!| +rkY]{ iUR.2f.{ߋ,~H.xGm:KS2׏؜m:`пvyS.GW]RG5uE׃[5UUݶQU: qxg^-{zURm~Ӝ- Dnp |LuWNPbL֋Fб"U>ùf78|:C;M{>YGsnj2{llMNPV%~@1!0}B_-._V@ $>C|$aeE>'d\A[[μn(#zu D1(\>91rcpuJjV[7Km.^.UكdltQdlfKJ^zv|Cȇ(;nm =kS^aл0:RYPtGEs+iol=LLx \ dpU)?FctT_jǬQwRol&e?0i3mJNO6~37j }|&3c*ۈ} Y m [X>׷ZXayj2a2^b`+JRamlG]?B?C|$Ӧ/0!hK3> ÚOVl^v ,{׬YC7 -Ycm:'4:kF"u^ͫ|LNr0*^pp]ק Yl{ho^]nr#c,]"#'|Z00ڶzll<={MFMWZ6U-qA-J*\~@֊DM<''0g̼6>mTvL#w>CiKʣeڭht<7.wU8Vwi3Z/ǠbV_ y?nng3B:.)gƐb߈IA#y/=Tŷ3̝bzIR 8mĭ~{JeMϡ_{8;n-XjKƆTpK*.?}=7˭BuTvp<(p }C$u笃{)RGIsZ~TvIJnOc]; Y7*lV$:*=Tck }#sez7͘| 4 d>UG~~(F |Uh%G&tOz]u@j|$l=QD{#_68׶ XσBh- z{Jfb,onfGhոmM*fU ^ ~uQlո-j(oo<%tG? O*m3M Mxa;73Нp7!5@3[ ޟüWyW/.=+\mޜ~v}&aaxwSͪ]ؗݢ?tgRИvofm>_Y|g6htPә@i{7>toܙ3Ǝ3HJk_ԍ銳`dE/*Q0@>_+hH0Qv߭9OԖ +XglPVtQd 9mtlh/ɇ}Q a$/!>!R=b*ELUc^ N;E%2&B׃_&n2U& /כ~hҚY4O~8ė5=cH" Wзb)VGk#YBY(ՊFpU}' PU/w nb mw^Vu``ׁݷY}v70WV~ʳ4>]lٛ0{sy~o_e ,VVY`Q-K1mMg05-&f͡+= p|PF635 )D{LT$Vnr"(Ih[aFdputV9|*SŌ¤˪?-~j9gL5nM6ΔFQ`Җ`qZt>K7_w2e~?"QT&꫻x9sV{L`jREtr{kB,pd%6Y/!"kF7%._,קs>Mq:vK+WJ6Giћ"SN35ù3ÓkϜ^3t kHvMHkC# jsK3n8kpp8S+m|Ef{uoɜ3ns25ZvK C5QIEefRQa3!i cRbR ENsuʡFi͢8d]Jƨ7[N\~_ ~ ğ, } ix>%.t?s)q!}N(qQF2%.j ]^OUKjD+uEݓM2K2 |<|8s!>'7URзtg_B߹$ pd.t?s)s;Ed.t 5Ltz=WId.Qu2uO-\Jd)1N M\*3&.Š } ix>%.t?s)q!}N(qQF2%.j ]^OUKjD+uEݓm)r &8B}ؔeA]Q B] VXT ?³Ҧd 6tn-D o5~O'=xwO$+;FCzܻ>-s\Tc]!>pˣuSp#q]R+,Ռ 4;ph]໢wЄ׃_s|O;$RǯC_s۹;w_n-f xpN%nػI>'~^^wC2xH{pwDcUlD . ~-g{\z|S_voۇ޾:w}%\H{ɸw}%|J8Z+W©:8V`&{|O>'~w__"qOUn"Y dJ->'~ >~U9ۯ_5]mӽ*,$"f8nP'՗Ke<*x5^C`'|Oh=5x$<2ܼk8^PD|} 4>X'1 1X _c`} VWGM l}Фe쩨={5p={5p'=_C|^xso^xso$}퓘AGGQ6k;y/p?蝼Mx@NNo!>;8h|4c{;.L|s.L8>;A; ֝AymQ9w:X(j߄^y-\xm.6Yw^ 01w^^;w8 ILhҴ8>GnG>'~^/^GہË+i K | vpz7;>4FjW7./OWWspfMRxOM2#ܬLu̮wi*S64Z$hֱ',wCF+uݐ\ۅ\f?og?C|,|8?O,|8?q {p; &; &ݛabrp\=Խsp\$}nsԻsh޻s\*^9<\ި!nyfΣA{#\PIh֕jve-X*$΢29x ?l\N%um̜0aR5auM>wMpvk|X-<=)u;~δ4J?M1JZ̵pgï $~ߵ}|qn]nneܺsgK֘Y`ytk,<>ɝ/۳.{.J%:''i]( pkvjD|hψPc,&oFY!-ߊ!C|nG,CI((G<87JFnyw[ ^-p稥o%mOΕc0Y\۠qz=>N{\#!>ǵ9F8u_LiZŪU1e7Ӵ Zť2 5lJul@~ǐ=*R'O=vK%eqKiR< ~:E?%#4@3>'E:Oj?͇Gsr%W0 U 㺭\N4I'i(ZȠ*Ev,{C0;Ⱦm4x - UlpH.嶬-yd6m"xQ]V۫J2:x,eЖeLrh:^R2iR1;Qc%d eFYk>*|13/Iha^ |qe2yC, | k1+mh,I;H̻`fqzA)*!? !>;GsEIѶuSa_Ly7<੫7_ V,;٫^MX"~"#/Qu|0t%|zoϽP&QS-\nMa#e>'u$O2PG܇D|STڇꆄGs.͛pA_J]%KE#3ϲLgteTL0I$RfXH#@ ܊?&:&NI$ocI_YR!^p)R4oZnDufg8E7D&֗l3J_s%Z1FZV@ځ#"5e]YD2{= H ]<_%8Z( 2!gx#/(hI|OS?Q$}O}Vb?KI(4U?G\Q/ z +}K%wC! x\.{j%)1ǢS$>顟#9dyR>*ZY#wLw儁_<yϫ2me7B6h{ZZ wi;W aM#-0}Qw`$bqja_@M<#֫UtNw휡;Umk¤ke% ,.wmsmCr x7ч,wx=9MwTµƄU|>F 4X<{_W8ҽ]e;G$@u#*=}D:?A}WtpgnjI/PR]Ra7\2M3tJ)#_9|K\zeRfAx *Sk­#GԙmMMr7p.:In ~ohh-ӟ"Gh͂9:K" ;|)KqHwto_ .,A_|B4WO᳨^ 8hpdrtRς6E \h2k_K:41=; mF~਌q (3 N~ ' iM\RiW0It]"iARIYK^ێ6};pXpl!m /KJ!`Q@ûerX<-y5Q `Yt9Qz?M,Q&WHpBEI@&w'TdxWp6SW='z NqO6?tptQ.7L7/ҩ ؝RR+t PE2F/kWE7hp'f(i[/|}iMG'ԭ+ Sq\K #esi.PY|(ݿ8*NO z'o7|B Cƌ[x$|eKڸ5Cm?yܐfdEFP3zuLp¸{gO=娶 L5O:.I݅0=]d%S^Р>KZ] }Z,j,!>knہ# (W.Fji/rX0oc- CNK#{dmLp/j%tׂ*2LD Z({!8ݶ.'? N= .q$ٸ'T5hfҌv)'.?iMmg r|bv>SO(WѓǼCU/ioQWMXcOK1}TPg~>Sm<*Q''2)oKM.:ۼ12,q>ӴSO:;-=p:g8N 7gR6\>P'ڛykjen=?.ͽ2'?t$p|2wڤMWj3N, 7".A]?xKMn7yIxѸ [jQ*$ -WhCXK}O# m0oQ)`:sz,8%q\??sZ;s΋:{ix'pxya₳yaG/oN^(v3Tlaǝ^064Zϖ;;C}G=Mv-|{lR#kIOЬ 7NultnPQ?_֒rR8/kdj녮wY/:Llھ`N!.^ ~q xxfETհM^) }A:ZBͦ9 <LKq; v$x%\IC|ODzN8RuR8RuRwOٚ+3T]Y J5T=Z GpSWm2/X]ǟE@PTTNRեG˺:sYz︶Qsǽ7XS,EP__b8AWLk6 : 5cc'$~܇ğKpN%p'p%Bڳ5AWg" 8k z:A'狟 'F3s_?A'J-tRB` :I] TלZG h\w]\2Nc0ӛ4^nx?q$Ɵ|OiH TZN wPZN.=[r%z&+k@ZFGyN}Z~a0Cv<kr4-8-'.Ɵԥ@uiW&f;vUگaVJȾ5T ƍnR =\x\jIK ]k%UN˿ OIC|V@J$@BT4O즲;" yOjYg}b߼pęGU\t1{Pi7(rL HB?f0)!pVL!.vߙBj,!>6a;) CvRwO:lWg"ve-h8֮Q ۣN|3UG6 /X]?l'Jza;p!0a;I] T7l]sQJcyM/(~~i tFڔT^F<._G]öyFBOU$C|OoMԜpNp'pBڳ5MWg"i>kiz:Mԧ狟 -F3ds_?M'Ji:p!04.Kofar2U:ˎݞʝF9a;ʊY̜ 3̜>|3s3R"'S9) C9Чl̕HfeLjEf#v8g'6 I"̼83'.Ɵԥ@u-t7EnLU:,Zb^f8lٺY1ąSnd}8ܜ>?7'n~(%q99 }j\Z8PΤ֮Qz^ܜ.*͋ssRB`9I] T_I'!jM`}Ě0%Z|d%Sl| D8jv]&KըWpT:i,KU Uq4eA;&-d,(Mi&6~ƪS3]ѵn&GcO;+G MvDVJ?geP\QC~+{QCB;?׋yGѴ2r-!YDok~W'g LPtۧ7Ob:fRd g*rɥ_t;';,ߎabp6SY#8\g}r;'>׽Vtӱ*=\KzhrYXے7](Kw:ʔڝYz*P! y2VS0moC }uE"liP(lͥك:"ZhT?,`¤ؕ"ӇsB#5H ?=w]ÿt9s%jɚ2حLZ Z]Y&3nyJXGP4)V5jجW2ˏ6WK:͆{1*mUj9iowjbޟ!ƂwB ir߅*젞kwNBK;wH? kXRcۿ=ToҼmJE:~y$O'v]W(lFղYX5l:ߦײ?m,856:.5v<$ SֈcG_i_RѝM[٬l.mj=vlVP(jy x1Pz'GZ9; N,w/m>"8aCw3P<~ߧ05m:;U;(Ɨ̃<(Dz.SVͅ@zP>S˨ú%zlި(k6sjźh=/NWIu5 `u 1yY ЍpyK'spX# 9!>s#n:7m>ɨS2ZĒ9%-UgרQ;.%uJZ8pgήQ%uy.B&;T]##ۂ5=O˽` _(11f9 A߄>'7:AMs?F`oIR`o}rέ79&]S{ Wg"ykyv:ώ狟>kݹ/X]&^R&\4#F4I xN[]tMV7oL|ONnN%QrRwOٺAeJZ8pήQey:B&>T]##ۂ5|H)UaQQw:Ez7pxRCd-x|kBHa`kBHQ372cSsfM{Oٺ&DeJZ8pƣήQey:B&>T]##ۂ5|kBH@ukBa؇(ʬ;*ruh$GGǘQmqTb sH F0g(i19$u)09$LJ)|9ԜYC.=[(3kh=/`'bS?9_T]#05| sH Ux͇씇vH \*9$n509$~]CRͩ372AZCn=[(3ZI t5::SQGpd烟>ks$s[aI=ÇȥԻ1.!q;/!-_CR\CYޝ3 sH{|jօ9JL,V3uv*d:\4g _CR'Ʌ9$z؇%` sH܃T9-tZ3Y 4yB0$~܇TfrܰNű[{Jq&MzW_{BeB[g?&J&WWRh!4Y!\̂gCd?qQĉ^މ32Sf9ME޺1ݝJqzX/4tX/c"^yjq.^^tKa$85௉r |-k{^#pS|U%ہg<6y#] m7gb#MSVq 㢓'K8h4R0Iޓh>n 2?]-YckN49%k2VK%C[`Ң'ΪWD@Z+W*{A#)i\j=YHJV7˭R D{/A> 4o!~~>@|n:%>'"I}L(\$ʴBQ5=7ht#UzxE7^ ~"ٞX\Fa.iJ(xu dmĮL˵?֟X-0+ymh``{.4̑b707"10Gb 9Can^18GWGm嶦4d#5VׂUf3 %4<~ Go).ֲ71kۯ H' s$ `#>TS9p#ezN8W+W$Hufe# N8Go9i;a[N(kUĹmꬕmE-ǪSkeBW*HY1HIb FJ"`HIcE\H8 "%8#%i)IzHyV&Ŧ5f:Zld酕[pU)OV%A_ ̠K}6kNj(š:_;r 8lt! zE:.o< M͓ (3uh4fʠ7H 6i~0~@]~: GXЖNgղJ-DtV֗ef) Rj3:p}ÙFߖApBEmz8eayc6@׍@t ;G9YueCO>fأgVRi*v60g0>)F'æ_p6ڈB*|!  k C"6n0] gN> xFAaj´uT3G{a}Vbyj^~2 7!D:] -_Jc1]sFLJli٬oR]k VdÝRC\&ԝ m¥q!cV)dE^2RTiwcf,6 /Ia|=MzjdB $#N8;&;HKOǐ{8<O=.nZy=x<-G&R}7N;C e2R:Β12iu<C%2wpTpNDHЛ ??89!,[YaZ"R-!qK|ͪ' @D!a^r[7 ,bTX* ܎GEbh;a/kefCGVCseõ͂Vu&K VrT쎥q,,t;w\w6 ثLwe6.DJri XE@EG$^,xZn9ꄤRूǑ v/!$vvU I5vrZr)}6OPy>8I1}+ڨ^p=fT"h3W506*rܝqV*_ׇzejR >B Nj·8 m+ӥ@-[RC%5?kh}Ã\DVDŚơu|¹c؃9m&͌'S͒>AԁMlj7iֵzs<-s5L4jIxa ya8zWDWƱ[O,^.8aH{EXut&yqQ*3gZ~F`a1fy ́>pDѪVE)x°.e\)y7=)] NE;L+Jִi¬^| /"#O`ǂrI!8a w Nґh'M~ e򶛭Ic°EE=s8h1agA)դXX^w$(ֵ{J{ar|7~Y_]F+ƘN5Y3u yyDG!;''T( 4(drмV5w  ^*殡C'kH3)%~p:'oc$axƞ?֏Epsw -91fkz cⷁ?c8+.WFpĿ&8G9˰+[{uΎ͛'''/ }U:F%=hWǫ]];Qy?씋nISt;+puϓZ,1m1z =ۣE-?!v9fZ٢%IRv}AV>-8a)ࣂ)9ӂ&1J*< |q_0I.)30NK` 5p^P.%&8IKW_%@ \ me1saܢN߯Z+3X"cRx`<DLQVrs2)t+A#R*x ^ k:q 7׎QoTY7`sLʍG;孙o|]3|_`_RՏR, ] r|țglTο.\VLJ'kx28Կ3#[H"yZP5Fi*'Ld LLpBE7N_C gQ# N8+z?/8a3 ^QSK)nj>vV)s兦vkS[F:|/_ ]#3R]poOp!s ~ Cz=~* }Ō>[M{a8SpBE^\􇤬G'~Lp־I<ĺbS@7kYwjuó{t_رRpBOeݱ'8a X0?$ͫ,=VTK1oO\瘏ڤaӚ"Gc^L߼yn$_x>Hƞ)ձ;VGUo 'ý~ ' ^rHE%sT,'.SjaX`tv{UyN;6O;oc xRiq$惍\(TysTrSC8t~Mp18_^p'SR^﹁>Js5y|vu 1xżeIS63Cy2e7#|bO/ؖ4%* N1.;\s3tOG'8O1,?>ޡ4X^s C;IyB K C6gף'wQףtWw *WZAt6on(s.i ȶ*Es$|h ^4'GK4o?} #q'Ov1I~ Xkg%䯅sk%t|&/(1ǔ | Kq / "eh\vqo>Ĭw fe.K 0G9G?+cD)1=B3 |ռ-›Rv"U"lA2mH^8ӎ5`̘U[rm Qo?DM!R}wEV>M-ܰJFiJnnƍ jV;iϺ]wm`MYļ)dVm .%Ch^l+UT7 Nu #qƞ%A! ^HTNL uI. 'Td#rx`\[̔txDpBeF{J+xFz(KX=⭷71&yt?P1)a*! Ǝ*)T ';c Qͬy}Pp"i(lZg-2uRm6繒.Tb繒n({ޠtx$.$繒+kSs~CX 7WD9ߕĭ>>|<| zHwJ؟cvt$ۇj#]gD#UzENB+j<6d#5׀KxliYWn.0Xl#qkK- 99Mo?\l&*:әԔvArgR>LLG\\wC1iBx1 RG=$n)p%^o>KY YSq\4s}_Cr5IëwUYvX\G(R`Kf0)P|i3N T䙋ڈ#2"O }Oj<an4ZXHΛZXaV٪9|d\fPv ڕԸ·^*qto4dQQ7 Y f?ԨR7n%6|X_6t ۂw&9 PE`f{[ 騩QנE Gʎݦs(s{'q؉O9L폛˶]o4L=PGHw}Ğ<]ؒxZ~ڽ09f>bٜkR%!cԐg1p51ZnMtcҷקw6h=5m:Fn5j >Gjz8&eփh0R{Rúс^Wkj VK=3oq\HyfTP2eҏѰ)‡ 3a6Smom/^H| F>t8R%P՜T99#—he~IΝ7'}j/Q)=_uPǝ^064Zϖ;;C}r=Mݵ]k'Gyp[op38|~JfR`u 1yY ЍXc>_SoeCnksl'}[̍\nO2jǔ˅3\NI c5\.:SEpr烟>ksTs[Ęl^ ~\nH99o)ه̍\ 6Uړ>$vL\h=唴p>V]<%\M.w>*#F8GJ5kCOa^_>.m?|>7}OH5�Sc,~ԥΙߤ9]S{Vg"ykyv:ώ狟>kݹ/X]^R[4#nѧ}Rd0 Um쓸x.sl!>1&`Hf37ԜY@n=[!(3ZI Nt5::SPGp$烟>kss[ITAU TB}#p7x={1^O&9>C+AHC>gJ%z&P+i:FPGyJ.|3URGtpvn V!VH5Q(9d4Y,3cadQmЇ[CuF'g rrC|f`8㐺}j8JLd%j`'Z =؉v?_%}D39`u rxU*8$^!>;B)rK%oaqH&`*8$~ p-!uV(BmBZj%-8Qgר8$u08$~QP1.!q;{R-!{}rrrR p-!uԞqXB':UB)I#thWIu59ڹ-X]ǿ&!>ʐTF}08$0rbJB3ا [ A|OH5`&ѠTՍg&Ez_w>^L^ˀW˽\TY ˁk$du# FR$߭4%l\~N)x9m |WhjEb?i`JڨmR5~qiV1l:AqCjV\Kӵnf:fƘeOdm~=UF_L c F'kDS['&~CmOg [d'=;棆 |{O\#1L+d:rD5TÔieqJ8zma" lBGcO VY[Γ#E2f~*snʦj=K6a <K_ 2ſO!q~ m&>Oee ) 7q+o-= mu2/q?@[|?=^Ɛ wcu6 2q?6g9Xfk-K=T+7H=y5ǐoG`&+lHlOw 䀃-H|-3]o];{l^ؙ=v.r/XUt$Mob}s ~#t9< }WxHd :swT H`%p2Rc9P} 랶BBkBJHFoO ᧢#K9&Hl0HF}:>8*=#Kq!,drH9z1 77HG/|Ӳ?pQ#tr*Ñ2ǁU1R0ÑaIjhy=\~Of%OLXc$&On'޾#{JR\nyepzJRc%p&/Ha^P{>'n5^P[uhĤDh~¨xG};7=fa\+p,zל2{RlUc1ɷ`ٴ٪"Ea6R$J#vVXήLw_]r6L2Z}{ZG> zfݖb2?e9a^ 5[W N}ZSvjl9L֛[pBEQF ڲѦrՕ:Ka CfuT"@4CghRDZt 8%\ϕ[8EьSt0SJnڎS":8Eѓ7NSaV2X߄gN4 = iJ2C0ON҆ݡ%O(de.8aU"ijU+07+8yV@r#ݒI26&\o%i5I4RhH*zK"5W۴*B3U'itTi5tZi^LI9: 7Q%CUs 3gz['LM N8'g~j&%jD7)-pޤ0Mj_%7EiyStRϑ7yrCޔ/XBsCP9oo;O?!x&RB}'}zRFo5}5"Pghz4W> :<9߮}@\k "3ge"NWXw+3\!gg,}Zf29'Tdylk@(X_1Op8?;_pF6C5 k8 ҭǰ'h͟>wѯ3a//ꮞk0Q<ȑ)\gOB9[b+3&D-ǿ%u,~MpBE^9[brEx!?ԃ)v3EáwXx 2-qQ _/aG$|*_a_|{q ބ}_^Hk~[? gy.7[upzyY1Xl.Ow ce~C k&i  ;Rr֒nUusIJ*C$pvlxj\6Qp\6$x: }zj\0X.UBC+ܝ(8"_ <,܆<"8a"z; jU5rW}X<]TO Nڂ&Q)*CM*z N8=K i͟@p8<0l J# CQ+꯴Jh;9Jj5{\ !}1g!}>2zO,Ԉ`?2ZKmEaϢ^OUY6W,Ja?'[tjnMK,#_Yq\Vpb/3N #Axs\j:a\o!{A HҼĞ>9gT$>\jFkՔqz)}Tތesxt1Qq {B/UK48k`)[ŷ7U1ۦNrUaТU܆T~Q̓< Nx>Jǀ |:*TzRFo%5I4URhHS%zK"5WT)B3Jo"U9+#GOt;quΎ͛'''iʈu}U:n~\Nͮɮ(P0Ö-\oHpi6ܰ?'MS eQbg< whfTc)8*E)]{ O_)0Jp¸~WjK{{wZ"Yqۃ/!>qh~t??3UBN;HO s$t8>  kNRc۫^ yīfc"?ƍF^˦Fg~G6&m )ژmժ5l4kST' ۩9sv׌SU6]P9bM/9|Hqo i\w9~ޠmsV1L ;ldZ ]4i^mꜜf1)vu&jئUSo;{kSFԬiX|dk`א'T4݇cU&xV\;Z邧UGk{J <|!-nǩ}Gzy9hfGǗ~&𽂧o>p/E J? .^~t6WXjF#biڎV@7Fz|OH5N9=lld??sZ;s3/:82NEW5I,nvq9^S{P^_uwzxz(7oh=[6< =k4۵p e-qn=;֮svwF٩7>j?gaY޹/X]/o|bL^V*t#,=k)*p|0Vnߖk\C|FJw pSFRz&)i]:FEyJR.|3URGtpjn V;7.\K\Yn?Y: vǀw5Π}OH53Փ64.&8J{|8gfPIˁsh]S{Π*3t[Y J5t;Z nGpWIu5 YA%+WT͠J5C|$6 Nlsܲ&(|ch{,[@Jl7MR Nc}8gIkshS{Nc+3ZI w5::SWGp烟>kss[^!j[n!>jW. x`$uTb/HC|T vN &1D qD %6@R D WW_C/Hݝ>gK%z&W+i:FWGyJ.|3URGtpvn VD oH%C|Tծ\^}0Ɨ$n70KbJB2,[4yBЩ{ Fw}~,u?Nű[/;.ҤxѻBeB[g:•U$x M7+?MfmrT+5ZE2mǭ4wx~QتTr(MID> >A{:όVrݳkӤɋ/i<6y>e/ mVgtWMDvd5*nۡheQ^<2tZ`_9 ):bq<RcHss/8aaB`i )M  N&7>5zQT&jU\y]!8eM&/\!Ł3?PG%5c3gwRS~h kEQ"ӡSzz4;j[ep5;N6GP•mLVPfE7N1ia&˺{STJ[-KʵkҙA<\k7ӵyY5`V^dōYIܮV1D-*Y4(ֳME,Օm*{뵽3CЙ1J;-[w qNLo[۩}'k\ei6ec'Uj%uPCwjG-wLGݰIJzm_;OZLm(ɡqe(4GZ>Hb'L]@7x#y7k &oYp¨/y--&! oSp,8a6y Cd (c2jZ`uv I%e>? :&wH\ K] xGd 'L0$M.^&xԒ6ᜰGp6N!IˁƝBIصjXK!Y_y'X WT udf-p#r`LV7o mKPfJ Qx ;[!qhBo I;a[Ըć$:oCMI>Lkۈ._eeZۇ( pz=4.=+խmކ -YmOɮX\ Vec^[ %GڜJ mL>hL#'.,1Fb 4C1m_FcioDž +cڲsjn.[/FH.CcAv j$ۇj|ԎjLp9Tx ށ WH.+)3`7&G; ]0av.1Tk)u!r棭*wArW$ _C|V]h{|Ŋ Gc'kq0=0io65g\6\,hm*Em{MU:ۜ ]:R㯉6 %1lz-Zw%ӝ TMFAo@j(I5l˷^0eb⁂^U)efB^ MZY_]ΘMJMW\SU.k̴U-5P_Vl% ?ye^k*)e}>B6C{J-Kv-:{rsbOJF0? Ke&ЋE [zUV؅~q n"2 Ugp}4`X쓾FpکNNs='8"tEH'Td&o[=U(֨I4N͂zn$W&GwNssxTpƑZA*#82_A<|Dp8lr/P0Mn(9{z}\0ΝJ'} NȪ )ciLʗ~;}a7/8aHvN~Rp„?'8as' i vT#.8aw,8a&Q _'L gaSp6MG;?@u1G$+H- l̅U&d Q7Lz2[W Nu0H\#8a]OZ>3rv=['6'L0ٮ's?pX׀3Ng¿<1>n\^䛣K|DO=ɹ~4!/ayE3PQVaJf~Yp8iW' iNa { f޻d J0QNc1:jalkm5Z*E_gT nioBg5/^{ц\^:NldJ1xXLJ0]n3OMjpt| %5o>0ψr5ù3ÓkϜ^3tbH;>}P["_E2]qVLu?[I~ϧdn,SRFvpa\&jSRn)E0^L? NKfx2c:CLuO5W)yCNO Uel\ä.R9F%wv/39WsQV1+Ȉ9mDrHUUN<+VJYS+ OÒ>"F QrVf$KE,*(%{R[] ]e=?c 6Gax %rM4٨6 E%r?;/9`/ l?c8=}0fլ__+Xaj"L<੪wWmk,LoPp?P/`z;}v *tY9!~ij/`T(^{e5>oEq.5N*2xY^LZ1Ҥa:U PKi>2u/yq؇`KXYt`5^rj`ըj ؂Uqmzۨ+^<9t̃r&[X 4)1aXʸ,֌Bfar2Uf&jh-3 xYO$/ҨE26eVkM̯;%YiVPO0a;@ FE|wAn}WF;]4꿆^m˦biu>GcymuJ[R^~qR%mvj7cFJz]vQ ?!| kct>JaxQqI?q1=f~4%& LY9?Ю]WMޒӶ2uS}ZȂbvP_,Hwq nCW\$m[Sb#ؖ;$. &ć4NnەC 1ႋ/vދ¶q.QGNԦ.I%VLJwUwБ{8Ҧ\NQ\H\jB>*zpuO_gDQB>w*]1$n.BNc SwQ|Diw7^K.~Lb &I|M01\H8 b 8wb i18RF ,Yc,(x8 >\ `K38T qF0g@{f[졉LG_3XߠMT ˾C'^:͛SgǸ"G12ZEʿܛmnq@hlŸ$~9D{{]r Ou=v)qob x#{ˁϞt?芘~@FmnYW[km5LtkJb~jv?Z3W&ݧ}{{Q> 0l'@f?cPNSKF^3y=XZrV#ڏ:a?/WSpE \;(§ t@jԈR[Ha"J\m;)zr}c汚Ca=dkl.o A Oz}Ucs}%;5g+xKʞ0k:HWU>Z-tOIpխQfͨ*xwJTm'q BC]Ś^ hw-l\DŽt|*Vs&q^hP:S$ LC|9xgoFc[|ZSp¸ PC5/l!bfTc .k1{4w~^8DF;:Ö/pΘ9X! _|';v搦ղͯ ]ѧp$EwKY5^IOIG"jY V! }P՜/=T}o!\0OAAxg1H<_F{O|¿'f\0՗iGx.U8V.^~-p/kZR}Pe萿x[XQjXLUh8DJt61I,/6*c}=4 A1IL!‘U*RBfҺJq3s+ڳCzŬJ)@հMZ`N?Q1Sg)~tWDL l2Q˪= M(6 xNSj,ljbNƠK no?osxMkzapl&RSK9"ƲA L>2e;GE!=dƽ0^Pv$ k\RcǾ[zf5nCFmklQˉ5 &1bTs,39*gܬ6E榐LGƜEG8Yw8iz9r̦}O޿FR1ul={GV ksGfV] Xd; voB ih&ԳδʁbyT-J8>$Ōmh֌#)|gh]SZٓI ::+V(4xV:߈ts\-OqFeפߥ̆ˮI?x nihCXvM_q^vPp"i Ըć /G?*iTۇ*Lp!>ܼ޽G oKJ+o .'FX\ VeϐH( \ꠜ6jPĭ?\[7/*־#1Fb 5Cam~]2qƸ;p&!5V&QH<T HzM76׽Zc g̱qWcb攴l|q&p -9R:^]Xo68Z] }O.Zp! DKL0ZnDKRc'\H.ZΓ9MTX \ ZYHLK@x?Km#(>@h^eEQ'u%RrOp ZJi6MtAr+Ib&bh{L_w32V9Q&+`z-e ymI}uNP?e2m>@Y/&aSۥI=]aO:m?ٯ:&g,Ew/ ztY ;U"_SE2_egΙ hmR`ʔo-M)0]o[ uihPKK,R}m;n9iYom`5ҷ\<Atk{-[\ .IJtR|2,[GjU )<ނe0nQ0u;Tf ȸcRzX/cxrW#1JnVbc{ jնNH/ـ`5<"|+I5 UK1NVƾ1,/l⸆)@؞ .R LO{]{d<+=.8a !xZ*4 .R׫b9X-1 AnaA7)6\$wЋ~?Im\ =dRY N9˂< Rߜv΀D.kU},A h0X([y鹢w>]ܙ+3 NwuT;DT4>MnٿB}Rg[v-+z qoo7hINh̪\F ~g}m'_$~HT(OT^7N xs/ا,e{ W6qEZ{$; N뱦 7JsȤ|#[4F8S 妮MU/kE%6wNcc<%T K_I8Ks/iO'{:e/ 펋?ˁ{?0J?ZJ=GCA,I00In1㺢M١e5*IW$K_ֶƍ>'n L{K=A+7f&/wxضt^rtMC/5S|*]Mz܉2_beO)Z-ons8[X+b^J~ܧe?י UejDpظ2ZKm"Uaε"Uqz8lN;#2~e_wQVAp:m9NR`'u-Wr }^IRO{_lZU2Q^vd 7k,,hgw';gx&g+ZU]P+̚⤗A/tIՑiY(d42zFd[#es@|ROBKIa=XC|B*mT0"UWI4նat |MX"k}OH5ldS,s7 e9>-ä:`<$]$|m7'99uUӸS FYyCٲyqgY{0{T}vMdƉzes6: 7_>kMs_5>1&/}}(s(_`ni~>}6~7'}n?47>˨S^Z:%-UgרksWs[w8 >. ٗ.m? oIs}OH5oY` jߒ>3oIuljμ%'us>s2jǐu+3[Y ʆ5;Z uGpWIu5 sߒԍ@uoɥ߇H6YVu>mѐ"ۀW_+n%q׀_YJ\ RRЇ̍Z@Ucuh=KpG]J<%uMr}>*#F8G;ké*#)UKQ\H%:3xr}'p|8A nǁ !37k hzR=[׋(3ZI Nz5::S\Gp$烟>kss[Iu֋H5)( JeO>dSg?#{<Ӈ(v6vH賀I%h?ׇq, Ts آIՀ .!k}8gsh󩝓Q;=(k@)ZF1B}"v8CWIu5 #/X]Rq/! .!>G'Sgn$׷ТROmw1$סL,Vuv*$:\4g9^CR[CP񢝢Tr}?0E;$N,YC<4Sq/!ǁ .!37k h̢R=[(3ZI Nz5::S\Gp$烟>kss[Iu .!|zΐTv4`vHvZ]H^@LǮtA34yB'<ˇT>gCTSqV7 ^~y? +B'2WG 4j`/xo%xZn~;zE΅-b/[IϦFhz65&ҞMzHնgP='Ǜz6[qMΡb;U5 zOzz)pXOsOsjeq#)wb\ar2sfQ&a°ne IRaRd :Yc]~j&M8QZQTbcd]1]YzzYsF]_.N -j9ps{s^m%YaT"4lȯ9B9v:uvYh"4{;BNV>A-{'uCnaXҢWDQ e9yN̠N(S0'L"= En|U]hGG]t1жj:{UFV'Oc@Nw#24)O53!{*%J* u_&mZ,Ov'@QT+i7c?N3G?~ c ŷ?_? xI_UBWfWtᗁ_j<.koKQ 1ʷ~hn8.^Ӵd'ł* $l^ Bj6K_\&8aH]ZB#4'xZjWa>x?*/x"i]uH% >INQ:6⻀K' 2@(u90qUzOI@эx%Hniq{<\p+|[=*Yc?m^#\6jB[ VpЙu@FwNT @ #]n@6dKJBJH!.!X KkC뻀 jV/3H \A -\-3LLAp8̲x!֫U%vk=N;֣{-0Oi#2u}/&Mw\iSاצuľIzaIc°v`DkMX[`z 7uL 73 ~NM;I*qd>ݤnH!w] @HAƱoԛpZ6^@lt.`Wlq(V\bM7t)m`ޏm+KL&KrZ ?̛qopt8.vC@ Hk\MR/kƍ20stSnGJ|h'1-W~ǁW)-| x!` %JC|n-u#;g O=#$~aOj\S\4 brqX,P1&?db}ݨI]_F֬zk),Twuw#v0`USg3t,3*("&5qڨ/Gz{?f=~U] jRmf_;Xtu Lj-,D;g4J tھS;fUi>p֝-zwFakk ;,8aqRq^qc=nbxC|Va^} 7Bߍ&:ʁsM[{,'q[$N]( ]p mlx9F ^ CdS}ÞŲV \}#{2T\঳S&8= |"<=< 0Ӏ&8Tё)}>=+pM~Xp8,^NZ 30|Y55:JE_ sJ%PA%+pmz+)6*hq\ 2QTJ?6PGzPpY$mR&]) JZ'ajvA|# oK0ƍl8,(0@j/0MJ x,f&[Cp. G\ An;"&H|wns02ReB`w~w9'%o0Fo0lp \ngv8PԙQ nm#ֶPјGֶPPֶyK乤K qkyp6R8~Qp`}!QiHlmUNTIѴ|Y7.NOUWQ먲g'"\2 8X&qc@Kp32OB>=N{6Q 4yMli'TeI|q1{\^ ZL5b}eZ,QaN'X)edVF`ao^խ}YŜVÉtw{[bQ9-Zcbϙ Ka);ZAڴ/Vfdn\[z&0)O^%X}T")BEyc߷R \!`,8aHZ|}kB {;?Jp \oMX4p2c%#rzKw*M|Op'_6})(u>X|"R ;A5ĭ:b]>3ޘݒӎ`hfeM|owaJj\@{mU7t0xgo4K%z/Ԙ7 ^YYvjTLOgC[Y& |6Qm~C6mtc_R?m_抉Mѓ%%5l-WYRV6#C;p)mޑv7ivkU -FU^]( ow=)sS#l*=1e[iW!h(qR)*aI] >q&tҠ'mC" WMa(U6kO{yThm;buaԝd'X=kKK>ɶ/3jjrZ _$r?it;m :^1֪Ԏ5`Ǟ:AW& _A'~W NlP#'x ͂+(F#Tx &;q N6q<% |Bp¸}˜*l`ܗ ur[UK'm7 .W0)UM65BwӾ[I