metafor/0000755000176200001440000000000014601312006011700 5ustar liggesusersmetafor/NAMESPACE0000644000176200001440000000774014570362022013137 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(traceplot, rma.uni) 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.md0000644000176200001440000003035714601247017013200 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.7--x-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/0000755000176200001440000000000014601022223012452 5ustar liggesusersmetafor/man/plot.permutest.rma.uni.Rd0000644000176200001440000001613214601022223017321 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.Rd0000644000176200001440000000342414601022223016137 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.Rd0000644000176200001440000003763014601022223014426 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.Rd0000644000176200001440000000306714601022223016273 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.Rd0000644000176200001440000001630714601022223014015 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.Rd0000644000176200001440000001212314601022223015433 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"}, \code{"tau2"}, or \code{"tau"} (the last two 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 for the various subsets. 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.Rd0000644000176200001440000000147314601022223014604 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.Rd0000644000176200001440000000405514601022223017500 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.Rd0000644000176200001440000002225514601022223014033 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.Rd0000644000176200001440000001515114601022223013704 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 subgroups 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} or its square root). 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.Rd0000644000176200001440000003303414601022223014774 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.Rd0000644000176200001440000004605014601022223015363 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. \emph{Statistics and Its Interface}, \bold{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}, \bold{32}(7), 1338--1360. \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.Rd0000644000176200001440000025002714601022223014201 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 \mjeqn{(\textrm{m1i}-\textrm{m2i})}{(m1i-m2i)}, while the standardized mean difference is given by \mjeqn{(\textrm{m1i}-\textrm{m2i})/\textrm{sdi}}{(m1i-m2i)/sdi}. For \code{measure="SMD"}, \mjeqn{\textrm{sdi} = \sqrt{\frac{(\textrm{n1i}-1)\textrm{sd1i}^2 + (\textrm{n2i}-1)\textrm{sd2i}^2}{\textrm{n1i}+\textrm{n2i}-2}}}{sdi = sqrt(((n1i-1)*sd1i^2 + (n2i-1)*sd2i^2) / (n1i+n2i-2))} is the pooled standard deviation of the two groups (assuming homoscedasticity of the population variances). For \code{measure="SMDH"}, \mjeqn{\textrm{sdi} = \sqrt{\frac{\textrm{sd1i}^2 + \textrm{sd2i}^2}{2}}}{sdi = sqrt((sd1i^2 + sd2i^2) / 2)} is the square root of the average variance (allowing for heteroscedastic population variances). Finally, for \code{measure="SMD1"} and \code{measure="SMD1H"}, \mjeqn{\textrm{sdi} = \textrm{sd2i}}{sdi = 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 analogous 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., \mjeqn{\log(\textrm{m1i}/\textrm{m2i})}{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="LS2"} to compute the sampling variances as described in Borenstein (2009; equation 12.17), \code{vtype="UB"} to compute unbiased estimates of the sampling variances (equation 9 in Hedges, 1983), 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 (see Nakagawa et al., 2023, for details on the latter two options and why they are interesting). 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 \mjeqn{\log\mathopen{}\left(\left(\textrm{sd1i}/\textrm{m1i}\right) \middle/ \left(\textrm{sd2i}/\textrm{m2i}\right) \right)\mathclose{}}{log((sd1i/m1i)/(sd2i/m2i))}, while \code{"VR"} is simply \mjeqn{\log(\textrm{sd1i}/\textrm{sd2i})}{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). } Let \mjeqn{\textrm{p1i} = \textrm{ai}/\textrm{n1i}}{p1i = ai/n1i} and \mjeqn{\textrm{p2i} = \textrm{ci}/\textrm{n2i}}{p2i = ci/n2i} denote the proportion of individuals with outcome 1 in group 1 and group 2, respectively. Then the log risk ratio is computed with \mjeqn{\log(\textrm{p1i}/\textrm{p2i})}{log(p1i/p2i)}, the log odds ratio with \mjeqn{\log\mathopen{}\left(\left(\frac{\textrm{p1i}}{1-\textrm{p1i}}\right) \middle/ \left(\frac{\textrm{p2i}}{1-\textrm{p2i}}\right) \right)\mathclose{}}{log((p1i/(1-p1i))/(p2i/(1-p2i)))}, the risk difference with \mjeqn{\textrm{p1i}-\textrm{p2i}}{p1i-p2i}, and the arcsine square root transformed risk difference with \mjeqn{\textrm{asin}(\sqrt{\textrm{p1i}})-\textrm{asin}(\sqrt{\textrm{p2i}})}{asin(sqrt(p1i))-asin(sqrt(p2i))}. See Yusuf et al. (1985) for the computation of the log odds ratio when \code{measure="PETO"}. 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 identical to Cohen's h (Cohen, 1988). For all of these measures, a positive value indicates that the proportion of individuals with outcome 1 is larger in group 1 compared to group 2. 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 the \code{\link{conv.wald}} function and \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}. } Let \mjeqn{\textrm{ir1i} = \textrm{x1i}/\textrm{t1i}}{ir1i = x1i/t1i} and \mjeqn{\textrm{ir2i} = \textrm{x2i}/\textrm{t2i}}{ir2i = x2i/t2i} denote the observed incidence rates in each group. Then the log incidence rate ratio is computed with \mjeqn{\log(\textrm{ir1i}/\textrm{ir2i})}{log(ir1i/ir2i)}, the incidence rate difference with \mjeqn{\textrm{ir1i}-\textrm{ir2i}}{ir1i-ir2i}, and the square root transformed incidence rate difference with \mjeqn{\sqrt{\textrm{ir1i}}-\sqrt{\textrm{ir2i}}}{sqrt(ir1i)-sqrt(ir2i)}. 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 (i.e., \mjseqn{t_i = r_i \sqrt{n_i - 2} / \sqrt{1 - r_i^2}}) are available for those studies (for the standard 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) 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. For \code{measure="UCOR"}, one can also choose \code{vtype="UB"} to compute unbiased estimates of the sampling variances (see Hedges, 1989, but using the exact equation instead of the approximation). 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 arguments \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. One can also compute the \sQuote{single-group standardized mean}, where the mean is divided by the standard deviation (when first subtracting some fixed constant from each mean, then this is the \sQuote{single-group standardized mean difference}). 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). For the latter, 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{"SMN"} for the \emph{single-group standardized 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{"SMCRP"} for the \emph{standardized mean change} using raw score standardization with pooled standard deviations (Cousineau, 2020), \item \code{"SMCRPH"} for the \emph{standardized mean change} using raw score standardization with pooled standard deviations and heteroscedastic population variances at the two measurement occasions (Bonett, 2008), \item \code{"ROMC"} for the \emph{log transformed ratio of means} (Lajeunesse, 2011). } The raw mean change is simply \mjeqn{\textrm{m1i}-\textrm{m2i}}{m1i-m2i}, while the standardized mean change is given by \mjeqn{(\textrm{m1i}-\textrm{m2i})/\textrm{sdi}}{(m1i-m2i)/sdi}. For \code{measure="SMCC"}, \mjeqn{\textrm{sdi} = \sqrt{\textrm{sd1i}^2 + \textrm{sd2i}^2 - 2\times\textrm{ri}\times\textrm{sd1i}\times\textrm{sd2i}}}{sdi = sqrt(sd1i^2 + sd2i^2 - 2*ri*sd1i*sd2i)} is the standard deviation of the change scores, for \code{measure="SMCR"} and \code{measure="SMCRH"}, \mjeqn{\textrm{sdi} = \textrm{sd1i}}{sdi = sd1i}, and for \code{measure="SMCRP"} and \code{measure="SMCRPH"}, \mjeqn{\textrm{sdi} = \sqrt{\frac{\textrm{sd1i}^2 + \textrm{sd2i}^2}{2}}}{sdi = sqrt((sd1i^2 + sd2i^2) / 2)} is the square root of the average variance. 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{pi=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-\textrm{ai})^{1/3}}{1-(1-ai)^(1/3)} is used, while for \code{"ABT"}, the transformation \mjeqn{-\log(1-\textrm{ai})}{-log(1-ai)} is used. This ensures that the transformed values are monotonically increasing functions of \mjeqn{\textrm{ai}}{ai}. 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{\frac{1}{2} \log\mathopen{}\left(\frac{1+\sqrt{\textrm{r2i}}}{1-\sqrt{\textrm{r2i}}}\right)\mathclose{}}{1/2 log((1+\sqrt(R_i^2))/(1-\sqrt(R_i^2)))} is used (see Olkin & Finn, 1995, but with the additional \mjeqn{\frac{1}{2}}{1/2} factor), which uses \mjeqn{1/\textrm{ni}}{1/ni} 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 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. Cousineau, D. (2020). Approximating the distribution of Cohen's d_p in within-subject designs. \emph{The Quantitative Methods for Psychology}, \bold{16}(4), 418--421. \verb{https://doi.org/10.20982/tqmp.16.4.p418} 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.Rd0000644000176200001440000000412114601022223017252 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"}, \code{test="knha"}, \code{test="hksj"}, or \code{test="adhoc"}, 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.Rd0000644000176200001440000010475314601022223014465 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}}, 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.Rd0000644000176200001440000000551314601022223014500 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.Rd0000644000176200001440000004305114601022223014233 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.Rd0000644000176200001440000000336014601022223016623 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.Rd0000644000176200001440000002667514601022223014506 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.Rd0000644000176200001440000000264014601022223016124 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.Rd0000644000176200001440000000200214601022223014654 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.Rd0000644000176200001440000000241514601022223015614 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.Rd0000644000176200001440000001211314601022223014032 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"}, \code{test="knha"}, \code{test="hksj"}, or \code{test="adhoc"}, 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.Rd0000644000176200001440000000347114601022223016334 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.Rd0000644000176200001440000000535714601022223015354 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.Rd0000644000176200001440000000264614601022223015645 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.Rd0000644000176200001440000001112714601022223013335 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.Rd0000644000176200001440000001771714601022223014336 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.Rd0000644000176200001440000001200014601022223017063 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.Rd0000644000176200001440000000261014601022223014301 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.Rd0000644000176200001440000000304514601022223015166 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.Rd0000644000176200001440000003474714601022223015404 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 style that is used is quite plain, but should work with a light or dark colored background. One can modify the color style 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 style 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 style: \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. To switch off output styling when the \code{crayon} package is loaded, use \code{setmfopt(style=FALSE}). } \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"}). This can be easily accomplished with \code{setmfopt(theme="custom", fg="gray95", bg="gray10")} (see \code{\link{mfopt}} for getting and setting package options). 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")}, 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.Rd0000644000176200001440000001324314601022223016023 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 the 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.Rd0000644000176200001440000000324414601022223016041 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.Rd0000644000176200001440000003217414601022223016127 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.Rd0000644000176200001440000000131714601022223015353 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.Rd0000644000176200001440000002770014601022223014265 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.Rd0000644000176200001440000000416414601022223014402 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.Rd0000644000176200001440000000673714601022223015206 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.Rd0000644000176200001440000004377314601022223015175 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 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 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 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.Rd0000644000176200001440000000322514601022223014245 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.Rd0000644000176200001440000003712414601022223015776 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 \mid \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.Rd0000644000176200001440000006602514601022223015032 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. Can also be a single value to set the lower bound (while the upper bound is still set automatically).} \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 or numeric vector to indicates which rows should be shaded. 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). For example, \code{annosym=c(" [", ", ", "]", "\u2212", "\u2002")} would use a proper minus sign and an \sQuote{en space} for the annotations.} \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}. Value 1 corresponds to using \code{"\u2212"} (a minus) and \code{"\u2002"} (an \sQuote{en space}) in \code{annoyym} as shown above. Value 2 corresponds to \code{"\u2013"} (an \sQuote{en dash}) and \code{"\u2002"} (an \sQuote{en space}). Value 3 corresponds to \code{"\u2212"} (a minus) and \code{"\u2007"} (a \sQuote{figure space}). 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/Latin Modern and Segoe UI, 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 the efac argument forest(res, header=TRUE) forest(res, header=TRUE, efac=c(0,1)) ### 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.Rd0000644000176200001440000003742014601022223014631 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.Rd0000644000176200001440000000272214601022223015665 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.Rd0000644000176200001440000000303114601022223014407 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.Rd0000644000176200001440000001375714601022223014466 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.Rd0000644000176200001440000000241414601022223015746 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.Rd0000644000176200001440000000737514601022223014610 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.Rd0000644000176200001440000001021714601022223015622 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.Rd0000644000176200001440000001307214601022223014315 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.Rd0000644000176200001440000002257714601022223016162 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. Can also be a single value to set the lower bound (while the upper bound is still set automatically).} \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.Rd0000644000176200001440000001153414601022223014213 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.Rd0000644000176200001440000005204514601022223014037 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.Rd0000644000176200001440000000337114601022223015002 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.Rd0000644000176200001440000000215614601022223015631 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.Rd0000644000176200001440000001301014601022223015146 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 the 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.Rd0000644000176200001440000001353014601022223014070 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"}, \code{test="knha"}, \code{test="hksj"}, or \code{test="adhoc"}, 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

]`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 DaFOS+ ۰\?yӠNg0aa׮·F~dJwS=cYZ@ j 94tq-;3kq\zm:G@&OmH@Or]Q+yÏV'؋ZD *"VJEL_p/< ݼ{xmos/KKy4)~7w// 7dW6ȈiiX;uܕGi>&6 ？zDY~ c(?iD;!yTY$z6-˲ƿqZQ~RKaj:` !>ƔԼ~ 2޴ݪ'Fge endstream endobj 821 0 obj << /Length 1810 /Filter /FlateDecode >> 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 831 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 837 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]o}ׯcp| @mmQZdHJYɎlIJ}$ΒÙ3sH*KHABf -P@$J TЖ8{k 9I %HQWj(RPPkEC# &tj%0!*PuPYj!j!.G敏*(3ͳY:Q)C8uT+jEh8@,%̌' j5 c0JbaTb \lX ,Gk6@/)d5F}a=0<4MQ1!ՠ/G`,HV RbзbPqWd_|1_WixbBk=hInwoK6 `Aš\s&,#07aj9߇pDlP[§ɢw)kF+$"R ufӋc@&tϞEjg翎GWvû=Ǭ]Or b)z5}( 'Q3^/٫oqzNQi:qiѳ7=7DrJdxjYLdIJ}0$h=`Ib]Io6w PpMpTͺ,iU1A l DF{dOPd02GR~{oZl:l>(`_ld4$Y/ jNx鞜3tO.<g~[,Ƿ9l;fٯVTPA[E%G݃ kh H`ÄGo )l3l`8rO\Zq[bp\9QT&niK-M&Vɢ٪lGM Qv5DQ`Tcc2KƉ4AP'?z(7 Z;d$y?[̡yK&80}Ly"dBeԜ T=v]xYڪZn0мay?3ɺVai osS(,0–v$Hfh{厵USuÚ%@^LeE7HKEc&CVBvTH4HfC#n )"x*6v 'b¶/:_ ymr [kp:AuA"ȑbh &kN_o:n0)Uz9ٵXڪnO:VBNI$wƷw]wʒ6eY|h?Ág{fŖ> 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 903 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 911 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 933 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 946 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 855 0 obj << /Type /ObjStm /N 100 /First 877 /Length 2064 /Filter /FlateDecode >> stream xZKo#W>_e6HC {ܵ(k|5ID-iAꪯ5 b@NmƎUW'5;Qxu\*bJ.NjfeReT\ lSvZ2~O2gGmevbI-`%Z @El{ŃSvCCu,bU' nSvTUr\`k<H@a(b*N6O!9%M4dVuR1r [ GE\6Y$֐ bB󛋋o}8j࣑8bMĢ ? >^WuSMˎ'"_Xd=s%+/ؼi8{;[Sñ~_sq5OI=xWyIw2^,f׽_c|ww"&{3]b-z66e T{6i%ĬG@qo^8Ɲ)Ϻ[B 6Py) =Dg{3/i Nv^q},'ۛ_VNetx1{[5Ľ [|0=^&S3?IIC/1͵_D ,#ج&*+XObcD}9L`b$Wد222^ܥW[!Ds=dcP_,oh-"tlj qG FpNlDƇړ_|t\P RdJ(V~t5ٗ` msP4^mpRX}"zehڲMy X XR5uø~o͇6K!w2>g1u[rafm@KQBluwoh_Z]]u?b?8/H> S۴fMEI*fňaIWPtĚrjEK#H}r͇A$G>FV ܬz$/Q 4Q8TXB(NcDz"[ F{A@@6A Uҗ(,~3r;ّTY{׷t- [ڈ $ln#dzqK#^\G,j8~"Dˡ|c&a_[[rS#LUqf*rTLS/nfٞ>g$ֻ>[=FT}"k#N@"#XJmr|_=~EbR~CJCʝp@9DoP2!SC7{}WO|6iX*ҩ{-AG endstream endobj 972 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 991 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 1009 0 obj << /Length 2326 /Filter /FlateDecode >> stream xڭX[o6~ϯ0M,e!7.z2"x?@Wu٩3!k-0av -N0UN~VMA5%D(@xc?"4/p,$C %.4 8 (gWUihKXb-mI"7LIuVdp4~|3t*;8(n \0E3'O$;ݤ9)yjܗ|!XE0̿(%|je?|]`-+:jCGMLqV "{a %8DONdt=R#ؗ< uRhOU|8G?ϔOz@)߻g[]o޼FaQε0j6%YVPT ڛPCOear _2,P껥*WRC__/ݦ9T+|2`?dnW! qh!ഺf86_&@1!(C>?ؓKEgr&:ynK1aQ M=Nģ.;ԛ:yx5;Ի:/ox] t.d~E~0Cu@6NmW5*3pșF-کBwnq,8 /!%$L݊%a Yw,z5` {F|=˩}Uh]v/Է=NE Wjn[sLZQ%ѣL岱 K>P CcgYkU߃u3ᗿlq371|V ٠= BLh#Y7h̘?1T]ݮYȫ(3D-[- 8t;cjQʼnn,U{GV" endstream endobj 1019 0 obj << /Length 1184 /Filter /FlateDecode >> 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 1034 0 obj << /Length 1390 /Filter /FlateDecode >> stream xڽWKs6Wp䃥T;әL`𡒔]|Ik3=o!A-0e3Vܹ'h@\ jj0kEdY"dxlbic`7`)5O"%1H>q>kAP-> ~# =搑 _0ysZB3jÇJmgQݑ([V"DiE4Fb0 W!ߙhN${l^pb ;.Tr%Vn3$¦ q9D`cc Cz*/F|KYmHu^h\ωNMF H3*MfΰT9ӬKi$οf}ldDTeϹBLC)zJͣuQJ;isF, ruAC,_UZ('D;Z .B70^cTW(YI#Ld „ Kn10LvBX5=7DPzqA~p_GL͔o TkSaѣn쨺q! c<97$)5k:'w}G _ӟ endstream endobj 1045 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 1064 0 obj << /Length 1483 /Filter /FlateDecode >> stream xڭXKo8Wִ(Y4.=A{h@KF Hɖ8iSg9\,&qlF0/ųte΂ſ7V |ZD%G ɑewf醰7:MSJwS]ْw"HD8Ǒ۩̫g\)c@fH h 4T9`ÎJC¸磚y_=M@"#<60pb5\iGnDbJ9/1yc܊@<|Xo Fah}vBƕ$(Rc 0FtҫK=UXLؾ`哐CFvPNGCf[)̖ (y!c[y$ۘa0bp nEIÔ1.h8W5xQ]| ?$lA6!u:B7ue݈KTe5]#z Y`hIyA,fQEܧEd׼S zx}د*晬ZbEdhDagVBvxbz^VÁtK̡G6gN b]D`2PM='Ġ!a4G]:&,RWWX0QK^N eN ֵ7Lڱ2l\puǓ[3A^us7Iv !PJ%G4,8C2[S@ۗ@Bȧ_]7"2oKiRhpM)wX@rM!}I7*iP@<_% }f@=&8!ty[)vm`n<ٞ0ur齮_4_m  |O}5O?,'詧w^ qy>pxG/^ܤ)N 1:WvG*3ƫ3dž.)Ԯy.k ?k+ŪT+ꁉ\5|iWz'aV%UrKavÊ?dlk}1F8dU̿t) v84EjdHI]. q癅;М0e=T-).FW_gѡQD#>ˍO/;d6I9`} endstream endobj 966 0 obj << /Type /ObjStm /N 100 /First 935 /Length 1963 /Filter /FlateDecode >> stream xY]oc5}ϯ#j)یM`Mp-|0{ B䯻ۼ` :/[J6/P/J_W`ޘo_u`}E~}Yձ&aZ\.zmr릟׋mLſ4%BƽMUEiu, ?^,e۽~ jse0G+uc2̊-f~<ս883t/ż{r}n.V_v'ş.C]nF7u S}*`AMpU&Y L n>;`lu^2O YxAߋEAWO=YNg39Z=RfQ{A$j[D>\hQ>Yqq'gu^Nr2إ{dr4wBR4Gg+.NhkqUbR&+e]4מob6$25I@ ,^>"h]xiDAޫgܧ%zWu |#V[!SIkP2VҚ;>:ag-Q0Bّ^F',BZ4zJuVeф!eȑT.#6zɁT[DAԞ۰eT+Y_Pz҆8SFxB΍h)W'h'21^e/|8WhiEp3.~EK"dsMezgsc6 |^؊vԈFikQ-49kEhxa#`iǍ49z#X/r> 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 1109 0 obj << /Length 3777 /Filter /FlateDecode >> stream xZmܶ_d|]i^IvyJFڹPN\<̐ru}s8Ze"u]))UMޭ~Zog)uՉ_/^tQ$HRѷ66y&yݘX4֫N7/{߾X!N0BPQ0LvnL$ojc2 ^5X6뢥SvT**zeIMjm޺V\m(^*B DVe l-MWʮ;jyEO UWŒ6lR- YZ%XdȊ(5+#bK'$Y[<&vaV9qnq8[xzJ1#zKj;J"Tn5u ۡl]eTZjĺlk*5;5jk]ausՙY;=Y(PYvI cc(aj{$z: f>`&d{ŎBhpAj52nkV)&_R>ۺzN*T/po*}h;^g~={8UU%YJӗY *IsO9G||y6V(So.8([ckc'"]5 %'ixl&d4'Y dM,]HmEƏҬ'mJ4i4,;O>fgdыw>i6hۺnZ8{__rY &E@_S)\t]Yzco:E}YFFWw {>hۺi\{]QQշoQE/9Sm> *.$I>"-Qfa_l(T8ډCݸ_U[ CQ @+<i fw#i&+ u\W5W ("ub'Gr{f3zM }‰~ rnD{wr+^t^JG^\/k$RYe}^S^*v|seƙ{4eJh%sd ^} 4`v% ؃yd'Xלx]@Sw.9Ws#sz^c&lR0f2rw>WAȔFuEIP_H19/x:Kqg\cC-h`ojy灻}ޅjA: (ajh}_8mP5Q+=W+hbUBWW7 ͞^|ػx;&B!;s+{]B2oTsbDVt1AJ4 Ik;nl,_tr[mD_0dDX ޠai4ܑGN'sO#q7ߞLlcXks2?Ux}ZRihһ·t ݯݶ?>\xrV kO c/Zz̛4e֥6'I T> 2΀E7gq:JkPw-=/e# xe9Q`iD@ `#`-z$MHrؙ&hlF BpuP<nj@_JqhLϒOl2msSr'o$hİ]p3JDjg=p%JhUz22+P +;hi*KNբ94x,,dc:ѹUFRdcBZNI Ny|PtPDo΢lD'4pT3=b{\`OIDM%fc>Q1Ng௰AY{,f5Hi>^#{{i|{ieMMϑ_0v 0tB.g.:.:<ɕ\t|`⢙;zkeLq3&#M2J4e }nsQ($1Btv1RGh?{h=ԁ%< Us BuȀ,se?Cg( & *Ԏ pz (,Se~S%y*,Z;Goa94/%'. kIPv)dᡀ+ oj8T z2A #{%fK\m6 oM&;f[,WȀ F 6)|`ؚ}M[gAj8Jl؄ =Dnmʓq}&(1jc3"0F|ci j/V1^sncDh}KEJܸNEh܅)[eỌH3dr>&P(YXO) POp_ȷSoq%WzO|d'4`W^Wh0 wvZ]}BrRm4M p:Pm)C42;R ~d[Rds-3@Yl5~FQI)LzbUy =U+p|oBI> keY 8&~/v)((@u2TjB7*ߡV(hcLVk^ؤ'- woW꼼 !,z,Bx(Ҍ=]=:?R`i1aF%1R8mNdZw&d&pȋ*PS2AW6rv^,)n#Xav ^P> ]=4&N^MX:<#ձ)b0A ǺXp5 y3(ix7=!4NFCjC"õD3#)}VR}pl\l$P]C~O{^JrT 2_#,REqM5;d/E}DC5 E~Caae>t D/_}xAO4] Eլ*2uWhCj 1{\gV/cχzjMb$5I`).dz/%3DhFJ,BtA丠г1V2^70z3Dl> 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 1137 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 1145 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 1072 0 obj << /Type /ObjStm /N 100 /First 970 /Length 2076 /Filter /FlateDecode >> stream xZQo7~ׯcP.(];pRFT[NZZCR~Cyeْ.bqWCr87TdNabJgK:go )2paWJXM Ui3x% Ȕu7WUV#xuyDUj:\TUɕoJ#M~K8tUXWn&\tMHT8YM8P߱!/NGj1W߉!f=9Ťqɐ[R z,waY Wg0F\gp .[y؞cQNU\te83:Uț" y({0Js1^(zpU6%pPEs%Õ".a X]$HS=1GV𜤊XKrU68)U9\u|!$z`;qrd(f00 3Rπ0ΩM`? Fl{@9P}itx?SW 2#I; FY 4 FTitv6j7@!MqdI-O gooߍyi=ET&fOiDeD#liLp?5H8@/pN,_9Xq^,ͅi~iNXVos7Q̖ 7Gd~_NTsru3\8d瘭i_f-VX%RɶU`Լ˲>fۨ_Muq{C݅%N\$%I]lE@U}X뙽lg7jM ~)%fۉk%HӋS9*iL#@:ҁuH{Bqto~c)rBW~Pܙ(G:Q,yڛ 7K{~5^|-6i*Q6ʕX=-ŰW|<[\'0dɈ,C%WlWtl?nd9$Kw6\TU{ َcxS(nuȐA>V XWI)"~/0(q*N=!t6g3B:z߇ $:X`\x>3fion'M=ܤ).M(m^}i{5N b#N[`'pAttM0/{?T=Ң][uhw#p'V!*60=rWkge+:Vt7Ez+ڀN]O6r@EPrɮl ڡVU&U{u$:uD/KV A}d+v Vl 1Ա`afI|{)20%֩# dH}PJxvR &o5N 3tCu]eɟףcK7ח1LW|ȊPOiHeXƓ,>:h+<.ziJw>!I񠩡]B^WuPԘÉuz;}]?iw\^: ]|sMǿM lݦÍ:$/"׊zJG{aOi0|O w<>/J<ґBHtP1Aءx-i_JeсORc~ Vz0HaSF-޽z/C͂4dVn>|/@G~_R-}ar鶽&*[Q!F֥4g(JS|)5I32뻴/F"WIoxH伃?æM!9CSV)ҶGJ>wQ,* endstream endobj 1191 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 1201 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 1210 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 1221 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 1233 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 1241 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 1245 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 1249 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 1254 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 1274 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 1286 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 xY[sۺ~ϯvNL`'NIә=M E*(q~}wEڴOX,Ňo;[Ϯn-^Y'nWg1_,erv<ijܾY @SF*gyYx'L⁧n1;)R1ci."J.{]|6W{7-m6E5Pcݎz.\F{4ntuVB{'2Jz6` `BB}H9. 6-iyV6ߦmnK$6eZ7yCjEev\7_]UyvÖyZ6ݨ%S(XQYZwTK;W>^i>dƍcFyuz&#/Í͍F ws[h$TX qt9AFcRvmwbY~UGтs)'1J!tC_re:BVv4yᆗk+ũ~<>YJ^bXܢL١.O@R ;D^Qܓ" iFU5vW :PcR[0hUW[RǏ)apLwmZ$qt} S#:L?Ga"^S"D Pg8c84 LJlu\IBU2Fh@d젼 ئ}߿f\$XE0.۪ lk:,mF:-IآkU&$ܡ4 R󲪷`^%W~>ՆLʯ-PZ^&ǀ[S%SY iCA!5BߌǞAl[4y{8EӤ߄0Y$-)YtYVUx{$DWy?#rMbj{2ԭl( I4_fxM38Bo)"QAWJJi6TIweVPK Qw$h֪ 4/Gd.C6Ŧ!}LE@Wr Eg0vƀo* A ̘VV%W!0!]"+@"4P53;MVa;H[$ "bc"uO:0]Q IJoZlQIXY jV]]"',_yI._m^}"8 )b@LʏXp q >KDᤁT5f_b% Mf"IdgoQ1:dr'r9!m)vD4qr8σ]/]vlya ڥp9a*s 0`x*4*HUAh," +NJ=CS0upU@1\y`i xjn`!*\W$,gj̀E 1Գ+yxa<κJ I&XLyQM_pCLn 6 Q9=18v',\Vq_ 2kM$zB&0f !I$d8>6uin̓XÄ'10!K䓗WdrǓ;a)zIj~#BD8= Of^jE Wq[PFM |8p% [`t4eTC ?~|VcqDM|&-4ӤLz¤)prۊ@1$tS5ԫY(`TMW wic=t 0Z+6Ď^bՇX:`I\~D Kع:WdO@wбAW&t{3X}x07 tz.HEm^Rw~= ~\. fpyǫt3&{kx!wD蜏cgr*]f`Y>b_?סRH^܎ɐ{ePZ^2`=dӴC(';K*y g?淍Ҝܙs9|ߢ'h_Ob1ӻk,}a Vp&wk,ӘsC@=T/n^69݁Aw3?W pC_z>h(2=ylG~"1+po#4S6ںv6zy!($UGp?K=ޒp3K__:3Dʱ3y/TM[|pPSjjWN(@bg52_AQVRQ9h𒚔Bē_7mac>?|3.Q]B>:eI jm%pl0wߑUz~uَݷ?u臲0o}kO mQ&pӋS.}/U$gQ endstream endobj 1300 0 obj << /Length 1092 /Filter /FlateDecode >> stream xXKo6W[˲և-Q6=bqWXlP3~"Ga[?>1l2]7mnhcyT Ϛ_fn~,gl`fo<şųlsM"wm~p]#YdWn3W-5 rl3by""f' deESEʂ'JI^iݶe2ᇕˌ}6֋XEM3.OE@:ݷѰb5 0HDdeV &"'5 7*__ JH:De*'m8 Y휾SYe|8̘Apو.B]#Z'rq2϶ǃ_Cea0D;l ?C FK{(2QٚVO[؞fk?l k-u*AemB,>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 xZmo7_͇㒜|rW '.0 U$ؒOJr$K쮔"<3C3ާb| r6! ST g IAs&;$SB>.o b}ƓgTtJajK. sȐI3<8R7NTN*@WNRX9V@IEEOPA]^U EdrWU J[ y5("W;& !IvcymS*&\EP"*a+}*=K%3nј] 2뺜 {D$ݚ`@oKDmuZctP&PIlWO*Uy#أW k1 :Nv 1|Tcp6YPP)8 G31VðqX|Yʃ&Ns\~w!$·t,$I8EW ʧK\al OHJHɾtD g_!6ɤaG4scɢc fQ%ޱȢQ\wi~oϚ煉E;Y5L1%h4<ۍ+YE}zy1]l||l0o] -lPOdG=7ymLLM|snbxt3~f >1 0q]/^ 6[|y]y>^\O'7_f<M/w17wGXo|q};=<$KD 1XBV˃޹-1[xT7f.2vؑC +xW+WNy@`KVC @<5r mY?0>i8H\hOu " ^2͛S|j(GGI(/>>D2jB`+޶ѻs>;8`y6*r5{dg=W]QK!żXFanܜߍMґ)ܶ"l+j+bg+6Co#BGw;XHRPe6%E6! wfѤF 6^؅Ak;/ڮ0k"VjB%X9}"aQvd}/WBT!NH&$Ի2ۉ}x}j>5/ۛ``ɰMe8y'J{?]TYo)E{Jd ;,)([mP[ګ9-{:(ŻɤaO r>nJґ [Ng6Vt*92ڃ#01,ZmOQʉC)*IWIcL[17R =z&M=pGj?_ lٳtfsXd8( ZժZMgcr#XC~dy'=?e@9Y=mPO3|X FSŮ1%`=puGa\w1uܚG`^wռhu@R=9m;OץT/z@e)}UI]''c,z=v_ǧehܢ(l(7/pQ;v[hOc.=$PX=zΊ?\ۋ;?, iul}0He~rݑ7Ѿ`c fy8𮊨zy׈^/[qp,ȷɳsP Hnak K#n2?v34$P#;˞JQiVS=$__qE~bSeLvɖDQ]r{.Jg-=.v0䔿GdMD)>hN1O}]׷0%r.1]L endstream endobj 1315 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 1323 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 1330 0 obj << /Length 2466 /Filter /FlateDecode >> stream xYob^)k+R%Ƀ,imv3{v",jDfȕ_o߽TQmn%aN7m6Pnvي睒۬.vGR8vT;s?j=q$LnA BM:l퍔ۿ LY>C}qMVu: !9j `}! A%n|8A?&{Rӻaxq(.\8Q8Z2_0om*>>jSW\}>f͸q,jTusezG2h ũ>"UefXlVn'Oj ͗jPTxwgc++HCE}"ls/-g z碄ׁpB wkj-n]aA%ac'I+}(;vx(q859lwԗu}R܊V&qxJhOY:tYn f nW? +bS!Γo!:'&S; UGQEwY=2vnXW=uyBg]59:5> Qiy( Uh)/{o*+CiZ߾%]{jdYS%'uS](kr75,fEEQC豊CyOquR&ҷzvD<q́O:L˲ro2'g8` Dal)TV,.1%&Ihq`$Գ֥XO߾K]ۗ(qxyBAsM[1Pӹu+Llv3L7eUM_(D-ہ>Sn}b"=us?jU endstream endobj 1337 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 1346 0 obj << /Length 1416 /Filter /FlateDecode >> stream xWs6 _ŹXQg6?d]n[oknEã$,%r}A@rZ?~ }+!IڢKZ$duZU[__@w)bФEf1+Y ;^> stream xYK60hq$R" r`g Mcs.LȒWbQxڝ&dUTگw7>ܼy'n\0dRO~xNFg3E"Y"s8&p78[ ؅>W@|󶙬I$KoWڼ*u^^fHP^[@s2Y{vă!j7jG-L:=ЏD*@@jQ&۠pJIgwtA&%qԟ$|< ,QʒPS)PM@KV5bK~wZx!H51871^Yyz<|  ńTSTaւF]|z{[4n7?@ w&Y,g\P#5&I?2",CҒS]7~9E3F(gN;OǯP7uKYhhO%u PNf <D'v Ml/+ԘcWenGIηK#2]%pݴ:/iXM@ЄāZ2P(Due~3Dp벛;"a1K`vVLǮi5H϶Sނi4ZU T sܪźɈGkwW#VGa!h,c&-,15"sYԘx[6TPms8ZfY垺6G55I(a< ݧW,gnuN!ry cHD'u7{XN McPY F?|ztvH\Bؔvmdҹ}dSj ̰hgYYh d}QOiZ<f_St}0G( vhY.h*aj #^"oZӶֹF1bL5}ރdQG4uq'[UBRR(}((1BgT2RZ*ӴPhZٓX<⅃\bo,J t-e C @l;k'kHp=w@-:^qGv= YΊ5E5>ysFikQ W@vWڝN?\%rsirs#@i4%dk{_a|ÃD_zUe-ݢP?2y<}J; G\_ijy>$ni㫳$` zSUnRT1O{o#T/TzbN5$#C\*rj_xnCtH(а s{D1j0wKVY)36oBs}I z8{ҺǼtffq-on g endstream endobj 1372 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 1384 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 1423 0 obj << /Length 2873 /Filter /FlateDecode >> stream xڭYKϯ0z1l3CvN6mkږ=ӗԋQz6A->d*Zv3=on?D,SYijhlcTlf<ы>|!6 1!C2x<oLs'K?d$hy_֍F F4KgK+ NmQ۽m]ʵ]]lA1 ."ۮ\EU[hu0j uj礧$дܸjnm]6u!5`%X6bDQ~Z>8/W2Z 8Z*ZJ E"!s !#2Cy^xA)Nڨ҆vSɝMuu޸T?Z( FJ9[%*NQG!0seG@@x?Ey?TW@ϻEE\uLS;% ۍxg SF=R萁0:>]3@{zyi0Xa0e3R:"L9懃#Q9c%]C{>N.2U6G?lRPZ:W)ʸee Bޮ9!Gjk9H]+@AE{G/ґmvbpJ8p*ۛF'Jg)>.8el{UCѡh#O!l(a\\ H竪a f5_Z]t,#g ŵy4b%;BB 7"a"Eӆkg:K}۝ HϲY5* C`]k%`ll; o / AwuEFXݩM,_ggB 61#QU/DO@lȀ#`f0t:թ.V[%D)es5Z⁉k#]-ei~xXMePK?/KdO"TeEAӚ;hl'7r: &B-ʣ_4Ra6$J})z@&njל/3IT1i4WCƊۺ`~bŝ`;$s# nxM l.cHڐY 6HU̓m+zR\HĊu8B͉(lw{Z4٨W l،YhX܎eX6&Zr8=BN\mcF~<gJ4Jp :F2NdlBPW)Q(.& O5} =ϓnd)HgVx07D=u n提}f-206}sxY ^hQx6 櫂H68ozQ^7jHla0tdi:z*/{pvNοK ̗eWjyZkWp 0[r,˃>4hqX¤#n3%NX8UMS,,~n)4FWЏAzaS=X38&bǼ*s[. YFG/y/H l]qw̿Fŗ ۺSP3è4 ,iXcrIPe: @,mZLURE%*:7,񵌖;'t`ǎ ܌dPVGNtbWEjrG^$u^>~˃xN>?ÜIdr4pwO,v5|ك*q$ҋUU~M\ JBa~PU2Lg/ԍxyiqq 7ӺToLRxd-"pi+2dK옒'hCW0`3=YM(aTtq50TvQe>@D&6 SƷ(}>iL%3p0 R08I8uaB(C'<Ϫ:+A9!.ĚMzR%$ա«@U­Fc p d'?G:|& D/OD YGld^]2 l𳗆6<$6`WJɕfƻR])wݱB;3 tԛq]筢bYDzĹrʓu0DBƕ\+H@^Z4ax%E%*}6z߮MgqC??xtm\^ zH%BѓJ'Q'u/24ǝ ăj19AEZwvP|={-D%"wjd"kT6R`72C횱 cD<'_E?*Wnzk$P*\Z$KɟΟʓW_] endstream endobj 1311 0 obj << /Type /ObjStm /N 100 /First 976 /Length 2181 /Filter /FlateDecode >> stream xZo~_ǻr9,r9z@ hkAu{rs7֑-Y)Ě3"b(.8:QRpZ q,Ds;AjPt9EfWC{m4es[ _?qbKG<Ř#)Dmay=@ljTPjO%8^K.*XaLv,tXoǹV/rŨZl آRA,=d@e{/l#TlqtNQ1Bb{p0fn^"e'ℴe'fPTS jk$V29I;VO1KImD{OfN̒TDN.qCDVPM9c&U.I+44 TmB. 6TSЄ+5=JifR*FS32(B ԖTK!N xZMQ>sSE-q{m?7\ M@n. P^ \c;XmQyKz@A 2ˊ9iC\a2eH]IpOc3]e motv~~}.^ nu?G1fOp~w}oP|r_,+w~Uxh +'lth.0_rqjr{=ez&?MϺXv:_Ziu/vڽN^M].n(L+B%FcY3>bMx~<^kծr5v|;]U› j&t /m;>K߳W~z`^k(r j񽨷x3\5{9PH>ֆpUk<@z-<Lv _@SO# ~&9btL"1aLLb^Ȅ9|K nlhwwz܇Q8! 2cdw-}Vi-[*`.e&N=:8gmj1^u{߫~6]M-Y.EbcBA lzF=Jc]#d;M( 6q':9WøubB|t=}dq>꒎0쩐mA5xދ܁|oI||@ލh>14+.CsMhN''rOQ2m*W_IAF[xoߍW1mҭu&|/g!$6LMnʖX3o'̦A.V /Ŷ|j{8iB˻&Z d@7׋p!m<øԓ1]d@@N>h:N1XSՠOۙA.壜#d!r/k}Mcpk8גrs69grON{=enb#6){b* {D=*ZVa%79E'm/CI`AvTWعOu*"-TU, kk~],?<"#CWoGC쏛C} n6,},o z endstream endobj 1434 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 1438 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 1442 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 1450 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 1456 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 1464 0 obj << /Length 3776 /Filter /FlateDecode >> stream xڵZKs6WrT3@@dv+f|jiH r~v|L6A=UȣOVqa{ϪWj~9uU'- @Pn:N+ =7:>DD9giQcSl˻Ia'z8Ve{_-.LBt[2H-#|*0 ka!X0kRj2L%OŏbD4u6wPR^@/wJoQ75*Hl7-jUW4·%tdyՔ+ T,@sn- +?-sdy6b1dpj戰F,rDAcy%Ĉ%*Xb3D3,"a·q&zҺ4䥼'Gi0xM]eBF=Acĩ2,B*.`?kh$c4B$ Bz/@DvnohWDl(w gNܺp6@ ˙*۶Cm{Hdy*RH4R$9)3]L'sIe>ޞΙZ7j/kΒs+Wa8;Ԡt?\wHm"2&T lPǪObky0Q3r rpT1Z}D8|;2 >㥊 DH^!܈J &W 7x h1q> m>OHYx#@5 DAV6 ,OM>7EloloS-.<Fƕ3Z0EC3ĠYb"bƅ 4TI䄢H %W-LWki\"K,.%bv]1[D^֬.@[% l*\WZ7z%(+W8oz1)NԺX ltn4"USkZWdvU 5"*'8Ql?Ja^D~"bKxX,H®پ q.K]Z%;YaŦ+O˦iD#Gb\r[4H@תǣV<.+*75.s(.z)#1CYHa1%AѭȲ/LrsŇs"ҧB+ T fXO$~+CЏgJ2` u D§m‡}ZV/-F| N$2AgϟAϏs?@"?CCɹ?Nu#7;x$"p([֓x&^FScs;ޖs-e{:!fAȂEw +}%N%;Ĥ&"PO6G'5k>`0f92)7Xpj0L6 Cb&_AC.W٥Ƞ-ߚX(] 1R;hհuO FCbxҢ7#kDcA޺H]H".y^"o 5lpWg@oi7d%g¹iwDa [-cL\7YP71Et[~b`ޯqqL<.|NX&~Nx/E6J+Mє/@i!B^PHe@Ya/.Alwo Sf C\.]?EcId4Ďjt6w "Yb5"mӗ%~/8;Uʳ]Qˊ5CH\F#K>5Cn;'+9 %WrЩj-,/^^AtZ-{SV$\*觉DDfcAxp:MGz0PY1݊xj,@Ip\%]"V#]t[ 54,(in(@yVlyP p\Pud9qoޔ8oO3=&INڡ[pHR:=~[psG/*g× rE1{$tߢn~,V1D/0$;H!2 +韎!BtfWW^ylUVFn>D ؜Nhfj.G]:n|6]! sz+8Nƾ\H⫗B9r59K"z$v-d.]^0- Pr*C,/ P10Dld}▻"5bҌ Jh/~x8 lHik{j=*cSj2۟&l`m[ҐbI)ƀ #_5$O! ! 0<׌5,!KFs6U-y֎I9G_uo)oIW.W=H|ub\{xJX")m>pS |֞}h}.$t=.".G#Xu+]ޮGwsJ endstream endobj 1472 0 obj << /Length 3523 /Filter /FlateDecode >> stream xڭZY~_!%`d#ƀ=ٗ8@(%Hv<*jL,fguWuuWFl{w&& D%F ()Dgbv?OﾍHФ@ 3L|IjmMAzE2|2 Ŧe-P =,sywm_/lNPik,d47ldmYZ &"}/-0Ka(p& {x"ȯUӪ`4v׼B(8bAdqL4}aGYB6/|<Q&?ym{Q:#ҧ8e+M T!Wo=KF)P%9lC2:<-wf|nZ[w-dMȵ"=T4΃FP{kVׯ|Pe>̻߱ x́y:`qqxxJxXwռ.<20P1+| (&(ꋭwؼVm8c0}t ! PɫR=SEi|6Yzrp'RdM &\`S*FTp=zQ w `q  Ÿ?}f* E<$M{QXf+]6=<_bb׶/;X.rK$/ E}ndnl;r55zv MD?r32aig{hWԱ4* 7Y~g#sc˱Ɓzd8g;Spq^;#mDȵvPƜI~8Xsj O%ұL@P(RNlq((DϺ 6T0PaӺIuUgghO2 c5I(t=-VXBhʨnĠ "y5v<2;TjsNGt6?b-\E"Y.s6AmmN*1?ڂ5XV+d3*^XSdRI^Mo% (Er(;MV^&Dz$q'3B `F &RǷ;$=EwN62\(%v4d5V8E(");KWC+M>fr/^KM2ĭuWy|"K=~`sQcҝ.63 TNB(-%.Hs &a ؓe)+. dP=Ka?h+.[sDaZPPօX@‡-JC3q&w]rp,/=bo=*کssޏRJ 1*L Qa([u* .9ݮT39w>ټzN8I+t㻠fkuvĺ3 Fv)!D,#vD7;MI؇:omcFrf\ zHaӡmԖx<`|nэ0TcJct. n%qu[?S<ԋgHR܏04V#~DZF=CQ m3vsjܘkCb٨oq ꕆD aw bY-OzqR1;40$I'cfˇO8.\?dؿhȽyL,b3w!*6- 0TS mvaU jisVx[:o=r6/W|޻}l}N(RD^/d@ܧ!uI} x:ؕEĭx$;(ÆnzudLqLtO:LoczcO%:_4gX_8)r[ 6̤xg.hͳf]>.q]=X=om޻ Ia*]n}TVD$!Mݹ{盙Pn;=OGEZ}x 0xzK]]u)]#X .<*#GnGzSIJt+4PÌ$w"Dv$h=Dp<ώJ&L=ܯݺs+zr 'N*ߪӨjxʂB1S֪pSEt*'鳰81F颺2.W-[]umophL%fho *l endstream endobj 1494 0 obj << /Length 4201 /Filter /FlateDecode >> stream xڵ[[o~P;/)ad{AE(M6[tDj7w"Qu Ùs~%V;0U[I!BūD0\}$Ǜ~G:MHcT]o Zw%[_kcB!յJ0wuo6O*ʂgΏyȻh~nܒ~_U羿ߵGJSS RO#)4 b#)**-o]Ս۠ifmQlrvNhYUx.wH$?vIB\ t%Cd=Zg 'n+;buVCX7ل4?HYhQSUft*;:%F 㫬O{P>تSʼnT cG~ūMLS;qK,㭔 fpwk`OcZPYJ{ J2ϻ4eCB_V2 eέ)>ql.A#bf%TE#5Q4eX! hvYkd5 ?napb 2'ih4 P$\NiR$k)e"\N@޿l&v$gAdPMKv?paH;9> OFJ:"AͯAo)."iu4&2qHF_0#B,)7UDơNէpw/`nqQ}dg:M왽c0gIYx08UuF4!Yȡ>EnoK*D K+?E=P5}{OdN۪o?_-@d @d681~fmm/8ե..T˴l_1-yfPa$WK.W[@U m#ox?pe}ѐѐRWz= -~Yts؍,. 651H_0ͰECc X-{2a"اQNťe!I҇Q>a}ua|#85\ǰzrFȫo~"ʈ\Ć)$? *W(V%^"5 5vvE6}Y}ww_&4x^.=Y1VyRɱuZh z(C-#"`^~C=0?bւ \HTEGEf0OಆT#4cY`"lu<.\*AΔhќ38nbq(2hfȓɈQ?&ÈGp":/fJMln^ T:7>Sǃ?AplQ|bX2/B)׌R']~kDȿ-]]cf&ZfiGQYp=&- Aݮ#RO[NشMuv/ԽTo7Y-q5m[T]2M4ek4vW.so`qu_EC D( AdlP*F nGCF b'%dzc _~|w?)/u~S/Us3%|Es-3WTٵ9<}f` XIl eRn%C>XjG[m}O n+~ o]5 Qв#g |0[,_ҩ`-zL32K@sܖc`^lug؉ScԉKLNAUw3 ?Lufq"yAsl\+o|6'Qdt#q<;0T&|kꗍmйGe\,[aeY>CՁnuRaXˑ đxQhuAFn _~Pg7M&m<PqC5< l1:%XɩXB Y8#Dpnp-=Nu4s/,r Iq-i0퐯Ğјq2cbC)o8ךTo-DG9np!b|MI:AQ_z@.s̓|]Ulr1iF雷Tr73ЏVeJ(Ӟ͛^7jceQpNoʓ[Nf&d-s# $qyJ,dTT#D oUɫQC|I4 JhNa_<8Kϯ yjk!>b@74zo+kBacI=+$O}ݸT/%@ 9܍Upc;??KNG3O@g!ܼק|(= xUĒGP'g|˃G){B e1*"L,;Zw1i҅Cھ$Wf\CS$$S#/Ʋǎ+ M"' WP ݯQ'a<g: 8; ޚ*2J܉ D^ۋ'_quDM}z:vJy:an*;e%Nc^߶mbΝI7Eά*3:|a5JΝ!e΂)q7w:Ц6.>NgZ]C:NG#BuxoCab!qPM|,.%T8&.dAӺJDNI;ze^Wu]Ԓqtn_U{w?j!39.qP(; MAEA.@iV-l5~?wu5sG sǔ!q .B)1UKen=bGͻږ19t*Op+܎Lq+Q< 9Lg‚|Ԯ^?wmo vCua!J]:م4lyi TP ϫ1PX&e AL3>jܟЌ;&l {g`=QrvCTujej|\wl;* endstream endobj 1511 0 obj << /Length 3617 /Filter /FlateDecode >> stream xڭَ6}F TyHv&YfQnmlɑt~ uw6ţX7\7/>2WSnVJJat)%Rnv}eb'cDfMrB:_ivc\,_mta(_7:7eѝڵ kZny_=7ޜ4\m[j|"&59ջ6RA[`Py)XhňU1ї_OAJ9kPLq?*N6Gsu4qȩ]D 2˽4eZ]TjFDke9dd!Od8@s8!+9!T:Oc)z_$&}3#3ǣ;V#eT=L_fE2N(L4'+vԟl!P\hWv:Z"N۷p`CLsN-n2 }\2ʾZ~U5r%ى2Fd _ńVt X ,D[1ͩ韣]hk_h:f$Ou 983a?% lA>ciFy Ga4=eV`Bv'tnWJ爙6]k8u RB+>Ԙkʄ"㻡 3HᡕFm}g͔lsO }n@26w[nmn%d%F ir0œ :`̞E2te^(J'+<Á5{/~cHPBuY#ͫz$CYJq BϮkEwM>ցt?@(X95#E>ix@3J~>vZXx`ϕ2N p.4_T/V_MXdv`P84{w{cζm~:mna6Z&E~3\yGBmH@|\>?΅NU& tFEO _YEڎ١ÐW<OT Zh9s՝ <p!0{Xy&ߝ5XV8B0 hJ /׿&pHXD%a@ #iNBjaב5l9pA-ņ6`3< 7 ]sn ]cj5X"o4%Ԙ_pq%nYkBS|VAw1\ی@9ikb&Wl]qrWX;5:c3313t.IЅec )NrR >SNw!pv{,/9u5_5gjCba҅:]9'+ &W^ Z K- uɛ*nS@; PUt3:Xo7wms<2p6ps,"Y3R0HjP2eVw$#/`OԹ ]W7o+\9;`-%cߏ}n'Ke FY@ZϷ,_ hKK3-؎Z/ߝ*CC/lQcUOU{ͷgukr[<m<_gTJcX梅fU, r:F"rhBRV`t7>Y'I4ew߼łv",m~ ~Yʶ-bS )>3YHz;ao3` V<;<6GIr/һ8~=u_K3 Md4R$˅A8#@l<#6ZCμyL+z endstream endobj 1520 0 obj << /Length 3233 /Filter /FlateDecode >> stream xZ[~_!!3^SqAR'ζ灒fw SLRl~}e(DZ- X33gX˛Ϟ%Tۅ"qȤR],nvXtgy"u۲"ߕ,I /*yw]{<jP ԙ`2]ovW*Y]UnjÔ"۲7<_mM XdZi|q|m?<]~8*G,;3'ӮA_E60lm1;|˗UPٔc_˶1j<sq8%M;Rnu='=d47 v, ؘEھ|$ek2te߶ݞP6UnmxlWݢ9oMg-UV;&; rZˈ7]de{2wOxpS\"/ q|z_5%’}oM]pvynvwW)kf{o~]k%3:7u:9eҩ^ʡħتi%1 QU&c3dPKmog۶)EhGK-H I_٭d;M3&@2ʁ!!Jn|Eiq$b쯕JNS *Nɝ|^'ԱY }^GYa0 D+-]0$. ,32LFMحj_)<CU VZK +fo/4Um/s$(I3l}ID UxNFHsa KS3<DNs(Ct'>L]?wNZ$ύbs1bRgxXa)Wҕ.lG~ iv(n ʽٶ͎Ip'=,xuw$ ?5`\q(MTor_pJw)BM.lQQkrP{n1'C^wmB3ltKS"Z #ɥ$]'Q'^*fsK*VGl\:D')놎2;Sv= #BqzbZ!~́@wCɶ t!2=w՘𕭣E# ՐˎeC$sMJA͙LNB Og:o; ۼ3]LߩJY+5xIpf9kkͭ^Ϧ*5Yt;0,QA{jFtcAs+iw[Wwc<X>"D;d5p8{Qmti؃Sv`+zd.灩pL | HŠ9El.B{8>x *:7GQ$Tc=}j@";2_&5Sa8 8h37I{X}Lsu$'g "Ӎ`<8N8;8\9n .kʗ3 ϻ5!3 Kkh,/AEs>xxK=~?Ms&$*wj=6GX_ݿ·޹ VlbUL}.Q&c@"2IAj}E6CipVҐ\{l4r"*krq`®g"]/!7\OͲExF(1sUKRx|1FL=+7e^X핤n\y YRHôǟbP!b/T W_rrk)?5uq1ѾĹBf^cfr>WJJJ%(o(IE$_q)_GrY&fI 8XZ 򍱆EFJ9kB٘$zT$_*siBkH Gid N=}~1Rv8+݌''<3ϢBUn`jxj vG#Q!z%6``N] PОfn# endstream endobj 1527 0 obj << /Length 3315 /Filter /FlateDecode >> stream xڵZY ~_CBU,/^N!gm'qvNmye)Ԯ'>@K̬]ZB}h4=bs܈^߽Ml6Y*o6&2u+6lwȫ?wMNF!$VnX*q+7;gNN%0EӨw[yuvM+s"v+xyuOki=Y+B%~\'skbp X$Ҡ?ٚ6}5upqhv.8ilj`w(fjeQD(:-ܲ?5Ѵ  )ȣŬ~ Gחf^v?m_.x\F↷JE1ߝD2pK B z$X(P8λqJ" ]o'S 5؁$4kPޣ ,3T Ϙ4gϷUK2 l5Y3XnWK3URDP4^鐷-ore"+9 ^6t 7Hw*l7؄v3NLiZA^z [^=4ԋt;Y6-m P$n7`@p-L3/,ѥs& z/ +V0jr8ݥ}|(MElE?3-n-Uq8VEGr,re(ppa@2#"6a8[O*xZY0Tz>3'alpLB5ÁXfai8oﭭq(gX\[8Ra"[ 9')l0DW$ ;,UMn{hΗ1G]q[-: C:Wǯ8x(.Y1{gjY8R0^RԒ^7ޖ.q1-~qF rX:U1rlu D'9|v}8`q8pғ /~0%{_nxo' ar`̏<鄉? cѦ7mJ'|˒TjOD҉cŽ! n"Ph}Æ"g6 cܠRJ,LJGt>/6#W;ˣv2K3&An7,/U l^祖+>31,F}! %|&T,~ HzN%Oc"Y$`m;ByR֜m?-&]D~ū(bvp(23Kf0"lU*/TU|ry\=8so{תwyWNG8rS ѭ {uW'# B n <8'}

miu6 h82NSwR~R.XBׂ_;WI`0:؀sOM<4VJ¾ݧ+>kWt ]31 e|?N):#iPaLr?!L&5co3Fi KH@\0pXÀZS9sdhj ֮$G"8 f7ϡyKdPqC c\Wg)XIh! k@g *JH9D"熜>pfm]g% 52N1{O FF Z$OB4Nx>IT88:P8԰\˃da19_=8o=m_.9j]w|/JX/a~Ra_Wě"p:axY?f'W_+ &/*F]˵O50R D8+ƚ taWQ1$ zg < AogqxIj |Q1tٌe}`Mog y߷m 諣\wUD3޻JSe,3jGU -q [ҍzšq֋EՌuSIhyv \DgɃ#RydPf;zTqXƘ)ZP</*")3tu]s(gQ*}~S_B/ܟtI#Pcr$xSٲwymUW̐|wFtGD%bK^h2Ӝ'Ap%0y%b1 o$w@{|KOQoRKQLJ@A!e5ĉ ޺Ro(Yh(K(~ت̤kEQifpaiq*^_'Wi8˞2NbI&I^rLEt~2ou(s6*25Zt἞ ' B:{i߿#PߨrCu3@c>\7n6Vfjxc@w\T(9IcH|^p~d|[4 M0܄,GEuw>ZjBdgoL6 8 $E y4r8_׷%I{߿ܽ^b endstream endobj 1536 0 obj << /Length 3068 /Filter /FlateDecode >> stream x]ܶݿv)|9pHcMӗ0pK p8&g/d&rMOōLH殸F~xF#LdcqL{Ч=wv2 &_|JEPﾻ{NDM,2vDzxHJ;5$=MyŇi\nIwe]y&j1١4U@L(QC18vdQ2;<085oLKgLؒHIOޮ%Q᪺*JD$d>lVbr9=})[Yi͖ś]W>F誅gThZCJ$<OaDymw!)uu0;zDINS![5ؾ _V,Oԕ!m R[MϦ v{|: %Ed nה{69.J6okEcyo><_]F2oBP]цu߁w!ah.v*dq7PK['@W;u0Mv!py*g3bM%ٻҩyc"n5uAV-ǚj̥n|֍["Hx|![#Pe5HTn*hUn8J!j|yqFYЂdCS V9M^d'D*0?<ٹ]kmeX[SV!BA}6^э/uYu}ق<3\ zsbu(86BZ}rR V%OR@)#9yVr>DTڇ2E!(^J=6@ɊX$ "SbXDN~U  ~>܆cwwg#<_-oXbo8\b$AJ'mK)&YW:3p}XqBu\E,J8p'%K3q9RԬv5ӡ *fQ1esHSU_~+ǿY/_Y)_.ɋP_tT.^L/p<ٚlVzj1O}UUZ,; TJa@\8_:-﫟+bEQ>h6S=\@#/3)in[mc:$[ۂ<+%`i0dE΢\a@UF Lwʛp0 ApZZA5護$HN=- @M}j=TGc}bTҴJݮRƇHZ[>@jx DE9G9"۸iqgcH1f L#Se\E1:@1Zxm^42*U#S_pi8Ȥxc>H3v˻7pZ]o߀U'֪AWj!FYkՈL}mfЪCFtk@Tr=-٨#qȌZ50sݪٸUrU$ i̢`-o7"%k u 6+;6M}/V&2o;6  R:Jcsa9T:k18_qfӤlڱYO$rGC"AгS rh` [!`[tLz008Eq+X&Qb  XN4ڻeJgnnVM$gyj ]3wTU#ﾃ&4A@k`٪{/*YNsTcp6͕o -Mџ4 (`T @+|b"4$T8찫' H }btM]nYۚKUQ9љ&VRafZ^F Sװ6Wo2q9j(Z^_>bjv@Y. endstream endobj 1543 0 obj << /Length 3384 /Filter /FlateDecode >> stream x]ܶݿX xI)ܺnS$NRMh;5Eqο3io\`Cp*۳?_?05\]D*6WVШz5yv7ǧou2#PyD!ȳ_mICeӫ0ElMUuOͶY;V4%,o]]|/E/6R?_ম%v{,^jUe'W}iaKY{Gj"]1=,LGaFd(x@&|*5W%ɳٱx:u-g)MQK%DŽ{AuZBiX^Cpd{9v<39GCG:z*H֨~nk!a _Fs 'KC]Q֔h^ASܵ',eӞh,ٙ%;a3(E RIq]{hV-(Xy/rQoB88V7v vżIyy݊pσCOz"[;yU(UX3%=K~n6 2">GzVf+3Cw :A;n LjYDq,uٸ]S$`O9XbXԔNF( ~p`bwP1r<}kg+[v0]:}YfGd)3[3OhdL҄OH|>3NBk(+{ iy2*MȢ{Ҏߞ De6A%KQ~9OB%St+ IW>VhXnx)6gi(|귐R-8σ]9|mB a&RFY1_GF quU7 *(+ 1k y#*̠0%XqÞ OY27B=vj7jλJn&)\I()GhPA-W8d>IS̹AWKRbw< 0B8xPvHĴq(  I`nԐƿOla 4J0ّwtM[L*k3jQI{F5Mw6f}bDŽ>%+ JL E0?Dv-XxM ¨Qڅ3#=eEaV^юePQn:Un#赼Y;KJ*e\+2=1ywy-nnjoZUI3d-<žώ>(sb56 8gC%`O K#T45؝J`0f}N\>i,p>iQ ۽d(k>>gak,:ZWTQBN;WSۧ"SBFx } WѹumXN=MU+۰bS+b0̵ xi]I#:ivkڧ4Ic*\4yCj/z* qEj'ȑFy )4`fzpGPK0r CX.\+Y+ػȉWe]U. QK&>s'vNפ1AihxR!2,fqqFӼYYO fPzI 2Ϟ᧊B=ۍϝr{G>.|e2?Β8xRa2ok B ]#~C THXs;"Pf]AGj&Els@L6+|;! $Fی5/ a,zh휵 dƱ!>vc|b[Gnc9@KRp~~Od}(x r_|*/^}I ;n/^UN,yJp/ HQ$mҟI OuV2~_ !hfqc&6LJ¹L'jJ] q'XX͑I+M:'Bώcȗ9DqUY& .ۓŲd<3GpQVNoe\{һss὎A/OpV3 i$tż :UO'oh,.V!?ЊF9"0l"K&i$ogBIor'Vp`ʒ$=SVpB؋b3s*XĿum?CǀQkb7G*Zm2@f| $`{9{3~<wz횖s;,M8s̓k0|7a>`7dEm^;yfDMIW (e8mB ף\h G7CVyͰTJ{#Pㄈ+r K9 h|6 q ^92-.;G-ccR HQrH0127t)X;HS穸\X|܊J;[pvuW2ǖze^ endstream endobj 1549 0 obj << /Length 3192 /Filter /FlateDecode >> stream xڵYIܶWLV,)Kq*&fv7&} z{ۇ~qs/'/XBpT\BDeſ#o{'/xS\{fQC {Uoq8*:X<|yږvbҨl[|#tDBam*Em62+K핵ŝ ۓݕwR# RL8rgYW<0Ч[&s{M ݇#Wr}PMLq3o*H`UGn#f+ xBݡtxM[Wۮ<:4eS!]9,$:,.ü+o/{B,N{. =zG4[NX*zӉ^'LOuJ'}f&l_3)Y,Щ'! K^eD1e+A5v~-abPt1/c~9ztR%JGPo8?V0_V`:4,J:e*K?眼~8^> xHə?Egֈ#j{PMF@0h܂4/wdί=6iy %72.!.Np%$L+>6U .KD䇯, Xw]ͫpOv)k>F}K]8i͏[0UBOCؠyT_RPSې?`[ZN`{5 :~&DKۻš}Jd"&QiI'bbC2?Y~iz1 %d*L$PC,Bgs$xzME:"5TEJT,+g \aMI HԗNʹQtw n]S<GeGߥ=DZn*'௝_]Bdž@5_ӌ\9 ͣd QCh) BQ73ƌݞVq8ba1ɑ9[ I2*-=dmjG_4:?\ZvhT,B:5lW3[ cYd=#,I5; ;rɠPvϚA[f=m}8#w3~%1PUE}ݘɣw|I?dY<N .5|(t;']X'c^Œ2V8Θ\Z$sgitphZZ..A +9ÊI.zu4= LTB(NƹA7jRxs:ya~2񚪈 d0ھH+ѝc fXsQtᚴ SGn| O%Jә9r4w8j ADkYNN} !(S`f*2R0j)|b$5MRoŠK ]KRێyqt2(x/JAŹ@Wy&~DEEWQ+DPG$=FIhz;7m\ ٠Pb]6@'_}P򰿂.u:2[1ޭG/!% &ۧ2|W7k{w}t٬GyJͩn%IH-1@ Ir&Ϗ.ν ǀ:ty|{Ae7H*|e΀Щ.x9+D"9SYz:vbME-C3r0Wfk*V%^` G:Hm˛]SI6Mvb{t 4ݿտc<||6槁,tC"L`e oUg/0~)Qv$vgk?c=p'(S-*{TQwlbmZ%ڏphrXI*.TN pY SF\K~6p`J+?X/:%M̉Hd<˫+Da!X+CY)՞+T$·lɹOʅE@p-]U?r%A_IY>xSz<  :ǚerv )H9I^CB+[fzLᜪDru"5q';?V>0(L1aQɻnF҇/m6 <,h'vVnf,[uwc2=2E$d=c\>OcV'\B=Kb@>e/2 vX^J&9^䎒~ܛϟ{zvVcΚ1-7Cd*!b -xp\7'9QE,9XI] ޖD*t`T(C7p4_G?L7,1r5>c{X@`H S`fDN*)i&$4h& i&+Jf`ioS;[6h`Rδso4>#څ[Cy:waf$i]]% |1syQOOcJ$UKG!eKV: VF0e*q71DƭKE/'EË*)p5pÑ^,{d $XQ‹g<bIEeŢ.FL C﹡*OUx>Bo**T.>~.ɱɊ endstream endobj 1553 0 obj << /Length 3830 /Filter /FlateDecode >> stream xڽZݓ۶_KyS@ C$S}$3II.vAtt}"b/JUV"NleXnW?EU)_nνѩa*;,8sN2R Y$7wY~oz Qq2Qk"*U}{#Et?t7RGejK7-;z*E,&s,[kuj^ѿJH dCDKZq-NTu%/ƮJݛ')kNN5RM ڃuݠ$5Cg^f[v0h49hF#}"|2SJ 4zfL7g[޾:㟖\Г1C*HL㛵N r0Ӄ$|pp/߿*YdnO/u@ĒV/Ȑ5B)~s ܄XU*hkË~-|~`RG;~? })hqLrjVY\,΄vB8uEry`YaAi<ui_{&Fe9P=c%#xU {Di2Ow ` 2V[ݬpӅȀ:Sa;+m 86|-"È Q_?"]]6 ,m}}Rmu5z`:P{iҲLF۵zGs;sWu /3 $|ٙ=pg`YgS8q#ɪ#u}Sui3b(7fa#$7$.:ha`QEDzzV}}ԏٟMW ?+zb=lVM;$vV~`˓MptqstJ9P_[Ǩ"eObPpRr3}Y67vCCʞ%=n u ƘZMCͪp u@-TNۺ5شi*L^$txڗM*!T* j}/C\<\xj7qj~kZdcä!?O(b1fGBo[wfb9s1c:`*sKzh>@ hlJ!o {ZIX8W DǓ|˭#Pp(J{ѩ~ YLe{:YFxNjp@ lhjD(T#hQQz!B-{5 ] Dru>Dz$ cVҫ޹dFP5sH5 K0dX> ڒ`H&^ `aˀ6v hݕ`6-\)3Kњ|Ym~CFo,/R@@dLJz@$9zOJ cW M|T7Ge-MoʪĒ[Y$:s㫗Q,5~K;#KRv`Xs :%98t+@viU*r\ppXm >^XeV>!R!2;?Vz>S羇<ONĞp]53À 9~ehXC!mzdOhٍ`F8ҋ8)`.! P"}ŧۮ1z{Dr8SǙ`W81X_KӢXUk bKA(Z# "FCSXuAX0sЀ\9Ʋ2FYL\kL;5VDToSB7<49a qdw[2c?ֱNUd4kae5>+]Eq)Yp qU||DZGOeV̰5=;cz-b!s/6k-L'xOuu< :(F1bDQ4JRƚC /Ů&^-mಢnT@!:IIgnH2:qcoN]^ ?Oш'N' =)8|)1OQl8̴s?]:%MCN_;.o9@ LݘUY׵u_YblSӖq#?9Є|f`''ÓOMjIdhM f؝=:&J< W8q_)!yݎZ1fϾ[Sn̯ev(_x}kO09ǗN>blZtџ3fNc?]-GM `݊;;{!: kOtJ0OdSSxebD/aˑ5AL\`w0j @dOe Ks2ϟU~s*NVw]r`o8׋@#goѳ^(CfT1=I|vu HXysi<_9]uc!*f5 Kr&Kubm#dX1]*?gz)3REַgl 33U>f,wgA(Erv ? # |sɫUxt!P,GS4Z#{ `- RQoD.vNqʯ JC;_Roi_tkPΊɹMi^CTʠ0VT=Φt=DgWnfeR_Z\%Lt1N -,ڀ0E(GA粒3=x]:rſPdB<=H|ƦA椺dpP$?&SfmtDw557nmxMRSk0U(WM3˞ĤnDa6ww7]pX07*&`N3CAYFW?I{RBRCsifarw.0翣tk\y^Cyr.}xEcrɛA硾~W.hl|P8R?5,rO6vmUөl+.Ҙ$1OI| endstream endobj 1559 0 obj << /Length 2805 /Filter /FlateDecode >> stream xYݏ۸_a䡑V$6i9W ͵Ȓ!&}g8/[X#3p0΂ߟ\>|bϖ73 Y"l_.`J? "z5{0 E~L`P:=_(JZD =+J[w[4%QxH-tN#^强ܔ :,$Oyl垧 ƃҭ]ZE1-n]aljj,Ҋx !ǺcuDx2hήwL=[өF jg Jɚ6XdY+ /*d=9 i_FԺ!v.> KZٚآ $&uY41#agMbc~ mU]rE -^@D5aIR{wJDF I #8weaC 8E'TG>' nVA,Vcط~0vWO3  S?I:CxAD(? ](QC@~]o}Xom#ig(u]aSTL &NmqiÙ9>;D1TQ7'tjz U_@8|& /|818qV^%Hmx gnUc)/SVqUxL3 POV#ב,P"ҡ/hAp0YB7Xh_4( o2Eb U*NXkoܮOh\348vfrȵ\zMU1.:>uX7DxR+nz8=v 7w.˜ Cl4Dq!PpJa cÌ*?9xKPvypQjr؟_CT!Sfmog4JF~-A\wFJ0g ˢY(h,pN;4Hc96`2@稀pQjiJϺMֹu^_Jy. lo7k ssWjj};G'f *Cؖ0Ч6$kD}?/Qq8ꗰ@c1ETͧB? ToO?i{ \z&˽8q0Gc?>.3)Yib}i HPDjןu>:h( /t8(8tweϡM;^ ?.lq2}8  29\̔lJ N\߹:5 qUwA[o'$.9/*p,|3(aweBAm/ZoTR'p}T z'mgsSFL۴<ϻyaXvj{wu_GOdކAzikBQבNKQ7 '44zqN6 qq۠vqEѠOQ4oC/XD e!)iL.a&&XwiF3 TS`b%CJ"{h1Xz]UNkN ]w4(aOj%T_5{&{o]w:PuƮsE+R\]\3>Q諩mE*ceիʝl͝ >q7,౤{K(4̍\o.K4=>A$-qҹX5W;CoȃS[ b*Ĵ9%{ YRqΛ 05tr³MN̗q]v}$k4,tQܑšv (W74z@:_5-+a^r$ⱍח_\tPR* m#/W\pGu]Hx}m0DKŦg,<=:KF{fؼwLTS'tϊ >K'C;Ti%o\LI]&2_|?CqOzӹ)xȒ- t@ynlc!'ma_7IEBǫyos!ńa}Bz'݇.5>YYz;y.HTs5`AdB;h>Xn{gEH_\4Һ/{)3'l endstream endobj 1431 0 obj << /Type /ObjStm /N 100 /First 986 /Length 2287 /Filter /FlateDecode >> stream xZko_!/y(x@ N ,Mu-G﹔%Kdq s_IeʺEJ+4X;/8(J*PeU29;CU6 쥏j0ŬF2+K $-<:#zX8L{ಠ`(A1K2![E&W&E֖ZAvĬXޱSb_Vl=@Neh3ddDj`%m9+;kB!)\9+" _˛씷̗ ;~֖}@x)E`>9!+&'rI FA̶."$:/ I52O$@fBK !Bth: lIEU2BeoHb(9,cXX(r̅*FKY#!/J6$-_3ZXM- KDXPaɔ|R$d.b/HXPaMy@s2_(1}=8|'sXaqc ɶ -9GggՇowތz?U?7A=h`[[G[Ϊ˺?S- {3B&CHF꽪~m>4z~4֓QO~ NW$ M4Xz 1F7]FNv!l}xrB4vp2#_6UT9?/+Toa3WMy6>5MbLn~|DV}#`TտK5O緷W{;[cJYg[vieoJQvn f<+=>滀MJXZ<˅|[,~1MZTջPM&g/SgS>ebOtʻԃa* 2zFԂEKu8N"ٔº|֤pҎ`z? iVK<||9ѣi[!޴SaK!/]9'~ /MQUb}:LX2%[2Y:'ײ7j 8mpRl{aGTt%x`sVih+8lmqz/'hRwhO:)k*rs36c2n<$;$b4Ǹߊ6 Ѥc]։bD4 fOD%C%ocXiݭȡʏa]N[@6?RaʅG@Ց Y8⣯!`"T^*={[ r'da9i!ܲfN{7iu;n0Cc7|ZM$oryW*{ );,aɬ2ƉO+4L uߖr ںv:5B:v`3֎ksUxNU DtG(WZ"G:BƑ٦F:k:nkxM?\?4kxxbsL5LkG'ڶƒ,wJ!gqQDT$)'m(;.#p~۾}`珧sݒ/r샖ߑ0_2/X`?ȧz{R:d =1↶D$-Srty&ٟPR5w:/аR3'ȼOK9zPܓON0:m$ugHs. w5$}t`uM7smC1rQxT7g= endstream endobj 1566 0 obj << /Length 3293 /Filter /FlateDecode >> stream x]ܶݿb^"CIvWw'D+m%˯3(s}Cq |s~7߾xs˷:d,Bon6 LzcimnlW˷F)O@ʣYP^p"I1iN"M_d·CއQy5)˦XUq*8"h ?*ߎݍP;i9kV8rav) P/ \$3 #\84(/*ooR}D@ (|)# _~/H,:`E/T8=YNE bkaga_92fQ@V tάׄ*^ʰ$(Zl4  P$Fv'HIDRƭUJ9+4RPVBd<7v@O(/D3  UsKՃI9Lc:v{E]Zzg;ir1UmtJB`#S*xK^]p Kp#yW~wksG$J{ƯǼϻ:4-lǁhߌxS=nݍe&Q1lɃ9rH8p;, I ug^H0Q d>"!ִS FmQatjA,22S7EЙ'ޙͥ2YuМ]P b[Cߴ5>LV|8X>4Gz !^_qu5 1 _#ӌ%jO+c2"߿Da#)(p5D٘X0$g ,#)Kt儜n>zﺜ!վv~_ػ_8'?O?~ûXՐE-;iS9Á/!$U!jQƒjO5ְtLiUaR  ]G2W%n\M8BҖ)g,Â/פ!T3Wov sJnr Cno݂1(6lսzfê 7M,/\K~;ۚ嚰hʲOSz24q{H 骲D2qg)˪RP&R1_6L] .+OT DÅgٹӑmɧ9:st/y, ֜KPH0xjI@>?u,`|. 8O.gq\˸9Jk\[x۷^U8m~{wq -Y*YTfoDP7aL_[Aҽ/J(G-XXZ9 ߻㵆DXX3@*>1GX~3v1ߏGe{y7C S!_FoQ\Ʉ&J03 f׹NŘDyzq ԅ H4@=3 =Ok! oSs`0I q;$rlp.,ИN+Ai}|LDH86qpe5?pY€|?Qbd8T*FpWG'-S 04s33v wgXɸgnZS<<  4F뺁IA" }DzX5HOi?1`l02^% CiW֕wrsz= +_!NhXk:LgsiOm^-%'֥N2eVg" 0u>.(-V3:]>bFe ^hOupjOždUb5 t~dDz-x[dzYѩq<ȄY5$Z JZEwn+Z.+laנN}IBpp8lpj1|rڹjRr"3y0JS%4m޻opVf_0XMBop&XMpYփ`"`QE~6M *GX<> :,wMEMY{ ĆfdLrc: H_fxC/j]Z/',eEIhG;{jiE㾽P߄^QVZgH&G}ӔWM.P>vϤ&wvU>yQ8 UX^p'xDb|-@hwU "D,aRٗXd fc+}V.OtNwXzs]5*&DӐg9SRfT(QhK+my=i%\p\Q *u!K]]yO\V~PRTFhr}cUޔ^aLK!5^ )rfcB@7ɲ'PZ3R+uaYj'~Dvu~pud#[Kmm+dr6h(S+!Ic+|v8:tAȄ9w+6. tImA l2}|͙ןƷpٳh Jga8S&n4.umf_?If>sЌ}\,LP!%a^2| Czes. VG%f-Ce$c*&@ŭ؀ל)'to)%_j'nmwPp$N e}$l|l60Bm.0a!6C/:ֺ\"0FM{$y]:Eڷ TyZU8LJ272T{JEaRav endstream endobj 1574 0 obj << /Length 3607 /Filter /FlateDecode >> stream xڵZs_C#MO<\Z6Mwn:43$f"뻋]K6(X<,6JHc/2ㅑR:]?,dݟ>Jc6+*g[u kem4y{]Q=ZeWp=D]wy۵5LX+-7e]6hE{ȷw}[^e1-ϫ:Qܑ P ݒQXlq%JjFRQxdU{_7|GB"ܮ.늶+-Qj7CIJ.u+,b #P-%<pѢA )H``3Qܮde,L`k/ H@*4pFՉTZݬTY kF15}&P*c i*`v`Igdlq#Wba'@4fD, ef00@eENTFgtvz]1Xsa(8"Yՙ, Wr0„TsNR(_lTfH_0a+%b0A3a&+VW%.HF̲4 2FRce񧷙-pÑAs"[~嶨lKt%62) t<7PcH+~H#;D\t숔ml#6zh04gds'c>.InIo_z}TrVa`ˑpV<ET%~/KJIYRbzj%Tdm}2)O8FsM7=*}ɠFANE2b6x0\BQ F{CX{B 6m LMXh / E)FvԚ{ F< PeUs~V#umWAn'-튶 @f@(Ύ.[gO{i0*}G"JNߖ P[qCsӚܐKQ(ۋ C 2x"-F=I%:0/)髛tl9x@:7d6)U\@s1#k{BVp\foMUP)l^vQoޱ0#Iu@ Fx┇PNh52l70M<lx'nGA]y>;Uyz.(;yk>]- `V[lm3oSYA$' .sg5P'i١GުH |Ni*|3D&(yCBc< )[πck H Fak -4՛d27qZ->Y 0i>79#]k%|Mm3e4kiXę#Vrzᣕvw-@ۧ"QQ{yֽv¡VC{ڃ;7֛6]^ Z'Nigt6ym HL+?*2 S-$6gW qHJvt:SmP'EpLg ZH7*n۰bܫ",/1?;}h[`#Mˆ^4;喱> Ϳmw)k$% X * >Xh 9̓El{fEZPbqČYE> &jfۊi ^J <h6"{ܛuUL]q R]´l3tiUe,³>n_#tN`L%|!r.8SФ3@>Pģ҄#6f-J08@en9q8?^TMÚ|1^E^~Ut!YsR ٥%Y^y#'(!^{ vpȋ)ol6XiClol[9%8r9`Y  '(j?pEX(\CUlp EM- BI_L]FTЮ=2KHa3F(F=bg1#]VT*\uYkGUcȥYaҗdf8TQcV Q"TܻGv8˻]C 7=b69b <]G̥__B[,I??|FXN#oYpA+)V"yOY#l$2ށP&l x%АB,j]j-Y՜%!NzH^ק—(%BX$ɯ~Fq18h+BYk3ʅ2v~*M & `nE'1|I WsON]&lF 6U(ҡyņGAΆ8hlX\M3xV <ç^\ص*Gx|-]gzF)&?6H1Y~`fN Ջ/,垚I ̌۷_E}HXM?g0i7o g8onex/o vq endstream endobj 1585 0 obj << /Length 3106 /Filter /FlateDecode >> stream xڵZm۶_T7Fȴu:z|7I'I?P"OC I|ł%I}}vY|ٛ/_=if739Sb!Qvv~*-WguFk.X(7,8g (1P4z Zewȓ6g"ۼ`hJ+j,sz>-cyj1*ZVpA/ۼYzbɴ~ie vI&H#Dzq{}O a/i/C\Bb%gX0eOx՚?ʀqfnuOq?:= ^Y 43gˮؕ-A`ܐ?{[|Mg-P2/j]Tkzrs?2Xn} xxwa} HC:ri)x'7E,s R>Un ͼ,P޲79kDg%QF2 <,EQ%`W2~lw@Ww9:U-tb)ӆ|-Ho0˲›NhDooؘ LAP嫼m1~Br7O~iM݉i|0_o* \#n@{=>BDCh80YFC2$D3'mmv7S脐XiW^ )=E')Kurp_QeE9K)cocUwUr$N.ySy"e1ۑ=ʔL>D~i`Ov%^驱>@񵛺,kḒ LJl_SR*v[L~_LĬ?߾| R~:%Ʋ$I^r~Cr1o_}gl]VT׿_3p~x_BŊ)sf JGcD1bT@x#1\$W`@}rQ ?WE-\.:^V 0Xi(|"PǮx1?r S9G\ +B ,fuCdç3t kjy>,K7WnJ͐zq`){kjȬn Q^d w[ju[K#1wȸ {΀XC-:Gz4\tUr&^hC*owEL^!%k`6 My D vi1wO47H!޵E;ݦL)P<13aEf9V}3Le&Plxޭ}SCR B8MlY@x)#FǿHif!,v oXw7tR0</ X<SIKկUww>bҾơJ(]kPH@VO+#0Vl2[Jd P=T`rQ*1I?mCG6y)bƨ)N.u*'ߝ !!8a"Z8wP9֡0B 5]f M܋8طlIPr:3i<14|TV-;~tKS3 Cwij#7. V6j^5EhEb/mzP\ɓ=bw}2 E12!L~#^3r?l9F^b e4 jS͇Wg-j h ^ވ^GGoƆC|W?C|3+> stream xڽZmoF_O9 ( \p:q %8P"Ur٥HP$Kr癙gNnOw/^_Xj PHu0*O~\Ur)$Q XӮrz/"s]1 {]7j;STfsx!E8QᗁH4881T(hMK7uCU]uEwn"Ϻ-_ʅÛޚf&MkƸBm[Z $٥!q8W堚Ā&Oۜmoʝp(L-[gUxL$p&Ռf[ÙhI`clUYyœ}y8?=~!q«pd9W\d <91F2> Zl(7MSFwmkʒ&?eFo]+jIȔm߬ 1# >=T1yqpF3mٖp:1D4`[gyҨga~nwU| >FL\Sv nL^z0o' PW`zbmwN!`"◯n۞.y]us`Q!ïNSoRƄ5+ӧorz "U o&+ STxuh#ލ41}qbo/=N @YҬĀ7Z΂vUje&0J'tEY9DjqwNr`4x_r\f ]m*δ>ap^1 cC0 o8*`ɜ 28#mGmYk[i~): v/9$i⶚tﳡ蟻 7Zx¸|Z?벞5n'ǔ:$K$tXBO8tݯ-X7$!$Ia+ ?NE ;K|N?sLġޱp1E54Ɣ?u|1%AbAOWuוKPovI`6YY' qCDTʀ0y^.]S7mYI i?i""9j]m󚒮,mWMݶT2ZEE ~->\Jq\:x3iLF^h//b85,֏f/\2M91 <36r#(~(nouWnKC,Bn0vWp8^gE):x-W!`9sLLAP 3[qMc'2T*|_u,k/ҡQf ;w^+7T ٰlưN{0! $${ Z,7') (|SBI8TJ?΀XIp>7Mk } %_eg$h lLtt- )8πܑh;4i }fE{M)|P6\3xj'QQè3`9;F=4o:!`v@O!ޑm IcG 8%Xhu8`e, MKR]j ȷ;%-nSfDS:#QxC2NOehbdhD#z[x{Fr:K~ @ ĵm ԶpuB%B wQ}&>nO|98vBR\( QpUNp*O@Pf >$ɰ@\&BɅ-@Imc̞dd@i$$@ ;)LŁSt(IјBOKXz&S}tm!6Þ )@ nwe _wYM]wGԨgUOՓA(Hg*=,HUd "7킱Nb5!e wrY[B,eũ+Bz&G-ː~KOH77.Xg w}BĂi 3II ƿA*t- 4g={A JPc|EG!jsȊ{ xnid#|,=nM`?:~t2zB@*ͯ A8cNU(3;E" 8טj2Kj(vH(a; 2KiT"+LVn!l@h-s{F~AjiS8=ȣB T<[ʊ'JFk>R6}hsL[2ŎYf0 grLHQ_D 3%xƑ6&e0 Z([)Vi/UjQ~GkgOFa: {<ɕGȗ- IJ1Dj? =ֽCrʜnGY, :p30#uMe6*Yy'=%CS.M\#z"/{ޚ4YYl]^?϶,x7D<>'ph QY%"gsG |IWZ@L>/dnF]ѭNrTsѾzD?A Gz(1:-09`^oP4Z" $dq`Vv!`|=:_= b4:&Kyƨ= j  !l:d0>׊F?ξF?$/Z& endstream endobj 1598 0 obj << /Length 3530 /Filter /FlateDecode >> stream xڽZms۸_O)5QxܛvlNLLB$^$RGRI|XmV3IK>BhqĎ<;~6{%G*VȎ?qbdG9q&_J*'~;{{ q^TVLqyGSYH$jd*;ԂzBXHE~o@Rw}! p?x"b wD`GWT^jh[ ׮D-7fHa {^6*,pp:ğ\H-M`R@#R8$g7 ȢrL\WcZu(2zɒ^h^'TR"5bi-zi;Qk0`do35Oo r6g-=`ec>㼟e9$e18-d6V_tH*fiY ;d8*?ActQg"N8 ֦0pKld{\Y&ތjcP?kj49A"d-}QUI4D?@}`5gۛ5 AWgGK3 X, *qp!.{1Xp[Hp= SQ:?;lj9SbJ2;'|e&d_*ÀKSec+R2>sI"z V7p6[ E\ @腀Ϋ?H..q*{!7c]l8m$<=Ӷ0-ifpL>~rTGv!%S= ʃ)yq [L`raSSX{V8]sj4WK뢰J`z |>$ |wR똠i\;&(q \Qb<x$ACDy B 0'ڐ|?`+D`^QgtOL3*%L\Ŷ\νm?Zպ:]z}532FI 7.LBEDx~0E!Y~HHaAXmL$A y %mGo£*[6ȱN8JPn]fPߍSFU7kFB^~<'h\Ua8OL~P-cLTH&)8wL~,O!QiKdµHx_V_, H > !^W{/cLxa#|he4t^6 HHIV.ޟKT\f}gy02@d@1G*f-Pa HoY Hӂ@ʃT2 iԻSlaaҹ#e 1DԎuņ9I O'IC{tâojPvp{ӘD049XsQ){i i>hrC_Ş)`U05sOdž`Kwxhܝ G$hwZ=rZzlp.@8d/1$hb䝓z %v7 UNRcG,$vyq2"&y BGO2 ;{IIIE5\ANr%?gݘ ZsqCPxf $  eF=ĈL{tv^`> stream xڥYr}W)VXf+ruw݇!0寿``ZKUgACvq.~zN/(E|qER Q,A&}|LH1 8f W?Y:qf"NI>Iū|c?67/,xʵiUxi:װEʂ^( .7&)um?D8.;`LBɡ z!tygKUQ涥I뺡ޢ BP5}EzsE3ԇ.w8Ev&4>eyNHăN߷O`Sog} :m֘9d/K$# @:/= PRR83s7]o_-E]Fus,L&P"_QV9;hiz{, 42 ~T/<[W2VPT7ʬez}"*6%*݉1>۶eW]Iy4vkA$c"/m͙PoJOה͜}T$u# r6wG6K[Y@ ,36gXEIr&+ `9+s";[LΒh[7<4]F>4OgvƖ;k'?PMS7t|{W%Oy5)ZYA`):B>=v'Amֈg+h7eG2zSRu6inC-}Y]q-ʌGB:Գ )PYH&c Yn^*=$DLx2CJIXuG>G}N\N|ȯlhmE e72U+$PZ~@;@xWpU> ļ!g$,JSuP ЇZ-t .!I $ p(C oBw$ID9DWXpd$ߘgcZT) %Q )2,I݂m=L6f[~v0BH >u< FrK+#5;'4ItԨAp8GDmw(J|Ugea/vHN2>v:i 9X=RĈ$1B9UFK8gN[m˂.2 y@0rYWqL1t5I ,0tCcmh~[ݛs:*y4ppk?ѐg4`f=9dncŕH!ι4{FLQ,( sB?h'Y‘W"1D]/g,iڶK}p}Rxk/X!9t\Bo<[ǑbM4hV X S"!V$sq?GT h` q |a8H8O]7},jl}]?pYoe՞c ֖_m,ս/a,xnW@aU v5ȹ{sEЫUkir0]>~dM%* lgnY&bz{p:CƅRr,/ z0m~ؚ~b}xHP=NĤvX¿ x2&e dxOLs =`?K~C»ځŘw8HTY ! hn~?ɥ$!B]/Qx~=^YX(b8Y5aGP` M S2֓An:4g==2 `}MDZ767NT$BOĔt 3T AtQW;c 9+!,Ri@tB?ϒrZj\vK F~,Q{#ռj]"!~b. `$] oKb~މrBӰk0 P{̻lWFqLDtfJFs h9 9ϋ| rwR1³Y8OKq%:9 YI |#>u:Lf.lab *Ɔbd(uܛ7¶+;%`{ eE8o 4P@̇?z$sϴDJ*k g h#hk OJXo6HQ߰1鏴S$[ Q~@mg)FQݱl}T^ʶ{Ёϡ]Pz4Od4u(b"h9; `QB*@UX=%{~'$\ݶ~-h_7!";sO=~ XmgΩ 2WTq1w':` U ;j֫Z nώ?qp-59^)c4&b]_Z`bZ}k-cM1xK!O(_rM}۪pO= ӈ-)q෫Sȓ7CFD5b9R# ˗d_ ™uLho3(7}֣ӟ{#OߣUyŐ{oJ,= $hb /tT)AQ ruSJOc:)ljH2-02Qmpβy|Bȅ4u(+guȢ;a$ۮ>k^i0Pg(8,0v a)!RM h|1Bܕ&כhV endstream endobj 1621 0 obj << /Length 1473 /Filter /FlateDecode >> stream xڽ˒6_fdVHQM}k3=$@KF<"| @$rFon^n'($LF#( Gr1'g?? ͔(͖`AVMx'yF̖_zS1xn}zO(S`*Ȋ[Y?G霄8ȕ'$FqI%5Тm+f5tBkZ4ߙeS˯cҬ HPz -,y|(xmEM˶)SR C7gmUXR:ݖ**ުYⓅ2*ui5mĦK^fmii]$:aqb]s|fTt-޾{w;JTnajXV*ZRVn3gim6\hBvΚmr?ڧX`]L'Z6Ճ>o$Y%: lWK10n䁥 EZh߾=>-:&nמ=gX|1Fw߯n!.̞QGYwz6٣0ف';`>ɮ1[WU'dJX[M~%(U8 0w5+Qe1n.EEt!/y'AZՇ(@ui)>j !O;jZvm{ᙜQr4LZ T|$ hgЮYιcEYXek7( #-.e˕H˪sI0Ѭ+T!Z%0(8T6K@ANf$3 to;%JfY@+2sν j.]Kr>U;~&(jW VǜxLwU]]le/[# 3PnjNv:BdkCV]et}KlJ0c[ޙ[-|u'_(Ȣp7MP3RX=99p&F^?6l|oy%%DHY63?@#n0AW`Oݫ S!=#dYyb0Js (&B1I-(7k3(M%S mD dl ={A$`_=yqy&8a#I0\mږ+ֆ#xc x0t9Ffتեa\]T]իLg\.1[~%WJ~t/\۸S꾏O|Z7"#|oӫ;'.sɥ|= U- endstream endobj 1627 0 obj << /Length 1286 /Filter /FlateDecode >> stream xWKs6Wp܃ 9ةIƝNm@Ě]Ń/vN/tXv]boarv'[<1,!([fg_E4H1:_0IZΰ{R/M64fW@a2 _ǟyrL=ҹyv+2XGx-ngv^> n7QĈǥD"֯U>H4H9~̃c6u' vb﫼QU,ZtrOT̙q !ę@DF֯_UVxF8 c/ bEbK^>՜pJ-lr`_,3 LiL.Un3벓B/V7&^9#VURp}ER6oF \ωU!2$h9! J@bYOuV#>q:/c 1B0G;/!Eil5n}nU)3+1N t96LmaCႰK:q'_x,#ҁ^wҲ@(iZOVg/*]ZlրaT D(nW\7T(v z7J $E3oJY4LV쫬т۵u {k$C g)hsac<Ϭ8>"fo8V+|Uz:I+^YP$4@]E#~Piz|U9 ӄJeH܊KBTyjoǝ[ϽmS rѾ6Z)L;7glI^vװd{>XG5F0 ٕ67̉ڽ f70M|w0$F޽' 0ȑBS-¸ͧ`  *嫩s]ZvltpZG|ݚإ+f3#vyeĻSD8=Me P$;M8 n 21ޥǼVO#}>@go`:J#3q ȱyj*`90tE_[>*턎)!F(ȍ˪"sf^PB $;B"GP'U QUkoidD@q׷_)`N]$k _Ҳ<{AϗZ0|*7V{ zt 4~Ng>l~ s >U&_Sh endstream endobj 1650 0 obj << /Length 1866 /Filter /FlateDecode >> stream xڥXKoFW΅B.,q #=$=ȕĄ".%%,)]مs93K *ƄI@':4nY}$Q9GT`͢`n,Umd3NP2`c2;+C: sE, LR%&OkMJ~[ZpK{I04X$F $ ۨӡ֛Qd%/t KzE& ivq29Q%ی v`Aa bF%ϪyVM4B8\ $j &|5 `M;H%[KSiW4#0?f wN /pޮV W;VuOXJ 9/%ų#z+پ ,|7F0%I%YӤ̲ ,h޸\8WÔ`"E/$`ꦣCi1eXe\u+\ld-<}+@$3v8FeKO S ;lGMGQGC)Q"㦥DJ}P=801Azgͦ kCR(V9$}Uir*W2~jJ__d lXU!Xd|Cφզiv竫 N<ډ (NdQU+[`T!>ǚ 7MrԿ,BX *>EJ-$m-2.K}8,CNZYyNz`M0je7Rikje="g":N -Fܵ3^@zy{M~&w]k&r+p^tUkv^rMQ2DGLHFr^yГ%A^l7W٩zT;vN;=>+Xx G9̍wi{hjK p7I;ܪMH.(h]1zG _^­۶KΡJ;l_dX7ė!;/>|Ȳ:G[x6|=i0~\z3P1dyP|]@1_@.҆vm3˗/FwP45uY Dc÷ NilӬ X3|cW *r`6*LfWi;Z¨Tk;J贆kǖk09z%K!*Cl2;0TC{Q}GB!M]_|x"AnZ{jgY352n,Nu.cW~@gL"{5}i-ZtO2B`[m&i2 /@٨~k/.݋)~ endstream endobj 1665 0 obj << /Length 1399 /Filter /FlateDecode >> stream xڝWKF+TR2S#TvoʮT9>1$ ye]Ԍ{{eFw^$AҘtq A1K"4ј !,, "*BpsPk.bDS-!p :.mQHOK O$K̍36] 쿽`ʁa,u4{ɣT" 20}bzǦ8ZitS 4Q;p^7R 9L}NkFU )F'(GBYlޥ#1a}Fn%芵q5%{m.wU:'g˳.#$'ӗ3k)P]Fj#( SnL{ xԔT/W"B@WhWW7$TwofCIP//>  hǮ1[ﶗG)J8]QOvc;,Ӱ4g0 1V_kxGvڕP%vDD\witkEq' (:F` ܳjVz,"I_4;)1>(\m۫:m$4+WUs/b-vqTjgN)§ҏd@11&T˟퉐4t֬v":xkZa29{W}\ޭA-qG}+.ŀGAS&(&زxÛU9A X2)-geԘVEi_=؇m6mXf9x`3Oߠ4]]jjW?[NǾ6kCj3%SO{WH#ѻw5t9cWX@ɇA{ :f/!+ endstream endobj 1686 0 obj << /Length 1582 /Filter /FlateDecode >> stream xWKs6WpCiHӤ;&J{H2S$GC$eK3&@o{?L^-&$QyG}0y1$b[uY}^t~jS 8J/1.pXy;fWj6B2 DxNXk8J}VYwDH\gsi>]Edea^6y}ۨyk)^͂p䭪IL2&\~ #q;o^-@:BG,@Jd#mҘeV,5[;ACY?tczЃ|(wfָiҦ&Y`JAƣ77n ]=#6g={l6}.6O ӎ@6cVVPXeQwUReIo9[[M+WяO~TR8{5]4% 4Ho+uJr2y@!̺nj:/UR^gz˼= 5Joy&V%]; .HU"U6A^c^?ܡuDwCW:85`A6 ?Y^C4bׄjAꥻϾOpaRxzP1Gʽ_K#"X|,‰`Nh.g6,N]oG"'0I[z uSe{MSpwA%V*dPY>F=^wИGXB˗jiwh5/n!`yPxD< %v64O10-%j;^qV ^ T19`EYgP?eިޣ k2 :Fͧ&A ?Q:'[ַෙ,Z<~EJ2iUujrj@}U"IYm5X#!}ԦM9?&⧽cFr5/  endstream endobj 1568 0 obj << /Type /ObjStm /N 100 /First 983 /Length 2177 /Filter /FlateDecode >> stream xZ]o[}Cy!9nIF[qܵ%CJ%[ dt5${'N'Q"ʤD6G%g%!)d] J)\|,~/K -?&Tpp}Ɔ\JePY1IIŢg+U؞銒 E[좠Aa-3 Ⱥ=VeMpQ" Ϣ QײK&wJ y" |"L̑Dyob$>lx]+]D ePLr T0|TBlRHzEb{ #(=@[E! GIpT ϒjPe؉kC_!w,W|R*d\gBd gdⲑaAEɸ"T"P sŒKɋ3v 3ԧgEa;⸮# /!oJ5bDy JjdVQLlTİ&)fVXWNP_rI+J%][U(X[QJ^Ꮻ~7|<_73h;_Oof'녇g~~7T=l2j0dݎC{r~|;:gk{sv27ǁ&x lga^otoOG't4|Nλ RjOت'ɏ]L@VѼ5~{Lh5E3ŭ(bӺ),?v4\M}dɷ_@ !뒶Ww\o1sz{hz~`g9>LYa^!(ڐ-EUh;dP$f$&lO;+Cy0"djE://Z,B4K6˦l6>O!y; [Š-%5 [VR~=;8O'GO_?wݷoT^ٟf;|/5'V[sYq$VK>T},DXsx*UyfZz MX&o.nn=yY6޿fg|%%iXK"4"6"5!Xf4DٷuG@ O}Zِtf嬶h G| ke&$:@qi~[ќL'_-}q$dt@PPaxrs9> stream xڭXY6~_JTEL<8^ֺJ>y(HC KʯO⡡eٵ/"Fu׀l3óxs{YbAq=##," WA,?| 8C"AY6G.+n6K~F0Ȭwj9*RU+g "V5apQLCyR1'8PN-q)9 c }^6OzNs)+6vySoغAV+K|S)U#2 <Ud.zVYz 8 kCV:CaЫ~$( 0J'h#Pc(H \bg!cRyۦ?ޮ `D'@Z9*' "A4B$1;8TmI q1ch7Gy`y3/bզ.`dҬ ;~YƱ~d'FMqFOvnvr#7?4 DEc`PCRY ;^LMΆ>rݜ"%wKOu>c&PqA"IUk4x&&l$|uv{:i~"\~nM,WoL {KaL+͠QU}ĘI5u[@NeW7sJ՜0n>g+| FXFt7n~p 1&8 U֏R:t+I6S%_uMoxu=,?u]F Mw3a *k|Gͽw~uPoZQ>Қ:k OzFH,t1C\rM4'4̘ 1_7Fx(p{6ũx.Αd1ƺNG=mR%Tu+7UJUw/<2WC$cY@qQ.JXa>uZY믲MwUv̓Mtܗo**)ug°$zqRt[ur[u)sqEcB3/t8PiҷMSBDqT"QrR I:g}|B"DewW.M\. c1KfRHnK-P( O>>S2/7*ɘer>a 4o375݉n6_RoZX.] f782!3M9,5MRIu\F2޾F}FH0Qw {۝{OQ5O=t g:oC >p]N'Ǩ<Η:-Y1/f~mR%ic@ l^L0ݸU=l d \͋Z7lmSI[fOgXNnj(ft>belsO83"h2cejQ@,D🵝h&Vܯ_6P[+Q'NqN\rez6[uFϾ RkB3j`"گ%:G=&wHg&xJs7$qlIA\֪gԫo˶Iy8la-`IjEaTR9hZ= O3$8uN%up܅yj0HN;7L.d8L3 h|g,S)l`'˭Gc0ϵ'_N4Y>Y:m{دf_7Y{"q|MK̟^);/<W1E endstream endobj 1715 0 obj << /Length 2478 /Filter /FlateDecode >> stream xڝYK-2VSXd9la6֎,9<ݽ>UD5J"EcUY+ǻq,q U cWoߴxQ E'),j&d }>|VʙQIOԼL}&,3+^g{Dl򗲣}#꘷:xC(|_o"y_] !2Īt@av|u,Rd~*fvw]}.`ݖ;Ѕt6FO0&A<d(m4e1 Fm1{h&#}_+BvZ9秫C䯿 [=91q#$ eձG(GQAF9 >z̧8h]}tz_2}| 9Z_xҫ]nF4s0Es!w( ^wjf QlW fu,,b 6ϧ`ngp: eo@ P;`Էq*ՠm!N e%.TWI<5jQ HA/e!9p \H3³1|=?'fٵp &w1Ѽ>gtEFԜ-DۜB3sD{x4h`P5ˬ.?`w‚wZuY0ـb9=/dP8lϸ߆^v$zm3'8Q&Xh@\kP$ơNDӍ*;*G;s{ݯm#3uWBk/VLߵt-V-*m@:o8TCl.ms:Rq[ *BϜ5$/_pͽsIWA\.%9\WDWfu&C-^.ISB' ˢ86'Np >UJܼliDI6<IglTI j9.neKyPA@ M-ƕ!O[#/U`;e15/mN xm}E)PF2aA;BTOȜWO] ^7db6Tx[%_L9mF`ə뤤93A2rI^dŘ.zP0`Dʋg3x3Pg(n[3E'SDGA2Um/fM*ZbnROzl|Ӹ^jSZsnK+~g옥AtS#f[@RKd1h^e֭)/!q ??H{(;琷6sOJpEBy |sHԣQ>y,!n$3=cOˌҙm l%&--f$Xi ;ѱȨ |qǜ3) ↢X T6`` rw;r#z5P5.ּ_J/R|*#ϝ ռM&PӔ\QszLXK u6L+NGuŭ~gj)uֈ2kmՐrDo.[OLUbWp|OꧪHgee|}o˅'.az oBҠz}չm]xF v0 endstream endobj 1722 0 obj << /Length 2228 /Filter /FlateDecode >> stream xXK ϯpI9gl2!--ʒ#J_eJVN|0 |x1>çi+EP$Q$2Yݿ sO[*)FvѩE5V g;>|YJAƩqs Jt1Wؾ2DYn:롩8-}4~\t՜^zn$i Y+9֔alj}Ga5)êUW2MIx+b5+{Gi |A#V*Zjut2Q$تo_elN ~ՃT5?e`ơi uqUط@CbBJeInud'H+KՖ<iv}Uh$ze:k_my#QB PRfCx2D ]~|f)WxGEp# CCaC On0Onv|ytaܳ.M6VXMǣ#껟0uW1"عd_N[:{2ǕNSW=Xsz4nAcfCXP_".oZЙ̅ܲ# 6GJ)c'o "?G.G=Hd8ռUGrQD[u(…IѡA#agEy ͉ƞUicL&":pN AѼPG){E2ʯb/2B©ƚ '"L4ߑp ‘5oH6ΐ_48hɄIM{guAcWZ? ӹ,:Ac R[9A h7m*~]&5ރ"AS-4K((NsH7"s GsE;Nm1@U+ʄNK1UӚWڈe+@RYЁy& WXcW~^Su4V7>5H6Q| S\X@hfxQsխTvKogɈCO{wE߄7(t+Y0KyV5+`;6@( :#Nڤ:4҂f$NgB#stQ-:_J4߰]*=G3Tٌ 6}fˋ ?2)a~=ծʒyg ~ݢVZt> stream xڽWYoF~ s *94/<$}XQ+ HJ;L)MܝkgjDGo/^\L$('y“r(%"JF)c$f1,uڎzW?oOYON I F2]PgwCQXn4-;US72P sZ>3jǁܬ!XwsS=-9'"qU'_Tݬ~rbɘZwݶ}>5C8y06QJ([fY6jEXֲU^B@,Q@p-+7sS$Gj+ +v%dZ%kHrrU) YYjהjMKrX,>/םJ 1r5DZzyl- g3*ٌEcD3coұS4;BHqπAA Kgp 1IR/A%g vQ J9E^,H,'qʭJ刧e.u0Py83 ecڀeC`PtgH'_ږ)%%,$.צ˪Ճ Pdfr3'.3v&=NljHx!7اٗ7>=ʦԻv v r sr/ ʶSh^_[&bϥS (v 9»,;BסZ.1V녪NlT{@zwW:~/ttE#.dnܻ4k35 yt{сD7 L1d}_:!SS(l[+*nfvNon%'CG &YtφvSvqFP^F%k5t 7wRmoo~=>^wu=[K?[^G꟎z뛋` endstream endobj 1738 0 obj << /Length 1679 /Filter /FlateDecode >> stream xXK6Wȡ2fDQ>Mhm㜒JMT]=_zYY'K47ߌ9?/~,߆lyԉ0F$&w>7o` <E[QA9.m= z{AܝB:a9'C\8wO !CWhRExj充 $ֽ[*tE$ +? Z+UMc^0) #{!fBFe_Yŏ qcgxۖګ\i~fKe = 0T?v|.3jf~i"Mc+i8V}uҽ1&={\vD?*p/9k&a8d F/F2^nAHh.-K^[={q:17v~ҜUvjƶsfmڋ {ZÎ:UX{V,ض%[{ff|yeţE>(X ڨ&*kMfTiYo;&vVy%NlͪcRͿ0+LC FLojQ̪~pX4FڊfKGI3BL&ՆUyh ]IfHDdv_YcKf x(/$]I>qТ T%|-aDԪήāheaLQGE#(s^XlGi=zO 4R1H4 P2O\XU֋e^CAf/+WŃ1dc~꫈ :N$Mhcǩpaz B@hP'v TMSsc]2I}dS ",ICX>zO6bDzs RTO !bƈLA2=ld99R5w-sȔ$14n[v&$Aҁ\56D( x}s$  3tkR^?\ShGAu$Ǎ;)| ʺЗ(7,݋ȵ<\c?ШI EOɪo; ^=d>8}^Wě~_SL|9<{,ac)W(A @/heV9l2L:Wj1NuլEk`I4 j;L@|nyəaO" >r  =ZGA F2\> {Ց\.,31KÙ7ˣFcxΟRMCrJ9T?}ZY@uÏ|ݘ]=lS㡱B%2ǓM7衵z]'(A] c6s #l:\앰{e_^0G˴9[``mdв.WOY /E{1~a R Jޠlq`Q_ .~,ځEm4@e>ꑠ:9{<鿅0N|> stream xڥYIϯCv77>d398`0%$Q@RofSUlJ|31t`/[-_-VUϏwS*"q(*]eqX=V_]a +<79ɽHì(`_&$E|>|[YnE4q, \أƃ_4^s=PvGnw;:SӍZ*p(cjߝXw-m7~gE"ICwuy[Ci^$AٜSqlil[iaڒ7r;{H -4$~=ڝۊ~Pæ 7-(8Nf-4Zhw9=Ac9۲i^8\/X8 8JqꆚD&2΂^O3 Z_u,/,v=k+6 5F7($*I) i19L7ވZMϔoBZesZ=_n0p%J|ܠ~H> cv|],"*7anϧ:܇q!o`=8s|\(w#%8Gɨ ii;+50GxJ]* A0"kE I> yYa8U R>2 ;^ay5z׭ވ@8S]zwBS#TV(/y3f44ZV;#4x/`3Fm|4'f+kJ@x$ju80s84;+f呷jt72t7^ ?D<\<r ^d<7q&2Bӝy/7Ё-q1UL$BT)+)SZ?8E6磾qfj ]kT7*jLAaW@T[:uQk5wLEM6 vb)x$^ xio g+k6'޿UKowy#ȩzt{ lylbV|,euVB8A3mG_js+2"6gGBv}uR\C$ytp%g펆ui[-'WU^yQG_@E&?R_]=3;VJ~W bK9qX\Ł^N٨> stream xYK6ϯ0r 5(Ja,fr,٦m!TzYt7v`XWb=|YUiHP&*0awd~&R1l&.ܛ:Aq:\AQg)Gld]6qDI{uE{kfiҕM]TMvx=Dٛ=ߝ 5zg/fW71?wPߠkh2e [E"r?S괟Τ3j)SDK}2M:RukuxImUhi/B Zg 6mQUT ԴM/-:+Ճo.Uue}^ӆHnݮ97 5ы64u3 GŤMQ] o;v$eމ/khn3)t<:JssφDڎG'?D?5碬I DK-ς5B/pk*=7JsW 2fLgC{=0 pΡCGA b bjAW{S Qʺ3-(Uy.vQzT'`f'R)GgO͵SjA#ٴ Pl5_lmy&vtlGRtPpsV'Y}Tk@ْ_ ]l@}>odr].ͽɃfk(=S!,##YD(E{vIp= d PZ䖚T~#z B^- [ Ly#|'`8b{FO4)tSLնݼO;DQg딯GvO4ѧB=c.Ă<_pP~Vɇ ,(60a C7N`o,{XSтgu6kFIi 6UËl* 2F{@T SSI5$iCU͑c~\yS,CxS^#ob=ώ~Kmq<ьrkY[ZzY|cK4~§5TKOLO-X>`-[0O%i'Ø{_58pq(R,D%t-fBsA qԞT+pr"RI^%pAO4AI1NHz4]Cn, ʖ7>,gx@yR(T_4}I_̀䵍]5pmefֻd*7)L4N]5_ӦxBݕ]ee)@*Ń.xgVEhxɹ(.׈ios\oڐN!l|Zi1R) V& <㕜DVp@},]]Ӷ^8G:z}s<1SPed4@Z5 xv /#t; ӂ cs{7G[bk"3Grmm4bIa)PDZ.98L|)=;>.;pWEiۦUS=1RC&;њE>t+h q %qx+z;p ps{`6boQ24KeGY!͵޳ qWlveXmn]il;Mf_k2Lck<,Tz'.--P&ɧC\+OL_@a}93YWC XJy?BhYe%֩]ˮ o"c`3C[Gb Ռب, =Ġboy]ǵqg$P nsV}J}y,P U\޴# 4LQ'9$s.H_;P"J縐_կIhx=Z&!E"j&4Fm %#PY&!>$L>}b endstream endobj 1760 0 obj << /Length 3249 /Filter /FlateDecode >> stream xڭZK%=V$\5N`ZVڢzwǿ>"Ei4MAdU,V}U,v|xշ~%weTf:{8ݩ8LJE)w?N):6{[7׷ߥE0ҔY%KcTbW,u7yA:AUn\F7:Mcr>l1=uå0"6[w1jjOƚ.m/] C?5*}d+n4S{Q {aQ\Vi;4p']w$,Hub .Hx0͢ '`5ѻ%Ked۱ERBc36G¥i4_4n&ZKNr rTF:~"vU RLEJQVN=4J]3n Vr%܀*R׭$JTZV&WD]T},|{Zq_1l&[T7Gm} [DW%m2fkW@]X|p2bzg+2jOtbL QVdN.4vCxH m ô &Z(-(߼ &^ ߱lMِ,9<jƏ>pjKf @ekױ7VFy֎2 ۪A}~LD)wS3?˦s sbT,cm/9)(`@C0a sSKS/[n?~~C쐀n 9HȠ/v dŒ ^%o؅m#6x-V =-VpQ}P@ArrŠ#GbG n>L [xkuR`*[#ŞehrZ `\Rh8T(,4+qAAZ j iyHd}6~[~ H?Zr L TAjlaE 7 ͙* ('.|ZRGq^}Fcs^O| q#%o(Wvu^ aݢ4:tQ<y? $:p܊/~|\o;:3;WAqF#HaKvT#mRZ)b)E: C $1yi|9_L0.a`Iˋ(t!>W\~jǡ&pmx`(\O0-AR/1 br`&P7 ge|B }~إWmj?mRީ0~B{|uh`[ėUt9< D:j|Hb#rd'euLe@"JfC8Ƨ.D22ymd@U*=qppi[3APtq K3~|X":3]*DE88qYPcqyěDD$0(\ s5tᱩ80C=Kp;/iϓ6C1:%@! Bt`mv NM=IrM a_؅6T#nb4T1ܑc]$Lغ\c}S=.]J0ZTK\9$~J<э8B'ܽ1Ri͒CY9} @|HJL3-QVɘ0ٮG ,><Ӭ܁)@wi7P NӬ}bڊ,j)Q J#*sD#{H1p_8Z;4lGfoRRqN cdȰWB/&ŻL=3I2L3"EOr/4si´4a̗/(Q I+BA/s,"x5!7QwCMnIoF5>(vv΂BCQzjVNȷ/r$_}r(N:ɋHbDW/8(z)5Sd;5%#:\C~L[{pg"K҇ \B߱1̬VQlfKi b+ j +'sVN?NZK IB?Z{ %~3ApW"#MÀc Q fp_@xGMM U>aCcաQ= &=2ys!0j1D}pQ-_ʇo\0_RYe7Sq#_':n^g .A ;KLE 5@ ?T+BVі`qKP;2Af#Uo N^(7!p 3L18B}tdGsV'Oq A,sh.yOr3l3hni<XzF?s5!xPZ.pzti4r_L;?MNLddž3ԗ.kۚˆLc[^\%,W `Da\L 8wXNd&RڟN=t/PxCYKf, 3f,%xmJu;~f{!y !y܃JAǒwvE{1.\s}B z tFa]49T}^x̛#er.>q|s5u/.! pP$1n#!ȓ g,1m='O@EPg`8ZXWN@Br_0A\vJuCS&x8*kI7AMK!|шo84px"*VƧjonE/`$@u&Ж̧o# B %RI2GYBulP{7v#'I"XKZC!@ UhpjQ iA)߰c$ nއWu endstream endobj 1767 0 obj << /Length 3261 /Filter /FlateDecode >> stream xڝَ8=_Îkf"d>$"[t[,NoNfdXw; 䧛'/*i MtK)"^WV2n~~R" rucNv*;yQs6H{bjvQZ z856=}es}Jޘ Y=/̦;X"XݢT$Q ٯh#Rcg hB3B"lHGWV aE(EY|ULKLT:v. Wnaa0GisK^Ӭ]p: w@Ca~ciݮ>Zm֞*s`ج+[Z@T \~;C`ŭ@jW7-O]jbx-FFKCp?K@u4n[qvm&J3>[h*I a⸠5J qk+Βhf*eŀ u!טz *eua3-{pv:ܪUVjDU;u"7ˎ!iܳB"J/p(^=6*ObʮCzO:LcKU"IiGў;+nOţ(<m,L%M %Y0zID{ڂO!r{= T,kTZ\6Ү7.@CJ!6* 3y"3"O ^ǰqp!o 'Q۳ZAB4OFΈgQnYAsCY0<B,{e5@r##b̙ 0,l88eq>3XNer@r'-ydUgbGn.&}JVyGc1vu2rQOI|~x))pT3+G4洁;gX"!gL(3Dd0O<p,L9 2xrk}S Gc1`-n+!SKM~1)b|$Eb_1"B 8 LDSybq$nJT }gFr`h+8Epsx;\ߦ,Hƅ.yhzaأ$pAb /BS/lK@\vSPqQq>i%@$]C;&eeAFha<%q.A%kx#`G6gA Wd 2LLR'x=%3qcRAR8FThRbe hy@>^M\wYB6T"})8U9p~\ȕr vkS?"(.>Lp@MkF9]QN҉X L ؇xdH`ѹ%U+L"@\_1|bt. Nƶ?%ZBqԊiO5w "l)B>#k[jC u& /tHN(238dbs U3_`wI`hߴ"6C\[qC-t*yEK¹TK0|rR%e'8wGy<8[Q~l} ;]υ#: !VϔM&\fS~KzĠ^mM8Q[sQmc!zArᤏޜsИcrpbVGt^x;ùܞ,> ֳR.UjU4 @| pۦ 8HȚj' ֬!w[115鏅%osCd6 :]a ETDygB UZ…M 3׿ rk (?i0xx}[^=# &Mz7? z}|ׂDȲ99f>{=U\c%DhjNxΖ%@ 3;;c}$r(5A$vI8{Ͼ2o㐾@۝sSf[Jq1yr ¤3A&g8GKK[ƍ^(`/ hn

3]sOd1|4L.wU}Y,WKp>G @21-oFM GX*AN+z2zԊSH♹X_ւû‰F9m\{?G'YBx oô7Wņ?\54|j>M,}8:k2{,S.U7=_cpe"[Z߬/]'Q3TclC[c5f_lq] XۿA"vC&xZ]wj{hQER&/Vo,*?R]>z '&Z~^@%M<^ ϾSZDž$V#gk|/ S=Z2JcꜾ>q2xa O X{M)WQp?# hÃ@M8O| T}ɢ cP8}G$ ʘ } 5* Tk O\ E͓}T endstream endobj 1778 0 obj << /Length 1345 /Filter /FlateDecode >> stream xWY6~KRwQ=nۇ$DJdK%w(Z&Śל lm-lp;<+Fq@vcVH غͬ7hPgwh uh kQG!0E휧fZ^/oMs|0Dhp@8" &dšBJ4"%SD05ķWWY^H{!ʱ;aߒyҥ(S+(jTٙpaRg&Mq`12wd#P8CVe+&#$F%Eڰ ˃0VejEӜIĐ:A46\Ёgcp(<j&ѻSnw(!-ڬr 'M]my@/C"D6e\}w[5>̲}b||//Ë{ . s<ym)YϞ=[,}mxdҶ` WˢܪIzQ)ԼK .BrKHRem;߅5껥vwgϙhkWISBְ:^y>eΤ ,NQuR1pͮщ33J=s4F f|B{k"/2j& 9vX xXxL4HGoNGq:]wk3{P83}4ғfhq@}c;bkޜ*`/BHq8 !{=qy,(|H @^MZ) %*}0PmH|ue {Gz{%E xk N}*c4%!%MwWR+s(68|; tfYzDù> ^g{2O?%&l-ʢ,[OܼB) gT,^r%}/MX~28( 7toyPW f`װ5 sPQ%ުTQu ':~"Ϋ>$18o+'{]mFTF (hDH}&g endstream endobj 1695 0 obj << /Type /ObjStm /N 100 /First 981 /Length 2062 /Filter /FlateDecode >> stream xZ]o[}ׯCyIX Z pRmV6nmɐddp,WAl̕撇Ù33fvE"eԥMȎC58&Tվ*J&DW1~81Qw2>_T3,m=ԉėX20u[ɧ]F| ps< =d C"Pf$єbK<#.ɧl<_jѥJBP*cH.ƟnáYybآ J Zx_~4׷Wû-M 68lHeh^Ɖ W+jߣ.H9.n6 a˝@p̧UEuo ݛtҽq|y|Nj3`l_⧳_ |QFp'jŔH# An^]U!4mEt)2KOm,3" i3z*LQԖ-N8/lTފ{ɢ912>#=׎ 4Z= AGSV-j{7%]>]n ӎ'Ֆ}svv>/kg?NuU$*?8޶-X昸U͆wB] V2p:PΈ[˺ޣ@!f+,ɗ ,)VAxg'dGk+0Q@Y7aXxYGЛ)?J}c-g2/nsMB=FUH_q:\*CdzL1Ҡ\VD ڱJ)Sחsrq67V,,{kSˏ|AIbv6nD""lQ^ jVE\JvĊT⸙^5T~'oEѓg'N̫0) Y/@Dr tWa 4̯G [7ƃ/Ro<_e)פ2(&Bޭr8- R.+!q *J>Nն)D7HlZj'WoLE+;Pk2`p;`.C£RƞR{j YI_$Tb;{T!aqtضz2Ro :~bjOm}ޫm<*Qg}^۽לj {v-+>+:5M` `d<>AV^Ar!?@};;)طU'.yCbZ=BdGO!_# +F4 6tyTvEq]\L~{IN\^G$[AWKǖmGng6]441*Z.K۟l{aoܲ.`!.T R*eʛ,ݥmhOR#˯}<(ϳ>ݭʭ3y[v"&TR_ %WHiAwS`vۺu+δL*$ zj P }Ni endstream endobj 1786 0 obj << /Length 1997 /Filter /FlateDecode >> stream xڵXo6~_aߒmMѡC>*KU ImH~whw]\Fl,c?ݭg:As`9+f瞛^umZA9n! iv^z XfO3Dai?^tR'IS2"rǀ;& 6HB^eBЁ1/t3zE*Bgv c+YxAK@^F7rWϬ$+u)G=7>Xndh]lV foYVƞ'rgVEދԂl/n V;noغ*kvvQnJب^e!?^2ˡ\m՜0E+&ź;ݒY1~Y~i}5(0#79zu+ω@43r^V -'[j?nVC-sv% [ٱ4j(y*I mn.=wiw z4QlJbI[V_.t7˥~0Rg H:>䵛-gQ'cƎfg?K7eU KN_gya lfBny[$}-X1Ⓔ0uw0/-@e9~d8X>RQ0:F`Txnv"u`c V R;p崲hTJLM|/%[/heŒE- 2.RW72~u 0V@rMðɰK:G;YYWO]:.x~/xAwaDYZ}ޡBTV AsABcv@YKhROhQyi2z:yA:KXPhT5$ ? %YjFKmLlL ץcL-JhKeWmR7R56%:Y3WSJ/JqB{ZrhmS֛$$Gt*\1o?N`Fx҅ /18HUFϡDX[ԞXB&c2 ٙ6 meПpQ4ЃRay+oXQ'fMKQR]#~{"v[|V$48vt5d+:GEi=] bz ?_O䩒57wK endstream endobj 1795 0 obj << /Length 2581 /Filter /FlateDecode >> stream xڥMs~nflCe:Cҙ"$Hb H3~::X,~c)9lOt9K6eXf27ad<,.7`zVee HIު8/̲[0U}a~qZe!au;mooecGpֻz$`1= TCsv(|c;25ֻGG5A7'4%XFz꫶ŽfUve]VTo#K3Hp3L$8F6gD!mjfEA]&5IһiB8ގP10F 5vžI&a5)>,mxAH6M zסz3z@t\$L3'ӓq[R^G%ۡd,Hl7Y e+Shcv4"~k}x=|l!YaM5Wuc,]@j?57ASQ^ #O[I#$ $~3X}/mfE ԩ\U;Pn; G+CRzTup]ޥQ $蜧Mr1eE5 AU |v]s9AIk0b $h,l4dݡHԉjt{02Z25o5doI23e9֣̙!ʡCFc ~@_vgneF)촯 H l/D.l53QeL/BeshlBKw]kT7*LݚI-c;Шӟyڪ;oS=^)C6-䳐s'cCӻc׿wh~5h"鯣 Q \65CFصz㡐hq2}G)-"_e$g)$M*z+x>1@=߬jCݱMb?2/(Z2@ eQx !iӓV&nGh2RH6Wҕ{gt1'fܧ T r_Wlqx B ]>;cv"v;ш8`W:c7^vgjn*jhG9ƧiЧJ  , [k5ˆt TrhШ cp;G&" = 'ӫrwI7kBpDT ' L 7h H `Mgv蚅tAo<`q[a]|^+Ba⟹b%0OEb_Xlz uW[XJث\ы@Xu&^m/ k> stream xˎ_!,n>>ı'pzr̎>U]MRn>&Tz#(TqɄSUl?!=cϖLQAvQڌp*qpGf*QvVfTty\l".K"sۏc2-z-cOh692=lU߽ҎAI?Gl[z)>1!IB1 5 0 -n$Ga&2tt UϴD%Q}z@%n 8V]nCc,X |zcI+S93DRZ: 'e/I.rK5Ix)ḆGjD*SUK0ٻ=h&k || =bF犴`=<<86`'yN\NNMUd!.dlu-# @t g}ߡyW3Ukz˓:$YCU(8=1^QI(sdmS_I vYuaNe4/ES\Lq,ys=`VBvD>͙R֠%4]׏-tխqq?CIbet iV?7嚪8ʋ W$$ڔu9'g %RHZ8Vdq%ZX?epVF@eg/`J5/i̿תg6u*viol G"AL$mC b>oc3@62(XT*͓dkeژrܬS$H ($gD. @ B$n3_Vt̡=\ڴ u9 >B,\1Rly,6fbLsC_/mam 3 ڜ+8Zy\yȈH FlW1@7TTo{P `'`۔/Ãi*`A]3Lqw HmlHr e2"/US@)wⰶ6z.p؟I ~2GLZhmC|RYyr9. * &Jgf0uz`뎒ǚ+[+ś9e+ )\- @M_aQZA7=W]ְAζ 6f4?L*3_yypu]e6 D+j."@Qq6$/]q{!kaSK*'RjՍUIv4o[;VHs9`k!X-ߊ4a"&WU݌>?"X(O+HXau- XEdS/2,"5x}/Rk|_(j쥎 = DL>VF2L&(Rrl 9WL/]H,IqA. @˯S+Gk." o~kN*!G޳&V) CS/^`A-=T-bOMkk1 \2cS*&qժM٤qߖƬC׺j04n-2oIa|kVBi>o :ܲ%1ۜJU^Ӛl`r`a Sl7WR&2r4kAXHb0r8L5RB}Tc52BUu2N陋=-]5K7kK[Ѭ\eLMyV Zx?m endstream endobj 1809 0 obj << /Length 2533 /Filter /FlateDecode >> stream xڽYͯ60rYcD"9@RbO[)Pڒ+K^IN_P~rmvD)r7Tyě_p;7ȍ2FƱHX)I}%:];{.fo$6a?VJ^|._p,вlURS)wIF= 33:EYӰ?F\kK=TzM"MIIb I|%808wefV+Rn+r+ѤJ`;P4#cp\:""12N#=x%a%WDӆEY-`(35Z`pQof@tw; t03 |{H6SЇE.kv@cOux\VR[>m`Q$oC/~դ_q"%,K*s6 ]q%4BH03?<=[ώUL-`,לVsXKA<`|>Si_+}&biPcZH7޵ȧzSiB[bmx UM4QBYu^+nHW!v3u#xF?q2:*-/H#-ܨ ˅#iʸRU7"d ^XV{Ͱ>-5?~Zfpd=h6hSW# "诓-FٺP}.^&]B?#XπR\_=ׂZJގ 5nULCHXS|FZ2Z|M[c񁗶־蟲>kg3 8aϑPQ~$Nxq )1OϜj*󳨩Bs2[֤Ov2xD / [+1 qJ[Ħ?îawG1ӍXZ&1|Uxx->].׾dg-LYo.rjgfln݇ELCbC=g5x|sj?Tn[IFfc O\6˯tU>:CAYQ[Wh=IK#ƍv<Ge:йC!=-=ODe0ڏkVZ iOϓN wi2]S-Rq":q^5eǰY/@5w߂3ѾBE^c'J%Bv }ŞLWHf7:O&,{% ճLJ ^8r$|x+ɩ+i8 k.񥆨$VDp]LhGJ"Ƿu7eҥȚ/(ׯyfxc~-խGY5Y je?'K> stream xڕW[4~﯈*$Zm; ч]؃C!im tc眖_ό/mZ+V{<I(nf=yxL E` hx$`](e??<<ˑjQe)2JۮJ;o ('<(ɇ IFw8 &?/Z82wH{1YE ]RV;ۮ9Kf/Ma|x(YLhZ 0ס} U|%Q#Pta\ClVܬVM"n|$5 8IgYXsSUzt8S1623rۮ+X_Cq[a<_:\12W^ZTS'~]$ʮ5qSJjٵ. m 'jTNWv䭕o@ʊL(|HwJh[H@XoX]}j=7Ж˘~઺rm6bB4mD9ZͰ{#nĜ&#oP ɊZm/Zk3ǯˋV܉eV,b~F`? 1Ym'-rst;3z*HC&2c#gFPRk0pzsySwNmexi *<=)Dʭ㌚2{;ʛ h#kdh'5' Mn" 4mX|we;_F.<3FQI/h3gDwn "ٺl_}} uN@⼸AkaaY:bW\c.̓7ϟ$tnIYސFh npM;fPIsmWGY0Ar#p,ُFY *erR7,|ڰJEYM:CDبx-IYܽ &hygO͡r0#f.ϽeF}lX868v(1Jg0PQJW¯s})#Evxw/Xϐy+`4A]k/˜f$}j+vz%/s\ k' ww/xQoEBh]Ӿ{{hyc}o!Xbm3@ endstream endobj 1806 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpvwx6Sd/Rbuild70522141f9a75/metafor/man/figures/forest-arrangement.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 1819 0 R /BBox [0 0 720 612] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 1820 0 R/F3 1821 0 R>> /ExtGState << >>/ColorSpace << /sRGB 1822 0 R >>>> /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}쿣5 endstream endobj 1824 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 1828 0 obj << /Length 3350 /Filter /FlateDecode >> stream xڕZKﯘ؋{;,e+d"L=EC;WA0)ꑕ/⻿oR{WDEӻӝ.S*JMqX}8 ch?>7I0EeEhR'e4Ag𴯞IusWuv$$n&zyScMƢ\6oO/ R: <\i:ՍkǦC&a襻*{iY%Z}Z| b3+wve;Vg*O9q f"EѠi,Sބ-ڊp5:{wx9hhZ|eY6xxϟٛ!cލ`gmԑ;DZEF>u+Uuia]g;d;/Ek7JmÃג~"}mUEg"_`+zGJLT؍G%bcYhBc &szu!39nbk~&Qb/2,^k(q P F##/OBm1jPZ“HCA&rJdf7/hb0ECusM?0۾nZw.ҍ4n1SШQU[ >æ彎UzCb4fhC鸼sBhzLF&7k7Ł[,T+> nx\ھJpȊf9gON#9Z9HuԻ7TϺs%m\a b7"E}#?oX=?ԸvÄZ(n"v"Ā=I9eY,h{: `s9r`'FrsxFGfշ6DZ|oV."n>T^O;m@eg mwO4oAFMϝbgk GIS9NsOJ4F`??:dk*BԞn375hnaf3} .~z&3$49d;VkRX+=f/jk#,C:4>)l$ J~tS[0"!LWV7&? s'^"80|n]މ7K" 1YIM|;н,؛U{b@o [s42勋NmH~Ȧ_E05nNrP8JTaNcn 3$wyp=SI /sqp0yd)4Bo "9\xveߛtp"VnjƩ_ڱ];@w f٘77fLw*@MIq>>~$؞Df<$ 8uj|)J%Ow6+9FWnn?_*/W|CO >c6b;ו=Ϫ`޽L92Kvt)WE53縃TF7lRB $JEK3dfo/ 5G9&t•ƢGM{8FGV0/0eUkaJ-M*rlcXbFocɄ JBuɥsp(BWVcxuMD;QdvTJhl^\ bXjY&ZC6I< >P Zr.HO;RA^]۹i*ߏ׈?, ěB3];R tYM:#%b6w]Nekʱ:7葥D3V˵@42.vaz@ |!8\7g8J:YKP2dm0TC8T^!ldccnŶs`+ -g,j&y$pNK+ϟo$k̻jNǦcD<;n|9zA.+NI,vDƄ,^dmb?'ՙMӟL.vAfY3w)̗h8" /٩]I3x!8MiAӆq~Db _=஢W\3:gՌd狿aI |it:ZMn">V1 *ImnvkԤmDǰK('EIR=hƔrW^&+OFJWݦy;-b_B.PnE.8+^qP}DeV"`D^IRY])#0)cyFv۠رhH+u @>A\ɯN<x5M,nڛ|/ iQl=( 1f /%}ۂ=? ՜b)-8Vn2_xh&рP˸Vh٫Z[d0M7lJdDn88/p"75+?'Y6Gx %}'>?N6t-EHhP_%87J`:nؑ%%/k>~D?~Ta/|L:ֺ@ 'yqPsp`}G6y+6g&3oC~ᡵ6ϓjFՎ5ORa#]x#t4ס(׍еZp ,twRګ4V(J-E&Yzmx{xcW?}v/%71/syQ6ILi9 endstream endobj 1842 0 obj << /Length 3087 /Filter /FlateDecode >> stream xڝَF_1C"3=}ĻM Ǜ<8L-6E $oUW5Er$CwW_uWQj%/nҫLd^ﮔ*QJ&z]\Y)e׿؎D p_kZ=+d& (ʾlZH~yus m ɏ͹hGwʷxtǧ8jPIXJg3-j8չ 60?:Z܎6߾7 ;m:Ā.ӖCO㦩:N/@x҄^==9L [PcP&Pg3ϼ=V$}B%?1չ`w4"z_|fDoz{~ɫ&r_IdRcOrl\"Hl:2N/%WbĘp`;O`eoXfR-4ctZ@Z ki▱s `E+XosUP3MMU33zִ䭫/!%bQ^+Appia˩l0A-9",~m L@|6,*`b/`ϻHUތ>t8v,~?)w!0"6C|[s!^bl!)s@5-2GKHU<2t˜ywdoNVqL| oS9oap)lLJ[-."FD(Xl?r۠4&Q87j10fx똝 t.t2ɺip'GдzRGJ|Rkq3- N.:/*%{F~2)+j"ݾ c\j:\ Ksc'5C Sg yn=QLN)M1ժ.M!m3ҷ#ӫHGk۠sio Xܘ6Yv 4ÀЫOZc_tV(V6rS99]O߻3%\OStOES~V BY8g+g JzrC].xOoUcKx6ŰdldS4‘N9д<=xsiz-I42HgⱠ[>ZdFvKUdʿoo1KP|/}BIɷhf,8)=MAfaK; )x%Ws-DҀ]zLAtvY\('2Vnrݾ ^`:9I}e&KZplR:Pđb PvLG׀ v7Hs ^q:i2cSl{σ} HεTLR|}?)Gm@'Bh&fllPOHZoB1& fSJqc+3CPLF>w5& gY`R~A*^CRg !68>Q(h #x! TzCU?u_ߋp\yHa9QBo/v_vה3ybԼlyA g!u 8:K&Zzl|c;4>[:xb7Dj0_d݁6 4I‰p~tUsɹ^^ P5Z/)!v$FQl GTiLߡDhJ[o7wx#P{Eg>UY'8Z]S: Ꟃ)һ}?D0;s&5l&YRYo!"mO١2ժhsl]>*M\|d\,ȧ%~Z"X fb >t1}nDD,/Lo=IX$E1̼l ;$RvyGSaO3 ݢrõ6{Er;n;WMBRh>o%-+:jMl5IOcܾ:ABZJJUOŝ (~Zϊ>vd0iגІJH8W@6mٜyf};?Ȓ9tQQf B>ADT>5  2T*ׄ?:x[.abQ j endstream endobj 1851 0 obj << /Length 1224 /Filter /FlateDecode >> stream xڵWKs8WKR  ̲LSdm6X$bg~Ie1~rG_o|2bOh?BBԏGln&$jJzcϧ/AS1uJ~1FW;FP`U>7>AQhM;F I씫sfEQvj&YB`) aiYEK[C?*ޢ`r֠׻56nVy%=cIޕeIW༤ӐX1&=S'H78zFIYn#f<'ķ.Wzc! O^Izxzϊ:m.ܐȆ@ٌ'{I(pz{*.i7S?Ne.7>5R.k抁e 0 .ۖi7uvPKR'"76 #~|T?N;?~`oܼb8%umM?Eƻܰ$}6tȷʆy\T#8yC 3} J{Jѕe']vsGķĵpg1 /;;`'7M_!u=n~ endstream endobj 1857 0 obj << /Length 1203 /Filter /FlateDecode >> stream xXߓ6~C2S.\g2}yAH~^ I 0k;]v?/W6W7wQ2[y8g ./WM>͇ͧxa- P.h +_ Y"6bFa b0Gx:o_M7# FL.N_H@I˜oZR\cǂB%ª"T̨V#bZ+'=P$NU]^T{"Cz?y@úsrԠ8Lv):H^j#{~g|/0"υ ~?TwAjF/La| i-\n51N LQLk{+/rqc]xQoyt):Y3mPWOw0VKrV܎T< uȋ?yVW&,r|\ٵ'k7wMp`eE9;S?sRhNGOB,(wn2Cn P6R rInx%(ߛ#"2v+ެ-R+os F߅*c+/90mf41 2M`=ujV:epU4H aRvfM2YԱrt'ElΡ@XDZD5,ų0s@P׌5.2aDB+{&'QPc)Q4[d$.4OVU BѾ_l0&?ijX MkTX Xurup &dȰ'aŠG*evOIwyLB~[9jx֕|S:}cxx ?Bgڧg$Ęd登h k|2v +t@dHȷW2O../3Y> stream xڝXKs6Wp|3-;q99@$$+$hIN{wHv^vmm-ۋbN`n,j+nlfbS%է߮oht1𓴔Htak7kE@ bz冑$_8Ћ/Vm/;2պK5c/y%jWC[.*f9HӬ};cBڴV]K5qa݋I\%E"}3Ŏ?Oju_djcM[5]}igŎUZበH +Wj] zY׷<|RȓCUTfJ4 9ZMPѰ?i\WuҰNp;gGR SSzF4N /뺋M%~d3A˿ĬZ)'*|D[?cYǷc}JbAēXgx2ƩyS&v' n>ɱyyC >aI5ݞ,9fsgx}T㶭&ЖȡXRs0c&R,6ppFG~NuVwM aRϣ/5cQk9x7OuxG0ʜϚ4 tzdjNrMQ囍./44(3~Pix>, (|n}T+{͔_Z< ۔rL)͆BGdtw d|K-!WaHGJv; }>%d!nbSq5O>N4f¦*1j/оCp:ۢCyCJˋOG`E8qEgs-p)k:7 Ik(mb:j T6\l %Enur]X$ 00J-cEͤ9ԨZs \WʂmjΪ3:bA@xp=X fd)zr[by5cCfi+[`\lG98_CL0|F!=tCT endstream endobj 1876 0 obj << /Length 1961 /Filter /FlateDecode >> stream xYK6W(1Cz!ivKZKʒ+ɛ3dycYA574_V|Ë/^݅*ei$}9g2VH|_E3UƜi Iea(}u'x#CVoD DI{dy'gKaN]F7MXlu>a_t4##^oOuN">4 wC s`=U3أdۀ0$&iaȽ7&T=}]е&-qZfUhGsxŗi;:\cCLY){Wqۍ-Xd -Yn-cow:;\l-_D@)k‰>4'}}Զ$"0b;Zdmj]b-*ňԪv(lw=6}eXڻ y}ڇ6Wz23}@jclCKVG_& @ XbעI0 hwGpګU9`ԗ U?W7ġ'4bzAvhᦷ3mL %^*e6Ϩ=TbEpm菭@L p5Ey! >͘l6C,iRf(ɥXFhJT41 kH4h JOJhhƥ67d\ 2+ 틾k4eEH_h/]/\/ Xh+s}Е1@jF]1. jDYH4 c49bQ !Kڴ"Lbsȁ72Bl1΢LCoZS3)d :֚+TzUs< DS;[Kvk_yv!{=PYm l`|iC)KLC6KY:/A 2 1) ao\D몱ȴeJ4(t*ۖhcX$%?XY1}{ILn$]O"/8S ΔרӃ$8<&6=z4$XYx$KR;JXՎ(Bq,iKZKXGI_LWi F;uzR^o+~AИlwh:Oѵ=MCEgiZԱ_i18.pbRbvJDSQG0rLoa &U2%(RO<kuat`j[3ZP%c9:'iq͍@jyރxEbwkSƴP*ouBMFΗbFƐt*(q1q8[%>7WeMJ*r@ߒb~] RxkHF[+z-ڵ㆙R2b-V5 퉆0@$+ .ȎG >:-e;1T*֩/Ft9=s *! mrj=YPLzkyI8BaPa*p*ֈu&/oGʊØ E0y 0𽷟h^^PXTB kݛ~}`0a;GS&u~{YBu gRQr 7TjWK C@{ҙb=qkq܏*7j%:djJҚ-AG l3߃婦iZ.o%pӀiPi z;y&?FMB 0:O|Q#?wf "l0 9TU^b0y^Ey~}Hg|f_ Iqg endstream endobj 1884 0 obj << /Length 1140 /Filter /FlateDecode >> stream xWrF+PA@1 $\I,AB! r>= (%q|fyx'8N␆ΤpƈЉA!I\E^l Z/p(cƄʨZ~cY j 逴ڮ"n5/^&˩S [L^'|m2`SL mDzE`5do{Εv5rU-j<&Z0'!P|FS]M/Ӽ~ /p<w">eň=lJ}&6{*6D؃^.+j}W|s7LCheࠤէ{KYL?1$Ƙ ILۆ:{!!VHzmo/t|һ@N0tѻ &!bl "tܹPAG(urP AK[t!$HZP4rIEr+ 5)@ΔBgǵ rX,r4 Հ8B˯y˕,KxLZCEe޹"x:hqQѥ\Na<#z2Ѐt'H@iܥqXc ]It=0M_7\,fUom%u 1]ޮe6 azbI;ё_Wpa+ۆz mR endstream endobj 1898 0 obj << /Length 1397 /Filter /FlateDecode >> stream xڥWs8_8sA o4c=4 c٦C/ouӻLX?vwW(qRA<1a0BPLSq|vI?op H uUڂz+lm68wKj=Me#Gϟ[J& ZE/綇I9K"V/"k6ϬRGA4!:3FvuЙK#>a )">q4[4 06϶F۪-VF^ԭE֥X!AK=0IbQGVr*dJMnJ՝h`In&Q>`Rp9/M,&Ȁ$BՇM[sSͩ 4A<IH~HH+#5yʽ,y1A$4BQ@Ȍbep 2BQeɫj,@!ac.E!sSԦIQ{! tr^D6?40 >yip~k%Ï>Z 苃eGXSN(CzpmU@ט+b"c7ٶYv7;pוb/T՛?GHvjpȊwWgmj4{|~8P@E&kWF܋*L9!vo1!V뺾V3]?;#<,Ka+p#eS7H3K_9-e~VZP@@$ ('mڻ7~/ZfAb?VcC,\~UZZ=fVJWϼyEOD2E@;e[~vcf_IZªEv雺ӕ _.:2uggϣ')Le>.+_@- b J?R^cܺ j6)%Jiק@u;_q endstream endobj 1782 0 obj << /Type /ObjStm /N 100 /First 979 /Length 2316 /Filter /FlateDecode >> stream xZ[s~8CdF3miZ`АK&)$ɃgwooJL2b7x]"E" 3*ȜLD$-yIeAɢtG4R$&Hk% ,&,Rꔢ`>{d P.Hdi!%*ɴyE`H<.|̠DRf:F0HyAFS%#8)LY^`&L%fV#Dh3+5IptD8ȑd>[jq/:{1^IΦG$(O'@)r49cdϜ] ޅ^;f[l isy:P,V%PyM H-!zɼ P=D@| >O@A/`ɑ_Vr#@haH+ =UdI,ؐ*@0 H`fIR t ʓTypH^\AE DLき(+vJV@YkԠV8$GPR./#B_oRq@s~efe-m=m%p_^v XxmuCѫ 1. O2oˆ3- [zăk-͂ҍqW.|X.V)([9gv/q#Z[CQ1j0ڴbNkH_8 a .?4x]G< O⍸Wb'*YnxBF2m&*[&~ a'bF׳ :MCk= ]{=L6;moA-#D}~2ŽR# \:*EI{⠙æϳØĩhgA4A=56aGJ0%KlA24c8FqI5G*J6d }%>žS0G+3H5:|KdP39;m1KS4ptVh&3VεGY* M"cÆ<KsA7TkuD}o GG$1$FÝN`dS+ 1QyѯJ7 Qt:;WYRo?пWOM3[|/ħOlzl^y=;j9" 攋IR&dz"V,NVVd/QȜFݸ5՟T({|߲պn;9W8'Wn":+\|K-I)9*<8=>u>!(®׆$-t2dԣHc R{.vʦW1kK⎾/tq<$fi֖cy,{kPaAU42c}<"en2S&͟wq{fiG[v=I{Kyz6 CnvKAnjl7uphҙs H ɕݷU;Ȗh炠{N'm4dfQO~=r rR4׽'iC~&ir4'| "YqҋmS5)6XI_b6N G|b^GiƭAk.zfLG}zL>wCgzpArݷǞw&'ĽV#SGn<ߋ}Pkm-ؕ; wx  =o?=Xڏ1opđ:wWmѯ֪8j endstream endobj 1910 0 obj << /Length 1992 /Filter /FlateDecode >> stream xڭXKoFWT>]@i(ڴSZ+q%Hb3HvlA73,6~͵dv1Je#Rdm}jot0Td, ~W\1h҈J%I:+K;;tŰ~{v!ggȘE2IL4o:IpJf(7zm GC[ẙ{L3xCfYf$ˋMѵl(vC5ag}u^#RJj6+Ioy19Ofk_1S:0S’뵷RCltG*ܯ~5<&a9bBVf|)4nbAL:PƴʋjZۗ+5BZ!J(B;/6U 8XOP0r?EJÀ¯{v$NBI~Tq: eJJKV[2N}m\7`nZ׃ڨ| PI1 +FXU~w~\-KzIb2=ΗHI AiJp:]4fyYeLގy7ɿyhVۀK=e+'bS,ZHms6[?xU vٶʺC^XzJṋSб7m`u`)Cz(hp)V$V|їi!o1'(gh/2EqrwݺtQ9S gSYIOu>:Ѳ0+o ǥ7^muiͷ ̳9޳2ok[MmPK^sjF I{\U?^4ľZm,@wuLYd'Ȫ*r(!F1 3eܸS}5~*&JCHQû()(X9\C|Flv?Y] CͰNH& U$eǴ殨`1I1 8k`iͤlQe)IzL3Xϵ9ksvie*(nYX(gQA-.aQξw{2T8НɉxIirc7/)[ =:O&n­LL]^l8~6#,X]0n7|6ȑes`*z$u[,^+y,-&+r !l#w 틯qe8!ac8fxl50~^g^O 3h>50ad66YC ^Vl )l6u(()GO\I*{^>B̥nՆn]^ -kѲ ú-_712*d=Yc!M9If33V#O}O8x4#/<ϷLV-PAq(6˩#GʗɖjEXN سZ1Ѝh0Tesg_; b/v:< <$p U|9GK`V =y%(CoG!09>O۫3  endstream endobj 1919 0 obj << /Length 3124 /Filter /FlateDecode >> stream xڝZY~_ؗ"u&K"2 $ !`e[Ȓc:_HQj^OEV꫒I=}>}OeTf:{z=ϟɒ`)(J D.C>( `M?: /C=V  ΊC\FּV&ӻԞF۵:UTwG̵sSTcGG>V;0TGY|Fo*ռn[{hyjwaζcpe1V/8}uuD*Mõf\ĥٽ ԜyБGiWs} MͫTֶ5#W$8DSCQ8,GI N:^o5stS3 (M(VF,crt1tPU:!Rv)\b:%^-c*Uz_rB!Αe8U S:@1FE%.m~6g{Dƒ)jx50I;VOlP,LU/N#4L Smqۢ't=<߮鎼`%wpQ:8NLzrZqA:xқ/wn"~bvaYXn]eJƹR\)Z4ݜtNPdt5I8(^{;|'Xa}> .͞n]l1s^#"RA+I"]xW[8SF"JG:K`NbQ4*.ݹn\]L\Nי0z&j*:Ȓ6d~XPa˴w]qуa~1΄ / _ *@D,xvC݂qn_fC_% "܂#^ 8]~w_y*[(z } 5ޣB?:%$ai<\#dtF @1& QA-p\fK¡Ud3by3kT;ΤB֤3=ږ X^[~֍#yH&wG&6S-"C#qYqѢ {&Q5[tA( DLFr-\c1ޘ$^- KGjJ\ ܠ8sA=( alPz xoc7 ާ3y?;Od;0I;$],"Q"ćؤU-=v2/I: 6|a ;PV4qt=<݆L! "*c_ ]Kqo Uzaz˜ tu@8|@2ξ}pU~$9BF<&͟)ȯ@Wίh3ҹW`Y9( f0{ <ŌHYTs>Ew[|Oa@^Hxy=jkAzm }Lxԡg72q\oZp1b 1~v/#\ͶH#/u;i*L{q7]GB/wo˺$VOE@Ec-<޷ 7dh⩜ endstream endobj 1926 0 obj << /Length 2522 /Filter /FlateDecode >> stream xڽYKϯ0i%Q`]$tA'9ds-ڭ@=קU(Yݻݛ | U|UlN`ƛ/(7a"N7Y(6ޱoILEgEIa$pһDIovQM.c =5<%}Fx'ըNW9TmCCƆ[=QODkX5D oUW6̽a}Ku§V$A+>{|P,f:*dwRÚ"P0ZRf״xXxE R%yUM;0rP=&a\5y<(:Ʋ26 0@91c]ӄN >6Վ5hV{pFJ -,U9ԜmچfC=r`kpwV^ZɃl`j"9+»>Y ^\-40d"XsT}u!GniО\ȞWCu;.s/{Ն{I<<SܖoaM7 ZN"LAr0쯡^Q+@ εqlj @Ȃ"?ϪhsT$t$9z:.*: 0Ӆ{7Xg[[Gj[Sc)q2Ud)9kRtr̹g31$kEx: &Ќse76~64 P+H(Nv2Y7+bKQ@ЂWH?78zPQOm%v6vt]0U0/ 00$A/3J;5/iRH$ ??tKw58jfb,8j}a0CQu LS s!>\"xzGKqM \a|`Oܪޙ\^2drqVL+l}T] Լi M- (LSL؂AmH̊րo ThTA2F0F$@iR Xa GY`kB`o-cբ&co++\pW퐤 WW+BWL'\\^g{$^o`V'|]E&(_Dq?`fA$r?i8EhB5:ꔥ7Y r"I4NwfL nx#TU{F*-t?5[,w ˴h=a=R395^e39)_^:ѪȽX}>HAHUHƆSa)˥k8G=Fq m؃z?QSiM;HPJx?/0|woW\'.<&N6Mzty`R"guRj+FUI\en)*tjxT:9$\%UЅ.gY>թxiH9f5$idps2yjm~f"'B|!˔ߏSݙF sI ϔ\A+pԹ6,tkDc~v327/d:B< O(A~lC7=>$R4/B{C}Z~d4 L}=;K9 R2Mҍ!B v C[@6tAD/&Vh> stream xڭX[o~dk7ˢ.zshOm>$}Ę3H~fg>Mh K" 9S:BH%] HH4 0rDzms=[͍aSѽF!(WOtu50,2寑A0H׋X"dv'֖R-.d< =M~\:xSfEb1A ۋ;Բ7w׻ݎ5Fc8h9i!e,#͝v=W宨^h \;6/M-8AkV,ut6|ϹbV#;íAInWCZM"e Bz4+m@jˬTB/Y}"/Fl`-! o:[5`a(Wmw#H\z B]QEʼ2`=ƌC.M̊ .9Wj,0HYgz).a2#cbrQkE"~$] @9Z5q-mOo8 9.O vv#8]*$S4 m 7A1vuVkXVu6z aԧ\:V`2(3*:_]+[aaUUK(ILĹ};qiuy;_@Z5<V<3Lq;{qg/-J.yʪAG tib $/ ?wHvrw͞/ gqǡ>@ˊZ|h(;So1*aOWH L^ae#a#&QrƹP&%gQVO84b>ŋ5Q:p |@g}DpK$'8n:~;vYڵ j>ncզ&  T=RD2׻8=cqW.9ZBmn"(=qJ&Btx ʫ 48w:"!.j[㽘E^FQH@Y@F"|tI*ƎbyB.(Ӣ,m'{xN^l5|%A!@3W}S~Z3>B]RG]Q'7.s)ޭlP)B0^/4tXО+=gh3*r84}o2D>ߴo/&~?@$1>w///wLCK˼XФ̪G?hp[mf[J_=e6 s 7Kk~LPk+V W_M` f7 V3x%l2]4_s(P̋d?n|l9{QRs_|ʎKJ `?{6U^ΫiIﺋET[r\֟7 VZ.l}vehaAcJC tnf (uJYRVh G»#K"sw(1vXDWo@0klE/j]qь-9rUVqB*+Ӊ4'l6Jt\/,-^2 A8~A6 i_~I6)(*~-eJ^>+Y~{+ 7$)1I+:&Wsڿ/MZnZjnTbjJL EœǢ^Ge۽6tz1z;lk9SЁd&<^=Bۇ!$]Xtuo>!> stream xXݏ6߿"UDx1NUw[]U}U&K d7_r\rJ?0㍖#o7w,(f>=f#ylbGI-KQL{F=n31|اƳ;qZ"1~|)^{W5pXWGtF=oWdOP 7じZ4*5tVՆH .1:|5a85wI 8%dIQLkf.V ǢpxjW@ V;Rj:M aFlFΩeMGԼ}kxNe޴/x|~[%y6|߈ /S^cOZW<^y)D-2٪қduP}MZ,2m``_*ˤh :,ExI:әzDƷEw.m̓h[.@-*Mw2)^v,8Mꛜ`ؔx_O7YnעlId2KHlT&B#oHQY?;m}jKIUBn2˥ٓ|)[2^Lj"K9 Qy<` 4¸Su Q>D:Pp:"ֿ&"! Y0&qH`>AuUKcQ5tFTe7LU) X7/z[WbHv推a_/xlS` 5QecT湰=}6 Wa`OنLl}JS\ecνDi7h8nz8s2FO`P3b~4D#ӶwhiaE` 6Jh-u莤w0œlouXԆQLӺZMs]on9IM[@ˣ)BLl3Ī~_6 `W*!P^< ΏSUz]qՁA]/<@r(b<;` }zP|v R&/Q-ǏQE)bVy%muֈ$z R,G~\'cC(=xGR(E A*Q;V4ܛ'"5Ui4(b?SU@¢` wX>ĥ?|{צ {U0G\M>)Hed[jެ4J}+2T efERB8[_gEPMa[`ֶ)lVm񓽩}Ԝg]M]m&[Jb_rQFGI]#A%Vj@Ÿ$;a!v`S^%z5rYpUP6"+8ʺ]S_>Y]]kD#N W,Iz!&O <҆Vz• ^m .J&3mڎhcfަL!lS٦2f㏧; o yOk!_oo noolU endstream endobj 1963 0 obj << /Length 2509 /Filter /FlateDecode >> stream xY[F~_a%f*(*;(]dP<ίsfzUcuX}xx>JVazدW*Xb:Ϳ>T^M_ZW8oB8 "Nh6T@>۬ fS&=9eSgf+C Y.']H }#Yj.LAӞL͞ʎVNW#_{3y (tɓESfFpoU]c?/Ynӻ4k}\16[ݥ&.V7g@Auf5T ؋ɯ"Uz#UsZB]͵U\;DGETH/Bhʋ<̈eMeBwp"2/u}9f&~*u7XF})k?m\%˱偬.p5\*Ciͥ.P׶ oYm֣L&fLyߴ O7\u`0cDrgf 25yx9T$_jf=M"XBDr Z iZ剡-eq?rko좋 *HMn( mgf"INhF:,ňG8)E -Au(ST'KCR~}T K (ŕϼ?SH1,DwG`5˅)R&m4=1o4ZC9k_m8vXg``;P RPxN"s ~אA杭@[hv; ZO庻v R{A;Afbj@ ?\YD ߪ+H5w9W  lVF6׫"mNEܔpOڈ1ڈMƗ*)>/&Cd.ZiKB֌Or:_7]-JnC86$Tp:wMaT>f*c^TP2ն ҷ5LxgQ=9V$q4do Vb璪sK6$S-x`M5qkj\aB ڀ!`״n9tflg(J[OO$Dx&pQ['^h\/VUh trM&>џ7gp_@7}VAs8ʺb"JL@ [%o)VҦTDX U~|x? endstream endobj 1971 0 obj << /Length 2795 /Filter /FlateDecode >> stream xڽ˒۸>_K8 &Mrn*IL(R&O>gwS:@_WUo~U&XūJQJVS;׵n&@,IYNnB>dZ'۶V Ljvg/nKb_2 磭۵I7mm*`i(>5o0y]\mv.zOSUF50,3pتYqhWe.jT;Hghx/m[z/7/YRi:gΩʑ|ag2.H*:afDME2wPP K~>ef ,Fq W&٭_86h!JatdFap H6C),h E#߈ l:> YN2x ߶%G9msY450e)yK֔u_].;(Ѷ@#욒*KG2@ m`O] HmޖGyW}J3aewخ/TޡTUƂ "p}d ^SΞΡ*8N,RWLK~3nhs\xm5<t@ !>64O cH1!r=J$` ͍<;HJtNypOrxa&•]g[3V'Dλ|D*5"1z2V2EjI\@ k32ǀ^}~VRH!l t"* džh8؅e?s]~putēJ2M:ab0!c "G]:|۵ [r (v DD !4yaaȤ\|'+Rq(H o> X:KWҩP*axJm9?+D$ dA?ѩc%*!Jz[ ,u`/5"tv\0mPe I-Q0[wJXQ 0ʹrNHC`=M:Ӏ9Om@2j|*:ixDaB|xWd*͜8_(N>$CmͶCWR*Rli)ݳ| q|>1Zu!]YwIV>747o*[^dG85<#tܕ!q ^|L`4CENs ̐oGyOӹ=5>K(,C{xTzp\.Jh-U\0uݯǫB$BPDPc2ӡHҋajEɪ޺٭ ::!q7k,|}@nCR„^b4: 3-#Yn7jcK8ظE0wyQpq@G7|&QB5gNaK|D߾G `&ݓY(hc|rŁ8t(gpyAاDz?9놅mk&?!TJf fźKY.SCSn %d)aMph6&I'\SFJn4Hlj t/ A!Zw Oz&ףmtLDUc8v-d엎Q"2CeÄ@%Uz|.*_Mlࢻ4maae&_{t8rW1/X|! endstream endobj 1984 0 obj << /Length 3444 /Filter /FlateDecode >> stream xn|ᗮIHI:CS]ګd-m$} gH]KRR gs'/ŷYqQ(sq{w!D\R ˋ?WRWߚt2UF@nݱi}H6[qrԴ^R6UdUug7USW2[zQkYҮ{Ѽ- ٻ+`}Xt6%ɒǺ"h=@&ER|)3SQOH h" 7Iqq|/oڮmusu z8#Ruul[:rG汎[s{PU?U=l׵/yaY{`'?i#li;>W(M ̃mD)CfaqTkomLV_?Sd >~^ zSwpp ʭkU?~]+ QnRd\bu|Gd0j[선+#P2%1節Qp,NӂSxJ" ;1}V"uyh׫ t6_m-LY~ڀ6~أ?=}@;&5|2VoHT )6 8[Ҋٵ,5~#E'Ō51=* X#X U)@BX%*@/GybEZ9WkrIc5"TIPkjǸkt>v6֨\]7#j4o^Synv+P8ww E9e_FhѺY.4`G#gܘ9۟~&JQȥWҀᙀmd A-sfyldBq&\bz .:Ƅ *z=P@}et;R .S"]z{ܶ%IԖUz:}ZTշu<_ E3k8zgҠ1윛O见G1GaYɢA-?i)]eA8c=2pBvS=SE\(.><8Zc<~!Cgx(5]{oiǙԉZq/KT9\DQL0ly6I7iP;{˜3!ؚjV1.( {8f!-x(L9Q21Qn)D+s'(  o:OlQxu^\ޘlK^z[ñmQ v;7s{fRvL$?^-$QwQ"O ypÜ?aj?ҢH(DJ MY|;3g6ypl}l >Ck 0&\D8}s;0x3ԛ!MzT˼zx~51ɱPx'͔k8VѧmЄɶ$J.o2(:r/{l@N-YV؆41p"(X w*PCZPrY D}ij\ CΞaP QH7bq:&kiJJB3ILP(誛/hUQpфϜ9NŸ'Ax>R?7BO~x|`uxID -\EL!D XYiT(i-c)<8\B.p1!zmY">RCA&$=,Tfr> FU*:G γ-D:[D[a QD{} NL.Ux&亞h*&U`o9^fjH*<)Tc|qd` 2KȒЬ|&~ĎdX~ eN-*@^گjU_t0p*h3j1nƢS6g-sCZ̈́!$6ul!~N7 pRcdN̟/0!/G<͜vceqvɳñk,gc7 |zMQiTQ^v6dC;D];.AߝtӅsټ<ߡV`|؟)#Pk}F/b<&5c"`5*_9P_G]],TeG`]|1Idg⨺JN-=D̓;+9/srYUDy%'R™ Dۣ_ r6Da%J甑CW.S [jEvamFhW>wqbLhWϧ2j)!̭ƒ @L"6Lkl[:Y\C'5t8x@;y_VlmWK)^P.r\QPr9\Q,jKHlg!J=ꇆ9V-g&] HwY*WrEw~h Lʲf#ޞz蠰HgO)>,pu=r>MrPe_% N[ֺe: E\\ afCY5!(+ SLgPKohf<>ELepHpvo'(~uWോbIr]C[sG"B/'WC0! 4fƿ%S/h6U)!!MSc)ޣpF Ez҂}v  U >MLs o4Ʒ1fzZ!yE1oT2ǶE:>KOp|xDH=^O-XLiΨ[:>l/'\X(cpo+)ǿ&<~GCd]Wgce 'GwOHSY%<;^k_&I v"#eνamt ~dAfO~_."9F<#9xvkx,?yn8ѳk*8NT͉>7yǗlv7J70KIϲi{3J) y{w&d) >/?-=bdE[02 )T W_Pa{۝E${FOH21"uZdk0TNlx1S\cgys(z)L-H^mYT%7+'=&C{?yn"_Ǔ 8jכ k;}G}E;e;by2& ; b5on?T endstream endobj 2000 0 obj << /Length 2151 /Filter /FlateDecode >> stream xڭXYo9~ϯl hƋu2I 8݇}h(I_h%kVhn /b_M' ||͇8d$x0JIƓ1a1[u>| IeK1?CWԲ̂$3?C!Sk>AU0WJ+ %mF4fK,"rQ@?p-rSGwSz22SF\ANtND[sBc5kjUX(a0`$"fG%~y[Q897+]Fpl:j"qm!RT |twWOY~.ε\ǫ錚mFYEԫ/L,^ sa^5UD.m)0QK@;ݡȇSҞ;$$Hf,ckjtHl7T\Y5xHӭn4" I =ZZVnq`͑]O¨V9|ɵGy] \p,Vk?=@C ?H^zvWMyo \1>$#Ue@ < 94,d5au28-R)@,cC{jމŊ_2ih)6߽1-,-U oP(P6t\܌  W@LS53ykjj{gwMD{y7vwt0뽀ϖϧ4u Ԫ黩O9d1VjͳNr ơזk^fq!$^ȵjy >H1c55PH:]pAX Xe41Ob¸9 m-őaՂ])j,f ^lZƀ\ԽDt@c6D7@BqH sh:7PXe7x+@!T! cD&Rg֩i@uQX񳙿_.t8d~zP[N:aj#}5@1CXK vnB+ )~vF"?;Q vgh#x1$}<I,ABJ$cKxz|4;uNRc,řUނ$#t [4HaJ{H Wۼ$hDKw TxU|mj  K#K|]9t,=4opmhAѦ?j^rޕ]$cGs8*'=\'QB&GLTDI9 (b?@Ъ Hȅ}MrhxbjXNpYP 6ྲྀz`׀I EI:-z .gM.Tmsح<ooЄ̀,أJ+X` ֽ(P(ZG0c~ {{3F1Pj9T(\EE SWv4tiJE^/R/ϻMnyB>P ԹzbJrb FIvi>6i:@{i jN0|1oЪn3{Y c[8DF-Rpt8_89uHviF> stream xX[4~_Qe]LY$Z /$7q3iܵN~;DZOLY3s]o~}3' o1瓇$}D]xs`pfdYNV,2Np/cɪ2g<;&2lFn{U i4nDs+" Ep7z{#b-:Qtp`YU ^}(N`4VV(~X .se]?[֛%*28tE P\z5ZIZUv')ZS3{g8 ] ޮ*iS/P(+QK9-St_CFNYY14f_U*GVSk~!7۱k۽ ' P9͘tr^18kIYoy7s:]2KtuPػ-k{]'\=IY ώj}J`j  0MX]Sߜ6xIc#;ƃ隼 2k _+(<x K 91(! kPM$G]GvTc8FBI+]DƝAbҵ~evE496^Bai3_1_|,0qtܼëƗLCՓ@tp<+mdʼX{2iˎШ\7{^WaKΆ-iÖ`ؒ^^Q95=\ZA0Zۈ 5{eEA]@aꌝFˆ.caI38ֹ_x{v:մxM}᛺hs E5jUԥ%-OQ5#dZӢTCs\{I|1K˜S@gOaۤm,xJ%VahqlX3$u谅O3u։!N5j@"X&|n6VR=6t}0RȍT.h>*Ksu~2h$.㨊nAK2&{ShѭóP{d$tL@1%Kmv^4P\ds< Mv+7HBHhU鍗`u(KŸm# endstream endobj 2018 0 obj << /Length 1761 /Filter /FlateDecode >> stream xڭWK6 Wh63+F$ERj&vMC:$3eR> >$K^et|M|_VWWET>n!|K!+1GHH`Q ;91e{hиE6/^jljc:Dj1b4@L p{9`G) Oa P|Mndv~]q{e7'Nz%]WVy9?* 8>Fq9iC&aAd(N6_ezZ^&nˮXOn}0G,^N] [3i,(F/|c7尧&[A}Fn.f*QǪfraIJS:x426M|_[/IA%iU|(\iܩ5{}4՟!Jb0_AP頯UUb]#K0e`S3á\_EܽRPW(!Qi#cOh< s*jn- o5{֣GRȒsDZkPqeՍ/QjO)6xiC2GgREf״P._; O4@8|baDNIH$[kDn.^Ywx]=)SY^)^жjREY) |@]>k0?0%<#=^#C؏ akAl,oWqjܨ fh~!0X uڌ#jĽ"3+Kiz2c. ?:OR `ј2{*50O| N>eD sjO0K'LzQFdJ[dЦ[}{SF1wusդHJca-tl+IR2JkWԌHjk5<~0fvxڅHޠ_m*v%Q5 kc <5EVl(M [{]{0i߈l$2+ a&[~jM4U4$Ô`<0>\?7?^osM_}~Km:d0'S Tvj/SE endstream endobj 1906 0 obj << /Type /ObjStm /N 100 /First 981 /Length 2164 /Filter /FlateDecode >> stream xZo7~_5(6]pwAtU InPZY${n1o,8YT WALrxq$*x B4ĢB2Y#ُ0<NU(Fr6pY}b 0$4^m-e %A%亦ǟ\tZEB0A9x؄SĺFH&Ĩc#V>фu0(DW(GGj}L&zf# 1eH.` 4z@vLI]s{:+pUrkeN/&,A$_AS6)ԱT Y0cDIzRLʬ!6o ?M9md(DRQ>u;j~ tК9W,fvQ˛LEVF u0+*XH@b<<rBgҎc=%佁Hyh=)݇ʮX-8ۆamat.|9|[|n+?Xœ:m˝'; ri9OX_[!C;+$re*E^GW:W@@AbP*fr9hfWN tʶ75'e~5:|Yώ]Ea ȻtDwP:a(u=}58ˇ++K׈k^W˛ٴyGͧnmowͯQ- گmB DElb9 D G@t[y\:vWǓ]8+2u c#pfPHdזJ,DVOW9="z, zyp>Y\ⓝ)S4œutt #R"ߍ@bACDN^B @tDp8z bG#`T{f> uV=a,=ø0]0> stream xڭYY~ׯ` gg(ۑ'J8HKD E,`\=uWHB+%p)%B?YW?y0--AvCq+ɇNQ`ot>:WMoס2h"frWռ4oڼܵu՝vY#GwEžZ :m{Ӈ5ܔ;:e$,m:1kz,oigid&Rcik#d;~CKU(ȏq*T+_eMLD L@ê^[*2yU즍}ՂܢT։o F"B`Ӵi݁KKES9Ygg@OkJM ]ji1YK}& e}JCiZWΔ,16G9Mxg0FYpwlϳg)u|pc.-6K֚Ck̕N>+hx#c$3Dѫi=: Y%>+[ 0kku,}䔵j"JTLX8 hhqֿh<_hP&_xo\@5_^QdվCZ D2;}AdPhsƁj ]] X\jZ*@"Gm'Y-vvc%V0E(55z K&$Gյ4A^fml>zzE&"8}$M 괙1mϗD2%Bx iC֤u##}ﳔF]1pDx3b 1iǚL,~X˳ݱݦĤ@zLZ`x\ w#e^9vב-sv-ggeXo#N|CYYzK g[ \F= /T,)x4E_` i~Gp#ȎAdk 9>j/w Swke)50;CaлO`NۊI%"f& !uЛQRǔ7V"t$&@ԔaYVJ 9(44(#K/S q,P ڬ0滫 X+B/o"aP}iV1x>-xuؿ`z¤He of7!8:/]8v>2. z()ግ 諔m?Iu0D ┒ڧPn(G -MrX % OB1"sB4(L:K Tnh!^gQQod1QkBσ~ogI2(q|ˠ0cx+o`J0f; 0ѹkm,.!9 " %l+$ăA 2 fc% Lʲ,5$l)Gn N#G^6C Љ;)vylce!N@o( Jry-Ǣ'K련bhCq+)̀GNbVkb؁~ɭ 'Y%G ;XqɛWլB '֚t'_|nK";svd ~9[7@SZ‘ECthlSKI8q7@85tQ R:q &tvpvFM0sȬt2nFFjTVxd8vm PF×N #'t/{* 3lKF!f5>{yW6nēc9L ^^&;'m3k?I8ECu|Z'qݼgEr^ge_}N%E#U{mut?J.u^lݕ/ç9{ͯڶ_k <ʾn}[t-&Fɀ-f|l?5Qq\3U.8R} fv խIE =ں5u~ o~ ac`ۍ8$E)̇H Z=}߿~f~L#|NMD(19,_1J^/}Lq>8cY_ɬGH1 9Cllص-%eQ>ey:!hGR!{n)E9oگ0#aG Ԭ"NfrG N;+ۂ#K^Tvx꘢9Y5kcUHE3:M\Ϳ^$p=~s~5E"FCOmۻ" nY,߿/G endstream endobj 2053 0 obj << /Length 1775 /Filter /FlateDecode >> stream xڝWKs6Wh`|gCر3IZnsHrHHDL @AiۃXbw}'룓8d(I<^M ' (u1(QY,>&:kNzԳ|FX +brS9S=>}8pRZ^Og$%%rwKJ:I}_iyЊBM诧I3oy'>&0bX {yqa7ga-9gնC մ[*YäiA="ܚՌ78ĤsSixG^ #[MWkJQwbLPF۱#0DY;`&G[,: / .A;%عel듓Bp$IN~HY4&|b0aXNLc,/%mke I;λ1윊hkMxiu֕xS JH ]QO0M;?LIVCFc PhhU}.V͝1T Gxd&4~17GrsЭĈ(޻:`(O`A%oρ8Ɲ!GC,snԱ@"/7pd  Qԗn /%oL8 ( Qζ.Bس:豇b>|IVLpf8 [S6dbx_ӫS;S2"# DI8Yİ>pi FY˂1 7Ň?JP4D BOٔO!Jyx Fi%nY# 1;ҥ]fyӍ3;v*WPaDsZҹT׷=_IHʂt0xZyifmHR`M[Z^/_kUy[Q:g%v" (f&h7׀DŽ8B39P/)}-vU>*&TȔN"FU+N(S5s}:?k&4Ìgr7*;i@m:ڽ,V5(?[Zj1p1djh6mNC5w*@6qv⁺_qu@P/+.(z\T_z_N mzPۡ BZ)br~1SV%afʀ1Ɋ0,aB} ;%dQ|'={g؏QCc:ۋ}ި9ݏRՅ~w6Ȃ-䛣IY:3IMP[MG= vXAcƤg_v?f2LJcd~Wo*Gwo VoɩR{ 3Ed19;f$D~\2[]ϣܕz\lQ,u#Z1h(VD@Ix]ei\l:rcJ)TV0ܬ@1yRkۺJ8b\r)»0Xv?F~zv+KSh!4x0A0䰼=-a\(JvAuM'[SfB'$x] MWzZuT V#E> q/RϚ endstream endobj 2068 0 obj << /Length 2382 /Filter /FlateDecode >> stream xYKo$v$`k'8Hr`'ӏq?ֿOZ$X,V}`)<w_߾99nQ2!CE,<DB>'rA*C΄Ȁ%H.to >z#OaRОOMЯo> EK2Ӟ~Ű=y4ayƽ98h|GߢR}O]FLdUW+66+\%%tۈbzrqz%rB"[#[љceġSM#X <#s3^ W&+⤢)p$h@Xwt.nhN_ۦ4sĝypB3c_x$W'A?_{ޔ,\tXvP4?X[/0b"/EOx@i̲4Xy{Dqs6؄+8)h|z%p`qwwpn~\,dnePHΤNpE ][\1b|= cr~h@0 D{nZU3åRRG!Jfȴ>uǩTx9 vsK;_E)cw;bΤDK:,NT|[`̝*^nKVbC\7j/XL)y.6G x{z6qj#qeHR)miO#h5B{ W,A12X[.6 1rGrΨ@eּD?^3,6lLea$[B?юImn;wTy6u!4e !=`@K):zݣ'QQ~4h/F>w[Ih[;t,*0˂JZ,`ih ;2Ohr͆mnbJk%N  LqZRxKCIi ͓0ԆxM{9bS ,W#vi4hSJqL\n^ WO@#+!Lrħ#0&1ӥ`B:e.#ȿ7.lp3Nd 81e0sk0x "nYVֵyNXLUpyEB7uۀnR+W΁ 8(b.(ۍVù:L;Fz-Maa7uN @@|E{3f,fm(v|n6RV$ %C!fY@9Wc1>ʶj,MzWI@uc1`5ug"X&TA>IE,ʱpU'Oƕv !* Ңrt'mQAeDxyŷխdY2֙XL$W q]&\xE)p-M)ɢxnJ] *@̯1Ҹ]9/XEzTY91LCzHU"Lk[`P<3_ eRoCJJY/JA/^\mz8^+ Nx] h蚬{Swms_qz|Kl┥Yv~4kfeٽ&Y?yUƀe,?x/ PAD޴&`Lm .3A:=-Vx"`Y4n]> wjJHE=5tbg icku [;%hٟUq1UCP3} fwΒkajS5Su:x.O6Q Mi/ pOenPkeo15NlAd@-έLr*G(NRQ:0JQOKA= v 5We,Za_qB5L? %.fxwΏBtNSws>vXm'uOpѩz|X29ϝk&xakđ.h^x`Y²RnE¶4 endstream endobj 2078 0 obj << /Length 1668 /Filter /FlateDecode >> stream xڝXo6_!*1Mn+K-6[IDɉ!rlC;x ~b6 e1ۍ`h{Ifm}Ec:稩Ood%bdk4BةDzы/HLjGڝl>+ Flv:Ha[Qr2Z7^W’.,3eIkh fixr'%^W"1tsw|Daw>JOG2DڻE)T^Qu(ӄK -ˆEe 3!${ .Bؗf;e9/xk׬3ʢG J!(wˊ 73@f-A*BL (. R_0+fgdΰuBbD树JeY6@4Q4h xIY-w y0Xf\Lz='PT[s֥ș@q7-Q~-E'B,3op9GCI6Gf0ɴu0%qd)E@LD]Տe!0,L$(p=O! s2hc"DAvꜢIrXYݪ溞0)/2\S6L4dט~hki7rޱfN*I̞uOii0TCa|2iLg LJJG%冻Tr`(=䵮3xVgt;/A4ei˼c˾cN( цhJi@&oX7ڗޯ 1ŽG9JRgϞ6yW¥kZBTkMY4to&4Kiс5ׄSJX/WɊ35|5{=tJŊ GׁXb3fH? l?`=۔%M =Mc] f;/hx< W\ɏC> stream xXK4ϯhS1$?}`=\`#Prew1I)Ӷv5C쁓RJL{|ëwAIXps7M9 e9d\{{V ME^WfEGsGW=sx?ދ%U'=;vm|{'+v1>Ew:C:$R-+> ">5n]$7L]0 )>{'a, ܘ-ˊS_ԙ.ߠM}:޿^ҷnޘ6"1hvEuSQeۛ*[>%1rpOoVw;վX S zMvΪ^?u^d:Օ*ob &EȤ kv۞Ix7PKr1 AAbxv{xN;s#n8oP7H*>md ڎc&QwMHU p8:-O8y8' sMvf.s/3ZNۇ N2pXӞCAz"mpN{Ѱx1$!|a믾 o?x0Q) Ba]UT,I5:Wt[Zȑrwt9ӆ d^`]">JbGosW!ޘ5iVm UC(pfFO*0,ުZm+8'#-{=z}77<d͙LqΌd#3 xMKe Օ5CqehWfl~2[S;M|+qE;=ck|9>;7 pcݵ@􂑥I+r Eax-;d5=ÑԪRKVrnl+hec~Єk֪;pj kAʨJJ?Xׯ>$p{g0ٶ䰺QVe`Q2Ռ(!'#ڮ,㖛 (kc`!@$9V~¿1m@ѧ!h-w 1kC@5투 &1`̗#fZ~V JARCɓhƩ־EؾVߋ_Ij<2GՀ⧑L|A* Y4J@h Y,r}֡`,_nSjCVW%-[ 1!_| dM*A4LPC/s;sS=ޢ!JhA!ͭ9fĠ㚰ȞJߊ>z36Jg8~47=S/LJy<4WlK|t4%\oƖfބ0AtԯxQEѹnZ:Pp,KV\Ĝ*$_)Z:R+}DK:Jz@Vqj\K@K_J250)h*LUm ,Z9sRROY&K=n=7дߜVf/dl^p z$xY ̨TđL~n!"bv?*UUU{кZ"jH&2ɺ> F!+RBNF> *U}5ə;g( t$'"ؒW q# ƃxl a['6Fh)```VH՟p)džMfr8N e Z\&N[c$JbʊNz4X#Ez0H.JV?k'4:SUB-N?$@?(V(&$e0YQ/ IrZi?F@1-pa9a PTNiyۙQw3w@ŝ,v0M/_떈l^ endstream endobj 2106 0 obj << /Length 2921 /Filter /FlateDecode >> stream xڕYmo8_=Qkq{4mM_8l,36[Y2Dn ,EISH9O~Ed,>a|pbܬOTE'Bfݷo8ң/E$ˀ7=Q;9ڽtۗA>z_rgW7[XA}[7*_vEe@Bn-X{Qv%槁ۧ4͵vʲPuǥwvTjnq,d:osKQUeyG=w'K,"p,,5_FmW+"ُZD>vZ1_pG\YfSo"Z"}XpH'^NIfz-KǰPDq K|v>ؚtPeIY<-~`nvkx Hfccl) gnA-j#vne۪jCI𢑻-5UۭrVntRӼ-$KE׍uߓ : 롧RvԵ.oUA}_%SPwtw37Ns^sɬeD%0Mhߥj˺3pnoZ5.p) Ȣʼ|uGy$N|a$oHgΏ*3JX{]vRitV6rj$] Bp\uYdc#513 -uЏWr/pmp U9y(Xq2!?GZ"6~!i[jAv{M;P[jb}:(]-R r $PԻ=>lNfnlAӘy{Jғ3+ 0N$PF2ϝ)KW4XIz+rߵ9"(Ԭ !ñ}0+hkllDpu#Q" An140㉉E7zn7 G6O.&ppl$L Bb uCЎ}SPOS-!sD?o4:e)~U}eγƓ>lDe \I]ǰ s}K"GPN!~{|G>h44yV42Y9GT:!A` Mt LC9A>x __4,m C5~E 9ˏ+wJkM&7$\={uo(=RݓrœHd.Gǹ,0hdvO|3BјQ]պhη~a,p0i¿5 ag@PY`M27IWBx2˼;mob; ԰L8'x( V]Cu 񜐚756vZuC:VC@x/IGՊp矃  4C]TZ )"95拘)_̜"=E"mj;go\(B"1kJFDN7$tg_ `W־bsVD_5#I7(d)} "-oydJqn1*6£z%UD*ok׻|AW4_YGs c&y%)<< M- ' $'*3{h6./t,PTő q4 q> stream xVmo6_!8b#zR -٧J+R ;-)Cx<=X+˱^O}.ȊQ V1 Hl=f֛&EAP˔Wo4JK*W&y  {@$Zȫ-7!VA-zd8FiYWWWswY7{˨zyw?JHZIM&u|u0kJk1PC^D:PL_an0A}mC(#@n8S6 eif%KA)} j&(Ǘ[>Ѥmђ>˟z1aȅTފtyqst]ZPeSàSw%_R$` q[ xoQ} I`zh;$XejdKg{*a!)*P1(Hjg` K|j>7:)4w n1oz0  (Uvzi˝fKFHV'ؗw晗(pOs_2dZcE2nqacCa/rcep#cZZ4SWX6E zH ]]zo0hEqtZ?v}9:lUq!Thbjs=wIO},[sSIxb*!k~kH|#s^Ɠ 9O__4U*#C2ޮP6dc uպY?a9-4I&m@hc\|-r׏\-/S)!l>/Ԃ`d2VZN#PHT/2ou@RSRiB5kf$n!3iAs i:[&r:&ĴBjѕքDTsy("nlj6^̱?bZ]ط))ԕJ6\!B@r{R!y-[0fPd+z\y8:&#%0vá<qU{D~>z@\g6sz8,{O=UWGė؇qU14[7?>24Р hB_DY( 1"n40{2:'"׏IϱȖOLRwAd=)W>YA/y endstream endobj 2025 0 obj << /Type /ObjStm /N 100 /First 976 /Length 2061 /Filter /FlateDecode >> stream xZn}W}(CrdaH-@n!M uXV-۳p 7ޑ3xGd( D)(&rS-73YR I`$$$&%Ul3a,Z>IPt^GCU'CR_P&łרAU @ࣾ+d}LHaIpAeJeR(M1GL&(MM ",&$)8Bq/Nu p ČR_u+'N __ I$JP-AEŌQؘEwu+P웾ꢾ<ԍF0e#%>=C/؈Y-`KfSd ,S}NSd 9*2ʥb+KLbUL0L|T} -Tp@`%]29:r)7R0s}o8(a7I|L*TbCtdg Hd [rR'&W'+5 Fojel[i ژjژOYm Oaӓ7cv{\P_{ʅk.',=ae\@]dĵ}ڜ14gϞtijI\3OLm.e6~}e rs*Nw6m8aZ)Vc_OM+WNH;::wra"j< krP+41AzAC R PƋ5w1|xo j!F\"8>xNV`8@>/8nfӅ}ίҀ<NT3iG(_-Ye[t3&d8$`P)>Bw6˻=vtÃTQ 0}"P;1@͌JNF*R*F]P<ژ4Wki'vڜ7?^Z,n_7b}u3k,&ͺ]l%i#\~WQl kidV?l݅&txp~ԫd@GJؕ+bW2H ;ÈЌ>z ஔeBfA]H.v= ѥ#`1l6&m1iwƿ܎m;TÐ|Ŭϒ@=9J 22Gc,~wZ9kM 7G-FsA{kу M}By8IײH I Xb3z`.  0Z+Dph:3$y0i15z |GhZp~f 2eTB=EH#fԄʗ ]c49G!&[Yib?@z*wle^m0<8ӖOPD)رZ"bAp݊t> stream xڽY[۸~ϯ0I]mr-ڗyXZmveե' -ٜ[p8J`s?ջ8d,Ey<<Iڊ;~C?ovQm=BlMӓJA9 Lm"K?cVZ-uˠ0hh\tMwS |tspU?||er~Cm;8nzӬ%"*tKMN1s/~3Cb셠26 jK6NԇV7ⶀ tq ;¢.0/̹ s)[h]SX(kG^ 44B (u `u]9ވNG H){J9]7-*%C}2eITa YTyDwk"惥p5Ua{о-,48DF Kk>j1l5{ŀb\?틮 |0a9I&^Uv䑠QmHҕ[L.jj/8:y:ieSߋ- E|>,C7):u|;blh5!ga |:lw}w`%bq_84rbMÑ`BuS&ΪTU}0{I W;zd%̲R:di}>8j!h=*xKp!6]0o.$#DSF՞b&:RָS6{;Eh*.o/\( HFM8E@ 7%))S@Ȕ(LT/Ю jI[oK-sGjҘqsh6m%h[Dt!  {ތ. eP2\nK ~lIhW=/i? endstream endobj 2144 0 obj << /Length 2683 /Filter /FlateDecode >> stream xڥYY~_!HLV/&a ^y5y2.Mqf :*Žmb"Lz&2{__lsE躲ϫ4gMRΥaPCޫRIS c73W ω.ï>WbR["qtA$IE4SW=ɒf骫Ӽ7sy\6K,JqpZ Whvdry6WQF90ܫ*)F;o_ocz33 ZbmWݖ;JTXXz񌫹L*v,i23iUkV U0zQZG 6#RI]'=')_ &GiHҢTu2CRdn+ֱ(,/L:mÀyjyf<ƁR`h*\UK #3_-59P㸠X84kp`(<"Q^a pC[}Gߛ]`W _px[9'-uTNaĄ%)Is|X5g<6yd]c~ýo Y'.g+7iy'w$(2pU/-7KSlkY~ z_}bo"w\qͧU|vvHÍ;{MaI63#]R:3т"\\hHràZk,P["{!BaO_"ȔFfv62>vg>i3CV/n(t9pӗ—Y_z7 3: fAU:@pS𴔸7E֦C@Af1@O:o[wZ)RE$leʴ|w7r`^9uD1."p1o?C~/xBpF+7W}ԏ08;0F[119ڔplq ǴMGz c$G lA a,J}ch]\&ͧ--o1 Ybl@yO ž}pWiEc2;J5@Bjݎ5ˌ) RC+Bx,D*kFS}@;Fj ' |!lN%"ҕW/ W<6,0A0)Ue!C^Sf<0hWbHCZ f\3Q l 1!{TKP`(DߗT"}=p7h`2S38}ZU : >ʱ(9ODqL#D6ҁU\*j%!m1#I)͐3NN7؛L`|J%nkD,)' @2gVB(#=Kԋ6PiՐ#M0 µuYTPXz0B)C2\su:wC#5\u3#P2ɵ e[!7;_i$F#y[Li_2z #{ǃۅ B`1eDe pRXh_,hJ9x)aҨԝ$-VVx5}޵O'BΤ%E.17a6hӜ6CFaC8)bt9m:c`mGRgLe9c9ڕ uؾDn~*<x|r2z{Fuf=Cz `ݎv\0O%֎ $iXO镇Sf祧Ӊc&n4Ќy_qpOpTJΈt?> \\j M!k(eb%sdDI\^ȵJg=X7{1f84:+б%6FKhccP:rq M,UMkUy1tQdxy11C0H1PS;E5bAW2pvwxrhʡ3^UzZ@CgD͡-^T&?6,/մUӆ@jsm4[C gANZ;Lvb߿Z!CZ=Wn,C4X64x7`l.:5iaQ)[`rMQ1 ik'ClݚLYŔ5.:/"70 @aĆ0v繦fVYUeMtA? ¢ +>w;QZyRw.<Я~+v< hmhJtid+JA*K9-;oꚩuq> stream xڕXYs6~ׯ8315 <=:Ӥ'N$IG^X,v=!<\ `r.u7!1z ÛxJٌ8p1 \Rd&h w|L=XdДy1"ųIHwSqX1uuxb4j|l"P$1i,ܖT򑍭E1bŅHLpD`#EDԀ {|DQkD`)/7yUҀ@0.}h8iwT<"3mٽn#AE:dHM }:bd4{G|HG4p:P]Yge^j 8"'0ajpK/ P:"0CfUG9O2gb." F2,aϯxc/E,LD"zPMd0p,QȍLJz8 cJL_ G/N_G.Grnu8T@𠘘8s De-$T2:%}CnMKQ.G>\>\k~GW$ޒO>Wt-֑1x<]mu0/\i($zLBgbRBs59SDp˲\$ .&w` N`s0٠LwkjSSbL)Vѽ9*X~D,}jX_":Z}32xfvkfs߆q-:ŝiwȱO KH,3H,8_ Q0ܦek4,%4,ul\<ɣPe ա^\=GZϼ v_ =SǼ3޽{K˦& e4_" |.u,/5*J$t!,zè`sjʷNJAK~]h"u;$*d~xg'7M:γm[M&&\*Pu+T} ܭo o J{ Px&pD,t5lOgA.r _0|FJ,ʽ_'LU3|@xٝ+(ke#ROK{H֥y?@,*X\ey}%[K -A@'s' (v{=7D endstream endobj 2173 0 obj << /Length 1751 /Filter /FlateDecode >> stream xXK606bkF$DmE(%ѶY2$9;UE{(X3Cf7ͫAcC\Az[8bWkܢ29|Դ粙H0|y #>?I^n]Yw]Q>(sܦ2Ox1"/b|E7G=+չ}) KRd[tQU{^vL [>/h0& ܞBSe|~yoZwuqډOhmb{*)9I<ƸBy#4)2OGN6St2Zk7hq`>,9d?k@ ExNL{$C/>n6A͚N6WڦnwUK?x"htg+RVnkl֪806LTb]AqᏍ\j-" ,WaQ A,YA07)֩4}۷̳hDa\k0O0 y6gZ7P$c B$%?f4-N>^ __X2}||laTdM e2R62+|t°;5itNaG.%zsa9{+>xچ;8u:{r'0\=I]Ʋ^"0 Ŀ)h083uSKCk++)G" R[gajO P+}wt0;~Ƨ1\hsEejB+ \XW196瀲*I+օ+Ec^*@ЩX /o]SJ#^UV;s:%%8P}Axlb,$nS,d6\?޶uYwh72u^i]8$! ofgzSnԯ*S$۴էSBLw()b<9|:ÁrE8 M L>Up6 endstream endobj 2181 0 obj << /Length 2868 /Filter /FlateDecode >> stream xn>_јSpkIJ#A^L6I]#=[[=I=קUnٰ#Xb_lFl?&"*Rnn6R(NM&e|6~o~?<@4ʊh2; w}2'3u3.> |y\Qrih9>CTVx'y+e@F:4NtܞI؟>S?ТLtߧѺTv\D%7U(OƯ_O*tKtTy`E 픴{A#s m_H/Nanvlz &"ӠwJBYE! 2;>GMG+p(qCSgd|—~g)I@L/%ֲp5ي$Ks,fB%`AWL V!)x I}}n$|r^p<*Ѿ,95 GWԌ[auiX,s6| Mf՗X\^üRX5. @$zM,NT̒yMKsVeMSf5NlДFp@J:3B;o)ЏRNJk<"Z1t$|KF4k(|M\ٿŞy8ͩ_fdο!esb&B9_ L~z)ğA4UMozHΉlg/_w%%>ld%`q1jVJ$*bYotx=y؞ >s#J,B!:Tq,TOe ^(I/F$J=ɮgRO'H;&n2>f@Wܾ.0BC1Y:EXaw c*ԼL>]r>{XQ u= k>]AR!v3Nu[= +o΢Xpza~l-+-dk3DAFYF.^mAWVE6LD:qx  K{B0?4c# p}g5?N bONvzmTZ+³']./o38ۿ̻~f3sAG`4s:[1@`1]VvYDhߞK|:9. X5UA򰸗$V>.-IXC+s,oDD!%YNuA9L_D/bFUg({yqn1'-v-.H 0dIE`{FP)ۛf2CpX-IIQ$ydsP"Ju/S/;wPqbZ -.E0z->kqLI9e'¥l@_=iMv=Ԭ$#=(cQ^PSq8]g6teT&i ޺hD/5ZT:N?0ouw7߽LM+~<bl~Ъr<:"OHKqxk)r7"~~ ~^ O~>H%UU;8h~_ǡo`g GGDS#Ka8s]U묳//|] m(4zsA#֟K0Qw]c{袔`|j}3]d`{3;(&zmA}Ng0f;{s΁{B& endstream endobj 2192 0 obj << /Length 1597 /Filter /FlateDecode >> stream xWYoF~ׯ &s".6v4iPi]+ \YAYiM3ofΫOy8)J#9 `X91!(bs;\(e1C,A*(v=4LN0J|"3#&7,WiNn[3RV')Ko~dr.-Z^Ţ3]yyE P`g#I!G7rմW8#5MT(1Z6b.ơ?JFƛ)Eh{X M$j!‹٫AZIN-5x>l9+lfbnu&南Rt>b!9TXo"RT4x{ab;3w4k6-cW 2WŏIBK [5/o;3 Yf֊N6[ٔIEtZ>YEF[YQ Hx$k(2IU@WF3I0Fxƞs)o 6SȌh1f~|?|@*5:K < p )'kL`;?7udjű[E2RRU[3-lhAE5>s1'(H ];M.Fޖͅ.@Y-o=HxrY4#Ռ}}ba }@Г$bSסk"T`6ʪ!E|[i5H DsKVm;(x>bT%w9_쬅l 1O&)A \UM F.$bSC96ugTa䢴ۻcUR0벑f6EbyzPZ-h1^nѮ(epCFŊH-j XAjQYA[gF tԐuTX,ҶRO W0a[VX=]qUݦ'fgV}q"MggsbigYq0S ClٷF H$b741 %xOc|oSGᇰ^raу[A-m 'f}|wrlH]NL.MkMP2'&>b'M0VVNyKb C8LUN!tyjeUﵬu>T9 = Yxdt?MSLGI(ؒ)-֊o=#K(pSޚFk<0"IHw gub-yykTi5@0"+Ԧ~造aכUA>nнYز,YTItKt.}]JZYH\[:5GÚ죱Vh?MA75y,L o> stream x]6}EODZ|a^Nj>xpG{_`lS[0{3- oի;/b &͂zX*Y|p2%s4p-fWwA48cA8D,'ns^M=:>}|(upiL() q:AetY9Gny3YFюu>xfŒIw׳%Q@ E0,US̊D)Pj#.8o$6ꨵI\fKsy0B@4Pjn,p 4o&a ;ze&תzܥ݄PY!\8FJm /t]f̳*/Ϸ@;2 eV֨#ѢBۚZ|X3Z *C !Ƣ Og?Ү6KyHVKk{ B|5F1#Ey,!cȕ2̳A VHȹBx@1q1N>#>(b{/͑tAI:(zS~e^y OyC札Rzcn^1ލ5#sw9 ۣy0!Pvҍڌ7 ]FdU#l0wxY߹NA.Iq㢐u/ho <9$"ۺ1t#9a͜Ǵa?#MQ#TJTE=ƕk_ܾ{1n4HϤػo,%#kao˘K^ ,b !W{\i!|4Nkde&ob_97Gs2/:DT@cը;a2`lVmҩ>CuQA$MLVVFUU QCA/Z1J1/`NIvΥó+}?6ȱ>!̱%*_[Ȱ;GV=Cֶ,c9M>]ƹjA5۩~BP"p.-6=8AVĪG/hNwg(s0[k`8 "Gu` B]LoG_6wcFy& Gc~wUj ŧ&纡pv<^)!Q7ԵyPC,l5Ή0__7_\ $Ч|7ۀ> 1ݧ)\PX#2Y1 C1!۠vyبn waYMhӃ]OOkvrUiũ׆eZuz%<(~iv0;ud[̣_}hDz:r Y-#0i?RNaճ D6j{uӍ (~q0 p5Af"Fm07x<ټ/SXNf@0Dw;7fi| ^r:2,,@Ƀ:evt}6tlb< a i̴`ʢ4b@dXw axć7#XN endstream endobj 2221 0 obj << /Length 1478 /Filter /FlateDecode >> stream xXYoF~ׯ  %s .qh*C\)J;{P"eFu =fgfvfll,lȊQZZcļ Ah/p>_@"%TRRnz 玏E _ddlhd$FQh5ۢ\NRP`i^'%)p+sgۻ_ּMv7iDY{BV Lmi6j\q|Ղ/mټJyOr'"S9. #[bea)3Qe]2, my)7[SE-\o9HM&+ ^30EQ[j<1r-lh"KlI(Da#1CqDzL;'J/B|("7ӓ&(@AwlºKBC`7pYJb+=;BVHZ!=Ջg3=x_stDc9È0{ӌ`,0 o&OpyWZ L׮- P!zPT0f[r!"YUB>FK #PCω]Rl~ݩC|;7[iGªJJ61E1 Ʉ*B?"Ƙof ՓKεe#&,WEzBV1GNPWkم`>TpΏҫhoeUl{APCފc6=(eWA]@ZV26FZm^^+yPlIrWTәgJaGi1M* =M M2&d)O/ (ޤgH"a?~,p )ӮLdR.[3*-=ViB5d ȥF:%u͏`gI|k4]O-N݈̮aV񕙥i`+)BoO'pP%4}涊S׼+{@t%N@TwZn<_7qUK*+-aTQkvHW16<4~$skȲ(rM򝟇B!]݋@*GsiB+ce//sjeFT$?2t=[l *ѵA =ҺJ0n'ja L סR\U9I;}W:}YB6yjQ0xȺݟmM"_Ouf* endstream endobj 2229 0 obj << /Length 1602 /Filter /FlateDecode >> stream xYK6 ڙXqC;I:ݜΔiZr%jw__ui9A,`Weɢ,E~d< ,.oݘo~.-&qyY,&92], ұ/1mz#Uzy"daX_$]_Wv2b4(NIaIvM&ZO%[#:k^rӶ;4Z $7Qmdehީ$Ѱ7Uh)X4#SRt} Qx[ԓ5)8L>p-13(KNlIxǧ!HV2 KS:H‘VR9QБ8'_u8zo_Y /r3%=n ؔ՞qjîZNsQ߯yT57%@X2jyT} O-%s-tu\7G :ͭ~\6CVD Xl3 )f%d6Glfߩjø`SG٥{):&Tafw^iVF}LUo$d)CujYAi9=;^69W.AsG\dO-zo`  Rfi Zc}g.LɅ3aww/ڪ+=*QWI ڜI9% Dh/ 5ԴTNI991Ӳ"2u O$˘k'pڴ^֕rS8HC l%Ɠ8Eתr ]DVW$5/70_ 49ǡZgm'/v Pul;3lzbFyVR]'RR5n桌x>ݺ5 (ꋡ'Ҫ-6H\R[U 5hتʶ+0[mҭ@1ۖ ,s^DcUW_zT=n5 Xl;|Fʌ/IF~'A8Fcq*U ׼-f W 7>2` UCrʗT?4m6h: 褸 |l|Tm$і*)!`e4i5ne De M Ac:AZp+)sIT$Rx6DZퟏR<("g2z+)0I i ;6ËBaxfhx 5@dMᾠS= ׅH/#t!VG(3TFõ@r-綅O׶n# ߌ,\30׾%^p].q'#%va,Oaqz"ܝxȿLCߣ+?|sǥA Ig~P{ZýN+³sJ1FJ+- TVU>%AjAд9%SUP`;p]~$N'OplF^&QDI$ Η(N(I.3#3 Q$ 9`q=3q4]].\,zODSu@ endstream endobj 2129 0 obj << /Type /ObjStm /N 100 /First 975 /Length 1998 /Filter /FlateDecode >> stream xZQo7 ~c0$J4 l@v ^;('s|͊hMQ"E> >LLdLSVQ1*K!P01Vn!qCHQFZ orTL:\T') @ Kg)jKUJjHtۄe&#&$X\ -: T'c^:@ ZL:@`蜞ɐwXU (#j$̆gO8gx+6Cgg(:j8F k0#6=lRѱ|ە3vԅccei /A 9dJa&ŶJBa)dؑN]buJ2\c؋fk4܌xl `ҽ TbQ)@*ubMT0#hp@j}村xCB!#u'Hְ<$W&4 ",HЙ=Cb2r:?&&K~e( X'Fe(#z ELnpp0h^#QoMo%XA͎ϏϞOS2p RxnL ?u+TpD - bENؼ$ jSZ`trn47Gyiޏ/Gx184/h<):h6f ~}8>|1G4+cN1Zex8O0՟[f ywǼ~lנy>~Myݼ8sPH#%CnIΖԕwa~bOޞt6bhgO5>EzJ%!T↭]WnK@ɑp{K"؞UV@ ƻyyP?] @!m1F?Aikj\Ol|z)7s 8ȱMJX @>. gp>Ȟjnk#pcCPmB ?_,xZhOgqk|~9i>l/Fdt'[UĢnU A R.r&;C:S((S^[!Yޣ`R >)'U(yB%VY$R)"Yv;rGGg?g[ϸwuϸM[JWH V@1tԎd$_#n݃1B6P:ك1-a\ j3gzYyk%f'+#ܚ<l ͡q^Oņh0WVtO<.ݸ!¼e'I u+u`7Th٣B -Vgƞjt ,9z5E6-ih(JzBPeo;rr/صmh>ѓJkO"Zy?OИAAG<[x#6dXG>Vz] +d+ߏdC;–vV]X+ᰖ[Z-/hֽUfÚѻhi_zgjF9.ǃ[.::8'"`/iŏ~V Tީw6V(~YW^ ;j'_lQ[{Kh-hgNW7~{ ~-վZxYm)^{Mp$ASŖّũhDidu^noh,O3+(6&<IA\L{\bkz1i6؞I9i{fuPXwҗ=rÂ_ ބIy4իo,/%ӎ&yrCPqܸMjŅF@JG9Q;2:jHG{ ީA@ ŽF:!:( endstream endobj 2241 0 obj << /Length 2697 /Filter /FlateDecode >> stream xY[~RMQ7I ا и@)r%ѦHp;˛x.v^gg_o_͛0Y)"nw+L*ERnnyR,d婬;\·ǻߛ7R6nd,΍aP|yX1uވ0ʢԥȻCt}C_~ڢڗvZxyuC;S7COg]mw:] {B,Ob򀐅nl"f>WIg:I# D!;WYW,c]KI^@YV79ޮgkx*iMSU(жߕvV @aٟ2Ӛ)v%u:5~9/V9wE7MISLqf11UBdu0@`ݴDO`)afi  wt0a8|XLq&&#;J^{Hs7}5 ~"/J!8>B,e f3ǒAV547z|jG+24zg|͈PLc '7 ýò/Ri /0 V|,1˂~|`頲,::c88xv\[6< ʪ[M q珯<܊u*EdM{Bk5L2X=7믾}W "Hz4K'Bn(e:p7 c*&c$N xn;w}/ "&w sɒVDmѧmVk,TjB.sZIV=p$g C`܀՟n5 :TS^TTmӜP:q+BxW( ZRV%p1U4[ہ}Z$66\Df*mՋ̆}66Ad}/32kRہ 0°0Lcl1aFrbR" c/~9b©<`&/ڮ)kM#aY`jxʴ}:{kH2QK`Q b16cFkɂ- s('&Qu:ש:I N+_M&MF)Mx3 |Bo_}^<.PHf֝ 챗zk/g]mǀgQe۪~{G5#5帏`(}q}z~u4bq']-uMIU 9|`-2$ -bM/BkG3c+xGT|Ѥ1 ꇷ>!תӧYɾ׮L?L1|w Q"{,'EC#9gTcu׏auItLDC~LQ k9Cvknj1T}+Rup͗ӳŌ7b4i{Уrū5ECݘ./~Z'Wm k:;t2TTԇ?^oNMJV7?G,6a%!ڭ~6Wr0wzc17 Tdc_np@.TET輭^_}hf_@ܗ[w[;~uxv%+%`*F3[ma+=Cx(.oZ}[8xEbPڮ\Q/`k/ X)DS<.JQ"@Y| `̙=Wy] n0!i#B~!8HMEPAi]6o*?gQZ2!M 2яmqol >Ni)E-µP'ϐ˗Y_nM+u׻%?y\*Cqsv,:GuD2ضΗ+|SC,gtswu: vG3qg]gh(p}y<>vWX$Ý?lҧ%i"lIw֊ġyVD s-[l endstream endobj 2252 0 obj << /Length 1929 /Filter /FlateDecode >> stream xڝXr}Wv$Km0؛Je'ǻݪP$$#C HY|}qH-~nMtCzi(RF~mQ[Dݻw%tge~(VaYoMGeϪ~V+%}]_4]7zȔ̪h -%)PYk4hP(;5%V?pev_7vQ%vU~Z+`tZSug$<8*;ZWQ.&u/}YUt}'ir Gay,Vlb郝x,nXW>jz[-hƾidvZNTVeUL:)A_`GF1wTLnŶ[aH&< C-.9 wn>ov}7ߌcp8^}z,$HEw^K_fˀ%Q<p2yD3 sTs\G>ߊEH[bF֕.D٘:kDҹ[ DD. ꂝnjJ@${ztQ”Znl^k:E#jԘ5ZUnt֦R5]Kv?~nYewa ?Gl.d؏[i<+(ta'|<8S' |kHxi8W^Vm?p`]'Nq,oWL3^yowm^;_ZT/'~ _eIS7jDsp3Z}oq ^n0#6*Dτ10~4|2ƨ+/yf 3AY]n{Ul[WY0 1e@bi7#AD=t(&JaSOj(l!CKXv?x=^D_唶,}kl鹀O`M~X>b!#嵄. +d!!@R$2'38ދge(} 9sC/uY PZd3Uf~HRIL3A:.].\uk:*l ԦD9j:r Li$#+a V&D)e N~{Fջ$և :x_]WB(2w2B\:t?]>8[?B8"?Bx9$yVБҵ(~[RҡgU ۡ%1cԶG5~:"͌!Od֐>qeCayfd {vXFTi=Fum\_;R{{&V[rkD"/scX8aNNR3; sL?[@“j^HOU> 5>!89P ?? w'M endstream endobj 2260 0 obj << /Length 3596 /Filter /FlateDecode >> stream xڽ[Iϯ2y>/,/8`8L$#QT㹴@BycʻUVڻwssB0 a}꤫*5Pi[f)a %8*S0L0!+DlI#Di'˴ӑlT&xhbQg撜I1|=RF8洋~\(Lz6˄I>0sͦnGu{Ѐ,~fQz #lY8W%Aúu}_ӲwHoV渍) 6L$ W1İ nHYM5g d ?ð}nW=?S*'CšJ9hΜtJͤS;*J(V+6ܶf]+>,K h/"SA&>ݺ=R๳jTϩ%uj;fG-6(;y5Y&,D4B XMt`(@O$"I8uӹ*bJV2d0mY{VQ9ЃuYSZk4M[p oðêkޢ.\ͮsR& C?5>}l1۰ZM+L,l؆TJSZE&uM(ͪo;l>[QBC7Q9ʼnV $6fSc51+waK|&'T`H]uNo? nTޔWG1!Sߚ~ 0Po}Y2$V& K z]Ye-ߜt+ gH/`.޵5U(-> ^ 5@vYUN,zWO ,ty7P3jA̳T3nY׆{R(=&jN駥ubF8|07~ԃu!teS9 4'v?~`)UP ssثCwŨa9^Y0ovq:Ҡ&s͌qHyp+:8"(g H bd|D[KeX2 LlO ) JD(@xF# ~0L}ؘr;n=UzKg& R2;U4}^i5 4z30ͣLv(-Y?l/6 /hNe2f\//`vFmwq00=8"3e4 *J#WC\Бo^\,.geUCR3̄ )uKVwr$rHf jm݁꼪\R=ltdt&NS+RQzĈi]C_{ArL[ZRtDd|~ tݭ6iXfj{$~ɓѪ`rwrWO591ɮ4ya.cHx8nz*aCpuZZb@4ISnFAS¹9FWr bzS1G7}uohl'Tn^-:O"t"p` P!>2UDpz89{+a4t4*g0ᦍwI2n7A)DPj6}9{-2ЗE9wr:?W13PI_'5 Xp&uJ-Ǟ& မ_(( *Q*lyBF A cR&mHaMxdJBJ+sx.GN|^ $ W46`aSR /NKa!ra͔=S'Lh|&Up˞l2m/s79;=;d_sj^8YUt7PwSЙYlU5epZw #+,Rox7x㴥ae< mAxqMSGJ{g-rsVpȯz_߸ 9\La{@?s!?CGQ}v?-YT߂1+"pW_`khYLl ѱL|p,Qpg,Bʇb emP@, j`Q7Z @8xjx+$,?bFq ?|N5hK-Ϟ)W endstream endobj 2273 0 obj << /Length 2191 /Filter /FlateDecode >> stream xڝXY۸~P!EUY2vue7YoyH ExF7IffKF@v+ջWWo8nBDƫlsHƬtяf;8a?K|D$z3ot.m9:c1?PEY m.KǤ?-%]w#:*{&B޸J:{s~dBEBZ]yn}WE־8աJSv+QRj0'"#d{j*a H$Jt8s$CyrɈPe2w'Q7mYd̠i<3h.o7(7HzY#&O@MZSDϿa^KK%DJyת,TeyW`SS p5y9c1m_t <@a4|Z#Aݠ3yFh)R~"Z5 oΌbePr/SrE·]يͫN^ED4^4&4 mf9X?1Q8jVT0o)#U B,OUj?t1˜xch I3՘¢\ Y()혳؜'*}~Q!6ik2̀Nj};D|^+QQP($aVNŸ6PrQ>0ސ#낊Px5#) ri|[1"$[xhwmo25UI;<1YkX]iF9J4uۛ_>,(£ߐ]'ק5Nwq{4zQ azrϿ]Qv|E5E=E!HEi~IzXv#.fO:7VIvTT] G(+1 cg[RQv( ZZ:pޅVڒqF[jl'[,XezEW !"*:Q=y8&wۤjz#0[OۿL@g oVjvy"Q۷WWb6s#R$ksglfǮ}]4qxg`2i睠;'@űFcBWPrSJYnZZČCSOEɐVl2DSOol;C1?d};/r A71oAW?*\A0를'S_@S U9 S aQ Ump\bX1:s<|nUӘG[yͰx\;=GX~`_,p XV^/ZT_XQ1%'?Nޙ}C2StsƹUˠ(@#DЀAe% -%$I$|͠> stream xXKo6Wn&PoiQ_Z$]D*0Hj^R$eQg7͡_f8 ~quu{V r ZKUf}vbP7NpgGKe_ݻGT L{ϳb~k#49/@>\: r4;z$*9bi4b8SV˱ ٨Bőt.hί%Ხ(#V]!Uq HdJ])֤~`(uKQ(iS0 !u):.|mwK-)ZԖKy) c&K#I2ŧ 1D zabF[*VU$n/1EHD(pO3lZF$GUOqd6`Zٶf>QL `EKCd NWLqn?ALpUŇygbn ])Ĩ.~ŤZT>[ 4SݷJh::29Ŋe$+|rF'QP˃zxd" Bl׆G?~2XM<;@r狘|WW1Ut8ƛMX\Gp{/(\;lNi%b RB=WUiҶ*28.e uqj }F5Ԅ Ĺ"}aϘa?B'A-K>n*ufU2oM\=|w2Ͽ$Pr(~ކ5=^^(Y]mB:ۂCJ~*߮61spP\}U~Y/֯,dHZ@:}h$qY\JB259&x>,f×6Z+,ђo>T-x*G8NB6H 0B%h6҅ר3c[] ] endstream endobj 2289 0 obj << /Length 1154 /Filter /FlateDecode >> stream xXo6BpbE/?TL!0IAmhrI@QE_Nf|xwю/Y`v8f*\DZ`f]מJ?9 Eky:HS jaO;.Rfʹ`M M鸍)c8CТ}w\!}˥NLq*W6(> stream xW[F~ϯB:f2B - P P'Yl'f$Yo HCα}߹Mtb4;#+&qbi1JV Z<X]?"~"ɴmmR]R#]׊@:!t7Ohz-mq^ N:Vm0-QU.6 :vߞem2~y1>à!a[SFIkMGJQ]<?i 10);#<Y^?x@{WRbR m P 3<:I[0!qNvoLycZ5I&Ło\yِLlM 6:u]z*]sE\Չa}p$EVJ:+v<5SMQeZgz- ZDB3jr>BKv?U>z<]Xt)KMC63nč#˃zJjKNOYalV3兠GKee8bf^Z}'LnZt>|(zl)sËI&o Boc/BG/$u!>MV!8DP4)7P**ZκǨwu9JK0 W"oUR A"?Y2S,xtk$ 6n?#\D;~hbx`$4\/Slp/iSPЁ' Wפzdql/8߾5Rut5̠]kin)0!Ni҉H:A=Og.M7Se^42Վ*hD kT}7spu+\Ih$ `OՈSM5N"Q.WY)?^M<[+v:G{nGDNyDBو؏~HS6gр{>PsچǸhGWKpE6{W)ay4b}ꆑ9W|y,nb醡liZ孬CM.Z}Pk-$6†hIPgrj4.JwTWm%Ȑr%mY= al w1`@G,wR>ux> stream xڽXK6ϯ`j*Y;d3IR$L Azhc4F_7{~͋7RF<^LȋE"wއi__?x&"X!o {ApKǩn>{;ك4Г'aX hOcE20'iO3'YIjۢ:7jۮOVbZc_2G *F1jG M0Eze̒J6n6*_tN5!}x!"xcHc<Ţ>ףvqBd*W }1sEș bOւ )x0a<H pe4eزShR%Mwsݴjl%P䙭?>J@I㼬 ld xDQ ddM d woΚPVXwm^֙M'r|j|t@WR$u)bFa߿^$sTf_0մR9N6E/i h@anњ=`D\\h ۧNn ⱱU{8t:&8ѦrES-ͽĴ/߼z{x%(e"YB'^i$?_z pOfYvgz*IS {loкS;Zf;;^Cn!=O+pY wb{~4;nLw3E=:PwJt B 7oy*Y"%bb!^[EԲmڠ٨;-z"ӣfEEF֧E 5/r _ ?0$wva],iڣK:*6Ks^q>|^u@9${:~H_j)INStE<q N,YPNB=tkeَoDRF\Yaoim$ψJ: P7%RpJŷP rPGpfPI˝$1%0;qOM˔LJ&tzTlEIVPSS:&l})o9mС]Eg.f xf1\mPf>dAf_/}B$ժ)fNn͸:$:+5zY{%!;`ڛMu&n@֜8q MB[xvL endstream endobj 2326 0 obj << /Length 2297 /Filter /FlateDecode >> stream xڕXo6_a2V$Rnq^@q%am+(7)KR4pșpj V?_pu>V'"Y=Va2JViW_n'фU&S[rJ5޼rz##A7"d!Aj|",s{+^uHgnzq{mɏabz-b Tѫ'&‰,cQ~)标qU2`ڭ+GV6]mya1(9g&"?q;$ZU S8bѻ|DNwz8VL+` F8Od^Yz_hN ueziD9dea;B0C&Audbձѝ:CsJ2M<׀Q6/K_4b102?sn'|6[] ezN>6QCpz桟3uH3TxA IH`z^#~On#϶ Bp.\I,ev)y$%O$#~p*:?h"aU I'WT<XI"HVCi/4PMq,'a:;0 #nMP;7!'ִHfyA %@FzPl?ZZ4 9R#?B 9U(т6H_@a0:%70Kdz1vH2ߊR2X $xRmY;%0=cP/1KƷ"*WW^! NB\9 "+pAQLz5\|'+5Y'{`d{kՖ >NE?tDikaA{SR \pKw,|gWC6\|`ϟv wCav ["u)V`y|W.eB j9# C?q?=m%MuqD%mY4}w,}Vg/tP]QԒB&J$^v˳f qvzLuhLv|I{z EceҏU| ]a* endstream endobj 2337 0 obj << /Length 2650 /Filter /FlateDecode >> stream xYsܶ~_qucG HNL$6!N'XH|뻋K>u4#],V+뛋D0KD[qH&0M9ؕvk ]u_nry'Qi@3)N`v&J)|Ѵ^o"5gA |MZzz-Y.]4l_z.o4("tk?J^V߭y[;чcr, ~lvzp ŚZ`1ءD Tзbеߡ4Y]_۾ljAJy}˘`(6ڻ` AU^tܡ}o a*@>Jy][g BV{.)Tm5OĒW:'E9| " "ž bEaq[t,C%:-P_d!bCVpnrDADKEpk׷e޹Q EP#U/#yMπ\HF&'ria1Rw1^FMceM,e J$8cjِD"'F$a)rXu/-!_vcKUoY CdG2C@av:$b}IPT?$G oTsl Ǖ/K>b}f^+m/jrAcWvcٌe>=]`[rt&lƍ\a2UOUtU5uM%G p_pD0cPyÙXG{ >xho^ {Kda?*,kI{1_ĥ)-\\f|9,L-`'\ND!b.CJ0 "^gh&];d:VXH$01S̖iȡP@!?/\&9T)lD$Âa0fn%x j?.z^AÄHB8Ld²or SU]lzgH/ 9mD84C#ӽgW UWe'u~d9w#.+*-W풎߫b9}f<55gϑt*+p τ]EѰH2P[7ۋR)u17s{oZ[$q74kU掝)pˌ3-tgEo-~7JmM\Y 5ηyw喪|PNwIHբE.4)>.CLS2H oiEۀ)>g,iUGFzIqwezy[Q& >lKs5mt/`3s᮸U/ z"1fb|bʏ(&#F ,k8s ݋ vs(0H=bJ֊l\Cc繍3t]t9+yc[82 ~?0GjHlө?f퓐yfREiF?ou #yWs܌XcX.|m(0+zr ?GT֋ lyEN|(o=@ dғ9eSpm}$޸N_ > endstream endobj 2234 0 obj << /Type /ObjStm /N 100 /First 977 /Length 2112 /Filter /FlateDecode >> stream xZQs7~ׯcp\ @f&i&wd̵<KINʖ,^Y܃m.H  yLLK x "&"Yy(X9ewTRl@{!::"/TG/;6V !r0ʩ WtZN)LtM,I5g((N503;f.:,]J:VNzJ4,lH J Q֙ q|ِTbɔY`Q*9&wUbU#@x$WPɃ*s&-c :K,L1 U -j4cot~#,2F Tֱy5i9};5ز?Lx1~}ۧ>molԜ ~@iR48F!c3p6kor5Xu,mv}v:U,v˜ap6Ǎݖ%+n(Ombj]c]E B>ROU⢈!(E7>Lhw4yv;H,pĺ5ZDr¶6j/5[gq">Adi3x}ZD4`i3?'t識 J;GH0.>W&zrϱvd#Kx+Picz'[=m AcTV-;]ϥiOD[_ѷ;=AojH|pݱQ)DA쪶bK,}j~Uj96鈍dز 2wZ;=vJ')wS}w[NmRBE !ΠD5BhB87mڬǙC8ݙS"T*Xdm{PM;zk#7Aʬҕ\NWEVuwxVc_򻭊^'<6~Ưޓ YiM5l Kh*J<\99sjM^4+=GCX=9Q^I7To iq3Njś^,5WȲ-i)=G?#Y-E/m=m<{CgނVkm6β N;Dk!v Xl眶|[?&-)? 4BGn8V]֓t:d7]Z:Ii.i=& I1f Xi,ɷ);(SUz =z7b_oX:r+Rr\HG~@vM%V39Qڍ^nKq7zi]R5z> stream xXmBHQ@N\Em][Z),6%XpyF(v뻬JRJ&UDӔp!R"yѷ1͊w__I1a2%@a5zZm52_;'3"Z$Y,Sofϖpmt{6 ӛE֤1#̨$`UeYutoGntSwk*|[#r( 4'4>&Oڷӊö7`zzH8^OFA3|4CˆldÐ*3M$tF)8O- nHߠyOzJa~Sz#pqlH9#p|s.\H0#pG{[،]6Fs ?Q/lWL<0^j(tӂfv<[8r Z=j;tH8&*$"5"(x̽ խv=y4%L/apLjic擝 L/vud[ū_<GqPXD.IJe]}]հ .d5F\&l$fFBJ"S0(Wpq1Hm3, Tf9?~طS4/K70.0~Dx\&em}T 餽uq UI8KG4MIˏw{+'mba~nvy[禶n~q G otdhJJVNP*1^ťs^BA_]) <^HP( A=o¿,+X67Ŀ-2>N8+g.ldl%\A9uBWb'ٕ[ݣ'mgA.w5Ln `=f8ȟ&~%p/Q*Bpb3}ϳlh<\ΰuW~J"R|}鄞iI?7nW@~؏F`}67g OӖ endstream endobj 2351 0 obj << /Length 2422 /Filter /FlateDecode >> stream x]oܸ=bqmQ-EJD'yiW 4gMW\/qZɧ|3R_.9{Tۄ?ͫ2(Æ!bI9g2RbdTlՇ$ldR@"D!ҫНq!&ػ(,Q 3. Qw-ci)Li `vJOphw} vu;G馾ӕ6o7&5%Gp"y?]8tBovdKS]<5`")_Fux ~޿!an` ax(ko_l'|m_vS.B082hvhm7!d<%d~"YMޒs5N Ә6A@TQ7mƹGkKHa/ ]k~rGm.$M~N$ 亼*rŠ҅I[֢((a+2T{R!h]_6 5il0LpR)8aL lD9&ey'j3H(C̘4ErLRȧ$8Ar6OqRIϩ }MWŎ<F&OTu wcS-oNNfAe=1k7y1syE ބkGit[9ږD.!A|eQ2i'eaB)<]IBBb 53S];.PچAQtH|j<՘$$WO !6tޔF74 30a'<3 >FGp4o$h1)]V!٢!"ڥG( NEE;0+5 ᫺I"$yz{Q!ѿ_,|"'ˤ m$)`p]˫|jMK CvжD/[HOuelyܡ!&Nqy9@1WA]&PYVQdBwft!=l-p&­D A?.M=ct2 @D)-:-"J[adk¦`~0HHgL^M\Q-:˵=&HoV JM.BPst(p10A\2%m\J7|TmKD?]Œ'ϳ:VXW ߗC?Qt%>lw;$ m z.o-Rv={*/lұ+PAaK?p)opb5G>_rB%C9|>w2TmEp]9F-?k{HnhCZ<1^(:luTR֦ KG?dVҤW'W~ݛ=R!Yh[.J{N>O+?Ɂ=> stream xڵ]۸=@꠱B%w("pEѻ-д֒Bm'J;J,'A @|b?݋|SDBD*ћLHbsWmZCUZDyFܘU g~jT8 -wۻ 4:t= n7Y"Ձ>?I@")|Ecy7'Bsnd xLHp\˝ 1~%bt?;[ű,C# 7 ]ݡI%C8&t,1xwDs}|4dkZ۪i@a weCMHg:6m:f";tp/cd mC?2ʶ*h\ͫ氳IUD1QCqGaڒovAϥrh*=ݙFO$ʪݟƊ.*Ú"-ug5Q"9b:soBw"a|% 8XJQR>qiUm.Ie1ADZFJPgӴ4|`y,'#aJ9 2[Z?=^wTC f=ov&dbBDS3פKD%ϣ7Jln: IO!6:*2#W1ՈDn<%YO6KbV3ǕMTP dpLQKvQ)4Dw+/HWx~x fjW$ZI b8Xe_Ɔ4_C__N3P39 R\@ؖ6yQiM J2d@!'e4"-  ; F3E; K9ñDGi!-zShIе56 i5u3|:+;>A\ʾnkU<咅RY8&t$MYss>`Jz3JB]r°YK"trv0p5}'bQ7M,D:۟E/72kkC3BE8J6àGx  Tg }.} \I4z}í|A,](pK1q%PPr&^~vi*/ ֯d2XzeACҳ 1JC]`S4HF)} ԭ'cעq]b+ cJd2)[0HbOjZJ)5R,,c dz?umՠ5|#kH~=`E Nlɼ;zJM }٣bA+*ec@,oL^Q`Za2cj10 ϗ`:1 SwnȠu+Z5ɨԶj:H XS.v $D˹V3x(NNa-, ʱ;Z7w*i<j\zgg $*φI:^s&,6ԇPv$6xn?]S&&> +kJP|7b„Iܑq`(;uڃм2O8qK.US:zlR ~:`/k(/Z_KbՉqdS 9| )ޖ24d +a-^*^[0^wYJp[Ϧ ka`r %yϖnhÝ@yՖ5>}p|2IE^+qGa%ԌҧPZ@i!zNLݸ*]VK Q-GcML 0Yt(PaD59.("ݚ:08O)>D@]iWۥsOY;ǖl~`3-ܱsuq w?V&1yEoshoaxSksg87d σ m+,P6[qՑqn=Gdni$/OM۩AH!l 6W zAL=a cҐ}c.Ci mKOB4B:Ns.KGNVX,S+t5EX{;mt1l"p=.ʇ[|Aroip,}k75w'5On1Оi!|DjH^]/'^H"۹BTCY$9h¨/ɰFĽ04W8:R©'& 5TL;{8^S˂[d6ڱĜOsHG=C8(YA1a-.-vȑ&JPSUJCYG*S%ʌE);L|X"X>ItSMCX z¶6́#?]S*r?\_21;8·N~BVȈ63mUVUO}E@kڣmsYW 8"$Bu9_rEJ]JOrG&op`Շ},'d8@pOۨt@. %fٔaJSLH1EV@? V%~)@ÒNOڨ >Ͽ1T$Bsv- lUۻ" | endstream endobj 2361 0 obj << /Length 2713 /Filter /FlateDecode >> stream xڕYm6(pXkZ\/6 .$h[,ᐲ*A_3<3jbqusD<+X(dr&2_W6FZf8̑yy+<8芹MV0γF0IҰc<J7"Aw6=v-#cUM_ [)bFLx>2!N>YQVo/AM۪77zK}Pz T4OTީ 890cUz$cZ`'ETPKW>l&PAW:Aزhs_F:(bYؼ_ɒPgɈ$S82aM6QS@Qhnͳ`:Ry(,p*]Sy垪p<٨2QSYm\R9`}Њ`_j Ƃ8X`͐nKStJǕAw]siƎP^Wn+SW޸Xbmnp(G0p)XJp1NUt^MEJZeΟ:-Џ6uRj;סPǿLBw&JڨTn*X_!/f}GE$y7cv=yS:K w/^|Rqd<5N?ժw oZˣYRY.A5Gݺ@uqh${6PPA]QƏ~~dzal ¶ˢ WECy\n{;[t1 ahzG&+iݣ̓f8h:ه3օ19qc\6Att9f ~KPp_aZ7<BA_<hZD}?s`%\hω2P(_O|og=xbdKȉxI%B2r/#26"C"F Gf@Pt7.P/;MpD1咲sL;1pGsG٢T|YLɘf^_vm'h0=U2V';6 `fuw? l=Ra*f<[~Si@Mxf/G1'o)~pq+gI43<.%('eʮ5׌+]N8eVыZ?H0AIW!=@YTvq,g%PSUYojW1`rGJ<[p'ƻ Ȅݹ %b8BLgavRn關$;ɵ-򔌍BU2`&@Ξr*la&'rXʈaQH /2Pw>dCS |Q;ςjwJ><&E)&r|CFZ>KI }_2{ͮn6VFǃM b<FFZ|# 6-Pie~MI{B#_z0eg x9:||\i'<$f%eLw endstream endobj 2371 0 obj << /Length 2496 /Filter /FlateDecode >> stream xYI8W 4bF"6li {%&"I΋OfYEY;**X/^U'* &d!KDz(WÄohT$I E'[s[\,pn  IV[ 6<^VzGjubuI[ZPMjA1gXoQU.p{& fR0iG [Zsv֐#9BUcZ8[YOLQQ'ג%q|z[$e" JaarN <(݆Ktj6Gg 'Ea>P3V=E(٩r,0 g"z&X?ҷ0AKUF*$Plb#;OG5pm MMU@';חN56{MtR[׳ o. "BOY#W_<!ұtҘ T2Iur0͒bbz9B<tNң[eA(k@oYo' p9CQGZ{HJ1De&VRJROmwG9cknϕN!cuHǣiu,$kU AJ4dŞ438ꞻNPѪHpsЧ(N'̌foOOrA86Fv/9pHKxAVL[5u׷ -XvaaO, !jiFrk&jqo8B1o87 4\܌l vƫ{fPmu `,LXr9gODUOA B׋Dyb}x,*Nespn^QGvZ(wܨR`Pϧ| ٯaUK|`8TӘ!(`9QU0!ɮuSܐ$Az+'cLJW;pV;8Bidg.u ~xQ.o<3 ֑,s9ӻPe7f_hu̾$x' Ttw\N Q1픴8*Wda<0B^~I(-) YU9w#<- Gg,|04r_҇1se/'B3/ @Vx]V7N3'!\I6 퓷`=Uc٪A{"bq<@wȧrr4y{ XPsϳ⤒M G"K 'G BRZBg;A}R-TV?ޣ>KYnn(hAΡ >e_fqoT(( [`q4pm$ZV?H Q:8m\_";G΄;MӐ*%K/J#:]w oRwghf}*uQ輅M[\eۖ n'QfV,#٤IV0- ԱV@c E-<}3iqȂE$θGbNubT:D@ Kq4T0phTkhO0=p|i4(-Puhp^~:z`Epav=a))9hT IpG%<\WFʵ -FIAOГF,lXm6hwx"–Qآ2fNR՜4v~F{9c:dϯ'F8i8G}8V;`s4Z-4wEӠn"TyIuZw}Ev'Yyھh;6MKR @5!`0!l|In Gر%$}p^{4 H!bTT XYb Z)9bR}k<ߋJ8`mog^$^W` 8ۡdL5 b;a;h$W$q1Ӗ,%6%B~WS}dCG6IT2N #ǣ+dW vt+,l1۟Kn@2>5'O%#("Z$s z?Ͽq~vDW4n/vy'W> stream xXKo6W9@PD =) =hE-}TXVlޢ{$Ùo͈^AW78 8ja/ VbSۮX1NGk !DjFJZ# BD.FF) =GFSN C y.hV'ÜҼ>;s/zEֳNJw{$r4ڦn%Bh;_>}4L-zr "yR\m頻gj2w歶ARݛeKF+ڔSN%KSkv'ʀDDz`tCjkҢ~0tLZ70X-1Lu{D`ޫleKc w|2YޅJdmJ[nhY§ba/Wsc34+#k0WM^7/J([۾BV_T8$ @jYd/V9#=PCxl44 =UI'M Z6#!Jq\[*doЄ 4#Q Zo{> stream xXM60=Z+,Cf[iZl!Ɂh[$ח9#YɦbՐ33OC,R7Xx.|sy-bw#.{Ǐǧ_`#eQ RUlmjmo!y*<Ү7"h^4:^"M3?IhչVrYKyT.9qJ ^?t "Zlk>DbwUhNfCp׺@pNPwڽK!᠚A΋풅V6&L([[KߑK?p&` 2=Өչl&F9~f족BTFi[TE-JK#7 .}Z&FǢށ" еԞښq/ke/1Z⇾p/IY#NIg.^ Ob'pA(e~NnGjꟍ:8-ff4uDLق IP=ZM͏RK қОP| i6€6?q謘z^m!kZw!>N_6) +Ziݾ}0ϙ;p)bG7q $JTi<{қ!5]Z#DfjY${kBU<qs`W)NRAO`pݺ  rToa<,5F,uQBBM% vڡK0eOJ`{yٌϖX%iu_[BuLuWl-8%ٜpf{7yϙjWcu_@)8h$Wnpy/qyx{yx6rIS(uVm 9=,3#(?0lF*H=_ endstream endobj 2403 0 obj << /Length 1590 /Filter /FlateDecode >> stream xڵWKs6Wp|4ă N6IkkCIi 8! .dʑ3@p~{'擳+)ĒIo.RJ$4jquj׳ $aÎF&3r9P( H B/`0y|nFجp9~ѓ?NiY}NNyI$*dQ6Z,6WSJuZ-8 A l@/_7*W'ˤztY$Zd_1ʦIYLtQVK+u^;M_Yj'urZ $a a@I ?eP4KE`AȦ7nj+mIaIVY@a)H}*xX(}I G95+י.g ɀtwRJhot ;^*vNlA(>BBpGsӭ0[r#=$gP] ;!ktm\raVPx֑D.6SI~!AhBs.1L#5q h I F-<<^{m@ uM3"4`0_:YX03IXnweP!WfxG6EdQwj֞ADͨƭe-7;d1,S 7@"{a=Kih ]~J;+EU \1 v Kfmll7OfNuHL`݃  ~|h8aVc4VP`m f 0UQ725v1k198=83R8ʽqh0x;7gJ|v&2?9({Z. zr[ٷx#,FDifw;Z.ٽJ{̾:/EiC`]л rkX'e΢jW@s]= #% GFne]>}ّm87OfDQ*iF4Y(CCi1m~F\rMboJN̆ 7sΆ8ӥ,6-tf/vIX qנ|Sc0% "ξT ݶԫ4S?wKCBR*(}_'. endstream endobj 2380 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpvwx6Sd/Rbuild70522141f9a75/metafor/man/figures/plots-light.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 2405 0 R /BBox [0 0 720 308] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 2406 0 R/F3 2407 0 R>> /ExtGState << >>/ColorSpace << /sRGB 2408 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 2410 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 2381 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpvwx6Sd/Rbuild70522141f9a75/metafor/man/figures/plots-dark.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 2411 0 R /BBox [0 0 720 308] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 2412 0 R/F3 2413 0 R>> /ExtGState << >>/ColorSpace << /sRGB 2414 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 2416 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 2431 0 obj << /Length 2949 /Filter /FlateDecode >> stream xڭYܶbQFAS)K!.Z{X+mEpzcHJVrWϮ_*i~K)tbNWOE~w: &:BE1ldEoSWU$rqFP(ZmT Vg}Wȳ|Xotk_zƜ{]how04wwR+;^sӶpWXo8nEKDE䡮&vucvDٻ6 4 {S:S!iDNDx,$PAPkM^W|x^gwn0똬t}SUUyde[So ͚xwg.P:^,+1qWAPfgun.`~ M|̎ҼhK/T-AƱ/4֨_|4A-.4Al(jG vJ9`VlބRz_mD h! ݻ7 (+{D Io]DWmB>zYZkd 庵¿.vWD ;4gb&*˺cAI%)kZ26wEhhZ[Xm`sSe(OҌm0Cݗ.3m}4i5uˍLELg0h7 }/PT,?:AAۮ hA(MI@Ǵ]a@y2$L# dF iGmNf&dҁ,]*jmyaeRb _mLS=)HԿ3;c)cb /41A&l7p`n4.x~1%@(Rֽu']vG8l)KJj:}_e%8:\JW3cm0Pq8.t-1%/ᔍ4ZP?)'Pz=e̖9ohL2HQ k ):H0#q'/J"A3<)*5uɠBevp^O}p Yax ێ#X„@JJrjkm[ LtoU}^ b5+1UyG z a<;VݵmޢP 6 R2h[E;s2TB8<^'Y!kxĚd\By1G?O\Zw> stream xڝYYs6~ׯJ xl*Z;qWemU!IRCHÈDŽؖvA\D__hFn8d"u()MM.6m:/KN,Iv~t! //PД5n'VHmoM?n`(K7z@ڼ%0f*"c@ߚb="KUm[˝rۺvM Tvrhu9Di9<6YHb/8m3,HlR%_$I1s* dx'ͤ5]^54RmݗwÁZLe32ݐ^j {yZ,a1ߏg]Z7.L(X̲u۱1\㺼O}'4ɫ%V$ءju"h!/~(F[뇮^T=Umy‹~(=+J{$4H,I=Y )\[ zjRnoxZ u6fWԔ[4i4Z jg?E0Qc(=noI ^VIhyʲ ʤ7/^>D=nc4s:<%yշBcFn|wlpR8qE2ӪRdيsőH8{ .RF$ௗ Twe{ȑm{ij)s8C~)}N6 !)S9]{+ G>2OM* T1y t{c#S3P kѺ@Ch' ;9RJC oWaE 6V$lؔ%j15i~Ann.#%2%Ң@&cTgmX", ,VΛ=/'> Q63?rh.?x;­4#nY]YUT$g\KJ#s(a0۲> ufD c ДW]ϩMN۽Hu ۶]O>%-94֠Vt+ZD_^nES\A%$uG[vCENТ߼I>'J >[ËNᖿOτ| rzo p5-+("A:4 mĞG*el䏅]9=ru;]Xe@`O0|L8?Pz^7,ii벡cc$=Kz} oh뺶8&G6Gip-j b"o疞sĞCb 2A9ns۵5#jCj9 ۗ"*mS}た;._NLوTy0x&d(,!2\p ܥs`^f438@DZ vO4!}\7~9dNB#*j9HqT 0,>OF^Ƕ1a/^dyO ~f!$,6 a;"MV,\U"QYDqQkgS;tw C7tƻə*7|)&n*OZHE qql~}'i_}|!B|1$}k x S\mf]gq#2Q=rKAjQȑ]-q=Mx̩Q-YMk։H>Eʕ]5N+MUSSu߬h^𼅮Ln簤(-Enn%>WuU: OȎ(ɀvg0X.2BR|Ji&;U.X!mmp).5T5CD$e V΋ofR|e.x,1gс<{WUB'%:O5rDe wN}>LD|jEiHo7jqs[wk4ryj>C{( Y XqBBuHcNtק!6{@ybL[+25B7}3W\?_|ᢣqŠ+ @k$+wP/ BͰ t!}@m0Ty߹$* *,!L5} E[a%PLԹhi"Q7Ԣ%mB GSwU]92P+6*L¦T;4\=Eᯁ:c Ze6[l_5&\bQL:`kk0Bh4_L?Bv|Px;z2zx#!wUtw*0tcI ՘pl(xC#/h忉>ɱӌX3SE;:cO>e2>9cp+SKɉ䄒Kdga!Dz{D endstream endobj 2341 0 obj << /Type /ObjStm /N 100 /First 997 /Length 2697 /Filter /FlateDecode >> stream xZ[o~c/ w\i7HRt i쨑44(-%v"ch9߹4:6 5Y8 Ȇ>x6t%0 /Rrhx%r-#YtN^hK "i(tP$ZT$S聯̅ ֊ҞKP"c:-EgB7ONp#sRLXZ܌VՉ ,eiRI`Ke BM^ؤ[Ñq܊Q-ʼh@E&p~ݛ2 \p D wlU;XjAq~!0tǂE.YA6"T~"XC*ى| 3%X) хJQ#%YQn_,z&CYAq-+DRT % nHrv@Q*S̔ "(ZH"5xв"ZPV"{9Pt*vm9ڄ1p 2r 1@9:lJ $x01ŪT+?Z6#7DҦLc&䣓FT;^udz.⍂#Poߪg7|U/Q'8e&SH`*dҨqɉ^u+'ӹם|WϚE7^K;r?D,RT㟐ÉIbiN^;.r2vF?m]a)\˴p(T ?#աP7zb@ Ѷ)(@iQ|V/U œz|J{Q5GclwKBYŨYp/xR?j?N %f́j=@a_'?ů&*Y -"ǵYjOar;F @C >UfF'|F ݞxDvmq;gC+omQyuSQ]oj׾-w&z·pvPS&Ӌ2f ~Dx_mx4.}Z-Ԛ֫A ="I#O hdTON Q7iիo/;_\U>}OO_XE ">B#ILGmDjh&%NNF#T0s2˶NJ~p.MaǒvLaH.m`WEYlBXt{0UY^ݱt@# G3i{]LED:ʌJG 7Q,fs3-j8m Oο6بAo!po$#;I2_ro￿mpZL RIJQJTZͳQluPk աFjl,${0ۥ(A ?FI ޙ7)oY 7L=S=弡̣h>^45ٓkă'?eJkcl_zMROFK;_uEըYeǛZt+s*y QUg3gl ߚǦQ;l[fJ?=jk=~9cs!Z{Adp\v?6q\&RP{vʹ9`ar9ǦGFh5;6n27լ--z4K,'JuZ`jNŏWzMUWgPj["h5[ rIx" "=AL5r-@>-Y.7N:3l)ᎇryc~@6; 6R[MKψ0Ƹ#gl@F&k=#K128ISKM1qe3f: D/u7XgQ;?c\0$/؉VFc JҘ| ʽ٘6Ѻ] X9K~ d 0v4dKruK1Zff|6+WvU$WԇVj_toaoưG{HlU; {ox7b`W؇!#[1_ًC%'Pacoxi3VOn<:1X%v<tBls'ns'OHG)ky2m`j݇A`9:%p;>+y2\ F+f2cW'3PO 9X$fG$Id'_*/ef9]%TBVi`Pc|O5O|Xˎ}xw0Z> f\So $M⏿"Ds7-emGhϰ5? endstream endobj 2475 0 obj << /Length 2765 /Filter /FlateDecode >> stream xڝYIsFW2lhlLM3Nxj25!ClJ@|>ok,$,K.U~/nW~u6kNdq_t, P^/w߽ ɖ$T8Ia#":vUm|9l2d SԼ_Ukpxi(G"_6}&GJw!'m{;_g}U 0Es7aL$v2Jf,YP,t8=uNVY 笴x}:UNGSOUmWeHާۼp0\q,6%ǺZwv'ֶ ծ6:8R-ev#w6B30`֔7yys9aݓTT{cIlh$ mѴ&/qĞyto81 UKlK[wLc}]a(j<>pfkd5fBZat5?a3sZ`!Xc=ù៣\5<S]Qj[>a#*Ƣ2 dR Db̺Q> h@vͱM>/aX)~Pylf@Zw!R=R -SZgԎx?VLK9$.'oH r W]ˤIILY[O^P8b7DU0pVWwur^u P%y1ĩ~Ǚϔ ʃFwmoy"E1pI&_!i|;v;[n?Tas~ښb$&jșXE#8a@g13tkh 4G)!}lpScaw[յ- vpqRe>Yo5I+Th,ڹ&$p\3ԅ1'U2z_/4Lمpe%Zâ |"LtJ9}6>C6K,Tq :vcF>8IGUC:p{@Ȃ1[κ0FhvܮhL-%*с l#OPY&K*BǙ]0`[st^QE }kS+ăuk˷t+a}G@3;ő8L[pcixaԯ1y0P=@,1N3Zq'c*Si12:'K=8(N^_RpXm{`l"zް؋UdgUR^~l bWBJ1/ UL @ˏ%T{L[ur+8{\zr3_CFBfVcYs7ܔMgF$2sC y TǾ?&5N08w\mG9veJ|ddoaRdkYjXVOiZNI.ٰɉ[$ۑU2kNcF> stream xڥZs8_᧎"zݮy.XZ/݄.Q58nS.K\ֶ%Oޯ{?#Kq7pΰșHNb\_l@ *ﭥ{PYB+KSJgAfF8B#p1J gƲa a\l,tE w pr懯7E&G!u[UYyCU<MHu[%NJYr-BY,"ar~8OY"87AB~[;i# aZf?G;D9ΰJȎC@8C2&0c,D(f)+2(,j|"-]n!Qj(ڢ4Fp-F#u)f(@d:`;3_h%@Bqo!%pp-xCw]RBU-Bh]w2򬠀'c϶7WS\*rw=NJ'{ND{wSPR%g߁Ȕǀ۝ƝAZ \z0|7Vw{bhwȠ\dp!R oy LWi9"N.!'=unߠl"tg1ӘkoFb]iپ 7{ ^n]Y})#ÖdbT |sy9QJC2\lA8`SFs5R7O@ ?cs^Ӏۛ?QpͿᲶ[76}nooYXhSzN)ƟU[ϩi_ˮ7ktJD}QӼ(ubdw>scy a* 1&'~3Q dz 0)ǃZ㙽:CHJ X}t/WA83\˷b< v_r ;aSr /G. eD| Wi2?'C!or?Vzn͊ M_L]/#kpS8vQD|J",~-|(i,~2*ֹk00^ MK3Zsxx%.Q0O,X:e\d ),኱#\o(d0xd"T/OUvfV4ݧ8Ǘ딳.||Uձ0<UH`_`Ћ]&`GJYZ ~bpT6$MW2 ey*PU<aBDP ,< ͇(5[,ILvWBV^Wy}X%d.R$F/+xj!q]mVs\0"ypsX HwժT-Nyz2uP ָZ$|=_@rWl()`a12T<5 +jo]VU6&A)=oC7}"Ӊc2%v~ٙBInP +X*Sz$j9q. v^@6-weq.H_n w- c,.>+Uy*˾W~^ w]Yt8Qcw _a1towM dC˻)ӏ^5QǯiW4[=ʹwp =^y!ϖG9[;xL> stream xXKs8Wf&TUA𱵵&Ζ'9$$1H-IEFiSVft9ӷW7 Mc2,s` OoGO|ETZ!)3f$Ƅ=\Iiߝ,\Yl|`˲I x9[ō\sɹQH;:l׆iY܂RfI1՗^FeEK$Hu^3hq&iӺ5Y\kMMya9*d<՗N#i,:)Fl֫NFgRsO n `FUl뿜eejy&83+2#_ 35L4= CfBTeq'1b%F+$\[~݊?&]5wT3{NY,=^"URbCE:N8յ/6|e^X]ayf˜]R,g2y]uR4u6"p42q= 2Sr;)uIDPfJ"IcGہf$(`BqmgCiǕMRTY/``=xмSGL }%֘hB@U5τ/(Jܦ[n{'2SP,0Hoi.'rA!`@RTV>F5-PPh&m\4&@CG̏Z^[*50o] Zv 8yeVɗZq[$w=1GŏG# T%@AGWsǀ`\Ha w@ `eNnr`'P Imjz"h͊%* 'K3Z0~4wq‹XŮE'B+a9\FUpJU*jG|!S|*`r8fcF]h/] H hN7_҆D1 L҆^ o_w, 2D%<pKkSUE-|F \c߾6!C4Z=v9cJ zXИT \p#[cçc.À &@8-c)4sRGh9ƍc[IB./>2ZC3Bm}P^)@yI[Nlᦌ1d1ߢ7[W6pF:V?+pIчi S~a.eh+Zs˥V#Rz&-\X04_ܓx,I8mzzUj}q2 K7[Tƌ5`.3 nܟDT/]yTF.Ty [D-G %j'=I;D{sAٓ9>}>NT=u-=y^NK~qDc "qFF;b-hlMNb߳30C@ [8, ([Gp@)MQܡ/# endstream endobj 2511 0 obj << /Length 1607 /Filter /FlateDecode >> stream xXYoF~ׯ Kh .Rhk+OIȕĖÖ_;E 3ܲe[Ͼ[̊H;ZԶ|+nd mD,xs녽 n aJ"S5ˡG"G-mWphW!"UrK^ۨ 9wH:b6mUzROQeɰzRòՑ0F@0VSx]8e \iD& qI1ǶCԲjV,lMkÀ;qy~<}u !ukӪvMK$2p tV~=AXQɏld'_+}Vo+i#x >0e#Ujx%]ژ ESKCN"AMr@0<4Hؿ?GuF~1yjAEќ}{\t/\e)=ꫡJ&"M042Ahz|`"8t2|p^Dn|@TjHWŲ az_Yƪd~IE hXgآ6KѨ{ pChD_ߋY}}^Qbts'!\Xjs-א!Gu?Ka_$o[aV{_c_6@JE-:5Eꊔ 2Q"04MJ0tz Mu [F98<'=^!bbh *]#**3<7(TSy!2eS2pw ܝVsG\}'Cx\Mt K4cNR.62sFt1xzo6Љ"gkcbu"B2k-%" endstream endobj 2521 0 obj << /Length 3191 /Filter /FlateDecode >> stream xڥZݏܶ_q}$EIT<ݤ( h};JVg;-a)~ |㝼ӫ?ܿz>w(s?))EjB)*_~>7Դd IןFJ4{]@gJ$Nc=+\V-Xwmi'u;ʒGcG wQo{=N0]%OiE'dŕYF n6#ҐE2ye?_g2vQ"crM];]RlOb-~ 1=CSX5aRе"WiGs$9W_tAy%^r48zWӼLy5KnG- Ejc9_wtAp+^*_OFoWw!o,̫w&8>CVM["tcU7 40Z 1kjG@&}@_]? +D\F$Z^X}N$urx c hv*[coSw\+?ڊN5,e~4eja6rcL%`_G>U\s\fneƥ.]OT~B}cj\C׀588S9>:~}5sS s1NyOqB={SRT4#!b'AҥH\Lك7!j*+Aeu"S&[i6ָ>5pl[V͔&[ө![^5<;T/{X {Vƾ8]R1*ͮ\ fkM>#{(ahiA4*PMt \ RAQLH2 kM9,mL0 /lqXξtYrfI\\^6=3`\o-I$_K$$́H || 3B7cۯoyԃUKiȊqiwLjw|m-57`S@VYrdhNC}>/~Zrح[~[6tJo!m8dž6-*`![/EvQ[ĵ= 5 O蟹D*E>%Ȝ~IjGe(%m[Knif!o}0>f c0OI: C}hG!!^}jx/L,Ph#oUAEե>y[1 L0c NQa@SXC ?oeJbSYF)YE<_N@h/{G,X+9Bw8n<(5{ YHK`BRBY/)8__reƿF*l+/quT姩yVz7Y/̍c(iEnO#7et Wɍsh%lsaPpz^%T]KH?}y`4Oh'dBHS,C'P WD"l˜st&?Q~!Fy(^F~i.o+vmYLT<%v+f bO}ԠK qtƪsT;忖HӼ1c`6'E;F-qa .& 4IT/-v+t^D* 0]ϡ׬Z=~r#,?qiȲ] RKxN_ھR _)ϰU"&d9 Yy* a"5bΎ+cHĔݒ%BVv"N\ПD@YFK%^ >*$k4Qj.C[v+Ш*дwn& Qց9%[G>ƭsZLe_~,8u\ R}0:!@#zK!L jEy-{@ϋ0 A '+"1ȗmqц|To_e;C8A=faQVJ+Ϡ ' | qfl$&9?,}HkՅ|Qfu2~ >C vvCuqϵ\ilʆkjT%`V_D7Xcdl*>#TֆIuYODHJ!i+&~LXY.2T|`'#,i=QMp-`;>M=hMU̠ *K>,-䰸ˤOk3"7Z hjqV#vwqW;xH5xm%R+!5aqLU)e;j[H1bM9=/ΠkR>tUR k#Fr*wjc*9TN !8eX@ U@h 4ǷoL g 2(`szoJYQ,ry`31+Eؚ:u pMU[\ݖAfRiz'FGYK*BY,P҃'r  Kn=ĤCPCM)ł6FE`ryA`xj1 T(  byjTP` \z P4Re+f#ss~)fm&!#L`gZcmF@sS~wz endstream endobj 2530 0 obj << /Length 2558 /Filter /FlateDecode >> stream xY[۸~ϯ0d1#؇`ӦnYȒKΞ %GNOEa!9FM^~D\L6wMBE& C|sWm<vqMPy"<,i*$zJCf/S4Lv8iltM}eP_ԏLV|؅V[碮1Ցcc>˧E=^*J8w()8;(o~+r髫cǦLkQ(%Hm :S{VMv#d1DL 2S?+{`y)O@@v+Dx"~:͡@V70)3 }eFЩÊD`zZ.]m X(pHaDngZluR R@-Ҽ\V5Q^eL{6&ٷ#N9e; Q4 ءB +:!f:q4X1mGYU!A N ORc^4U{noM)gY bp-&tDKȮlBzE0?_د@vmX8 }|1ߛ*,xwr+v2@gĦ~^,口[muOV 8F!qn4y6(J7%s|?YV/L(rqn6w|1[% yӈamCa==|h_. ~ ͻ!ID.`][,[}qfr vhRƮoӟq ;i=:jk8yUk=iZCyqnS,ԡgi*GgRr C<4+F$6Q`y5*k 1܎u;w Z܇g+v8;Ga,ra`uG뫡X'¬BH$ .37B)G`Ol,dl^o7uʰCDDj=h< D,P{j?@1Blh;t*5&E?ؐtG?Rgriki@Qi 0_dU*P`)^igѥ9>Mq͓D7~ HWb pk5ut(;MQtAdr|Fys^Qpp"x`~M2]eySAJ{mֽa .n"H9 >7怨Usj?%! z]A={#=D[O2&ȪHvu/? =<bɱO_ _҈|aSJJJ尙DW, ]@D澜 @G4ܭ^F%SqeDZȢd 4/j4KUT]uFOJ5rRRxB<_Ҟ2TU(Nyʘ.kAsOgA64K?'W މM:ŮE$\ 1ƥC 98"ɧ.9H)ew5IΗʕ+sKNJSJ4^۰#ߔQ"ze* r'G9`S$.M ]X`*]ˉ4/ߒ2tO{}雱W'2) ^e|wn Tw9>[X `!%?bܭ*U"+ ~K7M{Ee8;vB J[GN%O]b_+j{sc[X(ZmV>7%H35-VVK,*d~Ws_Td#Y;p# /`5]AQ!Ttqbp 1'xPjK}o*]9Qd;X"iaUp-GRmL)8YTx; gL :*8]ժtw endstream endobj 2543 0 obj << /Length 3438 /Filter /FlateDecode >> stream xڥZo6=Q -HhKIS4E/84W@^^%Vqze7@D )7PϮG__<:g+gWgsR}f`Zgo0??d2޺> 'ӯUҀPѣ֮J0GٯDR #InIR^“}Kξ>hZ4ݎDUZq4ބSfFŽBѨ49|Ylul8;|L83Yv]p%Sf0ޤɳȒ#ᾭa[$7u]ٷ{Cv1n_v޼8:W{bf%xҮ]] " \_,)w0*. ʮ7]Q_f+ rSW"Ѥ R$G &8\r\OKv6LYX6q %F~ \tkz-~lْkQ}7Am ]ɾKz}wr,)r&"-=bk; =ҌGHH41 !)DNB >A ?R(eXꇑ`˜L($ x(`|eP3x M hj,2\ M8膰+,Anي慣i6e޶sa`Gh] ˺޳[e8<*m"Js+x(#ڲa AO+[KT |li;W$#0Z ;P^=P9db{?މUL8› $^}pHeCe[`_5`-uMUnKy}6kԪQSAA$]Ǥ~f R~vi;X>#9h`ɈT1T96 pwS){;|Vڮ=gYB\\3 23귖ШFWwtSDzPb(䩢G/I35d`#{{n7KP?t{G)ݾ|ʸk`4'G!aGK~²b/eMP;&@,S*@(W񿶮h_އT@-(Wq@HڌJ[:X$'Îm M\s46HYy>.+Zb s?l~ #<x?[o{>/# Tviw.DbeHFJMݰl՛rGҾM 帏%KY1ڱv`oXM0k 5M/O\/[E3+(L QU{c~.y5d:n4Bj\w=b,[!}qؚ Fd^Kpz[Vi!Q?|!_w'07 U-TeKFKDAט#' bY̩z_f(q7i0/*cbN8_tŢ>HqWvWO=i^uKZДzmCn,ab,14JwYևQ1MP+S*=+d!)NBo?! BDTl9v-IS&ׇ !b/o\~qoc $&}'RbpjcBZh'Z}FL!TBv!>:3BSY)0)yC œ %mS(CCps8  pu my8&ՈyX‡[ FZuU?щʅ Yb!p'eE~nHAƓcm;_EOr}"9<|W´Vv/ˣ]rޱ?/P()k.BY8?aqLL9j~)Wz`PNn˦4&U-8yyL>"kJ$00h!QEH|痕Bx`H-PW) HZMu ~0 u#PqO!t>VwW>jD n@Mތob2xJjkts1KeiRBe;7&~޶N #9/&8Өɠg n 0'B4>.@]O#R< t{A 쒩$3Ew=h+LE򓍟_`!ֻw_'GWQ;9<9Ȓɏʄ <@baAmG:0ya)7 S4ڽ\lp -4KǝORםux4d|Ȫ >:ںxMחZK2fr1&Ę Z+2ef6\<esW0\* >/'NEʑgR ΃66܌"/M@BzExXKP8!Kޕsˉ)=v'iƄC:qЈ/ǂU ]]@mm?QZ˥BdйVs=W\-b_cds ],Dv`\FdHJ(xnݔð9m}kp58YC t=qF@灅@B@4:<@_GֳC1gkS}ܭ?ض@ٯgf_Z`[>V# SwOy}U~ O.{*pcpIfSO[&sraAzbk]~=[Cz9HAGܙ endstream endobj 2552 0 obj << /Length 1194 /Filter /FlateDecode >> stream xڽWIoFW!6b\ͭ-ЦuSÐYӐefh=FR eA 7{[werv.;'a,WN^4O4$ʝe|Txette]nEyy< 塙ottڵ0H_O5;ׇ~^09dEc2 r/ [u-dz>b_QaRښeϾ M6575)ך`tx`.H+i[ug @gWks3FZqJk}VmV/qRP}3k_ 4REJzMTTŚV|9ʹ03+x,&0ȩe_lCSIE&] ͳ<xyhQ5LV䉌>xEͦ|"9vGe xAz۴ -Rҍ}uH`=&_ %#kZ9H] 4@]?{@hrWHS?z\~^ݝ]d!6YߛYIWl)h^Q" Agū.VqDP}?T dX>ߨ1ڛc{;EF.") m6nI;$BNXxJhΩkF\ 5OǘiKrŧ],=pfkVY7dcW#kcG:BjPGV.8> 銚#O=aN"QURR =cͶ Ock l"HV%62uj/`P;r~mK+O?(Zy+no3a:4*+ lA=G Y.)aeitOkbkߴ$/} 66:t];gLtS$sE^S_7v^]X֯y TC0;XЇ;t U endstream endobj 2563 0 obj << /Length 1753 /Filter /FlateDecode >> stream xXK60CCO{hM,ѶY2D9;zx4p͓Ռ~ypM<=,gR"p1FBGExVPmY$mv%i6濡v#,sQWReMm-),!QbUY;R8ˬUvL£ 10SwyI%ct`N94#Q};=zods/F#a'AĜ'Iw # } ~NԜ>F ] u=B,6ez[8(J贵lmVji'h֦mu.c}xm%n<3;.=cBMQ{2vY꬛{NcqQLV`,V"eJDx܅JhӢ9j ?0=:$H49cZ8"AĈ0qqˁpLZmS@#q݄  R ~'i4qL: Aʋ,m%xi/gb9ji,>0rY:nz& 2&Ovp\HUv[,4EQkoc{[dqI *GZV7T2gB/K W@&%I ]HF;gR/pqlˈefOw]zmi gOb/(-$XiylD'jP7;5n0VTm?SSDwTU u/ۉjC?;o> >É vI{rS2?oeӸz}NOsftf6lכy90j3 R^^)Ι߬( OW_bUsUk?BE:}#yxԵ-1CvK;o\v1%x|tP YdA*^,'^/ƍg:r5_D+'KĶ\ƑͶK"\MUvy zO#_4(p}HUSy}~uF@yZR !:V b=qF1A Vɬ&t^ Owͮ\cƃ{)};1xe...=]e/IHw9ۦMlOĸZ|F? ]C/d7 ?soS7)M(//ڥei ȥe.7mj>4 Ё ǯ!(U} &4%fYm2c)Dz1 nHf oH"J7'6[_qE[cJ1E]؜ J{yDJ.mR04A<&?زɌd[i6uQVPZCeLO 1X֞fH&P׻.5 z]5QT=}!W 6N;12_} endstream endobj 2457 0 obj << /Type /ObjStm /N 100 /First 990 /Length 2494 /Filter /FlateDecode >> stream xZo~_A/s9$? W'ŵ BױYJ7V,Zk.8~3\}VFY" \"D֋T҆YqVYM&H5*X)ArH(fQI$iBiKY$8/tdग!!Pcy#9 *82s"嬗 \.]94W.qcҮ{=)% OAN[w1cV!CPt#oHUD›1`6^{ +Fe>YQnqɶOf.!#,ZH\:\ #rX# :! j=HdK'RRTZYdHb l N֌1 = 3ҳuOFKbtXl.F*RTf1p;R10:ALaq[<1=)K.d L+Y11vI%_𹬠1W)Q4-R,J/ )yx2ykf,XTޅ0̓aP!Akg,DN$͡7FeY2;[0,b8pN2x%m3mɉ}LS\د[]@mj_^U p "Y?U̚UT˛z_֪Gx$ ~]s}T@Tf1k{.G?67`u=#6Cˆ}X.SbJH+B^ tu !B7Dz]qGջŧ\rճ2Gss*1jXXYM:íC&mDe}ߩOFUowS=, @# -B W_do=i>0>Obm Ѯ.#B$|]v":MO١p}(fâ毱wc GٽFQ{^6z-q[.4)t0Gi1owo`jE)"%e1jS^ͥLz}rRF^fZ~}wѶj<su=Axn4=v9x5eoP!Hg„hgФ1E\^ `bMa , C0c/㔝6)aX[౗`$lqUA A$x٨գXCaGAKƱOBz2]_N}AuvziGi=_]wuY?/%bLɚ AB7xn}Ef)m31MӌggLݝӱԱCCg ƒIN_Q:ɡk$ZR4췰ќ_N53X!ACIؗ9mzY0WҀf2"oB ->1'WY=y/D"G>*[x AiѷUݎ^ wuWG4uL0=oߴ@:o6 SSSH52~]JpݳLp[u:uvvA.n?]xm ,=v`ܷ5Xl}g)Ȯgk Rך"!NfBnNT\C}|K*VnrW#˫;DQc j]aX})aɲ^@.@XG^HeA4^೶ i7˶R.q.96w2 =[[س1Lz֢:;垭]V_ܥO)v8Dܳ=:<րMrbQ'!;]m4gAfwe^V0:`PIvf{m:|Ws++l4 VH 5HK\JAe mH/gWϐ"LX%5n煅ܶo*|ͅ{'u-5?Ƶ=ZG۳1 [r ߌ 7ȷcݶ{:].vB{)Ig'_?TɜunY3޾[uz_}^MgM=㷞էz6?B.Fr1LZȒXvQ,^zԕ|"eq9mz>HBC6cU!yF*$70ck6T:!;)f84=1¦_WߙpQ wϒc`ç+i0<[ IӳXCm8IqV8;~SL䜥gk3z,qF%F>{5–|}pZL/X( _R`rGM!т$Iz.{1 s;2pxe@e|/sg±vGs 8 endstream endobj 2573 0 obj << /Length 1679 /Filter /FlateDecode >> stream xڝWK60Cez&mR$͢=$-JKD Q!)Y*M0p^f8݌~{xw6gb?=ngR,aA6{,fc$/||6J,&ILϒSɀ{ձ{WpY:Q/IǽX8m7RUvsCmZjOR8T ݖǷ:ec(x#~,ܩ//ZjwPԟeGG:"ÏݷF!QIG]̍MQ bdIE3VOh1tjRsHe+FqT!JK o'QIY4fWa h#Y ;&W"ydӊ?I=X^&x$X nk7Q[;E#jmUvZh](Ǜ$4XWۭDh;qk'|"+XA( ]0qпHH}G=> L,&YF `9 SRB{5*;e$h#Uv^õ | [98"/:;My *H3'!\JD"6 LR  '>"`6 /KPR0ڃ 8$Y:/zDE.Ȗ;Xsظ7`8)ǒwe+|3ֳQwOM,3xG] ޛ1Ʀ<*Y5튬 C=7.(~.e bQ훩z`Qx;Z@ɪpݯkdp+[Hڄ pz v4m9^iQY$UsI@Rx{Gz2)۸0Mi}yc)u (*O`^-"LryicRO"*'Eo6<B/e_T_OهҴ:ʔXU~ļ;Gj4G|& 6bbSFy r]mBM3X{xy}}ʨCd ;hXI20/>n` rwȖyX= _02N9|ģ 1T[^+o Er[$wDk9Wi_xBFfzMhA\Z bJ&=}AS(H04Z b"i0NOB>_s4ג`5mmwc㲲cnf'ܭMVs:'Kl<.P&!](Sz5mvZ%j8 PҦe5T O|6Kg'^Kޥy( } ˕F;w_KTnY%vnu~+`v-| dﺂ2ġo\ˆkezl?4hE:'yc7wP9l%RYڀ Lrkc)0ŅЀ+ƮCP8XJt~ q}3lЩs8oX~1,[ԽFe`?#l.&]J/< Qʧqktt OWVYRE5P Y> stream xXKo6Wad`#J0N jD-uD)v-zEAdH*V ]|u{Sy9˓0n<,rΒ(nw>O_o)3(NX.r82gV;H~-׷\p/H҄<Ͽ`)ϼ{zȐƵwsxjEs-x$Y' -lCg)w Ne];ο^ 5)5?%ՁXOtǟ9,?t%k$X/w ډXHnUibD"[Б_vWpĖgslI9&<;qȢ@8v˪Q$A2{n#A2SJBxeMgL(܈E);Yʤ(uUތSvTEuw"b ݫFU I%Щn[6Q`5WRZ"Qˎv4opZWjEaہ˹{ѸwBJC(T(oC@]BL  eA[Ba\]Z>7+bs&p~28L+Y-1onD-Uyx4f{G c2d,S7tF)t[x8CpF6b< J(O΢6K1HeF4 Mq`ݒgq.` Ҷ@'߬yV^3AaE j>J 8DL$ 3@2< ;zb NE1,P>ӳQ̓ݢ%ZJ/;_Xlk>*Mn M#Ww(c&)6L8{HU><+7xH>ӗ\? thUEyhӶ`qD>lzm&2Z>Z9a X k@C:ZsDJhԯOW5o7}Uyh4_cf~M}ďns,q6fjӬ$ Htl橩X3QCE|l6I&*H쟅d?Wu*LjFcL7[~qƞ?=T ecm+rj̷WI@>`y| Ìf׷-;KN>ps&yѮr5kMY^loۋ% endstream endobj 2596 0 obj << /Length 2419 /Filter /FlateDecode >> stream xڭYmo6b  KnMY\$wн[3cYv&Gv4 A"ꍢH>$؋^w_$, pq]8wYZ-RJ`>8}#=*׌gK-@>.E fO &G:@uf:PcIDC9|#'R21<>$/9L\}Lx6CG=Ǘ [@2HNI:.^l0Μ;p. v.(8_=(j#'xu@/uPoO؋#sm :!ݣ;2tBB45CQ-:7vSIsGɌN&<@`֖Hx6|9O:C\b%vD&Zޞ+.~k Ѭk}b=  ۻ 9N 5Mȅvtb|8ǙW>NP;J(3}osYd3|}9,KK8Ɣ.-gX͘)j N"D(.o)r GЏ5 yd'ylɂ5+qCuQEo\~_pb3}'пh$͆CZ"G{x'HC]}T˪z7E:b@5$ɦ9:V'6:V EPQ)w-B(Skq'3z8]1CsE~F/+ nZ_w+ e.#2[? v\J:3Mh-!~@PGh_i33D9a0" ,qϠl|-xz#0D> stream xڝXKs6WpC !>3!i4i#d$Kl)R%H]`L;G.rXfֳW^hE$o-8PJ|Yզ3r7 A^t˚d7Ǥ)2i昳^_qng޾`09 yr"!g$\R9S yCUnZ^mu S(hhNL+VmؘeVBB6-FHfc #!15vw#dl>~ꝙZFDZ9N1rKA6W.CW^%gvr=oFac'V}XGuK \tnfu;j}Z#8_E e$ i *,ؿzWn.SīqB0LLķ+i,FZڎsDo|zުըK:F1\7c)1]Y䋡^])C*O1 |©+x+&c[@8~(q/`jWp<-1i D3獣Ozpr倵N$&STBGܦ٪ y|yyYbI[!\:nډd:6(-sRf@iS)\w@0qS^L ܞJZ00΋a0XeRY!L:f\~$Ւq!Q1m]b!#B$ psη'`.K|{̖fw< ,EeV9F4fjۢuJd]EkamAmq07rvlÐ}s R Y s"֠"efN=5wܱnvlE% xoY58t26- D^L[6UXpJI.SDnP؎Oa.1iuIJGP:A 3J྿zwG~N0M=ٵvjf!4S&.>D!g>m,D0Hv'&-' *fu SDlrP/_O3C$'g1C8Ch*^!M aC lD! O[R_Rl$e4;,A`LBY {- Rgs 3¼APA5 m.U*Y1AN|jv>pn$| C"$$<~hI-L-st, Ԇ9(^Ot(˳RGĥk6HUA3aFQM\m*two[!9V͠zIGs6HUD.."oي:(u l Cj鰅9 ,j 'Ie2\#D1͉;UE3I Z*)*-Sëib̋;n"ڎĴ$yyڤ(Xcû$Y!yiS[,n_[ P"% y-ԣ "w0o #˶?OXkqގ\^T >c_3|p["ɑ絨 =dp)a&/N-ۃRtk}T%pe<SZDt+Oo~PMw4s?!gP.Od;ҬJPH[= 7nDީ׮7/C,dYc`:y\ka~ endstream endobj 2618 0 obj << /Length 2935 /Filter /FlateDecode >> stream xڵYmDb(R^"Em! Pٖmli_Pe͇]S9>> WUݗw/^e"3Y=V2 fH)VDYJ4\U//tUeF$Y&J\tYŽR]v&J`R;;)1"K#wPؕu@!vw]ڮ)#jm]yxSA+jτsа>cQbDO m,덒a àeT?c?ѨlyU[i72y Nf#H&HpMƑ)<Bs8i!)bHax=Y(QXUGC7ThD}Que~ǍpKQ x`6`6, p# CͻeUuUn$vִB ew":hgɇEǢ*ĎFkؖ;+44.LF(w\ tKuh]Ƃg0ö}Nύ \u5Lʼn:!:S+TXjKA/@kt2aUF\8ja{~,h=DȳQ E 7A5hÐPH-gx"$;~~$I~kB>q$U,B^~EdTrwG,{z,w9)H*/ӥyO1-2S$^*1'V`mr}>׈g ]_xd%i0w-d˼~+R |%Pֱ/v W{x H veC8]yT%y{f~0DeÅ`D k." pHfkpr{y6PMA;[`:qE4洢sTS {řC腌2?jH@P veA+&Z5n94 c:Љ~/Nf$uVjGLp0h4g:ݩܴ?T`!f-Ms*Ƥ3 #ͻ${† /`w[ /tA M-)2Rwi.};˹vOo I?F @s^cyAKf}<| dyq_> W# ｌE5FH Iz~T ^p9Кx μ͆~\ 90ԧMc\ Ƃ+ڂ.A{9::XQ\/kfLn+(g¤ 4WDML1䤖{{r/0d\V& )]$b_|!(ڰiif_;4l7pHO5y>=ocN[8SݔUg4PHm,N,}L1n>UrWgPd0TJIiZ20!)& M]+%hzŋ6M0p3D$dc5'mm{y"Sak(Hi>`uʧ1?3VVQ_||%"y8d`DO!9_tp&dBͩW\tFpTgG$̩V:e,9W w;*w;v09 uh( |Gt#*ϦG7[`Xh@yAʫ $:|g靂zRwx*c&09lP*/NͬK$)+ XW40V:ƧgƧ}Ӄi6>%$$ HD$7_|w{SGwhp;6+(bY/{)_d~ ^Ȃ3MAFt˽ |QZ1'20PDBmjP|]4(Wh~ `˒w՘r;?Lܗaצz6!c L]8k9&9ɲ~(m5ݼ^BJ/% `!D3o5Dnc ޖ2؝~qy.ٖ]7O7-sXr(B ~G.5s'fm_Fw.;j":ϣqU`P$.ogX\?S`|81sm*mhpeK汩_đHlxR=_xq^ {w]:% endstream endobj 2627 0 obj << /Length 1385 /Filter /FlateDecode >> stream xڝVɎ8+01MR{0>d$vfIDȢ#J\ۧ(Vgťzb=_8-1r AN̯եQEݦCt`mhPOP[ks`+)p0*=KzJ"U)==#! 4v]IZa{6u<Ncj㆑bK`*ڴ){$NR%OSEs[4;Pk5{Hүɖ! _kzQd{3)=<$ρľv)DSr7ysS726( ؚ`x(#:.FzDϕ͔}E]"9kx6g@ F$ p~-n Xw!^i`B?Ƿ_X[m\wHM[-) Pޭ'UEcY*';+mePec]2T,)}I5;(Fl0PnBx!^xcL׵#BF| tzѐgL^ > 1Zj\1p+*/U ψjd= +x=y9 XWzo³7'u[=Ϙ~Ľ Bc~˻d(!ʇ `D܀b)]O<:>ד2mD:/Œoՠ.W=B'uXP9%wG.ZCkYҨ]9˄C&ߞ%biŢ9p Hj)-i-VM)m> stream xY[~_)4^ۊo-Eykσb+wm+%EʖL l$E~o6_?~)o2/xx}IEy,6mϕjW]ﵵ|?E3[ddm@>G{gwaBAj4ԪOB[Oa!ؽhvw^vy؅Շ?TsHy%l}. <v/.Ŋ DlC/F?ៗnZ8506J<W?qBuNpdAzs_FV`nz-VOȻ /UG^`wVyy|!O$ݏJv@ VLJ0Q?K5FޝP4HC`;,`UG8rHaSOy$H9NsY)j:E7XGOĴ˟"U6'>GahX$vv uڈV1$cpk8Cmt?^`pMѪjY㤨Ax ɶ(-4paG_Q\# ccd’v-C\ˏ!:9ͧ~ەlJdC(̋l~ >3; 3 Qp!JgC3b0dݵTdO;~p.pq#s@ pI]\2, Z+ @](2/M¹C3@He*I@tpElCVhst(@)mKy˕)s_և|c‹a:L4>[YpAEb5>],.Bp٘pfmR2@u gQ<ϻs٫!3ݑ@y(!AYϡ60d=cepc~$ws,u7oCāEs]E;V潍Lx L>ۍ%nOq _?Вmw;k- NPs8[U^Uǻ`Jg! / B'@oӶHdcǠpR4 U '`.;se}tbX]}^ ~bg! /H.(E<#pFhGAOgtj{48"emGE.8xZ%ZG (8F\An!_ }pa82LT$3[4Bt,^D Dgw4GUSj`tb^U7_[SؼH&-'*v+r? &S; ݄/'f}f>'ԥ_0w[0wF x+2H, ?ՄxiKE䳉Ld)ˢ?B7܄0D&,6!xh깸(D@0)Mڋ AꎃK/ZHɛޖ ĒwyǗO.'XYܱFiy,\S[Ƅ*t, "45wJy¬>Wi{S1m\]-N.ԅ l`Af+vct ^o(8hs&@$q)2עZb+ghɺI_Nls}Q%_XW#vC >#VuBmvTu׊Ɠܑ*@MUmB[aQ\[X}{ZuGZRO))RZNU<P2)\'ɢe̸Q쒛Z@|Od]ED,}#%nQԥK}jyMqT!@Kˏb(4~z endstream endobj 2649 0 obj << /Length 2478 /Filter /FlateDecode >> stream xڝYY~_a  $tw<2mkbu5{`M:*V"X槇77|QBFr[A D.02.ů0OV}LFq(%:u'Ϊ=]:e:ўJqij&l`8 &c7ՕL6L0EևZ4X.Mպ_(a(Hr ֦k* aV@ު# +v(]~Utg9co˓+5֡aWaj68kٶtkޭ ȧE+U࠵Q.ilWa_N(5_%6v8EIGt=K,wiN34<˃Cf Eٶ)}]0#8(ff _дB5QsGCъ`,Kuө)V rφ-h4nY޲[8byO&2 OI ƨ?4Mwq8,@qWϱi^٪y;w>F{޵wQ5.#hd`Bl}1<"ۧHYQPĬe`bpsF Dh0ix9#0=Qu$)a%\")22%z}B||@PA (FߋUT$G0cQXqfR-kK'r0Y1} *}V3o;9숇!V)t\LA&>l)\T >!ZF4@3Oϴ":̔;/VˍF=|z.sF8FzXo8zn=yMg8Ԇ=E:/ŗ yqH  s ~\O9YE5]In`T|WuHcƝ 6v,WE-G EKKH'($T5]3O8Z wnr)[fW7}I]2I84?pȦ 5DvQow@$,p^h vxJPE*sIwc6+,vTRQaBէ3B(@P")NjZTꦹؠO@3Y3Y׭ %\Оky2MS|| &m_rklD6̀j|qͶl4=7*eȴx o'~`wl[[Nؕ`e5߁W:N b keSwϴ'@FZVOW|i.g߅ez-`f[>ia@ZgnNiUg[c/A+NMAN08Pxa΃>\!AMܕY9(Cݔ}as=IP>(c:Mvp'Kun_!dlO/"O7D ^(Xa>"{Y堉nBP mʋkLnXD"}#/'տ$S WB.~pם͟nn׫pVkL`/60LsY 3/ h8rQ\IX+ӗsF-R)ƾa}q6칬K}/Gē@dΫ/mc+iN!t wU{]wm,`,=< g?Gӹ?á5gkp0qv1)Ra=ͽoK=ΗJL2G$Li\tV> 1d?ߞf䨈^3~8Jcdu?J >4$!p0޾}]8VQiG m C2(]lAMObՋT?01Jsiww?C_󯪾-j% .|OkۡQh7 endstream endobj 2658 0 obj << /Length 1072 /Filter /FlateDecode >> stream xVKo6WClĈA}hѤ@n{%:fWJ;)ٲe'.X(j^xΝ9?M~M.oIQ3[8 "'E$uflUdI?~ -yF(NSJ$B:!I@Kw6Q>wC;5OpzO¼?t*:?bad}R7o;Vrd(̆bՑ5u `DW 549khXpJy^ܬBDha ^Ob^3i<Тab֑Պgr\w^Yf q{r*mTֲrV\=mbr }bb;8j4XQj*ׇ.yH@-i狾.v"Mn˹5Jsai]|sËp2vm+S\& ŞdG#G$MVtJpn'Sk`k QB'X5D@Gi;ͺmT8=CA-_(L`n[`ՙjKsq"[ěʴjmp(a<ֵ'O A8(!}/FP`\( _ghŔ LaՂ־Q8 n[+yJl%QB]?B8 ޱњxX[8[bHݪi<3eˮ*Gp& endstream endobj 2568 0 obj << /Type /ObjStm /N 100 /First 976 /Length 2001 /Filter /FlateDecode >> stream xZo7 _a:Q(i  lvYzmv8G9ΜNɥC|;H'RJL*.49IvUWɮD?ړ$Wk .G6B\401^2ChPR)$AGdgx]"Z'1L4?kRhLVUj6U1%+(W-&m.CI͘AFj|hV-)TBm&܂"L 'WD^=Dɤ{q4=E^u?vϺnLS̍8dC0+rAse=l}/?xqi]eV 1hFp+l|Si35 t>^t>f߼[.?u?~ɛ_狷pCQ N wn_?馽Z`C,`/ZrK`f7q@n{zn%TL -KN·ONBcf3̃EW+"dѣoJH!QHފDǽ*kS{+G#W9a-qR2vkY$]rXvu(ĚY %׆7jMϗ3T>e,ÀIk^d*󺟝O (<~Y0 ~L#au3Y$G_uhUf5W'33]U'\ #_mujЋԏLu070dB:[<ܬLIDEʍ$%ȎP{(ZC~[MGpIQ K3"3hݿOgo.i\#TmUoGGK@[`d1& ތTCE,lgp^c}B{aXx(/CŪ_sITtXJkJQ((k_Ɉ*{YVˇhU+cM-hLOZi)q zy;zb}Qk* x(6OѨ&gAvsS<NQ(ýrS 5{T%l;;\V4kIZ!ԂQ5s*v"Z߳~&])"2l4_Dw@!P2[{R(ǧ>,PWeΞ| {IGD]> stream xXKs6Wh4`wqNgb!! E*)E=w Ю:1\,r&3ysMb<ܭ&0uY ]2y?u`됊0b܏!eEʭD3^ΑysfCtU9sުҽZdF,12Y8⍴29ZV8ŊԚ]:~teue.c8u1 fY|\iQs}&qbT8銆ӻ"巪 $մBGU!Cpw0b'Vv)t3]fBVv>3xF:nK=pg!{?#nXKBwZ4Z#-*q޽K7E%4_(:rCNߩ6Za: 13:}\b}؊(jȭ{ 2B@BGM3+]/aĞ91IU2305fk4jQw@IMveK@\xa8yEd|8-^R(M&@pkY [Nc#}sRC 7F Q@(]YUp#Ih# =~ B^82IR H&4-S;P}# 5xM^hWw7X]W6HUG2?$ aJB M,cGkNra2nNN$ 0En?"?IDj5oU+@z~A';3dYq`$p(u8 % zpej< 2O'FЂ|yط`,ކ 3\79ZTI1-u^o&Ow:I JS;f6d`|y ,IBĺ(?1Ce+͍BZnX+sxy/P+6r(ߑD,BgR@vzl\p8lNFj#y&2褼ezdꊚVm" ,1x܂"y۵-#Јtأ39 |"E\!*ˏZ#:b4|<۽U6 _e ,2Xӛ6l{9yynL!D8]o툀$-K$zmNJ Yl [W_&~GK @kسo/^`.RfP %y)MT3BdXQvL-ҝV{Yɩr:y"+z9Qi{Kuu~ss~a/M]j\j^-o opl\7U%.vViը'vV+QT88V}:_RZQ"SFN}n/*SL,t' uSHEQAa sz7cKzEߍYoZW!~S endstream endobj 2688 0 obj << /Length 1792 /Filter /FlateDecode >> stream xXKs6Wp >isJ2S%6T$A괓сr~.@<4~6{a%8H0YuKV AUAY.\y}qgq$IS01҈{}mGО WS?azrQTVYmΔQF>҈ʕVe 6ps?2bz0#&-F>Q/`)6JuB0.џ#O#C~Jh @1Iʙo׹?+=_4Obc4Q2@s&[dbusvtCC9 uʍeEmӓGJ4@4"X@ǃXHS $AQﴏ͉@?8Vum0˳DLRoZ4%~xk($,fk 5Jf؎D)ozwsJs,h3T5*gT7\ 7uYq^Xprk9bBJ ˟7KF'BV&yȝ}STnbW #?S2* `%C+J)ڹ0V3%uM^6?4$!0 NŶ -E6z4 ĵeo۹D5Zrҏ&\F+6"X- etͼ^J\hp@ UYR_W(͢^n-˝^ź-2~=i/ aga^}Nw*2pIGX&g;-TAF퍞, !FO7|YYT,zBmZP TU:ì^,׭- XO;sQP lpc}9kN] S0]#H'\DZiӮjǸwUԬV3 l‘S|ӇMpO)''b؊pПņ|#Oy1lRUhFC5S8awcI;i[ l.^@q:KzuSn:P&љ} ց;n-Sjzzi<]L;.AڹNO4ehrp{)$|_6̟/RsJc _~qFF&Hu瞡Դ[T!<CXb,ѱfiiU3YS  dDo6noT/4U`J-WһGGs>b;3c9ǤzFf8 8iwk' afIAd3Fj(G;ŀ+ũ6֬Ssc#Ky.~`qq@ėguk˃:#LRh>$¨-s3y.D[rFkf`V0| *!8|N4͜9р>R;r;"m0W h{k"Jh(5B?8AۤݝsM̨-es Ss?~E!^~.7sSvrmVxȼd~$$_ oGEc endstream endobj 2698 0 obj << /Length 2348 /Filter /FlateDecode >> stream xڝYKϯP"U0xqv]qٗI|s$H"Y>h$%g˨ f|?^?,gy"v&8g*Jf,Qe3y.lߗ?&hScYw9hv ֚PoLe`)SXT柦ENLtfK\teoKTirOiB[+wQfw*e=~^ [uڔmɛJ,Q; ؟ccRx&O{c{A us~FƱ 1~1?)]y!Es/ ǿ1-$ ``y ^ymGu[%i4 _܉uhhy\}}*7!;*=*XƹB#U ty?B`r _$Cu+hWQ40}&tR(eYJNPIJEhB/`Rq82WL-ӷV<qkEu^5;!1//Q`~ gV I*]=Ӛb W#⾛)yp(W.11JW~G.#ðkԛeQ-Mzp*:nڝÑa8$1R6A5Hj ε ̈́EaRuRB.WEe@d悋K:ȁf#V)B&HՕr.G6*X7d7u2U+^m+˹,Ө-懓Prꆶv{XxQ 'E}yIrAyc?K/!)/(z]V3GC>hhp;|3&Sp+prw{49uA?.gfV\2> ߜ_W4byljf7҈a}rww}ۿ>>gs94~[U7z6[ck;u*mcU;dN oaF[J9ԕ./̩-3#- C_*MR2?xLK2ew[qmiuVk9~YãOg&1Ia4dGHޑpQ׻w&vѝ& zcY H԰#|@~&BV~&WYTɀN@^STM4Cf\훥^Eg}OT"Ƕp]fOFسHZ< Qnlڞ @M4xמ@s{J7O?p߷2X>1ջIT;-q*{Gi;n dܓq63m 86#c<+%oojzaJBة BA/w) endstream endobj 2710 0 obj << /Length 1722 /Filter /FlateDecode >> stream xXK6WCl`͐(|HlE즗$Ym%Clű (|9ASgPѫ;sfdsyX:Rz0F|w<$vS1]2&~{u'w`67 g4Ww  B>uȹŋTP:D*q.3 ]K=OiUJP`2Jf'*(o?1ӸoFgpFf,8T]cQwi֣_@&fH7h20z06b:ʼn8|g$w:;Ś9@)\o-. AFc3?md2ʿ?d.=^0:S'L䗚 X:z@ Z_eV9^^4,$~xn6naғƛt|CP(1ƿHGB[Nb8Nٌ!9(~TXl}m\ܻkW!+h pZļ0ׅT/#Nr AS&եP@BŢ#n -ww8bChp2,?WeN2ʫ-țj%R&?!`v:aڢ&t2SFN`Tzt׾]dKsQqKxf&nKRh1t臜vat`JڶEe}ryG7;I (8y elPjaJ'7Em/ݲ0L2lYEffU@ZnKMQ>e Tli\66uxнVPc$,N/GM/GM/G^z9za/`h;3 ItG`Gz72ǎپ$G1^a6Ưxb]B:ǵ%inArPv8TEO*k0^> stream xڝXK6Wʇ* Leة䐃=I(h!F؛FÊ~z0Y,hPL*E2]=?=~{V,1T={, O6mi֏aJUml"aQB;j+fߗmbqr7\9ۂVU?''~-dV.zϡUG%'=^yC ö"d< ɊWZ$aUkZʉABH:}l3l%I6KX)H?m$x*d˚|A/XZQ}*QLƩc:E2O!@طvSHKVF0fj$h4u3}hD|plvIIǾl|q_>KK1 Y* {;E`B 2#i q*B e4Ui%]f _;fi=pQ;޶8~bP"&|D4ؤ Rh`4 qL%bܠr {}!!ZK$fD$0 d^5Xf{Vm0?Subd깬8t[#8CB/=fvǬ<-Y,Zf'5?j gE6R[`=*FifTSXv˩gcѰ^aW聂c](/<`B̹猋 b&1}\ ?pKL$w;ZI)e9˼?I,kTj*0}NW# 84XfC&^/1y 'mD;6v+d s=n7>zo鞀>[Xo:Ql mXB:D/cAU֐ ekg>?w^ܞ'ˎْ34G;IXo._| (7̰y e1x@x 7^L;nS3M>)e{h6kꢱ]w4K\b7S{64} &b;t (ʵĎoiwۢ?CS  y1{hAFj׀ѳ׺Q Ura%FH"}Ԛ=r˥LO}4\+{mt-ӻ&k>7_O_zkL.[1&_OvrlL^9",oz%O3)4@$Bz:xb~y%f:Ԟ.DYEO>^CYscמAs1<0U@WגYT 쏮1+K2F(h EHBUQh/ۑ}1mp*Ҋ/*ߪ@)5Rk8fU5e:GAeh!^KGGM,4*vw4u.D|G;(`\S]6Q-hچ0F៻ h"LJ!ad'ė~0Xt®i^B)kk} Kz0mF\/) Fd25t]v&8쇘d:JGPo:*݉U-G雒a9gD SYfnZkMM۾myo&VWl|ov'{q 7MlS endstream endobj 2735 0 obj << /Length 1801 /Filter /FlateDecode >> stream xYK6Cl fC$E}dKZ%Ww!^e1ZAp8|FF]|{yU" Om(%B&QID]VաWU]3o9,gtA///`0'ieT/޾Q#XʳV# 7Hqyw:(I$*E$ϘS~-ҕީtۚ1* afdb?^qЧ- Ss@ sj(0]:eцe$H]^F0Rг#*-@ '7)x }CVu3ߺ뺼^AF̫8 $|][ 4cSr+PcQ7Ó!mޙ7ݮ.t%P3HzUF|:jb)c,ĴTᓨ2@5CTayy Ν8<'osM4jŐxfiϤwcB`[em1-Nzt 9X^Fw:^DjL ɑMTp+iZ*뽓whR'@СǓXZ]]j.]ݱLN͘6"><9wFD7 $gn50f/ΗZ endstream endobj 2746 0 obj << /Length 3316 /Filter /FlateDecode >> stream xڭZ[~_a(\ }6$Eчd>d[Dckfʒ+3;EsxHYoA|BM>z^66& Y t:'YfÜS;v.":wy?}beQd/IIhńҡc_Vkme߮Td HSմ@:K}npu፞?OU1>)S\PڴxȄtE[dqj@9aitCu_ŷӴvbӭV-_Yd+N6ThXcמ)@iEVؾhd)p>VDJɮ>N`7/Jk^`Yo˄ F8x}Ly) @f Wͺ'q<PebsD /UGW2n)CM{M"i㩵~Oe !=Pơѹ4ъ@VW 89e+z%aRXiװllk(b?P |ӳZ,P\o,z֚ /l$ 6"YK6r҈EXA6=}껚Cƨ`?"ba9v~VD`@ɀD)URVeR$wD :i;1n9Z nڱӏ2]be9x2>xXu-U!? C_0@&-چ8?B(V|u4Os9#Yn==O!̓ usYR^[Q㍚u۶ʢ;<3B dke Zq f1U*OSJnqN#Kg($zy d! ^cGC=MB-p9EJ7Κ mrqث0Q3^񐫐fx1}K+h.Wg#DḤΏЖF;=8 1೑6c<<۾{~g ff ;JTs4STbzmB|H2c M@Gtl]3٨U;.YxLqHw&M<7p }ޑ`0>f5JmL;@]2!BD D"y׎kjBd~a  Q72&W$&9ơs].ǡ?MLcwP[88fh)@̣X",*X ּvM3w\)Xuj,L*+qsu .C&3FRͳQ00?~g1 T^Z. q0걩Gʜr9~0l3mK"1!7Z e`5K?mL _PaUl 9`! OغDy+8X Xh+ l X_ [0BsP(wcgJ(fwh~l!t+6SM;7 dْP1C`SK֏ UTCKt+sꋍd[ !\R!_ki7:|5c'Z(*te4 %S]ᅐn$^BdlMY-\ė-O=LM*=ld,dsc&T!V_.uME>1~ RIS]J%-b9֥TZYd}Ko6e7gk.kbcd(b~JR Q=Sc1’P*9@ER,eB{)hP$9X-TIN@_(0`&w/9|p SlqBXvk`s -t>靻;\xp~5kX(Wt%ɎﴹOվw xzx q ֝ ]*I^ Kࠕ$pV"ػӁX#HW.l ?.8E$qMpVCػQ{l$t,L(%[y_]*a#_ yJ7\>Mì[Ca׍8˿23 -҃M3&G . "{\Ǵ4tq-Ͱ~ua)O3.1 mjfV9ᒛ*<'<Ö0-a3Цbw26ZcElLp~_1}u8T/< \G3xW!dup.m^6Qv (^%,TT]^W b'x\JcrC7dئߘ>SAde -r Ϳ,*4&~G\B[_!ΘƿXxe4]L5 O=kWA6T]0}e$+ endstream endobj 2754 0 obj << /Length 2639 /Filter /FlateDecode >> stream xZKsﯘ҉` U{S^saK]s^9&9u~} RirKJfu_ow޾{QǛeZ~#8g*#*DǮ,C~ۿ'*d0"SH56[eRK>RD OxO)䰲C.Y]>uX]$fz+8ʻkFC 43]T4<4[2EBvݻ/Giʎk|7NJzx1F%lڗ޾iT "$}v|YfT 2g1Q5Px9No{7Ua]{|pQVPv_^O`0T$@Tк Qrdwy]ܡ-H0s9 eAO_*ˎP<23cCk߭LJhɸL옝jak6?؟\[Gmѩ/jO Z}Lخ5YUJf%p3SIga2ZWYOZr3DPw]Nv`B!||;™Dδ;cbe /)>n 7ǘ`Mm"qʳ7#/gx_G#^18^"p<'׸q,lI"O ;CߎS>gcJ)x\rV8:e0jk@7˚L3di~|.Eҥoú6St+(2Z Ro=I_ )2n1׌dZ$l,@ uG!w:y X^flm$Ƣ. r8uU%6iƪت~sqU p>nᷓ>RsTQ dZL`-a4rb{px飩 vVCK8=W8-eJ9faL- K+-j1rNZMojs- Kdncg+NޞVNY"; UᶗcnCy3^fh Vˀ 7Q] e`v0p@A)KMl?o7yn=l28(ׇp%?Txyl3 ^u>5\q_^a69``3lhu=)(1nw=^Ta.]Ʌ ,+PwѸ~]BH\ XzC~~>I^? O.DfQ"e٩ԁlSl)ƒvTOQ9(ީ(f碯2]1za}jr7Q .iݗta>Z8g2KӥO~8|y7+wň,nkVr) #1}I2 ?bOc PUN? B5 2 iAٸ f~T*>`5٤ѩ.`B`V> stream xڝ]۸=HЃ \Mr945- KD Q3Ғe) Cr/ '"ei$f!8g~-b!X䧋b'`DՏ"2HVeޱv!n8`![}".R޶UJ/W"fCfOnM۪r%EeU5nu6w>ʦ (S];p;;#,BeMcn{=^aޣ\. S/[7#IO7A+Jeݩ!)TݕY\VvNդd]I80P&JEO'dA/| +U1 x1 ]~B@CEOvW;8(A }UV4fR$޶WvHFU5eu@z7S5U쬉BgLli01M#=-_!SYʺ B(@1 $^`I{CҖHD,#JSdz"u\q~/Ʃk}dXg45 ;:]Z\7o%ٜBCJw]^j6h5<2yUBKdz1KԊcˈ!#Al"h^ͣ)j8sj^ԝ fUXRrwoKS'Z8<.Ncu%_w ۲ٌ?,ZL<^aX!SZWt%}B|jwA%yԼʴ RA)dQ國K|9bIX7%6~4N,#.K! @D!dS8@%z3s/!G9ZMJs/0MKLeU $,ˑFΌӱ # Vi pA}h¼\,{릯 *+;)k Rm۴`[pٗ Q%xYaEs*21oWQNuRaӻ8ocLө 0ak% K5-~E%,V ȵlL.8R[gjgޘJƣSYq20T踬i#Xl"  B@YiuAxqq{{ 7: *'NEܪ(WEz(0q<$OGi.>m m3ia ,q\_ؑCJ"5qݕ+B3]&a(p^1+-Ps:78SU0$w?FHQchg ANSL@?5[TDxZS|Pnj6k>98ҘP@8 6}m~\bGݡ;BmP:n`6߈:ߤ<>B1-R1xL~a[V ыdڲw3t_ĔE%E@?V _IYQA', Z8V|K.p:%a\:xO1d3 |nN>._ %h1"(Pc@wezZ* U%-g a`u2lچ 42w\l X?hTvs D{LWOKh;[ìV[;|+`6-%uu= r"Ak  PeVif2CZ_q_Z3d$;9-Hu Bi^Κ$2*'# /2ٗw?Z7U%` ;˜ 𦦝0|XUA蒆:Nȅ { l#6‘"ʹBQܙ/ ___?> endstream endobj 2775 0 obj << /Length 1487 /Filter /FlateDecode >> stream xXYo6~66AW\RE7 mwOihp%YI4E3~͐ 6~\|xxVL (%X!c$pc&n/wuV/WI]𫻛_@ݍ1,q҂_lXfn ...lRXVYҊT5^|#TΚ/ZmV5J^WTlj!jkT.#g3Jb߳\wZ4B)*m v3{#F!ty٬h| ?'DI (iSmG,^{*+S2 ;+ɣ:aw'R?8مFŽ5g>l(CY‡'uJ>l'uPOT^=D qv[2g0.=Lz,8f?RٙW'&NUjUk `wگHyWWx=nwnJuj%Z:^ef&kQٔ:/^V \9XSr K4/4ADz/ݾmʶY~/>,\0XZ໾Kȷbq{G Ƒu/osAέO[+_p"`/,ׅ@M^0xH!q3WԔrh\†$/ oYߪNI9g~LCʏx$Ù7ċD$ ,6+T@`TkMr46Ɖ7}̼8@=Q1( {{& cp83(.d,l' 4Џ s:p g\}<| ސϣ<Slxč<" 0+dm<|K1c0B8D1qb6ţ8޲G 1w5MWR׋0){$"Ȓa&!f1x&) gdqV-;W?Y29JQ<阆X@l7 (1_ŋ$߰ ^Uؑ%;bB+3c&\ m撹V]_ LM80EUlb`Mud_pnk}=P,{:(]H`I}U2p )hb endstream endobj 2666 0 obj << /Type /ObjStm /N 100 /First 983 /Length 2150 /Filter /FlateDecode >> stream xZ]o[7}ׯc.i ' nՖڒ+M{lɖ+Gdpx.9g>P₣"E2#a$&TB5!:vUP\ TMHHbhUHfh41!Pr1RLbRvaSH459)a@5TMbYaWVLZ}]ljH/N'*q-J:Ab5 Vam^GE5I\J@ĔU1F%NIH.b$1o%6$ @RmpvTrd?Fme$+-s&:l,>9v/6kmc3RpLƦ8c&sN0-9~)bvvW~` HY%3eU mDfWBm%GWRo*Yl,[Y!妗!U6C6Odx; n@)Ԭb]j<\CF%.7|ݠi6=;Z׽pgy}ѠF܈Ӧtvv>/~b<~{CK3L4aoj2e2<-N$؄КAtv1Y< zs|^JgdcKM>A ?/`xI{uO'_?ڟo>,7vǏh1r3oo•upD'WHU|Usu78[w,n0V8(O{O⸝LFWÑz̵‘8?c6;GN|/'pd:&X`KC]J#Blr i#}mg%MOm6N <վg|DlҾ[s;n}1ّSq3r(r"/폊;w^ŊO[1wzzM3*kQ6(i3GS;}s"X?k^GI9F?ȧfح2'M=4UpSYmtZP7A#Y?\Yd-Jc$VI4bE1{{]3 |[xFNأQ -jԨe47 "jh2/>=䭝]/MFbNmT_m kNvB1Uc}>U㚡Qւۉ4FQ0}wa cӦ.֯7"pDEwFv5:$5p7L;3p$`RO$"IX8-R1(1Sz>iudǞK!VUo)Ŷ%*x)#oRq;H_ WEv!d'z;&PMSSb%{+C6 z l*E!/meyцW,܎i[9Ba|^q+*XHQ XQ$W p2!/狝Gң*=K*SOm;S%=IQ< [l.EvfHz~e endstream endobj 2785 0 obj << /Length 2066 /Filter /FlateDecode >> stream xnF_1CVBn|,bkU9wz?Ǥ>͍Jؤ%9IQ_DdUBsIĂq 3@=mZ‡z8@ٝ?uNա-LDDsa MO`2cj*>l-d`li("uHw[ٯ, d¦VEF3%ټLY6bfѩ?^,q"r s2,"y1#hE(z64 nv(?[.;"koK p(0N ^qB㙍r^=$}Ϡ4u8-_I(wݚ`vg6CDq>74wI|BDD,inƿ{dvwդZw n4wXCSC-G)F/L$8)ЫefYuQ&^qBMNu" G 7c>W{ըԍ֎UBܳ9,ҷAs O9RNAhι0lr*NЪ~h="Ȥ5Nhjt1uTŮZ191woIHH!Ƞ_-CZ-Lr7UG)@d~sdVfReA5íH0]d{+ aћ{p׷"bM?B,OkƘs68!6r(9==`fY,.NI@4 8-`AůI|_V՘ln88hyy`>\VEW1y`BWb~^/Is,cAW06|ZCwaRg nL o *G64'2&AP/?1.}' d|kp.9[ZtHnQ 4bQ (tSIN0͕9x$;w.Bɂkl'8}Op|XpŌ}t U_pl 5M>Qo5B }p A< K^*LYb-m[u[C;ZCߕVyLhc[7oi}oZ;fa]̞tO ggz5k[yX(U<[pB(I6u QUgD#Zs8Y16?* l%&:J74 "?:VF? u(S$7ы}s}<]c{ƳH݃,uayVIS7j-fHoGkt`ZEV"HH&S{9@Ŏt)@u䁂WT,51'Q 8u7dp+Q褪F?<{> stream xWm6_*mlézu+TMvpGpfw ,nV(x3//e2 A ebweV(=.mdZ^/hp aE$Jh^?/gLEmogwk >oEp߃yn,w|hH8>KN+4Zk;._EIRY 2*5ϪFgUk4N? 'IATqLh L! |_/jX5(RJҜK?z4?u`9ћ 1 :iJ{ϩ BĘ-AFJs䇾aLU(>Euhշomb( {1QQ>!^qRvcKmn=1oB DZCkcZL!PS  =`d؛ 'B"V}WDf̥t5yd2*q)T٘KMd7^@ϹM7ë)$ILRF endstream endobj 2813 0 obj << /Length 2141 /Filter /FlateDecode >> stream xXIoWCˀU+>t$L29́"KTy^՞S@Xcիm_{;{ 2)?"!X.>D_~П0d< `!#tlc2C n7pw Ma0J^?x0ރ=x> ڥzOsP2ţWc%pv_UNO6Iw:ojQͿtֵfe8]`P!gP)]QWS?"f`zc_eݵKѨLۖ\fn%-%I%Q''Jԛ.-bEՍ2m!;PN"/d/>-iMS̃)T ,y= P0{M(#-N/ZeYĴw]y0nHmszlLgA4S d!8_Zg-E3"5)koӮkhF.W+Þ1PK2ֳZJ&xlr%{ܺXt{e˯wOKxd+77Sӆ^6`)P,s r+o~iL3=*.o)WlkҪ>5iT4͕]ЕMo/'}Wl)1l[z>" /0 Ej^\'8:s{";"$8 c5x?#8BVW"X4$-HSuVl 4lTa$n| x|}%lLj)v%iyv5}ݗgSU쁙J.trňNa5(,K2Qc5NvM}88Ţ;mW7KO4jkGmBy]jago90FMnJ;B%튃x J|8iJtx+ڮ@cK=XoɔFcmbM&o.z1ЋUnTSgu5|qD_88ňp;z"z[\okR_M!3nh/nԘB9#mz88!H$mLJ۹+7^pPE2/k)-HAu߾)Hp)7`<ixK,Tѷ M(eojuF&lA$iP7!ʟ_xȌ.c% H l=GRImtqvz%A~>%,(P&H_Z\ 1'.D 9$WOFS <ɓ!ՕW4>e?}|XI:8`Δ> O|. Ӷub %GWY+9]I2왑c pls󇻋zi endstream endobj 2821 0 obj << /Length 2331 /Filter /FlateDecode >> stream xڽYKsW*b̦vvv+gDA7"A+_K-{RX F?nÂ.~C$)I ZRE#Oc&Ewdp(,Mͦ.`o_1Lr<* hB,,%"x~-GH/W! H][f:-wU}1R[ܤVjSZ-l*\{HjӨq¥rtn˝4h6/ %qIYZU3K4p, iY̺A]Vc_hHuce{بC樲 yF,4ꎟpi]aKehJj8a`6oWLXdVZ%JPx5\y: 6֚<U?yg(@pDjvUQTFN` ǪT`&8f]ߝ;4  <[+UuPS3<3F}#3H^iu]o+:ot5|a-Q< *<ᭂ(] = } xt[~y[Dh"}7cu# ?'Θ: .zߧ|ýsb-^pxV˒ҾŬkko0,']I qrQ&:YpfcOLH <7^ȥ}\ZH+i? (L1y^A\|wɈH\NNB^d A"m1o.1T\$+ڑH Lv|SDTC *Bhgʠ=\x4փV$}CO B UO$u \*T' 8MQffGfRԷgp0\){$DlI߁s0ZiHW ܔ&sA $~Ɩ}*osz,LmR}smD4[MlQvVBf2J$C :lM1b -4zZ|Bh8GEu3|ؔyQ@8 NCP'}1ѷP/6c9:w`)#*y9g ވ/ ^WalW`jVs*憛{@ll!)=rN d0jO`N,2)HeS"?]N:2؛Pc7JQб'lI'Czlqp)l>]>`P˟@4(ꊔO>x 8xO9ksha)a}`9fAfP[K _1W>1a,zc"Tzd$~f.>4`-tEܾm0kp!อ4uzIQwe[/!qb9gj5Ai9LU J@BvG_4M yƓ;RHS4GC+c3)$b>qK`m-Wz_mq1&pqMh\5ݕپjl<9÷AΝ1ƏM[Y۰pH=à;i>Ih0~7+m> 4Q%݇l[*dzlɆmfk c]|jw /O 3]a>(n@σofp-"Ҫt3vz6mGs I#[K[U FuVn5r DFwhvl[{0 kQ0=q8NMn%S@?t3̒kd(ܮ{YE_ tk[ @FYcsl7U`qrz BŭD?2HU?9"FtQCnǛt"jmzt=gQ`'S־M2oT6;q'֚ʨ+2"X{Un cZ87֬f1v?ueot,1/q>}v㥚~#xx;cbx3.ٗ DB;hv%m+`I?> stream xڕWm6_v+mƀTݶNnzwpP 16$HU`x^y<`kmaOEXE0F ,F hd-ibl^|ށ(e!rBe5Z\N9Գ=Nq,RQq}Y"zVE7ƜUuZfϸ: !vQةbEĵDFp,R(xSkj-3!Oil- A#dyZ|SLNbU*HH=ybU%dYIRYϞy<ւEV ;G?u>aoM%WWt^4%r68w >?נ,E$< /l2 :f#NJr5/em~1wBZH}FV<}V/DVtkyP̣0ά_'2`f:UC u@:Mԛ"1Օ ?t1؋p<F8 BD_|UZv!O~)ʽde$R PDH^AFPNjA † kq9}tG[ݶ2TvȆzoF`X x9%P~pcUt/=gZ_*[n |>/.,@H]b2h1hȂ*y S/}#Ax2HtVckXMӵmV=e)tjU7y]v*ꙀgzRf\tUMoST?ߏ Lԗ%&OT(J"V T٨_8jrmןzIh|B8Ô@]N4wj jeӇ5:f-=m1Q@ ND9,MW:*ƣ6@MxXuOTT.2R}cplZۀG@*3> Yěz@Ƿ=i=/U:QTE\( M]lۡNj~ۨI2΃X̢kߘxx #ꛪ Ж7xJʘsʖ`WWR{BsjMA@ka1(gUAeIԩ4Kڐu+ibU (1κA렉5*TVO>nh=q=yuITeX a@싔C endstream endobj 2848 0 obj << /Length 1399 /Filter /FlateDecode >> stream xڭWmo6_!b1Cza (0lkCDl%:;ȑ\pLRsݑ8X8c2I׫`h)!(yp]7m+RmP[Ňq6Ey:|a He/ SXneJ,h Ȃ%μ+2(qoJƬB6~YLst/GwyF}ه")M|A ߂Y: ZiDa\W&{l0(HR?|woA'Yz{Xzgns'qķ^Ybf35WE+6Sd; .'y}OV7Sj64a|b>Q2B{Q%FbWJ࿊iudBy_\,cW>fll?1"{?&|* 0G5-ISCnߟ;[KZ|U)t `_ g7SXJ%e͐dq,%fQ,cL4N7jCy0G~ <@@ n 85? N#}`WYWe.id|́J3Fo)ܤ$<,y6bjc[i-Ht(8/)u^J3-r6ZZ~hzYjш*>wբ$/*#ț 57m=O MT]k2*m)Xe*V7\VyÅ~pKΒ&N7pTVUcUwl=hMri)OF rݵibwGlqWojX7kgE}:V"O/weVZdYRۅL3ChF=jVxqPt@$S6w|m⍩B1 tJ3vxPaW} |]6e7X45w0d >K4;gzdҬnY +>clykrFl=&s(lzdM,Jt'n 4Б70Qݹ;܆aeh"'M)Pd M/>*` d)߶iש !w~>q7?Qq( endstream endobj 2863 0 obj << /Length 1669 /Filter /FlateDecode >> stream xڝXY6~Cg&A]7}H ˴D\QKڍ7)yH|AaoaUx)J#yˍG0F,[wsa* ,QBlMQhf*6^bgDqbz~JD^jājͪ!cZLK%ZDb+\ڬ cCl=;cd#ÓK2RΘ[PȎa* ~BD{| '|ˁ,*(F1B9>I#ޯpy4~$i&atOFwH GAT%6&3]ӆR]{Z=W˜ajFloU8Y{%GOhd|/Wǘ6'>V Z"DDiX yu.QhZk-*Z |*zr҉Nr_Nh!LaL `=@_ C 6(9 n5YW^ >dh)>r5Ti^[s1M]Zڸ>"[\p Rhhj{JCW*yC:as"\!+z L1KT9@A<"bSfb $f*IJ۩qOWME 4zȆe# 9Eܙs-N_kG}[[^u7n}i>Db+j7(@R=>\q D 5F 4 =>}jN>x5^`mUb34,NkP?lt8N3E y_b $ڴSYQּ15('[1UBaPAT75T&)kq"'ŪpwK_Iw?O^n>@g ֗mw*TH)Q_}?~^ 484lPl Xʲc6kvE=ed>fJON+J|Kc4FU=)T,N-^Bw@ %cYVEVePM2w[)n"uoYI&'bi|`prF@ S9lUotErεRbn޴GxDf@`z>R*ˢ3f|A~$SP}Yׅd$/> >ch &(2trM$^2{ƭoġ}*aê"S tUnФٯ endstream endobj 2780 0 obj << /Type /ObjStm /N 100 /First 972 /Length 1850 /Filter /FlateDecode >> stream xZ]o[7 }0]%jl@vZu;TiUN@]{$J!)Kahu*49Op\J)EfŬ&T(]H0@(;-Qv.oHMRHR *D8{!%@CeG"fO\ W&d!Tb <`VKA%`&aDm&NF؃ca\bm,= Šk-xh\L ^m>jG2I 1hVGh1ص^ {(c(| ͇uJxo2F`aJJ6:8,=BGjjGTNB la-'Y" )'B jHI2ݫRu\" mDrfeGڨLm,dv*1;k9?(?dvr6|9d+ENHR˪+7Kpf=I:]b@P=P s*/En::9 O}3uýl j?] ӀxφO]d垦¾~#>AMh^Voûwj|>_|f1Z|iQFT#0mG9P9HOB5벅eK>{x&VthH:>4 XPyDw÷nfmoޘ5dg=r_l\* Pl(g؋TK*/ h11 f0*`]I/g79Xt3pxIE ܭh,tLa= :!txDǂʺvYQ_i! Lڻd[ZzY?Tcw=DMz.nÚV Gbd?KD5*!cN?{ uψu /˗8JH7Rʑ+򵝏ZXPDM{Zn?ί[ё|(hQFĽh9h+7QLƘ`F`^wk(,pȺ욷JF$DS0UmgkB;*N^NyBLyj1 _.AFǠiϥjN)s ,qH69oyV# endstream endobj 2877 0 obj << /Length 1331 /Filter /FlateDecode >> stream xڵW[o6~!Em5 ے{hHVW"Er" 2uxx.xM?_-Y(e јh\-P[՛Dvє!Gv 0N`8aAV-}A)VA F¼ .Gc7F,&K$4@d{RAz2U6M^:_Ui{¼1E,O[a҈;SU:k]W4;G'#"XXrᶟ~tww75X1+, :  B{Q%"l+Q$'5}קUJ0^^R7V>fn3m&#Oo1J`cDMkiB jZ$E10!(M9uŦ_q/B\|MDơ ^n=/G6Iȉ I(@M#[Sf;[VI{IsdRfJOUE=RdѠrhޗjˡs6ٵrc\? V@B6GLOFn(Yr붩$\ 2INҏOHGzږo{q؝f"v ކQSߤ'f>Q1_Mf v7;\lvt[ٹV΢K߯(JPGGBQĆ+`Z:Y`P0@ID.\Y6/>R1S;HSX:^}L4R7n=:.ې%'lPgR?$vӋȐZC$)"B$;齕y^p0jܡx軆ef (yD"@<|P~fz`k "zjo()ڢ8ކ Rmw-j4B w%!*]WPn~p!ni꧐=ju;p@s.Gjs:i=5Ls2 ?#.!C8i2z vdb嗦Kʹ\Iԭ}p14f±}ޘW $MHe/ `9NiN2ft@&zԄyE,hCɛ @S l}2xb\"ŘQ%VmX}Uvo(s"vؗ!/*˼GoKJS ^ؘ $2E䮟g)|hRdo1 endstream endobj 2893 0 obj << /Length 1454 /Filter /FlateDecode >> stream xXߏ6~]3懡j^^ԾTJCR,xYZ߱ǰq{w}i}x7VaQw׷al%$Xdm-R=D~b(#A:Ȳ>p.Ԋ j6]d;u>jM 1[x}Sc'1*zqCJ>{F$Ҷc2/ !cD~IQ@XQ8>IhGWhh^eך,rK.Btekd^{Wj(čh% Q篦 ^A+p aNk6[C{5g/o%%C!NP*mIG}>%44\q#Euמ匇p%OMِG6֎Bjcljgq'?^/)[ xwˣ>Ěʘ/Wnۮ$`W1H'U3n3}?O}~@(y:B Hx&ga9~=~1/w'u H5 O+|8Ti&ڹv E:LDR}V+%+-l:9q\[|䏔2+~8l[)l/G/%`ui՛ǭl'4@8`)=yUSFs< '_x\ &מʶO ~:ghײ>KxrCzD<ćJE`W5ěS##%8}sEUF<Tn#@ _ j@=%TXIerϺIl|5k_ 5ߘ&ZHwLM=iu`99:Ch¹_x7DZٞBYJY@w%Qz?h-,w$;ɩ1K7LVnX(h\szpC@qr؃yYTBF ԕG^ǔ{ڴ,lБX-iFڍ~5[e0b;Ϯ26ڔU} yx PoyYbwM$T_ ;ejyf=$V2M,EG})SCcPazi>'Yy|@js}İm- ʌwNDRdnbV{)p{>D#"uT5LZV;\_G2hPW4{;S)3p ㅛm=/:]nMNj<*ILz@kJ%b\ endstream endobj 2907 0 obj << /Length 1592 /Filter /FlateDecode >> stream xڝW[F~ϯN"5*Ui }:q7NLSaٙeN !##4r֩aY7y١Z4m}2_}ZqEW=H6=_/>/!U!>a'WlE9(ֽ6̧@şUCQ' B_a 'r<qr <-)gz^.]jz[5=Vo#Uq(6e11u~&ڤ.ʉG'&G9/uVUzicפV!N 3X= pP+wmY}0 Ԃ=Z˷T{̦飀 &xWfu<%} !(>Jyw퓯?hYoQM$k=Mh;眛 k!2QO]!)aTiy SOˬߋҤC15$$Xxֿq9DC!BC{tq^ Sby3qK936`,.D'آ M][:*DX` H yȵEo?wBeXN| Qq"ک.Ov'THʏF}x#T}ZHd>(#[1Hbv羬`6CG̑ˠN0U'ʭiWzDW ةIZNL*:yKqQ|[*R#ƞ;ĘebLEp S\"Q6ϳ6::QT:puVz ߪ^BNѵ9 5s+:@qPDaRߪ7N8,dMHzcMƢ lR!qĄ[#q#\]F=-uqfU`<=IAӟQt=T{[ʤS>Hⶆ~{.ƐU?V2߬< jb#^CQijnm_ q*O"kYڂTj8!?)Aē \!r  5(fUkQw,|h4\:f>VDjjfE.šA vFy[ԆAxST:jz} RBpSMܙ hK3+ }k*Ӽ4;mƍ9,RӦ@7%vw.*BMc y6r`cb`Se =AkLor;S̨`<%owo8:G!3=D7KNr+DޠkE/M*ښhG]%z(g #+(690JvBN+a+Јo-1)t=8YeZZzh)k%cf+<* *ɮĽm¡oe3<cnTʈ~!9J|yծp@V|.Gb.>螯V endstream endobj 2920 0 obj << /Length 1308 /Filter /FlateDecode >> stream xWnF}WI A[4m..g70e~#eR:)ooa &L0 C")oF~FFK"SO{xy7I E_2jp\hI`(jW^HBWЖכvJC<1((!ȗe[ W<|&qq/>ToԖ!QHP|hQ;&}.X[fv[|<@SYX'q@d%,` С5`XWDf T 6Ox>"8'&b;٤Z8~͟QS4͔E|QbBF^"MŒ\o{4Pٞȹ̶/PØ~n ]1._; Ǻ~'Sh\1? P "ISkrt~1!Y0'k[d5gk6W톗97?T sRuvBXtʠz3=+%7iNQ OmT;S4O%"ImMPM+.h,d:gibU/e,%Fg[$j@v<]9RB?5oBG q۬0ߘӪ2bϱ/f\Dr+ w'ktRqXW= -5݀"Š;xB*XҜ-MjMӫ khyݨ{۶L6ͫG((6WA(cn.ü̒8q|LZ>dIy<Eikijpoƫ7[U9w_*z)f(nbNsuȝZ򺚢}1f7HF*:,oȬe6x?8,[,Wl 5WG@Lsru6m:".˻yP Kun:n&e*CQ_M:B #/,Z6 endstream endobj 2935 0 obj << /Length 1430 /Filter /FlateDecode >> stream xڽXnF}WN^.A[4m >J+ E*r7Br~9sƛϋ|ac7FԸ窱`׌xwy텽N @BpfXAO #7RjZWy]wOCQWChXvB"VqIݷoKk_mAHXVs)IEcF%C (Lkkr7MXW-ܴ۰<6#6Ra{!5\\:΍b?k|G_O@臃|n}0J٦Lsxt95],iu.Mp" PP+ٚiTNzv=ɒ] zY)q]O!(tZ@T ΦhdK_$ gGM(rxM$c)iyoܪ8_ s~O@H01En[z~:cɅZQVj#`=zW@Lli\UZ>ft>N^`#'E]jI7 sCUMlF=9uKM j\UxR\AúO\Z/qXۑ$OAQb2:K8(³ 8@5TX\m҈ a@c$-SKY7Et*6WSAb ʿ#hz13AtGb({.{)ribB1ohċц^MJfM{BН(-~"56`u7`J/<|W4K>7Mf?eQaC'M6 {D"]"#Y̲eɰoNHMF?"ӷ)*C:JkrKT|JuԎx4}}2K^ʎXmRI>7?> stream xWM6W(Cf ,Z$uC"ӲRKrEz+M 8X5fPQFQ&bI$ A ˢ2zSN/n7 2Q Fۮj ܚNr3;ͨE\JuSƪ)pFi@!CuR|wq|5qſM3)NwX` +6]a&2gyo>iȤ]+v/Zj;͋R!0kayR9ve$o7"dB8{JT]Ǽ2+lDu-ŀJ$5=fr;J26D`w\˶BmW F$M=` @~3"(cHHyPmP+~1J>;Q Ti6O"7ۦѫެv mrErN?+l?|T=ZWp0͢}%XFiq䶲~:`>%п ӝ?>!tW17K/]]'2v={/m@Kґq `pf D ~Tm_/X7^,W wT%_h_,6!1Ae0Y."k@)Gsa&fczBbJyV6`4rSgqDg+@ad8I gg OοgϦ3 }@~r<8t2t$g: ІǞP^TUY}\U/kUT+MR}/[ k/ܱgONsM7Tzc!,S23_@>C?p%Σ G<[O>' C}MygQa-o.7>WfNY  K{sf @`C$ endstream endobj 2872 0 obj << /Type /ObjStm /N 100 /First 970 /Length 1674 /Filter /FlateDecode >> stream xY]o[7 }0]I(q -؀"mAMv8hw|Fn\ =HQN]p8,N}V.VP#Ri(r1\<ڃjuj@n*yŘԤd)EQJ"(GH͈@:lw1"tEJdo"M-PYQOYm֕B 0[,-E9`Z#HhV4 r6TuĦI$$#c!%HBM#Cinۺ5fǡ4]d2łHcj_a Yh"9ʄ XŔ`MMVڌ\a[EFѦ+ʊ-߱&>Y8ZXJd8f.@f kO5j0V5DF*aW%Z(ldRec%&ZnAIn/qV ?5_D5'HV-BMJ,LPIt56 WiՕBi3^CteBC@cO$Çӧ)y,{ 9{E C'-H> cѡz=2ޛMngu{aF5=4!.PWo* C~8]z`ٔkdmo2vՋ=׽|^^}6d=Gp۟.ǓKk2ys:~6AtG9LWʻ /imr\h?Nߏgɼy GOal1=U5iD4v11Pm\!WŻٛs|Ol G7w}H>(0R>YS[R}og泿'On#lWT[,Sw f۱@ns 33jcYt @KC֗:Qa+,~K`FcZ`KDggJ>Qi\j"*LmM2V3c6ME ]IY3 0U JnkBFmpbTVsx1ݧVޚsf/gN8Շ^CSf5Dc&LCmGBYz9h?UdPE5ݝhGZGOoĂ8U}6XL.1=]Ikjh[> ɘ!Hv&$r< w!6ri :#YGh"MC^tA,spYb f+BZބ.OK YIоIi P> 'Tq& |B(+C-MP+-s[~4a9i 8"u;h 9+>.hO@4˗tzщQiO#4pZ"Us$G>Or\q]QAr$c08گK(3|`b36*$D#lھDj ~zѸtcf| DsE)桶 thhH91c-q&}aY~@6D-I\@w7P/:U 4~GA/ ڮyK]E] endstream endobj 2965 0 obj << /Length 3024 /Filter /FlateDecode >> stream xڭZKϯ0j`IQaѳ9v,˶=bQ{A|UA_WÛޅ*fq(n} \iY(vwe1_oT4 8rfcƷ+h=FI71+ƙ>I96Zyˆ|/=eT,DgRެ^gXjGmi4 mYMLsSx `]]JHk[!u<]/SV\-־8Ғh!(tYuU"T4OեBĸ/wT5 A5'8!fRW1-b-^[台ga˙TK(cZX/KG*pų"(PTvÕ05k+6,wOQ쎛~$J[xL $!O3B"ٖ*utq |9nUWa[W]ͶfU}QkWȶnցTrC2Ԑ7%aÍP^Rt8b]Bp}`b TV%cѪFPӇ7"CVgf#հl6ɋ*UIC>RtӪl몰SI3}gi+S׾ P4][T<5Ҝ 8X4֎n6o|М12㾾hR4Ez0~]dIaϳ{>U/U7K[p))wZch2OʴK≺@ ҵK2H2[L<4ª'OdRQ>6LBI>QTf,?CDV~tEbm i"1!FC%d82 dv24$x"鑥TS 3Wӥ67mMFMS ie,%C{$=,LE/AwZ^lL91ͽPq߮!{n0F0Qov}_d'&] gvjdCo%i-h]e~U֙Tb,#xRSZu߿o/geB1_L~5_9ut&bPO׿/fc5ͭp ޻e?VL̠cqtPكc她 gWZA1r^/03'85 ^pR"='d'CDΨ*bK`Ӗ^rrH)0 +߾kadW{a5Eo#\q\jq}(suqh$9 Ir0x 3V&*A3?)o`I#`@f41]AJBNI --y*? sg05x=PƓEbG.Uڬ,M>b6y1 ox/GMJN9RA֐ S#s\ԝ3h mA?6'Z]2_|ä5YZR$pH՟ 5U1o0ȗ {g05iC۬I|cčbhic^i܏d>7ln@]q9x2o!h&Z 85LpЉ7]n ;(fyB2.y/۾{=5RƤ,|i}i7XZ|9x\bc09dCJq1&aIm5G儷aU% RͮTt&SAV۳<'-8X{JG+N59VfwΖ& ##8f2~ɺ:%&G|QưA>V3 endstream endobj 2974 0 obj << /Length 2904 /Filter /FlateDecode >> stream xڵZ_ܶOzID~i7)Ҵ탓"VVHZZQҞ/6{7r۫u22^VsxȬnջۿ|i(f,ѱ-략 Ia&42Zmd}o^?\o"ׇvOfG~_Tgms"]֖]Y#M5ؗ~9nOYEE_}QjԡD tb&pb1eXvj+h" ލِX&VrpK}/x״4ui%^O%d3D)Rh&bX,h y*IA=,jB,&e*FRLRF;ϥK'7sa $,N@ S$ >d}%sKo዆֭9]7;0Ld+BcHՒ$ U]p]=db]Y)x{KSͩYno>89;zysK^tdM[{ljzhY$>׬@#I-zY73k$Z g2}X(e%2ּ"f-Rs9 |Q%l=TY w=؂Dt'/0?OO 4bR va1RfɅl$Si:źj"VFȡe\8gx"AT62ï E8=94#1ɹcr!OhHu3 ";W އqq]kPp~Ȫ|?V_${H&E q| NUTirAb[t)lp,]4|P=TKDI;.ʐfg+STYuK؁NUjyy* ':zJr9~DJ/u\Cu̶,j ~>NeÒ::y7"K(ٶcSLpmgs*Ng^l/]ic(XBV}%}|닫I5d7 Ɩ Koٝ-jض6H LEjk sT sqM=7Kw:q)7㽻q[u؝&K+PP$ BR;/k%0xŕ'+ń3+젧k! |MYw!6iWԒ*f+a/ ԷvYp'%TA,20#X^@AIʕ09KX0}x&M]ԎlD}R[İ#.砉 9en\bjXP$G3u2UuYeQbMc_Yb[ !uF3xxMiW>{rG"ً nbXMAxX\%lT"+a ii&{Nqr9^%Mg 9b&S]rΈ_s0 l=G-doVDX kIzb 'e(S*6ffagv,.Z6H# bžزZ2SC=<8*{ WuM&Ƙjt[Ft| My#NKK퇜dkHunn+>IAMIW'{`W ovҤﱳ@EXnޮI7C2Iݤ ^"Ncͪ4]Yodb"KԯWcV!u endstream endobj 2983 0 obj << /Length 3632 /Filter /FlateDecode >> stream xZms6_釖Z0Jt.&m3MxڹizSZ%6T| _dȖcI .v}xēoO>?9{$%bjr~9qLPRx:9_L~uQd__=zOI>g2JIFxMK%nS&|NgLQS7XwΫM޼%%qtʭEf(ILIGJN8QT9) ;5mM[̭<|avi"99kr B5+!'٠>ĘD2W]M!$őPDA٠0}GMݘ5<;?B]<=PNd'J&Dd2ߜK<@Zq({1J6/C7MI'{vOO`P`o8޹׮8pJ]#qϻ>%$P /PcQ VrFCAC'7SRO9|өu2rZDZC7h\n4+AwŠύ . PElDuT !_d:dM[SnayPln*s8DgR(ὍFr2%I]eIQp<>8@V(Ѹbgg16l*[ֶUojWTa}}ca~٢l-km%FЀb>Ӹ߂"c>CФbuJX(L$,>/>SL57(8Hg(,}!ƏEx.ˎ5V\ݲ:%4$r$m.(.E@zK,CnLK'̅;"+fE#L(QR )\OJ4D}t3yxZzSCv!E+?;N9޵̖1!rn佸ARbe,_ .KA`дGK].[DbەB4ưfV~[lˬ'§DtaJG 4hxlJp"rS703y_ᣅ*X n0pY, =Wz|.hY`L0_Th)9\Oj_W;-4#J+%S!W297-lN;iaIMW'߼$a ]2$F֚Ԡ`鐳ԲEG}K7_'ro=ٓ<Zo2+]PrWqYQc 51eOC#0[7+ 6i1CwKÀ<pyto2H LEvI8u}9YuHn __xi !|hW~:3= V° $Ex.铑3 Y!Sj"`_2o;`R]&@v›ǨiBS(dH&VBɿ*g;Rus7R6;F+)2>Rd!H3RdH@Ԏwu @M>Aa~mB4- J0 >٦!!#κD.Mv< w%@@Vނvv=]N] Ga!8_p~v>栕4 kϧmyx$5w DKG%iJ bOhĩqZRHnjU4 ?ԻdJy U%:?r cZp|jM̞=ei25nh,9A:j3-,ACfRЀ9qii];^9ȷ6@62`>8#dwtNϩ:ݖh~#!w'%?K[$ѣӭ û=M ^;y8Dɹ &l]s6wu4-鞆 -g >)2)6cfwIyT XjE:8̝9\(5zӦJ:8;SD$ꂠ"A}%xHߒz+[NY$ @w\P{7~ό HWyeuښU:| Ǜ4g@#HxXo^t#]r:sJ S: mϋT'M5C0w'fv+> "bp9h.& @ u og&ג647LkO?0Y=nOKdlP>J90r,JOZ!"1i|,Ac?mZ ):vU6C]4<34%qg~24S?NHWEB/>\\@h7b_YHb:wW> jm_GGdDQ;ỏQf|̺|W,EiJE?ԡyH`%""ǧ v}S{Uxz/.-5c^ДǽDF;jE* yXKޚm7}lԼ[|Q̋2p>u0ѹ-;gQsm'*y1R% z7;oA@c93(cv!PDJHWyW8H%W*A)gPhMrOYS1e0lUݚ){GE}7?RfIDϺb`T_㴰,a0-ڨ\Ţ)Lo4i@м׀<_fMpcvRv*vү6ʾ\H*i/Dܙm7ؠ1Cs=GWպB0.n5JA%Giqˈ͑h1C;]l- WDA? endstream endobj 2995 0 obj << /Length 1720 /Filter /FlateDecode >> stream xX[oF~_a%x.@$?4ޤ<`vvf2leYdmx03ۀo'_'Gg~D( h̗1/p8!(`3_8\JYu#p^T%4^j[.3EzrdfyYjJtX^ )qF4v/)||RXb9Icv쓐Ϧ3'X:i˅ȥ>fyYVzص½t2;Eoz!+!a= +xDf|nGNhB9B"5}%:KA6oҌqWHk"My[44kijXYU}{R "n %1-RUj4/) `RM~/"7pݟ0-gFJE:Sb7YY`'iL$isoZ =ֱyY,6Ic<]4|:7M֤C@nZDG#2`녭U_*SsNkWg׋ԗM[ .F[^|Y($,9#qfU' ]/2="vc4|vt(3T֫# Ə~}f#yQj [e Z\娞D7T>O6E/1gχqmAN w>8>˦MW` |Vz}/c4$sT=~ˑ"]#ī" uܫ)] j\Ӵ_"QyGjG'N0~$ɻYGHQEsb{*rbv vS!^8/J/#v5dFH9(z]O!ҫ@;Y0 a- !Ƕө%T_i,iBe?3Y>0RDi d^fLXʑ|I9XA`HJ A|B0v0.rDh;3P-dL2˙MC_ \/<CxT]xzha~zH EZT(7G4X?5}'l;ipzȣ[{5هFy펔15ϛ2?&bA؂oru7v_q(\TyL. ݊m{dQ  q4fywLu GfuLKo Y8-*^VTif)ZPj? I"i#Grb(BgD@*66^kCOU̠%G~t\3 θ_ ]m=JcKvIK㬰d-yV$zň+ݹIzf- ?} }8N7.Ֆ^sm5tlQ (_><ϟmшnꯔoEncQr9npkGm>G_St; Ƽ#oh̷ >ڥvA0Dm&}WI5/M%{G_#x_`n }`O!"U S_4@ Z䖾3fؐQ͝~F||)V endstream endobj 3007 0 obj << /Length 2213 /Filter /FlateDecode >> stream xڭZn}h D9"C/iyY j5-D-6$O(Yu,x?<g,i% f:kpYMՋ'*9GxrZۜ"?&4ePz4pI2SBix-ثnOl0f0kr&`͂ΰX'>kGw:@^wme!ҙa[ͧNFPlj~aY\]FY}c|>rj ا} -JS3ѯLV#65fX0;/wl/$0*~FQ]N;4!^AJExFBf8cwpxV㿯rJO0#z8n/CGhFN&L3I)\'ZeXBDBlh_E¯T =uGǩ.HCMg '9自#k:GeaTԔæVu#[?i 0θLi2xp5-vX!P8,q W. -|+GȬS`iu5V(F" `"K]%U;^'R9|+`090"ϙLUb̵jжnRd ՊAٰ)j}nXÜy#)SZȷq 4q+ ]q8 YCc%m,*;& >.@[=dxro}p^ v8 sFm&ވK2fI˿Z:HdOEi[u}#4I`)HĔMx45`;4 /,@yV]OYkJβ{FpiEx'i$ J7gj kYqiIɤ6z+r|<M{]S&{jD~UQU^&|"h_վvVɚbI솨aEMdϠ9T7\Dnw57/AsX2cE>l:U"b(s qeK#nr43gx3k5 +{9g)PkqũM_Æ/}5/S/(7x Yh _8iFn5^B*atnXF>5Ay)9/0O^no?Nis{a",ͅy.FFIT7}ڋ|37=&bl)ˋ |WV)&v>bV&b$ P ķOw~K|aOL9Y5 \ l?tfvE&v}p3h>$CXl-YifuOwK Gt;>(pm+9,ˀ+`%L(ze.CX 5рV 'MbtM!>+PX~Yc5>p *B/*ӿPbkiٰ.Sƞׯk\ +|bd7 z2 n8IgTOZ 3|!c[⼷ժ੭vo'،ZdJY1t")3O?=|?.\g endstream endobj 3015 0 obj << /Length 2822 /Filter /FlateDecode >> stream xڵZߓ۶~_ɓn@dfL6g88XSJR>b$Hξ; rka/_lGy*~%8RI2BDWk)?ou]Uj"d0tnq,"jOyRJr7F*桲w3Me_7i?ac?]tQ"^'ŶDUK˦;z,g-mp5fO˪oD lY힫nbE_FdT} WZMf6տ-Ny2z,ebF}z]tll۾^*R?xwCs_7]Q nhU|W;Emm (lnkMæ*?<6 f.>$a0u[ @^:wA)dPC.Te " nN~Z[ #k[]am < M_0/,^{65 1l4 SE&KhX}~EPnT}/~`_K"%Ee qU󎼟3wŹٳĠ3*G"" 6{)׈H3 vz7$R-'ɢD,s$QFq?z=Rlբ OnSL@td@dYf$h8}T̨O](˵_}8PQQRs#B Z7,"jSEtd$`8"`2qdi%bE(Nk\yX#'!VN H *Iﮩ z{ %wp .g#)'>hYHmM شmڶ,cZ0^xw  AC HѸ]=ܤzkx t,aL<]y8%KlfґPC^fʥ,c4 0H__T`O_LS /Rc rI+I@M.?pZ@1pDrC ;te`7ݱT;bGQPApT!vܻ'yʓ[ HGtrSc"?]0Bzh0֗ӝOҗђ"sLp/ڡeWVc*4GwS.Qm. ?Z`ZXVg3N%OqmGNvCh{0N1;<Bx8+.0Hoî˗BN"7&J A1 ʤ=\X , sy+᎚A*؉Sv$55Rv|I.w,t^k+$$[J9&\SA ZJV 6cbǚq<'|G8BPʚE4, n8qK#]nIhۥh"5!9SE%=1n]^ 5՜&Si=fRn ~6c1߱^JNEzj}S]kO qAIH0]h$ dLB-1s(i䎜kr aͰC STExl@mQ…Q%`5r\M`C? _ aEDȫ\VA!ǵ3B̝q>wY6" HRe%-TI Do*>UM}E3Af \Wnhx͂bYSK<~ |ފn_ܷv|r˛o_}F,/^bY<iRitʘ[1@*Ȓ<蕰k~^uz+?f{+aِ@(z^Xit(KA_Q7xشm3bz`D(q,{MkT;z (;b@92>B CR,vp Ώ% \(YÖ~'܊g )P2"76w PI_%UH.񸚮{7fGpp'\ל?mCԹܓqqw`,ЕWwj~ z WTv&c,WӅ :C!sSú=]~\<^_/|i܉fdrJ rQf u"ecN6D94= ) ;e>B$&ǀ=ŒAI84=YGҡF ):đr'ϊ Lug:`hixX)дh^Յ,'(IKz0p wa7k[#wyx Qzg8s2:x(wh4EDp^}%vM( ŕO [[>0=@ ֺIw\ZqN{/-?n{:<(R,|%7nnWgv/Xl?\C-^ݾ/}" endstream endobj 3025 0 obj << /Length 2150 /Filter /FlateDecode >> stream xY[o6~ϯ0ƌHݨ`[lhNw,6wd%sxHR4iR ,/|J:X⻫^]DeHF"%a-?/%DXsWX^l Y$rc\tS0,b-RҲ۽ZLuiSWWŇ2X۫&z=} ,]ݺV*Gʛ˝?3} Z4Y3E&fK݌딛>RU~"V;̩jtETׅ[ D1JM3˂į9[8Z~XnkrP@jBD@Kh LH`1A :-!a;} Rԩ[KUwz{)}WZÛ&T QC&?Olkld׾ LJgB6uZ)T1qG1`|٨z(6uT ZiΒ XiM5s-]i 7ڶ27'/I/>}C2uym3֤B. g%maJaXHPVZ=Bw~v{5#eĭfUt2:UkÈwtNˤך,L2u`SYBD.4@˷`5xlHPtT>!T \C^þ}Q81 7?s_BdiA8>BT  %pC`RSj݆휯; ~3# 1β!4,R2!-J tZ [BY &wc7ފ}J5ʈ(Mb]޿8^C HXKYK5Eʒh 98{}M-'=C9v^$H?,\-'u"% R sD^/D8kY_ 9ba"]v@R mmZ]5Ts*z:X@y5qǗ:pP-=\0M31:z[6@e}>6aGO[^{V ,Ф\bn.ILơ3Bj, ' Nk0Ѫ>GKE"J]w+8벥-Zb’{#3I818B2Xǣ c?&%02}{fğ> cO.7JP /C/c?M׬ݺ!SU)SVo:j[no xݑi5־2{uJ-UMޫwL ~,nW_5™iv_G,UhZlwݱ>NSX)y2r۫> endstream endobj 3035 0 obj << /Length 1729 /Filter /FlateDecode >> stream xڭXYoF~ϯi϶zH@i \I*oE"Nj9of(ng_={yl:g JBή31b~8A!Kfgp0BCZiwӂL3lhto..i\[I*蝉I i%[?KM:'En79i/Ӫ7n*ۋν4(Re_={?Oa0`'r$W΂KyXoS /}{W3ٷi1_҄xi ȧ9PXQySonREaMÜN'īTJze3qGnBo$ؓ{n&W̲ΑkPǵնߝp#H_X1 }` z$$PhlS$4136sR6gU^ T6GVٰ >a P,I~< ߑlj@B`J!|YW9pIâ+L {ѥnܛ &>;~ ;jxo4꾭;@EştݐCWVޤE@">`Ggcܧ*=yh NAM|@BT YXZv4ԠR{[gZvrnĆlF\o9#ӸG P\2Us-3J}J8N``aOpuD 14s }ەТBz:t{΍EWlbZ4K'kP`P_myi|vsjT!?ieOVH)W/4=ČPCUtl$ָ n"ۛQS'>flQK K+zpa/7MU~TӶVT,b l@`%w] Dw5BFAߪH>4Ew*wAl$ǫ۴l|>\ |!#|+X/RZL"ڹצP[nXVcVcnIH}4#W6S%i׷|}*kԝ]m`U]ebrX@K?hTasP a+srɷ[I1=E[Vǎ: w6=c5>@73S&XyY 6i~ի*{*}wjj Jw n짥Xѻ:B%oM'yw: #(x5X#d[C{t?}O?̠.c͗G 9Ƙe7Od:=fZNYVǬӫQֹWȦ;.ͤ~\`S㮭Lu(\J9qo \6x+JECeJnN/.OaCu (6*.h$> stream xX[o6~qEbzhd@1tk>u&KV]]~7[r4u(RR<߹8eb9{zN"rs}' ,r~s- 5UravGAȅ EO?̥ʙ\MR^}ybIßQQ;K8tZĩ$P^ԜDat`U {쬤cXܬ&|Յ9X>٧6GsVG8(tnk帐Wx\' M}FyLAjV Ll&x [lA=<Fk5ң$NϨ'xP) T%%[v[ȐMہm&r1(VeR6k^ |´3%xJk4.t*;ζ!谙]>Tc/ {770dYެ[V-gIYB~ ƪV A 7:gs U;im.' 5_ՕU",r2D`@eBQ#Rǘ?MYU T]< J鿟7g7}k=ujB>i;$:<[M{a!éGCj>~ۣr{@i fG.CYʑB_COJA7WnJ\{p6s.2^QOT~VQ12|+n|ɻ(Ǹ}>{ٝ]# FM: ܬU˛3͕x@ߥT/vq-2ΛRĖ*-4v 9'#ClK K޻qy8`H8$nT~<cSZyq1;t9>|0d_2^WxCJ ^?*dXq[ endstream endobj 3059 0 obj << /Length 2775 /Filter /FlateDecode >> stream xڝYo6߿(R_pk;8>*[[Yr_3d L pO*Xwt,n%@()EceUšH6rL_M{1GwPj^iV߇ OdKb_sʦΫ0 Cδh4̶=1`hɷms ިޤ4:UMǛ=7MeLY{0HIlSa*}s(t0*Rii&5炙Mk(p њqCs 0-*LH,IiMu^ IB$JүAneϖ@6ѡԁuu )jaF ^#_о'z,̶Du mEL|.uy `:U9pҥaŠhaOeeI$Fhr Mb0Zt_9<Cw p 4p7$#CB ɐ"ǃP.`/5zOOOß|1=Lm;o)'L N]IF3%c8 ]כޙm ~#,Fwo8'#lZ"O. <{ǁ s~?[P|'wЂRLqZ2dbU^ ȃ~N |{/[ kii~K9y3,b!N;Ih3̱5E/jf?EMklM@NwX0D,@q R[|l=yEi~ d^ӥ!:\>btLݵ̼Pa@!uS>zkWtS^tʸJHPIi{w|)kZ:&D"*B`P,HpdԀvtonMڍrJ&K'KLvh~j/)+[pz }%y{o( -TRGi՗?8niENLskĥa +s.p>ߓY2+B2fg_;>Nd\d; ؀qrwt`4G͒ƠDz%nolS!sL0xS4$(7hKi"Tc~#PAq8Lu&Aeۀg*iCݤ"S5*1"}4y487/0I%<3:`y8/DM[fK`?K#B,k- `%T"$$&N-ʿrpteq+^[)HhnZRd" _p1$4LEfK˥vn'"N%dd ŃiIoϻ% %P0ŗͽ ŋ2?6``<^땛B+~.79dz9Xf2C(=j|ޱ88mq`?[Ї;ymt\!oƙb=jĊ Z8i;8x8/u( rSwL52#s8 ȴPŚm4% SQB'%zJ5aJԜ`jqDt8F1C oٗCר^rǦp'Y M `G|m siv $DAuJ+3>5q4:kox5grʦ3dL3*|zNvW,/ Kt ]63]R*> 1߫u!b_;p41[t*Gz>#בf;T$U'{< bbaбS>doz34P K7P~z`:^߱\2#0:cEgS(C e6wfk,%=,FW\kQKs@꾠$A+o >=25A,|<#/$Y bMKI[RETbU]4MgXqw}*g V+kNa2:*(39:/RcGBGj@PS884g 9_Zu]5ǜX8 Pxr_@#7-=v^PNVifMe *DKp,nNhm}Nʎu|BĐOb >#^$K^zԍK;$}# {3[=^usҙbg^_i=vz#6*s*x{-JNґ(T! @q,p`,`P##VcFj|28{ĞRNPw1z`?> stream xZo~_CvwfGp i?mxIo:IE(ܗ0w7|cDg P"U`?z'B4 PedQL&N1%(<ޫR*L^tU F(R:o6>crH@xV@`1Η1ΗY :STrkog]C!K}! cN !)~IbE YW(P : *a܈NaZcCE8KAc5TRa{0E} X3spNB:{#.,.3U"#L/"iOk#ulpF6vFJ.A&ʩaaR1קLj+"%sRНp0{\d%eHIWb:3U[t;RI>g];YAKXaɾZƖ*:A3uݺLx .ST2Mpb¶gE Tj9+va"ޔ%A@%/6aWٻwUv6GG9Î1? '2`/XF 7ot6gyñiN[u~YL`a:j^t^i<?jNj961b}96wXhh(z([v f3_5GQ}<.*] lWB0>%milĦ4m߶XMxѶE;_} \GBR,W:gBo]A+o{Ўrok?mNddwn;]W-D|;!9g]LΉTq:fz*ީ Ű#cavy9ozai٤ݢ,j!T $:!0U_yutTWh^MtGzsLcOe_,`f1|oQ*ܑ3W?{s^MBM}ѱΛGL$̾' s!Kr#d7$ ًH Ha9Jj~1 )XFAبe,V̨l_ #(Z'Ht8>l/v~v]] !."S^%#I.+kO&\y$+tp#\_0h}KAG(hǣWd$$r $gˏ(t$ *h$eT [^Yۙ_w*rH\)E2ڻڞ|6#DP=}Trx%w:)r.+y YI ?:{25Nw/$^!O=.9/IZ0h'qV Jzz[%&寘@xuq1ڐıL [$5Cbq.l@$%NQ D=G7ښJ&?n+WxNB7axt V`>@;Aj9t*rgL=-1!0 }d}2ÙvN 0=#=cxP2"rhr^Dо}.SS噹wdɓ)eNMT+ qP֡(?zV >2$Ú7K9YNWW[[yQ'߸!!J@'buy$*|5F'yvqTB endstream endobj 3069 0 obj << /Length 2143 /Filter /FlateDecode >> stream xڵX[6~ϯ0Ë΢4i43,,ӖYtDyU%6{u v4"q<=\ĉY01lvYݵJ.BTY^P-e%W|rke[XM2a~)TH;monmk[+cZ\Ar-HfsDDs6 IB}(\П%~@=Ḍ2Sp‚Zl$[5>K~+/0OF˳>-HaDJfuzKG Z x ܔG" #zY  L= Iw)=qqvM\ܞS]@Lٖz'\6v`hW`=:i VJz2 =&s!a+ s2C>(>pέW䌈[|]+# m-yݢog *򬕶יV)rЊJV٥ϼm亵-_*<Z^F')7E/)zb  6, q2rit4J7SnM҇<lkU ȵlqoMX 휂͡r 9NQq#=i4z4pPNB|ɡc 6dЁ@Jϯ::*;R;NQrdh!=hE)Rm8a~ ɨQ&# CGn~aJ7ִr@ Q?I>7,NhOۨw7L5?0v q״5 fpj[")=wYD(wFou/;Zhm%Y vB54[Oj0cy.=$rBǭl3Q!yli5"s\s%樢mwp Ŝ F!6 ~,$0oJO, b?7dv* x2 񰏪 >A\un_|ԚRNVD jAcy[[ڜ9kQS+@ fEKJ⦯7 ΋mrgqН}ݖ!K_HA(1z𥉉&sxeOYBİ{1w@r&q4n a/UYыUx5{s;xߠ~S`HG.8E'L;4%P+dbL ! yL `fMb|I[F4Com9ºW.,B}V_ Tm[X ShMVPxd IIzMxHjp9w2j⤔=>2|f BO"CLh@!wUHFTaqsP8Gx)o-\7o;e^رޕ`:CߦJr$>ʼn4:~L./eu,(:R SPgU?ح6Rr-J۶)̶[8Qw5eU&PPv ꇹJz+nen;lwJzܸ^^^ǹs.,MW.Pmr*]pa"'> stream x͘Ks63g"/>8Ng4)"!5 IŲ}/>dږ39r~Vůś 4V`[egR|uLY 1jDB-u1/ 0&,YD%%f˗//~ֈ#}h}Qw!8[۷n/8la Vo #}!#K%C,mZzB8>->?5,h r⅄#F# cBQo3aI쫘ދb\yWֈ1« M)^?)"Y4LD3)D1 ~m.IiAE40ӯU8ڌi#E'ܜPEDQȚݔ~[mAS5y>e`m ˜MB%Bb nCroICdmO+r}s q)6צ~B:t (! |;=e(!H'fRv:3hZ&QfqA9/`cNqēF TVl.U  JT`q4);k&[+ܷ}*wY\ѣe6KznFTZvٶVާKJ\$s:An1MF*"G4Ī1ogiBT[8=}4H:)(.D5."63/IUbX6O1bs ˜W(AO7;=XowȌvmߚeHM~WWF#web.gde(2s!P-':elĮ GtTMOT) 2Œ)j2Ϳ`LeZB fl L[YOZ֠SZju!W(} mwq#r8"2'8spbӱUr|TZ+gkY<iwPu,fL6LV5:gLU]^m' vwT@霞Cu!]$TIf7$wMޟvIٟ9ܤo#Ώv_[^N@̽6K\[2#dYh4,hNiq)s]@ptbQnS zJ|8JIpPRpR)HWr %M ܱRjX*o ä1P cȜK~ӫE@SI@;vrL7A"Y顕\$r \lIֲ2tK|mfTvA|s J\S7yJ`7i\R&?;q IV9剅۟Cc3aUrw8Ղ5O30,uBT.OwV|Å2:s~:B9?Wԇ*s<ٕoAn N endstream endobj 3090 0 obj << /Length 2821 /Filter /FlateDecode >> stream xڽZKsW%UTł0=+9\9q03L8Ęק %J;tPoOW?]ݾ͒MLd݆1I9g,6wJ׿m&ܲX^0#Uo|u#s>9%}ܷv+h>REdjE;7e_fIkHF:~!Nc;lW"KU~c>VLqX.YQ HSz)#]w+ڴ#ZQ"Lbsv ?w4ݹqZl#Zc'VМ6lHsz+pDxev]nZ{…hC{)cfK/kjbjxl+f=8M[˩kBJ0H8qmWm'xok0dR"nufBE7h) ѐ S;=k()AB[Uّ,y"9,ث P,37{˕\AQ 3}Nh5Lݚch݂fu}kɍOkɜ[fSޫ%1l Ǹ-G rDg-pqlZsh! (zl+uE5'^@ڷ(.Ǥ3ɞh]V<猏A+ &ӱYZ;NQ*r\@9ۊ,fIm` A9r~GgExOIjێ %(3 ͒qgL2>FVDnfNE F z4gíE5ƌ27I2 0Ӣ|I(iE'(Ci%$MW]:=/=hs/6u|[qu^2^"?\'|Zj0` u6g]@@L"9nM8,~sUs 9#.d]~Cv%'͂`mz(we3 M SZgH |D(Ȝ;7]ln~Hݻ {9hzvyZDv2}u]G^K4$9 7s>z)ڎ=מqtZeROذaN@PF8-8=.AP: F'PM 1*<5:T"OfH){,L1` b2yEn?e) _W4FAbO>Y,eTXLp킅`9L]E]Bs\"dϾ*ㄫFl:ٴ>ڳ;{/rJ{0ؽiLc^(Jt}u.Oйk{8쓊ITL9 !iD5^K“q$w 30̥2&U"A~˄%̈́qK(ߩ;ddӹ7Ts? xdޭfn А)m8q(iL{u]'F!)B5Qh8ȶ ~]c\ N33uD~DR>[v[' [O\z R:9e<|ZjJƁ^44 8z9Gm+>bP8$K& 9Ee6MH. I:F]]d&>^z>V|V>6% ?r'tHCR!mp =$~Xyo7hh`Hq5*0Iq1 ˳AgEYt!ߚ-4|t  naD@ 1880!EO?$P?" Sb=[ӑe]Ћ> stream xXo60l fH m! C-6;YD9=r$Wq .&E}d5ۋ/r,~9aH$1D侘rgܿ~Hf1UU G0(<6T;= LT&lc:-Tl٨ӽi~כm]骵ߟE=pOw+&${2?'c;uSJ:,K?Ook:u z/9 Iw#cZr/0=e 8ft>hfCfښ 4bdX?.epD& Rw5yTm G[BF^شX_G=Xٱ+{drϕ@U忎oWֹqLBDoeDsﻗ$8nʿ,LA`LĨ#IcCG:(rAinOSSF]$C\֥v­;?^7.ONbKeW,Jc,?cL0z2֒%ho9ANUiJkZih6*s_'*&;ҡ($FV d_ЪlA<:%"0~RlvUޥvtSr;=k?}|d*?$1p*TEhv#AxN?Ͷ|#sI`t Q2ߕ ,땟4f9zȓ tB/\%4*] & |`ᩗs?jz`:hew BMmZWW+77^_{hW݃jL̙ y&hکrKxc8`1m^Љw;ك9Q1|BXח}fD3ξs#FUrgP P,o!»WDٴN-gȄ^B[/ز2gXÉ9  D''q31r壥PIz ubM0QM'hC4 >COM-ТHnhhw^VpsY?k.?$4gAbL$6|!wh$VEb>^_L3 endstream endobj 3112 0 obj << /Length 1535 /Filter /FlateDecode >> stream xڽWM6W!23"O9$m6hivAh[>\J&CiK٤E჆xHy89oo/BIHй8C'}\2GKyh˦SA!z$ [R>NFؙ;!vCZE;M_ɅنhJ;ݭ<.훳œ͵hX9fSOm~-g2n^{ś zdAGɪg%'<{Z9>%9إsSS 02؟Pm0$s!3}}QT*;pou"7Gȋ @[t4>[UJx:Dֵ 4?&fЏ&L{u@'F <[1D)>n3k}փ5 Vi? " Z~2)6M6Phƀ͑P5AʴmQFdbxahYɌhnUσ`ɬYqFB:/-% `T*# )٢L* RB5V e&QVp:(-[S6K"91lH0$mӭe9ƐYVPiR#:Z%OɌ :C0ٞ}ɥ@+g )b#%l JcŶzj3@{8 7[|BVz9fl\R\E>DW{<zX`hoDESF#Q5 0#Q8yDѓF5hx¡™Pf0I}<25$Ch]#`ZtBj\*<4ͤ^d曙ܙCTaBu.ĕS6gi㌙h%u;+zy̜ٿk:s3yD<&Q,ilTՌgO7|lL/942CUbKV~51qyP<]тlm |{ӷΜ҂:ң!pAH]Ќ;5<IJ( 3annW]jbU0orOJG:M/^] 'l̶v5 endstream endobj 3127 0 obj << /Length 2365 /Filter /FlateDecode >> stream xڽYoܸȇ@ diR3h&iC/pY+a}g8Z)Pذp8珲<:g|v>LRF~tv;SR DgR"e~ߗGUJ q'ODծwtYmmx[zV(zH!aܴ]~GÉDl?WCv.Nioj^J!Y$  q #:Z@ GlvKEY ZT]u 0RWz1HQeL,Ngݵg#KN6:Z3E[A:bX1et{WlZðv~ =O̫|j5mB] AHA.{&hGUXWصhxqna]7Pzbdз%ɡO8qmRHtBGFU>N))IMΫ! A^RJ  ^j[y|Sp/撮=5 D&, _7?F:lK MD2r,Tqt"!qgW_ zUsCv@G =>B嚕6gH=&2$ygV~~HXnF#/9<:R2$rk5Y"gO` 򦾻vE >#'рMJ. YgUVᅺhѬE#V"U/Ε.]ޑ/Z8K!I?4|W6&K>b!><(MH*諾%R\/즨[9YcmipσܠjtO"vTҷȻ6'B< ;jrSzPd4~mtóO hϲl+`9W*R:E|J re"> stream xڭXKo8Wb[vi{h{%f+K^=d!K"@DC7O::ffW7$$ й[;R1FB/q2F {IH$iudQsX1,6yEHRf[Q-|:\,}^$,p K/R+o"kFd;%/xXZ^՟{lBM=O ZpDZ e[iZNM[fIh od݀?W / K8|2xᄌD!l8=/Q]¨k7nf_JIjs(aqEWI-Y_! b >U^8~NS=}7]!I!w;fL<7:"3pijvGy2מGu[EM_(u=ܕr~+ӭ ('dVX5"m w =X qB =4-w9Fdڜ6sMzk=b ?0L X`57ĭmDvL'*y+d"IJIC $F&.d~u~)\!<?JN=lyqda80j PU@z`cpt~1jhMD"j؋/ˀRs|oz?ysm-lhS=`, gO5继R6tq<բZ40F66Bl$MEs:olN( !PTNkjXU裂sb:ǀ9ŠmƄ%u=ѣ1c7ub +H\zXtrG !bmqõcCHtrSn¹\OP6a0׷ HW1>μ Wo4dF : QQNAYphC=*nZ_I#Z@UDUUWEوصyECn7jIu]vquItAbN;0i,LǧB&z/R=~nǐN[TuIP37N旃ؤ X( /V2UTuߎ_׏ bjͤPy[yֵ8=-LH6P|y,sxVS]&]l$Ҵnw5WV}u6Q 𸂃7g~8Ҋ P!(VSH wV>纲DX<+܂cc1-/)g@ez_ ZMLvJ`pV endstream endobj 3157 0 obj << /Length 2137 /Filter /FlateDecode >> stream xڝX[4~V۲ -P`݁ʃ(Ysةwvu9:߹|mg|㳗7Ϯ_,cY"f&8g*JfZlv52Y}$ U)gKX jLuٶÑϸV׃)0g)5t*LQF0U0IzX]QWMF}҅(X7-y;?}mۼ)VvM=/B_~mj1YA)bvApKPqtWq WTYY*-m9,cbojmscv|csW[G-/]^C;:,4j]TI:Ik-ewi S2 ^v b xi!8XY9,@ngP[YTCYE/ۮ)+{sOP9 Di´-eԴb^d'vLRPA] ?X#V #nB{7T%Z̄\QdٛIaL01*, g4 z<$%SŀE݈"h}c:B\,{q+yGSNzSz<{LeHNZe6LJ1)-"YG5_;+#&bqFק)":CTU}*oZ#ՔEuI"q˲F͝Umյ_\B*h 9^2Qt2 5pb1*n ]/b,epO˼GÝ)?hIfyqM0~V5}l ;pNTMD8ެ(G{jΒN=PG{)Iet֠qР[1'UCvJ9v~:Ҏ]vMyh vكog:DS#MvĪT*pƂ-pu9t]oBG+b|w`yD0 jBi<n4%O.2HYR LNxg+{p<~Lnn1Cfy|K~q~BOpH2"Dt_h(+w1 m@k/) U.M`gց7E݇K\H]as<+eRggI&1cÇ0Pc}TN*91J'C *^AJsayk̔NAl8XXd-W Iηvxpz`wzxc|IyѠ Th'?VrbJHJ,ne@&9OzCt2PK8V7oH"Mi*/ծקӉKqXg !{m7)޺{'%\69/ϨݿD|^< 8~@r?w P"o9& n`wƱx5U2<|¤ށ^5])HD{5a d'p;iVp l}dyf-򻾖RQLlXƵGKp .N !Mw@掹Tk Wfi*S޷.¬_ F?aOr{&_)g PR`>A|SoX/ Eg]?vo8*yl5[ Ft gHB9Hi[vU &f,YN$ne[OF'i#z?OtP'y$)~ {Aq]Q^׍ܫ1)wHPO@T_Jbb:KƠ$0#ŃeiͣZGs٤p?M_ endstream endobj 3076 0 obj << /Type /ObjStm /N 100 /First 980 /Length 2157 /Filter /FlateDecode >> stream xZnG}Wc򐞮ꮾB'wz`$T%EJ##jfTt8]BT!࿬"F#Yu3 dRddWxūL.eAL Ó)Ԩ3J6ѱ!*p̘BVKWSЧR8VcY % MHj4,7yvEasKz@Gc%NE1\Tw{Pax=W+(`rH0Lt9LI0,F{V KSE=@@a8(x v&xRd Z#< .a tqtI8E\0RߖOD>3Ecazl Vz`15nIH YYAHy-YQZVZVZVb+Sr/ ,FՖiD[想9-uBenc84;蓸[MxHܞYi}صHV@wS0N❷u EN:=-w7-Uꮼ]acF'#{3yr%>zҩ凕Vijci(E0ᝎxym/oˏv~!?P6ҡDuV03DgŮ6vCr4v{v^./ Y)XcGm\B;t,O@* d B#= z@l @DK)& r;/W5zYHOib2>+H:xK{3\ b8.ƕ9:E;jh0:M~OB0 ` փAɧt;^F7=ؚ%rHϯRwgN"-sgp^ҿ8%:-Nt59n)OkcKtA~xrmab+z ɘm3&S[-FN(8C!<!A}VxC `10/RV#2Hdz4h1Zi5ųN-=mْdݱߣ"͜;jΠ }"Ŏ0XOԝr:)GH<nyZ*-J_-+NiJ k@E?_}5Zz䉚AU=;g܋ч~q0!O8R0?sN/g ÖrT wӂPm`×\l36-.8b<O&=/>'a"-ƄBԀ .r֣#H;n1'+Mct~34`9g giPnځs]nڞ v汣6xQKe1\ endstream endobj 3170 0 obj << /Length 1524 /Filter /FlateDecode >> stream xڭWK6W!61"'=l6-k>3$%Kbpq\Qū4 R, ."4(%)/Maٖ*W.zu#e^$+ 0ePiy렝^=dVJ.8r >yҜ̙z*Lh*I7GSڸh6~n[i٨00MB" mD紾WcDʳg={Ug^?[ìW~V򸶁q NgC'U]nu([Yv>Zod5 o (Z8#h;7Ss.«i4ָ-p19/2ڍhA^^ˍ $c1IbONF@\ýx{kAHСr>E‹SP ܞR(JSx2t[CsW$KxoUq`F FF1IK#3qyO` OO'>ۺoLFx+O y/}~~#;*;A%4#mkJ✹f/KBX}qqߛ*w'G7zV-'@x<V./  hۇ + ,ZHYa G[Xxt(p,XOGyH@ Ա~s7;;蠩0p2ȧ7K\(f^dirb2t[AI' Y4 ez|})3&4PBgȁŤ8r3x8=F'Q$@(;ęG<%[(*;Iy5lBgZ7/x(^ 7۩I5KGty CK GfMQE֕_{8 $>qs|t) pqU}^A;&€*/HT؇S9𥳐ގ߰9$F҃qv y9ac> stream xڭZ_oOaK""%Oi+>\Jv=LJ3D\RpHg~ήʦHsu}w%,U*HW׷W)O2UFUɘ;.t*zð0X쭄YZd~٪,Ka[qhIwGCC56];껍ɿLy±z$Yi#;|Լ06CMdl`WC [5E2kj ѷ$nJ$D<0Qz~:θ0|Y$]{y|swnSJ  xj@9v#7m}v$)R{S-E[,L{sہvUKkN3vLXΩAb#=4ޝ~+L5Z *oc#V{٩e(pGwQ@uCa__mNxzZd40DWL@4I77v}=i:G[lvWow^p؅D g_Yv`3CjL4躩[7{ QgCXLZSas$Miy#PGjY9#ݱJP+ʵ.?ˆTe94@aMI4l"c wJ o@@ Gw0&FC<*m3fΠ}%~?.Dbȍ3SQ2RtI=K%JGF(kܔVLƦ8n@]FRZ#bfXA줻d ;p5Y )R#',뉢2-Ty[p?$bDG zփTd2s.LJ !9lxt` m Cۺՠ{&`^:4G2nSoX\ 0?TWP6Ȩ/ffZ L iҼ&_xewKKi6Ӈ:ȴ0!_j߂ jU@'S"%CO :K ⍁>In%v5shD"C^|!$V͑3լI]DyR~EKf y"K`  CoϵmUdLpJdE"rH:e$ \G 0\bؽK$ !*>1hxJj5wUme>Mv*QBQECs3yηbǗrHx9ME4jH!C u24ņGG<ݞ<[km7>})¦~*/L^: XJ|iИJ Pƍ(vMÞ"Il𔊈Vw>T/F\7tص0uHj~.Y@0wRy@Mg>vm0RY%5ҭB9QF@br̗: ֩ >!Ý!/]F,R7+FW[$2\䂍._. NXreTVY9ú8]t͕"гD=,WN}IWeF&vY)gd`~{ M˩2!}Bk&=-``h8c?ycr$V9L%XNf:V 6bi|i(`Z./>t8c>*ӿR/\J'Or[ R] 7^*H5bm,DtU,T3DD;y$wSq8xܮ qO= LwB؀N1HeBc{;.=A Z oYNoAy;ˣ'9 {{lڷ2̨4(tRmk9<j@gHb C"4+~8NCC8"_4Ϧ}zb2-~zhX?)CD#*EXWυ K幎6dFisXjj'''|Ƹsx> ьċ~Iii8pĚ4>ü%)+VnuO563&h]㊰2Dp!BAA[csFfaTND2jsM@NgJo2I&SN(95P2ĠڍgS:pHBcļ5dd)VWTFåCǤ=Ǝg( +)EKF\ ld3W5XqN\V串3WB؍Π F3Tz<-wb9U=G>.o^WBK&A^ ]OgʭPRa|S)S sfSϥ>G`.V@᥀[.`K/HuC&cީ).,JdP*L>V/ݷ=i,IT~dMjt.L(3 47t,Kq1b*^fsr'YrRŜ+84+W/oINX endstream endobj 3187 0 obj << /Length 2115 /Filter /FlateDecode >> stream xڭX]}_a@#k.IIE74m+ӶZYrDy3R^~?Cr̡bon~{Pɢ`jYYE&SqxZ/~RO=H8.ˊT91) ^;Hg#U_ cZӲftb+3J<+Sl^WMl 56m]KFal1Mo8ucԛb;)V2DN5PT;j!c~j ~\n kNK:/x1U6o[VJ*Xt3d?CԺ& j%e_xsJ#}iYӀ*34n)yǹSA`+qKxhh,J,ϒw™g4YR!uo[l+yAaаK{НY}ɓ0c?==Lԧ DqdєfU"!g$4`o{8F v\KvXsw㺡F  =(hulÊji j0S> b[tθl(`~=`ʄe}\OeQDkzgΣo74 ێmP;*jf"i㔌1}loRGv&0~QNum[j=O8n o C}?KȾ)PYCR,)Q214. i읰x إUn@خlP=H3c&e&9B$Tm9Ll3Y~& UCg; +v_5w!k{$׹~Ԗtvk, 7vq"Q7]AC4ÂVȢ] _ 4:X9 B⁡=Ꚛ\=l<(`|X骠Va E񫃚qW[tiWˀ_0LG{xTe<М"I"hƒL:Ik#4 !x<w1=3*!SZgPl * |ƅUS6a;)fwzçEtw3F6&i̳|D;nQ>)%z]BihSHՐf:,b*wa@RԖ@j! H5LׁLH}M,I&K20D#A4AcLM޵1ϙ `̤ og2D3*Qdsl$WAq٭kiL'߉Tbf?/1s\Z[Xd(c02Px(mJ&2QWOP68Ut@;g~(L!a_Kkb M_Fs]0@`x@͝Q"7I2\ JV0);f,+I0m}! 8c6M8e*@؜7%cI@!tOCz.᫃8*alxqQ5r&ϖG;2Iѣrx4L> stream xWj@}WЄZ]PBKjVD Kb%ޕvudIcw:Ϝ3;cNư9f*@!#M"(+O_mV?oLGC`Q b.6 bs<UU&mz_~QZ BW,a}74aK繰phN;%E<8`2u7l=.Ŧj9؋ 6&aثPA\li'a k%L2-ZB盡'~GYxp4kǒ]I[/ DZU#,lU2CG <Аih_-5OX_bZVa?W5ऴPl!g{uZP_B7IqTڑ"6r4HGd9!S㐏au%u*-FL]U>fe*!.7hkP+*7+Ie~Xh U0G4s\^b!+~ؖ6J}$rGόpqǻ4=8o "tg MS]TJ9nr\dɶp8swV éCO~8Y~،8 À2MJ#Y~U G5YXUG=Wx~o0(n3d3'L<)ɺ`7eʷoʷCRf#86A~}f1 gecgwZ&ޏ endstream endobj 3205 0 obj << /Length 1747 /Filter /FlateDecode >> stream xXKo6WIh/MJ)) Pժc+iu}Hֲ(R9:C\] '!Ia?1s9Vw}/:'!jbg?]y`J6>sWdށ$vn5i A0/F~m%a'`a< dzsIb6(rjq g;30ÛfSJ{W^6HȒhтgaAdd|+-}3& gbf1w:G}cƴG:{6ج4t2]xD|o4vBa4h bX)% Wx=F|BL`E-@\ah J<6Lfo[ &Ug'fqW0‰KWvػt}IbCԢs[iKР3N(42 X,^N& n^ԢYO`M&37`Pk۶ak%DpӋD3\Io.cpi,ĥs!޼Nx- XMojٰ6JL)An lCuf1H ?.d3<=< 3g@g3` or7ЍR9ΑOE@ pF_$Cʂsa|:#j؁p1sP8V0AEgUmnW&cns-<.-O:*& ^/*!,͢]R R;=F~T7 g iXb)jQYD؞Y1EX|* Htz[cGiW`Z6-phh8:XFZmNfKz{tX(+>IiߕxlMb胂NJ :=hva^Yзg١^ q:ʣb9hE endstream endobj 3218 0 obj << /Length 2242 /Filter /FlateDecode >> stream xYMo6We VDQXm] C[`eȢAo )EI]@r4|jV?^}u{2,8[oW,Bd0Y<_wYYV ͤ5Kݱ#2_Ev{{ͳTs r"0y{< "DZ}]cVfE;D?%Q8EnMn^iP۷4 >ߎC %~X47HK^ָa +ӔR!`W&A4lSD, 2&9O];T4򴮞Z<g-]8׈d(Qh^>/h/?Q-펳,[`ftbz>zR)1eߴH4"G.ιk_ϡK;fL-}pJ#RvcuM۝qkŨHqM}Лq~)UtgN*Z R8vU-}[g)4~f!wabM!y0k1ϕ< ƣ5/X^D7V'0ߢ4.0>0)0x&(:n Tvy<%P@RL-PnG!^ cj4qEC 9;QfAJ"GHj-"La]СXʢ %ƪKC,t@v?l?y23Rx"d" 5 oldGsaiBhdYތMD)˃ƫ QQYݪ3aI:4w-F5b,z*ۗ2, V[| Tw: bb9ǡ&> ,X-keѡ D|3(&֑D:,iy2f܄}'~>ztHmTY!,8CEmUAV .wdbc-X -/ D-8FJShY+U#~FkA f!p(bu ~YJE"vaa˗H, 8W/z-*9Q6 TLOB%չN{j0aSVB)DosDTm9iD,uIV5w1 C]aդcBhS ] 9YEl/6>,fcq ~bG7R5Bi4I"3I'Efb0HR?>5 IMH{o3 :8]ܱGV=~l܅k\<^_쒓}G}&ҿ5&n_ {D1&+ۚIF+,.c@>^xf@ rrytsnkZ&k:_o/!sO_Gi>Y,9-E!{Qw.\LX_p(MCgj},P\Z endstream endobj 3224 0 obj << /Length 3023 /Filter /FlateDecode >> stream xZKo6ϯ02݀I=sf /u7֮Zt~֋ՖcOnT$U_⫿OYrUFeۻ+ǑI\(3Uo*]n\z"b,$fm 2e14F@4-C "N72ia`/(+ē'ZS3&΅3(Ȟ?ϧBITƹBFKjGtUH$}@d"z + ^|ڈU>젍cDn3C`\Igojyt P 4;ZEE,fȤcO]nL(SկU?af@?JW;Vu3{Rĺ(pP!p2ᨪ(+%ڳUFy-u9$OWBxe?DHf8 *~xRM#"l{\dY~ 5KĀEM/7՗z\ݯa n3`c ~OC:2ZwuQ`*7C  uF@4Z]k;L =7\o`r#N6D"/C&pmL 2ft82VR A)V꒞bXƉXeZǫӆEb7|]|퓍A>,E3?: v9p hhٻ6:WU5 KZ-b׶1 m}B! rh|),mN; _cR̪>fN83uLPW<CR.u>R> NP>UZexABA23pQHKS{t):X~%KUfc̾F8xproM9\iW\4P_m`OqGfÃS ;Ta_uk}78bx5!sBvT1F+ԑ%O6ҕs*?lqp9)W\gQv=mas+Sw=ت|z~ߐw.i~.W=u"T1ꖪp8zNv =S6d(M<+H*j1L4 '%$a6rPHfL RbB @B ty^g'9Kظbc?ݱw~Nr=Я*'II?Ls*|ฐIiOt; RgWkbrәHǾ=6gM-j*cM< Hd`Ey zuYdЋ2$ iݬ>r?0k )d&M$tMb+47Bێ$j;b%F2m(#_˥tf)` CW ZV[jp]JQl+GI؏-|ʱ|qa9k/f^J4hv4;g˜g%9ԅoلu`h ϞGU&z(6đMj:0 V Ct%((ʧ.\ 矂 ՙtsS?7_37>fÞ O2 BO77v Isi?]~/>$. v!lKM" t?WR2y1AJЇ5n{[W$WRm}pN/~ruzA3j gճVϜc]XR.XgfgG ;eEleexk _ʕhu+Y/x~MIЃ FS?]*@MD;)z{ xڜߖg}'-l2t~/~$Z*2J͂/m|'S$_&`!1}.=(uoVIϰ‚BNo.٢SLۇ2Q2+HC%zH=2&|eA |_ xNܧ~"v6ݍAuaA7Q7!&S0l _>mBa]Z4ڱ~U98I8~IW4ndFޑt&ZIq>7XBegܦt˼5ef?kcRF2a$5qPn&q_`:]`u.( %l4.V>l萐Ty(OgUiw`.`#|c:C@>!)lVg}8T2IDPYqu0tpܸ?[[[XD*K҈*4%zvD5kRO2-8"ALzǯook3> stream xˎH69(p6!g69ڝ|}|-Wd@ h`w?Ûw|WE. _. C?UËTß߽OV+?Ms Dz|m7 &teT|TRDhx`hZ2l3O7+Ԕ;{cm neUPi}xO4!)B}x8]@Rj&y;R$aɚ-4^D߇w]L;EuaZxn7;0PvmI_9p=<Ӯ4BVsz͵k=GBE*b"us3o;c#/1},z b]ܚ6u8;G9t=9u qocIԕ~ v)Kd4_)aR8ΫȆ'73>&kB't 'T Ɠ),"0zk,2?Aԣ FpH@Z0CWU2N/u[ N|| @6So{֔ QS䪉xRž~“'%Γs2s+T@Xc`mӗ}vH%[\ozm۳&> }GTA$lw1kHxZg1 j=*^ 9\JO%Ko%INщptx p A`QYTƢǁ-UHe8vdK8*I; i-M~nhQp{9 #еC5,MBeդ%~֝?zW꧑,RKUJ2:ZZwN}w΁ﱁX(&3#'7U]~PtW/8x8϶|̚BQ)tk' (]~b}x٫@z*0@*(;zP] {;@VZX_3@@$ה± zX] jyGNdn,:.QÒCm>rDMpԇpkmwܴ"epZȌ lÙn ^FIT M0r%t9@֘J6WS֧a6G9l훙|ݳFN6oӣ4m09a_DJ؅㇅V"(R,$t|z^|!w rGcS_ÔrJaqݧKŔحКí[N՛"֕m$Kcq |nCtRЃKFZI\?[a/|:Nh5_uד|.'X *%4B5u˹N:e_}ӝ𥋧*fgx(2U­ , % wM5V,)_bo[@XwjX^ֵ$L~Hyۨnig*_p;TkۓEvM] ӭ&_: q(jkW̴O ީ5T^w9 f U'F<> stream xWKoFWRYDm q@a!aEM(C{g_#j|H0t>D SA,շ_- af7xZV-C}%N+}!J#@vU=uݞ(CiD7 *O2ۻ7( abGު 7JeW1HAguK{<|ۈ|cDe:if_5]+;3r@\.K~(@\,aΊLjrZwziZ88zuUo%hΌ}XF멆y:|f5bӂN]C#]c B`oڼ%]?`M 8N W,~>:^y!_6@s9F!"OOW~Y/}(> stream xXKs6WpDj-Ֆ;6tt"! Iǥ_v;AX-ccXO;/4"3X ۲Lwm0u\q詺g3ۛnjj<wk0 &ìb `ՓmFv(///gsϲUNj)X DQ:#%Ϫ֔m6gbWI jdU|qb$oj[\7)vFXw*TMx30CR ^&*$?4xY 3\@CfjJ5_+$)~#7܀))Q ?r}NKHQ(NƩ华aYhqNW|*妾}>Nm8zqʔ/{&!:fsu *P*Ę1,EXk=N$qtÖ$^I#,Ej13{J`.H+54.k(e*;h ' ;{ȱ % )d9?04?Gc!C5NVĉ*m.lJ %5E%[Z(%f쓒8=*Bjr]cD9g%~0\ \ } ={0 ^IBeΉl%]Xzq9 xRErB B!X^[WyJRoeφ)ak)iU ;]3(N=Tґp#\N +7_<' (;fj*> stream xڭ]۸=b@̈"U wh^qͶ}h Ti=Yr%9_ΐIp8${F._~Bid ӻLJ~Uk2Y{$mQE*9V" F3*<ɶ}_Sj|n#sWu%ѧWME:<ٗ} /Oy"Es7՛|o7/ۿyݏzh'BdNNxdtnTftwZFl{E_`ͧXBRQ䱗a pn4FР'9dum4/cd\]sCړo軫ʮ#MTEz,1cĄFF&4mhyc)הLk5mkKSm}<_*%@xXw&JcݴhaK I"Hi#g>whc/ȦYHPȴ ; 0oJ^u@3Zחl`ڶi;ZAqMo~JժGBjjCNwt?%7V$$\.L`ˁg[2BTŢ99z6ff7ݲw(6/˫6T?CZͥM]VptOes0@΢x;!XZ0k 8FDS:wlѶC& 5!|̺mM ϥ|a0_i |p.\׽uˑ#%/wZ험uֳֻ <J,yyfBgy~kO~RTɩa^MPNDC[K[ֶvpd^&Գm%8yHqm{dl,b82U_R&T2Y6:/҉&]Z#({Ιi/R7TN%%J%J;ut ZvGZ8wak0㨻@ש.Z䪲iKPL>I|\%="H^+NUrFd}$~GBF_gh, Myq4@oRV2d!M I9o?F RDcw%=Cn:Ytf2$RUs\ ќ!io0yOղ5bk1I: jzAyn+Нga,ɀջV!/+ZGb|CGiQ$*c5+=lIF[TۦpG/<'#2MXhIZ*4ToTw?cnĶ|^H?AmR7fcA庈'ϹI :o8]T>TD]@4.WO0[4=OQݞs87/`p/1" N^*LOF%%G-i|!`04O|}< -͎׼2\ -B99I¢5GjGt\c1)W1OL۲eqέ ̔,R%7:Y=^qLH_g8厔'Ք\[c,mmqGw 45NL@Z ;mcP^gb,fK10F.EIߧ {}gN֙;8Ȳٔݵ C0`RH@Q*5&'%I1TPh-D ɌƼ"8 qCja:u^N.:́G<؅('kvoJڲ5'bF"ϊ_gA Y2ra<O3ΊךVpꓟd/^'mfa2 Wd0q;?"c],| #1E~e*ZViVm$ӭ1a>- ; RS>*ZP\>N~ߤ6Q7qJn#8!TKkPrVO&wΖUuL_4Mu11?NkKmܔQ(BRٕ&&B%AlsBJPao!Q (>J!2!E/ch],~gQõ@d>xpA|ShNMd*U=UFQho~GMw˿ԹHrX,޿?ޭ endstream endobj 3263 0 obj << /Length 2605 /Filter /FlateDecode >> stream xڵێ|q^j"QyhH6I@]f ez)9 syÇMH6M^%4$7wI4A C RvA}U#Xl,ۋCZv8=5_qhyiz}t!{.W4WڑNARp.g{^SA\Inx)`uD;X"'Rf ` ?J ʑ })lb{nUϣ1DZ"-t*T`IkU#χ]A >)vi`~3tKٖڶi⫅$s4A"/ Ӻh 9 .Kȇ'[-Bu^_ZX XZc=W.3]i;l(ɗQv[ۯ+<Y\Woln0.xK~H/o+.} /sD~63Es⏓`Jv00 @oW]x}$ +CNG/ Ú-ˌK^ eƌIt:us1AsTfT4l\ Gum/}P0ieŴI1Ⱦ[,fsB(WT x-CFaU3=0Q7ec (p %i, eP$/ie݁$iUsdGk~2`pI#?65Oqu K"j=ӻIH%  }|AQ C_ 2ċ}@_ 8F΃`Kab0NWԘMؤ)K}. ԘV. ~@0NqF~^ig NTWȪUψ2"МHM! a6TbN7h%&:9$OMkbʚ5 Ϗ}N葆o @) 5CTܴoPk95M ke!qGq:e5(d f-8 W Oe2tjc?+6Wk/k5 bJ43>ǐqF5 Y`9kGZ`E~lʋoMi0at ͡SxoOiQ 4}XybqK7B};hE|"yd94z-CC%m-C8sOzKQ̽%ƞk`Ţ]c0úr7M䅼K^f]="8aOq,3DIG<]E(Թcz6L)4r쇮9QꎗT-< |1şY ]ŕ! 5J}RXZܔ[ӮE28l4N :, {lסw<Qn-=j9{$razlJքK!FG=kiPy٘zJ=rӂBW⺢cTU3š "$Qag^F-eiJ> stream xڝY[s۶~ϯf"I윞9N^Һ'c{N3SJ%!.v8Ņ÷<۞ɳ_{q2mϔ"Y0avv9-hm_two/ɐ03"2va^HN&R' i/M_FMFOҳJExewbtu^QhIe b(#U.6T[=R}_[bN>e,TnfST~U#Lk3laC[luߴ~o$vbFII5X7$ D|~f/1fY/t 0hڮljR4 IIK1h+ﾌ0:=SϽJEBe+y=TFAP}= 6j%XYL,ۂwm2[0BF>0qB7ܴ)#UG4 ``WpPTwhNHX*Ӵ_w`ԛbsV֡0M/Q6tT|O7e^d8o-!}. W! (' &۫IEr%Ԑm3QѢxLi .#"a>Tf]lmAU0 2˲>m$ ` ׀r[뼶*ew]B>"愾|؇Y]ꊖsʘN/{ x(9f=ɔ)1FQ?S[w\xR̷ 4 LiJK5]K<͂ql*y,Cu5C20g[$yncE N<;o-|C,HOJf vڴ=*?0(wbؗwr7)uVhĶ;8-ޕQtgv槙 pCbU,L p$ d<.1,ǀyEWjg)KvA\"Uox-ຕzׯ#ii!!_Wp\V$(ZX7߿8~jfX,4f9JIqn{X6\'vyE%&xA\W*~u܃c2o(xAkP@uh+qI~: [(5L"@:Ce܇_iԐKD@|̩{,vͦ x$N"y@`ʅE3#7 yx$g}@zZ~ <>DQ%"@adt*ă]7mQ7(3kBű+ֵ^BkňۢjY'xyl{pszh][nٵSuFoRaA6 (uO]{]l̾2LP2 |8v< 9"8Ӹ];L^AؕcJ4裋lEPRC;ܫ|'ħ; 7UYmd}Sή;iSPPQ2[jH0DH9ΐgF3@1^ ø( w#\Mrcs2ĸ&tu_^O! ;K#~dda.ae~ Q&!2ė79g&oX@ ~q+G)4Cz2B'"T=pz8I2B,7y(kF%r9<. ^ahlSp{3=sZҁe нƿG|+7ԫD~ endstream endobj 3281 0 obj << /Length 1414 /Filter /FlateDecode >> stream xڭWKo6WHD=6A{hz`$$;P#IEV| |3|B&zsv!'EPQ:'!!IAJM5Njb2Շ4yP"+4Lyuoψc=G,R<4%墿c+1.~L iyԧYݒD$$ a)dW^ts#y-:֬5xJt?_FCTdW6灳x;k<,4O܆zdmN'I=Eixײxَ,.D%E4=v{Ըo(sg(ۚ $cd}?]]URRͯByJ/Z >?L 2P_shÔD)?@ { KZź -Fb Ϭ\*RɀK{E$H^MzlՁ(YW-!Q(ՋB#c<Ȋy p~ 1lnXr1aw˜Q/@_$ANGf׺;$.e\|ӐxL4fwLXJ1cWEGhavH}IQD"7I΄;Q䐾Q[~@/&n|7a?v㹯5*eT Y _qTHtD@ٶxfMa,WHw@IHaGM1[H0 1ͽVg|UDHhp,qԃ'\A8m4)Eno"Kڄj3%Lbwi䭼w~x8:Q6؍3R|vKdbƄwbV;Dx^i0݆dϨZ8lP+TڷHqkj1g=Gof [5f0c|vS(ܲdv޴O<c+y^Чm-&rRmA-+oYfPYP UB-wԉ/v4qA=Qol[ ޟ %+5뛔^5GQ-qߺ.eDzP3R^f膑py0] &pMo w4D+Pt5 T`ղ~QxٮuH=iߜQ endstream endobj 3166 0 obj << /Type /ObjStm /N 100 /First 977 /Length 1934 /Filter /FlateDecode >> stream xZ[o[7~ׯc<䐜.il tI5׻dHʦlْ#Y!!9on,+YLĮ"]fT3r%G0$ŌvQDZ7iفsf3sbB9'H-`,DͬTBdc'!]ԉATủINGJQ@ng fDZKTf =Bjh؃.~X˔)dpv6Nswv溷+[⇹d3{-|ՠq:z7 [׽2w0‹h}cG8Aw>M>NFEnh>~=]R X Ƹ`\h٩ +}$.w27]buFN5Wɔl A6 e?0to vXűaнyz4m~ 1+4s&'O_Y̿mEWA=!r$/}kGG BH,(m: *C u[a ݛj~;wﺟο?_}d?8O7_>AuPQ 3ģV;P;q௚ 7wG̺ c%}x#`*΍.&]Z]9>8mz)~ibYp:hQ;鵗Of=D쐒6R)C֙?r#k?vs9f_\hѲ. _G/>XP%B;hv5:^M9't̆r#$.箴0,f>7U M?A[*_~Az7T=M?hNڧp'qgIUOntVwa-á#=Y1'xi$ endstream endobj 3289 0 obj << /Length 1281 /Filter /FlateDecode >> stream xڽW[s4~ϯ<$Ш+aX0RJQl1KRŎa ;DttdvO\]8pv'$4vnS~mQBn<1hӒG )u"K@zAH/(,9tqq1_=YÅ|K.}:ylW f"$R֤7M3g n6<Y7_ QwgF͢P)<1Pyeڌ]U-j9vCT%AeLnؗЪK)8X}Ε<_aL}Rj;)oDDNUvgVnn59.>_/O,/^l,nut;4s^LgJG!duFNmy%\bu> Ze~KJ {͠;ĪTq*7ލ{Iq )y! UDwuӪ<%-l-y$9Eb^x^ۃf(7 @8I)+4_f8pXI3<b9-k&n''CEA$;)l>Dk񠉆yL~04^TG*tyu tQ#LyG8}>愐o Wfd}Xos9{V?yrP ϳɷRоG*B̀]Ut(d(͉亴%# 5$ths?\ߟ!ʂx"Q m*XG yNД!Am()ßlzzՆ3PfN,ە,xNbz@q@H-=w7LZCKvRRj'@Y7c1pzQ`,0/ç9S@B]OuL$`vn3}cղ*j]d57[ghC]ix oyF1f0ݚ@RzPb7J_|_OO5F}V֍fRM,:#^ϫj͸t$,juĜM3nQO n ȳq+ѭ6 K^( Zd^dSz jɍ~Qku6b́c Jd#Wl̊]?fl ^dmS lɾ1PmxsH__]{jPu~SspC<" endstream endobj 3302 0 obj << /Length 1580 /Filter /FlateDecode >> stream xWKoFW4 mR)+$h)q%H}ѤLٲ[a;;ݝ>L~O^ȋQ<1b6knJJPL)G)S1`-}0:Or5=! {f{w#G^n=, 99n&M p p N& %q{_$l9 8 OeuVgT6Amկ?岩QD_oHd8vMV9q*"n_RhJ3ZHA,)A V ̸̓6Ub4B:1>3{p"d-Ljb KxLΘ mSfDp)ofVY.0rg466=-V͙XdnT8,YS?8u&mQȼR6E/7WV{+EYK!, ^S$0_BIS?gQDD @#(.eKH{r33DbxC:..FI~1cXMR%KUnXYUeʍ4 (+Ip/+4!d_2DE3 (b02j9qSe="8}օ-m-g rA5u(Y7sh 0 C_n?ϠS(#K\Y԰A6zA"~iL m$fZۦe;\ !Ƚ mS!"+l}%>d] 5z`@v "~z:D.]=M( o3_ N/S*hlT; fbQNMbQI>ԣrF|qrU:\+j)cRU(5o&?5$UB:dոYcT6Q[:i_]r:_ecmG͎H@bv"$TÇP htQZBӄXin'-Y~t)n],~-7v9v5D\aҌU2mjz(um0B3\5ݪINWU;rG^yUW 5] ] uURvMmf U7J } {:-q{ҎUA4'(8I ςG=kI5[k ը{ꏺw']ae *[@_Ue8~B<$޳ D*sA(Y! `6}a1wa'|8l׷ӲeC3;g'{qqƹj>Q endstream endobj 3316 0 obj << /Length 2453 /Filter /FlateDecode >> stream xڝX/,^V++\ܴHdՕEWq9$E}p!]VtÛ<]YW1$IU$OնY}~??6IQ@͜diQ?IؘY ~BBq9#qðIa_'m]u{Vn"%_y8:fR5MZѻ/:΢_]WJ 258qO7)H ܃,C%lgԪ?Ҍ1DUnHbw7v,%%)`εȔグ;!ZP4=ܯߋTiG$LHgNu76oQ=ckŋKGJReJ55Ѩu96|x֎G,pGd9ծs,NH{z)/挀>DI=^_(>ε(lb Za ڭ1в 4U NƜtT'Hs#a4, B\5t'2 NuWWKp\#LEnI5/:r^"W0sw߷}b`Nf &ШK8K5<5Bpq*;BcqY[-A6%\V*u{x\.QЏQ@f^$P8 endstream endobj 3329 0 obj << /Length 1341 /Filter /FlateDecode >> stream xWMs6Wp샩L}hR'39SMq IH(%@$Ql'=X\5vVvM^NfoPst(c'!A'qxD)`WjEGK Ul`g7z~/}ΖeU`A%q-|,_V˩c.zAw8>&^M]].yR*az僀H]ҟqZkߴ[WbȠP#(LSuׂ7m^M $EdQo$\H+m?M˴DIץ8e) AUqٲnܪ,XK%+~Qw4"{\tY -d "ԋ0U7Zz4yjW֑&.Y/v)W "vG@K eU-,Ҿ@j|&-?:.G>6z5r-G+w4F*.BiaLo'NHOtdr>L>}N8 ԹU7N% UE䷓Џ C愓!qL=>Mg3䷠Zz&8__8EA# =%#Q@XdƖ_Z3[/$ C=zt*b^<!AmfvJ" F~%&7IkA6f9 H_GCe WHyܬrg(ݏ]PMH&'#΋{OfCiG1:  V_> NgKV7!hm>SR!vB%q>19:Jƌx/ UX Ŵ@O-[0Bɿ#KG"$|r%~PTV\*ڮ8'P94Q|pdhH㠨f~&[:N EN䙤Pl@s揼`ncFaHNM endstream endobj 3346 0 obj << /Length 2231 /Filter /FlateDecode >> stream xZ[~?pXk}Hl"SS D歹%WwCQM{ZyDCjo.6_p˧G&*NaPѢo[>+ttmZɫT c1#M4q3ء.=T($h-€R`iZ](tCk ]Ӊ;oM><~c vd$S$e) ߡBo|F* F*ʞ?=ɗ#ɫCh$UH]_^?<ò}fUe,X݃pOUlO$||t3;E$pE i6yD3#@D껵 t>2L.ԥԁU!4Si"6 #4Jb*a\LLJZտ_4"ep[$/eBoP4ֺ`wkN+6$Xܠ{(OU`u֗w2\}jF-{Z8L@nԝ*@[M.M:;T w}VY[x7 מJ Sa|IL4<) `;bZuvM|:R2 *B#Y1( gsIq7~besYgb]nd(G.ʾlla2jXR1*Z]>^fMPMxiBHoz4&ML2anL{ږ_허_—3GC]^P/PA;rɥR`E8-, }rw_"qes|'TKD,4{o)`j>mt4{qPP!;k:/4nUZ -Min`kX숱%;2Kv̀So], ^ Enk"zҘ%6f#W5e!‡/P+Z̓VOyӶzz4mI͑~c#W) 01\D5UӀahRisoXԘ<3/M- ^hLĭ 0L>g: a#;c,6̡t`n."]}$dr|mYRN5^^ŪA>c JpT ¹fd"l@nbX_آ# G}]vGVP6ֽ wC}[R*%Bbd<4$]  ,G }};{c2D6p@95>60}B#xtL\2Q8'ne >nf;C1)[ՄJ`)|nh74îڍixKbK-E@Ӑ2jR0f"vMWCY7k5M`UƎJZMg aí1q㯇cs|G緝MDFm 9굤qtOtB.Nt@JD*y6,Yk@I<\LLa7b;u%/0 ;UeAo IףFakO'ݶMY[ra? nK-0խC5г|-uU?S j\O9ȔY=?G+2ŭߊa> stream xڭYY~_a̓syRHl`S&dC[EUn/C_{t &^.5 0WzB<; !Rϗd,,*yT$=QuD,b;JPHL1d] 蟄I<BeLfhWTR%#msZ`P+NAH\,o354u'>PPq٢}7}}&)!U 43;%Gi9]NHaIwSI_| ךM?Gѵ]չ&Ԥs+q<lI^P%)f8*0t9 v rL:t4DTCc M07)pOZQSk2]b鸝CaKGi0VtԈЗk[1 u-e .'I*y)ھD]nX#^C:% QQx=s39(\tlAy~ 7N/}ϼ'L.{K@|Ž%a0hD<9|Fʠe :v4~*Žӓ8iwX¡qAvuS;DZ#(n8EG^2>EE3,l)Wk)(gup2GpφbaڲTq&![*Rg`27DUasq}szzL%AZ^B'5xudơJQ_sqҙ7.8}O3:PƸ C!͏yVˆzWz'oFJI_ϴ۶{qs!/§p 91Xi!STjx45,ͻ^-iz[ \ yNߨY = Mq-]h2|qЬHsv-fNƧG5>H[QxE% wXrEV~Ř 1 ɸ|w6dP#A * O7*डK b GGN&7,gY ˓>Li%Ĕ4'@?+T)o?baZ8 ¯,`Z䃵d Y7O%TkPW4e\n}@cY:& x*)|ܪK|>ui@-f6Ժ-{u'Le#5z8\$vG/ 2y\S.=_7Iw0G{/#FnE2gS<7맞^o*BzHjV@$߲H&S{(@;Ks 鰔2:w><{cT5X:Q>3Pi!Qw2df| J[ŖQ@XvPJblgl'4h0Lu~5aXHMk(I' H'}ֆYM ?N!|?ij9")QE5̣Y6=uhhI⾂fxLepXAr _LYDFΩle(n3wbSu}3ZT܍Yp02Ss10.*PRvs>$s/>qЯ QssuߴpLLW%m*– "~%$HO\ty2)~,Aoi3 \z1l. Wٷ2DpO4ҁ?eMffVl{T˾YLcxBTϧ2iH~^\s8L:WlQ: Āo,x= ŗ@{AGGt)&[r`v {xKC/ٺ}B Ek ӓT{j{jͤ"]βyBfY]j"zн˜7gC_M負]9D ~x_R` endstream endobj 3378 0 obj << /Length 3137 /Filter /FlateDecode >> stream xڥYYs~ׯ`b.86e9r" r!a-_I"ڇ fzz>ܞ'o_xjsXā NnN mPJjwWuk!Y͹Ft0[L^|Z[V!lҴCZkCgEZ]y͛옧-alWd4%>鎧-Sow)Зֻ]Y/i`]8jk Ə:=&UҤtWV/p.UMŘJZT#bysGWq:y?P֗MH:5UlTI[: 0` 2*UNQ!їM{H#A^n!\@(P@(ăJI\iE GKv f]?-goQE}%Q26@\P$%zViZ7/^2PF:K"_VwlyA :o #rO*KmW)؉m*GXb K]MۜaPU~zt99w}R;u">aMc!r1L"iVi`Aie4ˊnRz3 I0Qv[i l9nSqLW|t)A=}αel1)<_.gVڞn ['xpS!G1HFH!! L|Uq~r/t!d !&B.\rቂדּmRA$Ra,IGqt;:X9:z" !kю' {HڶD) U=ޒR2\ב-Pm R9u"M9E0X3jɌq| vм`]Pso$K}aس2*񽥒 CwVŎWT#%YP=[)Tm% ʺÿi(NUŽz!_ez^>"NR m8+qSDZ4DB*=uڝ\ 'A')zrL09/ig}ńc^)E)4Dѵ!AO*lv4KǍ3Fa) gެ4ifʺ`n9I]bu`M~#eݧK=Hl۴)z2:}C{/QNuzȺBF0?\{`qVF~ʖV}Yu{D _}G%e~T޿Vto6]Jb%OroIHDȈ+q$B®/޾:ocfp)7"3}M02Ez:cV/r%ݺ?&'Q z Q%>`rT=d/&s($/]PA:Pq_gKxһt;)&%zv^nve+JDѬج9TǀX9&Bʗ>GޜŮr}*qɛ(qyAoI0CWe[Q .q]w&b @z Uzr?$1sL}>/T*0XPprhuf+3 n>^K6(]`Pt%4!0oݷ9CUzgIPP3& "!Wtg_6٧"-wKa}E}ϻZ8uY~#Ɗ5|5{< j*b5,;&D"iJq|坿Cgg4lA@8*$F7qTZ)c вROeH>3=ӶŹ~4I q3PS{*\x,-JӚV T)Kae4-=[}*Y/7ҧ'K@.)Bg )SU m[9bH,^bf1>^pPӵEw.pEQ8_()}!^xN4>'/46?^rZ^VQo(=P }c,dҵ~5ɝt)a? _LܗQ]-B2fYAї,-<7v2}ˊܹ% pGC7e_SlzîÑ[vիimv endstream endobj 3285 0 obj << /Type /ObjStm /N 100 /First 982 /Length 2169 /Filter /FlateDecode >> stream xZs~_!8`Q36tܙ=0aE9䩶~ QtJL. b[EVF9^YD!*6^KE'9Ɋ*(:Y%+RRٹadeg,a2wLYSY& )e;"dG IaMTb9" ` c8HɋĊnv19C"oˀIu( FFT$aC (;HPb2'A~H^A- >bH^1Bb(#:HQ,X8L \$d[&񐼬5sˈ<8,eR<8IFx1~XF8fY!xSD!,S 1f1 u(Y` 0HN_< bW!oFMcӈ{&%n1H8Yf%2%M \c-Dh%*qH)Bgz8)`)/c,grvtr2>|]֪z4vT]Ԗ?NQbuQ>|s^zі/}=iGk:$YŹ hZLUY|XeW檭+w#|Ak= ]Ml8 Ag$}"ƀưN$15d.m8I\7{QGDc l\V}D^ޫ_Y;Ɓ"ɿ*[cv F?m~hڂT2)d{M.|]V>A(#HYia;mȐ6O7wM=ӽ)^m5_mi3)mpxr.l!;! CFݰ&/d`F~Su3G=R)0qL_ y@%ֲ&x 1y@ &5P/˺] {k)>JFG4e{ʏS{]TO}t eق?S[:l36J`)|$i>=h1ڄƋn}4۸a[GG?ā8yߵ;c&c&c&c&>tB0B=E#K #'wb`iv|~6FPt . M0is9I=< rr0 ᑋMӳb g4;3<``0o^A=cHcO_0 ^e8)ı\MVϦC_YGڠ:i{Vkib܎j<_'HY\c9fpGTʻ~9w%~K/{F#oT7kWU \BjFjFtB;ĮĮĮD?;Nl-0>.Y^{4pƳY=`F:^~||U&u[ByC _8^.g_eHA6l$`d0r;r\TX]2>ѯxaa/: InaS/ ޘy7hFoL$d_mHO|@$(es(_ IXy6_d3<+ endstream endobj 3401 0 obj << /Length 1220 /Filter /FlateDecode >> stream xV=o8+%TpqCRlT{[DD'o(uWWpff [غ]ȊQ8\[6+m̬Njߖ_8CR]e)5GX;a̜9!l͎6_]׊0"[vHۺ|'))mAU˂JY%"oLLuM 2V[*UBD3@eD(?f62KJmMR;eFVhW)Ko޿Z9M$bcÚ s*匮4%hq""]y7cxa{2IxB#Au3˶8oe(/َfފL<锬^tQB0P Mf9>A^(} >AƑڪz.ȅ}[x允;/lőm( 2H0%D 'P;VQR+YpߖzjGtZP|# >b{\Tj2>K!Jۣ3ŎP[mj%nj~AYvj$vr4JKLۭ5jurb M( ǔ+ԾNrԦ;i9[2A8eʻt~a2κ5)TyxgdARXт*Jy25϶:3dfu`$KȪsˈ?W{%t=p2ېt@%Ʈ1J^S%e`XhCRυ8 caYvi$4*#]'=Qx3Lu9oǀ^AiҍH7=bSA i$I%c"ɘW6^#w塒l3|1O> stream xYKo6ϯhn`&)9xw.f6 DnaRGd_U,R/vwc |hDW__>\)XIzxZ ΙU(S^zVZׇa^h+1p3;~"ǖxBاk#Rltta%2+F$,`/~_ PBLFS0L)rx)5x]^O`p櫟>(/~M卜/IV޼c]m%Ϥ RrFc~aIYAv%TQ~'%2üJ==Qw)l ͤ 5k90 5&Nz0Y~}~O fH#֤X?XYPOL?m C%Pb5o3c XhM:Kdd~K`Ni@2/M~wE>F߾lrH/)fLuP,s[x@Jm=D+%\qhEDm(b P>`n.!Z"¾; bY3kE R^b_P[He.tŕUhZm "D=kN8+QTHPue;݉LڮR] 3(eB~ NAhB;Thf5]*O`yC+a{ϼ,AYl' '/P:08%~Q4[?" QT#†-.f!$)AE5 Qs|(·Ys~ABOQć6H.+MF7z4i^ 2A8 ȏ ,vWWˀ:Ɋ')wg$39$,3D,$Y<"} TIZ}>^6 0Y C ?`9f«&9@1cRN)'!)0 :LVYN v m.hy8mMuMId:vw8[CGCMJvɘ¡]w2Qʄf??9X&f8#le8BϋL`O0iZeV;h)`ݖkIMkj@SSiSܲTblX=HRgv%{s3 K[3TF`ANr}ȿRt@>a cACXB7K=$CߟGN'ߝ~?E\ycuʡN%fwhpPե f qT3W^$ZWD$Jq Üi[|zՄ%t秅 f;ͧ/uݐ]<>|/{r0 endstream endobj 3423 0 obj << /Length 2274 /Filter /FlateDecode >> stream xڭYmo8_a@Hz@zHwo'KM,47!eQUIZg.ۋn.."gy“f> dK|qS-x/s7I4> ҃}~#/|^ Us=wSrfOtKgW(+U'-OFvя]wK?Vzl %{%˞zF6}W)Id}UٛlvUV\Ǥ$yĞUyyb7T= rߵt}v8*Q*c;Z4<֊}at,c`? ų/hh,rs82jvez1î8Xp̯!8YFVlDG<<)eOߣ>4Z1LbZgpS;Ortָ?laPۋşzNt #מݓ+Α;Mu}1$KѳIjBo$YUO~x6ǽd ` (:V|P B'PItXЋx8^ip-'5 oB`i7F^ bШ0ozgWDRi=k7$MAB( _eKR4&` M `>V.nAoL,s JL0io+uψ^ -ͤ(1v2\M4XD؜(Hh/Q!cnCK%O Ô' 2BخidBddle҈ȱaBҬ63UqXZU;űW^*#*,8ln u]ʢy5ލ1I:|S3Z{jgA S]'CT~Wš.J98=g*Ym/;,5mS|\OQO{TPQZh0f L?M=:RXhQ @oB1ZuX!߼~=S~:.mb''1~O/ag{w/ e LS:'daJmk|[CxMzV(G7j 9=cQ2<Șu_<7'N +œgl)!6sWU4\#V)C[0dD!!З\bR@L[\ Eik3k`.PJzoFyVPf, /Fꄝ׋d,d ףYN*5B(o!E<} O9Kd|0{Y5y߳An iW[d&-nԍ h_=G%C);biܟ& ߒн^<={s=H|kA%]јZ60<7}fݏmG@WҨrꔻ@R§'4\# R(r 1t!MB [vo!U\Mj %O{iы# gKps} F | c:$h]e2ʹУ\0z}. c?ȿ#~n\}~_\(~ endstream endobj 3429 0 obj << /Length 3630 /Filter /FlateDecode >> stream xڵZo_!'TG$- H :HEVwfgH.y+K P̞_ͫ7M|GQf!tl.R)#Mw,x?޼O2^&Jfs*HJ[(ɳJ#Md/ei;Ok}8;ڢ?u>,QrlslK[bԯ1zChVFF)؟sM):{L7m3TE]?R"K>#glKlv70&n~v]g- q`-.OZf <7#fDGͧ$LIKڴq:ݡpb /ŧI%F-OF[ զx6;ÃMHRGB/jMLkt:qi/rAccM]aOUmUW!FW!> ,[2^k%7iصG uoŮk{nnq@B jO]מy[Ꞅ&(Yvgwh۞;o-XnĺUFlN=WsGo? Xcbh4q$N@` b J P ^Q5 ,H3΢mOXQn7,o ņd(P4g砞l:74|nqv- vӅ)eKơc* -c]6zd2J̼)u$5OI}j 0+-;C,< ߾Ó^sfťrbʞ>P'`'%}}:Q"K!6unŃC;8A_sr̈́{x{jp@-CZ:I6`XA*`A*Hm ةcb`T7 0lܹplmw)͝79tqU("bu "PƘ9'M/ˏVmRr x&"7K0>(7 J|jHg`9 3x!W[Kc;N:;P^w?ۦ'VGw\<R'9 9_x~3yLAv@es 4 Qe ց4nKO(su,7"Ǔ(>8xBz_3ں Y3vU^GSU)l\g haz8 cV2`;˜sa>'e?9zP l-K7$}JtZo @oAO0x~ƹl!s?5eOgq $K/%xw/ q#w?rmdz(pr@ɖFD@0<8x>lnUԏSW}ۡ(09<#w/&I;wJN|^dBD*Kj. ,=k~"4$Y'3YG_'$@\t'| 2}pqdz Slq ^*i( SXBe>&FSZIMph~WҹWfp t|ݖ; J1CP8-B?`>Ywu)#s~$и%.}KVz8X bzsH?<[j;SAeYHK!w\-0di$ 8[!ȘEڏxaniK%lu12%gSmu'O8+C&C"Jķbj |~idx}ȏ(24:'_ZJ!Vq7Rom]|H8weZ(UᰮtZ%vh퉇C(prt2{ 7H2Fmv=BODA;0\!=";vhIuC vdں&.9~a_ !ЉSS|WKRiaWpi7 ZZ@oţ8E&⾰cWgC }%^$cnCjJ`J;/~"*xꚾĮkdK&2WFBO g"gJR #7\B~3 @;\IRü宱1 ν*ZP:h vU2Xo_Z:dؖjrjnjǻs~H8c.;J2x#&J2s,SCS%ӁR?U/xjBi@ >ti'$*M]=Z+v]\ :d_yH5בWUmgWX17"Z O7PǩA//OF3mw~ȖdV8bXPւv,N=@ѕ|S Qv-5?}jq$i_ .7WX,f(>t`FGΝTs7S0f:Ks|p`Pg+V}RecՁ ]2RtςH[LˑaX=hHw Nҧr$Jql$uH< >/.s;B$UhBGsՑ+Jq,h“Իꉊj זҽI.Io-XĄX+3t #ȧB3 -JFL0qR '̘=U PFFJ`|ve&I!?TAWEiт_k\i[Q5SP!hpJϥO+ku sjagL_`/1# 3(tW"_`M(cddL>)N>/J H2IvFM?` ; 'IX}xY #]UªHl@%b*%ts=ĉo`]I$s?yzjXbrS\1 H?23db TiOVSAɻf_•UQ /Aԉݯ(\cd/4DI^b9.hW.Hj)PVF_-,Q;~QI(O+@'^iURxvTBz?i1Bʅn,66cڇʿb}nQPNDh!}X% %:tCQ5D9*r@ߜbk,95Nƾ"J+MwD6$_J%58a>lZ.g\/J8Oڔ@7pPu>oy,CK,`iB/ɨ.[}'YZH]7% 6xW`l׭-38eڏUr55ۻٺqW'="-[[Sx}}$} endstream endobj 3437 0 obj << /Length 3388 /Filter /FlateDecode >> stream xڭZێ}߯h%j`[+.688H =#[-utS*R`*bx5曻7>PE!PqpW$*9>rUdQNå {x/̖TT)@(HK()QQpw,@=gPN0,$:b9pUǓ#YtU;M"o' 6Fa-4mOͪc(MvѾ깚tJ c̏B)2_EK5$FT&=T:HE:ӫ̺+ZG͔5Kf!,Ut1FgFHY`?v͖7#iXn6ƌ@#ZTLY6}Kotdp3utLU "0ްq)~l$Ҧ,׽ ;OM5GIAqi8 T>S9o*B)$;%N޶?p0C|gUԄ:o[ߓA! Lƞ$ aP&lPǫ>*T`[Y,ONZ~^bKi8W7~aDYnB>?A{)`UuW3*/0ya5O3n F=mOsEz]cY=%2 #lI\0kыI|nGY ī0x[ivspj`}g}b fqa޵_Ve U `ASH-@4(F|D.*ъmRN ou=^!k6x-nRHD '8L朩C21D-}sc7_B |x ;Giɲi`v{a#.pdXH`nQ @(Zr'Na~Q'dt[{؀a $arRp̲=P=RlNߕ( QqVNV)! |<ø,|#U7́q(2j+-#FՁ Mf gW#(1)X:#:p9lD%9XA.PЕ>S$񨂧koFBFܽ1 YFaT}BS>΄d-isfF.O~4C?`tz Gp,iCS޷9s K9UܦojB:;g uyNIa!FY1x99\N> /M)n8-/;Cc3 (cu{KF8'nq$3= "#u6ІnbgCӓ Ewف }'ր*^w8M@i‘WAB7daĕj \QOBb*<46=^n&D<2sBl0|(e46ٿ ˕yiBtein vlOz9%e:KBƟRqyWNkdIZ/79 *%PgsVZ$1Q9z&RUM MƎX!D5/B!|9o9F /8٪oSkAJؕ+ij㺶CV҂b23ZؐwEߩ~S%+Q6r߃Xxz;JrBјz ʩo ; ,G $bX_l!F[&Gxl\-yH8 ,4=]R}}KM-VꙛqNm뱶*S7ZW1O6w*y@,YllX;1jXJCsO l;j\V:trsr| o=^plȦ0/dۼguE|#OI" `-qk]e]˂8m;nnB!P:i(. 56ё/ 'eMxQhPF4`#H1 8G<; yr="H|qt[X'K}ZMb]lMDGP< OEJX9{x?jθ[fq ʝku≖RLNkvBU8L %O#, Gw+>C|gxfU]`^lێ_dP8&wŦ?Wɓt) Cnۂbc]aV}f^itG@0!-L~C9B7D%WKiք;a?LE5ĻObY(5!.OjI1,s-mcշYV?=ew8 x~dNWzi^%1 0fs;hKuf^Am22\>&kO ߿xWixgSȺJѸ#K|iS^@GrDA.x(=[:b(L"~ :P;߄LR.C FvjFVaE`XMݽ̈ endstream endobj 3445 0 obj << /Length 1892 /Filter /FlateDecode >> stream xY[o6~ϯ0$5#XeX,sdNP!QI_Ë.VjCh:w̝;y:9{xE f .^0 1FftSf1Y6g[[OQJSĵ4ȏ %j%E^8\nN|'53?ecG؉ qԢ9ּu.+3fyU742b! h{ };W,hZImX$%K|AYv->8B]6b4Ұ]c%{,`ru10ĩ+)m_mY7;ސ RnZ7V6f F Zs*P}SV4P)eRgʟm _aeB>i-kAXifm Ky_Ei2)2V)3FXZ$Sبҍ"+@HZJfxd`؁jR"jm ΣY%yjdR[~v]pKL) :D$fM4.-2VEǰ'@3}$l|Tlɋ`m'K9n.6l Gb}֝u{C.'/)3fx.UgZJ7E :tUk <%W]")T9OeJqM:ořq::(Yθݨ=S+ {E1rʘ)Ӌy^9( #bonu_VU3C;3zњ ok"uIxQ%cs3[9un¿Oit'Nx>8Ů_ SBMxg.O[>e:%l+|$ijR EpFOHVڗc~@DzfKp.nˆn≴ۭlinbi;&{ jBoUfuR)$O{|MM t]n7>m3?Npl/> Ąt{9E=Ţ^`DȀ/ǚ>z̀0T- GkĢqX6%iT}h˧K)?(z6w_YAN5ԂhA,*ζ N\Gm9rLO.IĶMbf`I~U\jک~7(nΉ07py Ҕkƛ`lexkyARWIwv0;@P%P{rw5aI uz\efq0lK`YdI>" _okh'!'ie`+BᐷW!e?Qfm-zݻͭ0ض=>UuHCDqm#o4G<{݇. ^ O5<[etwJbu y1 endstream endobj 3477 0 obj << /Length 3811 /Filter /FlateDecode >> stream x[K6WL]"ēV!x򨱓!%qFL$R!);_h 9F*\5hnU|ݫۏ*ec&J8gFWW-VWwF $f:T2po'WH$)wU= KK"K,aeG.ϚC߼kzÿs :&RtXDpضA"O?hEs!jgk\9iK_4 TkڼJp0ZωY[%itnRX21k?o4UNjZAeK݇r m̷lE ~(C0Tv( ?P'虓˔Y=-4IR 0"5\Ŧx$|z9cr1"(HY,F2tK449coVgS, $I+l}6cyFf(>\>஄ͼ]e h[;X8l%u qCzCF|o?zkH:PhO~ ~tK"\BOo8ZL| .4á\y*!r.⼲v^ƙtS&0 qs{)zǕ4e/ f'o4y+Zg[HM с\GOqx4)AL5wB1g *#!nd ~N]0qLA8u_uH x=)@}Gs8|"bte-EDR({UcP-&(E%}FLXof=l8yXf#JSa8R_T~A]KΙLF&hNV_h>%A:`.H IxCu$tI8Ah4-SNQ_J l:L3:rH-, )wĭc&vo\=NA`PA}a/%>ҭi.]Q.Oi*U\id/R+NhZS/ tMp rҟX@!=%⡮v0L&){-\A4/cT,~l KWmoC VKŵCI}*l|$*yҒH vv0M4!!6̕&$HZOBR<\OٴyCgb=p+}dPB1Y>fN@t骬p: ,L{f M LBK 3u}foIG'q^DZ{rDB,#Iw:}5 i1^B iW[#b8 Dߛ|#_IJǭu2K4$[@M:#xqu1AmGQۻ>YPt<^#{~:FG*&trA-_MΛ4K6ĎU쿒QBVՅРzr\vrP}YKQEuʐ.Uy\;:y5BnʌFC`p`MPຣX5v6=+GQmg @?6$hח B~y ѥ;CxcCt=&?1bV V`ZˉF3m&Yk(#EX`5QUuH'̆H|Un&b;r"zw+PqtuAj4I$, fHōf}UE<1s6Xp_j TB0bgjMYe] ͛ u}QemQC@yV6wu!\s6 myx*_ )`v,dN K~3PDy%&Y4%V3q@,7M .#$1S!J`ɿO+tr7D JhF$<_1cmVDU9wYYln.裄?]۞^`ae/Rx O7=^"QXn-ZVXOոZGyG=,8~$Y0Ő?{O1$XcPc^:P|b$"$Lqiaߒt746=XICS^ZZ )OGBXtU~Py%)uU;0% O'8@tEW8&3z 0J DM[*< -$  VEGL țjQ endstream endobj 3511 0 obj << /Length 3662 /Filter /FlateDecode >> stream xڝZ[o6~ϯ02aE^ $Ema7mnw]Dh{5c;0 rx|Bg3o^|62">;ς0>K8gqg^m_oFd|,2X͌Q^vod&bl#h hRԝn˪lowl/\V`Wp_9H8 Sᎇ, y?i<4U?8bR])3ivb3ʈq|gQDG^`x}lx߽/*Wu'N7{dGm!vefIP_$ÀGoOs{\#pO?CsG|,Jb"ט'  ՅH O,va!݃*@5M`;o/MvHt\1v[fVvR j"q; iBeY0'5L$u#keѐ$'(F|C Ŷ@ 0yE=}җV'z;\w?|?_%< d~qTBՎOvd؀\_d3R˪"! g,ǔ+\|:?*pڷvCjXwDj,'RǴE߫-h2oB;V8X sZ,K'ٌ#Nt]# G|!1y!! >57,̢Mbyt el.g/(J7vS֎wFwM'+68=P?/89'D`t6ڇ.L[fo͙VW42=v@L$΄.ڈd qOY/D؛S hp5胲Bvܩe A- 焬!ؕxtOovm8(@S<S3z/<$vGxG3! !֐$XZ1sbQ(CxhV@΍Y!RI 遟teFLDL uwL !|~~PC,Ə o@op/?zB(uiۢT@QWa  1d2dqϒ㉪ԝj٩S"LAF @HC}Tۖ>"(Q8QuC(㘅۸C9zFp=s,~:ѳ/ԝmS1[j1 b1 Ȗ,$Lwݐ%it'k۱ |A ARW遮]h+Ze7'I<Sy{O4eNXdːe N$rhӗTr'豤`/bFXeWtT7/p8q# a S2~"3E b飋LG>7WU C B(|G3 D_}Z+I(2 $k:卹 9B=}`q:Gb(|Lhrf뮯*%LzkQg';5}4;; w.#%&4$k2([0i]=]Nu`)5OvQ _Xϖchz_V#?d &dG0]O"2yn'h̶< 2?*9WcO q& 7JNBd*AP/Py{bW7pXzCH 4. :oyptc ~]Z& 0_EⓜEyNx2q5uH*`;;{Y׮ETL{Ma歂(J;9@<߆1!s #ݓ\+ѶG@~@ca>>et2d6}n3>DO]ip~dʴN˚H; t cuWc Ÿ^ VvVlҀ79U2  #ƓkRm1o#-p^elgK|ltF7ʭ&7W5w`JMNX07|-¤ }6`9x@!v~O&D;XN(ڴU{> 0UgʶZG(^{ unșt!tX5I:zW˺=Hʍa,C:9ن}AvJ/#Ô\4FÈ(0Nwolm{WnwQ+ HSi{7$>]ij̘5U,tԈ]E} 'TF`68ECf5NT|6']C²U7 QBj;@iMDO`ԕon^>` endstream endobj 3384 0 obj << /Type /ObjStm /N 100 /First 1000 /Length 2657 /Filter /FlateDecode >> stream xZێ[ }c"HI@p-Ay8d_M5L@eimEJ1fqŘ Tq10F]dO!Ծƨ+}]M|8 9G)B;babUvd (j2 dǁShCPN1 " gH-Z!T{搜s{Ww/oބm5jsS&jvbvX5c PRCj UL&%'`$Hb`T SVhbprР8|!*Fos_T5bt}Vs$1T SLbZ k$rZ/5oejRܔ"$P $@t ri:*kHYrٰFj 1)MR\ T ͫ!gJ~FVSӮ&evmZ`k-g5Sװ{'{U 3=d{PMX(JQPڢ T(׀nY]sPlf&XDwyBE:ydԍ~],ѻM{rq ?2d>0O /胹)UD{޹џnŸ/fdW_NrS2VyF?NoΛ9y܋)6_Mk|hckn ~\lګy_%nd}@D~apvF7|fBnk7z?qWnwd0L ۥIj2]o\oӏ˯\[f¯-2fk,"i}'..ԝPC ܅؅ԅ߽S͑jg$V.{ r>݌ϖ+x_'_ћV6xK6n&<$w3OӊiE +vBW;aN!DxEQOAf‘CO:m+6)y Vxy e- O^@p%#x8 ݁x{LV{0̣)=޺8/@2՚caXD@*j!Z+Cpz+Wz@o@j!,[[؜/bDqPAN<]yi5н2HLR4 }57z0LŐͷ[[㜍=*4_A+c G[4֨=dX7?3d:d8`$ukseDiϬ}f3>s3A S\S1FN}N]xV`X_@@%atd\71ʀhYӇXZC[`u"[Cb6?_ $j1j'*D\L?ƛObzTb! Rh7pu?|por.Y#tvmIĺb=ʋ $ּ*y0ٕ,B$,8R9R#F %CuKav0N=0.= ;h ̰UqSsg^.Qlz(=0NVGn ^u`uF&#Y jD9 H1`8ZZ#Jʃ >ˀ@^#;ށh͙ R z/zH!!> stream xYYs~ׯA5[q qE˖b+.99LK>Zd!Ň4zz_wt_{ߝ;y"UJRr(%"V+Q"]VD\_+hԖ0~c.ʽP5ݠͫtj:/̪#צ;xꜨLi>M En`R)RjwR7 4våSw{pvkGKB:l!o[U]S8ŦJMx"] dPDAz![Bm]u 4kDh] 4` $3'aQ2z8.C㗟mF﨤91h<+BC_]M4/)#t [De}8\1Ab S<}ǹ<bÅqGG{5YՂИeۇKw7pvg9C~61w? z ݫFؘ$?ac_ލ=nIb’cxp@2c9q]hnQ>Eb}/ɓ7UN,<: ۊIF*sGn; r~J4 S}h݄_l[ta4YᩉDhdg1Q3G64eUr{tP/YgP)eWyyL͊E^zr VZ{f"}ܛJaƨ&9IC>c{L_fóx@@~N_?(d^&|)2h  e%Oې$$_/~ׄM*hIZE  r1'p Lw?d@.WfQh' ӟP:qtEtcN,ΆnY{B `1`PPB!  P$qDž[/{S'DjU[, MX́b Hx@ <9Hj0ٍKȃ㉸JuGKm1,|7as&wU{?pg uc(bKHap.iݠ ű K3"ܔLy f-Uwm/| J-IY7EҾ>Ug*Mw}FݺNSʭsF0z/"2kxuC~K _dv@:,.k z(%iF}sKSR{Hn:E!xԡG''d޸ b0sg=P . Gt8{EGU]m@g 6(8N}y NC㭙.m4u9ٿcs`U<r%Z7ղeڡԏ&󕜫WapVC㔲σӷ!g!w7] ;d9V4X#¡:x_J]eJĴzfTYOyն+NWן^Օ^ <߄yksbn[)1? S)$&  QΦc26H' |y¤ԛ9 PcRĦudʕ{Gψ9%V dƳA{~әh|kڥY* ٙ _X &I. xK}OG?K!wUS/)(vaSDž@딏jtN:cGN"g0T,3" 2Q.Rʉ BD6@He H`/^C۵çhB%azQը @VoC>MOd A Z&Abا=V4TF/V) g[x+,u1IQ[ Pp / kݡlݳՃ\W(v!|ixP(D:^@B)S;n#/No?pR1˜RoB!HE^XPJ!Z u:s?1eYW;ba gfkM< 9M@R >4\^lro>8'CeH\n`u ,\9pd4d @_j,q)Z46V^h4=Nf NXq%)cakD ҢďiQP=Ob9 O4Cĉ}8G*2:9M/ aG9Qwن@f3Ps|='|)&V4qj AcXlO|ihgͮ<0WAcGT[ z4`Z|zMTzA: ^A}y7 [_|ZM域 UW7<>͔xW]xT!ƉOqr祛^BRn1 % J ZLd3W-Dqc3qGDDI?3m НN6x2 2"˸e#y(3 X[A("x{)2 endstream endobj 3537 0 obj << /Length 1306 /Filter /FlateDecode >> stream xXKs6WhC >Ln{{IHB͇J~wDIɁx,v~ f4 k`Υ\q^ T71$l[t ߈F qc(4jjGW$ A|*ӷ%q,`Vv>34EɊ#_cge!%*MRo{-R)u(5du-o0dN ZtF$JPcE%[}r&Q%xE)+'pJܦY5LfuQ%i}x O_^4BMt/QU75FSbY 8WC>GV. U5櫫t-ٮUG( u5AU󃥏ܒ@%LSbFȅ a 7#4KSkc鑽FB$~^clm?26|-0 +gˠAGCX1ݫ@gM[sI Gk],xSv)z}hjmPeՔ7xv6+CvW5210{)Io rħS֬Y|հk5Z4-՘U_6jJܬLηh1, ZC~vĞgrQvv ,gj/jO1LՅ-i^gǗ2Pڝ ކu1t_Ѧ>z\~Y(V"'P<ءt5Z"ln.*B7A0.\KaWn V|yTvoܝ1jL^Tk'?}+Я%K;u?!*耎a D?ҝ)2 endstream endobj 3548 0 obj << /Length 1283 /Filter /FlateDecode >> stream xWKs6Wp48SܩN'qZ[99@$$a‡BB_R#=4%5vvޏ~.(Й-1~D,uM8 VMUQFvI@@!m4\ gNOO'nx.23[9J+rZrm.ZW"^pUR/ H6nIֳdM:ͻX7f(To뷍ѫC2uUΟ[n}~R9=1&Vk'Tj%ݝt(Y76e!,mŢ8C4 P $FQ~x-Ip *"o vf:ج?`4/T*mMqO^FG^py/_"Xh̜fkG>9snFuش q H ⡘e(w =@x|'Jd\ߚIVezy?@>tpBс^"bLMI%׺Sy$0ꗖ&.%XfSF7b1R=gi5!m`=5HTܮ 1p.!3aLEjp.Z#5m_ٵRq TL`Ö7FZ oE\dӽl@G*ӍxT_ĜjG8`! o07) 'R~"i{+򲲖pl tƮD-ڝ:ȦoE QBszߢXSӚxVH:ftJnnͩnN9x l٬mk4Xg|ފy-Ի{i:%g^{[9=)wUA*B;Nd8w^M{ ڇ`?uOy5/79>8.2Z@MH075.il;L!OFq $88N6 X$EHXh#}L,e:@aL qhqm@:n i4I;2)LybuyxMxqϢ{??&H t 7G_ ka@m?6{/.Epp.^J/0 |V"Ox endstream endobj 3564 0 obj << /Length 2275 /Filter /FlateDecode >> stream xZKܸW4|2IQuLv<<-FbO &z["Ǩgg d94U,R>a޼{.2%ETH{]r>'zg*J z"P swx6;1 .՛ReZtC`ll? 9(Ky|:1t΢9&šڐmw4MQL%n"4ڜjAG_ro#oJY .ջ#% YQx1͐U"aDn"0F\盾9bm^46d 1ƥ J3UG)1!CCE 321#啘>3iՠQx>h$Q-\G ty,l>#b:y084&c#0,E-8%y%+B08[? {"gXGlpDۈco&ƓxI!|y'lb/gJ~)MLK--n-1n2YRh<t}b7=RK/P 吂s@'6V_#)7F*f 3 ^r΀hlV–ieZqWGbħV2b_YؙU./['z]у+K¿Tܸw[ yןmW!IG]:w2Z*ԃo?|xq"R20a3NM:SbFW?Rw K81k)"SHf+Ytߖ%L[|i%ީL_2J| o@QY0Oz#^+틾G2kNZYUD4Mn_BE)l%]5`^  XQЂ_KVNٶ!QFˤW uv˭ޅlmc*L|(3^x8${PKMu?wd4K;6Rm \ /zjS)-~<[ ) 5X6'+8>)z@;US7r>-~;ouy? 2ڤ;پrxwgcOR짪]NЮzuqf568mV6ll]V.T +6 %EL*X0 'l`ͲϹiR]uԹ-"|],uqb_[@t%p$I+V [^\eVW+Xȩ,1( e(BD?!y=;l 1Gi+븎T9޻8D'6_b޶Mm4x±eKڝȼ7"e,}4Չ])"i&؀ԕMERLSM`Bo&tqؼc͈Z;c6x"G l;aMcO{3 NXN"m3c!2m?<cG 8cyG^ql!.,q5c5bEC(P}qo&E]M43wWPNp^oՁ\B he^LӴYt-RB 8hjΧn#$=U68V!0*amY@X JĮӡhuv5uXB\8a5+O{Ữ;1H'C4\o؃&kAe h[Tfb>F@SkRBPIO]Wha{=wg{R]s \M䨚YBˤiyy+eߵŹ˛ӽ 2('f?TEI{ NP endstream endobj 3570 0 obj << /Length 2573 /Filter /FlateDecode >> stream xڥYK8W9@IQa6d0EʒG[*lGX룃n,~~77MHEhq] :".[TQݯ7pD)#OT8MGG :~Z0i}\1Y~&Z4Qv|Zk.V,mqr5{>:W\@[f4 'ost|D*r#yٺw"aa%D{`Iנ8sە T22o蛚8 H5ꁚ?Yv5KZ H"ř>f`iH2>jPT|+(|zwfS{)dؼu[TCML&3CO oooH-8oB2˚-g2|I'hRtGs@:_diKoѿ6+rZH.ZJ=4)1#Q4u|,\ 21>0/=/$a/" 9tuQ[@-?bz f|\b#91sP--}H(z7_BS%kb+0_޾:͢(~M7|Pd弆 4)}"Ac|EF\Wav;qHo%}uMY j/ X=#ciQ#'G#6߈Z#8V4 bGQN/(v `:{IհIPKXl*Tr˝[/XZ%9Oa, }ozV1G/ ` 1w<=ۼ; Q!EE΁r$TKT!4ULMW` q%~B(*sB BƹAkʒJ|ɆK+QN04M0ہ2AD|;vؼB +zmv\rN5%^Dl_CpeujP`Cp'T M/rMՏ V$&yv uc/pgBʈaøOt!icBhLмM ڠлMqZŌﰰDċ^B} H⪴ZJ];IDh:}l3*FC98=U(6*BRUhFF-R;i ?LЁh 'Uԧ$Z;`Wi/3Tթ{ ý?sL|gC/<{}C9+Pݭ .-J@woO4b}#b=5@eƟz endstream endobj 3578 0 obj << /Length 2887 /Filter /FlateDecode >> stream xڽYݏ۸_a֌$JtE"iܡɶ.R63,oZ, !9?~m^Q& =OPmbJbm{^Io*)Ȳcge(M6 AmWn/e?[$mMG鲮4]gi7oN{(#$Qءʺ/Gݶ:ʦ0" =YYM5 /?p dHVvA=`Kk"T/Щg~O^hQ"b^ zR)esMm֍T٘`U ]Vwڿtm芘0-FV} |}O ߬hD8nMSQd]Fd)o{nm? jÉ]N}]8 9m,b~Y']q$"LڦB QZZ ӹSǣGgsUmF{g[$|05EaN}4>Lz pmYwd e%F'4Shk06f98Y], >K79aAEԙ)AüV#v45xL\#H V/wT}V ဎemlx_i6ďuQZegKg="oyeH#Dtu@: .ue:'5Ϫ2UL6ѠJZ!m* @ F|"#UBOc~ם4u8n f x{W}X]p9Gw{3h_r?w`sfFhGϬ!g9<$%P_ Mdg-we=/[N-Eb)xr#9;Md(VC a7-P.A 83Rr-E<8iko:ײey,/dy!;e@B=L^#SWU?:WыcȷIoŃ0{:CZ-'X2k&QSCj63Vff,ٌ247-fN6'֘F4VYύwl*B T:4%KGܾZQ7w$obrquxa"M!o8#kv ~f-/媎[<ݎ]6Iaϭ9kFC}˗9B#&7; gXi(? $H(UlQաu*dWu]-=)AFIb%T=bE[B.UpgxTz^g{TFk:r>\T~5f(_z@ U;!^ ޶wnr{n3H+|ri4ySf*Pُ[>,ז襃F$;~PN`DT!ɩJ㛅sTN%FT-gy1GuW3SǼW|4who `)RJ .H[wMWPs~ *xh =ӂD$xo < xkumFoA…vHU*B UqPY8(eշm~w->b7̞93cqES9+z{Ru7)u?Mnwecσ e6w;^-~_>F! endstream endobj 3605 0 obj << /Length 2741 /Filter /FlateDecode >> stream xڵZIsFWrp* fFNŎ/K5>shM6q~ް H]:~-^,׏.E"A |q] B8K⏀rˋg<,e1ApYT;v3W3sE 2GIL]?W]-kY*_*U$8hUV6klcp;F(F!fBPv(ABp$/gIH+oE4"#'ŻY:yD$t 2!dPh5Ie?](U4+oK%Irnϻ9G`vj`P:=ʏ1.OW S46` DRَ1[`e)7qBKJa;q"8;+47eem;Y-Z2+=@8]xB%.OWKX)VځhRSKxk ~\?9惞Gc4 G3AqEp0>6P5wSir$ct\1c14s4s^bk$'l zpNyGUvݨڒ{Ot/ e+(Yzvoi 3c R->Ayoe$v=F6 *F$OGI# ϣ\}1O^TvxzuH!c E"gK @vXkn=~E^ت|{h%P] ~5)ݮbx ~oa)B0K5g?lݮmOwwwȟL7bFMʈ9&1ku^,Fj-~`{XDs B|gb\,*\nV"%4V Qi 2r;BFCB>d®7%6 8qpGgzA~ԯ҅T_\Ž{ti95dp12ʉ"D03{ 5\}9g|wD|2t1 ױʴ:]PFgYFyTR8 k)W`,)1t؄3$3Lxa&DK!xjs0A]`ᖩ~}y݅ wܢ3vC-CpΠ83gP:njY5\X> stream xڽX[o6~2+M~$]N%fGD;{IْWd"@x;:$shl0qCv$c'aw W2R=ҁtcp(4VI iaHl_e|ߊOWL.ծhZl(VVd*[?>f2 ٿfL;0eW_NpDyҢBVOBL0Nj8gE㐁(ԑ!1yh8 ݃Ln_*yZ)ЃR < (Aj#w(Z˰|aXw/,oQYIErc2 s޳pk1p 63 U!p?fe#{T0M4+,T'|Gm+@cM Ġ\MW$δQE;?rtTгY~-OgƓS- zE0hsSo4lg/^G~ u=L̐so>\]O#>W_uǍ,YOΒG}Vj*6}=z To*v&N> stream xڽZn9}WqlHɅw\&@d Б;&ڣK.{;,n Hj*rMSF`.E++Q_$COJ,c=˟XY ,,%NHD9HYJ(`Y9h9_!TEEdI2Efgqt%E9(G'X+HFHP+t|<yHP+Nyk , zHb` %LC( cs3|,0ɧ I& Nad%L$ Aa!*c#$)f8kldLhx*sqXBDK=+Z29 U|7H}`;`[c=.C NLI怪d|T\$+VKA%P$V)dAJ/LRpS6ŕ7بL˲ʡV*2/TȆd%֬/k1-hZlKO ð"A2ki{Q"%Ga쟵^Bq1чӓN5g~yҼZ[dzO'͓~~dW[-'Y7Z76xۨ=aláqj^^5/ggcX#'7֒`699v0vP8Zӱ6'.Yc7²LQ0falأð@ޠp"E1jy7,QpA'/Ek%0qs_<Lu*g=F C4 -V:y?[%.bZ9#wռW y}]WН4O-RegEźz^tIUH.Ye;Ƿ~3vK=-34Gq?k^5>MqXi|ݲ}v1,xtgOH"!"ǹ;ۙhGAxStw4.{,-슜+r%.EE;Djv4 p#p4\siؠ l%lX.q# #)9@dzmE6H pغ#ڣcwBcзܖ>{НV14kji{-J9ZYtp8mShC iSDW)ǒ #1})߂^ŢGL(\фuCU5m^{u 6u>J^$0O:6t-^A^C{+y)/ lO[6Մ*OSrT9?UΟus՜\59W͹jUshV˄Q.Yd.Ǜ^x,Z:E9l9!YW` Rka 6`鴝8Cɵ\X`m~\,bX0yj!27wFGwyp6hߏUdmλD:/!wVri<_tyD$=+<=!w,]XVY70:X,"E2oQwR_fDVeҾ{ A'PP|][ȦuBؙh/?mPɲ(Rݝi.&4Wk%dI '&"Vdx˔nFDX&rk0a]&b3"}G,yD@ L? %,|Z,q; ar{<I7˥ 6'{<;Y[;YG$%'>}2x{gthW^]CG54\M6w[m˽wMϳTW_7QqބB߄DYISEBR䃐\ du endstream endobj 3631 0 obj << /Length 3042 /Filter /FlateDecode >> stream xڵn_1KFOv Cp4yLxVSG7/q$y@GuuU=bu7~y"'򕿺ٯvU hu[V{=:P!Eu;\L}Zƍ5ܨ5/]3=,(TfUu\_p}i\dew?vj^UT:n hA\n[_Py8V Xy],u#_oS.r)uj↧b乤Q=073.R,y> #]$ .ߓK>-nԅ=oT .ocp?%{f0$Jw< C$FQ3eP7-BD"tBO[A_s(p|WO0l`Q"x4(/!'L:y Z_mZq;?% RnpUpt_E[+Oc5.졦ak$ :6Z eYř!05R`t 5*n( !MH`̶҅N܀`EwLCp g`PN|덖k<41QU]iZtK v7r+d[#ʏ,*=/>:Z,Q}8)8~h跷4),;jP_!62˜魺A+fdTu1&ip1KV>%;–Dh)Pb@Q)jCQ1.Q@8N+rm@W Đ7-Y2\|] ]K)jÝ-sBM^wD17&z$֏Ub]TqZ,AJTDz;n1Mpߕ sF|s/30M'B\DCi1%!8-m7mPo~0e`m= R^]LK,1^&&_ v*g31MgތmyQ@XP9`h}ҧ=G ^]KGj]~ `IΓ3]'Űd?$roBϤ=z@!B;0?,4N J`7غM2*.r E[O~M7`R 3B ٬Gg FƮ)cxp@mՄiEj K\ضgeJr)i^$C$$ǏZZ:$}uO[ ܃Ҹf sO^'9|!K.C[=P h!bO}|N2鬎 ,$D؞jdSZ WRq n 䢖x{2c_PK8YJ?2_K:iWm+ Z+JAHäUR;b?'i h|{[3b Ei{NgorټT9'Et0k6::*ek::h`K/Z,pFcѶn u? endstream endobj 3640 0 obj << /Length 2864 /Filter /FlateDecode >> stream xZݏܶ_耬,(hױ !){Xҝ(wC}w~(apH 7C]^E_I,jbQ8Y)Ddbkp{~/ ȒPeȲ|<*rZ ik(hrw|6{J,RM[Ǽ\rKK.4udl0biڦ۶xsTÖ[821>) z~1<h"*8=pN?&o^AۺitPh3!Vks&T]Agr-BHALzR_jR?i*uVI%{]Iʉ2Us_ݎhkoQ?;^S#?ݱzk8 #40Ѧ,ryuZuig ZF&;ThZ2y0?JyjMw|.@c5Lq%@#hb~LϔfgF,j@'a/f 9Wy^=&I9Z#w0a,6`aΰbi6=쟱2ކ~Țx\#+a% Zn dOOS7#Us+~v(兎4})BcJ plX8 %[~s@bqjv;Mxs@Y@OR6 @66P'a 3>02 aGݴU}]nhe'[{,y1ՎDpՔqD3M@PJX[̎Eg˰:fj'CC]@c+SSkh7=Okۼַ %X7:?W\Vs}% S9Mv\G_!gsl1N#"WG4HrPM%!y,iTK[O]o-9ۥhtϭu6T(`6zwCC]芚bai#&=qؘn@Gb" RQiV^/3[ F pب\m O`Ƈ3~tn!5nx7{[&3}Ki-$(4e]h8 W>{,~!H,K4XZe#7W/ z:]~I5LJR>j=9` (lc>ιLxvOy WLg5M `!7}I߮T(MVC]`{caLtx:@Mi>,0qZQ4~"N{NP7(uK7C=P>R `E3MpM&52FےenKtoN/~Ш&'@sCcX[,&ۅ0˰&Fou?% Z&Rez9X\ٴ1=]\>-䇛Yfܗ6`0:lzU~BEn`@)>ʽ׃3WqRf8{C/;C e> tQr.I$۷X*nW{}B)Uicr^( K+`G)T}Vnqr@G)GD' Ivsɂ`e3{#=Xi5>#{ܽBCaĵGtQxy}G+^6!ȇL~y@b( ľwg]"/!4PSӌ{r  #:= x:9Sdq`W˚CC.$br! 찠mc?zǑ+ml" ĿWh\X(z?P"v, ,(韗)rKN]U( endstream endobj 3647 0 obj << /Length 4173 /Filter /FlateDecode >> stream xڭ[[or~_=]jZ84ͫeK7 >t6HW;^-EyNPg)"JSZN;kۦoq^VrUHcSa~yNxmk9>#ha'u4].1~|oͩ]$/B4us]٧3w9} DWMwlwRGn7 ፞N5~m:"kn| /w0"aKa [zWOl%{&c06Adԉ't׺>[Le+Jz[ipXb~xiD ͔E)aƽ~{r U Uŷ–>>]s`^߼C{O#YXki5)*#<5+ d>aD@_ɒyK 64ݑM#f]ljw6'5ARETEYZSR Ns8MtTte9G9]0[M刨R%"Ӈֵ%<>4off"sP(Rt]{fEfNeJQ(=)2L jF pUЃqjWCn3>gʏfV F. [~0OyjawM} "ڂ+S7: (ZVZ.zsLLk+@ 3g`v~JYYLpEYBT)@vV>vhHB\*W<GRd{LUH:f#"d#۴?k!js%JyAGR-^r|J 1<5]2*eYVPe3/gQiiGܾ>F2jKGb8B17 "<1;ݐ~9LXl֛hkBFT>~>ͣ/(9j! =ь Nbc69#ܸ } 󀭅+rK &5+.&ug-u8(At\y"> @>WO1!m2Xފy#.ršxwx}ŀHM17XKlSӌ6)e\-&!·cd |nx|-NTQ1.F[yT9z毰)H0b>e;8;Jr}^)hPjPǹog@5~?\(hs R^#j'hRUT:`ezKL͐V S;^NI!cK͟8H0o\XhrUTUXCqOm<$ bHM2'Lo `7 ?UʏtTgEIaN }G0e{aUYI |m֖~` #[Cޝ#zQZgYuB9J@Pe ño2=W)<[X)[l6K"v,/koػ Y䥚~YSS=Z V+qAXo;`IQM,=';܂6ˌ/z& /B)4Kr0F[L;wσ*w{Mb 1/J:mg<`D,pU^s^T$H:W[-Tlsb /VU!_m+ {GQ}Rᕈ[2֖|^Xdb? Cs烇 ;+_ٕ,x0{|XR20˗U(*Y7+xN঱E80-liʐN43QDa nxZ@T)DataUq/ .B0o 51=fuqk$2h ؊,7Y ),EK$˫g+Nd b):yf P6%a7 #wͲݦBzϙ2YT[pHg%FQa&UQCCtٓH^adk8odtkc4j"7X&=<#j x tU~cNk:Jڅ? $$|Y\%HX;v22e%i! >e] qn_P/vq:M' -?WNF?7ZLZ=&{'{?1lʱce v:$UdYj/xNY 6ZcB) :p@KtQ,|~]3KEW|($;TNVX ]љaVɴ%Uс6"OcT…?>TQaK~U*#^gD 5 ˫fdRwsXDTs5x=ܲc}yGgbB Bz;?pȯ^W^Grم4fȃ|*he(tw#5ԧv]ySdٞrvn B19)zn'D!fxօ9Qs/wC}^)?!\W%K)SNr"^X-Xe;ݓ$=xP Z  ԶЪZ2[aq"{kBa?ĴĔ+gu׌}݃Rb8V죥b+",=yĉ(j?q A3- E"d—+đ&ivZޙN\/ ta& ֚+j֐rwb^ցe.he hY^ؕ yLrWiVoLxKW4Ph΢ o~TIO;$7ID'/.phɃǞp س+L㾚o$Try/6Ⲧ)28eZ8%%\&0kr\xg ( 5y C\僄 4Ҧ_3¼fEp9K0˚\i&"2հGT+1k e?Yy}u\ 7ƋtXY#XNYQ̦(A6?}Q endstream endobj 3669 0 obj << /Length 4031 /Filter /FlateDecode >> stream x;]6r ?`[oRg.|8wG7eRnA | >Nb%`L)a̯ܶ t۶އhjc;6>tHy<*οネӄ gqHs>ěMܷ vt 0 #cR\2%xjK9$}l9wlSd($nZ;?78}.bQc׏Qnzl6K~A%EJ=ct6!!O}s+ 7>M;$!,yNhya(\5mRsyfJZ)Vb>'J!>-y@eO=$M{I+=88eO3^T!@tAn0uDwa΀$A>.ArGyOUQ9˴HBG *|60h2Gd&R ,&7V:( 7NJ#.}#$83zL351R5[4~ I7W[nl|z] /33ѰG\Pki /&c (>˜&1 0kR!+l4Z`uE@[F h3/c(̈o;,ƕ_Ci:X]@;s0:93\'f p<\Wdzml Җ\֤e3Z̩r# "]~MO2p%407o/:TYus1l ۅ\v3lq yK$֚g 9b =9\udKCzΜ-" sgXt,R& ƻ'Xq6 E]JKR.d;8|Ƨ<(fu%%S>.P^NH\k_q >Oacc0PK[]1Ԇ3ONp n6 4Y1ʧ Le1і3s? f;d(-23u@~#Oք<: du>!#-1I/]`eo)P}\F lp.O xa4}0]kҨRՒ/m K/߫IrjYʥH^Qs+F= &*Cegtp&,s :l!5E0Wh t09 ] %Diok{FwĪ)H xI.`~?~TYGZ iGHB}S>TyB|.Kj%<q'<]nqVժޭh.rfHE48וUz U|^y,eXzr%RꣾdQ U2 U>u6ө+Vߍ;]+N>Ȗ?yu{XwB}of/:#m'S@S[U~b,X›3/>rcH3=Ȱ6VXc[M5YVG_} T3=yX?Q]=KD #wdDq_(NoynWT|%%Vٔ'+܄G2m V`DZjpHټs32*@sYGq 5^k|29\,xxb c;\#9A lAXU"՞K*$Tp _g gu',0Šu>V]s}:F8`>rV ᵓ%w {O?Zz_gll!4j?`:} PXak(Uc"A.oPR&wE/xМ<Iu E]hd#@k>c'LlfKZǢ_/Jox="WA,ՅV@PӬ*;p>؊]SwE_U<T%t}*}Ȁ6SB$bGzÄ&-wɻ ݞhRf c",c'u9KY M5}t_Te:/ h|2K3gɿr5a( kE"!@ЙW`E`=m07Ǧ"bB]fd˺֋ڹ3EׂAiP|LŸ,L#^R`h>9GïCw΁ ޹aEmt6|%Yc-o*?}ѩ[?S@߂ 5H!̊YCBN,9"mOE:PM ԰?770[Z`* o '_y1s .'wRt`ܼǏ"|b kt}<%R64fWkXjnM~?u3Tln ϖwk[1Adg}g|a/^4̦ΏGЦGoM5MG?evݩ?TifVEl{)RͩZ 8r~6G㇡E)U4BX+7Ԇ.b5ܬ%,ccϾ$T,pFChv'pRM(>/\`䀷0~&!Rɘ#< JAw0.BȑmCz)ce*Wg⽬ ثi !WCGhzcC+^ .vB}ZٗK (;DEu]'uc~[0K0,> stream x[Y~ׯ!E4th iКik{Ӈ oOV tŪbc,UW>{!F2Z4%\ȕHnV&?.)&\S2 ,Qs5=H=52ZB=YR7kPt:hI}>]-m!4MteuinSǼ}W Gӕ•eյ ;G,Bcy[WkT ZeL9Ȟ tPePmC(ۡ(XBQeUF-Ɠl)yWl{z-C["C+w5MFuiKȱGH0yo?Ykѹ|OЖB&,M՟QgISeU52Abq3vx77u[:u٠raWg碜O rO@p >^9Գq6S+Z{U>2j7vWPmf$Bz+~JS^;xL_8|Rj0l5qs3 =h ,bYI> S7?TS]rh';ʩA:}&Yf}F>+@ΕڐeZmQWNwDl#jрѬJ'?XIr2dGa¼Z }{ QJNp4y+7ھFM޴rOH~vIBGmWnT=W}\_:z TهM'DkJ(DkIX мb$3>Nq)/nd[j8VJE1I#@XFn`fCL:J>)+;d!Ň:/'qƏc(?jmჰбTLn,W!=mĀ^5A]\A z7P/oLdNAQ$U.ФO#X -d:[ayb6b k0 7D v~mye4$UƐg``.,jg 0"DWu?ti~|\|=Fn8Kgz!rXٰc\(ԅE+#͏εI)2`r9R1FNNQB 3Q4R578/Y,O,שaxk=i?v!sv*W.+J  WLf8|n|Wk& F%3qdP03MA#Z&DdN#fic?nC %}F ԯًw؋<>ds)l~az7;r( v~U:á9 ٜf hm= ҚCeCEs~U?9fB1amޑ*1!45`G4Xb &ڢ"LnOH@Y]{&}TQɭ6kʉz4ft&]Lsrr>ɻcj :olƆOԙ'DL2w/.e*Qfj!K&7=q(`B{?}?4Jg'6FΉӭdamfX6r{>[w '@-OZ%x=o L+mW9TS/ &@oKdjXBfLq@6m~m'&. ^ݛ Ԣv/9o%c ad4;b;g #e6HLCw*-ܡ`F2g_|w`5Fj\8yGL[J]9MB{}2 ֦ihӍyI1j7pMeX!A%dj=τ:V.c #M)1@# \^2Ȼu,\04%n("r,Ooɔ.ۡҲ*>fRF?,[]cfY! t>,Ӽ>p?H:)89Kifnlú$8V1ZϾ۳r  7XVsFI8#,_й}ۖD#uy_VݘQXF%&f2 v/Ka=,.gkQc$UgLk>ԓ,14"3NE>#;z͔N%c朏3$A;1Fb.Nu"4zVgSWw{Ćt`tfWsBSwRD}"6=NzK`K֟V ٷ=h1K]f%QcwD@48Y{ݽsuPN*颮9h d5'o@v9O Dj-v̌r1ođWS0J'nSg G+nDK831UIs,nMM$ fkڛ7e"c~:+_!llm+=t/Ff~sb(~ >=++SRrw[V ,]iVE8]*ޑ+p+ w1JĹCzw!sry[fw-A_Ȓ֛o[ɵ-ns0_1fEvO,J+zdSl"?L\7ۇ'\e|MwMlKu)I](߼(K?pHFBb7e)PfI+'G'l*QQ\G/^{Z]m)!߆ PE2^9UAj+* &E/:̋vKH^ 52VOaK5xOkpx正'COo߹QJp)܆n۵ OӦ\K҉O߅u(܆KqBn n;Z>gN.|s>1= 3 ׽pZ?+y:mt5~}࿗

> stream xڭZYo~_)d>8x!`js1ٵ =U]ռG$M:nyp%~WoU!LgWWJJalv)nWHC)y׷_)2tV`W1NȯnA}|f3f1IȂUdK &M+ǺkȪU?:kH}w]Wñku@>uR}:x+̈]Y[(7Vm[|D2(téA+m lJ' lK |仱y8뻊.ky"omuСƦ[1&fZ8Lo5;M,Ԃy*Rf:LG tdr´6Zn&UDerLb`OfK/jƐ1Ѱ >yOwVȼXKhSptW88mY$IaXL䄞;  n )7mR<0.Y`/hrUd!GJn3H^3L~AG!Ҽ63WOWjjPp@fb'в$Cf)CjÂ3p'~_ǧd ՛U.2?JH'_e'7.b"cu,8KD.3E<]@ K(܌>}77Mأ,037t@vD X/\191d YNDfuIbNHe t)dsFq9Cߝܜn21λ^]ĉ}< š0Rqy-0 =&6Ks2P] {*}LUcZñ`d8`<@eJg6'A'c5>QЀ2*i~-b`2L1Ւ:ܲap / )lwJ > cهu<5fzG`5΋:'(z8b IM}}u4t(a_2_)~)8~9 MYofn̮"\Ą̈́t{0*4Ծ`+gt{)i"Q|s U*rj ar)xמŁ*-܆_\%=82^H ;:b5 Cg)ZHb{Thɘlq4ߺI3"|ʟKIçKjރuQǴT ICp4F*˓XecR0-$5F-V4˗MAvY<ܞvMՍ]=>z!y+4u ,y~9M}קo;? %X:|=pNjW*cCn㴰j޳&ٸ5!фE~c'W4嵤cy0c^G9f)8/FoyX|cҟ./6t~(,Ta'vb1]AKW$lw RqLv >hW&bN8x!\?KCfx >Vtأ|~#P{G.,<8/<'FAx-dPFЭ?M׶@GMri b%/@|R5Ձ/GP[Iv VVG~VȔ g9Ċܬyq[gJy`!RZ_OleDj"竃w\y Mic*uG T_@Mv?Bh"|AD%ƄqfPB+hΨl onl)-FM=wHnuA7N#n^pϭ7P؍iVJ~}I[ endstream endobj 3710 0 obj << /Length 4284 /Filter /FlateDecode >> stream xڽ[ݏqb0/d`6o Mq53#ߞ*)jjAIbWUlvxn~?.nʬ4?p2Myfdysݿf]e3& d;*;}~1G~A{+ lELn+b󡁺;7oh`)gtr)-? Xw-F5&+QX'r2_ z g8LMŒm}n'"|Ei8a"SEan .rjZ\\b(28%<3*^uVfOX_& d8l2HP5}0>U#lSNoǺfOͧ;7UTS5*7=냣hOc4>׃kHsd09 34ډ-GO(ıC5fW <Ŀ=I0^O"JmjdL@lT֞ŁI-]|>V[v7]v`$wyA)@c*悱]Xq~^\ˋ }~2 uٛ*̘i8 |1? G~ db=Aw"dW?DlI#5}WQs杏UO;AGT>/#|8G($ ? ma왕j8|כ.4Yayw'dz'jO4>YȋICzں(aᵈ(\T+ioLV沰g6O]gI !iB r ZQsz֫`h]y׏;L>W-vn}גZA̡u[@Lv6MX'r1%aKy12!g);҇ YRx{bn?&g;.&S@XS&sh2WhO]Pۂ SVɠHA'H݁JcFV UE]Dun{Jtǂ:GRH2KT I>-UMΪha}820ꬓCHpr-O#o } G+U XxN `Jk.A}5'=+#/Ou`Hx젘$sw3xra X^<8v0if>:nvA9Tc? =]舅pWM8,b-vw.^ 4_n,VBV\ Կ70zajkSz &,˙Lx06LE^E gt$OrsGkRA$U!o $pu# H0Š-wb(S( L#/GH{cΈ }bl76E}N.#Wu 8^:B<<ᜟk4BX{>"o},t>uIhOuaaJ谔:6Q;z>.TLi;E$/ {O؛߯\Vww>p( g$H^XYA9k%h1R9,_>Qb #j{dHMFpZ3\c5Y%d.!D_6Vl~nN `Hf yv V-+2رFswf*VN@ݤ^Sa 8cb Vų_O[-b2W -sIƂa0`0MGmS"-9(IpP_CIl!])^Aj @*xP,^c8\iMkg\$NdP%~qA| [$NS:ԘdzYt+ [Ogmӂw`[9u[Q /kscm5ڼw~ǃfE`bYI +Qj +TbfUc֔*K[Or*L ࡴs]f ޥ5rk|/|xG"1c@e2+RVγOG|n>ޱ+Д,'Ba!hטTW fFye*˙X$VIAzlVrEx]&8W; s¤'AdUY=Bvjn C!M/vC(βD '̃Y^1+N *JB;4Wm{O8HG!3(%E/oȭ)sG9JY奲;Zk~5b^X|w"|Tȭ~-i,M&lrX!%[\SCb44t;Al*=/#6i[SX:C }S\ v7%1Oe\} TEpq]Ԝ@~ 0ՁmV(m< JŏeOJ~w1.[Z)(sJ%D]@ .']0N#ʸ?+L [O:B=FOhcq2#w endstream endobj 3721 0 obj << /Length 3464 /Filter /FlateDecode >> stream xڽZKh`G+zd 4u7^q>]׶LzJ=c3r'fz+\G2k)LÅtJպWbCDgn峩gLV'=!|!BEZLm5@}C]ce\kk~,ݟ eIq:nlC{9)7~ZmeM5wZYu^D:&.,uJ B: |To&q6M2Ъ?cSܚr:=aԡͭ8x:f?ۦV5.S8cO>5q® -:D=UŹ*F2?N5\pBz^: >[7~Qȸ (K@<v_}إ;M9jp? %x3f)?,Z䞻7jKvnOHY +M:rtW 9#XY=xȝ5d?3:a }G }GPomQ9kPJv#wZ׊g,5#"t!F?k '(yzQ5̍u:]TbsШۺ:z)@K)1\,˼51>& L #E E+>15=7 ڪ!h$B{u\k<@- j[Iæ#-tM(U.=E" CHi8l85/8aH-zslu rw*Wc%jq sTԭ!;RpI i=_QV&i {JuOT\ t^Q~>4wbƤ5\-WԼ6?u|ΏA}qƪ2HA9ldwOG VMxiŞ<˂ zFq(ak9EKw|듗笕|@d$^jYŚr6 `vO&IH1{j+ k{:E:' f|,l*I @PɖAUx MT^g] }䩛d'lY}fo)C:4=pz-6K|sfyߥ]J4oV.1TָqjOQ,q W`)YJ`@R15]ǵE/29kw--{d$z6 /b#EI.,ҚsX((0IsdWR@S\ Z.^%*) ޗ}I i*z9m/ug/ѫl ^úHE&Go+%k!5Ӡ]21"pY9WZ/CԌo) 1|?:06E‘^~Yώu:_*Nǹ9m/aBAD> stream xYݏ6_aKe J> K@ ^{e͋,[Nv7a55rg~v,/wn"%E>E~fROhʳXf/^W<KiߏKg^+uK զ%CN}$FStm*DYWh%7PwVھmw쪢Uu/W o(T7 MV[dlEƧ0F fd I’%Xi͓K IZm+1X!H,I>RCŏԀItdkhK0 SoFmgZ<(cwoԍq,EkFrPtx|[sYgJ4#'!hU@P4{41FpZ[Y8,^LS'' m;g2J|LL(_Xڮ{Ǿ^Y tc9qA~Zu،#?Jreqh$,:QƯ#mK0S9 uTNfNaҨ)b0\xPeisy$Hr +M  #~|4F'wjc/M(c6Ӹ =Gg1 E9%7G@O щgD27Gxkj+FXA۠tZ KY/ Ϫ˦yAM0PRӓs]ß-ִ5,MhTMg~caO %N+fMW8 ̇DIl !YIm"tPMxX[މ[.%N0ebe՛DʓIS1ANe' =!A4b0׀w6js[[z/TpHRzCk*,I$2O; Ѡ !r =>0󓸯w ؾh繚xp h"j J]IvFf ŗB?z 1++•kX+)O!WG?>AnXi(qqIV*JaAE<O/| ' e$j?Z߄GX(M/n^ƀ4">l.(Tu3l}_ey N[eg~Ʊxߖe+ԜS YYt3sE1 vVh'EZ>]5hF46j?C5d=F8@U~;&xa=d8Yg?Ă b>?'>W|{?C endstream endobj 3773 0 obj << /Length 3046 /Filter /FlateDecode >> stream xڵZKs6WrU HrQ68Z[H\sH)ίn4ǣa\)b@ϯ^_W߽z{VZ諻C&9gZWwv1cǧps%2,NSˮEBJ9*qb? D >.5uqX4/DQY0ݛ^L`Z}YYM>Lيm@"c>=},2UkL7-]sfh:ZtZ7mkP'O"emչ 7OwǬoߗg@1>&ںXRm{X|tf6ʵ0ޙ/8S1ky/k xb?s< <z;Ӓt);@XޕSG/ ,áYg}w9o2:*;g(eTP9*pr- ^M7z;FÏ9հDS~^(P@Ib5*˦e (0*S_($ xӛN46n>P,ԣ́C_߾'U)KK@~^< YcKUvjP%r;gS#pY)lIH;ewSt , r809#*PKH 0}Ɏa¹,f DKxQ"(9Q ,j` D.C:Gf bav+" X}3 D3FK=4C$54iz5F w!P2' 2a*IfDv ȵ*ɔN|vG;d}Ym<^sgon1x)Cj1FOMSM5=ݔi:L\4 ~Ztx~׮w; ﳲ4ZX PSvV'u4{zVqwAFLyC!ٕhXYk{nCJ<3$MX\y /YܪU%#/ an>[ohNy5t5H_\ttNܧ{sL**,\PS lg`D|%l=ߐ'3L+p  .6ކ/#pLţgB^~ʙSMuTݒyX|C/Ip )p92Y5 ;K˔Eڬ ,EZ?*m fGcvG⦸z[} \#EKܸ >%dY`J,WWx2)I)+Eqi):tߖՔ'D!߾A?%<]UI}goE0'}S6t ƌG b\s(+B@v4ca6i.Ǫiftʗf`5.>qvd^w}k??)}|F1Or?&œ4}F0핸xNIԒ^{%+`~̽yr=Ɔ9GMcA2nWBFR31'lsp^ѳB$YG\'T|ޮ6^y}nU> stream x[Mo9W{Qd@0| AfБډ`ې`~_QErۡ'`nu^-)|AY\q᮷2[ytb x B,/ U wQU>ʚd:[%LD&[rH^F^Yf <)AV9HF\$,ɴsQ~A9Lʯ")ٮH91b QײBȋT):!(F Q9+$E˯YQby70J *W*XJ^VDD0*oIEhJb!pS.lD9*RçbT.8LUDjdL'9dA)b߃ g"xL[eUXPmFli-^\a] a apxA; :E|\ J؟~AF  ӅD3.ij;.xK}+b3Nm7nʽu*7,m62ܮ%MÇmldQ-1ymbEi߀_\nv>J!$}&ilJEaZ\oDՊ6@-5JZ|lLR#zDqK2DI9@7@A$[3{IZU.J?`ɥ8lc>OGʓS\šzqHuP%*9VɱJUrc<yj[6d\3 $V^_!a?ތqn[:*LSvP8Tsz7nn1ܐK!2ٲ![T Qf|]o` ,.ͳrۯz,iINc@s%0l3:۫95ČeE$lҧ0  %M33Cnӭ-K{*JG(ޏzۮ!Vu̳v~e6(d"O zp ~j miYowβ ȓ2EE˳q7)H6c $@y+]vںGa-UBbyVt:}HB4oְq "em]ՇC}6M?:7zE j׮c[뻌߂mO z%9Eno+R:.R|zq*+O-G 츔Ҵqk\=|÷24gg}H ?bgß; &iPy`W5iUiEdS6_i&t`ZeZZPG )J=i˲Q"g8z۷ UvH<)y %c]٤{p-Ǐn9n&) 9ٜV! ".x`r%͢3g#޷?aJ*הϪ NiŒɑ0!ve8T7rb\}?pݥg4H7+\:ˎ'bMBN'nK{>%3NR3nbO^]ǫ;o)G*|LMϵMϵM>cJ*dJ*dkSkSkSkSkSkSkSkSkSkSkSkSkSkSkSkSkS6%Q`,J}9X@g(l# cu0]0T::.gnQ[]ȇ\wnke)r`SvQ*(9 ^`e Ё fOGv JT7~:+IK6 Ƙ㜿(#-.̾_5^uF@.,$9)0kKgV\Σ-Ҋv,M~>L[nMk_B322r cmW!>Y 9 ݮ`|p\Z\cN }s}JM(˿@ }\_>K p$0?B?+ endstream endobj 3786 0 obj << /Length 3624 /Filter /FlateDecode >> stream xڕZYsܸ~P%*Ef+JJٻIyxlR- 01!Yx#k_4 6F_7^.܋_ܾz&;g݅纎 H.n7~\oW`2U% IMrE ]'h٪HCbiU:k; lQUvU鎆moO:5&=ATK/|]&]{.KVN.ۅ~S}<. =E;'q-. Y`o`f+oyM<^94:M̤Vt:~Q C&Axy=M}YN w)ދH]].8A溸ǻ5Mpd?PL?AygGutwhg:ŎyLyp/HXG9a8va #3Ub'vTOmWI2qTWKl/:kyoeͿ;o;;۹yhu+*05G%xUkT) ƛ\}εTMD ",tWi7sE/[ZMQE u z w7}R#^R轠?I*xp<,.{$A4 +Jէ_桁%\ЖNs.:kvo!A[=>|Ǜ>x7C{Ggvu~^' gtX38|\{*#AԷka =O/abEݘv26f!ad!9_yoNf` I/E@G ]g Dކ>Tm~BB[#" `_}Τ_PA3+z@؛XT+ QėG! I?q_-]Laa/O#,1VΨ+$,܍e[uJLT`A" }F}3b`Xn:4;nFUKuKT FLp%4xp!4G@Iͬ" {Yh@tGl*ڼm+ T ۓGK4rmQ </iT 7f"a`:Jtdz5?{$A/ɲw罹6=lKA|@7^/EUOy> hr $ 0\uyoxLuf 4:@ -!Ki)$ # L*bq$vuӮ@9A86?w*VB؅#<<:@NgE)*Ţc}N /0 y.up+1f41?%cT 61B`Rـ"0BCkAb­< ܙLoj @f4qk,g1m eI'.@40ḧ́ھznAYeZ.YYھT; Пb_+PR9lVfÉEL} If́{i$ hEY JA{Clw+gXq\(~8@O2}ᨌO di(ps΄e̷,`O Goer-tpU)ѯY  odvQE"_EVxG&0 ^8Ee3k]T"WNfm aJahx FvN [YvHa!S5 !xK "W]|校{&%% &hltյh4g"wtS]{gr;H;tP(2ў,0^Z^\lM?Jx)|Hue|j&ɦ Q1Xg檼k7U'?LlЦDv_`532\Zq pObS)+yIWQR!g1ږGnr6Dԛ0y2yڑ X8E@+d'd6i$>wK`n^XUd6Z{yAO.H  Gx'Tw)wLeLS<OuۭGR,f*文Hg0-q6)%\LMd퇫NQK2^qJK'[ր>,h`7)qyzG,\~e72|JYB~cmhifwڏw` |i&b8XA:RԡG[<[ه͏p'$E/"OEn1zhн3 ݛ0t A.dZaMs`%M5qdsܠ[α_7Pȋlez%Y"A yG$IP 0tfȗ2 J&[mr@~\ZG*zNd22e[dAy3cr ;LBQmfO2%VhK+b< E lj͠ if=8Ծ?#,φطaȸg4+)qm߾еɮj;Kΐ!N}Ĥ'j/j8@XPMhge>ȗv5= K жXG]nț58Iڒ$n/4_fp'S4ϐ@'A o@oH+/.xD>3U@9*T:W#ZV.I4SYԕȺ$'@(%z_ Qq[ ѧq1JƷ,}`eDO߲ryeSбl@4K^>O e _X|';JlJߏgr&5J27UZ,Vxe=q}wcc]2Uby\&v9?/#ؘI^f7,?C AO[8ڦS7?=ov;_]]=<<8V71粿n_z" endstream endobj 3795 0 obj << /Length 2894 /Filter /FlateDecode >> stream xڭYmo6_a4@"/(׉m`+A^ѻB/N_3$zI$33=XЃ/^8|1C\0J E|pǫV Y{}~NFiD1e丒(AZ N *tou5cG geс"hdGx1=B齞 7qgeȳ•~r']q̿%w۲U5u2e<%#wz+7hYUwSTRVһMa>~,^R$C3_X-j&[նͼ\i's`e*s"JuVK,]kRޭ75z'#NWMdu|YaGi6 =H@y$$x' R مR?9mLᤔpϺlu}tx)!\5 gc4V>2TȘAq#Nxtd_gX Bɼ;>+7 9qB?8s*WƠrLP[I?XTuꢱ7ڷuM׮֝Nr=<6c<ԙN~=g\[Y2tgKrX"nNӚZނ%Adߔ坝-k:1s4mfaz۞+4sJh iNdxp6B,:B_alp6B}~Ѩ/8 ;le[C*YhUE ZW_8hZH IXCے"|WCRZeK]WʖsƐL!w;N:Bp2m!+옣?AYr eǫc`1*ҕP)a1)QpEw1Ew @{2l ឌbRȃIZ =CkP)b2#UґT|ʓqߗY̽N༬z m-Β"mul$-`:EuR "kIwfSݴi'=$TC<B~ݮg`|3"Q 2t#ܸK.RēPBtLC?U*B,!)_ %2$OI8лLZp=73`^+'l!qfaÁ3;-I7-WD!(^mS~ޖ]#Szǧ:2/1@\l~8l!lo}T.*\\I}KN"oq?N+\F&3 gN3VUMR4lv2 5LJ|7БŞ_.x WA.thye\-rͲϵN洴z.ʞP`=^Na qpo8}p GssUS(BcYxS geYp_ `ȆPTLG :`vƌwT˪iXF`MްvmO0=.I(DH1c St bDGRN?m|JQLia1FKr,f`/ףKUh6hvU{;x v bY]ߖ!M( &w^ھ/&l[QHPr2Q000P֮kFCЀ"'> jʊlH`soDOLƝD%8-\:\j Zs@4UuٔAP#ɸyo<אO`祎J$\E .}_TQlWhL"E8|!E1]A\[4{o ,[,1U!o> Wɰ8N)vmlCEfĠΎ6X0b:߅n _k;PR%t6ToڥύIj2`QŒϝģj`#bo>Q +M6+܉8@);0d FAE8"k.bp"\VO])v R5͵m /q;g[u%M]<{SCߓ?βsY6,2j_HͲ0,D efDGB"=_67I2.{*ZN"mq&B7M U>4]ڗFꮓ vzw5 -!PfJɍ4拥7!ήDH7UMfW<ο Qs]{Iz`" 'Y/&ے?]^Ź#Wy.Qz= ?u 0@5>fTgDFmȊgoc/зg-XgM)߽e{@D r3Sq*8'5$aJy]NH$:h?/hu߶ȶ,Zs]V endstream endobj 3809 0 obj << /Length 1628 /Filter /FlateDecode >> stream xXKoFWJJrI-)(&MS+r% J\}Q$mˉSs>9o=|9;$braG$=1I]ޛE@_/pp~Ch:9/\peE" |rM?3)*3WEcEi7)Uw[sOmjPn2(9ڷ;#83gNywS3|66'ͺॽ^{F fdWڊ%pJYmqlG2!Vfl^T6oZ/gfiaVeErah%ߋ*O/?{䤽p#Z# rcm-.)#~n`ANT-/<ˊ"3YB[x|FAe~a׮[ ٰb#jQeZ۔6VM o_iˬ+Y2mbAأEU^8B~ 5"/=wXk,|2}N`S` m!lD䯮 ?R]PФ0V"IdXIG a}2Tg\dV˯Ϝ\wY_>+9_Շ'3 F! ieٛw&FB#‰|E˅*(yg]\Gso#[ω/N# Cg(ȵe$t/A b>q@`Z)7ҢJ4TqECV8nΧÁͭTi: q*Z;!sB R MiAtn5%_;[C=kI)>wu\VL^˽輪/_?iQk&lcѩ!9Cw?mzr{^Q d88Z@+4JIԁ{qܓ 2߿/pݦʂET5ڗb)j0P@KpaHpP=$Q<{.3~d~  qy I=ߝϷa'1 hP H6: K a..0Kuj/,^`}&L`I`7P|D̍dJ07**Xd1qL2n3|1ɘc`!=Ʉw̱SeXx?DiЄ2jLO5dD5 vT3NCםMT`pPlq$€GZkUĔ..ln!ifo"vjcFuQq![_q>&WƑ8~̳ endstream endobj 3820 0 obj << /Length 2484 /Filter /FlateDecode >> stream xYKPRՊɱ=)RwnXHv2pfg&!Fn|~V7qʂ,6J6WAl]eݞf_onto8H Iddskd&)Mۚ'צMZ*,5~/ݾoFЊպ?:&ݷͮuܤ 67}^ ï*R7u1DlMן߹js?}[bEq/'Wy_6fk"n/3` UO&;nWfM`CK85qjZǭyYuȹ4=2Q_Z,sY6?&P.JW|JWCs7fD^*߽w/>G&@(Y^|s$Pυ''Ӟ/E5cLDvee׹]M5/LPtpXo=&}rwg/7z}x:9X1jAAoꏹ wRKn'p| Ovؕݛ$/ۭnmh F5,s=&ه<34Ss{anV%]+BBT Z]75-+1]o,.$ul}^3 I;^Wk=l4D&ب'` `zRz >&cq+<2,HxjEQzxm;;TXN|b2@Y ۃP (d @fEN?6pbC1-X՚ش@olٌI#9u||ߣkHoX:D')$s/hPqfe 4lF$v'<'$Dsjq901pգTAuǧZc SŔ$iGI:bWO%8(-R",D%dh$L;Ib;!J(AkZOr6P0c_c-φ2>s ٳ.{Q:ނȒT [0+LxWݵ \`+$d͜fmh@#} );߽tktRu)Bv`ͮ .ࠣ9r̊U=V&y,L8%5&͠L*-\ShB,߁2hz4( MXhM7ܨɥP4a7WVBE:, {uE+1sk\5Q=A,y/UϦ*5 $%?~!&_ f 7^jvt &- E;fv0]Ng$(綹o]a^8p,1{I/  f_qh$'v,8wKi/`CW/2xœ'=uH ]Dx΢&y*dV70uO,>7,K U̫O͉FE\J y";XFq&4BX˅mnes++Jfq%@eP4V /0k5E$;|^ؒ1n%a`Xė̤Cu -!i&jxJY6._|a>nR<T-bV0B\9*: &d(.XЂ "UY=z}[H1*896m/ 0oL9|P!MG8NND*ܷ̾uyiqnY~]s# ?<&mHk金qG_@K A3/3EoR$_C%4>qlݣ8/|Q"$Pm0c(ZE]۱>@Յ]ʢ C!*1HRNM$RBXA=ơձ*Xߥbǻd endstream endobj 3828 0 obj << /Length 2847 /Filter /FlateDecode >> stream xڽZY~ׯ͛  l$q8d -{CկO]cZEa@Ӭ㫪^{|g_~b?6 7Rndr/Oo7q8[${0E9w/7'\qrC/,uc9sުO~Ŝr1jyۙPڪ{'sb\Ocݜ>>\DQ$zzAi$N|)b-U~ʛ_5[T_.ɋ2|<$q99e<2OU'Ƒܒ* ǣz]ߠhyRA^] 84-TFRnE|CLq *Rw<ĭ' du{a@5bGˊxM 2LRL;}^d8R׏\"NKıCZ%o꼭x&/o>?j3Ⱥۓnx7GU9%V[4nAB6mb8Y;/ hi>{ ZUY|eիck  V_K*U ]?gie%D5וUU 'Kr"j4]li$sԍn cAպgX  : (tj-!(`G.=/ule<+ .( q*ppi?7?88V3bF{ӟxjnϲnqocO9叡UmyWAoMQ!(+@g-@B?2[AIR?Gb~ %` :ǥ!O|  Eg=E^#`W+ *\2K2M1 "s=cvfQlA*$.z.$wd'Sx@JyV2 ]L:uSTveHkۏ#W-4|^H& ~<> ¨ >($c矺56ZոԍEtCb 30< #xczjOPfn <8˸#;q@F3L5 ZBAC), &V:pRfyS4]w0,`)Lyifq|l 34 jⅭH\6 Y{*fR2^9hm#7L29ϴ0cP*'uS3E!J C*r BX*jM68d)IxH?MYE\XpFo*xCxEcnJl_"NIHȆn 8ְYϫU J *!G ek.b]Lo3ksK@[ [(Y*3caF6R w¤Ti)WH溗e̓mQ@5Wf͠|+螶. []*5?LA.K<%"'cH Q" 0uN:!#&ERz FQ*``"[à1rv,bsrw:fȏ \jh+XMg3@#۱2h^W VlpcHQ1u!-=ި_^NB*^f$二)n5MٌINCI {3>m_ Jyost?C(N:_07%Ь3WMϿ^a X|zƳDKM:0lWșAğr?*]?Ke X3j#^U#lv 85W/˧5cwm\0^},+>.^,Lc a+N͹9͞UQs :EK  "RM=Vxjx/Ljif^ yM*]EI> ~4=pR3^AU~isO ~}Ų޺`Zש&w M鉁J#;xk&U`Uv:ٷR2KBv&:Ay9>^wׇ %76x1]{ZٟTʸrEZQV'Q>_.?=Tpva4 n?& OHZE.vՐ gv+bL_]ы+B}|@7-;, 볔OX>y 띊ͽ~0ؒy+2趵޷{DO~=PSa^>I´"Og^TnZ,)TCRp0,"$ )%rdVIX>]?y_4 endstream endobj 3862 0 obj << /Length 2626 /Filter /FlateDecode >> stream xڵZYsF~S2Gs`pR+9TTvűImC6apHh&RsOO_X_Ћ^\߽|)I#]ܭ.DEDzq_یTg|-zF$NS8ͬq^Pw|-`\ĉ61 hEqD҄{nPl% 6mZ]r߳FFVecS419 xi/N'~d>b%wYiJvܽB7 qK]תi8r;l+=EV-9/vbY-iڬmNo6 .hZz(ڍmVIŧ*90V<ȕkXpv׵kp @, Yږ}o١.`r;蜃RZz 8ŲspbLC9zd_yPڪm.%#'Q旯j&1P5ȳӫe܃"\qDQf:z8f<4sӽVIN~!ؤy 4?+G 'r~1zy ci&_u cd`c 8d8\KJ7OIb@ʁnX&6vh' sUaPz> 1gmWBP5>wJZE^TwFՖ$eEV65<່SpR? [|T5𣃔 +Xo?KVȆ8=I1 _gHGɕ#l(`>T~1O^T>pX3ë&h֍'dr{4m WVch=1F=?3G9H c2aa Lu TK-\6 I&nK8!nZA 8nkWozkS*LӔ:i\Yc' SJSHVlJ!vpSBGtI‹bNi7=8-?&ާSG =J  b rҔiOIcR0R-pAۮmubE "w ɰ޺w3Xr:h v7&򝶋 @ ;> stream xڽ[n[9}W0< dAftAf&ȃ,_J8Z%v;ZW!Y˩"cs(WAq*BTIO"dި+O*(+"ϼU>ArҔw,RPby%SzKrg&ʻ`s/b;Vdr#8շx4$ȣSRo#~e+"pB]}> &xL_ĜsǬã|E"圑1 +"IW ˙ʷ))ً E)o`NYy9mY+H|(=|,sT>q;d1\v/[H!YY`dI1*5HTI& - ɩsy+JTE">a2*tW]D#yOL,|d {cyGNa c|KA%J$cDL6avɉ%fr uVˈ:x'4{Usazo&r6=:=#i&͜İsZm g֝_ Hq&qIcX[ Yc$ ^@ӫ@r5@d_[ރd4=c-kY`N[{vWd5F;JC4jq<14GV܃Ek7Tߞ?Zv%/lE)iѷnx~x<'9 Qb0"o2=dd4NN0AKXuY=b7a(l1\ P!`*Q#~`O~hL`% ‘g춢XNO~|m=i #0^r4Df5 Wj"'Q9] ݘ5t0 _a&R=̑!3|@"x;_CX~_1k/۱d+.2V ܇a?7ࢂ"IK%'phw8\MDFT?jYd#۩r41i-3ؚ#Pcn~=, HbbGlj}s/RX.zogkzo_Vt{ϻKMs҃|/:.gn˻?a*$g WV8 xJa-MT$Wa5OE0">4#*@]O'v~%HĀu"/O.G9CB&bH ļȋ#rْCgpOq7&Gn2!qH@:Yz D/Lm"x'bRDbJ)N:$,qՒտ^/G09gRٗʔzϏp:﷋r^o0Oow|ǟlكZ n&)_mb=~MElz 1Ã5,Y [ҭHt+F KB<Ÿ0`e7`ej052?B bx/gRl$9 qYN-sN$u F_4đm2!0.ŴeguDER h0rFYSN F > stream xWKo8W6P3$%Q.X$=u ,-юP=\vI6 p曏!6ޏ~Y..KP(k`y!̼O,1A`H+5%G*W#lbhY8r[vť{1,W`D(W^Mg!ƓRH>/ۼ5C|0Ÿ8EYfu.ʻ66F] ~Nq:SH@N|$L –Qnߘ+Ua._s|*5*wG3JuRr32Ճ$j(A.fI bQa>p*&kַ]Zi'*o"-SO"I3QC&>I s'R|6wM| 쪞qTfJҙT!M)h<53 O}p!A;3r&S̬YֱLc\ToYw1A١ͼP6h[ n0w07e7sgZ7JnJ7_r.atWͼq](W]vJZ` (! P#Gln~4myoq5s#Q3-˺Ff^cQ6>i*VBMCT4U c{*Q28*S{'Iw"JWxվu $C7vd7&՘J#Ba^KDFJ&m uStzNX;a` 5MBvZQ a܄#/ow/~۰IVΗ>.zW+'Vof2ϲ9z>Mb<|{u-xru3~A17|aq}5dYd}Oh|i#؋bR:t;^4/|wJku !nIhWCVyx3ކg>adX/ounv;>?yE1h޺+j/TJ5[j#o뚿$ût8Ҙ}33-mM+i]V `wB}b 4##"67Li@+̴] (~hyK~ː)@&B}B&6",kd#d\+CMfDMkfŠ*iDN]%ݭ0= b kDU[Zؽ#{MQH~Y U^/ C۫SVWfzF:LijfnpTk6gMb؛'!򓣓&wP&eB*]-~1PNIĎ;Gh]о:S 47/~)CeXF!fn>E~ԁެj)Q z16$ fknz%tΰ6xۜq{ nKp;7],Gu{S endstream endobj 3909 0 obj << /Length 1692 /Filter /FlateDecode >> stream xYK4ϯhq!-^y8,bwAX$<{:"4NͯzyNC*vQ*~7ny6 6)K#mn9h "?_=sTo߿z&u?X0U@dΏ;l'chigY_,G,MdRv'CDIhN!VE]QSuhEdcpa?ش8 yo@7*6K4kC±6>uaS΁Qʒ(DDԭǭx]=npM~u]}nr#+np3W֕qWVᶿ uZⶮ'܆*;?2[x!l^[SOQeekz^0EX]֦ǹymwaz)b 0l@1LliL ǭ=TC]^/g@_El*{xXn tV`Kvڅagt3]8  q / CQCWũyhvawss;S28jM>X?>E’ ^Kc>>wcE't֬.cH"fm佱<9ئPwq.[m*E6 `7Ss{ r] OX&g螢jz:>l|z[b/ !qvЁdt؂d<6Z'Ꝍ΋{ )+A:33K;7VMg^\vPFeqVAa l1xڏ$|UnDw:ztah]'/ G,wo~b!ԣE/~!~ *'xVKڄH!5P{`czoqϮcj6F7wD.šר#ӿ Pec@PweN6Q|Y/vbØ휅rzD8`i; ,Ma~G|q\y11f]N^d f$t,oʔDo&-vA?3Uyqx$> stream xڭْ6_K4UMlex;sx&d"!eTHjf_\Z4F. wóח^U"v@s]G"<'2[8/`< 2}'>s|+`J,]\7=Z>- 8vF볕Pq#^mUIj!sEP-uRf~7gB-7:m2]0]u, @ T&VFx늶ՙsn|U5dPiV8+B f)j'2tB aA`OI*.SMݮKR4zSM%{橥T㮈c+e3h ߴxJ-_Ա`sNdQ@lgY[)(o(dpEQL^kvG4 #دO08LlJvKhWu%,6/du>RT.?t%[Lhk f%Sf}A~^dT \]O Z@h3;#rZk^kLq̥B%P= :q=\h]R$gМ7XX+,4',aQL1pI}hz #>veg4A3/{iEٟP7z/-վd ΰ\'@uÉ xLdKe"Opp|J(_D'fcq 4aKpxCacVH, fȃpH45ޡ0xtȝ<>okC- 1ܙu km-d R .kNœQ$%>:C1=C ɾ:ymD(ԺɳcRpQU[]e,dc%!sN&W68dl!5/f栟 E7zsd a&os#\{xI$[0"P뀕a$~'K{=gL] Y>  PF&pH.xLIG|8'Yքb~CKh[&Ä^o(iQ<13x0=FM.6u^&m@꺎]z]5*4dӂ*Fc kMќj:^2@0&Q1]y!SP I^޾pqnTu4LK.p3(cCI=Y8 Y5(B)r?W>og6o<!ǹ5@G3)Ң$|o CDw'74"yF M^ᴤVu ͼX#VwPцv]Hlz׿}w"H,`(?<'R- ᖱO[qOX8}~B9EPS(~ '9o N~;Q7~LӢBJ.t:i&goU>C ËD3Dtʲff_|8[1>s{L@^ ?PCNl! o2@2!!JKuRNZPuƮfʳL,VCH͗Q0!64 o0Ahh6k՗b8ًOEltwsLۼPQ@ (;ګ(vĀ'.)m:DS kT"&4Pt=rquܸ0k{^GtD Nl.r70x)~"찞1 7x8ch8L z't sM>v!w {t{'E4j9ͅ l~"znS@SvI, W!@wE6{wu1HF{}u]̍JGz1piTUjJH>r֫=Fsx#rؙ~ı~+@:B'w';t:#<ݚyb\p?|?V( endstream endobj 3926 0 obj << /Length 2794 /Filter /FlateDecode >> stream xڽr6Tyh 2)lJ9=[e4\1o7F[sD7 pټyѳׁ(z:-`\dL7[u]myk?lQ`(bf%nz0N*p $mkNJе.Ke+|+3QuM5>IK&nQU֮LqմEY߉˔$U ;Uf C+فF"' z2 Ptw)MƦ+>۬iVaHT_䭮K؂Կl]qN VºʤJb][yuc8O \-ЬB;PWUC+ҋT:ejɓ;$'#;\F&]h&`}fq&<V`c'j"pmOrz@])W\J_ԐgC? ؙ,3Z?8AFa_MJ $QYUF4D@n&3NC23&EYO|HstAm <+$˪UDaYy f{[V6y!+ۺJX>~3ͼM*c\!Nn:Cu~ ~Lc; TJd&Uk*)Af> F>G 8Rɲ 2-:fk˪rq#4iW$k3fdjh$C|5}<[JA=:KL($0U$-jb]0̔2w?<@P!񚙖/7J9$lZ*~b,]* RЙz?h|8n?nw=OJnЎ^smB'qBljPIеsH/'`-!+ȇVj7Nʫl>δIHFɨ[I/U1)s'ɟtD=K^E)D=pcpsQ?,44ep& kM&cE$ؿԅ|% \2[I_, *>zfo[u*6]Ȩ{d`HEd?4Mq5/;)3F ?P'|`P10YK!!o*O6 y~3|vAZW]Uɾ6ǾiQWɢmZB#Y8Ι>=Qk8ɯ^U ?K5+2JT@H8 /l{tE ȯ7I/U{ 鈅#%yOII4Kʐ, `} щQBVҟ&Pwk S CwT`_h8ЖZс nowG3f`@{{F#^ &Lk;*d??4]b .ᥧ/X!I~{0 ½g* endstream endobj 3935 0 obj << /Length 3617 /Filter /FlateDecode >> stream xڕZ[ܶ~X#HIqFvh T3HIc{snٵ1H<\8Fw޼Mf.r7w7Z&:t&-nDi޼wlIuѤ‰_k4JnQ?|_5y]? ^&qPB`*hEfnUޗ(:CwǝAU}{'D=?\ySPh _6ea-8hLɬm|`nh|AF~=C{ѕcy]de 2Us?O^/C;:>#ed|\qE*8A%ߥgz/Av% tV/ʪ 0sbHEfp`8 ^,hq$ Nm'= a7- M'VKC#xˏj $#Z4ĻK~h8cF':>Ђ"/Ynfd'ʗ@Z**{h/:gB#F٨rǶCӒs3)==BO$ h֊k!B tL~Մ̄*^qX>?Dy 颼E*H1G%  <7~5h4V޾ǿuqtFP09޻H5O#Y{p^z h+$_t^qe-3Tٸ/\e0{ϼ:1#@.y%8DZ ~l FNڼX>],s]p/e㨚y pW`F/d '8Hu\W/O?Qzl٭uXlFjԴo'\wlAI s;A#y(4iO>ɏIhlGK#$6xy_O<(Ə$9;j^iThe@X, @Q -x)LU9fLյ02 b*.-f76 ڴ@D?g:v K}u g ~('cT6)P(}($g>6C5:L#76I^\N28vq6'JE ̼ź"3%2HVqOuWGzBk̡/;v>g _n/;yc{9 8?=q]fnKE׌ P֍6TmI  t;MB2/.mMQ[_n el"DB' r$ &'V)88O'_ù%F$ʖN9~}IDeS&*N&"_-D(  b +U^ Mt؆\g@bY,#*%VXE8OzepHGVeTZènyUyg5{vqYI8Na^xCТ gyl5 MTxSʆDXt-tbl,\Βa] }2ѦbcQԝsHtY1 99J'姴^ ?,4+4ɪ<0 &cZR2fՅ$ypou|% 0D8{YM hWph乃MP{܁]מ<!1 IQH%5*Yd.Q` [dwe ޓۊGzgȔ55Jߏx2.tf1"4Ocy*:Q_ěks>J .Lli61,co.}C'p"̼`NbD,?{]ʊعy:_[ۜR[>U1 R |]S;pDL +US.o|\XY57.RoiMy u_,?ОKHD<ɈL֛C(6Z]ޙ?Wh-~fasNvX0Ñ?K18f=SXC{,^~p,*9wbS C~|` xB/ī+eC)3A8rҔanKoZ'Gdڑ`'}3}LσO \xI@s4a]i x6z&_oC;ݱ)~3|hvp2#m Ŵ^/+{$tqpDc&N[K$&yٝJET) c!tZ2VjV^fiZ)^S>HVW^܉]WGN/B8ʞry++> stream xڽ[ݓܶ _zwe=~h;vL!L;Żsy^n3 pZ$=œ/XEn]\\.dmI)ŏPӱZ/ߤو]V<eulTX|sjP7suyij=D|'wiD%Y/ P?U8k<pRO'_AʦI6QSIߵD%1`|Hyw+3ew]ﰭ[}U4ɫ8]ޢݡ8RI^Xܐ2'tf|*B$֒l_Y6M_Ypr{m_x'yM[K!?P*$Yo> ܜhoMYhH[%.oJv glw$8 >WfWe4]"t>PJ^gA.`9aKgqQ"go1/o`۟om ɣM99 H$Ҥ46WP]wxU Y.灀 0 qdS/ H5A-D?ީH|EkH2SnУBvc2Fpϥ~T1R:;b{̴gݑ\O#TgD2}V%⃅.N;N2#ͮA:.a%LSWK  BPRcG]. ͐v<7Jxm]kCFv [ft46=C%R?sTT_Ihy<d} uA/ VP4*7#*^%e( CB|Zm5,wC9}r6am5K3e1~fR8 UpRm!m&!oNN\,Ψē&ȁ^+a^~ K֙ {ߑξlRZ.]{wx +ə]PS(N{Ԛkށ;4Խ}~(4Ejz̪kO iYӘ_%玎 TnZTB@.! 𠌥Nא[{M},Y,!!/,u$4fI,DHSQ4D%$HggLFC:M̨ XGyu;b𥠳.5QvPdanO]\rzjI  WO+,,FJ6 U5r0 7tAOح/¯Tn7sa}Y VooAIJ )盦[=}]]|=F#7GQ.mi?0czH*_9B8L=VӁ{UT׵/˵vt>8]O١^=흵f 07 Ex*M\o_#dzq] 5/-͟9ԇ#qrǻz6Ůϊ0YBh*<<\;ӹ=lfE62 xP7M=>N-Q\'hnlV~*aW‘XI 8&LP Aۛ_|݌o_v_mDNCBW)ϱt8֟uvCT/g"W-B<1^6P5#F;@xU'V endstream endobj 3953 0 obj << /Length 1291 /Filter /FlateDecode >> stream xYKo6W>@Ĉz@EM=4ɡ@Zcv%ѕP$eˏĊ$L o!eǺ׳wgWAl%( кYqV1 ĺˬ?nN*D#ǍaV*jJ&qyk3m/کRAz7E!JblGk "h6&n08nh)j5g꿘SPhc>:hjz8Z2#FWl { Ihe{aa?H$oS\nH+7eR2#X53^ܠT3@f )Qp*F zCQ_}"D~s3Vs L,'a0FS>GA=.Duܵ01Bs<X/QFiF(Agh;\a( <)קl)PMhmng7тZ˚aq_FJwbJBH; ũy|^l:qqW1׬,կ`~<*+ɿ5Fkz Nl6ֵ;4<6mlxhQ̈́k%YLm@{ cG^<PlUzutqQyJW(U$25)x͠~a3MQ3Sre5d/8uߜm#pS vF̗CJ{ܸS"LH`XdRRp&HuDB:'yAH'~@;nl endstream endobj 3995 0 obj << /Length 3679 /Filter /FlateDecode >> stream xڵZY6~-`guRfVVw+11_%3rj  Tpu ͳo*HFW7+ X?R^Wgؔ8UqdLb,wQѠo@gw9\mD'aHCoFIuE?VC8طk;"uڷ 0.YÍۮlx8ONß\u05BrQihd+\]ʏۅݬ "p݈Ɏ`b2b`˺ݣKyjEGQ@ <"Z" )b7|ae+W0e,LSnWXoBSԀ+Ce<(j?vb8BXV#_f<*,ĺ>䆠A 0S1ba ;h'a2 QHI=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ʐ͍lt,|;3[d"[|N=3zN`h^qA{)·vHDd +YNbYr>y'hKN4/N5=^~c+p/)Z&9X6y5}ȹ^Мt0{tGWt$\Ehή%T+iGWzWOwCQ3F{.2`G+#72+jiEy8^}RҼn.E!~7Gks>Xr4޾na+׆w~~'W ?ZBП.!ľB^YǢ`L4W-6uBB7ZޘR.}7?f+](k.хnS TF+'*Uב6> stream x[[o[7~c<^( `, ,'ڒ!M %ZrdXbt/ߙP3΄PJxsT"XhRJ$fSb}"_!("< C@%C̠\v8zXr}$wuL{|HY0>={#'| /؃ Pa$1/xJX$PLx ^`qX#euO<@%&UPc(^D:MB&5M5Lrg`[>.aR$vH.(2)v W0!a#.#8:#)tE*<+1g}F&{79ݠ9%]ɌO*uɒu'ST]'SHy%VCb92Hp]w L J `u?U+ 藇bRH"1Wr vNE(9tda .+Òu-5?W*ѧRp@gReW )by : &K6pt||Խv=2݋x2?|~ԽLF ݛ?pn>BrUPb L¸tL^NśWvz5q Ȣ!ZUy  NZ њȪD 6D5noS{q|\w^ q|~=~jFdNUzv0Jz$bS(9.ٛE"w"bZ@>_^];oaH|V}6H#!nqdYc68Q2K Ϊ3ir dcUQ v8sҠ_hZ%ZzO?@%[P޲}ݜ+u4Փqj_N/\^~8afIF#v4ڄhC;O&ye R?$2i'H^4-~ 7?2aX{; ߍ ӽ}}b?]|uhj̢,ڽҫEBVP+k5oYgmuMuY=%p jyl<Мصh%X4 =rhr~=b (Wu(7"-fa}{] yjpSaIW/mB Ю·iw#kUsM;F |߅5=&sa\ok=y6܃yQ.MzP_!+-ţZ% y[rv|z0t_C]};s 1P i6%Mf%q)eI_^O*EgjC=XK}TeD-iI>'{zSv|G=skSiݮ1,?ߧGj^2zJ"(^yn!ާ@ph'vG=kú@ \}e&;kF};kFl=$~3-\x^E#?Ӌ5LIH;k3M<𠽇Pwlt wSM#}ɕ@t15nyjSh@j@jRڬf6,nE=7 fA܊zn+s[Vn=Hz IAփ$IZrԕv+RWڥri+ri+ri+rv',NXڝHFg#ËpmH7i%\}i GY.vj0oǴ?jh`B/0|0frP!FS+xy8o&zb#/#df(!H=[F2p,s˻jWX=m~z > stream xڭZYܶ~ׯrR=%Ɋʊk}Ljv\FF_7ƿyoy/MIo{aܤJyIW7Yvw_I0Sd0 [_20 }3݇A6wGv@VC}G}( ^SWW.ڊ6Ϧ; /ӵǔEO{֥]OYaؘyq;*v軚$&^ vcC;V;<6K7|emC1i*YP+.J I3Spa6I _C#7?M]3K4K?AG>(]4)':_@STxq>dBLS ?͙"ChoeQO@aVŻ7qvx$0Edؘ%b@}|8ׅ/k XtxޓSЏi=?ay&lLH̎_8ɱXn| iٿиA y)RF׵h -D=xw_q}/0~p5MΕfjJ(?]?72y9]oeLmQl0"8֮fqH]Nga1?Ly⾦/V<2! ~^vcb{ `]us!oc[bZ}A'7,Ǿ`{a>$f,RG|yNcĄXoŹ$ɴOU7jx9R%mQy섐v\gwHwG ȿ&89l˒R4Qd'`Q[NuP(dšdez[g;ED`'J <j1Ef)Qm >Vk1ἨA$ "ujD-mFx@%! 6ʖ786("mWkT; j;Q52Y0e\jvH0Hlo5%si(61O Ͼ.- x5€I_k8e\0|J=_4]VB`b 0QxD>g`+`Msx }:\,<N"W8LcpyHHR"NA(fxb2QuRnxOAFDz(\OF-p ]|@xJg.[р$,TmB5G @]-AB8vo/y!=t ϱVr”``ZLzĬF<*I< 3 M^7(ٖ~1 ^<c`I(@hr4=\C3(RlRp:optdY{9o?|*RkaVƨ@ bjV%z+{FJh^O5BCF^AINÖ$[l iK@ek~]"sM*Qtz8eRH4';ݶ=GlT& I<@( ˧ ~]~5 1!mm6tY!!,/ f-q1;%2 $IbY>] x"/P'x4 ?ButF_`V0 H.[db9d`(ЙBRj@DByʰ03gh2jcKbyId`q0 L)\잕1cϦlVǚ 4bf7ceBQPw _빵qu|p07.w,#_ĔU6!h{y^~2TJYvmp3b~7-]QoΚ[X,dȰncxGx)JC.RT! _Cr!R E6E y8 Bӝ.Ri+ 'ϭ6}7{~fSYMVC[0".}(iC4*_g>@!8$0* "S(yNsr?0 ~Xs5wR]ftT((M7VˆS NɃmxǐ#f:ʦZ3.vT.UVQF 9V&@Ҽ#C_AGd^]W*['FKA/{d0 YnXE$MCo\ȗPY&Bշ ctu! 0> stream xZێ6}W e{7-%'N%[VK[*h3~hbaQ,8Փg/ 0dJgW_7MY_(tbq`#OR$pmE[KKsQ940;j}MwuQ;At 7jo&e7E\P0EID<X 1UEiM ]&C;Sћ&i*k޵:Ak$xq@m'|T(6-H9}uǺ?PnOκ<3TL5 }뢰0E.`ږZ୲5 в n*a.[m &AK[3K3,TUt0DT՞ Y4=՞l6UMq30?@.KV-_@U)ŦSKUy~ԹChp/8w;ն =잶WM(B7acNZkS*gLנMN{ @-5% ?ڃPMi*:d]RE7`EJYW~զZFWvMuSZM׮MC "I;_4b^ĭv+tӑ`M.M98oAnu&\\hȿUC Ӹh5MqrO]K? q `M$k"Cώm]]a"(%LTO24:|j+/@SY׺sӈBRL4 vLęn|%FzޅNaYcH]HqO, dA."ƻCU6`d\S^PiV(cPd<ӧ]Iyִ\أ?u*J@|wl~^^7{YlL\G]OѥA=R ڙ b ^_\OnnrSHe_na;A1Y}oJhG@;`,~v󽡎BfObG>_ D~ ޷]i9]9=KKY2>_1HX;p'Mۥ+X@Ԁf2wxm/xQ>g hYdǺuOAjW{ 8]ӿ,_׸XYGo$ã}MdbxίY>jB+l#V_m,(K$OݑhiuR':K M8G;DxkO`"gphh 40PY%U) m3] ڨũB<)@NSP4y݋525I}$T0В @AظD¹{JB{~,9kO!3X UF2Roup"dA (LWD~[g6bT2lt ֺ٘eKކ@&]o\1σ;#P kb-=X;oޞC,bD>|kP˗?;S  X l_sD2SJ,2QaAf);tfx&tXU}9T_ʒ$62Q S87zY(&԰#ׅ'rǎxmcx,d;׍1.@[8 Ь'@UxZA`ͽ)X`賃b2䒢" %}P=\h,PLOdt )'0uvzA>O0.NEpE[_wQ28yI,S-/UK~&,pb^C#Π| ?5e'? nId2[myPhDÛJof+b0s>jzڴUM͋>-1;75)hObw-ٶV-5p G`/(fI40:*uR^F E,B7:^gC:bsh>\sH%js( [./ɟdJPL7_|d1L4|Wi`dPļ/^@ȫTTK Ȁ1ֲd"m5;Fm-&0#+|_Tmeo:"# &!P.u{LAqC^7ԦGn#1B1.4~-_b?% 4') F?(:Tz$_!@p2-EJO%MmO(lX ]^Ť򁉝K&. '&)0EC܂#or{LSJ{ez`cWDuȵ8g-YLlvirsaJXU!#bĬRc:]@jtWHl1S.:sˊ ]f9fY0"$SO) |mxͧ 鉠 56p So]O pǷ jbsdl#w6u;j( V,e%M@,,"hwUx/Q,- kw0,.lp;׶RLH&B5U'&a[t.c]݉Mh.8'#:.a`yl>kO7.kbH6A Jdv;5uW~k̚/ZPwpFLI59¹>N B./Wo՛]_ιa [݀7c>E*~GÏ!Fl%+A GJsrW>Ʃs:'c@93f8G~xŚId67;er o3wgP:Y@yXbH a[+̮.hPxxx&bsmOOp.⒦l~&*;횽dtg&$c)lm ,},-0ڝ~+`NEp0ې-z_t endstream endobj 4046 0 obj << /Length 3252 /Filter /FlateDecode >> stream xڽYYs6~P!ũ@8xjJr|*ٲd(f1)cۍ eyRq4km٫gWw_FYƲXgw39Sa|bݭ~d{{2T0.SXjkqKf,U씥LSĺ e"X bEoid%X$3?gyYb{]M;X?!aKgASklA؈b׸~Q{ݺkZKC#`l)҈ep%!"֎xP6E^Rʋ58Y9^Y Bs2aPW]ׅޣ240糆Ca(ʰq SnP-8B5Z?nuM>eLqvۦ|^G6g!/&qc>iʢqCVɕ2 Ib ˞.%R&y<,eeR lںMhh\'Eq7Ë5=@$Uv\vH}7v^BPS fЏDUeFZ)p$b 趵nh kބC~{D(_5`V=o H(5mby?!y ,j&E<1y-Xi}Sf)e}1n<9*;d2M(@2]g2jR.$/vm^TwIa4W%@$CȀ󛌙LSxAX]o4ۦYnRn4< 0ЮA~0>Y[7: S'>3Y5wO9Ws D-ַ8Ddwsl6PpfΖ@+Ƣ[Q<9tƋ8= -<\i[ywiڊSOJ\dN,liLHIBz5>D.c|xl[[]\x Y)zރ=pCx 51n`ypeDHyДk+G,bD>߃gd|L?>|;0m 'TQi7?<,Pgn~]?<<0b /9FVLTNmo}Y+W Fkun j+ ^,A@V7%MhJϮ[YhD TKr5諣|b*pl0X[b} ʑJOץa2$ہs|+S@-9`!19^6yxx ™52{:r"+.j23~ Ѝwc;8&> #Wsc$PE:Hɢ#_7Ŷ7!"28y垄HQ<-Y7aiWG?=!8j"h;ݚX،Ôt0•2ҷF q%{AU%.#  2K's+x65 ޚMyl#FP\Mr~aG&Lcg0?F3< Hr~_f7sF x"דQŒL;sÀëC%Zp{6׌ü5OԐJ2L!%І@iɐB;F/ y2\9~C]IQhTS0s1n> a :v @Nf."|BOgy'|B<_,YJSx 矊gd,gb"괩vPnQS@+tq#sRegɐmɉwdwR[gXE 4?R)8>p@ d_7,dezpy]?no^,og׿M./gwXo~_o,IHz/!DeM<3c5+ݵ.ݽՄ-`ުtqqPSoOx)$,I#xJT ,fLT4`H M*KBq{aܼe$>nP Gx2B nW$ΓU{qDז2{ }B:Vt׆q쿵L"X.s!v*}&.#C9ˮk Cr$4brpUHDU֢ҒxfYE ׸ dwL endstream endobj 4052 0 obj << /Length 3412 /Filter /FlateDecode >> stream xڥZ[o۸~Sak7T_-`N fb5d4 %I˶*PfyM7v5y\4p[7|&2IT\ E r t`]I$3ׅLU'ij5c V BX< }ԅӅ}9c}V:Iw4n=fU.kz3@߻SuH' |E~4un oJǯhx-&_]#"c.T&pOۧbi:9|wmV'9sdy$+a@ʘXbaI(/[@f뚺h3ѹ/l>eSNrMں)K MIm{4*–wNk`?nZe РIF%҃^:4fedȮuK.q`Wu >XFP{Ԣ*Gd;o!-LWw*CgtHwXL^zνx'K %$s48ď)GƑAZOn4':*Z3;Dv ݡPV5KA=ubii]V5mq3Xd-usDrC!k6ՔO>+G!Ʒn$#b7h*K }n= *Hi ãOD;BwDTz8Mw@#80wa.S!`*΀测Bjrꢐ|vW_QHngUFCbv+b4r!HMĈq˂%`1F.2w8\"07*29X  @iT;bYTGԄu ^ ]koY%ݟ}Bw-& ϔ[IиʳqvhєUX@ccy!wJޝ^e-ݻ'h%=bH]Y*W#rH5$Lw3 +n*Y ْd8qq'eR.focdQ b/p^d1 h$W`bwNrcr uUULⰮ}5 #HFo|ԗ}eD6qxXnxUtGy )tWj;LkvHtJec\2?ۭ/ 4vXqg瀄ހuThk^jzS`:=Ik}^2Tg/,n7Y]qy@Snq @$ܺڣ| SyZqO+{K,jiC6AKb#=A1$XS ~Pna@ҫ4G PϠ3u x||(WТ iѨWnuGLFvq(K-8i'.1 b áyDS$3ϞvUlafWzyL$NXoEG eF_:/cТ!+Ƈ jtxzjz㏯:~ >›=,yyc 75F .6D Jc@UcV?v[qWj}4 c"14=mA$dɆzOz l$ѳ$BU{P RR\e<:ej=vĔ{tA=, \AxQ^<^}^^Eu8jѮz , n:> 6>zoCY_!)|Nq#˻c`8҇WBiڈbǜuK=g߫hOT}L>dv|rȺC.r 9p殀/?**N;גl*ޝsIdw5 FA4 Q}cv!sJ'c)YHvHÓA;}B&aS KdR$6H`,`CF`.TDnwG;+ =]9Pl6=85Q9̜Uz+ɟMD~0DyOTjav 2I`rdŬ- Uv54H6ejHv9\t{]ig[P(="v1{gԻ":(د`BtwwpJHk,Vv7~jco6|8e|kVDםĨ endstream endobj 4060 0 obj << /Length 1710 /Filter /FlateDecode >> stream xX[o6~ϯ0a;[H]E i=,{`d榋+RIteևHyH;Cƛl&䧫odiz{htrM{x=VꂸM$g-s"Fh4tBu"U|߃kn k3{<`a ʈ`U9ɩf+͹Um sR|w}Gp~j=zc'W3@a9?K T*ՊkHMd¸azPшd(fZsEeǮ5`nWŪbnUoB5/\?ЈDnA9OtOtz"ép f=2 HfY0 vnH}ð!J|;MR9]OQi& *ΚPYUvrűM| ʫ9xxLqb߷rg#eiWȻNqNq:qu̓?7 "9TjhdR˩&o% ,I,pA@/S5Գ: }E(>W#*\] agdz {NkHuT4y!+7znLKq'RrOpT% Z*$Ҳ^x1̚yDkZSoj]UGrK#)3m2+"4s=R)3y( J8 zfU`VҍeluV0뾁܇l#ҜB<8iଙUU*DL6%p$!ۚPS{U䒍,c'.PrJ%FŮ\Y JNٛz)T440QcUR&7)yvSXDfmόGvوg!U2Tm $dH$c63ZתE*3>+~N )hi|[C1H'˃l>QI8k9)衑 >x$wX] ; l8e#B|9 xě.d춖¬u>r+$G~|dzo=,~߃_WqţOȬܞj]~lh1zQ= |^jWёs۪e V/l]}yUȦ'91ѬL40關ץ!쁕+8o1ъ{nUG|c[#8JSK=m i˯ix8kI?/w eC(vw#IW$JĊء5ר3hrgw]F[ީjH.h]#<ԟ)U{.hɆyN ]*G3ԗ$F Vl}Hy4Z׀u*7fnK(w}t֝9}bޝ& VPZݕ ,ݢg={u'A=ڌ ֬Ut𖮻jB,+<4_)hc:ɇMXz֒g={-c:."=?}<a: endstream endobj 4066 0 obj << /Length 1129 /Filter /FlateDecode >> stream xXKo6WMX,[ե@Ң@|#%F]r֗_$vz=l5~3qdY;OpDnBgr|sqL} Yo7@nU??Nf i2%8)tA@l0Δ0HofAă_.MI^(1Nq1i-b-sl"ͤ@$(wf'- PPA{YCs 'w\b=0F=^;XkE¨I@qZ?.Gf仑?m`9Blac 3\&JDgмб6V`citg[`T%R'8;`&lrbӣ)0U蜗/Bzҳ,$K U'OyUu rRC<P%xwʔjw\`U|()&b-b`Qzi,Qe2AZgv?4u2kԉjrR 3^TU%ia!uqvr:{lݒ?Rs#V.5sO0J,uTľ*rQrK)O)l$N^뷪 Chyi A1;qIm iڂu.؈C圉Ȑ8ĂXQ7rT8nTvzl4q K3GF:Ze}K:??:S µm"q:$7(tuB?ZlUJu*){ {_{W3T;'jPrlRAh9*SS{^j/=kF,cօZ%:FpZ6"wStj]7ap*lmdk8|ZV _HCsłv!3-MI_<^|Ey?|'Yξ]rאBN=+8liԀ(Wn0;579nRVl,6tJwWlYc endstream endobj 4071 0 obj << /Length 1239 /Filter /FlateDecode >> stream xڽWY6~v V\:!MAESDJt|V'ibp8Y;y9i1#'Fq@grƈy;y37{.z, f(jj9x`scN,rY\3xK=#/Гje6W ote­HQ"W.()oďa-yuաcϞ$Xm6} ʳhdolUFclkf2YƁRZ'֣B4_ q .xTC|ֿ*/ XZW~*wB_?{^g|[e0VbXASGFR4" ןbׄ.vHHza$;줰 #Њ BP1ΝC-)iH qX̐utjX~z<8}U.t1jROUc2ztyn$v>nfWQߗ[:8g:!kc4}g!:۶G!Gebw2ѩN:îd"ia-[Y BL B*aRievFnESJhfv ~uTRo 5%> )Ϥ+YYdlN]4%9R?K!ixIrq RH x(pkb4Ώ>zRa8~`lf1hj{5MipXîHoFU ]hbN?%GɌ2yū/އ,vo7l5r~2~sĊ"C6EOŪx&>IoxY=#xmm>x Z|?eqerw1;z|1] A'9.c$x 16}Dw-k![dfQuZagZKu]|4 +D6ʞJacg]>m}"qJs-!xSgǧ4h8MꂸͼZgz3PxAJX> stream xڽ[n9}Wqa)xI ܶHݎ.N%2qe AJlXU?7hXl87a4xު1-wCdr[= 8X I"!rdFm>Loy aA N"o -ߏh֞7M;m`E:H8P"VjGJF׏hތmjQ:? zv^עI)i9Pc!䓁ŒB4@]{>;DH+ aF`4_U\)a, K =(y3eACZ]+2KX+3eӶͼ2RL 6d l6ebLd&nB'2}L % xi\Z@nR/_n8ƾ ]PB]5[%gW(3N {=Xl~T֐R^f؍AIrҝٲA އg\ժ3@DX k@ rH@ TiSY& Y/g kys$g j \8(do#y&HG=PM1H 8f҂IƎӫx0K8/CV|ѝ5󚡍$V$2| X tnP+@{_ҞMh5wqRIvו0G.@/ !w>b l 3\ECXΚx:VD@[ФmF;pQ掭Xp!kIwT,\c$#8\m $0k3\?%+4/[I>@.`@ `#{LֱH3lQHN0}\ֽM!q2$x_~\3uNPaz hAbVv JrxBݞV V,OkQ?^L=ϫ$|-o JqʘO/V3y<4"a"Ym&W[ݜo-Q֖,rf+o)l,*x6KEv] nZv0?;dxq)Z͚ f^1s;;ޝz;ՃڝQc>|x]}1Yu?YߎGUd;p2Q bA( 0ѭLc!WVݘknF%#`6#II]8y6j/4O6`ͦPՒP%Jw횖2B+*a :i)o8(Fα`;5K-Er RO \D( ANZïG@;(^16 V]4kh?= Fdo{/;C꾬oM<MhPQTHkdscL lw Mt)e WRgbN|Z.i%e0ZT0uQ4bԢECXJ 09K p6i5`Մkޣ)JNI.r8P}όfH\&s=_v06%N(งkU4Gpbqͱi`jY_HFm qI/4q@>w U$TIhŎD0"ef9H\ g,@"3R@'*jH&ʜ W9qe\7hmC3PUN3ꁥ'<馞?YzWpB+0.nǞbPL> ? /P^>k•~T6WYZL!e*a{y~-:NlrVI屡?-f+TRa5N6\rGlP-Ek9VHOo$=Z@#˳"p`YʎƐ;j`diEYĭ uxڧ3]TvN+ .YHHUHBgTMkjFŗ:"DO-'@H Z3cnъiibε&pG\3(VjFOU.OF\- cUFkZ6!0 3 IA7Y90kj-.p M뚚f댷N_ĭroQP=-n7X;G@Έ:j7`ZL$Sr($z%)$I$Epʰ'} DzP*$i?NS'@/Gt]uzdhşQ yQWY/$8pp&WqD[-ͫ Uij( LoUﾩ*zcA^g_}c8+-NS^4'uyś5A>?#fu̩꺦ҫkϪgּ$i6z!̱W17`Rdb3[^N۷1.2pKmz!6ݗ;(S.]z ={]i3~)B endstream endobj 4092 0 obj << /Length 3020 /Filter /FlateDecode >> stream xڝY۶&\jƂLS۱8c_N~(HB‡ǝ}wK'X `/ȿ:\W>yqd:LRF*_I:b)EӫϞJnn^GdNbIM])>yydZG[V154[|q8i iL{ }﴾]ˊވ FݙZFp !|. vu7)Mյ({TBʈ]KanʬU;[15lwV O$W ބA&s,l'>&( ex/2AX>I0UfQάIZ" T4d!uE_5Oܪ-)$VlT흵}mv=Ep|tP_KtA]K o2[ 8pCH#uVcZѫ$C_xU Һ$bHN%u*f^=[44ʋ z s˭2F R@$<ΒKV}tlVYUfm=,f&?XOWH$$?ԝӝ;׊8cٶ`J{2E;a-me^M_v%YCWwGpZR-ϔ*LupQx\Le]{=O eaτ E"G8ʇwMfInR "x ^r|xHt|.4'xN@7Sh`A2=F2|> ɷVD!(t vHJ$K=+p0aLi#Gq9ĥ#8oNē5mG.{^dnfNV p6+d> F -b.*2Jac"+^pefɈ뽳9l#U!{ qq>5\jH2Ftuh='ጆ&kn;FuvA-#GG{[Wl@ë͈́oP5''ƟkL_n4[g܃[RQ^C9K5h;8m@.7[S1rg';[ R!a3b %˖3lܬœ˯s ̖ 7fw03ܬ4}@JXCzj+XՃxi q[+P{sL~YoT ?nusHĮ bP]:vݩźeQ6Qf1  ~ S8>cxt-ˌ0ܯoxk,`:A BgZ {aP.v\{lLێ\~@5֖a%DceonJqkguQUD yN-;y,Hݻ#pbx}(dNH@>M tA!yTꎢ>f#_8Kpl#'GsAߗ 0B^ 0Ws9AٹLe臞"0dg Xa+04%H4^ VZ3x sozX`ZXҐ9^D7YIaB!ZEKjgJRl 2 `R=IzI:GE,RI;[ڎF!,PbWCq[&wRxJ[A܁o CXI(K Un >CQ0<15NiH<խKZ\3`3O۷-F 6o/6tmm᲻K) O'*4t~*w@~MTi{ `z="kk> p)|RJ<^, |v bl ssܞZ EtnM>+ĿM\"kpѤZ85=Tp(rd@%_Q9lƒ~ .\sA\ XBQ5nMZ#{DC%|*Sڏ7Jk?b#3Ͳ^‚RIRO|.~F`YJ̣Xʑ|3zПC3 fD"mZHɘL<(v 'QN "cHȈ9FF< oY7 ,鯥L+V"H?6%צ-"R̉ޅ8%~Wty~-y[3D­u1D5.a>ٲ/ׅegk5_~ Spnߏ[E8GaCԄSYԄFIGM _ИFM.DMN&2͢&CGݘB bTJ" Mχ૛'EO endstream endobj 4101 0 obj << /Length 2472 /Filter /FlateDecode >> stream xڭYms6_Q3wuҦyN{D[t$RCRv_X&eZV2Xx>@j'o:6m$avr~93 J&Jf&Pe.ICg<|b2S.3`"wyZ\Δ_IBslџT*G, x/nHb &M*ov˼HdLShwu^\Q*+*]gK\EVԹ)ٺf|2JMTtdfv^ ׷`I,ZF|$~_;.F V0Qq7r4|Y欬35;cߟ n*9tk^eDo m􆅆UdF? :$s5YU_G2|7wEYMV4d((7Siv-M X|et@Yq hu7+m?%Llt]:XoɳQ~H3;L]噉K*OaIDE=Kƅ<ǔ4'Hqc쁣bQ ;k &Y!ΧD\RG@ A%D+mz[Dd£ty j쨩Წ f1'"/ ^` IgE*k09" |8dUK$U@ϚUC;Qsqt[O+G`ÇF6*  a?8 1&,L1iD<A$:dtЛnjM1i(!Id@+ `bq Q.A1r d 풉aאgBkY]O ("hݬ:od[ $0;E9@Zc`|,ei  _p{w^FWBGIw[fbs,(a-("?`7x9}bpZ*[ аcۭt 7N7Tk!T"4rxl=&eɾ^[Ȼߥ櫙+-?-:^ y2$oS fUsG@4rtMP-z~, M`FF]}?t%F8~D:&ݸrm/]gesVSldryrU[o^>M%!y W|t6{2UxrJdv>;&P㎸0/Bt&< p:gY`vA \"ne\#, wl>\>\epp /x:4]T@*:~o>G/_,ch?G*؂ϋ3[%oԋ_i;Ivt endstream endobj 4107 0 obj << /Length 871 /Filter /FlateDecode >> stream xW[O0~﯈a v6mF&n,q H>;&+ι||6ލ'Z|[ [Bw"kZ{8 /&Ǿ!Pjj,A`|8V(TP/htlG,b4wwwm½YդW3VEc]X )%VcUЃف2aBjWCN9_hpzȝ^D(E$洲+63Z2m iFK!t,Y A>¸PXf|F9=!ez% rEK2?G7]ݮ79)9b˜L1D3E`O ^)Nջ # l1zC6lC໎ގpmSb\vÑA &gͺeγ¦Mx b6&\pWYu`,&AÿOP@{2YECZ]R=#9XEQ8i!y֢Aݝ6qIY*#ܐm22+83i_1A[Q6턭tY>jL3ZVu-Ț[i/*MZ&lzKk,k: RA9h  __MTm sźg2j+`gX%$Od^d)Fe(j.Τ=m) r9t֌ɕX j`K :xDN bOH5Uq;v4ixGI?=?FGѷxA Ŏ h@(rsVHǑH gBDa{I> stream xڭYKϯ0zkcHy 6K62m+%HuOYbbA:XW﾿ݧ8\e,E?x0ƫslu_kUun>E_f1K 9Ne]@ w2[Q.5eS/&τ̗jSe݊(X0؄;fthY(RwO( {4k_oQcV< 2ΑoYSQTxd6Y$"b{!ґ;笯K$4^Q,~"vV ھg4b&b 8]^7[` mŎ֪<<aq-{vfsd>&"\ѺUf4vNy,qvS&iKd,M0nrT)uӝY\^/VGdFzIUs,)Ǯ<ٷE x ' "NZ ~>Q[)&&LI皓:G`?(Ri!"C0)Zf@hPBHgEÿ@.++J tYȾɿE- m;ο.j_+f|Om}]I:) c2Su$0Л9+mc̚bbc#&liҩpmޫM-y_|&Q0st^E_a_Ͱ|}$EC3ngd;& $cic&nk\u\X HVkꊦv9O^Pϑ7IBEmǰ iks*39 ^>Pld=;ay0儀23H^Գ:+CSDK*Wpx;5ֈ+ -0@k(J4h&CUh6d/NZ-"eT]c*}!24mS:CY x$SH`4<:g+M.!d#pM8A|L<904vj~J8n ZCDF\ VK)X5]!F%JJWkpd\ڹMx PxuHeT<}E9p_ O9cYUtҙyaft{υ::=<A[GOa&b͈_>zΕﭰ䒉ݵz<=}AnjE87I4b#IBf8-ma-T_K|!9'"v+ރ b|4uqRx$ 9' ~5~s\ lEbŦ5*WΓ^%o?nLSۣ2F\ZP'.0$TˢEB{îpT{y ȁ#^byef|/ix\ľ5|x a0ŭ%H $K Su v.;mo"|T0:hh46H_gM S1dhlgE~pΣ[0n)'g6W[+S2 [d <,{'dGɥ&:l3V(`Kc-нvTF ``”k!dɛU^ 1x*Ӆ+}((Y#L/G}=UÔ mGrȇ }Z5dIj*=tٷVw۷ۑo1]*c1 $rPD1,j,ƬWǦ+J錱7򰻟N?,}6-6}]u v<~VyLJar>Wul:Y1!t"~ 5܍݉}%z.»FnЅZDO͑'lRvJ?AfL30RDUHvRk5OZ endstream endobj 4120 0 obj << /Length 3247 /Filter /FlateDecode >> stream xێ}Kd`"JT)rM6!'@vW,9}6 )=&(`j8gs~Wڬ Vd2[ܭL*eXTǛo>{53,X[ļnҹ}g#s*zFq/C=@@bܣ`V`RIba Ư @ ڝ[A|{4&@`#x& `8c^| Vւ'h^Jdߖ%ɍ',j(x;v2<\skAMm:֜GNnJxUOczɒs,[WFڗթ o ,JSm0zzl4B_3 ^FЇIŸ1 9 \I=qKxF08)aʴWyOedvQP 0X¿K8(΍v8I9.o' 6_}F~_odeCC"}G& mOX*R^ۣA>Ҝ=8ܶ34kpnIp#a!gd*GW9CT]k Ok'w w}KocUWv2~lZ-#vidrpƃ`dJE"G# +^$.glxFZhD:; ^B?mȟCWCc.>)08~Fo_L!T;Xj|yEdq P 3iR.3BZ$S5Ө z"c&OTJH*cE hR,N2&g *Y_$lن=&[ʂ) L lsY@H!{?<֤dy^x W܁K g|R36_H3DBaB9};% hHp;VƸK{x[ֹ9sQե(%y"(n.LV&+//P:m$m"u1'W<#hP+}>΀(PSVPxpRflfiog@ @pr-6,i<\2R9K-*}PYp-0T쬮KB਄Yl'CPNmj]̪Pb[T8C@༊Zx AF4Lv-B!%@O% lBw}7_ l`j{-CLI}-'c54B t~^/35XäŤj&]革XHU-Tp3p)ټ(}Tu\A}/HJLDhWc0"^r/ٻ=2 8t/Od.][bFP]h4x{&X[BW󜌢>l&T Axɣf.0Pol]\G73gOE2CٰIgY1}h1u>4}ftK{ïn`ixG}cv_ #W/H"/{sSzםu0'|ѥfeiqxʑpfLQὌxV}/~TU!&eI K$KP-]t-u}];{&Պ_\.;- endstream endobj 4125 0 obj << /Length 1197 /Filter /FlateDecode >> stream xXKoFW9QhrR4nZA@[+(E$eG>R"j0Ïf9#8~1aLۮ fu\5U̩Hztھn5? n"(E u5 `Dv&Oq7`bFr0!@d-B76ɵKr f,ڂ_y,!z qL6K ]D"XnaBup܉!FT2.<}/nbڙDT8f&#Ȉ"N0F3wՙ ܑCIHH:f#.uB|A 2P̉Hs҇"xk9Aڬ!gP<\Qj==;p?#gFE9]+?KN!Q(xFN)d;3ݵc #J"C|?ӵk 3"R|94".k ӧ҃6M;+ (I~Dk8Ceƨ#Y;9]$ou)zov_'// mTf.Oi,A6:]]Dtښp7KLheg˦Ar2JhK⮬0"ˏYr:fu /;[?-8|q`DR/ALTl遰hjɷ Ӻ1FNP}/6L[ %cSUr4K/s3-! CՓǞ'I'l{ ;춱o SqVH(6=qVPCcǟVM{f7-}/7ٮrm".t'/h endstream endobj 4117 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpvwx6Sd/Rbuild70522141f9a75/metafor/man/figures/selmodel-beta.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 4129 0 R /BBox [0 0 504 504] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 4130 0 R/F6 4131 0 R>> /ExtGState << >>/ColorSpace << /sRGB 4132 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 4138 0 obj << /Length 885 /Filter /FlateDecode >> stream xڅVɎ6+t]ܴKL[292""N}d- zlH $~:^2H<9&p'$Ur$X鏗XB"/1Uw3չ ~9( Є2I(3,>b%z|.^~gs?8<hɉXojP?dGij[5*YN}cGi=DʨLKpYNۏ`mm^rF(3!d]GA7s=@ (C܈Dp)((/዆C Z.8`7OM*zVj+9rȱ|o2di`kc`.Q_{ 5uߨ`t^Toc!DR@ꯠVJYw_.9'Nć yLy:BOď)ta&;]tjEE O}vW+4V*XJJp~-u#QLOY ~niTG#Va8g;[39x1_&y?Hgc~wmy;rA Oߛ?YO9y0XN썭 UIW\w xӵU^A\h>P`sT=dLMS†sBC`yTCV> /ExtGState << >>/ColorSpace << /sRGB 4143 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 4145 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 4148 0 obj << /Length 1719 /Filter /FlateDecode >> stream xYK6W{\>E*^6}ٞmf+K$>$Kv=hD|8ZG8yE£ MUD0F'$%,nћ\|BY `i2̬~pD"B\F ̢v~$;߅_Ic9yԬ9u> 0Z,H_Vnb:8uc2rB*X`1'*Y^^ޯ[hLkj/[7~y֘)ݔXûٔe^NW3O*/EiSRta@Y숈S3/*0i-hF׀ɊeV- NlA6kI)Ӫc>~i487gGh\ɳOܫ!5mv8i# =,BIDʛ:ܑ$q*tp gˮx/Uڈ1Ipvw >tdx'spXR|}H#`$b n> ~'{}˛!iː{$H%>'.|ɛw8Z$ܽ;mۋPM*EF\H&$PJǍbF~M>Mxs/6@/% :A`ߎͦ]ak+J<6{,&frA;; :l#c{+ RgA #k]*k%`Y]@׬wzaM'nWa9avMB;5dgPmul 2do𤻝~ Ъ`/:[jmA> P̓BRT N*]>ԛZ";ҭUE۩GfZPp6ލP(l=݅mٮWebp dJ0h(%J\Fj)o[vUf5O+^$`O~_5< y#}J׎}{ܤ)>$O+q]n]TWn7VUXGV|V̿ FgC2; bݶ@bec* te=Z:VhA4-=CPhS Z9K/> /ExtGState << >>/ColorSpace << /sRGB 4154 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 4156 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 4161 0 obj << /Length 1848 /Filter /FlateDecode >> stream xڵXo6_!a%)amXSl&K$7I(K6+6q}h"pE9˵m$8gI##I]oㄧ?zF3(ft9vkkDqbB'ߵ]T*Xb i$sgL \DeEd 4T4sg~qE,XWmCwPvYJJ'Mu?Ͷjv^ߖi$HfJ|+5CX/fY򯄊w+mkOiCiq`׼\nh$N6e8/Fb3j86Em4s&$1Wʐ+weL WXHȥ`RK5KYzY31=#\S ?Sq x q|3Kgp{l6 2㦤pDT/NscFm7 iIs5K IJ 3؈h3_%wJf8 1mҥ ti=#'B(>!vֶEnmgMųqg&h*McEKU6d2 ӷuK߂>cEupߓ( y}}# T剈62"Mls~{}^ zs=4Py*&$)s9M)PJұA欖$rD6\, @Xn%xwܻX@&EO<]uE-,)Ko \\45̢ `_ zBʔnJj\EòQ'A+l4WKπ*4G 4yZOw֕[,[@eS! _C Z5-k~$Lb6`DF݂ /"1f~I6_^8(vݴš[4u`MΔ@bWz,¶oFI[,N6<gá{P~O,3y/Qb#Zஎ/T#YU`%h5+_/F .'d[h8.f5wJd,UT` ?p 7ЫdN\[3IZ !&_(g yEȊdRT+eUݹG>b*Bd> /ExtGState << >>/ColorSpace << /sRGB 4166 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 4168 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 4171 0 obj << /Length 2126 /Filter /FlateDecode >> stream xXݏ߿Km !R4hQY4Z,9|;CRiso/)Pz?gÙ̐Vt}rURsz8DH2-~`S|AzQjb*\tGo4芭WDITeڝ~#0)݊馦}abMSۉ6"Δ8%#3/ñ6[n?4ͺ:lZ~z[)vnů[?=9XwaҺ-q2|{;$cE% pKRDӅ;p|v *~_ts'}ƣnW';NݏTyj۶OުF񴁡Fzo^I箵XO Mos'#c!vU!_?mF/u ҥ&T0?R*Ҥ4EHÈ,_36n)*Z4v=%7Kpu({tfTV1*U$ .cIgNns 3vˬ !ZsJ&qD 61Iӹ݉u۹ Vjg@wP4r ;ʨPğL}jըI 3S#,)bR2[ؠq2ybqSRphCR R.T ^NԁvY;?=fv>5z+ȻE79v9+ĖH"#&сHŜP3t=!+{]\+!%Haf"+ '&AC˅]J?FO8Usq#@]JĬ|1lR qVrȭ>tMPƬQPF-aP.qQ/";1}-sZ:r2asow9kwXG;0ɀ?>jA>|^@H`X&juǺ 9s=}˛\X‚Vb=6~1AwʘrQ-0ʷT$Y+Uk#߇\ne(NFЄ(S F6R 7Mt!Ri&aKܚb o^8N4p , oACptH>͜/zҠ 5gPBט3 wYڂ&CHtcP|[]0tO -ݣm¼x+9{L NaG\*`z….Aknw]z);?;n@ح۷w;; $B?DjN Uy"&qSvu54G ˔[(琟/r_aU.)E,I״nj ~l.%+Nv}8{|Bx30g1Szkcce&+OVv䒗y6v[]XiWeO9Eҙ`)F|v@vYvi;jవk0K`F~^Bsv%TW~"A:oi]r8{VGm="@ob•OŮkjG[ds?_R\1Es5U"D>O"BQ/"o&J9]a@PdRjA ­۶Frbl.㹃k|waӌw⇤Cnx=T4-8>80L}{y\heb%p%~y 4EE;;zW^$BNѼ}/К,`B|hê 27PPvo9ko+ ~2}Uz`ҿ;$WNx7R%#}[s -+Rx+})9Eɖ+<; s}s[4$WWUNhZU^)qU^qZV=|^ĞUJ ,ɫcLu2籮,KCo2oVA endstream endobj 4158 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpvwx6Sd/Rbuild70522141f9a75/metafor/man/figures/selmodel-negexppow.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 4173 0 R /BBox [0 0 504 504] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 4174 0 R/F6 4175 0 R>> /ExtGState << >>/ColorSpace << /sRGB 4176 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 4182 0 obj << /Length 2508 /Filter /FlateDecode >> stream xڭYK0sIis"3Y A MwkVISŢdJ3ݓEdqWriVԬ̨|u[-Qܬ~&*5lu:4;W;Q3mj#-}yxҬ723ɡe-xh?NhgO+wOro>\O7"fJg,pO\~ʰܪ ,p1 "m,6TLp;i:LOϚx0$D.\Xf,OŰIy8V jG`h1幠/?*_lVL=T,XͤwOb+olCOEكy 'KJ\گiJycgaȷQ~$řb_`mb |mQC3'SU 2mnaH:]ÎSVJ7ТzLg3)@k37hc3!ty)pQNj; T@}ݕ7>eTeD i :`CT_8,xpUi=Ѩa?|muǦޕcX z|s6(Cٷګg"ln1r<<ĢdYY.3+KC6 Qή1m|u] xWiaj3칉6]a 4y詭\хnS͓C؃fe >Qo Zp |Qσm60^szJ` K\ &c63\K* XzM? @JX-<]20jyј! Q-?Pgڃir0u~*A 7._{8Qhx \[95!}E(4T@/μz;&;\݈UP-m] V6c{`oCvז|$5ZC]k}wKEC*mG)Ok0Y48 R,/9 eQfN [<{$BrRdS?/̥"P_R4 Q~UZPgV2#`1߮mu&k"-ۢs*>Kts8Ci-rA1#NTAUɯ9@f@6UUw0S>p\@_$w4w PogY I2 O!n(&?>{׵H!c]+ۻ?!> /ExtGState << >>/ColorSpace << /sRGB 4186 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 4188 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 4192 0 obj << /Length 2152 /Filter /FlateDecode >> stream xڵXK)EUx Iy]IULC6F)RcfӍERxƩ @ q7߿ûXdpΙmͿUp)Ng*K28s*n|$Č{`qnvQGHhIXfTi L\?e͌3cvRkaǑiո+Ⱦ47џmzəx4f+ q>)]ͮGGG̝=94L+ `Yev'8o%eMc$oޡ_<m3j[#2OG6m54+\A q -g}\}lK}+"KSD`P<#/ lO^0 .8BF_Vb&aa9Yc~͏' VDps&$ @%ܿ4s4Sh^ԉ[u`kIϴ,{pR Įo-igZU5_V(TpS)ƓЄXvg;,o+ ׋d.$]fd q+ N!:@?c@9%? <8^څQ{nj1LzƴX4>dFS7}S98BdZ)g8 uH% q2eHKJ n-B/7e)5J*BxƠ%>*v`1Q}!2@պQ][r&a\K{\C]B6$G*P~>XsW>I|^ y<(g-8TMlϭ"@> bqB6E 9oC '/NJgOW DJ"RfiR/4'VYH8eӖDʏM ȁJmЃ1D IH:S !䀋2x/kaak[]:лFJy{*k/B7d솪ޗ2ͫ/,A{Jh S1+2Y}ҚʃᴆL+}~G6%"~ aϛ݌WMCu%e\ e5{s mz!%(`( ItWK*4xXΘAwy =>JASK cSc s7-vcيc*[@D.'CQ;*%!P<mu02fqh^uPȲhI%nWk_h յ҇6`FӁYq-KP6&HdKD>zFA%#eU )13͹~MĂ/ A8yQr[ π٭@5ޖ Np#hxqu46:j"YAu7]X"|^ ĠU! 8~`^E/Trd 0t ~ʉi<1$Llbfl65MĽb鮔56U~-:v-E_X5U 3tKVfZ^zrV~8A]! G@\5x/R#v-~V.0M ûZI endstream endobj 4075 0 obj << /Type /ObjStm /N 100 /First 983 /Length 2077 /Filter /FlateDecode >> stream xs۸W1~(@nܛ]fލNhD~1ʒ;C,eLqd^ͤ$&"S:$ӖI1H,Y 4LK,$O!cR* )J&30i$#R+Ɩ.Rk@kIBkSD͔LϢ/R4ot<$f[TA2*L-戁)Rb*U #H9ʤG1MF:%$%44e#OZҷX6ΓV,fNV:HEH1=%IV*CPEK 9C*m34YE|<4c6S,!Yg:QLƬ0YKʭKpޒd EZFEin`m-P nrFa $*s8#> |mňt@@*YIzy3Aޤ;żi)HGM @L+R>T 61XI>I& RiwI>=(1́F gQ Შ=%z%ΘH 3&~׿A_#O&ܫSBwvfgixȾ䴩;vxĩ׋n v}K@=Yl3\@. \6yٱ &~;9eCcy?qW!)G6u7Y9kmQ.=[9/8 /1Qޢ7)Q]7bbɞbo I]F⧦m?d/ɤA؅[8{ϯ: )Za@]\={wuw(ڼ?7퍸ˋؗ?y^?W]gl,M~>,׎S&AjkSx" q$p8gCNήk>f?[ޖm0;(28`8" c+m\N9a 9GNg5|+6F][o98ޜxc5[3?kG:G4'dm Y0 Jͩur7ڒͧIKdsdClJ5hEhqhgndg>-eoO&ueatJyԋu%xݭN襪IfrMFH!İϴpe+ixQ"CelC  מ2P^x7PYͩ\Bs*n⏢n[Eco6;TƣU/-%w;gmOFr} r&p]m@ˡ&"7 նʔvlA*g;Oe'ó9cWW3:՛ VnNBkkz=4`}t!榀ua)G| +:>vbwTa̩;ɻ;AeJ%μolPu*fyw7ҺlU:s5蠿@rJdC9ϧԦdLOeWH.qU,,inu?Ẅ́z_0A.W|qy9gUճkIu}]b3ʊiUg,:yӕCH1nY%nS)bޕb>_DWMƥE -.yQb\aY5\k͍($_>7y;Ny'.?"fڗ Mp-lٲGeU*{$~e+;$ Oc?~ +Ϙ7;نaBcTcmo֠b6^ *־*ֽ9TZU^TWsR CqYqKn}sR"..ߘ).]#l3B=&Vco_C{tWD ۣoMslێUc`mG5 WrA>}E%j=XۃeMme;d(X9'2G|?<յ endstream endobj 4198 0 obj << /Length 1569 /Filter /FlateDecode >> stream xXK6W923$ŗ"I=5CY殉ʒ+ʻ]nA`&p,ή2}vx񖫬D"[_fcT0IB(l~ V k!9B duﶺq /x^Xdrę 09&K4~ / ^wo<[BWGE$HI]UA;qultu[W}丠^7a6Pvl톰D9jAV/(ڮ5um,ދ9eI)ϯ׺ g_9KV઒W}X*w>_(9ŘfnNrb'E _E -%{H58U,)ΏNnt}e,p`}v_ES%"`i.}@ەmH`$ G2L(g 7)d :!rY 9r#j&0i `+T",r &"#NKՙ-wY})'bX 6Iw1 :A-tkfWڧaIHx':umKHϖ19~\/*gYd eL@@6}%Et1c-1޿0SeCOK,OQk-6r@m t0RQ<8P@P x'ir[#2pPA} H^X!z*gz+x ܆w ѺhȻxjj"̶a/S5MsnF6 װWCFbzEuˢg2y*60y#$?@TxJ$$* > P豫I>ǣmrscA .}榣I8X A5=}4/7__x endstream endobj 4189 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpvwx6Sd/Rbuild70522141f9a75/metafor/man/figures/selmodel-stepfun-fixed.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 4200 0 R /BBox [0 0 504 504] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 4201 0 R/F3 4202 0 R>> /ExtGState << >>/ColorSpace << /sRGB 4203 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 4205 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 4210 0 obj << /Length 2064 /Filter /FlateDecode >> stream xY˒6+T,S內ʞdjE+d 1C Avx!rKn;5+p\xuX?ͻOIJQdu_ %,]_##ˣ.d}ۉΔv kV]KiҖ%KA6kɽn&f8R+6`֔`Vfmjj}&ZO*ߟkD@18fA H,Ġ8F(WiZu7# *! Gax)JP* (m;rt HD X[٫'zs137Hna,^-<*Y-嫉 C Dqe;3ؕmVViCϵʳ~\&<j` ~7̱Cx(GTZ~tfa/o!jwH ]S4`Ê"zRK"KK .24l̋!hw~Ž1mW(i (`̀ ]h3CHlj܉}WM̃錄2 Z6\a_>'~weutW~&oέN|x'ٺ5L g3mXt.LHb+be>ts̪XYʾ]nMq-R‚J @q_똡`DfLwJ0A'ȥ",[ Y('tM {y,A4Θ7&.TG*\w@ a$=5'P ) $М6,2 y2dԞʥ0Cl|t~D,aY@6Gi#R8eKgMMB^წjMӅPddUUu@_ldn & _/kಓ'S -I`xpE^Bx/4"F Knsru{k\]0* 3QKe6rm!~6X~+y!@2$/1 Cg߹ ڱǻAC3K&5Q5Gky>-Yvp(a rB0ZoTym)@ bvַDh-DX.yx$g΀AjliwvK{3زQM aFO|5={7 Ԁ ha|A 1E[o릑rxhnw[P~2iq8b,Ufi΁536U6<4PHm}r6躶 Teez(xCi?ܷSҡŋߎ^:Ns`]qhH|>gR&R$H<6."U?e]LLYQ(ˊs$BeW_S޾h_K4JuXk3 ~#X/DF~ v BeoEkģ[U*Z  Xc)pշ-+o^D6Rz= xI+"'#F`O&a2olz 0~!t C,EߟQEB;|~`w Zqoي)Vhrbp0E$2x12 2mǃM9٪:&[sqzؐDC9;'s{ex.46ەz{7}NI փ&q #S~Y/Ñ, 谶_'>5-ut/{gG>gy_"K%}1C1g7}|[Ɵ[*?_L*'!>(>7.׏o ) endstream endobj 4237 0 obj << /Length 3744 /Filter /FlateDecode >> stream xڝZYoF~_aIF=M2l&ċfPRf"5$5G~})Y X>:w/^D$V٫ V'W- n (a"ߩvܸ{x= Yc*JM#ߺԣ FP t7K-r!oj0rK ůAm ieK.i*+YH83Q "X*4k=YX(a>)LQ"PI}{(MVfAcpu@LLPVwH°;,UtS:Jod~goRDz'(%-h&B!BaTÞ6)2t$G ?]jiJ-WMq:S;?:*2>`,y)}YI9$QZ ^ѕIc +-dN*3b@$9@4JntU+l٧Us~  =Kk7@eɊj^kX}Q"kl R`V܍u#OZ~k#b7P}FA}t#PL8V+-c[(e)UuS}dHhC BS Pםz 'jZ}ۢЧ//`8_sSuvik PEbd~QEvγf%P,$ىGD~Z2rI#֏e̓Sd[pZmrw>W1 D2Qgy &);`%V @S | #x8 ^άa0vm 8t{W-ߺts)26BIӊTsuq5!X8H%)S_:@T{DMɳ%_#_X-eb%3!i-9M z(+С};3Nj|HD3 GZDZN$[Z+GMߞ]$5@tFFʎ}>(pph C1r=1g/6ג}> rΔ\p:lՅCk-04:C1%G2e BFVΑ/o,]̼ѽV'$ԓk;u&Dg H=az ya1f=SXө,lr{ @:Ul;`|jXVOW@I>$b"?neIGz/PνDEZި`-&*cD4$Ȩ.SP@C4"ev(u5:6Y|I/- /.֏NZTt?S[WE=I"Efb{r>=  .av>L>+>bKe, aUeJA tAnL幀Juj͆)&!,6fGDrB*PB9IK?<͖wePz>T&n*~mܺ+s#tн{ ǧ/#*d(N8 Gi'O%COP6Esaa1Ar.?xY&!ҍޭ3+bp̹O ZY= 'CA)B w闬A\@th<(E,' IP8Hk<Ƌd0.#Lfwj0c_)UnN; C &Z>>:!Ef˥i3ɶt~Oy/w?5+7l"Mz# q[FL$k|KeD5Fy8q?FPS깍Dt0vcz(/`/ \z;QVҏf ^EgHZAҘf8tD}q('Y|+6P̶[曍k >8]JXQ6pTWrG4;n JjĮv>:.߳`\C=(U^,R osBn>yCqjߒ=D>匡uݸ=`\vނ)\x N`k0#}5-bB> 8QKɡVM+6-2b6}~֏ʣRj(p=M65O4rT|Y2m"@ws 3s/ޓ V wƭiuf?>]@ɍ9Ĥu6Ҏ#op M9{f  9~)M&⊹$v6"St[S\ x{.BA)eo[R֎*IЋbV+~4 Q+tYRS S0q.Qh觱h <.&G%[EZEVVT.Џ#͐i1cE XWVKˊY1H$}ݿΌwy/Ϛ=Aa?A1\b19閾G=@,WAyBUnԭCa:;K~a2Z)OW>:I lco|hVb߬mTҳb|t-DU_evVE'R? endstream endobj 4251 0 obj << /Length 3973 /Filter /FlateDecode >> stream xڽZms~s_*Ϝpx!2;4N;͇( PBRv|Xol_xAX,w}vA~uůy7?*gJpTLvw㪳ա_~1&Us͍TB7/pV&sC}^DvݵLW\nOUto}Ye4bc@2˦$6% Dh)& BOG{'}aI ZhM/ŵ䫇ig SjXFL4,bLXf~,7*sR3\ nTybJsh(EK&`9y>/zI4x*\ G9KLK2 $ULiBDaIvNYWR McD%2'"eLt*W]$ DOy>_+ q$NX >^pp:+*[\S&ݏ~TTeTV:]9t=Sgvն8u"WǶTѝG/$i^Z}ݩv"UHWMU5({~ k!n7| D ɅAlJ>Ef"]X%8M;zdGۺkZ',^(HQlG=}۪l_NwhR0ܚ\h+";<6en -Hy( j9)91<;uR%KV`{p֌B3mSmȆrhE?*$9) ;4B/uܹ Ʈ;K3?MkTA\r>.Bza$I'`Yٕ}Et'KE[:öwn=G I&(-0yű"g%B^,Y1ixKa^qp .]-]0TZ-@8& .Aɖy4liHQUr3[lp\gD.A14Qs 3ĨKLQdqy(OתZ:.]o %Cѷi[zGn`zKxƹ #qaQ_w@g%&X.UrRGHBψLU@דQC !M:wԦP|[pO|];]O6I#(d%>0,ĕ! 0ziQe8޶pdo6=Bl%crp[O4]&[I{n-!\ i8BΎټ ˮZ7oI$,\i92"Zm3!DF#!&$2tOJ;GX ؍Ku2J8]H9}6 c,]ٶmڎ8#N1[s}٭kI/shTaGE3e?@=T:T?H&vŔ,' SCR hE. CN`B|U➁NE讛~cua61qkdfNJmQ5?Z Kb9 Hg'D!P%Uol +D\_2ci.ˉ }F(6Mj`R N&rTDZhgc b[l 9̤ БLI*yk83_v]}g#6c$J,0u %n˺e 1(r+D>b~BF)ZF^f4UIGT>1*#C;@ AۖϞO#&8;KC&7 Q=5m͠TeNLF4{՘2X4\/Gӏ ?_RC$~>\r ѪY wDkZ"Z:8!ml4\0.\e TkZHyUW9tOsX䟈SP$3AdtcOuiU2`ċ e_b˙$cP56θ8dۆzàAeuHbA|p{AOv| muwdGO#&Kr2jXHg8+i N얠"oHox-( ?Xiөȩ,.pr싓U3 g5Zoơp)ԢeOBp/{ s&"*9z5,{3W+$l(efvyK"{*Uf ~Eyp2fNCD烷w.*!椴Aes幞k.ahh}4\8Ht@hz$l8TpsR%KNC&`al ܅(+sI]i@',NxR;Rh{ٌ^¤0 y %f@wH:p@W$%*R9-lyrIx^,])~0dFHAˠ׽E@wEqY$JCԡ*0X.iSicM= LJKF$KyT5a XXX$1XXNT{k ']82rup0ɟk C@nƧ8(>?ɰZGw)ep 3ڤۈnqJqeP7L*$x8=arafW~W4z8w 5AFN '$2HF<{'dzɛuY?\`IIvu|>|1]K_@>/gSyS{Sz(2\ =DnlPl+Ŋ opKTm pJ?0[ l %i*,!԰f˂hxHŗe}Dvߜ ` ].M__V5l6Q/畉}&zúXJ?K?6}(Y*!A4O୹L 0b)1S5ତ@}ܧ E _ B؝~i(ekj88{JȌe,+?q4ncsx+Yk NuR)~D GO /Jt{ʇ )yYy]F:OebœŔ1f~AJ@rO8T,dpѡ E?ȧܴ^i_$g9!om,8KHw1r_Ǫ9-r!@,!c|¶qϯ9qoh1s]8Fd]pF2TSB.o}q.%GqY`x e Ba"j)XiNCY^wdFQo`btH>%$(-2?5AG_CavYJMꉗ=u ߻;W-LJrEo~~j2?L48Wi?\"O|2 >/ADp;U `~SlM@|z|` c yLִ%qnW?}xה~i _߾7_ endstream endobj 4257 0 obj << /Length 2593 /Filter /FlateDecode >> stream xڭYmo8_=i],l^Iv،֖IN!)Er$׫DCjHQgңQzճٙ̎ 1# u)%ѿNWfgJ TD &rJ]o]4<f׃!n̔i~䅽f-3Z%@33 rb2\%d2$'uo߶E^OD1)5FBY[[mQ.|uѴżՍR]յ]mZ/T5#6Hv{.air] >|y mIQml[㊜h'TNEZDNA9i6=zH,Ș4aתInmo٢*HU/g4%z$Bçj $F ?i^:+RF+f :.竏\m;dindɟ:No- (׋.(0P4KNPA;ꥢWպZ^1msa4/pwE=y]΍+~˅P{xMݻLG4ǁN&K@r^G <,~PC!pt"[ < [J5–J&&8~%gN3DR̿8p9PJZw6v>\t;TeQmUm9-P{bU9DS Ƚ @Ё-B=`O.:@s%%x)3~" <AUoe@;&xoSY0%3:y g"+ۺ1`ߴE\iPMz{hZVaz44FQ]p=TӪlV(2l]M"_ǰ^#@pa"e R"\!A[#'b`\k12b bЯH$RS﨨0 R2;odj|Gn%d/[xfA΅axؗ9%L1: Ǥ1BgT̚fUrwIAHH%qBLMmmA7N7ܞkac/!Sis/&v5$x̰.wG<%H'#Qi|yJcAcj4\3*/ ,I5wmn$ϽۼllF9Dq0 R ٧m4<}g鞫giH*Q*Bsyw%<.\xgi&\dM"fQ /-*;vYA/R>` [| |Jt)gaC=j)=Yx45O]dǓMT*bLh[ʳrc GOndn@R\nv*ܻ /&b  !`{KC}ZcB:3DX*+:IB!!m]vi%!"'(Ix4 @TRA)Gp~, !$?7c&0F4_WaOn]/V3HLIzeE9Lݸp|{5=u| ¶,OpZߛ7 v wM Ey.bX- & wJvְj37 mYfKc/p`a/ MBt ŲhW.zZ^_=/NE endstream endobj 4264 0 obj << /Length 967 /Filter /FlateDecode >> stream xWo6_!xBJd K7X֢`D& QDq%K"Q<~w;y[y.^/.˂, o0BA'^qDg-+뷗WeO?ʒ 25#) d"o phQ~|sгA8C1 aK^z(H@v$7I% _5Fo6a`3;2AC4 H +$ig&y,օNV3sKӱhtp6k|2)&U}D䭐}P DY:˝ݴ_!DbW?AAM31N3)CU_䦴) Ⱥha4D:":'~ H$9wǹyc [74]6sF6*NytO5B$mRi QrOkpt-vcɕ4N@qjo ?LطevGMSWFzI#檪 ~Q^3a4 Bx4逽#8 8{4tM0\Q`k~r/ cDY4KAcmcכe( 8 Zu-x8_&گC MEK=9j<i λ&9VkWϋn'Эzt8Cl՝DiLZ8DQ3z,kC=T?t+=NvP U~i@^XNȌMG(_s5yM1| ua65U wݸ\F ³A_Y*[h_LA1:dCD~8Ç&?Ffv]Gnatp_8I[ endstream endobj 4269 0 obj << /Length 883 /Filter /FlateDecode >> stream xX[o0~WD&Is#jy&EUUiCbdv,[s15Søw9Fb':1.\V?QPrN T=G\|߈#?3/O]X9`.X˕ M3 ] U7J2Ō\MY!* JNkL@y.st R(5=Sk,9UmPj1N;xyKH7442'8 ,k'nNRGPg"LU=q\eO;(C5I``PT<1Uսdԑ- 49YPtŅAU%Hms kSeLΒ[9eWWmuE4$CO1g0" ;)0Sʈ{B5}*ylkP)2QJT+&rZ(%EmT+9]2(<+KGC Njx 5%[Zx2XPig-zAcdL鯓nPrE[?-?)O^=Ϳw8 endstream endobj 4273 0 obj << /Length 853 /Filter /FlateDecode >> stream xV[o0~߯:qxv "/L H˃Įl[ر50Jm|V,:y1;9$Ax$"&q̪SIW>>{s~f;8ikm-2F@weFK4:Y SCgQ ӗS+k(ʢ19v Q8 [I>ՒXt6c*8kSvx~˒ۅl5laG{pPZ [2mO'`R' O,o$ɏ)10j|B@w7QK\^%Ayy>4>El\@D  6]o`<*Oe͒WnuK+P)F*mȓP+"Vt-z> !:?40'm=b@G洱F#Y4WXEj}OZ\pCrhW9^џB6 \ӊmKtFQwoUd X׵g+y1=Yߌ/ Cym#Zʾ.׵.H/*Ah|Y\\`:WrYE&j5\Y='4v'ZrTF 6>CC@T"l^A*Zv=o K$u<}dׇs-\?̿ endstream endobj 4280 0 obj << /Length 1781 /Filter /FlateDecode >> stream xڵXr6}WpL-X0.C;;4q҇$@$C*/rү.HvMُ݃gW7A%$ yݮ[8Q;Z  ? =U+^t0΁X< !e-A|ATfĻX=3ʴ(S#/6EQnSzSWc>,j#M @p̴>ܻ`o3^37T*ԟws;N~%;ϻNuYw\U Rժ(jiQ+R[b fܮֲq/FBX1o0kɗXcp X״'b{~[χ&-˼gwM;#[ }" G'pV1Nk6N~UXSL / \f=wE#ݟHBdl잩jQ;\(&վxݨ 3V ]?(pM e,`ƨXq/F[sm`*4"]mbu\f< H%(ZìՖka M*cZ4PQd#nڜ=<CfLOBă`X H ?K49\S)~ ]d֊>1G\(NV&ncAR$ .d懕Wft22bD1uڥ"E#*}h #osUelI,EY\O0ꃽy9k #cE}L@X"]}Əx̤n$PH;wVefkR֚MdUMNe6 ݦI,ğHx&cL0+=1G1Tir le4T:l4ic.+Qjtm0MxO)WK}:k1]J$2+&a{mx+65y?ҬNYW5kDAt >٧rj8hkTen/~6/Tjq+؏mӂ&OG  PQUћt{&aԢ endstream endobj 4294 0 obj << /Length 1583 /Filter /FlateDecode >> stream xڝXYs6~8%LƝ&$L&>$}(Pb"HvL!v4[͢٫w/d lvWhdR1>[>7ۖ?w_ŀ䜃DChD{ܓez8(7{1b>H `$2,i,K]Uݕ[aFΌ D N*`aqLyJnV Ě^v+0NZT_+w+۳9 lN 3ԛ$iphx؄40lWYq쵘M1޼K%r EH8gQY7jx"MH{V|`,5!`_oLSOteճ}aew1 ʕ(#ŬC|-t_8FlrKwȩZZv_FYF((e wY ;6q6r4؉͹OOP4?iriFb{ʫra̐v ]'yG;y#4J+|CgB jk7bT $#Y/)|}+UA3ŞnE+S6hU櫲Qvix "Wv[ɮB]C5 ~Fx:]/zt(eGA(0!'Oe3,C`/2)7 IGo<^9ZD$IYY(YO͋hژ4+{Qb膍jJmʼnJxZY [$C? SL̵j>TM lrj^tS%&)G߷B94o"oV#b5->Z/x .b(t Te[Q %VB_]DH" CEFm]+ $5\MknUZL]Y}.aLKb6*ݠ@r6^#6徃wDyXi@MwGHFb"i'N#}&}`ل nfXG~dcgIA&ĄF᳔ "@ן"ed:0#ؼ=(9o_ΰ?ٷc IAO]~Ǵ2om>=PlYPw ؚ ߏQkʥظn]#ss<,=h5gc.\dV>MEŗr`}~A~"I GRgS )xOŒrO罺dQ|?rrSFkgFڌS0ߨDS Ha<ݡWh T(Kn.oo/ܣ͍Iv صbvUsS;an??&?sMh-e.jDɘ)Pc mѰS|~yIiw;^C}8>%K3~Mrk ^Jh0 ?%ܤW^A1K2ɝJwI endstream endobj 4304 0 obj << /Length 1761 /Filter /FlateDecode >> stream xڵXI6ϯƩJwմ9d nǔbS -O[= ~;囄hD])ƈ,*+ջoh<A l:.Yh~}ufa[G8%Aq<9 J|TƂ-z b89 ٟ~;!ӻcP0dZ/PưSjE+.&J•ؙۂKi}S} èț뭗5+45HAq;eV٨Ql0C,f)ZN'̷MVm)'9gda.{2śLݧ0 o/B꺲 ɇV2r|^oyw#J^C~2&]GJgqNBmEoys;j~W}x-gЎվ @w߸#m^0rywiDkEKi\@Qшx2q&LbgrHڪcG/oF\jv]p=aDޮI:쥇Nj(mU5{5#!!\7BqngS U cU3( @BkJ :JV;P/#h޸-;~bR{ܺn]1R'2چ Q ;0%futMFiF05VSCh[.O@U7s2?jK`aVR (Zeh-$ Q1 E~*2_^`6Oq S0pPϜ 5uΚOеH^ k{b_fL4mUhV`W/v\EMv vZD_odg)tdVO/6#YfSh&S1%:U=^۵ŤJ$4vIe_1 :,sXcΖ^ [{yܫYr$Vהoç;b Rk禫5˨XVUW8@_g[5s씦%pItQ ]*ۂIǾ iO8m^tZ)&Yl),:~Z4Ka0wsШPR9f ,ѫ !$ I<$2^CHYL]|)3BFˢM0yK-VBc񄷬bӥ$hX:Ϫ1rbfv:.Д\ :ʰpybL譂TNY|+Z\]W-W_O*<~o>ښѿ9tdBe՜d#sa^dAuSS43+!#3/pU\Q8LF£*"}gfR*EMUfIQt4MpX3fc1ĵ_g$6 .GE3v8 (5X %X*,~M&=x;E5œDA8?̠Ui|.Ug5LȩI-!6Hi!Iݠ1Os"t|VJ:T2 )R# 72bx~M~ endstream endobj 4195 0 obj << /Type /ObjStm /N 100 /First 993 /Length 2590 /Filter /FlateDecode >> stream xZ[o7~ׯcP,lbka<9jW%P[%['"͙!swH[JJ(a)A jn0>qOpdG%bI2fd5 2w FAZT|C_ d;n9uGAhg#B&#; UcT(hjyr5cFys`" 0MLECҌ4FaEa#`DBJJ]NY*2>#iǨ YóXbW/1 R^dX, Y ;`-iJOiyR2]m@F"<Un;ƣCW|~25|BBvõ&YixQ=C[ǮZP_|+'Eg]\e?p`s n<+:<:6~!f#UH=H zٳGEZ( _rkd1Qv1 v6*H>=J&=AlVqhnx}XuDoc\f(v(llCG]=^w\xy.66Ao_"X!!F)Yٌ۹\xZ1iTv/};xn1|g?ܟo P|eJkm&dA<)':dcK M}mA Fuw`FTy]xp8yg[PAq@Pq =_kanhA@vdH[zQʁ{sJ$}(;7Ż!䶲ȨȨjkŃCcMh2A?u endstream endobj 4312 0 obj << /Length 3236 /Filter /FlateDecode >> stream xڵk d>D=\>+Z$m$EeȒ#ɷ^-#p37|oz&L7$dBTjv4PU,+ )Q w{!r ~'3T Nj-[m׳iǁ.˺ع{;п|ioPlyJqK0 |q,eE.ѻXwm$Oe_GPm#-3p1Ht \}:^|zk~t8l BZ- z\q)XzZx3 F,`4(}zGlZ`ܼ*|#6CA5 y`!u%H_ [6JTEJ 2*Ks&t1Sq"?!ʿH [Qs*A/PnB6 9M@:5Rъ#rՠϥrǾNmr4,fؑ}QܹIjs:`Ee鄣H><ד:;{i^ԥzr'\YZ,3 d؈[e#}BuYA9b6c9dL&i Txfke 9Z\zu9hQ_er 0!nU "iIi+Fkː8354Ih{Nf|yHa_nG5Xa,q ̵&jR8W,Qˀd!î h)%1)NJ&^C&ܧ⃹ $x0D^M]W;;Ѭ ()|s!vpc@wՋ箲&BJ+4F|ʘ CDZtHG¥}F$!Իث)}@% 2{ü{=QC7k ڴHt13G"? sb{9toSsP+wuS[&J-K,y"HU4,0.2S8.o 0US?S<9}Tx4Ez]eJvˎ.\"dѶ?{t̷YJc_NJX"|)[LIwb>)©IRōOgC~kD HQ \x[k J:m]Y-5,dWV3fY6.ŔZf qwtPw%Ӏ|b|!7$$+j0I vW'EE=Ձ L˴J~]&Wdtlb|데'l U jv~q' fFl#XGIx ra*~= jݱ(yc hAtEfz4HEұXܧണ}aDKQCKVٯO|q9URؾ_~nB>FDI"w sj"@ $_ $ˊo=9xܢi _q{/a2R>y lwg0Sl'3ݱ׹`LEKaXq'"]&yU|^><ԃa;w7 E1' endstream endobj 4319 0 obj << /Length 2424 /Filter /FlateDecode >> stream xڵYߏ~¸+R?4ES`/mz@H%;Yr%j_)SZz>"Gp7`_8[I&W<X%sruW~Y"7@4Iciգл=xfˆoE !Qu74뾥QUj#ÆkU?¯A Ƒ\z=i̹$dLƿBDӔEQd8Ўk79m~uE{K(鹯M' Xr)g<_dBC^WnI0#&),O|Qʄg88*sXؚ4o-¦FW.Z$ݫcil]s@K9`f,Ԏf4՚Vr-%{ &03Bvfsuu\M@,If,DT0+OƐ! {Ų 6VGoFԐg.o_PE7:/ĥ]ՌJ.X`Y21μ^)Xк !,!o`t?PDn ]l"n vQ21 DZ N)$n-V7`;&ŗ*vA HnrvFp46RV0B&"oB|߄[yYWs 颳ˆX| F;̬/ٮAVo[8x9z9|ˁ`/z,Q6UgB&y7k ˪S qzUj+hY6 Pޟ8(U_t.`Or]0Bͭ`TBCGzwJZB%k.Y6T6&/WE"c7x40 mcm`ځ$ʄEPO+C{`^prqHg[qx$Zi&m%娈^<\xbFg^`T`8tJ0o-ym7O =N$s%KJ$S=t9EG."6eҵeFtn |.A% Nî65)8ZܾaBo3Rڝ9 ۑ,ԋZnR&C3/ cl0(' &?ĝEWp ޮU!l^5sj7dHh#"Ad+|ّ)tU Xhb8#ܾ`z!l0!_wueCյxJ?.n.P@{:I³6 @oo[4rȭN֠q72i2^H #VDϏjTvs ;֕c؂XndžFwH~/0D}n* Encӻ\]obn{]i8]>Pnv%KߒQ$:OCn:P֧)m~o endstream endobj 4331 0 obj << /Length 1857 /Filter /FlateDecode >> stream xڵn6=_a&6CCÊmҠ{XʴVUv9$HbrwN:ۋI4Iv5a%1|rE*Uܾzgp'$s fyz"4$B"QE.+tpLcnR wy;qЖDU֪ü=tCS9 Dj* ڃ;4RR;#xkxu]4,DmxW/z}:Rd} 4F5EO%q 1@SAXQaQuaM()M(b'" Ix3MhPbcމԔy4.λp󣪗€$ ҈<=hVY+]@#ygA#b N8GYv0 )W <(2^K ^픧nǶJS&8<9 }QvQ>,{ɞ}  $aݩJm/%٤ŭ[`3rmA/!Yu9,ܳIn!m@ri!T>|N ;*T72޳2m]U!wd,.9!%sjyeρAP(+ԶrVz\kGfU/[aqu]y) gC-ZʧB+-ʢfh`t]硯ןĶ܎'9P"ÒɗAֳgϦ2ba*ݶRkhK0[ȱhݺQs#͙R+?.qPWj=BZy~SrQ*īn<~Ru7dt„`pmܨ+$~T}{}qYl(Hmh68u7PBڇ/(8;YMU^lJczqx$jջzp.NJ=v+2UXaaDa@iTBT4 YEn#[̏@>TqSWj"f#>0Q<:cJkY1g9WHQΡ%i}uNТ'yTJT62QӇjJS9CHd-5<z[jL2ۿI xTu:`¡ endstream endobj 4343 0 obj << /Length 1307 /Filter /FlateDecode >> stream xˎ6_!iQ>!E(-6ITIj)Kx^ 3yqH}o7nwQ-2bop{ *N c~/:a$M M$((hU7/'cD G[cw~]] 8)͏#0t 9 w@[(pc{lq Z{@"Kْ-+/:+[Ző@n@k6kQk'޾h9q־{-^9AuvKKPt:4)x1X6NmSJq?oau92 \,$!2rL[ -Wl@찙śiM6S80(NņZq--SѬKüUnKzGBeU8'3Pw.`: 3"o `DFIN3x$i/S.5ৃXi $tѦ6:,ا|ȸș[v{43OXxUMvi{J?ëna'4҆pq& Ag`i5į{\Y:|>.}W'(w$2xU< &wEmBCjfvx'v=^ְ;-EiXuň3Ҋ0 ix`Qv(|uKmBh_=]!D>­v홏<;%]6 ){53;,Q4\^X9r|>>_/݃:[3ӷq+]Zw, D*|Q&[]: ´-Ԛ*7"Q kC#bh^djr2*uw)- žOrB^1#njD09q_7UI:MmF1 CBጕf)CvhS'qΘ׎&âaY? O9|~%Fy~9Ce}{v۰a¤<սu7a*0j`f|LqQ{ru6(HR "56߆cQV /5J;zs1=t(ۓA?U endstream endobj 4352 0 obj << /Length 3065 /Filter /FlateDecode >> stream xڥZK ϯړjIIS&I%TM&dsPt[HL:>R=;AN?çw?~+lO$BR>|:dW^zؐ` L?}ǟ6(0(˖ e3tT{Mͮju*uEϏ2۹j #DgKfϏ*˧!,[3 @CciU2"M%sW5nXe-K+#T":@-^$oo\fnlJ7 2ZrqA@r$)]ۙ6{L@",Tit9wejs&({s/zh\nl;[;*k| .akSGoAt/ pU;.lґ9H..D?P_yzf\83^9$ 0v .>:(-N|^r.%0nBSx87k\2MR/r {ȇ|2*G:K^` (JM =,@@O'XЅ\ k/|2U\߂O-;w&[zv/RGnboo+$ ei:<.&SPt fp|N5(yeɥw$bj]9Z?S i&xFMe're42NmY=^|rRҋ )%dfT}L)ʖ" [D`R 1HS9b}BT^.tʏ @ * <<*(mPݨy 8~aT:g|v{Ϩ4to nx9>!Be$ڈmHEoFxK(i9B!bAvmovmWᤠ0so|![f *i7$WGQbj,ijˌdq*dw#$~_[KFl@7UsC~O!b!5N* ݹ 9G4l%B~>γy47>W}~~lz]J(}8=C_yaKutNszZtl1|L;}MD~  { o> stream xn62Pɢd9lEO-PZm&חOYU<$g&9 8\|{I6NI8;m'Oܹ-?]N|Zu&Qi n 3 ct v:,b2D+(n9&͈xd%d~iꛮ)ƁUbb_W vzuu C aC N!d74%nfMh@L c?I- YOE:K5觕 (,PZ=Z辟x?l, ,cTݣ=)+$4ِ&~6dD-‚#S Ӂ,ZT݃h w'@ibx6V>$#$_2r [2ǤG9n۶1*l b6LvnI e}h*X##CY5C,4 VS,(v%fU?a?3DidZ0?+!n$8`x`>c%S&*ccMK8ӡ YۺEF Ly.PU }x Tz۷j=7_WUw`-A k͝QF|K@ ba5Oڐ2>6\qױj [uf ; +u؋$Ӵ*f8N1OTԘ 45z_IS\*e3u_TK 9wFR-V/v|_^m*vrGU1P'/?3`1J&Z)yVV*D5CY`S["I4݌@vʏF0EwԕY1=%n+t =a' .߈BuzH11V~w*}"` VZev ]Ukn=]+Q9H1 ͧ xG}q8X[!4xڅwaH`sy6 (,eao&EEM/"otLTg ]ݬ_y h?^v endstream endobj 4386 0 obj << /Length 2478 /Filter /FlateDecode >> stream xڭYK6ϯ0f.60f;H/vv =A63beV?&hgXՃ`?qEdq] a,R)Ej2T?|Na # Mq廀ٖ߳V) g&eD?Dp5poEgW۲Kf CԯMٛY4I{] ECFPDY2<҉;cIU! 8/teϾ*-55@*~]Wc۵{j;*&@dDrh"hgTX-5v]E*%mr4v P^<;\Bc(! AE[ݔ!Gn$tX9ЅxH [^Ul ھU`ߘ ǟK$oAdX0DR*41`AwVL2P:zZ-=t6Q /u#p?XJ!c25ł) F#DHqغb >ӤGŅ}GPc@ ӓq8Y h0 e#ּZmN*Ix=IƩP9r~;Ϭ*nsMp34b{# <߄il-"8H3\pgo WCij'iCwʹY*; О$ _[QVg 2\0khOT:D7礨o 2'TQ&Lr<"N^$ꙧS x0iiv+>ռ pQ󪖙m;?@"DlZ[ʜ_70)ok<`֎0O !ߊ{w~Tˮ/F+| 樀gTzB"^$D$ůu2d<θ<=: >%bnou#(,}%D0]2d gάx!DQV%Ezd/Zϼt`?{WR-5 ^G'D477{˙߾+k`sA!/x ejb,9Tz65:hHeZwi] _r8 Y0x'E,|$V~Ya\O?zE(68DAz!w;O\DKY:=O%CX0˝+y>>3Q_pCgq?H<{QzY}c$O+T]k;Wqo ^oVUH뿬.wt7?>nN.{v!DlM`Q?nnǣy,ȼXlV jSB,%ח~E *U ve |PcJ˕`>n U9A3&cltP?#(|M)+*E.rS@8QL&%(+wRIX<=> stream xXK6 Wh=ޚc3v4$ZlHCJl}%Y'ӞzX@@:rWgu[nhr8b^b2ݪm/WA<Ў)AύPhWמg 6@z9턱q# zzrwgMӢ ˖OכqVygOym=ߵ{QRYؑG q$0h8DĚ\0 ݗLvJK|֢D~Qn+ibTm?t}& +[5kz^yh '[T4$IQt=Q('dfwsǨi#1/TTJ)n/"z Kۋ zeK15y S.n5,~ǩ梢uC5s8[2uK ZLS)j6<む3EdDZX0_KbVVe"=ş}OGUh (}bo;`lZh5$G\;IWqອ}g 8b+^!냞5|xV5q`/|ر]!f 6 /LEqj 83&* !&~֩;:hjZ`ÕpYA5$si!۴a7AkOHz`GLdvK8H,+K)NRdqĪKVos@ N5X%A ҎI^ڊՍ| n8AG1 !?.?!37$8`;Ŋz fzR+pOsMB˥i 4ƃZ~]NJT6k#ڐds7n="sGDM? ғ\H >&=: Gc,,iM&X2M7'Fzpьu7ϚfU$k8#akveH;}҈}l:wӴ \j3RG,SQN;@t$'L$T#ap?pEӆۏ4>5%g SCSLlCrm z;n5=~XROCs|W NF7͑qϚS d ?2M9|1h1GZ4 A~ξqO~ icWh]Y^\EEsȡ6Ik'8]pgFТua ]; @7? endstream endobj 4404 0 obj << /Length 2566 /Filter /FlateDecode >> stream xڝYKϯhel`HY$AvKE 0E dcS*RZ=="Y$?[!~_=~eTf"{x:=$q4{ȓ$dT=4* %2FvFwSi.fI`Nf]9%1PUUޜ,* ۳9z"wohND_pu}x;TD:Ԛ(fGU|/Tj`N]-pXtc8i5LO ϠQ}~{44h ? vIs}ŀ"4L#_MS߁iM3+"_%uuR6:jLt@cܵ㍚ SvӲٷ Ώ3-|Ho>f,,_TUEu88 88ơ9\:8Z_u3:xWTϐa ,{0&Fz{ɦ+ dy$zF|\FyQx.x5>iZpŗ E[t5xN;QH$ <`V$o"dҿA4ρ+`" Z.+0ةFσ9"IZs3QB?tq;k-oW\@j@PV3 ѵx{I]v^[T(\yB> 9cLM?D9i51Jj#6?9v8`ЏtE>I%UCê A9Zd,,; |FHia9 hO,/ȱmN_J] CD~'>]VʪWt:Q\nֺ&yMN6Fgg0Vd3փɚ^Lڵ p>GepYLbcG)4/m8*ʍQ <悋i*q6"Ƕ Aiw O~nϳ~Yc+WeExA ĭY{d=ޚ("Yf>A=gJRL9 Dj Hw/ #_&H?Զa3Ọ8,Pd$1d )Y0i!6}UN7u5{±GָrW*I@ $qwVKp\=%> 64`C 6"C$+v~pŚ[~ p I5=ibhW0t0lX9JVSo0Wm,+14klj'q9!>Ϭ?,ǡ5wqa1^]?XYx9LJ:lZq _tV+$L8~ѩk4k?dS!3G]2`l쨔:=@C탢ݠ2缔R3ʼWE+g)!;Mw䑈['(&5HM E:iBGpam5)1DE ٰ:t2Kd;jLQ?b|>]G PFLeCZFejw6_H\tọdA$$(@ nK@VgSDw'%oD'0N8sFviN癕Xq]Ed9mBZm5/ Ď]о(XL,堭d˒OCbQ(}P"NY]z*'zw;db:6TlɄW'>l(fSE 8Æ\&AܙeB.^4c%:|YDžaZfoy,K*r2/V]H5+:>cFH\HXfb/DS؏"its(/)i}=iGo TyΡbt WX Kl!R"^\{?,YH<0r` l{u G ! 3mvs T&”ԯVhM8lm??m@T,nl31} 5nE5Kř?ݿE0;@?ࢣ;a(~> stream xVKo6WE,ԃnmⶇlP02mE/I;)GrYЋI<9id&^ Qo(Nh\xwk _f| ]. `00B|e@r7%W#U{!ͭ?k}ZP` ."QY)08phmfe ᚅaG:Wv^5Z iO8T$T} kV 9rHSLWJWAG)/R1ę_x,Cok÷HPݻt9^lR7ɷ(Ikl6[ HNlRU8~J 0()S_rn\+b`(kF.P)-7Ln>*NvQun`vY ԑh?- zPa#lg)wfeuo7L̂is".A#p ˨ 6&L)^lA"?@cXaǙNTR/glb3Ch23 ͉Y&¶^W,?"-[EL>¢ GNa9[cvuaȇ۪[c` YI}Wwf[s^l|ܿg}3ePg}fдuzz)aw3Z Cfg; 8],pfcJCdLi4MPH:v{AHn1wƢ2r9CIܞhəF/O5+ oTYkn9QLJ8Ս|XMϲ7=4| n|镛5p(>/Cw9jv# ^Єxq?;3O{㷆NDۃmaGrfH!/z7 b8g(^'W`FRGը>j!bU飐P&KU5i=#v̻nTCh i&W-9] C]} endstream endobj 4309 0 obj << /Type /ObjStm /N 100 /First 978 /Length 1908 /Filter /FlateDecode >> stream xZQo7~cp\ə! @"w@k#&"E[MMJ.F2)Cb.)$$@hs$Tm@.l2&aiCE mhqd.AyCp̻2Cj@T@BSX0$'!IjcK*6YmfW|jςyŘ4 ȑݺRIR ' +$N`N`6^nj/9nꘂV!8HIq&AOEJc6/Wx2LYL˕A`CF N6,mkCRBk4k@*@3Bb8hlx)+l,Ő2b# g@7נ& -6UHAjaXVkK,?3XN!BV%$d@@OM*l, gd\JggݷU6u'so &xqnr}&ō6{>}_Nn}ɛgW@Uk| Cs6EnqqH=AT^Ͷ>8mGp3N[ Y>oR^=x_dVl 2)e_Ge6Y1PrrDnk   DxxVJ^^(|\~DR{fA@#1'm }7{9s/brxnv??"8%{G|u#_O NR/+;=Y̯޿>'H:T0N2zL>@. $ӉٛV8Z HaD-T^ע FMj{ôf/>vN>r>N)rJ/ԕ)^#81c&vfcx?'7ח'-"o%*%κ;XZS~qDTՎx[9z%p|>_i9 /J7h$CR@\"Gz4<  2-k X8ntkE0l ^Ӷ`ۏF!|s{Hs9I'Ԫ`ZjyND@%ƂG˹ލ!嵶 dr|N)^,j3rTPO8d21X|kwws\׺ҧRׇaˌ"[g8O72U 2z-$ RDy{kQY4,{*> stream xڽWr0+f `[;m:k}k;S#Fq⯯M{X}vmp>>V7I4+ Z'& $JvQ/7zi Q- [6F?ڄÇe4;}15T,_IxXNAwp)-e\2 ,pCɎVȣdZ#ZϼB䡱ͪXIU)dmhUFBkdd̈=^lb& Z$WU3?Up\B\LKh I _z@ЗD5MO1^Jq1Id0-)I͖͸o$5=BRL&9$:Pkh͝L$AÜ%R0.+cU-d3#潫XSΤ$m~ʈH'uc1YB/%gmsq*$g5NXކ K""r^2@rVr75?QV{~FQ]ZcESܢJnGT%Jwtzm*:W;Ā@C79'H|fsi~ zD'ibZEk{Pm6c#s6jS~B&균CuW|Wb??h%fGC8;9kfc7(,XU1}ݮ_=Gny˹22;FuюOob. endstream endobj 4473 0 obj << /Length 2783 /Filter /FlateDecode >> stream xZK4FᡦTٱر{{Ç=Ђn#Lzg=@ f$GؾT$YY_> =E8wKi%cD0F(%I<5jWP#j%J^1bg_IlufbB=c# qzNtK@Ai0e)?UBqɋ.ʺrcݬ)u]9RR'OQչ.ORخ>(U]Vo}ݘF>1s>Fϫ!IX.)PA&zUHa7P`W'k-,B8j!k}S|E? R./kpDj(N߆cDa#9(vYܯWdc^{֣ Z =&{p ˿H%^‰+ChA'T|0J!Lh P$$Y"*~: w"7w2j7uE[a/*? K9U2e=g;.BW'NLj [:}̙Tnc(%:U!xgֆ6KA0z<&]-%%Li:g#"ofWW #{7F]6v8kN= 6?&S KUnHz%{[ rh1H&w5~/37v(& ɚ6IO7Y{ -[?\l#M?xuCaBKk[m DSD "B~j..,~]U&M>.IoMb$ \z=S)rE_pqJ G<ƧLL)!?!ˌ;}D|ҫq))KJEdJd9]t)SJkKF18bp7#(6G~7mgfqHΤJ!lVeAC,ө1LػN7At&LV>ZQPt2PܤYveg2+ ʕӀ լ~q3!޶:@a}]$F=F) )&;Q7a k\8,~.C^ue3k֫7hϣcKװѐ_yW%.A2y2*Ϛ|q2`./mX4qغAfMQOgB >4)BJ$e#A㊌sqb1:E*IJ4%`T.RԄ1&ev{&;a)3IXg]\oխ-ɑo LUP\+mm[ݲx9&Mg(VlzOO).D<<NRPq=0:~NI+A/-';ΥyS}T'=~3+ 55ϥne&-Ko4p~S.{ 77-Gh޺){a&F.֍ HʕZ@]\1Qt~ | m"o߼aE[&b >~j@-K%%΀VJWVx3rV iCɐLP_7V3n endstream endobj 4478 0 obj << /Length 3758 /Filter /FlateDecode >> stream xڵ[[~_FN8 ElZI+Ė6}6'3Rdr.yYK䈗77n>{峯~WΊ\73癐zf˴(fOs!o>JˈT"㜈6HwdP&ӹ-FA̹}WBD_Ld-m4*2ct b)ߴ]yf9e.j-bJO7 j_5CKd_OURXXmtVaBg6%d!=1lcXϹʿh)+wK8B)jZgbج==?[7FaH|;=>7> {PKI$O1Z Gt"/~D]ufY]j]>ޖ_#W:Wg8%g|P5Q_(_X11'dLs{d$L; /U7&cS \j"zeݬUU)_ u Ve\(آʬdmե>5N⸵PJ|:Elt\Vnzm<NJު(nmLO/@Q_ }\}/Q^O ѝ+0~۪n.ly(m}xK=3s=t9ռϑ` `$GJ1j٠>z@WI pdv}Kn5F1"dcChPk4/x3lo8]#5'Ѣi/g%7*'z3ǧ?x.2GB 3^!Cխo toze" ( y;G80}]~Td@;XdAG3K3'Wabu5 [zn@X7ǠFO?ʔ ߭o G?7sξs̓兾S˫)+d՞$MKIүM/aQ꽃aYSU =ꞫUrY`CGA ޳?<'ŀ~m=r! k<ebc@!b|iNu%nˇm.Z]XaiGG`a+ Sدz|/ub&o`g3+3 ѡbflk߫8! .y ǩkuILss;'0W~`0EԘ3؛kTyr'eb& (@̴jl;Lm4Nyd$(  ߚ]?Ф/(@BTW %2oqQ-ɿ'4S ]/O)D~9m1W yL# :cKN9.$7rK%. ]M,,aL\!ŏ0;'#}TYKF?]R͐|"ÙT,},dqLy79䥩GYY`Mj:O"X4Ș?,4DPmyHq8kF&ܔa\&}Lr1HA A<&a]|A{`Ds $E9&^'1v%*](M.|\x O#QLts~*_SB)ʹUf{! < b¶QApJ7`b Q/5VK6ns2d2p1mJڂ:l)MW(T\)rUcya[Qn)?.KxŲ`),O OMTzn;lXቻY=O8|~1㲼K'a&Ts2a{YX!}ՓR^_≤:tn7/[G P~8Ϯy_;p,5!Ai,smf"\ۀ5L{hw ɫdTs-| Ɗ:<=/b`E.,d#ұ!C(C oe`\"ŰyR*ۈSlPt%_13wl+r;z<ԏW~_*dbBmዜ P.%K0IJ O G2w?KEAz[wU"Tr:HrmOIl$!MO}Akk>Kl WڂUkR.GEbQD D#-\=+N|@ɡBBɍ J&`0hp1 ]h}:YRO:-9C T%ZŜ>B@|\ bX?"B_h1Xh| mz`.fs{=8K6gI pcΒ 8yL9*SNn}F'}T7:R}6yP"`&+Nn/2;Tv1_&MSTV`]U`\(zE4Ί/:>9ouܜ3#l2Tw9C]8ef9x6A͉ڣfu#E*jJe~>gKzZka1ÆE<U2.|R8V * }=ρA]\S{aJ.̙DUzLlIFz L}j `)/a ~3w{}yϾD endstream endobj 4483 0 obj << /Length 2163 /Filter /FlateDecode >> stream xYm6_ \S+ۤIE/(E ZKkN|ɯ%Y^k?Q3煦͂.<{q쵖$͂QJ "Y\e_Nfϫ˳*&&I@['EhPߍ &7?pF^ 1NeUUc$1[~\񄇷z*ADT(IeTK*lo/͒&r7AY6agˍ_nP5XyVju!7H?iAʶ cSW`*zY*xt5|m?P nmzr=7uh3x3N)a-ȳ a1Є/g@,I<( pu @v?E3:p<>Jځho?wd=#0fJ$R /p^8:;sGıi2K~BQӠj! t\٦,8 xtޗyQI/B)d*mWv;)zYS;3VdU}[rSw$) 4&}DCvcuK*bd3݌Ab46h uhl8{Ǖ=#?f.jJPc_h0]WzеI"9:fBd(*4.C-ďwGfNGfdf =4LՀ,8M$,JHqvgfg2diiRTFS|_X@ƞژSuĔ*Yt&Hl[%ll3K.C1m`K?#ږ 1@=C1 Ref#ϴ0T')PHL(D!|$D =&Qa&x@2y$x[Wp=^]=/Nui endstream endobj 4491 0 obj << /Length 2284 /Filter /FlateDecode >> stream xڵXKsܸW(ũ`"A6eZ 4%Hɓ_8ÛB@_wO/\XQAgGWGR"dv#(.GL__eTzӍB4Ps;t3I׳9/drNͳĵi/RVp-)T$Ŷk/em麶i +?lՌٔizpL -r(ү^ufrƗë "M۬lkCe!ɩe 9I_ u@!IES0N&x`NC(y6ү~bZ7KxOc.Xʲ"rߜQA9g9I /T$g&$L c1K,K@>2+xDRLDp G4q&vIib*᰾ސPndm]wmT{NFp7+/l?h8*ug>00a#d&)0Μx r&QZ(Tʓ*4 C` mEn`0B`L) f1`p,.2>aYڌD3%3 T6{GtZ5s|ݔa7`.~jfkӄ]oگ!|'r xbN/A{?dw%݀W:"tO|xg*2{Lś3yrIPDbl/- (K>cp.X,Ieu}|@{ej '`La:އsYYUx8B=LxzgTʏn0n讚[:# 6ToAzv IeBb?7" xs kEpB@ӯe|T$>` Jt#USf!n.ľJ[5aOҍӔPw D8Q>/tLR\<`(h]sNAT0AS) z//X_W%ϓw$tУ Hf\rz#KӠ'  $Kx 1d2;7rIfA/ju3S8FN(c9j"pv:'Iuyy}"4Em ߹A>9L\r;qbmn.Ckqopk[-{Xp1>+Hֺec4m o ߍQh;tXuFyi]խm`DbBGtBU@%`ãLqr~'t1^6y?fX?h8ˉHG>=kM5GTy4XqLNC~-PSa<\:h|Ů > stream xڝX[~_aL6d[؇-S(p-P%VK֗ݙH$y0%QH~(;zo˃< I!(NT rV SbG'A FBGpF)<9IO0W7%`)ϼ/b@G@Ǜ_'y_B-U"Hb%*df039jrQʇmm낈M|Fk]>vѡix aooh?}߹ %p|8UDA(=/pQyPnnӣomHd3l$fyj5OڬauN G_ݲoWg4q̱46id1aBVNͪWPf D bFA.ocD  ]KǁJ' Y1]9mERfK JpB ,s׶attߴnvt_>sS]tv#*SsK7>\ Xu~SD_^ t< d, iz4.ohr[_ѰoGnlHt[C[ 'fU T4Kj. ̔l-ʘFGc~/'?vl(ԔpFHJ|PP%?M\ٮsAS3;gЛ"KOE 5NLx;ʹeN#6/|'3k_{y59è0gSh[ eϲp6RG&=$":3b~AGo$[ YƔqң4*D-B4XP(rP7得G2d4zAS1ծD2T#1Ipۋlc=Y?@-vXwA+$f:C .e2ڙ2=/V?tc 2beEi®t@5VUngh b]@+ˁe" ׅbtTn@;1Ot4OѴ]!LQW.B64Jë4dRh+P2)$S^n9ڽiȘnZ3v׎k;CGS O"O~nky0/}oψ *M y/>_!.:=\sg7Ͱka"2kW<ErOGYeӄ+l+_?p& sAg4.ӹ/._Ke蘯+Ɨ@0үh tW_UyL-\[3a߄)1)f;FM XSV4 Mz8 w?;7+!DLC TL_2C+xP㰆;fe\ɝP͐o 4yx#r9] lQ>s.ٲbfZ }dTīy]`;Ɔn8nQeQ|ܯ)WT|ű]Q9SE7*i@_ʢ468=X7 ٺ87AxaKftWš]gZʯ-1րB:!1~H|2k##F<\i t xlo\"t nJ;8;!- !a 8I'0ʅ3(Y+1fM]> | HY ᮆ{wk> ZkRBT[B]_ݪ)L9^V j)#dBrE2u -6(\mSvnbnj@ h \|4p6֔[p:Ьh7'[AFDHTK[ g[2SߡCQ$YHuƅ.^WfWmg ;?bw<v;v? agJkUPu)%T/+U%6/?Pq endstream endobj 4508 0 obj << /Length 2570 /Filter /FlateDecode >> stream xڝYY۸~PCLU, t7krl֩2%B#z)Rק) =]5@א\ݮO~yr*VnPJdHt)WZ't*fSu N^JU8-:[q6*?shΖX6a.V {gBU"GTSPIl9l)J:!$[9+>Te#*~R Jq&e (qtXC?!.%̏2".ͥnl ҂C}J3fVxbDل(h~thg$2|U{z$ & eĭxFԶle[3@5e.J -sEayޡys>tB 1w" H uI6j]>Z)~ր@n#=dhiӀw,€\ϵ[USJo][UV4$xVn< t;-Rp+ ʱ#QĹXJ74v&JwdgMg./ywm=%/|mi$qPq ނcQo6c 3+&rC-PN('t7O@jӲ7vh匠]A3#h5=D ăіVT45/VVMts9Nu=a]98 >0k?@bw ꢃ>̍>v*=:8~{<1䥸:yXsPt&+.*tN<ot $k+ 䭭䙵s<* ';j&lukYkOmA_3w)#kE_ m3;PtLO #]:tyݴhЊt{l3 f 7M4!F=Da)>zIPj 顝n!Cff9B-m5tXz>?b߮Rry@asL֟>mv4CjloۿD"-v~> stream xYNG}߯G!=}Y¶H,%GJb1&;hw|}Nx]U/ՓLJ ބT& eB2g!B ňX1B:LpF'1K >*:g DCm 6%1vT5)@mPFQq:ZCmε :mБAGq : 6(:0m :(. WU?R4W?ȄPH GH0R#U?:AAA\ \rUP R`G' R:>k2$&Ơo:=4WІԁ"ĥ-P ǃJ!E{<.+9K"tJOF˾sT ^pH0J &Y͂GaDDO y\! (P iGIIv" Rs3.^]AߜRCv=RcpQU2GՁʬq!8Y@?&;;?ivg4I󲛟wS5?7oW|}4qoaڨֱ:H,l4?uo;Ӽ6>q7矦s?[3؀8'V#]hɴE{|zEL [Ʀ\l<ʦ78/[489%WFӽ\ܞ=k{ڬ{.gyYEZ3B( ?1$V)80=F򘄖0gG͂k$:D}bCIz?O' Mp@$Vܝ y'zzuBPT(Ɨ8hB0^?[Lz4o/9y_hml=9쾘zlcT0Ya9zȘo9pgF5fJ P|&2ǯ~)WD01)4pV3=26Ճ֪+T|rVZЮ(1% "<23!Ah/#g#osA@n}0eMV{f岢[@qQ{֖|jـ CGB#с-.< sY>k%Ϭ}Z{n,R6: 1ky{ڷa^s璃/hֳ&EFqƎ\$6'9;Xx*8h5~y-:עVG=-M endstream endobj 4523 0 obj << /Length 1612 /Filter /FlateDecode >> stream xX[o6~ϯ0ܡD]!v6={%f+K(99$H6`C<7C*tћ˫ס?JHzh懣uIȒ2ԕ}wׯDI,c ]QhƢX ̼9Lt2Ĺ#8z;b qp$νH @QJW0qS߹1"EYywHc1\^dfbBޖQ i,6.+A 01U.S^˲uV+3/xEIEL6~6]u|I* 4!V7;q] ۫VF2ƧڹqLkwZ'$Z$8cDZ 'Xq0N>x^6Zz3E4nz^\_g$ev)qiLz$ $?b =%& N6F:/hH0fpq) ^0 =4j2 L5񩣡FbKߐ#sI8aNB^AǢ#. ,&5MEQ?yB-+f0mhꞧuu;q|3) &]Vn@r]s["E<bkW뗙u]:.?|wPu8dGȁBo!~ cAM=0G.tEAؘ]7E!c{E]Bu nOk:uiƴ뀶VJTE;i6x&[zkNOyf#0]M b h0TGt VhotF$lx1^=q lWҲDn;6\_FV}/+~aё9ٓO+)$YFH7x=8V#* &'Лg-3`з%gEedۈ< 'Gyt1D+gPpXTEھx$g v;jM+~}~:(8!lض"Jz2={6& y1JOvVfVCЫ=\nfCBՁW۔BK~fFNpTb>^,SR VU*/[~*ݴoZrGy> stream xڝXێ6}W@E-6"NVm%NËdQb%QCΙ93_Wׁ"qʽ##s/$qy0gL,>^`*!`FOiiHTb5s7ٿ3C6"'"ԝ`{wz{v#T8N(\LeXߩbceeW 蕹LZ/1#JK7 '" $fdTپe-IB_E]RΛ\ jf|fƩ\/mcbV#ƴ1 ㆆu>䞙ihvv* 5Z,'7]6nSrAצ1=K!I <77uSVҺi**+AQ-! s:9I<3 f01cTyXYdfRFȏl㍜́9Fgϟ/;f;lԌ5 6 ]:9m&r2sl)#K|3P#fwk[|а˟VntTeiw"f0"U_jbvirfH;]޸gmi<q+”/:%FsYe{9Roo;iJ6qWwhW2;ub~i.CE-uY5Nt@֗{&K::GLU-p^VQ# pDs[۔dV|e.C4xRSMBI0K$A $0H-)2Ań8:6n7i+B-((cu0e`dRa$mR93{.]4Z2 |[ǹmՎڧBCO$ˊ$oӎ[8vGy:EWnJuzED5ooGH=Mt/ٽZ5v)Y=?Y菺B} `vMR0Vj' uR|z^^ AbtveT٩a,nC]Z_S׿כN% )msPk5(QN CxxZ ,]R牴!WFA\4#i樀AɡR[ΌrgDo(e@1KpN" .YD䷕9G@{~**_xV\]Oie$^anrE lId>EY׆r-uE"ԍP*C1,/9,֞E3JA}5 +Uի[sd:-F=8@Y,*K0JB);ڶ2;IݻR7GuWHN'Nj1>a#zLAgs|M("W.ۦ?\_e*5u0(lK'z223}j:2LOp#NSˀ$CeS^R*YEɑšDQHjRTr1:'u+<&=4ׇmlc+<#+<t'~0AaE/&3f5Q7I endstream endobj 4554 0 obj << /Length 1376 /Filter /FlateDecode >> stream xڝWKo8WamlŊz XmAiKYm$'I=\Iᐚ!gyڱvcn:$Zw[:Њ(%Xwey"[}uO$$QU=%ȴpMmnzJ!-53ɧ7מg :eӘnzgvE2-N74\4N\ )YS*畖hPawH%OLi !IQVqf5N,m:|֢ѻ *ӻ[d;M\J1Eie69+tl"n_c9sM>750.o|Z?R~lf흻xj^<1O\e%`h]C{e{/ƯBjnT740f]w} Qwg<:xd|10] 3| >i)Ln~ R6&cQu8q s ^g;vH?Q}e0 1-Hݼ7yR+N)jr 2=ցx8e/ߍz|7 5C_sm9k55MjfI>O@]sυ qZZqrZR<MXB" 3Xx{C.G/,(;ڪF$pb++_:V A:C|^nȹIECZ^7:Q40I$շjZe%l^L+?XPatV+]ެ $Pb߱U75-=gUڮh cH*%凮Dg!#8s@T)䵩'Fԏ. .Z2T<7XB ܢbka~@@V9z@[E)6V℟#LQdoX ڪZ`pǤ[4Ҙs0zǐC|bh @7r8#%w!o8N5/$p権A͎!0cGJ)+خ+!!2yr~.**<'yCBBDkSCmqϲƟe|TF"@2էiw? Ѧ! 4(:^ GLpiCPEdcS039qdMHj/0,3r}-݇ 隉c),G2+t$7 endstream endobj 4566 0 obj << /Length 2005 /Filter /FlateDecode >> stream xYK6WV/k%}ll-f{J Ti[, w3)v5 i჆C|3W߿Mr/ODݯ(YA%aݭޮȿ$rLR!`"c,^<}^߄3n ܈! odl_iٸVmj#*ײԭv-wU0T:vJTdJEH#٦4=dea{-cfߵvvOQ'ʶ̒1O%q^^d'm:*fMf6A%6;y A.&Hc_ I1Aº=힞k[=O. A'`0Vr vu!N2~nTUxJm4}ɲ߳Ҽ% U>qkE(8 "`A,l&0H[]TدAxB,J:q>*tM yZy&:NVEw+4x!`hH᥂g"8ByēX^ hN$v%KK AM}OJD 2ylŝ.SAu0FsdQ"r(T;t$b􍱋 Q$'L'Z@ ,nlVd\N&6ׁwl H~gGqO.;Eɖi4utf@78wEw@gRwj5TE Ke{ K T]m*iJI;Yñ2CaK.,?`6O=jF,e?8#މ#AB 6[pF@ݼc)o_wf~ ]\X׌5^75,b0n#yX>HиgLul?aqn!)"ޭ[һ'a|NG1+E<5<Z'Y,mx-)<,dTx%KuK 3. e8&@.:0(9E5.zhcŃ-z l; ?(C.8YkC#L ڔ@#PɶA0Bd`pOK 6KW^y><0mB]E]dkӼr5uͳ,ASJ?dG3kɆ&#ӛ\,maKù"ᅑ6̪ɸE +|>ru{J#%I)zB:<ȰtGnS#*Y cv= =C["JsY77;H(s1U4 qγnEzIMp# u c>bzcDžqd+.~^R>a |/ ꩭ‹hlcl^j={X5?!A>N3=Ѻ+AҬj6AzM (CgAByאɺ'ԼCyVZ}lA9RY DA0aHG"  :> stream xY[oܺ~ϯ[@Խ}JsR(CNhw^h(q}F(P}&Woʒ2,3ܝnTqJY\oU{oJ s\fa^0u^E2mV0(nոYuexZdASi C[]G⯙xɲww: ֦;åVQ V#\-xڱ2e}48p[S|2ƝQFX6럇#N:ԦFڡ^N>r C]ΌttAu #G7K6aOdkF㹁8@'(ہU(줅!Kc߬"Til-oTm!~#dWGz Pd?Mw?i#%%( BTr𼵵-f(, D=VUWcsQ[劾%Y-oFG)%#̀O?ZPy4˷IswkUDCցekUk:ѹ%}ѨajF `1_a [A0aD~=^w+UZk]#ae/,x@&LJ`$j ;UO@Z[ɌB`ڔJ0K5МEHӢȽ}[p( >eny}4 KJ4mn"BS#Wi:GE|i}Dn :Ai$x{USM{u@C׳){Aɍaq-[!/\ ݸMK`N>u[`F1gn0MNE֠| mnTUetL8YT¾^9+det\Z!t)v]Xʒ2dD[$6D{[0lS'xrIkFtLqT7[\FV:gjB džWz@CM`A Ճb:~b}YލEb`G-T&"J2,ROPG#xBX1AE3ھn5VK`A`E?N%||qqdpti%o:T|^F[W{Q 4B(n:8RmDCgh=AHOY 1EsBI_(dm2 xB(;Lp̆\8qlPU,z(q;*/Qޜ?|$ul\.Z@o9/եiGċUS53/>}eX+e`~(0:Y {1c(ɘNI`08C^QE*lT7cneI𡱽0=p=I,:}#GDPUBuEz 5&`/{C; U͍˷,F(5cT2*ʒheGM=0PxAn–D^N`eIFE)Ia16*¼ R%I]-`!q L4u}Fz3+) &R~! ex5V}Sw0ȅ:fDs4j^سF2~2,`FHʾIxe,zTxTk7+psXf=us $0ECQ "iGbX'*t,:< { _LxNXof%NdsXv7f5GSmXDa, Fَ5\*8s1!>a+D ](V}i\і~sRxxcV0D648a; vHrs~#9) 5=Ʀ$Ef+7&w sL-QE*ћ<ދmʜ"g4׈@AJjӦ ,&c˔˘߈ s}E_)+ʚҗ@YBjՒ?|+\=vJ&q@rzEסr it('wUκÚݞ}Jn18!cR;7=h#䦏'Z ?QbJʋ,vU\ ȖXOjƀsBC`,"3 չs󺹤%b BgP:1k 7 ,aj;ߦaVOZ< gJ ~$Y>|Iq~h{i?-j',tIzf bʘ/xH(n@?,2*c(L7 ncqѤ= sčSw4-ͽm' k\#bGqU:k&l)O RTۏ< hpXڏTlPܱT=֤*s0Y*TεPS@L *{&g(]PRGt%%MkJ-%-Ūh JZ>%MzKT2%?ݽ?N endstream endobj 4577 0 obj << /Length 3314 /Filter /FlateDecode >> stream xڕZK6ϯ-60PDIXaYd rHDն6ԫt:~Eaz<4ZT,z|Uڜ6jw}d:ù*nH2/!o/UV&mX{ z5 )?kqA:V\Ib]lӡ&8ћ=/O>W>76v~`R^+& aqi+:έO^YSm\G \eςlz@F'l︯]aюU/$aoJEe=*7{eY"z~!gTƮ.$O&.C`%B.F\WeAhBMvV ;-$M !i3Y"T < <%cRdBfkrϡk #BAH Uk2PJV/ēRC.}}÷}tθY>8;,zN~N S`NWb=t-!{`{Ї6#FIHQ7;V(]l/aZxɉ. {ɪycSo|ƹ>ǁ1Ck74pɃxqYg_> QMMb/zokXId0x}ADhb?H8y37R_#GNJ˅oS˲"q lPxz-.6<հS׎/Ld62~Zؐ]}~/m h>Up է3=\Mkc֑)p b@-1)< F7ݕϭ~|S,bXMMS x?ց")z 0,@),@BZ)@'$w ~>PBipQ "L,͗΢= z䑁NG:ktdiec@Hx.* 3쨭#qhזCn:<R2BDg@]v=pJK»]~fF=7&D7>X,uQXߠrzWȘcu@K&D JWFd.s'Yu $4s is .ҵL"EL#6. jM 85Z&х+@c(g:Sdcs?q2{Va?Y`G_vc0LYüI ͳ׌B!'sZ,%6Ӊ""ՒRdJm2Ayl`ITDΥX%?& xPi 5{ V] q(2D1؞ؾtu9`EwGǣKEҞc+̕EpJ{C{< n&:c "&8* pi> QͥxϸPT((#X#`sW WԌ'H,]bqw7MhǸDjX6X6%,;Ct˳n=Sf)?!I$ ]?ʼbbصQ[Fd!&?c_2v0\qVHm -3ޗIcTTLKB&޸]'}ЮrP?]uf"j*_d[-s.IyiIe ,ۑ.^ea0 1oNK菦:׳hY2gcg fjF:_|Û|oUuP+W[^uW\U}D9yx1iH2[Q+d\'[tU{ =Z7U8dK՞+L@\YDw{IjFf0}xk @eLX 7Pu\0C- E `>"",>~+@ƶͰLI:aH7u*y'0@JeExAr/KP#0M ZP e71 w ~5a3y|.pcSN_v{aLCڋKY\Ey'|V!\e l O:UMHD֏C=j?˭)7*]:U>UȽʒ Lwᴰ` 8vdZ)v7臍 n[r" Kl/cˮPB^(/Ҕ2+QR/@% [5.{:J<-(XƳ> h`[j2As>>F hϠ]uP⢒U=II#Pڴ qAUjg+<7+#W=ED,bq56H!.?Ҙ LBÀtcO)7%מ7Ld(ڄ63ţ$|j0]X#"rS1a7npA,4CNb<'_4 ()/LsABMpkB,%6b.A62kgtJFo>4v$͂?W٤M$2k"fu?Yv mU1zjZ_O@& endstream endobj 4584 0 obj << /Length 2471 /Filter /FlateDecode >> stream xڭv6_#&K&=r8s@SĴD*\|}PnN^|0 ګnpw޿{96boBG&R:7 \l&,I*#@B6HS٩5ʋU_B; rQDk2 tr=?P9<ݩvm--lci#ln[eͶmPAQ_}gHfG[1D_QW]]Y;8Jk]VH*՞@iv~84[V>-xfcSWEFbcL.!S" "lElБY0o--AʈHK]M߲ڗE򾫋i9ߛDA}X@]lMxgYp$?*$TI% ij#"胥e:߶'kyO&ʓ$^y`O^{_b? LMprL: XӇB;$z7I|&҈Ƨ R,) &:Ŗ`f,$"hګ-_PF)P UQԽ3Xd*g8Gqe=c'4dV5mU ̶m^$CJ ZF\!5\XhD5yӲN,Ph!Ê=P2Gi,{WPeښ֯ 8J>t@IH ĈQ&N횾 /[K# +X7%:ɻߚdzfDFkLL⁝SEd=D;ueKv4r {xp* pTlK7>=s`[ռ Je2 ci3Y&C s ;}S%΍;K~Odzið3pNSҚoV8~)N;zK$@ 874q<Ĺ0d&p5oϠQ蜩+41 M,D`LESX R2]>jT9FX$)dl 2X=h23e L^MHON| h1&=Ebz4S`IGZ)HMl +eK=*M}YI.k7}J?rhj#Q'$>x;!lG`ca|/<* ?Rn$H3U )dgbBY%~@AD>ݙZo1S,? VxE Bv|oi?-~o3|L ς›}SWKOBElr>.ҧ!yjD7r()!]L$@M86_' W0"}k,7 ׆ ^(Pwez.dK\U6\/rZ *Z; ȭgs0B"M})$L-w+۸'V e@(mo#r)MD@7g37q<&\swCfA{%7`pIH̹gPW: KVfG9VPaRSvC~ϯ5S7+3,V@^SM.tL$4:&F3)nz ˻E'o$i,Ԙh3dc8qڤ> (dH@.ƜrZPdz=JΫK~>?-rvٱ[Xξ+9/ЭYgrVu|2Pt m E@bX͔+nufFc*@hZ) _Tӟ8b>5sIܑ1p](5f0F-8NSEV\KrKj-wk-ā,-Y)?]8BZ []c2[/NE%Q#<!vgV6rd-\]JlBSFG0w)]`k(0©dr<7:F8˴.44}^U v:!~hO*T͵oTƶ w܏1ܴm[B@QzPGOWE wlW9(;e {`AM׻5$ ͨ9[qPlA6niRӱǮ$M< a3u|vT@g1`ݚ|wї endstream endobj 4597 0 obj << /Length 1716 /Filter /FlateDecode >> stream xڭXmo6_a`+ BKE3 i}H舭,i"4㑊8/[E=Ղ-~ų7I(" f0GqȂObqQ-.(/ޞI=Ѩ`~Jޔ(YWQVa}Vb{<5\ 7dӍmu4tm7UZM7Юnl*:^oJPƾ֢ 'kKAoֈЭ?EV ) ȮŽ6tfƍؖyNv<"S(%:">*n2_5# &fQ$Y uGBsd~NvWbT~No A] @e_h qՑ 9}C_]IgEd e*ŀ92wv[,o󷇘E~NFX4t[z3s=Za`Ҙ×}x̯!2,QÎ1H^YC A2*%<%qC\㪠ĭӴ;%D;foĻ0Ye ubRj-B;%rKh12%aši>p:9yew,J}ɢy~ g|y'ljTw.O%cSLB"#ܯ;zݶ̀"DJ TO*Djmumna 2 B-wFڂo͞fE*6nʲ/.]gV'*ݘ'᱈pb?b8u,#!Y(P8^%zN?Īsʕ; {ޢ%P-Gf,L-xlJ4DKy<Jn O;PgN eY^ɔMfϜrl /F{ZVNA1WErٟK?|?n WO,hQZPqsdz\Jy&f1eRe#Oc0$w41uJ-xeMY̢=Co`.cQ76z fhs>8<8 `q=. Ǐps gݏY7 z6x-u!0v?>hݨ,Mҥ3 f烀؃mHZ˄^LA= ZZ|'-YU4 L/P n瓓֨LBh ӇY(_VN 6UXip/ 9X endstream endobj 4605 0 obj << /Length 1054 /Filter /FlateDecode >> stream xW[o6~ϯkYuWZ=lRl(0xy@KtDD R"[6@,J:\rWloJ4"k:~Y1N֦߶9w׷a2"ȉT DW~}V"A#_{x+]Ŏ{g[Gƛsz9܃h+uk8)H7_o"?+[BP(:sX^ Շq+nHĬw2ė͇uO;5uP'D8yӑr`EޗQ?3q hjD)9&uV1.ZHUvujx@,˥ UW Ŏ$S# Sgvd'S9*vhv*NzIR -ĥ;+ԩڞEEX0c؄ k[Tk$!(SrM(0ᔶԺ1+%O]u<QY<\31eP Ĉ]uHq|*uw @a5~9ş RrD.yқk}0p":EaWW!&6ꊘ(BNlB+gpX MMbSAU8 ę4wh03ZRznM+NS&kL%=_ѥMRƥ7M^r{İic/>3F/mB*Gk}| ELK(EȨbexlI]:8xi9nbֲd AV rInI<ņŒ1bq-_]l ixN:Ut^{.p NʹY{{d2/u;J0} xj `㢻CD%xDwZZ\գ𼦞Tw>{LYq0=]ޟ-gU5 -:`z;-l&2U5tc|eK9^P: xq1 A&lq64KXDٗ&UXJBMA 7ׄ`]0PoYsus/ endstream endobj 4609 0 obj << /Length 1290 /Filter /FlateDecode >> stream xڵXYo6~6 lEaAk(f? ,aeQ);٢3^[Ǵlhߜ6{?"Ʉm\_§?ã&F p.%pԇߋS.yO4ր0USx8Q V{]5 ,gJf?~ccK֑u,/>/sW endstream endobj 4618 0 obj << /Length 1947 /Filter /FlateDecode >> stream xڵX[6~N"cc$Jb6@E!:m+$G;gΐ,:$g|36~^p 8wDSPm}idXO"YqM։8$*AY!Bu=be%T@԰v2'q~mk49I%*?,c~RUoJ{XjmLGpj%uR~UկX9*zgDb C:d|tF8de6#Ʀ:'L1]f'*tO"OHB_J̀|.vNK}n3}/Sq^Y|p jͺLw]_0{~|X/*n˿iuWefVUhxKo ]6Y__8f | !:ݶwIm%bNh8\z< վ7e~`y}4[mv|}}<IoHy8 4ekm*.SM=y$5%V!LNT_~P@"\LJ7*2~zgL6U">I`>&[ O Bˀ FM}9\!u{nzVAE\uH3:p$Nu3{p#s8aOV刔kB?7 9P{F endstream endobj 4514 0 obj << /Type /ObjStm /N 100 /First 983 /Length 2036 /Filter /FlateDecode >> stream xڽZo7~_$r @ m+89wATybK$_KͮC̷UL31`>PH 61x%I)+Q KRBL EW9#7Atʘ7ݤ)S-;tU Uڤy}^bqXˊĽk~m~k~~녂ᵽf> $$"z^4,,L|wz>7y{iWgjQl 6ȧh Q(]bDAU qDpI 22אňے=!n%قXFBA#Z³%Xi5 ĪZH^@\!ZͫwGsޚ{rGr~Kpwx{p#(?<.Y.Y##bGtixRL@FږWG٥ss}6]=\־8v}j܂""8$[{31yC?z8_^]x}G-hzԢvj/GlWF!dbFh]/F*ȡy у^q%l(Ǿ*Ae@eJ h1= 76[0|܏#%͍&XR(cWv8̾/7r:&˞>%$k<{S^tR+^!1k|BCFD.6&Ш2H~nXѓ; ܾ`0 2QUǙ7r|v-w-{=n,QKd.tԓtrwH3'9]4ONl}7^_o&br_(z: zyxrzz5mZԺUW4 wqa|$x<ޘFuz'YCM z>jSo6,8`#|_quӳ]=nG2ot',c)|rp{C,LJ*1խǝ0||q.ҷ!+垥ːV?;=Kh$1wO<޻ȏ3psIÌWKUHUHw`&]ʕLc9Nmj 0%c}k8H bx ̝opJH? b ȗl4OU/?0Kv覶r6Z$S4h!jz*s4( lE:ʐ$JIwJlaҏ[;'7`Qf6v^vᇖ6kVɁ͏x'{usv1 }Cz~pM_1/KlYnK)JFݤ۟]mzBD} sO/1KOnlɬ_%# endstream endobj 4631 0 obj << /Length 1370 /Filter /FlateDecode >> stream xڵWIo6Wɡ6qDC&IhjhqK{GY(.zՎ짇ه nh=-8C+^b=d֧Nj/~ ń y3uhp6l7MO|a3Λjt0Z.N^yC1\uHWc<{>#+vVMw=o@Re]E* ,3g5 .z7c |$M7Ez ?0Q ==`Np=2$bK U$JԂpru$? 7H/fhHPȫWmZz#J ժ޼吘WՕ7i^ ydyw_H0߶B}c[|&6uzauFU}E 0KZPJjM)y(qdEs(k_&2(} s&:Gj&uտ@Nt} K-VvxDJS$F5ȧt"7F 7|G5ZeCݪCy%#[Y6P'qcj ' 0zC^~'{d!^Pg O~ө/ !8\[s0MzHrnɑ$4"$7CjDgx*zF UNoHאZϷLwtF"JL*dÈ:hd,92ѕX'xT4ڃvO}㯜m ~8/鍧M& 1ﰝ:N.z) n W/;|m.|kYqWrF_*bXX|wSx4d1a1`?"7s&T5QT3 ^6R;d2A c endstream endobj 4644 0 obj << /Length 1522 /Filter /FlateDecode >> stream xWo6_!b1}Mņ5Ni[,9w,يeHxH,nωQ.1b^t|= [?j8@a"-ļX 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) _#PMQq endstream endobj 4658 0 obj << /Length 2801 /Filter /FlateDecode >> stream xZo_YH=4i| mќJ\HZ;_rHQZ60`QUz(]e,Eٯx0ƫsluS>el>|:!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/x38pt. endstream endobj 4665 0 obj << /Length 3062 /Filter /FlateDecode >> stream xڝYYܸ~觬ֈ(؇!`jO~}ꢤhvMEXWT{o~]r?Otpީ 8i4w?Oyχ%ق5S_9"(Q&V~gC$0ڎ;vr{?sEiA~e,NL7\,7d+n{5E5lτ^)A0$fZ8Z_Hk%ƺ~'Jـ#3|v:p 7Y~? F<8m %Y0Q0}$.&a#0(̱n2q-'HX,&r* !%e5I:67ӥ$4TK;V'-NxZ{N$tm;0(Nt1hP%PkN3~`;,;! Ypko/{omyb6VHc ǽ|[{D:_[8 i_=CrBM'=vOq4<4 Ϳ lTNXNeg "6ܞ)b ux4=z%2-l-PɃ Ix7<6i>Tn` @ӜL'=utZY _S0`MuuJs(`.T'e+bz ȇP2E;06+Á@rO [&W[g~`&\нRZ^`OZ2uCP=,N .¼lMO&wRUMϦOtyUmAr n9<[`X'0 m(2B‹'309y˦:KWuԆVgٔ{FkB֖[Euۦzp Ę}H 0efͼ,ߘ,ȊAL[ܘU|MRG mQGȪ@s<8@t"\1_wcO2oV˧h&,7uƊ +  0*j nYn*W75Ԅ X˜M+b{!`N ,A4θD|K݊Hd0剪]`R"c`%F8$HK1MШuz8l/,RW2>\rn΅D⎱ 6(\%+Wqe 4v ȃ/ЏtNi$ +=MIA' BBQ;cl&ðUH/"J=kH"=qe*Evت'Y~xۍc_)WbK:8_'g ʕY5H]ܺ ?vpո4/IJIJs2r(8!$L!KA{zJ£g=@KKAôh9eȣG*/jڪD#ASw:u˥yH7F/o]X?@C 7~%g7==}3E$*A `t,ʑޏ`=X+Pt86 U.&| "=â(#@bXe XkHY =(d(K٦Md>>=Vp{ /T2rpu%"UVV 1Jw0 b8c|Obz1-g j]6 bZb8[B_U1CN#P%XU/^z)$u/c*8Z8!dubԍ[s^6슞=XfUˡ3o} ƵU_{Pͫmiku$+ \)I׮DLH+;6z>]1Q"vlFZLi7dY.< I # MY&b^{m(+76J$IJ}j8ZQN .Tn(2i] ^>-6etq6xf%gHW4Ưo]yTa,TԜq9tn/ zx|U^w\p|"X.%Hu}Nwp*~ 'F%jTiRcF8(** $k%?+WeAxtzY %|q 9GQ*^uZ~jUGzD6q`HLN@T6Oa!?9`8$T^/ ,EGV;z}urT9?Ӏ?=!}*de+ols ۍkU] K"eoK=㇄ŷ0T}\ -sܦ+[B$6e2aH%}loq١( lAo P endstream endobj 4675 0 obj << /Length 2589 /Filter /FlateDecode >> stream xڵɎ_aedIrH!&L*k"K(uu}#r@H>.o^v}1v9잞w< ]9Kd{v2?cͶF5Icl\?{uA1hw),J:Z`W4>ERUa*}G<0a\v=\pʃ/XrK F, 9]3aH {F喡ñ6|'pZPH$k3!$"u[DGElQQؚCCH$(2*-U 7QS}ѴᨆWZmd" ĢhaIH:6B љIF:@cb? VB,&V39MA N +OxxØDKh)""gܧQXljfʁ_ohg" Arʒot]ͺS3TEU*A.ܕf ;vFE9UN*M2bU3ԇو_@nKn#S&nZAS#ph`3 bU &Lj&cӞrڼ)by]W,b-TiOAd7,OJR&G||+K(}ءL4Kp,Hd0N'@hn8 ֮! ^~SH8=7Ƕ\<3*Bjz }C閡-jucxgb04pEcٮGDßY"YyWPh0Y2nrgRS| lDS/*UGe6:/,3Pz_c&o0s^:EXLos rA/5Ţܷ/E/jcw zL (.+9CQyȅyja[[77TH:c B P)G+24>MH+T4kwg:|#L "i:RG L20jq_:؁Ũg+Fj8uTy_ ,c{˱`7St+Չ2MqXkw=*j" hrB-tv~ 0 mC$s$`cv5K}bL3Ǻ5X:o_R ֓?sܵ8qmcт jς[Tx(3\FsW=Kj (Q*f9 *.,Y]^dBO{Lg4s$!I 1VBVgIϋjo59" v{]g2{Np 07K y6+ 2v*+D䩷d,w> 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,^|xm`5 endstream endobj 4696 0 obj << /Length 1271 /Filter /FlateDecode >> stream xڵWKs6Wp ;S]ڝN=$9@$H|H۳ )[vH ezqsFBx:1e! c١O\}Yzs9#R#|Om Ⅵm#.`.v$>lڒ͛+ӵV~]N&P*Uv뇄+̚`^3:SoN8(v,+G(ځ:!pfvZuO>{&;֧`evP瀠;i`$gEۜO`qM3?[Ѿ^Ltk9 i1&a$,>MۮwEAӬbO&(nДMu9J-{,+2޴g{١{v@9)6rܳFޣZjjʺlf @$tN~(!'v5ijD!qq^ix F/>}A8*0=in80YMf|X1l!80sc71Aau0*͓_W!bF>qqE\Q/,$DKhk^xy0v O]WDW˜_AW|O"+^b̍ a$KWJ{Vw-\wNV"yk:]WٲHJqJHѦr{gm AF]rMx6є31zQvN/T da 7VTB!{^?(4mjC}Y`>4G0m%"O˃\?.'ܫB>#Ɇ{SLB!x L:dJ,Y硂84- !4c?Au>1 endstream endobj 4713 0 obj << /Length 2212 /Filter /FlateDecode >> stream xYm |[MyA ܇\je֝-gCɢWڢN493%؛bjVo~ F,NSPhUwk*583CI_|1Ӯ9UM|5 m B0"oUҤcjDLY$̄N, C<xȫǏ&o~ȖU]/c $*Ejq,[u5a4q9+F :7vF¾M57놌u.6D"-pi*QЭMIWXAIJEET9wf}THnTi*t`)FQhЂ`_WC6O ;hcmHUq_r,#}~ vi(d#ez!SvLe|Tuna'_  Y:كΔ]PQo m 5?wiT #{/{3H0aކ 6ڄ6BtO 5>"q9^DSkğM42QX s5qJoG˖CX̰mԀjCmEˆ,1z7EP.^1EVfWha gC M\r e꺪pe߮uq jиj*~K7}|iㇵ2::=/AĒK)V7>ըBU_kON pNW{2qjlӝHEC%Bd*2iM9W*Ƹ֘ձ]nWʝp!CW=15mNCf^{S/tSwׂW!-Ԧ-$^v.^]-4Dp? D!Q=YaOfe05`[: PO%9_HK_9 p1#LthṂH{Oj=y;8ώ\O.n|Jƅ]tb`mwde ^,l.?O?Wc3c%HOKim 5/0Wnon=4[G0PsLp}n,%Ryocm<0\pFVJ&]9Af Y-1^ &mơ#8l@~D_m[anXҍpwlB_{67,DuE: ћ4NCK$P3YK$-$b1 Xbk޽n$.$B첕4 \sj3בc9y [^{ӗ'`JHUO{;."Y'MsfQBd"ԏMHk_,rkߋrac`+3t:9P@H qIԔFݻk endstream endobj 4723 0 obj << /Length 455 /Filter /FlateDecode >> stream xڝM0VJjqL&HRiSb/f7w\ vR/cy0RF.>ޑ|I~$!c4r!QJ|b~3$5 Mz:YCu#\ahLT( 6 F^pM_K3SQDv ;aBkV fu1J]7Z_VuE[ZkKբ8wIh%»GAh#RX94F 3h-l¨PYq{WBt{]Dz(*(N6!MǜQFeQnR~ ]LWWn|*\И3);ORyN ntQ8Ӹ:iyx]pvah:'*\.v|&VY+,-]yO$b/=\>^:x=@ endstream endobj 4628 0 obj << /Type /ObjStm /N 100 /First 981 /Length 2119 /Filter /FlateDecode >> stream xZmo7_͇r/CF4EAzg^'Ȓ IJ+[Mryy&$NƙXR2;I "HM^ oR.J'U4 b(N*ePD: *J`) (D.ͮA ׅCuP 3+" ͰO*!T>6!Յ.!"%VɮRh[(3@Ũ2 ƇHd|zЀֹ |y9)?n9 fu&@`4T FW (fQճM`ɕg#]YDzsQPW1 k37_W&9Wg@Mt^ }Uˀ ,Te夆!`b&yXLfP $יp})q0 !.;KGxG黺0 0<@`:UYRHbU]LR&{QL0( T'I"(Udξ*ͅUa(2ũ )RۯMۿm9[U܌o~U/9>6KlMi/J`aT^*.`J+RXq _i^ͧg'œO/M}aH1k10z5/,5?j^ӛY{ 6?яͩ zR-昭N')V;]HSc:bQsrE}rq:?o{yqJA1aDbvjbZD= :1_o ίFfrLnQH."0 5;->8fb:5uH$[㫫lF O7PJĒ],Az==YAXht?n|_FH w`_|?@|! n3igڤ=+`16i T ERtM n(ݴA 5z#1ۢ^{ȼxFx܎4cxu 3Yn+}l_gE;KXy<Gh61f J$oj9=;~zRJ㟬']E 8;tuk E 7em(yQlz5H6ka4aE7B kѝ?DKoxV=d^s\ާ![Z#m '[oq{bt=}fV"~#(&oKzK/i=P]z&uJ5yLpU6nҁUG]jB) Q?SvO[F"bGZ#!7쳍 5u,8c%SxhΧoìY\s{2gWAЖ#vUKBU*H/oYbEca"-Jz jdL: ۢa[qˍw\oY;hk@ޡA+1Y^|w?n`E{r3Qͭ^'7bTVmd]Uܓovg(䒣 endstream endobj 4799 0 obj << /Length 1253 /Filter /FlateDecode >> stream xZ;6Wtf"x؞\礀DP|eh(VR~緋K}&ҫߞ޾xBLp"$'9'EM=fD;*M6Y0>+MI!'Lkχ(8 bK6|:[]kDӔ!o2 ?$O 73ݛIO9*tFc= `A gigBYC2  I~. U(3Sf H s7l!݄͇zɛq@q0 a822K̥6}$X*[!5yݦn m(Y,pv;b^|&w@sgLC[5lRArp(^QK~R9r0r]#܋'y>˭8w?[4\'>~30g=LAcalmb&  Fm:F 1 Wg9G, ž^@k!$US,ƦB Pi$HzSZ.D 8M-c )C8j? ڜhΔ)(R_1Ym2ByH׷eetM>:suA0eLzUT*J $9zP<8H}濋^_Jv@Ğ$p7-8$oA|~ j%k  s=Pfrn8\H8r}`"a$R[K)U}C fL'$xkAbON$rrJlfx|:(n:)( |Q ٷ*ʾ"F𝺮]{ݤl;4A,[u/L] RCv8deWLc8(zFǸ>% zqJ܃ޑ<?e}iNs e+cY| AvQv+\k{WT1BvwN@z^> stream x\mo6_03|nMa؀"àXE3Kv?ZV,S(Ѣ!A=; gz}{u}L1.gB@( 'jv>"L~7}HSZPwǮ`) @?ͱ$dlX LBѳKAofW0+Ral±K .iR 4|c.کj/l1_o( 0 .B(!Vhm?#thQ7T{'dP 4l0^-{n ۢ h(cLxh86p$Yp ZA` >?I=о 05"k"QyUioDU\K{)Ϣ>N2N|h'A1 SyDؗ_ 4_l-OqSE:BRٞK(^癯CX="j]-<#-S>pC3V%QFj&ʃf;7'4ln_ҬIUm4﹦ H7#9 \kؤfY g|e Y4fw;anjRa#e jݷ%8emhg K1Yo7H0sv. c;qf,A:%jh8xh.0 MU@8P8%f25+.8-ۂ4zʼbF?xf ( aQEv=)'aI>E M^ mыS5GS+%Slljһ@-]6lʶ|=X9SUڛj%u{N|}Ԑl^2^sjwG͌R97jLBGJA'sf6Kk)K c ;BT90=w?qPzUq5Px,?a&X)SyH DP|ʂegygMm>ҥƨ9`gk (|LA:֜ṆG =R?W+CGɼ8]IbԦ3APu0R‰-`N<#q.F#ݎj3y` jX\9YY oW^(]磫@ex0MٽS<||%K:{ޛW ~c\\zAgbHgOE%;MrLQUxzAV, J<`S2`)A#6Hg+-kϠ*L ^D?$#wI^و}^CĹ^82W 2ҀV+>o)&ßP9FuͬEA7;F^MB{>%юD;G%^J-6/!kיMES4D`aLJ Q (fĪc@w1awOyW@>@yܞ#tnF 0F;f;ͰK@PʫD1XKQ|1NsWjjցM .+"P2o9W"+-:>;QÚ /a@驿@:/$"&Ә?U8?io-ݺ# ɠx7*v}dJuEm)B~ K*utp`eCυ^MƝmS>38NH5ezZ qiW`rZ5>q 0ZFCff玪af ZO,V:bx \K<.i:u!y ,jMC&x$.PABLp5̑ZT(SRfG ~]\-_R2qY Ts#o$([%e=&Ѭ(ݭXʲ8}hVdsČk U)0{|7t6sXth}FJܥn7Wn endstream endobj 4726 0 obj << /Type /ObjStm /N 100 /First 1016 /Length 3074 /Filter /FlateDecode >> stream xڽ[M_cr% >$tpg2TsYAu N.Zljv7kK%PzTM^MC?4/zHbHG)RC=?`$!Xoh2!Yw{yWC}d!(r7-&Q$H-ARs|f>jA  =łlAl|+Ta 6W<[U6M|5 xߨjcBMCnKnˡk$PUVCתҘ_1/̅-Of<)}b]Bת5`}z XMrl-xW0ǻw5nc^MAxWs,sY-An ϶}lj,=RsWf1ؾpF+r*0 0Lek fXI1G8u3 ~l H9:F=`Wβ?__)W,"$>XV-V CFҎHi#!a6I0J0ؘ"a0[I: 0[ٍ̘tLTK}xYx.gp_!$l+{Ga,xYཧ_>y^`Xes?۟>}*pwD_?⍯p3=yon?ۯ7~O|'O?WhXjkL[|cZ͛'#3"1c A@8(TD" ++++++++++;;;;;;;;;;Jd%YDV"+Jd#وlD6"ێ=ŏ7ooo4>5ؒm)P[ښ65=o<8E˧N{h:X`ۊnYK6֙L@7 7nPߚN,Hy*t"hVIP!EUVJQQ 3 W 5?tX#6!-۞^Mpf,H_mH>l Vc%zrk{eۚ'&8 6DWv~yrv01V4BvIuC҅mk\72r3^!kr[tLa4^/\g2Gdƞx+`,cb҃ Fऒt/M7CR|K:s˸5ml@f^ʌ3OiSe}Ĕc/4@QtBIJyx.4Y.Qz̖7UϞ3,ueFD-5n٭ȅhfH34ѐ~F2BB+D6Eŕ+fNT p\ufP "i'aƜgV,tuSdY8rDE6/' y2"XW9M*#Ĉ֟ p9O+Ι p0eLaZdǕVpnrS! YyS3 4|t4'սxpM _l6 #VBh̼^~} Ď2;ɲ,<ԥ#W_EzU-̱!x2nA#IzZ (+װ+M@[" :^&J#{j?am~RG&Y#iĽQY闆oT"_9* }qT qT&FԕہS}Rdܤi(Nr z>!G޼Bz6^~${\-:h++̼avn1GZ2t]Y+@cB/{hR&ZuwWKΥ8h\ Όrvһ]4Y{KqΥ6,iz4_qma$m %`g6VV@<ü54 i~48H ,Atn+>`^A]!(ԵDdžoC4{yN1?ؽB=Y^y-w%e=;6ieˆEݖĕN B=ٌͬ] ({ٹ7l h7 a3-G/J#5l4:^H+qΕѬ( JA6igE gG)8zF} TUziP'{OkvKY^ogŘ q9 f999999999999999ZCP5Tj ZCP5Tj ZCP5Tj ZCP5Tj ZCP5Tj ZCP5Tj ZCP5Tj ZCP5Tj ZCP5Tj ZCP5Tj ZCP5Tj ZCP5Tj ZCP5Tj ZCP5Tj ZCP5Tj ZCP5Tj ZCP5Tj Ո|͈lDA#4rA#4rA#4rA#4rA#4rA#4rA#4rA#4rA#4rA#4rA#4rA#4rA#4rA#4rA#4rA#4rA#ת&(.Y-2_0 0!4 Wϵm8O?7L<| endstream endobj 4974 0 obj << /Type /ObjStm /N 100 /First 1014 /Length 2148 /Filter /FlateDecode >> stream xڽM6WhltTRI *ɮb>!,[M[^UKUJ[+sHA+K QE/JRB޸/ZhvURT_Q N+FAAڟ *12qChBukSL۳-05$~El(v+7(4^4IvՂ{Zh϶ 91v\`#sV]qb9 K5B=2~:jJ 9eoW(dci.^! ,ݭ9=QXy/FdJaJQ2@bJKދ`InmZ0=[ QJlبl*[U,11%Y xSg*vݖBKY `1{IhڽmrhU+sZU)n hɣW\"|18 15@' SwYKaJ[0%åPKX#u6BSw#U FL !phk,8o `ض`[7$.l kBV޽{{?Ƿ?~׏=>>AϏ==o>sx蘐ֈ Lƌv߆w맟>_Wu7[@QZL)9¹t C /Sw!Ev96/?R$B$(h'Pd]Xi!"Q ]_H3 YH1J[}K>a""_9hPt|xF7>Ñ8gep Mdc> 9vQXAzba*ZŌROâLV %"abh/ɕK &_@BŜbe\@ İ^WNRdeT(PwN@Kb`1bR1 ^9V9zU|b0P_ t%,J0 B}&P!(Zx)CCLu֩=0 Um}X{7eX@. b*Nuzƚ#fB;SErwue8 ؄,԰̣bu2{1H%LBycgK|uLK_|Y*{c1pY(Cf `[2 #_c3KK}lK/oI.OTĥIdcJ2V(Q0,g0:g. AdQj KP#"T1G`ZUj5݁Qs[ $zg2Թ "*} Ϯ8bNID~KS NҰ*''Db.J5jBWGCT\$U^<&5U}JJLgrR /ԘCJb'XRR&PeӀߡf0$8ٓa挡r@ ARO삹C97(\)E AZ? Q$MPšS -7HŠM]js +ӂ'^X)9V PXX;;m)'҃ ~&!B(V.F@OFh+˵Dy*VngYi(րka71jrnՀj !Eik4Ky↩t0k)Wf@oC^ 1B\4ɯL0wXI|qKH 3Vn1Bb a7;(3KG9 2s v5(}E^]r@ Ek9%)t;+\iKѿ>4%PЫ =MѿS,-m#S($\/_L?}1v5kk} ]=, HQdZ2xP͜bmٽ } g~88XE?3,=O}E[}PsJ9K4ur~YVAèP,_·\tkUo+7]4X|#V~\Jg < endstream endobj 5234 0 obj << /Length 2409 /Filter /FlateDecode >> stream x\IܸWLE^'3 9}03VZrC.Evu>0T[p[_?WNWHyBB*@p"Wϛկϟ?W&>&@J3d'x^WB~|*:MtQ`e.A@{xbr?~C @߉(+Kb$BY`(x.ew&(Xh;d*;M)Q&9)gFZey<`s5Â=ٛF.!ۄ>{<@$60̂ٔaA}oF2ve$9RA}(aK"LڎXIag͖OM#ʒ b;Fn3Crv 3mDU̟_l0|L%ߌ3yIڅ<-Og{ ׫ sVZʫtԦ N$>!R"'R&RB aG̮0UZR|$"-8JdQU&. <2k-Qq6OPICFhǥ|"UNK'XRX MIYC6<62GVlUglP@ XTgΛDFD8MVIA`qrF`]Y_o|BDXv*b/&߼a9ePGƕSg+MWQ@21Fa#. Fa=b?:uGUS%LC{ w&;YMK",]gNjю'hY)KxvQh?}a<`q',,0K1b-A>9egnqX9>q*4O!?lˆ?fa:6A;O(WP7z- J^u|>{B1!<9 ~mW&7۰ UŪ,f*uIbf=< n y9  `[<*ۘ.kZJa0F}>6ET˲[6m61ڮo_/>_Fs)Z)EYzH6<♚y'Xc|i|s-GOh~!AB<λ/*zl b Bޅv?89r?䁤-(?:6͔)ɠ{s$;zBggxy "[\ 9{5LN->`B fFJu .xl5gp^J@\-1 E|T3dq:1#oNkn;.?7np4R?r_w?rn_pA`-x!8^WH1}/};~f69"7x9ć%5p|8X>8zE1'!:DG\g~^T/^9*OM)R@YtRȿ3uq&ooɻbqմ$/-K჻GhjfV5A.2lPp+c#`Gf}ij$.□R'ÎdIDrGtˏkY_Bg hN`<FWDQ5 /[##5<1 endstream endobj 4975 0 obj << /Type /ObjStm /N 100 /First 1030 /Length 2884 /Filter /FlateDecode >> stream xڽ[˪$߯ȥx ma-f!K#,:#"o07;8r< OZ{%y0j*VhqO=[# k0,'g&I4,)IX_O%k+JO*H\6%iс>\[6AVI&xޒiO5z󑬌x5 .EGdcn_FAc-k; @( Y&?tY)Uc .RTJ_ەT@X\jKe,UY?T)<^8.HI|ԻmKX= D Os otIM1z`} `.YZLD[H.kX-|  xP 540N"x@6Л ޤ ޤfD/3bx&zS7-?Do6]DoU2L-$ "!8*"fH/HDoMЛ Ao.'LųDoz6@ ׵7k\! ^=\OwO._?ϞL^|od}pkmznKG`E"r/4z._˟~J/~ߏ OoіUY; [Vm lCĉ,.5!Y[*1&Y9dlq$g,Z]#W [4!>3,F] +̑X,.FYJ$ozb+:uۖ5N&dfx?~/*ܔXD+$XehgmP&:P)xIx8GL_V~ Q8_;C/ T3N䀚£ Wd 198`Lu.ȕW1TGt8UGPE}ekᚧ82BP@rб6?07(!NPocS$jW #3S#$qDbpEDSXbPybfIMC=I {\ܮoD$f*UVS/1([P-ӖT T gjQo>u皨XyS$P?w&75#E9;utĬI{8$1W5v]yx-gMٮjvJA)|Xq"H@c!6bKLj]d;^`H믓gED%Wzg/$ =7q5)Rh7=g:窜$X\'E7X WLx+mNjՓnq&58 k'oߙԸ ycNâm5IZ\s~y*$TqHbq%֤Pm$#s]+-e_;֊I{[PݍC?urI*{3 endstream endobj 5236 0 obj << /Type /ObjStm /N 100 /First 1014 /Length 2039 /Filter /FlateDecode >> stream xڽM%WhltT*}0`!1iLu [zTR%Pؠܛ zlsl 8t99Jl$ F%FX\Xnrr TW{6J ԻI Lp`+KX2Dw(tNGHXz4j 9feJsȕ< i USh Q :mAr3ڃ(#El,/ڽr< FItUtҲۛ7/}}O/˧_?K wo{G1!%G{ )68k9}޼ ۏ?~ oW1sKxP]cAR+R~KcM L"`;_=ͥZT5#HrB^h8flX"$r*W-2X" ԰ƎȷcpJz}( fy@?H A9'[Yam cSLQNQN[UG4 Th҂@ #i)r;1 W푬GBF#P,#P!<5!P 8 !+ۋbǖ^&r=E/(QQ)gYz2J SS3Ry;Rc2;cPu6RgxRXoKf4VV`ҙ1fJ=J=P? ; (h!qL=bІ ѓJ8:iѰ 5] Ab}h)U&Kadψ'O=`38'TA/h#8F܀@y!si{rd1$ў A,F , !{9h|B RP\V);ԽvK)pqy0 N۩18" EYa\Kz+(9!fBxf 솽Ft%!F^ 5±!֙SC7@=(fR_&S~ ;? "RITi.̎MAtK-GQrN[ |>uRQ't=nEwE1uKYYLGQ廓b:ꖢG]QQ[uALGS t菌^ΝLtNQ8A1 rNQoљ3ٓiͱ=قhkD͎~Ⱦ}9 ]jn<(b)gGf*Lxc0CņȚXbQ. ;+O#!.8[|e|)<#^6RczG=%|>Ü Q'qeJX & gHgvR-/32}(s[ `Lyؽ B8ۈYI40[)ט>=a (}1MQّkrF.h-_~bc6JOG rF}0QspE? c ! n' <7}(b-C)itA BGv=!ࠤmzo[/ xGg\4U+48y'.F'ь!ZFٌn!X.F'-ģ%"? endstream endobj 5500 0 obj << /Length 2444 /Filter /FlateDecode >> stream xYo}<6@̈7&YY"g4cՒf nK͡ADg헵אȏ}RjV?|ởXI b z8a̼߬o}~b(T~xw^Sz@⿧_QmȪa^m&HB.;{~tn=/!(mMvplB]ЄW)/~Ie3RLwXϪǗxl9w@Mۋ;g-ɂZ5l6&M 0kPdKg{"sb9<OH8QQŊT$f-6T_^Gϙ f%\ABʁB.:#1yL<8+rܟoDp|ubW-V+BhR|Eq#ݧ:LRwtUSl ؕu@i'@ѰN|#"E_6>·RCRY)œt'qCYl@WK_10Lq@Hr=ZE3?Y~ WshCU5F$ 6]xlJYj2sf:l}7AuUyPU(ew-aHuH&g Jzʈt-ɌchѕuW`ީ)]#~ Pbȝkq榅eCsɯ,[ZKQ{ɋ$aKlNL>Ko\ālc !@(ˈFet/*|Ixx=:*O?`F!.\tb\Q޷WNW R0o) ANHRT9H)Jrû@ޜ@Y);uFź2EّqbuSIoC/pMYG@%ZY=:YQ@(?ZYYǛ_}+\= u-ug?H`pʗnŰ k2>owy._*>aYSRIԚ+s1,LFW`J;tkޟfu-`T ^eFϛWNJvU=Z"&A?A[Lp?BT/L Zf Nr6ro60sv-<:ƦL!~K=j }ۉ\d? wTYPV%9Y"rp k.Rc`?G{NK6Ln=v1:V? x^[e7g撡4<9m)~FW(geh4sC}:Ϡ Yu5]~0Lpہ6܁ntmH$c[sIC㓐,$U߹KJA0 ]\,n3/\]dpafM&]Tf!wq=/njRih&PZu)'ڌNNMm]ݫkON(b8%dCr6WNI&d*.`.ƁYE2^M yDNjyk%*M ҩЉxT*q)0+ojdġݔ'}A8Ɔ8l1uQU`zcOO= |e |t^NuԙE,bGufIW'I9ypO} +Mclq`|vDMeY}+k9ags?? endstream endobj 5237 0 obj << /Type /ObjStm /N 100 /First 1015 /Length 2782 /Filter /FlateDecode >> stream xڽK+L6$%@p"hȃ1S>=—w9$b͛c.SqQ եМfD$R ^\!ݢ.PʐL~kUsVj.֔]l٪boѥRM.$YUrJC5+Z\^E}ԫx͕v'[m98dOD=8㍲:iKhTͩDw5DF,iX. ǿzEvy)Uu۸ZgJyU\i++YjF|ŕLVW\ euWS0\1Wç?  寗]wWǫjް>kmߺg嵻̓""a:kOdz7zopOd},S$Dz廭0w$#r\p^ }t7sobon07=X ;ED R'JziyD&"\k b:5OX.Ii2.L8cop/. žLhi2p-o0釉}>u!Kj\#WSY [D$6)?~DkSE XTZv G#*^Yo PsZ#V^YgI}g;di׳,Yuؿ[N]g=p2XVsUKwos]~翜 r-&d(f;㗡N׶=~vRtO^ý|]Ž}ɻ.`O?OqO{Ս*?kh/ӰG3Fg2b/ݽ&b/$e!PXrrPY,Gx=ڕ+kW֮]YRY\\\\\\\\\\\\\\\\\\\\ܨܨܨܨܨܨܨܨܨܨܩܩܩܩܩܩܩܩܩwe BbAXP2 BcʑʑʑʑʑʑʑʤIH&!MB4 i$IH&!MB4 iPY,T* ɠA!B 2(dPȠA!B 2(dPȠA!B 2(dPȠA!B 2(dPȠA!B 2(dPȠA!B 2(dPȠA!B 2(dPȠA!B T2dPɠA%J *T2dPɠA%J *T2dPɠA%J rΜQ2T2dPɠA%J *T2dPɠA%J *T2dPɠA%J *T2dPɠA%J *T2dPɠA%J *T2dPɠA%J *T2dP 5L *T2dPɠA%J *T2dPɠA%3nMmRKvrCңL5oFJ*Z|¥m)O&hafb|ElhViBorKK<~?d endstream endobj 5502 0 obj << /Type /ObjStm /N 100 /First 1014 /Length 2012 /Filter /FlateDecode >> stream xڽM%WhltT_Đ!1}Rt&Q_n9UJgC ,D|sML%|PCM͒w /U_m_UܗOϦN%pJ?a 'rTVO?k)Ae$/cZIʦA4,ٰ ւRSPGTϗ9ϗ%hbz݊lUV:~~>/ӯ!_Ho~>$V׃J,zn n6|߇ǟ%< ~߇oyE(EK ߎZB7RX蓢EH෯bC4) mh5R&(OPl(B,Vy7R#Fj,b !RDd3PsFWr@=!F DKŮKva CŰŚnЬA14kIQ:)f-)ZAЬ`fس"HвJD)*7RFB:)2()v*'eP7@P\<ٞ#:+Yޙ`Eەp睖`dÍP1(78ŀ^ؙ4laLHڰJgFZ? KL5A\lM7<*(>damD<:”*rJTsBp 6!Ls L4H4W C籃gx2 A@iFL([d. i;ld!V8:KDELK"En5: s`,n7|T PwqLsxܠ'Ŕ^9(f.)h jC$ADL°t/eߝ(l0Mp6I3M q6IudRM5O<ZC@PLj1]YRWN"H,_:肢p3)'(n(8?¼8Z M %¯E~ wQQΎrpB08vg(q\uS 3%q5˵ endstream endobj 5503 0 obj << /Type /ObjStm /N 100 /First 1015 /Length 2140 /Filter /FlateDecode >> stream xڽO$1hT* @)m!cl~^Қfj_-=Qe4jIZ4(IK?ojj%I_FKTE'BohhsiDhQD֣;KDSDs%IO1h֟')=Zjr\?$g[}SC- IHbVp'$O4NxI M=mx &i|?-a^ -Fë6ޯԄbT 鳭?O(Fs'0d/՚z-IgqKoՖz߯VfP{'dL(H]&kU]\~%/yOr4XܓK\ zc%Nn uItH ͐7@EUдM Pp1 ƴ%11GnP  S=ѨF޶0h)oa4h֣_ k416c4n01"mZ<,=9n˧t/_n?_n돟~Xʿn珴x_G@rhƴM>w/I?>ej7oozƻHŸV.Y^Ph[HѩG Q.gte ZH!_-A1T1'8e1XSbbNpFv lAb:INA5" MCsTSbst^F(JS"P"9)sl)pl eNTB JLM–c+" },P&ĎoKLCCO(od[q*2XAw ).)ޙ"vk瘐Ҷ2蜐qb/瘐1&dOA1&dJ4YPCWNb6,;ELLVG8U{8-j3KׇӓbYNN+cN>*FGKm#:)$kNa}nڠiSSnIq)W&tP8- {H+(^rE+u"gq*jw`ˋS-?jS/ysͦrwJ.!VzqpLmssUCzY}S(Gr,=h*n V]围4<YVŸ0!nAuLH5#%;UEE&Gqg endstream endobj 5867 0 obj << /Length 2578 /Filter /FlateDecode >> stream x]Ko#7W֜.y v}BԒ% %d?ɲ1|lPd*~ +=͒٧>||fTg$q9SD23{~?Ï???|ҘI1fL¡]rG*全d/mjG펤הyzJ]P&"9 }ns칭Sʼn.5Ge9O?Dϊ4nvI~b8~X;v~Tzx=ˇХi[s"u垊Įj] `@[2hZ8uxBV]=9h+Jԡc%6Ywq9~pP0vF=XM~\,3#) ܶZ#3&>{Lk;ta70ɘ+}DzBzеNhF[ 8uZ+I6NE R#ǯGRo2MqDr2)6bQ9N]1ҨVA2WĸnY-К Tmu-C:m-Sc_ʩL U9U/ɳtEs6Dd*U7j]N3LFugRtl~܁4rdQcE:_˷/4)dh$Q YvYHW٣O}Pgc\)yMðƐǚl=>&!Bu4CJᘒ'a˟\(AʘDC]~NK ]"AWHQD`wzr<&rxiag{EynT>}}Xk)Q0 WL$kBŐb-t\k `Zd e8"D:e6xbFc{`Oo_.{aOzThP^E\җS0><wTrq =S !0@aP ৆S1Ja{xA`%Ƀ1P]JNB#Ièy+6(ŰߨA`N&0SZp_g51LLvÈQfL4#=)cq@d6ېEf~W-TPqymڗ o/~UUf&o+~a7ܠ5>TT1F2m)a_%ÙמJc" p|U|%*e*kȾ]k'~+uڭV&j(V{;v=LƈdSc0Br#Myz@Kޓ'Nq/ˊ10FpXWC+JpƥOУ:Vy`lhm (Qn4T%0ސJ¹IG=ވbT5]<5Q ,fF čF6D3&746\o G<@,-Fjֿ/J:]!ܐx>2!RfmwjIl@'I ڴ[ylvk/潟g]Fcݗk1nqf*]3]Wq'Q_N[cl2Vv T((Agiﺰ1ͮ1M1s :XZgj+fL Nf;Ͳy;MO&Tq szoT Ŭ]e˂ܙxX@vd0)=P'4eEʯMT~,?C\3Ljx)A\+Z> stream xڽK\&" J$`{D±/#!ˀsgNEgaPHvFJ$J:!M|%|hy>IgDB!  ޷_dL$]G[9CTF}Z5Tv:v;oj3 \-\B3Z559m}Z~;FjcFCS} K͇TfRZZR#5\_\ք~-u=[ N5(}(B<~zu}?Ǐ?<||WӟO9}N?:} 5φ[tfl}fqiׯt㷏U!WcWo9=xϽcs.4ᖻD/=#3zיrkO#QHBBr7xC7l$G7u y6Ѕ fy21Jn |h͑[=1 V^1e%ĜVBZ2sњQ w &d`JHa&2m%]rISܶ@صx 8{+%eXF4QML &VV&Mhrlbi@~6ܪ90&.D/w4TEoK]2wK q+oV`e>$Ĭ9qZ&8l9PrU/HvwHVtqߡ^\py좏;L3邩ŸÎ2moPzm_9?x#ˇ!?@<}:M:}ۧ&_DO>sY>_?~8~/KP)bf}įy>q_VX 41/ )lFgBePY\\\\\\\\\\ܨܨܨܨܨܨܨܨܨܨܩܩܩܩܩܩܩܩܩܩ<<<<<<<<<ZJ&*mJa.<ĮD&:7_qo*̊rVFb`w(rEQ6^zck{P`UEW%3IH\sock〲#Dxp̓ct1s%Xfe~DBGyj}!j5j u1eU;0KExi"y8\I|~ͫ40.SG(,2]ͯ wd}ˈ\m|CLe,̢v[8#:[zhBtaY!c7X%Pg{ZQMoq0&볡@Uϡj2Wyv:r`beT'<*zݳ\;d m(uHW]|-8]8٨9!>b wcSfX= R.Qe\{|~<+/@ endstream endobj 5870 0 obj << /Type /ObjStm /N 100 /First 1015 /Length 2015 /Filter /FlateDecode >> stream xڽͪ$7)lT$h xf53n1t^*.ByRuR_DH9 r $ loXK%7j(z)P2^b~7S5Pw!tw~7҇#3hY=2IGHe " rZj b E(H5A@,jvce7=jКz x N>kbzܾK.DG F{`\GMG`01ƨ_`~U5LZ9e*DŒABphJWRKCS5 :sP?Qˡj=,TP[S[krBm~'%7 54N-Вԍc0q{ЊZЂ_Dt'%ާFl%ջJ NinpbbB$whwh'F%{7vԪ1\ԿMkѸϩ1Fcuc4vѸq6c"(}ՠbr{ro>~?׏鏟?>!4o{^n=enF(#VE:(J7ݻp>ܾçpG~-| m@Z#!"HO72FƤJB 6bkeDdLB޺୶( N=L5E-{)i#HJcn3]na[Q pI Z!İ 90d*ҡ;ĔbH o@rH_ jt&9"SBh#/0iT >0 %TG IrlXw)NVcâqP0Nx^n8_|c(1hm@HEEEFΌ^5%gjcJY#f5=C/ 8x+[(( bܺЍɔMRتSAΔLm GEo'+ bȦ_d qL]M'1KgIqd5tPl`5 ,`ۙA+[BT/X^W>ۙ!kP ,)+I14$`C/mVk1#bȚ]0#bȊb*kFbF5E j |E#j-)d'EW(9Zm'(.QrLfY[/PBJCk Ɍg O}dhO& a:sd1jKˉQjc=1!35JHDN\WD;)RAQ@#ZRl=<>6$ӂTnoA?6|)ͤ86'(t`PL).(LLL0)2 L0)2Je?) aSL5_A1`@Tbgd*uP .)\A1Bb(uIarRSZC)?=(uP ).(O%EBTB䊜:(R[52:(RyF$Jhւ5DyxI8QTc1jJM 5FJDh [ߺFY24 ( %ͩPI5: c) v TK$$A9D8` "]NT/Df*Sc+.*?' = K(&ߟ B endstream endobj 5871 0 obj << /Type /ObjStm /N 100 /First 1015 /Length 1826 /Filter /FlateDecode >> stream xڽM +tL."A ,d$@NތX, 9KuQ5 4qW(RJM)Pzצ%zQCѿ5IE -&衏r gq'\1(y s`.$ jUJHz%l@ m̠R#1Ҹ(=ҕƐ$xBjUQ9B&吹*)i ڀɬ7㪅,] 0ܓ>q * ?y0NaxCp o݆'|Jc-(7 6cPm)P{RVD5^[ Q IY Z e<уԨOD)H]Έ)4C,rT^C+cd8IW,@kQ灅j!Uң:BL).LWY0.gkM}:a= ˎ.! [B8K55b!cB ^A#_MQ!u* k}eX#@ G/ kLc k k<' k<' k|D&S/CL) (1?| w>}t{ۧߟn_?Do_n!5>r҈#v#!0G}s}s}_?@:RI ?oP̰~`OWRdP :&E0/r^HQY{Q:D]+z;4HpEѹ9ƳzFBBWL&S71UC *=!L.QbFOS>l` u!lPh.G:%ZQ*F6H(L. =)H}"5 SKw(LEJmLԩ  ե(+Rd/#㨝j>2TGS,MrdAAPgX($`@;JV:#Sk1Pgb}^y؍m 7$+Hl@̘IpDDFjeZy.HUr1@eZqK!ӆli =y*.rhg JD.xb:VLȒteDGͯzِ. ˑDqeD:)2gE|1OQ6d+(5=@+(=⋥ѩ}Ia¥H;j^5v_P@.EQTS쨁j BhC dV6@Fqn>o j bḯZBPqj-0uPb եX;:)L>EY/IaB)64+&)T0iC߿r~uq}H7jN)(v0>@!jP})T8SԴAFqCP O<*(ӖFdC!J=tS7&RbHOӨ oD}{` u!VӦB+Jb+:dVjQmI1ER,ԧHTSlˤ0e]f+ֺ98 +[H .2MVcȨՓ~cA|1p>]ig|A@=Lqy]/c.H\#lE\B<+߃d4 ] }Pվ*Y0FVnKs+w)Ҏ(,S;rܥ;b8>Dp6өOQ7z!TRoYQP}b գXYQP}AFaBu)MFq Յ"T0;vTBI^_8vfߡ5 եXP4S.КP„S8| ե[! endstream endobj 5872 0 obj << /Type /ObjStm /N 100 /First 1015 /Length 1859 /Filter /FlateDecode >> stream xڽK%+7yI!h6+eW(]JR|HWp!@AC47rHF 97,QCeCCcR cJk@~)PaMs K_ T&v9%R ,NLgIς\c` H͜,@'UA \X2VO@~HrvҌ4Iu Osn#,hm BR-QY GLWc-;A͈ LGX Y0 9IB cܾ&![tӐx,XD:Qm6_ ȒFԡ/#dY63az,I˞K5~>s=+ڨz|XmT/?~ ?>"wo Q)."G9wF UO *Hi=Z= HM~?J‡ CYȀPXɀ꺝1ԅ A i4b9$O25u3T`Q !4YZbaYbcp%NzĔa[r`5 e;Pt"dOi-GWYe#Dץ`f(ӡ b/ V.].sv!]Nt]nS.D9D`b]em& ؂/({ # ߡXjVKì7UՒQ-6lEdC!+~\^1 f1(TP,nUPHPɅt0zRrF/+$- 2!%bQ"y1(HN~D]`gKdq@t>nN)8yR4/lSҌwN*ʆWrXǶ>V43",?Eվaqux+ذܫ\0,7:ٟ@NǚBtc5[9Ep~Hp,w(βcz endstream endobj 5968 0 obj << /Length 985 /Filter /FlateDecode >> stream xZKo@WJekդj=T*=8`%)]Ļ+8z3̬i2Nh]F#L(%eD%J{ՍGQS}RA<8=cǖ~/6Qvn)b`˚<|aY&Cg5BDz,]_(=d4pIa.&m zz,;*wUch"+֯eUpٟLvu ~%?m+$d9g.d% EQ.CG,ӻIVʦ^u!Bx{%eS>B~ިyslunE:{Ua;= VY,³YHE2xIfAE&=Rjb.D[ ڕF`-ںKY6CiVh?S+E;(! 1-$Bd'5ы̜K]"ɤ!ۅqbG}q7+U;hTmì 7dWi>bTg01B#B&zp"ph5f^B0S,$'TkV?S ~.4227*C BqfC,i]bɝr՚h&&l&UMsMYS)Za@Qo@tpqNUl_\/0~Ӱ;5:B->yNjХnib-띅* Dؿ>݋9F88XךP qP7_3Im7E6S([6:٨zDD- blqڨLUpo-A}>ʾԖۖ*C-X+'ܴj,X>bbWZNOYX%Uwah~mغ_n3Gb"_AO endstream endobj 5873 0 obj << /Type /ObjStm /N 100 /First 1020 /Length 2462 /Filter /FlateDecode >> stream xڽM+xL.VY$mAIl:("0b p}t ^2/f{K)&H r`m6(!'bԠuBK9JlD8;8#jZ9TlTQ GkF-0a>z`%BtQ"(RQ n g҂jDͦ)HvJAZ̡8) V(sP֐q~m켊QvlV`Ty9j d\у-\`W4 IlAnkrv>Zvlj:_[CeaZrўPNqsm(wsT=F7ӸP+lk˚q[=-6Uaua$0!,F9%tq^u\QCw5ZqIǐ::@'`;SID9v<$Jf S?;$2#T1dN 8lT;8a=\ltfdFvodwl]0fRfc<f6N}0`EIhܦ2KR]`It&@pf$Xλ/No}8}tww?|mB|HN=[?ܝ~R#  k fƽEmx"~ DP:X}dg*_,#L)GU wwT/+RWRԘ-TN:S~JwN`!iܶVRBFiV5d6zy YbAj_FL ` b&Wu0 KkK+]&AغFQHc;)EӘSilJx)<(P&`-Ŋ"*B_Xj26;DqԝBt^ Zl @QVeei/"wr)5bAFBҊڦ䖥XZ!{eKCVHDg+7Ɗ4 vyXTXueݍ+Dib;-0(J}EK+^XjȨq^{~LQ|LB3yw2f3*׵4UhN?_jr󯿾_=>< W\WwmQ"C$N?>~pzsSxy Ȼ54vߟ?p?~_{K-:~W[ﰟO vn6(>PT4mВ+7Wn\rsݕ+wW]rw}S6 W&W&W&W&W&W&W&W&W&W&WfWfWfWfWfWfWfWfWfWfWWWWWWWWWWWή]9rvٕ+gWή]rqŕ+W.\\rqeueueueuew;ݚFV{$almfd8{M뵖²"|PT:FA^^5p _&Y; >STIoXM>Rb-zrN#!8 ,M)ߜ(gk-n[b۝!VFcO7N)ve%V&Ԅ-@iCS}^`H_,&d2XeX$h6y=L`n,{@H!< o[ \S5o[hN/bkW!V~ `BĴ?.Q,RmwUW*6*+ X rXs n퀐mrHr 7)!!8b7ڐ oiP_m\ Y+[? z!'rfV!̵L7; endstream endobj 5970 0 obj << /Type /ObjStm /N 100 /First 990 /Length 1144 /Filter /FlateDecode >> stream xMo7<6._ @ACZ6 /mI>iuX p<3;n- f<-띂lJByWyݜB JTh-+$٬AZlAӬrPB)ՠ:l:V-qEt\Hch0MV,敎<`i@jRkϠ-$FAl.QX59K]#b++!)t'DJk @jCK|.B!!UH>tR!ա5! 2 %N0t4%e :CF?Cf-~xǟ{:p:p:p:pጋס 9 ldx3%JCH{ ~h#AZf^Ʌ~( n`֩3Q# u]Q'ع5&CM)U~";t ' @K@Xgf1 ]c4:ZMw}ۄvn߾<~>~<nt?2:1XM6va-#s`q1"x] m~mt~ߛ(MxvO0a҂x9BTi D!T  6ʒ[<*)vy ԕ(PZ9RX-z֐Rֲx#Y.p@),ӋX4d'Yj R4Ȳ~ły ىZqPdg?'.HY Y %MĞXRd94hN@‘%5Gθ9OD+ \.X|"%eVtP+RfdR)*~ԆEfZ|mI ?B"U4_lvcU0n zڞL n[Ln70m݅M/u:w endstream endobj 5977 0 obj << /Length 113 /Filter /FlateDecode >> stream x332V0PP06S02U01SH1*24 (Bes< ͸=\ %E\N \. ц \.  33qzrrJi` endstream endobj 6001 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ڍTT]6Lt3t % 0P%ݝJJKH7HJ "( R}k:s}u}0ipJ[A- P'8'G &bdԅ۱0WI?00~oՠNe7 xyxDvDr w@ ub1B`[}_,ǯp#9@p[}EK@j ýH"n ;rs{xxp]0Ǭ vV Goj\X][_%> W(4N99 t&8 YZBAN^'5 PP{9 ' W}<qY;jPj 8]\!?9rLsNVPGGgr~߽5' +7gn='XIϽ _ ]`OK[t@O=?g3b qp+, `,6'ߛ^aVP'1o22PO'/?WD L n?JNP_o= aKz/]0_X?z'YJߎ~,9p#ǽtcu55j`+Jp8H;8W'JK1~Κ u]@q/|??wZ4^AyaJH+/!==?5Ly0%l !!`/ /r_/KM''|?$/uY `quvyI9_nN? (@ȯ:Ĉ3 YT!@r=W7G_{ml5 {j=X PKiJ1> v詬YAagҩC=K_YN>47$k^^%jObO HScRqJm޸#7#v*3湸 j^x)z-]ڨTyp]6cX2"{ IFp7}z wV9o7h7rS.k#r#2jSL>2iʤs>Etqwgp{,f lM1W̐L 'e>PQ,Gi :r{ M^@E+l >ЗB1|$LnLe0ݺ_|@RFPUF7bE*L.&TeNLB؅ lt>\tQz=lOFSXCD܇SV[PqOQP;ɿD_ 5i{ŗ[b`mߎS{ L{8~ \Nl2ـ31)UqK$ _BI<^ έJ%#[fV"KIXϺlTP:uˈ~ꔶxMƪY]K֢l4Ic9!Up4zP$; QyKMjug[`&b!k 3oɎ aZ;Ǹ& h'#JOB_x=JCn\G?]_}bO\}2˝wk]96V%U7.T5_J-<Q'T1mH8쾘655o'GWBK㥟ߜD sk;ފKd]B))K7XƖc[|)SxaX6 !GĈLJ_0V́p"^׵V4i.ן*ֽ]W8+]qFԣP,`:}{SdIaSuճc.y)ڈ`R94a.ܥ852.2@|{YGt!j+v}[C<&[J:ހťMu PmEl}Y0ד_1jnIrI^S0wIEW}pT>%<7;2[S}F@1*Y+|c5ގƫ|V #rLB(f%c.>cr[_]n%11Uj' P^@9@I缕i/trXu}O̵&W2@#SjݫY^"eՂX乧34K2V> $V|rӫusHI xeo{lQЁ"EEMSuZ|XDzc'hE$Z@Zhu1R?}>^"tXzhm/KNd[IY3  X%Q7ᗱ"B!a+d~0&x}@R@ Ū/d8ͺsVM9ֹҾgdY™d|V2(/cΏI;8S Az4l&]PE?!VLh:.|\x0=i{vMThGdG5iӇjKXJh1}'eO,܉'6l!S;1o50żtߥ z˸E:Ip6L' cKi,Ucu7tYdu PA(27Q(_WCP.*I.sJuj /QF7veLBN z0|"b=G ܚ36-3ϣ|jBj|*Bu8ܫp ~e$Zx<9eU7@[ڴ=}A"-WhGܬ`Ě8%?ya"TT~H" VritYN*++}y^15i!A lQdI"FQ5Åm4D$p#|1/5m$,Wd ZR^D- ws.=|0G čNq\pAC7+9=5S&26uCjr)&k8 )%Z;!yGG(W9" qoO`;IZ xQoĞ\K>U'mY@PJ_bp4lz'.`<~ogFA"zƉxsoӒ/F+N^#Y7EHV́p|.Z|Ҭ!B}bջD.rTE"ï'7!-"} tk}o0җ> 8LCԪm-Y-'hnz]EA19Ajõ ^[K.Po#/~t/tIZ11f;Hs<>\\K \#oI!GCORk4`ц]K`M.=,L#If"gֽпjCCb+l|i( ag^!ܷ5CF8 lNk9hv+ȶHtXjj/}|mS'aTu[̪Wzz#bZGE:.=RMA<gɿQ5oj2ԭ>6tIV_oLyI{/g*r3th|Y1EN=X͙0,19 )pSgo~sOlWDh>8Qj:␲V,>oɴxϤڶv$&2^$ٸv|pcO$0SR1QmsU *%WXۈn-l\t"Ӕ eބ[=#(BZ469Oy%LjI^Ѕ5iMN<2XEEgZL? a:dX_͞ch㘗-g7/.?]mZ>QDs!Lxl3?RsI IycT䓕 ZE{m"RN{ >ݘ^{Dc[JHQ֫Zk^W#1 mmCվU^V(o[RP^v毿7#II6mН'pzjƑNO ߻<=؀ը5h~%:1{:4?ڱsc&d07D0TM ? N~rz#K"h,dCuޛ m\E3qg/qFaz1H3MIjjV}I;@WM2}S0$8duض* Rr2P/WYtfʗJC 4 o! Q,‘Kb\jU0AB{Ee}M!rG&ʦd O ꫤVoFshPa~цY|9DBד6Z~h ?W .tN?"4$>Ob$bx nF^R&6 \=P,rmu)mӷC0B91J3bc)hj =?zxz%=OfrrcKӼ΀gt8gcv aÁb"(`u?]azw,Mg{of9*_ۯ2Fg(YLn?Y/⌊—$jv u~\6x@[eSjUka웲-a9r^vcEe$M-;rSE`tno 91^n"" g;/Wz6va]48Ւs \ |5Mj鴚%Շ 5yg(/P^c-͂8"f)#ȤFkpμ%oc!@Jjc[,^\e3 /LO.hnnw˾ ӎ>PDfqB]Z6y6_R9޽5{l;'b =Uvk$7 mal6oKbO|䢖_OC]O3#A_Dfz%MH@ iFLY_'&ߔ6<;vdp՝reg}UD3##[>|D!պ@JhS%Ͻ 5)! J ,M \;&k~W;<@xjyǹ/mInO)-@؜n5~}I.ݣ7)5 /m¶gT.'Lm?~v; ,#r\/ ު)6 <tim";WI=#kbk, 2 [1J9m wK$-b18 uݕƵZp`>ŭv{ [)ܕFdߊ"cDqi#D+nCiusIfA0˳Nj}R3OeJ /w N~wWܷмngiE+P]G>u#?QiuuXJ` rg.l0@7 5?>.8uIK٣5aoNl헬xV+1ͨf#xMNRy,G-n%q1}iYXLȴbE+q[9O9qiƴ[ wwv|߃]UhiJCkp#zTw5.b5Dgq-[DXey&|⋼]V\K^ʜ*ZK˽x )`\P0ZIhCiBjnGF ř6j3_d%GD)"QأKmU.@xJW.'M\*idԤhԢޘs0@c-[]jb\#?31Ԙ2/f6/t2 LDx3C w>: p(ƒ8xuǥCQG,|;Z2 VxN*eU rNcfq ѕt>eHlZ#!dk~JqgB9l 7ܧqu\biVm/W0-'њE0JTQ0XzK;l߶p,p>1(1}dGq$" wS70X Jf9(KmUUd5l;MK,0d^qVF9 ʦD"T)Nv`0aeh㫲3~11YWs9Zdf3lֈ{H[TڵNtJ)G M vtY81j+-޵8 -2NEM[chJLҘb{XʺبrpQ};4ŇzS0tDpB$L:ڒyRP?,r^׀9!83CF 0inO][Wsd )0$UVP&S]@>Î3_WaAdil&c:v1B8^([Xߴ/l4N^/Ime8Q( *GLV@EڔD w—WzA ,ͼ3o{R7˲!ͣV5#NX6 ` `\vEQCw}1JqÖcHOyU-Ef %36}&QgU;!Gl:՛lL1D{Z6":ɼ蜏TMhEG>ηZFߛY+^n8^%>FA1e6hR Z{-amέUI_wgW? Y@-h}7)pHK>yV6(H/a:T|V}Dn#wCnēc/-wmAh`u endstream endobj 6005 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 6009 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 6011 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 6013 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 6015 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ڍPupwwww'<4\߫ݫ\MY$&T`gqq QSk@H: W $]@@7L fPpsyyll1ttH=eZlm?tv~~^?  tٿE4- 7qss`edڻ8X3eZT$п1G&i|%R} V Ȳ1}YaFg9HkD94tW{,da$U7`PTFaUs[ItZ~!^ yosX:8|nah_PWړA0reY l(T.Hi3,0L7B⁐}+̀rwEyݹJ Ƽ'qkʫ/6ft9ҝrhk@u3!%,RdJ[ T\ݻF޶y,tʵ[wNG$Bzo,nJK%Lpu=#$c7xCs>kfuɊGA}ݞF4<Ւ oC~T"/EM[ܫx(oxA*P @6;: XꌽehJӶB "M\J mm*_rBF wt] v׫ua5mO%>%|'؉ 6cMu.OY\pQoRa}Hu)#ĉ'YS^9D_# vs'8 }Ÿ.' F8BKR!eƠxGU@d]쩑TPp+克F ҙ8%Jb-BNЌ| rTYD^*++g鳕y'u\RpB'gjM+( w2)#$ $d!x/ӡF*҆wsM|W{<|(kdN0?F"(pP['W|U!Hcrw\у枘qk w]J'_)&Zn[gӈoǎ\?:i{%Re[I6-̍rx9+YNUl9aa~8%gKq:)99㹹aXҽ0}Fs?ȑ%'PǎbPڣ8UY} %;1qʌNႾ%#AꜸ:: 9Ө0+TYTmZJHCNì7(d6erSub+:3̧cVJfSf6\xU#[:#DW> ysJ|c1K\# rKBrYH,^M[n%(N,\y Ɍ_* B|bU^4r;NF^[H&+I8Y+M)u燁t(v XVYm/R<\3 NR#9Tg{Ac `x9~O]1IaLKeL" OT8=n%bE|U>D)VAfO u$qX Bx׮&ˬ!%(iز5vb݇o}q1fUEy@=+d H"v?՝ Ks;3 .Yc5 hQL~ (Tۊa{ckYVw-O~Et ]P3Ž{${^{ s|TANԄ&cq{R &(2gBPg;:*fР. "/3(ҏ{ya )Ra4]g[0I>|RaFh:@@1]XbqDޘ(P@y5݌a:bdSϼA PVӗ-$凉!6)Ӈ L\]#DHAi쵒%41WY3KŒ] MJ%תKP<䎌OYChM+lk/VPL0ѶNu g\ۻu[by9lJܧMV+)Vʮ3dzO7u =u1&ȁ3ԶrgQrdQk.=rPkW(KЖi%mDӄB5IZN:/Ē3j,"u!k.\  )'}m8on.9u&ܦwuXg_6bFΑ6>U;D>J;1YXP<B)ߛ-L5*r{Ȼ8qZcVw/&N0]I~,Yk@0PK♰鷚%6[3=Z@=Oz-(("s04D7jI {$%B_*C0m"w{tav>Ʀ90Vډ\E}Œi;%sbV{>S4QwZ9Z"1gb!gY}hH*q}-#bb6b(p'6޽V&{2MK{lꁡjKTø+HhnW g%cMFۂ ^49oPERBnʽ]'ZgLBo??2b-~ד>)LA`9$`PXEX'D >=]~GB3(~Xs SwJ.G&>'e /\cE!ioNnd,udq]qd_7LXkao m{ H|BP8oA_ӳDltmv[#D^s_?l6Nuf47OJDi  [?C%& FRL*LS%he7>>ߚ$AB# !vizɹ>Ofs zQ6ƒq^iؚc.S7)$ 娾 qY "2jk:3˼vlG7ϙDgR)GUw_͌^Ouj -Ȝ"kuU ѷlqY5H5-,Ђ7фd& sfB0PiƙEGрtܜsN!/or|0M EX1TV M{Gو,-tFI`PjPd;?'킌Oska K[ʂx~䂌VWwMbHвq~Jv>~ay=JXV%]gqs= s?,2V~_Z,>ݣ ۲OﻼDTtLV(xt1)A"^ֆY@J}JW5\Y ^Z`ިF()k2j/uCcQ0Z٨\"ɂGlfZ]"vqgT'yw8%T"o_EuZӼ>ݝ ޖMba*P5->q/q.6 P^|.>zv4#tCj4C'#C.}^̱) wp.s0-R=hY]任hضsqExU|\PDI S+1-'x -` т],ǽqq۩ѧQ}ʏؓAM}ŅR_9޻r)F xDy0}ʝ En3gχnx6`_dކȞ9 ~M9{zLuI$L7:bM_(*9EVa2g*~Pl5cףhvS!ulE Ůg=l)!f, ̌[k+ًJQV7$fԮFX7dsߓ`؁ZHRv4ͫDE6=1~r}Xͮyy+j@%a-9r!Cqp;KGűշXuF~&yE}A:qA26, />* ;Fڪup0&#qOxF>~adթ'  &#(0Cړ@n0E֥v5tm3=dÊ}?mcTGEnlTTN` ,Aݧ?_Y.Ҝ/EHw&staӪŕ/t'\K>8LbFLAu*a:l8F:'yJQ6"h9gkPUpd (7SbިP8AHZ-c /M5hA9vh:PZn {__7uAe%#JQk hZ~s#}$JrT9mI$6h.s`Ъyv0RIyAlPcz :"zm)ؔ谲a! ]'VKQժ5KU0#"C;uKWEnXAnɺ,^}9TY]]Vbڐ:!^={1S3Va ?s8ͫ~F{!%TNXfg-Qfg,fS٬y0kNJ.&} XhC8ZACH'^I(7RWB󵭂a{J걷lUs@}c$0ҐjRtڼHD!7pBrbj)6x-~ٟ^Y-NÈ Z;:oi\W ϣ.>&cTCJ_Kx4e_#F3h`Yh_ `d=c-}l&"f O7Q,N/Ґ7rY"߯,j%ﴯՊ.&2#7 ts-b H^yB#uMG >{J@dbPi,.B*Y\!oTb73II18tㄬ VaK 11k*g+GoIJ.E$hR qmРD,H[?cRflO}C c`&@ ́$(W r='6d!@֎rABiAHhoٮ߳ 1$M*&cĕ,OV/澨TMUfE'3IM1'ũ`(@gCJ_jX݋X{U!;Hx&OsRY S6B0Qm[]=NKNQ&JbXGa`ٳREʉwǾ @| ]c77&#ߍRï:t"<5^fzБا2ud's%JP9bCRf B-"24`!yKiM2 )4`*_:Dh 8ƎnRY0͍eбV$Ƥ.?8:&2PA-X:_TdPѸXu;h_^+H)Wp~ @ <(qy{36d/cws*A]ZN7xLLo/gY"\L1-hJ&ẍ́mv#`TU୐ Oh-{sZ?,/Nӕz-&PЃv rNME9(S[ʗ9Uk,ˢfS1UiQJH2"ca zt%fCH%%kv(En*eHΩ2ݠ\Ҟ`q|I+3ӧ\eY@WrR^AjlWoHo?)4v ѮSbTdd E` oZƀTSouVz>W9QAo],`.{oE $pE1b~@96d kTgz<D]8?&#oh+A2|wLN& ?R63/4 'i-ԞbOLAQ4 ![񼍅.± YŦZD{3=oQ`=YE^f^+ltdr;MsnIT;~Vo`|'{H+#E}QGy j i8p:tD|X%!IpW$%Bcٱ<91,LZ`qq*_q$X?pN;>O]MR\u r7;;f.z_sp-OA)•$G}%J…@0={ ŲE C&)L46;Z^O!dC,xU#+U}?_T*%ɍ: c:qQy"{M j0.W?P Ab\k|薤K5  L .aaO I4Ѱ)[75fY P! %g$5/ 2SgAj俲L0G`{@nzS(nIգ@=첲eav׋PT#p%M;즴W1)'N7hʺ7[4pNފC:)j㜀37%2~#\3u( pͼx m4\KiGH|tj.'#XPLݫDˁVB`qų%dO`Q^:(G8k<>jFnIz~~B o^M4E`H/ sxVƾe:>s}8ykE=.y٧=YC 0P]?[oCXP YꉍVvqثOas6b+3h䭏&a [L -ysH~;*lg{'uB,Qf]]'r|_E18D020{Oo뭖o:Kd[:< oi>~1 T;yA5BY^<}r+w$ ٫i>0:Fc&HYm_Aej ozРӮjr|΂k4)]rGKcD_2>@KccN:.T7<{P0N9I %҉sb~oLIpCMIdZuGXJa Qq,VgwOn}]R gc@7{g 3FդL%i)l͓Ju#? BXv2/d/Ԑ M ekqMh+I ,ӄюF\ crf,DrWJxq[{/ǼG%mlѼ'{Ly 6P7K%\zZ8̖q dK8?++҅-w/V_ex<ȼpbu!xbb#/< B{kvEX| .:tI(3{qİJw_Ow0hc1ľ0ց >pH$'xZI^{u1S1wǜEL|~ە2T*#NMqMyn#PԣWK-{r>5)3<:jt-o|=VE~oksE|ID%!8+B!(*•Hu38oᬑ7T9]Z\B=H_禫Z˓4x'&1MIZBfNUHP";b~]d (LUtK1(2*6P<ٴ{ŴIПmWXd)&23Yګzָ8(yZ'*giC7K&4a~E.>4.޳SfŪ;mT觝DaƵh>ݨ?sp#^Yk*( BL `s~@ ?w;ǐɾ$bݙo]"gy: \qKmU(:mXJJ#@6zo|imn67n )Ud*c+쨻I')/y>ϐEM`1I Whա\,oqOy!>"\Fk9fG,H4l')ZPhN1Ԣ܅mrzeR]3,}9a[>WB'&D21kZ*B4@~O-QdB(JA>ȪT|&~SG]_ٴ@5yqpN@%O9  ɩ1aed!nx)Ⱥl0Ѳlf<7EJhG ˏ֣RAnثu HO>ž\Ih>&F9K`cy3d.r-LWJyH3YkɵQ;EŊR{?4"*zZL!L'fL'Y {}s0(Y]rCڥlԻNS~f,!/쨴J2'Uөd{9Kk'/G ~<϶1bT`wfB*dPjAO{iNU@%VFε/XuJË˴O]@gv{ΪnF&3> 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 6021 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 6023 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 6029 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 6031 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 6035 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 6037 0 obj << /Length1 1630 /Length2 20367 /Length3 0 /Length 21217 /Filter /FlateDecode >> stream xڬctgo&v~m۶m[۶mf6:8ogΜY2s>]kMFB'd`l&`JD 3vsQvwS6p8Z9؋q4Lf&ff @@AECCL^bea nfhgf7 `nekQPԒPJȫ$͜lnƶV&Y+3{3*3?%08Xu341sGE p4srqrX8ٻ큫o0EWg+GW߬jiOnj_KSJoZW#+{?V.F^s l/n.Vlfaljk7t?/9:z_V9= ߜ&s[X03+R&MCnQ33TA:zLa\P߱LG-Fw7;1Kwd,[#Zk!߶[B+q+O3SE+WKߞKfojlkeo@_tV&6o/]Ϡ")NY2T;^jL0o:&vN3'3&1YnFU?<0b&i&nI[5fff&0& gYnP>;"7ţ 4_'y9>6>xKMczNelRӮQ}Ս)*S ŷ!quxlsI?-Ȝ~cϪ:e?wM:WU /duJAɑlDSIuFNL%-h9F21~hU)ݮP|}@Ítc|VtL=xè/b!ߔ+Yxq@vZ0fk6!2Zz=dXްÑ%wZc|Ruz2؂ NZdǴ$*d XS/>G[ZhuOuUt eGgoX1 &CZS1Ju3!r,Km&L5QUg{Zq+==Umvesd4bxd|hk%LI5G%JesEk* B=]ԑ=јYm\HBW%/ĨQ,VX!yJ ~`WI tG׬,.V1B^[4J%FH˃b?dCup;ET毇i/wR ,e dKrcTp92nkB/[J ~4Ȕ\6,U6Ea R2ҍ!6*sy׬)(@(IEXTY!,U^ILur-;Ovק[Ev+ 0 :ol(HkfK\+ B ȓw_WщWAGN 2JK`OJ.:M㓅h! ^<|-,D5⾠e`<4NO-lV];mNw  2bwi0s!v$J\%B?RRV/PRb\4g6U:dMX1_i=K>:| }hHGpC/2 ^40~{s|\ѣvصYI A$ڎr.-Q,| Q$~`;ͣ\' [julLaЎWR/>z;pF;:-ޫ,:ڑ [X 0d5W.wmfY[6/IO֩+N03͞։Snlucf_9|<`9HzL_aaA$z#RhX?_j/h4Va%!M'YcgxmL㸤y|\{b$γ %OѬ{D-"'8P {cڌ&/^7F$'5-s31-%O'$·-jE>i~,ȘxQaNaN\uFq@le帱h m8 w&<p#C+3s~bU(΃2gy::CG)׌u0bJęAq6u%RӣpXZ| 8*Q&#W0'喝r[wMWuJJmw?XW\\ z4Jў=tڱfPF3U JM{ȑ@A*c= Qgf/-l V ! tGK%0iq@epwyqIF1|^vϹaKV vͮb bh h{!`FgҲɓ/x^۠<;!H ~Rj ?v 6Ȳ"4bBBw5ґ?%'21#!QR@%OERF-/A# T7hESkPXxN"[9?o>÷$Q_; P? &(x7}qޗ &GuV:*\&+3Yf݌h)(W+iXWj9F br.vKkLCT-܊Xʐ>3g}\‚ -YP *;W&@xp.@Iq6IzOjz>DzlzH")曡ӟE|=Rq]d{*3(tTuf%ĨTzrN o/iHc>3<[XW@*(}s%pĨT9\y(SliK9w]B*i>b$sI cG=nmO,paL q]_ml~)+ls !wpL`^ %H%.^lyXGX y0 *炽 Dބca Xy?ikOx[>Vz1Y}]Byһ<$i)<^C_HF +T" %^gݒG y~ŗSDX3belt_#FXT,)&1 NdyƟXN0dpH}%k;{ˮa)~VNUrv꿜$?eGZrZ8><* f q"3/!rQ-x0[; |ⲇ)s}E;Ŏo^>,L)@m͢}.׬ IHc25}LDbGRKwA*ɪY[ xE{,}`BbxXJih F75rW2d5GMbl+`T/w,b/3`t`NoRli-YۑfrB+ qRGm*[^NSvT5.#-C4;uBX/~ @Jpk𼽍M!d{nU4Ig¸1?Wxa6c$tG8A)vPXz[O 4. n۹YJ2&~)uǬ#l.UN h|6iM9\PMfزN{邃G2{ww. BMTl}-k{yUP/ȓ^%6X*NscR&bp(_fKlDWU  k<\u2}aY%NKi7^A]0Y2$RHq$􇠥97ՠBz{g{^Dσ1.66 'կΞ~MkugޅaD~tzeRlzY}URLzGGV-t11%9 %\zï%ݲ%!M8D TD_M/U^_EB32}#]eoz":i}u9nbu+'%ayހJRc<.4ګٵ={O+v.|d/q=N?i(uE|Q[G&|`{1!MR*'tϝO^O>~p>{'hy$uSW)"nzsL@Ai! S۱\'$a eA$ `#װ!~ Ĵ5*,n)hQ̉y̓J4m?}:5E _#Bv_v.IMt*\go(Dz>wiڸ(aou~ф6A"hdAP@Qя^ 'zi80uCvf% 'Rz4 U[gj`v-NK /OML#&SYƶ;vWYDHȐ"C}C]HMlc"wA "5l-Ɂ֯G%.LTy{,s+u /x9+띱qg6:DžZ:eELsy۞"T}`>:!ѻ6ʤybцN~*1h O CNmǝV}9(.3FAvQ'wYhs,NP"};CRՏ.wDJ_GYq{: ,F* [adRe3F F8p TYPDGTO s?9(B!Qлߙ넪X\ w2MKnr1>?\XSª빢br=~A-1~q#>J{%#n.I5x9Uq;@pn;,>tR 0gsW^Z:_KDMr9!ފ# rr..mvU1e}lŒJ$Yu+ze}["#:yUҐ*EaNoD0Z( n)F_y3ih⟩2y5 T+*ܱB_ ʋ _- 6ꚗz+㐮Ԕ"yMIN%(9 􇵂x lE~zäLDziZH#;GuV66XRhߚx#C;[6_"zP^QI2OZxMp/f_g'Wه;B|l49= OC[N'L;xZ+qޡӘ4[[Ie}?j?y{HH@г}b+Y Og|O"mΆxr \኷796^y&c3܄C-=WGj)r.]4m=68XP!Y &/ 8-"_t> N_?A`&<01W H&-2W ǃ1泇51l 3 (#Ujq E;&JҺlINo[-Xz;hV4>e|@9ǚb/(lj xfo{$o5 0xH䤲Ih.MK$ax,&si֑cD^lE[MEMD%]o[Ch| 5c]Ցu ̽l7= bFђ7ڍ"8f*:t̎SP-fjm,)l) vcJ? ]Qeɦ:9->ĨVe(ad='#jMН1 \ɹxƩ?I5}V&zZhN9C!n:=x1j^b.;bLnm\]GO-睧]0!苙NUbQ>r4gJM0%ߞ~ґ6D~V"oIVSwQ$גfX ɸ4&k;XYM2,<".ou(CGˤ6|0Jӗp6mS7*^dXqGu4d27`|vt~dN+!Z&OY: l|"LdTEio\¥0|*v u= Ô*6'5_2@h8#z=LiƗLM&v݀MYR[w+MPw {%x Iǫޗ C+#R޸cvJ{r.crQ\{@?rv&޾D~8q4 ϥ[/™2yZQ(}ϲZSͻRB>DF>p|׌P݅61(5+,_)P4jgW#"N.3 2hڧvg7%k>txO\SXz!<֡hW@,MzU`ޠV}+.xͱ!&q2mʮ[0IPSw32jϐУuCArj4M٬ ]ș+H:͉"(nS% c:x+*VFE~=hg\rU F! 4fIWCEyvmICl^vTT Eٛe+T9.~ɮWk#5?q aq ;| _z7K:%Wnv-ﶎtEXSNC7\JlI9>8 4[r4`, jT<`ɏ6q6O2 LU\dOdg|U׺X@6l`ja V~"p8M̈́ۃ2O}ܓRv;&.JƧ]dر3eka 3L+rFTCz"d<`bn_Kt #,pPIC\ B&!9 h$ {Y5΅ӏdJcjDKu8e%s&"A{ۯCG݁V[mns,SLsof]!wu} T1X$jtШ w@+1Ps7 0(eP.>@N*dTwqdA;KB`.Jm h)0:!'|H%"\;_Tb'ظJTH}[^XwrPھbtfHzDI#'$ܟUL5N ,@Oe g+<3N^>5So^io'>CL)Ea'ƒAe|!+/' ob'Cz$D[ŀɝULrE+ɪs~`lhP3z 5M-и\H(Bq0Ѱ^HX$]mbv3׺U<@s)A9,U妧Mg]ï^bۭYl'c*5t[`)*n B*=tڐ~2 >ץQ.ERYЏ-odMύ!6k}fXkE/:WU/&YS5i 06 r|D/\NP0E`W^CfEe%89Rؾ"Li*gvUKƿCHSƷF( rӇOh Lկ.H,*5͋ (Yڀ6ٻ'B~o5Ɗm⏆ f $0ǓwDce?%%5> u.DUK$HAIDW$- FQ[TL.XS%IӈSm s@=Y+op$Vr6^1ktii A@eǚA :'52j {IOmͽA,T۴]Qb} ZU;2Y!:Ig'RdM8U bmG4ޛd7Hh(PS%AtUk %2 XYRNy5lVWǐ Kp7? [rCfd׵Z8^g,'K+#E-`VܔUPY_ &sY^%*D1vۥai੡a/T=; k]Pr i\jRԉuFǏzJ\K  ]? Wjl#V[ ^nhjj4M{eWܚ91bgHj){4S= |)C1`RӁ@̋vI)V\VehDh',H(F$ Wi'/7^4LS"G>!C𫟢ʪmf TvУ[ô>yzvEOy *._>7ًԯ71߲TmDj@OrEjyH(bV&@N|seԺc3UdPo_\,#%S)0 ϰn09ӕ^"{X=k7uױnUֽfa[M==mKhXpc&wvŧej"M0jIVx f[ طf=Yf-[ܥ!&ДXg@39ӕ4y!Xuzڡ!~Y"wljmYz ~.HX<e0JЮ_ Q]яuF(`LvCYoy~'bXݏʰ'3$8fK%exȿwtWsjJf& oJK"k㢦Td1Hv#'Yi]bIY!*dU^M<øH0QfU:܍HD+JRrjNL*ZAv9Q`+{QCiÑ}ܹ/Bgm ɜވا | GS7I}V.;`-97fMZN= La3H XnP r$"E(,丣nAMZ̻ey`n^&gac֓ԛp 4/t1=|$2K.VGIhYm2ƚn5]E* f9Пw-='7B~eCy|;)4 ;uLfUa"hT6w>:pHFiJ^l   El,?q6=5C!%nu }?{Sa+ah[Dl#ke폺_r:% O)d mDw%)k M6֓ k$ܹW?MXCAǪ5Q Iϛ{ǹZ! uiQAYߐ^%}~SzsPc\2wo`s"/çMbVA@LkŢ$hw'mbm ||Ǧt 4s蟝5' fU$!dy^{"12֚UhgKnh᪪6p ӕ gjw<}iT&AKc>;{nЊSY45VselBZmȗq/)CэUSEǡ״jrZjh.,p57α$/[ k8R+,\8=j9,峖4f=ek>W,^ pb&ѕBxAؿX+ _3e/<*o{43bt4`.pT|ijp.uft|Rw\ \3ף6rzN26PD7ɋ#!iRgg\V,(Аu(rǧyRʦuQK0m+|ecIe#49\.ވ18Sf]?f,Λ橧| X}ϓ!bs^ޯvbK6^J"( e!/eosl[aK NX(ULs&[4F!R $T蟐oGֹ s 믞"'ߪԏ9u}9WVS^dՆ}w^lkF"Syo[\ T'$p= íC9Q"|ϯ[UuSƊ0 ڞen_Pq4QWa"B`ZѯFT 7xT `/T?wݑq2RH?%/cd1eM7kkoRQP>E1/С 1pǨh/3D{ hK8-SDQ5#]l"wA{ܤAض=JWk\-eC<`~\0|!8ŋIS$ 0udۥ7gzJû+bpzUDQ p%omZcb2k1?u$`6qE=s%|!6>//ǸqPF0 GoAS+@}N[/C<* H53^įo,܉={;6E @K&ĐFZ]NSHB;,ePk(Ծ{'+ר0>Y*MiicDMrAgqtAvc.ڈAYEXq23󨯸n _W=v~!ee߬ XgMFΊ@K8v۴d_WQŒQ`T0@ ~Y("?dw@V$@<41_lʨQۖ/e.^ "[2"o*M?S M9zt2pUjX ! 6T轥q9 rb!B9+GL]n+?S&m:e?wwb:X)B{`26_b l $l%> 7yƺ+b"5#2PgMlRT[Ύdk's+fZڦn*ӧr) dJ*۔gjgD |Ѱq:_Ee]j:LBA">fvcLk' !Yk3Ec2|tpVwE\~j-7Јײv4[) y0'لB>;)K-GRla0/oI||%&qKt{,=]a`%>J ?͊ *)(WI'@8XyͨU:r8S.dx/[/e 5Q4\KxB`e"l/E$O=+ T#ZEokԔa|u|CgpfԔ^1;.W@S5 ܝpm'e/ܫ0Qfr*(#j*?r W S4i`Py_z m 7W %D* \C7lHn8h,L7.)zuhVߐu9>?+o[^WF_L>hT'2 Z}{ddEMڭ>{%0ov˺͉IK<|8e}tPͱAk tB|܃зFzM{{q|Hu_}aa)S ,n:#%CA,.f\ ?d'%z-U.5򅽥M.d=mq I,ůFf4Z@+:V&)X!C] @ xHyT '_3I%"m0}օC+K:0OTk8Ic@(Ks3GS$lOǸe'2A^@eB–Fwǽ۵)pQ.xS+ĕ-.A0 2 o5 p`~KD ʮÁ+J\Da/ O\zQ"%|'@:טMCJi#Yb󡖦FD:{i/R", i Hk+bRY׵=G^XB^񦉝%h1GB~ !d!D<6w%'_558{N!!L8S;O$>\6ƕ\: MwM:^&svH %MEƉ[A-qGX+Tk_IHW/i㥫, f[Х a[˔)n"daUt5;GbS=Pz 2—ŰՅP*v][9w]bVTvJ`Ga%wq7zO+.@5b6duG]/Yՙ~T{PC`"ʜ|eUtK,*%!Âa~T!,+mfYثQg"[DN5\tN b͌z7vى+zvu3$ٝerx!UWt]<\>ъQfVusOrx/ Jf A ynkARD.NY R34> r$F۶f**喊:pJIG/zei ]j1k[С L*V)\,Zd5%Uz{X aM:7&^ [M* ?e3t!%x/cTu3v'\3:q/v% Ʊo1񉏗̬A<}r\(iu‘ I!c6j^a҄QΔ(%ZnΤi$d~*ܥ0‚J -E,Yno>]"To`qafLǶNKd8ODph3N *4:+HSMt!1PJvLS{ZRk`9_~,pW[zB|*:d.|XONNF8Ey]=6 96vu$yj$|Vt ]+:YKxܓ`F#*?-H鲥L>ϣ $i q6v&|ևo'x?$|ҝ)6 qy&ʂ6Ŝ*l=7іj1x-/ƽ{d 3=w5aRHjF\%,'w!5q#/ zh3^)eR~恀m)]L {!WN )Iߌ!u ^8K[ї7f;!v85BfSx~TAo6I6{/ł6[.ckLY2hh0?RzOrQ4ʋiT{̄=^?2m[0]QQG) ˷hbVD`w }caj1.+I[H|[h--,*?kc}2ӾX\rسY{.\*mϳz6N ZY{#mCnia:gi'[냠axaji:+i0qhz[h#IPh XNWAs(:>xu6qf(jpߐƅ{Gq/HiD/K1SxT g#†4V.7VZ7X*UƢtV5I3ܥ87@h^߆z}upjxVF75b24qdX8]͜WƬt>OZ8N9.Ms\T_ڴ#7UsKi;EzErd֬`5>2z Ez 5Zæ-#Ba2adn 9 ̹ w} PnїϏ3I eV߉]s#Ž? z,k{ltt\aT{Um]}󎞧( ށ\KqY6#\ r!QKMgv 8fx@v NyEL\^gqt^+&xEw (+\i !m>N$%vcziBeEtH P++ZB1CBXv́Y}*#Vi1,!ULI\ˉN8Ua@}8\19kJJpZH*#Q[So{Еpǵw Č'q2=;one 5e'0(;eh A 9!mi̻犖ƃS\?COJQ?r,‰ssB qU\\HSm޲'1D;|=?fdxk1XC0>i|-'ύ@K!IRW-UOy \/ .2+"AOQ; ,6zT /E6Mbᘺm<^)tRŮ?Y6~gq#T imA_yPio,*C8x2V-93qɚ_l62g#}8Qb=Fo/"ZL"dn2ك%X?0L:fg%Äv֕w`kLAb fŜt$۽165~sa9cà}a~/1tڼ/TQ%Eщ}3O}k"6/A(4+J9c;A IVLcGn0_A3d!p#F8o:3n͏{: DgpҒ?wQ^d5X؜@2FcK+.^*[ȻɸdODw$ -Ȉvcp׼kgۈHqvX5FmNJQi|#e XN Y`euYC6^x^\q6%/ Ip,hf67jqKn Bt*! ̛Zt{6 Be#Ɉ]5 ѧl< ^Tڦ __o\:\1cGxT(ͭϨvrj{8eEt."Rl#Fcxwfd >:3v|ws|)@rPH+eq$[h>kdV7C<f[QxV 3$`XF]h7MAZpz+SPړ*$/PtϧL ^ooJՌ"?Y3\9`r <ݓWI1cWཌྷWY /{9jԕ xժy`ȳ 8j z΂މ_SzIEӀEIaAu6Kl+/yhD,SmL]X=YRd Xr=My'#-񺗑^g4|Z+ź-;~;MwأZfX2,(zM(G*}"k1_+۫{L-"#LV;:ǂl~NOynح}vVH01Żm2 iC$q~)G4~ܓm},146?eاa5{e—p+UwbٜOԺŠRq]o^kۇ S] 2vbi{'Qwa44 )>!2`GZRzO*zN}2)iIPw!'iw̷4RSĂG!jWGNxayLcb?NF S8\‘}l8 6t`IV. kk!bg6a { KwūEjQer+y*nHA8K hڊ[[x);g2]}}SxV Z_!h\ jx91oSkeX+b-aPVLtɧBy1iH{!U VbO~cLϸܭ ΨcΓ  x('"ET6"ycIRR7iTy!;_S7TXY% Fk%Gewgb%)+y4[^!=͹ ʚDܭo~R`ڰ*jlwօ>JX~WɶG/(Z> ZF0"BKKj Fݺ/~ȞGaɻ'djt0w/MCQFhO?F5$\F Zl $0`Ħ8Mһ= q*1I0t|dՋ#ZsG.1w J\B7(VW H(DtP7RD2A&SlFXx2B4)^.$ڻ-m'sf ks?*B F%iSE pSU\X/鈙zDف_sSRRZ[fl6K\a_8%…ܷ՜.jK)Z$%(':-_?#tUԸAq0*ؕvrщ8dOY\Y2s: G/>G-}^U75;at3cy[|*X~L|-vwV 2`Fy{vi6-nXA~_1q[9b&kF>qrkkM8izin~zF{W#>za22d}ɥ<[R9iD*_[oHt. #zyml(|cAmAGÿAj`R zåV gJ7Ϲ*-QKv"Sy˿G, \.:#,1 I&m c0?l\3)솋;sK[x6&Êx~9yoϱԉnk;z/K7hbl`ܖWFRƢm542y endstream endobj 6039 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 6041 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 5971 0 obj << /Type /ObjStm /N 100 /First 957 /Length 4643 /Filter /FlateDecode >> stream x\io7_Q XI k,E-,K/r/;~dU[ݲS,"z%齪J:+i(+MוódzqU3:k4PI-+UK:c0sVjhWS)-R[T,Jyn+hf#G-&JcR}5J&CkPl=qD5 Vj{i`0syHI<_TKṔdjĄQ3a@P:ihH$ksJI^*n] Ir1D5SEk3:XlM\ʸ=WCeSS4W)Yk*IIꚫj!C]djהHi8%QD[jP,&^u@qÒlѡj؆ *UIz p2tT҇eԑǿz~ =:M٩t8km:Py෇0Emn-_)^[m.\n}E;{ໆΥ"q[M|ih*ӘDځeG|Z@p@$xz@@m#5e&&Uëu jOG ii -<1K[iPDzYdrCY2d;"0Q%X<2"u`0{׫w2Ѩċ}>RV5kLߟИ"-0*u7bz̪trvi8zEsX4G;\=lPLZ6U8[R%$)IHeCTDt ìc]rj~/9PGFp"Rș!W0ptY"&p CZJgLӌKeVv/MKfW93.D\f}m8 %Mx{eĎUiKb2Z9d&}yߋxigP/mqĂ<8˞_I@[@sgOxĨ~yirzOQ qNr ::мґK )z%&JHG+AOj.>.Zz?R6[BkAhn<6̓9]吔u\L1@_9'ǡݺ^.,~kt7qu>d5y.wkdrJFW$(g[:C :̃>&ᛆP:acQeE;Nᝡ@н:+3lDA]L_{ KiuR&AxS8_ˋ(.z/JaC\^ճWXtd" cHe͂2.Sb[.4mgR2*WR[/gnt༞?RdJn+,uge3DǝdC ɒ{=-gOѡK^r\VS9O`k\͖Ke{N\wt}ka3;W4}MM߿:yOx6?[\, .f)>~ekڢjqOܛ5yU'M{qX/bdތ{]nOD=q_<#X"CTC< R_ű8kF{A `tLg-F>o Uʹ.sq*Ngφ%զt:8kͧyMAWo}3SǙ8 'c*G8!K4`(/gH|?i q1mD_.hP LXq#Ƌ)1^DLJ\ ͘IZ"8qo'jb2oO2k!7DTĬY0k$_NF9 gi#_WNqKtu-η1GdѼU_Z<&f>ѱ̌/LzOWT|)W+pj˱H񼹘j8Tb,59g!zr6[%[ce!~yEA ]k R+țt*YE:/_9r9T#q(/r7T?:y}ovyO<'/8(bdK)N11bʝýWO4!h C؎pOr5vW}t LݱTaŭ  nL84$ON Y˦0Mi\ξnr!ך^OR '/r&| bα\um!VeRtTq@7)k2;1+ NnHT]ĒJ k~ֶ&K |;nj'|_A8'n#c<Maл!i?H1g]ZD؎?vS4j$b8o_s蝴7K#rN2m\N᫧,@F iFybnYg'qg "dy ~gװO;_{xږю*ZIZ]zμMsg={sO/bv2?#-{&CV}Ǟ}%6/\tW;<{.su<gϛv c.T_XfU-sCmf'X]|iU.EvV5m]b>^tuMNz'|ɓ7kz 7jқ2|Xћ+na]G:gySysp7i=M9Ќms.6eiMGd+srR@9lf8Z;Ҽ!MNC{oy.w{?h JͶoa0C2w+r;kpZ@ad?_u5c>8| $]8ټ*9l> ᱈z=>~?=c;\gW]`ِ9l6ҲtJ:!b)MQ"$I1'3iHl%Y,[fŐ>vE.]p_z ST&ϼX;^Ru8iD&\ͱ3ARPWW9$T?n*e]?LC,flw㨜4cfK3(v_Le_&n$l endstream endobj 6043 0 obj << /Type /ObjStm /N 100 /First 978 /Length 2687 /Filter /FlateDecode >> stream xZmo7BߋIQPp'؎_r8pvG͐]/;\iFDRa.!B)@ XJ։BN90aBѻ*!sHڽCJ9M A)zS>.:ڂ1$ %R70@U "G'`I5ћES0*7%*IK aH9ZKU(z78i-%*TX4a@QU(gJhHfeIc &fQ TP%ŐL!GeSϪpUj+LU%,M9Cn$ڢ\#MI)5ْk+FܩX1DbA퍭U΅;eQO+L5%5MA_@'BQM*y4YpR7FSC԰X&Q}Lu (ڬzlnAՐpsf-(u*RL$%SICY=H%kO^Sl"(!fSGLh[EV4IXbF).'?<8_Wado6&/Wm&l~wEWW_xw0oc8։ǭ?ѓI88ǃ_~Y7{_v !|~ ~sW?<:_O1{qe^?).Ǽ`7e1 2P`ˎ2W-}e[%yAϫß^;VALK( kó܏[}ZGG }>xx慗_zyO.MKzPn?h%ϣyףyǗ5B˷;=1>+}\;:囋~߯|Yc>?Lo^_}<Ȓ q" ^`}Omh ~xwzaypW^_}bo9<~%:k2?'oߞ=akړ؃Raowkg{;ӛ `wH?ŽX|qr3}W-AySyFaB]f85uLʵ%]"~=]2|VkDe{ˀ&!hzըvtC 뙱beJwZ /zw#{v-2ϷzF$,AЯ>Pϩd+صOzAj_v}ѳϥ4?C@4eV\ )#-SH8zhd#z5ZW_}=⌨#Y3O[6D@`_e@LP}OU!a#0/&BCYU2(&E[ JPEdP١8*U 22f&pB@e_ƢQ(Y̞yT} -&%vg][>k{H}@r ((dN?J1ɋ"T5$&'h u[{(fɾH,外PժT=wT0&Lu/ c,Ӧ[qn{"9#l8Ⱦ^qB 3YxTdD)- B NJ*y(J{u)FeC<G@%;~j3aGG _ϢB4um9# ~m*>%,e Zńh'"j'PhɎHx~Q0iA^gPDSȎ1OQd-V(Ȗ <kNP0b BWkB>bV*5lFJ¾<<2,6HMvWJ%٧VB/lm16"H#%JvDN#'$ c7Qv.ՁG@maJ^Z+G@+B VZ$tGYWH_sl#hS|yBl\Ve(2F,:#bVPlRœDqB|PNj3'!t 2oF Z}gNM[2_ZǠ$HOf܀] ,u yK,{-{o*4 xSQG~q!vHZ'›4 ~y vT?3x%}O\x1W>C@ $0Dk\M+Ћ1RX=FB OK)+BOT> stream xڅAG +hW=T` \$ {0 8Kϫgrd==ץ^9WMNik596tr 2_?\?SnMC;ɭ6hvEt1q*< MmwDYm eHfPX;svݰɝkaG'3;nkqg4@6F{;|0mr®L0bܡes3Y(&Aؽ {,ɻOE'D=ݶ[20v1{{sm=87&dOڔNfaN&sjb k1y ',ִ'<yT2|0K 2H`4&sY2upj5T;r4ݫ$6'7ff|9%beٖe6}0}46l+u lmH\̛V2ݔz[\}/y%ㆫUKCcv|yyHEkݷ>>rۏ_/7t$ˋxũ  endstream endobj 6062 0 obj << /Type /ObjStm /N 100 /First 1048 /Length 5535 /Filter /FlateDecode >> stream xڅ\K8rϯ탖xY;N'(Ej({~3|$H@sfe"$@PPlaAAI`{pw!?Y|*Aϡ+AA#MVu }֝=(Q|r4ZsL-]A+] /xDWAC^Hj[ǣԊ?.2D4QH6Ф[@'څ@8O*C\I\#,ey‘Y|oRKC),=CəCI! {(' "4RȒK%؅.آ>a!$@(:5K2 *)y["t&=`G!}TB/J#cz%c`4@5éP$0Jњqh14.aP%<0HCA8%?n򗱾嗃U~9Bf"(\0#?֌,=(Oʂ5W~M ~v/UwoG]_'a/˟np,.]+@$w O_9r/'Վz@S/z# =s\bI1tl9a0{I9!%3PUc hǹjȖ)M]H!HBފ -XHЩR:HԹM79$pnMy@;mc3Lgs 2:&t {KDĎ 2[]uI3 $=z#'"4 :dJQ\cibE3՟Z/XIvU# ddZaC}DӴ,ڹV:;:ɛ ݪ'9Fߑg Rx2in"oq)|މ+2O4^=U~ZwRj.Il[[{ UK]K8z#4%َ(Ib{D'{nCGL>)DCUĖsm>"Hd|P}ZUd. }38LUw_ .*7"؆#K\zl>ȸ)As=11U4s"=jK\$)4_Vn,i& Kas,|{<PKͧG䞪X?ҕθh^>,q'`w-]=`@TL9cOf]>Cw0;2o^<w۶9埈+@,62g(g: s9cYal!ݘTocl~ɉK} -16z_AN/c&̜5~RmxCVxJĬ}B7[szZכ{$2L-O&\1jBNy'~wKgnFGW.>p ϶.8VjN=b 6u`mM pTyV1wZlv8FuM͒:z3poU3ԁ &ogw 5ZlٗkH"=uN=B[88ܠjqlk<7^qtiڟ9:R:H wC3LNo=jHi  F@W>/)lOuhcC\Gziof{@w4lGsyV=cJIȼ2i\fEm'o/0zbm}Í=t>w$~GFJ|dI4 (O¿V瑪D7q2 Fj|Щ S}"ވ'qqě7|._9t'm>6Dxt๭$lC`%3rD+,bnP޷G]r[qo5^ -#cqU-yŸP[Y}#O޿ p[@»r) x}t1 (a#Z\p\)ݴ?A&ĩlUi`M)!:}y۵9K xV?g8H#lqA-PY.7=ޫjuXl6_lXy?qBkV°l{a\u5e0K; ztך h5tn'^1E~5.1|˚|hӉV7[j_ayF9\{=NL]mg-'vg #,Snid( $-EwF3mVS9Xm{o{tTJpha󆓉.xE63U4 V} tun[YR^ߧ~{;:P3) / {ujl[,2Rk/_qZMM~ Xmh'{2[IbYJy!1f<Γ%z?P&%*Ag^ P+bUrmڰyC <@*^\-?xu5ˋ7c/Q嶑t|yAQgðRͺ;opx΍Co=lB`|CWI~ 5]ZCݑ?0-˜__R/S|/avOhr*/CDLn-{-=w7bݢXnf.\JAe^4Go t.GS[y>5`vݶ.TܐΥe c½z̋K>g{2yhwِ^t> f^Ddtק*17`+o~ꘘ.&@ oT_յ [F%y)޴ƤⅯ]|qI]wp*ve`%= eS#S~1зw^_$+KΥK":JEe ^%2k\~Hkmuu)RX?:QUt|smꓜ4+ 5¶qIʹcЍޏhLdldO}7 CuiP-5 RҿK1WEl wyn{.afT.J /Hq{  v4a+9Alr:Mc0BY7\O¤nb43 iXp V볤ut p"``gsEQ>4٘6QN[rHq1M?}Uw2V`&bSŁ|{ot'r~o#)?\ͯnΧgM-Myz>{Y4LD `b6(=yRX+~Df/L.PbJAhDR 2,]iNr3(*CBwBei !E$EMQ"Jr `T [ *I E#DWE{D/ߐM4h~a,.r]cŔ.EhY44LXU!gͯ2-6x!Gf3bY8dfD\#`03i>4t)ty#Qt=m0 2G bKpݱx!b bvr4Qt,Fl9Zhh(qd;S: Үͮ>Vy] UHOQ*;M1W`ceb0h>J'TlHѝ(E('f,FѭKL3`p8$̔QRxYm1GOD&n] }v-XvSWt) t6E1foL4LoJ1l\/+qS ĉ" ,2~]i!VM endstream endobj 6163 0 obj << /Type /ObjStm /N 100 /First 1032 /Length 4297 /Filter /FlateDecode >> stream x}\$ S1_q/` r |#IV~3ͯu00%DJUv{vG//~u6G ?1 -X#eG)?(~-~ykDcvŁF?įq-auX77DY[/e?/"^쇏(~Wmӹj*G8ut1uїp_Y+ՏV_ZApWy8o+`j'4^+:akǯy ي_ ZRK`Y1Fczcb>V18V7_*~Ŕ7gvcʱ?9?#ȝr:㴘9 9YЩHbl0IVl8+HGgLEvhŶ15g[| E<mg^0DE:*h&1Z(HX$m@pe;L#L&z_< drHL@g2~RE>6,:lmdhֳ qxϙPC3 Y|K;ǧ) (`|}\yi0d$!Ksm {Ȱ^l|ǫٍwҤ:Æt!ϰ\m ՆI8jxeG6}זuf=`8TH7>K+QKSY bb-w G jx#@==Xf58r̪%MUcWdjfj5WHl틛 7^ $lihT;a؂&[-Kǎ5 @@Q-ہZϥQr}l! W)HpQNw}`.W\{j޲Cٴ88Pɜ}I}iK7ݝȵzzM~lE[{ ddywn&ፏ-RI%8tm;|m_C'?.h-\זlmvF[|n||R 4cY9oiAkOJQMBqiw#!- _{:pG>󷨷sF;HlILW^mY+`GpሃK'0 Qtb|+ߴ9{Z. tBi*Xi+`n~Q%o(RR- %S{%K1aYD}@)KrPp}1MWXQRv"8מSnJvFҦ(yFOɊ(u+t{~kœN1tӾĎ9_.+WAžh4 Gn*1"^%BīP0؉gu^Į(LEi0O ] ] CboM Oo#S3b>-bNbf2GFvf> x?؅1>^3I=[RC=V\MX'm Ǘ6A|һi9X E5P&b2  *1׺3)s]hdڻvaPAsq!U+Z}3+ !{\0|h Fȇ=n(qm6at`.Atb)9 q2ta2H~bʖzEȗLR,CUdg](H !7ARC!s CQ|@D*vND08nàg].<0$IqwN|> ib߇y.kCӮIz w`қ46;5VQ>5[ڰ7q<> >.ҷw|kϿCwvB.K/߆]:q#χ˾NˆVsaU|v ku[kHE򁯝K"KRLjԁNS7_{}P.u"u|WvuҮn"gY|kŴ=+"}{7ѝᦈb`_>"ؾ_Ho"os4wJ吜 MyHE-2dh4bN̵1*jom"E.̈́}fZ/Pd|llzfz]$o(fqC`!C)ɉw盭;oۻH[B-!j'U B2BY]~}D\סAi"cq+Įo|ۻH\WAue|Ȋ6jS$x.ҷw>I'1_,1_BcE;t}I>|ۻH, /M22ЉZN&L?wy݉7P\i7uYD;}_7)"}{鋘w˵7 )'D&vN摣ȺTUJYԹRa֦FrUyv endstream endobj 6264 0 obj << /Type /ObjStm /N 100 /First 1041 /Length 4278 /Filter /FlateDecode >> stream x}[ˎɍ+rƘg9]2K@dytSS! `^2.h9c@#vf1hfцSڏ,q4UdчtG_1A9f1h3[;Xc8f c:L9fgz5SG>u}y6>o#gOCE/:|=u<%ly m/}yX!oHIOAH!O/l_?Owh))o\[s9 ^ne Y=1':0\gxEڵP8сb|Qt`.l0¼sXwiBHIr`dqد)|Vrc;[Ko3+Eڵ=^0OhANٟ /.䔖il)-gb'EZP!P i|%4xNOo^(Xw'ˁ"0_<0c[ne |юP*,`;TXG3I9oXiBsY"(qHQy.Ҳ `;Ĝ"F r];pb/?,?t`:[ShbG@(x"+ {~\HY~_:с~DӅQtY N"FwLJ('Ks z|D':G$x"t/?,?@/}R^:x/z>y.Ź{>YY~^:].K3:f'I@H#9`=ȉ@(Yz"&D E C G Q*7R@e`xNDUF/ICNN$Y y)1c:r"9fȕyk@(Hy+ @n,tVL N28O;<8IG'"IGo;{R"%fLn$JuI9`7rr#FN$UZ{/R^$ÌȨd!g䴴0"W0_<[@{R"es̅s^awrB9tNluH`NW"漎:`Hgy"EscpA99l >",x1-jEJًcЧs ^1IR6;%$cދ) ̹p-Nb|7 xEB^H1`Nקb80B1`NW8Nf@)e/2ӟ/?sǜ\f,N.Aggy7}*{(^bN8(2?pٻ|UY")' sѝ)3 ((-{ ~gdr#Ae6zhދSKKA/YR(QD㘂'ڸ_ދԲܖSKn)%uOSb&S'qvMQ8Z"5 @M9>P`Ndd4<9Y"ETg|T-`NW|l}&S|gkE,^HMӱ9;'y=*\y$S}{ދԲt*\`FF& 9|lv0d!&S7fqQh|T_,.i,L{Ej?)I8yApbj4inh梛7o*9KՒr2cs <,y&^&LRՀ9]s0SDԀ9Y;"Effs>Ē'v`NhދԲ̹Vr`ss^s^^Hu`"01K~ևr'D DuhH+{v"Aى@e0 ʒ\H. }ja{/^%Ŝ9*xKJ6'RK8'-!KQ8ǢEZr̘fs:s:sNދi s&Ǥos%%-bpbEZr̹_zR$I߮ZŹ:?,lEZً#̉@Xr̹0<0. `N' WxSًv 'g[ cu>lu>a.jZq^ڠQU\ŗ"E&0g?4PE @owuw@+{W|W|)TA(*~{/^a`7`s9Yw(tm2WVZً40L^UW߮ﻱ"E(1PL5Ke.,D dQc Y{Q" i98&\@=Ȣ,j+Nie/1Jz8r\8,(dyQމ,;xR-yZ2,5)L;FInN*QZR,/vb;hvO.!INچR>?=kv?L/4Jm-k⼿׉YCD"5o6hz H%ͤWq ōfv 3ˡזzř ?K+2 [2 jW0>OyIO|vy 5 ?yy%ׇ__>N>症~}|G^5@/2U}7%_/sҭzs?}|oŽ4<kvfkbpK?PC߾|{]]xe_;7_>>~*//2=7>/؇oϟQ{_7,VǠ]wߟ*-_JZ endstream endobj 6421 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:20240328120222+01'00') /ModDate (D:20240328120222+01'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 6365 0 obj << /Type /ObjStm /N 56 /First 548 /Length 1626 /Filter /FlateDecode >> stream xڝMo#} D?@`|IN&"Q qAM9e%toUbR nrI)9?dg8BxK9\.}y+ ZĶ壶}KT%·s1w>[dU|i(8_k(T+3Ry8 {Ts.ur4{ГľsTFN젦Vw٩oТVP;W44V#Zꑹ\W{\hߴ(`"t^[[ZT\=RK!?V޻Pj6m\Ei4CQv~.bJkm|u1{W_}w?%Oׂ@ A&(=an w>><ͷ>?n?|RlԲ} <`ȇXx?|8]n-Ó'_0dP[24LLL,7Ӽ;>Yr2r2rEdC~_Dfvj"%HITY8Ḕ|~hO @>R|sSZ)K @.Չywz5"###5i!j8uuu )jԲHMM-!OuQ+Dkkfel80Ҡә|?H:hGuuux%5k;ڝ?uuuzUCWb;ހDZK&O`"㎧B;]kLP^*gߧt_/ag y&MTFRh@3# dpLZ:֪f̠Y#Ffu[kZ 3(2PdZT ~22dadkZ nY d0͕lNA.\,}4s`,L2dqh(-]%H4YJRuѮ04h%2e6V dL`岭j@, Ymz-m:+$ tY6Њv<xVI }4b\+A A>/Y i>,8Њ@,䷏F~dg#EľւbJ\\mWT~ACAC1 Ig#/߯\b0``F.~o-b ``S>/\ _PPdllgEJ  LMMql5~zNu D PgkkZg>3~?}7%Hcܴ.*@@ܴFlb|ppۈ8  &&?sb}-$$C``>kbLLSa.?~ae0@ o @3GkGݟc矊B>?7yohM;e_v}ɟw ] /Length 15343 /Filter /FlateDecode >> stream x%y|l^|or}}}InCRmCB(((c&&GC(QDIZ`\0e ISU2fdu|T{|TVִOue++`*jXʶ*{gjQf=Pb4UYȨ6OdVˢ>D^eDŽ>Lee;,j+(Ӷ&4U>*fQcXh ).'4ulOlPj&em+(,N)iCe0{^g1jo->eP'XBƶh$,J∲& s&)"&jU"'(;,R&ɢώZB[47bB'XZYƢ=E 46ش.['{`,C}b7PE}bg>g 4{bz¡|B[}⑲j-j-dk s ʪ-jϔ*梱O,4U*-jRMMcx,-j }ɲ#>^Y2Ge |eW~B%w,A9T@%TA5@Cڿ2o6@#xC]ۿLo^5X v9ڕ VX `=l 6 `;쀝 v `?p8 8p N8 <\KДʚv_l|.}= 6)rNSx貢C+p >EzX/|.+` xj)7S|u7܆;p}x<h'sx/7B\JS\VOUS pT.W?5@#,fh˩lWcNGoɥk~w_J Vn8Ὧ6<]9/d^[d#Ӳ2%N[˝rO;ǮvR,)2ΝVQxV }%rX+a-v ʶd :N׃~?3#N+`;s(Aj=)m8k`T_zEuJ{F CT#4V N(hE Ͱ\Z~G*X k`#)}c-D, mC;a7lH雾%v;~;]q ;_ .࠳Q?)pNE8 6ߍ3pyCۢ%MjJ' u`{@zR D&0/,U84?>fM0}3|}AR\ju.nnzr k>R-׆6?6̫,oh6LW@7ڷޏ*_ޥcGee<PM^5@#,T9iu5e`)4wۣJ3,òT'VG VX RlH_Va세~pb؝;Y îJxcpSpY[ۿ٫p fb+p @Zk܃#x - 2~p7o_ x 5tny µm/Kzˡ֊TcETzWtNֵ㱨G޺T?@T&ˈ%G/G}zA|I]IԣJ/Uzި.5k7#˗^R%[SuFmҬw7Ч4;SǦ^=k}xWPa`XQP/z9K^4=@*/_;o+!~*8n}.%KUhVwZٖuzi{1)z3R\FF$_TQ=9޻@^NK:7.o -(GbsETv53'{9'b㨢߻5D (2Uϱl}*n@6}*}=j]&(J(KuT+n&iPU"/^ 8Vx A}Kc 4U7{Y SݨtnZ*rѬW: 6 6f[a;`'삽8?{ { ~K?&V"J?': M']MMgA?Ǻ5 7]kpnMR܅{pChVx'qͱ^kxo "^!y@P2@d@C߉m 2@Z `<ЈwJP Ӏ1 VToZ#H@2d> ߁bvulK ]I*#$=7:p8U|ccԓ@ܭ@ܣhΦɨǜK q{@*IT6С?޸: ۩rLT2 rg1` H<>BrX Sڨ—y̯Heܘ_*?݋E̓a d'<#W?Ũ02ϡy;oH1XL񆶧ʿ_b36 eމb><y0σy`9Seߍ )5OygyHK?Qc>.><4l1ϫy̓a*R?<5p.Y42Ogۢ}A6 2O'~} C1U߉n}jRzR/ŐfpAпǫհ,ϷrXk`lU~1uwT n}~+lp6mw. 68։_pg:vu18~ p"U Ti]x_HU?bO\uE#z>m0zw!\OU?>ichVxO<Tgb5[h0Sվ/D=fH3DqCu3MРާTucԣ f4æ:OUݡ sf35 2C0b1U]l0lH3kMG-Wd-> f6f(5֧'c! f>1f47yEJΈqf_z]phC3ǽ8l]'SUfx5s5s4C\Z,~7aa`_,yyT Uf2C{*3ǜ0g93/z9vmHu¯fȜOArJTooE:XQV Q+ Ͱ͖rZj5V/lxlͰŇ~v;ap>ؖwcϻa#pNT+18'Ѓg,pNLKp]pn- 1>?n}11(/֎dMk2ki1;dx.n~L۾/İC뫕-ljT}bhT}X"hT}cEai5IWƊ V*X @6Uj }SeQW`{e?;akXGpNi8g p.e RL =T=r!7~$l81:܀p n >< Ŕ>#x :aZt<s?q#- Tsf_zx ;jG]}Ǘ>UcIs KrXTKq%tbH}K\}D#R׷Է,ռ7FŸ >Ox}R͟l+l"oȼO}2js?;-Xǵ>Ѭf}TTqk}4FGʵ7q*}TJU(n/Ǘ HAcL>'X1B}1.?CwfE VC+R0Ի R͏Xk(E`lwm3V몴HLڵ]Щa2W&Ռ]6 `;Ƀ+-ZW]bWp NT!R=B\˷@,|jQSxTQU*6x|O1oOWUߞRme칝111П\NvIgRm@Ekv2[wi%ݾ:.),igI;KYΒvZ ڴv]6dh'C>+h?j~GlF xh? dh7ȳ]orO}c/dh'C;iگNv3f=m#N8dhwT{i4ꑡ NҴʃv?OwúvnsSNE %)|JS8e)-tMxꓲ2HPP UPjQa5Ԧ/#VhΧ Ͱ X <*;5a;I_'\cGN8 \K` ˩+pn-hǿ#vu}xq chN<ڟ;x/%7 F ڞT[{khO-(oO5Ԁh{ 1iY,4_-ȷgT_)*/ۑU{#Igd>V=t7z({>j@{ʿ{xs h#xGRnԓyzDs#L['-:G=2mϵTV㒮G=2[σT9Q D1_=w++7:'}ɼ'~6z:J@G njZp>}⨲<8PSٷ"Ͱ2X `ECQy 6fBVg֧)6a]!8}_Uܛl**c@Yo<Ix1БT#YqP-FSndKTJUڨF62MmRݿ89v Xƒy;8n|0?2Mm6mOSZ[4mhAۛT_vJUڨF'#&#&112|JuœQ9b*5zd]Fh6ɗILReMNqK;$' 20,W|Pe*\IM:QLaҙaqhs A& 2IILi2: 2IIFLdRFR;`$K&i1Ob2s$&e9/d'㡫~ةs$K&#&IOaҙaR2'ւT'=Tɻ~˻3s+i[<(rLbփ7c[A->LZ j1%n1OGg[NI=|?#np#*ަނ/ſ4h GH8B֍Ԧ-89Z:BǑxܑu#`9o#YG2Mo Py#a;G7BlH#b3ڎo#9LGB]֍cSOf#!?x%'G89֍nd%;$! GH8Bp#$! GH8Bp#$! GH8BpZx#o͓aUF2se"+*jR_kbhfhHeRXa xhrIjkQy9on`J Kz!mvNa}A8(lL [ls'-VCSybXc3Zp_GF<G7g$Z⍟sp.@p&5\A#:U7rj«8܅{pG2!_Z<^kxo {cv:ıxVzcXT H8V8ƿ1N-&1qkc+fcFE/v!mϖ_Lcic&olmj1qctv!*scc1ǎ4vNeGRC\l/csƘ3}qcׁ c~f7 c1ET-G@1` cOcc#1ƈ1F1bcc#1xrJjZ~AџC4"Xݍٺ X `+l6C&5jEj l <7n=~8#pq8'xlؒ~cCZ<\p .\ /gS\clqM0˺;p=5EW><xwScoFQ O9s"Yjt> O #1ȈAF 2bd #)0HA R`p14Ax0wPy0ȃA `<$=hu?(Arcp 0g9Ը@A" Ӆ)5~G?X Re*,ܝ/Al.? f4$ iI3HA f <  _2ȗA rc K$ދEZ"  ReVj|{:% I3Ȓi/Zr i0g9oIj߈zD _465~gk5Kp}jb3˜YVoj2elujRT!,fc@1˜Y2g% /؂HD%,f3KY̮N_)De6ͲiMݔl&:Q:oHt(^:̒fvojWS?l`Zt[f: 2?&v",f4Kiei}1 왴p,fR\*f)5{1-۟}62^I % e,ffoŕP\_,FM>{WD%,f?+b5-ڏ"UfY^jW/RӉeN4٘uj+4˺YP]jzxa/U>}J`픩kk!oXrJ#?UC4B]j Ͱ2Xf11L0dL1KƬd1K0O1 `;E9 `/p!8 G8IM=ܘ%cJiY2N_c3p.4JLS\K=V\p55i]p nCG[T efdɘ%SrzO0GaFa?A9sP?L{mԫZFX 2 K`),N[ `506f[a#s;`'ݰ> p18'R'z|sp*e:Z,3p.ӿkW\K)W \Mlu7܆p7e/==?/*1gWLHLC9s ~-DK{2#P#|J+t5`(&L 6$H)ՆL!2 [#1Ĉ!F 1bCb#:Ԙ2_JC-h1D!Z 4a2%1$)*vō!F 1bC<d>tx0?e~iklK! |XʝXqN#.B:%C2Q CWA/lC(0D! Qe.Hn8Ƕz <jM͕QϴC1\w6U UP 5P Լ7*g(_2ėO'RjU3T  Kalmm+vV*X k`l`fG^m]%5 {`/ݩ!8'cp 5_a87 sp.ES;J. נnQ܅{>'AL^+x 1oob[GAL7r '?VSWP':9ɡNu S\~;ҹxɃNuʼS2y;ׂ;׃#)MNϬtMd~;iѹxɃNwPoQ~qF'7:ɍNw S|;%)NIwJSҝ1-\hGqe񰤳(IN tR@':e)NwʼS mzI~KrJjZzhFX 2 K`),V*X k`-6& [`+lv. {`/p!8 G(pN)8 g,p.% W*\pn- w.܃#x - O)<^+x o-;x#ܘ٥YgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgeyVYgr6ܹ8>i+K_"R K,R K,R K,R K,R K,R K,R K,R K,R K,R K,R K,R KˌZm ʡ* ja,&@3, X `5`3l  `7쁽80p 8 4p2\p 6܁px1@+< x 5=| sԗuȼC2y;d!wȼC2y;d!wȼC2y;d!wȼC2y;d!wȼC2y;d!wȼC2y;d!wȼC2y;d!wȼC2y;d!wȼC2y;d!wȼC2y;d!wȼC2y;d!wȼC2r;!䎅g$( *9R^&5.GbWCdRXaUZXalMVa]^CpQ8SpY8\KpU܄[p]G`Dň.Ft1]bD#@]2y̻d%.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]2y̻d%.wɼK]2y̻d%.wɼK]2y̻d%.wɼK]2y̻d%.wɼK]27{nw˼[2y̻e-nw˼[2y̻e-nw˼[2y̻e-nw˼[2y̻e-nw˼[2y̻e-nw˼[2y̻e-nw˼[2y̻e-nw˼[2y̻e-nw˼[2rwR?8S7ΘxٱA7y̓nt<C x 9 ^x m2w+tEAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAd^yAdnEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^yQEe^"+J2/ɼ$K2/ɼ$K2/ɼ$K2/ɼ$K2/ɼ$K2/ɼ$K2/ɼ$K2/ɼ$K35uv%5o.|U|_%Xˈ#J(1Ĉ#J(1Ĉ#J(1Ĉ#J(1Ĉ#J(1Ĉ#J(1Ĉ#J(1Ĉ#J(1Ĉ#J(1Ĉ#J(1Ĉ#J(1Ĉ#J(1Ĉ#J(1Ĉ#J(1Ĉ#J(1Ĉ#J(Ńb1XʴO6Zo!y z7?o8~y湛n-ycs7/ >/ >/ >/֓\ ZuZ*jbh 4X `9 VX `=l 6 `;쀝 v `?p8 8p N8 <\p . :܀p n ><C x 9 ^x m- "V|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|N9|NeiEc׫?-iO ~Zӂ?-iO ~Zӂ?-iO ~Zӂ?-iO ~Zӂ?-iO ~Zӂ?-iO ~Zӂ?-iO ~Zӂ>V4}Ye?D4 endstream endobj startxref 1447864 %%EOF metafor/build/stage23.rdb0000644000176200001440000323262214601247066014767 0ustar liggesusersq/_B:"31<A@@vY^ R-Yʒed%JdQeK-?l={wMgwof3KϏus[]թގn"/g&?w2\aO k)ۘ]#g8y>_:VxէM=;cmc[E?q^ˀ@ohe&͢A_Q+݇&KΜ>xѿ󾓧eܻg 5LfVȡL&"ن2… ^;v|!f௃fm5rhTFm(ߖ)YvI6D;+iR\5XΞU.^7;hĶ.+̳?\F٫׷(l7sIu /EvQ%HB\K@<`Ŋdɻȳ<'o.> ³ ki_ ^ZjuxpBNൠ d~h+YNV{ B]wGbq=mfF62:1b S7kSӮQ==v+ʹ?WZY% w[]uBN1ic "]Z2] 6ySY-Af]wI0 {A]}]H z~aa:_;.u=;⊳ 'ftQP 0 윓W@<]_w8eҔ5y+2 8ι/j+'q6@(kKV!; sJқQ a=#Iߧar>e6 zkAUTaNO:#oN{sZM|B?£&ok`݄7}K'ēuM{h\"!Lz9JyPN˛}ЋZZ2ˮerq^YD?]mv(Tvem,rK/ p饓@tZifW} @.~`yFoP4w~G:y#& nV%RӖM~GQ{6sT"=mI_ೠU-/sHM[_~W*FjO_M@/| }ߏe9aȨ{T.b 3_+S̲q冩oQG)oē(/}Q {?J[ N(Ӗ`gb6[muY}Z#L  bw8 z QNnTEX3h΂[m`'Us'A?yJRsS*beQAE& Ma&YN =?ŨAU;Į7 xmʴ)!X/P}pkPy2k[,ɻ6b<9 "HqAOG+ev2p/i$@$_b>؊9-hq* O]@Yxҏ6arrt@aәdHМ|њ2zQ\dh8Y]ca L[bk1VT1YaouN^l(Cm`LբK$* k@FC3Q!&[A5ygH^ |n95ёPO?ʔ;t,?hCOdlܜժe߅h:kdkfTov?$ী ~]w@Ku?wē~#L O6 !\/pmG3xҢaDf6.nӎR{X3^_d홮B? H_~ }#OtF}3 Ab? 6b9| γMVϳ5 ]EqmKxcG?x&31G)cg =ڱ`n\-'eט31e?X{wB9cr睩J&Fs##~#, 5hn$x$DeQ4EL!!:oW֯wW'AF[@oIW'vYV[ci>&&FɢlKFĻ <^ȍJ NyH_7ی,~V;⚜4maV Yd^Ohfyo䭲wƤޕz9v^NuIC;0b:ې3_SGI2&rIH \7aGsu+ቸu6Ƭ}CyRW3zC$,.$ #@4"&/re꒛u%Y^ |h55׃6c<7Į&oJ oOuܞ=L0UB^ez6{@H(^DY>5ˬ)< Ǣ6W~u:4׀[IXkē~c *XB^"ѼLB}rNh8+oAo Kj ľ, m <]l@m77jieX)yf<1U ngwj>iz)&~I*y?Կ~?ZjtA87(A?d^HY+y.nY7 W2ŇƜzW2)ԑ3,ԬOj؍LLEJŶXHZHӻr#~o"͡CI%!jc !h ]W\0Kz4#!?*tF,n8ρ &vg;7➜v5!v#kV>;^GAiNІKZވEsexX4Uvr\TD]9%{s70HUh+Uq{-0:LjoIiC ޞ|;'vwJnFb}Pyp'Iα9|DzJ>sML|wke˟QUoP1@Kom=|3+ZÔV`c:'EYDN}$xTqĝ&.}GrY>N ?Ш!,S#UOnwz5mj͇,S,NeCF`]F15{z":IE/ 9[^B >Qm̛ݻf$iZ6]Tg]cCmȋyЃÔw/Y͜W9gۚ_"|KzG t^hfTKfAR)Dcey:4BxOlL'!;mL(>ûG;7bi˜ QgBڂ8' /B˴fe ECg yʾPyۍXP7|;s a~OL"<'k4 oݮ]O|rDtLVMV뷅 o`|yM|IB0jhc "/}gbyJTI;k,2l٬I^)=͖j[7U5>1AP`$ RzC= II9M$v~ӄ1C4\o7Wp{jl53O"Wt\@HEE]rPu'$ x;NF}u, czU *9AI:K9dYPS'٢otsda菼Kr{, 2E]i};Zt֒EѮݻ8M^Խxӄ)fnANw-N-HاM{fw^JUS4Kw(rE NEMjuE) ntWhiVL[m{'-t<|BAI]{NWatlFREDd,U&;ϜK"] ӄI;bx c̺UuiBU.>0aNwEAeVӕ<YΩ+,SWŜzj jV[O"n]M?]0%#5UW.~*wuw78u/~j1j)D.^js񍍡Mh:IKa^>9xy5G:WĹ^P%~}Y.671l /YAgeV(#0Yt~@u ZjmH&.Յq]GPӚt/W W/_`޵,ٝ_% / W%#D@UQ"ddNCѦj qV.wq]PӠ#[O:eΰ'dv;LraУ hMII#{7'e{ñ /ޣx]n˭P#F`ﱍQDoQS}B-ַH46Ub|t%ȵuWuf.J</ӄj3Y<)NTstG8ir0fa#&SC5i9%{uOF[k Ә1^۰|%niɡ ѣevqT.h{5hb5ukyi/횸eTB/LR[z(=eJR]i 9Mw,WlMub5:W4~RIr"kzଡ଼&!Va6N1v!I[8MNnn4aL'|ӄmQ (qN>5H^[ۖ;21cW&W JIfzJcOZW rm1٠4Pٞe̴ͣ+Nř3SɧZ2rJP]`:$] "=im.մS}8o8>S 9N^^Fn5]cW&]dN5IcW/>㺈WzOc&f~2ةl /QFn5=1ǮL:%][ؓV]xEz5N+D׶S~ık /uU]n˭#}ʄj(}ߒǞB;5눿];88nO[Zf2_>nӔv* >N^}/#>F}ݬoKR}BEit>II#mSHhEwtq]SӪO"@l9"VC54M_t ߧb&l}9cam2I~`+zCzwfN;c+Ew{{X%H] ʔ(՘D1Et4@bkNjD(mж2t[NAK]]'IOߎoϨSo-~[:*zAtہ.u:M|6aU[+<+HM߀|m$ rh[2"jv n^Siۥt\[1V#l[_-zṗ~uıs /޹.7VՈ|%VIճ+TbT7aGZv+Է'ȵoWpO&xSÿl|5li D0aӄ):5`?;+J)^YE[>Fj ,.&urPAINqҋ_$#8It9?$#)*rN%: 6&߮z EH,8O@3iƚ41/s~U2rJH`Q`:$7ͨXSfLT[?95%k*Dն^٬f׀iK³ ȭƳ+#г3U#Zd߮N/v%r4&pEܻ#~zї? (kܒ3]N*RV%V)Ǎ&T(ٹM~Nwn xn?U3};pӄmb/mƔ*jvv,#mOLaAȭ$&S#F78K#ɩ)PHN6b6Ui`aBL 46LkPQ?lI##刜liX $[\ia)͒9n~+[΂I El, 趩k޵nMkMD+ۚWzZLO E6-Es^uۜpq#bqLR &*Eذm%1uD#$ 2D 8I+?In p cwf̆R8yp k)O&}C֬QX"fyoo:hHؒFµ^C54sc^ :a;@md0](c\0 SFٰsECT̏WYsY0F -17s ܆UmEM>ej_:աPowuit4QҤStf53&{?[Uyє"zjyЩOտ߁63I9YFo|ুi#>j|Jį҈+ATfKz.EvrUJډ*ՠi6\)-۠氰Xwy"80lҴϳ5cOHWlJVy!6oeál_Awܤ\i_TB zk.]Zʓ5BD7|q"ӣQ ;"c;_~;Qbj4R4 /[GzR{\OL ю}Q_ߪrX1B#ɦJ^ srY;?yB솁cbea|d@>et B@j1{;.EKs'$Ĭ'|*NN,|4^5"=^ Zn鮚Wb$s") !5vRQA%ԍ$QӮ[qv"*ds= 8z\zƫvv-ubx~ٸ^u-;PVKl٧7#r^fsZfdhx?ʅjSSzqaaYa)V)#E,Ahu66\5毴S֤;aۀ[ |9aY5bw8z>o:%Oσ-%y 4c*B> |)V̖6<0uT#z(S̭~ZLFr;o1xqr3C[̡-;W-/BDl xq;%fhkKl{zVYQP a7X9dԌaGx%hB&>76BzWZlo-7(Bmn9>j0aen}0;Gp/轱uՋZ$ǝ{@Ka |1 Z qd3h{']s;.VP$%\& r7߬ʼFE|OfFn&9D;io?gF&gDʝ:bU~Ñ< 7[ӆ^0YD<Y{!jЫkro4ds6an6ʵͼ˗ݲ8!pk#8qYT&~KբkqpE;o륖/m䂜~H| vA1P[1VBG}i?4w>B(Kn'!:>bYT~QMKՏAHBu~usy푅fb?=Vßo՘&2aa!e37#(,pMC!eexFFk\~ZmFF}d$d ;'9>B^ ڶÐ68xԲ5S[-xbfAgc ƅ˔ ݩhߩ͛fV1GgPF(%i_>1c=PH?`tkO!*R+f{m7aP#&7$F&\kc#zhi%(9]!(at=s bjX\$[NDw"f@gb{dt\VMfM8tc&]Ty`OCHBu#?FcFs}ThMM91`{ǩXB"oG[uE!}jU0XON(u"E\"RTZZBx!˂FA uUvtTQ&=ag=fISѽIe!&ςmv'l{}TAf>3E9Fv`^h JdmI8z W 5i#@+AKmYh dCfddmڴ oqꕍgŒny8+aͽo͘}esQBa&2\k NF)5C&nng %-#_WU!/V-`%?Hd1g Z-Ղ73̼)#,D"wAtmzp';Y9Dn`U}`gt@H?>&4meX(Ñ_ʚ^uqȅy < p}Q6T](*&K]@ Aw+j,Ym[t^9^)]1n4$W\ؽHi닼Gw GB |% 7|q_IeZY>~Θe=sNZkW _'  XVXP^bw#z; mQ P2/EhdcqrQN;d|te ]c§>wZ)XedZ(O,^ExyeK.kzex*獊ȷ'T@gښmL(O .dVAx~˩h&Nm /QiY^mʋ&i3-%k/. QS\E,@]Ɋ+ ʹƯYN9hUqL@~6+ͺitE{ZƯlsM`+3 M>/fyԦ+FpA[eec6oJzY VC[X,tsj)bز6U76fwm8yۜ.J#[27[:%^XRkjn}P7 ,TwNubA^U$%ݦN+|j/ ,cU|50)JfNgaKRyͦ 2/UZ+˘6u% tf7[w2f0,H?OUQxz.5Azٜ,žb, .56cUOih},(j$zی12x576'oME" W_D8~7eF7p|Y}kUׄ FKde7&t.]δV>9{|FU#Vi91HqsQC 9;j6ɵf2L<h*`~ڒCuSq4MmZx7 ]`PЧ4`K`ŬCe +ih*P?PB XB W@󴚥f2 rlJa?rcgN:x tjMQ5}VU9en*?Ate|M? ʹse,WJK۷ep 2] |bwv>O!Mۯmڤ-(V9SoY;ξ>7է|91C5Ͻ{ {aF 9 `G&Gc*עJlT2Zef*rSw웩5AB !qf '9ՔJK再R`:EJӁ8U QSm5w5z7Qn{[r<pt11n _B/[3tp 51ZW؇˚r~n~/콪ZxIi;ocn-NJvE}B>:8lz;bw m+mU\) "qY ?Enx)ot,H 7wYe9/l=υ9/v`s^V`{HmМs'09/b lΫ3'{ģAzXIZC߇ mdTov{2~r[Ɉē'#v=Pxd Fz䈝,yF "v:ce9n_ !|<'vz瀟hGvzOTvz/b{;zW4z;zK3< I_Vދmw#*o0]85&LuwxW'h[:Nw?5\"끗sdD/SP.+?Ki~ϗWx&1 Qt N-y?#?FH QRiv$ǀ+" wOw !+MC$v=Q"IC\QyBtTKvIƛ?I.|u *~$:4ۜvic , ~pLd~ocp EH!33.5W~ZlA>yE^ |7n32H7-T>R%Q[-7%~SIJ_-iʾ# 4T wAm{6k?O - 9ӟӎLjղpߝfTh; t{°NTlbt5w(OR#7*q4a{Gn$.&L~F 8M7xuo=i´ob~-L? )![/pMGT2}{eט2lq֥ sJ{Rie-؟4lZ.dBhssk/&mȷGmZ 7ѴlMQ@<7+МHi-K \Q*ٲw|hMlGg,y'-;AbI ^CNP* Zsq{,I֒+a7)}%}QT;`lS qH qŹ -G11/rZL7ԏW<0h>*P"6W5`ׂ9a|?hz!1'm\mo=ٓY-ړϠYVwV&uҗаxhnb x|?<3lԔYtB`aAO."xiš;υdž0~6>acjnv{6 eC2'gXSܩffjK$[e$o$2pD-?Vܚ 5$fb`Eܞ*\28e,dܸDSWv.Q?-h76ܪd}+ˀs?൶ݵhGIR@|x&\D:E-愣7vVM"V!~[\u\L 5?9UfC^v¤GDBguU&HkvC(frP[h߲74a _~ӄqgsQ$HӝrۑO#όYC53#4EkEz[ǫzqƎ^.Xo\ ~uײ~l*bA66O0nD;k5GlNѻLEz'+r)Z$/ c-ebZk)5RVQZQGj+8JkXK!7Sb(ɯګS~Rq)2qJt8Zk)/D^VF*&uƄO;oy7d"bdh[=fjt@lNTZeezt[C*1%cfk M66 ^6Wלc-[FDˎWzy|&(k mDKQa6>_dZN3Fq>[(e6H+7lseas'ÈP(‡A?nfB!I2,.$?3AƁh#B&S)dM֌FB IO*ޡgi4 uscm>qcN/UFpZ]ފ^֐F-٭a1Q^GAۢ= c6=)+Ӧ]vOZUm\;$^oIg^NѤ>׶ ºjޒ:?ye5pxvq<7}PG8_4a{]|g4a & /q0YKZ^w$t\V:d2D Nw<"*}Z\n#Nƴ΄[:fv~kMaVK^L8!GPި{mL FY[!Z6jV}1}!^3$ 9vӄ,]_il7p+~'uO"L`0VTI;L>our8;moo\UQ\/j_r¬=^? 5W9U9v?iBEgkIiTB:"?q0qM\5T3`áεbPHfQ#vޗ|h@V Ľ~]VX"EIRNLGS@͞ L:7׋֔Uuh0Aӄ]@LAś~"r֋;tsHA[Q)ɑ фJKo~Gw':r\`]k\Cj/qԮ* ^Kk>u&/~<+w\@f9?]_ª$]^0dW㚕72o)7DnXs ]r㺈Uc⧷_쉁[E8ͰFLMH p8/$ sp< s'0nPcO@~H'&9Oy_[?+jmGB+:m%*ztX&%]UA_eḅÑc\e2Eq*d7U+l\[ St^%2K޲zEs1U|"c;h`o{ϐB'tѯd tIg}!KNer-h U9ŋ2:d*P2Fڞ ,>V c\Da0׶wyS'Bu>Np[25/\AM% z]m CtT7sZiBEv'$AKi,k5*Nƴ~-{ɬ.!q6(z~ZcJV^vwYcsRӄm67i45pK-e_|[0=/v] Ꚅ*j&792I>.L7GZy! 9X[yzk+H oNNưg(3-<˜&Tfgk~$QK" ^~ӄ)wӄ1^acB\ˇڸ9o'ٯye]yd*ǜq2D^^;T7ALUj7p_Gj;TV`;T]x9C;TC5$GA@/=bS1Jd H1Ƌ{7|l aoSZnUnn>{hTF(Gy $蓱uu!AVe\-#2zy艸zD_i!a^|W?䊭&f | }x$q+=>Y+n'潽4EmZ"z2wrY^ftAձD77ޜcf@gb+E'/$%:7laK:AnB_Eʴ-Ǘ$y9'Ad:Z~1_[27qCI7 5}(patyL;kXŢ57*VVeCm{ 0\@_&#W~EO'}[ ޚ0)!Y/ph@nj<+Q0ldD*ExpP6L8 z8}{&#Iߞ%jH \ z2shΕ\nT&o}K6 vKx+[ӷabI@ (jaڄw;y3&=9?" |L{GfyNB^(2lUuhXxOw!5I ThvL Ov3YH+Z+NxmV.XwQGn{Aߛcxҷ]]ZzIB^ZPKob]j$oepL‰]Iwêw+֛ TLjeͷ녂IbAo49!)@%oûam!#)rfޢXDi.-j$Y\zBY1!v+AE,rVeHAoLG%W5Zl yz[.en io>e[GwX'AOS_1w~ݒC)G8 | SgI @!= |#7~Ccm`8yۜ`>awdo_HC]C5lQBT?ho#qx6cbx kbk箆샠\ |#5>A<@ 9-ef5 3ɏ]\IߙlNx lu!N0aG~D@5 {ޗ=Kl&|n SvK ~xҷ|Tݟ "~jaτ{@I޶Þ GAo~xҷvCr}|EUG5gs5p`|&L8z(}s&Iߜ„&k Hr՛lX.vA3l۲UA2N)l۹mz-ߕ]Yf$S+EQ*qp9arIQN`+@_k+ZSY`̘z9odGfye?kId< ^W-5=ͽ5H@<[XޖJYmy gG` ēMUtFo&^2\îhGphu4> c&vȦmo˜Mðz{a&bط2XN^p$:5,N;^۶p |,Q>6vZB^$jWQ\uҢ&m`ӷfb?$ 8,x,3Au&L~JxVR{ q.&D6bbY@< dC0ݔoianz_8Ě2ʆkUi{DE30wq">D@X}ZRWDv ׀^#m˛duR y}\tU#!ȅxۢH"vAeYEWE.n u֦ ǁ'@P $vwO>[SK(NB%sT.LbNHG1gy؊Y-`t1KKľ, Ce{tuH2K!3ɳxɆ$K*d&ooSȬL !2"jLȜtrm23PӍ!s㼙1}Q3 rPΈQD$)#*IGh#<=پS=Yfb5ē~<-Oލvq-?ywYO_~Oi?-#Q@>9|t 7N* CHTg@?bb+&!9~/u^/UԶ1۔Xqj!$_Ŷp䆷$KaxKK[2*#/όIm ilV#m[|%x`,[u)~zJ=ӫ iIKcAWF2A\Ijk@F:&b!O_ ձ&?m50}dTyNT~'[LTrCC#];FЖ-CvouAVݻu0;orhKn(S3S>BmDw5Ob8j~1uIU g>?myr+|F^eп܆5_Sןm*!ϷZjK ۠6efg;37)&ԙmٺsphhhCFF"icRN&Ae,r@#^C5ĉ&c_w W} g$Ǟ ޤIMMgEѷvtqan.C)UwGlh5™r#:)p'(;یfr6t Hː'; uBr~5F>QQ#+ЀVcIVui'yDz3}e`eSkdUk+aOi󛿫¦3לa5謹󽩴߸aq[ۯ9fZ| 5T;TnfMoE|o}? `:ֆ,9Nyp@+:f{>g;_[i`y;*L_78Qr*ᑡ#/s<Ξ'?"v[;oHCV7'm1 y=F^bnS9tO^M-On}8tL-6$a1o.0e80QhS*8nme'| SV>͊7aYkbi͙/c;7 *.IgA?|D4ۀF0 ,ΩTrȮm[Q&cV{ecRuXNSvG*u*ZSMaġ*o|KhŪނ# FZr7$'o[ iCH|'hu]ۇ$?|H)Gh=yH,Ӡ?L3C[$?-u25ZH>s'C@{~t B> {>̞QT;z C8ԣ:TFw G`W|jxb֊6; *!.,2JP-­n-4ېLBx @zW;Λmk7AUȥ nL(nJ(nmzQ"˵5ib=;mvAJLbaX-XWl#ׂ~m]Dh ۶q0'L'K'@K m|S?7(+on9y@zЙzm-ӞWOM)Ӊ\(7XI4X]MǜU 'O'AO*3#3A,ff0hbGH9ρ9eu|1 J2h8w o'4+z'fYSC+ZSm:x7-UEP*+"4oN䒸P61fIN0c hͱ3%Cw176֗tsԭXNV`D٘jys47XF?TBUQO$gr̀jZ d&X#!|~2B.@ OogV:L|afj3f]YM]svзђđe%ҞoX|K n[8f~!9X*9/j!U'&_u ݎ(@?/v04[)+j/ VvObe$'<Z.|m6ޑȲ\ m6jqV?h}d$[ޕ^ND7C •WA/oըrT].Y'T99OC\ϑ~ oufF \3CP?z~2>ug8! E'/6A~}TcZN^FAEV)G.ˇ!?!Їb}?o}s&? Y>fx(a;?>ۣMX2{?TĢgg~ T7A?jd!T*i1(ųϱ"dҚ>qm)M)_Qka*&*x&i38raۖg<˰'N1s5ӣn_@oq1#`OΎ!ۤ6',M 5 RkX9YAX#QTm P\+(!B:MoZ kuV5ݞ3Uݯ&T6Ƶ<&eg {^+Z˷㛑 4h+4OOQѼkJi\ewP c33 ڄe4S"( alkDa &9a|*r…0~UCrM#?Up[7٠fF?a[ݔtltxhhaFGl\ow[0\2rzo(u]X1y֠>nU{mV\ͤ#ˎsW}̗h_.7 ..=k^جѷdf0o<.ۜm,/\`;38z,+X9^G>Ry9FxJ_l"y*+w0W2ͤW[{[͕l9$$HHETQە8Ih mgŐH]l+bX/~bF"fBo~ hjн,0e5]WEu1 DЁ|[Z\d~'1"\ Zj<(SwdȗAY+uH.{Bw}Elk9B xhڼ\Q Cg4aGŲS6 .h kmkjBG?vPt/@GQvx ,.(:l-Ziޒw WUG<1kEq=ENsNB^vYD͛>.˘Z  LA,MFhSPNضܙHV@~K E&棷ɴy0DKX+<)m ka>%G} z[˜(]͝4z[+I ^+j{:tz `ptQo@IѯOGoah7xo} `=~}{zmk0nd@wވ:p9lp%h@ y:cUt0;癀3qY==_&==oxl5 )D4f7&s6yhS`rɓK8ZN.3y4dw(lc!hn p=f>t2feMx^N%nZY>1e[0OFis\ѕ`t1֍ԦHUڲ%Ķ8[h-7oE\A뿽5Qo%=4?;ڀFHxt Įƅb_m Wq{P;EbWwv(Zȑ$I֒٫`7)}%}QTZxiհqHqŹ-G=^ b\Ǽibk ڌk"u=q}0[՚phK zh%ʍ &MӉ$-{AKi*ըM > Q,s!lǀ~,9|Bu8zBI,2M6t,VAWӱ(QT ג't)3I,bڞ'56!I^|w Q#,DBNbNˌ $FrXkS*[k1mie6/&iۚ2ʬ3\}@/yCʻ1+h.e6'~=D9&֋ŨZ\#GPqsNRex opW!<~NriП*?YQY4`Vu gd| #xloǾ#\X/-UZL2wGfy/G;uV"3lx:B5Ͼjb}Mw9i)TPvu7kpJBe9Nw咏+]pӄIǕz cO˵ Or-QR2~{Сz X"4a]d}g "YC9 ˠzU~,3$S/Is; b1'Fjgt7&/Mة7HtTƧo~-? ;W[St~x]B_c&T/h$ɵ9M:i˜ZeCuӝr;ZNCB!6NwnSi4Nƴb9<׋eu#9$NIN*a mpmOb% Ɇ&8}Z~L(*A:̐Įxw x7[aַ&kb 'n¬oMoY^fcL|zS&m`؄s\;x3hH? o ;mO&f9Qq+ %\ա承jWYg}xb 5xG jF8Rk)\{!$a#0ްqi\qh^cxbO2hڃVqrJ/O5,%Ev?yte5{fg&Bm uβ$ԀAZ:nt:etS@]T@< l\tvh%]s3*Ĭev\6AFgNrV;I,#Ii)[L{WWoؘcdZBr gR)Mo }ڦ΢=-bu`8ae~f)kC:N; ̲!!/ CҐ8#_-)_ko2u K]@O:&b!7XٟFoپmD?@e`3写_tRnx$\y!]5Iw;WpS*2 QތaO td΁_VGI[AO>Jd>hxArv4t.{) 1Gn C( )ЧEG-6Lj 5vn|>p\ ; =߆n?<:^yl)ӠN[!vO_ ձ2*KٺS g)֠e-;:Nnfh9%bB_HW!v> 9xckjz+Wfqob~ȟq]Q=9T~diFٲQґ66]C*8FPPB \s^.LX9r&! 5_|_C*ׂ~mljJ% b!Xy]]>[;8vPGv~$3/$X4k-ۆwmHԯ _%ݳ{b7QT;pBЦڊG}x$ve\qDjJ,nJ/*>k nAa !*c-#~}A^ Z&!wPd ̂Vyn 8z mK`?Z `I}AߝYtb+#.oɣ~Xݵ$`H/DR7>*괗0j7H%8 |5WlXC51Do W3Iw 0 :͋5srGxhK B@z9{γ,S\lc)aЁڐΎ;}zo{.Ojr7ky2JXum~9仡DX,ڞ;W$&A# w-T=W/EJ+hEkJ֟fK"6趩Ӽ@rBv.uL˷̛oZOhҡ#KR/~z I8$ᰌ|wB&k@_>~=6Db}Mdyk-vpH,t̛Ym=*G= YWPjSWAQүܐ7G!  Ĕn%ϏaCp%hS31w}TIqU2xǗ%R Z]YH6:+^D(5YKxRǢ[QQ$NٰH)WhI"r攥tY-o̍vF_ S75bܘX;pm؝Tڠ"}SYK(}|puGB&%>p 5># XVXPG;d̑XMo·[K_ǐ冺i?$תtK1SY,622uxrc x 9J_clRRƬ {}H#(V+a&c*w@WvǏ,gN@ͭVpقs ,"Wr+R/{o,#]v63[FUS˚?=51;4FW.v>Q\VG_e/Mɹ`RC<ber/-U1\ESꁻP ]BW t*BVz-h%tC%A9&ai Wbx)fY6t[;S0xXoN =I/Qe]=P(Q*tMz6Ba*6m;#eqYĬ~fU2"7o`2G^΋ܖ\jhix3nN2*ìբڅ,+1j;sNЄ˩y'7eFy&q_ZW^ǻ椖D~Z3g ߮/sgQ4g\p˕g}[ g۠k |bwv>ohqR"L_Yh^}˞ڦMڂr*aE<>]W\,g_vTtgטFrAmpq_f.m1 `jEc(f9eNv3P  et4ON NMU *B8-ߠO#wľKxqYQ|?88*! 88FNjO t3nr_);_#zc1*g0:W; 8z0~+IheH@2(8aEv')n %b -ӟ4,iδU- vinZz@!͉YϦߴ/ 'i]MOvHQ5%M2Ub68p-x˲5匑EN-pPcԘD@/_n"v;Po_BA? |=+S|;yߙH4غB )YTuUFmN!v=w:;IYM̺h@ G+ wo_-}1~'BxєTh'B|w"^:bxv>Į /SO)9"b7 < tl>P[Fi-6O P:!5^2U6+!kgof־Jwr$tZBgr/c jA8>A^ML,/[Ԯuomet܋B^ɍ]\䞖w G⊳oOZXzXK05NVůABd^,@?/׸IAK-G:a6ΆH&آj|j ٪iP!?mkhjI txXL}NY+k}{/l.p|:1e\b8>Z)F'ayc7kI'/bֺ RB=Q,i[O K6`@=k;,O˗NdgPՋf.&Þu_ikdžx*H.s:_]$m>+tl;Xʧ%TR+@BֻcO0>=|h^ |/h)u黮[rkuC3?5GѸ`ieWziho/w*~,75]3ah5'!HL) G$_|O@#Ze2ᯀD$ׁ-5DOB@s?'qC?Tf=O^І#@S]fn5Tg]-l[#ʕ,AWI$#aM]zclv>]XxUTtqFtqiӑt,Hn{ e6sьhO2:_>><ϧchy%EY%a. 6TȮ/@E+j\ߓdGԸ"{v gQfTnf@Tk3ڬLxJM$'5ḣ}nA24_|3"v?GqW_ ʴrʹt#]$t@My7=&oZ)fsVJ1? $O?S~Yͧ9eYur h6ѕy௃ʹ!6]s:27"/fIĿ(U_:<<~x.o TBoyu IoQK@o,dxä6璌~k .#`"I IDG,Z`CYte=jGC #=Vbq޿ј1m3φ^|%cVrܠߊ]~<%u[:GGd=g/n ge)#8ix6rϧLH=Z,6vLp,:?J"9RúIHۍ=Z䎕w GM,+N=+V"89L#?N'B!"zľꓖ=P-/eOIޮ̞F7!|#Ahxh l.B\> 8z\˯a|t'Gģѫe8m%]s7NOZEz 6N&ݞ1E6ܺ+i];s*x;k xA"ox5k|yP 1/.e6<[zͲve4μc˞w{^uau7+"E! y/)i&b!g_&>3 G>s+2}B2 ڲ}xhNN߈{ɠ&TÞatg#画-,enqLDՙjrڃk<`ϟ˒O<6'y(zq1ȍa+ Ax/hT ᦣVզ}*Te?c@Lc@tg!. ƞxx{b7|!VǪXvlصSSr\lexhv>4<4442c[N}=@KNؽ R"Y-6TNŚ0ˎUjw{>d֧i$xf)ˢ <<)q7&E2D e\^J[ɛF95c q/O!vڠ} w.hW~:Ks^@d{۷<8-sЖ @C5W!v> bE(*eæ9(0ױ(b% I]W+ "0~ȭn-p mH;BelCvpDL8'ghwtT 1o5䮔aεu]y  jb{`>q<MlGmbrgI%&(#ub/^ୠoM&Лb[TN a3vR$Ad:< h:# Ixe:QoyΣYkx |/)067woXbP&pATRH~gǁrWk C? MoDKBjZLjP!~8*aE nm. ®XqBoOj9x7(ufPEkJMfk5w*E"fti$Tƒ.ɉj{4ádJTmcol/[61hMo*QOn"?PQO$groմd& [o[3p?"Fà. _Y 2fV1ʏ  ohj?L] UA=:{#-66[ j%c{ K\%r@@KMTpB'bauļ3m3]s֬nO~bU$6e:r}9ָBJdB [c?V)ZnF\,3ّ6嶱+]Ȳ–9}+\Q#8ƺ1rbcd}-CXq6{cʻڏE%363˽L~5 bh_AMD!@n]eKtAOB8>}Ibeї>g:,,uYMfFa?DD3>σkѡ腹 T}ms +Hnxsn žƜmu[tp<3RtTe$+/=jSƌW?<#L;ycnt8z-!Vs4 \&NwF"Љ}F |SD蒩^kN3g-;h(Lo2겦\Kc-U?3sO&fch]mؔ6X˃ }}j;VU75F.[I2C.eu;kGwK3 Zje ѡrޢz].'ɼ¿+6Yf}'Oy(ֿjju}Y[GP],e̦'͢╋NPtg}c[!ͽ<%GCl<$x$\"Z5uAˁA*qhA=r*p 5뤫\8Qަ.وzPƚ^Q5kq*D7=RMAx vN"4?鈪Yu^ TX8횖j2|JBTVTMpY ,de]8阖rF@h={MUŠy|KfhqeG>Mwyim/dqA5{/l(.r(xzosLp!Ă[&|50J3czcAEK/~_Umo^غ$H<"35$)Ƃu{/^G7[uUвt3dQՊ(mUuHGOEY lZ'ogŐH]l/V k:xT#Iyb:!EFF`)^ Zj'616x:s;37H.e1ctNbO3wbDuH/] < dlwh`Nnm1Cݞڰ',A7V14HP݄BV~`A#pbؕ} 0 zorP9w]OkWZK[/(i=*[8-qy`Zz Cv>ֆ~Tk@}bk-ZT_ ^ x{'Y ;x tf&IO ϽN `Bղw Чޅ ;Н-dB O7F/b 1J5*מڔ^~U6G\#<UGw\$1cMElwHQ`;׍Ё)ǵ1+9Se=0k#C."ܕ^LK8*.G ਈN`[ 0 .:T5::&ľK@wS<} eؿ%e-coTTE Q|/&}PQ~@@F}R:?N>$OI'~Ii /R: ˠ[#Rs$WW*RJuw@'|]ߍLa{h@ x2ܜ=LpO;H ?HiiEABU^B蜴>K$s ^藏<|fW׏Uv˼S$ NwF- ԲY*KwȤ" f*]r$M$)F`7r<+w?BrS),kHn*jfϚ.bS #Q#?ZO2S&\ݔ%w@; Įvӏ}U@<  &9qWF $Q/0MC?#̂ζ%bX:jZ.^ wRH={d/(#x G ]r#G $1UM]u5$˵EԠHOӘZ%Oq۸ Am" aS iSB^s|jD\lBxE sIM-4LЩȁ2" jUB Ҧz "HPgi Eb,.$x<>#DqP&,oU-<:r v $ ebnVT9TP&WPAR߬ôfdi(yt%`@`I?Xȡ&,x%D>ǃq]GmgЪ[ 9ṤtTM21BOerE *e`iS rm,3P4QJGj1X m    $DD:Qn̜dw0ڐ PsVJ8!S뀏~TYCy$$rgz65?nwht<#!|Tǀsb`0YtsڑIZfgkcRr ][myԨ~J3o$w]𛠿%O~w7[*ƯcCuZ Ȯc`&Y;ț%b -ek" jԛz@*&5fDir)Zb5)bߤьmRf# zԒ&jMVhSz=}-'e27RSp&M9ZM"F[ -ׁyIFJX KZCRa IZC息-;4 @c(7~2ɷ ݉ġ ؾ ,AkO:G${b. 'ng $DA^8Z0XMH_-r3()NDݽAKo*bxv>Į(!7.[6_0|] ⾨xx]~C ;ܢ=LEvxމ[fp|~FPWpwc6 PQm.h3UI'j!D/41_%{)bxRĮ4RIKmZ/z;Q$F/0x$`<͒Th-y;% M,'*dk+Ĭ̋xU^/[hz1\e }BYO)6zzL t(G@?[Ǔ"T,'#NU/j]#2ﭢ8lZfL7-3z|G5FgԶf~auIs*\-W܍kQMmKB{0~(4^HUI^FQJ#jCl{A/] n&Vo}jk}_Ծ乵~ɣ*bkycGT׽_a = KOs1Pp'AV|bw 3Tm%5Ɍ3=0KMI?:q(6qеhgrJ++kq(JY8Lk&8T\[Rg7+Emп ]Q W*.w :TO9oOk:5\-;c_?PIX֪Ʒ'W?+ofm섦$-JVvi jޯvܡG~ WӋ9[Q<&^u-H׋Lpo˂7uQA?wᅘ78MbWzdJN`] &gz$% ^iBEY-*縔vn8%5b뀃&;ж]fY,j|%;q< icfy74PN^r!y4%w[2+ Ո>$W#WԐ\R А9)kB+(h}šv=6 N{㺈Tc -Av!?OƘpKO O*C "IuIh&j q]O1M,R6g,[sLǥjʪA;tf8ewFrq]\KnDbs< );491|X4aLeߟRbY~uײ?]6ebş[b?%rGt_o1;YpP[-E9$~+t\yXuǐL2WiBEZ210SJ 7CB?ӄ?ONCZC9B =SDZvjpy%q齜&lCou194m]m >,JB`5boU#W(XRoMfBiLԚc-2ƬGӜ^:}JSܔ\T"YU5BE4̬j$㺈Tc f%Uk!K=R~Zu|K#hEPS'ymwv#|ӎxtmNsz]*E9$ nQN*Au}]N&0Xc(D]>UNI?  S]~ӄ1}Ov_SkPqBmݵms}ވ&LNF8Kb" l 2+jPՓ+TJb<њ rmUdVb-$yӜ&LaHYӄ1tSO)B=mcR:,,e4"/aһ~'&LCSN/ԖߜƧ3]4Ii|/r094L|e9M(Wf8MB;zeNlg)O_7;v!$&a&mP݄ބ~{˴N^/fI-(Т#qvޟ|[$v[@>s$Agw+rw*PiSnh6ӱgAm#ߏ=;uK1x+:q켃ӄ"oXy,9ݙŠ"ӝW_8M܈P]W4aw#!9"&To|= h]lo4o79%w Fcہ\{qDCsOYQ5A'm1}S b}Y7xi{2fWMSI((RYDl[V+H'O~*l0_ :l@ͫ_M"fȀU[k  ПPqvVVhI|K)}{(A kl@܆Ps4o)XUꃍPnd~ >}!6{;DϙjI؅Nw˴y9 rʄPt?7q05>&N*KАRCJG)Ü&[6 pXpT5j'bݵJlxӝŷ6εht F=ѳ_Fp0 >|ӝRAX[G!^Hgux=cUvr $|:I4KZ Þ`Im<  闁tg0լ[9)1x攊mMنS;a/fSZqɡ̨^,fZ)XͤwPpTfЊ>}ןFe`viM Y,/\T:ou(IItȞD?Ɯk%c1/f,52k%ʨC~WqiBEVubt=M6( cG o2C&K=KStȳVI| ԑUtd.o"ӄf$.o9cWӄtb>s0ֻ#G$/?i´\5TwaaL6 dm3(g( 3*vn^}΂IlGmS&}/h\ T oK5]Fz'xsTlCu'dA*)G8M(8gȖ<<z$DGH9)z##d$C=)#*o}nx?cɣlqɑ1B ~e ZAį;C l~ _n~ m^p~DrH?<)Մ>a*6.N (6qšixb+U^o}".<7x+rFIO$FI*Oz&s՜kH֓^̗vnvkySkΑ@O/'8R5:քfjW.ѪeߢvYK)/k\I-tJHT ߩ$/R\#~G[RZ[Z3\ߚ Tu&?d?Ҵ̭̥P_}:Ʉpָvfktk̒q9M]Y-Y={㪅ߵy/*~&<7'%?"Eo-rEv:ʚ w߭:c׉3)i;ke38)F7"j}kWX+c)tJ O,h˜S9Z$ M[5+ 4a).tZΪڈ*ӱ^=7Q AНsT:1)ݹMЄDҹ]|Z"=bT5RѨE*-H\T4|nЛ19V+wր@N%N+N(pDЄ15ve}&> ۝! :PЄt"ܭ_/h$"MSiO|t^p||k v{a%Q{mO犋gIV\"F  Za)uVLmy?3Zb \9Q[/0Zd Nut~5k+Ju.7uD)}RW6nV$SJ'}rbw0:[k*{I~fЛ5G%OI/7wN o?=' y9֬YL/a7\m|'6oG-; I]'ߵ՜k^f5|\|g#F{.[7U?s[$ߩ[j#[r*yK-rE2U3޲u\z ӌҲ,1ReLc>',?z<1B=&W"WdO){̹̾]51[u@OKTi[ZAݠ:<Ek {XҦN:uB[sZg+1YX*QpjO1+B"X?eq,/MؖMy)h³?B#KE614j+RW)lu4ZuMJx9k%כ55OI"L9 槙ܽkqogrzak̜a<.4jZxô1nNӲ]6 K+XQ$ 㗿LedSx.VM㹭[={Q 9kM/@"RBDl6qЏg!vhCB_|z)9y_ؽ ӥVi:o`KO~JAQ_6T^ _!)9Пk}B\s|o†[-TP`ׅ$qFIӍڣ@OG!v}=݆? < Zmi2G!9^|h!= { $\gS!A?M15Pl=yىyBJsGU3ςlNB6L~9#@|zSΎOZ36R{$Er ;Zr\.5!< hk!D1UHLPN*vղ= IyX[1L\wjT ZkwP8nj٣fPQU6YCG߳;ȯzȫ=s\GiEx5c˸Ugp!腱%9L!&ҵ_e%zU ZHxZc uudd\϶ _?G q 2dHNV!}q{c9z`@;%ēoB>zk*;hr<~SQj!)a/R7r[߂} f!,i[%nJ 6c c]|I ϖ07P5؍ QoV ! 7[+ B"ʱ#;12 aoh0Fwf*lYwA(+@+-6wS|d|O\F^wJ6e{^ޚ6a=b/*K4xJz49UdE;D@ *vyʚtf pLZ)~x*`[=wP{7V¬K>ȚCrYx0gbrjHp.mmʍl3l/fOY ֕7[^TCRMNjy p%uSE|=GRJpɬ\p(-^KI2^'xɗcto:xd}?0"_e3TOϟk4YFH }f9}>e yTG 1t4uBK@+UNSf6ɝΎ?)5pp8av*=H*l'VEvDJ[Ocxi~:3yΧg藏Oϝ9ݲ~#$͂p;#߹r;@Z.zcl?DtD<5Tz},}ܵv:s3Գ̧wG/dkΕIu3!v5Gslx[LQs6U&AV JHޓ|WLo[W WJ'f @hW+rQ a$V*$=,$Py6}9$wJrߩ"w A-)HЫ RZABk$k9  ưIQv\ëndqPXSkyՒ vrrrO޿;vw!wvVL{Q˷wuh~5x1ה-nZ{tIh 7[rewNS Z^ߚ)PzF{F>o,_*:OC0U=ԅ@2۸zcV9DlyzWpoš0zį ӛ. lp_7qfAdfK7a9/wm4T|,6P'O~RK<_r"ꧣޫnn/T^o4l9h)w<6Wzc2X^xľ#[2OآLhY0ʢ4$ޘHGn狖9V!#TǬ9b(6iejxb,k iǥGLg|#R3].E+ K%[A { &ʇ .t ?hwug RaQ JZY`ݺ=R66 "p!@ր :Bx-t7ehk&NVX.!p4r4%,YZ`ˤYZCMpWo 04Xf·SV8Am6Hax[[B<ɛնW }6kj1Y52blc W>z_3'< h&Oxx70-5,SlP?ji-[n0fxTMגt**0ַy| E $VWtF>rUG-NLõۏF @ޞW ss3O6[4q蜘<q=i>]ߤzT_ > j< La $ok`kZl#55-#ߣrX_K\jXB-xokak[`:UAeA̜~}-/94z ZŶnmh+WG/j]dٟy`:i*0TFj7lOE dHaM,lzD à?ezLnRQ(c?zF?;6b $`Aoc[H+C -Ju;j^D3FoLg!%xΨ=a Tԝ9LD/{-+@OK'yÿ~aK  C[\G)ԙ.uefԮ]uU=2-gA=ZlM1Z*ҭR޳U\.D!_5o.> FB<7D.jis9D 2k =Y0=T]*Y3^x)C=I]Mn<1݋u^<}"jLB a  nGL? L0&v m '$l[|0pslEflˀ:fѫ-!ӍA/y`O=0΄]dj6g Y ]\PC}އ v6(i[fJQL(~?:oO?SaBA:xa.̱#M* #HBmtjyM1g2BvY~/Z}/q!I!yN!v{7t,ҊF)ُ%kd] ʘWH/$ׁ~]2|YǵGQZ{=#FQݧ_dTQA96fɵaMٞT̻Rmm_o1r " s?צ%y)'_El]NKqǥ7R$0S q]%u M_-4}KmJC;%ģXw'8T6P<E-8El͹l֫_N-QZk9(y`0:3$P/Qe\tE ͏GZ}Yh]r&ӡyƫҲ=%j*/@8#ҩW|XTK1LU%Xȹ!ҟp5O9Tn&6%\-, ­V({R\$1.OL]fQ<)pJ*;B?s>!܃*W*)F6KoMHVcn˱3 cHu.]Z$ٰy/B}^"vC,uy`p/ի7Mw7~gGp[^Sʸ[ָWl49 nOL~Kh]%19'Z7^R[23xU& ѡx-Ax+[c$snuo9=q^I*b'ŖmqkYךW䷔U<չX_? /wV?mT~`t!Ѫ)GA>$snu6tnu*b'ŖmqkYךW䷔U<չX_ŏן2ЏĮ8Qu}F{},_m"8RB<1ŸL/\yu,1%Adu4.59uqά%q-r%VÑ zmEZˋoۿ*v&}{}*>qz-PR%%ģX m7yBt >}ڬ2tO'@?}ESDfmKR $IKRP\+GV5-zp}x#Hz{e""~Ls&SP;.}fhmkY຅ךW䷔U<1X_')B\@}"JJGSp=sFӠO']{@?}f I!_ѶtbM׉oCxr`u9= I!qKb:ZlˠG[ G FZ^AO NW䷔UcsO>]^ lcOK9]yC:K!v$]DH:] m:~L |J!qJb:Zl[p#=ڪu%n&U3-u0O{n3Wɧ}6jN)*G $]D|q-ۘC$*ni [hp L~Kh]%یU|:ĵ yK`H`b8m!OJ/SD:pG]Ew^L^lcZBS^ lcOK7SdA?l6I ́Vh6l6uAuC wޑ} m"~L |!qJb"Zl[p#=ڪu%n&U3-u0O{n3Wg}@h-,t$} q-ۘ@$*kiZhp~L~Kh]%^یU|I ĵ |mg{WB<01tL~TU9gOwR2jtph DM g$Sؘbrrv%ygOi‹k@i]eVKgFE/}>}D?ؓx%+E@OQdGm$ Jccq0Ett}7 8z0['h21(X1ZTr<#mglV[vhOŪYTˣwcFt}@]Q0}kqV[@EUd#I|'w&]54ЪZ hS"ި]}IПLF1 Owݪσ=?$@-|u_okk;b >VIZ\m]6K"euJo, :@t|pad ͆j}A8 I߀dT5w@'J8?kkPD|C?LF'[['Pkf^XOz۞oX{siar6nJ|9qsZa<-<߭;q¾YǖҴaJ$s;Xr-y\V0=*Ի| z7epm쪸BbOҍR/- KA/]Pt'ъEpiaC^^ efT㻪Oa?GʧΜ^ ʃ!#?⚅CQ|>szF}CM7qƜdW>ƬM2K'\|D?"8p2RCD![|IݜkUg666WSIWi*EI۔1nPCҧdVtVҷ:e3F_ߖq=m&Пy}FI?&Gԗw~-@>:!t=yO*\j]r<g즢/$O_Zi;Z$v_ qm x '_DH3c~,Q:vkЂ7ʟ@LZ 7{tifs#;{v٣` HfʾNQL`U&lQAЄ e7 0cQ(8M;k$:cOS[yQ"0lXd%ϡd^hlnw& W~sn1"jx.fbMӶr!@˅nl?mE}@Jv"PC{vudu-uBЄ ^&ix(s>aJ+)[`aps6RaɆ{.-i3+=plY_ C4 :ksvF IR:3ZN3NMɟ^MW#c2HǁO 0i1; POxH讇z`muƮ}M|=!bNq0 E%tAͣB1߯x{{ Yκ=9iVبwrɰ,.wV:鮩Kjj}wAF>_j~t7БX]$kn а`!bbw'y=2YSOنŚ@)K2PԄ8gN>$0u 5dih,ׄehWn3hxuqšYY+˄U[ei Mߌ*(k;xbkf]} )/歠@+{6UrfI{@IFmM la2/nc0T`"K%+@s/ЏhyLlI쩨o /HF}.IJ|W=nܟ/ն POXt#esJ`;ep5խ7fbt|.=GPxL^ Zm*:D5H͠VԢk: ؚFkԋ))gEmZ-}8~2,!zN5R q8zJLDHiW%7cw^w&; 6~#o|t.cKE2Ʀ|>xB*I:ӎ^fsҞ*J,,Ώlݖ_U61_nf1hڸ3 -d J͹lЫ6AD:|hk8hjb"s-LᵝQr1,{D|#/\KgJD OckM~1r@@XԄPkM:.+PH r) uJ#&S˜?lVRЗjkԗLN 2n&CrfpBTA[] {p ;R*:*!M:Z$`NNNf#*djtIW U7LSۀ'@H%ģKfs'CM掶^b)a/.tJmG`35B9YUiuG4aLmHXekO϶M*'x 5)暰3j0{#1&蔾:;~Xc$-ގPV_ުVr=m5l+~{#7Q#Ni:QfgĨ؏GtHS5i5G-5 *B`&bPߨi9lڪԈ^ |s]eޓ}{πL{b 𳠕j9x4<{,۵g-ۡ/\ľSBWEնү" F cr1?Zf8D#998U(ѕve8$}SdںV'H5UIQP]$!l"SixG/(at1vQ2 9VBF騡'oSBOw2Nt3%'bgx}tVBylБYX3 *#SaHiLF5`bdBfmŖ˟C.=t&y璷&1xLtFdQ{….z >PO9Ha|?rD~L8z0 `OdYv!.{oe)֫rG۲-[=\6Gz쏷VNlգ)sv:ěξb~ں3%"FE昅 D}MBf1q_X ;AAC(xP0G+(jP,s2(.@fs!(9[*D< %{t{kwazl_5FwrBV\"1POu{d*]*49_l6Κ_U\% bfShו2M\|nvM~ue7opy+D?`k73z:|"A(v,[>* ai0WBATg 7>y8bsS;@=LOv _!_,p{⸾Y>wP Bi+f~wtS_f5i!?cmoP|S0V ZIN@y@ok_CqGiIk)2Foxygg6WpjpCB0 :[~F[k[3M\&y,x-oXf8ju?J/) ؽWXF(M,m!?jE[ݤLB|BiKf̢TY&^<[1UJ@YHJ_QB}GwafPA>_$8 ]bjzA_-qm" &ԷuCI+Y.R8wBt =©4 GrLZn.- GqJ=JdAoT)X k.{9wJGAfͲ](ғbJ+)ei5=6= =*y<ģV<ܬ/D;T̑XIo[M[(ts&\+f^{3195x{xj[66F[6bp/7eJ}9XmU*c{yH3YƿhB K\J^\ Z2;~*~hg+Wpɬvn4)_Υ$/K1h:K<ﾂѯѲV+V|ic5,^¬z.Ys|f! 5u \ i (׮Z \Zzr]7K٬WD]t6Kj!`OX][ΛH5UqȪ!aQkȵE=qzΣ{y9{mhvdˎZUHwF^ǻhatgݳ+8,P,gOzV 7[reRZ~?0'?#m]G.n!?|B?!!{sGpQq 2ꎸjs}]bq\I3LJR(!xncǍm@'л{A]:niE#Kǒ5anWޢ/EO_uhgA?~E^h>N4K> 2/VF,Y6)ۣGgYe 9s~9kSݒwwÔ/@".7<:;.tXI&S :uFKXЄIq:Oq܅9㔶(ˀ+;f:sKI͗kkQm^- aӄ;AOlV h*|MmMx/^lΎģؚV%9_qꜛG*G} ̖2Зil!QA_-^fT0˵VjӘ"qi{fƒڮ>Amj_nVn8z"Џ>=[oʆGR0=iƸ9M.[LwzơeֵNWx *^0˼r/RaK÷`Jc2j-,4 [NSL LtJ)[zyrv>eWmfw~姴<4>)-!InxԐ 5H;l&KM‡tJmF+URs}j&ܭw9\g%E^WZb8VЦinsvi+'hyz=Ft=S'P[v IP;'5ON;#a0RЄJK4aL6kDl/gnQlÈM؆ԅln}6܏l| [MxNRoZzy=b4YVHרYQD)m!׹ZM+T}U材mK`?] pz1:ٰi\"P}Zχcp:M=&*zV[=oO 7FSgӄTGЄ„T$AEn=U#YdתO--,eW j+۷<^O?]iXߚ`$#d)di[BɈNs%L~N98s-bhNF#Td?O#IFli;qa1M![00;+jf4~$T]&ʚQ׌$zxBЄ+[HUmT "+Ns1~M2W=:o>$h˜~AݶkC*@WЄ:?T4&LBMIATӲȻkH_)N\zv8p l×hmg;Bn# hk$4ӭoĮ| ݹE?ݰvdY,ڸ;>عM(g evhȉoVw >} י&,7cVpw͸Y.[.MSk^ ڸ=Mu_v|#~Ie}]+ -n-0e :eI AͱM!o,_ hQjS;u?f.r]~ =js*3u t%-VV;rOx!N!]POuqPi:}9tUpuںKBczZLNV):Zg`1X0Kя52a3cęF?AMgO5J[lFhXtIjޞU2*%_ՎU0nt1/9hE.? A;#v5JA'4xhAkHi)٥Yt#p: t|~ijҭׄT{~H.-2]$mKխgA?[wWMMKhVC𫠿[9Uο!MlEWj:~tY?t~'(\F;?@G2gy>#ok4i+00LXчT LM:5aM53v\,FIe.ַbZ"Z Tt>FE*WDAoNFSAToF>[=jӲ4HEqYņh*+&JIJ;GWp Tl57`o3~k3 |W%>|h׃~}l )]K"oѦk):`2y+C?A=3w$?cԳ"P@-|u_tʍ۞'Z@J[s~KTN1VOb)KMlM9DQ}C ksLU/t6>)h 6yX,{4IGqd/b7<NMi!> P h³!I}]A9I%oMSJSeZ'h³&IO :4}]= ߤ An?lI| \)h$K]%h˜m My DbR!/(Mx_~SНJ ?4aLj'L-)h˜"F0^/4^vN_ vb¸ X#OL+L/t^~D:}^&Ўd1t=0:r `?ʹ8覘J{A=;$A.x}㠏'"'A?|vt$(&b+'e k[!qL_ۮ|@ie~'Q仁O? gO+ [r>6oV )?Cȡ0@H[m,݄:VD{b)!E;]W ΓOZuJ#&<˜?lVQP TSdrbq7Y'SqVp455nڥߠUtUBfV;ƈXb#w8URo_gğd#aNVJ B#vGӠc+3GA+G|C| Sձ<=Н1r==*56\tEǦn7חm{}Yo bJПѨ a F~9x4<{r-Z KnhkK;%.+NC OZYz؈@% @/՘C!69*ȶxh !6bkd2)#%/mp#z4 *˽Nk8o2ky'OHK@VkKe% iKdَzb)a<+N^o ղ"%zT*GcrìJ!NÆ)~JUwMGktd))Z%ߤјS4|ÈGA.Ti*&l!@([AIiO"he%8I2@pjxǮ~TWT)-o̻c5'tE.f!.e/l]2Ɣ=THoxL־62I {AFwzlF\sR*(>elEy}Om.2?qS1@봏mw[ǔr# ^Sc2Uv " & u-"5 ^#oB KWpY޷\;mg( C=Q :jU↲c(W/]@Yj9EfFx5c y@1wBb4rƨ3o5mgL׺!<@,`'xrd_B 7kMl7m#W,PĔ{gth*n F]$nwz`Cƣ!!x ?ڸ4n?x@p{z,cmtll-E{$ v\'@_>He" Jkvv0k}SdK/F{QƒƏxg\W,C^QzŞLdA^B}FL~.{?NdQ~;fm۶Eww Y⭱=jd<͖ZS 杪fYX;".P]H+K7jiDU{|[ TAPtV*>ݜe-H%Z²`\"+].Ztݨ!-ϧ˱ƨT+Eq 4m%P B}KP6u3A cRIܲo-a4r%4}O>> E(M,` 9VJb~]"b .nw-~'NZZa-68dzס=R\ ]sndӍk69\wǘ%5U{x>FZ@M@Ϲ3{: ͞S=!'@(LHF֏@jՎRPw =i^=xM. {Ac66E.Pѐ š 63- a8C/zR'6[ ;@ |5d,加aCW_aoL6 c͑ $ G8 z8vA`r:UqɄ!>oiɜ#ᅐPo՝`cf ^ J ) xHk \!6I78mD Po^/ݠc˻gv6c wȓo}Rij/CӞry+;@=MFjj5N[-y*Ӣ"뺸=J7kpQ5ʖUѕJHMo|-R:p]wE Zk&QUWAWi,c{=JbcYi۵%??lAyj?2b`b{iB%4PPWɇ>}=>'l}-x1dpE;VnïCY=;Vq))̝#+b}a(˳Z˥d¯׷ل1-3SyPkFHL(S2Q7A7 Uz3DyV[;@=6lH=ǻ[knYo)6oEbJ[B_*E.҇"O}|95R=&!ETs aPOT?#p 54#{$hR #QK( SW:w} w1E&R ݐLG7MmLO3n<؂F|V_p'e-L61nvQe#y;>A%JA/3fÎ?&M" (t`C-O w NƖI}P6$0+-=g;@={d÷;23%JZn-Gi݂(zcRt!&7 <:wK/8m-xSCN D'ºn ҰkEM_؄ *XWfC|RUkS??h]!x.8·|d&]Ԭfo') #|΂.._GiuJ F-nnl]dw1&<'w7M.o~ͰQqs^f48;( ڌ]m}.d$[޻i&[e~ w R6?$7&<69!\ zm Zn{ 걽2`#c@!%`ON7 <X;żY?t̂!xG͂[0VlS僻iWN (q(@8Ͳ](߱gp%ڔ4ʚtbpU^x*`[=Qs7V+:K>^˚CrY^{3195x{xj[66F[6R5%zmևe٠Zxvj._PΫͯʱ݇om7%uSdAwTn,x==[Ň|jHG$E};fXM'vɡGW#?/Z6ZlF;eKU%kWYqmނguZBخZzՠj)yd:NTEgGӔBJGV$L1=G+~3b9ʾN%s(!1\L FkTof mHxUJJGQCJ ĬvZ}5eoCk޵|xYKd eq=\=b#u5"V"t P)oKgNXSbqrV;c}]#^vDk]7_:޵G5G c?5]c_I6-[~o29u@mgZ*n4=R*:OC0cT).!eC>w雼kW|f0zį ӛ. lp_7qfa< ٗn8?s^fڐi Ϝ Q޿s!f2@.gE_cQ?YjN>+Irdí7r7J*MPob>,14lZ̡(ʢ=[4vyh cUǧ:f 7Ά : QR nlH@r%2ƣ<- jъ!lJXCUܒ5am.b gYXnG&< tҋl$ ٸϞY+ X+(rP*KX8CDlT;Tk@,`C:3챱U4B`o0 sKYWo}(oQۅw&܈I޾cEK{D[lJoi<v"?eH}e׾Nx 8ݠN K'y{_ _r{FwƓwJ:{_ _Smf`Zj i 25 3ͽn3*G *3vۓ7lbx70խ5Jt^ c^iZM =yj^ &-ɛ7SB<ɛ2:NZ&!V:g7RrG 'zG{ ,z BFϺנq'y^ ^RoSAe@/%0& ~&oӴqe׷vV96*]3aE5x~ @OK'yÇQpl/"pˀ;jA&ۯl?]rF#/3vBO&`L 7_,~RX%Lم` xޱh6U6 ulu3Me_|3!/OB4 [L7і,!҃h|D2yĴmֈY-ok ϲT԰X]VVˍH/})fbh =‹E$y'A?*ov/u~huG$ˁo{QbFoLދ7I'y/zht[ElٖWufy3d\5Yvf:۰mq%d? ])6Ka v>;CsYRàkSȜks~ 'QX<,.jUKRۜj9t@;ɨV@WbeYp 6,'/D4zƾZfE߈5"Q_O>"v #-b) $i],c+ (TAe@S9Rx59fVT 0;CS341Â0^~Ԕ9n-ڍ62#tHڬT\g4mIsIH3*'@+^J܍Iw~ vGJ[*&H'y?w0gsr[\Q[Qu3/,V0'uIJX1IGV,k)D̛R+6l59[7kiW*"A[c].(+zHk]B]0|4O7 L/r?EB A65-v\2@KDR+ej 5if^9jR+ 0դ/4aLl1L2|%7*ԍC1 z/ty p u9C:SEG :oҜj<OЄ1ոHeRDxB)yL)tj4<4a!:'MZB=%ԩCtb_c$_*̙c }TٖWu])y"LEzOئJNX ]ʕ%>&Q>zC][_uB7*Z &rcNQi{WeD à?~菴w!~ Z߻x x].̱8@AeqϛSP|Xh񃳹*{vз+ׯq#sx t tޥSV4N4~,Y&vXP6^/$ׁw Ҝ|Y3"eͫ5?Z> hŗ*(ˠ[e Zfqڰl'55Ye 9s~9kSݒwwÔ/@".7n#vKW"Yp2 (OQL4&HLiZ̞Р+~P[<QLHQ$B;bpd\ޙ5:]+J]fJ@6*`QVqmdܜ6ʎ5BX] 6cq]ւϓV2bISOM{˜aziؘtZ/4Ef,5ƎY)jWL n< ɀDA.*,if$ZǫT4v՚3F̂]}q&cêF@v^.N%Z4wo᙮\ig057gCNR^m bAnw%t'C݈nݠN؊ֻAmMWS]$Ak뵔H8 ZLj2p ھӾ|*sH 2)D>m뜶U!dVZhC"| j^MU2?ɨ/Bl52k(^}2]A?_~wG}K@(5}w.Iӫ *_YI༖ĚbSPӈIˁ:4Y ]Nu⧂[a+|t!DU{ؗx4Ũ+M|}=)m?#=ZЩ0{(L_愭Ksd xws Y *?IIκą M!jS S.6r*Ȟ1l &;j—V;F׉$kπ~}{9_,z4\|^h@$ׁde7A3^5v~ݖ-3i ֦QVqCN.MIĒ3*;kcY5§:#C&ds4]nyA&`'Dt'0R9Ϥ| CAF+|K'=&dm7IU:[IUvΛ&CjiMetSMtv61s pSVQxHxoCW ?( X_Oإ̐ EIg]?!TϦ.v1sz<1ztg%ENUZb8VЦinsvi+ܳ<]O?]bN}hJP: ъi1zDz4a+MSa -rDƽV(zqӸrx~}" m̜*'w·:IJvk:[:$b\ |uI7mo0_-D)+D ;@CVK6wAn2Zy' mh,yҌ7 :%COH ϒ? Yc1(zלa3LicrB'H ~Utx*!hBę*qчN\?cG\C!&fఠSZ-# 1Ѵɯx!<&la^M7@U]}:ǸO)˟^M1~1Z ΂6R 06$U&ڄ,j;M؆sk㻀tvu' {*Ѵ.ɧ^:@-BEidpoWwt:OG4O`sV<_<|޹ihGD/=F\\/hsw^+ ~Z\1t!٢zd#oPBs;fM*zCglrtt%mMwoчGU{h q[x@Hrȭj#, д"YdwO-&A!sv+hy:= G@ȉ٤ ~ګ NL)%hUqfR\LmK06| EA$"@ӤX@T}*/U/>u\zS"muƮ}<%YhFO9nXմ-^mU,CøA7 ߦapN,Q|Mk)iilvW;Cvnjh ObS^dbk ~&i1Jw|{9Z\ pVB5ԓ=! R2zpTr&ɸQYeuMv0_5;޷G-pD*Hu*yұ!-@<1keӳqSWwљMYǘ>* 'ur1?e}gΌ;ckm۔1r[g#e#' zwR)[EQQQg6E/JgŜ]js}MT VX00A.?Zm.}h!д4Z:x+cPrPYAA?}IjhCȥˢD+cU^p'\za s}`.zf})*fڅi ;M&쨅ʡ AQ(iۦ灭˾v6ӗݼھQ Տ.T(Ky\\PQ 5 h-ԁVh`-fkjp++h_vӦ-˴ <|aC'`J#~xc3j @="a5"#v^iD!E/7~2 r%mW:ŊJ ɷx [+ r;p/k'p}u:͸{_Ui0tu4;<;7x)nEHFѿ ]J_cn'~JPOWyѕrQtU3bli::2bl:PDw4q6$=qVF+;6b47jOXejVlE~5j-C@-}mߎ" ԲTT~2*[%3*CUOI2j _c⼑]hLJzk.ϷLʁqRL)oIct /|YS2m,&:2BzVЄIwۄ0Ҹ];lxb!k҅jIf5iպXPͮ>1FϼKxإRϼ 89Jg@A>PϼYwgМU.Z[P[;Q6gn?$!Ÿ5v!ƙT4P[0I\TE@+͢?SDKJX @ߐJ7[%WȒn4F(Yyd?ٿ&]C=_try1Vb%> ǮLګT&=>RF1􍦹lQrhVʶ ݽañ̻LIA ˬ%=2e?J h*[E_LA큥A]%ԭF1%HY+%FvExh˜U85t=Z`ַbw50 :We4\0]ݩt늦).\QƈY*yF)t1fF&KI&k1#z2 cҏP@y$1Rבּ-"kUI>_0hbn Ͽ :).HN7J*۔6vYL٧Kkir><){ؙI~0-HSj乪_y:@sTβ:8[L4+ްM?fPuIX ;]_ʓx;RȮJο4aҮv/|Wz\pyKaq'҄5$/?I+/Ob܁m6q'&jA2(.#>s0̯Dzġc+8zPEx.qJblOҶu*#!YG+W6㊞RJI^eRr/+= 9{Lzee29ġeQV3ƐA<QGo$} &I7^kG>A͹l@֫T܇?6vYݹ:\}F-PH֨`M]&c?]x¿,NHSYg/ Juu1FU*ӭI-S$ xe-b4ʫW+[j.էvNCkhS4?u6.qi>E F QǙΜ6h=3b.{XTVHHDE#,mb4כ6ȃ0mGU|3_zQj\3xSչ/YO4qV aگft!jqҭ#yVoU㣵G_(fd+ya-F3TѦ:j>Q7m;qӚOj{j}$c>y:$7ݲ4&znc8t4zNyG!3hN*h¸1])$ c$Jξa!hx](>iJТW/>? 5 ,[x MIoll2cd⓹bmSb&ަl*{RZsz7(9n)1U E D1w??4a]KЄ1Uv yK v4aL"O ԲH`?㌽<*dC(n,`~Qt7L;MϫXSf7ظv\OkK,_LҩL+ĘS**z7tp%сN^XR1n2}9?xS Z8O_! ~gԃOC' )ӫ1vUMx\爇np Hhۻg`}'ص?] ٟ)D?I.8 6NYg}"]qIUふ1ެ䁵a߮ :cq>>Ngy&oF 6;##?F'Q?>'Sn$T}ъW`>0meՄ{q1Q婈 #FKSsH8عXЄ#\RkqzwCT`QF<G:ᷫjBi H5{茂`Θ.k}xFڳ~jڄ.)\q8*N0憫Se>@-. K^|tK%]4N;SA|j OP'C',\;pbÜcϿQu~!)έꏬ#O?ɫ(Xb򌱯.C\Z c'u-W sSMryu9%KmQ~P:8faΖ @h:@=p)s'~YTn}}σAe~yyC[i-n;{^0'r{$j2rFoOb>a.{u8 I @%_y0^@f<POs4]h& wٖb _uz^ 5Dc(t~Ҵ%ưQ[wi n͑Ks%84 78EG}IZj @=>a. 3/w,'>!c/'`R˰`Ikh*3 NE+by*شR2 %.S߈ͼ9<'cnjtzG=WIf,wd?cm 1tcIl~s=W࿁7**俀dT_elвv?MI;J'(0  :v;jC Ppt.^*hB]:Q9xDY4a: ^Є1uzX;4Ed9IkM(}!ϙB灣&Vz#xL|LE-hڒLZ ՜kHV^̗2Zg-LStc߂SQE|[JvihUs ZGreX]zFr 9`Nm3tB0o~m°PMc6qB b0<@0uiR!%qxZR;غ4y_3`,ó ]uݹk$zFl`X|3 |F#q!ݷ,Nb 蚓4Md-qJ ֖Z*h~!jtrAk܎z[BЄ <^)h˜u}Q&.ɪ{֒ ]Є戦)SO݂N[S]7:}d"m 9"q 5+Wxwa-"o*;rXG{&TKEg} +t:{o+k'fY+FT\⬑F-В}T@^Zi0g v/}(&MTBQa &mZnV*V8g]GvFJ56o? x NP2IT{~H.-DnW6e5Fg@IFwxl]zk%q V;JH'of}͍-3ys'TT[~2*{ >ZaٰhՒ~ua]vr $~ҽUn}H?~7[two#@MO΄Zwd OZ^pi7*둬ǂN/8tLa}ҍ<#gCK\dkta#UM*쩆zF8),?S9F"QVW^VB׀^[+j"ކZ Tt>EGyXDmn9M]=[SRڣvn2hq-nH%$d8:%*hj ЯhK|,g+RQDx-ߢM)+]'u#e3r\GBALF=o~4'}D=@LzVQ#>%뱵dp|!?$8@ |jΏ'֋+Jza6Lv~e|C`j 5YƂZX${H4axDЄ1a ZbB/OݲP&6WH2\ЄgIzVA&W&h˜ȃb/4kRBOGI_~M)%/ΊDM kA go"h6ǟ_pjɯ3!SjoZv.4av;ϘƟ#XЄgKy[Є h &j?y:{78Z)h³[? Si9#Mӊ+Ή:NK ~QYIsV :Z1_s]EH@_zC&vKRgE"\\z>/hGeFDKF9tl\\T(m V;BؗD:|hk8hͩr!|gGM"]n21h۩j"e k5+g<2DhV5Ew~O$w? ke~gϞV@+|mߎ5:WEIGjcq&|=VTľSB im.VMho/:8e'v@ΕD}#3?Qw;gA͕ɟFvsT.FG5;BǼ%acOY&!䧃JL5=`IWm5"J'Uڐ>/}F!O x Kb6K[(ySoE;!/}H[-{e<'-پwJ >_qBWC^!v Oj|j`N8?//? \:P!l[qa>L  K4ם; ^غF*+;@=!Bq?^\1OMsvƫm=1oyR%#|CKQ.]GI͘P?T#Z_CC~ؿ͆jP!_ez A6!q*]CVưIa%]_(* ϊn@pw.ĥ,;\=)o>YB$x umnςwzn Y/L*cL]ݸ&jIs:r^ @i rsݒW͉ekT\Sdͼ" ( j(,oE[x0xoXj,E EgG=-V:6{€# fJ-:qt1&캵墛[ :IY[lno1235w<鮹~[uJH7ת8.١-ҶqԹ8<ȅucz '.⥡TKE o}sR<kؒ7Xrf ‡蟌QY2xPE`c6;sb*PT`T$$#\z)Ts;ΗӬ ra˟, D8˷I=a/W/`>5r "OaI=XMҎ=n͈&+|ܬxoD=c2BkpyBy"~"6e{^k?_vj?}xhz3Y+E,eWjS)kpNW^N>ģV<ܬG;T̑XIo[M[(ts媺I?$׊fLLN )ڥ▾MmͽklfZ}9m*㷀N j5!TK烖 ݢY^{zos3%>\2 .r\Jb?3 #+-ŌM~ϟ:kT,c^Œ U9^y;f̒X^@gNA mLRrJ5ӔYfp'J_)!MY!de;f@0H..TG.4C/&,kf|,bBJrHi RO1 a^lMO+bND,:AET4"憚R6X!HGjnE1}{2Ӧ|S-DT88L ]J&b0:Qm헚AL?y3 !E-++%TO0 cti0.}63P7siըIk7QQ/{wWC ۛ\b!إi>[;(v5|yi$5x#C@?47cxk֐[x9j Vh'Nyt;;=Gvo']3>Ѩj=b)?Z3ݴYw vIճ=f˖[a?vҜe6TO3R-]7xӞogiĕ*:OC0n1ԅ@2۸zcV9Dl󬩟ڪ]ϾsG0r`Zf{eqSg6Vɳ̬}&38e 0̙ > 1uH3czc7KYDH~4M/٠ShH?"q4l1V\sm:ѶS.[-|2lZ1, CmeQ /̑E{h8WR?srVEE98cÍ@B<}M%ePRxb30/=zP<磲ϗwrtX|Tau茾HahNJ")z'<>~ >xv4h\+[=O`jS,ѱVo}s2ZZYD=bvwޭM1˺pJI5w}O2<Xn1{%ģo]}~ $ æ9^mіc6wY2X_>%L5i:4Hvt ?oC>ŘÖFj>$7Dm#hehm]s|1'FK$ē|Qlˀ@H~HoZFa[6oҟk`{6Kej"6C6||(otԦEПi}Ӻ͉?|"OMK}ne; -oZf4:O#.w\a"X##vf(SsHqs_ʎf#c.B[ =Yr2 e_hM_[7et^|R -пQ7!w6u=7*KmP* v;$;w;VovxvVz:h|Dèg uc2*8~rMNY+1,[tNezjz ~g#IfoN}^),z*'# u!\z\kߡdx9[‹WTVw?=N6e_Ώ{,$Y(;٣+׃vi wDnW'@O$\cVYN_`5_Fw ᵠms Y6{Aq}b+ V 3=92~.eb[F*c셦A܏4iڡԵ#}]ZJSh3UT?cX񸖐ރaM5er)7NY[C{x 3,~Iߝ5v :̬8wܡdfxL'fu<ëYȻnpVI͑IRYZ?+tτ1UOL7Ae&LPS c[f#~R &Ԥ&$տ 5ih ?&ȡ9&TKE7R˅kw/inwJon疸DR p1wބ-^ ZiJi*ٞO'oi]Q.wp3ͭw ت)k%f1vFeQ-d^ZĢYv7PIElbx`7Բ;(ȵ CSz+'<HOJ'y3-}Q='ΐgrZ+ȵ$#tJp}5^;}߲O/)^;s&P*u[SHKAZzc֭)K'=&d B BZIkUDg|;H Z|5V7!h9אKUj$U63Z'u |EKMS4sYkOvi,^¶=hK-FIek'yVܵUIKT.ok&FX׾Wk&T]F ]Ҽko-9v})kHk'v mډkϢ-!8ˀ@R␅b%!腕'+Y߄D;h#U":5Kik 3v(l8$X ĹZVoLEm@hB+cbo}[2 Z햃b!;TR}u~7b}l(݄A"<|t\,9%X J2yGb+g *Nw\is A0L_Er>m,PPSW~>y=Mߔj^|37VM]m[˙\˯هFJML> POǂƍjz_.֮_~~H\cXK.hA 'zn`C;Aߩ*o<Z)!g]?z7:0lne"tt se:?C[ ˒Y.~דKc~YX)Jֿc+%:IkLl[BJxil1X6l)t#Nt}s45CBlo)蔶!xT)%Iz:tac=P-4y94f]HTA/4aB 7z'Mvǁ/t*k(&iQX |ǘYdgyCqA$kuqgQ4{0~> Ƴ{}x[ ĬF rmׂ^5v+ sjW @7q[fzWϳu'o&qś8hY0U>HB򃄉V;i؁*6Y@.?Fn%E9bes5NկToKr~?A+RMGmJg] $V.N)#˜?lV_еz"/T\긣 BAЃkܴK!|/n%AɣIG|m흜FUH tRsmO$zT%y9nImtľSxҸH۾9Y+'5f-GƮlƸ޸ˬf;F:m@w_sA^T{ ck[-wp\܅t|7B7Sʆ7l8lg9E.~uL+]+4'!y7E+cCkW~6yVB<ڴ1씊!l_ |=ƪtw zzr[.m!jM]ko/m۷mk_~S^}?OAFNXpw %?Ob$T^C=Xw%c) rיg3}v-cj_&puQs%ӝf.|}T#!T@suN-; v]a3: h%bj@ 8?MY*9A+MD똈'_Xαi枞[ i&Ӭ[ mݶgM}}G#vL$/7sKG/IZ໣Aba41eO?~rZ׾HݏaShfhc[ΌH݋<:7Thh ; =݆ޅ? < e`PA_Z)8ZB>XaOOϦJA?M15\l=yى7W!Q ϴW!v? ɻsb9 h*yH٦BtK"^!f-B%#Ӡi˻ Ug}2`wGUmMcZ&>y`V)蚓r2*RT hE{$c'@?L#OA+M 1OVEl0=»H'2{ƮGr"yϲ(1+^cWG[;xb)a~'4vq/!ղk@b%gpm= 8$R\&hKJ-)yW(qSayTezU:|+c_q1̈51 PN2F#j BxYmwzZUd\W*JX瓞33u] >2F}›}Mv3yJudD3mnQ,z^4S|9CT%#R.HG"˱ԣHHi={YR^*{Z%1H_9㯷X rx92 9K$/DV?h3ڦ. _噸8)X!w6x~HNx3cV/U|cVз,F_t"<|,E@a6CUZZ6o;? GAEP|?\ b 6anhkTR-dG1:BLR,A*ڣ6,Fë3ָ3!VI96s< #NV'$RLTT*;uN6tN"6Y )a/Rf}b3n%qYFJ Vèee)QYǛ. Cb0?E& QGE1$ 曁="$m},u3ꇿ 3>ԷGN&QyS n-;q8 Ō3ɇXdC<~#wvG[t׌o4jukkʏL7-=k$B==f˖[;iN2ky{}k@JC{iϷƳN!Ӑ?‹n xMm\1JXQ6VkW|.ug_v9#~et`0 ue[2W|͎3 e ٗn8?s^fڐi Ϝ :2ߧfLo̺nyEԏ)jpI$*ʂf <"ݜktZ6/;-P[Yfċdў?t<_FTǬP1*@<}a59Y*!Al2r/WР.:b{pu3 `}ƑlcQHP-o7硭,+M/OZQu>TBd7Wz kRS b-pn/g q.0%&Tmphv.w+!ra[P *P.p;ft+/-9#)7/ә3nikw͂o xAVpIJ-ⓒ8&&5bVKV&JfoxՕ,|wil!ؽnEe=~o}[|%ˈoK'y_22ʎY]^]&Xa1^W5wr2M)F>(^jlkW> nUg}n}X!nf/RЅֻ_…"bВ/30`rgr݄l Y6,y=C VC[@oQDͥ;ہE/5e؆3CcTJd֎qňYKo h+Uvņ}5_#.isY؅Q O[_ճ"d\%0ݖ#vEQ ejSkHmdx Pj-*AxzV+nָ\<\G1a65BHC_1.jठ ώN$*ӂ&<;~G)+zijq3&L4aLu">rqEV,>OS@Єmw` +h˜:(XeeU-}&{b4_ tp:QGЄϏQ ݩ4t.4aLӽ\Ҏ=rdr)&q-t5itt.&hBM.f,Du <"#(s7;pPu=HGx*{g7qXl3lhJ*=PSu.-&{*am$Qqš}zlD jw O.m"`_NjA_[5Bۡ JH!.лT%[w#K tAjs2k]Sh{o'Qݏ̮,imim^[ꚑfOI%Yuڲ-ɖ|{}43=ZM + WNp!7$$@ @$?M=ӳUWWw*>O;=^{UW"bh-u׎ :%諄fk&T/ x";SA FW)!xJc,/7j<>PUWI~D_< ,@TN@C^ZHq`tEY;\2˄sv$:A i +Eu}+dH~|d:N؆K3b^SUifkO9xAT͘?Nxtyf.yۀMu--RLy%p{w~w~*=pG & KVN'/uD~'QɄ)AZb&O9'9WA5kZ1蠌n&o*eB7zaK);am:FMi7˦;cI^wxqImU\dq5]jECCL:sX^MiF5ُLݜ1&r{|X =&[ 7&63KSeK >AF08-M0> hJam4Yڜ9m|Z)hEfw_:V6$pe ]0AZhwr+U,>0Ta|KN:=ͤN :=>T<%$& 㞚 ⛼yIMӰPElHSSjFY#~􇕹 A+I)xgA6vUKw+4yK-ds"){+۪&ULEڝvOf"RiJ`<+z"V29X0"X(4]o(%Of9:%*8 ig4M*8IO:%tq/?{4aȞx3ME3cO81ϿI~_Єq(+4a('? 0Ptl Մ{Nj-o {zF1gVCl=H?W=7jS%JʨQL=NjQffOϮ>wNիm}Iݠty%N:LP_WBMsd$JKG|_9GCb4uݣV3V[I՜k jRM{Oeu1FELWsȉ[LK)f“qO͐`ADZ_X-r]\C|g:AG@?FAA I:.hB$ >Nɥ?=$Yh?-O@:V5/CN;4"t9=Āx~C\]咰kqlkikUЙ<`IwL}kn+L7(K[7-ZԃF M>ĥHG{FLOOU/ y pԫܷjNc}K0WIndnHù%a!J z+d`qsڃZfdhxM[B5gԕfA1B7U>&<VզN"iv><hŲ)8z& Oς>LWm7HM{iǭXNNcD٘iysO,30~-x£Fg- =LMWZ6U-qZA9 1*V]~V D-~'z_a;d%vI̘9m]mlL!7~H˖d`O: q=Tcq_z#X!ER>G/lsSy"}pp,/j4z;i Zqӄ8U}#xn+-טOWM ),\tohrlZ 2Lseo 6y$حPJV- 7:^Wtz1S o}kxR T61>^hg S>k! {3 &Lٳ-܄'"|!me'x{Vv\HT,Zyl\ vA]}/0&톜 I7=aapޅI@(BuaUIĮC5:]`$aS+1yȜaNLx 6|~CyxC9C.'>:>x+46Zf YT "VkH @~`!tH12f +͘?;C5V|ϜѾ0enuk%IzBp:G!=k;=e7C^qbw6(Z՝7 )3U#@ z#\ zmh!Zt®:ic Xv? -GT/F v-mx(m%v y~ ZjXwM&C9;qJ8z(sx=~pv<(f2xeλY@ c3{x{}N0v ̓j, TP-Lv x$B_L5[R ?bЗsvi5bBkxBuHp;muUhG+_gsbo[=TӶʌاnYTS0%,|BTɮE.ؖl;D" i2RKgEA ;C+j DcZOil<"^#20>,7d1=ɆsO jA`@ߐyTC5qGb%ۛ4 )ܑOCJqou!i|e77sH-;`O2 λe*"9St_ohq$$~@K5D@VែIŸo՘֓{-(j ==u{/<3ASl 3> Ս-va11p nρԄ᳞@|` E m=L81䶂!!{shikl 冘sb 8*V/ b7j o`1ŪÚؼڛ bi3v@px%Tv>(M5gi[-?ɋ!=1xXkY(l)3'n%pp23ҟ{$g/o݌'!MsH 240|MMe0ɷ{?.yO<pS_1 CS]:J/i*ŦUp2`3J-3pb!. 1Sf%H/Y^L)KFO3Ӗݬ+=䕸C\r p]߫2Hw,;WV]N?ǐeM]ָ/k5*p0x|j 7>$njbY:CQ nH as[ aC\}i`#/!-T S bz3D!%eTX q?HIG2fgWJI9{ …}O{+c1ps,#9!BzD =Ã#=}+@۪ 9Y#ORLxB ?Y?@kΞ|oM}=Ԁ~-"AXR]^W*,JK0ۨ|hy\EK} YqUo'J 2+!X]4{0 ~& aN&^0r+x[Ţ5MW9Hhi-ZtkZ1{VbS+~ziݔx)Ket͒)rgIHiuӡQs%b:c98Y?<=G<]>~#{#ڨk@Z aHGj^Hϳt7ty녗N2}VdV I>w]attx\>+z4۪Z,**9j;BBT61)u3o5Wj2ZfV4]*paG.#?p!W 8F \Hn \H)pY \H ɻ'wB21"\(pQr\VW%Zmu=ցM" !E.Į (!Cȅ؏W :UЯt_Bb\yRB'wB21"\(rQ"r\VW%Zm"u=i%5j/jK.8&BabK.W~14p!y/p!/g-p!.$ .Ĉ pQ&[Eb \K"pZ]h \M\Db/kK.Į abK.W1ȥ<4t!ʰl*ͳC~g}Md[:=ANwFoWú }WN!-^Xwo$';F*Bz/̻6#ksL RbcM!M5њN5lS/WKc,J5c}y`M4-o߸>q2ԸkaFbCs}kazd,u_ &եĬ[7͇ZuEĺg[7Ia;V_Fr+a+ag=v̼W¤W¦U`&{}+~UaԼ;`Eb#bޡu`h=̾M_RbX!{lzU] WWcǦ&V̲ؾWWk߫`ӫUiհw`6:¾.;QZZ0_ ^ RbY ! | zMEea$$.L6W/t)V*kp1Ǣ750q{@{}+~s_ _vkak#1d Zܷw0.%މqޯ_af˳c_壒_D# j$r>RD0 VMt!>kj-Z /p VEb\S1Q7y σ@Nh0}IГwboW`L] E gw[n82)o&e7e5+z^k& zwMo!-eA-et+?]q|`#a}0z#a}(~#'WF>Z#ja#1F~(9 ޜÄ @o~؇7 0 њs%9o_39Q6 Y?F`s9o oH֜7=L̜7„7FjΝNnaÄmEàMG@Doań@oߢvߢ77EkveMMJ,k@awpnVZ;8ݛi!|۽$-;۫xt҉n& 'VkܬLuG3Lwi*94j$Uo澤',wCF˵nHut&@O캀 ~7KF8+In"W~o/XP{&A@EoϛaÄàρ3!9Dk3A9DbZcaO5?B5yg`҄5z o}[M0Yt6Z jYt6>o7\,,зDoYXt#^Yt.oS$wYhFP&T60y{jm[v`&{7zQ̶ m[|+~ {mwсOuwԏSYz8J/mD^vuO(SIG0 ~<~>fMA +#|V;a>L`ƞV ɺ ?W3|{gRE&ޘT fx%w f93͠6mbLJ7~s}8ZXBn`eqgքg2s׶z;};/ٳ." ]( pv}4&~iZg7+?7+?7|+~32iY xyCZRqhobJ ˤ4[9"QSmo%?{ucp7Y \۠~z=_#v]~o~qspB/$_׵U/o^%YNL/YղKeA<~WG?C\Q:_q'A2~WG?C\asuܙJ'$R7p9<ݱ,F:/aIPWD>AIIڊ'qE퓈]4$boW>ih7uTH \z_Z4KOսRC3OCx5ѼZ֜! s\)ZzHv`Hy5렿#v͘}:fu[oBb%;#.⊖Pw}JSʿǣtJ?|O;~GQ}+1j0gэQҥ$^Q;G\(hu>z~ Ly_dn7$OF }h~9|)bg {ȱH~5gsaPGZz+ip.Mw'!XhA0S0v-N#{#+]`;DG^$S7#kwkT))SIJXɶAwϵtY$ e#A?_Tt 5j/\kBh 9RU<:h3P*qKn|RE E?&.߃$b>t0gnJQPP;nrPm% Ug|Oùl VٺLKC< p Z*4pcTҲ&J[<|\%Phj-"p&(gf)<)AB_ x $Z*,B_|37Vh§Qhza+$[]_x'?ɹ/ Iƿ 迉G%_~ B^d@;<.)2fi_SMl/4aH5offsk'_͊֔aOۦeIզ :%5U2O}BF{&A; 0nD~R(}tRNNIm^ XtZ)}{S=JI@/4"}I$ Q~&T6)^_4aHI@r>AFDcGؾ_Єq/ѻ_Q:(S E2u{:TVj8"X=tzqM_/0L,ߤעTMffoЎ>,^6SN.V V?Iq&۵wk$qEǒ1Rݣ54 w섍{K+.qk'gStk%6$,NqXB)KcBowhEAU HqF+UwaNݠkL=[kGo'&l$~A*,PbQlYq2k'7d4l-&, yaǭ hoO'" PxV"ؼv{DoZ-y03AFA> CKIt4af؈jbp n{ bRs'Xf9*R,-^ КyI=㋼͜{8g&sެq\Ux;ϵy3/Zx0^/[jt~Eo*^Uп*2uVubRF-|wSKsڪwrZ~~!׌\@lMR6 luɆ.XL2\ŷ&NZ0紂ɢAIB+9n,93ΎyH :閊⏓jεy'?wc-.x]켦"|V h%>Ȉ],ecI-g|󆖳i.z %~}Qps‘55uQWwMFɩ잏7.b3])-)ju1_R$VzG})2Rז42!V"#Sw\^,3ycI SS:HRgs]G+7zeRo?6nhn@ WboW.P.P]{JL$TWB(z"TBPb3]#hMļkCu4T ˀuP]~-M{g5FycM彋b8@@gLj:15'ЉqA9 I. I%>kDDte-(pR(h-/t/;8N ?@'KJmta0 jNTbSȾnĠ<334)@ ޢyҰG@?WXNL>rbq8 I. I%>kXDDre-(\R(h-/tX/;8:D ?,'KJra0 G213)X,~ cu dN\F9 dN\WEw:1 W\ZdhղzyΒ9af7ٓB |qIcsb!c#"'\P9 \@9'|͕șHlLjEl兎#68bg6By3Vu)Pil^ˀuP]l~l51kh^ AeݤݎlP6!8!Bk>x?:hMÛQɯtS?Y$K7ӫhJ)Cc>CwLZ骙?UMkzUj kvM:ƞuV4f%'m&ݱϋ2c8 @,Om :%Z^!^ٮ@`ӔKqO 0n|m  6@ep#o\[%M*;p9p=Sĸ͇6ЦJL,23jwR"Gg͔)EIrE2dTB~8$I'紊aUƠ^6K,>uZ gfy%R1SmjˤįtVV\ X ұ 6 j%hr?ߏ*v̰mǺNB+@vXcqm_@qk{zbK?k </_uX36lb̭6co3gi[>s=N͎tsfRHkׁ.tGy$*ثdĎ!@M7e-ܢ;7VQDky"68y>k6>cu ~^ЍpyKsp+譱G8z0! ޾0>wȈS0ZĂ9%-xUר,OI0E] vKj戩6cu ~ zgFv<Hrx/{1>ĵ0@?0}b?(#vLA]h9 ꔴpV^ ꢳ<%A]MPw1ؙ.#F#Z،5+!࣠ !a0J(phݜNO`A߄S>Rpᠪy#07u07c9֛pzN=_߄+38[Y 58;Z gGlpwI 5Bpw3V 'wz.qI6Y6[r&IUf-:[V(sq-zH>k:9pHG^<%uMD}1ؙ.#F#]،5|URˇE]NA. <@{(3ZI x5::SYGhpD>k9܅X]ǟB\ jQRYw<mX?=>&|KQH!%S>&1g$j1`b!?!^ױ`sHU>kb9(k@AZF1ىBOv"68wI 5B9gO!w$C5R5)$َs:`9~M!9`Gb9~ȇFD= \@9$51GEJZ8pNQEY:B&]#.l>zpgGb9~'ȅ{1&sHCsQ`9q-C>{&(3ZI x5::SYGhpD>k9܅X]ǟC\db:11=ӔmӚI<Z.I )FO-fzҰFűt:L}m9 W^Z;1Q:Z: 2H͠7ǣЙ:O8gpw"} O(Ӝ&RX<8ǓNO*"ןNKK(,.GџUy?0xN|#7ƣ_ No:hS|U$;xtw~Wh&3e\-6 L[Fk8Y֧9/s|!Nz;HtWhMhA:F(d^KИa|--}Ap-0:n&v.=l)h :e+;VN[0~ 0ݑ>բfU<]sCǪ?E'z Op0c>j58^-w">׀^3,zRfp h|`حn-?*&tK倷5~~>I@RiuH+}+"hٙL(` \zyxiR5;r/w#Qz+AK-n:n$t# zeI$*!͠oV&Tlvp=մJ9mq FvfsA v !%Ƅ9&m70A7G{|-;!H^uip#*r[SSϑ@oP&n}(zG6o}{h}]e0 ӆw4͑8w sLn`nP \ZsyHyHvR'#vw#NhӦ;Ma[N(k浊UŹSmꬕmE-*CdBzׁ~]r ̇cvľLJx) pxJc p~{J0SM@uad&f5f:Zllᅕ[e8F*P'#0 ߠLy Ő4|;7|w-%C>LI~ am70P# qE`EX T"vV Y-5FaЇCkl&hidIZ6Ǡ)p6 wN:|v1lu |,jƁ:ԇcm[ p1KLPÙ[AgtӡY9ӟ='ffOϮ>wvȹsK̨kqҰy\"Q?KœHF먟q6]2Z:ɞUzr?"#7y#^ZMG3m?J)9{jnaKm;LBT9mRZ}6fmvaOwIh̙JɄ9eiU i?PΕ zr wʎ-/~g'>DFn5c1-cKAH 4J$<ШS\ͅwڮԩRk':smw̺c8w [nfq&awB< vCV薭ב{S!h…f~.7Vfkyh&A\4FE%$"RGӆQ%eW-Ci2Ne>pZ}VtgҼN_'JQZ$: cҫ&L"LKMP>c?jFdCMB}r^Fn%!1mC H# sHALQ>kHZ1rm(O^㜮fp۲\/ѧ [0ja(ZP,wh祂3 ;LB^/h"ˀ;v UD@ ׹QН{#av"s;J&nAwN&GЄ Egf tch]7l(`IН%v}reV%igΏ 6hPUsLBTҹ{nRzlEȵ}?LPe]!VMH43B?%h8?-hZZӬThˁ4"IU$Q~˂&C- CeV6YU9nx g)WMY[ 0U}qATre6 ,~AЄ!e n PM Z ċpe6\:tPEon9pu^8kNژ6M̘@nյ֤QhmJ/V,u Z%5錖lȻw( }1^-i&͘F@+9bfmbVyY2MK7|5 V{R4O 0$ up c :2 vf/)8[?XqHBo4ao4aHU]=XL8B"/hBE _,#weheb4G3sAhe7b%ZZ$dM2/GG˵rײ|;c~R+1&:kAsfJ%õͼVC<ĵ Zt1uVIjtحcU>t'u|r ʖ]ҋ;38Ry1?AAM3ɜGl hFA &͂NIVv"IxP)c҃d Cڤ>EGz+i  q=f.ӫD@bN5,w3iUvmL/L3|5n dmpLp-LW&Yn9P$9skr 8|lMyqhC9^/nEb1g- ;ⴣI+gSYXD}! 6*Mc#_+fC=˧|i{2d$O`j Yav+hL/FЄ!M5ޢc g㚔hUbHi[dG'63r]|4]5Ե PR&n{M ^A3n/Rj(Tg(N_)rq"Z;'uᾋQ~Se@ahEs~jfJ?l\¸7bC4*Cr߁!h 9)h|N\!7ydmfho)1V8ം셦yݶgO(";^%֤u|'߲ar|k#_6wO:cx٘)oy;:G 5%hBE]aȠiF>洊h`hV6 1!lFԮtU]RCR5 |9 Tj>Epuw AsTL7pv-~}AsA9b0%! (vgl[qv NOOWl$ X`:ULV]ݧ;Qu' ? *.= \tI xb<@MC/OЋ)4I~Sӆ7/hmVhriwX:]^ux3 {h 0ш )A)9&LbDxiA&.z1%&C% Cڜ IA/xj8G923r%HEԫMtý"~&zS Ѩup^ O?+h8 0tNU/^lOm3&2]sM)]&C~XЄ!u_2mb 5ͺx=0h۳w6Ѓ}D`A*Vd޹/NԿ \ 4aH:7?Lj12iÜ/jo</<6QVd1̷*ȍ/ӎz:.0+OBM C6qWP+ӃWt&U#J6e`46'<ZjS7-8[$|h6vh֝PGdz$_LIOLz cAOVP{#pĕTLENG~dFnrr9 JiRx_PF-U;gƍ@R`e5 c +!VCU-ʟA"ҹ?|tbiOwFcvtľLJj=]W#Qz+Aѝׁ@#1V׃^L1f;$`mZ*1/4x|یP9P)%ܧO5Evsw{A/!x m58b(W"d>[\Znt24PZ Ait\*>ZIb7Ƹ ڴU#Bh j02{ 9C^'uT>8d3#*{E=XZw_tG+_E`eb4#/+$jvnP$͹8A=ut< )isIIO"uXD5r*̈́I迋'&:۠Z/ T ~^1 @ `h]5{1ܧt gXDL0CcC(jhڧ7:)jD@(\֏RhA=BuE]Kyeo6]:ɩHa\'MD"ϩ:M3ɜDow5ޭK~qA]?!hrOÊ 3 s(kc31i⩰ S0/r=='tZ o+ T”#l4iyVr#o4c1>HÏ>o\IFhQ2 w|nT #~so-_[t^]r35h:)hG6\ݫ8b@iIjgkl}2r(L]с5d 4QP!i*WOf?BsiaC5FB%i^ )ƀ>u8B%3PT?N;k/6>"^:p>|;:ZNW^%#vCxjN:=ol9;40l7Mw7U,Z8PtV9LO&0.㖷(9&%BvKjD _Ub ^V}}FTc6J6,p -6VdlbЇF,7zˆ.#vL\h9唴p1V^墳<%\M,w1ؙ.#F#Z،5cxr#2ͱXvз'cwˆPdb#>ȈS,Zb9%-xUרb,OI,E] vKj6cu ~ ЍpZ^~zǔGhnq oA{݇BQ-' f~^.$5]{V"g"qkqv:Ύ>k6gM\WP[4lٝ!-ig ̀(ʖ{:`t6ul!mr+0$b?C\ #nX0I$v5 AJZ8pNQY:B&]#.l>$. AvzL* x]}%>M& B!P&{'|Q"gbkTut$ /;%5|Dsĵ ?j>ĥ(9$y(G㉨OGA&|KQH!H,>&'p s?&C{}kOvHk (]{(3Ɏkh-/d'bS?ٹX]#s,|>tx}Gb8^!.Et>\ 1حf;K![|o:q H, ([mRڀ:JZ8pNQY:B&]#.l>t`:C\T@}0tb #tb߇q>\08$aJ!qĞ8JL,Vuz*\4`gava3VףqqRPwG"ꇁ1P8M.!+u 籫-` A`>RZ46<_$cuI^5f/ׂ6r9}^Z墢0$:`x FuAǣM߭]GiJdB5*d7fR{Bd\+e5IyXmt(Ҍ9` NҘa Lm\/RZUt540ky5&,{&+[o&aTf7oxf@-w~W-I3G'~C뤟E=Ȇ')>PD𻠿Lb 'Fj1!֌3zB`e:/pޭkg&k\#u /h!w[ߵ -t[1k0o]*atQ}p7KҡS[ܙ,w\-c L0U?Ĥ陌YyXY֔U/p2Y2k&&-Nn r 64c_J`g~|LyۨL-?Ǿ> Ew|;OGdnxYnĈwe5Zx-LGwr8=ju5?=Zm^Ө9OCP"*ml4/a94a/P ="A(sK˰b\,Q)7em ?W.ol~wL&sJSb1"aJ/zQܡa:Ig,i#CC;Z?uSrΎS\ԃzYUCR'E v*g9߂q{^¢UdLQ/ԣ{ua0hMdS?hIqHf1$ȟϋGB>" U|9K#/Ůǡ/M_CoG1$wcwĿm{C2AV/cH'];_h #MTi24B콬{+4"QWu G!wzsMz8ĮtE[$[z $һٵS;}lތ؝>o,r/XUt$IogvG!@c =BBoIlfRG)ǀ1 e'[Ea E B5T⾦~-rT8Eb}"\z2+^IkPK&i6ڿ̒ZV[C몚%{/˻ZI `!15(OC¥J氭Cb\C\I"/W:-;컁A/o2C\\W}A \ ze帑:r))92k+ZmFj m:t.##;@KM8WrLn`P#;ܑ(+p#dlRW :upa]C>ȭdR#Fӱk=ڛ̘FcBm5fwjcऔrkJQgz]6eG|O@'A^E`V(oq7z;;Qۜth,Ơ#9@.Bh'Dp 3f3_dG'W :uN2#YzM]n˭d$S#FӑgH6QfTHAGO29/FBjj@+)j9Gȵ(?]մ0^F(d_] kj䘙 pAc>dV3f*阹WF.%iMWIIi09 5}&e!~+ %koكˌ:m14oz#Cgx 7EAv.4B:{r\n%Ñ1GQ(M9&7ގV @xsEh_h8gEg|_;2L6mkOڰZvzLcEl;x.8dsym{`]sJdyf~>QoX&;@uw~Iw~yebDp2Ej3W4.z9wIrm69OyZFv* F 3ڃ_o.Z{rqf(ppL=_@K1[࿂Њ\e:'q8ゟ~F A*RY^(H*JЩ6+ F]Q ` Ugx/nM~7 :%BSvkl9Lԛ WЄE_ 4ʹZ?.#1@Jd <SLcZ9wIQ95=:14&ȟ6".Ն31NY_J2dkR Kk CjKl;MH1qϐR:_ݹHЄq(G`{ C*ڤcf C3ǍK;jɪsn9=Emmt(MX ƀvbs% QK/讞9%}B6>] %@͈~At&B|aa:*hBEV>W7&:;E^68n7UX]BIH )inɛR΀q=ZS KM.4GEj3$Ղ%u`Y`t-tTlC#{12 q?Tf|>ƜS{Htw Usd70-"1[r%ɝf0'&̲;ixgJRqT@smk5Q ]J=4?~]]t} g0܊`,bF&ҮrAsLr ]t ZAƠEWW 0Vhs`=d:fO"yn4aHyy-; Sx>v/T Ob[S&:3Xˎm: 2= Ahhdz%fΤ8!J|/ =' vyЦih6dy á g/yo6 3 I?_:|~9)O vLB7 `_|7(3=ˁބ w> ֘0쑡a ? {k(Ӡ?Z"k}?[׀_-5mkNe֝w 뷀?x/Ҽh$5IV*-hBƺ[ 9fM8M6ZЄjL6EЄ1lUЩ+r& :dKdbQ.m&TdہG-a> 0[x j7UM+&8 TA><-h8L84a"]Ah&Y* Xe_+hynXЄy4aZS?<tJc;klit I?4<_MЄ, ?4aUԇMb/ɜM2|IAFcgf4JML'hyn_~U)u4a)?0 J& )GWگ&^C5/>,U !/()Bsp3Ay? ɛɝ_(#,dkε~n?z9wIgZ]D˵~u=Ȩ7l>EeS%qYeǵy(xq@N{ӠzKSmt # c{"/>"v6Š mx8{Έf41 tE5)([qd^ 132pMw&>vǔn:ПViAIx (?)`A0bRO_+QɄJTTgeV*#PIlAC%4TR,.P)Ru ">TRs"TD8xL.VVaRLVeډ Z"d'n-8[4aHCY^{d@I?'hBIint݊kppzzzY_Fu:P &Ow4FdOX5&ThWgvN_\#hBe&7oj۵& ir˚Y,VWkI-g|󆖳i.zd%n"[tKjd~Dkyqdhpm !Q;%5|Dm^,|~U1xY ayLVрàcm;1|kat7w޵0B>wˈSHZB:%-xUרB,OIHE] vKj戬6cu ~ J͵\%6qǕ7Khn~7+ )F}z҆-WP} * | p|bT%r&n+k@aZFnGky N}}ؙ.#Fh.|>Tx}TF|Kpfl!P$f`tVY'v[@o r $V00elb26 |#p-c}bel%r&W+i:FWGgyJ .b3]RGt0Gxk[;T-cK5m>ĥ*vہA' .Rl-^"ӻGA A_"c>R/FWs%q]L%y@_\@/HU>K%r&2QPzb兞Dlp';>k6sX]^ߑKbΙd30Ɨn0$V`/0Zq{DP"gbqkTqut$ࢉ/;%5|Ds %qxkGb/m>ĥ*vہ1D v{^"4eZ&dI78ZA%]'wWH1zjKTg1y0*={N"Izׂ6z5HY$SdDZ: 2H͠՝V'33ur\+e5E2mǭw脅x9kUQ:I' | S N\A?? t/Ht&I^|%Wƣ_Uuv:jЎFY-o;4$k3nSCKP+b PmJЩZe!A& Sˀ=NIEHuZ \Є!ur>[Ţ5_~ TT5 \xL Ny0*~c-򾏪mX+/%S⌯BmXմ0u8yC Wv1eZUGCiL:ꦮK,ޯWFZK01د#h:D{Mcί};Y4aQ' x;b _],%v%M`I\ ZНR)ui^AeN8$I 07^k05^lGp kbD#A Z*&!U5Cq(SR9p|(!1hBoKA/6k¶qq%:oG]ItLkZ.<ʴBq)rp?Խ,@˝mގ WKYmOɡX z2\Kg7KH>jqT,zh]sA}?<`r>BiĶO#=>Ti$K/0FH8|ާl(!V~R%S#v@HC%~[cNvtjľLJj%̩H^*R%WmHFeDBphގm>.b'v&1ku rSz˻~ŽB/!xC5k9jfq8pe"uӡY='6efOϮ>wvȹs^v5θvi=3쟃?\|a9c~v=rQGqfKFK'Cv=8$1d旷}(*@?`Ͷjnޜk]7jJ=*k*;u\l#RJr04G7fv-_9|5W/5>_##Ds'spDÉ:NQ 5^uRm=DuDM:hÞ:o2z~R$ذuN_aeYp5}Ýl?HKSQ&\ND[ɀFlj2Ïу? 6*w؁wRm90Eȵ'?}׀vTn}\Q7r==i'{gr֜Rpm3UeméE]vW)`:ֱ*2Υ6m.~ΰۇnn3:#A dt|qowDa[Gܲ1˝ 2mȯX(1s/d^.Z3h{ |-IwKzj^a2(1:V:@AZ تEK~g Oݮ*gZrI/DDb97A32ׂ1 |4)YBe _Lez "bA-Տv C]Q RJA~4`S}'up C{91'&T. $$SЄb!jMw :, QF1v4~#Qj$9WЄq& $#AA*I*$'MN& 5 O"POSatЗ iu }, R Po'h  >SAơO?+hYv!uA&+:p2ٚsmkV1sZ;BBT61)u5Ok)u=*NJޠ:'`W UEl^än As~H^)h " QpVb$ đ2H*,{ĭ*Q\J741Oc0_VA\§M6QIO~/As ؈-h+;B5T+z+zX`E2qG93Wů֔Y3|A|ƒf~{`R;wJH(pB/SÞ{1-t&ǁ~HV~n?;=ޥVIX]RnWM8mAI|@jSA?h]A+h׀~Mc-gAlcP͘uT@EqSM 0_\_C\qh~4gfv(.dX8rx83o?`؎.Wo}on\cqmc.=Tbce>hzqGVSm̀[eצv ]6Okz5] bqז2yk:-JLYn=2n{ՖiOZUSZgxL~ǒ\Kcf~+g-ZȜ})o;%Y޶!M+%|OЄqA 8ćĕT|-a%Ѳ38Ӈvw$v!.UȱG:8:܇q#R,Tr!17V7duR}BݵH!v?4`8U>GJ85#VAWv1Hl @b(|݁} I ~7Hb.Hc>sf ^!NN ~TXP^)vQ( wF/aB} mkf2E&cWtB{xJ]!qL,I{Ft|+\$[9%3ndx)"VFU.Vw{*iUhlaX{Fk[t Wً3&/{ Ӽ@]$'z̟}zG@?莘sIG}r?*#wm6=gbxV&FdkεEZD^N]Qy~\9O6V\/ʧS!o,P/344uzi&/KXc3ת`RY6;VK_{Mx1 @H#*AZ{J 5bD3-P1@%7EP\@zha?\EsI.D4&$ }]k5 n{H W1,M*A|CTZmX'vw BC]ENI;ZR:a9֪^uH+}pNEHItL-gn`3}q)rpݳ}}A \Z]ҿn$\ Z-י$FoQB# bJ6>Zk$XcvtoľLJjcGOY#iz1k1n$$Zt^co%d/zF6)}:A;̃'>#cvxľLJQx j$M/0FH8<8_=@uO}:wh6y"c(הkt4wshR&h{(^KG*Je{cMvi(ScgRk 0nPO̓SI1X]Hߎkoؘn/Ͻ:(yOPaT8gsЈo;搤d%>_|wE Zj?uȪ9=~oSnM>b\8qM3iV]@?+o=]G/UG2d>|w)ӡl5IxnЊTvM! xM&vp):ĸ҇ ] ZoNG"Kv!=>ĥ-x_PF}]op#*I@oPUm A:(Z$CVWtk;˸Jo esLn`nP[~FcM-H8vkw(k$`x ׈&ob)t)V6&)iZtU46J9VT-$L/0FoP\$s::ej&,#Օ^jA]QЏVZFlEqgX]L \_S2i&0o=ThpWBU˧tYLƐpл.ʃf9` 䂚wh:h]14WklQ-3_9 Gεxȶ ǀxEz_GK' ~ ZkosE-ܷ21{\L͹Vs%|+tE˵M.uHb-G˝zZƛ{04p\J3>sOhu1;=1tv׹ڨ=iqc=w<1gIyP;$ U6ut$y(Cw5b4kG3@Ɲ5;W(ϝ[RNPk5nRl9DȵТ?ϊ '2l`2i"+s ilZ-A 7w 0%(b7%TUCF5?Y˲hXǪP*!Nx,R)3<0'ji Fɾ򉳿cs|rqFdVC[=<#U=CC7洲gP誝vBЄ1XkA>m4xJ\unAwm9n}Tmێ2J]0& $4aHAWj֍5${peuY j$U@ u5G'@oR5HƐP]ca@6w`e=OZjz{$Tv3>)SYmgw )u= ,6~:|ѫOK׫E7[Kl:UR3&K6[J;+]YX d((woܵiY-gxd`FJgFq S3+r&Tl\{16͂NIql\)A4\ iqB]|A\4`3&}V{+ӸYp.sx&7 n4hҋW 0J#4J_-h[h]m+ *hBŎ}RtZjtfAOC;e19ByM0|GܴS$fwxo=0aРj%$tZaN'0{aZ5T39Xu뚬)3_x[&e?@|ƒ6L-8w9+ z4;w緓QIRG|KΑǁ~HV~n)ЧwD:|ƠD(O>fyޜ_ b |(3׀VbmkA6/Hs.Akfzan\%65i)\hWa!kbwmHě_4 Ax)O~ZXd ~ 32cb+A2I |W6KkowS׃~}`&YoXMQG-k%>LC{Y,ڦm͌5v^*O\ph5{ĸ͇6B1 .h:UR-k &KE%k1$O2R3"*̜%.!. yؿ -6Ny#?莘Iޏܵ~L*V&F+9Ij3W)%qJ|j(-6zqJ| -yXҽ Ot|m7@Q˶b8me 6,*s(Vӱ.l:LN޶!0ϖVԋ<"ϒ)^y?lOe}b|%6q^8xlmhh,xTۂ&;fWj|jYkEiSS?[75er Q 6ה7<a @vC¥*,.$Ji~<}+/%^zivnj]>/i >R/g3 ͼCQ}c8yvNj7 Qw`>Ͷ hO쬌 Ѻńiҩyc١a$߼lڼ1mf=*k@Z0=ybwMFɩ잏7.b3]RGtfҴkl1x2Gr V} ֦9aZqݝ#,O2bׅ3NI o5.:SEhpu>k9«X]_1/ǀA(i@kӜ@q-ڠ9>cB˙X\U\)"4h⺋wI 5fcAOnːq! =:Gv /Dз>R[Z=b5?=}}lK\5`oɉ.$F`c%'q>2bu+3[Y 5;Z uGlpwI 5Bw3Vَߒ-@uoɥa$BUeH@ߠ*[n%vAZ¤(7/U&@.TOp C˙Xp=Up) #4hwI 51fvĝ@\wJUj>ĥ* > Z}QУ׏Mfy`/-ݱ`EH\'|Q"gbkTut$ /;%5|Dsĸ ?_@u"RpƇםa9~n< y>C\E1}E%0%̝{W `Co.7;+#v S%r&2QBRzb兞Dlp>>k63X]g;N![ &R4I|H:bK!vyC?i&C.Olw1סL,Vuz*\4`gawa3VG;N!ǀ;K!'|8i \?1i'I;$c@#z`/-ݱ`vH\'|MQ"gbkTut$ /;%5|Dsĸ ?ivN1i"i)%dtNtJ78?\N%tKX |+=8*P?Fűt_$H/Do?ׂ6r9}^:uY>V׃4% 7G$HZlp}lKr= ޮN'׫HANvZ'Z([8|7oڸmi8YZ3lq]2 Uhz*ckLXLVVM è$o ZJ3mZduv@+Ж$ģw?ur5?2mMڒN3:I?sǾ-\C5gt>^}cT4eSѬt8oмU*YVuVΖʛq~gg<~s8=*j;b> =%#wbbe'+#beZDwz9wI-6˘zT'6g *h}͢ל6243;,5_,F0]}° .S0m#0X <4ȌYfθm4ǥQidN2 1g2 Iphlv{_!#Mьljd :)TL#b9wɍl!#4цM/Vub@3|p([T̼^?fޯc1629iNDc;|&N[lOZUb^ms#ƞ[b>8LÆ> T?i\* lН!FlH5]6NMĤ'Rg?nlkc&Kk(X0(kUi0HU,11<GeٶQNFƲA:#c7lPgoOL3qݱ4p 2SD߸-x~ﳤx~ P Z 1j{('̉)0\)ԩys|攩>\^эp2rn|8z"&&hS>*+ӠOǣ@> UƳg~V<ρ>ZrgZDWetK? ' /:`qDtUt ̃ hDedǛ.MzCA8=$> %ПG ?IH ,*Ӈ+aKJ< /@EW J Nn6𻠿R Vʺi5-J2/0u k1g:K^+T6^`.4aH]UәB+$/TWi>x?*/{K!RiuuZ'I+itR & k2SGR ݸ(r3gw9:|I.uX=+;a).r (&L:N@r#} :]p@ j_l"  PZdgpVAơMR-gR[P,Է]) egѵ3J0hceWTҘY>iӝ,F۴)Ck1:b4rkژ2윆#\dSZZݛN&tpR[9й# b:|nM;Iyq1h>ͤQot!'xhإx0x08:2}ԫ:ภc,"׊Rqy!*-ķH(lA*RX9=}'$Ћ/4az AV&ו~jA*Ry͂&C3EЄ!5~ MD2}V Ybp;o[y@RedlA[i~Lo^Xc2 w/ɵj_z cʬi& CJzh6CzBW;^je-Qbf3{*H$$]Hs0 4k!^9SB]1%z-z"/Ub[SfAl(((Cf}r&UuчwABG'M0=%>,ӎy&ǁ PN~n)AwޓQ mZ K,GY\"YzĿ,(KGw/_q/w-P,,W5ei6eF Y툷LC @ >ZJM,Ϳ-ZIuk4BuuV-xP`z*;,ϫ!V>Ya VTPE,j:f^S_%4( zK P%?z5lqv^1y"YG՝loMzfUK%ݞa_c";$PL2P.vJ iuʬj2cODfv>Z֟)3˵Us?WEEe1a &h-ܧ1| Mߺ b\tTR[w0_" (Րp ݢlx9dMron+p%k7yJ"Ά: ՜Krp .~A" s>=%e GeAKؚt rݩ <#hc0ق&TBKMR AO燊L .K4*O M =A&՝~AKV-RTKi 0|AU)jh}:JE.kJ"PB%+pizAK%)V*hq\zMh*%Z =WCEk RTx/:$ƕuLRʵhkNGb.Hl謹lԽ,7H [y+A*\Mbx^wd*`IzBpĶ#=uTm e$L/0m+ō6c P9%4a΍m-h°-KxTr;89rnMFk78'_ZǤ<ʷ귶-{D"%Y2;Thi1>`6ԅ_/##&T66?"360;ZFApl*h uζ6>}ʌNbg n5ح@Kv +P8QNd#Z>UE($J'SԏkxX6Ws M&v C/949@MJc Ї<+h°AMNb,ӂ&TJ^ |xN A͟yBNȓ1و >oH;śin=S˾d F`)brgslZGzMm[E6ֳZƵ&<47Þyk1,GwdAشgzzkCbiSEWP 6Jl !O*2PH*j9p%gOUm&;0w0o6aAơ];MR[2IG-x7 t?qA\3ǀO0flV{R _}R>P>R D\m,4p0d#r KwG>F`ObI\UWjmb!9*DǗI00_q+/w-Fbc6 l kmoljǰUa7Zv;@"!T"^I]qfhuJJ j;Y,ҋrlrXLTj:g*v͔i|} شSҝiƤڿi' J3Y۶ٸ\%wmHLM R ۸%mqH~6*LOU`](k/-(`U#*[T}/Mc(HZKs&Td-{/!_L 0<w SniW09?e}i fBĂ\QIe$#R?ˣ^y 1f!,)6˞5M@ю,5nHorO %j6{MFSq^5֎U}UImϞ9EnM]QyU2{jg7 07o47&hT&:v14Tn3r x)!Asy_(CEKYkB^ e+["hi̗حntT*}C#4\w Zmy2Ԗ7 A¥gn :$ƕuL:0ZgXItG-nnn:*޻wh_PFW 0j6,nx$UCmcp;ԝ[j 42ݴHE6G-ipva#BpaĶ #=uT^`焄#Yz17rvH@v.[w0jF6 Z.1=g#w\ 5m7<&و}O9r஍XXg<(Cb/sUf s[-W C#v 0vF Zh]hcvthľ$ ѡm7rXT2~LBsrn>Awܗ#4aRNn<&}O;$ 7rNXT~.!oxDsZ7b xT EI\[5s[S "uvCGuL лBqe,֊&}å*$Zr7'vWZӏRڑwe痧S21vFf[5R\>#WN:MºAR-Ļ@\Ù$eb81'C /XdPitL|[6ZJ?[omE6b\ ẍ[۰Ƴ|d^5S&r۔wA]Vq4``bIUq Ufq3d9Yݽ9ml"o8zEر*ݣԼ-maۺʅjST}b6&bCmю41hc4]8os[ ^?CU4 3h@ Mwj A|AlI> CcO PJo!A> ;-Wɧ4aH)zT٪m~qbئQ{B2z>crYWn3ԳcT/ވ|츆^C 3*jzsLj lm0pݤ|藩Mb$ȫ-U"n~ Я Gf7|(.X|Uֳ%X%Z?'ez^R2~4o?h CkSo4"Un#iVMҽN/ijhFA=øUCE3 ҷA¥gGb\YǤEU:-;S$b \ޑXR謹}~ H^ʎ7rHU@>?*iG$r-4IЄ!5<]Ҏl/&Ȉ}OG"dƸoA F& #jQgw$-w`GxP!&}O;CO$Yz1:ƒFCar}SƌV| Ho>&h¨="&I~-6iͨ|G\O0)7xHPn)v oPG uLj7лBqo,1lK"jS 3XקA=/7l:3`wǺEx/^e^۵Q P4aԃ ;4aH52_c\l؋U^]BeysMHez _"΂iO0hK hBUo4ay͂& | cH.hBE:ZqHWj˷E |FВO .~J*g ƘL> |e|rπ_4*OA%AW&C%_~CЄ!Ur8ń:o8HBK 8?H$;m tK ^$H^pI]\zY,IytEij Ee'>z G/e= 0x8z$zBOt.'ǽ&=ѩ]w1:|e!@?z$'Q@2`-5=SAQmVI/a G _LGҨcʝxB$JU"q=PM;oQ },x܋]B!6N 0j@MAw ^jD8 , CjM1jGvJ+M8M,&TdUMZW CVOȳktԲR!.a*jI Y\"(1Jy%F:&UbTqdQr4Y-16-?A^jU-ZF+C8$#W4:Imu4yLUSX*ezޙ*2 j,pghѵgy2 CA :uˮ$ot oIDx 7MJ%J~NAơKЄ!Uⶬ{ NiZ1l*foBl95vz2 mGr fIx;WCEc.p)Y*mköqemwsBItL-nĶ:*mw8xm;#v'čAm;cP}mT,kwi\[MLK-6 -{h->c 83b LЙ:*?=qw$L/0Ӄ7rk;TvvPd 0jF6tG7] x rm }sLn`Qyɓǃ~"Yz1<_q=e d7~{Em#W{'շ4"3Hy A&Ä}A&ճARI?%h8TCMR%_௸$AI:k(o[0S7L2:3%$l3bUٯ 4l:UXJPTۤ#,>"<Uoԟy0vU_R~ B[:$a(:@O!#B* Q?Z QOxh5P^w~ќ3LޟYu߲kNw2 ߵ}r͆dU*YeͱUd7O \ŅGђEK~TY Q#Mu?$v~QЄ!-KiSρ?YI Zn [Є!u)?ӏDS*`/X˚^ZXS$ǵuש[@(pJlW6Nap YaSex3hEs@d?t=6?c "zR2Qt$:=L}Is~AW`}yRTy8*h,~c& iaEHǁO 0 ، mzء捍\) cV9!*<֑hbIUyx\Yt' a'&6``UV_TG['' ammɡv C{Czy H'x|nA>;<~YX]qt;Ⱦ$#*7R/A6smD=!qLyyv2@}e!(L\`t)d̓O'Kx`E Cs9h\/qE ((ձ\a@#d֗d2Yetu*KcQ!>8ozg*SG۾ơq*ײ** V%\ϬC+h<5>M7rS:J|1iyJzʊchk(lCm66y}jgO6mq17\M/_wnۭݭ4ej624<[;bٶп*kM@紒T]V6, ^$IiOpql3τR$ s u2"_E~qhܘk\YwE i"ur2Z| @2-v91'A25>S?\4O@J/ (O_JQKn,_l)Sw{_L/4"%m 0{Z$5ȕbw@7)? Ui,a:ģ"+.[jvR{(=M(Io :-\y | C*OEQQm?4aIcgH7!RTxm:&]T$Z礒hٙZr!r!=uT^TލD숭Iq#yPTXT_Tgp[7 PZk!v;MRER]݂+Ɠ 昀'#=8#26ls%FI, sIZ3-#Yvp$ss96~scd7^!&{}n&W>=#=xm>eHU꽪zWU'ڻ{[t[F¬I-)~gAR*c PR3ՍI4aFح^tFSC\ثYo(6[lI{&l9,rsHlm4~e010)"Qk^sHS4n-P9R1@w;4al`;6@b l $+.6pgd#HҬt9JEkKkgIk&|Anxj($vۙV,G5ٌ[孂vި8*6M䉖r:.N}yCқ/ eO$n`)_YD鍑)I=-%> )qkOI`ح곧=8NAwC2d'Iz1M.;pߑ;Ilm~e5l'$j,V4C%_:}8ig$LYhw0MSWom(ͳ".# eo+%n`-_YGk{nP&aVS\%> :I5@kGkѠ k?pW&brn-P_1Ӎޅ.M'>ivY{ Her]aCwOH ulWzOL1պž#/9).U/ypU%thžuh/c 07w~xOЅÇ.>|wքoҡR>cV]~ȫm Ͼ*r ϴlo(pZ^)r OG4 65jQ6 %3ß>T[J]E8srivA=eXrwR  =R iv\:=cl/_^P"o5dQUKgPISD iB%7dzz(7\G-ˑMdTˑTbi`%tbKL/)V7&e *)d-"*@CZXR)yYPhJ0F/ձʻvL.XerS|;d8OLqbrs$;<^ki˜к1)#CFEuΣ3vQj25*o]dmNU]1NReyB MWM߰#aEA!Rzz_ЦW4$W)&"v_AH?~+6 .Z !h֍jQ i¿wƊJ/?ab#/@'`:-4KпLG#_qJ5H_7ڴPKҹxӄi`i˜:ĞyҦ34-s"ӝJZM#84a J,T*ZژdlR*z:|i6'c0 ==|=ӄm :|3ӄXY|7ӄi-0Mccob?t[;$̗_gZfJLw*z1;Ϙ&lI&LC5 cf fޯE2bUC|)NdWP2.9i6K~i^4aLba21H~XXk 73{m4+7T"hW8"%?4a{_b0&i i(A#!Km)}i2Mưߘ&2G]W?̴DMjI৘?4]jި %{o9%jHEI#_~i)h2-1F~opv՞i )ݐJ.Kp  6,cZSǥZWִIq[=Vv:5ƥaZkyymF<0m7C} s駀RRe0f\oV@悞pmSxiLjR2Αѡ z<LN0}\Ol=.~Hx1ӄ1|HtU`svH6r))Aw'mņ{π9g'0T>8|`_~_OXꝂ ճ[-yLt<#sX$?U-֖7{7YO;<[/d5M%B;Ed3j#ן5ֳE;Mߧ yZ֚hIJ </،:kmJ $ʕmL&m؈&ULw/#}ko`SmBmYD i44r5&;gV^ u0Jqt}N0MSjG-HLIC4a:3ݩv<5j9vc\H"> up*z)L1x!Bo0i´cEc!x~*n1x::N8jQ@vWdV@دbn}wY LAgA1c bم*iBml,حtFH;#w'ď0M!ֿ6:b l#+-Qt$jL&m%_R2z,q." 5i悅+q/^4aƍ] i¸-5 iv%2nM.VnpnciDbBU0384b6O +fɢS.}eє'O޼ߙ\~Vڰ9I&b i~nÝ yvC)IG\hoշQ9KѰ!7%V9}!4BjWE`"%sx0A9i,y saS2|YI[~y'm1*{t!qŢ9NE*;?Nɩz-2L)Zz\Ex+qy'TFd&YK eR)< %Kg-0ÁxK-q3v\pO nJ&Q1sLg"_ʣoD=ܵyx61+:r6Tm5"^-jx uʵpl'.M"K_ULh"WX@״oB w4W[ żh>Cy4ǍIH<1w{ IxyVlA0!f8yCp!eE] נ]hHc穈,u:k3^[欒zƖi.!:X@K[ G5(]O%LM({ZU.{6vE:q,"%l>c} ^Q 2-{a[p?4a;:OppROO6|7 1N2r* tfc2i+*slW0Mx,[CboU;6m kppC^ kyZ;\2a~H]ی5b iBݰJ\ iB͍d"`~5JcJ*ʩ0S˨$ch=/$uUm7p8@^7ÿ́;xJ? +rؓl#,5|˨|`Om˨:J\/[FUj:b#qIߴ[ 2bPlymsLT2 $0p#)eq`ײ:;k$ch-{)-bٶkRszE.~Hی5LkuPZR#\]VO*o`:sC:aNLC71x4[ tpә} VSV[ w{^\1@ <HBb?[ٖp_[ G 5p?ٞ;O"{dagJ {2mJ 1z[ ľ<$ p(V}+@\ǁmJ xl%WwkH*b4-gZZ8ŗOI-yZ vdY[J#F8Jl3[3io%m6n%{+!zSz ԶN[ M.NP-nΔäobZq#D]'{<1XY[B# 2SW211d5 D//J<tflD/DʹbM$VhL+EX@aQ0M>LԇZa*a84a<* rrՖId=p3EzUv|EcʵZmyYzȌ\֛h1iwDe=Lj ϽZ0Lg؊[:<oV$ӄhy cjfYL*V*Eӫg).x^un+OY]BP2zϳƖ(ygciO&LG?ivi6itO_1MS+4JooXr\Q񄠈oP[T')j!eSE}2}*t@5y#oz(i]$Fh~\o.%.pS lwMsXU~NdʩU_]PL*vfM}U_L *qv5V(ap%ԷRY}V[,=ߓx*~My؟V)F $3zAHw=+$Y*bϨEΦ͛>n1k w8SY[J#FXdgϪ?)/g/+BY¹2Mb&lGc\8tsCbW;p.m 紴pd7OIs<-\.pB? K}$Gm~}I1xgZFeC#~iB31ik ]")Y)F}͔/?GƕLfObLiuk6c} 5qZVjMu ]1u޾4-e p;әԗw0ݎ:Ƽު[@ ;0M n k<1h@(wp+NqQ6n xl  h-m-)ի$&;ؓ;~Hs5Y76n B !$Lj|`7uLy3m@ Cu0}aP?nt=4^uG$!T!8Z̬.IRmDo]}mEw*&;[t@hS4k.uɱ2E2}#'MȾ&9b0]۳ \*S]-U>oQZk=s}dS55O8TN#*lDk 2od^յF$EKV[ z?^tjI&D.eV*3&M*NY*sA6Cӵ"g1w3MPx%+dO@!CbZiW *-i9 m*` \4adb4׳={zZFf5 /J<tnlQZ84&EQ3Ega~5UrF5Vgi95"vP?#{{&l{5+Zb,uL‘0)ZW%>, s O‘p7fRpnN G5hmpĶF GW1Y L½(YgH5@̚[P jab1)7obZD3qni :#/}Lg=ɚ5\6`Dnp?i/ }#$Cr_EnDG]/oاM*k9W*& Krj~U9Y\U7rŸ^k@}F\\cg ߵL"f/D6DA~jlڃѥ2]{X(=?0MB(?2MSOe` \蔫f~@,Ei\ ~ܰ0y*dָq9kE X+UZi״Ix\^-~{Ji2s%y?ӄ)%.s coDWɒ4a[gK# PO3DmU!9Y01ŨGq,t3Mֱ\ʴ=i˜24ҵ tږu2%&2-1F^)dáiL۳/@v|^[w3χ`bҧ뷨,1UJGS2]~͇; y')7y'dy'[ʢd r=a«Nz"i \O J*ݙ>lV>WY'ǃ>^NJ:Y<ɩS@W'OrwLY&)27Z@hb~bmy:Ҧ8yP^g >H>): 8bi2|Bלk=i8Yfnr]on2cmpqYd6eu$ -عN}%ATf4[W3ݩB^yp'ӝ/V?9GN|AN0Mvq`ˀ8Cu;3qj۝chiiL8ȴ8_YGrkOTF¬cE.Ul'/`PZ'+X!{PLáĮc:`9E5d$0pӊuQ4dg Kl!#62b Ҟ-;1e5l c/J<d>1\tЦ3k)`Zm97Y#v4aL=kEt$ٕ;&lmtĶFKGWQۺ/#YVSt/Jl#g#St>KwrP_YJLec~/1yku=4%6&!'Ա]{> =5-㼿-B,\iiHuO>Pgh5Hs!,LחDi#J,"N- 2QmɁ43Sh0Bw lkM| I H@Є1M> c E{@on`·ni{H i=Wū.z#d07RKWHRvn M \m6z^-znҦj*3Rckr]ڮ4>d|QWH=$YVح:R788zm3Dlyhn# mdž=$*rkqzh.1L*>\Q}F͇7#mjI@:Rۥ;A;oM*]9d\*qeSv|le,X]@~7]п6rBhG՝|Ǡ#ςN*rq'Zhv7h%/E^DfEFB`ci$(NCihȻa9[刼iCjZe^[ebLߤ׍|G~G)M|"[qY7"g**cŦ+B\ 2 a:3q]Õ] 2$Wx63:t-VLn~`L1}{5]I,d,;jf8g3mcAױ]y,>U|Y->Y>[,]|#mE9*v(~*p ǔZ%161x\_Bsu\S:{\j Sq8,>Aud)[m ?qJ%?<ZfolLpP=tE]kZۓâLs8"ФJ3%A~!Ĭ!ow SsUPP!=7o}~mNՔF rp=ɇZ^{cڵ9Q!Ϸ}kchRщͨ,$#A?qv;1|1_[?Az5𓠕Ev, OCtL -Z/J:}OAT΢_'A Ϡ9 /%JuC/oZW\`}ǭe;nvN>ZZGj{ze켓NCTV}$4a [-;i?U.JbLLwħvX%{;BERHrxiho@8b/eDn/PHC*L&FB7Q ՜kM -6*Ѻ÷YoV$u }]3ZV~,f8/'T&1g6,޸==*~K0MO&[ $4&uLw*Ui˜9COF,azz&W]qHn* SԒ.L/Q!=#It b cJyYYoUa x{^!1Nc3| %-i9Z\&]&+=#'"aVS̈%D}qg$LgԌZ3՜]a0Qښ6$vk2MSeSG뀻&lm2+\blѶulۖܡdHsV2ьۗ։R<`әmzlX:p|g`9rF^g0iG.(-(4zN1M. `m7Fدv@Ҭh_)Gt$yLjE䰌Vu&L=Lg4Qp_eKl#6Z8b-rSg5p j&*Qyב/dPb\,K[\zl#vf-~cʦk#$2}M.-+ˆ ulWC%zգla=]mAw6-d)AX$|lXmDu@>&yTS8K D'&5[[z!EGXZqLZYme53ض_l7ke<_֖|Ѻ]dKcs@?'u@6wM59RxVG)g@yٙcPe)*^zcQ8?^t˝GW>u?x5cA&]-MOىI_{4;A~ g3JgaNgΚ~a0A7zQp,.s7]G9T^' -HϗQ{!_u^a3*S>{ aP彅ZlQ[OYΣTQ7 ey}Q7 )tڎc<Vv ӝW.1mXRA?hh'4!9^ʹZѤˀB#Z^Ly1ݹ/Q&73MSyK`&ntgL:}J|'w=oÇ|pݳ/ƞgVp-vh(sndL< |i¤ {Z cv\(鞠?ElWξӄbǹ_|? d@!LF{ Fڗ Hu@MGr#4&Ys-nUn뷫m_7H" uЧ' ]=UW rvQwlL pǯ(;/PS< >Mb^( 'Gy1*W'I#˳ž#a\,'*iO#e!-IW!L.Iԉ$,:PNjWZ8()H=@)/^f0P0+^w3a-6̷\@߁,gRM N):+Eԟ@, Y4nX4EԚm5Nᕮ~Y0D>8qIb 1xTENus-Ը("r")Yp&q1[(VtF|?ǫތWS_kG4 >"xEmb4MHI @|,EfӃƞL>ÙMyF3 rmNJ (6K0SJx7g-ShZ_Ut`kJqnDåGH ݕ܈v)襱;u#WkN ;I<tJmrS 9*kqzTթjH2N5fiT亸S5ß-}̤&/6RI ۀW*ֱpKY*I$ѧ$IYtV} ޮ-R"I-}M_}NM1IG?*z S[:DŖ,wYjZ4S=Cx<9^:$Ʃulw~@ɴL-.KnL.Ku|YgpOTF4a//'$9 xYp͹: 16QHK&ԦsNbwղ żN^4aL_%n`M_YGͦmi dY }&w,yyN&wܱ*$*c=bhvz5j$wht r]kO_x9۟VT,o6diV# 5hfGh-*Яh'!A^|7h;^ |#7/;چ$ȯNU]fT&?cAcGHP\"nEXFI6Kkףx`=]3iwp=RwX߂mly"/w5-T[Z=_C$“ Iڌȉ` ;l$i&L:V v+#6֣CpyTV$#AJ4Uy6n7g,% s^%m>8ô ڼh3۹fg2E{Z5Cf:l$gE79oXT'cٍV`26WM7zsc}[ 3J j_f0 )LT W('JBNz-*Z8z$v\=[KUǵ-(+׀V:Q]7ׂ6nnÒvիy͓!buzZ.. cβg(9kt-_ۏY7IAXu Ϻs֭MHnI`֝t4u'uYk+A@eg5) IjSN: &iDzHAǏR/G񋣗=PP!ΓT[4Oӡ^Ѕ5O8=1CÇ3=!jƩXeEk.q[:ۇş 4KBS ]6^=ϳ;7؋??C{&9QސU[{#FS7Φy!F!@g~HoS7}]]ex #M!Z5^ʠsCq]6;rȍzr-W-lfшaaJ{Bh,詪.413$ȭi[ܒ"%}9[j mjS]jzg?=ݘ2)E_}3ԭ˒Lܟ ¦+72,UK&<,KCr_"Ge|=Eus4`7 xbt4 /8D UjY.pYy\x{j &kL&lISI=Ln8/ZjR|(Bj(؞bGpJ2ZA։qbمnǵa_,Tmw2ی=.z;2I+A_%Hx/|mb&TAFLY{d.u+tZ5%[|?NnILzK>%=փA?x֗zl1tV-BE4mMYZŶO?ּY롊\HvJʎQq<Ϧ ktfBE\b}U5˾ePpny>M`yyמ:tiGzy׌Ĭf.m2wwna~V. 0M+b0Ւa]1x΂EAϲg4,wR:/;b 8Z{4N|;iw <h))3œu{ZźÓL/}60<; ?YC@SDK:M[EU7o}S:تҤJ].سvjq-~)\CHhŚHW֘%iRI%ؽ/KH5,Zӣ}\M>]t#ӠNG?t+E"M"+pMl?a\4aaϸ7)8p-CEgZ'~.s )=Yv!`\\gShH&D$+m3(  /ʫ.9I> Ⱥ{4hN_w1At()"#@R|W]G ".yG vXi(NfyFN3M.?\ۅ $i9MuHzCvm5$^a tf4?:V~Y~iz-E,6ulz?A[,'. K% bUKĿB']n39Y˕Wq,;\J#lY̯3n[t"XskHO^c['^oPieLyJ9}<[(۵E(u*>}Ԋ5qTi/6Ճ&MU1ekZLUk\49 e:6.nrSbEePTk!40MtL/f09ŐEX;$Ütf-בmM>,ӄ4Y?z=*[LQT}m5UqʗiL[eU.و ;*VO.TLϳx֎[SSb0?qƎ+@_tG^$Awޑ;ձY954IޫȎA߯OJ|_"> ؊^,d{P!t+.զ%8/B:$[q\^}d!? ?7 a46.?ulÿCO4|`]WkoľhF7?2R ԴRʘѼ _!baKhp54Z93Zn[e:t8"vg3MSs[p4g{bBZ;;e1A)Xt_tPLL˾)j$7&LK ݍ03Z Z3+aP-vdZma6%[1vM5z9ӫ~NA>mM5!Q#LKLN -q5KA;[&ԤJ*6sv%e0 %mc:/N2A^ftҦ'a,1))`L9zjc:SI] ӄii˜*.~*{C ; ӄwٲSQǁeZm 0?ӄ1oUH(p9T j ^~PW3o(JdtuɎe@+MyZ(eVM)O}z*J8_ӂzAJ$K@Oyf_5lFP}nc],|#l&A*b{bJfgCd0@Lg|udzzх.sm -4&ݞZP$GcZͩGWg0z/2zyzV$?bPN tcu{g0 = LTtS[Ar0 m)?{JD}S((TiOKEI'O45[H7B^нa)X-!\aԮ4=N-c:߲WOe0K_\'/"F)싾Ǝ@nd4`4,N,Mǩ]Ltm2ԐR5 RLѮ46K*wm&T<i„da0f^r ÂNH4Θ;2Z*p/>4a]wfy0/_4awӄ1;- C!3Ia.6e8O0,% ԓJ{-1R_3My @r:s/&L`('_1MFo௙&.|t*T0Rܽ;.dPS<841\1M:.3MS{"g{r/g0ȶjlOQ+$J<[j1`NO4p1Lk=彈?ysMh5{M2cZYӿ|*p=jУ jbwpӄ1{jvhA׳:iQoB 4 zcK$bDd꣠¡eE9ˍC"j1O&Ԥ&:v`vi4 c{7=qšW)QZ,jvm} F8hp-4V[@U+g: C70XJy7_MatXvaJ}_'ŴP.dY ΁O"ۋ`/x*q5Vvuz&uʻq*QrȹG Y"QIL٭% LggeR `uEU2ǘOG%9& c~9N+WGjjC b~6=x+ֵh>%=m6$%R?˴T2K<#ӄi4a5 Z;JgDnRQ7iBMٲ7z+2v6&Ψ)%et wRQ $x<ӄi`t椭:F,D5:U W“<1[ŕ{ݎolh_Z1.Z"թ)voN;mPhڕb2jTEop58U5$aћ8Egz^Ayk&̴`d0. Z uݹќ@oiBmtl_|ӄ1qRo040ӊH?&/;6  FƳªd7n.$$GLhY˝l#&L1xc%󍾧Xkl-ؚ5ag4 g:JGA\kڥU\`S#]Pq*ԻxQL+Pl/T_֌9k;o=.&1vE:/g0uCyLg 7v12 ہ`0iC_zLTa~6 ) w?4&6q@#ac7n o|;>ʹ|K 11xd(t7*]ؖ5f3ǗYMOq ^&#b$jhu-^N':~zXe r3:Kc6na3KcE6Lj_Ǩ8c$l+aZmʻٌ g32>400:^ih= |jj.nl ys.Ou[!Q6jeybNw&L?c-Ƃ<ۄjN;^q#r5SqE5Jw34.nU`7:'|RxSr  ǩZ(&ҟOwgMwv UWN@NoC;M.>͏ RșmOu~DL&ہ4a9LX:O}L+h`כSG|iEf YO Ӥh c\nƈdGƎL&v%ӄi{bC@Mj9ƍ_,bSK;Y_̊<Vuwuvi3a/ۤsE+@58?$1M!v_δD,!aP;#o4DQk0%Zor mF&yNW)gb>4::q$7%c'E;wHi5wi´ >:Ob5C~gwVLNY4}ӓqۤ+Ÿݦ;mlX4 "$;o](AQx;^vmc[L]|͍>o!y&Lگ;w3M_!E3E~e\A3M_!v%`i~Dž_ ˬ4ff2r|9N|>jODs"%3M&c-Y3Py>9l~qU}3DRW=U۵:s6Dh@$ djkj۲W2ݗ$|>E' HiL)q |i i{Z֘ks8I-2A6bzۘp ;#FFہePnv`hxlhhTHӄIb1V4'O1xhкٶVI,2]YY5=_кZs~w66N-eݜ%ZADXeZ-YݝY S,x}%7 ϋ2Mg!v&rl|2g2$ǘ&LбFn8~[ d[F[8I&Lڱǁ_d0mNkq&rOS"Ep_-S>ԠZ>b(SSK>*9Mx^g!aZmS"!v.QO?o+1ѨuS#9>Ŵ /!v_˴դ+{GhOfXdG6*ʹbf1Z9sh(aC.!)?&ӄIbෘ&Lo1x|(&7$-8+^+5ԊAUʌiV6'GޏY:!L`bw'?Lb"ཙ&0no F6F?L|i PHʧd0iB^ ӄi[rb:Ob\E59W:1|.#l )oNæΜ N8*LSt*mEf ^/{xoWP#Tvqr+6{D4k80;A cv͢\!oT*YS(^/:֜qdzU,{iTDV)!ϙ&L{]s֡_ m3vY<(}Z 9xDbp "(֔-„Nu7] BAFlRh/e0 r6ZN:'&L:#v_4aLu;L#1FrJ#w2uM<9>604~4'P_n|*6va@WdyR`_2jh`ؽ +ժsu Ÿ#NəG ])(ZFz8][>_q,ר] jN֏xoYlw8xZy-n5pyoElB;b+߸MuP0IZ2x9%QI3rC䡱f֡1)FգU&, *9GEDtjMub ;t.xUYz(9ƴ ^'$sR8[G󢛪р589ʔݐ6169 ,b>δrKA%0V"h۠ 뀯gZ-Pؽ  ,ɍ6 GH7ǴډÃ=J6!;#c$G4a{?/&L1xj8k9 }yfo* ѣK +!"5E`Jp>T pӄI{ bxӄ1xQ8)&cیY)eԝf9" g̤/ETk:~o/NzF -E_4»kpm *->pv/i!B5Hxwm2r JG]h‡ j[7#ٞi { S{cZl5uy> ӄI`3M{,FMn}$'_ePzo zv)j?H?i¤/b5?1M'\I[( _x1X7vvٓe7f}GauLڧD;iw-] x.})ʓjc1UT ŸȨ^rlteB`luc1M"vjӫN%L+NtˍHi[8-bLkRkύ F{,ʹƚ5X#H.+ot("IHElV+fk2M kg0uOiBM*:$1c$݃GVLx1V'%lمc)t^  6G$e0iN~i´]*|'m1Fh&~/ye{yJEg[ӭwJ)_E+ދVWII&LeZm /~idI(MhI8)emYϰWoˁx}Y4!#9Zqd,nEӕS5]pǏ6] Sچ[eZyZ \9gY>ʴZʇhcM_4a 8/F'9ƪF-#viԁO!~ y==L+xsùA)y ?2V$ZG j =:ObA@M1o''ޓGDf൓W6GS pOKKe"9k} yT1]S\؈F!| >"c"1~i[8&b8SLkh1O?4.t">1Mc"vӄL4F׵Ǣos0_ ӊԒ6 #&/iMk" Lw7Ƒ}c-84J54 ;Ks-/u}Y:)/y~.SbAڴ-*rxG<l+%m$%kTzD262>5dx z#NcؽVQ{<7N9A~HGo`ZbX34ܺchxx<1I*m/3Mw!vo~i´:j'm1.˃һЊd,nP4Y1AmN٪јnkXa1ÈrcT^ |M˥Ҋld`x|Tё -&HI0F^0F?]ve o:plC!W3rbܭ' hPٵ/EѮލUyL&'V4zF_|u&FZy."m>i}>d:cj!QoI3@i[b7 i هl|ѯH0L7>* #^{&Lڇ1$%idM_I[mP9PnCQ-Oڦ':aIh5vilyrՂhNe5E-*Ie˙VK8L+&y G2XU0vY%!v>ɴZ&eF79ؘ(z N5^ Ƈ?F#WxHt'9ݻc'9_Ա]'9C@Mfn7֬g&moE 7m-N*NٳLP_#yi#xy9l{^Ӑ0/i1-< ;|i 1=  !Jm44yLR< {)q5d>Y^(J[&Ԥ45LJ oXơ;%6۽={eppDD/Ϙ&Li´-?:Ob\~䀨Fryfא]Zx2ynJbdhN[["[8݄-*)Fމ&}4ϸf9tsT=o䌭9l=Q%+|k~i¤se0f0=yیD{r󵛌[= ?s 5ym`/}הy]Z@"CFyIEb]`؉}gu} d_,5fޙqj[ҬR?u-+ش[-p:e^}hߡ] |1ZB)n:\[NV{ 6A;V?wʹƲQSc$?4a"ydjCNDFG_`Pj.hnףDב댐_ie"gL~bu Ÿj? sU.T[d7#ۘB(}D% j]{_ yyY%V[1-pYcxNZ)SS!ŸqK:xiG@Sd>̴-\ aZC讆? |ӊ,Բ&9^|is\ { ӄ]FHeF !y^ |/j'ǛgO޽ ِ񑡾܆M mڴeU{w02r 7{}QnM~$57m'؊$Ki¤ h27)ӆfXaPrQ}> <|+j9bwmLm$aiBMiI447ˍ mk=%mgHwɴաh~ؽ-qU& g^%̍;JJ"τ7S ߑh S Y]jiއҌy1ʎoS5˾M~*`ERhWaԮ%6RnTfdSsͲg%pV~3O՗ rS.P{W[^bZX4E^ k Sw_o4x0{~F_4aL}/&J}]i&ԤMgI]7dCCkƎ&Lqlg0mA:Obn&M8r05<` SSalBI[)3(]ᔅ"_KNsCC#BL&Z/ ӶTI[ T Pk {d *\ QQL|Z:>Jg$nx?pn`eêdi i¤a0VǍ7(AkbX&:RyG6Kziы |i # }:6Q!,l']̙A7Cfַ1[g @C }G|hy.7[6܄p-ӧ7ARYX~ s$۷t SJS4O;n>fhpf$ǿ5WC%!_/aDτMoo!ohuٳKّ1#3|cgJ\ աV"i䀂د\L[h`"!L.9iZXv[ $әΜ-9qK3fdxI}K7Bw;d 7sf?.4xys|.8pN !r Nt;pß 4g@恳b`3dSRpC9z0Ë_iF ftdGOCz !@:E&dZ3Z/IzDoaDeGG7 n~@pLoe7fGB"&D H!IN"B H(D:+IN jNVv _"s@יyl,NVvn%<:N$Ut& f [$ <4a/`0uB_4&tynE/EV+ '6сH_˴bga?FB}3LG0uo0Mi'PI[ j0o![;;+mJυ'eu.|r3~,!urz3g 0G(Sy0M.lϫ*Tg߂Vzv..+'7Iwi[x,bV3ctE ӊz!y ӄI{,bm_0Mcm(o$_iE em +#QH&LUۓV˓GSI-'{}=i?g"p$0qw&^fxdhlpxdt(׺Q BBU;[bVט0l؉6NanN=UhOvDFRsL֎Fޑ8C?w1h(iTmuk*c R O?ôZih==6bz(YV\hg:r26q&rrONU.O䂝

?}x?PVpH@SVn ܼ!~nL%6],3(2jYnRj_T|9YU,SuOUĕ6PPaӡ {*z֡T<|HΣp s}];|Ç{ƄoS`l}߼w[{f0{7N<C颷WLH\uRL>bCMʊ޺'"NS֜+X]'<:MZd8K]r,u[#'饆Ow=cRVlʫ4Z~?~hb6`B!arՉ2ՒwI>"vsV?u0McuTbAZj YXde=⿦[0 ֬޲eQNJodQ3ڈ9:FMy؍XJ70WnqP^EQ_d@M{1M x Km %j&` 65" x&~G<,yN?-Y[J ec,O/;KY>h燜.gm>ytWLxEL=_v×A%:8,XETo,b eݪ#"@|32aGCM &~\2IO: CS䖣qƲ&Шz(ҌeHb17>ӊbK}*$&6F0$iӒcH!yzCa Ico#}TdW0N-еV*BƎđ$2x-ր|vG!ȣHWa@>hQ Gb@>u@QF`GW#1X#p[2ղ *jR6| ;w| cL5:bg0vX8zEiVAKL).1MF8c0fx),ƔˋDa656sD*b^hV^Af;bvGˆvR#[ojagVz? l~%!Lz8QmtH8%vLk-)ψy :@C_ f~p"ӓx'&zۮa~>oeRj>JmZenCIq+fhd~: < ܄ZC,oC_}x־ZEg4E"GE~MM~녂 Bы,{ٯ8^1)5oy OhnF/RoK^>Ku y"FBQoocwQ<^P!rmEOy[Ye/;seZ~cƜ"}w}؆,Y7&)e}5ϘBa>j)c{ʎϯuLތ"/7Nz!תͼyǖnPWuZ:o:3)7ܟڔE6-{+#\ "4* )Ck5\r :xޏviwBwjm>]3ŪϪr 󪓞寓6i]K˝R֩Qͻ&Z:Ko9iCnaLOiz3NދW#܇W׆a>>àw0 /NٲYzg,!.a/-Q{ޞbu{{zE 'm?.l?9k|^I>4HzeL5> qel4o bz5kV7z[y?w ܌wܞp ǴhI!WĴ8=OL';BVgqhR/{P+?w$ xw _t3z}gڒjŁ|7Vdב2;LZ;L0# 'Y v&]Gx;+|лhގ,'! 2H SSZG߭5ƦC't8M@MEE*Mڦer:ԦtRt۸O z)˪Eg,`W3RH|iA/ڻYa;>9>mkM˅Wlzrg8`[g8w YCz1H?? 6Ĕ讳+5O'%B4odnlX?2o E" uS:##on7j_ʭRx[{7'8*Y/jh8&$?G c k>?k^~kr~U!nj _+^W<+O۾y$zkH8WhOk |MkkG9#°ocaM?Cܹ?ڜϳ:Mh9p%hi hM JJ!'&XInɌ%PF7t9c lW;2 WR ?=x4)L_gWPKTхβ\DTKh*`XZjBo T^|y弥PҔR(ci{Re[vmSq +RIn ģK'[t zXNB[2|/@:Y^v&UГfB( Nzkyvjts<#\ zu 9 <>;3x4f|{)2$ʮm[-O7˖ ^ JZml n%}-!ģeqšk+B'fL~ 1k"~h8NB~C6V>|N Ff̥/gD|u)S1(zZj!^Rm]|nvc3jErt^>aOLZ*T-{0٥ k]voٷ-y{ozڇ;e-*,2žSF wğ D ^A Y7[r4(+G-oo LUEˌߣ{UB^oOG~?Hwk#ރDʺ Y+r/߰ {v?vy`c|9omf.:88܄a=_nу+_#ox/{vckN(:f>⻺H Iadwnεye=\Glxy)-uhWX D$_ ⚰hM=q`qM"҂=v6 ag(s8-Gx399X報eBrVFmGlL+oՠ溍ZAR3gVu'2E!uTyͻzUWH׼"k%t*tJM.-c4Я_W'15(vs,7l}]Lb\ ߆|JҒbġCx JK"r0Omː_L}8)x! K{AnL/}~,E촧aEO uT=bhhqGIsb7Z%#jާ7HKOG0dˮm u'>YFXQ,QrhƜ?UmCBdLCa0=x>h:~c~NsJI zFb8!tF)Ng`ўtZG<ÅhMT=sٞ 33q=` ľ3x✕ElE76)kΣWAnJ+2jq@AȞ )e }GHK3 6[= v@YBG۾Uj 8 z8}#GGB'}rwgz&1+@-<5 CX7JkɂT8^V7:e9Sh˓mFҐ@;7!yKCUDM=3bJہw+>scD6y>lUU~IG-a){.h7y*.O v1픉B<;s?KL.kɺ'>I?@/:v,҉ebycns8 p͔|εgZ,Ԓ쉿L&Gjx'R}ָʚ2*>.b,uZs۠vQD$vb.:GhESA<-[+'s25 _KNQcIc p%ӄihvӄ15RYp2t;ݿ]*#Tr.`HE+0ݡx7ٞ9#IzL&Qwm`(1xpϖ\B<l)WK"p'+Ye tf)f}aF z6Kdv$-!bw=Vз6'K2p^R=j3$нA߯QcKKv~ _ ű;)(Pm<dnuTnؿ6xw[񘒘Z' uWe`D/U-REt/8kV!8by.h7AjkMx~>M$ P\W#7sl1wBؤH6G2#qVOtK~qA&f֖V0uj%vz+}j&lE+nAUOV ⍓tXqr!0q埖B 6-GɅtq.;&32g=E @KAo(a*3kZG1cA0O-*m^'(@Fꭩ);oHl ǁoMEijVu1 LU˱@ډr>>Bqƫ8e9PjIJЅ'YLCZڵAutEZu +23hzz2əeWgdx{eQttr(ɧ ˖K(YMiyE4יfp|6;jU>:pBI!}Q7".%֍: S*oEb5}GȞD{п2M݄-oӲ !Ş;;f* }Eط`['..(pPž{ANET9tXޛ07w~xOЅÇk]7n!H~&Л}lz&Jw{BP}LE@ghHID/vUȷM\[ӫnkvv)s]h OiVak{A_X)STӝGdfe[A88z^c4+>|G즁@y+8q,D^(|[INϪE>#wƖ̷F!R5kiNG>I_q#ӄ4Zvfvƞľ3bCQ!UNqjfՊZ4=#8cnvJT_dwZAH)d|VښhA*:B1],8Zjʢ}]S]VZ>ѐUdxPOVcVA{gshS⦔'bgțƛxQCizyA? ((D0~YvfMQYY&16dt6w>뙊+'Ofvrنk{gg=T)1C^7n-\_0}Ily:%gϞ[ٛ([Fޜ?)BVoN槣'Nj^zmK96wzFYMSA].ԯ+YSHƬ]Whd9}]Ot^) sUfPff`}@ssU2 Ղ%-B:Y[[KNJ藄p {bV%v !gl6^(^Lq_[Oy' zkzʕrtNb ӊFp " ee)鵬d)opt-4.CQO#-6񍮾 i_ ?/gKEWvAx(B2)tcVw;@=]iuZlN"P+.HBJR)tk 5Zޑt#QA9IJd!`>/Aĸm(V%Ď.dhꢳl qۮ)'4mzb n#/G[8b#tSWfbTjFߚsfn"n:"+؟B$ {' ^@ŽSN56~ͧͮU.X]voٷ-y{ozZ;e-*,2žSF wğ ݞY7[r$"n#~з Ţveƍ=*eɧ|-~?_tRl}ڵM"^eĄLqwoش.5Qaz!'p ON}k '¬'z74|>jX2꾛;AڍG$9qOvЕ~adwanεE-\mN<˖4W,67l5k.KAMU 5EU4ĉ}N4u ܑ9"64LpGq{eC )zDyZ8zV$%2YZDgV-4lw[06ɦm{=˦5⤄dD ])3e\!ss==#JYoߘLT_?m*y-}??PK)O|*U6.r7$ n9 ֬U<vUQU'd]MQRF=>SD649'1>h ={sw(?]G{[r99-k7#l Tџ/:oDyZ^i +!6a9 N20v3p -[36  6AZ,[U=1ntԾƏ;!(8B<1[E)z`س。X!\ptTrb/edֲI*VޞB_Țz&oJ>&v];G!ē~d`dTR;S/Gݝs[wlMb PlMr/}iT[!U[kC_lMH^}hnu\u;[Egr)M]]-w,N\/C@Wbu9lRS%`~A[k0^5&I Q}~ylj^={-KECZ)n^*7Y%Hw?wSyiHb;`?t(x.A8H?Y=Zbӝj |NwHtS?$x;7&R^}h$(ͧ;r]d[?m9ݩV*INwo )Nwlt$8 7l$SϪ 0Y3!aLuC PS.`;#!ēt ,._+Hʐr:ѝiH1Z@EgZXycn> nKތS-h3,_'O^ , =4uUރD)++{b7 =GDg]g=JV4D캀>h?}D!ē] eH. `70tSi*.b41OTVIL6E*A߱˳Y^4:~kYKeFdyQЏ&oW~E 8Ǔ7Z ʲzcF?B<?KLhyjd;u{wRYfױӉSrg@ϴ4,3ha A(̾,! TB=Y|Y%SF/5ڷU-~ҷ|/B'}w6Y.ʂ Y7$')۽q\S"Yqi\kZhYcהQ-jE<=K$oҀrJ^ٳ'D)g{/<mA0)Iʞ%9R#s)ϣ~`ac?aKF9at9pFI4J?87D bhpdYaMwZ~8nT%rz?$-L FgzV!P8#zC\t"bCؗB'MCa>PX&'dl|(zNb9sODX>Fe_oE^P}1mJv(ǬNI W1.G¬%?`I1w^#PTϖC іoV hNZg/ iVmɏ0j bIQs~#hLw Z7pE&م%jiҒgCc F}bM*ri^0JdDW^Ƭm^daЇYQA?qX%v/KbZhxFu۸gC!ZbFK&Wh`YG;is@C熆.7;*62#*z͓V;`F=~D<|9hKE.%2AToGRb> :j ' |2dy:ЯKސ.A>}CJB< 2l< 3\% \7pUʦta t73Y˕K* |*p'Xuxa!yW&o69L w}GA6$"}L0oejj"fŞ'i؟U]~_%jN| qO>^'v~'רޅn$]]?w! !Ke T uWf:~LOP=mqP?,Cfޒjs3v~f(oqT8uy*A5hEh$dbY4b@+]ix8U9YgܕP?Yb:XX.+:;1M SAb]}Qb]*Lwďqn!1A?E- &]V)La0ZlĘJw?4a[B'bCEWGf0>YЖZ#l(~ SX-sKԗ/cXAu a0ohXψp=L&S۽L}u KLpZVfUzH E%\Y )z̓aY6_ NqC(vL:IqLoAT+f' ɏ 1.b!ē#DGWV}/Z 39A1d"b6}1[Hf\y sKG~qP1 `a4pG"=?ɏ0 5bI]uqc͋>.XX[X墚#Øi *h2k$(p3Qox"$*׺JgF161%^&Rs-ՇkI7Jkr]$n:Z6[|*mfi]d~H0kYfzIzؽbuZnE84%=1K+&s%̂tvAYcSۍ4Xzǁ?\a3oo@&[пF /fk`$[wmӄiľ~N`nGIn{Q29OF7_"1%M 1k W"/B9)^Zbg&h1]$3Fԑ#LZ6&matKtO#%{D=CЧ('vf ;^vJVM-Ѵ=k;8zJ^@t$J Xɤ^M׋B*(l:&zB*&pBAUA;yG캀mI8޹FG"uWdt_z6kjĴΪ ݌30!EQ{zЌINYMiG(CBO(doF9fof)0~􇴍E.=÷? q#!ēM#v]h6,xҷipx:Yy/&[7pe&2]3jAQabAQ\eO.X`VYy=x΂(-%/ JAOCR K+B)ٺۈ/Z4"s qKs1rtY֕_1B8ǵn~ցJ -ߒ|ؽVo=N+2|SPۀvmE8ӠͷMfl? @yh946y@FU%]A}CKLv4HnઌUG5Vq7͚`hx7o!A> 6ׁ~]ؽzs$oH7booOfW;}aңH #T[_p![ Z_6ŭTKBZZ4Bvo}s^R$x;۵i(բjy>p 1j8 z:ML$]m!ēGr=יHnC{޸Y(LbD%ǵilt%Oӡa{jeGM0mk'8UG_`qik}Ε,y9(drӕ2 ^/e=g0Mb[ԗ#L{<A d5e$?k4yb*-.lBF4f#E Z'piXsʶ8B1rOspg; tHm8B]WA <A0xxClC%|L Ck'>Qy-<-rgͱyIGVtzGeU[C=!"850?%RZi^g>TD$Yϊml&z03tG g2C2LƉL$yLwҗdy?#LjSN 2MS9 *.T0Eg\^p׾u@V80f,{6RzHeUOMm/`!:|ؒcW0ݩT4rV " ; Wt}B6sR9_vʆa7ʇRqdNh% [񾄳g߽T<|H?tj07w~xOЅÇ*~{ٽe۞Z?Qo&Jw{PzZs{ _HTmuuT&zOj[ٚH͹R/L\icZvv5)s]+h zvC޵QU4|n;\ j8|w+!߭"éEIa8rJSPM>t.,gr\b::qHN]J;u٩B;j 椈g<asų}"D1ЅmhbkR -٬@˖`(3FٷE(&k0.1T0J97)/ QxSռ-))/Aq<Uo;c0n+]4an2S?ED Sn v>8ѤX3O^ :ˁӄm6y S{Gx/:#E;Rױ:k/ Z*|Ek2yO 8 Uk@Tx-hLцt̔[B0<䥁;أo=1Qy=:szF gn*u5nLgVZXWdx1苓Zk㪪iLk5z«:d23*P="qFUF|)ewrbqJAGB#!cSa(yq1C#; /9˞Y,6IwZĻ[,=ӂ_ Ŭә,ܺJJd_6)ZacgѷݙKau 44R/`0<β(z^4V +ijn Ldz.bp\AQZ>a_SdIX^U3j`yKIjţ/\S%jQ^d9pӄ)%LE] IUS^w^EE#KazI xɹL/y+06P~vWPs4a1MSӇb;U!%Cf^(=珴 沦2~kiG:*Uy`)9!-d9j fP58JEE_c0י&WƎ: 7{gMJF(hkpΛY=sSbB<}~kӟdtxT${≩B@cePƫՙ9oLV}ŕ%&#+Y&oreȼ%:frkz,KA4{3Xg}hRĤO_uPP3Gh.P]IYF1e52SqtŨ:"tX2[PTxdd݂v"hh>nV]Q\Ø3Q] _>s-S{}G3N|\phӧpNK|:v䪹Y%O{**AXEʜ\dC;Hkg V!H{S+dddn{WYf T4i’-#3MtpDnLlI`iB] ?4\T)w+L c*~$ cP\bbzj&LC3/aZ1pzRdjJ$i GHA%Xy܏RJ ÒƴD,;D G{X6J鑷34 Sů~ WfhZn||>isP@N\hoobg(]|.hDOT#}ijkO!!wjG@#mx@ޢPy;Ɵag0{'_zF2Lm" 3V4+QI [<ɱRn\ j&ΉR0߯/}\k*0t"+VNE °ma ?"/;x,zT:K~$p/Q<א!7X9BkM()Jwh]'G^T+gر7ѵk=i pZH$otKxz&fyN : SP5#e7V*Oɡ`~ndZMS'Š 罬]D䐆wbnWׄroiE%nZkUD.ۂ$F_TFhJg5yuS[THK7_6 :ZwN|& 3'']K|#&'~( 9C?qG*"xomajiVFwTZ(jSށLs!' %Z^n%yND' QLRş QՠС`uvbJ6c)ȷ "Vh[ i4G-.A<"xQEedV녋 \z:aPUg>S?y5%k[~bZeqtqm5`, p*ak%Nwz$~{{=ۂu+/VXZRt,媇55|Ӟ.G^Ġ}': Ҽ \ޮFi^(Y2JFG={e4KPG4uXD(:| 9LwlJ{pn\׹\*UGK$,KHH,0;$f[Hr/U,%-;qd;-N{/v$/=N^Ͻ,fɹsg~v) ?Qβn㲁wr:iTD ӗmnUc.w}%T}jztwT]}@Ĩa%K]zc -N~ e|hU>ܡ͑"ɒ13ԅ-A-(V?Lv5Q-"0Njc픟ǘod3Zs֋NߕȘ#xowvwd ـ|ACq~_$Ws1~=e;)eOێ%g^>И&H$!RhaT@qdXA9&ظ9!![p%J-2 axS6YɻiH5={sL0"$Q"Tܭ;lv~qK ΐRF%tKԲ4c1qPz[GL1[3̱j%Ɓ$ԯhpM^{`k^*O]΄#pB6!%0 ]*8aD2ee_D2SrI`UD]u] xJjIh 7 .]y(tGDsKV'i6w NH(#F ͳhf UJfz%#&1{G' v&i~x𚥡I;3fGahu˝ YOEߺ$|)~{bѮ;Bn vO#8aD,  _ ?-8a.Ag'|E _~Kuss_\A˳^3% NR %'Lv~,O:mQQ&"#+'nRQxWNH/ːjD2ڥn~*z| }G7Z7.֨2|zSˌ9{z)k&u=S4F$cKvw7ғY1Zq (gH9oq/MSt6Qs81 L]%8" XߜRObݖQpK-—n 'J&!NM*SOɬ (v f n #Zٰ=A PF'LCn$1RmKGSͱv&T1ē*70_&'Cŧ}G2D/*$ٍD|+=iVi|Bg]M05#?&Dx=bNO\6\uuN޲u&4-LzѨQR@k[F7hm!E:fuΎ|]!%!wGG{fij;A=TC>ģG;iA\dWGC/aл*8oWOķBӦӎmOIO9P^ cxZؒ:;{!-X?pmpZʕfB.fcZgR;d5TFB>t]|Tܽx-L@O%_0<4$!ˁB}Yb@3W2>.lM[ n6 E4֢eR[?8?V>gS$~V}_W) (o#f$-FYhjyus=YVX+֧<𫘴cbZ8NFh2p)I4x5Nv}:$p}*p|M x\6vJoUW:{5௉eaj^6mrZbkײl2́ᐭ NBŽ$Ω!E`}֋ A9C VWGpT|ڇpˢSV$J/-,F V/W$`QKCu/Y5ԶY,FMƴ`JM`;Iwp+ax; \%avIFcۀYcחC;:$tԤݼ#t˺|.9yP[)ֲĿhڸoDn V.%U4;aUB߇AO,Zj KnDpzHnpMYQq=KUn 0*MK~_<+rs m=] _ۢum.B^]Nڗͯ<_q(\C<_˞uuЅ%Jքf)gZJkRv4 Cd J%.1jEv U'DGzi9Bg>r#c"̑IIjLCt›o^ R'?V`B;%}l;k9mm9f1gV#}Ϣlո6o/ z-Zpܮo 3Ϛ92S E #'ݵ7@<;lhi\\\NfLpŔ>eEmRZm+ y>2H誝EuO\JLL9C6j 吐p#x= 1M1k >_ wG-{c#L5G[)@n(˚ר:#÷mԄ7G}@kߌo(9 - ژooݑ42$aB%耉e{QggL  dRhz#0+l 6srClxS-'ThmY:N |W(C5}0yey:Jffݲǎؽ <.uҠFHF~GK 2Mʌ]G-f&[cUО}]7Bw?O@cp'Q';Ol89׳ N㎿O}Z!,iΥzT[T|ڇx$9[NR )3]bvp eJY2zʘf~Pr |e:y vUVTK+-kVϺŗy\Ր5ZZn35=xX,l48]ߺ>zASy>"l7u?_-+t h^b*pxg ǻNt[}sio`@.!xu_n\|\ϒ/i-ly! am/f=ny>rnup=Ž+W# 155FK^OR%So6.%iPT0xe#M12 w*Fڑ1:dC z"̃ cJ\ɷϡ?yQ>#D;šȿ‡x"mlϷ}!Y„hZ(N} G6j`a/ްC&=;p x+ў /靣wq6`:TΈ]9>aF gqr:ޢU4sA^|p{چ ڜzWªqt_ܽkT],b_v@?tgRИFz~s˸kg]g7jt߫w- dl9M+E 4]\%&$Uez땹x*o!%4!ejLuoT|އx(0gb (Kat=]dOh۸rdMPk' ~\5f I?.3nC8>,.u85lX/*7|Q=qʷ\⺁._!o'ƸHH\5~QiaL'*c?p\L+Z}.3*l]v}uљM1Z2u$ؑ(_~ = Qq_~lq67B_wCu [*}'VRacH{$dCjJiR\;X?Un p|Íbpg]:]_WDo4IF> eq'<;Ѱ-Cx*%ߧz Wo,e|TOwdv.JH\\:JtfҲVefI g1ymVԯ5v WwC6\1Jze*L<ŗOtw2 )T}'yOY X=e-cm,0YH >_h#Uް#WB J$ .p9sa,I? |, |,%I>^#ܔc{BB.ջ{4GR`Sgd^oWQ޽b >e7*p?~#[ל%nsj*4;6vF9ix?1uûvI?Tǁڋm≻u⺁_b $ߺh–9ƸJ$+Ϋ-2=C cξtDw'dfgi(_8fYtiFa# QBlF= 8#;;>-|ޚ㞷)y[>_lXleL|B`jd?V>Sz9LVq. hѴސ +c&vn^,K|`vyz) ;R_>'xJ O<%5|myL~iæ;]񼜷 4]j6ך< r3ԐC 'k)ڦYJ-$$&1 k]K0^0ޓ|/Zacy6%DFnTpYhCOw3ѽN8жb)ryD/.vtڟeT&WNK^y7;[ Y߻w%]TO ջ)ad=@~ߌCV`;Jw3" %^~~TD/Q.`ÌŜu*v^|^Q!}mk]uuJ|mID |猂{(!*0|һd/7j ,:F:y,e4np4{~h̺g={< Wܛ##aO̹Rehdʂ SM|uSIw+2 N1͜VԾԀV#x!{^ 7K](Y{6\1UgHK["x_DWOOTO?Y4rL X䭤Yip^;a՗`79K5{L+$Oho a{T!{T\7_%;>ē|}e1{$QPz qyN sJL幘S76lFӉN!;_r>G`RL@ſهKޱ!VOYZKB $E]Z7M*ETݦmc%~$21#] W#/@I2ڕ TP TCē|]W~kh=]S>< ttӀ152sAt:IF5ޗLS"WH?,RJ%a~IO*yQ~ SOO1~34*>ē|L _L[$WKYo7O[OpOe{u[2|5]CqFbz3kzDGj؞ qU Rq~5J. =_P y%6d覑 `N_~ۑuצ^9-ep$(*|E$F]/Lc|mb]ʛH.nQӼ\RVw*f I4 |%+ooGU''p{C c?{C= qi7$껁7T\7)eIA>y\H=<Ͷ9U (|4h'Qs?J6!$ pn*n?."[}7CHhn})9W8lxöT"Pq@LEOO-BN4+t$*߮Zzfe]-&aӱ\ 'Ov$׻ZћD;grL> x(fJ_H]:V(E ]Grԥ9*iv[*~m'y탫Ƹ^m_WOdžҬѥܯmS~4\|:WO̖Ǭܹ͐}\g+z5GWSuJ?s8cޔ߳~!g@Ԗ*gy$|CRa $G;Fm59X?_MO6oVOFTr01T qcccdL}4YH&/΍,GGPqǀ?/yA.+s$> .wFENO4PyvzR6R氩WOM |5o*OMŠh1,XzPWvE*C}itºq wAa;PO00}U{|ܬZ b:7w!>8br4''|'y'd4 :&u`m0\ձ6ԇk66 Ivj<0tUsdJ_Odwz/V#\q.1*˝đ0SgGVgOQ/!# | # I>Bm1ƴ R$U0zڅV{e&Z: -}3;t*$o[`[b%wVBe3/1}}=̞w ,^JߨuY 9qi;ߡ}ĩǁ}eq$y?QqgM>Q!VacS[H=@cHFKVk~ۓZ7eC̘N+X | eL*6;"J@F= |";N H#I u訸n7|C<m99nO Sm*l݀?d;杂TYc4?C<;v8Xc1s|th A_\slȄg9v8Ѣ9$;;bu%dgOh;hsE ${KɻJI=nKܨ=SqzGJ k7K 5p-~vJx-,C_ρgyn ] GܻOͳ2p$y JSRA*7 |Mn!Wlx^ |)uW7οo^< |)u`^6S#/YV5cF=[^OTz:i2’1e,_~\j.Q|RD^u.]f4'2f̻}QLV3Kҍ9lh4408:}u;I m%qU%vYϗz%4 )8aOG'EZ d#8aʹ Ivx) B-8aVq+ #ZŪY*JIK^)Pi67jxbt˥gFruQΌf fY7x^{h(@w{=ǎTb8%xj*l%Z?x|a|n3Ji2g\X =)FLF3B٠sc)WRGGcT/d?7wpO""%8h;͋QLqӂ&Ѷ #罍&-S;U>2fbb~иqA}s1i:? rȶV4\<#0<-EvMg<gۡ6'.4jPЪ+lCP)56Rohâl̘5|^~r'6H!sOU0j-XLRh(1+>vYRpB9hk'L ^.8aD/y˔N}4_՚ΜC瓼W z{GQzb=lzmLо@ʔU) ⢍F,>bL'o}Yg5gWt,Լs?V?tќʋrs+:]|,0n7_(v)&nX(M ml'W!W:L2I N:)}FTFG~C*҉FG<%u]x< <%xTd<}'Gh;%w'Tnw8H ; 0^pˆ~#0^:-c={!%)۔+y. s!2pcׂK2_֣V}Vܜ`mQ DRv l{D|NOiVtD;+v3zZ2r➊\%kB;mJzÊ*ԝIYS)Srv!HTxĘJX_j p X_* \#8aD뻓ZGk/,3AMG|Ze )nRJfFD* 0)r 8i5C U|Tp¨|uO{~_ld2F~ %Tj?#8"^Gs_0 ~5 6YM_0f}>~ )'`+ .) vQ4Z}"/׮L73. Kt1WҬc[4n6K%6u15c0HSJ{ӦIoUG5)nY=GmHJ1'g1wظBuEuJ%gm!~;K8>%](<*== |+OHz~OW}^O fN^W&RR\ީ~]>RYWg^ty=JMOe绁S>JFp5SǓ,p JN%B4r9wJ=GTcߖRZ5Kb_uP} }F'YS /<-9{1UjۋZ"Y09*BՂFTQގ+`VT6A~:Id2< g2.{!1O;@ H^jk f*Hvd#֘6݁^. -\ ֕Qq=@u.'˱fQzEb'Na;nTl7v'\Cvݤ[;ARyùܝp3.׾ jXuE.~UݎDuObǻPW3-&Zt(nX91 -]epnY{{-><>_Dʪ"am2 T\VŞe ^|IezB*1SOE- 4gSw QMThz\%`1ʝ=)??DKRu"~e/u:R}p1{h5L} m32  =~Wep*h lsFq[/~Jw/+ɡpu ԯ,8&wqq࿂GR ke N],8aD3leS?> %ຝl4eF,Q߆GLgO)DW>?Ih N@ɝ9 N$ӂ_>2 ncǶ݋ OO*N-^~d\ Z$z maB~y8Eiq`9Aq:W&(%,zwٙ8'x#ÈS+&H⍬-L,&$ʻO  =sCW |iDȇ? h'HdtSNB'~t]|/$OslD9WF^~ t\P2$syA 7D5V!tl/ &exT u ^C ;y_o!x@XT;rFQ8K+DKCNEo2MZqT ͨC歮~[]"j;4)BlHcchUJ7HŘisRdG?D6tlNvY̚9mlַkd;i9mٿQa͆ƃ0vؔgџ:\H!7%5~8ƣPnlvdșԋL1[ ްPP B)̈گQ~0fVa^-ɪUs{~so[oKoS~s6tuF\YWohzre>N)2m^).Z!L[n G8qK5j;nUܑQB>;Ulַ9?D ݭ fEw"hmzT,dPcǔ2KӮwW˜Pza:bTh7 =~"$-FZc" '#iFB%eRYHkX7 3R,C=R#fѨ ~ʙ'BFdeH?d4~G?Y#22$ǀ2H,ː _~\j}$F>|_P#22$.>^#_~5",C2|+࿢L+2$oQͯ\j=$!*;w`m:c(0iۙxa x-!2^29٬HH|2g \C4/C{qKa 9& o% mtjҬҬpGwK:`px7={WX>MˇuҬk}P\sӺ$@8wGaq%t&H ) %i^蒾iÜt[I⩸k׈/JT+ sʨ>'˰Vmx.D܈3;E(CtUe#5$ MokSB>9ŀHM} Xkx]ֹzpwg2%]wd3ʔa;FI- .oͼqbS! 55ɚ!Të u`*"s̈́*s_%@R!Ί%Pu)~Lpd-/yb Ğo~\p8&'O8? W7ɁĨ )-(9%tI[Wmgϩ=e%@IBs5w ϘF-K w*,IO&8"--s^`~(M;],ic֊q=#ێB_p&M.{)eQ,;'L@q (/.9 ]pBEZ$?Yp'a ,|Dpˆ\G? 8aDAB:BuT3xy ^xZbvЅLK0>fթa=C\ \*nC]!K8 (VXޘ?Z_kHLyfnZy mCVec17?ݚ6 6ߣa<#6U|{|T/ c(0P-J[j)p [jp*4Z PƆ4Sp$460>v3#cd(pLDxYNU0RYe9E1mJc/ N1'h5ݤg =*RKn;?'LB#5rOf*Ezl̨B-{;%'|iu4>|Dpˆ>X8}JSbr ΍--sY}5?6+~oM-uwO-?%&2k.NؙH+ jF?Ih"8aD-t# \pPpw ".Op~%W#Cy"vhf: :.( auuo 1um!k@#lV2OE$&wGw5:\F%LA eR)!OE*a dx)4xeS')魈+0H{M!,Lv9mBm`?pB@u"(5x=mol=ZơK''!9|)G#>L}IO&~ S0+D4W%o5|5ɱ露Wc# 2wuh)eWn6(Ÿi%m6 41KWr LPu.0u^ֻp 5&@Mp~WːzV'[h(ΙqH]+Y]aX\} EIV*/AyD[)uil?*so NE #9Z9L> Y'Ih7@% oel()yDkK O-_1t%W._.#hS5y'ड़%0vD;Ǩ;\RE1oGb¢^=^Nsf}rbC'K)J&mq߂a3dhڅZ.=.H [i'lRؠKy fW t)ͬLټv \qto7k%4Z#&@)Ge=wEYϪk$%i TߝgC9wh%6ԑ_~\ V/Ixƭzϐ"Z9x$EKV/>oP&xU"DYJ~TlfA qD@OYqp-TZQd4w 5>'a>Hm&YƁ'O&GOuH%%`N%]4ldTR΂FVRx?|,q*W)"Z2y#I'QͫO?Y5hz#?FjndI?n 0#=b}Spm㰎@/-򅪒Qp56' V6rQ5Di2 f~J` Uu!:<(xJjSQh[I0[cuZw$) xZnhPŎxr>ۅI\k%rɖrL6jNm1yFٚ hl:b„Yv͵hfD)ЫՒٰv=eߪwC+xzo# #w6/ܳR+_ ?Z3]vώ%JUH$r;1`r&{rr%әmżvܵ 0VBJJњ`KVmk,q-~Cly3;+9b%>Y7Aӛ8sf^(z¹}n8E:ed"wɱr21(1R) pm\ bCIR˄ uTܽ@]ށ>?,;v; SH^b 9 NRG'H8-8",!3fH_+8aNpˆ7yD=DyѴn/=38%_rZWO4ZXԐ]t\w@Y ^gD>'×֐' w` za0;~AۈX>xM>%qGysRWD*v~X;U9h}JRpcS|?7E/{2t4ޘ)ԍM*/Lm<%uF4G~,C5kHFCZ٥uvnߠg]@$I?~6"+BvtǴU0:HٷҴ}M' }lx)mm|3[%ԙhXj]PrgúI |UE-_Y+SvZUL؆q.=Ýg"i&g?k$` W7uX+cO.u !vG6۴z20VmBf.unw-+?_%#4WiϣI6O[/1'o\d!KYfE P?7#4OO7zë)5<5PMc%rJJMNpj: |)5b:lMA|9AÐ1 %=`ߦT~氃ݩHZ)u;kwov}cH7.5rjwe`7Hbd}'"]j>l7 hV@(r]XP"χ `$CG?Qqu3$MSƬ7/E1`a-dēG ^X=j1gg6hif>zWI{-B6omX ="m5*^8e"`*|fƹ.sE5\qE}5L]|*`o6lׂzAߵ |Nh^Nz&flY.Y֩zgRs` 9݈^>OT ?$PCmG^SHi|*7j%83KgόkQͬ͞>Z9nY/2Ta];{ϱ#<[IJO,-t硁n}ޤ®@$)FmۣѠ t2ڗ:Z>RbS/z¥.FHLs;=]ཱ?y3Mpz #cqnl`jxԙGP p)uW֜<.~iM9˺NKеQL_mwcATd3StPUw?~ؔ +!_bg$X@}*c/#]<MD 3 s,ƔN+ [,r[bѬVjP1CoYZ~E`zxk)?1Ȝg6448600$5H_=+1Gz=^mA4Dise'q'|9^^ Ν~=I=oNȹӏby".n;x'O{Bc d7iq{0* o 8^b297 z+WJw hi sK 洡zy$_GY0:c`+B?+B oy $/,s|wD?U,yQ =I=\rvF9V8vy5Kݎaܥ^^;fhk*es> .Ay46J%q_HhkPf?zL,xVR+ a!`fQ,HeCQ 'DHfhJ|TNOP=U]Q7C/l-56E4{xZEY'2;c369 nm|nnY8%6bxw Tg.&iS?@.,ogz9@ MGm/j&iV/\nWvhK'6`T 02n{+MۀQk=7`O ۚ֋'%d슺S? ;a~0]CkZz(cͷ7ݺ1[rK5_YLD)G?@~1E%Iy)Ĭ}nRϤ7JO)Es|ܰ}& q<#:)A|\`* Y|Z xT+X]n tK/8auP26 voPzJfT@[7 NU w N*.xȆ  4@D7=${چ䵐{;L>إlLLj(*j6Jw PqkȊ ?WwȂ! ^|+c*qQf@6 nںopӶ)/zi(뵭Eˤp ?88|2ϴ I,PS=P;F MIZwQM{5/̒1ӎ[Y s91a҄v4έqJovO!yz7Xeg9G]#$<.wynM g*|#;P.9؂MaCŽ 2/i͛Ky;2h53$oօ|5pcZ*}K5j: IZw EQMr.颜vh=(U) vJE/NhUpJ0B2+kjPwA/jǭqwZ%!΀=5Ngg;КPg(Uzx<7&TˀMdu, ९o6)'z-i)v ʶ-[O:N~j`xK٪~*T[_JᜊQT Fgh7BKs0g"wlKB*>Cƀm>/Da nR"e:5e3qުNa˭KA$.p>5 x+5đ9mFmBQy줗`cW1@ ܊l&7Փ)6[^% $'o+ljzP8a|bkSBUKU`E/W>n vK#6_ r])2r؜$F`\*OxޗE\̃;d,jt#[/mb+p/dlb|_l6crYBPkGK o?&d$"x1cJBGSSX)4Vagy{8Sڹ6nZɀ'dswAR>|~ KwBa;e? 'ˮ4Ȓn0.;LNuu\Wc@o*zc^s> Q$Z~o06%J(/Sit'p].:Z[ο m3A 6S|ϩ[[(W}{w0{viϔ ݩHcbP6HŘisRd'?VȅѳwDQSFA=oH;=Rkr|e{o%aSW֛ o)r-.bo7UT CxEEFg33#}򃬡1%X75@w*F7ȄީU /Χ p4E߆oF oבQkzrJhY?.b.h«0Yoz⅖sp)QjLloA)K34fTs\+!o ec ~ۋ}&궅/B‹v4ɶl9WYlHt%iɤ+sÎ!J%~e{&n=`4w|yW_I2A?Gv D&TA[EYA |YdRؽw =SMo~ӆmǤzu9O\j.Wk>z$C,+Im bB"$D*RÇlՄk({x-A8>]h)&G "3U#;6tkW`ٳo*Gv=TcZQ!E~-fP&2@~`sn ?97۔b!o[~ "/lZ>dAɾyCDn֨-~BW!> (9akpsolXU4؋j# X qGzOc.1uHDꣶkDܾu ̿9 6|9d.ds庨 ! [(C5ȿF%LhinWo[`B;0(y,(ƔY0֘),sa%Zj+PBug+fnoبpD3!?q~4c|0fV.8 -EZloαoKoS~D}~u ?r}hvn|FbD]JG6%rEJ#CE=Enػ/O;9O0Ĭ${hcˉ[K"|>d' ;r=vyF/o3PV0z`V؈H4a[%J'+r%[;]&q'gniTcdNͭQoS-;t w\Cvı8ڈrOz?N#=qM{b!}M8>#hÞ2Dquv>iZ?=ݼB7û#V'OzN_GIt6FVoOVa=Ggp=Ȣfp{{qo'@R~D?G$V'7%jA?gW(C5}M 3RZՒY$.$ucj|m}|3pU 5*Ax@ EZAne>ogyH"#GFܡi#nڼiT۔ߒ=ǔ{V?VG%?oϨ Q𣑫mVchA y/d$̂g#;,/-JV0w 6 n1UBJC5sCm}܄CNX"T7a}[5 Kg}ʧ5 ȵ5pW6N,#ᶲ)H?꺻l5J,lV4ldF\*c CW?QBu6-KaapYx]D&| $o@ɵQj:{)C$wn\y*ƌΆņ6=I{Z^.NpTa{4V7p4m&)iF x)LvJ m4H+5k[wӽzAz'U g8^ 9,nG,߆mH6 ߂BX vCoXZ|ͻ]Ν|˶oBWi1DxUXzn:eSWO3ڸf۷fo篵0@b:V\{n9O5ڳѦZMSLQժakcVRtSA^ yQ:]p zИ?J3Ȍ*HMWI;\7+уJۥqobI:ֿ=IYhUhsAx3qsjohmPͿ꘧ 5I&:w .˕F#"FǢ<;u|Bh`k%,SFIcVpkԑCjjEx:VwRYTgmّP*~olVɺքSx`|΢k#JԋN")⸬~VZˡCK R^)Qz4-chP{V4)LZVBWc5Zi(y@Bx ^EryevkPBu %WEs|z=%DGWCȫ# X|ɹKx oHM.(3oj7hZu3bL<[85š8' ր.-:ejn/!csSlnvid$M.EeMmǨOd/d{ΖpfmAVJHoѢtD:eΌ0LifmKGSiwP]*Has 4"IꗅWNH)KFOӖ>^b Na:B|C{s>>B/-3uɘ#}b}?[E?_EGrUC֤kykmFrgjzfbY*n<44ip|us?3/~\DG>"6u?++pUX pEKzN\H3>󋛍{~pNlľ>,N,z}\<ǓV 7l%$c?b6iG￷zVm|QOka//h !l sz1q6j#oV,@q޳~<`iH֮!Z\ .zږhT/zv9wn~/IЇx{VC*d@x (ėvR B̄TH7НBı q{{zfю: 5*Sޖ_fo?9e.LvlvzwIh);_1JFGI}~L TZ>{v}}w婷-ZO0U)z# ^bf 9Ue(33;mV],b_v@?tgRИFz~s˸kg]g7jF14LƷ)xQѣsM/>doٳUء{ 0!HX3O,kIJђ~|iiI8.d75 I6ya(wR4*|˲R1x-|*hv). X@*Exvh6^u@kLUY lFC<ξ4>ćx"v\ѐH[hwskE l=678E$kUERq{{; !e7ɀbG}X!X趫 NǏ:]gRU z|'XmY7,Y 1CQy =.e^eF9n@LO 1Fs^$zWV ,߯^ nEò^Ҫ% ~z,LO I~@9Msh7T5xIe_Z/ lI8>OŕӑE#ʄ;Qcpm{%vp9|FUQ 3! I>RCē0\ecT%Ì*~钜n;q>GAӆ9c;m0J~y;4rxD4wx]8L"ZG~a z7ை?HQqW2 EſʇxR81 M;!$$.گVy|Mx}J2+HTc/zhb?kRQi9Uh570wQpُhO?C_"%yOF}5 XKH>~3ˤktxL/ЉS,MSR0*,[E֔ӀΡ; J4WsHTrzp(aɬ (NC߯> ptG|'Guup=GŏOb\#Wh(%;6!0ilz{؄ aBc* a& [cbH/ 'qp*: V*u- zđ 8 > o")y7O&f.V^J"\C&T?ii;Kz7[~XŹm|p/mC(!XP}@TV{Jo /y!~l}Cv?$!XP Lth`g`K9fT$oacjaF;a\7j}\8ͼ7s7yoI ~sM!ۗ(sb"CBʮ~[-6LKB5/~asV΃}3$5>ģ̏f@ \lZY}Zz!W!7O Ko+)So5Ѵ[e3cVV%~NFa~Y⺁d )IY WcRIHTkod܍ EeíٴGs0 Y|p|2~? Mp3y?OO~p=lz~@|| Oo>͒T^;%m!EM٫`7լ~7=#-WG'PzWjEeA-^&ʺRIRqKkDVkqɠ)V j{ts=kJӟ7/Rm$2B5ҦMX)V;.a NeFlpL>+c~#ǻhdX%ǀ2, 1 a^,&"kfF@_2,N(W[(Ȋْ5с`qQwI&}u߾p[/N\N6I]͡0`!ߐ^hΒO}h[*_3uDa[.aD#S8$(4S8TܷN2VKO>CcG  '؆>A&l8@uluYiJcm]W% n9i32*W)VyF'W.{]%5vQw=Q~}:2 }3Vy[Ϋ ]MF=S0&JJ πuh]y'~+zjФif}&Xu|ܠUhQbQZ}\LWK{OIm?w|&zX0H4OML=`fs|<0Bl ۡ/ uGѢ2mto!Io*[C5@κ}9'W-(;2KY't1F>'򡅬&vpچ |텍7$}o dFbmم5K#-u(7w Aŧ}-HDgK{'[Y18:F~ZHBAF$e+ͩ5+qfIkl@Õ95Ţj. Zbq* cTV1v:IfSO)|&:O'cp- zss0a%c(?q冲 Ĥt/11O ƲʋG^ | [࿥7¼#MWo#+(GGz9;lhO0ZoQTqgD|+N=Vi|Bg^{i&1tЗ_^:=5vspuWu_6# oQ81ʺY (w-p+x)m!E:fuΎ|]ݽ-ɭ{fij;A=TC>ģG;iA\Ʈ^*>hwITqvv#GV닸9ힼ=VX+R^KAڱƼLSBVl*&<~\]D8`^ 5ָ;a_ggFRq';cwLRg(Uzx< 1fž DVDzp6 m&D> 2\5Eˤfp ?mޒ7C6$;_BMX@o~+ɷ.T_0>C˷ݲNcޟ` Kŧ}| i%y'kdfjwaL6p7CO_Y>.M!C[Շr6Ī։cwiމ2}}eB朸z4@fBW={$iQHG5jdnEE/ʱe{&3qcڧ4n4 T?$tӆ9ٔ6nHBAɊ$of /!#ZoxIC:B_:=06q%<tRpi6ӽ9 7 mkw(!"/q;0yKqACJ][nH=44<Ej_s?}D@E$=Tv2oiK7H~'$3~RGy 1o}'[~+Y>. Y/ۆ(drU;#WN*4>F#Ur"kTqDwo _ŻP-Qpuk,KGBxKe$4ai9zŬ.A芐mKFOӖnjp%ur>!0Sc^TK+-kVϺŗy\Ր5ZZ~\?rlf[6 n߮o܏5~fD{aZY W8ʂqd%S~#K64-:ߋ^lu\/qE(or I+K-t_3؛ Z{C5~%/frz;h{zi= *4C%S.^ږhT/z&8n~!I냊_C, ,]֧ lH@WCC nQG '7*~H5whq(ޯ!o否iG-`5W'reec]V@yy^X^rU)s?3Kgό7f3bsO#Q)g>q{{zX٧ukT2-ި4Ys\\[9M2es[/+N(Svbj6|gn71WJ%{Y5yROh? Üf=+\lެa6╰ljN6fGz/;j3[)hLk#|?WZeܵ_|ͮ5LfVɁLG[J=ڻ1sLϞ=4c=vhcG0>š1}bY', &Ԕ=GBoN IiA;7en_*f\,Y*G] FruYjUi'H/]sneEC{-ukΘbxNѠv[NKvj1Jf&M4{HiEs;[5r^N#\h@5`]2:isYp'aY-K F8LHNn/K/`|SsX*sR!z,> 2Qš2aTBf% ʊ9X=>l~bqqs@3b1Ӟb=c|JsӔŦl(^a0Pҝ>ˁw߭lzda]{FA+ "{ccC^B#QV.n`aoOqS\=6W D}ȑ0Ԝc̡W"Sm]˘fqy+(=!>0CV.Nk5= p|:8>YIX!c| 6 :]}8p+EfV۶lB- %I_ M y}SXKD z&W7+^BR>e5F =Щq>fMa ﹯q*;RK >$oa5|ZWH7ݭ)Z\Ym{ݷ0Ǥ!Dy"ěX| E,nIgO7f{{.2"^_&> >?N0$4U_͆0#_Ը=mV߁/2I ?OeBKJ N6 b] NbR  NQ1 s$/Ök(+njL2%>#8aԱuؙ* gԍb&8a3 T=,1|?h=]sR9DS_;1evN7s6tq04al=fIxd@x T@ŗ|'yOxcE$d슺|*+L1۞0Ct|\P;} L._c'2;6|x _l=膿E[{z̺}0]Rd"9qʺ+h|Dz~p\#n@ŝNOFvZjfLR*32-=A)UɨU'X\42:m5; JMB?7)RnN7#=~YEJ I!FN:SRV1%k?B5pHC&c?)j/H@*R(6%8a]E*>@Ixp)1sfȨk>PP[44ө*ⰽUɚ6,?Z֌Y3w- <jy§J[}'yorI޲$^Gy."|nB\b6۫Q% ^}Hik_#O= |-k#{93zPIMd4^Od2z'𛟩6ք~Cɷ&T}'Racy$dR=?=Y3+1a9JSǨagR%Z>YDB^ԐVR4aj8 >c\ g < ~:yǠO0[cv' eBUCշYj5P`ׂ_R>ģ=u)K'W6!IoU!J'jEK>\;,k<Pax. m ~2gKY7X0+fVYpMZToo'Gp\/8)S/?%]gܨ9Nit<hfh,ʙugz>w*@y ܟBXJd95mOI&K29͕~:95 z3IԾԀj[i0;R'\bDXD#GE{%*T cu:~}^LNj،9lpV2fi Y+⋼wv;/ٛN[-jKeVkc%.a- 첦;iakY'ɬdpheqϳy/*Do@>5ӚtQ{Kw : %I_ 0\ C3]G -Sog&%w307*ݘM{mT2{i#+*!5磤'J& Iy> |\*A dQD}OIxyn/cds_U2#_udŽ"C;j(h/m']d-/[wy.V3o뻼A}()h6a'Oۨ@4AܛH/r:H,] [^U?9Dr >wM3ZU{$B$mD#R;?EMwdBJx-"uUbۖ|Z%kp|(HL]5vyؗ[|QĄbƪ}4`t]YY,c4W[gS[nӜm6lF)$./jtXWo| ݱ*NNM|ϻ%ޔ\h>Ƨ,[`_ѳ_'Y&YVpEet,{8_'8aҍS/½Cᄑz8mK`g.H=nxVЇxc=^PuQmb^2q^{>Gx=Kjĸڇx6 Еj FWhL4*V,]$5wAŭ~Cd}%ӭU sb{5gf'_|3et'z^qN`jo']R.xnGS;g@S7T6Xx]#xJj Eպ a G'Dž|]@B%:<ٛH"xNƁu򱬷C,0xKO9eβ!-#fXx~{tmݞ$V2tt/ZiδH,i]og&[ł>vfxICp]ۙn;2ڗY>ogolgVg߮e=ku'Piy5Z9 hSOrǢ-hwy#>[k~=kqm163qsf1W\t{yೂ/:#>I‡0!ڤ.Vj9&- j8>@K2-0L:M}5* jUb_*UN'53^رY, 'L|fQxWJ>Jxv&n@7DDIVKn ׇx6a<$WL a."D]T?(jr;07, -x瀊}I."m'h7 T5]D8i T8#w$%ε(`a2CtC  ]S8GPlQT4)X wzW&9ZurX1s軕eT4iAa:AcdN;gg'L=#{رNM? 'LKn.Ї{1DQmbގ n >GxԺv?$C'LB>+xJnǞDYT~Ep—@ϊ$[r3o NQ]ggY(x#BN>_>.8a}-°ꨦ +vpR/jzi²+-^ĄpLL3kw5Ww f5cjTF7|<Ŗ/=u^7(㬭x?6>L9r]oF#os࿀Kd{l~t/'Sߖ1Ý6cV S4l GW/!ʉH?-} * U>->_-#x})=%yhKm’ )6-eR/5ܖZ|&ߩVstKq}7L:׫_܏A܏4ng .}M}Uӥ_~Ip¤{<.(0񝇴ۍ;_<܁M-uɨliS(FPi⑌7Dg'5V.a>;rhp)kN^$UkenYKདtAM|et\:˼RJlGE3V.23Պ>KS^teN-3RW |"wd3֯ҫU +ު gw $Y?Չ&~?6wƒd=# i9>N]FpAp1 ̀go$o7toՌVKW L}aM\ \*e8S KJ͔>Iޔo)/0._̐o>y kTaG$oTQIwwjݮ^q+XߏZ& װ-:ejM~7>Gx\j!7?SwO& xM:]ff~K,&jg& aM|p\j/U8fL |S&Mo!MzxO&=ѸD~_ˏ:wGbaX&1W7=0b! ! VV瓭|2k$pYfoL޲>ēe5ղm~ܩH\Ji=xu{7dYmH+BV)b/Wg8W[Vb݂!6mP6maP5q #|6ē]Ͽh+'T?X4q(tWar5p| ~vKm >Ga*~ȇxc?C5[p^~Ȧ.6A.DHV\]!>Yt5K<$.hwQh׍+_lg ,1"ao~sy;(Q#`7 Ȇ}6^w ǀâQ۔qGJh79Ȟ>(r3$k]z;dzqV֚g}SŔ 4sPrs嵐;o"%G¤U&x[k\-pKa'$4wXFy:'G6LEm[$?PcVP<.u:+3ٜex[_ߖMR2+^ZLj@[loے3C$[_:$C6P (M/9ƅ$- :ijog O%xm5 #M~J+zi1÷$wYwEpfӔ67- HȣS_!Ÿ[hj'q=P^;_hv}#6"2 3i\lJ$gqK5>2wZw*/B6{C= |/{;POl.!χ?S7@T? ӊM[6mڲMc>|\8C5' )ݱM-["*y?CM>ē QMKD3f5voXCǪoF|-cm ֪zN:CV>TP5qN}lCkܝH3R{!õ2T ,Tw>b+CFhҾ;uFr jWPq/5ձO 6&|C4s]&fۖ''?50%o lUHw .5wU x檨!E`}Fmk1^\>#iˢ@?!oEb(TB}mNŶ1Ox1^~B j !R쩣⺁mr>Nwv pXtA&[%c+ہߖ oVk SVlU$8 >b\,'XHeR[< ~61/ydn14)B)y ^p fk]q"> 8ǓgD2>'?Vo &4H6fXi̛6$O\^c517|>.\m)@dI{rI-uɨczɱ:Է~ *>hàWZ[Q+Ym:4Nrx}jU4jwW&Cl<kr>p:;5=vEJsĭZt#c"̑I'?VȆ#aYm:P\If2n -""zfiSfC9w[x :uPje{FWq6K. " 2^2Th5"!%R#M= 07J<7#4oߜjCNꈋL7_k/F}4p>mw`]~}E6M # nh 0|pEW,9S,inS…WL^'.>!0Scjwɘ#}b}b9e*Y5/B>&\[k-Wg/ցCCǷ[7c YYXc/`S7C}xgPU*Q..-:4괾_.>{+foq I؊wQG￷zU6gN//h !լ92md#B/E,o(} Eg@<bgjuK.KޮN=I*W"X'3Z@W'6"cה$*BQPKkNRj‹/N@5PaäTC_Co]i>䙣YjQZ%UjBsG4s?3Kgό7fH2bsO#Q)g>q{{z%:y66*Sޖ_fo?9e.Lvlvz JS4J攝nZfnw>splwկoV*OިeG:QS.[ ޟa;2ҋڞ.6}oV۰ASJXU6Z5N`UW3#ؗgďz5ݙ4|+2/fٍQr &3@M-%ݘkz9&{gϞ `=vhcG:@X3O,kIJђ~|1"ޜ߬,h'X7K%ӌԶe; <@o$h". X@*ElPKMm} ~4ZV!RcG@B\^= [(yS]My_ P]뺱uhn_[UkumRoUBPTl?* Um[њO[![w~yWVNT|ڇx$@*m{\C<ߊD_iGDQ''Nnz|ؒg%dfA8H̅82m9kۜvY $+sTȶnuҵ)$Fw7h;QE:,n`|X I>vS\=@oZ}ZbEf^_Y ъ8Cē|ZH2peW`0m,ءY,~;m0DY ^e+] _$G?|Qqup=tSL:4yURV+ɨdh[U6QS.> bXUAu[ *qIŸF9; T=q\Ctj'ldLWulhNwL]ͯr!SMǗ!746Q'}'pDuOJ>Q%I>i”93 z+[ZUcz ,d8Z]Ί{y=Nl<7iJEjJTs#Ŭ> l#1;Qq~}:lD?C"_>Q ^aP;/Dx1LJ\Ur<{yuO/Xec%!,'s'X,vp/cFֿ.O8.YOX_YOXcoIHT xE3q!WUMrs:.pFO8>PI|m B;u0p:|d:uu`v67NxߠHmʿvn!!*0h/}n,^V\Z9nYO>oM{p|$9i7O:LF,2$.dJ\Iq~w4sj4frr*}99#x!Oc{^ 7K](Y{:z^kf̸Nٟ#mz+sEI'}GYO&`{)d}'~ | bZSg|'~/MEy# z+nmF6Zy̰LpJ+)epe#oU`5;70oƒ7u*$oԒq=Þ =kU1ycX E+{3Ҽ~ӊ}3@~{$AYxM6VZxWugKQqnOF}VK[viEP8DOCoB*GQu/|ĘĒDGK@܎%ǒѐ< ~VI{koBݔʩb_|xo_1O*!Z0`09!lK3$jK w`B~Wmx7ѽ/l!c \.PS*>I> cD>g z+gHƜSY"aY/|t7=i&[FǛ|ٔ]۪UXk{hm\tӖ'i;yK׼KC|cu'RߜF`J<)˅2ClJ2m ZY Yk'/P MPM4g3uºQO-\:TSoh$sO8M)%DF&.n,|Yt ;80y 8\uZX7F`jlc'?9A] teѯ{Ұ |3TrszWGʦSiF= |tp. '";--,4 z~+3$O?@*' [ŢiJ, _RzO!}m ǰ7XcL̾Ӥv"B |B"[Xwؓppa3XT`Mp¤TzO=2nCp¤{4o樸?Ff*Pg ~gK>ēr e_ŝeQcdC>Uf2,XOEH$$Lu NHǸI ' A.^$8a]*zO]n{Iw!K=w!¢9x`n+ꁍ^+2^.g>mw\K8DW7K 5Tܥ xKWh9XH,p eJ!%XЕpdtxmuTO+{5&Fܠu%oti;ef^FQvFr|Ƈxǀld}_;OM[F}n ]I2*OQCnشIlht6¤h n|C<Acg8Y2+W;Iʮ 5m*.pUX T51pF/ s*C<{~(VX>JV"!\pUWFKZVAԜ2l/}JBv/{XwO3?姮A`M6suSb~Fk\696buEŞVњ^Y7mĝ 5<iöxϡte ptǀmX:7mV^i1_]60b Nw`bQIf*~ޓ|`1J~wkPq?so !yĜmvZ;HՑbz[Tu[Bπ?wRq Tko[d_= +< 8e32uu4` dѿ46S ?SqC0|'I8%Cp0)!XP}>SK81o9x<2_0K%iJFx2Y̢F7*ċkqŽIw c14= \C=|/{#;scqXJiOKng KOt+%,)HH\ ZY@sTQ/pQ  Y[ 'bK0``oO ~Di5xk ew I=K}Mߌ=a.['Ku .=I>n1.l $P0zU^ȌYvѰ- ׾+'%e P%v얔zBzlBBy;BcNxς EAU]=b+;#xׇxmmzBEB}ZGOER*M}rZ#Q"z*xHnr:qH \j.\/; |\ 1 Sɝ$)Rxγ.K6TPw|'уr趁Omvace;+![peQACѤSbF_ -@M-Q56Fmvpc_a6FJƄQ)Jݣ;KkBbF"F68ôV#(0,& ^ôHXtDBX\뤰D¼$am&*u>wsD@Qڇm.7Oō¢9m.S9[]uXk$jo7N 6y{}GQ{FjiS0͝@NC.x.Ҥ6quC`׌V`~mR9t8\?,օî+p'*p$rBo/I`ldQds7F=V<{ d_R VU1(OMA #e-|׬60QRiB m7(v)LoWշm,%i/\z ,[xy0@W\bb.t.N('o Sp̗_D8"8aD݊iMnb]#Hڪ>6$.+xgv רhkmWHA \*@}kgV2AFqo%LɚЬblJXIߐNP ?@zDG| .O / L]!xJޢy<2z9^ ~u[lg9^+5BH<s3|솻^u"U( <#8aҭa uT*X HZ ޭkۭ6O4ǘbòRs;2O llE{BVԒ.)YGxJ8ip)W΀DV wxGX$Yf]~8`F?`}'rmJKWbKD7SԇxTy0 6|p-x*x9xQUszvEWn+&Aknt;Cfe*ݎ^ ~eNt;*"k&[w"* #u=Eb^ N3NNZZVo$i?>HxԸ:?^ .Mo"O(*.oRF:RF:RF˓;|$LwNDwis/gC up|s;:;w_<94Gwwt%!Tm9u&*-t™vƙv֙H 5u76̉I7 `< 9 W9mږ ,mJ/9 cj_CDW7UK{R4%jtbȃ0O"WL(YLJ"LUt\[%kKU+~ev:C"4oӚ/CB)D S<v9HNLn|/LZf>ua:)xJh>J[Ƒ_Yd\" ) L,BphHMVw( a]KT6!C 鹺 ٮ[+ pdd.IKKZyJ]2e;ߙ ]wY67~I-V׷p )5=|dS{)dUe:Hi{?d4?e[ -oOa_CI QqD_iöB(>$::zVab5QhW QWVfk k$e+%Gŭ^ }\:'W_L# Iݫ~8\̂gQ5E9)pp|@ZMtlO ; 7X>g I]Hs#Q($sxI>IPV)ߚe4xgҲVŝӒGM_[ {5PPdTMுZ2yYݒmofN2:-wc#Li\#|Pg;~HA>-B*,/4~[/,rrYh (mW-/ȻlL 42צP=ǔ.H^*(:N2 .]p7j˖M 8 >L7=B72ڐ@ɨ4q#&OSȅ7 7Y5Wʿ~࿜_ DVrƙ.^ m xYa_1ĢKNC.WؗIӵ Y5c1Ý66(37S Zo&B`^ aɰ'\Rx|҉ nΟH(}/k4s*Dj_jjbS/}xK':HֿbҚze֋eq5cƵvg'mj-c'9 ?J=fyPIN,&$~Cpˆ,W'ߤ=ҶhdHP%x߉b~43zTEizO|IR#*R"k|d4=, JZiX<]6zdMMz^/ח>pT ǣp3y5FB5k9Bɘ0*Ű@¬^ .( ׀_YG˛Fyр9pm725$0p d =+X # 0M4t1u1;mޅB-CyES^U1q,K9Q ݟqg8.^MI(Qbȁ4Hxx 䞙LhZ$qK+$lXrٍMl'v9v&vvm$_&L=SyiLU[ooj xvlE"~{R bm_cC̱J9oXX?= 9WEO* +m'* \/Pwl< `l:R[(#]D\%EI} +$9aLF7FP:feq:朰%8 <9"u,1-r/'I*gm2Cᆄ&l<8'L_]Kt[$% cғP4 d=I8HO=8AT:@FԴZɈ!mcGuSpUŸt`v)@f':r!?ºq8ljt: ; u]T{ e=Jmj겼{_7qNS}7=Gi() *R<`0.9'ۛMu ݖ.4F0 ,15rw  n=)ք&h19a"kA'pk[[Sp# $;g U{*;9ZA+8'sT)j4-pbY6E Dw&SfqNjLzrsۉNs˜ʽ\Ҙݐ ޯv0:{#oq ~<11:Joqh.hF>2ĺDҁer:yXNN3i&eB$YgMs-͛o2ľ OT:y+:vȌIH_QlB} 9pu3σ>n^[뚅Ú֘Ttg욷oAm^6hg;F`)צ% {8oQfKy, c s~ c]8<_[) xe: Ry I#[y{ 2s@8yG)[xhp.V;Fcƴ-ڴR}jp 6"|sBE[l},ְuwHdg?yap$;/ppW"0 ~8]%~s˜*Fr0PЇ\rSaw,_[^URgr֙yKq`we]#9"t@  &$%mrNS5k m$πsW˰s4?_ Ө ϜKno?}0eO4jz s-x-S(9*tbsT w u494cu3N`| h̬զc^&?9a |sIU81GHytL0 +_~N߼Q?xwu6ijԐ.w~ 9'T]~ qNwJI͍팾+ː8aL" ѹf_<7FoV=]"Ix;;E$͜)kzRQ KσsMyWD^uR~\*"ZKŌn.wc[gO),#b{dvFH;ME?ݝՌQ8Q?DhF&S `6!$?qejrZ"7: \Kp*eFBT&QnߘqSrelMm~Gjo"A ~N8!S{U^π(s)Dni~) +xEG < N(6ALMp9j)/K^F"Lmp[J"9ēFioJ͇V,f2-q*z/>?~\"x=nB\;/zSF ;\ Ϙa|jɬP?̱}#RDʃ-8oRMmƴՈW\!vqj_;xK?\Cw Z<0>f:כӎX[+{<bY[fo}F*&1J0k3]7afkM܄Y2/6ud૕Yz!#^{^nG_JG@<1ډqb1c)vFrO wRyDһm-sSs/+p,i3](Nx==^.wp3izpWt6:6Mol'lu1!5^ ڨf9$} <"exhU݃ӹ Z<| cz(ģ(z͛'CUnk;zƻUY* mwj#9t..e dc9<woN(P}h}J:W=vv {c4CWgd(, '8+,Y쑃IݙҝveNkzsFvG+@5XeYΰ1Z˳G?Dw \d\3 Z+)5L/5uw¾ՙ\c]WƲb>lZ~@UdTLlGU!)+pURJk _c[5_+SVA yP\ I_lu f+Uc{焊 z%ۤ^m@np`poܥ"m89os;$J~n Q$kr !.0?I[ jY֤2&5cG8uvjnt"Z--imjԘ'''lwh^:r!˄೯ږ|#M%~ c-h(_Q]Kg<~ɷD?.uܓ%ؽop`Yn۽k ()"o(_ߥP/ ŘZh5EToV{o|R76B#cH^Ǎc!UV1 ̨mYIǼi1$}8>|C]΂5J)eژ]{%y,ؽ!m %zsVǪ.jbvDo2ڬuٿw׾Kص7gت.uW]V{ewģ(+áfT}©}JC@z6?;Y֧6[o-Z&v㑥z#$!\ 69 MH;@5~פ^.X7=9;sq]y8Ǥmn< K&3[sទ^vZjEsĈz8z < ~&PD&B#;DJO^d o)G^r3сzF6f{d" D]?T߻Iiz皥zkJ6k1[:2Ɔ9#w;#;Baꉮ! - H;@5?CB7-5B #9KB6πǏzzDAPs,\aW8٠ˏO9;FO˭_nY-7r˔ݎ7ݎߋTcI~mӛ6bW}jm }Llqޒ4{p|'9kCv/_,OJ5B.# i!E VӎDp\+jA@=T"KHL<~MbU.?>z!ҥ!0k+ygQ'YJha7=^#U٬_E؇ 0k3LnphOVg0 f]g`eiKxBf~JiƢ[O#X)>802afx^αבyB41źv`9eN%gz w={oOOj[ 4|qsQ 'Z`=C (5$YP N>FǑ bgu(e#gEduோ\5+YmwV߫z 2CJH;@5pl717 4r~b׫*|YҪʪ^=S4]GH;@5b/U \f^H9;ʼn~shw~ [_ c|B~[lG̊tc`kwh}̖0{dJ9}2l0^b>X{.cϟAngϟE#vD :>4Ԭ]ƅpC P.5bpV?ɌF-_D*T4wї ]Ѧ֗j%#- &T=k |6L>Q~!'aio6&kX^>d#-V?1[ ׬=:θ!V̢oOezřYE E//"fONP~|,[Yh bH ;jYZe-x}¯"'OΌHgſh[5[4LyLa#K%HF|k|i3~cN%cQc `d#T4}9T2d{Y|9ocE{w6eGp)Yhfu;gvE/_$kƖJdA~vw&P#YZkЮHj:9 h]X .Jz+9;_Ex2Jke)NIncdxhSV \|q'iuB}t]} "|ؙ3Wf3]d5J^$is2'"g.ZP! iBAZ}#Gmv&~Ptm^V4)yvS `-QW"̃KYil0%66d" 9|7oJFo@$xؼ) R~cl ohZR."T- ;jYYr{ߖf&:Rep "*T9~ ~s",U߂Lzi 4MvEޘmBA6,LJC@<b4O|&k"m<25ʔ=x2۬?]5=Ab]rJ)'g^U7qIkW"oV.{igTrb! nN M۫ء-/|ޮyEǬzY9˾>CZEim'g_];Nvj~{\ `9{3>~!濱*_G>ԙj? '#;IVH<"vydItppfucɑмt2dV "v_QUmuH/I7ʂ!:#YW^\G @Y(PJltBxV70n,}\jx<j[fuB*J*pٕu.2@kMS]/B&6}UL[G՗YA=^$'Y\AͺVZslXƯOJSϵƓ/(gls5\4rHw]W%@YlS8k&q9 #};snaIzi G|kA&e6dd6Dio_s GYMϨ$ '}9e9H \NYnzُ0n8Q4f@n.~T_ KͧFkӷqJxҷuu8:t;L{ztn<]M1)H\P2TJƘ^+{Q"_yB_0DG^*ǒopǀ Q34~)}oDL '}os}?o<KH؅.OH>HkVzcއR 964o] .gM}MDM$ʓ@K7GM b׊zs &)ҿGZ7L_~4ǵi)}Ϥ? غZ/2쩰jnmǐRͯtT5jQÐQ׀ 93$$6;QeyZ] ]DQ$ ;b\8%ē~Gl7g-C$D s&>^u5?NG{OI7@?o>xO?! vL$dŨk``w!7֧RW߾d p 0Q֬mJuI;{(^w6sک1fq_eef*zq"ߴ\ߪY9瞽^([w}%]ēﺖW.=$F7P}c擵y " mZ)6m,%# E$`um6  g#jH[6̋\ jQ@ʗf@b6[+BM0՚phSNmn:5'B(&՘Q3GĜ 5Jx/tϩ蹚eJqpGCGFOK5_p:B.V:^PnK$*QwL6W9ۿElt(b[ĒL50 ~YQ,'-!ۀσ?Y<|tw+YusQ&$ɻ? ؄@ ;/.i2.-3408KSyUۿqg|3^𷍔LZgs#=ji :}dS$"xyr:IߢϞyaTljR6j_h?Sj<꺏 U]Xr~)/4JFgzW_1r@ts4_l:|G-j:-n4`jh>04ajڄ)՚E Uڈ%⍘"?>K.8ɓNrNpj1œII'DNRF$ U$K*NRiC||%>YO)pNj<1CJD'!aުB ɥz/,OzGb/E*c4>\7X:-P/Z8۴\ ٪1P T+%0h d0!:'8U"j˜wJmVqs!(9z %3W8'i˵L?A,QoNɣfR=/D$isQSj>p̈qN"~Y;Fićs˜&!DE8'TlH[ 0/NopN,5u " FU!Fb-@8StǮ. Ţ.VpcZ\˹T[WIq}"#1s޵? 7Lۿw3Ez0WkՆ{i7wj)Z.Ùm&Y4Uv _a tYbk|5~vLi¥yOɭosh7Ҟ+$B'd?WL~;᪍Y@Ƕ8Q!ۋk GAX3{~x+Ǫ{6ͩjٟJm.SGddYcv<,`݄ -i =>i2-I_:k"]ApWF-21x3m&K`,ZZuoU4oMu6KVAQZr\MY; Y.3Rq"[t, _xx/ QFp5VS()oU).p\WjRt 9]&L=ղ{1q]Ã?V|O2Jh|'ST"UdN%Ws|%܃&U<?gRe[:80kAVy^R]jMQW 3y9oE^} xU5b{!)F^UJ^W 5VKWM0Ž"?=keKڸcOѮgۃnXZ~Kp6_'#D }5"Ep?B wɥz,O?L[LSy:5fʼlѶ\߅Q(ʂ1զ ?Eo1^ 6̟zåmQ?("> PnM RyW?zp74|,#iH=lEG?!#xOMۿUL͠2"5jrfjߪi&":#?o6<Ӣqt#sfքm|7_+=\U"FTU"UdON%WʑIKM.իxY5)~m~O_;o]$q(BsN)V4_&o*ZJ%Ύooӵ96f8P$hVʱvuǹbh}%p=)h} p1+4JlܺB}ӿY/z5)Topփ 'ݣ"YwdfٞbN Py]:iO hfR`iJlh /WV_CrOu[\.ROCQCsT=p|D:1Q"x1ŎK؊}{œLt݄>ehU^2(B(`?3OǞ =R\ 6ۑ8(@`oZ2̌q[?ka /2h*C6erEjUJ2'ے.dS]d@Ok]P.c\Qgٜ<m8oהդA{;rT۾sZmݜ/&9قQH-l[NbJkydxYvk޿R݀ 򸄒)_Wm|@ XAl}*u7--6k?{(LΩ葫< tp|pm'Nuuh$\*荠cvx|sjm$yXĽVa'xiu-vٮ_$eZItm̡8s5‡KZ&> RwY/0HI}-*)\Mu_Ia ԇ֍."#!Y7p5je.]c}ǜGeeΎt .6[o_]Gx|&NxBN' }'L|rs_|Ҁ |2d톚Q6h5Íj$z@6vK8> SCI[ 6@5#*]:Ӧ'^/mSbtŔ8)]; $ ~ 9< ~:N/̙^{cֹ4x1M %EbJHVߞ%&y49t yV 9 KE'oҼߏhvnml"|x$ƸPeY* i8aZ/iס7mZ`ܥ%}(z=VרEIáZi.)K_ÆF{FB>[kIr(=VæI~ɻJ'TWDy_Ee깶nftE7~ ;[GK.~Mo*SXEGO4| g[+G}?Hcjݛyo0]`E4\]?~3焊{˃ ]:}0i<|;pvQ|o89a ޾x1MZ'q#Rr~'psBŶ؅Gŕ[R΃f~89"~89a6< |s5헁OsNhW0͟ ƳK _{8'Tdo~s4qNZ DQ%i>% _=#_iꗁs˜Vr9\Xu. 焯v9"0 6ƴإ.sW٨9җ'LCKɮCڼ $fuϣ3`t&\F-siftTi/N;6sޡ.Ħ@ (zGi1+֎3)yGk4_Fq9>eL/^&v#S&JOsޡrҲfex;7>`)HҸJ ,逢]YWDL,S臞^S*EקN_ձiiv%Ԁ{*y*aH7h"m{zz:AW!GkH;y2]ukN,}C?. E_kބ8m-u|\oUW2Z@<1KŢUieSvL 1A?i/vhsu,jsڑb{Ώ4]wާ[e}Js7a紈y -pKap )Nh머OUEOՀ>JYMJ>|l|g;]R`Z$q> e(RH~67 %U>$'f[ܖlP%ǭ0'Tu! .oS 지V-%m-.:iGYK3yK2ZU 7ĺg]64-m`M/re9{kůh NG1oZw a΀\ iS(Y)Sc^ y> l %zsR{KFW*ћ/L16kQݵv͙Q[_JU|9%e-:iU kU4WI- kKkGsɜ6Z%|3ꙗ,â'L2Kn7ۋ඲ʲn =IMΜI9|'x J |<%e2`]=!mumDlgjGGj9}| \ʓrǺH5gpΏD*{KQr/%WQyŵ,gLPצE.JC@9Y4ٓՊp~b?1Bن?9c|p{#gNd6Tvj929StrY]"85zjo7679SGsbg6lKYfS)d @=ѭnID_ T0ְ:'aΦeٳk:ыD& v_q2IT3Ü!oa"=^НGΌ-0)O5p-]Lʨ܃ lC8TS NǠ>*)CxujcX}4-_WG @gQ? OǮ|2_dc 4Pr/DFL';Ȱڒ7<7LÃe<oYaGd[SBvViބQJě&"O7WM@]VE!,H=ۿx2Ü4fmٞz"k XVH]@d XCoƷ@u.~bnjȚCr}^?;Z)ri݃c}{ٮ[~`@[C_wʒ꤬Tusg*S82Fpa9,([;D֥?'5Ui`($_O%yf}SuOT/_=^Ƭ{,OfSv^LP# fi9pT!5Mui^/zV%\Zʡ7 Gr++KkZ!% K"~c1m Q7 G֔ ]r:.fJ~xTy66Du),Bٖ@!-lfz|j?5S;_uxj"S2z A3Mϥ2z#eqš,jvBoPk@j׼i8g޹L9$a}T;HǰOk"}(t3ﭹA{)@mcf羨r󖾰KٸUV9jc!q_N/"uDhM%{ߋ+G9C;jTGqQİSʲ1Vp|œ<4Ǐ;G nn k*3CZWw1-z8;_l /% sYoU+ltM\go{=cHC}=2=%ifSv=x |{{;E²3=ifi,LUVQcZAjWkSB,& 祜),}^bFL}߃}T37F*_Gp@4zjz#ĕ$?kl&Y!y]U橆5$զ}m2voKf7CjYi&H(?4E]/XQ(++DZY0Gl %8׈5s"JFpk/"fR4MS]]! ou2h`ޞ(vEi;-amak#T%ҲYʿ`xzH%4 P6U-tr%; <~$!&nQ?WZш Vׂm"Y67\GvM*Q$f~ܓsZb%(ٽ[HCrNZ4sZsZQ_! h [Hk룺'a7mSI'oj д-]n\7wJnSEMr2M]xƀ/^]?昞t(^,qҘؚ;a%:ش71Vk]e `;ImcHD3);/7meNi%=旅6v5-Gm{r+.u9vbKN;5,Q g]Mw`NO)S|]p g}kOǮyX { ?+FT:IRE@t nϩ\&u^XбEwPI🌚3zc.%&`!(} eaUBœ*|FTu7B6(y!]Ԫ*lnehQ4l**1T%Z{O7jEubE> Ye5I䇈/W[0D5-xK_JJɿ$ {!zTk+I ֋ԣt=0ؤHNSXlzjtNو7Q^,ih@TD< }%7 b׊zs &kxu-)G?LsKn>'a> gǀka|~Gl~xj_}A18_i٣'Lˠ!aяX+]\`.֝?yEu?إwQOF^a|Lwuі` ɺWK{%$:JfOl[`/s`财2Z|!e:#NK(&&l bzP('. fe[Œ;O:z z笙{52JQ}O*&~7)gē~[j$F7PoEwkfI@ \KfN oKf)(}w&iC@-:rl<@<܌༫$Ke"Yc̺[-D[BD淋%$x=ަ.2J n[9yi?KgmC氏;ºӢrh 9ͰγU2ʾX[C"i^|ZYgcN[էZ٘2ꃜڔh9W7f:[ߊюQi\uTy3WI_M{m)GAo7xoF{mI={d;:kLD*y!{mժ&ɽ%ߒkšM6Eڪ=k i]֩:Y}B/]0`xӆasnY4ޟfڕmJ<LS3#mQS 2riJXSDM:$ݔT|K)IRaMIr^)QS{O/ 柃׈CFn5_y%ETW+ORa?Tӝ&Rc{LwI7A-Koҭ[ZL +!׾-1%!`e{-}eaПYW "%Vi)nTٴ2/ k ,vqzIP>SSʔm g4Y@76ZT,J9?LO]dS2Zg&-}?WK76ROz&Zcnݝ6e?T; &Sﵱp\7IZ5nǨS#ݥm.'TLR d<zZ&^9]Xʮ5f]|Fgp! 9'l}c578'LTۿ  c:uS#A~]*m\uTih6fLq;_2lm̴Lw"i#Mw>w1b0V>ul9'T%iM$ %2v;>^9aLK [~UÝl:YՌ~yDx1E<WG53p4ij f) :zBgUضQϙE$@f0j*Mѵ]|>Ġ8M$]yqrkiEӇ |qCT?4Th5Ig9b]4J.aG8'|[;PQ Ӱ7?9aLk]W߱j~Ib88'|[_ cFPYPҿ~sBݹJ,\ _?sBE叁9am8'iK]焯Q?s/'N']yԌ/+-AmM2gϘVmO/$q;+@ (zGi1+֎3)9aLӘ~-N >e+?]ȓޔӜwކ7:OӴ#eVM,3 VS2M6-M/Lۿ[5M.mhߦM#fY!>ehcAO93z6k~\&#}H2jmjS׉;#iK㊳=+Tg=ظnkFq+5#~RW6_%*U1X\@<:z͛'CUwO[K]/%!`<{s\qWOR\ݬCW6fڱv$MddO#9 -3x`@oN(>p_o1 `[b+ /_Pq}.AvΘɃڃ&m^ 4,үa.q;qo`[06|(Aޝ5K5S&M9HfOeࣱպ%mԎN -:ˑ$ (@5?_fg o?JVPOk;sFqѷ E+Cvi h |ljj5 ڳvQFtfj=quFj/_$.R}w <;#Q w~K]cP% Ÿkj_i#ut¨YlPy9\ߙF7|+t͜zdĜމj lZP_#Q7Jm _rJn0Tq! s-օ(_O߭S% E_g9iI{vjS٦D.JC@<{u 'ft6 wC%qBcXt=^^vsR!4{[ʊߦPBvPr]om9c?J11ͧ Hח@M{ٴaOxQ;v$| \*@Pt^; |Ie2djt~z6-|2'hPQ[ PV0aЩvm-m)׽RqB7#cJ,=۷o׊vu6ͮhyDϮڵ^6.lm'{mgdُC6=edɹ2đ<K515}PM4Lj)SA8y+}ؘQ\5"z~KlQ#L̚Ym=\bmX{6?=E-Nv9[07r6NAt»ꃇٸ:CGqswE4!XH;@5V#wwf\Ùb2Q4B9\l7ϐun.]g!fͱ똉,9$N.ډ[-^f&yUcj6S = f/$t{y\M\@7;7k,}pmv88G %5H6Z : 9E}$EPpU1tH1 j7O>mk<3ӛX.;9V1X2^1\Yo MN{vjZt,Ճp-R1@rC䡸R5MvEޘBf3ǐJyIwo9h)H(Lˮ\V'iiHo|L[)z:Fe=QdM5j|u.~`njȚCr^?;Z)ri݃c}{[%|L7}z }?.K /~]2,'d)|p=ݒ'p*kI'~lA:nmQI2`ًl(Mqم*zI?z/ꞟص ʩ^+{{εY6y>eO?ఎx$hMMr:u2b5Mui^/zZdm?NK+(ʚ:.m7J~xfYiTh?*D']5) z lҫNK']x/@7ub>^@<ڞz@R;Hw[mO74B¶A@mN~ؼ;Ŋ:Wz"́3ra?x:#qš['f|WӴ<7`vͥ=x^h윳=:Z{ cV,% ׯO螦kYǪo8k(JV͛X]WX.wn4Ճz"V/UmKmiХحͩj%X0ǢN=k9'T=|[F{7qޮo\YR{kJ\#rpbe+09a ͽ."E/*"[_er/]9'L~pN~;">9a<9:ͱ 1SuEaecqc1%Z@<{|a_W'$dm[s$Ӷ@/ShKcph[5جתU Ya/Vzw_y`v\ 5drک1fo6Rߜn=y$om4WRԪEKWQ_9EY@/Nw\̍h KhOZ5[0Ӧ7!c7ve(#!{Z& tF N}n/ *0@B!H"CСɳ|cCJn9px@wg1Ҙw! E|̏*g[y !0QNDW'gx/(Jʥ-j1Ρnݽ٨ #Wo @I(,%e*lvĉSG@!o B!QN/ҫT9_#Y? 0K666F+ҿϡPtBx#x> .k+*hwg6W0Xeaz(4K~m*"`H(1 e[,U3MȺ/<[+l$~6Z>hOfa_栔\\5Mu֑t!Ɠ_" Gdއɞ"Q6E&Ԛ~5m썌iijaø\L.-G6m &OukN)DQ垏o:[l]4~,->v _=ϾYvܬV`?O2?ס]U,ט8İ(8 B̘XtKxmCdpC-d+CSFS$ׁN{J4@fT$ ʾR t ؖSE` ~߅?&C_ XY2p {5V0o1e>?bwMFor4ڌkY&~'>țc8KmT+'\>t nt*wI Ԣa)GO 97)^\b·5&.K(&y#Q:'$)FӖd]>#:VH!ьI<ՐhjU!32|JHlr==VЭqЏdg]`|?2 ׈}Aߗ[W"Fb_tݿ:$J*%TXO.ի5Gf{L E25_? j_k)+<yAh@Y}B/]0 7mxF66c€ 3k6o\h"ӄ/H4 @LO}2roHLHMZ$T|K NZa͛dS] VW{O&8XTb{@/Gj1Jթ&iVR-I½r^=;3n+#??-jFbJ͒tdVcVZ=uMi7W "̊VNɶQ׏D M9z7ϥ&y?#HV&]ZjlK*%B'-t.B=_-cTl`W2&l LѮT셠iGȶO.<_F y?>yTWc>|#焯Mo[IˤFZ&5Em&I[r-S mLuIQ?LQ.l&' >,ؘY4AQsb&~ǔQ͘rcʨg#I|D^GGՁO+kɴ$(Pi+nr,,/U&FH WmV\XJ 4`QoU4oɒMuLnU;& F7Hb(Go~Q !Aȭƽ*#Q2";YuIr^R-QL ɥz߯3cp֥fi}Ռ'k<E?J.FɈs?O$s[aՌd~dF͊Y֝lV]`SJQJj[(F%jj)G^-?}AW&F"-2"jUd˯^R-?i5oMu_]?];|B#x s=.'L?oGiz~ߍJa:$( =.w_K{\Hrh21iI%V$[boII+yKljc 7wr5GxqUY:Wd Y2֠z6"wA6eqpա`QhPہ{9͆f[IF wpjc:xU^x7'6i-nē~EYUR.m]lP]z5o^|*Vʺ߷2ŵ8>Բ1Ħ]Z W˻O:jf|nm3}Xsѱt^| -Hޒ wIFc eb4mJogBL 0CjtaFh}iQQ5KV)#T~`˳։s=Ζ/kn-GO O+%mLUʱ+)cWm 5VJL.ի8I5f)~,[J. kۏ2#񢓲^OE?%)xQ%byI)/D^T>EÌUEK*^TYnBi"72Q_زIL(`Be?cOӴn:k }FCPT=,[9e%W54z ?ZhHӂe)CAH=P>zHP{ɦH,OJƸccVƱ & 3.p]@1H4lP]CyPcB!-cՖ5L77n?J@+h/][!YOr;~sLampS|NʹڒJѢj*UfּuO6EZwuH4UYӊ7%[0S]@u svĚe;fL~[k2/};p7`#GF21\e"Ejp㪃0coU4oΒMuLYFoD9mEsv0Vs4Ům^,{-)%I[(lmmz,N ۿ|F1*]i縡5WtgcdN;g{DŽ]â9>{liƵ+4{X0=Gwfsh@389eglT+Ӛ;aʥ}jtۿ٘+B~NiCg6V#v 8E9* )Vimd[~]\qm],tN%V1X]W(hp#Feݞ5=d-=a}&mR}`m˔&׾,|ʦgc5 $(wRQ(!xAʦ#Gk8XIޜ8.!n<b!De. P3r*%< ~T:#y'ςGVi[Bꎼ+y!KjqݔQ'](W+Mu uf)~UcFհx޶ k1pkwN Ow*CT"RdߩN$ %w&U|>mU3ݬfz~gO4(}̘fNF6򵒠JW-EVҎx{.Eq=?g]'-7qɱgB0ʳe{Iɓ3}`̘I/o/vvF j0iGm P͜\0flpck63 &PBl< ƫ GQR'{`}TQ7H eEjժ&h;B'E%ߒh#i5O$" uG4; w[/M͌|DX-oQV; s@a+$O Ne Ħ |ؚtʨ"MFP/?>r Q-tX\@_ wTf緎;4IPrೱߑSc^ y> Bur)$.:Vevf*ћ/ JI{w9s`W! $/PwSSI]_NߝS_Ob\uTӪ[A֪嗔MImkn%9$kƋ.2ꙗ,â뙱ʃgh%7ً!6\Ye|u @WQBSw\/ ikmY-S洡}}C{v3C.ڈL'ΰQd%p)Oʝ"طp#;?J/yG2Oxckj_i#ut¨YY,s^3nW6)˜ qt.r @rÈSFg-yhY>6sT*ˣ ܂5[ߪLMIwMɽ =##=YM7*/0bYhߔCg?Bq7rDFρKjCpvjjd&tXb>cl(z.\ )ȀB"gӮYCw(C[ >@尶)3kf)Th_ϰ/!v_D}>jH;@5w#vZxx>E=x2۬?]5=b]rKFٜrr[ yv~Ϙ+Rj2{v}};zF%GLO.Lp^t-_l^mmA>x(ݢcV=, e_vZtw*jLk=\??H2qWvj29ip~^y1|윂2|}+!hWz0E5czcAUP>m5ch_)2ҋ~d#hAYC\tZhmYݺ#[iIмt2dV C+VhH%\=˂85oڼC"uGʶ'g23ǛBY^1KO[h,Ym=Npɡr+Us!Ui%p5\\x/[7oPy}Fc?3efg#v-?^* j͘g3;Pw 6AxRjqbxh])+bf '+7伺I5.VY0u}t5&Q1fUh4נKo-ů;aZ1隰O(SN&Pe_k kb'@M IԄk5քk`״&\e5Al$$ #\8WR!(6vUǤ~+jC+0zx! @ē~F]`6zF]`6 p޻. pV`loLtꥒ`UR1M'n5p.zc= $ZrŢh,%dVXA4$;ɆxPrYwƮV76| W7f9r # %Qr]GMQy6cr^ó%_)#WND\VYsɴxpN!N .krz$؝NQr]G|mF#&ٚcS m:\/3(+ٍXߤ_(+ +6ɍ{ζ^h0yUqٰƽ mȯfEl,2sܲ6V`~Ңn,tD<̃K-|Ek)cŶkXwxRCqO*SҲc|BBo2--˻l/LOMoJDK?# J ,xM%xo*nc#ڢ54 ?/P&zc sh;?)Npz0"oR HH)jM^Oa{M~nOl{Ͱ q iT^qE(qǮ*;~z>1V#XJd} )5DZ o> ZQrςon#TItN|լգh\_=%IߣmFc@:/!Yw[̬qDw V.>D+h` Ύ$G[8x`+Lp|"j@ɛIh0}-jYf%Ο &-{)Dzi6`XС ?uۤKɷl_p_PsĴJtgVO ~OXmz+;h]*۵ e]k.lOIw'ROo>I__bW+Z%Ck9'T5WS(d7p޾%9aL]Z8Q6fImd]HvimOm6n>mBnk:R/׷?EYj=Pk,Iffi,%# E$u0 6 r$8QCo4,]d'~hc+k"5ơB[՚ph3Lmn[OVc6kp1sF.&|f Sf54{3$ )gXv/pNvyf@ZӝJ^ֺ}xv}&aRԓ@s45 qNSQ r訩?92 p.u#|/jtdJn,I㍃Ȩ0i !0pNѥEK95Nr΄y9"E.9%?9'LC8'ɛ&MhEdũwcF KqpRsձ yGOluhULj4رxsBEj[6*w\LGosN{4-Q.\%  @䕓[%QzR_`夾񄢁 -S+Slx[lm6V{<؏;f-ϱ˽^[gMM 8ϷSVϤy[at9QhTtA͏8^}zoBybe{qpͰzήԻjʢHo j [/bחsoneۧ^Y]k{75mj{!a ޔ_s˜o_#NXQh=$,%ϱ39"EƈFs)5YT S:NA/(#qNJM]L92̵݆SroNk%r#rwi'Whl`ݥ#-ԃM-t"J Z]Wix76%xh򾒒?~ԻY)ñQ.~#X6tdP6*q4zB0#3܊^.St\bqW"]AʛcteQN\ll^_>i]>x+WvH{& @443Eﯧ|}| _\b U66򔸹A?*^I3I7gQ%dkj%jx+BJi*uu1T%ZsO?y:k1\BG*:?dktpu< ]LW _we&ȽLh鬉y;Vюu%"rQ(vv7c/:;w '6W2I9#XἫju#v=yTм芶91sqԹ-OqcSlsQۿn6?>4iJg̉SZXd殱m4|ӗD(EՁyALJO.#%! Itc\qrTjY*h30O2CfNHF #"S"'L.d]hP:`ISqQgL)w꾯r7ӆ#WC"rM '}Y&kbu &n0tM|f=ZY2Y%jE#anTT%o9ynߚRxҷ]]Zowbw%b5 Մwl KE fˆ-෤o”I߄wlw'k/7 ݝ o8`?xyd % . n,o6o{`{57ƿd<]6لI5)x=0[z`JV[l&jfɕP'jY,х# hk)v"lքll KԄܲ^M-*6D3w=B \K~f o#/%# bb{ƪ0mcx5OYX'ƀԶ4bnnih儒du_W:ѻB@<1KzfFqq0WkF.'.hTᮊcWuKFN* UhFE7!n9ׂdt_@\lub`sR_P[-usŚ][UޜҪPr x~e mnE}/lh0hU\q (Jo;? Tjɛ=F֡qB!!Ɇi亀^nz[4zKo~ryd ̂gӱm>t,F`<"(ٛHa1pm1M$7~G` mb).QπI.$#u(Pӱx!]c5y6$}Xj1iá5y+#5nRfTak ہ6u@O[H~Yw ¢tݩ|c0 hVRqBPR@<1A~z h5cnvMy̜^O13sc>g:LtMGjEsĈz5㽑strAx/Ym'vjjz2 'yr,ǖkeYg>]c!iTv%*kQ1֯0>Wh\< 3}~X699 y985%"_xt՟p==ycb6;)v֍0^6dL.HL5 {4[8=_N:Fe=&czc5e:] ?lkojȚCr^?;Z)ri݃c}{6_ѭ~%}0;P/Qk$Ҵ(1XZ5炵wKx/Öѥ?_s-C-68fFQ.'?g}ً #p~CE/GE[U/z962fcfXW:`f̩ޟLˠUG<b(jjׁKNT7k;PmMii EZYߨKWY( N'4Bx=)hGX1I9J(κ _ QN>ߔr\() fii sIz@%K rY"g TUiQ@Po镛FɉFnHmY\qF@<1Kei'ŗ8@Sӵ.oQf}?g3ClTf}5kfԔMCblV+UgTQ-SE懡u49ye0moys,?pԘ:HSʺ>n ;G.<}䡑'=~9usgXSyZukimS Ɉ.`Kad.)'g^U7qIkW"oV.{igTr4 b! )E'Ŧv |޿0zZ44s}i}GY1 r x~5w\٩iLfɁLR΋I{vf|>{\ E$1{ՌWFʗm\qM8~ dng3 ɛGN|7O56H%6[uh[7w|?6NPJ3AuuDxvU_\hQVV-P`|#de_{J p^lN330T&a%^˨-,| :)5 bIG%>&7 ctTujyiא*i5|PFbInK_ .5s2J᷿$ SUFd^}=^НGΌ^ O?݊Nx/ WO-[V@-p3iE*T,Bu V2F1cU2J8VT24^{_=l-*D*ትZka8׶I6)QZT-xӑ)U3& U3JmW3 ,Ye4_sfS0umq{⧑yNy<*,&Iyȗm8mD;l˺ll5p+Vr[Z`<;9jzӀ\#p|PZ>V3 +Vd5;rP8rb{~j?՜>@f1'ģ,!).C)O0lZ᥼-![7p-ZeO^L3 K5Yŧv~Y܉^4mC^ڮNصr)CvjLY{~Yip'%Qm̱+j]"| 5N/~բ, ֵN&[UBH>^Z2OzbZŰ˰2#!\w[#2`7GEt ] uyIb6Dt5&0Fdl2FKO/EF$K8>7NOĮQo/_RwDu''wG|Y@<黣Mܞ}T뎤dؠ ? ]6\EBk&)6m,%# E$vpE+#Y[g3jH+stB.*|6V~ՕY1v[uD{nd$LxYa21V2#aLx2n.XT]w ' u?[]iQ7V(&GݳW˘9# 7Nf2."9 |؊H"<|qeYu&좔r `r> dl,Y2q3R-%uQ< |t2 |jYIOzzyNwS'?tT<Aʹ0a!j0lO䃁$;wzoگN=d#x+VR1F: I bY}l(lk8O޵þ{7}Qph^|wkmoAUtObdPEd~Ork_9: -!t~X הYOtoH~ai_hnp!K_&.rKKwG/+N ORv uD! ul%07ߜ|n[G?`Z鍄숢.ggc+?(2eu]{%y,2K: vρ?[2z`_R_P[fdԌݵv͙"6$/ip !ɾ 2x nv, ˵]G5mݼUdY~+҄Qbb9픥i'shqbEF=eXYmv*'L2Kn7ۇ඲ʲ$ l{9ys Np%hm %W>|ljj5 ڳvQFt&N99]k";?KR;?E?o=vGv~$W^Ώ{}u(ObڮWZo0jxV;˜WL}M?0 7VFJ>nٍ0 dĜ@K%e55t8ZlH$ltWHIsRh.3os ה[o25JN$ݻ|<~63D=R5G?nڬ丕`BZ_Z %Q[K@=R  13>ˁiKzԛ5(eJ(Q.09i 5r)dN%:>κqV*Tg={cZfTqBw2g 'FW,YKn)lYoU+M\go{=cHC}=] 4ٷ[ڎڂ|"aYٙEǬzY9˾>գUԘֆ{r~Zep?;(1er $b9e+WFEM'}gNߣpWsY1.Sl8JCx.L\qV5ba&]+!\7p]ۂW.\n#ԓl/z`V96+옽ʠwh V.;iM6jD> .7ncNnw+#}=]뚅Ȁ|=֏d afL^ 醰  + ݞ85%6.Ǜ/cւXG6:SFItq"_8.L\XI8oz]7%D@!e}Pr]@<~!r/' *Z\TB |_/[ }!A_@El/j\E[ռl_Ӧ/e{:(mM1uKBlZ^|LR}!y ɶ}|-u_HC-(#2"u_*&z9ŷ$/Iy%T龨9M_x%(R~亀-~ Irh>&ځ!7vݼ3صjcKCmO/33/GwZ uqK)oa61{?]h[FVFFXYKlx7M0M|ؑ(;Sd"Q4E\ bY ugV1,=eD5Mxa7M0vGI)Gē_c>Q_K \V?/Mw3n1vbּ)D.l~{J*k%n3' PE]Ӯ_56:lNj uWy2B ٳS{,ekEݥ.ͳʳ^^;FcmUfi(:vL¼ V*;go[YQ?& %|;wV '}guhsVKH.u״Տ+jGM3 g~:$_ѭYdk=֏-{Nk2?&D 0{x)*@I דQ# ɺp3ˌbznN;5լzo{*0CC\&xeZn{/%_nNO_(xү [`[ kXdj¬LMM&l{[ҭ [`[Z[lYM S5IH T_F~G_I-MV 1Mf܄up%h&=a~I 9 0 9 0~ݜnFsk+0[V&ZK%D"x7~nXpm>MK:B%%^Њ5gXfƬZSՌ'k<c=LlEe!ү8ē~PYD+Ngٛyub?[mUx`ʆ5MZiҺCFlm }-$Oo,»,_&_~&&WM43*y![wꣽQ M-&[U(7&"dՙT+^,Np͏?/SLշBo&B5F1;ʪ# ?H .O4~(j3$#亀) {۸Edp$!X70~k@u4md{} u I3-t I<~P꺄D%T]¤ y0T3K.!<sAl-#NZnfp'$s4\C:,Eרog{̢7e8yX> P(.~;CA'LR.$P70 vP_= 5C!oQEz(DCQ= y%T顨3KO]Rk JjgVJC|κ(KuXIBu;,=+i.P?B|w_]\t~cz.u 4Gڦ[?M Q?ej8w$х] L sS_v)L~kօxn](.~Bxo]newȭ$F7P}lgQmZmV)0#R=Q|]-M^6gDv쀍G+NԐ,,"GB&̛Qe㔈g;,xVY#7s\OdcJx]E9<~LrVՕs~DJ7 >`ltVtJ!Rcxj2oND 2eWB2anH\)o島zw#8ֶW7 }QU tTuxHlU]y"RBywUu |QMg"DWޓY;RWծO2z^u*I/H)ju~U菜Η_Zluۤ99pOf8me2u$ׁ.%+UO[yp~,fALC{NtN[tͲ^nTn 㘅|ƒփYs?yܩ;un]7wfW@Y@K7Z@ #$!=tHl|NbogI|w|;?NK; zUgjvgT3l?4;zޫ%Vbr*%lsL=~ Q#?f2`;_f2`L=WVeU~ ~صL5h?Ik(D勓7^Hn)%(KKMх oh#ވUc7M(ߤNv7[Qں-=BY~m<}܆xyiS}E 6w,5x&pVf8܍G9N'5Ir=:9h@k̔IZFEv|Cpvq$78ʏK~y{Q~h6|~ ${Kr2 [x+*&X0ߒ-iuH6&{iݖoӆU?|wo ~rm#%r^(l5OPI{ğoϔɥ{M Bڣ#_v+C*%fJBڣ4OWEYZ 10R”؀!  ^d@eLdD+/b2`"LNI6[l}Ev,LjNi.lϾ c wuK wpJMj3p 'Z>gL\W9_᭤ӫF2^5D; hW1O-No&jN?}? SRMӆkZv|zph-&ľJ_`@O.c挜L"( ^ѣG+єM?(RW 7Zҳ/a2`L ) ]tmBBi"iu+Piv6&!~ɀiU54A]4 pIMrtqDõX SKS 6moM|\^ ݛ h/Yb,nݞ2-_N.Z?blAi#Yǥ#s8ORHӴkbR'L0Cx1 :YpfzFI0/ wRLz1iHbm(-i m?ta΁"@z~!~?N`WG]/$0]P)@,N붶ߩ۰؟3cU2%|6m| /i;FHb6n*f`w4[Uw0$ryuc>iѰSIA,'7(_:rE9?K_K(=4,UF 1Xňd__[k2Û훥jkeSԳ1EDŽ:04RnCÛ\?Gpp#Ŀ@/s orvaꮡkQ^!˂嚙cղZYm6jLqt(PwgY,2#>q_9<hL;@5uY3'I1k03ov#\pn\> [̵C!sb*9jP_0(Wp,eoh-zV8c13GP>;c[5_ ߜQk~VnB€AV7G~Nޘ]Ul@i5 6My RCU!quDsQqܰ!QP^~܌VHXփbdX o}a?irYk?ܹ1GLn+VqC;m[pn`sA>4l_Պ$ ]QIt5DBW7n3`jIe9ޥ'ff3dYm6jvV+ M6ԘJn{Y0@n`Lp6t\ һGwlII"WE=4P$Ȯsĝw0ݍc𰿫=M#C2_'į|xt`xY*VJC7 KT,U9ΞV(al/<_4]^2{ҷ'j|C$rt.a+KBr=w|G$C޹$}V2t9u4iD;n."Ԍ^RUn'=b1i?-nn!~oyVD2Z}#FSʴ$Qq(}s(.~sc=ԃ(Ac=yXhn %-C$K-g.;-f W!ܧ.Du#?IHĐ]39or(?[I \XD=@و?8r:\b;a:k=SL. ,Ԗ!rc!{(C-ƹ!^m[B3uۇ byAM|2geNj::*%#$w/r 'Q>0AP i?BlBVH0[MIQ [x&kP-T!cEFy8IWY >RN)wI"?.v#zd?D鰗c6y!#Gn/} (=OؖOjt H|QQ9:?eįUei2: PZ'!s?$׃ 9iY4bT2U]Z? M¿5@r ʃLdAY^[QQQzz.aPt5E d mBYjX<oC|F?)ɚA(W^jH ,p@DlD.b^m6W!+4)RhE|ombWtVaI{#Q4͸77.9rlv6#Rӭx ~e 78ߐ]A.ɛN-AE _ۨXxj%=jA&6RWɦFuՆ-ݦBʴiÅ2p/Qs{+ (TXdoH?9OҽoHP}COs 8%-CT?ەOV Ɵ1H{r Ν,8Yc.35uޘ-ilx?sQSň/E hN%+ZсM;0.P~Yj4m a# 7%H!7;RH-ttd{%-C\ws.ڢ pƼUӎo bD^,[:E$]q}שE&5UWuXO|?!~_1.pѼqw[Vܺڡ;YFDmX%o^YHC(|M-!i/G nE!t.~En3|M%L%d](mz{)y('ޘ7@$_:%7B p?BF|ج2JFͪ7+C>lMF@ՙeShZz!Js;})lYu^C9u&;|82xN%4B=|h) UV[|EPًRWsO.]MnZLm dD4^.(_( rğ+C\WB#\J( {wuh@2NJM.>TYOGa;A]gfXuX 3ߋ8T[֡CO!{9xy8Fy.b"Z5'`_ D|!G640.ʯv0PA e)is 4 [d:uũuw`aOMD".cH6nLJ1f~h&/{I04ۚ\'AiNd .φ5Pa@*L{z1Wn\}-frij2ĕ 3L2-jx uJiln*h\]"埦ex#yyoCd-G92xK%4xIoTfߩɥ[1P x\<,-o@}n=|P2eh4 "ddXt}P&5m2(MMTޒm2$&C6o2(Bٖ}X*$”t&]\ !c^N zkN|Cyk4$҄^eC^CjS@xG| U u)$LCykIJxJ6&JYO ؽm~>ӛ"](wOiD)Yg;=rǐ\(??MMyWXʞ~⿣ʬSJ]f1Fq)V~ɞdְ;ypSse)qpfV!Yp"HhoerJnD(4u >mfYGp9] !dN:vوe2`L\ا͘m0f,UR: U)jj+HWmIZ" (X@}5}.:-#~ }5e4ՔQꫩՇZ҅WK6&}5uf?Xp]ied|w)\ CZ~EQ`iVܫ]`ϗWP,}=:wPNMHOwc["=@{?Dl$rvhGȞưeٲuqdg S M D)5!ݤvJ&HݔhDLyIYOYmk33`NN23!c ̑އ8䔚umpS)jjJŽT>qIJ#M.TY6~DϩF3)&B):˙ߒ)iuE;RmԜ.gɼ ofsw")j.goc𑤣r&6' (iQ/gps^9>tp ^XBa|Z{6RPyW{k3aNɛ_D_WڔY'03>ɀ Z?_ԩ,N* zcŒh=Fl7(KT5QtwϿ&aҗJ%kFMmW?˵t&^^'2`΄K}L&gt})8IAd@mٻ_'C\PQmE>(WfH 3N-LSeK#UdSy-q|9Eɀ i!i*4eNS:>eԄ:-S6KTcS98<wmJ^@g2pxAFs)s/2jnS^m_͗tDRm6՘)Tm<ȣI)y;7 0 G|FFs)sA2jnS^mїtDRm6՘)Tm̸ɀ i#vj-z)&5l{W%]8n3T[M5f?sw wtmJq ߉Q&. 1dqJhKM%Ԅݦ:m]m&Y8n3T[M5f?sEtSFd‡3T[L5F??FѦˈc2p_Fʨ {Muz9ۦINL.nS6<&SL>gs&Zo#Y;e;|Q0'Mƴ-?))兤|1וY|W@i#ikҹ JC,u5gQW,Dը%u(SV2&{E?й *JCr"rrLMbw)ZIE'rf_pӬc)jkz#;lDcFY;ԬĖ!@Y֢PBӵڄ zԜ? ev+Zјt Ɔ " Ƕpp_po1k2܁Jl`kfvM7\6T좗(UG d{Z /rׯMX6%ZӢkV)(K]gY^Ѥ;dd%a'o@;$C3h|a- v-bCEfyzhU]EmX8`6ABy6 svC PMhT+A_Xp (ƈ k5Xt)3 8L@iJPR)®->zz(%c 7 > g;PKɍ EhlTU;z';/2;O|ZA@C߄c+F9?_̜B|3Rv߂[b@ᭈDu%}Qv+7"~O+3"c}Q|lcM ;C_@"_Ty I*f]vlW 7 4ĥ:K8OR6#C|bV]:-HȍGpq %w$BE >c1$cjl:~qu*KF%;9O;T:Se3'4?(蜠Nn9 +K(sL5Tt@ `CI.qB-9rlv #RuP%|h6s/2ny>^XxKjZ-Pфj^;Oɦdj?= AvHd 7-f2ٴ6cZ1=bs\T=ctg.U e lCwѣG+F>(?|Dj )0E'3( ,Y?*2w"6ʿ-Kx/C(=vZv{~mYp~(QljߔWsnu`Qq'z>i67&QOVy_WhbSn0?//!_6hZ ։N. iD_4 ,Ȣ{o\|a 5\ ނ-(~ʉ4A'+6i'mgƆuް4h [ eQvCc vb2;FЌ/$?8.;C,X:L0mF=^Eʼą37 _p$5ĭ(sIkP7t/F܆r|ovHGQ"f@z~!~Iq# T-]u|xtW!~bs(4ܬvSN5eviwzу!:e,ƀWQFL7ba&mie[ H{doRqXm](@a$S݋Ŷ !">ʴ&e/G 1XňdA|ʯU}YmdPaJķVe  F nۺcC7OQS*6d߆g(Y $Unۙk& 2[H㸮[-H,uz+$IO*,a@n2iqD!`" w% 9 (Qo[#~$ F RD!{XB| eb$a/H> ArCʿhCNBFmYm7HÃC;HD:\9qA׉îz0@kXl0\v0ext~dN~vWNo'ጌt˰}ޢvua1efXu S$s$~Ն0 ""~/' W"~ĶQ-3cEbDrNb@3ڳNH wXlNB_x "&**y¹-alEcۥ. H>!~$y\:0벌C,3+G?"r[si nעVa/R2u(Sl$׃x!6=~I/ $}>eh%S2qith4Jens+>K"S(hӈ,6E `n`Qf2HMcPkZBx7zŞ!n w50f%]@TЦڵڌOG/e)Q\\%`pnP*V38[(_D$n\}VhWEF+ky!?xGO#d3Ezjauy;]ޅssL·+C zU%7͎2SlOG/e#cY_?+P]|٪5G7 f5{v v=Atcvj^Ј z76O3U$i=[E ;RaQ%Ho% i\NU.2Isx6 #KI ?fvj,e+ IsW`f N\Ȣx&?Ѯ ˀ2Uw DnW|E=iF7,m0y2 ƋoBV+KL8F10׆9Oj;o&ru13J́>AL;@5z=* j Wc=wͳE#8(_;yi0Lhe`zvH 0!t]gK9&xfzy_xgax#7.삅Q9i8G _Evj*.2 ' 9kk$Y}ʎ]'}1 ?)F~Y^PK0(X0bM0wTt7A ߔ%Hj,j9}L&4ţK1_$p<^$\׭YM vrvjl*H؄%x*oJ^_+U(_NTm{CC4`QW"i@t1L;@yCZq|x>ŶlЕ ǝiN*QN)'xoqKw6QQyx#ШcW#@u{HwNѥ‘'*#A܎̢I},*Wuz|' މ0SFw:7P7bՍSgؽ >Qx32c"ۢiNz.߂,c- Muiz6.Z?m6,;̈w`)זhT?lmS1,Ӟ;L|ݢgwNމo@0Քf/K`jӦY= cJ3Fr(&4*fJU\c>ts/;^V'mL>9Zg=}(ZA4ڱ Gg}Xt[HPl^G{:5U3GObg &C6Tɹ53&]R){Aۯw=%I^5 0^xtP(lM͠>516 5ymhD8_Ob^@'…f)8{6~$~Gj<`'gx?i ,q&3N'T/O! 8Pl޷V*!袑<\u 뾶{Ȱq ޙ1Obmilo([)yG潕>࿧0]2o7=kwkF~`0չΝ~kh{ 2rv^gQ&0#|1އr 9ď,Ru(KQhea1:n,vC(͒ZMI7p%+۠lE8I7 ~TE= ~jHE4NhŸ1ͰCڥH~ JܕZXSvjpL]8# EX{s(]zWޜ3fxz[z>aKMvp>[wsc{|;CUܤtw޾W^w -s}0Y_߼ nm, ti7g].ASk>{ȀmbYU7J9ܙ^bFaV6ڋ/q҆6n ʦ|E+fL ?v>Ͼ%]ЈF{sAj9^kg6ip L29 I8?'/2]G~|Vr%MdFM&E<eHE8ɈT"^ keי6LܜkLgNÁ)żG)V 66|.Q-ꮈ#i;e˱9jAϽGR  Ps*N'<)@RE\Z\qgcs`ϸ[Y"~1زĜvS(`U`MәZFB3L295.|:lڇxɩC*wG"$x=a&ƴ@LY-Sր]^}$1QbKQi6Vk$/0P2tPW׮=]6&Bd8h ˴!?_DK' ~}޵It wy2ae>SWʸ 5*&բ#WN(&ձS 5T\֪pOӣO|ځeǥM, HV*5)1aϵuh$(mFz0sg`ݣ[ Ⅵ-ŃV~FO {-6|gW'kLïB*&͑6iؤҰLX.5D f̜yf9Ҵ9J۱M~'HFn$QV7 Ѓcvkgx?ŵ KRD.KBc3)87\K}5 x'fv?@n7\hQəpZ&k=ݥp:ɚtޅ-ziMw uӢ 8y5埅/RpdQe.m8pB̈́UgE[fPt< Ԛlhts"+8'I=*B~2i߱ɧ~4BL(LuC}X@E9v v0Imvu+8&邥b'8n%V^ 7ؐަӦȏZkL~Y^.Suׯ,u*e-U|vs *&a3N ez@GpM>r%5, ,C*)]. a͑c۰`gEwuӟe谷HoYM0 m`ۦ_zB,(Q[LIN ʶ]HC|1/mv^9LJW|IrhlVb[[f9q=4Xx`zgK&6JsUre(9ʺP`P'H!HfEZD&|>+ ilCcStW*d5YԦM= a4M߬]Bi ylΘ-@S3'mDE9Pǫժx46\֪JP #+/)vE:cG(Zѥ2 DH>!~Gt,aD$ q=ҸCT_iK+d%`C H$euIodD/DYjY_Dp"]xr:d@{1!$u2Уlx؜{0֞0,^Yjs_K:O'*.O=jp#}bNf bįgQwOc@)?m{5sJ0>eCܩD F&*jZ;).5x=oWBo`2`Z'vpN0* %x}p3Aj NFgayI&mkahc a܃ >,Kl 9}9`0 ~t C6\6*K2IYM,糖{5p\ 5 mqm6ԃkeg/[)ݞ4jM2:wlţ#/uӂ:+,Lƒ?%c0vRbnуEȰ5LTT=њRhkOsLkﰑbyxW=bJ6Ct9-O9'A.\XǤBrċPjX5 E|qlx15LHPQ{Lۈ?F1#DOfKƌlC 88KMhЄsiܴYsٝ]ej9iuof?b23b8=Z&dS/A|`"ɀ1M#us,BÅ,58j0ת# 8>ͱ mƩXN$[&I ئǦ87}L|Ƅⳙ ND|`[ern3f˖N' ˙%<)&Y tW.bӃ:-ȊP ߧ(*8 #+;XF8Ut`Ɉ4]}>3>Do[߽$_:%~52/VF#ԧ^U2oe SXV=\ 5 *ɦdm:^k 8-fc=(vWG5hZ՛|h2ոU%4› ѫ'UBJؓH+O;U,3T[8O5?ݯ9NÂ:XU22΁;" (A:7q-01뻥T ~#GPEr?*[VB#|mirrJ buiw2t|ƒDt¢DrjjOEz966u)Hzi)_oX(u4 q5n] P" +ҕ0vҪu;U63T[xO5F?7gn2}6`CsS%>ɀ1[qK1Őv5tw|,jjy,iתkV>n^xyySyp9e09e(sDwj#>!C~Tw62^/H 3ƿ2Bj5ڼ uB WN5lM:/tO=3]f-s:J3cH!"b}OwDw9ߕ!&|(5DD*%4r(;U,^6T[xY5?ͱUQ}!rZarJp1xǡ.f\ҧ!dS d+jhiMrP[UKԭ*TJ+;U25T{VE?eڐ8 oŊ^3߰ꍈ3paCC2U%4Jx UuJIί&Y2~5T[U5?#|izI;ћp]6+Sedi?TVΝ2|u@8ӯJP z<ߣ]*kr;$|1Y84*2{g\xOܼgL̕~* lj ]U|' 왖c7e!q/I3L39-<Bsu s ̮b[Fx21JGhAwBJUΨ7rT6jn)դd6#ͱJ}kp 3 Ɲ.NoA468ħ JPjhPR)3Ü-*Pg_g;\-P%"jTN  Cm|g]}*%N"Dx/2D %4"5`pP֋՟W(SZ)FǍRm7T8)(u!ޅP\̄nHt;n( 0P8Ps1r(C\MPBC!5:$n(bɥ—1͆ O?;'M[L\W_W*P?mTĦ-h\-.疳ǨFB&$?M3O2p30[2yR:~:sImtq3=L`?R O BSv3:dg1A'r򚓙T'Q?@I#t&t4~m,$hFf Lc3tZ}h j izoX㾤y XC.tc2@8w'dx+i5"dj uj9ݴuBN5:$j5q"v,~Mֽl|W 8_&>(uqxpTOg4gM;8=ƱkGtU8OpWpq72}}8LO+WܲZ_s,$zN2示ViOg;/d2EU6lZ0)ƳO9E˰hg7G=>ס PٍY8QFaWCt>ZU@0rVOou#A܋^ey#$׏}5y[,=T)({lBc7V63e48?Fو;Oi&)止CM9%z2POv$^MĽwԎ3 H&@[ 9KdhTyNAdK0!OQnSSp%G.y>!W/v\_;1A+|Kpȳ &*$,#IaMfWw WGeŠ-C"E6uFMWEL\A? q5%4g$;Jx |uJ9I6q%2KTcsj:bTo!o)/ $GLTBo#)ah8 W~ܥ$@/erZ6@x*߃ťg 7]>=`P<e_ 񖝝0ItdK42&PQUCX36Ьߔ`jVoy <;n,U!_Iz?d@?)G8᭤KFhYU%s+2rCfZEċKLח`-:?\蓺ig5Ey_Er X. 3&D.r($5ğ30 %h`nU}i;>^\_\gU+,3ܒaLT'Ywd-f2`[}s SYkTcO nٲEў!ӐELT +-og2veڸ}s-^- 72P_~1; Ө+!w"ɀ1y,Y լ,4m̯1mXjq O HHpelXK7Hڎ M([c} v 0Dwf!1Z ,C/Ja]z?.H(=Cuz>kL/A@R?cKU!zɴ р+hkgފVRi&axp7ybJ if]4!z-TJJ.л̼`j7M=YX67$4!2וƶWIŀ ⛘ ,GZG|3c8 uE{ g sM|Ya fg+g6Ծ_ /3!`kƞ9Ԑ9dn+2:o;#L\EVЈrf\ǯWߌ2jR%;hǟ\-Pkv ߇et1\됕RnS|ڨF #ɊnK G jQ+ڕpv<ߖߩ҉ɥ1T&_-ͮ FO 11aL^1||7܂Q`ҁv~ld8%lmzLq!xK8WԭKVCL%+J+;U48TcE&?=\Ǟrfsէ W4BOv*L$ynk+wv ϕ2s̙9x=gx?zx? [3VBC$^¾XRṮ!UIDuKEpPSee+!-n-cy={4=AYa2~/G2u%471RFLرY6 SEGKUcSaH6*ăAݲBluG>!~p: R_"#]dw1;"1yQЋ_#C\VCC}x:hJ9%;Nd"s6ϊ :\lW.9ۗ5"{UuESiL*XeB6;peQc*Ro ʢik:L Os:z4ܒ+Mi*6W&gMZ ף^:n܀S}=+d=`=`h eړv:)^Q~]x!*L@MD/B6c rP'߯wDP< :fz.pSp4qeD/LQ9a5!WEEC z1 _u_<-DB(XpI,a{xVwJzGNK/s,;~H;uE wq UL "tt—dFWN+זlMzmj45l$9ߘ6H6k-zDD[?hS)X6jAjC;`ˋ(FeB]ig$r(}r5&utvp#)X,|qʖy)z8$q^;#y0'i|[ёaD܅!A;)XT>8dgJӍ Z&Ʀ}z*[MtLNKJUvvr?8.M-nf\jNAMpsc Yˌ;FEZ31EcrZ:fK!w]1$0ڠ{\6|G|y_(w ? o@L4П/BY(g!|q~[x bgӞm9g t8qe_ذNr{'ѭc@n-gy(?otkh$ЭUM[V1ukߒ&nm6֪9[Y2=0 ԛ RdޜgW 0b堏}K_VAoKu㛈_U>C۶qc|pGspMr&.^=o)^С]\JRsu5^5QZ)TY#9ݠO/{b1 YҺ:{&{J%#tϖuջlz-+?=&{I;GHn9b{"Decfa8Q.ˎP8g{\% M?M[Y-pqiн Iͫtq\/bһ†>N]K{V2$'\S2ua<µhzk@^PN;r 7CE%Zni&j?CF㷒@2LLNϤZ:PR2 , >d=$̍.\A\cFe!Dm:&7uVmXi-j t(#X S?A H_!GQGr$lmS Tٲ$XGM V#mA0P"yy: \qcdDLhd=D".p1`S#D˻ybQShr^HzPNҲ'L*zXQ nTfqeϢtI6=R\XAA-(* c&۰ʝ8J^uwfMJĐ)u}5o=D )&z?L1V|K]VW3aT1pœ HΪͩ88wvN)ðBCD2^B7EILuܓFpN.HbBjD-u‘tY!Edb&/V7Sج?sT]:ڟ&ӟh_F?;E*dud%q o1@ҩ4"%(/Q6|j1EĕF''#R]x˄V ''um:6NZԲiOBrC??U F$Neߍ)wI0z(@&HC#" ~%`V1U']oy>itlnq&[U&'KUf I#[3zdÂfp{! LNI 761h{OsL{c.8@'ܴ ;E4.?1 Z1n ңa(m,g 6S4עByW/I4 S^1ܬvwN  Ssl ÑkqP9M0c1ǔ :栉o0M9L3/J},ʳ NH(bjl姅O!F2]GJy(\7Xňd0W-όeۥ#,n CϏe^IX7vyx/:fʡ޾`ڡ#Nx^nzpdkOrDYxޘ\'OhM~V Uc~֑kv;CKX5eoy%縓]4+E0=B9* f{tp=KNTyE΄/TW 9IZ;o8Q7}qL6Y7ΝƊ]Ƕ>RRG3GV[2㦣27bZ+,?t[ ^t`f>i>n!,SODRY/cgl.Rv3S<(S(ܲz۞͖U`H6FA6Jw[}'e)mRIڝ6y0{ 2;'t7Pns? 'p[- )l\seStrd3&*#ס6l 3-Q~p êjEgƶ/mڤ9 i;?m^?3lZ A;50ϟ6'mRL/S /!~ɀbp\$900?]10&aO3v9@@)@$^qu22CO$<6bՅPķVAI2e b$g ޏW>H8Ω]Q'Qi㍻.q۔ (+QV9W2B| cC|c[\[ #<^ߣyHz > ?y(=&[BS#l iϠ!{Dcįcu!⟣؄ā Lj?Cg!執&oQlFW(*2-?Llal7a09%ӏ#aN%0Nb%b F IIn_N-EG{6.VKk+aȝw 'h%Pɀ ,fܤOUs3Q#&,2Ld@EؓVD?T19,%ޮef 8Kg` q>$+>nV` ݳW&{@cM h6sNrqհ3A!Ӣ 0')7 nB>l-#˲cd9YfKoe+um;jCNŮ 1=XI+EboeCO%PS[7ԢLS?))y #( *&6= EPH-( z oDԡz6@#٦{ H>!~$mt9'f\Dݎ51'-;PO,wEXžpfzF ݄Lzq(oňPߠetCH+"|H<\WvWjHvIRǝىr!4K,eJBR[G;?G;G#ArG]; ?L8 x<ƣ !;i$s60yqO6=(6ɽ )O9$9n0mPMTy7*Ϯx6F:7 t 6c`@2a sr'/Gn"EWpKKUE-]]4t;y]zwpڏen߭~N)&uə=zK;Pӎ'#8ɽOQ)HԶS[FY8} ;(GAh S##[G IU" eOͧ:@C[Ã\G1"d_0L] #B$sLb&;V@1(^$~uׁ.J 4QdKRŎȹ_PbO s0&Ck_!~ ܪyi= %cFáOXVw=G|lCg ;s&‚^0ʇEޘwyNJ<߈ťs.R ?1KpIKT#%zgJ>GV(a*ƾHN;0UlXoNF1ˮ"np F1'soC6euoQ$d{|UCW}J֗` qu׼ؘ?<[6 5z nVX1kz”oFY_.fЮ6?h׫x勎6Y2YǦW J@aegңq E9q~5Z:`B)rE_Izme]`Hڕa- 0^¸t` P)A2Xep G%Fhh;7ʊl6j4RZxhm48&wIڴpV ׁY$ke@m ]k< "ށH6ϩ? :k >*tBrGu]7kJxTGc+8K|@H-Hq)f`D#L` '$#SL3br1] Mk $w."'+jfM6mfyV2J\ us/hZ.\D~%SiY9y]_QLހf߼:}(VC_|-(}(O":$ hC?qY؎n_MWmEmZ>(N)3^ͧӵPXuwsoZ([JTϿW;z\8Q58[Prk7ԤHߎߣRKɖ e@Cl w0B }uK&\BT`::mCumݷ`3ĿCqI޻Q.GVVp,2',Aj!=j8m@`Cbܚ6k:1/Ff2`ljX+' #|Z0,g BE8Fu&.SSRAS-G,19UM9c)ҦI&hc4,R6kʄ 4Mw2{⻘ Sq͢]0 nď30.%' .$:t.cFN ]0RK]˺7# ɝ vޜ 0ګ9je!YK,E+-)+㥈(JMȬWF"GUGQ~4v y&%Cq9 ?t[Ɖ M`1m A9mE" SxIW Pi ctQ r&dW09ETzI;Jd@U ޢRE(mVKj LA$>R]}f˹` eӬ٭Tre2`Qė1ߟS0PA~C|9cZڟtJ_{d̯M|< {RW-~1P#ՕRɀp$L,|IAS̓rmN=sX7P8mر X=3~e&@&0ɀ";(~XF1 ODɀ+q2<`1=_ 7 d ]#>ɀt9X; hoN7MLF|}V}2J1'+b2`LOЮx.+M U"k{ QjEtX&{UY&wKz# Sβ;xGQv`w2c]u >1iH&q93|NMj`<\aڭ H~i7 XJ/(Kzş NdnsKf<OR#Yi{X)a2J[UM[;Ro`5 B/̠PSnu*.Nt&1_I.Ds&]xH>qeyوQ*OE${r5CO|Z#[%&Oɞ!~$h(lC]kP*Tuâr #X0 $QRzF]tY/ |'ҍ0^枴c9kNLГT` ?NA3=((4ӻ)d93fU,uYχa 郻u=G9wͷk#-yÞywV9eO& o (ڹ)]sن?`K$S'G oˀo p(y:0=v`F?l0=ڋ/q҆6n ʦ|>Tӻ`IhAc^MvA#Z x3ן٤ H$sRI{7e >K7|ߙ3Q](#w9r(Œw#ކmf oƊA}}ê+%tuϫe8Ե W˘9#V U1@y)n)LT,,}& 9t4hx_.,KzG}u#:2az!eVhO>CLNj!30!%ģLNUK *P1i&GUw"00Hէ ܥM*oB4zZ-=ݯ*J*fU9֠7X92. 8C&;`*9޲ q4,'%R$ol9 [C9׎J ^8\^<؈D4mS$) n؊ml=_zW˸.B RSiиҳ˦c^'!z]=}/+ӆBDQfF=a F..OQilRC4aڄ딢L ~h3i4AZ*8iLF*,פ.{!Rccflk i3m^L,' [OZ]Hoɀm _в.+3)QK}/ .2!r{W +Q& ӫ [Wm Ȁ15wzqj=Rڱ*xشO (,9iJGX ldCbrz{b#iI Mć~8p4OZ|.T[겡`P.ը ~ɀnTÌj_ZGtha¦Ofq hEf(flġ\qp4RvlNؾ{> vq(dYX˰򗔙| }Й37MmTjy^V;+ P&xc % P*61 xg;G| Z J#î{g*9UP1 O5b5Zj@g[:UF9%R5Zeꃁ 4x(r347e=띈E ųq]ϪF|Uʙ*!%Li3mb*h\-']| vgp,= -xg2`> ^5}(K\+kvY-j.d]_@ J\bₓ_xQF^Mڶ\v®XjW0С US ɥ"H= A՜v\:`Uڑ6<7cP+jܺn}E>(Wʥ+a&թU뺕wlgrjob.$rM'U Sl!|O]dk8]m%xbHZdgk5M7r~/)SLT伋: G|Fxh`{z jr ]([y.|]댮勑"d 5 7 ځyGn4c>-l+a8܆55tͺ W SXARk~q1UN):|8TL}usn7,d;"ك²un4o =N~yA4ETLT9(`00fTzF0]۰yITCE@⋙ ء̥yҎ;ͯgI`[0wrmԣ_b2Bh2U&& 6pf39qS^v6-3^<Çh`^rpҕ}o+>RsoAr ދ#qL0#Gx,(<&HY.ʮBDM z({1"(꾬63e"7Kl+7&euz 6w"~*`D{3PX| &1(.wQZ9ۡ{_+$#{8hP?F>o LP;ɦڤ#,N\xҳ+%yveWN&Q?I`2p2jܼGi #'x >?&C<4sJeYu `:B&ߡB /U:#RMyxPpƱ4yP(Q1k&ۛls1ؼ݄iwj "v&`'wj cx;5Vᴽ<}2tOtu_xR?7.>Yq Pxa9"k';cSvPUDvH pb_ Lom-_v ]gvN `'bڣJ{;HnoPZukv[FGF6ލ\WL vh;M46ն?HA<5@'e#1"[! VVk$mg&lufGFB!>Obad.ފ]SU{念Ԑ'D3oya$92O*!02P2FՔ#:&dSm2୮O%FDk{ffY5T[H;d$49bҩXEf08$N= fc/R +$s2a2v,xf__Glƅ#2~BUrZEֹC%ɦ$zFc%iFq]v%m*U%=ᅗ@G q5] (q)?WVK/|%]&j w4lIR hLB2ӦNNVj-F~SWcT-6FʟP1MH OW >{(^,(WUP; / ~ 寵(>u(֗tWEiWMT׫N7:^DN@*S^N;˶J9X"yH;3ۘ%7_U%C<~] u +$-WVޅNPɦڤ_,i62J:VHxJ{ t[-lϫ Z4]upkNu)W,v/3~kنE8|zX[+IXk 6$xFjzV5Kz  %eJ [+l].IHNƴn5v<pKtqRhvSMbxo0 ?:eֆMU .L{t܃ -&tM߀N!!운suJsR"7M>w\JIkO ?|Hɀfw}}ۼg3R%}rpsq °{ DdGہ:oy+ jho-if2q] [ѸPUۛWW(S)FLLyDQ>2 6C,X3?ppKW4%CK7nvq_آF~hWpQ S킓K VcӜFz7Vp8pĴV 9#u1 >݈a2TFO]uP[UKحSJ+;U2ў5T[xV5?9糹5k.OZdi#_2xZ%4Jx {ZuJI&Y2ў6T[xZ5?aunol*CXTl_~EvOɀչ {ĩlCuh8~*{of2x<8ٗ^?PC~f\ЅAn"r%V=n•|vV!Z4%gZ}{ǽ${^C&ST8##aU{[FLeEc啎hkP_)S:k1MyWp)s+4Ck^[ϑ Νd^Si=pL߁'>hm7⼕ 3& ӥRCS4f(QQ[:TPϾvJ!TEի6KNNԨ\T.XhX~DuFH`t\Xt L\Q.]2D %4" 5`pPk՟W(SZ)FǍRm7T8)(MpQ_ëYɍ>tۡDD|)%;eW!PH )@N#ɬ$JX}irjL&ȶ*!:'M[/zL\wW*P?mTĦ-h\-ni{Taq͏۬5IuOxDTV.صںl$WLTئ~[dj=l鶆 83e$/2yގU!bC $.>?,C\IDUCCv5DB}$=B <*2KTosЛ1Co![t՜Cmt{6#Vz&|8R܍fPMi]QCIGf6B5YރJKhL.]5lC xʗŦ(s;5&1ԇmWja'xj\~i0;50@amN!am(oM^yLcXL`ȭro'y-35;8cprN-_X:F=k,WzmN"$r܉o>ٞ&|󉅜;}AQ%d ɛOlLVZ'| 'g'e$ɛOǴW7H<@xxpdGPMo>ƛO6oԴ͹Ã;n>824<,Ȼ\QVny 4`#]an>F)~)mhޔ3WJ Wd8ף^7wjiPK#XE-tDkYqeע|ml}}z3v/MÈ}gNk6?g$qp>+G棓rw@qe+[W8J3A<(~% . cyz!m^ |y,;42ޚg 1 O5b@zZ\_?:TFM-'8M ?,A"no2Vo2lvs t )|`C$Z`z|`p!q]6"*f(Kf?4uhBiJB|#oTso∿IxFhн$ WpUS(UR {jѩ rɦ$ȩ3RGdށ;:bc, DZ(.WRPX/aN), Nd]frpj zeK/xU35--Ҁpz=BnbrKzb~(2-.[}2"ٿBʿPl($}Dcb8ME, lQTE M_#>˿22]O/[ CصQyEzS r%_q=/dhJmC5R8d+i4ѤhIRk4%Z2SmhRdgCQ?/T3}vDOlvەտAnFmlDPM6ǘ ؆z207f^(Un?iӋ̴k 8_2P 55210F:?*L%XT\ĭ+0});=Gʻ5xF*OPFJP# ԑtD6LyHirOS?\6Jݢex^ZAcN&2露uPs(b(_e6ۆuO-æ ׫x-3x>\ 6ފq__% 1dD_,$fҨTEl!dCZ23eZ]ާKJbA'Y$H3a!)8_= (icq̏ivK3RqF2>x5)Ə.9ex+ jh5$<6h\&R')*C%ʭU"Cy6努QC6!+}Ȥ+sJCs &S\V28|%4Kuv#%zIo[O._M5'0+ؓB?#9ޕa5^8|] ,?4&؍r2Y*㑮fH1Li2 E4`l &~&M4 Ná;;5I,w,u%~U\QnzUa2}Ww N] = $.\+ %Mׄn 61w(,:wb=}ݶKz(?_lBr/@`ZyJsȓ.h'\-䞦V;83[C5=ʆ [UhU#phV=rTn"-]|,@$9Wg΢sno㘓Wl218-yɀ }qɀ "`7s7W0P߾VK4j(TJbDK&2t$jС@)g ȟlމ |;&. gy3Gfj*7.(#%)i$ IKL.nRiOj_mYsҹM3p;d 䴥ĕ&8%j< qWOةSNksߒ]㞴ޢ~rjQC6%22)?C5g2pxJFBkܕvꔓw\d׸'h\-j?jQ6" e;vnd؁,g2~*6cᵦg6WC5kM֚wfij^0B~1mmrpF d1dL,Fugƍ*IՌ>g!C|{銯c}&7Q2~1z?,5At~ "$Qq ~ QǸ1Jɰ}*eΞT6qsd.ٚ:]K=-T\Tb4Q2~f2`CTS/gQ6CV~%*R-^̶kp 3 {<&fp׉D[xF^,piOKN2ǮmFft*<# ;Ak b@o%|=qQS%:AB ͳdvH#m5{lC؏Ճwp!$m?|c/kM{sK]؋rt}]\9OQTYj[,0Ju6{Ϋj|F h:@v r]/AptCD,ٗ`i~ oIlAߑ|jshyNki/)N:Et S#LNY1\ 8chv#<,Bj5j`YuC3 _;qdSm2.O;TV3'q2gP ;%]=lX]JE1.2/`iF4;22&) ~ /6A'$xe2^MRYtDSm(EZv|D-< S-$ǮXwc^_&O=tc#Nj</QKcSYxl ~.h\-<-fq -C/i]v}Z.Tg.3ؙ]|)ejFu’`*+0 |Rtqρ 0j GNDž8 -xSN*jE\W[sτ*cV/6qt~oi DžeGVU^ (˟#m8kVC5P0!kHp [.G{ Q*]PާEF^mE[2uOUdӺj|6MM*d+L ۴U{6G]K@6 ~htTGpˮצkW v`֖;v?~KelD̼O:3lXpdc+ =NTHdi˽vz0&*݄8WՃ,$E?e2`z0\ HǎmL5NxTՍ`N_`\|wsVəujia+¯ `;{Ǚ`8+yBEcɀX`f۾{0qءc&ElbiNT\FWx XY4ˢFOkm\,ڱc~(NZڻH⽚Wa w_[ƤVhKE0-/$kډp@i#XkT."nǚI.(LzEFס/B"eͦ goՒg_v9ǝ !nEy2^ t/F܆!5 vHG| *b\H^G9LW=P>~!~ -w# TwuBiq鼁|?1KFzElTjsYl?dr]t ﶑ni{rZfoi}9M0oD}ވʪW#q9 `Q6 Nv k%rp )O%v#Ftl=09ۍَ{rv]IR>bp+>I:oBC PCnZUWZkڍ&)\ތ̣,B^0X$ ixhj.71Ygc>-|<_E<PM 8ď2m;V1"ӈPlmljo2YU(Jj&i1 :04Fpp;ɍ6{)}#QBNxDFrc ,!/rvx x Մ =YvFpOVۗ!6[pq֣84fI τb'oN<l[Ǎ:U05 S6DK<1s;=+:Y(!>#HnI㷇ă~u(ғ5'`}(<6VdH0?2(U>y?p$6068u#;D#2/QePUC$44^C5hD"nD6ݝĞ=ls9B{юz$O WcfPSV)6pfc΄?#XsgQnH(bj  4raJF Q~a{(? 2߿yT%zqW"srӃ#[s`d5"7 ~&U W!>r ?!~~ypfpRKOsEF{n)#‰NYuԳ4Ҩ 2)/DC(b60*]U(jR%7ۭH<#WJ z߻1]]X o}a?isYk?ܹ~/:V82^1-C&v۶ `Kx%+3+ J~U+Wb7C$FV %^T^S]P]¾[4/yt_?/~z1yi]p`}L3i{і>4v_es[Q}Z6<^B{´&m3KaKĹlD T6yGjۆRQ*TuNi,tcɴ[1ZR1Ӎv^K1N*Z$1,Kg1 ѩ}W\CQՃ*CO|ӷ\i k9ďťWr.eXtgZ݆xC(PEZE@kJEyo Hn'>_v4qvq9NZd%FYahzeKRce״@0{5 s"Kp8y!GDj Ƥ6M9vz-([61s("繘9OA.(/VV 0[-d =GG|W `¿u(L>A@t@ǔseN/>TD$>kA9OiE PdNW^#f--Zsp0ELͤGė_;6pLyY<;o~;T[4{#Es1J+aF)"%Q^XeJaQIm ע,A-ɝu,=-c&sD|<34SV|F0ӗk ucrk`3u_t]+@u-Ln}U]pIWKzEYnt[IvQwẎ Zvį5bM3R)v\5%@ǗQvՆ%+ͥXW/DBE^V;OQP;Qoc]YzJ "֛XWַެǺ^iYEMWوVXI7C2$u\V˰yV0Ee]H< Y  ԗ,V,kpx]wCur?w.]֥˱xXaZwE+X.jX.R90:zLga8Upq(\vl: Z,BAڀhCgjE:[6tKQhڀhZ] +:E(_[#ۨ .F܊U +֙ a:[vC҄)Q'@@y"y'= qغ=hx^efi %O!>򓱔롚)ϢY%=~)jEs(.Em2-,n؊Vc: ##W9W_q)ja0aɀ1 Vp*VVK뤀lHr̂V>{`N^hj٠K;i%6Z=8MR=;&++¯fWÎ,ڈ}ڃwp$6ۄ`l"gDfWUTC "UҪ<†ՈQ,CR>W@cieTcYX2|f:VXsˮs"zPpZ-3({"y]VT!md6\5ԤHw!FYj40E_ Mv9M(۲DgfJZ Qa9nmSN ΢<+m66FaezUAj_S^Ͷ)Cz?wbkvcPu E1_A2E] rt uE[`zAATޚn>>r:k= _P%3lFhJFQ@*vAJMGVT!APԎ`Fm9iۙ$R l3 %$4XtkYF;9,!pVЄ9^e4aL=Vz'{<̨vt.¨5ډ&.*L쥜^kepl$ĈW-k ޢ'e|ŷ 9z>l[%65໑1 q̻1~fU/ͥhZ IVJi uUQ -(E?Vͳ~hܡ 9ḴY䈝c'bdQ#neԨPnds?&v~cβ,MK(꧁/o" _4OWڠK5l7pYEF2ݙt]u|7r 9/@*~M`A6wBœ#h (^A4ڨ_tgfb(,CXEPKL2Q {ܢ5 @?!h´;a!5lfBZb*v7n94jzQJ%lX#&nX#v A ;#[ RoS%5(*`zz Lr$@֤fՇלfՇfՇy8U%x-PoUvYZCz$ khɺ x&5~44~46~4"hPQT?Q _iw +ՏVDxf@+hN@+hn@+QmKڜЄS<=&D8P6]WPSk>$܅m(h>h2i>h2m>h2>m>u^}D!R tD! 54RIy F761mC֜ƴ h[s64 '|nnZmSJ P]yK݇*nGeuh;;mG;vv*mG"CMv4qN4=52څ9hή6]h:>*nFS'߅+f Mgf4[@6fxjrⷫhKӮv-nnڍ1nXŨj7?Hia77+Qsgm(ibv5 ]vs]6Ԑb9rh2׵45_&ڃQ͎U]Aw/;M.qF ç<:۝φBy0Fӯ`c3_m/'M й AR7-A1 oӱ>N}wRٷ4݂{h17B>-ĖƲK؍ ;*1V-!ň7Gh6ү`c3;$_eO(e{V/KUc{#?>|K*@i/bs}H/xwBw' D+xŻ EKi7.\d7x[eå!R(諛ϋZb]G55$Us-R1hswT7J Q&,qOdŧyC${~ѷ J fiURkܢ"_>O}vBDWƔq1I͡4"yoipVpv@T ҘU+ꞶG3\*M w8"*BFXxNB@b˼q)+.s$3> QK`CjF%sլy_TGiyL6\@ɵinw"otTP^`*N#A">Wlw۳AM.%]~B)."%<Y2fVb.%}Ţ5ix0r 1aDkLWrnra W!*RGvBarޝ`ib&xc 4O'1K-,.Q<#&UW^20Z)CG dۓ&rXKe^| f,&j+ťJh0KnI^ }֦͢71OBK={uc8 CwsGÑOS4 t< a̧a_||:mc> >ט2n5BioK [ 8㣚^qѐnw`XcXpU "V jKs<}þ^plםW.t#(;O_gG5b:icujb,o)f($ \&};7{HANRcl.лbkmZ,XBS]ίN0|hm#ev7pd:z;,.[{$@hB Pjڽ A+n5_&y'me%ēoD4lbpQcګ( k:K+2>j |zCmH6{Qm-KŝjS?KM oY⺒eAYvXÙ a3_Kŧ cI>r7 ڏ1 =/ߒS,:~+Hyl*W^(h´}]ְOS-*V4{{e{Өvinx3&T=#6jebd#[!e//bB#+R;mN)QY]0n*sB{v<ι}'wnL_&4b/};A7rR4/At/B*KA_~EXش)Ncq46i`|lRy;Ǧ;qmbi#hKt t\ $1 Pjhp7ֲog Lca"式( fЛ%{W_WkA۴'L6ǜ;hf]H@wӒ9pTn`C|\eH%_*;AS7β1K~AXY1Z??:1-?kJzɵ5tlަSs1e8Y~c?R4\s-MlЦYlE\Xkf56v|s]$H,t oԭ)4bhȍ2fc[#hBUf)!B΅4? A*iOb^O 0yEWKG4",@4az)/0^vӀbR1ЬDcb˵ˬ9s{[X*hB% |EЭph˜lJ"6Av-4a Zik4aL,y &7ոC^.ntT]/W 0^29d`q B/*;Iy56A*R@mԣ0]宬66>\ݺe<|RЄihM&e%x)3&CeK$һ42,~@Єiۀ4aL/G A? Ӟsy0sw1H2{9TozߋOLkvʹ&hݝF?<#2 C8pV-޴Afƕ9Lhg]7m`:}CP=m{fnxE Ue%V״=˺4HzJ[l{^p$Ze:Gri~zEN `HԠI {lRR 3ut_А:6 0mb#jQd1>6c3#ZlKh挄h+kAm^HAbl hGITk!Eq,P}Hq<=ݴ$$ԀAT'L ;@oK~ fR&]TD`ń M]-F`/)u*mJ!aŇL،^BQM3,Ƈj|TVg"p=hxFsY|jgI={o,́VY~nܾlݶ>iW={f)C9ĈW-6vH@//$gT.9 awa6"?f 04w a1[4*8-eI[_:E^c"oa/ٚ;۟<[$>)rA*2Nn]6z5ZA`Wn|7non쭿=A*IY5p}Aƴ9$hBE*Z"dK0+h˜JY9َMMH;[GfkF3 ےd4in߿핂&tBRym]k&5Py]Xʠrm8"h֖t[+l'VMx!Dz Sb=|ZЄi͂&i/ n'A Ӟf0fYX=FN>1 {@KX)O4ۀAK]_]x({7~@{:pt:< =>qejW))'xkn6T-Mi~@fʚ$۠Lqۅ){LU Sx?XK0cDWM(Ƴpq6\.NOFaMM]/nWf.^A*!n zA4ȁ'OЄi?%Yæ S5@`]~Ik~fOŵE2W;CH},G]S>G* mPjlQQ?k&:Zp{@P؃L-&!ЇwR&qf c*2lw}o:q xұQУM~@E,#-!$cc=^l =Me [ӱg@Ke?n~[lYsK瘒}#X;/~)xamK|mJR-)\Cc ~2ӱOG_vqȄPD:D*)G&3LV Z;Mլ}ek!rN~@?Y?N 0 ..4a3:?4RЄuIZJ֋ UGd׺x S0U-y0A\ݪ)7%C2ȗߒX=n:(-R(4aSsK|Ah@սZűRԙ].&LWҽZ!IAQm7tGt{ |PЄMׇ ]Z4°GotTf1\XK. )AayӂnڎYWfQ"mfޕ⨆O9(,P;]\q3wδT-ڱ\?BZjm}ވpZ$ !2&1y 5N_:df䮋د (G5/O `NO``Ľ~IweTM/Ģ{77gMGA?$x oH&$6nTw~G:6F;A3Mm#|?h1ؼI2}IПL*~)ПJ*>4OǶJO70-2"Qoq&b RG6R)oV ~ěUo%C픎Q)eiV+MNRź+)E7 HvZEw<_l|UU$3[?.hBMa5ô>7]֟ Sh~UЄ)֟ c2!fƎ=c@?w9S6< L ߺ4xjI˞.qOӵ}$d8,YSX .0Te/sWqY,6h,ͣ!<6^ 7 Q;%ףmgHTVT-`T_(X8IVhM~d9ICYG#~Y6mQ0$Mh@I ~cl+`6MzQQ/~9 /-uԏvA\ݑZmBmƄ F)a97(_`WBY"y s5Ze c0,2n?]XavĺK$q!Rc$ԣ'A?0LX!I\8MU\ ‰| S-nT1XHXht]S =eC⼀XaA6&cT,i}e>lN\6<BR@S:?غTL1Ow?zE O/-=!w-VFs0 79 /^&h ~y[Є)1ϪAx[㟓9on=eIۥ9 PƱݪ2aaB{ vA*2QAJQn{ Z.B]p- |Ru*kÖؽAS%k/cf}u]sejy.AdxFwV /hНKZ^r K2mKMV+w M*T]e kV0Jf,]RX᩺2YhR-tԅ4߁[oQBہaA n4_H;'8 -_v~AW׺n~Q5Ͱw!]fT䝮]W԰R^R[&LCO?"6w?_T-wGHMm^]d"S 6|W4*ukV |u}uBwc(/UGtUyWְiؿ愩/mDp7qi/ `6~M4lhxYrpTM5Fb@<>~i\qV.bm.463Oz^IwC&DxhuR6NOo"Ay !5!e&t(3 t~H@<®\]X !GAA;FNv?։ģlW m[-Muľ-\ﲸ6{VOZa7q]9-3)mX-MB0пlctoYzɼ{0k+W|e,۩燴M+{z[~ ^[̗2O A`_H2^x;?#SQ,)Y`! ^Kj@w&b9x$4?xdqhImMĬ|wA]WrT-H췢v4WӋX < y2[]̠:\KǏiaѱ\!d;\=#A?m{Fͱ3^t1SqC&au=Vaӹ̑}'oe'cG)Ȭ7<Út{:bg1-su0;{ ~˟*)h)'g^U)@ߛ80k{=c@J]i︳gs8fXŬ.|ږ-ڂr*aE:::jW3{܂cV<,wa?v>#^tw*hLk]\/ϭ2+~f٭Qri&+d_yGGf*>dgC,x9+#8b/}Q͘>jcvn~Ts/#}Х7,yD %;k׮Tϵ=1[bŦ^&JBjEi$H'(E]5Z45Y~Rdޤw3+Dj ~I\qh\".UH+^_*QJa Đ l^"s OtD1ղv9b .j],,ew!#$I۸VB>1;?'XyG\*G5\|8zHGMI-e!lC;Am3Kdr à[\d11㠏c{f7e4?dN t: |37+h-g@?^3ǏHi懀niQͼ gY(r3 ^ty2N[ԋ3u6t/-nB e{1R!e;<*㙔f{q@/ښe{~ngֺ9>4_-Egay:r^ۮQw[&h@dMBgu0?4aLYEH?  {aӦAׁ9aiІ\q. ;R}fI睋NKμ0&ppA;ƒ[6sݠr\O:kv2|G ')Nk)N&gcKEi'ʚ2,]xrGB(".<˧3X>?[po.AZg}ta/R:/Ԯ9ݭ- L4R( dh6<_†G%\}Vث.DaqM4h1k}x<% ^0`tٴ C OV f8hݺBvL2`Z'q+S&}@p(XLyVgC'#vez7N>S | _[[Fp%1"*jȦP# 1fUKhЖ Ń6E|;؆4ƈ]{zvH]eEЄoߓ\U"F,kת9aެJ q=Ucu(=(ʿA{E|EN|$}.F zII&"MZBd\L3 "R\.߂-Qxq1p;"/7u^*ոN%b( /ՈqGe6z,1iٞgud* ㍢d$ZzR4ǙVdIp@Fp5TaT. U"RdgNtaެJ wq=3UcwPR.#*$ a2ùڔjFDg7āQk.|XP6l䔻B>PK6 z|Զ[@^=򕗬„qQУ]Kj|OcI=;svgBW^r@=k[$lgAMrYwDw 8-!({nc=g ™r=,A>3XN6κ""- dϳHWb.bȔ[8H[|76BOx| \HDox5mpB!lMAd͝flnL?=p]zh$paCn995chWI4ؑ"fZJTMw&jw hh'DMa@?Z$7Q+#l7Q+1אMjqMaެJi:YlVgwwu0պ9˒lH݃mMxd Ek%h¤G"fA;:&vW 0]\i]jw CPڮ4jCq$ V1AKP 0 Cx cʻ pQj1G<1m;q=fnE&=b +Zޟ/A*6Sie?-h44av+h˜v>[lޖPؾFЄaDZE&|] #7$#a1#ԈuPI #aD\F(2o3Λ).fޮ8qvR/Ôctu%aeͿuZ1h2 l- 2x:^Bu:~\Є/SJFp5^Zj"{iuHK'Y)^:9j2nU4.&i 3,9|s`!pz9d_"f zo[K&g4ʝQ[8-~4Γ 3|EYV|Ik]A*EO)hɏ;+AsL~u_ c8P&= "JLZ#]I;% O6˽WqwX9=@Jފ^Ǎa(#)Lʈŗ0F'ԪW#Yx.q PN5d cA "g!a[N`7EЄM |^ٓ7)^_\I(F=h~XZLQci 9W,nͪ`:Aӊ 3C:Zo8F,xA"5/i{)k+WN ڎƂ.CwY޴p9]unJg TҒ ݉.ҧ 00v+CasQM'M('_F9A`/-4av$uvDxvA*%eOɨzAֺb ,i/?&hBE>gM9A/;g|w"x`0PYn'͊g^IW ?X >(gm!BBڇ&;/4aFލHҢn3b7IU\!9c/v"=FC6&/FM?[Ok= q !WfQM/UQ**P 'ӍvH ^ ېqNUNmOer\wTF^]< /D-`ûe3ߵ;s 8~hZ-쭟Z(-֕gnm'3kf;T W՘:lK8Z*_T<{káͯze}(vYL# ={]B\ }}Bp)nм3ݯ0 \'v#k w;_Ǎ Up'1r`u樓ӜYQ4QK o}CRlެ,@oH_`%ټRo#i@j=.Z>SoDbZk 9WV 5`G ~}-6(G56B Xnfl +@(=B"m^ZjΙl/}B!34n%2З6 D򖹄 Tlr{I^6*.bQlmE)"NHK$Ե00%@$ӣ'@?)-͔@)) vE1T;Kԟ45 <]"{Do- rA\EG'm{ +\EDqSV3tnlTlyeãqtrk6_Ǡf83g"U-@`ߟKU 8^Y1iC\MKbZi._CͅTès_c-G&Sk'p &"vՂ&L:! 7خ4a̖085ƃ >WijD>Mb[bw!q{\唩KbZӂ&a$j9 0Sh}3nTxٿn~ء;Brlk^2]q:hkOe}y;:w{ boE&]ńzOUKcbt`K_?-*&V(rJoDE3nAXT T S_0o_&-_݈QMf6Up5h)fMk-`ҬL׀ig"_+#x-okLϤL 陔2hIBQLIJLr]$=: :IWeZTM . t7__3K<_.a^Hw6ʮrMάV!P(ѝ[uدMێ7!I%j<7Lm۝01lNR"Et ղKVZxr |ʟ}Ntb¶=~%.m*RY:+hBe.׾TTD U*[NCKjmnү$v?-h˜n.nL$M{@ߣ0^ v7v#GA`pԿ-tԿ<`tQ:vQbw?WgWTz=e9wE\_@of{ q?н=,w;|Gnan箈]- kPSa[H!@j==vjB~wʰ)-o"1Q`JA&KۿU{ vfԭ({A3fUqqƼ Iy 8hw:*X i#7(*àVT. xyV1$ Y&;/~A]O3unZ.j紓[¤ki6ڝc[$L鼬vmyvL4 ,gr31e*4ެ4=<?YsUL~wEn'Q _c) U&~l;{/.4TA˝mG4"9~c,yGG>q?[ڶ==$V5H~g)^wG?GOP$_& __Ob%T^C5}߳dE<UtV#9Yߨ&ʺ8~0aJ&M0ѪȭDȺD!|$[|69m>Yd\^qX^HsDWvhн8keEjLd-yލ&{ѴMK\|d$ވ_ %W@{]V;1L{[%epbcC; w PK.^,hBEi׵޼Wܾ3b?G"_ <"h¤9bw `9ŸGhM;}/& FU0N1 Qhˁ>_FĆV$HO3U7ǶNDNEB\ ]~ѝ|a1z"VVfBkXΔm?8S3,v.;~0Nd[c ʹ<:{\˭MiO`C^YK~El^la.$@|BNߍީX]Uש D=Gr<< l > ؐo1 _Pw DPHw$ߡ? g'm1oY`Nݾytڍt'm lLY؂]CٺE[[I_~rBR ꡃ?`QRof<@-UeпL7&Y߷ch׮C}}}}L}5࿂"b@ N[-.4^C5}H㾨O176՝QY(( a؈FqE .Ǽi݉:GB =|BNgA6s!g@Qع I8 O$߹GO~2:VEnY$y/(SՍF7;wrTP싺D} |B^ 9b-FAhjz*]MZj{QrWhJFDW@@,[}6Vvpض3aTu (:m?XK-"$:I%lA{4/VǴeb- :A 6-P=t$] H!—P=t$ӣgZDT*V4|V4xű F DiS+3F',߉yH*ݳo ,SDo T4[[$4 -<d$C,]IIy@:e=V\;ɴKװgc _jQtYCM$g?ϭٖTNk#an3NsجS"Pu .l4hA A˵ĆMR`°~Z h5xB-5°ᶆ׮xIڨ2n_ q>"v>|B__`բ$Ś^Pkw/H*RJF_aZTX[bAЮ==;K>䖎eyFzI ?{>OI$?fXz?зVo[uG: mģ`WB.Y AK? .4fmk>7ޘnEģH7e-DȄWFV 5&}#W >vQN-->敖7kG72_6'kɵz~izJ HDj; oۥދ e%qkW|ZeکZH3Y^1r#TɝWfɂ󎓇zzb+ ٹ 6eke$/cg4Ǐ6~h|fjS?sm՛dFMIyȫ N,@g/ps)yb>x$Pj,-U; .K(\jCUWKZ!GVϵ%窖Q;E/JA;&jVik_@<^;it@!AoLA9PHGKËRNlM6H9[s刋N֮&؊vU;kxN5-ss u^Q'z"ݛΈ}_Hly\qY@<1kn=T t<[+3UOlj [XJjK7A] |N?v`\7>֗}㠏V~EB3}2,݆bFWT̝"blD&p X\9cg&rcnN1z19ͷăwਸ਼GusgXSyowu_^Z9eN&t'|{ E+w-%sYkUlMgn51SUK%wY39Gevj.|ږ-ڂr*aE:::\=n1+fE/ui;k4\{n?V(/Ӏ<ΣA֣][ue|ٳ!đ}O 1qډjU %[/~) g$ޕ>IO<"ݘ+fR\NS-ސ_Ӑaeig5ɢ4$^8͝{vh6W[XRQ-5b H6uVh9dOHdum< * T@寖h{v p Ⱥ!؂DЁR]MC*/zR ﶑Y g/oD.RAc ܭ8x^wO]4MR=ϱKѽS#oNsz'^`&x5Ё1ﴶEx$Bit>phi-Cx1hU໗."v pkC56ч6чz}-1QCKG>h*o9_9w?w#+}[+6UV$XJU;H H Ksna)Ez%~v5 WHכ-huıtol{lGF1}AЃ#B?t x#{ߜRҳx¶xb0xw 昜_CM yrIj}ÿ?zٚ[1 ج6=pX_^䮹vT_7"_P1WKfF8끓'% Qez<`xy J< |9^0<|sI v@~A_ EsLY V mϓȡEY6[r$21ZЍ,ӊ6eA7͘AQ) f3I3!vmK[wTE>ZsFsYĮ :­Ne E 4&v5m}!(QuEu}$Je.LErs4GoBF&h3yoDX@JI·%e VGle]%oًeJIG.m>բUȺiV/F1setR@jhc]7:岨Mk |Ӻ͉e/ߴ' iSM{4$[\_=OU^!k1[Ú(`. +Hȏ=| M:N >x;ۓӉA 'bn~n,j01/je:u͋26h[J5¶cplXe̜=;IgA*k- A?ZNDlH%yҲ> âzyHG/o;cvs%cUA1mfYX2t kj{@2y-IK [UTjYdm7ASr:֖#I?gʔȚ61AyQA1IzLD' / DDRI5-q?-dMgt,Iً֒aW2}%]ģ+Fkji{L?֤}#ZΏ+Υh!>JoAƃVJ.6]mEQ Y|v{\s9{Dk8S6iå}lo"@xvkbVqF=یbECe.=wRgbӣFs--LNw5csrߌ^P,Ĭ~C2R[+wl@ڵ84?weh-fMv˹b{ M5:tLkes!(-ړ.%4;jQ?e?sYl>K/>lCD_4k ]> Ѩ'dM-rH!H["a X@dm iB.-P&F]Gj&$2s IVIgŒY =eeݶ6ueV ՒkTI J[7&+ai6[m-3_uhP/Ћ3@}57ٶ l,F@]Ѕ|mb!pfx^̱iA=)1"cᱨF".\YhBZތnIDKȌ5[ DT~Op;mXg =sXGi=cWn&fT7i7݋WчUV:elbYZ_W-r%KDJ?Z-tk乺fH஀]2-)#l4yLH%8h)؛U)GKr]d,fh3,֝+A@#MqHң{MpWFp5Tf^";Su93]U-49pjL3B|OO#+2(n9{Mp ^ոU%bUW)DnUFV YVz4^B;Yig8ӎ>Yo+ M2Jhi;U"UdwN%r|%ܟ&Tq SzqVؖ=aFuN?oWďj]p%~T~t@ʏ*UWGCMYG亸Udw~Ԟe(fDcnj- zMSkW|Tfif|͓#^RaYƔa .-3bSg{z?he"W? M&I:r΀ft$_<~LR!^;T&SPB{jqg,E:Cu|w}܉XZf3&I?xx? 2JP9L.SFNZ}fr\3՘fk>3[M؜mNЄ wں> zS5b(V&UTP%Il']/5A;TE|NSrZ;(d/m&{Ap@a8Q%b(V&Ud'N%ILk']/N49pj31%ݟm6l\)J &TJ2W'-.ȭƓ*qz ,LٙӊLBT5/[)6K[.>9pjZM\X)TlA#/VnvVC5o q[vtJGDʹ $\ЋTU6G,|Qw OXo.]aA[y{@GY =`K|/62";e@^ܻI"BAwyGq" #}/Րq)_<2@3ղ%L}[ P,vb6zx S끇MfԲv[w Pv:U2=,ZaWEATt֝wu5do,ђؤd.gMT2nJZcfy~v)8?/QMVW4aO+h˜fiͭ{JZY-7}w=wiB`^X-ydzs]:,_VcE? %6E1dM0FOKLw)hBU[grdѥj'M,MML IA4u,`Lg ŵ} &Lk&&\$oGЄMvmA[$_T) CAT <3q̥kx0r҈EU<[-<3^lӅ4yGSmvSЄi3¸jfXl=!ΙI(bQNB .FZUCB*4}&iI$z* M.umZ}mߖ.^ZsWiI2_[P&½dj5dYABNVO'u{u|Rt@*YX/J 1<-^*ExAq[\7׍tjJjWu3ɷOX UMsm4*]?MrĽH 9I&IYЄIπ"h˜6y3۞?aU)q# &бHl!\(l(Ph_dq*Yvٿ0?q2Lz- d%$QA.bJb 5bK L!B}(O tF r]ѧlZ.苬TGAkhMↈ^0'l-uĬ!וn5>0'me%ē}~f`&ͺ%p9Hύ|~3U0sହG]u.׮ScgmZТjLke( b8\D4ح^j|_CkLM&S,̵CoZfa~'pVFg_1Y͝0jˀ缫ejy⼟iY _DH@\aE!Ǥhqޥ(X KU>DO%V z.x&(VG\Oc‚-%i"υZ&M8* [Z]E-r!hBE-khYP"'AШZς#e,yt>`6ZMJl؝ a}ìphFڜ݊F|̎2\]xl3(;aO[t[tK)e¶4"Kj;OŠ~ A`Eq'Mӊ(U$4~IЄiGۄjkشu;>̛8!KؤǦ0&\Co ɏHЎ^뀻AtU,1@}GLAi4LEN٥=ͷ;mjv$y?Ԍar#ʔuIj!|GyPӷ %^ Zj%IQazWޝ zly_v~`+@RfևaX`ެl+XGU8kwJ) }wfO Frd2nAߎ9HɻdӮgj/E\j PtǴYCK Q h#Fp# p X؏O`? `i^VY jD|?LfR |9?@<Dͼ#2v~}_!P\}HlcnVpO8: D & \)/! k@<(ӆ#]6 OC!pV^Xm=-(NGS6ϐ)b7=]uGN8 z6yD:AKe睈I;V1YTHSRiwIT蝈މSNĮDDi&azHm %#o9ŻX4i(@ŴH讘j$z^{`ń׃>}&7Ob Q6gy:NXU= m8ԟV-lɇ!+XT()!=A߯Юvd}e ss %p=Nwa/>{qb7|\ uJ"Qπ3%${ c,{8L*17?q:wݜ蟈mο8hg Ú^8I \5qD2lX!F D֢IUv P[˳l/n?[O Pu#1KMN#yU4iೂ&TZ]Є)4;ʎ&V"Q74zX:k{Ң2jl'C[;'fxk5S߅g]O\sbV2 }2{5-t0F,mB']8ږWQiaєm$觢>v6O^h;tDH6eb4EWfjڍMhnS@xxѹY8[\ILvK͸yTԤ4$sw~g; eW3.ͥ2"Ju82J q=Tcw5Nrbdf ?fi5FۏMoh`KF[W UEl>9,ȶn4)^b8e5b4>MKjj\nyoV:.f|B67/3kb]i:z;\T"FJ3iU0oV丞g1nmt$P~_Ip"uMVlKG# )J~#]1*k+@Z#hׇ}o@*]3SV"[dN1r6fNN9C{W:`edPS+r _Nc?&#D jD+#yD+%E&.RY:ڔۿch֯~_n`98(Q+mM؜مmm7NuۡdWՈ>Ma*VW1fͪP ]" 3C;d]fM; rmwuA>\f> x^Fp5.SeH2XVKL9\ ]Zy'Y˷:t-ظtqqwqko?-hׇ##DdqoSLNN9ܷC{W:΅,n?Ҕy6JAG^IN}U@U2+qjP:FR>MRB]d\w2hy9ayl"< \`'xk%G 5N4:8^%buJDx#Ǜd;丞1ujs%7"JHE>|棚O7LyrwSjLu9~;cF̲ΉW,݁:6GKt{KWMwB܀eiެ1rO/E> iu1.e yдw$s~vؽ~m y\\#,HC"-鷭c0!մu7 &XMҪs)uO灣[;FooUWVy$ f6Z*mG[Gm\Ѩ'k{?B:H %/)|QMG#~ bk]RtSIlw]X %RڬcLWF {{qq20}zFtrWRy?.RAJ}aȚ𼊻Va哜B}ah4ٞmփ}};=ބiMуSccb*f&qe5UЄ !ˀ0ј2.e%5ƳK̰y{MȅuUv6D_̏ۂ&L:MS+4W)&\ЄSxr[? 0 MwdE/A'#0)(ضDmr6RqUѮ/gTralmKЄ)͂&&CՒ1ԁٚ:O]mW4Aek2ZnsC@Omi4Ȳ>?R | ilɡ}DNO0]nSdQE= | c*j9S!x%A5eے֣)[ PVm_4aL]2w®q7(hBE쐹D?M &Sy$?&)H䩼ۅ>kf*o?M._o^;oB6h"w? UtșOEs }.ݐ6Fvc-S4\Т UG/ -7Uv.j DH~t 3m?YjG2?o)Sf{_'$}4 4WM׋nT?: hBu/R3c$.&LAϭMSf2g8 P@G%2#q,?fpn <+h4Tx cXwNWrmip )L)?)>O [tDZ߀![ @}2ʅCSnB~GЄ1ۇ\s<(-0F`ґ'M@$P.keL/ȷٶ&LAm2>Dc{ 3֠3k*[,`6+%n:41+m,2sX~EЄ,: 9ly]%eC[AaC;AƴZTeT4kf0w0t%nZ=n?ۥnw|Hq˴^]eo` y_2W*|a?Zt1Ӻm/m/ P~a6jZclK蕕V̐-!e& 򗎖O%}6 dm&ik܏Lӣ5GޘL\C6UBLA4ve@\9:ߕX <yNaoj^*ef#x$Ҹ>Y+"](N(LxyjD?=^"e^Tlܶ)!=̞Q7K!|7wߠet3x wt.B|> 8 zTϯ:ab@(z7a;!N-Muľ-\ﶸвY+2{.ʺee9m_.mю;[KG%-ӿk׮v^2A**ecmը^uM7E,P7რTVhL>,DݑNmж $dCV@Wb- vm{hE}Z:v-w/}ݵcpg&𭠥K4MߡmQzOz9?Yr3{XEAY& '/bēPMu-7v1iY2G}HD@AoTf߻6Rf]tY=!o۞9zIcvF.xh[BbwnXiZf)jF1zԘH1q#q{a}3go|T*!lnQs8ɣv䴛D BUIn44t'M啪cUH+1åӒ[(JJX]Q.c.1f o-u Z!vl0yϫ N,&;CHF^t2,9 Ղh ԣ5z]߱} bER~u_O>"v~7ē EPMW3ºjV*}W)V |G`np|bnc%fX,TǍmП<QŮ:Lpk su'jBB iIw+$plx܀a28$!'@?|B> Z*B]Wq}O϶RM@L1W7Pv =庹*$껀_{b"e/Ή'm1ڮ^JdW!<>p}m_\8#@Bċ[@_%#b-+od`@ڷ=ʚVǨaB^z --C}r8N|%0u("cfMcIvx?7 $ǸOĴedA4}"QiPPn@W>a0JB2=Slh ™r= s ]JŊƁ4"8ɔw'!16N^ FxN.*dUp  iT6gbO,.Q){H6=e„]MŨ3$ l]?$M?}G4 Ysq}lEU$?h"v/a\[b1tpgp6s^ÞZnNıak}_>L7Wrr@ >ŞM>!v~Ez?V"*ِQWm._PyDb@<*84_@<1kc1vrNYU-SBu AKE!6pn-/mfbўGkMj<[3`<%6Ͽ ՍbMoTM1c1XjDsDڣ5t 0:Hc[Gtғ 7y@:}bWnAoWnR$}@?n&yAKm`n{~0j[nue]p+^˚|ܾEͺ`c} ПHˬI^%f"'A2~IПLǬO6$-V\4%o^c </rF~RYu-u P3o `VZ% ղ,d/%ʌ^ű hTxǂ0Sl ?1;&F.)(0^G -dʆVcĉ^vZ1 pRdfȅDANp(Txl"3GVD 7[hKS>t2fV2]" eep$ڊ r4 x(oV j29KVP\XY -W*=cACцZUjtOlv /b`p[t]̼Y2٨jrﮭņ"ןAׂ^ }B(K@_0b*ǪTe m1:QM}Aa6h3Bvp\FϻvJ!s%^(\Gids5t'z4;,۶gڣ?Z.pnun Tz ٭oX d Zn7"Nxb↾nzg!Š/noQQG5aԞsQUgٞ6FkfdDt߀J$zk3z##TUm^ 3r>[e54O@e%zx}T㬯筅3>r(cQ &Nx=FEݥ0&l2dM!V/͞^\=)WRqGmc{Ѧ[s~>F~jk^P-jZjx>@.[~ ^[?qPf/}eh7;4V͹:]F?yӆv?6rӛ󙭯Zk#h w'31d,Wˍ9?O )b{aH޾SZT5tT/z> \Z!Gj6!84G[kjڪSx;tDx k KR`/?*0m}lH38OZ6a.4-t7-\K43}1-}eWͲ@Ct&8bغ~<+m{F1jc܇wN1ˆưcH3G}wxIۑY77nx5vWuZ>ϚcZJtaBw2L~hNlxcN99zJ)}^3=*_XTbN;~~ǝu="U WC'w჎/ŦֶlCT +Q~O3]G؏ݢ􈗺4ݝ pW.s={{vF@1Y!2 <d=ڵ5[WY&{w=6^<2F5cĂ[Vl U݅GR HHFwlo$Y>y)+wc!)pjO,w{ CjEi$H$(ڡGnW asCB֖Bx"C SX@}Oj~-z-ӓQ{%4 0WhG]B<D:ֱ8z$u$*d(+;@Q;;'NghDt`]B-s%;D4~ 7 ]^ϐ07ޜ'!v}Ul#_ Z~\`발Fz}V`˂$5$R e8Zj*D)7)exQ>b+e:=+ Z*RJI/pE' mpN1 e|ʔy{%z,gsԽj{a } ҏētE@~E_ #¢9&AuVij~sAja7_2u ^Kv!$1I*76t!076vH! eZ9G8ZKG-AQ{b?@5pM9m?-P ^Ե)ٜe|D.M^tK\͜oDJ Uţ#9vG$Vࠠ J6Al'w:0Jt ,?Py4aҮ,l4aڮؿy'}W8 6lP |c> Fm.ѝզLӴzB;E~ _ -"|0:| \=:ZTGnľ@<鷀MMɶ:f.! pwٿ1O T| Ћ4YRMMho1j3؄.8NlN*k A঑A{0!! *F-Ș=~Yl9oPuv,tسP`JL"R c-cB܆c].4 AT2LAC"kbwX#<6wb090 )S{Db=G$3ēG ܋G,QSU@+=|.#4f*:].:Q[ zKV| ,p+[1OV|),d45{i"Va7p/n)yýJpi0ZoX/Sn- IuL0R|s]':bT%5Z6{JWoľ+x~hM- xi^ēv\dk08W(MNS̋ Rth0F7L3svtEnY tw^'rj<)rKo>H3$?#vH:b7 < ZnGWݕ5Em $ȣ7?A^ QE4H~;aO+ڝ|3gZQ G/zuqC^.~lNT6t & pq2^i͟}>Pqc:#$UA=F oĶ *~NBW-迕Ϳ@);jQ} \8sgl>K/>l^}` DE;G˧\&h)nt!7π)#x-Zn;gNzHR|F3Ba^_\W@x{΢f߬&2N8D 4MVfa]1AVf*wŶ=n:񯭻\U#F=rUPQB˹.bͪPϚ =" {Xٛ6]#;!n`\yeMi̴*ZM`YЭTF%V+:Wc^FɨCn~JЄi7Íf5žqG/dfֲwf|%s|£_t 5oeZYHV;ӊ&l6R} 5,~Gb*T!@MY;]ldh3%Qo%Lo ۱ km̓Jm!a~נZz]>T7 J w[Gm}! 8*`h1ZwJQn&⑴˥qžV.b]vil\Ƶ;M0j['xi5j7*cFRRfKِYtMOTģHGWWNOO"*dCBU8:ab@(|7a;!Nnط0]WG<1keހjw@_VZ+<2N-yGp:p]u`%G<6fp=~zauǐ^ h]!1sȄ; =?:FOπPWmC<| ՑKdlu vgm;ћ/~AbբmR7ߗ94rf`ΕD} ]np!l_ {bQT34Q0 n=Ma}[q/Q3-=P a-JwH*W)ls־2O5õ}.eJxd_+WZaLֺ! "EvCF!Z[64sjQ:?bxoݫ't6EOjٿyfC+cCvi)1u"J%z-ꞶG3\*N@]'Nte5*򌰌V0 "#+0'/G!< hrV*xl"3i$|pM廌Y()=Y3Msm0p\%u]novgWKG]ͬ;ѫsŸէH$yXNrЗ7A;G5:%Lq[mjDz$%[$q9:wC:Q::RzG̈́Ś՘va%<\e\6r۳}ۻ2 >(W.og!13ܟ#.Qq0lWT58F;RQ|Ԩ[^cZkЛط0^`\=AQZ!\hphҘfWg: x*`N4*>Ek+k^|d/ɚCr_}^{35=34R=⎾v;b[<\_meL۩4Lk:!T7hxm7yC=X^xsA:hl2Wc :?<ςǏ~h|f/Zk#(6Xz'1d,W;E9B? l0x$HʩZT-5tT/z Up4vģH;[SL{&lvkPS[cTaԽ{Pa*łAm3ʈ}oH38 r5 H @\]W((}x2c_4* z2] v[A:{Ѷg󏭍sv;ŬưcXEù̑}'oe'cGijd͍aMe}V{i昖:]НL?o ()h)'g^U)0ћ80k{=c@J]i︳gsddvj6.|ږ-ڂr*aE::ʏq Y48u-LxKY1 wr>s˸wOgjẗ ٗixt Ѯٺ2~ٰqb|79'_\5Z"'Vu>AH|1TV\C(*pjO,{ CjEi$H$(GnW asC֖B῏x$4,x$ uS$r*Ыd$k(ѪW3z]D@cE9ZCƭ@Z֘aLJO8wmMeL=%>HK'v!+ ,Y-͖~&B&؟qz_YzR,Gsޠn7-4 ĮĶ/A!ЇN T]-,Rʻط0;69 "OI`˧n5j@F[b#)/BA/[et,mrj҇dG&v J]58x$ar}c'"z V׵,>fy"-.J$mW)EkhESl:_TÜv> )MKd%44ڽ)S;'2ptvq;jvg5埤drѧ )o`HB}QE:A~lo>4QsF@`JAT(B,E "ֈF1>k?$!v+V绲stZx\R,.(seK^Ծd9@KE*bWڠ"غ*(,W5~`ccfreږVQ+ofn[J[7# Z`8&cz]Bu-qC^\^T&-hSf;bt O_'Atk!0gu,T=|ӱI[wToE | $רּ]ߚ"OJ|F`rjX *99B4&/_'Fi6 n:mR @KI/ЇNς>yGA?'Ey oHIч:o}II1I'wHȆ'5_1q̔y7m&O/ӇPJ(U˖[vHU'T iRњz437 b?@<7 h m+6Hȷx50ڀ'47p܅Ɗ`Z6ޯgT@6^yTmk7sQ3ѽnV3 +լVg)\lE bvs+ʺ3nZn[^/9?Om@# ~#@<7?\&KH5:f|owyÛ6~fp~_q }yXq莄`E11Pbpx98z"vԓKף`ƪ%fAX"3>R f5x{t5ʡɻYb-п%@ (C""*ju@Kqt/cr-Vgp%hm y6BGZ ` ]b΄{yiǴ%kx_/ݦP t kq6qm?m\qa $[\w%vPȷ>QZCfpX6mK [@s!DH\CALOg#DRqNB-O# UF,7}rURGEdh#V4T}a#l!)ˠn hb7#gz3WhzO'+ (6 &C 5ٿ/O-hM#l UO\cpM˂1Áub_yGRjm")ᕠLf}W(*њZ^ lҙMqHqŹ-G3[N~#JHL^L&էr`ʂ?LfՂRiEkUԝyԎ/UVi3ځC=Պ&}_ֽp{y{V2)ǶS|S=ťOtTzg4[gŇ3ϞqY$'/I'd-r@]slIH/>]}Eh.VfjGê'$2s ɭV)uE;Y5M>ephݹ0ȓOwkakŵ#Ws [6h&fu=CkFЄZj$.x S[{;gˉlnRxe^ 5f:edHE7hfb1eT: |NЄT]JF$h4T<Â&˻5Z{Q%*8#~YЄbl_m ׀4aZ%]{wk Io#h´ PH%2Ɇ\D#Y˶ftTO]‰OF,e(Gb`w$4)1< AKmɨk)y2(XDb Զۥ=M=iݩZ%  oz|T8$]sӮZz!1VO.4%ڙ̴2rSXw[:kQ7]߿b9Z= -o;0rf@m2e6Jwڨ㝩f&{*gz|Y* :rF.KG˧t!y2rǟtQ&FîL DQ&hYZgaB(4V,E64J"F/di?9rJ3 zRZ8Yo_VAGj'k~kΙ[5t$m$e*#lU&RW>9X 3fUJ,Ytg2n,(ftgWcug .ݘy*hU@<1 ^Kb$xjԽjžeV pC7Λ#f3׳5bkheCwi|HFp5>V X%rEꔒMf}lr\ch_X-TFCWՆī ⡻.Iv '{*.`QЄ f7dWՈxkNw5BE 5r.7ZB{\wL3H`+9}méZ2xJԙ"O'hׇg/#ϬD0*噕39=s7Z=sr\՘f\N1wIޖpUV'ߪ/4aQB&|]v- &#wF uGUՙ*ԇ*IWJ+MTY]%\k2F{]z<۳&|}ʝwU*CqFRF<pwsK5|. ? ĜuYc }͉7(t{䋵DƉ*C]Je"Ev<%Hҕ@z,2[p@ӥb 3MK֟ _*#DwhkV*+UsyEYyzϫ NCԷi09-bb#<-vSX2ec4$8zFYYгߖigmpHBǁO~B:vUӳmT#z/(S~ZMF{r;wrTPع~np!l_ :5ב9b-Fv ŅJVۢ0xV;c/6z%n~d-0Nt#Z٠O;l;2kQNՎ,)rN-[0 O~Zӷ-"sētC |󱵱63@L@OOv?~czO9n95 J W@_։WGQW:4:w6qFoWʆ"xb֊DFP amV{wq fAg6ܒiaj+d0\:\2%_/= %$vassvO-X* {<[+J3vźR @O>▍\;Sji$m{fZo޼Y+BD.J$EW/Wh}QKJ%z-ꞶG3hAj'n{VgeT.W௰\0PP£&groմ;LLO+3F3 ffzfGW-v*|ԓe=MwБ w Dx';cnee̬զÄtaQV.V Z.D=pۚ`@Gz"b^ "^Ȃr-V,=x="M =Ozko!<E[AbeFAt1Dt:;:t%J-iSMtd)@2+@_[ʍ\# Xw"c5 uZ @>dM!V/́^\=)WRqGmc{壷[d,c|[~vv*E!{Oh'd*x KT+% '`WW A`\/#x5<ƫ ?9y oWOoVgvQú6ndw23K"y3^n4_JGBĬ:eKAKTCKG7P-mUģHC).K|zkCmՎiivpByWjԺ ?8lG#;8o7pDu5V4P`C#B %ݍ|?(0p"ʻ.H,F7*3U+bzlc}0m{F1t1Sqau=}v h89ͷăw(M̺q3L׼j/-q|2WZ  ݽg;2[2exVHo>s`ngZ*Ow]gGκQQ*!_Abvk[h !e(?CxY:~}GԥUИֆr^[eܻW޳[5:df4`<:hhl]gu?}l@}d='4^5Z"'/Wuژ>AOH|1,TV\C+pdjO,w{هCjEi$H@%(ډGnW*T!aRk˂akbx(C yX@@8ӣϘ2=7t]Lԋ'cҭq .vjfae/F7&?#v;[j.cx%0޶Jn}<Jo P#Tlr: IC%Y͎DЁhCZ1MIŔ.h7Ō=^l\Mѵ-/K$@?L[ɖ# .@@:G۫]԰(xk]G@Ha-)xk7\Xm00(׶Xy pzѝ9<ޱoZA?&$J_ڧ,g~,>UoX7#qЏ'麗] O.~d7E TT[kEKm2r_X>O{5fyJQbr/hhcWbGLwE">&`⮈YA9vCBuŒkNu%3/$[-xLm/Ѕ~꧁ۧ_zR//*ʴ^*JiW 7ʗbk[jHB6[#ԟ _1z$5NH@>GvoO͜vBHwOm m3K1 VϸF3UFݔKx.Kt=П1/);HXDqS]8 z:vienx C)Mr,S˟LZ7%:/%]Aw#8bI](\\SzI!  |)e;2ƜWmќ[Ӌt I;(vxT3HD#Q xSLO-o-5gY[@%}gE@<;@$kwVvkU/%nd#'o}JZj&IUNc:'? =!ΉugAϦI9{N9Y V; ,Cf+8cy+|$S[6`3}bo`6&DLh͢7oo5h ס"> xҷa+}–P$VN^půņgZ6,/͒Th-yvJx%+ӷYb@@(1Џ>/}M)kwMVXpdZ۩k kop p<;@o*xY 'Mt5kkβdvAOnTkAЄTcO8;qxS%J%r 7)OјiML{4-[l%$%ىc;vR.pع:;q6s_3{ǭ`^zU]lI5w p0zg5:̒ 1.*Rb:'_2aǁe˜*M/I旁eBEYFjw,q׹Lv~g\&I}HiV# Z 彥5ٽvE؋OnsPmF}OTM3W5!\ylc2WLg߸L>Q.T Lwoɰy.*|OK2UWL~5.ϵc4sVg`_Ji.#u.# 0V;G4{"OLt2aiWoL-"Y!vAYZHl|]K-:jѲ,2̂YE@QELKr>pdt;p7ݱ!6 ޖ]h;֛꿡h ;Vsw nl5zaek̨۹c(r k[K1Fg~gټQC36S}L+gNL؊Yp [3OGLR)VaϹ4zMW+4md4-ʆe#r4IP~? ӎ&EQM49Dg2彶w4>v*Mx/iS>! I?lyoc+#Iie|v`2}T҆˗_̳uM$' YQ.ȗ9h8 $Ρ$''e{֪ͱF-=23S,Wm'zBT+Ԑ**%Ө@inS.uF*] 1auqHфl%J!>U*7T9{xX%T#4^xa_}у.hv/Ju wƮ9rVVu)KjN%4:uSJr]g5u&W]~uj٢E=mV1T,²l[MܱX͒>R/ר6<e 级+Uq).^u[E]\DN"g@2ĕ8s54;s5:sJI̙'Z3h͕ }kV+fܾa`U*61qѸ)݋L#cq8X8ݻ"%xsB:}Tc;I6lGgzكy'2 UUv2‘lC񄝐;[`Qj,po{FY`d;p-䵱9h OKa:MY_=3Tjl3@;nBKi-.LLJ"S ZcSeILt6g-" W1/ VŨ&\IOB?6FkKXf@gokly,bȴUzzo%^ R͐P]Fy?Qomc=Bs}rt}!ՐW@Po`}sK,}#qX>Ä ==|졂[OC]3 [&Pn|3Qd4ʕNWrPiS<²VqI[D.i!pe2KKC"zt^o.AL6ElvFԋR4ִB_+ .EzQM'AxRP0O*^1z)jv<rBu[ uAE.RY@\Z]V7\պ9tBGoKW] ۶lSz95pdzθ}Q% OYOwX6x'.)k54 cG{xTѾ7o UQf ^fcƐmTإ=3O?|S4G>< רLdgC9eW.ҡY^OϬ 9 ;W1J̆i9][ g{k\+J%;{y3SksgVӐ?"SZOѦ6nf=(yo^`UW354>Q;Sƴ6ԝq~3.oh;r Pp~Fy|i˸O˗C,nO2ߗ1}cn%Q?@ZՖOb)d؋~#H1TTRjϒS9}!MMs>KsI>JxHSKn9V!=IvƼx++Ɵdc_-"p$08׬MHeured Uk!KK]B ,50c^bLCQezmKg%rYoS// y'F69zG ?YhGW+cK,lckĵ @"VB !R[;!]ox]ݐw'7꣔Ow.]O5 x=d9B 5KZ̝Mݗ辷"\|WZ*'lb[금.`,X|a# o~b:*nؓo0^9.qŬl+€lYIp.o’ȼ3gu*୐o<5+yz_Y;եn@mН9 1nMRvCJ/w@>^B>$rH@\ʞtrHÐPGĕ_-IWHsK%m|zgkeݵ 3!WHL+l`񲺱wG0rtj% ӆȹ(WAw(c  "^!\(ʹfA~ Nː_ߒ1*q%ǨN' "}?FR@\1q]r~lQ}D-A|yђ5eF}Eſ =W;A߷$ (l Z37 |Jr$ZD:{ªd蘈J}Lt=᫐_Vj z K߀ ~ eoBMņLPq H| ա;: U!,z_#F@\IwbJ,? &R' ;Ba7o¡E f8vMA>Q1R>°]WNM4B~kJIA3Xh\6+-zcZٰ7~faTPAxߔ Wː:NΣFmw@~G"g*NQ#5={o=+wBڙ0aEU(z ߫7^[2+ iK c"߇,w#a*ĕ7[sy n]mqw:1c֪Gا,8)Ւ^0 ϋw Am*EݴVK7ќ_,71iQ +uM6-G[0~Ӛ9eԛnhmK~DG߲[jQ5rc>ypP?ǐqnV]w@VLQqwBV,C00(ە)H|aN$Uw?#uUQmIG WtNA;*ĕ~#K&A ~XgVhày{kE޿NWC> D} ?|'B|rdĕ:C~8}C?" Zn&8MI%uկP84mꕂLjCc;콮GsGzX|w)]̛Q]qy3yEŽ]+vi껨_b򾋊~]Tĕﺅ۳j}W!`F0~4Y+9bٔxQl/oT PzA}B wO^Xmn-^x=Fؚ & 5˴0N=Us V6qkEE_TWMlp9NN;;"/_g$d`@Z1v5gْns!Ot=ŸF}Fڛ̈ Mxwn3HdFGYϊ LRC6U\ͮ ~7%[jfUѓ,DBuì|Tc+E3fboXmPqPY̒OUieԪVjU8[HX%aCk6V^*L?O* 2LX4cf7 [ -A&={L !e4R?bڍ)) R9U%[jHw%B )9~t+lG5!B q%w* rԷ ;;x&&"V;!Kd-&G '4&$Cvg>wXEBw?Yp8FLA? ] a@2h=gG/Q^\ERÊdKmV3K+'b&N}_,7ncA+dd? wyݣőZm2(:%9`zbbJz<54xj(E#/J ,y,Ż/Z$t]z#lG5m#Lګdz"򆫡7!· o!7QF#x|>[;Q)RwV!su'ުZ O-I0ŻA{19جA"aҬ;| [>u'.G9_^,Єl*Mɞx*dY*!ӪӊiCZT55Vi+H9z5Fs" C+ZT،82E 4\'QUeO%6,*e(*c5IQ_Ŗ+ᢴkҋ3].h/^%xjm%4unv\ :ՁUR hޟ'WU.#;mNժxbC;sTItɒ?(3o2a wm\&jUGrneE(mv{8/q; Rޟ֏ ^zʗt'`txTyq?1m.oP㽭^iţżb%`1b =m~0e^c\&釶:kIG=A.APZFǁsPqH*e.r/ɚc1Vp.㯵ls̤6eL y>dZ*.,ֵu(SWOrXeBE6au w\Rbdw,Wkz5TXeֻڎ-]\&LCK\&|=Kˋ 5_gco0e&:r)KT{2aF2 c6zVۚ*zָ8)jrQj< JQ N{˂9I+YЃ±s;ܱx7,7:Ycf18}ӅxJTγg̒1R/z-=Shܡ\&LhOp0= %x\Ό|oQ9p<0ւɯ70N;cYy2 Չ!1Z{H_*n8dQq@q0iLFٱsVrjՉ !ut7yWɝN~o􍴗 'C<2e43\ߏ)\j1Jk)asoU|J&/x %o$FZV rݯDD6g?? a?[S^4^ E~WK8V [{| [Fq  KmnУ W*tii'VOZ Pу2-.aD\&y"y\&Tfj2KkLj2 7r% x3 7g4BҚY 2aLբok m\Heu ^+SRx˙rPqہGLS7CF*|v&z,քY4K/C/Q̯`ֲIsk?Q4GG :jTG2 :3rnf2 Y? IY54 uV@RHfBg,"fՊOz+hI1d}*ضv5/0-9㈼ހp'^} v.TxD&u|WE,ΛEg]T\j,ffK\&|Cc\nd*0%.2a\n|{Mk2a 1\֥v0푃c&3J154,re"25̢Fd 2WD6鷪nBcKm)2Rws*Z" BF'<+e7FqX2a {2a 1)I%.*RQ3q0 < cjGf12܋7L1#:fSG5Vi î9NN\WA^aȮ'6k KIPq5Zl% 5Ƨ e[ H,YNAthAj5d WV!W1ǁOA~*1.,4(dǜ~iɘ3"WÈZ iGh(~WZ$ m&[jѦ:.ZNO@XuD_WW

]YdN-IM%]74RpjT68\o!g.?!g:ߓPi2"ěL#NqY.|dxs Ws0zڦ>Mif31w\B^,q.سɏLceBNex+ tPYqB̕^Q2?zLE&?r ,y䥨ՈwP`:r8ީd%v86PrJv>)H;H/Mf۴W-1 ae=k8b$ph:z8y,nBO?VBag!?+ͱ1w_8>"~eǏPx2N_ k/ALIJplMLu):iޫh)%OA)ei!NAt::_v{ߚ) ]-ߒ!TB#|JT)rN!svުZ +uPaw5>/0Gcs 3Y.~HI #:d7 !KTFrDfX\mI$+- Vob9"@c9e4gU,R4V-sEslx.RsT+ωt sT\'=ߓ~bM^o3Fbbz*V]ۼ0cqP=ʉjzC]cմ־.tjӊ*p@NhJP;<Ho <9!=e>w!'AYgcz#/)7l+Vrr:V]]z??ڗNH<_~Wұ뇦c/O(ұ 9p!"ȿ罎8An꺸=-. .V=.mRWpĻ{A{⺡\Kd yHG]J>^~5]8&dR~>5pUuZs ve@[q]kcZT'.L+VWu)toRE'7T+fsNJ1;C>DW?N^)7^ӊդ:<"N'#,0ыVAF9ص]7zx3jY7MJ?ݠ),R}Uɡ_f0␒_«aJ~jh2 Ԑ:SH71VUK*RxwV4l7ʄUWv+$HqQxowmokMSqF +VZ--28h8L{e"8j52gn𭪖'R8LSg+qAc5C{OkSܽ ?ptx>!?A~(T{P/Z7᭲`qIdhNwi2LFeqJh(YՐ&i$5j wɕ:Tcݟ y᝸RpR hffWj[̲Hê'ޗgoNS3wjOWFDHErpԞy&xw %k2yV(ǷhC>_>Rc}-0+]L|V\TLנaԮAzZ<]a3mC;Kmމ)jQ/4Yg=DTFΆ"^Ok#|;θq֛tc?k\ 4>mT;?ZHܼ1S7Z^5sT;Wcl:ځ+LȤZi/˄1 =*.yQ\uT[ث>+oz49mNi=Sɬ*#Ǎfh'᭔]+`r^:5;LSA~,}C?. .E qq2tORsĥsgW5cӫizyrZvp=9-"{57*k ae|*:d-^rLGr>) 3B Rqg ~izE;dclrpmA/eIѳaII[Qg8ڀW;&p3+Ii*yqLN;FL6&hvlT`!C|^]Ds29IStܪٌIdњW bC T,wvPZ۶HvwBNJŐb .[ {mZ/A~IV4?,Z&ŕ;Gr7bI,_~l°GB0 MSw#u*ĕ6a:]Y"i{y1zV ZvYcFpsvCsנŎQwR6&/@|orVzoB^^|Iڷ mߖ|gBŽ vo%٭=`_߶]RY _P7 Pvغ 'ș[#*DE )^{?UȯΩĕ6먦WY=W1JDnjȫm}30_qśYRS .u4]"J; wjȁkORg nkݐ&K|qg =Y:_nAa},š:B5@Ng|u '0m3(7kuĨ| Suu yR/ٿa@uoG4o\@ӓ؇zw% \ͳb*MIB鴆k@9Q1uȯ(~#E$lC XmkTcciJj&!UU-YnUDS)QQ-;+$ikiKŷ /R:+ebqŬ6l zP+鮷!VMՆxe%3a=l`/µȬ ?)W0:'ISG>ҧ>a!4xz۴"3;[!Aזi7_ 5Z'5״@E[h<ȮUqӛnhÖLA '<@ heZ:=#Y'aQ&#hĂ83fNЙ?ǎe #b>˭! B ގ7APs(G5?re1PO5 "?U<#=McP!;8ЫmaVvmcvvQf"%<5#u)l՘2ͥFJ&MQi]FDb?ܶ9m>Nb.6G*Q}RYFbVݻ"?Sx3~GɈY)f=coO/'{^gO:cIGZ`AQ=ƂvhYۚ*z:)=bģ<hNgN;8;*z f7>؁zcjxB!E3}Tc>AhYJf"%Ff'^{b?ЕJrV/BOxAiS(G5qø8sޛӳTcu8|s4,V4R|'ծc"$䓱i$Fr m7lը kI[|w7e<Y>4_G9+iYZX+zH=KYsQ0GM/d&#?ћ|=!6{D4m[r B4zÌO4Ԟh0™ނxK: ~"gq TDoSUEwQϠlոeZE781ע6a.`(s{J"S#1a .oZ.hY 1aNhmendoQ\c~DM`~#.b)8װ>ީE~Oŷ KFM""'j\y2,̟7& )9\yEJW Kf}LУ{MK+g+N^?2 i_ķg&&/.΁[ nݭޏ]e/42;QWV"e!)=cNXzUc!|]C}~}6o> n _F.$f^PmQK:_<#hrQ2G͒+WE1! )*zqIH©gZ\ YKKQBڧWNںo"\uS2yu@)7A) [LMi+_+ .E s/) B76mMi#<@j KRҡİV6iv ^ C7Aޤ ,vwԁ]9.Ȼuwݐw<-tOnVtOw>R : < l: x?c+(t>t"b뀻 K 5,*v7pP+,d~AXHHF-F(?l6tť$Y+9،0 " AK9"3\W0g*=eT5PѴ\)Sz<ۢ;5+[[!ˇgL |O:<Dl,w4I࣐hS5xjjkH6 $>)Yҳ~y8y*/B?zI%q){z5!vMNĕ~(+PC[py۬ŏ1GNGvcĔۢR+OYSdV-:%O[$j6bh6FdEƨ3:X?sy 'jzY|7eh6@~%&DB@\7h6˕7!RլښnFu,Z kr)zӷY*[@\+_WK@K`+-5XdkYJGh|yJK>w>\d-ʬ[0 Z2FG͂I坂w6fV Zq㟿e F0n9OռmHxcB1U_ߎq?-Q!,OMSS-ԓ z/z=&i[ܿ٫)L+] ۶p^<r^uG6}u^}T=:);nS=J@E58'jFpHa 5nJ^֠.( 4˽T2 װ9hINqFV`kQ_< p+Ty#wckTy#wRUih )Yc}%Q2-j 뿥'< ee[F(v0 ]!xFx;Z@aK+x3vRެ0!Zhgmk4YTSz( m6+~XK=8u֘QaAT=1BϺ*&4!P-P-Q-P-Jսrڨ-Q+Bt#IJܛ7GiM߁"t[n\\0xyW=%ӕDF`r6C7ft_/sQAd;x Lir 2ojY|OXW+Ԑj"~1[U3ɧ\8D T{OWOUtxuӳ?:{EN4 [+R@ubQVjYU `TG;n~z,'tq*/+Qы%%e>[GBv5T\X\y$T2YnJJvSJDb |s(][1TwON;;%5 Ƙn"羅cԊ Q?ڒص\J̿?s5Dg?+C<~ઌFUHQZ61VUKpȚlMBVu)ӞkE2RsܑŞ\0ײ>E|NE65f j}`%l͜뀷puu2ĕ\54ue<JQ=B}qCUo,Udݍ4,eOXUb_p5#;'_z\*1`pF.F ubNٸbVAT<qMc=G5Kgv08KZ)s?="umx@ն&LMN_{7CY =&:CCXQ4xr"d)ȧ6ꦟSzZ+a tEŷ K:ҡ O,"݌>,ZѢ9X fWtTGfe4? QB*Z1̏K8.WZVZ1yL05#|jz" 8'fOp].Ϝ-{LY 1hbHk;!o2:% .E:Z EUH!ajvvX\@\FRzlNnO[K]/.`<{c\:>l '_-'#p AFbLba .A īTBH o[ԫisٓU­^T hIg+} \RƳ )e'i3ǮڦrjGlhHyeOIfnJa5FA8\?Pf@KX@BB =D6Sm<öziy^6,eڃp>Ҳ|T;̗`qx9Dkor2]]t_٣\+ߤcU"'1C]CJeθvbcrDH)م:_6cי*[%kl*sd`2)37CTٵ]gb[Xs<da*#f-ڱSϓ@+2K0f^~*C}8.31Kt ցmdXs2Գ-FAS nqJ<'/)v}BMHHUۼWHFW4zf< y (s螼uHoCxwzտڱv4ؐus'r9Qs27R~} EZpDvk}xvg ?l qx#u&ֱ]ל Z:(թz'O.ૐ_M_| k h j5mٽovZcLj[yf/51J%m?By$4Gs4AS <9.W1 8 !<KdɟmmkiCŷ ZeᲶ[Ctrޘpv@u \wݬ2mcɘ#}cl o6}Yw3?v όRq-[ wn8Wg`a;Q[Vw!e 5aBAն*ȫkyDY]}\J^V@\4T6I VP`zԃF5bĥH1˜ZSr::k,FbٴUC_/ .EKmJNz9e&4~#rGCޮPu閂]'EUGfmZ& 2 cX %#ނp#ʬ~a7CZBqTdСCZ6CjGjᴖRAY8K3+|)mo6< רLdgc_wQ-r0Y^OϬ/(+sN(vbj?!Gߡ~~Ǚr\P2=kġnwxţMۣmܨz^%Q6^ϗI-ь3{ȁl@%ŢݛzU|/>{._yzB۬AWfYyK^D̏QU$[˰lG#bP칃K IY%{ Vbxf2as(jD$^#R{R%mUuH%Δ̘tmevqI6WJ'4Z|I sRċkiS N| ܄ u FHn$V8']w];|`-[!o=,8 U$qT: yOl"vG)78g^-i1*p9-nezR}Zy*ssy9&U)ޗPQ?pP,Tqiȧꩱ.qVB7}#3RWp0O/sYqpL˙.q*୐om}C_ VOɑc/ YnBߡk@>w;gf%Hߡ/t wW}?}~󰀸wV0~OXHpwfrvcMQ0Gf\d8q0l+whθU+Yh2Qݧ,]!,P?=_ Q?/C~9&͆ȯ߄O+& fUMhQ}S^Pi^pYq\/Z5[3JF٨6ۦ>RbM$qJQaۖMNau' V Ve,"Z͚6Bωڔb~oJ|?37%*J) KȓlJ77%J<%Y#k h&!j~[ߢ]UqLF$rv @5hloxT +'nH\ yWaaE"ВQg#l,񩪅\?3@Aϼ x ƵhoY@\7Kio%u㏐fn[Ƽ<;BØ7as/:ɺ SnJ<|R{N!KңPq@~$?Xqoab1zJ(X4i)"ӿf8h<:(Y(ӑ)Y? ?Lsi_HG_"_9 fF 됿LYEFS ; >#TH>8:o+`57g `5.;<` RMMxJC;2F!Wr:ÌqQqǓ8T=q" OOBV_YSxFŝ>939}<|ܛ Y<,@.E*'%bA>T-5)<A Bۉg ?SsJidLl9m)z@+htc8IUK=*ICse_". +M o-6aMT͈>&Mvن5aؓFEV .U{dafOr9#9Gm).^͢]?Se>e$q.Tʚi%Ԅ!3e¤Gz;Q. RS GsJf:۹$A mVň֎/}F w`  | {Yjߡ9FPz̕ ?ouxԉbN![am xPt } >y{vR_{b7e<H\ %HNwC)=Jߑ [[tSYp)~t&-;okf,oԲFn,쫀NeF!B5H")Qq?bRt}2d ?s}yȟv?&O?e i+S:m;Z0h`( zUq4Fcf˄1 B*ax ShA^._FTP+t߉bq0肊~tq#`FRmhtR+,EzDYbA֒a!Ofnq)z|]-e/ilQn`>l-CqS O']kB-~:¬+9. 4^ "\yM=Zd-B1r#0xx۫p[^z壢+4؁imCmDi=]Z&Eoݷj}Td$:XHsCB:4uP2I7uhD3UtsyS5X@kW6k45#_'@(b!k!?-[ %QT&IU { bVG!AƵaͦL ^]fs2wAoEo{Nw*kgB$9hM xƾ|9H($Qȏ&? :y3FWĕYϭDTC|pl],6{awqsTk&ˀ9ȹYR2vrLۚqoݰDffĺK Kr $t s8$-^Ƚr7연r_Lĕ-onHԖ4s$7/K0]#țt@Q_응n\\0x҆-/n͗G ^~bҞ;<͸6րUG#~!4QD#oͨ@ߘud|{F:B L${N}Nw|A*LF"^E{*/%eK 9qI2sx+kK-@Wޢ[W9\Dxw5sFB" [8;e؅K.h-dNoꉾ;Y&Rqw@~G*NqʭQ6̺^?}U㛂ZF oJߊҷ`%jM7\֦zРEIиD{%p?du+$QI':SO6D41R< |{ * q6r0Y5.`h q=^ |x "s0Ȝ聨N` =j'( 1mD n5-6lKFKn;!虱CÐ+ӇL8brx T]!G!nB>u $z8"a3G O+8< |tl檩Vƀ KNxi5bNR(ռI>2e8ҫU_,SUĈ?l`%\%CCn&uTjBSk4&5AZhyfIEf46A9 m68Rq{@tpf>:9ϋiOB~2՜تyG؎HJH%GCBnX#/B! R:!rlm+qJ!1MfP~EoSB1WWsgkLj3ˀ3ZlުeA&6!fN;09+2"KI>ʣF(0!.g5z=c=@˄dѓe $l*fv̨2˙"G훹vҍ @۷M״o[Toil3X(w%M6SH]ؠ6bGn7 )yϽ{3̮Oi{,vqIɡA@aw1/nl<1B[ ?)Sg6 Aާ̹Hx!2!09~!E9|%tpS h',B.Ni}*BUHKdU2!۱U"7Or!m4M4mOGW[-ѽ8a MPi*& ÖjR?s\\WD c(7O95ȯ)Sdbs_ '9!y 8.5)Oex4if_̗/ϰ*=jKO \&L;vRǖA ܉H-܉[T!U(!TG;{ K֊w?q^*SA^O)zkO@kFZr\ jǫ\<i ÜeaeCwjQ~w{[Q{O"xϦדށyRuoSɛgQ1}^OyWVղÿSezhҞfNlEY*Czr&K6la ,M}qm&MKoTXX, ~P=״䔁 YBC׽z /Zxcv.*ScLpҶePlήEY+7jr4:(#z͈|P8F ~rb.֣1H))s=&AR "{7ʺY )w  v K֍n?99 Dr0Y*\p K훉֩ĥ'Rs ҡT@\1ke^j얁vЪk/fԧWҔ:+޼73cFN`ba`kTP[@"dh$$qw8y*//ALW[wHy6*gGR179V6۶K= | s߭-[ws9s`kΕ/)݄a~ૐ_Mw__g1l9!} =m-av[C?XO䇺 Bx DvBL8}TӐo"[szEf(X_D87ÀW)/!¥ϕ8j; Nk Q1,Pg3z-H6V.k+>oLMZvtr*`ַ=x6so,om}l}tG5x-4wj ;gFjfs`-Gw;cWō<9b~eEv; Sㅜ]sf4!8X-j̯o=҇@_َ f6`aTb3j`gO*5yt?5kfVSʜn|Qd4AC& @_}:⒠Sx=dJ ,u~^/zP_ݎio |r5R%h'K65I;)w@KBesMԜٺ5F%qPL@\1keiG3s5Pҝ LAk!oTfKu0FE .eF:Fm;#|G\{0ُچS+ΐ]u\}JѰtr٣?t*?*^tAF7!.5 &%8-XuסjD$^x"R;ڸvIhpcUef>lbOBqI sRDep)2)u=tmkp d[` |OHzOQJWzZe­\]jG&`?~i;j 4b oPG Aw@ޡp\sXҎ3h$./{jMx+.z $_1kEbb0`"7'!DK˳"ؙ5zsSDl)puo8y0*Nn%I/gF/BPV~c)p-xԕuQ`r^+떿>!؞>!Yֳ~(1ȏcC~<~甓'ĥCϡ:OB~2ĕ~_(P`_8G`a9N{z y깩)هey?<3}C1Tj/ߋ.$Z7Q*m^)U!|ZfC WoBT'ĕ~`)nBRm#cl5+,fF^V5Z6vJm[@\+_WK+htlJ~%ޠkɪ՚utb}ŤÓ󏚶jْ>bV@wAKȬEQd%1ǒnK;$pόȆw#:451D[>|eR=~!]S5Ӑ?_~gb(jF꧑)Q).VUwN?\HۣVdMַHP=Q]}3LC_-j8l '^Rq_/h!1-jE \Yxw4`;{ "mo͛B_}C.]i=ç*6 ^\Ƿoon }cֺ9Mݒ 294$2}kW>U x2CRIfߪL>Ri$jEZV/MSt EnuhpR(xjP{ ߣN%ч3gÐQ Ygc$|B3}|!  TnB@?+jz٪Uk֘Q1Lw*҈"`?V(:((:(:Ju& [sjQ5vD Yj3L\VFcJ5筞aZ -+QO!\Sя.$"[[!oMZ %9~D7_Ve:<<,[E!mi$yF3 u$'[ wB*nw%k^sVZZ5\HU{vpd]nq'GRzZ3/UP @\1 -?O@\*hY zսآwT|$o{\:1?w]l=m52S֬'L)MEN&dPdG'M[dE7r|gEY}b֊@ORYR9 mV Ÿ[ H/k2:%1u8? H{<8?X۬i*qq)z&)rz Zzv)YC/S =TL8 Yj;D`@ ؃TYT۬SS)N.ENO<mV IOŽ Y)%'?1yB۬q,%Ÿ H[w!)RջP Kϑ_:HlfC_죚GB%m2$>k@EaMfፐ rpu #djv\b^e -ByO!I'ckLlq UC6p}z+A[PyfTm܁.k,D'7B!/O_'=qUo5 &c:A f1,?W]ۈ:CGgYyUC~_Ue_u_IK|%ACmSg7xHUP`W9ZC_' .EY8THQ5hP\jĥH56KAX⡟ oN_ATZq)RPg]<8g`wx v1.B?v K.&yGw KRuҡkb&!. !&efvwX,h:uK㧛~j$'ֺ^a/ȫ$9.5d R'ROQm21\?w ZG\} MB?cuxD>anQHhiM[vԂ#4]hi:${E?{59 N{+[9fwOod;#OC>J +Dѳi̻!wK7БAHI*vpdxW"?{ $7)CL+tP 0@]6jK\*h($ ؄!i1+|n᧢Z`d9Kjфsshф-h`>&ӢB 'r\ᛧ&VBُڮCG@* =:?c*}i}) z~"ʶI+]xCkҡẢ?!ZQqSQ!.g,g<5YCKf0Ԫwcc}Y4`rpS+y2~5F?xtx e%3|ZFMȏ{B~TApPI>[~TJ/M&=.YE8񏈭 wDg3p d(gnnE8l[fdlG IG1{wC;b|*(d ˧:!]>ws$NUδ#N+.&%{]N;6*MgD9.jjZa?|sIEQM@\(=n-j8)),1EsJ֘EhWw^ϳt5 ΂*MIKOrQr㘠^="i.;,7,;k8y"vXqG>IT$9)SYogyG ${?[]4dy -} )ȟ ɴ/_B5W* e'!d^6jA1NOCc *gĕ~1G2iE1iA%(ÄC|MIᥤ(SHp_<YjhP8ev> 4 *nYjte U W+C  ,{qO/_W} ȯߗPW}c%RUFpY۬91'}NVYG'e~קoT|=}#W4[g lG\e܉1]J/SF#Gtr#KpTe`$6=ogGFۆ~rHN{p;~6b%g|GE'e)> ,ƶ|z7nX4il(*ߗKsp_QD$C/dVF#-g$VF*Ԑ=j5"LoU9lMVgs9RsxjdɗuZ0y[юF]+}S56?:9aeu9I+ܞ胤,P~xwӟ+c"t TGfe~Z&c<ƷE+f:i=DoaP?ا>m}ma>Qyk>v 8ا:R| 8)v|X۬cr=TRqņJSmRzi]C)қ*!?n_n|omke*(ib6=;!ߙ|Wlm;a?8d!C3rsv.ɳbD쇴t\W>zUp3N"hz!Me)GϩT! F~Òzć )9*v$h(j|+ KN  TKZW KV6Rഇk!_fa*mPĥH3+GTLg[㔇kfb: c`F qBJL,k(jVDՈ8jSVC3Xp )T3V*#f>1?e}֪f>ZՈl"b@i3،Gպr{Dx[ pOZM>I['BKNɉGˋWA #etA(,I[/tZq)'pEN4/^6lbc&}+lol\y㷘dZ ]nEmo5}Q%qPeY+ OwVCZM; Pfҡ}w]{h:fj y2,v)he(-1qǕiK>#IG/h>6+Ј]J/E`r9<@H/ F$-ߒ^[ce~َ { )ͼ]+<o1t$|AtLLG_JT3oLGO?!^tWəʞ;ԐmJJoLGeBZ@LGek[Y1D]@\}ӕizBg'-Jw,.TZ)nshBʿV7Pa79YiPH3d<:dqkrt?1|8ზK7DI%q X7n:RI\Cn$;R~{fz=Ǫ78,EmCt:?5%9%W&*%끃kG[; Kr۲N.ȻZвE%oM-gP}^8&Voɷm1^7@&fk[!˽*jT6.D&{ iAz7ZۦPn mob`ume 1|#3Ą-gP-g,5Ёo E gLHpZLur"T7hǸ8߈JLEn_,OeLk}|b!/W:,=nBhڶɻP z+|afgE53 V4g" ׂ| l7P7`BǕhBlPGo B_i4w gܟtBOq3p1PՄ-A D ;?_sUlQ(T.vqIt+fHb3)bSԅd.Hj.b|Gn@[']o䜲fVwq㻹ȫ du];!ߙV|WxeZG|&Cn^|bH ByHG/G!H/cq㪽X}DN@HG+&pdlբG.M[Jim!?v._Blײ-?tZ^~ QˋCqgNB%/_n~uT\'OIq?̻sXmEü|P%}rbvA>O|$yOu," +}'F'Lܺ} N;,tAVa>>,%Z fr,Eq6Jj˦QOt\)7ămOQXiÆQb{ Uesܰ F_Qe,}`il:>{%c_ߐ=_.ߍ{FkwӬ6nMzgkX׶J3 kYH9~#DbSDL?_z?_3'V@^! e1' %xg̘^šKYN)lS\3\c_a0jI\;>7 Y.q˴4QQx^U9 !V Aȱ0Hd! %u -xQ+}(k*~g[>&6 E_LG/?/`M | k\T\''!dSJ?&p-׶I0^Yjl fD]>o`+ :̈TSK%]skѣR7*^*C"i.;,77QyحbUN;ă_>k1pF3 |srBը] zI+(V")YK -} )ȟ^n&H}*d9J}dlOBVF1PcPqT+#˛K\6\fssLpӄ%| N'!?F8A !@n oDUy+SQQcSXCŽ8䏧ߗP/ +龄Yj]Q),%=ܪ=Tۗ'd.ku u+,Z٨NT%V+d-y큝V[ ^jQR]Zilna>l-Kٌni4n`^lůfV ZpDe =KPjLGP8a|W|z!Kĕ~.K[TJv|w5W2%sܲZј0);ث[1b,T4p]2&S R ģFD~L>ڥNu," ]e}Fl. h|3}QO.S$o> V8T[N:k(q#N@EYˑBM| 6nkPq9ȹتZA[!oUBA),A~VچckzG7\öƌaS N* FZ_Q.iY3gkuאxSDwIȟ~v͛t"ړQ_ n\\0xyW=%s~F}Ƭs~FTmrC  I]!I?UOI@xrZ/O7T45VՌg)N#QZ|0x۴r{rpZe~1{(,MwNΛfTZYAn5ö-o1׌D:לAdL丢E9M M׬z׬WT׬P)Dk&5'Xjs׬@Ż o\ն&LZgHkGW-1GJF ``l9LP@u+fNHT" ^95e8Dgp#?5M{5]suzЬhZ90U7ݭrժл=/Z*Xmo׷z!QN;}&/ |jR'Yw̱.w?CWCC[ 29h`A9Q,RV-s9s~&8I&:#`gL N5^,jVpadLꝶȲ^6;(M.[1"^6mժcx}DGk^~ŚBf\>sBW1%.gJʨ/t\ a5Y;s)6 g,oR4 w> gr0ƃ4͌uha Ӱ?# 9еT׀2aL|Z]MxJ .3'J)8co8E5\e/ wQ 25#G 2#mQ@JU54)5TUdf䒮@5R TJ#jNw.W &8=bs"kUJS2 긛r)ܹvu=8-t>eGLvæLH3K}:n) Pc* [6;3R˄ih>+ʬ"˄2ay/%.T=\;QfUڬP^0c=҇2a #y{ܒt3u.w~ F轙Oĕ F~k#L2C5EdH3oUD,@DqN+9\9*"%\0~a kbEv.{bnnr#o rԞqAIleSLx=lfpzH:rl:9ӌyQD#\AIbNS)1r0Yrg9rhF\Hgּ 2Tᲇot'粇)(ⲇ9УaTJx7̯nViqM?D׵nfVi&l %۷F]͛fC61ĕiLslqP3wzA9F#avBWp0#_(v% Q*.tw5eV4miXkFO7UXsLFu EV/ /W2aFRO(WfJ V 2פ\ߪ JWtZ|SVPykKfg:nʺg22?/C\TB#t)V]*a]Ss&ߪz wɕ:TcݥªDJJ>-0-b;͓ "RK[ҋu2ȑ_S#7 o!SF#8gZ>{L"WF*RV#saM U܅%[j.Li w3'YnѲfEvo=cc е\?$$c^4/LRR͡)j1ӣ k#5ozbѴkoҵ}1FSw./ɍmJ|p-2AJz 54jHE-j$"j -,yo4Ż:A 0[z`g'dç1j쏕5S)LxBP.4E;2z[7Lxu \߫}] q5;Z%"w4PGdwɕ:GG4Ż:S%\&Ibjq+LSTl'SDaSG0b xUM--ZTF#;*ч)#S9poUaɖڤSg/4ZY]Ӛ>H9/5R_ J7 UGjq,cjR:$ؓpǞ\s8v5)}T%fL22* c x 8e«\>L-D3CNT ŝRQ;QIMZB;Kmމ*2Mn>ww$1÷ E؂>*F;E8-e.MAs-Su\S~ "8#o u5Dx@| 2axCHZo|%8H&:oƀ{Rp~Iퟥ†MJ5:HrG'vǫ"W}(ȣVDD8/*E[Q\qkRdKm3K=}u:ׯlM\W*$OvaYO}WWi#`zJHE42AZ½mrm՘xlۆܮh PE6w+ [?%BKL([˙6|8SK>w uV2%sܲذ 'jY'z& c9H }uK^22eb7s0 ;|˄1mZcR4\,90[֬ɍaP@es9 \1Gj{q`f,?&h Vзgh=XtGONnUZ AN*~R\/'ܖOxd}?sj}!|.]q̬2av 5v K]u;.{Q-N^~ҋS*qzu“^n j߄^?`UFYV)t=mĪUE{[aa[caZ ԙJ}Gu\u?Z9ClrYaN^襩d4VL=5[^țw _vԖ#DO@DA'!ϬԛJt/N)ȟjE݃v'n ,uV͋AȡY +mw}f|̋y"2 K ˥ 3kȈI76ȷ%24Z KʦS質t#:dy7ƶ{ #'{tZnwܩQ/X%6*R6jmMF 8yBۂz]/=gUmr=_ 1cݚ*aC&e' Km7ԤJYȟUtƽ/; A?>4'rK<>q?C (y3WePJBdZ>#uV^lts'Be޼zQd h?Z|'tAEKVU ^-m5[gsx;)nS+u{JFuG!MGu{ uAerҘ;fXl`Z bѤ%1D8ݐ߭LKF_R:}Ð?܊+c?yނ]m-CvK6.WZf}(T p#-ͳ9`r.7^B2jQFCeNxeK YբV#sj>j ^ՒlMV3M†`a $цC>.Ͱwo>=(󛏑,q^ڰ<2[҆|>wMJ¥kryڿRѸ4qr?uƾ/DOþːY.&E +2ă4fRe1 Ǣ"[r%mE@$P[c&bi[,ؗl57!SI0u,gjBv%4;r] }:՗Lo-@fW4[p\s|5H{B͛9[i[073 Jgo2U1=Y+_+C\WC#xC>U+*efߪ u ܍*2i[ɮ1C#f|`wjem /~>y쏳v*=~/ Kd9?h,mLŨyȎU}e;fiQ>fh6`s(J V4S'2ȼܒ |)c5)_ X/W+ӬgiX*$WB/rϡN7sWZUA~4RjU;Op v 9h :s߀gͼk\p%wRterlo2w{G7y+jhzqjEu U3Т ^K$[ RwZxw!2Vfc.j_T!o2U Vߕ^\N3вsWB-sWZT9yÚbtד+uՈw ҤxKvS┣ؘYqq\uwʖް3bxC XNU͂.+@BՆAk\&#BW{9 F0ۥNiU/rPAYW_!{WBCHEid}ONZJUc] 'ozKg/LRCpdɺ?q;"o/uɾ Nrtsޞ4d^Uy3 lQŷ˴֨{m-)xFvi+zjO\sp8pټ`g\d}QQ^L}^hT y-K^Ƚ-XvKw@V=&8Z!{{e(x٭2^\JIfm59%[jIw:!I'ƕt>{!*SC_-1c2xO%4TPF*TrJ$]-~3RjLsZKٮ R!s|X\ZdE ^!O*rN\~RFOZdr'՘xG4K%0Wƌ\\f1 ઋ9_~ǯ_@ej|cN%"RuI(LZ}irK՘洖 sT]u1\-~ q5~R 1R:$s&Y-~2RjLS{fF%" ޯBՖΕ<[>oqO}׀ /OW!Ɠ*I"ZJ(F3_ЪJ ɕ:UcZl4S;߳!Yo3.g"/th7ʹ7oFijE u3+iP/`ͽ"s.R"Y6ZH3(,.^Z28O%4OgBO5";Lua{*%I&WNRYwwkEbbdl!g=˅u'@DkyYz @Aja^WUB)WU9jR½jrU՘x<+᭚&Y~5R(h W+zi1k/Merf݇1 `XH_ c“Q|ʜ-߲RÎW58W\7u7>e1w2U!'VCC5 5D%7N潱"Ӝ$+u*@TkGLxuGW'PC ~RFYܑhJO1M_P_.fE%}'eB5٤޿.[kUB#е^;(KұU0Un -@vWL[ R Դiz9!*Z / - \&: q5N^ @'_(-ەiezoUՄ{Jk1i-Bvק77|=蠬[s!j|a>JE2lnp\sL5&*]L)pC~A)}Sюv\&:6 7VYи)}raQ]BDro S-$#H5@):AlM|,e«"|8 ? C\WBٔoWB,oW+rIVML9"$Tʑ̣N9t |˄W|P q5>S fS3i劦 UU3+uDŻ=O< "&tð(qŤq#?]Cs'-hى|8Ɩt,;7M7^ $$C<~ʝHEPj$IWKpglM:u9%"͐7OJ w^-~r@| q5~R ;7'i$IWKL9[K)`Y4(QE9tm8df٪znX纉q[9yWfPCȞVRʑẗ́;J٪1P[9ȭ2sz98AZN(zI+e=3c5aē9QmʪiUonF?Ci&z&n2GL/.U>t;9x`f9 q|bWcGrGM;m~K}ѕy c(30FzV1%Ƚ|˄Y2+C} 0?e˜ftNU xP๨ciz͵X hB ŋ1ՐH21p\sL5)]K-åk/]ĺo z^Y⟂⟶,^nvP8fՌ[zc ce7y+qjh5A!hFu u4WZZTQͶJ]F625/=9mnVzG͵mMW[ݑn2Ulwlo!+8VC*WdD%s&WSiw7x zeЊFըi.dl ?ě{se«áVj\٧SJbo.p\sU5*9/CR/uKc7nӬJP:vZֱ]d6+86afY(aD&;9I:&vfgzЈ* d9?ۊpoA "O Ox.H 2R:!I OZdKm 3Mn9Y<>u;r_-N$/WDPDDi$!'d;JÉ1M-be3p(.R|n.X,r6 7iSq٬xH0vg!VjwVٞRVIOJTM _JO+Tm`:x8VaHi2"/ԋj#:b*.L.Jh%smi25.i2e+iPӨ!5QdbD%4I1"2}`X h{Ri㾖8PW;NQ.G?­U@ q5S uvQ|TGϝS K/γQ)N@᧹lSٗD*]@\F$.v +fHfx*!!Ҩe=WVWC^6b* x=|Ynx7zKF&1L<.mro:/ kE (dUõ$ A>M|8|E6q7(xCmbT.Kr.M>Yj.6M>61כ 'Eńz nO' Oc灓'ӱ xdLméZ8ntI?y N+y0h7HLN#m-PVU͊ңm<&\yB7&-;hQp9Q|G\r0[g_&ceUY'U5@mpM"^Kg>~\?31yapH,wl߲epn}~L JgtAίէ_fFVYyِvj[fhv*BdUJ۾?7ˡHv}fn.ՒWX_oB3~gv=Tp}+6~kfa˄AMaa/`M6osA= 4)ya秇$h@oeɐ ,u~^/za;*0HK'I o]tflD*Zq)r5 M'At }^u :RiOP0D5 _jA`Yy  0#*i>Cw„d-}%ѵ^@\IR,:~zAkն|#,vB#k I_;TRՒG9lfDT"(dQ[`Bi Rrh'Fv/ӗM[nbڤ QW5vAU5RР "yKj KRmKҡ̕VNi5-Vwgmqmd&Feq%P.I'5EƺCh;s! ?w bk8N*qP|"Q`r9< @H+ L+g\3 |s) +~^wSr4K_JG3/? [NTGѸmxɍQvϸsV]sTˮ\,vV3g JZ9a*_˺;~Np~ |}R}^{;Δ U4{ Cxw{Y=ʦ|K)fP7m2=_uk3U)hLkCݹ\?_Z?&-2!gwoV|9Ăfo%3?Ռ.ɗ,ʰ]cG#WsUIY-X z/C9$%H!HKnfie KR:V)zRYrtr6",)Y||pǭE@a&T{N_(^m/߫Ж^TrР77u!MyHU3Hʦ#YJCVB jW\|-3@UAn!mCҗ@>YC&c|rIy,rBǒ[Jo`kU[TDa9XYҫzz1}T7qh(kE؏CԡV:kPHޡE!Mح,*"kz"vv]wiB\=?F7UDŽ%cT>`K8lV f릚pcT3!Sm{/TOo5{ s-a EoV[Rh"RKy+iЄ VEu]7AA7McMgBvL \y]z혊ՀByI7ތ&C7B!BˁkS7dhS{ja|hp7}g߲nVz5#%b,x'%Q>$9TD#p2c9X"emqMn7jT|$D\:q_#"kTBK[c~ n]吗K;E38]WWz-[\v- Yju YFy[|_y'ej^KtYN`@֩Trx7仕iE["v dH!~dlլh@67Dt ;(fBvG.9 ĥM( <~FO +@IarR.g#-P#u))KudB6@ޒcфkkc|-;Sۀ!Vf1Mr hedc)SJ9Zxtrx?G=Q{a*L:A~(^X@\={t_3& -tE N-oN'޹Ƙafcj)o3YUwJ+ כ7Gi tn\\0x?:{xX7CwB>1,ȗ9`5Bػz11uis:e4;%|OXlQ,Ԑ?jՒiKeS.u\GF*p 9 θU+OP5kSSqݩI[6vF#L.j̺K!/H'fCޒa~U\@wALCViB09K\Δ!w23C*@J?>̭C j]6b ְ VsXO V24BZUXL.xnK;oN܀ZV?YjmF"8# Y@\7^4D$A  &1qfh@ 5f6 m8lܥBDƤʬ& \1:&#jNT QȣTc1cA|T8Єl&N9FTyq9{7Z& Jiw4s8Uaz]w_{*045MpA3@DEMD) YEY4ԇ@X,EjZ ޓӎX)[Bs@2v*֤> 4O?3u)q1,?L+ˬ6Tc3懀? gcf~N6 |_Q W7#Jd =ȿL/ }5 /ǏFbT+X!?L?H@\b9n&8+A ~jdQ7r˦{.͛7Oǒ7 qȏoTJa{!Nbi˟9#rS}5sy{TzS~j`ҡy_l~x@i]*qbШ^Jzƚ{h0K/.z;/B~1yEu?.*CJw ak$V&F]kfz&»o6'+>Jv5Qb:gT=IrF7 ?*n"g{;**,gwTT;ĕao ĺS+]UBL^zpEm %˦]YzӐOr@|srFjM4Jv]\&L۵R_mxn}DY0|LFg\e>̟m9]xVm"Ko[Q6|Prp@kT|A@\706 `;~{ `*۞nFcd@Y7+̺=/e;=G -b;`턏B[.Syqo;a;[>a[z?>N0PrS=yXjmv'p=,- .EOߕ%[`Ү]qqIqF WZɬa^G C;t!t[L'G0ʚ?RfQټH ln\3k'&mIpL+{Hsd9+福.^o͛/6Dˀ ]۹CCe´QMۑkp䢬ۆQ'J7C6q/W@a*/-RS@\i[:y;+lOX)SԊF`.kF1,#W(G5U:WiD.w G'n܅%Uձ_IմEŐV9O޾;~Pҝ/zrjw_m\bvY; @Pà⺁c&EIBBO[ \]>A YD|CaÐm#9t%4iOKskr}Qd7N?/CzWF#4׻ȹޕ .5$׻Z4${3oUzO&xwX7]ntZ48#QquGmxCv5Y/\ިQGnxc(@1 __=|ɏJ]v1G.h7GJ(Enj A*h˜ 2hDji{EұfM]rJoP旲xֿ=A cj}Uu1,! m_ 3~uY;v9a.%Ra~7 ES$j.лشRt{3 I < pl) $-8m$<ZޫeGE*ma#@bP]+J^i 9by&m9$(FmD;$LFCNeb9j#9iȩV)r2vCdr3o[tDTwWRЩCt>wy U }ZYe S{;4a>$1AesXhcOS+q٘:PYifxppo/@e[0|uak55Xt8!6?cϡ(FIqċ[QMZqjߗ[Z [" y;n/) ًL] w v{/?,^Z,2ᢦ$/?cɧCxly\ʏ鎅@\J,nu_s1s7/8&, R&#;4O]Єi;)ئmi9 愩ϾѤD7q/ `f68 gDٷOZwy.^+=W$Mē=ƎNddutWX2̯g uӫ+=|qV-sbU@KOvTsVy.DBH|G}#M!$C<eb4&2"Q&Rs!ARAB]/Vd ,M)a#&>X*y1^=1 |E9tq8灟GPOdln\SM(So2)@1;~]ߍnB7$u[/]h%=?Yuf=o;4o4]R|'jĖA91A1N2B.A*2ueF{]˞?"h'tg1'))4S5p%_4a:B_ ARMJ(o P`ʗ+aZjπIН);M4aLUPNN픫S;,*3\Fb15? ݥiwu42N{Qک/o.hLk A4+?OYMUn)AwRn?q|AMra8#e6pAaçOMhEMhW2G3 !%z _6;MZ Ӱ֧/0^Vݎ.taަS&|-AO[Є1UC#(-J(w hB\)_ . _寀tLۢ4a0.)߂&|߄K6 h_rAҎ ^&\egZ~vѬY鋮%Wctz[o-cOBK ^"u$Z 4Ĉֻ% ic&nUgu7Z bk2&v#oFL?"%R6f<(̤mvty7}lӦ ~m),0rp n+/wd+#DjNgoSV`= -nQYjsNI}L}麗UA[]r|SJZk_yɳx kڒ,h^[f$>}? |s@e (#tWm\@\rJvMoy6,ـ: ~T6~RѲb =~6@'l`^G`6_Nɳl@qZT6@Mـ21_:LHـZ\:t<7<Hkl@?M*Jb6@캁mxd0s>9n/4P06+̴J(D>& :͵90'L.*F8I*Ыb෎f3W/ѭߊ99kg@I>rn_l.K K/&jݓFI"l0FNZIgv?/q g]6̼)b\>P @vOXkOT%})QX7sI zҍ"̜5E7q+,3omҮu׈&"A?]ؿ6xw na%".b-\R.\Ă[X麈"Ƕ H뉮!ջ27FL|@Άm- m؆J߆pq;x-//jeU^šMktBZeX8a?~e [6ͨ Gq`teqqس2xbS:ΘF~ƛ+Ft\jr1f'`>e;eǦbn9ۉz, wޥРnCnSFG{Gn{\.BH t=Qq40=Qzś Cu5 !||1kځ\V1*vtsN/)z~[VVk,(,Xz"t51_.f=,2֞rZķ= #) SkiĆ|fޕ!+om]YE/*SMt\Є1i !l;+$WސٗՆΕk)z`ԡ  LyWٹ'bwO"ot 賆3ZqA5ŘZsEV;{A3,eQ6VC:_1qrM3{l6f"5=])oNw abu z } ?Z궶}. y> ZkHCtՙbwr2Ԭwٳkdcٕ3G"*$껀_{bK~8'_ Xڮ^e^F?e;y7(m4Lo?]6 :`6Nrd;8̹' +*.;b[^>^>aguZwYOn]AyF$nWRD3\Cw3'3uK31oM> !vebm)5=|YuIPhGBT~"$ؽx%?[2XkC;tn/}2li:xqK# $'f{ g? ţ&w vh4[aDg}WHH'xb):CzSs˔2FRa֮]Ķx |u-_MG~O7o!%2ҬlہY -~vak9й,+s}=0Z.oe+\| NP"v9(wx?h]m [Nà/#UM^pT(N-^Es5Vp9+>,j#_1>SE5ٔD$&7ݿ'!AߘN4X= )H}ZRvMU Į ԴY+q Coцőnr7r,l΁S6WLIJC i? `/Ur_!l'k9uViщi.\͡IIP2fui<%OA@utOׯ4ϔ ݭ8h^ ^v$#,c:oZT6# <.X_<ZGқE 3Gm̊Df7D~}T;DYܨ.q , ۻƎly0*럀;Al}TF4'2)M.8B';|+PV+qb8a/F7&*VEݐp%m0jt?0irczنҬd{!0.лb ?Ql &˺Wi~ D{ettnv>4pԒX}-G" Awd?>1[Oٵ;Ҕcϱpv8|(&n!\W֍ΙEJW&!pd~R2u1'Mcf5=us0:ZͲ^S+& 4ĬX!H~Ce܎I]_;Q[1O?c~ίAl>Nx;b7D؝,Q0b&rM1X͘1w=GOnuA.BuXJWh>c4erVl#J+b@hӴ2 (';D*D#F .0g;Ά|z \z]:$#[]c͚Shv977tܗϺ"#{\5Zؚ^<03;7k006Y1݃;v Mwn {}En߯Wq x[AEԍ.hy1-su$b)jXn\zy{uQn"lDͬT`s Fќur X@If0ܝ1ߟOUE۴q\(\oYh/[\l}ڶmڢvWš}bY;fh1ŏz5]ho.7s ?v>f2Ff0h<d=ѻ=[L?wbYwv`wV`43onꉢ~!}W$S韒>4l2y8R\CMW•hlmYO@Lږ%,&ٔfK=U{vD6^uذ/D IgꥊVsK+쨍AGLH@KM5|뺆0Z\$s홅-Y*NPVŬ69lW$&o-YMe{FfB;}8+P.ȑk[Sؖ|u`VsK't0z}6vѺ>ɚ)FdVY+q̗AN~Ҟ: Ԓ?䉾ߍ4z{P(oY뵻2&A.Bޥ0Q3> ؾX]hp 66$+.BB@߂znGuzzHl'S ?3/^wyrjT끩z Qvg$G\Yݳ|MGQ~z`/vx x#_&s |?Ox%8+_~ ? ϜR~)xR[Hg@&ܛ6xOvk &4*!Yp h\ mkz3Fe2afeU`R:j|!{AM>>ୠomkL+EO Yn n}3cN@::: |Wlt+ܟ|5ϳD1\Pѩ* Fؕb.g(UyqqÐ; O7Q0Ϡ2;X>_0K}_bēt6㿀/gO&aQ}@=ՠ&ru=HGw4i)ÇkIpfY+^.nN;?#(]6X|2FK*8Qg@/vee۴"[$*+ѐI B]$3O~"O^.xh nPI]>C%> C%.x`Qp@=Q#jh(hf&m`8}l^ԑ'S[O>_;'< Zj"43ē_ ;6Q *e&%?7-JbWg_ lԨ R'gw‡A?G'}#MWg $^'˜=mbὮ]R7])z(! 5ekc\Ns-g@BVb:ೠ0VqARc?L[;H _+ULjJ2|Cj$gHo*K1b?G;)I: v?'O'`hɥKA zk;U9?6aUJc; |hp1-Ӄ=@Q zz@B-{xgm^l݋ -n3Ir'A?)+\b{<(Ol dMN[WF]ZQu ouoOQz=ctԎtH n*C/>@ k V%n{̳1XTOm>=zX?9b_ =X zB7';^Ffӏd}8i6fF{BS`ʡaE0@: kALB8@k#; }$CKIׁ^,K]"Al+8QfQ7mж<]fFD.^P!;Į <Zjݼ[E/--@nEPUē~"̙c8==.5ӎaPG.bߔw[=3OYX:Yk2Ezb@oD~)!!Z0nם 3UI2lngDnx eR^$j #|$!R0UH $Iez\W!a2ŴXW!yډ b @{ ľ@< [EsLp&6I?dkΡ`ұ|m%CТ Oeۢ Ewys5kpZ*i '̃Χľ@<{%e;jq#LPfҁ0g|^¿}\ʸoM޸oA?}&O} d-HT]/y(aIԧ>ӎNiKQ(dXGClH*(K\gz]hRނyF/D+}U_`Ѣ$U7@#G캁V C6v'?L~O&5Z6 vJKf}o(j}DU-Mxoin vظx$厸d!>JYEN{{NLyv =^-,|3HAǜlXgl<ϲe>:u}Z7-׫?ZsT_k~?=b_ƊQs灟sbA@!jYa^g9% *2*UXI; 0 خtܥ4OypD,'$[ QЄ1\Eծ$;<*hBezkAvhUhYYB!~AwJ[3QM{nԽU`eZIר&>urQf>kMvrp*I^I7Ⱦa84ϲ,_t`n .PV^7ǮLψ3؃>1oe߂+YQ˾/;I~HD,'HAoO>M hbhO;/j&_ gQܦaל,}-Z@ x80P9^OդNp>qũYYJL f59mv0IÙjC{ Cm+Wyݢ-y/p'nv'6Aw#ՖV&yxXНRo#h>Aƌ'U'@rfy gU95= tt:j: t\!we_ l|>v1BIxl8SG*?F Pq~̭REB/UЄ $~k&Lì>uA47+hBUAЖm Sst|ǂ:\ՠi6d 1ŗ\ʹ l|% ./#e._}: hBU3-KG%~3"ARi֟ fXfu riݡB0dX?X0_4d˻ivœ2qHxa(g.\/LdM]>n]:t?@;"z;IoX]\&ciMݓOd.u]rTͷNdM􅽙3&)Rsd#*5'Ru9Dftq aWB{Θep],SWzKtK7 0u &;Y4cg~pk%UE;fLL54k"8Mo!$ठ c$dG5s5M;+93)WD-Pk'Y.^ZhNtԮ@X!;5t:j%BM+8[rIldõFn:%0y -]4pOf8A|J\~^lGztѵc@?[KL'H?ǕGFfGaNG5,蟍\_.|s?.?)ON:JwA7ͬ)K~8T4[Y[mS&IPR='MH|$Yࣂ&LA_)h˜?ƺ#&T\#|/p< ټԁ4 1M!?2ǟQ&e"EQ30I30rm1,eR`UcƞcwkeKR(UO*UYx^{Tp"]kM疋jHOx SS4aLMx6\4mI!Ʈ&T5"5zXЄiQ#&E*VK oM,ˊ1(3&T'[*K_t -Y 0'/*8Ѵ.8RO@'&Zr8iV^rpq̈́L7Bsu4cND0t@IcSo]A/_++QK UcXFOZ^bI6,hBUIYPyATDz4̒MJ%;dTO*y:AT+Ze k=) &'Y?9W_6eA/n!)/h4]?0YWXG,&EHߪFU" 03]CJ}FЄ>,HtԈ-һ1>~T)} ~F(?tԥ>M( ".:O6= ]#+C\WO̷ri8Kl\J(n*0TE4]F0rVbPnESqvyv !2B_wh_<PR u}g! M|zG& !VO0M|zG&f&fg&~ڱ 0E:Wq,:&t't2-Bzd⵫y.xeq!'[rgԴnMkgL#?M#V=rWNQb-Kˎ/pp] (;&nлVnF+sWFјQX@4+TR̜W9=m$yRUѼdvGz!/Y /(U. y> i꘴O_:~%ՙ6߿c,gu8~ZYMJ#sC{vxus#r`rWXrI E_TYÙ aK~8'_ /]E5ݼWb1^,?cω&Ťj&v(ݝ3%N13 ҳ9JΘe\:yѷ6hlTpu9ums6oK!ve3mY-S.᡽;w0C8humLl#Dmvm$^Գ/$/=i`=C#C;H_~ރh} ]E:{ēwmWQM+ln1C!; Y`N*apoGu88ٚ1(jyȞr$,L\y]E o.Dz$ |=hE=bWڐa7M4)8O 6{3yƚKv߹Cu|)SLY'3={} 7 3$퇁b~@+O/x~DuR> 5wPٻD~ľ+x$vE\qhѹ'j.8ep'TBAg_/z .nQۆE ! t r;ewZ9^ x k22ҌlہYt,b --Z`t.Eȝ ;@Pn+*ʆgKHwx7ӱۀGAM.v-uqIݻ?w"US']ʢFig_sVe%j½g@? p thkbB/1YR ݈='k9uVf(Նq}T=L(8"R15+FY{ fЛȬ ̂f͚N^uR>Q>ד>c{r,A-^,T]eY3NjTv%s({ tb8 t aY08 }Gf7R&jb-`!'a1M` }|xm`kOASq)ەl ؝Vș& `Lqt,%Hg: ڎbd猅9i6~z \z]:9G,VX;fwȘ#}c-}c gnxlɚCrilW*/ MVbaCS{;o["9>"W_+c|}ė^0!+wTEKӧc}7E^t4&$o_h0'Ə>z?Գ(S}ëpK["{^y,-Ri,l&~ج)NJx$Pg-jr]6MY_܅UNV _@MSۙk'Dr/:ͺP0FGGRmCOOX2 | cQ͘.E[/%̅͢$d%$L<"ݜkuJ6Y/o[!OsMJe I6 2hj"ݮ(檧OԔIΗNj'|#b/ˬ,>6qD0~̇ o|AY#*:gfzE3Nf#$nZ!.^Fr%sK̚:•ưMeZbf@끗iuD aO_:L7,pĥYmhy>I4od"hw> jEc(ȑMl8]AfLo䞣[TVtge#Sdfʱ9 Fo:MG5vn@7"za~2HFxKF7/zlͦVq?i\w0^.{(8 oE:,M*)#W?\{% \[! ?7+j&/m fe.:AL4-o9 dGYCWAo}ԀBsē~@ d e":pVU 67%Kt＄`=ՠ T]̖紒e*uMíS11&&GPKN ^@vbOq =bAB`v^pMq z5?|/h=ǜ:e+Iߚ'4H<> ӖMs3˙Jɰy^BvoOc;'} /ٜ,%d눻(ӫM3iͻ5j{j]z. J`ҷ}?`ߗԖbXߘ G#װ<|BO>b&x=ĮxC x=g oQo z7%w4is|FWdhvٰFsY$ьu@+4@egv_|D`q |TeS:>/:[KI J>n N?r tG`$QIQ*=f8g2S0>:k;-glkq&' Mڲ8ztYq"J`L;B0S2[@j!: v;@K-;DKU[^R. \qdP74,~nĮ_H?_ ۍ9&ܖp=:uu^rBiᴘ]̘9#ؖEcJ\NgMX#f,/548yYF/$A7k?{PA7knJԃ䍨5Fn]-Z͘/˷\vZ1IZے`AoOߊ}&xҷmmZrxY~Zh|.!qoU=qoA?}&Oƽ=Q^qZeTu-t)h !Ї7@@w LĉI30r'UOHY pmM˗ET5Z6ӶYb@Mo, cD1֊Ro:,q |@eFKv"$h:{D&0 ]L\CPKi뽢M痢d|]㎙2{QYt"j JRZl%tdO(YTw aՄu%b4 '($HEs%BE4|9ZCer\/*՘fӯsOrfuiU=άmkyјѧӺi^j>wÛp˶oCrj=b!NmڅGŹ}q)l{η~J5b46Ld.#/jP9}MoIj/JkK3>T_N7Z5zQ6MY{g} 1^W]vfLw]-=cNx mp͂,ˏYN:L& L:C:Rz֜v@l );6ծ`_,2>'2=ZYWU)\SnY 5@~ >3Y2*%R &@fZxȟfEvh`5"_;Q @-ѹ20YݢMxz3j09kCCN䞒;~ڣLiϦI͚D~)QKe?!ӦRėe\(Y-r!uTkX JZЯ2<2aU}y{;BIwj:%b4Q3J)R;]o&<&T?ߟKvwӆe ڤb~9g(ӶYEUu!,hDG[IV#Fx}mÜe]QB-]*}u6K7OTN\[w;,Ȕv\fse]vvEn C_4^5U2e΀[ҋEA|:ik7譟 m(%P(VgIS͎ep_Aׁ?Yxy XF|}9jYln67ehB8u/]=wgXvĹx eQ0$7;< dl^eb)0 E4@lY%2r:Z>Z:E ~I]SE}YU8x"1[~W6:Z1Q.iC|.I~A_)?d?Q&FS_=5yLHjpmz7gZzc|8,uv*b"LwJI3Z-}Yq<ϩ ޝ7Wg!b{ wQ3<%6Ԕ\E5 (:4#p骼AScGMHuMNJ57fkj\"-/F8exԙpy˵UAO_6JZAji %|)\dk-&~ZdgK4P7@)2.DݮY9ڴW)δi lP7z)ߝxm_XtYw$]7@C%v&o&_ݯ[-*>:?A5 {-&6J $>-}!VWD#I7~ %ZE58 m^0Ucź9.ń- r;f3Gl'n8llD`"(}JGgoE}la6v@+螮M9zC c[T)֨b n%uWnsJ uFFPDSqvS6ߏsS0-^S?!b_1D¯Bi!b lci!b8m+-f/Y_' B&f/]^m&> MėFa؄kx^)T l\@ŴHu&o£0[@IڴM@<~DMۍ^s?pMG*ٰ\ZK~f F_b@<1SZ׵ܟ"x2hdtBqD"-!$uGG[ľ+CuVO̷r5-ũiݚΘF~ƛ+FE'«A_-m񜛝dx`pv`Ci]w)4hAo2:@Kisjpix> 6fa)ֱX6 :@# 21d+ao;|;@L3]#^}A:&b!|ձ.3җՆw7VW`)ۤt`h074gp`pp]9 G;1ǐd~_QYÙ aWA5j-*oV=͢amѥpc1;f l,Ik0Ų_M. z1zsZ{|S"8NaȻmQ0eHx,gy]ove*-!OO{Agx߿g)y7@2lk f)cݬ _HC~'$"OA9? Ÿ[j:;ovTCM/t<Bn"Ǯ8JlE[] yGB@'ݧہh6i>WgՍf앐"U_|BO~2:.nehxdhxǰoyϧ05ֱ `˵/U'ٳ*xbC[neRi1s E W5^FnP*]R\YQi5ådJVcwlTs+nVdeLg9?)0N&}5u<+^Y+t LʁB8>qb)57>!u-_YwY0ڬY,M؅Ç{I = >핤[ꯂYdQC6^ \:Ǘt-eVC?~A#!z:f -p^}j'\Q?۱#L@|BB7A$)Bҍ C;jEoaKDw>A)0=U"  7= >#dU[z1aܘWG@ǟܢÌn:" zs? >oըmxA`вŞcѬ(]ӐpMmP xF^wƞ f5!U=e6!'a?hAz{pFrt>canv1OMO9ڌt=U!Ym^4\lfQ5̈́/N( )(&. S )vL1Ѭvi&M~YIulZW 5nNLR%/BG>=+6딖Bi@<\WzP>"?-jv$¿.s̭(̭[9`n>3bFTgDmau|Qw]-bd00RP+{+aISq@_Pa] 'bR-R$EAZfV%7L:y ,gc+fΔ/Vsڥ4 *n]A;Y0 P{W5nMSՀ|yH\:,k1t8u={CwU77mx5m6V_w)-:ѝL𳾾E?ғ/X܂Q4gexVFc#s3ԾJȾ{v=;2;j/fc nqi۶i!^ k ~>7eO3 G?twkLkm27 59ixDDl݋2|ŋ!2H2{Ռ.\=QO ѠiQ]+!IH2CfM&oݜkMJ6[/o[cAf-C۲$LxlP=tz`XHSS9b '$=MVB.(OXXl=?z i%њ$yܯ#Zjn)bcc:;I3bMݴw ug =xjV$bWwԕΉhVzہ@w>pUpUUᕠ&آz*xFrSOwDk9pFB_4Vdg#ǀFA+e BT? ]Zl+#oE|ZIE1xpu ٰՄo1/mr - x# NВ<G@m"zGla;{@Q ZvG^]sJ;x>"b < h'xҏEsL./IhF KD:nUxQ49ðA048HnțS & URWS=cD.OGx9s v~݋ -nsTQI^8e^΃'j0.hiG% 4 Yqm1WFGsFmgDHW]jAB=]b п~%@<] fb-!?y?nIqtNGZq#'?  tDR,PY ~Vxv-A1y׺ D%_Jߵ;_ ]k=i}%&$djFյtg7-Z慛>vJ|*,D1rӹȕgA*KuzjNjHׁ~]/b7|=Ui=. zy+S$ߛH6ہغoYwt:]$;b &ooOaGU z:jsjѷ.s\2 i":U(A>[Urکz%F/%CtX_E[FMEuӜd~5RQs=B | t~7f7%j]G`@Rf[j$ZMy̗0 :)Iߔ^)/-⤄h=@þ OٰKMEkv=ph2^{ӷkbko–Mܮ+QZu\N®-_]_ [v}-lǶuઊue͵K &V0'``Cҷab?@۶VwhS6 [1ZmKFV-_Wq Yk? q?nq%DA&<_PfI]YԮ:Aq= S"A"B+2҇/50m%onp;hup8ӡjvkۧ.MR3iAKlu#ڢ#{ IWxb \7ӢRii+J8M0y6Kji |mfEUę˭0~{X)KH@Kl%y/U|ܿ,*I1/~eRgb^ீ^9 Ǹ%> "TW+%TՏŅ_o%nB-UDX&'!\NLX5*$tA?$"_ԁAO>"@K_gDxcL.[J@:z"K[?'/~!{}5?؆3&l*J;p65ˮVq0*6dx%փsfH?am m0\[-πj{,@oE%w bw97sz\cb7G?-z%lD~'H2y@KFO/Ƕ~IQvI$պ289_w=wPzՄ'X;H[\E`Չ8bT^n Tk?#[j'@;3\oF$7Vy+čEA? ߪL+VY3ܓD{Qۀ6) C$xzś C;K/gCO̷Yzh6ӎ6nݙ5ENܙ=C}_hlW>O./fΗ7 %Z!]\*U,~rS27nGlgc*?,t Jeீ9ͤ],+ۄ6dFX84co7R<_~ I}`nhpȮ{?FH?HE42-RlCx$]5!4^E5Ž,,镂aMVܙ6xY88.NOsw^\pM73D#-u֫3lǮ8tBÅ쟵+!(tY1bwV{++mYH'A_Lg!vW~Ulu e{IA˭UNedhp]{584888<{gN}ˠv*DT[_-uGhN@Et4&JM6Mܙ|sP fId؍>ZuSϸڕP7 +* (q{_zB^t@Kue1=О2tB$ݥ r;o Xu)#RsFoTSv ݃CC{Cҝ /%ߝ7?Zj>^' #]E5ɭ;7tihdOQ,Թ`XPXls SDo3Bf[AiaYNuBVY" vO_bcN۞,I8~ϭYh,D^6#NX0?L?Nes-3R>Lظ֣}ցjȱ8isڈ1:eM:F`^OSޜJTAD T!-uWktsQ<2k Zm4k}_lk}pqN~@"pa$]à?dJDMп*F~_Q~ qߊp.Q1ߓai:j Emm7 S]_b5 M8 wKm\ ]#VTqBOR*xbC[neY1_)Ί9f=I5ܡE"3EnR1[rc_fԜL݊cf5ʶ&aY-oO ?"?t_F݉}<9 0x{#(?Ŭ"7p٘ʹY 2 fV5kʏ fr*7xF)ŌAd1B4B [UL*c*]@ UkS+'y MM] `nhO@E=u)? slq>(pL[)~}ȽEkt{oo_ ~v[ /B>25Y~H53c?s cX=sxxh^}Z(>9>Io-ۿ_}ju!Nԡ%DBV@.F,N";~ ~tQH<}H?,k?\[llzk\Af?ɛcK,?ybyϷOz1~W5~~K}ի~!/gC6KL?y;8 u^Z)?@<:]Wn&i4߼5K+cfYu~ VEBw;-I> /k߄97Cl)dQy±c?|4_psӆgXކ{nӪ?ju|ל2[?[gzY{e9,%x3w ϘS*"vmI grwfz vՐ_=G{EbӶmC֔N>sifacG.Xyim7` \ZğqFu̬&'8OYOnֽ,]6|lUЍ5g@?Ռ (z'sRUՍ~6 2;%$L<"9ݜkH6%\Vۖep3lpږ%,&ٔfa=[{v`L:X4x9?wǞ-≙ |V0>?z}O*LunYw\$+½JώQl%V~c蓷$;@ߡpQqYb?Wqnc<W]@<1ߊľ<~}wKX9/!VOvt:7e6j2n tyS{ [']6Qem} itK VeG\ʯrx@/(; O7#0O 4|½Ҽ(1<|#7Ə9)xY!loeO]F`2>.+`?$Fye72f 76csv-JET cvd@yk~$y_ '|[?eo䬿DtV@+ӵ+Ktd9 ]lԫYZE5at!yX'4@Tkak4HT,ӼA1(w-GL}q9j .Z- xi,Z/Q$Sׁ~]Cb_O"G+AKѢUpMxъؿ9xҏV=sL0Zєdخ Zjh莞Xx;{N uN;ře,;.2q?C 6~w0ILK3t6nK%뚓_=t"Znٴ Qw~W]{+䒊Bi T)E. D$#?LI=,b04_G}%_JGS~ckjsMS JnbH /@KI;/SSz3%8a&'A*Ҥ0 O&]:M7ьfOi6B7 04Ow&f/$d% gdbN [M YKë8Qt*-Z+}gՠ_./Rf[O w|3,R7YϦ;O1kgjcf!ɔ Sz#LWJu<mv=p -, E `PmG[rՉCE,>z/h5kgYwg&nBm{|BM9v)pT&vrYmX>/sgY-)C).Lނ~)毀 %ą&$˿_b g? gj۠ $ 9YjCm.Ss '^E&&_4/[$Ωw癌D$5iJ&@U$6{ݥ# In4a ѵxnWզq$MAݗ^)쩊jtn&=ߛ49z9;4bd9{gj[%/0voԍh: l*0'5c]^+x/Q@g~:C W;9t\n%M㻶i [n۠OZ;iWN;b;d%Jr[6SjDvœC[E~s"uh"q֡=٣/h% M#6o,:Z| YS$YF`r21Mdj'^OKer5rRR[f߮7M>e45:8ϴ/`Hg\MT"F9"09`SK f߮70z@Nf)6Di)GsB7ҔVצm%.( 1)g`&:d*{pzkEyu&T NLA|"֚/1dÌxJН[Fe/lL& ًt-(0q9lGrsiyrӎy;-2r+Ո4\? 7ZQjSj8mz[MRgh "O ~z kbi ƴcK~SE-c挜T7Ф?knXzd 36:{2Abd7,7S#WBR^.for\/xh%}1? }hL KGĶnґkmׅYM3祍֋<2-C=l Ŭ֡J-"_QPI;Teb(^[R&WURY[J4PڢCUgu ?Ѷ9C:`~_Q _ UL%bLRS\:nz339j 4ڞ+G1<@2ZDz~#6>;3tňW Sf][WH{yt+Z1b%lň$v|JЄ dWHާr?-#VVH2=Y %b;[/iŨFM:mPiO7,^1ѶA> Gb\M7D 9SJ2~339j 4iT3g-:? %AhDj1ZEK)*5rE򒢥Uo&/j"_KDL%b"GLuJyIS*L̈́G^"b1]`O?ŖCb5(X{0r0JpTkO̗ _@P&*U _,lʮX,ݽTWd3i2C{ ^'D1->;};uh+Iokռ̶!ZkurH+@oR0BKuk@_[=Dy0 JC<]̯0"\Ƽd|-mӲԽ$,QBńDUV%͜ˇ~;$/o~(]ν&Tf#+vAƴu>V,XcZN; 9GD͸A*a Q>/h¤'"o4aL>{VE.yR= ^?1hu.?n䴓ߠ uA*Rޒi_WЄi!ZT['go,UJum3蓙euL]rMSa2y%w>,h܅)G"Hl%omTZ[LkzjAc{I0)VAo4aL 5*eJ py1WMJ_zFz1JilwM OR}{LڸJY̲J&KzQ|ߤkYD 3K-.bk gmH-BՌ],xy//gXaY ,EmgT%]C/͙_4a ַ䗁!h˜7^[3DhPOX2s؍_.r Xer>~΀4ăE^*죊jfzAZUX}<FIXޕ:]E-$=̯::aONEL`t9Wɏ\Iǁ@mWy 4Q׀~Ml|D;%#(}u`F(ۢZ6zߦn;GV zm,)]CIpLA4M~C ->MV| A1&[R#gn7;whX 5z|AK8Tm?]CIC[НT8rI| 5Dt6/Oԡ2m⑴q!O̷2mز=e8T*|ӷFz;G8z g3`NK '!Xp525=6XgΛR^Mgo+{)線%nN5~B"v^m}pDݰX=#KĹiiseq KUk@RPl!'S+bw8z*~j5i hhuMf?@Bt>@S#^eIAh%ɼ&ᄠ;$NXFp%1^d5BE 5Lk rmfӍMXAĖ- G5Z } k{4#v7z_bt|3^ wg?X )UMd !]#ߗg=+'[jũiPgL#?M#jW+ dx:cӑLKwޥ̞DA7!|7w?ZoA2:@ L.x;ߞ )^.S0N%D Mx^Np8z[u+"C8>1앰 ʭ됷3r;}GiZFaͱ k1IȲ&y!կz!$˲Y#p-m0G5f7*|7p.)܄H6Je2>'󙰛eZfq')ȄE:C³6x&D@ Uuf .sxeẽuoJl\,vs n\VbύBQm(pdَCBu!ɢ[.^ wᰎ] YmGߍzedQO@<A+< > wE~zVK XV+C6[)QE#(Q=F1[n ;<7lKG ,#JM4G5ޡ+vMoAb—tlCvMo՘>2;TF%7lH&< 9};6Mԧ3;JzhNPpO#/-LJ GT# < ! c |@K/. Eb3Lެ֫i]"TotcCxƒnȒ[ ~=,cJaiDaX؄*H4 AU`X K#ѽMn ۅ6 XMٮ@2{y  1VX2mXzClb}H-+& sӓz @|jYNj-tVEƼY4Z|O9?I)`UE<b(h|Vׂz7M.Ћެ/‹h:LK']UWGNV~zY]n!&C7^^ģH/k˶I\ ) l(-Hb(Ruy G;j$(R(p+ ^Y!l/-EGRQKCVNQAV[c_=CsaEeXѤ"IiR '|lU~FHZe]&)„qc<$FtGB֥1ިCr/;p{<0Ç?;g}}L_!_rm/(gK,wf0ܝ1ߟOUE۴q\((-!z^|wm۴E5ebw̲cݣj`5\n6pife4a~VD=x݄M#0jZ42/B/@KcZH@tɎR@!K:_lb@W7|%3vP a2B,Ou話ӇZQ6GoQ^0O#Ix7cK_f)-R#8aIK F)EoI?v#F HJLYh9F:0)þ {t G,mŬ69,~dAXañ|aY2L}hZLPS{j5<ҕQ3G72O(k)~SM i61?}t`z;Tz}4A׾DMwц>zCG-EM^&&#Vׂ=S7\^Zj*8j7Gɽ\-hׁ.=' '&z[AltPq6i) `cqšuu|+u  UZ(bjpAuK'8 /b&o}{k|_+{k2{9ɳ S桅?Ŏ^@)Sˊ^Q"WJ+{= }Gl,e7uAVb$ANG5Gg@Qʹ Cl =*EϤGxɮD~(r^)/w?񝍟4̇?iZ>%пZ~ПQ$tY@NaM(7$}c7?rK@hnsGA?@<k=sL.h-~%DVYܚt򳫁fA1F@m, Uy Q^(O-=E*b|ӱ}'4o7F_Z540 1u:[eZKƜmşed8YZY`?/֗SHaȑkvtԮhvAi]5#u9&8Og$$Ɵo~}A&9V֜nw ?%v9a&1nTO#| c{usϥ ľ@<{fXd=a!'loNdQOXl/XT-13GYf;|5Zx}_nHmiX9vtkZᆊ<Ÿ;p_ ;Iߑnܐ#uѽx.eٓ. >vSXve*c 9R=+',#/Od]DKHT cR/%ɢAvexlO[Q@u*:'=|[`[uF% XH{[u-0-u-0z0DK &O!Qw6n346x8H^%ūAո^Z _Hރz5ctd" =h+fkL:i/jx-XL>JiVNWm͘[Իbm_]†CbɄ$\ëZ6_-AMϺ 3灿Zj!g[ʄ:R!H:o86 SVL}@)F!%E'+33/g M:%yS 'w&h˜klE2  :I2nm$[Q:;QLBgz-h\|)X&h^YLY( "lb ~X#ZաT.kFKu-܋cA?u_.*%,>U9[0R^,HLR! Az!uoroO!7#ܔcr!wI9?#!X0~Mƀ{{.&m~ %KrdV䩼 ơ 'qўwȔ+bEɼ$;?͋>i?|J|7w˹3zz?|(%vOD2x}¯8&ۚ$D|F}N+ 1Iﶊ6>fGڜaN1K͠k^[,{^?I}࿀V./df\H 7L-zg%\.h4`BНo-B]i >{_ò-c[)hP}Gzw;lW)u@)ZH/lK )rHOe8&x, I,S,UjS4ioFc^/.v9mhfLZ6VW$.Y#|D\RЀH< |='E@ˍ.o>u \mZ'^eiQ> |Q;bI#!v@ !xHn1uibR7Ud&m`8}(^i>԰u@t oNL}>m;_gui zN\'i~|rW0ӻZh6w,1g#;?@<;B??QGv4R,k<s&N`?&!e#J§ s e\Jŋ&Ry ]lH?|ܺuEυcphT'\&cT 5S_Ftu\gRAb4 NdM􅽙3&)Rsd#R0coKᆞ2e{X Q)a ])XV▤`{^Zjrذ+C'[HOғ- g@??g'xMĮz!DOiXX4v{%P=:TSW /}0y U}(} 'wO>I»w Oj,3LO+[ܦpJymկ׷ЩX'}п Ivv$oKނ`=@~SĬBt9zwp3?GIvv&rsQvv&r_rsf0uvvл{d#@<.ٮD}nYј6n #*+[ׄĭP6'AOJz5k$ ,.)ʐ5bZpxѭ猅9)ԩ\L߲&Ot,uT]T v 该cT-пۨ"_UN;'uO=nF\ڞgSIti{yH_C 館ްY$ni ;RQQ*i-?r[Yn*ev{[ZO(X 6hiKEVBS%2AK_?R:т?$AK ^ ?xK,&GH ^;[/몵~VVI?+SnY݂&T+_x &Q&b@I:mwrAU65Ӧ=¢9MZ*~EJzW-fI@ n%}%ģ=U4}%Ls/Oگ`/lG?GD ~EЄRՓI kè\koK,.@my YX(05My0+Mn"ThJ jlXJc4a< h˜`N;@_!Xt̳F®\wekEۚf}1=6L ?Q{Pt uy\#rO/ e`5GAa5 cZM7YB-A*RK2t|QН/,M7s/_+dxrcJ}l StY`A]ؚ@'dX3%,gqaqtoK`؂F3BHeJЄ/k 0 kk'hD⮿"UЄih#h˜9# \rRЄO ".yXKNEK>"h˜~}@#1 mMMDEpxךG#%R;ZXƈeOD*On cZ,߰l'OcdZ&j#O,?}f̂FXCj&4DL>i-7nJdx7lbw%P)Pf;ZM2JzCJQmv>[M?o)lY;!t—'j{z I C-֟ o@%;PiGh!28΋|+]VΎp SPVZAT*^\[Mdp U\;6I MНR^ѵs p cģ(GdPZ$$aMV=&B WlF͟{tg+#TQMgiĮCp5hz {ViCdx諒bx5c+ꦹZwW9X ,)nNTU\^Dw$ tA(8@{TDH p2ݜ;j c7~c:9|7VMONKο <+W޴+}uRGţ oF[<ʕSVΟr h>5\WwxY0LhVi#X h[gf#8r/Ĭ*B$p}b/˷>| v7}Wls"DR <-UED9|WAK]UU7*"T͂Y˒ĩJ: )WP=FJuQḣ]lrvҧN .Ji{qK,tiqM`+:i K Qi x2n} }H`A*2ؖZYlS 0|zAw]Q4f+ 4"8σS5ׂ~m:|h!w+x}u5](]O"KwKduݥb8|*4sE2=j # ]D+mMm0՚p S0՚FAw?ߵ9Oe;&VjVT7a>efN2 ܗX [t a(dQil*efl%S -mxvIPVR/f5U8xZ⨃(z7 MD=WqՌ>Z+!iTVCiΕUjT s%0C??u} m.oA͡r`#@]ʎbRBs?|!v~O)](ۥ[J&cfWgIwݡbbQIjQ ɰO;q#b@~ms$ xsȅĮ~KodO|q?,Pkj+':ൠMt^ cb9x71X5oJ\z2]O^Ij%o3/ҝhZL`ׄAKmgHodm|!îǓm|v=îkkf`קk̭OAv3j|z](ME&N}(y?>x&~ a%&aa֧5DP}m`0MR4l7?@<DVՇ[Y"/pְIu&og`̄5}&O}|6QJJ{?@M;撐k@Y17!ضxm9DMvocd:mG%' KHa=haV4+Mx"[9;xk,dvt=R5ë8U3k񄅜vh(p'kq,aV(IB}Tq,J]{@[?^s${BWtښ[)Y*]vl-h,Sܓ\-09F?F^_ke"{r[A_8F Acn67lok"ߍ(ľ+x$rY\qhVʝvqjZgqigIՠJW6f'S_vlruBi]w)4hAK䪷  E:asss:sx`4:Qq4=QovBL'1 G<1ߊBTvm+紻rYmv9=mZnV'irZfxpp_lZ[zq5\^*)sT}N32KZĆ&@vEQѦZӊ@> Q*τς~6MD?1F>ye*'?c.BؾӠ::6dh_Ν{vɨV_܂mR;04bb5K=#v$/*TެL@QI[ ](jqvw,Cc9d[JO#ڛ<қ(DlzN+#6l! RcWK˪v,7;QA<bw z ?Z]]<|w+ k@&:VgFW߱Gʉ^ |sSeϮnnvpdWث~Us/R9x~]'8\(;:#]7[W|aG<1ߊB_ qNIU,SBˀAoT趵;Įx5wDx&5Qn+$tہ9йtlb p@:6q-p`lXƫphv4+!!ݠ̣[((Xn=/~!WP?PT4y~#8_mum2I?Qys/ݠnkuńkT6?oY RNTqB*PUܴuV-of<͹'Ŭn;#Guj# YLm_?IOGʄ$@KΰBx }Tc&bR.Ӛc4E+,2rKAzCv@ֵ٠;te9m7M22ZB;AE4yt)jLV& <Xޭ >yxm~QE *>iOvB<ҫ )׊ܐ2'<`Ar̂fdtQU L88$[nG"x9`O XJUhk&@J# AµjifYh/(hGF7 %zG: >mWSVE=1WTvtgù F=mHc46+bo4ܚ&YEnë 7(mW^gEL9L3BѭI0P3u1Q " nE5%TkOA^EOO+5ɝpI`nOt| #mׂ/K lG5̼]\`MVT*%ހ}Fxs-\8SoꂷԔśSoo՘d _;{-P]Le"J od!Lr~2OK6HK8z v xBw,A9QͻwWxE/U>pj Z#<%w&=/7:#}qCh[A/s#' '}Tc[xLCAC{zŏ3㐓Pjȵ ]q>zʊoFw E]ZRߪW*]ȇ'Mg?wD' O(}-'G5H,{_c;b;E%Jӻ^geMyBSh#?ji15VλhQKtKz7xƒ%\1NF=p//O#>^4JWtS~$# m0/@;ۙ>ygk)ypẘi|٬IYoӶ˗A0PPE2tѭ_TQXd#C5ĵp۶3â1T\Т)mKInb %T7| 9YQ+޺hO+6yW׭k4܀ЄF"W?z}PNEܟGhGkMLÛq ChP,VcX\::48]\Ao\ݗ0_b4QK.nv㭸^\at$\S~w;_./p]/ ;x|OAO)};Oj:~G-.4o(UkB }0vCVdX]@ ՠj7er¨+-RF>FGB%gZ Q")猅9iVs:=ȽEktG;d̑eenG7^6dM!4Ffw&+f{pЎ(s4PҭZr;}Em߯Sm /Yg{09+mxzfFY`r(FBꁞ,4B I(1#jkfJj'Hll8mqkֻwa?os[3-֭j}5]TsUI)g-{ᔖ6mJTlvpƔ2H4=Pz3I37$ivW?LւS|dz'q~;wjJwjp_楘b B[q !ѣ .n*J>fuR]܈P1ebQCڤ߯aXs[0Z|쉜[Jj7R]]NRI%a.!.AM N3ʎDPBGnBZ Z$iYQͲYf sM:9CG\~mnm@)WR#6gZlqhY}04V3r@߸SWv:x{}ͺw^sM؎/ٚ1W|1ymōԦmS.U<%,pz;myG3۩?iŵZokGGOZuܰ̆#-kk<ѺL<=к,USe?vHn}7m[ō@tǜwȚjavT?4ӛ(O{SD{TI#`CEsWJԊ9ӦYxPXWY܀TR$\W,]l;g qs_u;0p,!:U憎;ӇBts R5d$h&,A|ihe{%Al BoSԉ-muoEB[;hFj0 z3P1J4pp3Я11}xE"8<!| > ZêCYWȷ"7P)YkRPŇپr:M٩zgMnFwzd[]L9U;YRYZ,\s_.mdA#r-PWE'IA}DE>%髜 J⚁Lak>}šQ]@`ah >lg:$w~ů8W;Wq`x_h?҆:^0txtX/Hh9 GccWqЏ !+ߴcDP =VI5ΣjdTmZiNS3JizM\5"o!8DBkOXd5~Md!&fhJKFi!cRyT2k R+k M$ >1;9!}ZyF! } IVaXZVU G $/NRTӖ-s4BW@nr6o{f> _nH;|+reeAf:Э+G[Ų̚lF!Yz+Pt砖2F T;حHt#-dn) я{CZ3 x?nˇnMw;tyԏ{}l$֏> | x~OS~3jfЬ.Y[ةDC&ᨺ50`֭BQ6yo4hjA!# !jw|q"uilQj-@pϘ MZ<d% %]F_Sa!(` p2iFinlZQ&I`xOhl=t5{ y6󵸟lҹlүi"&],ͳTTspY[@&ͨ3K Sͬo_kI|+:57u-˞>hM!lx(:{VqL@˩^<tw6ަաAc|iu2\.V['$}KZ=*fN`P mC$y$p%J1,x!Xdp#:Ydp3fiZ=d p/:dRpbm2վrKʕ*}omi)^ 5py Z`2M3 m (bS~ KqIী_r@>u?5$>?D 7Z ソJ]̈́F43CےI,3;tT8;uS -, ,'́/ $!«,L=tkoMY br_!%1Gi³*p#b)̂ ^0i''/Ba <~(AW$ †橲$?aIeajtP%p%z= ~Jx9,o!.IO2P4Kٳ'!dKa9%C ~5uH5E3z.)~ >aݛK+:PᶚVz+F,8fN(avlnP!Q-%ٽv6 ]FhRve븣,GpLE>TX Pu3ϗ`d't-L)XHn5l6\fG"vXcnK) ~"ח>X~]M+_t*}ok@O9eT/? @ ϦjVpO?y҂&ǁqҢ]fH}YIzݸ=kڸ6-0uK~蚔gbpՐT5+WS1Mm#qs[z{ꆓ6O-r,72Qt%--Z-5EHfz~e(LӇaA@<6 9p YZue[R թbЇ(*PGaڎo4/>rxqϑ#^sGpt[8H5ctlӂ>1%oWu_`mD2Ƒ3Jz+Ũx=Y&J5*H =VUI.'M*1rr9IT:ʛzŘ@|>MRVjljv#֊yIՄFTUhYA50nibsOwOűr:3n#9F@e|Ӯ͐V?%=z9YfDs$nfCi L!- 9;O(MgW\;nĠ_A,,9"r#+7!8O*tYIv'f;ȿx߃wOd[ܧ Mٜ'KKA,y"p|8+e)iIKDD/焒&ts8 sk #;pNw n"iG|hO]Gc‘x&&\^oXշI-/޷I\/p;P*-Ίx+N@;WKՂ;H##X*NV¤ fپ",KV[4'_r= ,h2ՑHцTm+'9&'0~"ʩP9|nKΆ]]Q7U- jF_H\7p#F]*Rd:r[`9N~s}+Ҋw*4T-7UvfL'lIgh61)AcZ+n$< ck ~vh$є4ڼ7L/ꍄ-QQקD-F)Z\C%jD ld^ ?3,prh JΒ%(9FW.K-EKPrH-E'"$ \~2sn}Ϲ(3ַ2򳠬|>7 OY VE!TYZ,A,xAE:j) (DK[y(@-w<,ōK+  +RKQ}i/UJ7heNbVВE.[ iY}J2e-YP<[NReqYCY*겵 K]_HLR//,B [*J *Hvk&– |+n5=35TRcAMK' m{V2g V6UMN6| $FG҇uz:A]! 5i!Sl]}$q_ ߄v&[?$+)#;ᡜw[sNٮ<S(9z륕g&U- p|8@n -y){Tq2va2Vwf IwWC w)p|>4k7-8YF0wB+֭|Gj6-_Yq?s(E0=&8ggqդ*8&4ۑE:)Z:EK4/\p}+w`.`?!:^yBBupz a*!Mr1re=t:s򡟴3S'c;zTI%A6u~._9aSa_IҺx!oGҷ|WѧՕJ oCeuAV'̲$tgZ2œ!ϥurYDrKՂC9m\{S6.+|_|fB2 ,')8&~9$9@S&n&p#>%UbWȷr7X+~0: CϙsHKCj=OOSϬNaCf6kѿhjmx1i 8.=*mP)e9Tjk}2gjèRG@%*KqI\3p C:_C\JHZ$pgE aO2)e7)*F+҄7$~qޫҫ"uCjР L8|4.[Ay#ޝW wgC\jh9ܝWÅWGΧNMog-`\`~K|+~?^]7elZsHs+yaC.ɘ!ZI?Af޻=%O98>})ZJ!KZxhKAcFR a:Z82Jpz-\۩IjߩEg'k) Գ')gYid'x(*WWuN"H^&p]Ve0sܚp3%M"[|KEEM*;wc{6H%L$/p>i.x8>M.^ ~mhLK 3&J3KxRHZVP_€) Zɢ D?qyoevǞ~s9|;Z~iyHkfÇo_aSi#;(Z PTᆬ9YʠYpC54g؂d ?Ky{93,j~ {$~qB"BPo___X_ے}=\|=nspf)~I>ppSo<ll1AgY;eJjU,LM6U~/Ow^/SrZ_KT)| Zxe{vqYofpLu\I}KОV Xq|+ rO_Tk D<^j]-[J^ <>G]c< \\.EBS|wfk|ok9\1s!N1#w Wt}l춷Ap6|bRaOiQBZ]!-^ӡl2seygDWĉT> 49S4z?)1绁O?ڜ:Y);/N4+2ItulcB=Qx>7fs>zN~m3ά8Ǹ1QN[l/o*ކ?hC>I`7àm{OWJ &MٔX^r4SZԪ&்˪o m۔侭Ȣjd .2 iaӦ׽d M;)Jk/R;-#%sL zU!orCfmx8lP6-nP!8;dڵhߛŅ,ÈjiG؎&6ҀA/*5:} <l֩nO"5௑.r*bmkB.&o]YWv &,f6SEw +RJwך5]Bn%͘:ժ]=˻Vw\|ŊUkYR}/l*b~W3$}+n5vq;QN{[rLRE6tg$\?=bhnnmUjLLꦺ͹vPۓVdZJ-;xp›oׁln(iqvo'^|\踛`0uxH#w mM˻W (>?}C~(k[Y޾j 2g٧Bݽ|U`@kRUU*!Ryo}%DG/>{ŋ(zĭ֠ieRJ_i|R槔ʦVtubS93Έ)uh윚ͶN!3xK;k'>O۴,[:gDZ7L 'xh/ #H+_'{*SJ7d!~WQ$]gBU^d7 ZC_~\"q5x"pX޾|B%+_fR Q^Қi3o[/_#C[}Ljr+jZlJVFWY*"V7ᔲWJݘ?UK?"Ŧ7):G7\g&<~tH[?}C:T:$Xt (!q>XhsgrVt}D{O -}qg5+R+4G??ғ|+n5(U8&a\q 0 sc+}W&64h9K:n[_ vvjiCꫵT_nf'`U)o;O~竾g2 ôj?K [r9>YُK _k n޽8קٚji̚#qϷH?Al cH\bX+Ή%87* CZcZJ)=l'iJ2ȹG֬^g͚=7RV[Hm]K]q[rwۤZiR4`*J_a* n)mf8z\ zVni-].VUnmu@?Pʞ`5{Mo֡"~Գ6)7(߂~*ꇭ^t +iYZy@ͩ:VuH?pdm?HncTH!UKhc'.C]qq97wTWp(235Bw{APnp><*fWZEdiy@3U6O[tjfLQWbVfctPJۺU_9u?Emx eOލKZ3XL={V*DJ!qPZ)$@K3Qcj}> Tϻ)$«FJzHYjP4墬غӓkWwlҪj -` m8qqx) L3c%5cw-e-]IpTv;:eDI-Ǧ+ⳮ=ǁ j$R|v-rEr:m5Z\9 Lm]r{)nmO)W6!{T^ 2cWa-p5v-7/,)>71 :@J^ Ԑ :I!aW_kjcĽxx]sih{mAv=H3Lũ5<`]Wu]IշZ=H> l?C\~{fѹv;YV:&i >%sªs}?C\!ߊ< 0 ayDB=>dK .oN>-S&e5O?5S(3H*&\/vׂ1lMϤ6nxF=x:ކi!=ǐXߏ,^tirRR0x| x| ~sh_YZd݆?eZr[?.elC@D<.$2=k?hq~[T=nCGIFS2JyRm)# H+*[˲\D# ipOwm 9Jթz>`;dB/^ƝQ3e.]Ƃ6h}X4lGxy~Thz6-}_ͪzh_Uͦisdadl<3y%n OMm+IJli9sTSvo_3q~!<o9344T`i{Z݊QUbtRzo%ϽR]5{UF C9Nt&9ѐ ?3X959ug<Hձ1*!<| ke!C9u*OųiJ/O?:t*οLZݩtZp2!Uv4!C9v\Ov,?+7iۤsB: }G,|>S7Ѓp.:ׂl嘷NbgE TjݖBDJ6tw{ :>W(H|iheOlp P4p\q=W+C~LtJp4Zm)ޔ#noMNqLn(e]oLW_f 84 Vl%6AKx; (cu0KwU7= ] :jPqױEYNӠEZ1#L 6@iuB?@[Vbx B{+fhIx>2w>þ[-RuzB3³ϮC d{(/Bϖ鶦nϻ1Ww= `g|Жp9КoDc}Nrަ,&s.3e2d9eل,c 7o KHuCwLxB$n]9ȂPp Ъ\z/4Y˾ _uL兮5k\;R cpzPN80A$떔jLp8 d7nh]{#4"<\h]ZHS =cKԾ-#98m^T[Q-v kOf<DOt4,D .`ep`Uxzej&,KPaO`m q纖ݘJuwIe5c,oZgZŵdԆ\^2;mt_북syRʎezЙp-:8}X108 5Fò6ѨHG(aolXHxpE֌8ZFc3Qyd{(c{Ն5#X+_.G#+1VWpm̜8nH7heHWGW7j:jY=Ӛ*h6޹6 ֚ t}B>]knE+զ-μ 0T% eZq?v4o ^+Wԡ =Sv2FBKG˫C-%N͂Qn e mMKĖ(w[q ĽWj N7VO!HCZI3́ĘiUژ8@(lq^*=DܑGwxei[3E/C?3K}^s'?ͺN's3:6?7Xг]+{zWtUWDƊΜjt"txᴉ X|&zڞ*ča)Yí9K}'P26mJllv3)%i6iv$cܦߝoo+ӎENZ& [P{`rg3\צK5ny[h 5Wi /W~qLx{Vr= DԪ(uJ5s#^B[/!.iVFZ h*LJ,\̴ #ͨdbfp>⛨7!Q. 4XDp2` [ ?ɇ$Yfa1FAZg:,Bx )1Xǫu +]$,(Nn$qf 'q|+S$D"qf7<%V`\vZ`r2tf' 5Xf61l3). lΙ{̉6s`9CYXf*g.,2!޶oަmi|(-}Pr5[ll2\˔lQli`&vv&st'[isDH|q lnXuCq|++ [l˨58C[a;bi_癘(Fq*M|07ׇ*&ϋ;JìrYnI+UxMC@ܖ(J/Yp|TKLkwGx oG&7IGkAoě?' {"U;'5t$+> |xg sG<*WjԸ~@:nm@)WR#6gZQМN#̩u|N^hizB6z=ev\-Hf̴*_LyGFS`j)K*SQ z;myG3۩?2P#VmtI<wpdf5h] &Ih]*{)Wo;rro-}{ s&1g k_txr39BC?*i6{ܕkF%ni<*z0y_girjRIprj?,]l;g qs_uA,uiL/Tj!.ž|T]M5Ӈ\.HZM5PDIg %O?--g"6Bx`[kI)nnaOjڸΘސ=UwÃo V׀ H[+_A>ڒ*W/قc"< \h>"h$>\l9I6R2NBNb{7գ[;$")\b¾ڒM9 suMu5 &.D<= YD t ҋ(>'GRDOF:sb`}0ԫ0:gS mvpD /?v )(@DR NA!^&X/:(~&{P_"N.eĮߏ(SZ:u ޡ;>a4Rȃg/w4ixm'4T}Yb>{r[jn۴kNP򐸋}2fΌ::Z:c?(X-"ֲc,m9J#H .ofgLt7A1G\0>̢A&!$a?+tW5ղMC4>|<›Fy%/J3+XDkcEb+.0k'ĶpuBXk~ rN(Hs[Ӧis`RvJl0|!:9O"Q[H͜Jˌ҂T bD1$zW1?!v+ Qp1$~[ +ܣF73 0 2 /?%x<`xG-vwBCp%Jy]a0g="piVx)t2 x- 0 Xs >B nJ3VS*#GJxMu[o =c[.RX.0By^ć?!́=ili>.l̈ ye(kEk+o+|mod/ ~Jǜ5ЏcNC\w̗pf]| (\@D9T$^c`2ѹڔki}hBQtd(=膂<56}۳ڨUr/8Zyjid':f >_:>X|{Bt5x/B"k~#G4Q?]at_@ 'ɚzڍi`66Qv~nj֙6-K˪X 3 bk.CnxS2ZVc_0DӞ<.ԥfOۄO!rGXzց#Ë^s7GpqvF5N5Ӱ|&wwlHM=V%U*MRdkkQBYyazXyY DHK sz5t]E&YZa+Ф?wrK,&-?mS&KP=, Ei_ &BOm0Q? 8s¨;s¸$~f +>R s h\P5I+5M}a%];6Vn耺DbmH}l"qBRq^_ \)3c Xn.wIV0DŽl>`{$ri$ > ǤYev+(MVC_xLyCFl)b'U v{Zw?Pu$E)!FƇnfCĿC\7Ėqwf:SE@༆L'[7mX+ĢQ 5Zi,`wTЃ:?=BB928uq>gr냪%5ZM. 9ZgI@\gχz909$Շ$=}@,d+pWܯ `iVvq|+mnϺfNZ>n<ΈPT &}kNV8gW z2(%b빼ۢn,"^k_ݫ]3+0 .o3u9(υ ;4eP$t3mehbm" ?ڀ'*[ sb'.b/x9%kZݒ? ЬoZrBϹE\B?ȇ(Yޝv`tcouYi|CM+Ŝ6s.еlVnRl- ]xm](g Ɂ;38Pvї.6Оnxr ޽=D%inox_fa \^+cA1? (p!|?/;$- mB# >|\la%,JLqVy7ه~H/__8-.p7 wWDЀp&McoE0ȐVgǒY mi-&`KOk(Ӫ <%c%]B3m)4x}+s֔8&-5=l xٽS$KHM 5-*Gvsd[vs|}rz"<,1,'}})ƣUY.MHvKӮ*;&ʝ5%h3%rp=B5PpX^Š "}O?IZ:LfO?9m,Ez<\lR%,.[?ֶZKcX@Zï ARJ3)"FYkxc{` 2DdrmOځv'H+JIѻ͑c75KPV8?$uG9Kˀ9;/\9a .q: C;z r/b]+uPP~.*ԙ|wU7xP--G"%Bd>|4c弩8>-6-O+nkoc|up \^Ios'T(H7Z%8L loإ,O{bר{$n.|CHvwIв \h,{{t &11:{%Æi;zh`kC>ʐ-͖ÌŚ6:.lo&S@ |98C<<} _~^?;WLJ8OM | }axWQX]X(P8!l竜R)#@ %^U\`T>ૣ/$ \(xk8ЩID |4 rC\^ ~ 5pv<~(H\3p|(-!_+0s81@zß9Yjf ʤ|1!}.} N|_hWI1ק̓!uƀ7n ~sZ=$F_Ufk_UA_C\q;t qvRjhZZyn狠(a'x,Y<. M:>b 4BT@Tں$ 6P XBmIl9x84y#1lR q+QV2Aʞ3hjlNUlJσ^D6 7fh<$k^O:&}^ W3EįC=[mF8 re^-@ =56U#<F%qogM>{oKoԽjal-=j&t:=\.p67npu||!ո]xLlM 5$?ZzCZ6(Np!V>2;敀k_,_^ 7fko(.a|_h^ۡ7ޚ#`SIe !,xr1'zKwAJw0T(gq{:)/|x ŖM?]\xU&)9W*=L`i|+aGZ-pJ}KU>A]  u%#/ RB6mu.{ 6;>mরav:WsLz 8鎸9‡|Qcll,MmTYj]rk`K9Z58sKGgi,Bu,T %Tŧ[D*!7TJQ)pgHBe/zNQBJ:CHk|ũi(#ҹ(_qR .w=Q\NHܐ*E!U=" Q!5:G rՊnOpԃ*Cژo;n5!li5L[xD?q> &NBH( u-ejkIX;j'~#vk4 b2vUsL9$C o6 uN9a Ll<ږɶeŽWQs6[h/mX 9vL/b hG8ODR"WPL)|)P0xs|Wa-:׈x7qN(wP׿w%V~{9'<}pN(ɇo>9a>|3}֩Փx?C'ɵvk]j>Py8OO?9$o}u V^%%tb].MckOi+YUakNrBx):sn۴kDj] JI>ЀPSdYؕV߸ Hk,&tUO*7SC%^Rj(9jDUC.h %4P5%VCEj5TRkPJ?J' Xif^DeG:t7WzNϪ"Gn\9a Qpݳ/Kn⠦MiDIv}I_ѵX2yv}z,DW_}ˤ5>;|,MHei&zY V^VjzY^sO[ l* :;޸gSTmy3.^Hm|i-K;̒l24vI{O?-`©^Hxql[$y /:&-\6e)TPp.\y*9x:x +H<ࡗW$kng (4C*w::m_PץlOpKGzCHZԟ{Pj98&ڣ&Y֯#E.0L \9aȀq PI$pqX g!-ԲjP_ z.ϗE m.9C)duvNtp`q>VsՌavy>yE5zv(4 ^ӶGM<m{Rq3ԅHۀ?(NS"Vzcw .sZvʘve%6^Q+mf'F)IJ[nmM#86-ޥ ɘP  rۧO=%C]cu)J)g VXh ZpLM} AJE!觏sL V6C!.I?cV CE^p!oezkaJC#,UfFJѡ$׮Y֡ZXp)Pb!?R l@q TUCNz|WTn^ .ɬJ3$ ڪt(\kfJٲi)fVYZĂ7H~ n_$/y('2eH)W:l]W:U'ps}C,ZqY4 /;3ZAO"%G_TH~D$0aij\J@_ .4UPf6SE쫁sRJw{5Bv=ȫueԩ)ѽf՝܀:ڵ|U޵<`T}g$nT,ȸ?C\qqv*fZۭUvi͋MelPxz$gR~:C3:+FtGS[3vG[(A MpSZa9ujdM U9ae(.𻢯kH\x7ݡ]"${m{{#l6Ӫҧ:km)[&b{π EW&Rkw^"p#U3?GHܳ_2CC\q1ȭ]D9/35Q2ᔲ ^J'k)aRcB.p I3i%>O+%p5Tv󾩀 5<ok:bU2S[@|+5x7x h~Z==+J=GKTtut\GwUU]Hǁ/ -SVw:qIz=EAڮ |]%)o!.Aw]V ->45m@E`&PŸ(ZP0tO?Ibr" Bx2V/6Oҥ_:xP:WpFS}5t[L - ӁuN`xtsЮxEjVD7p:ۣl.'epy5}b/Zp>x|yN,_׳n7GG1xB M͕+K)g>xGC0[o{&[\ fOBzo;n0"G 0vx\X~*J%ĵ?'H⚁ୡCh: \l|-XP4i|K<\f {$[Z6ٲka˕o!C9̜>e & fL)MER܍1N|chPxsW}W0= qC(d{xL1(8v,q(20W;k@M 7!xۥ$чڥSxN@hs p>|Ę"9\ ~>%Wѽc7#1_YtЏ̒q_O;t lfuʞCk+;33M4RٛwY@7lg>Ktʪz3q_{ßߦM֎_B,{߲a@"p+?RU}N2щJ)ZSӞtñL-tXT; ~FK m; P?IZ:5B~ 7&y pԿϡ}18`Zqmg_m$ w9OVwH61V&e;ZѬk޴MW]Y- cXs4c4:ֶ jݎ{!%yq(=ZIgmmS~[lmV9F>綸坚|ؽe{;hj%[3fj/mֽ7mҥʔ}e쬖vgz[w?SojUT{H+z[;::{:g6Y ѺL<=к,USe?vH1Zǐ\9a07;3g k_RŌGȐK|/*i6{lkK{*0RVY6 CcUZc F,>KP|JkU[R$v@F>*DÔb^ c3WȦ^;4[M4GRnOqbb͗?&=ifT_i+h.ՐOfӻﲭ|j'Yu0afׇ~GP3ttmXf O1J{[w׾_Zm~hvwlsC$> KVMq4m=$0~Ňa't]q~ŗv߿f чu:ѭ\ܮbJ1n(rv2Sihnn-6t3Ap& bxJw#BQчj\Xu VχI+,=^u U]@/@PRi2{Pg·E W>5mpP86E.^ ./T]KVo]N/1y0C;i;Zf`<$^!co0h{ZM{Gl 1?i% t`nj1=6GaK O <HMc#q+d#vc $XG5--a/4>-&Z#6c $`ĭ1f`|X_4ϴ C7K DU[.? |DZH P H\3Px??C\ǿybe HqHc-N1?c#qd#vc$XG|X*^FHqHc-N1?c#qd#vc$XG|Xw/_ P |H[1Uc2b;1? c#C>[;/?'pϗ|H[1Uc2b;1? c#C>[;/Qƿ?Rx?Rv>Xf`ĭH*1H\z??úſSybi7_Hycm !/$`_HJ1q kq |X/0 HqHyc-N1?w0GVGH\3k>[;/?'h#}ZM#eG:mH[ <&)c#q:?n ^FFGkt1 1?xL?Rl0G⚁u $^aߙ|1.5S0Zs ٓ47Y<50{wX7Y:T4 ]<]v?fAP6)9;uX :GUF4}Ӭf ;#"YaG!arGXӁ#Ë|`k&%% ~oP91;`:ܯ #%S-"ݯhyQQ&6<8VTX*MRd,k_ӢTuz1K([?M+v^KC[=-Clu|,:n׵28Aa'ϩB?8P:K>>_Q\N+EW="Q7:Gribc:VR5&- MQk,ʖfᬣYmD.;C'.P +d%f8O\Re] 8Ou !>!}lI*n-P{Vt@ioPRqPCJ өfsNv#Őf}qGK]=atc<3^@bKvŬ= :-FM5b}VG6s͞>vdxu>ӶuSs< xAZjnZT Nx3W0$nx -*xɬR {-ӦX4Q5|- |?uZw#n~]n3xZ ~ _H]{,[ G?`̂SnüeMfgpN(xk!I c^L`牶;@<`?Q7e!v?7Ie%gsg]3pV8 Z/<\F)f4?ZTZGB6CT5=bTIڐZ:nXU@\0R%C;tЅ-hh"(h5M$~܇M wgB4k_0YMU?#q7> |V/#oNPWp>}'\lT7>ρ|{$bؔ%)5?4^\\بВ+A;➡%7 xZijțReUfhC m/ mRksK)dt-r[:E_fᏢ \>ߊE]?+[ p~CEIM݃Ū?u(4KOyI39hIdPxEW:ъ@xHeC\(#-Mj&#X P~nhl AmJ9PsfPw'8YֲYv$Շ,ƂfhBd Yљ4deFrKbh}̓ZFF3z5[!bŸ4TMޞ!?Qbd_U*r$g?)t$g7':5myIzWz /_ #2zo;IZKIXX/-'=x!z5*6v;B{Sv&8>(N3ZM#;*b+h* ̃C۪1#eZ dx\$6&-z1 i&٪uZ]wc[w*DӐ Oa=M,> h&Ҙ͟|>g;v4MMp@nܥWa#qt,>O._<.)<>K⚁?$>].[|/Z 0|ܝ>lfhXLA*4LO8>*LzmՊF& #x@袰lG[O !&3ѭ;r7aw6Qhz ([vwl%d{o[ܧ5s9͠<5tj0uF݆H wp?V K,w߆M20Ym4 dR8A՛JaGƦ3͌.&/H~USMX^c.~c]*ir B >չ< ǁ&%/Z71tB+vrNN R |;$> m煎a3NбR~`͓3RC|ƀo+k^_tzZg{}cNn7&PooAe͡l`;liy|\_~`;E}G(J|$tjpk.'(V v9It]N3 ۃl$>uF⚁π?F!k #66]|f-ܓ{?ɛΒRxjVYukS:֨cQ f<Ղmo׬[渞q:In>beyc58OyRY5S" ;p῀މ$ i ㈎$w%HӇ$XD$}XDܝFgj֠i-#T pACÁ'HOd|iovE'7"d1os=B%ʄGH WbkIHۀw kj}蒲mRjrw[+yV*pz icOG=DiC}!3⊺"q?dšŚM6[He,-3;ّY1,TM}cbQn -{Q7Mgл XO:f{#Wa3Cay2N p^C#LFGRa3 (Rm!\sw8+R;._C\eh ?q =%XdZêC\q0r#VA8at yO՛'HuTE[[cܰ$5!h5L?J+}H%ųTY o%\%T`iGOBrt EfW]^xHy5 A[$vp6xnwB-!.Iݸ9(˽{ZjD ϒ,2MD?;a.a jmGb'sN'?Cb- ~f.Ի.{W3,}V Q;STu';l]  _6=' 5_Q0hkx37AWj\a|b+o 5uN4[ p1bM#a-Hj,!ilGZ+M,sLxs|1:YUe"e8bhMA|&|5iY[;o7(rFV/~Qv[vZ(~ڸv/n6BܨSۃ¶'l((g{@aŻPmgt @W!ZRi! psD"7x&71+(`K+f mځce+Bf;@.+kʵ@-^ ~qh\hfJn5XJEZƋ;o+Ov]wIl nce)odgZuXwo"j kqLhEx&Pqfi +; jm:j94pUkZ NK_nY)Jfw}nd?!2G|\jP}Sg >.&_JjʏQ4Ӯ-#yVC'q$~e 7i+ŏG_l:{GOFcIqЄ}u#w!$IJ {:^忒u+fnc'jf[s*&&],3\&d ʠn9}ioiÅj!$h9rN(? LNw07% :M45>|scb\tza0}~~1[ns++ ȂzXRyEW M+'Jo5[=`^[D9 $o^Q/BIdU$ K+k=}zNJFh+fIeHYlND3jiYWJf\43[I 4EC-O"ߔf+E %/)O WPy5W~y|Ո- 9ae]9aHc]_vm[BG4'2[:f,ؼN>搣QrH,>^IhrN(avôr@)M_9$8wpk?{&1{nPYz Yݡmݎ`T;;R]YD{ɒ}}?8O[5}!aWpq.ytYrvRc>dVJ=\ \D9@k\gGm0} ?4R>/xiԐ6MJVY&צER*MVjiwH7چckhw;4ϖծԡ(n釼yKY<^Tg3|O8sz+rl`D):DO6ťe9jT We9* qԠ\RʒܲL` QT;LpMtrNx|u>׉(.'FJQCjUJc<{DpTI=JO7+nfTm[4ii䠴"u 5AqqXZ:~^%=nwyrWkH(8'aH(jࣜL.K %YEQӜa?9aH4 O?9DXY9'"~sM:|לJr| W0UVj4RbkKXqD hVZ˳eSwy-ބR0oڣ=V/>FM xHBk9{HU@F#|$ 4C+kyi~;qo_fVgn[πK<[pgKZ_ΖSJN`; oW#]wG9'sz " ;MM\('@I\6:}-^u >Q8[6”OTG˴V[7ҹmCފ#|jZ|ȃ=]z(r C*yr(77MK TN#^Pǟ[׃u  %@I>W!C9o^쨇AĿ a_ W]^M#-4TmVU9~;~f)ώ5uؤ`7x0 8jẞ*\E7o tGܫHM>7(~u45*vZܴxIӫ*KhKj}Lu^JK?2j5cWj/:xxX.5Wm#B^+̪Fu2[CdM(?;;.`E>`EME`V<-DSF׀9ޚ2ZGє!.x45$7e)#(4e~32JєOOf;,iMIFvBчz0IwH!`(|)?uuXZ% 5ignI/E񛓖ftmʈ~Dy>IgFgeͱ9&9'e6x cxf3:M<n>lX9|ޜle? s-!. kGR#C\qoU;%\:v2y:pҸb¾KgSjt~N[@)aM ,ٓV Ce;hWrW)Yb)~Lulҧ'0ְznG}*n{O!PtiW$׏ _ y\Y@7 :T&ŵxkb9{psE)>"+EjysBUJë<{-Vuz5:G riJq3C.ɸhz9"lɧD6!7lJQ)pؔgHf/z،NQ¦z6 Աj>JflVț?lݦUeXXnVSeۻ?i8ge^hŸ=Z<ƾVh6Cxi>=OXnOڢ:ڰiQV|?WֆF҇v%VP+]V ':fW:xKN2IK/LZ:Ov/;,4;$6T̸.CM/e@;؁taPJGo/mP sXc_f5A#;SKkMaM8942EvsN_W {8' ׯ-&c I[1{\,6b5|3=RFm|{6 l4F5eHJ/`9 4pR~\ĺFF!0*^*:P=OCxXB=k? K.[LcHw;igwA[㸏]zFX[]>KMz%[lbFپȒdt^Kx+H@ܠ*-0 'nMJO:j=UfdyZ[fǸ_i?Dx\fC:A[هO1\yBhGk.0dȥ\HWGwJrJN7Г'oPC9؞| 9O|IDԨƵk iJUZeCETÈVj9 ytwߪ54[C]5VnoGz $vhւz G h|D[)jț-RX+g~)#mtRie;zWP]W)gH)jnJQ*pgZQq2:Gr\ň>rNXA8x2El<ŧ)"K rԨּ<(84pJQ՜^/j،Pj)-n-_蘎-IRzOjv!5O2GO͋FkCvاr"5EXGXy8jz)#ltRa帥k+JDoSxYBfSeOqMi%/\e׀PkU6~ = CD[g %i6AcD29a%rNTԚ0_9aTarjGЃ+4 8sBi֩5pNS.I<T́HS\Yi3:fq9' XnYĺY{5ƾVy5Cx1i>:#x'nDuKgz?C@np5Lߖ$5VWnu3,衜7 1w>+8tղtZ1Vp!Qų"FBcJ)\m৺TVjy-a0^Ė"dRh.%Ifީbɇ(OˠǼsǨҢAZ̪eT1'Ǡyx$iyPzj+J:'0-П, C͚;NP4:0KdYuPVO;Wl^;p?>x9q7nPĺ)^ᄱ3 ugi>S?x'nD~{]ϰFݨ~_?D1R]:TkGiKSZt>;[KC\q0r}l7glΘ^Zͦ Y}7~œMP6 %u wmr(fmk~`~tG~ cC/~ʧS"ISC(i*ɵQQ}hsKߧK7Z(?һԲNjӉq{hWknJ}4U[`V˹Qz6XZNc[b#4D=b7vkt`za ǀ&@2e0&"g7--5ҚmI+ᨥ);YO{3h8'ipʤrvsLb|tXlzັpwbUkE8ЍsgsNҡO/Mk2b J\9a}kM-a qNXڠq+pBWbmиx)qd'sЅT{H~`Ɯ4CMXfKXps#0f/-u+b9$4lis8L:=492i7?&E v/) %l^i8'fO?9aH5+V' |shg A|  0˗\lnKXDf ]v?J2ҬnwGLs8 q>R7=A:4ڔ`}nuشsj}=w"m) 04 u\JNS߈OT:s 9P&yI7~$ч#쮰꼙ޚq|+'etheU;p*`%“OVNz&ZSD[ۂVKٙN%w2 +C  m42ex4x"7 vy70 Gp70U̓nXЬ8|f5ZR%lu K, 媈mNl҇w{Dҍe Zf*;t #~Ф<`7Pʁ`}'~&}+~N|o|hT ^1a1aR\^woC1^1ac4_úK烻[oĥO.OۑoKRz[pR{[ไ$>C\{[oԋ저j-yq,e,RTpd_ LȦGX .3N|ONW~ȝ؜>8}:}p=?Rgo û !ײaSM*9ձ +z(Eó /8~/'}+~/@^쨅Z[&ij֡wWKסlʎG}-W'=.!.ieX= +OkL'$s3bfz[nm1U4x:31hu@5⊺: q!?C\WoN0`Ԡ>_BhӪJ-$PڨEJU=KI^`}gX\QesVH=>k mA#^ ~m5.D!#۹_3.U~YC:tvڑYAݚ \ :z~;\p ݚį!AѺu^@u %tXQirtQ p'Ў` pNU8O'|+~OzzN@U=<9C,,UR '.4\' 7~o'|+~o'RŵA!:a\hB0?~K|+~?~p~L{W~ZCq9T^~)??pFG1FGໄu$<- Hz/u-Iy w /0~&}+~~htb-9sM._? %<}/!}wGÍ;zj͓3AX@yO[dM;Nk%O}c;"NK /)XDG46㕦F1I׮JS* yZ$Qz%_R9%oRkO󫱸tE]fpEğC\쏡,FXoZ>-cf'u\oIUN /)^]j54r-rԚT٣ZfO~5bI\35;?ׇu߃D]>S7ZF-] p!PEYsrɨi$Qjek(Vkg+…rѓ=pu+IU>ۿH~քRFJZI~rQ-l wB gxCݻ(3{hA=ثB{` GG/$^!pǣ-CASXz-@"ӝnu^Z,R2(iǖC+%ryNx%P w=ڇ'k3W ;?nsGjN1&-o aC\~Io+?C\kPv>í&]}?!&;[ RSQFyuխ^2.|.G |}8ـe#B*t2';)UмO@\YTK.?WPv D95ktܰ>):N n.>.rt$z<8^Ln.G4ǀ_Rh$ݾ8`h2ߕ3b'҇#~3qܹ΂So#s_;_h=tc*ڸcivK-1.pL,Pҋ9P̒poxkp'ê!C\!Lz@2'a™b'wT osrj,uo_kU- 4xiїh7 x:#riplfn6;Čqr塍Ә1 JpMSLB-x"i=p;PbYnf'p7(#!tx 7fD&b*?p.!qx3m56!#vTՁMAƤVLtp9`Of'B}zRL9HNAR( 6g~,$hi=T(?hnaZ_! _P6OxcsިHS 3HsYn۴s<qg_-^em)RRBzh`ZA`dqșӮiSy̻[驶]E- l%Y:Ĩ9) Źԉsݜ{00QY*-f8lE9m=1 =Es8,;|!-+2L|h:9avy#A Ce\YN(ibgΫsԳ(r P}ԞyB%9O-,{ QX Rz.Lql9aݷ(v}ۦ;W J1 =^Ҭ F5Kj(ݡ,(5JMmuAi<uqPK ' ΰԘC\O]|R{iW$bem[ ,\p1_H:Tk7xبEuPHVRҭewǦC(S;p-x |]h\*U@je5Z+aXPJbWV\.$` 7ʸ^ g=$|3%Z/gہwC 5 ]/^䶅l{q8ΛRQO"-nx%~=1OCh#s{5Zn߮Y97(i3YR+ȑV:k7VhVp9' ZL쪻B@U')9a ͖ n0kM_,R|>lhI-{ml N xb+[0 s94E:Q qNjhW\= -o^! } B 2[orNB"c<nyku^qX{\p9tFݰje]L3`d/961Ng1Oq3ØmẙTtJ`t"Pim̊Cz;QzT2uoHApu_v<=tЮ:>,͖v*4-U_2Umֹ f2zӉ@!*yThʟTj_qׂ RM)7\tk~H: .TWԬϧٜn v vp+êLoCׁ.OrwړZ}8Au'?:tF+c O}y &xw?3js6X3%3vBIjFYw<3zˀrNC`I^9a sR`Iz˔={Qih;^S0F D^5-V2`֡;nRYiLj:fU!;텶H<+նk/QpzZ=?~(bc %{(k7^yP=xx/rʗ8';_ 0Rx!ZbN=T ,3'蹍JfZr&c#q7o0NwV:u({ MIӦumknsBI:%1tJ )ۚtNmm⻁0+ C6@Vg?5 9CƙlE:e}E߶p?L qN$9'WbpNWVT95}SRy!p+牭*in1ep1X1 x)!(F,5iT9Ok98QRt+qNA)ڮgZ;G9'e0?ݛĹో-X1:ÉqNxL;wsN(Io8ҡr.!X׈1'|8cM? OscO?(⩰OsN .銶ɖN}Ҵ6_ P9^ംXNn-p?/sxY_b&B9*!v!z׮uv{ߴ[ WuЉl\9dn2'-&v/0m. c^nW{Re7`ۤ)'8'ԩ5$R[x uaC;8' iRV8wQlf9pP@?9a5Q\Ə9'8'WWk\9('/91sBI"8'q_=!&R"YH? %nsN5kϹ8/me8&tE+~yb2;@B C:e"ҎүVzD*d c 45Λ4B:C]t3焱tc, c!ଡ଼{kIoPQgfi&vf0W [I(H_~3q p;0v2)QnNe=qxУj焒z:)o0XK %9aH41b5SpÛU됞Uͦ52lIf4J%, =o8'] 6ol6: c(7 ({=J)sF_9o;ljK4jYQF4Kk®vZ_۾Yp}3ZqOsPe^&ⷀ?9zuqxK?{ΛÏ,~HCLka8M,/ E6Ea';Rrۡnݠq=7M)K)8j67LX0npRt⦹bSh絴>oz|OOxmŒX76o .4ہoKhXh(6lV{#FzH'X<6z/)$(RiKDP9u+XZ6vkkDl"e )' imByI D BKl"XC:ycɼ8%FwJ ZӌtPmRm9; !e_N}^;M# A͢xڴbch<oK?شsBI&V/a#R48d74cyq 3 au@+bhe4GK;[B_9as' =zRUGU=f5^ܐ5)aN'F!n~s#pQ6 QQLv)*Hiͥ++<7DWjxlF㒆tvmTP6j涀o%" \y]$[ |+[C΢bW(I=\ sqp̵޺U? 1.cRN@ZJB>| ;N>x $ÏۆC+D'c$R%(im_%kT'IZI]VDl}) q{SuA\(gr8_"C9.0.<`޺"{!5W2]a x/ jѡ*gg"oaq gٜJVF^K~ZhА? oWyզ"|:p/X$Y-6c qׂv[L\4 H#G&x3-BTZ7ԩV(uI `kE?LJrkYn ,z9x:x $n. ԋK/{H\ x׋ 9a? ~'Q dA q'8OS>d(r%!GBX&S&~8o$q~s 76^M |,a >nPn}:n%|X_ŻPΊ乮ClfJd[؋Pp.b`\Db/2^vw篁0|}B/!~|sBI {4לasOױD/DԂcRfO$s?g{Ozc':_PD9ynr|Ԍ@uA8|ޱѼ! .3%yCj< ,)W uz7 |Yhw=Nͺ?(=N)Γ/sz<><]w8W@KQ%1F -ë^pX/HkbWmcJ.sO 1S&Jp%M^<\f=7 (c Fub;O %1g&f8y"9ç]S '^m(`9tcWN qYl WLY O4Z윘LqlDsvn.nlvvePk r 0W CkIGS ى͕a {gn| 2-sآILߌzY])xfS-"}OC|f }m ZHkCCwp<˽C(6THeED@/3/cXsOQzXUP!K=tJo\_PF̱ ;4'6#9'բxLb. c:"ቜ l kgڮHK?(*bCwQz%GHsN<"Z ]flEÝsEkK]`[ s꿶ٖZyBh/Tp]BD0FJnfy<'Tv$ƁsN,8' i#N_9JDMPV. (pݷ p w4xPƏ`KfOD~vT8+a 0_mnzd+Pw67lj8ݑ423+Y6 TC%!=˥Kow]]$ݑb޼ϻ{^H8gWK SĭL:LҦ5n 5UˆN[jbR2@97ӲzQ,Av3LpE9nw%Mr@Ao~CqhP\1nt==K]TuZ_b,F-5tİSn_I,ZzVd8 x?s>'|g?n;LoS5.ٟErP"FS_ ۜ犺uA z/,MznIAgٍ8LIsqjYкa/RUkswðQ ,TJNގ7gvl|Zc8Ǿ=GMweզ`-{[nYw>~=3lSx88)&R4y;9NfYc^)5f%U٫5 s[l,Y/ɷG6ħ^so7noW$vP#m^ |Xp)A+.83؍ܢ"^ |SnQ}YظjZT;EeW^8b#9uLzizNͭij$i68On> #WUQͫXm5'ڒGRcQq^wu%%46l:FbۀG˝:2oRPuHxx v76!h̗Y&~7Ȼ~g/I'SDyI+HG.HO'-HO< O7xF$J kWeJ7Pjќ o4}G%hQڶ#rn|y/G+B@ErSʎM8$~g/%(=lNI&J7[cRuѮI7q#au7QxE'V8t:8>Ќ-o- Vyjy ZVm =;Cj0wՊ~:cL"U>ynߜTx%/Qfy픲+m:Vy)Gb[eHu7YajTӓ;?e|?c[f)xx&1C|}>"ϾOa,z&mU>~څ3)k_c#"V _*KdH H>|)8"3OFbq*3D2r t3) Ӑg<("Oy'-+xFV.~?uHKEvՂƴi||Xˬ^)8zg\xi*uK՜"N6]IpBEVϬ"CrG۽!Yc (M8ڂ6;Mˌ N]CƴB:iȋHۀ .uÍ%8)ˀPB&qʼJp4|~'_z3K-hyۣmӭQr;5:|1~F̒T>hZkZᓹxŸcxS:$p=$1^K]SeG9q~eB_#0k N̞ճ;D9h.P8I .W8:b5M.2֮37Wȫÿ; .u>b(xe%V$Xi.;>#Ψp5Tb\W!׀ǟwy_@\lt֘ {{'&&z"M7({ p|Hچ*No9Co 0sgjVkmӏPv,bADq_>)2?ߠnGӥ0EZ*N[Ct[CMe1vu;>ݾGR RwWʚU E=vphIJ6 K QG$hOJ3:͊6K,j䣖A1W|$qo~ <PO&_> 2:RfaX wrѫ.R{HAmg`oժ5+WY߿:DDtg| *m"Dp´k?殢j?uU =Jm#9aZ)#VW]k=ϢaWu+hW$mIy8Tg-ϞZSE.)$.wMrjBF̛Vɍtt<^&v!qE񏗉^W Q@B_ /mr+;5+֮*A/\zuM?kfg嚵}+B3t}'+_I!qo~\*MI+m5YjY]sϚ6]6٦Oti T*]ј.z^\?fzFGLkyCqpwt`M&Vcb׾JĚI](b_H,~Ԅ*pRZFBoHWvls,ͭa5Vߪu}kWI\qF֚Uk6H_ _6 UU${i$WjBjYUE]ڕ~vf[= M2V:\gS ; WTVNX/V%[Z22uKBŗ <[lYL]*j^ߗ|D|\.Y ~$GWwwXNiO+juk{V`aeͪkV M#B"oW(."q7W$ĕ&NV1K%*\}siWjWc ռa4jX+#^2&lgu Jbw!&ֲooxr;TVW| hP>ߕ|D |7P% ^uU@* ?|DGbj[jmw5kJG;uru+5kz֭X7пrՊ+EHۯ?H_ĕ. ^E5UT%Ku>&$Fv,%Zcn3W=b44ѴFZ ̃Ft ?WCl$H)V^LtGhޯBYSӥG}MpuSB+/1Մʋr}Y+@+/Qo%VGH{eiةoe_ZϨܷ4"[ gпVUTSkZTƕv%]7t}03L>kR[@ǛZ%ZVduWoJkF-goxz yu_&o#"+J"q5_7"[UWIGH/cEH_J_*+J׀?2l ֭X}.Xy1=ʅfcW^'o_4]XB V'_؟B3 EIHWjV8ETh{SfKT[[mP{ℭwזbc'rpe$`{ěНU)LWA$$d x\n/SVKsn𻓯Hm{m4{ZB_0֫|֮^wXcXV?9xq)zc=8먎 t+lqI:qաs{q|+kLBdLH^eJ(x" m9.^3Dl9$ x2oW$6eD)'ޕG N#N4#z}}=( /<X)n'wlIH:lnߖPF-෤{{ہVl8w tVSa#/B{g"'`)jRN\vlAz,(Nk EOL8-z}/Ngr;|/$ xMH~\*污\/Uxew K[:M>cj,rی_6/a*if؎ٻ4ŶKs C( ?ԄYwsOaWR(&!btp7n*HZ 7(,!7n)-qq{m`b'w{]+N]櫻z~1--rq}&R 5J=j,*Wu$EȁP|%Yz`h=:&b/3 %=9SgQmf&.8㞹N-G[tބ[Qtp܌?p56Ch`n12m:̈eviys0?)0?ZtQ:K9vl`W㹮NYa~*rMaWrǸb]ˋ%cr.NѩqEj*;mm)EO9O~2Zxǭf`\J&fwnKh²QMjܰwJx)饱↪nټ'<=< x:l05R zS]%GCo. zα[9tuc1#5x#h7mz/NcCtUܑA=&DdEσ,K{CJp-v"CG}R<ĥzu ;z)<8PP)8a~zԸ@^twM-,G'0K9+8^'Z/7IV;nu WCձu_*@%B;+8z6B^ylYyC|)y\y6K%];DdzqZ[&EVp rm B%2!kL;ۢxbB˂[گk}͛ؼ^ɏɸ*< <̖sF]JNFV#Y ?FQr:ntvFV堍:9Y4FD(!6B v^g"yXWC[}q:2304uYul}qK'TVSg4.1\ ,M($ qWvw%x;~8RMq~0gtM"MzRw7ā{ +fo@uU[~;'O^[eZqO+'( YVC/S[/Cfk܍qr2ʣH3w^4oڹg ytOC3¨x97|.` 7E-Ou zb%:("pWSW!h,Cv;I$$~Iq)2IvE\":_]<}nXA?:*0  ^^Y lcӂF1aچ#Kpqi(_^@Zѝy6ͯԌ[+zq ]D1Տ}­oaƼR! Cv;4[?y>:e!ju@XM߸{gsu7o\t™E򽺋c%1F)^֔!C+Sn<\<z3bULRK7Lb`Ah۩W,s񲘲os Xܵnr5OU=І=4-ϱ^B!oSQߖЍJ O(!IہB/ f?}l0zɲ :"-O ~cU4{1+~8Pvnr RAzb `87ھ+\,x 3a:}yVrg[c ~9g:{~}.{c^U.tol~3tG*""m=wRs;iv ;p+nqw;fKYa 54ߑGOq&p%x! dIUW^ +-R+KaWg.>U>Y ՕG?BVd4!Q,v/JɰܦGz6csKXX/%t{/Uf^xw?e/S(6dow/\U30CW{1="֟>+\x(_̅¤f K0*wraej$ +-R.0 % 'mpRJNṰc% .𻎐dtz!e*Ґd=|9TV-&qwHJIJ%$ 8x,4r2L@\' &0raz3s)&}WnR.LraeEʅ&\X$rU?NVj\X] ~[cX)t 鮖#ctz!0Ŏa0Ŏaw7&1LڀB#'$lZq|qL.nfäP;p!Ԝd^SzlxԱ+e5xI۳ٞ^dst\OܐXध\#$pNwߙ|$q:VNg‚* ׂ6Iڀ?~$ 'ʗ] Q'L;P}#Nנ6 n!~6UIƁwKhĕw}$ENR#R!,Z$qmׁY#'}q9c@䔓jOV4̚,,i-/I'8>|$qEK7<%)v2p=&!ĵ_/r$WQ8&/#gP;P}axJIO8>rLWB&+'"WIFI;|9ʾސIڀǏT&8'1EN0Ivy,SJ1GGI:yIp+$b8 x\*tE$n xБ1IۀKhĵ"GLJ?b^N4bFN1Iv̧1SI2ǎI:UUƮIl!p-d8xmGR$]B&k<~2I++y(_ _r-%VaiJib=Ƹ95J[e#oLgW]2kpϧinhl5iΒ]Ny2T%Wb)R;v+0a[*#EƁw,/G绋C0md:5tk~962۳oB3ۻW9/|Df n ].e tmOlVV1R)ORfy[cfh 0՟!]p?a Ji5v{t#f^"8B#J&V S0bRgmeU#N3YEI%3tr6'L;K'v +,hq ځI5Z/ri(N0qtm8-l#R.MR7S)p;W$~wqOMi| ځmFT=إǴS.R F_zÕJ `T+ -m$/ (~UWɶH.mTFk(?Fe*՗Q=u=&ٛRLVju2њU ;:fW$ |K?"үOC"L/ɑЭTwgVd8fP:=T4w̮ ڰAՅjPx〷K%E+<?~ Wet-z X;Pvf²n=s:{rZ9KvS=Añq&Zfcf[N׋J"ڐ6+F8+*t:S YW.FkSIOP"Q4jDQ>] (&?KmԽ:@=F.'z?Qa9H3 N/>,xFXs?{gƚCĆt.{0fR8O  OC ]пүOcrIֳ%j@j4} Jo\/VXȭA2u1RK5ϡfR}@D.nO ]/gfRv8 >N p̥L nc< ^ml^+we^^,Jdx\!$.v 9Ne&9铵} <Bƶ<uREK-ljw!eW_tr,?ԫe7BM n(Nǟx8ɇnvS3 NxD4H_)\'ZSĽ* SW Nx4H?$\c'ZS< bBp´z$5zg1nuqn-cuϛ<^ en*0ŧ4 N}|hC!>i.J~M".~{=(;G H VǟN`]^`?%L /hvB@3HH/&8a 'L3>)8ᑓbJp¤6i'$75Dಯ8,I(\wtd4Hazj @<RR71G\AW]G-'gA{OrBJh(Zd^%Qj(Kku<#!,g& }ϊ84T"-#zhU%rAy,V[mIhtRN:kf]4X2|7VJ}x=ze bt HI_ C($6:RJ?"'a Ǹ nԒLJM8 ֢cD7a԰ ZUl1]vQpJ,/U< .7Ůny=JNX7r~pOHˉ|<~操HsKhĵ~q:?sL58\tzzYu"2%r3'[6,KPQϋ13?E^Xb)a4Уm*e(tibJ]{$q7"i"N0[d~%OG*^4R]:wz.Nwd^ R9>% t?Mb ]pD$W{(ƫ gJN ZwFyG~.YRX&ค灟ĥۇf#{ _9ptqIq9G\i`G"-pRg)߭}y >XwY\.+m?d>{ձ/{Pp=zu)tRXq mbtIgW`/3-'aoRflEG* Kt4f:ԝls㭖o.-HWX<Ƭk:EBp:,#Dˎ=n {Z%J$s<=ϗ?Y;R>Uy@]D6B^QF+ӭԐ=Xoʫ3xĩI0Jm;q|u,v0j>T;jE>Qsq>_ypA1'R'Jqa)n)bpSېs7Cq-Փ6e^3+=~T=K̼KIԔ}8vvLvD < $%Q)2{n4?>92jOIw 1%[Ϻwwj4#VpJ]3LZ-wQr7 Y.# GսkW)Ov˼3_G\7onreN)gr9%o8rήIry\.AK&{:Y.#0KJ5{+e |\n@u^~Yc=r˛knr[΍\ʀWʨR.[ϦrJp:V]<%\L.t]RGr/ajn V⯬])&/WwL{A֝g?Sh;!o ~s|:Mo j`oô#0ox\KI38gIsh=9:DϦ$pG]HIv>~Y.# םսI)@uR/| CV7C ]B<\R搵+$Ly5(Y's-&@͍2gf JlZB GNt5:9SP'p$O? %U}$fk`u/>$unKX@\azxIK45K/m9. }r=@HΙi f֖93 Խ2: DMKȉ:&P'yJ.g^,yŧ? ^ѢjK@\V_*x dԻ7{<3;e\zsqH-S)sq"Oxq1ԂI]R(ѳi 79QgפIiD\W2,8P]&n/1lmsbe[دe#FqK00<8֨ҿq3nӽN.QZ={ ">!BԏůEb_%~?%?zD{쮩OT}{vad&ٝq*=m[fFޯ92Y?Ď:BHWf?,8aS3'0ӂ6#s~Y g?; Ӱ_){'lj&} ӰǗY|[ NL>O'L&Lp˜6tgBU-%*:jniאo?zR5 Ӏ *59ZO!8a3[+:jZP:ƻ0 hg7X 34uY0+PMٱǙINJqɥ%O.҅Q#=+?Q R̘~%ϗ7vgȜΙ,-sj7 RGnJz+ s85z^ ;O? %U}$Lٝսw fP\Glm٢b ) }Zs2jֳiɜ7Ugפ~Y.# ٝսLI)&nL .ɗ0cN߁-Is灟-C'Ɛ3ލm\q蔝&[Ι~kR8־)eԱlZF Gt5:9SQ'pdO? %U}$fIl`u/~v~k&TeԞ\F} 2ɨ׃ml $p#xj$r`H&0x½9?x@RkiF)|Rٔ7)Uk$:z^Nt]RGr/Ac V< 8x@&S< qg8x@sLwv8x@8gH< ujȨRF[ϦeJpLG]ʨ<%uLFt]RGr/avn VZ< +M< kz@.xYKj$n-0A]N;"7o Q{I⊩FNV b3'K;7I"'6VIOSh4~N:69x.m;xU) mVe~nt\qkm+d7xIPX!ہwߙ J4y>/L&_6;V~Dp?Z N싁dja*⊩Fk2@8a+x29fȭ mp,mڕ1HJ[x>6'A>p#g =h7f$t] <\:׆F.}ԸVQ+e^x-M/[Ϗ_Q6|O'm?YfzBw52:jQІ'5ax^V_j8􆺡Hϰ uǴ+,W8s CcCú=5ΘO%O쯵 #%*f0t0fZы VVb5^Q*~txfڍIM/3qAz񽈃AgFoT~[ҋEghy}٣ݝg0]&Ŗ3<>z}|"iPG5yp1,8yޗ](bgWRΏ9=]r_ѩy &ӥ1\yUݕwFwlX?1f0G 0I-'n?YSl[t1W4~1cz3W͓Or^B"IUHϗx5{f>=<ݜcd?hAg^0ͺv2pYpēimoYQ)FVd˻=";x+nkhRc{qo`Z;DrݠBQ 6e{i:8 Y/RÉGhs/͚k ':O^ Z_G|aŷ]&ءb>SnYPaVвÇ}[QL0tnj& J\cثC (d2_qnMƈx}K%Zm_~h@5hCbjO HF | | {z+`F~PfhFQ_a<&z5(2Wh}3SꑎC+ uM1 U)1DڎŚ%V,#oLґtzthd޶\gútN#wUcv#7/jD3 {*.\=1*(潖#w"Xo5 #862o?0|$.B;2OͧLHZ{(o%RױJmPǪs෇6_vAuJ.F+NJ촲 4; M*W '8aLkI- 'Tdg˘bid5 c[ 1+iՍ92cvXRXU?!#Y󦓯( fʄІ)Z.'{돝h{̒'Jͽz쉂*.IxZ `)xZ$2 czW;쉩|-[zuw`'ŧm'Jcm~/y.rʸytȞ|1\. >_mr$Ϣ3otlԄXEug$މKv%3W Zx9USt5 X@\~e\u9*bŞQ>j%_daRvXDpucsNI)utZA^g II&X @dhEێWQ#vhOпhs"ۢ. :i xaa$4k._$Y];aE}mSi+ws[j}c?kH&ls#ځi lz_H'J=bz=>t%k~2`5A =]4Eșձc{w~.m WFH]X 3O?kУ|  s~A!Wf–PlPEq& mNf Sp>LZ Kއo$~ =!n:rMo6im-wq)bl˒V0{Qvvhuw?#&یS.*eJ_ Gl{~埭]#>˳rکH9c!WSBaxTuɟr{"O {/o*|#!=J$n p |,Eld~\sM8.8)a :)wnTҝI > qP\Bw/y[t:zg?g%g_r=;&i oVlu?)o t<߁.^'ܳѼz61Jw!~/0Tp´\]x ETf .wpQJ^ZIs]RE/݋JKoRxg+)􋋁ow'F\pXAz7ߐ;XUZ@:K5oLgflۀt֎EvI,ʡQF#r x/A_gy-oM׎/ՁkkW(G G!Pi }-vU<`꣖-8mN =Qɋ G'L'W/._5~gz_@>"7!H 'L ^E5MXbM],,B+YZJ~tfwNoy-_?<$;<JEt9H)mgdz]_aCG9 m+tO+mOMAZo+0" nex:1BcV*ikm_ ni<"Z=AnNM4JA **v]LUƒz?%-"!2W UmM^$W}-Z* > xXZ*4tw?"N2W}3zx/i뀟|I)ৡ˧꼢.}=vr%o[h"Gⵤ᨟N؎*G:3#wkø:̳Q#Ͼ˴Wƒ[Q殿x/i!vp]{dI>v[-)Iq]qQ8ePh,G \ήS%P>8z5)xlf1co {,F/]/jW_LB iOӢkآL!>BFO$22[) I_0Qv=Į7(+/>ƮFxvxc f[3 F_=eW\c7"ahd~YG܇mQE5}Cthy?wK,ct ({}:>gN%#x*).=huWX.dX(']xpf. ~gAaG5A\v#߶ zl-cP?Kn/Bަ{#k6 t уDێt^._Oa wp;r%t |.x}YŲjUwRA'_ Zѷz劈 )c*WtT+$eE\N<<#?O}f"ϭSEzBjBBoZSjYVB{:b=ZBn .=vIn6m RE>_6êa^zYklr!e_ T}r!q? :\qFEػj*׳ʥU֥mp hO-)jY]ECUBNHsY=cgX:l{c~oѴʢݮEdz4͗ GǛ!|=WI{H $ׄ*?|?\_-jk( 'H-S%^1B|w6ZUچEWuu7I ՘h-MG3uXvMG}}k;#;hL\ glg5ciF,%.ڣ ^ + |wlr+fzvEU1SPf˦=O,M2 3#{?+5r*,la)~R1swMXX 6Q7V0GF ǠuoQApGpG}=" .7W? mP6$=|)KcXRnߕRe7Iu 0Ӈ֬]1 #M"OHܛ_R9V0vT45ݱ-K͚fV`i}:o3F/72b5jB ^N!qyp$FC = uuȊ@bK팤78.&cfJY3 Ne۱ܿo{9#X<ʄ=~#ϑ8@qaa*L[ʹi&Ŭ}m&fdMOstHp;*ԷD"M>7K3Vm!pFEH[oQW$_QpL\ݽnTk Tdf\3߳.tlHAW$ӥJE`1?@\iq0wT{Xة@LcIRѶ &mk֗n-unayVYwa[AyVeC&t'tJRR'EEWH5I&+$ ܛ\r! [ s+5LKH_"e;rkznxߊ=f_9'U*$IK3 n%ack$>@\NWďTW̷j؈ * Jb-~b[lvI')k .S/?x*](rb$r`xO:>q678 $$eó%|s:>|K:>x}BnGLa+p~11.Mg?+xN0pl8+:)"! {UhJ ɺ((0^.:3oƝo5 e۲e˦m幢=کمJ&*=Kb3ȏt/K |[G"Nʕ ݭ8`,l^vaF,cK˛yI MdΏvF~[*r?d(|[Rdew:\xuF""ְDy- I| o19a;:C<76 ?6^=[dXLw,¯'>[J=Џ挚i_עO+{wOXл{b kV YYՋQޒn;^+eZaϔKCh..nƼAk6wc?OS)%hŒjV^Q;s/xt[.صs^gQro7\dS?×0_1F[jKZH_-#jFAJ&{)j^M]׫x٩$m%ĥ$[SM]^)z&_Ec%L-<`7}NmLM ;ߡЦ@)CV3q^}5W\{ݳi;=nϨxciՏݎ{-wu0?;w3~ß/X=\6q2^B\pWzƁ<=_HXdww\bGNQ-Qa?j7:W~S;SV]p`M۷uDWh(ŀ[>(L+w;[q;Xe*z7t׭҆=/P/k.m׋,5GK@_gF )i&|<)PSF_dg ! QpPn锩}Ժz)KVjCԹeڢDeθQr̓t/o t(7ߨ4-\tJ(5 ShD@܌1H<RL(m&h$@\'h%h$jE]Ѫ3g 3P~F7 \|.gtO.xNF25gT,R??KVjL[gyq l[4Osi3UZ2}=ZZG Tj~m3Yk @ Rd lz2zJԨc[5TU[`0~ قIo^ c^ $'uj@M ~vu9QF0vZAe^NA*ehkn{+C^Z{"nMm8Gm= [ `kz gqVJgktF92͸yzbp 7IAfch̓[oQ<~L uye*E/Cyc>R?KVj,N[DcNw1-M'xj9>"x?$&x'}o}jb5h+-rpUg %xO\a?9}5%'">R?KI.F m ԨtJNڀoJ' [ \+&Kh\H:3Muꦕ/V f[毘 51||d^];niÆ6j >vXInp~I@(?9U2"jK%+A-RqX1Ul\uߛ,m0L??7!FX}Ku "+,D WJ:{$|)79_5nv.a%%ݚvR\7l([Kxp&/zcC]u>s1[6*E=r[3m֐hH @CPl$n7pD|wrTD)9 |!eFpxH 0>H +>!m: !񯯡h/hЭe&ӊi:4LwؖyPP7Ot=jcҝ#VwvQTXhůgo ~eW*E|5ӏ_$5ĕt"qmׂ+Q$ҏ_ `YBv`lNh6=k5Wdj@mX%RYYrfZ{hq ;H{&VZ`8AT: ^VfƵxC Mo- < PI$6B*Q~%ce:zUR)Ĕ7p24ov*hdp|ij+Ӽ+$ ?'b* 5foyȊ I]Cn W_:ڨ]$a{i&9@a?@lFp˜F煉%wt)U,p@pBej2̬^,xFjCdfV'i5[aA3 ,088$8LH,_B@|!x `1ݟ!]^|-Լhk>H]q_(\cK, ځZ.aRMq;toJ\4kU'>]໒W-$~wq'OJ8 ځmFTI%fM-9k'>+rJ{%p<0ݑrJR(^ulrJej[NLRCSI)`9: ~{\(^׫LÍ 3 ĵwJ? WW(ZI.@J\wt^Vr~ Jp|L[ :yZL\@/5FG0O:?` _#:Sc5#"z3 (8oKĿ5/Dl!',K_LFx>ZcGLϣ&mar,UJZo1.h9<8.53/dmae$sThtn8KyNIdfK<5L7yWpB9g. 6:xe%Y\2,NTDG &F NtK b<#tKﯡÞ& rHA KՔuSؽ,+ͱt.m Q0RKDU/+EݓEX/5?[!u9ʌpBE/JyW2 |x}Pdi ^ |eYĭYQRy3}RbD7뀏?87huK462F5::k!͚f[I4/7g"ۜQ@ eN.8a xqS ?tBGg NvBGW £9&+FI[R;p1bnz5) ,DyxCo~I?Ռu.QX6L|.si(/ e1"jh%}ZPr]+F".&҅R|x.r % qLeD5Xq_)Jp uFBH+*ĵ_ PUM[h£9&*-W!K鴿.:795Rss"QB|6p %&OEbHar;9*Z՞ |5-QCVNA OD} #)HOpmܝBu ¡oțT(ӬԐM*ԚeM*fsf{U$+^4b@`^Q.ήqIO:WLFq5qTQ%E̒dM݄G8iMC:I5<$pjj _›.=߁ ks x. `p\ DkRp櫮|ŇeWըDpVY, DMhpNPjInFp0EVߎ4,(~Vƭ1.ܿ"S=XteMy)te|1m:_j\txC*)S/HRBH_Jp˜<@/C4R bFp¸Ou\m + g .-z%lY;pQK]ZN3GxmlGx1␜AsI)K⺀;[$*3IfVX2W6"WaXwݕٜקcomU|^-w!FQ%ލ[Vk𮐌x/u׃I GU~$R[wˏVɜ6H*8 ҤGx:Vy?dz6ObGtQ2Lo_ZݘZ¬iPYM2 f.0 NӬk#:f3#!C Pܮqsi)rf[\/xf}:fn0N L’G m ;[Y*R&<^w30z>Ok pVϤd*>ÂJgjW䆠HW"8a;"P2RFB><LRCen߬7S)Y 9h"-}R5a$R H-ύ^}q3R͔)߫ r4 :V(5D~*2x){ Nx7_Gp˜&҈r$O:(G?@\IG9,\7F9J?-1(`paj._*MSj0gWr%x&"m;mVvQp F8 `D~ aռ5_&]¡d$v.)Wjdc(5Ѯi_v_:‰R=s_JS!7z~=_WkC$ĕ~=1l`^)Tm"P>zf}Xb7:3c X.ǮXuDXQ.mZRD4%q7Y]Xc5r԰F<'iaJВ?OSw`t¬2N?,_~ ]ԯMӦc8ݑy1QJO -8aҁĶAl~M3pcj_NQ`9&؀I(\1=r]E>.RHZ sP^+3׺óix,Sz_N< T埤#7!>|OJ:6ߔ~#o 9 c-)~::Cvbҁkz9=A/L.qIc炟g% t$~yq)zY^ +WpG\Et+ 8 K̞GTR/=]BѥXwB\W~ ďgiGpm3=viشD:2UM&NKG*##F\ RmYȠna?Ubn2.M1zF{=9_sH+> `2)a -̝ tt(~st˥ɬ+e2 m$Tfޤ͔/g鲆r|gwvǢ/Xo81u3MK"ֆ6v~ص|`${5qr\me1ȵR֜NaA )rpYur Ӏ9 cƌjgK3gsLal'0/x6̐d츯 gV}q`VhWg8y?k~tbxG?gV54!Mp˜qL;< NUQ&m*r-`~Xlh N~B׭K{, 3/1$gNbOцRΒdzYsSb;a@J;z&Kn ODPotpQZ (臨쏁2Bc~]F%[y6}zm>b.G] [٣mfK4}'2/{C,~E6b?r+T@]3& ׭cB)_XGi.?]zyY'T'9ra"EpDvx)V cV O*&,8jt}@ )6Rd;X0ZfT*9].;d K Fٰ WWyWJjx{VMVMY.3/4Y\-xT̝kgh2#uR)'83~l[ϽʥĀ=]bdI A]Qڄ)u5n))hr~Bi7YVwbzWB8a^RmuSwծAWji>W#7'Fn6X]QQjGOԗrZzqHj@\i;G5tF "*J.7a3-rJzOi<7iviuayq3 $n!,b.J(@uCDRꞮ,3.MÐev/z})tߓCxIMmLNOc x`lrxmB2*w7.{b||e4y%/I Z*cq2l(`b>ڨ91<)c/}A۾DZ6P=+{ mGn=֮jv?h#)On03?Tڗ܉R/ѻ mTK**+r`Ugkco֛ I%q砟BㆣT ?GU5(4hsdC 9eB_KՄR%jIEQ%*E1kzz)49P5nV?F_3Ghg=u.;Y`cgW N4F_Hz\\CRdF| 14pn%Υ2xsPŕTjPZUQ)jUITЪ2AJEnv qJI66\='Q%W!A__ 54*<8K-k'TeqI^ |f90( %"=;;D[o0;8X5,qȋHǀ0nN>^E5k'6;-_-h{O+ڊr1Eq!t'AYoc -V6%q|۫\r,lTL<cOh|W)C)Y4kjqv92uGEhLFej^Gn(S)RE=fm9{^JKR^Թedn6ئ@+w64eW镨n2"uuP>K=$:KToo sΜvB֎EXpqrZG~Mx-{)OJY@(&*QP[V**Q+rUgoCo֋ I%qy|}ks12bM:0xGsɕ\!xF~i8x9G|,\Pzŕb5j(jԊ$X JmgS;#޳lra 3_ۿ|°6nX~ ;o9Xc|Q~yKS|'roQLͫ3o &D\%jԍ :TVfFu2&JmL^g$'u:CM ~;D5%5D̝>-pNTyTJԨ?}(WT D5:VCN#fY-<''u`T0GǼXD`n"RUwPw 7e1{IIO,D jT#D_JxMN,qT[qt_f|#ZrZ"|qijQr6=諡)\Xw>_NbW k8cĴWcvէV&x6x䙯"fkE U_3V]/#|5)m+mcyĕ}lOl q}a=Şu`M##W–4Rw)0i3xf$5. i# ov٧=bzm[2nCXP "Z4~5i][s*y.V+Bݨ8)sN'qK[_#g/`W_ t #6+,@2L%O8DΖmd4˜g|5dUITq[yj yʱ<,_M3 Nn0ɬ0lTc|K*M#BuJzpQ&&dv_-8"KgL(+`jh$8aLӮ+8Lvμ_^% f7MUh/8a4`V#oFզUT4aɾt(8O=A?(8aS x)<{9pYCsa\s2 GH''8aǠ;m P 2mPFp(72K tPkfsfcJm0I^ۣXh6=Gw&5R69g&?ojUoۊ%h୚<"us~\+PG Rp˜>pzgȨfVW&ͮN؄+{vŚNmN N8'TAŕԩjU3LFBVz;jR׫5m$z9e[#"h}s#r0 eW91kj-rTg9%Z$șY"G ~{؁ٵ5v7slNaCsxo(+v'5C} hw|[ cZrޯKyϴN` YՌ~ir 29&oҶsgv26Gh2瘂ƀ 1юӒ1M]O, Kp){݂sg v^#xh܄`1hВZ")-Zʝt\=#ZZd G9`oKTFL 7O6 +WQɄ[Ą @^HX-mK~ ݴl67:i #V=>~ UG L8M3rn^6.wi3te:<yJ'ݠC&@2%;m>ce8rqtynP`g0|T.\e[tgJv@_عl_'t=tz׻`xYt#ffiᣚ9eˎrryOkN$=.\ ZaحӞ`A{ O~3~XpE*\ 6F$_oێEG. rp/#aKΜV:{Pכ |/{x}5 oP/}x ?c/6x+T7߭[zq5H [[EYzjQGsrM8ٗWz;ꄁ嘊l]er% L|gmۨ B%&WGr)c&:[Al#;cE*W)35Γe̮0?O:|5mYC: puý]پ b:^g\om$C?Y+xFoy)0sRF3R+"9x1|L3'\Gpf̃ NA| x閖Wb%A_ M/NAG ctU͎%Ejv8|58Sj/RUWX Ub NŒٓgdq3'iƭS6#([MyՓa˺jtf U7Ff-#xIDzc@W۲KI-xVnI=#ic3=2 0= NL;|]9f>8I֒8kWIV~ %*C^[L['i Pw2+ej-C9aU_jȺFm]@co֛& Y s'*Kd[т6!.ݧ j]P`{nvd,mmv1Gbi벀dWKըQ7?ndFèQUyfO(466؝UT[k NBӣu8(8aL*tRu)cKE[Mۆ1[2,'5Q\MeDSXÂVTU PIf|KxY*=5vT=Qat& =CVz8\YZ]!A'L|?/'i 6fxcyv2%mM8{IVmGO\UF݋j4Z*4K݋z5AUENV 7ôLeu֯֯:nb;o{۷wl}= },dVv{RWn:ֳ, Mz;!B2,WIBPS|ߞhhMK]U oQyJp92zJHjTIvc:$yP>?6:7+B>vxhH*#M3p 4dn Cg/g|Uw!*@!9:L_6wo={fjwE햩*]197+k3ϬTl{ ~  7)g}ԽVWN<4|(O ~ə߇;,fFn\ѫWW)*-\;<WI9sɦ1/zD "_\Kꨡ>0S*[aW~TSxt՟꜒_9X+MYi iR%+eI mezSbGnJ*e-cjJ苒`.V/Q jaC:O&՛l ~/-ƏjWjl|Tӥw,NGTkT!<Xe=Յ>[/O H\, s9eYHYxEXx1vGU\O+#2R_$"vNnmon^8 >66E#Lc<.Aӻ44.87ʞ8GfXZæ'_|%] E$_Pu2ǟ6L kii$IOo$+\uvv wui-b無7f8(Nܼ^4 IGޤhS-#|_:NjJKDSzhψJ"K(Hr.'O?5 bn$< tjeK&#c|)Ky}5}6modIǀr]D^wWH9|{OZ~~= (vԆΥc1#n̩gg^. YŻ%V=7dLp#o'wNo]'LoK'{E{C_3r eEoh?< U3̂ = O2#F٣NL7yW5'8"~y1pFr +=Ysi%* )Oh^gol]VT} ݱ-~؛ S~YLtN NB"m0_ބU -iԕw 5,~tMFҤopE kzA{RC; ^5㗟Ap4 !8a3zQpB.\MDײu L lmqRU{_n%8a_ ު5a[1!8bhEldu*b r[GgS^* yk'p୛Re͂6_]3'T cYBc1hEZw{'T{i8,z[m c:ln`Uomye1<7o(UT27/sG;N b@:Fv Iݫyfʶiynf/^]S>)"W$1s98ͬ&z}\oizųc1X{<%3\]uV8mW;OYoybZmlӓc6w x s ` c]ewwƤQpxwp5e]ׄn;KWwåGfgkJ>Eէ~>!7\J+8a;^J P>k25v,+PU_j TFmjco֛5Y ֠sݹN^K6VmJm)ˋĒ7ĈƓ}[Yѓ[CS ӨP1Dm;W0+Y,)1aaǴ+ԤWlaXGP*܁V5W+kqk/Uszϔzs7Nl_ʾ N Sw ...:\f^h-kfaf5XFo8Ezȹyۡ"uEm.8"6tK5#xT-eY cZvcuw:V.UFm&s==@+prk=1:t]7Gr_/[ϡWY[Yf˾eϡO݄ Jm+r9`:Ԭ&3:3󠪶Cۥ= 'ѻmd$}_c59Xv:6?Wz-O[VLo?K8HÑL;??QpӟCy{nd#mۂ_ _ :Ŋ?NIG~IcRK|2Fvr^>3xٽ:['תLiy!+sv&~`*5ՉGW~*Wwh] fH3$dņdLS S٩1 F$Pmj{ԜqJQM6Є=>ÛDp_'m~YVzf]t LnzvĴu뢮%4(Lԯ%MOѢrzc]]ɏcݱV_^&-ϤU*^#a/n`/^ $n:b;lԥۦ5ni: ߥ6yv`[;HnQ*V[]] d9>7V%:E*]~9ӱO} %ȯ]:r;}&1t\rsZU÷`kE5JAIS0G۟X0] ƈ^)zڦJh ¡bY bmyzAy/*j3hz+ NM#efQFKQ&Py2K sTk֗:{^Jd6-n D+ ބAK &l1oYcԎS%gx_+e9l7?NB͜Wߑ{Sml 6kŹ՚8؈KsM<'K?fw Nl[go,xVjECd[go0_0|]^XY+23~6c-.hb=={*8\JA*7)ᢍJ.5j(MԨ5Rh$D_Jh• " ~ ĥp[DHŶh /hڅdlm(8'?IFq%!SuCQC9>eH"j*jTh٢f#o{ Jm89gۯ-GljT_-;uiv-~ kQ6K Ϧ+vћxEW}oV7{iKc ZR|Ӏ_HlЬ_KFq5_UW(lA I%qȳ?z7zDqf.L![~ar]? Ֆ?^ jIjì/z7x"mȖ’9F2/⊩FKͼKi$}8vv8lyT> ޡ$j#Zf\j/Q{JqM?o_ol=yZӧ%)({Ñr(vz2w{yF-_t$:X/?g^By Vծs7%KQ3~H1Ct 'ez+W*Qq \.u&TV|MxEq̋kndՃ/YeN)gӲj%o8rήIey:AK&~:Y.#0Kr;{kW&p3zoM3x!w+!Cy'DR tuc+6Gh]~I&vc38gI᳀-s]PHVgSneo8R"֮I$z^;aSp?],xTKh}^|$`I|.jtٵ]!Jc6URņcNjͱɚJ1؍M/&̙nlRw}@#˪َ:&U'yJ.g^,ŧߍMR7ucK%Fs ʹB/}ć3dX||cݰͤ۔{JmOCW)SnqPn#/R^:Dm\%=ӊE^P]՞Bl/VJV,rV*ĥ $Ebwuė+ܢW\-Mz^Q8~Jj I=ıJfq*Y93VI. }U*ѳ)*pLE]UIb$p{U.~KH%4H`u/>Jzc$>@c[_TX%i Lqu8VI0ݱJıJqX%)<eΌUjcJlZV Gv5:9SU'pdO? %U}$fIn`u/>JıJ9<2 􊳐%dx,d,I[z*w1Kejԭ@NYlyRumܲNiKS,Ͳ`dR)So*[KqM2~IBQ/I|%bˢii<Ԓz*$ΙKR,`G˜$u>R/ٔeo8RƢ֮I$y{Zv8=-O? %U}$ys_%I=K m[wt(:~IS$q&_5Lw6q_93~I /k3㗤G=U+yÑuvM*Nd :\2YςwIUɽY۹-X݋On6qo`s/Ok֔i[sb-D|Zv&=+ ɎfwCFԨ[> ȃ4\ɨ3lI类JoY3YTj Z[zR\Y q;wD$wWL50]~vkE/?QM{~Jj I=!Nf')|e qjCJlJg7)Qk$:c؝1 ;Θ>{ Ҽ/X݋Ol'Pt(:IS$q&q5Lw6q_93I /k3CG=U+yÑuvM*Nd :\2YςwIUɽY۹-X݋_ߒ'Il'qMc 9 2j~'XYq}ms E/R>$}_2zTF ܡܬySʑulG="դVW]ɂ, MV,52VRyqq)YCCIK/Ywu<ĿQ)Yul=U+yÑuvM*Nd :\2YςwIUɽY۹-X݋O@DȁR=f+ÜY/%Ŋg1,6oNXƍg;}OHY N*l?-a?@lFp˜Jն{y]eڕQ,e6 Ya8ϪoSRX@ҽ5jzv9F,EL 絒iQ`Z.zaysR}0lhniz*8ay ܳbQ[G4=ct%JIYۥ2+ۅiyTYw]f="5ϓX&F|dIX/57]"U<DEYbj"LSVbJdVR )cI?̚'8%mP]cA6Ñ1ǁ_J: W㇘XdTVfY?Q:V?m1V訢ˋ&/kZUL_m@˶U֧cOYJUx=Z¢V6n'3W N` VThdg\5mZ Q~C48hg #®UT dcGa;x{,繋 SM_'RE/\iz/`yt$gj<㗏vw'_I1^6XlKe)Wޭ[zqe:,ҳ E=c=F/p\* P|T `ETDŽ GZRJbmXɬčg瓸vYgŶQ6YB}󬕧 2qcd{+1%ӒgSvI}BJ_\A\a([6E?ߙTz7/> hl?Xأ]]2&iF߭Fxa1H:ym 5J4jL>-{VXLj-gtɘ ̔gZLSې@@3' NNwΩ52HdSgX-eÕPm5pl`Ƚb{!7 NZgf?EqՈ92.cˁÂ*2RδX!娍j?.<$8aL۝U,!]n;%{YtaoK"|ͮ3Wpd- Nt"Mx]gS RWQ\Mt׭DAQ}xڰ+hኧmqC+#ezF'$h{*yjNYv$2J޾'MʣCvnQAtruV!уI6C]kjڼM=9gŢ!غTpBE~w0mEW S`W N3vFh V*7W NЁ0Nh;a QviSHTHx,\/ZmFv۫BcV =H TJ/Q|T%( SA ?'<}?'< ضY[m[pۖ5/@Z S%v!V tL hMzȍ-壎q65 KN~^qen1)d0kuis&˞i=MU-R`X,*дn o ơQToy uHAwPm@(ίX u7n:4/5dZ̺qoֻl'Y sxEv U(9Ap&ն)P3';'5,2ŕT5j G +Lh5*4l7뽄6sʷ=-̪.9܂Y9<#K9<#uZ”wpO9;+Eƴ2P֣̌}S64148PCo`5#c!;f莹~ "*eC%Kԕ>RDi%_blHx: XWR &p]fkmZ6=o3kb-ZCeJvZAp61ٳ+ ~Wl>)?-{š6Ø_ Marf}=]yۭ 9F K;t$࿌moٕ[ſn1t+Y'?c? fIs?:_{ J_'X%J4֥TZ;YWb])J]ے$n'zMQMqAsvYn!8as-g'L~Np˜/ϴ81] 6XV-T+:U(QKvE&=_ ̮<+7HYJ񳫀 UpS^Ǟ:[#8aS` + >< cZAA,lK?bV9|'lj|~ uRiztk=I cZj|'lz_PW Jӣ[_0UWKȍ'o;?XuPkpR}ёؚ0nn!6Z]wŢM]JS'pt\c/PɗU.4t? 0n7$L)'TdFǨ_fRV6:'i6*6wo'Td#p .W(dRXIb N^1N-8G56k##Iإ URsL.m҆{F `L=Q1" Q]3SH00aqX N':[=]3CݺU=ߏUwMSu= &JmI.`m "c5u%Xo^ x[S9NȔM%nVLp*mwQU[YT1K/-z^.x[ƺtIC!9*TA{5sL&_'8h69fⴔImO 1Z祔qd^Jj5V Ym$ZM"rrٶ,Z.Aar_\;N +jZ][~˿XKRU[pxr,g{C>`"HLjN˖#4fNaekzbԲv^r6T) Vi^gXXH L\ӺRFonJXI '5KܜmW b+Ru)-kttл8v Y.}V&:c 츕o(MhY`jۚ-ܣ^~@qrz1[[~O-8g[^KI51xW ;Nи?绵$H=xA]L4Tfu[ Yx;m6HXVfNa^|d sQG#Ff4x jpu' lYcf<|Y`m6W44#ݓgQn, t dl,;r dw?@zh9_L@~7L& [*eߞ+ L Ni~mF4ͼNI9FN=+YUBC u TۯpcgN_j~q đRaD^Aq*Zm ;޶Tv\3˥ַf|uJ׳3%8{^+Ja p?"8a*ZR?N1̧_0 | ESrSŢ#B8_~]܌O0x='L3 #zjݢ  ]葚|Mk|ٯ[dѷQ6:c֥ ڨcOg֣uX wgZ VppFw$k)|Od Q$wRFps`GCKlVm%UH|sg:޵"VO,z2lKLNnFmѩM(޶,L7;34lf|T69 R5 gES|J`5jj4 [+4t5t߬wX!(qIߦe+U=AmMs]"1pvDk|_#DELnZxDRQݾYo&8Z'uhAEKOkhǓ#l8,8숕#>GdW+x<)3TTUH$EF.߬':MTo⤧ =̦6V<$x*u͊}Q\MTF`KƕJ4 /ՙexcoֻ I&fqRGѦsr ulR|a.+'a!(&l*Q#0d J 2ՙd3^e|R j㸭NmD5a4+Kgy0d _RJQ+9bYyl ֟:7`ɴJn1h {'笒$FO'͆>;'lBO +O_9K{*W($Q#hNخF]="z)=F"{f-ZLYА3c 18a nӡkVǧ=2JԨ#5KɲRQTZ:LE:}^Lp$O4T{=;K_eV{=._+ B_ /jZˮzY h_v) o~EpB!w. Fܯj"5Fܓ;:TVfF^NxQ@yiҋbR,SIPSʞ%;F~Wר5DU̝vr_ le] N8+*2z Q2X4QT D5:LWCN#fY-8'u`h3؀Un9e뉂J\Nж@5.E \KNjjzTuT=vWC ¤8?ro^AOr& xy V+fpuq'loUX J1uo v%m ?LJV^M~8O4b1+#7o.} p%Զn\ڔXC\I-j\kp`=yď@#9*dXakZRR6iI1OlWI36isEvw&c xyMȋpM6m"q;WG޴)u7;Fe<âz&|as(n475ņCΖ.9kҡ: \\۽6Iro[}i0]7kOMj.dh)c;<]iiu&6uWp%c^)!.y,Й䭢hTQM&y$X#ʇ۠+ ga!6}ͣA]4= xEwb#Q|4`=pܾLv|dUk03XR7&c@\ly1BPYHjtd c+ȆY+K, FiGjWp׃^Z(s۽Q[p /IO$S2GTFeͼG.V_jȥZL7{pzo۩?B#uBiRUy &ϠZr!3̖OgeW<1m [n:<z;3>O5ɣN}>P1 a)d]XK_r٭5D΄ .9BьşQ\IjFxڕjt )4LXN`jƩ"GXzyzՃZY(YL=#~ǧwdWJO+SnC:ʌNJ8ӹ||/"GoSyfT|ZH^ E/VM*O?)Ӌq#'G6)4wQZ4*܄;\as0._V7olkNh++\a96WY[5T2l:?ưe X/&ck%RdASޭm+ާyA%~W*s=|5#kU|}yf):l:O"_|9uV\qR+~-o%c/ = ?]*ȶMR g?K"M/B#eXW߁I=Pf9K7JR8a&M P*)ٴ;϶^86]=$],!/UYQWUJ۳JGOOI%eF \A 0~0r+3g lJA[sOpBes\NzI%Gڌ/il+'T^iKl['L&Up¦䯀oPYVq.)< |IX N"s2'H~HpBuK.H=&a~RpˆV9[[O a9L{2e{R~WvdC O%NJj|y MTs0_ɿb4KܼiY2/]镂uJA#Ey<-5,qM_(8aDn 1[k͂ny_.?zx,*4Az~IN'hҮ ?*8dE.OIoc3 NVVK0 < v;3W_PY!ޤ?0 ?C b,8a/0 7MM2 OHš&<[t]}=A-sH N1莤@Fq~EӧLs@=㆞ѧLRf5K\Y|x6ϧI'|+WuY]+Kz[/UjgЕ`[˫FNɍI+oV*}ek+'5ٍ>oQ\MMDKUaJT ]tUX7]IRo384)U_:N h}J[\Wq/JV9^ꔀnm=m,I8AP@뫁?PuZ 4[W[7O 5 LRP8Rn smRn[ Hp۵xUj{Ra=pmr 5+c瘀Uw 1U:ĉ v]sLpvNMbԇ-:]2 |mr(m^?@mo>%x[ݼlO(F}CVF@Ff1JmToO-ǽ *KPKO5l%3sfӼ7őbgM!eWpjl&9 hN+pI;WplBsFT,AgR,uY6wԢ9 NdsZ.s6 >GڈsNш=dCV (Ң( #y%JG=AVf;TesF N #0^>_!TuKBzIը6'Uh/'Mx(4Uk,1Jm++*;o&Uxz<|Rt_.[pYݟj5G]j:<\*U4Y I&);o墻{{WL+{>G͑ Gg}z?+D}dtWZ.3j5Mlł{|Rjʎ[9fGr~y? N8+O}zTFo5]r]j:<ܽ_&U4Y I&);o墻ϠJsI}tt9ς$Qc].Q-ltWh盻Dwj@6b=FV*{zM N|Rt_.禁N8+>O[MtW4}\tWZ.7/j5Mlł{|Rjʎ[QENHQTE\8EB*x'"<\];zPF8;Y \L#q;;"Kje Rf)cU૒I7p569C5^J5̵>7*֔k4`*X:[Y+ 6wjَ8.`Z7(25B;Zpr5򚞵F>1 .UTSᷲ>"wC8a+x2WZ0TҲ:bV6C\Iq^M{!ި>ѰweŒ8>qiNulݵlGB%NNQHjd|+iwP;m ZUd*8&*|SbՀZb. oXl 9yӡ:_ɹ, w, 2g]9dڎNڽi Mد`q.[6,ݙ5_W7;&k{٭/0%5G jў9jz~mˮy3W-e$|t5u%KȂj'd]7l C|Pp¸Sw/F,i#AR<%J<^u ^|: #w N6'w֚fѝ&SJeq`1k<\ Id!i5{#G79C> o =,ݑ&ţ(Sn__jZjo{)FzڠK_/ OtJ|%VTq9-8ᬈs|#Fqt-6+4t18|h 1Jmo9j- fq?'N<>~ÖM-XI>sϑjjCRÇv`5ոҥbұnչM>:f%F$g> \LC L  "UBY 'q;Wx>[ s9zqѩ˶Ufv¸֑gCC/(%C&wka`M-x$ie>ݛ/R% ysMү:]p~UwYce$n{'T`X$` u `NmRzŵE^ssS܈n3{ƼwQO+~94jخ,&wg?$8aU+WiCNxJx71C%s|ؤ a~@#Q}az:-sF4doж|L >3MQmIjW.(硚q"S0!Rp3wQ3O]:[A' :MJ|ck%VS0)8橫O u8!V\wvk5571 /R|zȁҰYc§8#8ak+8aQ̐1ȍW;%a=snWA_zoP#ͫ9UPi~;eBTOw$=~A ܧe>~Ly5̮G0)U_jZL;&Za+:o` PW׺[[GVSh1mO'}j5ԍ+S)tUgqHi"2UTŬH #FާeW#:#UT("1eq8in2OB ^ E'3}OeW:ը^ jT 8c2ٛRfRMEnvɈߔD|7iwhi\zZ}A<`s"lY6^pvDa2JRBGXu69{^JpO4V[n`7}Sxۃmá C]ՙ7xħ(cIpBE&o4V4+F4qd+V&ꡏ @@iD2տSp$L  NTmH濁+8aazwdW(b Y'`#k.0 ##x ~w lMS{Ouaۖ]˒S6.[ NBO0zp*VhgXy+JN/*VI,z=;Q:07d6M!UxJxAY]r2lЁr#qE_ I, &+B9ޖ,Z.ǎ#6KC^ m(ۦs} |/K+OQև !0ug!w #=.Z 2F+g3VK#Y1GO$c뀦)3ͮ2֬LTTwZYY`Om6z&''lBSkvM7}"?3~Χs2G}RF(k'eJRkiFY~TR@sMdx7XrjCeǵ܈;@؈X09q|O4[}YFq5qTAqdUT8"`ok I&qM= b )kAMXOK-s>*zdHD(_Jb*Q(x%໥I ڛC\IaaոݷD(bf%::Fs+4l!g&LK+, DF5DFv9浪Ceei*W|~ \nچk\ R 7@nZ^g߁NI~?1}'?E.۫Gtk'L ZJS['Ts5W/$4OI5J_ApB5 8$8a0b'ٲVEt.θ6Lō?tfiiV.Xnu<QAkWNu'4:dʢ\IOKŠt-~ c N@N?|Jpˆت elRo[=lO'֜I5ſ,xAZv; e*՗0;H=]vz)+ un6|^[$]^h!@[,ӳi^dR_C̋rVYt{^c|JqLQ=Ri;1SaQ$ V-tCTR٩&T9\b N2T8a\|?>ɮ@BOUkZ[Ҭj)`ꫢɛ+TUq/Tp&T8org'UNǧxJ5jMIevt(Qhi;|^K`Վ"}tU^{bbsBqC?Zs9RGdB;Nob%X뵂P6t(v6Nx AxH6x6''Dî ֨Sl򅑷s9Jϴ|tͩE5qq%ru=Tr~m%1K{;b?"Lic!&vՂSNjލAcMiwd~CL%o R>!xƇ256>LP-f27o+A3DMޯ;׭Gs]"1~ó%b~ħGdW1Q7bM+/:^3t7GN-8[hQ6%Z #l[g?;[b3>şQ\MTFXdJ )ՙdH^d|Rj\x٦z1JKso{jb5[0TTYx,ӷ~Mp̌O41Snr)/%x /SW2J-abBJu&> vf8i{!vR"W7|2Ĥ4 2Il{~JZTR{Tnt47oASpw!}+'TdEj$npMzaٚqsd5JnO~2Vj5pkn,{ꂧd v0+8aD]ى4曥H]ݻh8^&1#?8{;1[镵L9GOIxex `e|7w=*g_PN)q7'L? :gȶ-R^v:7Q_&a_[pˆfVs~:T\>ФȬ1!D9.Ĝ h;6m0#_Y=.M=ͷ#StKLQb(fAw% 8"/[ Xz.0'L_~_p¨@L{C#)0eTV)UVuG MF_FSEJB3֦ XA[oא临nusz_O/bA #г VŦM`}&> R ›8a&5Ci+u`puԑ)/ħ}K2~_U[!oxZ_ҬMڃE\AwB-kXxUu:턖f, HӀ]]Ww$`7xwd] `2ڟ7~kY5&*:i fT WƷ-˂f e4ٵi-rp=Jm+$~q%0VN{j._ΡY<2wuht/~ ?y&}f ~ NTvhT;ܘ0-c'sJ\)TK1)1ac4_æ?KûťOM%gzpRC\e˒bC\{s&V/3 Y ځ)skQ9`!Npo#9;̇w?W:+rba8u?\g0æ9Gӣa=#nBmȵo:P$p #lK/IIVJ? h^>XЭ|Mҩ]z X)Hi`3Aw$=)%x/-sɕ| e՗0\Y#wSNyR)WoŜ3lg}\ :jį!E"+a+}ҨM]$RGƅ?۬U>)SSFU25oLPZijKo~uս:ս_~{\}6tuOWWߡ\Wݷ6=b=x"M!"O~lIs}+x^J!RU^I؆(RWjz^s_ϓ6`/xonKGU{R\Mj+SCNpʴ U׫5I;^JmPϫsN_Ě$ ޛ|=O|شPS$j!R5l}<t^ zv*=Bn;{$$~q%<^/KCa'KphtoG!gСnû /4yO';|+yOzzQBv >1[Œ8pvvsݰ x8.]{'ᄗ_}+yo$4X}8{^@~Vڋ_w? &佛_C\{џջ[w,K(t[ L0B~KMa"gෟՇ%*%k~2GTiqW9wcaKh+REn?zW_Nx5ɻ=Ƈw?ۏʌvv@no󝵍k^qt~gjgWc98z\[ŞSwϢ` ~w(ߓ|!!Wgb-$3(Tn%E6K(L;._ $_ HC\gZ 2nj3:?V]-LwDb wUhyc~ƌCuWNۛp~,|Ih'W~9bќb91}>{؈Ｂ'[ \uv*A":0 UX'qse`)ChCl ڲ~gRBe8x2 xPdۤC< -AڀG$_K[}+Z©9%[^4Evyj5=7)VQ04G.!-ßGڇI|q)z&un  wq)ί4+UE/v肨!qE4p*-%ƛlgԲ)5B>˗r[DJ(}WSB,p|Haェe&uMF,3ukW|;^641D.6+%Cd-#W0m}\81YaJrGPqاmeӊ1Х,0]Pq+4[eWND[4 4nIPMKW N@K['XҡS'0N焋WQMOi̹FKPIQ24%Uߢ*GPRnp]DKKRW>^njN^ .7ݰa$ n6p |,w]0 4Vh[ʼu? d8xdoͰ^5y>PA _刡HCM}#KƐj~3\E~1)'l2^v34!"?䳭^E5< ۄT柠;z!8l7u\vDԺx5i r< SϮ^~M2><ѹtx#v>sJ=MZdvɀKOy{֜ZxTo[0SH1^0Ao/~óY*TYBsUiyG"{S\z42+_EvWtD17%: )iO"kk0kxdNh7wDem{Lu;S1}Hj7@>|/-q aդЫ024+C'TSt!'LC NxF5"<| EC5ᡃl<[ŞywěCChkZCf!lMJmSCeBNnߨ/wKJ b|}aĝ !zN$7wќ6g#'妤^~27x#ɸf7M ϱ$v;qBcIW-KZQo ~g2~W\n=R]a{m${ 'qօΒqǕw+wnw7]=ݵu}Y&NOR>|\jex'}/Yg䤟~tnvRA 9? d INs/42b!UxR'LU*-OнMpBE>o%&᳿c'rIc'NoHMHu&ᵋϦ Ngih&|p@p¨q6t_4ɿxc:([@5ϡ{I|ڇ$ |E,Wķri &; R֍d+JNƤ |(Y[K?.aRbC,=G(/ >giSoOxm7TPRL}_:+wY MEI+>M I##hic}@s 㙩jhEڵ"kx>7l;(:^(0Ep¤wQr+8X`9k7wV>quXrx`oH-sTꤧra9&xk\ڂsTC[瘀O<"8h>}c}W'DA`cY҆m=Ojy#G fDl}9*.6H&m( $稦9&P~9F+Q^(~']4k6dqsr/^9 $SY+'Ts6Lɜ Âω_r?%^|Fd'igEj݅jK{U zIl]i'Hvmq˒Cfca"Ι$q4o]zKHnwkri2C_H: Ve6ꜰd]fhsn}gt锱⻀_J2V+WيpfwWrs3H#Is*ŬaSlMɽtM~-ׂꚸ7&X]a_IV`뙂& إFJTG,y* >vs77vȘx EF4%u#wkʬ>f7,ژlۀ NaBwPItzhF[Qu%*1mǛUf5[l\ö,mW0h1}7rV:Qp^o`FkbBAÆK;3.m[k4bm30p^Kwýlj E 1f؇WٵL+;al8;N)]8pQ6K+c-8aSNdӅ_O]`ET~Wr .SRc}2 [p¦གG,i<|% r6*ZT~֋Q''L0KԉA_ˊx7*5S8 I)'hhVH0afTAhڰwtmA6Nkӆоe''즢~&&ۆN1.hq3S$lOiOm6t ˪fjլQĖ".0k28f+{<4!'x"«VVf͚,k; s%T <I5wEǬ2W>FW2ڤnmIޞ,NKbU!Wv{E bo,%U̟vCfp̛jVm=d5B% $.g6"OR{N}E 0-!oÆz+:MmYņ~# 0 #<%uװT7B>E˦jĸW)4ļsE2k-\scJ@XOgPyʳL7^^XtMѤ.|܃'!&EN :^kԧC= EC'W0t[4X̒S2s|I?3VT A3EU'{tFta*N'i3unmjX45,=jzs\bDGMG,6J*yngieq'et5jS $mը;wټsǔ 5؛Ln?YPu(Yv #1-ɒO85]V1s<9Um\ot7L:ѫ4_QSЙ*ӕ%C&5a95_l|Pg'WQ2BƋ"FJr= 4+,9 / Hr$~FpB9ͧ_,8au.{7'XuJɐwjYbX~<' Nte3.U[L^e(V8Y~f85QYmAım_ʉWDbXO(1i7h[YkR׫FY2hUÃg vo.>ߵY˒mݎb=;osYJu7 2q;71}~"✲D>=R|zoћ_Qz8Y&N57;j j ]yφ8u/4vx[:uIo^ cbR!Zr~N(Zotjqv =OA5 %*q4akl\G2đU5ԌuKG9 kyOL-xZ~4̈́)%[PA=4CNQ'("RF"ԨQh_A] tf(Q^[-yC͛<9W#^_"#$&S6V3|Y" RH<:w7Ft5|s3cMwZgoM8sIW<-0qݲs~OOKvWٶHn;I(8ĥFgxXw[ AA퓊dO>|KY3I#dKKSC/O0ZίٵЇ"лmc;p,eM죌6XOا;-5/maĕWjj1Z2ڥ"!n;U_-(PM*'Tΐݼ\mn[E^F* n%oN{-~&SV^od/%>VU&xԭĕ&ϪKnꢱ#=z%oU4{]Ԧ\/Ľ&L<;,XB N:'t!=0WVH^x3 0`v C 7!/~&lCxq]Ð;/idk,XN*;/\tu1Yӻk횵Wwu/fʇaHǁπ? C^|C;q%ū)Q cW/V٪,W*}G y_9u+[ηHYöat "5$,x{rW>.ս!qAp!U8ڇpH׀&5v gU_WURkМov Yː~\C {w I|+i5SعjjC١dTJQKF:22+LMU#=bbn }mR,8g&<.[ݽQ6i3.ԋK'z!qׄRpLڰ a_Hˀ?vQ߻bmWWQߦ>\m/5lXf3MIIY/F^X_i2"6q-5wDk^PVJĕOXj*V\nF y}+h3/4$Pg.CƳn/v]㊽ q{#x̽efڡbN&Ͽy^0i3s|r >qi":=(jTп] ]B'!re%#*% ҽpeh7^lB2ERZdjM59k1p Q)2 XXI+r8^pu4ۻ|yW޵kVww3CR$KG#!0y(F nҪό6K^.g M|(kSK%3oVM^Z).^2\g)u)ՠ!:] [zy?VVzUg&TK Sp˜k#.&]q[p%JVr=>-R'݅'O N63bVZ6|C͹]Mo?͹]"̚ky0溈4&\ p񿫡w%ꞔRPѢ}y@/%8MB8b9aS([6tk[ЦZ2Y{5gP/PhR/Zp1w5+!NpBE|R-5z[쾝WyU_/* 3W毀0Ǜǚ@քzHۏ$~ A'L:лVUCEU^V6-V)_m|brOTL:UnU.+-֐;!W,s%\{%\B'Lj!WM/9bxriHKpˆ87kV*Dw_!8"ÜSwF̪{nr嫺ް RU0Z={ $j]I1GXCEm'afkx3fR/˩ SqYꢩZmocƄe?{.YDp}bn̔xwN_ E (8a~ N_foF4K1IǤxG:ar s{Wdcz֚t #梧>_uNI-`l<묳^UhV5+wuSim<ыesI 7%ݕ].pq:Tlc`e{ie2R23ZOOxln3C-CCPmLЪ,*!z,VZcY|p<2͸:vAgrbW#Schf+w #<I"XqRfavE1I*Y_k9\oޘ֌P, 3W-CUmcԴ*93g"܉gz=wũ)ڭZv+ʼn_ {uOCEN|&OGҰ;jTz= τgF3KWUi:3Ï`,߱wsxjxqx8 z1rj|3,>EPlOl:KYAc`&- =z.ghcuҜUU)YxR4IOy9;r3I+| &< 9z>v;Q^ZӠiJcʉ%Wp3>+`3Jm}A@+G pA |e4ۗъ* N'樮xPh}B£QMpҳYJtg<φ򄫠2CtH˨("T-x',b~{p(u[" U#{ԠqVQfuE)={$>]È={SF !uځ'Td1ˮ7uKp\,I($z rWzO5_"t"=-NJϖ>3#9kpӬq=?cWVB~u}Ck+{0AyENV[j1`7`o"E5y/[ 7gJXbߖ.IJ7 m.,jr>iƟ62ay_w9OC퓅-^O-/|ˋBmLŷ̟;UҋE{ހ~Lb[qIҧ\ .rJ;Lޤ4DnO($Nr_ޛ%ix_C\ʋ4MۂsꅡqsE/L+}Rao:?_$p+4>X8r?|dv7y>t#?rޯ *dG'2+n޳s=WQ[&AK(oVfz\EW HVFvk¤@~c )Wς6 XR}m8 2Ӷ ;ۺ}{$a]w6\4ڱtK;iՏݎ{!ҡ܈nw3K5I|&Ms.nO\)M8ؕ 8kUܱ4o? Ì~`)n=K\mNs)!^ {eY)E> WdG,=㋒A l.U_[i=$2%:A,nRUz8"~վZ!|}eJLx1^Ǖ$ |qEMUݤy`4feR̄9zgE4)YJ1:/YUu k) ,J^bro=WlX0zǒyU+3C#g6]'pZ Xg*Wؠ[nxO==W:@/OY;Xq)9cqħ}-EUg!TWķ~ŷOYiݔЫ|^\Y2.8a&wVCI͜uzӁ+W(i۽NRFԈ{]nZOj _z=wItmJmн݉!۸brtkG\6lgZ(:\6#Gz1#ńh >2;?Pl\\TOg0+bF1@7:Ԝυ1\86&}0Ow‹a:¿\tlʅIߕ> +S#\Xnra/V.\8nsυ VWr ΅msx$dLw1CaA*ҀdĽTV.&qw_ ʙ b5TV.&qmGBC'$>ĕ|2,c2 = =I0x:p6%tJMJC2LPɰZė D2'Jm +<}0y?L{&1L7Lcn8#;WߒX0lb0J>>E俄10y0i M0ҧwraejĐ +-T.0% mpRJۺ"NcLw̬aA`$%;Iܝ1L `0k~p|y%6pϴN=Dtbd\ 9n\e $nxT 9I\x'3)rbw.EN|/ߏߝ=>ĕ>x֮Khm4:iI R,_/6n&(7:z{p| tǔцyśH }_(xej v=ʠLRF×@goKߗ}QL %ĵ/$o!+Qj$tk.nrrDT@(X&k:S@5m3,uFn=Tw5gĪZ*ˉAa=[ol@xHeC\ɗ O13=P,uW2u5@d)@/ZK2 mml(U+7(+bq3n[Q3_aEЫMzIcP^i,dHm'#!?ԨRNIƟKgqziUqx"Ô)xʌJ8$F'T:I\x)1<"x*zlTqH |qm 3Hkk]8c7ObiW;0ͅ駍ˢ< 7) XY.^~Fu:8p{;d p+T .E|),{0Lf3);mf4[JZV2ȶJnI(7mp[Q, )KUMo޸3moWfK͡^Y |dbFʜ % RS0KYʐ2oS2fy f7G6˷;'jكhMm!ЇuS%LC+n*Nm᧛кCΈ@zqHA~ ptjr|@T؋uG=|Bp¸[wm. nݑwлoݝ${~D-3I> ;Dyb!١sY.IqY9=m_ ;m޿9HU)ݦHJhH/X,HZ6 E $?r)Y>^[N^̣ݻ hBOoSpFT?.8aܕ?{ {pTا<Tm}S}ʟޕ|(_H$Tk.jc YOOAqсb;fxa_oAR̼Q#Y$fi*QW!Rpi\mu,oYYFF_ X"?ORw@tr]b6#A]w=m_.q3l %]^| k$ ZS)q%HOc|tsPPzA3%.ѰQ2ley8EU+ְm8yLU:ĝ7&WwjC3Bw+%/\Rҡ)eR14\"qmKEW$~J>^*c>9 ځ[LWVHR"7 G$o~㑋v,Ul^N$ 6*Lvd^ R9>!0uqn{Q7MлܧQmn0(dNR5]VHB=7u{wPj"Վ~N{\sw\̇=}`,ud/ĕ+8!."(:gx+鷢 1DD; KE_Wx ܦ}KJǺ8LJ0j|q>zâ _QQ3v",Lx>Ϝ VywHxUwO=2zWKYz&`ų25b`Un,}Vk4Z~Uz`5ns_Օ/VY3x~غʯPd抺*.g 8|g^!'K=Qs R$hEڄ،pT˷a6zLxlKu˨ɟKxqETK kds(RG֎ɎH'$;j#Zύx'>QF ɑt)9ý}FQFֳÝ%8Z{ ӤT[WL^+W*e^*':7ojOl!ّmn6;r>˨P.YϦrJp:V]<%\O.g^4)o] &/wSI^Zu0gx=}"7"oqXs=&Ƕ4mĿf>8I}jo%z6%VC%?jGENcv8I_>{ r/X݋O~𛤞T7-N!.ɗ00u3@}HK-g/6h_w:Ǜae>^'&@ Κpe@ u|jJlZB Nt5:>SPp$ ~K%Ln^|3Hj?P ʇT%YzxaK$/j9.!}r=@HfΚi ඖY3 S{NQgj%o8tήq%y:F'K3]RG|/avv VⓟBR/jQ5 D%\C\RTF}%jɨ/^~Msqq)vʀ8$:`|+℞Lx7E $u1ؖ!/ᬙC EsqH}jԹ8JlJKGk-x=/rK'fSK3]RG|/Ac VⓟCRO6q.B7tH !q&œҔ8_ dsqH|Ƈf.)m5sqH>3u.=P+yáuv+$1:\< _>{ 䵳[\l\ʇT%yzxaKbsqHjE-MC/!}r=sqHfΚ8ඖY3S{Qgj%o8tήq%y:F'K3]RG|/avv VⓟCR/ji\q)J[KR␸ˁ״DSW|JAH>y|- v ·"q3F'Q?Z]c/JfR5IB _2錌=.7h! )r: 3lj@ \k=.m_GINy%cZjGXR^&`|/*Rd p-dl<\M3Q\3 m6n?GT\ׁUz"&Y`<^sdm2 @I&.&ǶNŲ5^, kq6U4y-W0KfN/hm?:ltj/sֈeaƃdyosQטFMx6tN1- =gdUrmSJ]2WsQ0Lww8 tC6Fc%euvtrMaBֶCNw.(A &~,~ | Y3KOimHϹ쮉OT}{M ЍNQ+gᄭBAuȯRصAx[J$~q%Ƌ=lOd <'rõ9N*. .56'H3|+iꂱVy'hLƨJE33fQg 2S(XìVUJy* zbQъ,)Lu`Y]3GVqMϏ%W6C9%SX$٬V?X^0bU Z*ZꟋja?S|l&{4Wj'YjEUOsadz u Kl(sz= ӵ봽c VDCwMORp!e'%-kȰí9:3ȲmdRg芻MpreEjxش QLMq ›Xq9>lR݇a|DÊ{e3Q6贗G'V/9z5*lŻ"I<vp, Q Mj!m9L{RTʼuQ^)F?^JBgp js!Uȳ̹N+G.`J_jҐolOJV|;iҒQ,>"t7y>t#?rޯ t=MW t;̌;X *'i'L8i4T=[&N5-z3!Q[}sH&5MM/Mz;ujPe.^`Wg ӭ]kN CmQ0挲Kuqе!z!3:qVZcׁ1ָ5+ؼ>KxejZ3yۯR*9qt{(|^tS欒/+U)${zCg ԓ/c(+UTxVk #mWJFuֹۤERxL30^Rb4GHD Mx HL$PD XJC:{|)8>ӄb5n Gqؖ|N*xJngV 栙HYsO% ; x%5;TԋOM;ҵdL\.8a&WN$_b- ̀ |94Κ꺗``2Ybԙqδs"%=9Mj9KF_ran ߭45L՚Z)0<-lD.o[^ J.0J'^wT݋Mrk:gÕ,Ll1z:?\qHy+eMz WN'P! N5 f@W*8a'葧ThjeA7KCIWy67[HIX NRǐ 8aSSW_0 {|5 #Cn} uw'l~c'L.BphvI͗Ynmې%;3@o͇"Ųc+{-3]% ,&j!uV"<xe rK]fviΰ!iv'ĝl %FV0%q*1NbnG fT [yٖeaIBvBpq0/[B%NNetb6 n'q%y/ՑܹPz/PhN^a4'C̩97o(iRvp\p>}1p%3-4_C\zX} ځsK84Oa-RG[}Wʄk:2"5_C\ɻxݺޭ77,˳J|IKʉ7>sU8p p\sMމI2ʟщ7q7srfw!+Z;p"u)k*!vJCfw풘cukRjbF2ac3_æMpMu%[o+oǭ+r n )YW\Win9VNQjW;P}kb],> '#sjv3񰞽Ő|p yfx3:u{6--zve ځGKc.M- ~v>~KxT ͇I>ĕ_$V^@vR/*UYwyS`RP{,N/qtº5)<2aևMK:•s͌6jJ\ Xo"5|/&O mOvORú?=ӱwpyoLIC\ɻ6X!בPx,J@|,6*9bǼ1ʽ;߶1mPa`y d*mJ͜9|j؂BBK_AنAR&_PH|+cx)i%/jCä1^}x;/y&>ĥrԑ;7ؤd=ĥ'N[@فJUQ"l w|s*e)|eu׫Ccg #uH=RjyxTb'x+|/PJw5TN K7G?2kuu {Ȝ0S;eY<KXoVJ=SJɏjQ*w: >䳒3'~;;Fi߃>]8,? (od<+Ȟ{jm {9~,T1""?"Rmm*ɴ!m ePp<(L°:$S T(ޤq3TR/$n>;׆q{{cpXoz{ׂ_þ`l"] \^rrYyMcFV.iu'R]O(~ko]ߚKu)7N,RtD&9:Q䵚OaFUbW>\D@[YZKuH~࿁h^nZF&ͫJG)/PQ~$ (' N5 ݐ O\rr W)!Ţ QȰ ~!tJ~tNLo|v,[>rg+\9\K I=-bT]_QH= ُ:DAܤ-5Ui_ʘ;ċn6p]7k4bXJ@ʜh_<Ȯ{ q&V%K*=mQa\cWK}[)s;g܋[$w 覆_7y]\ 7B7wUHH?-||*WK껁b׻2W}c+^pǁ|I ''꜂.}H:f>&Įo(sg?d3$᨟NȎ*G:s3q5˳Q#mƾK%Wƒ;[v2wWo{I]󄛐*u0P蓒Z]odE 2@G&KƲ=q@֦J^_"rJd6_Q3OG4Â{701{t-ڧN}+= r6z" ͞>ɮwEo"jvMYxv="y"}"p?D.U:;ΪЋ2rF~lR}_1 E#FcҎZRˌ-:n;mIvtESI^< 0t& X o5x+,QHc8.ݹ8so?끷"/~Gaa j9,,\퍀[oT뵵^[0_Ytoh_L>jhᑮ!zlw.p;tIQ '妤^RuR䦗o17 &i)wӹkxvp1.Kjx\j /d\5 &{Q${ 'qօΒqǕw+wnp^$=r}ܵu}Y&NOR>|dg2W0lF:|su peu~(sԯ d_*z4 OBk_+{'pr%PMH!.R:7:W(VN4*04+M#7fثa' e'f/!*t[p*e.=w(f!@IRN !.E6:cu==ccc!lu=8.5P_`Z'zH >ĥ wIJ kZzI|ڇBoChBVB[g+v)ֶwgMq0Y\m atk;t04=KJ;bϧBXmӱJ܂a͍hxQmܐ3L1hVH(mw֭|i}>e=l̒ț9 t03~S f%s!_%ׁBsdB>@엁fds,h+wu^-Ux)OYFeRkBդRl%X%v5l؟ASRDH5ͼPXu*Kl(R>^0x%ѷvm/6mN˩(.G7-oLKǽB\7KE1)<.=xp e&Csq][w;*.J=GUfsU*+V]ۻwuȪt}j!q? .-OWjBªͬj;f.퟽׵Dղ]xt:uhwkEgoQ='@" =e6m*;.N4k`%yCx5o Hw⯝H[Xj'q'ZTOr }> .5*z"q~sqLZV=-_շ|JywLoUic|ُ]5BlJTH|ޕ7 CWQMV5]Sq*CsZmc;1weVh9k sxDSQf%5Xe VguJŦ\֊VЇtWKkKl?jc^*@m@!ߓwC(+ZK/a֨5Fz&kTwrnkLCCOz><㯧H[_XO/%T`@)RQ+Y=|ʮ7?WWZoUۻ|yW\XswyW_rǷ*bO\nChu?ޕYa**7~Ѯ⍥>h ~vm*a#taEX`ݪtM!Ͻ֐;a+RZAp]U0$np|  ?< .]XYvx'ʙ xxG~: ZF |+z˚UW8ݣWu؀ZT}.Z={ps>ĥ { twVؘh| !.I=.:4Cp'Χ RLB 0+hqdJ(x< mmOP(6`Z-aDp oWK'OKB\bP,Jh ޝO I'N6'}b.DqDBVՆ-["{*K;w]db/p?db'F#{|bwkЮ8HzҁwGoτNUQMZ*@8a| ؒvxu]Dڝ@-ܲy#;Nv`'xgEĵ? 0.u$X(Jh|wص/Rˁ{$]rTH}kQ iiT\VBE x\3Q o+ܜ=/۴9@'`2{;)"nAh&)!?=d6Y#5˕ħ}K?[:I[,!墳:k$M*kSyGiWKuj;\e~0(ERi„Xp˖Ѳ጖3r<#{:@u]67 Кp:eA/+6dQ%Bg>pԻ+u^0zq/"=$mtĥ& 6 G+l@ޞ=|<9NLH?ڇ٣g'\}Եfmcywm2rөI`/U5B{_HN'EUgNhVH'z MܤD3n腮 0 K_2;-mhyf 81+|3_L CNX8rxpql_|q F)o޹~޳7nڥ]Хw (v,uZF^sH8t(7:;Rok._aoKS*Y I?xYr|]CBݽtv9=gqb7eKVӀ?xFSզ=W╰GY688hU89,Xv`h;㥜Ƭ6ߓ3^#~#4eә=doG$E.]3L ?yHw\Vߍf*':!GO~|QӺӛ _Oezew95Z rV$ 0WxSPQ೴S$ZWڥȶG sG&)7Cda?&WTez=: ke4`㋝{4A4J}~s~`/ȏ[XTt}\q]6imR3U[(V= FjdzUНK6by kv(\Y 01 zu 7z0 3I>j |~Xj 9Uز~^x=⎽Kk44&Tמﭽ|XgKb]qP _ད]0FڕD.+W0+ ,1W7M*m'>KL82*dl lJ-^W1~ -"[YnJ^ S.ƣpB8;1Кpc[ji, hqm8(O؄pMb7IHẮع;%w– aϣQ9E$pʏdXdrLBXgIBo 㦄^X]ǖz3je!JᏍ&O?]~T̠9D=^5q8o}xsY}GxtNbîJ `xGX)]79LGWxL/%)SSF_ [(Sq;L@?2K Tkߨ_] tf K([md5\-X`欢ky0RYB#:+dk&=cx|K4] x@"/W ډ£9ƘMHv LHE٘ggUF woRL u 2B%hjVxD(wA"11)K $ <~0MuJҤ86ۚK2 \|si ;&qmJ>&W£9ƗKÌ2 ځKHӓ;<{->\/h=\)%~BS6rиkQ!pYn;CϦnFM )SF25ԥT nt;R?ݎWjt[[D]q +o %#M#ZlLxBl$6 #>wFڀߚ|Fo!sSGsq|Zjl6ҫ}|z˜)[(tƝ" Mm ZKm=p -`x p}$n%p+x T7 BGms?̃$!ߩ|q1eÆ?ҧ8k)8`#q ?8#) `#qm&?oi4Q8ra5Ꮤ]itZL0u[ L06`7|شw(_c iΚG.δG:&H:`ĭGm&H\>lZ;C/1},P;0DŽ)| %*Q@#qKpĭn6) DkOG|+16BYHH `#q32bہ ?lb#C>lZ;E<)5] itL0 ? 8#)`#qm&??æſ|q3HvଉbL`]L0UHk61!6-%:#ځ&3-N ?w0GVgd#Ŷ$ G|شw(_?R8k)8`#q$npF?Rl;0GڀM$~ȇM1W BYHH `#q32bہ ?lb#C>lZ;W/qƿ)5] itL0 ? 8#)`#qm&??æſe|q/щY/p["DFVp( 6pH.gR$.R(\$qm!'t$>ĕ|c0tHgM}3-N @7L0IK @lb$>lZc  O;p,#eg8i=pKKb H:` HJ\Gm&ĵ>lDc+ O;pք?Rvp?i=0G $n%pF?Rl0GڀM $aߋDcÆ?ҧ8k)8`#q ?8#) `#qm&?oi/#ß6>YHEH[L0Hmk61xÇM ]|q1 O;pք?Rvp?i=0G $n%pF?Rl0GڀM $a_(_c iΚG.δG:&H:`ĭGm&H\>lZcs{BY3] isI > }&qZfgRl;0$ Ĺ$~ȇ|q1١gBYHH `#q32bہ ?lb#C>lZk10o)l#}ځK.δ/`ĭ&%q+3Km&%qm&6Iæ5Eʏw$4kF_`FSnrJЬLu]v<('nm春-XTՆQ鎂qJ;J睓(tG睓XF[$;WΕT_jyjK-ԜwKyRw-4l̡qWy jvV Y.L: M#e) ZQwm8L=B=gYO->,D WJ:{|)7>_5nvf[c`kQ/k9P)7 ,hԳap5ܷ0Ki&_S'T܃0^^ )]v]$j!xJ.8$x*z2TqX-\-F'RrxMCBW_/8XnAp¨axHk]qP i'LĿޕ|rCjEɽCϻly3ǛԱI?Vm}t`xxB>Tѳmv"en ~w'PE!Ck~_ĿćU+Gs/T+S+R|tZ f6ˀ?}>`d,2k[.\j0\5Bڀo-V}+jdpm1NͦTBv`ٓ5Z_󐭳[bm3M l.8K_IJWWNAJhm4:X,2-#._.m䧭+a;J _SBūnL uVT_jUP>m5RjRL[Uo7klOڀK- V>ĕ|ſ%0S:Fҩ|T@MX}_ uzy 9hn>)|f83t٠>x xeC\ɗ(kc-z>/X;P,x] ֢E!u%kdBbzH\xEUt˟ |[AĵG?.t#WA|Q8Ү%W;P,Jc;hF8i5 q$828"RUQ#=.nWV@#qmmR5Z#}+N'16rUЭk#m(|kw#1+H\pCKu{զ9c#pkߙ|#|+8w(Nc\l8Ja$Tk.jQPi#vw͐0G:yX\#q+_#q-]H KmkC\ɇQ8Ƙ w 5G:sgNF}3+zuKy%f;W2]wk뽿x1׬BX_)Z 4tA%+hiF;\#q>DM"ֵv͈qZHJ]oS9} SF& 5CV`1/c L NbmK7)oJ"SRY`h{ 43I-#82lNEP%N)9 x,W";'L"g;'lEHT ,r@$U&a pM1 FSk'TVHn&a i6 NlnPEvU; NE.\r+8x͒6_p$lxM Nl eX+8aD͕vt9 UmWIo/8"4v~ #Z&$5.e~09@*A'aG3Ik]ՐͼPx4F3k$ځǀKuYם1`OڮTiWJ 5bǤ7׆LWݖ&_ Ru-MHn(R!q/>}-W_.]$ jW'Hk|+upg1nಢ.Y;pa ok4cHc|5Yy ̼Qb'QݷyKU,W !2@YO;PĘy zpuGt0 o\zΌv^wo&NG`B,Sme ՍjK]WLrlE~_qz7'Fwe <%v1 OIŃ oZrƢ'!ذXx41*FO;Pѥ7DTg*/_%6hrԥ%\vn;{{wzVjۀ N/)s/~ oۀ߶ %cTOA{:MBw+8"Vϓ_@tr]ǁ<%=r/> #:S/6fOkFv,SZggBڽe nP(8a-O5[$21%0c=\Ԣz KĹ,qwN&uZ#)%kW$Ȧ<x3MɽKuㄏ E\[΄ A]w) 6er#oКiI׀Kun $ Z&HI|+@EO7ɺa{vHv`o&o} !!LXА31 ͒8_XbBGtߩޭmK"[=}H/c1~p,ZŶa(KhZzY S> |#o?QTx '$e>Ghrw? =lFևH\&ELx5{Jf ^ Wo5: kHD7ir|QRh:NpYKS/%8ᬈ}-XF T^acBKc}34Fc"{*! lX=+lЯE b n5Pk5%ځKHɣ8+`\A@{%ʬighZr`T&<~DY2g{C/& ]z[w+%/\RvN]vv%evW:RFp>Jz \n L݌jW/0F~ J=H}+zĵ!cJ,ܙc|ܼ9laIvջ?ZD9Yɳic@F Ĉ<_3U]UY:jh2c |ԅ5i\?1:i\KO?E};abӖD(iN 7DIO+,H{|(=X.6{ߛ|@#!%9 h󖗘NQ%ꂀz>o"0?#R9︾y[?7y%|KӷVRGϭ@\IptqIӣ C\I0j#.pRmV>Ge'tWPt p)RX¨$5!hL?JZN/UamU̚%LUK^wwšS'1,9Z,Y4tbExZ<ש` k(9;yIiri'ަL|7][/9,/Ri҂K21mēfl1^ƔrCwnя,z 8+Wc씭RJ"mh1S09m 2XdOFaVb4G5uv'wW!0%7 RLRRa$   q<}u]5/4Ūƞ鳁7NʐR4C&aa #̪!Y{6Oԩ՚'xZj@NBp$CF4׵_JGY-!}sZ^Q<3mfi# % ͒ܝZUusFt]Oћ8hW[I=~(PQ36!m*Â&"t [ĕ{=lOQ}aqwҜd M_̑jAR\Jڑfq?M-ősWpv2Rx(;&P]' 'خ<'lkJ5؊ADnq"iMTϩ&)_L f͛4?&_%Ö+ޯLT4w1!*pI,Wx)Fh|ĵOPضRO<%v6bZr p)hJjⅅ&T^~XGl+?͐SɎʫ,ϗ"EFcc$ <~0pCJdx:# E ~w2&x=MR:7̽I;C 2 _|/{+`u5{%}lԊy=p/Vf1nfX`7/)d\jUOBiOn4Y?eZYh2L@ \v>(ڡH<+874u c@0Oi4W؟t8x)淪]:hK4t%PN) xZ=EvW+:1>DQ֮sƞfF 1s')*XwF-ӫ4IR!8"m%?"'L L *8aDOY?qE݃]ZY>Q6OL`T rY^ h4`-c>J+2ԣ>)od𩧴fG;mH~-8aҝ6W N @q:%4\ \ 4< <Fވbwcs(v76ވbaLuK(u }$n!P]ݷf<е*(__,)~kTt+)eLG[Zt+c*c;(WzeLGҕfR{˚UU㬠e*SI?FxMM*tYls ]-BEAPm[=%]{ Z$p.Fk-;۠s4ָZsS–=z37ܤCy5Pr-{97c6o]r(m Vx96BuzVbٴA(񉝕;YDg:ma0~zO?|JZ+ߜG7Q<]3tIˣt-iyҒFz`tKtTYR)ŭ_ee٩f4(hFs aL%wܽ |ŕ?7Ј#]>lcc62W"0L{Fl̝@nB.H9H6}'fM6f7oϴ]]Ӄ>ϴ^{ޫն@W3b - t5BMUhIȷnT'_]:G}py>H:8zE}pn5}pn}p&-\%A#q`ݎ6UK/I#O;O*ְyЀׂEmk5mkmCmمj^P#$N6Ex S":]9xٽ.~G'pxzzX^WԅSƀxv Olh{&(T3iN>XRbٿ3gX}MKgE^7> ]6R8{ dEWVkz>k(Y9t =i'(m*9^ ;Tk\DMw|ܕA9X$42AK&'۹1ǿn,^|A"D VЄ%++{u@G G8_ nyȫ|"v~A#[zAFmBS$\“Ϟdƌ\n-*{ Y>2HhiRKsV5DC֜9Bx&OܶigOiW-eto:op{v(4-ܕh[fmiM=+>ݓimO,٢p48XCfxQD5 лtĜgNc~PǛOَ!%oҊ%{ ;NtGwm\X*qۥ2H2 F(2P8'<?r!b7Iŭ^;VsY::Eu-ؓ$].) $aOD |CJ9b\cXXؿB޷Ȯ NOڻX_t[֮~i a7n\ƣO)l, oa?Hf;V9pelRC]A-sņRRI ._bԺj1VjvwU@ųYmK<ȟr0L?DScXPW6oY{5X|+o/tB~A*HD> 3 0Dens > J_F*_~MЄqH 0T^'[bmD@Ǩ븺5&K2_NhB*kWF-!0yW)SCՐKK\,Ƣ!ɫVtKzMʷ%AF#^QHjά{wozݗ_ < H:]77JA`npB䋊$*, A0hUIv4f,lv%e6h[ KL@O#p/轑v֍l֗kC?(SF!e]a 3a7'_xDa@-0NrM\|mV&nV_ w⺽%:ϴ妵]"b]1s6zq [-pڕ1ԒtG -Љ;4a zx #Ev:Y rkgQuT!#'o4a2zvAFD͋gZc;eCϧqgnP=P6t.߬<<҆=NA*Rv-#. 0Wnt2zRެ6ɃSJ;Fў`}pJ^4a܃S[hE N{M%TзVQ)q.h}+ˠˑ/uS.PN) x37J\T6]$ǡ[/2e"iw )v=,]닽I;~ɛm!`~% IKeW@%~U_,j\dG| #?R&M\h\7[dK_I^^x?F ~.LseiNbi!DArM _g=P;/#~]9FG4˞>WMO`:^vynM[ڡg6h[(%״fwfZI4EH*& U ˡg;4a*eMo&Tx$+hBE9x(U`A[MH2 2[PUВZ#z^gh'4$Qd}ws!}!fƞr' ϬP%? oA,b>*x5HIYQF7 (~\ o.jQZi4:+{BM2!|VTv9&h.'O1~ J6vbv9P26X amBAewVVmb"E;@c>j1ACg#OlJoLKWAGte}q1S\?<5&ǀM49 tMqƦ bnJ#4gT̲oʙ53OH grU)oA֛R5J7b$J:I%7 0l$hˆVЙ y~3nAFO(g1J= |LЄp҅ bAЄc9B\M[]Cwrc#ϘqCJE^΋w|qpT!=- ݱ%cm;H:4aqcdW2xPFuC)&WQŽJdQBoUXj"{~M0 <1;U,mҗh13P+;" ⊖DQ^ NeWc`(e^ڼǜUl\WUZ=^l!VGg O,l&h|0l*aCTRhNM1l`ټR0j˘ٴ7(fUYjb / TfpM~*;);j tzò1 }eLp7T<hÖ^7N4x|zl#M{Ov5ʐHOܪRP*]"6V/i;qjY;gG%/-wBv/Wf9'+@x~w^HՋ6OI}u )-S]gCC-({ֳJ%z0)Vvo6S0J63K5ᚤ^])pe6yK42 XĢN :^,MQT,~^]n[]b;7SN"o|zyG3ALlv,ː+Y(TXA¥ڑá;3i FO$dF R;WЄq{;TeA (0@@7=lN܄o :emе9C>cݰMx0:# ,[n_)xeelmar ,ȜsUR)6X QoYA|+vijWoJrًmkŢ3OMx`X۟ j6-:+c)U'n`KۼR簴jr:ʤK."&<0l|Iq56R #R%L$Ҥl'WvRjU_`A"^ Y6vOPQԀ9xAsT_j[ vM7q\ؽWSQYF1=iԨz:>9QcvNv|3Asl&M^'\,0ޱM ieLX@bg8]&W>du vGL\a.s.c)^ȦUi ;eG!p1ZۇrxP*lm(07c(;y>l无=lN4N4| 3jH}(t ۜ%QIlOZ2C5ZuܼVlKB U8;]d3;s6YJ -|3QkK۹1GavὠnH3Xo8sJ|WUqϜX39zTKgNcΙ eoUԟ9mn fNթDLkkV,< 1ql8h,7I3\НQ/wxdg0r ̥e0gAbۭrgݵ{슛a|I|3A`_tBnUt7I| -Aބv,W J6n'j OJdMb ߪf (M,GQo=SzܯعXvٛK7zCizIC._'?#h¸wxز)pاhށ[8Da^e:Jʨ:pvN' E>7JGxӤ}ڨ"$6Oܚt'MZ!v"_](0b2?agp@H+@PUt:W9bA 6eS%pQd]KasPGʵ43$0 8Cʄ=; {vNJI n ǎ,M@!ݨ9aX4hr3gL9;t 1IԾD]~j ,Pڞ}BfCi}egi{+6t5J;4ʺ:,wZIfrJ j7~éFjWLx&ƦJި;՘oT#1dbsӕ{kbn?39ϕ&s>ux szKKQ)Rhw!QNѢƬ[ E]5s49<{֐xk h7( 1D3V8IdF'ڷn-Cϻl2XETW_޽ٽL|N`Bk^}2{7UdjOMh ע[X @ktkb=oM(N}~fn3 3iVڛkGа%N۴c칅=Sm3o\ggdPu} C-CP:)L.!:nd$WNBM,|إXWܗ!<) {̞b?81]ߖa\PF+ReR^ O:̵y#iʢlcn^`n^RH`7 SCZSiH[rl攋.spju͕Xsϰ^Bw/o7;[2"% ,U魑+:}zTQM|Fەs(sP|آ9A{(uK]87X]E0PڽJ1tPI⑴jj5*Gթ ˎt7 }2Gux.l2;Du-b$`t~; Z]NksErȌ.e& QXBoq.IW.h9jq= Za$p|Ml1`vw: A) LE GLJA+ f(\zyv_C<ƯkJ'iP|-.DBeN^3Ȁ&;BKR-SA @ůT|įAkBwî5&lw2sfNJ߇kF5&lWe6~URxj|ST8Fgjx R3X~h.2-OOZzh뛪rf0,bRK6lW|*[#Г3nnٵ{la-4__' zkN_C<+P앰({TM??Ö)Pɉ Pr ǔ:=R+e)~iZ :*FB /}aZNo!!hCM^l10z>oG+jZ\bq腮=¤>z!Gxhu =A4WO|\C<\\=>R[2"z2Tl)#9йx3̃G7aoO=;G}'~wPjs \#+CA,Y?}|vD^+Pt+@_SWOJ*}b\>ģH/Wz+ S:'jTp55ƇxWGʏ6WKl-Z>'ROT3OtG݄(Rq|4M7OjzQ>T5}ךm'] N a8m Nx)Kv*2_?TmOn bwx9fURC 7T>*y % }2-?怰:L< i7@o O}z:LşC<'m[$Z To{juaxO@ _k7įoFݾmKI竅&h%la,oj'/k10?E\eKx4裥%{MErkc;րވ;q 1|SejDM2q26..J]$FSK YV"sijj[jt5TsڷYm^K 1}d1kHaA]ė}K8Y8`|punŠU켠⺀>8 9up,uA5szAMcZyʕ?9f6];ȥ< 1pjV:U_}'~dS~є&s{>\bO8]F.-W/ Dx-[eOklaU((ht'c_cP ?n0bՕ`o1P}7 ]1D\2ݐfim+x {3k\\<%?{lg7Pqs@!!5w6UFVF ~g[3~8= t \ U&la"*~į*jK)//Jpqz4p h)цSwA -&)6į2]UwCVti򻡿ЙuO{KER(0ᑠṮ^@U88z*9;Wy*r_埆?tȩP󧛣q^ 4xUiӭUL 5oSU>9V &h2Mxp꫹N]1ֆ+eͲ'5ݷ@.>#\zyu}cZ>N?=~:-bz/}]2З5_ߟn-~}O~m|-T[9lvTAǐnf7eٟv?TMo6X`l1x;xZ[l螅0į~@Kpi}7qy-Xp7C8ǣ er |4-OD<8?YRuV2 5_S Y9C\<,?ix4?sdͽji綱2iq+m ڄE+Jo1]ӢS NK >j9"sou E`AitH,=|TЄqta>x~A3; 0> #g+B>S*fڲ"zúeua'e Ǡ31s<]ƺYZ-&+3vb7L^#hB]lQ׌U)<{/4a*Ç$>An4|?8d@p?&T ~64a(v #vd6AF#GWQʹgiN {@( J ]Zj^f.,KDphZuyp;T\/p $v*r}&$xs'Q%cIm56h['m8z*0mb < NBO{o&J1\$88S?J<@J[{>ZRiПG ϴE_TݢC+࿁xug8~s?Wo/w-P=?8*,{Hf>05]ClLVynq'#>EI'_\ ̀4Sq Y8-=MPX/S{ۀW:=|ʴ![AoU/xb/20Aw!ӁJx;hYz{؀s7Aڎ}GQЄ1tI ~^ZF~|mW^7 }{7Ciƞ &A'O-5"hx:D=O :!i/UA! #vNP@Il鬴%+&_ hB} ;D tReVp+7dM4O\-T <FЄQ睨:ق ]E5N4M[[oJu^+?Q".m"F{԰ <2wXj#1FF\vy)0@ zx}E11Џc0˒Xx[pPq {IF9% GA?OCrfK2U g* sRIZ ʭoRh>6UK{2ܣLUoґEġ<"U}xyX@Bgr7}8.UKۀGN{2U}Ľ<GU~j-RՏն|~T[+rw?dwX3M]<Tԯsi1~#(ɿDVTMÏ?r݆vuGyy wXR]{=L]h8(vP*>BZ~8*8=RKlj|&0ŞS#5v8 Q-9=Gm)%n1ɑՄݖ%xVjW0oCƾrߐQ,?b}CS{Ӈ}PY\7l߲vK*o=:l%荃f`ez{{[5-TW7*xu`l+5ɡl5RBC]AsņWB9jߪ*s `4oFؾP.7Ҝ `≠"n$5JC3b(m"EqiC;$JYP!5ܸ.!n-hԛbc <(NrS>;٣&3'7eyC<+MY# gF[ 3LSIޮTQwFMa;8᎙%' C{5 ?r."FyYY.rGf+@:#J}jPZjRCotwX4Δ3sS42I>y M2\0(ÐAG@(V oJ\3+<"p&^QOJe!o}sSV| ģ_ h-ׁ~]d8}C}zcRv" 2WO}xQ$?6o+ ?i[FZN,V3sü+i$I$q”kF&Tɱ\xM/ɫxFЄjT'4 R2Yϡ҄˷1WV~(ΰxy:j/|ԑpփG"IzG~,~yәѸ.^?$4\탿O}AK }~<{+I&"bwl* :w+Tz/P9{B!N;RSWRMnz/_uZosst~lKx [Q%cIU-^F˻5Uo}[T%~rU]7&L\ 'A?<,> Qez')Oţ/ Zo;kڋK0)g@&M]8ؕT?ʔςl-X_ ׀^#~:g7}:Agb"0ΟH2pYPsй-SssKmpYMWv4Wڅ nj'du7"mo0˴œ0 SPEyT3Rqå^2Knvh^eDy0صٯe)ӻbp9P3>]1s&ݙ0 #Ybò3AXrm+ƈ^)^%_IĊk5c7+W7&#OE6m5_UM7etk}_F oa+TҶR <8W԰޿+S(Lkb"{7E rBE'-[Uv|x;j@\/TfEPˠ&O.t2D]:>Wƞ*a=]2 BTuR j2@oݠEMT*y:Wo~N٠-z=[ƞ8SJQ*aX$]}%?Cg{'1Rƭxq(8/<۪kP,3rqhأÐ>d!k/ZS.0~ }lZ{;p iX5 ÉhˆuČL4 /C&T$݂&AJc #JPLDt() 4"-zS@.^*KZe&(Nm4 yW3& K6}SbtMZl2b,v1o4aD->WF>4",K8IݱzBz qA+@Hw hk3*je6\1 S]U'4aDB/'~EHjY*92b8MѥY^مn+"sKF$.sPat^]Lc q3 zwgrfQV$q0Xr/2er [NJ_ִL> d(Q~^ҽEryN^'vn(i-͵TYtelLj8(sj%[WQN(TiVy5H7 05H[MQ Vk){Re+4&J]UCh>" | mbM<_ _ ,Z38RЄ=|L | &D^E5A󵔠u˶ٳnw5a&֏uÿ#dz^ :Z6W,ӱC'Ɓ͈Pq0RQq;.h7e|)f3=8zn*Z>1e浽~E$'@Kx~ȣk֮(  aRWkб-zn̴ve`d{mOo> .#{'ᄇL_DRЄ&6HH.x c\xN^M%)'£˔XRF&'_ h thɂ&(Ul,¡a{@VJ:0 )Kԝsi.x Iq!b]LFNHf@C #(;  3*"mX"F/tB$A=g|j iPrw_/h8$w;AF4˂ Fޤa SnHv ^S꥚U6?'AhBvK٫nl1):eZvҢ5S 9T *Rk}7FB͓&cYr.S|o^m]ROۓ&TdsOhZQ-x Rq.hiimRS 12 8<x UM[eR.^)h8v1*AF: ۘ%p+ܜemS[0OLZojn>z4OB%d4x5ֿ7U0gscE3_=$>akpTw͚.f Sމ2Jƞ^hƓ+bλx-k5b!|MJ{_=F~z%eokN(l*:; saQ+L#7V+t.gE/1sAz!K[#f i&r]ASЄq? Ռ_4xb/tM|3o׵CT7T  a01>p+02G+cC0X_jҜap[06SP!*|tscОU|qhzu72AI6c-lUM쌗i5O2!tY"n*vI-[n??ѡ1MθL`ku[]ݙJ"Zɓ/?_Ma5נɣMx1 Ef?y3dWbհ+W(Lob;"{~ ~sYiC]` -U-nyZ):k^àV@fr0YZm郠 V ̻ne >HCgo |[Tg)D* T5Q8;l :}PMӶ ȏQ8a;v0䨨BlCJIxBgXbҥI(Jh[_ ?ikOaԊS,vSŒ-dZ45SzС7/bj2GRƆ)e|R+LM5eOM5SS'a]`K̠#,Qv<*'S3/UX5W=s 槁4'dWcӬЦYPg2ya(fd}+4^mu'/{,!alW rkz8lvGY,yv'&AdY7-/Q_ bU`dX[JRqw7 |9IEj8KtW"xXL +-53)πxt_uj;I&T$LKQ26^84iHt+MGW :!q`Dh !sMHZIk+Nf儶8"h8v.pTЄaȠ)!1#hKx cp)K-wMgxp/4aD8^ɐ '!U] 0]y >A'%kn+o>#hˆ ʋ)$)O6PKPn]/&COAFltk[$_ M#T@I5n :50Ո# PYx cPB` #lRFIOtR*[a1Yep89 h絒W:)/+8Ci$!O4AH)FZ~c aZЄ1]fMQ|kiW ]na5.ू&S͡R8x ո 0]X} #1M=nd.6 Õo } (7o4\q+}&T6fAơ&AFT㫊[\K\WN|aLC&TE=Jpݮrʾ9$ng.^y_ЄwGUy6V L;}_wWẗe Q=+c U+iC.u9>x9*Ágc 2As$sG tؠ., 9 /ttNUx9Q~%P2f1f7#..H#V0։O N<9~NAsT74tz~As1GQ=ECDNw̬IôQG-oӘ9*I4a nM|9&h:|i;[(<_kh36NtR&lB<8X̧!;bq z܍oVOWgX~~NQ:Aϗi|ŵ VI)h82o4|,* 4aD?L\@D١9=OPQo#7 K\G.!~w'߁2FV>\ F DB⏁-W/U(`v&jeWLt֦j ^.MQwg(z9d&;@B)0t"̘uS]X-A'¿n*^QG3s(cwbG,4F# A*`VFƟ~IЄq_4aDKm&R޸fᑲ]Ui($h8MMQ0WC=W>KGA'%$(pǝl@͗^c;]*qDLJh0WEhl'A }d@lqסԥFՂ&T$gKWBbAF; V$Zx yVT :XQ;n*bne|픸2R6B}b>2k7>ƓW"hBE" ':rU AK  oPЄa!s7WJ'. A*1}v(zƔ~+]Єq s&( ktscFnܛTY}B7 !{RЊ: .h;G?y;? {_UwMDӖFFmSL?ul,gj! > sd_ҕcD]=VWɭk%D'hDKwq| #Y^1e-iXfCӼ[F9l,|MHE/;"!WO)D|+ F)r-y߲󺤻4cKl[x'I ]Bt24YLCYuuq&AEMQBˉIDx 7arp !>NJHrw4bA'L녇[5%`^Є ͩӦ|D| =[G4a4w 0 q6"| &T$“gBށΒzWKtRj^|O?'h4Ӫ˻R'h=/&à &𯀠 SЄq%\:zbz!ۗ=Z.Fƥp1&AHtM`u,Ĵ2-ѐ69c:44q}2Aݾm^wB f^ms房}5&i.fi`1?n1t׶”V`C\;gD瑂^fW gO}cBl׊ˆ% V%>h|%.ifCc7N3G /eO4sب]o(5:2_NhufXȕ3*\ Zjn7B@W^]edڇxTM%lY6b<!Ij ozk}G+1 02uRK'}[TvT>UndwSim= imL+]e-6 6 ,؛.jkZw͚GsXb3,H`cԡ+!~*>@2[za5Y u ʬуUq)bYc< ,%*&Cn1 }G(ٻ\7 1zC@Z$CR˻Z^V3Q&3<盷Mrݽ=ޞn,fZӻgyʐ>x'P~l5P?3≛qW1Kn94,37LVevLf0>I3de9ult]\:S;J3|tٮN]"4t6Fe -m07V4M},Ns#菩~/u i1OFh64b@~џ7ߑQqݏ>ޑ!mEHm$bovdToDA#clLfEr~'hJdzWbfD/]2+#n{س=2*:j['~6KjF̕sc2KC#6.Z+s307-b=;oC=%1bI-d!-u_G>xi3鰱_/@K F>|ȪU̇^-Ճ&MhuzWvY[be5==Wf8~R A?~KN?C3d?*F oTXirFBY`U@7%5Qu#/l(s]a<x dxqk/4aNb6w2{%[ dxq A jdB̚ޕR}gX܄b]\:YכYӿ[޾g>Eumc cx?/h&^\Amܩ/{f#)CE>>f, aZ^E3k[=fR7+~#_EOo3ɡV;*N⮲ W%$Z+2ZZZuXľ[vՒ`~/𭂖ge I'[ನo4*O4a]v{MQWdCpv=׷z5!wp&WA6 QqFЄq[*j=q!"'ߚ6g+v~ߑmDsͽ1'Pu4ܩܘ]GXWaεluEkZw 0vA_Mug h ٮܾ:+7W3DZfTN Plά;_ߟ[ӳ&?ۗe!M'-!T^S&xSo|!rT=o斳ЪmJ}lWrښKMlAu/4aN.hBUN7>3 Zn0Ӡ/4adAg7V0#~'{=} W\fʞU==!}zA6gPqMB!q3f bviar\$! $+/LOKwڏ6A6kЗˀ-iߞuK4F~ڜ7fN9MC+7>`4?L1Jq>uTZ7sx>m ;p-[ z)mÇcK7nT7pWR`|3xq7[?063x~|s[\3xq8<շ5+y_A*0FO/c4a/* 0nO7 A{Ef>H[A($1|O`0LxvMMFA8ێ!%) $GGY)fBw#<'E?a:q*v su/^1$Jmb-Wu H"݂#IK!υ"YE9K% @o6q;qu.XCÕ2 n.iP*g8B-~-eYt %@'k扞2|XC "D~XӿR&va K࿣)~YV|}?!b.\AYl˅e1ֆE6T\ ERP]>L'n6PQdsE6e9fnH8(LJ/Ҝ[ɲme1{彍zavXzw7wA9ށCY:x2q>$h\rÂV-!>*hBe#+8oErK\𭂖;C1]1E=JJ< | I&p|oUkB;* N{=AɈf{fH!g97v^6_T,9,e%S皰y+t5Q~ow9%%B wڻgmNA+Me8x$KeW4*/6M8>&l^rf pzWz5lӷr<|k8]:Px|&l 6T7k=qq|UxWzI]\;5fLa>eUs4)g;S| ,1UU:D;w :_C] K-5Tw)5Žh1*:_sH5idV?E<|%YaOY$1N-3 ~EЄqx*5*3[LP>3-k/ >%5,jzbƓ9:w9.)t/8u"܊:mU VKu _| eK4a^ʿx%]]/:)0 ^{>AF2|ņeon캲9Yӷ{cٞի=WC5A6Pqo~]r#h6F 'n6Pz%oXwx'{D=08ǧ`"KDn.nq;]vy.6hB/Oڐw]M h[(>iްmnYv,棼C=QΚw?,hf&*VGMQ0,J)Z]l߻BiW8ӗܬm+̥󅺰}XG_MwW<*xҮx늃fnmkH/S O0Y,)Y'< u#uBYR3]M]tMD] td/+CtuZ~4a;*nx%o{xfv,teύptuʰqyAp /݂dxְE7$^ "bJGYsbeCھ_9϶!'&k*!|3 L4;E=gTĵt^b|a x a;*~-9a$?1&lӡAЄJfVY,'4"ٜ^^wefBzhGN,ۓPq@-zOlhB*r;v1 ^Q2T]}Ts jJGMzHߌmL< 4\m6P*>,l>ڦ|芰+7cJ=T 0W'd$_O6=uXv.g,Yj%d1[&'"[A+=Kg$5P*>C1f#6aӢq6<%0%r1EK4o΍x:A1tK?T& VJ0Pet]ry&ӻfuTz.5?ַ2tf>{/𻂖;S߫iB*9`> =,sLM2kvFΰ^6ud*?pIuڥdHNx`e:iWЭY=җl{JdCk&f:]M@4NG[m e6-j-oܿmQD @/h^LL{C}.taL8gVdV_Q"V ql2ptN=jlFŜ zcЇxf !i7:mW'ZmXGI##laX$h8sGBBwe6v=Pci;Q֘=ZR[`^)>%h[B'{iAKfz)kn/"v? 틨OCЄq;*51*E}g~ 7th7JlFyWv.TpT)NyI#I ;GLGm{\)AKޔ6s Ps ;G|UЄv.TMQq\ruw/^ٿ{f'zWf94a wÂ8͜SƙB**cJ_/K˳KbQ>s#x]ʳ"ϡ!;1vLY/6TdyN w ZY8_CřW 0JVrK~#1t7 \7'NNpbw6#F97-za=yDMwzqgkβ^˖#!M"I &{7Am?⡿.q*2G6 x#<-mO,L Z޲Il9gcgW%uT1n[Yū«ҁͶG˸lpc0=*+*V 9-:sg}%WMIB)1MyBؾ?Pq>ئ.!J6.[fU&7Qub!Sm̱"Y&b(_m~ BŽ 6|-~O?Y!i G֋ABr $G>"bxVxmB2ʯNmzB\.趾Ⱥ!Q@|ʍ1Am1r끗g-{6+SHm^]H^˞sTPl =".vr:t|VAT_/ifQ&RƖ)3xHy1h(:E֢1~#-Y 9#_q w19}Es(sjy'O칽MT@=u;IE%7f"Gwۚ4sDLu$4tE1S_?)|aQem;xBw2!7Vl_ٓ 9xfPH{ɦU7=kYg/3]t&*,`ߧhKţK;";pn\i@#PP)tPz.N'bdHF v=ROף;E=[PQ`Z. HY܀bs,b (x cT XHQ2ʶwg3VxaCЀYAo^'v %::1Z(%;Am*7Љ&C' -i[7M*zcBw 0NЄqhV.6=VƇ6݅*ڈY+VN\6!/4Z8^p퀠bT|Cseg^?4鼤Y֟zZN/*tߡVG5t58[څ +y/TӦ PCw)tV w 7lZyV'(\v\c9釈Atoo;E6d^d9 Y [33 h7h\Y\Q~x&Ħ~ib|\T+B̒,Sf5 %#F!d=)h ^ [9 >(w/ɻ[+f9HY/p>1&@\X,|5Gk h-zZOxU xPMBp, B\.C.kF)lP\`j:UaMiwcҎxuDͭnRHT(:hm^Di8¹*$eU]mUhc(Zt@m QmoaΛ#-*2i`ήT=\lt9*BaĊ\<}bߜ3Je.#T0g{I# }gSIOCW0b5qj}|lҟW1BWBW*Љ Ew~sk;1LCf7bV'f7]n!KxHC09m!BS\3C !r."5 Dsf504j1a_hOhaNRydN5a8e'LpGv][;/ج4CYvZ']Y)UOdwә4]#ގ\7م2KuZ괌2Xc= 2A#uԓ}(ku<D0'\DÑ͐+`#2+0ht' 8oWF7ug*5Z+3NݴV0\yYE/r)hy7 Az- ԋQˆj+Oqc+UaScvJdXQ1]Fέ :v׏ ǭȉK!l^Tf^7"Pˢ;UKjii4Wu0:]ˍ 0?XSV8b}, ]/2(a-2+}Nm\R9{.ē.ԉЛIۖv+гVНQ&Y2]f$p"TO 2>֨R|*f!ό j#5"* ZDMJRPu{$?fuQB!X\B3S3%o|5̄ fvg&rJT_+]|t!(_:MN"m; >&-t76vR>g.~ Y[Xٶs|^|dޠU!Tx)'ySb3Ιn&pu7{+tP%BK43{1k~k'K&x@ 69fE-f?admd3 4DT9+j]}!vFu 7Hlo zIό İY5'?Q9 ]cߥo@=עk#- xh.o'˓#sy(md9M??|iv͚@Kvmb[fB/T$B[6aFxoIEVF//QNYU <,^ )QBuSqRuL^dztzsU||9ronh_ `:>s2ЌhNں@DH .7=wx&QR\ \*nqRٵvԉSE{mשXCs\ un+/aIH)֨=i}==CHxx<}-xR٦NRwh44}m0 ><ާTRÚ a+5WeMߣJY78ޤבÄ&t!PuaRscFn\LO26\q+cuΙt~*7*^ccfrgr. 0j-8{fKқHʕk?xSm%3_8+̦2/`DCCiF nAф)GZUE3ڸeOZ4S?2{Siuf't[Z6aPQ:SgP0缼 $' $xqTdu }U:/m~{T>#}Cƞbp+;nY5_o.^{nXVfrFٰ&R3:G~uKORY?S/\ 'knTd.}݆l~J ٰjLo4󍃆 GPD'p﷋8nzFջ~*tA2k[+|:-h+.̠6*Y@Q$ۃ9Uea[m$hoCCڄOV a[G a>#i u sSA,n3kQ'ΰݜ^:U{% ;>wh##`?~eY)\\6,.Je(Y6v/}Aڇ5&4cu-V5B}O:# >X JwWPZW\Kp"*m[R39^p=a;aᝠl~g9 .wYWOptÛY拁o{2;/ E R;64T*=p߳7/A_C< \u{AY Y@Km8=BA /W*o[Y'Srlemg[.-IEA+HQuNRh4Ku] ZVMk{5j [;jTX+L5 4 SqjVoc1*>>ySnQ}-U~}Ts1 ŭy [|=ʱ)qj>]4U,,IS۳G7P .+RخEu8C?u$A8EćxZ܊/׋T.F*neÀh:{ЧįT|(⡪X}Th`V{GFel$eVdumVN Qjִ G 6nf2tדo":LTi,-*Zvf.-6Wڨa.}`OY2:Lљ?r 0AfU{SMS Ay,l=$ĕMm{CxQ,ϷNOڻYR E{րޘ~Pq˸l 2U'|O0^ sF$fQF/J1uM42#_D&3 U•=RV4U5nbx1 nGU4h1*b4#{mTcj| ZbjEYCq@@1_1EZ%l?u:*JY%,61 TV5Jm^sY5j9My~W`kށb#c2JP*a*T'&l`;ټR簓jT ޟg/ҚҒ)h@Dq3va#(d,ZN3 RV5Jlb"{we}mwϞ={"8<5$i8'4a8_&øé )ra)T'9 gQ gJpQKױ.v})lhi1˚NVŨA{F4o*9^JK|)j_YQ~[%݂&<0=>a\U†YQ5,6ьYѦ6Jm^s_5ji .;ymxjjvv(E.(y*VY[Ȝ _42*LN_d,Tr=<)ihZMTP4]M7Ҝ㡚4 5MхDp@ebK-VOӗry!@LSqǃ>>xvi)t#.!\23WdcC0#:?,'o}[KV7A$ CM%׀~́jï1ZƣبoRmScNR+C[4 ToH8k8bK…qfٰܔYd!˄U2vfrXRQjW_C%V PQ_n_7N\KЄz8G x Ν$ZE5ùsR~*] ҧCOoJÓ,zK3}Fth.2b*>C&|!ƯT>v >ݾmKI@KZ40v4Ч5_τq0įgAoRÍ\qP}whz>o&`k &KÀ={gAo {AƯT|FZ롚}9fve Midžw0"+)^3ht8p4s6Y/}B]05͠7+,6` ZndҀ [AoWt8!N.лQmrjh{o3՛K\:N׍P@e/ M`jzЯ:gUQu>Y#o1Q> 0$з.MkQDKgW^|N-wm'Cʰ<)x5諕[%p̕{AmuA`Nnлeٞ:_^_t{Ǫ&<ۑi5Ķ:"طm-`vs*?3]bn27<!p%We7h ?GNȍ.u1\*ȿnxtP\M5p:!4*;4x" 0K?C^RMGߠUQjm6?Sq'Ӡӑv1߳8G8\MuEC+(OH:o(j”Vb(LQ= x>po}k<§"^2TDC ЯG*w_ rR:A]:ˈi3GL)qlimRAkL ~eecܘ!R"R]nNG#㖻ZkJs+lxS&v8FEt+ypŘhh"&Ex#bT/r> ~5Rer`>+0UAމ'}AƠ hArb_ 0_JbkyClSJMwy59: YŪu1挼N>7/;:%sԅ6qRkVJk*þQr*tR;sF, L܈nekQ盵&#?ji_Oc=+[/)hBeתŮPiY8*>hQ١5E>U|vad:+#dDx,c LN O $ &5JlE,{GGUh!E2:T599 !Ty!Cd1Tq$x h)S/b1 02 F M/a4{[TvH !r=3)mj[i /wTZ m"SV[g2wϳaYX2Hm ˡ8[|,$ gC-PWt>Xq& h.أS | hM麩ׂ>۔ }=:}S&dj ~> Q b>8$6+d2{w~2ٜ+zt ܲlNz ;u֧*Fwo_7s5=+% %Fsž /QCG7xZzEY#~y]w+_dWIuW2ٜ湞m|Ľ=w9Y8})Пj{~Tg|'n6ƽcEzІϬ3bMð(1Lu>]Ez[%']dg~`VcOnȻٮ6Ҳkzdf:Tw3w&4a=PJЗeȓ.R(zX$z"S:tS`:ݐsl͸F3b=nܷgZڈi4u6X GӯaXqcQ̶n ~ k' #l~G^(菶 ~?8+X.瀟ǏT'_#egR2ٜ\'~Y߳wEБ@_CG*{|aIu4Er}z~b>Ϝ,|_sͽ7'ס_Zn\Xwc!bQ">D녈{o{!*6LL^ vCS)] ?U6e'+Sۙs9{|<4N6pny4)1 MAx{c|XM7ʅz hw8oD |'wQy5< h,Qq~tt{ L_bCσZ +t]ԻgyfyϪ)f\X 8@O7≛ЫnSnڬ;鱥"x&\>\u;}|@nXZef8xZf)ߧ#QqUnf5R@:뺙Uݬz' 8?|B=$h:)≛Kƹ<6͹`w'<t9#.vft[4{6tڌ!| cʺVtyzn g|}[FYTu>ky??ﳨ' |JVFferS@AlR1\r͚+{WYٳ&pp่8YЄ\TXM8]J 'n6WQc' )Nk8K+.Q Z p9"VMmE @)(|hit̅V mkAKl x8:Яk~u'xoc~>;*A?`gu_&Tz]ߥL6,^weJsr՚[S{:Tܻ-0-CQ7нg;*M@AaG-(סx*UA߭,8iPq_ :iCd:~2]۷?d!& 2/7PqO+x*>7BUTgg(qHv£@nԾ֝*6%$2j~ybDok6Oj:eQd%w[u+$(< r["UOϴ떤{^,~/H- T(83g<A] @[-|X]R8\_)$p=)S '\"Y|T pzX3{ЀU!'d$E\ w?E?Cx+h*zmo,Lfy9qݠV7`V_սE=+fOSj}:ΫPq? s*#>7W iWQpEcRd=< \ؠ9}Hldcd&)mڭ^6txE~r%9/z] w-7P7o}21%$y4۳Pq7o-7P{8_f$Nkɥ}+]nF'iA@{-?M?CZaex@ǀ>FaGSqcA݋98H4q@\+V'$x; ;8 'xtod9#gE)[\o3ϸI%}ֈ)2Op =\YStuK]86`]R'E'}I\ٙ}l7Ofr0K:PʝÚuҔHW9EmN9scOn5 v,25_3'1^s3vXpy4IY4ilH$6nq&hey_J$pIק̴6z7'DQХK zB Nrm Z_%Ym(O٩P^2O?[sMm;}ݨ v#WblOƻ杗2N|sؓnx'r*Ax1#W+NB.EL<^a.a17; f }^ Qj Y\ˆ5'D+|v2ZSj D|kgux-*Fx-k[3z'l>}u?x$T7:^Lu/\^iO /PĐA0Jnȕ C`!L(?A=#hïds_Gq*mЛ"HQo1Ħp¥*!6zz}H2y yGf^GdԑXJo_9\|v(}!~?җj_Ϭ͚rԽgbr|YȯY׻wdjE72tu[פ7:xM kjdkxX&Ǯl,x=Y}h5Zkʅ 0Ca]:xU?-Yyd+gt >+́9zFW1DF&*uB!nIDrz-*0Q$C=ici@}L 񝜫(.P* ҶB!@:$Y.3gV 0pEe*kʼSenUmG=g@x:ӣ}2}K{=Ά!C e_*fJ;<ܜmY h4\K;3ͬJ=F@?k}GlBXSx`yZ+XJdg_yfwa'br7H M"7!I7Q[=o8A䄇M_#<͋X x(՛st%h%xQ.WU-5"[!DPpx<#Lqyd5m,du Xȥ5&` M7Efz%cotƵ75J.eϼ9ji϶[q$e A_ uIxGT\6b pfǖToCx¤Ψ,$<U$2bɈȑ$zhb҃`]t= ʴAe8=_a'|\gnN̂*恉8 ;z/JHLJx,ŀb;f >Q|(=jT;gT:(l1`Kەfpf h#%/ۚ[2r5Eə1I.]./K"G2=PI9l^Mft-p]îI}q`tALwvRrq׃>Ao\nFerYiƞT^ H&]jT^m֥{Kʥr1Џ#{~Ery O(˂Β=i8RBy .G(o[$2, cx^AE ?phHSg#KJ,_3G,~ Z$o; X٩XrG_Eᖥd'@-/ljEj}x1&`> RL8V fu;linG̜\&hBEZ0ni%HEV/*ޣLWf{ >V '"3_ ؼ%? } 35y#on5w?jcœLyf~ _0>V`ú^h^ |ΡZD7FJ:Z#n ۔ i~g頔|?#ld Kk##?# I;ml> #~W#樺5?$:?C*>HpPtM\ >-F_ [2w /Q-L;e[)1 Ƅng`=Aq5S M0J m8 y-l8WSӻJF^EQ)dU&M܎V+iQ!&Oa\5VÆzkXPf2ָ6ƊFXIP sL;qLM1t  Gy%% As8 ԑ0M2&,+脫L&s[MASeୂ&(sTm5ez0M@/4aڇ_ZCȆB96qG` 9A`il3 mˠǢwdt s$b VzYjcE |a)oXQwO87VT+|'~cuh3VkY$[ IZN9z& :<`hr˥ڢb~p=a+ъb0}n@jn@P37얩?7R SP^|7'Fmxame"\-/2yY`$>z<0b'/~Աp T܇zptWVtl~jKBL~i)eY>&OL{пG^?"KnxV|A6HE_(x RQ k=RQ;P"A=:Jh7Z4-VMu'͛xKٕBa_=Q;;+S,FtGe/o-5ΑPq7-52 6u#zypGƨd+Dv[:C9\2vlP}?QCTOO~-VaZS@3ϓv!Yd/ z'lj.ǮXyJsшVim=G?KEv]p@]t'p]ߵ|53Õ-5ěȷڷ + .Z# cNJRXpB:xuSuz!f[!* Qy 'Թzũ:+x#"bc10悙P"nX%jqSS@R>ģbSRwx踇x${ˋszH|YIP(ww0O&y1M Ob\ɛ|'Wi'UESOicBefFX``s.#y2p̉ a]Ptl*}VF i!OIˬZ%/B Ν1_bOyV#o7kuv > ͊PGY|T /Opʿ,QGlY7=r12s"zԉ$}A*96 Vo !I? 0?w}X `9| hA9b0}26{k]sʘ_j9k\oU2RlSz]~VN+'N*kdM3=/tRVʳ|%øS=\RR _:̽Ǹڷe fJ`QPɦzyWu%8Y6PwD*< 衚 ԃ4M[% tEѵ{^Jxt[uWTc@Y6E6uwo\oBxXwk;̼'jb>M|o/汲Eo7 ) ;kпnppjgS8WA@q cel \C8ʘ ਕȜ`oUԏn[jFjN 2A?+ y;?OmN`h&6䄜TTX;P"s`oU&N*RMYple paTT.-A룺35BߎmQ; anW5CecO)+UͰY4ÉAภJ|fk > 2|JبkJE-epg33};.*;:P{'$f',KrImXw hlTukCts>yF~ x X~0+a?~(U_R^ :!~j`CۼR0jz~֍Eө+B>Cs]ff͜?黺٪ #"mY ~Pq޳o=?t6jUֹ69{{ @ӓ&:eWQ3#g)_ CtV5S]m^sU5;h)sDЙWUzQzl8ALv Pm J 0ڻB v4a |!G{W-A'>m=%lGx~/S`hN:sZDyԨ"%l'zo<NC{@ubj`WؼRpjxZu+ςgcuͼ?A?gAFӪ:;Re`u?`)b(Q ;EP")2I[XhU"5nْ[-Nĩvl'v\Ҝ|naggw gygzdeR/^ &GɄ)T []/^eyQ]_$HR ie*G5V zi3O+g6 9.-ՒwJӄLǵ͑i1u ]ʖMG it:En\-ǑDIjJGqp~DWܴRX БXQZFnVGjT|;F֎6)um1Z8j1s˜aُ۴88f|1Dj9^룚3j~pLZ˫U#yI*x)ЇQeNx U2 s*K4sKP՗Z^ʥUYZTew[+E.W@"z: nѸ.[K<WO\(X**a:3MH:"VjU|?e;B uDC(D~' kҊdJh(BQ+tTgxPΙ1SomyEݦ hSҋE&Ƕuh8dQ_u,8KN_xf%xYF 7?U{?Hn&J Ms4ToF`61f3`D&-+;O'; .ū2[\.-FR5*weܛ=< M˳DɘGeGWF#hVS4pye]i99"V6uZِ*B9.Ώ'!&*"JP%BPukmVʟ!TowMG~!?03ay'\&T=d>,~XFè|UCF^*`+!:`~5粕R5>$UeZ'>-j5Q|{fpc`DeuPƢ|޲7b"Crνn|& f~˄% hWQe?jU KhMjfXu\[M;7q9)Q13NѽAVViĤE VٛpȤpNq0b?H6c2yX5WBPCa ЗL@ MfigkiM`5"'V&$jT^*J5lʆ͇qp~W6h6¦fæ:5l~Zy6"lqR?R&Ud?teˆNǯzIӋx tuʽ%lV7Xz1,ms9+գrIլa\0W G>"FK / s^ZBEyrw$VZ ~ ~=!C (>VeY Px k/ZRүna|%}AQwcԖC^XQ/,JD|5z[!+qM:)\ T SI"൐EoO4G06PNiMCKۃ w1(?I/O4DO\WE}8ڻ;Gۇ;UQvMM֘w)Vy5i3k9[ҵѨF'OҾ3y fpXP3\qݚScAԒP6 dKe>9l {*agt}LS}m65? j+gAZQ*E8W@˄ X]'?@ZS^ 7 (?@ovðq ope^1ǔDŘ!S)jshXq\_OQF:t͢b껆>m܉WkHkobxWD8^Fσx"$iQߚHz$"ixI[j^ϩ?A/ΣID{@TDT3e9֮q uy:bv8CO??%U}ė Mz_O~v6HP$NdVSDgFe8Hn)Q:$!M"֭'Iv̏)C<2 [O!@TF9t^& KZx0^- 5n-Q\Lc㐏GσӇx"agj! IKR>$xNA"|)pMڧ r(Pvc#^ϋ<éx)#LhЛe|Ӈu5-CR ^DhDRw0= 0=u+0CR]@˄ X]'?}HZS>$7 ፵A$hjDӺ͝{A~LIy?.\xFe4V0zJRYBT,jJ2V6Wk PMQJģ $oۣAKRDˊwB\K,a򓗤B%mM^zM@< 8&/SuR TXpZ1Eb<]LT_&4i2>KҺݖ%R@:VfgKb3y2 $uW7Bq9#۲%i LqohYΣK[}N^*ZZInk\-H|"иE%t4P0 ڸah3p̦̒Ulbخi8e@ulp\#S6wsZ`˲EIZ29AZȯM=_~0fh2-%u@~|o'dGohX߮ U.T%4*ٹq&5:g߾Gs,u u,p*)MglXl)`:nVÝ4+zʢ\#XG̢NգyMe&E2L(#x"X5XFc'<b5sl 9ܿY\Ϭs93$/d!?ֈ1ަ o%_ b@&6+4ԬФ[ yαe*Fͫ*EL|{W'Qסl+!='cks% %] h;6jUYm(Z3nM' h5e4kTYMJGY.䇀?2a %oIWOĕTjh4պbna+bikiN`u"GP mZUG~8fɗl/ S%l6˄#no!&*2ʮJ 3(iNpOk(Qŷ\b$Ӄs9=z"uil@QdB]m#~p TcR2" gƉ7[uJy,dP#{ Db,~jULI ?(> NES9~xR)웸[y_aZMC^di/,M|`/d^ȜJZ, >•퐥 ^Nw@Nj' 'iGPM FtC{:mh1(rעPk6PS|v6dF"o,5Rn MwA+lB2ģw˯[.Zôtrq?^MU|{Q1C`KfYs̱9jr`qmƭbA+e k#G ?J]8+R'!?9_bSdJh4>yV**:ު3JxʙXVou\frpjuM900͸-67ƽMZu #U_~RqZG /Fls!K5WW~Gyst:y˄v<|˄vȼ_ ~Jj54jx%!֜ bڼvP34JktǵET~mƽ COe@& q5T tptKR%BRuiHV ʡUÊotk. eh'PE\ 'T/Rr0i^Xdmk}Cc"밸^q {(Pc\hޑɏ[ryO3-S.ceBIP6M2dtk`v `mchF/U7e-2K5)}~Yuui^(ٿ~˄ ,"U\&X0{>p`lE>0 פȓ•ݐJ_"O@^ByRxq *ikd䑧GLt, _1Q -dzvTru\͟yJFt0縬Ͱm=Yb1J2/&lܸ>az[Uҧ[)U)r7~xSmbјak}jd ﻧto:аCD%j;F||s޲YWr1X危\-k#Sú̵pk\DU @4[ۡ{[u&'Am,gIW>V# '퀥v(ڬ>MY/BY`x*ba^1QH_E˄ X]'iL*/RWy5Ğ=% Lz/ЀlcQ(v| hB6Aة%RD@<i\g0hoٲKzQzZ:^9i z!Ԧ5H& SD/Σi {@TP3N8Uk8:Az^NPt3SRG|Ф/25Hj`JOkZILjdvuC&5p3&5HU!KMjLˇTz prr u+0R]@\;v8Vnv͒h%K'hækw v˽WA~`)ID!C2ħUB7$e4'[CC%t=ΐNTR_Ƨ/ūEm oCQ\DW_5 L$x"LdvckŰF (a3B%mDzM@U LeDYj=k#%z^䑒NHOIUeBW.㓟$mA+Toev $BwCi$[CmI$[)A-k+A-SuR ZJr8tG]jYyJZ1:\<-맃>˄ X]'?IZS$7 Tmd6;nDӺYLKXRIyY e'1hX&1гʲ"t-Z͂r;-c4FWkXM1JB_8`~U_aQIQ3 Ipw/߄O 6J5=DR˄ X]'?JSF%7 4jmkN4,{/b%!2O"KdGTFa-VTu:󵚴TUsjmQ_ŧx1Uբn7L]EEVagHIx"8)Ndt=XTj g.%҆{lĄdMII:8y`>ԔDxP >(CjO7]<n$/d8h\xdxJh4+DSKE_%BG_uo6y!&E2-jJwY̯5=Y\K6*kŜ5߿;as(LG3 13ʆFP/IҨ:Mq*FՋ'ydNYC12aGZׄV;ȟB.*.3(M43+LWI"\&Pj(n)2 V\f;36J5\&LG{7w hJoN|NԬO*Ys&%YXL(_\ yitgɅģ(-(7fgXG:Rw"E6(9=aK$%h/JtJ^閠(5>-A4E!ph/ ᅐl^RH 6r_EM7TK Cٗnڇr2Y]샟W^ vY]+E,+ 19P1`ݮʼn8^u)(B)NQ[8-Gە*RQ/|iEj?a'ȶU{ٖ6*^ŋ|(u3QWCb2)՟~x,住j~-5dhrc97y3*?39nߖYQ)#V՝[Ջײ6if5rȻZEw>:(1wE{OYh\ ?A*1|9ȟ?&~#䴃**3Q>5$=[:gUkf)ې>u'w 'w۳j /XDݰzL>eP3z3C$4L`䮰O$Dw ĻeGVFazƬ%B祕l5`^ZuZ cAH+ǫL:~Zs妵RE;m7lmB/VY#0oٶT?{\􎋩QwNVtc](SkΜΏ[Q拑952^D3Sqߥ75X77}c3GPhYE=̅\΄M\T'NrxJ54VC Wd*5I [(cDyJ+36v*,;f6wE{4m׈^פ1$#xZ\&|X >,C\MWBa?QJH,*6(ieSpԍOkuŷ֦AnŠ^.h ysܓ7rp~ q51W -1W 1WBV6j\W|Z̵nY;oMѺip~]ʖ[ȏ1D7wգ/hn(V!kW0Eӝ?%5zq̲MwԝLv %Kw`*eq9+u Yž3g11hӃ3nM:|8Mֆl&GWŨ"ULdu*em\.SΌ(BKjGkJP,φMHBDs>(FL862nFՈPkO+wū :G^j4O{x֬i_6D޿[*ρtCnW@Kkf(?I/O4>wBQ}i}{Sw;U2kzQٛ`;XkmM7IWWG+" .XG5ums452F6Ɏ2mu-z+0y!pz4K`5k\HU|ZNUNFbMvj-Bvjj#Z~7u˘hx/dl aazپf_ | T-#[omNeXIc:XBQ,k#S2{WzFwRwxx?*N ׃':EM{譎g z[K/3'9gn: n!7Lm#>~*HwQi_rp~/ Ŀ,C\MVBa>f:έ\? im8m,,Y6N!z"_/ ݃72[`wY]`;sUhY?er0 Mj˄B!BSCE~ 2fa+4fkvWyXŨyIŷhyL7,E#ZFp e { G0}P q5T 8zjc ּ imL86Pd?~ /2a]F_QGI(P>Y~?:{Rಶ'Sf%*ǀ@PIeJhp02n:ôƝ;4>-"Gxǂ:tӯiRޢYI3}"O@D:SiA?%~Q EjASnZW(-M> im\8v' "mRm|2g0z\E!$%˄ZTdeFu2+s920S2t&[E/WVx}xo˹߳!w<'μ_Y婝W˄ jO$Kya>SYVdkCdmm^eQ}GR!*V7yˮX8"UTl+o8N 1!q0bFCQ̈́-PN]ǶN"'ict3158GDto͸ #h^Ƚҵڧڒh 'i: ƥyhIHBE \ y2~uMBg؞Z %H@ H=^Y6QOz5ըz] y2۝EV-bv#.w)l~^A wC>ل~ȔvQmY6E#]6n1֐b?nd?jLYźi/n,ƶ˻ no)Uͧ_OE׬ .3TCyw7GzdW\rFj)LOLwdwkc5PK5txkx7d?(}-®VJ Q/A}HIm ҆?&)_c\&:qW_h_WA6j *J,0ƨyU]m.d.O%W˄# ćd Jh䍼*έC4>-BvCVҏ[|Yᣦ>R4zI\5@H%؞.(;> <jOOWj ,h hՙ m"Vju[>H.CGwm>\&a2O%4Z/7Yة,bg+O+of|Z[M5N*}f~J}^g~̄nVOVLcf2a~o|x SX~*;^eC\ ~ q%1[ l5lfi~Zyc96~l `Yv.9Vs ,m<wh~:@P ܌D.NnF"uC^tzRw [mAJ&eN//C__Z*,mL6RG*ngq'@"vۓ/~xR)p0¾ΌcԖC^di/,M|`/JZ, Bפ•퐥 ^Nw@^BvRxasItygXrt"u\~ɈcFxj7˚ۼpNNӜv([)[nBfdȇR |aH~@52ģ(؅-PkVQ;īIWYN+23"7@~C*!4ZF!{#C\MTBCZeBNufk my6"lqRme\ߊW0m֝vb .B:䯧@x0%A|?XF,s)c:ʪ3M\qOpOkHYŷgwcfɻ G/zr\ey`3u$'$0^\X22V װVZ# 1jm|9v+̵hd`. fy,T,d #)}c%Cs&2d Jh , ՙf͊@Z~"qieCrpF^P78]5D$\&WW>h18~2fC:up6*ظ&8lƧETʄT"AT¦w`ē(˄#|O >j§Nr22è: s- iQp8Okpi);G$!PJ2_A@Xʘn&8pƧETo6==nVN&jy1z4pEϺF[bUT@mJ%Ul=yv8SE4zZzHqݧhղk5.o],O_TN>EW>e˄"ҊK :pΠt1z^.gUԁ'쑺7eˆv+?νڳmU̷b F wܤ Ͱ<FM֡ϟ4=ɱ=eˆi ELQ::}zVJ&%EU!<ʊzw P5 3l n!_0H9֡ ul|4# Ǒ^{z>Z($ NS-QxcV8?MRJ>3 ֙Wt ͿJ/YքckPLVTY9t9R0'yQ9XE:[sly̪.#7_׭Li.OSKq8G 1r9*9n9|J *>.F ,4c~Zvs$$5GoiAch,CխXfF8K]r*ልZ;UaCꅄL$RE8 y)D+!Rw'ЁDb q&oJZ#[KfǔIP{?~ "[h7B>txkRϙ!*!~w6ފn* q+/d1˄γdE\&hnk2N?+s-ʹDs1˄) {䛎v.DxH >$CA^ y^C;2ģׇh(硌YPYw4ڤ>Tj]E.W@"d1% x-kK&&C\MTB# (8ƧEbԜ*lL0c^!QMzqmQ;={4ֽ5]Oio\RSz6 eˆz6^4՜_rO GRpg׳hγhW`fj"v6 ۃI;Y]9Vz4޿Y_Ԧ (P̖WB^)#k `6t+ЎOoO4^ ?1 *Uh)peGDϊ7 K[VzGcF!W)yAȃxZiUY4 ~ ~뀻 Rx0 P|&p7tp=yRxR)s0"P=&Am)p9ɗh2E|&2,K[ Y]kRIJR/L'eC^ByRxRQ5TڸC|`Ѫ&=@ȗHǤhCɰT}<{Z =@2ߤ*.]RX AB x&~ŇWo:l]oIȓɗV>)r27Y:TGSl1H$M~SW@+DC6 Lǵ0`mhaubA^'զDcxvWŠ>q-! $B^=ݝC.9Xgcx䋔EcRw:bG6|#;Nn"X;+2ȿQ1k)k__`=A;崚cVwYU7Osw*)ʞK)ҶMkaS@Hz@K2ģ/RF#h[kuZH5NKEZn vx6YPkX.}υ&_6sjg7TlHə3gsYxurf).F:_;0jfnz2s.F.JRkRY}X+D%*NƼc4YZy$f6D'c,m[:y"? 0]:aԆh[ٿymxXêрq>Yߪ ظgp(;r,sdB&6oF'_Lt _q.ɖG&qPAc1kyM~XSq8[8nVtJt$~YLBw$~˄(uQkqpw ̱5k`K؜:.{RN;in岇 k?bds9Z?5tUNT/gyMFt,?eOxG_ⲇ XCಇѬ1_ex8zH?q}Wt|G JV׿(cu,\? nhƧEN*}Ơ7ZS ѻ [נxLr UɦuQdҵ/k˸^q.&P.xV.FtYsiQ=_s|b1Cfڈۀ2$vQ-X5X/.XN9y :3g9ܿy z|geBBVZ//VRѰkt@#Tj؆~E'jt8-sFbڼ5oRH-|;mr q0"~~VC5~&t5P9oVe&ZJV,1B²F?gU?f%SM C#n'5L8 Yng\\E |9"uǀ ֓0c2,aW?3U/XxIs[/Zt҅WG[,2aFwQƤS>1eBm3:uSǩ;( Lū6`OR+bi^m4 ԬqkZOg_XlTU]qPoM{+5+rɁKNYB*q[˄ t2}~9^١c1v#n.*2Qy"6 $ 0䇀2aDC^RH7|> .JTaPGϸL"seG/QFŲW*c,s]iMp3>M&9œ~jKsi\&L1ص/eyM/_ C\I4UCC"2eFSfk4ǚ74Fͣ"'V&dT.Ke#]sp~ q5aS 8jc#4ּ im68ךc,QQqÄaOyݛyk\jyuvOd Z:6fIciyVWz_Jz77E6t]Qhfiİ!Z0 _,IKr {нUriEEevdrc6/^#d<#Y+yFOD+y١0`8y轅ѓtAhŶ*ep:j,_Mmwѵgwؒ^#bm9i1|/кXx!5wB~g*r~.' b>DO^+Ѱn_QC؅՚U>"V4ڤWۯ\0"z>oU.vڸ䍂f^+.%]NBQ"N+=m3NSg{jǧXArH+8f ӝuu]5U޷hJ[:-;MBf^L5ע uPN] )^AeG( RߊjwhޠCg G!*7R 'b6o9B|5m~V"<92+]՝:Z3D"`rN3Nxs}"lzf}Yo+iGpU,U2_1샶1V6dT3$c` #M-zw6&k6{Ft▓tXyZ:jQ{C}Q23L|wye|$-HS-Lh+sO`tRZkouIޥ7~S.;x-.,uuVcvX0+66sն ֡2MpbAȃ;4_# p7'BUf1a 1U t(q7sonK4FnLb&L-Fnx]ޥ7~K,.}n޲ma}4q'_h/~ >GT1Kx+bR% x#z񂼙+HP[\y27b=%B=*G͂7kYyS) gB?'y_N 'ygh^ ٫Jb(dQ8:ppSsىP}r?g؛|Q}oq1pibyp  7&Lqԯ0ywK/e)~]%qNM,,epN.82zwjRA@<;ש+Nn8cqN1Kx9ȹ`>}{3Ox{b$;.Lx䳔s( mJ¹|(y''ynD._s'Oa'p'u'OO}L 7o.~ӁCĖO|2W6™6 澻Zd-|8~/\nw'^O>bu ԖՏ1GPJ5?oX :8> }pj퐷'~xw'O+̖/x^Z~#\9'Ȅ) 6Xz1sj̄`1t˅c2y|FRv+vRf8itN' +rPm|`N%em'4*FB,C߇?%<A(Ja& n!=6!x76U7A>a|>Q"D4.VpY4š|-9JIxc+65q=Dcr ԸhhJP K Gws\| ys8_VAݐ%>!"u&d3o]sÏ&n;vN^/-8[,sg0 KwT e_N"X{qF"guTO+"{6EAZm^C5MEB.Hy9^TQ3rM|(G-,`%qp=fRrAfMU:ݵ4kkFck_>#aCr%B>#B"k!6l"I_F_' +Yh wqӆ^WcVEO4ur"x6YAŷu|auڎi;?nB$pk+rhE}F`ؽ{ Gz.j.gÆ`L.g]͚]t*m.n#3C\& sPQ==A5'|&C/.gӲ`ce 2]F-Մ[v)p c(ѳ4zV3\J]Jo>Ym]mJ.Ft٬znEx W;dՒ1z˄^ ˄j4{0e4{6˄t m?2j? {{LxJ6N.gw*ӫL2aV&[>kNtVwB.o-p0 'u\&T2a~"\&kv-H]{ݩ!v`K9(ufeBn:ľ  f].&?_~˄ hU1 pxۗsPQvQaZnm9 LW/2aD-wkb\ni?rT_ۯ2a5U jx-p3ۥϵ9\&LWWkm}:j`#m˄ʫ㖁.kr2= ?hsݎWw6 Jd8_eBžQCo2%Fo˄Q.K~krMx}]\nۣ'=Ts޽3m+jי6]9x!{fυy aCT UwY ϭcl.{DXb\P<<> r0/^ASG]\sF%حnrӚj~.{YWrG2X:.nrGU,9Yu^ }^O0#a:pC^Q'&g< K2/G"Vw_E$k [A~_$Sw ,A+~+ȿ%eZ%o|'4jyݭU&WʿΙȳƭaCI5GڊCr-9ӴRSޞB˄ Cx~+ȿ3_ WF`L+t tumiLpЍOkAŷ+lW]t? #SӖzӎv >3q\U+$ ,2޽>bL.#u2aD'sdB]`uecizb[]C+1w\fȟ˙h숟:mpY6.nkj1.gTވĦs9#ul854h]%i)x˄,ŚڃҖz\HsR˄-W?e6kz[ڄ9 0'_䲂w/˄y' 7j Ռ=CӦ]U'Qd;C!O>2^djO,i'Wk>:߾A*;oMv-ڧmt2 ̘+&-hS3nok;*A0ִٶT-tׯ#?mpO u Dvjc%"Kə^GE&HēR[ #G2KZ6&w,w*mL+Gdu#-RYeBE$Ls/1.sp˄MB_DD[,yMd K\&LHCgq09˒ .-S: :pN,r9&X2aDێyG1n thًS;Aն|JM).*2>Ϲ4\V02ucо׋MG3H 9\&Td#%웽x9/^ e\5 ķ2NղwGmw55tiSq0 r0qεqL k{LFLZ3ѠV;,s9[Nj #ZmJ+.DV*BNg?kw.f8YpY+-tm-&uL1x,5jB!P+r9+w6sP 訙gM)ޖ5]omن:3WI^y&,uwu}_HV~#n/v[X\ifhr Mgt ;aAHzfqWx!e4fiC )Xk̐ZjiL㙡x6RJx\ O11ц~ِy2//!2ՄL%4q`[X蘩*bf O+kf|Z[M5.:-ȋL^Y~9 2_ | ̗@jBCTTB,tTg9 O+kCf|Z[L5.:MaNMy;䷧5Oh[C;:?. q5S stX*~*a:~3M9"VjuZ2%۝>OA*"`iW!uDЯ Ŀ&C\MUBEJ؅L3ڬ?4>-"gfM EC/xJק& slu4㞪^f[ˣmVQri*UY#¹rbњ0ݣLjL5?ܬ}"JNiyXj^v->5O@(oKˋdev.L3N^\aIYCt~w.*rf˄$61˄l$؜| 0Qv,.F4њB8^{]d$}᳁LȊŎ[Ty7>8R[[v2aDnisV3zKiMG8bM҅deBEF)N>OMnǹb>-huuf?, S@E~W\&}W_!句F j6)J|fM`)F{L\T|{ t,UttNY9cZsE^g\&L^{ϹLBa_7|4A ^;-xnqfݣ*a~- zIvn ˄ ع}Y\n-0 # ܨ5Tz.QkLwԭn2ab_Uv!.g]D 0-< #2G1IM:}Jb]s sPݲXWq0  #Z3r\Jfضe;^}ܠp\z횎k杞ް[Q}.*;~jSkwΖWs̮2"XG>btp p /)q9+wv?+4>r`ݡhےt|2*[fӸU1֎-rV]߽-<ȶ<^"^.2keS՗}!.ie_].&'o2aD=6oE }.* 4-j {h}@'2a\&hȳ $LO_sP /eBjuVl=_;۟!q0rkQ~>˄L &qLYL0:ڷrPMѾ˄ m{/z.7L(4~Ҟs=%NeˆF j[̲zG-gr2&G2dқo1CHa*#W2{5k JRhc͙6JR. Fp^,4ǚ-PlQm;'V ֗uwcWڠ2~ \&Tg8oVfZHKKY%BYuVl6oj $դ0e_ML%D&ߤZ>od&hłEw' 鸀˄qa8+jh4tebacB;jS.ieV`Qk@ȍŷ.~3X lf#ædX eEXWVh<6>B)@ @YUmieKpOkP5ŷWhlt  5dHn1.pkte#m@΃"[MUB#X4RV БViZ KL/ )O: He: >-5G|LsjaǵE,'4: |9=W_!C\MXWBC|^:6kGjT|75'چ7;qö/7oIwe}XK=UfY8Ru\}<[* 3tkHlRln./PR,x͂{@jUq{1Xs@ te:wLn?(78\&Lv#q0riˊ/: fDV"3 S=2/OrPAiI~L! #qqJ6~˄lۆEh,e/˄I珀eˆJ¿= SD9b?eyYOd+鎨 5vG%*b͙HZwG9LἵhMjH:._ eB5QgyxF  PZ%uI$%0V{6ʍۆ8$@m)]{Yh7!?sZNSKHʢܱ! ˄ tZ.Fq-|\^(w@#-r~ ? S.&aO˄-roeBEzA?rr~ đ.!0 }j3\^$K=eiI>5k532 RCijk 봘gexJ.=p-d)"=b9С [6a rC < 9!7!8LZ+\}_Ï:SEK+8^ev]ʘCBh2&}c?٤+9ɲwؘak]&8 ՠLt_e@N`9o!G%ԦLX` zzؕ ~rAMͶFl,p .n/.2aD [ өzƲ*`듵N\<ڡ3 eߓ75B;X2aҭ?>SC5Ykf͢ԡ:zC\YAF>l!*=>}R?Hax߃&^/hKz+ /%Cw̼#f&u} %n*ȯRfDol':ezcKxd%o;f97sJ}m68&aw?S槠qV⼆VLjUugIz՛㲦JAcqw #,6ʝhJi$GOrT5Ū6 7p0\ eˆm]jTMٟw?«TI~81%Pp Vޙ'.I7N'|/3: g 5nOqP/OCOs0 D! #ߎ^>^Q1|?;gpwY,je˝t0Ʉ]u̹j O.;,q9+'YXrfZ\&jz1sq-[>Y hVefHˁr6zP:pY&2cǹj7eˆ&ypeDm³% ڨOq9@~Y2s02/r0 |%.F4"Ǡ- $\&TfUo2aD,ѵȋ˄J~&ld\&Ljr0{܆YO͗fȧRg6Z\\Q2)%&p0?k/2a~~2aD?;[؃/>b/qs]`k&S6 %WrԞ|)).Fm`֊C*e~gLgd,?2a\nj|Z(~n5d_˄ˁ!~W.&aeˆ:>#֝'Љ/9veˆBO9q Li,>_1^lHæ͏[Q[IX+(+!(Û۵#c_FH]8y* ?<ӹu ~~% x$]saT:ԡ?M@<s,$fGtVvo5;W_`3!KɉkKRoŶh9gc$5za7@9A26( E6du+澾\[l4#[Ð.jujYjNri [I]QEì CEm^R0ZJ+9C@<sfw16֣iY}W?^-tGۛӺ6mZK+ʏ붞w MM5]Qȇ;ia:R4#䴐+x V0l7-'l ^S@~vIp2s/ͲkI/bu]u|^|W(4LjU,} _gv7n*4> Ql2V 7n͚kׇe;_,uRh@ǀfH 'i_vJw%^v6-z9VDŽ3_•WJ{2=>҃@3"T+]gaOӣݖcj1c]n`͕M"y5BAG_V)Eklj͛AY3B^֋S4~ [+{Vx7o+LYbr޲If~*?Mf~0 {cdRhݐ .?Qf̠_ +ݸ!u?rבk7XfZ3XF[64] 6i3npM60)lkJŇ ,ݏC:h {#1ȏ)լc͆5l*DlݰXw$ϻ9'u!+ +}mN>O4[j*c 0AVmG·z#Q*eo(+82a=p ;,B.P >TwuB,  ];nTљ卪}Gef}ت*!u/~CIqkPMU:s(Ѣn0V&@+OvH 5wa.4>r3O)Rt ;W) MJ!Ud`ڰJ :)≻J!uB~*e[T֔l*:d`0dBT_ (dgT)AX\@ aA_-mSC;Z&D;ShgA^?"rva;~dQ E kBE R7Wm?Ak-R@ZnX~\| ȿPf֮[i`;*.b3s0j/2a5?I7x T\Vqlk{ۜomj`iI-+|08lgf'|m\yUYJzʪ̎M$1ȏ_{C~<:6oSXKy^RfHہ>u ƭXۻfpPH= ds٦a40w$7f Y!w,d]D?%__OWWI?qPM]R]D}&SHN:`XGQFQ*EtgD~y(ІV0GG : .dFcv~\;8Uf([FN_ 9 |4cX[!mKlm{#6Uk ZuX(Z68IO*̥ W nW7)7 K aDē4rKPMucn!VdumW]]4x=t _o?}[{HPV<.;{u¯t$/R7 |䗥PŐBVxd`ak &*ԽZR F {{KY]ʠa6VچMLM!kP{wmC:dJ.Z'O4jjXm#fg[m3ʆ͢t,_:9FnL RYƻ*2A |"t8KP*#]@C|-.|C_|=׫xKy ȏ_7,եQaځMkׄ_Fd>)eiSC]ٴvư܈T?\C3HOF@7u T8/iPfY;[i/ҡrqA옮9aSZm׎ea6-ۜ4|%_)&J^|K|+䷦PꪟCkAc Ww,7%]'vTy IȟCE7nڸvcnmY  WCSAY\@Dfk'ܑt.XU6)o+Vhl!bm.TaAEQ=1ԹNkst5ݡn$>4L }TrVB .,2k9.&fi(ӟ[ݣ+#Ct{iutAZצ`n%a sl+ 6QME9^.qGt*P'b?da' `B;a,i|Tm;a9ő9>v1vBh[֥@Wa|r@#OX1BG9#AK1Po B>cɩq>rH, Ri~ Zv-@"e#lwF$mҞyIRը,Djw#5SiTf abXuoZE~ f' n^._.X G\fy,tNC<"HMtěec|ԋ;p$/JKcR+lofNC͹TKx73yj{3Lt赣X(QKcؖFL/| :֒ZX4?Rj`n2gYJYS عN/C=l +RȵsdB\%T7p00IBSCCϊ^%I"d4[Jz*1F5֭Yֳu:I+٫]ػG7qA둞#g]̕ƻpP7CZ{z9σةDu4B>Tt!H8$J]wiz1|TXԋjQw (1*UbyD͡o֕N%H6c[tD4VЁ[vwZ )#T7#z/KSvZt|TqOU/FͬAB~8?2+)`f۝;ϡe.a+A,{9x\ԲCZPuyc]>|WBȄ6Vz2Uu`xh{$LܺhȺf3 En:q\ͨCFwzs=¬Ҡ$J!)ץ`*v^-ӍAјNG}F5鷴NNԞ5tz(}H>D`…Q3{`&P`,F3))St ePgp9'ϫ$`0([0!}&(c@?Я<kE*0 (M@8P ]t9D` "$ Y"Hrb ւ?}e>AVD źfVqsXm,:$DGi45Y4Y/<`Ier,ctExX{LnJK("eʁoA6!f#RtM;Y5ˎ'+"Ewjӱf(NhbEŦs=aS#=rj?H"8d נyH^vUI'QxP-E+Ҝqk?FY]Z;7ބ~9#\}znKFg=j2GZT5|+UG<[C'Փ91U~\3ǵ;5H᳑gGN~ۚ,3;9]tdH8lE#QIVE]-x&Ư=T7":lJ#cqジWBu3ΗM 72bԕPS ! b0TtELrxUtʴfzzq'(&1uU7 ?nPhaQ;|V۴4ö-֢37˛|: պ|1B݈@DN>tEvڸ2y'VJ :fZL-7~ =>L2j%N%uT4L|=t:pgB)d꺕q 9ԡ=e9݌ݬ^2~7Fj ǐB, "UM⍗S Jn_L8&ǣF:@ ^j':6s/^I0svЙЋf.2FM]ǜ'qsL !!ۑ)d}q mKnla&oMßp#IQ[}ghR/)y<^Ϟ%RbVqLXv2"ۉԒ#]B9]Z޹%9d9%PY{Ip$Z$A0!KzʁǗ!ǵsxrNmmk䃠`rxR5: XOPyHt_dҗ6:ACky< /KS0UJq!"TF ǯCBu.Uv6^ڄ3f `FZ #2i %Byk(s,z4דAO^zO&.oWuH'tIDŞ9ր xz7SS:!JH+!n HcL4HJ!k^#؜i}JvllW⍳ҽ^ ;ӏXH7hi +XrO"~ZGAZGiZW8 @EΎU^fLZ hZ-G' :"|3MH a!}'E*ys*,`e/wΞZ -f< [}bFO |A\2*΅G֎yi`M-!ioeBVH3`{Jښ8Ҥu0eV0!Lvr6.|EFuLmrȏ+͏t'ށ4Fka~9U{w&^w{uxg{f|c}HNj- \&TVS]МQV$oRfG.f}*{A2Fd>>qe% ]ҕ?r\~3Ssu[`LL[w`j  ݤoXGX[hWzcL];%r$:T]\}nG^~nb-vn/vYhg9o,`=3/3%]tߞw}~t_d{ҙo a閟NjEG_ ӦOn?N&xj3GG"O*g1p d|iu^4F5pmkxkR G=NfͅJ;,ю/nVfn^3!UHJ(XwK<7G;hQhlC S\-6fBgͤD/Dþ}1W6jkt--o <_“ II9-${z }v˰9zb-O>hw؆S-ΐ]q\}r98 (Otux}VUuix~\wݳsu+澾|;9aʆWX?vMscyJ_hXdZ}`zqR]+ih=r}e6}oz6+qO>\GTw7sp~ {iol$~PZ5ڰ+y|gkxP90-,ƙFDU"GmO.XVTbwyP[C,sޭ4 </FJ1 1c|udnEw9fg/*5xi; A%rnjп=m"?襊VPŠ=Z m7@Ay3 ۨFjo?r~fC/9 |g !HǙm^>d9~Ox3d5lЧ  .櫭g I:ްe8ܕ\&^Ƚih"AS8QuX+˴իx, ( Qp}T:` (ŷ Id9LB( *[}h`YSV1lW7ƫT1`(Uv!'ɤ~@@l"xC+;fC SRRSmfsfV{.sl,N2Y xdC|`!Oq<@d?W3:4!)ĥt!  IȓWx +R?% +ad$ 1tRц5 -jiB9 PV81(ySVOt-v {Mk|wq=CjOEFdZHoj" IFd+IʆQphxeМ7GM ZK!4u_e$_cŝj|PY "VG,oY/j]tX ,ڔ%6ssS$O/i&kKWKU*.B|">xx`^ !T!.MwB~g }.!;u=( $_'XIk%3 MVxNfZKQ )jc̜09*u}J&6>Glώφ>sw|Rxq\&΅s^t{-N˞RKxzzn!#x!ӓ)&_`鐙|=fvP/Qb':J6Ţ6>UtWgS;?t#Ҽ xT%\]tJ%ὐMhIhp~EclVϗ,#3OGz1mF7PkF?)iP&ǩeFӠֲi7[c!g26;&oRVq/gX}w,IݛOB~2riZ1-u'6O?StZm/%cO_D6҂B2,d6G, o%c ۑrvNۡiS D J7u'D ! ±16xf$-.LYGI+FQ10u6r]V2%L."pܞ0tPz4.Z?"(HII-Fl*$k&k h&E(WCZ7\&yKnDē48>͗@%J9^JP[^\0' иvu4B7[GهjK0z4&bgmDwؿݛl\(z%2L7!SY %.~wot~"Ř  uBiL@4O4.>]ZPNufN ,^;bpe O~x cjn}_ĭ%-Fox̜{Aj!zbTٻ*+4 1g5 #|5W+ @ ;`y#-C= |#O64ǔdQYJRFyIRS8)OE6$Qx?Ð?.11qg &?.w5kת],1#~ V}c.V'Pq9%ߚ oM\K&8O3!?SYb"ʪQ -ޘ_|C࣐?DWXuyPf(k? YJ o?s0Oƥ~ ג1˟͢dQGu ɷ HOē|`5qk,IW@^!9qoXhLbd-VU*63it]}Bic%-l(xfl9qV)5;ҳ ˊftk+c$=JȯTVf ;ϪZnG 6l" 'E:,74>-acX@-^ Yj,gCᧄ;wRJ@{_g nKۢu4xmF,Ƙ1Xr4/K샕N'My~wQpЩ߅ԮNON e8 RB@<-<Y sN LYg{ৄB>gI}x~p, t/kHBgA/|G$\u\^2FmDmzU]O3긆bc!n8ΨY Kߔ)ͩy@~(mdT˖ V]zXDUt5բNy:MO˄I~QM~8ONNϢkԵ@Jo|QmQVc̒goФn/I=x?N-bO5=D+}XӝFhSѨ[-%î^kP۪FG2P誄F3oh7TU-tUgV;16>-bGVv@#Tg?)OgC~sތJ$~wA&  @<\q}K)[=K5@Aj9%4R՜J9uhY9{Z\ŧE5-ŷ{VUCiZfC|{7n:T#Ie?g!VYZJ:AO_djkynwk#f*thk}cr6rn-~ -&cpF2aD=GYo4Y}3lQ{dE{e.^e9x #k3. ).u}#fYe'2ohrPf%@˄IXrX2aDK|!3u-V([]De(x1bhO[u-a`wco_.KF˄IE\&]^?ޥ]c&}\&6Fn WEL!wp9ȹTz>5'[[eG+x2^j:sq'=^M:T|5+kOqy[E[]Z 1-/BeM- a u/k"v)"CIG ?>~˼.J2 ݑ-Onj;NkzhdN! QfeEd fIw nOYU 2F6 9 o!VUCxE|3od"KK=kjoMfAg iaq4~4Ѽ^u"A<}h~3Ft{̿9B {5Sy#1.&И< |˄4͠ϫ2aJU3x0u˵G@jdq9zF26_᭦ F{64K5 PgVMe$ljViZR2`p >-j 6"o7e4Oul =cG<ѭ;*ZX@<sMӶES| DxsU :Y3l[\HݹNȝʹ%;=3QjY)*GZŢ5I?Q*,氎FW|W3G IdD]ګQ ZKģ웾qӠbxwܖc:9 gn‚a5Jj;[ oI>5~wp~ ZKTsKu[Ȅ!OީI$ש7DzNw%hLЩ#_S_G15|mNhNZ6fI[\y2>\ۣEU3_o'_ %ܝ+ēonՏ-nl g(s Btt82xPh֓s` ངWA?'$ʄvX~;w{,n\Xގn5~&I{7V@<{xX{w%e)sU] t{iRMh"z&p 51ZkwiRN@<ɻupbuv$-tehP\&Xв5\`?zK)W~&$ %:9_ ygN~p];9- |'{gN~&ԖΈÉ( EKi9t˘>'"+!}2w8)XkFgS9xIFZ,P۫* 1ʚov x;ۓog '6.<y%8duzK+!4 g DL>="Nss O Rxr_dw^u9##c~3 JFmCΆx޷ޘSF#}A؅jҩ5M3?%/(n5npƫIS]!fö#Eφ,Ւ ׎ƓcQ;8&ݎ$w'vn^o)t_X @HއIx^룚%8QhtZ(]Z,XJQCr=^Hg_Y8YA ۉ&P[eԭn,5?<,j9O%="r Pa/4{5Hx$]+*ٳH@<{vM bre[ug+ _Y&u Kɛ1%'݃Wh_ ʸ5,DxAi_B|gX b""w !}TA uװ(j(A=Z%LiOWk~:^| a"{!ߛN씺ۃxKK_ ~ q5S uw{(:vGn3%8vƧETۭ^;X 4]--_PV.p'cTG/t4}ߏlTw-~1*MkeyQ=f ėWR=kRQ=ZĚ)cZWR|{V0GG {fbԶJZ _Awx˙лC kke Jh(W:pGX3%8pƧETۣta-8,osMZb>*Y׻L7eΈ.ܝʎ+Ý4:!??2LӊG8J:{Ҁ3Sp|Z[a5n9> *OγS?2TږJ#:{R3S#d|Z[DH5n);2z8գY݄BVAJ9Πdl;_pPmӁ˄ͷz3=˄󩏐}&R.΋0)!TCCiA 5B{G5Sk6gޖj35[Aq;d2 į!&r*Rȩqb͔S[o[X7@]0FgVw{D܏D9.fCօ}`@~5Ep9rw.RwJяԽM,*uq, MZ3.s}~8+UX̵j5b㡋%*!??"磒"i~Z!;ooxƈN氿M/z}y6t@t[c74}QҒ;Ux 1Q2|odgCGO ̕]Aϋ/90u=57I_lWˤʴo?7?HHȑ Yݷ)4a}!q $M5TSZ~e@5 9朶umWkl^4!%U>X峭L-[w-{(s@g=tyJhA;XʆUEn"/!u!8}\Z :O {)U_Yz{׭*62t5g6lذÆ7oشv@jؾ%_!u_$I_ 'iwpPM5CaGweYm_Gӈ@/% hVG1#tFbwc.1AkԝA>B OPp0kKy_BTcQ^2ۻvT!z1!)3*l;85sf Q}?B^ $O&Iģ(Kg 6S: m 8PHtӣҡq%J_m0 a;dCTf,FlmI\0|#<9 - Px.d5jǐ3!͌ozޅƘn2:8yP,QI_ d|ep7dk Wju_aFmEݍ1!6Kf1:ebU Yj>XO&1&ķ<5%6ny@~riuĞd2)OEKosn{}i]m `|MGf8~?>8FIJO&ߐ;O O2BȞtupg'5"8feBEyx1 ھmvH}VhJ'p]Ξ≘-;VZ"dhiem<aS* 6S2#rJU]mKf8.w p?S2{ ="LGpU)tn"?VGkϺ޼^vUʺUtobmIG2o|S$]7\ܹSL$rm=tD#Q9":QQA[Uǵm^'˻ ]*؆V7hL\oYe\EP@‹=:=]==E< 'Y1‹!_]^8ZZFn!{'-ͻ"'rMhy)fl*a1ޕ<3ɦmP k G?JG PV@P][5>Ę_V+=Zѝ,XtK{@p5NpQ h+%>p;=L8XMoZQ;qߒsiﮘq"Wj"VHDLbGs=M"E*vBT9q!zq.d@UGo?eDI%T/ŗ\Qh^BeLJrQ)NTT ՞6LѣRl8WC6. mXjqEZ-CGIn@mr\T@݋dɸ#}b} |J+ ~/չ&3ff}[`LL[w`j  ݤoXׇ}%GE??[8l_ijZõrtRB,]<_-o9Lvf^.U~v ֳq11цɺ{S-t{΁ OB/^3\oas?]qbV3dzW3lNmܰo9su {pɍQjfgQnwﺻg}Mh;_(8hNع+%(qǏǮ]g8XXo;Z-٧;nfu(b=omx٣Mۭ^J+;u/W3 CX/U;SƬ6ԙZsܺ֓Wht& FW34;虖=>y2QrہynLuEK/ BFuA`_a/VR퍘!&XkYJ6朾E2_гY71SvPLJ#"jMZ(n eu@i;82oGwD.bDl\ފh#&- [ӣ#I.I.BB8[617jDJD) xz챉[JFُE};Mpç4)H/qkl )Vh׶&~zlCBot0鬿ЩZ_aצ갦TQB¿htNoD-\~%l+d!I[\y F{tkؚR,o!^Y{"NG:Jh~ܦD|!JfM3\ }f ˁC~XYY4;f$u}yF?Y,HGYyh`r[6qE}'.dL?q! ~ⲚY &.# <PRB x>%.$Amb$hM*qѫrO)$.Iy,y}#~uc㊙(냠R̅u?e\(g. f.E̅,93?K = x>e.A2mb$hM*sѫ2rO)d.Iy,y2mrwѫ8Bu3rg0!xB`RM\HN๗T?K &;3J\@M6EbK\)>$K\I\ym!reMqȅu3r!f6r1w\9 \ Zi-lSnynڸ=s' }.m-yKMK[:]@-feMIY_$KtߢJc%0K`sUmN9 vmLԉQQ7Kaޗ&kSARzlSwjЉ̌}) pP}) p}7Q@{ zM-$b { ,z lYXTnb([ZXd;kak$F|ZZjU;30鵰-v%m~(:[:x %`ރgcޱ::jUCuu0-%m(e˒t 6}Y:]LgfĦ&Qum'`ӗk¥Ye3 ۷t^^}okabȎiaaiU-Mèê:Xoè/O;:Տ@d7Ͷp?0镌5aߵᝠL/͝- J&!is`1ge<wYCwbL@]8>ɅZS~,0BmT>4 ̺-Y 'WV$, X5A3i 'DI7ª7&kY ޘ?xN ̼yG0ɗua!cx*IF>8݀`uO 67%3'yde~UѵFGmN mٛǠ7yk&[6A@-{3ysZfXD,{#6L?y{ &==AQҷg6l$jϋ|PUght5pN,ڀn-}&DIߢ_E;}%0yo e]oK-B_ &0BA3]DU6~'K3J>!:i; gYo2:cc}q',Ys~ yf?$`f:ط$kt0d@S7|13)qZɖ[srLx7i&CoWJԴdnɸn;f,aڳݑ: ٧f`n\2lX,"³簯FE'E˺ ~Kns\@BnCQ@jՉ"TRh@}vpk@_\Վ'v@8|b7zF-'v=Aۭ:qVз&]6J49bQr[; W'0E1D\H#vo 8b73q:>JUS#9nc Z)Ƌq6Qҏqpw 1MAN`OqDX]8Gt=&7%~:rsĮx qx;h=rqu>~#w~sw 188RANશFan,D<pa7-^XFͷJFuӆg OwGmG(&^9O$z;!="w&FGi9GULn8~~9ŧKZ]͏K$?+zB1Zx]lҡ]b qB^9ŧqǬ:'uЮso/4+[Oߑ|u /y%, JnO!&8HgV#;J2uW{! ku['lSe bQjC&;x-D:}x?c~ۣXƸ#4-A׌Wy}M8h@>kԬUtkO'sXE?HG_~ bqt 커Z(Y #aё픘v8.,/܊vcn# 3Uk8MvsyN o=d3 9=r#!a JƵܮCL.XܸWxq[@tM]wԇAI\#75ec_,2z5ft$Z,:jԜz3cգ[$Z*cd:jdh ?C] "菥Phz~&Wo]#DQtw%f,e!| .4V"odzbح^b fύ[bJKMK1o⺲q1MF3߃x.Bs?&/G3$Asu[djX*ѫ$2d-/vϰVL|JHIt*>oM̷R%\. b%vvn!O-L$ȕ.]ڬ&blq()dtqD}(GB}- >Q4e8~` qC^#}7_C\WWegϣ8$Asu!93haS^$ky9 nϊO)5U<󟱾O!q] \ߖBb{9$ȕ Lw!qBb- P_ <␸Ax&Ա,R҉>&P'gyZ .għ*af mi/!}mU0}m,ּJKJ ^` qv` q.!.!D9?#mBfAsu!93K԰tOI%Y:AK&Y3)#JX =[.! {!ΠRF}Bbwxo[8M.#+M ~R8Zm K]B% Ø<ss q9zz{A‹@_]Nm1v=*x)hiŦCl^tƌ f}Z$A}M:0ygՖa*X>Dat zg::+NFQecԳYNѦkU෕:ʈS'R,ƨY.M\5.RlsnU;4&P+Iw_{c+}NdԒ$HG'&ߌn~';O~{|sxux$' /τwp%X&|YY 7VHdb;ByH+WZV~zb@c~rW[>cpWki|[=h ^N>"ȩE.{&tէ(0)>p{jܓ@p9W}wV1aa"F).jspac1I' []ÔĿt@;!?lLԀ'ч =>ӠC~ؘy)e_>ND\Uiؘdx9U_O'$g@?N^ |u0ZrȻas=qڙ? Y3_~٧_ڗ_ofF=}mP!I۠BǠ8Æ;"?/B|=KG)>VʱFK]GkN1]Z`j_gU)ќdeu%30}+?p4&/X_,%n4a J>u%[+njx,kEФ[韩^MSzMfLWÿ'c` [_tN_uX)U 0tN5Ujsh r46ܩoӄihiL4g?4>9~ӹtwt.~E4 *[&6h+F+P EOjcЯU*7J [ ô6 ցitrQ^'463)l_|ە+}jNƴ΃ e_FeFX.)–؏bhaNghZz kv0]gK k\|*6ܦ:a.&~P+M37Fb ݞ6%kԬ1+NKXϩgXp(l'Y^|)&Un2J3`W71az6l=ubS?O*z"𫠿? Kz WFx o䱑f٪m֚bmӒ7X%0Gizs4T9`ۀG9M94aLsPZK" zA\hFM\ݶ>iBM] Uj?v_|ӄ1kt͖pLGcK4Be֧giB]ɯt(Hk&EH ,Zi´op}Q D6[7|&MgL}}^K(d˙̅P\Y&yn}(ydAX5(jsLKB-g,a Z|cp {3ICiECXSfJ##Vٝ4rUgbkrͷct=o2q0Fp!U'Ab. bXW}TkĬ+ÂG)¤IJx#tExh02JronUV~z"M$5רX[oS6smI>o MRJ&>)7QrOYu`O] yFM Lj%@+usbv~hI3Â*rZh۷NjZd`l'S|jwJ]c{r\z0abk=A+-lQef-wA\`[ط /.+ \ JZ9Bq{ F~`tR."W5Y?n5wQ5'1`Ha8h}K7<[X r6]d<fM p Ƅ;=[/4tվm5m^W' RC <xP@n!TocÐaXE؇;B=V{nD#4t7@#Xa #O$`"A >[ÏρM/سgOQ߅M.W O!š󱉪Bzgh&d03vu"D+juuUWUȫ?=(V o}cpѬ P $tQw?B~ o`i |!Ï0 j ca,nphvptAA)b75Hv^̌ޮJdfUWiSʲ5[`CAN_'6E<~٫G{ ݦb*z ?^66dM\~}AwgbrjR߱].188}`tkGF1C[V%hs7sNEN XkA5 (QxNXđ^,\l\:lj;E&)u$ %/}nDV,_ " 4~s6QkyGLcKAڤ5-&QS2sM:mڟeՠ*)%f65REhRJ z vbk^É8#aAREPa>J ̓~+qšJ@r?x!MGg4saK;%n1L( {h+qk=䭕+9f ys{'nmჇi0f3uWFdz9U7]woKN1d {>ZaI09uӶ>XSEzZ̞޸?V@^?m=њ.d#O0TY6GJ _IBov_,P:KFJ[:{mt\xٗĄ \z15%M-x|\;xn~\qV6/1kEaixK , VY'\'B֬I'{f1;Λ3AÞA.*4rVC]FVmTxK/re!f)^ |=k#Kkn,> |7vMR1MvQ1}*jS\m~ 4m͂czlk<Ϊ6aT[ƺ҂mo@MM2DI \},vV a6cgd7kr!2"(H TTS#ClJ]{ln]ɗ$A*r׭MKmb,xɗdkε^3#dT;-N5nYɗrK}#~{u4!;lڎz%SFhݲ(H>q` H@BL0qM\HN๗zM)q!ywrgh#ElR^$S|J!qIZ]dΓۭW\DYBe.Į)tBDI?spL0s)f. f̅YY\M)sgvrgh#ElR^$S|J!sIZ]3dΓhcKٝ5" =pȅyH̆\.j aKI6q!y:^BR,%.>SB(q&F6٤I.q/B⒴'.r'q9M\xcE5!bpȅ ِBL.sY Ȧ.$P'p%hMav8s' 23Q@\ Vo}[~1_DIamQ֔Z%K! Kb%0K`sUmN9 vmLԉQQ7Kaޗ&kSARzlSoy˥R4R4>7nb([:AIĸ6n1|K[XjU3550-f%m&QҷZw ׶If[wU]F kakagUL줦:ؕyo`6o&.<V} WIFաŰ%}.kNҾ+[( sSgFlkUvi 6}Y}ll]z[:~MOľo1d40ժ&gaaUZ,KAQ7aԗ'jt?-4TM;Up7~sNC" JNs5DfY*) U]4Kei; j85uS\[]jLCuhq>O#oVA x+[rĮxh(ܝBLr|U"G"^ s$ƑL7VJbZ[8bwphЪ)Ƒ7o}K1uoZ8b(Ǹk;`Ӧ ['0~'8G"^ ,.#qdx蛒snp?h˸[9b<@q8Ҏ|8G:GAM?;DI?;&@ Y'PM0rLy%v<-n!YsN~[& %>o+;&b>h:4D+kU JML`,rO_pu5=џr}M}4]t41,8nXX>b3.s+8Svkjˢ[CI9im0x9sJ?4† Иl闙O:by?jEZT`Y>srP mġс˹-Dpe> 9M('?=1pÕNW&MApSEzvަx61ICԜkCCh؛ZLKcϪR],y.gž1d*5ٔToM"_>ˌLŚ WK}8*h+t%[fu=MXpO[÷Xe3,kxŲ-8nGlC}gR5_u4&̐/RV3_`IGO8G5UeXcyp iHVvL}Wszz ZZd' y~^E 61@lR-^D-i{ Q@S $m|\iyEgMo6X՜&)v^Z.S%/Qvcq3!c(1hOR~(phq>D{p_ \ : T*BQbQRXS,=>N3)Kr""ॠ/Ւu`f[eD×S5kTĞOY_5ֵ VEzcٴz z]=K~&Z[ KeTz[Td-oehy[_\4y n v&>|$W d?c}QRL^׃V˙Est*q9*WZWD(G.w-t *bŖ3\NK KT.i4dr;Rj>R󛱾/4JKp\nP:@ZA+moD9?r#͂7R.[r9-5,kR\r%K~L|JHHo*FI1yX{U'Yo>h`~?AGPx4FJpL書nl{Erg$Eh]#}|k3 [[ Ke>zDΰ68ϊO)5U`JM@] RBx=hn̓PoZí*%Ep ? Pi;oր7 bk@șYB}zM*N$ \2 ςO)5UyX_ŧԷDnESBPʨ}O:QའF ([,!3\CPBܴCL!q]ָx:8x.BsC_<␸kՅ8Z̤OzM$lp9?+v&>|$W 6*>8u-p}[f qj^S WR[C63\C0݅8j` q}(GB}-&P'gyZ .għ*af mi/!}@΢ y!NI) Lq!p!0݅8u0Å8(GB}xYC,}."gf Nt5:9ӒP'hp$? v&>|$W 7c}Bz 0Å8vu/TʨS\Cm)ed5L]pڛ / JL119nynr0oÃ(y$vA_[-=*x)hiEM[`H +@_>7ޘ>67ެOS$V5IG0:ڒ:Lt Շ4N ;;ALG'}]wɨQ7O2Vlz5)ږoU෕:ʈS'R,ƨY.Mޠ^5.RlsnU;4&P+Iw_{c+}NdԒ$HG'&ߌn~';O~{|on[IO_ oJ#JL16LDe;BnAYv|#qqtqk"^ jY9UK+]YLoߪ"Z^YMmpMDj1|(O>r i>س'uq=}f9[~p Ouʲ;>%t&{;{Pz"1]l!Tbt/{/eIupO]^/{Y1F,ïZE{ԶJƄmqIǀ'ALGJ2rluS Ӈ1 RNHG.pdFN֧ac~Y:8|sUacW~> OL::y5YVj |#zY,1{*Oig^$Of|E_LGg~ 2k_~Wk o CeZ$ov:   hTI]@/[){-Mw!9vjaN8zW]Ds zGZEt+K}8)`kUrWp:'ݤ'>"q.=b4u8W]*^zl1rKjUS-hVk9 Ǿ4yZ\x4S`͈plj6YҊe5Rhs-NTQNTznn\9 WZa=^3Fcd:n7GQo'Z 1bav`Gߗs^b ciBMuX)D9M)os0PiBmSM#&LC#Nf !s0 lp0F2v`渁Yekdsrf ;(2cq׷veuot| UC~R10Vq/ -0La X:ڗiJX~,d{'W9MLʶs۷v&8M:6:壮gT\f%+0ϛb+l)*f{4eJ-`e;Qϲ뱬њ2+Ua5?L,׮ȍG/] 4lfЄu[kIkط g՚(1k"fP&@z^("J2ZKr_ Zzu/=X A+T?M }cbH^}h_t4DJ0aHk=A?~!93k29vط /.+΍\ JZ9Bq{ F~`tR6Jc}?QnfTIs*/vTLxq}61)9Nw,)wGI|>=)Zv< 4ʗ&A֦m;yr/ר\jE'A?[+ۺ{g@?M1WGjɵ/ ޹mWc_߶`ol\IԷ? u7ay#-> ϥߺ W g,rVAãM3la}H3"DY+X +)ApEYDA 'ȻҝP|#-c¸{V F Ip鍲1ncHfqNe| wkUR0828 N@Z-C*+~Qa+~s&o~ U e$tQN) or/W:M5hqZlSV8hzcn-[!܇w ҷ,`8Дhi{@K}zLs1"\X'pU{'Ik6 @u E<~٫G{ݦb*z₶MƅYы|d/]H f}AwgbrjR߱].188}`tkG&mE-Y!ԗ<Je[ ̤URJ+**Gs='b̒g{9>t)4bܨe$Y/ {s &Z;z1^=g9QWNW~: k^ʬy.[{gJUӔaƘZvC:I[%~(T^)I,./}q zfE܄i_* f 5lg#erz."ԫKI,2VbCQ9bF@MU4XZZC%r h֌}ۑRhciʚjf)^ͬ|FI5ɰVjAP9:bN@Mjl9d"E)e9T4VJ;⩅D@i-N uBmeRe+YuV@F2bN@,ʘmqOgVB+͘WB+2͘W#ԛ1c'˄aTc02e,fa2]L[A1U);8fìDaTj0͜l5TAaNaB9^...lK7]]\ؖig.Poˈl\$Uw([wVaR"ERuAYpiAOOɰ'kb%# YAY*R(#BY-(`;L釽o'&a89jT۱tC/EnkA0YȬeDw@3e G/d9%–㘶vhnmJ[TT[0,[1%bdӀP#xIYeDbI*r(s9qyʈPbV5S/v?kl:6l:3:jF,$++RVP٪ #d˘j*e6BYaUG$5 Ԗ:MƦL1fވ-l:66C2f~zمѨfuDI9bw& !lroZ!DjKw2*0bz'fƓ)jlus5^\2C7H IlN:!FmB@Mt~hF6JmưZ JmM "D@I:Rq[<"LƁ"8P7ҝuC):P7&B~fvXAj:Z!4kZhP蝦%b% &-=62-BaL4qE`n9}]ӌP5Ѧ:D`:YnZHզAbzf $b(J}Yio!JZy0oz4m b_az帣2XG~MGc htqk=Y~C^1kȳ=|ܶcsCwiǧ˜XDk]{ڣFJTqws~+ Xr %lO ji`1sm}/z~L et]wi?*:(UrџÞ~.)HREzqZLC2'͹V Wzbiu+o(c}__ O~a|-e IJ3A5h'EnW,nsv[tӫQ΅!DQt呫m<ό%fsacT~ʖ?vu>P5E;(ZŊV ÕYt1xƊu%Cm:Esavh,cHЍ$"{ GA]fVɢB;h!p<$.01_^=PX)r|(Y^B/ruAh1uF!HBjm*>MgY5˿ܘPe)uDIkeE"$~B/P\$ddJr,ʵa8 "7MGCP_۴q~82\²wMS2#H"nnzS+ڦ$-r h_dBB}eⶒ8pD"Է2+x=̉wi󍂈#SF9}q$K/*w2>|kg8WDZm-;! QqE bݥI0-*.ƻN_%,1t,AbL68D:U R)w2.BW_$=DoJ4%LjM-b) ) &m1p:$%Xb`SKk9lK?x=T?DZ^&9>8n#DY+ Ð$pEBl"}V ʳe*2?ffFTPxt6Z I6j@b0&ix0H:bLXoE=~rb7+6^o(? à֦إя)py$hsF? t@;YDǸRC `я/Po^ wzcxph}Db tu5J0 T倍s}Tq,|$#QJO8Zi)n#Ɓ~;bv3|~z#36ʺIj1v3lr6̣x0řGb 7* [vLcQ{v I ,< /fQUxQ5[‹"LSO u*$LSF::eooT=,zOM:vѨX=tsY<;3ma9h'76t&lS% hy7"k,_~1 o6FF' ,ZDM쒊~/%dOtTqHM$~|Ys}AHl;~zhGxP< S\A:Vx=Eg2ޢa?mN2by~G V;ew|p+= Z͹ Zrm4O2o>oJu)b%~{]<81|:n@gfDqOZ}^cG9SҡM6?[vMm;r+-/Csw=Wķ;v ?`$<|D "#mrI7Q5:'u@g OnsjN[$,0/f%LjH< S>"vspĺ\f*}2uhe7pnjKue|fMʾ{dzMZ]O5G(š%o%+c7-& "=zQ2G=x}5xƠ~0qj97h Ӿaq`{xq2i"6@ ۚvwKJVT6FDjV$u1:!hMMw텥z7z0XQ7}Y]Q&+iK<>}AveY>ij#Ӂ={v#5\Gp_xzV`:n B(Qf冀'8;q4prߣ"NMyAJ#}Y1 UOSqȬպ-Hm4FM~#(#,F09f8A ]O[`LAG0]'ܛHbmf7|T6s >s*[9P`;҃ &ЛwSp͠7MB5汎Ŭ:ť_Ӥ=7~4 O; :wNû"iёTUNA7&h\tixՖXN`yR6Yxۋa/^{Q"xXzB8܋ H^'#sY;\C+bDpx.wnv&;7;˝ELWYo; S슝 5ۍS2}*czKaZ>ukh#7+Y%G[}ޱkAڒ}z"%$ <ӫ6sm1hW# ೪crglXiq>L#Mg,Ř_TyHs\>Hf{~@cNmUO5 #-wc[ dghOY8Ei=^ciV.n{1̀'riEp֒N?w *kz%5j$ȟh r?k2M,lbx(v\eײY5F`Ҳx&FC'Y5bbo&ꖆUہ4u'>D]-bLJQWPQWF >jiu@c3PU00:?YE VEp=RS-BIGJ}I(?MZZG.):: .c.hbw w2j 9Mx~@Ep=1Tͯc٦R"tէ"hKcϪRZ.?)*;E"klf_ "`v3m&DV5jx0fb $fa69 Y=)~ywvf]8nm?ၨ¡f4aZqV$?+tq] 1KX¢HoHo-¬KaW `~(תƬplռK FMyab Ԧr܃JERaMgfYž-t͞9il5sn#o}+f`o$G9U-v=ߠXݜ߅{ަV4Ro [3,8N1Mt ^7sMq0N I> |ӄ~R5mb&T¦W# &]-SdΓ3M0䟂:$_4T*UU-bkI:Ӈ>pҕ:&u,ocEEe+ Ķa/0>r֖}AĮ<B7 ߒWt{-&ˬ|$\8:wոnd9gu7Y2hz_I5,%Io3z-aͺ3mFO-swq0ل'N6$Ӝ&LC'~n;ӭrzfM`hSp:1H8e_0eWNhv٤lr-/Mj)۸ZʦGdٔMbl*)fŧ]:+ݶL:ʦo;}-ؖ,HUZSq9+nG@;f8b7.S)eQlB12z 6i8.`iF W\OEš-+5ZDngg YUR눚"lo3ol5x0b,%^O!oRaޓ SZA:4mh[qkEӥz':.hW-$&O~"MW m:=cfy[c|odtD v0y3=ޭ1@Gݪ*hԣ00"h('lzmp7_ SI*Ñ-%awWCpɋҜx61ƒpmE:{&TWw H[FTNƛw:OW@ߪҋ42kU.A넡U3Зwǃ"BKF`ӹyҸ8܎z-b4m\6 [R3EPfDjFZzKFUTȳ٬غmHm*(DE3𾄧ӄ}£$O'kis*Ew-rIGw}JYh}~ϪfZ.0 k,ldF tJ#5)ٜ1xfm1S _~2ejPUjXMW8E(8O# ೪A69 Y=)~9:7vpI]uWAc lk`OsK-/`GLU=UY(dUC-Cl\ vչɺ0+!LBiA~p- ϏN|z1ZFR"tԧ#neYUJb-~x(`]x6GtENk]'4^t:*{0uxĶ:jw]6.?S۾xU2F]wbnG i3^%sȵs:29lp09tjV9+[ s0S9MrNW\-SHA&Ԥ%U{CEs/ZYhA( cjΎ[Vү2/ [فG# 3[d ѩݬD,Ra *~ -Nḱ69M !&i=7q0qՆAOv3DD2 |ӄ)G^ 9MxqH> 3uܫ4az99MxqH?il8$g_tN]'_4aL=a kq=c;燭̱}#2DI8Mۑo4a=ӄl^ɕb=b̰gC gѳ)+ /OO]'phfT{k=!Ag#ݮR]/iӡI.Mf oĶC$7-:?$6OběpK. r̽ӄ:es'R1{8ػaANGksʰ#KX4a:yXtt| $vi_iBMzSy#x5ż{ N^R@󗀿iBMڋ9EB>O9M ӄi{ 1^ f $ @2 8E:淪 !xꊙŋwFீt );A3I  1Il;Lb\@!s5<츴*@:hn)y_!v͠7͛Ͳ;foxQ(=?9s$,.vV6=@+Кxn7|2ñ,>1"\eLfw b?쥽ZT1?so?Md%QL]$ Zi0n`} WlVb0&X=Yy $L1NL`|-4&Ә;_ ̴1}t6N4li8fztѾ UVSƃyJyNnݱ³L{Y}yfqμ7ؘcb9?G'gd'F'ɒ=62-A­&Įx kbyq6yw_Y~BM. e&M8uEYMhvo¹~=% (Ƣ⼡GQbJ7ƄU n:86O 2^Pa7h)%áX-x)[y &xsI\qRQb!f<'E5 I ]~@9k7y tJx!7sPqxTw =D? ݲ@O}V1 |LauV61&ˆX㊵I՜kd3rb})~{-',2nGb̭Bf+baYr0k$==XSW9]v'-̙GԪU {e)(mߦ%.ZJ6]*7~HA+8TaS%k4lqpuLS w5FgS+q\AmNJBjVCQ$'_b(}E_($—_o݄o ۱uz8IFcC?<_k/*iUmTE*EJcYK#9 zSC"Y-2k:zFChk8SjaVhr` Sh9v90' ϰrV%Q!iBMJYJ`Uu>N[s09ҔY-rN%Xz-=A=4ʡ}3Wq/3 (쒸b_!JZ0zE^V2Зisu#7Uu^fԏYŠzc Bwj%,4r 끻@o*:- &morr y 8 zXcVZijaz#hKZ0z- 2 ľ]x׋+w] JZy! \ P` qހ)Xe{?&4kFIE6cjf|w@߄/Bm69,yd]åZ1g8`KS=n{>ǀofJ=3oئ.}/E}] 𝠕i\j@?[ۻ{mvnޯX~G;jwKMl@a@ ];ٽpWv&d L~ WJ ',oۏ~D(iK\u dMrN?kv,qRѥkbi 58,=[i-k>۾2^$ڜem}!QZ%d:_|[CW~Um 55>i QYA>< [ZmJF{@Gzno ͞];vd``[7Ыkڥ^^v޾o[PtHHF;OE"v oMQWQQOZ$wb-mpni'!\z6Yo;X?J4+Z ݠkٶcn[P7T`ʼ.Yz;nknN{Q^yĬUm3PXmORZ5E51+4.DGWުW3k@/Jt]:{YnV+,jb҆OO Pc1 (DժNE_ᦝā1i'yޅhtΒ'?E<=_"b_Zn)o&!9 Jb7 t@;ձ:?vۻk.%qg@ѦMzw 60п]CAB> |sw(݋@qM- Jb*s406Q9mhU5[ 9)ٺ;A^:\|1 t}|8>U1_aᇳfd iS쒣oy|22/K}'v'@?AN_|TBϤyQnމ+Xc nTMڔbPR0n:%Ȏ n7c`g˔ENRYПMe'vo~TbyQ}\uӲRY6G ƑpLD56;hFČM6 HJLg,$ J {à?9;[~I8 @AjlF1ϯPoZ?$ׁoo?(i!:if͞9c`63. + {6ERa L1ko?vUoރ h@\[v>dXsECB'Th`@/CLAO'ߔǁ@ԔldJsjЯ֦6%vo;O0X`K6*$3πL -,hxќN@y4*PbP32|.ZKfab0%F Xێ5di(^hs5+U4< i)B`:Hm!vkՖ=ʷ-8 zRڷ *bK@$M_  lۭ8/=^~֪oֿ@}}מ$Y@+ub/bI@W{4,Yrg=#&V=9(^Yڔ=F 'o8=ɠ trWN _|AM j9vع]FUt;%(0%xNL v\AؿK@yo`m peUEixcC, \={o\g170N`Sa*Oi~ͣn 7Vr̭5n]߭U.3&W;NӪ3h[TO8:BoWx'߆7;a/ /5a{Zy|F 6>R{H􏴩ekk>B`~kdM&L"9MvAF%m1~z*kfώFĺ=Acr,:ZOj CvsV ଩*t{OH'UUmre}iq'otd\Ch%1Vۮ{0@+rM{]㧺ѲmڣI~ Ǵݦ;vm/ io|ǁ ӏ-Ƨ먧9f+Á6aAvq*6f9&4^8ڼbо'wGIӓ=|8Z-Zbw8 z:օ}Z_벭edG'Va˵.E'A]@} g@?M1W7kZvdmc_߶`㐨o~t {8ݳρ`f^@Mob=cy e38\-b. ^rⴼ-p(1-[ k;`]óU?\0URc;gi/&R V:YkƛQ2^u|:v0E{F8XQ'%FaC?XK}/Bx;ږr|#=LFمSr+de""zc|x3?mvCVeP>>MZچyώZ`,v('-Oq ^fjW1u]“n=|jWW!;~cGgByf=X}6dMUd"\z}uP> m\;k;5FÑ3IoA~#~ctΡT_`ҳ銱2鞱!lxX^\;ԻI-o,!<X;c% \fg6z'3߅84h7ѽ o}c&xGG5VY>-=Bxb˵\׭q ޮö|5}@6kľ]xݵc +cW%E+UWiSʲ4 g͆=:}| EVsj?գ!^MUggG/~llȚv!.6{J㥾c#5\տcpp`s׎>1C@%fs7sJEZ8ɲ+v]-ڨW$h9QGzbr=Wr:]hT2,|oY݃;z1'gVDSNBm3-`=/e̘Y}_j`إ.p9?2L)LkC]Bĭoafߙk [Lf&gqYw]3{3~̙V$u؝-Aڒ5czb'V]"e^"Q՜ ҏH/E$I<$Dmݜ+fR\ :6Ui5]4$^"6(trdq NǬA,+DjEٗǞ-XּDVF]Tu-EZJ*jkܠY7r9TzV\߶:,^E-"T[Z8 ZslTJqADGn\2F,îTkU*dFl[~3ɶq)*QBDx'oIKux7ZN0PkD.iBmU-n^i:x cpdM9| ,)[6!zG8MtC&7s:6*~+[s r:X9=@^WCϬ֢vlsJmK;P؆-? zFS~!Їàē9 mrR}"x{b+茬z nĩUFXf%yd,-dRA\1@:}??JẊS,zI?Ţg>* J)+k)^VO#f!Yad*B0"qyf.|qEk RecIr "/J>Fx b1%msH*FKA4E_& J1bn!&0% :~ ĨF1jr n-a(7XhY486afyXoBwhp$m14ߖc o$ǁ1I7bA@*F? h|u? __: 89[-QFoD@tGrRa&05'f%80=+[ #w'o >o! ^i٥lUmsN'iacmzc5:ۗY"Hf/^ mw ;ji;ZL5Q#8k!*,hyI6,;,E5G]41Y#mg}[2~eBfr7>Z9x ZFJB={ֲoe&jX׸NJzߩQ-V7\:4]۸NhUF^ j[.dz{ˆEzws̭tNw`a7Ik?ٯ Wg[c\gیc0\C'dGHUG]p`I& J}D Ze0cCËg3j+skAˀwt0] al:[b۰ʎ*5Ѧ$MIfjwV;L~)]MB~GGަ!nc:T:ЯK v@%Z@OBLX[TDlY,5ay&B'eDx5諓70\­oQ7M0MqGUކ7n >fItY7o,5o̒x huE.·(,H7!>-720}>|9e-gԧ*#[<-yO'^Ĝ Wc V(G(}ui_ph7=j81sdkε1sz[ Q4kwJ]/u)[#~m/-lGө|tIۍy>ΙRxFBM_È9?[׫W~6ݴ߱_EOL:x5YJ#\}5iXw~Gb%п~7(w6s11i[AN1g>EMC}uoT5p0 S;δk>3,QЏoo,H'd߀XU|)-+H ⌖#&=Amf6u%D Ct+aƄGuf_4\, . z #ixRɖ-dTxhRIbw/m뗄Mf9ہVjS5n#Y, NGGX|u^ĄHEG'g@ѦQRѓW~e:*z1UzKr}tx5iO'z ;_pGbg8^M%m1EQϒ1ȿQ; Q:MAaszLͶmOV:hgՓC1D{X]h=7 ݂nЎs~!"8 zRC^Y0小PS׀~v]W(nA?]1%&U-wV^<痟_Kv=S`{s'E F.(o-d@!_@J\2v]"\b. +Y* JZyGxkQc}8,N ױIl.>vLu>*}V ;@+%;Dy7m l/:š~APR$Q>$!v~ tiz<>\;DKf&L. wcOTݧob.ܾn4g4Z4zec|JS~x]MNY+3\ӄip}y3*pM'?͌U+ 2-$W:F@6Ɂnՙv3)Tzy@;!G-D0c??Ʈ4O0;)E'Kϧax 2S1@[騋Cӄi{k7l.B-ޚ;1,>Z:hE~gdVJȶlϰ1.W)Z=-1@ q:xFNigϳ<eB;I맂4HQBSzZ(8iBMdd x/ 5yN q:f,,M" 1i˜ad?xB)̗iBMZe.8ݮkSٟӄ1uв  iBmٷӼ mMgM:%(Z蒸НWDY+><:f^*#fM~{/DKu6w^791rO/30v1! N;ab|wVRih(ty<޾ɂZl`"!AkUpk=A?~! 2kxtڜ C[h4v+ƗFVB/3=^0n+[ٯXI0:&S̔ ߦtS4O\ӤYc5/Jf})Z0$kBvoZ:.?T6&yh9K h+[nqSe;v*O96K-~)V{;vn߹Me> mпM7Qk\rmj} }XHٻmT '{”dLR'QtK )蟦>DI[:i_y?C:]BkdnI DRw[hH c+{_1RWִ 9JȵSUσ|ڳCA6h,N/hhoZ{z{V1?֦Bvw_;Fjm{[E+E2 N甶BʵRJN< ^G=Yנ`;~`N? Iтq,'.nYَ$< 6ν]5a9|b|V]Abt9\#EρXV ށۙL^2}vٚ8'Q?[E3F{B:tRfyI-[06 wGIӓ=|8z*y!v'Ӡ3)iЧvd H'/s;b"m,.ؑ$>mYb{]}~a΂ݿM2#Q,h-P|= -t8'EۯfRs)jٖHoEh/+Mu 5;@%лϐdjz2 9A_*_nt{hu}Ul[}_T_IH+ U9>CF(J[ EC^[z"B  K=kDu%kÿ/FIbJ҅tRNrn*&PE[xtlef7c+ۀ% [aJ7[̭q-fQ Ė'A+ o,.p ^(3: 䱅|ر.)=#k(C#O%o $m7ks.γMp5"slҢ{E)<554P1֘唆z?Num[CPB.8F2 Y.$R;319xH.v>0ܵ*5:R_B?~W*c(snz9kELC\Z~Gs='x%ϖHr:]{n2,|헄Y5%wyAd>?uaM~W: [^l&yOa| Eee#kJ^ ڬej)%f6UF*Q4iხú b@7x{1o{Ѝ&lS]9dUm'0@G7މ@%_uKX]Ҩ|OX14㘶(^W['~0 fE3g_dtņUW_h{7q*ھEgHkLZG7UQ9>z1=ߣGsZϾBr|@@MrUA0ŬT.$ !`Ҵ/C7QU&d:QG-/ ƧbƢn_$[qia==TgNC8z+tĐG{'nmჇ~a ,g"5G=gQ#s8nzy9?mS+c>^>Za]`1sm}/z~5֥y޸?V@q?m=ס.s {cG¿w;"(;pwA:tDow45a2'=b%=bx#=X@=Fb%M)Hқ_~q p"ݲ%A#C|'w&@i\D% Jt)HeNsi"$t)|)yХKaZLWڃDI߃I·N6@k3C,3CrȍOccyfVӷ3ay;g*x}N7gT˫w5p@;#'QwƵp ;lc6g_94[Ru 9o\ \ HY@qg:깏YŠzc}vJSHQSRsMx5xPS/[bptĠᏻro fsfaNN)sl$_2MH|I1WbMvGs JI}ضs0$/j`TO6rs1$F ['0~7{@7ϩ׍xYAͣ}[o8r-z*p~8< Y^|-&'.ߍ?|,b|3,b(ǬMܞCZY$F'0\lG #R}QfIh#y;%,Ew҄ f JU6!cC"DY+(r<0镄oȯ_+S3mX`:ԈApW_  jYJ[A~T߀ OQ ڌk\JF 7'|&qZ8A+OBU~OGPZ6≪n9k$*,Ӵ峑X1Z1-Hnk#WB{L9EKd fAsz -g]x lh/fuƯbi2& {QYzt/ _CbW"_A?!ecE&L;Pw!vD'C wՇx78@Z)ga!PWU!_#9I_Xҫ| G:Z! Jұ ?A+1HKWi9DzJl;̵C3ݺ̂K/$C-3kژvǜ霭Vd4aM7_i/ cߥxw[a}WFr/>Z15 ^N&`s&:*_e8tN9z8Mt|M1k nuJaSdFI;9Zv'yG+ߢ6'UlM[].Лc&L;csd,+YƲ?Z-)Ր0:WR4׃^|H%v/}yl|(k\q̝sط05;:%z$,s'/XuǶL2D&V O:4h?4aڡq+WvƀZ=G 3Ob7i?,z7.(k@(o qNDCj~yٽwXpSPه`,s6#J2&Nj)? DA0,zOב䤁'9^ڦg@>PgotN߂yVW\%?WT9d:ވGCs$WiIop0ޔvǑ~ӄ@}N? c*]:! +NJ'y?Gg Mu\6-J Q5ASfag=ݍW%|_[aĵ`NīZ@:uZꥭeh,v}i gxf_%3-fo ;[x) aK _B,2oޓgE&.K-^ͥxnT]/3Nb=sHO(Oyr Oqӄ1cь'8FFw̸F)'vЄi7=f? )s Yˤ$Nbwp-赱U3)uB#D nbtleii:eQ|hiYC3ϵ np3_tyu+@? |w՟r6KmZ#g:%k̳4N82+.2&ku?kMmx.#ތhSN:=sNVj(pKU,éwsdic54  4a1| YN+Qb>w{xsׅ.X<{YfG= ?Mzs:/n9uԓaiѝw +7͉yM-2&lSօ 2{2 $M$^Ac1/F垰.\Kմ=p$蓙C$ @+ɫ V;XEzN+]8)ES_}E\8cVg):L=XskV4QS0 27 O:~/[X"4 ?[i´[~:i]0AWb7 f7T$zn[NJ>Z`6⥔;g32+L#Mxi~<(oGTj@X=im(ׂVK2uuSwtOߚ{Pzˀ@^/> tT~ /:J9e&IuпhlF5={9\.q0„w QsptAi´[x ȄIr05bxהW@+ s =[o$G-Ǡ- 'b O2-t.x|뵎 s ׈mPZ_0%usMzR=o/Qo W-F;}gMT,a"P8;2L;Z`Zm}$? h1ǠጪV8Ѥ"p$O8r0Ds0]4aL)mb!;9M+SWD#I7r0 i˜:J16VeFW="7B,X1DERfV$ 3쯑$_~ӄiX_4aL+x# -tn/Fmϟs)]0c+:[EdbtJ'T#_~ N:wssGˁlXN|`ICa D H@KɈN"[D/6?C6LM/h'tnob N,mHCeu=zGWjӳmO}MqPn:nXsw϶T#VáXg^:z7ٿtz-5΢?4:>"_@ve_t XfF@+,T%=G-)s?,M*ԾJ;jrg)ˍx_i؝amL[SN9fȬ[+Z3hwgXlW\8Mvpmz.l5bѭ9F!i+rc?d#ݥ1U;$J7tO9JHpV (e0Ҿ!l yl7JF )Fa =Ac.^[v_9iѼm}!O]^4"w`U֨ɺ]= Q#fwXY4ѝ)b@6 fڌ1AzA݈AANj oҹ$ O9 j߁s:|6-;8ݮv_QsHg$ JNkϧ 8 ư˽a" J\\t4 "֯y)lD\̙sv̔oLNߙ~u#B==ߥXҝT ۜ)QUk|Jo9p/ELfUHX`؜f%0wA6W'Y?@]}G(hL"|TV2oʟ{r)*ۙq=T8sFtݲ##Q.^inr+k8M'/tNQmcd$ʕ8MR64aL`xX Ŭ2{5Ka蓨S&ЋlV9MvBrE$$f4O")͐!{$:LE.]$a hՍIT;{@M"G/Ѻl{OVr =Ah~cΣN]Ю^q @,TO~"r>eLY3,N ]Y]Q| G`9C0]3`hۢe$|r[_seqWD{"qJ9rPshNp0s]ӄz(nNg17i4ts X4aLݬhJ)Nn4K4aʚ< rDps&LC9i3jm÷򍣸pV 5|(o&æS}' U̻94&Q H&LRoi˜fnw_lV&!Y'j6A,.XHsvi98@5{,3)h‡砨oh(*oV79l9?=*]s_, Jb܊ڏPG"ˑg5V:pB PcFpts'XRIQhZh wВޢ[_}jz^g$)A8yG%v%_>_oN -w 9qzhf L ZѹG9߭-lgp) _^1wsJ"Z%<{z!$A=)()m[r0n ߧ >,c߉Px[jzMlIHA/m;Go*3Juao>C>2pLⓏ%X~ǎ?xop9P9'V~bp1I)8*eMЋ*TVA*vii$[:gzn:=|@B5JFr*ij3|V{\"V$jrKS'U{@+5ԋ"%B-UC@%.a6H r*r뉴Zhi/΋V ZT32AkJa.k$:yMtޥoS\O"ZP1^FJ֑49 DR=)~{0o? Fm|ds.o;Z?48 p;Nʙ388 zG.Cڶ;'ZM\ &Y`F`7^ o鉌%NeCF1OKDhFZtHׂVECV}]l}-}v3x Yt4x4 <4FX Wj/a1IhD7?rqlͷp)%qqԟ ~{CσV7 M`q* "𫠿MAހJ&oV:,!݆$_kTv%?Wwc+P9e:Z.Qdq`ױt\-_hY`BF6R_6[F$AGZI:OfaiT4%Up8")$*'8MvB:IзxXf>Waq&'LHKtֹ!r=0ܐԦ+7 iVd|#ԵE1˗݇DXOjWQ`t9Fe“oY.3aqu){ nnNU*O\*%A9W +[gjM-HԌpQOSowfBS scn%'h+y M4ld]p6j@DQ'š\& J!oH2:s,4:Γ0'[ü5 e/BO\^/^EZMŪ|Cҫ6֜kUzЪͅ?ix3Y,gϷ>?fO7Ӛ*ֿT@|㠏k\9,͓DKKgm=QɤI).p لYӂ*i |ȋJ @}XliYUJv/9 {zRvÌI\I }7hu$[ot713[ 1,i%b mv \WfmKDY+q(<6v`/Cc(n` 71V4M(,0yl IL`҉r=,VʻgT2RVZ,`ڼpIX]KG-ǯ ϡ}M<\F>׼;5v,\`3&P0;G/[œJוjbcx}dWUKJ}Wi9RNq#[\i 7~-pnwӯ/hq[h[ 71,g慓mX"{tV.Om÷*tqnj!8Gh5>Aӱn!Їb[%&O8%3ɇ~&udfghIݧ{cx3Ƭ] +QcЄrQbޛu]w$EmEEϔ-vdZlٲIKN,H> @Ҳl'vՉ֬N86;6IM%M3o4:әf~m{ (.'OCl{=9I N3f =tp'K@yaW&kRAHm$mL;RN;vIG6Amzz:BW֦t n)ЧzTiW7P-uu eQŹ=$VƙH{O%Vi O(ϭqٹoʣ,P& zoHr/9L$<.E&{6C [0 :Y=."84{ȧq]R8O%mJMx=;WzoIdgmۀ&hh#d^)oc'$ݲ&-lL>Z@>k@GOe^oR-l6L 0%wflb_ ]ס(wCO0._Wƚ26 hOn?OQCqqnzΞ-e^힘WBsw.Lz1{LP;A\W/nF<}uG=fך1 v ^'f aÛ *bojSfPS!&Л:跀zxxn͛) vfp}wzbi¢Ve{'!t|a]om#5>;4.)[{ F#Ky+u%̒%t]qh?Iޟ0\tGy`aVE֧XOWx"t~ Kh >zȣ4(ecÉm]lx$'v&vlAo>ܘ V<>4z051*8U~~[sM^͚3V%=YK$=_e{5fm~"F;!uy'w'Ao?~hh~#o|oߵ)z) RlC aIx-ku]G a'GG=<ƒu~ÈeN S4D]4R O1#S_,!4+egެ4['zPӰʆ'X=t>b[,<4,BF߄QGtIx1_ydjϮ ?1W^}|i$Z$!7>>qsK AGf3A=}R^Z鞗3+YR)GYπ Urvrqd3of1{w|TG=A2t_D@G#N r_ AxGuc; lڮ.)e;-R.0c"l(X-t*o[Xɦ]e{HMo;F R.4D'z_txII ',@g:KoB(a'zvvڌ垱fY՚pp?/zSN[= ;9Ux$loö4<3L[?O,&.WP;Aߩ9|^yj3g1bj•T>* Cp ֨.)$KSѪ=py8 |h Ax [4O=q *PQnu/6Q&Ͼ M-7tO)3эMRL!/)?p# {΄ sѨ &d& zw-QcS=n>x6B/m{+Rix(բ ׁx:录 -!ƽ9h K_KA?oMmPOEwa6Gh:bg+,,bf;|],[>x Fx/{#&R $=i71)QlLZņRocl5' t[5 $b*%Qٱ 3[>5/Bo $RCL`۔>>)OQ9R Af&hdѡo ?ٟ?P?Ao x8 8Tvx[)S+ǫ-Y ]E}O P,qGE'FOVD\r!<IaDOIDȡxBPӪC1%Lbu [N}9On߳+ڳ{ıJW_TO?it"#ץx"gՂ 9׶ XD8;8*Jr3]BIkqI SykE#^Х(!Ї"\mJY%ӥhB x) fZ8$hPϣ$)ײI設3d' ߹orB9#-4e͛g,nO>-g-?Џ p&4pdd]K7Ru/'GB"qL-GѮUE+:%=S/BB\'N sgL=Z+7+G]J:{߲cMVv|Q{i@vtc{sgfsiɢU, t9od,o.ak~~ǛV!IX_ b;ڏE.6nؼ٘WQ%([S)˺vlع~qn1gKh29 _?s-,I iuKL;4%Ê;vcgA?֌+~be:9ԏʨ״L5NEz.j&Y͹ikebQPyB38A-eYj+Lh=#Y&ݮL,ase˜)NV #!ƾ8揢f7ĄZ_ <6wRJ9iW"X] BA҄h_|.Tمt|?hqб4𛠿  -ߊ .]4Cլ,ZdJ  5)|ߨeV=+mywx #Э}0_QSk(A.Sˀ4a;z #juwH*y/lϓ~=k&luϓl.hv<7?yޞU_~ݜ:*'͒Dh66Kxoľ_B"|ct%F,e1kiHgT$tLqGAFU|R绥~[ua4wݯGw޹4w"4C̗w ntTp | ~z\1߲|BX}9o1t~{&){q=zwCW҄^HR _XURzW)/8AofURJd p*\tuŵY42u3"U9䘲 eJ~4CnT1Џieijy-kֆ= (Z|OTq(2 Տ1ba4עk_yv&3*g̊! zgt5/\dq'4;@hV9wݠUtKB4f_޵+bq<-NťWl83^6˶WqgCM6\!t@:a}"ʨ6@±«EEjMWe[Aklyx&mp LI'KuH)>K/"&ϭ.I, `t=?ulE\LNv"C]X["E (&7&vo}s{l"<`l0hmb2_((Hwo6eA8<Zi:%M ZiC'T6 ss-UVAWcgӠcpAC͟ᇗ'' -);;UgN".X7TYOAT[=/K{e=';O=r}9<_q7u !|Zf>[Sȼ3iwp)Hٸf8o]WC@\sfXO=\LZccڣ% #dڣYJ?o2 s5(ooʱ}zNd薺ƽbFxNB&,\YvJLƬeƚq[ 7Y Y;aPj&gr[Q2= .6:`qQ}"`bI+oZaŢ6]VE #2hpnzx.>^ Q#5gv~N, ]MxS)brx $D#4@ xG㱅tahq "#vqsSpMP0xGW+vahQG ۋ(js+t+Ex_(gܾ)mתb#aaμ1 )ӎ.< tE?`{V _'! 3pDT>k{o sC/h'~r OZzy]_~m^j70vjs!+$3B ML!ϼZ^r}~ i>J d~%^ zut"mh]:YGNV\XNi="A3tTݚ!%ģI3 ?q8,MV(iCY#G4*.(HcGKGQqӞӳZB<k%='9I]㲦ׯ,kF6#8rЋKw;iim-E-ɒNWo) ۗӠOG*ۛ ֌IUNROKOH/_Tݜk!Z6i{rmEiMFi hR ~9Sٝ^G<}ME9g{"4ȏ̈́O{-BE =&{Dz.ՙ]~O? Ӫ.!O)7ͅzyT<+. \c/^z]dS9H7S.' )5zpkWxv'K31ѻƎߜmorjA0#llxѣf#߼/:^̖*h*Fn.'F\0h7PZmn"zWS\{@Z ϵOt,hנw57PkA+Mc_kB b_-\ڨIK Љ5jb;LNuQ:g+9ll9amWF,Gh}XTq(ʯP}}N~Wx]QŚ|lX}9~ҿ.#΅f1jv?lp#g"d ښxD83[AolK-X(%LVs!9 *ephTx Y)㆚NON\>6;'@Y/S@ 茆ZRA%Y`tNc2c^j7OH"3eaG3}]yNŞѢ9}tǢ?9~7^3^iP6MIgƦ!Vެ`8r0nxSN%KXҫ&]wf*p ˠ5]Dtd~w46n.{=ߋC! sIĮ>HBN[/|Kշu_Axދ w~ =wx6L;<=eQiSeXAyU5z#Ƴ@[f%_t ^@{d&P~^ؕ~8rXƋ*jzVoզfT{(m~`,|(~@HNG OT{ta:0N*m6PЧ_4{.;ڳm'I~0o}mj SŠ?w "ף~9*\Ty. 210gџ ] P`qzu*vKNzgςl}8s?ׁ < zF_6b$~&m`k,gMf!dM~ 2t& NBiΒ'Dc梺,*#"Y^ |-׶e_uˡ"iٚ$ Ŕ3m,.ioAFLe Dx=j A6Nv?ij[YO)7544_GAo+Wi@l{Wwtw`?/謹 m]wa)(\ zra tL~ȵ<`b?Jf@ ;A8AxZ_=ND8&~ }= r~q>Z{@d.SDB< sغ8KG$$\V swxAiHf1baDZ)},ť ':,HSh{|hwsZ,*Y;clhEBM(9(b <\HBOGw~'#WI)SҦZJ"ˠu.c/ld,I7s NEc;6,M{wVjBcG?ѻ"a;b/$h1bC #v0g-KɯQ+^ʹ"d:TQ"Xub=..O4 ax e0x{A~'I9 O6rX; ꗕ͝$6IWhܾ'T*p50:\s+nM-.)I5=~}}d~I82aT͌ ì)䍂 4sGTuzEz.bN w]! %&,k楿{>XʛY}mqy%eisܜ :Yaܚk)Ņ?aA?u3i"_O֕hNWjoZ] J BൎXBw'+:fIu@zvJxGC,kji{Ls#CmG\U-Gxy(e=(m84nV9t-U۬Q#d\ |zIHrbz[A}Q`}poYMX(|q@萋>Xϙ\8'̆4䛱` 3?mzsQ*Om?T;oؽ]jY"5~ةzBg`-Ώsvg-6Hwl(H8zPU$ưxmTWC>1 ߍANZɄ|5PU^#jJwrDGmNn l]oN{+c3 lY 6p 9lYzi{2OYŬBi9|*۔JыnJ;Wk~dR$ zÖ>1/tǤ4K yH ToI ;k:T7 ՜k@) 2;U-u)|EKMS~rQ`QHL)mxzj >nЕekΖjntyJխo}zգGUUԫMdU+W-҅vTנ1]ccP4wMS vzǯ6}l%o 4 :֤ g =wu;Nebx5?k!~REn=BM#ą+ -s 1]t8O₃E븞'XiHv٫/(aNq\JN1GBr9wCXyկt2ˮ=c8i6(ZFPc|݋ݭ>0zY^ˀW PkpjGI^y$Z%&Ty/7 ZsĮhZR}Qm54ns\˩Zn+0m[))R)C&icaI*ktҿ#UFoq!TvZu&ߵdBml'N@oN*cZQ?k:ʫ g4? &rXVߊkԖ B!h GJ[S eB"h_9_JrREn=UMEs['H:S&7QS@;~@븞-dTHҞbÖ"lϘ죙YCQ4a r £I=NQ5 {Fmƨp9pmL~|e_όFͼMihkiyJ)#KSѢU-"UgY/NN .p0n4&{)&1$'-~r*6\vyh(Ϫo h ;4Ѽqf &u,'ɽOEn-C=bj(i͒ʟR8RƔr]8hj=j~ ˙o v3=B[]k2\f1g9r]mv)j꧑k*y0vU #juEګd)S$[2eVZS׵ N7UaC $,|Y9&R K6TRީgd +5X`lsS,ts&Er-PrR[z,8qkyr)l-*)XBL~6lms"aǺ\bޚhM_N+XرNVv}e9<*hV~m&luo.hˆmtBXF#hv0Qc3Rn#ˈe*eӪg\v>-5ء8sF(1Ǵ ָ~T'9й7bw=NJ} 16F8^d!PY%ȷZ+g-0]KĸUB<XtaDA(mN0G_*qin 7[2~X&3+tV*eݖ sDnɁ]+֕ʧ|e!ĩh.2b)f#D޷e;Cues- ÕӖUlGyq^D3G>Qq7?@Ho&'ZjJiyAz؝VЄȶh~/544d>tv#i_|ZJ `:TQ߳{UAFTa>Wz8j²?v\Er*4acM><69AiTOORK˂ nzZ^6xZQz@?2&fZA ؽol6$Dt#gMJS+ Ӡ^SEw Z[3Zd]W]]1Z] ĕ9-)tu=&.W W ;r}OEw `?I1ƣ>k\s>+8vkiҼ"fQS\ QY٦.8WWhGB> GUN=!e`{du냙СZ` &lwh?(̿zB-"+JSL1 &@OνvbqL8dy V[I;w <xdǰy8zz7%)%5G,߬hPDЩmi H? ;ySvɫ .G?}\%7c0炞=ixYʌc'wII'1.1x$op-G=AW 4y1-\"|c^ksr9%t lHUcY}X}Ca!mi:1@$LCa-nhR #9zK!le>Kgk1 [Q?k(XرU4c \"%r~m)eiM;5l1}xF5 Dbm%Eټ~q'DzmU{`\gݬ-LjvuCte}g 8zsQ*^Di9!Lc { Y0z}}5ONu#| ^ʞy-MzE^|37ws \Į6ok"oO=¤9\]9~y杦;_9(LX&)@ކ@o~XB<ŰZ,-cMn`H@ ڲM3 eH5iu!vˁkAw=ff[LLr܂pVAWڦwv4Y] Vqf%+W)gA=$s?Ps*(ڔ̗nb_e C= vxRr_J}9@C{/@".TY^ֵ3U:Tu#Q m'Zm[}=B5YF7*.bNɢwVk5M\NmkW%h? !J:&l#f]ezI:ɅVπF X\9rm< PǁAW_,h^ZCe_eC|y'6珁+ndI4t/]9wJy'ҭ$P=Pc%1KnڵOѪQW u_ F `t:〠 # ۯ#A]x֒4la].Zb#!&y.~7` DqI&p.iU'O+GsH;hi9)h:vqL,P:ZVZ=^A#+~?>ȂlӉ.עkpEGE?[A֮ln7k6 -݂Ur§5bW )gE=饐p5hĹx9[N!"O@SYkcjdڸtyZ~a4 < Z)Rx}&J/I֌]{ Zρ>MKQ' ڣo}kt ER'Y,KmR+S[t:AaFRKE`%o} _mJ,hBFi(gC&|[otr_-Mk}~AF2O&ISVբT_Z k&>A)_ uw ټs9 \w&\~Ab #Ze4 llj&l'خ4aD-m3b|6C8gxE{f] y *Ine2͂YN7:ݳ.Ζc,֞ ۠֞{nw>gH,U>]N^ГTIA蜴,6OzJEm_vz (.OZĤɺ"'l+;UΘ+$Dx K9jf_*;Pr:*tI! ;U`0k &m*Kޞd]yaA+myk5]q4x bx4~iڬ7Pӝ%=Fs;C{$f7Zy/o&d¸20nffn|K(®!a )ipmښ1kҥe dX'ГPG@?Mw=v*J@J:2N>eW~udumK']]#J-5w~^eα9J =mGz$4j!?lK'_O(=POdEJUE8Dv*֭2\l1F{Y'PTvq^ꩰ-2JhjfSaǣI$X]h}$!v'HB` tI_$Rg8Z΁HB΂5aGvSٮj RTm&q$5ȍw޶-l(!9| S%πV(&''!vUPO(5me>2[whr@P8[&'ڀ8 >͠-\(DF6E$QའMJbwx:;K&hS~ęOCmvdmXرk`6vsX]ѦkōԶALvJl2tĮ gJb/]C=#f$'4IJ=鸫)~ Ï=EظD&ζY,ٽi,cU3ig \a?qQ?mml}-6mt /?|O@]&>< Z٦CTJAo[Okovdu\K fx کԂc?֦G7Ã]Hn۹k(b S$~ޥx;]0El}-t| ?ꮡ05”#8C!Je|"q{~!S[D!=ElVd>D h5}&|p!ς>/PGA?B>1 -v)5WDk?v GbF3i;'_OŨmPOTY??"H٪p=6>9'AQ#UGlz`@c74wҊQl+6ĻWo*fnH~w7_;&4>$FK:{'A)-5u/<6NEqm˰.Co}'ğ2"|KL>z'DIMo Un` [@wiwB |7䝑ձ&f`wؙ xG¼$ctsU;CAHԧ!v~Kb= ӥi˥fim_ľGB<:84OZQHR9 FORtt[0 ZzJ=Àf[?]:mp %#vK@ ?'_EMbdPPn 0 : 8z=6qpPdXPdHwޡ.] bxXN-ol|hURe~kzfÚڴh XL9'+hT[ Yx@e YY0'l]tVDmoIӛ/,>Gx9h~ b Ցmڎik$P $5QУ-8R*>-,.ǔ#o>m6}Ǧ@"ΚMÜ'eFB(jeiϲA%E::&=Fj'87 X-{7m::YVqYM3:PV0|:{h[maA{A\+,u$2#$qI2> }E/PGG= Aa{ Xtϸ'!{D_9//iT "LfQe3FU,O[i;\̞a$; Jγ $*g('/G|m7GG=ƱcQhIt@+&/d|d \zy4[ # ɦ;W,@{pi#ԮgJN>CvPt')b4m&$QMWRc*nP;5Zm.Fhruࣞ^TXڵ]In:Ox"E5ß*}Bd|4}ԣsoʙ AxJFIIZUh N|6tI >$[+U6Kf1g9!#O@J­rs7H|da%&zqX'Q~?QE]EF.Q#fmXJ:iEx~ ڒFfzDž~ȘF -:ߜGQA*L16HhT6-SӰ>ꙒM5#Upl8Mb{\,Qs))r]hcV Fگ!M5R\7 !e$k4kvq$w8[)~x*`ާzƚS(v='V'Vu5tgkG/#.kk,Jc̎Xbs;&v;vY]`~}>L~_I4VR<ψVEjk3fY4: Xn j59<3\iʲi3,[awU(Qs\WW6^uN$* *ǫlO,ӉJhIr-t"bwzߪmy3[fJ9I 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.r0000644000176200001440000003646114570401021020404 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.0132, 0.0674, 0.0515, 0.1961), 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.0133, 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.r0000644000176200001440000000506214601242716016742 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.r0000644000176200001440000000625714550233116020612 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") expect_equivalent(res$tau2, 0.3181, 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.r0000644000176200001440000000144314515225546021472 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, las=1, bty="l") 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.r0000644000176200001440000002423314601012025020745 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"]]) # with ptable=TRUE sav <- selmodel(res, type="stepfun", steps=c(0.05, 0.10, 0.50, 1.00), ptable=TRUE) expect_equal(sav$k, c(7, 8, 16, 6)) # force delta <= 1 expect_warning(sav <- selmodel(res, type="stepfun", steps=c(0.05, 0.10, 0.50, 1.00), control=list(delta.max=1))) expect_equivalent(coef(sav)$delta, c(1, 0.999950, 0.442783, 0.148181), tolerance=.tol[["coef"]]) # with decreasing=TRUE sav <- selmodel(res, type="stepfun", steps=c(0.05, 0.10, 0.50, 1.00), decreasing=TRUE) expect_equivalent(coef(sav)$delta, c(1, 0.999966, 0.442781, 0.148179), 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(-6.862544, -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.r0000644000176200001440000000177414515223530021671 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), bty="l", las=1) 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.r0000644000176200001440000001300214550230631024520 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.0633, 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.046, 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/0000755000176200001440000000000014601247077013727 5ustar liggesusersmetafor/vignettes/metafor.pdf.asis0000644000176200001440000000015314513444712017011 0ustar liggesusers%\VignetteEngine{R.rsp::asis} %\VignetteIndexEntry{Conducting Meta-Analyses in R with the metafor Package} metafor/vignettes/diagram.pdf.asis0000644000176200001440000000014014513444713016755 0ustar liggesusers%\VignetteEngine{R.rsp::asis} %\VignetteIndexEntry{Diagram of Functions in the metafor Package} metafor/R/0000755000176200001440000000000014601020775012112 5ustar liggesusersmetafor/R/print.rma.mh.r0000644000176200001440000001007614515471040014615 0ustar liggesusersprint.rma.mh <- function(x, digits, showfit=FALSE, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000002623514600651251017061 0ustar liggesusers### for profile(), confint(), and gosh() .profile.rma.uni <- function(val, obj, parallel=FALSE, profile=FALSE, confint=FALSE, subset=FALSE, pred=FALSE, blup=FALSE, newmods=NULL, objective, model=0L, verbose=FALSE, outlist=NULL) { mstyle <- .get.mstyle() 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 = if (pred || blup) NULL else "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)), I2 = NA_real_, H2 = NA_real_) } else { sav <- list(ll = logLik(res), beta = res$beta, ci.lb = res$ci.lb, ci.ub = res$ci.ub, I2=res$I2, H2=res$H2) } if (pred) { tmp <- predict(res, newmods=newmods) sav$pred <- tmp$pred sav$pred.ci.lb <- tmp$ci.lb sav$pred.ci.ub <- tmp$ci.ub sav$pred.pi.lb <- tmp$pi.lb sav$pred.pi.ub <- tmp$pi.ub } if (blup) { # note: already removed NAs and subsetted tmp <- blup(res) sav$blup <- tmp$pred sav$blup.se <- tmp$se sav$blup.pi.lb <- tmp$pi.lb sav$blup.pi.ub <- tmp$pi.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() 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() 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, decreasing=obj$decreasing, 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() 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.r0000644000176200001440000000452214515471034015112 0ustar liggesusersprint.regtest <- function(x, digits=x$digits, ret.fit=x$ret.fit, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000002743314530173441015365 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() 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 annosym <- .chkddd(ddd$annosym, .getfromenv("forest", "annosym", default=NULL)) 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).")) lcol <- .chkddd(ddd$lcol, .coladj(par("fg"), dark=-0.3, light=0.3)) 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.")) 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 textpos <- .chkddd(ddd$textpos, .getfromenv("forest", "textpos", default=xlim)) 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.r0000644000176200001440000000454014530173271014513 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() .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 pi.type <- .chkddd(ddd$pi.type, "default") 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.r0000644000176200001440000006513214601245626014172 0ustar liggesusersanova.rma <- function(object, object2, btt, X, att, Z, rhs, digits, refit=FALSE, ...) { mstyle <- .get.mstyle() .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 fixed <- .chkddd(ddd$fixed, FALSE, .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.")) #mf <- match.call() #if (any(grepl("pairwise(", as.character(mf), fixed=TRUE))) # try(assign("pairwise", object, envir=.metafor), silent=TRUE) 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'."), call.=FALSE) 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'.")) test <- .chkddd(ddd$test, "LRT", match.arg(ddd$test, c("LRT", "Wald"))) ### 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."), call.=FALSE) ### 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.r0000644000176200001440000000225714515470703015470 0ustar liggesusersmodel.matrix.rma <- function(object, asdf=FALSE, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000370414515470310016142 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() .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.r0000644000176200001440000002331314601245451014122 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() .chkclass(class(x), must="rma", notav=c("rma.mv", "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 <- .chkddd(ddd$addyi, TRUE) addvi <- .chkddd(ddd$addvi, TRUE) ### 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 (if vectors) must be of 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) ### 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.r0000644000176200001440000001222414515470327014330 0ustar liggesusersbaujat.rma <- function(x, xlim, ylim, xlab, ylab, cex, symbol="ids", grid=TRUE, progbar=FALSE, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000002432614551524306015175 0ustar liggesusersrobust.rma.uni <- function(x, cluster, adjust=TRUE, clubSandwich=FALSE, digits, ...) { mstyle <- .get.mstyle() .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 must be of 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 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 ddd$vcov <- .chkddd(ddd$vcov, "CR2", match.arg(ddd$vcov, c("CR0", "CR1", "CR1p", "CR1S", "CR2", "CR3"))) ddd$coef_test <- .chkddd(ddd$coef_test, "Satterthwaite", 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")) } ddd$wald_test <- .chkddd(ddd$wald_test, "HTZ", 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)."), call.=FALSE) 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."), call.=FALSE) 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.r0000644000176200001440000000220014515470452013735 0ustar liggesusersdfround <- function(x, digits, drop0=TRUE) { mstyle <- .get.mstyle() 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.r0000644000176200001440000011466614601244753014027 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() ### 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","SMN","MNLN","CVLN","SDLN", # mean, single-group standardized mean, log(mean), log(CV), log(SD), "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","SMN","MNLN"))) { 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","SMN","MNLN"))) { ### 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.r0000644000176200001440000000736414530157643014150 0ustar liggesusersranktest <- function(x, vi, sei, subset, data, digits, ...) { ######################################################################### mstyle <- .get.mstyle() 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")) exact <- .chkddd(ddd$exact, TRUE) ######################################################################### ### 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.r0000644000176200001440000000303714515470462014725 0ustar liggesusersfitstats.rma <- function(object, ..., REML) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000705214601243772013142 0ustar liggesusers.onAttach <- function(libname, pkgname) { ver <- "4.6-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.r0000644000176200001440000000726114515471275014047 0ustar liggesusersvcov.rma <- function(object, type="fixed", ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000321614515472470013433 0ustar liggesuserssetmfopt <- function(...) { mstyle <- .get.mstyle() 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.null(newopts[[opt]]) && !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.logical(newopts[[opt]]) && !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.null(newopts[[opt]]) && !is.character(newopts[[opt]])) stop(mstyle$stop("'fg' must be a character string.")) if (opt == "bg" && !is.null(newopts[[opt]]) && !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.r0000644000176200001440000004470314601245310014632 0ustar liggesusersprint.rma.mv <- function(x, digits, showfit=FALSE, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { mstyle <- .get.mstyle() .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) <- paste0("sigma^2.", seq_along(x$sigma2)) } 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(paste0("tau^2.", seq_along(x$tau2), " "), "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) <- paste0("tau^2.", seq_along(x$g.levels.k), " ") } 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(paste0("rho.", abbreviate(x$g.levels.f[[1]])), "", 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(paste0("gamma^2.", seq_along(x$gamma2), " "), "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) <- paste0("gamma^2.", seq_along(x$h.levels.k), " ") } 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(paste0("phi.", abbreviate(x$h.levels.f[[1]])), "", 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.r0000644000176200001440000001576514515471036015164 0ustar liggesusersprint.rma.glmm <- function(x, digits, showfit=FALSE, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000327114515471017014715 0ustar liggesusersprint.matreg <- function(x, digits=x$digits, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000015331114601245347016045 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() 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() 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() 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.arg, r.arg, 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.arg), exp(v), v.arg) # variances are optimized in log space, so exponentiate if (struct == "CAR") r <- ifelse(is.na(r.arg), plogis(r), r.arg) # 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.arg), exp(r), r.arg) # 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.arg), tanh(r), r.arg) # 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.arg), v, v.arg) r <- ifelse(is.na(r.arg), r, r.arg) 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.arg)] <- v.arg[!is.na(v.arg)] # replace any fixed values r[!is.na(r.arg)] <- r.arg[!is.na(r.arg)] # 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.arg)] <- v.arg[!is.na(v.arg)] # replace any fixed values r[!is.na(r.arg)] <- r.arg[!is.na(r.arg)] # 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.arg, tau2.arg, rho.arg, gamma2.arg, phi.arg, beta.arg, 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() ### only NA values in sigma2.arg, tau2.arg, rho.arg, gamma2.arg, phi.arg should be estimated; otherwise, replace with fixed values if (withS) { vars <- par[seq_len(sigma2s)] if (vctransf) { sigma2 <- ifelse(is.na(sigma2.arg), exp(vars), sigma2.arg) # sigma2 is optimized in log space, so exponentiate } else { sigma2 <- ifelse(is.na(sigma2.arg), vars, sigma2.arg) # 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.arg=tau2.arg, r.arg=rho.arg, 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.arg=tau2.arg, r.arg=rho.arg, 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.arg=gamma2.arg, r.arg=phi.arg, 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.arg=gamma2.arg, r.arg=phi.arg, 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.arg), beta, beta.arg) 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.arg), beta, beta.arg) 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() 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.r0000644000176200001440000002303514515470553013566 0ustar liggesusersmatreg <- function(y, x, R, n, V, cov=FALSE, means, ztor=FALSE, nearpd=FALSE, level=95, digits, ...) { mstyle <- .get.mstyle() 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.r0000644000176200001440000002535114601245374016657 0ustar liggesusers############################################################################ ### c(m) calculation function for bias correction of SMDs or SMCC/SMCRs .cmicalc <- function(mi, correct=TRUE) { ### this can overflow if mi is 'large' (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() 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() 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.r0000644000176200001440000002040114552246461014017 0ustar liggesusersgosh.rma <- function(x, subsets, progbar=TRUE, parallel="no", ncpus=1, cl, ...) { mstyle <- .get.mstyle() .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) } ### add tau as column to het het <- cbind(het, tau=sqrt(het[,"tau2"])) ### 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.r0000644000176200001440000005356214600622473015322 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() .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.")) 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) == 1L) ddd$xlim <- c(0, ddd$xlim) if (length(ddd$xlim) != 2L) stop(mstyle$stop("Argument 'xlim' should be a vector of length 1 or 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.")) } level <- .level(level, stopon100=(type=="pl" && .isTRUE(ddd$extint))) ######################################################################### ######################################################################### ######################################################################### 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.r0000644000176200001440000006656714515471137015541 0ustar liggesusersreporter.rma.uni <- function(x, dir, filename, format="html_document", open=TRUE, digits, forest, funnel, footnotes=FALSE, verbose=TRUE, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000012225014601245515014360 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() .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 efac[efac == 0] <- NA ### 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 pi.type <- .chkddd(ddd$pi.type, "default") decreasing <- .chkddd(ddd$decreasing, FALSE) 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 } top <- .chkddd(ddd$top, 3) if (is.null(ddd$xlabadj)) { xlabadj <- c(NA,NA) } else { xlabadj <- ddd$xlabadj if (length(xlabadj) == 1L) xlabadj <- c(xlabadj, 1-xlabadj) } xlabfont <- .chkddd(ddd$xlabfont, 1) lplot <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) plot(...) labline <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) abline(...) lsegments <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) segments(...) laxis <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) axis(...) lmtext <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) mtext(...) lpolygon <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) polygon(...) ltext <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) text(...) lpoints <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) 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 <- .applyolim(yi, olim) ci.lb <- .applyolim(ci.lb, olim) ci.ub <- .applyolim(ci.ub, olim) pred <- .applyolim(pred, olim) pred.ci.lb <- .applyolim(pred.ci.lb, olim) pred.ci.ub <- .applyolim(pred.ci.ub, olim) } ### 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) if (is.null(ddd$at.lab)) { 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) } } else { at.lab <- ddd$at.lab } ### 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 textpos <- .chkddd(ddd$textpos, xlim) 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 { if (length(ylim) == 1L) { if (x$int.only && addfit) { ylim <- c(ylim, max(rows, na.rm=TRUE)+top) } else { ylim <- c(ylim, 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)) { beta <- .applyolim(beta, olim) beta.ci.lb <- .applyolim(beta.ci.lb, olim) beta.ci.ub <- .applyolim(beta.ci.ub, olim) beta.pi.lb <- .applyolim(beta.pi.lb, olim) beta.pi.ub <- .applyolim(beta.pi.ub, olim) } ### 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], border=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], border=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], border=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], border=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.r0000644000176200001440000005006714551445641015153 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, ...) { mstyle <- .get.mstyle() .chkclass(class(fitted), must="rma.mv") x <- fitted if (anyNA(steps)) stop(mstyle$stop("No missing values allowed in 'steps' argument.")) if (length(steps) >= 2L) { if (missing(xlim)) xlim <- range(steps) stepseq <- TRUE } else { if (steps < 2) stop(mstyle$stop("Argument 'steps' must be >= 2.")) stepseq <- FALSE } 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."), call.=FALSE) ######################################################################### ### 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() == 1L) { # if only the 'null device' is currently open, set mfrow 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)) } ### round and take unique values if (!missing(sigma2) && is.numeric(sigma2)) sigma2 <- unique(round(sigma2)) if (!missing(tau2) && is.numeric(tau2)) tau2 <- unique(round(tau2)) if (!missing(rho) && is.numeric(rho)) rho <- unique(round(rho)) if (!missing(gamma2) && is.numeric(gamma2)) gamma2 <- unique(round(gamma2)) if (!missing(phi) && is.numeric(phi)) phi <- unique(round(phi)) #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) || is.null(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(0.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(0.1, vc*2) } else { vc.lb <- max( 0, vc/4) vc.ub <- max(0.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(0.1, vc*2) } else { vc.lb <- max( 0, vc/4) vc.ub <- max(0.1, vc*4) } } if (comp == "rho") { if (x$struct[1] == "CAR") { vc.lb <- max(0, vc-0.5) vc.ub <- min(0.99999, vc+0.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(-0.99999, vc-0.5) vc.ub <- min( 0.99999, vc+0.5) } } if (comp == "phi") { if (x$struct[2] == "CAR") { vc.lb <- max(0, vc-0.5) vc.ub <- min(0.99999, vc+0.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(-0.99999, vc-0.5) vc.ub <- min( 0.99999, vc+0.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.")) } } if (stepseq) { vcs <- steps } else { 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) #res <- parallel::clusterMap(cl, .profile.rma.mv, vcs, MoreArgs=list(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), .scheduling = "dynamic") } 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) #res <- parallel::clusterMap(cl, .profile.rma.mv, vcs, MoreArgs=list(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))) 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) ######################################################################### maxll <- c(logLik(x)) if (any(lls >= maxll + 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) if (.isTRUE(ddd$exp)) { lls <- exp(lls) maxll <- exp(maxll) } if (missing(ylim)) { if (any(is.finite(lls))) { if (xlim[1] <= vc && xlim[2] >= vc) { ylim <- range(c(maxll,lls[is.finite(lls)]), na.rm=TRUE) } else { ylim <- range(lls[is.finite(lls)], na.rm=TRUE) } } else { ylim <- rep(maxll, 2L) } if (!.isTRUE(ddd$exp)) 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=maxll, xlab=xlab, title=title, exp=ddd$exp) names(sav)[1] <- switch(comp, sigma2="sigma2", tau2="tau2", rho="rho", gamma2="gamma2", phi="phi") class(sav) <- "profile.rma" ######################################################################### if (plot) plot(sav, ...) ######################################################################### 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.r0000644000176200001440000001063714601245433015372 0ustar liggesusersleave1out.rma.mh <- function(x, digits, transf, targs, progbar=FALSE, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000301314515471325015475 0ustar liggesusersweights.rma.peto <- function(object, type="diagonal", ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000002336514576551300015145 0ustar liggesusersprofile.rma.ls <- function(fitted, alpha, xlim, ylim, steps=20, lltol=1e-03, progbar=TRUE, parallel="no", ncpus=1, cl, plot=TRUE, ...) { mstyle <- .get.mstyle() .chkclass(class(fitted), must="rma.ls") x <- fitted if (x$optbeta) stop(mstyle$stop("Profiling not yet implemented for models fitted with 'optbeta=TRUE'.")) if (anyNA(steps)) stop(mstyle$stop("No missing values allowed in 'steps' argument.")) if (length(steps) >= 2L) { if (missing(xlim)) xlim <- range(steps) stepseq <- TRUE } else { if (steps < 2) stop(mstyle$stop("Argument 'steps' must be >= 2.")) stepseq <- FALSE } 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 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() == 1L) { # if only the 'null device' is currently open, set mfrow 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)) } ### round and take unique values if (!missing(alpha) && is.numeric(alpha)) alpha <- unique(round(alpha)) ### 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) || is.null(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(0.995) * x$se.alpha[alpha] vc.ub <- vc + qnorm(0.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.")) ### apply alpha.min/alpha.max limits (if they exist) on vc.lb/vc.ub as well 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) } if (stepseq) { vcs <- steps } else { 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.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) #res <- parallel::clusterMap(cl, .profile.rma.ls, vcs, MoreArgs=list(obj=x, comp=comp, alpha.pos=alpha.pos, parallel=parallel, profile=TRUE), .scheduling = "dynamic") } 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) #res <- parallel::clusterMap(cl, .profile.rma.ls, vcs, MoreArgs=list(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))) 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) ######################################################################### maxll <- c(logLik(x)) if (any(lls >= maxll + 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) if (.isTRUE(ddd$exp)) { lls <- exp(lls) maxll <- exp(maxll) } if (missing(ylim)) { if (any(is.finite(lls))) { if (xlim[1] <= vc && xlim[2] >= vc) { ylim <- range(c(maxll,lls[is.finite(lls)]), na.rm=TRUE) } else { ylim <- range(lls[is.finite(lls)], na.rm=TRUE) } } else { ylim <- rep(maxll, 2L) } if (!.isTRUE(ddd$exp)) 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(alpha=vcs, ll=lls, beta=beta, ci.lb=ci.lb, ci.ub=ci.ub, comps=1, ylim=ylim, method=x$method, vc=vc, maxll=maxll, xlab=xlab, title=title, exp=ddd$exp) class(sav) <- "profile.rma" ######################################################################### if (plot) plot(sav, ...) ######################################################################### 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.r0000644000176200001440000002455514551524264015033 0ustar liggesusersrobust.rma.mv <- function(x, cluster, adjust=TRUE, clubSandwich=FALSE, digits, ...) { mstyle <- .get.mstyle() .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 must be of 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 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 ddd$vcov <- .chkddd(ddd$vcov, "CR2", match.arg(ddd$vcov, c("CR0", "CR1", "CR1p", "CR1S", "CR2", "CR3"))) ddd$coef_test <- .chkddd(ddd$coef_test, "Satterthwaite", 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")) } ddd$wald_test <- .chkddd(ddd$wald_test, "HTZ", 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="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)."), call.=FALSE) 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."), call.=FALSE) 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.r0000644000176200001440000001174414601245501014242 0ustar liggesusershc.rma.uni <- function(object, digits, transf, targs, control, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000220114515470765015655 0ustar liggesusersprint.confint.rma <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000001273714524144637013764 0ustar liggesusersemmprep <- function(x, verbose=FALSE, ...) { mstyle <- .get.mstyle() .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","HR"))) { 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.r0000644000176200001440000003073314567413421015467 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() .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.r0000644000176200001440000030266014601245222013500 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() 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", "retopt")) ### handle 'tdist' argument from ... (note: overrides test argument) if (.isFALSE(ddd$tdist)) test <- "z" if (.isTRUE(ddd$tdist)) test <- "t" test <- tolower(test) if (!is.element(test, c("z", "t", "knha", "hksj", "adhoc"))) stop(mstyle$stop("Invalid option selected for 'test' argument.")) if (test == "hksj") test <- "knha" 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)) { ddd$dist <- list("euclidean", "euclidean") } else { 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.")) } } 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.")), call.=FALSE) } } 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.arg <- rep(NA_real_, p) beta.est <- rep(TRUE, p) } else { beta.arg <- ddd$beta if (length(beta.arg) != p) stop(mstyle$stop(paste0("Length of 'beta' argument (", length(beta.arg), ") does not match actual number of fixed effects (", p, ")."))) beta.est <- is.na(beta.arg) } ######################################################################### ######################################################################### ######################################################################### ### 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.")) 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.arg) 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 <- paste0(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.arg=sigma2, tau2.arg=tau2, rho.arg=rho, gamma2.arg=gamma2, phi.arg=phi, beta.arg=beta.arg, 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") #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) } if (isTRUE(ddd$retopt)) 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.arg <- sigma2 tau2.arg <- tau2 rho.arg <- rho gamma2.arg <- gamma2 phi.arg <- 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.arg=sigma2, tau2.arg=tau2, rho.arg=rho, gamma2.arg=gamma2, phi.arg=phi, beta.arg=beta.arg, 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 the 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.arg=sigma2.arg, tau2.arg=tau2.arg, rho.arg=rho.arg, gamma2.arg=gamma2.arg, phi.arg=phi.arg, beta.arg=beta.arg, 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.arg=sigma2.arg, tau2.arg=tau2.arg, rho.arg=rho.arg, gamma2.arg=gamma2.arg, phi.arg=phi.arg, beta.arg=beta.arg, 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.arg=sigma2.arg, tau2.arg=tau2.arg, rho.arg=rho.arg, gamma2.arg=gamma2.arg, phi.arg=phi.arg, beta.arg=beta.arg, 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.arg=sigma2.arg, tau2.arg=tau2.arg, rho.arg=rho.arg, gamma2.arg=gamma2.arg, phi.arg=phi.arg, beta.arg=beta.arg, 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] <- paste0("sigma^2.", seq_len(sigma2s)) } if (tau2s == 1) { colnames(hessian)[sigma2s+1] <- "tau^2" } else { colnames(hessian)[(sigma2s+1):(sigma2s+tau2s)] <- paste0("tau^2.", seq_len(tau2s)) } 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)] <- paste0(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))]) #colnames(hessian)[(sigma2s+tau2s+1):(sigma2s+tau2s+rhos)] <- paste0(term, ".", seq_len(rhos)) } if (gamma2s == 1) { colnames(hessian)[sigma2s+tau2s+rhos+1] <- "gamma^2" } else { colnames(hessian)[(sigma2s+tau2s+rhos+1):(sigma2s+tau2s+rhos+gamma2s)] <- paste0("gamma^2.", seq_len(gamma2s)) } 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)] <- paste0(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))]) #colnames(hessian)[(sigma2s+tau2s+rhos+gamma2s+1):(sigma2s+tau2s+rhos+gamma2s+phis)] <- paste0(term, ".", seq_len(phis)) } 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.r0000644000176200001440000012641214601244733013665 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() ### 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","SMN","MNLN","CVLN","SDLN", # mean, single-group standardized mean, log(mean), log(CV), log(SD), "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","SMN","MNLN"))) { 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","SMN","MNLN"))) { ### 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.r0000644000176200001440000002017414576275240016224 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() 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() 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() ### 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.arg, beta.arg, verbose, digits, REMLf, link, mZ, alpha.min, alpha.max, alpha.transf, tau2.min, tau2.max, optbeta) { mstyle <- .get.mstyle() if (optbeta) { beta <- par[seq_len(pX)] beta <- ifelse(is.na(beta.arg), beta, beta.arg) 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.arg), alpha, alpha.arg) ### 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.arg, beta.arg, 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.arg), alpha, alpha.arg) tau2 <- c(Z %*% alpha) return(tau2) } .rma.ls.ineqfun.neg <- function(par, yi, vi, X, Z, reml, k, pX, alpha.arg, beta.arg, 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.arg), alpha, alpha.arg) tau2 <- -c(Z %*% alpha) return(tau2) } ############################################################################ metafor/R/contrmat.r0000644000176200001440000001034414515470404014130 0ustar liggesuserscontrmat <- function(data, grp1, grp2, last, shorten=FALSE, minlen=2, check=TRUE, append=TRUE) { mstyle <- .get.mstyle() 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.r0000644000176200001440000006671114530160033014511 0ustar liggesuserspredict.rma <- function(object, newmods, intercept, tau2.levels, gamma2.levels, addx=FALSE, level, digits, transf, targs, vcov=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle() .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")) pi.type <- .chkddd(ddd$pi.type, "default", tolower(ddd$pi.type)) if (x$int.only && !is.null(newmods)) stop(mstyle$stop("Cannot specify new moderator values for models without moderators.")) rnames <- NULL ######################################################################### ### 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)) # if (.is.vector(newmods)) { # rnames <- names(newmods) # } else { # rnames <- rownames(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) # if (inherits(newmods, "matrix")) # rnames <- rownames(newmods) # } else { # # if user gives multiple rows and columns (multiple k.new): k.new <- nrow(newmods) # X.new <- cbind(newmods) # rnames <- rownames(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."))) 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."))) 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) if (!is.null(rnames)) slab <- rnames } ### 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 && is.null(rnames)) 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.r0000644000176200001440000000402414515471045015161 0ustar liggesusersprint.rma.peto <- function(x, digits, showfit=FALSE, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000374114572304527014712 0ustar liggesuserssimulate.rma <- function(object, nsim=1, seed=NULL, olim, ...) { mstyle <- .get.mstyle() .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 <- .applyolim(val, olim) } ######################################################################### 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.r0000644000176200001440000003340414530154165013076 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() 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")) correct <- .chkddd(ddd$correct, FALSE) rel.tol <- .chkddd(ddd$rel.tol, .Machine$double.eps^0.25) subdivisions <- .chkddd(ddd$subdivisions, 100L) tau2.lb <- .chkddd(ddd$tau2.lb, 0) # 0.0001 find.lim <- .chkddd(ddd$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.r0000644000176200001440000005477514554440124014365 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() .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 <- .coladj(par("bg","fg"), dark=c(0,-0.8), light=c(0,1)) 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 (if vectors) must be of 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 (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, at.lab) plot(...) labline <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) abline(...) lsegments <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) segments(...) laxis <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) axis(...) lpolygon <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) polygon(...) llines <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) lines(...) lpoints <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) points(...) lrect <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) rect(...) ltext <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) text(...) ### refline2, level2, and lty2 for adding a second reference line / funnel refline2 <- ddd$refline2 level2 <- .chkddd(ddd$level2, x$level) lty2 <- .chkddd(ddd$lty2, 3) ### number of y-axis values at which to calculate the bounds of the pseudo confidence interval ci.res <- .chkddd(ddd$ci.res, 1000) ### to adjust color of reference line, region bounds, and the L box colref <- .chkddd(ddd$colref, .coladj(par("bg","fg"), dark=0.6, light=-0.6)) colci <- .chkddd(ddd$colci, .coladj(par("bg","fg"), dark=0.6, light=-0.6)) colbox <- .chkddd(ddd$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 <- .level(level, allow.vector=TRUE) # note: there may be multiple level values level2 <- .level(level2) 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], ...) } ######################################################################### ### 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]] } if (is.null(ddd$at.lab)) { 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) } } else { at.lab <- ddd$at.lab } ### add x-axis laxis(side=1, at=at, labels=at.lab, ...) ### add L-shaped box around plot if (!is.na(colbox)) box(bty="l", col=colbox) ############################################################################ ### 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.r0000644000176200001440000000031414515470346014474 0ustar liggesuserscoef.matreg <- function(object, ...) { mstyle <- .get.mstyle() .chkclass(class(object), must="matreg") coefs <- c(object$tab$beta) names(coefs) <- rownames(object$tab) return(coefs) } metafor/R/print.anova.rma.r0000644000176200001440000001433114540541707015321 0ustar liggesusersprint.anova.rma <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000001224014601245537015152 0ustar liggesuserscumul.rma.peto <- function(x, order, digits, transf, targs, progbar=FALSE, ...) { mstyle <- .get.mstyle() .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() decreasing <- .chkddd(ddd$decreasing, FALSE) ######################################################################### 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 must be of the same length as the original dataset ### so we have to 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.r0000644000176200001440000000126014515471012016615 0ustar liggesusersprint.list.confint.rma <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000002300414601245762014313 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() .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.r0000644000176200001440000000063514515471243015260 0ustar liggesuserssummary.matreg <- function(object, digits, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000001023314515470745014634 0ustar liggesusersplot.rma.uni <- function(x, qqplot=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle() .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.r0000644000176200001440000002306614601245234014575 0ustar liggesusersranef.rma.mv <- function(object, level, digits, transf, targs, verbose=FALSE, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000460514601245051015672 0ustar liggesusersrstudent.rma.peto <- function(model, digits, progbar=FALSE, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000166714515471135014151 0ustar liggesusersreplmiss <- function(x, y, data) { mstyle <- .get.mstyle() ### 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.r0000644000176200001440000001233314530173476014475 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(...) width <- .chkddd(ddd$addwidth, NULL, digits + ddd$addwidth) drop0ifint <- .chkddd(ddd$drop0ifint, FALSE) add0 <- .chkddd(ddd$add0, TRUE) 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 } postfix <- .chkddd(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(...) flag <- .chkddd(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.r0000644000176200001440000000704514552421204015473 0ustar liggesusersplot.profile.rma <- function(x, xlim, ylim, pch=19, xlab, ylab, main, refline=TRUE, cline=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle() .chkclass(class(x), must="profile.rma") .start.plot() if (dev.cur() == 1L) { # if only the 'null device' is currently open, set mfrow 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, sqrt, exp, pred, blup) plot(...) lpoints <- function(..., time, LB, startmethod, sub1, log, sqrt, exp, pred, blup) 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) { if (isTRUE(x$exp)) { ylab <- paste0(ifelse(x$method=="REML", "Restricted ", ""), "Likelihood") } else { ylab <- paste0(ifelse(x$method=="REML", "Restricted ", ""), "Log-Likelihood") } } if (missing.main) main <- x$title ### add the actual vc value to the profile 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 (isTRUE(cline)) cline <- 0.05 if (is.numeric(cline)) { cline <- .level(cline, argname="cline") if (isTRUE(x$exp)) { hval <- exp(log(x$maxll) - qchisq(1-cline, df=1)/2) } else { hval <- x$maxll - qchisq(1-cline, df=1)/2 } abline(h=hval, 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) { if (isTRUE(x$exp)) { ylab <- paste0(ifelse(x$method=="REML", "Restricted ", ""), "Likelihood") } else { ylab <- paste0(ifelse(x$method=="REML", "Restricted ", ""), "Log-Likelihood") } } 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.r0000644000176200001440000000646014527114030014610 0ustar liggesusersblup.rma.uni <- function(x, level, digits, transf, targs, ...) { mstyle <- .get.mstyle() .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 if (length(x$tau2.f) == 1L) x$tau2.f <- rep(x$tau2.f, length(x$yi.f)) li <- ifelse(is.infinite(x$tau2.f), 1, 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 if (li[i] == 1) { vpred[i] <- li[i] * x$vi.f[i] } else { 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.r0000644000176200001440000001052514515470542015562 0ustar liggesusersleave1out.rma.uni <- function(x, digits, transf, targs, progbar=FALSE, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000021363714601245747015440 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() 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.old <- function(x, y) { # # 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) # #} .psort <- function(x, y, as.list=FALSE) { # simpler / vectorized version that also deals with x and y being matrices # (of the same dimensions) for elementwise swapping of pairs as needed # 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)) { y <- x[,2] x <- x[,1] } else { y <- x[2] x <- x[1] } } flip <- x > y flip[is.na(flip)] <- FALSE x.flip <- x y.flip <- y x.flip[flip] <- y[flip] y.flip[flip] <- x[flip] if (as.list) { return(list(x=x.flip, y=y.flip)) } else { return(cbind(x.flip, y.flip)) } } ############################################################################ ### function for applying observation limits .applyolim <- function(x, olim) { x[x < olim[1]] <- olim[1] x[x > olim[2]] <- olim[2] return(x) } ############################################################################ ### 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) } ### sapply()-like function but for matrices that always preserves the matrix dimensions (used in traceplot.rma.uni()) .matapply <- function(x, FUN, targs=NULL) { if (is.null(x)) return(NULL) if (is.null(targs)) { x[] <- sapply(x, FUN) } else { x[] <- sapply(x, FUN, targs) } return(x) } ### check if ddd element is NULL; if so, return ifnull, otherwise the ddd element or ifnot .chkddd <- function(x, ifnull=NULL, ifnot=NULL) { if (is.null(x)) { return(ifnull) } else { if (is.null(ifnot)) { return(x) } else { return(ifnot) } } } ############################################################################ ### 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, argname="level", stopon100=FALSE) { mstyle <- .get.mstyle() if (any(level > 100) || any(level < 0)) stop(mstyle$stop(paste0("Argument '", argname, "' must be between 0 and 100.")), call.=FALSE) if (isTRUE(stopon100) && any(level==100)) stop(mstyle$stop(paste0("Argument '", argname, "' cannot be equal to 100.")), call.=FALSE) if (!allow.vector && length(level) != 1L) stop(mstyle$stop(paste0("Argument '", argname, "' must specify a single value.")), call.=FALSE) if (!is.numeric(level)) stop(mstyle$stop(paste0("The '", argname, "' 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() 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() 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() 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() 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() warning(mstyle$warning(paste0("The 'vi' argument should be used to specify 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 == "SMN") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Std. Mean", "Standardized Mean") } else { lab <- ifelse(short, lab, "Transformed Standardized 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 == "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","SMCRP","SMCRPH"))) { 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") } } ###################################################################### if (measure == "HR") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "Log[HR]", "Log Hazard Ratio") } else { lab <- ifelse(short, lab, "Transformed Log Hazard Ratio") funlist <- lapply(list(exp, transf.exp.int), deparse) if (any(sapply(funlist, identical, atransf.char))) lab <- ifelse(short, "HR", "Hazard Ratio (log scale)") if (any(sapply(funlist, identical, transf.char))) lab <- ifelse(short, "HR", "Hazard Ratio") } } if (measure == "HD") { if (identical(transf.char, "FALSE") && identical(atransf.char, "FALSE")) { lab <- ifelse(short, "HD", "Hazard Difference") } else { lab <- ifelse(short, lab, "Transformed Hazard Difference") } } ###################################################################### } return(lab) } ############################################################################ ### stuff related to colored/styled output .get.mstyle <- function() { crayonloaded <- "crayon" %in% .packages() styleopt <- getmfopt("style") if (is.logical(styleopt)) { if (isTRUE(styleopt)) { styleopt <- NULL } else { crayonloaded <- FALSE } } if (crayonloaded) { if (exists(".mstyle")) { .mstyle <- get(".mstyle") } else { .mstyle <- list() } 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() 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() 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, ineq=FALSE) { mstyle <- .get.mstyle() ### set NLOPT_LN_BOBYQA as the default algorithm for the nloptr optimizer when ineq=FALSE ### and otherwise use NLOPT_LN_COBYLA to allow for nonlinear inequality constraints ### and by default use a relative convergence criterion of 1e-8 on the function value if (optimizer == "nloptr" && !is.element("algorithm", names(optcontrol))) { if (ineq) { optcontrol$algorithm <- "NLOPT_LN_COBYLA" } else { 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(optimizer, quietly=TRUE)) stop(mstyle$stop(paste0("Please install the '", optimizer, "' package to use this optimizer.")), call.=FALSE) } if (optimizer == "Rvmmin") { 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("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() 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.r0000644000176200001440000026414414570361252013545 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() 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", # 2x2 table transformations to SMDs "MPRD","MPRR","MPOR","MPORC","MPPETO","MPORM", # 2x2 table measures for matched pairs / pre-post data "IRR","IRD","IRSD", # two-group person-time data (incidence) 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", # two-group mean/SD 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 / R^2 (raw and r-to-z transformed) "PR","PLN","PLO","PAS","PFT", # single proportions (and transformations thereof) "IR","IRLN","IRS","IRFT", # single-group person-time (incidence) data (and transformations thereof) "MN","SMN","MNLN","CVLN","SDLN", # mean, single-group standardized mean, log(mean), log(CV), log(SD), "MC","SMCC","SMCR","SMCRH","SMCRP","SMCRPH","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 "HR","HD", # hazard (rate) ratios and differences "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 <- .chkddd(ddd$onlyo1, FALSE, .isTRUE(ddd$onlyo1)) addyi <- .chkddd(ddd$addyi, TRUE, .isTRUE(ddd$addyi)) addvi <- .chkddd(ddd$addvi, TRUE, .isTRUE(ddd$addvi)) correct <- .chkddd(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 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, 1912, p.603 } } } ### Yule's Q 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, 1900, p.285; Yule, 1912, p.593 } ### Yule's Y 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) # Yule, 1912, p.593 } ### 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 # Sanchez-Meca et al., 2003, equation 21; 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 # same as x1i/t1i^2 + x2i/t2i^2 } else { vi <- ir1i.u/t1i + ir2i.u/t2i # 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 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("LS","UB","HO")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'LS', 'UB', 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 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("LS","LS2","UB","AV")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'LS', 'LS2', 'UB', or 'AV'.")) for (i in seq_len(k)) { ### 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]) # Hedges, 1982c, equation 8; Hedges & Olkin, 1985, equation 15; see [a] ### alternative large sample approximation to the sampling variance if (vtype[i] == "LS2") vi[i] <- cmi[i]^2 * (1/n1i[i] + 1/n2i[i] + di[i]^2/(2*npi[i])) # Borenstein, 2009, equation 12.17; analogous to LS2 for SMCC and SMCR; see [b] ### 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 # Hedges, 1983b, equation 9; see [c] ### estimate assuming homogeneity (using the 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]) } } ### standardized mean difference (with heteroscedastic SDs) if (measure == "SMDH") { cmi <- .cmicalc(mi, correct=correct) sdpi <- sqrt((sd1i^2 + sd2i^2)/2) di <- (m1i - m2i) / sdpi 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] <- yi[i]^2 * (sd1i[i]^4 / (n1i[i]-1) + sd2i[i]^4 / (n2i[i]-1)) / (8*sdpi[i]^4) + (sd1i[i]^2 / (n1i[i]-1) + sd2i[i]^2 / (n2i[i]-1)) / sdpi[i]^2 # Bonett, 2008a, equation 8; Bonett, 2009, equation 5 # note: Bonett (2008a) plugs the uncorrected yi into the equation for vi; here, the corrected value is plugged in for consistency with [a] #vi[i] <- cmi[i]^2 * vi[i] } ### alternative large sample approximation (replace n1i-1 and n2i-1 with n1i and n2i) if (vtype[i] == "LS2") { #vi[i] <- sd1i[i]^2 / (n1i[i] * sdpi[i]^2) + sd2i[i]^2 / (n2i[i] * sdpi[i]^2) + yi[i]^2 / (8 * sdpi[i]^4) * (sd1i[i]^4 / (n1i[i]-1) + sd2i[i]^4 / (n2i[i]-1)) # based on standard application of the delta method #vi[i] <- sd1i[i]^2 / ((n1i[i]-1) * sdpi[i]^2) + sd2i[i]^2 / ((n2i[i]-1) * sdpi[i]^2) + yi[i]^2 / (8 * sdpi[i]^4) * (sd1i[i]^4 / (n1i[i]-1) + sd2i[i]^4 / (n2i[i]-1)) # same as Bonett vi[i] <- sd1i[i]^2 / (n1i[i] * sdpi[i]^2) + sd2i[i]^2 / (n2i[i] * sdpi[i]^2) + yi[i]^2 / (8 * sdpi[i]^4) * (sd1i[i]^4 / n1i[i] + sd2i[i]^4 / n2i[i]) } } } ### 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) + 1/(n2i-1) + yi^2/(2*(n2i-1)) # Bonett, 2008a, equation 12 #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("LS","ST","CS")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'LS', 'ST', 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])) # Tate, 1954; Tate, 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) # 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) # Tate, 1955; equivalent to equation 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 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) # Nakagawa et al., 2015, equation 12, but without the '-2 rho ...' terms } ### 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" && any(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("LS","UB","AV")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'LS', 'UB', 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]-1) ### 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)) } ### 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) ### coefficients of determination (R^2 values) 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] # Kendall & Stuart, 1979, equation 27.88 ### estimate assuming homogeneity (using sample size weighted average of the yi's) if (vtype[i] == "AV") vi[i] <- 4 * mnwyi * (1 - mnwyi)^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)) # Kendall & Stuart, 1979, equation 27.87 ### estimate assuming homogeneity (using sample size weighted average of the yi's) if (vtype[i] == "AV2") vi[i] <- 4 * mnwyi * (1 - mnwyi)^2 * (ni[i] - mi[i] - 1)^2 / ((ni[i]^2 - 1) * (ni[i] + 3)) } } ### r-to-z transformed coefficients of determination if (measure == "ZR2") { yi <- transf.rtoz(sqrt(r2i)) vi <- 1 / ni # Olkin & Finn, 1995, p.162, but var(z*) is 4/n, not 16/n and here we use the 1/2 factor, so 1/n is correct } } ###################################################################### 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("LS","UB","AV")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'LS', 'UB', or 'AV'.")) for (i in seq_len(k)) { ### 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] } } ### 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) } } ### 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 # same as xi/ti^2 } else { vi <- iri.u / ti # 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","SMN","MNLN","CVLN","SDLN"))) { 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","SMN","MNLN","CVLN"))) { 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)) { ### unbiased estimate of the sampling variance if (vtype[i] == "LS") vi[i] <- sdi[i]^2 / ni[i] ### estimate assuming homoscedasticity of the variances across studies if (vtype[i] == "HO") vi[i] <- sdpi^2 / ni[i] } } ### single-group standardized mean if (measure == "SMN") { cmi <- .cmicalc(ni-1) yi <- cmi * mi / sdi vi <- 1 / ni + yi^2 / (2*ni) } ### log(mean) if (measure == "MNLN") { yi <- log(mi) vi <- sdi^2 / (ni*mi^2) } ### log(CV) with bias correction 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) # Nakagawa et al., 2015, but without the '-2 rho ...' term } ### 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)) } } ###################################################################### if (is.element(measure, c("MC","SMCC","SMCR","SMCRH","SMCRP","SMCRPH","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","SMCRP","SMCRPH","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","SMCRP","SMCRPH","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 sddiffi <- sqrt(sd1i^2 + sd2i^2 - 2*ri*sd1i*sd2i) # SD of the change scores sdpi <- sqrt((sd1i^2+sd2i^2)/2) # pooled SD ### (raw) mean change if (measure == "MC") { yi <- m1i - m2i vi <- sddiffi^2 / 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) di <- (m1i - m2i) / sddiffi yi <- cmi * di if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) if (!all(is.element(vtype, c("LS","LS2","UB")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be either 'LS', 'LS2', or 'UB'.")) 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]) # Gibbons et al., 1993, equation 21, but using ni instead of ni-1; see [a] ### alternative large sample approximation to the sampling variance if (vtype[i] == "LS2") vi[i] <- cmi[i]^2 * (1/ni[i] + di[i]^2 / (2*ni[i])) # analogous to LS2 for SMD and SMCR; see [b] ### unbiased estimate of the sampling variance if (vtype[i] == "UB") vi[i] <- 1/ni[i] + (1 - (mi[i]-2)/(mi[i]*cmi[i]^2)) * yi[i]^2 # Viechtbauer, 2007d, equation 26; see [c] } } ### standardized mean change with raw score standardization (using sd1i) 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]) # Becker, 1988a, equation 13 ### alternative large sample approximation to the sampling variance if (vtype[i] == "LS2") vi[i] <- cmi[i]^2 * (2*(1-ri[i])/ni[i] + di[i]^2 / (2*ni[i])) # corrected (!) equation from Borenstein et al., 2009; analogous to LS2 for SMD and SMCC; see [b] #vi[i] <- cmi[i]^2 * 2 * (1-ri[i]) * (1/ni[i] + di[i]^2 / (2*ni[i])) # Borenstein, 2009, equation 4.28 (with J^2 multiplier) but this is incorrect ### unbiased estimate of the sampling variance if (vtype[i] == "UB") { rui[i] <- ri[i] * .Fcalc(1/2, 1/2, (ni[i]-2)/2, 1-ri[i]^2) # NA when ni <= 4 vi[i] <- 2*(1-rui[i])/ni[i] + (1 - (mi[i]-2)/(mi[i]*cmi[i]^2)) * yi[i]^2 # Viechtbauer, 2007d, equation 37; see [c] } } } ### standardized mean change with raw score standardization (using sd1i) allowing for heteroscedasticity if (measure == "SMCRH") { 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] <- sddiffi[i]^2/(sd1i[i]^2*(ni[i]-1)) + yi[i]^2 / (2*(ni[i]-1)) # Bonett, 2008a, equation 13 # note: Bonett (2008a) plugs the uncorrected yi into the equation for vi; here, the corrected value is plugged in for consistency with [a] #vi <- cmi^2 * vi } ### alternative large sample approximation (replace ni-1 with ni) if (vtype[i] == "LS2") vi[i] <- sddiffi[i]^2/(sd1i[i]^2*ni[i]) + yi[i]^2 / (2*ni[i]) } } ### standardized mean change with raw score standardization (using (sd1i+sd2i)/2)) if (measure == "SMCRP") { mi <- 2*(ni-1) / (1 + ri^2) cmi <- .cmicalc(mi, correct=correct) di <- (m1i - m2i) / sdpi yi <- cmi * di if (length(vtype) == 1L) vtype <- rep(vtype, k) vi <- rep(NA_real_, k) if (!all(is.element(vtype, c("LS")))) stop(mstyle$stop("For this outcome measure, 'vtype' must be 'LS'.")) 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 * (1 + ri[i]^2) / (4*ni[i]) # follows from Cousineau, 2020, equation 2 } } ### standardized mean change with raw score standardization (using (sd1i+sd2i)/2)) allowing for heteroscedasticity if (measure == "SMCRPH") { mi <- 2*(ni-1) / (1 + ri^2) cmi <- .cmicalc(mi, correct=correct) di <- (m1i - m2i) / sdpi 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 'LS' or 'LS2'.")) for (i in seq_len(k)) { ### large sample approximation to the sampling variance if (vtype[i] == "LS") vi[i] <- sddiffi[i]^2 / (sdpi[i]^2 * (ni[i]-1)) + yi[i]^2 * (sd1i[i]^4 + sd2i[i]^4 + 2*ri[i]^2*sd1i[i]^2*sd2i[i]^2) / (8 * sdpi[i]^4 * (ni[i]-1)) # Bonett, 2008a, equation 10 ### alternative large sample approximation to the sampling variance (replace ni-1 with ni) if (vtype[i] == "LS2") vi[i] <- sddiffi[i]^2 / (sdpi[i]^2 * ni[i]) + yi[i]^2 * (sd1i[i]^4 + sd2i[i]^4 + 2*ri[i]^2*sd1i[i]^2*sd2i[i]^2) / (8 * sdpi[i]^4 * ni[i]) } } ### 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 [z]) 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) # [z] 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.r0000644000176200001440000000062414515471246014561 0ustar liggesuserssummary.rma <- function(object, digits, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000407614515470743015016 0ustar liggesusersplot.rma.peto <- function(x, qqplot=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle() .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.r0000644000176200001440000000101714515471031015261 0ustar liggesusersprint.ranktest <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000002544114552250740015000 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() .chkclass(class(x), must="gosh.rma") het <- match.arg(het, c("QE", "I2", "I^2", "H2", "H^2", "tau2", "tau^2", "tau")) het <- sub("^", "", het, fixed=TRUE) if (is.element(het, c("tau2","tau")) && 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[,7: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 (het == "tau") labels <- expression(tau) 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(6)]) } } ######################################################################### 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[,"estimate"], 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[,"estimate"], 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,"estimate"], breaks=hx$breaks, plot=FALSE) hx.i <- hist(x$res[!isout,"estimate"], 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,"estimate"], adjust=adjust[1], na.rm=TRUE) d.i <- density(x$res[!isout,"estimate"], 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[,"estimate"], 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[,7:ncol(x$res)]) lpairs(X, pch=pch, cex=cex, diag.panel=panel.hist, col=col.pnts, labels=labels, ...) } ######################################################################### } metafor/R/fsn.r0000644000176200001440000003070414530150210013054 0ustar liggesusersfsn <- function(x, vi, sei, subset, data, type, alpha=.05, target, method, exact=FALSE, verbose=FALSE, digits, ...) { ######################################################################### mstyle <- .get.mstyle() 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")) pool <- .chkddd(ddd$pool, "stouffer", match.arg(tolower(ddd$pool), c("stouffer", "fisher"))) mumiss <- .chkddd(ddd$mumiss, 0) # note: default interval set below; see [a] (based on k) maxint <- .chkddd(ddd$maxint, 10^7) tol <- .chkddd(ddd$tol, .Machine$double.eps^0.25) maxiter <- .chkddd(ddd$maxiter, 1000) ### 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] interval <- .chkddd(ddd$interval, c(0,k*50)) ######################################################################### 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).")) 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.r0000644000176200001440000000251214515470465014343 0ustar liggesusersfitted.rma <- function(object, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000734014601245323015163 0ustar liggesusersprint.list.rma <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000213014515470340013743 0ustar liggesusersblsplit <- function(x, cluster, fun, args, sort=FALSE) { mstyle <- .get.mstyle() 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.r0000644000176200001440000000222414515470332013452 0ustar liggesusersBIC.rma <- function(object, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000025714515470361015456 0ustar liggesusersconfint.rma.glmm <- function(object, parm, level, digits, transf, targs, ...) { mstyle <- .get.mstyle() .chkclass(class(object), must="rma.glmm", notav="rma.glmm") } metafor/R/cumul.rma.mh.r0000644000176200001440000001330414601245532014604 0ustar liggesuserscumul.rma.mh <- function(x, order, digits, transf, targs, progbar=FALSE, ...) { mstyle <- .get.mstyle() .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() decreasing <- .chkddd(ddd$decreasing, FALSE) ######################################################################### 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 must be of the same length as the original dataset ### so we have to 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.r0000644000176200001440000000022614515471273014537 0ustar liggesusersvcov.matreg <- function(object, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000020014515471100015307 0ustar liggesusersqqnorm.rma.glmm <- function(y, ...) { mstyle <- .get.mstyle() .chkclass(class(y), must="rma.glmm", notav="rma.glmm") } metafor/R/print.permutest.rma.uni.r0000644000176200001440000001461014515471022017031 0ustar liggesusersprint.permutest.rma.uni <- function(x, digits=x$digits, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000002466314530157546013404 0ustar liggesusersrcalc <- function(x, ni, data, rtoz=FALSE, nfun="min", sparse=FALSE, ...) { mstyle <- .get.mstyle() 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")) upper <- .chkddd(ddd$upper, FALSE) simplify <- .chkddd(ddd$simplify, TRUE) 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.r0000644000176200001440000000412314515470770014672 0ustar liggesusersprint.escalc <- function(x, digits=attr(x,"digits"), ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000312614515471327015330 0ustar liggesusersweights.rma.uni <- function(object, type="diagonal", ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000004230214550231165013366 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() ############################################################################ 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 rows."))) ### construct R matrix based on rvars R <- list() for (i in seq_len(n)) { x <- rvars[cluster == ucluster[i],] x <- x[seq_len(nrow(x))] if (anyNA(x[lower.tri(x, diag=TRUE)])) warning(mstyle$warning(paste0("There are missing values in 'rvals' for cluster ", ucluster[i], ".")), call.=FALSE) x[upper.tri(x)] <- t(x)[upper.tri(x)] R[[i]] <- as.matrix(x) } names(R) <- ucluster #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) R <- bldiag(R) 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 vi <- as.vector(vi) S <- Diagonal(k, sqrt(vi)) V <- S %*% R %*% S if (!sparse) V <- as.matrix(V) 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.r0000644000176200001440000007717514572304106015243 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() 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) efac[efac == 0] <- NA ### 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 decreasing <- .chkddd(ddd$decreasing, FALSE) 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 } top <- .chkddd(ddd$top, 3) if (is.null(ddd$xlabadj)) { xlabadj <- c(NA,NA) } else { xlabadj <- ddd$xlabadj if (length(xlabadj) == 1L) xlabadj <- c(xlabadj, 1-xlabadj) } xlabfont <- .chkddd(ddd$xlabfont, 1) lplot <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) plot(...) labline <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) abline(...) lsegments <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) segments(...) laxis <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) axis(...) lmtext <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) mtext(...) lpolygon <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) polygon(...) ltext <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) text(...) lpoints <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) 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.")) 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 <- .applyolim(yi, olim) ci.lb <- .applyolim(ci.lb, olim) ci.ub <- .applyolim(ci.ub, olim) } 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) if (is.null(ddd$at.lab)) { 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) } } else { at.lab <- ddd$at.lab } ### 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 textpos <- .chkddd(ddd$textpos, xlim) 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 { if (length(ylim) == 1L) { ylim <- c(ylim, 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("%", 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]) 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.r0000644000176200001440000001564714515470410013670 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() 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.r0000644000176200001440000002247314530160660015624 0ustar liggesusersinfluence.rma.uni <- function(model, digits, progbar=FALSE, ...) { mstyle <- .get.mstyle() .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)) # note: 1:p by default (also in models with intercept) m <- length(btt) measure <- .chkddd(ddd$measure, "all") 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 #cook.d[i] <- sum(1/(x$vi+x$tau2) * (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.r0000644000176200001440000001753314530157262013766 0ustar liggesusersregtest <- function(x, vi, sei, ni, subset, data, model="rma", predictor="sei", ret.fit=FALSE, digits, ...) { ######################################################################### mstyle <- .get.mstyle() 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 } level <- .chkddd(ddd$level, x$level, .level(ddd$level)) method <- .chkddd(ddd$method, x$method) test <- .chkddd(ddd$test, x$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) } level <- .chkddd(ddd$level, 0.05, .level(ddd$level)) 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 <- .chkddd(ddd$method, "REML") test <- .chkddd(ddd$test, "z") 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.r0000644000176200001440000001170414601245013015453 0ustar liggesusersrstandard.rma.mv <- function(model, digits, cluster, ...) { mstyle <- .get.mstyle() .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 must be of 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 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.r0000644000176200001440000000466414515471102015003 0ustar liggesusersqqnorm.rma.mh <- function(y, type="rstandard", pch=21, col, bg, label=FALSE, offset=0.3, pos=13, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000003664714530160355016672 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() .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(...) alternative <- .chkddd(ddd$alternative, x$alternative, match.arg(ddd$alternative, c("two.sided", "less", "greater"))) p2defn <- .chkddd(ddd$p2defn, x$p2defn, match.arg(ddd$p2defn, c("abs", "px2"))) stat <- .chkddd(ddd$stat, x$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=.coladj(par("bg"), dark=0, light=0), 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.r0000644000176200001440000002702514600577401017227 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)) { if (lb==0 && ub==1) { plogis(x) } else { 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)) { if (lb==0 && ub==1) { qlogis(x) } else { log((x-lb)/(ub-x)) # map (lb,ub) to (-inf,inf) } } 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.arg, delta.transf, mapfun, delta.min, delta.max, decreasing, tau2.arg, tau2.transf, tau2.max, beta.arg, wi.fun, steps, pgrp, alternative, pval.min, intCtrl, verbose, digits, dofit=FALSE) { mstyle <- .get.mstyle() beta <- par[1:pX] tau2 <- par[pX+1] delta <- par[(pX+2):(pX+1+deltas)] beta <- ifelse(is.na(beta.arg), beta, beta.arg) if (tau2.transf) tau2 <- exp(tau2) tau2[!is.na(tau2.arg)] <- tau2.arg 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.arg), delta, delta.arg) 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.arg, delta.transf, mapfun, delta.min, delta.max, decreasing, tau2.arg, tau2.transf, tau2.max, beta.arg, wi.fun, steps, pgrp, alternative, pval.min, intCtrl, verbose, digits, dofit=FALSE) { mstyle <- .get.mstyle() beta <- par[1:pX] tau2 <- par[pX+1] delta <- par[(pX+2):(pX+1+deltas)] beta <- ifelse(is.na(beta.arg), beta, beta.arg) if (tau2.transf) tau2 <- exp(tau2) tau2[!is.na(tau2.arg)] <- tau2.arg tau2[tau2 < .Machine$double.eps*10] <- 0 tau2[tau2 > tau2.max] <- tau2.max if (decreasing) { if (delta.transf) { delta <- exp(delta) delta <- cumsum(c(0, -delta[-1])) delta <- exp(delta) } } else { if (delta.transf) delta <- mapply(.mapfun, delta, delta.min, delta.max, mapfun) } delta <- ifelse(is.na(delta.arg), delta, delta.arg) if (decreasing && any(!is.na(delta.arg[-1]))) delta <- rev(cummax(rev(delta))) 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.arg, delta.transf, mapfun, delta.min, delta.max, decreasing, tau2.arg, tau2.transf, tau2.max, beta.arg, wi.fun, steps, pgrp, alternative, pval.min, intCtrl, verbose, digits, dofit=FALSE) { mstyle <- .get.mstyle() beta <- par[1:pX] tau2 <- par[pX+1] delta <- par[(pX+2):(pX+1+deltas)] beta <- ifelse(is.na(beta.arg), beta, beta.arg) if (tau2.transf) tau2 <- exp(tau2) tau2[!is.na(tau2.arg)] <- tau2.arg 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.arg), delta, delta.arg) 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) } ############################################################################ .rma.selmodel.ineqfun.pos <- function(par, yi, vi, X, preci, k, pX, pvals, deltas, delta.arg, delta.transf, mapfun, delta.min, delta.max, decreasing, tau2.arg, tau2.transf, tau2.max, beta.arg, wi.fun, steps, pgrp, alternative, pval.min, intCtrl, verbose, digits, dofit=FALSE) { delta <- par[-seq_len(pX+1)] if (delta.transf) delta <- mapply(.mapfun, delta, delta.min, delta.max, mapfun) delta <- ifelse(is.na(delta.arg), delta, delta.arg) diffs <- -diff(delta) # -1 * differences (delta1-delta2, delta2-delta3, ...) must be positive return(diffs) } .rma.selmodel.ineqfun.neg <- function(par, yi, vi, X, preci, k, pX, pvals, deltas, delta.arg, delta.transf, mapfun, delta.min, delta.max, decreasing, tau2.arg, tau2.transf, tau2.max, beta.arg, wi.fun, steps, pgrp, alternative, pval.min, intCtrl, verbose, digits, dofit=FALSE) { delta <- par[-seq_len(pX+1)] if (delta.transf) delta <- mapply(.mapfun, delta, delta.min, delta.max, mapfun) delta <- ifelse(is.na(delta.arg), delta, delta.arg) diffs <- diff(delta) # differences (delta1-delta2, delta2-delta3, ...) must be negative return(diffs) } ############################################################################ metafor/R/hatvalues.rma.mv.r0000644000176200001440000000341614601245463015477 0ustar liggesusershatvalues.rma.mv <- function(model, type="diagonal", ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000004556614515470724015601 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() .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", ...) labline(h=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.r0000644000176200001440000001257014601245266015173 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() .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.r0000644000176200001440000001560514531113260015156 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() .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, at.lab) plot(...) laxis <- function(..., addgrid, at.lab) 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]] } if (is.null(ddd$at.lab)) { 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) } } else { at.lab <- ddd$at.lab } ### 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.r0000644000176200001440000000556114515471150015056 0ustar liggesusersresiduals.rma <- function(object, type="response", ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000003760014600530311014776 0ustar liggesusersprint.rma.uni <- function(x, digits, showfit=FALSE, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { mstyle <- .get.mstyle() .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) && !is.infinite(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) && !is.infinite(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 (is.element(x$type, c("stepfun","stepcon"))) { 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.r0000644000176200001440000005104014550240261015117 0ustar liggesuserspredict.rma.ls <- function(object, newmods, intercept, addx=FALSE, newscale, addz=FALSE, level, digits, transf, targs, vcov=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle() .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")) pi.type <- .chkddd(ddd$pi.type, "default", tolower(ddd$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.")) rnames <- NULL ######################################################################### 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)) # if (.is.vector(newmods)) { # rnames <- names(newmods) # } else { # rnames <- rownames(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) # if (inherits(newmods, "matrix")) # rnames <- rownames(newmods) # } else { # # if user gives multiple rows and columns (multiple k.new): k.new <- nrow(newmods) # X.new <- cbind(newmods) # rnames <- rownames(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."))) 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."))) 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)) # if (is.null(rnames)) { # if (.is.vector(newscale)) { # rnames <- names(newscale) # } else { # rnames <- rownames(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) # if (is.null(rnames) && inherits(newscale, "matrix")) # rnames <- rownames(newscale) # } else { # # if user gives multiple rows and columns (multiple k.new): Z.k.new <- nrow(newscale) # Z.new <- cbind(newscale) # if (is.null(rnames)) # rnames <- rownames(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."))) 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."))) 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) if (!is.null(rnames)) slab <- rnames } } else { if (is.null(newscale)) { slab <- x$slab } else { slab <- seq_len(k.new) if (!is.null(rnames)) slab <- rnames } } ### 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 && is.null(rnames)) 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.r0000644000176200001440000000364014515471323015154 0ustar liggesusersweights.rma.mv <- function(object, type="diagonal", ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000360514600622503015461 0ustar liggesusersconfint.rma.peto <- function(object, parm, level, digits, transf, targs, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000407214515470740014444 0ustar liggesusersplot.rma.mh <- function(x, qqplot=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle() .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.r0000644000176200001440000000277514515471266014361 0ustar liggesusers### based on stats:::update.default but with some adjustments update.rma <- function(object, formula., ..., evaluate=TRUE) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000607614515470773014242 0ustar liggesusersprint.fsn <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000035070314561115307014020 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() ### 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 <- .chkddd(ddd$onlyo1, FALSE) addyi <- .chkddd(ddd$addyi, TRUE) addvi <- .chkddd(ddd$addvi, TRUE) ### set default for i2def i2def <- .chkddd(ddd$i2def, "1") ### 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 <- paste0(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") #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 <- paste0(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") #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 <- paste0(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") #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.r0000644000176200001440000000142414515471300013635 0ustar liggesusersvec2mat <- function(x, diag=FALSE, corr=!diag, dimnames) { mstyle <- .get.mstyle() 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.r0000644000176200001440000000367414600622557015135 0ustar liggesusersconfint.rma.mh <- function(object, parm, level, digits, transf, targs, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000462614515471060014234 0ustar liggesusersprint.tes <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000001047714515471062015006 0ustar liggesusersprint.vif.rma <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000003202514600622602015126 0ustar liggesusersconfint.rma.ls <- function(object, parm, level, fixed=FALSE, alpha, digits, transf, targs, verbose=FALSE, control, ...) { mstyle <- .get.mstyle() .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() ddd <- list(...) .chkdots(ddd, c("time", "xlim", "extint")) level <- .level(level, stopon100=.isTRUE(ddd$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 for models fitted 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.r0000644000176200001440000000070214515471024015646 0ustar liggesusersprint.profile.rma <- function(x, ...) { ######################################################################### mstyle <- .get.mstyle() .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.r0000644000176200001440000001354114601244772015500 0ustar liggesuserstrimfill.rma.uni <- function(x, side, estimator="L0", maxiter=100, verbose=FALSE, ilim, ...) { ######################################################################### mstyle <- .get.mstyle() .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.r0000644000176200001440000000033214515470735014773 0ustar liggesusersplot.rma.glmm <- function(x, qqplot=FALSE, ...) { ######################################################################### mstyle <- .get.mstyle() .chkclass(class(x), must="rma.glmm", notav="rma.glmm") } metafor/R/methods.list.rma.r0000644000176200001440000000743014601245407015475 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.r0000644000176200001440000000151014530160543016151 0ustar liggesusers############################################################################ as.data.frame.confint.rma <- function(x, ...) { .chkclass(class(x), must="confint.rma") ddd <- list(...) .chkdots(ddd, c("fixed", "random")) fixed <- .chkddd(ddd$fixed, is.element("fixed", names(x))) random <- .chkddd(ddd$random, is.element("random", names(x))) 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.r0000644000176200001440000000017214515471105015012 0ustar liggesusersqqnorm.rma.mv <- function(y, ...) { mstyle <- .get.mstyle() .chkclass(class(y), must="rma.mv", notav="rma.mv") } metafor/R/print.list.anova.rma.r0000644000176200001440000000135014515471007016265 0ustar liggesusersprint.list.anova.rma <- function(x, digits=x[[1]]$digits, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000305114515470356015472 0ustar liggesuserscoef.summary.rma <- function(object, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000270314515470321013451 0ustar liggesusersAIC.rma <- function(object, ..., k=2, correct=FALSE) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000153614515470353014001 0ustar liggesuserscoef.rma <- function(object, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000001471514600537022016433 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() .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 (is.element(x$type, c("stepfun","stepcon"))) { 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" && !is.element(x$type, c("stepfun","stepcon")) && 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 (is.element(x$type, c("stepfun","stepcon"))) { 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.r0000644000176200001440000000166714515471000015377 0ustar liggesusersprint.hc.rma.uni <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000126714515470547014314 0ustar liggesuserslogLik.rma <- function(object, REML, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000001574214515471261013663 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() 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.r0000644000176200001440000005570114600622550015142 0ustar liggesusersconfint.rma.mv <- function(object, parm, level, fixed=FALSE, sigma2, tau2, rho, gamma2, phi, digits, transf, targs, verbose=FALSE, control, ...) { mstyle <- .get.mstyle() .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() ddd <- list(...) .chkdots(ddd, c("time", "xlim", "extint")) level <- .level(level, stopon100=.isTRUE(ddd$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.r0000644000176200001440000001202514551703726014624 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() .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(...) tail <- .chkddd(ddd$tail, "upper", match.arg(ddd$tail, c("lower", "upper"))) new <- .chkddd(ddd$new, TRUE, FALSE) mainadd <- .chkddd(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.r0000644000176200001440000000767714601245437015753 0ustar liggesusersleave1out.rma.peto <- function(x, digits, transf, targs, progbar=FALSE, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000006232514572304132015510 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() .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) efac[efac == 0] <- NA ### 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 } top <- .chkddd(ddd$top, 3) if (is.null(ddd$xlabadj)) { xlabadj <- c(NA,NA) } else { xlabadj <- ddd$xlabadj if (length(xlabadj) == 1L) xlabadj <- c(xlabadj, 1-xlabadj) } xlabfont <- .chkddd(ddd$xlabfont, 1) lplot <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) plot(...) labline <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) abline(...) lsegments <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) segments(...) laxis <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) axis(...) lmtext <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) mtext(...) lpolygon <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) polygon(...) ltext <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) text(...) lpoints <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont, at.lab) 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 <- .applyolim(yi, olim) ci.lb <- .applyolim(ci.lb, olim) ci.ub <- .applyolim(ci.ub, olim) } ######################################################################### 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) if (is.null(ddd$at.lab)) { 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) } } else { at.lab <- ddd$at.lab } ### 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 textpos <- .chkddd(ddd$textpos, xlim) 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 { if (length(ylim) == 1L) { ylim <- c(ylim, 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.r0000644000176200001440000005506214530173125014721 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() 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")) verbose <- .chkddd(ddd$verbose, FALSE, .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.r0000644000176200001440000002763314600623324017121 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, ...) { mstyle <- .get.mstyle() .chkclass(class(fitted), must="rma.uni.selmodel") 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.")) if (x$decreasing || x$type == "stepcon") stop(mstyle$stop("Method not currently implemented for this type of model.")) if (anyNA(steps)) stop(mstyle$stop("No missing values allowed in 'steps' argument.")) if (length(steps) >= 2L) { if (missing(xlim)) xlim <- range(steps) stepseq <- TRUE } else { if (steps < 2) stop(mstyle$stop("Argument 'steps' must be >= 2.")) stepseq <- FALSE } 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() == 1L) { # if only the 'null device' is currently open, set mfrow 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)) } ### round and take unique values if (!missing(delta) && is.numeric(delta)) delta <- unique(round(delta)) if (!missing(tau2) && is.numeric(tau2)) tau2 <- unique(round(tau2)) ### 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) || is.null(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(0.1, vc*4), x$tau2.max) } else { vc.lb <- max(0, vc - qnorm(0.995) * x$se.tau2) vc.ub <- min(max(0.1, vc + qnorm(0.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(0.1, vc*4), x$delta.max[delta]) } else { vc.lb <- max(0, vc - qnorm(0.995) * x$se.delta[delta], x$delta.min[delta]) vc.ub <- min(max(0.1, vc + qnorm(0.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], "."))) } } if (stepseq) { vcs <- steps } else { 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) #res <- parallel::clusterMap(cl, .profile.rma.uni.selmodel, vcs, MoreArgs=list(obj=x, comp=comp, delta.pos=delta.pos, parallel=parallel, profile=TRUE), .scheduling = "dynamic") } 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) #res <- parallel::clusterMap(cl, .profile.rma.uni.selmodel, vcs, MoreArgs=list(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))) 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) ######################################################################### maxll <- c(logLik(x)) if (any(lls >= maxll + 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) if (.isTRUE(ddd$exp)) { lls <- exp(lls) maxll <- exp(maxll) } if (missing(ylim)) { if (any(is.finite(lls))) { if (xlim[1] <= vc && xlim[2] >= vc) { ylim <- range(c(maxll,lls[is.finite(lls)]), na.rm=TRUE) } else { ylim <- range(lls[is.finite(lls)], na.rm=TRUE) } } else { ylim <- rep(maxll, 2L) } if (!.isTRUE(ddd$exp)) 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=maxll, xlab=xlab, title=title, exp=ddd$exp) names(sav)[1] <- switch(comp, tau2="tau2", delta="delta") class(sav) <- "profile.rma" ######################################################################### if (plot) plot(sav, ...) ######################################################################### if (.isTRUE(ddd$time)) { time.end <- proc.time() .print.time(unname(time.end - time.start)[3]) } invisible(sav) } metafor/R/print.summary.matreg.r0000644000176200001440000000273414515471054016415 0ustar liggesusersprint.summary.matreg <- function(x, digits=x$digits, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000001074614515470641016717 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() lopts <- list(x = "topright", y = NULL, inset = 0.01, bty = "o", bg = .coladj(par("bg","fg"), dark=c(0,-0.9), light=c(0,0.9)), 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.r0000644000176200001440000001321514551524200014770 0ustar liggesuserscumul.rma.uni <- function(x, order, digits, transf, targs, progbar=FALSE, ...) { mstyle <- .get.mstyle() .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() decreasing <- .chkddd(ddd$decreasing, FALSE) ######################################################################### 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 must be of the same length as the original dataset ### so we have to 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.r0000644000176200001440000000467014515471107015350 0ustar liggesusersqqnorm.rma.peto <- function(y, type="rstandard", pch=21, col, bg, label=FALSE, offset=0.3, pos=13, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000001637614515470413014351 0ustar liggesusersconv.delta <- function(yi, vi, ni, data, include, transf, var.names, append=TRUE, replace="ifna", ...) { mstyle <- .get.mstyle() 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.r0000644000176200001440000000576514601245021015635 0ustar liggesusersrstandard.rma.uni <- function(model, digits, type="marginal", ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000002140614572304610015226 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() .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 <- .applyolim(yi, olim) # note: zi and pval are based on unconstrained yi ci.lb <- .applyolim(ci.lb, olim) ci.ub <- .applyolim(ci.ub, olim) } 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.r0000644000176200001440000000070514515470477014536 0ustar liggesusersformula.rma <- function(x, type="mods", ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000031714515470706014024 0ustar liggesusersnobs.rma <- function(object, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000002551314601245423013610 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() ### 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 <- .chkddd(ddd$onlyo1, FALSE) addyi <- .chkddd(ddd$addyi, TRUE) addvi <- .chkddd(ddd$addvi, TRUE) .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.r0000644000176200001440000002035414530173067014200 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() 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 <- .chkddd(ddd$cifac, 0.1) ######################################################################### 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.r0000644000176200001440000006171714601245201013464 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() ### 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 <- .chkddd(ddd$onlyo1, FALSE) addyi <- .chkddd(ddd$addyi, TRUE) addvi <- .chkddd(ddd$addvi, TRUE) ### 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.r0000644000176200001440000003232714601245133014026 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() ### 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.r0000644000176200001440000002740214530157612013646 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() .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")) fixed <- .chkddd(ddd$fixed, FALSE, .isTRUE(ddd$fixed)) intercept <- .chkddd(ddd$intercept, FALSE, .isTRUE(ddd$intercept)) joinb <- ddd$joinb 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."), call.=FALSE) 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."), call.=FALSE) 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.r0000644000176200001440000000537514601245042015334 0ustar liggesusersrstudent.rma.mh <- function(model, digits, progbar=FALSE, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000175014515471005015733 0ustar liggesusersprint.infl.rma.uni <- function(x, digits=x$digits, infonly=FALSE, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000003477414600623077017132 0ustar liggesusersconfint.rma.uni.selmodel <- function(object, parm, level, fixed=FALSE, tau2, delta, digits, transf, targs, verbose=FALSE, control, ...) { mstyle <- .get.mstyle() .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.")) if (x$decreasing || x$type == "stepcon") stop(mstyle$stop("Method not currently implemented for this type of model.")) 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() ddd <- list(...) .chkdots(ddd, c("time", "xlim", "extint")) level <- .level(level, stopon100=.isTRUE(ddd$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.r0000644000176200001440000001455514551524275015366 0ustar liggesusersrstudent.rma.mv <- function(model, digits, progbar=FALSE, cluster, reestimate=TRUE, parallel="no", ncpus=1, cl, ...) { mstyle <- .get.mstyle() .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 must be of 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 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.r0000644000176200001440000005060414531113246015212 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() 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 <- .coladj(par("bg","fg"), dark=c(0,-0.9), light=c(0,1)) 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.")) 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, at.lab) plot(...) labline <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) abline(...) lsegments <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) segments(...) laxis <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) axis(...) lpolygon <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) polygon(...) llines <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) lines(...) lpoints <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) points(...) lrect <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) rect(...) ltext <- function(..., refline2, level2, lty2, colci, colref, colbox, transf, ci.res, at.lab) text(...) ### refline2, level2, and lty2 for adding a second reference line / funnel refline2 <- ddd$refline2 level2 <- .chkddd(ddd$level2, 95) lty2 <- .chkddd(ddd$lty2, 3) ### number of y-axis values at which to calculate the bounds of the pseudo confidence interval ci.res <- .chkddd(ddd$ci.res, 1000) ### to adjust color of reference line, region bounds, and the L box colref <- .chkddd(ddd$colref, .coladj(par("bg","fg"), dark=0.6, light=-0.6)) colci <- .chkddd(ddd$colci, .coladj(par("bg","fg"), dark=0.6, light=-0.6)) colbox <- .chkddd(ddd$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 <- .level(level, allow.vector=TRUE) # note: there may be multiple level values level2 <- .level(level2) 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, ...) ######################################################################### ### 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]] } if (is.null(ddd$at.lab)) { 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) } } else { at.lab <- ddd$at.lab } ### add x-axis laxis(side=1, at=at, labels=at.lab, ...) ### add L-shaped box around plot if (!is.na(colbox)) box(bty="l", col=colbox) ############################################################################ ### 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.r0000644000176200001440000000026414515470444015263 0ustar liggesusersdf.residual.rma <- function(object, ...) { mstyle <- .get.mstyle() .chkclass(class(object), must="rma") df.resid <- object$k.eff - object$p.eff return(df.resid) } metafor/R/rstandard.rma.mh.r0000644000176200001440000000270314601245007015437 0ustar liggesusersrstandard.rma.mh <- function(model, digits, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000104014515471056015704 0ustar liggesusersprint.summary.rma <- function(x, digits=x$digits, showfit=TRUE, signif.stars=getOption("show.signif.stars"), signif.legend=signif.stars, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000373414601245471015652 0ustar liggesusershatvalues.rma.uni <- function(model, type="diagonal", ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000015242014600776042015461 0ustar liggesusersselmodel.rma.uni <- function(x, type, alternative="greater", prec, delta, steps, decreasing=FALSE, 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() .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 (see 'help(selmodel)' for options).")) type.options <- c("beta", "halfnorm", "negexp", "logistic", "power", "negexppow", "halfnorm2", "negexp2", "logistic2", "power2", "stepfun", "stepcon", "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 (see 'help(selmodel)' for options).")) if (is.element(type, c("trunc","truncest")) && alternative == "two.sided") stop(mstyle$stop("Cannot use alternative='two-sided' with this type of selection model.")) decreasing <- isTRUE(decreasing) if (type != "stepfun" && decreasing) { warning(mstyle$warning("Argument 'decreasing' ignored (not applicable to this type of selection model)."), call.=FALSE) decreasing <- FALSE } 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", "pval", "ptable", "retopt")) ### 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 # [a] sets con$scaleX=TRUE } else { beta <- ddd$beta betaspec <- TRUE # [a] sets con$scaleX=FALSE } 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 # used to check if prec is set for certain models where this is not applicable or experimental [b] 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 if (is.null(ddd$pval)) { pvals <- .selmodel.pval(yi=yi, vi=vi, alternative=alternative) } else { # can pass p-values directly to the function via 'pvals' argument from ... (this is highly experimental) pvals <- ddd$pval if (length(pvals) != x$k.all) stop(mstyle$stop(paste0("Length of the 'pval' argument (", length(pvals), ") does not correspond to the size of the original dataset (", x$k.all, ")."))) pvals <- .getsubset(pvals, x$subset) if (anyNA(pvals)) stop(mstyle$stop(paste0("No missing values in 'pval' argument allowed."))) if (any(pvals <= 0) || any(pvals > 1)) stop(mstyle$stop(paste0("One or more 'pval' values are <= 0 or > 1."))) } ### 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") { if (steps[1] == 0) stop(mstyle$stop("Lowest 'steps' value must be > 0.")) if (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 as effectively equal to 0 in the Hessian computation deltatol = 1e-04, # threshold for treating deltas as effectively equal to 0 in the Hessian computation (only for stepfun) 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","solnp","alabama"/"constrOptim.nl") 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 [a] ### 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","solnp","alabama","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 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" ### can use optimizer="alabama" as a shortcut for optimizer="constrOptim.nl" if (optimizer == "alabama") optimizer <- "constrOptim.nl" ### when type="stepcon", automatically set solnp as the default optimizer if (type == "stepcon") { if (optimizer == "optim" && optmethod=="BFGS") { # this is the default optimizer <- "solnp" } else { if (!is.element(optimizer, c("solnp","nloptr","constrOptim.nl"))) { optimizer <- "solnp" warning(mstyle$warning(paste0("Can only use optimizers 'solnp', 'nloptr', or 'constrOptim.nl' when type='stepcon' (resetting to '", optimizer, "').")), call.=FALSE) } } } if (type != "stepcon" && optimizer == "constrOptim.nl") { # but can use solnp and nloptr optimizer <- "optim" warning(mstyle$warning(paste0("Cannot use 'constrOptim.nl' optimizer to fit this model (resetting to '", optimizer, "').")), call.=FALSE) } ### 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 (Inf by default) is larger than the tau^2 value tau2.max <- con$tau2.max if (x$tau2 >= con$tau2.max) stop(mstyle$stop("Value of 'tau2.max' must be > tau^2 value.")) ### initial value for tau^2 if (is.null(con$tau2.init)) { tau2.init <- log(x$tau2 + 1e-3) } 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."))) ############################################################################ ### definition of the various selection model types # delta.lb / delta.ub: parameter space of the delta value(s) # delta.lb.excl / delta.ub.excl: whether delta must be >/< or can be >=/<= # delta.min / delta.max: limits imposed on delta for numerical reasons delta.min.check <- TRUE delta.max.check <- TRUE 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) # [b] 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) { # [b] if (decreasing) { warning(mstyle$warning("Argument 'prec' ignored (not applicable to this type of selection model)."), call.=FALSE) preci <- rep(1, k) } else { warning(mstyle$warning("Adding a precision measure to this selection model is undocumented and experimental."), call.=FALSE) } } deltas <- length(steps) if (decreasing) { delta.transf.fun <- rep("I", deltas) delta.transf.fun.inv <- rep("I", deltas) ddd$defmap <- TRUE # actual mapping is defined directly in .selmodel.ll.stepfun() for this special case if (con$htransf) stop(mstyle$stop("Cannot use 'htransf=TRUE' for this type of selection model.")) #delta.lb <- rep(0, deltas) #delta.ub <- rep(1, deltas) delta.lb <- c(0, rep(-Inf, deltas-1)) delta.ub <- c(1, rep( Inf, deltas-1)) delta.lb.excl <- rep(FALSE, deltas) delta.ub.excl <- rep(FALSE, deltas) #delta.init <- rep(1, deltas) delta.init <- c(1, rep(-2, deltas-1)) delta.min <- rep(0, deltas) delta.max <- rep(1, deltas) delta.max.check <- FALSE } else { 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 <- seq(1, 0.8, length.out=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 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 == "stepcon") { if (!stepsspec) stop(mstyle$stop("Must specify 'steps' argument for this type of selection model.")) if (precspec) { # [b] warning(mstyle$warning("Argument 'prec' ignored (not applicable to this type of selection model)."), call.=FALSE) preci <- rep(1, k) } deltas <- length(steps) delta.transf.fun <- rep("plogis", deltas) delta.transf.fun.inv <- rep("qlogis", deltas) delta.lb <- rep(0, deltas) delta.ub <- rep(1, deltas) delta.lb.excl <- rep(FALSE, deltas) delta.ub.excl <- rep(FALSE, deltas) delta.init <- seq(1, 0.5, length.out=deltas) delta.min <- rep(0, deltas) delta.max <- rep(1, deltas) delta.max.check <- FALSE 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 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) # [b] 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) # [b] 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.min, delta.max, and delta.init 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") { if (decreasing) { delta[1] <- 1 } else if (is.na(delta[1])) { delta[1] <- 1 } } if (type == "stepcon") 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."))) } # when ddd$defmap=TRUE or any delta.max value is infinity, use the default mapping functions defined # above for the various models (note that this will not be the case with the default settings); # otherwise use .mapfun() / .mapinvfun() or the functions passed via ddd$mapfun / ddd$mapinvfun 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 } } ### force use of certain transformation functions for mapfunv / mapinvfun for some special cases if (type == "truncest") { mapfun[2] <- "I" mapinvfun[2] <- "I" } ### remap initial delta values (except for the fixed ones) delta.init <- mapply(.mapinvfun, delta.init, delta.min, delta.max, mapinvfun) delta.init <- ifelse(is.na(delta), delta.init, delta) 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 (isTRUE(ddd$ptable)) return(ptable) if (any(ptable[["k"]] == 0L)) { if (!isTRUE(ddd$skipintcheck) && type == "stepfun" && any(is.na(delta[-1]))) warning(mstyle$warning(paste0("One or more intervals do not contain any observed p-values.")), call.=FALSE) if (!isTRUE(ddd$skipintcheck) && type != "stepfun") warning(mstyle$warning(paste0("One of the intervals does not contain any observed p-values.")), call.=FALSE) } } else { pgrp <- NA ptable <- NA } ############################################################################ ### model fitting if (verbose > 1) message(mstyle$message("\nModel fitting ...\n")) tmp <- .chkopt(optimizer, optcontrol, ineq=type=="stepcon") optimizer <- tmp$optimizer optcontrol <- tmp$optcontrol par.arg <- tmp$par.arg ctrl.arg <- tmp$ctrl.arg ### set up default cluster when using optimParallel 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 (type == "stepcon") { if (optimizer == "Rsolnp::solnp") optcall <- paste0("Rsolnp::solnp(pars=c(beta.init, tau2.init, delta.init), fun=.selmodel.ll.stepfun, ineqfun=.rma.selmodel.ineqfun.pos, ineqLB=rep(0,deltas-1), ineqUB=rep(1,deltas-1), yi=yi, vi=vi, X=X, preci=preci, k=k, pX=p, pvals=pvals, deltas=deltas, delta.arg=delta, delta.transf=TRUE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, decreasing=decreasing, tau2.arg=tau2, tau2.transf=TRUE, tau2.max=tau2.max, beta.arg=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") if (optimizer == "nloptr::nloptr") optcall <- paste0("nloptr::nloptr(x0=c(beta.init, tau2.init, delta.init), eval_f=.selmodel.ll.stepfun, eval_g_ineq=.rma.selmodel.ineqfun.neg, yi=yi, vi=vi, X=X, preci=preci, k=k, pX=p, pvals=pvals, deltas=deltas, delta.arg=delta, delta.transf=TRUE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, decreasing=decreasing, tau2.arg=tau2, tau2.transf=TRUE, tau2.max=tau2.max, beta.arg=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") if (optimizer == "alabama::constrOptim.nl") optcall <- paste0("alabama::constrOptim.nl(par=c(beta.init, tau2.init, delta.init), fn=.selmodel.ll.stepfun, hin=.rma.selmodel.ineqfun.pos, yi=yi, vi=vi, X=X, preci=preci, k=k, pX=p, pvals=pvals, deltas=deltas, delta.arg=delta, delta.transf=TRUE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, decreasing=decreasing, tau2.arg=tau2, tau2.transf=TRUE, tau2.max=tau2.max, beta.arg=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") } else { optcall <- paste0(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.arg=delta, delta.transf=TRUE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, decreasing=decreasing, tau2.arg=tau2, tau2.transf=TRUE, tau2.max=tau2.max, beta.arg=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") } #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) } if (isTRUE(ddd$retopt)) 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.arg <- beta tau2.arg <- tau2 delta.arg <- delta ### do the final model fit with estimated values fitcall <- paste0(.selmodel.ll, "(par=opt.res$par, yi=yi, vi=vi, X=X, preci=preci, k=k, pX=p, pvals=pvals, deltas=deltas, delta.arg=delta, delta.transf=TRUE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, decreasing=decreasing, tau2.arg=tau2, tau2.transf=TRUE, tau2.max=tau2.max, beta.arg=beta, wi.fun=wi.fun, steps=steps, pgrp=pgrp, alternative=alternative, pval.min=pval.min, intCtrl=intCtrl, verbose=FALSE, digits=digits, dofit=TRUE)\n") #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 ((delta.min.check && any(is.na(delta.arg) & delta <= delta.min + .Machine$double.eps^0.25)) || (delta.max.check && any(is.na(delta.arg) & 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.arg } if (con$tau2.fix || tau2 < con$tau2tol) { tau2.hes <- tau2 } else { tau2.hes <- tau2.arg } if (con$delta.fix) { delta.hes <- delta } else { if (type == "stepfun") { delta.hes <- ifelse(delta < con$deltatol, delta, delta.arg) } else { delta.hes <- delta.arg } } 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 <- paste0("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.arg=delta.hes, delta.transf=TRUE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, decreasing=decreasing, tau2.arg=tau2.hes, tau2.transf=TRUE, tau2.max=tau2.max, beta.arg=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") if (con$hesspack == "pracma") hescall <- paste0("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.arg=delta.hes, delta.transf=TRUE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, decreasing=decreasing, tau2.arg=tau2.hes, tau2.transf=TRUE, tau2.max=tau2.max, beta.arg=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") } else { ### this is the default if (con$hesspack == "numDeriv") hescall <- paste0("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.arg=delta.hes, delta.transf=FALSE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, decreasing=decreasing, tau2.arg=tau2.hes, tau2.transf=FALSE, tau2.max=tau2.max, beta.arg=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") if (con$hesspack == "pracma") hescall <- paste0("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.arg=delta.hes, delta.transf=FALSE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, decreasing=decreasing, tau2.arg=tau2.hes, tau2.transf=FALSE, tau2.max=tau2.max, beta.arg=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") } #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) } ### impose constraints on the CI bounds for the delta value(s) 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) ci.lb.delta <- ifelse(ci.lb.delta < delta.min, delta.min, ci.lb.delta) ci.ub.delta <- ifelse(ci.ub.delta > delta.max, delta.max, 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 <- paste0(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.arg=delta.arg, delta.transf=TRUE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, decreasing=decreasing, tau2.arg=0, tau2.transf=FALSE, tau2.max=tau2.max, beta.arg=beta.arg, 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") opt.res <- try(eval(str2lang(optcall)), silent=!verbose) if (verbose > 4) cat("\n") if (!inherits(opt.res, "try-error")) { fitcall <- paste0(.selmodel.ll, "(par=opt.res$par, yi=yi, vi=vi, X=X, preci=preci, k=k, pX=p, pvals=pvals, deltas=deltas, delta.arg=delta.arg, delta.transf=TRUE, mapfun=mapfun, delta.min=delta.min, delta.max=delta.max, decreasing=decreasing, tau2.arg=0, tau2.transf=FALSE, tau2.max=tau2.max, beta.arg=beta.arg, wi.fun=wi.fun, steps=steps, pgrp=pgrp, alternative=alternative, pval.min=pval.min, intCtrl=intCtrl, verbose=FALSE, digits=digits, dofit=TRUE)\n") 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.arg) & 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.arg)) 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.arg) 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$decreasing <- decreasing 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.r0000644000176200001440000000021314515471316015461 0ustar liggesusersweights.rma.glmm <- function(object, ...) { mstyle <- .get.mstyle() .chkclass(class(object), must="rma.glmm", notav="rma.glmm") } metafor/R/regplot.rma.r0000644000176200001440000006005314572304434014537 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() .chkclass(class(x), must="rma", notav=c("rma.mh","rma.peto")) if (x$int.only) stop(mstyle$stop("Cannot draw plot for 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 vector (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, at.lab) plot(...) laxis <- function(..., grep, fixed, box.lty, at.lab) axis(...) lpolygon <- function(..., grep, fixed, box.lty, at.lab) polygon(...) llines <- function(..., grep, fixed, box.lty, at.lab) lines(...) lpoints <- function(..., grep, fixed, box.lty, at.lab) points(...) labline <- function(..., grep, fixed, box.lty, at.lab) abline(...) lbox <- function(..., grep, fixed, box.lty, at.lab) box(...) ltext <- function(..., grep, fixed, box.lty, at.lab) text(...) grep <- .chkddd(ddd$grep, FALSE, .isTRUE(ddd$grep)) fixed <- .chkddd(ddd$fixed, FALSE, .isTRUE(ddd$fixed)) box.lty <- .chkddd(ddd$box.lty, par("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, psize, col, and bg (if vectors) must be of 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'."), call.=FALSE) 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] tmp <- .psort(yi.ci.lb, yi.ci.ub) yi.ci.lb <- tmp[,1] yi.ci.ub <- tmp[,2] tmp <- .psort(yi.pi.lb, yi.pi.ub) yi.pi.lb <- tmp[,1] yi.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 <- .applyolim(yi, olim) ci.lb <- .applyolim(ci.lb, olim) ci.ub <- .applyolim(ci.ub, olim) pred <- .applyolim(pred, olim) pi.lb <- .applyolim(pi.lb, olim) pi.ub <- .applyolim(pi.ub, olim) } ### 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) if (is.null(ddd$at.lab)) { 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) } } else { at.lab <- ddd$at.lab } ### 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=.coladj(par("bg"), dark=0, light=0), 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.r0000644000176200001440000000653614601245240014746 0ustar liggesusersranef.rma.uni <- function(object, level, digits, transf, targs, ...) { mstyle <- .get.mstyle() .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 if (length(x$tau2.f) == 1L) x$tau2.f <- rep(x$tau2.f, length(x$yi.f)) li <- ifelse(is.infinite(x$tau2.f), 1, 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.r0000644000176200001440000000270714601245016016006 0ustar liggesusersrstandard.rma.peto <- function(model, digits, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000006106014515470711015526 0ustar liggesuserspermutest.rma.ls <- function(x, exact=FALSE, iter=1000, progbar=TRUE, digits, control, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000002261414552252552015317 0ustar liggesusersprofile.rma.uni <- function(fitted, xlim, ylim, steps=20, lltol=1e-03, progbar=TRUE, parallel="no", ncpus=1, cl, plot=TRUE, ...) { mstyle <- .get.mstyle() .chkclass(class(fitted), must="rma.uni", notav=c("rma.ls", "rma.uni.selmodel", "rma.gen")) if (is.element(fitted$method, c("FE","EE","CE"))) stop(mstyle$stop("Cannot profile tau^2 parameter for equal/fixed-effects models.")) x <- fitted if (anyNA(steps)) stop(mstyle$stop("No missing values allowed in 'steps' argument.")) if (length(steps) >= 2L) { if (missing(xlim)) xlim <- range(steps) stepseq <- TRUE } else { if (steps < 2) stop(mstyle$stop("Argument 'steps' must be >= 2.")) stepseq <- FALSE } 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() pred <- isTRUE(ddd$pred) blup <- isTRUE(ddd$blup) newmods <- NULL if (pred) { if (!is.null(ddd$newmods)) newmods <- ddd$newmods ### test if predict() works with the given newmods (and to get slab for [a]) predtest <- predict(x, newmods=newmods) if (length(predtest$pred) == 0L) stop(mstyle$stop("Cannot compute predicted values.")) } ######################################################################### if (missing(xlim) || is.null(xlim)) { ### if the user has not specified xlim, set it automatically 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 ### note: 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(0.1, x$tau2, vc.ci$random[1,3]) # if CI is equal to null set, then this still gives vc.ub = 0.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(0.995) * x$se.tau2) vc.ub <- max(0.1, x$tau2 + qnorm(0.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(0.1, x$tau2*4) } ### 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) if (.isTRUE(ddd$sqrt)) xlim <- sqrt(xlim) } else { if (length(xlim) != 2L) stop(mstyle$stop("Argument 'xlim' should be a vector of length 2.")) xlim <- sort(xlim) ### note: if sqrt=TRUE, then xlim is assumed to be given in terms of tau } if (stepseq) { vcs <- steps } else { 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 sqrt=TRUE, then the sequence of vcs are tau values, so square them for the actual profiling if (.isTRUE(ddd$sqrt)) vcs <- vcs^2 if (parallel == "no") res <- pbapply::pblapply(vcs, .profile.rma.uni, obj=x, parallel=parallel, profile=TRUE, pred=pred, blup=blup, newmods=newmods) if (parallel == "multicore") res <- pbapply::pblapply(vcs, .profile.rma.uni, obj=x, parallel=parallel, profile=TRUE, cl=ncpus, pred=pred, blup=blup, newmods=newmods) #res <- parallel::mclapply(vcs, .profile.rma.uni, obj=x, parallel=parallel, profile=TRUE, pred=pred, blup=blup, newmods=newmods, 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, pred=pred, blup=blup, newmods=newmods) #res <- parallel::clusterApplyLB(cl, vcs, .profile.rma.uni, obj=x, parallel=parallel, profile=TRUE, pred=pred, blup=blup, newmods=newmods) #res <- parallel::clusterMap(cl, .profile.rma.uni, vcs, MoreArgs=list(obj=x, parallel=parallel, profile=TRUE, pred=pred, blup=blup, newmods=newmods), .scheduling = "dynamic") } else { res <- pbapply::pblapply(vcs, .profile.rma.uni, obj=x, parallel=parallel, profile=TRUE, pred=pred, blup=blup, newmods=newmods, cl=cl) #res <- parallel::parLapply(cl, vcs, .profile.rma.uni, obj=x, parallel=parallel, profile=TRUE, pred=pred, blup=blup, newmods=newmods) #res <- parallel::clusterApply(cl, vcs, .profile.rma.uni, obj=x, parallel=parallel, profile=TRUE, pred=pred, blup=blup, newmods=newmods) #res <- parallel::clusterMap(cl, .profile.rma.uni, vcs, MoreArgs=list(obj=x, parallel=parallel, profile=TRUE, pred=pred, blup=blup, newmods=newmods)) } } ### if sqrt=TRUE, then transform the tau^2 values back to tau values if (.isTRUE(ddd$sqrt)) { vcs <- sqrt(vcs) vc <- sqrt(x$tau2) } else { vc <- x$tau2 } 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))) 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) ######################################################################### maxll <- c(logLik(x)) if (x$method %in% c("ML","REML") && any(lls >= maxll + 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) if (.isTRUE(ddd$exp)) { lls <- exp(lls) maxll <- exp(maxll) } if (missing(ylim)) { if (any(is.finite(lls))) { if (xlim[1] <= vc && xlim[2] >= vc) { ylim <- range(c(maxll,lls[is.finite(lls)]), na.rm=TRUE) } else { ylim <- range(lls[is.finite(lls)], na.rm=TRUE) } } else { ylim <- rep(maxll, 2L) } if (!.isTRUE(ddd$exp)) 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 (.isTRUE(ddd$sqrt)) { xlab <- expression(paste(tau, " Value")) title <- expression(paste("Profile Plot for ", tau)) } else { 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=vc, maxll=maxll, xlab=xlab, title=title, exp=ddd$exp, sqrt=ddd$sqrt) class(sav) <- "profile.rma" if (.isTRUE(ddd$sqrt)) names(sav)[1] <- "tau" sav$I2 <- sapply(res, function(x) x$I2) sav$H2 <- sapply(res, function(x) x$H2) if (pred) { sav$pred <- do.call(cbind, lapply(res, function(x) x$pred)) # use do.call(cbind, lapply()) instead of sapply() to always get a matrix, even when predicting a single value sav$pred.ci.lb <- do.call(cbind, lapply(res, function(x) x$pred.ci.lb)) sav$pred.ci.ub <- do.call(cbind, lapply(res, function(x) x$pred.ci.ub)) sav$pred.pi.lb <- do.call(cbind, lapply(res, function(x) x$pred.pi.lb)) sav$pred.pi.ub <- do.call(cbind, lapply(res, function(x) x$pred.pi.ub)) rownames(sav$pred) <- rownames(sav$pred.ci.lb) <- rownames(sav$pred.ci.ub) <- rownames(sav$pred.pi.lb) <- rownames(sav$pred.pi.ub) <- predtest$slab # [a] } if (blup) { sav$blup <- sapply(res, function(x) x$blup) sav$blup.se <- sapply(res, function(x) x$blup.se) sav$blup.pi.lb <- sapply(res, function(x) x$blup.pi.lb) sav$blup.pi.ub <- sapply(res, function(x) x$blup.pi.ub) rownames(sav$blup) <- x$slab[x$not.na] rownames(sav$blup.se) <- x$slab[x$not.na] rownames(sav$blup.pi.lb) <- x$slab[x$not.na] rownames(sav$blup.pi.ub) <- x$slab[x$not.na] } ######################################################################### if (plot) plot(sav, ...) ######################################################################### 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.r0000644000176200001440000000345314515471320015135 0ustar liggesusersweights.rma.mh <- function(object, type="diagonal", ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000273014515470776015166 0ustar liggesusersprint.gosh.rma <- function(x, digits=x$digits, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000102114515470442014627 0ustar liggesusersdeviance.rma <- function(object, REML, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000001257714601245553016422 0ustar liggesuserscooks.distance.rma.mv <- function(model, progbar=FALSE, cluster, reestimate=TRUE, parallel="no", ncpus=1, cl, ...) { mstyle <- .get.mstyle() .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 must be of 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 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.r0000644000176200001440000001166614551524225015121 0ustar liggesusersdfbetas.rma.mv <- function(model, progbar=FALSE, cluster, reestimate=TRUE, parallel="no", ncpus=1, cl, ...) { mstyle <- .get.mstyle() .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 must be of 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 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.r0000644000176200001440000001221514601245362016351 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() 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() 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() 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.r0000644000176200001440000000173614527114021016612 0ustar liggesuserscoef.permutest.rma.uni <- function(object, ...) { mstyle <- .get.mstyle() .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.r0000644000176200001440000000355114601245664013531 0ustar liggesusersbldiag <- function(..., order) { mstyle <- .get.mstyle() 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.r0000644000176200001440000032121414601245076013654 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() ### 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", # 2x2 table transformations to SMDs "MPRD","MPRR","MPOR","MPORC","MPPETO","MPORM", # 2x2 table measures for matched pairs / pre-post data "IRR","IRD","IRSD", # two-group person-time data (incidence) 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", # two-group mean/SD 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 / R^2 (raw and r-to-z transformed) "PR","PLN","PLO","PAS","PFT", # single proportions (and transformations thereof) "IR","IRLN","IRS","IRFT", # single-group person-time (incidence) data (and transformations thereof) "MN","SMN","MNLN","CVLN","SDLN", # mean, single-group standardized mean, log(mean), log(CV), log(SD), "MC","SMCC","SMCR","SMCRH","SMCRP","SMCRPH","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 "HR","HD", # hazard (rate) ratios and differences "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", "retopt", "pleasedonotreportI2thankyouverymuch")) ### handle 'knha' argument from ... (note: overrides test argument) if (.isFALSE(ddd$knha)) test <- "z" if (.isTRUE(ddd$knha)) test <- "knha" test <- tolower(test) if (!is.element(test, c("z", "t", "knha", "hksj", "adhoc"))) stop(mstyle$stop("Invalid option selected for 'test' argument.")) if (test == "hksj") test <- "knha" if (missing(scale)) { model <- "rma.uni" } else { model <- "rma.ls" } ### set defaults or get onlyo1, addyi, and addvi arguments onlyo1 <- .chkddd(ddd$onlyo1, FALSE) addyi <- .chkddd(ddd$addyi, TRUE) addvi <- .chkddd(ddd$addvi, TRUE) ### set defaults for i2def and r2def i2def <- .chkddd(ddd$i2def, "1") r2def <- .chkddd(ddd$r2def, "1") ### handle arguments for location-scale models link <- .chkddd(ddd$link, "log", match.arg(ddd$link, c("log", "identity"))) optbeta <- .chkddd(ddd$optbeta, FALSE, .isTRUE(ddd$optbeta)) if (optbeta && !weighted) stop(mstyle$stop("Must use 'weighted=TRUE' when 'optbeta=TRUE'.")) alpha <- .chkddd(ddd$alpha, NA_real_) beta <- .chkddd(ddd$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","SMN","MNLN","CVLN","SDLN"))) { 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","SMCRP","SMCRPH","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","alabama"/"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) tau2.inf <- FALSE 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.arg <- tau2 tau2.inf <- identical(tau2, Inf) } else { tau2.fix <- FALSE tau2.arg <- 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 && !tau2.inf) { ### 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.arg, (RSS - k) / sum(wi)) } else { tau2 <- ifelse(tau2.fix, tau2.arg, (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.arg, (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.arg, (RSS - (k-p)) / trP) } ### DerSimonian-Laird (DL) estimator with iteration (when this converges, same as PM) 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) V <- diag(vi, nrow=k, ncol=k) trP <- .tr(P) trPV <- .tr(P %*% V) RSS <- crossprod(Ymc,P) %*% Ymc tau2 <- ifelse(tau2.fix, tau2.arg, (RSS - trPV) / 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."), call.=FALSE) } } } ### 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.arg, (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'."), call.=FALSE) } } 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 tau^2 using uniroot().")) } else { if (verbose) warning(mstyle$warning("Error in iterative search for tau^2 using uniroot()."), call.=FALSE) } } } } } else { tau2 <- tau2.arg } } ### 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.arg, 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.arg, 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."), call.=FALSE) } } } ### 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'."), call.=FALSE) } } 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 tau^2 using uniroot().")) } else { if (verbose) warning(mstyle$warning("Error in iterative search for tau^2 using uniroot()."), call.=FALSE) } } } } #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.arg } } ### 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 <- c(crossprod(Ymc,PP) %*% Ymc - sum(wi)) / sum(wi^2) } if (method[1] == "REML") { PP <- P %*% P adj <- c(crossprod(Ymc,PP) %*% Ymc - .tr(P)) / .tr(PP) } if (method[1] == "EB") { adj <- c(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.arg, 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."), call.=FALSE) } } ### 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 (method[1] == "DL") 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","DLIT","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","alabama","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" ### can use optimizer="alabama" as a shortcut for optimizer="constrOptim.nl" if (optimizer == "alabama") optimizer <- "constrOptim.nl" ### when using an identity link, automatically set 'constrOptim' as the default optimizer (but 'solnp' by default when optbeta=TRUE) if (link == "identity") { if (optbeta) { if (optimizer == "nlminb") { optimizer <- "solnp" } else { if (!is.element(optimizer, c("solnp","nloptr","constrOptim.nl"))) { optimizer <- "solnp" warning(mstyle$warning(paste0("Can only use optimizers 'solnp', 'nloptr', or 'constrOptim.nl' when link='identity' and optbeta=TRUE (resetting to '", optimizer, "').")), call.=FALSE) } } } else { if (optimizer == "nlminb") { optimizer <- "constrOptim" } else { if (!is.element(optimizer, c("constrOptim","solnp","nloptr","constrOptim.nl"))) { optimizer <- "constrOptim" warning(mstyle$warning(paste0("Can only use optimizers 'constrOptim', 'solnp', 'nloptr', or 'constrOptim.nl' when link='identity' (resetting to '", optimizer, "').")), call.=FALSE) } } } } 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, ineq=link=="identity") optimizer <- tmp$optimizer optcontrol <- tmp$optcontrol par.arg <- tmp$par.arg ctrl.arg <- tmp$ctrl.arg ### set up default cluster when using optimParallel 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 <- paste0(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.arg=alpha, beta.arg=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 (link == "identity") { 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.arg=alpha, beta.arg=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 == "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.arg=alpha, beta.arg=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.arg=alpha, beta.arg=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.arg=alpha, beta.arg=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) } if (isTRUE(ddd$retopt)) 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.arg=alpha, beta.arg=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.arg=alpha, beta.arg=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.arg <- alpha beta.arg <- 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) { if (tau2.inf) { beta <- cbind(coef(lm(yi ~ 0 + X))) vb <- diag(rep(Inf,p), nrow=p, ncol=p) } else { 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 ### handle special case of tau2=Inf if (tau2.inf) vb <- diag(rep(Inf,p), nrow=p, ncol=p) ### ddf calculation if (is.element(test, c("knha","adhoc","t"))) { ddf <- .chkddd(ddd$dfs, k-p, 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.arg))) parms <- ifelse(optbeta, sum(is.na(beta.arg)), 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.arg) res$optbeta <- optbeta if (optbeta) { res$vba <- vba res$beta.fix <- !is.na(beta.arg) } 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.r0000644000176200001440000004260114515470714015706 0ustar liggesuserspermutest.rma.uni <- function(x, exact=FALSE, iter=1000, permci=FALSE, progbar=TRUE, digits, control, ...) { mstyle <- .get.mstyle() .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.md0000644000176200001440000025700514601243655013024 0ustar liggesusers# metafor 4.6-0 (2024-03-28) - the `steps` argument in the various `profile()` functions can now also be a numeric vector to specify for which parameter values the likelihood should be evaluated - a few minor fixes to the dynamic theming of plots based on the foreground and background colors of the plotting device - slightly improved flexibility for setting package options - new measures added to `escalc()`: `"SMN"` for the single-group standardized mean / single-group standardized mean difference, `"SMCRP"` for the standardized mean change using raw score standardization with pooled standard deviations, and `"SMCRPH"` for the standardized mean change using raw score standardization with pooled standard deviations and heteroscedastic population variances at the two measurement occasions - calculation of the sampling variances for measures `"SMDH"`, `"SMD1H"`, and `"SMCRH"` was slightly adjusted for consistency - in `plot.gosh.rma()`, can also set `het="tau"` (to plot the square root of tau^2 as the measure of heterogeneity) - in the various `forest()` functions, argument `ylim` can now only be a single value to specify the lower bound (while the upper bound is still set automatically) - in `forest()` and `regplot()`, observation limits set via `olim` are now properly applied to all elements - various internal improvements to `selmodel()` - `selmodel()` no longer stops with an error when one or more intervals defined by the `steps` argument do not contain any observed p-values (instead a warning is issued and model fitting proceeds, but may fail) - added `decreasing` argument to `selmodel()` for enforcing that the delta estimates must be a monotonically decreasing function of the p-values in the step function model - added the undocumented argument `pval` to `selmodel()` for passing p-values directly to the function (doing this is highly experimental) - some internal refactoring of the code - improved the documentation a bit # 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/MD50000644000176200001440000006144414601312006012221 0ustar liggesusers25107f6e777fd890c02c6f42f528e6ca *DESCRIPTION 2fa9254a117ccc7a628af691cc1193b7 *NAMESPACE 194e109c0ea8c006c7a8b939a9ba25fa *NEWS.md 0bc333c734919be9b29126ea2347d599 *R/AIC.rma.r acfcfae1f9461cf94b91377cde2691e2 *R/BIC.rma.r 08f82d8d86dbeff34cc74bdbe373c358 *R/addpoly.default.r b70eff307f69feb1a8857c1a5193d05a *R/addpoly.predict.rma.r f74a85ebb8b2bc60c9e4fe43b2c182ee *R/addpoly.r 5118c970c16ad67b29bfcf90b1bdca85 *R/addpoly.rma.r bfe716dee5f421668afed5551f7f3afb *R/aggregate.escalc.r 13d6d84f8c4829c7ed3b302b7d958f90 *R/anova.rma.r 9b7c6d4219b7239aeb940a93f9b9f3ff *R/baujat.r bb20a48737ed95593b38c2285bd58437 *R/baujat.rma.r c0d3f05536177bf10812c98a71fdb259 *R/bldiag.r 73fa86948ee4195ab0c03c9dd770ad8e *R/blsplit.r 30b9c7c5d4eaab44326f97bd3d2776af *R/blup.r b3d3edf3c4e5be0ab1913106f61f0bac *R/blup.rma.uni.r e2dc3f1db03c45fcda596d9f0f3e617b *R/coef.matreg.r 154cd0189f5c716a17c24c87e06b1362 *R/coef.permutest.rma.uni.r 4e9eb2e12a5f1c8feed307e705b6b6b9 *R/coef.rma.r af410f040e09d6be41442eefe833ed9c *R/coef.summary.rma.r f01de3f02399102df480b4b15f20bd24 *R/confint.rma.glmm.r 351ad2a2ce9574fbddef2ed5312c614f *R/confint.rma.ls.r 78ecbb99f2a2d7b380cec71d24f40555 *R/confint.rma.mh.r b99181291587c92f8bbcadabcfd8e6a1 *R/confint.rma.mv.r 50be90a6169460f406470f47dd883197 *R/confint.rma.peto.r d733aaca128b0b6de441271138d5945e *R/confint.rma.uni.r f27c2208ee03c7800e06a32ad4e15ce5 *R/confint.rma.uni.selmodel.r 3e741abb899e69d2d2956ee9d3357119 *R/contrmat.r 3233f8c6af64f7dea7d1ec949ae131e3 *R/conv.2x2.r 39694c5957b810e4939779ec2186407f *R/conv.delta.r dc1b38e7cb897522887cce7979a6fac7 *R/conv.fivenum.r f56526286069cffb84016318904114b1 *R/conv.wald.r f0ee9b9bfc5307823f927b7cee355177 *R/cooks.distance.rma.mv.r 3e67396d29e02b21bd712216e6964794 *R/cooks.distance.rma.uni.r eab5a85465f21f2dc9a58055ba597d10 *R/cumul.r 61b1e8f3a7b4d2b5a3366e1dd29d0c83 *R/cumul.rma.mh.r 106264d9ebd2bf5f64861533fd2b816b *R/cumul.rma.peto.r 7deab7f6411b27f3ef4acd4ccef2b6d6 *R/cumul.rma.uni.r b0ce10ffc14224af12bec12be1dad70e *R/deviance.rma.r 8b6fd5db99a01f06cf5c15bfd109a6a9 *R/df.residual.rma.r 34727ce7e4c4382ebf0cc18b49a708d9 *R/dfbetas.rma.mv.r be52077ac7b9873d44c4594a0759610d *R/dfbetas.rma.uni.r 1ae4dcb420a1683ed869fd553397d69f *R/dfround.r 83eff74bcc1dbb02693c6d320ec21075 *R/emmprep.r d37e14e1400705440b84a3eb8fa6497b *R/escalc.r 23c9fbb02e78031973d913c70aae0b10 *R/fitstats.r 7deb18a0ed01cc0b91df5bbfb9b4e44d *R/fitstats.rma.r f0377a04e5a8a327542c178d107ded92 *R/fitted.rma.r 8ca762d72147b3d240033d17a065a1a4 *R/forest.cumul.rma.r d13441419d24e0daa8866eff4f7cdcf4 *R/forest.default.r f5148247e2bb84f6c3cd524c72cd06c6 *R/forest.r 510d82a95f11a25d31c8f86bb07091b9 *R/forest.rma.r 4961072b5d45448e8039aa8ef40460f6 *R/formatters.r ae58c1ba8b1542133afd1e71bb11103d *R/formula.rma.r 13c5c7a4eeb6cd3bd879755a470c1e51 *R/fsn.r b81fbbf3c07fac99db7901735b9a7143 *R/funnel.default.r d1cbb7d3ab050ed099679e78af50aaaa *R/funnel.r 0a3b7accc2425b2e5192860995a49faf *R/funnel.rma.r 2573a8e03e9331881bef8089ac03af1d *R/gosh.r 3d89b6273eb9563cb6a95939d35e843d *R/gosh.rma.r 59ef92890fd02783d662146487d4fda2 *R/hatvalues.rma.mv.r 3031a52282923d30eb7d94be3eeff143 *R/hatvalues.rma.uni.r 41d410d818a21e7bbcb798cecc8b57d2 *R/hc.r b600f181bad753dcc5604c6b9b985534 *R/hc.rma.uni.r cb6eaf717fd76fa165d6d15c6e1203c9 *R/influence.rma.uni.r 79a9a5487b16c86b53c7c221028ad2f4 *R/labbe.r bd063479f17d0568635040971b5bb709 *R/labbe.rma.r e9309f3a06c035f07723140e4e29952e *R/leave1out.r ed69008d2aebc63bd6b63c5fd88bfffa *R/leave1out.rma.mh.r 77c9779aa05b0533ea90babbf0f56541 *R/leave1out.rma.peto.r 449acf1f90a9e00bc0a5092bd431b132 *R/leave1out.rma.uni.r 2df2b71e432e1098e7e2f226fd838b48 *R/llplot.r 0cf91bb97814448a7c3e744799c8f7ba *R/logLik.rma.r 346f31470c9ad3b51def2482f662bdcd *R/matreg.r 072c5707ff325600d0763dd1d40262b2 *R/metafor.news.r c71bda52ead1738943724a190eb25680 *R/methods.anova.rma.r 1420e92c358ac4c188d703dbcd1fc705 *R/methods.confint.rma.r 0d2ba5ee1eb8538d3f0faa49f1084712 *R/methods.escalc.r 978025da03f0829eedb0e20f8d350893 *R/methods.list.rma.r ea059b12928048bbae8eb19bb62d45c8 *R/methods.vif.rma.r 790adad531049d8bac309cfe3190c497 *R/mfopt.r 78fdbb4760c9c39d2ae06e5cd13b7a0d *R/misc.func.hidden.escalc.r e27bc28eac3965815f8d055c46df36ef *R/misc.func.hidden.evals.r ac59129053397447547b490c4920fa70 *R/misc.func.hidden.fsn.r 06ba89cfc785d421202048e68d51487d *R/misc.func.hidden.funnel.r 5ee261837c3593705786fb872e2d1aab *R/misc.func.hidden.glmm.r 2e09d1091441e19fd7321e255959410f *R/misc.func.hidden.mv.r 99e1cc1e6bd6398eab633d0ab0545b8d *R/misc.func.hidden.profile.r 7f2c2734436ba73e2128fc64239f95fa *R/misc.func.hidden.r a60307d13fe547384d13580394729216 *R/misc.func.hidden.selmodel.r 480d42f955c1b6bd896eaee0c2ef89a2 *R/misc.func.hidden.tes.r 49d7da7150a0004c80cd9c83389361fd *R/misc.func.hidden.uni.r e5e285cd17f50971c0db507ecf38b153 *R/misc.func.hidden.vif.r 38f1d80ad0417cebd7cdbd10707a4530 *R/model.matrix.rma.r b404b15bb4b482cf9d70ac948f142bd1 *R/nobs.rma.r 3376538a20fd1ea72c6cc0c76abff14c *R/permutest.r 77420d05dd466641313765a2d1712938 *R/permutest.rma.ls.r b960618ff5e8b8a29f5364d3fb512c8b *R/permutest.rma.uni.r 13f7964f12e4a5c4ba029fa951bef3c2 *R/plot.cumul.rma.r f189d81f1b595cc2cd174f127fd58625 *R/plot.gosh.rma.r b35244de4ddc90d4f81196fdaf30f748 *R/plot.infl.rma.uni.r 6ae4dfdf34731e7b7eda4a1c1227f3aa *R/plot.permutest.rma.uni.r 1c90ef8366073b756a34ab9169d52fdc *R/plot.profile.rma.r cd161749cfa04b1742558c41f30291e9 *R/plot.rma.glmm.r 28b31434ca202f5863560da4b2afce10 *R/plot.rma.mh.r 2c5634ae2cac759a450265bd6bfa9301 *R/plot.rma.peto.r 87bf6397da6ef621f1cce16db4ddfbb2 *R/plot.rma.uni.r bd6a66268bbfaada8ea9762ab37517e8 *R/plot.rma.uni.selmodel.r 281271f23ef172e8ce8cc7a04809b7c6 *R/plot.vif.rma.r 8c7ad88f5a5faaf22e8388d4c8308694 *R/points.regplot.r d865a507b2b53030f4a46756cf37b650 *R/predict.rma.ls.r 7ce996b31c09f964c3f4d562345e5927 *R/predict.rma.r b2ad46120b7ef4851845b8b0a47d9b94 *R/print.anova.rma.r d43d3c9d2b61fd6f04121303b61bb5fe *R/print.confint.rma.r 545ad0ae74a45e3532ad22e6e1c99d48 *R/print.escalc.r d4dbeb6b94b10469ba3d6607b7f82df7 *R/print.fsn.r 3c6819aac9a24599b16b2ccf8c7351fb *R/print.gosh.rma.r aa35d08d0e551e39d972dd83ec36ed46 *R/print.hc.rma.uni.r 04d0d5b809982186c6539fdc6405ede2 *R/print.infl.rma.uni.r f383cc8a162264af03e247954bb45d86 *R/print.list.anova.rma.r f4e711961b4e6c72e7d79d57e3c17faa *R/print.list.confint.rma.r 665d35e6d84bac100d47afe0acc9f75e *R/print.list.rma.r 98daa34f5b56dee6acaa1b280a7a0baa *R/print.matreg.r e0485cbe691e2047ccaf44e647a3d940 *R/print.permutest.rma.uni.r 5f0447fb5cb4e588f500536be3c5dfdb *R/print.profile.rma.r 75d5649864cec5d19b105e0a2cb03559 *R/print.ranktest.r 89cee8049d9de7b99eefc6ce61211f1f *R/print.regtest.r 650c20f7f983d57b68723dc4ad6f296e *R/print.rma.glmm.r 5b49137e5438c729d8d4cbe501c530a7 *R/print.rma.mh.r ba9d6f3add9d5d78e91e3c11e30b8ec6 *R/print.rma.mv.r 319880191c2f18a5e873f387bc8c1975 *R/print.rma.peto.r c87ea7ba379aed775530f611ca931353 *R/print.rma.uni.r b4397bef9d84df65a424c677de46174e *R/print.summary.matreg.r 0dafaa64b7fb53fa34e6d2f03ce4acd1 *R/print.summary.rma.r 79ad86a4804df56ae2076e6fb657c8e4 *R/print.tes.r 64d88373b104a63bd7fc55dcb0bf4009 *R/print.vif.rma.r f852b75608ba1c0822034e68162dbea9 *R/profile.rma.ls.r 52d9f9f6387975145ec57cd9395fe605 *R/profile.rma.mv.r dd7240b652e8a316b7cac224d839ddbe *R/profile.rma.uni.r bf97cac6a67c339fef9ed6a7ba381f64 *R/profile.rma.uni.selmodel.r 38c10f1945d9881f29a7416462c62998 *R/qqnorm.rma.glmm.r 1ca7a5c5774b45d72fd99388348be78e *R/qqnorm.rma.mh.r deb8e92cf40f9bd9d92ac72bdee564dd *R/qqnorm.rma.mv.r f4e4c7d8b4255228f0aac4def5278aab *R/qqnorm.rma.peto.r cc0afd0106152d17528a403b895ee91a *R/qqnorm.rma.uni.r 708901230afb921438232ae1dae2f5de *R/radial.r 43101750419e3d83ba64a2fb0066ab5d *R/radial.rma.r bbd5dbe7b65d4b2ad880d47738643c52 *R/ranef.rma.mv.r e88571e1860772d0af8756878d213d0f *R/ranef.rma.uni.r 70d61ba2d59edaeefc1a510c538b5675 *R/ranktest.r 5ccc005f6e01a7fb07b9248cbf5b4d0a *R/rcalc.r 48adb556610afbd0ac47307d9346e443 *R/regplot.r ad1e3eb96b6d99f574370a3d43e8c55c *R/regplot.rma.r 4212a94e058b6ee1f0656d1523a990ab *R/regtest.r 505700ddeaddc71f2dc25d842b175797 *R/replmiss.r 91777063e31189d96863dc3a8c9de213 *R/reporter.r 75d5da3523976349ddf3f94267c72451 *R/reporter.rma.uni.r 0d41c89e03ada18394efc0c351d94e9c *R/residuals.rma.r b20b448a52e8f325ef746d8f13dda66a *R/rma.glmm.r 26876c1fcf6b9c31ff714c42190bb770 *R/rma.mh.r 2dc602ff4faf9fb54595195d6c18b108 *R/rma.mv.r 71a732370eab3be1786285fd1120ba27 *R/rma.peto.r 1a523becf63a732199140bb9461c92c7 *R/rma.uni.r c7549400ef048f329f3bc18433c9a32a *R/robust.r eec0dbcbfe6f6d3610975cfd5b9607a3 *R/robust.rma.mv.r 65777dbdcca4fe206f1f1d73fb4d5670 *R/robust.rma.uni.r 1c1e9dfcf98dc431c3ac105a0b9cde85 *R/rstandard.rma.mh.r 7f60d191eaf67bb7a12ef0d3d5362a77 *R/rstandard.rma.mv.r 6022988c9ba11f52e2f77bdfef7e6a6b *R/rstandard.rma.peto.r 9d591bb6ddb5f234bb87de38a9db0979 *R/rstandard.rma.uni.r 49a0eabd0d3e6a09e2c3fdf5dc0805e2 *R/rstudent.rma.mh.r a6ec58b850a07bcdd6c33087083b54d4 *R/rstudent.rma.mv.r ff15d64eb28d42014b032c566ddc5c82 *R/rstudent.rma.peto.r 07a1ef1722a6eab8f6522afd21ff9ac4 *R/rstudent.rma.uni.r d31b9a1f07c093dac4a38e92edb83040 *R/selmodel.r f4f907fc38dc6a3a5a8ea1b0e2ad4232 *R/selmodel.rma.uni.r c7abbf1bd9986da505b2609215a16cce *R/simulate.rma.r 792459f89237813c51495e3d53f3c61f *R/summary.escalc.r 056293a09ecb844eae6e09c6b1fe4cc2 *R/summary.matreg.r 3d4a7a8df885bed6085691d9564f823c *R/summary.rma.r 31b4d0a08f90900e0b09a2265d615e0c *R/tes.r a2838909fe979f4e8d85463ce40a55dd *R/to.long.r 2719ba7813c02398aecc96a28796050c *R/to.table.r 3525c13c281f6873a9344512c7ea531b *R/to.wide.r e063bcb1e08fa45d01ab304d30c010e9 *R/transf.r 362bf474245dd51425ef3b345f298778 *R/trimfill.r 1c1d19d1322a85855f80a7b82d1f3342 *R/trimfill.rma.uni.r f1e6af7f7accf8629e3c931381024229 *R/update.rma.r b119bd2d6c0617373dd8401d4394079a *R/vcalc.r 89e23354af21025712f577cc65b08c55 *R/vcov.matreg.r 9ee97e97875a3564827dc23a4e86b661 *R/vcov.rma.r 80def66293b45384a31bf95e5d9c0599 *R/vec2mat.r 728fdc925021f89708a4031cb4f0b5d1 *R/vif.r 63a90ea691e3806dbe8f9f1be6298658 *R/vif.rma.r a006f4fbc230b842059fa1099fb55af3 *R/weights.rma.glmm.r 56374f08b2b3eb0be9cc0a27679cf79f *R/weights.rma.mh.r 22ebc95e3e8caad6c6c96fce7c893bf0 *R/weights.rma.mv.r 1e6712866a9c0dbf2d56e9e6ca942e65 *R/weights.rma.peto.r 9cb48d6bf7dc5832dcea9079697d80db *R/weights.rma.uni.r cd2db0c0fda32f4775214818fd38bfd9 *R/zzz.r 8bb37a0018e66e8e21e8b24e0e0bb2dc *README.md 5d5e8c4dba2b6f100627b808707b9684 *build/metafor.pdf 155e7a628d90e5b3f19504adb9148cd5 *build/stage23.rdb f7e5953175621e52636c4185cc4e1210 *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 13deb37dcdc7d1cb1a9ccfaf97aa2246 *man/addpoly.default.Rd 9f537c8f36c79ca0890055d528edc366 *man/addpoly.predict.rma.Rd 7d5be1c4605eafcf4719f8e0cfa4e795 *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 4ad656a28ea48c58b9980e13c2bbc6c1 *man/blup.Rd a4c3589f1f903fbc1b82c77e2091af5d *man/coef.permutest.rma.uni.Rd 925307c1c44e7b05684e06fbe2ca1581 *man/coef.rma.Rd 01c0f824e45890872f3a96100681ace6 *man/confint.rma.Rd a2c4d9f0d40d2d9fbba53c5b3c9faaac *man/contrmat.Rd 228ca273877cb323327c19f1d632f094 *man/conv.2x2.Rd 3236a8ae060c2a5a8fcf8e4576909d05 *man/conv.delta.Rd 87815ad711c1984e96ce2032b133bda3 *man/conv.fivenum.Rd 62fd23c3859634146724720baceb0623 *man/conv.wald.Rd 4215abf38c3e91af63d1987dae3f3ba6 *man/cumul.Rd 388f141ffdd0cd201a7aae3bb9fadce8 *man/dfround.Rd 99350c560d7723deed79db3496044ba5 *man/emmprep.Rd 2390ab4f0cf230124302575a0265e7d8 *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 66a97a3f31c2e9dcc46b39f26667d5bf *man/forest.cumul.rma.Rd d0243df376c347197db5f2af72998fa5 *man/forest.default.Rd d025b8ea3d314e84655bcbded3d5349a *man/forest.rma.Rd 06636dcf9a4d988299590dd51acbe47d *man/formatters.Rd 68066441613f2a41c4da6baa2570b4b3 *man/formula.rma.Rd c72f68d0ff21e8ef6cc0525571309537 *man/fsn.Rd 2f44c39533f7acae043e0164fe308bad *man/funnel.Rd cd8cd6b98fb2cbf25453c7023919fb14 *man/gosh.Rd fad706901481d27d64bd87c6863f2a45 *man/hc.Rd 8560d4ea64aef2ba1b6e4086a668016f *man/influence.rma.mv.Rd 98d90baf1a6cdb021acddc401cae83e5 *man/influence.rma.uni.Rd 6a7cdd3e5d4b17a2da19421bd8a788b9 *man/labbe.Rd d4f9dcb2e6b793e6aff5797c31a37786 *man/leave1out.Rd b957366547386a7243518b1973311bdc *man/llplot.Rd 20563d95cbd152a9abe16faca5db037a *man/macros/metafor.Rd d57528316f6058bef872112fe931c0de *man/matreg.Rd 606b67376140ce1ebeea4d8cb8523162 *man/metafor-package.Rd 022457426198d0d4ff577284888055ca *man/metafor.news.Rd 4578fbf3f7c23a42fbf41de698cde504 *man/methods.anova.rma.Rd 15287bbd1c065897b61377ba1222dbe6 *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 72079c8db4d3c84692f99e6d7e265c49 *man/mfopt.Rd f258fc00ef51685043d39b2ea60ee9d3 *man/misc-models.Rd 8be3864d0c6d9dba0b3e19be628f3d91 *man/misc-options.Rd 0922b20f88e34104928944bc5d181d8f *man/misc-recs.Rd 99caccea8a46483a51ffc6e992b5a49d *man/model.matrix.rma.Rd 11fc8137da8b3ff0f9c5afd8865249f9 *man/permutest.Rd 0847caabbbe6d530ebf63a2eecbaaaa8 *man/plot.cumul.rma.Rd d5df5c2cbe382262e4b0fdc0efce4d92 *man/plot.gosh.rma.Rd 6d9c1d53bc4c00b530f8d701c63c9e1f *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 2108dd067d27abdcacb1dac2d463dbe8 *man/predict.rma.Rd 5b9d15097abbbf2a127c7938677b0b68 *man/print.anova.rma.Rd bfd9e6ed5d707e7e8ec6367585661330 *man/print.confint.rma.Rd 583d7a23d37b0469c48a6354ba8839bf *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 57041ef6a00b0e4b70db98f0189a3a02 *man/profile.rma.Rd f0f32d1390a01ac0a493544da49ede1e *man/qqnorm.rma.Rd 521ee078fb6966451889e4cf93d5cbbc *man/radial.Rd bbff16f99b2d51435ffb2e3843ca8d24 *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 5f8158a11ffa02828dcd0b2cae308cea *man/rma.glmm.Rd 5db8b1ed9ce75a3d92df417944c42c57 *man/rma.mh.Rd f5ad4b5b41b6df6f9ab1dada1724fdbc *man/rma.mv.Rd db280cac475ea3bdeb0228fa8e33e69f *man/rma.peto.Rd f2ba33418fe9da321652a4131a48ac0c *man/rma.uni.Rd 59f6e966ec80ac1513da932c7bf08064 *man/robust.Rd 9e0d5a96dd6d36801a3c79346f4600d4 *man/selmodel.Rd 213a9563b09d95a9f5281b5fc832f786 *man/simulate.rma.Rd eeee7a7696cfaf35990bfd5c4370940a *man/tes.Rd 4791bfb90d99c966b83a9a7eed5e267f *man/to.long.Rd 7dad81678cea23aa262ac114cbdba5bc *man/to.table.Rd 50eae7c3536924738d684f8159d28a0d *man/to.wide.Rd 1158e676fa4ae4ce3757d47877a69faa *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 c244e0204b94d887896e1be6c329d475 *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 6b966a05b9110cb6a042c657c9149567 *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 dbba51ea395cd1bec2c5b6f7b96148d1 *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 75e52d0d5534ef00c26995117a778277 *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 136576d23f0d11dc63fcb810794a1ae7 *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 c2c5c6a070a59665eb82cbeaa07d1947 *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 51632e1c48a577ea055f9c30bac8c934 *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/0000755000176200001440000000000014601247077012674 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/0000755000176200001440000000000014601247077013441 5ustar liggesusersmetafor/inst/doc/diagram.pdf0000644000176200001440000061371514601247077015555 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.asis0000644000176200001440000000015314513444712016523 0ustar liggesusers%\VignetteEngine{R.rsp::asis} %\VignetteIndexEntry{Conducting Meta-Analyses in R with the metafor Package} metafor/inst/doc/metafor.pdf0000644000176200001440000161472014601247077015604 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.asis0000644000176200001440000000014014513444713016467 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") )

ǹ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.Rd0000644000176200001440000003677614601022223014146 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.Rd0000644000176200001440000003054214601022223014632 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"} (or equivalently, \code{test="hksj"}). 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.assink2016}}, \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.Rd0000644000176200001440000001531114601022223016111 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.Rd0000644000176200001440000003076614601022223014667 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.Rd0000644000176200001440000001630614601022223014203 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.Rd0000644000176200001440000001176314601022223015137 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.Rd0000644000176200001440000004301614601022223015672 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. Can also be a single value to set the lower bound (while the upper bound is still set automatically).} \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 or numeric vector to indicates which rows should be shaded. 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). For example, \code{annosym=c(" [", ", ", "]", "\u2212", "\u2002")} would use a proper minus sign and an \sQuote{en space} for the annotations.} \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}. Value 1 corresponds to using \code{"\u2212"} (a minus) and \code{"\u2002"} (an \sQuote{en space}) in \code{annoyym} as shown above. Value 2 corresponds to \code{"\u2013"} (an \sQuote{en dash}) and \code{"\u2002"} (an \sQuote{en space}). Value 3 corresponds to \code{"\u2212"} (a minus) and \code{"\u2007"} (a \sQuote{figure space}). 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/Latin Modern and Segoe UI, 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.Rd0000644000176200001440000000360214601022223015354 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.Rd0000644000176200001440000000270414601022223016315 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.Rd0000644000176200001440000001315014601022223015326 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.Rd0000644000176200001440000001261614601022223013711 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"}, \code{test="knha"}, \code{test="hksj"}, or \code{test="adhoc"}, 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.Rd0000644000176200001440000003603414601022223013533 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.Rd0000644000176200001440000002767714601022223014343 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.Rd0000644000176200001440000000713714601022223014600 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.Rd0000644000176200001440000003323514601022223015157 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 \code{newmods} is a vector, then only a single predicted value is computed unless the model only includes a single moderator variable, in which case predicted values corresponding to all the vector values are computed). 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. If the matrix specified via \code{newmods} has row names, then these are used to label the predicted values in the output. 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"}, \code{test="knha"}, \code{test="hksj"}, or \code{test="adhoc"}, 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) ### predicted average risk ratios for 10 and 60 degrees latitude in 1970 (row names as labels) predict(res, newmods=rbind(at10=c(10,1970), at60=c(60,1970)), transf=exp) ### 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) ### predicted 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 a 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.Rd0000644000176200001440000002075114601022223016266 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.Rd0000644000176200001440000000250114601022223014161 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.Rd0000644000176200001440000001424114601022223016220 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 covariance ratios, a horizontal reference line is drawn at 1. On the plot of leave-one-out \mjseqn{\tau^2} estimates, a horizontal reference line is drawn at the \mjseqn{\tau^2} estimate based on all cases. On the plot of leave-one-out (residual) heterogeneity test statistics, horizontal reference lines are drawn at the test statistic based on all cases and at \mjseqn{k-p}, the degrees of freedom of the test statistic. 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 (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.Rd0000644000176200001440000002657514601022223013546 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.Rd0000644000176200001440000002003214601022223014403 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"}, \code{test="knha"}, \code{test="hksj"}, or \code{test="adhoc"}; 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.Rd0000644000176200001440000000615714601022223015767 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.Rd0000644000176200001440000001252714601022223014612 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.Rd0000644000176200001440000000463014601022223015004 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.Rd0000644000176200001440000015354514601022223014156 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}}, 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.Rd0000644000176200001440000003220314601022223014220 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.Rd0000644000176200001440000003256214601022223015167 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, \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, \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, \dots) \method{profile}{rma.ls}(fitted, alpha, xlim, ylim, steps=20, lltol=1e-03, progbar=TRUE, parallel="no", ncpus=1, cl, plot=TRUE, \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} parameter the likelihood should be profiled.} \item{tau2}{optional integer to specify for which \mjseqn{\tau^2} parameter the likelihood should be profiled.} \item{rho}{optional integer to specify for which \mjseqn{\rho} parameter the likelihood should be profiled.} \item{gamma2}{optional integer to specify for which \mjseqn{\gamma^2} parameter the likelihood should be profiled.} \item{phi}{optional integer to specify for which \mjseqn{\phi} parameter the likelihood should be profiled.} \item{delta}{optional integer to specify for which \mjseqn{\delta} parameter the likelihood should be profiled.} \item{alpha}{optional integer to specify for which \mjseqn{\alpha} parameter 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). Can also be a numeric vector of length 2 or longer to specify for which parameter values the likelihood should be evaluated (in this case, \code{xlim} is automatically set to \code{range(steps)} if unspecified).} \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}). Can also be a numeric value between 0 and 100 to specify the confidence interval level.} \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 fixing the parameter of interest to a range of values, 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 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 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 \mjseqn{\alpha} parameters that are part of the scale model. Alternatively, one can select one of the parameters to profile by specifying its number via the \code{alpha} argument. } } \subsection{Interpreting Profile Likelihood Plots}{ A profile likelihood plot should show a single peak at the corresponding ML/REML estimate. 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 (assuming that the model was fitted with ML/REML estimation). 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. Similarly, when profiling a correlation component, the peak may be at -1 or +1. 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 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 of the parameter profiled. } \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) ### adjust xlim profile(res, progbar=FALSE, xlim=c(0,1)) ### specify tau^2 values at which to profile the likelihood profile(res, progbar=FALSE, steps=c(seq(0,0.2,length=20),seq(0.3,1,by=0.1))) ### 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)) par(mfrow=c(1,1)) } ### 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) profile(res, progbar=FALSE) } \keyword{hplot} metafor/man/conv.delta.Rd0000644000176200001440000003237614601022223015011 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.Rd0000644000176200001440000001400514601022223014247 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.Rd0000644000176200001440000001025514601022223015263 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.Rd0000644000176200001440000003706014601022223015163 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 \mid \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 48 studies that have examined such an intervention. 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 value shown under \code{estimate} is now an estimate of the unweighted 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 of the studies 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} = 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 (or doing so requires \sQuote{extra-statistical} arguments). 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.Rd0000644000176200001440000001607214601022223015042 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.Rd0000644000176200001440000014720014601022223014316 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"} (or equivalently, \code{test="hksj"}), 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{\log(\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}}, 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 it 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.Rd0000644000176200001440000003204514601022223014422 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.Rd0000644000176200001440000001214614601022223016610 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 the 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.Rd0000644000176200001440000000705014601022223014604 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.Rd0000644000176200001440000000431414601022223014435 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"}, \code{test="knha"}, \code{test="hksj"}, or \code{test="adhoc"}, 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.Rd0000644000176200001440000003773514601022223014255 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{-\log(1-\alpha)}{-log(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\mathopen{}\left(\frac{1+\sqrt{R_i^2}}{1-\sqrt{R_i^2}}\right)\mathclose{}}{z_i = 1/2 log((1+\sqrt(R_i^2))/(1-\sqrt(R_i^2)))} (see Olkin & Finn, 1995, but with the additional \mjeqn{\frac{1}{2}}{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 \mjeqn{p = \frac{n_1}{n_1+n_2}}{p = 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.Rd0000644000176200001440000012465314601022223014560 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, decreasing=FALSE, 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 \mjseqn{\delta} value can be fixed by setting the corresponding element of this argument to the desired value. A \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{decreasing}{logical to specify whether the \mjseqn{\delta} values in a step function selection model must be a monotonically decreasing function of the p-values (the default is \code{FALSE}). Only relevant when \code{type="stepfun"}. 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 according to the model. \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 should 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), Vevea and Woods (2005), and others. 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} for \mjseqn{\alpha_{j-1} < p_i \le \alpha_j} where \mjseqn{\delta_j \ge 0}. 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 should be at least one observed p-value within each interval to fit this model. If there are no p-values between \mjseqn{\alpha_0 = 0} and \mjseqn{\alpha_1} (i.e., within the first interval for which \mjseqn{\delta_1 = 1}), then estimates of \mjseqn{\delta_2, \ldots, \delta_c} will try to drift to infinity. If there are no p-values between \mjseqn{\alpha_{j-1}} and \mjseqn{\alpha_j} for \mjseqn{j = 2, \ldots, c}, then \mjseqn{\delta_j} will try to drift to zero. In either case, results should be treated with great caution. A common practice is then to collapse and/or adjust the intervals until all intervals contain at least one study. By setting \code{ptable=TRUE}, the function just returns the p-value table and does not attempt any model fitting. 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)}. When specifying a single cutpoint in the context of a random-effects model (typically \code{steps=c(.025, 1)} with either \code{alternative="greater"} or \code{alternative="less"}), 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 \mjseqn{\delta_j} (for \mjseqn{j = 2, \ldots, c}) can be larger than 1 (implying a greater likelihood of selection for p-values in the corresponding interval relative to the first interval). With \code{control=list(delta.max=1)}, one can enforce that the likelihood of selection for p-values above the first cutpoint can never be greater than the likelihood of selection for p-values below it. This constraint should be used with caution, as it may force \mjseqn{\delta_j} estimates to fall on the boundary of the parameter space. Alternatively, one can set \code{decreasing=TRUE}, in which case the \mjseqn{\delta_j} values must be a monotonically decreasing function of the p-values (which also forces \mjseqn{\delta_j \le 1}). This feature should be considered experimental. 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{ptable}{frequency table for the observed p-values falling into the intervals defined by the \code{steps} argument (\code{NA} when \code{steps} is not specified).} \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}}, 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}, and when \code{type="stepfun"} with \code{decreasing=TRUE}, in which case the maximum is set to 1). These defaults can be changed via the \code{control} argument by specifying a scalar or a vector of the appropriate length for \code{delta.min} and/or \code{delta.max}. For example, \code{control=list(delta.max=Inf)} lifts the upper bound. Note that when a parameter estimate drifts close to its imposed bound, a warning will be issued. 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). Similarly, for \code{type="beta"} and \code{type="stepfun"}, \mjseqn{\delta} estimates below \mjeqn{10^{-4}}{10^(-4)} are treated as effectively zero for computing the standard errors. In this case, the corresponding standard errors are \code{NA}. This cutoff can be adjusted via the \code{deltatol} control argument (e.g., \code{control=list(deltatol=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.Rd0000644000176200001440000002465314601022223013546 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.Rd0000644000176200001440000000473514601022223014506 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.Rd0000644000176200001440000001053514601022223014652 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"}, \code{test="knha"}, \code{test="hksj"}, or \code{test="adhoc"}, 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.Rd0000644000176200001440000000311514601022223014402 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.Rd0000644000176200001440000003761314601022223014646 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 \code{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.Rd0000644000176200001440000002604414601022223015520 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.Rd0000644000176200001440000000751214601022223014073 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 supports \sQuote{ANSI} color/highlight codes (unset by default). See \link[=misc-options]{here} for details. Can also be a logical and set to \code{FALSE} to switch off output styling when the \code{crayon} package is loaded.} \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.Rd0000644000176200001440000001613114601022223014565 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.Rd0000644000176200001440000000226614601022223016513 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/DESCRIPTION0000644000176200001440000000475414601312006013420 0ustar liggesusersPackage: metafor Version: 4.6-0 Date: 2024-03-28 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, 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: 2024-03-28 11:02:23 UTC; wviechtb Author: Wolfgang Viechtbauer [aut, cre] () Maintainer: Wolfgang Viechtbauer Repository: CRAN Date/Publication: 2024-03-28 16:00:06 UTC metafor/build/0000755000176200001440000000000014601247077013016 5ustar liggesusersmetafor/build/vignette.rds0000644000176200001440000000040514601247077015354 0ustar liggesusersun0 ) &Mr;e\&-m۞. vc/ac1)Y00or&0+, Q y |#juT4%5#NKw0N*.Sfv6wٞVTv {: :?> 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ڕXQs6~ϯ[I:wmǾ)J^9$$$߂ R&H`o?“O^g^-ūIQdaj(.9}? d_Ɂa+&YOi`f= ИYh LFMZy 2;kåY!5x6h3ZKxX#x>l_Bd Có P,m3/l# /[p Qʎɉ#^odc-JH=<ڠp9J@՚ Iude6XF;^E@ &JIUqʵ0ZI C}8P aJb/qJ;htg0qoE?4PiV:؇s$IF lD$%S㸥$EA WQVI|a+5nQ4(V㔏-8w-pJx(r",Bg}TάaWne*nVˎ$gPo4TZ=eIA0`OƉ;eI w0[D:gT%M'2ɠ/:[z9LJz\u>jKU7oՕe5|Ks(!swnWhnPny81w殐ha" G4Ö|Σ.,q΢EԆcB^\>cڕz[|,@BQE0p^YPiqݾ )>bI TG6"rؔ/ ~SkԙY+5'42…j)k_mIyA՛4umCNg!Hl:lV%1e\ Wp6|BKN?|֮HUAȞ06%% >:M؃{ \anF@AEלja>>sj Tj>qJBfi0SާMfL0D[WL)PCMz뒋|VY rihאDٳ%^4/ z!el# LԎ`[ *i1~_֫,c bN=?41VN4iz]y͙a~€{/.RQ],͎z0Դ#D!%3d.x"fw$9(X'jE)1Nu0g{qE_ۼ=޽&.fyYSs`7Ñ_vO?ގzKzny&mk#|7fvH&b.A%$w w.iM *ǼBO͕fԥ?1\76+ޚa.EQ7܏ZWt:W)!yY}FBφځc"8/NM kG[1 po߅7;&ŏC6 8=6`p нMMֶÖ>Jhs]T.RS.ۂ -Mˇ1k]Ev,}: endstream endobj 475 0 obj << /Length 982 /Filter /FlateDecode >> stream xK6:J1|@D;nDmo_Ҳg6]*Zh<89ɇû$%)50J:)#ZɱI>O6c*=g*%vrQ[&|?ٟ3u_WJmp T-T*tmTguⷅ~/qY@Aޗyz'U7C!p.hnqved/kp_pm,K\ R3Ѽ.d MAB|Ip,➆4-|Ec[mFپ)gG!yGQ ˵(6!A-bKxb+ Xڜa>( f!؉#@1b^Pp`(R[oʽUnXVOOqJ,nl$ u}6,. >,8j۱Bbw$CǮkXvK+6#}i6fvoR_ TwoEenhl;|1BXp?F 7c,|hkg endstream endobj 576 0 obj << /Length 895 /Filter /FlateDecode >> stream xKs0UУδ1[aA8/Rg2Iȗ23jW`f!FrlX1" 6yp lg :8kEˆ't7١ugm~v0PnÔN qq"IUᲨZ5 R^bc9RRvo#!Ib " S&%Ү-~JDVzoYׅJ$Z৫t_r4t- b?0]G 9_h3ER1'T E]Su'Z*#o`cjc{d ]gcد`?a&Xlpq7uXlm^d2vo`yy[I&d1:eFgIfy=پQ}+8m벴,^o]9)p* E0g})yF^n\ % 8arׯ׿6Wae8is%iM_]>:|fd1c8{f)r0PzP7m5%i^e 7)8IQm (Ȕ* >TH@yR;V5bƸiCz +C>0=eU8d|qbSoζCƊ8LW䇴tI_T܋cXTdWVTSW4H<~4vM ֗<$TwxzZ"ިhXNܛ! |o· P6肛@a^ Dt )z7M ΀Zt]i-O*Bu/ï"G|jtmZ-+IQT#K{7_7?κ endstream endobj 404 0 obj << /Type /ObjStm /N 100 /First 911 /Length 2576 /Filter /FlateDecode >> stream x[Moϯ>M} pb $1t剭ͮƐFSoRHf="Y,>F!Tp):%JFGOXa bAkI ,IVHtBQ(PxKIuhՓFU MٰYlZ-h+a.ec@LqP_8kqYݨ&,F\1h+zSN>u&+ڍ..APe#Jz"*:PVEG P T1D ¡{bFru5Z  1`LAR{u* |BmZh0ш^m8Q& @1FUwzb"bS:@X{u+7''nz^{r~~Շ6O^et OfzO[7v3o/WFk+^nvחg۫|< k`y|gg<2D+#٫-s7~ڟ_?ӣ_v-zlkk[ jk5Z|@]`PC:2KRR,H1ɎLʀHٗ0$hp#Dq6Os30K5Ga}>P,Ռ-_TK NRmҙyd6Zf zpG@ Y&IAHu]?"$Ľ(8++ baM1{sgnA$;! @E>IJHY*)$#1@QY0 @0 r8$젠]A 䜅;ٱ;NkܢHc%Q$Єzk(B񋓀 =3ʬ)/SN@ sJ3r"1G/K%=dB(]3rO2bD/<~ˀS ec"1 2VϩzgY?weoA_ii%#Mqf&do2cL|"o?*9^Kif4I$lf6I3M&if4I$lf6I3M&if4I$lf6I3M&if4I$lf6I3M&if4I$lf6I3M&if4IZ;M+2/gZH~5cXX0Zatߐ^. 2ߠ籗D.79w1 ȳ4E 6͐2z߳W<.dSYb)Ow8A((T״@ms H>/x9PZ ҽ@mH^=l /,Z2{bhILxaEzj) P-3@}s=8 `'NN E1@;[T.Hߩb +yYȡ=`7 PX(SEƐ8t!~Dͣ w<:[(G;> stream xYKsܸW͜* >sۛnrn1$fC,#j[䤃@Fl\~"((7MA*Myn~~3F'1!Ծ*?IW®t/Ee@,dO|N>]M"u">6:5] !(Zo}BAI8M̎|Mid9z nF]Qr4b BMũŒgE "ʧ<."Ep !c 5@8E!a4=%gbfJ5eZ`g \9\Cf"g!eyd.A{0SKjҊ `۶½a2w`j] 2W$PICl$^2j⏋ =`0%%UGC`A7 8\F.<:0$LW )g { <kT0i9iAS!q͡_*j$/)euSx^KpJ!w$?`:6=q .v cP=K!ײƠ;ZS=4΅ UOe$ L;Ms:C8փL(ٖxݓG\6]PB[[9Pa1⿷!@W_Ѕ'wTm1.6q|6Igd5=ѝ[Yol9"ⰺ6<3/!!D/D\eUk0\ eزj k MEC2m?,i%mSMVwhlmolŅly/*V9~mc>\u3& 9蠕ݠL3AKhY0x;^,>EW[ovkX6쓙 ͉lDeZfٲ,wiAz#yD1lV0#,=8K/4ON"FNb_FFlɬBEwq"0&LLa`7A mȄ+vEsa7 :ϑ<l*cS%(3@]^hVW c4na$c7ulW\jejtGӶg/v_%Ɋ{2v;;FNu;8 #@&b Q]mJkr$깅8gUۂǧnri5w-{v5>wDip,lvϿdz+Hl@vgTy>!!@5 l⦇ItDF)wXB;8ub#*oeY㸅vt-*0HBs/kGe+ M8ga`gcǀG`PqZ |(W(ط"2 U ˾}?B:@s<ޫAb2vOųݳXDO ̽:$!Ra ?q` Z^I gtl1*y~ D4hK|(My۪Ą*;#㈾Tp^_bks3%+ޘ7k0'C$=J:vw_?@:ɥH\X̧=C ܂@ٱp[թre`/&L;tx=:0CN~m%72a^ e[:W- v[.揶o@3 l s1fIɀblbWtgj |SsP=9{?ea??Lŝ쀢:[KxxgV+ ~7L endstream endobj 661 0 obj << /Length 3360 /Filter /FlateDecode >> stream x[Yo~heڈ).!A2A`oMZwKzf<>U,4r`7I(ȉx?^E2%~%ZhΙJzqm~_"^F|?o4iV&v$vJWF]HhhLh6gʇ}j7wL7f?f5ph&,ўK%)3*x%`ӵ˼.}C (/s[|S}[*嵟}|y*_EI:Ƭl\"Pe7m,0n4LJ"nF  MQڼŗk.v{߽] |]G #fa\^|t$s>R-ys>)&eq< M=SwOɉf9՛+Bl;jb;.[$ ^$TB$6K2%X^SIQv{?j`{A*eSA>LA%]3r&CT@G~1Dgurrq6f!cqGX#4IŒN_+d{)0c08M|zH$ T8dz2[S#3_B}6Z&65_zĒxo$˾f;q_! \ؼ.(.BIᓆ: .4oNnfD%0 &4=IR:9w6NF^EY{D@muZhQQkoK@2ӣmm]E>(r*/+wdry22uǣG 'o;oKhi g1FyB0!+bOs,d 8(Tu,KT89E/FcrOOkP'CSCXEs.9{hÌT^~s\b Srr'3Dko5٘AtOnAöBނjAg*Uwmws k$q.19JDLis *]>Flf:BuXа) 0[JA1iwU㿣wO7J`bw4bk*BG#Q(fVu |ġ!T4C%SI$=[f.!.{'GrmURLw 9sJ.#|ijٖ!3 PupLW),[.q H9)]k) *w{3> 埇aj[a/KY3M̲=}􎑇#}q4|jMVfHG&O\>JeS%K`z&g&u-0GbgiLYf(2eSQJg y9"܆x]ˏa1lTYٍ'$`?5Ȅޣ!GJӍ!7.^đCDÑLh@cKrl'k hNat2YM4> Ɖ@3;*;h^),RL8)*;f|ġV\qp p7Byl!_rϧ6H,FAy{OXHgã}aƱ .s7]M_7vlO ίR/q8LƵEp6޻Cs=2a_|j endstream endobj 681 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 720 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 611 0 obj << /Type /ObjStm /N 100 /First 897 /Length 2519 /Filter /FlateDecode >> stream xڽZo6?6"9C0 rWp {w}h/EH+Qp ɜKpetTqH(e(ٕzv5Di^\ q3f(z[.ٞb$(TPS7*^$R咊Kq9J.$BVɨ$G1(*9 3nq_pr :*!aE Bv5*iހ1C:fEW`V2 R̜q D4sxe) *0b3)|b̊`"FTq+Yc4E`JNa>{E'я UXCEIRN~vb#^".'0ku֙R@CLQ⩨T]Mx,**ŮbظFJ6BPz(EkQuޤlhW0~ы K+:F^ @FG0x1h.-bߌVωxv1Frgƕg_Ws<\f.5?/Oofixml̚ʽCj +GVM"pD5]śk^>} FD/iEɞE缃"Ї((y}R&} @u+bP/Nbό| 5SAq=0} DVv_@{P8 oae"gԋb $(Sv76m_..Wm/MAO5a* ~x]K׼rn`͚_r/=].nVc3?9;ykMSFD^]Y۵V]& KYi]BWƮL]~ݸ%Q%MmJ)ׁۢ>80thϱ<F~ݢhGSAР_@bհc Z=bD]+S)ɹ 4OD3+K?_# k72P0$G`X8 qݶƹfm>@ k#8x͏@u7-Vt? )531n.wr?}C-ǬCY.R !o3MC&dAɢIyzԍ/xRVnOzmUd66@B^dDkzU4HrP72y:K CF؊H dž,xQ!5h-S]rPz-OHȻEl)bXd'R7gcxr<n(|ZlA籔,O[(V}>m^|ݶ2x%zteoҕ..!ґqsd˜}Np;.NGtbR{? AzO)%Z$ jZH.5z2F-}W>!II|H-/ԺJR[1ª@nrc xʰ S@S'Co1-vܥ[䘜(6*=ySMۢ›ov"3mˎGQxT;Njnש,- }q@UU- ڧЋM|kH"G{R&|-474ϏWgu_Ǧ9Y&_l~_.zh{1e=3m+!>b⓽eAltj7~mv$i u cFUcdb=ȸᛂAbZrAC=s̉:eEI! DȖsx:y|uaq<%Tm~A}Ώ@`z;b Cƭcn5Dpk߈Ig^= ; x0*r0S#JJV[Ⴞׂ ٓ!3nbRWrW,]6eʵ٤۪nVZj[I+NDLl xbӬOVķ[ b{\j1;Q# p؎E(d\S0Fl$myД)ł<otP\-wي6 d[ܣXA+=bJN0V;m_$CvzȶL^XFN5{n؀:89_}' `; ҌT d& \;N: {;L Ӻw[T`4 fځ (q0;>7:AF endstream endobj 756 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 766 0 obj << /Length 2186 /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`G,Χw'~}8ӊM}jx"}ws;;Zp9ͿmZx1!KH&_l$PtYX.qn#1> 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 VoWȾW?kTDcǕB!n.Ӈu#}J-\4la8hFj}q3DC2._-˔"r ί.V9baG/8U?V?3=yq~|y+[X endstream endobj 803 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 812 0 obj << /Length 2023 /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