mi/0000755000175000017500000000000014247457434011027 5ustar nileshnileshmi/MD50000644000175000017500000000673214247457434011347 0ustar nileshnileshae60994f13d98346931f629d0025d2fe *DESCRIPTION 3cff9345a28fcf308d27cd4fb1024fc2 *NAMESPACE d40a3d06f38c44bdd479a06006eeca4d *R/AllClass.R 3ce3aa32589799fc9cc255946ced225b *R/AllGeneric.R 54582ada9780d1d0a788d3f82c90ebfb *R/change.R 039e4c0888302c0ab552e8407ff21dd1 *R/change_family.R 18dc62aa8a9efe1667e0e4ed1f341d71 *R/change_imputation_method.R c432254da0cc432e7c813d5ab815eb5c *R/change_link.R 5e56fe5aa1f5a955a3422e80a4cfdda1 *R/change_model.R 586ede7677395ec0f91abbc2dc33a0ac *R/change_size.R a7553ff494bd3c261a84ca4b4ad39b6b *R/change_transformation.R 91374c98b46448341e2a46956d9d71c9 *R/change_type.R dfd85e6c34acecb9b4a7a4af970e2b6b *R/complete.R 339925dbf362cf49d2f22e48edb9c845 *R/convenience.R 2f6f8dab8d88b66a080c39aa1bb80579 *R/debug.R 6eff90fe590a73070e77c5d305ff1c8b *R/fit_model.R f7dfe0685bf2085ec8dcf96943dbabdb *R/get_parameters.R 50d72e195ba8724cb42a226f74de4649 *R/hist_methods.R af4c014536a23866f57add672aad7b96 *R/mi.R 9c9b6aeabc5b47d11f268a5caf91ee0c *R/misc.R 1442c0b84378b7fed9497b8d7dfa4804 *R/missing_data.frame.R ccec62837773157bbdea42e4cbed0487 *R/missing_variable.R e460dbaa09804ae44f75c202d33302ff *R/plot_methods.R 176c56f95ae64b9803d6bbe923321a21 *R/pool.R 1f0960308ae1258cacd265ee621d4a5d *R/random_df.R a0a5aef6f895a573d55af58cf42f5d3a *R/sysdata.rda ff146a33b7e5b018a84868092721901d *R/tobin5.R ae4d04291a56901290e61570fe88d109 *R/zzz.R ffc87ca3683f91347c030594f17bcc30 *build/partial.rdb cc72a631c4b8feb6a5bba77a5797ce6e *build/vignette.rds 379ddfae591ad8ea6fabfd77c1d617ec *data/CHAIN.RData f0d0be59b38944ccb05c7db05f83919e *data/nlsyV.RData 49c2291ac7f09d1637fcab7878765298 *inst/CITATION c57ce1f19097e743121d23ccbf63071c *inst/doc/mi_vignette.R 3bb603698bbb07d97015c41d35f18d4d *inst/doc/mi_vignette.Rmd fb2bdae43f06133321a97f9de4450ce7 *inst/doc/mi_vignette.pdf 9681419f7f3ea8cbf1e49216d6afd458 *man/00mi-package.Rd 466b9739a71d35f52fb377d69ce5bfe8 *man/01missing_variable.Rd 7b35a9ee5056c35abab4b4e2745785ee *man/02missing_data.frame.Rd 62cfd3ae53c7fe548bcc066e97da961f *man/03change.Rd 588665cf7644c8632efab60fc9713990 *man/04mi.Rd 4f3212bf4cb51aeaf2c2d1e8bd35c56e *man/05Rhats.Rd a7081eae2613236aac735bf21148e442 *man/06pool.Rd a7ad72bef3c84337ab27f298f1a76604 *man/07complete.Rd ad8d0f17211c20431d4c6c59b47eec55 *man/CHAIN.Rd 4a45140aee0a1fbd45df9fd13fa588da *man/allcategorical_missing_data.frame.Rd 6fb0d4bdc81aed727ced3b3a5118e2a0 *man/bounded.Rd 85cf2151c8d5d8bf7e267905ca56d267 *man/categorical.Rd 12fcc6e58a9b9257f5b393a1f51e3f77 *man/censored-continuous.Rd 7ec42b8bb866483c2dcabe15f377f796 *man/continuous.Rd 9f73b3e29f8b96367c861066ad218399 *man/count.Rd 4cc12091ac5adda3eb0ebde9faba8c98 *man/experiment_missing_data.frame.Rd f18f64b52237f415bec92493213821d9 *man/fit_model.Rd b1d2d8ee4b8b83f249e7e989a4c9aa52 *man/get_parameters.Rd 406b1e3fab5930b77e4cab8cc46a3586 *man/hist.Rd 5b1544026cdd649d2a90a8af69faaad4 *man/irrelevant.Rd 1595a8710c4ec7b4b7525e12e350292c *man/mi-internal.Rd 5967fea9dc60e2408b10ece27886f77f *man/mi2stata.Rd 0522e2704f2ac6e3c01595a37b993f90 *man/mipply.Rd 520f42e38cf48115186e179da03a3585 *man/multilevel_missing_data.frame.Rd 6f389295b9770e77ee6804aba47f2ad0 *man/multinomial.Rd 090d748641c772f39c9287b3bd09c417 *man/nlsyV.Rd 55fb1ae5649deec7a3b7268968966d8d *man/positive.Rd e3ea5ea6be1b9a772bd03e679e5d4715 *man/rdata.frame.Rd d29dd537c8ef0895f39db27059264737 *man/semi-continuous.Rd 2b34d0c66bd45e044b5fe119737f7540 *tests/missing_data.frame.R 276644cf2dc960b51d26396d74b87c15 *tests/missing_variable.R 3bb603698bbb07d97015c41d35f18d4d *vignettes/mi_vignette.Rmd mi/DESCRIPTION0000644000175000017500000000347314247457434012544 0ustar nileshnileshPackage: mi Type: Package Title: Missing Data Imputation and Model Checking Version: 1.1 Date: 2022-06-05 Authors@R: c(person("Andrew", "Gelman", email = "gelman@stat.columbia.edu", role = "ctb"), person("Jennifer", "Hill", email = "jennifer.hill@nyu.edu", role = "ctb"), person("Yu-Sung", "Su", email = "suyusung@tsinghua.edu.cn", role = c("aut")), person("Masanao", "Yajima", email = "my2167@columbia.edu", role = "ctb"), person("Maria", "Pittau", email = "grazia@stat.columbia.edu", role = "ctb"), person("Ben", "Goodrich", email = "benjamin.goodrich@columbia.edu", role = c("cre", "aut")), person("Yajuan", "Si", email = "sophie2012@gmail.com", role = "ctb"), person("Jon", "Kropko", email = "jkropko@gmail.com", role = "aut")) Description: The mi package provides functions for data manipulation, imputing missing values in an approximate Bayesian framework, diagnostics of the models used to generate the imputations, confidence-building mechanisms to validate some of the assumptions of the imputation algorithm, and functions to analyze multiply imputed data sets with the appropriate degree of sampling uncertainty. VignetteBuilder: knitr Depends: R (>= 3.0.0), methods, Matrix, stats4 Imports: arm (>= 1.4-11) Suggests: betareg, lattice, knitr, MASS, nnet, parallel, sn, survival, truncnorm, foreign URL: http://www.stat.columbia.edu/~gelman/ License: GPL (>= 2) LazyLoad: yes Author: Andrew Gelman [ctb], Jennifer Hill [ctb], Yu-Sung Su [aut], Masanao Yajima [ctb], Maria Pittau [ctb], Ben Goodrich [cre, aut], Yajuan Si [ctb], Jon Kropko [aut] Maintainer: Ben Goodrich NeedsCompilation: no Packaged: 2022-06-05 05:31:15 UTC; ben Repository: CRAN Date/Publication: 2022-06-06 20:10:04 UTC mi/man/0000755000175000017500000000000014247037603011572 5ustar nileshnileshmi/man/03change.Rd0000644000175000017500000002355512450147374013464 0ustar nileshnilesh\name{03change} \docType{methods} \alias{03change} \alias{change} \alias{change-methods} \alias{change_family} \alias{change_imputation_method} \alias{change_link} \alias{change_model} \alias{change_size} \alias{change_transformation} \alias{change_type} \title{Make Changes to Discretionary Characteristics of Missing Variables} \description{ These methods change the family, imputation method, size, type, and so forth of a \code{\link{missing_variable}}. They are typically called immediately before calling \code{\link{mi}} because they affect how the conditional expectation of each \code{\link{missing_variable}} is modeled. } \usage{ change(data, y, to, what, ...) change_family(data, y, to, ...) change_imputation_method(data, y, to, ...) change_link(data, y, to, ...) change_model(data, y, to, ...) change_size(data, y, to, ...) change_transformation(data, y, to, ...) change_type(data, y, to, ...) } \arguments{ \item{data}{A \code{\link{missing_data.frame}} (typically) but can be missing for all but the \code{change} function } \item{y}{A character vector (typically) naming one or more \code{\link{missing_variable}}s within the \code{\link{missing_data.frame}} specified by the \bold{data} argument. Alternatively, \bold{y} can be the name of a class that inherits from \code{\link{missing_variable}}, in which case all \code{\link{missing_variable}}s of that class within \code{data} will be changed. Can also be an vector of integers or a logical vector indicating which \code{\link{missing_variable}}s to change. } \item{what}{Typically a character string naming what is to be changed, such as \code{"family"}, \code{"imputation_method"}, \code{"size"}, \code{"transformation"}, \code{"type"}, \code{"link"}, or \code{"model"}. Alternatively, it can be a scalar value, in which case all occurances of that value for the variable indicated by \code{y} will be changed to the value indicated by \code{to} } \item{to}{Typically a character string naming what \code{y} should be changed to, such as one of the admissible families, imputation methods, transformations, or types. If missing, then possible choices for the \code{to} argument will be helpfully printed on the screen. If \code{what} is a number, then \code{to} should be the number (or \code{NA}) that the value designated by \code{what} will be recoded to. See the Details section for more information. } \item{\dots}{Other arguments, not currently utilized} } \details{ In order to run \code{\link{mi}} correctly, data must first be specified to be ready for multiple imputation using the \code{\link{missing_data.frame}} function. For each variable, \code{missing_data.frame} will record information required by \code{mi}: the variable's type, distribution family, and link function; whether a variable should be standardized or tranformed by a log function or square root; what specific model to use for the conditional distribution of the variable in the \code{mi} algorithm and how to draw imputed values from this model; and whether additional rows (for the purposes of prediction) are required. \code{missing_data.frame} will attempt to guess the correct type, family, and link for each variable based on its class in a regular \code{data.frame}. These guesses can be checked with \code{show} and adjusted if necessary with \code{change}. Any further additions to the model in regards to variable transformations, custom conditional models, or extra non-observed predictive cases must be specified with \code{change} before \code{mi} is run. In general, most users will only use the \code{change} command. \code{change} will then call \code{change_family}, \code{change_imputation_method}, \code{change_link}, \code{change_model}, \code{change_size}, \code{change_transformation}, or \code{change_type} depending on what characteristic is specified with the \code{what} option. The other change_* functions can be called directly but are primarily intended to be called indirectly by the change function. \describe{ \item{\code{what = "type"}}{Change the subclass of variable(s) \code{y}. \code{to} should be a character vector whose elements are subclasses of the \code{\link{missing_variable-class}} and are documented further there. Among the most commonly used subclasses are \code{"unordered-categorical"}, \code{"ordered-categorical"}, \code{"binary"}, \code{"interval"}, \code{"continuous"}, \code{"count"}, and \code{"irrelevant"}.} \item{\code{what = "family"}}{Change the distribution family for variable(s) \code{y}. \code{to} must be of class \code{\link{family}} or a list where each element is of class \code{\link{family}}. If a variable is of \code{\link{binary-class}}, then the family must be \code{\link{binomial}} (the default) or possibly \code{\link{quasibinomial}}. If a variable is of \code{\link{ordered-categorical-class}} or \code{\link{unordered-categorical-class}}, use the \code{\link{multinomial}} family. If a variable is of \code{\link{count-class}}, then the family must be \code{\link{quasipoisson}} (the default) or \code{\link{poisson}}. If a variable is continuous, there are more choices for its family, but \code{\link{gaussian}} is the default and the others are not supported yet.} \item{\code{what = "link"}}{Change the link function for variable(s) \code{y}. \code{to} can be any of the supported link functions for the existing \bold{family}. See \code{\link{family}} for details; however, not all of these link functions have appropriate \code{\link{fit_model}} and \code{\link{mi-methods}} yet.} \item{\code{what = "model"}}{Change the conditional model for variable \code{y}. It usually is not necessary to change the model, since it is actually determined by the class, family, and link function of the variable. This option can be used, however, to employ models that are not among those listed above.\code{to} should be a character vector of length one indicating what model should be used during the imputation process. Valid choices for binary variables include \code{"logit"}, \code{"probit"} \code{"cauchit"}, \code{"cloglog"}, or quasilikelihoods \code{"qlogit"}, \code{"qprobit"}, \code{"qcauchit"}, \code{"qcloglog"}. For ordinal variables, valid choices include \code{"ologit"}, \code{"oprobit"}, \code{"ocauchit"}, and \code{"ocloglog"}. For count variables, valid choices include \code{"qpoisson"} and \code{"poisson"}. Currently the only valid option for gaussian variables is \code{"linear"}. To change the model for unordered-categorical variables, see the estimator slot in \code{\link{missing_variable}}.} \item{\code{what = "imputation_method"}}{Change the method for drawing imputed values from the conditional model specified for variable(s) \code{y}. \code{to} should be a character vector of length one or of the same length as \code{y} naming one of the following imputation methods: \code{"ppd"} (posterior predictive distribution), \code{"pmm"} (predictive mean matching), \code{"mean"} (mean imputation), \code{"median"} (median imputation), \code{"expectation"} (conditional expectation imputation).} \item{\code{what = "size"}}{Optionally add additional rows for the purposes of prediction. \code{to} should be a single integer. If \code{to} is non-negative but less than the number of rows in the \code{\link{missing_data.frame}} given by the \code{data} argument, then \code{\link{missing_data.frame}} is augmented with \code{to} more rows, where all the additional observations are missing. If \code{to} is greater than the number of rows in the \code{\link{missing_data.frame}}given by the \code{data} argument, then the \code{\link{missing_data.frame}} is extended to have \code{to} rows, where the observations in the surplus rows are missing. If \code{to} is negative, then any additional rows in the \code{\link{missing_data.frame}} given by the \code{data} argument are removed to restore it to its original size.} \item{\code{what = "transformation"}}{Specify a particular transformation to be applied to variable(s) \code{y}. \code{to} should be a character vector of length one or of the same length as \code{y} indicating what transformation function to use. Valid choices are \code{"identity"} for no transformation, \code{"standardize"} for standardization (using twice the standard deviation of the observed values), \code{"log"} for natural logarithm transformation, \code{"logshift"} for a \code{log(y + a)} transformation where \code{a} is a small constant, or \code{"sqrt"} for square-root transformation. Changing the transformation will also change the inverse transformation in the appropriate way. Any other value of \code{to} will produce an informative error message indicating that the transformation and inverse transformation need to be changed manually.} \item{what = a value}{Finally, if both \code{what} and \code{to} are values then the former is recoded to the latter for all occurances within the missing variable indicated by \code{y}.} } } \value{ If the \bold{data} argument is not missing, then the method returns this argument with the specified changes. If \bold{data} is missing, then the method returns an object that inherits from the \code{\link{missing_variable-class}} with the specified changes. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{missing_variable}}, \code{\link{missing_data.frame}} } \examples{ # STEP 0: GET DATA data(nlsyV, package = "mi") # STEP 1: CONVERT IT TO A missing_data.frame mdf <- missing_data.frame(nlsyV) show(mdf) # STEP 2: CHANGE WHATEVER IS WRONG WITH IT mdf <- change(mdf, y = "momrace", what = "type", to = "un") mdf <- change(mdf, y = "income", what = "imputation_method", to = "pmm") mdf <- change(mdf, y = "binary", what = "family", to = binomial(link = "probit")) mdf <- change(mdf, y = 5, what = "transformation", to = "identity") show(mdf) } \keyword{manip} \keyword{AimedAtUseRs} mi/man/06pool.Rd0000644000175000017500000000342212506167234013201 0ustar nileshnilesh\name{06pool} \alias{06pool} \Rdversion{1.1} \docType{class} \alias{pool} \alias{pooled-class} \alias{pooled-methods} \alias{display,pooled-method} \title{Estimate a Model Pooling Over the Imputed Datasets} \description{ This function estimates a chosen model, taking into account the additional uncertainty that arises due to a finite number of imputations of the missing data. } \usage{ pool(formula, data, m = NULL, FUN = NULL, ...) } \arguments{ \item{formula}{a \code{\link{formula}} in the same syntax as used by \code{\link{glm}} } \item{data}{an object of \code{\link{mi-class}} } \item{m}{number of completed datasets to average over, which if \code{NULL} defaults to the number of chains used in \code{\link{mi}} } \item{FUN}{Function to estimate models or \code{NULL} which uses the same function as used in the \code{\link{fit_model-methods}} for the dependent variable } \item{\dots}{further arguments passed to \code{FUN} } } \details{ \code{FUN} is estimated on each of the \code{m} completed datasets according to the given \code{formula} and the results are combined using the Rubin Rules. } \value{ An object of class \code{"pooled"} whose definition is subject to change but it has a \code{\link{summary}} and \code{\link[arm]{display}} method. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{mi}} } \examples{ if(!exists("imputations", env = .GlobalEnv)) { imputations <- mi:::imputations # cached from example("mi-package") } analysis <- pool(ppvtr.36 ~ first + b.marr + income + momage + momed + momrace, data = imputations) display(analysis) } \keyword{regression} \keyword{AimedAtUseRs} mi/man/positive.Rd0000644000175000017500000000422012450147374013722 0ustar nileshnilesh\name{positive-continuous-class} \Rdversion{1.1} \docType{class} \alias{positive-continuous-class} \alias{proportion-class} \title{Class "positive-continuous" and Inherited Classes} \description{ The positive-continuous class inherits from the \code{\link{continuous-class}} and is the parent of the proportion class. In both cases, no observations can be zero, and in the case of the proportion class, no observations can be one. The \code{\link{nonnegative-continuous-class}} and the \code{\link{SC_proportion-class}} are appropriate for those situations. Aside from these facts, the rest of the documentation here is primarily directed toward developeRs. } \section{Objects from the Classes}{Objects can be created that are of positive-continuous or proportion class via the \code{\link{missing_variable}} generic function by specifying \code{type = "positive-continuous"} or \code{type = "proportion"} } \section{Slots}{ The default transformation for the positive-continuous class is the \code{\link{log}} function. The proportion class inherits from the positive-continuous class and has the identity transformation and the \code{\link{binomial}} family as defaults, in which case the \code{\link{fit_model-methods}} call the \code{\link[betareg]{betareg}} function in the \pkg{betareg} package. Alternatively, the transformation could be an inverse CDF like the \code{\link{qnorm}} function and the family could be \code{\link{gaussian}}, in which case the \code{\link{fit_model-methods}} call the \code{\link[arm]{bayesglm}} function in the \pkg{arm} package. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{missing_variable}}, \code{\link{continuous-class}}, \code{\link{positive-continuous-class}}, \code{\link{proportion-class}} } \examples{ # STEP 0: GET DATA data(CHAIN, package = "mi") # STEP 0.5 CREATE A missing_variable (you never need to actually do this) healthy <- missing_variable(CHAIN$healthy / 100, type = "proportion") show(healthy) } \keyword{classes} \keyword{DirectedTowardDevelopeRs} mi/man/experiment_missing_data.frame.Rd0000644000175000017500000000456512450147374020067 0ustar nileshnilesh\name{experiment_missing_data.frame} \Rdversion{1.1} \docType{class} \alias{experiment_missing_data.frame} \alias{experiment_missing_data.frame-class} \title{Class "experiment_missing_data.frame"} \description{ This class inherits from the \code{\link{missing_data.frame-class}} but is customized for the situation where the sample is a randomized experiment. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("experiment_missing_data.frame", ...)}. However, its users almost always will pass a \code{\link{data.frame}} to the \code{\link{missing_data.frame}} function and specify the \code{subclass} and \code{concept} arguments. } \section{Slots}{ The experiment_missing_data.frame class inherits from the \code{\link{missing_data.frame-class}} and has two additional slots \describe{ \item{concept}{Object of class \code{\link{factor}} whose length is equal to the number of variables and whose levels are \code{"treatment"}, \code{"covariate"} and \code{"outcome"}} \item{case}{Object of class \code{\link{character}} of length one, indicating whether the missingness is in the outcomes only, in the covariates only, or in both the outcomes and covariates. This slot is filled automatically by the \code{\link{initialize}} method} } } \details{ The \code{\link{fit_model-methods}} for the experiment_missing_data.frame class take into account the special nature of a randomized experiment. At the moment, the treatment variable must be binary and fully observed. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{missing_data.frame}} } \examples{ rdf <- rdata.frame(n_full = 2, n_partial = 2, restrictions = "stratified", experiment = TRUE, types = c("t", "ord", "con", "pos"), treatment_cor = c(0, 0, NA, 0, NA)) Sigma <- tcrossprod(rdf$L) rownames(Sigma) <- colnames(Sigma) <- c("treatment", "X_2", "y_1", "Y_2", "missing_y_1", "missing_Y_2") print(round(Sigma, 3)) concept <- as.factor(c("treatment", "covariate", "covariate", "outcome")) mdf <- missing_data.frame(rdf$obs, subclass = "experiment", concept = concept) } \keyword{classes} \keyword{manip} \keyword{AimedAtUseRs} mi/man/multinomial.Rd0000644000175000017500000000217612450147374014422 0ustar nileshnilesh\name{multinomial} \alias{multinomial} \title{The multinomial family} \description{ This function is a returns a \code{\link{family}} and is a generalization of \code{\link{binomial}}. users would only need to call it when calling \code{\link{change}} with \code{what = "family", to = multinomial(link = 'logit')} } \usage{ multinomial(link = "logit") } \arguments{ \item{link}{character string among those supported by \code{\link{binomial}} } } \details{ This function is mostly cosmetic. The \code{family} slot for an object of \code{\link{unordered-categorical-class}} must be \code{multinomial(link = 'logit')}. For an object of \code{\link{ordered-categorical-class}} but not its subclasses, the \code{family} slot must be \code{multinomial()} but the link function can differ from its default (\code{"logit"}) } \value{ A \code{\link{family}} object } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{family}}, \code{\link{binomial}} } \examples{ multinomial() } \keyword{utilities} mi/man/nlsyV.Rd0000644000175000017500000000322714247037603013200 0ustar nileshnilesh\name{nlsyV} \alias{nlsyV} \docType{data} \title{ National Longitudinal Survey of Youth Extract } \description{ This dataset pertains to children and their families in the United States and is intended to illustrate missing data issues. Note that although the original data are longitudinal, this extract is not. } \usage{data(nlsyV)} \format{ A data frame with 400 randomly subsampled observations on the following 7 variables. \describe{ \item{\code{ppvtr.36}}{a numeric vector with data on the Peabody Picture Vocabulary Test (Revised) administered at 36 months} \item{\code{first}}{indicator for whether child was first-born} \item{\code{b.marr}}{indicator for whether mother was married when child was born} \item{\code{income}}{a numeric vector with data on family income in year after the child was born} \item{\code{momage}}{a numeric vector with data on the age of the mother when the child was born} \item{\code{momed}}{educational status of mother when child was born (1 = less than high school, 2 = high school graduate, 3 = some college, 4 = college graduate)} \item{\code{momrace}}{race of mother (1 = black, 2 = Hispanic, 3 = white)} } Note that \bold{momed} would typically be an ordered \code{\link{factor}} while \bold{momrace} would typically be an unorderd \code{\link{factor}} but both are \code{\link{numeric}} in this \code{\link{data.frame}} in order to illustrate the mechanism to \code{\link{change}} the type of a \code{\link{missing_variable}} } \source{ National Longitudinal Survey of Youth, 1997, \url{https://www.bls.gov/nls/nlsy97.htm} } \examples{ data(nlsyV) summary(nlsyV) } \keyword{datasets} mi/man/allcategorical_missing_data.frame.Rd0000644000175000017500000000351612450147374020650 0ustar nileshnilesh\name{allcategorical_missing_data.frame} \Rdversion{1.1} \docType{class} \alias{allcategorical_missing_data.frame} \alias{allcategorical_missing_data.frame-class} \title{Class "allcategorical_missing_data.frame"} \description{ This class inherits from the \code{\link{missing_data.frame-class}} but is customized for the situation where all the variables are categorical. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("allcategorical_missing_data.frame", ...)}. However, its users almost always will pass a \code{\link{data.frame}} to the \code{\link{missing_data.frame}} function and specify the \code{subclass} argument. } \section{Slots}{ The allcategorical_missing_data.frame class inherits from the \code{\link{missing_data.frame-class}} and has three additional slots \describe{ \item{Hstar}{Positive integer indicating the maximum number of latent classes} \item{parameters}{A list that holds the current realization of the unknown parameters} \item{latents}{An object of \code{\link{unordered-categorical-class}} that contains the current realization of the latent classes} } } \details{ The \code{\link{fit_model-methods}} for the allcategorical_missing_data.frame class implement a Gibbs sampler. However, it does not utilize any ordinal information that may be available. Continuous variables should be made into factors using the \code{\link{cut}} command before calling \code{\link{missing_data.frame}}. } \author{ Sophie Si for the algorithm and Ben Goodrich for the R implementation } \seealso{ \code{\link{missing_data.frame}} } \examples{ rdf <- rdata.frame(n_full = 2, n_partial = 2, restrictions = "stratified", types = "ord") mdf <- missing_data.frame(rdf$obs, subclass = "allcategorical") } \keyword{classes} \keyword{manip} \keyword{AimedAtUseRs} mi/man/hist.Rd0000644000175000017500000000256712450147374013043 0ustar nileshnilesh\name{hist} \Rdversion{1.1} \docType{methods} \alias{hist} \alias{hist-methods} \title{Histograms of Multiply Imputed Data } \description{ This function creates a histogram from an object of \code{\link{missing_data.frame-class}} or \code{\link{mi-class}} } \usage{ hist(x, ...) } \arguments{ \item{x}{an object of \code{\link{missing_data.frame-class}} or \code{\link{mi-class}} } \item{\dots}{further arguments passed to \code{\link{plot.histogram}} } } \details{ When called on an object of \code{\link{missing_data.frame-class}}, the histograms of the observed data are generated, one for each \code{\link{missing_variable}} but grouped on a single page. When called on an object of \code{\link{mi-class}}, the histograms of the observed, imputed, and completed data are generated, one for each \code{\link{missing_variable}}, grouped on a single page for each chain. } \value{ An invisible \code{NULL} is returned with a side-effect of creating a plot } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link[graphics]{hist}} } \examples{ if(!exists("imputations", env = .GlobalEnv)) { imputations <- mi:::imputations # cached from example("mi-package") } hist(imputations) } \keyword{hplot} \keyword{AimedAtUseRs} \keyword{methods}mi/man/00mi-package.Rd0000644000175000017500000000305312450147374014221 0ustar nileshnilesh\name{00mi-package} \alias{mi-package} \docType{package} \title{Iterative Multiple Imputation from Conditional Distributions } \description{ The mi package performs multiple imputation for data with missing values. The algorithm iteratively draws imputed values from the conditional distribution for each variable given the observed and imputed values of the other variables in the data. The process approximates a Bayesian framework; multiple chains are run and convergence is assessed after a pre-specified number of iterations within each chain. The package allows customization of the conditional model and the treatment of missing values for each variable. In addition, the package provides graphics to visualize missing data patterns, to diagnose the models used to generate the imputations, and to assess convergence. Functions are included to run statistical models post-imputation with the appropriate degree of sampling uncertainty. } \details{ \tabular{ll}{ Package: \tab mi\cr Type: \tab Package\cr Version: \tab 1.0\cr Date: \tab \Sexpr[eval=TRUE,results=rd,stage=build]{date()} \cr License: \tab GPL (>= 2) \cr LazyLoad: \tab yes\cr } See the vignette for an example of typical usage. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima,Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{missing_data.frame}}, \code{\link{change}}, \code{\link{mi}}, \code{\link{Rhats}}, \code{\link{pool}}, \code{\link{complete}} } \keyword{package} \keyword{AimedAtusers} mi/man/mipply.Rd0000644000175000017500000000471112450147374013377 0ustar nileshnilesh\name{mipply} \alias{mipply} \title{Apply a Function to a Object of Class mi} \description{ This function is a wrapper around \code{\link{sapply}} that is invoked on the \code{data} slot of an object of \code{\link{mi-class}} and / or on an object of \code{\link{missing_data.frame-class}} after being coerced to a \code{\link{data.frame}} } \usage{ mipply(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE, columnwise = TRUE, to.matrix = FALSE) } \arguments{ \item{X}{Object of \code{\link{mi-class}}, \code{\link{missing_data.frame-class}}, \code{\link{missing_variable-class}}, \code{\link{mi_list-class}}, or \code{\link{mdf_list-class}} } \item{FUN}{Function to call} \item{\dots}{Further arguments passed to \code{FUN}, currently broken } \item{simplify}{If \code{TRUE}, coerces result to a vector or matrix if possible } \item{USE.NAMES}{ignored but included for compatibility with \code{\link{sapply}} } \item{columnwise}{logical indicating whether to invoke \code{FUN} on the columns of a \code{\link{missing_data.frame}} after coercing it to a \code{\link{data.frame}} or a \code{\link{matrix}} or to invoke \code{FUN} on the \dQuote{whole} \code{\link{data.frame}} or \code{\link{matrix}} } \item{to.matrix}{Logical indicating whether to coerce each \code{\link{missing_data.frame}} to a numeric \code{\link{matrix}} or to a \code{\link{data.frame}}. The default is \code{FALSE}, in which case the \code{\link{data.frame}} will include \code{\link{factor}}s if any of the \code{\link{missing_variable}}s inherit from \code{\link{categorical-class}} } } \details{ The \code{columnwise} and \code{to.matrix} arguments are the only additions to the argument list in \code{\link{sapply}}, see the Examples section for an illustration of their use. Note that functions such as \code{\link{mean}} only accept \code{\link{numeric}} inputs, which can produce errors or warnings when \code{to.matrix = FALSE}. } \value{ A list, vector, or matrix depending on the arguments } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{sapply}} } \examples{ if(!exists("imputations", env = .GlobalEnv)) { imputations <- mi:::imputations # cached from example("mi-package") } round(mipply(imputations, mean, to.matrix = TRUE), 3) mipply(imputations, summary, columnwise = FALSE) } \keyword{utilities} mi/man/rdata.frame.Rd0000644000175000017500000002472712450147374014262 0ustar nileshnilesh\name{rdata.frame} \alias{rdata.frame} \title{Generate a random data.frame with tunable characteristics} \description{ This function generates a random \code{\link{data.frame}} with a missingness mechanism that is used to impose a missingness pattern. The primary purpose of this function is for use in simulations } \usage{ rdata.frame(N = 1000, restrictions = c("none", "MARish", "triangular", "stratified", "MCAR"), last_CPC = NA_real_, strong = FALSE, pr_miss = .25, Sigma = NULL, alpha = NULL, experiment = FALSE, treatment_cor = c(rep(0, n_full - 1), rep(NA, 2 * n_partial)), n_full = 1, n_partial = 1, n_cat = NULL, eta = 1, df = Inf, types = "continuous", estimate_CPCs = TRUE) } \arguments{ \item{N}{integer indicating the number of observations} \item{restrictions}{character string indicating what restrictions to impose on the the missing data mechansim, see the Details section} \item{last_CPC}{a numeric scalar between \eqn{-1} and \eqn{1} exclusive or \code{NA_real_} (the default). If not \code{NA_real_}, then this value will be used to construct the correlation matrix from which the data are drawn. This option is useful if restrictions is \code{"triangular"} or \code{"stratified"}, in which case the degree to which \code{last_CPC} is not zero causes a violation of the Missing-At-Random assumption that is confined to the last of the partially observed variables} \item{strong}{Integer among 0, 1, and 2 indicating how strong to make the instruments with multiple partially observed variables, in which case the missingness indicators for each partially observed variable can be used as instruments when predicting missingness on other partially observed variables. Only applies when \code{restrictions = "triangular"}} \item{pr_miss}{numeric scalar on the (0,1) interval or vector of length \code{n_partial} indicating the proportion of observations that are missing on partially observed variables} \item{Sigma}{Either \code{\link{NULL}} (the default) or a correlation matrix of appropriate order for the variables (including the missingness indicators). By default, such a matrix is generated at random.} \item{alpha}{Either \code{\link{NULL}}, \code{\link{NA}}, or a numeric vector of appropriate length that governs the skew of a multivariate skewed normal distribution; see \code{\link[sn]{rmsn}}. The appropriate length is \code{n_full - 1 + 2 * n_partial} iff none of the variable types is nominal. If some of the variable types are nominal, then the appropriate length is \code{n_full - 1 + 2 * n_partial + sum(n_cat) - length(n_cat)}. If \code{\link{NULL}}, \code{alpha} is taken to be zero, in which case the data-generating process has no skew. If \code{\link{NA}}, \code{alpha} is drawn from \code{\link{rt}} with \code{df} degrees of freedom} \item{experiment}{logical indicating whether to simulate a randomized experiment} \item{treatment_cor}{Numeric vector of appropriate length indicating the correlations between the treatment variable and the other variables, which is only relevant if \code{experiment = TRUE}. The appropriate length is \code{n_full - 1 + 2 * n_partial} iff none of the variable types is nominal. If some of the variable types are nominal, then the appropriate length is \code{n_full - 1 + 2 * n_partial + sum(n_cat) - length(n_cat)}. If treatment_cor is of length one and is zero, then it will be recylced to the appropriate length. The treatment variable should be uncorrelated with intended covariates and uncorrelated with missingness on intended covariates. If any elements of treatment_cor are \code{\link{NA}}, then those elements will be replaced with random draws. Note that the order of the random variables is: all fully observed variables,all partially observed but not nominal variables, all partially observed nominal variables, all missingness indicators for partially observed variables.} \item{n_full}{integer indicating the number of fully observed variables} \item{n_partial}{integer indicating the number of partially observed variables} \item{n_cat}{Either \code{\link{NULL}} or an integer vector (possibly of length one) indicating the number of categories in each partially observed nominal or ordinal variable; see the Details section} \item{eta}{Positive numeric scalar which serves as a hyperparameter in the data-generating process. The default value of 1 implies that the correlation matrix among the variables is jointly uniformally distributed, using essentially the same logic as in the \pkg{clusterGeneration} package} \item{df}{positive numeric scalar indicating the degress of freedom for the (possibly skewed) multivariate t distribution, which defaults to \code{\link{Inf}} implying a (possibly skewed) multivariate normal distribution} \item{types}{a character vector (possibly of length one, in which case it is recycled) indicating the type for each fully observed and partially observed variable, which currently can be among \code{"continuous"}, \code{"count"}, \code{"binary"}, \code{"treatment"} (which is binary), \code{"ordinal"}, \code{"nominal"}, \code{"proportion"}, \code{"positive"}. See the Details section. Unique abbreviations are acceptable.} \item{estimate_CPCs}{A logical indicating whether the canonical partial correlations between the partially observed variables and the latent missingnesses should be estimated. The default is \code{TRUE} but considerable wall time can be saved by switching it to \code{FALSE} when there are many partially observed variables.} } \details{ By default, the correlation matrix among the variables and missingness indicators is intended to be close to uniform, although it is often not possible to achieve exactly. If \code{restrictions = "none"}, the data will be Not Missing At Random (NMAR). If \code{restrictions = "MARish"}, the departure from Missing At Random (MAR) will be minimized via a call to \code{\link{optim}}, but generally will not fully achieve MAR. If \code{restrictions = "triangular"}, the MAR assumption will hold but the missingness of each partially observed variable will only depend on the fully observed variables and the other latent missingness indicators. If \code{restrictions = "stratified"}, the MAR assumption will hold but the missingness of each partially observed variable will only depend on the fully observed variables. If \code{restrictions = "MCAR"}, the Missing Completely At Random (MCAR) assumption holds, which is much more restrictive than MAR. There are some rules to follow, particularly when specifying \code{types}. First, if \code{experiment = TRUE}, there must be exactly one treatment variable (taken to be binary) and it must come first to ensure that the elements of \code{treatment_cor} are handled properly. Second, if there are any partially observed nominal variables, they must come last; this is to ensure that they are conditionally uncorrelated with each other. Third, fully observed nominal variables are not supported, but they can be made into ordinal variables and then converted to nominal after the fact. Fourth, including both ordinal and nominal partially observed variables is not supported yet, Finally, if any variable is specified as a count, it will not be exactly consistent with the data-generating process. Essentially, a count variable is constructed from a continuous variable by evaluating \code{\link{pt}} on it and passing that to \code{\link{qpois}} with an intensity parameter of 5. The other non-continuous variables are constructed via some transformation or discretization of a continuous variable. If some partially observed variables are either ordinal or nominal (but not both), then the \code{n_cat} argument governs how many categories there are. If \code{n_cat} is \code{NULL}, then the number of categories defaults to three. If \code{n_cat} has length one, then that number of categories will be used for all categorical variables but must be greater than two. Otherwise, the length of \code{n_cat} must match the number of partially observed categorical variables and the number of categories for the \eqn{i}th such variable will be the \eqn{i}th element of \code{n_cat}. } \value{ A list with the following elements: \enumerate{ \item{true}{ a \code{\link{data.frame}} containing no \code{\link{NA}} values} \item{obs}{ a \code{\link{data.frame}} derived from the previous with some \code{\link{NA}} values that represents a dataset that could be observed} \item{empirical_CPCs}{ a numeric vector of empirical Canonical Partial Correlations, which should differ only randomly from zero iff \code{MAR = TRUE} and the data-generating process is multivariate normal} \item{L}{ a Cholesky factor of the correlation matrix used to generate the true data} } In addition, if \code{alpha} is not \code{\link{NULL}}, then the following elements are also included: \enumerate{ \item{alpha}{ the \code{alpha} vector utilized} \item{sn_skewness}{ the skewness of the multivariate skewed normal distribution in the population; note that this value is only an approximation of the skewness when \code{df < Inf}} \item{sn_kurtosis}{ the kurtosis of the multivariate skewed normal distribution in the population; note that this value is only an approximation of the kurtosis when \code{df < Inf}} } } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{data.frame}}, \code{\link{missing_data.frame}} } \examples{ rdf <- rdata.frame(n_partial = 2, df = 5, alpha = rnorm(5)) print(rdf$empirical_CPCs) # not zero rdf <- rdata.frame(n_partial = 2, restrictions = "triangular", alpha = NA) print(rdf$empirical_CPCs) # only randomly different from zero print(rdf$L == 0) # some are exactly zero by construction mdf <- missing_data.frame(rdf$obs) show(mdf) hist(mdf) image(mdf) # a randomized experiment rdf <- rdata.frame(n_full = 2, n_partial = 2, restrictions = "triangular", experiment = TRUE, types = c("t", "ord", "con", "pos"), treatment_cor = c(0, 0, NA, 0, NA)) Sigma <- tcrossprod(rdf$L) rownames(Sigma) <- colnames(Sigma) <- c("treatment", "X_2", "y_1", "Y_2", "missing_y_1", "missing_Y_2") print(round(Sigma, 3)) } \keyword{utilities} mi/man/multilevel_missing_data.frame.Rd0000644000175000017500000000327112450147374020062 0ustar nileshnilesh\name{multilevel_missing_data.frame} \Rdversion{1.1} \docType{class} \alias{multilevel_missing_data.frame} \alias{multilevel_missing_data.frame-class} \title{Class "multilevel_missing_data.frame"} \description{ This class inherits from the \code{\link{missing_data.frame-class}} but is customized for the situation where the sample has a multilevel structure. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("multilevel_missing_data.frame", ...)}. However, its users almost always will pass a \code{\link{data.frame}} to the \code{\link{missing_data.frame}} function and specify the \code{subclass} and \code{groups} arguments. } \section{Slots}{ The multilevel_missing_data.frame class inherits from the \code{\link{missing_data.frame-class}} and has two additional slots \describe{ \item{groups}{Object of class \code{\link{character}} indicating which variables define the multilevel structure} \item{mdf_list}{Object of class \code{mdf_list} whose elements contain a \code{\link{missing_data.frame}} for each group. This slot is filled automatically by the \code{\link{initialize}} method.} } } \details{ The \code{\link{fit_model-methods}} for the multilevel_missing_data.frame class will, by default, utilize multilevel modeling techniques that shrink the estimated parameters for each group toward their global means. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{missing_data.frame}} } \examples{ ## Write example } \keyword{classes} \keyword{manip} \keyword{AimedAtUseRs} mi/man/count.Rd0000644000175000017500000000273712450147374013223 0ustar nileshnilesh\name{count-class} \Rdversion{1.1} \docType{class} \alias{count-class} \title{Class "count"} \description{ The count class inherits from the \code{\link{missing_variable-class}} and is intended for count data. Aside from these facts, the rest of the documentation here is primarily directed toward developers. } \section{Objects from the Classes}{Objects can be created that are of count class via the \code{\link{missing_variable}} generic function by specifying \code{type = "count"} } \section{Slots}{ The count class inherits from the missing_variable class and its \code{raw_data} slot must consist of nonnegative integers. Its default family is \code{\link{quasipoisson}} and its default \code{\link{fit_model}} method is a wrapper for \code{\link[arm]{bayesglm}}. The other possibility for the family is \code{\link{poisson}} but is not recommended due to its overly-restrictive nature. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{missing_variable}}, \code{\link{continuous-class}}, \code{\link{positive-continuous-class}}, \code{\link{proportion-class}} } \examples{ # STEP 0: GET DATA data(CHAIN, package = "mi") # STEP 0.5 CREATE A missing_variable (you never need to actually do this) age <- missing_variable(as.integer(CHAIN$age), type = "count") show(age) } \keyword{classes} \keyword{DirectedTowardDevelopeRs} mi/man/categorical.Rd0000644000175000017500000000710712450147374014344 0ustar nileshnilesh\name{categorical} \Rdversion{1.1} \docType{class} \alias{categorical} \alias{categorical-class} \alias{unordered-categorical-class} \alias{ordered-categorical-class} \alias{interval-class} \alias{binary-class} \alias{grouped-binary-class} \title{Class "categorical" and Inherited Classes} \description{ The categorical class is a virtual class that inherits from the \code{\link{missing_variable-class}} and is the parent of the unordered-categorical and ordered-categorical classes. The ordered-categorical class is the parent of both the binary and interval classes. Aside from these facts, the rest of the documentation here is primarily directed toward developers. } \section{Objects from the Classes}{The categorical class is virtual, so no objects may be created from it. However, the \code{\link{missing_variable}} generic function can be used to instantiate an object that inherits from the categorical class by specifying \code{type = "unordered-categorical"}, \code{type = "ordered-categorical"}, \code{type = "binary"}, \code{type = "grouped-binary"}, or \code{type = "interval"}. } \section{Slots}{ The unordered-categorical class inherits from the categorical class and has no additional slots but must have more than two uniquely observed values in its \code{raw_data} slot. The default \code{\link{fit_model}} method is a wrapper for the \code{\link[nnet]{multinom}} function in the \pkg{nnet} package. The ordered-categorical class inherits from the categorical class and has one additional slot: \describe{ \item{cutpoints}{Object of class \code{"numeric"} which is a vector of thresholds (sometimes estimated) that govern how an assumed latent variable is divided into observed ordered categories} } The \code{\link{fit_model}} method for an ordered-categorical variable is, by default, a wrapper for \code{\link[arm]{bayespolr}}. The binary class inherits from the ordered-categorical class and has no additional slots. It must have exactly two uniquely observed values in its \code{raw_data} slot and its \code{\link{fit_model}} method is, by default, a wrapper for \code{\link[arm]{bayespolr}}. The grouped-binary class inherits from the binary class and has one additional slot: \describe{ \item{strata}{Object of class \code{"character"} which is a vector (possibly of length one) of variable names that group the observations into strata. The named external variables should also be categorical.} } The default \code{\link{fit_model}} method for a grouped-binary variable is a wrapper for the \code{\link[survival]{clogit}} function in the \pkg{survival} package and the variables named in the \bold{strata} slot are passed to the \code{\link[survival]{strata}} function. The interval class inherits from the ordered-categorical class, has no additional slots, and is intended for variables whose observed values are only known up to orderable intervals. Its \code{\link{fit_model}} method is, by default, a wrapper for \code{\link[survival]{survreg}} even though it may or may not be a \dQuote{survival} model in any meaningful sense. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{missing_variable}} } \examples{ # STEP 0: GET DATA data(nlsyV, package = "mi") # STEP 0.5 CREATE A missing_variable (you never need to actually do this) momrace <- missing_variable(as.factor(nlsyV$momrace), type = "unordered-categorical") show(momrace) } \keyword{classes} \keyword{DirectedTowardDevelopeRs} mi/man/07complete.Rd0000644000175000017500000000413712450147374014046 0ustar nileshnilesh\name{07complete} \docType{methods} \alias{07complete} \alias{complete} \alias{complete-methods} \title{Extract the Completed Data} \description{ This function extracts several multiply imputed \code{\link{data.frame}}s from an object of \code{\link{mi-class}}. } \usage{ complete(y, m, ...) } \arguments{ \item{y}{An object of \code{\link{mi-class}} (typically) or \code{\link{missing_data.frame-class}} or \code{\link{missing_variable-class}} } \item{m}{If \bold{y} is an object of \code{\link{mi-class}}, then \code{m} must be a specified integer indicating how many multiply imputed \code{\link{data.frame}}s to return or, if missing, the number of \code{\link{data.frame}}s will be equal to the length of the \bold{data} slot in \code{y}. If \code{y} is not an object of \code{\link{mi-class}}, then \bold{m} must be a specified integer indicating which iteration to use in the resulting \code{\link{data.frame}}, where any non-positive integer is a short hand for the last iteration. } \item{\dots}{Other arguments, not currently utilized} } \details{ Several functions within \pkg{mi} use \code{complete}, although the only reason in principle why a user should need to call \code{complete} is to create \code{\link{data.frame}}s to export to another program. For analysis, it is better to use the \code{\link{pool}} function, although currently \code{\link{pool}} might not offer all the necessary functionality. } \value{ If \bold{y} is an object of \code{\link{mi-class}} and \code{m > 1}, a \code{\link{list}} of \code{m} \code{\link{data.frame}}s is returned. Otherwise, a single \code{\link{data.frame}} is returned. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{mi-class}} } \examples{ if(!exists("imputations", env = .GlobalEnv)) { imputations <- mi:::imputations # cached from example("mi-package") } data.frames <- complete(imputations, 3) lapply(data.frames, summary) } \keyword{manip} \keyword{AimedAtUseRs} mi/man/mi-internal.Rd0000644000175000017500000002234412513725366014311 0ustar nileshnilesh\name{mi-internal} \alias{mi-internal} \alias{change,missing_data.frame,ANY,ANY,character-method} \alias{mi,missing_data.frame,missing-method} \alias{plot,missing_data.frame,missing-method} \alias{plot,mi,ANY-method} \alias{show,missing_data.frame-method} \alias{show,missing_variable-method} \alias{summary,missing_data.frame-method} \alias{summary,mi-method} \alias{show,mi-method} \alias{change_family,missing,missing_variable,family-method} \alias{change_family,missing,proportion,family-method} \alias{change_family,missing,unordered-categorical,family-method} \alias{change_imputation_method,missing,missing_variable,character-method} \alias{change_imputation_method,missing,missing_variable,missing-method} \alias{change_link,missing,missing_variable,character-method} \alias{change_link,missing,missing_variable,missing-method} \alias{change_link,missing_data.frame,character,character-method} \alias{change_link,missing_data.frame,numeric,character-method} \alias{change_link,missing_data.frame,logical,character-method} \alias{change_model,missing,missing_variable,character-method} \alias{change_model,missing_data.frame,character,character-method} \alias{change_model,missing_data.frame,numeric,character-method} \alias{change_model,missing_data.frame,logical,character-method} \alias{change_size,missing,missing_variable,integer-method} \alias{change_size,missing,categorical,integer-method} \alias{change_size,missing,fixed,integer-method} \alias{change_size,missing_data.frame,missing,integer-method} \alias{change_type,missing,missing_variable,character-method} \alias{change_imputation_method,missing_data.frame,logical,character-method} \alias{change_imputation_method,missing_data.frame,numeric,character-method} \alias{change_transformation,missing,missing_variable,missing-method} \alias{change_transformation,missing_data.frame,character,missing-method} \alias{change_transformation,missing_data.frame,character,function-method} \alias{change_transformation,missing_data.frame,numeric,function-method} \alias{change_transformation,missing_data.frame,logical,function-method} \alias{change_type,missing,missing_variable,missing-method} \alias{change_type,missing_data.frame,character,missing-method} \alias{complete,irrelevant,integer-method} \alias{complete,categorical,integer-method} \alias{complete,binary,integer-method} \alias{complete,continuous,integer-method} \alias{complete,nonnegative-continuous,integer-method} \alias{complete,SC_proportion,integer-method} \alias{complete,mi,integer-method} \alias{complete,missing_data.frame,numeric-method} \alias{complete,missing_variable,integer-method} \alias{complete,mi,missing-method} \alias{complete,mi_list,numeric-method} \alias{complete,mi_list,missing-method} \alias{fit_model,missing_variable,missing_data.frame-method} \alias{fit_model,missing,missing_data.frame-method} \alias{fit_model,continuous,missing_data.frame-method} \alias{fit_model,semi-continuous,missing_data.frame-method} \alias{fit_model,nonnegative-continuous,missing_data.frame-method} \alias{fit_model,SC_proportion,missing_data.frame-method} \alias{fit_model,proportion,missing_data.frame-method} \alias{fit_model,truncated-continuous,missing_data.frame-method} \alias{fit_model,censored-continuous,missing_data.frame-method} \alias{fit_model,missing_variable,experiment_missing_data.frame-method} \alias{fit_model,continuous,experiment_missing_data.frame-method} \alias{fit_model,missing,multilevel_missing_data.frame-method} \alias{fit_model,missing,mdf_list-method} \alias{fit_model,binary,allcategorical_missing_data.frame-method} \alias{fit_model,missing,allcategorical_missing_data.frame-method} \alias{fit_model,ordered-categorical,allcategorical_missing_data.frame-method} \alias{fit_model,unordered-categorical,allcategorical_missing_data.frame-method} \alias{get_parameters,ANY-method} \alias{get_parameters,polr-method} \alias{get_parameters,multinom-method} \alias{get_parameters,mi-method} \alias{get_parameters,mi_list-method} \alias{get_parameters,missing_data.frame-method} \alias{get_parameters,missing_variable-method} \alias{hist,mi-method} \alias{hist,missing_variable-method} \alias{hist,semi-continuous-method} \alias{hist,binary-method} \alias{hist,categorical-method} \alias{initialize,missing_variable-method} \alias{image,mi-method} \alias{image,mi_list-method} \alias{image,mdf_list-method} \alias{image,missing_data.frame-method} \alias{image,dgTMatrix-method} \alias{mi,character,missing-method} \alias{mi,missing_variable,ANY-method} \alias{mi,missing_variable,missing-method} \alias{mi,semi-continuous,missing-method} \alias{mi,bounded-continuous,missing-method} \alias{mi,binary,glm-method} \alias{mi,grouped-binary,clogit-method} \alias{mi,continuous,glm-method} \alias{mi,bounded-continuous,glm-method} \alias{mi,SC_proportion,betareg-method} \alias{mi,proportion,betareg-method} \alias{mi,nonnegative-continuous,glm-method} \alias{mi,censored-continuous,glm-method} \alias{mi,semi-continuous,glm-method} \alias{mi,categorical,missing-method} \alias{mi,count,glm-method} \alias{mi,data.frame,missing-method} \alias{mi,irrelevant,ANY-method} \alias{mi,interval,glm-method} \alias{mi,mdf_list,missing-method} \alias{mi,mi_list,missing-method} \alias{mi,list,missing-method} \alias{mi,missing_data.frame,mi-method} \alias{mi,matrix,missing-method} \alias{mi,mi,missing-method} \alias{mi,by,missing-method} \alias{mi,missing_variable,ANY-method} \alias{mi,missing_variable,missing-method} \alias{mi,nonnegative-continuous,missing-method} \alias{mi,ordered-categorical,polr-method} \alias{mi,proportion,glm-method} \alias{mi,unordered-categorical,multinom-method} \alias{mi,unordered-categorical,RNL-method} \alias{mi,categorical,matrix-method} \alias{missing_data.frame,data.frame-method} \alias{missing_data.frame,list-method} \alias{missing_data.frame,matrix-method} \alias{missing_variable,ANY,character-method} \alias{missing_variable,ANY,missing-method} \alias{betareg-class} \alias{clogit-class} \alias{mdf_list-class} \alias{mi_list-class} \alias{family-class} \alias{multinom-class} \alias{RNL-class} \alias{plot,missing_data.frame,missing_variable-method} \alias{plot,mi_list,ANY-method} \alias{plot,allcategorical_missing_data.frame,binary-method} \alias{plot,allcategorical_missing_data.frame,categorical-method} \alias{change_family,missing_data.frame,character,character-method} \alias{change_family,missing,missing_variable,missing-method} \alias{change_family,missing_data.frame,character,family-method} \alias{change_family,missing_data.frame,character,list-method} \alias{change_family,missing_data.frame,logical,character-method} \alias{change_family,missing_data.frame,logical,family-method} \alias{change_family,missing_data.frame,numeric,character-method} \alias{change_family,missing_data.frame,numeric,family-method} \alias{change_family,missing_data.frame,numeric,list-method} \alias{change_imputation_method,missing_data.frame,character,character-method} \alias{change_size,missing_data.frame,numeric-method} \alias{change_transformation,missing,missing_variable,function-method} \alias{change_transformation,missing_data.frame,character,character-method} \alias{change_transformation,missing_data.frame,numeric,character-method} \alias{change_transformation,missing_data.frame,logical,character-method} \alias{change_type,missing_data.frame,character,character-method} \alias{change_type,missing_data.frame,logical,character-method} \alias{change_type,missing_data.frame,numeric,character-method} \alias{change,missing_data.frame,ANY,numeric,numeric-method} \alias{change,missing_data.frame,ANY,logical,numeric-method} \alias{change,missing_data.frame,ANY,character,numeric-method} \alias{change,missing_data.frame,ANY,logical,character-method} \alias{change,mdf_list,ANY,ANY,ANY-method} \alias{coerce,data.frame,missing_data.frame-method} \alias{coerce,matrix,missing_data.frame-method} \alias{coerce,missing_data.frame,data.frame-method} \alias{coerce,missing_data.frame,matrix-method} \alias{complete,missing_data.frame,integer-method} \alias{complete,mi,numeric-method} \alias{fit_model,binary,missing_data.frame-method} \alias{fit_model,grouped-binary,missing_data.frame-method} \alias{fit_model,count,missing_data.frame-method} \alias{fit_model,irrelevant,missing_data.frame-method} \alias{fit_model,interval,missing_data.frame-method} \alias{fit_model,missing_variable,missing_data.frame-method} \alias{fit_model,ordered-categorical,missing_data.frame-method} \alias{fit_model,unordered-categorical,missing_data.frame-method} \alias{fit_model,character,mi-method} \alias{fit_model,missing,mi-method} \alias{fit_model,missing_data.frame,missing_data.frame-method} \alias{hist,missing_data.frame-method} \alias{hist,mdf_list-method} \alias{hist,mi_list-method} \alias{initialize,missing_data.frame-method} \alias{plot,missing_data.frame,binary-method} \alias{plot,missing_data.frame,categorical-method} \alias{plot,missing_data.frame,semi-continuous-method} \alias{plot,missing_data.frame,missing_variable-method} \alias{plot,mi,missing-method} \alias{traceplot,mi} \alias{traceplot,mi_list} \alias{.prune} \alias{.possible_missing_variable} \title{Internal Functions and Methods} \description{ These functions are not intended to be called directly. In the case of methods, they documented elsewhere, either with the associated generic function or with the class of the object that the method is defined for. } \keyword{internal}mi/man/fit_model.Rd0000644000175000017500000000670212450147374014031 0ustar nileshnilesh\name{fit_model} \docType{methods} \alias{fit_model} \alias{fit_model-methods} \title{Wrappers To Fit a Model} \description{ The methods are called by the \code{\link{mi}} function to model a given \code{\link{missing_variable}} as a function of all the other \code{\link{missing_variable}}s and also their missingness pattern. By overwriting these methods, users can change the way a \code{\link{missing_variable}} is modeled for the purposes of imputing its missing values. See also the table in \code{\link{missing_variable}}. } \usage{ fit_model(y, data, ...) } \arguments{ \item{y}{An object that inherits from \code{\link{missing_variable-class}} or missing } \item{data}{A \code{\link{missing_data.frame}} } \item{\dots}{Additional arguments, not currently utilized } } \details{ In \code{\link{mi}}, each \code{\link{missing_variable}} is modeled as a function of all the other \code{\link{missing_variable}}s plus their missingness pattern. The \code{fit_model} methods are typically short wrappers around a statistical model fitting function and return the estimated model. The model is then passed to one of the \code{\link{mi-methods}} to impute the missing values of that \code{\link{missing_variable}}. Users can easily overwrite these methods to estimate a different model, such as wrapping \code{\link{glm}} instead of \code{\link[arm]{bayesglm}}. See the source code for examples, but the basic outline is to first extract the \code{X} slot of the \code{\link{missing_data.frame}}, then drop some of its columns using the \code{index} slot of the \code{\link{missing_data.frame}}, next pass the result along with the \code{data} slot of \code{y} to a statistical fitting function, and finally returned the appropriately classed result (along with the subset of \code{X} used in the model). Many of the optional arguments to a statistical fitting function can be specified using the slots of \code{y} (e.g. its \code{family} slot) or the slots of \bold{data} (e.g. its \code{weights} slot). The exception is the method where \code{y} is missing, which is used internally by \code{\link{mi}}, and should \emph{not} be overwritten unless great care is taken to understand its role. } \value{ If \code{y} is missing, then the modified \code{\link{missing_data.frame}} passed to \code{data} is returned. Otherwise, the estimated model is returned as a classed list object. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{missing_variable}}, \code{\link{mi}}, \code{\link{get_parameters}} } \examples{ getMethod("fit_model", signature(y = "binary", data = "missing_data.frame")) setMethod("fit_model", signature(y = "binary", data = "missing_data.frame"), def = function(y, data, ...) { to_drop <- data@index[[y@variable_name]] X <- data@X[, -to_drop] start <- NULL # using glm.fit() instead of bayesglm.fit() out <- glm.fit(X, y@data, weights = data@weights[[y@variable_name]], start = start, family = y@family, Warning = FALSE, ...) out$x <- X class(out) <- c("glm", "lm") # not "bayesglm" class anymore return(out) }) \dontrun{ if(!exists("imputations", env = .GlobalEnv)) { imputations <- mi:::imputations # cached from example("mi-package") } imputations <- mi(imputations) # will use new fit_model() method for binary variables } } \keyword{regression} \keyword{DirectedTowardDevelopeRs} mi/man/CHAIN.Rd0000644000175000017500000000400512450147374012703 0ustar nileshnilesh\name{CHAIN} \docType{data} \alias{CHAIN} \title{ Subset of variables from the CHAIN project } \description{ The CHAIN project was a longitudinal cohort study of people living with HIV in New York City, which was recruited in 1994 from a large number of medical care and social service agencies serving HIV in New York City. This subset of data pertain to the sixth round of interviews. } \usage{data(CHAIN)} \format{ A \code{\link{data.frame}} with 532 observations on the following 8 variables. \describe{ \item{\code{log_virus}}{ log of self reported viral load level, where zero represents an undetectable level. } \item{\code{age}}{ age at time of the interview } \item{\code{income}}{ annual family income in 10 intervals } \item{\code{healthy}}{ a continuous scale of physical health with a theoretical range between 0 and 100 where better health is associated with higher scale values } \item{\code{mental}}{ a binary measure of poor mental health ( 1=Yes, 0=No ) } \item{\code{damage}}{ ordered interval for the CD4 count, which is an indicator of how much damage HIV has caused to the immune system } \item{\code{treatment}}{ a three-level ordered variable: 0=Not currently taking HAART (Highly Active AntiretRoviral Therapy) 1=taking HAART but nonadherent, 2=taking HAART and adherent } } } \details{ A missing value in the log virus load level was assigned to individuals who either could not recall their viral load level, did not have a viral load test in the six month preceding the interview, or reported their viral loads as "good" or "bad". } \source{ http://cchps.columbia.edu/research.cfm } \references{ Messeri P, Lee G, Abramson DA, Aidala A, Chiasson MA, Jones JD. (2003). \dQuote{Antiretroviral therapy and declining AIDS mortality in New York City}. \emph{Medical Care} 41:512--521. } \keyword{datasets} mi/man/02missing_data.frame.Rd0000644000175000017500000002501012457333431015753 0ustar nileshnilesh\name{02missing_data.frame} \Rdversion{1.1} \docType{class} \alias{02missing_data.frame} \alias{missing_data.frame-class} \alias{missing_data.frame} \title{Class "missing_data.frame"} \description{ This class is similar to a \code{\link{data.frame}} but is customized for the situation in which variables with missing data are being modeled for multiple imputation. This class primarily consists of a list of \code{\link{missing_variable}}s plus slots containing metadata indicating how the \code{\link{missing_variable}}s relate to each other. Most operations that work for a \code{\link{data.frame}} also work for a missing_data.frame. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("missing_data.frame", ...)}. However, useRs almost always will pass a \code{\link{data.frame}} to the missing_data.frame constructor function to produce an object of missing_data.frame class. } \usage{ missing_data.frame(y, ...) ## Hidden arguments not included in the signature ## favor_ordered = TRUE, favor_positive = FALSE, ## subclass = NA_character_, ## include_missingness = TRUE, skip_correlation_check = FALSE } \arguments{ \item{y}{Usually a \code{\link{data.frame}}, possibly a numeric matrix, possibly a list of \code{\link{missing_variable}}s.} \item{\dots}{Hidden arguments. The \code{favor_ordered} and \code{favor_positive} arguments are passed to the \code{\link{missing_variable}} function and are documented under the \code{type} argument. Briefly, they affect the heuristics that are used to guess what class a variable should be coerced to. The \code{subclass} argument defaults to \code{\link{NA}} and can be used to specify that the resulting object should inherit from the missing_data.frame class rather than be an object of \code{missing_data.frame} class. Any further arguments are passed to the \code{\link{initialize-methods}} for a missing_data.frame. They currently are \code{include_missingness}, which defaults to \code{TRUE} and indicates that the missingness pattern of the other variables should be included when modeling a particular \code{\link{missing_variable}}, and \code{skip_correlation_check}, which defaults to FALSE and indicates whether to skip the default check for whether the observed values of each pair of \code{\link{missing_variable}}s has a perfect absolute Spearman \code{\link{cor}}relation. } } \section{Slots}{ This section is primarily aimed at developeRs. A missing_data.frame inherits from \code{\link{data.frame}} but has the following additional slots: \describe{ \item{\code{variables}:}{Object of class \code{"list"} and each list element is an object that inherits from the \code{\link{missing_variable-class}} } \item{\code{no_missing}:}{Object of class \code{"logical"}, which is a vector whose length is the same as the length of the \bold{variables} slot indicating whether the corresponding \code{\link{missing_variable}} is fully observed } \item{\code{patterns}:}{Object of class \code{\link{factor}} whose length is equal to the number of observation and whose elements indicate the missingness pattern for that observation} \item{\code{DIM}:}{Object of class \code{"integer"} of length two indicating first the number of observations and second the length of the \bold{variables} slot } \item{\code{DIMNAMES}:}{Object of class \code{"list"} of length two providing the appropriate number rownames and column names } \item{\code{postprocess}:}{Object of class \code{"function"} used to create additional variables from existing variables, such as interactions between two \code{\link{missing_variable}}s once their missing values have been imputed. Does not work at the moment} \item{\code{index}:}{Object of class \code{"list"} whose length is equal to the number of \code{\link{missing_variable}}s with some missing values. Each list element is an integer vector indicating which columns of the \bold{X} slot must be dropped when modeling the corresponding \code{\link{missing_variable}} } \item{\code{X}:}{Object of \code{\link{MatrixTypeThing-class}} with rows equal to the number of observations and is loosely related to a \code{\link{model.matrix}}. Rather than repeatedly parsing a \code{\link{formula}} during the multiple imputation process, this \bold{X} matrix is created once and some of its columns are dropped when modeling a \code{\link{missing_variable}} utilizing the \bold{index} slot. The columns of the \bold{X} matrix consists of numeric representations of the \code{\link{missing_variable}}s plus (by default) the unique missingness patterns } \item{\code{weights}:}{Object of class \code{"list"} whose length is equal to one or the number of \code{\link{missing_variable}}s with some missing values. Each list element is passed to the corresponding argument of \code{\link{bayesglm}} and similar functions. In particular, some observations can be given a weight of zero, which should drop them when modeling some \code{\link{missing_variable}}s} \item{\code{priors}:}{Object of class \code{"list"} whose length is equal to the number of \code{\link{missing_variable}}s and whose elements give appropriate values for the priors used by the model fitting function wraped by the \code{\link{fit_model-methods}}; see, e.g., \code{\link[arm]{bayesglm}}} \item{\code{correlations}:}{Object of class \code{"matrix"} with rows and columns equal to the length of the \bold{variables} slot. Its strict upper triangle contains Spearman \code{\link{cor}}relations between pairs of variables (ignoring missing values), and its strict lower triangle contains Squared Multiple Correlations (SMCs) between a variable and all other variables (ignoring missing values). If either a Spearman correlation or a SMC is very close to unity, there may be difficulty or error messages during the multiple imputation process.} \item{\code{done}:}{Object of class \code{"logical"} of length one indicating whether the missing values have been imputed} \item{\code{workpath}:}{Object of class \code{\link{character}} of length one indicating the path to a working directory that is used to store some objects} } } \details{ In most cases, the first step of an analysis is for a useR to call the \code{missing_data.frame} function on a \code{\link{data.frame}} whose variables have some \code{\link{NA}} values, which will call the \code{\link{missing_variable}} function on each column of the \code{\link{data.frame}} and return the \code{\link{list}} that fills the \bold{variable} slot. The classes of the list elements will depend on the nature of the column of the \code{\link{data.frame}} and various fallible heuristics. The success rate can be enhanced by making sure that columns of the original \code{\link{data.frame}} that are intended to be categorical variables are (ordered if appropriate) \code{\link{factor}}s with labels. Even in the best case scenario, it will often be necessary to utlize the \code{\link{change}} function to modify various discretionary aspects of the \code{\link{missing_variable}}s in the \bold{variables} slot of the missing_data.frame. The \code{\link{show}} method for a missing_data.frame should be utilized to get a quick overview of the \code{\link{missing_variable}}s in a missing_data.frame and recognized what needs to be \code{\link{change}}d. } \section{Methods}{ There are many methods that are defined for a missing_data.frame, although some are primarily intended for developers. The most relevant ones for users are: \describe{ \item{change}{\code{signature(data = "missing_data.frame", y = "ANY", what = "character", to = "ANY")} which is used to change discretionary aspects of the \code{\link{missing_variable}}s in the \bold{variables} slot of a missing_data.frame} \item{hist}{\code{signature(x = "missing_data.frame")} which shows histograms of the observed variables that have missingness} \item{image}{\code{signature(x = "missing_data.frame")} which plots an image of the \bold{missingness} slot to visualize the pattern of missingness when \code{grayscale = FALSE} or the pattern of missingness in light of the observed values (\code{grayscale = TRUE}, the default)} \item{mi}{\code{signature(y = "missing_data.frame", model = "missing")} which multiply imputes the missing values} \item{show}{\code{signature(object = "missing_data.frame")} which gives an overview of the salient characteristics of the \code{\link{missing_variable}}s in the \bold{variables} slot of a missing_data.frame } \item{summary}{\code{signature(object = "missing_data.frame")} which produces the same result as the \code{\link{summary}} method for a \code{\link{data.frame}}} } There are also S3 methods for the \code{\link{dim}}, \code{\link{dimnames}}, and \code{\link{names}} generics, which allow functions like \code{\link{nrow}}, \code{\link{ncol}}, \code{\link{rownames}}, \code{\link{colnames}}, etc. to work as expected on \code{missing_data.frame}s. Also, accessing and changing elements for a \code{missing_data.frame} mostly works the same way as for a \code{\link{data.frame}} } \value{ The \code{missing_data.frame} constructor function returns an object of class \code{missing_data.frame} or that inherits from the \code{missing_data.frame} class. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{change}}, \code{\link{missing_variable}}, \code{\link{mi}}, \code{\link{experiment_missing_data.frame}}, \code{\link{multilevel_missing_data.frame}} } \examples{ # STEP 0: Get data data(CHAIN, package = "mi") # STEP 1: Convert to a missing_data.frame mdf <- missing_data.frame(CHAIN) # warnings about missingness patterns show(mdf) # STEP 2: change things mdf <- change(mdf, y = "log_virus", what = "transformation", to = "identity") # STEP 3: look deeper summary(mdf) hist(mdf) image(mdf) # STEP 4: impute \dontrun{ imputations <- mi(mdf) } ## An example with subsetting on a fully observed variable data(nlsyV, package = "mi") mdfs <- missing_data.frame(nlsyV, favor_positive = TRUE, favor_ordered = FALSE, by = "first") mdfs <- change(mdfs, y = "momed", what = "type", to = "ord") show(mdfs) } \keyword{classes} \keyword{manip} \keyword{AimedAtUseRs}mi/man/semi-continuous.Rd0000644000175000017500000001045212450147374015225 0ustar nileshnilesh\name{semi-continuous-class} \Rdversion{1.1} \docType{class} \alias{semi-continuous} \alias{semi-continuous-class} \alias{semi-continuous} \alias{nonnegative-continuous-class} \alias{nonnegative-continuous} \alias{SC_proportion-class} \alias{SC_proportion} \title{Class "semi-continuous" and Inherited Classes} \description{ The \code{semi-continuous} class inherits from the \code{\link{continuous-class}} and is the parent of the \code{nonnegative-continuous} class, which in turn is the parent of the \code{SC_proportion class} for semi-continuous variables. A semi-continuous variable has support on one or more point masses and a continuous interval. The \code{semi-continuous} class differs from the \code{\link{censored-continuous-class}} and the \code{\link{truncated-continuous-class}} in that observations that fall on the point masses are bonafide data, rather than indicators of censoring or truncation. If there are no observations that fall on a point mass, then either the \code{\link{continuous-class}} or one of its other subclasses should be used. Aside from these facts, the rest of the documentation here is primarily directed toward developers. } \section{Objects from the Classes}{Objects can be created that are of \code{semi-continuous}, \code{nonnegative-continuous}, or \code{SC_proportion} class via the \code{\link{missing_variable}} generic function by specifying \code{type = "semi-continuous"} \code{type = "nonnegative-continuous"}, \code{type = "SC_proportion"}. } \section{Slots}{ The semi-continuous class inherits from the continuous class and is intended for variables that, for example have a point mass at certain points and are continuous in between. Thus, its default transformation is the identity transformation, which is to say no transformation in practice. It has one additional slot. \describe{ \item{indicator}{Object of class \code{"ordered-categorical"} that indicates whether an observed value falls on a point mass or the continuous interval in between. By convention, zero signifies an observation that falls within the continuous interval} } At the moment, there are no methods for the semi-continuous class. However, the basic approach to modeling a semi-continuous variable has two steps. First, the \bold{indicator} is modeled using the methods that are defined for it and its missing values are imputed. Second, the continuous part of the semi-continuous variable is modeled using the same techniques that are used when modeling continuous variables. Note that in the second step, only a subset of the observations are modeled, although this subset possibly includes values that were originally missing in which case they are imputed. The nonnegative-continuous class inherits from the semi-continuous class, which has its point mass at zero and is continuous over the positive real line. By default, the transformation for the positive part of a nonnegative-continuuos variable is \code{log(y + a)}, where \code{a} is a small constant determined by the observed data. If a variable is strictly positive, the \code{\link{positive-continuous-class}} should be used instead. The SC_proportion class inherits from the nonnegative-continuous class. It has no additional slots, and the only supported transformation function is the \code{(y * (n - 1) + .5) / n} function. Its default \code{\link{fit_model}} method is a wrapper for the \code{\link[betareg]{betareg}} function in the \pkg{betareg} package. Its \bold{family} must be \code{\link{binomial}} so that its \code{link} function can be passed to \code{\link[betareg]{betareg}} If the observed values fall strictly on the open unit interval, the \code{\link{proportion-class}} should be used instead. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{missing_variable}}, \code{\link{continuous-class}}, \code{\link{positive-continuous-class}}, \code{\link{proportion-class}} } \examples{ # STEP 0: GET DATA data(nlsyV, package = "mi") # STEP 0.5 CREATE A missing_variable (you never need to actually do this) income <- missing_variable(nlsyV$income, type = "nonnegative-continuous") show(income) } \keyword{classes} \keyword{DirectedTowardDevelopeRs} mi/man/irrelevant.Rd0000644000175000017500000000367312450147374014246 0ustar nileshnilesh\name{irrelevant} \Rdversion{1.1} \docType{class} \alias{irrelevant} \alias{irrelevant-class} \alias{fixed-class} \alias{group-class} \title{Class "irrelevant" and Inherited Classes} \description{ The irrelevant class inherits from the \code{\link{missing_variable-class}} and is used to designate variables that are excluded from the models used to impute the missing values of \dQuote{relevant} variables. For example, if a survey has an \dQuote{id} variable that simply distinguishes observations, the user should designate it as irrelevant, although it will automatically be classified so if its name is either \dQuote{id} or starts with punctuation (including underscores). The fixed class inherits from the irrelevant class and is used for variables that are constant (within a sample). A variable that is instantiated from the fixed class cannot have any missing values. The group class inherits from the fixed class and is used like a \code{\link{factor}} to spit samples in multilevel modeling; see \code{\link{multilevel_missing_data.frame-class}}. None of these classes have an additional slots. Aside from these facts, the rest of the documentation here is primarily directed toward developeRs. } \section{Objects from the Classes}{The \code{\link{missing_variable}} generic function can be used to instantiate an object that inherits from the irrelevant class by specifying \code{type = "irrelevant"}, \code{type = "fixed"}, or \code{type = "group"}. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{missing_variable-class}} } \examples{ # STEP 0: GET DATA data(nlsyV, package = "mi") # STEP 0.5 CREATE A missing_variable (you never need to actually do this) first <- missing_variable(as.factor(nlsyV$first), type = "group") show(first) } \keyword{classes} \keyword{DirectedTowardDevelopeRs} mi/man/bounded.Rd0000644000175000017500000000531312450147374013504 0ustar nileshnilesh\name{bounded-continuous-class} \Rdversion{1.1} \docType{class} \alias{bounded-continuous-class} \alias{bounded-continuous} \title{Class "bounded-continuous"} \description{ The bounded-continuous class inherits from the \code{\link{continuous-class}} and is intended for variables whose observations fall within open intervals that have \emph{known} boundaries. Although proportions satisfy this definition, the \code{\link{proportion-class}} should be used in that case. At the moment, a bounded continuous variable is modeled as if it were simply a continuous variable, but its \code{\link{mi-methods}} impute the missing values from a truncated normal distribution using the \code{\link[truncnorm]{rtruncnorm}} function in the \pkg{truncnorm} package. Note that the default transformation is the identity so if another transformation is used, the bounds must be specified on the transformed data. Aside from these facts, the rest of the documentation here is primarily directed toward developers. } \section{Objects from the Classes}{Objects can be created that are of bounded-continuous class via the the \code{\link{missing_variable}} generic function by specifying \code{type = "bounded-continuous"} as well as \code{lower} and / or \code{upper} } \section{Slots}{ The bounded-continuous class inherits from the continuous class and is intended for variables that are supported on a known interval. Its default transformation function is the identity transformation and its \code{imputation_method} must be \code{"ppd"}. It has two additional slots: \describe{ \item{upper}{a numeric vector whose length is either one or the value of the \code{n_total} slot giving the upper bound for \emph{every} observation; \code{NA}s are not allowed} \item{lower}{a numeric vector whose length is either one or the value of the \code{n_total} slot giving the lower bound for \emph{every} observation; \code{NA}s are not allowed} } } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{missing_variable}}, \code{\link{continuous-class}}, \code{\link{positive-continuous-class}}, \code{\link{proportion-class}} } \examples{ # STEP 0: GET DATA data(CHAIN, package = "mi") # STEP 0.5 CREATE A missing_variable (you never need to actually do this) lo_bound <- 0 hi_bound <- rep(Inf, nrow(CHAIN)) hi_bound[CHAIN$log_virus == 0] <- 6 log_virus <- missing_variable(ifelse(CHAIN$log_virus == 0, NA, CHAIN$log_virus), type = "bounded-continuous", lower = lo_bound, upper = hi_bound) show(log_virus) } \keyword{classes} \keyword{DirectedTowardDevelopeRs} mi/man/censored-continuous.Rd0000644000175000017500000001012712450147374016071 0ustar nileshnilesh\name{censored-continuous-class} \Rdversion{1.1} \docType{class} \alias{truncated-continuous-class} \alias{truncated-continuous} \alias{FF_truncated-continuous-class} \alias{FN_truncated-continuous-class} \alias{NF_truncated-continuous-class} \alias{NN_truncated-continuous-class} \alias{censored-continuous-class} \alias{censored-continuous} \alias{FF_censored-continuous-class} \alias{FN_censored-continuous-class} \alias{NF_censored-continuous-class} \alias{NN_censored-continuous-class} \title{The "censored-continuous" Class, the "truncated-continuous" Class and Inherited Classes} \description{ The censored-continuous class and the truncated-continuous class are both virtual and both inherit from the \code{\link{continuous-class}} and each is the parent of four classes that differ depending on whether the lower and upper bounds are numeric vectors or functions. A censored observation is one whose exact value is not observed. A truncated observation is one whose exact value is not observed and which implies that values on some \emph{other} variables are not observed for that unit of observation. An example of truncation might be that some taxation forms are not required when a person's income falls below a certain threshold. The methods for these classes are not working yet. Aside from these facts, the rest of the documentation here is primarily directed toward developeRs. } \section{Objects from the Classes}{Both the censored-continuous class and the truncated-continuous class are virtual, so no objects can be created with these classes. However, the \code{\link{missing_variable}} generic function can be used to create an object that inherits from one of their subclasses by specifying \code{type = "NNcensored-continuous"}, \code{type = "NFcensored-continuous"}, \code{type = "FNcensored-continuous"}, \code{type = "FFcensored-continuous"}, \code{type = "NNtruncated-continuous"}, \code{type = "NFtruncated-continuous"}, \code{type = "FNtruncated-continuous"}, \code{type = "FFtruncated-continuous"}. When doing so, the lower and upper slots need to be specified appropriately. } \section{Slots}{ The censored-continuous class and the truncated-continuous class are both virtual, both inherit from the continuous class, both use the identity transformation by default, and both have two additional slots: \describe{ \item{upper}{The upper bound for each observation} \item{lower}{The lower bound for each observation} } Both the censored-continuous class and the truncated-continuous class have four subclasses that differ depending on whether the upper and / or lower bounds are numeric vectors or functions that output numeric vectors (scalars are recycled and can be \code{Inf}). These subclasses are \describe{ \item{NN_censored-continuous}{where both the lower and upper bounds are numeric vectors} \item{FN_censored-continuous}{where the lower bound is a function and the upper bound is a numeric vector} \item{NF_censored-continuous}{where the lower bound is a numeric vector and the upper bound is a function} \item{FF_censored-continuous}{where both the lower and upper bounds are functions} \item{NN_truncated-continuous}{where both the lower and upper bounds are numeric vectors} \item{FN_truncated-continuous}{where the lower bound is a function and the upper bound is a numeric vector} \item{NF_truncated-continuous}{where the lower bound is a numeric vector and the upper bound is a function} \item{FF_truncated-continuous}{where both the lower and upper bounds are functions} } } \author{ Ben Goodrich, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{missing_variable}}, \code{\link{continuous-class}} } \examples{ # STEP 0: GET DATA data(CHAIN, package = "mi") # STEP 0.5 CREATE A missing_variable (you never need to actually do this) #log_virus <- missing_variable(CHAIN$log_virus, type = "NN_censored-continuous", # lower = 0, upper = Inf) #show(log_virus) } \keyword{classes} \keyword{DirectedTowardDevelopeRs} mi/man/mi2stata.Rd0000644000175000017500000000667712450147374013626 0ustar nileshnilesh\name{mi2stata} \alias{mi2stata} \title{Exports completed data in Stata (.dta) or comma-separated (.csv) format} \description{ This function exports completed data from an object of \code{\link{mi-class}} in which \code{m} completed \code{\link{data.frame}}s are appended to the end of the raw data. Two additional variables are added which indicate the row number and distinguish the \code{\link{data.frame}}s. The outputed file is either Stata (.dta) or comma-separated (.csv) format, and can be easily registered in Stata as multiply imputed data.} \usage{ mi2stata(imputations, m, file, missing.ind=FALSE, ...) } \arguments{ \item{imputations}{Object of \code{\link{mi-class}}} \item{m}{The number of completed datasets to append onto the raw data} \item{file}{The filename, either a full path or relative to the working directory, where the file will be saved. Filenames must end in either '.dta' or '.csv'. Files with names ending in '.dta' will be saved as a Stata data file, and files with names ending in '.csv' will be saved as a comma-separated file.} \item{missing.ind}{If \code{TRUE}, includes a binary variable for each variable with \code{\link{NA}} values, indicating the observations which were originally missing. Defaults to \code{FALSE}.} \item{\dots}{Further arguments passed to \code{\link{write.dta}} for Stata files, or to \code{\link{write.table}} for .csv files.} } \details{ The function calls \code{\link{complete}} to construct \code{m} completed \code{\link{data.frame}}s, and uses \code{\link{rbind}} to append them to the bottom of the raw data that still contains all of the missing values. Two new variables are added: \code{_mi}, which contains the observation numbers; and \code{_mj}, which indexes the \code{\link{data.frame}}s. To save a Stata .dta file, end the filename with '.dta'. To save a comma-separated file, end the filename with .csv'. Stata files are loaded into Stata using Stata's \code{use} command, and comma-separated files can be loaded by typing \code{insheet using} \emph{filename}\code{, comma names clear}. Once the file is loaded into Stata, the data must be registered as multiply imputed before any subsequent analyses can be performed. In Stata version 11 or later, type \code{mi import mice} to register the data. The \code{_mi} and \code{_mj} variables will be replaced by variables named \code{_mi_id} and \code{_mi_m} respectively. In Stata version 10 or earlier, install the \code{MIM} package by typing \code{findit mim} and installing package \code{st0139_1}. Then the prefix \code{mim:} must be added to any command using the multiply imputed data. Any observations which are unpossible (legitimately skipped, and are not imputed, see \code{\link{missing_variable}}) will remain missing in the complete data, but will not be indicated as missing by these variables. If there are any unpossible values, missing indicators are included automatically. } \value{ \code{NULL} } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{complete}}, \code{\link{mi}}, \code{\link{write.dta}}, \code{\link{write.table}} } \examples{ fn <- paste(tempfile(), "dta", sep = ".") if(!exists("imputations", env = .GlobalEnv)) { imputations <- mi:::imputations # cached from example("mi-package") } mi2stata(imputations, m=5, file=fn , missing.ind=TRUE) } \keyword{utilities} mi/man/05Rhats.Rd0000644000175000017500000000415312513731514013306 0ustar nileshnilesh\name{05Rhats} \alias{Rhats} \alias{05Rhats} \alias{mi2BUGS} \title{Convergence Diagnostics} \description{ These functions are used to gauge whether \code{\link{mi}} has converged. } \usage{ Rhats(imputations, statistic = c("moments", "imputations", "parameters")) mi2BUGS(imputations, statistic = c("moments", "imputations", "parameters")) } \arguments{ \item{imputations}{an object of \code{\link{mi-class}} } \item{statistic}{single character string among \code{"moments"}, \code{"imputations"}, and \code{"parameters"} indicating what statistic to monitor for convergence } } \details{ If \code{statistic = "moments"} (the default), then the mean and standard deviation of each variable will be monitored over the iterations. If \code{statistic = "imputations"}, then the imputed values will be monitored, which may be quite large and quite slow and is not possible if the \code{save_RAM = TRUE} flag was set in the call to the \code{\link{mi}} function. If \code{statistic = "parameters"}, then the estimated coefficients and ancillary parameters extracted by the \code{\link{get_parameters-methods}} will be monitored. \code{Rhats} produces a vector of R-hat convergence statistics that compare the variance between chains to the variance across chains. Values closer to 1.0 indicate little is to be gained by running the chains longer, and in general, values greater than 1.1 indicate that the chains should be run longer. See Gelman, Carlin, Stern, and Rubin, "Bayesian Data Analysis", Second Edition, 2009, p.304 for more information about the R-hat statistic. \code{mi2BUGS} outputs the history of the indicated statistic } \value{ \code{mi2BUGS} returns an array while \code{Rhats} a vector of R-hat convergence statistics. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \examples{ if(!exists("imputations", env = .GlobalEnv)) { imputations <- mi:::imputations # cached from example("mi-package") } dim(mi2BUGS(imputations)) Rhats(imputations) } \keyword{manip} \keyword{AimedAtUseRs} mi/man/get_parameters.Rd0000644000175000017500000000271612450147374015072 0ustar nileshnilesh\name{get_parameters} \docType{methods} \alias{get_parameters} \alias{get_parameters-methods} \title{An Extractor Function for Model Parameters} \description{ This function is not intended to be called directly by users. During the multiple imputation process, the \code{\link{mi}} function estimates models and stores the estimated parameters in the \code{parameters} slot of an object that inherits from the \code{\link{missing_variable-class}}. The \code{get_parameter} function simply extracts these parameters for storeage, which are usually the estimated coefficients but may also include ancillary parameters. } \usage{ get_parameters(object, ...) } \arguments{ \item{object}{Usually an estimated model, such as that produced by \code{\link{glm}} } \item{\dots}{Additional arguments, currently not used } } \details{ There is method for the object produced by \code{\link{polr}}, which also returns the estimated cutpoints in a proportional odds model. However, the default method simply calls \code{\link{coef}} and returns the result. If users implement their own models, it may be necessary to write a short \code{get_parameters} method. } \value{ A numeric vector of estimated parameters } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{fit_model}} } \examples{ showMethods("get_parameters") } \keyword{methods}mi/man/01missing_variable.Rd0000644000175000017500000003661212513632423015543 0ustar nileshnilesh\name{01missing_variable} \Rdversion{1.1} \docType{class} \alias{01missing_variable} \alias{missing_variable} \alias{missing_variable-class} \alias{MatrixTypeThing-class} \alias{WeAreFamily-class} \title{Class "missing_variable" and Inherited Classes} \description{ The missing_variable class is essentially the data comprising a variable plus all the metadata needed to understand how its missing values will be imputed. However, no variable is merely of missing_variable class; rather every variable is of a class that inherits from the missing_variable class. Even if a variable has no missing values, it needs to be coerced to a class that inherits from the missing_variable class before it can be used to impute values of other missing_variables. Understanding the properties of different subclasses of the missing_variable class is essential for modeling and imputing them. The \code{\link{missing_data.frame-class}} is essentially a list of objects that inherit from the missing_variable class, plus metadata need to understand how these missing_variables relate to each other. Most users will never need to call \code{missing_variable} directly since it is called by \code{\link{missing_data.frame}}. } \section{Objects from the Classes}{The missing_variable class is virtual, so no objects may be created from it. However, the missing_variable generic function can be used to instantiate an object that inherits from the missing_variable class by specifying its \code{type} argument. A user would call the \code{\link{missing_data.frame}} function on a \code{\link{data.frame}}, which in turn calls the missing_variable function on each column of the \code{\link{data.frame}} using various heuristics to guess the \code{type} argument. } \usage{ missing_variable(y, type, ...) ## Hidden arugments not included in the signature: ## favor_ordered = TRUE, favor_positive = FALSE, ## variable_name = deparse(substitute(y)) } \arguments{ \item{y}{Can be any vector, some of whose values may be \code{\link{NA}}, which will comprise the \bold{raw_data} slot of a missing_variable (see the Slots section). It is recommended that this vector \emph{not} have any transformations, such as a log-transformation. Any continuous variable can be transformed using the function in its \bold{transformation} slot. The transformations and other discretionary aspects of a missing_variable are typically changed by calling the \code{\link{change}} function on a \code{\link{missing_data.frame}} See the Slots section for more details. } \item{type}{Missing or a character string among the classes that inherit from the missing_variable class. If missing, the constructor will guess (sometimes incorrectly) based on the characteristics of the variable. The best way to improve the guessing of categorical variables is to use the \code{\link{factor}} function --- possibly with \code{ordered = TRUE} --- to create (possibly ordered) factors that will correctly be coerced to objects of \code{\link{unordered-categorical-class}} and \code{\link{ordered-categorical-class}} respectively. If you fail to do so, the hidden arguments that are not included in the signature affect the guesses. If \code{favor_ordered = TRUE}, which is the default, it will tend to guess that variables with few unique values are should be coerced to \code{\link{ordered-categorical-class}} and \code{\link{unordered-categorical-class}} otherwise. If \code{favor_positive = FALSE}, which is the default, it will tend to guess that variables with many unique values are merely continuous, whether or not all the observed values are positive. If \code{favor_positive = TRUE} nonnegative or positive variables will get coerced to \code{\link{nonnegative-continuous-class}} or \code{\link{positive-continuous-class}}. See the Slots section and the specific help pages for more details on the subclasses. } \item{\dots}{Further hidden arguments that are not in the signature. The \code{favor_ordered} and \code{favor_positive} arguments are documented immediately above. The \code{variable} name argument can be used to control what gets put in the \bold{variable_name} slot, see the Slots section below. } } \section{Slots}{ In the following table, indentation indicates inheritance from the class with less indentation, and italics indicates that the class is virtual so no variables can be created with that class. Inherited classes inherit the transformations, families, link functions, and \code{\link{fit_model-methods}} from their parent class, although these are often superceeded by analogues that are tailored for the inherited class. Also note, the default transformation for the continuous class is a standardization using \emph{twice} the standard deviation of the observed values. The distinction between the transformation entailed by the \code{\link{family}} and the transformation entailed by the function in the \bold{tranformation} slot may be confusing at this point. The former pertains to how the linear predictor of a variable is mapped to the space of a variable when it is on the left-hand side of a generalized linear model. The latter pertains --- for continuous variables only --- to how the values in the \bold{raw_data} slot are mapped into those in the \bold{data} and thus affects how a continuous variable enters into the model whether it is on the left or right-hand side. The classes are discussed in much more detail below. \tabular{lll}{ \bold{Class name [transformation]} \tab \bold{Default family and link} \tab \bold{Default \code{\link{fit_model}}} \cr \emph{missing_variable} \tab none \tab throws error \cr \code{ } \emph{categorical} \tab none \tab throws error \cr \code{ } \code{ } unordered-categorical \tab \code{binomial(link = 'logit')} \tab \code{\link[nnet]{multinom}} \cr \code{ } \code{ } ordered-categorical \tab \code{binomial(link = 'logit')} \tab \code{\link[arm]{bayespolr}} \cr \code{ } \code{ } \code{ } binary \tab \code{binomial(link = 'logit')} \tab \code{\link[arm]{bayesglm}} \cr \code{ } \code{ } \code{ } interval \tab \code{gaussian{link = 'identity'}} \tab \code{\link[survival]{survreg}} \cr \code{ } continuous[standardize] \tab \code{gaussian{link = 'identity'}} \tab \code{\link[arm]{bayesglm}} \cr \code{ } \code{ } semi-continuous[identity] \tab \tab \cr \code{ } \code{ } \code{ } nonnegative-continuous[logshift] \tab \tab \cr \code{ } \code{ } \code{ } \code{ } SC_proportion[squeeze] \tab \code{binomial(link = 'logit')} \tab \code{\link[betareg]{betareg}} \cr \code{ } \code{ } positive-continuous[\code{\link{log}}] \tab \tab \cr \code{ } \code{ } \code{ } proportion[identity] \tab \code{binomial(link = 'logit')} \tab \code{\link[betareg]{betareg}} \cr \code{ } \code{ } bounded-continuous[identity] \tab \tab \cr \code{ } count \tab \code{quasipoisson{link = 'log'}} \tab \code{\link[arm]{bayesglm}} \cr \code{ } irrelevant \tab \tab throws error \cr \code{ } \code{ } fixed \tab \tab throws error \cr } The missing_variable class is virtual and has the following slots (this information is primarily directed at developeRs): \describe{ \item{\code{variable_name}:}{Object of class \code{\link{character}} of length one naming the variable} \item{\code{raw_data}:}{Object of class \code{"ANY"} representing the observations on a variable, some of which may be \code{\link{NA}}. No method should ever change this slot at all. Instead, methods should change the \bold{data} slot.} \item{\code{data}:}{Object of class \code{"ANY"}, which is initially a copy of the \bold{raw_data} slot --- transformed by the function in the \bold{transformation} slot for continuous variables only --- and whose \code{\link{NA}} values are replaced during the multiple imputation process. See \code{\link{mi}}} \item{\code{n_total}:}{Object of class \code{"integer"} which is the \code{\link{length}} of the \bold{data} slot} \item{\code{all_obs}:}{Object of class \code{"logical"} of length one indicating whether all values of the \bold{data} slot are observed and thus not \code{\link{NA}} } \item{\code{n_obs}:}{Object of class \code{"integer"} of length one indicating the number of values of the \bold{data} slot that are observed and thus not \code{\link{NA}} } \item{\code{which_obs}:}{Object of class \code{"integer"}, which is a vector indicating the positions of the observed values in the \bold{data} slot} \item{\code{all_miss}:}{Object of class \code{"logical"} of length one indicating whether all values of the \bold{data} slot are \code{\link{NA}} } \item{\code{n_miss}:}{Object of class \code{"integer"} of length one indicating the number of values of the \bold{data} slot that are \code{\link{NA}} } \item{\code{which_miss}:}{Object of class \code{"integer"}, which is a vector indicating the positions of the missing values in the \bold{data} slot } \item{\code{n_extra}:}{Object of class \code{"integer"} of length one indicating how many (missing) observations have been added to the end of the \bold{data} slot that are not included in the \bold{raw_data} slot. Although the extra values will be imputed, they are not considered to be \dQuote{missing} for the purposes of defining the previous three slots} \item{\code{which_extra}:}{Object of class \code{"integer"}, which is a vector indicating the positions of the extra values at the end of the \bold{data} slot } \item{\code{n_unpossible}:}{Object of class \code{"integer"} of length one indicating the number of values that are logically or structurally unobservable} \item{\code{which_unpossible}:}{Object of class \code{"integer"} indicating the positions of the unpossible values in the \bold{data} slot } \item{\code{n_drawn}:}{Object of class \code{"integer"} of length one which is the sum of the \bold{n_miss} and \bold{n_extra} slots} \item{\code{which_drawn}:}{Object of class \code{"integer"} which is a vector concatinating the \bold{which_miss} and \bold{which_extra} slots } \item{\code{imputation_method}:}{Object of class \code{"character"} of length one indicating how the \code{\link{NA}} values are to be imputed. Possibilities include \dQuote{ppd} for imputation from the posterior predictive distribution, \dQuote{pmm} for imputation via predictive mean matching, \dQuote{mean} for mean-imputation, \dQuote{median} for median-imputation, \dQuote{expectation} for conditional mean-imputation. With enough programming effort, other kinds of imputation can be defined and specified here.} \item{\code{family}:}{Object of class \code{"WeAreFamily"} that will typically be passed to \code{\link{glm}} and similar functions during the multiple imputation process} \item{\code{known_families}:}{Object of class \code{\link{character}} indicating the families that are known to be supported for a class; see \code{\link{family}}} \item{\code{known_links}:}{Object of class \code{\link{character}} indicating what link functions are known to be supported by the elements of the \bold{known_families} slot; see \code{\link{family}}} \item{\code{imputations}:}{Object of class \code{"MatrixTypeThing"} with rows equal to the number of iterations (initially zero) of the multiple imputation algorithm and columns equal to the \bold{n_drawn} slot. The rows are appropriately extended and then filled by the \code{\link{mi}} function} \item{\code{done}:}{Object of class \code{"logical"} of length one indicating whether the \code{\link{NA}} values in the \bold{data} slot have been replaced by imputed values} \item{\code{parameters}:}{Object of class \code{"MatrixTypeThing"} with rows equal to the number of iterations (initially zero) of the multiple imputation algorithm and columns equal to the number of estimated parameters when modeling the \bold{data} slot. The rows are appropriately extended and then filled by the \code{\link{mi}} function} \item{\code{model}:}{Object of class \code{"ANY"} which can be filled by an object that is output by one of the \code{\link{fit_model-methods}}, which is done by default by \code{\link{mi}} when all the iterations have completed} \item{\code{fitted}:}{Object of class \code{"ANY"} although typically a vector or matrix that contains the fitted values of the model in the slot immediately above. Note that the \bold{fitted} slot is filled by default by \code{\link{mi}}, although the \bold{model} slot is left empty by default to save RAM.} \item{\code{estimator}:}{Object of class \code{"character"} of length one indicating which pre-existing \code{\link{fit_model}} to use for an unordered-categorical variable. Options are \code{"mnl"}, in which \code{\link[nnet]{multinom}} from the \pkg{nnet} package is used to fit the values of the unordered categorical variable; and \code{"rnl"}, in which each category is separately modeled as the positive binary outcome against all other categories using a \code{\link[arm]{bayesglm}} \code{fit_model} and the probabilities of each category are normalized to sum to 1 after each model is run. In general, \code{"rnl"} is slightly less accurate than \code{"mnl"}, but runs much more quickly especially when the unordered categorical variable has many unique categories.} } The WeAreFamily class is a class union of \code{\link{character}} and \code{\link{family}}, while the MatrixTypeThing class is a class union of \code{\link{matrix}} only at the moment. } \value{ The missing_variable function returns an object that inherits from the missing_variable class. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{missing_data.frame}}, \code{\link{categorical-class}}, \code{\link{unordered-categorical-class}}, \code{\link{ordered-categorical-class}}, \code{\link{binary-class}}, \code{\link{interval-class}}, \code{\link{continuous-class}}, \code{\link{semi-continuous-class}}, \code{\link{nonnegative-continuous-class}}, \code{\link{SC_proportion-class}}, \code{\link{censored-continuous-class}}, \code{\link{truncated-continuous-class}}, \code{\link{bounded-continuous-class}}, \code{\link{positive-continuous-class}}, \code{\link{proportion-class}}, \code{\link{count-class}} } \examples{ # STEP 0: GET DATA data(nlsyV, package = "mi") # STEP 0.5 CREATE A missing_variable (you never need to actually do this) income <- missing_variable(nlsyV$income, type = "continuous") show(income) # STEP 1: CONVERT IT TO A missing_data.frame mdf <- missing_data.frame(nlsyV) # this calls missing_variable() internally show(mdf) } \keyword{classes} \keyword{AimedAtUseRs} \keyword{DirectedTowardDevelopeRs} mi/man/continuous.Rd0000644000175000017500000000501312513727071014265 0ustar nileshnilesh\name{continuous} \Rdversion{1.1} \docType{class} \alias{continuous} \alias{continuous-class} \title{Class "continuous"} \description{ The continuous class inherits from the \code{\link{missing_variable-class}} and is the parent of the following classes: \code{\link{semi-continuous}}, \code{\link{censored-continuous}}, \code{\link{truncated-continuous}}, and \code{\link{bounded-continuous}}. The distinctions among these subclasses are given on their respective help pages. Aside from these facts, the rest of the documentation here is primarily directed toward developers. } \section{Objects from the Classes}{Objects can be created that are of class continuous via the \code{\link{missing_variable}} generic function by specifying \code{type = "continuous"} } \section{Slots}{ The continuous class inherits from the \code{\link{missing_variable}} class and has the following additional slots: \describe{ \item{transformation}{Object of class \code{"function"} which is passed the \code{raw_data} slot and whose returned value is assigned to the \code{data} slot. By default, this function is the \dQuote{standardize} transformation, using the mean and \emph{twice} the standard deviation of the observed values} \item{inverse_transformation}{Object of class \code{"function"} which is the inverse of the function in the \code{transformation} slot.} \item{transformed}{Object of class \code{"logical"} of length one indicating whether the \code{data} slot is in the \dQuote{transformed} state or the \dQuote{untransformed} state} \item{known_transformations}{Object of class \code{"character"} indicating which transformations are possible for this variable} } The \code{\link{fit_model}} method for a continuous variable is, by default, a wrapper for \code{\link[arm]{bayesglm}} and its \code{family} slot is, by default, \code{\link{gaussian}} } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{missing_variable}}, \code{\link{semi-continuous-class}}, \code{\link{censored-continuous-class}}, \code{\link{truncated-continuous-class}}, \code{\link{bounded-continuous-class}} } \examples{ # STEP 0: GET DATA data(nlsyV, package = "mi") # STEP 0.5 CREATE A missing_variable (you never need to actually do this) income <- missing_variable(nlsyV$income, type = "continuous") show(income) } \keyword{classes} \keyword{DirectedTowardDevelopeRs} mi/man/04mi.Rd0000644000175000017500000001634612506165513012642 0ustar nileshnilesh\name{04mi} \Rdversion{1.1} \docType{class} \alias{04mi} \alias{mi} \alias{mi-class} \alias{mi-methods} \title{Multiple Imputation } \description{ The \code{mi} function cannot be run in isolation. It is the most important step of a multi-step process to perform multiple imputation. The data must be specified as a \code{\link{missing_data.frame}} before \code{mi} is used to impute missing values for one or more \code{\link{missing_variable}}s. An iterative algorithm is used where each \code{\link{missing_variable}} is modeled (using \code{\link{fit_model}}) as a function of all the other \code{\link{missing_variable}}s and their missingness patterns. This documentation outlines the technical uses of the \code{mi} function. For a more general discussion of how to use \code{mi} for multiple imputation, see \code{\link{mi-package}}. } \usage{ mi(y, model, ...) ## Hidden arguments: ## n.iter = 30, n.chains = 4, max.minutes = Inf, seed = NA, verbose = TRUE, ## save_models = FALSE, parallel = .Platform$OS.type != "windows" } \arguments{ \item{y}{Typically an object that inherits from the \code{\link{missing_data.frame-class}}, although many methods are defined for subclasses of the \code{\link{missing_variable-class}}. Alternatively, \code{y = "parallel"} the appropriate parallel backend will be registered but no imputation performed. See the Details section. } \item{model}{Missing when \code{y = "parallel"} or when \code{y} inherits from the \code{\link{missing_data.frame-class}} but otherwise should be the result of a call to \code{\link{fit_model}}. } \item{\dots}{Further arguments, the most important of which are \describe{ \item{\code{n.iter}}{number of iterations to perform, defaulting to 30} \item{\code{n.chains}}{number of chains to use, ideally equal to the number of virtual cores available for use, and defaulting to 4} \item{\code{max.minutes}}{hard time limit that defaults to 20} \item{\code{seed}}{either \code{NA}, which is the default, or a psuedo-random number seed} \item{\code{verbose}}{logical scalar that is \code{TRUE} by default, indicating that progress of the iterative algorithm should be printed to the screen, which does not work under Windows when the chains are executed in parallel} \item{\code{save_models}}{logical scalar that defaults to \code{FALSE} but if \code{TRUE} indicates that the models estimated on a frozen completed dataset should be saved. This option should be used if the user is interested in evaluating the quality of the models run after the last iteration of the \code{mi} algorithm, but saving these models consumes much more RAM} \item{\code{debug}}{logical scalar indicating whether to run in debug mode, which forces the processing to be sequential, and allows developers to capture errors within chains} \item{\code{parallel}}{if TRUE, then parallel processing is used, if available. If FALSE, sequential processing is used. In addition, ths argument may be an object produced by \code{\link[parallel]{makeCluster}}} } } } \details{ It is important to distinguish the two \code{mi} methods that are most relevant to users from the many \code{mi} methods that are less relevant. The primary \code{mi} method is that where \code{y} inherits from the \code{\link{missing_data.frame-class}} and \code{model} is omitted. This method \dQuote{does} the imputation according to the additional arguments described under \dots above and returns an object of class \code{"mi"}. Executing two or more independent chains is important for monitoring the convergence of each chain, see \code{\link{Rhats}}. If the chains have not converged in the amount of iterations or time specified, the second important \code{mi} method is that where \code{y} is an object of class \code{"mi"} and \code{model} is omitted, which continues a previous run of the iterative imputation algorithm. All the arguments described under \dots above remain applicable, except for \code{n.chains} and \code{save_RAM} because these are established by the previous run that is being continued. The numerous remaining methods are of less importance to users. One \code{mi} method is called when \code{y = "parallel"} and \code{model} is omitted. This method merely sets up the parallel backend so that the chains can be executed in parallel on the local machine. We use the \code{\link{mclapply}} function in the \pkg{parallel} package to implement parallel processing on non-Windows machines, and we use the \pkg{snow} package to implement parallel processing on Windows machines; we refer users to the documentation for these packages for more detail about parallel processing. Parallel processing is used by default on machines with multiple processors, but sequential processing can be used instead by using the \code{parallel=FALSE} option. If the user is not using a mulitcore computer, sequential processing is used instead of parallel processing. The first two \code{mi} methods described above in turn call a \code{mi} method where \code{y} inherits from the \code{\link{missing_data.frame-class}} and \code{model} is that which is returned by one of the \code{\link{fit_model-methods}}. The methods impute values for the originally missing values of a \code{\link{missing_variable}} given a fitted model, according to the \bold{imputation_method} slot of the \code{\link{missing_variable}} in question. Advanced users could define new subclasses of the \code{\link{missing_variable-class}} in which case it may be necessary to write such a \code{mi} method for the new class. It will almost certainly be necessary to add to the \code{\link{fit_model-methods}}. The existing \code{mi} and \code{fit-model-methods} should provide a template for doing so. } \value{ If \code{model} is missing and \code{n.chains} is positive, then the \code{mi} method will return an object of class \code{"mi"}, which has the following slots: \describe{ \item{call}{the call to \code{mi}} \item{data}{a list of \code{\link{missing_data.frame}}s, one for each chain} \item{total_iters}{an integer vector that records how many iterations have been performed} } There are a few methods for such an object, such as \code{\link{show}}, \code{\link{summary}}, \code{\link{dimnames}}, \code{\link{nrow}}, \code{\link{ncol}}, etc. If \code{mi} is called on a \code{\link{missing_data.frame}} with \code{model} missing and a nonpositive \code{n.chains}, then the \code{\link{missing_data.frame}} will be returned after allocating storeage. If \code{model} is not missing, then the \code{mi} method will impute missing values for the \code{y} argument and return it. } \author{ Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman. } \seealso{ \code{\link{missing_data.frame}}, \code{\link{fit_model}} } \examples{ # STEP 0: Get data data(CHAIN, package = "mi") # STEP 1: Convert to a missing_data.frame mdf <- missing_data.frame(CHAIN) # warnings about missingness patterns show(mdf) # STEP 2: change things mdf <- change(mdf, y = "log_virus", what = "transformation", to = "identity") # STEP 3: look deeper summary(mdf) # STEP 4: impute \dontrun{ imputations <- mi(mdf) } } \keyword{classes} \keyword{regression} \keyword{AimedAtusers} mi/vignettes/0000755000175000017500000000000014247037643013033 5ustar nileshnileshmi/vignettes/mi_vignette.Rmd0000644000175000017500000001372612513737154016020 0ustar nileshnilesh--- title: "An Example of mi Usage" author: "Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman" date: "06/16/2014" output: pdf_document --- There are several steps in an analysis of missing data. Initially, users must get their data into R. There are several ways to do so, including the `read.table`, `read.csv`, `read.fwf` functions plus several functions in the __foreign__ package. All of these functions will generate a `data.frame`, which is a bit like a spreadsheet of data. http://cran.r-project.org/doc/manuals/R-data.html for more information. ```{r step0} options(width = 65) suppressMessages(library(mi)) data(nlsyV, package = "mi") ``` From there, the first step is to convert the `data.frame` to a `missing_data.frame`, which is an enhanced version of a `data.frame` that includes metadata about the variables that is essential in a missing data context. ```{r step1} mdf <- missing_data.frame(nlsyV) ``` The `missing_data.frame` constructor function creates a `missing_data.frame` called `mdf`, which in turn contains seven `missing_variable`s, one for each column of the `nlsyV` dataset. The most important aspect of a `missing_variable` is its class, such as `continuous`, `binary`, and `count` among many others (see the table in the Slots section of the help page for `missing_variable-class`. The `missing_data.frame` constructor function will try to guess the appropriate class for each `missing_variable`, but rarely will it correspond perfectly to the user's intent. Thus, it is very important to call the `show` method on a `missing_data.frame` to see the initial guesses ```{r step1.5} show(mdf) # momrace is guessed to be ordered ``` and to modify them, if necessary, using the `change` function, which can be used to change many things about a`missing_variable`, so see its help page for more details. In the example below, we change the class of the _momrace_ (race of the mother) variable from the initial guess of `ordered-categorical` to a more appropriate `unordered-categorical` and change the income `nonnegative-continuous`. ```{r, step2} mdf <- change(mdf, y = c("income", "momrace"), what = "type", to = c("non", "un")) show(mdf) ``` Once all of the `missing_variable`s are set appropriately, it is useful to get a sense of the raw data, which can be accomplished by looking at the `summary`, `image`, and / or `hist` of a `missing_data.frame` ```{r, step3} summary(mdf) image(mdf) hist(mdf) ``` Next we use the `mi` function to do the actual imputation, which has several extra arguments that, for example, govern how many independent chains to utilize, how many iterations to conduct, and the maximum amount of time the user is willing to wait for all the iterations of all the chains to finish. The imputation step can be quite time consuming, particularly if there are many `missing_variable`s and if many of them are categorical. One important way in which the computation time can be reduced is by imputing in parallel, which is highly recommended and is implemented in the mi function by default on non-Windows machines. If users encounter problems running `mi` with parallel processing, the problems are likely due to the machine exceeding available RAM. Sequential processing can be used instead for `mi` by using the `parallel=FALSE` option. ```{r, step4} rm(nlsyV) # good to remove large unnecessary objects to save RAM options(mc.cores = 2) imputations <- mi(mdf, n.iter = 30, n.chains = 4, max.minutes = 20) show(imputations) ``` The next step is very important and essentially verifies whether enough iterations were conducted. We want the mean of each completed variable to be roughly the same for each of the 4 chains. ```{r, step5A} round(mipply(imputations, mean, to.matrix = TRUE), 3) Rhats(imputations) ``` If so --- and when it does in the example depends on the pseudo-random number seed --- we can procede to diagnosing other problems. For the sake of example, we continue our 4 chains for another 5 iterations by calling ```{r, step5B} imputations <- mi(imputations, n.iter = 5) ``` to illustrate that this process can be continued until convergence is reached. Next, the `plot` of an object produced by `mi` displays, for all `missing_variable`s (or some subset thereof), a histogram of the observed, imputed, and completed data, a comparison of the completed data to the fitted values implied by the model for the completed data, and a plot of the associated binned residuals. There will be one set of plots on a page for the first three chains, so that the user can get some sense of the sampling variability of the imputations. The `hist` function yields the same histograms as `plot`, but groups the histograms for all variables (within a chain) on the same plot. The `image`function gives a sense of the missingness patterns in the data. ```{r, step6} plot(imputations) plot(imputations, y = c("ppvtr.36", "momrace")) hist(imputations) image(imputations) summary(imputations) ``` Finally, we pool over `m = 5` imputed datasets -- pulled from across the 4 chains -- in order to estimate a descriptive linear regression of test scores (_ppvtr.36_) at 36 months on a variety of demographic variables pertaining to the mother of the child. ```{r, step7} analysis <- pool(ppvtr.36 ~ first + b.marr + income + momage + momed + momrace, data = imputations, m = 5) display(analysis) ``` The rest is optional and only necessary if you want to perform some operation that is not supported by the __mi__ package, perhaps outside of R. Here we create a list of `data.frame`s, which can be saved to the hard disk and / or exported in a variety of formats with the __foreign__ package. Imputed data can be exported to Stata by using the `mi2stata` function instead of `complete`. ```{r, step8} dfs <- complete(imputations, m = 2) ``` mi/build/0000755000175000017500000000000014247037643012122 5ustar nileshnileshmi/build/vignette.rds0000644000175000017500000000033014247037643014455 0ustar nileshnileshb```b`feb`b2 1# '͌/LK-)I MAsSpH-IUOST-NLOgHAJ4/@7 %! I1k^bnj1 .y) 3GZY_Ӄ -3'foHf e2|s  =XQĒD"~xܬmi/build/partial.rdb0000644000175000017500000000661514247037620014252 0ustar nileshnilesh\rF(RmY$N%geQH("GJu8Z (Vydeb+? qCVUP7tO=>$$ VJRi3߀$ r:\hYat|y Wm],Ipnp.+?<&5?z*iCWUUMcި|`!!eEVbgL-ܲE?Z߿`3v,S*#q\&QSx:qr>Cm!b2)N3fU[QnYg;*J}kb9u ‚tbTԵ tStaiXg\#E{-Ӹm-z ±Ʈu"*]K'͆i6rYLe4vMb58*o90\eB~ )wI~6Ue<T7ǣAy%j *u 5zAYߙu0^l0=qY$RT U`>iAs\aPb$(קX>Y@r^s@^ͥ)lƺ4]u(,-dFB&4g ;iFHI5q~"3eLISOAEu:)BYf_嫉԰(Kr;7XrUg+eay+ӊob4<)9tc?'P8VCIN_5JY`,ז3aYm dW9йB2d>6$`1XlrU;)ldq8Ñӌ lMy嵛啕 ֍OI_d.Wz]?s GAeؤ',TQ *My;ʕ,z(W/ fnםM i1: Hyi1eTp4}s8'2yNΥΎiD}{PW4K[Gq @ܰʴW%F?nRIp 67|ɮ]{Ȕ+mS~;?NW_;ED/`{[k,x+pӯ)?,!j˻2bֱ=k"T֋r/P9m `>iN=?pKSntW4Wn/OE&ѯ@O]^3Ů@L16Md}[e| ?ºԹus[UݖW'OIitR'h"9$ h{R3p{wԻ'΋~g=!s/AmGTZ_T^΍Ң 1zӘTzA7DSBmY(y!@?hX ߜ6>qh[M~&@|T^ L̋g܀_e(ۖ) 5t = *гq" Qa9 >߃qxV-w!U]~?xs@?ܘH,P8 B1F:b4_Dx_:% W_h%`AO[@⟺Ý4=ŧiQPT׉uMv*s vSSaߡ lHq]>nKRZ%;To`=zov;nMƈ̄Ώ(NJHho/rc ZVۍG4nl;"GH`8"`Zq- Ql7+ 6VAqGυJ]e0nPbᐖiFS;6ЎiٔD)&>`;"NGop'%͂PWU ,Qd&ƶ!{B:'5M4ۏO71aOaL fcs5e,`'>3HxEX(Z'Tm‰Xxo"uAc޳MiHƯlXo׵vOz*x`@CG6]?am"MS1:";$*qJeP;YSV PoRBgI/ J i[oMf%&|/cgӶ;H]]Z]{F5 ]&foG78qſD҄? \!<? ?ZLF TkSF[z@fe5JFW/,?Ꙑ2,i'=^lŢA| GщFM @9՛C><5ygbt <})yuM-׵Z^_W6=^dkL!c.'Y)bwT9W'.\h@'B/to&?S^?hs&[{" 1) stop("'what' must have length one") # what <- match.arg(what, c("family", "imputation_method", "model", "size", "transformation", # "type", "class", "link", "method")) if(what == "class") what <- "type" if(what == "method") what <- "imputation_method" if(is.character(y) && !(what %in% c("family", "imputation_method", "link", "model", "size", "transformation", "type"))) { if(length(y) > 1) stop("'y' must have length one") if(length(to) > 1) stop("'to' must have length one") if(is.logical(y) | is.numeric(y)) y <- colnames(data)[y] if(to == "unpossible") { mv <- data@variables[[y]] unpossible <- which(mv@raw_data == what) mv@n_unpossible <- length(unpossible) mv@which_unpossible <- unpossible mv@which_obs <- mv@which_obs[!(mv@which_obs %in% mv@which_unpossible)] mv@n_obs <- length(mv@which_obs) mv@which_miss <- mv@which_miss[!(mv@which_miss %in% mv@which_unpossible)] mv@n_miss <- length(mv@which_miss) data@variables[[y]] <- mv if(!length(data@weights)) { data@weights <- lapply(data@variables, FUN = function(y) { if(y@n_unpossible) { w <- rep(1, y@n_total) w[y@which_unpossible] <- 0 return(w) } else return(NULL) }) } else data@weights[[y]][mv@which_unpossible] <- 0 return(data) } mv <- data@variables[[y]] mv@raw_data[mv@raw_data == what] <- to if(is.na(what) | is.na(to)) mv <- new(class(mv), raw_data = mv@raw_data, variable_name = mv@variable_name) data@variables[[y]] <- mv return(data) } if(what == "family") return(change_family(data = data, y = y, to = to)) else if(what == "link") return(change_link(data = data, y = y, to = to)) else if(what == "imputation_method") return(change_imputation_method(data = data, y = y, to = to)) else if(what == "model") return(change_model(data = data, y = y, to = to)) else if(what == "size") return(change_size(data = data, n = y)) else if(what == "transformation") { if(missing(to)) return(change_transformation(data = data, y = y)) else return(change_transformation(data = data, y = y, to = to, ...)) } else if(what == "type") { if(missing(to)) return(change_type(data = data, y = y)) else return(change_type(data = data, y = y, to = to, ...)) } else stop("this should never happen") }) setMethod("change", signature(data = "missing_data.frame", y = "ANY", to = "numeric", what = "numeric"), def = function(data, y, to, what) { if(length(to) > 1) stop("'to' must be a scalar") if(length(what) > 1) stop("'what' must be a scalar") if(is.logical(y) | is.numeric(y)) y <- colnames(data)[y] mv <- data@variables[[y]] mv@raw_data[mv@raw_data == what] <- to # NOTE: exception to "never change the raw_data slot rule" if(is(mv, "categorical")) { values <- unique(mv@raw_data) values <- values[!is.na(values)] if(length(values) == 2) mv <- new("binary", raw_data = mv@raw_data, variable_name = mv@variable_name) } else if(is.na(what) | is.na(to)) mv <- new(class(mv), raw_data = mv@raw_data, variable_name = mv@variable_name) else if(is(mv, "continuous")) mv@data <- mv@transformation(mv@raw_data) data@variables[[y]] <- mv return(data) ## FIXME: maybe reinitialize data? }) setMethod("change", signature(data = "missing_data.frame", y = "ANY", to = "logical", what = "numeric"), def = function(data, y, to, what) { change(data = data, y = y, what = what, to = as.numeric(to)) }) setMethod("change", signature(data = "missing_data.frame", y = "ANY", to = "character", what = "numeric"), def = function(data, y, to, what) { if(length(to) > 1) stop("'to' must be a scalar") if(to != "unpossible") stop("'to' must be 'unpossible'") if(length(what) > 1) stop("'what' must be have length one") if(is.logical(y) | is.numeric(y)) y <- colnames(data)[y] mv <- data@variables[[y]] unpossible <- which(mv@raw_data == what) mv@n_unpossible <- length(unpossible) mv@which_unpossible <- unpossible mv@which_obs <- mv@which_obs[!(mv@which_obs %in% mv@which_unpossible)] mv@n_obs <- length(mv@which_obs) mv@which_miss <- mv@which_miss[!(mv@which_miss %in% mv@which_unpossible)] mv@n_miss <- length(mv@which_miss) data@variables[[y]] <- mv if(!length(data@weights)) { data@weights <- lapply(data@variables, FUN = function(y) { if(y@n_unpossible) { w <- rep(1, y@n_total) w[y@which_unpossible] <- 0 return(w) } else return(NULL) }) } else data@weights[[y]][mv@which_unpossible] <- 0 return(data) }) setMethod("change", signature(data = "missing_data.frame", y = "ANY", to = "logical", what = "character"), def = function(data, y, to, what) { change(data = data, y = y, what = what, to = as.numeric(to)) }) setMethod("change", signature(data = "mdf_list", y = "ANY", to = "ANY", what = "ANY"), def = function(data, y, to, what, ...) { out <- lapply(data, FUN = change, y = y, to = to, what = what, ...) class(out) <- "mdf_list" return(out) }) mi/R/convenience.R0000644000175000017500000001045012513634171013634 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## Some S3 methods for convenience as.double.missing_variable <- function(x, ...) { stop("you must write an 'as.double' method for the", class(x), "class") } as.double.categorical <- function(x, ...) { x@data } as.double.continuous <- function(x, transformed = TRUE, ...) { if(transformed) x@data else x@inverse_transformation(x@data) } as.double.count <- function(x, ...) { x@data } as.double.irrelevant <- function(x, ...) { as.double(x@raw_data) } as.double.missing_data.frame <- function(x, transformed = TRUE, ...) { sapply(x@variables, as.double, transformed = transformed) } as.data.frame.missing_data.frame <- function(x, row.names = NULL, optional = FALSE, ...) { as.data.frame(lapply(x@variables, FUN = function(y) y@raw_data), row.names = if(is.null(row.names)) rownames(x) else row.names) } dim.missing_data.frame <- function(x) { x@DIM } dimnames.missing_data.frame <- function(x) { x@DIMNAMES } names.missing_data.frame <- function(x) { x@DIMNAMES[[2]] } dim.mi <- function(x) { if(isS4(x)) x@data[[1]]@DIM else { class(x) <- "list" return(dim(x)) } } dimnames.mi <- function(x) { if(isS4(x)) x@data[[1]]@DIMNAMES else { class(x) <- "list" return(dimnames(x)) } } names.mi <- function(x) { if(isS4(x)) x@data[[1]]@DIMNAMES[[2]] else { class(x) <- "list" return(names(x)) } } is.na.missing_variable <- function(x) { out <- rep(FALSE, x@n_total) out[x@which_miss] <- TRUE return(out) } is.na.missing_data.frame <- function(x) { sapply(x@variables, is.na) } is.na.mi <- function(x) { if(isS4(x)) is.na(x@data[[1]]) else { class(x) <- "list" return(is.na(x)) } } length.missing_variable <- function(x) { x@n_total } length.missing_data.frame <- function(x) { ncol(x) } length.mi <- function(x) { if(isS4(x)) length(x@data) else { class(x) <- "list" return(length(x)) } } print.mdf_list <- function(x ,...) { show(x) } print.mi_list <- function(x, ...) { show(x) } "[.missing_data.frame" <- function(x, i, j, drop = if (missing(i)) TRUE else length(j) == 1) { if(!missing(i)) { cdf <- complete(x, m = 0L) if(!missing(j)) return(cdf[i,j,drop = drop]) else return(cdf[i,,drop = drop]) } else if(length(j) > 1) return(new(class(x), variables = x@variables[j])) else if(is.numeric(j) && j < 0) return(new(class(x), variables = x@variables[j])) else return(x@variables[[j]]) } "[<-.missing_data.frame" <- function (x, i, j, value) { if(!missing(i)) { if(!missing(j)) x@variables[[j]]@raw_data[i,] <- value else stop("a variable (column) must be specified when replacing") } else if(is.null(value)) x@variables[j] <- value else if(is(value, "missing_variable")) x@variables[[j]] <- value else stop("replacement must be 'NULL' or a 'missing_variable'") return(new(class(x), variables = x@variables)) } "[[.missing_data.frame" <- function(x, ..., exact = TRUE) { return(x[,...]) } "[[<-.missing_data.frame" <- function (x, i, j, value) { if(missing(j)) x[,i] <- value else x[i,j] <- value return(x) } "$.missing_data.frame" <- function(x, name) { return(x[,name]) } "$<-.missing_data.frame" <- function(x, name, value) { # this never gets dispatched for some reason x[,name] <- value return(x) } mi/R/change_transformation.R0000644000175000017500000001630112513634171015714 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## these change the transformation and inverse_transformation slots of a continuous variable setMethod("change_transformation", signature(data = "missing", y = "missing_variable", to = "function"), def = function(y, to, inverse = FALSE) { if(!is(y, "continuous")) stop(paste(y@variable_name, "is not a continuous variable and hence has no transformation")) else if(is(y, "SC_proportion")) stop(paste(y@variable_name, "is a SC_proportion and cannot change its transformation (yet)")) if(inverse) { if(identical(to, .standardize_transform)) { formals(to)$mean <- mean(y@raw_data, na.rm = TRUE) formals(to)$sd <- sd(y@raw_data, na.rm = TRUE) } else if(identical(to, .logshift)) { yy <- y@raw_data if(any(yy < 0, na.rm = TRUE)) a <- - min(yy, na.rm = TRUE) else a <- 0 a <- (a + min(yy[yy > 0], na.rm = TRUE)) / 2 formals(to)$a <- a } if("inverse" %in% names(formals(to))) formals(to)$inverse <- TRUE y@inverse_transformation <- to } else { if(identical(to, .standardize_transform)) { formals(to)$mean <- mean(y@raw_data, na.rm = TRUE) formals(to)$sd <- sd(y@raw_data, na.rm = TRUE) } else if(identical(to, .logshift)) { yy <- y@raw_data if(any(yy < 0, na.rm = TRUE)) a <- - min(yy, na.rm = TRUE) else a <- 0 a <- (a + min(yy[yy > 0], na.rm = TRUE)) / 2 formals(to)$a <- a } y@transformation <- to y@data <- y@transformation(y@raw_data) } return(y) }) setMethod("change_transformation", signature(data = "missing", y = "missing_variable", to = "missing"), def = function(y) { if(is(y, "continuous")) cat("Likely choices include:", y@known_transformations, sep = "\n") else cat("No transformation possible for non-continuous variables\n") return(invisible(NULL)) }) setMethod("change_transformation", signature(data = "missing_data.frame", y = "character", to = "missing"), def = function(data, y) { if(all(y %in% c("continuous", names(getClass("continuous")@subclasses)))) { classes <- sapply(data@variables, class) y <- c(sapply(y, FUN = function(x) { names(classes[which(classes == x)]) })) if(is.list(y)) stop(paste("no variables of class", names(y)[1])) else y <- y[1] } y <- match.arg(y, data@DIMNAMES[[2]], several.ok = TRUE) for(i in 1:length(y)) change_transformation(y = data@variables[[y[i]]]) return(data) }) setMethod("change_transformation", signature(data = "missing_data.frame", y = "character", to = "character"), def = function(data, y, to) { if(length(to) == 1) to <- rep(to, length(y)) else if(length(to) != length(y)) stop("'y' and 'to' must have the same length") if(all(y %in% c("continuous", names(getClass("continuous")@subclasses)))) { classes <- sapply(data@variables, class) y <- c(sapply(y, FUN = function(x) { names(classes[which(classes == x)]) })) to <- rep(to[1], length(y)) } y <- match.arg(y, data@DIMNAMES[[2]], several.ok = TRUE) trans <- lapply(to, FUN = function(x) { switch(x, "identity" = .identity_transform, "standardize" = .standardize_transform, "squeeze" = .squeeze_transform, "logshift" = .logshift, "log" = log, "sqrt" = sqrt, "cuberoot" = .cuberoot, function(...) stop(paste("must replace the transformation slot for", x))) }) inverse <- lapply(to, FUN = function(x) { switch(x, "identity" = .identity_transform, "standardize" = .standardize_transform, "squeeze" = .squeeze_transform, "logshift" = .logshift, "log" = exp, "sqrt" = function(y, ...) y^2, "cuberoot" = .cuberoot, function(...) stop(paste("must replace the inverse_transformation slot for", x))) }) for(i in 1:length(y)) { data@variables[[y[i]]] <- change_transformation(y = data@variables[[y[i]]], to = trans[[i]]) data@variables[[y[i]]] <- change_transformation(y = data@variables[[y[i]]], to = inverse[[i]], inverse = TRUE) mark <- data@index[[y[i]]][1] data@X[,mark] <- data@variables[[y[i]]]@data } # initialize(data) return(data) }) setMethod("change_transformation", signature(data = "missing_data.frame", y = "numeric", to = "character"), def = function(data, y, to) { return(change_transformation(data = data, y = colnames(data)[y], to = to)) }) setMethod("change_transformation", signature(data = "missing_data.frame", y = "logical", to = "character"), def = function(data, y, to) { if(length(y) != data@DIM[2]) { stop("the length of 'y' must equal the number of variables in 'data'") } return(change_transformation(data = data, y = names(data@variables)[y], to = to)) }) setMethod("change_transformation", signature(data = "missing_data.frame", y = "character", to = "function"), def = function(data, y, to, inverse = stop("you must specify 'inverse = FALSE' or 'inverse = TRUE'")) { if(all(y %in% c("continuous", names(getClass("continuous")@subclasses)))) { classes <- sapply(data@variables, class) y <- c(sapply(y, FUN = function(x) { names(classes[which(classes == x)]) })) } y <- match.arg(y, data@DIMNAMES[[2]], several.ok = TRUE) for(i in 1:length(y)) { if(inverse) data@variables[[y[i]]] <- change_transformation(y = data@variables[[y[i]]], to = to, inverse = TRUE) else data@variables[[y[i]]] <- change_transformation(y = data@variables[[y[i]]], to = to, inverse = FALSE) mark <- data@index[[y[i]]][1] data@X[,mark] <- data@variables[[y[i]]]@data } return(data) }) setMethod("change_transformation", signature(data = "missing_data.frame", y = "numeric", to = "function"), def = function(data, y, to, inverse) { y <- names(data@variables)[y] return(change_transformation(data = data, y = y, to = to, inverse)) }) setMethod("change_transformation", signature(data = "missing_data.frame", y = "logical", to = "function"), def = function(data, y, to, inverse) { if(length(y) != data@DIM[2]) { stop("the length of 'y' must equal the number of variables in 'data'") } return(change_transformation(data = data, y = names(data@variables)[y], to = to, inverse = inverse)) }) mi/R/AllGeneric.R0000644000175000017500000000437112513634171013352 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. setGeneric("change", def = function(data, y, to, what, ...) standardGeneric("change")) setGeneric("change_family", def = function(data, y, to, ...) standardGeneric("change_family")) setGeneric("change_imputation_method", def = function(data, y, to, ...) standardGeneric("change_imputation_method")) setGeneric("change_link", def = function(data, y, to, ...) standardGeneric("change_link")) setGeneric("change_model", def = function(data, y, to, ...) standardGeneric("change_model")) setGeneric("change_size", def = function(data, y, to, ...) standardGeneric("change_size")) setGeneric("change_transformation", def = function(data, y, to, ...) standardGeneric("change_transformation")) setGeneric("change_type", def = function(data, y, to, ...) standardGeneric("change_type")) setGeneric("complete", def = function(y, m, ...) standardGeneric("complete")) setGeneric("fit_model", def = function(y, data, ...) standardGeneric("fit_model")) setGeneric("get_parameters", def = function(object, ...) standardGeneric("get_parameters")) setGeneric("hist", def = function(x, ...) standardGeneric("hist")) setGeneric("mi", def = function(y, model, ...) standardGeneric("mi")) setGeneric("missing_variable", def = function(y, type, ...) standardGeneric("missing_variable")) setGeneric("missing_data.frame", def = function(y, ...) standardGeneric("missing_data.frame")) ## FIXME: acount for the other stuff in the original AllGeneric.R mi/R/random_df.R0000644000175000017500000005761212513723170013302 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011 Andrew Gelman # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## Function to draw from the relevant symmetric generalized beta distribution .rgbeta <- function(num, shape) { if(shape > 0) -1 + 2 * rbeta(num, shape, shape) else if(shape == 0) -1 + 2 * rbinom(num, 1, 0.5) else stop("shape must be non-negative") } ## Function to draw a Cholesky factor of a random correlation matrix ## as a function of canonical partial correlations (CPCs) .rcorvine <- function(n_full, n_partial, n_cat, eta, restrictions, strong, experiment, treatment_cor, last_CPC) { nom <- !is.null(n_cat) n <- n_full + 2 * n_partial if(nom) { n <- n + sum(n_cat) - length(n_cat) nc <- 2 * n_partial + sum(n_cat) - length(n_cat) holder <- matrix(NA_real_, nrow = nc, ncol = nc) } else holder <- matrix(NA_real_, nrow = 2 * n_partial, ncol = 2 * n_partial) count <- 1 if(eta <= 0) stop("'eta' must be positive") alpha <- eta + (n - 2) / 2 # if eta == 1, then tcrossprod(L) is uniform over correlation matrices L <- matrix(NA_real_, n, n) L[upper.tri(L)] <- 0 L[1,1] <- 1 L <- .rcorvine_helper(L, holder, n_full, n_partial, n_cat, alpha, restrictions, strong, experiment, treatment_cor, nom, last_CPC) if(restrictions == "MARish") L <- .MAR_opt(L, n_full, n_partial) return(L) } .rcorvine_helper <- function(L, holder, n_full, n_partial, n_cat, alpha, restrictions, strong, experiment, treatment_cor, nom, last_CPC) { n <- nrow(L) mark <- is.na(L[,1]) sum_mark <- sum(mark) CPCs <- .rgbeta(sum(mark), alpha) count <- 1 if(experiment) { len <- length(treatment_cor) if(len == 1 && treatment_cor == 0) treatment_cor <- rep(0, sum_mark) else if(len != sum_mark) { stop(paste("length of 'treatment_cor' must be", sum_mark)) } treatment_mark <- is.na(treatment_cor) treatment_cor[treatment_mark] <- CPCs[treatment_mark] CPCs <- treatment_cor # treatment variable is first } if(n_full == 0 && restrictions != "none") { CPCs[sum_mark:(sum_mark - n_partial)] <- 0 holder[1,mark] <- CPCs count <- count + 1 } else if(n_full == 0) { holder[1,mark] <- CPCs count <- count + 1 } L[mark,1] <- CPCs W <- log(1 - CPCs^2) ## NOTE: order of variables is: ## all fully observed (with the treatment first if applicable) ## all partially observed but not nominal variables (if any) ## the components of the nominal variable(s) (if any) ## all missingness indicators # fully observed variables have arbitrary CPCs start <- 2 end <- n_full if(n_full >= 2) for(i in start:end) { L[i,i] <- exp(0.5 * W[i-1]) gap <- which(is.na(L[,i])) gap1 <- gap - 1 alpha <- alpha - 0.5 CPCs <- .rgbeta(length(gap), alpha) if(restrictions == "MCAR") CPCs[length(gap):(length(gap) - n_partial + 1)] <- 0 L[gap,i] <- CPCs * exp(0.5 * W[gap1]) W[gap1] <- W[gap1] + log(1 - CPCs^2) } # partially observed variables have arbitrary CPCs among themselves # but are conditionally uncorrelated with all missingness indicators under MAR # note: we condition on all fully observed variables and all previous partially observed variables # this triangle scheme implies that the errors when predicting the partially observed variables are uncorrelated if(n_full >= 2) start <- end + 1 end <- start + n_partial - 1 if(nom) end <- end - length(n_cat) if(start <= end) for(i in start:end) { L[i,i] <- exp(0.5 * W[i-1]) gap <- which(is.na(L[,i])) gap1 <- gap - 1 alpha <- alpha - 0.5 CPCs <- .rgbeta(length(gap), alpha) if(restrictions %in% c("triangular", "stratified")) { CPCs[length(gap):(length(gap) - n_partial + 1)] <- 0 if(i == end && !is.na(last_CPC)) CPCs[length(CPCs)] <- last_CPC } else if(restrictions == "MCAR") CPCs[] <- 0 L[gap,i] <- CPCs * exp(0.5 * W[gap1]) W[gap1] <- W[gap1] + log(1 - CPCs^2) holder[count,(count+1):ncol(holder)] <- CPCs count <- count + 1 } # if there are nominal partially observed variables, make the category residuals uncorrelated (MNL assumption) if(nom) { #if(n_full >= 2) start <- end + 1 end <- start + sum(n_cat) - 1 for(i in start:end) { L[i,i] <- exp(0.5 * W[i-1]) gap <- which(is.na(L[,i])) gap1 <- gap - 1 alpha <- alpha - 0.5 if(restrictions != "none") CPCs <- rep(0, length(gap)) else { CPCs <- .rgbeta(length(gap), alpha) CPCs[-(length(gap):(length(gap) - n_partial + 1))] <- 0 } L[gap,i] <- CPCs * exp(0.5 * W[gap1]) W[gap1] <- W[gap1] + log(1 - CPCs^2) holder[count,(count+1):ncol(holder)] <- CPCs count <- count + 1 } } # missingness indicators can be constructed to be instruments if MAR holds whose strength can be manipulated if(n_partial > 1) { start <- end + 1 end <- n - 1 count <- if(n_full > 0) 1 else 2 if(start <= end) for(i in start:end) { L[i,i] <- exp(0.5 * W[i-1]) gap <- which(is.na(L[,i])) gap1 <- gap - 1 alpha <- alpha - 0.5 if(restrictions %in% c("none", "MARish")) CPCs <- .rgbeta(length(gap), alpha) else if(restrictions %in% c("stratified", "MCAR")) CPCs <- rep(0, length(gap)) else if(strong == 2) CPCs <- holder[count,(count+1):(count + length(gap))] else if(strong == 1) CPCs <- .rgbeta(length(gap), alpha) else if(strong == 0) CPCs <- rep(0, length(gap)) L[gap,i] <- CPCs * exp(0.5 * W[gap1]) W[gap1] <- W[gap1] + log(1 - CPCs^2) } } L[n,n] <- exp(0.5 * W[n-1]) return(L) } ## Function to draw a Cholesky factor of a random correlation matrix ## as a function of canonical partial correlations (CPCs) .rcorvine_partial <- function(Sigma, n_partial, n_cat, eta, restrictions, strong, experiment, treatment_cor) { n <- nrow(Sigma) n_full <- n - n_partial ldlt <- LDLt(Sigma) U <- t(ldlt$L) holder <- matrix(NA_real_, n, n) holder[1,-1] <- U[1,-1] W <- c(NA_real_, 1 - holder[1,-1]^2) for(i in 2:(n-1)) { denominator <- W[i] gap <- (i+1):n temp <- U[i,gap] / sqrt(W[gap] / denominator) invalid <- is.na(temp) temp[invalid] <- sign(U[i,gap][invalid]) invalid <- abs(temp) > 1 temp[invalid] <- sign(temp[invalid]) holder[i,gap] <- temp W[gap] <- W[gap] * (1 - holder[i,gap]^2) } nom <- !is.null(n_cat) n <- n + n_partial if(nom) { n <- n + sum(n_cat) - length(n_cat) } L <- t(U) * sqrt(diag(ldlt$D)) if(eta <= 0) stop("'eta' must be positive") diff <- n - nrow(L) alpha <- eta + diff / 2 L <- cbind(L, matrix(0, nrow(L), diff)) L <- rbind(L, matrix(NA_real_, diff, n)) L[upper.tri(L)] <- 0 holder <- matrix(NA_real_, nrow = diff, ncol = ncol(L)) L <- .rcorvine_helper(L, holder, n_full, n_partial, n_cat, alpha, restrictions, strong, experiment, treatment_cor, nom) if(restrictions == "MARish") L <- .MAR_opt(L, n_full, n_partial) return(L) } .MAR_opt <- function(L, n_full, n_partial) { n_p2 <- n_partial^2 lowers <- lower.tri(L) cell_mark <- tail(which(lowers), n_p2) lowers[] <- FALSE lowers[cell_mark] <- TRUE row_mark <- which(apply(lowers, 1, any)) diag(L)[row_mark] <- NA_real_ partials <- (n_full + 1):(n_full + n_partial) missingness <- nrow(L):(nrow(L) - n_partial + 1) block_mark <- which( row(L) %in% partials & col(L) %in% missingness ) foo <- function(theta) { L[cell_mark] <- theta diags <- 1 - rowSums(L[row_mark,,drop=FALSE]^2, na.rm = TRUE) if(any(diags < 0)) return(NA_real_) diag(L)[row_mark] <- sqrt(diags) Sigma_inv <- chol2inv(t(L)) return(c(crossprod(Sigma_inv[block_mark]))) } opt <- optim(L[cell_mark], foo, method = "BFGS") L[cell_mark] <- opt$par diag(L)[row_mark] <- sqrt(1 - rowSums(L[row_mark,,drop=FALSE]^2, na.rm = TRUE)) return(L) } .NMARness <- function(L) { xs <- grep("^x_", rownames(L), value = TRUE) ys <- grep("^y_", rownames(L), value = TRUE) us <- grep("^u_", rownames(L), value = TRUE) sapply(ys, FUN = function(y) { i <- y sapply(us, FUN = function(u) { j <- u cons <- c(xs, setdiff(us, u)) mark <- c(i,j,cons) D_ijcons <- det(tcrossprod(L[mark,,drop = FALSE])) mark <- cons D_cons <- det(tcrossprod(L[mark,,drop = FALSE])) mark <- c(i,cons) D_icons <- det(tcrossprod(L[mark,,drop = FALSE])) mark <- c(j,cons) D_jcons <- det(tcrossprod(L[mark,,drop = FALSE])) return(1 - D_ijcons * D_cons / (D_icons * D_jcons)) }) }) } ## Function to construct a random data.frame with tunable missingness rdata.frame <- function(N = 1000, restrictions = c("none", "MARish", "triangular", "stratified", "MCAR"), last_CPC = NA_real_, strong = FALSE, pr_miss = .25, Sigma = NULL, alpha = NULL, experiment = FALSE, treatment_cor = c(rep(0, n_full - 1), rep(NA, 2 * n_partial)), n_full = 1, n_partial = 1, n_cat = NULL, eta = 1, df = Inf, types = "continuous", estimate_CPCs = TRUE) { if(length(N) != 1) stop("length of 'N' must be 1") if(N <= 0) stop("'N' must be positive") restrictions <- match.arg(restrictions) if(strong && restrictions == "none") warning("instruments are not valid unless the MAR assumption is enforced") if(n_full < 0) stop("'n_full' must be >= 0") if(n_partial < 0) stop("'n_partial must be >= 0") n <- n_partial + n_full if(n == 0) stop("at least one of 'n_full' or 'n_partial' must be positive") if(length(pr_miss) == 1) pr_miss <- rep(pr_miss, n_partial) if(any(pr_miss <= 0)) stop("all elements of 'pr_miss' must be > 0") if(any(pr_miss >= 1)) stop("all elements of 'pr_miss' must be < 1") if(length(df) != 1) stop("'df' must be of length 1") if(df <= 0) stop("'df' must be a positive") if(length(types) == 1) types <- rep(types, n) types <- match.arg(types, c("continuous", "count", "binary", "treatment", "ordinal", "nominal", "proportion", "positive"), several.ok = TRUE) if(any(types[1:n_full] == "nominal")) { warning("fully observed nominal variables not supported, changing them to ordinal without loss of generality") types <- ifelse(types == "nominal" & 1:length(types) <= n_full, "ordinal", types) } # else if(!is.null(n_cat)) types[n:(n - length(n_cat) + 1)] <- "nominal" if(all( c("ordinal", "nominal") %in% types[-(1:n_full)] )) { stop("including both ordinal and nominal partially observed variables is not supported yet") } if(any(types == "nominal")) { has_nominal <- TRUE if(is.null(n_cat)) { if(types[n] != "nominal") { warning("assuming the last partially observed variable is nominal with 3 categories") types[n] <- "nominal" } n_cat <- 3 } } else has_nominal <- FALSE if(has_nominal) { if(any(n_cat < 3)) stop("nominal variables must have more than 2 categories") types <- c(types[types != "nominal"], types[types == "nominal"]) } if(experiment) { if(types[1] != "treatment") stop("the first variable must be the treatment variable") if(any(types[-1] == "treatment")) stop("only one treatment variable is permitted") } if(is.null(Sigma)) L <- .rcorvine(n_full, n_partial, if(has_nominal) n_cat else NULL, eta, restrictions, strong, experiment, treatment_cor, last_CPC) else { if(!isSymmetric(Sigma)) stop("'Sigma' must be symmetric") if(ncol(Sigma) != (n_full + 2 * n_partial)) stop("'Sigma' must be of order 'n_full + 2 * n_partial'") if(any(types == "nominal")) stop("nominal variables not supported when 'Sigma' is given") if(experiment) stop("treatment variables not supported when 'Sigma' is given") L <- chol(Sigma) } if(is.null(alpha)) { Z <- matrix(rnorm(N * nrow(L)), nrow = nrow(L)) X <- as.data.frame(t(Z) %*% t(L)) } else { if(length(alpha) == 1 && is.na(alpha)) alpha <- rt(ncol(L), df) else if(length(alpha) != ncol(L)) stop(paste("length of alpha must be", ncol(L))) Sigma <- tcrossprod(L) result <- find_Omega(Sigma, alpha, control = list(maxit = 1000)) X <- as.data.frame(sn::rmsn(N, Omega = result$Omega, alpha = alpha)) } if(df < Inf) X <- X / sqrt(rchisq(N, df) / df) if(!has_nominal) colnames(X) <- c(if(n_full) paste("x", 1:n_full, sep = "_"), if(n_partial) paste("y", 1:n_partial, sep = "_"), if(n_partial) paste("u", 1:n_partial, sep = "_") ) else { if(length(n_cat) > 23) stop("number of nominal variables must be <= 23") cn <- as.character(NULL) for(i in seq_along(n_cat)) cn <- c(cn, paste(letters[i], 1:n_cat[i], sep = "_")) colnames(X) <- c(if(n_full) paste("x", 1:n_full, sep = "_"), if(n_partial > length(n_cat)) paste("y", 1:(n_partial - length(n_cat)), sep = "_") else NULL, cn, paste("u", 1:n_partial, sep = "_") ) } if(experiment) { row_mark <- X[,1] == 1 col_mark <- c(FALSE, is.na(treatment_cor)) col_mark[grepl("^u_", colnames(X))] <- FALSE if(any(col_mark)) X[row_mark,col_mark] <- X[row_mark,col_mark] + 1 # ATT } X_obs <- X correlations <- rep(NA_real_, if(!has_nominal) n_partial else n_partial - length(n_cat) + sum(n_cat)) end <- n_partial - length(n_cat) * has_nominal if(end > 0) for(i in 1:end) { y_var <- paste("y", i, sep = "_") u_var <- paste("u", i, sep = "_") X_obs[X[,u_var] < quantile(X[,u_var], probs = pr_miss[i]), y_var] <- NA_real_ X_obs[[u_var]] <- NULL if(!estimate_CPCs) next f_miss <- colnames(X) if(n_full > 0) f_miss <- f_miss[1:(n_full + i - 1)] else f_miss <- "1" f_miss <- paste(f_miss, collapse = " + ") f_miss <- as.formula(paste(u_var, "~", f_miss)) ols_u <- lm(f_miss, data = X) f_true <- colnames(X) if(n_full > 0) f_true <- f_true[1:(n_full + i - 1)] else f_true <- "1" f_true <- paste(f_true, collapse = " + ") f_true <- as.formula(paste(y_var, "~", f_true)) ols_y <- lm(f_true, data = X) correlations[i] <- cor(residuals(ols_u), residuals(ols_y)) # this differs only randomly from 0 under MAR due to finite N } letter_mark <- 1 if(has_nominal) for(i in (end + 1):n_partial) { y_var <- paste("y", i, sep = "_") u_var <- paste("u", i, sep = "_") mark <- grepl(paste("^", letters[letter_mark], "_", sep = ""), colnames(X)) lev <- as.character(NULL) for(j in 1:ceiling(n_cat[letter_mark] / 26)) lev <- c(lev, rep(letters, each = j)) lev <- lev[1:n_cat[letter_mark]] X_obs[[y_var]] <- X[[y_var]] <- factor(max.col(X[,mark]), labels = lev) X_obs[X[,u_var] < quantile(X[,u_var], probs = pr_miss[i]), y_var] <- NA if(!estimate_CPCs) { letter_mark <- letter_mark + 1 next } f_miss <- colnames(X) if(letter_mark == 1) f_miss <- f_miss[1:(n_full + n_partial - length(n_cat))] else f_miss <- f_miss[1:(n_full + n_partial - length(n_cat) + sum(n_cat[1:(letter_mark - 1)]))] f_miss <- paste(f_miss, collapse = " + ") f_miss <- as.formula(paste(u_var, "~", f_miss)) ols_u <- lm(f_miss, data = X) for(j in 1:n_cat[letter_mark]) { f_true <- colnames(X) if(letter_mark == 1) f_true <- f_true[1:(n_full + n_partial - length(n_cat))] else f_true <- f_true[1:(n_full + n_partial - length(n_cat) + sum(n_cat[1:(letter_mark - 1)]))] f_true <- paste(f_true, collapse = " + ") n_var <- paste(letters[letter_mark], j, sep = "_") f_true <- as.formula(paste(n_var, "~", f_true)) ols_n <- lm(f_true, data = X) correlations[which(is.na(correlations))[1]] <- cor(residuals(ols_u), residuals(ols_n)) # this differs only randomly from 0 under MAR } letter_mark <- letter_mark + 1 } if(!has_nominal) names(correlations) <- if(n_partial) paste("e", 1:n_partial, sep = "_") else NULL else { cn <- if(n_partial > length(n_cat)) paste("e", 1:(n_partial - length(n_cat)), sep = "_") else as.character(NULL) for(i in seq_along(n_cat)) cn <- c(cn, paste("e:", letters[i], "_", 1:n_cat[i], sep = "")) names(correlations) <- cn } X_obs <- X_obs[,grepl("^[xy]_", colnames(X_obs))] mark_ord <- 1 for(i in seq_along(types)) { mark <- is.na(X_obs[,i]) if(types[i] %in% c("binary", "treatment")) { if(i == 1 && experiment) { X_obs[,i] <- X[,i] <- as.factor(X[,i] > 0) colnames(X_obs)[1] <- colnames(X)[1] <- "treatment" } else { X[[toupper(colnames(X)[i])]] <- X[,i] X_obs[,i] <- X[,i] <- cut(X[,i], breaks = 2, labels = c("FALSE", "TRUE")) } } else if(types[i] == "ordinal") { X[[toupper(colnames(X)[i])]] <- X[,i] breaks <- 3 if(length(n_cat) == 1) breaks <- n_cat else if(length(n_cat) > 1) { breaks <- n_cat[mark_ord] mark_ord <- mark_ord + 1 } qs <- quantile(X[,i], prob = seq(from = 0, to = 1, length.out = breaks + 1)) qs[1] <- -Inf qs[length(qs)] <- Inf X_obs[,i] <- X[,i] <- cut(X[,i], breaks = qs, ordered_result = TRUE, labels = LETTERS[1:breaks]) } else if(types[i] == "count") { # this is not quite consistent with the DGP X[[toupper(colnames(X)[i])]] <- X[,i] X_obs[,i] <- X[,i] <- as.integer(qpois(pt(X[,i], df = df), lambda = 5)) } else if(types[i] == "proportion") { # this is not quite consistent with the DGP X[[toupper(colnames(X)[i])]] <- X[,i] X_obs[,i] <- X[,i] <- pt(X[,i], df = df) } else if(types[i] == "positive") { X[[toupper(colnames(X)[i])]] <- X[,i] X_obs[,i] <- X[,i] <- exp(X[,i]) } X_obs[mark,i] <- NA } ord <- c(colnames(X_obs), grep("^u_", colnames(X), value = TRUE)) extras <- colnames(X) extras <- extras[!(extras %in% ord)] ord <- c(ord, extras) X <- X[,ord] cn <- colnames(X) cn <- cn[sapply(1:ncol(X), FUN = function(i) { !is.factor(X[,i]) && !(toupper(cn[i]) %in% cn[-i]) })] resort <- function(s) { ord <- order(as.integer(gsub("^[a-z,A-Z]_", "", s))) return(s[ord]) } cn <- c(if(experiment) "treatment_propensity", resort(grep("^x", cn, ignore.case = TRUE, value = TRUE)), resort(grep("^y", cn, ignore.case = TRUE, value = TRUE)), grep("^[a-t]_", cn, ignore.case = FALSE, value = TRUE), grep("^u", cn, ignore.case = FALSE, value = TRUE)) rownames(L) <- colnames(L) <- cn out <- list(true = X, obs = X_obs, empirical_CPCs = correlations, L = L) if(!is.null(alpha)) out <- c(out, list(alpha = alpha, skewness = result$sn_skewness, kurtosis = result$sn_kurtosis)) return(out) } ## this function makes a positive definite correlation matrix given choose(n,2) unbounded parameters make_O.cor <- function(theta) { n <- (1 + sqrt(1 + 8 * length(theta))) / 2 CPCs <- exp(2 * theta) CPCs <- (CPCs - 1) / (CPCs + 1) L <- matrix(0, n, n) L[1,1] <- 1 start <- 1 end <- n - 1 L[-1,1] <- partials <- CPCs[start:end] W <- log(1 - partials^2) for(i in 2:(n-1)) { start <- end + 1 end <- start + n - i - 1 gap <- (i+1):n gap1 <- i:(n-1) partials <- CPCs[start:end] L[i,i] <- exp(0.5 * W[i-1]) L[gap,i] <- partials * exp(0.5 * W[gap1]) W[gap1] <- W[gap1] + log(1 - partials^2) } L[n,n] <- exp(0.5 * W[n-1]) return(tcrossprod(L)) } ## this objective function is the Frobenius norm of the difference between Sigma and Sigma_proposed fmin <- function(theta, Sigma, alpha, final = FALSE, ...) { n <- nrow(Sigma) omega <- exp(theta[1:n]) # standard deviations of the implicit Omega matrix O.cor <- make_O.cor(theta[-(1:n)]) alphaTO.cor <- alpha %*% O.cor Sigma_proposed <- ( O.cor - 2 / (pi * c(1 + alphaTO.cor %*% alpha)) * crossprod(alphaTO.cor) ) * tcrossprod(omega) if(final) return(Sigma_proposed) return(crossprod( c(Sigma - Sigma_proposed) )[1]) } ## this function makes a 3-factor Cholesky factorization of a PSD A matrix LDLt <- function(A) { n <- nrow(A) L <- diag(n) D <- matrix(0, n, n) for(j in 1:n) { s <- 0 if(j > 1) for(k in 1:(j-1)) s <- s + L[j,k]^2 * D[k,k] D[j,j] <- A[j,j] - s if(D[j,j] < 1e-15) { D[j,j] <- 0 break } if(j < n) for(i in (j+1):n) { s <- 0 if(j > 1) for(k in 1:(j-1)) s <- s + L[i,k] * L[j,k] * D[k,k] L[i,j] <- (A[i,j] - s) / D[j,j] } } return(list(L = L, D = D)) } ## this function makes plausible starting values (basically treating alpha is if it were a zero vector) make_start <- function(Sigma) { log_omega <- log(sqrt(diag(Sigma))) Sigma <- cov2cor(Sigma) n <- nrow(Sigma) U <- t(LDLt(Sigma)$L) holder <- matrix(NA_real_, n, n) holder[1,-1] <- U[1,-1] W <- c(NA_real_, 1 - holder[1,-1]^2) for(i in 2:(n-1)) { denominator <- W[i] gap <- (i+1):n temp <- U[i,gap] / sqrt(W[gap] / denominator) invalid <- is.na(temp) temp[invalid] <- sign(U[i,gap][invalid]) invalid <- abs(temp) > 1 temp[invalid] <- sign(temp[invalid]) holder[i,gap] <- temp W[gap] <- W[gap] * (1 - holder[i,gap]^2) } holder <- t(holder) CPCs <- holder[lower.tri(holder)] return(c(log_omega, atanh(CPCs))) } ## this function finds Omega via optim() and returns it as part of a list with find_Omega <- function(Sigma, alpha, method = "BFGS", start = make_start(Sigma), ...) { stopifnot(isSymmetric(Sigma)) # Sigma is the intended covariance matrix of the multivariate skew-normal variable stopifnot(all(eigen(Sigma, TRUE, TRUE)$values > 0)) n <- nrow(Sigma) alpha <- c(alpha) stopifnot(length(alpha) == n) # alpha is a shape parameter for the multivariate skew-normal variable opt <- optim(start, fmin, method = method, Sigma = Sigma, alpha = alpha, ...) if(opt$convergence != 0) { gradients <- opt$counts["gradient"] warning(paste("Convergence problem. Pass something like 'control = list(maxit = ", 5 * gradients, ")' if alpha is far from a zero vector", sep = "")) } theta <- opt$par omega <- exp(theta[1:n]) O.cor <- make_O.cor(theta[-(1:n)]) opt$Omega <- O.cor * tcrossprod(omega) alphaTO.cor <- c(alpha %*% O.cor) delta <- c( (O.cor %*% alpha) / sqrt(1 + alphaTO.cor %*% alpha)[1] ) mu_z <- sqrt(2/pi) * delta num <- c( mu_z %*% chol2inv(chol(O.cor)) %*% mu_z ) opt$delta <- delta opt$sn_skewness <- ( (4 - pi) / 4 )^2 * ( num / (1 - num) )^3 opt$sn_kurtosis <- 2 * (pi - 3) * ( num / (1 - num) )^2 return(opt) } mi/R/change_link.R0000644000175000017500000000553712513634171013614 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## these change the link function used in the imputation process setMethod("change_link", signature(data = "missing", y = "missing_variable", to = "character"), def = function(y, to) { fam <- do.call(y@family$family, args = list(link = to)) y@family <- fam validObject(y, complete = TRUE) return(y) }) setMethod("change_link", signature(data = "missing", y = "missing_variable", to = "missing"), def = function(y, to) { cat("Likely choices include:", y@known_links, sep = "\n") return(invisible(NULL)) }) setMethod("change_link", signature(data = "missing_data.frame", y = "character", to = "character"), def = function(data, y, to) { if(length(to) == 1) to <- rep(to, length(y)) else if(length(to) != length(y)) stop("'y' and 'to' must have the same length") if(all(y %in% names(getClass("missing_variable")@subclasses))) { classes <- sapply(data@variables, class) y <- c(sapply(y, FUN = function(x) { names(classes[which(classes == x)]) })) if(is.list(y)) stop(paste("no variables of class", names(y)[1])) else y <- y[1] } y <- match.arg(y, data@DIMNAMES[[2]], several.ok = TRUE) for(i in 1:length(y)) { data@variables[[y[i]]] <- change_link(y = data@variables[[y[i]]], to = to[i]) } return(invisible(data)) }) setMethod("change_link", signature(data = "missing_data.frame", y = "numeric", to = "character"), def = function(data, y, to) { if(length(to) == 1) to <- rep(to, length(y)) else if(length(to) != length(y)) stop("'y' and 'to' must have the same length") for(i in 1:length(y)) { data@variables[[y]] <- change_link(y = data@variables[[y]], to = to[i]) } return(invisible(data)) }) setMethod("change_family", signature(data = "missing_data.frame", y = "logical", to = "character"), def = function(data, y, to) { if(length(y) != data@DIM[2]) { stop("the length of 'y' must equal the number of variables in 'data'") } return(change_link(data, which(y), to)) }) mi/R/tobin5.R0000644000175000017500000001321112513634171012536 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. # This is superceded by the tobin5() function below tobin5 <- function(mdf, y, f = NULL) { if(!is(mdf, "missing_data.frame")) stop("'mdf' must be a 'missing_data.frame'") if(!is.character(y)) stop("'y' must be a character string") if(length(y) != 1) stop("'y' must have length one") if(!(y %in% colnames(mdf))) stop("'y' must be a variable in 'mdf'") y <- mdf@variables[[y]] NAs <- is.na(y) to_drop <- mdf@index[[y@variable_name]] X <- mdf@X[,-to_drop] probit <- bayesglm.fit(X, y = NAs, family = binomial(link = "probit")) class(probit) <- c("bayesglm", "glm", "lm") gamma <- coef(probit) IMR_0 <- dnorm(-fitted(probit)) / pnorm(-fitted(probit)) IMR_1 <- dnorm( fitted(probit)) / pnorm( fitted(probit)) if(is.null(f)) { mark <- colnames(mdf@X)[!grepl("^missing_", colnames(mdf@X))][-1] mark <- mark[mark != y@variable_name] f <- paste(mark, collapse = " + ") f <- paste(y@variable_name, " ~ ", f, " + IMR", sep = "") f <- as.formula(f) } else if(!is(f, "formula")) stop("'f' must be 'NULL' or a formula") df <- as.data.frame(cbind(mdf@X, IMR = IMR_0)) if(is(y, "continuous")) { model_0 <- bayesglm(f, family = gaussian, data = df, subset = !NAs) } else stop("only continuous dependent variables are supported at the moment") df <- as.data.frame(cbind(mdf@X, IMR = IMR_1)) if(is(y, "continuous")) { model_1 <- bayesglm(f, family = gaussian, data = df, subset = NAs) } se_0 <- model_0$dispersion se_1 <- model_1$dispersion delta_0 <- IMR_0^2 - fitted(probit) * IMR_0 delta_1 <- IMR_1^2 + fitted(probit) * IMR_1 betaL_0 <- coef(model_0) betaL_0 <- betaL_0[length(betaL_0)] betaL_1 <- coef(model_1) betaL_1 <- betaL_1[length(betaL_1)] sigma_0 <- sqrt(se_0^2 + (betaL_0 * delta_0)^2) sigma_1 <- sqrt(se_1^2 + (betaL_1 * delta_1)^2) rho_0 <- -betaL_0 / sigma_0 rho_1 <- betaL_1 / sigma_1 ## FIXME: correct vcov(model_0) and vcov(model_1) now return(list(probit = probit, model_0 = model_0, model_1 = model_1, rho_0 = rho_0, rho_1 = rho_1)) } tobin5 <- function(imputations, y, f = NULL) { if(!is(imputations, "mi")) stop("'imputations' must be a 'mi' object") if(!is.character(y)) stop("'y' must be a character string") if(length(y) != 1) stop("'y' must have length one") if(!(y %in% colnames(imputations))) stop("'y' must be a variable in 'imputations'") dfs <- complete(imputations) mdf <- imputations@data[[1]] to_drop <- mdf@index[[y@variable_name]] cn <- colnames(mdf@X[,-to_drop])[-1] f1 <- paste(cn, collapse = " + ") NAs <- is.na(mdf@variables[[y]]) if(paste("missing", y, sep = "_") %in% colnames(mdf@X)) { f1 <- paste(paste("missing", y, sep = "_"), "~", f1) } else for(i in seq_along(dfs)) { dfs[[i]] <- cbind(dfs[[i]], NAs) colnames(dfs[[i]]) <- c(colnames(dfs[[i]]), paste("missing", y, sep = "_")) } f1 <- as.formula(f1) probit <- pool(f1, data = dfs, family = binomial(link = "probit")) gamma <- sapply(probit@models, coef) Pr <- sapply(probit@models, fitted) IMR_0 <- apply(Pr, 2, FUN = function(p) dnorm(-p) / pnorm(-p)) IMR_1 <- apply(Pr, 2, FUN = function(p) dnorm( p) / pnorm( p)) if(is.null(f)) { mark <- colnames(mdf@X)[!grepl("^missing_", colnames(mdf@X))][-1] mark <- mark[mark != y] f <- paste(mark, collapse = " + ") f <- paste(y@variable_name, " ~ ", f, " + IMR", sep = "") f <- as.formula(f) } else if(!is(f, "formula")) stop("'f' must be 'NULL' or a formula") if(!is(mdf@variables[[y]], "continuous")) { stop("only continuous dependent variables are supported at the moment") } for(i in seq_along(dfs)) dfs[[i]]$IMR <- IMR_0[,i] model_0 <- pool(f, data = dfs, family = gaussian, subset = !NAs) for(i in seq_along(dfs)) dfs[[i]]$IMR <- IMR_1[,i] model_1 <- pool(f, data = dfs, family = gaussian, subset = NAs) se_0 <- sapply(model_0@models, FUN = function(m) m$dispersion) se_1 <- sapply(model_1@models, FUN = function(m) m$dispersion) delta_0 <- IMR_0^2 - Pr * IMR_0 delta_1 <- IMR_1^2 + Pr * IMR_1 betaL_0 <- sapply(model_0@models, coef) betaL_0 <- betaL_0[nrow(betaL_0)] betaL_1 <- sapply(model_1@models, coef) betaL_1 <- betaL_1[nrow(betaL_1)] sigma_0 <- sqrt(se_0^2 + sweep(delta_0, 2, betaL_0, FUN = "*")^2) sigma_1 <- sqrt(se_1^2 + sweep(delta_1, 2, betaL_1, FUN = "*")^2) rho_0 <- -betaL_0 / sigma_0 rho_1 <- betaL_1 / sigma_1 ## FIXME: correct vcov(model_0) and vcov(model_1) now return(list(probit = probit, model_0 = model_0, model_1 = model_1, rho_0 = rho_0, rho_1 = rho_1)) } mi/R/change_type.R0000644000175000017500000001021212513634171013622 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## these coerce a missing_variable to a different type of missing_variable setMethod("change_type", signature(data = "missing", y = "missing_variable", to = "character"), def = function(y, to, ...) { to <- match.arg(to, names(getClass("missing_variable")@subclasses)) if(to %in% c("ordered-categorical", "binary")) raw <- as.ordered(y@raw_data) else if(to == "unordered-categorical") raw <- factor(y@raw_data, ordered = FALSE) else raw <- as.numeric(y@raw_data) vals <- unique(raw) vals <- vals[!is.na(vals)] if(length(vals) <= 1) { warning(paste(y@variable_name, ": cannot change type because only one unique value")) return(y) } else return(new(to, variable_name = y@variable_name, raw_data = raw, imputation_method = y@imputation_method, ...)) }) setMethod("change_type", signature(data = "missing", y = "missing_variable", to = "missing"), def = function(y, to) { classes <- .possible_missing_variable(y@raw_data) classes <- names(classes[classes]) cat("Likely choices include:", classes, sep = "\n") return(invisible(NULL)) }) setMethod("change_type", signature(data = "missing_data.frame", y = "character", to = "missing"), def = function(data, y, to) { if(all(y %in% names(getClass("missing_variable")@subclasses))) { classes <- sapply(data@variables, class) y <- c(sapply(y, FUN = function(x) { names(classes[which(classes == x)]) })) if(is.list(y)) stop(paste("no variables of class", names(y)[1])) else y <- y[1] } y <- match.arg(y, data@DIMNAMES[[2]], several.ok = TRUE) for(i in 1:length(y)) change_type(y = data@variables[[y[i]]]) return(data) }) setMethod("change_type", signature(data = "missing_data.frame", y = "character", to = "character"), def = function(data, y, to, ...) { if(length(to) == 1) to <- rep(to, length(y)) else if(length(to) != length(y)) stop("'y' and 'to' must have the same length") if(all(y %in% names(getClass("missing_variable")@subclasses))) { classes <- sapply(data@variables, class) y <- c(sapply(y, FUN = function(x) { names(classes[which(classes == x)]) })) if(is.list(y)) stop(paste("no variables of class", names(y)[1])) to <- rep(to[1], length(y)) } y <- match.arg(y, data@DIMNAMES[[2]], several.ok = TRUE) for(i in 1:length(y)) { data@variables[[y[i]]] <- change_type(y = data@variables[[y[i]]], to = to[i], ...) data@variables[[y[i]]]@variable_name = y[i] } return(new(class(data), variables = data@variables)) }) setMethod("change_type", signature(data = "missing_data.frame", y = "numeric", to = "character"), def = function(data, y, to, ...) { if(length(to) == 1) to <- rep(to, length(y)) else if(length(to) != length(y)) stop("'y' and 'to' must have the same length") for(i in 1:length(y)) { data@variables[[y]] <- change_type(y = data@variables[[y]], to = to[[i]], ...) } return(new(class(data), variables = data@variables)) }) setMethod("change_type", signature(data = "missing_data.frame", y = "logical", to = "character"), def = function(data, y, to, ...) { if(length(y) != data@DIM[2]) { stop("the length of 'y' must equal the number of variables in 'data'") } return(change_type(data, which(y), to, ...)) }) mi/R/pool.R0000644000175000017500000002065012513634171012314 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. pool <- function(formula, data, m = NULL, FUN = NULL, ...) { if(is.list(data)) { if(all(sapply(data, is, class2 = "mi"))) { if(is.null(m)) m <- length(data[[1]]@data) else m <- as.integer(m) dfs <- complete(data[[1]], m = m, to_matrix = FALSE) l <- length(data) if(l > 1) for(i in 2:l) { temp <- complete(data[[l]], m = m, to_matrix = FALSE) for(j in seq_along(temp)) dfs[[j]] <- rbind(dfs[[j]], temp[[j]]) } data <- data[[1]] } else if(all(sapply(data, is.data.frame))) { dfs <- data m <- length(dfs) } else { stop("if 'data' is a list it must be a list of mi objects or data.frames") } } else if(is(data, "mi")) { if(is.null(m)) m <- length(data@data) else m <- as.integer(m) dfs <- complete(data, m = m, to_matrix = FALSE) } if(!is(formula, "formula")) stop("'formula' must be a formula") dots <- list(...) if(is.null(FUN)) { if(!is(data, "mi")) stop("if 'data' is not of class 'mi', 'FUN' must be specified") yname <- as.character(formula)[2] if(!(yname %in% colnames(data@data[[1]]))) { stop(paste("no variable called", yname, "possibly due to typo or transformation,", "in which case you need to specify 'FUN' explicitly")) } else y <- data@data[[1]]@variables[[yname]] if(!is.method_in_mi("fit_model", y = class(y), data = class(data@data[[1]]))) { stop(paste(yname, "seems to have a user-defined 'fit_model' method,", "in which case 'FUN' must be specified explicitly")) } if(is(y, "unordered-categorical")) { FUN <- nnet::multinom fit <- "multinom" } else if(is(y, "binary") | is(y, "count") | is(y, "continuous")) { FUN <- arm::bayesglm fit <- "bayesglm" if(!("family" %in% names(dots))) dots$family <- y@family } else if(is(y, "interval")) { FUN <- survival::survreg fit <- "survreg" } else if(is(y, "ordered-categorical")) { FUN <- arm::bayespolr fit <- "bayespolr" if(!("method" %in% names(dots))) dots$method <- if(y@family$link == "logit") "logistic" else y@family$link } } else if(!is(FUN, "function")) stop("'FUN' must be a function or NULL") else fit <- deparse(substitute(FUN)) models <- lapply(dfs, FUN = function(d) { dots$data <- d dots$formula <- formula do.call(FUN, args = dots) }) summaries <- lapply(models, summary) pooled_summary <- summaries[[1]] if(is.list(pooled_summary)) for(i in seq_along(pooled_summary)) { if(is.numeric(pooled_summary[[i]])) { num <- lapply(summaries, FUN = function(x) x[[i]]) if(is.matrix(pooled_summary[[i]])) { mat <- pooled_summary[[i]] arr <- array(unlist(num), dim = c(dim(mat), m)) arr <- apply(arr, 1:2, mean) colnames(arr) <- colnames(mat) rownames(arr) <- rownames(mat) pooled_summary[[i]] <- arr } else if(length(pooled_summary[[i]]) > 1) { arr <- rowMeans(matrix(unlist(num), ncol = m)) names(arr) <- names(pooled_summary[[i]]) pooled_summary[[i]] <- arr } else pooled_summary[[i]] <- mean(unlist(num)) } } else { pooled_summary <- list() warning("could not construct pooled_summary") } coefs <- sapply(models, get_parameters) variances <- sapply(models, FUN = function(x) diag(vcov(x))) W <- rowMeans(variances) B <- apply(coefs, 1, var) ses <- sqrt(W + B * (1 + 1/m)) if(is(pooled_summary, "summary.glm") | is(pooled_summary, "summary.polr")) { pooled_summary$call <- match.call() pooled_summary$coefficients[,1:2] <- cbind(rowMeans(coefs), ses) } else if(is(pooled_summary, "summary.multinom")) { pooled_summary$call <- match.call() pooled_summary$coefficients <- cbind(coef = rowMeans(coefs), ses, z = NA_real_, p = NA_real_) } else warning("pooled_summary is probably bogus") if(ncol(pooled_summary$coefficients) >= 3) { if(colnames(pooled_summary$coefficients)[3] == "t value") { pooled_summary$coefficients[,3] <- tvalue <- pooled_summary$coefficients[,1] / ses if(TRUE) { gamma <- (1 + 1/m) * B / ses^2 df.r <- pooled_summary$df.residual v <- (m - 1) * (1 + m/(m + 1) * W / B)^2 v_obs <- (1 - gamma) * (df.r + 1) / (df.r + 3) * df.r df.star <- 1/(1/v + 1/v_obs) if(ncol(pooled_summary$coefficients) == 4) { pooled_summary$coefficients[,4] <- 2 * pt(-abs(tvalue), df.star) } else pooled_summary$coefficients <- cbind(pooled_summary$coefficients, "p-value" = 2 * pt(-abs(tvalue), df.star)) } } else { pooled_summary$coefficients[,3] <- zvalue <- pooled_summary$coefficients[,1] / ses if(ncol(pooled_summary$coefficients) == 4) { pooled_summary$coefficients[,4] <- 2 * pnorm(-abs(zvalue)) } else pooled_summary$coefficients <- cbind(pooled_summary$coefficients, "p-value" = 2 * pnorm(-abs(zvalue)) ) } } kall <- match.call() kall[1] <- call(fit) out <- new("pooled", formula = formula, fit = fit, models = models, coefficients = rowMeans(coefs), ses = ses, pooled_summary = pooled_summary, call = kall) return(out) } setMethod("display", signature(object = "pooled"), def = function(object, digits = 2, ...) { call <- object@call summ <- summary(object) coef <- object@pooled_summary$coefficients[,1:2] colnames(coef) <- c("coef.est", "coef.se") n <- summ$df.residual k <- summ$df[1] k.intercepts <- length(summ$zeta) print(call) pfround(coef, digits) if(k.intercepts > 0) { cat(paste("n = ", n, ", k = ", k, " (including ", k.intercepts, " intercepts)\nresidual deviance = ", fround(summ$deviance, 1), ", null deviance is not computed by polr", "\n", sep = "")) return(invisible(NULL)) } cat(paste("n = ", n, ", k = ", k, "\nresidual deviance = ", fround(summ$deviance, 1), ", null deviance = ", fround(summ$null.deviance, 1), " (difference = ", fround(summ$null.deviance - summ$deviance, 1), ")", "\n", sep = "")) dispersion <- summ$dispersion if (dispersion != 1) { cat(paste("overdispersion parameter = ", fround(dispersion, 1), "\n", sep = "")) if (summ$family$family == "gaussian") { cat(paste("residual sd is sqrt(overdispersion) = ", fround(sqrt(dispersion), digits), "\n", sep = "")) } } return(invisible(NULL)) }) setMethod("show", signature(object = "pooled"), def = function(object) { display(object) return(invisible(NULL)) }) setMethod("summary", signature(object = "pooled"), def = function(object, ...) { return(object@pooled_summary) }) setMethod("coef", signature(object = "pooled"), def = function(object, ...) { return(object@coefficients) }) setMethod("vcov", signature(object = "pooled"), def = function(object, ...) { return(object@vcov) }) setMethod("residuals", signature(object = "pooled"), def = function(object, ...) { return(rowMeans(sapply(object@models, residuals))) }) setMethod("fitted", signature(object = "pooled"), def = function(object, ...) { return(rowMeans(sapply(object@models, fitted, ...))) }) mi/R/AllClass.R0000644000175000017500000015764512513727705013066 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # Copyright (C) 1995-2012 The R Core Team # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## NOTE: If you change something here, also update the UML graph thingie setClassUnion("MatrixTypeThing", c("matrix")) setOldClass("family") suppressWarnings(setClassUnion("WeAreFamily", c("family", "character"))) # arm + lme4 = warnings setOldClass("mi_list") setOldClass("mdf_list") .known_imputation_methods <- c("ppd", "pmm", "mean", "median", "expectation", "mode", "mcar", NA_character_) .known_families <- c("binomial", "gaussian", "Gamma", "inverse.gaussian", "poisson", "quasibinomial", "quasipoisson") # "quasi" is not supported at the moment (FIXME) .known_links <- c("logit", "probit", "cauchit", "log", "cloglog", # for binomial() "identity", "inverse", # for gaussian() plus "log", # "inverse", "identity", "log", # for Gamma() "sqrt", # for poisson() plus "log", and "identity", "1/mu^2") # for inverse.gaussian() plus "inverse", "identity" and "log" # An important class in library(mi) is the missing_variable class, which is a virtual class # for a variable that may (or may not) have missingness. The usual types of variables that # we are interested in imputing all inherit (perhaps indirectly) from the missing_variable # superclass, e.g. continuous, binary, etc. In principle, these class definitions should # provide ALL the necessary information for that variable, like the extent of its missingness # and how the missing values will be (or have been) imputed. Thus, in principle, it should # be possible to tweak the behavior of library(mi) simply by 1) creating a new class that # inherits from the relevant existing class, 2) writing methods for the mi() and fit_model() # generics and 3) perhaps a few other things that you will have to discover on your own. ## missing_variable is a virtual class for a variable that may (or may not) have missingness setClass("missing_variable", representation( variable_name = "character", # name of the variable but do not rely on for anything important raw_data = "ANY", ## DO NOT EVER CHANGE THE VALUES OF THIS SLOT data = "ANY", ## Copy the raw_data into data and modify data as necessary n_total = "integer", # total number of potential datapoints, i.e. length of raw_data all_obs = "logical", # are ALL datapoints actually observed, i.e. not missing? n_obs = "integer", # number of observed datapoints which_obs = "integer", # which datapoints are observed all_miss = "logical", # are ALL datapoints missing, only true for latent variables n_miss = "integer", # number of missing datapoints in the data slot (originally) which_miss = "integer", # which datapoints are missing in the data slot n_extra = "integer", # number of extra datapoints added (as missing) which_extra = "integer", # which datapoints are extras n_unpossible = "integer", # number of datapoints for which the variable could not be observed which_unpossible = "integer",# which datapoints could not be observed n_drawn = "integer", # number of datapoints to impute which_drawn = "integer", # which datapoints are imputed imputation_method = "character", # how to impute them family = "WeAreFamily", # see help(family) known_families = "character",# families listed on help(family) plus multinomial() known_links = "character", # see help(family) imputations = "MatrixTypeThing", # iterations x n_drawn matrix of imputation history done = "logical", # are we finished imputing? parameters = "MatrixTypeThing", # history of estimated parameters in modeling this variable model = "ANY", # last model fit fitted = "ANY", # last fitted values "VIRTUAL"), prototype( variable_name = NA_character_, imputations = matrix(NA_real_, 0, 0), parameters = matrix(NA_real_, 0, 0), imputation_method = .known_imputation_methods, family = NA_character_, known_families = .known_families, known_links = .known_links ), validity = function(object) { out <- TRUE l <- length(object@raw_data) if(l == 0) return(out) if(sum(-object@n_total, object@n_obs, object@n_miss, object@n_extra, object@n_unpossible, na.rm = TRUE)) { out <- paste(object@variable_name, ": slots 'n_obs', 'n_miss', 'n_extra', and 'n_unpossible' must sum to 'n_total'") } else if(!(length(object@which_obs) %in% c(0:1, object@n_obs))) { out <- paste(object@variable_name, ": 'n_obs' must equal the length of 'which_obs'") } else if(!(length(object@which_miss) %in% c(0:1, object@n_miss))) { out <- paste(object@variable_name, ": 'n_miss' must equal the length of 'which_miss'") } else if(!(length(object@which_extra) %in% c(0:1, object@n_extra))) { out <- paste(object@variable_name, ": 'n_extra' must equal the length of 'which_extra'") } else if(!(length(object@which_extra) %in% c(0:1, object@n_unpossible))) { out <- paste(object@variable_name, ": 'n_unpossible' must equal the length of 'which_unpossible'") } else if(sum(object@n_obs)) { temp <- sort(c(object@which_obs, object@which_miss, object@which_extra, object@which_unpossible)) names(temp) <- NULL if(!identical(1:object@n_total, temp)) { out <- paste(object@variable_name, ": ''which_*' slots must be mutually exclusive and exhaustive") } } for(i in slotNames(object)) { if(i %in% c("raw_data", "data", "which_obs", "which_miss", "which_extra", "which_unpossible", "which_drawn", "imputation_method", "known_transformations", "family", "known_families", "known_links", "levels", "cutpoints")) next if((l <- length(slot(object, i))) > 1) { out <- paste(object@variable_name, ": length of", i, "must be 0 or 1 but is", l) break } } return(out) } ) ## this initialize() method gets called for everything that inherits from missing_variable ## but can be modified by a subsequently-called initialize() method setMethod("initialize", "missing_variable", def = function(.Object, NA.strings = c("", ".", "Na", "N/a", "N / a", "NaN", "Not Applicable", "Not applicable", "Not Available", "Not available", "Not Ascertained", "Not ascertained", "Unavailable", "Unknown", "Missing", "Dk", "Don't Know", "Don't know", "Do Not Know", "Do not know"), ...) { .Object <- callNextMethod() if(length(.Object@raw_data) == 0) return(.Object) if(length(.Object@data) == 0) { # copy raw_data into data .Object@data <- .Object@raw_data names(.Object@data) <- .Object@variable_name } # bookkeeping infinites <- is.infinite(.Object@raw_data) if(any(infinites)) { warning(paste(.Object@variable_name, ": some observations are infinite, changing to NA")) .Object@data[infinites] <- NA } nans <- is.nan(.Object@raw_data) if(any(nans)) { warning(paste(.Object@variable_name, ": some observations are NaN, changing to NA")) .Object@data[nans] <- NA } NA.strings <- unique(c(NA.strings, toupper(NA.strings), tolower(NA.strings))) if(!is.numeric(.Object@raw_data)) for(i in seq_along(NA.strings)) { mark <- .Object@raw_data == NA.strings[i] if(any(mark, na.rm = TRUE)) { warning(paste(.Object@variable_name, ": some observations", NA.strings[i], "changing to NA")) .Object@data[mark] <- NA } } NAs <- which(is.na(.Object@data)) if(length(NAs)) .Object@imputation_method <- "ppd" else .Object@imputation_method <- NA_character_ .Object@n_miss <- length(NAs) .Object@which_miss <- NAs notNAs <- which(!is.na(.Object@data)) .Object@n_obs <- length(notNAs) .Object@which_obs <- notNAs .Object@n_total <- length(NAs) + length(notNAs) .Object@all_miss <- length(notNAs) == 0 .Object@all_obs <- length(NAs) == 0 if(!length(.Object@n_extra)) .Object@n_extra <- 0L if(!length(.Object@n_unpossible)) .Object@n_unpossible <- 0L .Object@n_drawn <- .Object@n_miss + .Object@n_extra .Object@which_drawn <- c(.Object@which_miss, .Object@which_extra) .Object@done <- FALSE return(.Object) }) setClass("irrelevant", representation("missing_variable"), # prototype( # imputation_method = NA_character_, # family = NA_character_) ) ## a constant variable that has no missingness (and very few methods) setClass("fixed", representation("irrelevant"), validity = function(object) { out <- TRUE vals <- unique(object@raw_data) vals <- vals[!is.na(vals)] if(sum(object@n_miss)) { out <- paste(object@variable_name, ": fixed variables cannot have missingness") } else if(length(vals) > 1) { out <- paste(object@variable_name, ": purportedly 'fixed' variables cannot have multiple unique values") } return(out) } ) setClass("group", representation("irrelevant")) ## virtual class for categorical variables, which may be unordered, ordered, binary, or interval setClass("categorical", representation( "missing_variable", levels = "character", "VIRTUAL"), prototype( known_families = c("multinomial", "binomial", "gaussian") ) ) setMethod("initialize", "categorical", def = function(.Object, ...) { .Object <- callNextMethod() l <- length(.Object@raw_data) if(l == 0) return(.Object) ## FIXME: check on the unused levels thing # .Object@raw_data <- factor(.Object@raw_data) lev <- levels(factor(.Object@raw_data)) # dummies <- t(sapply(.Object@raw_data, FUN = function(x) as.integer(x == lev)))[,-1, drop = FALSE] # if(ncol(dummies) == 1) colnames(dummies) <- .Object@variable_name # else colnames(dummies) <- lev[-1] # mark <- !apply(dummies, 2, FUN = function(x) all(x == 0, na.rm = TRUE)) # dummies <- dummies[,mark, drop = FALSE] # lev <- c(lev[1], lev[-1][mark]) .Object@levels <- lev .Object@data <- as.integer(factor(.Object@raw_data)) return(.Object) }) ## this is a hacked version of binomial() multinomial <- function (link = "logit") { linktemp <- substitute(link) if (!is.character(linktemp)) { linktemp <- deparse(linktemp) if (linktemp == "link") { warning("use of multinomial(link=link) is deprecated\n", domain = NA) linktemp <- eval(link) if (!is.character(linktemp) || length(linktemp) != 1L) stop("'link' is invalid", domain = NA) } } okLinks <- c("logit", "probit", "cloglog", "cauchit", "log") if (linktemp %in% okLinks) stats <- make.link(linktemp) else if (is.character(link)) { stats <- make.link(link) linktemp <- link } else { if (inherits(link, "link-glm")) { stats <- link if (!is.null(stats$name)) linktemp <- stats$name } else { stop(gettextf("link \"%s\" not available for multinomial family; available links are %s", linktemp, paste(sQuote(okLinks), collapse = ", ")), domain = NA) } } variance <- function(mu) mu * (1 - mu) validmu <- function(mu) all(mu > 0) && all(mu < 1) dev.resids <- binomial()$dev.resids aic <- function(y, n, mu, wt, dev) { m <- if (any(n > 1)) n else wt -2 * sum(ifelse(m > 0, (wt/m), 0) * dbinom(round(m * y), round(m), mu, log = TRUE)) } initialize <- expression({ if (NCOL(y) == 1) { if (is.factor(y)) y <- y != levels(y)[1L] n <- rep.int(1, nobs) y[weights == 0] <- 0 if (any(y < 0 | y > 1)) stop("y values must be 0 <= y <= 1") mustart <- (weights * y + 0.5)/(weights + 1) m <- weights * y if (any(abs(m - round(m)) > 0.001)) warning("non-integer #successes in a multinomial glm!") } else if (NCOL(y) == 2) { if (any(abs(y - round(y)) > 0.001)) warning("non-integer counts in a multinomial glm!") n <- y[, 1] + y[, 2] y <- ifelse(n == 0, 0, y[, 1]/n) weights <- weights * n mustart <- (n * y + 0.5)/(n + 1) } else stop("for the multinomial family, y must be a vector of 0 and 1's\n", "or a 2 column matrix where col 1 is no. successes and col 2 is no. failures") }) simfun <- function(object, nsim) { ftd <- fitted(object) n <- length(ftd) ntot <- n * nsim wts <- object$prior.weights if (any(wts%%1 != 0)) stop("cannot simulate from non-integer prior.weights") if (!is.null(m <- object$model)) { y <- model.response(m) if (is.factor(y)) { yy <- factor(1 + rbinom(ntot, size = 1, prob = ftd), labels = levels(y)) split(yy, rep(seq_len(nsim), each = n)) } else if (is.matrix(y) && ncol(y) == 2) { yy <- vector("list", nsim) for (i in seq_len(nsim)) { Y <- rbinom(n, size = wts, prob = ftd) YY <- cbind(Y, wts - Y) colnames(YY) <- colnames(y) yy[[i]] <- YY } yy } else rbinom(ntot, size = wts, prob = ftd)/wts } else rbinom(ntot, size = wts, prob = ftd)/wts } structure(list(family = "multinomial", link = linktemp, linkfun = stats$linkfun, linkinv = stats$linkinv, variance = variance, dev.resids = dev.resids, aic = aic, mu.eta = stats$mu.eta, initialize = initialize, validmu = validmu, valideta = stats$valideta, simulate = simfun), class = "family") } ## unordered categorical, which corresponds to an unordered factor with more than 2 levels setClass("unordered-categorical", representation("categorical", estimator = "character", use_NA = "logical", rank = "integer"), prototype( estimator = "MNL", imputation_method = c("ppd", "pmm", "mode", "mcar", NA_character_), family = multinomial(link = "logit"), known_families = c("multinomial", "binomial"), known_links = c("logit", "probit", "cauchit", "log", "cloglog"), use_NA = FALSE, rank = NA_integer_ ), validity = function(object) { out <- TRUE values <- unique(object@raw_data) values <- values[!is.na(values)] im <- getClass(class(object))@prototype@imputation_method if(length(values) > 0 && length(values) <= 2) { out <- paste(object@variable_name, "unordered-categoricals must have more than 2 levels; otherwise use binary") } else if(!all(object@imputation_method %in% im)) { out <- paste(object@variable_name, ": 'imputation_method' must be one of:\n", paste(im, collapse = ", ")) } # else if(object@family$family != "multinomial") { # out <- "the 'family' slot of 'unordered-categorial' class must be 'multinomial(link = 'logit')'" # } # else if(object@family$link != "logit") { # out <- "the 'family' slot of 'unordered-categorial' class must be 'multinomial(link = 'logit')'" # } else if(!(object@estimator %in% c("MNL", "RNL"))) { out <- paste(object@variable_name, ": estimator not recognized") } else if(!(object@use_NA %in% c(TRUE, FALSE))) { out <- paste(object@variable_name, ": use_NA must be TRUE or FALSE") } return(out) } ) ## ordered categorical, which corresponds to an ordered factor setClass("ordered-categorical", representation("categorical", cutpoints = "numeric"), prototype( imputation_method = c("ppd", "pmm", "mode", "mcar", NA_character_), family = multinomial(link = "logit"), known_families = c("multinomial", "gaussian", "binomial", "quasibinomial"), known_links = "logit" ), validity = function(object) { out <- TRUE im <- getClass(class(object))@prototype@imputation_method if(!(object@family$family %in% getClass(class(object))@prototype@known_families)) { # interval and binary are validated separately out <- "the 'family' slot of 'ordered-categorial' class must be 'multinomial()'" } else if(object@family$family == "multinomial" && object@family$link != "logit") { out <- "the 'family' slot of 'ordered-categorial' class must be 'multinomial(link = 'logit')'" } else if(!all(object@imputation_method %in% im)) { out <- paste(object@variable_name, ": 'imputation_method' must be one of:\n", paste(im, collapse = ", ")) } return(out) } ) ## ordered categorical with known cutpoints that discretize a continuous variable (like income) setClass("interval", representation("ordered-categorical"), prototype( imputation_method = c("ppd", NA_character_), family = gaussian(), known_families = "gaussian", known_links = c("identity", "inverse", "log") ), validity = function(object) { out <- TRUE if(!(object@imputation_method[1] == "ppd")) { out <- paste(object@variable_name, ": 'imputation_method' must be 'ppd'") } else if(object@family$family != "gaussian") { out <- "the 'family' slot of 'interval' class must be 'gaussian()'" } return(out) } ) ## binary variable # binary inherits from ordered-categorical because it often makes sense to think of # those who are coded as 1 as having "more" of something than those who are coded as # zero. Also, binary logit, probit, etc. are special cases of ordinal logit, probit, # etc. with one cutpoint fixed at zero. setClass("binary", representation("ordered-categorical"), prototype( family = binomial(link = "logit"), known_families = c("binomial", "quasibinomial"), known_links = c("logit", "probit", "cauchit", "log", "cloglog"), cutpoints = 0.0), validity = function(object) { out <- TRUE if(length(object@raw_data) == 0) return(out) vals <- unique(object@raw_data) vals <- vals[!is.na(vals)] kf <- getClass(class(object))@prototype@known_families kl <- getClass(class(object))@prototype@known_links if(length(vals) != 2) { out <- paste(object@variable_name, ": binary variables must have exactly two response categories") } else if(!identical(object@cutpoints, 0.0)) { out <- paste(object@variable_name, ": 'cutpoints' must be 0.0 for a binary variable") } else if(!(object@family$family %in% kf)) { out <- paste(object@variable_name, ": the 'family' slot of a object of class 'binary' must be one of", paste(kf, collapse = ", ")) } else if(!(object@family$link %in% kl)) { out <- paste(object@variable_name, ": the 'link' slot of the 'family' slot of a object of class 'binary' must be one of", paste(kl, collapse = ", ")) } return(out) } ) setMethod("initialize", "binary", def = function(.Object, ...) { .Object <- callNextMethod() l <- length(.Object@raw_data) if(l == 0) return(.Object) .Object@data <- as.integer(.Object@data == max(.Object@data, na.rm = TRUE)) + 1L return(.Object) }) setClass("grouped-binary", representation("binary", strata = "character"), prototype( imputation_method = "pmm" ), validity = function(object) { out <- TRUE if(length(object@raw_data) == 0) return(out) if(!requireNamespace("survival")) { out <- "the 'survival' package must be installed to use 'grouped-binary' variables" } else if(length(object@strata) == 0) { warning(paste("you must specify the 'strata' slot for", object@variable_name, "see help('grouped-binary-class')")) } return(out) } ) setMethod("initialize", "grouped-binary", def = function(.Object, ...) { .Object <- callNextMethod() l <- length(.Object@raw_data) if(l == 0) return(.Object) .Object@imputation_method <- "pmm" return(.Object) }) ## count variables, which must be nonnegative integers setClass("count", representation("missing_variable"), prototype( imputation_method = c("ppd", "pmm", "mean", "median", "expectation", "mcar", NA_character_), family = quasipoisson(), known_families = c("quasipoisson", "poisson"), known_links = c("log", "identity", "sqrt") ), validity = function(object) { out <- TRUE l <- length(object@raw_data) if(l == 0) return(out) im <- getClass(class(object))@prototype@imputation_method if(any(object@raw_data < 0, na.rm = TRUE)) { out <- paste(object@variable_name, ": counts must be nonnegative") } else if(any(object@raw_data != as.integer(object@raw_data), na.rm = TRUE)) { out <- paste(object@variable_name, ": must contain all nonnegative integers to use the 'count' class") } else if(!all(object@imputation_method %in% im)) { out <- paste(object@variable_name, ": 'imputation_method' must be one of:\n", paste(im, collapse = ", ")) } else if(sum(object@n_unpossible)) { out <- paste(object@variable_name, ": unpossible observations not supported for count variables yet") } return(out) } ) .identity_transform <- function(y, ...) return(y) .standardize_transform <- function(y, mean = stop("must supply mean"), sd = stop("must supply sd"), inverse = FALSE) { if(inverse) return(y * 2 * sd + mean) else return( (y - mean) / (2 * sd) ) } ## continuous variables, which may have inequality restrictions or transformation functions setClass("continuous", representation( "missing_variable", transformation = "function", inverse_transformation = "function", transformed = "logical", # TRUE -> in transformed state known_transformations = "character" ), prototype( imputation_method = c("ppd", "pmm", "mean", "median", "expectation", "mcar", NA_character_), transformed = TRUE, transformation = .standardize_transform, inverse_transformation = .standardize_transform, family = gaussian(), known_families = c("gaussian", "Gamma", "inverse.gaussian", "binomial"), # binomial() is only for (SC_)proportions known_links = .known_links[.known_links != "sqrt"], known_transformations = c("standardize", "identity", "log", "logshift", "squeeze", "sqrt", "cuberoot", "qnorm") ), validity = function(object) { out <- TRUE im <- getClass(class(object))@prototype@imputation_method kf <- getClass(class(object))@prototype@known_families kl <- getClass(class(object))@prototype@known_links if(!all(object@imputation_method %in% im)) { out <- paste(object@variable_name, ": 'imputation_method' must be one of:\n", paste(im, collapse = ", ")) } else if(sum(object@n_unpossible)) { out <- paste(object@variable_name, ": unpossible observations not supported for continuous variables yet") } else if(!(object@family$family %in% kf)) { out <- paste(object@variable_name, ": the 'family' slot of a object of class 'binary' must be one of", paste(kf, collapse = ", ")) } else if(!(object@family$link %in% kl)) { out <- paste(object@variable_name, ": the 'link' slot of the 'family' slot of a object of class 'binary' must be one of", paste(kl, collapse = ", ")) } return(out) } ) setMethod("initialize", "continuous", def = function(.Object, ...) { .Object <- callNextMethod() l <- length(.Object@raw_data) if(l == 0) return(.Object) if(identical(.Object@transformation, .standardize_transform)) { mean <- mean(.Object@raw_data, na.rm = TRUE) sd <- sd(.Object@raw_data, na.rm = TRUE) formals(.Object@transformation)$mean <- formals(.Object@inverse_transformation)$mean <- mean formals(.Object@transformation)$sd <- formals(.Object@inverse_transformation)$sd <- sd formals(.Object@inverse_transformation)$inverse <- TRUE } else if(identical(.Object@transformation, .logshift)) { y <- .Object@raw_data if(any(y < 0, na.rm = TRUE)) a <- - min(y, na.rm = TRUE) else a <- 0 a <- (a + min(y[y > 0], na.rm = TRUE)) / 2 formals(.Object@transformation)$a <- formals(.Object@inverse_transformation)$a <- a formals(.Object@inverse_transformation)$inverse <- TRUE } .Object@data <- .Object@transformation(.Object@raw_data) .Object@data[.Object@which_miss] <- NA_real_ return(.Object) }) setClass("bounded-continuous", representation("continuous", lower = "numeric", upper = "numeric"), prototype( imputation_method = "ppd", transformation = .identity_transform, inverse_transformation = .identity_transform ), validity = function(object) { out <- TRUE # if(any(object@raw_data <= object@lower, na.rm = TRUE)) { # out <- paste(object@variable_name, ": all observed data must be strictly greater than 'lower'") # } # else if(any(object@raw_data >= object@upper, na.rm = TRUE)) { # out <- paste(object@variable_name, ": all observed data must be strictly less than 'upper'") # } if(any(object@lower > object@upper)) { out <- paste(object@variable_name, ": lower bounds must be less than or equal to upper bounds") } else if(object@imputation_method != "ppd") { out <- paste(object@variable_name, ": 'imputation_method' must be 'ppd' for 'bounded-continuous' variables ") } else if(!requireNamespace("truncnorm")) { out <- paste(object@variable_name, ": the 'truncnorm' package must be installed to use the 'bounded-continuous' class") } return(out) } ) setMethod("initialize", "bounded-continuous", def = function(.Object, lower = -Inf, upper = Inf, ...) { .Object <- callNextMethod() l <- length(.Object@raw_data) if(l == 0) return(.Object) .Object@lower <- lower .Object@upper <- upper return(.Object) }) setClass("positive-continuous", representation("continuous"), prototype( transformation = log, inverse_transformation = exp, known_transformations = c("log", "sqrt", "squeeze", "qnorm") ), validity = function(object) { out <- TRUE if(any(object@raw_data <= 0, na.rm = TRUE)) { out <- paste(object@variable_name, ": positive variables must be positive") } return(out) } ) ## must be on the (0,1) interval setClass("proportion", representation("positive-continuous", link.phi = "WeAreFamily"), prototype( transformed = FALSE, transformation = .identity_transform, inverse_transformation = .identity_transform, known_transformations = c("squeeze", "qnorm"), family = binomial(), known_families = c("binomial", "gaussian"), known_links = .known_links[.known_links != "sqrt"], link.phi = "log"), validity = function(object) { out <- TRUE kf <- getClass(class(object))@prototype@known_families kl <- getClass(class(object))@prototype@known_links if(any(object@raw_data > 1, na.rm = TRUE)) { out <- paste(object@variable_name, ": proportions must be on the unit interval") } else if(any(object@raw_data == 1, na.rm = TRUE)) { out <- paste(object@variable_name, ": some proportions are equal to 1.0 so use the SC_proportion class") } else if(!(object@family$family %in% kf)) { out <- paste(object@variable_name, ": the 'family' slot of a object of class 'proportion' must be one of", paste(kf, collapse = ", ")) } else if(!(object@family$link %in% kl)) { out <- paste(object@variable_name, ": the 'link' slot of the 'family' slot of a object of class 'proportion' must be one of", paste(kl, collapse = ", ")) } else if(object@family$family == "binomial" && !requireNamespace("betareg")) { out <- paste(object@variable_name, ": you must install the 'betareg' package to model proportions as proportions") } return(out) } ) # setClass("truncated-continuous", # representation("continuous", # lower = "ANY", # upper = "ANY", # n_lower = "integer", # which_lower = "integer", # n_upper = "integer", # which_upper = "integer", # n_both = "integer", # which_both = "integer", # n_truncated = "integer", # which_truncated = "integer", # "VIRTUAL") # ) # # setClass("NN_truncated-continuous", representation("truncated-continuous", lower = "numeric", upper = "numeric")) # # setMethod("initialize", "NN_truncated-continuous", def = # function(.Object, ...) { # .Object <- callNextMethod() # l <- length(.Object@raw_data) # if(l == 0) return(.Object) # if(identical(.Object@transformation, .standardize_transform)) { # mean <- mean(.Object@raw_data, na.rm = TRUE) # sd <- sd(.Object@raw_data, na.rm = TRUE) # formals(.Object@transformation)$mean <- formals(.Object@inverse_transformation)$mean <- mean # formals(.Object@transformation)$sd <- formals(.Object@inverse_transformation)$sd <- sd # formals(.Object@inverse_transformation)$inverse <- TRUE # } # .Object@data <- .Object@transformation(.Object@raw_data) # # if(length(.Object@lower) == 0 & length(.Object@upper) == 0) { # stop("at least one of 'lower' and 'upper' must be specified") # } # ## FIXME: Deal with interval censoring or force it to the interval class # .Object@n_both <- 0L # lowers <- .Object@raw_data <= .Object@lower # .Object@n_lower <- sum(lowers) # .Object@which_lower <- which(lowers) # uppers <- .Object@raw_data >= .Object@upper # .Object@n_uppers <- sum(uppers) # .Object@which_uppers <- which(uppers) # .Object@n_truncated <- .Object@n_lower + .Object@n_upper # .Object@which_truncated <- c(.Object@which_lower, .Object@which_upper) # return(.Object) # }) # # setClass("FN_truncated-continuous", representation("truncated-continuous", lower = "function", upper = "numeric")) # setClass("NF_truncated-continuous", representation("truncated-continuous", lower = "numeric", upper = "function")) # setClass("FF_truncated-continuous", representation("truncated-continuous", lower = "function", upper = "function")) # # setClass("censored-continuous", # representation("continuous", # lower = "ANY", # upper = "ANY", # n_lower = "integer", # which_lower = "integer", # n_upper = "integer", # which_upper = "integer", # n_both = "integer", # which_both = "integer", # n_censored = "integer", # which_censored = "integer", # lower_indicator = "binary", # upper_indicator = "binary", # "VIRTUAL") # ) # setClass("NN_censored-continuous", representation("censored-continuous", lower = "numeric", upper = "numeric")) # setMethod("initialize", "NN_censored-continuous", def = # function(.Object, ...) { # .Object <- callNextMethod() # l <- length(.Object@raw_data) # if(l == 0) return(.Object) # if(identical(.Object@transformation, .standardize_transform)) { # mean <- mean(.Object@raw_data, na.rm = TRUE) # sd <- sd(.Object@raw_data, na.rm = TRUE) # formals(.Object@transformation)$mean <- formals(.Object@inverse_transformation)$mean <- mean # formals(.Object@transformation)$sd <- formals(.Object@inverse_transformation)$sd <- sd # formals(.Object@inverse_transformation)$inverse <- TRUE # } # .Object@data <- .Object@transformation(.Object@raw_data) # # if(length(.Object@lower) == 0 & length(.Object@upper) == 0) { # stop("at least one of 'lower' and 'upper' must be specified") # } # ## FIXME: Deal with interval censoring or force it to the interval class # .Object@n_both <- 0L # lowers <- .Object@raw_data <= .Object@lower # .Object@n_lower <- sum(lowers, na.rm = TRUE) # .Object@which_lower <- which(lowers) # if(.Object@n_lower > 0) { # .Object@lower_indicator <- missing_variable(as.ordered(lowers), type = "binary", # variable_name = paste(.Object@variable_name, "lower", sep = "")) # } # uppers <- .Object@raw_data >= .Object@upper # .Object@n_upper <- sum(uppers, na.rm = TRUE) # .Object@which_upper <- which(uppers) # if(.Object@n_upper > 0) { # .Object@lower_indicator <- missing_variable(as.ordered(uppers), type = "binary", # variable_name = paste(.Object@variable_name, "upper", sep = "")) # } # .Object@n_censored <- .Object@n_lower + .Object@n_upper # .Object@which_censored <- c(.Object@which_lower, .Object@which_upper) # return(.Object) # }) # # setClass("FN_censored-continuous", representation("censored-continuous", lower = "function", upper = "numeric")) # setClass("NF_censored-continuous", representation("censored-continuous", lower = "numeric", upper = "function")) # setClass("FF_censored-continuous", representation("censored-continuous", lower = "function", upper = "function")) setClass("semi-continuous", representation("continuous", indicator = "ordered-categorical"), prototype( transformation = .identity_transform, inverse_transformation = .identity_transform) ) .logshift <- function(y, a, inverse = FALSE) { if(inverse) exp(y) - a else log(y + a) } setClass("nonnegative-continuous", representation("semi-continuous"), prototype(transformation = .logshift, inverse_transformation = .logshift, known_transformations = c("logshift", "squeeze", "identity")), validity = function(object) { out <- TRUE if(any(object@raw_data < 0, na.rm = TRUE)) { out <- paste(object@variable_name, ": nonnegative variables must be nonnegative") } return(out) } ) setMethod("initialize", "nonnegative-continuous", def = function(.Object, ...) { .Object <- callNextMethod() l <- length(.Object@raw_data) if(l == 0) return(.Object) is_zero <- as.integer(.Object@raw_data == 0) if(any(is_zero, na.rm = TRUE)) { .Object@indicator <- missing_variable(is_zero, type = "binary", variable_name = paste(.Object@variable_name, ":is_zero", sep = "")) } .Object@data <- .Object@transformation(.Object@raw_data) if(!all(is.finite(.Object@data[!is.na(.Object)]))) { stop(paste(.Object@variable_name, ": some transformed values are infinite or undefined")) } return(.Object) }) .squeeze_transform <- function(y, inverse = FALSE) { n <- length(y) if(inverse) (y * n - .5) / (n - 1) else (y * (n - 1) + .5) / n } ## some values are zero and / or one setClass("SC_proportion", representation("nonnegative-continuous", link.phi = "WeAreFamily"), prototype( transformation = .squeeze_transform, inverse_transformation = .squeeze_transform, known_transformations = c("squeeze", "qnorm"), family = binomial(), known_families = "binomial", known_links = getClass("binary")@prototype@known_links, link.phi = "log" ), validity = function(object) { out <- TRUE if(any(object@data > 1, na.rm = TRUE)) { out <- paste(object@variable_name, ": proportions must be less than or equal to 1") } else if(object@family$family != "binomial") { out <- paste(object@variable_name, ": 'family' must be 'binomial'") } else if(!identical(body(object@transformation), body(.squeeze_transform))) { out <- paste(object@variable_name, ": 'transformation' must be 'squeeze'") } else if(!requireNamespace("betareg")) { out <- paste(object@variable_name, ": you must install the 'betareg' package to model proportions") } return(out) } ) setMethod("initialize", "SC_proportion", def = function(.Object, ...) { .Object <- callNextMethod() l <- length(.Object@raw_data) if(l == 0) return(.Object) if(any(.Object@raw_data == 0, na.rm = TRUE)) { if(any(.Object@raw_data == 1, na.rm = TRUE)) { is_bound <- ifelse(.Object@raw_data == 0, -1, ifelse(.Object@raw_data == 1, 1, 0)) .Object@indicator <- missing_variable(is_bound, type = "ordered-categorical", variable_name = paste(.Object@variable_name, ":is_bound", sep = "")) } else { is_zero <- as.integer(.Object@raw_data == 0) .Object@indicator <- missing_variable(is_zero, type = "binary", variable_name = paste(.Object@variable_name, ":is_zero", sep = "")) } } else { is_one <- as.integer(.Object@raw_data == 1) .Object@indicator <- missing_variable(is_one, type = "binary", variable_name = paste(.Object@variable_name, ":is_one", sep = "")) } return(.Object) }) # A missing_data.frame is a another important S4 class that is not unlike a data.frame, except # that its "columns" (actually list elements) are objects that inherit from the missing_variable # class. The missing_data.frame class should, in principle, contain ALL the necessary information # regarding how the missing_variables relate to each other. Together, the missing_variable class(es) # and the missing_data.frame class supplant the mi.info S4 class in previous versions of library(mi). .get_slot <- function(object, name, simplify = TRUE) { if(isS4(object)) return(slot(object, name)) else if(is.list(object)) sapply(object, FUN = slot, name = name, simplify = simplify) else stop("'object' not supported") } setOldClass("data.frame") setClass("missing_data.frame", representation( variables = "list", # of missing_variables no_missing = "logical", # basically a collection of the all_obs slots of the missing_variables patterns = "factor", # indicates which missingness_pattern an observation belongs to DIM = "integer", # observations x variables DIMNAMES = "list", # list of rownames and colnames postprocess = "function",# makes additional variables from existing variables (interactions, etc.) index = "list", # this indicate which variables to exclude when modeling a given variable X = "MatrixTypeThing", # ALL variables (categorical variables are in dummy-variable form) weights = "list", # this gets passed to bayesglm() and similar modeling functions priors = "list", # the elements of this get passed to bayesglm() and other modeling functions in arm correlations = "matrix", # has SMCs and Spearman correlations done = "logical", # are we done? workpath = "character"), contains = "data.frame", prototype(postprocess = function() stop("postprocess does not work yet"), X = matrix(NA_real_, 0, 0), done = FALSE), validity = function(object) { out <- TRUE l <- length(object@variables) if(l == 0) return(out) if(!all(sapply(object@variables, FUN = is, class2 = "missing_variable"))) { out <- "all of the list elements in 'variables' must inherit from the 'missing_variable' class" } else if(length(unique(.get_slot(object@variables, "n_total"))) > 1) { out <- "all missing_variables must have the same 'n_total'" } else if(!is.numeric(object@X)) { out <- "'X' must be a numeric matrix" } missingness <- .get_slot(object@variables, "which_miss", simplify = FALSE) varnames <- .get_slot(object@variables, "variable_name") names(missingness) <- varnames missingness <- missingness[sapply(missingness, length) > 0] if(length(missingness) > 1) { ## FIXME: Very slow combos <- combn(length(missingness), 2) dupes <- apply(combos, 2, FUN = function(x) { mx1 <- missingness[[x[1]]] mx2 <- missingness[[x[2]]] if(length(mx1) == length(mx2)) { if(identical(mx1, mx2)) return(1L) } else if(length(mx1) > length(mx2)) { if(all(mx2 %in% mx1)) return(2L) } else if(all(mx1 %in% mx2)) return(3L) return(0L) }) if(any(dupes == 1L)) { temp <- matrix(names(missingness)[combos[,which(dupes == 1L)]], ncol = 2, byrow = TRUE) cat("NOTE: The following pairs of variables appear to have the same missingness pattern.\n", "Please verify whether they are in fact logically distinct variables.\n") print(temp) # warning("Potentially duplicated variables detected by duplicated variable detector") } else if(any(dupes == 2L)) { temp <- matrix(names(missingness)[combos[,which(dupes == 2L)]], ncol = 2, byrow = TRUE) cat("NOTE: In the following pairs of variables, the missingness pattern of the second is a subset of the first.\n", "Please verify whether they are in fact logically distinct variables.\n") print(temp) } else if(any(dupes == 3L)) { temp <- matrix(names(missingness)[combos[,which(dupes == 3L)]], ncol = 2, byrow = TRUE) cat("NOTE: In the following pairs of variables, the missingness pattern of the first is a subset of the second.\n", "Please verify whether they are in fact logically distinct variables.\n") print(temp) } } return(out) } ) .set_priors <- function(variables, mu = 0) { ## FIXME: maybe add an option to draw from such a t distribution? foo <- function(y) { out <- list(prior.mean = mu, prior.scale = 2.5, prior.df = 1, prior.mean.for.intercept = mu, prior.scale.for.intercept = 10, prior.df.for.intercept = 1) if(is(y, "irrelevant") | y@all_obs) return(NULL) else if(is(y, "binary")) { if(y@family$link == "probit") { out[[2]] <- out[[2]] * dnorm(0) / dlogis(0) out[[4]] <- out[[4]] * dnorm(0) / dlogis(0) } } else if(is(y, "categorical")) { out <- list(prior.mean = mu, prior.scale = 2.5, prior.df = 1, prior.counts.for.bins = 1/(1 + length(y@levels))) } return(out) } out <- lapply(variables, FUN = function(y) foo(y)) for(i in seq_along(variables)) if(is(y <- variables[[i]], "semi-continuous")) out[[y@indicator@variable_name]] <- foo(y@indicator) return(out) } setMethod("initialize", "missing_data.frame", def = function(.Object, include_missingness = TRUE, skip_correlation_check = FALSE, ...) { .Object <- callNextMethod() l <- length(.Object@variables) if(l == 0) return(.Object) varnames <- names(.Object@variables) if(is.null(varnames)) { if(is.null(.Object@DIMNAMES[[2]])) names(.Object@variables) <- sapply(.Object@variables, FUN = .get_slot, name = "variable_name") else names(.Object@variables) <- .Object@DIMNAMES[[2]] } else for(i in 1:l) .Object@variables[[i]]@variable_name <- varnames[i] .Object@DIM <- c(.Object@variables[[1]]@n_total, l) .Object@no_missing <- sapply(.Object@variables, FUN = .get_slot, name = "all_obs") if(length(.Object@DIMNAMES) == 0) .Object@DIMNAMES <- list(NULL, names(.Object@variables)) Z <- lapply(.Object@variables, FUN = function(y) { if(is(y, "irrelevant")) return(NULL) else return(is.na(y)) }) Z <- as.matrix(as.data.frame(Z[!sapply(Z, is.null)])) if(any(apply(Z, 1, all))) { warning("Some observations are missing on all included variables.\n", "Often, this indicates a more complicated model is needed for this missingness mechanism") } uZ <- unique(Z) if(nrow(uZ) == 1) { if(all(uZ[1,] == 0)) patterns <- factor(rep("nothing", nrow(Z))) else patterns <- factor(colnames(uZ)[which(uZ[1,] == 1)], nrow(Z)) } else { uZ <- uZ[order(rowSums(uZ)),,drop = FALSE] patterns <- apply(Z, 1, FUN = function(x) which(apply(uZ, 1, FUN = function(u) all(u == x)))) pattern_labels <- apply(uZ, 1, FUN = function(x) paste(names(x)[x], collapse = ", ")) if(length(pattern_labels)) { if(pattern_labels[1] == "") pattern_labels[1] <- "nothing" pattern_lables <- paste("missing:", pattern_labels) patterns <- factor(patterns, labels = pattern_labels, ordered = FALSE) } else patterns <- factor(patterns) } .Object@patterns <- patterns if(!length(.Object@workpath)) { .Object@workpath <- file.path(tempdir(), paste("mi", as.integer(Sys.time()), sep = "")) } dir.create(.Object@workpath, showWarnings = FALSE) if(is(.Object, "allcategorical_missing_data.frame")) return(.Object) Z <- Z[,!duplicated(t(Z)), drop = FALSE] Z <- Z[,apply(Z, 2, FUN = function(x) length(unique(x))) > 1, drop = FALSE] ## FIXME: What to do if two columns of Z are collinear? if(ncol(Z) > 0) colnames(Z) <- paste("missing", colnames(Z), sep = "_") else include_missingness <- FALSE X <- lapply(.Object@variables, FUN = function(x) { if(is(x, "irrelevant")) return(NULL) else if(is(x, "categorical")) return(.cat2dummies(x)) else if(is(x, "semi-continuous")) { out <- cbind(x@data, .cat2dummies(x@indicator)) colnames(out) <- c(x@variable_name, paste(x@variable_name, 2:ncol(out) - 1, sep = "_")) return(out) } else if(is(x, "censored-continuous")) { temp <- x@data if(x@n_lower) temp <- cbind(temp, lower = x@lower_indicator@data) if(x@n_upper) temp <- cbind(temp, upper = x@upper_indicator@data) if(x@n_both) stop("FIXME: censoring on both sides not supported yet") return(temp) } else if(is(x, "truncated-continuous")) { temp <- x@data n <- length(temp) if(x@n_lower) temp <- cbind(lower = x@lower_indicator@data, temp) if(x@n_upper) temp <- cbind(upper = x@upper_indicator@data, temp) if(x@n_both) stop("FIXME: censoring on both sides not supported yet") return(temp) } else return(x@data) }) ## NOTE: Might need to make this more complicated in the future X <- X[!sapply(X, is.null)] index <- vector("list", length = length(X)) names(index) <- names(X) start <- 2L end <- 0L for(i in seq_along(index)) { end <- start + NCOL(X[[i]]) - 1L index[[i]] <- start:end start <- end + 1L } if(include_missingness) for(i in seq_along(index)) { nas <- is.na(.Object@variables[[i]]) check <- apply(Z, 2, FUN = function(x) all(x == nas)) index[[i]] <- c(index[[i]], which(check) + start - 1) } else for(i in seq_along(index)) index[[i]] <- c(index[[i]], start:(start + ncol(Z) - 1)) grouped <- names(which(sapply(.Object@variables, is, class2 = "grouped-binary"))) for(i in grouped) index[[i]] <- c(index[[i]], index[[.Object@variables[[i]]@strata]], 1) .Object@index <- index .Object@X <- cbind("(Intercept)" = 1, as.matrix(as.data.frame(X)), Z) correlations <- matrix(NA_real_, l,l) if(!skip_correlation_check) for(i in 1:(l - 1)) { ## FIXME: Put SMCs in the lower triangle if(is(.Object@variables[[i]], "irrelevant")) next x <- try(rank(xtfrm(.Object@variables[[i]]@raw_data)), silent = TRUE) if(!is.numeric(x)) next for(j in (i + 1):l) { if(is(.Object@variables[[j]], "irrelevant")) next y <- try(rank(xtfrm(.Object@variables[[j]]@raw_data))) if(!is.numeric(y)) next rho <- cor(x, y, use = "pair", method = "pearson") # on ranks if(is.finite(rho) && abs(rho) == 1) { warning(paste(names(.Object@variables)[i], "and", names(.Object@variables)[j], "have the same rank ordering.\n", "Please verify whether they are in fact distinct variables.\n")) } if(is.finite(rho)) correlations[i,j] <- rho } } .Object@correlations <- correlations .Object@priors <- .set_priors(.Object@variables) .Object }) setClass("allcategorical_missing_data.frame", representation("missing_data.frame", "Hstar" = "integer", "parameters" = "list","latents" = "unordered-categorical"), prototype = prototype(Hstar = 20L), validity = function(object) { out <- TRUE types <- sapply(object@variables, FUN = function(y) is(y, "irrelevant") | is(y, "categorical")) if(!all(types)) { out <- "all variable classes must be 'irrelevant' or 'categorical'" } else if(length(object@Hstar) && object@Hstar < 1) { out <- "'Hstar' must be >= 1" } return(out) }) setMethod("initialize", "allcategorical_missing_data.frame", def = function(.Object, include_missingness = TRUE, ...) { .Object <- callNextMethod() l <- length(.Object@variables) n <- nrow(.Object) uc <- factor(rep(NA_integer_, n)) .Object@latents <- new("unordered-categorical", raw_data = rep(NA_integer_, n)) .Object@priors <- list(a = rep(1, ncol(.Object)), a_alpha = 1, b_alpha = 1) names(.Object@priors$a) <- colnames(.Object) return(.Object) }) setClass("experiment_missing_data.frame", representation("missing_data.frame", concept = "factor", case = "character"), validity = function(object) { out <- TRUE l <- length(object@concept) if(l != length(object@variables)) { out <- "length of 'concept' must equal the number of variables" } else if(!all(levels(object@concept) %in% c("outcome", "covariate", "treatment"))) { out <- "all elements of 'concept' must be exactly one of 'outcome', 'covariate', or 'treatment'" } else if(sum(object@concept == "treatment") != 1) { out <- "there must be exactly one variable designated 'treatment'" } else if(!is(object@variables[[which(object@concept == "treatment")]], "binary")) { out <- "the 'treatment' variable must be of class 'binary'" } else if(object@variables[[which(object@concept == "treatment")]]@n_miss) { out <- "'treatment' variable cannot have any missingness" } else if(length(object@case) > 1) { out <- "'case' must be exactly one of 'outcomes', 'covariates', or 'both'" } else if(length(object@case) && !(object@case %in% c("outcomes", "covariates", "both"))) { out <- "'case' must be exactly one of 'outcomes', 'covariates', or 'both'" } return(out) }) setMethod("initialize", "experiment_missing_data.frame", def = function(.Object, include_missingness = TRUE, ...) { .Object <- callNextMethod() l <- 1 ## FIXME if(l == 0) return(.Object) names(.Object@concept) <- .Object@DIMNAMES[[2]] outcomes <- any(!.Object@no_missing[.Object@concept == "outcomes"]) covariates <- any(!.Object@no_missing[.Object@concept == "covariates"]) .Object@case <- if(outcomes & covariates) "both" else if(outcomes) "covariates" else "outcomes" return(.Object) }) .empty_mdf_list <- list() class(.empty_mdf_list) <- "mdf_list" setClass("multilevel_missing_data.frame", representation("missing_data.frame", groups = "character", mdf_list = "mdf_list"), prototype( mdf_list = .empty_mdf_list ), validity = function(object) { out <- TRUE return(out) } ) setMethod("initialize", "multilevel_missing_data.frame", def = function(.Object, include_missingness = TRUE, ...) { .Object <- callNextMethod() classes <- sapply(.Object@variables, class) for(i in .Object@groups) classes[names(classes) == i] <- "fixed" df <- complete(.Object, m = 0L) mdf_list <- missing_data.frame(df, by = .Object@groups, types = classes) .Object@mdf_list <- mdf_list return(.Object) }) ## an object of class mi merely holds the results of a call to mi(), primary the list of missing_data.frames setClass("mi", representation( call = "call", data = "list", # of missing_data.frames total_iters = "integer"), # how many iterations were conducted (can be a vector) ) ## an object of class pooled has regression results using the Rubin rules setClass("pooled", representation( formula = "formula", fit = "character", models = "list", coefficients = "numeric", ses = "numeric", pooled_summary = "ANY", call = "language"), ) mi/R/zzz.R0000644000175000017500000000344712513634171012205 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. .onLoad <- function(lib, pkg) { # library.dynam("mi", pkg, lib) return(invisible(NULL)) } .onUnload <- function(libpath) { # library.dynam.unload("mi", libpath) return(invisible(NULL)) } .onAttach <- function( ... ) { miLib <- dirname(system.file(package = "mi")) version <- utils::packageDescription("mi", lib.loc = miLib)$Version builddate <- utils::packageDescription("mi", lib.loc = miLib)$Packaged packageStartupMessage(paste("mi (Version ", version, ", packaged: ", builddate, ")", sep = "")) packageStartupMessage("mi Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University") packageStartupMessage("This program comes with ABSOLUTELY NO WARRANTY.") packageStartupMessage("This is free software, and you are welcome to redistribute it") packageStartupMessage("under the General Public License version 2 or later.") packageStartupMessage("Execute RShowDoc('COPYING') for details.") } mi/R/missing_data.frame.R0000644000175000017500000001636012513634171015101 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. setMethod("missing_data.frame", signature(y = "data.frame"), def = function(y, subclass = NA_character_, by = NULL, types = NULL, favor_ordered = TRUE, favor_positive = FALSE, threshold = 5, ...) { if(!is.na(subclass) && subclass == "allcategorical") threshold <- Inf if(!is.null(by)) { mdfs <- by(y, lapply(by, FUN = function(b) y[,b]), FUN = function(d) { missing_data.frame(d, favor_ordered = favor_ordered, threshold = threshold, favor_positive = favor_positive, subclass = subclass, types = types, ...) }) class(mdfs) <- "mdf_list" return(mdfs) } variables <- vector("list", length = ncol(y)) if(is.null(types)) for(i in seq_along(variables)) { variables[[i]] <- missing_variable(y[,i], favor_ordered = favor_ordered, favor_positive = favor_positive, variable_name = colnames(y)[i], threshold = threshold) } else for(i in seq_along(variables)) { variables[[i]] <- new(types[i], variable_name = colnames(y)[i], raw_data = y[,i]) } if(is.na(subclass)) new("missing_data.frame", variables = variables, DIMNAMES = dimnames(y), ...) else new(paste(subclass, "missing_data.frame", sep = "_"), variables = variables, DIMNAMES = dimnames(y), ...) } ) setMethod("missing_data.frame", signature(y = "matrix"), def = function(y, ...) { return(missing_data.frame(y = as.data.frame(y), ...)) } ) setMethod("missing_data.frame", signature(y = "list"), def = function(y, ...) { if(!all(sapply(y, is, class2 = "missing_variable"))) { stop("all list elements must inherit from the 'missing_variable' class") } return(new("missing_data.frame", variables = y)) } ) setAs(from = "data.frame", to = "missing_data.frame", def = function(from) { missing_data.frame(from) } ) setAs(from = "matrix", to = "missing_data.frame", def = function(from) { missing_data.frame(as.data.frame(from)) } ) setAs(from = "missing_data.frame", to = "data.frame", def = function(from) { return(complete(from, m = 0L)) } ) setAs(from = "missing_data.frame", to = "matrix", def = function(from) { return(complete(from, m = 0L, to_matrix = TRUE)) } ) ## FIXME: Probably need to add a boatload of methods to mimic the behavior of data.frames .default_model <- function(y, data) { if(is(data, "allcategorical_missing_data.frame")) return("Gibbs") if(y@all_obs) { if(is(y, "semi-continuous")) return(rep(NA_character_, 2)) else return(NA_character_) } if(is(y, "irrelevant")) return(NA_character_) if(y@imputation_method == "mcar") return(NA_character_) if(!is.method_in_mi("fit_model", y = class(y), data = class(data))) { if(is(y, "semi-continuous")) return(rep("user-defined", 2)) else return("user-defined") } fam <- y@family$family link <- y@family$link if(is(y, "count")) { if(fam == "quasipoisson" && link == "log") return("qpoisson") else if(fam == "poisson" && link == "log") return("poisson") else return("****") } else if(is(y, "binary")) { if(is(y, "grouped-binary")) return("clogit") if(fam == "quasibinomial") return(paste("q", link, sep = "")) else if(fam == "binomial") return(link) else return("****") } else if(is(y, "interval")) return("survreg") else if(is(y, "ordered-categorical")) return(paste("o", link, sep = "")) else if(is(y, "unordered-categorical")) { if(fam == "binomial") out <- "RN" else out <- "m" return(paste(out, link, sep = "")) } else if(is(y, "proportion")) return(if(fam == "gaussian") "linear" else "betareg") else if(is(y, "SC_proportion")) { out <- .default_model(y@indicator, data) return(c("betareg", out)) } else if(is(y, "semi-continuous")) { out <- .default_model(y@indicator, data) if(fam == "gaussian") { if(link == "identity") return(c("linear", out)) else if(link == "log") return(c("loglinear", out)) else if(link == "inverse") return(c("inverselinear", out)) else return(c("****", out)) } else if(fam == "Gamma") return(c("****", out)) else if(fam == "inverse.gaussian") return(c("****", out)) else if(fam == "quasi") return(c("quasi", out)) else return(c("****", out)) } else if(is(y, "continuous")) { if(fam == "gaussian") { if(link == "identity") return("linear") else if(link == "log") return("loglinear") else if(link == "inverse") return("inverselinear") else return("****") } else if(fam == "Gamma") return("****") else if(fam == "inverse.gaussian") return("****") else if(fam == "quasi") return("quasi") else return("****") } else return("user-defined") } setMethod("show", "missing_data.frame", def = function(object) { k <- object@DIM[2] df <- .show_helper(object@variables[[1]]) for(i in 2:k) { df <- rbind(df, .show_helper(object@variables[[i]])) } df1 <- cbind(df[,1:3], model = unlist(sapply(object@variables, FUN = function(y) .default_model(y, object)))) if(is(object, "experiment_missing_data.frame")) df1$concept[names(object@concept)] <- object@concept df2 <- df[,-c(1:3)] cat("Object of class", class(object), "with", nrow(object), "observations on", ncol(object), "variables\n") if(length(object@patterns)) { npatterns <- nlevels(object@patterns) cat("\nThere are", npatterns, "missing data patterns\n") # print(table(as.integer(object@patterns))) # mat <- as.matrix(levels(object@patterns)) # colnames(mat) <- "missing" # print(mat) cat("\nAppend '@patterns' to this", class(object), "to access the corresponding pattern for every observation or perhaps use table()\n\n") } print(df1) cat("\n") print(df2) if(any(df1$model == "****", na.rm = TRUE)) { cat("\n**** The model lacks a widely-recognized name but is determined by the chosen type, family, and link.\n") } return(invisible(NULL)) }) setMethod("show", "mdf_list", def = function(object) { for(i in seq_along(object)) { cat("\n", names(object)[i], "\n") show(object[[i]]) } return(invisible(NULL)) }) setMethod("summary", "missing_data.frame", def = function(object) { summary(as.data.frame(object)) }) mi/R/plot_methods.R0000644000175000017500000005062212513634171014046 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # Copyright (C) 2011 Douglas Bates and Martin Maechler # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. setMethod("image", "dgTMatrix", # slight hack of a method in the library(Matrix) function(x, xlim = .5 + c(0, di[2]), ylim = .5 + c(di[1], 0), aspect = "iso", ## was default "fill" sub = sprintf("Dimensions: %d x %d", di[1], di[2]), xlab = "Column", ylab = "Row", cuts = 15, useAbs = NULL, colorkey = !useAbs, col.regions = NULL, lwd = NULL, ...) { di <- x@Dim xx <- x@x if(missing(useAbs)) ## use abs() when all values are non-neg useAbs <- min(xx, na.rm=TRUE) >= 0 else if(useAbs) xx <- abs(xx) rx <- range(xx, finite=TRUE) if(is.null(col.regions)) col.regions <- if(useAbs) { grey(seq(from = 0.7, to = 0, length = 100)) } else { ## no abs(.), rx[1] < 0 nn <- 100 n0 <- min(nn, max(0, round((0 - rx[1])/(rx[2]-rx[1]) * nn))) col.regions <- c(colorRampPalette(c("blue3", "gray80"))(n0), colorRampPalette(c("gray75","red3"))(nn - n0)) } if(!is.null(lwd) && !(is.numeric(lwd) && all(lwd >= 0))) # allow lwd=0 stop("'lwd' must be NULL or non-negative numeric") lattice::levelplot(x@x ~ (x@j + 1L) * (x@i + 1L), sub = sub, xlab = xlab, ylab = ylab, xlim = xlim, ylim = ylim, aspect = aspect, colorkey = colorkey, col.regions = col.regions, cuts = cuts, # par.settings = list(background = list(col = "transparent")), panel = function(x, y, z, subscripts, at, ..., col.regions) { x <- as.numeric(x[subscripts]) y <- as.numeric(y[subscripts]) numcol <- length(at) - 1 num.r <- length(col.regions) col.regions <- if (num.r <= numcol) rep(col.regions, length = numcol) else col.regions[1+ ((1:numcol-1)*(num.r-1)) %/% (numcol-1)] zcol <- rep.int(NA_integer_, length(z)) for (i in seq_along(col.regions)) zcol[!is.na(x) & !is.na(y) & !is.na(z) & at[i] <= z & z < at[i+1]] <- i zcol <- zcol[subscripts] if (any(subscripts)) { if(is.null(lwd)) { wh <- grid::current.viewport()[c("width", "height")] ## wh : current viewport dimension in pixel wh <- c(grid::convertWidth(wh$width, "inches", valueOnly=TRUE), grid::convertHeight(wh$height, "inches", valueOnly=TRUE)) * par("cra") / par("cin") pSize <- wh/di ## size of one matrix-entry in pixels pA <- prod(pSize) # the "area" p1 <- min(pSize) lwd <- ## crude for now if(p1 < 2 || pA < 6) 0.01 # effectively 0 else if(p1 >= 4) 1 else if(p1 > 3) 0.5 else 0.2 } else stopifnot(is.numeric(lwd), all(lwd >= 0)) # allow 0 grid::grid.rect(x = x, y = y, width = 1, height = 1, default.units = "native", gp = grid::gpar(fill = ifelse(is.na(zcol), "black", col.regions[zcol]), lwd = lwd, col = if(lwd < .01) NA else NA)) } }, ...) }) setMethod("image", signature(x = "missing_data.frame"), def = function (x, y.order = FALSE, x.order = FALSE, clustered = TRUE, grayscale = FALSE, ...) { data <- lapply(x@variables, FUN = function(z) if(is(z, "irrelevant")) NULL else is.na(z) * 1) data <- as.matrix(as.data.frame(data[!sapply(data, is.null)])) index <- seq(nrow(data)) x.at <- 1:nrow( data ) x.lab <- index if( x.order ) { orderIndex <- order(colSums(data), decreasing = TRUE) sub <- "Ordered by number of missing items per variable" } if( y.order ) { orderIndex <- order(rowSums(data), decreasing = FALSE) index <- row.names( data ) sub <- "Ordered by number of missing items per observation" x.at <- NULL x.lab <- FALSE } if(clustered){ orderIndex <- order.dendrogram(as.dendrogram(hclust(dist(data, method = "binary"), method="mcquitty"))) sub <- "Clustered by missingness" } if(!grayscale) { data <- lapply(x@variables, FUN = function(z) { y <- z@data if(is(z, "irrelevant")) return(NULL) else if(is(z, "continuous")) return( (y - mean(y, na.rm = TRUE)) / (2 * sd(y, na.rm = TRUE)) ) else if(is(z, "count")) return( (y - mean(y, na.rm = TRUE)) / (2 * sd(y, na.rm = TRUE)) ) else if(is(z, "categorical")) { y <- z@data if(is(z, "binary")) { y <- y == max(y, na.rm = TRUE) return( (y - 0.5) * 2 ) } else { the_range <- seq(from = -.99, to = 1, length.out = length(unique(na.omit(y)))) return(the_range[as.integer(as.factor(y))]) } } else return( (y - mean(y, na.rm = TRUE)) / (2 * sd(y, na.rm = TRUE)) ) }) data <- as.matrix(as.data.frame(data[!sapply(data, is.null)])) } if(y.order) X <- Matrix(data[,orderIndex]) else X <- Matrix(data[orderIndex,]) if(grayscale) { plot(image(X, aspect = "fill", xlab = "Standardized Variable", ylab = "Observation Number", sub = sub, scales = list(x = list(at = 1:ncol(data), labels = colnames(data), rot = 90, abbreviate = TRUE, minlength = 8)), main = "Dark represents missing data", colorkey = FALSE, alpha.regions = 1, ...)) return(invisible(NULL)) } nn <- 100 rx <- range(X, finite = TRUE) n0 <- min(nn, max(0, round((0 - rx[1])/(rx[2]-rx[1]) * nn))) col.regions <- heat.colors(17) breaks <- seq(from = rx[1] - 1e-8, to = rx[2] + 1e-8, length.out = 16) plot(image(X, aspect = "fill", xlab = "Standardized Variable", ylab = "Observation Number", sub = sub, at = breaks, scales = list(x = list(at = 1:ncol(data), labels = colnames(data), rot = 90, abbreviate = TRUE, minlength = 8)), main = "Dark represents missing data", colorkey = TRUE, col.regions = col.regions, alpha.regions = 1, ...)) return(invisible(NULL)) }) setMethod("image", signature(x = "mdf_list"), def = function (x, y.order = FALSE, x.order = FALSE, clustered = TRUE, grayscale = FALSE, ask = TRUE, ...) { if (.Device != "null device") { oldask <- grDevices::devAskNewPage(ask = ask) if (!oldask) on.exit(grDevices::devAskNewPage(oldask), add = TRUE) op <- options(device.ask.default = ask) on.exit(options(op), add = TRUE) } sapply(x, FUN = image, y.order = y.order, x.order = x.order, clustered = clustered, grayscale = grayscale, ...) return(invisible(NULL)) }) setMethod("image", signature(x = "mi"), def = function (x, y.order = FALSE, x.order = FALSE, clustered = TRUE, ...) { data <- lapply(x@data[[1]]@variables, FUN = function(z) if(is(z, "irrelevant")) NULL else is.na(z) * 1) data <- as.matrix(as.data.frame(data[!sapply(data, is.null)])) if( x.order ) { orderIndex <- order(colSums(data), decreasing = TRUE) sub <- "Ordered by number of missing items per variable" } if( y.order ) { orderIndex <- order(rowSums(data), decreasing = FALSE) index <- row.names( data ) sub <- "Ordered by number of missing items per observation" } if(clustered){ orderIndex <- order.dendrogram(as.dendrogram(hclust(dist(data, method = "binary"), method="mcquitty"))) sub <- "Clustered by missingness" } foo <- function(z, raw = FALSE) { y <- if(raw) z@raw_data else z@data # y <- z@data if(is(z, "irrelevant")) return(NULL) else if(is(z, "continuous")) return( (y - mean(y, na.rm = TRUE)) / (2 * sd(y, na.rm = TRUE)) ) else if(is(z, "count")) return( (y - mean(y, na.rm = TRUE)) / (2 * sd(y, na.rm = TRUE)) ) else if(is(z, "categorical")) { y <- if(raw) as.numeric(z@raw_data) else z@data if(is(z, "binary")) { y <- y == max(y, na.rm = TRUE) return( (y - 0.5) * 2 ) } else { the_range <- seq(from = -.99, to = 1, length.out = length(unique(na.omit(y)))) return(the_range[as.integer(as.factor(y))]) } } else return( (y - mean(y, na.rm = TRUE)) / (2 * sd(y, na.rm = TRUE)) ) } temp <- lapply(x@data[[1]]@variables, FUN = foo) temp <- as.matrix(as.data.frame(temp[!sapply(temp, is.null)])) temp[data == 1] <- NA_real_ data <- temp if(y.order) data <- data[,orderIndex] else data <- data[orderIndex,] X0 <- Matrix(data) data <- 0 chains <- min(3, length(x@data)) for(i in seq_along(x@data)) { temp <- lapply(x@data[[i]]@variables, FUN = foo, raw = FALSE) temp <- as.matrix(as.data.frame(temp[!sapply(temp, is.null)])) data <- data + temp / chains } if(y.order) data <- data[,orderIndex] else data <- data[orderIndex,] X1 <- Matrix(data) X <- rbind2(X0, X1) breaks <- seq(from = min(X, na.rm = TRUE), to = max(X, na.rm = TRUE), length.out = 15) plot(image(X0, aspect = "fill", xlab = "", ylab = "Observation Number", sub = "", at = breaks, scales = list(x = list(at = 1:ncol(data), labels = colnames(data), rot = 90, abbreviate = TRUE, minlength = 5)), main = "Original data", colorkey = TRUE, col.regions = heat.colors(17), ...), split = c(1,1,1,2)) plot(image(X1, aspect = "fill", xlab = "", ylab = "Observation Number", sub = "", at = breaks, scales = list(x = list(at = 1:ncol(data), labels = colnames(data), rot = 90, abbreviate = TRUE, minlength = 5)), main = "Average completed data", colorkey = TRUE, col.regions = heat.colors(17), ...), newpage = FALSE, split = c(1,2,1,2)) return(invisible(NULL)) }) setMethod("image", signature(x = "mi_list"), def = function (x, y.order = FALSE, x.order = FALSE, clustered = TRUE, grayscale = FALSE, ask = TRUE, ...) { if (.Device != "null device") { oldask <- grDevices::devAskNewPage(ask = ask) if (!oldask) on.exit(grDevices::devAskNewPage(oldask), add = TRUE) op <- options(device.ask.default = ask) on.exit(options(op), add = TRUE) } sapply(x, FUN = image, y.order = y.order, x.order = x.order, clustered = clustered, grayscale = grayscale, ...) return(invisible(NULL)) }) .binnedplot <- function (x, y, nclass = NULL, xlab = "Expected Values", ylab = "Average residual", main = "", cex.pts = 0.8, col.pts = "blue", col.int = "gray") { n <- length(x) if (is.null(nclass)) { if (n >= 100) { nclass = floor(sqrt(length(x))) } if (n > 10 & n < 100) { nclass = 10 } if (n <= 10) { nclass = floor(n/2) } } aa <- data.frame(arm::binned.resids(x, y, nclass)$binned) # aa <- aa[!is.na(aa$X2se),] ## FIXME: remove once Yu-Sung fixes arm::binned.resids plot(range(aa$xbar), range(aa$ybar, aa$X2se, -aa$X2se), xlab = xlab, ylab = ylab, type = "n", main = main, mgp = c(2, 1, 0), tcl = .05) abline(0, 0, lty = 2) lines(aa$xbar, aa$X2se, col = col.int) lines(aa$xbar, -aa$X2se, col = col.int) points(aa$xbar, aa$ybar, pch = 19, cex = cex.pts, col = col.pts) } .binnedpoints <- function (x, y, nclass = NULL, cex.pts = 0.8, col.pts = "red") { n <- length(x) if (is.null(nclass)) { if (n >= 100) { nclass = floor(sqrt(length(x))) } if (n > 10 & n < 100) { nclass = 10 } if (n <= 10) { nclass = floor(n/2) } } if(n > 5) { aa <- data.frame(arm::binned.resids(x, y, nclass)$binned) points(aa$xbar, aa$ybar, pch = 19, cex = cex.pts, col = col.pts) } return(invisible(NULL)) } setMethod("plot", signature(x = "missing_data.frame", y = "missing_variable"), def = function(x, y, ...) { NAs <- is.na(y@raw_data) z <- y@data hist(y) yhat <- y@fitted the_range <- range(c(yhat, z)) plot(the_range, the_range, type = "n", xlab = "Expected Values", ylab = "Completed", mgp = c(2, 1, 0), tcl = .05) abline(0, 1, lty = 2, col = "lightgray") points(yhat, z, col = ifelse(NAs, "red", "blue"), pch = ".", cex = 2) lines(lowess(x = yhat[!NAs], y = z[!NAs]), col = "blue") .binnedplot(yhat[!NAs], (y@data - yhat)[!NAs]) .binnedpoints(yhat[NAs], (y@data - yhat)[NAs]) return(invisible(NULL)) }) setMethod("plot", signature(x = "missing_data.frame", y = "categorical"), def = function(x, y, ...) { NAs <- is.na(y@raw_data) z <- y@data hist(y) s <- nrow(y@parameters) + 1 yhat <- y@fitted if(length(yhat) == 0) { # embedded varname <- y@variable_name varname <- strsplit(varname, ":")[[1]][1] to_drop <- x@index[[varname]] X <- x@X[,-to_drop] s <- nrow(y@parameters) + 1 model <- fit_model(y, data = x, s = s, warn = TRUE, X = X) yhat <- fitted(model) } if(is.matrix(yhat)) yhat <- yhat %*% (1:ncol(yhat)) the_range <- range(c(yhat, z)) #+ c(-.1, .1) plot(the_range, the_range, type = "n", xlab = "Expected Values", ylab = "Completed (jittered)", mgp = c(2, 1, 0), tcl = .05) abline(0, 1, lty = 2, col = "lightgray") points(yhat, jitter(z), col = ifelse(NAs, "red", "blue"), pch = ".", cex = 2) .binnedplot(yhat[!NAs], (y@data - yhat)[!NAs]) .binnedpoints(yhat[NAs], (y@data - yhat)[NAs]) return(invisible(NULL)) }) setMethod("plot", signature(x = "missing_data.frame", y = "binary"), def = function(x, y, ...) { NAs <- is.na(y@raw_data) z <- y@data - 1L hist(y) s <- nrow(y@parameters) + 1 yhat <- y@fitted if(length(yhat) == 0) { # embedded varname <- y@variable_name varname <- strsplit(varname, ":")[[1]][1] to_drop <- x@index[[varname]] X <- x@X[,-to_drop] model <- fit_model(y = y, data = x, s = s, warn = TRUE, X = X) yhat <- fitted(model) } the_range <- range(c(yhat, z)) #+ c(-.1, .1) plot(the_range, the_range, type = "n", xlab = "Expected Values", ylab = "Completed (jittered)", mgp = c(2, 1, 0), tcl = .05) abline(0, 1, lty = 2, col = "lightgray") points(yhat, jitter(z), col = ifelse(NAs, "red", "blue"), pch = ".", cex = 2) .binnedplot(yhat[!NAs], (y@data - 1 - yhat)[!NAs]) .binnedpoints(yhat[NAs], (y@data - 1 - yhat)[NAs]) return(invisible(NULL)) }) setMethod("plot", signature(x = "allcategorical_missing_data.frame", y = "categorical"), def = function(x, y, ...) { NAs <- is.na(y@raw_data) z <- y@raw_data hist(y) latents <- x@latents@data yhat <- t(sapply(latents[!NAs], FUN = function(l) y@fitted[l,])) tab_obs <- table(z[!NAs]) tab_model <- table(apply(yhat, 1, FUN = function(p) which(rmultinom(1, 1, p) == 1))) the_range <- c(0, max(c(tab_obs, tab_model))) barplot(tab_obs, beside = TRUE, xlab = "Observed Values", ylim = the_range) names(tab_model) <- levels(z) barplot(tab_model, beside = TRUE, xlab = "Expected Values", ylim = the_range) return(invisible(NULL)) }) setMethod("plot", signature(x = "allcategorical_missing_data.frame", y = "binary"), def = function(x, y, ...) { NAs <- is.na(y@raw_data) z <- y@raw_data hist(y) latents <- x@latents@data yhat <- t(sapply(latents[!NAs], FUN = function(l) y@fitted[l,])) tab_obs <- table(z[!NAs]) tab_model <- table(apply(yhat, 1, FUN = function(p) which(rmultinom(1, 1, p) == 1))) the_range <- c(0, max(c(tab_obs, tab_model))) barplot(tab_obs, beside = TRUE, xlab = "Observed Values", ylim = the_range) names(tab_model) <- levels(z) barplot(tab_model, beside = TRUE, xlab = "Expected Values", ylim = the_range) return(invisible(NULL)) }) setMethod("plot", signature(x = "missing_data.frame", y = "semi-continuous"), def = function(x, y, ...) { NAs <- is.na(y@raw_data) z <- y@data hist(y) s <- nrow(y@parameters) + 1 yhat <- z yhat[complete(y@indicator, m = 0L, to_factor = TRUE) == 0] <- y@fitted #fitted(model) the_range <- range(c(yhat, z)) plot(the_range, the_range, type = "n", xlab = "Expected Values", ylab = "Completed", mgp = c(2, 1, 0), tcl = .05) abline(0, 1, lty = 2, col = "lightgray") points(yhat, z, col = ifelse(NAs, "red", "blue"), pch = ".", cex = 2) lines(lowess(x = yhat[!NAs], y = z[!NAs]), col = "blue") .binnedplot(yhat[!NAs], (y@data - yhat)[!NAs]) .binnedpoints(yhat[NAs], (y@data - yhat)[NAs]) return(invisible(NULL)) }) setMethod("plot", signature(x = "mi", y = "ANY"), def = function(x, y, ask = TRUE, header = character(0), ...) { if(missing(y)) select <- 1:ncol(x@data[[1]]) else if(is.logical(y)) select <- which(y) else if(is.character(y)) select <- which(colnames(x@data[[1]]) %in% y) else if(is.numeric(y)) select <- which(1:nrow(x@data[[1]]) %in% y) for(i in seq_along(x@data[[1]]@variables)) { if(x@data[[1]]@no_missing[i]) next else if(is(x@data[[1]]@variables[[i]], "irrelevant")) next else if(x@data[[1]]@variables[[i]]@imputation_method == "mcar") { warning(x@data[[1]]@variables[[i]]@variable_name, " not plotted because it assumes MCAR") next } if(!(i %in% select)) next l <- min(3, length(x@data)) if (.Device != "null device") { oldask <- grDevices::devAskNewPage(ask = ask) if (!oldask) on.exit(grDevices::devAskNewPage(oldask), add = TRUE) op <- options(device.ask.default = ask) on.exit(options(op), add = TRUE) } par(mfrow = c(l,3), mar = c(5,4,1,1) + .1) if(is(x@data[[1]]@variables[[i]], "semi-continuous")) { for(j in 1:l) plot(x@data[[j]], x@data[[j]]@variables[[i]]@indicator, ...) title(main = paste("\n", header, x@data[[1]]@variables[[i]]@indicator@variable_name, sep = ""), outer = TRUE) } for(j in 1:l) plot(x@data[[j]], x@data[[j]]@variables[[i]], ...) new_header <- paste(header, x@data[[1]]@variables[[i]]@variable_name) if(is(x@data[[1]]@variables[[i]], "continuous")) { trans <- .show_helper(x@data[[1]]@variables[[i]])$transformation[1] new_header <- paste("\n", new_header, " (", trans, ")", sep = "") } else new_header <- paste("\n", new_header, sep = "") title(main = new_header, outer = TRUE) } return(invisible(NULL)) }) setMethod("plot", signature(x = "mi_list", y = "ANY"), def = function(x, y, ask = TRUE, ...) { if(missing(y)) for(i in seq_along(x)) plot(x[[i]], ask = ask, header = paste(names(x)[i], ": ", sep = ""), ...) else for(i in seq_along(x)) plot(x[[i]], y = y, ask = ask, header = paste(names(x)[i], ": ", sep = ""), ...) return(invisible(NULL)) }) mi/R/change_imputation_method.R0000644000175000017500000000601412513634171016377 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## these change the imputation method setMethod("change_imputation_method", signature(data = "missing", y = "missing_variable", to = "character"), def = function(y, to) { to <- match.arg(tolower(to) , getClass(class(y))@prototype@imputation_method) y@imputation_method <- to validObject(y, complete = TRUE) return(y) }) setMethod("change_imputation_method", signature(data = "missing", y = "missing_variable", to = "missing"), def = function(y, to) { cat("Possible methods include:", getClass(class(y))@prototype@imputation_method, sep = "\n") return(invisible(NULL)) }) setMethod("change_imputation_method", signature(data = "missing_data.frame", y = "character", to = "character"), def = function(data, y, to) { if(all(y %in% c("missing_variable", names(getClass("missing_variable")@subclasses)))) { mark <- sapply(colnames(data), FUN = function(x) { if(data@variables[[x]]@all_obs) return(FALSE) is(data@variables[[x]], y) }) if(!any(mark)) stop(paste("no variables with missingness have class", y)) else y <- names(mark)[mark] } y <- match.arg(y, colnames(data), several.ok = TRUE) if(length(to) == 1) to <- rep(to, length(y)) else if(length(to) != length(y)) stop("'y' and 'to' must have the same length") for(i in 1:length(y)) { data@variables[[y[i]]] <- change_imputation_method(y = data@variables[[y[i]]], to = to[i]) } return(data) }) setMethod("change_imputation_method", signature(data = "missing_data.frame", y = "numeric", to = "character"), def = function(data, y, to) { if(length(to) == 1) to <- rep(to, length(y)) else if(length(to) != length(y)) stop("'y' and 'to' must have the same length") for(i in 1:length(y)) { data@variables[[y]] <- change_imputation_method(y = data@variables[[y]], to = to[i]) } return(data) }) setMethod("change_imputation_method", signature(data = "missing_data.frame", y = "logical", to = "character"), def = function(data, y, to) { if(length(y) != data@DIM[2]) { stop("the length of 'y' must equal the number of variables in 'data'") } return(change_imputation_method(data, which(y), to)) }) mi/R/misc.R0000644000175000017500000002734412513637413012307 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## like sapply but for objects of mi class mipply <- ## FIXME: should probably be a generic function instead of poor man's S4 function(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE, columnwise = TRUE, to.matrix = FALSE) { if(is(X, "mi_list")) { out <- lapply(X, mipply, ..., simplify = simplify, USE.NAMES = USE.NAMES, columnwise = columnwise, to.matrix = to.matrix) } else if(is(X, "mi")) { X <- complete(X, to_matrix = to.matrix) if(columnwise) out <- sapply(X, FUN = function(x) apply(x, 2, FUN, ...), simplify = simplify, USE.NAMES = USE.NAMES) else out <- sapply(X, FUN, ..., simplify = simplify, USE.NAMES = USE.NAMES) } else if(is(X, "mdf_list")) { out <- lapply(X, mipply, ..., simplify = simplify, USE.NAMES = USE.NAMES, columnwise = columnwise, to.matrix = to.matrix) } else if(is(X, "missing_data.frame")) { if(columnwise) out <- sapply(X, FUN = function(x) apply(x, 2, FUN, ...), simplify = simplify, USE.NAMES = USE.NAMES) else out <- sapply(X, FUN, ..., simplify = simplify, USE.NAMES = USE.NAMES) } else if(is(X, "missing_variable")) { out <- FUN(X@data, ...) } else if(is(X, "mi_list")) { out <- lapply(X, FUN = mipply, ..., simplify = simplify, USE.NAMES = USE.NAMES, columnwise = columnwise, to.matrix = to.matrix) } else stop("'X' must be of class 'mi', 'missing_data.frame', 'missing_variable', or 'mi_list'") return(out) } ## create a bugs array from an mi object mi2BUGS <- function(imputations, statistic = c("moments", "imputations", "parameters")) { if(is(imputations, "mi_list")) return(lapply(imputations, FUN = mi2BUGS, statistic = statistic)) else if(!is(imputations, "mi")) stop("imputations must be an object of class 'mi' or 'mi_list'") statistic <- match.arg(statistic) if(statistic == "moments") { iterations <- sum(imputations@total_iters) mark <- !imputations@data[[1]]@no_missing & !sapply(imputations@data[[1]]@variables, is, class2 = "irrelevant") means <- lapply(1:iterations, FUN = function(m) { matrices <- lapply(imputations@data, FUN = complete, m = m, to_matrix = TRUE, include_missing = FALSE) out <- sapply(matrices, colMeans)[mark,,drop = FALSE] return(out) }) sds <- lapply(1:iterations, FUN = function(m) { matrices <- lapply(imputations@data, FUN = complete, m = m, to_matrix = TRUE, include_missing = FALSE) out <- sapply(matrices, FUN = function(x) apply(x, 2, sd))[mark,,drop = FALSE] return(out) }) dims <- dim(means[[1]]) arr <- array(NA_real_, c(iterations, dims[2], 2 * dims[1]), list(NULL, NULL, c(paste("mean", rownames(means[[1]]), sep = "_"), paste("sd", rownames(means[[1]]), sep = "_")))) for(i in seq_along(means)) for(j in 1:ncol(arr)) { arr[i,j, 1:dims[1]] <- means[[i]][,j] arr[i,j,-c(1:dims[1])] <- sds[[i]][,j] } } else if(statistic == "imputations") { imp_list <- lapply(imputations@data, function(x) lapply(x@variables, function(y) y@imputations)) n.parameters <- rapply(imp_list, ncol) arr <- array(NA_real_, c(sum(imputations@total_iters), length(imp_list), n.parameters)) ## FIXME: names? for(i in seq_along(imp_list)) arr[,i,] <- unlist(imp_list[[i]]) } else arr <- get_parameters(imputations) return(arr) # compatible with R2WinBUGS } ##Outputs completed data in either Stata (.dta) format or comma-separated (.csv) format mi2stata <- function(imputations, m, file, missing.ind=FALSE, ...) { if(grepl("\\.csv$", file)) type <- "csv" if(grepl("\\.dta$", file)) type <- "dta" else if(!is(imputations, "mi")) stop("imputations must be an object of class 'mi'") else if(!is(file, "character")) stop("filename must be specified as a character object") else if(type!="dta" & type!="csv") stop("file type must be 'dta' for stata format or 'csv' for comma-separated format") message("Note: after loading the data into Stata, version 11 or later, type 'mi import ice' to register the data as being multiply imputed. For Stata 10 and earlier, install MIM by typing 'findit mim' and include 'mim:' as a prefix for any command using the MI data.") unpos <- sum(sapply(imputations@data[[1]]@variables, FUN=function(x){x@n_unpossible})) if (unpos>0 & !missing.ind) { missing.ind <- TRUE warning("There are legitimately skipped values in the data that were not imputed. Including variables to indicate which missing values were imputed. Values which are still missing but are not indicated are legitimate skips.") } if (unpos>0 & missing.ind) { warning("There are legitimately skipped values in the data that were not imputed. Values which are still missing but are not indicated are legitimate skips.") } data.list <- complete(imputations, m) if (missing.ind) miss.indic <- data.list[[1]][,which(!is.element(colnames(data.list[[1]]), names(imputations@data[[1]]@variables)))] vars <- which(is.element(colnames(data.list[[1]]), names(imputations@data[[1]]@variables))) stata.data <- data.list[[1]][,vars] stata.miss <- sapply(imputations@data[[1]]@variables, FUN=function(x){ v <- is.element(1:x@n_total, x@which_drawn) return(v) }, simplify=TRUE) is.na(stata.data) <- stata.miss if (missing.ind) stata.data <- cbind(stata.data, miss.indic) stata.data$mi <- 1:nrow(stata.data); stata.data$mj <- 0 for(i in seq_along(data.list)){ dl <- data.list[[i]] if(!missing.ind) dl <- dl[,vars] dl$mi <- 1:nrow(dl) dl$mj <- i stata.data <- rbind(stata.data, dl) } colnames(stata.data)[which(colnames(stata.data)=="mi")] <- "_mi" colnames(stata.data)[which(colnames(stata.data)=="mj")] <- "_mj" if(type=="dta") foreign::write.dta(stata.data, file=file, version = 7L, ...) else if(type=="csv") write.table(stata.data, file=file, sep=",", col.names=TRUE, row.names=FALSE) } ## Returns the Gelman statistic Rhats <- function(imputations, statistic = c("moments", "imputations", "parameters")) { BUGS <- mi2BUGS(imputations, statistic) make_Rhat <- function(x) { m <- ncol(x) if(m < 2) stop("need at least 2 chains to calculate an R-hat") iter <- nrow(x) xbars <- colMeans(x) variances <- apply(x, MARGIN = 2:3, FUN = sd)^2 W <- colMeans(variances) B <- iter * apply(xbars, MARGIN = 2, FUN = var) R <- sqrt( (iter - 1) / iter + 1 / iter * B / W ) return(R) } if(is(imputations, "mi")) return(make_Rhat(BUGS)) else return(sapply(BUGS, FUN = make_Rhat)) } ## tests whether a method is the one defined in my (as opposed to a user-defined method in .GlobalEnv) is.method_in_mi <- function(generic, ...) { method <- selectMethod(generic, signature(...)) return(environmentName(environment(method@.Data)) == "mi") } ## cube root transformation .cuberoot <- function(y, inverse = FALSE) { if(inverse) y^3 else y^(1/3) } .parse_trans <- function(trans) { if(identical(names(formals(trans)), c("y", "mean", "sd", "inverse"))) return("standardize") if(identical(names(formals(trans)), c("y", "a", "inverse"))) return("logshift") if(identical(body(trans), body(.squeeze_transform))) return("squeeze") if(identical(body(trans), body(.identity_transform))) return("identity") if(identical(body(trans), body(log))) return("log") if(identical(body(trans), body(sqrt))) return("sqrt") if(identical(body(trans), body(.cuberoot))) return("cuberoot") if(identical(body(trans), body(qnorm))) return("qnorm") return("user-defined") } .prune <- function(class) { classes <- names(getClass(class, where = "mi")@subclasses) classes <- classes[!sapply(classes, isVirtualClass, where = "mi")] if(!isVirtualClass(class, where = "mi")) classes <- c(class, classes) return(classes) } .possible_missing_variable <- function(y) { ## FIXME: update this function whenever you tweak the missing_variable tree mvs <- .prune("missing_variable") maybe <- rep(TRUE, length(mvs)) names(maybe) <- mvs if(is.factor(y)) y <- factor(y) # to drop unused levels vals <- unique(y) vals <- sort(vals[!is.na(vals)]) if(length(vals) == 1) { maybe[] <- FALSE maybe["irrelevant"] <- TRUE maybe[.prune("fixed")] <- TRUE return(maybe) } else maybe[.prune("fixed")] <- FALSE if(!all(table(y) > 1)) maybe[.prune("categorical")] <- FALSE if(length(vals) == 2) { # permit binary plus children but not other kinds of categorical maybe[.prune("categorical")] <- FALSE maybe[.prune("binary")] <- TRUE maybe[.prune("semi-continuous")] <- FALSE } else { maybe[.prune("binary")] <- FALSE } if(!is.numeric(vals)) { maybe[.prune("continuous")] <- FALSE maybe[.prune("count")] <- FALSE return(maybe) } if(any(vals < 0)) { maybe[.prune("nonnegative-continuous")] <- FALSE maybe[.prune("positive-continuous")] <- FALSE maybe[.prune("count")] <- FALSE return(maybe) } if(any(vals == 0)) maybe[.prune("positive-continuous")] <- FALSE else maybe[.prune("nonnegative-continuous")] <- FALSE # unless SC_proportion if(!any(vals < 1 && vals > 0)) { maybe[.prune("SC_proportion")] <- FALSE maybe[.prune("proportion")] <- FALSE } else if(any(vals >= 1)) { maybe[.prune("proportion")] <- FALSE if(any(vals > 1)) maybe[.prune("SC_proportion")] <- FALSE else maybe[.prune("SC_proportion")] <- TRUE } if(any(vals != as.integer(vals))) { maybe[.prune("count")] <- FALSE maybe[.prune("categorical")] <- FALSE } return(maybe) } .cat2dummies <- function(y) { if(!is(y, "categorical")) stop("must be a categorical variable") if(is(y, "binary")) out <- as.matrix(as.integer(y@data == 1)) else { levels <- sort(unique(y@data)) out <- t(sapply(y@data, FUN = function(x) as.integer(x == levels)[-1])) } return(out) } setMethod("fitted", signature(object = "RNL"), def = function(object, ...) { Pr <- sapply(object, FUN = function(m) { eta <- m$x %*% coef(m) pred <- m$family$linkinv(eta) return(pred) }) Pr <- Pr / rowSums(Pr) return(Pr) }) setMethod("fitted", signature(object = "clogit"), def = function(object, ...) { target <- mean(as.numeric(object$y)) lp <- object$linear.predictors foo <- function(par) { intercept <- qlogis(par) mean(plogis(intercept + lp)) - target } opt <- uniroot(foo, lower = 0, upper = 1) return(plogis(qlogis(opt$root) + lp)) }) # Borrowed from library(MCMCpack) .rdirichlet <- function(n, alpha) { l <- length(alpha) x <- matrix(rgamma(l * n, alpha), ncol = l, byrow = TRUE) sm <- rowSums(x) return(x / sm) } mi/R/sysdata.rda0000644000175000017500000105326012513740445013366 0ustar nileshnilesh7zXZi"6!X?])TW"nRʟ7i|Mj{/g<+֎|&cG))=F0&ٲH-1)7%ǔ 9\޵X/o h][N;Tgh캆P.R`5v:~x+ aos,|R`Ts`kPr &o_Qw*VJB?vܾQ>(ƪPg[i?6:{N!9:ӃTnZƼySO_Blk+ Fd;dWb{ ӻ l\_!%if+C$Yڧ.iO1x"/kP2 ȟQ؛rx_}ؒ%$檀l8 $lmbch%M}>>8p)qek7xۤj5rq~P(CgTTɞ}.$L=~iXSe6ut\QS͈."I8~jg5a35ةˊn{JDMLi$=Lן5oHmHs//,}ׇ̮!'W S!9=~>kǒ'~ey%oO'9l#O8I"2י1L;VFu%UJ>e\V=]40˹*zRR7sj%׽zX^'ͯ[IIX뺹M.55Z6ہn9k;bȪ7%cPR(> ]~RY,hF ~?X%w{=t2;&ҠcQ9.uLQ_}? L^kO,%Ut>Aͮj(<`NEvD/ 922c~bsnoGHkgIc`"8ۙ^$ s=嶌p9&>[e+ʵeϯdYٯUF9 31d_4=nw!VZD oكw{Eޏ3S'\Tr|93&&y{P16( Tli_Ϻ я ; Xmag :NNC^#<4F+DʈssCulUqkM^ ;JZY 戈%wh҇)-#dy\LݜK1Xhg/ZU5cuiS uI0yl Qc:QO(Y'.3F~ /7nx؄\fG.!+b`1 ukx$:.'.$|W?wIer={'j̍3 (nnC=wzZA;װėh:͠KJ. t0I%M9kk p_Qľ]z61C|Aٮa=l+ɔ >%z2s3dS2?>O_,-kSe2$V-΄12.BNAj:c&GD/cq֐bW'!ADNlOu/)@25[0ϭ]bY*?+kK, >>^v.J1VW tz91'zcPq2 Í.$GRaH,QxZ::z^EWcrz?ȣSxi>5n>Rɿ#ȊW%!I(^1- =|jCw&cCv~xxO1\[C.ejvɦ6F cRcqV&+| \ }<7כO*uV&i'I/xfv9hĻsu ;ȣG͒c/,KF0~k4I ]Kiff]*Ļ-<$R"m-/" krrekd+|3JYiAglVA6S3>q$C)'ֲ \tEC0 v-"ԥ$p2Av {Aa5MJ)O~}wq'~g 0(usAr ]aP*LL3Ꟃ1A/+.5OˀH|숪a &jO ^f~ ;u"4X*LB)Z%'`,Id$c T\<[--;i5+P>eCS=smkSulsMʃF ֻ/4M2' 9)t){Igb@cb й?-BSs=9RB7uaRt&> `5o'1褥%,(HH X4N@|Fţ@c b'(y!h,0.@օEdGo$5’L$('Frty7"4`G8~9񞚊t|8ptnVWg $UYXLhjQ<롬5ѱg/'wT°qb RIvRjTH',< T3Tgݱtmo֊T7m -c}p3 &>li Vp*k2漢ooc<ݱ+f@mFԎ氥%m: H.AY5?1'JbTXć;s>.Vƞd w'%9H!1<=B}„XzZ 70F|r'CEc_VVnۖ)q#^K$"N9AqK<9Q d-i94Il16cةh=Z$ Z#'/7n';`{|sl't}>G迡CTBKCvHƵw4<ߋ99r!FNr@6=+&v"qVTU~ۚN'rCOPu%lGγf>!AjZCj9- D}9>a$TJk6*Ӓ %$W>uhNU2>t&"q%Iu :ņ=-_Y9wV6]!p›ӈ0 NUʒy`ݹHo$H}!"jnJ45ks3d61}*B/qI1rp\=iPȵ W^dߑ1,Z,_%ՄvwIŪnZ#iyw1}be2N01֟Q%ކ>ԡ> пIg+9N!p ߩWYo#վ.tt|I&^Rͅ;,!U#>Z|~Իy1kV5 oӫ&a$.^Jk.=dM I/탷yTEߑPR?#LٔP!NG.`$7t )8Ď1$U|0@D'J:YCtgj鎸ZpY-:Ƨ,iZWXh&wJS캀OlWյ !w^?Bcs0oޏJ̀ `P"OKC[Dp[f !u:6gUOۡ *Gp݌y^Bv_7%.[*" 1jxޔ䜡Bz|^EDmX?jĒZxPcj:%tg:F#~.6lF> +mCR=j=c$G<: Sj Wi@kƦ4fJ b/yO+zF?zͺS#o_m!J^uMn2˭IB' WrVb]hU89q )hMㄉvR.~s wb6{-5/Ŀs[k|;\־ ,#mo|n*v4 ׭nQKU3ɢ'Hi)}nc'6I$MpHS02R.2kOj$Ho8}N/ :S…ػ[7r˨+9<yyUgTZ1jb?WՇZ0zBDX3g8ɜqzDLdY`7/ŤL\4nj^тaO-^Z+et@"W> Ps#+$JЛ'ߥD\N]5ړ5ƎH ]Xxo +|.հ/5| @.Awo%_Lbxn+˘V[cs^H%'֛4zӭr޷ʚĪښ80ލ!CƍL+R GGÑ2H"Z֏.q䕄 9x,UaE-1,қ kK\ Lys8^27s7ݠ BHv=\+@o12RF &p>`&47rڱH$.?`byx b5,,%afՀW[juVJB=1Vʲ]RjIe \t4]AjQS{iyI珷$iDs-Y7FA2勐e3e>L)ls(aâ9:׷Zّ1@nJaj~@$7%$3SqլQ /nŽ:6Xza_:ge6ՔB,5y %BkEtfɏm&B-y8'ޜq:<cUΒfęoӣB6&w1ElҚm@z*";ȿ~P5#y,&Y7i~5Dv"GEɂcDl E5ǘ zGIҕo%'9c#@|mn 'ۧ)7tA"pRl~` L@w1 o晋xHmflWmw*c4ؠDv:#Rp6]zΌ( (]|ey^~76z6Az})_<+sYoΆz\ekħIrڹw800r[c5%gHj+tMIJB*jkc=!VJN. $d*vݑ.4*F00Zg>8 f>Q9r#ޝ#ifnQ#b%f 1Nۥ:*lrf82J(DKZy7{zfM~\DD凪es_嶼*&dR\&l);78e Y\,*~0ϋ"9LВ`G ;F?b)dU;GggkcbZ ۯۢ"*MQVr%`R6r%*bؚI;`o[}!y$mfnE41d t\&7i8P9Icp(@n*]@u\ھ/`te@x*ymWkX ֒>@L2†yiU7HNHHQ=Z6*&]k#zs]*Uǰ`F pnl6Mxfm 5fF޴ Xgn\;n 0r VooIg}MoL]iO Fr6kh;稈H)dM1Sbgӆcy'~v#.@3jb|?ۻW*π_BU,q9=t#of?#'BA{1m.*æLk?sbK*c&VtzadW::a0ϖHB[5=afCvr-LwB#lpIer*NO- o#hZحB&XSu HZeCo \?5k%Р&1$ϥy%YxeDfg$wnz]YM`;>ԏ-ubiK=T?ѷ~/*kKFX{G:.1mHpTxLKlw(tێw̴Uc5S'óz i cG?esJ*p?}>T<ǣفV.o>t&04# l![7C)\TV*z;}*攇അz=}5rn +J ش/哷&`Ny0{UXC,6_hsVR=bQ3W݅ލ B 11px-ZfȞ<V4ȬNg&kc월hPfCRk\΂PL<)X7ijm@\W] niim~ᱬȒCs;)\=j+&/J]q{ԥV[hC^Ӟ9Y -ht*||۫4bʃ7zƵRl="X"Y$|P3Z,,S69{6!:ދ[ {o½)+H[v9PzK|9-># r{uǟ릚Պlc7-̋~г:\K\()hYD J{zIްٛvf^5Ne/=jPp\>)F钮x$zi^GGŃxI@YU(7yNƱmS@z >z'ccCt{䬻 w\^ P?>S_\SLӕ(txcnqZEZ͐'{3@5=`)TNnTiL+`WO]2#y9zXZy- 0H{)G7\65GCMB\E {11jR^j!E#&bv0 Rj?W4.q"N(`Oh}jiB$((^H=qIV|thFs}.:{)_?Јu;Q޹e֒e fԇrQVmӓ"Lg/00}aadc2ka_8`Yil\Էz" $zAFzUặmmL_m- QShWTMs>ΤDG*PWI9 >˓p?~}p$gr%v~rRjQƯ HH־_IYnBm7IWN״2X1+894AP%ceJ+\%fF5˹kc>6 \LW҆(.7)k|R=CYXD=rLc8l2 լ%LDpՐƿrC#*~;bF[uC˼o'кWʎzXH*'fL4ڹa7bUTYP2L"8e1.NyttHfzRŲ@1yB; `8RWg Ӭ}mF4)$&5l2uf,+e v3XLaS[=a$wG|>QvS&o)i\1dC-zM!/bߗfeJ|^"=k(6jb纻ke6y0['3<";Bv2,x\UYQrR-AoӲ>B_3/,5~UJhU1k""DejyibA%'ޏ7Oe=v`lqo!7n580ڥb &tlr0P4Q2#d- Oݩ2"EmL<}qQv-jSm0`jyŴ/Yz]"_$ؓe//)c5fƅjW+*͵:'a.z`Ty%'W_]}3#>3V0dHqo)8op3["u!! 7ڕ(-0J%1]H@&7>s˾5,Fb{Bn4z>&&ڛ? L,ut& 8)ZS<0[X>2 ~NޙLB:6O0sn^t /xcϡk:Аm~EbgN\Jづ|!M9}%k 7MEN#4{gD z4@(*0BjS|cӽ|:?28A__=[',)]ИA$t,_$>* `&h&B"c_K ǿ3"~F[Yu w19ߙ* b%az*̩ MQx@|γ,ęR ]KAZX)lh ςyoOR~4Hw2-miŭ~ӕHq=u4SDd|1uvXm[.-R0z{?C_$`<^rwpoլk_ Q>Zp(ULG?RT㱣8PKݤT<\  {âQs/)¸Pl_=,sFyr\g"P9i+ <_aΟx;! ±RaeT?蘛 Uz9 q@%:k}&6D>Soynp!mgZ p9,Dڵ4nԭrcf{[9LfȤQi\ M3d"\@ lh5h"OKr*=Pq"Fn` =8i&]ņlńlH\OD%g pVMTj sc9&XAqTŽ˝=s;R͝h<6xqjH> PQY,W-`Y#$ak՘g-*SK:>O):1c+f8]գi^ q/I%y?nPPlƊެz$ zmg] j"t1G· fJ,KMՋ7(Ji*duR6-0LJ,iB5f|9+H"&8{.'z؆bV<Ho /ÂߦcHL|N[\l]M dY'.h74M[GoW~)7ѥ~FӜYf;FW#r N6,/r&W3k~o5|Qa.hCPБeihOFOy=١oXUD,I^B,ףr""]N|nSvL79 fZU&0B&,aQO8 ::g58TM!dįڪ_dkJk 41Np"Xf5Ul^P#l`7|j*m&IrU`:m-:"tI?@5(m{k> S)#F_>!Um_)\̇47{uJ>K),1BRBMq.jQ8nz: !2xADqbT'F&c#xP9,zj8nx7h T]?u&!rf-A(0/d?8! ɽY4z ᅊP $7pgJ&{|@ ܴyWaz̮V xB꿠[aм`Jg;l AGE!~A\e \Wtar/6U[;TOAW?l+(!rܦR;y* z=p LÛuN|@>G_- >3^] ٧B?;?Rj5dc7R e U5`Rrbm"y붞Q`]\(ߕph0|Xn  b\C$ @t*"8\ߢb™@.rgRL<'؆\0`?eMZC/H K=Mڏ_[`S\hR5}ųj8>3Fg!u3bd2N9+N(CpA~6lkrI+q$@vdW& Sy;wL藅x434ޟ +?%G]@~%f^mF1CL +bmQOhL` mFš|(O,I4j3e y<Ju T`~KwL=?[xVzWב$<\ (ޕ޶tD : y'0H8nQ7g?Hw )eSewц^E$q|$b'ȱ"#FQzoq`)ccC- Ů! L~.924(.!;0Yslt@A|:&Y YC/"+U@Y0AEoI tk|0el^`H2"x'@̫X =)eRțoK#a{ꯗ!ncמs8 %=0>d?vMxc:KNh^BTC'`To6Nf׬53U71 I(~U*e!NwK 琙%>KOkN~&"v*%[x7L?0 Ϡ悖MvNc(laQf_g a [ 8]2G]%ďл$$V9,i;&S ./M E10Y'̫0bW?+&n!!&m[ǿ5NWAPH߲4,/X2@FHs(q' 4;,2BblB]w|%бJ@ywɂ9<=q+ ӡ́aWb.0eT+lj {54h¤=9?n> (qpp׆ H:YXRYʵRs/B_۵a.hvd&ͤ:RoY鸪乭}?w rgJ\Vèy4#ϴ17@|'\w>]W>wUJD{fR^~Q"$N"l+|ۇh+,Rɂ3fk;9={T+|]̓M:x隠o۶S4хrۇv6<ꡡ˻ۨß BV_,AHDg%f !ٛdžzKHye e.]sIHΫ˙rgܼA|x$x_lj*I>U!nuUf#~ӂ8?/@e:-e8kzQJrl_=&npR:1~{ JVV1V[7<Ǵ_'zH?f+dH OkG ~;WQT~|.(X!?ڌ~pwfTA}l|Z"5acÃ{ӻhPBw*7fK9fĞ׌^F[rЏ)Z]@LKtf^E~4}ŲiT%k_aFl򀧴ջZ`2'=U & FE ])p3 ZE]x *6gaUtLk(q(++N,Ы2g/2+Iʋ\Ϟz*M[.JpL/\ʆ48IS[ gdpXJk_˕G{7&͂t} vtwCAύp?uRkOp"=Yx4ZYM:'U`j%aJh޽twLW6hK?PZd8-( i{V`/E9qxauR1L㇙o$*)gT/KJ}͡2!/屓N Vwxc/lQ 3_kˀNv{KZ:f}' ;`zbx.[_K c5g*ylV>Z#å^P^nZ柒I]qȫa.Vq}lO䊱 ;X1 |{~&%9r^7Q"_L$yR Mk+ K#'C9( +f aWuH%rH=zw*3 ʛ|\ $咤.ѥ&ڨ| `lEN~H15ћ`.K٪CW:XzVTcnnܬc78etU&l3-Eÿg*SFe܄fZ ݃.5=MS&X֤<q~9,&5.~P2=aRaocoශw*!S½!&ޏ\M*_ÄkOҐK#/뽆;~~{m}@WK`m'=^X2(ѿZ b3ʦ7Gы¯eRa+c 0NyG ?P_؝ sl#Y%)[b63'79;lʞ!$Xj<}"@օ#W@\5T6Jt<{,9NIc9HX&v{Mf O mBjrP7ݒ?d..)EyDbiH" C-5ܝTΨd$]#Q]m]A.ܒs! U *iQ~8Z >_r2h7ɒQ`k*k`GF45kPZbMۨˤPvD:֕0@}@׎7~D5҄vОEcu׿AE'`7kEMJ_(zj6|XBS8r3g'Q!>To?o0^=ln#\kPQųtEKn76o.5X0h0"(;)#0$@>-4_ Q;SZZX.!gV E>MB=5Ag}9g /5% U p집$@!`Ćw0}bki<*lWDoJ KM9ZqX6JdTM^̶X/&47[p; /.҅,^9G8fCvv|d5HSV[?eqqYX?H#2uZ[3\=UbV [F_e< ɳadh97y`Y>`ۯew+l֌ocs+|EJ'"r #g 8 USW$Fot-VHq6ŗ&4Ǻ km0e|z|Z^F:h(T}U"Zoն8IX0Ɉv9XO"icۣnC {F&-\.+Y cx:h>r),Fmm`Ⱦ ){@w :zuiI =Ʈ;[XeN_\/v=i%_B^_ Hi4_6QaG;̧Q^ 6K]cU)VPSU[L*կe7KA"EW2';Q~?w{h.Z$?U-&ﮯ&-33amZ:C}ԝTǐx}85ҋUJjnjy_{zZJ6մ~7D$"TuҺz"8b8ZO nQ܇-W-#ứϾ.7䷗B@*j@C\ fl8",[]j?l8.9s#f]5zAoِ-?Px9rdZQ}ea8l?]3!U 5H.|-MsN rJ |s^ jzaTseUu *.(Ң+chSyδMJTWki;&igynbҭ ;/ + ulWSIɐ(Ag2/q3?ho!R}BQyx9Cv'MBȯ"'ʗ}xO=cS!IXcb0g/1 BU*{+_l~Va*ςv+v tJ\K#FrhߤTăT+#a  M3O)M6_ 2,oԵ_fJ_ߣp x0-B%x w(.ak}9 % l%!鰸FVߢz^0 (-"e۳gVR%DFPdGLE N%"292$hۮ nV|mY2cw7LF]82k35пpl6&κ:GEVNr?_p {^aAjKh*of sTT XǞO 51,_)/$J:o@1B0RE#0e&P7tim3^QG>UF$gԒM0*q8z!ƚ'>lڑKQ!תokb\!r:_YrM y8C˫Bbư a**lWf`i9Q7xV kEpZ8Qt P܀o ަѓnLo g[y_p6†J9˟ ky~o%lOuɣIlTX$iaZ C6%}L3՛YgfPmܿӛ24࿙gku2rpֽ]jg|lj7h$ tw{{yό>._뒦fQ(ETz,'0A&\& o0qF ^]Xd@{/Ѡ_g,_LckQ4LjA~!tW21zVtA"uC'ΉFV "TMZ=dBJܤH- g7.hHQ4VS ໖''.ʼn{ ~f d{*3m#vK;)9z6{EyW)aVS%!IiA4Z\2٥o$g D_~L' \P׸ΓlqG 8Jۀp@> CXY|ܕs2Y^s1uM.*%6UN~Jm̼dP!q9J6:vKuNÞ^us @CȲ[#$rX$}>i6ZۡeuV'KgLuW~F(OXřJ务~ QZT~.*<ûs~80*lPQ]jEBa7j,/]Gղ.}FA4<#bV)[CdGM6/d!L;ssrb60_8)[ruP?}GVa{AU1\Q~K-y6  xSCR NQD3,N'tmkKU9(̀QAJQѩ:y\$dp<:v"pdDX'Į=$8*fw\A-;=. !{-h>eK|ۙ~esn][Ԟ.Fs}>%`-|AN3W`t>3 Qo$ V_š,xv.M2lf={DpX 9;]oR@aA oIdR\itLF*m|1~P/qs2*; 5;-jFu㮏?5?T gĀWq6>uyB,k]0> M~bʚ-ihS6\Xqc9ÿ5 dF%641Y g ZӚJH8r]=19\DkU^Fh.oKO`9H\b|:ɔm|n - > QϚ*#`##p " $d>3o5ҳe?j Y,v%5e B<{Y9 4ڝ1JLYo5quBDdGaq֡xG_P\(*[?TOCɔyp:Ԧw^[%i(ac*_aROKkbR?'kȺ{tC[ҳ#oE붬MJa9!ua)B,ms)%)6?ъ!D,asN8šh],*B>ڄsh6 ,L ĺ\ZvmaAMDX T$Q.{~|>JS6e%5M* Bp~^M-z4|Ilz4rtꠕ? 5ILA F?UY(^hNW%UFBk,1Kt"јBYnnLE Q 'PV?3d A~͔kg`M=I:mҶ3Diž1䇬Y 0?E-W,ΠGs&NGu1QvIvϮ܎@ MNss}"KE4AW[gu~ߝ, 4|Ք=^6R,(o$^ܷ6B$ U!3{X%hhڙ`¢%<8!}(S*eOtx\|&.'nU@" 2ڑ\x'||+Vl1֙|DiQl_N-nT_}6JŚ׊>籃[uИ{YrȚ:|f[CEyhfbxF6QitycB??<B cE|^:`!6T|I&u?8aճO'܀i OLۢ',V<&C,FDī)X/WHLf6_"6?,c\!u<_-lJQ6@;+:N"eZi|wٟtlR}BƎkMV32WOqIC$*L8>$x]:r?Vir(AE6&5~&BAݢc/F[,ܝEVf85%ūHڣM8^=yK Z.lw\G*i7>,)18)ȲSwϼ-f*hӔ]F;`ⷞ3M11Ĉbx~bau] }# y\mަl>nkvM"⫅-|*辒@ jsKep̄搮d+zVǔWCT$FӁ}+M'n<1X(O'[p7MDa JKNӭA?zOMLC<T8(V=K wي)^FcQ4j1} s# D?VXa:6 SܡʕеP85`0ݭ:18v~cbYDaOpic}RsXȱv4!?$gź[:Y%o u~K=e^ c8/bВ($,Sd~qopn j nġd&n-8'tsK`Xq {xd0#Ke#=Üa٥فQoJHԊvD*# 6 P>qs7iJh@86vPs8INOR]/?>.x>ou3egrA]@~4(ѥ!Pk|*uG޺\uEh5fWiWt>YL4_I_,e[*N]ENGg*NqWka-u?z:[OAѼWLvG \.Cpt2K77^,WF0gPSN"O\ڐN;ΥfQV#k@OVυ䢭IV]

fxr1!Lm~9"ҬkH^Ξ'-RA}TsMx/? 3qUUm˒/p>>^1MrM/.Mf< h |8ۥAcmD+ayIv?P8;uwR{MgF/-WX5s>W(Yy<Ċ빴Ʃ\]%tvOlꁪDT?ʟyxT\X3nņWF#Dt)V$}z&N"Q?{uG@`!mF{=R|~ erщj<:-?9Tq0c[4Q)3 9?Ѧb ۑ< cjx~A< V56C!hԦ>=qGbA6Li܋{f$h)ڋ#SV *y:˜i`Z duW/)f]{{l?7Y@l#˿X#W%y؃;c&a+Xlpd.Y,tLl c̺>neB@~$!O''{SbIH]|Sՙ: 9|dA deg`@q&JG^]}Ƿ0X=š1kɩLRgV|>|Gka2 6.׊)Xr"UxE}_ "L%XzpZ[ ދZ u)bڼb@JuXA@4 \Z{h 5d7En˸^.F6뼗{LqS^.oߚie\ 4kO4-6P('[${Ps~?J,S/Y]`xV%jA9NQFH^(JA9!K=Uw"{f/jݷ"mڂ#4:eޗ|Ϧxwof;}r}Vc*]?( ZSfIyj AfrWm׽üsA@OHxuJZ@dPqlg1} Q?/ iN[zVŀ#Tr칱_s4PXctZ͆TP&* M~V,t:UngFl<+_O٦u_HPL#o'":I"ьԩ;MycD,ij|ih畈n?~W݄EQo)|7v~R'aG3JZ>k pj`X ;1]u^7MZn z~"zzhA=iٸ<-]'HR?Gsw6ô3MNIqb wߠç)3yPpx)̸`ZmxLC ;D xRHv֊u? &Ҁ/sGYsBܷ5:=\D·zogݗz Wyo)SeaDBv}Zd Y7 h.'fw{3 jf 䱊`Z-Uj%9ҲF1[|/{-+:p-N{ C25>kO/v^r'>H1$:MN )w'5yB$Jȍ6PM;rU6)kIx/;be/}W~gAmA=Uk4Qhr4.;87sKoVK \ޢp{oܖ3d| :{,3<njdBY'…L%dn n .D;q=y4Uv}EO٫ߝd1J 5eڪ{)#ٽZ.x>օ3h%Ze.:O^Y@&.yLs:p);k>gj̸|N8lH'qX.Оk#w`;r0rcIYakP(ITSBHɧ;ً*,}ԡ A3ʕ8Of*o<}c)^_Uxfp.?Ψk$E'kT򺞤9I 5Ԯi8K-n$_0߁IY<҆gGǹ3鍟' rT$"L=9'R>,"]2Gfc.G|XB[w½E5e1M]>JW:[$C7;ڲ\4qٰf+-x!HG,mkllu/ {M͎Da*e_4ą8M>YAP}g8y8%}oR'Cw5X'dh<U=WuMwr'+`%UvIbnY O#蟶8foRۯa楆/0e&r 8^*x 7g,qLbGs *8Щ_l~Jt =,Z$ f8R[~(yv`OM=y?d܉bw걿!~Ō9}3q}%JXċu9uߎXoYXsyн k_#Xrﭘ/W&fw[?πd'+c5O|'U3Ej%c z&D+IAA6Cw-rmo6EKC,^ 8SHz&BV㏓X lqnh2Ǻ >b86Kk~Ie"q0w*?GcOPwyU],Ⱦ5m7r%|/ V#樥%o|U9Z|(:JrLmx`0띅9Qgmgi%kmq=ޘ4~?|B 6]]@o3> a>W+ "x">V1GAktAÓrsa|y{; >@UPt*LJ;5 `צ* *r$n|B}YzI^%:۲pĹnkƧ4泔lLwW3_mDv65jF_'j[X JOvv<𩞙x(}O~|0Y;;AnǬW_:R]/sn2X; _J&jj ڿgJ4|y l-8*qWffa'Ns R!2d.SV;~0RgTђṊ04mC 3k8YMQs*#+|zbg (!k[ ubT3VB]JR3iKG\{@W4 uX*yG LIfA ̿d>AMLe'u!=`=`~ 諭n$eLQ!ͤ4?;У'٤−Q W<k2XM `Yz(ntJ|V{KBBKQլMQ:'K,ψW:DAl8M09"缻N-Iްxe/ڍfVc%X0ctK%/Ezd"굣=Msy{й4Ci|Ҹ$ D9xyoLXn4fߤ*Nsc)j*^G uGNm#D#>.!iN:B\v,?EYB"`.uIGó 7AJ7h),}ホ2Iܯ"? qpO&sMs1Cŵa=VcD-J@37[ :N>f5By7 ILT2Yt"r.d)hXH3.>Ǣ3< LjJ%|;]b .Sxl0% 37K^D(^pHܓ&SoScHtΫCcG4@j돥]|^ 2;oU%4֖ݚnΫB *Oǵ"TCFjL'QD:77PZU;lgӚ7nV@W᳷p)e%>͵@UǯamX~{󙡞̸rF6pm`6Rrՠ TF<KU+4 ^u)ݳ((s*#K)AQH4tW7hƟHƆ^]qK 6vYZHxCT XϠl@EQj}rHD1RKs K5P>2[ˋ]Gl݌!,.4,+[Ibe?gL ͸Eоb9V"T o+/rV^LGB1Ib_#Rk/yocsubqQ].$$,?LV>`ua'N)+ʾd5km'$h@@{ y u6I@wb,Yz{pD=ݑY:c$͗PLy $qɽ}g"7m"_JR'42[PDR9\{nx\콞Of 2UpZۚ,W%WGt]Ő]&rw`KҕYU' S|x$oMH{SQ/kwJF.bjLEOmX3uFwvSf'Eyr eG& 8' jVP}ކTĦD=ILn@*y+KZ;yZV՘)|^xw&tZCSGxzКF8[LP&J6KT" 8!Їe;NZ[$GDbL&yE!F_ANE -c*$9#^(OfĎA .dT_[b`gL|Ѡ2gI)9蠾hhuB#=uڮ1|p:&J JĶy?W<Wš`0-3gRyr?d*GMRR$l7ByO*K!R5Q`wjL~oۚ(QdJj0a#3L2&ǑbgOjP^zOezFYρBU/% }5~ΖfW_O9wŭEGeڟinG҈%~vEF$&-Y>L|GDX)9 jtwk?8Ps -4!W{IψDx;M>/dץFke1ȷS$U@d+XP>zXE4Հu(E*xgb!f3 (5XJT)\8143VN&U6[E[j62=JnDWNj 蜠YgTVm!bfƠwfީuH3FI=Zt~øc%K%c-((XJ=MAIWD?(F&j֪n>%4%ۏ8ӳ+pߍ-$ ݡ8+o]g.btqeSpDw}J>8ꞆUJ ƌJS]ey ΩS|$R~QaEC,=Keep%OLָ#(NAgP~$}yGvQA$f D4,#~hE|ÆZ=GF+{[I6y^:*Tcirg1Yt@T>\+Z`!x?'YcN ^tqωf5HF4u VUwHBı”ri om`G$W 7Ѕ= ci]-hU1Tʨ{ 9b7䢼[+5w dEGӕ)4NFK׈rΠk p|+Ta̢uO~I;#-B_N /:޶g'qѡ ^A.G<%Dx{qt4J/ < ѭ(!1T4ҝ-n9) #ߟNqdB~|;R4-_#gэIy! jˆPRX 9ˠn\[z&!P ֒X`Ix 52kްoL Sڿ[ZO͗(3ѮqL?R힍Nm1Q{8yw0o 0ؓS`GN߃0=}Rnս6S)X? o^ꤙOvX3'G;J0bM5}g$  ߁JK&>mS*6@݋r2%[k=ݘR˾19I% }NW =vؿf/ݓ2pʺ(MDsMcfGklMmU DKfS ZEaLJ<" *~dpHY _\dGp(PQR1HyWG4yl\F_>$Se%~| Tk!Hffȑ8Io.%jGq٠vm*?IjOȏd7ab0ܒKam"*Yi[h^ /,B9+Kd Js}KY Ea Nr'̾# )޹8AZ/{bKvscg]cxVc1<R**eO  wB=],e;_04r0Wyvdo?5U܅#R׏CQgO.v%@ξ29%CZ\6rΙ7bƂ(Zu kacP?.It>ʍ".DBušd%Q{tK= zaS XOjҚN'Cc /¡9͒ΓpO d=c J6]HK_VЙ:5 Z&M[z@ĻV{}Uc@ul\?htO)@jhpOi) 0Hx櫰nF@fOW"yej`kYr 7)vyPQs6IW;L)W}0|ſٍD YF70H# v6 {@;~0-yh6NON8@Pdj*嶭ʤ\II*r7BaKVpru̜,:>XM;9WHvDb9eGׂ[kC5YG!L3=Efñ}ϭJs~iʒ¹ ojHOw.-2\e+#ksb'I3D>d9dz/Ub0v 'WL7Șizҫ R NKUG)i8 .y;TcGs\fZzTt>а'OJn|Ç>A ;ydu:|` er0jl]fZyVsrȳ #T+a4/ /@%+wf:!zgLۇx y{nÄ=p}hS.v_w HZZv {^As񴊑פls%p*i>w_@2NE'1'ZUĂJ"_h8/mQNK[F M'W̫ , bxa'ʥN7 O%6;JV*׋Y( hL/Fg!cO%.iU҂8i$ Hd_;yv8.x.}mq5;fc133L\c&]ȨS}_b[Tpp@Cs@e_1)ȳēoO8Y epGh(>f ] eSZ8v~}j.]Ae/lL{r{;ȡL>ͮx^Vy[b}*B DF=#@(G>,Z "@٠x s2"yږjQ-)z q68I0J_\xFhYg^ t+ [Sl ^dt=_a=ᓟgl%tF+CTm 1 ;ڍGǺ+Ʈ"i[g\6֦[5]5,N0qUT8%_aŎ\^_~N ByR=z s^";?HUKZr?u1^iA6ߗ Xu@.EVZ[ԣC̨$䍄G@[u}fO&.M[J sLIڕ^q{X$;dijiK<39~|B; rv o'z6=Y9hPz͛9N߹ {jd}yPPꋳErOB1D|zŪFy(Z 0TR'f1",7{#C=4j8腔~J"Jhj?˲iϜ w|$g]RU-)/p'p,zUm:׽pqCZ '7Utѐai_o43 R]$˃D&ϫT|M}G~y̛6J4oUaEՃērN qƌAX-בl:wOpJȰE_][B;Ip "=H&QIV%a O!R0 C%,wz̧AڰpH|Ujq Qק`#.y±;zaW1OM:-nf" J4|>[: P-ESiK@ncHχy!׺V^M Չ*p'vb]޺*U=UT[ANc 917=<;uz M+w0YjFcK loָz;*@ǥߌI)7u{^+^ L'Sޣ4$Q\sP V.SWp5\a{>`9Su'I99FSw`18e4 :]g,0cy_Ee;Fƚ.:rC(L&V^pHb{H}+EIcte-I`w1ܵg+hi;cM}3EZue<dGSErF>0؁5^{`{nH[J @w@-T\d=NeTxEGOoe`-ѫLiR xmVafG bК'.!B4t|Q~"Kt^f&I s 5o^-cx:^JMX%yh(Q ,O["]Xmaa|WpV:s1PA]hY88?@{ೞ?V$F}G]FSɼ |҂ڄ ( z5:>|2P"S5GfпpC"[F ,(?T1_VmNvi+F#6i^+MjE\oOudt?N,@!㰛%P3h`D=(@(lL#drlU/5'ńJLw X:nM~yLI1Yӟh~XDhYP x ru2.汙W^O`dKӨ{iPv,A0evAnu/ ;3U}*Hnùb hVR{ƥKA)r5u{͐!>,2#غ!w[blO-ٺzVtdž+2.>ÙcX+igP^aʒK넝X;9EkDHh:GT (B9|LxTdN?PN#5쟕 h31U[ 8H|@f Ii6HMIfK_&LgjA y:ezf vvo̸ FKzM+) ~it}]໬rJ-C9yll`Dя*T 2;S΍5CB(lGZ;B#R^_SG'X]=ec~9g8v <,4:"+rG6N A/o%ƮuMx)Qb: kh"n䊡\Q_sBث}{Wu.K}!7Ē]EN辑_Gsѭ=?cW GCicQ`e@w#QXb*p7rQ;yzZ+}uo띮O2n֑tAW.><>A4DUB v5IP@|Ѯ= Ell{t˒ Vdhэ_|0?T-jK.-Q)=䚃&D-9hɢ)n&yoKudʹLL=~1 k>*%9Yyx#Yy^ʹZ. ?uյQ-ӎITiu/ o:YA(IRHh&Loi(#4+G1 ` X`yȜ* ƬS|KA?M!wtCS3~ LEQ"ZgyH 59zI_({pmנ8ը,C_ݜvlDԣ[zɩ@.KTᄄޱe>r.Nu Nz!F-EG8Ux݌|ObfI}"C`ٙwWx@|.F"Wښ9%iHVd:=}}q3\W}w:QҸF֭Q?bטSge,/p]~`Ҳ*mt239mN*gr~hj _XN`fc7}By[ԥZDnesKNM[co.VHqs?^d ;%FNcԅ og4c^~'b)dh۾#BZ 6R)xXZ, B9SYa&vկGe7EK}h/3i+$ [JNgBgNΒh@P68ê'^VohgZ,aʓ:Dpi]B.V?'CR.j}ph$8Kq" DAAkq?̙Q7XVjGd#ܢ9KGtՑk>__C<;N\8zT.uLp$"ᗁDv4V+(~Xb1;׶<KX@]iFi)Z#Rۼ~'ܦ+ ~}3I0cjlb&3~\;Q4S d~hEitGE4[В-.mUp)Xj)C$iǞ et{/5<:1-Y-:ޒgoL3EwSW)m9 5 ';@.I/ e 7QV`~#Vc,IUA K) bk+0p-zMOYy 䶋/ l~UK+Ol'6G 8P36a:v yަU^⏱Cn'ߌ6S,Ǚw( TՉ~aLdb::*Hа\ )-3te aJ("ЎCuslNk73]0KutMoӰ:/EywqDXnbӎǕSuGG)R%ڶ)n,( 2_; ٲZ,GjFP,̶] LIy+V2=6Jqpnڌ;oq顼QȳoGfaV)V0d$goXGvR[#KW)""gX3o#K=@C98(.t%/B(BWX(bv.}P| zzɍKL'LDkźC2[榼K[*>Ϋv *G⻩Bc.+i5o}HVwbBL&BzϊY70GPm`Y' HӆV:_,_>P(Rq\\Ƽk%o {, fZ 512n}!Fh(D'J"iQf,Yol_ x2QGzcnQ~† yXI)D"m7]o ]YG.'VIJT2ԠUY ;idXRWr\lt2jr:z(ycpxM 2 vm=[kB KU&^ DCd[ua2عo@!&Z轛bj{8+'n6dK&=4T]4G?aAMCwp6}Q@Lk)O}\.`,uMp[=dw[g )@J a_6gZkV|g1ٲX6ABYKڤy\FLRuit+p Z \ w8fXZԪF=g^ E! 9  u %5 ݱz3!9`2_&2-/%?8]x:=RZN4>L+}V9$Wqlb"Tѭ7y{턼5Rd|5Xl]X 3Y|򈕓@k¹YA%5*}VW.RK]/?M׸.,$rU6s8xy X%ŠN>!q ֱt]ֳ$~cd.*I Y/;\Cw@MlixI8Gsκ[47nt0wl 2Ws?U^-j5-w[U'kt?ʼMƸ4mcÉF].dɚRFYG=bߨ,45 ޥɟy.zsX+~ Q@6>l!-Wj@Yb]Ȍvh3;w!fjf9xzJ`4|u=$p6 {8 fL4wIBֺ^ᡦ`2ՠCѱ9ʫC.E AjID>44z?7*r8.^]*nr`S:~3+qԍcO/rUul0?k^9&-D?(4U Nh MF%mmL4:][}FnXjZ Ljø>0zaAw,OA@˃ե| [޻wH4!&ڵT&~1n\F7O01S ev/A:~X"-=^:Q8ѣ:tN\^~؎r[=Dnt}̠7w@$р{B@}!x49f)b7BH E[N6FU^+rcx~7&{HNm:p~KLo;1*}Ѭ2~2䯺j$ĒfR:]# )n2u_CfmaiwW<'}~=[hTk|)VA28/pMYsPJtoLt c!w+n!6} 2I.%w^&vFJ `-hBon'o`?,/Ȳ%{hҁ_p۬ 5h^ҟiV!l_cS 벻[Ggc /Ai%fC9(3n$G5WYް@XkNAq'YHF2A,wUtqE;J|N|5zgwG39M~]W7M#)MN/.og-X(]mmy{9x^h7z F-vQ6 => A|0S ' W1R='5h)tXvwC#2V"H&'2tZk3A"avi|/[✔aګu~4$8#؛ɚI/OxxK;6o%.e} R@O+(x$"eBN0O݅l\Ec؊3˧dܘU_~>Y H`Zm7%Y[n$|KtK8q\ux0qͨ;ĸ\jϵb?S|TVh ɣJϯnNw) "*+U| F9Eg ψ2ۼ\g%R & ZI~KP9٦/!꭬tP4^ŤXu41S҅i>-2}і9d/ H \;cr˒1A]B`lipS?#yl?o+\u^-rs(lt?gHZUTE+;lob1N>TUR+zDpHꭷwF0E6kn5!q70?7'G\ڳ (udΛՉ6wP:BfkG?Q3]IyG{z|88hh׮צVx},˴Iχ EP3,f&C+:d@R;nWD,]hG ح`q3!ffclTLkȹW/+X꫱\y,K^_m4;DT1 [0#qER YCXD6~X44P?o.ސ3PHLVmJ)26qVy5X>f(K[p±4S$ 0ԁ `*ۮHRbAry3AAWJ2._6ٚdVBvN3N(H9ZM=>`IgՁoCz&8GmALS _pٮ Nsڷ22a~ x ;&Ui,Jp,m39]<|ku$&[{HP UE5g{9+tӉ,}~*GVzhnjo6)ZC!9_`"WA9 nT3mYKròqM~6ju%ڊ.ʽnY6Qkkd`f 1αr؁b'E^1*{mQ(Jq-:fc殤~8)#0)2(5PάmA׃0yLVkO3LFՄV>Jq蚏=„i^:D4z |V"hAV}vd6uKܿ%K1+beDM1HL>ٳ$ѵfrle#V\#A bRE2/y:ÕgT};Tgн"FT'x Yac+Fn6%f=j`Mx/.sZL=k0Ȝ152@R*kyn$uYr9wu -?-I 4֍M yYwa w`fGNyDxE.)!AG'OSY-l;`/<^Cc^ GJf0GQ%[_*۞);pi%uED6ryarWIhTdx򴛵[3^=|¸TL<"5PqFhI-t ~mMCEzT V}B[[fuC{!3idID*elv ={¶}0NW &>R1ea5rD#21Jټ,= )6%ari:3>7-\w1rFWC~(b"@=#0`cA6o.'Fvv2?K.p${hurGк#EYS!F p}kzK<.M͓HfVC][b i3 V{~k5)mg3iƘ6DŽ?zGiυ7~־|Po?ij"'7 79+,ϼ`pFfetKg'YED05%pz*&A1 -zM1RdפЖ4SQ9vx)r h&3YPs/zNj{bdB1 29MΕ"hQC{_ U+TRݚ1K\*IO7R!HU``~D?J=zڹgnmzPT#5rܲNKN|vlЉ<*d.}vHhoh-<,m,fcxM::э WX}h'Fh}/=EWuo_۷ݼИ`*ݵw[\W}=rQ] AGt3!gzVXSrwQB(-,~E7)s xd-/I.:#4;b,ڥJB( <▓ r$EDd]}.diyYj^a,/sǪLs zze}s n@g=x͸yUIb-ĸ5/S\ #9kюw\v-]NmRpэq#⼶u S"~&7I50b f李Q4ufYˁM s\rbt^\ZİXRT^ԃ@]QA[%!/ ИɆԀs%0$r/lS/ GP@7^:E;Ǽ!G[޷ܑ(r@xFR)C A_1y)//`zf a}KlOq8u}8JWXed3ᡣ˿kNcBGf.DE~,Џ*_1`o^LȆO1ZID;`<53bUY7:R^Dٸw<{@_ &:6,gd8 .]'mA,cYl *^%sa(O@G,%̍U2}y2`лwH^.,{\cMWzN-!wt1u}*#L(Kn$SF-"Ƨ Cz?(4)w|;Ԙ1 Lt!dF?؆vUpJU;F~+x~aMj~~Had .eH*Q<4r"Y~=`xAwQ֩B& H6 iswF6|.vYg\J7L-2E&Nw"kaN? DeZD`ȍ5 N!n.Pf}ub |qH:k$m Ă!W6T)T:R@7uqARJD܋j1_%4Yt0Ut͕$Z5gr&E.I?P1Fb:B&pC7@Zg87:r\1M._,ڶx~Pe^{M Eo(~q27-v#Gu!Vʄ⇜]9Z&1T <f;)c[% C']T; &{_ 5qf!7_anHGeVY@ut̰tMbJL^o#͑ۨG{WvmWltJ[Q=q scV< /k-n[Poԍ|}4@GSkC$ =6Ϫ&aP߅ vJ Bbs\;NJK0+E^%o**DŞ#j.Yljx70H hyÉ19X`XQSez桯c<8}E ]ʫޠn>Ai~/qcYn g]UeG$j6$BX :䢄gT_sL1?+ZXsq~:L->^D~zFmmg08s~w{lJ([KQܤHʂ'+ ER#Jvf_K+azYG^O (\zJ(ߤ<6nht9(p{p( STVHGoPM"^p+bõn@UֳJ{4 @ӱ p&F๙ϸp^o0VL`|#k XܲLdU /+>9+Q?wƈ/3^Bܞ'7W`^lk{w+X;P)%ΟJkZo;#iqW>+lUx,|-uUsoKB!&ř,<*ap[^$25 $2|@ݴ(jY;w.}O!+jaJDyn(n1PrhٯyDO #l*3w 0D/\-6p|^׉RCD* 唯QwϤ/9ڲ/:{]ɿ ddPF c-J̟✃) C܉aq'<4P>#xC,Sѽ̺m^Qƫnzv'@r>8ĀX(u}Y#J0^Wq+Q]``*$!$Akj4q1$2,Yx^c~6'+PM]ԢTԭ&jqDbw g4M$TUz>:oނRwvԷSlj3}֐#:HxC4bcDـQΏyqGޡy_*M+ i^!%߯d)njZẴZ: SSQQ+Vv;p'Oɓxp:*KQrW 䋷 eאC/2{(0B2p#µdn}$}R!jJxruGiŤ Fxzy釸A "M]*b}F, ez~-I?ۆK&*!-2g4m΄V(Kq 7pwy-}?u]b Y;*ӈHL$@'[8V eM^QF]ag4k_مdC_Z[J,n<_sU:wѤi/FMBzp =]} }Kx݃?Lm.K)x}BR}D4=a;JT^{xqJm2kH2`L4ra0k26ԵL痆 = w+t-r2Q wQśA^qx\W5@zlcWX9KJ5}d i(n4+g:2ߺHʈd? 1ec("v9>tǗ< C.dEBdq_JFnar+&D|7S<–O52R}Tw {[!PM"pgnpm.n'yt!geElC2[s롫cr]\Ȳl=wY77>>n5r(UM3oOp#XdoGr <cZn\I4y(  ]*1GLxJ{Dz- vŰhIf _?sC6YʢrtR@쯲]淪흎sQ1簡1 B3WVg d]vN7£H"Θˑ8RVٱ't.՞]-qr(x3͆5[ʑ+ݸfZ':DdOp)_Q?~zJnFP&@D > AyMQOWĝc ~{SMkۼ`c/k SfR]M1,9 < %/Kndq#v>'( #K.XF!f)lͤ ŕ1FkPjcըH2konn+;T, ` KhRV:*ݷ96r 9mES yg8YR ܂haȣTԇ cDа{sڏdVj8\ĽJ-{߮={10|LJqܢ(6[#U>,o#ips}s2*ʿ3=}GIc8*OW}@Pbذ2&C쟨*snZT(`ƣOz |ءl&^5P1V,8 dG8nZ"a;CZ_)r'j0{Nl3D+ŻX@wp _~bQ&X ܕ|-WgӰ#v(ȩ+Ak3yI7ԸFR9k6 IB{ݾgAi;w¯)#D5'dϓddXNKNb y.'q#{PZZ%nXȢq2M"wؙ0#0<زDh2o[}XM! ?A>+EeM ~˪[-V#Fk1҉NH;ySWbZyyzjc,^Π{AEUG&ᕰe[Z`F I}y`/`LƕJ#4m];"z^C\XT~M=dd^&:ūّsY nlyUJv]K$Ċ0#^²Hf!V S0[yNodouX젓E1Orgk̐ѣ8eFI'/}/BeC^i% Yf ZAZɇ:5XS7fxnTvLdqw.lkiy:?sQ0Q`'ہ4n}껀@G ^,6fqj'<̵Gg> cQ+(ˎr;gILHO@Ji<*`%F# Dfs2NM뵃Y_nMD_y#pCG䯶w`fdܟ@qj.K6~ 2UNG[ܔ/ 97\.wLȔl*&="&j-İ8C[mJ _^Ss ۆuҔB%A>`mq\q\BCLC?!9, 5db^wx Gc/"nHL"c/!MAm_BekE 4[ZYyxO)tj7NtJZ%Á8`d9b |6]y+/ 1}H@ χJ.9lVKFOZcؔHg\}7`]1!׸*H,mXdq#]\,?STZ"t:i(T;;8FT{\,*|ңLH#6mVIh)瘲욀8'g9`piHɂelPGF=Z - i U$(vd=T7 qX?ӔeOMCe+Џ-QR h51)[N$[e948G3~dpiDMd&@C@+v~?|iZ'5'TUoO-jw1ٻ2ڟW|_$jEscڝjsaͷ]v| Y2X~*psrXIu(B IxzhNC)dŬ;mGIc}Vo<yr 8+=KqwPC~ w[͇~G^輍ǺUS~iAp!_i;/W&mmi&KoO$.?OՙHR~ܯ$uYzr };xV÷_+(_jMThעgćwGg6=nJoQoCrXYn<3,7oW!m9ž]cƋ@o>y꣣gs,*VEgay< )T﶐ie7n٠aΎ0w_jc~矀M䮴)j|d)2p\e.uO;G$C7pNEwXg||XCXlD i0j+1qJ 칰[tQݩk&#5SC+M:F2A^qږX{ZOz < ۓ0'z>0*$K70_S1rVT|+k9NJX<ZǘςyBܙ?vcg(YDR"O^1sNPмy÷fN|oFFŨӫi=Bbe"fc)#XkYV@9 .:fD\h]U-(|㨎~R h`F,bjRR4=pg6˾i^4YQ)LoWʭAa N2?>KP>s$l)v'ES$E(~,TfeN6= Mh VॉOE4f2уO-N""C+K`!)O9jRÛ+w{Z2ݧuٴP6f{Cń H⍑Ŵv=ё"%{h[spWw?˃;QQxbݘݦxxZߧ& ?,,qaۊ x G9b;j#ءи P|-)zS*\~ݙ0k$IWȴ`:w=в5 p,Fӣn2XN8>+Z6|u/%\ }0 }z{ eȌ8w%/Š-=g p} `֟#P59^_ .ʂү3M`Ew6/s^ؠ:yJXRCIsni[7* ︤4B5!e 1kbi] ;⹀2s"%}/FH?DrS j kY|_PVхY9?UP6:gtZ'{@1w$GijxGkkb:EsxyW@J2jBeF:lfJEgU1S4+jv[|PG5D X_*lFobrvgWuyO{E|TS{-2Yt׹?<r(]ߗtox4=avOJʫ<IUnŜ^aUX. ](m-QuA1ؿxެ8Mù[/ jgH :"FĤq$Epm/k!S뫧CE(JQ͟TY9gvcSʬe|k| Ǝђr\cbk H&>V6'X@m5³0.@|ɍy%O)t@ lVm8jF qr3é'js.}Ӭ\́wf6I~o-DscɊLtskf! )eC jAu4$usr[+ rB%!ђWGӳի7w*eHX^ f! ,XP/|2vW ;Y+a@0Dw'%vNG/Ť_sc~sDaߢJ 9'pNg S]MI~"~;]AOXMdP,}*š n g*PX "/}/:>ݝKinJ"՚-'G "ci'i#^ب7_7&րTcYݼ8ۻ#{Iz3#=<{Q {#"2yĂd:"H*HkyL{*Bxs@&-efm5dg@naǝYi2o0^ sqZ}P)Bո"fP;<{Ggd427+Þ;Ŕe>cӶ+!zOǔ즃jB缻BDٻ> Aq'F1tI`fk b4\9!~- L }xin*RH阍kw:?v3sjVzHMձvզБ\j .hvJT`[8ɷͯΜ/t_3jät: hȔK'ޠ\E"p1Iƺ[Hmk-fk,Ûe>F?-!u !^a吟:4r Ӂt[<]%Z>M}G>.Kk_hH [>I _7ǘ6"@:R4%$~n%xR=qjZ HɗT,qy!ounOVªh=9-aj=&p*-Q͕rȇ=%J8jt"i+<vz!&93}LvB1Ks: )zl>j [ӡf+i>Wi8(!Z4u|)E qV͍ -m޲• gE7cTo ԍ`j`Wf\= mG;~M1jkd9Nѳ ֆ 9fT}3<_jT;0ZJR}>\my5|uSMF Ǥ_B͒m3e1!Sϼk&{QsYin]k j6|6Xaym˿w*ZS;@|GpѹI2J>c픋}4+| *y2ŔHeu ߚJ%Av 3AmM þ>J&E)L ,]>;5B̂O$f:!BvN' -[)+ޒ>B,rז?Nh,wI3L6睙U1go̭Hg6ʋ.\iU7\RjzaګV繞&) jC2Nj@XȚ5!aLe|lcc)f]S%% ጿ`N*wW6>hVèvgel5e9s)a4vO|;m}\x4FGx6 )6.8ڐEЫsz/ <6/Se蚋҄w-sqҒ@CZXPH-("w}@e=7`-Gd7 ATG8PXf)GśV80E3 -?Rt6SxyO=2G?aPµދ>L5-=G%N݄lj=E>X,Mhcoh}Ƀ18pDN`Z'[1RNElFB5# qbEg) |E,q̂K#8,,\JKo=$8P- ɀBY!M~gFɼ|y&k "EրUVk.Z?g622 2Tk{ycD]]jnl$?z9ߏJmR"ld* TV}AŚ/lHgOl?nl}*v5(#.ؿYApx?V!>Αm ס'~o0's%Yk+b8zMe z Bf/VӳfxFKp4Su–7kV j͉xx/fٹ4V/^!n/ sOB5c枤{; _t@7עu̢=-#z*kH9Ziq\B\ ]ֵm3ZEC*T b$T1>2?kq ]$'nH'.Eۚ᧺pzoTd]EkxDɯhP;,.ȍco="/AyLxMhřU@ =]b ˌxȚs鿣 u09n νJsYPx>tjds@!dx][/)Yv~;G||oe InqSaqe(+,aqS[tlJi;☝/YK^fuL0<^/f s_@ "Vax{׏#DD//P雁an p[I}TqrVӬAW]<6[a'V 73e[nY }JZk1:;Dlx+hߴ q;L'9%rMqwn͕.gp%R؎es< 3Ӄ5hQ.;(s m~/%̡Y.Ƌ j=drPjzC+Ix} PN[{F{&M,Zpĭsġƞ 酏w LdF#tN#t*X~΍iέo2}{lpF`ߣ* qm(A8|#=oS;MbDr I$!ɗs-{0DH GU vHql )P<=21 P츙R-&nJyO7 "|B(aȝ:l>1*-BHb.A k~cqU'ZJ2 8+ʗ}s7KWA:}<0C wH ]Z\̈́mqYt 2AUdTv:w̷ im5k4?iqc-ޘ'';*!iKNg>2!2 CTJxۭ~VM/VCcxZr|p6 39陿LKGo!3al*fСʣ"ɷDDy5_kB=,^zQak{^45t!ǜL'sYcf9)pfD]aZߩeDX2t6I *}t=z %hկFf@Yyƀ۾ wGuɨp=Kf8Y[u=0R[C@t Qk! *Q?#Be}cx4*Sx#$5`:hzL*x`? aB8CQkt#}iA@C^QW"-kn{}K@ۏᡫΠߏ JkLf3Eր4Fe aLZ_Nsj* ^x:|w^, /Au?9d^ZM ߈vsa𣒜Sb5PdlV\!;-$iO5Cƽ5Ud8pߡt( 0CDF] ?Jmя֚ιk☴W/}Dy93iA.H2=AavSXY '0`PfV(aI.#.+e+TɈ4_f@w!EK09(|4edr; :쇲)eٶRn1.s'+9V9,@Ecb@Mrm4 hGGg Ki&p=epj`FեSxXB;s;q+ԥa]a5e/L_(9goJ;j}yv\d"ڙR>Kz1C7}Zk.d:vl!)~JTC]bok TQs7A Y]GI8m_WST8V^൏j\ ~;c8NZ\ƃU8*gO.TtMmw]&?UNCiTu4V;tOᢂ>FwL | .qJy٩OD,?825W}tr9];U|5=n1=0_?jD#c; qv5Punĕh&u P8ŴC8ZŠ#_Ħg1 ߭F*&G0 a[anj&V7d:w٫oE%_E~t4i}1_fYGr_pfK7jMu0HĂ2Mhyz2iL_8IBLN\d  7MŸWz1gQ`[h @%k[H(^gH"aBHiCdrfԠURaStxn?B09ә HZ ԱʠFዝRLd/ :mw屃A6Tٙ}벛۬4L\_`߾TQ+sDH>ע}܌%R?Iy[ӹ{-Y/yw+PRGx2Ir@ =aA!L}^QqgFO0Ia6CMV$u"Cx:|mvua;Ƽ;{%ٖ +Gp|m,lL,˯Qԉ5.=lo/Ž4@Ⱥ q`ƨAb%b`~QW6Ç{!(#t*}?mxh=Z>qZWR j~41.b=4kH%Vڀ 5RQVf5Oez-q^xshGrbW> 'j|cϟ{}^iާ>KSȿ)}$v%85¶ɣgu1/~|I0v Tp%ic VEAe4w fWV6 jC8J'6`[`Dപ=&haL⬮pz-w8DO t)MJf9mNmovA1}K"Nbȟ/L&/A} [hk{QZ0wB2lT;Oy!m{U}7ɢ;ؘ8vU>"o15PB]8Q'6y),-ghI PBME[w}?slƨ ,a2Kî #Pg5P Uu șSu/{@sr`陼?'F%'4H2NK5`B,hg4_j@ǣe%ȓy벟i;b ̂bGaqOU7~t2ġx#-CEolbNQԲK0[I4ce;,JLka,`*T wā .NUc)P |"!k]i̱uO)SERTt#(r &x:T= }b@ ZyR_T2. JIdzz d P]z9&a?xtWG+ x7\CSj7ID`aO b͌+⇦1 ppx$ ;\K@J13d @B &|Fa_D*qeswJ =]ALF^lN)dGl sݗsf+7LY(1S,rA__dʵwܿdf"30|a+{S zBBDB'5<>C_7,>OC~5I{fAWiQ@H+ʉJ=_UfmK-q̨Nl VH`њYK3jHg`M@oV.aSMُqe9|I`y c,֋B#YJjZokaSNg;5е6C~\-/;ɳI7f$,EVCp+$$~1T6T+ 0v! ހ(W΢,n E>@mJ mf|:?-66iaOHEdܼE#Cy m;Uk9d \Pk Z bS*Ù,ņ9rv5;/ۨ A.[Io Wx>b5};˱fNOXwZ?|qtbrՇ"V8I1,sӾ%ȬMe:.LV}!0vB( 4P q(VHԴK5D+j#"p}4fp {&22!,x4Qqw^Ljx, X}AcYIJD(r{Bk9&F4 ;JXSPKOe/ 'hч'e <Ӹy߀.xN?tu3ۋn- 0Y7n" N33'dyms|`h#۷{ ͵~3¶ M1zBw5ia$Hci%3"JqF8lXG2y6SQFVhHIS4?ݧ\~EwRsx:nkmV7BYRq  MNAU|uvLAZ:"=.$va?aMqi /ڻ'2h%-8d,r@{DkT8&bǿg# ybsܣ ;zpn}^H0v/\1]tpVV0U-ű_U$`ȤhRݭ[ .nn:r;کl#їdK[^}t+F i89h`mnҴJ%p}Of 5D,f &$#x$Xfr(i\Կ.w '_Fm(fM6s~ӅJ.Ss`؜s4 /̢LBMNDs{ߑoNLx1&Syޒm*zVsGZOtWW /-NOoZxkc`cAWT?$g A/lOK{Pq>=#g̻$S3&q,rOb]"[ʧXiu 0W0')X<]h-YK07R>zFF?l y=haY~im"~41.d۹lz᝛A'WXk{Q|dьT(q,Bgz݄C1Dd[ٯ}ei,rDnJS_[R".ei|5_xk<7l L ڠs&ܠYs3ZPM^XE-D@0M--([`̿\yPRl{Fh,G`^qэY)9b16fu c8usfmc$mpmjcb5Yq!"Ɔ4g_gY= (fY~Je4"`t@L&qִU;eNZu:o 2 xđ;p9Ai=@1{٤͏J\xcVoגJE})'K-έ| Sle#'KHоN7 ;kY$D؇;fOwPG(z컑%hH U?w_}P B_ڛyW}q@nRsַbEU.`9w|+{Js qcm;.coV(8YM5o`;Pxw^W)`TgZx;I]@:k=>(8\좠gSŢCT%x d?ȣ&3RhJ$J}U ̄ %0&^J##Wc) x?+43EwA.-ssGbT]%\ -o$]uPp 6bPۢ!Avǚ1/mmY1|cY@lns׷*GFDs1 pfC$y5zpl *D;6@!>kauReˌr0ǜ.hN<) kbRH:S3%0.Ӎϔ#\GVĢ+1~t ,"Y1.J$n #먣Ga-ƴ,[8AR.I]Ƙ*7J}څED~<ԲbB[ zz*״Oxn2=\*K{D8n3CXn2bO^|5_Kto<"En\{֦9\. 4=\:؃6IolowDД؃h'\Cul(> 2"7;W" @hvO)8*ipFےS&&#EO6uLPT֍J 6K-/7B*dY݋&>-^@ifbR_@eQ6Ξ3]ql.!6>Xڛ? #yj5\m?w j|m²qmW}'Z斱0;n=9GzK"ww ]}ZiGu}i@֭צ+י!+,M9Ѿtyl^X2}G2FT7Gc>Y.I+ `#C!Su*wGanuM@QqϐQ %Id4Z6Ak;yPwk* C?7}yȪjxJ_- ͗ ,Wb>IP1쟵:ĶuH*TaPfSĐ~+W2 2 ?8&C/g7R-jtf<勹8( [5WBMyoTAHUyFeݐ +kXf8RqDڵfT)T!i kVD#[2}t )eq@ke"ףm~4`3Qh8V%J4 Y͔Oȿ4>ځC=}X3-"oYg{%@PsC,1W Lc5p4J0"u}Y!rC9u!r1_ĞIz{bF+1z0*+I婒[4ɞœ |˶c#MYe]2_ZuK_N_K2A3紳4f)խKXDx"hHu94Nr|M׈Ǒ6a1}38`j`lMri-@PI5'~իKod'@1N&ĥa`l0{Q=+C#T3=n50 S@:^Xuj@:[ܘ5BAWkPT>}I?&ʼn7(aθ_5TIFğElnH [ecR:X#Y]}oԄ +% x}DEr%p/K֙<$2VbCY'Ӗy;l>kؗ:X%:MfiI*]Tfȃ$8ӜjcO;kDK̋Ooy?~/J[ùoaؔDB$XMЫ%vKO?EhXE:ݺ0GSZXgu% !kqb9J<3kD4];^X$5Xi(ϵB_XduyZc/w >^HFJwN.l^+9iʝV87@KD|³E>j<@*P;,CYίO#t@7@c̩ P4<#zтe#.cB>>֙R#t3Yn퇪vKɺ]o ))Qx؊9uʹIMnD5ǫ4&e|p{Ʊ[j'1#iA{!,Q8{4:5;Gn#֥m g.¿~~T$n5ʟF$[۠/͕8Yjj|idl,lgF87Z\k@soz/`깴 ͨ9t4i9@Z<ƆWYyjIR剳=y:k!xeL ޅdc[> ]}$k Q#jƙ*ݢWOD7W\k9j{b]*sjIj(}ACޔsfbF#oXEHI< %/_ |fb84!b$ْy}ҶJ/L+zYy_d=9o) K\|%I'\sqB&X$GR*< ;U(rD\ϊb@;n% .R2&vOoe6{Uߺ+O2=ߤTajl]Orf c$7]yhOm3ccfs cekk? \T }[cqs=;4&7& %L+=} >:ġ6cU%mTt# ]A~!8*ϠGf̯=E.L%LPL66ϜEe(E?xB,ژV% G@"Ђ Jm5OqxTD TSDY^xDWJKFv1|@2%9CWt*i°B`dq/7S.场9rt j豣CƳu<ދ77o]Z S@9K1~M."[arUiNXwxȶTX"d  I@0d >B+HMD ";pX1UhA-\S ;IIG^|+a,o\)J-G "|#8 BnUP67Jf?\Wo:Z^Lĩ \:0&RoEZ.rV~cX(i9?Op1֥?EwLy$魓,^{OzcΝ$ Y>^zXռx=4VZ =þ IJ }Iw&Gc$s/{l/NsD&bZQU3;cżEQS:p`X9ϮZ7›v^"ۆfNQyEgċ|5˶^U]QKEJ\/Ik(s촍4dSDf 1਺"Q)Zd}e6+ vLoU/>5dmI*@ӤzӬ>m}j.M'6 A U"b_FkI*` 1M&xZg=+KܙF&tSPjJR%)>0 $Tld0>ȋ`!20[2T˚M$NJL2B2퀍Yy+&p)woj]}փ(#N-! d'+ ֶU5^0ǘ9{ FD2>F}cF0S`@mR۶hv~Vp\@acǹP HRX>3}ySh Mr/ǯrΞJ'}3'1 gb?$oys 9 ~U1t(GV͑j=\J^#iv"gy jj\;Dcpr}ܺxeĹq" '8@ms dR4p[yvEQgP-41qYEՀ(r6a<}7s|@GG^xpYγpT[_޳ raRQ褰#:mp9=08M ,]8E(~TB**zԾo߆!` ,#QIHpr⌰{f̾ՅvP^װϴ עTWT_ʻнJDZœë޶5Nu=^ʂ }x YeSW]^Mʐ2(QP-tHJJ!('㪳FZql/y:3.blgCc`X͵+ RGcI8iRis;+#^񛃥F̥rVVYmq1[/OUAM2/bNIPcc)&{A__pk,{n V99.VAZmݝ pGy98JU2ŀtW6!䂿L;"H7V ]0Jq5-؍So_jCF1rZ4E&WoɏH3Gݻd!AӯlkDOKE`2RbMEY4B׊L60xS07#2N1/An,5(fʿMU`H>,zw+PdOa%)b eMx9 "#uB¹O8]k:-Ǯ+dSԇ#QcJ'ShС<,;*QPuz,z|wK8J-L ^KK5ZqSkb4|ӼC0C Oуt|4_.dC*ڧaG6uȪc&j#a]H=s}Ht430 dZB!JܕG^Ct9yQEF$& v&䳎h& ݣq\c-ukh\Ns 7?DXz8V _敄F|;S.5"8`Z'\R[>d)6q;2N>fHq֑n}fR@S/F `ioXDs2d;H?{mxkld= F]4TM>es-׷!Z#av3 [cţQ IbXRYoT@X܋#*.>2*U_dŴ5b5:VI 1suoཅ's]MEUM7&-Y~{|kd֝mV% 7zL&㉔z8aaaxEtIh LI$*6d,' E22RvEFU#eJRM]M JJv)s7wi0.(O ϩNN4aVT251?&.J]P!>= HA&X2G^\yoW7T`=zءM77mќ7o(QDJ,ޮ [IPj^î G|򵻁ɗctNx̂1d [SaHBr7߰wgM} s$;&.N`_OܮH,;TN-SMa]UyEeI)c92t{q{yQ/*LA=.)߯BhqǛh9T6>0P%YZa3}ƪqAok0 JPVlS4SUY>bfpSMHxY-QFb?>z- y3l8wNޑ'N&1݉+) 7zT1@N"G/Gu2~Ä1~ b$Qp`/3`{p&3"\+]m,U/naJ>M6j^s5˞!Yr&%m916ԭ pׇ_ /rZ Xbߜ}\<r/_-"#owRP,h8#Q76tg,]R T m#}>crh x3a7lū"`*FW`6++6cQ>UrCߨkQ1U4>)|)ܥ3)772wrdp+Z$2q Ol`>+Imص(Jx8%8Z+kx2) rtW}5uR0Ieي {⼮b59XO@4EB: ]9.# SZvc8SMG)Šs%\UVyp.ɺr5m'y|8o$XTE{$nlqkQ@1sݰhbYKPBnQ#Plڶmԕىx.ʓ@fyGx\܍{_EZN«XUcXкfGce>>KSwS|S,4ѩaq)J^ _l oP ~y/Tt!>*hJn+5UZSaS]9,Xƺ&yA-JkÊS2Sfe DeR.nuW@6VVxyzި= κp$ - ;pm]ܷ=b<Yן n$#,Ɯ?q/7d`JuJOQF n@h}]%f-H{C3o\l{\au]kU}> zue N/@;H㕴)Fr+fU\CHZ$` ?ƿm? RZ8%`b|`\UJRF- |ߘD#&('NE[yW.fwۚ|W3 -od<{T%!nF !xH'Τt<=ayL~%uWVc1^}p>}GF%5Ŀa X jRZ\t[Ei:2 `p7a9nz C20Ǽ/$mp9vuO=*҈ۺBmf7„s k~^lj%7c?UgZLhؙ%:2gl_^B\P,Gqm kܮλM鎚`oy1?&*T&JPvfAs2 pka=2Iy\-x" sBВV1:"ێy`ʅ{-Tn~lY/f`1 `3^Yɨu[h:=6sձNh"e掺 'X-{ _P*V nyO{d#e@ _T5dy|:lΟdXL,=sR΢rW/>f._^x)h{Mћ*1p-+[΂4/R*ш)^5ݻrS׭kȔFrav?ҟV$=.qT'%q:#%̜k6 ~];=. LJװo@@U-vi ffޒ!f R.%MzJW~6&py:| =  .H{uc*Ri4PHyӢൠRRݭɎB{VzgP(%?!ݪ4IHsM7ͼ)SaL`1GqOd81sDbgF"$2EcSqe;k'DR\9+l2̡֣ WH"zGrƿi( P!TS~ZO~͢( J1'#K*^cSĊbfeͽe`- |n! ]3&0'oX8q*ƪg!C5+m3rGY޾vd L%ϬA&'ͷ>r7ڬgAŸ|"7\=k`αꪈl {7Tg=ٕbBȣ$!G(:ЩfF6C$0=xQP7z5Q$٥g4&)vds> *?k]2&/lI&Rc'K )30Δ++qH5Cӓz;b8i uŊOL-T1ex IWsL!봿q{॓{E8AԽn57حM]UGo[ȥW!Ȝ=*Я?}p YwRJC8T}SP2RX5~yƒۖDO~IBc~_"9P2e_KMegOpVž=&wM;d_@f;be:UQiy :I0O#K6Dd4bXKy[6AWBԭsJ#yZX7q ކ})h-2+;CP[Ə]dbYH|o%Py9͐e\>8ϼc9DfLKApA) 'mNxrgd¢/Syv|ej\ؗJO/>%wgH kh{r%ŐwOU};`)=nQKTVo[XT4_9a~<|ƧfۋrmJnr:>!1y>7J$M5~#2G}c~f?a(F(&ux`~e)>_)K.Wu8`Sj*&}6֢mL\-5anTĕ `ە2'[Xh | q!䞲=#>iFY\v.i>jF=gl{1/G>ePpmN1† @DAYՙ݋ ڹ%G&Ot@'D2 VF-IUx>_`DnY "_R,ʨ2ԐՖd#2]ܽ&{J\M~᷇"GnӂXp_t-!(%6ŊYJFhc+L1;Gp Ͼ0{$%4l ~Fgw_c𘞸ϥvqo#gA?lb[Ʃ;sh"pcOtWiuu񑥆p#͘eFI 6^rBUw}Pkl4zǁx>i-(*T^}#O^ jӨó3 ~c2Ɲz%f?|<=Mmf WVd\yS 2CL~Xaw; 0ea*okd@x+FfFct]AY<4>v/0:ঢ়2&ĽU:NW+^?,f0}T{apݼ=n̆[ $Wb@/{B7{ԉ ,me0Z-}k',8^z0,ծ$sسLXv1^]vl&|Y /12zQ8(\cଯS{Cg6mfZѠ-qBT;AweCԻ8ӬxRuXδ3EfnIB&_3ňdw^b_혊ԝ^8 Jިs뙰ϒ!⚄ZȅL:4H*mOηLW,3\ovqG6VXiRztYN?~qe<P[Tw7D1xзd{j i z'0o#"/k ǨirmPXtg0n4Da='Vzj⑻jp܀6%(-@ V1yW)eIڨ)~Q63fpv.Gpbdе-bm~w)S54We Et{*}Y(SVG Cb@̾›uY\.*7dffƗ,CG24s#.\^.INg=l+j]0ٽ[3`Jj2`g(3&#Xb 3.^ [)s-C/6zߊ%Lfk_Ux!'ga˪Y9\heK,޻=~>9Qr&O_)@9@8M0+b? pBLPC>E#e|Ƀ;w2B+/x]g89z2SRegZʱ2#It|^aien m#~ǔu;Q'b9)`H[$4wO$tl04 kEN}W`;6gm KqqU_uNHqcg?Vv| x aj 8 {P$ ǍfG 3?ZL%* \bKo?; b)ׁlyš- hE%()zG[1ԧI~,Lsc!f=-6]+,kka(`: c"jXs3퍇 iaГ1P#ѫ֔.)03vE kh}2y=GK7dl̩6&Rְ`׭kƮ v|)xmA nCU+{Anx̤+?m]pd)z/`ƈ@@TxԦy' ,D;gc9.]p%F"Hm cMU +]J{f1_,ϝ1bSK/t|D]oՂ+m1C t gqB(U% mc! LB$%> s?q bd8&Uj9D}-)]'m7ƄLZ}csԡ<[+U&HUް\O Ywi8^"RBͅZ;|8/?_`%"d@jӂS A~;gs5'$.RmWq--Rџv1BPIڜf%iY|㧤ndUUF}$c4@^S!w`kV٦Qb+ OՐjTTtINW꥔K*19P0?40   Ŏb1m2.ژ\J)|z*~WiJՂS=NVr1竕{R:Q0[PH.X#Sӥ]PWγ znphz.m15#N.C&.G׈,j;RaUտJwRs;}u5 l+3gMR>ni=!×|;dpE)VJ{s*;6#J~*:oٜW& =R|$Pm.ꗶ7+^r'jמr1 b9bK7᠙=QIq4hJj{RWM ) ޒݛ2ʹUPlU'AԪRFw45z%q+a ZA#V/[lu1D#!d֠]RBS2ޏ&()2OONe|_ٻ#+$]>\Y X*?~*O9|GCĉ~K^<] gVgŦ79 Sf8"w}D?wosdBNp?hO^[?G ^`ߺp^C\}slg5%{wOE ˶*mxXtT/~D/v2=wFX)Xo[?\ s?~ j>T8 ^?Q 9X |&CքjQMX#O&`L磋ᗕoFI6RvfoWܯwp 9fyWS@4*eN(A><ފM&+d5"f<)yrPuRf)`44"v-Ofi`qfASƋ7ߙV#[1J5gwca?TȎs) y}ɱ#[^̘P7Q>Lo[ a2#Xb%>{U[;Wo\-)OVzK]]ZDs0;a+pŞc-wl!eKɀ´~_Q,$h4ߞ(b= 5t>QJ<6&$ioUK]& F{hݯU*,> !4;Atw͠|X|A5S꿉ǙBw1\ՎT*U]o",c7 ,W_jYFDCJNZhY骇CjBNRΒ l on3-%Q!nNpPf6XJJiONFjOt|0寵Aܭ xBBMHn7e| "@Jutʣ=(B?؇hEfޕp`_N/2H Wgc2ʫʌ=zRz(zY:ދ,54( VxJ1 05|x02X]˰tix-.nH՝t;gR+!˃eJplw.\J7x!I2ad€?磐2y/JQE,Fm*ڝ۲}%U]itQ4LGzw_'/ӓA0DL*>DW| _N=J@bb%ЕsQY(SY"0AY+tω00B(Xn$na+O=}gGJ ʑ_&Gݢ:K#>abH^+mlmO tӗR'wq45HNȎ;Gw|V8%c0 )mT ]|ϳg3R]f)حqFx)ېRr#^Om)519:FQro :u$  :GL)i}f"OtE$ѳlEV: 5 bfJraڹZ;j L2jT~G\n&J$uw,ZQTy\l4f(bժ-Uo6br%.LDT\DvӢ=D0c#{uYB7])lF T&5z fn%9c J9hfILϪK[6(:v2)Ձ:)gXңgS̀;gz!ڄ1&zeNЖZCK]d]-&]FdRН-y0%ޕ:eA\(H8BԵ*&n*ٰ3ܙC2l*}47GRuѸw1I~41ϧ°L|AZ$g)~@+,9<zʜ^SUJbn~ %eT'A3= al|/&Ĝm?2FS5VbxU|-"&~#H]EkHhU1 ReaDi²8.Xr 钵UT֠t誳i4; l xR( !66?@[Qwܸ>t䦔]!,`jU5nw[G+}ryn ^S.O@ad7HU.bU z>/Yel^Ej<1KUQ=,~Iy6>8.ޣm$ cH= $K"Fȶ͡9[1%7msphH017\[SBsΠ^rs a_@U>po2X2jD7 qˏ͏:xXZ sEHVFh\NSJ3&*%/"&WSؚ4S(+mihj'iA< ֒90eD?h**V>lZ>?f;hI6s1Yu9Ji~]ٕnv`[t>oSQ[j)1U;_\{΋KeMt5i2"$WXJ1exXRW90"xPaFBbayZ Z)&)J{;Jr06})ir( Nq5s:r@|6H=rVN00x_ez0WQQ{oiVN0 C&Jb F((K7Pyy7flJ #A\1ٹBJݘlWQs6h%#C;r…>"/6K{_}uZMV kת} ! T IBWyg^<2R΁Xޗ^[-5B A}D"\o]ӓ=b^⡼:$VhZ80 (1AG)udP[Gnp> T 81XPSN[(۠%dŇ)qy"n\w(r);HpO1r%k@x}*$śwBiA# XAt)G&])W [GunjRl4r94Rр|9l0"#oH?on=O?EpVzA&,m3ù5tՎaDR {@( ̑!KjF; &)MWQɕOr .{+VYǒ%̒F(QӕZ߃j}e O8i|_AIUg ĉ&@.VKsJ԰Hۈ~5Fyd=8D<xoS1e_S?=םbGߙҭ2U6j&P[KwoZph/Q;O)Zbօ'Qen%u驵r%""9v;WHJCҤؙU|iy95Uc>%; Kt(%9H@w;EhjvR,f͵> = gTr V:[gM*|?&OJm}KEHCW2 A7,VZ+kdN0쪮9gJg΂tצeTxHfѓv5 5o5t2wj`iN}9Y@H2}Սs!-qtoR{t$3en cws n$ml#,t"m1~t`f;,V/~쏀}Ɂ]K<+_O :.?] b w;qێ kǏoeexrDKX{$/"uaBs #)?f19pD`\LEO#B |ϓ.gy|lH9bxQʖ8)=sаS_zhLXaFr-3i”ZRMޜ/ڏB+tY`UW.uʥm5YW`|'7]nEM`ݶ}TcZ)I*~ܜ8@_ &X1h"ZSjgxnc>.*k&RUdoq֒j&leZM7{3%c2.3lL_}7hxmOi;/f [}'Bdn Pdru )rdFJJ)/ QQό@V!VX(GwOδK(\N%fZ;x0D@b&{]Z 8VV tx¸Z^rVzOß5H$j|^bbwF/wo{ qmл ViO<YyXM"X5M:6.g"(w2PB½dcd <+Ug:L[ G%zJޖH6)vB wҘt"Wܨ*= 'M{ٷ榥)G7\b (f&;Om䃸D7"@~ᄊyzJJ՚yOw~ǦVM@&dӬLY?K/"9:j}-b!ߞlI@j4Woӝn0h]j>&_[h׍shJk#$բ̋q *=w Elm3i7 Oef!g[6doa\B 1ŗC/ѥlJs>^\=4ΐw8=SÁR?"?Ex/؍q^X5P6QlEAsrevҐz(a 9sӗ#ce=(]Ƅ)RWVcyg'R"ɘU*";Kbd,oX0%9,toiHAejL[V)N-6ay9?#TR[TS^Rdơޒ&- ;Pqٿg z!Jq ٸb(c6"K sK`)UM!{p "(~P9s))vk vor~Z8@VS2u\kw9"qt^lĚ3lZY&פX*Qo4xuVX% K~έ|kٺ!;mZNk|!M7xH KD@פe E(C=ȡ§J'X?8+K^$7 qJ`XI¡ ƞ&3cMPCp8I7jj"M>w>nsȊك{ =6=$TLuEv[Y]e"vk*JԚmb=Ny/ܰa'>O}yho$k;_,7oHlve`[dh,3Cσb. [ j]x Q9yPnjݖHL3hYO`V/L1تk }YU 3l==KGb1X0X_r?IvUv'kغ5ZAr'|yMeUMe&Rp5raL>/@Q ̕XW-S'"F) x"vµr\+fm=̈́Yd]BZc _dW1 ~Ԉrn/GIh u*V94V魵f+hiOsDo6H!DX@ ZGo+Rym3,g45&¸ 1׍? |R9R@T.UT,(‚zo ˙5Gbg^̨RCX PiĚ^,]$z!yk''<cj1!CԼVqwQ?RC@-KځO!Zq'H2M6щNԝ)j՚˕G64$h%$ؼix 4MIPv,F&1tqqZbl4]~Foed6XyOAz2RȀ,_')3uQ?G}%+3eIpN`qGov4`k$-XWaeҖːK Q>Hq'"66adXfGs\kE)@ى,0_rdǽA-u S/)KˎK=0ʘ-{*d;ujDǸ!WW;HdMڎ=Q3 u)T p;VsH&XHa.%4qoTRv% (}-X*zODd{Ցj"+Wp[J3trvMɏΟgW»X=!m*hN*O҈F7Uk!\;v2⊅#Ws_nSu5c_9pG}=|#46 &Dz b9Ӄ}<西;5tq2FI%3+2}u&~|cU|[g>/< 8pqۓ;{ A\7%IK=9?Le0؃Ra@j] [Y1A¾7 2Z& ` n`%)D o^w)TϢ{W7)ˀz=|zV/Fb1ЌxL'ػ|?Ky6iߨ\E6F5tFx %X1u1i7e~<)ʄIU?Y0Xzo?1rwFqGpa`b dŗ%vAgsk}{b((nq*Pw6K?*֬1[&Q1Sݱ\:<4Y0KV-)^(rQ@ oCW PIq~v<*͝,Cv 9u~U(:׍@l/LM`0':S߽G ݊(΄HJld%8եnIg_ƻ1==> abqEH$GX #-s"oanwPceo%|g셲P}uEDT"Qq${v@% t`Q>CԬ&ʺuCؒ `ab45: ݇Q lsMâ!}6@}>vt1 a<o'QXZKּPx _y@4AT8YHWAHSe_o"+8=MG$ SA3ђUJ 1dkA ~`_ %4Gqn ι.038g eJώR4aK jhˢx5yh. ګtx48W6W11B&#O^sקX<>I\*s3ۋ]v2:/oK6),&8ޢz=%tT@nNd|+2 H+xC*MuX!+c'ڊIع0pEb=~h!25@ZL'Y K}ZLxq[!,DI r|!~q!X ؤi.EQz4 =Nsy%*te 8\;-PsȔiuCn˄A120q3:jM?OYZ-)G-$eSܹDLM e%cގXG=~բhu%<7Rv_;a;G|1:v.VG ӂ+ 5#=**#RrNlb$'VS1UlDd a9&ձ(/=}!PL-m$Az CEj{x vtC2q=ER{|ܝA;3) = ̩vV"R{XH6h"@)Uf:6;+ٻ# '~n 57/>bGbi  _dM5.?X59_!3^?cT,5~&@|-Qȴ^'$/l*Pʋ~&6E'R]GMܫ`ވa_MaC5\`.NCHԶllXcȲ"kQnAʐT1-S$?4`4#hEx< ^bL7[6#{_4P+I}, 0!dd_HG› k 6tk̗-i+.5a{j#Ls>=FU${oS?춀(EQ2i043+5Bm1Ȫcy1xʎet`:ğ9&x/D>q]فFsǗd8Eb2?0y&{qB`O7Mmwţ|ٻ,Ny-ΆyC0KRTkથ񆈤`ALh;WXH?8Sk aTnbͲm!:鸾f 1fIǎ/~T;h˫#Jb= \C]0'O?R'C?E:B|D/gyBU$Qcq,%{]Y&:0wds9N`%bɂx.$JhƉ3QhBQВK"L_VH\rK6$TſԑCd=*8X%‡iGojR(qC&$W,fNf;JA1O#1.f-6a-""6K=] pp&c6 9 H0޿ \}ّHLn.E>あDfd2hmlS{nFBjc'g4@VT [3i)La(f-^YD_db}@UEBfDrW5YNNb_G.[;v!Ryzu {:|%@9hɄOJ9Gf ;B!j;m/ERVJOg ffUuﶪ`jϊk hn\jrJj2s|'7ѫu1i^b>}:PK}S3w&i$闕/ up.Rk}bl6|5l&~m 'eS)5&NP"Ε<.`m|t"v"pX͋))r|Hv_̠в.4'q*>}vG۲py[dDos 7-8w%"~r)4|^Ez8qa ;:Rn$%p`)ѥpWQUD,P"D '̑"@&niw|)T[^Wk@__ⲟ!-ү  3rn6M+,:ʙ0VȄRsYYbњmokי8o89?VsPz4Y}=@5ќݷ/E,op$S?ʂċnv';= O&$MO0TI3". <]S  M:EB?U"u21.5CSe)`7˔@*4c*nnBR IY&bˍ0휭2۳6h۞: wcU[ wxz}+rEq̏gbȵ\t rX#CλŪByhyƛE+thͅ,%a?Qמ/G 9%w`o"+m L'3IxcB7z'@yϧ5)`yng3Sܪ(qVQG>wjuoE\Jn`8D8S~qXvUc\XVY-N֥\STPdncb.K%."F8\ ‹\ʔߋe<Aju_p&vV#[ķ #8sk[qњ8`V2͟Jy} ۩{#qrF|ڵ9PrCe!8B*Nw`\sgg7t~t~Oi:K6oFp=D';9:9}ϴ I>b O%}):5R9 WPzZl`\xT>L}ToVoѦMq4xAg.r @];6DP\>7AFh;,7T@މcP{: u>χDxAB3Z,,{UBU0gzpB2|I7zVaa#hf퀞9uEٺ*^~="!:_J-;4rpnf M>C∐T=nv>O.y]4.jia߬: Z5a]IXǾAH9;fi S#40Pv`|ۖV+?@ u@t"צq:,m^-~KĿHO[oZC2k]fE.# `h-/G<*"sX%y/~IvAX-le- { s;O;Pջ $1˧lM([َGK:Ɵ ׽Z75#|0Axu޷|&(8WJ?0| *qk$ d4kUH/d |c*>?#}5=(ą2r `0*dy5k9ۏ4 *]Ƽ˩0emif":}Lh#JQ(tA޾2Th$oq1dRL%nRt0WʋKpƾ;ﳵ xPgyhmF(|z4+⹑,Z/ E99tJs~wŚ XBE.=1A4>.0` w-7cbB(Ahl]~d%Ơl}ʯuc OБ 'H?: *_.[k.pfڢBh&1Yy|=*^/MT0,'=G >:?3[Vuc]x|(~j]ilMPw#ID?SmvyiaLj?E=ްx4}ܹU?ML3ӅG8 & UcC/@ 偧c68;ƀo""O>AᆭzkC i4t٠ߕg/u\=}6ܨm(R-0<^]YѽWȼ!e1 yg %hf?:M$9DD_F5\ZMDOoQ:b)GNE :kyס%'1,bDA|f֢!/$ K \9eqDœtfKZ _M=ko"7gA|SȰPɻ[硛t/̈H?  F!x/{|8^b* _tO%m˿P~))z$A*4S@$hCeN`3!ܐt}B6| ̲q{v{#KT""$E<#\>p,crW"Ljƞ 4Mz]I*Q7O6qa]xP'0i%2H ˙* 2;h㥈*O4HF?h:z.tݚ)"Od$yzpf! b L<&]-[eֵIB{,G%^4n Yq6 2v!<[%*(Q;gK?8p @e⅐l(\n#!qO5xd.EhŇgq8RBr2΀#X֑arR]:LB+ռu۽|̭"gmlIjݟ${JVj35kL^`u4XߍCTa?"Bs &(ʦedW0_\pIM~$ovpa/\YN]mD&l$څq1J޾\3H&*د ]X=(q.꽬^i鰩 > E0] =njur>XK&=E^01)J!@7 4\O#Hahk)QDc/ү"$BTv଻lݬ;FK d>aw.DE' n-e:|̞Gts~+9\8Wg܆̢%sKz_[hNݪY (Uj[>Bi?ЌMl:KJ3"s32r0ڹߜՄVUE否., )_kc *Zh|.p@Y\BTT:=7'iEؕ΁!D6H~ _ nVLkH"yKWtFwN(jTJ8v9L#1RfnMM}黍t`2ې!q4!w[8ަ\%w7~/{w$K" Vgj̆9}Ї 3D 35̤dZ=Z7%Q-Zfڇ[2XUD>m&Q[bVB C3jl"?D< `IiNJ Q`H*O}6xBB˽NģxA:qW*{ߙj * M ۃ}J Z1(+vV$gVjPt"X(J@xb'V g3 %nNEӛ=!;{X@UdTEB*yF"!m?w(< aڥj:Lx ]N&e}_O1iB39ЊKM]$4qNwìc')\4=Imgu/8'y<;&A7O<\wGḓ^ŵ;F~dQ , :s+.vbYįh]&6_pd؀>Lcb#T~-*"sΊ4kbD"M0yv/:$LV?ށ0C$ȉ;9pVRwDU|U7(&1[7%+b"=2q;YY!_FS]$ Cio4jo${7IP(5&@ 'Tcr+5tn5ֈu!;gśwN(ӝGn\Ȭ˱8 ,t$L~K`=,ypqEt!&ͫ0\%FA, a- =}mF|_xEW,1b_o? [`(ncey(6nDYNxiC:]?( [F#S e&(LT\8YAKt6u *׿hy'h;Fn\)4kՀ팳x$އ0#'\%9g*(|_\G)>?M#OTɯp<<{q] IBP.HjK@e@-cqph+: o_QÎ) b^E,2/bY [LJ z^mFJu`Vh;Sb6f61Kߖq+N>pBF|8b[8u Kb*3WR eqP+]tV [Q/] `֣w=:X0[ 2q,׳361m?ze2k9]0\+dsz2/m h;F'DžA'uuT5p/Z?gYY}.GJk^?=;0$)i-؄-&fXf(-6"f!'GXۜH+钚hlJBvevL>*iI0@Єzf"0wZq;HZ0=3yT\:^p7יu{EWJ`n{IVbK7͌A[SaF!O_\~Z/)9yA,=g1"'ne5r.F`mE'\WHj%HG mz3ўoۓܟB"S2c~(!d+'*jsjlG1xPؕ+ϛܡC uKbT>|aOk0#l@R0W'}Z'"Rb<5ሻ=H5.NnN+% v/Սŵ"V6Fغu)Mi^29ϊ=D;;P% ֺsì]jg ΘbUvLJIO_'Wz|VVo}O'W+hj$ýV[|OsT_,Y9b%FWdo\RL ql,p2]EX2N@LxG:6*F=gNA9 yWc ZdZ z80Tm#Cpqa w_bQ aR;aj&8 kRyz!#C3P qԖo} \pcHҗ>"#*qB@yfzviu(>Y e*"cErsQ$[G#@FyfKusI*T-d];Q˵ l[bx{_f8 )H au`smmbKH1ƨ-wbiW,ZMePbv֩cx1% ?Cg wf1!("`B`g`6Xm{ȸJ(&8.i)5ct1X d l C*ٵ~q+4v4-imѺIVM#_d8>gvm19"SI*mrݤ`ɽR+|I2SJ\1d4.U]ꟿvmK36K,z_AoKhPZ}izZu$=;'[pgk~>T}t39,kEi*/L_ArD\"efϰ&O bshYFI! f >:R9n@s3 xpG*\a\A1f1٢QHcM?˥O=0,d[mL:~<>bG%ot%-p0:X[1.І ([?Evktv2! *i^[3]Eo%9w"MŝJE|iVZ)])$A~"=*bEsjg+p z 5R^3ԇ E9M?A W4+P$Ql|Xo?z79g7;=j* #nh/CF =N"kD|ۄF,\8# <:5˞yMQ-Y&6Ӻ$e̡:Qָg@*I Ss*L5Q ݷ02:ypV3nmsP3gCK=m)C˄ӸݞT ]Yۘ诂E\~7jGVzy N)xI4ZWΚuZ7A% !EV&&<<%? lKFvG3OC#A|NU:z ^^r]Y[魃źCd54!6 u!. vGtHa\/Xe՚g@[Ja/sr7E/h%D7$ ηn@L4ٚIhh8h"k۵f' -,5WOSRI :7F =C[$Xb;kuxvQAgwYMDe4jx-isj2?@AŹ:]ˑ-10vag٧@%tK2'71|L wYVڂolց/VNvMB:ZX7HD9 mHe$l z]\,-{cu8Z}.xF燼Z s'pF73j͆q0e\?Xr+:Ϸ20 ǡ~r%%D)JY-e<=B Zwej\W UVw?acNxx páe` N ͚ȩB{vUEIhC7`]?ucE0WऐllEn[ȝ4''"} H(.t{S2ukmEP@N)hW{_LS_--rZǵG]81PRb?D%IM}pIl:WU0IT(aU$f`Ux@D^֊~X G P\;DN፴0 iB`R_!?Ёi?XMhtSS(BG:-Ps9dKƩ{Vt:*nn44Cb`8f43}aY<6AtS4O`oR"+N9^t`K}}mY#uI O lwof7[!ؐu @!3cBFjAkss ꆻ '&P˚Ͳa ~(l:"ah,$U[m(j2ȵpdI{qex5rjrL Zo.E4 C5.H81pOgԢpu`:͉d8z58`gQ'NHY ;)1/*h$I Vτj8GKSⰄä$dRh2J Z~$3Ujk{U!޶-/`5Aʼn~+ov}6\Uv>άf9t/7J4c!iK g_ x[U:c5𧁝@‘X+82 7˺M %Aðڽql/t̮%n[W+5qH=erfWPA@ƣʺj935&XY|׮D[5~6Rb_jH4ķm"i *)a?E)qϹ4evZ͟zvBScΔyT2Dքohy(BCq׉K0Z-ZF#;:8Hա H#~r 4!(NH"sCq!TwM' C9;urkBFu?C eڔM{G.ijX*nz؄"JoEѽ_~C Iy ?vJndBϸ9"9r{'b%jHb{-tv^Kݬ<1ĭY9%ڴ*gdù\Ži@AQ.PE|!>`L$ ^ ezV/|l*P[s}|WuneY}FK4|s` p/^5,R"Oc)sR^aL)w|"%wG^j<jHq/c=U1g: ſ/7.WtÅWdSozD:He2#=ֲ[,2?MFe[3\O,~ӺsH2%J_ZӘP. Lk;e&$c=G(X##חUShKybSb@:"@E; Ǭ_w@1{]MTF ~~)" Mb} :ϐ/]V s} Uaa8yL,z$'dNNfYXqkEf%iQ~;؀⍗lyEؖ'j-ݑ=V+snERˮȽs6pb>>#M?XēЙh4k8֛$$ dCyK=RG )xʠG~=9Q .ބ=}3"+׏ 1 n@ye6cDƟ#~v㾋emkÞ3ơGGBuX#z/NQ:Ω{<@5eBzKTLLЂZyPIЂ TasK4 I[LF2&A{ٞ#{38*N)|"ͥD KpٱT1,>땋O 227PhlUb%뻌@-+x0,8ܯz&5xEȔ2 ]3hV3uqqpϤʁF@U E@'~ 7hpZDe0HXJ∯B$fnNvbl'yR3Vf+lSNpeM~Zn@ +_N#[Nc (+y'' e_{wAl E7]?vMTj<[ؽS8bĆm16&q`'b0![D[p fkaԌd1ݍ@;e&V 5횲1srOK?ij۟mwcǀ=1yM=YCRj-ܽ MVv4E} . |YNtv%\oG4:lV”5mzkZ; <·U}%X=8F Cܚ,JL'~Hm{2uB/`6fPѳ#]:i، 3Kf?##ev#Tj?gX^͝Bw zLJ6kh]# I3ܞ_p9+oz1AZKY2af=821wC>t(!Hqmn?}|CJ>:p1Q|pqpfL63{Jovw0R#ݒ$9 iMV VMاFx eS2v&oحI!pBt}%# m_S݀0IlC#BGSB5·& iM6WLcA’ ԗI㛷@zWN8ABOfcfjH-p2@?lrJ D,ѫF ںXt= ); "hV΅pf.YUAvj"EFjKQDFkS %XAr7pMXK0!zde| p,JWoqus&)^q~'ɀ7`c˻~HnH&g ˸_5{HTނr!g7`-է<, #Q6v{Uʨűd*x +MX[[ .lWݘD⮴8Le=5lJ8Mkn,P_~˷֟vҦq">Bڥ%H0*',[{Y D<0lIwYV}u*YBr&Mw64s {a&~֐S^,<`fyUv~;df~CfqENP7NurtHCqUA$mF?rmi]wg'ʴTe8N \Xq+uu4`ժq'G=MP0>jpfD؎"Z j(00 _nlfx1tX,BK'48"P/;3vȈ#džDxy%m]hV,ݬ (&q3iK<(|8#φUrMi(T` =ֿP Nh1l9NL%x(Hu-1}{B/1C0m紭-(O´OWp1YB!X 7RpgwhDH<7J/uժXE)#s īϾ!ȿpi}DjADtPt!S }Rv m's7ѠBL:zbEĪYc_WH \+} WVO,6bTXR97AK oIR 8kvJTN:m *X7ɌѸ )f^lmҸy &WLX!2eW|n$&b{}Mj$~oB ej=j2i:t)߉Y}CVQjhb_ϬA|c:QRf48R} 񁵝k;34c5">8Y/]TˁH^48Q݌TzbJ+Ljڗ {JL%I-Ֆ=hJ7jըr}=+;T@f-PyL Nd-QF .yIi:9^CXuݨw0ûjf WݓYtZY`8_ ~a$k#[XHn}r0Y,z3? ҚxrDnb8oA3'u#=6K^nB9f'ebYdB_%_'?] c|#8ʺȅy}nr\ru:J5hpcVa%7~0]:(mu ^ۂ7c,ilt)QoP([/6lJ(EҜ@e7{E F5dUd`F|Cyʮ:7U!xSFIwU7g7#g)úm΋SB"3)9ljrTc*7"~4*p}J5ԳI A?o5)m?d'[c ilV6sE-E 12K/7Y@ *J?L^u($ !lx\;J(3_ शt3qg*/pWHzjkI@ <#.cZ.J-S6H<<2KZ? -K&jQ nokWd0X')Ql2FZ4k fґ╻,ə;DApYR|4뎟mCթSlD,7v+ ևDzYDe J~?|s]WL’t5f-Ux/0 u2ꁌ* 4ym7VM-}{Wy^ ذSR+_)~!!%4zpR?iwn1dac`Log=GC|bSЊYC:α/E [wGwdG~M )JP="Apȏm&"n#,0%iIR#и!j6bs!܎B r]ޠE }o[Qk&I?އpD J/@^Xuyȝ:\Śk׾(HYT0U跨CJEl6lq:ޖdvχY&n85&t= ;KO4QPբ]  jT}e^BLIs2+.u"wK!d#~&Re LLHeNX| dzo:uqskK(Tqy{!(G4P9,3E`:Z $Tޓٺe/ `5YLkx!35'^\r"gx<0!+M6y?6̵8iP#(kHF'rѺ{i^nmo(xQD3}[ ?66 &BlCvp'hH+)bv㦖-N9+_Gq#kY]2׻Z^w TiPgpf6hՀewEVg9Qbf@r7g< ?Er +s>ΘsuxlOJb ߛ[Y/Oj] ?o:W%q ʧ~ymm+;#pP%t~m’oϨ:TPp/b$gu;E@(Z48^i>)VBG ZUTk"^ӥ B]WE0VXǽ}kj,L,8pN|1֫/t <.Cp- I;(tׄS XZwg)۶1*O8P#V!: gB6 !P*zG6Nq4'ĎA`/"@37آ=| ZevqSi$JbEC11; =wim\l@ePg~^.یqp${J%yPw޾w3ZJGj >ԞXU#c7\ُ$/}`CU^,xM6\Mg*BN yh6m?!ShS=XO^AJ $7xȳ>SζPX/z~.z0cw[h}A+.ڙ.Pj)c~)SD1(QMhJnB Uۮ_MUYyI厠E5Q?z?Lj%g$ PǹqAV̬+|YkE H~/a㢅w.gZ@,:kw6솵nRjl9 DyaI.qdQF:HĿXpi, 2 8Rq{.iBA$) +\gPR!t3|W ` B[l-|eue&*GPh Fߦ+*ilKMOw}u~j@Rwjjl2A o a!e\maQ8Xr`tc ft[E% S=+&Slu˜!l@ + AC:%.|QL"67h/ں$zT(&eGUkTHk%_<?XL^p[g7G}EtX(zÑ:u8reX4\X,(=H=PXbS ﰛVɕM wsưRe${S־`ya%0Tvl~) msrKh?'D29x@ExҕKL̲O􋉠Ƀc*%51 n޾ Hp)u}nǥUXY ֜kܧ^9$&H.0C:q({'}fC_("bXf藥qec nȸBS(bFڣWY>rKDߡ;q/Y[/Q^!d/pXUF1"fPYφns>>&ķP`kb@Lўg*7#fQE[P&e 9"2GFj˵̙"ɅTEXAԤ ֑Ue2Oc㷘% K n wP.n*bZ}R\P(Aۖr J,2Oe wJ+?H [Ή|ųxgV蛜`6׊?OLT!HgsfM"ت+<-8["Qy˼RE~#rM13H dת9{(`ȹwM$ԥ[V!z]N~gg~pfPv[hGʐB$6D$X̖{SD6}ۀOҢw>JDhA)~n2Mtm~/=⁾<1\g䄸~mHS<-y^^KBV'o'S( fA16XbֵaKdO>Yl'7949S \vRu@:/ ;i{P+bpf4h9 3_@*%`)o ]C+L@Ӻ_!38R~TǠ˫͒t\orM؞ Hy6xx+L!'!`wAR$Lt~4q א};'F=b=Klltҵ^/ To͐uOZGZ$hBduuK!o ×<)jPYAѐI/Ti(1 1p3 Q v h !X<-xM%WP#7ʕoixZqpf B_"q;1K%)"8kě6̐iC8ln›k 04`a"¶,ɿ)bMnFԱ\/zy2 2$#=W/ k!遠e*⹈CMS[vq\o2dl 񋂧u#H]ߐE5LD U/@q}"Y;Vp5[u1e+:9y-`f C<[4;<# W~b?i]m)y/ .ّ{qѠ=H\ʨ/M2[" ڟ.KFGaznEJ%K< @'As OqQ׋`?)W:4vqzJLU((d֟جirgI5ǵz")B<\jW;Jslt!َ䘞fQ4+wn+^2l6|NAA&SZ9bC^œ)J #C}2 e@[m+QZ˘?c.~ej]Y w 43 ۚc%q.tƘSZ@יja-6R;c^8Ɓȟ7Xe. a5qB&i|ޒ5-DVfHxK5缼4W܇~&t > 32Tu=]LCtb]:X"Ε+ ɂjwן@($Ar<*lLo7`Ԥ֟ F9Y坎k7F9vM`嬑n+Y8r\!)v` &V#շ?nj&931ZFVDN⢥7&᫴HAbixp |:\~y˂ZBV咺d}%dJ<{7۲ p=oM45 8v%V# b\b +I2Yn[Z]^ .]$d"=8FC"XLab*W̌4Ήݻ$/WOe{Z8AOES90RGnRdG<+40%@+hv.Ocs$%ΦtP3+Ĕ=w+` )p59%JM1ڊgGEC*@n wOyvV7Y7 g#|!q7 ) Heqyjeؙ棧ڢzݝQeŞKDpg c}gNx2م:Eė'TI븞uurMK{gbautյUFK_kI~4N[W?*0O3! zLD@ %G{yACe@j`XWo<[29W8o9&t6>vfK(NO:Hq*I3xUUQU/A\ouvDtZ,-^Օ1?W,j>{=֨r8 ,-PkMK9=Ҳ*>|_ X}~t+&VaА]f8 n6󫚵S&eWw-u`Z R)Hl!\9YJnYENC ƁG(X4͕ GOP'ũ%{/Zta{̷)ilڼL+ki7K ~7=?JAW9g0Zs) (r٘ }S Go;v\W("1rOp?^$Uc-;чW<>!V|*X)07,zKOqO(l5`[}NyOKyJ^$и:+?cVs,(o?ǂ:6+#E}=XQ9Uwk~񐼲S4k}Trvʃ;oAƴZޒm~Kh\Nؿ)VD2z`QP[fm5fқ3Ƈ ßy9QF$HpU`9x͢PS(b^T3o.YPcH As:B@ wun>Zq>ۡc(IianqJ8M+* C(o{ۊWtW% ko/1 BWgp|XWQM!fmW.~<䓲50 ex6*OMDnWs|NMZ?؝DOq3aeׁTo"'y0 YB+P`a[ 'C5rd4ɝw>E6I!mR|Dєzn9lQ5wM.Eniq׼DZos9D+v'$ X j]c9Jʵ F+De7ˀ79x~s XdfDu[W^/hȖnڂ6o$~…bGw+61ww E8+|t[ F\>gxF=…#CXs|t^?Aevl@\QPlҟzX+^QppG8؆?kScZ҂-F5 EG';)1^b w/@f:u PX߿G-4J1 -(j2m0iS#2q269rt7O/%ިnlQNKLk 2=BQkދ0.yd#Jظy9Dґ&KՑS8mLO|a|VS E:GUSxIKvȇhRh͙"`6rteDb(U\h[< &,eIX"͑D3f+༩f^C˺5647v LxJ#_rVx6Lsz!t$y*B9aQ,M zSBE%)kШaPծAȩF"\OS_HE'Ȏ&?KiMCb@ADi-PoMqT[*wo4_䞎^4n28=945- )Aì :'UK"xn1f .XM+HA\s=^(>bwuc FU,;oQ踂ޖ`0Ky#3Ct̂Z/ej>9XJ%-WLZ3[(xlnjd1p$:QFor!ٚ~Ԙb=8mX4a @ juXd{FIЍMD0\|eJl ~ʱ3z͡|'"n:zN ?T;$5qGmS6IkI?: TWx*pS·~êa85#$JT;q2N8 w5nHFС#ovmkvBeE$Z7w$ٮF&d2K>(@`zrx.)n4J2 >N(< WzV2]>k&qZu䡑9ZŁIWy]4$M4⑔g^u /w"32=CǂвmI,MNʏ8Eԡw]amq[iI]"x}sp1@$hګO|nbؖS7v:N4LbOSF%It "{uG} Z~obXei@ۂ4Ξ| m{ҁSr1zۦ`x?pe%5^( S5IsMs"9.Xш]`iEZLJ;2Q`/ @=[hVy;ARiG ph W^eeJ-LT81mjeM8{XP[Ig7<َsG4ƒsϦa EcTk@īȚ>px 9[Tm\Hg‰<Ĕ+:ƌق\ˮ31$iFhtX ]{gϺvcU/}͞k[)2|p4?,`!]y ? g5T/_VڡG;ġrO&ަDL ʑ:'PȄk&jǔrBG(FJk;[_'%^+ʬ. 9UZ*4ϊ|9a=dV;_H`2֥sBjrÈ[Q܈}?r+ T)jhVOqru6CD\KT7rj] #NI/xk} ,Jρjyd?)fZ&kڣI#4e@KyxsVϹyhĆg*py;[o҅D|-%q$Ohϴ)%bĢ; K1V~WHR[-}v9J^ps4}>$CU`^ exwI`hpDeN<_0Z MT6tST|ƌo(!@!?j1>_ zT?X+J 5;wh5yYۥxy0^#"fVTV#@̇˄H;A0VO.DOƖB:S3o@;-}loŊFuAWܨLmG|zkͦQ:@PQ(=ǵ.Py'o[ /I;:3,0{\w$ [u9É?fMhAi4(L Hisl$AB8/da01#< H4+ƭ_NMW,w30"=] dȆ21B#Pd{SFv7X3U:ّU|qD`8 !F,2N͏O.5' G+ʚ)Ir2|VV'7!c]X4 _ [!ZnW!-U`D`9=Tu:C{)\WRj-&}22Z㩦ɯWкBF*s5xܻ MIBji {-nC(!8Dy:֒Z4yuڹ~ ÕVXޘzDn$D #U31#ȌÉ+$U B$nBeId}fg4 Ӽץ9*X]#[00۷)!n7ßQD\TKfE)2%~KkUZMa|‚PڇN7׊SqO3a>2\.4ԥp$÷*l+yM\q`Yu)E\˂@t0E=[\Q`72s!Hԃ/,$$t[a8i#:4||e80GLplфMoc`ȰHY -|֠b!E5ӏJsQk3'$pEVe~Q5X<@: ?1L 3~W[Cj8I;/rR2w_}L!WB19睶o~5Q0id@ lOB#75$HcAB,πeGuj%yT٠L ~\{f375CLEܻgs-y-Y,0pV?^ IQ;o=d](>;ٌų)0fRMVCzf<y7z77!W7j~OhRpg+ܖܭ`ӭ~⍟wbEaDJ?KyN̂^c6M@q= A{<ʭ[%PƐqB6  ЧZŀ cw90WqpQ@ԏt Ňɏ񐾲8gAwR&? ZWN bhDbExXbahMcɻ0㗰fm 6D ݱUA5KޛWn` Uammw ׶d*ȎcDcZ>u'ТV_'= D;px,ggPrpѭH{1@Q%f &ybm}((h^bPtVb3n*ݠƍ,(H kIKwiYKD~8' Q0J!s qҏVBubp#d+)(#wrS_ -G3a<zYwOݪ C 0 @ܾ ϶JFGq.@B  ֦J%tyAڌ%}"x[2c7,qO; |/3-O;Mn|Օώ4 [}ne:0FqY!{3Ȟg^#m" '3 GudL"Qz:yBë߈ -qF*G+_SkFl-(J`6nyV:L)|Яg]zYkC717|: Olr:V$IX]IRe/w|HǗ%>NfJҒ\wK)@kݵw i-28"up=}“/>}Ħݧ 'qހyyBfzh#$48PGnA}RerޤRe*?uJ)`X(*6n=\SpͷXjSy Y]\ٵBjeT_oW3/e3;~Gmzq[,Ԅ18덏pK%B<+s-нC3{wM~Ob/{NoR4GSqj5gػC̦ߡ|H U2T '8bk s-!*=a[NN#+q<VbJWty]A[ "_!U^Kiz'thSSKg_?mO3dS=xh#cp8:Ye3"9?Bq99 ٴ- dGq92 >:̨ I0<琻^_<}7^yO F:FPA03 qu/l ,V`W/r;n9>~RL428죚<($M}ޥ"c_7Ydj:mkC+ ILD^t79`>M/) c+<9;({5, M(Iޣ}7U5{[ۤ<4_^ܲp@=x(е_ 9z )񉋡-Z8Km2Ǒ߼\bi/ڸjsU7**"{1'h~bLCO`wx*V;=i?q{A7pD\wε9Wcs< ~(t :hhqzj4j%Hf2džܺ*OkX[ DJ1p& ǵdӴgkG҈zn?_Ŝ@ FqZ_5 s]:DTyDwE :f b 8_[!ljG!4:}E[QH.=bWY/A~/MqG)I Fef*]г1cek2 ]I%GͼBvJKI8^ X^4kz?݊]<?2hzD}M3mڄ)(YkwQJV,oð}fiKR%vm8rlאI4>l1lR쵙۰-)@3=$VuWP)GE ǖZ^WI>2eFk\#]UݶqS諬D9$M@4)2cd˽ vEd$r ̶O>bW ϊ "AB8k]$(t5#NDErNx?cT+zZRN <9 Le`<zgԦޣ)c:ľl+q1I1ƽ38UʜXLOBX*-Uc͡t%|r'ba'%X~ϳҒo6f|@x㯶Yl,ؿ )- W6 )4q66F U6Ӣẩ[mvc[%p'X ϙKPp#cAl X8b3) 59l+؍B|0p5fR>2/DQ3_۽C1~F,JYWWʟh +lLH>TG3Of>hҍ \JLһhPJ~ݨRrg1аɅ Ϻ_Zp&:?io@7+9$#{pR9Ӕw֣vky+~/ьdj}M)agp9"ےP"'^Bn בgX1a@DOQDz]j׎z; blJtuvh΃I\`5~E~"pݭEg>=jַӠ`s+;xk,HS&R7dLcwYXKr|ǘہXs n,sI1z5W%%룛ƙJ8oesMEbڤ8QM 3GR# 𝸨琫Y1>0gYgi~ϖ?ޙ|dZRArh|ؒo@?{[R2kKsAk-PJ.=5€iYh(3iJsnb"3*n+Xk Uhh{aP~]DPf6l};҉P9[ϔ;L0{Fm:bBkUxϺ2(hj["%$ zxִrm-U1v8'ޕTq YrߖNd\ Z+Rk^3B\W#admECޯc:~&8pGSGm#Pc _0?:lF"`hwt^U"̷zrө\v. ȫ 1zynR3 _ 7_JC9; ۅ>LYc!GM:YPQ[@iV}c)]d,/Ȍz/@O#U'+[YR$W<2&|bX1,y]0QßXڶh$﹵.GQge~+fmtN1ȁCGӕ#bC E{P;;ne#z?x)ǻ0,o$e_:8WzAP4ZDp=5w#B-ۯLܫ3DVsw 3 % "SL #(؅ Xw{5DpΒjDϢO9 ճ6-A~EYd~s!ҬksnvP!]d<ҰI'oenM!w'Zѫ)Z_J:96-Һذ.::]h2zZUxGڻ'P>jx6+jkמV`}RuE##8(Nºٜ2yýNkEIۈ"G'me~$ja#\_z|Ylm89g|c%_~'x"gA D߳CFCN3DFivl`ǂSkCiѻ,{ȍUƨ69fR;mG+"m*?3yXWC/|r-+Ҍ @\|2X{9_v𕂸3X|cFy#nu'ez-^i.ԮeHH†[-# ͝kB|Q2Vzd B%PL.SWJϯ%E:pB@b/R]tXqXw>qYզE3|v.mjW`鏧v OD:6 f[Kߡ-uJۄ.ܬ_@#^U^S]'BP&gOFζҢsh$V_\5;/V˫qC ܀Ly;QLj@\"Cg<C,̎pYo/_"¹`bmQՠWa!utB }`_N9q˟r>^9 3q;)GӟZ):q m.V @=|4`VM~OI0T9RDMTĮ&3tuirgX879ubzя }HU[6)^>:r6Z DӞk7;X5q0 L hǕA686*Ƽ}e\fGAsuRS]01 dc瀢q& ^~oB $mb.OJO IZ.@TAͅ%Hk>u١F30"K"Gw!ĝ\7S(Z[kjaQRwKd"0 LX/{-dMXn9+ V1iPW"fzE n #sSO0nv0jY7N( *gM6q!4kvMJw۶WS6xVbGOnKgMLsc,=Ra-GҦTXA3xeHBeg/"oi{ ݮ րtE)x*wnvVhXaw$Og-eu€m08ˤФ&9"J RiMhiK%e3e}aPgו*>Q)iL[A{F~ۍ63M@6_ĪD>bP^=1P>}׏8%&!032o & 7ϳ SAą=2^᳣ZQٖ:ITGWס tBn|9%ƙ-a2#2iإL?YGQ8LϜ-nE}Fú\āNfJ2;dTc^d u0)_x9ֽ)9R{Nf ^YW}8kaMAßI[[5mK=t-o-bJ\,,M:PfPD=;ldv_t6;EMX'R?ٸUN`rwWe F~kpܺ#Ӌv۵42 ӿx2rLӁ_. wӄJv+Xy6LU5anxNbAK 5Hp/cUV HX3XUntjhX~"4i /I<;mpXA3#6>;΢R(5.hCqۯؿj)eqƽ{mt|ɞWSqSfe/⻞Lq,pկAo?lAzlDZtv!|_,UEʕ3BjvH2ugq]!p.( /6Ly#1n7mxvU5X'.@`VQ3CG9eQJ"꼂*&Wi 57c=HdFQPa>&nᝍ~#+7$uq:[>7@-)ޖRcYq2 XS\m3M,]۹{Y'%i <o2PEf6izO3{^1!<~M?IvRZ.sc 8c;E1Cd6\W>@ CIR[_?0T\CVae~徤[.zyNLŭtX/׹e9`-e@Lӵ_d Oau\Xq`BxǤ2M{gG^I #Bp;Yk)`ҁDl7:OFTqot+I6!Q1O>K\*Axj`ɠ.PqWYo:ˠĂD}u]s[mVJlܻNU$&/In~:dËQLd z7kC/Ly Qu>0&eE#6#ԫ'3a;rC#%1 #a %|އKyR0os5YͿX0I~vDw&zQ\{;ɷ/ƒVaBM9H@II*a ʰ[(?ߒ&â;>f{|3"3S ">60DTi6vP+]Ӻ5{l6THAqmb 8[o&p,yXkb)+^ǻIB+&Z8[L9jP>r!["GN 81=//h߃zztx#vt$ YQ)dZ\G̹h:yV`ShC*PUuL;t؋}^iع!22T#ʾ}\Қ#FO?fYNY0DRmQɘL5Y9{BG(LÉM' F>G5Tax\":=n =fCN'y*)j}\DuA.2DD!c9mji'k6| +gg-jx9dwAxdë)"ߏqZ'+o$_hO>]a$ bqg" 8KqH;YItprkExQRg;4$fq| \Dc͌ X/wыH ^cڬ>Xatu2 =?VFˌH:䕮>c4 ^M'> k.42@(>`U+ w$ Gl;" `n<Ա94{)@7BcAN2>xOwu^- OKoӋWkq!/^nBl m N zDKDcUP<يA8<q([g'o򝮐 #.z8t+@G9|.w6&5IMym@&֏() 剆ͿUUYqA8=EyT}TE5 G^|rfE6ov+G Q~Wo((1L)%Ӌ4i?tl蹉0B3 u #L}F5_  Jl`"Mʄ[!sSlA"j<ۊ*oŐd'nT_v(n#U(bg77aM#Ф CngL5rQq/N.SD kWw%c-+˦UxDgSe_ubAEW(SJ /B쓇ieMˠ0e~!\u[BM-'_3&ܳc}, 1GG8;k1 fM:% -)6V9w%./`Oq 혖M˟«kr@Zq3vY1(l +U`#[ce͎OrP!xT`9p쐯"r1,b14&g9uS[ҍeo7I iPjK'NE+DX5L$mX5I93fr=^{e9|c,'/F=[PZ(w>ØY.ӔSOE|\x2"R'X]H9 2i IVEU/ 'n_`v{.(qMXs /}.Ujp? :ASgmG%zAt%Ctnw|=s=#2TYĩ{B.E\5",pQ\z Z& =[ +Ppi9`roJH!)*C?hڲ6Yܑ9:T߆?HR;+,ςAPVM%d3b/`5g8ZYDzUCِiTD^h핌]ExX2K&LL+RB2*PHy57HٴdhKJC :]2gCo-6gITLPb H ^,` ڬ,VO7f 4i<؃ J' 0]U}Ewgy4cZ&ȁ>`R0NzचzS9T&o{zs,K 3]c`3d%a|_P᭦[mX9#%%=Ҷ9( k]'X\ż?i^&U(Ԃ7|)4Wxuh.=@8ˤPLLN`Y5+D?zH։cLGXw45\cJt\:зUS鿩%V~ /e+ǧ=Z=Hơvfd4,#Pɋ ON.ci^n=j[&ʓMK\9|p1g-ߤ$S"x‰33G-mbz⬤O x 9-FlInt}Z.+:vD 7LX0,3X qI {>!;slUN=ymZ k|Z*}8%$ߩwdTE|my!K9"ش'O[rYF.k5#X?|.ILYc4|%bMtn֯p=|R͂yƟ4HLKQL2~/3/To1䜂x58(iw)<?`>%%^e0HZpҬ[TԴ6I [ X)!m<ghZ+#"&a|u]9c}mQo4Fc BGJ{>O6lTnmٙ\+F@ (h"8>"i75RI$/r* -Z5<_8 ɞm1T K¡tˁ8Y"9}}}Lرe+89mq };6 33ޮ2ҧ{WT?J/]6(쯆vD=T@M-D[P OF?~=uC<:Fc7?u%naq4e ,]I~dcSd [P `kF_HZ?oSGiZS% !2W/:vF'm1E[-=?A9=r|& &GWh$j\i#hsnm1jS •K7\e܇|n׶==k f7S|X٨Ϫ"kRiazG^:˄W?-FGFĕ q;5 r3.ư1 !5</bQR@dOb^6hFE3(D o:@*(?tzUͼ]k  >U"/h~<::nCN ē<+9R]DgYl@ǝۃ_ YfHL$@U鶝-$;~\A4ƾikr^@UNSq?YgdC}ЇO=K\9lP/ߢ:4xn U I:4EY.(m,q[nL/39%FSw5%2$1TEl:@E. ٟ0\1@3S',DtT?3Vhv&_S)s!ǘ]8Ge3R|ۺ[:9ei60]f ֫w8>4xOwuw[,\d9ϕZrX/[I]=̱ ٗb.9')k3f ّQ:X{y]_pBcMѰfPby ( Q'oģ\_UWE,.2jEE$ka/UE  hiծ EͰ*tw鯃L=Wv7oD>cpX߲:{`)hg5^]Z*O܊pۛTITx"qBY< [/4h|QE.Sq\;OJL&zRQ?JcO{mB;![SH7?y?'revtUh#*LMVjhK /"GY:hMK2 X Uz~ZDi MS3}%zŕ[%f*CZT:7HWt]NK+ࡿPH. Eë{6cAlSE}V}× ؝cxi>uz(ʾ~:3FB5yF!wHm7pT?*&$W'VL("Lo{8)x7)q&̤>ᅂHT%{U+9EMyL_a~Gm򴃧+C}Pn ~;4Õo7m;bUWrVR;kս׃8L`ԉ`;W9s9rvF@`8Iz +؎]A8obE ׯs-W^UR;fAן5 oo+WRs R^^C1oãOx+HZZI5 ':yڛ4^D}k/S1yHf柏%\I j㉓!Vñ|弍8p]3 qe}WlJjꜵ5fm|ofˍ\~_9GJ&HFGڅ5C5OA\m<z(?֯ǭ/ЧW8CO˿a3EnQN9gUHs̒"%/aIQ!Bw OYa{ijpoRµ߇ k w  ?vQO%t ,: LCI;m#,uZ0\2d5YF]gwKWl_];q*crM IźWvhXr_)ɰz._zSujjjC;6#~8#ÓOħg*XX)KwZG}z[z :hhmrA&rA (q̄f3q#3c]},O_wlڜC({xU*yBcA@*uu8_>M}ym8),M%4$l䷥4 A"gXGˁ(6_߼ØsN^'= Y'Y?xSғ'Z{z.+ U ֣$BAeFi_mfx@iN+x.Nrũ>)m*7s8u %\Us;g0&!ulPOMl|πp lbpa]3`/f l2:*j]@ulû3I%wLo4bvͤ+|$e3RiS*&+UMfRto(M Mtb_"q;B{P J.V~ SMDs@r2>C9p?ZM9nOm.r2tIg{g @}dKHV:עCcc浘c{M,oh' mj%O#$E=R~Oiķ:"(r$lldf-QLZ@3&k܈D_!v+IW/sM⑓&mbnVA =fQfntLR\y?`wcMfDۧV)ެ? fao,6L>NS7}3m_wVY7@ pcV.ljPP6f JeՁ@L;VqAիSiga ˆ D( N(wſ|#@q5s ߦv5[`|Bjfμ7"l^2;Tytc 'Tq1*5z>0]6o&iRDY"=Wj/#-tE_Yn6QF^J EA V "fE$gh .x۫s~U.#^(@ھY+p ^X v3vG^lg%5h9i}эY] Lĭ~ymBtNl~/gZ%*`5.<Q@V%1Qt* A[z_#[;xY87BnI*kdu֜)ڶ_#Y_t( s7eӢ~&Hj=Qa A?4fRtR0x,KhqVD Vp^ 5A1ޑzv9de\nj䪩?*TƟN[`g'aGK~RNJJIQ!;'OX1*D8>^![ȩ@##}D6ʄt}W>uNOI1kltv{1֥u*t0áZb^ۤG%oM]f׿w$ɑՖx}|Eaj 3ewփ"\VI+d('TNHN#]&nZ&1@A' ݞnyW{F9Qi'{OXyT9MQQplc.L'k_zGپDThGڏ"b~U8foyD2sO+|aY·3 wxIǎxi:\v7">lͯe GӶv3uڬX^8 YdvkbXq} w0 ;Q"-Бl-Ez]lkp?5IW;5AW}CmFywHƫ&$S_H5ӲNj@;l @ʴ~R $M>AtkmrtLwo=/],aàHOJּjOKV/%W60mC5L Jk*HcDr xFadq ) mYj֜ oJ% HS% s~H!fg#=;PjL&0g])s=Qr&3jS%h=+,A#;IדAC :Xꃉ<|>z&'sI(ftXB1φs9Vkqb4.g L˿99˹9G;4"Q,좩ÿTc)HӆфnUdqk3$T0=ݴ%qSGo5M0kvᯍIL[}m穯|HgHsXO0\:9)%+dVo8{62iURϻG ݫqTk*%-7V 5y ex)w6rTgvf1m*Mz`"?E; T"sѓ/gsJFĽǣ_ _@<}omAu8z:qOKUoo643`m+'grC@I{ǭE't fjA#@d0<[R=,YcÑ `v18]M: u=iM2.VȋNYek;[+e ܛ>T @3?4S)_,~IJvHX0C-JQ4T_z*NctbqX2+!W ,e:T>kFC:vNl w3;񯔻Q-+3vUC:`V|wF#n54`.83+ToIG &lN7DlOGmK'z9. NC. ]^.MKͻƫK:TT&T|1OFZEc,{lqPgb^zAh%7U9ȉLXYE6F6 #671҅dj-9z!Zs"Η/F\뒦ݾ_}3jOj!|K!fjV ̽g7_vPyEt 6kPP4'5>"N,;1հ P޽Qv_³ؔBK2ױ[\; _dPRZ#,;r.<.pjO^{yKX["U,p)i Z&(R}z~ j謁`v/m+߮Jʝ4 MYuZ _0=?~!2|xlӅ 8B ߝ~83y_YN/4a<_)w| KmDo(jdޮl5B%;I4eEI vN@=>-zoqWݻfeWawC$HȮK;cퟂ1}xVmHxWk-Ce5R&+`gԥ{"e0Das UXAYo&W,R Vflm59$jiA,2sl~}̯eʝ\iIg끠H{<&?:A_GwNaQ/FaIp97ޏ]PO5IR Hp|Sbi }0zS[DmHyj@c[VQO&)ԾǬ(h` lb]ݸY(IDrz4mCjCp0ptw~9%qo(*iS: %qRr* &<8Bo{EfZ35$q(rusqx^z_5?/vQy] 1DFgk%D>Ϲh6f8_T PDx7l 1Odi@{ rzyz$E0䷙'hڥ^H!U01##qgϊL؞DIlX{S_YCJ´Cr5{0*e踢B:䓈RzrMwOp w 82ZM#p!\l<:Jܫo9 zzmC+Mg"Xe8ʣJz*X`ub({Pq Pt,?T=2Q5$VdYe /?>1eЗ|p$;NhwSRE{`Z]N'1{--s|csc`*y0Y 4 HP_o^ }ųRLj%tWKWGF , |bQ%U!9΃nL=/-1BMj!%Bt̪:ON4!@E`By~|[va W9(5 \'ڦz5MmDi44zNkmv8A~#ҁJ6a9>m4ͽT nz++"|똩U0eѓ>k͇D7B| }=8utRreO?ԣbBX-Wp;K Mx2|:L*`Cv?Eb %:BG1e%AٯSmtyRFӝ{fad aw,\RtAp~9gsqk#l'+4 )ͽ| (3sp81Sk>v}ݪ+:3Fs8/ ӡmŖ@cGP!RP!=`z>e DVbXv ,|A6^G`xpZ!QUadl먀Dz 7v]{S0C {18'`,[t^X,,jh"׻,$~_:t!#ne/E8yQpaOC/H1IQ)n?} L֔4~|&Ax/ĺ ߫B C']9$I cZgL SE`6Z lθkD+[4|_i\ "#r}adȐ[-=9 ,:I&{:xwhjX1F# _d\HordzGy}A~Ĺ:lUU2&gpg+hUxoQ F/ }#̀l /dHIKRQK@ofjaoX|l/=1]SwG˧w+K)r);8ыr?@X tXr-6cpH v(~g B-{E1Q.6ö*(l"Xw(ꓵ}=ܙQw3ĬJu!4`l| D>!#LS)(ALXunLII? };I~6;@\ K@I9JpoXn2W A'0EZgm 64U 3em<}aϢ1w6Ҹ׌(~cHƧ߀w*,L )긕tS^;ڻ{c$cCcPTdIpRqdoLo#(9t(sʃs/扴 d}ip .d y#&""q Dju\&5Vg MƮʄ:-&_/y!sY8QMJ*vW4+nsnFxy#(xzyK;ZoK#`IwBko铨xk pਊPR܃uvL^D;Y,+LI3@mJ*dҵTa 7?x~lQ6W9qff6 sj*u?ЯMÿs嵐/nOGMFDm1{~XI8\ꕄ>EC): ͵E0fPR([(I\6miekɬR!̒爛{t8@_o>"NՖ50\.eᄮTz>HdeM}h0dzk+i%ZV .ߺITr5n:i}Cˑ1HfK>#Y6z^\D Ęh ]G7L>OXZhX˜K84w\@E XRj8@#N/7Vҍ^v,,2Z( l͜3BZj?J_MG37.F#7h6ec2dPDl0$ji!pqֲɐwie!ISax}vk;o'FG]qk==b9;=B^f <12T;Ӊ>/'L{M"EP]_uuiOPC9Otu S0ܞdnt&1ѥIkD+2zzH6m侨+f0GpJvĬ)򌴀&P-ֶX7n:&@RBMhJsCsu*=qYPwS%(S3Q6b H9S.,lSN*6ߞ30ۍvP{ 57j+=G~?Jl."Sv9 hSRݿ3˞oU >O5Ҕ(E3s"e^$% 17V@/qY!yp`$.w7XiNވ}Cc 3sl`LnX;dz/Q63-iҎT%tF<{<b0iit:@ b,H&֛G,3Skm<( mrL·sYptf94Gy@πy,?( MA[30a!qRN+[ \ԙN|X[@ODbRV%Z_ЍH S`CdNwgq5lrpDR֭:R] H&h{*| :fJU=GL8hsb@.A`Juc)E< J/n~{*<w.G .BRCqW&\cqpb@ NL䇪ijwhJ0V*m=Z/  =e,a.h{MhO,BIDT*g./+y-Н۳"T@t*XԐb6>HXGy{03Q,;Ɯr# 9Z\$ 7ӝb 9[t5T P@AX W ;jeip;V!E\.+,<'ځ"|0zD^3fE v2|h%CJRwP&gJpGOr# QD?x{9#ml{摣*y,S)LNh2\;N>%ʥ -|b v^× 9Jbu]q_b[$b؇ئV>B:uoK9@|6˵ۀ;Aфp? ~&[s=d|s>#. )kU\@&;X! ?? Y0n_@J n$\E^4{05ntp]}߽IuhWO] tnq_k]|,"E6A=IF0x|x) OCtW ?S2KV1*tT d{mu c*VWkuyb>O6.-S|БSnbل~@t[d_<5Ia38W ltQ+q4bCc;=mF (6Ղs^,<.b3S?F#Bج'\%1߽[wN=,4},ܔ4Cad`BmE \UiiCȚ֘sut+= V{ Jh ]Sݸ%ZLYH-+3 Zv XĆezEL犸~{޽DLeǍ{ yÞ]Ms#¨>C<Ȅa|LYŌYh.=o<O̡m~iL"z. }`Eͦb13#όRWq#C՟Wfq)sۄPnh ? Q<M ѱX hZynL5=(';1:tۜS\|(5T pc|!w]QCPp=0n32"G0ԈJ',#NC~<. qY6j d~п0AUƀw0#0ʵݎHH#y`2!) CsM6L3iÔ -cZyNګzԇPI2EQ ׵fU,fP둪GC0V>#FkDWAOj{\eYE}>aLbLG⒴=U8:DDQkؚ۫_%jyp)򛖤pY Hӯجڄ7Aȇ }so*j/gOq^)=lG::nDσ-7]i,+s;Նe# ѝExrjoqB^ .] q!G_ͻ\]m2j# cPrc4bAi'^2=;8{ 2i,W:qEM rg=c,k_VYvIazLa~X7<SZI,tkz7愾ꌽt F.+eaq+qTzE*C|v NkR@8,R6rKe,T2ay 09e6Ms"SZqcO7Xn^Tks ,My KZpJ#4QؿUűҾ"|lr@`8y=,<(߇=Ş> 7{:nJxKS 8 mw| |~JCPx[sI/>;(C4;ŞPl"x.ϖ[:ZFKfc?=`( l־إ4aj݄;\q1RBTLXzEWWͯBbTǝEY;&ںNxb,` rl"V7&7).$kw拰Sp} S 7P\V88?׷f$ O~XJdMVE*+l<`,1ڣ?zxTH$+r|W/EjXYPN> ![{JDF (8 Ob\S?R WjD`M-z7G|9m&2bGDlK$u3%1os]4[/< lM'wZUǖ\_]{@:xlq@ G$mňqJBQ 9`JPdg[<өu1<`Zl;ڞ.p+!ߘ)~MW@I@IYvذ9xcvض՟T`ڷ87 q$HɄؖZ"7gPJ.if3rUGTW۾j(ZCZom(s<;dqM:0T2֜w nƔaUYi.p#G]opߗ?6{[9jGᐓ0 ñ'jVr;=J4V "{Q 2щK5%AjVaZsMN^xgׁݟ7Ӝ鲷94ELr;+W8n,aY_B;$#F ɾo蠷'>2=b(>K˵Z>W8 >O۱#]%%My1ޗB%¿X7rd12Q࿙N>놿YcN4îJ5P $?|>f~+>2T5/}΄ ?Bc.,[Z{ ۪C`,/uUt `еG9hVrn2[r0VoH{I8Pa};Ä((M{']/#{^8 ,T&xW/+a;s "p( xkCti%aR0Vx'ms-ֱyXi܆Ȋ>.mqU=@ڐw1LJ[ˑH4lxeqgD~3gf_bc6I6g'M="X]O- JnH6oql }ʥ<"&Jv K```(O9nǹR3nokV| ML}508I0bڒ'c% 㟕C&y @xg$./ oG']ɽk +lnh~r ){&B GEr:O0/=z~=ο4F9B. q5j%xՉp$yTz'uav ?2#fShl?}q&^ :Q>T+νsTh[mQ7>\2Fi~_ "Ξ$I8,線')\֐td]Zk8Pms3٤(4ݚ1]lN3U( >ߝx޳LfIأ?2rQOӔkB俶*THZ[xV@X Wrƭ::IDA}pH6e>d{fWyIэ/V~}& M¬zi[ 2ql~;Nܣg(9@8u a"JAD`Nnvd-pÀ6q_$u DN0h&7t7㠅GI-+m,Ă-Ts\^9k@2dGQ7DR<72c*`d*c»cydP8p, D_殱oI4{ϴ߰p,jR+z/\K 䟣{p ))o:Mzy-?V$4NKsϡ|#*0𤣕:s"w%k\t}a&{j 4+ h^$/|ԀaŸU{eX1Iٷ!Ass{`F4eXA&QhCj]Miͱ^fZ:p`,(գ~v_Y׭u2xܩxY)P @bB2Z=sPiR(O8xڢ?nY8@ n]"BF?+ tF^z0X!PFI1?c<{px NPXEg)5=d \;&>0": HP)ˑ2'珇}>-αAAq@%cQbӁ1{^z;HZZ ^7GHoH[ѸM39{Iڦ!4Rhs$zsތcO+GAL$Ps4j[!)X(t%8|֗UWVد(hrsb0$vmAMXVI<"`e ]5;\$ܬJuq'32.2Y-n氨4c@F V*KO'XEZd=Ud>nX.S,˸0 /Wsmh<I]u_;ek}]`;^,ٗeeӷOZwc.2:u'.JLFiik"&w_t@94`ky.2j0d5zխ0x_':'հ Wc#*\oe+(#ʎEV Ǽ~矯. TEćYIEC{-RU#gRC9H7`і._?Gj&AOxəj#ti ?]mXyɻpxX7vwWMc BΆm)֡<\3{4 q/U[w0u4g7K$Rޒ ҹ&teL!S J!M7$sJ[2 &? ^;cv#qwOD9aŅ8`EI.ZvlDZ:+±g}>z daĹsVL}kV]]ڨ%.*gp 2*ݘF(5"Q?2b12\ nCY݂ 6_4UX_~4/Ԝ=igK#Gdؽ)IIvhGoM'+(@KI{H"Gu_WWtY~|!!+H &qPsxZځwVK,>P7gp y:H{*2%]M9݃%k}k TT A.Xy4P!R@V ?b;w}"3ѠKRGo5Lq曽9P)p2;<L5/ ƻ**rZe Qi =;w)=:q,E|jk ߁?{+1s |-:p0}a}OV>yLiK/{f#<*oe[?7:NpPED]B>|f8O>c%bS+'[FÛg)KGc@@OY< 0ϖ[Ë%akq]*BU4b L7&l*'W9zgydTw,pb1B*@ s]f끳GBGL҅Q2&(t23k~qqk^Jx /Na7^HV%v'HSш|Auѕ*‡1& ,aKzS %5eaoETnE0~!9 eN?ͱL!z&Q|lrx5E88́&~ QUk4{~z6n5-/XH#wG%)rH+j08ת@R@kq ,Ԇz'U6XѨ%ݪaXZXR[ Լٰ ]PWͲA807a+m2uo]IρHx5^C Aa ya߿@UujcY}#YyOۂ)3ކ$3ti'TtvlDAz%Zkwegug,]CUARZ‘&r:.sQMYӷ6Qݻ/?rv+.yEK]_{18\N^A>=MwP&6S^LŵݓӺ|&kк kqLE'Y~k84/VX8si M*P#EsmLN+4cnldKԟpEDJ?2F=/ZxM:@pV^V1/}=puTdMNȞIb0Mq} 6"-I\iT+TqޱU \WdO4ϵ:pD40@]`-u`34M*P{bs!{A~[@jmGYГL㌐6Q"C)luS|EodPVB+<\m9͓-]HE. ^d)p^-1Ì)^\ttnrmSjb ԟ f݃uApRT>5M?~.aILlHr5OzRŸ~,5g_NO9AIl\[~C3`SyPWXfJ"@XB; jn⼂Bּ>y'AgWTnk-@h`yo|hp#kÂEzBu9aa _ce zq}XXCG[ۤeݲ$"4|RtLk`5f[??1Ȥ:e)P,OKG2,LeW-f yOMw籈)o qYS(7$ cݦ&loE O3!Mi~}7.)|/<}]ݮƖhu$9R83]dOT+I`&9k:֞4 a6j#Z}LLF-N @&_#%eW_z!B5▙)22,ۿ^H>LTrwmhNuGtیFlX:!s8N` ,d ?SCi*xȢnK0 _e|b_ֲ Dܐ)6|Jp AV,^ʇF͡I3Gfk9>]̷p8j&J)| >,U5eʂ0OLZ,?ͪY91okn:)b,D#ZJA)YQCkE).w З o*սX#XiY}I|@ V 2| jV6VD frVXCV}?̀WaCDq&M[M$LN?(n/=4gڄtULkY1A:cSaZ^֛<_R3a?m5֪zZn~լϊr?>7G.M v,'s^P~C N4xX Fcmͅ'8g2Ľq:SO]-9j3>M!ansun"GVO .]h6Ŀ:X"JوeF lBAW ;&+dW)ӎ D, D,6poi_ש5 g(sB\+YHUU1#"Q?@E}ݖsaD_9-䅬ZW(vkn1F ĢHom7 7w-qDyb+19Aš,1?j}rзDŽۈpUlDz`:rhɍڽdRmNAIظ:}_兲BsCuQ6Qp~0,uDE7BXFH*$3EzJ~g!MDHfMa { ĊL510WϏ9+_r,?#\T aANl8`>*6 qwϔ7{|㠠z Tf,{k.k5P,+[I}O[{U:v&e$ٗCq [g4Jq+}cVU{YaD?Cww9Z25y+&jٽRzG0:$դ 㛫$2F8:JŮT ~=vⓐt8U>q/=h݌^@}d1$VK\D *V li^ 93֮4JPX;1mt9e[ƕ' ՐFOj?W_s X xho~ʽTi37Sg$3<+h ٣]N+,m<޲D,ݓ*-OC_B*m#Pc#cfO`>#WmaDy#Ɣ#LY NEhz/XVR I='i`{3 jȭt-@Ɗ:҂qawOɨ}Dm(BKA @!K1tjN:}N%ET])=NyqY(gGak,|ԎYWN}wg;9j̾J&mѫ&V-k?[V_ۯb*12 6kt5z$ieF?U|+HP3δGOɯJv;HZVjX%[}0Z9j.0ws2˔tdiţO{Jֱ#^d`(C25-2D$xTSJƓIDf@#(ޛ)SĒɑ3C1)bxot8ZӑrӞ JF|"{mU`hGR VU "dx$0Zjvl!s A8yzQ)hrz7D̴`6]T;+6zpq :lLHaI6q5 ~p<_)lƙ2gQy]x/mǢ?׆?;!PMJ́^Oď/@#zBXaW#p׺D+!J_h>)C5"ڿυUIQ)_ 2puTx՟=aK}o݉GnEܓ='=OG4UT n8l͝çt=0iGBK ;'}#**1,nW D`l]̥-njb |JjU\ۀ{]AQjnSz5&b^eEJ+-18 Ν%|O:LNU{rjt%AX.Poj?'ȵ|W[B? uO,k1G,g552/Pp,$Ms]2WvgQԻ@oVĆlI{-wԟM*^14)Ļ/DX UH45q 4a!~&##{IǷD3B3:$|nUR+D`AP7)zB"$04Yhu ên%"zBc0>En {:D5|AH0."#.o=o0J􂝒*O2r?HM 6N@شۡ6_Lwܠ1; 7(Fh4T~)~l @{x% |cK2}cuQA`0ÈoZǜbљFk(.Œ @MYaSy)Hس&o$"=0]nZ]7H;b҈ a4x#9 pc;Aʀ5{d.!iͻp3YLî[j i7FtM$#!#%x"' ]>ڗ }3+ s2˩ӱ׀`F.o'OHV#UlV'VT>q!G ty}M`kT`iwLji~۝RDk-vv}|k*r|ر1`+"ueo>yQΒ.FMI$۹P󖁶wy{DLNG*;=& V%SэVP{7( pa#o16ЍY;= P!ls1WFoY|NwknϽxk+'ic c;xBGwEV?iM$H(]z'BO̿;Y2~hDg\cIOxcȄT)\*- cYLjnųIJf$9">ʄPKuU"vWҲHtA¿=W+ ȪD=o(Ҍ̔|fnΊ-s8[8aﴶ pr#9Sԣ˼ĸ7Ȑ Ecmy oTɌ!&4 哥fF8QKfLԳdJ/KB ~9Yi /TX <-*Oeh4XEq 7o 7 4mVʣ6=yR,8.nً~C`]uEa˪+oHC4x-O#WiP5xH{jnmgGzu7y C'kdɫ+I}&X>8?0I-/G^<@|'2S' U(}Rw99. jǧI -^X?=櫥$z(![PkS=[%uj E囕Tw:g79;PeA! nX4M2Am"Eg% _a B({:ol_$=T8!m]u*My2۞S@L-ew٥1B6 "vO樇3zǛ 5klRi 8 -Q%S2vcLEp)Jx{qKt8H: K@årM۪)XJ;rw2fj{j lK':Ǥ| _k}ŔwnPVRGm-[uCϸw!>#%-yŒ/*'^"|﯆jCZ{vhDSouzg#O4;t_JR7_ttg %F%ꌟjWlF}̨ 1#H5q~f:wᄋQ I@#PwG(s@TtnM;8lօWAbKist̸4HIȾVڒ"j2v`El0/b-% ̎?chaK\xS(%-xOy:$X1"= ¼DEz/Mf]e [941s6{06F7<<:gOX={& G 6?M6[F~>Akva{I³Ž pI]}93s jY#=3U^b-ޓð6B;K3l|eٙ++pS|ΤPz[.Psi ߱`cnyi8Stz' mH/_#t%՘ї&Gܽ݊hHӫPa,!,"dkqm9[uɘ= psj&,g<΂whfdpPAmm ߫/H᧚+:"r &)Ev}89h6j! 8FJ*583=S.}W΋m!͂/܎/(qfn7ikc&<8lʋ/ר83t1ZTq%sQM6ŷݥe LjVnR"{fON1* oo ߤؓC:?6n^DPH ΀v&n{s1NsE=l -A?BN$F)S}(ر92YއaS!C8ZOE+lq+X_dlNY[`&o ~/J% '7EsN6qgkEuZֶ JN¦DDz#-\d&?|6(R{%dٰS׌fTwSijnQ@&ϱP`qZzi;Z8 U𼓾Z!+JfnL(Eӥ #^2@0N'[jc_dGߴ(SfP3X+ʃ;ʝr&ړwO&~zgFp|!"8HY$u Q͊27mEBY,f\%Hp`87'&aܭ0P|bȡ]KL֯3~+,Ky:mAO fq~8ֲttac7Wl0LFV#,Ga#>k{R F" ܃?%=u E|p\6~u724mUF$=khPTqS($nFcNw,@Sԥ<{ <z8ˌJ$\fXYycV, ->ٜ:o P<Û~{*փlϟU?w pgk]_;Dz-!n$it(Wˁ2L yz;>ycB-" 즋n!AQ)$/NՉ뮲'БMy1E%PwV}d|gaj0h@4BEis2 t%|M3$[=jZl8WnD*̷;qT)إ<]e>] Y}#op um>(g1}*{`>T6DW_ja7"3Ь 2'fՈ ͥI-s.~XF޴zehD`T޽8ƞ47tFDVw9J 7%`Y8mN=vbf.sQH,irIkg0,эjbKޢ(m Q\}< v/M@m4r2FэbW k܂q}|m6la7S<('zKXp\c0D LuYvG}@W|f y!d{ܵJRީ$ }#naaÙ,0B#f(NqiOue;?f - /\bz>j c\}.\kOlJ@0A]69Qt7{B \m.bJLHv޹Մ?@O xՆnT/_.]Omh%|3z Y~AjTOFْ~:R^g0#h/NkiOeL(c 'GG_dh8[=#yg|ީ>{#v@cD|V=rsq6=wtau2LDVͯK]O}ԑ$\z:?\LbkCS 7R10N:S1A tOƢh Y׎&Hȓdl)62orRFe5¤z Jy<>[vOnCN% S򙨑Omg5  V,أhx{醻Po;F?2^Ʈa:JqL FٵXhXKUtJ֍9/d j̨ 1튓ϲ.PIفZ`yu8|YcZ$!پ_WJ:r0_OlT463(kw!PRw*9OM6+&8k X?7¯nE)rqu-8J1MGHcgh݂.;f^QҀg@Lfxs=F/JRxNNs"\]||'p/m^DS@I哓$Np:}KF?۪ BVL3#@:G5sATyO|V>8Ke5j~xx8[(* d$sn9ۦ1N7"k*#~ &~6 ] +juFԤN%K&n@hEqb;s ;3XfgeHҟ .Z;nxM:;v ldKKyeѲ+ ^ףPjVa;4@=8uPӢu\[krt276 ߉| Ceے/8|& 1jdٺ;tsg?iNYAlS@cͰ6k r TLU7xy8Ԯ mq`0V롞#S!z~=N%:&UU7FZބ3H_{oҬl3J#w xux/j(IE\*ډ7ŵ \v~S4"XI/}-CMǰb~}fMwV+>ăҾN;2hl6vٸI]J'_fYG51 9dӽsh;[G"R.n)>CQȾ`/I*Lqp<EM)S*W\0+Sf0p9"eZ + g&_AR1> q$)@igMhA 3 $/~2;Ndۈt<ǮlzR;TauCW-+M7o,c{ŵ~=q $똖`,o)DSfuȣ;uJ=tvj!tӽdI*/jupZfT#źmU ?3Mfx$Y~)2?$ 0Sh 8O*(;}Ȓf/&lf=TL {IX+N淮Ҋ)U- % 'yzAEETQbf(YЯ9~R +0U97Qv(Sf](npiG8U}W(]Wpw>䴩ݐ1+@ OQ5WPG< P] \OJ~`HSLggD2kuvwQB/'صo.'#^|Ub2|'s{..2|#|T?Q7PDmI󛖊g4:,M+ܫ@W7]Oxla,B D8^e9A0hI9]xX1k|Vkt?PZ5HH)J)em0sڮ8Eľl$5E"1nM'~cwiݎ0^{Q J`5үkt(qmOպ񚈠X΅:7," R_rVG'?w1K4 lN)Fb"6;k`z7"IIclo aaTW(\mw!mkꪉ*!P5ݖPᆮH+ѡ? !QlX`s[! ˑ<m@.7(ȱ]3.HgofvmJe2@@<@NA=&+= i`g9(Fri˹}_0><'s}rέVhyG&|⮼{z]n(Q3`b'Cd6|8!\do_>.T I"! 9^:>/Jh|rW߄:zQ"MDPaZ[1G!wiqJ/͕q Q^L|-L%>ZԄAix񙌒W\Iى77HŠ͇gfm_;jxރOE$:zEiPMu00" r Leט9ch0M -f)MyDI.8l:cۛ3SȰ,bP SSJ&p`^ eulceI{AFG[ȶm9V)`'qW}7O*x+Η^VJn6_΅z? S~]!Ka_Y͉ MY.NSSr7M忾ڬ,i4uƯ0"Ox%n<}[\~Y@\zOYm8m%A?k2)8xd4Q @gPq#`?D1ŰFBeD̨B8.!SI_c;&K}e-8PjX)5>4VؘlzMʇ˲.䰀(nW &YS+ KDyvymE咁Q*, i1aâ;S" zYMFH3Π0%zjUL7g Bl;ᐪx):BOP>  \Id"~GM8.2IN7`Ҥ=K?p?!nm5@ Yp~I|bS|os3؋J/K!X ۟)rPِ?om'o@=z:},eyNMw׻7UMwSz $kȇoNjZʗ(]C`7zw<ڕJԭ uO5ۉQ::o;}{m C@qmMP'ZWo?77qdO(ڤ%PÏ5 d_ؠuNR:jP \2o2 ~hȚcpS֑~Wa )\dp Xu3ήb5_y\;<܌>=~K;u:L߼NꝏcK\i#-9ܯ;NB2k lQX;X%/iUT$GޝQ"ώ[cVH)[ &fA5ξœ=^Ρڀ)hDb: C,@ <=xrH ug%d>yU=gx({_jCo]e?SL" Gh:7IORbx]I+L2ahs`yI.l]=ɂx|G;jm2(Y݈lB` k]ʽ}gy)!ij6MU ҸymFT;cĕc(L5ʚU8 j.C%g#9Y;ٻBA-d3џTCpz>/CTeDJ\}>Y NYXGv#rVQ܍}Ov^WV·v&qr!5e\둁oj;c;hAVezY\4'=j|$IzԈ068`C]xTzFNEJ{pL8YyE8tJΞ JT[oI)|6KCLo%W5; VwA1]GA:tk_JCKBwbהq+x F%JхGh s#We~ pРWB)DAzoG m,V?p69߼(1*++vàaRԶ+cI%Tř6cS#۲J@(%nܕ^VJSݤf~Ȗx;q {]ΧFIx%NqoqUx^/L%#}Ou^7 wl]BxPFpI}WÔPQw@63 }!.jOE@"jqSKMdR-kma]B%S8?( ܅4TOK@u B Kմ?֯SMmz2`[zNFʻhUZ[M~ͱ:qn>Q'&j>QKrf~ .vzEpux-S7fK7d1Gz9d>i)@i{ :C<0 St})Sf1OsV=Ŏs|_sb@Gk 3'!wrx@+"?ϔW7zܡ_qSe WQ s˒G7n,qVO9[η;7l  L#Mx$3{FCdy{FPSܹPs J&$Es' lsOMO?z]PaQ 0~ XDV$#UV|^wpPqsqx!Z*XR:ڳ'딾:D XUc4wdc4KmJrADfyBVP( B$.2Τxvf.d2>N}1Qn":#TQoߥ(%]FI,:mV4]liEH@Av"O>[0&L*U5*<ȴ+WUdq2PBmWd3v9Vr[Z343lACuZYwrhR&eЊ̖֙]+i OݥkgO hϰ'jM3ʬ\^^Ȗ;j|7Etu(fT唼K uׂr^-G.*5KUklmT!_-岂vA"0)s @AX L23KhZl#a)J9 ffaT,2k_\I2Qu܉( 9 U^l"F7ϳLܭj䘀KkH wМVEYd*xt0KFQpTv4!PAA(,fnH52匜E3W|ʬ{r4V_޲SŶDTDIиZkTp}4`/p"pLN3#vhgm rh:REs@]8Jk9,`I|ƽ2ڡ%Y=I#yKXD8L!h44RC/ȋ1K?`%u:Ck~E`5<p2VTf?]A X914. STu5Zjtz 0/gmdk;n{uѐ{N""ۋEm2`uvd;>kY0tֿ~1epڟz9骧n5{G*ِd(CHfkSv"5UeM-ifO]k|mwa\UŪ:̴;w&B%ߚY\Dv*ƿAaeݐ%HuIv%?|mW[Z3X 1<$WS'T7KEgë0Ri OۥQOSn12^qfzœGO,;iJ#e]ֲGlVW. 5VD@7V z-dz%@CI|QgfTO=AzdQ{ cn裥R w@QuZ #[9 yX$(wY'BΘSPَK14y.+26d<4v=9yPz\@[ut(p~4I%Jm>+ \$oDƙ2y|? ( fC~jy .꽦KڷF_kt2AD֜o`mbX Pˬ{7=/հgE)a_ 4EzYaeʯ hѮG/rT_YtQǡJ5Pc层o|ݢ^5J k6b)o8鳴ۯg&0>)Z&aRgIEGYgo^NaPn+ yz@3 臸c+`(:sDT{>"C hwqiԊ9RO+ W]>*X_TM2%LˎouBSH%uG액׵gM=Rs*ZWC+RQä1]QJE^MыbޥsSv"Q_/$&c%qk~}PTi0 O27C ]@Ɏ(6 TE:i&~E2[l'X՘|pN2e2,֙I v3Jѥ**ʎB6 ĐK:>>'3BGmm@ܾQa!qن Д1h}o q#1a90bIFSTYX-vZ4^ȓJxR͢  ĀPIoƘS8?9,Ӈʐb[ !e-\e*KHWΙOة[`*Hh *{`:)Knex{ GgULM U :IdfGdݲ2+*k2a'ݎ:(tH zEV]0#:2hL\'6<ÿ?}5> #HL6E I\SPKG=m9߇KQo+,^\NNw# bB|.գB7L=^(qLu_U1UkU*;sfv2Q&]A(.F pNJxCwVqKgL-M/ӓj9fCAa$K /Ynva5rC9Qc%bdZ[Y{x/)E&QR :0Lވ'k#1Dh=)=( Mt" mv["rfikD'L>O{2 Q6Œs״>ZDm k,%5nէ8@G-{)C)SkϬvXϤZa5(cvŴ)Q Vja jWQ%%~iXݛUDY 1򺎆=PG71c0'c7wf*h̬ `z1)\^%FmVNnT+9vkLEBtu HM1HZG0Pz` X7y,4[-H=+fJ3Pڑrޛ\aWw1wAu"9vMCxTJ)q`( N ݽQecsW TJ0^N:V:.?O+ ;B6w֛/Eqg9ݝb.?VX*A} ZUyvW1\c0]+@9,xmyV@aOtZmWf[ ]wMdĎo[&&"v5Ō]VRv@o"rZSW`L78D`vޝ*WԲGZ ]@(&Myԕ6,JGZxC]9I9 mm>{yt>xmJhLam*te-z+$E8RĂ*̂nC'\0,ߑ-۪UiaX vyUe-G`^$^Exۜ7O?{4 o3 KBdY57!]X(BZL"tYv5]iYS(G1O~xN ,qlhc.1d;k&L]sw+HkrVèdpݮD4=bɯesRZc+^r{Zw:SwJLtPS\'SQFSy:4nf]I./[*ttSȱ;+:)IoRm'5T~S_ɅX"3عe9qcNAI; vaart2S1fuOh`U;[fÞd%Zv۶ BIF:ðfGuU/S"XGsR/86RD ?㾐+vSŏqRn̓7fRt_+vm υ%\0 u69kI-'5g+|edC HHmn`1W=*evyBr-5 +!'5 Q'ٷ ׭եD9T& ݕG2J={^Q?@v'@=CeH@TKBC5lXqq$=JC`OEg5΅u$Dzy3vBϕY- I$_um]q:N_nd)XY#OqNdoιRP\v=o7m1Z+ cHGcl24u0T8k8eM=yyWN6Z3]6*+>CP+=a;~BdZ[$hR(W |Ю|dm@! y{ZSG(NC$ԊFPAp@ZL On=SH{8sFa$3֐qGX$,%i;OW ^WOc<0-r\5OjBkF)@-Ӏ,;$/uƓ\J$E0#{671+ұgr2kU,vKk%Ia 9U㾉\ i Os?WMɏǃiauG)`XhD./ z j_A#_-JF)Gf M ZpRWoEݴb.?,Ҥ/.HvٮFjm?%"^ҡk;}T.wJ : r2'Nf"xcH\f 픕2䛰! ;$qRI曶\}Օ ᫼:NvY>z5BU`rBV@} ɍt(jրų>M:nE֚)^ IS?ҍE#o ڟ'iOll@~a%]_U޼T?<`w1ᇫgA~ @Rz:eF-y(ĶOIbsx#~h¯_5y@ B2w?>ɰ}KHga6ASD]6x-_ mǜdU8:35~awް\Az=y*LL>@U>%osdn,|x9U)o !tD?N>iP"Ad|jg Gct:d`( F|J4.o5<5|Vey%hF 'erC & ` N 8~ ڈ=q1Z;VkY/? L1?(;= &*U?JD+iΜzhVLw~`йtIQ0TJd _i(N=ēv5";PRS'ݣvTٺ}+anu;r#u"-HzC #>+zɈ) .U5"'a{B8 "rYs)7Nx J45{1hI2$pVpW*h V>$b ąDP2iE1DD蓱k;4YpKۣI<.]?f6UךmY=)5FԆA=S]|[j AqRwV'6jI[,j9QLb~у52|o#2N(S BFWIT؛G(PlOEzyY, ~9mT&Nغ'F[@Ƹ?eU빾Бs-S Q5r+Jֻ%w ՇB,Ώ ee=euhV:N4s!h1C):ɗ*r B,Xg(ï֥dEEQK2ykK#o޽rVtː>[aP0{ͰcN$7V"忒-_w`yAmʚf@ lI 8wjk"0m~5],eqHoyx%yB0XhbHݭ:;Uw,U΋T>A ?Og?t%L6P."s~fSmώx_F -dz a%Pks^+k`L^aN[jbwu-ʩMᢕeOr[##~.2Νe@KBU@o1E5N*0զGi8'UΆگ6⾷"K:.ЅgMєtZ=߷:W}v8EsZLǦ@Q'S133 . ~֟`m-*P`'Yf ̜*i$zy3ιuVcBLx"zUɧ'7Dv:}W!,327J25[mq†%kN X#GA92cḘsDN*'U5i<ҿ]_#`3E,|=pL!пYPӿOTxDYXˋT|JMDFS^HHdo&M|+j:ۍt؄cӪ`Ԫ ]ꂮ-+w~N4#/'*|f҃4PЇ0[Brg;tXM\ᜀwQ0;i%v*{_IO^Jlm&O4yc&Áy7׮ ă'Y 㢴:O{ܷ{["`y:=3g?cY_TGNjXz2TE5H}Gv^12>=64+׫++fŪ"*pnB'TA(-c~_c.(gۅe uZSaDlNbB=+q[l7}U)`@[.Ag@#pӘ"M{A,[`=FB %@Uk1pnt&_E*8R=rD6F6&[ UVMS~G`U ,!J5mΦKƌ` G=eОUj:[hAOL(#Iy5Zr({b_Aq"o}-\MDFl#sҀ ̗I"Uk;  >y%j,K=pvOdPG9'}O^m(Cy⤾6V[Bw8wٯ:rm ;]Lk| 8Oag >-$\jǯ*9E-B IX6NYy[N{qUɠg2yn|vV%b*f, MXyOΦB v, thKsئ[(l׾~shLRmKcv 1fIV-#j.ZriUs0b"؀<Ԡg Re.% -F`To*3DXl 0MF PJbۮf ;g{kVkEu-μY:aFA:mbWz)ݥ߻'kOJrE }FIw0~ BȀ1),Ljgl֞9FT[=|W:[=YSk'\'%2ab.+u|yC$SI*M L g??JOg9c4 }UCOM#b ܧѥ56^U Ay}iQVYPUS?$lʡ۝%(H\++E61Ձ04>&ET--a|xbw-r ̍]j8!DX}CJms/ǫdYQcrogJ)5bl^ʵ)%龢яsC+Q,bvS֏$U|(luC>W]: o8It%-%jaYĔQ/c?+4 C³M/2M3Q zͭ׽Z_b?9_eŚ -ܓ]2G%mA҅bK4FJ}SkĦk XG:ϼSH^Jj-K|# BZx6J/'pȸoS ˳7Qd[Ι3&0WKnghuJJzS So; QD ifptS0Ex@Bݔ>1= .cS?U7*K*U+x ٟ..`NGz7:c}hQgh}:KuvǥMہԟA9̋^VA8q^^H)x_^iX' CiLYbƒ͒`t CWM3.C_skn@ͅ){`V~_ ,pHJץJ5Ò6' Ty!D,ƱFb 1] t|Bu7nMsL~HVD}b-wn8=Jϓ_@];-Z#h{DCHE^aO ba[*mL)42ia q{iSi~_@Lq%r;(*6qBJl3!]?߂4xXSER#r Wɯ}CT?n2h}f\SM"#f6[|eAwc2@֗'~JA>}@RjݸD{N+tef_GzI\M1Vy=`;%t's|wZm B]$<⠑KbQǸҾ3+:qyjU.?hF"9btBߣDi9Om:Dkrq~]N)!#ZT@keVASOv*nb1rm gVgUʊ6( rGIPȗV݄t"@ }t,7!y6w"6yWDYI :MLA]|U[J:ȹۉ,;K 8FIY][R[~zPiu8 HH&cg9 KƋX1ke. ^TEǷ3GQFpq\4ޓ>QWAZCJ(`1z^yq%AV Ī\51rglf3єxLq7ݢpɽU +Gwus7\}@KmH[xәLg#G}1y-+4Vٖ>zj;'ܪku뒄?>!z7Kn}$ P[Ji hnVO=Oq#+[ɗqPԙ7`zr7JX)n;BeWƂy-c/Ѹ]NJB3`m3+~kBrx͝jt@s6g2S\J^f82BlQw o>?g7Wu'1qݕq^!p//CGg6LZawXJCJd8@Z:F5x4G&?N[dJy8/D\ZrfBQ%&Nkb(=hT5V& S) j!ҡp)oHOpWZHf]KNHhp2%Qǿ6`C8'r z|;_jWl_ ELm+PU uǏ(AɳI7n*#L6K[зDS-'#륋R*Q1hfKڅi>gUme^ۺ+);QitOnN !ln`j^ [Xظ*>at]z.h[z(fpX06 A !{Q³sWdJ$.P]mz O-GIe$Z?pÒ^902PCJ{#/-% Ƥ9rx6F?9ge+dJ2TmxxUJ`iːg&-JfO1g,$B{AK Ezogu.ՒoI62eQX  -DqK׮Ul௳yZ,uZ҇H;G/DYδΙ8ˋJŹݽQc <9DQ/Pm P-YK%S&>,ư2\8m̕{IorNZU+}M3 )9{`d!\T1pf蜠7gc]V5a"3)-(>B'`a_ U0b07,iŢ ~Vc,lO-um}\ Ο; |1V>5:1tZy23$9R>Q.mɝzؚ!XSx6ҙPTH~/'7X_g ; +'iPT,U!jF3Ea۠P˄ݔ+ 8{Eu@xa;/ Y`W)$P24l6-5`' .R褯3!1ݏMǿBmW'1wGP HI>dv{TT=u ?$˙o]H5K6,pWE>9 (VhA2 j\2Gc+)$%nk>[h]Jp(MV'-舴)!2W>3ْ<ܞh~yj 5q \R;ʴ2\fXitҞ-6QO9煦Ŝqz<ϛB\@{gCՀ\l%m"m?lajnޫ8iLt0="trUDuǬ= 2Ykx@Cż}P)Y,PnzkM;1 ϑ`> yNA=ĿJufyr[,+<:r]jLf:^n5Ur8A⣀Q68E+n2#Y$]W_5lI) ʈJƌnstH,A#,ڡ8O:1TS_ 4kZ AhwlWz~ھD{C:QHxx :QN'7qFڤXVqgͼVV9K˶*s$d+f/ut.b'6'W9y)[t _`ͭК]C%!pv ]| P֡v^z|Z)*XΉ~XqCNjVV~KNp-J ޖ:J.9Od)vZ8 Y2@NZ}V-Ao~K}j.x+#Hi9GQhkyi^JֱS^9X_*hhɊ\-`N]6Et".n z]I\/bT;W hAҗZ+]eeeZʑ4 WlO=#쟉bg2}!aRO&qV>0rc@CS;BF$eEe41HD.h+ r71X=ݛҼj{E@4$Sѻlkwr,2UK>jR}m!ͷ|e6E4$RMӅ#>.nykGPw܃6Ĩ퉆DIyOnWm3r- P5w}i2Geg09G]Ώt w]Uwh'͕Ř[`|]X_~XTQ^=)2D⟵RKc4U)>hXԨ ~-5W]m5eSzl^GشAhʟOng#s7M2SPOtd"U ɌQ@zm Pf'5|>PkRL`3xSGNc'>x1M`3cq2Wj/OmUq@$x\Z6Q`E."0t?},x~9s'‚>Z);qE:^.\" nҕ&H&<.ƤD$ʣPxٛ ( XfjNA@QgL >y>4pmDBRЂټxn2L-B[vgFW/>uaR9c^TÿZj[rҽGcΣ_1T/2jƽ^ aEJ_Z8*޾j)4 3tnؘlhUc-sp MRG!˳9ښA1E[=R 6;j~j$ƕ,yGVi{ V 1Cޤ^ڐۚT!!# ZF흂3[{)u^]bAULa.*7hVeͤ(M7e"dVjz0`| nqm%|00J6 `0;ݲ}/ G )]M;uq8S&Y)V8`cZnMz9  K\=Ѭ'r!B[h}BirFy1] =*WD:Ԩa>!a |Ung1Q{Tͩez !ײ͠*zTѤm6}ԓO/-A5+#HG.n@Aҥ(&a ƺlH9VGv/G5zߴOթh(s5|Uw*}Dƿ_C|=N `Hh]3Y [z#|/ݘ{) lzjM&PdM)S3T!kZnJx4rt ĩ\ bWS˷OʷdWjDNk|H|$[G8nx)ԥ"T, 8K"-ømZ_Ȳx %h ?iXcy=Է-F:Sl)jkn@ $ZRT樘]lIt&76+F.`w"<Ц S) }o i1ۊWȠ #:ڱC9_#"+",0*cDU#F=IBYܽe͐KAOĬa.>؆o)թ(HFar%Fy 861Y]oP&'"'%5KmMYkh/D _!,q>]{ )3t9a<$%RH $j&}mk SEPh|`/k:E򓫪rp*RջiD1?ɧޗP%'LCc\W˝AZShvXɫ\)܉@Q/4JysSsgU #BM|{>^ ;Ӷ/'X^b-o"h LHm1KLJy })TZ۟lAn ,= Y J5qdfۙvai[nb Ԗ8P]m\V]M [2멷KNWKȈ=}How>Dt~̜3%|0\K+!uoDSYRR@EC F6A;,J4ِ,<\'F}Ww(ՏFRl9 dSoSF?Xc \%nOoM:Jl׃zaa z6ZICR͞9E?^4iѵP=*@GPM7U%~2Yi:S F|ن |QĝecZV6}b" ddT>$f4) #Ƹ\_XW gNQm׊s ^| ɽ^,YI6V&ޕK?p|pƊ?]9n?]8/ʉIǿ&;m3II7 "#3oմg̮Bk=t]=/h?;tӢa$XN30~WߞnH샤arJ]Qwc d_mj74-8Dnaqhhx Ef6[ʯ&?4%LŸ:6 #^OHʊY`odE4=bRa:veTPF 9C%i"rհgbyWȳ:?Qbf8j=6Bw<rU"D,-iy!O 4=?"$׭%POWOwG{m]CZ&D4]4JT343h'Q(kO Rf` $ 99Yqje@ZnM >_ - IN)1: MF)wݘl4sA6uR&qK 3v͑՜-9=ޱY:| 5 Ӏϴ0؈BEq _tv~tdcOPň?`3AQrm5ԍ\"̍\mW6ԃMbN}U%/ehYs@PZCRf7ȁOSD :ߤwݘ;5F{}ilʺ+2A$0k;#iu(|G&ijE&&zcAc=g#%xh:R[c+gR^7[Tvl!qlq~){W8PaX7FyhJP{R2qi(La@&)Kf_LmXPD),{|6iX :Z+%#}hگu(Z0Uȭ(Uh\sB@)`Ҟi.;V ҳSv·Sĕ?sHU]RhE PfAW\Ǩ+i".U0ט5F4LOU% gL.(xǮKV 2EHד t@CGHpPyQp-BRRdDYy_fY:^ovhu(/{Y+DZJ硦ƍEJ9lw1*4}ww tmfMA 寗./&KDS"R.#Ѕk<8&t5w oIxȮ?9U*DDWGcB,w5#h') \~oD]^0ֺ왊)[) I41V6ӆV{jO_vޓ8l[-*:6שNVbSCZsL5CQ@V@OϺ`b-`9#s7XyoĥU&Mo&"@i+Q3{ _hHC5$攻mu:H؍eXT7$Tek⚑KLIsSGNgCkO,]ȧ4TFT9E34yqnHIsŻ`,puP%,30ޙ!{șy@ܡ\Bu-H+YlPZL=>6c%ip/&MY!.PVa}gwgPSjM[*g=mCGjLid#.1ZCOHW;KCF &qǖLsw8-ڥ`{w?H}2v5g J׎8#MN5Zq Yy<;3XpݭK YљFNte&a{'XpF*t9wb}Ǵ*:7?4s^hG~0Szr%L 7˜դ=nJ˼t#iw]LAk(i9B"G",nLnO.ᗃ4>bz!('9Ę1 +1@ۿ >ҩYRQ Ya-׼'HZf_PL=3΋"KJJ/8yMUTp.2vS"G^z.JívJC̙Fk/&>Osrսf̔ ǻȧcƲb-vMTҕoZ ܒG4z=iHW@EKGh:H#\2̉j"ȓG ,On"Ҡ`c"nDRɚMqZfW}Ov>;mEC JqbeNO%@s0uw]1JIR0YRfP L2 եV[Ϊ {ZSK'1#P j*ZؖeRY@ 8r#n>̫T)pE`95@/CkVu=u{@ – du4U]eؽ ?9 -QۖhL* rT2@W CdQQKfdϹl={o] P}kzӺRjD sHz˃pY2XfTnۆVU;&L"}I =M9v_62AjC;==L*sUm La.%VB7uT.1~oqaԉ]C^YߠXa&\E5Rh|mQrsP֜5+Y@imcIv?ܖN3UMV:#:"C>N!"TkF<2 ~\0b*j7CLby)N$S v۾qjGE'mvx6'nS@lS԰R/dޥ&:{#g%\5sG4:ztԤGdV] d?jC-sqb(}Jl~R`jqה>P Eyh6|ӨI}?u )=A},ڻ'g!Z@fN ށ[Z6"oķ ?*jhy̓ v*sT.;> 7;oM$‡CEqe4Şu8!oU0m d $X_?i΄U(|ؖ-/ 9"?$rtHNyRP jr/ǖ>^2C%"uވaƁah~hx#OkoËM\;H6^ ͸\ZNҬ@|~1&($MIήooövh-UHi>o_K«~w4m=?G!]&CYz_,ڴNv?^[#F+ۚO) x-)BfIBmr!ՋdXN \ A@jF &R(d&t*:kSQeu3=# X2Tg߹Ôό9W)._PZ"ա`$0S՚)Ug~\Y~*Hn^> cs^"gO a>}33Z$fb…3 u E 9ҍ5bCə`kEP؛t;De6:SO9ŗ$g>Z/Ic^Y]vSK8z!-^*G~.fyIdj.*r (,|n+(zAtx%"3ɹUI1&8~f KU-<0Zd͏,%G9(; QB9OYFx[Y!R]0}FJRՏdvWEgtTvΫoƇ>%Ġۄs:vcST v0Ad4(5YG.5]Fz{(FrL%oFRr "Bbı"e8"?$mPD\i9"Z_|Ս7!s 371BMB_\X bΛl;iHkiCx4 2D]=Kq$;fu_GZY6FC2b8nPѻUӴ :eBIǸD|#edRPUyh"[p?]Z$ z.hS S0ѯPsН΢ X [^i >*iћ&* Ou e:SiLj3P$H~Yl?cTءQg+icJAŴ$Vp$>z/&Q4u+qB+ם1`o~ٍxul;. Ӊ 2gE?O%}Wۑzl/5HOuU&y^x&$لw`-2<%Pƒ^9JNmT@(3VEC"r-@f7.S#bz4djʛ^/տz*:80s~5z*`%lك8t5֢EKn3/Q!˧ :,$Et]nv/b׋q8 w)tB^F[ +A`ɍo)7n-=va cJU@䑣)&JH֋%%vL5]N!-;ĨLYog»n#n C_g 1zmC7y E^$mٛU Y,mfH&?0Sj|3qo B<~S~ݾAhm<$yɴj풽Sg[ot'ׅ8h`z; HT}FFNkvfE+h.сx\JE:LU5 KEXH#y:Nv;z{lźEc8mhm~Rpx%7U86XYH$dݭm~qp9XqEQ׀\ թE$if&⥏wV@xf|ڪojq!>ssHƛӮՌJ"(\|iA^qB0>G>jP%^M̊OݬOZMa h}fFb鄥k/>gY}@G&Wya#)b-5LoHUúQe $wQSkbYgwmqͰ؎N4@QעEPhJC47} i"(Te!|$s#F{U=2tQqTs'E 8?zy{=P`v}I- hoAg3Q3gwѝ` !/YJf2);nQ6SEQ\WA/bhPpI$<.i.Tk'cZ}i[n)}YcK+GՊ}NV#rj>0e "d1Y D2%t虘f!‰XD6I1 m|̰MxfSFlaF?n]͓qҾ^/SOqk:Frӿ DX`rO-!}7iH(mTwmc3-5 ƢINk!| 46+N@Er躇-g7}%(-i̖޴rj__Qcbu~[H9cgdK(`g"i3 AɃ 7OI[N}W}p6LrK`q91͂[mYPkywgOV/Ϲ%2Pf ^jR$)W0G.ue L?d /${JLGk.U2uё˟CK2W'yʄO11f#;kq0?AXUk~$ޤV֥_,>ܶ*pEP.4 ?dy]9οXud䯵>@Tc LY \D9uG-Q;܆̅87_BpH q(Ϧ v7A]<4 ]%#ȝ/t"f=F;וCIQWrip.O0g}U98|)k@\gz2BI#Jcſ!|ÚPObtKQY(Q1:~H_Ad ̧l6QVL8p^!Pnml/*8j_3u=sxZ#gZ1V3y迿$o+qoN.y1mũD $K6ekt(̕x/i&zv]=,C>w, -1̝Z|ajo`:[_zဩ"ջG8O3yH[M2;\V/f!=?wDRJaڜn=S2)"^Ct;.ou}&knyjlW˼m T0 zʽJ)yCp=dUh0#U>j9ei9NX(N^T҆,7='&àfeM?^['\lKȗ,BUMZ7 I~7VsP//]/uAlZV4 #ոy *|ɳa!CDŽ?>rq|i!ѧO_/UZI!V^;hŨ*jNlZ G/NjFT\UؚW0ʯM]%ifg%nqRQYgI`eucbFJ!U\F8+K e@$yTGPmC)atZ85:'fѦIAxDK쫳`^WD*:볮` _u@Wq*[{VS3bKthr%H+!j54ۓ]0̎\@{&'aB]{lJТxa˜Q&' .~\67/!7"QPMl'mp 5݆e-4Lhn}qjX3I`[7 sޫi932VKmN%qdW4Fhy& +ecN ~N,e t߮^jd#M2ɧEIm2ȼg1mB Q=.Moc1m0dNw+ "m6ຜ8s9a#F?};M,0&bǬ._\CAGE76#[GS>S$5C=(wXHp9UXaoySGre*m).zUJS%U&#YAZܸW]=zFـ4'h=~ ƃ(ma 8twS'x`ZqٴW'Yr;&O*LmNJtV&$d ˫>Ocz6s~,7 s0WhD՜`=}Zc/vʅw5W̠S3i} wlhT,SL6KmqArAeo'fgZ;[JBFjLwDt #voIi RPu++y R :l_H{YkMD겺WTu!(G4|d"׀Voȼ{$QgǟnJ{^\gwaPƞ!PbUv2 >,:!O MEp؈O5|O*;f3ʌdXi.qbE * E4)\5S4ְؤ%Ic?Kh^֠ MgIOtUW;H.+fB19ͲOklJq_8_.mOn3Zj[G r8lKd[-r|]z3/=]XvQA4]~9=܈oGhnYP] (]maO)mto*!i(=ENsLgcn#|~N ҆W,/OՀL_G AU9^8? f䅦4eDQvMb^`x//?pn:)ezȓzoDCCavKݲ`D*bN<"̫sU@D.^2q,TM*0^Z01*A^l8ϨgO3@$zɮpYȨ@*"/5J#DdL2r&8Bgk1(q9'r=s]<͘|gTSn:7]c!D ;L*&.* 1s[6*p_TMP8\/R L%!,i/8{}>e$gjМYh>^d=n}F$NR4 y¥m.-EIܐM[ycqo!Qd$%D`2MOA]QCV^ZD2Yͨ l 8YD°V\#Vx|9@cW8jvGB6`oF&F*?dQa%&9C w2kB3Kd.قC ~AzW;M;;WڝKdrE5폰;_ /3WΞt.xa` ![yؔSRlQLJyZhbO- ܌P*P~]=fz-ű|Dʞ},'Y꒼`np&:+2ȦD4{ qN0[_<'~%1[#O^S^?ERUyYЍ09-9R.4`4D`[[Ż,Ў}osEvI}] [h_m ; ǑSbfE/"V9'7-Y#D\Wdh=|-%u\l_K\79B*Q9*Sn,HV{Nc-SO8 -Vlmb&Ynl5^ IEGV n42Ϲw1?2٪ QE?w3Yʤ`/p7,c+O=\^²DQV30gpM6JOryCrv*EDU)-N. bsl]C[z,GI!1lftgNL/-I %wmY]`}^ Aܦi:UD R1kT,Kw13aJʭ L/~;E׶,h& ȔlJuGi4CfDնD+$2f.ږ=PODcdҥ lUa>nla% Ƿ kl@MqrN.~!.E _=B 5 Л5@ԧe׮YvlnLkGgBd[4R S Ew2SvJ mډf^ES%]xU(謻sОXU{\#.#`O*ԩ=;]6Fʗ0s/[tfXx%pLxQ2!p'E=?k}/(mU|qrCRѹjDDzEk&lS\byqRS6W#nN=!D~셢\r)fx{e#}[Ah04U,Auyb<"@<|j]ljc m72`rŃK͊U |RM˴YjP!-KpCFZ"9D#K^.''A %%I B<&UZA!`L S>NM+bJs"^u:6> 7nz|3uMD* b|a &5!kի$_11ϰh2 Jy"DZM̮^ǭ(APU &йD=}!dkg;SvMZ6aI¥w4X* J$T{dD' ,UE)H_~QE٧[NRvL;BK_Vԛɭ;=ymޢ k;(+=CVOK *r~1t5>90аyn ņ8QRO -{Z xJ}qHhd)I᝹JJqZzi;ݖ08+&*3ΠBO1Y6->X>ߜ}o/Mݦbڷc^;h)kbG_pm%FPp`e@H:efHoBLbFⓎK§|4OE҆^gFHܛm ,S5C,2PjBZW/BXdkσuɃf __4YB0nݜGc\&-gp.p>a SdE{z{0NΖ;x:"뵞$̣b{v#jKp _I' mܢ-ftjuENO4DŽ]kv`d~|&S3:qK|@hUWQF8cqJExgyi;m\LZAFZkM6ZCI7i;y*q5T$;e`R7c|E^ s4FӉ$-˸'̀ѸS{YE#{TX1tiy7K3lR=Laq)&mm! 3НP@ l=vmK_P&f*0}ɼF{Hj"?MnlLUIoc-lg$yBG<]d/D dvt̀8HOVϊQ* ?VR9՝nKmʿ*"ST[<ĄJl<G 2HU| zuzUO`Z)r{1!A\T--^k;@ػ!1s%2.4nK@EBTU|\]!vMP%pQ~ӛZ$"4&늤0NzdfO0T(kc>⨦cgmjoq er3 hbdmn?` - 4}6wXS>I *c x&I((b`6 #ϦlQjCQ wSt@MI˄mL BTr]< 4X1ȂF^;GqϘ_8j$4,èDdAp2f:m0xt]В`]~ˍrDgjtrĪ%1 +h@ZDnsWZ<qm)>zN%^Ė-vCjH;l O2qv]0]ߒK_ B]Ybs=h;}&y%,gRw42T {W7Z HkuNw2!'ZǑÝN;E\?HVS7:-GtIYCA>`Awo 0W [{'ą`޴ Ha"9j?ʵp'm*NK]d)!cmȳ^^QA+ysJ=~)`ncfUQ؍mUJ;ѓX09s@ A}+mͲ,i3R͕;( 1.  y$fIVY+VVFm2gޢ]6djhaMtDa C݋!kͦ# ]8As}bָeZ+}i?aCEǰ8Q\*-2Rg4xDnp"3F8V2Ŵ%3JX}?tBt_VToo 㐌x5YjèU+ʿRqc zDe xHwp2 5l3\4mQ} U&?ѪtkMF?[@Jd3/E,B14S&D|,nTZ9[ 1rK'tдYyObĐ* cn,Nl{(:o5;yHm }݅Wy ]1zBp%#XX4k& z{r2ґX'g#ƻnf#L {06kfb&)OvsCˏY2OU1BԠ=KAvrxȉ*UHt8޸ܣS`n,"KPkg:1>Er;CKsmqHTIJOq%\igƠsa78  f|IˮXlp, ܩ Aҕs_kkT*xKdD}# PK` h:+ SRx-kp^Ua"Gϛ,gh3,Hݸ8TjoJ-!&8 @ywjD,-qx9M}{+h[ȩy2bT0EV?$Z)Ve(DRO91* YuˉcT,oH7!5(5PD̬ ('vy9f ؇NQm#.` ]!nӍEVpKbUq_˹PGU.l]q>mܔ8Hq6͉gwq}.V%>%1;!ߖrr({$qhAEg+|YGkxnTe6!mџK'l.v2 }:Y"C{_}?ZKHAl)+pX.╡,8=EMf]<"vW3ZVI|1PֻZ^h^偆YRMnt|ZeKUeT;0a/"P3)V}Y]ˇ vUl pH#Av] ORϱUGΞw~3'JBr%ē]؋Kk m4?*p<_ K-&0k }D468RAtwM֨sNY-_p 飌<īf .=@aP1& K\xs/л{2hr@&3-?Wu[G͈xHԹEmb'r>. "Yjcaf-s6kyIlQ;즴gfۯ0d.%7I݇CA2S0 Lef0Y7!΅S)|VH7/'ٸƘnnE}~ˁCLdW%Q*T^+}`R"U5uHĒjX-V[l|vz>Ӎ"jjy%TԡqwgЂ 7c]g*m\6-~y"P?Mރ6ݑ~ tr 79rn)9 a b Qw%_dG1\(ۺA]X™- 1̰s3h d̳F(;yEr";pFó[ls2{JF{Bw.J*xVB x7\9 <)FZu z\&:2ԛA4Z(|tf0T|*^-͔ UO,o"}RDnfser>#^Աq49ǖ+ \u0g"~M ӣ5KH>/2:9}IKo&6x Kċl. )3tJW "]Y7]}M n݈O R>jƔ1G+,wUMķ#h!R9reu& 4Lህ2bs? 4Mh><)y7coWG%XH2<-.98)kI^@< h%8;_Nũ {%[Ϊ[!WۅKzM/7I^'"BPSǛsI֏pJV ?xVPԯ-Qd"ֶ/3s Anh8.b]p?zABXոn{R=a ip;7"jmaV,h%\$g8ݢ,SJK: x6\&Ҫl NIwqXHFTZcU撃].BͼXdWwbKi, jj UymnB}0Km%5*uJe8XmJ<_k$C,-[c/o:X!J>3@m7%/9d7K׿e{)g@fsWNKRD=k0+V]ħ6ZLO]IAFzVi?#-bNscuP^@~|ZG9"eMtӴY#4U{^ftJX/6싩}q:k!YG5A$O#pV H?^jNK|?e 1nYfpfU&LÃx 31}@[p" &񐨃fI}CgbE{u$0KMB:C?v$uaRX|fn4u=&H2=DzJ؜]:s/o[ZfJs?+h*X1抸'x7H'fmgY;^hNH!*suER"7_Ge߉s>Iq И2@5ƻ; WD0"k,+Űu8]hErs G(vHV 0wcS/[S'Wp"]j{v;#}{{@f߯σK _à w\T==,i˗U4 ΁_sANL"A[uTLQʡؗf^]QzA@f?9j\p`x'ZQ?_/@H($ѥFz VT'2J\bkq+v/Qu ypWq8lt_xp b-SgKOé퍎5էͺ "MaB~ϖD[ҼdqwF[]4|%nMKH[Wy& rؔKA^ǰ*1Y%yy8`˒=V pb'B[me>q䍟OmyQ8? ('qhTlLHRlyNnLXTܒXRX`i]We,?IӄH\;Ix4 W5fBdcr|B;^d9`)aQTDQRQ;}8$|#-{/Cf \\ FC81j*by3dȵ:FF|ZTJFm_b r0j4;eH'sU_.Z< 5xJ'"B:;‹|gGs9[BkC^~$d:e',Q픓+wg#TQM#&o5ՖHBFΚ3dLALrFˇcyrJ!ԓbpٟ6EMɔjj8ƺވUs F ڳ< ֛@Aꌦ$62+i@%w!FaӱɤIFsSF2hИ*$HvBx9KC㷘g򗒣kK~Җ60_d>B.?ȻR" %_˺bvfo#s(y*7v+-}.U g;E5@qbuFF\wáNQ!R6@2;BËTMzw? 2D"^j|yfj[,{\#]y`t|5X3RD _qS`p,pu8#>!l>`J[L&(թa'-oG+eiBbiq=𷇻:EC _ e]=P('ȇ˚c(TZ/H=8W(&Og(.03{n8>]YfF/cw >ZUBs >UAV6ͪxkoSOӁ>1;,Cx }ß*ְ2N,dj%L|}4SNǿ @]RX,$֋it 4CѾ02{ \PԹ?ʵ`7e0o8"iss:}3H*_! %iT 0n3o =;cWn S{<`u97Lc89(,Otu=E)y5xI)!f6ըeEl1vIoAK'S_ VQP.)K9s)(Nuݶ.کSRGW?ּ:UT=9)iF!$2=>c~M&.Y<ܦ^@kV_}i -JWB>?ތUݸpH'vV^]Hu7'ohEc]6.t@boz=>Ȳt *gy!lky@tP3vLjEb[/~Zi\P*52=;hK!V؝"}n=;쌬I5$>9 ƷZron8*xrvtnW98tWtuӯL.ͼ%:ecOQpZ j!Ǻlu#2 zmsx;|>F.R;;̧'q鮷ےX`PtmlzOnta~78SP/Ufl>aݦpB.jj]/Xu?/4IgJNs}+q Qbk~^-mR8?oP-T 9WqnIȆ) cYڌUcdrY߆&p9Ny f u6 +CίYjhZ3 kz5L uBO09$&Z%T:BY씾3(~$\ {s~˶G9iZTŸw=c]Hޏ׮j#R57E;.cD{=«-^<Z-RE?kfjꗝsdB3!" ݮTB0!!DW(ۭ>;Ur?RyNt~^?8J5zfEzpѶZ۫#8w*P8/4<6M`0YAy9 M.ڌF5={[z^ճW81q5"Q v5f񅔷TGI/u I,:Y~ ͥO%FGϚyxxZGfjWࠣf,1q H pp!l ,cmz&3VT yQ6s\Ȳq'u4/=0{0zmXVєʎ|=Fҏf.d,4G~& RLV I/ɼJR~Ժ&HC!OՠB9#i({q'MxU#c~bpf`oz|RIl|E >߸sn;zQdK˄юԐ5Jf{hNṲ{FV+ 4}~~ٚ3/?+v*YSxYnMr^ox)Y}m]}Ak!fvksghulh1BHqQiWBd;0r`2p84e7b\DXVp2H*6KtC*Xj(HboCxAorB 'q d,B/~qaaK]!ߛ{!YA^W9䡂94FKMKӪiVXT9w$7 3 722Yݬgnx;1XXD{.8lށ)bYқ(W:Q )odۤ9RjYzj,e'z>7 .ϐOo%DWfP8YB׆#g͠+NKT4"SeVrDM 5CpxDR•M͘L h#g\ lq9eMcMoM7jܓWWL;D>Pf  XZ7 YBXtzP|k'̉Ȏ/OUg9SFѠׄ )<ЉucD og'1o(ľ%G5 Qڙ? N` "̙lbѺh 1CkG[/9oqb^d!rQVw:"UHz!"`j R"H9&QeRm'6fHCLPV`JY:|m )uʌHfZ:jh^7N ᘟuLWs n[rTڽ''QyCCS1.yKI!~ZY`.]jSָ. Ӗ{}&D٫Чj[%|WwmsU)iXˑ.F|O`5 ov 0P)\5>șb2acWLIk\JNO௹22YUSBz;Qaup7ZQщQ Ҋ#xTl"PIdU"mꭱb9O}Y+>&DN#|-R>O:5g*yc*ȃ(-UTn fIDx DT9}͑baOggM^)-[Sg* `aK/fTM(#CL;:m}(ԟOQJqQD1Qc (J ՍN#Y;.%\ ~Pё{`$jp< +U'<8o$(+RI ·mOʠ܌F7Dr&}a麵,&[ 8-3ΚbPc &s߶ HΑMv \Чˀ$?ʗܸPos{;΀U%f{hn$9:i#|W^> jKC_b ^ojNf9ݢtvp$񃋠1e=!$Y'yX!]^5\PzN N U#r|fpz_liTk#hƳXRA!=;s/S s͂gږ@}f:i'A<{JTuUXcu )6lv o>?ک@YgGGPH+L6  WN,s)`jF/Bnk.EQ#2xgO汪Lz .&_ʔ@nd&=0C&uf'עt9+Q4>(ϥpLsTepgfybѩ6s8YMffY!VoT PITi@Jj?rsub\?U%L+ Dׁ':&:'?;oѥ(Ւc-E? +1#_Ib=!C]PD\ ͛lNQܯ1q ӭh.ެt-1vXxâX0?`2u@amAsTR4ZK*P F\cܼ8MgKG`ZDc4A%w)Z)X1#ȂoPj`;%Bi46IEzg\nLj Wk^\O+Y36*:F4&W`>q\ m|&蚇8a}{KPGQ&Yp/P\Kfi;CZ"z<:l2fZ 42+ Wqφ/0ZlD`FtS68ooPkrj$~p9%Œ+hI@;=?NjKV+,L)6?u@}|2X8nu8E+/oiV Xg}Z-v:hdj憹EZ.rGzEf|5ϖrh JfY$!xXPϑ>[n*Dw"p\`82Ƈ8w [ ~EGDD{m[s[ňN εؓ;SLz)̖:8 4 dǻ1$ɴI"Tym[y튚RAq;8r Zζjx&5$N%3ЄbQ4ЬVfKT7z `qFCohLr 3TrɢyBQ,ًVwV3GTrR\Tm<,M~{_RRu,7܇{6$SMP !$ep"c\&Xfʿ΃4ksmʋHo jbxw I%ﵲZw gtGm4u8ArJC±h7HM907TQZff+,"& :19bbN|ģyp01Ӷ:cG߽49/ҷpWE)d }#:5jl۰͠BYH^aZmS6qzo_wZXߛnh1Աb[:$ V o,1!\7?<E3hcvltS˔\nSOt8iR腍R%\paM? ܅Fq92*6h|C%;ڤ"U>vdɌP7~Pq8"%G`ݑ^4(J @ZWD4QȒn!_A/ʚxڂ̉rDyv <i$Zy܂('}P#3;74t@^눠0k cf l`&R$7i`9Γ" 7o^֧v/QI?5ΚijpZ+[ZEAZ.ަ&:_#]OP*eA L8c%4J :YI -¹afc~ JPLl7O(5D/t/C.Z_ 1Eڡ*[;QGUP osh Q:L)[a겍77< ޹yO.P:ngFF&L|5cv?,!%~XH$1$÷zp}X)&y&`w?lY ṠCv) թkf9ʎz:Mۭ5O[ m qUPneW{wD;^>LӘM%Ő̭v)mv giHUVt]X5zئй^kC@pM89c34|j#S| W}X(S թBL1@c/52 u;=C3`~Wrv*p`M?gYOxS n{=~QzͪYBuTp64GA'_w!T}r_W4UWmV]ꅻkPhK:2?xE=>٪D?hЍ|mڋıȷ [P]Jr^՜˝P2nQ\weΡ9 Y,J+3Dz,:+܁<&Jfi~N͖m A4 X!owġ&?+&VfGrX›1cQL]]0jO1LN +kQ%]qTBbY>RqOL4DwCv#5qɒ`z'f0f&ݡ1I|E9O< P1݄*7j+ZQjBXWz V lh<'D㐙G!U IUh;\&݆tc9,IH)O f Cc*E-s)Y&/ 4|e41u`P" =VĎJ=do*6-'\~uآ1@{Lz3HœQ4ý7[ U RDՈή2Ј2>(Fi2@;O$Tr0#~@+>,Ԑ .3ZAtw.IO0gZ$L _~@HK)l.Nn-MH1W&iհo #ڭs=@ݲ7OwK?S0:x|2'd }}>%de^BQ eV aŸ9 v:RE#\_=5LΩY9EWb&) MDY|A_ 7=BP`3w1Dz3ܘу$WpAkAt޸e%8?Nj}TV$>?Ϩ$gPhKBmUOkAߙ+Xr_\|zXp |y R;ft4`clXLL.0}uC{?I`6|M=Bk\5;4Bn>+&Q%5_֠+ƂL/P~^uQ}6 H/+Wr@đUU*(CB[f4KPU.;<υH]A1S7# "1iK =QKs$XGlj<*S~lgsAny8GpQZߎ)U DpmrvϚrfKFy76YFU~Jsh}u(Hc̲[_x2 õYgyzkzP=˞"a cqdP=1Qo:?Y * DsA_P]hj?kiOl$ΨM$]OP1+bk-)HW}q%\_82"96tKzNgL} |4@&h*(LԜr ; k#\- :e{\W‚+ 3]ToCW!rWvLb&hQ eΘ CTWI%a:Fh GP:;L\и\& b#AoV'-G8ﱸmC=G"3>;Du9DkB>˚rO&LTDVQYV}:<3 ҂fU,6 ~xI4- kM 1ON5E ̭?O%$q!L ڢ)6f7X;Ӡi"dIIM% xH<k527;QROoPS6[iGfc1R$ K!vtE<ύC3dʨiqThYit_DMuŅQUDe <$"J%uǴ dp3,Pz94fU6b MufD ' 9o9~ljnHY[ &fuFVP2};לԐ):RQr 8˶Q n(T%`F@sp:XwB.-QBM =3q'G! A{T4`rw󇎗G2h~ 큊E qHp[Dn2/?w~:߂Ĕz+yn2ǡXg ?>.S6„`PAȍF F$~ȥXL$_>*AM5(oTf29j4øKHp8 H^{1֟X<ѓIW׻Ȼ/ơ|K  X?Lrf|10r#cJ I$KDX G;Y.UnB^y˅lٷ>aD8h٪SCyݼɋ' ̿frcjqQ;pƋ(,&iHR[р;sOn椬uԴoe`V}jӇ_8AVZN\WVcI>&bW}!qE% R,~ O{VԺFTl I%$9𭚤(T-)Rf]NJ彻Il.hP2iv)Oa4]R+}ǕTJ4ƚ">RԃrD7diELgavi8W= CeoӋ 23U)NRB 7W{˸%=L: f G>Y9&Ӈߨ ez_^ߌzYZb(t0zc(#|[_&֢/X\Hy ,2U،$>~X9Z#S#E '5ȉ1mDC( bmV<1aȰaMew(3嫲=}^zՕ [$Y}:#遗!5244]3FYB\_/ YN n]TcB-2X倄T ݛya=-j+%s[/!폢y#Dͩ #%VqRRٰS</̨p"2WqFndO%J1Ѷ؋ sx^`Nu2<{BYJ&@JS+ /˖ 0FrO^)#^y( U:0K.&W/漯d%"9Kf7 EM rai;[/s_Zut=vg#p2B `*e@jj}WG -\DAQBG+35ٙ˧Mt-g'c |$;b1S@3Jq]heݤWי0]e8P[9,oWU&_qi ZdPI ?`Pw[9AՎVTf*]Žc@B5$/ƶniT+%yS6coӟbJmxяTfVG 9R/CLkX쭟CUWb7B1 dҴet4Q jtW3tF'Z<!ck%l44 eYt~<&8i] !A(SVchMA w'%z7n(^M̢ ~Z/ҫ[p`Ϻ.qT;l<}Ք#v5awM_3 7ЖTO 057֑Ӑk~T)$ĉi"b-c@Qk"#cyN \,ӋvӥO{imt5u f9:mGer$#cQ_!M`ӓ?D`eCOQpd5`PWS_;6-ӒU`bڭ*AeꪭBYLڗdب7R<Dq`V5))+\@ w@VM vNz>}*?lv.?n9|}-.E`"$HW?g(*pYf9 =d6{!kw4wf2Qۋ9ك9~}ֲ|ڒ4<k˲ʡN͚U';d*H(VB\%X˨Et=xS_v`zN]S,,,7}rb\"_LD>xIxM%3Z'vXy{lwH`EΔLqUwVߓN̷-gЧ >DѥB#n? m["D_s!;a]Eu[F~I)̾s>x?NB7LX2:櫣,7RͤY"o:r7o`L>̦:mn{;K?ۅT/㇌E>Sc?-2]kBIQ>Q^#8|g866M0ECWH!a޴湓#GGIt|}s*Ș,N02,;+A8(piq@: ,!OrWRLs89-рEpH +sӳ11f}cCeTSг& QS7^z;KlVzgKBp1Kh@_{kXLkW] KȔC2y1JOP5ݡӖ|iB‹ dyʠ1[4XE҇ߍ8ݯ3~_viS|uaNיOƮ~}S OtK?.^Mc5ǑyW@k"b􅎧CamcQA 2W|5]Ȉ&:'Q)p~L.AV;/. aOVrɼbL%2Ik_H8@ 89DSF Hh/ 4eM.Ej_~`uW!S3*7Lތ ~B41qo =NNM6 2jwVL١7j@w='Y@xm=D_1[RVtILrMg"Ku?yt?r  %-+3 i4Rj}mz{t}ꙂHqvPZ{}XPdD+ )L^j^AXPLz8mC\i8LԀ.*ԼT8|1V2;_d?Ew$r.N0a7-6_Hͳuѡ$$)e‡( +Vp}c@H#{8I:-͐Y(kCں zҝV,*`wHQx7/u8{}D˴ĭ 6NWI8?8{כ(TACqG;68v$z"CeN}+ʄ9**\iB;D:-$-\W ά`RODsmBE#IK.i!sST HzrGdw&ݢyH~xv`fLJ%4(a u&.;lbmKYEsS1i_U|mqy +2vu#qb +[^9PAR)_'lmm2+gUwQΎ~wjɘtȗlja0b*iY'g)~.]F <-Cy u{'0 ,g%}Π@ivϲJt51ػQm=W-2xo>V yLܷv _ I}5L.*4/_O'NLOA3kCܻ)1m? eUMAtu.>^6I9e:U-k.?fŤ6NZH/s=g/1^TۮRyB+&Jg.eH_ƃjG.ؕg/4~+Q,ԞݻDh Md2U"_⯌Ck_z0V{Q}kk=*y7|Ao c\b O5&k!d0YsCH8״R/h;2@JŌkUV蓑md -e<x.,B?8BS2nX}kKy$~0.M502 -@VqvY>1W{'9"*|үԄGxI6#%TewE8>g"7P9]^\5h?3U㪭S:xWm8MEcP#(haA{/kb }Fm ?'We@~+݁{b;&_Z@QKz~~Gh=|h.*l`}/EsF8& FTj|Ԛ3?LlhD*: #/;)+켘X !Kay81Zsr&^C.Oy/$Y;R|YdCVHLö9艄4*=*Udup doOgqKTS`ć?]Ey dZ%Tg[8՞Sa&J-%Rنo*q[7S%+@5YofeӊMcy.&מ)`],yZ4RK"e}כծfR+; ?5{u zzdX=NMB}|ȶvW;LtweEU@x 9T!գO}L͚IqzzA3P{9>xY][K*AhK7drVrX:\&@7 4~W=NK5TnnwX]{0J2e=tvV#+% iQA9)!Ċ/`)GvaO`Qu8AVC\`f6]x#Ymݛ:›(Z7Ә&&3#_sMǐh'):ވx6k*kin//|>#}?ԇQqu+dO􊑅%em:VVKX' 1e܂gI"_7H].?m%rJTj$| 8qsJ{0WȈ$zDagU`Bwweb^AtX}^Y l I?>2SPG8h~r NܩrFWH`Y Ia C}J=R^\ sZM=<ﵩ1)mwORKWir\D[ݧ{+P[٧ sAGeqOL3~E!h뭔jl ZxD td*;!^` ›qm?}a)'Iޡ&Iaᑤp9!!~Åi*'Z*r?"6Ϙr/[KX|v+F9 > ʭ"{@+ŝb ƻu= !Kz#.D,,.+/ MضĥT"rvӚ`K2:hn;t#+aJx5 :bЌ[  ̪"v{R 1,淬i3pߙ2Qrf_pdjc#4֩î,$I!oα!u,*|2& S%(uQBu,HOi]+@ 19Ǎ¤V^)?؎ 8EAtqoDlG~=]t9fvb)lC(p6J%l~*xok{2Taqм` V#G<_5I_NYeSyEVoX^XAn|jWV{Ac#Vgž+tyfn_MzA|5Wr1s[t9tBzJ$(Qժ=v0O][U.~|p6u6R-^jٮg9&w߄*gꕞI} JUWD!hqh%I8zօawl<2 uJ6*2H*NyG=]=Py $-]O<#轂+>ŵ!CGhGi`/˪E2!<j:Ƌ*/ky@F\oH2z򷉪ޘʾGSHjM2h1u$rh ;\g )$\ߛ\Y:5lMXG%g7QczD~$muTJIN_@/IhFB\(B>V!-ed/g56$:oizȝ0q!EbO621Z`zjc( ]S"/';jw3'&?MFJ0Us Hig1XN$ ct?9e,X5`C/$q {r_GWv"Q|-+//e3QDߠE&+%) OA,EiK=hLGICjfj/ɲ+kPv;@F%Q@Ǜ88WeI{G;T\/rI5?0\B&ᭋͿ~5Bs+w2htv@lg0*f4_ ,t3OE:$ZwɎElmil"hQY< siDKx͊U!@;&Of Ɨoo8uaUpL*|SYE` > Vgg)0U^|}܅^'HgMTʷ_@nY綥)Vtq'(IY0`_:]Q&3,| X~ -hrwpE<8=8J [|JD.u{[? -U$\K-I  gǩV q~+/A+ksHچrc*Є([g"xŝ;[OiUl1\Um$]_7b2rLt_JLJ6;R#[v=W< 'BL>PwWR- #e׳ӗ -RrLFW=ej%fA^kę ً"1p4 Fmv^>T'_S`i_pRCS&Hd %_R FHy"gGwCq吁w1ߘ[=0h^B\*6 sL4ByL ml? &Pf@>@CNt.`{c6*SۧDV%ujH78+xe]R(.kLfvLБƍ4+2@WJփUL<I0Gʇ #.n^x=%,usGBmI$`냤oT ؐqwG^&&'l<-ˑDU~irWPCNCpp~sp@KD$Rԓ Hk(`|L.U^ݛ\2f2!^a9L)ǚ2MՊMvK|j<ݔŴsujRoˠ{ %oO[0):` 3d}4*[B(F>H &2YյPfa,Mt|t%k]oN5?pJ}͌VƘ_뭏#d4LLR'9B]wFp}=EYH#pZ)!>G|AΊJlOJw 1z*CBD-IUʥ,\-{dVIOu\(b06CơiB5"͝).O`uo(ށ11!ݪ}-~#Hrmq Idё eT06Bh|;HJaϣc lBIn=Qea]NbwGicː$ʦJQ4s@i]&eT'~uӱoc}^|1D0; YRL*M*L%-p8Dzp$=w=7 '6ZՋ9@<՝ak _ % Y?UJ:ȯPK} Ɛ 䡭uJT^@UAK*4V#=`#sS\ЕPD'f 2Q TtĺE֘w`d7+R^ 6tjHZLG6*n )n yRE G6$8K͎@6Jo0`'<ͬ,-yd(iR_mk)&;㍤J1凋"YOB7+CglʁUWi,fwd wg0d9~%IeM!W۾lIP4~ 812$f3Acqt fu*9h"htL)mbf0#yWߠ$dzk:&~k㍝s` ?j'smǐ*euۂ &f/6U핣(]4?OS|~W_~"u-sۈ789w+.l[;wiXچNY2?IyD|Omɺg9#^B%Gωɞ5W]dD2)omo?r>0AsbT pԝ/-…[4R&r2ƙeK/<(W|v͑M%4W\CJv7>V8pA'\5M)hZ+;%AhH1Evn'GNPр_1@M7|z'-ހyA Z,y ^2Q98(UKy^<*,A8vH͊Ri-nYkO[gA)(CpH$Վoj9E9 ߿&ܱ.wW7r%lZj}2%ܗ*YeIo^=nlOijʹ/sӗJv-so%UGϨV< ].5KISe)vq T_CAB#Eɦs=tK,q1180fT.@"-Νy%QlV$ftSLm Gv. ǻ 3+]nehC)w@3ik&%mFKq%`r=[MlnP6vKQN` |_ɽApud@TjCbfӜ`J=CN$Ūy=%,2 X[PY<ҕ:dbqpi)Pj\u ڦDTCV(w( <Ux~摥έU! <q,𰪖Y5f>1*%}-+wTQ}H=j_gk kEP=zo42_9[֜'p(5}Q7-T ugS?CJP(nm+Hk',TcjUo !Zb`Z L"rs,#ܑ"-Ywcw?w9udTT `((xK".#÷<5c8HRO t5Vp;QuJwg؊*k9C6a\hx!0ȍ8GYoG޲Q!i!nEZpbZҌSƮo[ށIݗ,<QJSlH˦Y_o(DG[8{&Mf>= "Ģ|8kmL!=.b>I>iAs>dFqpmDSamBܗwOp%BwXOY_>$DEqvaImݙ 1?69Ԧ7K]SbDμD]S+f3su]CD˼R|ΕL˜x筎4u Ff;sB}GJsaCO'k% YE<⵽@hU6-lދNC *@/o]+d;S6lRszt3*"fhǺ6?\[?kPq?_{"#JL4m0YOMCI $H{I& )6+s1bz/UꜶ S#JUq".Jmm8^dEՃSpLV bql@q(ctg8 +3ꊭH^2,XNѭuir[4CPjzXVi}bEY5ߜ%n4^EZHƵ 8!.T>P-^"VruZ xUG+9ZU0x\'GKvUCYdw"(_n( 1gkG:BغzaS@)\NGWjƤ'={/§ьu<]9L":*,Vdx"fq'8$>  Ե8^\\F\+[ŠDTo':6yE7x2_VѶi_%H'+f\& !X2"uz WaD.[1:Ͳ"9 ̂E0j q9 H d%'Y\oRM|MP(pBxŎ7a~@R*(׻&yk*yaԶwV2[LbB,@/Jvjxx\F/\yp*CPÃT+GXJx @-}4t&z<:+èL7:4ԝR8K-×QLU;Qlz*׭^9BxgYPqvz%1(#N`T^AVNuag^f RAwO.+P1`rpL6,qtԺ[,i/VSL݋G3?1k}3Q %*hru8 ͙iR:Dz#%`NysP6l~"E흶A!qZ*|`;0>>MMeYtAv GF7'ZNhu6z>1J6FGC(*V:" hNh5VJ᢭qs;\m6lnbSFmqv [lNG<CV#0)f߽Yl`Aap5r"/u iT֏ޙ(1.A>G3hau:gmKǕsުs,ǻ nt7pXf?G%5*G~:y #'s> Pb쟰k\tA_0'$u/%tOd^hyDG kl|wQ ]xo^!i$7Nn4>FA_ ]r_~,(t$ x/_ C7Y :+fLT)Y i4bE0E7z{yjxJNr%;n`<ţb>(!2A2<ޡ0UCJhkD)\p k86 rbn"-=-##Kp oZ]q![9q\j;5lhbY`)3d%Ԇ4"4J.hZ|͸%O]a=aHn_.~su: )59ECpI7)rȤ:슓2q9O2FKC4ĩƫe*;+M!Ň!ԥfq? b·6 osmt GE ݕa]{զWAKGp;_" X;I4,AQ 3Ն`ܮƭqq?tQmw8'3_ӻ ]7^oH Q&fl*Y' 7䝕eĖuķԓ?_eĆ"YDBh8{^&:fM/ց>ˋ1~Ih|o.@^muG ٸAOup^,]HJ  DD_2AӪxDDސqol@RGAe(i|hMcT\I3z]>Y5a냪n8MJ);jS[`r j$/c,cjɄ2`;p~}7%)gg=~ b}*NsS"hb,b=>߁0Ip~ch%S ^>D*"oO}c.>K7-B⾨qI%g0͗@H=PyCPfCM#L35F)6nX-仐qTIxƩ/ONxmLA|JmhW`||Ϭb:&>۽-J_"uz(0jS/JjuY :j[s:!hh{"E*]~V{=~0#*2=sGֶbP , ux|Bܛl8iu*j79p_]W i\(ߑ3F(6{*7B-{*mR1vۚ/Vl>*I} 6jUb*^"ڻ'&ʳ֓#ɳEb}MPhL (,Јuj0auuIBsXZ6RױֵReY ;xm-oj|" [=h!!dUV]K }DKG4(iۙkکH6x' ";*ݪߍ@z}&1 לfmpJˤ("QpXOfE[t1~.*ўލ/a>[Ԓ&/&|lƅr\ۭ9mi c>˟lEˌz L_DD }mfh3 " #63_F/p ;|s=Ώsvh%J*M`wjcFcy*%0h6dΤ؁\j?^]pƴK[I_cU0҅ x|D!r% 5 hXV' F'3Mc "R[pw"BlT1ی@|'%@E2GZ`964Hu 04i$_wcZC٤ fomQՕOv3 eł *[F %:Ԅ:+-Hg]'Rӈ2E544 0t Ǡu^o/@hct[l2[#*ccfb՘c6@חA'Fz p(tŘE7|S #9 %}0o TL´8D~m4 Kg3!" 7j\U[t[hC[2;3o {z*Z=|'`٭S ijKvy+rT 3~=_ : ]q -q[Z"Exc[DX [rvu! O+%ThB̝#K2?₎1v@Q(+` UJ'OS`ozE} J'i23.QI}%H:8q~ uVz47Ms<\:Z)e5}i^<2DB%jV`?5c+~ |m|$\NeZ0<?{1IJ[' s][1e$50/O<&ܞa "rnt]J6:5^'!,>B$o67Kׂ~NɠAsMPiCm2-a>8]RfV Xơuwh(՞0 l $3YXi|ôQn[%;~m@Gř1^(GE8-( 6&8dE_]Fd!ciQ+u37MJ%zA*2cJ=|Xwwa P!Yf.}T.fa&}0֢9TEYu76E8'y}q%9kn\@;^v} \?*v ή3ET}©cR:ZHȱу?APT+V/9C6Ƙ:KV X}T:"7:puuK/'f7|K%GW,)FHI(_$ L g3G4J ^ j"µ(F qێtqFz}i/rT3Y (p<\=F =Vab))eU!CDO$ }75PK%EkN )J?\;]n0pDF0]N6T,|]%ۗí9Mr>sC}+Y=[ۏo. 5IȜIsp(a=Vo02#Mz넸Ƕvƀi=_V`x-\$eRCJs<9i%d,eNrb{rz"*z5 Xq4 XQ/\m2q۞>Zv@oA_17Iotb*Yx"xu |Ko=0js("#G,:}aҰϬEd_-6[z b@_T è%ZjGYb&,XPDKwnR=YuN.TC-;8c8"8m~tL-K&P>@_ "AaS~Y}gC>y$ߊ)B}Yfz@ڣݼ)tpC?x<r6;4\\('Nhfn^۞itˣ(|P?>B39DeAqe@N&6m 1{'BX:3&{-x E[R$u ?P = SbXkz^rTF٭r^Ѷ2Bb/^c03~8*%M ! ut1٨mu!ye A;p aes,7j> ]l`xx߯4?yCV񦃀_cXOWtbzub@N[WM9pL\na紃:wzkB&ڰ`@ehwvοR-&{, ?~S dWӽj€aO݅v[jygDk*%a_Z}7UT*IDn_SKU`scˊw*: ^դ`#c_pI_Q g2δvawZDp*P%9vlexf$<"t&N | ڐ: Go"y=íc7;gP|l=7w@ljq?l(%pϨyM;f'yto K[)Lf4vP?wsōPsxu5}3HqZNmiI@y!~|Ɓ[#0O4 +x;Pl7'!t'Ja ecl3^KcQkz<{>=>wbόkBy^KU n7^Q3_0@l3:j&ʹ푏nKps'SAt;^Kh6?L SنxXlB@ ARӻtZ[K<=hӀlB3.#4'j)JGz\#h;٭vJ{lKgyxdV»~°3Yp,8vR2h>pL>IU)bT:h_LP,e- A?Ï~ Ͷϭ3V:'ep3UYPAc2'35THwʫ:EY~@1XgrcWF w1Ҙ{bkܰjd&`B3ٜ%7Eȱ i aLx=-N'd.  `CECCnK y_^hbIʠ9DK|\&ӭ4HR'9ǣkrOȑJ $@D}@f0ճE &=/M|,yt%_-4ߨ)amD8!/g=XZ`'"qcʐ}Yo$kFjP!#T9ѷ壂WLTC*1{( y%tKۓ?s6T0RӓȂ:JN(:KM>o}RxCiT}HĻT;"7ljLEV9[:߷dj$GXlSGwZcoku)߻P9FM~W\{Îaz)E'^eiϾ@hBAV]CS$/\%t;f-4+*ad<;Ք,ɷS?'\YkVV{V/hy٫ !p^M*8B ?h 7! yRC7`ogq'5.dYxFh`"JFXehYiO0sw^(X͘[ms(; P7L$.}~up/̷nWS KJu=wd7D Eg À0j:J eth"*r=t$j Ɍ&3GwGm=tU<,vCKmRЕw20D\CbRG$*HX7bPK͛ \t%p"5k-Td"AA dib(=<^蓾ja;i!6ɓ(q%Op鑠L-Mu.(|@_>! b;f %#Z!@Z+Lm YS\ 'z6frȖܥN檫ۦޡQ<+$d[ldVdp/5y~z1]3aa1ݡy5-qfO8} t4#ri-Mh "}d.~iJ  joUY.wlEK[˫IN.$1X`T%F:>V[`@Zd̩dBkl=37p 0l16Nc9]Ͻò oK/B|v`|rَ Sw/4u,J ;uU)J)mFآ{ŖlYccq-̆b zk`ud*]D8OA\L2:ZR ǝJ s6Ѥtm( W -$g"3[U$k[*4W1IpF}嚤bh?QMʈ늗ޟ\2ǵ~F3p\Иb}.0!9ͲOᛊ4R& JHQ ߗb'k̮x㵩8&qMh"CV j qIīC817gI ICG1h `='~yc >k7XF~w_ܩ4wF=ј M~D?b4uğB b7- jQf}EԖjn8v>iD/J(z8켩I4 b\r$ݥG#'R:WTMl\Ml#\m=dgWFm>:F.(my'B.# 5kZd {{孵`$UEJQ%&SVO]dTk5'wpCbTw:g,MȧP%T\R|@=%RfJc0&ٝySvѥ#B'J;wsLGUg]GlnW {ON(ė`@ F{jM bGw)k}~|7;<Ϯ?Rߗzlq=p EbŬ90 9-%Ck>d^.xLdq W}j7]VҊ R*$ .mH  -.-aRq~_;J Ts1'ԉF.0ܣoz"nTW Ō8[hjsh(^^($<^8PِZ^&-3*f>dDxed \!!UZ58'-Z2ϛ `ZXtVr(1׸M,{f6m{S5 ||%U2x2;AuQoVM5<ဇ!) vΓy`nmVb 5|)K8Xͪ3!|ާg3)G2\CDuo>/\ֶ~cSD4㦞` s'waħgy`QZ!fz MDebL_~(`JκՓ~gd(&`ͥ9&2[߃W1%Q~rCXFVb|~]~cncӚ*TÊ8:Gr2q+Ge w0/rxd4/rϻ$`WcA|[5 HNA+P-:u *lp-э}5##'-~g/9$^pGk_j\ebW=xMŽ<'5"3ivV 3MXD́aRPdG"oYps@\) {"M e_me3 1) y <- y - 1L values <- 0:1 breaks <- c(-.5, .5, 1.5) breaks <- c(-.25, .25, .75, 1.25) NAs <- is.na(x) h_all <- hist(y, breaks, plot = FALSE) # h_all$counts[h_all$counts == 0] <- NA_integer_ plot(h_all, border = "lightgray", axes = FALSE, main = "", xlab = if(x@done) "Completed" else "Observed", mgp = c(2, 1, 0), tcl = .05, col = if(x@done) "lightgray" else "blue", freq = TRUE, ylim = range(h_all$counts, na.rm = TRUE), ...) axis(1, at = values, lwd = 0) axis(2) if(x@done) { h_obs <- hist(y[!NAs], breaks, plot = FALSE) h_miss <- hist(y[NAs], breaks, plot = FALSE) counts_obs <- h_obs$counts counts_obs <- counts_obs counts_miss <- h_miss$counts counts_miss <- counts_miss segments(breaks[1], 0, y1 = counts_obs[1], col = "blue") segments(breaks[1], 0, y1 = counts_miss[1], col = "red") if(counts_obs[1]) segments(breaks[1], y0 = counts_obs[1], x1 = breaks[2], col = "blue") if(counts_miss[1]) segments(breaks[1], y0 = counts_miss[1], x1 = breaks[2], col = "red") for(i in 2:(length(breaks)-1)) { segments(x0 = breaks[i], y0 = counts_obs[i-1], y1 = counts_obs[i], col = "blue") segments(x0 = breaks[i], y0 = counts_miss[i-1], y1 = counts_miss[i], col = "red") if(counts_obs[i]) segments(x0 = breaks[i], y0 = counts_obs[i], x1 = breaks[i+1], col = "blue") if(counts_miss[i]) segments(x0 = breaks[i], y0 = counts_miss[i], x1 = breaks[i+1], col = "red") } segments(x0 = breaks[i+1], y0 = counts_obs[i], y1 = 0, col = "blue") segments(x0 = breaks[i+1], y0 = counts_miss[i], y1 = 0, col = "red") if(.MI_DEBUG) stopifnot(all(h_all$counts == (h_obs$counts + h_miss$counts))) } return(invisible(NULL)) }) setMethod("hist", signature(x = "missing_data.frame"), def = function(x, ask = TRUE, ...) { k <- sum(!x@no_missing) if (.Device != "null device" && x@done) { oldask <- grDevices::devAskNewPage(ask = ask) if (!oldask) on.exit(grDevices::devAskNewPage(oldask), add = TRUE) op <- options(device.ask.default = TRUE) on.exit(options(op), add = TRUE) } par(mfrow = n2mfrow(k)) for(i in 1:x@DIM[2]) { if(x@no_missing[i]) next hist(x@variables[[i]]) header <- x@variables[[i]]@variable_name if(is(x@variables[[i]], "continuous")) { trans <- .show_helper(x@variables[[i]])$transformation[1] header <- paste("\n", header, " (", trans, ")", sep = "") } title(main = header) } return(invisible(NULL)) }) setMethod("hist", signature(x = "mdf_list"), def = function(x, ask = TRUE, ...) { if (.Device != "null device") { oldask <- grDevices::devAskNewPage(ask = ask) if (!oldask) on.exit(grDevices::devAskNewPage(oldask), add = TRUE) op <- options(device.ask.default = ask) on.exit(options(op), add = TRUE) } sapply(x, FUN = hist, ...) return(invisible(NULL)) }) setMethod("hist", signature(x = "mi"), def = function(x, m = 1:length(x), ask = TRUE, ...) { for(i in m) hist(x@data[[i]], ask = ask, ...) return(invisible(NULL)) }) setMethod("hist", signature(x = "mi_list"), def = function(x, m = 1:length(x), ask = TRUE, ...) { if (.Device != "null device") { oldask <- grDevices::devAskNewPage(ask = ask) if (!oldask) on.exit(grDevices::devAskNewPage(oldask), add = TRUE) op <- options(device.ask.default = ask) on.exit(options(op), add = TRUE) } sapply(x, FUN = hist, m = m, ask = ask, ...) return(invisible(NULL)) }) mi/R/mi.R0000644000175000017500000012054114247027226011753 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. .prune_missing_variable <- function(y, s) { if(!is(y, "missing_variable")) stop("'y' must inherit from the 'missing_variable' class") if(!y@all_obs) { y@parameters <- y@parameters[1:s,,drop = FALSE] y@imputations <- y@imputations[1:s,,drop = FALSE] } return(y) } .MPinverse <- function(eta, tol = sqrt(.Machine$double.eps)) { cov_eta <- cov(eta) ev <- eigen(cov_eta, TRUE) ev$values <- ifelse(ev$values > tol, 1/ev$values, 0) Sigma_inv <- crossprod(sqrt(ev$values)*(t(ev$vectors))) return(Sigma_inv) } .mi <- function(i, y, verbose, s_start, s_end, ProcStart, max.minutes, parallel, save_models) { mdf <- y if(verbose) message("Chain ", i, "\n") for(s in s_start:s_end) { if(verbose) message("Chain ", i, " Iteration ", s, "\n") mdf <- fit_model(data = mdf, s = s, verbose = FALSE, warn = s == s_end) if(s > 0) { pars <- unlist(sapply(mdf@variables, FUN = function(y) { if(is(y, "irrelevant")) return(NA_real_) else if(y@all_obs) return(NA_real_) else return(y@parameters[s,,drop=TRUE]) })) pars <- t(pars[!is.na(pars)]) fp <- file.path(mdf@workpath, paste0("pars_", i, ".csv")) write.table(pars, file = fp, append = TRUE, sep = ",", row.names = FALSE, col.names = FALSE) imps <- unlist(sapply(mdf@variables, FUN = function(y) { if(is(y, "irrelevant")) return(NA_real_) else if(y@all_obs) return(NA_real_) else return(y@imputations[s,,drop=TRUE]) })) imps <- t(imps[!is.na(imps)]) fp <- file.path(mdf@workpath, paste0("imps_", i, ".csv")) write.table(imps, file = fp, append = TRUE, sep = ",", row.names = FALSE, col.names = FALSE) } Time.Elapsed <- proc.time() - ProcStart if(((Time.Elapsed)/60)[3] > max.minutes) { warning("'max.minutes' threshold exceeded") break } } if(((Time.Elapsed)/60)[3] > max.minutes) mdf@variables <- lapply(mdf@variables, .prune_missing_variable, s = s) if(verbose) message("Estimating models on completed data for chain ", i, "\n") mdf@variables <- lapply(mdf@variables, FUN = function(y) { if(!y@all_obs & !is(y, "irrelevant")) { model <- fit_model(y, mdf, s = s + 1, warn = TRUE) y@fitted <- fitted(model) if(!isS4(model)) model$x <- model$X <- model$y <- model$model <- NULL if(save_models) y@model <- model } else y@model <- NULL return(y) }) mdf@done <- TRUE if(verbose) message("Done with chain ", i, "\n") return(mdf) } .mi_split <- function(i, y, data, verbose, s_start, s_end, ProcStart, max.minutes, parallel, save_models) { mdf <- y if(verbose) message("Chain ", i, "\n") data@priors <- mdf@priors for(s in s_start:s_end) { if(verbose) message("Chain ", i, " Iteration ", s, "\n") mdf <- fit_model(mdf, data, s = s, verbose = FALSE, warn = s == s_end) Time.Elapsed <- proc.time() - ProcStart if(((Time.Elapsed)/60)[3] > max.minutes) { warning("'max.minutes' threshold exceeded") break } } if(((Time.Elapsed)/60)[3] > max.minutes) mdf@variables <- lapply(mdf@variables, .prune_missing_variable, s = s) if(verbose) message("Estimating models on completed data for chain ", i, "\n") mdf@variables <- lapply(mdf@variables, FUN = function(y) { if(!y@all_obs & !is(y, "irrelevant")) { model <- fit_model(y, data, s = s + 1, warn = TRUE) y@fitted <- fitted(model) if(!isS4(model)) model$x <- model$X <- model$y <- model$model <- NULL if(save_models) y@model <- model } else y@model <- NULL return(y) }) mdf@done <- TRUE if(verbose) message("Done with chain ", i, "\n") return(mdf) } setMethod("mi", signature(y = "missing_data.frame", model = "missing"), def = function(y, n.iter = 30, n.chains = 4, max.minutes = Inf, seed = NA, verbose = TRUE, save_models = FALSE, parallel = .Platform$OS.type != "Windows") { call <- match.call() if(!is.na(seed)) set.seed(seed) if(n.iter < 0) stop(message="number of iterations must be non-negative") ProcStart <- proc.time() s_start <- 0 s_end <- n.iter Time.Elapsed <- proc.time() - ProcStart y@variables <- lapply(y@variables, FUN = function(x) { if(!x@all_obs & !is(x, "irrelevant")) { x@parameters <- matrix(NA_real_, nrow = n.iter, ncol = 0) x@imputations <- matrix(NA_real_, nrow = n.iter, ncol = x@n_drawn) if(is(x, "semi-continuous")) { x@indicator@parameters <- matrix(NA_real_, nrow = n.iter, ncol = 0) x@indicator@imputations <- matrix(NA_real_, nrow = n.iter, ncol = x@n_drawn) } } x@done <- TRUE return(x) }) if(is(y, "allcategorical_missing_data.frame")) { y@latents@imputations <- matrix(NA_integer_, nrow = n.iter, ncol = nrow(y)) y@latents@levels <- as.character(1:y@Hstar) } if(n.chains <= 0) return(y) if(is.logical(parallel) && parallel) { cores <- getOption("mc.cores", 2L) cl <- parallel::makeCluster(cores, outfile = "") on.exit(parallel::stopCluster(cl)) } if(!parallel) { mdfs <- vector("list", n.chains) for(i in seq_along(mdfs)) { ProcStart <- proc.time() mdfs[[i]] <- .mi(i, y, verbose, s_start, s_end, ProcStart, max.minutes, parallel, save_models) } } else { mdfs <- parallel::parLapply(cl, X = as.list(1:n.chains), fun = function(i) .mi(i, y, verbose, s_start, s_end, ProcStart, max.minutes, parallel, save_models)) } # # else mdfs <- mclapply(as.list(1:n.chains), # FUN = function(i) .mi(i, y, verbose, s_start, s_end, # ProcStart, max.minutes, parallel, save_models)) names(mdfs) <- paste("chain", 1:length(mdfs), sep = ":") object <- new("mi", call = call, data = mdfs, total_iters = as.integer(s_end)) return(object) }) setMethod("mi", signature(y = "data.frame", model = "missing"), def = function(y, n.iter = 30, n.chains = 4, max.minutes = Inf, seed = NA, verbose = TRUE, save_models = FALSE, parallel = .Platform$OS.type != "Windows") { y <- as(y, "missing_data.frame") return(mi(y, n.iter = n.iter, n.chains = n.chains, max.minutes = max.minutes, seed = seed, verbose = verbose, save_models = save_models, parallel = parallel)) }) setMethod("mi", signature(y = "matrix", model = "missing"), def = function(y, n.iter = 30, n.chains = 4, max.minutes = Inf, seed = NA, verbose = TRUE, save_models = FALSE, parallel = .Platform$OS.type != "Windows") { y <- as(y, "missing_data.frame") return(mi(y, n.iter, n.chains, max.minutes, seed, verbose, save_models, parallel)) }) setMethod("mi", signature(y = "mi", model = "missing"), function(y, n.iter = 30, max.minutes = Inf, seed = NA, verbose = TRUE, save_models = FALSE, parallel = .Platform$OS.type != "Windows") { call <- match.call() if(!is.na(seed)) set.seed(seed) if(n.iter < 1) stop(message="number of iterations must be at least 1") ProcStart <- proc.time() total_iters <- y@total_iters s_start <- sum(total_iters) + 1 s_end <- s_start + n.iter - 1 mdfs <- y@data n.chains <- length(mdfs) for(i in 1:n.chains) { y <- mdfs[[i]] if(TRUE) y@variables <- lapply(y@variables, FUN = function(x) { if(x@all_obs & is(x, "irrelevant")) return(x) x@imputations <- rbind(x@imputations, matrix(NA_integer_, n.iter, x@n_drawn)) x@parameters <- rbind(x@parameters, matrix(NA_real_, n.iter, ncol(x@parameters))) if(is(x, "semi-continuous")) { x@indicator@imputations <- rbind(x@indicator@imputations, matrix(NA_integer_, n.iter, x@indicator@n_drawn)) x@indicator@parameters <- rbind(x@indicator@parameters, matrix(NA_real_, n.iter, ncol(x@indicator@parameters))) } return(x) }) } if(is.logical(parallel) && parallel) { cores <- getOption("mc.cores", 2L) cl <- parallel::makeCluster(cores, outfile = "") on.exit(parallel::stopCluster(cl)) } if(!parallel) { mdfs <- vector("list", n.chains) for(i in seq_along(mdfs)) { ProcStart <- proc.time() mdfs[[i]] <- .mi(i, y, verbose, s_start, s_end, ProcStart, max.minutes, parallel, save_models) } } else { mdfs <- parallel::parLapply(cl, as.list(1:n.chains), fun = function(i) .mi(i, y, verbose, s_start, s_end, ProcStart, max.minutes, parallel, save_models)) } # else mdfs <- mclapply(as.list(1:n.chains), # FUN = function(i) .mi(i, y, verbose, s_start, s_end, # ProcStart, max.minutes, parallel, save_models)) object <- new("mi", call = call, data = mdfs, total_iters = as.integer(c(total_iters, n.iter))) return(object) }) setMethod("mi", signature(y = "missing_data.frame", model = "mi"), def = function(y, model, n.iter = sum(model@total_iters), max.minutes = 20, seed = NA, verbose = TRUE, save_models = FALSE, parallel = .Platform$OS.type != "Windows") { n.chains <- length(model) call <- match.call() if(!is.na(seed)) set.seed(seed) y <- mi(y, n.chains = 0L, n.iter = n.iter) ProcStart <- proc.time() s_start <- 0 s_end <- n.iter if(is.logical(parallel) && parallel) { cores <- getOption("mc.cores", 2L) cl <- parallel::makeCluster(cores, outfile = "") on.exit(parallel::stopCluster(cl)) } mdfs <- model@data if(!parallel) { for(i in seq_along(mdfs)) { ProcStart <- proc.time() mdfs[[i]] <- .mi_split(i, y, mdfs[[i]], verbose, s_start, s_end, ProcStart, max.minutes, parallel, save_models) } } else { mdfs <- parallel::parLapply(cl, as.list(1:n.chains), fun = function(i) .mi_split(i, y, mdfs[[i]], verbose, s_start, s_end, ProcStart, max.minutes, parallel, save_models)) } # else mdfs <- mclapply(as.list(1:n.chains), # FUN = function(i) .mi_split(i, y, mdfs[[i]], verbose, s_start, s_end, # ProcStart, max.minutes, parallel, save_models)) names(mdfs) <- paste("chain", 1:length(mdfs), sep = ":") to_drop <- 1:ncol(model@data[[1]]@X) for(i in 1:n.chains) { model@data[[i]]@variables <- c(model@data[[i]]@variables, mdfs[[i]]@variables) model@data[[i]]@no_missing <- c(model@data[[i]]@no_missing, mdfs[[i]]@no_missing) # leave patterns as is I guess model@data[[i]]@DIM[2] <- model@data[[i]]@DIM[2] + mdfs[[i]]@DIM[2] model@data[[i]]@DIMNAMES[[2]] <- c(model@data[[i]]@DIMNAMES[[2]], mdfs[[i]]@DIMNAMES[[2]]) mdfs[[i]]@index <- lapply(mdfs[[i]]@index, FUN = function(x) if(is.null(x)) x else to_drop) model@data[[i]]@index <- c(model@data[[i]]@index, mdfs[[i]]@index) model@data[[i]]@weights <- c(model@data[[i]]@weights, mdfs[[i]]@weights) model@data[[i]]@priors <- c(model@data[[i]]@priors, mdfs[[i]]@priors) } object <- new("mi", call = call, data = model@data, total_iters = as.integer(s_end)) return(object) }) setMethod("mi", signature(y = "mdf_list", model = "missing"), def = function (y, ...) { out <- lapply(y, FUN = mi, ...) class(out) <- "mi_list" return(out) }) setMethod("mi", signature(y = "list", model = "missing"), def = function (y, ...) { if(!all(sapply(y, is, class2 = "mi"))) { stop("all elements of 'y' must be mi objects or missing_data.frame objects") } ## FIXME: should probably check that all the mi objects are based on the same missing_data.frame mdfs <- lapply(mi, FUN = function(x) return(x@data)) object <- new("mi", call = y[[1]]@call, data = mdfs, total_iters = y[[1]]@total_iters) return(object) }) setMethod("mi", signature(y = "mdf_list", model = "missing"), function (y, n.iter = 30, n.chains = 4, max.minutes = Inf, seed = NA, verbose = TRUE, save_models = FALSE, parallel = .Platform$OS.type != "Windows") { out <- lapply(y, mi, n.iter = n.iter, n.chains = n.chains, max.minutes = max.minutes, seed = seed, verbose = verbose, save_models = save_models, parallel = parallel) class(out) <- "mi_list" return(out) }) setMethod("mi", signature(y = "mi_list", model = "missing"), def = function (y, ...) { out <- lapply(y, FUN = mi, ...) class(out) <- "mi_list" return(out) }) setMethod("show", signature(object = "mi"), def = function(object) { cat("Object of class", class(object), "with", length(object@data), "chains, each with", sum(object@total_iters), "iterations.\n") cat("Each chain is the evolution of an object of", class(object@data[[1]]), "class with", nrow(object@data[[1]]), "observations on", ncol(object@data[[1]]), "variables.\n") return(invisible(NULL)) }) setMethod("show", signature(object = "mi_list"), def = function(object) { sapply(object, show) return(invisible(NULL)) }) setMethod("summary", signature(object = "mi"), def = function(object) { mdf <- object@data[[1]] matrices <- complete(object, to_matrix = TRUE, include_missing = FALSE) chains <- length(matrices) matrices <- array(unlist(matrices), dim = c(dim(mdf), chains), dimnames = c(dimnames(mdf), NULL)) out <- vector("list", ncol(mdf)) names(out) <- colnames(mdf) for(i in seq_along(out)) { if(mdf@no_missing[i]) { if(is(mdf@variables[[i]], "categorical")) { mat <- table(matrices[,i,1]) lev <- mdf@variables[[i]]@levels if(length(lev) && length(dim(mat)) > 1) colnames(mat) <- lev } else mat <- summary(matrices[,i,1]) out[[i]] <- list(is_missing = "all values observed", observed = mat) } else if(is(mdf@variables[[i]], "categorical")) { mark <- is.na(mdf@variables[[i]]) mat <- table(c(matrices[,i,]), rep(mark, times = chains)) lev <- mdf@variables[[i]]@levels if(length(lev)) rownames(mat) <- lev colnames(mat) <- c("observed", "imputed") out[[i]] <- list(crosstab = mat) } else { missing <- is.na(mdf@variables[[i]]@raw_data) out[[i]] <- list(is_missing = table(missing), imputed = summary(c(matrices[missing,i,])), observed = summary(c(matrices[!missing,i,]))) } } return(out) }) setMethod("traceplot", signature(x = "mi"), def = function(x, ...) { traceplot(mi2BUGS, ...) }) setMethod("traceplot", signature(x = "mi_list"), def = function(x, ...) { traceplot(lapply(x, mi2BUGS, ...)) }) ## all the mi() methods below should return the missing_variable after imputing ## need to explicitly write out methods instead of doing poor man's S4 setMethod("mi", signature(y = "missing_variable", model = "ANY"), def = function(y, model, ...) { stop("This method should not have been called. You need to define the relevant mi() S4 method") }) setMethod("mi", signature(y = "missing_variable", model = "missing"), def = function(y) { if(y@n_drawn == 0) stop("'impute' should not have been called because there are no missing data") draws <- sample(y@data[y@which_obs], size = y@n_drawn, replace = TRUE) y@data[y@which_drawn] <- draws return(y) }) setMethod("mi", signature(y = "semi-continuous", model = "missing"), def = function(y) { if(y@n_drawn == 0) stop("'impute' should not have been called because there are no missing data") y@indicator <- mi(y@indicator) draws <- sample(y@data[y@which_obs], size = y@n_drawn, replace = TRUE) if(is(y, "SC_proportion")) { n <- y@n_total if(is(y@indicator, "binary")) { mark <- which(complete(y@indicator, m = 0L)[y@which_miss] == 1) if(any(y@raw_data == 0, na.rm = TRUE)) draws[mark] <- .5 / n else draws[mark] <- (n - .5) / n } else { mark <- which(complete(y@indicator, m = 0L)[y@which_miss] != 0) draws[mark] <- (draws[mark] * (n - 1) + .5) / n } } else if(is(y, "nonnegative-continuous")) { mark <- which(y@indicator@data[y@which_miss] == 1) if(length(mark)) draws[mark] <- y@transformation(rep(0, length(mark))) } else stop("FIXME: semi-continuous is not supported yet") y@data[y@which_drawn] <- draws return(y) }) # setMethod("mi", signature(y = "semi-continuous", model = "missing"), def = # function(y) { # if(y@n_drawn == 0) stop("'impute' should not have been called because there are no missing data") # # categories <- 1:(ncol(y@indicator@dummies) + 1) # draws <- sample(categories, size = y@n_drawn, replace = TRUE) # dummies <- t(sapply(draws, FUN = function(x) x == categories))[,-1,drop = FALSE] # y@indicator@dummies[y@which_drawn,] <- dummies # y@indicator@data[y@which_drawn] <- draws # # draws <- sample(y@data[y@which_obs], size = y@n_drawn, replace = TRUE) # if(is(y, "SC_proportion")) { # n <- y@n_total # if(is(y@indicator, "binary")) { # mark <- which(complete(y@indicator, m = 0L)[y@which_miss] == 1) # if(any(y@raw_data == 0, na.rm = TRUE)) draws[mark] <- .5 / n # else draws[mark] <- (n - .5) / n # } # else { # mark <- which(complete(y@indicator, m = 0L)[y@which_miss] != 0) # draws[mark] <- (draws[mark] * (n - 1) + .5) / n # } # } # else if(is(y, "nonnegative-continuous")) { # mark <- which(y@indicator@data[y@which_miss] == 1) # if(length(mark)) draws[mark] <- y@transformation(rep(0, length(mark))) # } # # the_range <- range(y@data, na.rm = TRUE) # free <- y@data[y@which_obs] # free <- free[free != the_range[1] & free != the_range[2]] # draws <- sample(free, size = y@n_drawn, replace = TRUE) # y@data[y@which_drawn] <- draws # return(y) # }) setMethod("mi", signature(y = "bounded-continuous", model = "missing"), def = function(y) { if(y@n_drawn == 0) stop("'impute' should not have been called because there are no missing data") a <- if(length(y@lower) == 1) y@lower else y@lower[y@which_drawn] a <- ifelse(a == -Inf, min(y@data, na.rm = TRUE), a) a <- ifelse(a == Inf, max(y@data, na.rm = TRUE), a) b <- if(length(y@upper) == 1) y@upper else y@upper[y@which_drawn] b <- ifelse(b == -Inf, min(y@data, na.rm = TRUE), b) b <- ifelse(b == Inf, max(y@data, na.rm = TRUE), b) draws <- runif(y@n_drawn, min = a, max = b) y@data[y@which_drawn] <- draws return(y) }) setMethod("mi", signature(y = "categorical", model = "missing"), def = function(y) { if(y@n_drawn == 0) stop("'impute' should not have been called because there are no missing data") draws <- sample(y@data[y@which_obs], size = y@n_drawn, replace = TRUE) y@data[y@which_drawn] <- draws return(y) }) .draw_parameters <- function(means, ev) { if(any(ev$values <= 0)) return(means) else return(means + (ev$vectors %*% (sqrt(ev$values) * rnorm(length(means))))[,1]) } .pmm <- function(y, eta, Sigma_inv = NULL, strata = NULL) { if(is(y, "unordered-categorical")) { if(is.null(Sigma_inv)) Sigma_inv <- .MPinverse(eta) MD <- mahalanobis(eta, colMeans(eta), Sigma_inv, inverted=TRUE) MD_observed <- MD[y@which_obs] y_observed <- y@data[y@which_obs] draws <- sapply(MD[y@which_drawn], FUN = function(x) { mark <- which.min(abs(MD_observed - x)) drawmark <- c(y_observed[mark], mark) return(drawmark) }) } else if(is(y, "grouped-binary")) { draws <- sapply(y@which_drawn, FUN = function(i) { which_same <- which(strata == strata[i]) candidates <- intersect(which_same, y@which_obs) if(length(candidates) == 0) { msg <- paste(y@variable_name, ": must have some observed values in each group") stop(msg) } eta_can <- eta[candidates] y_can <- y@data[candidates] mark <- which.min(abs(eta_can - eta[i])) drawmark <- c(y_can[mark], mark) return(drawmark) }) } else { eta_obs <- eta[y@which_obs] y_obs <- y@data[y@which_obs] draws <- sapply(eta[y@which_drawn], FUN = function(x) { if(is.na(x)) return(NA_real_) # happens with semi-continuous mark <- which.min(abs(eta_obs - x)) drawmark <- c(y_obs[mark], mark) return(drawmark) }) } return(t(draws)) } setOldClass("polr") setMethod("mi", signature(y = "ordered-categorical", model = "polr"), def = function(y, model, s, ...) { if(y@n_drawn == 0) stop("'impute' should not have been called because there are no missing data") if(!is.element(y@imputation_method, c("ppd", "pmm"))) badHessian <- FALSE else if(is.null(model$Hessian)) badHessian <- FALSE else if(!all(is.finite(model$Hessian))) badHessian <- TRUE else { means <- c(coef(model), model$zeta) ev <- eigen(vcov(model), symmetric = TRUE) badHessian <- any(ev$values <= 0) parameters <- .draw_parameters(means, ev) while(!badHessian && any(diff(parameters[-(1:ncol(model$x))]) <= 0)) { # rejection sampling on cutpoints parameters <- .draw_parameters(means, ev) } } if(badHessian && y@imputation_method == "ppd") { warning(paste("predictive mean matching used for", y@variable_name, "on iteration", s, "as a fallback due to Hessian error")) old_method <- y@imputation_method y@imputation_method <- "pmm" y <- mi(y, model, s, ...) y@imputation_method <- old_method return(y) } else if(y@imputation_method == "ppd") { eta <- as.vector(model$x[y@which_drawn,,drop=FALSE] %*% head(parameters, ncol(model$x))) pfun <- switch(y@family$link, logit = plogis, probit = pnorm, cloglog = function(q) exp(-exp(-q)), cauchit = pcauchy) zeta <- parameters[-(1:ncol(model$x))] draws <- sapply(eta, FUN = function(x) { which(rmultinom(1, 1, diff(c(0,pfun(zeta - x),1))) == 1) }) } else if(y@imputation_method == "pmm") { parameters <- c(coef(model), model$zeta) eta <- model$x %*% parameters[1:ncol(model$x)] pmm <- .pmm(y, eta) draws <- pmm[,1] y@fitted[y@which_drawn,] <- y@fitted[y@which_obs,][pmm[,2],] } else if(y@imputation_method == "median") { predictions <- predict(model, type = "class") draws <- rep(floor(median(predictions[y@which_obs])), y@n_drawn) } else if(y@imputation_method == "mode") draws <- predict(model, type = "class")[y@which_drawn] else stop("'imputation_method' not recognized") y@data[y@which_drawn] <- draws y@imputations[s,] <- draws return(y) }) setOldClass("multinom") setMethod("mi", signature(y = "unordered-categorical", model = "multinom"), def = function(y, model, s, ...) { if(y@n_drawn == 0) stop("'impute' should not have been called because there are no missing data") ev <- eigen(vcov(model), symmetric = TRUE) parameters <- .draw_parameters(t(coef(model)), ev) if (ncol(model.matrix(model)) != nrow(parameters)) parameters <- t(parameters) eta <- model.matrix(model) %*% parameters if(y@imputation_method == "ppd") { exp_eta <- matrix(pmin(.Machine$double.xmax / ncol(eta), cbind(1, exp(eta[y@which_drawn,,drop = FALSE]))), ncol = ncol(eta) + 1) denom <- rowSums(exp_eta) Pr <- exp_eta / denom if (y@use_NA) { Pr <- Pr[,-1]/rowSums(Pr[,-1]) badrows <- apply(is.na(Pr), 1, all) if(any(badrows)) { warning("Some rows of Pr are all 0 after dropping the missingness category") Pr[badrows,] <- 1/(ncol(Pr) - 1) } } draws <- apply(Pr, 1, FUN = function(p) which(rmultinom(1, 1, p) == 1)) } else if(y@imputation_method == "pmm"){ pmm <- .pmm(y, eta) draws <- pmm[,1] y@fitted[y@which_drawn,,drop=FALSE] <- y@fitted[y@which_obs,,drop=FALSE][pmm[,2]] } else if(y@imputation_method == "mode") draws <- predict(model, type = "class")[y@which_drawn] else stop("'imputation_method' not recognized") y@data[y@which_drawn] <- draws y@imputations[s,] <- draws return(y) }) setOldClass("RNL") setMethod("mi", signature(y = "unordered-categorical", model = "RNL"), def = function(y, model, s, ...) { if(y@n_drawn == 0) stop("'impute' should not have been called because there are no missing data") if(y@imputation_method == "ppd") { # imputating from the posterior predictive distribution Pr <- sapply(model, FUN = function(m) { ev <- eigen(vcov(m), symmetric = TRUE) parameters <- .draw_parameters(coef(m), ev) eta <- m$x[y@which_drawn,,drop=FALSE] %*% parameters pred <- m$family$linkinv(eta) return(pred) }) if(y@use_NA) { Pr <- Pr[,-1]/rowSums(Pr[,-1]) badrows <- apply(is.na(Pr), 1, all) if(any(badrows)) { warning("Some rows of Pr are all 0 after dropping the missingness category") Pr[badrows,] <- 1/(ncol(Pr) - 1) } } draws <- apply(Pr, 1, FUN = function(p) which(rmultinom(1, 1, p) == 1)) } else if(y@imputation_method == "pmm") { eta <- sapply(model, FUN = function(m) { ev <- eigen(vcov(m), symmetric = TRUE) parameters <- .draw_parameters(coef(m), ev) eta <- m$x %*% parameters return(eta) }) pmm <- .pmm(y, eta) draws <- pmm[,1] y@fitted[y@which_drawn,,drop=FALSE] <- y@fitted[y@which_obs,,drop=FALSE][pmm[,2]] } else stop("only ppd and pmm are supported imputation methods in the RNL case") y@data[y@which_drawn] <- draws y@imputations[s,] <- draws return(y) }) setOldClass("glm") setMethod("mi", signature(y = "binary", model = "glm"), def = function(y, model, s, ...) { if(y@n_drawn == 0) stop("'impute' should not have been called because there are no missing data") if(y@imputation_method == "ppd") { ev <- eigen(vcov(model), symmetric = TRUE) parameters <- .draw_parameters(coef(model), ev) eta <- model$x[y@which_drawn,,drop=FALSE] %*% parameters pred <- model$family$linkinv(eta) draws <- rbinom(y@n_drawn, 1, pred) + 1L } else if(y@imputation_method == "pmm") { ev <- eigen(vcov(model), symmetric = TRUE) parameters <- .draw_parameters(coef(model), ev) eta <- model$x %*% parameters pmm <- .pmm(y, eta) draws <- pmm[,1] y@fitted[y@which_drawn] <- y@fitted[y@which_obs][pmm[,2]] } else if(y@imputation_method == "median") { predictions <- predict(model, type = "class") draws <- rep(floor(median(predictions[y@which_obs])), y@n_drawn) } else if(y@imputation_method == "mode") draws <- predict(model, type = "class")[y@which_drawn] else if(y@imputation_method == "mean") stop("'mean' is not a supported 'imputation_method' for binary variables") else if(y@imputation_method == "expectation") stop("'expectation' is not a supported 'imputation_method' for binary variables") else stop("'imputation_method' not recognized") draws <- as.integer(draws) y@data[y@which_drawn] <- draws y@imputations[s,] <- draws return(y) }) setOldClass("clogit") setMethod("mi", signature(y = "grouped-binary", model = "clogit"), def = function(y, model, s, ...) { if(y@n_drawn == 0) stop("'impute' should not have been called because there are no missing data") # reconstruc the strata Terms <- model$terms temp <- survival::untangle.specials(Terms, "strata") mf <- model.frame(model) strata <- strata(mf[, temp$vars], shortlabel = TRUE) if(y@imputation_method == "pmm") { ev <- eigen(vcov(model), symmetric = TRUE) parameters <- .draw_parameters(coef(model), ev) eta <- model$x %*% parameters draws <- .pmm(y, eta, strata = strata)[,1] #FIXME: haven't adjusted fitted values } else stop("only 'pmm' is supported for 'grouped-binary' variables") draws <- as.integer(draws) y@data[y@which_drawn] <- draws y@imputations[s,] <- draws return(y) }) setMethod("mi", signature(y = "interval", model = "glm"), def = function(y, model, s, ...) { stop("FIXME: write this method") if(y@n_drawn == 0) stop("'impute' should not have been called because there are no missing data") if(y@imputation_method == "ppd") { stop("FIXME") } else stop("only ppd is supported as an imputation method for interval variables") return(y) }) setMethod("mi", signature(y = "categorical", model = "matrix"), def = function(y, model, s, ...) { if(y@n_drawn == 0) stop("'impute' should not have been called because there are no missing data") if(y@imputation_method != "ppd") stop("only ppd is supported in this case") if(nrow(model) != y@n_drawn) stop("matrix of probabilities has the wrong number of rows") draws <- apply(model, 1, FUN = function(p) which(rmultinom(1, 1, p) == 1)) y@data[y@which_drawn] <- draws y@imputations[s,] <- draws return(y) }) ## helper function .mi_continuous <- function(y, model) { if(y@n_drawn == 0) stop("'impute' should not have been called because there are no missing data") if(y@imputation_method == "ppd") { ev <- eigen(vcov(model), symmetric = TRUE) parameters <- .draw_parameters(coef(model), ev) if(model$family$family == "gaussian") { eta <- model$x[y@which_drawn,,drop=FALSE] %*% parameters pred <- model$family$linkinv(eta) if(is(y, "bounded-continuous")) { a <- if(length(y@lower) > 1) y@lower[y@which_drawn] else y@lower b <- if(length(y@upper) > 1) y@upper[y@which_drawn] else y@upper draws <- truncnorm::rtruncnorm(y@n_drawn, mean = pred, sd = sqrt(model$dispersion), a = a, b = b) } else draws <- rnorm(y@n_drawn, pred, sqrt(model$dispersion)) } else { eta <- model$x %*% parameters model$fitted <- model$family$linkinv(eta) # model$dispersion <- parameters@sigma^2 draws <- y@family$sim(model, nsim = 1)[y@which_drawn] } } else if(y@imputation_method == "pmm") { ev <- eigen(vcov(model), symmetric = TRUE) parameters <- .draw_parameters(coef(model), ev) if(is(y, "semi-continuous")) { eta <- rep(NA_real_, y@n_total) mark <- complete(y@indicator, 0L) == 0 eta[mark] <- model$x[mark,] %*% parameters } else eta <- model$x %*% parameters draws <- .pmm(y, eta)[,1] #FIXME: haven't adjusted fitted values using pmm for continuous } else if(y@imputation_method == "mean") { eta <- predict(model, type = "response") eta_observed <- eta[y@which_obs] eta_mean <- mean(eta_observed) draws <- rep(eta_mean, y@n_drawn) } else if(y@imputation_method == "median") { eta <- predict(model, type = "response") eta_observed <- eta[y@which_obs] eta_median <- median(eta_observed) draws <- rep(eta_median, y@n_drawn) } else if(y@imputation_method == "expectation") draws <- predict(model, type = "response")[y@which_drawn] else stop("'imputation_method' not recognized") return(draws) } setMethod("mi", signature(y = "continuous", model = "glm"), def = function(y, model, s, ...) { draws <- .mi_continuous(y, model) y@data[y@which_drawn] <- draws y@imputations[s,] <- draws return(y) }) # setMethod("mi", signature(y = "censored-continuous", model = "glm"), def = # function(y, model, s, ...) { # not_obs <- c(y@which_drawn, y@which_censored) # if(y@imputation_method == "ppd") { # parameters <- arm::sim(model, 1) # eta <- model$x[not_obs,,drop=FALSE] %*% parameters@coef[1,] # pred <- model$family$linkinv(eta) # draws <- rnorm(y@n_drawn, pred, parameters@sigma) # } # else if(y@imputation_method == "pmm") { # eta <- predict(model, type = "link") # eta_observed <- eta[y@which_obs] # y_observed <- y@data[y@which_obs] # draws <- sapply(eta[nob_obs], FUN = function(x) { # mark <- which.min(abs(eta_observed - x)) # return(y_observed[mark]) # }) # } # else if(y@imputation_method == "mean") { # eta <- predict(model, type = "response") # eta_observed <- eta[y@which_obs] # eta_mean <- mean(eta_observed) # draws <- rep(eta_mean, length(not_obs)) # } # else if(y@imputation_method == "median") { # eta <- predict(model, type = "response") # eta_observed <- eta[y@which_obs] # eta_median <- median(eta_observed) # draws <- rep(floor(eta_median), length(not_obs)) # } # else if(y@imputation_method == "expectation") draws <- predict(model, type = "response")[not_obs] # else stop("'imputation_method' not recognized") # # y@data[not_obs] <- draws # y@imputations[s,] <- draws # return(y) # }) setMethod("mi", signature(y = "semi-continuous", model = "glm"), def = function(y, model, s, ...) { stop("the semi-continuous mi() method should not have been called") }) setMethod("mi", signature(y = "nonnegative-continuous", model = "glm"), def = function(y, model, s, ...) { draws <- .mi_continuous(y, model) # now account for the fact that some draws were determined to be 0 in step 1 mark <- which(complete(y@indicator, 0L)[y@which_miss] == 1) if(length(mark)) draws[mark] <- y@transformation(rep(0, length(mark))) y@data[y@which_drawn] <- draws y@imputations[s,] <- draws return(y) }) ## helper function .mi_proportion <- function(y, model) { if(y@n_drawn == 0) stop("'impute' should not have been called because there are no missing data") if(!is.element(y@imputation_method, c("ppd", "pmm"))) badHessian <- FALSE else if(is.null(model$vcov)) badHessian <- FALSE else if(!all(is.finite(model$vcov))) badHessian <- TRUE else { ev <- eigen(vcov(model), TRUE) badHessian <- any(ev$values <= 0) means <- coef(model) parameters <- .draw_parameters(means, ev) # while(!badHessian && parameters[length(parameters)] <= 0) { # parameters <- .draw_parameters(means, ev) # } } if(badHessian && y@imputation_method == "ppd") { warning(paste("predictive mean matching used for", y@variable_name, "as a fallback due to Hessian error")) old_method <- y@imputation_method y@imputation_method <- "pmm" y <- mi(y, model) return(y@data[y@which_miss]) } else if(y@imputation_method == "ppd") { eta <- model$x[y@which_drawn,,drop=FALSE] %*% parameters[1:NCOL(model$x)] mu <- model$link$mean$linkinv(eta) phi <- model$link$precision$linkinv(parameters[length(parameters)]) ## FIXME: in the parameterized case shape1 <- mu * phi shape2 <- phi - shape1 draws <- rbeta(y@n_drawn, shape1, shape2) } else if(y@imputation_method == "pmm") { eta <- model$x %*% parameters[-length(parameters)] draws <- .pmm(y, eta)[,1] #FIXME: haven't adjusted fitted values for pmm } else if(y@imputation_method == "mean") { mu <- predict(model) mu_observed <- mu[y@which_obs] mu_mean <- mean(mu_observed) draws <- rep(mu_mean, y@n_drawn) } else if(y@imputation_method == "median") { mu <- predict(model) mu_observed <- mu[y@which_obs] mu_median <- median(mu_observed) draws <- rep(mu_median, y@n_drawn) } else if(y@imputation_method == "expectation") draws <- predict(model)[y@which_drawn] else stop("'imputation_method' not recognized") return(draws) } setOldClass("betareg") setMethod("mi", signature(y = "proportion", model = "betareg"), def = function(y, model, s, ...) { draws <- .mi_proportion(y, model) y@data[y@which_drawn] <- draws y@imputations[s,] <- draws return(y) }) setMethod("mi", signature(y = "proportion", model = "glm"), def = function(y, model, s, ...) { draws <- .mi_continuous(y, model) y@data[y@which_drawn] <- draws y@imputations[s,] <- draws return(y) }) setMethod("mi", signature(y = "SC_proportion", model = "betareg"), def = function(y, model, s, ...) { draws <- .mi_proportion(y, model) n <- y@n_total if(is(y@indicator, "binary")) { mark <- which(complete(y@indicator, 0L)[y@which_miss] == 1) if(any(y@raw_data == 0, na.rm = TRUE)) draws[mark] <- .5 / n else draws[mark] <- (n - .5) / n } else { signs <- complete(y@indicator, 0L)[y@which_drawn] draws[signs < 0] <- .5 / n draws[signs > 0] <- (n - .5) / n } y@data[y@which_drawn] <- draws y@imputations[s,] <- draws return(y) }) ## draw from overdispersed Poisson distribution .rpois.od <- function(n, lambda, dispersion = 1) { if (dispersion <= 1) ans <- rpois(n, lambda) else { B <- 1/(dispersion-1) A <- lambda * B ans <- rnbinom(n, size= A , mu = lambda) } return(ans) } setMethod("mi", signature(y = "count", model = "glm"), def = function(y, model, s, ...) { if(y@n_drawn == 0) stop("'impute' should not have been called because there are no missing data") if(y@imputation_method == "ppd") { ev <- eigen(vcov(model), symmetric = TRUE) parameters <- .draw_parameters(coef(model), ev) eta <- model$x[y@which_drawn,,drop=FALSE] %*% parameters pred <- model$family$linkinv(eta) draws <- .rpois.od(y@n_drawn, pred, model$dispersion) } else if(y@imputation_method == "pmm") { ev <- eigen(vcov(model), symmetric = TRUE) parameters <- .draw_parameters(coef(model), ev) eta <- model$x %*% parameters draws <- .pmm(y, eta)[,1] #FIXME: haven't adjusted fitted values for pmm } else if(y@imputation_method == "mean") { eta <- predict(model, type = "response") eta_observed <- eta[y@which_obs] eta_mean <- mean(eta_observed) draws <- rep(round(eta_mean), y@n_drawn) } else if(y@imputation_method == "median") { eta <- predict(model, type = "response") eta_observed <- eta[y@which_obs] eta_median <- median(eta_observed) draws <- rep(floor(eta_median), y@n_drawn) } else if(y@imputation_method == "expectation") draws <- round(predict(model, type = "response")[y@which_drawn]) else stop("'imputation_method' not recognized") draws <- as.integer(draws) y@data[y@which_drawn] <- draws y@imputations[s,] <- draws return(y) }) setMethod("mi", signature(y = "irrelevant", model = "ANY"), def = function(y, model, ...) { stop("The mi() method should not have been called on an 'irrelevant' variable") }) ## FIXME: account for the other stuff at the bottom of the original mi.R file mi/R/get_parameters.R0000644000175000017500000000520612513634171014345 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## these extract parameters from an estimated object setMethod("get_parameters", signature(object = "ANY"), def = function(object, ...) { return(c(coef(object))) }) setOldClass("polr") setMethod("get_parameters", signature(object = "polr"), def = function(object, ...) { return(c(coef(object), object$zeta)) }) setOldClass("multinom") setMethod("get_parameters", signature(object = "multinom"), def = function(object, ...) { return(c(t(coef(object)))) }) setMethod("get_parameters", signature(object = "missing_variable"), def = function(object, latest = FALSE, ...) { if(latest) { if(is.logical(latest)) { mark <- !apply(object@parameters, 1, FUN = function(x) any(is.na(x))) mark <- mark[length(mark)] } else mark <- latest return(object@parameters[mark,]) } else return(object@parameters) }) setMethod("get_parameters", signature(object = "missing_data.frame"), def = function(object, latest = FALSE, ...) { mini_list <- lapply(object@variables, get_parameters, latest = latest, ...) out <- matrix(NA_real_, nrow(mini_list[[1]]), ncol = 0) for(i in seq_along(mini_list)) out <- cbind(out, mini_list[[i]]) return(out) }) setMethod("get_parameters", signature(object = "mi"), def = function(object, latest = FALSE, ...) { mini_list <- lapply(object@data, get_parameters, latest = latest, ...) dims <- dim(mini_list) out <- array(NA_real_, c(dims[1], length(mini_list), dims[2]), dimnames = list(NULL, NULL, colnames(mini_list[[1]]))) for(i in 1:NCOL(out)) out[,i,] <- mini_list[[i]] return(out) }) setMethod("get_parameters", signature(object = "mi_list"), def = function(object, latest = FALSE, ...) { lapply(object, get_parameters, latest = latest, ...) }) mi/R/change_size.R0000644000175000017500000000525312513634171013624 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. setMethod("change_size", signature(data = "missing", y = "missing_variable", to = "integer"), def = function(y, to) { n <- to if(n <= 0) { y@data <- y@data[-y@which_extra] y@which_extra <- integer(0) y@n_total <- y@n_total - y@n_extra y@n_extra <- NA_integer_ return(y) } end <- y@n_total SEQ <- (end+1):(end+n) y@data <- c(y@data, rep(NA, n)) y@which_extra <- c(y@which_extra, SEQ) y@n_extra <- y@n_extra + n y@n_total <- y@n_total + n return(y) }) setMethod("change_size", signature(data = "missing", y = "categorical", to = "integer"), def = function(y, to) { n <- to if(n <= 0) { y@data <- y@data[-y@which_extra] y@which_extra <- integer(0) y@n_total <- y@n_total - y@n_extra y@n_extra <- NA_integer_ return(y) } end <- y@n_total SEQ <- (end+1):(end+n) y@data <- c(y@data, rep(NA, n)) y@which_extra <- c(y@which_extra, SEQ) y@n_extra <- y@n_extra + n y@n_total <- y@n_total + n return(y) }) setMethod("change_size", signature(data = "missing", y = "fixed", to = "integer"), def = function(y, to) { n <- to if(n <= 0) { y@data <- y@data[-y@which_extra] y@which_extra <- integer(0) y@n_total <- y@n_total - y@n_extra y@n_extra <- NA_integer_ return(y) } end <- y@n_total SEQ <- (end+1):(end+n) y@data <- c(y@data, rep(y@data[1], n)) y@which_extra <- c(y@which_extra, SEQ) y@n_extra <- y@n_extra + n y@n_total <- y@n_total + n return(y) }) setMethod("change_size", signature(data = "missing_data.frame", y = "missing", to = "integer"), def = function(data, to) { n <- to data@variables <- lapply(data@variables, FUN = function(x) change_size(x, n)) data@DIM[1] <- data@variables[[1]]@n_total return(data) }) mi/R/complete.R0000644000175000017500000001413712513634171013156 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## These functions extract completed data setMethod("complete", signature(y = "missing_variable", m = "integer"), def = function(y, m, ...) { out <- y@data if(m > 0 & y@n_drawn) out[y@which_drawn] <- as.numeric(y@imputations[m,]) return(out) }) setMethod("complete", signature(y = "irrelevant", m = "integer"), def = function(y, m, ...) { return(y@raw_data) }) setMethod("complete", signature(y = "categorical", m = "integer"), def = function(y, m, to_factor = TRUE, ...) { out <- y@data if(m > 0 & y@n_drawn) out[y@which_drawn] <- as.numeric(y@imputations[m,]) if(to_factor) { out <- factor(out, ordered = is(y, "ordered-categorical")) levels(out) <- y@levels } return(out) }) setMethod("complete", signature(y = "binary", m = "integer"), def = function(y, m, to_factor = TRUE, ...) { out <- y@data if(m > 0 & y@n_drawn) out[y@which_drawn] <- as.numeric(y@imputations[m,]) if(to_factor) { out <- factor(out, ordered = FALSE) levels(out) <- y@levels } return(out) }) setMethod("complete", signature(y = "continuous", m = "integer"), def = function(y, m, transform = TRUE, ...) { out <- y@data if(m > 0 & y@n_drawn) out[y@which_drawn] <- as.numeric(y@imputations[m,]) if(transform) out <- y@inverse_transformation(out) return(out) }) setMethod("complete", signature(y = "nonnegative-continuous", m = "integer"), def = function(y, m, transform = TRUE, ...) { out <- y@data if(m > 0 & y@n_drawn) out[y@which_drawn] <- as.numeric(y@imputations[m,]) if(transform) { out <- y@inverse_transformation(out) out[y@raw_data == 0] <- 0 } return(out) }) setMethod("complete", signature(y = "SC_proportion", m = "integer"), def = function(y, m, transform = TRUE, ...) { out <- y@data if(m > 0 & y@n_drawn) out[y@which_drawn] <- as.numeric(y@imputations[m,]) if(transform) out <- y@inverse_transformation(out) out[y@raw_data == 0] <- 0 out[y@raw_data == 1] <- 1 return(out) }) setMethod("complete", signature(y = "missing_data.frame", m = "integer"), def = function(y, m, to_matrix = FALSE, include_missing = TRUE) { if(to_matrix) out <- sapply(y@variables, complete, m = m, to_factor = FALSE, transform = FALSE) else out <- as.data.frame(lapply(y@variables, complete, m = m, to_factor = TRUE, transform = TRUE)) if(is(y, "allcategorical_missing_data.frame")) { out <- cbind(out, latents = complete(y@latents, m = m, to_factor = !to_matrix)) } if(include_missing) { M <- is.na(y)[,!sapply(y@variables, FUN = function(y) y@all_obs), drop = FALSE] colnames(M) <- paste("missing", colnames(M), sep = "_") out <- cbind(out, M) } return(out) }) setMethod("complete", signature(y = "mi", m = "numeric"), def = function(y, m = length(y), to_matrix = FALSE, include_missing = TRUE) { stopifnot(m == as.integer(m)) m <- as.integer(m) l <- length(y@data) draws <- sum(y@total_iters) if(length(m) > 1) out <- lapply(y@data[m], complete, m = 0L, to_matrix = to_matrix, include_missing = include_missing) else if(m == 1) out <- complete(y@data[[1]], m = 0L, to_matrix = to_matrix, include_missing = include_missing) # not a list else if(m <= l) out <- lapply(y@data[1:m], complete, m = 0L, to_matrix = to_matrix, include_missing = include_missing) else { # wants more completed datasets than chains quotient <- m %/% l remainder <- m %% l num <- quotient + (1:l <= remainder) out <- vector("list", m) count <- 1 for(i in seq_along(y@data)) { if(num[i] == 1) { out[[count]] <- complete(y@data[[i]], m = 0L, to_matrix = to_matrix, include_missing = include_missing) count <- count + 1 } else { # double-dip from a chain SEQ <- seq(from = ceiling(draws / 2), to = draws, length.out = num[i]) temp <- sapply(SEQ, FUN = function(j) complete(y@data[[i]], m = as.integer(j), to_matrix = to_matrix, include_missing = include_missing), simplify = FALSE) for(j in seq_along(temp)) { out[[count]] <- temp[[j]] count <- count + 1 } } } } return(out) }) setMethod("complete", signature(y = "mi", m = "missing"), def = function(y, to_matrix = FALSE, include_missing = TRUE) { return(complete(y, m = length(y), to_matrix = to_matrix, include_missing = include_missing)) }) setMethod("complete", signature(y = "mi_list", m = "numeric"), def = function(y, m = length(y[[1]]), to_matrix = FALSE, include_missing = TRUE) { temp <- lapply(y, FUN = complete, m = m, to_matrix = to_matrix, include_missing = include_missing) dfs <- temp[[1]] if(length(m) == 1 && m == 1 && length(temp) > 1) for(i in 2:length(temp)) { dfs <- rbind(dfs, temp[[i]]) } else if(length(temp) > 1) for(i in 2:length(temp)) for(j in 1:length(dfs)) { dfs[[j]] <- rbind(dfs[[j]], temp[[i]][[j]]) } return(dfs) }) setMethod("complete", signature(y = "mi_list", m = "missing"), def = function(y, to_matrix = FALSE, include_missing = TRUE) { return(complete(y, m = length(y[[1]]), to_matrix = to_matrix, include_missing = include_missing)) }) mi/R/fit_model.R0000644000175000017500000007312014247027001013277 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## these fit a regression and return the model # note, helper functions are good because they are checked more rigorously by R CMD check setMethod("fit_model", signature(y = "missing_variable", data = "missing_data.frame"), def = function(y, data, s, warn, ...) { stop("This method should not have been called. You need to define the relevant fit_model() S4 method") }) setMethod("fit_model", signature(y = "irrelevant", data = "missing_data.frame"), def = function(y, data, ...) { stop("'fit_model' should not have been called on an 'irrelevant' variable") }) setMethod("fit_model", signature(y = "binary", data = "missing_data.frame"), def = function(y, data, s, warn, X = NULL, ...) { if(is.null(X)) { to_drop <- data@index[[y@variable_name]] if(length(to_drop)) X <- data@X[,-to_drop] else X <- data@X[,] if(is(data, "experiment_missing_data.frame")) { treatment <- names(which(data@concept == "treatment")) if(data@concept[y@variable_name] == "outcome") { X <- cbind(X, interaction = X * data@variables[[treatment]]@data) } } } if(s > 1) start <- y@parameters[s-1,] else if(s < -1) start <- y@parameters[1,] else start <- NULL start <- NULL weights <- if(length(data@weights) == 1) data@weights[[1]] else data@weights[[y@variable_name]] CONTROL <- list(epsilon = max(1e-8, exp(-abs(s))), maxit = 25, trace = FALSE) priors <- data@priors[[y@variable_name]] out <- bayesglm.fit(X, y@data - 1L, weights = weights, prior.mean = priors[[1]], prior.scale = priors[[2]], prior.df = priors[[3]], prior.mean.for.intercept = priors[[4]], prior.scale.for.intercept = priors[[5]], prior.df.for.intercept = priors[[6]], start = start, family = y@family, Warning = FALSE, control = CONTROL) if(warn && !out$converged) { warning(paste("bayesglm() did not converge for variable", y@variable_name, "on iteration", abs(s))) } if(any(abs(coef(out)) > 100)) { warning(paste(y@variable_name, ": separation on iteration", abs(s))) } out$x <- X class(out) <- c("bayesglm", "glm", "lm") return(out) }) .fit_MNL <- function(y, X, weights) { model<-nnet::multinom(y@data ~ X -1, weights = weights, Hess = y@imputation_method == "ppd", model = TRUE, trace = FALSE, MaxNWts = 10000) return(model) } .fit_RNL <- function(y, X, weights, CONTROL) { if (y@use_NA==TRUE) values <- c(-.Machine$integer.max, 1:length(y@levels)) else values <- 1:length(y@levels) out <- sapply(values, simplify = FALSE, FUN = function(l) { model <- bayesglm.fit(X, y@data == l, weights = weights, family = y@family, control=CONTROL) model$x <- X # bayesglm.fit() by default does not retain the model matrix it uses class(model) <- c("bayesglm", "glm", "lm") return(model) }) class(out) <- "RNL" return(out) } setMethod("fit_model", signature(y = "unordered-categorical", data = "missing_data.frame"), def = function(y, data, warn, s, ...) { to_drop <- data@index[[y@variable_name]] if (y@use_NA) { y@data[y@which_drawn] <- -.Machine$integer.max # make NAs the smallest possible signed integer } if(length(to_drop)) X <- data@X[,-to_drop] else X <- data@X[,] if(is(data, "experiment_missing_data.frame")) { treatment <- names(which(data@concept == "treatment")) if(data@concept[y@variable_name] == "outcome") { X <- cbind(X, interaction = X * data@variables[[treatment]]@data) } } weights <- if(length(data@weights) == 1) data@weights[[1]] else data@weights[[y@variable_name]] if(y@estimator == "MNL") { out <- .fit_MNL(y, X, weights) data@X } else if(y@estimator == "RNL"){ CONTROL <- list(epsilon = max(1e-8, exp(-abs(s))), maxit = 25, trace = FALSE) out <- .fit_RNL(y, X, weights, CONTROL) data@X } else stop("estimator not recognized") return(out) }) .clogit <- # similar to the survival::clogit function function(formula, data, n, method, weights, subset, x = TRUE, na.action = "na.exclude") { coxcall <- match.call() coxcall[[1]] <- as.name("coxph") newformula <- formula newformula[[2]] <- substitute(survival::Surv(rep(1, nn), case), list(case = formula[[2]], nn = n)) environment(newformula) <- environment(formula) coxcall$formula <- newformula coxcall$n <- NULL coxcall <- eval(coxcall, sys.frame(sys.parent())) coxcall$userCall <- sys.call() class(coxcall) <- c("clogit", "coxph") coxcall } setMethod("fit_model", signature(y = "grouped-binary", data = "missing_data.frame"), def = function(y, data, s, warn) { # see http://www.stata.com/support/faqs/stat/clogitcl.html for a good explanation of this model to_drop <- data@index[[y@variable_name]] X <- data@X[,-to_drop] weights <- if(length(data@weights) == 1) data@weights[[1]] else data@weights[[y@variable_name]] groups <- sapply(y@strata, FUN = function(x) complete(data@variables[[x]], m = 0L), simplify = FALSE) out <- .clogit(y@data ~ X + strata(groups), method = "breslow", weights = weights, n = nrow(X)) out$x <- X return(out) }) setMethod("fit_model", signature(y = "ordered-categorical", data = "missing_data.frame"), def = function(y, data, s, warn, X = NULL, ...) { if(is.null(X)) { to_drop <- data@index[[y@variable_name]] if(length(to_drop)) X <- data@X[,-to_drop] else X <- data@X[,] if(is(data, "experiment_missing_data.frame")) { treatment <- names(which(data@concept == "treatment")) if(data@concept[y@variable_name] == "outcome") { X <- cbind(X, interaction = X * data@variables[[treatment]]@data) } } X <- X[,-1] } method <- if(y@family$link == "logit") "logistic" else y@family$link start <- NULL start <- c(rep(0, ncol(X)), qlogis(cumsum(table(y@data)) / nrow(X))) start <- start[-length(start)] weights <- if(length(data@weights) == 1) data@weights[[1]] else data@weights[[y@variable_name]] CONTROL <- list(reltol = max(1e-8, exp(-abs(s)))) priors <- data@priors[[y@variable_name]] out <- bayespolr(as.ordered(y@data) ~ X, weights = weights, method = method, prior.mean = priors[[1]], prior.scale = priors[[2]], prior.df = priors[[3]], prior.counts.for.bins = priors[[4]], control = list(reltol = max(1e-8, exp(-abs(s)))), ...) if(warn && out$convergence != 0) { warning(paste("bayespolr() did not converge for variable", y@variable_name, "on iteration", abs(s))) } out$x <- X return(out) }) setMethod("fit_model", signature(y = "interval", data = "missing_data.frame"), def = function(y, data, s, warn, ...) { stop("FIXME: write this method") }) ## helper function .fit_continuous <- function(y, data, s, warn, X, subset = 1:nrow(X)) { weights <- if(length(data@weights) == 1) data@weights[[1]] else data@weights[[y@variable_name]] if(!is.null(weights)) weights <- weights[subset] if(s > 1) start <- y@parameters[s-1,] else if(s < -1) start <- y@parameters[1,] else start <- NULL start <- NULL mark <- c(TRUE, apply(X[subset,-1, drop = FALSE], 2, FUN = function(x) length(unique(x)) > 1)) if(!all(mark)) { if(abs(s) == 1) { stop(paste(y@variable_name, ": imputed values on iteration 0 randomly inadmissible; try mi() again with different seed")) } X <- X[,mark] if(!is.null(start)) start <- start[mark] } CONTROL <- list(epsilon = max(1e-8, exp(-abs(s))), maxit = 25, trace = FALSE) priors <- data@priors[[y@variable_name]] out <- bayesglm.fit(X[subset,], y@data[subset], weights = weights, start = start, family = y@family, prior.mean = priors[[1]], prior.scale = priors[[2]], prior.df = priors[[3]], prior.mean.for.intercept = priors[[4]], prior.scale.for.intercept = priors[[5]], prior.df.for.intercept = priors[[6]], Warning = FALSE, control = CONTROL) if(warn && !out$converged) { warning(paste("bayesglm() did not converge for variable", y@variable_name, "on iteration", abs(s))) } out$x <- X class(out) <- c("bayesglm", "glm", "lm") return(out) } setMethod("fit_model", signature(y = "continuous", data = "missing_data.frame"), def = function(y, data, s, warn, ...) { to_drop <- data@index[[y@variable_name]] if(length(to_drop)) X <- data@X[,-to_drop] else X <- data@X[,] if(is(data, "experiment_missing_data.frame")) { treatment <- names(which(data@concept == "treatment")) if(data@concept[y@variable_name] == "outcome") { X <- cbind(X, interaction = X * data@variables[[treatment]]@data) } } return(.fit_continuous(y, data, s, warn, X)) }) # setMethod("fit_model", signature(y = "truncated-continuous", data = "missing_data.frame"), def = # function(y, data, s, warn, ...) { # stop("FIXME: write this method using library(survival)") # }) # # setMethod("fit_model", signature(y = "censored-continuous", data = "missing_data.frame"), def = # function(y, data, s, warn, ...) { # stop("FIXME: mi does not do censored-continuous variables yet") # to_drop <- data@index[[y@variable_name]] # X <- cbind(y@raw_data, data@X[,-to_drop]) # if(is(data, "experiment_missing_data.frame")) { # treatment <- names(which(data@concept == "treatment")) # if(data@concept[y@variable_name] == "outcome") { # X <- cbind(X, interaction = X * data@variables[[treatment]]@data) # } # } # }) setMethod("fit_model", signature(y = "semi-continuous", data = "missing_data.frame"), def = function(y, data, s, warn, ...) { stop("the semi-continuous fit_model() method should not have been called") }) setMethod("fit_model", signature(y = "nonnegative-continuous", data = "missing_data.frame"), def = function(y, data, s, warn, ...) { to_drop <- data@index[[y@variable_name]] if(length(to_drop)) X <- data@X[,-to_drop] else X <- data@X[,] model <- fit_model(y@indicator, data, s, warn, X) if(abs(s) > 1) subset <- complete(y@indicator, m = 0L, to_factor = TRUE) == 0 else subset <- 1:nrow(X) return(.fit_continuous(y = y, data = data, s = s, warn = warn, X = X, subset = subset)) }) setMethod("fit_model", signature(y = "SC_proportion", data = "missing_data.frame"), def = function(y, data, s, warn, ...) { to_drop <- data@index[[y@variable_name]] if(length(to_drop)) X <- data@X[,-to_drop] else X <- data@X[,] model <- fit_model(y@indicator, data, s, warn, X) if(abs(s) > 1) subset <- complete(y@indicator, m = 0L, to_factor = TRUE) == 0 else subset <- 1:nrow(X) return(.fit_proportion(y = y, data = data, s = s, warn = warn, X = X, subset = subset)) }) ## helper function .fit_proportion <- function(y, data, s, warn, X, subset = 1:nrow(X)) { weights <- if(length(data@weights) == 1) data@weights[[1]] else data@weights[[y@variable_name]] if(!is.null(weights)) weights <- weights[subset] if(s > 1) start <- y@parameters[s-1,] else if(s < -1) start <- y@parameters[1,] else start <- NULL start <- NULL mark <- c(TRUE, apply(X[subset,-1, drop = FALSE], 2, FUN = function(x) length(unique(x)) > 1)) if(!all(mark)) { if(abs(s) == 1) { stop(paste(y@variable_name, ": imputed values on iteration 0 randomly inadmissible; try mi() again with a different seed")) } X <- X[,mark] if(!is.null(start)) start <- start[c(mark, TRUE)] } out <- betareg::betareg.fit(X[subset,], y@data[subset], weights = if(!is.null(weights)) weights[subset], link = y@family$link, link.phi = y@link.phi, control = betareg::betareg.control(reltol = 1e-8, start = start, fsmaxit = 0)) if(warn && !out$converged) { warning(paste("betareg() did not converge for variable", y@variable_name, "on iteration", abs(s))) } out$x <- X class(out) <- c("betareg") return(out) } setMethod("fit_model", signature(y = "proportion", data = "missing_data.frame"), def = function(y, data, s, warn, ...) { to_drop <- data@index[[y@variable_name]] if(length(to_drop)) X <- data@X[,-to_drop] else X <- data@X[,] if(y@family$family == "gaussian") out <- .fit_continuous(y, data, s, warn, X) else out <- .fit_proportion(y, data, s, warn, X) return(out) }) setMethod("fit_model", signature(y = "count", data = "missing_data.frame"), def = function(y, data, s, warn, ...) { to_drop <- data@index[[y@variable_name]] if(length(to_drop)) X <- data@X[,-to_drop] else X <- data@X[,] return(.fit_continuous(y, data, s, warn, X)) # even though counts are not continuous }) ## experiments setMethod("fit_model", signature(y = "missing_variable", data = "experiment_missing_data.frame"), def = function(y, data, ...) { stop("you need to write a specific fit_model() method for the", class(y), "class") }) setMethod("fit_model", signature(y = "continuous", data = "experiment_missing_data.frame"), def = function(y, data, s, warn, ...) { to_drop <- data@index[[y@variable_name]] ## For each case, make an X matrix based on the giant matrix in data@X if(data@case == "outcomes") { # missingness on outcome(s) only if(length(to_drop)) X <- data@X[,-to_drop] else X <- data@X[,] treatment_name <- names(data@concept[data@concept == "treatment"]) X <- cbind(X, interaction = X[,!(colnames(X) %in% c("(Intercept)", treatment_name))] * X[,treatment_name]) } else if(data@case == "covariates") { # missingness on covariate(s) only to_drop <- c(to_drop, which(data@concept == "treatment")) if(length(to_drop)) X <- data@X[,-to_drop] else X <- data@X[,] } else { # missing on both outcome(s) and covariate(s) if(data@concept[y@variable_name] == "covariate") { to_drop <- c(to_drop, which(data@concept == "treatment")) } if(length(to_drop)) X <- data@X[,-to_drop] else X <- data@X[,] } return(mi::.fit_continuous(y, data, s, warn, X)) }) ## here y indicates which variable to model setMethod("fit_model", signature(y = "character", data = "mi"), def = function(y, data, m = length(data@data), ...) { s <- sum(data@total_iters) + 1 if(length(m) == 1) { models <- vector("list", m) for(i in 1:m) { model <- data@data[[i]]@variables[[y]]@model if(is.null(model)) { model <- fit_model(y = data@data[[i]]@variables[[y]], data = data@data[[i]], s = s, warn = TRUE, ...) if(!isS4(model)) model$x <- model$X <- model$y <- NULL } models[[i]] <- model } } else { models <- vector("list", length(m)) models <- for(i in 1:length(m)) { if(is.null(data@data[[i]]@variables[[y]]@model)) { models[[m[i]]] <- fit_model(y = data@data[[m[i]]]@variables[[y]], data = data@data[[m[i]]], s = s, warn = TRUE, ...) } else models[[i]] <- data@data[[i]]@variables[[y]]@model } } return(models) }) ## fit all variables with missingness setMethod("fit_model", signature(y = "missing", data = "mi"), def = function(data, m = length(data@data)) { varnames <- names(data@data[[1]]@variables) exclude <- data@data[[1]]@no_missing | sapply(data@data[[1]], FUN = function(y) is(y, "irrelevant")) models <- sapply(varnames, simplify = FALSE, FUN = function(v) { if(v %in% exclude) paste(v, "not modeled") ## maybe just skip these? else fit_model(y = v, data = data, m = m) }) return(models) }) ## fit all elements of a mdf_list setMethod("fit_model", signature(y = "missing", data = "mdf_list"), def = function(data, s = -1, verbose = FALSE, warn = FALSE, ...) { out <- lapply(data, fit_model, s = s, verbose = verbose, warn = warn, ...) class(out) <- "mdf_list" return(out) }) .fit_model_y <- function(y, data, s, verbose, warn, ...) { if(s != 0 && y@imputation_method != "mcar") { if(is(y, "semi-continuous")) { to_drop <- data@index[[y@variable_name]] if(length(to_drop)) X <- data@X[,-to_drop] else X <- data@X[,] model <- fit_model(y = y@indicator, data = data, s = s, warn = warn, X = X) indicator <- mi(y = y@indicator, model = model, s = ifelse(s < 0, 1L, s)) if(s > 1) indicator@parameters[s,] <- get_parameters(model) else if(abs(s) == 1) { parameters <- get_parameters(model) rows <- if(s == 1) nrow(indicator@parameters) else 1 if(ncol(indicator@parameters) == 0) { temp <- matrix(NA_real_, nrow = rows, ncol = length(parameters)) } temp[1,] <- parameters indicator@parameters <- temp } else indicator@parameters[1,] <- get_parameters(model) y@indicator <- indicator } model <- fit_model(y = y, data = data, s = s, warn = warn) y <- mi(y = y, model = model, s = ifelse(s < 0, 1L, s)) } else y <- mi(y = y) if(y@imputation_method == "mcar") { # do nothing } else if(s > 1) { parameters <- get_parameters(model) if(length(parameters) != ncol(y@parameters)) parameters <- y@parameters[s-1,] # scary y@parameters[s,] <- parameters } else if(abs(s) == 1) { parameters <- get_parameters(model) rows <- if(s == 1) nrow(y@parameters) else 1 if(ncol(y@parameters) == 0) { temp <- matrix(NA_real_, nrow = rows, ncol = length(parameters)) } temp[1,] <- parameters y@parameters <- temp } else if(s != 0) { parameters <- get_parameters(model) if(length(parameters) == ncol(y@parameters)) y@parameters[s,] <- parameters } return(y) } .update_X <- function(y, data) { which_drawn <- y@which_drawn varname <- y@variable_name if(is(y, "categorical")) { dummies <- .cat2dummies(y)[which_drawn,,drop = FALSE] data@X[ which_drawn, data@index[[varname]][1:NCOL(dummies)]] <- dummies } else if(is(y, "semi-continuous")) { mark <- data@index[[varname]] data@X[ which_drawn, mark[1] ] <- y@data[which_drawn] dummies <- .cat2dummies(y@indicator) data@X[ which_drawn, mark[1 + 1:NCOL(dummies)] ] <- dummies[which_drawn,,drop = FALSE] } else if(is(y, "censored_continuous")) { temp <- y@data[which_drawn] if(y@n_lower) temp <- cbind(temp, lower = y@lower_indicator@data[y@which_drawn]) if(y@n_upper) temp <- cbind(temp, upper = y@upper_indicator@data[y@which_drawn]) data@X[ which_drawn, data@index[[varname]][1:NCOL(temp)]] <- temp data@X[ y@which_censored, data@index[[varname]][1] ] <- y@data[y@which_censored] } else if(is(y, "truncated_continuous")) { temp <- y@data[which_drawn] if(y@n_lower) temp <- cbind(temp, lower = y@lower_indicator@data[y@which_drawn]) if(y@n_upper) temp <- cbind(temp, upper = y@upper_indicator@data[y@which_drawn]) data@X[ which_drawn, data@index[[varname]][1:NCOL(temp)]] <- temp data@X[ y@which_truncated, data@index[[varname]][1] ] <- y@data[y@which_truncated] } else data@X[ which_drawn, data@index[[varname]][1] ] <- y@data[which_drawn] return(data) } .fit_model_mdf <- function(data, s, verbose, warn, ...) { if(verbose) { txt <- paste("Iteration:", abs(s)) if(isatty(stdout()) && !(any(search() == "package:gWidgets"))) cat("\n", txt) else cat("
", txt, file = file.path(data@workpath, "mi.html"), append = TRUE) } on.exit(print("the problematic variable is")) on.exit(show(y), add = TRUE) for(jj in sample(1:ncol(data), ncol(data), replace = FALSE)) { y <- data@variables[[jj]] if(y@all_obs) next if(is(y, "irrelevant")) next y <- .fit_model_y(y, data, s, verbose, warn, ...) data <- .update_X(y, data) data@variables[[jj]] <- y if(verbose) { txt <- "." if(isatty(stdout()) && !(any(search() == "package:gWidgets"))) cat(txt) else cat(txt, file = file.path(data@workpath, "mi.html"), append = TRUE) } } if(verbose) { if(isatty(stdout()) && !(any(search() == "package:gWidgets"))) cat(" ") else cat("
", file = file.path(data@workpath, "mi.html"), append = TRUE) } if(.MI_DEBUG) sapply(data@variables, validObject, complete = TRUE) on.exit() return(data) } ## unlike the above methods, these return a (modified) missing_data.frame setMethod("fit_model", signature(y = "missing", data = "missing_data.frame"), def = function(data, s = -1, verbose = FALSE, warn = FALSE, ...) { return(.fit_model_mdf(data = data, s = s, verbose = verbose, warn = warn, ...)) }) setMethod("fit_model", signature(y = "missing", data = "allcategorical_missing_data.frame"), def = function(data, s = -1, verbose = FALSE, warn = FALSE, ...) { if(verbose) { txt <- paste("Iteration:", abs(s)) if(isatty(stdout()) && !(any(search() == "package:gWidgets"))) cat("\n", txt) else cat("
", txt, file = file.path(data@workpath, "mi.html"), append = TRUE) } Hstar <- data@Hstar if(abs(s) == 0) { # starting iteration V_h <- c(runif(Hstar - 1), 1) c_prod <- cumprod(1 - V_h) data@parameters$pi <- V_h * c(1, c_prod[-Hstar]) data@variables <- lapply(data@variables, FUN = function(y) { if(is(y, "irrelevant")) return(y) if(y@all_obs) return(y) return(mi(y)) # bootstrapping }) data@X <- do.call(cbind, args = lapply(data@variables, FUN = function(y) { if(is(y, "irrelevant")) return(NULL) else return(y@data) })) phi <- lapply(1:Hstar, FUN = function(h) { lapply(data@variables, FUN = function(y) { if(is(y, "irrelevant")) return(NULL) return(c(tabulate(y@data, nbins = length(y@levels)) / y@n_total)) })}) data@parameters$phi <- phi data@parameters$alpha <- 1 cols <- Hstar rows <- nrow(data@latents@imputations) if(ncol(data@latents@parameters) == 0) { temp <- matrix(NA_real_, nrow = rows, ncol = cols) } data@latents@parameters <- temp return(data) } # S1: Update latent class membership pi <- data@parameters$pi phi <- data@parameters$phi probs <- sapply(1:Hstar, FUN = function(h) { phi_h <- phi[[h]] numerators <- rep(1, nrow(data)) for(j in 1:ncol(data)) { y <- data@variables[[j]] if(is(y, "irrelevant")) next phi_hj <- phi_h[[y@variable_name]] numerators <- numerators * data@X[,y@variable_name] * phi_hj[data@X[,y@variable_name]] } numerators <- numerators * pi[h] return(numerators) }) z <- apply(probs, 1, FUN = function(prob) { which(rmultinom(1,1,prob) == 1) # rmultinom normalizes internally }) data@latents@data[] <- z data@latents@imputations[s,] <- z data@latents@parameters[s,] <- pi # S2: Update V_h n_h <- c(tabulate(z, nbins = Hstar)) V_h <- sapply( 1:(Hstar - 1), FUN = function(h) { a <- 1 + n_h[h] b <- data@parameters$alpha + sum(n_h[-c(1:h)]) if(b == 0) return(1) rbeta(1, a, b) }) V_h <- c(V_h, 1) c_prod <- cumprod(1 - V_h) data@parameters$pi <- V_h * c(1, c_prod[-Hstar]) # S3: Update choice probabilities phi <- lapply(1:Hstar, FUN = function(h) lapply(data@variables, FUN = function(y) { if(is(y, "irrelevant")) return(NULL) mark <- z == h tab <- tabulate(y@data[mark], nbins = length(y@levels)) return(.rdirichlet(1, data@priors$a[y@variable_name] + c(tab))) })) data@parameters$phi <- phi # S4: Update alpha alpha <- rgamma(1, data@priors$a_alpha + Hstar - 1, data@priors$b_alpha - log(pi[Hstar])) data@parameters$alpha <- alpha # S5: Impute data@variables <- lapply(data@variables, FUN = function(y) { if(is(y, "irrelevant")) return(y) if(y@all_obs) return(y) if(verbose) { txt <- "." if(isatty(stdout()) && !(any(search() == "package:gWidgets"))) cat(txt) else cat(txt, file = file.path(data@workpath, "mi.html"), append = TRUE) } classes <- z[y@which_drawn] uc <- unique(classes) Pr <- t(sapply(uc, FUN = function(c) phi[[c]][[y@variable_name]])) rownames(Pr) <- uc y <- mi(y, Pr[as.character(classes),,drop=FALSE]) }) data@X <- do.call(cbind, args = lapply(data@variables, FUN = function(y) { if(is(y, "irrelevant")) return(NULL) else return(y@data) })) return(data) }) .fit_model_Sophie <- function(y, data, s = -1, verbose = FALSE, warn = FALSE, ...) { classes <- data@latents@data uc <- unique(classes) Pr <- t(sapply(uc, FUN = function(c) data@parameters$phi[[c]][[y@variable_name]])) rownames(Pr) <- uc # Pr <- Pr[as.character(classes),,drop=FALSE] Pr <- Pr / rowSums(Pr) return(list(fitted = Pr)) } setMethod("fit_model", signature(y = "unordered-categorical", data = "allcategorical_missing_data.frame"), def = function(y, data, s = -1, verbose = FALSE, warn = FALSE, ...) { return(.fit_model_Sophie(y, data, s, verbose, warn, ...)) }) setMethod("fit_model", signature(y = "ordered-categorical", data = "allcategorical_missing_data.frame"), def = function(y, data, s = -1, verbose = FALSE, warn = FALSE, ...) { return(.fit_model_Sophie(y, data, s, verbose, warn, ...)) }) setMethod("fit_model", signature(y = "binary", data = "allcategorical_missing_data.frame"), def = function(y, data, s = -1, verbose = FALSE, warn = FALSE, ...) { return(.fit_model_Sophie(y, data, s, verbose, warn, ...)) }) setMethod("fit_model", signature(y = "missing_data.frame", data = "missing_data.frame"), def = function(y, data, s = -1, verbose = FALSE, warn = FALSE, ...) { if(verbose) { txt <- paste("Iteration:", abs(s)) if(isatty(stdout()) && !(any(search() == "package:gWidgets"))) cat("\n", txt) else cat("
", txt, file = file.path(data@workpath, "mi.html"), append = TRUE) } for(jj in sample(1:ncol(y), ncol(y), replace = FALSE)) { z <- y@variables[[jj]] if(z@all_obs) next if(is(z, "irrelevant")) next y@variables[[jj]] <- .fit_model_y(z, data, s, verbose, warn, ...) if(verbose) { txt <- "." if(isatty(stdout()) && !(any(search() == "package:gWidgets"))) cat(txt) else cat(txt, file = file.path(data@workpath, "mi.html"), append = TRUE) } } if(verbose) { if(isatty(stdout()) && !(any(search() == "package:gWidgets"))) cat(" ") else cat("
", file = file.path(data@workpath, "mi.html"), append = TRUE) } if(.MI_DEBUG) sapply(data@variables, validObject, complete = TRUE) return(y) }) setMethod("fit_model", signature(y = "missing", data = "multilevel_missing_data.frame"), def = function(data, s = -1, verbose = FALSE, warn = FALSE, ...) { data@mdf_list <- fit_model(data = data@mdf_list, s = s, verbose = verbose, warn = warn, ...) if(s == 0) return(data) ## FIXME: Implement 3+ levels recursively # update group means means <- sapply(data@mdf_list, FUN = function(x) colMeans(x@X[,-1])) if(is.list(means)) { } else means <- t(means) mark <- 0L ## FIXME data@X[,mark] <- means # impute the group level variables if necessary data <- .fit_model_mdf(data = data, s = s, verbose = verbose, warn = warn, ...) # model the individual level estimates for(i in seq_along(ncol(data))) { if(is(data@variables[[i]], "irrelevant")) next # if(data@no_missing[i]) next mark <- if(s < 0) 1 else s fish <- sapply(data@mdf_list, FUN = function(d) d@variables[[i]]@parameters[mark,]) if(is.list(fish)) { ## FIXME: may be a list } else fish <- t(fish) for(j in seq_along(ncol(fish))) { model <- bayesglm.fit(data@X, y = fish[,j]) # group-level regression class(model) <- c("bayesglm", "glm", "lm") params <- arm::sim(model, 1) beta <- params@coef sigma <- params@sigma yhats <- rnorm(nrow(data@X), data@X %*% beta, sd = sigma) # change the priors for each element of the mdf_list accordingly for(k in seq_along(data@mdf_list)) { data@mdf_list[[k]]$mean[colnames(data)[j]] <- yhats[k] data@mdf_list[[k]]$sd[colnames(data)[j]] <- sigma } } } return(data) }) mi/R/missing_variable.R0000644000175000017500000001514112513637565014672 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. .guess_type <- function(y, favor_ordered = TRUE, favor_positive = FALSE, threshold = 5, variable_name = deparse(substitute(y))) { if(!is.null(dim(y))) stop(paste(variable_name, ": must be a vector")) if(is.factor(y)) y <- factor(y) # to drop unused levels values <- unique(y) values <- sort(values[!is.na(values)]) len <- length(values) if(len == 0) { warning(paste(variable_name, ": cannot infer variable type when all values are NA, guessing 'irrelevant'")) type <- "irrelevant" } else if(len == 1) type <- "fixed" else if(grepl("^[[:punct:]]", variable_name)) type <- "irrelevant" else if(identical("id", tolower(variable_name))) type <- "irrelevant" else if(len == 2) { if(!is.numeric(values)) type <- "binary" else if(all(values == as.integer(values))) type <- "binary" else if(favor_positive) { if(all(values > 0)) type <- "positive-continuous" else if(all(values >= 0)) type <- "nonnegative-continuous" else type <- "continuous" } else type <- "continuous" } else if(is.ts(y)) { if(favor_positive) { if(all(values > 0)) type <- "positive-continuous" else if(all(values >= 0)) type <- "nonnegative-continuous" else type <- "continuous" } else type <- "continuous" } else if(is.ordered(y)) type <- "ordered-categorical" else if(is.factor(y)) type <- "unordered-categorical" else if(is.character(y)) type <- "unordered-categorical" else if(is.numeric(y)) { if(all(values >= 0) && all(values <= 1)) { if(any(values %in% 0:1)) type <- "SC_proportion" else type <- "proportion" } else if(len <= threshold && all(values == as.integer(values))) type <- if(favor_ordered) "ordered-categorical" else "unordered-categorical" else if(favor_positive) { if(all(values > 0)) type <- "positive-continuous" else if(all(values >= 0)) type <- "nonnegative-continuous" else type <- "continuous" } else type <- "continuous" } else stop(paste("cannot infer variable type for", variable_name)) return(type) } ## this constructor largely supplants typecast in previous versions of library(mi) setMethod("missing_variable", signature(y = "ANY", type = "missing"), def = function(y, favor_ordered = TRUE, favor_positive = FALSE, threshold = 5, variable_name = deparse(substitute(y))) { type <- .guess_type(y, favor_ordered, favor_positive, threshold, variable_name) return(missing_variable(y = y, type = type, variable_name = variable_name)) }) setMethod("missing_variable", signature(y = "ANY", type = "character"), def = function(y, type, variable_name = deparse(substitute(y)), ...) { return(new(type, raw_data = y, variable_name = variable_name, ...)) }) .show_helper <- function(object) { type <- class(object) missingness <- object@n_miss meth <- object@imputation_method if(object@n_miss) { if(is.character(object@family)) { fam <- object@family link <- NA_character_ } else { fam <- object@family$family link <- object@family$link } } else fam <- link <- NA_character_ if(is(object, "continuous")) trans <- .parse_trans(object@transformation) else trans <- NA_character_ df <- data.frame(type = type, missing = missingness, method = meth, family = fam, link = link, transformation = trans) rownames(df) <- object@variable_name if(is(object, "semi-continuous")) df <- rbind(df, .show_helper(object@indicator)) return(df) } setMethod("show", signature(object = "missing_variable"), def = function(object) { df <- .show_helper(object) print(df) }) ## setAs methods cause subtle problems with auto-coercion # setAs(from = "unordered-categorical", to = "ordered-categorical", def = # function(from) { # class(from) <- "ordered-categorical" # return(from) # }) # # setAs(from = "ordered-categorical", to = "unordered-categorical", def = # function(from) { # class(from) <- "unordered-categorical" # return(from) # }) # # setAs(from = "binary", to = "unordered-categorical", def = # function(from) { # stop("not possible or necessary to coerce from 'binary' to 'unordered-categorical'") # }) # setAs(from = "binary", to = "ordered-categorical", def = # function(from) { # stop("not possible or necessary to coerce from 'binary' to 'unordered-categorical'") # }) # setAs(from = "nonnegative-continuous", to = "continuous", def = # function(from) { # mean <- mean(from@raw_data, na.rm = TRUE) # sd <- sd(from@raw_data, na.rm = TRUE) # from@transformation <- .standardize_transform # formals(from@transformation)$mean <- mean # formals(from@transformation)$sd <- sd # from@inverse_transformation <- .standardize_transform # formals(from@inverse_transformation)$mean <- mean # formals(from@inverse_transformation)$sd <- sd # formals(from@inverse_transformation)$inverse <- TRUE # from@data <- from@transformation(from@raw_data) # class(from) <- "continuous" # return(from) # }) # # setAs(from = "continuous", to = "positive-continuous", def = # function(from) { # from@transformation <- log # from@inverse_transformation <- exp # from@data <- from@transformation(from@raw_data) # class(from) <- "positive-continuous" # validObject(from) # return(from) # }) # ## maybe add more methods ## NOTE: If you change something here, look also at the change_type.R file mi/R/change_model.R0000644000175000017500000001532312513634171013751 0ustar nileshnilesh# Part of the mi package for multiple imputation of missing data # Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## these are convience functions that implicitly change something else by changing the model buzzword setMethod("change_model", signature(data = "missing", y = "missing_variable", to = "character"), def = function(y, to) { switch(to, "logit" = new("binary", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = binomial(link = "logit")), "probit" = new("binary", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = binomial(link = "probit")), "cauchit" = new("binary", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = binomial(link = "cauchit")), "cloglog" = new("binary", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = binomial(link = "cloglog")), "qlogit" = new("binary", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = quasibinomial(link = "logit")), "qprobit" = new("binary", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = quasibinomial(link = "probit")), "qcauchit" = new("binary", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = quasibinomial(link = "cauchit")), "qcloglog" = new("binary", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = quasibinomial(link = "cloglog")), "ologit" = new("ordered-categorical", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = multinomial(link = "logit")), "oprobit" = new("ordered-categorical", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = multinomial(link = "probit")), "ocauchit" = new("ordered-categorical", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = multinomial(link = "cauchit")), "ocloglog" = new("ordered-categorical", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = multinomial(link = "cloglog")), "mlogit" = new("unordered-categorical", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = multinomial(link = "logit")), "RNL" = new("unordered-categorical", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = binomial(link = "logit")), "qpoisson" = new("count", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = quasipoisson(link = "log")), "poisson" = new("count", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = poisson(link = "log")), "linear" = new("continuous", variable_name = y@variable_name, raw_data = y@raw_data, imputation_method = y@imputation_method, family = gaussian(link = "identity")), stop("model not recognized") ) }) setMethod("change_model", signature(data = "missing_data.frame", y = "character", to = "character"), def = function(data, y, to) { if(length(to) == 1) to <- rep(to, length(y)) else if(length(to) != length(y)) stop("'y' and 'to' must have the same length") if(all(y %in% names(getClass("missing_variable")@subclasses))) { classes <- sapply(data@variables, class) y <- c(sapply(y, FUN = function(x) { names(classes[which(classes == x)]) })) if(is.list(y)) stop(paste("no variables of class", names(y)[1])) to <- rep(to[1], length(y)) } y <- match.arg(y, data@DIMNAMES[[2]], several.ok = TRUE) check <- FALSE for(i in 1:length(y)) { categorical <- is(data@variables[[y[i]]], "categorical") data@variables[[y[i]]] <- change_model(y = data@variables[[y[i]]], to = to[i]) if(categorical & !is(data@variables[[y[i]]], "categorical")) check <- TRUE if(!categorical & is(data@variables[[y[i]]], "categorical")) check <- TRUE } if(check) return(new(class(data), variables = data@variables)) else return(data) }) setMethod("change_model", signature(data = "missing_data.frame", y = "numeric", to = "character"), def = function(data, y, to) { if(length(to) == 1) to <- rep(to, length(y)) else if(length(to) != length(y)) stop("'y' and 'to' must have the same length") for(i in 1:length(y)) { categorical <- is(data@variables[[y[i]]], "categorical") data@variables[[y[i]]] <- change_model(y = data@variables[[y[i]]], to = to[[i]]) if(categorical & !is(data@variables[[y[i]]], "categorical")) check <- TRUE if(!categorical & is(data@variables[[y[i]]], "categorical")) check <- TRUE } if(check) return(new(class(data), variables = data@variables)) else return(data) }) setMethod("change_model", signature(data = "missing_data.frame", y = "logical", to = "character"), def = function(data, y, to) { if(length(y) != data@DIM[2]) { stop("the length of 'y' must equal the number of variables in 'data'") } return(change_model(data, which(y), to)) }) mi/inst/0000755000175000017500000000000012513740435011772 5ustar nileshnileshmi/inst/CITATION0000644000175000017500000000035512450147374013135 0ustar nileshnileshbibentry( bibtype = "Article", title = "Opening Windows to the Black Box", author = c(person("Andrew", "Gelman"), person("Jennifer", "Hill")), journal = "Journal of Statistical Software", year = "2011", volume = "40" ) mi/inst/doc/0000755000175000017500000000000012513740435012537 5ustar nileshnileshmi/inst/doc/mi_vignette.pdf0000644000175000017500000157172414247037643015573 0ustar nileshnilesh%PDF-1.5 % 6 0 obj << /Length 2759 /Filter /FlateDecode >> stream xYo}8 Z4$饸G@ JZY$ewfg)LIrg*RJ*x~gj#d-rKVeӒToZĮjh]Z,`4mVKY6igGҲ&wXCyM6-긌ۯY4YJdoYץ=,)}8em̭ccxD 0w8"sKpEGĵ*'Y86/L+QUW{K uߚ<Ӥ تnin}IcH~ÁY;}m3k@ܦ]+}uYwXKZ{hlhepimG߮t{5YC#Ht1>/`I[Bxa3hq 6-[I"Z! ۵Q@M~غݢ(9< '[ IK׹9sE0'c圴8dB36ͼ,=ƃF,3vGdEt4&M,:YI*ΨN4Dw Ҙ캜W hLY6Q<jueZCݑڿצ-unY:giHNlפ#>$5cb :dmmYG<1ڌ5u7"Il$#Ӯ4iɚb~Pl:VC#ti^īM\(* &Oju&D(i\{}z^]]7NXbpJU$a}I*x~}q8΋DwpCS1Ӡ7UMkm8OTjX o-U(B#)2/D?P#J҂?Y VnC+[hV{?kX2 1S 2QѰyny'Qdhϲ! ;#$6#h"!jRߗ {l1О .!hEϹe+0qw P^cT$mˆ`/T4DiaƖ$0T ri;2 FW)4BB0$c^ĥ$6s?*\<)3qv50-UalJ,fJB"(U6vl3XB$im ɄJF9BJ#Z@GIBtZ(LR),Vա"\vq0cRi*+ᱦǹX|@f~O2!>i&!_$,&YRs BԷ+gcs$&+PdNJߋ_(N[^.]6+2׏?]ߗZ7ήz e a#v+gɗRg':Ӕc]f =[=@ [*rqz snio3tݥ'>vD7ăH|Xp5P|XE#^Y6 7Ua^Gm !Da&&SS<7WR]sthAa4g"N(?OI@;&5*Lx"z{DV$X01*1}Ɯp4ݡ)MR-j3@E4TzFq.IBUz}azno|V~([QPQ(Oթg4U`~/i:$'W[@m5ata|bqsV{6W0D;낈0E۹&O[|~|Nn1 I8PGWAbZiD$!SmDJf$xAI KJȐKxC=<;xBh-MZTN4*-1[ЀPvQ. ϫ=ə>nk&W[ȅ=|J1x0%x'S'\#rMɘ}D$4$,I31K$3% #z^E-:-ȡuS`MEq/n՜q~g`!:c3/2\b``䎆5z[1688OCmv="p>ǁ[dzDtXg GX'9kQcOA7]b11<&%aGFi#ƆsveE E,h]Rٹ$\ED$y$70q>Qbt s ӆEot?A%7`F"Rtƒr&#t|QM1c\CǹuvU4T,% I(P NOk `\`dN@\sa쌃W>=fpqD0R62O6/ngG_ ×? 5pRN'9_a$! =r0t9#PҀ|1n$v̍cQfNġ߶L4q?9dMsW3kښ|mkv KbBQ)PYif{ƈTBܑ~?3F%:1C͸jfwOݜffXik,WnFâ g Vn/2Gb>N0c ! o u@$|D?WO endstream endobj 20 0 obj << /Length 1956 /Filter /FlateDecode >> stream xYYoD~ϯ)ۗ/-,ժc4$_Oagg%/z on^}Ǚ$w"E#"6O>Y8 (TZӐ~?VZ]#vS5TUׄ$̺~BA0b߶JvPeTNh2<%rf>/:

ڍtAE"[ssLgzNM# 篏ح<ΡΩ. %#gW DwM$\u-!Ez$f8v;%`.4s0LC4"XZ5lkb0; ٱ7Nn}:}ڡ{o6YuTYQ KgGη0Ze=Qe2?JH?6>FI:sQWR4g\,ǚ uhuFW/Mc#tkɜ3(/ixc c?Sen's{VLgGtQYW+s T`1>Ds) fFyAp/w $A?HZ(|\c *qCHh_f8Ǯ}nk Nqٻ8ߥ{N?qNOXƣXS?f8=ZZC endstream endobj 27 0 obj << /Length 633 /Filter /FlateDecode >> stream xVM@ WCg<{@iWjҊ.H|6Iv[@\6Y{7~s j@'P=̒5*ȩRyRAjPG77 'Lb&(+F}(eLox:_,Fik,M2hF< endstream endobj 23 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step3-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 29 0 R /BBox [0 0 461 317] /Resources << /XObject << /Im1 30 0 R >>/ProcSet [ /PDF ] >> /Length 34 /Filter /FlateDecode >> stream x+2T0BC] 2RH5Tp Tj endstream endobj 30 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step3-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 31 0 R /BBox [ 0 0 468 324] /Resources << /ProcSet [/PDF/Text] /Font << /F2 32 0 R /F3 33 0 R >> /ExtGState << >> /ColorSpace << /sRGB 34 0 R >> >> /Length 13487 /Filter /FlateDecode >> stream xͲ$q,_mdF3qLBfA 4eA I6y"%~sOa)mǏ27rS@ĥLIJAtN'.qԟ>Dv;/%aiYx/x^돻>_ϻת?~m:KCkzk]\.'˿-ereKTo/zbj|/kXkz=[ C,۪?~mK;`~1iߜbqx~-S5sS jÝ\^/?WpZSnȇw eY.m.8./ꇟX2%%z<]^~Ç~x߰.q~~g~AY-27xPf[Sj-c]n/#Dw =>QBmgT[c^S`7-鸝w4v6sPr_o܎K6C?b&ZVo\r2dò#:O8ǔݢqME86Yt櫭ɮ ;C.b۬/ev~.UDU˾|97[WLO&qJ|;W[EΫf̼~削9lYDh}\qM_Og?|e5攝b3e@7#f6׫xl]HPLlYlݩjbg7[oiro83er<|3fH+k>^jQf|!+جf&dV˧f&h˧>Rfuof&tS3rƋoCg2'9؎g3?YlRo5=^K9!jfBv;Q|L Tq߀ȏ۟ʕo&f~n+e]uY~^bfr[%OL/u^JfdJYEWr<[LJ)6Sviϻu)Wbwze{U>RĴ +kSgٙ(6 9OefLr I??99p9oKv%[%[-6kA⫸ V-ےblI]l\}]T7Y_W-[I.6n)W|tL'Idp Wu9l]`3{Nʪ*kU]l]G=9_u/6cSgh2j9Fg3d-ގظ [I9kB_lTv{Nb:ۓsn?NTdrg0mn;bndzں|&Wױ-v'tu{=YCM/&Wd*vu{j)UVCU^䷚PŮJzUϲfU$ࡪwU7SUޗͷUVCU.r_AWuPU]9T$kšC'TUtۨnU/rGު{~P*[mNZRzlVoP.EG:'gF]Vv{.n*>ihg~&[UizYavixr?RՋȆ=ssz籟?VP]U&*WwUe~߿۸z^j?ۻUNu.&[9QLr*v?)y?6;bˬW9~βr{8iUOwr{6)"=%A~~Ej輟3y7yPgPygov&[ OW[ >u n%6d\9e'Y =uηǝAZmSo{P]SG ^n*:p<{-}qN9iWԱ]v]NqNw;~.C(6YՓ=8ٽf+f+nRپks;z&[~yz{UWO\v_\lZ~v.Ι~βmgi39de:TU*rUYA|O֊LMvdkϢewY=`=~n-y~Oek%϶ڬsf9ia?͖}~W954Y;r3dzʴgST~?rU'~?u$g3c|*V"wJ).oQMv:MN[MVdCUM~VʌwӪ.r7yϽi2yyd-3TZp#\7,N6QU!lt?s"C~붙G紐}y_5~tFp0qQWIcq:YV }wMmc|]TeOqxi:y@M3BMz;^e`̄<>x4Of̄7fH*>&d>FAtFxXL0L;B`(,W.!?qiFq Y~ծ -'T-!˯U0ReY@ReT8Re O Ll)瀟2@<,ZJx%dZ J] OBv NM7'QO`O ' N 4ݖ%H( GB$ I{|H4<^eXTX!!LU UִN8J8=yxr4`~hO2=B/Bu*;@UGϟjFϏ0k ͚zz܌4bI+4bI-485i@4$ɚ1D3hF'#Q5aLG &;  &k N@<<ٔ 1'o0QeG@4f!5`qT١2tW40F18bz 3:#r@<5،4i'xF|H D35:;2;idУ$ZFd UNv# ^  zIEpbMhY(@ 4C d@Ё@? ь<,E@y KN6J$K,UvLF R*;d̈*"CDA,+hƒsst< 32/g=H&{ P*;~#8'pOသ<yL~e@:a8 @B\a@q` Bv?6!|$A4? <'9dWAQ0 :@O;xUv  UU6A! p#9 H4yIk;|pO2ddW@4ɼ_$'MdA X0Ds :Y| oD qj CxҔ' OzrIC:ٽB'-/:ٔ`3@1n"@CB|hCU5!TsH~&Qa(U|T 0@|T>N@=TP~2 BNhFq"IʀY޷ Xe!!UDȲTQe@a!ˢDȲ(Qe@=a,D}Y% P?!dY~x@qI !'pW#@,UD%JP*!Ĺjna'1@=,UCȉApux@ԡʀoqnu2Bƒ !'^T#@2$ʀdY  !2A_e$ t ,P@ !W Uv@ >N,, UBnA@e d])tB%#W#*xO)B5BȮ@脐^p!'NT#!$$aO'*vNq: @ *: @'`B* *`T2B*:!dW"HBȉ7A(GI2@Bv!dpUAA|q>YdN܄Q~A]˂0 X>ٕ|Pe@ V-9qn  BΗf܄8S؂0ŭe !X"_a%@AȦ(p$ԍO9Q!˒W/ك 2 tq > r FQU'@<] B屇LȀ'C( Pe @P r!'T# lv1d@ 6i5d@ȉ!Wtp!B66QZ 0UN5yl#S`k@?t1} ,U}s4q5~)0M1[CNثka@k?d:[ M~G !'$P5.&F !b\?8l9q71lq~ ĵ'h{ @8@,U9#! @)1?L kD5y~ ZCV_e܃TCv6jrma$ϔUCvE3j2ʇo>>dYJ24R[}>dWV0j]ɋZCv%/jK^hټæCvOojt9_4 jtٜF3C6=dU#j^9_]CNyQPYy=dW '4?dېNàtHM=̉0lS=!=dWX*v96*CCzI3 !b/&s4WCv"j2àZC6'D1O8Ãvr ̽Y?% >hHԐ{!/ү uAK;-UuF^,0We!Ok5c")@|=̈k>dY m[=-A[>d>Cz{jC| !И {O4<~ϵ4Bk |ߴgq<@0Uv7$8@Ȳ@+I dH@ @|":gP~L(2 BvC}} 0F8xLz q;3B0Fq`7ʀ8>]I:2'YbГ,@Pe*<fGwpB2XOjߠa j z-VQ0&zԃc!=B,_.=,"'Oٕ!n!nfdP&)BvLVVЄ‡ 'O9$6{ Xx !3f!˒xrYec;A3 '*;ӣ4#] WF88|Qeq`nT{rG eʀ-UK78|+<[Gt` CN;ȝW8Ȟy`xq>ɖ@PxwT !r4?B_ 8eQe@t,UGȲ[en,AUFȦd(~ʀ\mUFȲZe8fTA3pͨfۅf` ٕ@!a4ދ =y$wv/ʓ(0rN4U$ݨFag` :|r8}aY pޓ|MA>|xC` $dW1!dKz=&$dWԁ&!{TaB0zTA0NTA N,&^yɂGs">HȮ *P%a^d&`;XXjXMY&!`k9X]Q&!$LBEɐ]&!=C&TIȲXe@lΧ"$ds$!r^?܃,KtUHȲVelz)R$dW#xHI +&$dW# H|V !ABv1Bcٕ$ aGa-A>Bo|,΃2B86G *G@'mRe=E`H4b~9#>T]#xH9v2x 2f<0O3<0O4NdGxQ;vӇ4cDX c/,B1LJq?MָNvL @>#z>|F#%! @D<'ef(#':>a8hQ=H1 {dIz5II#:YڛaHO 8dwC#Ȝ%4iO8c`3=jF{cr#Gc`<>Gzӑ5#0&{쑾kGG<3z{Ԍ4g7#=dW~=GaHb5CꌞjFRg|VgJMأNVe&kQ's0J8KtjpϣFu Dz-ȏ]C x";s-W7|p䇬GJ0d!!|NKpJ@4z'bk`~PTd=ɎO6 Nv_JvRv +=l T><Si\_eӨVNC xn 0c dXe#M@ -!@}.]>N j2|4ɮ /n$ga#O cҘNNF1=ytxxz>ɑ|3(- $d#c$ḊAe)*kFTTf/L_/krT=*kFTIs?@iO$̇24_f f5 _2} e5B2?Y3@:|I<5g j8BuTe T6PLAe:TAeOT6@ePr{y;B}rK wgx)\4]O(iUR0rE@Ae,U1ȈA>4||3{|3\aOg$ # r >F= d ɪ H] H&{$Lǚ1ciX''ΎV#x[<| <ž4iOy <$OI|,LuČUc a3 ӘN@*{& PyQŚBQm5NV;*p`zs8NV;&+d r~;C|*5ü  jv5خA jd d.]3@q5k0v dW2ٗ:K{ʡFqu؁@4t]9 2Z©Fɼ:@f<2 Ȭ&{8̜cA 5YMp,Dñ0X8s V5gd@f= 2WMhNvg1amch' YjVxY< '!VȬC= [㪪 `NN GP8*T:ˀjM ?r6q`SaMU# djr FefR05 d=* (ɾyʡ(q2 !eoTT= P@<* 9JN6S jgd dwT_$^ĩr F$*8ZPN'3#sq7oh? o <D~ɮ( qz 17) #O@&ktM''O5Ԁ'ԄlNƆ9 'i6Ԅj6/ Uчa22әY&=_pӧ-f1ƀ'y}uF46f0& x҈NV&;l Ʃ1(Mր(gB ؘNvP .\qƤ1e Db:y Z3ҀA ؘAx&4L&8 Id:yL30A1kL'2dC0`2MؘN~o4 63z݌46fIda20d@4Lf0d3t{}8 3t*5YCI:?ɪDM:Y=;Yؚ1!M@N61Btz"7Y<:ٔd dUdPMЌNVϲ&kF;Y})zݗAc>S7;9#׮ߌ\>z4jdӠ]5H$ɼg85^`@O:#Dt+n^ ЁNv/_,HF &kd@'BI&k `l?^Oc = :ٕp4Ycp n @f~?Tс~?>gFcBU9?7ߊZӷ7a:|f>>iۿֽ}˰-5o7g~leQvH_U;ek?ß6|Fl6?7*;+BύVѨ|Lm^/Djtzi&fFWYhzU봯84z ֨FeLu)B[FYoT.#r~eto=p;0^^w>Ϙό.>$~^Z{iYzً*}<?(2wҳҰ}b?ZnO/O^p{78]?por'2uyۖ}!7W)ֿ>?}O|{~[/ _O_~h<}Ww/rx7og?̏ endstream endobj 36 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 39 0 obj << /Length 2003 /Filter /FlateDecode >> stream x]ܶ~h/-%CAAkNU>|r+j}w8pfD7FRĒ<Aܼ,w=7hD]w7ﶶpq[JvD,p%m30nRa#Po~Od4dAqhϾ~ gqN1T̗Mװ㴀Bfڄ;ɨTFXS"&9נxc Q#R,b՘ŋZm`Eڮ^;L)pLܙk?CDr 1\6"aAݖ@Yp13SA6֝~j[ߕg)YZ*9\ %C5Q F#׈)7^lMaKRgΑED;L+S&IV^!bYhŻoI虩5ɖق6Ssm U(.vKq@LŀCuʸ;rw~@rW:(L]~͟zT$Vxw29̹HT$2\CpmϤzs}*g7U<5P4n:CCL%]ʸC#Z`m-aLЩJEL/9y/Q89CjŸ ;R% 8_lHvc^7ݽFP,DDwo]^' G weaߧ8cL2`ˡOkÚ*z50dek2 #(?y},,X6tCrnHW[RJ)Ta+D32)3'jYWVSjۿ ZZfVF}%/$~"0&0_]K]\-t8vk)-嵧͋lIVH04ۏJQZ@6}Y?C]a,WN7g3ѺyzWhsȮ Fdg\9NCLqq Zq.,I7_KdjfpjMHwFhFNX 0VMTģ2pfCrvH"AA8IӼ6mmMSiv" 3%bNMc'iMUvf5N =(ęfHZ {c/^F/~h a1 gbRN&Cco<Ϡ ŗOl훈6? j-T'Y]ȅ 9?ѧNWRjXS}wQsozBwF t/W8ɽ?/t{&|i'3#W4)>/ProcSet [ /PDF ] >> /Length 37 /Filter /FlateDecode >> stream x+2T0BC]C#]#C\.}\C|@._F endstream endobj 42 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step3-2.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 43 0 R /BBox [ 0 0 468 324] /Resources << /ProcSet [/PDF/Text] /Font << /F2 44 0 R /F3 45 0 R >> /ExtGState << >> /ColorSpace << /sRGB 46 0 R >> >> /Length 1434 /Filter /FlateDecode >> stream xYMo7Q>WMmF@I6b' JvV=2fič~BI?P>+Ζݫo?MGJߛ˻.?_T$X:V[qZSۉN,VW'a+9c.ެW.9eLAho * GmpUn:NZ;.bYTa}ZK ԂN[2ĺbAmTK+ V&cStj NRՖfXMO 9oQ̅F\ s Z$߻MrhO~}X-[jjr,SʒA<[MoV36yz!ش1kdHm2;x\mOd2x[3(]`x.2<`0q1<9&"K|AJՁQ|>(RrUgSRdP^&2E~Qh_l..+_]]ɠU4B _irTX3j( 8ꐘ:KH2cM-#qe6B(ōTϺYnXf}9j{b'%!"\ErHXD.7 y?JGXor/澚]Nz57өdZRsT߉b5>RsG N 7=?&=9ܐ قbO&lcg41i $1UȯD*'I%"Dfa#˜Lif4ezNmf[J#{JARtRbhni@v'zb0/tӾ? pwWz "ZQЇ?; endstream endobj 48 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 53 0 obj << /Length 1665 /Filter /FlateDecode >> stream xX[6 ~?@_DeZtZ [KfٽQAru+ЗHDȏd˻,?YӌdQʪpJ_늄x?bD1f˸$zSh+` 7+̱Ī!kJB#P(Be]cI\2}N]wh=8O][?׶܅6.NOwM7A(1:i0ѝ ^x$1PKK`ʄ  fo:EԍH}7\=u-=YxSVfԭ<.fq~ġFt+[o*J[dbU7: ]\Ex!Ek͵S4xURnʎoBz%TQ"㸹f䉄Z܃__$G w{ܲ pAǑA}7u J u endstream endobj 49 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 55 0 R /BBox [0 0 446 304] /Resources << /XObject << /Im1 56 0 R >>/ProcSet [ /PDF ] >> /Length 36 /Filter /FlateDecode >> stream x+2T0BC]C# TH5Tp `M endstream endobj 56 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 57 0 R /BBox [ 0 0 468 324] /Resources << /ProcSet [/PDF/Text] /Font << /F2 58 0 R /F3 59 0 R >> /ExtGState << >> /ColorSpace << /sRGB 60 0 R >> >> /Length 22531 /Filter /FlateDecode >> stream xM5&_qU&#a@6`K3^ QWnIۿ̼'xO*բ[q"d2`|1"[x?m{߶ ٺ?}/yǸ7mo1^~o?_/GAGcaǿoaMȋ>[={oyo^=_пoV]x.`wy˰w^xk[y =}^pyoß{D] rd6ȸw+eJM+e)#O-Y)xOf@ʔr !{v"{>M`H(W5"eKo y?\x>g>q{gWx/L|i+ݶCw]{~z> {h 7YO#O{:| :r+Y|hv)i+.L;-E(.}тTs#4fž<΍T㽥:7Ǜ 7Փ.OE_#ǛjwBY_Ə[.ҙ/40v?18}񝊢ī}sj^4>}7n'ճ.2[KG_I$g}ionƍi_Ə{G]? T=oƍy_'!4,:7~)|3~='+Nrt.螜/e#4iOO)_J=Ot"Nәx?{ߥyOuݳ._T=!I"/\ąͺŎ.b2'xp}vz]\Il>qedЪ$nQ]ڿ2qFyf{MWٖPh:PXtK ض<1I 'FBl>q h!||v+\wi (H)x'x>;_C/g[oom{?ǿ~OMu6z}y4.>;䳰O_ӗ;a_hcxW |EwDmLXco2vg]_40ӮNv-ެ^s7_,wE6^]7{o|y՝}HnOQyCɪ[+kyoB}zh/q1} ;3{gq,F1?,kv;u> 1.RsR)G,9,!`l=Ǖ!,Ųr$k lPk޶Rt8l sVbK/hT8VL"(A)>̛W jf27þjM>|$o]fJk/Ʒs̐Je^zK8v!Y cww^ p}N]'b~are ǀ1wXǶwD W eGb+x#ugLp1ʥo-O!]O,սo&pu?.Նy[3 ;ϛ,IXBO4]0t΋?6;N,2b@y =~ńzAXp<}=H Q䊴%X{0s=f!/xbɍQxx{|Fh]䫯F.2 |&Z{l6q\_8JǼ 3^ǁ힄ڙ:7@:&,iqK(|.WXvNW+ܧy8yl@}GYj唲:]"+̟Bmc!0e +dr_ܗ .@ɵz>ݗdY2ujkpfE =YkAkwULZɭASVO̼f8XLZרE+{0o0[J{1~aWڵd.庴,EfxhAML:"v]ZFUwOa0|ƿo f"(R<;RXBA ˄cliXõ½v.,-[|%`?*ii#KYIFNR:?ϴ <~r;Y jmsq"$v|ᔽ.:l+z緥}[^eIM E ._Ad5diq]EX}nkVlHnZ a8M~}%kK'+l2|i\P:׉{2 > _;pM=ey,h78}J]n%c5&$\Qwp}qؚ2GA0,{\;C)EVK!т:~ +AsTםV$9">` Q^/b Kkʀpdz Q\[UQ' |4@++tx2 }e| q1xéĹdlqʆ׮r.DAkb\bv/^+УIZejl&:fU W K{e̯l&d6!c]Qg3ߨF`4jrҕsW~ <ַ#n+YF2lr׼ *aA">wZN[9CcW@]u=*(D.r_قM^}^jc6#cΣaVIKDN\ ~aʼnvfW'l4'lځ O_mar縕ޖ7vphD Su: }Ѡ*Γ݄ݘnof̐WBǍչZ+Fy,Ex:x| '* Rݪ4rl4\^b,bXOv4l4!s Ȃrc(/ްZYaCU|0v۸KkJsU#{#J*q$ir**Jo?BZp0 wg-0™NIy׉1n s%U73aC* a|Wի5ƒ~-uD! '¡*\ig;KUHF1f5Op3XOX`-+8n0|fe3K¤QJ^:)2''hpS2C41$e;oʔ&@L@.Ss|qK!|+=߉N>`WתBM8rݞgoϪ0oq}& 6qfE%O;\H _װiP^ƣߧX@+gNSbk՞:W{~uz,cܓoz6Np;u3_6j|<_:i;oQvă.l/YEMxo/|~-|d[c• ӓ8vȶ SJ … &>Fmsr‘DfDngnlE(ToFW81NKf$~8~aW=l ^z i_ew 7?ρ*hRNvo5^'?߇5'>[iA73*j6ߙ90 }=_(n|gІQN+]6 7Ҕ[75Y@5/kV~l=VsyQYGM`ps|ڏn7X0?H|>/*?}93Nl/$>=ʳ;\؟F~|y;z؆as>OU^6?3|?#(Og揩:V™ếiaat>&VoB}A.\>cSQ o|[ي%Αȿ4?H(ZkӔOwXǮJqJbJ9^6bf/a( wȋovK5K̰D -#XTOO |GR :Qφ g˄O~1Wef;<W3q&{"ܵ{?Ōl߷Ni,wBfϷbƒdk:M#@kB.߬z/+ܦ%`n'\-H<gAȿh%U\P}y`Y+L׻|w^|TGEG }wѾ_#y.V.Uq=x0 5rT]0yRa S4A3 'OH+6™M>&Uv5<l w~/HR^Mywѷi' ~Ԟ"s :ja>:ߪ^N9z_Yʓ1UMR]*FWD;}G-1T sDo L~/ f`T_;a'>[GBO`M$:)';1'؞2ҿOBT8ݴi@y s@Ʌ8&N0B\m 5?lIǡh'%4`*İ OO GO>=#OF4^Ҋ5ZXFKNd<0vIhL`h 0^&IwMhQ~}ǿqfM,uiX"G te)Wh"B }8;I=#SxT sIdKCTPҀZ!oH ,)f `r(O K ]0XyA˩0Qtpe,$Rlg )Sΐt"+SxΐB!uL9gH`tN!ΐ07 A_TgHܜ3)INMĥ0/xUrX; OJWj&BhO/aAF Qr Okߊq)y߾<_}}(UM]6>iat5ZfۀxҞm2Ehf˟k!GzvB{|Z#mȒ`mӛU0qhZ_F]%(RSW 2wie&QOgۀHvu\J{˰Qˮ Gfe;_G^+A(턢~VRmȐ:Y >;o"e.=ϋ̺_LR~ߘ2 `uų*_7ZػfۀHзHA{ _w/2)Pc®'FT|„ض=_`6&MGHI{ DV. 6/m;qt;ū%PiB|z/I ?l7I~qۻٿp+FYBoN_ƹ% |EuҊ ζ nɿWҞwow ^ނw!DB]#R6Y|Joe['-6 >}+~qۻ&EPR'\AFM7.+|7Z6_M"l־R]dTalme?_M4#c hSZ6_lr"zt OkߊvqčWB/wHrT$b4?̷gb?iSm/o블oCqZ2n}-P~_I \B쇩"}džο] 258p5?*ie'0϶܋ַHA{K;)8@x:S ?q*^*BhO/(OZ϶7_fߊ3@{頍|>ο HQ즙i;oI)?D݊sYWZ<F\ٷu\6)S/phDf2*oA dm;hCm)S[ߊ#˸MשW=W:5 DJnӃٻt?N M=A`ehk־RM?(S=~o)eI^b22< 2 ي_:.rMhQ븺iFǸ`cԧ~za8A dAlLFڶI-\e6l^ǥqJ=q*_S* 2ɲ?()-!ͧ/[mB&nϑ|ATd{H88U) mXbEv2;[mi&t`Cp+$w^@[ܫUP | 2{Ͽg\k\_`/HI_ :7ȄH'>YsG_/6Rݾ8Sg}]T}]?bγǛ xwBY_Ə= TM'Ӿ΍OCXun Y_&X}3~=;\HXS,ttO=;_{r\Tݟ2FK':ތYwiߗھQ9{?0Is''rϵIzmSnvNY=ENtoMY/t*Y_[8Wژ4۸Rv<;b|5L1 ~E߼kݾǼn]e>}츸@, jbMJvKܬL* NE^J]+zl q^XE؂z7#oݮd܅5';.%AWPFNfU娚#TsJfGYS{e$4y/av?KN/Oft;ys#mDXŜTdH> 3`td 9',{s_6ޱ77adea"-bODrPs8IԑQ-QuFxs"e^XZ-εc$}5!D'+jn_ݯޑf;q83/:_:ڶ=U6ːP-8_:b{xn}q( yx_.'s̐-k4sGfb"Gjt9((%zz3<;]}3\]7!7;2 M0qOBH7$FL.b3{"q-n~+$Yƀny -]v[HȮ uE5T9D3L2M v(q&^-ă8VK@s XHLGֻFp.2NO$q_g'5:hn* aޞ=䟄9].RcäQWX6 sUEY{HYPĝI`ֿWW<֕"m {_K$ԭ dBbtE) =θ&]|q$fa\wo&̰x3I1|Op˒ojQ;LWr"SJgm̨|l2֋3G՚ʔiv]&r-8bYwJ8/𻍣~pϴ.DIxZ:2\ʼna7HrH[+0 7k? +然JuR1T|[m܄&xVv766VV<`aQ CDH'_j}iuX*ea˅{$VP(qRe|ς|: y!F3kOl!W 2Y *rZqj Àl_Bԡ]}'!8,w4={,; yTCHHRkGfk݅RȨNL{9ʮ ,Xe_cY|o||U4U$*Dk+5>QxJ|N6풘 wV)qzY`a?2+YKn3U?Fmȶp_C"\jr扺T(G&,ڼ_eJ rO %UAоdvh_BNՄ!#Bδ y }{i>z!ma+G&+=b# / SrX%A@vsm+YwYڗFc5ߒfxsq{Ef-ƾfA; j\,J|ەੋ-v"9>p&u/2C T|)&+!9A}ѹ.k F9( |%%٣,H %jLp0ֵ6-R\/+;\G9vȢU{zƏnD++!wX ^"E-ɵE|jC0PG_ HδZyRW9 JƜВ:uiA: Fȃ~A߁/ُ3^}dqFr.vWԈF !JWԩǪЫtw֘\gޱv'5VvA6]htxݿpLD|&oG&:/5ͪ lVwf zW̦Y7 j[g3Ko|Mˠ:j24/qߓ9+D`_ny*+m}&sˀ3EPSW{z%cީ@1õ Wxfi5qa^Y!Ϯ!`՝cGndCږ,.,NCe)\p$jcȵ= ,HZtxbSoh[j$'[XiEپsM͔v2 N$ɼbѭ/iXGe|KA Gl?{58⪍vLkvxbw\K_^`p]?xboclf)myc!ur-W4d- R>FhAᕣrcESbcgXyOxbMP+(S\J35B`\FI͌aq$Y0@feԡ1[`%ڴx)g'Bbńf1Èb;<]`xi ,^;IV|5ҹ`ra#VZũdMQ햨I#5J eqsE-y|h;,j#0+ϳ8iQ5FZbOp<"jpP8lW8*\ nN_gqQQū%w,\~'806a{YX.{7+ÁϧpdZ2OCE l}x^Q+<8瓵'cŤ)7q'^hI LzKNY)Q ?權%SfJ5eݬŧ5BˬNY=ٿgVcMj̶> Gd-T6dnxlYn𠩄1S%Z7/hf U';X ŊW3/Ӳi!A_7z'O=֬l,%fd ,ΛdU [>,.xjCYY/aaqRu>4+>C%/lcW Ltzq'p?m>Րuq&ë\x)\dm< Tl<_W8 nul]!}S~'Yua0P*00 bu[DGQ|y -V,|>-ly&z<ˉ#+ ߦ3۬گpaxpS8. |ϔ7)#;z3Cߴ_]˪pxx~gJ9pe85m_T}7-xP_7T6__A-QeX}`b󭐿h&oj0 /C(#؞^'JGӜK~$6LF0'o1{=17nbvaCl/a$'7% 5P1GR~$ S4`m^`rn 33#X{^-__TXp1 '>n^T>4$[l U_l<]l5ao~*\r9^r}xݜK}@p!~X%~9aU0.Wշ<ԿU7uqT[jaij{T/0ݞtQ^W{M MgUMӪ=L^>ߛ>pTxLWc…=}^M[ZIa엮AeW^]J}W)nwf6&?MH?0^)elo5~_™.G,k-/ a7xwiүpf 1V >;Q5& ,y;'4 DR7`{bK2OHXN8`{"QŘO=q]>)x6>kwJk~C#ԙxldg:H\Z,' 0O>?AxBep>qp|4ҧ^_/0GXW_Kjܕ:~ 0!yq8' y(%z97aJec]Rx۷?vK?4ng?jhǪҽ&&MRrdg0:o#Ddž<{RJ.~(W]& cI80nz&(JΗfN1(HYDAt(: ŽȼK;1{TZR`B vi|!K;gIgH8y$f:WciJ6CLdr̐*4C5R3*A UݐR32,,_ 덠}3b}M&0YNVmϊeg6 >}+~qۻ056¤kU NoQoҶ(TmT;ᄬ2n^Gqۻ[X}KEm'5W:V2{/0bNڌvu׭o2븭no !=~[fDCWo}*C_iXEj6 >}+^ǥqۻ id78BGT@V7` N0>>Z& FsYZe83]+ 䤍HgۀL블oJ 2%MM^bMmVKi62b +&2c@pڷ2>Ē5iBI mBI߆#y&F/jPĿK Q>8'Bh۞ Y5F;`[:.=iJSި5Jyd2ulxڶ &ma 蛎}9FV XZJOUnXBgXB'lcg6+Mlu:|oEse#|<*UҎ"BZoW]37x%qYe֥Ź7噯s_sjyſؾ-)׏MisnhMUs˳xaÖ?t-ͳ~-~7~-~թ9<_WH?@`mtsjhϩ9'7 .aFsFܲHǯ*[xul49<e?g? zZi -~N-q/9a5*SW|E'x·x'| aZ{9ܿb_Q7|f.m(X[x ú{ieǿ6%MRpֵbJ7-\= [z\'>r}Jn'8-8do%\Ȗkw3&@ũx՞ |)q v ^7K}쑀A3IHXT]nWʗ"H}!iݔ:g+X K}m3Z3w8|>$9ƩU oFq/׵*"(Tת[0nd.gpEm?3qz|"ZSBgyGWߩcU9/꬯Zr]z% 1i/DX 0[D`->R<:^ǒ٤y;~5OH$9_)98!24"sx׽+ZqR<w0\Zø'Բ[X7Â8:D._w}^,\-VjJ \.>mq>Uږ&.gu@_ |>#DSޖ(? Fױ9&5tO6AQw߯5ǒI+~$(f1߸F;,Z3.*. B(xk_@b_c~VE_ǟ*5[p!,eJm^=t酒y9ndKFتc Wk)ju26Fqb9~J{r @xE(p_3UԷ3*ް`joX&փT!ZMgz +NԽ5$KxkQΕ͗YWktpV7jlv.$t[KY7WFTu)".:y󼻚J"v)#yb #l <½/:+#˹>:[.J)݂V9}{R8ת!.2p~QjǞ"Z??P'y,l]Ա}ٍ9ZZ/Ʌb"޾Wd 2oK%|=GD]BM<E M|"oseVg%n+|AeItޡ~yy>#,GoyY}n}\뻫u|#8v95)3 ¼ rZ[WJ?%^oa_zel¾7nHsS'Ⱦ`θ؊S$i-Î7*/uS3oEP߶p_9c: |г(z[zFފ,K^&֘Cd7ve,gEE_G6q#BW:=m,Hә;!;Vo+vIᮟ`%\weiYDz:Sqn^肻ZYu%#Vv\"Kv"kNvB}qqNgX2fXpwW|_KBiu?7+,x䢲!t_Wõ.lk8gcn@d xzmX-!x߮[5`^{}b|*4f._ۈDWLnIdIdk` JIGCQ( }6o޶׭uȂ>Үa%{"kaF&W> Xr\^L}IO֕}F\6#GRmk ބ [ÍK/EU߶izo=kl S ^RTl[@82^q-Xj6iM}oR 5Qr!oDYBcoVmE% VX"-UkMXŻI`q]UߗY՝NO]4}l%.dݔAv n:h j^f0v~=,c`[XHӷdTƒn,[9M z|vX -,c[]٭t dy!>/\o9} Z>)E%H5 yBFc|.]7VݿUwD<Q]t?B'p]ڷ Pc:nkCqbL&|) &`yLdTÊXr Dz./`ލlZvZ="Zyzɒ!DMlYX{^f!l~fuhH^0ZY_n+hD\%爫ȇ}+Y u!e3LAK lt(d |&8fβ"t]uв(ȣi z境$˼;2h߷",)E]ueH_̢O0uvx U/pYְbueV;#(>7yKʐ3gyf3`2Y=]h|adn {Vl &4ćNQDyn AH؆{e+â2Nf7(ZU[ɲ̸حлD3 DfpFD$ ?kUw\_YZQ#Hc55Дwh\0O0bZvVqL+ZNhj0fUk!2f+ZF3@hV+ Ek)[;* &QdU#Ffy`;TxbF0jw<1vdf7B#Igz=s>jV[a xkk}mO'4z{(m[T<#$yjH8jYt H_QZwYW݊^PB\Q7eVѝWU/ \NKa9 GSR磨H!i>J|hRm00V;|gj~u>JjQ-:D!ṗH_V ~lG!>XK6!V`*IZݰ(nt~ŕw+JTްѝjh{qrh WoZlj}{#g](#][[%`EcXNcWԈe8PPlU X\'όn-%0,]EnjcXFNc=ʼWEQҀ"DkoM+&4JGZ}w QUV=m:֣{fGa yC=€rF>eXPj%ݙT\$(C GDSҝj4?N?'Q* Rjs?R0,juV'hj֧bmx;ՆalqR1#F07V'ht,ŎB3J216<НjG9C`ȡ|Tmbz|N~TWPttIjD} ;ZFܙqWhDO:kH"Otfi^C6kU>5ENc‹p748?.?mJћ'4L ,Jg@YcL:XFj#s҂L7HqbqU{T~@VHC*kX)hSҝj7e6&T2l=&{Ca0:Pm)t,Y]T oױ˭k(iGs 9U ko@ YMb9>ʋҦt^6mEh4VX8@oz*JNsJ6`+FG LΩ?l*N6ҝjQ g` 8̖4 V0y[t,?`^Ck5*ڧb^i&`Sd~~hEqِPX IdXXcQ:LB %AZa}*)&_α7X<]?(Ru$!5 qt0.[y !y:y|?Ʀ X|<ậbY+Wf\]g0)4YM tj[^DDخn¡#1x}/=oA\?w?~ endstream endobj 62 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 69 0 obj << /Length 303 /Filter /FlateDecode >> stream x]K0+fi.E'z'Pjm0+M :T $=yB׈ĕAJS,s([(&:C1nM¥Ew~/ɨE˔2c끀BQt2%rEP3KdetAiv=hK?Š[;Tb1Vj7u/ojm@X q UΨUTmlߴ!g#S9HOk0gd0?'5x`bA$$I>/ProcSet [ /PDF ] >> /Length 36 /Filter /FlateDecode >> stream x+2T0BC]C# TH5Tp `M endstream endobj 72 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-2.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 73 0 R /BBox [ 0 0 468 324] /Resources << /ProcSet [/PDF/Text] /Font << /F2 74 0 R /F3 75 0 R >> /ExtGState << >> /ColorSpace << /sRGB 76 0 R >> >> /Length 15955 /Filter /FlateDecode >> stream x}ˎe;rݼ"In>nA2 nIʐ)KݒoZA}rSUjbhpn'`0X/_?~9h/^b~~o/^RO,'t}w/7/?8\<ͯ^-^~~~?|OZxE~R/j?^S|?|?~ʳq~r>^Rxh|j嵿 ¿dcn.93{VvAi1^vAPM8c:q^@_nWw1巷v][N$/}6f;I^G|'ywWE/^K` ϱ]1an%o/N٭Q%UkbgkI {)oo=~rᪿPzTo/N13_{y//wFd˫/Fqt:>6'z QwЃ3>EK'~11.8_c/'~ C]Ʃ~bzIk̶6%Am^뇙sGa^ۣ{ul_Lr/H_3׳ _- җ_!|/_uwp] Y,06^:Q }Eu#ﺍM O?4뗩7ן~_|lT3T ?oW:KzM'L?t˻nCP6f܍F50gzʯ2*8{o*ӮBrxͮzmve0m9gl Ӡ(sΆ69g+Vbߪ2U>2-=~!y3j Qi`cުr@ژl|VlsNTPgb-*JqSGʔYOw­&szAK̰)v~sf@sev'XߌƂ%xB@ S=b;XϲM%ϑ :X1fa#*^5x1W2ʸaJ+fM "2,f`&T=* ?sOk!Fg!`s&|s #zFn4>)»14eTW[?)U; ͚X04Eib)aBQ ;g4+Y(LA̩5})bfGQhu͠?\f-ԷA 03kԸSZ[@]ĝE=,XE zWUqnM1?5:'h[W5Mn9Lͷbf}p 8K2HtRV>[Ү;粩©)6{]pq94̭PƉڅT[dMO{%[#XJqG:,LM԰U|YUL T Rz2U"o[ 3wZ@9-l84q4LǘTv*'/զ`qYvw@Eef{> @E)@ Pn]CͲ}7ʦp>ZsΕHت*BZ)i'!sbBV5n\jTL Tf fv@ejXQ0?'kV!&sfg|~|f8ֽL}+v X~ڄ$V/ʣ$Ke(Mm}f!2nJߚ֬&wF +º>R2 Ϧ̶oKM4I0-fd2 f5W؜A)P\J)IJ3:7z^^ơ@PKxU: $syעvxfs,F\cIRPaf-|S)Tbt6,V؁s[1 4p׾E;ӅԪ3sۿT&CB)t^2Ľm+@UuOauڢANwv/Jണ9L žvM\ENQa7_CXm(TĬoJ &c!3/Fj4Q(<2SNdC_%.|CY;9u/B؁balDت(&@#ɆUG4(%TܜRThj:&]ٮ M N%X&Z 6Tgx+0gDZb+6Meb"{ =!wٽ `cO'\uIuY],ܸOnDF?{WC}{/2fEm*#]婪 ᮪vgm1^(Ffzݕ|H|PO&j*\yw}< ̩ݔS4AcXN-fRa[)[.{UyYb&BkBEuovi|SgOJ&p.z8'SD'bGrnU>Z' w],aʻI:*og!=G҉&W);û$goLr`1<#nq%kX7?YlG)TSgѱ+O\fN oh#*u _7ա߇Jj|m ;Z^gTaԾҳޔ"Z`@7AQФ8d@Pmwx} HQ+{z~MSGv޾3㖥B3J2+c.I~B$v~Q2Mބ<^hi02M0CI%>a$f?)rfYɝvYړ؞]J^Mi Gi$۟qBT_\h}:5>/_d[/1Xzk7'~ C]O֑3MQZ7Fiۢ2-J+7Ei߅xųFlDǷ_DFi‚0#)^~A3/p/.~18Ɗfğ<ϲw8ؿ6˹Nޣy=a9Vca. :l]#0kؠEsz?za?~wST_ z?W|%3Roόٵ;Iυpù=:8xEϩiNݏv~IgxP3D`bf켍~!/ܶ01Zm8mCG Wof-ְq-hvn؊3]-b;[lsn1 s|~m1;-6c/kݿZMڦź5ԥŰ[14jVfϙvMpΎ@Ou{i%yBT8oU6(ڿ.^oݝf"UV9]^F Y*|r{]jYSSV4mӁcGl^R,)vWW٤k~{oI{,R>,CmS7ֶ+?S({)P&_5&,E.ܬ"JA!RʱQ.^P5Rܼ<Ze۞r9Un%)]RQʋ)MwD-.J''J+?À]X6S_ nU6)^[R^ ޮ)YmɛKR𽄀)_{J1uyq+q o{W..\[)p]Rf3eFj{YK)| j?ppn* 6d"f o{WW]2݀O횂P g-=xBו7ضl o{WW]pd *)5c۞lYݿ#1<EP6)L͋]6\"^|>aSͷk kXȶ3Nxʺ޼NlzLrV3v٠koI{{եpaYz`2-,Sml$t>,^US`LoleZo{~YWW]2K0e}n e=ޛ^yIƕ;)Ӳ^6Nuʽ?nS[ڭ_L +X%r%'IEL+jyzq3"ܫ.:73rײ2I-O8'uElSm6/b8v٠V/\}2KHlcLTgK %A~dwSKˮVڼA>Ƿ=rޫg] RU_8@*RKÔu*,wpxCnr>ǙOUU%]RaT=^֖Ԓ3?/^R,)8o,groI{{W{Bh^ 8r+togImKeמmr:ٿ]RmuyrV*JC,r=V\>~RkϛÙ_h;Bܻ@mGۡW٤~rIq\{{.V_Cî4t0>XԮK<y7Yɲ&|yr_M?BXBFXϺ3pt^P Spy;!RlR.ߒ*uqKvv5eL+[6su)/j:))v~&_+K ޫg]Wfwv =+=\ݽuQ.#x:=}+c꼍Լw]|EW52y`HlEKqHzw,K[)ڼpwo{W.'} ܏~^yLGuEGs+žr+xߊW~ax^Wn׆jw_+U=%!8p瓼ww>Km[O-q1߾ <~߈W)^'/+d]/aP^?-79\ \['Y*kwA?Olp/,_#~D??qҏ.6}5ע?0-ע?0-uEsᛉ xuv/j{@?wVϝn-_ϝbsDP?QHCc F@LTDsٺ'fm`hNnC`ZRL:@CV O%20Mp7Oen(f&w으b@6%12vz@a3.{DSX1.`bQ?FLjh9Wa N7T"_7 Y/'f6Hˌ?PG% \;(+~]E"Œ&_rG4&0*P9,z9f > <35XĠ";\kؖW7omBYmg\jb3 \=gbFP;Y% -&K$X⭞mj#0b^v[Ns=EbRFztJqW:fU ␠ |@F,6jT@?ED$8 ʿPRVV 2GGw|OD4PG@gK3Gx ] ? 1GџwMѱcriKp5GuN(@k uٶNQLc4F vx8Qی&@J%ڀ* Llj5 2|maEhCYsfV!ery(PD6MDTa8-Sػ7:oVYODF% U:B+x60%/z\ wN~l pOCڔ{BW@@EN`غ]RGmHC*WI?x5$pc˫S:aZw|!=V0r#D%ILS$kR0=( g~(ZD<|f)L7Y ٠i- nwmpHeQia8*4dtfՔN_C mYE%{JL?TD?-2w}CvA 9oß38u_~L]|6R 3{ 7x:nS[ռp`4өN:x4"_N49Cz:mW}y6Yb'mv s\t=.pqW5q>/:aF*gcj! ~ۚI?<ϝ*>%qk}#qw؃_3?!Mn{JAj_論y8ϫ\|ϩO<^K]aT(p\%k8o(]>1E^FgVW?y7^Uw.`?2Jˀ0tόDiŅ^q<盾KׅK؅W+oBlz(osVQZ~7Fi^-Z2Jkn6?sA"2J  7_sp }Gd'>)GS7V~y;ˁwP^AW1wAX~;a9~ƍߕ^v@?7nP2GE0 >\Vp7P  ΡN : FlFW˿J>tn2lo S8vw :zf = oۆ9vz\輓hxA?=[ bvi1[lřz$.-fth1̸[븶E6'[[<[ķ-{bmٯba{9/E?7,R #džgW|>xj'NE .;mߒN;vMQQ>LBRxCk:ׯ-yQvW>ZWb8Fmmmu8t 5zV~Ek-^B)^]vYh۞r9Un^b1R/a!=A՛qd+?3:Nvj}"[o3E`c P;ѣM'g>IؿF [Cer9UUa*W MizyPRD(v%^xɋNkvo3x^H|~xZGR=|A/^Ʋ])(]vX۞r9U^0&4{tbsEja[+o4q|v(͛ N5x}].ʽE1F/Ng;2n*,sO!zŻ|lPWֽ*^^u>ZJi4>ښq5&P;_af]Tݯ)5xJ.mߒ*Bs4ю t xܦeZ9Lשcc )sdl^h]v۞%UɽX SpdbY>,SB(o̯ŋ)1Y6˙OU4a]xJb66{;9NS({S y{ˎ[߯o{WW]u Dթ]0h"Z|ljpEz`wwI-$wߒ*ɝ6Q hÑiA GroHu绹+*'ִd"W;/pwyܱ.y>ak {2,tn 'brt:upy}|!D?Gk{}9Sz$r|DkdbnDZ%gmnj/+%=B/MZ_ַ=rޫc횂_927fEm||:X)q+v\{~Q~1 s*}\)}A?t ݷf߂~㦎KG\ZȾ<[ SB>.o|yr/եեK]/ *)p<ჽ4ҢV]Z8Sau.)qlކ_X^[R^^ukĦUFh-MqKe_ap_xMjy g4wrԙ+1<~{,xYBo߈ᩝN= {#oۈVv m#~ʽB}m/ؼ5ضlͻR'μ{ _s^ZvJ] tLnw׷v/b>_EշkJf"^ZEe{ζI{Z5ymDebmw* }R-Nվ~yˢrg>l^m^o3E_05%ƾ}wo|B>ݼNNAE.;.^~D?Ï:#9o?|?_37F=fs -'nΒrh_ε>k;C$!q@sq?+u-(@]޾ 9I^PWI>boM>"M>M>M>b櫁˯_[~Z+ע_y0$&9;3Ve yx+'yɯ%r|?\$/x)<_RN\o( Qg!_hxtfl;64ѾCw&_7>K>#| Y4R7-A*v"9ky@"kĜ}fΰoODYx `3Ϛ=.BS![2 죪̖^h80EӺ, ꮚa"V'x Ta04$ ,9KlՆÍ >ndz)|@K9;Ez/'D-j =/ ף gso;#&>]q$vxTHj{-vaCԴxw1]qt%u =Eְ8emN=ցG!^;^\!gF/3!bhݬύgX,wn9UYF|&$,r!7brMt~ ^A>vx` vsyi p#wvi s27o65Wޜ`1;BIoe4>nt0'DK 9lnʋ6֊~j&֜ K[/΅/b?O5r`%ObHUjOf q|K~3 w5{U;(M iȔح)cHMl&8[q?B/qoܚe,/C.jO:du%!Pl(w}0Cs螇/B ~ u@ Ba g?٧EuNSe.'}8*&aWx;yH12[/& Q.Av8 cI|h+,+{SRft;|,cR%ʧT`RI|g[򥈊㨢B1p:fo;&TŁ9 ,>I@es3^8#N9h J r X&J\K8p=dmAn9BqDў].ǎ3E}Tpث|.QmVroΆ*;x_Hxa4'֢q' lQS/ARz>0m( 1Y L*S9zxsYH߯}.gqi^`ޥ,#aRPǓ֨0~ p~OГm5}ŮWdG^mxr&{Uj!Y{ frCKuK~bu\ޝ@Qjw򔘾I]bG>lA/̈gsA<ȇny^ě.BulsSޕ"\SSN%pDhqI̠MUq/$Y 3 %#1Yf>Ze%1alÊ"Uo :*(t.k@!וo :RԁB> 0t7j6Q/`g>|E$/;%x$/w>K>|EθqH %㻦[<s\;c0\`Ǹ~<q_pqwA5 oQ !o \8ȦS:.r tB]h׵ igh st%91L?ظs[dXD'xљnJnC[po~ 2Tb6땬(&emlʨ<%ۛvnnF\Cȝ''쥞PMϥ4wĤ1 %q_ I|Xx4 s"-|R,5.Mϥ4wuAmN?[<+ ]e‘6p>'NOY|DdRORz"LC3풐rk&4&$#3?rG9_ *›oz.q.ŵ4I C Sg߮@H$ړ 9R4 ||\RIF\KC.dv qrqd` 2*NT ɺK"Nm̯`׆+!snRQ:/ s*ԺKi*B6?Cr&4a}A9 9ԝ XGn_O(p|xtZ>[dKC ןBu. z(b5ĄHb$s)GLw׹aMϥ4wuӹz”{( x*\/4mѕۤ P ~Z|xpoZ&s]]e=;1׊K lzsaj->(usY|0V }s)]d]}'P4zM+ADbc'D48pmu״Ki" \1۱-}3k{epcf\\CN 1F|r<|Fls)]d=1 QL\:([l8˽Բ.byM-odK@}8NY\,>(uZ/>W Vui-뉔ls q]}uI2݉[wHB̄6^[l4v|YOp䄤N\K\wnvE7v.qum'3h(8i^&Kvn>(u_msvO훞Kij-qk06*7Xkܬ1\ 5/>(` />Ըf7=8EoApRyHhCF&;U"¹ ت"7qr&-- Bᇈ~*~}/~o^ů_Op*~*~ۥx'~50)>TA#wqej 2c/S192Hpej)]ڰf\A)pe-/򚜸 [bnG7_$8K'29Ke*>Gi=x'~?+~RO)q=@羮{@$ҖXs8^8 gH3e'%^]#T%}>mxt铠)8V r㺞7Q8R*5o|&s]]eu?@\ endstream endobj 78 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 81 0 obj << /Length 144 /Filter /FlateDecode >> stream x} A E|-d^JqE,;`aIM1']2C`u'e8<.yI+No 7<޼_FNt.$A%;<{9#8+Pn8/?m Z3s endstream endobj 63 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-3.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 84 0 R /BBox [0 0 450 305] /Resources << /XObject << /Im1 85 0 R >>/ProcSet [ /PDF ] >> /Length 36 /Filter /FlateDecode >> stream x+2T0BC]C# TH5Tp `M endstream endobj 85 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-3.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 86 0 R /BBox [ 0 0 468 324] /Resources << /ProcSet [/PDF/Text] /Font << /F2 87 0 R /F3 88 0 R >> /ExtGState << >> /ColorSpace << /sRGB 89 0 R >> >> /Length 14523 /Filter /FlateDecode >> stream x}K%޾~Yv/tdH1E[bf1ӪqHW%~y<7jESH& @~շV!ǷXT{_ro=~\y}˿?1?|Wgs%[yO?o!=oݯ?w9-oQ7oϟ|TĥuN57Ӓ?=~?~' O15<[mboSIo)I{}qϩmC^m8m孜>bd5Z }ZU\w͇?<~sJo7ߔ^VG:)6 =HߜqBN`>cѽhWY>g nͥV9si??o} ZyNij7&%~#3>A{mmzcFo>Lo Z(,7"o̩|<;\;f3َ) 3˙KxCz9s o h>EnyV6zoDNoߨ7MizvBoƨ˅esrzTZ_ s''OyFc`iNFjdN_;h7iذJ]` ;mӷ/}ej+nn̒Yhzs7SV|kfGWhy5iX,`؜5%րt ds["<_Н?y5ffԪ 1VOY^gǀ3o<ϭf&bEuH$n_a;#x$ 7MX6B25;Kðk9mO2GKQY/3D=v.QN򃯴7o.]ůW،͖$c3VSXhoKYOre}*J^\ cƆ=%E[g^Ϋ qF{xL4S?Ae(H&+@ϵ;'ޘyVh0 ꭑ,4./x=8}bp#KzgdTxe`}-%%*P -'wZEP6yW쑛YyMƒwj&$3h0sұزMϮ|E6m 61,Hn*Й6՘~jonT!݂lXMrgnH`$lK[\g !$}{.=2szmJqbBOS Ef m3WX9joJ,f2 %8Py$na9.*6Dq{g3g Q 9nja-`SQcY"Bֶp1mU"bI`=$-ôFiVHgXzhqE.-3Zcx4ؾMIegӝ|ӞfREb7p]UB'3,x3'i ^iɋ6i٭D %1Q#32*fDve }ҽM(OcAZYYӌWf-N`:D7 }[Km1hNc6/(+ `(5v"<հ%բ N.pwM})}džBB2VF+gδʋb-[~u2{ ig 27s1ǔ1\/` ]x7t1hSbCZj,fnfS j۪7qǺvN} !Yi8t]--Vz72Xyf^֒)o#g륦a?k6A5ޮwf;cT mu CjH+$5Yv|a{}1Kxk}u&Q>8{Gv欽k_(Wٖ{XUY lK\87쨊GüZO#l V1a,f^j$dyT^Tpb}.|. k;1{K]kɴxO7ɮ;SCi2젾0jn۩l-O*5Q MޥLm|[Ӆ/;_ k'|:mK<%RFNeC]x-lP.y _..}Ox TKe+u'$%y+t*1u nwN9 }2O^C*(K #=Z eo=ob^4;w{ FqO<alJi]Y ֺ_{.˜ҺlHKMIM#*/aoh)ܑ ymycK^6(K#sZv-Ry)QclRT03+ԚW(.[ߖ';1Ai]JSמu ^3lJ8QH/W(.o'.ī%t.-ΩKO|2R01"KK#oBqZ[ywjlP::҅/;uIgڼOJF87qt emyRGywʷ^6.WHO:"9̷%;_ScRj܉JUձU 2^6S]R.|IޙoK|6!i5Ѽ") y3yV{Liے^f[x[|G'Kp^TYDH*9P\OkϛY+ѲҚ󷑮|!o h Y_I~k*pQC{eg]8P\6OhviijKN]oKz|k]Z~'5ǯxGWߙQZ7ҁ(yJ_ _ye3pF.C~tzB+ƞ=qh׺MQ5M eE$[yiňlPx;©F]b >?$=2?C&Pk'i^[|ߖtK|S].i @7HߏOn[g;:`뤑S~R[[jZG5l7s#z:C'qN^:3;'[gӲv'jˠ'['ipO|i4 %c%EJ)w>t eU_ =oe@:;><=ԢO:S]{*GMaPGZt:WNFz'0Ѐ1/_UR]#3V]bUK[ ys.|Iޙn Zġ9~>l8TyUߑ'Yafky _w[u5U%AE)T L57#ֲGLJ/)hz $̷E^t|}~IV%aeK(騒*t-Yx(4/i} ے.|Iޙoˀ/ ;Ca<]p0 e؁CaRxv`%H5t\96rJ~; ޶9쀐S0 .ia';Z@|/v1ǰA7} ;01xcǰV]h؁yn;p|7!ݰw2 ;0KS؁.77.qLoDAWBo|; FMBo?s}.u a|q?#쀯mv@P1lx_Qfe]WvCEK[cL/5$ iHQV[W yc7obȺD:nL` &:"w,r勯T7p! )YrV׸~y%|EoBbeB64u^p <;Mf˔8pZt@X~Nɪ=KǸ{>ݲd+(|E&qg[A\%6G`\`@Neyh2-p&.ٺ5;H ,dۺ"yFT7mM 6毠W*A&֢2sGnfg!XϬq^( 6'p^#%ZHslȣȞŖ^qEfX hM2̀+\w~eaq K-[a=wvg]6Z8 뱀|,`K o|>d`y y)kټ ;DŽk+4(9囖 \oBDXˤ*&oEG,+*(ߔźSl߳aF"N6) lsǽ~kp<؍Qo–bSk?I&AdXygdTCw§љ\Yf,mb_&3Yr{ڴ{Yo,tng;V v씌wu*uTn!^v E+4LgC.cbHs tV{%,le$f,Feȥ7W030dkS*#j\) (DK`}L LD?]#C 9MmO۠߬!E Cf msAtZb]4i.[߱8t.֏WFMlt$\GJ 8 7͖ecÒZaP=5,^LI8smh0`\DeƔ1pMڰN>nAZB7w J%',-gv5(T.z-d펒mWnVT*D { J+pso97wҋߗ+`/+L+ sa!XP3_X(R8kj$ah,]ԟWײ`iM=o1:~G!ްސ6dM3SwIҸiNfZ +XĂXki<552/tφ^V*lfr`cf97y.p n$łiy J9K6=n\2uqjp@(oVC HV*!m`0^h83u+׋> #k"j*w>ٽ1l;gKKɵBEĞ0L ،Qbi u{_Q|d$lnɫrenw?hUlPoF` $И( )mbmΠ&Z^p3`\ t[WY kάymbw9= ʽu5kؽXT!ɨJ-=磝X+O2i<2o.t1"90z‡k~N3ʶH -6 ĢĹ  .";b- 6K9}tY]%*k5Ѩj l*Y{r8/\8ijQ[!Z3\XGYۦJB5!0TF.cӲ]3ZȊ ًqbW$:nm^P5h^jcJYR[!cb] ߮3Z*zŁ:ps Ŋq/8 ^ep2įz]p#y^F]٪i)痬<2Z:y]+aYv jEqs bm C7T% 8bMaܦ{ ZыuInr\|]Xuiq"r~, yWm$8|Ck0t^c|>{H;S4A[ݸ~M]Ӱqn;MD-;>r5\ǥ"U+_x3g*B]9j[}׻ ְxg7v}c=@%PtZƠ{؁n7ojw ;n ;и0؛s$$DH8#p^՝xFa!1=Q!0Ї7<pFNo1\ Fm1+B.HwCP|[._TWT|+t.K肯x]B|5Wb>vؽ@K00pNH{!Qg-xD߱F4Bl쒥' / <4KH[4If_)FESqO-Z-F(m7HOZ3S9"~HfĩE8"^o١ "tfH7K fHy{:DWj ];9`#v+l$9=w^6La#h+ D`#p{٠:fSt+/m7Kۢ'HAay|M6+a'z٠.mM*|e+l V^&c)|P7q^K xc +H {eV8f}9U::h8yry<v[R:~emmmO|`YI3<zf`{:nk^ Vk- (+p9hIW􋌊R8ּBqF7L@߳Sj u!pjKraԸE PG^Ɠ"Ey J<4 %!7@P ]*F--: ڞe+i?9he ok:Ҽ3f5bìM" uQrxyl4_ &y ok٠,#|iޙ/Q"?D EHOer:rzPIst0쒼=TZvے>89󭐱[ D֤ ZeᤊWD5=IB6?E^ AiYfKp*yg.O>>?i ҜC܅ǤFzEgM*k8P\6ޖ'T/K1K/`S]҅/;-u''&QE{ JC顷]T齨Oiνے.|IޙoHء|  r.:,r򥥫ɫTPdc8^-{[oK%yg5tA#2o[sH d~(WS\6H= e.ے.|IޙC̡ Dši˺/zzנ8Pu:'*yi>^6)tAO$O ] &+JMz:j^!H`N j m;l=:N։[lzu։:`uЩeԢ#$:Q f:wqR-|W2;.<=ԢSY.u֩S9i#'!PQmLtTujT#C]CCp$PTKJ~%QEMeH]Mzh-LʂV;_w{n2&u<ђ3S)̐mv4/(b]#Y.XW}ݱZ@o@>Q6ow XJs~"qE4'/43 Þ"67Ft̋YE:_xFC̕*= :Jٸ!FpTyݹ5ج0y|vDlVa/8j˼Q-mf/0>mXȳD|W9xӇ'K.592,a2 NG ؍uneC6oQ[KlNFF0."ȵ\Ӎ5 ޱ~n"q.A[mF;p<%+qVഢ64l?P4[),-RX`9F{V͒PmZsj1xsVuZ{غwtA۲CJ:CNuB}mX,Wlƾg{?;7Ռ[/&ٷcgcۅK$Gng08Xn[ ě2mjǰl8}mo ]k.T&.-!,geZ><, ,aanhXEdnb:t/^?`΅zF; 0օ6*w}fD.;<3Oz+[EkJ{.|dKDZ[\~0A[^тY/V䳶Оϙq[&pVo7N{<^̱ \+{gt fb`cH_8vB[lEVk WeE#lee1E_ualqвmVl_c'fno}1@[kރm [7m]ʖ}}GlY e=3IuU* ?Vf;Β yF:!y[0oۼ>htN^D{W=sf` jq%?fg}+Żgj{ pgm;l"-Kë~L+2SC:yη e2'^:5';(O<&1#Y^|=e/%3yK+m?F܌o8945Vk'|.llQ:2j a_.zyT/딼Sü|>DƩ O0b{3UW=soZ͋`ӱgHV>e/%; "",ȥg? ^7.|WiV0f "K8ΑzgU4S(3W} {&8:3C"NY&>K+>gM&aGSsE~k߉l*n 4s>sumcg}l,_&lub\\uun5;g m^/n 9Qf풫uo~M|gWz,}?^ޔo]_RޟP;!ϧbAL' ȿi'oy׈][^މ9@/j { :yDB'.?i5t y+&$Eb`OGwRE^v.^IMRh"p:}U-y! {2_g7p\p#σbn~| 䔎{B=䔞#ANe;׃A?ҙQ>wvOG+ ^D rR@O5h/E/w%Za K_IˋP:No8T/eiLtd-I)Q&̤ ^ G^6Èbm4e(Hh|>p5.rccccccc€7@' g3@Ii hN XhφG'~P 8ΰvT%| BG%ߔTeMÂ6}Y1B߻ESvp@~ෞoTkLtBS=yڹ܎³? i=l=5hv:P$@ R~eoz~(v/IȆ"rO-"LuŠG*|E |uBf)ܿp+r YqZDH\jg[~bv#-`ɒcСT?v XL7:/N9tcZ"d07KO"ygn{>@WĄFMX9ʉ%rh{n![0"6A o=Q"ǪP(ߔ,%Iu o\u@[ @񙻡ȞI%wID@>P(>\O7=DUٯxe_ t<>[|!_DKeMn}Xʪ]9< Χ3mMq>wTඞϱ!7%Usۑ1;4/APѲ^q$ ͧDK/EKQ}O7oUg/k;X$VJw>wz*+)O.{PdK/7@r >SRyUVvvsOpd'{H _T@GvH>#T&Е)FM !n;jVw} ] Κ| Jg ||BK}7* nzyYqALʈ:>uXSRߔTp#&^R{iSfOMmO U5ml)6a2miS۳i{Mvpvv7yQ8Ay!:0{YDpRU?QJeBO[OU8ᚪ[}| 豚ZO-f߉QɺRBOU\<:;ǂ α!p[_bV%j\'Ԯ n[]T&T5vuނF $RW٠mpdg=MԏmD՚Т5cz~Yj* =j*Q:C?I?ƒ&Z5j^{*/n~{>5aHnoUW zzL NB 8 T@pjeԞωNպFM h̭G'Ã=EC7Wl8!tمɩ|sK1R5z =`cG*Ӧu=7*Kg75,ϋOQk> 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 64 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-4.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 92 0 R /BBox [0 0 446 304] /Resources << /XObject << /Im1 93 0 R >>/ProcSet [ /PDF ] >> /Length 36 /Filter /FlateDecode >> stream x+2T0BC]C# TH5Tp `M endstream endobj 93 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-4.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 94 0 R /BBox [ 0 0 468 324] /Resources << /ProcSet [/PDF/Text] /Font << /F2 95 0 R /F3 96 0 R >> /ExtGState << >> /ColorSpace << /sRGB 97 0 R >> >> /Length 22001 /Filter /FlateDecode >> stream x˒&q&%Pu,֘llEw/d#dT{Fo?玈pdFY?^%˟/zIh/毹~-%[O/叨}ݶ ٺ~//o"߿|qm_bj_{}˯~oO~_~%khӟ5kO_c{9Wsc//߿55}a)JϿהޔ²kY6ս˸dž7e&"͟עke( [Z49[ߔƯJeۛ^ga i_ͷ*p_9AT5qsFoSzceLՁYbuߌ'3lZ3jư Y w鼽]M;ūז^Vy$N;qj('x.2G9S~Z= GQN\+rGyڗ-Yੜ<ˏTPˍ PNHq- ovMxkTz3(ܝĪXH`].'}퍟.F~{w4K־.}냾.?9|יq/΍?ܸ /R팥#©<}X~_j֐d [q_hŘ͇}냾.Ov4~aIeO;CG]xig]{П/x`'ރ"$߹SkOC;Eq=Ez~x*m=xwi]{]. }_.{?]beqG]-?y ve^LF^F;X}nCB׿,/qmOCOh6; =m}-;8}rDaTUa<|v_c€fxttW=O{7Lx9 Os5s·0Xc۲wn*XЕArUøow~ VB0Na2;-ӸAsz7mQpqRmf3ro@_>{@ s ҰS:dtNzqlx{u647,|Γ!B 7-ҷ,};ZX a[]C9c<8}-bx0{ הlNg+/>ڍs5a>'3}_|Nyx|W.Dw_L]`nsy!P,XHjQ/6;:C1T*OR} !ꅥ&rE4ICs ;̀F!̻q)˚mΙ,Tpn߰Gd+5Sক>?v>eQZ+~옐6cgY55ՙH?l4s8Λz*zYg5.x`<R-LBx3 1~}B.'I=3=vt3-jj9 Ρ=̙;S-L)**B|Z6q#oKFY✫L}sU{ s%ivp7g3V0Y󮔵5(xGRj +ڒp$è\UNbcBG!Sd}AZ+k4+TU7,$a@db9t<z,b\E\X*9~F)^eO괋dgAWSt*)+ cTR\BlH<<.j}-| A6|qp8OVSE; RltHJBc`5WuzbluEcHK~<{,%RMT(4gG+L{WY\ލJqэV;ҾSDo1خ)pqﶓ7]mn nE;Q׊m=}6:W};CcOZ8ciwany[@ %.T߻u۪-'^tSC[a5͚'F%bT 1$">DŽ CaWkp૽t L2<&ūȝakKВCTqgwwEUJe<ժy'rݒZm#cPnQR1vKM+h-FSj^ǂ\ZyDKώS:(] .cbu! IP c_qJ}툧hbhFJ@pzsdK|uJZdxA.{.B@I$0z JYLա{1pxnkKW:+V R2/;-34g%Y /KO)ڳ^[3_N/8ȓ;7u$'9fm?R;hj{\H4|e؍Ac@MtP'=?+;oډ7Rgܩ^UܳWlKe>iǟ0L' WGsE+ՓJ5#{5E7dʳo1abPе ~Qͻ} \>ſ:=H^ s;_ )+.`=NUŵ %R_oy7jMvE|BrZ%ۻs,U]emŔEPbФwK\:Zɀwuê;IwLq5MVdU@'{i[q>2<V,lNc|'Ikަx߱j^8?ix\v;O}j`"WPomLaE-yA~|~5Ysv|t>HQ p$0ky~yKcYDؾ@ 3Mτ ǘԽJ4NJn*⧬pPb*`If*CpEa `uV 1L_cXR (CSLu~J T$w" ko+k,3ob2EIJU 7?u4EAϔ|lukC0]O}`f0񻵗Ԣդ7n*Y{p0e_@l=\^V7l|4C.YK{[: Yr \p-=?l}:֧ngd&LXwX3k(<+p?ӳaBQ8Pe‰j g*ҦpQÆ_Hu l s|%*dB{^Ppap|ݬD9grdV`겫%~#3*(;M~7OP|9`u 51&u~Տx?̗!O`P% Z0ޙɿ~uzƞ}Wj9-l U 7_ *JeV2xMᨖMaƪܢSpyӏTg!wQ OaՆߵ7A}{ߡ0_ Pxj0U)ٞ#xb‰%/{n0+[eP^U_b03[\)~o"V|r_M)z_4F%Qqjk4 ovz5]|uwT=8Xm( ~~V~#'S@yq+ScXꅡKCto=j^S8 &~Hq$ʔ60n~_~~v#/?~?# GA*K[c_n o*zM)qk 'm*Ԡ\f*a6]6fq1#x"ӏ#D<*Ap̈\ոuF࠙U38f 6#mtHSf'զſ|7 QenuEK6e~Dl }Cm} 啬Nho<20Ͷv6gDo~G2FI6>|/n2_XEvUm0 -E|6 n:.=[G@7zAULZŶ;!׳Bya.Umegy Wel75ϑW}(ą[l;՛}kKqoK闎G!ё!(hyD mԶ_:GG*#\Gq۷h#^|=S@]0ʣwB~+ąiϾYn"e-o;5_:GW9I8gLjʬ_*MqI7탮XZR[{.YfUQ{ nyP>lOwBʽ_L\yζqoo-q)y-Jx{ þ؉_"n:ӊfm.X7jl o-q)y-Dx\s&zBa<3Y{ w 蛎}k^ƭߢ l_z.9 y)ٸ$㠀;!L DL\gy[ˣ!p9`KMq/6YN'bkS݀+;; JI5Lŝl m/b am2MlkON+CP7 JeܔH8!L\ж/NL\ЙmIo-q)y-PPeP>PgB@u N(Ye{l|`m2@216yjEf#0Pj{!|oOTt4 Fiٜx7N\ǥqͩso9~ivD?ia )i@P,cp'ɍejb?p@>3 ʳ͸4 [!`B{BI|,o z_v¦?ަa}k)po9RfmץD8QG^ܴs=Ⱥ/NOO|+fW69 qG!8idHr6琡3RܯJq-gtrO f9s9T4G9Sy{YNT>`ޝ<V~i_`raF?ia{i"UVOP}:gkw'}xzK4~`i_q_hK4Cץ3ֻsxi帹sx`ץŀ.}Ama_lE/ݧ}іaXui|bT1B/eXم}Q_'H6~_Əwb/۟}ߥ}gK據w*AyH޻]fezʢ[ ev)8`x)l5qV1ڬqV2H6גϘJ7GOAz;z7(ÞՀAss 1n5oޏ:Y4"prʾ^w0aٿhZ{;M_oy³ғ@T l7o0|%3RP/yy/jNR47*7YLY%c:7'NO ̓w̆x 4s9Yܓx@*ù G')Zus7yvhdޣ /zyHw]O6J}x:%P^>Nil5זyR&r3veD[q>W,g\DT>t5}D"tO>h^Φ'%., 4}:UW͍Zy}9}~}{?湍S O(4s']K#*Sv0+v,.Ce8mvnKƷ3/ś2TIvNjrݏɪLbI?'hGΗYW$nMaxOXX\(zN:ln}+{ń͌=w.*FR(ylIe癩]$.5NK\P9-Wy -[a|e_h^bPjM"1:gtW}vR}ܳ =*MkCu3gniUdoйuoqE]@cC3=2yQL6_TrGmn&t/ MHZ| ys92Lfg㟎qFH!8yiלW&rf0OG|^g&ny/Sw(O؛mxiJ5 -Dv]bʿ-%Myo 9b읥\{D-rҭCd#q(ٍc3Gk`S+m73$7 #M1ջJœ1iCw?/}-t MuRnrN-p&z%8Y[ .8jǪk'rbּsVE*dk{s~Q׳sW"M ^?P:݊UU 1s ]DڙĭߪyVZ-<;>O\I)c>۪0g.4/VpgLd[r$- *t{rCبZyBch-?ɩ7\k6eK<-\uWhtɥOQ]u.^ wL{ei`VXڑ{JϪ݉˓.m8Jwo~lvG}n,`l$g$ M\}:Ky|g-4v2ψD|&\M\<@"̩1{QW|OLF;#\wm ~Bkt ёU&G}R.7>ǥpJ~OJPiҵ@9Giʩx}7MX$ ɄQR3drPpte>Q3|2V D zL{L43F';T+. |m!Ux SeةT[t?쓴ૺGk|=A0TU(&g,:")BrZ%5yx5)6ߝEWw-1'/f>zM3Y4yDP8~vN.|'"l7@]A`qX9ѻA"=4~UW9fuuZK&͈ ]W&!O9Pl|A~(j'z?LOT[63 >^.ZnW:xï#_9haBRQtl&+C00kWRF=o%G=o%9_Km}"ţ rf{ 3 _׋|p (\ o` 6_%&]hAr@O*[j6߃| ɢ'=%Q"MJ/ npOuQD܃l<]r뛦o0'{lw?_Z\˳C!Zw_q>Wʭz>iYI֏=3`5~e9 d G~S0=NGi*֞Wo-K+%gD} ֧j98h{VY?0T[bt_M.p`+=P{1: O+P1zRT?{z\`}ɡ}Cr/zft)OnLGno~#Ǜl|Q ㋺Z&q .u X/:J9(ʏ%%9~_|ɏnp}}[ǁƣ߭_W +< Üd^7gz>ԚT<^yYV(Xm?iU@+#(_n5;x?U|&O_WpZnEyN+r~O_;CQiyS[/[5p?Uc+[ރ; }ʠ1\JDoj2g7tpc}]O&金]Yqt]?*-]yMIW8}ҏ:8?KOLT6z A7M{5JE7ز>lC9/RzD`˙.Gʷ5NLa[ 5$yVN8`4WGq@5j\I]@9!Ȓ)tlЗN\v8mD# >R$okk|ѠH=j>אJTg581c$DHA ǁ( |o'"QjYr[Iu~2"QƑ(Sh}eӟ?_g!a(H}iv˽ʟ bI1'4,\ffVܨM4cF2Rq) LH%p` !/ˉ*9pCUpܒU, C5PA* d `-njJffv6#4#1#Mu6#Uy xGیHθri2H(ٌ،HfD~̈aS0}",Lt0 C6턐,3Ru m֮ړ 76 ( Բ=ے=Vr6K ; ¡,C$d-C蛦aK͞fIa ۾Vns;bmmm7a(_Ͽ ӓԉYKq Rmͷv&ԶHRrmR)`36CF;_ ځtBh&TsRv*.lm@̸rm+Tn/2i, !&QΈJ,All;ZٷϑEK,N&.F2i_渀{%ԠY0IH%SJ:yYVb1[/}h㗐܀Dv$o-#y-3>Io_>ZD}$?Uiy7U.pʖv`AlkvKqoaX6 ;IBZ9JmޕT%+&A󮜿ྛ g}E˸-9*i{=WQ`/3vfd@yqU(e@5qambm[ˣ[͸[}_ϿtO}*s:oaHe+Wu6G֦ʁ[9Vmߢ}k<>ڃ0F}88l, *Ӥ<*q*F-ąaf}ky͸-if/&_XV UyPH\-ON\6k'3cȞ7\fy[u\{}K]TzYID'^&>fzX̉^ZVfJiB=MSqm@}k)p>dPqn_ȻjE*ɠb,r:fB*/Q7̶o-#y&! 8yTMAG"[YdLdR>6{k#5/SIÅzEp)ި(0ЍZ`"3 C։ 6q+X}k:[89.=P}{=H'` }_.ڢ.(Oɧ mm2hKG)po!ί_~s&ͅmѠNgtCmr0 \&.[Gy[u\{ c #.m1|³4c݆O2đx{ǿBoS"áw`훐EQ"aP$v.x,#Mdc~.B2@.ǟe{o?|CJo<%*#a fDvͦb;qH:\SEΘ3E3D!vP<73.뫞PMtcӝJ+SKjiĒ,ؗVJ(g ~tl{Ϲ÷$~-n?hEY`lxsˆsms˳~в|Ϲeau?g?͒![~}QaGM.+_AO~v= Xd.þ΍Xs}}?:ꣾl1~?>m4`ߗ Sq_+E_j֤|}vr=K>ܸum3+RPsy88~,7s% (x[>AbL7'hogiOi۸3 ɈWCR2]?&&VTL#dݿ5_m;3sĜ: YNTj5 (绎cf9S9<ˏ?л!Y/{`=Ԏ0żP/i nh`ϿVYI}ƀ?Sł PDr(CmGx.ˇ^xJV 8)O$Oм84 7S~{Ғ o 0UxeN﷾y>+ދ/rmlj}neQlhm T0<ݘl5slFxGE6>k~m"sA$X UR(&P{sd1xڼԼo:xgɚħ9I nxF0_1гPV rp0>&VFe^> I3IG߿#s%/xoŜрnxxCں}Yg@siZvf<5d;"\^xMrC`! l H#}8A9k{ V1_zr")su>Ex2Ɠp:{J ս'0}X{8~C7NJf9xN2E'aU^h˘PE6DGφw "HFߡ,;2P/x؆sBWd+!d3}s09k?~O~~ onK+7W~aD:>) {Mߜ42%[DhOZp !OI!ET/ꊾn"Y<3VTrqgLI 4J ćc]$nNlcR=?.kXڂO_dЪ!6/ߚ.:_~F2O,:Cd'H^qC^0*7OwIV߻鞹c0!QLAٲC|NIjD t8Xw\>` 056,)آn;U9c('[0Ƃ|8Я~ɐst/_*[ 'ɗڭ%MRqG: AԢO!]<au&6/u_G^_${%޿}v>y92eשQ5h7 s M9w B }jR9wvCG.S- "9w;~ Ҹ.俠:jG ZsY\Ϸ|W{o'/:<7gK>XC?+Et#^6f__/4,-&f^w C$T[ ^ݮy֊^,e(-³dp>WCkýw"+#߁G_$DӶ) 2s.h>xSNKeT =rQ@,d$/0S m޷S:E<-իFd|W۳>WfCY-֚!wt[aR2dDً%} ztbCYzx.Vl^5oбNm/ЪkQ ݣwUonYp]br2$*p65=AW]WToXe~_Zw&ŒIצּ!v^v9Oį.Y}_y1xe1EFV/j<~,NxI^ ?{?~XۜE<9ɛɭO:!NK=iqBo!wNH{ìSne)ʷ4 E^阘YOo+lOS<7$9Qztjyjw;~kӧճk!bհ?B7!ΕŶ-t>nY-sMZՕK8,< ~|a9MFkʧ}o\?ޙAaz|?]^Oq[yߪ}oReUY}_ҷfE5U~kByك}K{2eg^|Ҭ)b3ssGgdn?әRZeZ№51W2%7H5Ea +ư,T%%K F8ihJ2r,ś:~-X"Z4܁r>Tpe % !`R`Bj\gŧ#X,)!7FèLҙ6aocT5I_JapԼ2S`7ՠO7ZG%~ w^ -vvZF9ޥ }*Ujjyvfic7 d6n "oRmѭ`Tӻ nXat2ݘyEce zͲV*f^xn H{63LwKjVnђR+WYX AB9}?U. bpkTLdKiֲzZ}S% `o6 &8ĵQ9̛^Ѧfyvt}SƦM.2TH`wDɫf}\G?.Cj3W7%0f2rڕ0'웝$`,+p}_t̺ 胴ZU}2˦ w]Qu>ӵQrIꇧ`ĵQq#ivx1d0jy&GQMy1a 6sF@>#ƚg<6ԹE@>ʛ`KҬ`[7RW{܎f FvY^` LQ"+@Vu7DQctkrokkvWn=)5k83JyYSBgu`gXm&8)IW{O: =p/I(f! ߔ?瑛uOp2 U&mOYgos~o~H9$2΃<Lyx-߼H7cYޏr&x*0r. 9 1|i M1O/?ü\_OA߀`|\v4|N?3'#߉ü um]kfC &.'T7QTErL2 :I" dr =Cm p32qzܴ[I D`g)yB#GSK%F{&<5sJuJc:UY?cNC'C'@=͜sDTJPUW jqL@MdIt8<'@Ⱦ^~ͲS S|DԜVg@_Hꧭ[RFNc}xr(.M3fiv n Ɲ4^ZL~(k%>QX-+Նʒl홊[eU4@VRg&^ Z-oAݶwT0Z㇎W߉n;]Fs6K%Isұ $RV-f GJR>K9<;A~=\ΈIEIoqPZ !#DT٬U3|$w&}gj=#QHOIK^ .|6i YZZ2VHVDМ%)H XsZP q$Kzuiq>ԆXm;[A^O?[RU< `wJa0<hr"0&'j֧w)y֗ȯ0#0sY [&ƬJRŃ[,U m],ѹ̾b4w /Q!÷F ¹Q*YK (?qX,eQXm ɼ:3#4Km;^FRV ؗh:j0h* 0p%ͩh,N4?GmSK9;Ն:4iR|x*S`{0vd2ijo\P_Z&D (vxoYX>QX-)¿UG`sE,.]7OBC+mMndACjk7zɱNSF}wcNխ(YguzJN`Kk5[&kSKmx;Ҫgz!-t!Xb@['g@(:~U ^ ZYQױZ&umQ)tOI-lQt 6Vy B[%M0,h 4V0 ':Dg7 S`aAUU&IZjXMzE"ifAovGlpJ0G~S#o`?V$}TGCXM6'fnFU/y§xU>@z106[-S> =x%r2Y8@h ) 8+y_HPߒƲ;ݏ9^GZUSj0TRFNcw}![,y UVK0bTBLVJ5+ !x y7yd63k,> 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 104 0 obj << /Length 330 /Filter /FlateDecode >> stream xڥMO@ 'aghpk=46MD,-hjKwVīXBH!CΫC(Qw:1C抺I&~r-fi|&1$cHƊ DPm`{9a,KK4,,?:uYd(f#H`E=yL݂Y8 $m&z%{۴<4ը9'0!RTo(ՈcFX594̞[u*rG-3Cn^:|LdnAgkN1U"aܦ endstream endobj 65 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-5.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 106 0 R /BBox [0 0 446 305] /Resources << /XObject << /Im1 107 0 R >>/ProcSet [ /PDF ] >> /Length 36 /Filter /FlateDecode >> stream x+2T0BC]C# TH5Tp `M endstream endobj 107 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-5.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 108 0 R /BBox [ 0 0 468 324] /Resources << /ProcSet [/PDF/Text] /Font << /F2 109 0 R /F3 110 0 R >> /ExtGState << >> /ColorSpace << /sRGB 111 0 R >> >> /Length 17022 /Filter /FlateDecode >> stream x}Ke9n>E,9zKi qcfa{adnTQmߏэYYHJI^%߾˿:K5p_x=O?ϗƏxʟPw^x?e_vluėk/{͟ۿÿ߾_[8l,֗؎_ÿyO}= Tߐ6K[y?__?| /5㗀/y~e8^B~ })xW{ K Y欵[1^XgWIkCH ]퐾P;'.|n-'t˔בv,f8w-1oKӬǗm>wI>ǜ _:O쓊suO\Cm&YЦDqjU{8o/ #Y t'PXkj#yhE}qOx_,a{{Q0͕JgXqþ;և}=4>Ç ¿8ה/U'ylghD7}w}7 nY6wWs'?}CG>jFee])x;@bG/b(r{m"׾reg8ag;_B__~^Sy^ːc?\0'; 1{z@'څ~N!6+/+EK"Px\_(ag1ٶ_  oS_BOHNICP~f,Yl'c+p$eN??sRWfE.o_8?~2oOsX2x_7~۝?)̾D9iBw4a^-܂t2Ú8#b ͏ V)/1v\ݭˑ_)v RHLќy@<.YR+Fۆe@I&X,yB\5oKe:]M)'k5.3D>'P6:9C"ORu\'~d~g B95W,J0eW;l9t8-dBPdr_C<(ԌAFB*Sң|e#m<)BlK{6;oK\9Τ3+H1삵V$Dݩ=2H;FEɯ$ܬ HeެZ[U@&lxvMβtine€N1IW=~^CL}м{݃&g)\ުY^N9qJ7P~ĘDZ\E_'~:tjVˮÌd]o&"G!WploVg=0ySvݛwRd&G+$vw7%9ڤSM#hWYy 5"{^%Y׊vٵAUdY﹵/ JE'#6Y!Jo0''WE;t PC":cof!E6TVryd9~V2O:t6,󰐍;GtksPyD]vؤVQ' AOr͉/c6yfɪ7hcмʌF𢳒"*3@(plʽ-M^oKI@HhDuS˶gPva\Y+`FFva){B$"ct [ "鳤Q^M>:.Jٙ4"*SK)+gĒB7!Z)@9u.{ C&'LƜͮ8ޑtkŁ]x@P8| @XSUG%Daʫ,۸uNKhfNJ'鮗R(4.qK>!,eo񄑠$z<團;;X r3tYRN뻳mzPUDP2c9CGԒ5n(eS=j2:uː;@xpBl&)qg~ ^A/W_X>j|.I`_D90?9d˦dR}`HB2LI%X#-y^gېVgU GeeBT cT ADQ#OD)l]aEh25CAkT|Ew\rEM7ULz&_9ڠ6Cd@sC<}#g#KP_2գ:N(jٓ $ P)@MB1 hu֫A u[.$.&ݛ>9U:Uʅ'4HjKd7=?.&ݔ)Dv+JThɖ*'}LIuLai l^\4e@/=q$;.&*dw档1^S5TD3yeYY{88ۗʛU{lX7=in+ 7PU; 9SCW 4R I¾lnk12?ȌŒZO!̹Z„P;C-SJq\yI%֢߉-T F~rp^CLjPUx5 ;fIAghBGTU9WqeGyŦ^6=0Eg<0vG~pr͵?z- cp"fwFƜPxW/NJ _/~蚗eޓQgyOΗ-0|Ys̥=O%}2'dj;OI>9l7v懟~;a~ÏHޓ#gճS_i*Κ;}^`oXFx}M4a81W7he_ulq[}OJKARĭ xn MF`<ʧ@*O2@ src[f g<0_%5*[gH= 9CW!%ϐX̆zΐωY3[Ix ^ys` 3$vΐm3>>C͐yۭB{3T<) w|${ $eaKp2}_t^7 ,r Hm}[pq;uE%0M#4| )āmfm*B­0w鯭o_#>nze$1hONm^V?T}imt܄86 m6.mrҖ#v= y*s;:Ah[mGqE]V }57>nc.”QH+jmf0g UHJ 7Nkoq>n34"z'I& O;jmK}paӷF2Yo2}-,p跜%=ɽB:^5VoF ߑ^ײv^TzoA<@#rD&c\!~ FI6nJm@km\۾Ed/Q*k룊=DNj 諍}[)pqd7% ykNfF}Vߔ2Ah[m%*DžȻe[`#,ol4yQaLbIRY`f BU2p!5o m%H1k[uez{,DD1('嬙B:EV2]Pk+vqs],e[2hɀ9^"<2wV*5(^v:Ahݔ.޶Bkm\ۿ;/}Kwfr҈:[;KC)*Ir\KWۋo]}kKqmߢV]wEK Ԉ. ;&.(ku@mr&uQA!uQկw}KTOGǒ1O@L:[xuQD!GYjwAfKtp\:m@6.m" ;ϋ$͗y01J!F}kP\K@.^Wۀַ۸ w}KQշ6lu5 st&*y}0M5m믭$ppom@_m$=6.-RArcng d=ެ z,MB^pOy7/cmʠ+*m\0SnX< UצAJd+X#ԮV?pҶ]n8xzr mX ǒ/W!Ec]=K wA%#+3Xz %}{pq;O\o%)מU>Ft9Oe+ws ezoAQbb%I}DKեG!{Xre_[ m@-ַ۸a·V AV!O8ݠ"Zh,Knskй^RT~0\89eO~'$w:2N? @pV}NJv~%0]Uذ66m6.}; k?x7/}p!YeP搎[C8Aiq^g Svtum6.Ng:gPTݜ;RD#]lV Nnp^ meGP귽v˫PFqH$k_kΒN\lrH[ .Re'_/Ef5>gf&r@hlͰgxD}U?TƾP- E~r.~,Bߘbl6 ,6¦ٳYK[>o7UVaܲ]h+i%}K6P,p>ŇeXbD5fx5Vj6=Wij}i 룾_Xn}=4Nx_m}d0;,8>Μ\O;և}=4>Ç {^^Y%xU:a_JlgQo͟xc 樂nejav ^:%aoxC owfa]o,/61 ?f8q,_c6' ?f`_]YקY,اYLاYl%y-e~.>)_-=d0xkl??d0xŨ, 3bם1ί}6DРߘ"a7fCz·gþ[1{;x!ů(Z6S^,T6bQwL6 5˾wD"xR"V `H:z(΂hQ6B9LKBKU8U%5UAR 4_A 5;4{4#OQ@TpAٔ¢#qG$R?'iԳZŤ+Y M*YMFѩj{J4"4kʛCS#ԟY'DpjaeO\Mt $d|F!W*h4ʣ~Xxo;WK)%ETR?T/LuK>PCL\C]Ŝ=ONjFyȨcehcBh]c\4M7T/EOk%S9n~XFKAwob]=TwLTD@{XĞDCXKURÎYhz0*XY;hHBJ␨ t말cV42z;VNPÇx:ႪXV?J# Lh`e4<Qj.3}zVN "dbbpӋÛӶUxNEdn PFվ9^܌V!OYƗjIx4|١_VM- C//y51ƲwBa {"fOBA4Y)2Դ@,CZ-PEs* Itl3Th͐6C5+ϐl3M U]_3.kj(6C ZC =YF`і|}ڒeznqV fhzm6.Jh4^NKJ!-'c$' 5mo5]"m@+Dk?m\ۿ1RN ^dɑBxUl yUqZzg;Au&8K$,c 諅YF }g zm/]!Uȓe:PACNCpdz>e}p(G6LҋVx֫mO(…$+m6.b.BŃfo%u}|CIBf 3X VɃf~93 ø=ZUõ'-ȽB6^9AX-\'_mkzVo2}-Mc1+|#]@ݮ*<`mo~Dmi+tnƆ+Jj[!OYo#5} W 2Vaj -d kV!]RW UH_[I0+j[-Ǫv!|ۿE`m/A >HncPz}pܾLrulj _6 [Y_ w ӽ(BFu\j{շag2=⺁D涙e9+N^DpOu^67`޽z>e[QX"h \xd2/8p B.XI(~ז:*z%4\v=WzvڴP%g7aR97q-i68жsYpS`},YzvmmP#ۼ%0'$)&CΓX;;AhmN#x^mdzoq)øGP c|%cHdNscz,C4 /flc%𾭾k])ZZeVV{ڳ'SS 1~?#Vm:N/ʆ+PMG)qT(i&-;G-/x?{WN냹{h`_\+a8~}<پQ_{'Gs7Nx?}O1_cZUǤ~)-VZ>~wMf1KeKNeqLdL)8ʻ4g=m[}{aV_CZ%h![}?W( nAgGHo[!x9m8V.$vTmJQ?$DJKWd"O'x5*=3*V*qf\pke .wX*b3«Ci(W52g?^  Ά`QKط#!RyE`.x4Fs6reXC(u];r"ăCfK{ MXd2 Yi kcCh*Usޚ4x!/'t3@l4ND|h D#.BnrCbbe؎ sȍT]kAZߌ-6;,A"|2L妩4;oyb/瓟kp(T7s7S.~55\;<LSD`:P J#8UabֱLel&,sgmz} 1@7C\Y]qm4AxS ' ZQr1=u*2< WhӇ |UEdXu^ ,L\gD;3iTWYAYiyX3; `&3E6*ni95g -kd:Y~`gF}T̰\ 3%2`Viy3. 8+} D1oД0\4He-B++;͑umS5eKdHƜ!{TvpT#fc87Q|:ߓ+41cpЉy"@ r:y~k DRLo!Qt/$Z_$ 6QTZ hƅʧ:ha{3y "zB;yE"ryQC)N!;&GY{w3"c7 C?jVh6W6Xt;+r4yݍ=o0: QhF署hёCu4ɹY%:{>@&#: [䮻XX¾|=X>4mGT$ 73 b}2?zT[ kZV>zVY}Ocg n:U"3oNOp:NIxrw³0Wg{$|lP= 1K9I\^fxxs-}fxϬU< ^<}6-!XR/ ~XrZm)<4`iާh oUg8Q /$\Rjh~Oc60֪?U86V{ !]K٬+[^T+Zu6<K^xzU`vX1mg~<m!3ȵ8 )G?ª5<ЪT q0uV`9Z𶱞#?X(/[J{^3rO΂-<3yFZ>a_lh+b{-B;hu _^b.[~ho뷅_E *b nPq* "F**ԏhr#9^ e?iVkS}g0̳m+H~Vdl)@h 2y+PV|ju4 `Rߒ&5͒\o8VGcxXdZ "i|CW<-WYz-\ ?ІW V|HZ'xX-SI_%̡XF_ endstream endobj 113 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 66 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-6.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 114 0 R /BBox [0 0 451 305] /Resources << /XObject << /Im1 115 0 R >>/ProcSet [ /PDF ] >> /Length 36 /Filter /FlateDecode >> stream x+2T0BC]C# TH5Tp `M endstream endobj 115 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-6.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 116 0 R /BBox [ 0 0 468 324] /Resources << /ProcSet [/PDF/Text] /Font << /F2 117 0 R /F3 118 0 R >> /ExtGState << >> /ColorSpace << /sRGB 119 0 R >> >> /Length 16803 /Filter /FlateDecode >> stream x}ˮ-9rݼb:J&C `@@]2GߛV3{cP;H& Ƌǿ^[m/gh{۶ &GO>OWw6Ao}챾7/_~ߡk0<&_?~OϚXz[>-PT_o=~Sx? [yy#Ɯ$}\ iya~GF'cZjSiϗ<:H-y}oGz㏏ԧ}~S}o=,ţ>nm?xf17^8oS҆݊]JǞI/l>kXO{†i RJG<5Ѝ?>Iu,G*'&b/S}qAQotsMO,yбۗ鄽({bKlIqOtSp2˷7|t{@P |Sgbߣ h(/R{G~!Q<(/F4R7ǷN7{Ļe3q^&,nO =AU{$\=g[Utĭ_>8 ϿN` dc bu ǟD-"C_'r;1Dc.Z@UGvD>:˧<Ϗ_?~kT!9 ==7_~Y.j:m,c dE02eAuy;˭^y=YQ/k{{!}/K)11U޼Yoeodk]DNaog{C%XBoq,ơў=Wڷ9޷KeoUĩ*I9l?s?%8u2w`ww)E&{ʡdc|-\h-a%[V1ϼMY6庀R2'}R謁2u2~ MV٨"M|!QBp&0u D| 1>K6;(w]wf:KX'W>p3'qp >U.햱 j+?eܱ.Z3;wV7f˚Z\ yk=^0{uL F}E.Tn½d6|nء Wc]-)vA=Y|%M LCU]m񱘠080k8y;aUM {sSa$^8K\?xf_rwM Qk;N?\yũ$촭Lхnyl3MD`o| .\q!8Lg?c\XZ}fz:xr)GD]R-\Eγ1 ߖ~|1-*V6U2nreDY屮w;t|rr:w4y$rdU.++Xp:ED9ϳ!n)`LwA(OѬD1:D{, Npl5qr B]_U1Ic*ܮ[iLF߰z蚁#Hh8;T9)쎀qG4,ҳܝA)H;L[Ö Cp=NM5$tS..$"H&z ֶQe !6L88 6(\(ùpJNl^p<im0+F&!B\j "cʤ^OɳԂ%Y`yhH׾[̍ ,MFW?^qVX5&en0 G^4NG` mZ"׵uo ym 8$_ReUOfܝqhFxz FS2l^fsT% 2-ġ,<|0zޝf!9)VE05.lz0|,k瑣ndѓ Vy96\a_qѲVXdcU=Ɖ:tDt-]L/-q ujW;^(UeUC&'~u<4bJ^B;hYK=Lʽ㉽Ju|"tF,t{_{uTyapwYS@TƏeV ,^ Y檽*vnD%}} Zp8Vo A٨Kml|Nj8qV?D_'Vn1Ί~l˒FMV?Vlmx2xGw(#do6$K/+ N);Ro4$im[ՀB}Z'u},/Lƪ"u:quh;V0C Gw|[@|oq7pb&r&qd;ِRr,V+]-$b|<8ER66hjh_s=Hvy^Ⱦc Pd6_\Gl|}l4"6#feuIXAᆗY]Pœ/g:qPLcQA:kT$'HKSoГR-+) M`qW!6GbjXcz;16 /9t ^x} #~<לv,v\%ۢ#2 s=>X9{l5 4[7aRV2.gQ-Ӓ:#ǂ$fU&VfDz6ʹ. ~=!NMIJӱ)ѫgsxxi.AXeikt}osf͉! /؂;=cbw@ʼn;B|`i)7b @:3vZˮ|jT9f1q3H3ё6J"cw\d,E/Tm]p~!A8,o\Q4pA%nv1J1߭0e_^O^ fUm)jiW9q5*u\eP=5?_ !b Pjn5m=yyk%NSѬ w UM< aԬX Ŝ'   Rt\:af-I0}=;-n[Fh!+vK,NEJ1gq;wг;_{pqsWjߝʛ9*2V/Jl 3pœwuƽ88͋޿<stsBƄ#meK*]sa/|Suaum2Aaٰ)~Kڗ<M\4;S;-/Na^XinX9K>./H[rs{V۶h2[vH LJ_stɎ0sI;~Nvj_*zl-n Y,|Usx,yWcQ9vNyp_eGgzlnOݜ;3χ]TkpVrt1K܌/{`W/嫸|^ ;' ʮ{ĊGkXb~@ YWٹ{3Q!-(+[>[y M^dv̼xڭ$+^HG< hH3*;.Nx!;w/aew^ YgĮѻ^p g7ieݥ+#yx(oNzL^HF4e mM~t286nW)ydT$񋣬H^y^ߧq|TPleH;g*[Dtr"xcs0\,[DnO D,a"GwCϿȎ_#0Apڊ{0moi9ბ"E(up4]D)]gz9Et."ƍ" h?o7xeğͯEvQW}cUJ9{e1Sd;ӶF;F^d%\!bxCH6]4_\.…,e"}yBa.,oRN%}p%f/ ӾWj3ospI&3 f@m;f@3+e1R1R.c,?"1Z 4 R.bP'cmIGwZ?G*Ow#CD-J{¦ {WA%s*жO8iq϶Q⯵oq)y..&%D^"D_ t~j=LR37mIGYo"Ӹ]kƓOOS,S|apXY}hgIy|Ȥ-r̶Q⯵oA{KЌ'Uh`BDj|29(ي'H;iqgy犴^Eڧq$Zy??A)U'5%ɧ6JMZ\ÙmIGRQR]H߸__]IWJJ_^lcnL"`3ji;F'"IlW6K5zhwihGXOOzGIMaA e$zQ=J6y%w7f(}ґoqi.yltنOƤI;TP蘟e,=AВ6x'I Gn q˻Su$td2K#apO2yL{Y[+)”,Ɇ*F cl{3{d%Оǭ2uI#Z(7FI4wl%Whٴz%~`Oh.Y,uJ{:0@8|:T(D}dsiV9_1|I ~9۞t:.=tb+rP]GdVܱf(B=1%#sZB۟TDMZ䌙m_kZRM?؍X'Pďp-QO#Za7Z6O%~62X,f^GqLM\n1fO/Q &d#(Q-譾@iDaOv~¸4F־^ǥq|qs$_JRaO*z'VKhۤ@'&~6Jt$};u\J{na79TdR$3wɡL^aTR2kuFEmGV;~q+IǕh>%&L*0?i;'mKsJc(Q#U]:<=)bdSԢxFh=nmۓUcI̿mL:B߬qi.x/>RƏTo e_x= j7az:` nhG@ؿD*Љ{BdTs⩾O@Z>qd1Uo 5[ [c;tBmTuuPHe5i;@MgYBx?~ =(gXUTR"T@7o&9sQ iqg6aAre^H*%?wf0gRyxC7ϼ^ 3Mw rhɻ @ S\{ \B\cY;B*mnB1xљ pS}]nKMʎ UBܼtEwݶelZ gޱf!tM4#i%ذʛ!ݮ3ߑ}Q^ɹt{{\H 5'gs$EJ5]gYdLo^[Jv%g2Au=P`t$v\ē )䋚wo܋fؐa}㋶'Ow渞 cۉ,Z B%Rmw/A297nsK>w褙ޑD|9D1e"_q],Ȋ!kCl.)%ʍ"ĭF0"k'C/2w*#"v˛$BdX=v>F%I"`h3P`+U[bQ^,<\B}QJNL_mQ{ !kgT5S^GDs{`w$*nwlCn1:R!rO}PS񭸹N+!/|5NF_ Jޑz;87 XN$haɄAɫp:'rVH wZ[Xp%;ݔs 2+%/hҺlWOn`:lMZ2~\ #~l4#HrWx.$*{"fri3swaF ²ėqΐy;E-d$AzEG3qr%ev {Ʃ',` \(vf2͵s`Yge=j"Ɏz(2+o^Bmqd;AP6i"0{]p ,rW(NDK[Օ^*|"=e2:s;l/|v>i`y7&uKfȢB',/Ӗ eqxo+;{I%QOf=b4~qXoĉRL]AbH 9z>51d9tuBI`Sm<^~זv QGv۲'ZX"W=3zԱY%j[Fz(N3Ewx72{^z/3&Nz7&иg9x9ka;sf."!gscs/sDKFm;#=X=/WȘ=P,Iae]ܿx5Q!$ xC) "pq.jwXſO:fau zI)4eVcͻǺZ]@Ɠ`ai sq[!6EB? +Q.Tnd[#ZGeܨ't*#"*. &e*b_ZvBzj{AhZ ,(`V]rAglz֋*39A6 ua]Y7ƣ0{2 \˛!.ȅנu xfu|81FE]zOD\*'߼.v+#%wc ~I#?| ks;X78fC$cqmS0g9`4gVK,oQ n6:<+B%GO6/i8^;N$c;287c*Z(;bGfؼq  Ǎ57bvI fp,h!u9lLMbs݉׽cGf7%F&i *4ZJ FnroD Fn_UyIIkqzE]"U"k i =adbRMƑ6I>ũyER <0t!vI۶4xF;J1ζY2=:R=Abùalc,O+G=UU'pζI}k)h>xDPOx4%gHJ%m)S&-܁<^oq)y.'ɘ%[CA%"MZ- ד7MDv=9kV_)hdቡH' Dq$$HNV2HNyWhYbktUPKF3d  ʠ{LfZ 5 ul{1zҞm3*t\&x??@fPa0ҟ%GB;3dڶ_7JgQx}kn&@Оm0$OviZJEo'SSkL1Z-šOQ1i7mIG:.= ISg:)[iģ>2-R8Iev4DpOm;ڷA=djn FJdВA@fzNpɖZhf'8O[HA{!SwՀ딩LF$LmB!MjS 1Z-mu\m`I6K5zh>ɡ },CeDYbkzf0Z-y Gm^ǥq~;L-;5{E<">Q;M'׀w wǧTs@ۯ9_9(''w:,7x7,CbLkY:j%,ZچVQqX1E} N>:-G[ vCT73M6G:lٰkAFQ?'\x~?疯4~?gc8ޓߏG#a?lyB,v'G==}P}0wO;T7}Dđ_[UžDYR}׹IwN_8 z{4,s(>#LY|͙3g3:s:_9Ӿs:_9Ӿs .0-s('"i^L2'O5>xo #S=4Ԥ 8~<\[Cn`8gE0Ag*! '֗Aqģck \utC*R8w<]P9GܩFcg$KP7ў `2c6,VqP8>ROyXW_Uy9 3 R3$͋<]F.} L' ooz'@V7)>J-R%RF(*!/H烠",gF~qpn|.9m `yFIM-Y]M_]La|c] W2M| s..\}"]-r|!*B\ 8 > ܲ=y7a"j%<^Wq GMi-?ŹLqexm0$r az t-vY!pŎXݢ rvsa $= V^p^QFOr]z[Uvaney9ԫq墄3ql6z)w?hTB\7ޝje=190aI u 5%TsIրHy)z"kdoXT 5/m*Nҡv73NSre_6Ӻ6}e:{h ;FtsGD(KV V izjգڧ=/T${p8I6٧\RMޝQiD-(oqoL+κ 7YD5n_uO ݳHRcXZV2+G¸e6+>rC"?pO/w]~{/'?ZOTϣ"t/A;eYQˎ.tlm!q6ӄ/l:w 8GӌwHMBqjxδAlSܛY-RE5Y7'ȳ9z#3dEb\MF?c96ۨ'#f=C¹H[:i8{]O^$/ I~o9ij9J8몿?6Jc 1v"CS+.@Y߃q)xWu H-C{X+X7o{ 6 uCPMmGz2$\M7H Ҽ]X_d=O#m 9!%D|K |ӎ:#K|BT:]ۡ SL<ڐCzG+`G'Cr[!5>T)nnei뺲Da\Gu3oZ ֵ޽#dGwq_˰~=T_fF"ʼUBʽ[Ȯz9dJVFe󽿀œԟdC_~š Y&\s޼otI+ [HaL>x#I9Ѭ77dݳbG!6m916qîNuwFux'oè%:KW~ƍe,z~ۘv^eěX^\}72n!Ïx[9&ڏD:sgwrB{s&VW>f饫$X'f0Bc lmA ~،kdtc} /RuL_X@U"6ű/f8hՑN?0 G>0#gGq0ǘ^ijV+NS WB6:ܔVQũXtZb# n?=hYJhA eY!XjqqtoncڤuAw)S,U ]A c(0py ]鬀V?)6J"1)]afcZSk.:НjaN-Pޟi (O`crmtVDQrF@U[3ҝjA y+cɂ[D-. Al*]A>VGCX-rZ\Ix?=@zECLZ  hR.oSFW^[ebѝjg d ͈.37aPǕN a\/Wm VGCX-sĴ#3dla5bxdegۺYwj-<#FB:>6\PYn}j-Gt+ֈ?=@ Qh)qCk#r*v$W]Dk>QX-_5 0X$H$+sgBmǔZc!Ԁ=M-kTir4Jw2[r_XpzqHuߦ֦MiF >`iV}j t(.&8J0xo!`X'}dt, 3*Z*9|i6}{ Y5~ߴ%X`O*I ^ObZI̜%V D˺r*(j gڧ@wW HːhÅX,/ZV.Fg9J'ΆZe4c1X an&|J Cܩ|+YYit,TCi8ȩtHj1a}j t4H8~<8ENg$itgmUP`.mJ[etZNc5݀n~z@u iD&|bRf-. h?i4:[v>QXMƵ "DCߛ uP.8jm;бV| Q)JGCZ޶? 0}@脀[ #c u qA4tx lp j9;Ļ"gA9}$V] &jXئ(5@N]%,m?&4α 5=@OQ7H TX0獢V' y Ţt ҿn}j-Gt PUD jYY5 QSA}(S0Oh4VYGڶa'J,`1b#~ItFl* endstream endobj 121 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 127 0 obj << /Length 246 /Filter /FlateDecode >> stream xڥQ=S0 +4`GZ9hnWhe.w,žl'IFXThINBM0,zUdPhq4:Ǟ~dv2CIh^ͧWFhk8hԭvv^q߲Ǡ >/ProcSet [ /PDF ] >> /Length 36 /Filter /FlateDecode >> stream x+2T0BC]C# TH5Tp `M endstream endobj 130 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-7.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 131 0 R /BBox [ 0 0 468 324] /Resources << /ProcSet [/PDF/Text] /Font << /F2 132 0 R /F3 133 0 R >> /ExtGState << >> /ColorSpace << /sRGB 134 0 R >> >> /Length 22531 /Filter /FlateDecode >> stream xM5&_qU&#a@6`K3^ QWnIۿ̼'xo*բ[q"d2`|1"<wϏF{Ěr{m돿C۶=bO(g>/y|w8?}1<@?[|S{?|_~ǿoaMz[x ;o<l?~/ .o[GxK7{ĕ@Wz&rJD qFƽKl-\)Szk-^)N-~lyJ9[>6R<+vh-o4m8aCRGRƷ/_|Sxs{K\ފr=}Pao)_!N3iاq>^0'|>-<o'_F>#t o&^3/t}ɭdVM?mFU22ol?;~X梸w-RGriaž<΍T㭥:7N}ꋾ.OI_#}jwB꫾.}59}]?3y_h0vץIcp|ץWb;EWR䫾΍Og{j싍?T T_uiܨ'}]?J"9՗6w/4nT_ui諼xԥNv_hܨ:E_Ə[߾k (&6 d_vm]ȟtwm+Nrtݗ]?}q\?ja|ݟ1t_wi\ы.tQz}߹rϵݮ|ӯt? yOuW]ڿЩd}m{B0ƪ_] u]e OO"2H]'|.#'~U#I>5\]ӣ2e>qBǷfٳ-tIm)|ybpCO~ |46D3C/)..\WQ N&R||^w8˿9Vζo=O?4[1.C> eľp sbGÛ"e(J&jGd}xȜj{󐱋=+ϧvuxjof%+>}`{.쾘n/{fKFv{[W ~XNV|"^X[{z:,S{ V웟pYY1 ;σ߿oe1iYO41wJ5J9j``ep= f)/ #q^[xdz_䷶>+gsd럷z[zAܥ±b1EJid쿊W 7ᠸWlA#y2S8_{1cW*]BvЃ7]^޸_ő ARا\bKs:ۯ-O=!8;6[m jXbx$/;*<}w`쨞^9/;cSV.}el~"zdx3酫y6:_oؑ0e=/N’>삡s^\UYoYwdc-&ll .8uɂHM$N_F60'"W-9Ŋ=d~߄ 5yCWOnԏ@d}cW4+0",D"_}-7ua3׊g(޷xgm%tu‘P8e:|m$ܷoҙ0 fIc\Gu굓Ht¼]>f/];J$RcTO.бYaj q/ fX!R\ pYHaߏ2c-}Rޙ*+?ZKRVv^$tߑ>ڥtaZuf"eąafrNbf;w^jRp 9Y$Sbpw3!X౉cul}ʳ̻1~V+D$8[/H{[\C{, @`;Sz:< ѬhE_YRkY":w5bR|8] VߺjN/8VM\a"Ue[9v~JLtsRZZ^1 )z[Pe"Y.9?=Òvz_s)7o|V:WcihaK"/e}׍ WXy)sd )εLm;R4m-鱯'pܾ9go[NuݹKaыnzoE.VPh"ϰt ( G K̵UuyBjpg˚‰KZ}+*`? WFk@GX7W*8JKA6/7l1!|*B~OYt0n1!ƕ+f'뵉[. =J$x:^68Ȯ<]pmoVpհ4WfbKfS-;& \}6+ʮoOc&wy-]>Oъ;|qe[iO+ϳrMsf[p_X1,O1^Ob'3̍Pc}=e$cɦ(w+ͬ!R8\~}T> k-i<=v {Y'ۣLL"-|rHkYXMLF=f:B;~< |MfDnVhg6yu2FZqVhf.w[ 0mz{n!HX~oF2\j_7Ih( Ҽn'0,(7rb 5U|1.6TW s`[4W5bo̟(8TG|O&ɮX 7҅3H8Ǿ;k̘׆`6PtJJ+UN쏩vxpc.Y RAP*^1nF P8U2L;#^bLG*55+\~zoY@Źu|3/Y& Wҏ0rK>Q?F…w9rh')+y{(uUdf7QbJu90F[ 曦_NwK|V j‘|&^?s~|Vyӏ3qu\!040.*~Bh?hN`*6>ł2_>}/uCX< |cl~skw; ߩ1J.VKL+L˶y#pa{/o W}c5$U#?.ćn01*>ܯ9jN[ ` FrUgV ĹI3Bp;6te~ߦ痈pZ8GaHRnX ͔x_f뱚?ψ2&0gj=~|k"iLO>79^؞ e>qed}q-LKhH.6qB`Di si : S_/aTׄ)A%ml?o{%~k7yW?KhǺ1<yf*K$\3" $asO}aP)%E2, 2PAHVG?Ck<k A+P޲-a|ȡ?u&/-t8c坎:sa,Fa:gᖱԓH2>N3$ ?gHNQ:CC0gHNM9Cfcԍ7g(2!a;sS:Cܬ3$^gH`|Q!qsvn/rj>ǾS¼ϿUeNʥc7<+y_E m>d-D6 >}+^ǥq7|M!F~VT5 t"_,c;hamڷu\J{0`.a:`Ö?!Cn)GFې%&ħ7`"xi/w%߯jѭKQx1| e>=ʤMζ}ӑ블֌ƻ2ism@|z3߆ e.)[lb Y@6SE? yV!ͧgZͶ}ӑ~u\J{&p)"T9ӻdj!'q k~~UmN4ia:moϑ}+^ǥq~P;z"Rʒdexeitj/3]LmԣquӌqO`c@9qh /A<#V!mO[Fnm@S?Ki69z TO3]M+T@=de~P6SZBlO_2i;ZۄLʁ#y&2fA|x?4TDYqp%R&AhۤAճdvٷ\!øM00U"WHx @d$dXyhkqo⏑ e&y?b"Հ3 2 Fc;g$v۩j'-gۀL ہq)y&dʙq2 qٲxLy/DLe MNqe -8l־?G ]ZRկjq r!nT**bˏۏ?y[|,W dϸ, 8ָ $ E_ u"!n '{O}xDexiV |EI,.TKMKDMhuG'R+~7B*kV=P01s~iؿ,DYge{qV#> _)7OL2OnnU/7=ҁ'xdxg|cc7|yaßKnƫ}`Yo3B%mP4L;,u"/G"8-,HKɥq:O:7>*4O:7ӾCO}K㓪m .#DF/b=n'W}]? x4>K=oesh}]TÖ}]?FYHק}񝊢;s㓊>O:7~5ObǙR}ץI5x{ץ/|w/4>}]?]/B;eӻ}Ie_'!T,:7~UU_&X}3~}۵SwIKYT/?Arm'̵N5!ct_wiDǛ1._#_:*g/< AIzmSnvN.{t.ϝ躅ߤ W]ڿЩd}m{T_sc/lKCo+,yzue;=qO=QqKx.#ܥf!ݠ\- kg,:=f϶jPnYOO FOh$ dN:=\'Ȏ'ް&/)$8>~^|NI7m9㦷|^wkc@aw)BS%y׺}y4>ua×y|/qq7b-> @YAL'Ś언Y7']9UJˑ;닼dW~wf;/&Hۋ}nzGu] CkN w\K0ޯ0^n+̪n{%Q5GΩZsBH^iM^h*j/ _|!+wxe#duj2Q\6O!W[rhͮ.E,Ԍrxy;qQP;/K.gyvhfo=*BnvdWc{ae ̟%ka➄$poH~ٙ\gD$[LWI6.,(  [R ="]m싂kr4?'^gd ZJQLj ޽Z։Yq6ցB<`Zw!ZW f_ɍ\dI8*Oj+t ?%X wU^;$ü={? %'ls k\bW8Is/H+zm&暫nxj!]1RC|zh1Ց;'"Ϙ!x+ENwYwA HA[Ȅt;+8ҹS'U{|q?Lylc5H¸= r.L af3c39/}%,Xv ~EPςuۘQeg\-5))%#gLZqɲp^wG, i]듦 nud9V)1nJH4V\axZ1E-b̂k׺ Q%N"bs4] 9rYRs2^".N hHTVj|x:#l%1ROSR1na%<~,eVf.)ڐm)"%J*D+CPmuP4'M /[Yy3= 7 Jd9 ,}22о CFi} TŸ}VkB8¦WxMW{Gd%^A~JldV#p /k<%!ѶӢk,xEpخpT75֧+8f'⢶ݣM?WK>YNp` mY=tb\hO |#QoVG7AS cJ~xoR_TbDE竒[OiEwBP g^eqCn}n,N:G3zYلY89JN͊=Y71@}'|X\6jއr_b=_N|hV|vJ,^xydZt F"Xfpgכz /]σ`&"׻Wf7yR~;lL~Û~`R,+*,Tjw3]܏4F-XZ_oHjҤ_#?Ec +}~w.k&4L!-XvNh*n>+fueXXϿ@&ADg Lrax<6Z6_PwvlZͻٷu\J{䉽%/ѥ5mR6vTMPK ;FKmӃBf 7mBt$zs `/hw)fB)ZS~UYv˟ZTV!mE N-X`gߊ/vUq[ҍLy2*;MJ%Z]<%F;![5 l^w *oovqۻFl/#vi뵔BVS52J;]4Yڰַu\J{T,.L̏22 iFŜ=j/KLg۳ [:.=ޅ &/= T 08h]i}LZh&}+^ǥq[}؍a~riac-Ԏ*@VWX,C+gWI l־?G ]wFa*Y'x7(7ii`D6\OpBV#U]ԭZFqo㓚@h+^|JP1'mF]uk;Ϻ7~uV7[MH-3d7i_uI! m jLڌvao블7is<MGҶR]^֐_`ʡUWiFC63c64~"l־R]4~P* JPĄX'I -h,2nst[ۄ&q[=d.EZ1xvyBZ~F`0Zж=rK;ħoϑ"b8|c93Kꞇ!L$iI3KHC=Yb'$",YYqyND[R_+NN5oW.3~>ӾP0lHtBKA{/ >Tɰ 6mf*7,`3,b&:a Xa7Ese#|<*UҎ"BZoW]3B2eCyk'Z4t9a5*SW|E'x·x'| aZ{9?bQ7|f{.m(X[x ú{ieǿ6%MRpֵbJ7-_#~< [zHx>%7f\2ͷ.d˵ûR ]SAajȅ]aerkvBn2]~v<ٮӒˏ{a&쳲 Yed%n~{2qrTm^K}'?6$.ƍPw -B/1^ ®juD 1{rs(ږ"k#/0iskܹ^lY<~.@U;ȄI/TN\HE{s$$,}.7+K~ɴn 3,Ɔ%{߾6f;>SUԪ7U` ̓UwA|^k-}e72 s"w6矏8=>dz)!3/Rs5.F]{Z8*nmKH[n}:Bn/>VP)oHkuXKyvci' ɨksɤ o eSBMeEh?\s!oK /1B?/O|\-_WMn{yb %B6svBּ7%#l w{:Wk OL ϸJk= I"f^*sBPE˙zgoXMR03V: 8UgSٴ^ uo #R-ZseeշAn]9"ݳ ɟ7.kձt0UݭwKe}{x<ﮦȯwH޽Xh=p/~NjrnַKr"|JU_ߞ /ε*|ȟ5ܷEhZ7{.֏b+I [ul,ACvwΠKr!$.lL2zg e/_;QP }Qd:_.ۜw٤Y ,_ayw(}lrj^gψ/K'[?chCV`_#:<k$j"h}=qM0܁9źVVÕ"/t[ؗ^[9$\ !/؀3..IZ˰-ͤK]}gԷ5b'N/`-,$^Qi" 풗5fٍ]c=2 YQQfבM?#6O$RkC]@ ^^,>Xo((j ٧6"U/Ӭ[ٺzXR/cT2ʂb͛鮷2/ukϿkXɞZأ땵ܷu%S_wueG5yߧ>Mȑ<w[Z-s7puQimڨ^.E+64H?*Ԃ=2.ή c&{}l3ڢMZS_B o\Q֡óИ|[lQI/ȅgKFVnX\~UeV$#bu'gSr|&{[ Y7OxP³ZWY8 6F+XǓ-ֲD3NE{rЊ{U}8gڏXJEE0nߚE\9yϷM%ֳ6a$Ub̒ά"\5[Az^=V)Z9ժ#F$\h"8׬M#j9T[ag+xO U>d8M$5iTpY>;+3qOVZ=٭a kyaC֘0!4qڥ=eMAc\ `RV`z'Yg={^V^U`FSZ;"z"`jʣ~ .T  h-7tTe#N5jjUcT+l béB"i_ ݰPW \Tʲ k ORNbB~mZQ"qzi2x4h57lj f`g-=&jnWidjyWkyXXOԕ:X$LVD58ۊ; JU.kZa3aE ]c&7V>\q 4,QnILKJ㢜KZT0V7 VzqDu;:oIr,/l&^U4Pw}6m0lՍaroي55`Љ6*ރ2/q`!h`>ېՠ`l%̃Y0}=ZIzT٬ZA?}+V{ekG0Zdu:JV>r }Ĩ,:xj 5\^hYᎇ<;P@۬WhV~c$\R#^[]xrâuwG <֊tKx`cV=l0"AYomw- Z9Uop%6`g$O uU- cN`#JR@.[yK*B2 *j`WAagX&g`m~ 9*˗tAKEГm;B(NKL=h)!WH 9m& Z-  t. 暬gІՒ'o*]WUzYx(}S+סRh $#nZ4E1 _4lZ2Q/AQ9틺bkk<{Rˉ%],*س`vЋ,nXYYHe4Y<fK ΰ?7L] bB7)Z̚$ b;%t?Yz> 'he'hz8[VB7)Ӆ-rXd+"ik4۵|=Ox >'xD'x(Pn,#?|C1?N]0uM[6-&tW,KUsE_LV̫n֌UX/T0$JR˻7Y*lIi-&b1wR*R Kh5{jax :4خEץ>^ ѯT&˸}K CWEfP֧TV(|=%u>:"4ʱ:l·.(&QMCk#YwV)W$:eQ:M4:N |Tev`rl BFG`;JY\z{{N5 iV|7 wJPJpezX޷W:}ֵ?H25XUV$>4V~HXU_V+UpubQڂ\Ò%Y*F8h4֣{]U+ x,qM$NlJtЪw0 E[%`X6c=*lzv/`7# ؎(7H1jS@VҝIER:}pO>(iVAw 56#u⾘@V?luff+m}*ֆXm& .U3bS(G&`: Fs#Vg)v5xUV14V>V D5KH zl#t RKR[%`%f9<<ժ0\Em&@ zYCZ&~B#0 H Yج)@w^~amV< $dMdXffQ:UjKe2jV֧b9;Ն[L5ֵ"k5‡PjlEXaBN`[aF @T OcRՎ-MC&RbQ,lFGR(CΌVN}*QXm]]ŊXԤe2C%6Vʡ%7Sb؏@ h6kkhHws~!7Lpa<Ya$QâN(]F4)IimҝzXz,Ҝ^`t2y(`u9cXlZVQ[[mJ`^&Vsqnbz?B76eިXZ KV,?}*QXr:v[PUNyb^G;6KP:]V|pr4Jw`?s MKKKN {FW4If'ltERkLa9;H B]*[(Jg⹨69AG Qj:+qLl1;t dS~ŔY9>#s҂L7HqbqU{T~@VHC*kX)hSҝj7e6&T2l=&{Ca0:Pm)t,Y]T oױ˭k(iGs 9U ko@ YMb9>ʋҦt^6mEh4VXz?@oz*JNsJ6`+FG LΩ?l*N6ҝjQ g` 8̖4 V0y[t,?`^Ck5*ڧb^i&`Sd~hEqِPX IdXXcQ:LB %AZa}*)&_α7X<]?(Ru$!5 qt0.[y !y:y|?Ʀ X|<ậbY+Wf\]g0)4YM tj[^DDخn¡#1x} K??"?_ endstream endobj 136 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 101 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-8.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 137 0 R /BBox [0 0 451 305] /Resources << /XObject << /Im1 138 0 R >>/ProcSet [ /PDF ] >> /Length 36 /Filter /FlateDecode >> stream x+2T0BC]C# TH5Tp `M endstream endobj 138 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-8.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 139 0 R /BBox [ 0 0 468 324] /Resources << /ProcSet [/PDF/Text] /Font << /F2 140 0 R /F3 141 0 R >> /ExtGState << >> /ColorSpace << /sRGB 142 0 R >> >> /Length 16811 /Filter /FlateDecode >> stream x}ˮ-9nE92 t.tl[ uȲ-E*bѾysBC!Q$Eq_?=qԷV{o<–R}?=m{'$٪w?˟~o?_dŲy??_X 'ݟ-4W?o?^ޢqoo%=!CozmoJcs#v8X-3;T/|i{KX~}6=*e[ WH/|l`ua>饾z/sg?ZԓQB >V_m[^cJZZWv' Kg i?X[0l*(.žII_Os:}=5P}= koJ_>U9Z/60 [?>q|nߣ$;'qZ>_Ot1m??>|jߣIZ\ge@h+]?Vx[/6β"ַ=_~q_egO/~v͕.jLH,ۓvBϹSg[)>)gc"d᭨lu/D_t` _|,Z}P]؄+_OL__!WAT s,*Zhtu7/y}?ǿ׆@!:ݏWeshVmWoMXw铱a};0}*#$dܘoS]h1IR'ۭ ]:^K16KHSW!O؍l]bOk-!#/vT0߿Yܤ3YZZ,}=~v2E ;LFK>nߤ}uKwؿ^',tpɧB}>hh(ڟʂ 8S;*۝d=K\Jmcp]q(*ə1+픆՛3i!@WGA6>]Z^?xفᮏHckd?xs/nbSv54I&D}ق3MVYi1?a!`plBUMO&{&c7vh;ƌcR+T ,@(·Xdy丏|x9E_T9u9:}cOX4B,aj>&oJ2-[!vͺb0۝ybEeϽ({Iȵ;b6`h;m"6!H Ӳ&_t:f98 Z*[><`Y/f1ګBBfyƑr4g9[t m Wݗ{e Ӧ8E@pq6U-kvgȩ%Ǥ+آwoZn{e7CHN6*x:K2`XJ Y3(^m\Qɡ d V6Bog&xFZ=mm} ,-<5.(oquJNrW|pf?.ڠ=o;}A&2 ʑ39}l;պ] Dyx6\REYfq$[JPGfc_xojڍڻvܻ7omry6ng9V.c_%B&,tulG=TVnM7*z?g%+G^ 狄Kp}ǨN{l}vrهW+8ɪ.ֿ@{W'rk`ip3(My%; K}/kh@K0 S ]ʩ2qV6i4իXOMo49yu]Q4ީ 4$玣VխμK0h`,.ԙU|R A,8p}Nݵ|Eb+%ë>.v9" qgp ҍ>Uqg;Љy dU̅)bʴ{]c4FS^ЭTħ_Я"Xz e$ ufV!|PQ3nhͶ0VBr"/g¥@䅽:4W+>9QV)T$`5R`nAҺ;k =ַx"^eĠ8!Nyt9Ÿ:LV3+$^#WJsC܄aN"Ԅt͆'T?%jxAMdLrgx{9#xD vVFyyB,k [swL؊ff\A8,NٿgAD/g҆s4sP9g xiLΙL! zJɘ|4G gkw_vسjxZs:6w2O\6\Wl1daTeo16 pznR"į!gs6,#1yF'f1Js@Ӷ/Jz]WuUñji(g% :AlA8"ʗ#DV/両I|fT"su` oͳY!z^qN{C3DwA 7/К[SG,`rs!:vY-p 3a``p% woMeXZVf̠0٫wʎ @49RW=l6T.Ozl(mNlrWj'{EfnιːOPسO"E,܏`p5G4ʘ@ n;Ga%Vܲ4s'#lq8ˣB!VW_m(]U( T݂^\[>(,׉\lns="TB2C1ē螚=U8I= ֈMFqG3¼F25 ѠN8',/}826oqQ@lqg7en1?01m x9vĖ/ nv` a8EX -_A_~8ph+c+' L.Bע4]DL)]Gz1"p󫦋8J"cc1@G7%O;vO%Oh~M-ϒG|Y[3]HWo:ޅ˺H?m![M aaÌ:|골VKhߠG,ɗ^ob]IATX/6#,d",+K>A6=E=Eh/IigW]jE88dޯOVv}8KO8%HVB=0h#Yqʗ^wi1`??gt$4Y"wE,Q_`uЎҦonOp-u"bo=>ٽ^DI(>5 ϸAR4C#3hQҶx`!g5XZhrW]ۇ 'k"%W-[&i6O6Vh/IkgW]Id'YLp)I>&YBg hx?0h#q夔^R+.+WwX&{V7WZ-m>*f\YNo}`(C'If#ٻ*(;QA%mZl£mk[/mߐɠI q1%whR![( J;JA'UVf J_ݾh|˻Su$lh:K#aE d Z_MifiO6W1Z8Fۛ٣o+ʷ9 !'ro`A_gaZ6O* dm_oWNʷ:@j$oRN6ÎJ-%#Ԅ~[i5 !OGZ|)ouvHAm}CX2hv-[OwMv";{A{ ۙ}kW>MfQL푝s#bPY)G>ٽZвĶk}R"f,=ʩ^6bV͞ )\ {I4hD7âB14 {0A h%ZzKi|dc:k)RjԂcgYDiMKh|nr1FrҶ^R+ߦP}hFJ`DMj ?NUZ-EV]]gD4>[5)h|/IÕhmhL,~Uc~N]"s㩍dZzTi|ۻ4ji}{ +:ɦrqCV>LTlZJc6Fɴ-z㋴O|˻rzmz@ !++oCTO(9 TSeٻ4U_(t{ .B]H'AI@U.M{'0է<7?>|jߣW|]g.@hR~:8@/3 q]!@OįB]!_*7s*v|@鯿 H_5 h0B:9] i@_$+k d lH-=C|(?AB 1 m}!>|&GKI*>zsx M{^q owf/$$)+q2^9 -_EƱ'^-^nm^ 󉷜Kq'T"H!Jȼwim*398ZB#$Łi`ڻ˅"+6sq3%\d K{[WKq۶23f "k]Lf8_cA =5d#:wɹrջMҼF:N1ggNIw1}LJ\id->"33wrm~ZtYrdon>GV;MBK߳S% 1IDYx-{~̶I(چ نC,Œ)y=R:`r*$Q,vg'Ed刜F^엄|`=1|mδ03/Bpcފo.ӧc0 ڪ=/̊XN-/ajm*Ѳ]rEŹ`D_H9ҥ-˧($E)΍ɘD$wyLpO ƋanB"\& ϓ-yr@ qI)J@y=t47eciٷW'y;Bh) rfđڜI9_JS[HnO.8f+l b /eG6w/=W+3=cQ;^]ߛj)t8jPKYlju_6e^z E=ZNTJZ5;'\\ҬM4?ͻk)ba9ybv&q<#橞F#.؞(;xݛgtt,YI|ku&9xofs+9CzHf&DBol;z FEcx&4ҚGy3|(%p.'-<\q%ҞS5u}ĞwH5%Gz$D~Ayqf/T% *;d&B u 9uDJ4'9ˬ@>;yf`[YBV/34ٳgv>LbR3W3nax n4q@jf*ԍE'uh8+ҫᏉQ29k:(毻7F8F|`ggj+9ga עCfXhϰXt a2_mGWMO < Yba^ f/υxc^ga c?iQ.\בw mUn8} E,d iqid 9Y ;вĶ Oe⧮m,mʩ^>x G/eMaQ_fвĶ-tB%VL$d<5͎A/OB9iR3[Ҥ~p +'X آo&Ud:rgZBۖ2Opb"~Ћʗ^w)Oixd̒@I5VTDΒvU"IƬr&r־^9U+ߖ,<2C;IY/hle u͵v& 'Ii30^9U+'8j6ЃC$N^%UXުqJklI E,h;i?1^ n#U=L}a@rDkzs5Z-JŞHmPGHm}kW] B$:tA^,HNˣ>2KilO?7hmG_FZ|)gc2c'עهCTSY2H5V-hFmۯI8m|sUIOH(m ݂M$`a*/K#z}j)Ϟ0]ҶoW 4={WIs͚~%/dZ+gO *9:FyY߬7HR< t{ S#@_fZ9(ؐ"h0(ѷ&I@{x"J1H\wٮih@bSiVǯ5 +2F˫F6K_FE'O[G | [gJ2 hZ 5l@3Zbmo6?FZ|)ouv:֢߯O;DXL'# :j mۯ+m%3Cx}kn.@^6[g0$ޯOp.%̱COJGfXZ 5E^6J_ߨWʷ+F['&Nub9юR8I+uv4HpOm;ڷAm:uހ'@hR'rW,tLѤZy'[:iqF3ھyjZ?8SnjS h|# xXXJ멅ж mV$k%}[=2+=4R˧d1R*ul>33j=AՠExsi6xh1X5L-~UF;J1}YcG.l}kWO}ggǐR , ~[VCR\0ڂ85k%j9뫍> #תLJc_} N ;w9H7stp x?_pw|JNV;GFНU̝{Bp q! x3jwY+)e-Zڊ~VYK>jz߂ο d9l "P,e\I &3xl5ek˃fLiTum|P}: W5$ ?9~qsF(>Q|̹]s.;ˀ9WWr.p9WWr.j e,4| *笇t 'K}9PrX⥞ U>N.mst+Њz]M/ ؂Ť>ʉ^Z.]3.)#yX۽ey"'|v#IyVy>ɍ߀w DNyuߨLXΎ.ztwDftFK?= }N&:(n;~d;C s. dqU6i.tlUꜻ 룾|=)RL0jy%,7FOtQ]#֜y锔#?' E\/IBݰj7#dF/}7$N.FC"9Y9KZsouہ=#Xyw&%h%zIhx ^ʗ۩;df'\}.匜Ł qe[E*Zz azK4H{ѲiSg}UNȓ1ڪ{/ 4ݙ2El/ŞزuGj]@}pE/-\Ryw%5ß}C˕8⤿n$1!| f z7 BEwXJv87&$#~popaч l 9EcsqUI^"D1w# 5{-"$w 7;q\ _5o+~ _" zNdLgH6&{#?6#zif#h_,djq]n6f ^{qw*zp!?3"Y3 { aMNa%Qr6C$n@' V| fr;s7 0^*%f6鏷{W.'{<|Q:i|sC4s5 !Fl=!I$r>U-'"Q &6!/ ll`u͐^U޼[ A ҕ ;2uQyDzdt!i|I\h./s<wp*=Bף"vϮL1[{-+S.-'B*AGsGSG}U~g)z#X{!KFO_ryjy Y6OZ ;l<3%L"_!ݼP(tn:6\ƈ.kV/L[ x36meKYbęI[?p-WO@ܬFǟP#!1s"߾[b}Gh Q7w`gx z_80vټf-&/WejA}ԐuNUJtZ|OҬp6/0ZL .` \WpxRO,YJM\H?wuq?JÌЁ{Q$$&ַ.}"h>:mglGgy$u!RΘc l|!׿hR}ѱ"ɚ%w=k'o=omPs>-/t:HxE7>Ή U`O7kg\}p}Y^.~3'(wOs^O&>vW)/|"ӗGD(^s<{pCb)7/cW#>x|)V3~:Ozee\oMnB^]d YS]%/qaVՓood+Nǚ7 9cCtN=8`T<@ϯ>uB%"\̂ؼӂj_Ǫ{é1/ ;$jy=K"';rCZݯ秐~\2cMM1<"t)qHq @9Qlęc݆7;Eol tDveMx_=*Ʌdm6/#y5BI#|1bCY+1f8W3E^^tx{$ߔs@rDQ\!9tB$JC XY˖K}5Y[?sh}EQ⥞ U"WZΤ IB"q0t@B,-ˀ s9_%Pt:z~ˋrlŦ~s RqVFXCQMa4bA0LD(4⤘4Fl# `*RvRv$yf>L6h`&!ڂ]gsW(\GzD2{5 !]\(7%Ƃ78'77|co'$opf\47'\o3_Q8/Enej$SN@1m-^W24p!@U.x-VKn«&@[fIct9#oP -k`icZtW^-gqcҠi~ǃڐU@hJ7lm!`EmHv)KmA֒ᢾY}Skɍ]x4E?s̚$C'<Ci+Y~QlI <)]ffcSkN:]xpfO4!T&@a\,ѹ>ȴtѴV_UZrt^&/_ ?ߟTsp0,8hE` .#~K[e?EZܐʫR+ 8kV4B7e. WKFZgzpAoZpct^}f]d 2{ Lo)jqD:>ZeEh, ` 鮼Z|w\]#.=,Zdx}=[#gF.8M,{<@xe٤qCkfU:-#?>ؑl\vh(UF.Zj8 /S'Yw8<J#RX-ĉѱpԀ=M-kTqԒzBMG2Rr_Z{qjux٦MiF 6pZO.(>p6_$IZ0Z)]@2 -`}ZoϼȲ|PxۍG\`Icjt(U AJ'^f`0(Zt^}s QlHô|IU:-!c9R:EZ(؛h={R_POxOG bs*CjhbtIף @vC~k5 3Sk=]xIW ?=h='( EYAAc+{VY0C7FwM࿕m՝g@-PϐZlcJ@TN@V Sk=]x=m "n&Ȇڝ `$Q fc"ѡV60)m xhZct^6LX4k h EWy₟ѱVS>@Fh'Skɍ]x5G-^w 6DP`[h]O@A[=޶?z,> tB/uD9LY Gq6TJԢ3}@e)|-O%7Jw;R`_wT@ڵ`Xl1F6Tz" %U i^Hϼ~-^كQ托wiዪRrHk*5_ ۉ do'0nP֧֒ÔpWKw CǏ.#`JOJUG_UTjK& 5 j @#Q:@Za@jZKn«,'J,uGF|y49(t endstream endobj 144 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 147 0 obj << /Length 138 /Filter /FlateDecode >> stream xڝNAWj1hg2h1#f#Bw Ɔu,%)NI"{Gڢ"XhB24AD'yQ[KE+ZP/HĐ5:Dxz٪ 3 endstream endobj 122 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-9.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 149 0 R /BBox [0 0 440 303] /Resources << /XObject << /Im1 150 0 R >>/ProcSet [ /PDF ] >> /Length 37 /Filter /FlateDecode >> stream x+2T0BC]C#]#\.}\C|@._E endstream endobj 150 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-9.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 151 0 R /BBox [ 0 0 468 324] /Resources << /ProcSet [/PDF/Text] /Font << /F2 152 0 R /F3 153 0 R >> /ExtGState << >> /ColorSpace << /sRGB 154 0 R >> >> /Length 2718 /Filter /FlateDecode >> stream x[Koݶޟ_ˇDm-]4]&N{q%s|EH$k&ĝe |LN'68.&v~fwB0%MKJ^^y/W |;|իYG(J)S@md.^}?z{sɮ> _6 5LY ~ Wo6o^#_`7^ÿah WIŕd 0B%5+VH uR|++tDYY&fWLf-2+ȇoƚy+34+i)xQFKvK6air#G}3)j.m"l=p7 {("|ŮR.TСb_v Hϼ{NP @ܱXgQͯ&dY. Ň&7'j*-!3˧qZl""-kS+0Z|AYǵhrB1"ܫTK-EEc4u@>TkϮHC/(XUZ|f:Rlj䶶)YEkjzi!h%~E_//Gz#kGz>P#W=[|# #DO5=Z.]i|IGC L\W;\Ek~=^Vy^?5"ʏppQw?^ܫGRcX~q-=OpL[5po-G,E >9ʷ* ֝ǭ@\|K ~{;?ݼ%{!o//eW Ov1CJO =Q]~3˝p4);c^Z<,0Յ 89fq1DϠS@џ~n#6njK? Ԉe\JE5bZT#I "T#QK{yz'a- HB"E4ӻNХ3\%qǾz٭ Gnz GvŲuz'ңYj4Gyxqw>L=cO*\4#Ws~L!#|V'CS&嵠WHb"p3!ڕ1BA}@$אucin jUlƖqoA-Ki3k @z?]?w<`|Tj] ?HSaa醂W/-N;p4tVvKc3ȩ;%t-dNnUR{6BkþbEdw"zln=Qj0vxI wybjOZ3h,ttsi#OȾF+Ț_BQT2Z[cVZ@ jn-B^P5?rEV /!"UÕq#Zi EȻKz@=b;m5Z˵pM8 ׫# ;U hE~3Nh^G/rb0?iX~3^t9k˱-ʏы3׀n_pM=;B\Gz:zpӭc8/z GGoX^/GvM Sg,'G8W/ 4.JN~ۙq-=¿fEZw#wwcb/D,mTkTvQNҬSCg=Y;%1Y;ny#S鏇?F8(=|ܓB)7׊/RxmLQ. +R)ji&. {`Cp=4_{+&ް0*ȝlNEjS![Qs"Ι^"QQԈ >6k]\0G,Dc-ҎdiaUV}w6N,sE"__յιyLgw^_p-=_px}p&MUEo~/(?ګ G 9 G;XY)Yӫ G $[=r:.0TvpkK._/\S#\k< e#gnG9Ɇajfœm|j|:=}ca!,Gp{Jiu(p癱Cc]W =W!3qr" IkH3Rމ_bt,X*i X*؎l-L3өM:UusFnb~Pm0> SM5"۩3>1f[l2>pqW7Qm}=`Z6S&/ Ԏmg2g[(R|yþS+/!_P1$3yPsw}lGߗ endstream endobj 156 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 123 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-10.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 157 0 R /BBox [0 0 440 303] /Resources << /XObject << /Im1 158 0 R >>/ProcSet [ /PDF ] >> /Length 37 /Filter /FlateDecode >> stream x+2T0BC]C#]#\.}\C|@._E endstream endobj 158 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-10.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 159 0 R /BBox [ 0 0 468 324] /Resources << /ProcSet [/PDF/Text] /Font << /F2 160 0 R /F3 161 0 R >> /ExtGState << >> /ColorSpace << /sRGB 162 0 R >> >> /Length 2657 /Filter /FlateDecode >> stream x[KoϯQ:WW {ĆITѬui%S5b=fx-(" 2 t)H/RR)a_Z/zys_R~?JПo?~ـ"#r1@=Q\rkqP(*Ee_/̬֑o|B14]2`fAiD77 '/ %x >t?$,,Bi~y57:u2¬9ANROtĪehN*Y28nJ.R5ܖY$fg;1[+%I͂wC؝ 7r)Z yg='Q,!Ya+[E'>,lO{8 }2W{RI!(WiHYiH >jj*zbCbO^u]lf9pU=C^E=k)bz1pia~(pF77jJwȏ"ig_WԂ7ɏZ WKȫVHȏ"ݣZ|EyՂ4y!#?tj5,JGFk30j%(ҨXdEI?58ՃýQr\WzH/.ǫzzYee-=O-qȿzj$7%c֋cDOccDы)ϰ^䯸'+wq~mTBkcD/fx =.gg%]՞'N\ srXQ|خmc%c@4d3'gys+.V)JYKd1J3u5Q¹nA\}2+^}w'zⅆݽUܼ.n~a2KR&dFj)?gq5'|ŚgnVyX9;n%uK 5$ť3)EjCʙm[5c"̧W{i"W1RiLC]4fW,:zE+Ww׏/d,ƿ.="u6*%fRyYQqne{8X{<%QwsX/W\Oܺ8nGyպpZ2қ3=7U\W3\s=9gb+6z|sYfyjgQ{3YlL9o;0;}̆!sgQC_pnFN|j -fZzn3ǔ788ڛbav)r o@0)|Tw׎bxoNXwZ~Jf#ݑJ>jOCbїV{R-jCb}jOCb_z՞{\ښqydkMcXOcX Fok1OV]sRդ#ZTQM-F>+j)qː;ZK Z ȩV)[GQO!ZQ%_QV߄W]eGQQ%lyQW=^O4$#.è^⯸81~n%~}gX/zM[=OL9:z{)t3,'8-VO?R9rϫzzzozE𹯷~vqz/ p/̭PSZ*]>^6*xwIHwhsNwbsیҹ;qx{߿?^o ;% >gA<{*FD]ơ [cP̬2R2ZpS{`V+`{&=3cԺ  &[ Gw 7:0c@pŠej,3acxOȠ7_1Ǖ+Ҙ^nH3$iC%ֆJѦ飱eFo7f2x]89{8@$CȨ^⯸篸n݀ov\cZݠ+KuX/񯸾㯸z2-܎; J^7?5zzzzp;zt\{ߞB]q_q]=Opd[ Fn7j.ݼ#u]ԓns; g_}[kj?8LfZZa6vڃB?Yf'w CWw%c`*TiX-~sVklQbUiTsf54tZjcH>~DlXVmz/ᓾUTh9뇘i (;3#!ʼbT1:w02,nzsbXlT+O% 2 ԎF Cl*7Kɛ(x'i1[CFPT.%x, }ޭ?# endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 834 /Length 1656 /Filter /FlateDecode >> stream xZ[OG~8o RoD $HImi zm]wF7cNVؒagvϜάǂ8)R4 aɓ2 I2ґd1Ck QX+1<@*&o9YeP 5y’ɅHho[5XpP 䖂# *Z" ZkBKpEm'k) "%\  L &l -@B;^* H dH"-`-ȑ S$ 8X#Dx@2%$#9%F)ȴd WƵ:$Uӊd!)YG HaTLj(!$F] a)9Al"MG Glh &mqX'^xRd5ϚA⊉mMY;}ͦdLtd^ê"a6k݃-v3)F7E3 qoM^Ħȳ{UU(R8_VLGlwk+%1%,vqz)_r8@e&v)Tk:."aY^wڍYSt;Ǔ:KX2LN!K F>y}"A{g`  b n>->LyƒxB`v X&XUR!~1gUHXޥECag,sK.-˭S|P@\壊D_$jU$,"bze#WJ}td͸zsV i+|j1Z,׉H~"j1E2;]$Z/[}:D!tr1Ww^%>jfQ꣫"^c߿ٝ endstream endobj 165 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 168 0 obj << /Length 535 /Filter /FlateDecode >> stream xTM0WX`VUaizڮMNHXm,4Ĝ, 'wGp_N$4,۲3&xp/g֠rgc$]ݕQ ̆P!$UK#8$h׊ Y\(rVfԩJ[T bըId0e2z>ꍧB߸i]Yn >Ϙ:3`VigY#$4eFwξ*E|U˙ee; {E^_s/'0}tePQ·Fu/c_̻>];aj&=+ą#>/ProcSet [ /PDF ] >> /Length 37 /Filter /FlateDecode >> stream x+2T0BC]C#]#\.}\C|@._E endstream endobj 171 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-11.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 172 0 R /BBox [ 0 0 468 324] /Resources << /ProcSet [/PDF/Text] /Font << /F2 173 0 R /F3 174 0 R >> /ExtGState << >> /ColorSpace << /sRGB 175 0 R >> >> /Length 2657 /Filter /FlateDecode >> stream x[KoϯQ:W쫍l {Jڍ lKɯOլui)~G(VHI};ľ1옲Ǥ7|\xvb%`J6?)|/Wz}u}ͮ`^"LbQJgԎ{ˮvۛKv𗫨P(*Ue22Rx߷w-CE17v#߼0{wM?a${ >dlfZf&WIh7WJ!'.d}dչOȪ,+|6 Af08ӑf\٣VOܘl6#V\4q:%ea2{֙\*|}4R'wLh \["u`wx,ƕ#rqb𸲷i >J:& ^ђ=~%[8O}h3{nEdwKWa*jOEl|6>kubk==vu]f6T6c ON Ѥ +EDASe%|a8M-Z0F Z|a-,!_Qn5y\O}D|4jE"U 6A"'kEeDtU,!-2}D % Q%wLskES~ewnX/W\Wp#HOoqȿzM|j[#zpɡ׋+G+:;zƓ.xf\W=iZzƓ._ixf\W#\;Y)?lT]G:.;z ze\dr~EМ/axT/#\G#\ǟDR%ư܀LGpg tJ'ɢsA[WΆv@?_|Kŋp~JW7w^Itvs_0УH >= '"1/a:jy 3Ԋ|F?F?gϫ,TFёG5A?=kUKT#q pC5RԀcj\HOd/H^S{FW=t,e떱ozaem䥮kGnz Gv17qlZBo1y*G 9 w3ykX<.d1 +W|c A^073RJ2pPqUw6',l5\שc<Ԡ ^Q=1YU<r$@"tgf!ܳQciɣfWE 8 ^qQ`6pjNH;q8+ԏgd;*3z= cxN)|KJ.\4NUIrOSr|_Sra ֔\.b; {,"՞ޛR՞Y^R~kʯ0wv'k3d,tT<6rv 9;f)6hۨ}ٟG扠Z|XWa-r"yEu!Z:"∖"X˶<{BžɊz&R?k755sMm쑜Y=᯸~N<^9hK5+G+nX6sM9^9u^Qe\W#=[-\SbDϦNqjOSz羣GN>E~Ӕ +Xqz­'^b7`gWp==¿l3LYC)^hW\DrpۨިPg duTdu^:]Ȝչxwee/>_r# `YE]r7yvnT.5\fʇ'X{`½X]_70g^號+1'G64lfP=(t:=Ι"BPH pHe\|8tk"c4DƂjk`\LYPEfdxWc["_XEF()ʿ#ry|n{8;epycK#O¿#Gr٫4{8Ĉ^_X9kF(uv GNG岵%[%KkvqX/#\OW\?pg.;YP> 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 181 0 obj << /Length 535 /Filter /FlateDecode >> stream xVM0WXgTZU$RH*HV5`MX6ڕ6=o<6#kȗ s\pbQHh$e\dEi$QiYNVP#EJ,wUO=ܞP!v*+U;`^=mУeȦB!UNLSLPL2o"A wWU]/Q)eϙ]KO~ fCl1^_-mUP[@xܤM!Z}<.ZSkeS/v^6ˆzffv̚EZQBysy_qi~ ڛUON'o!>(4)pt4#9(4`!*/LŪDXG(+A@x]i栞gm/C"#lOt,# endstream endobj 185 0 obj << /Length 1647 /Filter /FlateDecode >> stream xXK6ČDM$[Wm!z8^;lz7 d0̓!h%ѫ$~GP̘4*꫏W%'OS <]s^V\NKFT\D躎/V"Rii!A?SnYoEv[q ſ=T\SR2X/ZWj4߇ô9\ֻ}VF+a{\U4}[S[AUE֖Ɋ2._9O%#ENm8OI _v4ln]וmCvMmwA OtBLbZ9L YA"'6@e`~e.48YwsWSnmb`o*בiva\h{W6`GNB -ɝ~,#۲Z1t0 -o>}\/'vNJzw5U&a~I.ZCF!+ b{Ѫ G(]WvaYÀ ʚQ&"PψkFS `Y{@k! RÊ'%8h2 ŸS9j#S9(_bւr7i2Mx".=dJd.ǥ73”!eS.Cnh B8Z@YpLh93Z2X^fn B}\:N@t$?ĉKy |UR񸘠鴍ARHP*2捽sݦȺrP PRO2Ŧ5K d2q̍\'f* G q{o o C%ѭߣ^ *F}F~ɼ&B=0BG0b!@)lj*+Lf$!~?{S ݖ)l#ٸx.MJ$FrvޝNTN3N|:y z[ق*v!IvVLs9stj*j2k/]ӭG!z(y0 .fMuGpC> 5wxj4^layM s4Q:ȃqokO6m t]x(9 WJ^)ԙW DCiaEyޔygH3 H~pkwxJF%'2 H=0C^o*W?H6Q15s. xG&8m K΢"y m>|Z Ȏ1%"!95G>?h-5 O!.“vx?Rq3p5`Wn{,b 33I@4(ׇ.@B9yOLrGUq̺l&K(Dg9L\bήhp6sʹFn8wsb8աdv( Mr6Y endstream endobj 178 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-12.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 188 0 R /BBox [0 0 461 295] /Resources << /XObject << /Im1 189 0 R >>/ProcSet [ /PDF ] >> /Length 35 /Filter /FlateDecode >> stream x+2T0BC] 22QH5Tp Z endstream endobj 189 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp9Sj5gS/Rbuild39b77c9934b7/mi/vignettes/mi_vignette_files/figure-latex/step6-12.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 190 0 R /BBox [ 0 0 468 324] /Resources << /ProcSet [/PDF/Text] /Font << /F2 191 0 R /F3 192 0 R >> /ExtGState << >> /ColorSpace << /sRGB 193 0 R >> >> /Length 25674 /Filter /FlateDecode >> stream xM4Iqﯨ̂>cy$a&dcbA^U]ǻ<'[,kNY'ܟ<~;/>Ͼ_~ݏ_~WO[aw8?܅zrx8ve?w~O_c_zx:򉗗u_o}//]:~r~XB;^2>e2O|ovvX/[i?/,?~p|wR>q[8OeñOg}b|PFY'! v?,ϗeH7N<.t?C:wo[ѧ=ݢOGί_q:sֿ'o}b=}OOOzX.jzAy>^e9ί2WqaÒ;/ہĠ}^ry|?ۯw?tr9ߕ>F.?wi_i9Jǧww ) ?nN/Iruhz!Z?+R~BעhFoVL=їs9S%|d=ߗ?Y}b. 9 gsm6Ŭc'8r gt9˯ÓGcof󬟖 sh)p<]fWЬ}^]yD kp1gԓ9xе3?Ҫq\w#)kpQp]a^~-.igqljٛ㴪燗p;?<+?gG|4h9SXS<i,l ]DSwL}x}mskχc):<<KUvLo<,j+.kԾylǣ8gq-1vu߽=^|E ޢ:_/%}t/ܜۗs;[0vΠl|_:]W/AZ! VmC7YĻ"y N}qq.l>[vh¼"̏E8'y4yYn[kpG9RE$BeogU%&>}t vGrK.?{"./}oqiP-1%&9Î#\xy#'9$ѯsZOWnQ+'HuNTIu٪^O&9bR%]Ϥ:?Ks:*/ɹZT\9xTt= sΕ׹\-+9WRGQk)tٞG%5Q>St(FlE=+=*>G9Z*:WyݎϢ8?KjG%5Q~}7jqn;s`}'#AG`}'aD+}^a>Ţ_}(TF;Ij( %o#$ɮvPm/iq^>G! ]>ip,N\#J=ɖzN_\L%'I 4vA[bN:ARWW%Ku;RS_+cqh^r V8+s/%8YoI*ٟ%*9[U9z29ד58z2|;z2Z@kΧXO8z2?ۓuf*3sU?z*Yj'S=|E >9"S.kh3h8\OF_,չrRCEmoKL|6W8Εڮ[b}[b*|N/sG|I7;%&roR1*;}ڊ^<[.-1kݖ:BoRi&5g\TGĤ,]DO͎|*_={?-jS[b睍A9}wI? cFq[`;*U=[Msڤ:OMsϤE '_a+5tMNZ:WG~QG%չQR$58L'_*yIRݕKjYTIuTH U:'_)]5*E U:t5T||PJ h?ô[ougdy[s;6_eq)Րl% L$v3\]d{Ȱ!9I\#X)r؟ߒ/mɶuaBݦ̿q<e@J?C"vAjXeU~,NLPq#ًd.iLL@&d 9y8 D K a\<=xd:l嗜q/a7%Z~H![_2<햯d y]Lĺ {L$;A$mHnJN{5%OyCrڑyc=Ć|:}UdK.ɁK`a@l7W%>jn208$Fi։LwXY\C#C!Op%[\2,3 <Ϛ =#%F\r2PQdkH%)"9mMB2,p@l/S)N IC@)0dB2'p9ysB2*!dL\e@LHPFI@'FJ8Rߘ!T >Bk$[cF2[08ˌiċ. $y& ɂl'.ʼnFJxɚ8wP$n툆7q"!P2FJ0R2|0MkC"t3L"i"}ӑ;0"#! JLF"!PL텙%obȞcQdb2 (rE>i-#ɩ 1JPbbH^B5$35L#4O'[KFRX<$99: x \ 8RxL$I&ۘ܄+$M {7& VwmxEe@@+7[q# *|"Ĩl *ɩi$ C XOHN^EGBsM`"7#pB2%B" .RIIH3#̐ yzjDSY%"l~ɩp9$m \9X\@9$[Gr74Cl,;+A}gf̀#YGWƕ {] b< o⴨ %߶܅Hl턑F@"|0$'Ç CPę` ӻpSr.Ark0%5aɮp (ܯ"dkHWDA:wyB3@25' XGr*$ND}HEL%p 4*!kFڇ/4 8i|2"Hl 0dDtK0's bHN V9Ap2U>(rz -0#*܁"~"LI"jP~*ܯ4~ &#|H "' EN PzX0YR-XBOe(rlZCT@q&lCԇ">(3 #PvZKnu >Hn<)>IbɍZ5 whF}|Ye̐l﯒UJnp5\BAHU ɍ^5 $#dH"ј {']崙FdH">Hn(Q{ {ϔl'r}d裸[ [dH}xPHl7$7Zd>$'?N+xɄMv{ArB44ɉߏ dnAp$[_5W9Sa  JK&lHn\* ˪.!!Z ,dH]Ard/9DLFkĄU^5$$7vC`#((DAgr _r2$ TPߗ% dHD ('P$[CBrew 9 0(' Q$ Y"֦ UPc7TA֦(S_V %PP߼0R2/K 9%Xe Yz.q:. p $'KXӅ"(ᒸ(2WP  (q$䑀* 9"l\f܇A R JV f$.0$Hf~@3Y%D ^`~ @1 y J'.ܯǸ@~=%K$WP*UBDyBGg#5 d-ɩ΃ri>KNu/9*?ezɍI% 9sWѯ~Knt+(-?˳TP] k瑠`n6R2f 0K$3D l-"r.#&dkHdP>P0'D?bHKC"VlPxy~ɩ&z%Ǘ^RuKNFKNF %:K= ۨo^rA|^#ϳ{ɼUj!/k7pC^r2$C^rXz2KNCz5]4 z ۨ]V% o|3Nv}:%[@r;=(Pըg]r%+/;='6Y,N,Nը;=IN5ۗdP;" Ш\rs~C>tɩ:%)C7/wN1!J8R|)!|qNvU}Ze3Ê=\m=]8RHʰ!9gQνgHiNC`zvd3\Q}hl% ?>rI|x Gx nHNɥz3QaL eLLmd}#9qaw%=Ud}#++ɤxz%lS H@Al684wgfm ԷوGblGAAeGJq$[M5$;b#bB^N#% DsjO;U0|)g>M|2f- G*8r4C@xgFM"!YKn dkI~L_@AY#b6Զ#%-#( 9ŸwDԷو'1)l0Rwiž=!9o|'0FH|Ñ[+$'SB@u!NdzdkI[gN\fS1\0dHf[̩DS 9{`Z3H%'ٙok.$'e[5$[M5$[L5$ bOHdfeB5$[J݃lUFd/#Br2{"&ٚC RAH>AHN.AH2|.Xh5UyL9%rD)#!d$azH%OFiž aTE쉸DDYH% 2C'+$'sI&vb3O LHeW$ I8R"*grbZP7O..0eDYz2{de3DАlo9+\Yܯ",T FJ9$7 J9VDdɩڊ/>C đꟈ!^H%'hB\UΥՐl/mB V!Vd+Crr!9*DŐlbH]&dBU$'ן L ɩS#+$?q*$[KC5/V8SI#'/0"Rě/q*$[A$'#{ Џ'q*$W#2 )Jv~ .$."]E4"C_1)5z٘ Pd8S@\ 8i$N3Dۘ7!Zf18$'3c?|̑Wxb{9"C_y8' ~Dg+P$'3! a$'D$ZXDYCנM~Df_DJ{X*rڃD/"_omo[(A/AJ{4+v:H J0[%(vxl{%=>7( A7(p$;sxy?~g e$"EvENp %^;%hp<)D LI"EPt 0 U̐"Ff:vq3@^ GēDff 3Fr*E(YAt8`&H"a_ I"w)tCKl!)Ana#y3q`,5h"#ȩuO#!,%(N;,v݋7|$PX[RGr{E旄Iξ/A'%h;% 'pD2Gr7!-EHo)98ɓiN>1AkKvOJ3 |RKP6%)zB>ur; 1L0dh,A,y(ELI)w()%h{5s -/gv .vvJ v l`㔉*0'YG$S`;/jS^<:D49% o3QӋM3&JHo;Q%n.2)pe^QazI-%one["+}0Y0";}rYqV<}9+%h;g%kRSK0Yrz@jl"' KL/6 TzS 0Eve$Q]d L.^ mg gcE֤FTa9d`0$.Lh15YdgBo7Y&fA>' M^`9&>!f6[ml#8y$O)rXjNXx|"zC'#Ecҁ3,t{NXdgșI8ENmX̼82s` ߌncϰ gOtYzÓKֵ7yG$";QV;$QOAMH8NN r]~9pܷ䀄3 m'ᔠ$$$f.D E)AۛF/U/uwEvF]%0oJPߒ͐?Sht"mƟa+ωcg#7y큄8ENLٗC,|a'ܝ|ƓiR~1x;P~f#-9"FJ5pp}Qz%?s9{ FW h^0>a(\~NY"Ψ+r`E>Zrp Fl"&b?e .DLx).#0*ٔ$"'̗9)w>lr]QyS%(S9E\QFbKa-eJ @8*7'*8r9 ͋  @"Zɜ+8s}IyFPhUR]+&*ϟ v,=nCƫ;pW~#Y/4oѯJP4  XXyqsI9$_ >Sp~ "Z?ޗy^9Vp[Ac6)oPMM0R`UlEN[ig6ќ"^A,% 8LEnl)Qmĥ"7J J&ҷ&l%X[IA .^f+yRmSNxȄGR^ q GJ8F徂#5j30t"[䈈"' JE5X5(`/0"#If㋮M2N;葑֠LF<ȍ+4)U:%C ӳ(Ud$H$ LF‘= 5%Ij^&l6)Q)JTF5| ' Oۄk)JEN6%9l0DFU(̷!g$H4$G<;%(Mg+MKF0O\*r {V*r(yR-6Cr#^}GT(,$9Va"0(ٙoEd$P2Ru֣)A;RPPЎpd2Hӎ&#ydNw.JsY0f/ ^>x?H^~؄ %)(]#/ 4r(}aq/UP/fK)m6%9jH2 K|o34S&hf+a u7Vٗ9բE|2R6[$#!Cn1Ir:dykр4dO;*2d8OFp3V$s0[j&#H$ȟ@XE עMXE^ÀJ4\L!ɉ4KICYzPU侙5a <)GP͒Ґ?'!̾izʿEJT, "ˀ?4YL%CD8RÀ?4L̶Y2|wSs "f$3]p g $8`e,/-r*m0~Մn# ySdǦȉXgC&3GJV@r~)䙊o%b ~3Gjk7X3riꪀ7SdCO2o8%nHa湽R"i 3d&sdHCo"󯄐PdTd4eb`~izHByaȔ~ 9m`"~%+ B"3dm aș,$ 'y{N m!ݯ"o'؍L)' f2Ev(̿(3dJPjx8QhHv`ș7:`"Bk)4ӑUdgqy{{L pr~{jfJPjQhJP2&>f0̛%v1,SdgfykKv24 CƧ2ao-AlfߧqDoqM2pp=C}3 2ENu'[\!gqy{K J{)r!SdPCΊ*r@fȞRdեiH-EN6W !{JSdg]ڊ쌙"; lI2d-)(EvVI)Rdg9@g9@)) ~yEvÐ=ţN2G "ǯj9 (rQ"EP"'EN({f{S/t9yU.}XOߥ?YO߻_zw+FJ%V8ﴇc/KᅦRG?{_xU+}ENл_P ECd|h"s>=B~S>N#9XХ_~ɤK/ͤKOE_%ن~H2ҟoGax>DC;tOtsweSE7@G(?I$H2)`9 (rHYnPEN6P&yzdE ` L,BO*4dk\bfl9*&,/*r3pB Dz>yH/Cz GTEb(rHE0dH%"'&,g9Cts>"'#wOgYF~v?1~_.r-/np_\!Nq2Ưw?~9|:Vpfˣ9] )xq1O/ ż]5|.S.|)wG9 b(-2cܶ)ZsǘkE$/߈\Wr4 rc\iJ,_71CPk 3-y׿ 1>q{ ,]?jm|wkI>O<]]>O<]=OXN+OO#]>q*ot.OyLp^>o W?Y?}on-[~܀2O?J!%z+gˁ93;Z|kf|;w_~%W'n~?~:):YZ5}f/]:|}mx_1+grQ{^KW9oWZKo}x|X.x֧<>]>qm8-TY ^y_nuZ[%Ez_W}Zp?5:ۿ/_c?j^_O Ưߕ,<דx?C9 _Oסd]O鯧}Qڿ^tv.J׻eNT#;_o?ݝ<:O[&}N?|Lǧ3Nǿ,F&ןM-?_xo~Hq~\~զW?3.5Oךtrs]gÃۇ)W*o/ys1|H8Uw!B>B-yRv'ѰP/KkA$ү>9!_^ YB 8r]q If;KHDy4 o/!QY?GCѮͳݫbz={mkq oڹѝ>BxO?t=E^O=Yî)M /'k.!l.s1X:;%.!_1B 8dA\ h٬QF>6Wxm=dM>{eZC>/}N2B8Dwb*;6א|d8oosyl+.!b`޹` IM9_]g%uv.K&n0y[s &M<{tb|n+gϮ9srL)spΘZrX1_J>tCnE^BRL[귄$v%-W ùݚ]#lxON~E{O &ND!j\M*r-6n|4YB/#'L-~i1vtbr4¦S.)uMǧCt\B8nSk ǟ|i߶ g103g}siKa a_◐d8pv TJ$Ϯs4DyW֔Һ$t/&%>J4SRsJ7* a=ڪS}wx%l,Js->J~ ~ԇ5"o+AN}lﻫ {&d~5H(X`BI懯 Kq [ofa#ً9$bﴒFPb3a"gl$td$j YJ)MGfd&yK ⇗0 [3!9=D$yyH2WD<dyLndчD$FEpn0OU%0O@I^P&$ip$ފ #(i U "ɶHrF.B,Yvd[ y&a7Xe IB@g&lHS>L#q O̶JH$*iW64$h>L#p D #=qoGrD~3Tk պ2Cef8 6Cļ1sa3fc5a8mgBvfmg,?EƊi=YU 58=C3PP6@ar hcTB0CNP3H"4%g,Zghm ("^8Gk 5r-CVA´p$,,|-"B mM .E}m$e65N\|sj*em p,RYV5Y(DŽd,2T 5Tje6`lf=U ¥ ==T#]v >LGeܔY",dsS'C @.j” :6CeoV.ү\]$C.PS -~~sLDbva2T 9!dmgeB,~ ~_"V>d "x DZ :jP1{( SjCP29ZfF Cnb(:+C Ĺj"zPȄTgCbU 5a)( :8 uLƱ]PhHHnvnv"Ӷ.BPӻ}зsn8 cz ffi>PjAC O׾zRP5#&x>ԶA=C WOf.n6GL:o}c`8b@7{&_:'Y_jK/Z5|u5jC=P>o}W#vswE:o};߾kN1w@uPP 1ނzŇ\ jp+<+5IPx\9 UW|&‡k17/$PPpWch=PPۥ]}W{=ݴ6f {z*t5'PPԧ=Զ3J}COC {[q:롶:fZ/jx^롆ujܢ6P5Po@]q]z|:2tKNO4_g6RUʹK*8Ҟd7u$'.9С?K$*Cd#+4q ‹0tYzq8Ruyp9,$وٻMHic ,3#%@)a΀T }Χ >G&ld /n(8% @HV}xV'&A>@*Kad  gfxk(B $'"((ق0e"c[0'n3*A;-;cgSɼ{WyIoɸ@ĈY'cɇ+􌡶]8g պmCM=1d'c&gBdp:jH.r28}<05|S擙~[h 6fmolg T8lqF떬6J\p= |da&OH1Eڇ |ȼ? ܀2ͺrܒWGm|-2Զ+G& J2E2O7/5b1m$4Nr1d 5;iGM<[ZW X6CMofZm*G7ۇsȵ~4<0rj=l½+k}IsEb{0rɈfPv8PwhN%h;ieiNENpDki4я ru&CМJPނ)'fw59洽mo*A62`<OyN픨UR ,yDgJ08*TI%(5a4%0x*7臠%9۫cJvL| J$8sV,=O(QpYCJ1 KXL~e̻"m KLEĎoXUbSPY8( RtR%hEގ/Aܜ`3; V$o4wkzBz7El+&ytRNRL2@Eb™g*SO-1&mQvRb~(VäRL1):2}gJuԶ9!J5m{Wbw)f{Wbn]7WcNT8`]s'8[:\,lYc<-Kj0$'\,bImŚd\G{=1@˒EbYOhYвhg,Ju`kU;+8GPj۫׌jeW,SkBq%a>oºgZf]$npºqO1j*fYW4N$d-b{L@ZUϺ'*M*w_@gtWW)[UZW)]W)f&טۈ4vΉb(>ZJ1̃"U)&T$Jjr8KӮy'&U>dR_s Ux~Thڝp{;R+WV8*6׹t^OtWK1moBnKjo H^:B喼:{&,{f+g\,¹rRעCRLh->fNZ>7`h5d-^g"kwm x[RC)`/TLrtΫ Hd-ZL֢y;ޖgKJNATLrwx[kBQn܏^7T7Nt_i3GnG_k%Ӕ.ww_Cɍ5_ J[8Re_EvENY`Ev&~HErz&U;e&L.mj~z*(58^ /s>=:561נ Sۘн$[H<n w(ai2 &]EN:JN۔g@A5͏\0gsM)0n#-6R} -pYepIN~Xd-oKrz脥i;qs=x[En k)VHvEn)(]1O8d}XdS(H`])>JNrWsUD<ժR\dWއoLbR7: O*r%10̤‘ }]e! ru!EnA3U^9;ɚQ8Ȏ]GSy %'6Hȉyxv`E]+yPH&'X!Wd&o[MO0wx̬ 9V7!'&iNENnVdPXL T6S3 {Oh*W~^A m%wYF,DŽd IJ3O~eѶ&$%B-҈iT[޹u{o\IIjh !$%?')UM|%1I-`d{8퍍bjKCM斟.I ֋')IC~5&3Z̤IoqFLh93*3h w 3ɎI~Lڨ1 iБFLkX]E#,Zt~U3 .Z4b"Hƚ'ё H~U=IjM$μ[5b6!5#NkFRg(FbDZ?g,<(o3ȯgrcD&Qnא[2#PU#&opZPCqNp4A,`A5F2?O1|h4D#mD#&e~iyE~+I";qB 2o(rnb4]5a5['}=(6l}CmwĴS&l#m=Q'Y;b]$|WD1o\1Qtfl#;giGLJܜ+'m"?K|!F#&գsFC hbDNec@ F)FR=y}"+1"(kGLKlD&j+0 & "ʱ]6aQn'Ъ`" ./T}Im\=V=&8$$9a3.(fY]!{玘qڥgʫڢ ƻGLpπ+ sDY1ޝ?4B#1b i͸BvOo %4 8ɫ^ Ifǧ1ɫ\!֙+ qd'6OB>YxP>z6$չrR5m"4Μ "v~$Ahy kVVGj"3 ~ n@9FHo݄C4H?#EӮv'}ܶr}Q&W#xm~T`kKPđkLoy;ݶchH$={4Ȉ~ 9A" @EbU>q;H|!{k#(S`ʉ {*Pό"/0pE?n O*rz)=6=%ECzY%;)`ujJ8,{N-rz$+ B!BaaSY y{cU JO`ik1aʉA#yQCg%湽`"oo*A D+D8_Lv4B 3!ޟ D]&'IMv_?Oge \|2mqX~g εXc2S }XtmV5цhU3mf WȞwІl@ÄAd Ӯf^lF)F~b^b e?zm4g^qT^#٫ Б8')Iu>`EAy M$:s$=) WAKM\J$ʢAR Νb"cybw\)f;E>7⊙WI E턃deb]1" %џxz9*}_=3Ijpu8HARv: )&y~>m(t$O{/ IR[=Ijroa&}I$}$枙ܓZ$%]ď㤻."Nqh8𕤶$չR_(9Rtx g+1|%̝'zRG3pCIR=f_LRkU12Б8I$PI<ꤶ뛁$7q>+=3Ij.ґh-|vo)p{H'#9xj~FR{"H&mu㫖ZH3mȯE 8lҾ<ц(sO=+41WH*$yTRޗ3Km7O@Er@[r|nRӕֳ[0 $u^q~ERL@RkdW ?R?$u;'[1 ZU_,5ՓeN?2#y>~v?՗}^W?.9~O_=ݿ~~7<ުO%e_!4~3_grRrt}>]~3c{Đń\6 ykm3B} ' ykϭ!%qDא[65!V|2+v=`[z y>xul*ó711oy~}}?[dNwߢ?U9ӾߝO7K?/MϢC]M?Z4?~zMo&tc|wIJ&WBx'.׃[>qrot5x> 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 198 0 obj << /Length 268 /Filter /FlateDecode >> stream xڥAo0 >;MFIcnC&h ? M%l9EX“}a\a 淪>'{DPtQ] @NKPA^n=5lB [ք%,F8Μql/JD2.:W8#%xhn$/wj ؒ.nWnv]7,N)v8JS()Eoa?u O<ONe&A}X. endstream endobj 211 0 obj << /Length1 1730 /Length2 20499 /Length3 0 /Length 21578 /Filter /FlateDecode >> stream xڴctݶ6'۝Tl[ݱmu\mcIǶmV>=q~F]ךQUdDJtF6@QkG:&zFn5#Lhfc-p8 ?̌\d15h0plLJyG:}O3H"dcfofb7 L6.f}k#$ =@SiM-6e:@EIDQ ("DEX))dE@UZWe'~ZoOǿ2""L `8l3JSGG[nz'Gz{z[)9\l-W{%8Y} mfv 곕AzsZ2JKͬֆNtOſBNko6+ӶwӷvrpeX;98:+#`lf YQR$5gw]O@X`b0~TH }ލ?XmambZc3k#]7reP6sJ t&@G#h2-S?[akc 0ַtz?/@ [e:~sP`.amlk)R 5tadm?@όG-Q'KKY}+ nz[YopQJ9 M%?I/`mb ܑT*򓰟3 @O.ZX ~?~6/Z'kC#3k3;@^ llO*]! 3`0LL_Y &&M0X`73ͿJ{gu#+9X̌>sw7sbӧ~d35-(hAcb03r|Bda_:w@+vyƐ'BƓ26㍓.%&]*u)̜QU$%׹x檧{8ꐛ `;=&}H$D_f[Hu {(KYTqyy+yBAYH@Z,jo0M;̖) iKĴyGZxdݮFP;꺗8ȆqR'~jL7E/rf fkM-Tk*Rھ&U)@hw7X1mȓv He8W}-vTgm;9:>&H[4 Oއ3jo@WHK=WC-t Y[/BC7Ī)Isy/mB.Em*Xy'tgJX`M-i1R$)|g*kl⋘ HMd4d*>uڜy{ѿ]R^'@)*^.2aIY~ ۍBXy!'s_e13,,µ a8CY5WU۲Apvu*/X1ԓ/w;?V|O uN]R_^"`09$x!x$VfQY ԣTh# Tz&I}V4&FFS*{۸R3DJ#u_@jSjmx/fo38>*y:V s^3pPthq{xIJ-բȫ#nHrZNH?p@1յ[(u~IG5Y]jPhZrzoB͜ûRќgKnGcI(u901| A8>N2tޑ~L}jLem5NHşqzP>9fZrRs* rjƔGz߂O-Q&qK}Ef> 0;@ QZm4n$ fP/gC;b[:/䃳_w3D:^h,q,7AKFA2]lHnY5R$UtsY=>[5>ehu JۉvהfPQ %qkG U!>v\] kXm8-Fb}˃aX[9$/9:;Qj&VoqR7P< Ȃ֢Ձ j7Amf!$KcF,lm?3F?8,AMX(ʬ) ⹱ nPHҐ0jKA>r_bQ86@$zٖESg)1~gMԦ"ܯP3ϙSLk,ޝu_VdJ#/}AٳD!'ش^4\ɵPcwCߔ`nALÒv0L.;*MVHׄ @q6.:(8;xn@z?k׶fSYhD+wqyh+^Wu>#3F_$@ 3rpwʧΌv# Udk7 D IZ2gԮ 5E3s$>j6ƞWt׾1;F9 CyJt&fbSS: \t+>"_t8pr%֪Lzrkl+3@e5>9tBq ;[V&캟riia~:IX0, :Q3tbV^}uVxW,ˆkD zR)N!>3*~NGr7jHJllY{|2g&"=02Gs)G/we$> *6Geަ2W?xO*jeGP%hDRt0q3pڛK$(g9lO{M 81f{I>C[ Ea%G13Mf%v ª`5-jodQ9íUMXM&\]p-SFYu O/qoW;|:N'B.ksn"Ѐnm*BT 9ӁBA&B|*F{fuJN?-۰ɡ s{ȇ@aPWj;Wg7bRVʻOful1 )~;K#ޡw#H[{C;dы۲ad4 cs~{2K;ܠgz EʼGA.iJ=gQ%ۙ+cQg;| X (XZE[_T%Ё&ˆ 29/ƪZ`_/>|/ <8la.}],Ǘq͹Xf~sscLN^,XN!:֟4p{\vIB|mmE9$#t ̚8i;%;))𖿹m*QuTڹ8:8W[zUʫӄo% RcM=~ G;ơh>ERd/*e!B:j2AnqLGuJAObg Ct[ɽ+WfҊ|UFȝqQ"ww4 kӟ4JkF¤odyHD߾[ֱΨz|U]ۃQd;~kݹ=οqz+QƣKsR2GlP9gekFqYXZ+bX*93 NdKrgOs wؽs[i:ofmJ`>SGt#c'eDiI{i,ztjua`֯tLdWPT:F>k/o:(+FveXy6L 5Q溱л}dU_^4#ۨݱ6.?{I} Zޗ^gTX@q5Bur?EWZ"ḻ iuB 0f}q?iXY/q5J78s; ^dVa$Pݝ>=EHMD&'ߠo.@C ) ?Sl6>{@97ANgPP]`*6jl^#cpMΤow9M Q8yJ6v7HQ94$r^_:0 4Ƚ=y_0U5XnIg50nn}Ğ\7W_èQ|ڎVBFlz4w]ԇ619TK EYw@'^[k՝Wznᙹ`522^ZZ;$&۽Ƒ&cIcuI/pBj13GgvOU4!Ge8a]$ZEi* 1|/5|q3 f,3zRZ8:H'3<I'/O< Q#V!S#3OXy)$f0 2l8ǭ|&n{ܣ55"7g[1Y|:p ̀J5 6B=/ȿE͂7Du~hf}c-BN3^$Sօ022C\v[=KBQ~>%]1KJ~z&(- 3-lٶ,j@d&~Q8W*O>u`QϫSX5㬜ozď-]F= 4 D}3A #g6>R'UCƵ*qA2IX7D1m 3 }EgQƠ=٧ĉsKX}cwLLG-{9H]7 tf &d76/IoHb~-&nhXZ$~sqʿD.bp~ alh j0Inߐ+iO(q +wTكI$vnC;ŋԂiVȆUPJa=Fty{ iw3ʝw~˝g'*w |ІcME8D cuE%G㜣ԨSϠxʴ&#We=;Hd1^mn3vAb}g~͢p/"_4aN՜ܚDx0k};G<H]ͫT@46@\z'YHi W,jujNs\ k =b8R35?Vy΃ݪAo`8 5`iőKs&TES_{*GQUlrϷCۭ} : ~aĕYm >#[f U( ӽeLxњ]Gʻ\nxoNo阨YCGa`/Ccx,j 7o ܳϯy!( z` %>Zr+͉إsG&b" FDzk=--<9 ja)2x m\+PڦS42V3*Yt *n6RjXiGNJrpt)Cbݸ@&&^TV$d.$336dj O<Bc`Z / si#z Ц-Ex^1 6]p\P%_-(] ]k2>Hrd8҆L/9m,WT_c=+8z`E[=DX[OnSMmW~ -]}$LqLi80i.egXUc%Hkp{t5=<+Mm,S"U ͐F{+ۏkޘMy03vк*CCO~"ϱY 0R* ʜ7VmhʹOx6#F.Zl9H. 5ofjKh[֣冸@XrhF;}; `vQ q[io u`k^?e .*9ZDY HÎbBڎtW_)3%3v,]6 Ԑjd,$|$ rj" n==1"VwV<Um?I]5Xϱa?w׌k8D4|di8\1IWr5%X''꣑@!ɞ 2$< IY-jP1ssK++6Pl(E#WQQGi +4 ;Nmb=;\ZV['FU'Vľ@ZQ\塢&c#6Y;qR+SfN"b\"ԧ9f;lF;U.?mQBC-A$uGA b8| ~u.cE ? $Yչ:f}Ǔt+jl#IHK4ljnoĸ[C?i[CieSH%-k{49 *h#:()"Vn`?\]zWZ="A(D>[Rlfg/V憜 y;nS&K4g "T} ^ݔ*+,>P8lF3׎h􅺕fC^r(3Nz+lXt]7?=Pz4bb?3.tkK>=k;5y_fW_'Shv^8HxW8ꥌgb35}`ܬd ڨb7wOm-d9^Yfu괷" ?$_]ۮ5F Y q̋O^Ѷ"k44ǹka]yKR}Kuʒ^w#CfeXQ ^XskbMW?j%˚-6MDX>y)‚C&ۏ#9!$OpAvSkV boq)*æhBjyLJKh8[J>ÕZ~1x-f pOЦ6nL,5&;>XwtripMM7zȎ-<9"M# WDBc$ٟۨ禸3.7x2ݡ;8P[/%MM]$kg"P1x U'\OeH3'Ǩ=7!wPM3|B.y<2pF9DE,gCdz~<JHF'LD`R!jF#QU_W"؁q7(Uq`^cF í_7fJ n{g' F1!)=Q8\Vh+6)iaA b)LD7ʭѣwA_ ޕ69;]^:E;33fJ| aV!0M~Hv}UnW t|=w,P fX r[b8 %s\m{& Sp7n3)|y/k_$|9ƈXTqkdUxZIyQ5(O?*n3ږF@\p'|u$DI[b mb"Y[ 4+A5D/W㞥2Wdv ' aA gmzuYkm2*@dw72]E}b T*h]E)wHICBԥՙעOgԼSy-zTh'l+ ݧ4ܓ2uq 7,'^;‘#QXJ),[;uXB M(g#_sX3cНg߆m i{Cw_$\P#ъ⡝1\ g3c\ q ngv w vn|pϏ-URPV6#GQ0wM.LͬoZՇw JgXԜ(-0Q0YERmnbTDȿqKN+xC Y6G^ Rw2'JFRK rfŘC<@TfSA ]32>'+{^=ͥ4% `7+"4!Ig0Lf:&5XNUǮCCc|ڏ@Yĕߣa0RK2xϴ?V!DŽ V_D3yl"Aث_Oʿɱ༩[̫ܳ;0KO%^[ge`N}x0m%X:P+.?b RP{4iͶEr^R419Oƫݝk|a ' ]DW,9/݆NTCBy"4J'](5|P*RՕnpy7P-ն[ED۞ 1:/ 1?2[$PDhU(:rv|F[_{Hc)q&ުoW;HX+'_"L@O&#Kv2.Y{xuxڹrTÁѤHSaE~B^CtH>9uqÜ O@|Zt闟40髺i: W.@~أj$r]ˇ"uUf0Bݹ,-,8䢣͒&ek({Oi- GCS܄uo?2e7PtFq -('t.#}qb\V+Dq~U?F]Hu;vPeۯb118(x]JeL#2jpwx26a0ص=8?Ϻ"18PN +lC,Jdc4B;qQZa7yVyjϭ1Ufv8;,TB=f)iky>=oAͱyS]ܾpcV6I{`;ԽYQwCC}S7؍VeUn(s,ht́x]M˘/>e|!4mF]yP? o&ÎZlNJ4=|uvWrv_X'plQ.Z#&dg6hbu-^K::>w1蒭cq$4ML*ҞĔ-\I>HYDV`޹K5SAə4xtbLOpBl3j^ X~~b 4D X־D{6n:e4rFBwɳw wG*vp-W5U(Y'=JW_ނUN!c$h)/H#CuAlDA|AzX>짝~t\NU=w]$ȋ|+Ώ̄{xEmcC5|B*[N,n `HucKS8u0I_9itG]ixj}5OcMSb#0*J>i >K6ӱdr_PIMqu=? 7'wRIG<naW.h~߱'uZFNԩfzQ$fyy6~*-Y'mQEfi/\*;gW/ o=@w/.nE\`t]IXIWP~GU@wZk_^pZ|c<7!W+qbs'󯅻J O^b| )gjgO\xe V_pr(\?01qM:V<Ŕh|J;KUXx}ffTok)((O4xv,4WX$Ǐvi +3EV Ѝv)ro :o@[fl,w Ǐuvc[kpxxqiRiXUw9Jgq? :?qPFOoS"<@ F?;3Ћ&Y(JXԝ׹K1Fs-8OuA>Ȋ5caK3BU$OBCdVf&rvK$gJ0'cަ4PvF"13 YyܝjH{?+CE_vůM㥄6EL;l9hV !AKǛIR}!&ބGcrfs?7@lɝEg_fcX%`wr|ۺL/eH#.)ϹuX^^MkO,FW;Rٰwk$Rf\t-u8%3v B n@I, 1,HAF#G"g涪 bi{.ԹQB+IEG"g]> wCQwOr׬0;GAKO ];>׍OZuIlFU׶79-2= @^)bAIɳeednz+Tj!)< 1ld&A<5NKFZ)yv)]YrtEfkI$_}VDž ᔭr`XҞE8u~Z^C ڦ'GI*鈂e e=mWEW!h0l0n͵N@b鏆x%bvO:Ŏ[Vټ!~;6 f:ʢ^ D!RGvbsk z  fPtAՇÚAPs=:+$VP%۟+o_L#zuAGȔm,Ӊ~ V'P|+W8A! #W|1B?. _cWW'AͿqo h+.}]< `:$߅C;1R|>!FG4̉eGڶUY>[&\JN sհ-xgX^BKY|+ڇ\,8O%hCĈ}5kBgD(xiiAbTٰa\>ː)jjaʔuDtiP] ebz~ 6Q=Iqz tu`xW AFY]Sl2-{v*B9  9ռPpkPԃ[AT6jSH'b{)}2Zh7p^oؿqtBȼNE"cB~ M<ۊϕpA@a|CXx^?oELJ|>ۿw>mztCf0qHAmV \ÕLM:;fW3-ًof5D >ho-bDUȁs[>R;R=b#-WXؒR&?G>qd|80J;p0#m!Ծ/m_r ƃW(K2X6, S?YםĠVetɭdk,˿M!P;V1D,O{cLj9Gd359J$5n buVڽ ;IFhY*mHccdrO٘'_ 9Т>ְO`b^ B.: Cd1?)M, !FeRY}OoGWҮ[q7IQ/\1ߤ%Vn/xb >y^1@>n8$ &19Э^,VE6u6[W 9s)b7!9QN.α:{yN3NGxy?ɒLuRH trO3>": C I\Mo=(`D7^㨄}_ >2U44V'" .&.%r.㩊ڣEhl'_tR{hӤيsݼ,TaPS h jIkɵVx9]V'8g&_=hz: wl5*b,O>ѵR uA~Z/!_MYS9 ƇLM~1o< [GHE?f5+&cLdg!׿{K=B@52DCCͤ*A'xIH6"X] 9L%d `+1',dkSOAof, g fZfkx W/R/J .(jzh<T$X{Y=$$jL+LɘD5< }C.aUb9VY =`ժ¨ uV*EgDH-m\RdZ/!Zdl4]ܻqseB;6Iq|IaAHvX;Q:wP|٭?-0x;Jcy'"ikxw!"bwP_sO?-oٰT˗R +Oap"ģ\ ~뇮,v/A3;/ʎ`’ %Xڏp||w4|L%T|1#CFE O0O BFQVޔFc: %<-UB/U.fUa+-\}jz{ v=uiNEf[uO0<8JF:i̓UYƫR8ˬt ]eѦmF8v-S\Mo>fEϨ%jrº%pgr(\0S&KPFyH@kv.$붥&K=e-E-Xܮt/7qNa~}+LJ f#s]#NS?d: pZ0%^,j< wpD$)ٳ{\xskly& Т0:#K#.rVB&ȾJW V\T6gCKrtDjeoSn)>lykxܲCRӈMSwX$-PMlyCmң`4JXMMdet((@Te+)~LlV>"bl CZljakmsJI:rlpfgВ1F/oH sK;#D9gӽwm8ZV7SWmצ]6Éa}89ӝs7to:w阘鎙_Xu:CVګ_t"o9[ޮE ym.S4c}ceCStc6?z<#m$ Vs ߊ|7(pN'ê GMgRw>S _U|݀+{Ne2Y?4_`qY63rm¤@.7(ݟ4mF[o9w@Ic84Ft@ f>"׎З7L@y{;uIʼJՌb5} d< 5*誾o;^]A,O2v7fɷ]`:+զCR~ǶYM։ b2g~71x. B3*8[E?=Um15x+nHEK}he@l35M80^s2uw#)lCCu0h}"[|;+G_{^8K 8`[ ^xzRŕ*NaY|C)ߥa-. *WFGJ_',,h]gQSjmQCB~ cZ [_ilv8?I u"劂*N4W0NtX"\h|b\zbR.'խ4Sx U5YGfeP偲?&AنR(SJ@#Bl+q^m<`cOs9QIE&؍t};,SӾ 3mOS]xB Kÿ$-nOD| ǷP<\BKbB"#`%{c q- )g \ R^FbE' F&ΉXU N\ Js ^P${T.q,넮 :pXb2~j<"#-t7kk/Ap&2A;K_tfA,ñV8PpQ`AQ0 n6mK}ڐ;#&7Q*r>"j=n2cu7=?(b /H%XmQ LX4F[5NȮ "M8Q0d|MM=Ж6z42hWK}OݥEM)~#ǂ-3"tb-Gի1ct?ꜗfA19 dWēMQa@t<9!KLaZ5.qB8A)x֣VOsP`"pPn)8"0n•Hkg+h7Q٦PHBRàIXF搀87$!]AF} )/)/X$ouAu]}ʩ:xmz,X6* ҌO` ,)Ynԕ6 .2%fwxC晴a/ .[q'iPțm Woz i}\a~uNYTկ.(;Fo$bZ/`{s,1}b29I8!!#-Y։Pg@L ܓXx+C~n Ceyv =d3\g:ּP8"o V!` $NpXiLJ$M^Reff5ܟ%19IR~2?N8۴Sc3 *DZI]ԂN( ۈ{'!2aWNw>E3H5v8.-Tʐ0AQ`&HW ׇ2S[J/GkKr Xt5dv{/ 3c,XzM4Ohu-:G(""T ^sv<@`>w mk/$SvxhhiȆQ.w:_GI;_jtϊDab+|TVuBԠ}/?9ʑoi"Z>6q |y%mNU%/sbYr=#{[vVO//pfLI_okS@\-d+8JT]Il7噓34l\75}@gL*X>&`5I[d mHu 7ԿgCz}]D(Cc'ž25t4_K (Iv(=nOdvχO}5cC4)6xB6ݨ+t'ZZ 6?- Ԥ$,֝>rV 3+B:^Fl?5 ʗZ6ՈF{' N3ߌDl!= %a[,\uE-_4K}Kڌks0N cG#,_G~b:INU} DQu\l3.Pv~¥,A%e?(ۊIgz˜HW4 ^C% )QRʚ[h= D5¥(Iw9 @75W54bPPL֊')&vcb8*Sw JJh'Y:j5k.f 4CӔ_>*m\ D`]OpV 5p +Zk;GZ;Lt|)5O d:Yi*l Ͻ+̓BKi#&_}6a{y6$PICIUEp"3{5˲ic[AoI,]iw`kq[^4BԆkFW|hO\h;]O;Y?*hEy&>Y)@ 0h%4d f~(m!07즕Ie])$jy5bb7 `AhacI!3վpNr/4r*LN=lxhx̫u, S +b;_mN%Ow"?  endstream endobj 213 0 obj << /Length1 2555 /Length2 30006 /Length3 0 /Length 31499 /Filter /FlateDecode >> stream xڴeT]5 !Kpww +-hp.-8w'[tskԨ"'VT63:330dl m蕁f.ֆ&&6xrrQGGCg ` Y01qÓ$@G`:zTE;'gz#C'hkfa {8Z;JO;oo s -Tv#) )$U@U\QU5 :GayU1P *T@^d]NLUXUKQwf+wTOi WSG;̝y\O fh:bk0:;Ki;oa "Ǵ9 4N**l -l CgCg'?2/Є_.s[i]3]k/C_gvNNNZXW{fTTeAgK/gbǖ?8l&Вٚ؀vMG Ovwll?&7qgTppJ}s `@wcs ٗbb>^vSCk')d 8;}V'gX;Vt\.ekjTɿUTUj95MA+AI\.6@XX{hWK%ohch_: 'q w\¶f@X>R֠?/=3@kile tr "*^:]lL,l,CGGCx&.AmtgY v @9¿E N&`XR'Q0AFE\((`T@15q`2/bAT[[bcǟ Ԛ_Y5`m`cbd 413Y@Z 鷹_@&fAP³cao$ j h ʳA rm_z v9Ԍ5(!!/H0- 3 ?𷉃3?=A 3?=F@׿b;Y ?f ';;3g7@1\ ] Z _/OqH@ AC۞ ?*ΎvV@ ;L -u@W53HzS/o;w/z6V&= 7ba;ct@?5@;~iΘ72)W`+97Itm`a@E$orm&y0zkR䍉Ў/>h:Z`ܢNC|錶6B(w{C ݯmyPnEh(xSo {hf CF{wv3x~Q=8/D8u }##j&LԅrKND/tt ȗ:mDz%"v{bEƓf#ᩜjMٝ7F w,](5Awk@FkuWldmqûтЗ3Fix1/" f(r8, 9.+Kq"2"Ys:)53 ]b{`DŷZ\=Û(HsI54nDv\&%Vpʡ+/YiWB0pзySWhӻư m^4rbZDqn,kk"UQoN ǴP#7nF/E>$,Kd>'{?8NʁM(PjȰ(v7z˄s]^+B$?;<)y b P|Z1maцͫ%{cVʮlcHP@3=Ձ\ճ%HB)u۝9eRuuMFQKe[i+nqa 6`S˟ZE [#zid#+&}w'dEg`PZ0rj_Yn٫Bt׬Ռ._;S׸m_Pl"b4<돝<*`Sn&DquT>Rm4=oQc]ACDc(Jn|/r4G 5zSµx萘L(5=NWeliG} RG^VjEY DiX8 oan=D={Mg8D2j?uFێL1YẌ́72Y QajK0:rzp"Ӓ|`;* ؞M&7| ]7 &"]#5R! \^\<:a>5H9/tаW|CZjw~ M"V5ܧI#t{B.: 9 pѬ酨[EgDC!JDKԡ/܏$xxj#~OVmR5%`ڥTHv-gI( :K*`hg-e՜ỲvUY91^rHu#6&dYr721G~͔ IGji_h5Ldts/lcQiyۣX?Z: Y# t Xѱ`;VTQ~Q{l>ULYBųC%EOz``cBBHEx$ gi I}N3ѤR1;YmQg@Ҿ0Dǣ]2/dJ`B ipmdONUX&l<շ[}^O0#9S8(J6q9d1OX°-ЫY ~s(6$A=*5F +GW5{ܢh{PBQPxN/ [M.w׏'&٬RK,O Z{1 zKsvo[_#UBa!'2|bXon!H~9`޶)wTzhD;rOEVDjhb_x.%8TlBEP֗Gq30.. H-o.p*INZvcWt.&X*p,eJ, 9}RJC>8t_GL#qh-*7E# ۠0 U@q`6b_~wC `v,cK|ߟ@]!B]WlX͸v\/hD}~9$yFD1xQ݅0j10$ҏjIJ-CX}؄y>VNcq$¼|1:ǥo#o[yd ;ǃO%* g.D/3ɷJj?{Z'V\'eAˢs6bbp8QY@m0+cmWm̙c,/ӷ+{3MP"OJIihD6GZm\҅q=d24RIwVMTg+zy掵, 31+ :u'gF۔݄/m|4\iAc_ꐸZx3tҺ2>QکAx:kryr`+k6yۜ' `BvǞU ;ST=>ۦсēP>ӎлsߨp]F\=.:~Pwkjz(L(2YNR}N)-% ϒfF暟(XlQUUM8\c6>k0&ta 'sFKg62۪cĵN.5̕1m<44#RPSWxmrhrX72-]֠3/{ QU1>j1U΋E15TX Ot*sV5K=EfY**m$qÔ괎Ld8Z1O(*rBPؠ6eJm-e˦?9^[:/LEDj88i?mGA?GNE-tkcYz]Yy**/p yŃX(Q^cehR:3L2_:s-?1GkNfl{=H?_yeǠ̲ljº:J™3 |_~TuszʨBzWf!m` ݚ4+&5$|/ab)qInq++M7rI%xrEEYϕ!<2pV{]ĒuUxLפj[~VJOLN?n/Kx1O乾[9Ġs-f[Uv)GL_RFc55ZUS0Dc,~U.2s;I6z?{xj},EѪJţ{4@Upw8. 9ސE#Y@S4)u~+.q^jڟhKhĹ~!Yheg3"%.o 81E{PO֙Ss :ԋ\(@jA{A@$WUK#&`\Zõ_[<) _TUFBs>d ZӕzCumCͤ\d(?)W~#5d)t*uݞ*#v2Vyx6i&B٥?љu 9{.X .=v0jzL"4! %p?r;$~8i pB[q7(a~fQ`40T W_!V@LqCh"Uθw}vrɌ՗!SY IK( MisT_L]9w/1Z ՄRWɥHa*IovּZ1Fdv f\65߳0!*BOsa:!7^7w mؕzHٹf`Zj>Z.r;b?Kޞ ~S?BC/9 RSTp?i'+uMFJn,ʋgB0l㡉8C>]?B?d"Gy#pW,t~!Ю5Ͱ7B\$O_rCuzLT n>.VB&nذJG__ MwU@HrkeR8/#c+z!ƷQ$ A]l *,<<NW N0u%]PR(ޙqBIhvt_$f(:jн{a3l2NG_q>A2(2H_Db+Kau׍>y v:wLRh/\IޗVv>ܩE_Glr|ޅǧJCآn8Yc<eD\Ld2#gҋ "D\' |&㓭X K&{b?YNX w67eb%b(zǶn14hY3G0 &jz.*J\zL]PH|%n3{~3\ 1u좞u\9E RTv;&b^ǮES)/b`>çy&Bu-k9o SpF&~y3lǺջOVV?5*}p!^trܜ0&;М^󣟍H8*z y2=vl(D]R,~CÝq$P1 |36S]r 7ꂑ) t vQd vFw!upPɵdLg( )= >[1_F/ROj5FK .AuWs- Cqե^Lo Pa feF}e#{9\lO06~7,Sw,D _D*=`!}ұdy$4dJyNőN I?b#suUcD_EΠe&9޽|j/U[NoQJʝI|DoйdR,틾_ T;Da<ʈ5207ĔYĴݳc 󧃠Q/ &\Zv݊Jׁ,K{h'7[Fv>\4"Nc\XIZl{ltr'346Vstx"WX4:J 誝IKt$ӱ %*ou b`WZkˢq{IɼisDR~N@stzzs]C0LM ;/v29u6AZ G=Wϛ䒫ڣqoBЗ/Ko3y=ZQȨJX%sbS`?G7'!Ti;=_b $u/7ԣchDomӏY#l}nXl+2a5wN0+LEd*59بU#l݃| ω_.Rɭi\KbAi}BF n7?R%P]P?$ϟ5`i-}im_(3q%܏Ւ؝sܨÆF eDOcz/}V~o=Vg2C4^$<W}.{O>n߿ i1?lRXݻ7l(ڰ~y|tx{,㶫<\P0RH>yt p[CA$||8E[{+OkEB;! پĐK7SITg2)f=w*d-8ea  e8( xU#0T{<foei4vIi) u{ŕԈh1+WUo4,m"tNy,W]0)\eƢ婞ˇk!hIg6S]Ͱi"tj|־M@(!q`(0cT8)! /?b?bۂ AYͅ[Сjm6 x*[r,hfϭyHeP_)n% '/Ĥ(=aU!3m ]QЫ|I`ZI48Tէ%:OX޷][C%AX%l|{e|p@^˥@+UF.{[N?G䱲GڀCG;2uGw)\]uB f3Q1_dn7Q f`QvSlb}Y;/4"UHH>zNL}K _u a<{?5R{ 7*k.Qr|qM^ߥ `RkRu˝ b(ֹ)`+}7wOGi!Pݿz=Aeh91sf;D&"d@S=W0#U:.oyQ; [Ae+_~'8LJ&oOث]D*cݓnQDBS^4w㇏ $ڟ?`u%2qIXzofH|šq^62{~c@V<ǁ,h'$̰nw9UP(7r8+aNLJjne۶+ XR'A伿A 7V _4wɰxTnoI}_lt8Unմn>qSA e2ǙDz(4CZ7)^ G,aM[=y^2m@|1@5٥)_]j\< Zw鏓Vf,`GWpVrP,/cըuyWod,}W/"oJ\u9Pu]&ro_teZJЇ&цAͬM4]ĔDʃHX_`#-Me+R`(>d߶^a Ylt,y%I@[3fDyJ:3{YΘhX~ ybZ⚸V-er N0Nv>.rq-V,ޗV^f\B=HzIȗQ%a H7}Iȏ)WmU~0֨Nn#$KioCרLH(2TBx;{tNcJGZ e?^`)8 XmS^g` {&TcKQs_'!R BqjvHSP#u s5\}nGY* rt39iQW \3xHoPQS73$2=<+-{];JssgI%c:!*n8+xcK%z]RLgRkDZ\x^]wn^?m@BwP9V U1O茁*ğz#[\p?ZUyztl8*QcTguMY*jKrORy4\y }3[t[oS%g7#@u;1ALdMF |JuSnGWN#M8 U0ovPSr]bk3`L1T.IE-NFm@G3.byO;K(3MHo[":Bҧ3UqbNEW;̌>V !ע[13[n!ծp׀D=N7o(wD翗 Kdu3G|LQmTBy23-;&e¶񐒽d]pme3d<΃(WSl+ǀD'72{g& v5^\LTZ;PdQy//Qj9OiX+A"6pWaĔT=p{LɆjkft뒄hUwcnVQfp.T4B iYn3fe 2H2b7E6G ؝3zR1# C3}+R/YXK*cC+)Aa7g;99o ͈6(߽Eesl) ŖCza[_Y1fh|`o L`F!~{htgȤML-fJaffu#DnLQiJ*:u=>Qcn yRSLP1d. +"z98+8o0_cK"_d.܆ Uf"] ׺ޢn=UeBm\Ir3\X$+pϸIS [ZOw q6?UI[_څL 5:tKin|Ua5n&\(%CI&s3#8!Aj[shϗKYCWul9x=B,q5pQltVR Y\dk C_Pj1pckSF[|Iêpq&#'x{> :t} 9R~xuF'x5H }U)Jq=E yb_R"-Ckvgş{<8zZm2_nvܾ(.}!FWd SGHe6;*.T딼61L:%z =j@8%y ? c2w MhYhcڼ ?~*Ӟ(~ ΂Q_or#PNp4I@~J?~*\wmBWzsd{]wB:pxg(lkMrkFg/p~<uFJBD*D${:.j>w%n6q]=0 c+@Ns4GQ޸\&l9nϮf ۞R?bD0*rK[􄦕%2vi=Er-5|frn+' O1Vu240{.aF9Bۍ|ܶHJG˜"yP1܈5ev" R*XfMBw?TY\)/4[IRiR͵L'[^ah93e0Y!?w{!V}(&# \k)$I%1 ȧ漭D #d1 \ jL/u5?7;kPNppPIQ>GD3,=:<o~KQ /w$Μ<F&ֹDul1K'$yw^kD]}BCpET Gz԰d`t^N8Uo_E?{z4i@fX//r.Roӏ:O+SΰZ9۟FRJBIzk,M0iĢAO381C;x$? 6iz62Pͼp@?d6֊r!8aޣ{Pif·y߸4e._i/'Q处Kƛ[}K7Z0bCgV2кSnJ_E9Ƣ,o`R"<&lϣ?h㍷hY,pX+ĠoH$/J%Ճ.U)|z,N1W:P '\t4>Tn9p&asn#f}BϊGLthgf~Lv ꊓo)5 (+sE ղY24Lݣy^LwACKoVJEw Ŗ,;7yO{~u_̂9͇*(J z+e5Z\}2Re Dx8X6"J#{G0Zdnq˧fbMD=#"P 2+ uu^0Iwf U|G`>hj,7ci vXL; Q;LXX; ^Go+gk Ts(w u+ݚ3LOtbrAlyu~CT/J;Yzy 7[SГԹ#('ˁ].LJ5l Fؖ{BR[^*YF)t%h7`^.XD 3D M smDTB w麜 DM8'̻y !:4cZ`8 d0o9T$K4D¸I^'_E;_&!#ݯOmt\.j#:OOHOMؿ^N9rӉ6kMUۜ̈K\ZS[ 9Y~N=AD'}0$%1KeT\A|rO9ލ8,j߱Z=Yv{k!!'P, S A94X*ex$sl-Ndwؑ~"M l;&j7MvԷ9=Zk<~N1.y<#`nRiz0 +js>uc6@+ $ᷗ M}=V8OnV| rsiмbV 'hG煑w>L$O<2EEG[$nl>xTѺuc* \ _'S@᝴w]9'ӭ`#{=:ݳPaBp!rwnlVa;5O_u{ 9k5o!7]\ pLb@ %k'WioyM+cؐg^ mܲMSmٟD'O{i__ y ƦC s.J &THވB!Y%Y֋:g­lH}S0aǭ`0/Kt#{7 |%- Jމ+tiNO xYly`.#k1jQ&eo ,իU~WEGMrIVDzYEJ #ءԙ%ˉ u %poJTKCLizXLI=V.LhږV_Xwc5|ĚfzV{QO:yI=| jpeSLlfׇ$ ? (\%Ld7pAE늻#.FwDeO8C`.6r/&u)IM2\nd^w,ȯp?蟕QέR\6o>U~@24\FmCs _^ْψѱLOբg;?\>nv*NLdžuDzaN%8Ca}60}緎%iM /]w{8dBS `%_D o F"J/Ԧ:a%lf<`*kyx@u\Ms9qOʪz ZMu9em#h}L:y!)CsSE+j p[WwtJtoJOW{ԲU=n׆ԁxeOjt VcY]*Mۉaj0_oPziLm]f,ZS+%hd=hP"c+P(]DaI%Kff^@f q b)<ѼN$?]MvѠ] EKͬ0a e`^t^Wzn 1𢌌3 ^EKP1zT|)[]p >bo%CY.5*]N0B絊mFJAQbK"A<\L-c+1"Q f!u.V8S'Hdk<  hj*9etJ'sla-N2|ExkEoA[cWeWNqnnDP y--a(|' i>( Fw:l 9v/ Kq1Zݮd RMorFiutxOu^n=JEAJjhhLj wWUPY߉~느|JDv{g{2e|L/ ԧȂ5>|-<|B&^\DĒ ·aG'G}p&T\[]*rI:2;O֩L;5"_` V˖:ՄH93gj}ڊ%Ҩt$j:\0xbՂz,o)=2I:8{c(\> +F[<4;%U*}@n&06T`\1DBV6넄{!1"‡t?+BRϬpaM t% Ji@a´H }CzKфHVy uEsu{l1%Ҧʂ.x:x;.'Qw{ u3 4?=&J'phǂo| @Bny%b[{:KgA,ڭ,3Ä1YjcuGj~6ؑav!J #7ۇl?<\ɎRWAi 71Z.@u-t3;n4+jZI݋*b @`}ZJo j?b~6NuL%qȀZ!M*x^?rJ tJoO+kbPH1nBtLwTH`ֈ+\6.U B Mk~!!`jU7RXXT;tubC"I~Ă|BTIgZ7[&PE-:3ܥ?[כurd EFSbϦY?f41u=0v40{CHE>W^r9ߡW4=6> B@j;(Іxb,#S%pwfQT]*<ͅQkSU=Fg-f#vަISm+N]G]/J3O)V9PY؋g o$qrQL̔/KWm^܃STۍ Wۏߊ`_6>] e)Q*ȹr8ylV aͷ,E}Dy_y*ibpc:X06/1EJV d}>-RHWQGSkop#C>tI R+H8}_n]H4әISEd-(fl3XSgt%5UƜO_!orWctE$Ռxe LgF<_>HY?%|wūJo{Ҧ]=?"٨.UJtmRzve98JsHMofPYmevI'^fF0qJƐ,݅QnoI `#Ysޘs I(s! (V.qE=rZ5|_H8)1*#cVj ʮtY = e^pOJ Ȝ`ғBRLsdeN%k?7#RczR3<92ЮmظFۂen̠aWQ 9_p6̚0OU؈u0[ژ"J85P@9?W "I}XWS@I};1#PY&xNVYeI.'c-y16IkoqK#Ki@o{%Ux.C 4ҷE7TV)#Et\\EؗahagYDiDh4)-Nxm~y'mŀf]JyՓ[LcG6y10 \CKo[Z<h*v."G~"8ǡk̔+*pkL$[xCK{q ^pLhY`iLP,;R: nuw6 n h&E A-&SeCBW W$7&{/.1 m4B~QGO. ^ΨH=I۶?S&.ּF쳁B+*NYA{W;Vihj +—,Ҍ{ûm*OMOFlekl݂)ce7MgppAf=(w cPYQ yO5j9[(}-JO.4gZ_`0X?=+?o֢D/9˲;p*vFw~p!@i`ىMQM)'aPҲu' #[ӻ>B6V hj(0>oS%awe@Ԇ1>V/'#.SiImK( Utqj11W]Ve,\CA3QK ]Ӌyb,NnOﯕR|RsΥXF@lt*WYn:-ba?%m_} $+VEoE[ܜ},]eq2emsl3[CGWtSh]O;U[I8\LݩcKIe@qtƿ+0PhyXYDqx"I PGRHAې^4^"z\ucV;/k"ȗ=HOQ0Sէ;/c'̶e]ǫKp}%BA#M<7Tk`6T7hQ) BZ$^2w{PwI"!_aJh%W!54Н\>3|"2lpY)+H.݋_k%%韉O}_(&B5LZ>)o gPH}T~ tDP^D.<.sPj(S&:^PCn6C~iP@PPp1fx*=~8UhE 7lHb{xwsh߯HoXRagbx"!(:ϥY9:!\ b6nJ44+_]/j_RMFsv:"v;7w *o"%.)/1DYFÍϘPiEH{^e jn4RN-L^1쵗B  I8'?a}ZG Ftac Mqe#{ MTr胵;Eop7њq$DLԳ]N$Jh v(u7Z~hLnI)74ug] E; {Gx|eRu{kmW T *n/ [goo(uI4S 5Ut^sv͐GNTa@;M@|l]z%ǏqN?OF`6wKEpk _MLMyy~  }Vϱ4Т[iƂpX+Qn*׈ץm jr_&nQuIUo:&e$~e jϞU8@1xNꏫ`ٞNL( xV\bK͵x']bMreX5,3BRGBPvKǢ %"cXSyf S9}&4/z~&0_~/D%x&栜n:Lš+H Z.L&pnԭ>]#^j^mv)8[m˥}ϵ2i+5])Q2k4'3"E='fZŹX7[8olp[+SCV~*oq9?Tsݿ^ghA lу/`2Yػ2eHR.kŨLpS5g:(ecJAGݓUò=c%)qj+*0W *_*5h=.Nyi[Swe~Uw^sbJ)Vv~kNcɽc<9P|gLSN~ y 'oQF8c%X2! HOYWۺAEUؖ9%ep[+B:쭉(y-ޒm_[0p;N.FX* sU.na{}%'ݰa%0דCG)K%A5#Ps/yRQ(dgBvv Ñsr,3г_jRس.z{OʏV&~cX1ō{[T)@L9;/W ;-DC}j30hHY+լxy\aq*~iaaxr6IJtLcv>1V98)F#9mc,\C54/;d ]bZo[hW} v&8sxDSH؃%BT"7H8X5DȢNeWfDD舓)SHdQ+3&_m9nX7_jJiy72IbA;oO`y.S_#Ig}<O0{iٰ;e(^S}U}O$ lҽtGՍ'z' okC/dRwT% D9s:lԹD8܊2qyV0{t+o&tJ(b#=.:K,#YSLL6u5#`l-.PoF 3W( >%<&5Җрwu)iʸg٦%ѹ'-]8-TH!fEqXN`D)}u v­ D#\e c]urwA~ kJN7 Ek2AbƭN\{s=?f`gـͨجjCSN^ OGRv܃M^-wg n@wH-v5j2a7kGxJ8ےXO.qy $ &(:Q|+jԯAr`q: ؚKW *+KUWe 3Gdac*fkk3UϲYv)T=Ckue7H lr :L m SEg"GZў8Q)y's# d#PM;k)x5bDXӉkRET?)XuU^Sej(y`5&n. ̄_yM5u&h6i~! w_Aj۔m'$$͸|5ꥌ"qm_~ vOIեo^͘tkVLO9 W~=e*ghu[( ROpK3ݵwFg$gh 9&:z(j42a\A v0Vk6HqZ3bgg̋&71q̮50Ii O~^WBׄg̡ 3i,`L:aӳ׋ߘŽX-DX+joZt a3B@)Z.u9NC}bAzWZN)N~VN#j7(|Ioz2n~Õ%3B"SGVe*x xGϸî(F\tݝj]3$ooͨ4c^T =e;:ǗcamuGv#9+p. CX:!б x`ǝ^T}N(-r۾6\#4(~2a#~'Y|ҡdQ.~`hl/c Xɋ&I%Qy ($ݺyxS$bX)ʚkA'\sf\ibl~Wi/>k qN5ê9fjLu{AN2Y?œ;``_a:QN )qiQ{cCJy(ܥ`[> stream xڴeX\۲5C 8{!.޳9=<j֬MA b` t202TM@, @K7;g+#33;3$n pZ\}-y(R@]i0(]MԽ,j+˻i]-\`c`鏷(#@`22*0<ޅjhebgpjj)U% e5jnELM]C ..j4U[qWPQQ`aStvQ3Mj+WWG^&&FK7WFgKFG[Y<mOgƸjW?6\$oӻ'ݿ.@2qW^YY`ob rL@f&n.d@sܜP_/uQ||M ,Xg}w?|Jk_ h`&9Op [P[6j%s#xRPQ`k@e4_J DͶks]?("cAY ]4:Y D#11o藩,-Xvh;]MzEVh Bda{cWZa<|@}ԉ3\5Wυƒa7XB fGE K.cN*`u~ʧcW$/r^#W&aݪBOi2Z,&B`5ŋw0s]Q;RKKJ4g(+S7O|2 O~E}rpt Ccfqʞ6ͪx/궵 tļzvf$@+}si)o7K$j9Q`2;W"/7Ffp-1$呍M$\VVZisJ$? K16F%, Y9Ae=\RHRpN1ظ?}R)G^6ٽ2we/[yZ!G3dd;H{jMc wB#`O,]51K!`݀fRe;3,/zz,u 1>}T9Wx3=۝xTHq?'crwBGiE=۠GOzAEޣSA <EaTGa0ʝϑ`V#.PTQd86244$f2B_/gȇVW-AHcjfnvZk3P7 BR-%E_Bޟc27oT`ڶ>5yLSPT|Jw\c'N2w+! Iv5n `m9zjUv%䴟u{"uN_Kl B޼yR'ܹ^uXw"S0iRm*631f(1HpYu΢úSy*@P >,P~sdqiyWݩ\y ZmOM29#er Ō4m;t$:P$W`&b-줎PЂA\td ~"z~=)ޢO6$p;fFN=YRDžkDPbI vifxdWP}oպ62CNG"EД6vfXs^J'! K ;wb;CRM/ALVMnl5܃>[P+ѭNb9aB&!{jdՏgK,[E ~r6HK4в_͝Awaub)PIjh=oQ?| O?څ|] .1svn1?m%%w5cd\3_c-CtVF{2H'(iJȺ4MjS0*זݯ+zi#bX^1t춄w>M.]T+" sHӟZ5bղK/WKx&q(b8s3 G* K_V=aCG9urHp8S#Spա۫@>i5-uN_s] /b~zl3QJ)v3nfb;.~8c ݯ~Åvǰ%T$!YfOBpplDD\7[)/h ؖ- *$&NwXo5SЉt^;m򄓼̊z]$dq"v0ˢ˒.(纡p!vpBkqEwo3ł^bA%M^0mDD0@V-x*`1쀹=]#Qڞ_hANnw^WIT)CCRʚ_*f~ptnbŤ? Ykf\db0VFh1keeSYEoZ,e,DԆ9Bsac$,nxhsaѐùό>3YEՄOj>MYBy؊D+rV n-CX"[XC◠/sr@@pfdOiMy6 )jpFNڭmm0EO7+(|PHfY R&`/S}{j9 +کgyzOQ_gG)VS+hq-yXb#AX }j!tMmĆ6oU`Hx'mY3D&a>wټ;d^բzzaH8ZݶC]:G0‰?ҞFO\ S~>/($86: ZyTvd\>h:PtG-xdC4ԩ1`45T8-pDܐ%Z_X\ҹ!R*fe_ޣt{{PyQ嚵uɐ}mGdqIe))L h wѴf1w@Fќefmu4 %P=$?5&¥}o%|Y` 'srcZ<>k+{A!xÝ1f :fULktíGOڎu 7U׬WHxY5y_lWV9߯Ǹ#?f _IB{U:$H I(jc&vgqM~جj.JV|+325sIrf`)d@&(E#Oo{@xf:HnU播Mpgg`1i)Zw .aڨx( b !)~_6rkRe!g~[{Sv)VI<z 6.UuN(+0DmZ.g'wPuvj;P'a<(<-6= z(cBI%Lߤ<25na,NTLي#C!rǴs@ )HJ搋0^bx3)Xɍr1"(#PmfjZ@tSk˯f(?I5RDmM is4 Jz c:(DK.SLN`f"99li?Vk&}RD6(>ȁ^r{ qn[?v;vw儘jʏ2q rFmZiv|8VG+}dzsAD *5 U֋N$EOK7Rƾq߱>')OR*$:yy\=LkC6r H~05u~pt483ŢƗ-o ,,cIY$zȣYT5YVSvqkكb@WO .{ERk}X[jsֹcb6i~k3D Gfu(Yh,JNtm'sZ,Ɲ/LNx v ^۬=S|:m*|isOnFrqsDqP PLfU_O1[Bc9#!,{:0VSgeo GYvRl :,by7e3H%OMco5[nV玓I l)QJ`յcA7Ňгo[4OXM$º`+f Ūd0O#sSMi)Ws5Wt6C;N;upY7!&;]kr+^,bf@nAYhY5$eٓ܀+iSgZ[3ЇX9;,Xc mCA7HZ*%pƌ\VG7eRHē#)L:}'_Cޣ-}x{BwpT3A'&=;Ζ% ,->iS:XmEbф ctFccQ~Y:D>\eԢ:ݒu{m!geet, f8 '";ߎYcl_6-?vD(ˣ*VV-x\@He?w ^]5}7/7Ydppw,#򏵪'R8ځ 9 ԥZiDSB^vi r+ŸTV\ mOaD){#]M6~fg>53}Vl6$TuҮ!F 1[/*ZᇪƇ#qu;ϝ洏*60/R a&;-qC 7p4J0?':Q+ ͠%ceM|DzI[F_@޲I(}<[13f6X2<^|1M0 *+6x\,,#~f2^ꤍ73DZ ]D宎*qSb{/+ }0B#<a[q n0S=#o씿gjz} {dbɫwL򟽉=O]Nsfuk,{=ѽ*5\88,dGNY[eo *-"K ۉnG+SۢF$F%9M^&9೼5(a,?S(Byu9d8<]D :an飣D;jq٠`mښ 6h6eoR-5p3NKb3zBڅ&uݢ?"_?e->C[B)|Wabx29oGJNȨG:a s*4ߗ QN))e0R5ΔlZK-0>e8#H$TZ`#%^S[~Ǝ_Q㮫[|<>]'h5!nxb~>Ok̺WI>ڐn,yl0WV>;i6Lݔa̾(8.n4jAu0媄GKk|C`FJvl305zlONж8Ljru8dcL.o1p4e?Xf\`5col$r 4Oݱa5B -%yeS]J,wl2.p_w ӲJOV=Iٳ|"<| 3sT$vu|Ͷq鄛Y~@o/gIg|OLI9ٹT"=:rؽ+CZ-Ly~>OppU٢fmD+:(kuۨy_r?HJ2xT˦ /r1HxL-EN ֥PjRi̋p|kq3o<0$NJZ>[):mJU/9^,_q/-p5Z _X"%Ų]~9@RBu8PzvNq,|r*@}Sh>wͰ?Jj n p/SMFjj;~s!@+腟3kX ңe::YD6۽-\}!2j!(v,ps%E,NIzs>ftH2e\ܢe#no]S@I*7Cr^[l!TꡖN MC,IRt!<'q%PIs;o}aR{-u'v^Q̧_`ͱch>T#©== bEq~"&#T\ӂ~Tgks`&tt|<*QhM6.[)ɌkA9J Zcm&j?JjtGZW&zRUP[y;~cT\* 7Jm6=ˋt[l=<7VcI>1XMl˙a׻ ٨b=xDҮ-8 #M|M)bǭKYT Tͮ2CR̜׺Adtmh 9B=H"xfÅsC6Hs.`Pt&Wk$2"AkN_hӻ66#4Vm{(c*B !7}ogl]bc FqnxV{^= f ^f1R5jԅ >C 0 SkB \S+Bs嵦<{)y=c<}*'Q恧 J9;$5aC<(p3sOc_M3IÌP7u'Ke xuA.Gg0ܷ{x=햨r(75 C嫙zfnʗ>QoŇ a5s

,'yl|cJ#ӖvP[|?'Z 7b<֘dx}"GcA)>R\[[%Ac#I0#b4͆X+%WaH2r Rm )9lJpXS<Q5XIeMG6~{Ju eQ$u\s?]1 5$3EZ୆|~sl٣ -kW~-+FvyuzbM/s*\z9 ò4ð2ʭtO.-rhGp^M1O.1Cx \/3u$+& {4n˭nTeg"B 6ԑ񍥈hs>]4ͬok!a,F`ĹC-jHQ6lpYEԙ4?wnF-~1KeyFHN4*DOtn3N覔 Q4]Q2N}[|~v%GUuAM8BHJ+{|j?!oe}| ! )_UqaV 1knjo_9w?~^^Fe*LHnTwJZBp{6hV @r{%d:]} '+Uo ?cr,$uE#^8gGr on/g044~rpӟܼQ:MbKU=I%=ca *{`XPō3n.8b|381R==e-neSp5kE1zAbBS9AUi-$Uu 5-NA˯i} WNȎZM&wjz`h!:V # 2p͞;ŝ^5a=&*Rs b"-7kVB{NrބKGUO/ѢS=rקJ zm Y <͆n*ߤY>\"ܿ&HXȐ7?9yZ6`Ww 'n`bDŽ@?Q閐KD~ `@}[8JcOֲEP̬cZu@yfy\SֻB9V~լ {K|ϒ2h̨ 42gGbu[ij=<DoIbF@3LZ udZgbRP7YK8 c2Ey2knmPuqnd 3GeF\h)F>Sr)i&sk19ۯ&۟?% X⢢sY~`uDŽmup=Vvt"lofuO QP Ӓ'Cm }]ī/IQee3h^A cmBeucIҨdަ$jJ3&ss!*HJcyb k62`aH>a>f@;~+?r1=wH諅rB; ) ؔ}SR׵:K;Լ^u|hoξ{`ijQjv#g*9~"cϪ}–`7_M¬D7O E2jC&Jf꓉Ղ|'gb8Sp\)a'D,]ˉzbyӥQ~w^9-Z$cO:m|x:aR}A(ʷ L)d&OKn]|n]thO~6EJ{3jN*H #قa;_HrWȃWdl 6lVKY~쮗ьko^9.d'E1%X,R&UJẰYr"7IzBo lB`(0}qwz@J_1CM76PP e.=FЕ-cYG-Ap|*`jbyܲ}ǜT!Gq̚V=fCFd,l)#97[(<3!\㡧o!"M]2[-9LJtlJ3UNr$ϤUjU e{ȭ9amS>D'!-cPK׎u!RskZRsV1pm  b IYц}ROFo^rnZH0 ],A$W'gDjs/Y,|R7$cAղ,IP=:b.l))J(-pɬ tB +ub%mC9ܴB,FJZJ7O`u\ M}.pTȞ}S=_ h-Z73!U+JJ3[yD`evZޗ˄qtUeHo[4ʽtZ!j/%Jɞ5ƨNCt$e=y-02ܲ NE?zTH |흎#9!4E"iA[(@*KzQKpU5lJM)5]Pq;k>9`>Qy|"ZyQxWGW޷>a@J"p1ћE 9H ֵ "6a.BS:<ϯn_ĕ#r> :Sz_5 bqTʥLr3WL CsЁasN~Kۅۏ'50cXr&(LQ~"*V?L'l9dcqp\У `Ͱ0Eq‡L]N@3{@id}y/ G?.wP"uY% Y2ۅS S|olȷw*{y$VK|r*/ "Ĉ>z)eJT[Ȅ&=t??ԉN"RND ?ĘM N6dOL2ҭ)躋ZRm (0Rl<պQl3kpN*@ h^WRbt=yXofT`b*vv7YB\b#Jd{doGK19=hcZTy~ 05TiA;x8XUaL5 .7hJr9'OmS J_J\U#؃5]2HƆGyoKf! S!JNq4|8+dmL[ݑIB(یԨnN$~cmAaI?nmGGmZNwmK iƸTEjn8?^Oi >qknG| DL3 I]e) &kY!n'2i)]% f DlV[^WV"a=RrjU9!zREBrr۷.do$n]# M=Uc#H 8p_koxCI'*Ӟ9~4jnퟑuP|%ZU D+Jk'lDչAxJx:5 5Di++o? &ܯ-݅v|J>QU>jp1%'ekSn nz5+@Eb0vNކB("䡝 Q<E9> De%*:j Iާ=n8d!d<^1Ʀ!&mt]1K(ێD3+.ӭc$D0s1̉G_NG^D0ni|ǟL(+ 2^?f q5coc/]Y@A8SK/vÎx v[`Cr[; ٓD#t'LxяC..~Mɬcȱ۶+b&H2:~"=_Ǫy:%-Dk|_oru%"1"=yE[ն+ٕl[tܢr|ԩMJFzw ު3@,ۏ-JL.-߈T5}qkG'$Up򻦣ƯZoKZ%$8Su1Yq6}ArT>|9;gİ&m$_1#K@Bw 耞d<8[ Ugl `h QZBdv EzL560!i$.[+)Sг» cM[,=x-P4REZS<a59Ӏyk$PD/+Ln1Ibto_͙^<w)0:B[/jof]$FwmTc^+ y>I0?0dY,8 F~sFUs;BQbLRU pr h9>;"N^𳚑e=X9BE/LcQT=-nEX!'py etjԺD|We/DQog0^+dR 9g^qM ߲ி,*,>hmtGMuj~'3d}Ȩڰr/vmU4h203̋8LfXu~}jP'4yIЊj쪒_% i #ߤX:N?Qz_-%B`Lno`n6W~NN0CS;6df)f&Dx+iBIzqU\9Ea[d^p\}K?+ïRӜz6I-~6J.ֶ15NmSS֩m[SSԶ5Զ&7M߰zV*zqL6L}zai #Χrׂ5A yCߔ/y aK6q kv%)InJ4 9[c̱G]f Y_WIWfKT/4RhV`*an?Yh}h^~VPRk7(vN8U_w"iXHX>tcc+ibYbJNȏ"%[C9liIc[Q2?rbGsW2f[XZ<$OlQq}55ɞܯ XHa*cD?˩6mM` "+Wc px'H)-YWK'Qs`pwqLEƂq*P[(8> \c[Iهׄ ڳ'T?LQxyƹVa! ^Nf ZS;AZACK Ï /JNG62\1>KnQRP.3 tB8wpZeNHYo3 at Ӏ\gD!%LY?Ƹ(|V[x~[.KBv*zOp 9T\]pqW#:7rnԷJK|"tnV,[[n%JcNY˻ G1)j5ਔzF_3n% %D*t|9Ƀ;%2\vMqTwّLrĄ{-Csf/FQMcr=NWm$D:6洷ߤ.==1.B\m$|D1q`K<_ x?``r<>qt_-etx|p"eQ<\\m\zЈ-#^{30$[HaRF!snO؃S۴4XTLEЭ jVz`NnXA:u:DC½\뛝~84 ) w&v`8&Xi.v(Ts_JhJ'gk- rŎ\9#Ykm};<}6&Nfpo { CgGiGO9,2>`AsBk /B&mn1)YX6&7I$µ'6~H80m?! Qĭ?mͬicAË4zU3T+Cr{;1ED |PO]`Uehtf2Er2z)JX(IRXBhIň$X J0hCBs^UDmyHdfWQk) = I#"_>kFsTKP9Uם‘E="j[) rwb:x3Pr}21n6$ UxT_\f'!6;nL7=nvkE(%wF {lHEdpQuܩ":^:h^?] mЄ|efH^11D/own/I},;7ighкGk,8DIjl$#ɣfTS<85;h(LJ;%cm[&znLaOxX5+2MvSok%u WRχw%F|P+iuȯj"_I K||3/`/w,bTO`^oCK`[1MWU/wB2"Z1J+ePђgk9MLz+v tcn$YJ~z¨p[_g4oHD;bV'ώ@p2.1h&ヲ*G`Q,VE,nvs=$e+M όUO-mOD!VoM'rơhaʟZk_-3Y;qԘN}} ӦL5$wEi{Yѱup.X/ bHTTs{g%DjҖlmBѷ8zSa90f/Z 2<~ yUvPp 2ކ{/i.^!tdŜ{h ĶYEjV?dkxȏY^?ʃ|Cm$C6E=^;[ ؇(^y0u};:6wf;L=<.U""$walAn=LpFFSK4Յ6<g/ajSF;, [zzzrt ,tg+凞\pg 划J}twqfzuR7[u0써 zQ o\<:bMJM-\')x}99{aFJcE]`K :܈ Ra6 YL} U]G0:p72_TM+Fxz{xvb=4!*Ȥe<ʤ _*ȹP[Nh&__L~jp{PŃ7NG>G63,|B{Wu"_tANrt<%4!25:g'\Hj˔p [ثo;=:1ɹ?pl=W^_9yow^L "qMx tS`(_p_)F<2Y=o9Sh$ZebS*V;+m[äunWm?2IIt8u>գ[p6lG˺oCf~^Ňvr:- J$)(.p4"H.:5k_&>)H(t5ʖ@# a`Tܿm&GQU|8OF%N%Bfi3l9y lAX OU~&ZNF!msL26D1+w_ڗE()'qI1B!XcEq(IVG|SfuT;񗐾IНGݘt9)nAAY'}L7ӡxńQoB.`|9#믖T][;8e <8A|" mɕۢ) ݲr c? P,F޸isSF2T.T[,xL'%Z+qQBPr*^lr3_[+ T z>okpe7b[^;p">yض㿿K*5Mn]ic⊽,xH)%AV%\= k&LAn4_n8՘gJ҂XTo@<1J 6.t޺9yŨ+#^eWԡnUe$UAh(xwl^\;yg]J*t]To"|`tY1BQi l.=h)HlCSRF^(sU M-I?>. Gqs(" ?3f::{EjxWSgߋb,1p{{̇y^JǬ|I$DLOJn+Tuα8@Ђʲs+$V,>@ra7no۝ƶ:Yh=fu) 6WYce*LdX%?;% ѯ0#^v;FmK^cdsUÊAA56=eWzMwYUmh^2]W{-9E`3/jøD[V yr3MoaY3㤺Q[x PyYdhՒJ<¾MTk @aO9;%xm9.|Ro3YX(!cdVM$]q0)f_ö}jI7W}Zmt߂%v$4@I.͝UcSHBύGiltAG\E'2yEd )t,EIDÞy*Dܲ%8%}튪^k@@oZ]I c[XZELYѶli"3^)mR.w>EIJmN?H I tVHuյ[R!~Q+ RϫOKO ='=;?Ovd@ e&ppTdH=i{Ӎ]E5 llA}[G`SFmwӑuDKH-Ld!ZFiq5Lh2S?ŖTDVшu:@@h 'e5 >MOad*ffOnJ%/\DQê˸`m'ik5nP/r#w#\XvdLijN2W/q7.F` k1S5\Ř z@AnOcl8m}~&]q0xw] |挩 T_mJoHenMb1֭ќ~RsUߨ4kg@qqdQVr`KrdQ»WHZ:ȏQ`#8M#Uj(&_,|}TSI+*ٙeΔl{8CS|1(lݸɌ3e=@ేR 8Srh/нhՄ5ߴa8fa_rE73FB]@j^p 6,T!1H5bQsDzpYvY#N0偔Sqo9OnYV㈄)kې~^n0ϘnD@$QG_& !e7SmYo^Wovf-\~몃5!C9Yq!B'z u6˪Vu-d P'+ձ-J^YhN 釔PQr=L&fHj(y_)X0;PUyԶJvwKbqik%(T54iDAgi}8PvL݂!`XO!a5i?lTa؍6ac߽twH4OR* eQ鵳JÌ-=b|9H=vsA$KetKAqVp}.bkAٶ|EUW}/M`z5I.el6+߮U Ɛߜk#v$sQJ(O`]åiUl\˘Rr-p>q`2kLc&a+YBjیܷ:)-cEGQ{z5/@95ϼ?"I^i|xSلtst*jR$n<WO\x_.\`.h z6m׬jȗUkv* fQdG@6:L|&]]zu5C?Q|%4bv0"e3-M/V^j֞6(LÕ={gnf22Y45:{)z|Z ,QKJtj!v/érJs,X&DQ qs`g;@5MeM.tUMLHX׭FjP:?}lʚ3bϠ^8;PQjY{bs?dҳZQmimiQcNoqIfP |Z.ܜU񄌫H" ѧa# !lYc7ғϩN!g8A)F=Y۵ܺJE.&aX ]@HzoWP|ͼJ*s蝤:APjB$npma)}>.3bJf ʔngxoùd:=ꐪ*#4e:?M`Yڥx6k>HqxV JE[5ӄH'tC `2!A-ڻ(q2 {23Hbnx?ө~VYN1f7#|kC𛕮sˑ'?%avu)]nc^ˏMt}}8UƧvT v3`盤K'K3?)2 y}W:6LUa:>} #;꜑t0aiq9#qkO7S*j(Q,~S8 40%6QlCsV[CDiLp7o7Qt*?nZ~ +z7z e1~[Iug&mJ^hʣ8K46xo\j ax-I a%;vWjrwZ<_ /k1-e5 S CsVG.IkQ6ɡ/1`\_xL"24h8uPő_d9!v_'&cNZlSGǁT/-"X,+ ORӘY0f ׅ>#tAD4~!]Zs˜m{sVQxw⯽'SlB1Nhbo=TxcK15 @CO(އ[՘Y_ c 6Ew_=J@9>4oR IZDekux";۵G"mR3GS_8㺌;*Ggf aIp?Zcc~K*Nm*-ZXqX"xf*w"z,V׈bm[(Y~Wkhϒ  WQtr)wݎsڷ ,+2xQ*1c JX:U ӟֱ <:$iv0'm]S~f{p;{Ihpc%B|k^thq\V<\.uXLBd;.+X}ǕgURYQCe~E v .J &V|* O @JcGs [S{` |nsNE#FO;-]~`]AXrun({DvQӽrC ˟T̓HfzJ dٚRǭ䄿bobyx`\_.hi0fFz\䡿r_#dI7 9)1 @ԐjNB.L|pKR m6uj $%h֥.#|l|×I V:'NH 涖2"kچ>(Ț׉>BJ) !h/'*솶⩻ٶ۽0 ܛsOvAXvgH^HwCw"o3%J { 1!aEﴊ6,r3XGVS"TdT_a-7BuKi⳼<ыnBA~\LinT `@5ٺ6n ^cnmɻ4RGHYT(Օ(%B~ey>wxcPF,kJ'˾א endstream endobj 217 0 obj << /Length1 1848 /Length2 22082 /Length3 0 /Length 23271 /Filter /FlateDecode >> stream xڴeT\ݚ-܂Npwww .SK@ w>ݧϽQj||55DI^(argf`ɫ9U.6F&&6x QGHt(8~D01qS$ `:yF%;'gzc#7dn ~Hp4p[o" #k;7'kK Ps0Z@c $UՕT0|Vus?KĄ@ :O5 c~s:ڇojjJ̌ p::YmQ~L>Rlipvadtssc0wqrfs4gg>5 K'5C Ng ] $a/Iv5mpW #r唔F g dl0Rk@ @or9w]tm|sŌ@.Nm;ӿ*f6;]3K?6yai qU5z>18;`8Tcj'Y~l d8,Af7ugTY:O l@gX0m^?񲷳8},̀x/'#W 9&R.Te\Gl/d03*9H$\lllhdkiC#DwZj;G[#Y:IXM,M,EF?-eݏgag߇,MA@''ǿҀD(/ %C8q%0rt4g ;;Cئ@`d9]}fv(/ `oSo `4o `d0d0do ho@f&#G# ~Tvl*=Q*LC9jΎv@MKӏ̿9;Z0}ozlsgcb \z{@w o; _ žS%P eXZ21K)Sm8bYۤ@<&T<;9)=PEzs|䍩Ў/>hz@_I#BԖ"(w[c;U"nIj6[s# " ^;T;#FO%YÜ`QhN= $ 9E]qYj=3Gy >\?Д8 lW[h,wsqSҶ 7[-(zKH_y%(t[EZ'_>=X!^UW(Ӫ 8|j \9CfS4^tW#^ZigMvsEVӚO5!gHUDvJF$V;g8"`ō>g\.e:V%J됣5nu17̙6Wh[ImC: Y-˙G/!:5ζj70NN>IpN]Օo2PQ^Y<8'(2zpa,\ɟ5 5?}J 8W ø>K6 A-ssk) 4oO!7掂W!v3DI]</$Ԕ_qČۏU6yixpjd,q>"{_7?sJ\+e%dNѩ,;c =QRP>6Q P5y"`ag֜=tECONvyv-0r,cKFm8 V^0п{Qd@nЖ\@~kҍUуɦpoߠU _%.KV"F)Zxr_8nX zֶdt y\ti|ޟNJo>he;H_%B䎟9aeY/R)B]-/VT] yM'!tK:tC>Yb8wьBKu,5,KL.JαΆPU jhKX ==Wa&90H8|) ]UЇ yaaɺ]ԧ^Ğvauznd~rP`<!+= |kAF?r{ 7ku#)zF]WQĨ }Ag/9b6 )ТVS#z޼dJDKH")JTKa4<~Ij2יt|!-i$-;SjlzĜgXiY]QXo"A GdJZx¾eMЗH=rPӚVhw]oGe zu;Cv[Dr') M^Aed.%P@ ١:Nx&kŝԯI::>ZMH.P)@:Ԉ` ~ކ~2Z8Cp|IX%\& WӁ9?FCw!AP`T/I@o?D*";mqV31p_p{9!U[Wo BWIå.(oˌKB`V7KA+_Ym_;LFb}!2ŠIzt?ڐNRq$$c{SkXK|Wػ́*Nxہ+)*^K?m1rg ^P눿W_W.~ )WMO"uT(Q7[|n9Pٺ  ]B$pZ (S:rK>1w47R2̜]Z^3"[O=C,!U#VmHD7],/zޕki.ݷ39f=w#pջ3Ep6نQu c,-q|`4/錵ho}c7UuM`@-Řns'AvgK%4y7!'T^\QG@ jb(ٽD{tU^KSuIEMܕ:vS.~3zsc#&S9ccM~ L˾CHdyj (U)t}\+ #O3<'v OapΡ_\eZB)kVW7 MF?)4X\Y:`7|H/gIP>K c"O8cASj%z~TnM9<|YQ_%]=hI( #?d< (*ͅOcY69QNMyU<[3N"T(Y=u@O:<[ S`Q5n BKCf.i|ϰIS^w| cR%yU  IJXf+SgV%s-w֒ϼ&Q*;u~g}Id#!{@׻ ZϢxqÂqC33 hTcU!>hj DcxO\07X [z6Jn]F#[" VvBX = #zBtnf`:rB'P-6A(Try G~ a_ E1hҫq`'b-{yPZJ1I] MYh•~a _ըl}1hz=M*)? #ApfXqs_&[ǃȸ{%S=^_sӤ {n|&QpL#3K%ˋe5ZYyǺD/_™$DiPY嫢^T2oJ3;C5g nQvHbQnB1@0JũV my9`M,[?`,kŹyx4}&i:Fkٝx'Uӟm 8;QAfKJQ)hX 'HmeJnjHk `#'FFj-fD %N?#&ͬvuE%\I,9l{"3eRĵ^)%H]JDQM@>+9%YHe^y͘h@ɔ?D;;畬bo$e_ 8N.xG˪Hƒ+x-65ўMo2 _.]g7&UԾ *}=qHz1dAҌ[\[o޵ @'sUIhC<ʝq/[(P BjJQYMu|By(W2s7j)1w{Ky<#v@}KQR[·$^!||^1w%J oZբ'YSJ2pɻNUh#}{A:07%78Q:>ވu"ۀh Fi`5 <%"}xR6/^\L2-"?3N9R1rhjB?u9Nfo,pSV}HNt)XTx|8li,(k~Hr]I Ds Ex\%a\4S_2+\RMg];J@1b ʢ~bsٯg>eOoGKu31 YyKNh!#è0~HՐg1?́Akarƒ+ȍ /iqN`M+N..2 Ā<(dS;U8in?WxO [/_޴UPPq|@`Ɣ˄uCCtCzHl48pDE]J2}Oe3yd8,j5dJz'ʥ@<_+#T}pew74!NksM_k5kP >Hc@S1$"Fa{ZS$j5M~b2k+U"FEN>/a>zj4 qNfֆA} kм JK~W=VMqBIO~47 6ڱNK]ȿ[B)JpL,}^rADp8*YP^"Z5nRZG^]ZL4}щ1,KD(>A% _JL.5&mX`۫tfvPئT;2{F5@=fjDFԌֲ=]]<udgpQ3s+^5Q[ǻ rvbcrX;!WwhUW1[uJrx"r˄B[ ԟejzul u2z[>!R>XۊNxKv!^\rḄ{8- 94qwZOQ?vZZً"SIm(EcB̅H,T`xM7b"=ïo]JtQ(?MSvsQƉ Աc^cnEu2=Hyd*]U:"L{t6M9g=5Wh^{y)^NRe'K2k@t׈-YuX /7֣iظ[7!j՟e26o:WmLA"y_~T;v#OOpVH[!yn6ZByfWNd] mn&4y@ W>b _!29$^u.엟gKmr_vn{ *07ƀB1^Ylrn޸ߋK I^pVUR⽙4c`]ah'f1~|=x|`t27Ls}&QT]bzC[4_pO.<u{ V4 DsIV8X4sRY!m$M96elŗv;`\@vNpd38f2X=w3C-}BAr8"C c$_.˹9ycl㴊duDRHգ5DߎTzG=ʲG!`NP@=yi _JvQڝM:~P7kpKސ.L-Ѵ, ; O4\+i0h B{H >99׮!*!7ycv.zqdQrL? Qi(c%SLxmɓ5,Թ!]?J"TP'yGsrAWo$$=z P,tq6PPAVWUsf9kֲ\ '8'G*i2%oʇˮCF_t5pVJgj6~8/X)[&.w_'PF<ل^-eH׾ ]5mx!O)85"*zy@Ip徥t< rLj9rGw3wxDN@p3'uʻbQ/*K^:O3/)v 쉯wH:lZGRrBO½(!ڦњ-N9H#{Wg Q9dل^vLM~iLuьR@:FT$+/C^QI{j=g6>!ͥ>^88eƐIihކh8[N9 FLdOX1Uz 9 (m\krm{Ќhkôr1JY#rSuت۫0Ϋr7BĬ@fjxk4J\-/Asc_nr>B{KxQ>d "@*imUgxQԢj?ziJkDŽP|A}FqBӍk$޹܏#9ޭnyGu||ߢs%-C879]7J3A^'YuOPi368gy)U'8A60L=AT@%c4mcj6ח.=AǦva[~'_nOs}\ZW+ctlu~|3N{Y~,I(Z3N7eyH #xz@bR7lgop8,KCbyxF I32C0:2&^;֓'_nhBh,ydfx0ąV%}4rZ);-.PB_ k5*߸t@ZF o@I_ vJJgwep93='|~|$KVheW ǡsa=iY_v0r$ {~ETu5ͩLAZQxc=zʄ&Vv*6qsu@ej,f jL#x(Wp3|nZ=l.־_,HmyktU\MA;1zE`#=9IEP`%V1+L1LYcT"m 2c*4Dz֩OP-X山*7N\)qү8?Fk9 ֠/-;wBV[?g sA\'ivd"%/d`WJ&ke͓?^]̿Zs=>͆jɻWB (Z,o׋S'ZzPzl#Z9&?+8߱ \As_(E7;^>8x4[֛Łg2=_~ ś~UrC(['y\ \w൤ntE\("Xe<>+5%7iً@ggwBN_lK7C5uڮEK7B$`rs=pQ pɟz,Db pl6ZҖu #,\rY~^'k{*k]:>;)gd]Du)brj -?tXq/BJ2ktJЗ)YXqMbQ*Թ's꫘{Hh. Gf'rucEWќBj5*0, NKUU7Պc   HV,:FGO$e8zPj} Q9vآnZ倽{Vrn]˔ŘQ !>%hy6_*q'% Ђ;"i9Hg'?A߀Aq7bIrg1Tj];YLH Jh )_;6ƒ{Tz'CIĊF҈ޢ~GIf[EJ`oOC)8ca 8K/w1$具}S4Q<.:͏gL&xϓUÌ})ߧU|g&2'>9Ma8 4,ͥ ?W=I">*q7Ѡ kP9^[#/(m"bcUR~<^U Xfs$1.ϿҼәtݛ޶@᪊$0J!DI9`4!zx6$h%v2j`e{< B0Q[y$d8˭CrŰч^gcAHJ*[Zֱt|B$mdf;/o/x{7D,-z%3\[~mpH[(F܌5t~8!}4w/ݮHi60Ʉ;Nb*"w#`^kCDsiږux ȱW+tORu`"ن |XcaGohέ"-0OWV;uZ]p*Q ʈ?q6#ZP+% IgA?'Wqu `$SpofLz[_+x4'PGKAq9 /ػ9nFJ,gע}֣i%Lbٖt"x6$  =2;m.l80f? IĘĜ7*¤&3hCp׎Tl2u>oB`G(^A3Ũ ֤O ƿPF0gְyfE2ݣj\\8,1W3n,_vaDi0p)%f^Q$9/ϔuYyT/seӌy{_"]PC\Iߏǚb=ƊKSӒ 6%c./tD }UQ#7yyQ:lkO j&؎48RxsC %{Cv۳׊#epJZq=zeOfJu0!2>:l7cĖ!w *W~3xv ȎdfB=U UWU+&ڷz|$(ītܪ7I7@)ӵ8q{@(§_eue˱Kް=N M`Bwܲ}fF+i,}E.'}&.Ԍz Yμ*T1dmI/k+f Fts)J#Zm5R5582Oס]q'uhUG>؆ `)S4S*pE4'p/~zCNO.a[YGJu<+UI=us)K:a԰YkN@:ӈ$l^n2MS]ٟ8JC;0>}*_ f~?J澷ȠmJ!63oSHUW%,!;a)|,>e6\;ݽ=䯪E6"YI1l&1έڇcM_AWOumINaG_ʱC 2GS8d̓e7Gt/4Y,wlSp2R5jy;Gi*:vϼx miy5 4#ZƏ3yȉ1/e`A+s:NYA=G,z1gːْʤ_ >]PPJǿ*e=5 z̠\ LJ z۴8cPg%_Mҿ E@@=T? -oFT*ޝNcV}3e@AT}dWt ;8A ېiVQ9 а횊q|'Cc[|=_+^ ^%uͦ_Q"0SƓF̪_w}uAi St^ VݎBYݞ<ѱr䅭6UBKLʾFxeÔ0KެG@\4<M/ k!0qL&EDz=MSBvwg҉#NU?  3*&q*{N/d 4~nQ 2@Z؟q)r`ókd!$sSޖyZ(2ˡⷰ)?SDԑ(͝XB^8ĝ;H%&.w.OGeTQ>ku@J4H6&cuFF'ae̩Cp5MW1s',†Islx+Պ"lvêHIrP"SZ\ע243CLX ]—kyܝ`p3K?M&께 g.2*$kyr1{tr=3uI!)I./]`dC@„JŖ)N_@Qw+Nu"]w2I@s`ͱvyJHdzE!pGv|i%6'AJmhC9xX(t~ vYN{C)(r mIRD5<3>D̲l\jk̋܍+tP^n̈́$SM`4`mϔ8;<4 ӆ9$_#LCZxvx^Gcm*'˔. e'i9V++P_TzLrSҡE#q',ˆ_&?Z,+@[GgœW?e*/jCbĸ2O;u P0M! QFJϢi6Y`- P09 - 3*V'ɵN8,6p`U7vܹ"/<܁ Elܚ| EoģzBh3OAjW{,9J8y c]ԥk\>IְtrlꞶ.2e%ݘHBKl]3{ʽ_8RVd?򓈿%;~-w|g1gdܱR@zcAHJ|dx" `Qg\MuGJܠ:Uc/!ZMQ ҳTڈУfW&Vǹ5 7VPo0ǐKЦJbXd>>"YJ)eyx_q!? "m%xI$sgdUͅ²Yp1?x۷+:݈֚ SԐ-yV =OC"+mSCm۝|lk-,lu[VZ\~wxn~~PYdPL $yXh._zʰT]רccbN[m"g'pRD֋XST`=TH!EO9#?YCswfsQħb{v]WgF2ű2JQwH)VbAiLkr.$^b/GC呜g))KJ?|4u5=711F (C)z_s^AMG|@ ]8d;[jXS"mvG!~`k@ss*nu ڴuGׇhA: Ob] ᷩ@}I7Kf>/K 5~cBYJR^R]98^o_mG0{~(&#zg.FBg"9ix42iB뽏|;Z`5W7K~k촡Rke0}G Ͳ)[CԆgj}eQu9DqO#bO=Pd+ianxw q!<Qզ<˃7*Oi+NLm_`,Jyɔ(ũ|-S?߁CZ,M+zg;sKUo)>NqHEqe x :,\Ek8\s@a^ɔ]璘:o*·2R/ tk,ag)#70V`oK͉).E >|?pis;G'b;Tf+6f1jxD Z`r,nxz~Hg`%y3u/J4ғݺ$d2ɥ^b?X47u0w>Ev(ұX~etq?[NC[͂:%" |FD2\< V+l#||fvY%=T'rV\@/1 DBv.t^qT|mFDsq%P@739\*)2J祄<]/J;9/Vz'g{Ɖ9$O;v?_8ݠrz :w%S? mAf*d46q(" MfNIdμZY`; ]P0z! )*G[a@iQA|.-J5` `KCzp˨ҏM)u&TΧBgm]U)>)tdSf{!ҹ;|vY~`}DҴ=B&S`pCkziXZ i$cd[#6h- k@tE~U{DH̠aj1{c lhEbeTBZ)R{;craٓ B^ :Q9ԤabiM `3άз7A k>2Z\, D+43&la #&>].'g 4KϟsmX)~k{@Z,I xCՔKɾXaR5h}T7 kF Uׂ%bQȍh<:O&bI6RdžS"oR9dָcJ(+Zm]Gޥ 1hbZޣV1"4+1Ü$gf-+9R Y`(TO8rSV X?}mt !Rjʥ /k,A_`1w538,T:qH&c2Ir?G8ĤLtE/ tHT"7[__ e( &t,sX k/'&y@W4,4#6ȗm8P˶9몾1WwR4(X0Qi8lS`: <8zIӔ"T$|F~Lz!/!p'YW/>}`UƖ/1Q`xZތ-{&$ISd`:xk/JW]/۰E7Gj3aw9JTHҗ֪:*ocGɉ/Iqp)z/ [2:)UP2P16Ulا0FdZ5#2g$Ok/\>b в{U=29U6[Z\:K( /15 MS*չ%D PpNz=8<:ډxܤv$*Fn > !J#9+M~(]XpK ֒1f zHN+[Yz!ˡ#2FcяJQȹBFaBTEZ=X<LG&^֯4~IOGIV*w2&Az:F ,KsJ駿{I,YO%z6L[.c Rt1)uSi8˰4(w_V= K ʆ䠋Vq_-D2Vfh&_4u^1~n!bB;o7?Vݗ.]7n q6ׅ$6F b tSz4vRQO,14 ʎ.9&Կ)di^p-\mq&n=LG|Oq9W4yS9n;Ko=N&9X0I|Cvi* Cܵ=FЎeoh zg+G T*kI ?t'_%gYZ6 CG+uBImX**G%zI].C k9tds ŒwAl ۙ*1",|Ev_L _Hry*M(jgCzΠ99h 9Iu0ly з?գs; saEj-؞4^]w#f4nbljѣyV8ȍWA B=wAW1`>}TױiNMsQ=Wk__TVq"n^cތ>kƝEO=I 1)ꁫ JUGC+R"׵fQ$VҫjW9B l-o ҩ_nBt@ߢɇK(e< :{UU{Q;>ѭ;DQð6/BBX2?MaOgkQsvw짳d1s_r1%ʾF%P1 &C<57~ SX[ ?i{DE|KfᒣN_ cyD;p0 w8r#W$+QsGUJ<ԨCΔNk@Z\z8^T_D\^)RtT=֨mm k)K5e-'%l7 ؤ*,O:\ &\y~]EBQX)/:h UGYibG'ozW&.\j.l_{M* m*:h!:Mb3t>[qooc*B:H#&Ap LtbvWf7S& HGm"3ԙ5 *3C)\ 'iqzPF =40WQ\@ ©e|4S%OU:~("P]Klǔ 3WW41D۔4Mj0@reޢcč:%%2jD/#DY1q9C-XZ ]#[$#SղM*X0Ji(;hXWki3 t~0xr눜0+EJL>pS37B+( :de΄-aƝ2Xfl(SڽaWJ [!.T޷3(@$RD7Rqٜӭ!*D_?%>s >7A,^4/bJ]um*"4ܘL>L > stream xڵxuT[ݳ6ZxCqiK!@p]{q+V hqޟﷲgl?{fuu-VI3 HrqTT5!v@0'" hke bA0+X agW(C Ϡ A_:jt|A` +0Eb'o)6hcJll5˳ L@@[s hjj5k1=r@i-my, ?oP~y6*-m.g N3h'F\_=C!v%0X`B...lN06Ԃ-. ق" lL'w?P2A vT>;=a,؟AHc tWE]]`@` 99=AfH;Ar3?J<샭w vrt7ns٦# -O NURMQNVKUgvl0W_Iʨ8<&IC잫vDC3O0ԍ zs+͜uVN E~VKg8 ԒO叚/{=h2=_< w?%4N~)џ`s@os%T)5mf s4v5!sUځYٺˠm rr[L-fo߹$ +'7߈Ο}3/5Mm GG_虎*y `RW֕d_,bfpP( !xyϽmrcl``ChvU[SM|F%r>WnZA͂,9Zf [~N_2k8EZ0(ge|7U j㹓9ϟ3󖒂z X)C}5E{ϑ\AhsS@䆠boټDZA2B1}ؗimeP|!* Bމ~B}@ǵ 3 M7)g]6tߒ*=ϹE p6Cmq]pHI&aO7Ei %$N-pt]8&|/-gʺ)3t`ܫ$|q sk!a533n׷րk8PX xas:mW$zʊtw;7ywˈ#ǣI*K]e3R~`6.$գ$6A@E~s_(XTӸn?>{ WuMJ4YF_1:ee#rN2R!@Q) \,t\Rq8kq^Aյ?@ $5wzY)’R)[zC.=:`OeC-醞1Uv^uҮQ>\|MQEs~yb Rr?!3"a"ݵ]f&E(}]EشjI ~쳙%LJ?n_~#+=kZgqr52~u͵#2gcXTUR!f+GG݄wtIkR11-"L$I b<ae%`06 j]L#wW$qM6Vw$FO?|"%&I I8cDd'ɣ2lU݄֙CC-J>/M $>=  I0ЛĒkJZiTBm'xV"R{ێm9Nr+[ }fc?ov;HWR MyLHW傾/㉹n+ᏆCdiX]ҼzvW4Y7jk3i%v*7^HC] AOO em'( O? l؉ ӓ_egu?Qg'eq3x7EKpv/Eol!Ņ>c%nZTF2ucK5 "md[ Q04߈"M8~;Pʉt#ͥgNJuU[FTkHxjN;MXM蘷fh*qZT3'5>K0; )ya*q]c<{4Z1^>N|yQ;ԇ If.=ccjHwOӗz5: փ dMStl8O&hMK&ɭHe]cٱ\I[/NO)KY95~k!@ ]P%8X Kgc,@]I?9ScuJ@l=H9UM^ AeHgVX@ qX8#w6}j^9D ?R,M% 5 w32adKAf>D֐&Jz={' c/R׺yα\zs:< t1xe 3p8?o( LDМ+aOATf+jvӢ)2jyĺa!Җ}Eo)Jث^mJ33Q- }sb'RM T.b;(PBb xUm{5 ;݈GQ=WVkn:]%^FwVqY1_Zu'Ԓ_3J\FO$65*_ g}nJY[%Fog9 ˆoPkOq&ii0w &-=nbSHE7bC%w1%u ØkQɥk00v\rthelƩ6?k%\&jRaLo>;tJS씖6J@\F=nҜtH5q5ǝ*yq]x_T z(4;IbQ+Z_2-LE?$rq+G.ajJ?ʽ!+AaZuC^z[**$2?arfXJ^xs1+ϛuh'7_S8]FJi7dfyt-\uwPi9Bi B#aDo83v]y.ۅ23{IlPjp;%v[rЫ JYmGҾg-șX~GR72& k* Cc(aw~7=|[yͤ 򃓏#\$ʦ" .'PapLoؘJ`kRo*V؃#h\L$o~ F'n`8+PC6 n&MWA*V+){4\vG YBnazCiRP'ǡQӴ+\ׇ [LΟ9s*ķzjW RBrNF_r&l^m~Lt_/]F})~4WeP&/ԕ5lk5[ݨkw.$)@lN*5TE6EKw:wySz&2DfR/}J'k1Ww݃\?(0 [ <Ҥb= \[t&Xf iyGs;yJ^ynCLcx&o4M  [[{BbGDwE[3|kr ltDCk|n1ij=5~mp>JPᄳhvn5f-[g 8&p SڮҜH!ps}/lnқ9x:´!o^qcVM0kmkLOFS\A)OLK`@W%#yǟAhDݚw" i5pMO,W6emT8]跓Z>ut K\=Mt{ڷi[|.M."!exF;o C,*b+?η]JIMXցwJW#?1LU܊3+ME(0avuDk z9=و*[iaXXOʉtqZao&؜OiPׅ9yG8}mDGAe iQ䋁k󓝾X*.52թ% cAXӏmIN%ᗜ5)E/ԩBYcB"͈0[;*c,12ǩn 7+xP ?^l >Qʗ`P2[̷]%Ao91dlNr[j\KYB؃#^߅쁖+@lͮSJ]Ъ,o_ Vr4O*ztUZǀ l9B+` tT-\.v&Rcɜҋ鎱:E,Fc<rua!N]cw#|ChϾ:\֟j]95ygiO7m4pspޖMR&lekޯ/JLr0Sh\ Z.-u5}D q M&"覧H\m::n4pG'k5~4й;|VHEl+xZvH  \Ы',%r u^sh"l*QsFʽ|t_ezz0K4܈Q8UGWJi4,D92H^EmRZkA#?ƒ^|i1PvCdJ!|gUc'w;!Itp4?Jn!RDYGTYc]vDt>_>ܴ\q;i<l}g!;ǿQuupb.r23󄝗%G̶Y@8<'K xs#F$"~pObm̞il?=A]_Gci/c!RcL;S?~}_@Cڤ2ĩ&dadqMջYfv%B-qOp=Vd$\F7e֪"K\]myYNкd _݌ Cu Rx?ٓR-;W Z1pA14tU%X\8yK)MCbe?R(;{7(Ov+GAuEr*L;cHdz AAW&|{OfEpNou<Xb3JjwG^׸]28!tQl)"nw3Y][6iw}8$1wZaҸȸ+vgܮ{58i :W.Cq1H̸?`Fvnv @ e]`]^K Ъ2ѫEh4uRr[\M8:.]ɡ{"];ķl@AȎg!F] KW7:z-jZu;3RMK퀵'"cƈ %4mo.c1SX$JZ9r_8r&\|mA 4 Qc?r3`$,2jE966:\$m Ҧte [' b$D-Eo+gWe*TvS'=!"'SoKgqf2}?TuRIUa5bء6'{3bB t K-Z3d#qn)HtJʅs[r.QDbcʇl:~#?j~/h_[O.o<`?Q|\+{MĪ8oF؝"9Qq ܥxfEz`'ʻ 6wL#T1b >%/ ,~CQt E^]Nr=䣻k2[_'^E\nc iؾ ЌD.O,M Q|2UԶUZ+1~IҎ>ޭi(%8RS]UZ,bPI2(8}Z'1,Ro=oh/x]tB$_O *_TX1:yGRrܑW\ϊ ޑL> +% $i{^/.1}7+(-_m e[\BGʉc0r7ׁ;KQiG9' y/H-?ne $ui+VS0M=I{B lid)[rL< Nǃ( r)ZU{eQ3M Gk)Pi 0ueHE##|@J85p?Hy#,cBP*~4#,.cdMAmk*\1fCk!.wliy%l2':zQR b0[ޭdP#lBMa|Y/40Pl>x;^i>g m~Zl7E!xwI(NV u%ғpI ̓=3V{=]U,wJbQd_/IcKA1ˀghYNG?m7 s)C.Y1IOQ=EB6f">U@eҧyiT5\aScz@ZA}2 )Z[jPǁ.h BrU؜ߊ̋ j~&=]cbw*=*ʃD& ,2e/…o"“S*iqX\QmG Tְ̙~VAGd㤿ZЦxq"_!֚~j'ztS(!p}ihb[u@7ƫX Q$<{;,N> 6C` y`-UP]mzOX:R> قQy>eލ :ۖ= 2%p#{"S+&j؏}ReE08l>R%u7[!: G`ҏ[ }~>qqUᗼYa"b<~Z&!#Bq_y1yGC[=?81xRte0|ғZɣo4KܷȖz^rOeՒU"a|G N.+q2 aps6\W.2Y4׃P)fcԕ>YY#l e-j++Pv)\&gsx) CwԕrY=mmJXSִ\"8$S{-M k* p[t5LMquc@6HJyMj쟬!#QH) D)SN&'@=]R#sȹZQ"蒒.ϛ~?l *fO58((4JT֔\Wm74(].Go8Wߔ-{7,t2dc|[ X 0зto[uݾ&B7^a\s[#9}SH)|sGóv,!?љO7/^6/xJ^wo8W%H e@Tuاz]U4\%Mk8bMH =jbvώ[ډpAGm=IQ:.vA?1bDBv\ =+0%ǡ@{hR^%qf#Đgˮ i|wok2EAW?gLpʭrD#v床b3m]w_cSg!~u2>vZY sgM5< `\3aZš_SG!zZfw/HifwYn|vJE+aTǟI ڧaj{xh`Qe݊ (\puTu$kGsY%wwltzRGНoϫǤhǡYÕf "HoOH/ 26? z\T#Iw|gRgIQ 97~Y6>%E?%n *(f)-01ӷݶ6nx2?HMv8d|~=9uBkySYԦCx+1}˄ĀDO(uj.9p-8 g{+bw>]Е؄䉒f=7NQ< Uַ6W8GD bH|۟ U_<~-۰A_Nj}FϢ*9 ΂,FUTi]M5\~+0=e^iy͠zRZ60͒'÷|9d Ƌ/4=Z}>ٖ8j\,2_x VcO{{!v*Fh4Y3Ή#m7W38Ik;^m%P''?(ZN9mqvDe8vdWotW&Jb]yItsG~.۴]A)ʚ+B8oV2?rDo(w徹_LE*%rx *ߡWw2j-+$Fb;' ʤ)Q`ÍQlSKZnn'fܶS?ӡȹbԍZd DHH:i"ħ+E7ȨHҰj4l5gXx'w;V|]+0|%rWR;y]/(_yU> stream xڴeXں5Npwwww/ Xp")Žhqn)]$1|$$Pj0Ỳ`W&6fV~$3r"RQI8M]A`ISW ? t:-f^%# @kP2V  [de xҟlqf-0u3+1oF0ZYM.@KCJ] AVX?\$44dbʚR6#@FKCOMي-O˟5@gПōojo`h]]YX<<<\\V̎vӴ<ζGg/a,Wk "$ Mʷ7{OM\hcmW" t0u0 t5uuse{Z  ҿ]o+333ups6ls _K{?{r˦$,'-ɤ6rLJ7u]=]SOLR `g $Ao:X{m>%n,Z '7Y]in_&#`ijY}\L݁Wg7?x s׷1;*Use~co _tZ@KDe8s=0S{WY#" Z\ͭ_f9Wӷsm_&?GmfП _q4uxrD/oa `QRWg+JlrsqLMYߦ 6@Ͽv}K8,Έz¢g dg;b7 `dYrX9,\?[[Co}o}r M󍉣w72p|oIb^]X=e/c |=/ ,\d 4`};lo?3T+{0qrq8ޤ?|~j[{m~\ h86Im -*(c>֕1O2o(R1(oPKm֚TBMt_ɟUJl4WY+(Sicy'9݁|nΩ̶6o o]1/R Va"yWPh^'ȇa1?~,}tyeŨCǓJҴ%v߉\9u<Ӕ ]`;~'w%.Q>)䊝$GHWql:[襭!|nukSX*ȧ \ma~ʅJdX{LaC}5 iIfH< T/K^TbQFbSM7+fг W2K|(ue3CUzb/yj3eUa|+3٪.%&U7p?ĔBѱĽ^Og7[?%d9yK{)rH_Vm*d&oSe]2UAcH_vʾ̥VDS=M!*0/K e@z^/VsB["ɭו!WGgmo%@ps>s~я.pÞ. (׼FׁXp1I(]3ԯv 給i7[b 2+h#FDOmR Q>aIxe`T(LT>FjtT8)cdARd7Lܕb&PE&흪Z xKWfƎ‰jj%Eߤ^|bTjqu 2o!IJ)a>@/1'{:/ԣb(/f:ZF(t[j,+^೼{r_7>eh~ 'Ўk@UN7<\t)נ(=1?;ठvωo"s !CoL޸LomQMyAB{6 ='UCV%5eM"O5/{R93~:MD)E4?h hƛk8;)aK~wPn4~}DSb6PAZiD8RMme ؠ7ڶ>qx!k+{CԞ[叾#Ho׺ oAzF .0xO4ncnOn> 2iq#/T=ew=R(|YsC- -3pfۼcI|N$;eѨ|ՈC։=6 S\?pRsKO6re ;(ӊ8k/A%/w_'ZcbBtg>= }I&E IؒnF-Td0Q=)mX!5HV-yv"'ǚy/J4BϥZARHʗrz]nl u0oeď< h&s}G=e13ZBCDl_Nd? kH/&4zqq(!{/`*\tw"Y%ҍ78ngLQ 8bpdU\;fi>qEr1}VGn_qXY -B]^c]X5u6j}XW"/a`tNO|*6=v\~ƒQ;̙美8h+bgo|k寮ٷO[ pX+EIS$ LqjDP?ũݹ Zqw5_a<}pdtlcn.\΂~cVizjZ)Bz50wLŃݰRa/MlV]rǮLx EC18?>#ŋCΒ/A)rr]^ΰҍǿls|%Y)M#_jʝ$vvlÛ|9[**4_cM±l^+ ׎OP>We'-WGKT|IsY,rp9J)|]X=Obڅ +j 6^;F3Y A:5Ё|n'S!cPeޝsR7.ՕK˦UM"sO[Z9*_ܡ=GwZȈJ]b&ސb\I|#;LˈJf4%ʲ(ygAԵ4y9>PBAF>TΈPmXbҧCE,1'XAq>hQo(`c>yzx]t9p鷶C,#XOp \S6E{jTJ.g$;A BNL&b;GxW.ύ-~rٞʚg#$^ɖR_5AdvZ0VP#6ECA!d R&:dn-e+c:QW۽,l; z|p$Q6\vn郘xQz>2g;si$2)uk$B!j^NI %w#m2iӒaC/T44bњzgܧ4tG]ҿg$."\V#p{Na^)gJX  ,o dpDSj&̺|AS- >M} ;௃R]ٌ9&Oe&#ʥ P`RR-xl_hT0h+^ԁo(~Qaz"%iH'Rs|PUW$7\;S нH։~.a}=ޞ;L$LmD =dסm`S9!,mrEaf9S?\2<ԲLuƮoZQ=L [\'4[1 -_LC'q)Aݟ/j5/ YNjf, epY@˟Ι PRG=$xeU#r$tڃ?A%Xuk Ci1[8iݦ F\(%Y3V7 DDp߭FeZWUb*QLGmZPyo\N]#»¶x}H$"mFFuͥ|c /1~:F\%C}11$}u.Lgv{U.%}n\PQl-Yn"| fcޏVuص>rl5ӳVK.&w- ~Wi"<{#b.9YCkA xX^ec0FU^ymZzRU I<;:m\IWVRփ|-w.+2HO?O_D7>9STÞ2j5' ﻼ<ٺg%/I=L2UT+*#3⥱E03W'.î"03RNҝ亮f #qEZϠKV4IDt?乑Jgp=jDʇE%#RED ߸uMj6Yyk: HŵV)DXׇǣ\\-Ofadq]\J\WK庎эkA;yVD|:dY*hނ$AIn&1@paءꜧS^D4l_Gg1wZLLXj( }VFN( axS+۽T7B}Y惙uz6/ /qJ2?bv?Ml1Wy'd3~^J BM4B--Uv)ݘoM1 B;kzƽG(kh׌ZpS y>KSԳКQ9b\u]>]vIXvҙ[XIErӦT>'hwSkXDPalAd9LSb2Fϸ$j;Dc=sk:"cQLt>VB#JΉp^u$o(nWEH:&M~SS meG2 X2ޟDNV$C)+}7, lN!kȗ+Ƈ&ĚÕkbnVVR!(xKdѴvM ;ǻgQ=k rG?[ҨZʕG~6eKܕn~ )®0S#\Js֭!)5ťGB8FNwN"Ԅѣ奈"2Uzq;/}ŤnMBfӜrsMV@POPzeе*Qu"XN O@7.1+)Otymz6g͕ƭ||(އ{'s|xs1J1`(! !|1;cj)[U ,TǨ8W<{:y!aL Dפ=; ) 8abq_k^n_4qH! 9$gV^L8pOpfMvۼ,nʯ+qVHa]w!23]^K(p%ۉ(fg_ONPv. g1C힔f@ NE`XO$6/>H\T}@=tMY&L~*hKf-jod)f6yZΡ|<8dc$Oűv>`-1[b{ ,!VXu0st@eBCGsil5{uoymK)9 |gjnj? 2qZk 2w㎇'Y*1wtcU)(ė ۑ17hƢmo*j6a!lh*ވYRn΄@ۏ?ABR'm'\T^^&:EGC*tw9(V!Z3}utePѶG5^DF-9f3N#>ǸUߵ)T&ug,PObtijwָ" -A4ZĪݱabw 5f,% i}h.Hr9lhOCveo!;$܄?djjwHb#V`وݍJY2|Y#ё(40*0[ $unl BusV-eL/ח`eG^">71"ȯu3l"ɒսI*̹8JyG5팟BٶS/3/2(>o?KӇ?P:Yį0da `1^0Qb =܏1YQUgq]MpEFBZ#-1B-1$y(qv'jR>x"dTEW;#g<Opr4OwMf+qҌ'YbkL1³R^nqפ6ɋb5!dجx(@Qxw kƥN|VDoǺ7'֑Rڠ6xsEWBu$jS\1T5!!9WI_Z?b!|KG&vFvVQ$vsna}" m+cGG<33΁RjD].d@ ]J{$ᎣyЅdV׌*؍ϸye} :,Кml5S]@*_QƁgMB{J-$}-xtl7l(UBBm`×Y[*#7W>%ɼ]DCVb]bɇ}]YCue9MDo"OO×jná_x ,؎2LY124\ "B\a=\ppNl&;? iH֜I2hK,6bD8T:vSd0w!@ n5u(f qtt r5dKzR@n«آ?H\,࿍_,8&a*˩$<&y0ݭuf#)安`Wں#ySԎYa74m: {X}E(3P#5:.;h:cMXd[z 27p(kj.QWgB k =lydyWčEja]o&# 'Q}m-^7L1 p7х@=8L8@P5 5JOX ˭w֔Bq89ww,M(̒CT[,Ң4;'UvJ,fYv#,4jKڜhQ =9 BV[̝L{}MtFaY Yj3CXM…ԀKWw5&\bvҌ,!\fTb₻ULvLM9yT^4 >Djgpp%&U/)e2soŐctj#;9r쩘У?V>K̞E{kw Qhq<="uO<uA?7˹p=PC‰dQWB7w5^ff>q腟v8YafD/%~gzaK606쟋yw0AȳHٕٓM ao7zi(55[ӿaKJZWPύwkg .=f7z@YiNiL@_nA4 xSI\@ ?^X_sꁍ\Jf ͽcղ+L5t["٪f 3x(cK+~R*|ǂ#\|묽N,t۰/;UNufn]@eq[3*k|ċ}@^e|Dv1):03ձ)}K݈ش6K !d9}WcJp0BX{ENHY]Bk(0d͐@е;WB6Cյ JFI23)̳~Y4g`iN)]y`.+mWFG' /(V4%I*(1D G7 B}FI5;C2Q#t0s%J2ZZ)0~Pa{'_ȴR%r^ܠ7BZK!U/x嗰</8<P^7JB~rMJRդ$Ű _n},Z-Hz_ZQW5t Χ hԻ[^s / 4T"t%k{[?N} #9/ D26#$-[k;Á"û`m*2LonD/M0.l$,Jrs{k NnT^pIƑNPx R: X"@3}O2O{ fL܇}+ E7ZKNUwg\Iǫ뷠*J]%U hj ރ_> їYה#n*˚R(43hr6?`C|%bZYi%}'%vTWD e;dˌC­Ehطw=/. cP_"Ŏg0V}FJD=Wg\#>bK,"w͋1k@WAqS `iJ_/V Y#S&mQ J6flY_h׿{. 4)o#ERn\ c0жd"lhEDiynZMC#yNaf2$ YB1veLk'ær﹣"mSFT~jEgRJq6d]@sV*"z$\!{4Tt)nRz u~L >ۼ0mwT:z/mb={{y'5qM-L}#r{naӟEߤ5U~M(Ma[.`|PA=DKB|\+]ON7[T?h )?1J]H#0Ǝv'gPWSu> *D04ъK0q;⢑b8*Ц~wJf;G`"y "}Mռ340l Ԕ#珩E=7݇VtƾZonY;:{ *TiFtq_la^U.*uրD}(̨y$Hǂ&r`ffIXG-mgE!3sS-gU΂Z@k8Vƀ+3$,5ʶ扜buV|7U}1Q j)΂z{sYtD} )mR]5U\ܮ4~ 4Yc'$+R5;^_RXDϻYKr|͛xLǩ Z{YG1Y#զ&y"<^=d|AkwjŅ68mctu(]ni؜L'urHư._ySbuwbf)'] 2ӖsdCu"娝,J^ȬLi2TsiRD; jv['*qMun}#ChLqqˠ IyҾkg@'xs j"Rdc G(2 hVU`߫z`BzG$kML-VVvgrKr;=!ց4dU51lsb[ FI\q[6=GtըYr;6*gxbgb՟:c.j{2eS2{X9h2~ʾ!qSא?C:#_poM>h]ιvv>}OS&gr3C@/l_*8+.%k;a.j2H:bgu,eg_*ԓ8!7KZ!":paeĚD~6h4Ikc;[?aJ3>gD\=¯֤!)qWhIA\󞺌0Z%*&G U-n gzKP|v{ߓg".z4\=X`<[n͘gp| 9.\WɌ*x].l:y8ThX;rX>M4-Yh]%r1[*`~TCys╼=i!:5aKW З`I%=rf)\*A׫'`qPFcnqXmКT=q sN(h):"n2nU8JA!DDn+Vzַ{wRBIA2/HtB5Ce'AV"C훪m0feL/W^?N خ,ʾo)\è=2i.y#b7Q)c}km;! d'-BkQZz .XSVY;Z puMMů.&?9e+•Ա7hkE)Y(PgfYz+"nئ?K 6#{፱'KynY&cHTd9=Y ]G3k]M#V]3tq:oP1NY~Q/f-͟3J6mC(oi*jzE~nS'VWlP7`}٥wPUdڞ? ]|- O[&J!/P PATY>H3EETioن`k:ktM?Ŋ Es/"0Qk |ܚs矹-98YEOOP)]yH䉟`xhi0nbGڒa&HOW\03O$|D ~"JqFyhlxC:͵ᒆcvӟdF?4S_p{1 hb,TBcqjc^ExeMSgjso{p͙yeL5E?nd$;$,ZyIq;&kR_4uGVUͺI^*9Pod#iDU HdBH6BQ;/NTWK:! aM7ۜ0$4C4.X]¤Ӕё4e1[yA7Y1 \22x<,E}%6P#}R=AI ~IV*AlƇ SQ&had"C1_ǣ3PO6eW0Evpa]a #cI|՗A%SoYl|O'v>-&Ckv>dI]yTj X ԁYg~ԕ_ tR %XTx /~-GſC2DRNNJFրv|ivÅӄ~;~wv¢gh9tQAyǢJf_'d5puc]W#'e 9qA,l:,C~Z;Cr#"0TYSƘl8ms>> W!F ㈀w$.(uzD/ gyn1|ҟdsXݧ~sV4%_;63 ?F_ttGBN]]ˣ|8qTnKӈi ˭7Q'"G2&B_B4 b*̬@мz\N{*[r W ^' $*)zx1 8fG^u؏ HWģ MXH>^IB |Y.%Ry,} BVRcD2bZz9֮ܢ*:D2PɥE'}h_SsH*mrVgnDzLS6 j)p_[>^:-I iq g=2zM<H1 詊9*:n3 8[OkcU {$Ԯ9۽ 92˞tOQmpMhJнx^gErf7q1XU$YV=p\ޭ~O v[n%ŏҭ&LrnΧJҋn3:NN ){,I-_0wWWne1U&{DHhO%1 +GQ44~,s;}pCbaSZP9$گV:et2j5Yt!Z7~F=S$ME*io] tQmYgˊũY_Ҫ񜮭;l6RG6qKZwXF2>P1ZM0[@)6Խd6uYsM96|<=n3́!LZAtb3v`FaJ3Be+1 S-z _?\Q^lER*}7ۙR.&aɭg'gZMA˲|2h,4.vJvӡcGbC%ǀ,[?deS6)ICÊK;Ynڸs&U #fg4%,;,{# .D)5K+_q#8CkkQd9w˭_tm[s^cj{ 'nTc9J Ǝ>J j/:b$F$ Ҕ7)5%kC+$\WBHrFX?C0'Rh%cv!է):PRϭq3|FNYoj;yS]%qLtޑ%a 3Ym-;[BjL7~º%^"F|ZOB24)`)a $r-TUtK"_/92PԲ.X*sEf岾WqN%z.{WqխN>Etdex|;nj'X [@,R^̌P7fo/+6p]"N`3G>7܋J Yv5TZO轃Z:nu3lJZj0TJ`} ѳ˴3ِ1.G#%fǸ@tf]t@'ɵawzt뢚:<Ŭ^ #= ]#yt/| ¡85VoTŋw]a_̱bC!U%4,tAcJjpp%nmR0Kc6Z^4 #s9.ƀěZ;N"AAk7 S @x-fW>'w >MC^df I5p|<# AJ7[ުgp֜sHF &e0ӷOʔOt4TK"_UEUE X~^ (3rOp yގ36X6n:/fTs~lNE^̝UFNv:WVB_;˷\ȞԺŠR!n$-.ہ`g jLܕ=!znAĮrП%~#ai!wY8UOH=( D@!q 琠1gb_ H[E].kLvٿ >@[gC;U :b$y65)tpHhi 8Z%/7G9s+q)%#{˘Bh{6f?_c0?;mXB~*= xNʩxIfF'f$_lZ+=&KvnJ73=Aϝ _ dO|< k_g 1BP[(?"<.]"5œw,IPDO5qp%h't\<ݗ Ñ+W໧$L[\po]@ .N%YQ] ݤv:i!&ly=0L|<Ovu4o|v2. p@%%eL%:Bo HZQ]BƋ2̿=8/9k z 22Ps &_%Mh|ΔwѺ$3E7'KKV' #ၹ QP\ݛMxšי~deP׺К;@XyN;뾳hqEB|Vm(uł0̏=sXeh{Ʃοв֛c!k4bLLzOu F86$m=AwHۏ<\V9-D0O"|`6kgmF'_y䨀4 &Vok)XIH׫` u=̱w::{^Y>6V 048Q-PH/[KpDS4aC3\J9$i~zVWi7uf^  zf(|GɶTcEGY%.^Qʈ_&שPh; t5 ZB4Z?rx/,PK]cզwGm;NȊ4L\ Y? 7hq&^BUat.8wn`oW!fcǷ9'ym*H u~\]I~}%RKՎu!&p~"P?DROMJ8Zu1H<kRvՕB1.t(Sd~u>#nL/· @BrO*BV.ȘM37c8ĵ<.\ך`DZ ^,fBUَGw ˫.l4~rzZxCˁQOh=);2(waJ=7or neKm^?YKJ)_sXg`O"׍y6؅O2/?vLo Aw;wj$m<7K`tU?*AdJ)i?lK$RSD'8#F_d<M0?x5']~vNV:T OZmm$0Y?^KτMxOr~Y7j Lt fcώCQYNt=xUgcsIrAG/M#U"<]۰7)$J"@@@ 1p"k/}p֭ik) sE ZưnE2dQ|ڞLJQ'AdtNǕ}#`)7[vZĨ21Mcc*.'}7&ȵpQd1[Nܺ1AgBJˣA1?QIK Sԇ%oB?b /]ZkAJ)1 Ɯq@䥶Nh_3y~t]x=hvcvO2%Cbj[Obn5)C6\T-tC-4iPNk⚿@]8ڌw?6kzSx5^OϺBCv6Xn5xJ>Z:}' =@08nJs|!Z'cG.$ǭՋ]O)J/&ғ\MI%!\;wu2_K}}T W[u37`V)+g? _)GJFr%3Tݏ,ڻ2~ZI_p0f.:k;#$xߺ#a$ 56C;mFóTD}nq}_j'I%}}FkT@1o(ߋU μ{yS9&\;'͙}t,hiWB$J"fPvGm10p|GNc a ^\ɡJ(,ϟV?jEWb*˶0jӫhDSSd-ۜQ"~DK -Rv2.3ӱ^cEUٛbIfX*R|в ;@485¯>X9ٚSq@*29A_3%jo3i @,CRb#}:B:Ґv5g~߭DIUKO59Q5?h(j<9aq.Y\2 y#M9kFF=Xvy/|O˂h6;!)NfDFڥ%pbQAw ƃ O4ei}k|䐍x+-ٛfG}$>h *b Yx Lݔ_׺@PyZ%=N[O?\鸏m#Uĩf^rwhȨE ^>YS}@ }%iϑ` ąr M(x£%BqķDI!,Ru(x@#m`AT]|Y$yB/' EL'h&5=v|vsl~kgW ɮ=0(5/Wo%ȿy2Ň\@.),$4@*Bq]а~2|t)rj~ao\2G? + J[mZk_.Bz(ySjݵO2dBTa2XO}aDjMZ5]cV.YmR[䆬|O`S}Vp5羴& &Uģ4)qq:5ܺTv |FJTqkw\J}Ƌe[.Fs"\ x[};͚:0h:3hG[\r; oz@G`,h:*Q.uy-}a<+zWEY|2@ԣ 8-Z8537[Ul UVWq9WYgO uFL: *}[rtS5ͳ6o[A q(OU.&4ͳoNkxZRSeG1۸=¶צS<䋸Q[w"8 /{n#gtAzFҊW;jmewIzL PvlJEx]L̙,Iw:(DJWItfEV1NH1Vy.| F9wh>i z][v"Zij0%U& aUAbF[ FS\f9<Ǣ R~9Ei}:3bi8i9(={6:-;⛻P|qu>"4 jd848wUbe|_&^79[<4./pY7jUcdDFy|S* xKhHٔ<h]M8At$Zwj!n ! c lq'CH+TYK6O1j%`>U=G+NjnHe$j|˨@țyS"_qDV t6j-,JJ86SCϘR][͘jt͹**8˫-Gf)O-d1hg-}W1FI1MBP_iEeR&Tc\kdDuFl{(G U] K# iOX/9Q( .rwz^]=FUvwܣAmCʢ0-"*cDr=> tX,Ѥf|ɡ6҂^[K{/fm- +A]N4:ըJj7Z(3ݾ^l!ĭ&CoiaU"v+w O>>]_BjJ7E1Tw2GmG PL7~I4b0ϩ_u!ko A~r#}ODrC@Z N+N6#٩ңBvH˔JxDA_3C jxStJd`.W˽V/_+'X4ˮ d랬T \*zc[ @_JV 1A*]s2;rTN+ Fv.W  'Փ5}3l\΃E)M ZE `CN_*#6n!U[r!擯ɏk2O u.Ɏ=^K/s`dD[D l*a_(5WI٪lD4|x슉Ya+FXgMrw C|:i;.O,'(h8L4X} c*JSZDQ&aTTL91GDRү>C2xׂZl҉uAN;`zDLa 4LAw59XX3pQmsƓ^D*COix[Vwj(Jchj8*Q,H6_lR"F!bVi@NSRt,{8yyuzͿF,8Ȳf\ZhדR ^YZ#~dVΌg5pӳUVmxƘc5 z3ҽ Ldd!WB%(`B-ѷt,>]npj0ƒc2X(,: ܧGj% crlB\ګC)QwTҬ8fR$ܝ^L2hbupݺy9+(su̿ڦ`H?'$ VF"͑%CUl~RD{cl3aGyhG#fpGw0r9Cd2M8Bɿ\üU`*uZV|a @jN`4i)t> ~۳߄2rp~\4p^IGYHm[!ް51-*sO͓AUU(%:#_** j;2R卭DRx_F$T=#U|Q'}F8K]=ufb"Neo$P{ve3M6(}Hb]HK{S?EVMױP:x|hZv2Jbfe$ t=9Y#刄;w endstream endobj 223 0 obj << /Length1 2779 /Length2 29080 /Length3 0 /Length 30686 /Filter /FlateDecode >> stream xڴeXߺ5Lt;K@\tww#-Hwtt4 ٺys19JRe5FQ;#3#+ @^A֎Qhbm`cba@w:[J:%cgP*( :&#P 1(993:@[3 [ -(Ew vFߕ~g1 ܜ,&9&&h Mvu@CMRU F*boo?\5&@ZCM@[3:(w$+5X@G'm5P? 4|nnnLf.NLvfLS7p9Z@?q5lWߛ0:'Ii;H5p?C [g1( ` hB/@ rw.fZ_粍l,U0f{,l)*JI3ʃϖQ-?ѿJȃF` o$,@:99z0svS [ʛ3kZ8e%'dBc3:X@؜w巙$= ca @r2t]>^;!rL,A:,T5 b*-蔚Z{L̊vΠW/)kkEC Kq6_(9ZIhlll2:F_ړLO5hlAW _>D[\ /Hlk'L 0tt4@`''4&@dk Jػ8L~o&'Y_,%YR;Y0A* YT7TX*YS8h ߈ X@Nm6Y7$ I#GРEb#NP1c;kT/^, YL A,M?A; \.4kjWn;{BT~C@@ۿ"@6 _VA8sT}DAR?8AlAGnֶ.6F)(CT,VVBA= Al6Xs9@:Z<.-dqC1kXAֿdfOʜp' @Du6w٠U9Ȃ:Qdl4q s4Ł /,J@1{Oϋ" [CszXAvП4-&f7;C2%]@w1;c`˯SeДL'BZrPKiS9[d@ႀft;y>=ߤ"-`,/7&*"ۆ ȒٚL edry3#qh7d2ݲ\h9&LGktETũpφEf BG`{Puku{4_E@`(R=#(4J#*iam2e XZ;(اygTRK5*K~jGs[&p/$qmN9%Y(QXP +ZkBS˛B!aR/&0ʆ?մ|DR5ec+Ι(s~HH/uݦQۤ[[IɆ,Qc w|ULl~a\q#V 0S]cVW`G%Et`K'NZ$4x6B5~V>R~=jx?o̕Ok/Wy%=ߦ(W;NoauJk؋#HfԢpb WQILk0_xTTc,&S :_M zBufYf+àM, K' _=Pm{V}uSٹ r& <1.PB,H:xzs ȂB n&BGScqJZr @׻7L67rhҕF^#wɻ˭gPB"@|hE>1n/?p$C/z%zPHnQ;9UTjZg!1pN2r&f uyXx^߄ya?N8Ӱ4!ZgkP o`iT;Dјv JY.ҥ/ QӛW("I)6^ɜKPOWd1™kkoԿ:R5KI~&еE!ztoQ}|迯CQ+R*v=D}eX;g懪Չ_͞_C|){Dͥڏ 2.SGv V<],Ω%8ujUЏ^+ema {&R뾙{W=[V@DƊ_ ʠݘN5c^fqVZ4W7>V1>|L7IiػlGF?#p9l[_8ȝH]}NbOpݭ{-ġ.2j,XG^Ҳ6է7v-7=tdq FU poD[˟pS"oB$(e&N?el0KIBT(O/[⥲a4B"' v4ʺe宾{"te*;r8Z%]=.aa+tpCoUޠ1sS dT 4'&<+T6_쫒F`j4j],+$A]3NG<KZ4 yFeG7X, "Pz>\4hˠdjARYSv/CŠA rꄩ(.s(+5<_c.$ ~Jn8">~m]\Rh'pQJ"֏}J$ӝX#M_DzS!8ϓ̀o_O895=jOԆb֒h GEQTt4i촱LEnD& G*荄["\(3*Bqs˓9em&ZCuxP^F']OS6|*Zո"YdNh'u>rK}<[_щԑV8ޥ3{̽2v<5lJHM$K\/ט҃sqCTy97t oɢTնajp'Oo0?Ҭ-1/ʜa60d$PKhn-&4Q`ӢZN8N={>v-2loh3/{g3Mx q?ucjgQ[|>xQWsXi2 ӏ:Lp!w"&I'Kbk.!^wۖ:ɸh13}R"bv<8٬"ž#5SJN5:&Qꡕ7`!*=lQe^NIҬ̎׻bb)Wm̒' t*\W PlaGoz;.rjӟW&1F#nD 0Uk4^=i*Oe-l <6BلO`B LLËFd9˂d F]zb-8gCiRsoGL*npcT($1= "#Klu}YSxQfK :,/ko&g H\uM~ uX&8=DiZ\e?/QZ}Uhw?izc\ist< *2qy>~:ɚ-1Qصo.B܂SUw^jcwe)e2?C iEW\>]'r[i ڹG]!]")ѻ' 5dsVjcWl1=j^}\:.L_we"Ml 뵸)PQ_taE\+P1]ԔD&8& ahwhգ30ayXckO ]S$F6m}\ur4W;K$R#qjNO=[ƥՆ:x7jdIa 7q]m (ٗ=)e`/jg:xOGuZ_eY:hIgL3 jjKteIZ##D>O|Ye~W|{Iu i}\$`=Z+;>jыѢSlV_ꙎwO٫z[aGSVMjjxc'wpyd>ku$+Ŝ3&҂l! ;2~!ykq&7`i5'k vbah~ {@{(پ`t)A)OY:OYlYUk1%T_iiețj9MR/Jzns}UC2tgXE. NqU`8l!Q2\f"t>MxCGt[px4zk]EZFG, >ޑ.ϊFzgdS>@\}23&zmdZPՊgSkj͑r(3RM"w5k(>{l3^A>pX ?w6rb%^o.wƻwD'|f˼r~n( S'H.3nbS"'JIm5wSq.n[/;w!&SL!MMO}*c$3݌M{ N7n= [R2I+k2?_+OJG9 Y2|<>iF(|yLf^R5R4q, ζ2@Ę׌U̅gP9zN\fpҧ9HuqǦ}W+y0ANs@a9ZLz_?Ek}Z 'ðn%TUnHR(m'qAVv& +^%Qc?/B$ʂB1M-RzRaW6|<>=Qܝ#?yP=}c~'\p{!^F3B7rz<. ^2c[)pid%D>8B$FW*55nU.g >vW;/`ɒqxv0lJz;CkL0:J?j)>;g ^妢"mϝ\m3wh(!Ʉ#Z~t"~DOmdVW)+}f5^0/헗Z.~pPEߤ6&Ǖd 4- !1 êjzVSuJ,!y[2vcC2P9lw6M X 8&mEW|R|uOKZ!_q?^&.5˃zsm>@`ᴠPtE!K]{--#Bp\ H[ +^IG摡#A#t]ǛwFW\,{dɫlSV$,"Q<8cI ωL!,}RQE~89*{9-4c/XH<EzG:I5$k gtFNG`1 Im& ַm:wDb'HۂȆT 7gҚҫ f? ?$# 3u σm;^LtJM}hB.@#.kJTe6.t mOcPUfgYiC% : ETOݪHTɺRi֬Ř g zAixIr4ia`KPV_ER930^z}E YFDI*%_ %]7]+]6VYT0dr Uõ.|PA^:[ʗ(\ַ֞Al%Qeg.Xh5$4᧲vhJtD=8ATL|n_ٿƱ1!ypqn0͸\L.o`'6-]iEp8tI,shxn d*;o>F5e!XUk*CY˾COoxӬ ȇi2W^j a= p~@W*ÎsIx$9t0ʒ[jUy3/5_A)tO#f;J介+4BlHs2D$=ke,e",Ĭ!j͒aTԀ6{D[4Bq5%LDnl~d8% 7`y#o%J9nȮ柉@Y%ɤO5nM&0e.2<:tB 1^w1v}V+$̡$%ٓoķi 궥Hw~=@9n49KW4`x2l3x[Q ٮזBt.h 9MX.Amm=)5"oJ7N'hi&o#,n*x!s{KʐJ,9hbE׵'0$ [gp.c=VD D0w##J=@=jd }VRణcFe/iHV;e5m+`䠊ӽiZ6uc܀|}G_BcC>Dp'}g^ U26lbaZ״]#`RqșTcɟ\ȝm+s*B5M)cXۊEF܊?.G|/qƐϞލ))Zٚ`r*X eIQWd7k:DžըpcphT5AyJ@NQ& }3c'>Na6i+t/$+(h-;.^,C\c⡢OEBmRQ2uk??yz[ !m=¤V:bwf:)`W}{Q/-۬dRs_$9"_^GI=Ӟ-rѫ\}exeݯ#|[Eupw\y },iѬQ%4Q6=}bK6P9Ͽ2%cek<9<=Rf:"YOeK6@7h"bhW%ɐf^ӽwb)>BjY/~dZ~'cG.Dw G@ C5'c}:ʷ/b ;_7IRB~d+W^vV/DZVfl}YlaD0 ( ͮ ӹ^U +\ =-,ɚuؖGA:Z.CJN']# ەqn|Rv=P_S͆W0$|t-7'T""%d֙~*VBg~6%Ļڒ}|ϩ,,-Mý0E{0.A|l;͈j[,>=-W1&L _=PHmnbI9W"8Kxu2_3Um{G׸zfM~Gĵ- UO?X턶/9zLO_LBMQruHVqTl|w!-_b 9KC0ma¡m)8vu; VE;-š`_cԻt] kҡŜz8hwm--H"p!ܳ=ZĄI@l*;u6*ܴȍ7"|^zWǃ/6AgĘqy v? FjR lJ {j>` 2߻(nL \}5Zơ񏳤&O%W[:y?WkYd^W%aS'eɷ~_bDU69uX[M_najY8jvnڎ+|#WDr\v%^Odnt;K3 r/, ,h&SJk fyKQG6͹tʛ׬c}sE7 FoVqmpmRQyЎ(~k~00'GՕ}o7l昹C(ts2=+gm+ 03=ebGXSTjك0"i+>18l Ŗ"]mзoʢ&!I\1'8pmjNq- QdtMO bϰ贼5-nV~B\Z @1`{42 gLo6.޼cw8ՌG7_x|[19lNrZ/D,(7e[nցå5 e8ĆxeLܷnI6V=0J`g)d M IRs>c~aAt󱁄\4cՐDe8ah0Vͥ_4}$;v ~o'8]zFoBn}sQ1|E,%S1'G5޻~)\{]n/_>dG5y$nB3Me iX=tb-Ap+G#'.mZ}zYhligೖgۧSX ȣi;LnH)]36j17XeRsgp( r+{OEXkC +/;Fsʨ+F0fdJΌ 8Th%UuFӗY<ϯ;:+:yM)Mߍ8 sw;Q c!v(ԵWGxkJUC2 l5G I^qP3%_X[? zR5߉ 1 kAm kF+.3̏7c$C``Mߠ&'SsN1iה*P{fD3)/.\WGԟKqĮDmW^rS\,S{StB*FKPXpL-pri@F>ٕ,V3|֕,KU#jY8)oS!7Ҽ1NX+<M/}=롬ZVI(ڳ3 CDJY }WQ{)8 W2$//}_ -Ko4CI» uLR+^zjF4a)ѥ?yG#8D>Ws˖V͡)2"? F*S{ͦdiC-Iu4x_6u/#z7B6Ң~w7D؞}E__ft Juv!*(1Dr+.nFKR:kS--ŮV3GK{TDSGo-. *%p|{e3v`ʭr K9msU jOV51rێ]j*B1/'ҵI^@χˈ̰pǧw\3C_zn!" rΣYrdM. ]6lW_gZxF B0 ÿؾj?p8౩:4#OG \Zeo,?8"[p@#,:|*I/j9L%, fc.y޷ ^Ű`EZ`4H@$H%CjR~ώC=9'g]˲o$.RH#T[oX?a_>3֊g3\QvG-1dIfQC7F9[ymF$z|*dS#b-̕>4驵_;WCb( D}gWpN ܹ2(/ȊϧU lu1s3}_Nu #`{p6 I#'8ìwkbH0KEM^H3D H2^PkÐc[ |+NU9Udq7i G gVGoSfu*$)!%YitF`?/t CbC-,dHD<=DPؘ\]f2t%s4,Ym~{#dqdVR]/`k1{] ,npO9|\܌ȧ?Z Of5+rT!gt'}[Ӝ -BE8h`x4%O洠*[^Jg99A_fi=*&?D"&՚s!&ïT- (eD&-嬭VD L_P̙q4'E}hZ[]Vgp~ Ens l- lB$s)|"]S#a8m|w;~mHrG1W6 z; shUm9^΁cdn1m6i(xkZV[H +hkSufږtV?QRS^tмG'H̃嚲uy7ZzYݭRKU3.$ J+SF etVLtV~R/Vyvi €%m3"Fգ;-uwX;j*7B+z`D2Hb:fP7xxыq{ZLܟ/Qqݢ<>7dQhŞMi+*w )jHIBhBʐqg bH(e`gOk,ё'cmJ Gd,?r&6kL9[nSCl'$ f1dUe#5eSц:!]Vm@ӈ^>1c+CWX7;S 2ڛ=xk ]3lG`@;X]e2d.%&R:13qTLm'L*5*Ş/U^u*칗P$DM oǼ8D!8ӔH''ظPˮf"+?!O^q<(ɯwyXщ^[fV sڇLBhzqW(a)&Ǣ_[`GjԆwGvGIDewJK\guGh1{z?\OX0 ؏h8O 7-k!+Z~erwS~K>D4#8w P90ߩ񼃹_Е\@峴'Q , b U Up#vBQ+6@Iטu կvݸG݈2&oB'S;8ژlͦU6'/> ,l.>7 ŹQw׏H+ R %;fxLj^Z`xTՐ fYHl",rJiRb 3 ("ƼC-U2U@+:T{CP^By>LZhloeez#Z!bM(EwMU&"q+-G#w.\ =9UTbEG\($ f ߉'Φ4m#I"k^=W,JIx7<usʦ,͘4R`lsanK"!xRF{PGqd:Cf510*Ôv{D(.a k[t !Y[ v)4ކe4!^*8҃6T_X'i:C.u neU0Ph7Fճ~d"NSl4 &Pj&} NfNPzҘg[L0$"ei{1óluid5 k%J#?xf-rNM( $g?B6pM:ӿ?׍r%8tSFP213P$+/;~pb,AF qkĶ jLbk.Hʻ'K!'TCȚw+β딼2BRo$i~rM6Zo4զ1`N.zUĊр Z@;KUpwwW6b~Gy +yVK5 7/ȪFUKSR,p]" zf<HCcȨ'ŭ_c}~>JTa)Ƈ`-r6a@(Z tiѲ_uzl]u/ twlRKhAQN_NԳj.YOpI$56~$SO(<5>h~F$~7a:9ޖn k"ÒG^u&kƯ+8̇_Ц ߀Î%Ff>';:'t|e24Ž $cxYHJ`®?@´hK -8.|$؞P%}N>*#@ .0G}9?|6Hw "1wkݲ@M X|DQed< ObEa*a~_c+ _mf]"e /<;7KbXBuwD'1ygtm[$mUΧ,C {gte:|s3_tĵne P\m@!^ ?d6[w=,p Y-'RMXaK΀8 ԊILB @Mȣi;@>|4dzQ ufHR7|n;t33d[=Kp$"B#y;vη:c7A lP2tGPX?`xyӑ[3D{ #ȭGu:qA3KN|GVa\aޝ!vb9z1Z?&ZHd3K@ЩxA(Z\mGP>1O1 $FD4t8akYzDـdTҢ{]_0(^ԋ8tV} |7Od kxp?Žbƒψ9 ޑװas02\z|Y9:%8bQx.f$.9eK#\x> $ᷗ MIm`> HjZΩW6uU6CF>DI! =wmD!-zʜWB5SsrH2<Ȥ|k$IA.Z=@ƇGZ9qBl (4yh 1vAjv-) ɯ<DD2(WHC`bje)Y*O01t%z- z[G I"a/V?l}ŊQ@7`Sh+Q{5T3Y}[>9p]Z_/5u MtldqTYOboH__펮 \.~~Wv1ǿ9Y L!)P"?6 Tbhl 4cpI)&8B+w#zMf+#WN{EYYNPWvtc<,@Azrm'Q< ɵP,FJM"D"I2^U9dFIx (8r3 a],{ks9q۷]ʣAt^Mi2:C c[Fxϫ 5ǃ 3[-dJb^TʏIk]%AKΆ#ur{%K3-;:dnb]7GlA $w)((Eka4Y&cgM!U3d '9@&P&\ (V_UqTu%hk\ӨtFofI9Щp tp7~LZe7ou$:tB7EAd^CqkF}9b A*JxJl5Q25&Yo TJxۤ/:y[ssVWzɡÓ8m&*O$?E<]Aja r)W r Ԥ<W@˂sxCp0 @)rǪk;*05 *r17we\ۡWQ͟CiYK,$Ơ ΗSYTG~ThILiG/Uu6l+1}u!*Y8D kxR^;P:bxAzƾ r37=B,-.42H)Ӓ0΂pPChaM7W`һϫteUBLfAUx]]ky>U5%w:y7xmtDh-GanOߎ8D= ~,(^k%?|t_OE>'vYײJM^;S0e8?OJ:N|X gDT{3+Q?(3{S\P$7yo6~ADmpE0&j|( VJZR :9bhX `Iw;qeRE%õtoSDJ#>נvajf[gT|ò(LWmxf*gMZ$A2QsK`ү׮Qoz}Q6o_*j՚Ç2+ rkkA.֐OgW1xܕV|5X bE,#r&o. aZGUBdMe׭N U|N>q\>>Yoٽ)zQ_D3oݵM\g !I0iôHݽĘf aDS4;ԥ<ۦY*Q(,XR|:>̈~+ߩZp ƑO 鷧<AF?FQ럺2rXgzƮ*!aYx67(frXoخ%/0·Әf:4\j!>"i(9٠Zw7#HyuEOAL1Mt{Z2 Q@AEWk!SCV a 9g^&lY٠3n3Ϳy KϬڔH!x e8j͉^8te~63i{$ gNh&v@)Ѵ-VU_oiVrO;w.$1U/1츦 +(%2I'{𐑎zQD抰+K*%RD;3nXRlӾ{id9`~9rss9;0_l{ϵhw˳L4rg vU`X*lPP~o2OU#Pfr3qPȑ]18.0[fq ^D4FLGMG#x%|UOCGOeq\pEp&LP D(Gc.]҉L_A0It_P?+4 KsM\Z p5B_r2JP꛴2qLvL%[,(PrgP#o%_ 5أvűR] b7| MN ʆwY}y<# AJ7[ުo:,y JTWL#\g$fT˝AH`)SWiU}wb>hIK|-G!yCy^,2-|G^ ,2G>T+rw'\0/!xiWÖA:1!}h}Ԗ@&':8ﱰP}L_H)¿,$d٦yWEp*m`ޓk1 G~^?~:S5w}ei_-cqe$ 碎\ϓ)!Lhɗ(o0E|K)5s aIVf,}i8p]M 'OBa%)D1|+0_o#.oHK=6Yqy$h -$KeuYSQ.~hTQUoG[o/+NyqW .U>u}X.} {:ܫ`v̥CwX.8OK`9<6NM) |c7aubڶsYB~q_*D*qw8y(f>"wlB DZ Hjw1iyv;U0JV;Yw=qӇ0aPI(96c^^mDW~$:phBs 6ٚ"ol((P<KPP9(}zM @t4[9pةDhK1PHyvA1' 9Yjշc'Hf[o8qUߥc.JC_O: ЇFpN!aFS*@ {t>XxDϩ{k6cp Vmuw*^%SŌ)v NÀ=2&Qi3Cp d^aȝb_%TΤ_G.¾3l,mWf̩6YPe+ DHumD I*3EV7|1I[v9"P UY)#mZ5EQTԍ&,TD, ? bjtbDzKN O?{ h ʓai S .YbkBsؖ62?֮m&\wC-kB9o ;O-K} # ghOFrIrXݶo6ܡWrR]"S]>;' qHc}2"Z5iһ&"&dfˉ2&lC<>6^ox9ׄF邆[Ũ1׽îCfB#+ۡm5?Iz#Tz m:9f5= rV\O"k*e< /$B0Pqw@ }ݞy0| xEgkOA5\ f3X)3b *w]8@Qe %ݗm3)J==tWfi\i=6,79t" ɿx'a}]瓝p$ԞM(<\K}s#٧ @Tv{n#h<^B|-3|Q5fKqP4j^ְҊb}0 3`kB V vD&3V.^b)Q+|x+M46I]:f]c 5la3g4$yǞ]-t|W\K1>\j׼Y \_>ne@բ`**NR'5JIʿ9 4Ȓ<|,/'yw(vn䜐7CtHjpd?YO9LǁjD @H>seC̄wd[hDQQn;am7Ƶy*RoWMd;_߸d#᷐.  0s[3P#v6Q.3~-?,qw#CO MU5h$| .U*s`NmJpZ=5?EK0]3u;&&׮ǀ8R=$ݨ4Y^7ON2(Qރjtm˓*rՒ^&'hX 8Ӕc,gE2+e]z؍o^‘_͡$h~~RNSBQKyicvNU>tp!Itr'T\F }KRY@{I87tFAT&j&Dݥ7)]\l8ӮchbK3q$;+^mnB[t6 e'!(pg Xd -7IӬp5@05|&M^|r'oy&_/T} nrO3Ap(oC"? ¼p]ӥZYŸiْ&ncugS-&2X&Z`ϰQbvIHa׊#)h)[kAK1e~g|p^aC+1" (z-%ѵHwr`")]T#N)nS-8IT=OCid~`1N~)N6jBw$']yV43Uy"~}V7ű?U +tS" BB± d8P !XRU>Fݳl2Cll]xėoQDAHvzQeVh$~e3\h^gxi1SȆqqMBi)"s%pz䳜@''8ctKQW5y08&7 BĶD,hJOvo4I? G7pm=gR4W8Q=iWqVvYs?gAD~3=jΓ~43{* ~@ձB%4~vjdcΝG !q^+Ljf k$$]]`|~sm$_҆Cd`d-3nvi촥jPm;z˛i&J{L67-ŅoTm"ohzOXm+X[ALw$:E?{A"of:CȢQF=˨[݀e$Z۟N>ũ3ہ^# o^%(q=M|Nk:h6G|~IvR>!7)HH"aÜ-[>XIy 2yE:T6.Z#f{?~ed}-xާ2 [B-xnBSߙsqnCENyywkւC`7lwExgs[RkL'W)QJiEmdxvvL:2< 29ۇ <(MdSc J)qq,e]F**⚀_'˦,"&w톁6oԉXag=ۉu@RQTȭ)7u@<( ƧT;19mdI 23'/2uvMVc܀uɮ uzZ¤/*RNFHnNgJ U8W9n PPӡ{aEU,PD p. +* ͆=k;uFb[SqMc<4 ڄFP˭ԯM+bn9q4p@K_)i+4@jSuAH5d -b] ghK+S0@}6NƘ}GmUP0ݡ$?Y1ϣ 3NOYRB2&|jW̧EAt`9l߻rAo 5rŵ㚁H="e8.yrFL+-ǂɖF=grļΉSjG[N tM/YGwfZa7Psc5p{d?$ #/m,%o?}|G2o渵`hArRbB:lC9BuU 磤&%LixεњN:tͳvBn$\$lDwcؒ,*6 hFEHN4^5]#BnnWܮ kNKJ+yH|,E 1tQ`9@6/hei1tM3lLTG(aNC:Jp6aٛDXENqo;KA*ҭ qU<(AuzEZr>A =j y 3W<@ENe&!Wrl9vV,$ŔC6)sD:i't5|EGv(| [ ӎJгzއ:-n Xad&o}ً{KnOE4Plqan/6Bǁ806wO6 bVqr=r)]Cmfi% J*'-ηXp!|ӴK's{FhX~%4x4m.dF"͟$7a{D.}>vHp$#oH0Tj2}XWm[-zL$!Ϛu36JNW1d: "@ KeC'rgQЕapiU  1T_zg05.uI\U1Ra}olbR2*Y7 &CL}Ir1[ʪq'~pR6[0 { vC i$ 2;A RWuf8: Aʚ󱈤<ѹhi,x c >L%$y8^:f/C՟2([]qʠ<ڰNȍ6׭Zc~^E{eв \)E@8DE kWGNSI1NfmVl f/'hv H]E4yâLBַ>yvאm˥x:WXʂ׳6SbA-f@5VXC{5aZӁuscH[ cGk G L,:?s*6|6 㣿ի닉2&G(ԡ+C䫍m#p!Q~@ &ENe7(໦M2idєay.nr|rԚ$t|m=>$,mԁbbPfMӯXJ.V5#?Й!kPN6*K %jPi\~u( A/Mj"Dv$tg\0MJ#c{E׬`0ðFI}X356mRz'ɖی'M8\,+UŸYd%_sF4'MM #j(P7ʼЅS)I ݌G=ֻo[\:뾂홁Ȇf&S5pO1f./bHxE3}4X )geL XN;zioI(pG46B ^dVUMoFVfͼ@aܗ6?D> 8tX }ќ{K]a"dj}k+RF`?N"S|]Cpe1d[eu_%7aHhP<.v{/fgDrG@5a<a3yL2eШ2͔e-|-k3ZZ4D0nrzx9XbO(]:&~!S>30 n#92.P S%pқٔQNE@j)Xw`TSt\lRf̴ 싩Q$@1 *JCKXx(2Z~;:#AMR%ߌ RtXѷzwUudƟ=x +a  ߗ×Xqa?}D9ID܈dSjX4M6ޖoOQP]캽&>AcDU6kZ4W}:2g;CWicrFI| Lt1Cx|+@|%뜳-}k_PX?d.aC&` W*ԋ6.gzb]d4L^z(e^ZnQAB"n%3_-yX-+9qHZH0:L@7r@Ԫ)•,\b+WV{ح-1aPz罚[D܁ PiQ"v',_v:L8Vut9}ױ(u S<SzKV5HzȀTh{{&Nt=`"qT< Jz^NKbD(xH\ZJU Bb|_u\竩d܁Qn$.v\y6}.P){P81>#9PdWaoI w] FCst89tLmh}XKp*+ZŁl\bNOuT)a@vζpwG~n9T6A爨*V8V!JaO57Gbwot8 }ɨGAa(t\ߩy caP64a) 0w/]0<]xyBzjDq.9v] endstream endobj 225 0 obj << /Length1 1953 /Length2 13753 /Length3 0 /Length 14962 /Filter /FlateDecode >> stream xڵeT˺5;!wwKtn NpnAw4G>g=2ԬRCLR3 +@AQp:؂\(@g,a :[͜_3(i 4z&@_@bj-A` k8di;?dLl nN6  Ǫ PA` 2@,@:@ZMYSE=khJH*iHZoҚ>5WoJ?}^+JjjHrY ttintj^͍əhjo? + hxv uV'$uIv{󟚶 8\  ^M]^@s]P_/u1m|Lc&`'Ͽ濗m;Uwg _6EQ%Y)Iu WY!:;«yWJ!vvPO:'g?em?f ]4 Pc:@̊O:/{= ~x9Ύ.@;pAfί2=*(U[@22_czF!`[9M *N?zI*1؁l=+?T v&@@s_C_D@ +;y4(W^??׫WUـNN\Y! `ӑPWO% 6Nn 8^6+wqX@Q(7M/ `S7LlA6#vv  7f77`|c7?k%uZ7`s|r|7jW:=u*n&# 2K[#]\q__J[݋u|̞Ruu_5݁f(K3 ƐR_2xZ~֓ |a8vB-*OtߤO" <絖ʉ_"&$o$EGhjd(.uR1}-hk%hwGq`L/k V8фhIA8ri+4c?"`Ӆ9%OC YW '.u hrDi[%0_'ѹ =6+|A 'לO\џ&[T9J- vHz< Y?,k{*wψJ`&Gs?K$2,0$EwJtYAJIBG1E뷥 ϲF2{s>4-Ĵm&+g-ݠ= ȫWyʰ~n"/qu_;z4;7T4[/.D+mIgV % )&UB0%6Մ>OTR ])+mB}Xp}Gy i(M}l!C-$"ޓkΧ,MZgaX LgAYs܁bA{ZKֈPr1Q&ڈ38~zxN7zL)#F|v#Fj$|n^tޮ4i6k/1O2Exf݀"}ZP^^< bo'E)џp3*Oirr'沙(tUZ=,(0ưʛJXI^SRimA=(Zlr%nPhT@|ex- .[* "BV﹜t哲3m&JY@bJ^uXېǰ7O3.tt2kM>uI)_j3c3Fllͩ~"f2{l FJLnLJOi+(pB莠K 0{B^HalR{ֳD=iZ~q0WNw^]Qέ`hMV~PM@^a6 D{"S(KWq툯5guc}RxgkV'_ZiCː0]v3?wR}U@rZ(ç.2?=1:=) eQGWOnj+2$߰7HF4̄u !ўNE~2²LC֗=d։8:!UźC>j$϶*&r~OP5{RޠX^,yA(&vcuuG^kGi'5tQEl<[LΣ)&"KG"x%[}\}ׂPs|*:h䐮1ݜ(PHn]e?vC, kc#^QѸ\Kb,iR[bb,xH6o-vg?|2|o[*b宀p=a:Ť>w )wס+ܥpoowa߂؜ʯl>h_wqA^ɰhb_=UoWF[Ŷ;b*/q VҐ,%2ф?|;[TK;Hh3]|fel-/`6\IH C7Coht+<ڒBʄzFs:Y( }'yP7o_I ĺn ]ͪm&Ңג#SNe$),@ԺpسG/tMT*тӪ_H=̧Kw4QDrl Ġ (I~ŵA7bin&-bL2: ]ڿnv< )/^} ]GiЕH!'zW\O6Z 0^36WTI3VrF16%aW,F4PX/kj-֋F̣5׍ W3aǷR E&qXb#f}t`t6,ӖD  -N׷zuX}fм~W튻E~E\w$*oTBRgX Uhs0PhZR ) +Fmk:{GZRꮳ ­ި%KZA;Xƾb'q&8U}<=<o ]5tz9uGjC%=A<7aYX KmO"߅E^v iH6y+׶HeӾg;pTֹ o?Y9MdfM%E3C; 1`Im[b%n@'{kNހÀ,Lip+#)}oRK&bnw"Wrq/Y{9<r'jq Yy%CNm[D*:c|!tGX$cU=WC~s!Iu5633FMhʑEݐ%G^i!!R(fIdQE[<-4Q"F. e¥3qk\;#Z>Nl:<Tb;`PkSCY* 7kJjoݪfTȓ b&ĚTڇ3Tʤ_}H,/}ĆS oo+ΔIZ ^~J]\MοqWXisbx/5r;!) k/4q/eFj:W#d|2#tФ<E"P xډ!7n^w`̗}t :>yqS,ޜXW0Aѐ\Zw*HM~I@ F6 \^[[Z]:&:rkfN}Q7ed[QGDibU}#܉XS$kz2(K_ym6Ռ)pmSClNyJD.#:r cr)~ڤ%k,V XӺ>}fOɏBtC9J֖޴{ʺSC:awDC̢rW/hӆR"dH,=/[Q&r!5E}$ҦYv=%1iMm$o4}cBϯCꋙ2c:O`:#xVAd%S,ʠVG;mg%ow rV;,[~<ȌQ yγJp~ ,pcϹ ǒ݀'#%/\L'J ~S7F{&AǍ2^m76 +wn>_&DTb/D%.7opݥg]:bOE0MxoFAɂ7y2dQ!ˍҰ[X`ux+_(z&u$ čp6.xPi[FgΥ ~1~C}˛Kq|!ܤ5쬒b9ԩfpǽnB>?ݘ؇.׊X:Yp]}4[|C;Es9tiQd[lfK(HLC '߄~sM?>5HTuh,86QOL3@4^Bbe h,,Կ#oT="u&8==N@zX ,swq":.C?.Q!FL0sZq]&] V M8ۥs(B$z.8|{Dy:+"#rx@f'd+JDWR ^~| +eYk6:;l|dAO #S)bw"&A+m[+îݿh..E-*I2 ?B-oUxg42&oGIo=i6{T /;G] >TOp֍V)3m2}fgI#4zP%G";L+y7zCZRO7n%Gɼ(JK"k0Fڱ?jyI]Ou$2{G1.]pN* ^ 2V g|(ƇDcҕHO~|eD6G_: Ч1R`jLaˇo!˿iO[5 񲲙x Su4rʘtC{?ٻj8ÄQ6SZ$llAW[r3_SL0}B(AOجvsiAyJ >ng0ftǐoG/W"Wex멓9SLI|L!V6025\O>64۴,V}\.sǟ130ϐnr,hmV?HBхqҳId,XJL`x)qP/3~f5zXDd3/Y\̵!UMʭIU ^~5bIA!>njٵ!Mt\+ 1+m_WRpC)wyacݭ(]C'~p.< 1&5*;4RT}\"m٪귟 kGQGo\o'l5Wp=@QRA:W.}Q m٬*:WAؠgkc|.,t d[J,u/Qȼt&3oN>e,hM|TDf/FP&Ձ{W!sԜ@ G:|"LxN Z o&ehwK %kZ򡩶p?U\!> &[ ~}_[=^i9pVgFNY%]q`q s1oﵻu!eS_nbWGFVJKֿz6 aXTՉ-IqǔB%{E }M+ ؟8LWy/k0S~SN`"})U+x./ƲW-㘄VYV6af³V~>%u ,9j}k-?Gۏ+ܶwIA5!Xr՛b^D,}EV@nF(5QJkO,VDsUzmX)C5Ҳ5RC4Eg˕J 9D҈P1Ӏ?z0N>#zX>i#Uul/cl}[ lŮzFɰyh sMnU. hFz\wSK.8wvjf kߣń/@ϠvB,8 ОJQSx~,wUE咗!cxV)[7Kt%X.wFKy7T? lY.m&!k;QiV{3?';lM%;i<KVØ`u"o- KG'lH욬vm#4 "1~go hfqԢBg26k4Tl Qׯfᢧv0'"*ߗk }@LTHvbv)7j0{:Υ4;jv.@}\WD2pŃ`f:U~` 4xPJ Œ:𰂺M(C_̜6\XVa1ڰnj)MObxvRDc]7PscWR~R+% nL3gFCW<BQO]G5qCl>2eBg`%,;^1KN1j7}wJnx sjVVU4e ՠҜ_RK^@yMvd7(Y-s! Q7ciO˅zgʪ3vJPSk#Νx|iO d.D:GdSRF]վRg-ZY\Fxn¦[{jsjŗ) Ki^ F&kTma]wL;œT(d>!w҇1 vmPRH$z)pp tk|,5KfY9_Vʩ’y#:gf̻{q;]MiZs%R'p|c)A7/{~ߞ$M0M3DHi%}*#3č}58ȿqs3Fa K[C z!Ko'=K)sF"0d;Q,ͨmtKXqLzx`!+ CjہϢY߾U?>O;/,g0*0!jP|#^Fnˌx: kKz .bB,FuoW)?4ز3%d6ѕ}?Q4]@;gLܶ`ߪm<7x]ru.S^SaXI%uO3e&$+1d?}#JdЭYNxqVOQ+ő::"g'p [Tβ8P5{ϓJ'Θŝ~MdLEO)/l˕>9աK H%3pD/aT0ZމB8V;hD9[d~j̖q_[LSe.OPr_$}AT A}%fr#zSy%D\QQv̤/;T|g[! \]%2Z]:u x9>?;FL=2GXTd**j~ęYVM qXsS[8ĤX*KDRh %& 60CC~фnzoa߳Gۗ-c)3KrijZykfFkcwaC/1!%UwQԈu6}= |:Ҙml9u0c6rU,.=p>0ܦ3LJ%OXr \rrRNuK-&>_1#yGޔ]^hV }%tv,NSaS9OKjno9ƘaMl.4CZl.n5Fim/d~ 56zz6ňmM6r;6gDm=gOJZ\Ap<7QjqDoV K~l4kE7n1g(YGNjc}Qehk,Ooy3ӪG"Y@mDτ6ybwJ4鞘yدX(hw+H1B1q~m{WH"v SOffooGTX Z&b/qڧ a"171 ,T1ElNѓYA3l2Yl-5ZΣz15Ba]o,e׼YEv!4q`R|q+$q//L[^1h=K䶸'hv-Yc;cDQ(P&䧣 q?zk@u˟ǥ;|u"8$ >ц|]O~U5z[jjƝE ~B. kâ/u}_^.jQn l }Ci^?3V>u6LVCy^=q}qɛw23F0Bz bTx-Ĕ׍Dd6 YcG pZ6$?!Vp0V0Ii>h[o+f hKYW)~5A z_STQ'1h.ؽ˜ @?Mh+R$/w$s :brІIDԙ 8X'Zi\AYt'MLƁZmI2~.7Ϛ  &5|.l$&c7'8J~y[wQ(VI"wϿQ fێ(+C"?|*)HǧK2C$v3:l+^WxnOQaqnsQ˝>Ga7=T}S?GMsQ+ՖZ;ߒ|_ ?oْPȥ+^l讦T M*c"0hXd%6 @;oӡ.ԑlKU04 M="͏$aƒ!n,6c/O~A O8|2IҼ犀H{ ,y" Oݮ:i1rN0viFEx-"Ypw^0:}F 1WyS$mab ;rM;V;db3B0NF*~d@E{c` \U/2ɘ;?}>kzColFS4#܅4/ ,U,4CqbH/ԛsY>-[U(q8!)4Us7\vB]u1q=5'K%1Xph,Aɾ\-{JCץ)/K f8]\VPX\ϡ?iRmi}Q˽wm*M791-H{VYwZIiu I4yvj_&DȘMaح'3cE.9f뎄:r-i`RiZ&9o4NJyI' WfNzlT~~B=K '\)#y {vIG˘FId "Ɨ?}{0 ӾJIO]*anS௽ޮDt~d -NS4Mǵs$="@UdeU.n{&i/ I]U=c0^7A ~g0_(w?Pd%5[S]ȱf2Bm&2_Η E֩Lw ATḪaOY)do]x':놂Knq:R /3 KX##;|f2 =pI4{R9k؉A`  a0K'<*oiEADZ{Lhi]s5s(]L/opl#&ͺg^vsHM mdHᅣ"4mȷ2ju_ȾٺZ`;!`y#UC`g_Z]W_{#*}'#IZlu 6>ABWfѤ4nڤ@sXwXև~`Gy#M'CPqAǖ/ݚުŢ&5A%=0ܯ̹)l !#4y&]l=w5wUkɪc|T+xө7ilaJ;L5Srg^a,t)_u!'%U](gC a&{>׉o(օ{m{wzz95SV:/M'}Ɣ'Dol Fh6ٻ(f'n[km؉C0~fcBnŗv~y}sў1V8E@~ GL%!'~lŵy  \ta#hneңL) bRf]4f-әhSZW/eo4,) Dft#8lIJj,T);-i-fHj,Q, m-Xծ9|}_q}̛T7b['7n+bRCieZ~YVJO5V3ɏxL,~Wk#o^J-e4"rk7<؛'wQORF!=Y">8]aJU,]6>Mdܰ\֚39_+&]X+:Q蟖nS柺VVLڽ%=l˫)gzɋq5 I~ ϘuH;X*dkoqKW ^)ЦUԘ'\ 3d _.f"\3xMTP(";9*},x䶖Q-XђF@h'Gi YTʗIZuLe_ѓ{Sugٱ̡*V * U8Q]]7YH&[:mYeH'ymAFEo/8ha3;wՕL&Z^}֪+F?"vנa~μ岳V=9epsV| La6Ќ gn iޟ|xwx7shm"㦢hA7--{#1C={njfmj"8:W %gf%RWB?iO>GfH1Jғnvs~N.<3a-2wX%U2iL* |u60fh{{N\RwR ekkHܘEvha7hqVpɧo(#fE}I 06cS;mmGT,1 ~);JHqMb,[/<.e1M^ /m0ЄF6qNg״$uəQU)iy\0nP,Mc"}U>.C̏6څ)0g}o L5H*\*BͫZU8h%DHh pK1{V?/a+4Sw!F $e®hSONR-Z7:q*41nCS;.?s͏ؒ6 Yݿ?R/J"&#L% ]hB)õq@caъ֡? 9dj+t2]J\HKOq^lmM bSD7 @ٓX>|zbsy=Q΍adLG0+D1Ekt2>@o rߡp/)0[ى%̋ۼ/*bUa&,v A~!QhY&=˶kOۅq γN.r Zw: 1daqJRӽi/mJt|OMY&y*n#uySXIzXWWy_ܨQ5UT힐H<@F'[LC;v59o% qAzbE endstream endobj 234 0 obj << /Author(\376\377\000B\000e\000n\000\040\000G\000o\000o\000d\000r\000i\000c\000h\000\040\000a\000n\000d\000\040\000J\000o\000n\000a\000t\000h\000a\000n\000\040\000K\000r\000o\000p\000k\000o\000,\000\040\000f\000o\000r\000\040\000t\000h\000i\000s\000\040\000v\000e\000r\000s\000i\000o\000n\000,\000\040\000b\000a\000s\000e\000d\000\040\000o\000n\000\040\000e\000a\000r\000l\000i\000e\000r\000\040\000v\000e\000r\000s\000i\000o\000n\000s\000\040\000w\000r\000i\000t\000t\000e\000n\000\040\000b\000y\000\040\000Y\000u\000-\000S\000u\000n\000g\000\040\000S\000u\000,\000\040\000M\000a\000s\000a\000n\000a\000o\000\040\000Y\000a\000j\000i\000m\000a\000,\000\040\000M\000a\000r\000i\000a\000\040\000G\000r\000a\000z\000i\000a\000\040\000P\000i\000t\000t\000a\000u\000,\000\040\000J\000e\000n\000n\000i\000f\000e\000r\000\040\000H\000i\000l\000l\000,\000\040\000a\000n\000d\000\040\000A\000n\000d\000r\000e\000w\000\040\000G\000e\000l\000m\000a\000n)/Title(\376\377\000A\000n\000\040\000E\000x\000a\000m\000p\000l\000e\000\040\000o\000f\000\040\000m\000i\000\040\000U\000s\000a\000g\000e)/Subject()/Creator(LaTeX with hyperref)/Producer(pdfTeX-1.40.19)/Keywords() /CreationDate (D:20220605013115-04'00') /ModDate (D:20220605013115-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.19 (TeX Live 2019/dev/Debian) kpathsea version 6.3.1/dev) >> endobj 164 0 obj << /Type /ObjStm /N 67 /First 582 /Length 2828 /Filter /FlateDecode >> stream xZ[s۶~ׯ[9Z tƗ8I7$nS?lHUܴ%Qrĉ;9͌MᲷoX\HaLXɜ_R SڌL0qf_$y+v {&VτHhFdX*H,XG p=gg'`Rrd zŤ"Ƃ'vˤe |dF¼gE.`sѓ\1% vF˴L)Dhc3# !L48YɞY1%Y9,Hf#Le]"џHg&..ڎ.Q,]=39 e`QΣX_ dNϘ<=)@^y3 RBN@Rp>*7J?cS=@4 uhA[=xTaQ^Qq{ iPYGל#I]ۢ)bٽ_\\i(f0~0.YPYՄQh{U3 u]4fMA1b4 0Ӫi@dP60,PE]/f.`ah/fe>G*{$pF >{'% Na<3ƹF ˇѹf\d.8}qkcd8L4aZMРghc>4l ( =Ce`"8u5_i~ǦCDV; e^#kKQp6S`28 ۢy_-T6 ySa6ϫEUM`'780ls!a54LpHA>ɣzn { i҅Kyg_?7S3<Ɉgxt;e9Ѵ-Ẓ>{ax(Vk$qfZ#roryߑ&Vc%Re|zOr-Vjm7xjKfT sZ%c:WRq6SLO%=Nk*pqh'QETٍZ +8IVKKu Ӵ )q+r[to"o+/&I>r\79 Km)1uAlZ*)aYPK.ц¬R'f壼No5HdJZTΓU_$)S - O d:ws{Qd9WSFo'|'y-)F/d]sn] 9L !Z2`Qpl38\;.REO26}TNϨCD$k4=mFVIKڢaKJ 4q4Tc?--drOohPu[ 4ڷ=(Rr5 ,3C(;4ms7d7veFтEHSۛ!p?ԃi1sgښ#?=z8/o~f:QƣvmK< ZP ;5I(.*)m <0403E832B7AB27C50B4059CCAA834E11>] /Length 648 /Filter /FlateDecode >> stream x%KUQ(6_>JKLa- ʄ %BMjDCI5 ӢQD:rcz?'~0$@ A$< F4}%I3i$ I(]qI_X8HZ$6l';H"I>iI E&iW$$d,ȵXv\$]$BRY#`qsboT/k#2RN*H%Wlz5#[:/xG6mfӭy88k^? x7iޗY{ۭ=Dart (\dܪNr''H܍A;L~)[U k{I9MΐplznU< |*ʰuZG^ػQr\&d Mc W«onk Z˰j~jZ<Ƒx? 6h0IQE$E Mw3̸2 sƦy$Ϧ0 )C 2ZD~R 9b!?ߪrļ5gXUí_VE.a6p)å 2\ځ #v endstream endobj startxref 454732 %%EOF mi/inst/doc/mi_vignette.Rmd0000644000175000017500000001372612513737154015532 0ustar nileshnilesh--- title: "An Example of mi Usage" author: "Ben Goodrich and Jonathan Kropko, for this version, based on earlier versions written by Yu-Sung Su, Masanao Yajima, Maria Grazia Pittau, Jennifer Hill, and Andrew Gelman" date: "06/16/2014" output: pdf_document --- There are several steps in an analysis of missing data. Initially, users must get their data into R. There are several ways to do so, including the `read.table`, `read.csv`, `read.fwf` functions plus several functions in the __foreign__ package. All of these functions will generate a `data.frame`, which is a bit like a spreadsheet of data. http://cran.r-project.org/doc/manuals/R-data.html for more information. ```{r step0} options(width = 65) suppressMessages(library(mi)) data(nlsyV, package = "mi") ``` From there, the first step is to convert the `data.frame` to a `missing_data.frame`, which is an enhanced version of a `data.frame` that includes metadata about the variables that is essential in a missing data context. ```{r step1} mdf <- missing_data.frame(nlsyV) ``` The `missing_data.frame` constructor function creates a `missing_data.frame` called `mdf`, which in turn contains seven `missing_variable`s, one for each column of the `nlsyV` dataset. The most important aspect of a `missing_variable` is its class, such as `continuous`, `binary`, and `count` among many others (see the table in the Slots section of the help page for `missing_variable-class`. The `missing_data.frame` constructor function will try to guess the appropriate class for each `missing_variable`, but rarely will it correspond perfectly to the user's intent. Thus, it is very important to call the `show` method on a `missing_data.frame` to see the initial guesses ```{r step1.5} show(mdf) # momrace is guessed to be ordered ``` and to modify them, if necessary, using the `change` function, which can be used to change many things about a`missing_variable`, so see its help page for more details. In the example below, we change the class of the _momrace_ (race of the mother) variable from the initial guess of `ordered-categorical` to a more appropriate `unordered-categorical` and change the income `nonnegative-continuous`. ```{r, step2} mdf <- change(mdf, y = c("income", "momrace"), what = "type", to = c("non", "un")) show(mdf) ``` Once all of the `missing_variable`s are set appropriately, it is useful to get a sense of the raw data, which can be accomplished by looking at the `summary`, `image`, and / or `hist` of a `missing_data.frame` ```{r, step3} summary(mdf) image(mdf) hist(mdf) ``` Next we use the `mi` function to do the actual imputation, which has several extra arguments that, for example, govern how many independent chains to utilize, how many iterations to conduct, and the maximum amount of time the user is willing to wait for all the iterations of all the chains to finish. The imputation step can be quite time consuming, particularly if there are many `missing_variable`s and if many of them are categorical. One important way in which the computation time can be reduced is by imputing in parallel, which is highly recommended and is implemented in the mi function by default on non-Windows machines. If users encounter problems running `mi` with parallel processing, the problems are likely due to the machine exceeding available RAM. Sequential processing can be used instead for `mi` by using the `parallel=FALSE` option. ```{r, step4} rm(nlsyV) # good to remove large unnecessary objects to save RAM options(mc.cores = 2) imputations <- mi(mdf, n.iter = 30, n.chains = 4, max.minutes = 20) show(imputations) ``` The next step is very important and essentially verifies whether enough iterations were conducted. We want the mean of each completed variable to be roughly the same for each of the 4 chains. ```{r, step5A} round(mipply(imputations, mean, to.matrix = TRUE), 3) Rhats(imputations) ``` If so --- and when it does in the example depends on the pseudo-random number seed --- we can procede to diagnosing other problems. For the sake of example, we continue our 4 chains for another 5 iterations by calling ```{r, step5B} imputations <- mi(imputations, n.iter = 5) ``` to illustrate that this process can be continued until convergence is reached. Next, the `plot` of an object produced by `mi` displays, for all `missing_variable`s (or some subset thereof), a histogram of the observed, imputed, and completed data, a comparison of the completed data to the fitted values implied by the model for the completed data, and a plot of the associated binned residuals. There will be one set of plots on a page for the first three chains, so that the user can get some sense of the sampling variability of the imputations. The `hist` function yields the same histograms as `plot`, but groups the histograms for all variables (within a chain) on the same plot. The `image`function gives a sense of the missingness patterns in the data. ```{r, step6} plot(imputations) plot(imputations, y = c("ppvtr.36", "momrace")) hist(imputations) image(imputations) summary(imputations) ``` Finally, we pool over `m = 5` imputed datasets -- pulled from across the 4 chains -- in order to estimate a descriptive linear regression of test scores (_ppvtr.36_) at 36 months on a variety of demographic variables pertaining to the mother of the child. ```{r, step7} analysis <- pool(ppvtr.36 ~ first + b.marr + income + momage + momed + momrace, data = imputations, m = 5) display(analysis) ``` The rest is optional and only necessary if you want to perform some operation that is not supported by the __mi__ package, perhaps outside of R. Here we create a list of `data.frame`s, which can be saved to the hard disk and / or exported in a variety of formats with the __foreign__ package. Imputed data can be exported to Stata by using the `mi2stata` function instead of `complete`. ```{r, step8} dfs <- complete(imputations, m = 2) ``` mi/inst/doc/mi_vignette.R0000644000175000017500000000315014247037642015200 0ustar nileshnilesh## ----step0----------------------------------------------------- options(width = 65) suppressMessages(library(mi)) data(nlsyV, package = "mi") ## ----step1----------------------------------------------------- mdf <- missing_data.frame(nlsyV) ## ----step1.5--------------------------------------------------- show(mdf) # momrace is guessed to be ordered ## ---- step2---------------------------------------------------- mdf <- change(mdf, y = c("income", "momrace"), what = "type", to = c("non", "un")) show(mdf) ## ---- step3---------------------------------------------------- summary(mdf) image(mdf) hist(mdf) ## ---- step4---------------------------------------------------- rm(nlsyV) # good to remove large unnecessary objects to save RAM options(mc.cores = 2) imputations <- mi(mdf, n.iter = 30, n.chains = 4, max.minutes = 20) show(imputations) ## ---- step5A--------------------------------------------------- round(mipply(imputations, mean, to.matrix = TRUE), 3) Rhats(imputations) ## ---- step5B--------------------------------------------------- imputations <- mi(imputations, n.iter = 5) ## ---- step6---------------------------------------------------- plot(imputations) plot(imputations, y = c("ppvtr.36", "momrace")) hist(imputations) image(imputations) summary(imputations) ## ---- step7---------------------------------------------------- analysis <- pool(ppvtr.36 ~ first + b.marr + income + momage + momed + momrace, data = imputations, m = 5) display(analysis) ## ---- step8---------------------------------------------------- dfs <- complete(imputations, m = 2) mi/data/0000755000175000017500000000000012450147374011731 5ustar nileshnileshmi/data/CHAIN.RData0000644000175000017500000001701112513740436013466 0ustar nileshnileshBZh91AY&SYp/>|S>xzOtOef>v@[и%S `&&54cPiTp\2k'?CxxL[h|,'<"HJ1$H.!zNK'=ݢ=ALTAfYg?kl(57@XCQeě R٠B !""@8*qKiT! b As΀ JmbPHBH, =l$,`&T|21XO3=;927x+X  a1FDAI dK\FyhF͈(>{Y$/.8pK!`JNZ^y2Dq.fvG*T>@w@D( xR!qfI'ʊM 2@|ӟ !,@irI- R%)ʣIH+(j3}m$`<}4,aQevCA0b.%0 )m$ @y5Jj3'H\vܝG"(.C'v{19Oe!!qs|H [)3 se ,Jz'0t^&~ ]lXRϘ >9!Žyc%>BtH$R WtUm0y:RTQ[8>JU:SiO1Tc`z'dm֚Is'ZzDxB\4!XD-|v*ʝ:YKe}{?LLc/]gWSa@ 6#!icB&Iηu\hiuyN歊Ԛ" }QwY}9 [KW̭^ǡ?F!CbFhpӑmsRi,dh]S 1`+p_A->|nڼ"ŧnQ{SZڨw!i ':);<T$ KsCpDS'hظYTѫA.;Q8 硌FwF aD+~V>m>L43<3tlE~DHq`3 5p+c(Co8ioMr,w.ԕZ iB]0}X.,2T{PmRk{Ն^|gЧ q| ?o8;rܯudI$I$I'$I$rn._oz }}}}}p35kwwwc",]2,]2,]2c'ܻ6>|;;;; ?#f>|8wwwwwwxwwwwwwxwwwwwwxww|V2Ʀ,]28{e4>k>|mmmm^OO6leXһXXXXA@333ffakǴ7VmqbŋIc,UUUc,UUUc,UUUc,UUUc,UUUc,US3ffw9wL~YehѣF&E|2UUV2UUV2UUVUUU$I$I$I;FNj崿g1づo7u$I$I$I$I$I$g<>u4kkkkhѣF8-zzI$I$I$I$I$I&~w{﷞sKcK6l΍=<٤I$I$IUUUUUUUUUWzx]OB{do=;I$I$I$I$I$GrֲٸY0`v޽ m޸Tp#Py`R(^tXB* ^4xt= . ?Eta80^3]NJ;ܝe`$c`@CP Fy ,Z"ܧۺ,kX64 ե $1I044A( б\&Kpku4^]YÝr{ 7T\ДwJd.-S[d"I9Fȋ1Hj1i@)⬫6Swuk 2C@V>OC,ŪNi8R;-pVE8x<9Y! S֬^L\MKș6#bj"VLAs$.PrAj$Q)bD$I")pԒuѴK3eXƑ59m28_#vĄqq%W8s? +D/}W S1.wX!_![|{dP7o@e}Wug(&yO- ϰ`W80t jhpPlJemĻ.Y^: RJ9ry IEeUXY(ܚxy]Fuƻt0wSGhgnC۴{qø>* o0*~Y@mg\퉶!NtŬ-DD DP"" o}u|a]QGn}'u )U{NSc}wG_\A)iZWkr_;Wd6DFBSoy{Y}ZWYTA11ɺ5}s_Z4#7LmVۯWe iR8Y]KaO ˾^ yLkI{e>|1y}MvSvR%`lj)kRKd\,E[dV4rr!)H%^ߥõ_7W-xmGxedZ1u[wAJ\R&0TMB|ߵ7hѤ__ !\b_,`1@R'FiDmb.Q۵.9iHk63t*7m=d񝺼 L?Zّ-An~sXuk3q5Y升 00'6) $H rI`aba?+H=&iGl3F\E  Z0?&-WL åoI R=H 8 0=+_5^¤pI°4jpIv䛟EHYcK0>Mv{S`S̀WH,K#V%r`/60<|ޭAK60 ALMP^^8$ii1[6nt YnQ}{p(;tA!ؘObP mI2ƂcDglmѹTΦ=sF"u$@'P|{ʗsbmGvgWdز"BPSuagYqMV% ?v~5K?b88 ̌Dy1 RPڰOx]FA"}sUJ6#ھ]%mfT_LХ+J %H,D7|#`Ð^, 8NHsl rŦ{܆Sepeݔ7rxwyפ3)@tjʸ'  Dhp v ՖF{Ax qBSoK:.kK>?2c9%LmDveQгͦ,ժrN"*R[m^e9̧8زDӌ14IĴJoY-fdGWC+WDy5aBv4ѣbGyPSy,D(VRZ.hrIh'kd>cgQP׈YK K,h/HU3&(U)EWvX፺㥅A6i!}Y^ 痝ǩ -Y}}#9B' ƟGr#HDou7EJkZ@7PNÎl{~2y`(j9^6*HCh ʆ0gwWM\s*~LGeWFn/P7 CpQ(D w(v~^>`80 b_٩SfDRWdc__Ra6JW~5ՖG>ΆKJ,/ ) i.s̭ZihBg*(eVU߆Ƿ-W`!=$U?[յsdc[)lC(qߊ|ڇ*|9\+ϒߔ@iw֏7'wd#MM!V.~R1+vZs"7Y-s1`E;:6%MVoiG} 0}-?E/y;]̖m(KX9AVhvF>FQ&7":eBhc?I[K Q dXniwZ!YX,V5֘21Ķ8f7zzسin񙅊^EYRmL MnXDuuۮb) V2 mwMTMs1 TDBRء DdTHQd  lI!'MkHJ` T,"EDB,7-V bȈ"*H#V Uőb"EX,EQ,( K"E ",*C| G[$1 |N1FY o# IN8Cc XJCd g*G$ ]HmduC!'3'@wM' z䬓(7|jsJw|>PR6 ?yI\o.C@0R\'$ڈ(t])QЪ'C[O;x;.4Çt>ZI`@Q