robustbase/0000755000176200001440000000000013465767243012444 5ustar liggesusersrobustbase/TODO0000644000176200001440000003077312737470400013131 0ustar liggesusers -*- org -*- C-c C-o follows link[MM: grep-r -e '\(FIXME\|TODO\)'] * Before next release ** DONE print() and print(summary()): 'method' almost twice; show iBest for "deterministic" ** DONE covMcd(): allow 'hsets.ini' argument to covMcd(), and *return* them (optionally) as 'Hsubsets' ** DONE export rankMM, classSVD, .signflip [MM: repmat should not be needed] ** DONE 'scalefn' argument for covMcd() to be used for "detMCD" ** DONE adjOutlyingness(): *** DONE change defaults for clower & cupper (E-mail from P.Segaert). *** DONE But there is more: +/- swap ==> results not back compatible ** DONE colMedians() -> ask Henrik/ about "License: Artistic-2.0" ** TODO nlrob() *** TODO summary(nlrob(*)) fails for new methods; better error message or *work* **** TODO for "MM" we are close to done; ideally want '$ rweights' (robustness weights) for all meth *** TODO residuals( nlrob(), type = "...") should provide types "as in the literature" *** DONE nlrob(*, method = "...") should call methods "tau", "CM", "MTL", "MM" by Eduardo Conceicao **** DONE shouldn't we rename jde() to jdeopt() or even jdeoptim(), jDEoptim(), or JDEoptim() R users already know optim() etc.. so the name seems more logical for them. * Short Term ** TODO [Peter Filzmoser, Geneva 2016-07-07 talk]: covMcd() warns when n < 2*p .. should not *warn* but give message() ** TODO [Peter Filzmoser, Geneva 2016-07-07 talk]: solve.default(getCov(mcd)) error with CovControlOgk() init *** INSTEAD it should report the (theoretical) breakdown point (p ...) / (n - h ... ) [from the MCD theory] ** TODO mc(x) can *fail* to converge: workaround: jitter() -> ~/R/MM/Pkg-ex/robust/Robnik-mc.R ** TODO estimethod(): also for lmrob() and glmrob() models ** TODO VT implement .detMcd() in C ** TODO r6pack(milk, ..): *return* singularity message but do not signal an error ** TODO nlrob(*): *** TODO for the "vector parameter" biomass example in tests/nlrob-tst.R: method = "MM" As we do want the formula to work ==> we *must* allow 'lower' & 'upper' as list()s in R/nlregrob.R, have 14 matches for "eval *( *formula\[\[3L?" ((and *org* shows the `[[3L].]` (no ".") as underscored 3L)) : 123: y.hat <- eval( formula[[3L]], c(data, setNames(par, pnames)) ) 127: y.hat <- eval( formula[[3L]], c(data, setNames(par, pnames)) ) 141: y.hat <- eval( formula[[3L]], c(data, setNames(par, pnames)) ) 175: res <- y - eval( formula[[3L]], c(data, initial$par) ) 193: fit <- eval( formula[[3L]], c(data, coef) ) 254: fit <- eval( formula[[3L]], c(data, setNames(par, pnames)) ) 300: fit <- eval( formula[[3L]], c(data, coef) ) 355: fit <- eval( formula[[3L]], c(data, par) ) 361: fit <- eval( formula[[3L]], c(data, par) ) 366: fit <- eval( formula[[3L]], c(data, setNames(par, pnames)) ) 390: fit <- eval( formula[[3L]], c(data, coef) ) 434: fit <- eval( formula[[3L]], c(data, par) ) 442: fit <- eval( formula[[3L]], c(data, setNames(par, pnames)) ) 468: fit <- eval( formula[[3L]], c(data, coef) ) the same as in R/nlrob.R where we had eval(.., c(data, coef)) but now eval(.., c(data, start)) *** TODO nlrob(*, method=.) -- try at least *one* other optimizer than JDEoptim(), since we provide already most of the needed "hooks". *** DONE nlrob(*, method="M"): allow a "fixed initial sigma" (--> inference for "MM") *** TODO confint.nlrob():, "Wald" works; naming follows confint.lmer() from lme4 **** TODO method = "profile" based on (TODO) profile.nlrob() **** DONE method = "Wald" works ** TODO simulate() : implement for "nlrob" {and lmrob() ? and ..} ** glmrob *** BYlogreg() [ R/BYlogreg.R ] --> more tests in ./tests/glmrob-1.R --> glm.fit() instead of glm() --> vcov() instead of just std.err. {is already there} *** glmrob(*, weights.on.x = "robCov") uses MASS::cov.rob(), i.e. "MVE" and Andreas had a comment that "mcd" is worse. "covMcd" has been available for a while; now via robXweights() in ./R/glmrobMqle.R HOWEVER: Need something better when 'X' has (binary!) factors! "hat" +- works, but needs more work *** We now allow weights.on.x to be an arbitrary general wts(X, intercept) function _or_ a list containing a robMcd()-like function. Definitely need *testing* this situation! *** glmrob(): anova() has three variants: "V1", "Eva1", "Andreas1" --> ./R/glmrobMqle-DQD.R - gives warning every time {-> easy to fix} - Default is "V1" is that a good idea? *** glmrob() needs a bit more tests in ./tests/ [also consider those from man/glmrob.Rd] take those from Martin's old 'robGLM1' package (need more!) *** --> first test already shows that Martin's tests for "huberC == Inf" were *not* yet moved from robGLM1 to glmrob()... (in other words: glmrob() should work *** also, ni = 0 does not work quite as it should ( ./tests/binom-ni-small.R ) *** obj $ df ... maybe should be defined -- for "glm" methods to be applicable --> e.g. for predict(, interval="..") ! *** summary.glmrob() should be better documented; we should decide if the current return value is fine. *** Eva's code (and MM's) also computed & returned the "asymptotic efficiency"! *** anova.glmrob(): More modularization, allowing to provide own 'test' function. Test if Huber's C are different. Need theory to compare different C's and same model (which includes classical vs robust). *** add1() and/or drop1() would be nice ** TODO scaleTau2(): Also do a cheap finite-sample correction [MM] ! [DONE partly; but undocumented, since bound to change --> file:~/R/MM/STATISTICS/robust/1d-scale.R , 1d-scale-sim.R, etc --- unfinished!! ** TODO Psi/Rho/Chi/Wgt Functions We have quite a few "partial" collections of rho/psi functions; some are "sync"ed now, some not yet:: *** TODO 1) have the nice S4 class psi_func + psiFunc() and .defDwgt() functions in file:R/psi-rho-funs.R with further explorations, ideas in file:misc/experi-psi-rho-funs.R **** TODO print/show of such psi_func should show more; at least the psi function **** TODO str.psi_func() should be a bit nicer than the current default str() **** TODO nlrob(): also allow psi to be a 'psiFunc': --> ./R/nlrob.R ; consider even more *real* checks; now in tests/nlrob-tst.R *** DONE 2) deprecated: "old" tukeyChi() & tukeyPsi1() originally called from lmrob() , in ./R/biweight-funs.R *** DONE 3) psi.*(...., rho = FALSE/TRUE) functions from Andreas ([[file:.R/psi-funs-AR.R]]) replaced by using the new psi_func objects **** DONE nlrob() changed: uses psi = .Mwgt.psi1("huber", cc=1.345) as default *** TODO 4) have (C-based) functions Mpsi(), Mchi(), Mwgt(), etc, used from lmrob(), in ./R/lmrob.MM.R **** TODO provide Mpsi(psi = "t") etc; tuning parameter: 'nu' => MLE-t_\nu psi and psi' **** TODO provide '1)'-i.e. psi_func versions of the Mpsi() etc **** TODO Mpsi(*, "GGW") etc : have no (??) easy way to directly specify (a,b,c) tuning pars **** TODO *New* Mwgt(*, deriv=1) would correspond to Dwgt in psiFunc() which Manuel needs **** DONE now exported and documented in man/M.psi.Rd Further files, illustrating features, differences, etc: ./vignettes/psi_functions.Rnw -- with quite a few FIXME ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ./inst/xtraR/plot-psiFun.R chkPsiDeriv() {and plot utils} ./tests/psi-rho-etc.R compute asymp.efficiency and breakdown point ! ./tests/lmrob-psifns.R plot and lmrob()-test them **** DONE Deprecate* the "2)", tukeyChi() etc, making them call the M.*fun(): * Mid Term ** TODO R/lmrob.MM.R: Using lmrob.E( * ) *** TODO: numerically clearly better than these -- e.g. in summary.lmrob(): use integrate(), or *** ---- allow to specify 'use.integrate=TRUE, tol = 1e-10' etc for *accurate* cor.factors *** "hampel", "bisquare", "lqq" (polyn!): derive *exact* formula; others maybe, too <==> psi_func objects above? ** TODO New lmrob() features ("M-S" as option?): *** Function names with "." (which are exported) are frowned upon e.g. lmrob.split() *** checking .vcov.avar1() and its "posdefify" options [but "KS201x" uses .vcov.w() anyway] *** TODO lmrob.mar() [file:inst/doc/estimating.functions.R]: Maronna & Yohai (2010) should ~~~~~~~~~~ become part of robustbase, maybe under a better name, e.g. via lmrob( ... control ..) or directly. It is much used in the simulations of Koller & Stahel (2011) *** TODO Provide "simple M" estimator [so MASS :: rlm() is entirely superseeded] Consider lmrob(*, method = "M") --> default init = "ls" (Least Sq; as MASS:::rlm.default) which calls lmrob..M..fit() which is already documented as "simple" M-estimator (though the *scale* is kept fixed; i.e., no 'proposal 2'). ** TODO glmrob(), glmrobMqle(), etc : expression()s and eval() no longer "satisfactory", e.g., see FIXME in ./R/glmrobMqle.R ** TODO covMcd(): pass k3 as argument; default=current ==> allow "formula" k3 = k3(n,p) !! ** covOGK(): The argument name 'weight.fn' is pretty ugly and the default function name 'hard.rejection()' is just awful (we need a globally available function as 'role model'. - Could allow 'n.iter = 0' to simply compute Cov()_{ij} = rcov(X_i, X_j) ** rrcov etc *** rrcov.control() __ NEEDS name change ! ______ probably use mcd.control() and lts.control() or forget about *control() completely? since there are only a few in each ??????/ *** TODO tolellipse() --> renamed to tolEllipsePlot() **** maybe use cluster::ellipsoidPoints() **** allow other percentiles than just 97.5% **** maybe *return* something *** plot(mcd. ) [ R/covPlot.R ] : should show the call Default for 'ask' should be smarter: depend on prod(par("mfrow")) < #{plots} (which depends on 'classic' and p=2) *** ltsReg(): has undocumented '$resid' in addition to '$residuals' and '$raw.residuals'; drop it or document it ! ** More lmrob() considerations *** DONE more tests in tests/ *** fully implement and test the multivariate case (y = matrix with > 1 col.) *** src/lmrob.c : does median() , MAD() instead of using R's sort() routines * Long Term / Maybe ** inst/doc/lmrob_simulation.Rnw : *** use hyperlinks {e.g. using jss docu.class!} *** consider making parts available in (new) ./demo/lmrob...R *** tau_i (p.5) is not clear for Joe Average. .......................................... ** Generalizing 'wgt.himedian': We'd want a C API on which R builds. There are pure R implementations: - 'weighted.median()' in limma and I have generalized it ---> file:inst/xtraR/ex-funs.R - more general code (different 'tie' strategies; weighted *quantile*s) in file:/u/maechler/R/MM/STATISTICS/robust/weighted-median.R - The 'Hmisc' package has wtd.quantile() ** Miscellaneous *** Alternative version of covOGK() for correlation-only using's Huber's correlation formula which ensures [-1,1] range --> ~/R/MM/Pkg-ex/robustbase/robcorgroesser1.R and ~/R/MM/STATISTICS/robust/pairwise-new.R *** package 'riv' (author @ epfl.ch!) has 'slc()' ~= cov.S(.) -- in pure R code doesn't Valentin have a version too? otherwise: test this, ask author for "donation" to robustbase *** adjOutlyingness() : **** typo-bug is corrected; and I have made it more pretty. Still a bit problematic when denominator = 0 Currently leave away all the c/0 = Inf and 0/0 = NaN values. MM: Maybe, it's the fact that the coef = 1.5 should really depend on the sample size n and will be too large for small n (??) --> should ask Mia and maybe Guy Brys **** For really small (n,p): Taking 250 random samples of size p; is non-sense when choose(n,p) <= 250 Rather then, take *all* sub-samples of size p ==> getting a non-random result. *** Add data sets from the MMY-book -- mostly done {do we have *all* ?} *** Data Sets --- Valentin Todorov has several of Rousseeuw's in the 'rrov' package (and promised me "the rest" when needed) Don't like the *.x, *.y sub datasets: They shouldn't be needed when use a *formula* In his lts tests, he uses these "data sets from the literature": (Note that 'stackloss' is already in "datasets") : heart.x,heart.y, data(heart) stars.x,stars.y, data(stars) phosphor.x,phosphor.y, data(phosphor) stack.x,stack.loss, data(stackloss) coleman.x,coleman.y, data(coleman) salinity.x,salinity.y, data(salinity) aircraft.x,aircraft.y, data(aircraft) delivery.x,delivery.y, data(delivery) wood.x,wood.y, data(wood) hbk.x,hbk.y, data(hbk) robustbase/po/0000755000176200001440000000000013465050072013043 5ustar liggesusersrobustbase/po/update-me.sh0000755000176200001440000000152612533543452015273 0ustar liggesusers#!/bin/sh # #__>> Keep in sync with ~/R/Pkgs/Matrix/po/update-me.sh <<__ # ## Script for updating package-specific *.pot files ## written such that it should work for any package # R=${R:-R} thisdir=`dirname $0` ; cd $thisdir; thisdir=`pwd` echo "R = '$R' (`$R --version | head -1`) preliminary thisdir='$thisdir'" pkgDIR=`dirname $thisdir` pkg=`basename $pkgDIR` echo ' --> pkgDIR='$pkgDIR' ; pkg='$pkg echo "require('tools'); update_pkg_po('$pkgDIR')" | $R --slave 2>&1 | tee update.log ## -------------------------------- as of R 3.0.0 echo 'end{make pkg-update}' ; echo '' echo 'Test with (e.g.)' echo ' LANGUAGE=de R --no-environ --no-save' ; echo '' echo 'and then something like' echo ' ... [TO BE ADDED] ...'; echo '' echo 'Commit with something like' echo " svn ci -m'translation updates' po inst/po"; echo '' robustbase/po/R-robustbase.pot0000644000176200001440000005015012533543274016146 0ustar liggesusersmsgid "" msgstr "" "Project-Id-Version: robustbase 0.92-4\n" "POT-Creation-Date: 2015-06-03 11:16\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=CHARSET\n" "Content-Transfer-Encoding: 8bit\n" msgid "some terms will have NAs due to the limits of the method" msgstr "" msgid "y is not onedimensional" msgstr "" msgid "Number of observations in x and y not equal" msgstr "" msgid "no intercept in the model" msgstr "" msgid "All observations have missing values!" msgstr "" msgid "Implosion: sigma1=%g became too small" msgstr "" msgid "Convergence Achieved" msgstr "" msgid "No convergence in" msgstr "" msgid "steps." msgstr "" msgid "maximum number of \"kstep\" iterations must be > 0" msgstr "" msgid "maximal number of *inner* step halvings must be > 0" msgstr "" msgid "value of the tuning constant c ('const') must be > 0" msgstr "" msgid "non-trivial prior 'weights' are not yet implemented for \"BY\"" msgstr "" msgid "'start' cannot yet be passed to glmrobBY()" msgstr "" msgid "'offset' is not yet implemented for \"BY\"" msgstr "" msgid "'weights.on.x' =" msgstr "" msgid "is not implemented" msgstr "" msgid "glm(.) {inner subsample} error:" msgstr "" msgid "betaExacto glm(.) error:" msgstr "" msgid "value of acc must be > 0" msgstr "" msgid "number of subsamples must be > 0" msgstr "" msgid "maximum number of iterations must be > 0" msgstr "" msgid "value of the tuning constant c (cw) must be > 0" msgstr "" msgid "Currently, only family 'poisson' is supported for the \"MT\" estimator" msgstr "" msgid "All weights must be positive" msgstr "" msgid "non-trivial 'offset' is not yet implemented" msgstr "" msgid "NAs in V(mu)" msgstr "" msgid "0s in V(mu)" msgstr "" msgid "'start' must be an initial estimate of beta, of length %d" msgstr "" msgid "optim(.) non-convergence:" msgstr "" msgid "'X' must have at least two columns" msgstr "" msgid "invalid first argument" msgstr "" msgid "'formula' missing or incorrect" msgstr "" msgid "'coef' must not be negative" msgstr "" msgid "More dimensions than observations, currently not implemented" msgstr "" msgid "More dimensions than observations: not yet implemented" msgstr "" msgid "**** sampling iterations were not sufficient. Please report" msgstr "" msgid "the following arguments to 'anova.glmrob' are invalid and" msgstr "" msgid "dropped:" msgstr "" msgid "anova.glmrob() only works for 'glmrob' objects" msgstr "" msgid "'Anova Table' for a single model object not yet implemented" msgstr "" msgid "Not the same response used in the fitted models" msgstr "" msgid "models were not all fitted to the same size of dataset" msgstr "" msgid "Not the same method used for fitting the models" msgstr "" msgid "Not the same tuning constant c used in the robust fits" msgstr "" msgid "Models are not nested!" msgstr "" msgid "Models are not strictly nested" msgstr "" msgid "This family is not implemented" msgstr "" msgid "some eigenvalues are negative" msgstr "" msgid "non-implemented test method:" msgstr "" msgid "for fitting method" msgstr "" msgid "the following arguments to 'anova.lmrob' are invalid and" msgstr "" msgid "For test = 'Deviance', the estimator chain has to end with 'M'" msgstr "" msgid "The first object does not contain the largest model" msgstr "" msgid "All models are refitted except the largest one" msgstr "" msgid "anova.lmrob() only works for 'lmrob' objects" msgstr "" msgid "'Anova Table' for a single model not yet implemented" msgstr "" msgid "invalid 'test'" msgstr "" msgid "Please fit the nested models by lmrob" msgstr "" msgid "NA coefs in full and reduced model do not match" msgstr "" msgid "test" msgstr "" msgid "not yet implemented" msgstr "" msgid "deriv must be in {0,1,2}" msgstr "" msgid "deriv must be in {-1,0,1,2}" msgstr "" msgid "'x' must be a numeric matrix" msgstr "" msgid "The sample size must be greater than 1 for svd" msgstr "" msgid "'wgtFUN' must be a function or a string specifying such a function" msgstr "" msgid "invalid 'seed'. Must be compatible with .Random.seed !" msgstr "" msgid "Invalid number of trials nsamp =" msgstr "" msgid "!" msgstr "" msgid "n <= p -- you can't be serious!" msgstr "" msgid "n == p+1 is too small sample size for MCD" msgstr "" msgid "n < 2 * p, i.e., possibly too small sample size" msgstr "" msgid "Sample size n < h(alpha; n,p) := size of \"good\" subsample" msgstr "" msgid "subsample size\t h < n/2 may be too small" msgstr "" msgid "'wgtFUN' must be a function or one of the strings %s." msgstr "" msgid "Unexpected 'exactfit' code" msgstr "" msgid ". Please report!" msgstr "" msgid "illegal 'singularity$kind'" msgstr "" msgid "Options 'best' and 'exact' not allowed for n greater than 2*nmini-1 =" msgstr "" msgid ".\nUsing default." msgstr "" msgid "'nsamp = \"best\"' allows maximally" msgstr "" msgid "subsets;\ncomputing these" msgstr "" msgid "This may take a" msgstr "" msgid "very" msgstr "" msgid "long time!" msgstr "" msgid "Invalid number of trials nsamp=%s. Using default nsamp=%d." msgstr "" msgid "nsamp > i_max := maximal integer -- not allowed;" msgstr "" msgid "set to i_max =" msgstr "" msgid "Use only with 'mcd' objects" msgstr "" msgid "x is not a numeric dataframe or matrix." msgstr "" msgid "argument 'm.cov' must have numeric components 'center' and 'cov'" msgstr "" msgid "Data set and provided center have different dimensions!" msgstr "" msgid "The covariance matrix is singular!" msgstr "" msgid "id.n" msgstr "" msgid "must be in {1,..," msgstr "" msgid "}" msgstr "" msgid "For tolerance ellipses the dimension 'p' must be 2!" msgstr "" msgid "'hsets.init' must be a h' x L matrix (h' >= h) of observation indices" msgstr "" msgid "'full.h' is true, but 'hsets.init' has less than n rows" msgstr "" msgid "'hsets.init' must be in {1,2,...,n}; n =" msgstr "" msgid "More than h of the observations lie on a hyperplane." msgstr "" msgid "original detmcd() wrongly declared c-step convergence (obj=%g, i=%d, j=%d)" msgstr "" msgid "Invalid scalefn='%s': must be function or a valid string" msgstr "" msgid "'%s' must be a function, numeric vector of length p, or NULL" msgstr "" msgid "provide better scale; must be all positive" msgstr "" msgid "More than half of the observations lie on a hyperplane." msgstr "" msgid "'%s' is not a valid family (see ?family)" msgstr "" msgid "Robust GLM fitting not yet implemented for family %s" msgstr "" msgid "'weights' must be non-negative" msgstr "" msgid "Number of offsets is %d, should rather equal %d (number of observations)" msgstr "" msgid "'weights.on.x' must be a string, function, list or numeric n-vector" msgstr "" msgid "'start' must be a numeric vector, NULL, or a character string" msgstr "" msgid "invalid 'start' string" msgstr "" msgid "For method 'cubif', use glmRob() from package 'robust'" msgstr "" msgid "method='%s' is only applicable for binomial family, but family=\"\"" msgstr "" msgid "invalid 'method':" msgstr "" msgid "setting 'y = FALSE' has no longer any effect" msgstr "" msgid "No weights defined for this object. Use type=\"robustness\" argument to get robustness weights." msgstr "" msgid "need non-robust working residuals for this model type" msgstr "" msgid "invalid 'variant':" msgstr "" msgid "Weighting method" msgstr "" msgid "if a list, weights.on.x must contain a covariance function such as covMcd()" msgstr "" msgid "weights.on.x needs %d none-negative values" msgstr "" msgid "All weights.on.x must be none negative" msgstr "" msgid "'offset' not fully implemented" msgstr "" msgid "illegal 'family' argument" msgstr "" msgid "start 'theta' has still NA's .. badly singular x" msgstr "" msgid "Cannot find valid starting values: You need help" msgstr "" msgid "family '%s' not yet implemented" msgstr "" msgid "NAs in d(mu)/d(eta)" msgstr "" msgid "Non-finite coefficients at iteration" msgstr "" msgid "Algorithm did not converge" msgstr "" msgid "fitted probabilities numerically 0 or 1 occurred" msgstr "" msgid "fitted rates numerically 0 occurred" msgstr "" msgid "Only 'test.acc = \"coef\"' is currently implemented" msgstr "" msgid "value of the tuning constant c (tcc) must be > 0" msgstr "" msgid "Std.error computation not yet available for the case of 'weights'" msgstr "" msgid "negative scale 's'" msgstr "" msgid "scale 's' is zero -- returning initial 'mu'" msgstr "" msgid "scale MAD is zero for this sample" msgstr "" msgid "calculations stopped prematurely in rllarsbi" msgstr "" msgid "(probably because of rounding errors)." msgstr "" msgid "unknown split type" msgstr "" msgid "No categorical variables found in model. Reverting to S-estimator." msgstr "" msgid "No continuous variables found in model. Reverting to L1-estimator." msgstr "" msgid "'psi' should be one of %s" msgstr "" msgid "invalid 'psi'=%s; possibly use .regularize.Mpsi(%s)" msgstr "" msgid "Unknown setting '" msgstr "" msgid "'. Using defaults." msgstr "" msgid "Initial estimator '%s' not supported; using S-estimator instead" msgstr "" msgid ".vcov.avar1 can only be used when initial estimator is S; using .vcov.w instead" msgstr "" msgid "only M and D are steps supported after \"init\" computation" msgstr "" msgid "%s-step did NOT converge. Returning unconverged %s-estimate" msgstr "" msgid ":.vcov.w: cov.hubercorr must be logical (or NULL)" msgstr "" msgid ":.vcov.w: cov.corrfact must be one of" msgstr "" msgid ":.vcov.w: cov.dfcorr has to be one of -1:3" msgstr "" msgid ":.vcov.w: cov.resid must be one of" msgstr "" msgid ":.vcov.w: cov.xwx must be logical (or NULL)" msgstr "" msgid "parameter psi is not defined" msgstr "" msgid "parameter tuning.psi is not numeric" msgstr "" msgid ":.vcov.w: ignoring cov.resid == final since est != final" msgstr "" msgid ":.vcov.w: scale missing, using D scale" msgstr "" msgid "option hcorr is ignored for cov.corrfact = asympt" msgstr "" msgid ":.vcov.w: unsupported psi function" msgstr "" msgid "(tau / hybrid / tauold): tau not found in 'obj'" msgstr "" msgid ":.vcov.w: Caution. Some psiprime are NA" msgstr "" msgid ".vcov.avar1() supports only SM or MM estimates" msgstr "" msgid "X'WX is almost singular. Consider rather using cov = \".vcov.w\"" msgstr "" msgid "X'WX is singular. Rather use cov = \".vcov.w\"" msgstr "" msgid "fixing" msgstr "" msgid "negative eigen([" msgstr "" msgid "])values" msgstr "" msgid "invalid 'posdef.meth':" msgstr "" msgid "'control$n.group' must be larger than 'p' for 'large_n' algorithm" msgstr "" msgid "'groups * n.group' must be smaller than 'n' for 'large_n' algorithm" msgstr "" msgid "'control$n.group' is not much larger than 'p', probably too small" msgstr "" msgid "C function R_lmrob_S() exited prematurely" msgstr "" msgid "S-estimated scale == 0: Probably exact fit; check your data" msgstr "" msgid "lmrob..D..fit: control is missing" msgstr "" msgid "lmrob..D..fit: prior estimator did not converge, stopping" msgstr "" msgid "lmrob..D..fit: robustness weights undefined" msgstr "" msgid "lmrob..D..fit: residuals undefined" msgstr "" msgid "lmrob..D..fit: parameter psi is not defined" msgstr "" msgid "lmrob..D..fit: parameter tuning.psi is not numeric" msgstr "" msgid "control is missing" msgstr "" msgid "'control' is missing" msgstr "" msgid "internal logic error in psi() function name:" msgstr "" msgid "Please report!" msgstr "" msgid "argument 'psi' must be a string (denoting a psi function)" msgstr "" msgid "tuning constant 'cc' is not numeric" msgstr "" msgid "Coefficients for" msgstr "" msgid "function incorrectly specified." msgstr "" msgid "Use c({0, } minimal slope, b, efficiency, breakdown point)" msgstr "" msgid "Use c(minimal slope, b, efficiency, breakdown point) or k[1:3]" msgstr "" msgid "Coef. for Hampel psi function not of length 3" msgstr "" msgid "Coef. for psi function" msgstr "" msgid "not of length 1" msgstr "" msgid "tuning constants for ggw psi: both eff and bp specified, ignoring bp" msgstr "" msgid "Error: neither breakdown point nor efficiency specified" msgstr "" msgid "tuning constants for lqq psi: both eff and bp specified, ignoring bp" msgstr "" msgid ".psi.lqq.findc: unable to find constants for psi function" msgstr "" msgid "method for psi function" msgstr "" msgid "not implemented" msgstr "" msgid "tuning parameter (chi/psi) is not numeric" msgstr "" msgid "need non-negative number of nodes" msgstr "" msgid "unknown setting for parameter ss" msgstr "" msgid "'epsw' must be numeric(1) or a function of nobs(obj.) which returns a numeric(1)" msgstr "" msgid "number of rows in 'x' and length of 'object$rweights' must be the same" msgstr "" msgid "'epsx' must be numeric(1) or a function of max(abs(x)) which returns a numeric(1)" msgstr "" msgid "Detected possible local breakdown of" msgstr "" msgid "-estimate in" msgstr "" msgid "coefficients" msgstr "" msgid "coefficient" msgstr "" msgid "'" msgstr "" msgid "," msgstr "" msgid "." msgstr "" msgid "KS2014" msgstr "" msgid "Use lmrob argument 'setting=\"KS2014\"' to avoid this problem." msgstr "" msgid "'weights' must be a numeric vector" msgstr "" msgid "number of offsets is %d, should equal %d (number of observations)" msgstr "" msgid "Methods argument set by method is different from method in control" msgstr "" msgid "Using the former, method =" msgstr "" msgid "incompatible dimensions" msgstr "" msgid "missing or negative weights not allowed" msgstr "" msgid "singular fit encountered" msgstr "" msgid "init must be \"S\", \"M-S\", function or list" msgstr "" msgid "Length of initial coefficients vector does not match rank of singular design matrix x" msgstr "" msgid "unknown init argument" msgstr "" msgid "arguments" msgstr "" msgid ")$" msgstr "" msgid "^list\\(" msgstr "" msgid "are disregarded in" msgstr "" msgid "Failed to compute robust Mahalanobis distances, reverting to robust leverages." msgstr "" msgid "lmrob object does not have a proper 'qr' component. Rank zero?" msgstr "" msgid "lmrob object does not have a proper 'qr' component. Rank must be zero" msgstr "" msgid "invalid 'lmrob' object: no terms component" msgstr "" msgid ":summary.lmrob: unsupported psi function" msgstr "" msgid "weights should not be both close to 0 and close to 1!" msgstr "" msgid "You should use different 'eps' and/or 'eps1'" msgstr "" msgid "calling predict.lm() ..." msgstr "" msgid "prediction from a rank-deficient fit may be misleading" msgstr "" msgid "Predictions on current data refer to _future_ responses" msgstr "" msgid "Assuming prediction variance inversely proportional to weights used for fitting" msgstr "" msgid "Assuming constant prediction variance even though model fit is weighted" msgstr "" msgid "'weights' as formula should be one-sided" msgstr "" msgid "Use only with 'lts' objects" msgstr "" msgid "Index plot of standardized residuals is not avalable if scale = 0" msgstr "" msgid "Standardized residuals vs Fitted values plot is not avalable if scale = 0" msgstr "" msgid "Diagnostic plot is not available for univar\niate location and scale estimation" msgstr "" msgid "Regression Diagnostic plot is not avalable if scale = 0" msgstr "" msgid "Regression Diagnostic plot is not avalable: option mcd=F was set in ltsReg()." msgstr "" msgid "The MCD covariance matrix was singular." msgstr "" msgid "'id.n' must be in {1,..," msgstr "" msgid "alpha not inside [1/2, 1]" msgstr "" msgid "unknown 'wgtFUN' specification:" msgstr "" msgid "'wgtFUN' must be a function or a string specifying one" msgstr "" msgid "y is not a numeric" msgstr "" msgid "There is at least one constant column. Remove it and set intercept=TRUE" msgstr "" msgid "'qr.out = TRUE' for univariate location is disregarded" msgstr "" msgid "Need more than twice as many observations as variables." msgstr "" msgid "x is singular" msgstr "" msgid "no valid subsample found in LTS - set 'nsamp' or rather use lmrob.S()" msgstr "" msgid "NA coefficient (at %s) from \"best\" subset" msgstr "" msgid "Invalid number of trials nsamp=" msgstr "" msgid "! Using default." msgstr "" msgid "'nsamp' options 'best' and 'exact' not allowed for n greater than" msgstr "" msgid ". Will use default." msgstr "" msgid "Maximum 5000 subsets allowed for option 'best'." msgstr "" msgid "Computing 5000 subsets of size" msgstr "" msgid "out of" msgstr "" msgid "mc(): not 'converged'" msgstr "" msgid "in" msgstr "" msgid "iter" msgstr "" msgid "iterations" msgstr "" msgid "*and*" msgstr "" msgid "'reflect part' in" msgstr "" msgid "iter2" msgstr "" msgid "optimx" msgstr "" msgid "package must be loaded in order to" msgstr "" msgid "use" msgstr "" msgid "optimizer=\"optimx\"" msgstr "" msgid "couldn't find optimizer function" msgstr "" msgid "non-function specified as optimizer" msgstr "" msgid "optimizer function must use (at least) formal parameters" msgstr "" msgid "Either specify 'pnames' or provide 'upper' or 'lower' with names()" msgstr "" msgid "'pnames' must be a character vector" msgstr "" msgid "specifying 'pnames' is deprecated; rather 'lower' or 'upper' should have names()" msgstr "" msgid "parameter names must appear in 'formula'" msgstr "" msgid "lower must be either of length %d, or length 1" msgstr "" msgid "upper must be either of length %d, or length 1" msgstr "" msgid "'%s' must be character string or function, but is \"%s\"" msgstr "" msgid "Psi function '%s' not supported yet" msgstr "" msgid "Initialization 'init = \"%s\"' not supported (yet)" msgstr "" msgid "unable to find constants for psi function" msgstr "" msgid "As \"sigma\" is in 'pnames', do not use it as variable or parameter name in 'formula'" msgstr "" msgid "Method" msgstr "" msgid "not correctly supported yet" msgstr "" msgid "'formula' should be a formula of the type 'y ~ f(x, alpha)'" msgstr "" msgid "specifying both 'acc' and 'tol' is invalid" msgstr "" msgid "The argument 'acc' has been renamed to 'tol'; do adapt your code." msgstr "" msgid "specifying 'weights' is not yet supported for method" msgstr "" msgid "For method = \"%s\", currently 'psi' must be specified via 'control'" msgstr "" msgid "'start' must be fully named (list or numeric vector)" msgstr "" msgid "'start' must be a named list or numeric vector" msgstr "" msgid "'scale' must be NULL or a positive number" msgstr "" msgid "Do not use '%s' as a variable name or as a parameter name" msgstr "" msgid "'weights' must be nonnegative and not contain NAs" msgstr "" msgid "could not compute scale of residuals" msgstr "" msgid "failed to converge in" msgstr "" msgid "steps" msgstr "" msgid "type 'pearson' is not yet implemented" msgstr "" msgid "invalid 'type'" msgstr "" msgid "'cov' must be a p x p matrix" msgstr "" msgid "for method='" msgstr "" msgid "', 'parm' must be specified as an integer" msgstr "" msgid "profile() method not yet implemented for \"nlrob\" objects.\n Use method = \"Wald\"." msgstr "" msgid "Computing profile confidence intervals ..." msgstr "" msgid "\"boot\" method not yet implemented for \"nlrob\" objects.\n Use confint(*, method = \"Wald\")." msgstr "" msgid "Use only with 'lmrob' objects" msgstr "" msgid "'which' must be in 1:5" msgstr "" msgid "'id.n' must be in {1,..,%d}" msgstr "" msgid "recomputing robust Mahalanobis distances" msgstr "" msgid "need 'model' or 'x' component for robust Mahalanobis distances" msgstr "" msgid "saving the robust distances 'MD' as part of" msgstr "" msgid "Tolerance range must be between 0% to 100%" msgstr "" msgid "arguments of function '" msgstr "" msgid "' are (" msgstr "" msgid ") but should be (" msgstr "" msgid ")." msgstr "" msgid "invalid tuning parameter names:" msgstr "" msgid "instead of" msgstr "" msgid "You cannot specify both 'main' and the deprecated 'shortMain'" msgstr "" msgid "'shortMain' is deprecated and will get defunct." msgstr "" msgid "Use 'main = \"short\"' instead of 'shortMain = TRUE'" msgstr "" msgid "'weights' must have same length as 'x'" msgstr "" msgid "Dimension {= ncol(x)} must be 2!" msgstr "" msgid "Initial set" msgid_plural "Initial sets" msgstr[0] "" msgstr[1] "" msgid "For method = \"%s\", argument %s is not made use of" msgid_plural "For method = \"%s\", arguments %s are not made use of" msgstr[0] "" msgstr[1] "" robustbase/inst/0000755000176200001440000000000013465050072013402 5ustar liggesusersrobustbase/inst/po/0000755000176200001440000000000013465050072014020 5ustar liggesusersrobustbase/inst/po/en@quot/0000755000176200001440000000000013465050072015433 5ustar liggesusersrobustbase/inst/po/en@quot/LC_MESSAGES/0000755000176200001440000000000013465050072017220 5ustar liggesusersrobustbase/inst/po/en@quot/LC_MESSAGES/R-robustbase.mo0000644000176200001440000010525012533543274022136 0ustar liggesusersT \X;)+(3<\6)4 ;B"~AAAVPsQ ;5 7q C G (5!^!w!!!A!(! "#?"c"6}"")"/"* #.K#=z#9#4#('$"P$s$1$&$$C$6@%Bw%5%%&&$&/K&{&&&;&&& &&&&'9'OV'.' '''% (*/(1Z("(+(8(&)";)(^)).)%))&*S;*G*O*)'+0Q+-++++*+",D7,7|,$,N, (-9I-B-7-N-6M.e.B.>-/3l/%/A/?0H00a090 00: 1H1UO1/11B1262<U2624272)63/`3 3373B3B,4o4]4$4/5/456d5+5H516FB6%6676#677MR747<7;8IN8A8'8A9"D93g9.9G9:1:*A:l::2:>:: ;<F;;;;;;><,D<=q<,<<<<.=,6=c=@v=9= ==>,,>+Y> > >>$> >>?,?5?K?0k?#??? ??@'@K,@x@@@@)@ @,@+*AVAhA3A6AABBB2BIBiB|BB BEB>B!C+9C2eC9C"C+C !D.,D3[D0D(DDDAE'YE6EE/EE*F>EF!F5FFFGEG#`GG+G<G H&H6HFH0ZHAHFH I95IoI8III1IJJYJ"`J(JJ#J6JP$K*uK(K+K+K!!LCL,RLLL8LPL4@M*uM0MMM)MN!N9&N8`N#NDNDO)GO%qO)OOO OP.+PZP^P4wP/P0P Q5Q*HQ'sQ QQQQ<QSSX&S;SSS,S@S:3T-nTT8T?T&(UOUIoUMUV VTAVUV"VCW?SWOWKW,/X\XyX%XMX, Y":Y']YY:YY-Y3"Z.VZ2ZAZ=Z88[,q[&["[5[.\M\Gb\:\F\9,]f] ]&]3]]^^;^Q^W^ Y^f^h^y^^9^O^.(_ W_'c_%_*_1_"`+1`8]`&`"`(` a.$a%Saya&a[aGbOab)b0b- c:cQcbc*ccHc7 d$BdNgd d=dNe7deNe>ee*fJfFf7"g%ZgAgCgh4h=Th hh:hiUi3kiiBiij<j6\j4j7j)k/*k Zkgk7{kBkBk9l]Kl$l/l/l6.m+emHm5mNn%_nn7n'n7nM,o4zo<o;oI(pErp'pIp"*q3Mq.qGqqr*'rRrqr:r>r:r@8s!ysssss>t,FtEst4tttt2u0Lu}uLu=u v%v=v,Vv+v v vv$v w!w=wVw_w#uw0w#www xx5xUxKZxxxxx)x (y,3y/`yyy7y:y4zOzbzuzzzzzz zIzB6{!y{+{2{9{"4|+W| |.|3|0|("}K}e}E}}'}6}"~/4~d~*~F~!~5N_vI#/@KȀ0܀A NO 98L_1fJ", :#W6{P*(./W3!݄068T\82#4V)†ۆ=<'[DDȇ) )7)a# ň.(,8E/~0߉5*'E m{}dk6'AM~(>B+OTHsN/AC 4$3&p=zE"D-%LfKj1o S*|.{G2JKrTO4v 6+Jw-IQ3_<Pm5.#2MB,'7 %;S9=05C/> :UtEIR?@x@9P 1"&nah](<:^RG0b)[qluL8Z e #Yi,\;`D VHy?N *W)g7!c F$F8!QX!! Using default."boot" method not yet implemented for "nlrob" objects. Use confint(*, method = "Wald").%s-step did NOT converge. Returning unconverged %s-estimate'' are ('%s' is not a valid family (see ?family)'%s' must be a function, numeric vector of length p, or NULL'%s' must be character string or function, but is "%s"', 'parm' must be specified as an integer'. Using defaults.'Anova Table' for a single model not yet implemented'Anova Table' for a single model object not yet implemented'X' must have at least two columns'coef' must not be negative'control$n.group' is not much larger than 'p', probably too small'control$n.group' must be larger than 'p' for 'large_n' algorithm'control' is missing'cov' must be a p x p matrix'epsw' must be numeric(1) or a function of nobs(obj.) which returns a numeric(1)'epsx' must be numeric(1) or a function of max(abs(x)) which returns a numeric(1)'formula' missing or incorrect'formula' should be a formula of the type 'y ~ f(x, alpha)''full.h' is true, but 'hsets.init' has less than n rows'groups * n.group' must be smaller than 'n' for 'large_n' algorithm'hsets.init' must be a h' x L matrix (h' >= h) of observation indices'hsets.init' must be in {1,2,...,n}; n ='id.n' must be in {1,..,'id.n' must be in {1,..,%d}'nsamp = "best"' allows maximally'nsamp' options 'best' and 'exact' not allowed for n greater than'offset' is not yet implemented for "BY"'offset' not fully implemented'pnames' must be a character vector'psi' should be one of %s'qr.out = TRUE' for univariate location is disregarded'reflect part' in'scale' must be NULL or a positive number'shortMain' is deprecated and will get defunct.'start' cannot yet be passed to glmrobBY()'start' must be a named list or numeric vector'start' must be a numeric vector, NULL, or a character string'start' must be an initial estimate of beta, of length %d'start' must be fully named (list or numeric vector)'weights' as formula should be one-sided'weights' must be a numeric vector'weights' must be non-negative'weights' must be nonnegative and not contain NAs'weights' must have same length as 'x''weights.on.x' ='weights.on.x' must be a string, function, list or numeric n-vector'wgtFUN' must be a function or a string specifying one'wgtFUN' must be a function or a string specifying such a function'wgtFUN' must be a function or one of the strings %s.'which' must be in 1:5'x' must be a numeric matrix(probably because of rounding errors).(tau / hybrid / tauold): tau not found in 'obj') but should be ()$).**** sampling iterations were not sufficient. Please report*and*,-estimate in.. Using default.. Please report!. Will use default..psi.lqq.findc: unable to find constants for psi function.vcov.avar1 can only be used when initial estimator is S; using .vcov.w instead.vcov.avar1() supports only SM or MM estimates0s in V(mu):.vcov.w: Caution. Some psiprime are NA:.vcov.w: cov.corrfact must be one of:.vcov.w: cov.dfcorr has to be one of -1:3:.vcov.w: cov.hubercorr must be logical (or NULL):.vcov.w: cov.resid must be one of:.vcov.w: cov.xwx must be logical (or NULL):.vcov.w: ignoring cov.resid == final since est != final:.vcov.w: scale missing, using D scale:.vcov.w: unsupported psi function:summary.lmrob: unsupported psi functionAlgorithm did not convergeAll models are refitted except the largest oneAll observations have missing values!All weights must be positiveAll weights.on.x must be none negativeAs "sigma" is in 'pnames', do not use it as variable or parameter name in 'formula'Assuming constant prediction variance even though model fit is weightedAssuming prediction variance inversely proportional to weights used for fittingC function R_lmrob_S() exited prematurelyCannot find valid starting values: You need helpCoef. for Hampel psi function not of length 3Coef. for psi functionCoefficients forComputing 5000 subsets of sizeComputing profile confidence intervals ...Convergence AchievedCurrently, only family 'poisson' is supported for the "MT" estimatorData set and provided center have different dimensions!Detected possible local breakdown ofDiagnostic plot is not available for univar iate location and scale estimationDimension {= ncol(x)} must be 2!Do not use '%s' as a variable name or as a parameter nameEither specify 'pnames' or provide 'upper' or 'lower' with names()Error: neither breakdown point nor efficiency specifiedFailed to compute robust Mahalanobis distances, reverting to robust leverages.For method 'cubif', use glmRob() from package 'robust'For method = "%s", argument %s is not made use ofFor method = "%s", arguments %s are not made use ofFor method = "%s", currently 'psi' must be specified via 'control'For test = 'Deviance', the estimator chain has to end with 'M'For tolerance ellipses the dimension 'p' must be 2!Implosion: sigma1=%g became too smallIndex plot of standardized residuals is not avalable if scale = 0Initial estimator '%s' not supported; using S-estimator insteadInitial setInitial setsInitialization 'init = "%s"' not supported (yet)Invalid scalefn='%s': must be function or a valid stringInvalid number of trials nsamp =Invalid number of trials nsamp=Invalid number of trials nsamp=%s. Using default nsamp=%d.KS2014Length of initial coefficients vector does not match rank of singular design matrix xMaximum 5000 subsets allowed for option 'best'.MethodMethods argument set by method is different from method in controlModels are not nested!Models are not strictly nestedMore dimensions than observations, currently not implementedMore dimensions than observations: not yet implementedMore than h of the observations lie on a hyperplane.More than half of the observations lie on a hyperplane.NA coefficient (at %s) from "best" subsetNA coefs in full and reduced model do not matchNAs in V(mu)NAs in d(mu)/d(eta)Need more than twice as many observations as variables.No categorical variables found in model. Reverting to S-estimator.No continuous variables found in model. Reverting to L1-estimator.No convergence inNo weights defined for this object. Use type="robustness" argument to get robustness weights.Non-finite coefficients at iterationNot the same method used for fitting the modelsNot the same response used in the fitted modelsNot the same tuning constant c used in the robust fitsNumber of observations in x and y not equalNumber of offsets is %d, should rather equal %d (number of observations)Only 'test.acc = "coef"' is currently implementedOptions 'best' and 'exact' not allowed for n greater than 2*nmini-1 =Please fit the nested models by lmrobPlease report!Predictions on current data refer to _future_ responsesPsi function '%s' not supported yetRegression Diagnostic plot is not avalable if scale = 0Regression Diagnostic plot is not avalable: option mcd=F was set in ltsReg().Robust GLM fitting not yet implemented for family %sS-estimated scale == 0: Probably exact fit; check your dataSample size n < h(alpha; n,p) := size of "good" subsampleStandardized residuals vs Fitted values plot is not avalable if scale = 0Std.error computation not yet available for the case of 'weights'The MCD covariance matrix was singular.The argument 'acc' has been renamed to 'tol'; do adapt your code.The covariance matrix is singular!The first object does not contain the largest modelThe sample size must be greater than 1 for svdThere is at least one constant column. Remove it and set intercept=TRUEThis family is not implementedThis may take aTolerance range must be between 0% to 100%Unexpected 'exactfit' codeUnknown setting 'Use 'main = "short"' instead of 'shortMain = TRUE'Use c(minimal slope, b, efficiency, breakdown point) or k[1:3]Use c({0, } minimal slope, b, efficiency, breakdown point)Use lmrob argument 'setting="KS2014"' to avoid this problem.Use only with 'lmrob' objectsUse only with 'lts' objectsUse only with 'mcd' objectsUsing the former, method =Weighting methodX'WX is almost singular. Consider rather using cov = ".vcov.w"X'WX is singular. Rather use cov = ".vcov.w"You cannot specify both 'main' and the deprecated 'shortMain'You should use different 'eps' and/or 'eps1'])values^list\(alpha not inside [1/2, 1]anova.glmrob() only works for 'glmrob' objectsanova.lmrob() only works for 'lmrob' objectsare disregarded inargument 'm.cov' must have numeric components 'center' and 'cov'argument 'psi' must be a string (denoting a psi function)argumentsarguments of function 'betaExacto glm(.) error:calculations stopped prematurely in rllarsbicalling predict.lm() ...coefficientcoefficientscontrol is missingcould not compute scale of residualscouldn't find optimizer functionderiv must be in {-1,0,1,2}deriv must be in {0,1,2}dropped:failed to converge infamily '%s' not yet implementedfitted probabilities numerically 0 or 1 occurredfitted rates numerically 0 occurredfixingfor fitting methodfor method='function incorrectly specified.glm(.) {inner subsample} error:id.nif a list, weights.on.x must contain a covariance function such as covMcd()illegal 'family' argumentillegal 'singularity$kind'inincompatible dimensionsinit must be "S", "M-S", function or listinstead ofinternal logic error in psi() function name:invalid 'lmrob' object: no terms componentinvalid 'method':invalid 'posdef.meth':invalid 'psi'=%s; possibly use .regularize.Mpsi(%s)invalid 'seed'. Must be compatible with .Random.seed !invalid 'start' stringinvalid 'test'invalid 'type'invalid 'variant':invalid first argumentinvalid tuning parameter names:is not implementediteriter2iterationslmrob object does not have a proper 'qr' component. Rank must be zerolmrob object does not have a proper 'qr' component. Rank zero?lmrob..D..fit: control is missinglmrob..D..fit: parameter psi is not definedlmrob..D..fit: parameter tuning.psi is not numericlmrob..D..fit: prior estimator did not converge, stoppinglmrob..D..fit: residuals undefinedlmrob..D..fit: robustness weights undefinedlong time!lower must be either of length %d, or length 1maximal number of *inner* step halvings must be > 0maximum number of "kstep" iterations must be > 0maximum number of iterations must be > 0mc(): not 'converged'method for psi functionmethod='%s' is only applicable for binomial family, but family=""missing or negative weights not allowedmodels were not all fitted to the same size of datasetmust be in {1,..,n < 2 * p, i.e., possibly too small sample sizen <= p -- you can't be serious!n == p+1 is too small sample size for MCDneed 'model' or 'x' component for robust Mahalanobis distancesneed non-negative number of nodesneed non-robust working residuals for this model typenegative eigen([negative scale 's'no intercept in the modelno valid subsample found in LTS - set 'nsamp' or rather use lmrob.S()non-function specified as optimizernon-implemented test method:non-trivial 'offset' is not yet implementednon-trivial prior 'weights' are not yet implemented for "BY"not correctly supported yetnot implementednot of length 1not yet implementednsamp > i_max := maximal integer -- not allowed;number of offsets is %d, should equal %d (number of observations)number of rows in 'x' and length of 'object$rweights' must be the samenumber of subsamples must be > 0only M and D are steps supported after "init" computationoptim(.) non-convergence:optimizer function must use (at least) formal parametersoptimizer="optimx"optimxoption hcorr is ignored for cov.corrfact = asymptoriginal detmcd() wrongly declared c-step convergence (obj=%g, i=%d, j=%d)out ofpackage must be loaded in order toparameter names must appear in 'formula'parameter psi is not definedparameter tuning.psi is not numericprediction from a rank-deficient fit may be misleadingprofile() method not yet implemented for "nlrob" objects. Use method = "Wald".provide better scale; must be all positiverecomputing robust Mahalanobis distancessaving the robust distances 'MD' as part ofscale 's' is zero -- returning initial 'mu'scale MAD is zero for this sampleset to i_max =setting 'y = FALSE' has no longer any effectsingular fit encounteredsome eigenvalues are negativesome terms will have NAs due to the limits of the methodspecifying 'pnames' is deprecated; rather 'lower' or 'upper' should have names()specifying 'weights' is not yet supported for methodspecifying both 'acc' and 'tol' is invalidstart 'theta' has still NA's .. badly singular xstepssteps.subsample size h < n/2 may be too smallsubsets; computing thesetestthe following arguments to 'anova.glmrob' are invalid andthe following arguments to 'anova.lmrob' are invalid andtuning constant 'cc' is not numerictuning constants for ggw psi: both eff and bp specified, ignoring bptuning constants for lqq psi: both eff and bp specified, ignoring bptuning parameter (chi/psi) is not numerictype 'pearson' is not yet implementedunable to find constants for psi functionunknown 'wgtFUN' specification:unknown init argumentunknown setting for parameter ssunknown split typeupper must be either of length %d, or length 1usevalue of acc must be > 0value of the tuning constant c ('const') must be > 0value of the tuning constant c (cw) must be > 0value of the tuning constant c (tcc) must be > 0veryweights should not be both close to 0 and close to 1!weights.on.x needs %d none-negative valuesx is not a numeric dataframe or matrix.x is singulary is not a numericy is not onedimensional}Project-Id-Version: robustbase 0.92-4 POT-Creation-Date: 2015-06-03 11:16 PO-Revision-Date: 2015-06-03 11:16 Last-Translator: Automatically generated Language-Team: none MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Language: en Plural-Forms: nplurals=2; plural=(n != 1); !! Using default."boot" method not yet implemented for "nlrob" objects. Use confint(*, method = "Wald").%s-step did NOT converge. Returning unconverged %s-estimate'' are (‘%s’ is not a valid family (see ?family)‘%s’ must be a function, numeric vector of length p, or NULL‘%s’ must be character string or function, but is "%s"‘, ’parm' must be specified as an integer'. Using defaults.‘Anova Table’ for a single model not yet implemented‘Anova Table’ for a single model object not yet implemented‘X’ must have at least two columns‘coef’ must not be negative‘control$n.group’ is not much larger than ‘p’, probably too small‘control$n.group’ must be larger than ‘p’ for ‘large_n’ algorithm‘control’ is missing‘cov’ must be a p x p matrix‘epsw’ must be numeric(1) or a function of nobs(obj.) which returns a numeric(1)‘epsx’ must be numeric(1) or a function of max(abs(x)) which returns a numeric(1)‘formula’ missing or incorrect‘formula’ should be a formula of the type ‘y ~ f(x, alpha)’‘full.h’ is true, but ‘hsets.init’ has less than n rows‘groups * n.group’ must be smaller than ‘n’ for ‘large_n’ algorithm‘hsets.init’ must be a h' x L matrix (h' >= h) of observation indices‘hsets.init’ must be in {1,2,...,n}; n =‘id.n’ must be in {1,..,‘id.n’ must be in {1,..,%d}‘nsamp = "best"’ allows maximally‘nsamp’ options ‘best’ and ‘exact’ not allowed for n greater than‘offset’ is not yet implemented for "BY"‘offset’ not fully implemented‘pnames’ must be a character vector‘psi’ should be one of %s‘qr.out = TRUE’ for univariate location is disregarded‘reflect part’ in‘scale’ must be NULL or a positive number‘shortMain’ is deprecated and will get defunct.‘start’ cannot yet be passed to glmrobBY()‘start’ must be a named list or numeric vector‘start’ must be a numeric vector, NULL, or a character string‘start’ must be an initial estimate of beta, of length %d‘start’ must be fully named (list or numeric vector)‘weights’ as formula should be one-sided‘weights’ must be a numeric vector‘weights’ must be non-negative‘weights’ must be nonnegative and not contain NAs‘weights’ must have same length as ‘x’‘weights.on.x’ =‘weights.on.x’ must be a string, function, list or numeric n-vector‘wgtFUN’ must be a function or a string specifying one‘wgtFUN’ must be a function or a string specifying such a function‘wgtFUN’ must be a function or one of the strings %s.‘which’ must be in 1:5‘x’ must be a numeric matrix(probably because of rounding errors).(tau / hybrid / tauold): tau not found in ‘obj’) but should be ()$).**** sampling iterations were not sufficient. Please report*and*,-estimate in.. Using default.. Please report!. Will use default..psi.lqq.findc: unable to find constants for psi function.vcov.avar1 can only be used when initial estimator is S; using .vcov.w instead.vcov.avar1() supports only SM or MM estimates0s in V(mu):.vcov.w: Caution. Some psiprime are NA:.vcov.w: cov.corrfact must be one of:.vcov.w: cov.dfcorr has to be one of -1:3:.vcov.w: cov.hubercorr must be logical (or NULL):.vcov.w: cov.resid must be one of:.vcov.w: cov.xwx must be logical (or NULL):.vcov.w: ignoring cov.resid == final since est != final:.vcov.w: scale missing, using D scale:.vcov.w: unsupported psi function:summary.lmrob: unsupported psi functionAlgorithm did not convergeAll models are refitted except the largest oneAll observations have missing values!All weights must be positiveAll weights.on.x must be none negativeAs "sigma" is in ‘pnames’, do not use it as variable or parameter name in ‘formula’Assuming constant prediction variance even though model fit is weightedAssuming prediction variance inversely proportional to weights used for fittingC function R_lmrob_S() exited prematurelyCannot find valid starting values: You need helpCoef. for Hampel psi function not of length 3Coef. for psi functionCoefficients forComputing 5000 subsets of sizeComputing profile confidence intervals ...Convergence AchievedCurrently, only family ‘poisson’ is supported for the "MT" estimatorData set and provided center have different dimensions!Detected possible local breakdown ofDiagnostic plot is not available for univar iate location and scale estimationDimension {= ncol(x)} must be 2!Do not use ‘%s’ as a variable name or as a parameter nameEither specify ‘pnames’ or provide ‘upper’ or ‘lower’ with names()Error: neither breakdown point nor efficiency specifiedFailed to compute robust Mahalanobis distances, reverting to robust leverages.For method ‘cubif’, use glmRob() from package ‘robust’For method = "%s", argument %s is not made use ofFor method = "%s", arguments %s are not made use ofFor method = "%s", currently ‘psi’ must be specified via ‘control’For test = ‘Deviance’, the estimator chain has to end with ‘M’For tolerance ellipses the dimension ‘p’ must be 2!Implosion: sigma1=%g became too smallIndex plot of standardized residuals is not avalable if scale = 0Initial estimator ‘%s’ not supported; using S-estimator insteadInitial setInitial setsInitialization ‘init = "%s"’ not supported (yet)Invalid scalefn=‘%s’: must be function or a valid stringInvalid number of trials nsamp =Invalid number of trials nsamp=Invalid number of trials nsamp=%s. Using default nsamp=%d.KS2014Length of initial coefficients vector does not match rank of singular design matrix xMaximum 5000 subsets allowed for option ‘best’.MethodMethods argument set by method is different from method in controlModels are not nested!Models are not strictly nestedMore dimensions than observations, currently not implementedMore dimensions than observations: not yet implementedMore than h of the observations lie on a hyperplane.More than half of the observations lie on a hyperplane.NA coefficient (at %s) from "best" subsetNA coefs in full and reduced model do not matchNAs in V(mu)NAs in d(mu)/d(eta)Need more than twice as many observations as variables.No categorical variables found in model. Reverting to S-estimator.No continuous variables found in model. Reverting to L1-estimator.No convergence inNo weights defined for this object. Use type="robustness" argument to get robustness weights.Non-finite coefficients at iterationNot the same method used for fitting the modelsNot the same response used in the fitted modelsNot the same tuning constant c used in the robust fitsNumber of observations in x and y not equalNumber of offsets is %d, should rather equal %d (number of observations)Only ‘test.acc = "coef"’ is currently implementedOptions ‘best’ and ‘exact’ not allowed for n greater than 2*nmini-1 =Please fit the nested models by lmrobPlease report!Predictions on current data refer to _future_ responsesPsi function ‘%s’ not supported yetRegression Diagnostic plot is not avalable if scale = 0Regression Diagnostic plot is not avalable: option mcd=F was set in ltsReg().Robust GLM fitting not yet implemented for family %sS-estimated scale == 0: Probably exact fit; check your dataSample size n < h(alpha; n,p) := size of "good" subsampleStandardized residuals vs Fitted values plot is not avalable if scale = 0Std.error computation not yet available for the case of ‘weights’The MCD covariance matrix was singular.The argument ‘acc’ has been renamed to ‘tol’; do adapt your code.The covariance matrix is singular!The first object does not contain the largest modelThe sample size must be greater than 1 for svdThere is at least one constant column. Remove it and set intercept=TRUEThis family is not implementedThis may take aTolerance range must be between 0% to 100%Unexpected ‘exactfit’ codeUnknown setting 'Use ‘main = "short"’ instead of ‘shortMain = TRUE’Use c(minimal slope, b, efficiency, breakdown point) or k[1:3]Use c({0, } minimal slope, b, efficiency, breakdown point)Use lmrob argument ‘setting="KS2014"’ to avoid this problem.Use only with ‘lmrob’ objectsUse only with ‘lts’ objectsUse only with ‘mcd’ objectsUsing the former, method =Weighting methodX'WX is almost singular. Consider rather using cov = ".vcov.w"X'WX is singular. Rather use cov = ".vcov.w"You cannot specify both ‘main’ and the deprecated ‘shortMain’You should use different ‘eps’ and/or ‘eps1’])values^list\(alpha not inside [1/2, 1]anova.glmrob() only works for ‘glmrob’ objectsanova.lmrob() only works for ‘lmrob’ objectsare disregarded inargument ‘m.cov’ must have numeric components ‘center’ and ‘cov’argument ‘psi’ must be a string (denoting a psi function)argumentsarguments of function 'betaExacto glm(.) error:calculations stopped prematurely in rllarsbicalling predict.lm() ...coefficientcoefficientscontrol is missingcould not compute scale of residualscouldn't find optimizer functionderiv must be in {-1,0,1,2}deriv must be in {0,1,2}dropped:failed to converge infamily ‘%s’ not yet implementedfitted probabilities numerically 0 or 1 occurredfitted rates numerically 0 occurredfixingfor fitting methodfor method='function incorrectly specified.glm(.) {inner subsample} error:id.nif a list, weights.on.x must contain a covariance function such as covMcd()illegal ‘family’ argumentillegal ‘singularity$kind’inincompatible dimensionsinit must be "S", "M-S", function or listinstead ofinternal logic error in psi() function name:invalid ‘lmrob’ object: no terms componentinvalid ‘method’:invalid ‘posdef.meth’:invalid ‘psi’=%s; possibly use .regularize.Mpsi(%s)invalid ‘seed’. Must be compatible with .Random.seed !invalid ‘start’ stringinvalid ‘test’invalid ‘type’invalid ‘variant’:invalid first argumentinvalid tuning parameter names:is not implementediteriter2iterationslmrob object does not have a proper ‘qr’ component. Rank must be zerolmrob object does not have a proper ‘qr’ component. Rank zero?lmrob..D..fit: control is missinglmrob..D..fit: parameter psi is not definedlmrob..D..fit: parameter tuning.psi is not numericlmrob..D..fit: prior estimator did not converge, stoppinglmrob..D..fit: residuals undefinedlmrob..D..fit: robustness weights undefinedlong time!lower must be either of length %d, or length 1maximal number of *inner* step halvings must be > 0maximum number of "kstep" iterations must be > 0maximum number of iterations must be > 0mc(): not ‘converged’method for psi functionmethod=‘%s’ is only applicable for binomial family, but family=""missing or negative weights not allowedmodels were not all fitted to the same size of datasetmust be in {1,..,n < 2 * p, i.e., possibly too small sample sizen <= p -- you can't be serious!n == p+1 is too small sample size for MCDneed ‘model’ or ‘x’ component for robust Mahalanobis distancesneed non-negative number of nodesneed non-robust working residuals for this model typenegative eigen([negative scale ‘s’no intercept in the modelno valid subsample found in LTS - set ‘nsamp’ or rather use lmrob.S()non-function specified as optimizernon-implemented test method:non-trivial ‘offset’ is not yet implementednon-trivial prior ‘weights’ are not yet implemented for "BY"not correctly supported yetnot implementednot of length 1not yet implementednsamp > i_max := maximal integer -- not allowed;number of offsets is %d, should equal %d (number of observations)number of rows in ‘x’ and length of ‘object$rweights’ must be the samenumber of subsamples must be > 0only M and D are steps supported after "init" computationoptim(.) non-convergence:optimizer function must use (at least) formal parametersoptimizer="optimx"optimxoption hcorr is ignored for cov.corrfact = asymptoriginal detmcd() wrongly declared c-step convergence (obj=%g, i=%d, j=%d)out ofpackage must be loaded in order toparameter names must appear in ‘formula’parameter psi is not definedparameter tuning.psi is not numericprediction from a rank-deficient fit may be misleadingprofile() method not yet implemented for "nlrob" objects. Use method = "Wald".provide better scale; must be all positiverecomputing robust Mahalanobis distancessaving the robust distances ‘MD’ as part ofscale ‘s’ is zero -- returning initial ‘mu’scale MAD is zero for this sampleset to i_max =setting ‘y = FALSE’ has no longer any effectsingular fit encounteredsome eigenvalues are negativesome terms will have NAs due to the limits of the methodspecifying ‘pnames’ is deprecated; rather ‘lower’ or ‘upper’ should have names()specifying ‘weights’ is not yet supported for methodspecifying both ‘acc’ and ‘tol’ is invalidstart ‘theta’ has still NA's .. badly singular xstepssteps.subsample size h < n/2 may be too smallsubsets; computing thesetestthe following arguments to ‘anova.glmrob’ are invalid andthe following arguments to ‘anova.lmrob’ are invalid andtuning constant ‘cc’ is not numerictuning constants for ggw psi: both eff and bp specified, ignoring bptuning constants for lqq psi: both eff and bp specified, ignoring bptuning parameter (chi/psi) is not numerictype ‘pearson’ is not yet implementedunable to find constants for psi functionunknown ‘wgtFUN’ specification:unknown init argumentunknown setting for parameter ssunknown split typeupper must be either of length %d, or length 1usevalue of acc must be > 0value of the tuning constant c (‘const’) must be > 0value of the tuning constant c (cw) must be > 0value of the tuning constant c (tcc) must be > 0veryweights should not be both close to 0 and close to 1!weights.on.x needs %d none-negative valuesx is not a numeric dataframe or matrix.x is singulary is not a numericy is not onedimensional}robustbase/inst/CITATION0000644000176200001440000000334613012615634014544 0ustar liggesuserscitHeader("To cite robustbase in publications use:") if(!exists("meta") || is.null(meta)) meta <- packageDescription("robustbase") year <- sub("-.*", "", meta$Date) note <- sprintf("R package version %s", meta$Version) fullTitle <- paste(meta$Package, meta$Title, sep = ": ") authors <- eval(parse(text = meta$`Authors@R`)) aut.gf <- lapply(unclass(authors), `[`, c("given", "family")) authNms <- sapply(aut.gf, paste, collapse = " ") collNms <- function(nms) paste(paste(nms[-length(nms)], collapse = ", "), "and", nms[length(nms)]) citEntry(entry = "Manual", title = fullTitle, author = authors, year = year, note = note, url = "http://robustbase.r-forge.r-project.org/", url = "http://CRAN.R-project.org/package=robustbase", textVersion = paste(collNms(authNms), sprintf("(%s).", year), fullTitle, paste(note, ".", sep = ""), "URL http://CRAN.R-project.org/package=robustbase"), header = paste("To cite package", sQuote(meta$Package), "in publications use:") ) citEntry(entry = "Article", title = "An Object-Oriented Framework for Robust Multivariate Analysis", author = personList(as.person("Valentin Todorov"), as.person("Peter Filzmoser")), journal = "Journal of Statistical Software", year = "2009", volume = "32", number = "3", pages = "1--47", url = "http://www.jstatsoft.org/v32/i03/", textVersion = paste("Valentin Todorov, Peter Filzmoser (2009).", "An Object-Oriented Framework for Robust Multivariate Analysis.", "Journal of Statistical Software, 32(3), 1-47.", "URL http://www.jstatsoft.org/v32/i03/."), header = "To cite the multivariate class/methods framework use:" ) robustbase/inst/NEWS.Rd0000644000176200001440000003020313465050054014443 0ustar liggesusers% Check from R: % news(db = tools:::.build_news_db_from_package_NEWS_Rd("~/R/Pkgs/robustbase/inst/NEWS.Rd")) \name{NEWS} \title{News for \R Package \pkg{robustbase}} \encoding{UTF-8} \section{CHANGES in robustbase VERSION 0.93-5 (2019-05-09, svn r840)}{ \subsection{Tweaks}{ \itemize{ \item For tests: try harder in \code{moreSessionInfo()} to detect openBLAS (should work for KH's debian openBLAS setup). } } } \section{CHANGES in robustbase VERSION 0.93-4 (2019-03-18, svn r839)}{ \subsection{BUG FIXES}{ \itemize{ \item \env{R_CHECK_LENGTH_1*} fix in default value for \code{ask} in plot methods for \code{mcd} and \code{lts} \item \file{src/rowMedians.c} gets better PROTECT()ion thanks to Tomas Kalibera's "rchk"s. } } \subsection{Tweaks}{ \itemize{ \item losen the strict tests more, convergence issues on all non-standard BLAS platforms. Now modularized the partly platform dependent testing into \code{moreSessionInfo()} in \file{./xtraR/platform-sessionInfo.R}. Further, for now use \code{RNGversion("3.5.0")} e.g. in \file{../tests/mc-strict.R}. } } } \section{CHANGES in robustbase VERSION 0.93-3 (2018-09-06, svn r827)}{ \subsection{Tweaks}{ \itemize{ \item losen the strict tests, notably in \file{tests/nlregrob-tst.R} to work around \code{nls()} convergence issues on all non-standard BLAS platforms. } } } \section{CHANGES in robustbase VERSION 0.93-2 (2018-07-26, svn r825)}{ \subsection{BUG FIXES}{ \itemize{ \item Update \code{lmrob()} to the change in R (incl 3.5.1 patched). \item \code{mc()} gets new optional \code{doScale} argument, and \emph{increased} defaults for the tolerances \preformatted{ eps1 = 1e-14, eps2 = 1e-15} such that it should converge by default in more cases. \item A \code{na.action} is now kept in \code{summary(lmrob(*))}, and when \code{print()}ing it, a note about omitted observations, e.g., because of \code{NA}'s, is made as for \code{lm()}. \item Internal \code{lmrob.weights()}: more "resistant" in case scale=0, using na.rm=TRUE (report only, no reprex). \item \code{lmrob(*, trace.lev >= 2)} now shows some information about the number of \code{find_scale()} iterations used (as these are now stored C internally).% TODO: return the maximum used to R? } } } \section{CHANGES in robustbase VERSION 0.93-1-1 (2018-07-18, svn r818)}{ \subsection{BUG FIXES}{ \itemize{ \item \file{src/robustbase.h}: \code{is_redescender} now \code{\bold{static} inline}, needed for some compilers, e.g., on ubuntu 18.04. Fixing R-forge bug(s) 6588 (and 6590, 6593), \url{https://r-forge.r-project.org/tracker/index.php?func=detail&aid=6588&group_id=59&atid=302} } } } \section{CHANGES in robustbase VERSION 0.93-1 (2018-06-20, svn r815)}{ \subsection{NEW FEATURES}{ \itemize{ \item The \sQuote{Usage:}s in the data set help pages now say \code{data(<..>, package="robustbase")}. \item The \file{lmrob_simulation} vignette now should continue to work with upcoming \pkg{ggplot2}. } } \subsection{BUG FIXES}{ \itemize{ \item \code{Mpsi(x, c, psi="huber", deriv=-1)} now gives rho(x) instead of mostly \code{Inf}. } } } \section{CHANGES in robustbase VERSION 0.93-0 (2018-04-21, svn r805)}{ \subsection{NEW FEATURES}{ \itemize{ \item \code{.psi.const(*, "lqq")} now also gives a \code{"constants"} attribute. \item more examples and help on Mpsi() etc functions and tuning constants. \item The S estimator \code{lmrob.S()} and M-S estimator now both make use of the new \code{lmrob.control()} argument \code{scale.tol} which defaults to \code{1e-10}, its formerly hardwired value. \item \code{lmrob.S()} further gets a new option \code{only.scale = FALSE}, which when true allows to only compute the S scale estimate. In that case, but also generally, \code{trace.lev = 3} or larger also produces output showing the C level \code{find_scale()} iterations. \item (By Manuel Koller) There's now a small C API to call our \code{Mpsi()} etc from C code in other packages, as \code{C_psi()}, etc; using new \file{../inst/include/robustbase.h}. \item \code{nlrob()$call$algorithm} now always contains the algorithm used as a \code{\link{character}} string, compatibly with \code{\link{nls}()}. \item new data set \code{steamUse}. %% which also depicts the \dQuote{non-robust} behavior of \code{lmrob(setting="KS2014")} \item Vignette \file{lmrob_simulation.Rnw}: fixed the wrong \dQuote{emprical power} plots; with faster \pkg{ggplot2}, remove all \code{eval=FALSE} for plots and longer store the \file{*.pdf}s. \code{nlrob()} gets \code{model} option to ask for the \code{model.frame} to be returned. } } \subsection{BUG FIXES}{ \itemize{ \item \code{lmrob(..., method = "S")} no longer necessarily produces a warning in \code{.vcov.w()}. \item \code{nlrob()} returns a correct \code{dataClasses} component. } } \subsection{Tests Tweaks}{ \itemize{ \item For use in non-R-internal BLAS/Lapack libraries, several \file{tests/*.R} examples have been tweaked. } } } \section{CHANGES in robustbase VERSION 0.92-8 (2017-10-30, svn r778)}{ \subsection{NEW FEATURES}{ \itemize{ \item \code{fullRank()} utility for \code{adjOutlyingness}: \item \code{adjOutlyingness()}, gets new options \code{p.samp} and \code{trace.lev}, and when it fails to find enough good directions, now checks the rank and mentions \code{fullRank()} in case the matrix is (QR-)rank deficient. \item The \code{"lmrob"} method for \code{vcov()} gets optional argument \code{complete = TRUE}, where only \emph{complete = FALSE} is back compatible. \item improved (error) messages in singular case in \code{.vcov.avar1()}. \item \code{.psi.const()} is exported as well, and help is improved about using and setting non-default psi tuning constants. } } \subsection{BUG FIXES}{ \itemize{ \item loosened some regression test tolerances (for alternatives to BLAS) in \file{tests/(mc-strict|poisson-ex)}. \item \code{scaleTau2(x, *)} gains an optional \code{sigma0} argument and now returns zero instead of \code{NaN} when \code{sigma0 == 0}. } } } \section{CHANGES in robustbase VERSION 0.92-7 (2016-11-23, svn r742)}{ \subsection{NEW FEATURES}{ \itemize{ \item \code{vignette(psi_functions)} \item \code{adjOutlyingness(..., maxit.mult = max(100, p))} new option, allowing more iterations for finding \dQuote{good} projection directions. } } \subsection{BUG FIXES}{ \itemize{ \item \code{summary(nlrob(*, method = "CM"))} now works. \item \code{lmrob..MM..fit()} now works again when \code{x} and \code{y} are specified, but neither \code{method} nor \code{obj} is. } } } \section{CHANGES in robustbase VERSION 0.92-6 (2016-05-28, svn r717)}{ \subsection{NEW FEATURES}{ \itemize{ \item Now provide an \code{"lmrob"} method for the standard \R generic function \code{hatvalues()}, and also export its lower level workhorse \code{.lmrob.hat()} (formerly hidden \code{lmrob.leverages()}), which now by default has \code{names(.)}. } } \subsection{BUG FIXES}{ \itemize{ \item \code{.lmrob.hat()} (formerly \code{lmrob.leverages()}) has been corrected for the rank-deficient case. \item \code{classPC(m)} now also works for a 1-column matrix. } } } \section{CHANGES in robustbase VERSION 0.92-5 (2015-07-21, svn r698)}{ \subsection{NEW FEATURES}{ \itemize{ \item \emph{Hidden} \code{print()} methods \code{print.summary.lmrob()} and \code{print.lmrob.S()} get a \code{showAlgo = TRUE} argument which the user can set to FALSE in order to suppress printing of the \dQuote{Algorithmic parameters}. \item import (remaining parts) from "base" packages. \item \code{summary()} now also prints a summary on the residuals. } } \subsection{BUG FIXES}{ \itemize{ \item \code{summary(lmrob(.))}'s variance-covariance matrix is now called \code{cov} instead of \code{cov.unscaled} (because it \emph{is} scaled). Code which has been using \code{vcov()} or \code{ $ cov}, or even \code{ $ cov} is not affected. } } } \section{CHANGES in robustbase VERSION 0.92-4 (2015-06-04, svn r696)}{ \subsection{NEW FEATURES}{ \itemize{ \item Started this \file{NEWS.Rd} file, to eventually replace the \file{ChangeLog} \item \code{plot.lmrob()} also identifies largest residuals as \code{plot.lm()}. Also gets new argument \code{panel}, and \code{add.smooth=TRUE} behavior. \item adapt to the fact that R 3.3.0 will have its own \code{sigma()} S3 generic. \item setup for having message translations (volunteers sought!). } } \subsection{BUG FIXES}{ \itemize{ \item more careful in \file{../src/mc.c} (valgrind, thanks to Brian) \item add missing documentation, better examples for \code{predict.lmrob} \item \code{warn.limit.*} checks in \code{lmrob*()} } } } \section{CHANGES in robustbase VERSION 0.92-3 (2015-01-14, svn r679)}{ \subsection{NEW FEATURES}{ \itemize{ \item The \sQuote{Co-Median} \code{covComed()} from Maria Anna, tweaked by Valentin and modified considerably by Martin. \item Also document (and export) \code{r6pack()} utility. \item New \code{smoothWgt()} function --- \dQuote{Biweight on a Stick} --- to be used as \code{wgtFUN} option for \code{covMcd()} or \code{covComed()}. \item New utility \code{colMedians()} and \code{rowMedians}, as we use columnwise medians in so many places. } } \subsection{BUG FIXES}{ \itemize{ \item Tweaks to \code{medcouple()}, after detecting flaws -- which may be inherent and have \emph{not} been removed. \item Improved its documentation and the \code{adjOutlyingness()} one, notably its \dQuote{central} case. } } } \section{CHANGES in robustbase VERSION 0.92-2 (2014-11-22, svn r660)}{ \subsection{BUG FIXES}{ \itemize{ \item \code{covMcd()} with new options (\code{kmini}, \code{nmini}) now ok (sometimes wrong in 0.92-1). } } } \section{CHANGES in robustbase VERSION 0.92-1 (2014-11-18)}{ \subsection{NEW FEATURES}{ \itemize{ \item The deterministic MCD, via \code{covMcd(..., nsamp="deterministic")}. } } \subsection{BUG FIXES}{ \itemize{ \item \code{adjOutlyingness()}: reverse the defaults of \code{clower} and \code{cupper} and fix an \dQuote{eternal} erronous \eqn{\pm}{+/-} swap; see new note in \file{man/adjOutlyingness.Rd}. } } } \section{CHANGES in robustbase VERSION 0.92-0 (2014-11-18)}{ \subsection{NEW FEATURES}{ \itemize{ \item \code{nlrob()} now works with indexed vector parameters. \item new \code{outlierStats()} (Manuel). } } \subsection{BUG FIXES}{ \itemize{ \item got rid of Fortran compiler warnings about \bold{ancient} style. \item \code{nlrob(*, weigths)}, fixing R-forge bug #5988. \item \code{covMcd()} fix for \dQuote{MAD = 0} case (new \code{exactfit} code 3). } } } \section{CHANGES in robustbase VERSION 0.91-1 (2014-05-01)}{ \subsection{BUG FIXES}{ \itemize{ \item . } } } \section{CHANGES in robustbase VERSION 0.91-0 (2014-04-24)}{ \subsection{NEW FEATURES}{ \itemize{ \item . } } \subsection{BUG FIXES}{ \itemize{ \item . } } } \section{CHANGES in robustbase VERSION 0.90-1 (2014-01-30)}{ \subsection{NEW FEATURES}{ \itemize{ \item . } } \subsection{BUG FIXES}{ \itemize{ \item . } } } \section{CHANGES in robustbase VERSION 0.9-8 (2013-06-14)}{ \subsection{NEW FEATURES}{ \itemize{ \item . } } \subsection{BUG FIXES}{ \itemize{ \item . } } } robustbase/inst/xtraR/0000755000176200001440000000000013465050072014502 5ustar liggesusersrobustbase/inst/xtraR/test_LTS.R0000644000176200001440000001033311757675047016347 0ustar liggesusers#### Utility functions for testing ltsReg() #### -------------------------------------- ../tests/tlts.R repLTS <- function(form, data, nrep = 1, method = c("FASTLTS","MASS")) { if(method == "MASS") ## MASS::lqs(x,y,control=list(psamp = NA, nsamp= "best", adjust= FALSE)) for(i in 1:nrep) MASS::lqs(form, data = data, method = "lts") else ## set mcd=FALSE - we want to time only the LTS algorithm for(i in 1:nrep) ltsReg(form, data = data, mcd = FALSE) } doLTSdata <- function(nrep = 1, time = nrep >= 3, short = time, full = !short, method = c("FASTLTS", "MASS")) { ##@bdescr ## Test the function ltsReg() on the literature datasets: ## ## Call ltsReg() for "all" regression datasets available in robustbase ## and print: ## - execution time (if time) ## - objective function ## - best subsample found (if not short) ## - outliers identified (with cutoff 0.975) (if not short) ## - estimated coeficients and scale (if full) ## ##@edescr ## ##@in nrep : [integer] number of repetitions to use for estimating the ## (average) execution time ##@in time : [boolean] whether to evaluate the execution time ##@in short : [boolean] whether to do short output (i.e. only the ## objective function value). If short == FALSE, ## the best subsample and the identified outliers are ## printed. See also the parameter full below ##@in full : [boolean] whether to print the estimated coeficients and scale ##@in method : [character] select a method: one of (FASTLTS, MASS) dolts <- function(form, dname, dataset, nrep = 1) { if(missing(dataset)) { data(list = dname) dataset <- get(dname) } else if(missing(dname)) dname <- deparse(substitute(dataset)) environment(form) <- environment() ## !?! x <- model.matrix(form, model.frame(form, data = dataset)) dx <- dim(x) - 0:1 # not counting intercept if(method == "MASS") { lts <- MASS::lqs(form, data = dataset, method = "lts") quan <- (dx[1] + (dx[2] + 1) + 1)/2 #default: (n+p+1)/2 } else { lts <- ltsReg(form, data = dataset, mcd = FALSE) quan <- lts$quan } xres <- sprintf("%*s %3d %3d %3d %12.6f", lname, dname, dx[1], dx[2], as.integer(quan), lts$crit) if(time) { xtime <- system.time(repLTS(form, data = dataset, nrep, method))[1] xres <- sprintf("%s %10.1f", xres, 1000 * xtime / nrep) } cat(xres, "\n") if(!short) { cat("Best subsample: \n") print(lts$best) ibad <- which(lts$lts.wt == 0) names(ibad) <- NULL nbad <- length(ibad) cat("Outliers: ",nbad,"\n") if(nbad > 0) print(ibad) if(full) { cat("-------------\n") print(lts) print(summary(lts)) } cat("--------------------------------------------------------\n") } } method <- match.arg(method) data(heart) data(starsCYG) data(phosphor) data(stackloss) data(coleman) data(salinity) data(aircraft) data(delivery) data(wood) data(hbk) cll <- sys.call() cat("\nCall: ", deparse(substitute(cll)),"\n") cat("========================================================\n") cat("Data Set n p Half obj Time [ms]\n") cat("========================================================\n") ## 1 3 5 7 9.1 3 5 7 9. 123 123 lname <- 20 ## --^ dolts(clength ~ . , "heart", nrep = nrep) dolts(log.light ~ log.Te , "starsCYG", nrep = nrep) dolts(plant ~ . , "phosphor", nrep = nrep) dolts(stack.loss ~ . , "stackloss", nrep = nrep) dolts(Y ~ . , "coleman", nrep = nrep) dolts(Y ~ . , "salinity") dolts(Y ~ . , "aircraft") dolts(delTime ~ . , "delivery") dolts(y ~ . , "wood", nrep = nrep) dolts(Y ~ . , "hbk", nrep = nrep) cat("========================================================\n") } robustbase/inst/xtraR/m-s_fns.R0000644000176200001440000001340613177452122016175 0ustar liggesusers#### Testing M-S estimator --- self-contained utility functions --- #### ## Exercised from ../../tests/m-s-estimator.R ## ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ## Test subsampling algorithm m_s_subsample <- function(x1, x2, y, control, orthogonalize=TRUE) { storage.mode(x1) <- "double" storage.mode(x2) <- "double" storage.mode(y) <- "double" z <- .C(robustbase:::R_lmrob_M_S, x1, x2, y, res=double(length(y)), n=length(y), p1=NCOL(x1), p2=NCOL(x2), nResample=as.integer(control$nResample), max_it_scale=as.integer(control$maxit.scale), scale=double(1), b1=double(NCOL(x1)), b2=double(NCOL(x2)), tuning_chi=as.double(control$tuning.chi), ipsi=.psi2ipsi(control$psi), bb=as.double(control$bb), K_m_s=as.integer(control$k.m_s), max_k=as.integer(control$k.max), rel_tol=as.double(control$rel.tol), inv_tol=as.double(control$solve.tol), scale_tol=as.double(control$scale.tol), converged=FALSE, trace_lev=as.integer(control$trace.lev), orthogonalize=as.logical(orthogonalize), subsample=TRUE, descent=FALSE, # and hence no 'convergence' here .. mts = 0L, ss = 1L) z[c("b1", "b2", "scale")] } ## Test descent algorithm m_s_descent <- function(x1, x2, y, control, b1, b2, scale) { storage.mode(x1) <- "double" storage.mode(x2) <- "double" storage.mode(y) <- "double" z <- .C(robustbase:::R_lmrob_M_S, X1=x1, X2=x2, y=y, res=double(length(y)), n=length(y), p1=NCOL(x1), p2=NCOL(x2), nResample=as.integer(control$nResample), max_it_scale=as.integer(control$maxit.scale), scale=as.double(scale), b1=as.double(b1), b2=as.double(b2), tuning_chi=as.double(control$tuning.chi), ipsi=.psi2ipsi(control$psi), bb=as.double(control$bb), K_m_s=as.integer(control$k.m_s), max_k=as.integer(control$k.max), rel_tol=as.double(control$rel.tol), inv_tol=as.double(control$solve.tol), scale_tol=as.double(control$scale.tol), converged=logical(1), trace_lev=as.integer(control$trace.lev), orthogonalize=FALSE, subsample=FALSE, descent=TRUE, ## ----- mts = 0L, ss = 1L) z[c("b1", "b2", "scale", "res", "converged")] } find_scale <- function(r, s0, n, p, control) { c.chi <- robustbase:::.psi.conv.cc(control$psi, control$tuning.chi) b <- .C(robustbase:::R_lmrob_S, x = double(1), y = as.double(r), n = as.integer(n), p = as.integer(p), nResample = 0L, # <- only.scale=TRUE , now in lmrob.S() scale = as.double(s0), coefficients = double(p), as.double(c.chi), .psi2ipsi(control$psi), as.double(control$bb), best_r = 0L, groups = 0L, n.group = 0L, k.fast.s = 0L, k.iter = 0L, maxit.scale = as.integer(control$maxit.scale), refine.tol = as.double(control$refine.tol), inv.tol = as.double(control$solve.tol), scale_tol=as.double(control$scale.tol), converged = logical(1), trace.lev = 0L, mts = 0L, ss = 1L, fast.s.large.n = as.integer(n+1) )[c("coefficients", "scale", "k.iter", "converged")] b$scale } ## m_s_descent()--R-only--version : m_s_descent_Ronly <- function(x1, x2, y, control, b1, b2, scale) { stopifnot(is.list(control), is.numeric(control$k.max)) n <- length(y) p1 <- ncol(x1) p2 <- ncol(x2) p <- p1+p2 t2 <- b2 t1 <- b1 rs <- drop(y - x1 %*% b1 - x2 %*% b2) sc <- scale ## do refinement steps ## do maximally control$k.max iterations ## stop if converged ## stop after k.fast.m_s step of no improvement if (control$trace.lev > 4) cat("scale:", scale, "\n") if (control$trace.lev > 4) cat("res:", rs, "\n") n.imp <- nnoimprovement <- nref <- 0L; conv <- FALSE while((nref <- nref + 1) <= control$k.max && !conv && nnoimprovement < control$k.m_s) { ## STEP 1: UPDATE B2 y.tilde <- y - x1 %*% t1 w <- Mwgt(rs / sc, control$tuning.chi, control$psi) if (control$trace.lev > 4) cat("w:", w, "\n") z2 <- lm.wfit(x2, y.tilde, w) t2 <- z2$coef if (control$trace.lev > 4) cat("t2:", t2, "\n") rs <- y - x2 %*% t2 ## STEP 2: OBTAIN M-ESTIMATE OF B1 z1 <- lmrob.lar(x1, rs, control) t1 <- z1$coef if (control$trace.lev > 4) cat("t1:", t1, "\n") rs <- z1$resid ## STEP 3: COMPUTE THE SCALE ESTIMATE sc <- find_scale(rs, sc, n, p, control) if (control$trace.lev > 4) cat("sc:", sc, "\n") ## STEP 4: CHECK FOR CONVERGENCE ##... FIXME ## STEP 5: UPDATE BEST FIT if (sc < scale) { scale <- sc b1 <- t1 b2 <- t2 nnoimprovement <- 0L n.imp <- n.imp + 1L } else nnoimprovement <- nnoimprovement + 1L } ## STEP 6: FINISH if (nref == control$k.max) warning("M-S estimate: maximum number of refinement steps reached.") ## if we'd really check for convergence above : ## if (nnoimprovement == control$k.m_s) ## warning("M-S estimate: maximum number of no-improvements reached.") list(b1=b1, b2=b2, scale=scale, res=rs, nref=nref, n.improve = n.imp)#, converged=conv, nnoimprovement=nnoimprovement) } robustbase/inst/xtraR/plot-psiFun.R0000644000176200001440000001127713310763444017060 0ustar liggesusers#### Functions to plot and check psi-functions #### ----------------------------------------- ## used in ../../tests/lmrob-psifns.R, ## ../../tests/psi-rho-etc.R ## and ../../vignettes/psi_functions.Rnw vignette ## Original Author of functions: Martin Maechler, Date: 13 Aug 2010, 10:17 p.psiFun <- function(x, psi, par, main=FALSE, ...) { m.psi <- cbind(rho = Mpsi(x, par, psi,deriv=-1), psi = Mpsi(x, par, psi,deriv= 0), Dpsi = Mpsi(x, par, psi,deriv= 1), wgt = Mwgt(x, par, psi)) robustbase:::matplotPsi(x, m.psi, psi=psi, par=par, main=main, ...) ## -> cbind(x, m.psi) } p.psiFun2 <- function(x, psi, par, main="short", ...) p.psiFun(x, psi, par, main=main, leg.loc= "bottomright", ylim = c(-2.2, 6)) ## for psi_func class objects: simply use plot() method. mids <- function(x) (x[-1]+x[-length(x)])/2 ##' is 'psi' the name of redescending psi (i.e. with *finite* rejection point) isPsi.redesc <- function(psi) { psi != "Huber" ## <- must be adapted when we introduce more } ##' @title Check consistency of psi/chi/wgt/.. functions ##' @param m.psi matrix as from p.psiFun() ##' @param tol ##' @return concatenation of \code{\link{all.equal}} results ##' @author Martin Maechler chkPsiDeriv <- function(m.psi, tol = 1e-4) { stopifnot(length(tol) > 0, tol >= 0, is.numeric(psi <- m.psi[,"psi"]), is.numeric(dx <- diff(x <- m.psi[,"x"]))) if(length(tol) < 2) tol[2] <- 10*tol[1] xn0 <- abs(x) > 1e-5 ## need to jitter here, as for "huber" the mostly equal cases are not counted ## (=> use all.equal(*, countEQ=TRUE) in future). Save & restore r.seed if needed: if(hasRS <- exists(".Random.seed", envir=.GlobalEnv)) RS <- .Random.seed set.seed(8) dpsidx <- (diff(psi)/dx) * (1 + 1e-7*rnorm(dx)) # jitter if(hasRS) assign(".Random.seed", RS, envir=.GlobalEnv) c(all.equal(mids(psi), diff(m.psi[,"rho"])/dx, tolerance=tol[1]), # rho' == psi all.equal(mids(m.psi[,"Dpsi"]), dpsidx, tolerance= tol[2]), # psi' == psip all.equal(m.psi[xn0,"wgt"], (psi/x)[xn0], tolerance= tol[1]/10))# psi/x == wgt } ##' This version "starts from scratch" instead of from p.psiFun() result: ##' ##' @title Check consistency of psi/chi/wgt/.. functions ##' @param x range or vector of abscissa values ##' @param psi psi() function spec., passed to M.psi() etc ##' @param par tuning parameter, passed to M.psi() etc ##' @param tol tolerance for equality checking of numeric derivatives ##' @return concatenation of \code{\link{all.equal}} results ##' @author Martin Maechler chkPsi.. <- function(x, psi, par, tol = 1e-4, doD2, quiet=FALSE) { stopifnot(length(tol) > 0, tol >= 0, is.numeric(x), is.finite(x)) is.redesc <- isPsi.redesc(psi) if(length(x) == 2) ## it is a *range* -> produce vector x <- seq(x[1], x[2], length = 1025L) dx <- diff(x) x0 <- sort(x) x <- c(-Inf, Inf, NA, NaN, x0) ## if(is.redesc) rho <- Mpsi(x, par, psi, deriv=-1) psix <- Mpsi(x, par, psi, deriv= 0) Dpsi <- Mpsi(x, par, psi, deriv= 1) wgt <- Mwgt(x, par, psi) chi <- Mchi(x, par, psi) if(is.redesc) { chi1 <- Mchi(x, par, psi, deriv=1) chi2 <- Mchi(x, par, psi, deriv=2) } rho.Inf <- MrhoInf(par, psi) stopifnot(all.equal(rep(rho.Inf,2), rho[1:2])) if(is.redesc) stopifnot(all.equal(rep(rho.Inf,2), rho[1:2]), all.equal(chi, rho / rho.Inf), all.equal(chi1,psix / rho.Inf), all.equal(chi2,Dpsi / rho.Inf) ) else { ## check any here? From ../src/lmrob.c : ## chi = C-function rho(x) which is unscaled rho <- chi # for checks below } D2psi <- tryCatch(Mpsi(x, par, psi, deriv= 2), error=function(e)e) has2 <- !inherits(D2psi, "error") doD2 <- if(missing(doD2)) has2 else doD2 && has2 if(!quiet & !doD2) message("Not checking psi''() := Mpsi(*, deriv=2)") stopifnot(is.numeric(psix), ## check NA / NaN : identical5(x[3:4], chi[3:4], psix[3:4], Dpsi[3:4], wgt[3:4]), if(has2) identical(x[3:4], D2psi[3:4]) else TRUE) if(length(tol) < 2) tol[2] <- 16*tol[1] if(length(tol) < 3) tol[3] <- tol[1]/10 if(length(tol) < 4) tol[4] <- 8*tol[2] i <- 5:length(x) # leaving away the first 4 (+-Inf, NA..) xn0 <- is.finite(x) & abs(x) > 1e-5 c("rho' = psi" = all.equal(mids(psix[i]), diff(rho [i])/dx, tolerance=tol[1]), "psi' = psip"= all.equal(mids(Dpsi[i]), diff(psix[i])/dx, tolerance=tol[2]), "psi/x= wgt" = all.equal( wgt[xn0], (psix/x)[xn0], tolerance=tol[3]), "psi''=D2psi"= if(doD2) all.equal(mids(D2psi[i]), diff(Dpsi[i])/dx,tolerance=tol[4]) else NA) } robustbase/inst/xtraR/ex-funs.R0000644000176200001440000000432212455444424016221 0ustar liggesusers## These two fail when length(x) == 0 {but are short and nice otherwise} himed <- function(x) { n2 <- 1 + length(x) %/% 2; sort(x, partial = n2)[n2] } lomed <- function(x) { n2 <- (1+ length(x))%/% 2; sort(x, partial = n2)[n2] } ## From package 'limma' : ~/R/BioCore/madman/Rpacks/limma/R/weightedmedian.R weighted.median <- function (x, w, na.rm = FALSE, low = FALSE, high = FALSE) { ## Weighted median ## Gordon Smyth ## 30 June 2005 ## improved by MMaechler: 'low' and 'high' as with 'mad()'; 21 Nov 2005 if (missing(w)) w <- rep.int(1, length(x)) else { if(length(w) != length(x)) stop("'x' and 'w' must have the same length") if(any(is.na(w))) stop("NA weights not allowed") ## Note that sometimes the estimate would be well-defined even ## with some NA weights! if(any(w < 0)) stop("Negative weights not allowed") if(is.integer(w)) w <- as.numeric(w) } if(any(nax <- is.na(x))) { if(na.rm) { w <- w[i <- !nax] x <- x[i] } else return(NA) } if(all(w == 0)) { warning("All weights are zero") return(NA) } ## otherwise, have sum(w) > 0 if(is.unsorted(x)) { o <- order(x) x <- x[o] w <- w[o] } p <- cumsum(w)/sum(w) k <- sum(p < 0.5) + 1:1 if(p[k] > 0.5 || low) x[k] else if(high) x[k+1] else (x[k] + x[k+1])/2 } Qn0R <- function(x) { ## `R only' naive version of Qn() ==> slow and large memory for large n n <- length(x <- sort(x)) if(n == 0) return(NA) else if(n == 1) return(0.) k <- choose(n %/% 2 + 1, 2) m <- outer(x,x,"-")# abs not needed because of sort() sort(m[lower.tri(m)], partial = k)[k] } Sn0R <- function(x) { ## `R only' naive version of Sn() ==> slow and large memory for large n if((n <- length(x)) == 0) return(NA) else if(n == 1) return(0.) lomed(apply(abs(outer(x,x,"-")), 2, himed)) } ## Tol = 2e-7 : higher than usual is.all.equal <- function(x,y, tol = 2e-7, scale = 1) { ## scale = 1: ensures 'absolute error' in all cases ## scale = x: ensures `relative error' in all cases is.logical(r <- all.equal(x,y, tolerance = tol, scale = scale)) && r } robustbase/inst/xtraR/lmrob-trace_lev.R0000644000176200001440000000452212154325275017711 0ustar liggesusers## testing trace_lev settings require(robustbase) ## fit a model with categorical, continuous and mixed variables selDays <- c( ## days ranked according to number of outliers: "403", "407", "693", "405", "396", "453", "461", ## "476", "678", "730", "380", "406", "421", "441" ## ,"442", "454", "462", "472", "480", "488" ## some other days ## "712", "503", "666", "616", "591", "552", "624", "522", "509", "388", "606", "580", "573", "602", "686", "476", "708", "600", "567") contr <- list(julday=contr.sum) ## using this seed and the default configuration options, ## the fast_S algorithm stops with some "local exact fits", ## i.e., coefficients with std. error 0. set.seed(711) lseed <- .Random.seed r1 <- lmrob(LNOx ~ (LNOxEm + sqrtWS)*julday, NOxEmissions, julday %in% selDays, contrasts=contr, seed=lseed, max.it=10000, nResample=5, trace.lev=1) ## change best.r.s to 11 and it works properly ## (for this seed at least) res <- update(r1, k.max=10000, best.r.s = 3, nResample=1000, trace.lev=2) ##### ## fast_S (non-large strategy) ## test non-convergence warnings / trace output: res <- update(r1, max.it = 1) res <- update(r1, k.max = 1) ## test trace_levs: res <- update(r1, trace.lev = 0) res <- update(r1, trace.lev = 1) res <- update(r1, trace.lev = 2) res <- update(r1, trace.lev = 3) res <- update(r1, trace.lev = 4) res <- update(r1, trace.lev = 5) ##### ## M-S estimator r2 <- update(r1, init="M-S", split.type="fi", subsampling="simple", mts=10000) ## test non-convergence warnings / trace output: res <- update(r2, max.it = 1) res <- update(r2, k.m_s = 1) ## does not converge anyway ## test trace_levs: res <- update(r2, trace.lev = 0) res <- update(r2, trace.lev = 1) res <- update(r2, trace.lev = 2) res <- update(r2, trace.lev = 3) res <- update(r2, trace.lev = 4) ## this produces _a_lot_ of output: ## res <- update(r2, trace.lev = 5) ##### ## fast_S (large-n strategy) ## need to use continuous only design r3 <- update(r1, LNOx ~ LNOxEm + sqrtWS, subset=NULL, contrasts=NULL) ## test non-convergence warnings / trace output: res <- update(r3, max.it = 1) res <- update(r3, k.max = 1) ## test trace_levs: res <- update(r3, trace.lev = 0) res <- update(r3, trace.lev = 1) res <- update(r3, trace.lev = 2) res <- update(r3, trace.lev = 3) res <- update(r3, trace.lev = 4) ## (there is no level 5) robustbase/inst/xtraR/mcnaive.R0000644000176200001440000000443413325654361016262 0ustar liggesusersmcNaive <- function (x, method = c("h.use", "simple"), low = FALSE, high = FALSE) { ## Purpose: naive implementation of mc() ## ---------------------------------------------- ## (low, high) - as in mad() - for choosing the (lo/hi)-median with even n ## ## Author: Martin Maechler, Date: 21 Jul 2007 n <- length(x) if(n <= 2) return(0) x <- sort(x) stopifnot(is.finite(m <- median(x)))# <==> no NAs in x[] x <- x - m n1 <- length(xL <- x[x <= 0]) # both contain all (if any) median values n2 <- length(xR <- x[x >= 0]) n.n <- as.double(n1)*n2 if(n.n > 1e8)# 1e8 < .Machine$integer.max stop("\"simple\" method not sensible here: would need too much memory: n.n=", n.n) Mmedian <- { if ((low || high) && n.n %% 2 == 0) { if (low && high) stop("'low' and 'high' cannot be both TRUE") N2 <- n.n %/% 2 + as.integer(high) function(x) sort(x, partial = N2)[N2] } else median } method <- match.arg(method) switch(method, "simple" = { r <- outer(xR, xL, "+") / outer(xR, xL, "-") r[is.na(r)] <- 0 # simple -- ## ok only when the median-observations are "in the middle", ## e.g. *not* ok for c(-5, -1, 0, 0, 0, 1) Mmedian(r) }, "h.use" = { # use h() = h_kern() .. treating obs. coinciding with median k <- sum(x == 0) ## the number of obs coinciding with median() irep <- rep.int(n1, n2) if(k > 0) { ## have some obs. == median ( == 0) h <- function(xl,xr, i,j) { ## must parallelize (!) eq <- xl == xr r <- xl xr <- xr[!eq] xl <- xl[!eq] r [eq] <- sign(i[eq]+j[eq]-1-k) r[!eq] <- (xr + xl)/(xr - xl) r } i <- integer(n1) j <- integer(n2) i[(n1-k+1):n1] <- j[1:k] <- 1:k i <- rep(i, times = n2) j <- rep(j, irep) } else { ## k == 0: h <- function(xl,xr, i,j) (xr + xl)/(xr - xl) i <- j <- NULL } ## build outer(xL, xR, FUN= h) manually, such that ## we can pass (i,j) properly : Mmedian(h(xl = rep(xL, times = n2), xr = rep(xR, irep), i, j)) }) } robustbase/inst/xtraR/subsample-fns.R0000644000176200001440000001273212271657124017416 0ustar liggesusers### Mainly used for source package checking in ../../tests/subsample.R ### however, available (for reproducible research, confirmation) as ### part of the robustbase package. ## R version of LU decomposition in subsample() in lmrob.c ## Modified from Golub G. H., Van Loan, C. F., Matrix Computations, 3rd edition LU.gaxpy <- function(A, pivot=TRUE, tol = 1e-7, verbose = FALSE) { A <- as.matrix(A) ## m x n matrix, n >= m >= 1 stopifnot((n <- ncol(A)) >= (m <- nrow(A)), m >= 1) ## precondition: cf0 <- max(abs(A)) A <- A / cf0 v <- double(m) ## work matrix ## these matrices will contain the results L <- diag(m) U <- matrix(0, m, m) p <- integer(m-1) ## pivots idc <- 1L:n ## which columns of A are used idr <- 1L:m ## how rows of A are permuted for(j in 1L:m) { sing <- TRUE while(sing) { if (length(idc) < j) break if (j == 1L) { v[j:m] <- A[idr[j:m], idc[j]] } else { rows <- 1L:(j-1L) z <- forwardsolve(L[rows, rows, drop=FALSE], A[idr[rows], idc[j]]) U[rows, j] <- z v[j:m] <- A[idr[j:m], idc[j]] - L[j:m, rows, drop=FALSE] %*% z if(verbose) cat("Step", j, "z=", sapply(z, function(x) sprintf("%.15f", x)), "\n v=", v, "\n") } if (j < m) { mu <- j mu <- if (pivot) which.max(abs(v[j:m])) + j - 1L else j if(verbose) ## debug possumDiv example cat(sprintf("R-Step: %i: ", j), round(abs(v[j:m]), 6), "\n", mu, v[mu], "\n") if (abs(v[mu]) >= tol) { ## singular: can stop here already p[j] <- mu if (pivot) { tmp <- v[j]; v[j] <- v[mu]; v[mu] <- tmp tmp <- idr[j]; idr[j] <- idr[mu]; idr[mu] <- tmp } L[(j+1L):m, j] <- v[(j+1L):m]/v[j] if (pivot && j > 1) { ## swap rows L[j,] <-> L[mu,] tmp <- L[j, rows]; L[j, rows] <- L[mu, rows]; L[mu, rows] <- tmp } } } U[j, j] <- v[j] if (abs(v[j]) < tol) { if(verbose) cat("* singularity detected in step ", j, "; candidate ", idc[j],"\n") idc <- idc[-j] } else sing <- FALSE }## {while} }## {for} list(L = L, U = U * cf0, p = p, idc = idc[1L:m], singular = sing) } Rsubsample <- function(x, y, mts=0, tolInverse = 1e-7) { if(!is.matrix(x)) x <- as.matrix(x) stopifnot((n <- length(y)) == nrow(x)) p <- ncol(x) storage.mode(x) <- "double" .C(robustbase:::R_subsample, x=x, y=as.double(y), n=as.integer(n), m=as.integer(p), beta=double(p), ind_space=integer(n), idc = integer(n), ## elements 1:p: chosen subsample idr = integer(n), lu = matrix(double(1), p,p), v=double(p), pivot = integer(p-1), Dr=double(n), Dc=double(p), rowequ=integer(1), colequ=integer(1), status=integer(1), sample = FALSE, ## set this to TRUE for sampling mts = as.integer(mts), ss = as.integer(mts == 0), tolinv = as.double(tolInverse), solve = TRUE) } ##' Simple version, just checking (non)singularity conformance tstSubsampleSing <- function(X, y) { lX <- X[sample(nrow(X)), ] ## C version zc <- Rsubsample(lX, y) ## R version zR <- LU.gaxpy(t(lX)) if (as.logical(zc$status)) { ## singularity in C detected if (!zR$singular) stop("singularity in C but not in R") } else { ## no singularity detected if (zR$singular) stop("singularity in R but not in C") } zR$singular } ##' Sophisticated version tstSubsample <- function(x, y=rnorm(n), compareMatrix = TRUE, lu.tol = 1e-7, lu.verbose=FALSE, tolInverse = lu.tol, eq.tol = .Machine$double.eps^0.5) { x0 <- x <- as.matrix(x) n <- nrow(x) p <- ncol(x) if(p <= 1) stop("wrong 'x': need at least two columns for these tests") stopifnot(length(y) == n) z <- Rsubsample(x, y, tolInverse=tolInverse) ## ---------- ## convert idc, idr and p to 1-based indexing: idr <- z$idr + 1L idc <- z$idc[1:p] + 1L pivot <- z$pivot + 1L ## get L and U L <- U <- LU <- matrix(z$lu, p, p) L[upper.tri(L, diag=TRUE)] <- 0 diag(L) <- 1 U[lower.tri(U, diag=FALSE)] <- 0 ## test solved parameter if (z$status == 0) { stopifnot(all.equal(z$beta, unname(solve(x[idc, ], y[idc])), tol=eq.tol)) } if (z$rowequ) x <- diag(z$Dr) %*% x if (z$colequ) x <- x %*% diag(z$Dc) if (z$rowequ || z$colequ) cat(sprintf("kappa before equilibration = %g, after = %g\n", kappa(x0), kappa(x))) LU. <- LU.gaxpy(t(x), tol=lu.tol, verbose=lu.verbose) ## -------- if (!isTRUE(all.equal(LU.$p, pivot, tolerance=0))) { cat("LU.gaxpy() and Rsubsample() have different pivots:\n") print(LU.$p) print(pivot) cat(" ... are different at indices:\n ") print(which(LU.$p != pivot)) } else { stopifnot(all.equal(LU.$L, L, tol=eq.tol), all.equal(LU.$U, U, tol=eq.tol), LU.$p == pivot, ## only compare the indices selected before stopping LU.$idc[seq_along(LU.$p)] == idc[seq_along(pivot)]) } ## compare with Matrix result if (compareMatrix && z$status == 0) { xsub <- x[idc, ] stopifnot(require("Matrix")) tmp <- lu(t(xsub)) ## idx <- upper.tri(xsub, diag=TRUE) stopifnot(all.equal(tmp@x, as.vector(z$lu), tol=eq.tol)) } invisible(z) } robustbase/inst/xtraR/test_MCD.R0000644000176200001440000003057512436421036016300 0ustar liggesusers#### Utility functions for testing covMcd() #### -------------------------------------- ../tests/tmcd.R ## "workhorse" -- by default *passed* to and called from doMCDdata(): domcd1 <- function(x, xname, nrep = 1, ## These are all got from doMCDdata() [yuck!] method = get("method", parent.frame()), # compromise time = get("time", parent.frame()), # compromise short = get("short", parent.frame()), # compromise full = get("full", parent.frame()), # compromise lname = 20) { if(short && full) stop("you should not set both 'full' and 'short' to TRUE") force(xname)# => evaluate when it is a data(<>, ..) call n <- dim(x)[1] p <- dim(x)[2] if(method == "MASS") { mcd <- MASS::cov.mcd(x) mcd$quan <- (n + p + 1) %/% 2 #default: floor((n+p+1)/2) } else if(method == "DetMCD") { mcd <- covMcd(x, nsamp="deterministic") # trace = FALSE } else { mcd <- covMcd(x) # trace = FALSE } if(full) { header <- get("header", parent.frame()) header(time) } xres <- sprintf("%*s %3d %3d %3d %12.6f", lname, xname, n, p, mcd$quan, mcd$crit) if(time) { xtime <- system.time(repMCD(x, nrep, method))[1]/nrep xres <- sprintf("%s %10.1f", xres, 1000 * xtime) } cat(xres, "\n") if(!short) { cat("Best subsample: \n") print(mcd$best) ibad <- which(unname(mcd$mcd.wt) == 0) nbad <- length(ibad) cat("Outliers: ",nbad, if(nbad > 0)":", "\n") if(nbad > 0) print(ibad) if(full) { cat("------------- *MCD() result: --------------------------\n") print(mcd) } cat("--------------------------------------------------------\n") } }## {domcd1} ##' Test the function covMcd() on the literature datasets: ##' ##' Call covMcd() for "all" datasets in robustbase / rrcov and print: ##' - execution time (if time is true) ##' - objective function ##' - best subsample found (if short is false) ##' - outliers identified (with cutoff 0.975) (if short is false) ##' - estimated center and covarinance matrix if full is true) ##' ##' @param nrep : [integer] number of repetitions to use for estimating the ##' (average) execution time ##' @param method : [character] select a method: one of (FASTMCD, MASS) ##' @param time : [logical] whether to evaluate the execution time ##' @param short : [logical] whether to do short output (i.e. only the ##' objective function value). If short == FALSE, ##' the best subsample and the identified outliers are ##' printed. See also the parameter full below ##' @param full : [logical] whether to print the estimated cente and covariance matrix ##' @param digits ##' @param domcd workhorse function, to be called e.g. as ##' @examples domcd(starsCYG, data(starsCYG), nrep) ##' @author Valentin Todorov; tweaks by Martin Maechler ##' @note Is called from ../../demo/determinMCD.R and ../../tests/tmcd.R doMCDdata <- function(nrep = 1, method = c("FASTMCD", "MASS", "DetMCD"), time = nrep >= 3, short = time, full = !short, digits=5, domcd = domcd1) { stopifnot(is.function(domcd), length(formals(domcd)) >= 3) options(digits = digits) method <- match.arg(method) # *is* then accessed from domcd(.) stopifnot(require("robustbase")) # all data() which do not specify package data(Animals, package = "MASS") brain <- Animals[c(1:24, 26:25, 27:28),] data(list = c("fish", "pottery", "rice", "un86", "wages"), package = "rrcov") tmp <- sys.call() cat("\nCall: ", deparse(substitute(tmp)),"\n") header <- function(time) { ## the string length here require 'lname <- 20' {FIXME} ## 1 2 ## 1 3 5 7 901 3 5 7 90 2 4 cat("Data Set n p h(alf) LOG(obj)",if(time)" Time [ms]","\n", "=============================================",if(time)"===========","\n", sep="") } if(full) { ## header() is called in each domcd() } else ## here header(time) domcd(bushfire, data(bushfire), nrep) domcd(heart[, 1:2], data(heart), nrep) domcd(starsCYG, data(starsCYG), nrep) domcd(stack.x, data(stackloss), nrep) domcd(data.matrix(subset(phosphor, select= -plant)),data(phosphor), nrep) domcd(data.matrix(subset(coleman, select = -Y)), data(coleman), nrep) domcd(data.matrix(subset(salinity, select = -Y)), data(salinity), nrep) domcd(data.matrix(subset(wood, select = -y)), data(wood), nrep) domcd(data.matrix(subset(hbk, select = -Y)), data(hbk), nrep) domcd(brain, "Animals", nrep) domcd(milk, data(milk), nrep) domcd(lactic, data(lactic), nrep) domcd(pension, data(pension), nrep) domcd(pilot, data(pilot), nrep) ## This is for CovMcdBig .... ## domcd(radarImage, data(radarImage), nrep) ## domcd(NOxEmissions, data(NOxEmissions), nrep) domcd(data.matrix(subset(vaso, select = -Y)), data(vaso), nrep) domcd(data.matrix(subset(wagnerGrowth, select = -Period)), data(wagnerGrowth), nrep) ## Obs 14 has missing, column 7 is categorical domcd(fish[-14,-7], data(fish, package="rrcov"), nrep) domcd(pottery[,-7], data(pottery, package="rrcov"), nrep) domcd(rice, data(rice, package="rrcov"), nrep) domcd(un86, data(un86, package="rrcov"), nrep) ## there are missing values domcd(wages[-c(29, 31, 38),-9], data(wages, package="rrcov"), nrep) cat("========================================================\n") } ## {doMCDdata} if(FALSE){ data(mortality, package = "riv") mm <- as.data.frame(lapply(mortality, signif, 3)) for(j in c(1,2,6,7)) mm[,j] <- mm[,j] * 10 mm[,5] <- mm[,5] * 1000 mm[,8] <- mm[,8] / 100 mort3 <- mm dput(mort3) } ## which gives the equivalent of mort3 <- data.frame(MO70 = c(140, 101, 86, 102, 115, 121, 118, 76.6, 131, 112, 111, 112, 117, 118, 123, 122, 81.7, 108, 111, 109, 92.5, 83.9, 93.8, 135, 124, 126, 122, 120, 127, 115, 156, 95.1, 127, 129, 116, 82.3, 115, 106, 134, 94.9, 119, 111, 131, 85.6, 135, 126, 141, 152, 137, 151, 93.6, 84.2, 78, 50.2, 81.3, 112, 80.1, 125, 120, 143), MAGE = c(297, 277, 275, 268, 296, 327, 314, 258, 342, 278, 278, 313, 284, 272, 296, 277, 271, 296, 286, 250, 280, 270, 246, 301, 279, 287, 293, 271, 291, 295, 314, 267, 275, 307, 259, 251, 324, 285, 288, 254, 278, 287, 316, 287, 326, 309, 334, 369, 321, 311, 261, 272, 260, 244, 248, 277, 240, 295, 319, 346), CI68 = c(137, 137, 129, 129, 151, 157, 157, 157, 157, 202, 202, 202, 138, 160, 190, 191, 191, 191, 159, 159, 146, 146, 203, 203, 182, 166, 203, 203, 167, 167, 165, 153, 149, 149, 149, 157, 152, 183, 183, 183, 183, 183, 183, 111, 171, 148, 148, 148, 192, 160, 160, 172, 172, 172, 172, 101, 173, 173, 144, 181), MDOC = c(142, 80.4, 148, 167, 230, 187, 240, 149, 240, 195, 327, 377, 203, 160, 161, 68.7, 141, 120, 176, 105, 128, 112, 98.9, 160, 209, 200, 153, 126, 157, 157, 145, 160, 158, 102, 195, 188, 250, 143, 157, 186, 114, 129, 129, 143, 186, 207, 144, 112, 157, 121, 168, 155, 144, 144, 120, 194, 93.6, 231, 185, 89.7), DENS = c(37, 37, 27, 32, 17, 13, 23, 19, 27, 29, 15, 15, 48, 34, 26, 47, 17, 10, 10, 18, 11, 13, 26, 19, 55, 17, 16, 7, 10, 17, 44, 13, 18, 26, 40, 22, 29, 7, 28, 10, 15, 1, 11, 10, 8, 13, 13, 6, 10, 26, 49, 28, 32, 18, 62, 15, 21, 18, 10, 12), NONW = c(4.22, 3.36, 0.67, 0.52, 2.51, 0.82, 4.07, 1.11, 2.86, 2.92, 2.74, 1.05, 7.23, 5.16, 3.44, 2.84, 1.84, 1.47, 0.62, 0.03, 0.96, 1.07, 1.74, 2.41, 0.45, 4.7, 4.45, 1.2, 0.64, 2.28, 4.13, 1.06, 4.02, 2.22, 5.6, 0.43, 2.34, 1.78, 2.81, 1.9, 3.09, 1.43, 2.58, 1.34, 0.78, 3.44, 2.07, 0.68, 1, 3.6, 3.92, 2.58, 2.66, 0.05, 0.86, 0.32, 3.02, 4.24, 1.26, 1.08), EDUC = c(454, 516, 601, 631, 565, 620, 661, 653, 661, 591, 568, 499, 685, 534, 539, 536, 560, 542, 680, 546, 648, 632, 601, 469, 458, 446, 521, 540, 661, 601, 480, 627, 506, 363, 551, 662, 518, 556, 484, 607, 562, 517, 521, 582, 629, 506, 534, 433, 459, 476, 492, 548, 517, 517, 468, 685, 483, 471, 678, 528), IN69 = c(86.9, 99.3, 113, 99.2, 104, 118, 113, 117, 125, 100, 104, 115, 122, 107, 135, 101, 123, 114, 114, 113, 108, 109, 100, 99.8, 102, 100, 110, 112, 111, 113, 92.7, 116, 86.3, 103, 86.4, 109, 116, 112, 104, 108, 103, 116, 99.3, 116, 114, 104, 105, 97, 102, 83.4, 101, 125, 117, 118, 90.3, 108, 92.4, 106, 126, 109)) ###'------*Generate* data for benchmarking ---------------------------------------- ##' Generates a location contaminated multivariate ##' normal sample of n observations in p dimensions ##' (1-eps) * N_p(0, I_p) + eps * N_(m,I_p) ##' where ##' m = (b,b,...,b) ##' Defaults: eps=0 and b=10 ##' @title Generate n x p location contaminated MV data ##' @param n number of observations ##' @param p number of variables ##' @param eps amount of contamination ##' @param b mean of "outliers" gendata <- function(n,p, eps=0, b=10) { if(missing(n) || missing(p)) stop("Please specify (n,p)") if(!is.numeric(eps) || length(eps) != 1 || eps < 0 || eps >= 0.5) stop("eps must be in [0,0.5)") X <- matrix(rnorm(n*p), n, p) nbad <- as.integer(eps * n) if(nbad > 0) { b <- rep(b, length = p) # recycle to p-vector ## = E[.] of bad obs. xind <- sample(n,nbad) X[xind,] <- X[xind, , drop=FALSE] + rep(b, each=nbad) } list(X=X, xind=if(nbad > 0) xind) } ##' Repeated calls to different MCD algorithms for timing purposes *only* repMCD <- function(x, nrep = 1, method = "FASTMCD") { stopifnot(length(nrep) == 1, nrep >= 1) switch(method, "FASTMCD" = replicate(nrep, covMcd(x)), "bestMCD" = replicate(nrep, covMcd(x, nsamp= "best")), "exactMCD" = replicate(nrep, covMcd(x, nsamp= "exact")), "DetMCD" = replicate(nrep, covMcd(x, nsamp="deterministic")), "MASS.best" = replicate(nrep, MASS::cov.mcd(x)),# uses nsamp = "best" ==> up to 5000 ## rrcov.control()$nsamp == 500 : "MASS.500" = replicate(nrep, MASS::cov.mcd(x, nsamp = 500)), ## otherwise: stop(gettextf("Method '%s' not yet implemented", method))) } repMCD.meths <- function() { switch.expr <- body(repMCD)[[3]] m <- names(switch.expr) m[m != ""] } if(FALSE) repMCD.meths() ## [1] "FASTMCD" "bestMCD" "DetMCD" "MASS.best" "MASS.500" ##' calls gendata(), repMCD() dogen <- function(nrep=1, eps=0.49, method = repMCD.meths(), ## "FASTMCD" is first p.set = c(2, 5, 10, 20, 30), n.set = c(100, 500, 1000, 10000, 50000), n.p.ratio = 5, seed = 1234) { domcd <- function(x, nrep=1){ ## system.time() *does* gc() xtime <- system.time(repMCD(x, nrep, method))[1]/nrep cat(sprintf("%6d %3d %12.2f\n", dim(x)[1], dim(x)[2], xtime)) xtime } set.seed(seed) method <- match.arg(method) mkL <- function(ch,m) paste(ch,m,sep="=") ans <- matrix(NA, length(n.set), length(p.set), dimnames = list(mkL("n",n.set), mkL("p",p.set))) cat(sprintf("Method: %-12s; nrep = %d\n", method, nrep), "------------------------------\n", " n p Time\n", "=======================\n", sep="") for(n in n.set) { n. <- mkL("n",n) for(p in p.set) { if(n.p.ratio * p <= n) { xx <- gendata(n, p, eps) ans[n., mkL("p",p)] <- domcd(xx$X, nrep) } } } cat("=======================\n") cat(sprintf("Total time: %11.2f\n", nrep * sum(ans, na.rm=TRUE))) structure(ans, nrep = nrep, method=method) }## {dogen} ###' ------------------ These can only be used with rrcov :: CovMcd() -------------- docheck <- function(n, p, eps, ...) { xx <- gendata(n,p,eps) mcd <- CovMcd(xx$X, ...) check(mcd, xx$xind) } ##' check if mcd is robust w.r.t xind, i.e. check how many of xind ##' did not get zero weight check <- function(mcd, xind){ mymatch <- xind %in% which(mcd@wt == 0) length(xind) - length(which(mymatch)) } robustbase/inst/xtraR/platform-sessionInfo.R0000644000176200001440000001074113465050054020751 0ustar liggesusers## <---> sync with ~/R/Pkgs/CLA/inst/xtraR/platform-sessionInfo.R ## ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ##' return 'x' unless it is NULL where you'd use 'orElse' `%||%` <- function(x, orElse) if(!is.null(x)) x else orElse ##' not %in% : `%nin%` <- function (x, table) is.na(match(x, table)) ##' Derive more sessionInfo() like information, notably about BLAS, LAPACK, arithmetic, etc moreSessionInfo <- function(print. = FALSE) { .M <- .Machine if(print.) str(.M[grep("^sizeof", names(.M))]) ## differentiate long-double.. b64 <- .M$sizeof.pointer == 8 onWindows <- .Platform$OS.type == "windows" ## Do we have 64bit but no-long-double ? arch <- Sys.info()[["machine"]] b64nLD <- (arch == "x86_64" && .M$sizeof.longdouble != 16) if(b64nLD) arch <- paste0(arch, "--no-long-double") if(print.) cat(sprintf("%d bit platform type '%s' ==> onWindows: %s\narch: %s\n", if(b64) 64 else 32, .Platform$OS.type, onWindows, arch)) sInfo <- sessionInfo() if(!exists("osVersion")) osVersion <- sInfo$running if(print.) cat("osVersion (0):", osVersion, "\n") if(is.null(osVersion)) osVersion <- "Fedora" # very last resort if(!length(BLAS.is.LAPACK <- sInfo$BLAS == sInfo$LAPACK)) BLAS.is.LAPACK <- NA # R versions <= 3.3.x ## A cheap check (that works on KH's debian-gcc setup, 2019-05): if(!length(BLAS.is.openBLAS <- grepl("openblas", sInfo$BLAS, ignore.case=TRUE))) BLAS.is.openBLAS <- NA if(!length(Lapack.is.openBLAS <- grepl("openblas", sInfo$LAPACK, ignore.case=TRUE))) Lapack.is.openBLAS <- NA if(print.) cat("osVersion:", osVersion, "\n" ,'+ BLAS "is" Lapack:', BLAS.is.LAPACK , '| BLAS=OpenBLAS:', BLAS.is.openBLAS , '| Lapack=OpenBLAS:', Lapack.is.openBLAS , "\n") ## NB: sessionInfo() really gets these: if(getRversion() >= "3.4") local({ is.BLAS.LAPACK <- exists("La_library", mode="function") && ## R 3.4.0 and newer identical(La_library(), extSoftVersion()[["BLAS"]]) stopifnot(isTRUE(is.BLAS.LAPACK == BLAS.is.LAPACK)) }) ## also TRUE for Windows [since both are "" !!] ## Find out if we are running Micrsoft R Open is.MS.Ropen <- { file.exists(Rpr <- file.path(R.home("etc"), "Rprofile.site")) && length(lnsRpr <- readLines(Rpr)) && ## length(grep("[Mm]icrosoft", lnsRpr)) > 3 # MRO 3.5.1 has '20' times "[Mm]icrosoft" length(grep("Microsoft R Open", lnsRpr, fixed=TRUE, value=TRUE)) > 0 ## MRO 3.5.1 has it twice } if(print. && is.MS.Ropen) cat("We are running 'Microsoft R Open'\n") ## I'd really would want to know which of (OpenBLAS | ATLAS | MKL | R's own BLAS+LAPACK) ## ## Next best, I'd really like ## ## strictR <- we_are_using_Rs_own_BLAS_and_Lapack() [ ==> BLAS != Lapack ] ## ## Actually the following aims to be equivalent to {and *is* for MM on Fedora, 2019-03} ## strictR <- !(using ATLAS || OpenBLAS || MKL ) if(TRUE) { strictR <- !BLAS.is.LAPACK && !is.MS.Ropen && !BLAS.is.openBLAS && !Lapack.is.openBLAS && TRUE } else { ## workaround: strictR <- print(Sys.info()[["user"]]) == "maechler"# actually ## but not when testing with /usr/bin/R [OpenBLAS on Fedora!] (as "maechler"): if(strictR && substr(osVersion, 1,6) == "Fedora" && R.home() == "/usr/lib64/R") strictR <- FALSE } if(print.) cat("strictR:", strictR, "\n") structure(class = "moreSessionInfo", list( arch = arch , b64 = b64 # 64-bit (:<==> sizeof.pointer == 8 ) , b64nLD = b64nLD # 64-bit, but --no-long-double (sizeof.longdouble != 16) , BLAS.is.LAPACK = BLAS.is.LAPACK , BLAS.is.openBLAS = BLAS.is.openBLAS , Lapack.is.openBLAS = Lapack.is.openBLAS , is.MS.Ropen = is.MS.Ropen # is R a version of Microsoft R Open (==> MKL-linked BLAS) , onWindows = onWindows , osVersion = osVersion , strictR = strictR # are BLAS & Lapack from R's source, and "otherwise known safe platform" )) } if(getRversion() < "3.4.0") withAutoprint <- function(x, ...) x if(isTRUE(getOption("chk.moreSessionInfo"))) withAutoprint({ ms1 <- moreSessionInfo() ms. <- moreSessionInfo(print. = TRUE) stopifnot(is.list(ms1), length(ms1) > 1, identical(ms1, ms.) ) }) robustbase/inst/Copyrights0000644000176200001440000000243410353034413015455 0ustar liggesusersThe C code for Qn() and Sn(), src/qnsn.c is based on Fortran code that has been be available from http://www.agoras.ua.ac.be/ (Antwerp Group On Robust & Applied Statistics) (-> Programs -> Robust) by {at the time} Peter Rousseeuw (rousse@wins.uia.ac.be) Christophe Croux (croux@wins.uia.ac.be) Department of Mathematics and Computing Universitaire Instelling Antwerpen Universiteitsplein 1 B-2610 Wilrijk (Antwerp) Belgium and carries the note This file contains fortran functions for two new robust estimators of scale denoted as Qn and Sn, decribed in Rousseeuw and Croux (1993). These estimators have a high breakdown point and a bounded influence function. The implementation given here is very fast (running in O(n logn) time) and needs little storage space. Rousseeuw, P.J. and Croux, C. (1993) Alternatives to the Median Absolute Deviation", Journal of the American Statistical Association, Vol. 88, 1273-1283. This software may be used and copied freely for scientific and/or non-commercial purposes, provided reference is made to the above mentioned paper. where as Martin Maechler got explicit permission from P.Rousseeuw to licence it under the GNU Public Licence. ---------------------------------------------------------------------------- robustbase/inst/doc/0000755000176200001440000000000013465050176014154 5ustar liggesusersrobustbase/inst/doc/estimating.functions.R0000644000176200001440000005501012737461431020454 0ustar liggesusers## Called from ./lmrob_simulation.Rnw ## ~~~~~~~~~~~~~~~~~~~~~ ########################################################################### ## Prediction ########################################################################### f.predict <- function (object, newdata = NULL, scale = sigma(object), se.fit = FALSE, df = object$df.residual, interval = c('none', 'confidence', 'prediction'), level = 0.95, type = c('response'), terms = NULL, na.action = na.pass, pred.var = res.var/weights, weights = 1, cov = covariance.matrix(object), ...) { ## Purpose: replace predict.lmrob from robustbase package ## ---------------------------------------------------------------------- ## Arguments: See ?predict.lm ## type = 'presponse' ('term' is not supported) ## terms argument is ignored ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 6 Sept 2009, 12:16 ## take as much from predict.lm as possible ## check arguments if (!missing(terms)) stop('predict.lmrob: terms argument is ignored') ## set data tt <- terms(object) if (missing(newdata) || is.null(newdata)) { mm <- X <- model.matrix(object) mmDone <- TRUE offset <- object$offset } else { Terms <- delete.response(tt) m <- model.frame(Terms, newdata, na.action = na.action, xlev = object$xlevels) if (!is.null(cl <- attr(Terms, "dataClasses"))) .checkMFClasses(cl, m) X <- model.matrix(Terms, m, contrasts.arg = object$contrasts) offset <- rep(0, nrow(X)) if (!is.null(off.num <- attr(tt, "offset"))) for (i in off.num) offset <- offset + eval(attr(tt, "variables")[[i + 1]], newdata) if (!is.null(object$call$offset)) offset <- offset + eval(object$call$offset, newdata) mmDone <- FALSE } n <- length(object$residuals) p <- object$rank if (p < ncol(X) && !(missing(newdata) || is.null(newdata))) warning("prediction from a rank-deficient fit may be misleading") beta <- coef(object) ## ignoring piv here predictor <- drop(X %*% beta) if (!is.null(offset)) predictor <- predictor + offset interval <- match.arg(interval) type <- match.arg(type) if (se.fit || interval != "none") { res.var <- scale^2 if (type != "terms") { if (p > 0) { ## this is probably not optimal... ## cov <- covariance.matrix(object) ## set as argument ip <- diag(X %*% tcrossprod(cov, X)) } else ip <- rep(0, n) } } if (interval != "none") { tfrac <- qt((1 - level)/2, df) hwid <- tfrac * switch(interval, confidence = sqrt(ip), prediction = sqrt(ip + pred.var)) if (type != "terms") { predictor <- cbind(predictor, predictor + hwid %o% c(1, -1)) colnames(predictor) <- c("fit", "lwr", "upr") } } if (se.fit || interval != "none") se <- sqrt(ip) if (missing(newdata) && !is.null(na.act <- object$na.action)) { predictor <- napredict(na.act, predictor) if (se.fit) se <- napredict(na.act, se) } if (se.fit) list(fit = predictor, se.fit = se, df = df, residual.scale = sqrt(res.var)) else predictor } ## predict(obj, pred, interval = 'prediction') ## f.predict(obj, pred, interval = 'prediction') predict.lmRob <- function(object, newdata = NULL, scale = NULL, ...) { ## Purpose: extend predict() functionality to lmRob objects ## ---------------------------------------------------------------------- ## Arguments: ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 6 Sept 2009, 12:16 class(object) <- c(class(object), "lm") object$qr <- qr(sqrt(weights(object)) * model.matrix(object)) if (missing(scale)) scale <- object$scale predict.lm(object, newdata = newdata, scale = scale, ...) } ########################################################################### ## some helper functions ########################################################################### f.lmRob <- function(...) { ## Purpose: wrapper for lmRob ## ---------------------------------------------------------------------- ## Arguments: see ?lmRob ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 8 Oct 2009, 10:28 ## get arguments args <- list(...) ## update defaults: if (is.null(args$mxr)) args$mxr <- 2000 if (is.null(args$mxf)) args$mxf <- 500 if (is.null(args$mxs)) args$mxs <- 2000 ## get all arguments except the arguments of lmRob: uw <- c('formula', 'data', 'weights', 'subset', 'na.action', 'model', 'x', 'y', 'contrasts', 'nrep', 'genetic.control') ind <- if (is.null(names(args))) rep(FALSE, length(args)) else names(args) != '' & !names(args) %in% uw ## they go into control: control <- do.call("lmRob.control", args[ind]) ## now call lmRob do.call("lmRob", c(args[!ind], list(control = control))) } ## lmRob(y ~ x, d.data, control = lmRob.control(initial.alg = 'fast', efficiency = 0.95, weight = c('bisquare', 'bisquare'))) ## lmRob(y ~ x, d.data, initial.alg = 'fast', efficiency = 0.95, weight = c('bisquare', 'bisquare')) ## f.lmRob(y ~ x, d.data, initial.alg = 'fast', efficiency = 0.95, weight = c('bisquare', 'bisquare')) f.lmRob.S <- function(... , robust.control = lmRob.control()) { ## Purpose: call the S estimation procedure of lmRob ## ---------------------------------------------------------------------- ## Arguments: x: design matrix x ## y: vector of observations ## robust.control: control list of lmRob.control() ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 29 Oct 2009, 14:54 ## code: from lmRob.fit.compute, robust package version 0.3-9 robust.control$initial.alg = 'random' robust.control$estim = 'Initial' z <- lmRob(..., control = robust.control) class(z) <- 'lmrob.S' z } ## f.lmRob.S(rep(1,10), rnorm(10), lmRob.control(weight = c('bisquare', 'bisquare'))) f.eff2c.psi <- function(eff, weight='bisquare') { ## Purpose: convert lmRob efficiencies to c.psi ## ---------------------------------------------------------------------- ## Arguments: eff: lmRob efficiency ## weight: type of weight (weight argument in lmRob.control) ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 8 Oct 2009, 15:36 if(is.null(eff)) return(NULL) lw = casefold(weight) if (lw == 'bisquare') { if (eff == 0.95) 4.685061 else if (eff == 0.9) 3.882646 else if (eff == 0.85) 3.443689 else if (eff == 0.8) 3.136909 else NA } else if (lw == 'optimal') { if (eff == 0.95) 1.060158 else if (eff == 0.9) 0.9440982 else if (eff == 0.85) 0.8684 else if (eff == 0.8) 0.8097795 else NA } else NA } f.psi2c.chi <- function(weight) { ## Purpose: return lmRob defaults for c.chi ## ---------------------------------------------------------------------- ## Arguments: weight: type of weight ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 28 Jan 2010, 10:05 switch(weight, 'bisquare' = 1.5477, 'optimal' = 0.4047) } residuals.lmrob.S <- function(obj) obj$residuals robustness.weights <- function(x, ...) UseMethod("robustness.weights") ## Purpose: retrieve robustness weights from robust regression return ## object ## ---------------------------------------------------------------------- ## Arguments: obj: robust regression output object ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 6 Oct 2009, 13:42 robustness.weights.lmrob <- robustness.weights.default <- function(obj) naresid(obj$na.action, obj$w) robustness.weights.lm <- function(obj) { if (any(class(obj) %in% c('lmrob', 'f.lmrob'))) stop('Caution: returning incorrect weights') naresid(obj$na.action, rep(1, length(obj$resid))) } robustness.weights.rlm <- function(obj) naresid(obj$na.action, obj$w) robustness.weights.lmRob <- function(obj) { if (obj$robust.control$weight[2] != 'Optimal') { c.psi <- f.eff2c.psi(obj$robust.control$efficiency, obj$robust.control$weight[2]) rs <- obj$residuals / obj$scale obj$M.weights <- Mwgt(rs, c.psi, obj$robust.control$weight[2]) } naresid(obj$na.action, obj$M.weights) } ## t <- f.lmRob(y ~ x, d.data) ## t <- f.lmrob(y ~ x, d.data, method = 'SM') ## t <- f.lmRob(y ~ x, d.data, initial.alg = 'fast', efficiency = 0.95, weight = c('bisquare', 'bisquare')) ## t <- lmRob(y ~ x, d.data, control = lmRob.control(initial.alg = 'fast', efficiency = 0.95, weight = c('bisquare', 'bisquare'))) ## robustness.weights(t) robustness.weights.lmrob.S <- function(obj) { rstand <- resid(obj)/sigma(obj) Mwgt(rstand, obj$control$tuning.chi, obj$control$psi) } ## MM: Why on earth is this called covariance.matrix() ?? -- S and R standard is vcov() !! ## -- For lm, they are indeed identical; for lmrob, too ## HOWEVER, the *.rlm() method of cov..matrix() *differs* from vcov.rlm() -- why? covariance.matrix <- function(x, ...) UseMethod("covariance.matrix") ## Purpose: retrieve covariance matrix from robust regression return ## object ## ---------------------------------------------------------------------- ## Arguments: obj: robust regression output object ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 6 Oct 2009, 13:42 covariance.matrix.lmrob <- covariance.matrix.default <- function(obj) obj$cov covariance.matrix.rlm <- function(obj, method = 'XtWX') summary(obj, method)$cov covariance.matrix.lm <- function(obj) { s <- summary(obj) s$cov * s$sigma^2 } sigma <- function(x, ...) UseMethod("sigma") ## Purpose: retrieve scale estimate from robust regression return ## object ## ---------------------------------------------------------------------- ## Arguments: obj: robust regression output object ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 6 Oct 2009, 13:42 sigma.lmrob <- sigma.default <- function(obj) obj$scale sigma.lm <- function(obj) summary(obj)$sigma sigma.rlm <- function(obj) obj$s converged <- function(x, ...) UseMethod("converged") ## Purpose: check convergence status of return object ## ---------------------------------------------------------------------- ## Arguments: obj: robust regression output object ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 6 Oct 2009, 13:42 converged.default <- function(obj) is.list(obj) && !is.null(obj$converged) && obj$converged converged.lm <- function(obj) if (is.null(obj$converged)) TRUE else obj$converged converged.lmRob <- function(obj) is.list(obj) && !is.null(obj$est) && obj$est == 'final' ########################################################################### ## alternative estimation methods ########################################################################### lmrob.u <- function(formula, data, subset, weights, na.action, ..., start) { ## Purpose: update lmrob object if possible ## ---------------------------------------------------------------------- ## Arguments: (lmrob arguments) ## start: object to update ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 28 Jul 2010, 08:30 args <- as.list(match.call())[-1] args$start <- NULL if (!missing(start)) { ## if start is a string, get start from parent if (is.character(start)) start <- get(start, envir=parent.frame()) if (class(start) == 'lmrob') { ## check whether we can update start easily oldargs <- as.list(start$call)[-1] if (isTRUE(all.equal(args, oldargs))) return(start) else { ret <- start ## check method argument (ignore cov argument) if (is.null(oldargs$method)) oldargs$method <- start$control$method if (oldargs$method == 'MM') oldargs$method <- 'SM' if (is.null(args$method) || args$method == 'MM') args$method <- 'SM' rest.ok <- isTRUE(all.equal(oldargs[!names(oldargs) %in% c('method', 'cov')], args[!names(args) %in% c('method', 'cov')])) if (is.null(start$x)) stop('x matrix not found. Use lmrob(..., x = TRUE).') if (args$method != oldargs$method && rest.ok) { ## method is different, but the rest is the same oldsteps <- strsplit(oldargs$method, "")[[1]] steps <- strsplit(args $method, "")[[1]] ## reduce start to largest common initial estimator while(length(oldsteps) > length(steps) || any(oldsteps != steps[seq_along(oldsteps)])) { elems <- c('na.action', 'offset', 'contrasts', 'xlevels', 'terms', 'model', 'x', 'y', 'degree.freedom', 'df.residual', 'call') ret <- c(ret$init, start[elems[elems %in% names(ret)]]) class(ret) <- 'lmrob' oldsteps <- oldsteps[-length(oldsteps)] } ret$call$method <- args$method steps <- steps[- seq_along(oldsteps)] if (length(steps) > 0) { ret$cov <- NULL for (step in steps) { ret <- switch(step, D = lmrob..D..fit(ret), M = lmrob..M..fit(obj = ret), N = { y <- model.response(ret$model) ## taus are standardized because otherwise ## the resulting efficiency is lower tau <- ret$tau / mean(ret$tau) tmp <- lmrob..M..fit(x = ret$x/tau, y = y/tau, obj = ret) tmp$residuals <- y - ret$x %*% ret$coef tmp$qr <- NULL tmp }, stop("only M or D steps supported")) if (!ret$converged) { warning(step, "-step did NOT converge.") break } } } else { if (is.null(ret$qr)) ret$qr <- qr(ret$x * sqrt(ret$weights)) ret$rank <- ret$qr$rank } } ## update covariance matrix if (rest.ok) { if (is.null(args$cov)) args$cov <- lmrob.control(method=ret$control$method)$cov ret$cov <- vcov(ret, args$cov) ret$control$cov <- args$cov ret$call$cov <- args$cov return(ret) } } } } ## if we're here, update failed or there was no start cl <- match.call() cl$start <- NULL cl[[1]] <- as.symbol("lmrob") eval(cl, envir = parent.frame()) } ## lmrob.u <- function(formula, data, subset, weights, na.action, ..., start) ## { ## cl <- match.call() ## cl$start <- NULL ## cl[[1]] <- as.symbol("lmrob") ## eval(cl, envir = parent.frame()) ## ## do.call('lmrob', args, envir = parent.frame()) ## } ## set.seed(0); d.data <- data.frame(y = rnorm(10), x = 1:10) ## lres <- lmrob(y ~ x, d.data, method = 'SM', psi = 'lgw', cov = '.vcov.avar1') ## obj1 <- lmrob(y ~ x, d.data, method = 'SM', psi = 'lgw', cov = '.vcov.w') ## test <- lmrob.u(y ~ x, d.data, method = 'SM', psi = 'lgw', cov = '.vcov.w', ## start = 'lres') ## all.equal(obj1, test) ## obj2 <- lmrob(y ~ x, d.data, method = 'SMD', psi = 'lgw', cov = '.vcov.w') ## test <- lmrob.u(y ~ x, d.data, method = 'SMD', psi = 'lgw', ## start = 'lres') ## all.equal(obj2, test[names(obj2)], check.attr = FALSE) ## obj3 <- lmrob(y ~ x, d.data, method = 'SMDM', psi = 'lgw', cov = '.vcov.w') ## test <- lmrob.u(y ~ x, d.data, method = 'SMDM', psi = 'lgw', ## start = 'lres') ## all.equal(obj3, test[names(obj3)], check.attr = FALSE) ## test <- lmrob.u(y ~ x, d.data, method = 'SMDM', psi = 'lgw', ## start = 'obj2') ## all.equal(obj3, test[names(obj3)], check.attr = FALSE) ## test <- lmrob.u(y ~ x, d.data, method = 'SM', psi = 'lgw', cov = '.vcov.w', ## start = obj3) ## all.equal(obj1, test[names(obj1)], check.attr = FALSE) ##' Compute the MM-estimate with corrections qE or qT as in ##' Maronna, R. A., Yohai, V. J., 2010. ##' Correcting MM estimates for "fat" data sets. ##' Computational Statistics & Data Analysis 54 (12), 3168–3173. ##' @title MM-estimate with Maronna-Yohai(2010) corrections ##' @param formula ##' @param data ##' @param subset ##' @param weights ##' @param na.action ##' @param ... ##' @param type ##' @return ##' @author Manuel Koller lmrob.mar <- function(formula, data, subset, weights, na.action, ..., type = c("qE", "qT")) { ## get call and modify it so that ## lmrob returns the appropriate S-estimate cl <- match.call() method <- if (is.null(cl$method)) { if (!is.null(cl$control)) list(...)[["control"]]$method else 'MM' } else cl$method cl$type <- NULL cl$method <- 'S' cov <- if(!is.null(cl$cov)) cl$cov else '.vcov.w' cl$cov <- 'none' cl[[1]] <- as.symbol("lmrob") ## get S-estimate obj <- eval(cl, envir = parent.frame()) ## correct S-scale estimate according to formula n <- length(obj$resid) p <- obj$rank type <- match.arg(type) ## for type qE: adjust tuning.chi (h0) to account for different delta if (type == 'qE') { if (obj$control$psi != 'bisquare')## FIXME: "tukey" should work, too stop('lmrob.mar: type qE is only available for bisquare psi') h0 <- uniroot(function(c) robustbase:::lmrob.bp('bisquare', c) - (1-p/n)/2, c(1, 3))$root ## update scale obj$scale <- obj$scale * obj$control$tuning.chi / h0 obj$control$tuning.chi <- h0 } ## calculate q q <- switch(type, "qT" = { rs <- obj$resid / obj$scale ## \hat a = \mean \rho(r/sigma)^2 ## obj$control$tuning.chi == h_0 ahat <- mean(Mpsi(rs, obj$control$tuning.chi, obj$control$psi)^2) ## \hat b = \mean \rho''(r/sigma) bhat <- mean(Mpsi(rs, obj$control$tuning.chi, obj$control$psi, 1)) ## \hat c = \mean \rho'(r/sigma) * r/sigma chat <- mean(Mpsi(rs, obj$control$tuning.chi, obj$control$psi)*rs) ## qT: 1 + p*ahat/n/2/bhat/chat }, "qE" = 1 / (1 - (1.29 - 6.02/n)*p/n) , stop("unknown type ", type)) ## update scale obj$scale.uncorrected <- obj$scale obj$scale <- q * obj$scale ## add M step if requested if (method %in% c('MM', 'SM')) { obj$control$cov <- cov obj <- lmrob..M..fit(obj = obj) ## construct a proper lmrob object elems <- c('na.action', 'offset', 'contrasts', 'xlevels', 'terms', 'model', 'x', 'y') obj <- c(obj, obj$init.S[elems[elems %in% names(obj$init.S)]]) obj$degree.freedom <- obj$df.residual <- n - obj$rank } else if (method != 'S') stop("lmrob.mar: Only method = S, SM and MM supported.") ## update class class(obj) <- 'lmrob' ## return obj } ## summary(lmrob(y ~ x, d.data)) ## summary(lmrob.mar(y ~ x, d.data, type = 'qE')) ## summary(tmp <- lmrob.mar(y ~ x, d.data, type = 'qT')) ## this function calculates M-estimate of scale ## with constants as used for S-estimate with maximum breakdown point lmrob.mscale <- function(e, control, p = 0L) { ret <- .C("R_lmrob_S", x = as.double(e), ## this is ignored y = as.double(e), n = as.integer(length(e)), p = as.integer(p), ## divide the sum by n - p nResample = 0L, ## find scale only scale = as.double(mad(e)), coef = double(1), as.double(control$tuning.chi), as.integer(.psi2ipsi(control$psi)), as.double(control$bb), ## delta best_r = as.integer(control$best.r.s), groups = as.integer(control$groups), n.group = as.integer(control$n.group), k.fast.s = as.integer(control$k.fast.s), k.max = as.integer(control$k.max), maxit.scale = as.integer(control$maxit.scale), refine.tol = as.double(control$refine.tol), inv.tol = as.double(control$solve.tol), converged = logical(1), trace.lev = as.integer(0), mts = as.integer(control$mts), ss = robustbase:::.convSs(control$subsampling), fast.s.large.n = as.integer(length(e)+1), PACKAGE = 'robustbase') ret$scale } lmrob.dscale <- function(r, control, kappa = robustbase:::lmrob.kappa(control = control)) { tau <- rep.int(1, length(r)) w <- Mwgt(r, control$tuning.psi, control$psi) scale <- sqrt(sum(w * r^2) / kappa / sum(tau^2*w)) psi <- control$psi c.psi <- robustbase:::.psi.conv.cc(psi, control$tuning.psi) ret <- .C("R_find_D_scale", r = as.double(r), kappa = as.double(kappa), tau = as.double(tau), length = as.integer(length(r)), scale = as.double(scale), c = as.double(c.psi), ipsi = .psi2ipsi(psi), type = 3L, ## dt1 as only remaining option rel.tol = as.double(control$rel.tol), k.max = as.integer(control$k.max), converged = logical(1), PACKAGE = 'robustbase') ret$scale } ## sd.trim function by Gregor Gorjanc ## from http://ggorjan.blogspot.com/2008/11/trimmed-standard-deviation.html ## with added correction factor to be unbiased at the normal sd.trim <- function(x, trim=0, na.rm=FALSE, ...) { if(!is.numeric(x) && !is.complex(x) && !is.logical(x)) { warning("argument is not numeric or logical: returning NA") return(NA_real_) } if(na.rm) x <- x[!is.na(x)] if(!is.numeric(trim) || length(trim) != 1) stop("'trim' must be numeric of length one") n <- length(x) if(trim > 0 && n > 0) { if(is.complex(x)) stop("trimmed sd are not defined for complex data") if(trim >= 0.5) return(0) lo <- floor(n * trim) + 1 hi <- n + 1 - lo x <- sort.int(x, partial = unique(c(lo, hi)))[lo:hi] } corr <- if (0 < trim && trim < 0.5) { z <- qnorm(trim, lower.tail=FALSE)# = Phi^{-1}(1 - tr) sqrt(1 - 2/(1-2*trim) *z*dnorm(z)) } else 1 sd(x)/corr } robustbase/inst/doc/lmrob_simulation.Rnw0000644000176200001440000016440013312257746020233 0ustar liggesusers\documentclass[11pt, a4paper]{article} \usepackage[a4paper, text={16cm,25cm}]{geometry} %\VignetteIndexEntry{Simulations for Robust Regression Inference in Small Samples} %\VignetteDepends{robustbase, xtable, ggplot2,GGally, RColorBrewer, grid, reshape2} \usepackage{amsmath} \usepackage{natbib} \usepackage[utf8]{inputenc} \newcommand{\makeright}[2]{\ifx#1\left\right#2\else#1#2\fi} \newcommand{\Norm}[2][\left]{\mathcal N #1( #2 \makeright{#1}{)}} \newcommand{\norm}[1] {\| #1 \|} \newcommand{\bld}[1]{\boldsymbol{#1}} % shortcut for bold symbol \newcommand{\T}[1] {\texttt{#1}} \DeclareMathOperator{\wgt}{w} \DeclareMathOperator{\var}{var} \DeclareMathOperator{\diag}{diag} \DeclareMathOperator{\median}{median} \DeclareMathOperator{\mad}{mad} \DeclareMathOperator{\Erw}{\mathbf{E}} \SweaveOpts{prefix.string=plot, eps = FALSE, pdf = TRUE, strip.white=true} \SweaveOpts{width=6, height=4} \usepackage[noae]{Sweave} \begin{document} \setkeys{Gin}{width=\textwidth} \setlength{\abovecaptionskip}{-5pt} <>= ## set options options(width=60, warn=1) # see warnings where they happen (should eliminate) ## number of workers to start if(FALSE) {## good for pkg developers options(cores= max(1, parallel::detectCores() - 2)) } else { ## CRAN allows maximum of 2: options(cores= min(2, parallel::detectCores())) } ## Number of Repetitions: N <- 1000 ## get path (= ../inst/doc/ in source pkg) robustDoc <- system.file('doc', package='robustbase') robustDta <- robustDoc ## initialize (packages, data, ...): source(file.path(robustDoc, 'simulation.init.R')) # 'xtable' ## set the amount of trimming used in calculation of average results trim <- 0.1 <>= ## load required packages for graphics stopifnot(require(ggplot2), require(GGally),# for ggpairs() which replaces ggplot2::plotmatrix() require(grid), require(reshape2)) source(file.path(robustDoc, 'graphics.functions.R')) `%||%` <- function (x, orElse) if (!is.null(x)) x else orElse ## set ggplot theme theme <- theme_bw(base_size = 10) theme$legend.key.size <- unit(1, "lines")# was 0.9 in pre-v.3 ggplot2 theme$plot.margin <- unit(c(1/2, 1/8, 1/8, 1/8), "lines")# was (1/2, 0,0,0) theme_set(theme) ## old and new ggplot2: stopifnot(is.list(theme_G <- theme$panel.grid.major %||% theme$panel.grid)) ## set default sizes for lines and points update_geom_defaults("point", list(size = 4/3)) update_geom_defaults("line", list(size = 1/4)) update_geom_defaults("hline", list(size = 1/4)) update_geom_defaults("smooth", list(size = 1/4)) ## alpha value for plots with many points alpha.error <- 0.3 alpha.n <- 0.4 ## set truncation limits used by f.truncate() & g.truncate.*: trunc <- c(0.02, 0.14) trunc.plot <- c(0.0185, 0.155) f.truncate <- function(x, up = trunc.plot[2], low = trunc.plot[1]) { x[x > up] <- up x[x < low] <- low x } g.truncate.lines <- geom_hline(yintercept = trunc, color = theme$panel.border$colour) g.truncate.line <- geom_hline(yintercept = trunc[2], color = theme$panel.border$colour) g.truncate.areas <- annotate("rect", xmin=rep(-Inf,2), xmax=rep(Inf,2), ymin=c(0,Inf), ymax=trunc, fill = theme_G$colour) g.truncate.area <- annotate("rect", xmin=-Inf, xmax=Inf, ymin=trunc[2], ymax=Inf, fill = theme_G$colour) legend.mod <- list(`SMD.Wtau` = quote('SMD.W'~tau), `SMDM.Wtau` = quote('SMDM.W'~tau), `MM.Avar1` = quote('MM.'~Avar[1]), `MMqT` = quote('MM'~~q[T]), `MMqT.Wssc` = quote('MM'~~q[T]*'.Wssc'), `MMqE` = quote('MM'~~q[E]), `MMqE.Wssc` = quote('MM'~~q[E]*'.Wssc'), `sigma_S` = quote(hat(sigma)[S]), `sigma_D` = quote(hat(sigma)[D]), `sigma_S*qE` = quote(q[E]*hat(sigma)[S]), `sigma_S*qT` = quote(q[T]*hat(sigma)[S]), `sigma_robust` = quote(hat(sigma)[robust]), `sigma_OLS` = quote(hat(sigma)[OLS]), `t1` = quote(t[1]), `t3` = quote(t[3]), `t5` = quote(t[5]), `cskt(Inf,2)` = quote(cskt(infinity,2)) ) @% end{graphics-setup} \title{Simulations for Sharpening Wald-type Inference in Robust Regression for Small Samples} \author{Manuel Koller} \maketitle \tableofcontents \section{Introduction} In this vignette, we recreate the simulation study of \citet{KS2011}. This vignette is supposed to complement the results presented in the above cited reference and render its results reproducible. Another goal is to provide simulation functions, that, with small changes, could also be used for other simulation studies. Additionally, in Section~\ref{sec:maximum-asymptotic-bias}, we calculate the maximum asymptotic bias curves of the $\psi$-functions used in the simulation. \section{Setting} The simulation setting used here is similar to the one in \citet{maronna2009correcting}. We simulate $N = \Sexpr{N}$ repetitions. To repeat the simulation, we recommend using a small value of $N$ here, since for large $n$ and $p$, computing all the replicates will take days. \subsection{Methods} We compare the methods \begin{itemize} \item MM, SMD, SMDM as described in \citet{KS2011}. These methods are available in the package \T{robustbase} (\T{lmrob}). \item MM as implemented in the package \T{robust} (\T{lmRob}). This method will be denoted as \emph{MMrobust} later on. \item MM using S-scale correction by $q_{\rm T}$ and $q_{\rm E}$ as proposed by \citet{maronna2009correcting}. $q_{\rm T}$ and $q_{\rm E}$ are defined as follows. \begin{equation*} q_{\rm E} = \frac{1}{1 - (1.29 - 6.02/n)p/n}, \end{equation*} \begin{equation*} \hat q_{\rm T} = 1 + \frac{p}{2n}\frac{\hat a}{\hat b\hat c}, \end{equation*} where \begin{equation*} \hat a = \frac{1}{n}\sum_{i=1}^n \psi\left(\frac{r_i}{\hat\sigma_{\rm S}}\right)^2, \hat b = \frac{1}{n} \sum_{i=1}^n\psi'\left(\frac{r_i}{\hat\sigma_{\rm S}}\right),%' \hat c = \frac{1}{n}\sum_{i=1}^n \psi\left(\frac{r_i}{\hat\sigma_{\rm S}}\right) \frac{r_i}{\hat\sigma_{\rm S}}, \end{equation*} with $\psi = \rho'$,%' $n$ the number of observations, $p$ the number of predictor variables, $\hat\sigma_{\rm S}$ is the S-scale estimate and $r_i$ is the residual of the $i$-th observation. When using $q_{\rm E}$ it is necessary to adjust the tuning constants of $\chi$ to account for the dependence of $\kappa$ on $p$. For $q_{\rm T}$ no change is required. This method is implemented as \T{lmrob.mar()} in the source file \T{estimating.functions.R}. \end{itemize} \subsection{$\psi$-functions} We compare \emph{bisquare}, \emph{optimal}, \emph{lqq} and \emph{Hampel} $\psi$-functions. They are illustrated in Fig.~\ref{fig:psi.functions}. The tuning constants used in the simulation are compiled in Table~\ref{tab:psi-functions}. Note that the \emph{Hampel} $\psi$-function is tuned to have a downward slope of $-1/3$ instead of the originally proposed $-1/2$. This was set to allow for a comparison to an even slower descending $\psi$-function. %% generate table of tuning constants used for \psi functions \begin{table}[ht] \begin{center} <>= ## get list of psi functions lst <- lapply(estlist$procedures, function(x) { if (is.null(x$args)) return(list(NULL, NULL, NULL)) if (!is.null(x$args$weight)) return(list(x$args$weight[2], round(f.psi2c.chi(x$args$weight[1]),3), round(f.eff2c.psi(x$args$efficiency, x$args$weight[2]),3))) return(list(x$args$psi, round(if (is.null(x$args$tuning.chi)) lmrob.control(psi=x$args$psi)$tuning.chi else x$args$tuning.chi,3), round(if (is.null(x$args$tuning.psi)) lmrob.control(psi=x$args$psi)$tuning.psi else x$args$tuning.psi,3))) }) lst <- unique(lst) ## because of rounding, down from 21 to 5 ! lst <- lst[sapply(lst, function(x) !is.null(x[[1]]))] # 5 --> 4 ## convert to table tbl <- do.call(rbind, lst) tbl[,2:3] <- apply(tbl[,2:3], 1:2, function(x) { gsub('\\$NA\\$', '\\\\texttt{NA}', paste('$', unlist(x), collapse=', ', '$', sep='')) }) tbl[,1] <- paste('\\texttt{', tbl[,1], '}', sep='') colnames(tbl) <- paste('\\texttt{', c('psi', 'tuning.chi', 'tuning.psi'), '}', sep='') print(xtable(tbl), sanitize.text.function=identity, include.rownames = FALSE, floating=FALSE) @ %def \vspace{15pt} \caption{Tuning constants of $\psi$-functions used in the simulation.} \label{tab:psi-functions} \end{center} \end{table} \begin{figure} \begin{center} <>= d.x_psi <- function(x, psi) { cc <- lmrob.control(psi = psi)$tuning.psi data.frame(x=x, value=Mpsi(x, cc, psi), psi = psi) } x <- seq(0, 10, length.out = 1000) tmp <- rbind(d.x_psi(x, 'optimal'), d.x_psi(x, 'bisquare'), d.x_psi(x, 'lqq'), d.x_psi(x, 'hampel')) print( ggplot(tmp, aes(x, value, color = psi)) + geom_line(lwd=1.25) + ylab(quote(psi(x))) + scale_color_discrete(name = quote(psi ~ '-function'))) @ \end{center} \caption{$\psi$-functions used in the simulation.} \label{fig:psi.functions} \end{figure} \subsection{Designs} Two types of designs are used in the simulation: fixed and random designs. One design with $n=20$ observations, $p=1+3$ predictors and strong leverage points. This design also includes an intercept column. It is shown in Fig.~\ref{fig:design-predict}. The other designs are random, i.e., regenerated for every repetition, and the models are fitted without an intercept. We use the same distribution to generate the designs as for the errors. The number of observations simulated are $n = 25, 50, 100, 400$ and the ratio to the number of parameters are $p/n = 1/20, 1/10, 1/5, 1/3, 1/2$. We round $p$ to the nearest smaller integer if necessary. The random datasets are generated using the following code. <>= f.gen <- function(n, p, rep, err) { ## get function name and parameters lerrfun <- f.errname(err$err) lerrpar <- err$args ## generate random predictors ret <- replicate(rep, matrix(do.call(lerrfun, c(n = n*p, lerrpar)), n, p), simplify=FALSE) attr(ret[[1]], 'gen') <- f.gen ret } ratios <- c(1/20, 1/10, 1/5, 1/3, 1/2)## p/n lsit <- expand.grid(n = c(25, 50, 100, 400), p = ratios) lsit <- within(lsit, p <- as.integer(n*p)) .errs.normal.1 <- list(err = 'normal', args = list(mean = 0, sd = 1)) for (i in 1:NROW(lsit)) assign(paste('rand',lsit[i,1],lsit[i,2],sep='_'), f.gen(lsit[i,1], lsit[i,2], rep = 1, err = .errs.normal.1)[[1]]) @ An example design is shown in Fig.~\ref{fig:example.design}. \begin{figure} \begin{center} <>= require(GGally) colnames(rand_25_5) <- paste0("X", 1:5) # workaround new (2014-12) change in GGally ## and the 2016-11-* change needs data frames: df.r_25_5 <- as.data.frame(rand_25_5) try( ## fails with old GGally and new packageVersion("ggplot2") >= "2.2.1.9000" print(ggpairs(df.r_25_5, axisLabels="show", title = "rand_25_5: n=25, p=5")) ) @ \end{center} \caption{Example random design.} \label{fig:example.design} \end{figure} \subsection{Error Distributions} We simulate the following error distributions \begin{itemize} \item standard normal distribution, \item $t_5$, $t_3$, $t_1$, \item centered skewed t with $df = \infty, 5$ and $\gamma = 2$ (denoted by \emph{cskt$(\infty,2)$} and \emph{cskt}$(5,2)$, respectively); as introduced by \citet{fernandez1998bayesian} using the \T{R} package \T{skewt}, \item contaminated normal, $\Norm{0,1}$ contaminated with $10\%$ $\Norm{0, 10}$ (symmetric, \emph{cnorm}$(0.1,0,3.16)$) or $\Norm{4, 1}$ (asymmetric, \emph{cnorm}$(0.1,4,1)$). \end{itemize} \subsection{Covariance Matrix Estimators} For the standard MM estimator, we compare ${\rm Avar}_1$ of \citet{croux03} and the empirical weighted covariance matrix estimate corrected by Huber's small sample correction as described in \citet{HubPR09} (denoted by \emph{Wssc}). The latter is also used for the variation of the MM estimate proposed by \citet{maronna2009correcting}. For the SMD and SMDM variants we use the covariance matrix estimate as described in \citet{KS2011} (\emph{W$\tau$}). The covariance matrix estimate consists of three parts: \begin{equation*} {\rm cov}(\hat\beta) = \sigma^2\gamma\bld V_{\bld X}^{-1}. \end{equation*} The SMD and SMDM methods of \T{lmrob} use the following defaults. \begin{equation} \label{eq:gammatau} \hat\gamma = \frac{\frac{1}{n}\sum_{i=1}^n\tau_i^2 \psi\left(\frac{r_i}{\tau_i\hat\sigma}\right)^2} {\frac{1}{n}\sum_{i=1}^n\psi'\left(\frac{r_i}{\tau_i\hat\sigma}\right)} \end{equation} where $\tau_i$ is the rescaling factor used for the D-scale estimate (see \citet{KS2011}). \noindent\textbf{Remark: } Equation \eqref{eq:gammatau} is a corrected version of $\gamma$. It was changed in \texttt{robustbase} version \texttt{0.91} (April 2014) to ensure that the equation reduces to $1$ in the classical case ($\psi(x) = x$). If the former (incorrect) version is needed for compatibility reasons, it can be obtained by adding the argument \texttt{cov.corrfact = "tauold"}. \begin{equation*} \bld{\widehat V}_{\bld X} = \frac{1}{\frac{1}{n}\sum_{i=1}^n\wgt_{ii}}\bld X^T\bld W\bld X \end{equation*} where $\bld W = \diag\left(\wgt\left(\frac{r_1}{\hat\sigma}\right), \dots, \wgt\left(\frac{r_n}{\hat\sigma}\right)\right)$. The function $\wgt(r) = \psi(r)/r$ produces the robustness weights. \section{Simulation} The main loop of the simulation is fairly simple. (This code is only run if there are no aggregate results available.) %% set eval to TRUE for chunks simulation-run and simulation-aggr %% if you really want to run the simulations again. %% (better fail with an error than run for weeks) <>= aggrResultsFile <- file.path(robustDta, "aggr_results.Rdata") <>= if (!file.exists(aggrResultsFile)) { ## load packages required only for simulation stopifnot(require(robust), require(skewt), require(foreach)) if (!is.null(getOption("cores"))) { if (getOption("cores") == 1) registerDoSEQ() ## no not use parallel processing else { stopifnot(require(doParallel)) if (.Platform$OS.type == "windows") { cl <- makeCluster(getOption("cores")) clusterExport(cl, c("N", "robustDoc")) clusterEvalQ(cl, slave <- TRUE) clusterEvalQ(cl, source(file.path(robustDoc, 'simulation.init.R'))) registerDoParallel(cl) } else registerDoParallel() } } else registerDoSEQ() ## no not use parallel processing for (design in c("dd", ls(pattern = 'rand_\\d+_\\d+'))) { print(design) ## set design estlist$design <- get(design) estlist$use.intercept <- !grepl('^rand', design) ## add design.predict: pc estlist$design.predict <- if (is.null(attr(estlist$design, 'gen'))) f.prediction.points(estlist$design) else f.prediction.points(estlist$design, max.pc = 2) filename <- file.path(robustDta, sprintf('r.test.final.%s.Rdata',design)) if (!file.exists(filename)) { ## run print(system.time(r.test <- f.sim(estlist, silent = TRUE))) ## save save(r.test, file=filename) ## delete output rm(r.test) ## run garbage collection gc() } } } @ The variable \T{estlist} is a list containing all the necessary settings required to run the simulation as outlined above. Most of its elements are self-explanatory. <>= str(estlist, 1) @ \T{errs} is a list containing all the error distributions to be simulated. The entry for the standard normal looks as follows. <>= estlist$errs[[1]] @ \T{err} is translated internally to the corresponding random generation or quantile function, e.g., in this case \T{rnorm} or \T{qnorm}. \T{args} is a list containing all the required arguments to call the function. The errors are then generated internally with the following call. <>= set.seed(estlist$seed) errs <- c(sapply(1:nrep, function(x) do.call(fun, c(n = nobs, args)))) @ All required random numbers are generated at once instead of during the simulation. Like this, it is certain, that all the compared methods run on exactly the same data. The entry \T{procedures} follows a similar convention. \T{design.predict} contains the design used for the prediction of observations and calculation of confidence or prediction intervals. The objects returned by the procedures are processed by the functions contained in the \T{estlist\$output} list. <<>>= str(estlist$output[1:3], 2) @ The results are stored in a 4-dimensional array. The dimensions are: repetition number, type of value, procedure id, error id. Using \T{apply} it is very easy and fast to generate summary statistics. The raw results are stored on the hard disk, because typically it takes much longer to execute all the procedures than to calculate the summary statistics. The variables saved take up a lot of space quite quickly, so only the necessary data is stored. These are $\sigma$, $\bld\beta$ as well as the corresponding standard errors. To speed up the simulation routine \T{f.sim}, the simulations are carried out in parallel, as long as this is possible. This is accomplished with the help of the \T{R}-package \T{foreach}. This is most easily done on a machine with multiple processors or cores. The \T{multicore} package provides the methods to do so easily. The worker processes are just forked from the main \T{R} process. After all the methods have been simulated, the simulation output is processed. The code is quite lengthy and thus not displayed here (check the Sweave source file \T{lmrob\_simulation.Rnw}). The residuals, robustness weights, leverages and $\tau$ values have to be recalculated. Using vectorized operations and some specialized \T{C} code, this is quite cheap. The summary statistics generated are discussed in the next section. <>= if (!file.exists(aggrResultsFile)) { files <- list.files(robustDta, pattern = 'r.test.final\\.') res <- foreach(file = files) %dopar% { ## get design, load r.test, initialize other stuff design <- substr(basename(file), 14, nchar(basename(file)) - 6) cat(design, ' ') load(file.path(robustDta, file)) estlist <- attr(r.test, 'estlist') use.intercept <- if (!is.null(estlist$use.intercept)) estlist$use.intercept else TRUE sel <- dimnames(r.test)[[3]] ## [dimnames(r.test)[[3]] != "estname=lm"] n.betas <- paste('beta',1:(NCOL(estlist$design)+use.intercept),sep='_') ## get design lX <- if (use.intercept) as.matrix(cbind(1, get(design))) else as.matrix(get(design)) n <- NROW(lX) p <- NCOL(lX) ## prepare arrays for variable designs and leverages if (is.function(attr(estlist$design, 'gen'))) { lXs <- array(NA, c(n, NCOL(lX), dim(r.test)[c(1, 4)]), list(Obs = NULL, Pred = colnames(lX), Data = NULL, Errstr = dimnames(r.test)[[4]])) } ## generate errors lerrs <- array(NA, c(n, dim(r.test)[c(1,4)]) , list(Obs = NULL, Data = NULL, Errstr = dimnames(r.test)[[4]])) for (i in 1:dim(lerrs)[3]) { lerrstr <- f.list2str(estlist$errs[[i]]) lerr <- f.errs(estlist, estlist$errs[[i]], gen = attr(estlist$design, 'gen'), nobs = n, npar = NCOL(lX)) lerrs[,,lerrstr] <- lerr if (!is.null(attr(lerr, 'designs'))) { ## retrieve generated designs: this returns a list of designs lXs[,,,i] <- unlist(attr(lerr, 'designs')) if (use.intercept) stop('intercept not implemented for random desings') } rm(lerr) } if (is.function(attr(estlist$design, 'gen'))) { ## calculate leverages lXlevs <- apply(lXs, 3:4, .lmrob.hat) } ## calculate fitted values from betas if (!is.function(attr(estlist$design, 'gen'))) { ## fixed design case lfitted <- apply(r.test[,n.betas,sel,,drop=FALSE],c(3:4), function(bhat) { lX %*% t(bhat) } ) } else { ## variable design case lfitted <- array(NA, n*prod(dim(r.test)[c(1,4)])*length(sel)) lfitted <- .C('R_calc_fitted', as.double(lXs), ## designs as.double(r.test[,n.betas,sel,,drop=FALSE]), ## betas as.double(lfitted), ## result as.integer(n), ## n as.integer(p), ## p as.integer(dim(r.test)[1]), ## nrep as.integer(length(sel)), ## n procstr as.integer(dim(r.test)[4]), ## n errstr DUP=FALSE, NAOK=TRUE, PACKAGE="robustbase")[[3]] } tdim <- dim(lfitted) <- c(n, dim(r.test)[1], length(sel),dim(r.test)[4]) lfitted <- aperm(lfitted, c(1,2,4,3)) ## calculate residuals = y - fitted.values lfitted <- as.vector(lerrs) - as.vector(lfitted) dim(lfitted) <- tdim[c(1,2,4,3)] lfitted <- aperm(lfitted, c(1,2,4,3)) dimnames(lfitted) <- c(list(Obs = NULL), dimnames(r.test[,,sel,,drop=FALSE])[c(1,3,4)]) lresids <- lfitted rm(lfitted) ## calculate lm MSE and trim trimmed MSE of betas tf.MSE <- function(lbetas) { lnrm <- rowSums(lbetas^2) c(MSE=mean(lnrm,na.rm=TRUE),MSE.1=mean(lnrm,trim=trim,na.rm=TRUE)) } MSEs <- apply(r.test[,n.betas,,,drop=FALSE],3:4,tf.MSE) li <- 1 ## so we can reconstruct where we are lres <- apply(lresids,3:4,f.aggregate.results <- { function(lresid) { ## the counter li tells us, where we are ## we walk dimensions from left to right lcdn <- f.get.current.dimnames(li, dimnames(lresids), 3:4) lr <- r.test[,,lcdn[1],lcdn[2]] ## update counter li <<- li + 1 ## transpose and normalize residuals with sigma lresid <- t(lresid) / lr[,'sigma'] if (lcdn[1] != 'estname=lm') { ## convert procstr to proclst and get control list largs <- f.str2list(lcdn[1])[[1]]$args if (grepl('lm.robust', lcdn[1])) { lctrl <- list() lctrl$psi <- toupper(largs$weight2) lctrl$tuning.psi <- f.eff2c.psi(largs$efficiency, lctrl$psi) lctrl$method <- 'MM' } else { lctrl <- do.call('lmrob.control',largs) } ## calculate correction factors ## A lsp2 <- rowSums(Mpsi(lresid,lctrl$tuning.psi, lctrl$psi)^2) ## B lspp <- rowSums(lpp <- Mpsi(lresid,lctrl$tuning.psi, lctrl$psi,1)) ## calculate Huber\'s small sample correction factor lK <- 1 + rowSums((lpp - lspp/n)^2)*NCOL(lX)/lspp^2 ## 1/n cancels } else { lK <- lspp <- lsp2 <- NA } ## only calculate tau variants if possible if (grepl('args.method=\\w*(D|T)\\w*\\b', lcdn[1])) { ## SMD or SMDM ## calculate robustness weights lwgts <- Mwgt(lresid, lctrl$tuning.psi, lctrl$psi) ## function to calculate robustified leverages tfun <- if (is.function(attr(estlist$design, 'gen'))) function(i) { if (all(is.na(wi <- lwgts[i,]))) wi else .lmrob.hat(lXs[,,i,lcdn[2]],wi) } else function(i) { if (all(is.na(wi <- lwgts[i,]))) wi else .lmrob.hat(lX, wi) } llev <- sapply(1:dim(r.test)[1], tfun) ## calculate unique leverages lt <- robustbase:::lmrob.tau(list(),h=llev,control=lctrl) ## normalize residuals with tau (transpose lresid) lresid <- t(lresid) / lt ## A lsp2t <- colSums(Mpsi(lresid,lctrl$tuning.psi, lctrl$psi)^2) ## B lsppt <- colSums(Mpsi(lresid,lctrl$tuning.psi, lctrl$psi,1)) } else { lsp2t <- lsppt <- NA } ## calculate raw scales based on the errors lproc <- f.str2list(lcdn[1])[[1]] q <- NA M <- NA if (lproc$estname == 'lmrob.mar' && lproc$args$type == 'qE') { ## for lmrob_mar, qE variant lctrl <- lmrob.control(psi = 'bisquare', tuning.chi=uniroot(function(c) robustbase:::lmrob.bp('bisquare', c) - (1-p/n)/2, c(1, 3))$root) se <- apply(lerrs[,,lcdn[2]],2,lmrob.mscale,control=lctrl,p=p) ltmp <- se/lr[,'sigma'] q <- median(ltmp, na.rm = TRUE) M <- mad(ltmp, na.rm = TRUE) } else if (!is.null(lproc$args$method) && lproc$args$method == 'SMD') { ## for D-scales se <- apply(lerrs[,,lcdn[2]],2,lmrob.dscale,control=lctrl, kappa=robustbase:::lmrob.kappa(control=lctrl)) ltmp <- se/lr[,'sigma'] q <- median(ltmp, na.rm = TRUE) M <- mad(ltmp, na.rm = TRUE) } ## calculate empirical correct test value (to yield 5% level) t.val_2 <- t.val_1 <- quantile(abs(lr[,'beta_1']/lr[,'se_1']), 0.95, na.rm = TRUE) if (p > 1) t.val_2 <- quantile(abs(lr[,'beta_2']/lr[,'se_2']), 0.95, na.rm = TRUE) ## return output: summary statistics: c(## gamma AdB2.1 = mean(lsp2/lspp^2,trim=trim,na.rm=TRUE)*n, K2AdB2.1 = mean(lK^2*lsp2/lspp^2,trim=trim,na.rm=TRUE)*n, AdB2t.1 = mean(lsp2t/lsppt^2,trim=trim,na.rm=TRUE)*n, sdAdB2.1 = sd.trim(lsp2/lspp^2*n,trim=trim,na.rm=TRUE), sdK2AdB2.1 = sd.trim(lK^2*lsp2/lspp^2*n,trim=trim,na.rm=TRUE), sdAdB2t.1 = sd.trim(lsp2t/lsppt^2*n,trim=trim,na.rm=TRUE), ## sigma medsigma = median(lr[,'sigma'],na.rm=TRUE), madsigma = mad(lr[,'sigma'],na.rm=TRUE), meansigma.1 = mean(lr[,'sigma'],trim=trim,na.rm=TRUE), sdsigma.1 = sd.trim(lr[,'sigma'],trim=trim,na.rm=TRUE), meanlogsigma = mean(log(lr[,'sigma']),na.rm=TRUE), meanlogsigma.1 = mean(log(lr[,'sigma']),trim=trim,na.rm=TRUE), sdlogsigma = sd(log(lr[,'sigma']),na.rm=TRUE), sdlogsigma.1 = sd.trim(log(lr[,'sigma']),trim=trim,na.rm=TRUE), q = q, M = M, ## beta efficiency.1 = MSEs['MSE.1','estname=lm',lcdn[2]] / MSEs['MSE.1',lcdn[1],lcdn[2]], ## t-value: level emplev_1 = mean(abs(lr[,'beta_1']/lr[,'se_1']) > qt(0.975, n - p), na.rm = TRUE), emplev_2 = if (p>1) { mean(abs(lr[,'beta_2']/lr[,'se_2']) > qt(0.975, n - p), na.rm = TRUE) } else NA, ## t-value: power power_1_0.2 = mean(abs(lr[,'beta_1']-0.2)/lr[,'se_1'] > t.val_1, na.rm = TRUE), power_2_0.2 = if (p>1) { mean(abs(lr[,'beta_2']-0.2)/lr[,'se_2'] > t.val_2, na.rm = TRUE) } else NA, power_1_0.4 = mean(abs(lr[,'beta_1']-0.4)/lr[,'se_1'] > t.val_1, na.rm = TRUE), power_2_0.4 = if (p>1) { mean(abs(lr[,'beta_2']-0.4)/lr[,'se_2'] > t.val_2, na.rm = TRUE) } else NA, power_1_0.6 = mean(abs(lr[,'beta_1']-0.6)/lr[,'se_1'] > t.val_1, na.rm = TRUE), power_2_0.6 = if (p>1) { mean(abs(lr[,'beta_2']-0.6)/lr[,'se_2'] > t.val_2, na.rm = TRUE) } else NA, power_1_0.8 = mean(abs(lr[,'beta_1']-0.8)/lr[,'se_1'] > t.val_1, na.rm = TRUE), power_2_0.8 = if (p>1) { mean(abs(lr[,'beta_2']-0.8)/lr[,'se_2'] > t.val_2, na.rm = TRUE) } else NA, power_1_1 = mean(abs(lr[,'beta_1']-1)/lr[,'se_1'] > t.val_1, na.rm = TRUE), power_2_1 = if (p>1) { mean(abs(lr[,'beta_2']-1)/lr[,'se_2'] > t.val_2, na.rm = TRUE) } else NA, ## coverage probability: calculate empirically ## the evaluation points are constant, but the designs change ## therefore this makes only sense for fixed designs cpr_1 = mean(lr[,'upr_1'] < 0 | lr[,'lwr_1'] > 0, na.rm = TRUE), cpr_2 = mean(lr[,'upr_2'] < 0 | lr[,'lwr_2'] > 0, na.rm = TRUE), cpr_3 = mean(lr[,'upr_3'] < 0 | lr[,'lwr_3'] > 0, na.rm = TRUE), cpr_4 = mean(lr[,'upr_4'] < 0 | lr[,'lwr_4'] > 0, na.rm = TRUE), cpr_5 = if (any(colnames(lr) == 'upr_5')) { mean(lr[,'upr_5'] < 0 | lr[,'lwr_5'] > 0, na.rm = TRUE) } else NA, cpr_6 = if (any(colnames(lr) == 'upr_6')) { mean(lr[,'upr_6'] < 0 | lr[,'lwr_6'] > 0, na.rm = TRUE) } else NA, cpr_7 = if (any(colnames(lr) == 'upr_7')) { mean(lr[,'upr_7'] < 0 | lr[,'lwr_7'] > 0, na.rm = TRUE) } else NA ) }}) ## convert to data.frame lres <- f.a2df.2(lres, split = '___NO___') ## add additional info lres$n <- NROW(lX) lres$p <- NCOL(lX) lres$nmpdn <- with(lres, (n-p)/n) lres$Design <- design ## clean up rm(r.test, lXs, lXlevs, lresids, lerrs) gc() ## return lres lres } save(res, trim, file = aggrResultsFile) ## stop cluster if (exists("cl")) stopCluster(cl) } <>= load(aggrResultsFile) ## this will fail if the file is not found (for a reason) ## set eval to TRUE for chunks simulation-run and simulation-aggr ## if you really want to run the simulations again. ## (better fail with an error than run for weeks) ## combine list elements to data.frame test.1 <- do.call('rbind', res) test.1 <- within(test.1, { Method[Method == "SM"] <- "MM" Method <- Method[, drop = TRUE] Estimator <- interaction(Method, D.type, drop = TRUE) Estimator <- f.rename.level(Estimator, 'MM.S', 'MM') Estimator <- f.rename.level(Estimator, 'SMD.D', 'SMD') Estimator <- f.rename.level(Estimator, 'SMDM.D', 'SMDM') Estimator <- f.rename.level(Estimator, 'MM.qT', 'MMqT') Estimator <- f.rename.level(Estimator, 'MM.qE', 'MMqE') Estimator <- f.rename.level(Estimator, 'MM.rob', 'MMrobust') Estimator <- f.rename.level(Estimator, 'lsq.lm', 'OLS') Est.Scale <- f.rename.level(Estimator, 'MM', 'sigma_S') Est.Scale <- f.rename.level(Est.Scale, 'MMrobust', 'sigma_robust') Est.Scale <- f.rename.level(Est.Scale, 'MMqE', 'sigma_S*qE') Est.Scale <- f.rename.level(Est.Scale, 'MMqT', 'sigma_S*qT') Est.Scale <- f.rename.level(Est.Scale, 'SMDM', 'sigma_D') Est.Scale <- f.rename.level(Est.Scale, 'SMD', 'sigma_D') Est.Scale <- f.rename.level(Est.Scale, 'OLS', 'sigma_OLS') Psi <- f.rename.level(Psi, 'hampel', 'Hampel') }) ## add interaction of Method and Cov test.1 <- within(test.1, { method.cov <- interaction(Estimator, Cov, drop=TRUE) levels(method.cov) <- sub('\\.+vcov\\.(a?)[wacrv1]*', '\\1', levels(method.cov)) method.cov <- f.rename.level(method.cov, "MMa", "MM.Avar1") method.cov <- f.rename.level(method.cov, "MMrobust.Default", "MMrobust.Wssc") method.cov <- f.rename.level(method.cov, "MM", "MM.Wssc") method.cov <- f.rename.level(method.cov, "SMD", "SMD.Wtau") method.cov <- f.rename.level(method.cov, "SMDM", "SMDM.Wtau") method.cov <- f.rename.level(method.cov, "MMqT", "MMqT.Wssc") method.cov <- f.rename.level(method.cov, "MMqE", "MMqE.Wssc") method.cov <- f.rename.level(method.cov, "OLS.Default", "OLS") ## ratio: the closest 'desired ratios' instead of exact p/n; ## needed in plots only for stat_*(): median over "close" p/n's: ratio <- ratios[apply(abs(as.matrix(1/ratios) %*% t(as.matrix(p / n)) - 1), 2, which.min)] }) ## calculate expected values of psi^2 and psi' test.1$Ep2 <- test.1$Epp <- NA for(Procstr in levels(test.1$Procstr)) { args <- f.str2list(Procstr)[[1]]$args if (is.null(args)) next lctrl <- do.call('lmrob.control',args) test.1$Ep2[test.1$Procstr == Procstr] <- robustbase:::lmrob.E(psi(r)^2, lctrl, use.integrate = TRUE) test.1$Epp[test.1$Procstr == Procstr] <- robustbase:::lmrob.E(psi(r,1), lctrl, use.integrate = TRUE) } ## drop some observations, separate fixed and random designs test.fixed <- droplevels(subset(test.1, n == 20)) ## n = 20 -- fixed design test.1 <- droplevels(subset(test.1, n != 20)) ## n !=20 -- random designs test.lm <- droplevels(subset(test.1, Function == 'lm')) # lm = OLS test.1 <- droplevels(subset(test.1, Function != 'lm')) # Rob := all "robust" test.lm$Psi <- NULL test.lm.2 <- droplevels(subset(test.lm, Error == 'N(0,1)')) # OLS for N(*) test.2 <- droplevels(subset(test.1, Error == 'N(0,1)' & Function != 'lm'))# Rob for N(*) ## subsets test.3 <- droplevels(subset(test.2, Method != 'SMDM'))# Rob, not SMDM for N(*) test.4 <- droplevels(subset(test.1, Method != 'SMDM'))# Rob, not SMDM for all @ \section{Simulation Results} \subsection{Criteria} The simulated methods are compared using the following criteria. \textbf{Scale estimates.} The criteria for scale estimates are all calculated on the log-scale. The bias of the estimators is measured by the $\Sexpr{trim*100}\%$ trimmed mean. To recover a meaningful scale, the results are exponentiated before plotting. It is easy to see that this is equivalent to calculating geometric means. Since the methods are all tuned at the central model, ${\mathcal N}(0,1)$, a meaningful comparison of biases can only be made for ${\mathcal N}(0,1)$ distributed errors. The variability of the estimators, on the other hand, can be compared over all simulated error distributions. It is measured by the $\Sexpr{trim*100}\%$ trimmed standard deviation, rescaled by the square root of the number of observations. For completeness, the statistics used to compare scale estimates in \citet{maronna2009correcting} are also calculated. They are defined as \begin{equation} \label{eq:def.q.and.M} q = \median\left(\frac{S(\bld e)}{\hat\sigma_S}\right), \quad M = \mad\left(\frac{S(\bld e)}{\hat\sigma_S}\right), \end{equation} where $S(e)$ stands for the S-scale estimate evaluated for the actual errors $\bld e$. For the D-scale estimate, the definition is analogue. Since there is no design to correct for, we set $\tau_i = 1\ \forall i$. \textbf{Coefficients.} The efficiency of estimated regression coefficients $\bld{\hat\beta}$ is characterized by their mean squared error (\emph{MSE}). Since we simulate under $H_0: \bld\beta = 0$, this is determined by the covariance matrix of $\bld{\hat\beta}$. We use $\Erw\left[\norm{\bld{\hat\beta}}_2^2\right] = \sum_{j=1}^p \var(\hat\beta_j)$ as a summary. When comparing to the MSE of the ordinary least squares estimate (\emph{OLS}), this gives the efficiency, which, by the choice of tuning constants of $\psi$, should yield \begin{equation*} \frac{{\rm MSE}(\bld{\hat\beta}_{\rm OLS})}{{\rm MSE}(\bld{\hat\beta})} \approx 0.95 \end{equation*} for standard normally distributed errors. The simulation mean of $\sum_{j=1}^p \var(\hat\beta_j)$ is calculated with $\Sexpr{trim*100}\%$ trimming. For other error distributions, this ratio should be larger than $1$, since by using robust procedures we expect to gain efficiency at other error distributions (relative to the least squares estimate). $\bld\gamma$\textbf{.} We compare the behavior of the various estimators of $\gamma$ by calculating the trimmed mean and the trimmed standard deviation for standard normal distributed errors. \textbf{Covariance matrix estimate.} The covariance matrix estimates are compared indirectly over the performance of the resulting test statistics. We compare the empirical level of the hypothesis tests $H_0: \beta_j = 0$ for some $j \in \{1,\dots, p\}$. The power of the tests is compared by testing for $H_0: \beta_j = b$ for several values of $b>0$. The formal power of a more liberal test is generally higher. Therefore, in order for this comparison to be meaningful, the critical value for each test statistic was corrected such that all tests have the same simulated level of $5\%$. The simple hypothesis tests give only limited insights. To investigate the effects of other error distributions, e.g., asymmetric error distributions, we compare the confidence intervals for the prediction of some fixed points. Since it was not clear how to assess the quality prediction intervals, either at the central or the simulated model, we do not calculate them here. A small number of prediction points is already enough, if they are chosen properly. We chose to use seven points lying on the first two principal components, spaced evenly from the center of the design used to the extended range of the design. The principal components were calculated robustly (using \T{covMcd} of the \T{robustbase} package) and the range was extended by a fraction of $0.5$. An example is shown in Figure~\ref{fig:design-predict}. \subsection{Results} The results are given here as plots (Fig.~\ref{fig:meanscale-1} to Fig.~\ref{fig:cpr}). For a complete discussion of the results, we refer to \citet{KS2011}. The different $\psi$-functions are each plotted in a different facet, except for Fig.~\ref{fig:qscale-all}, Fig.~\ref{fig:Mscale-all} and Fig.~\ref{fig:lqq-level}, where the facets show the results for various error distributions. The plots are augmented with auxiliary lines to ease the comparison of the methods. The lines connect the median values over the values of $n$ for each simulated ratio $p/n$. In many plots the y-axis has been truncated. Points in the grey shaded area represent truncated values using a different scale. \begin{figure} \begin{center} <>= ## ## exp(mean(log(sigma))): this looks almost identical to mean(sigma) print(ggplot(test.3, aes(p/n, exp(meanlogsigma.1), color = Est.Scale)) + stat_summary(aes(x=ratio), # <- "rounded p/n": --> median over "neighborhood" fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + geom_hline(yintercept = 1) + g.scale_y_log10_1() + facet_wrap(~ Psi) + ylab(quote('geometric ' ~ mean(hat(sigma)))) + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels=lab(test.3$Est.Scale))) @ \end{center} \caption{Mean of scale estimates for normal errors. The mean is calculated with $\Sexpr{trim*100}\%$ trimming. The lines connect the median values for each simulated ratio $p/n$. Results for random designs only. } \label{fig:meanscale-1} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(test.3, aes(p/n, sdlogsigma.1*sqrt(n), color = Est.Scale)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + ylab(quote(sd(log(hat(sigma)))*sqrt(n))) + facet_wrap(~ Psi) + geom_point (data=test.lm.2, alpha=alpha.n, aes(color = Est.Scale)) + stat_summary(data=test.lm.2, aes(x=ratio, color = Est.Scale), fun.y=median, geom='line') + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels= lab(test.3 $Est.Scale, test.lm.2$Est.Scale))) @ \end{center} \caption{Variability of the scale estimates for normal errors. The standard deviation is calculated with $\Sexpr{trim*100}\%$ trimming. } \label{fig:sdscale-1} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(test.4, aes(p/n, sdlogsigma.1*sqrt(n), color = Est.Scale)) + ylim(with(test.4, range(sdlogsigma.1*sqrt(n)))) + ylab(quote(sd(log(hat(sigma)))*sqrt(n))) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = Error), alpha = alpha.error) + facet_wrap(~ Psi) + ## "FIXME" (?): the next 'test.lm' one give warnings geom_point (data=test.lm, aes(color = Est.Scale), alpha=alpha.n) + ##-> Warning: Removed 108 rows containing missing values (geom_point). stat_summary(data=test.lm, aes(x = ratio, color = Est.Scale), fun.y=median, geom='line') + ##-> Warning: Removed 108 rows containing non-finite values (stat_summary). g.scale_shape(labels=lab(test.4$Error)) + scale_colour_discrete("Scale Est.", labels=lab(test.4 $Est.Scale, test.lm$Est.Scale))) @ \end{center} \caption{Variability of the scale estimates for all simulated error distributions.} \label{fig:sdscale-all} \end{figure} \begin{figure} \begin{center} <>= t3est2 <- droplevels(subset(test.3, Estimator %in% c("SMD", "MMqE"))) print(ggplot(t3est2, aes(p/n, q, color = Est.Scale)) + ylab(quote(q)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + geom_hline(yintercept = 1) + g.scale_y_log10_1() + facet_wrap(~ Psi) + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels=lab(t3est2$Est.Scale))) @ \end{center} \caption{$q$ statistic for normal errors. $q$ is defined in \eqref{eq:def.q.and.M}.} \label{fig:qscale-1} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(t3est2, aes(p/n, M/q, color = Est.Scale)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + g.scale_y_log10_0.05() + facet_wrap(~ Psi) + ylab(quote(M/q)) + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels=lab(t3est2$Est.Scale))) @ \end{center} \caption{$M/q$ statistic for normal errors. $M$ and $q$ are defined in \eqref{eq:def.q.and.M}.} \label{fig:Mscale-1} \end{figure} \begin{figure} \begin{center} <>= t1.bi <- droplevels(subset(test.1, Estimator %in% c("SMD", "MMqE") & Psi == 'bisquare')) print(ggplot(t1.bi, aes(p/n, q, color = Est.Scale)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + geom_hline(yintercept = 1) + g.scale_y_log10_1() + facet_wrap(~ Error) + ## labeller missing! ylab(quote(q)) + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels=lab(tmp$Est.Scale)), legend.mod = legend.mod) @ \end{center} \caption{$q$ statistic for \emph{bisquare} $\psi$. } \label{fig:qscale-all} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(t1.bi, aes(p/n, M/q, color = Est.Scale)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + g.scale_y_log10_0.05() + facet_wrap(~ Error) + ylab(quote(M/q)) + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels=lab(tmp$Est.Scale)), legend.mod = legend.mod) @ \end{center} \caption{$M/q$ statistic for \emph{bisquare} $\psi$. } \label{fig:Mscale-all} \end{figure} \clearpage% not nice, but needed against LaTeX Error: Too many unprocessed floats. \begin{figure} \begin{center} <>= print(ggplot(test.2, aes(p/n, efficiency.1, color = Estimator)) + geom_point(aes(shape = factor(n)), alpha = alpha.n) + geom_hline(yintercept = 0.95) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + facet_wrap(~ Psi) + ylab(quote('efficiency of' ~~ hat(beta))) + g.scale_shape(quote(n)) + scale_colour_discrete(name = "Estimator", labels = lab(test.2$Estimator))) @ \end{center} \caption{Efficiency for normal errors. The efficiency is calculated by comparing to an OLS estimate and averaging with $\Sexpr{trim*100}\%$ trimming. } \label{fig:efficiency} \end{figure} \begin{figure} \begin{center} <>= t.1xt1 <- droplevels(subset(test.1, Error != 't1')) print(ggplot(t.1xt1, aes(p/n, efficiency.1, color = Estimator)) + ylab(quote('efficiency of '~hat(beta))) + geom_point(aes(shape = Error), alpha = alpha.error) + geom_hline(yintercept = 0.95) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + g.scale_shape(values=c(16,17,15,3,7,8,9,1,2,4)[-4], labels=lab(t.1xt1$Error)) + facet_wrap(~ Psi) + scale_colour_discrete(name = "Estimator", labels = lab(t.1xt1$Estimator))) @ \end{center} \caption{Efficiency for all simulated error distributions except $t_1$. } \label{fig:efficiency-all} \end{figure} \begin{figure} \begin{center} <>= t.2o. <- droplevels(subset(test.2, !is.na(AdB2t.1))) print(ggplot(t.2o., aes(p/n, AdB2.1/(1-p/n), color = Estimator)) + geom_point(aes(shape=factor(n)), alpha = alpha.n) + geom_point(aes(y=K2AdB2.1/(1-p/n)), alpha = alpha.n) + geom_point(aes(y=AdB2t.1), alpha = alpha.n) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + stat_summary(aes(x=ratio, y=K2AdB2.1/(1-p/n)), fun.y=median, geom='line', linetype=2) + stat_summary(aes(x=ratio, y=AdB2t.1), fun.y=median, geom='line', linetype=3) + geom_hline(yintercept = 1/0.95) + g.scale_y_log10_1() + scale_shape_discrete(quote(n)) + scale_colour_discrete(name = "Estimator", labels = lab(t.2o.$Estimator)) + ylab(quote(mean(hat(gamma)))) + facet_wrap(~ Psi)) @ \end{center} \caption{Comparing the estimates of $\gamma$. The solid line connects the uncorrected estimate, dotted the $\tau$ corrected estimate and dashed Huber's small sample correction. } \label{fig:AdB2-1} \end{figure} \begin{figure} \begin{center} <>= t.2ok <- droplevels(subset(test.2, !is.na(sdAdB2t.1))) print(ggplot(t.2ok, aes(p/n, sdAdB2.1/(1-p/n), color = Estimator)) + geom_point(aes(shape=factor(n)), alpha = alpha.n) + geom_point(aes(y=sdK2AdB2.1/(1-p/n)), alpha = alpha.n) + geom_point(aes(y=sdAdB2t.1), alpha = alpha.n) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + stat_summary(aes(x=ratio, y=sdK2AdB2.1/(1-p/n)), fun.y=median, geom='line', linetype= 2) + stat_summary(aes(x=ratio, y=sdAdB2t.1), fun.y=median, geom='line', linetype= 3) + g.scale_y_log10_0.05() + scale_shape_discrete(quote(n)) + scale_colour_discrete(name = "Estimator", labels=lab(t.2ok$Estimator)) + ylab(quote(sd(hat(gamma)))) + facet_wrap(~ Psi)) @ \end{center} \caption{Comparing the estimates of $\gamma$. The solid line connects the uncorrected estimate, dotted the $\tau$ corrected estimate and dashed Huber's small sample correction. } \label{fig:sdAdB2-1} \end{figure} \begin{figure} \begin{center} <>= t.2en0 <- droplevels(subset(test.2, emplev_1 != 0)) print(ggplot(t.2en0, aes(p/n, f.truncate(emplev_1), color = method.cov)) + g.truncate.lines + g.truncate.areas + geom_point(aes(shape = factor(n)), alpha = alpha.n) + scale_shape_discrete(quote(n)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_hline(yintercept = 0.05) + g.scale_y_log10_0.05() + scale_colour_discrete(name = "Estimator", labels=lab(t.2en0$method.cov)) + ylab(quote("empirical level "~ list (H[0] : beta[1] == 0) )) + facet_wrap(~ Psi)) @ \end{center} \caption{Empirical levels of test $H_0: \beta_1 = 0$ for normal errors. The y-values are truncated at $\Sexpr{trunc[1]}$ and $\Sexpr{trunc[2]}$. } \label{fig:emp-level} \end{figure} \begin{figure} \begin{center} <>= tmp <- droplevels(subset(test.1, Psi == 'lqq' & emplev_1 != 0)) print(ggplot(tmp, aes(p/n, f.truncate(emplev_1), color = method.cov)) + ylab(quote("empirical level "~ list (H[0] : beta[1] == 0) )) + g.truncate.line + g.truncate.area + geom_point(aes(shape = factor(n)), alpha = alpha.n) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_hline(yintercept = 0.05) + g.scale_y_log10_0.05() + g.scale_shape(quote(n)) + scale_colour_discrete(name = "Estimator", labels=lab(tmp$method.cov)) + facet_wrap(~ Error) , legend.mod = legend.mod ) @ \end{center} \caption{Empirical levels of test $H_0: \beta_1 = 0$ for \emph{lqq} $\psi$-function and different error distributions. } \label{fig:lqq-level} \end{figure} \begin{figure} \begin{center} <>= t2.25 <- droplevels(subset(test.2, n == 25))# <-- fixed n ==> no need for 'ratio' tL2.25 <- droplevels(subset(test.lm.2, n == 25)) scale_col_D2.25 <- scale_colour_discrete(name = "Estimator (Cov. Est.)", labels=lab(t2.25 $method.cov, tL2.25$method.cov)) print(ggplot(t2.25, aes(p/n, power_1_0.2, color = method.cov)) + ylab(quote("empirical power "~ list (H[0] : beta[1] == 0.2) )) + geom_point(# aes(shape = Error), alpha = alpha.error) + stat_summary(fun.y=median, geom='line') + geom_point (data=tL2.25, alpha = alpha.n) + stat_summary(data=tL2.25, fun.y=median, geom='line') + ## g.scale_shape("Error", labels=lab(t2.25$Error)) + scale_col_D2.25 + facet_wrap(~ Psi) ) @ \end{center} \caption{Empirical power of test $H_0: \beta_1 = 0.2$ for different $\psi$-functions. Results for $n = 25$ and normal errors only. } \label{fig:power-1-0_2} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(t2.25, aes(p/n, power_1_0.4, color = method.cov)) + ylab(quote("empirical power "~ list (H[0] : beta[1] == 0.4) )) + geom_point(alpha = alpha.error) + stat_summary(fun.y=median, geom='line') + geom_point (data=tL2.25, alpha = alpha.n) + stat_summary(data=tL2.25, fun.y=median, geom='line') + ## g.scale_shape("Error", labels=lab(t2.25$Error)) + scale_col_D2.25 + facet_wrap(~ Psi) ) @ \end{center} \caption{Empirical power of test $H_0: \beta_1 = 0.4$ for different $\psi$-functions. Results for $n = 25$ and normal errors only. } \label{fig:power-1-0_4} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(t2.25, aes(p/n, power_1_0.6, color = method.cov)) + ylab(quote("empirical power "~ list (H[0] : beta[1] == 0.6) )) + geom_point(# aes(shape = Error), alpha = alpha.error) + stat_summary(fun.y=median, geom='line') + geom_point (data=tL2.25, alpha = alpha.n) + stat_summary(data=tL2.25, fun.y=median, geom='line') + scale_col_D2.25 + facet_wrap(~ Psi) ) @ \end{center} \caption{Empirical power of test $H_0: \beta_1 = 0.6$ for different $\psi$-functions. Results for $n = 25$ and normal errors only. } \label{fig:power-1-0_6} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(t2.25, aes(p/n, power_1_0.8, color = method.cov)) + ylab(quote("empirical power "~ list (H[0] : beta[1] == 0.8) )) + geom_point(alpha = alpha.error) + stat_summary(fun.y=median, geom='line') + geom_point (data=tL2.25, alpha = alpha.n) + stat_summary(data=tL2.25, fun.y=median, geom='line') + g.scale_shape("Error", labels=lab(t2.25$Error)) + scale_col_D2.25 + facet_wrap(~ Psi) ) @ \end{center} \caption{Empirical power of test $H_0: \beta_1 = 0.8$ for different $\psi$-functions. Results for $n = 25$ and normal errors only. } \label{fig:power-1-0_8} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(t2.25, aes(p/n, power_1_1, color = method.cov)) + ylab(quote("empirical power "~ list (H[0] : beta[1] == 1) )) + geom_point(alpha = alpha.error) + stat_summary(fun.y=median, geom='line') + geom_point (data=tL2.25, alpha = alpha.n) + stat_summary(data=tL2.25, fun.y=median, geom='line') + ## g.scale_shape("Error", labels=lab(t2.25$Error)) + scale_col_D2.25 + facet_wrap(~ Psi) ) @ \end{center} \caption{Empirical power of test $H_0: \beta_1 = 1$ for different $\psi$-functions. Results for $n = 25$ and normal errors only. } \label{fig:power-1-1} \end{figure} %\clearpage \begin{figure} \begin{center} %% now (2016-11 GGally) works --- but fails with new 2018-05 ggplot2: <>= pp <- f.prediction.points(dd)[1:7,] ## Worked in older ggplot2 -- now plotmatrix() is gone, to be replaced by GGally::ggpairs): ## tmp <- plotmatrix(pp)$data ## tmp$label <- as.character(1:7) ## print(plotmatrix(dd) + geom_text(data=tmp, color = 2, aes(label=label), size = 2.5)) if(FALSE) { tmp <- ggpairs(pp)$data tmp$label <- as.character(1:7) # and now? } ## ggpairs() + geom_text() does *NOT* work {ggpairs has own class} ## print(ggpairs(dd) + geom_text(data=tmp, color = 2, aes(label=label), size = 2.5)) try( ## fails with old GGally and new packageVersion("ggplot2") >= "2.2.1.9000" print( ggpairs(dd) )## now (2016-11) fine ) @ \end{center} \caption{Prediction points for fixed design. The black points are the points of the original design. The red digits indicate the numbers and locations of the points where predictions are taken.} \label{fig:design-predict} \end{figure} \begin{figure} \begin{center} <>= n.cprs <- names(test.fixed)[grep('cpr', names(test.fixed))] # test.fixed: n=20 => no 'x=ratio' test.5 <- melt(test.fixed[,c('method.cov', 'Error', 'Psi', n.cprs)]) test.5 <- within(test.5, { Point <- as.numeric(do.call('rbind', strsplit(levels(variable), '_'))[,2])[variable] }) print(ggplot(test.5, aes(Point, f.truncate(value), color = method.cov)) + geom_point(aes(shape = Error), alpha = alpha.error) + g.truncate.line + g.truncate.area + stat_summary(fun.y=median, geom='line') + geom_hline(yintercept = 0.05) + g.scale_y_log10_0.05() + g.scale_shape(labels=lab(test.5$Error)) + scale_colour_discrete(name = "Estimator (Cov. Est.)", labels=lab(test.5$method.cov)) + ylab("empirical level of confidence intervals") + facet_wrap(~ Psi) ) @ \end{center} \caption{Empirical coverage probabilities. Results for fixed design. The y-values are truncated at $\Sexpr{trunc[2]}$. } \label{fig:cpr} \end{figure} \clearpage \section{Maximum Asymptotic Bias} \label{sec:maximum-asymptotic-bias} The slower redescending $\psi$-functions come with higher asymptotic bias as illustrated in Fig.~\ref{fig:max-asymptotic-bias}. We calculate the asymptotic bias as in \citet{berrendero2007maximum}. <>= ## Henning (1994) eq 33: g <- Vectorize(function(s, theta, mu, ...) { lctrl <- lmrob.control(...) rho <- function(x) Mchi(x, lctrl$tuning.chi, lctrl$psi, deriv = 0) integrate(function(x) rho(((1 + theta^2)/s^2*x)^2)*dchisq(x, 1, mu^2/(1 + theta^2)), -Inf, Inf)$value }) ## Martin et al 1989 Section 3.2: for mu = 0 g.2 <- Vectorize(function(s, theta, mu, ...) { lctrl <- lmrob.control(...) lctrl$tuning.psi <- lctrl$tuning.chi robustbase:::lmrob.E(chi(sqrt(1 + theta^2)/s*r), lctrl, use.integrate = TRUE)}) g.2.MM <- Vectorize(function(s, theta, mu, ...) { lctrl <- lmrob.control(...) robustbase:::lmrob.E(chi(sqrt(1 + theta^2)/s*r), lctrl, use.integrate = TRUE)}) ## Henning (1994) eq 30, one parameter case g.3 <- Vectorize(function(s, theta, mu, ...) { lctrl <- lmrob.control(...) rho <- function(x) Mchi(x, lctrl$tuning.chi, lctrl$psi, deriv = 0) int.x <- Vectorize(function(y) { integrate(function(x) rho((y - x*theta - mu)/s)*dnorm(x)*dnorm(y),-Inf, Inf)$value }) integrate(int.x,-Inf, Inf)$value }) inv.g1 <- function(value, theta, mu, ...) { g <- if (mu == 0) g.2 else g.3 uniroot(function(s) g(s, theta, mu, ...) - value, c(0.1, 100))$root } inv.g1.MM <- function(value, theta, mu, ...) { g <- if (mu == 0) g.2.MM else g.3.MM ret <- tryCatch(uniroot(function(s) g(s, theta, mu, ...) - value, c(0.01, 100)), error = function(e)e) if (inherits(ret, 'error')) { warning('inv.g1.MM: ', value, ' ', theta, ' ', mu,' -> Error: ', ret$message) NA } else { ret$root } } s.min <- function(epsilon, ...) inv.g1(0.5/(1 - epsilon), 0, 0, ...) s.max <- function(epsilon, ...) inv.g1((0.5-epsilon)/(1-epsilon), 0, 0, ...) BS <- Vectorize(function(epsilon, ...) { sqrt(s.max(epsilon, ...)/s.min(epsilon, ...)^2 - 1) }) l <- Vectorize(function(epsilon, ...) { sigma_be <- s.max(epsilon, ...) sqrt((sigma_be/inv.g1.MM(g.2.MM(sigma_be,0,0,...) + epsilon/(1-epsilon),0,0,...))^2 - 1) }) u <- Vectorize(function(epsilon, ...) { gamma_be <- s.min(epsilon, ...) max(l(epsilon, ...), sqrt((gamma_be/inv.g1.MM(g.2.MM(gamma_be,0,0,...) + epsilon/(1-epsilon),0,0,...))^2 - 1)) }) @ \begin{figure}[h!] \begin{center} <>= asymptMBFile <- file.path(robustDta, 'asymptotic.max.bias.Rdata') if (!file.exists(asymptMBFile)) { x <- seq(0, 0.35, length.out = 100) rmb <- rbind(data.frame(l=l(x, psi = 'hampel'), u=u(x, psi = 'hampel'), psi = 'Hampel'), data.frame(l=l(x, psi = 'lqq'), u=u(x, psi = 'lqq'), psi = 'lqq'), data.frame(l=l(x, psi = 'bisquare'), u=u(x, psi = 'bisquare'), psi = 'bisquare'), data.frame(l=l(x, psi = 'optimal'), u=u(x, psi = 'optimal'), psi = 'optimal')) rmb$x <- x save(rmb, file=asymptMBFile) } else load(asymptMBFile) <>= print(ggplot(rmb, aes(x, l, color=psi)) + geom_line() + geom_line(aes(x, u, color=psi), linetype = 2) + xlab(quote("amount of contamination" ~~ epsilon)) + ylab("maximum asymptotic bias bounds") + coord_cartesian(ylim = c(0,10)) + scale_y_continuous(breaks = 1:10) + scale_colour_hue(quote(psi ~ '-function'))) @ \end{center} \caption{Maximum asymptotic bias bound for the $\psi$-functions used in the simulation. Solid line: lower bound. Dashed line: upper bound.} \label{fig:max-asymptotic-bias} \end{figure} \bibliographystyle{chicago} \bibliography{robustbase} \end{document} robustbase/inst/doc/fastMcd-kmini.pdf0000644000176200001440000020452713465050176017347 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 3656 /Filter /FlateDecode /N 63 /First 509 >> stream x[[s۶~?oI .d88O;SF%6RTw $eю;"n\o/X>A|$SМDhXHB(N%!S1H0!% jrAX$iOE|.> ~^Nx/$\QD0ʈψ'"%" |]HM)t 17c! SP$0ωfa4: ]!t=I(D@) z 4#dF1fF ,@F0 `Bà4$4FYa8@g>w ʾH+O$P5Lʜ$P 6@ hp:$2ǯ+[@5#7C/y4X P8#u>O P`2f.ۃtJ^2$v,PQ(T4՜Dg>+;o|K,om4f'oi6YڣtiN%GtYr𥯠87.|c^^0P$/X~09dM290($nz(\2/Z:DQ/g*]gc 3)Ťd<΁w݉r Ug8HUrmH ͨ U^ ܻt R#txE{?K|Qc.zT ^l%/zu/֢_h9!brz`Gn O~}Av4-^t',x S 1aFzzx 7 /ѓ_}*QhNi9s;#€ ɳu\vhJXW?@Ezq:ISTN!Yf5쁁Mx Kԡ|.د}L& Û>R0E)uZ"@ KJ.EhZ٧ڔ~iu9~Tj оd:y1 Bd=};F^}ċx9V3oͼě{K/n4& Iyro}zah3X"`<0|ߵ񳲕hWd;k x-62|$ Gj81 Jxq9 xW'o "a(0a>P|0 >CSpYLOi 텮K ; v6`p{tIg*YJ-R3X-{Yꠌ~Q[;> +J2wއ  {w|}>{LQ{PְTvRl.&[,SF%i6-m`hèkf~_n;C`3!|mӦM((t4!*Nh ɝJ< @0sͽJ+.^D?iO>Myi|űUl30L뀶q݂P` زo߽xd6x+\.@X FJ7A[/X m֋yږCnx|FDQmKbTz @lAwplހ2*86;^csQtE"STONeUnyvمe=- ;28>6)vҭR&[RkHk7 ;w Rw'S0 ޥII6^/nXy, xaEԕK<5n6 kY!R7VI:n'4xoUHlWW*sE|oF jka.(]J9X #vUjJPYGiILbi۫TekmZ ۮRQ>_Vj )h"W)X?sLbU*M.a.v"uJ̛b%Ό3Vb r[  |w7 /zPۨmjɂu`|@7Q[^vVheY-= 7"4DKζ+(,-`UBBpD̀ke(4"X.J–;CCk9jOC j$kXw*侫RaZk Kߏ!V)FY{]!l :5hno:QJ^fIEؔ-|ݎk4c5i&e~,Qt,'4,y ֆ6uePI@I8;it;r$ Y Ph/~Pu~k'6pqtf%ҭ:2o\\n1a(7ggfSVnܧn/6eCwynSJ'iՌ@V_Q>+dlw%)[7(D|wJt \~sz5/|3߼oӡJ.qh\Y+r\%F8Lev3[i.T Ms;7ףXW/I!瘄1)rJi&` 7E;tt=пlz~xwo b,,fk5a%{r}_ܰ{;_)]nt{&4Giꌻ!`Ʈ/a[)#*vWTJF8oUl-_lNHⶔDw v2%VfnD{v>G<*^f ؀&xGXj):ۻ!3:c3TG M `?h+ۼ ,@RyKD&oQ1ZĿw,bܣ! ?9/]eH_xM xldvY_:t!u+,)[f?sTRb;!ƽ͌iX,+V3Ahk-;\oZo,v/F'%:ˆz6?Zmkc>kjujjƪ}*$_yN+>8M]w.VE^6;8|Ǥ7B@˹̢*skgXy(sE:$q1H/߅廸Zk4GuV9"-pG;:SCeW$mIWoLwmź[JC9ή-ZJjt81z87 ޙD  Npҽ#%Mpщe7QfqPCm5ՉADdx+#fvHkl6qr>[}!;4B3&%qw)Q_5q-|"?GL9꜖2a*^r}vHq٤DaP N/0!CSO q3wF5cnړw6V V| T'Hendstream endobj 65 0 obj << /Subtype /XML /Type /Metadata /Length 1557 >> stream GPL Ghostscript 9.26 2019-05-09T18:08:30+02:00 2019-05-09T18:08:30+02:00 LaTeX with hyperref package endstream endobj 66 0 obj << /Filter /FlateDecode /Length 6584 >> stream x=]$qvk!z6?$G ȃ6vnOڝY}H䯧dwdO,sdX*RnX7 7bۼ8n]m)n{<}~3vc=wg_u~;սů{]]w?z]l;Dϙfp zEx8eZ1-lwM-)J*qJzL܎{;@F) 9Hݟ"U$l8! ¾ Va՛4sGMyP!Oxlπ&Ϟi" JML u!*B1 'O`R (t̄ k;n2@$4ZFյWpC008LIqM~պ8oOVqܹn:v$0-t$6d p7 C$@=>߿"p.ɮ3rGg(P,2E.;j;<AJ40%]`6mϝr](Fp7)H9(ߕ:އ0-*JECQ 5k1S0I E,R(=v$a*Gk*@fh? Δ%ݾP/xj E8B.6>!w 7eBapmv410DwL,aJgB@ D(A񧀳q f2W%uD)Em/8;[NKdXQiBI`%Y✗Q A4Gӕ  +6HKpܩU67gL.}>̩m0@fMts@xǓVȍ%ws1ywm9n[9tdl`i3i0P3x9qvOt[tIƟNqp.:VJHG? G*IО^KZDY$C(75noю*yU꧓r x b}i)[Ku,e$8O!W@v Vmzd}@g1kxuh|j4*z3fh4 RLhxe_̐[]aotz27"LsQTtԡޚV':i8oѵN)⃴ /KXb'%Mm14P!߰T(+bYMߡ/0Y2{ DsO$ޓ1Ե6嘎↷ۈ3< h7?SZ_*β[_V(eazD4?jOa;"7>Odt1/"&@2C-9-#:϶8X:R>AH 1r>\c2ol"#hxK'aͮr{iL04dQ֬ԽLβsxDŽ !DzF⭈=a[ŤJ=83 R 쐟 %٢INԤWAd! .TAQt[Jkz+/ d/ Q( X. R(3ɏ* ]o|4DE$LQ ?CIҊ+j7Cs*@b1QK PS\$s?g.&I%Z NFF͸[|Î;rT6M 0m9ׄSG5B@iT48\E3Sd3C.Gl&29,D5RMedq9: EJlVPG1/D7:J^oʴpJG!oo ڬ&J:*Dy&m?y\eQ/(.2xd\_KX]N~0 Pek qNRD›X;\`&\ǿ7'R澊)P =@>I]?#CFlO*-8M5G&JU;*@Rp'%H iNmS֕or [xz3䅠,ݺ"e&u< p=\"Ѐغ=y5BK5n,2TbTY:$[V}p_Rb6-dѫ euAj/obS (Y2/'5.6vb "5IPHA;Z!>AFe1uО>7(oTʥ6,Rt(333KɃVr љ\ag¡^t(ݶ4EMe$.^ a@xl L#qO;Ð4F0M&`A^8$jb_ Ѡ9+r,UinBXITFc6~ͪYE0^\`hb)Y`5I,t톭h-m:6Z$&1+IӬ 1:Ot( =B` S1X l{~io! :2@W`_ilbJoL100g 6)46 n;2\M=Cڈj| ~J3a|MNG#0OYʯ) =8m(Nj f_BfQ{IHCb]DC5B< U /2MD7җwi-Oo(?;q!ȳC7l2r *&L$ZS,'tfRMs`f+Ϲ-̗pYlV3H)JvXXKn"h^UFLbZbٶFzPNp4qIenv*dKy4"]q!f/= jGզ3>xQHYz/BI![ s #?>?3bG3aOC%ʪvHCWn"dUT+];;,u[/ R#Gz)I bc@.jy-(:-v̒= u" 2:bC*z3:QC E6O0)ocjΊR^rP$=1X*bV\+ ,u*AYB("Kg8,oaZȘ?Q6B+rUWG%t4p 7/ Wbㄈ=(y:]~r)K[pI(s <35>O#x.ԃGXzVWW;&7N.KQA(nyI=6H=4UA#0e v#Q+l,UV/M#;! ;t-]@L=kv2HnHT >Lϧ4 G45"g{2Q_)(5<ި+Bcd+s4}кyuԝ'f@Jqf=^ ܐW"/W3k118ѴߒrK+r,tW#)]-_)[Dm<#8vةRj8ZMt}#>G%.oE%,hף2Хm܈@+Tp93k:k.ێ@AgS~$R VVW3Fƭ;ժ BhH}Qr:~'|kh6ȌI^Asؤ fM뮭{iHS~ cdVM*g(,ho86)B9*˼cHGfj}JU;ɦc;s'apVUa \yy<}6Mg[>o˼78DK_,kZ$5?yjQwt 1@}νV%:OTtON|zqRa!Q;޵ESiZo3WZOZb 0O?:9eSwFDx&RpFNJnΤZvԝ-?Dh4H|"E"G~>7 c7u4F0p֎'=VƅV̂*nm(XĠ!-eNJ9Cк#96'W[Dg5Pٞ7E& b8D\88_;=rg:v!πVHȍM' > SRd*=PYU['o͊*< H ;ž4*Ejמ0 6~|4jƍQ[TgN5þy[9-}5zXh a/|`d` MvZ"-*RL[[ K--toH4ѯej8{dS )CSBՃ%*/de*e[tK]Wx7Ow;B /hՒFq&F6Boc4wZw ZO:ȥTɓ^e,M1f%hj* 9.`cO``SM)ۉ!tA=O/3r򵘁JbM.8?0ün~. ,x00Ls>4֋u7 +0C6;a+**qa+]-[&[6gZf'45XxWBY*r$FK]]ڊ>+'[TT.^7%～Qv%2/3]+h\ ~&V3QX𡀬B4S5D<>BmPωS,fb!ϏT6d^ YR)/Fx6>l@*DiwMylΒEM%LmhT.5+ag^,2bx\Fƌ*TCe)iArHf+&ݗ/ȅ{Q#Qi/-F%YPɉ@6j#*xBlS!(H`biflQ@Yu98H<x:4J30x v/_ *&:ui wlcX/pYx ;f.w1z)՜S; &2kEWȆI9EPJ,m\T<ܲǛ=Y47 5^?[)uG0 xfb'Lwi_@2VпR|E~Ʉ"*ON̚ݦGY^ o8Lk,AVM)SgmQAJhX(,ٻ;nr4NtǁѢyҲ;ne$'t1Ħ-0kiO|'x%E):6XdA1Ṕ? ,beC(b 0aC_*1X07ՊѪ5[8'4>ْmw?"{ˇ RFI6֌w9L? _./:} r0NCh0# ^7who_ǒ0WŻg/WaDH Ųabs,(xZkk=qV80}> stream x\Ko$q`ڐo|kTmk$%֊e(=C.g<$r];"3*"+C00Ū|FG6onNF\Dߛ/Ϡ"ٷ'H|g{;99ynwV^Hսwo۝&1 hQwSٿqԽ <v]~4- qx@D9ד1TCXIܝF6鱛n l հbiƞ'ɜviIOEz*Sqvܭ!}Ua2-Y%KI6OR8rLaT5aL_%?/y/12|aqDfpfr0ӇicηeVG}v"*w&oBxô&)& 3&s :^5fyAd,s'd {[Ij(80L_la4.u}Ծ洳N4}mޫvu^ a=o{#!\.HV>}$({t1^oF=D)D!wݷtiYy Cvg EW-eY^Q7Wh{ĉ{NLoNv1͉2XďoO~l<}0}J^K v϶O% !iCPc{oZ:LI ٩ p!ZH{c@[ovw3VDQd4 =,+qVl{)pj ȁX'2#a4>4B> 1 l v-E2`(b M5`]+_4IeN^?\T/6̰,,65Rlt0B\,3<.(wD&}R @[1S"t[(:6hAaPUiR^:Rq\awDKιI /aT9RG5۠ԕzY$"QaAGBb/a \>" uWn| ۍT$$iq$-p!cXKOdz@/Hq}}[n[\4y,1@ׂ(prhc(M z^@78'v'%^wW3[G8& z:`gxހ0> '- @,јҥȐo!uf]9#lF ʇUZ~W@Y&gUR|D`CJhƮWApwEp~2b\p}Cu JyŏcI'-8spŞLJh=#2WoiI4vL UQIJ#HI[@qkن#Bqq Sl妻+Cс&kr977YA79Ǎ<gT+If^@ࣃ>sA<@aH;w (E1㒓|@e9h=`P LG&A!cd}^[b QNtKQ+ fICȼV.?u t)]ӇkL^Q%2V!2MR\0p<*wnQ갤\YQ(X\@5!R >'[ =eRY9rCܬ:p1^T$e>Ƭ5%c038TUd W4qL.C>$+!48ű'ŋi53xMKJڴh%VDyldt34KH[#*0&.lt rYڤhEz: M ĈG`gy<9;9ٺ\M408xC7owNQ~oE ުĞ0i^jOdKݴ:oLpi] U˵ (G` VC0_hFq܏l$4SUĭ\qYi cbT5THRVTJ&ա.ePTfdTPQ>͇JSBFO]Y>Ğg.82R9 p0 ڥ! G!iSm Or4sGY 0Ȩ\r_"^ lJsTvȖ2 m?qrG/)"*D`eK_K) ޏ]֋]./SAvQTQh=[tJ5?AuF0 ~37 *N\@峷D7\͵{[*vf(wyi"ARm^X>̰v1423={tޞv2qWZ`y$8|8;}ljq?4!m..R-U> Ty{*`Rik)RA# ɯq C`p)Sd!3K>36Gȓx*\ s~~ :?։z+ϗ<% 'eui/fHPB {uUX19Y(#;jcJ"OC pMƥNt(iN9)JaO<M Qu_ سJqJ fIy4ZD"oӾA|D2sQ/p^mʣD SWE0 @Hx ϴoX3G W WgV QOV/t/<- B@ ۑO Zt 䇫J,UQ@"`D+p_Pf;:^,:NJ'yPҪBWˋ^yu\ֵ6_^n?.xt¯,9 ,f#I`t.CZ̋ c`BiR%:u<}&aL8zhQ^H+V J.1-rtdž2o R.z .3( Mt 1f~A; C;8ET\&Q?fΘ|6vw)OS2d@(aXΩLXe"}=vˈ SfOä2JPtxPp#j?D߁/"/ʫD# +[KÎZ%GSՋX'E4Qr*!.TUujQѹhV mn3[/VS0/ A5!//VT~ ;Q/4_P1ق)+7k=d~oT+Oaï@2thj+`l!P]bEdʕ0f*#SrvzDv"z%eʠSU<+dBse*|,tpuHlu,2B2 00SL1V.aeAk[|*?i F:[aZu۴ƦiE)ym5mNuC祶[Wzn[<Ʃ51/ N+%>?#widmĚ["wʔ!x ÂX":_pÌ~A^_+| I2 fU2y~{S:7+YhKOx=@yi{iOr;Е%=^-(ouJK'XѼ[#{)"tT[btY/ј ^Xd &afR?Ԛ*2BM X!܋n-0.}rTI{ <r<*Yqg<oX t92A3 aui%IOtzn^GH7n5ZHqM}]c)@O݆ T?ªeָ$,C=Q9^`.M*/%66q=eupގo.0fV^,r)y=/Jw\yNIPaES6\|#|tU3Ɓ,@9ڿi q0J8xza0 tW5)6`"ߞN*endstream endobj 68 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2550 >> stream xViPgf`$ډDK( hbPx 侦{<@GD#1ukb.ķǏTmk+yy?rthVx >yKii4QK N ߚ1q+TH .Och ~R,_m>.",\rWOWyϙ3SsT 5qm*`]&:X'DVi^FN3+))38:S6oLUR.\%jBU~m:ջ>=V_mtLN׆jQM(/~.!18D=T>S+)Tj5 ܩ=j!K-< ۔ZJCSZʙA=/3C9R;JˁsTLR|x$!ƙt|ˆi#2WlB>z3oNŻJ2")9SA &?o4z&_pld,K@櫓?RtOln9m/Fr8BsK4ҷgxqAݪ;TpzP]G^ ԰\~fsxWCw\+|d/S9S1nqzL&$Qgʈp"sA30KKłRrbk3k*J[wo D´NB;p`@3`+`-vy`*'+ғ0.NӿV+lZ5ݼ3*4QR̂ہ% ʕrOU ǯz9M=_P l`E1I SQ,)6ˊs]̞ؓ;ޘJ!=4,jU߽_2m7CN)6LIӇ4yYC_X|1ZxӨ1cw14e K@͊B޼$Kq3?c0$pWN ;CZxd}8 !oUΡFTW{j`SE:d Ȟ<}?_l ަ]/?qCiPxټpx! -`T$%dV5^q5z*ѥƬ*9*UJήhm}ژd1NLD$ gL:b! ;d˭5u@[ Nf: 2 PJR2`4԰bKc B&g+98{2GFwJZ+bP `o0+ WE)\4[ }xӖVu}Wݘ8ïi^.t]U}wG[va_vߠg-d˯~ʴ]jݛ8zh+Vw}t]?dQ+Oo2jegfd[+q/+%k!\ۘ]UV&yOsvd*œQLb$l9f^?u:9A̭N?VֈDِcA_t 4pYLLSnȌg|%-rA,ːHaAsSIq2Z`_$,`bAϓSLdU~Wq`UI&;0<^TV'2(A ǻ$gU!oHcC͕}6GBG*|f]RDtD^2&*\lذF* @_ 5hhȃiL犊df$h7?c` | bzz a5\)NnHNsk'ju卸n*p Wڱث^ewG J _ʇ6<\UZU[[e,-#̜)DCAYә^Zֱ߬A%:'w cU {d66_r/Ruur&*)I^^l'n__ζм,a<LT{Yezid:/"*7&.p5/ikkrcC'deOLdK4c)VJ iw7Tp7y:WTHXY"SIa:Vϐ`*(tƱ71la)?a=(v'-%k +c2 E\؂&.r6gΟӁ5g0Fpt1@"c֯ 6OWC*oYe% *gl#\zHgyȾ(=endstream endobj 69 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1819 >> stream xyPgƻi$3&YK \փ!1AeAFz8P@A ! ŲܪU+$I5أJvHꪯ{y󒄷AD[RPE!ܵ&>sMRnYt 2"I^[*W5:@Yضm[dCCvg+5) ^e(:#Kv@Gdt!!lmJ#0Hː+JA*{UdqllAg*We:FJUjx "?%Vq[QA# D$HDīD4K,'V+DX!v&7d^NT޹ރ>} }f%9k' GD)Uܺ|Lʭe; (O&JN*h;,Bi.IQc͇8\ ?a٢' x9Y|fkR7!yQ$-נ :8ɥ#M{)%amM"u,ZkQ^b~9P#{15mCAZ+RVO(,k6-tlrA !+z8ڟq>(0bykLR{Cm2LB7;&. Y#/co+eJi/o%'BhǙ 'ڦbiC y*+07۠yԠ|(5UTc 7CTsL%~q8W4ey/kTYVV&Rv5Jxeobk8gfAvO{ a6{n2?^* .pfcQJN&n B];ȂgC"KhP\{j-28InWIh5 Z lD$ #?tJ U4*璚FXںT9_5Gf,si+遻?c#76J7[xypDfsY?_"Fe`=1^%/e BO_BTQalyMF΍vKtGaisPVe2?ej07AJtacFJD.Q3VΒNHa08U9z:ە:0X\ac8$V< b~M/Xk.Ene1]0 /F`[m#Q4%Dd^şӧݓ;a?Di[U1% p*'MUxW==w,_86D!c/`~zʹ :릦x=,^1y K؏Eq^nRhpePiՇ^k|n, xIesGnp]oD~YEwwYU&09OsjT{8 |I?[g#EΠJBY\|>5\䔩z kNa-EP6r`kC67zg71Rj=Cp `c3 pΖER)|C Ͷ>_rvέoj nhw9ܜ N]"rިd' |>Gmw>U[UWWA0(؛JLEmEm9?] Uc]iϒɧ%[lO|}'.%iߘendstream endobj 70 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3182 >> stream xV TSg>!!;ڣ9Gj%S[EQThQI(AI6A Dshw8˱eVuc?]3'`ou>$}}[B(DBlr_d.* ӥ@JWZsS|N_~^NRp6x7X8_69WJRnt\\ٮU"bIhev&")UvTRR[ ,P$.&D3w2E\Wic1ʱD}jc⒓"X\j}'%LJWo^cƒ-s)jH͢fSAjJm>^|jGVQ QZj"5zJ8JC9P hK=\{.iQ k}i L{f^;::qCNƫ E `A7^"lzy!yxy%B20*y`6si!U%`4 LP;:;huOB: '{ =XG(m( G"u9bTNNګKΓ~*PC#+H/ b~YҁNXNR ,[NHpN4iՇU=yi܀8w $'?LaG:}nh>quNw`BXg>}15:p{A*fNki1 y[#J*'o^`;<OZa fX,Gv䁘Jn2yr&7cb߃M؋gf|&cD&m,-l!M~I6=j7ᎅ+~K-t@8_{X.Kq,RwzUqfZo7&G(!rON;@_ްr`AC$C^> 3 oq HnIH:+Q*D[ .owܪ.R~Q_`0(3uWZKCρ3w ]9&Ӿ^sнrN 9#<ҎX'Ӊ׈uUC|a>Ő LJd=ʑ_$:X[j(FF,e}{˲k*UanjYmƧ%Sh}ExB4r Gnj3n} mPxy%btHFd6eK^ɍ=|Ų&腓P*1Ȅq|ΰT؄lSzWx_x6HOp;& E|j]1ۀ&xCw]F |ĩx3"=`([O16)r DC*A_ed礁ޙ]s7oFLuM \H? UY=(/:2> [ϓ"!72'Sȡ+Qmm16FN7\kYf2&؃.S&ewQ͟GH7b?֘?4W@Uf b#v)\b9Y/=h/o4k.n"Uu0Pv3Hxg'(Wй"Bg ėwjy./0#;7o dCPT/!OEHۿf} ѥ܉ \0ObHJvȝi›#NG'/uKn=Q`f6p!ο+Tt@;k Sƪ>(.k_|\da?^/[ Odށom>j:Zw)kK9{ ʀy~11[wx}>ːb(A2ieP/JmpRn%; cNuv';BvGD1ٿÜɿUaנ5Gj/] G a<3ⴭ"GXI,{@xpgă6 𣹊cSoǒ]!ijKC*C)SUgq7o:f>ޝн%65#7זuR|x% #eTlseh_]=: r,B$k:Y3ӚlJ`UC5{x,Z?\If ߨl` u<ʈB!YLd>+kYհ X\( %8GWCWJ;)(ߏendstream endobj 71 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7538 >> stream xz tSU is E7EPf " 2 ^N+<}B<ɛ`'083}뭘!Q"3)& iOOoaN+=B|h}.tZAQԲ/ raԢ%;x,ZwAC6LH89q^{;3}mѳnj?^ώ^\*j$zZCIRhj5ZO6P㨍5+?S碂a"x޷wg\b |ŃD[ydB&.^aHIA-B,zes<xf^B~9]~0r?|Ͱ=خ aԴݴV:=t0vRs|PSqqD@B^ *.pw#Om ܛq$PSZ'ʂtn\捇ǁv؁כxi~,~ٳ4iŅ>G.I҃tl0w OM7#B3FUh l ~7'֚D~w75>s# * c]6DŽY&|1Fg*'\ HRgq]bUJiPw w"r-MbxPuOhʃ{Bm]j"\R}`[=N(( ?H ʟ(}+aP.HAmD X~5֙F#ly<S,7=C_|s%x,= &88쯫CԷaHj_[t3Y"I=kڞ\eȎ=G3=OSbY5chmxt(b!M%{;` /!8@%!WU XlyI0Cn&J Pj8lfA+AcGh4&Epҏ(ijӅI^p$|] n-JV)c Iy c+K,aIIXR7MlwX*Cy/ef$\05d4Xt(ިZ\Y#/ ɋ3#]f1Xvn`گ{a(V!{CN6݂&7'3nɖY>r,m76 !ތ ۮlyH{Qt+6֣۫'7$#]ՑrY`ցm xT . ś*umjImӡ`,nT|X2' r3><͑{ڙ ;??mgnDOgb47?jG3"5`MW it? 4b\iɐ 1huMǩ`Gv~K˶.W ^ܽPZnE2DA^M 2?LY~J+$)uuj2vVuxwσZ#f&~[VR`ڤ1MPmʚn f@?QBp;ߩ>1۰G78Mt=c-.# ȷl%5E{ܖt=2ju~im;#>]ֶ^K5G,"ylߚG,U9_[KYvRQ0ۓߛ_hE4TCA[0M~caԻxI2'pnQ/HЬ`z^hZ[91=M RjiH7r(Yi*|\$l#I;ĝܸ֡ xng,vY2C/L cRzaZG")6DÂsQ@:R9) zE3W+ʼI>3wr9E=S f2T MHgd2f OyW%EYGR3G;3|B1 6͟:;zn1U03V댚qj#}?>Ext$QVTv<[z֒L_ .-\)X '-mڲh(ʲuP˘taaq1vN '.җ>C(7 ;'v`(KI*E8$,T@ D$yZ?A)Z9E,ݑp2 K4lQDY߅HjW=섽?>ѕmKS+Ws"&3أ Oi-1T a $u7*U !&)΁'%Y) b:6v=1t? Es81e[&[R[eJ/]GJAKBe];+Zg`$MO8-]׽3-A]/bs%PRҙ.u=~`qr@7Դ \$w9;G4nۙ *O>kp̆ksD˖Cpy8ĤQΝqkD;z:t!^ ~wf6.VPl/3ʃEgŶJǹs6̘6['| H K" 6#_ϯ0GIBҼCA}dnsyE{f Ŀ~m'llq-p,E]R{xwI16nAaN)nڍB;:=cYiy,aOZ(K2k܌?u+/pj.O]ϳo"ų *㈢Fe-\^4qxa|t-.$]ߋb!& $wx=[M[Qb7VUrχ=o,/YyW_*s*JF y_TRlᨖΔ3uqTYk̎wZ WǓBtgi+ dVhn4 DJzn:/UF' U|mOw#Aztϗ"  &SN mI+x V,ZPTm9=Iɲ6"8,^'Y2_dH@A%'m/WM7.@kCZЀ Y*0,UqFS}rwgg?掠>H-сNP(5J*&b8܈#N:Tr=_`އ{͖ 0ŏd%{Jp6ɼi *KŷTJ%$ };{?ٜ<0H`MU;?^6w" 8,3~BwkFwK#w5{&իWEŹFcVt*ɮ+v ),<m9{Qdct%,8Ǔ{E)!Z48 פZQVeA88ޢp 's(@"{]! m&0{àf]}2לp`cf$&NoϏ;Ȗ~|CuTt22VՑidJtbeF+;z rDotؒ(M +1nmf~߆ߠ&qMSfX-L'Tf2vR?Dس6=׏k3]%CAtP^endstream endobj 72 0 obj << /Filter /FlateDecode /Length 278 >> stream x]n0 > stream xVkTgYl]I׵㽻ZmQQVB @ I=!  \Z[/]k[g=jm=_{vnt̙|3<;,l,bm^rrUYEr6IMRa6o\/\t"2ؐ1o?E#j݇XCzsJ) NJZvR+r7UbÓ <9sS%)Jcry+V(JrlK \~ W@]>s":$K9T̫U2aD ð67WIkKBQ>n3sa/b,ۅ`aVl݇Eef6aEY{XF_vlJy75?miִ&|5/ϙ?'2'uGsazq_(i,f@-npD !Nd,v!Y*sC^wS5z!h=Q ī0f{y+^-rK;&SLaAV=4 Zt&Xaε^`xC5`ĕ]vol38bo =NnV?$3q`$ϋvNtz"dQ4 /ݲj6ya :L;&MQ)٪N+Xm>M:H?(}-گ8cvDgnhU[xHx*{yk^I-4^ֿGĻ&MC齅.bOi;z 8:TB dHa`\MH/"|q>͑Np۬+9xR !]^E 4rw9"Ѓ*'. _q_p9tMZgj֛HyY9%/PQ{r-:Sd6A=zܪb'Uc CG?J?tGΑnސ8 A4+"*s_wZ] -1*PW+ O9яE_#o~1`0FB><TT՘A}ϒ6_AE> ,=`q<3H[<4WXfvMr? smlͅ(,%2L<o>>7vF&S86yUUuUm3#6Lep|b#!||`^A1wF_Ӭ%xAmJ5AqϿ)v|3=pEZ>MؒTvaQ1(W+h,#¿nؗQW(=}nmPT\SV> stream x}l8BzUrguF)jjPXLpRbDZ?mbu␤€d#jW M֪UUڦ.0t +D"++/oOH +Q/v{e /T7\+B)6zQg\5>H$Zc7Yӛ ͍MrS3;wج|n۶Rܠ*UDZ"iA]C0)7n" [vttlQi[tƗ٬h&jЮ>NK(+Tr tZAY;6hUM*AhM-k-T"UUd)NA֊IJV4]Tdqqi({{{UyFǻj^v@ÄAi'>gς/7yRfTڔxcu1|^?^<0/Y習3oD2pA.u?ǿMz|POL6贲̿flb~m/p=&W$#Ǻ|=xWm*ʾ\foWqyY#l\|[M;KA);X6weÀ8I4_=Cwo~BZ%8e %.o{}~hM`6UpuS@M{Ẹ8q|h\e=?:acEeng?ߓr3~sh5mIsf荁&|Q*?$`ng"v<)*h} 3ý#G38N7yV%(m:?9@[X/Nd?-X9)]IYRFM39a䖊}`K$ELlVohQOnͭ sا܂?@B1[foD'a,wwfftbODvdK&sqދ;P npF[:qH&-N0F_)qpu6PX ]scendstream endobj 75 0 obj << /Filter /FlateDecode /Length 260 >> stream x]An0E7)MɢQ"1C}fxSϧsWS%|j9BQs8 7w&6;n%=@ŧ+Uk0MXQ~kӟYnرgu|)tNEݡºPhvpxd .ZQ U3@JPOVBX; X/ڠ*/iWQa:k JFml£J]^dizdendstream endobj 76 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1916 >> stream xUkp޵jI\ K4exZ0^~`eYH$K1òa=,ز一a8;ąPIJ'IC IiKU:]K8읻;ű, q{KWϘ+8$Ydל|,gӆ#ǃyKf-`9b"#7/YS۠UȫeB5k^\.^U\FFUH%jNZV#s*^T!7kbh,4ZbB_-~Yi JVZ/%32fMMm^TʴjV1VUdUY; IR[ˎITrLem0pZ*d52^%.FhDITvrH0l]x[VG_\nQ)`+0-v;ip=o}Al?jܓ4k$#lk_'_ʴ R%P}oWZbn2]gS SJ}b} Ӄ078hQ%nv+WX_åVxm@).n".׎8ܸ8t3o G &^tZ>7&!k#|˩4r_o"un{)O=@]8+$oN'i`R.9uv\ipAXG(vBcoF9M%pత$u*؟T)E*:G(֝ڬa{^`jIkx_ 4' :Mw.mm|E *}!կSu:O/0'T1(TPęwosy#CV0ll=*A)=V9;A;}qE*9r-Wdj/ @ tvxˆ[80jVbvMޫQN>Tc $;Xܖْ4 ct /{]ȐlGQ4T ;|'+({8'MVh ^RQ > stream xcd`ab`ddd v541H3a!3#,lP_7s7ˊBG``fd/r/,L(QHT04Q020TpM-LNSM,HM,rr3SK*4l2JJ s4u3K2RSRSJsS ԃP9E A L@00ֽucź>c9lߵ~L^2FrR}_nrlsguϝ:W>mr-S#z|gx2%[euweռG&Ddlk j讪=W2Is'} }wn=eKӻnn ߡkEt9`koߢ9~>':yn)?zٻv/k񝍭Dɕ3{VY3vgW>> stream x]O1 y?!!bI `""dg;܌D[toQ`j҇H3^dx,SU.tQ^( d`L N0%L`yBg/5xbW%5E3h?\>endstream endobj 79 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 651 >> stream xOkpMu˴v^(m:/DD)l"蓥K45+-YdnCe:AKa:W?ᗒ=w8CPpοy1Tا ݋F2m.`{b&0wz!w.C,bDQ*K%w0~:陙kOtY'H/K| (>~0[SS,Nzd^0A#AzH?9y 0u!:@r\BGtQ#1>F*{JPReCڢ(<(b WIJ5BJ&dK9AЧ- H[N)KRb74*/> stream x]QahSW~7y&/5\`Xivvn-TVRAL$[_^ڥ4/iM[+MAd?TFas̕ 쮰j7ݏs=AoBֶ7ֻWxd D:zb7;鯶`Yx~y#\b~q*4JjmnwF@V'(y4h䗵XçiH$R kZuk>~Ľ,>\(*P&brLV{E]z{T$ǵFBUV=Y~cd_k8{FFG*u-4}N_pOl!dkDLl0I}2͹ߡtv!KlgC fg :-?8^&"0ɛaEHJKD,zLd4J{?};`M^J"NW=taB7FE'O-atLV<4[iQ'ܜVV N:xf? Qf!bTȌk*v[>cSqPendstream endobj 81 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4204 >> stream xW XWמ,"ĩ upG?KVA*(  $ÖȪb]qѪ_mVmmЧy<ͽs=y{f@ -d9+^7fa%{aa7܇#k!6oy}d=&L,#3JbNxsObXJ 'laOMF"FC #,ń 1ǖ0'og>fB*UQ0gYNmŪ-ֽ6lmbwVU}n?>sv8WpOȅ ݣS"PJ@AئO7Zd(#'9##%RP󌬮G-rjɺqrYgd>Բ7sOR!T˸X: x4ٿ) m%q#6Tȸ R>am#CjxRnۇΜH2XCԿѸnu*馣񧫐_BA{gS B."h363&a;,a?=<Σ]U.,o"Yϕ~Y)t%jTfg29Y('QMv`ox {Se(*M(&QN~)0z/]aw' ͰT3p݄W=XUܾ6w KBb#GS?lg?eD(+~ܜ }Mz}T9M++>u,j$z0΃)؁Ţ4QSx:l쐨tf8Ha ɋ7 V[٨Myj{ެ֌= 6#URQ*{g4dHb!2!I%~ gQԾDF3y[MPD(dsmmH3?TG]i'nsgVR&:,Q!(NN% iKie^G9|./NWL M̻E+0? )GLV4Tj4,;8z={G{.$,7.\"CRt7meJ)6:/\ul@-H}?Y(M%/FuE)9s+#{:d;zA=Kȹ c`|H,wX4iEBɹDQyC CeBKrt1HSTP Eng,rɬ}'(d>vɱ遘ɒS,Rz]Z˸@D(Z O_K呅>xXAZy|5*G(z,y^䑎ڈSTQT)i,Dnn}J%ٱ@īoepJCg]_wW +w:AJ ,:IM|0š5yjth`v`'xE0l Zq(l{$1~)Ѓ+R>RHz5v\b f[h+e^!tSHHɑ3w@cuQ*RGT8]`ǃ=~2A9-znhQ΂N Nʈ rrKQ^PۧǙPp^%AEih/Ҕh򋾂sT^_4/Em:SN~E | `df8W7>w5TnSa1xчM/y9/]f7ݸm0R/8oz^./ZW:\~ [Mȋ'm0FBHgc7mH r:k*2u tHK6z{پ(Z/ddPrzs;ч[7߶͇Bu!Oz[RX]y}޼]u{UUW\hݐAn/PR㋨]o PbL$'FA!iiz%S󞯁0yWӛbYZAD[2P&YEQnM zcեmmZBT/Xy\O4q?N~-r ؆2 P/yS{bAOVx=zzeȈm{͐~j~Er9MIlDRT[ļx^kA׌ƻnBR>_,1o0:*:TX[i+e:# WH}jI{ـ]K)EAÙS7bzD[5g=P3#Ә ~|u,1|u.},dS/q+̺XB-,ڇ 3Oi| (O>c`m3~I41?/󧹏Mq=$ȯ1=d|Hu|h!M 9\ŎKčwҷ;䒙YUS8YyǯjOP%jFvPCs`eK7i#%_=8 x7H{:M"KvӢsIHC¨H%"1Ɠ:_Th M!љqxڐ;͘PC9 POdR iG v vBCwD FDln;j俳L+Mr~/l:^F}#~nnb?i7@-<tj"Ar*4BLx D%ܟ^H( }_nYg~Fx h\ߡsCжX Ch0kɰp׈HV]Pil;R}ϊ?w $KKxWKyWeq_s[2ߟ. [:z`!ꟁׇߞ7@ɅTL|_+)~8#%Q +E*TL\>{Vs_X:C/8f' qw!lFQX{UUY3S0ջw# eDO72RilCQ)PvTcU[< 3Ch7gO}v"w w^x?fĿĭ~e̔Gs>x|㒫Yhgn^xoJw/g#u6м%e{KP U(OHMU3>LHLC X'A5<+kjY Fq-< ]׭|w&;y> stream xcd`ab`dddw 641H3a!O/VY~'٠L٭|<<,k!={3#c~is~AeQfzFFcnjQfrbobIFjnb ZRaQRR`_^^[_nPYZZTWqr-(-I-ROI-c``` b`0f`bddS{='8[w%iKw8f|[Yw_/~7b"??Dlwo.y҅?|_8{!'nrq> stream x{Tgg$#(ETۊHtZ%!I@^A@.`@ZDoª{[]OhWuO̙39= I$IEnX} >,`~)Vڐ>7vͤ>H5mJHRS.Ry%EaaҕJ:=%)Ke$?dJU)2H\β.,((X]R`^ K7re|Y4ZJ㒔23xQ*ev+SKcU2uAS e;ӕaϛOUf"!qD 1xxDbb*N)اA"U>[*,{ᦺH4i )\1@Cvnv\SH.S"-m:X(D_{ n8_s<:8)AEoxy:vm7Tf^'6vz$n FX!6A1*vc?jwzhe<P9d=(? U[a375R̅N콃F;R4H?[2cZp8v晘sPԅ Lz}ŲWѓǿ1&C T÷L%*OL q{w_/]Ca&g&=$tw;.{SymP B~ȰOZVtu+?<56{;RP E /;AMg80(LV%G+D=:^p_Fp ` (VS^N!h:^6B)W08Rq]pᨐՂ7ԐTL#b.^xaߧoЖ*$;CVe@U۶@`~z(fɎaT>5,@+әF@[m}] 6^ypCbnXOT++*j4[]ۋ?JJdS[*O[rk$O]lɴo$B",@38~.ㄢs zLfjt=KReTu ux$ύ;gm# @D/#Gh#3f6Cwt[8Z!RY/9f&2p(I6{ &l|noˇ00q]V Stce @b6)?}yS;w#}A7hxQ:l AU`߷³w0އ xNCuہ֧7ڡ [`|)\?;ZVZHP$| ;|~nu\! 7 GB P8Zc g_9ȯ P-G?L,a\r93U)OcM_=M2[CsG8:-6wO99qAco})(3YC\Uauy5h)M= ±S|6"@wkM< (B@d`Ld *X }cԯ3z i caP+*Ш )~x2)QJX20XA3ԅbsrb!}.l=4| `cY04y60Kj n ȷrQHհ*IDɌx$_!qendstream endobj 84 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2891 >> stream xVitSu!P+RD佊l*.R+XhA잶iitK4i[Ӵ=JhKYZ 2*9gΙa^[<:G?8'}2ٳ017>q'~ƅ1 /g ҉=scozuN#.B (k!d0 r!/'Waskz ѯpt~tb([./G*qE1/Dxt]zAѺBa5ѥJ[KŨf`7֚ {Q]."2Z@Gdǡr?lCT"?9 мSdP%uzNEw6 &>@s/"{Lta"=En+ʤz-PƑ9Q)j'b&IV\s6fyh5zlJs\^I>NFy5k?Ku;}*Ƞ!qI[݃i]~-_şcQ^ ^[F aHZΐǯ <x`0~n  nIj1 +tWxTAp(K2Y;xC ւNSIQ Jp`Y]y o J8ӯtnmTU]խd; `3{fF"Rw3IAxt{(\>}b UTBܙge?췵= Fj䑑hJxoBh6D[_z=_fnr;unIJy]sXoFcFZS%Ԭ9[-!/6MΫJgJ8 t_ȡ$-MNPX[]>c(M΅Tztw׻Ls-̈́pw#[p">Fѣ (* -w.zN9m^ˣb?ziSd|eY4p*_<)_;j3uXn.WJ >ENDNB(Lu1&d]`mAn[+<':h]Jm45 l0gL?1dJR'Q7jd6D4z͏؀wATiWέ?M&(jBÈi95sɡ`IQ &ji}͵z 'N;vD0(Kn $s@ m%-%]}t׎IKmGk5 jB뛎Z5tvx&3ӕ\PL/ ΔiUR-! zcb~6YǻP.]sC. ~1/kendstream endobj 85 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3117 >> stream xV{Xw(%P=[(UzREs!KBBȕ/$B@*J"ۮۭFzNmݧծnk=7}~ Haw=933߼~D8B Ĭܴ}cZyn8n˹GO#&H-ڙxB\ThĮT3f! RRHz2멤K,NNZ0oޒ9LIҦLE^8S_J.Q(\PȞ;dN`8״׾ ՔP(jw9}r$2 I'v7/]Tgi*[ln: =wIz+{~I(73Ur6QՍ'r #B-1N6s_^zkUFMutt::=Wy>?6H'z[9:TKZ8|7,G#A!5g3RdAMDMZfl-2/ZpԆsۿ|'t ȎG;ѕ1m̷jWnP1PQ5pFzaWF7[xFf&v[wóy9>rH@{+"Q/sΣxڪlVP*;?yyuӟ2":e˭ol`egʚvm[qx<>Z糯{*S*1[_|~siM$Lg5K^\3lk hJXpuܳ 'X>FqgKQ4zҭqIg fiY7lm`AgkZe`G2w]XfĐ5Ay55@xfdiul!l.5c _ 'Hl$HGK"GЬ7dacFp#xOs %EzH!C]] }Nc*2I  g1ixҏa`14D?6#7H_ǐY<)幽QE)(@:ԆZ;s (*˝={~guJ~ KWhOAzQa`Fd.y;jrP9ǎ偖WHmH:& ѭEG^~8G";sՈZT4 ~˵ ?8vj\চOzbJҧjnta6, z?etqShDo@_oĉ?qMC4`^}{{gMv Y%si; :QҨ*9U#Lj]MC]`@,vyA#??Q_-{|RYlmw=fzK@}AALHHTL E 3p^:he+"zо~6}趽_X6Sz a~ֽ_ݻW;o7 B̬vu[ۚ<&ؘ=6PNɲ%s$AؚobTB8QA`m8i'kD]RN$#!"^L8G\v(r|ΫQ,zJ7ջ rD[U@jJO"7^zFJQQQ!$a>7%fJAҩR4.ѣΚ:x)O( 7dcLg͝@;kRwR8?(RSkT-k`?RJb1endstream endobj 86 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1565 >> stream xmT}PSW{OĨķQ_mEha]Yt.#֢ui]"$GPjIKR ؂$#jv:qq;Uf[s^2>;g9wG62NM"Fy"NYwl"-a1qqaQ-$i )~ VJF\tƒ9D07eVayIaڵk ƵMGyf(0;JSyհ^Rnq Y}9ʪ l}Zi5Z,K!ns+-Gx4lWvZ{a#d˵W9o.f)!d)y8O Mt iιu&pHߤ[$FJ{%B@5T;a7PEwDYԗ<5'Ey+'Ao} v!Jg.]4pB]zJ4$/XN3z#bө&8|zpupoD : /VA{1pHmڣ׍86^p2n2ߩD'ʚ% ?USlEyKij,2a|/-_8;qQ[hL Jfz`i7*8eMp\T OkjkHϝ_FpzYSQDŽWa{lt5@~mc7cVHǞc/=W=VNG Wק.ÝQW GQI\}r@eMUU8WJu[Gu鳛(Gyt_C!x64+S/^ vMuU9vUIJí>FE|jxU)^WM~4z|*ɼ䔦/Z%ߟaA7+w8蔤z[f-B(3gF:=|PODQ<> stream x]Ku'7]xuRӬwe!I3@,Z3֫G9_U=weo{ sE08LzWi,CP77GJ 1_miM0DaEA-a#~i6^μ!Cdz tWjv'3s[r]xksJ4F= DV8}2ј):d Ġ=/)ӮzU: ]`,>P*$fZ:~AbYxjIÕP9Q#/0)D C "D!pl21o5$p=?eKGfDqp-ϼLwKoX8hR Η>|1;G"1e g9ahȒ1}&(c>O{^uzk<7m0 MV4ymK\&PÒta4aJPky;MTS:6pR mIIZV jGm h(981)|%Y}t!ґ&[&iby-YqMHCbprgJzp\1Y)DZNg>Xf&FoIqi͊Й4Zߟ6ZKל[ |z7+АZT*,6fجֈ<*\ϼi#2ݍ=Vp 4-V\sh l2Uw(7>- arNzp\5h0O;/eb4O$O|RG E\!>=MFn&k;hNXGF61/ /B@Zk?6x{h50EaۼL` ]ypm hL\P2 N(ibu*כ:=G/"41ASw, W^ 0`6;Õh~X~JK֊& aŒif[ZVSdD7+|ɩg 7%0l!{B|@@޸%46YtͽΉ/RJ^M[l :pw&kUf2 6皶e@Ye62Jd˪x?dX;{ wMJ֚=-k!z ٶYdֶIK 6ʃDMǮI\9Z#x0R+J<t) ǔ* [ȟto;>ɥRXpno-CN҂:J:(}Q'u;'C8//fat0Hw+dwOQ`RY7LtxUD Gl{Qؕ*iU_{hS)ZBU DZX *D̒o@vH2Ȇ>FkRJ.MDUa`1jMɧ¯bAN8Qmz"Jv'%IA-h>=~Ql:Dr:Sª0Ǹ1GZlx ?Q#w}vl<8>GR{"y?xс+ovժd8HV ~ &Ja:92r YA0}_gJ`A6MׁhOEq߅0CD}iOJ3,/7~Z|\LVc<녺V8+Y/,B+a,/ q ~2G_[-.Ch>xA^/dwBԸiըSbu@b+ A 4{SzOyr{5e]^ hui˕//[)T\)T|1U& =UzXDtߣyspٶOt砛S i?Q!{֕bw/zfkI,m#b oʌ)^uwH=? ḃH7$2}~G#zhD( Q{>#4wdc)4)f(pdi)"vGbT_;|C_7/%3 SX% ZJ)}-I/jI?T$?@6khVp-|1G&bQEp[6`̀x{ܒ.씓V/^jWG_YL >I F0EEtB^MXj+F~o0='!j?LҒ2s#g")wUE|O3K Dj]1a}r䄚h] .`mTʇமob Z5zT6j,}<+Aכ2>ռs?tm϶ԥn];hP<3p@mʵaͭo"'K= >=mL*F(T)[MV~6pE7on7`$`7 l1TDt_g!x5ԷWh^)G&GG}5.> Q%Ȫmw93J˘F W%QdF@B;ZEB#*# Rne6W3ǂ ۈc*QvpثJTīY:Z?rH96X 7VUuDU%3,{͖Ml|e5DeA񖣑}&Q8Mw $oUkRHiRҗ| }JKjcXJ7+V)Q%aZ`8@3 5$XGNKSċs'Dvldқfvh6'yU[iZ]Gq ѯC7WݢVl^i@D,mV~0*CBlZPLR yWn/D{ګ {1BgUcK'и|<+ K@1F~gX?ʪpY%|Hl/64R5D,F P.VxSxb&-T/|HD)틜l=<]pmf(%KJ胡GMYKQ1 <?J٤F7c~[n=>ϋ{L:Q $Csk%00)IKe7p ]̭&c"O! l5L\е-UNEE㛯oi r)т *R'R|t'zRL g%z25jу"!2EBcնMϣG[`ɩ ]&NIzF2L-V ʁ<KeO. L{ZvntՉF^ₛ&IyⴼIs(34,?0k+ݦ򃶏E'TcwL;9mX޳h r!v0b.|RLﰚH&)By9~-cc41|Y[%3 #(o}3JŚE4||TaB;t9 -$U.Fqwcd YN }su)(`9bu"R24aeG>]qoHMtڵz†-5}pƢb.Y?behkDY^5C4_-f3?}v[ԡ,m ΃`5Nq8 RxMk6u'SRn>bRL[ꍕ#y1\Ҏ6C1?K˯nVVW=FJgO}{ZM-d8U jb֦IElԑbZ5)OthB'`xX!#\\6WBpڛZ)V{6~LS$罍U1Yn~ƒڍKW B2$%ΥEOc{NMEA"FHt:t봬c[), & (ǘ b9<cWTQsZZS<[d+?]l&]*l8EUSEyussy]λ{rmЂJoz| ŷOԮMDR߃pWQXs}0}!GȄ PF{*/T^!!iejt!ˌlgѣ*ryofDs;kFAE<#z66ZO2< }X!7{dx! ;b[Y ^RuxOm%el𲕪&O92 >m!s.!V)W8x;W yMV9V#+/(E_-|j˵)|FxJ>zh7 R3 i8L3jJ)De;yPE?A* =wbl/X o3tS=!ʗ&xS7?X`W RaA Zd&a Fv ǰpb6'BOBAT+y|tO!H[m\h]ѫR9 ogz8\o~՘7A/)Xzr~D*4<'SiTng^f3PE|Y淕5jV׫w$2y } jJ/b]J{_ѯ9eW%HݡHzGv<2zO݈{svYm!ջa/F+N xxXVF.eYiM:gt;&(2%S]*${\+,~euKwH9fhm>Tؐc S㖵L~6;|m&]Hl)$Lv,܍ҖMeM$ 5M|lΥ}p)vOe۝o;E--]眝Iøp|zrϵڮh"E[ܾ~/336Hr@CaАGi{ >GÚ`6R9LHp;[9"Tf.+6Zv%uO=%W;+.gW~ՠc3[Pa}te'3-Cf:Bv9G)W2 xemx%.6%ˁv ynEy? c]>6%tq"ußHp R23h,(ѬwM :$GUQЊLmdj|W-vendstream endobj 88 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 359 >> stream xcd`ab`dddu 21H3a!]cO]VY~'٠L |<<,k$={3#cnas~AeQfzFFcnjQfrbobIFjnb ZRaQRR`_^^[_nPYZZTWrp-(-I-ROI-c```4``d`bddI{L~]/^wK/r@U~}\<>c] g8uu{wU8eus-<{ ~'Ncu[|>I<<20=̉endstream endobj 89 0 obj << /Filter /FlateDecode /Length 2306 >> stream xYɒAٺca$vء!/>H>EGhD:~Y@u%gĒ|%h kϯ6py1 ;?Wßv<`DSh=ԥ4$sCJIG?6_볭ѡzvut4EoxcSliIn邎!ƻgK좋%L?{Rg/̵T *N\ORT /r^Rrjv>ITr c삺\;rMR\J i)dɟtJͅS>9Mo\VoC>iocdJmKC%qrg-Q]CCůn0k8Y e>?LNm678`*l:W?WayC6}F"GmT%B>jJׯhRy ڢ6֙_ը8wb[s+kӚ7mUDf åU5=ܹP|]Ҵ.Q;sl|X'k֤kpdHC4tK=P7x8`!<c6>Rfydi*EEr`\k]Fmȕ,d<AwQ;u|;""hXWE1Q,pvݱ ʻa!h} BG݃aqmrwzwj 9q 9/ חŧD-_Jq#~((.o]{ րw4A5-ovf&xvmCr J8!:EAܣ(X\ [~Q}-X;l|c}|G`X)i=PAjNXhX?m;`r SNA2Hv@JdX m#e4'T\AB ,[,GCM^Fdb#퐍EwNÝh8"*J\@U:GIAvrXEcك+fAmwr*s,J " `(ABK?dXj9%)zH2lz|.iayu~)^:gEo}(/4ػCS.To ߞ1dcvzC_-mXˆA(:Ҩ붉M4=|{Q7߼~vRI~kUPZ?uDy[?C,;6~2 z;uR-J̉L^]R𛄥crh>Xz ϒye5 ȞzBa=uz~EK>[ ,[V-L+ыʔx4Wגw>'3b 6UZ})ag)J퓌x[\տ_-> e&|SOqaWQ5v88ű_qUfzf;2!3<{,2# or2#;ߙ-9{bBB\6!y..qPsÏҝ2mf%팔yg#tpߺ)t.#ShVW3x^aQlMpU28 C[цص/~!NIm#L ܬ*g61P [*}˔`gflU~gL*ܟˍa( > '<"D+|TxH^yTO/oēgHLwĽrS>a _L~9s/Y O遫z;8]ZV4\;y)]mHO'ەF 2Ҭ78\&9rUHH=ԗ˺lRx*-W$")O 6@NMp%|~MXvņ'YQ m bm 4|%Rk"Ht7~3Z~P7FƳ^k:!ZzmAo~ m}l7[endstream endobj 90 0 obj << /Type /XRef /Length 122 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 91 /ID [<99e326469827575650efd40af19b1c75>] >> stream xcb&F~0 $8Jҕ͞ )F)DrHR{Dʝq K,,"9Hp_DM<_VD,`spH2rz3 endstream endobj startxref 67533 %%EOF robustbase/inst/doc/error.distributions.R0000644000176200001440000000271311535441110020320 0ustar liggesusers## error.distributions.R: additional error distributions for use in simulations ## require(skewt) ## loaded in vignette if required ## centered skewed t distribution Eskt <- function(nu, gam) { M <- if (is.infinite(nu)) sqrt(2/pi) else gamma((nu+1)/2)/sqrt(nu*pi)/gamma(nu/2)*2*nu/(nu-1) M*(gam^2-1/gam^2)/(gam + 1/gam) } dcskt <- function(x, df, gamma=2) { ncp <- Eskt(df, gamma) dskt(x + ncp, df, gamma) } pcskt <- function(q, df, gamma=2) { ncp <- Eskt(df, gamma) pskt(q + ncp, df, gamma) } qcskt <- function(p, df, gamma=2) { ncp <- Eskt(df, gamma) qskt(p, df, gamma) - ncp } rcskt <- function(n, df, gamma=2) { ncp <- Eskt(df, gamma) rskt(n, df, gamma) - ncp } #################################################################################### ## contaminated normal #################################################################################### rcnorm <- function (n,mean=0,sd=1,epsilon=0.1,meanc=mean,sdc=sqrt(10)*sd) { e <- rnorm(n,mean,sd) nc <- floor(epsilon*n) idx <- sample(1:n,nc) e[idx] <- rnorm(nc,meanc,sdc) e } ## ignore other arguments for the moment pcnorm <- function(q,mean=0,sd=1,lower.tail=TRUE,log.p=FALSE,...) pnorm(q,mean,sd,lower.tail,log.p) ## ignore other arguments for the moment qcnorm <- function(p,mean=0,sd=1,lower.tail=TRUE,log.p=FALSE,...) qnorm(p,mean,sd,lower.tail,log.p) ## ignore other arguments for the moment dcnorm <- function(x,mean=0,sd=1,log=FALSE,...) dnorm(x,mean,sd,log) robustbase/inst/doc/lmrob_simulation.pdf0000644000176200001440000320754413465050140020234 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 1348 /N 12 /First 78 >> stream 2 0 3 146 4 272 5 373 6 499 7 622 8 766 9 910 10 1011 11 1110 12 1170 13 1235 << /BaseFont /MRRPUK+SFRM1095 /Encoding 71 0 R /FirstChar 136 /FontDescriptor 113 0 R /LastChar 136 /Subtype /Type1 /Type /Font /Widths 87 0 R >> << /BaseFont /RHXHGX+CMTT10 /FirstChar 34 /FontDescriptor 112 0 R /LastChar 121 /Subtype /Type1 /Type /Font /Widths 86 0 R >> << /Count 6 /Kids [ 118 0 R 120 0 R 122 0 R 129 0 R 136 0 R 138 0 R ] /Parent 12 0 R /Type /Pages >> << /BaseFont /GDCRXU+CMTI10 /FirstChar 38 /FontDescriptor 111 0 R /LastChar 121 /Subtype /Type1 /Type /Font /Widths 85 0 R >> << /BaseFont /WQDNZG+CMSY8 /FirstChar 0 /FontDescriptor 110 0 R /LastChar 48 /Subtype /Type1 /Type /Font /Widths 80 0 R >> << /BaseFont /YNHMJD+SFST1095 /Encoding 71 0 R /FirstChar 39 /FontDescriptor 114 0 R /LastChar 39 /Subtype /Type1 /Type /Font /Widths 77 0 R >> << /BaseFont /FTYMYF+SFTT1095 /Encoding 71 0 R /FirstChar 36 /FontDescriptor 115 0 R /LastChar 39 /Subtype /Type1 /Type /Font /Widths 72 0 R >> << /Count 6 /Kids [ 140 0 R 142 0 R 153 0 R 175 0 R 195 0 R 212 0 R ] /Parent 12 0 R /Type /Pages >> << /Count 6 /Kids [ 234 0 R 254 0 R 274 0 R 297 0 R 36 0 R 54 0 R ] /Parent 12 0 R /Type /Pages >> << /Count 1 /Kids [ 65 0 R ] /Parent 12 0 R /Type /Pages >> << /Count 19 /Kids [ 4 0 R 9 0 R 10 0 R 11 0 R ] /Type /Pages >> << /Pages 12 0 R /Type /Catalog >> endstream endobj 14 0 obj << /CreationDate (D:20190509180759+02'00') /Creator (TeX) /ModDate (D:20190509180759+02'00') /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.19 \(TeX Live 2018\) kpathsea version 6.3.0) /Producer (pdfTeX-1.40.19) /Trapped /False >> endobj 15 0 obj << /Type /ObjStm /Length 19939 /N 100 /First 832 >> stream 16 0 17 125 18 250 19 375 20 500 21 625 22 750 23 873 24 998 25 1123 26 1247 27 1371 28 1499 29 1626 30 1751 31 1876 32 1999 33 2120 34 2142 35 2388 36 2509 37 2611 38 2738 39 2820 40 2882 41 2915 42 2944 43 2975 44 3008 45 3039 46 3068 47 3090 48 3336 49 3463 50 3531 51 3613 52 3635 53 3881 54 3976 55 4078 56 4205 57 4287 58 4349 59 4382 60 4411 61 4444 62 4473 63 4495 64 4741 65 4859 66 4961 67 5088 68 5170 69 5232 70 5254 71 5500 72 5578 73 5598 74 5608 75 5649 76 5659 77 6161 78 6171 79 6547 80 6557 81 6868 82 7508 83 8042 84 8649 85 8934 86 9424 87 9780 88 9790 89 10398 90 11010 91 11610 92 12048 93 12463 94 12925 95 13246 96 13548 97 13902 98 14209 99 14418 100 14625 101 14853 102 15079 103 15287 104 15772 105 16017 106 16271 107 16476 108 16728 109 17247 110 17527 111 17743 112 18056 113 18471 114 18677 115 18889 << /BaseFont /EYFXHE+CMR17 /FirstChar 45 /FontDescriptor 105 0 R /LastChar 121 /Subtype /Type1 /Type /Font /Widths 93 0 R >> << /BaseFont /AZTUVT+CMR12 /FirstChar 44 /FontDescriptor 104 0 R /LastChar 121 /Subtype /Type1 /Type /Font /Widths 92 0 R >> << /BaseFont /XACIBE+CMBX12 /FirstChar 45 /FontDescriptor 95 0 R /LastChar 121 /Subtype /Type1 /Type /Font /Widths 91 0 R >> << /BaseFont /CQHVWW+CMBX10 /FirstChar 14 /FontDescriptor 94 0 R /LastChar 121 /Subtype /Type1 /Type /Font /Widths 90 0 R >> << /BaseFont /ZLCRYT+CMR10 /FirstChar 11 /FontDescriptor 103 0 R /LastChar 123 /Subtype /Type1 /Type /Font /Widths 89 0 R >> << /BaseFont /RXNFNP+CMMI10 /FirstChar 12 /FontDescriptor 97 0 R /LastChar 120 /Subtype /Type1 /Type /Font /Widths 88 0 R >> << /BaseFont /OTNCYL+CMR8 /FirstChar 48 /FontDescriptor 107 0 R /LastChar 94 /Subtype /Type1 /Type /Font /Widths 84 0 R >> << /BaseFont /HHMVVT+CMSY10 /FirstChar 0 /FontDescriptor 109 0 R /LastChar 107 /Subtype /Type1 /Type /Font /Widths 83 0 R >> << /BaseFont /NFBJFU+CMMI8 /FirstChar 27 /FontDescriptor 100 0 R /LastChar 114 /Subtype /Type1 /Type /Font /Widths 82 0 R >> << /BaseFont /AFFYTI+CMEX10 /FirstChar 0 /FontDescriptor 96 0 R /LastChar 105 /Subtype /Type1 /Type /Font /Widths 81 0 R >> << /BaseFont /OZMFQF+CMMI12 /FirstChar 32 /FontDescriptor 98 0 R /LastChar 32 /Subtype /Type1 /Type /Font /Widths 79 0 R >> << /BaseFont /CDXFSQ+CMSLTT10 /FirstChar 33 /FontDescriptor 108 0 R /LastChar 125 /Subtype /Type1 /Type /Font /Widths 78 0 R >> << /BaseFont /OCOCTJ+CMMIB10 /FirstChar 12 /FontDescriptor 101 0 R /LastChar 101 /Subtype /Type1 /Type /Font /Widths 76 0 R >> << /BaseFont /PFSLHD+CMMIB8 /FirstChar 88 /FontDescriptor 102 0 R /LastChar 88 /Subtype /Type1 /Type /Font /Widths 75 0 R >> << /BaseFont /DIWXHJ+CMMI6 /FirstChar 105 /FontDescriptor 99 0 R /LastChar 110 /Subtype /Type1 /Type /Font /Widths 74 0 R >> << /BaseFont /WIRDCL+CMR6 /FirstChar 49 /FontDescriptor 106 0 R /LastChar 49 /Subtype /Type1 /Type /Font /Widths 73 0 R >> << /Font << /F15 20 0 R /F18 22 0 R /F32 21 0 R >> /ProcSet [ /PDF /Text ] /XObject << /Im18 318 0 R /Im19 319 0 R >> >> [ /ICCBased 320 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /Font << /F15 20 0 R /F18 22 0 R /F32 21 0 R >> /ProcSet [ /PDF /Text ] /XObject << /Im20 321 0 R /Im21 322 0 R >> >> << /Contents 323 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 10 0 R /Resources 35 0 R /Type /Page >> << /CreationDate (D:20190509180745) /Creator (R) /ModDate (D:20190509180745) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 47 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.302 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /CA 0.4 /Type /ExtGState >> << /Type /ExtGState /ca 0.302 >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 324 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /CreationDate (D:20190509180746) /Creator (R) /ModDate (D:20190509180746) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /ZapfDingbats /Name /F1 /Subtype /Type1 /Type /Font >> << /BaseFont /Helvetica /Encoding 52 0 R /Name /F2 /Subtype /Type1 /Type /Font >> [ /ICCBased 325 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /Font << /F15 20 0 R /F32 21 0 R >> /ProcSet [ /PDF /Text ] /XObject << /Im22 326 0 R >> >> << /Contents 327 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 10 0 R /Resources 53 0 R /Type /Page >> << /CreationDate (D:20190509180746) /Creator (R) /ModDate (D:20190509180746) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 63 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.302 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /Type /ExtGState /ca 0.302 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 328 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /Font << /F15 20 0 R /F30 18 0 R /F32 21 0 R /F38 5 0 R >> /ProcSet [ /PDF /Text ] /XObject << /Im23 329 0 R >> >> << /Contents 330 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 11 0 R /Resources 64 0 R /Type /Page >> << /CreationDate (D:20190509180747) /Creator (R) /ModDate (D:20190509180747) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 70 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> [ /ICCBased 331 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /Differences [ 36 /dollar 39 /quotesingle 136 /bullet ] /Type /Encoding >> [ 516.7 0 0 516.7 ] [ 611.1 ] [ 445.6 511.6 660.9 401.6 1093.7 769.7 ] [ 999.5 ] [ 659.7 590 522.2 483.3 508.3 600 561.8 412 667.6 670.8 707.9 576.8 508.3 682.4 611.8 685.9 520.8 630.6 712.5 718.1 758.3 717.8 528.8 691.5 975 611.8 423.6 747.2 1150 1150 1150 1150 319.4 319.4 575 575 575 575 575 575 575 575 575 575 575 575 319.4 319.4 894.4 575 894.4 575 628.5 869.4 866.4 816.9 938.1 810.1 688.9 886.7 982.3 511.1 631.2 971.2 755.5 1142 950.3 836.7 723.1 868.6 872.3 692.7 636.6 800.3 677.8 1093.1 947.2 674.6 772.6 447.2 447.2 447.2 1150 1150 473.6 632.9 520.8 513.4 609.7 553.6 ] [ 516.7 ] [ 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 ] [ 636.6 ] [ 826.4 295.1 826.4 531.3 826.4 531.3 826.4 826.4 826.4 826.4 826.4 826.4 826.4 1062.5 531.3 531.3 826.4 826.4 826.4 826.4 826.4 826.4 826.4 826.4 826.4 826.4 826.4 826.4 1062.5 1062.5 826.4 826.4 1062.5 1062.5 531.3 531.3 1062.5 1062.5 1062.5 826.4 1062.5 1062.5 649.3 649.3 1062.5 1062.5 1062.5 826.4 288.2 ] [ 458.3 458.3 416.7 416.7 472.2 472.2 472.2 472.2 583.3 583.3 472.2 472.2 333.3 555.6 577.8 577.8 597.2 597.2 736.1 736.1 527.8 527.8 583.3 583.3 583.3 583.3 750 750 750 750 1044.4 1044.4 791.7 791.7 583.3 583.3 638.9 638.9 638.9 638.9 805.6 805.6 805.6 805.6 1277.8 1277.8 811.1 811.1 875 875 666.7 666.7 666.7 666.7 666.7 666.7 888.9 888.9 888.9 888.9 888.9 888.9 888.9 666.7 875 875 875 875 611.1 611.1 833.3 1111.1 472.2 555.6 1111.1 1511.1 1111.1 1511.1 1111.1 1511.1 1055.6 944.4 472.2 833.3 833.3 833.3 833.3 833.3 1444.4 1277.8 555.6 1111.1 1111.1 1111.1 1111.1 1111.1 944.4 1277.8 555.6 1000 1444.4 555.6 1000 1444.4 472.2 472.2 ] [ 607.2 471.5 576.4 631.6 659.7 694.5 660.7 490.6 632.1 882.1 544.1 388.9 692.4 1062.5 1062.5 1062.5 1062.5 295.1 295.1 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 295.1 295.1 826.4 531.3 826.4 531.3 559.7 795.8 801.4 757.3 871.7 778.7 672.4 827.9 872.8 460.7 580.4 896 722.6 1020.4 843.3 806.2 673.6 835.7 800.2 646.2 618.6 718.8 618.8 1002.4 873.9 615.8 720 413.2 413.2 413.2 1062.5 1062.5 434 564.4 454.5 460.2 546.7 492.9 510.4 505.6 612.3 361.7 429.7 553.2 317.1 939.8 644.7 513.5 534.8 474.4 479.5 ] [ 777.8 277.8 777.8 500 777.8 500 777.8 777.8 777.8 777.8 777.8 777.8 777.8 1000 500 500 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 1000 1000 777.8 777.8 1000 1000 500 500 1000 1000 1000 777.8 1000 1000 611.1 611.1 1000 1000 1000 777.8 275 1000 666.7 666.7 888.9 888.9 0 0 555.6 555.6 666.7 500 722.2 722.2 777.8 777.8 611.1 798.5 656.8 526.5 771.4 527.8 718.7 594.9 844.5 544.5 677.8 762 689.7 1200.9 820.5 796.1 695.6 816.7 847.5 605.6 544.6 625.8 612.8 987.8 713.3 668.3 724.7 666.7 666.7 666.7 666.7 666.7 611.1 611.1 444.4 444.4 444.4 444.4 500 500 388.9 388.9 277.8 500 ] [ 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 295.1 295.1 295.1 826.4 501.7 501.7 826.4 795.8 752.1 767.4 811.1 722.6 693.1 833.5 795.8 382.6 545.5 825.4 663.6 972.9 795.8 826.4 722.6 826.4 781.6 590.3 767.4 795.8 795.8 1091 795.8 795.8 649.3 295.1 531.3 295.1 531.3 ] [ 766.7 306.7 408.9 408.9 511.1 766.7 306.7 357.8 306.7 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 306.7 306.7 306.7 766.7 511.1 511.1 766.7 743.3 703.9 715.6 755 678.3 652.8 773.6 743.3 385.6 525 768.9 627.2 896.7 743.3 766.7 678.3 766.7 729.4 562.2 715.6 743.3 743.3 998.9 743.3 743.3 613.3 306.7 514.4 306.7 511.1 306.7 306.7 511.1 460 460 511.1 460 306.7 460 511.1 306.7 306.7 460 255.6 817.8 562.2 511.1 511.1 460 421.7 408.9 332.2 536.7 460 664.4 463.9 485.6 ] [ 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 ] [ 497.2 ] [ 565.6 517.7 444.4 405.9 437.5 496.5 469.4 353.9 576.2 583.3 602.5 494 437.5 570 517 571.4 437.2 540.3 595.8 625.7 651.4 622.5 466.3 591.4 828.1 517 362.8 654.2 1000 1000 1000 1000 277.8 277.8 500 500 500 500 500 500 500 500 500 500 500 500 277.8 277.8 777.8 500 777.8 500 530.9 750 758.5 714.7 827.9 738.2 643.1 786.2 831.3 439.6 554.5 849.3 680.6 970.1 803.5 762.8 642 790.6 759.3 613.2 584.4 682.8 583.3 944.4 828.5 580.6 682.6 388.9 388.9 388.9 1000 1000 416.7 528.6 429.2 432.8 520.5 465.6 489.6 477 576.2 344.5 411.8 520.6 298.4 878 600.2 484.7 503.1 446.4 451.2 468.7 361.1 572.5 484.7 715.9 571.5 ] [ 583.3 555.6 555.6 833.3 833.3 277.8 305.6 500 500 500 500 500 750 444.4 500 722.2 777.8 500 902.8 1013.9 777.8 277.8 277.8 500 833.3 500 833.3 777.8 277.8 388.9 388.9 500 777.8 277.8 333.3 277.8 500 500 500 500 500 500 500 500 500 500 500 277.8 277.8 277.8 777.8 472.2 472.2 777.8 750 708.3 722.2 763.9 680.6 652.8 784.7 750 361.1 513.9 777.8 625 916.7 750 777.8 680.6 777.8 736.1 555.6 722.2 750 750 1027.8 750 750 611.1 277.8 500 277.8 500 277.8 277.8 500 555.6 444.4 555.6 444.4 305.6 500 555.6 277.8 305.6 527.8 277.8 833.3 555.6 500 555.6 527.8 391.7 394.4 388.9 555.6 527.8 722.2 527.8 527.8 444.4 500 ] [ 958.3 958.3 319.4 351.4 575 575 575 575 575 869.4 511.1 597.2 830.6 894.4 575 1041.7 1169.4 894.4 319.4 350 602.8 958.3 575 958.3 894.4 319.4 447.2 447.2 575 894.4 319.4 383.3 319.4 575 575 575 575 575 575 575 575 575 575 575 319.4 319.4 350 894.4 543.1 543.1 894.4 869.4 818.1 830.6 881.9 755.5 723.6 904.2 900 436.1 594.4 901.4 691.7 1091.7 900 863.9 786.1 863.9 862.5 638.9 800 884.7 869.4 1188.9 869.4 869.4 702.8 319.4 602.8 319.4 575 319.4 319.4 559 638.9 511.1 638.9 527.1 351.4 575 638.9 319.4 351.4 606.9 319.4 958.3 638.9 575 638.9 606.9 473.6 453.6 447.2 638.9 606.9 830.6 606.9 606.9 ] [ 375 312.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 312.5 312.5 342.6 875 531.2 531.2 875 849.5 799.8 812.5 862.3 738.4 707.2 884.3 879.6 419 581 880.8 675.9 1067.1 879.6 844.9 768.5 844.9 839.1 625 782.4 864.6 849.5 1162 849.5 849.5 687.5 312.5 581 312.5 562.5 312.5 312.5 546.9 625 500 625 513.3 343.7 562.5 625 312.5 343.7 593.7 312.5 937.5 625 562.5 625 593.7 459.5 443.8 437.5 625 593.7 812.5 593.7 593.7 ] [ 272 326.4 272 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 272 272 272 761.6 462.4 462.4 761.6 734 693.4 707.2 747.8 666.2 639 768.3 734 353.2 503 761.2 611.8 897.2 734 761.6 666.2 761.6 720.6 544 707.2 734 734 1006 734 734 598.4 272 489.6 272 489.6 272 272 489.6 544 435.2 544 435.2 299.2 489.6 544 272 299.2 516.8 272 816 544 489.6 544 516.8 380.8 386.2 380.8 544 516.8 707.2 516.8 516.8 ] [ 301.9 249.6 458.6 458.6 458.6 458.6 458.6 458.6 458.6 458.6 458.6 458.6 458.6 249.6 249.6 249.6 719.8 432.5 432.5 719.8 693.3 654.3 667.6 706.6 628.2 602.1 726.3 693.3 327.6 471.5 719.4 576 850 693.3 719.8 628.2 719.8 680.5 510.9 667.6 693.3 693.3 954.5 693.3 693.3 563.1 249.6 458.6 249.6 458.6 249.6 249.6 458.6 510.9 406.4 510.9 406.4 275.8 458.6 510.9 249.6 275.8 484.7 249.6 772.1 510.9 458.6 510.9 484.7 354.1 359.4 354.1 510.9 484.7 667.6 484.7 484.7 ] << /Ascent 694 /CapHeight 686 /CharSet (/A/B/C/E/I/M/R/S/a/c/circumflex/colon/d/e/ffi/five/four/g/i/k/l/m/n/nine/o/one/p/period/r/s/seven/t/three/two/u/v/x/y) /Descent -194 /Flags 4 /FontBBox [ -56 -250 1164 750 ] /FontFile 332 0 R /FontName /CQHVWW+CMBX10 /ItalicAngle 0 /StemV 114 /Type /FontDescriptor /XHeight 444 >> << /Ascent 694 /CapHeight 686 /CharSet (/A/B/C/D/E/I/M/R/S/a/b/c/d/e/f/five/four/g/h/hyphen/i/l/m/n/o/one/p/period/r/s/t/three/two/u/v/x/y) /Descent -194 /Flags 4 /FontBBox [ -53 -251 1139 750 ] /FontFile 333 0 R /FontName /XACIBE+CMBX12 /ItalicAngle 0 /StemV 109 /Type /FontDescriptor /XHeight 444 >> << /Ascent 40 /CapHeight 0 /CharSet (/bracketleftBig/bracketrightBig/hatwide/parenleftBig/parenleftbig/parenleftbigg/parenrightBig/parenrightbig/parenrightbigg/summationdisplay/summationtext) /Descent -600 /Flags 4 /FontBBox [ -24 -2960 1454 772 ] /FontFile 334 0 R /FontName /AFFYTI+CMEX10 /ItalicAngle 0 /StemV 47 /Type /FontDescriptor /XHeight 431 >> << /Ascent 694 /CapHeight 683 /CharSet (/H/M/N/S/a/b/beta/c/chi/comma/d/e/f/gamma/greater/i/j/kappa/n/p/period/psi/q/r/rho/sigma/slash/t/tau/x) /Descent -194 /Flags 4 /FontBBox [ -32 -250 1048 750 ] /FontFile 335 0 R /FontName /RXNFNP+CMMI10 /ItalicAngle -14 /StemV 72 /Type /FontDescriptor /XHeight 431 >> << /Ascent 694 /CapHeight 683 /CharSet (/psi) /Descent -194 /Flags 4 /FontBBox [ -31 -250 1026 750 ] /FontFile 336 0 R /FontName /OZMFQF+CMMI12 /ItalicAngle -14 /StemV 65 /Type /FontDescriptor /XHeight 431 >> << /Ascent 694 /CapHeight 683 /CharSet (/i/n) /Descent -194 /Flags 4 /FontBBox [ 11 -250 1241 750 ] /FontFile 337 0 R /FontName /DIWXHJ+CMMI6 /ItalicAngle -14 /StemV 85 /Type /FontDescriptor /XHeight 431 >> << /Ascent 694 /CapHeight 683 /CharSet (/S/T/i/j/n/p/r/sigma/tau) /Descent -194 /Flags 4 /FontBBox [ -24 -250 1110 750 ] /FontFile 338 0 R /FontName /NFBJFU+CMMI8 /ItalicAngle -14 /StemV 78 /Type /FontDescriptor /XHeight 431 >> << /Ascent 694 /CapHeight 686 /CharSet (/V/W/X/beta/e/gamma) /Descent -194 /Flags 4 /FontBBox [ -15 -250 1216 750 ] /FontFile 339 0 R /FontName /OCOCTJ+CMMIB10 /ItalicAngle -14 /StemV 113 /Type /FontDescriptor /XHeight 444 >> << /Ascent 694 /CapHeight 686 /CharSet (/X) /Descent -194 /Flags 4 /FontBBox [ -15 -250 1281 750 ] /FontFile 340 0 R /FontName /PFSLHD+CMMIB8 /ItalicAngle -14 /StemV 149 /Type /FontDescriptor /XHeight 444 >> << /Ascent 694 /CapHeight 683 /CharSet (/A/B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/R/S/T/U/V/W/Y/a/acute/b/c/circumflex/colon/comma/d/e/eight/endash/equal/f/ff/ffi/fi/five/four/g/h/hyphen/i/j/k/l/m/n/nine/o/one/p/parenleft/parenright/percent/period/plus/q/quotedblright/quoteright/r/s/semicolon/seven/six/t/three/two/u/v/w/x/y/z/zero) /Descent -194 /Flags 4 /FontBBox [ -40 -250 1009 750 ] /FontFile 341 0 R /FontName /ZLCRYT+CMR10 /ItalicAngle 0 /StemV 69 /Type /FontDescriptor /XHeight 431 >> << /Ascent 694 /CapHeight 683 /CharSet (/K/M/a/comma/e/l/n/nine/o/one/r/two/u/y/zero) /Descent -194 /Flags 4 /FontBBox [ -34 -251 988 750 ] /FontFile 342 0 R /FontName /AZTUVT+CMR12 /ItalicAngle 0 /StemV 65 /Type /FontDescriptor /XHeight 431 >> << /Ascent 694 /CapHeight 683 /CharSet (/I/R/S/W/a/b/c/d/e/f/g/h/hyphen/i/l/m/n/o/p/r/s/t/u/y) /Descent -195 /Flags 4 /FontBBox [ -33 -250 945 749 ] /FontFile 343 0 R /FontName /EYFXHE+CMR17 /ItalicAngle 0 /StemV 53 /Type /FontDescriptor /XHeight 430 >> << /Ascent 694 /CapHeight 683 /CharSet (/one) /Descent -194 /Flags 4 /FontBBox [ -20 -250 1193 750 ] /FontFile 344 0 R /FontName /WIRDCL+CMR6 /ItalicAngle 0 /StemV 83 /Type /FontDescriptor /XHeight 431 >> << /Ascent 694 /CapHeight 683 /CharSet (/E/L/O/S/T/circumflex/equal/five/one/three/two/zero) /Descent -194 /Flags 4 /FontBBox [ -36 -250 1070 750 ] /FontFile 345 0 R /FontName /OTNCYL+CMR8 /ItalicAngle 0 /StemV 76 /Type /FontDescriptor /XHeight 431 >> << /Ascent 611 /CapHeight 611 /CharSet (/A/C/D/E/F/L/N/O/P/Q/R/S/T/U/W/a/asciicircum/asterisk/b/backslash/braceleft/braceright/bracketleft/bracketright/c/colon/comma/d/dollar/e/equal/exclam/f/five/four/g/greater/h/hyphen/i/k/l/less/m/n/numbersign/o/one/p/parenleft/parenright/percent/period/plus/q/quotedbl/r/s/slash/t/three/two/u/underscore/v/w/x/y/zero) /Descent -222 /Flags 4 /FontBBox [ -20 -233 617 696 ] /FontFile 346 0 R /FontName /CDXFSQ+CMSLTT10 /ItalicAngle -9 /StemV 69 /Type /FontDescriptor /XHeight 431 >> << /Ascent 750 /CapHeight 683 /CharSet (/N/approxequal/bardbl/braceleft/braceright/element/infinity/minus/universal) /Descent -194 /Flags 4 /FontBBox [ -29 -960 1116 775 ] /FontFile 347 0 R /FontName /HHMVVT+CMSY10 /ItalicAngle -14 /StemV 40 /Type /FontDescriptor /XHeight 431 >> << /Ascent 750 /CapHeight 683 /CharSet (/minus/prime) /Descent -194 /Flags 4 /FontBBox [ -30 -955 1185 779 ] /FontFile 348 0 R /FontName /WQDNZG+CMSY8 /ItalicAngle -14 /StemV 46 /Type /FontDescriptor /XHeight 431 >> << /Ascent 694 /CapHeight 683 /CharSet (/A/C/D/E/H/J/L/M/O/R/S/W/a/ampersand/b/c/comma/d/e/f/five/four/h/hyphen/i/k/l/m/n/nine/o/p/q/r/s/t/three/u/y) /Descent -194 /Flags 4 /FontBBox [ -35 -250 1124 750 ] /FontFile 349 0 R /FontName /GDCRXU+CMTI10 /ItalicAngle -14 /StemV 68 /Type /FontDescriptor /XHeight 431 >> << /Ascent 611 /CapHeight 611 /CharSet (/A/C/E/L/M/N/R/T/U/a/asterisk/b/bracketleft/bracketright/c/colon/comma/d/dollar/e/eight/equal/f/g/h/hyphen/i/k/l/m/n/nine/o/one/p/parenleft/parenright/period/q/quotedbl/r/s/six/t/three/two/u/underscore/v/w/x/y/zero) /Descent -222 /Flags 4 /FontBBox [ -4 -233 537 696 ] /FontFile 350 0 R /FontName /RHXHGX+CMTT10 /ItalicAngle 0 /StemV 69 /Type /FontDescriptor /XHeight 431 >> << /Ascent 0 /CapHeight 0 /CharSet (/bullet) /Descent 0 /Flags 4 /FontBBox [ -188 -320 1445 942 ] /FontFile 351 0 R /FontName /MRRPUK+SFRM1095 /ItalicAngle 0 /StemV 50 /Type /FontDescriptor /XHeight 430 >> << /Ascent 0 /CapHeight 0 /CharSet (/quotesingle) /Descent 0 /Flags 4 /FontBBox [ -156 -360 1361 830 ] /FontFile 352 0 R /FontName /YNHMJD+SFST1095 /ItalicAngle -9 /StemV 50 /Type /FontDescriptor /XHeight 430 >> << /Ascent 0 /CapHeight 0 /CharSet (/dollar/quotesingle) /Descent 0 /Flags 4 /FontBBox [ -204 -361 1351 830 ] /FontFile 353 0 R /FontName /FTYMYF+SFTT1095 /ItalicAngle 0 /StemV 50 /Type /FontDescriptor /XHeight 430 >> endstream endobj 116 0 obj << /Type /ObjStm /Length 9661 /N 100 /First 890 >> stream 117 0 118 136 119 238 120 432 121 534 122 720 123 822 124 949 125 1032 126 1094 127 1116 128 1362 129 1597 130 1699 131 1826 132 1894 133 1977 134 1999 135 2245 136 2345 137 2447 138 2535 139 2637 140 2809 141 2911 142 3076 143 3178 144 3305 145 3388 146 3450 147 3481 148 3510 149 3541 150 3570 151 3592 152 3838 153 3933 154 4035 155 4162 156 4245 157 4307 158 4338 159 4367 160 4398 161 4427 162 4449 163 4695 164 4822 165 4905 166 4967 167 5000 168 5031 169 5060 170 5093 171 5124 172 5153 173 5175 174 5421 175 5528 176 5630 177 5757 178 5840 179 5902 180 5933 181 5962 182 5993 183 6022 184 6044 185 6290 186 6417 187 6500 188 6562 189 6593 190 6622 191 6653 192 6682 193 6704 194 6950 195 7068 196 7170 197 7297 198 7380 199 7411 200 7440 201 7471 202 7500 203 7522 204 7768 205 7895 206 7978 207 8009 208 8038 209 8069 210 8098 211 8120 212 8366 213 8468 214 8595 215 8678 216 8740 << /Font << /F15 20 0 R /F16 16 0 R /F17 17 0 R /F30 18 0 R /F31 19 0 R /F32 21 0 R /F36 2 0 R /F37 3 0 R >> /ProcSet [ /PDF /Text ] >> << /Contents 354 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 4 0 R /Resources 117 0 R /Type /Page >> << /Font << /F15 20 0 R /F18 22 0 R /F20 26 0 R /F21 24 0 R /F24 6 0 R /F30 18 0 R /F32 21 0 R /F33 23 0 R /F34 25 0 R /F36 2 0 R /F37 3 0 R /F38 5 0 R /F39 27 0 R >> /ProcSet [ /PDF /Text ] >> << /Contents 355 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 4 0 R /Resources 119 0 R /Type /Page >> << /Font << /F15 20 0 R /F18 22 0 R /F30 18 0 R /F32 21 0 R /F33 23 0 R /F36 2 0 R /F37 3 0 R /F38 5 0 R /F39 27 0 R /F40 7 0 R >> /ProcSet [ /PDF /Text ] /XObject << /Im1 356 0 R >> >> << /Contents 357 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 4 0 R /Resources 121 0 R /Type /Page >> << /CreationDate (D:20190509180737) /Creator (R) /ModDate (D:20190509180737) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 127 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> [ /ICCBased 358 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /Font << /F15 20 0 R /F18 22 0 R /F19 31 0 R /F21 24 0 R /F22 30 0 R /F24 6 0 R /F30 18 0 R /F31 19 0 R /F32 21 0 R /F34 25 0 R /F37 3 0 R /F38 5 0 R /F43 28 0 R /F44 29 0 R >> /ProcSet [ /PDF /Text ] /XObject << /Im2 359 0 R >> >> << /Contents 360 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 4 0 R /Resources 128 0 R /Type /Page >> << /CreationDate (D:20190509180738) /Creator (R) /ModDate (D:20190509180738) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /ZapfDingbats /Name /F1 /Subtype /Type1 /Type /Font >> << /BaseFont /Helvetica /Encoding 134 0 R /Name /F2 /Subtype /Type1 /Type /Font >> [ /ICCBased 361 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /Font << /F15 20 0 R /F30 18 0 R /F37 3 0 R /F39 27 0 R /F40 7 0 R >> /ProcSet [ /PDF /Text ] >> << /Contents 362 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 4 0 R /Resources 135 0 R /Type /Page >> << /Font << /F15 20 0 R /F37 3 0 R /F39 27 0 R /F49 8 0 R >> /ProcSet [ /PDF /Text ] >> << /Contents 363 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 4 0 R /Resources 137 0 R /Type /Page >> << /Font << /F15 20 0 R /F18 22 0 R /F21 24 0 R /F30 18 0 R /F31 19 0 R /F32 21 0 R /F33 23 0 R /F34 25 0 R /F37 3 0 R /F38 5 0 R /F43 28 0 R >> /ProcSet [ /PDF /Text ] >> << /Contents 364 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 9 0 R /Resources 139 0 R /Type /Page >> << /Font << /F15 20 0 R /F18 22 0 R /F21 24 0 R /F30 18 0 R /F31 19 0 R /F32 21 0 R /F33 23 0 R /F37 3 0 R >> /ProcSet [ /PDF /Text ] /XObject << /Im3 365 0 R >> >> << /Contents 366 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 9 0 R /Resources 141 0 R /Type /Page >> << /CreationDate (D:20190509180739) /Creator (R) /ModDate (D:20190509180739) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 151 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.4 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 367 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /Font << /F15 20 0 R >> /ProcSet [ /PDF /Text ] /XObject << /Im4 368 0 R /Im5 369 0 R >> >> << /Contents 370 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 9 0 R /Resources 152 0 R /Type /Page >> << /CreationDate (D:20190509180739) /Creator (R) /ModDate (D:20190509180739) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 162 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.4 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 371 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /CreationDate (D:20190509180740) /Creator (R) /ModDate (D:20190509180740) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 173 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.302 /Type /ExtGState >> << /CA 0.4 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /Type /ExtGState /ca 0.302 >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 372 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /Font << /F15 20 0 R /F32 21 0 R >> /ProcSet [ /PDF /Text ] /XObject << /Im6 373 0 R /Im7 374 0 R >> >> << /Contents 375 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 9 0 R /Resources 174 0 R /Type /Page >> << /CreationDate (D:20190509180740) /Creator (R) /ModDate (D:20190509180740) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 184 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.4 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 376 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /CreationDate (D:20190509180740) /Creator (R) /ModDate (D:20190509180740) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 193 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.4 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 377 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /Font << /F15 20 0 R /F32 21 0 R /F38 5 0 R >> /ProcSet [ /PDF /Text ] /XObject << /Im8 378 0 R /Im9 379 0 R >> >> << /Contents 380 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 9 0 R /Resources 194 0 R /Type /Page >> << /CreationDate (D:20190509180741) /Creator (R) /ModDate (D:20190509180741) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 203 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /CA 0.4 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 381 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /CreationDate (D:20190509180741) /Creator (R) /ModDate (D:20190509180741) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 211 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /CA 0.4 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 382 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /Contents 383 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 9 0 R /Resources 218 0 R /Type /Page >> << /CreationDate (D:20190509180742) /Creator (R) /ModDate (D:20190509180742) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 223 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.4 /Type /ExtGState >> endstream endobj 217 0 obj << /Type /ObjStm /Length 8073 /N 100 /First 883 >> stream 218 0 219 121 220 150 221 181 222 210 223 232 224 478 225 605 226 688 227 750 228 783 229 812 230 845 231 874 232 896 233 1142 234 1251 235 1354 236 1481 237 1564 238 1626 239 1657 240 1686 241 1717 242 1746 243 1768 244 2014 245 2141 246 2224 247 2286 248 2317 249 2346 250 2377 251 2406 252 2428 253 2674 254 2806 255 2909 256 3036 257 3119 258 3181 259 3212 260 3241 261 3272 262 3301 263 3323 264 3569 265 3696 266 3779 267 3841 268 3872 269 3901 270 3932 271 3961 272 3983 273 4229 274 4350 275 4453 276 4580 277 4663 278 4725 279 4758 280 4787 281 4818 282 4851 283 4882 284 4911 285 4933 286 5179 287 5306 288 5389 289 5451 290 5484 291 5513 292 5544 293 5577 294 5608 295 5637 296 5659 297 5905 298 6007 299 6134 300 6217 301 6279 302 6312 303 6341 304 6372 305 6405 306 6436 307 6465 308 6487 309 6733 310 6860 311 6942 312 7004 313 7037 314 7066 315 7097 316 7130 317 7161 << /Font << /F15 20 0 R /F18 22 0 R /F32 21 0 R >> /ProcSet [ /PDF /Text ] /XObject << /Im10 384 0 R /Im11 385 0 R >> >> << /CA 1 /Type /ExtGState >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 386 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /CreationDate (D:20190509180742) /Creator (R) /ModDate (D:20190509180742) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 232 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.302 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /Type /ExtGState /ca 0.302 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 387 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /Font << /F15 20 0 R /F32 21 0 R >> /ProcSet [ /PDF /Text ] /XObject << /Im12 388 0 R /Im13 389 0 R >> >> << /Contents 390 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 10 0 R /Resources 233 0 R /Type /Page >> << /CreationDate (D:20190509180742) /Creator (R) /ModDate (D:20190509180742) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 243 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.4 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 391 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /CreationDate (D:20190509180743) /Creator (R) /ModDate (D:20190509180743) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 252 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.4 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 392 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /Font << /F15 20 0 R /F18 22 0 R /F32 21 0 R /F38 5 0 R >> /ProcSet [ /PDF /Text ] /XObject << /Im14 393 0 R /Im15 394 0 R >> >> << /Contents 395 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 10 0 R /Resources 253 0 R /Type /Page >> << /CreationDate (D:20190509180743) /Creator (R) /ModDate (D:20190509180743) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 263 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.4 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 396 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /CreationDate (D:20190509180743) /Creator (R) /ModDate (D:20190509180743) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 272 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.4 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 397 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /Font << /F15 20 0 R /F18 22 0 R /F32 21 0 R >> /ProcSet [ /PDF /Text ] /XObject << /Im16 398 0 R /Im17 399 0 R >> >> << /Contents 400 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 10 0 R /Resources 273 0 R /Type /Page >> << /CreationDate (D:20190509180744) /Creator (R) /ModDate (D:20190509180744) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 285 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.302 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /CA 0.4 /Type /ExtGState >> << /Type /ExtGState /ca 0.302 >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 401 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /CreationDate (D:20190509180744) /Creator (R) /ModDate (D:20190509180744) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 296 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.302 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /CA 0.4 /Type /ExtGState >> << /Type /ExtGState /ca 0.302 >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 402 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /Contents 403 0 R /MediaBox [ 0 0 595.276 841.89 ] /Parent 10 0 R /Resources 32 0 R /Type /Page >> << /CreationDate (D:20190509180745) /Creator (R) /ModDate (D:20190509180745) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 308 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.302 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /CA 0.4 /Type /ExtGState >> << /Type /ExtGState /ca 0.302 >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> [ /ICCBased 404 0 R ] << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> << /CreationDate (D:20190509180745) /Creator (R) /ModDate (D:20190509180745) /Producer (R 3.6.0) /Title (R Graphics Output) >> << /BaseFont /Helvetica /Encoding 34 0 R /Name /F2 /Subtype /Type1 /Type /Font >> << /BaseFont /Symbol /Name /F6 /Subtype /Type1 /Type /Font >> << /CA 0.302 /Type /ExtGState >> << /CA 1 /Type /ExtGState >> << /CA 0.4 /Type /ExtGState >> << /Type /ExtGState /ca 0.302 >> << /Type /ExtGState /ca 0.4 >> << /Type /ExtGState /ca 1 >> endstream endobj 318 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-power-1-0_6.pdf) /PTEX.InfoDict 298 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 307 0 R >> /ExtGState << /GS1 301 0 R /GS2 302 0 R /GS257 304 0 R /GS258 305 0 R /GS259 306 0 R /GS3 303 0 R >> /Font << /F2 299 0 R /F6 300 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 9641 >> stream x]M%mϯKifNU8劒J*/l/䉜k!s@u{=\.-F  ~ n.|~.uϒgg6///?~*{M?j~tW_%WT0^RYyetIS) Uh%50T\s}|]wo^}\s,S``Ieor]4:ko`yPEײ/ _ 4I5sjlK`&6>h=|`|Puߺ[ M :DSpIB%?gMS UՆ/?K5kGkmB^2K`[mڹX;Z>m]caA(y!*3Nju i.'9f֕Mg`#Vu޽`AtMAy+zJG@Fuq偅4Fe=*_76\ Qy'(_tƣI*@T^ uKʂʷa D uuTTjAcKOb^*߆+*tK߯KvkT^a]%[ԫ.۔6;)kØׂޱkWT\t:oQyBx6 m{~]YZ<#~]eq:i)o%D6 n!hg~#f` tK-I XBn%0K[u=ZBn>c* }\Mv$.BĻJz7ރ%V]I[ ,<my9rz]%еK` ]%@{Z[h$n`tsiC/(KF[0ACi!g6׷묆`nR5OܤnIۺضGĦ^HG@S-Xkq|݊sU@WԩFYϘ$ɰͺuPM y偅zJG@FKzvW^Pd=c^öYrTdيP:'W^aM=#\EOhmA&]רPd=c* AEj SaKAYH%iArM$S uُ]3'Rv{Ǽaѱr^QzWV@ie=cun{մ_7S$;ҭsZ+4`{tWbkT] kZkZ\/QyBy\s{0ZރI] {l*}lG D r+җɵ: i.zƄuAyuVXzF疘Ay 頼`]41TeG6PBi=4 (:;7rt!]i8WBr&NvTْƒYϞ2u,M!QeNK(>%i. z In!rr&zĶDKKĺ-!nmm/紓F [brr&CH޺4.B% u_2l'7@;}ʙ띖cHs>GK}".i9 #8:r=Ż>LLKxI:\,6smnfn$i'#NvxeܴÚNr5uGL-ل 5= N+_P nyÛcezl5Tձ*529g^hBe:Ce튕F},e+ĠYZbeP-vUzgPmwoe-^BbF?Al\AYPJ5^mTŇa!EYe?lNE海kR k5(!szPY%zpZ=]8gQ <mtZ/ywK-;{z݅~eέډxWva_oO;2}[xve5#lL%^[̝dfmA7 ^)(װ{mQ L+v4'x[No#=vcΔ5a_{Uvt՝Q9tUiU߳UJUZP-n4-lC oYSNrh&ϔdttD`~LU|Eϔa!EY[ֶHuISC6z&57Ǎn3r]:5i@db!XLx 1x^H=t1X vUε_<ċUq$.X?Ǹ69R[ }R3[ Bi{P^MyY}27<r@K0DK[@;C%K/V}h؁zDŽgڏ_~-gVMX{/Vu*ka, `/B~0H{L1`pxw!<&/ꢻREn}s ~0LNd/ʀ_Ts:=`2~ѓSVu? 0 ֕RG*n?kB 8El_YշٝXpA:-ܐ;hti;²D֌KޓY7 QSq(p74%i 4%-,nn }=r6}ʉL%}hIK%Si )he?vK2IڤN+`{ |ߡ%z oocv,3K~jD.Xb%h-к]{ݎ/Yd,PA`qӬ'YH (g%i w@! <m&pl.d EF^`L.AěTy }y1x()M8qtxJ3Gk<4-ĮƳOl'G/m`'/2HѱJdKʮޥ]GMA 0:68m!33myg `ɮ(ͮ(Aě5xGKFcy#o%r:,hm1aܾ7cnÌ 3,1iבw; <mR}ͣ%%ȟ¬0O8H|wjat(4u'm;=KT+}Œ7È~&=CYR5ș.{Bx()gQp,U4EKoPKFڢF.dC.FO9vS=ZBϔFһ޵-1h z3%đ-!ftK(-1O9vxs,!'-y; Ż%-Zn 9]vK[%( )gαGK~.nRP[h-K3hW[[% )gѿ³h.% XRĒP뾦7q,)ǐK\ ,<mUTS H<ۓ*y9"c͓mH;g |w:XIKh /rp,G;6<2A3VQr̛$Ȼ%U1iĿEKoUN)mo%\F;}*8-Qs`%[a["m ,oXEqI2GK,^Y_$)h %4^K;W΄@A3VѠwͣ%0wK,@XktKM{ۦ؟wox>c'^:G_ECܥɥxUKt%tZ]%^)rzN']ƒE<|SدzH㫼rZ@~/$No?󺁇\r<]KH\H`q֠h MS%x5ZM`= <mUsm`\%-1գ%-1h xƒ%[e>Zy>}*JxifyEKMA hMTNrK+CC.FOYEQRmJhWf` MS.d@]-|  r6}*fuۥHP[.oW:Bu@[]>3lOYEJ7@^R1OX;>tX;pWͺkǒځsnX;aP(K~( U|U'L vN^rf9X6OWP_/"=1B;~#[ƧÝ8X_b}ztl#i6)$ԷYp=!$Wc^gVnR4v{sCs%e@2 ꌌ QμDQ-LGt@嶀jg^ypfny)c- y%ioyu/iΓIJgسz3z 7"iOg[QӛQr0>6]x^мDSeY8*z4Ոsh y4?viY|{*4?m=b64Z=mW&^(qV3)b{R4 aZ4h\[ﹶ`!F<@>`CѠA xGGрh4&Hz4̇F*30 n?|||!h}&I* YblYW-uwZ@x [<#NaQ)R婘n4s%7MI (ŭXtZR=:-<m }$ϣ%7-ai KMoKBBA{ A!=lq.'smm:ZB9sޞRuAÐi "alxZ]67!K,tY\'֤]cɭ] ;XĪz3`ԃ(t{\ kҀ.zbq[;t,(ؠz'TXUt,=& )П kҀ.zb|qu35;i\5DN6Ik$]ĠII]X*eJtc鴀*xb;b;^7 Q&5h 04 :5(ZxӔV^ky ; ;Z^7 Q&59l9ZBKXwK9Zb-GK[ĶEKl-nO g>OJ\}nsxh ZK9 Iv]<u/ aa=M v{?m- M=M 6WHxhZ"ijP-袸'Ye/=/-t?L $/ī%e/ڤ䝸 Ov`0}ͣ%;4ҥ]ɵm˚GKd`v=3 6|}-O nFK켵-vK}T-A<4w,Q-8ƭ]Kr .rч 7f6q7 8PU( (= s;]V0fN`MYOp=I' vPAd~(xՐxNTs1)j5@=1ɜ樿&e)`=|ii]Ir4+ҩS l[@G<[[xr"zRZXZ`/+}^-o j$,vOsb?=u絹{|/;^ k׶#'zZ=ctioxz{6\{mk rHFm>=}\ěћ%cvsXbF ލ7wQӻ-"5l<.o 7¿}/v8rǟӴp#Cq~x3lŕ&7o?~پ(Q{kY!~ջow_?vhg"SCc}q?~}~/ROTthпhdJAVm݁ *uF=('cS r"><'ҿd۹it {D/a]z)eI{eTAܡkF5>{$4E#1v;!덥.mtO] g.6|O\l=m1xއ!zAV̋:.>knuV- x8lހ ~9c=6pp<8n`@:EF#YEOG#P?w=M~їo껏'Wxs/_g|wwWa֧٧IlVy2indH,/iu\7M@(nzw}wْkzT-4k$rӂ8r89Y;9.^Z{~Vd83բ9gV =v\K3f!LeɮiO[[qkh& #7<%y"K=e^USA5r aYg0 gI ~ӝ?5H=gĮqY#筛{;@]IB}c#T5ɠ-O($k6ig &nS.~6=f`#;؟jb5b˿ ZRi4ţB:y4"dc(h J;t8y?nx0@GO c5sFl;(y+ ƽ`)L%nKIɠ-Ŀ^$ l[.|!u縭 a0w4q`?V=gJٗ[n9&>X`VymA[@50h %L6IX\SDFf`#`؟C7sF?@8T\֣#C>{( xk`ZT##-ё#xUNwt'#ot;w?5@=c5o|cL91%1 O/h G?ƔcàSo~oY ~r>`SX M;=vռmAϿ6{/n B ie>&%>1BlS -o~ZCXO.o>7n@k'IXIEfc ! <ֶ51d߽{Ak0;Vь-r?i}1@M\},VV>hl/kN6z6nLFF9h$u|w_<]>˻?(sޛ,)K#?VEO;ܦMnH/w'HO<Ƃendstream endobj 319 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-power-1-0_8.pdf) /PTEX.InfoDict 309 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 33 0 R >> /ExtGState << /GS1 312 0 R /GS2 313 0 R /GS257 315 0 R /GS258 316 0 R /GS259 317 0 R /GS3 314 0 R >> /Font << /F2 310 0 R /F6 311 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 9592 >> stream x]ϓ%m_&l*qrEI%R"ڵ%!73of{WKyS $F//w,eџoo.O/>|Uh}qr~rWWA#Mf5L(k/!--\Ҟ+wx"4fUkN7BY~ <.<Xsog<{`[)pMtMKkkx^Aޙ'rݪ{Ba< xr͋{@aꔢ{ kr?m׺tu 9뒜 'R. UpvO_[[`l2e]ο_|ncu0O%kiLlX/u{?چFbAI1er t^cd H&F<_lR޴݆qvu Y5n ᳴ K:R>^cqJk6 ,Q:Q3ٯ&; k/6^Ȉ,dS/P<# zjVK}^V]μ«Hr?.v~k#a_zsdP" !CTh FAx-j X-ͼ{^+ۖY69D^06o~'  "j Jy= %Ҷ^}mYxm2]:t}wYI H֧Qd{!m[Q@4|}g5npD[&_k 4ixH Z@R61u 4ix&_ n[51%?&bc"㘈ɏ-15ލ~J"mc4>c]d^eĢ7nj2kxH Zno]Kխ3I1potM{qE4CR Sdi* VkxZ+fگYJTD֚BsjaBνХwCԪ,ڦx=cD}[^mk ߺuF+VS:Rye5VZ8ᵀ␵IM#lfם"b! tF6:XlS yfJGA:1wl W,:R~ҵU/3g~G0,þٰW 1V?~"]G)*R@nno׵UcYȂͻ[7P j5l{6D,XtY(T,Q: +տ4 =^H l*) h·;T*^F¯A`9|=<,RxŎ(3g,xCe9!|ٝe?_v'|xj~xk. * rr‡vd$ɦNx`U<ZANtۺ (8#'ؗ7D64AG6g*i I4JVkIW6Ki'OMI7YN6ɜ(*ЋtS6&64!xlOGMtnhRZRgM$q te&Mo.)6{5 r8NMP<%UZ娉v7t [IߧĨ>&ʮ+rS *5<$-!k`uoy`6:/N75KgoZq:_@q+cNk0byGol,r8S?ح5oxC#N 5&ˌkL\qscq">a4XdmnŰPV 5&vA j}v#gONm"-՟^5MIY +z>ľ0nb֕Ja7JyH[J_a7;uu/B i ml$q /6Ki'o+E}KGtQ*[МQJv0_n,A7}qo& Q8MKPpĂ;6@Qt(kT+( 7!n=d`f3lxk3z~W'CضNVzt⣡A7!8U(8NT@TDa` @xCf5oX]=:r U nz^ML~ F2#8ᵀ  Jߠ(|!^xło^ t,,n׃rds &|L3'lAQ &z-}=+g`) & o.]-Q&OShE3FFJR6Xt HN"RҥnIJK' r:뉁%Mm}]ٗ~I6pN _tR[ˮ뉱$03D P=xC0KADm^?܀z^DU7{w֍}gL?à$VLFA,=tJXXàD& I6龞gZB<# zᛍMi_PW4Tx=/hBNA6ry`Mmszoy|=49C~X1-r%9kr3|q= μ7&н aw0f^bB:R„ẗ́kU`xaUn@y=/nSaLT :RUa5EVWG nz^@~І !<cMޚ,X:>T'<cy^ϋ䍭m/B/+0Dn,)J~]/CA%֜jKynl"N\}` |/xݸH Ȏ (սn0'Vx"g_vɂ ü #72fX9LF0/F QL~u:/m=>gG8)՟bǤ[c0kf^2o%EOȖ^MlV<p%dZD!fy |b$N̜'FЦL vh2OF Mŵ=د: O@ 3(Aa jgP̡'Fe8e: nwĆ@. 5ͣv4o%AծwMi+$+W_>oBZ@]>_A]u%&8]ߧo.75Qea&*cLCR'Mh8-i,;KlxZ)F{M&ln";UkxH Z˚fMn8M5Q7|p_pcLlre/1QҠ5uֽklx%~(z}jbqاuND}g:ODyg(~᷋uxtY|5G~;?u[^'^V?jd D&b` D,^[` D~vc R0;on.Ò,6mw(H!f۠J^6<yݓܐ6J-d_|}JjlGаOhgfW͸UkxEd3hS]ĀrkxZ)qS?8iDžԾK[&WII ?%F]޸Z/zO ({kC &t׸ M!)h1,J>mv(\'lvNA>cE뒻/)LYg%& /-L hi 3vQ궮D1KMo 1A9iLFc%A{< |?BX Y86[86\YILm=ꎌ_|r'ٺob=`*CM32jl*5xKĝ fwd=Kҧmh=ߧآqgzC+b&j/4MTf84MIA hgC+)gY^Yw> <[oP/EG5ѯ]M{"3p񦉘&x6kb^<M4SlQq~ah &:NN04qX'7Muⅶ訟Vh[cv^V(D&hM8]ߧآFZCxkVD^{r*gIf.hCʇ&`}.-QR}UJ4;IwPÓP綿ך+5%d{ZgKZ}AuoAֶɗN|ƶg/i&34hƭB^īu{M]\M2YB^S>cur#=n&ixhBi^0nuhB6M 5M(~ȾE]E&DM}2MM&5}i" 7:h&r8}.G@5!&54ף&:dWZ7B¤ ͈md٦ ˥mP=gKvQY$suNIeѳM~J%Yۊ'_J;}.wu+l@_Vyaq@!ᶇM_z"JM<]5;ʤc3nzЄB^īUw Zk%\h=ߧ좣k" ti" H&X1Mľ5!xD|D?lPY 1h"ӏiIVnQvyem@>eE)tM{MUu{ UkxߋEMZhJj SvQv{4&XSq[/Zb=E.X66k))⬉U^Vh;:ZI⬉ǡ,L;iwoE|$ݘFlan_[Ww}{dMbؔ=D}>/'^>'_Ln$[Ƨcح=xjO>.8v'Ļמdd=uڛoO=]=KZ쿢/<6 X+WcI+8}FMb҈PBE#L+eĮ xH\p="]5{sZ%vo~.JuTklxp Z7LJXI,l zIk>h6<:ɏ[F*ٷxJ$Y\f^3xXJKүYQgM[^q~,$B`xqFG  [o*M}<% Εk  /G2i1[ wd0ʗp )cK&$ qS & edI 4ixZA͚"&ЄB^CRК^6kLYށ&e&7S9}bK4!󦉒&J:jaDM^5їcjBҸ&,ˋixDO SrNshl="spGqbB:6& A( PkoRM`9^OLn]`dS7T OG)$y,m=97kL6Un@x=1yL󀂺t(NxbE<ҩuDok.Cx=@}n*{s\Wb, "㝻25)|ƒNue-tr` ?6Un@x=1ҟ XՄg5= i I h X;iugl_|TyZd$7܎|xH Z@JA4aY=M/zO gzMĺ51B4&Rk"&rHA`4{xMkb/GMS*i̚'D&5Q&7zİ_gA$]wc? 2,`2nWa75^ 1`aG@o7_~w: yA뇾Ow#~WscB{*1G`Rcc}TXAMAO O 0(H`SЩ;ң~M^mÁxT ]%hݴ=erɶ͍?|\>LʇE|T>HE?H}%~[#e#[}{NɚWo~U],`UL(v?*)Zcj$Ccȅ BVȄY#2Y# G`¼h  ~>Yс=>q<;pE/ iPeV=/Ǯo_Ԛk'*,[_͛o?zo|˗>rk=N[J󃴒L'eh2& R=,z|ڭ 粼/!IómiZ=0;e`O[rkw>txy/n_~0zi|jejka-I -`x^>G mJXxo*$ffip6+)) F6Ki'}:;IS\6_'EzWaϙY?`X脓-$~}J6G'Q;I!?-w$JTҮ;u|'VacPF zь*ꆜs&@\V"6 qEX;)Z(;x`\V"k#ֽZN @\T/Я>wd(%yGFHޑё<κOP 찿{ƌOļo/яDXc, ^֣c ޏ,ޏW7~o+Z~r>a cP /;=By;//ƾ;'=A @P{>8/7>.& >1Cc=^7¶UmY_o]$G|3&iYp?D8Ht=#iIf&B aa8-d汾-!3o‘uKr?iy1s=~ww$oziZzrѠ}v=DzG gQ /#ڰk*)%NϿ>~eVt㥿|+ʿS r)n3:Sc˛Yț?ȟ!>S>*Ҿendstream endobj 320 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 321 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-power-1-1.pdf) /PTEX.InfoDict 37 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 46 0 R >> /ExtGState << /GS1 40 0 R /GS2 41 0 R /GS257 43 0 R /GS258 44 0 R /GS259 45 0 R /GS3 42 0 R >> /Font << /F2 38 0 R /F6 39 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 9229 >> stream x]KemϯKik>Te9S(dT兓2SvIqݷ{Ό)-v H| N/~K ?[N/F~7o_ő./UzWKx}ꑪ0&K,5KµK #_ a0["Z_zUw߾z =_KwRb,.V[r [n;No׭0 _Kx>v-}RIC`c1;dY`!k]]=\[s \{, 8n e5lNf}-_Bacp]% T?޲οx+}u].yD٤;̈́r%#`H; !aJYft 6+.Ur#t7XцGWtd8bISQ*|nԍM߉tZ x(|m4snms  |ݝ) ?uwV[t=fٟ *4*a!Aw"|yb ߽(|2D~; yyS\y=WGcJ[[]%c]dl2)^KEr=ovn?f xF#(&K<^9ҝ7{4JƓ:h%TjVֱV@[^RZJkY]5vʦ=4Q1 &/VyR6F񲊲7LV/|1ZEfmrТ ūJN Q'lYP->c^t}.ut4ft25 .{(&OPТ +_J>cD{kbOT=Ӝn^$B K ?hi}C /|1cnzd@F'fT.%6[k,^@Kլ<xJeW -1IJ;q/hnk&^xxLKtJ={4ExN7LzƼ8ey⅑ʦNxŪxL75Q"~4π1NYC8?SZ' ="Ʉ? x9ôz!HlfNB6kQlynon˿lk^u+ %lpk 6GB{nt 0ltg+Ϊu V:8T~7e02s:eS'bEL٦hgtDes14Т CvdTK)-7lZ݊Wv31J~54)48ۂk~Je/h崄Z4xKhO9}Egb)2D  9M/4tI;|e34axKh% d`X.MDJ7TyB1 > `omV&;>LY nyL@#Y\eܥfeb[+58O^qmrl,ȝk̡2>#JD21([f'|߰:;Ηj&u/ jiy#vy+Q%l} ʾJ#aijDתjS r2óhⲝ, iz|Gleln+_JYz[dSkv؏4eqa_ryߎwߏ*c;\F MC]ڡ.|灠mUnvh8tLqi90 WX lŽI WXw(u8 <0Qu}:#omǝa^n M恒~o3p &˂>ghOdtVx߈pVZq&6V_6gefPW ќ獀SرF@S 92'| cp |-_|˗c򹬼t';7kBެmn ,A'@&D>*]츬u*VQ:~&#= 3US ,:$D7(y`HnzkIh` B(VS:mՄnt (5MWShW^O&nFBsy EB% V-ȿG߱A~ CJ=sݩ+dJ`ܨtvH(טn#!Qfӣ ^p&%zlNP'tV;$"gV;/-99Sx?ם~?քsϙdfZ5a _y9A 9A9tX<'\˧Z>C˧5 +,:ݙb>"b!إ4㲭L Qwx^jUnzS\4d |> VS:*9HiB;ZAUnz^"|>5'|jSsnZ"| t۵&+/`uՄ,USMMrD/S̙^b]5 ]@ hv&ops=H|&mL n CvuzI&mjYXqMoWmcm뾙--6[cfݗsD]duIw{5mg]WזYtY256T&uC^CqhF$OV~hidi䊫EF;^)+7Ƅ]q rHҁg U(ab)Q((-7X[ʗz%sB%ړB鰅ړBPynvslk[VW^KܘPLw;L'F*C4/xLB hZE2-!%$,/ĵ))W&ґ_~%W >QIh)}cSPAs ȁ 1#*Л#]w96|ucA̴ȡqVvf`Ȏ }FV@V@Z9[9flwJ&=KEVj1nVNKD^=5ѣI ZK>>˱OeQOyMv k-!:\RyA2\8"cwM3OHʖܚ]rBu**)1D)M |Af2fAP7ʩzOqB&ưBкmLūJj"WFC[ -P|D9}*^6i'R'X{z,KB!%^h#숧ZV/|FJ&\0nќ &IAPĮRl CmlͶmu | +Qu9MkpSɱĸxe(47 wk7 DnXE]5QMEMEuDGM |gN{M~Uԏj"jbG  ƫBJ^5QPڍ+{Jcu ލ9Odu凴jbC @K&MҾ@R2m(E j6څSV],]vۖ%FW:$S T16&l-)ZqAInx(UTK5eʭ@^U(j(W;de35򥴞SVY:MD,16ی}IxD\4.NiĶhb{Gۢ|D Ai)w妊rkQ(Mū+3pDIE1v W}*;wH@ݸ)2)yM/VYLwS={-&*Uԍ n@:O D̓2ܨx&m@CZvխ9ߧ+W+Y6hY;*e{M].[弖]ku+^RZK=YX#hG#1o_mOG"tfhgFWY>䓀$N".y iGvO=q/k}n仼ٝ|q㫾> f*߭']}]be5K=|}aMq6Zͼ*,yU(Uekܖl_Xvg6ovsPlL8>~8uG61 mA(mQڠ8i fNK}g/ pw¯efP% ֦B!Z4)?õA)xmȁm1ʤNhkw๯ԱefP~6ԭCmŗ^5/R V" h:*6 /\o);G-dr+_J>эBD7 X^x*wOLSLMp.ӄE2M(Z('Rx/7~*qu'i?I::hbibu'i5ђDKGM5':*i/^wUɖv݁n3,^@'vùn7hvm89^OM]}C Y gYIZR.Ϝde@Y>-K)W(/wM ;LiūJfbEJnɤ({=^-etv)̍|p6 Fi*B;R뱠-Ĭe3i4':^@pxb|t5Z,p\7oVE|)DKRhʍʭ[)TERЪs@NiAWN;?R 4QD^%5QD^CF|sU.Vt2Z&˵N}q#ݜg(A+|Si5<ױ. h4z3vD2LR8*iÄ&,iB"j±ьæYU<څ]>)Mk1g)"8rƭ3i gMʶ`sV9>yBe R 0bTșd &WUɠR@+!g5J9} E9h"%&^$B b4VfVkxKi=':P5QL5xD^pD D\?[|<üU&Jv~¤QJS/yDn.J 4"{9xsVJh9[՛o.,"pm.wlHpToonWwa4՗} .D7Bc97jz.nBq3nFsFfތm3nR8kڝp^hXt%y{e[,:;|/.KA.A.ݾ@arvb5cLHlmZ=מ=WK~יּjuҪP׍zƫmRg)||O'": 8OcuqH$IHly]oA6f sfm~@u,6yȷ3z}Wc\W'ͱ_9~F*ߎqvztGDQ@.}__}uʎ/\  Wwo4wG{]S yfh>iLj{ǹ N!oƀxoi[Y?QbB!KsEZ{5hРTcs9t/)8dw*!'v7Ζ)O[\} Uھ޻Wyw*w;Wyg*/UѾq`0~~p=Nɶk]"Uq Lq ]i3i #hG!GŞ3D;(6zFQ ,CYBY3-K,~GEndxQ ?}/?F0[قx뾚<54nB."US<˔/l#5T0jg|~|d)o/ 3gx_/_ƺteºn>>H[NMJ |!14_>">,7 wUڿz{'R={;?D׵0$c4'38ASt~gԾHֵ_&F8PwGws޺9?e(krH,_z.7y|]i5s-EJeқle ĹnŃ/]&C#̝vx7ę% No%=`?`tyu`,BycMTV_*xi`R2gm(;<څ':mT-~r>`sT [Fc@ k{IXI VZlW"a2k݊O(p[1tUu4q`?U=gsGcqr"+s)~\a2 K# ;J R6Vl.0;m.|?n+j #;؟jؔSE#VrA2;@/rIX)׍шK+- .wq-9D _O(Dt@b@G?7nПoyz;}Mvuxi` xCP3d;W8ʾ<xZ|爽shg^oxz͊_юc1JG;Fގc_+e?sOZ~r>`sT sN?21o?[=X1ZsF XZ?0{SY/pX_G!] O[(B?A =M$d{/޺^I7~1o0$@rZGw6&$龒B#,kO;޶5afo߾}Qk/.Fjcj$ʬO/ӿ}~Ir;35B^76J)nY*ϑw$m|T'^/4endstream endobj 322 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-pred-points.pdf) /PTEX.InfoDict 48 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 51 0 R >> /ExtGState << >> /Font << /F1 49 0 R /F2 50 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 16036 >> stream xŝˎ%ɑ.$4HT H`V#͂` rחE<]l-#ا^xM2tV,]U`[:Τy| S-X7.#+Μ*:UꙓCscT/ r$SEYW6͋r9'9)8{UXLT%sPAR9Yu%S4A'*;ZdJ9o( D ( Xփ'Ϯj-gX :xQ (!wRpzQ7hO"WAG}tϫ+Оa E]KSl6QDr>(!G13dZ>(W| T/᥌JF4V~Ph8\bңUA5@ƪsrP {?T4Z-4G9(N"](5߃0v n߃a5bE!v(Rh~;j7PAUPC@oAjA\T%#2qy-,U2dV[- )= -$ [ !,p6[,vm未Y54ǭ;G7\AHAnJ"N^"Ffro\+Y}ֆՎg]㴯EV 7V7e;>U udu^a1шEc +:bm&,Vҿ BH|t"Dkd]*w,u8Rm_U.+"J12bIg'YW$,T뚙Qa]4'DrF@I"\PT /Ft~䪖[ɛ,LRCXa;Y*ݎ7[FlXRm|W^*cFxnjR&.v&ߍ]).sAI^Xv HNlϻhHO O2M!8 }[DV/7 OYt` qoǂSpȧmWDMA*-AYDYxriEۂ(IXREXI&/Du p铂P'Yތ7kĻD$j1f;nO)1'PpT}u &˟L_DWD# U,dMȺ5TmE͡B{cgw2k!uM 6yk"] s(xA\J^}~e|TD{b+ "T >9,*%Z6`Űpxaﯪ{~\1urx搜صF `07y |]7ba?Ʈ3ydeK6e[UWʕ\2g~f|Vxb|{{˶6 @8rbV50%+;. \m(C5u<yc\k[\xȃ")\/ȑ늜x 3En+rS^3}F-rO=%ܯsD5r}n)rכ<n;ry{8?xȭG.㓿_+{\K O91/pY< ;yB$pNC]=4Qvw1?w 0;|7QY|O+}`L>v v@y;J? 2PABC?OR^~K,7O?_~ӟџ?YqydOWw#/7UFi@ӣ(/=4;Vs GwlIf^膄 ]wUCUSMv"3_H̨ZLGA}n3STt!-k؟o,K|S/rqG=`Ox;}sLs7beɦM[Í=\uxzLy:mG4Nܵu D GQ6e״SzxA :%钠;ГI}gi=?rS s$M))WP~"LM.;vYΣXϷQ؟ߙVFJ~AgmsQ؞>YϨ,ϐ-+a_]{B ?q3dSߟvg 3Pv֋) tejZFխ*^~<tM%-SY;þ~|3ߏ}>ݪtvs5}u=h"?gCJ@s~?dџ0wu|vIל^=d>팳 nN$gfn1}dsJTs?uП0X:nRsIB]H{?-(( kN&^@fצ<+0NBl$,[tي9%wYa(I",a-!:"QL\\,V:/p*l$,;R p J[ɒ}ѬľicLQN}Pz ˦4Yd'Ȓ7"]-6kpX[~qg&a H2g' ɲ->v\;{: vQ$[o6[ZH]d¢|쪑h!/B2Enf I"Obp?H b!cX󈥭#lM#]d4"OB%;.(jb5Cd2/y:̿413:~#f| WcÊ7Rt$cum!fr#gߤ+yC[H.VC. }1X7W]/& XXiZ)1,ZTf}Hɚf625 lhYhOv.T32b55?&+c~mdMb}%܋0o# nZ,iwkf5;,_񾑂7MlmJ* }7F~ߴhE!فVGBydCjWy׮$x}^%e ICif)ڥ+|^މQGTyO6/^7>/\ :ER]8~ǎN{~S_rh 'rNNp>םl/pI^ÿ/sB:<3^z"o/8YϓE7Md"6O'a ¥T/w,~(׃ڀYQ:0=y*|KWy:aۼuw̯!O1 3ÿVyb3@V!fO,'YjW .q=.Y}ծq]"OX2]exxcAy`s9b1_^i?Vo< ~Cb# >vl;>/A5.3!1~~Po5LĔG Te؟bo70zTq?bKWAawA\1󻠈msvILW&J}WP!7=/I&'F!?e7YXBSP7L? SRb׏ù5R%0 hq٢vx%}E_D{ZO ܍UL+iYfbE1+*A(7K=Ӥ%&k; wa a/jX;}.*iX}Wfuv]HdW~X_u&JWSW"_( nw{u6./rzfb{EUFQl*kCȢʐxZe_?O15^yiUU 7Ÿh(4BR*dcov4)iY~5*O_,\Rl~ &n`'oA_w j++>舧&FjD +_"?Ko3Ϳٲy/xZfTXUf3SCسJ@?-lT`<@[dWy"&}YJ$fW;.?eo G0W#pwnjZCz#rokx5rKs{92#yw O7^{D{AOx=r'+ӟ쯗"}EsKȑ"y?9Q/{-r'LjXx"yzsW\x~sW\Oyn;rW\݌ O\z~"{o7xz=yȭE.zc<=>O~[칥9\oY>#)o =91fۈ\j7,s-[=:#}5c<<}5c<oQ_OzDA_OzGAfY= O3Ӭ^siV9ӌ47ixճz4bN yAst8=NW{׆/.y ˲}_uk{gw;qua쌻a쌻a쌻]ؕҁ]_* }ٟ ?c6|3Z7agdZ^֯W%bxy|?sg?;I?dg ݳ8JʚYY@髅BSf;3:ܝ |}{}h>GM4_7V}L~Na޿O{'}{mGum]@w\S@ x/Fj-f@w| e=q/F75%[$:}]wt:t%q $>f@w791'mNDw|bˎMN4{6:k+hMQrp6g%t e&#n3ZH8gk2UgX;)`GL+LqjZYv5cNVmmX>x+ewbGe-|Yl($xڈa o$Pgue5ioM<2a3]G󚵥My,}'mκlmM=Voڌ _Dz6)(c&eAIc[դA)|#}M"A$} |+Yø_gbC3q$SsZ"Q,r j^7v]$iS*#&]\y46hY;;,7<:.^"V+{9?"ߍx~s1fUJ괫U1+Uva PZQlWAr.4^UCoYpicnwL,Z] q5Zs3d>ѭӛc'Sݨ/ 8 #גWYML%УFX ; n? "ݮJ QGVF]юv(jM)6VqJA 冣zk]*72*!*Rj $4 ejh,6|WS"7jûoՖeyE"d vKL6.S9bJh":5aE7}蘪3 `Ѿ'iZWdp} gX}VQhҐ.%\ 7u) 1jU/5CCC/_hү!Mo% @~ƚz~}ƽ"kakC~p% _mq7m 8rD{a{8[.R\~,rӽj ]X|w'FwM'R4q[$; >[р4Eĥ(:KPx`n'o((e Dc1oW/* YsXڅ]50StM ˆg5P7yGC}i.TKpPKTl5Nak8{OR<v-{(ح¨)V;:bT_8cCW(ґCoGz_5:3644TDCCCs 7.glt؟Im⪷3644t9cy9ccbihhrƆVU6csRTP1.)`r״'ԇ>'E/,iyWznd&U/U^"PR9954$X#6xS .gljh$S۾XQ ]'D7gDa#cQ`^ u;ch|9cSCC3ӗ3ؗ3f'9h!8s$36'/ݤv؜I 4/hh]DIDNĬd[ 8i[/0ZU^*fq95#`s0V3kXf8v;cu-59559`og \5i/Z5]uv]ӵkHлBCлBCлBCD;ЅFVzt#J%sau{#iߡ݂kQлkZۭv7ѨD#ݪ`w UF6 %Lkpg=ړ'׿p>bܓs/T ߽({q 7 "{5ٛe'C vQPgKa Tz5Շ#&8ң)0o܀'!9yp]cq\&P=[oW nރE|p {|qM]qw:EG=o7>8K7 "eKXY<,j’aAf*5W22Q%CCdRC4%k|k}_ }Z_XXBzѸz%s,. w8PCdfqXS@dfdxǣ n,2epǾz@/lEΣ lׇm7[>lJ~ho6m)efCa?$< I$xH3);;;qЋƝta̝,މ"̕drWʅ^-zѸc.J+!B/W2υ2ȡL"0,ɡW25+BCLL !cyJ}k|q9^6ȺڻMf}WYMf}WY;v7sEɷy+~Xڳ{[C){+o(u) ` /Jq_7_Gj|3~~,I߯&'~Ua=t~W~ͪקxL$O>v˧lu)JN `rN? )ٍX\Mvu获n|<$b8}R˘sVkq]RȔGwpޝsw]^ǁܠ8û7kYї*\)3VGhͲe'Xem#}o>EGݗ!=CGQ=z}@ xv?Ոendstream endobj 323 0 obj << /Filter /FlateDecode /Length 563 >> stream xڝTM0W؎p!ۤmRT GTP$73@8>@ gD%W0Δ +>g_תW%8Ym.Z0 Y;]o\?f>wj,%2|WG{/tl1b0; Pc 0kx1ΙђL4;=sP3x<'xp0KȦoZ% {JݙO˞ͩ]kt8?onsH؍)i*QIJU[T&.pOʦr]woF*ڵY(󹋧EIn 9+w>){_&H]qAԋ藾]vt$Ho!WSGk n"GtK_^uncY0$ ۺI,[z.eF"oVJݺ 4G&z]4_BGM`Dm}m"_xۮj^Åq!IPr)s9 (SI3endstream endobj 324 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 325 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 326 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-cpr.pdf) /PTEX.InfoDict 55 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 62 0 R >> /ExtGState << /GS1 58 0 R /GS2 59 0 R /GS257 60 0 R /GS258 61 0 R >> /Font << /F2 56 0 R /F6 57 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 38203 >> stream x͎ܽ%Io%'o4T -@)@-ǍqoeUV\dH#h4Zyo?{ן>So: |oC>o~~ya|?36Ųᓬ囗u{[d{G(p:Mo/XP`)@^ηoCu~aȋpJP*W$\߷#%{ )x_3)/IM)Vג>E- ܶZ\u(k@?e2{O0luخuUDG$SY:4˲jc1[p5m-u(R+5"ٱ9;ʤTDwŹ`I'tYڏ9[K-rxo~HWY?TJ,_,%ޕ5hGez#sF{lpTbW>ޒg<%_R/%u~Ie/U/,⇖]>RÞƫ|rÞƫհkFŀh² AGFÞk\n҈Ѱ4˲_^s4~ֿ6<_^5{#RzzTReYk2Vvju!v_R| !RaF?V#oWkXֵ6يI]2e+iAx&ϼP9C-9U0vLcv -~hٵ-#5/{K4PaY#RzzTReY/XKׇplZqftuc҇nWKrS\ XRkd;WXֶ_5պT>z1//s`gIaem}G^j?:}S]r[ZIwCkyiN*]·_1~|/Am'CZv-GK [T#~憍Qg)7kH\ H XJct藧bopI@h Ԍ.X[PqzZ"XRSXJ,k헢=oE2b֯m_گ+Z1~O veXNmN3ʢ=`?M¬uDʴ!uņ3R&:5vs=4ʋ]yKi@eE,W=ܕiNm,S~Goi 25nA!!5&r6];d=k^gR4~XGM[O%}雾ZVխ[)pmqҬ!4`Y[ v*RFN󨲶)%7SsJNֱ߂I{Y2[cni%:`:&d)L 4G޵4j^mpټo w ~OY4yG.xL55EmLKژ1B8ν {~snSY蔛e rlWߎ=zoS5OQ6uNݮߧ; 4mo+84cgㄏ8$_]d0ttpiwih4܎SLՈN &S:]:|kKVߡq&i|4:Kzȼܖ1mL v}ȰLxaj}5I# h|5ڮS>aۅ3;ܡ;4L_\YPC% i|w#wwD׉O۰eqnW!~ȭovF9~lOy'N'䂲u*A]~ =;pL7.[6H;g$U¿O?sYyNGՏJPuRۊҷqWs6ynιh/8J9JOl_.s|ںF WNյ{68?+yӳ،rע8kb/*ċwO}ٴ?`~byΆ γ_xdYz*Ѩx=(/ʩZ"["mo-̮u o*?хNXbe9L`&L9]h ~NŶ!>tޒ-ޘf7vsmxze;XGqmGu#֚ˍCN GC=Ɨoڡ ϣ{.d[<8S$1:meڡ ϣ{&yYzE=]CwhCéhZ Ce& U^!hcEW7~_G1/)L'뗭g'񴯟]Rsfkﴇ42+,R[ps#3}wY?_XbZkTNcQD;L,`IG&Եlm%$eb) 責}fD$l Ah84 5&X##?o 8$_YFF.%KWq4Bz!b$͵:ۋߡq 4I> ):-FfSrْ[v.&R_hx,uA~;idM,]6gʙLٝ%ί¯NPvm,-qJUTvKv Xfbkn1-7;XJL$rv#%ruq]DHhaS*5ynĻ<65ygw8 fbk p:y3\wy8g@46XXo:X/L|҄T/@ԇ>(=N-5رuyvE<әe KUh4STeR KC+' ːKCoȐ9aHl"C>1s|j@d[s Hƕw $5B';Zy֩[ZAέps.ZβUm!Lw̢j=m;h8Kرs+عV(5gTGkĻ8Oձ_wm?Zfk 'Š!E vh85| &fn}Ƀ= `S}majl7%)#9t4i:jh;4>îphK}VnF7qcXܧ>>XHTή]1#Nb ɢÔd,V^GI IdwW)ᱮ[-;kcE'v8$_k³"X Y&yHd>}x 9~jA}$z0OmP]8賅R? iL93%lIYaxuSY0ՁF1s @J,.=qMTa:S|QeAL0 ?gRd?G N>  |E/HqaM0uk@=i \SAjKٮ4I~;idMCzks&U`ܳFAj eFA.~g2&cQ'9p{+7-pO+c*z;nuҨs#clt"7: 7EgEͅ/osi+`$UFqM(5` } S.;4ej_3 kU وh6"DCSfOOMWODO7^;&rmKiU%g@y]\33, 6u}K (FFq1o!Ir<w3בi@oHQElQҞgjb{ȥXv֞~y)vEUf:➫waㅕ%@r#B9aa* NT|8|P#\4 %KcXZu  GCui4=/gqъ'{WrYիP8NT $O {W-٣N|ܥ& aeFs4CN GCŅq40 > kCéh辶 dV+hȬV>kvhCéhz,.7F8zy"YR w=ZB $zl/LOo2gAfK6N^>C^i>|=ءٱFyk8-5g},8 iJpҡ|}@ݍnP vՀIUx-,`\#^ ~_BIF> HNa_lp"ĝ$bN`/ _IB^ę Y^HXAb.fZ;4LwIJxì:&~ln 8Ȱѫ볼K\l@ F9P:!5hF^hC~FAX^ENfd5~6c0v1b ]c% ] gF.@nqW?97A=v;P0@! g%!L`W9; q_u:uK,hsDu(0#Brk\>YI!vuxwaW{\.Y>9NgsלS;8a{aiBZ,sylk{4!i=%u4cR1b7ψ_coU1btF9[8kc"}Q{h\|)wm!BpV켧YpS;fC2,H{ Kxma;漮t̯iDA]sXK~`Pu&[DW͏͏R&6?vу]6N9ǰr{|~[oT D6m B~g `"+.}[4/-~hٵ-׶6`s56KCN GCմ a{!9 KC;4ءy4t_^>״[_XpeC4֗6DYmT>PNTI?Oʸ7]y~Co|׬/X$Ng\8BeYl/ Aᣞ;!ݎL!o "q&;iۯ34yƁ#/ h|}s\`twG"(p.u=a|`^A$l/Auxb%AgR} l4/ EdM~25я'*^%;A=Vp;N7>Enz䆠Q/pc{Qw@K!n)Hu^ ɏGx,̔g.o b,s$U`ǻ(LÓ~ӽ ϼmؖؖtl+p}e+i?{;wwnn<4$mr4ei}u%=urZ5&\ڔX!*4a$5GO,,vi.rGcd wȚ(R?{J7;ŌNW7Ǟ]DRs*}E$FdHFyIu^DrʞDPDE{D~E30v;* qJ~Wi?Zfk JXǕ,œ+(d5CN GC} \ȷ(W;y>{.H vh85| >$ `Sgw_iHP {/(I,'X tb~\y $Ҁ.co4J㩕hSR]\Q,[)LϪQ93K9rmT\{l9z"Aе<`!b k N>aJtf%^AB%Y{?ޱh:2a15\,GEX+T4!m b 1DKgX,|3$c 1 oh JYZ,@*JY^q6O comyBGۜ;;~mKMY襦Z87uoGC?8P_Shk/Î5簋>069XĔê==kW28ܺEJ!í#uUEZX繟 ڳC)o|GH?Vj V .8J9f^hues:nՑ!$8i)!%JG 8 K2N2;tqdk<#\H7c(/ OB|N^F:^J:iH:Ӑ8t1R 77׶%Ȃ+*EW c 5r~hCˮehi62E7 nC tZвk=ZگML~X#$79~hCˮehi{N?k;^'J_.PTxߤ%dEx MeM\r^jzֱQUKQ&I+<5!EnkjP)1N9bSfb=\CS@MOMHKx7NRS|t} ,w:/m|=Q|EO廙G/meO$S7񔋴ܝ*ȳ4>r;X  ySbeq:5)yQlq5 iH,]Tei_*vÚBͼö/YϦV)/4I=b)責*x2}%5HdX(01#>1 :#׈G<4˲vԱd⃱n⃱eϓK&2G]F2I ?YM yq rdHT1B*72USUuSd$2%1񧦤[){J?ao v:&}ep޽~7&@@6,a߷eeѰrs(so%|RO+P2U)0ULUҩT$|,Ih۫&xm_r xw+1R 77}E"c$U,dj?ZfX/R'Qg)KCZv-GKaBr-QvzljZX.`sgвk=Z.cO0Vih@ ^Rs"-eWH\X +7 ]ƪkk딦5 %:iM0w7۶2V_cY+#`S Xiҙ@Wi]VScz2VA4Uӱ^gslnY7Z<㯽\]-ZG雏T_0ckי[hy;nh 6.Aזt]z.hKZKdh^o/I[{q 1=2g|R !+IY.ᎃ0U dX-2b~0YC8SRx,-ݿW|o-5O?cA>ZsGLۿx&@LW%L(TǍ9R)S0 mJqՁ sy 9bQ#&ŁH@HQ'm [+_J)e|<է-ϋs W{RLվ1F )ŭpzR=NxG yzaz1Z4KKxS l)bΥSo)\:]k/)Ea%f _A2[`e@6k]8VNKx#5xQ &#[xE,wa ii8]EA-HWpˀuxg]ɸ858yʺ OII585~F`i7<{8PW{aTtbq|;NA53OtΛ<%Ocn]2s`+\F5W74P2K#hZp|ü\rwj[MwwOI+Gwڜ hJgYVS)i]VmfnA|ZS^d;H#yE{7rlIrkuBz 5&)^%Tnīlv8FrŲ ._쌳\&i)<d_ݝV_}s\sɞ7񔋴YN?ifHngw6u%VЦ4v8N1x~[HyOH4f)}Yl*ye].4[_&iD[쮓xur6iͦu5> tmh>0NvKE'Ģwrmq[@̯l yx@Z0#}uJ o9ωG#7z*=:F/;NE<9AoqfYT_jnSm_y|]k9\s0923~A<ݥ3/(_qq|(_Eyfgܣv#[ #Ymρpʡ3_twon=p\;4t4/v"{ yMREO!^ePگ7AӀ.g?Ukbv/2ݔh6ֺ|WU~50 >cԉd'ЉRKT nKB5ZY>o)?5iϲ9U;sE>vjsm4?Stp1R 77}_SS:'̙u_jy ÍFa$˃v&u%wZ-bq|;Jo?IfF| <[q0sC7_K}t2-pywc_(qf a/Qxf[QnX1}k kSRfy[lm F%i6[d7biQ=&D))i]~ތ/uƗڲBtO ZoƗoRF5@YS)ג/λ/җf:vaB K =LDCk^h/̛xmexptM˹qP6 6h#x~\rw7sfrdk^}>{ǹ~NK(BNkk_폠yS.f;!|Oye].%d3h(e]\rwI #6󣁛$8PFl-aWS.f;?/)죰H[j3BIWǛ.NKhQX_&IE[l⣰&r6e0/Y9!\O ﰉsL .y.,)0,}n!' {O;^]wY|p؍L]%Ov1a ]uO@~@( uJsHHy0g:F/;>?>L wVr}=Q!O;ݫ1wcO4MOẃn+U.ö])Pqw@uw FG"Owȡjc,xU,/jwon=p\;4| J"{ Se# 6Bk=>Zd0k]PW;(:gqdYٟ|֥qastv[)@Mﷵ.d@&O T2yƂ`^r!wCS +D+J,xsTRR+_c(6y5k*YϞzѮ(,ޭ,ZKa$"~62,@R,| rviRNB@HB}-N-UJ)=#n|sb=Zn;ZpK1x8>n~M'5.Qlp cn7& f>!ppK1x8>n~_دdpK1x8>n~c+$zL}zinzy ÍFex~Y00@cWiX3 i9? o`/7eax7M.c6\c V 2l@1۹1AŞwN佺_yOH2ǶOb 1-$/ZE9}&IZ sSV7񔋴Y.c(N_2VrV%ceM纇Ŷ)ISMrw5c Ш8F19ߓP }\ -||9U4Kݎt0zYMS\S>U_f{ B= ޓWS.f;IFa}aKyQ ]DK(B )ia0 +o)iܝ~q+Ȕ8V+J}yH=0o))i]~2" c>W35n~?yl')Gh;-bq|;13Lcf?Tm|-bq|軌د9 {hW c? s$-G0 2}S~ֈrwc&DƁ 1"L(BmOPĐā-bDGV(M<"mدGsˎ44ٖ۽AxHK(bAkŴ*׵&&q/0Eјh4>%chr+ȁÍԔx_cM.cfl"/Os\01\贄w6]}Snϝr많\kλ 9-͘/W9zg!ƤlG/գAҘ/WH1Әļm4f)l}Y9kwAʺ ]H+h/$b@]+o%h;*|/B^ş,Wzm@jM.IWh;AX0:Y1:y1J<m*syjn\̺\bu]Λܝ~ҌSӗ9:.YW@YW iMLM_âmу)o%hkd?|Y{%!2ɳ^O]1/9g 1Ύ ύ=I7s΃rgC0x:eW _E~2knc Γ!PΈ^;C4 sCU[cCpWF:PEQve> IS_znr ?Rϖ:5jc132Z-pywZ'fi5` 5}a׌^BfFgJ)ЄZWz<^̛xI F>cGU}ATFF^jx́ _fDZU-<%%m/nlC=[8Bye].%d5dcGE\r|_̈ekn/{7{z#-!7fv]q/]OH3; H/E? j.*kR&ݭIeGv& ղxE3.}Y7؍r17Qn열c@a/f-asc6i쯁০V5SUVՏMÞFD j5NʼrwI=1$c?P{˜/aWS.f;*0 *[UaW,Y; -Z; ʛxU /4.v(t,!jxBZ|[]-^Ӗj.s5MMNc?i³߿w ~+n~Rnr ?Rϖ:5 8||~<[q2$cck$Q\s=Zɘ]36Ib~8ƹ5I[22ujد-8_%|S/NHZ&?=RDްR)i2C4VMZ gm|?2akO{)=p9-Z ÉJ5,^H=UN!!".AƳ) /E#^`qߧDO F:O }/ppaf&&WFvFfb}%Zbl'WoM_UO5m!hu;O#%Z9;9I+/ AGʎH}侭 i1oN;m}soq4ؕzc!R_<j rbB*Ťw>fˇ|>VEƞ s>c"2񖼻˵Dd~6-R,|G)G,U[I©Qik׏R~4&<2TҾ4zI )&\Yz>,Mo zSagbӸ\QR.b*|$[OZ)CP{O—"ޏpHRR4ʕze܁vиX%KH-٣KӮfQKӪΦa~hCˮehi;Bsqj:jn5MM{SiB4j⇖]vDb>W;߸af?-~hٵ-mWP+_{_\kk 8| /JtZv{_쳹1nduf'tI֮8V?rUF v#et$Q刅aF{^e2 )',!]+Z 6[ixYʙ;d*G,'MQj=U;:V7j8vm2}-՛kTQ "%/WyސS tINH4m'vՆ%d5X(@:[ ab.iur@ZJT/NTXh6KS{Q=ؕ^XtINI1+ؕ(HX(&Ttv%pMV'),!]U$P8lè\w1Mf(, ӹpiC]v2\6O2TAXE| e+$K+ni $ɴ4!+ H2-ALaMLKh<dZBB<%Y;MK$Ym%>Xj˂lcVOX(@:G B DgB%Y;MK$F|(beVħ X(@:w7Ϋ߭8$5iDd2-Ca\j@ڝ: .xEB}Fre CP%2y1bPXẪƝ5*-4"Հ1fϟWY[ Yl .42q^h;w /]?UaYOVdu>Gp3WwpOvO~^=^}9<ȽU܋o\)~ S*Tq7r4oߪJ!sRl,b@_?0e>$o?v!~Bs{/⷏NcO+}|:,eΓ*z6!~F'4Icc)C{$do|4~}&ZעzQF{xq(9EC>sxL njmTwVV~3ttW3޳tk%n[ܡX6,R:"|xK춐]xd\,C]|w%˶8qQ#|M1R 77}M%ӲݷEFm>mfвk=ZC[-٣)!۔;ٔ|u&QMZвk=Z.ì䃆J#dD$o2+AHa1NcoGO$Ґ.eVs[RFv 7ي($.~ۊdƬxWnʕv|r5%3=Ӈ꽭9b5Qd,*%&WO:F1h] O<$Gۺ<;-0~KWUm&׊r$ڊ=q᫧pwpO?=C%že"0|`z'^ 侺+ ilNsaыA~),! L(z*_8gb?*Ҍ˼93֙)g|[P  \漏M#}:,ye_Xj/Haͱ0hSn!-LWڧXو?hd#~u %;L8f±cOuk5[X/ViB:K;֥30Kg1c\ڪєncٖJ4'Jt Mnq4JW~HdWo; ݒF N?nZ2Y_u_ȁE{*O=bhq8|.}cJэ+sq/7]ה~@}2IquX鹣EWxǙiVRǙB:J"o)Kj}?i{.Ysm>0w'N;5fozZEM?y&sAlERӿRȚ?Zf;4{ׁE%G,*?Zfl;Pac(DLcl#/l7E;R5%^r(%dӗb.ՠ4g3A;iJ6":IMb}69]ƩDɯƓݩc|#{sᎷhSNKO*o!hܝoWܰߣ0š0 0t=s\4Lauqzq$;v`ʶd;I,bNǎߊW!c3SXHC$k#$qS>I[Y[)\b8qcn 3inr S8Ґ.ִ:Ti T}zپHEG$H8 zfCO1q0$"1%4s bA#74RɌRi6Rg҈N#@ZS#ҽvp9H yg½\Abo`Etڽ V={xr6ynSR*V׸pΡnᰇ'|w2øV`V֯xs`|U'mۭ[2j:RG%Ow78g}b㑼k90 (I۔w{jW9O|RG bqHe[ٿ>ҥGi?P w4xziypj,w)-?GBRx!;eWۄ)-qt=`9!?jԿn)Ǎ_?؅-S)#CZv-GK/w&ōS-⇖]vcfy\7Ðh-~hٵ-m?k(8_`|ӍSVxh"ZBn/f`r)bQ)%I Iy,W..夘}&בA.?;:esyzn̟-2˶?jsGXavXleL{kt_n|YdsvBZ{,y ‡1iorwbN4e8FSC%|2P͏d71/@j;+`jj+0=ijP)n*dMy-l[/aڜϛܿ~97G-v*8#A C9ĒU'=v"r/GTF-s>J.Ζ-UF#h蚎 tWyF&_7=ꗌ%9)}׻~^/Ļ$h~h$'\c>oN _nrwz]f'ŢTȚbtd,E~@^%4/dӎ*o)iܝ'r$]\B|yo8-HD M<"m!#4V\,Xyz5VWu3 jP+ݼtM8d *.$O8dH^ i CЩt \rw:df^,#]H#]FMM5_o g G6ҕx.GrL_V`f#[mx=%4zhKꯇP9z˙x[{wCOنX+]rМ<{=%y :$!x8w8d/I޴pos9E5&Cdྶr$cIp,c2bCF2l2~۪qN/qGPy, jsGWoi aQv=#sX")9:uEܱ:$ǂ7X1cSry:v??DžWb='O,QJ#tTWR=9rуe"~jTʡt8X8+W}RC͗V鐋))뫦 Ţ#H(BR|ΝI<@)4}9B" *1@==9LZ'ozSlxS|z}\@&7?=Um[huv޾$tַ42tAu;džg](CrAb wA]$`(rh'n :AcTϺKg{6K/)mRVܑHY%xg, /ox.%6!NJ%Nϒ"ܖuBuMmےk|BjBm9>(lg q`pX}ix ÍF~j-O?rQN)ZdX7<[qpPy9ãFzod=rcnЗb(b6Q_5•:I9-?!̜URI¾FєqeH[dVW߂uYj^9THIw,mWn4}}%)WTZșZ? N 眳*=TI ;?]A97/]A97/AFbtAfx -[XdigWVB. ρ~ `X,K @,х]$AFbtAfx ^sP&59kN- 1 3H<&/Vm?u{Xp,VmjuԤX&{KT7c뱘LM&-KӴ6h*:nse#RtM'㾦9E(-/l&Q+܌>pF9-EK)%__X)S.Zn_ _:׶P-4u󗭯s6'JԹ6$^f/͙] |Bض55`D[ -Q¶z_O--X4ClSUj eu8_X U>KO[ BA~VCg59{|S`#6=>"y˅wm <RsH}~)%GH)9pC#PJ<7;l[fCpvcy-`'6?~6TX]% # U w8&p!y9Na1苋cKS y/7)W@>s_b !dyʥBMU)jq11hNi߉麇Mi կ;@W*&ȀK@c3iy ؀6 ^dؔz=ݰ)1t`ն1JKum郹@Vw(7 bpcu"O -e ,~4JLJ?KU: NՖ_S8k.$ќL0 D-EFbtAfx -Z]nr꒕ 2so_ >o -K~Q ?bDW:'[2 2so_އwu{0qbtAfx g}. #(_/j]A97/b]cU bPHvu,i ۔%\R z7/lV0BRxj/D[%:f3t" yz6:`sp)FVJ0UT%on_cUrJ㨟:Q$t/=xɵNV%m W ׻ ~v,U9pW PK8:/hU6Q>@~kIv6Sk̎Z$c8MyFikkwY06e_HxJ7̡\yHsmSgƩ)XG*2L=%]-m93a"}օ ^X6ǖ/+ݜ^ LqlNᢩz@a.IO@_缀W( ˠ/6PҖpKxލ ٴyiDzSd.y^9ڟ<DN` *#^w#Bx0 Reͳ0ӗ%/˔ W_"$mn_O}Up_a򺯏53LUy]|׻~a5v ve?XC ypɫjj,kвbH^> P6IO }缀W( 3076ҖpKxM !Ck]^@Ef:c_ HYd#p#xqÉ)~o~6Bם)t.>Pw UYp*h s ϣsɴ%Pq.%?ysP@ؗ* ϊ}AY/6~=]_* Nו>pj>/f%#]4[fC׶^badtam  #YG|fais2{k1G%VRTN~ۆ<-K> "$Vpkee9uYaM4)<׃`h3lY27A=㢠XDzY(YA6acz)SAO/.dc 2so_aQH-E}^{W[l|^ bZ!2DZ:Ŷ*~[O[U/T&yBe|V[]>yBq++hT.tˑ)00y,@:Giqi0miA$>&xd!ѣ\OB|wY|pgi@of&g"B7/| ʟJĿ!e1#-=nWl]um7Zm7n>Lٮl;C GhW.=W;HAv]5uU|,"_h py CBRN`:5ԩ^꼱gtÉ<B ןu'| #M7Te^m_Mw¯b z wk9<_T.AêG{ wܗ'E}~C }乣<ǘ҆b?n[2B}Rp-&On7ǵjl: 9 bЬCp(_[$dM[E/z/c Bz}WE8B0B"![}i.z ׻ ~"0 -CP!m$\&B긔ԉ3TUµm-Sл ~@JWl{ߦ*b7ee fᢩzCثĘ n?|Bd*Bdnw/Ef_@fB&C'L&&&` )0y  ]{OR]Y_~-tnsµaqi0mid~(]nkگMUx thW!|3_qrHKt.J!/l|YpzCiڡ/x8RV|9**7G}>@߆_^e]Mn͇y7ͦ31MBِF”kϳ4E!;DEn_h    )GR0!q|5<4%̈oh䲳A/; qml8)t.tCU&|4bc¥: (4<@q#~{p;F kXZbs q-3GKy?n[yM/4j_бM@[)B2 OkS^n_h(}) ++lbY"\l&J}S_ -as*7z/XvH4 eQ9J[s*7՜KΛ)-s:nA s%;ܩjS>Ycys+xs>C%^Σݗ\W-Tf+1ٕMҺߞIH[­- NBu=tG]}L/ s:M/]vé?OȝS[T=V!m\,sʘetor~mX|:DJfS%_˒3/}M~5M0<\A|>O)Z]1w~91\AsC.Y=W@}țޑѸ|Mr`G.s>[3vg NJ$6%ajЧ)ᅯGNSO9DX>k7O7.瑮fyGHys=m 2WXk'NԼ>Yݸou`{1jK\JD={yNR1N?hLPT^ ݌c}?|`<[/NξiYWU?iO)~*?"|\G㏯O_g+/}ګkI쪰^Oo۳7[h)#UʫRyRVYR iua7#]*4Po9j)O,c5i7#t+-"V~7fx3uRmVBo{H.w#dzP{ҒZ6*9?FvfISx2'bnJkg`9ِN7e̱p[Ja:'#KX6){Pn̼K>*{ga^df_̜;܄1ZYKNeE&`y5 tK pu(3R&]x@8pPD'Bl j;d =m[X*^N_ xZ` /Ʒ8) ]{="L⯏+'.| LTuqOttpޭW.^^oyKWW}r2KNo{7ߜO}N^JN=}wzӷ?+mapq9x?d7)?A y;mC*#'gX{kMTL>!=;"s=2Q؅Y8Zs؍9*幣\TjҲUA/b L(o"ɐԹ2pż֣ `ߞ0}s3s嬐h䥀(=J},JK9fzN B?))BJ&RP6r\yy_n/uc;F]`KaLAv>v"XV]OSq1#|>:xzܗI2XN}*b0Ǡ*6hU“\IHNRHKy6k\F7iWB. ρO.i=t,$k52UGƄ˔S5v#cX(lȈpIpIѲ O|;Sa>UIgO~PFtk֙YGzh^TLcˣT΄,EU.~TG֞EUsAIt|Z}IoaڥC=Nj~κS>b(}/\IhO^M5XWo~(_ۯ''ktme*J#wuM)~zu*n &ʑOޟ~wOe/oϟ^-#ٗ339m3ʾg %<,)?CA8@TƳN(/Tv³6C/~}vm `"ִһm(]܌)G`mF%ߓ5`ϔ7?ټvY-E0*:2Wݏ R0;OB{Y}:'1 % 7ezKf}LP&vW ~\ |5Za}G@Fʩ2JH/d0 P2 ѫ/50oܨo^'L8K(k#|^?.KIL>JG;>bpto44k)e'~MÄ38Bɤ' ױ0qfwJ36kd, .%3\#pUF&qA >f7cdR"ػ \ gp mz!, .%395Kh4[:67o0mC(֯n6,aV58mry]o, .%3Oَݳ=]֕lMG7gcOG7g>!0gÚLVhnD>sxVn.EllLz{]_|ɍm.h/޿S:뇟>݇o^th>O^?;;vSi{v5+o9W:1n*^|{G9ĨT^0.HĿ?]sZfs9zgU//,]k@{[ݟ7U 5uVi/_4 =ixKQ1{su^lt|yqhI4_Зendstream endobj 327 0 obj << /Filter /FlateDecode /Length 280 >> stream xUQ;o +ap`;j,[+IĩQ\{x@[TY"9(P}ɾ3`lS8\2ejVhL>pOS%`!v\{_6z{J[~n`A(8~w';v}L>9?E&9'_z'Em;>Nڎ˼)HV:.bGB঒b9(U*H]ɸ\К@T@f0ۛNHoendstream endobj 328 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 329 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-max-asymptotic-bias.pdf) /PTEX.InfoDict 66 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 69 0 R >> /ExtGState << >> /Font << /F2 67 0 R /F6 68 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 3546 >> stream xɎ\\ p62@@$EK6Z[B"ꮶ Z#>bp\p?p?^wݫ[-=Ͽoy!g!xTp='H~~ض<76PTKJjto0+}N2v[xH]T9<g-Y,,ua8C[^TȘ Nf 0J] CjT^*5TyP/T~D }&Y!>LRȧ & {'װ<+O[_\FEQS"/:]>RͧK6ߗ "/*~ T^*DD^* "/>f:Wij4ߓUU\ʖڴU} ;YUŽU2AZ8Ne!GFI&C߱Ҡ][؇{P#ɏJD'$m,IUX%;i}shPJ!U5R$(;x/A5C,㖂C?1dc Qj7)j&Aj[遥jj5#Fi3n-M;!ĭ#a@EȻh$v "5C)1X6_][,v~+[6ep 4GNbNf=u]5\ Kz 0E.+"U8re 0JvzՎlFoeh=A#':%*wF 05, -zIC2f }K"G e7Fp} NsIF;*7pc+˙XCɉu?ʇdL$yI1E#3b2!H!J 7*o,,JH!BS4oBdO$aZbsCws PS A2 pBOYA3;1a]$E+dpDni)zR|}9'' U+SLI!űU$yD5g=ZabX.OPp"uPYߨ0!C{=UB'јDʄBpbB#7;1 D6Q&D eBҼ/Lw'&L0^*cL8181YS%j 0eLBcB7&`uaB17+0s}2d-L'C3&XBU&$Q1)LhE\P>@&)&@V%, Qu%L^X)ijGy2q2„ A`Lf2A) y/p0@<@Wxj3q5 pbpazh-<i8Iq8@(m B4P 0 1'7ZcAJn&;d0LCrѲ>NT8(Ebp@ࠪ0LX_yg->>9dZp0&? >AP63--8@3i8=X߆vAV=?9 {샊,@RTWASTRp@p^APq%m*8,Ѥ8(;M֧$.^Ło8(l8HWd "&,8q=2Vq}}g+A B^q$:5dq";Ad8hMӲd cBqe `8 %)8_8l]W/GB\ɞBu)0XOCy(ï4Ig#n |V -^Ϥ״r F(Apa\ׅ q 8<&PO9ԇH"@jmEBX8@9-,@qr]\8P.ӕEqsu<ĝ69@Y9Zir R:*a %+Z' ܳ-Q2i@(tUhz+pKSIr=TDʁ$Yl@VTN'49V˸ p78q !q jS8rʁ,@1+Dǘ'i  p{A;R]q+(lFʁ@L/rTd1D,a\9ІP8B}@Ѕr j;IF5pr1hgx]? v)3%eamA)!^ 岱P   EޮmD^O  NXMޤ@P#T Zn_*V8y6ۺ /H YgȺ0d 7[j X@s:^@-]R(Hꡟ˭rkp5\n .[˭rkp5\n .[˭Amq}@(vLrkp5\n ~[,POȚ A COVl#9n?ya?_bIu:thO{,a1˜|qt_݋|}!P^LOl)Z'˔-[6SPĖ\>Z4I-3_PqvK`ƒ[_LjWS*ϤGSJjhj)GR7SK=Z,?=ZRnvϥr{{-EO{ 2AKwXZ{su_Rm#'F{pgB:N"x.mN0vmӧp=i)}"fRʹؤ>o?~po߸Woo?\o>\͡>AJ9}{JӺ˓]?U|ht=GukTt_}<_>pʽs/x|mhy n+dE-oՙ$k:R/"ʾ}!ƙ4W>IoB~wz[߂?tlA 7n>g#_Ʌwvqx<͹y߀{W)#^{ [\߽ySO˛%^R/W/tf߾p}zP9%Ǹ[endstream endobj 330 0 obj << /Filter /FlateDecode /Length 1451 >> stream xڕVr6}WhЁf"WțM[m&`S^T绋e2U2b8BgWWZ̤$jgI2KӔ'f~gvRY?\K Zv=U5}y7cuJڙ '1-`5[m= Ǻ=U|Ko|(VXRf< > #riq}ncoi-C^}+4e6&jN39&6[Hp52z?4f\KE}@Gi3߶o}Pr2|V(!Reru"~`(œ4N$9M9-ƍm9~"F]žھ)-6 ܷAA{s@~ DOJ% 7-- GDɳ^}ixX0twƐdN,s۔ņͥK)1 $2ɨLP p,ܐEmC,۲nm%,& X*Ii{ZoV"g!D4qri&-qAE\]J?]d&c?մI[TA;]c Rdu ⁕ \|BZuj8 A"Ujz0(]sx ix"ݳKH4. UieBm9v{`>a@iHL/IVϠRZȟN iq2\톾<"mvtJ([\k@8Ҹ ul@.G`.SNw8֛ ;\|cUȣ? V`9F |i/it.B]%yVDƗ~bt4hNX7&c =\# f[RZNp'E`̸ uu*#aJ˖E,mz:naQ"H}Kv 845}AXǝF *h4[H.7E&L-3~{_RĠxfbEEXn c~ 8嶨tNRF'(mKf^, QoI=pso5l1_"]sty+HaMA䑼;Rwd|T'J\l,l$ozك?#-<S+: ځcEutUl̑,qhK ~xndʒO'Ў^놀ctdzű9t/7ȈtJ {-Lÿ@3yiո$e_\$pT  eendstream endobj 331 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 332 0 obj << /Filter /FlateDecode /Length1 1945 /Length2 14702 /Length3 0 /Length 15908 >> stream xڍP  $Xpwsr{kwugu?@FB'dl(nkDD db02322Ñ;Yc#S:8p!4t:}lmV&;77##?D[n1@ mkt#sw075s8?J#*!k @ hq@?)(y͜\]] mLhNfe#h d5f9TlM\ #8"% PE@ 9&z;D6ZڸۘḼqYz'7'ZDC+GۏxCCs+ï?ą]#52b6"@'G?;>ZغxQ3PJo· ) nFf noO;[;G@os   hjnO3/qnmƏc0DŽXCD$54h.Naa[7'; x<W-/}dgo.yۏ(tF6F?LϐSGAĝSEZ[\g-K¶V'd B6VmXqˮǢYmxc,?^3 <{[qÆpLh ts 6N!&p(;A_ A쿈 `q2AL"?#?;9[X}lkѡXh HcbbOslLlb/͖z?j~?J>Bm>._f>>_Q޿3}hu?^1}pq_j?n3F/?_3/4[^5 js۟%H\vp~FN tJEY\!zbHhߗ&Կc¼u#PbI,:"!{ r/Lmy~gApHD J}$WipHN.G^QڂeBǁ׋-Y. l儷:j"Y4&MĂ&)lk4g8č3x٦2B ܰT5,-@߅ɭ2RG*ꇷq(=PnN$.QQD *)w P<5FGܰwGYg( nQ_[{~L$ h/[<_}%gxJ.' =TD$kd!RƜtt4Y΁tX&jQ-@8,ArR\onqH|o3틁nkBukiˑ^+M0.RQ,Rm%{ hW#_N/66Vi+bᳪy+=ʭ"/}@>7Ǧ<]剂Q U~=/O%6\cLt_0KQ@":Ypð˭x:r$x𬌡(l7uZxy.>#dfYcX AqyI 5@./R ;u`IE uUwp97esjd[WH];:lUj*G}˸HPN bj +k`^sا~.>`NR]y vN;i #zK0[KtQωvVb/m~6h,;7J3w]KQJP)GU!C;uaJ cG5GKt9YȌxcGRe2 w?&VcJM]fOOVO:]ˡJNuG+K>G;=%Og`O쯜~S-Ӛ r%QhKE;hpv1[iT%}֙n2{c3yy|if Mh&*-ە9[9n àk,<|j3,*ma ZY9k5#za_;5i56 FS;O'-8D=26G ʢ&9.>ʴ-4uvc @ ,mr. |wԲSUWD خJP֞ Kp fiFh 9PƯ^FUy_M,FaH gv:6p }w!|Jx,JSp8jRZ fotɪ0=5-ӈoŁ[=Y1\ qÊr,e=h7=֥\'YP8nҰaϲ}Ilz}\uȇ@̭8Zjtd!U0,ց]^{ 'a\GH|H;<aWww/I\ϓ5OV]cr @:P/W[^&'"R#\B-sQq+1ɲ? 4F*@"fC) U2'^qxgDG=s`z8ڤ@XvZ7 @rhD%6RW__U.D7m{bѳ$R : ™?MځqB*ɅtJVd-y`,#=Mdfy 匀-ZSaˠs 96roEM\6`K~{ɖ~*٘%,e7X>rN28xɹ&Juך䥳ϾYe :lwPc4։,_I,1/ZzKt˔i7e3Ax|Ee>c_Y (n<HpE>aF %&hcȄ8>ed0_PK' od8@ie?.FEY@mkRE^)OkGyAcIh1Y~Vi|ELmTh#Ucy{kb4|',y/?^mʅߖx}& N.lJ?Bu9zeɠNEk4 DW'<9,)܀)RWf nc>TUOЦE,Go vd<NܠQvG''Oޮr ~_KRw-F ܿ{/XQ~#^OvYΤ_,3zSez$nq<\ޭ?~D);EvQ][y{¹;=#0DKo;?V&=ZRhFhOV NZrOj*奌'xQei*㦝:ͽ/4fEY!idžos.EryO %: |O-Aڋ#u)˖, z-jTG2(AM%P3 4QyςWJ˙̐=s4-qdiࠕAh~ƺ׶, SH(Ka'  cxW9N0DeAcggl }35p,uR i|B\ /kY7%E7Fv>霼݂q=i,-Ydɠ\W>qz=`ֲ?ewOzpB`@TPDjT \YU&̥1Ӛ--c0 =`9Sooy`XvU6*bn'AQq̞$-)LE,|h++%9/#7GuDsL% 2b<؛O#بdd{J55RԗEJƟGLJLit.oxuV50+l'/~nKo}]J$i;"]JT~o֥ }S18sye,V. ;sCr#Ի\[ph8n&j:iqnxUX]w|K{OHCWh_5@)j)D)Z?,2q,эs] (3mXU@U 1 4xY}4χ4 `=޽рLPPZ0z:]S)ŝڔ!鲯xDkm1d"S3Zᦩ9L6#>~ u~Xh{F+ zdgX Ar6KZiysޫR/{~n8{ kq`h*f ݳN!Ok"Y&Ka֨;57";B4J*#I,n2ΑS Ƒu|"57VclquGkӏ*mf*2-{T͘~~ϥ V_=AO< *vsyiZE\%S5q@EL-$dг liL/|}I*+H-' U_j8lH7zqJˤ8%k ƚ L2 oHI*@EMl"2 P$l' rN+ *W0 #*O$F4=h$`rMt$W7 W3cL㊬aul¸PV2߮~-C=\4޹\VY& `(S]y]hwiVA樣0H)=!iT%{c L{[qRiXPeõYڷ$œLD9 ^hI7 ՓXe\LPhݳId a^x̝SDg7 ߃1(v}q_*Meݖ^<._n 39ꗔP0~B?'!𰾃͊wnl7cжhN9un:8dzK ["XuIv(51N3F (wNsïhR X璀Wj( XC|.!}|V1S85%3Q[%tȸ?0فEEM.o߼ѱ }Kȵء tuHUԛXdkhŽ_bsQ_/vd|Q <~:';sW, .@TڣPWR@8F\CBR?54 ?'ͫ^$_{# @> -X}H#0 1rDɡ17by}]]PHh ~X; p#38P?:Ƴ85U}TC|R]!KS-0]4Ru7%Y@p.£7EIR ,`nqDL?9Gm)#Pp#є/P{u> ݮ9إcB`DֵMj7J9ةHmI>iaTYO0j:_W"Z&+^Oooh2pn_fnxc谶~ctI<>S5<tR3aGjZs}h?˥U; P"7z.ɝk!;5uDHVX)g/%2ou箕씽dvqRuCTt#Oat- DOc $qµEP%Y"4],>K?hm<z]tK8ItUiՅ ds;;e&E9&lF5Z$OAɟ~W1ynPtA|9'\H ?LߎI }K_@\݆؅CNHd;~GUc&+YGh-Gx3v(+!FP_?펴Uxf1y 7 "w!](P?zh… nt6Sn_m3wHuZ?GH9f+ X %_5B Z4ks@ū~̶m#j %jf P*=LB0Y텯И>M2v+ u./fʙ&Hf㎳OVN3brTf㞂v7؉-`&*ݾ]c^6uLG׿MŃS!pc .QS" Df5=w&f?3CF]՛ppjL]e:u,I|&Rf?+m^;lVeFcKA$'[ F:~R9zmœ JI*7XֽIs-5R'K.+7gl"W*DIt*HMYqv[;c>s?/+-GϩNUA./M3lmuz0MI-QEgLȼ&ZF+b!Hg=TQ&ïA\˟( O߳#حb/+z%Bͫg$A5MZيBkYl4ȯs9Ֆ%}i9`kBA#V͌WccQ+S w6nܬ:-- זj9TB~ˏlVUDkusz M퇪Nfy2>/ \7Ŕ,PRl'ܢQzZ5a[Uh=H@\LuX̷lTb,Lf/܂йpB/T3!ď`׺ ;0ƤTNWuZ^[{.  ŭ/mۚV$e~kC dXUJ='0*\c%/OQߒEZ8E=Fvs4q? ]uE{/}>! b.Fh w m絬X;L^:|bܕi$ >*הT"TJΣftc j,~fH`[V˼,^Ú6#ch N+WFt3MOH^Ps?ЗuyP 9 !Epga z iyCɝ?lP;kAf?{olpiGh(} :}b:ыZn&[j2"=mF` Y HIJJm#,mQ ~X7R>O +M π*Y}0敲4EWTfI%杧dw{BQWYq_LUoYlȋ8jxѝ!llB=spjecTS_7D)Y=fJ;%h&\4^O@ϜQh;zC%o@j "@~ |fv*ZR^i_,殫Ú\mSøt`ۅ5WKBI]27Ra+|{1|܂ FW*eq"jdzl_+]a<ŒdhLκ zn ed=acV\'beSNuGwNϚns)z+\-| zD YľQ8Q:g"wK_2-jzPQ^J)΁ZH׌ԝY@kA8=_[M9=RAqq+IT B,[uL $Tˏ"U 'C2ja)}:2%JQ^pgH\2yFæDįfZ-O`r)Jʳ/Xb@@#ٳE XMI{  x56bW1 d!5#prF; ]i/ 1tU9%Rn:Va爳x8Ύ'êuA]g wP;dWTkk<Yx:̪_oV%)[ :r æE|9!  D,n1X/١QCl$xaӑQoGVL]tg`-zo= *خMZtK'aE  XZ١k؜pw*Ԓ]85 Rg%/ ODUW5( yuLHKhS4p$4*SM8Eu1ٲXw bMgVczfAnqݏ{S 驪Q(; j̉`WܘνPoOQG?R) ٸH[I""*XU2FǤԛy_K]MEOdlq͍&KpS'n/`^曎wJak`ƻ*[3(4 ϞBWA_af_`!;uFaO_@ 2u]ͥ_өcO` 0*r: ;uyÌzw-ch⩰nZk:R{}JhR:]Qq9v.rWK$ʲP^&s5<2SY2_!)ReҀ*$lL=>[F  Z,|pe٫}_#տi-l C#>RJRh{&ځy!%fB(4:1t x{QE!6Hc,]SM+&pQ^ aċ!4hj~⒰Z\3ꘟRDC Yd?:6S: !Wrtxp4 '-vyt0;֗&6@*iEbEROm_@uҟ˧ aʹJ[`QFgi J_<&}7Sdq2B?/I-[k36DB-5/> MYϸzqK^a5Y{n9,g]/R %jJ#ptٸ]+ UÖDI% ΁ {cւQ;^YO%fg/]!LlHiZ[7 zagY(LB<`/;1͍'>,T1ƓN5%-^ _# 'A}glTZ M#Zp -y& ċ lң0eO7"ܝm;Ƀ'z~άZQo+"PoRWnP[*t{7ȋbNyAG6F;Q2RƚOO7"KYrʨ*9OB>˨s* <^w09-Q3y|NmR v_Cx}ըƾv ɀ`)F1PDJj:!܆<ʾٮnX/YM(Դbl(ԷBӮe&9Q^Շ- 8ĵ:5[1}~} pPQF(N-M r/7U6k_^(0n"LXOGwt %i' __,ע|% yhr|G,~KKZ xWўT$W#l"WەC%dCzD氷lit9 ђ Le?_<(@+Q3u?7.y%[ڏe%:pLZ }JM*(so:p1`DƞcjC=™:*7,>oru%l>MZmSl-> bhxؖp-r-\Cq T!zTX/ ڒ )4xsF]w~ۉq*qS +38x=8L澦#;FMGl{>t8',_n|ёlRUA۾p<'4#I1? 4^`k]"a!VKBP~vʩVH|+0-n7w-- gbf:-q|^cq!M&f4ikSX-g:`KP)㫚B\B.tnHĊĶ~Kȹt}rJ$:d#J4D \q^o(8H)YAra;ׂ{-I]ewgÅޢ%Pė1 T _xk`I!M^#!gyR?-9DT٪+LmNl"a" &Q8/¢AL?M%48,SAѥ7L#"2Jc9+FB8q.x g-?> stream xڍT. -V8 n" $@wšh)wRheZ|3μ_h)U5X@034 !PpppqppjBmj 0`LDTA.Nn' ' C?D @ 0( Vfr~G9#S@OsbV`@[v/ BVnnnl@;'6# lP;] %vKcChZARh,݀`b:=@A`GSt"@ wslG@ss=Z, `"3 A:쁮@-g@T9;B읝؜ 6KAA0;;0 $!`{}6P?YQŞ] qpIyY|nnGM{J?O5xOe} T/'+*''1w-!Pޟ`;BO ϓӄ`P[?]WLBN\Q^V.^N''~Tm+JOI`{AK4`A70?M/Aߌ]lm3Ev[OJ]/UlAs>6B!`*qKǢB`U䏫?2y>fOiy;c˸x@GG*(q8vslP 8! #~o. إAvN =15AOLo7z`7AN;_)?i- a.2xX ح~ j9WO8 >Y8)#_?eS]jq O<5x.OWTy׃`sԅY` Wn?Fh$3z-8`"'08^% tb/mH1]oAk|}g>u~wXu RVͷ[6i\^c^u˸W}UΧvW40 6 3+ α;N#|,3(kFU͟?yiֶ}OY:$k|gK| Զ87O#;I_6v,/1(Jށ85pӊ2 ANoΣ¨g Õ+힘]AB[oџ9hp 'SBn#4r* {>(‚ ω9$ agd5vA8 YcwJXec`jI#O:s;نOʦɄ5~RՊ;1(g$Q[eNzp+zWC5n&Ǡ=ixEqZLkRjeZ[Glˑ.S2 eYFEa~х즯ӑ>D ӨZL#ȹK}/6d< >@n]a7wo*"u%J*"aH OU6Z ?yR5Qc\9ހy<8Fa6L=,4u#tnD}42;osBXpXeL@]2\/4%~E1!"z#,BBKJ/,o(ZTaܱ$I&Qe0*nA^lO?H9NEt*P^ ̯Scļ !F6H|AdWƴѱf!^[RF%E˔֭cQxU cR&OlŖ5bz>*6#O,;g_ou}!,eV_NbY*$etWcrO0*D $S\O ^RNʀҨ=Q~&/B2j !ǔ#Ad;yB5559Z%Po,0o(ljBSJHtoY^1zA4IЌup=ڻQNKxGBt$[@"0ޢ~B $V5Nw="_B"ЊLPKǀFZBy .erc_tF6"MUS..x5MBsEWH%$w![Eu•"0*!Ghp0aeƺѹga+abr:{#}D9i7#0/}щ_~}?|\r~`֨GzzP_E.]rioӧ.fvP<05KŚր$}榤S.$rL5c"*&-< i%8c[#%Z qZhΌt ;vG奄CA"D.'$KĐf{PQmv"$ޙG?-QnGx\FK8C# -3y, M]iv60-w,VGrxH_xn WY?9ESce4o\6RjD(-Tq6Ƌ5b_MO1hw~ñz9O}Dy{ \X1=K2! 7/Խaj ɇ0O Ј͈Ykվi^bpV4=H3jczI'5}ߨr ~DW%eX[vnH˻Jd P{6q}sUt۟?@"`Vuκ YA+BOM)6\ru6n̈́p.ǢvH{_o ҳ;80%'“8d#^>"ީ2+jufRM4ܶZ :ΓJ6Bbj(8wKb-gOm'Jn?tѼ0گ݈[xd+mIEٝMJu- /7c4Hu/ X y[HHXAC=$h'/Wd+MZfSL(BrVCb)e&aE`rūbG/UuĖ(p'$ZtV#bUڶOoVuF*b1=e{VG[6K q>m}~aL-yt\eAHXd'V +!N}]`Y m{PdWT{aV_ry 3i XTA|N#Tk8I\L|YؑȻ zfy[sy#4_ hʚu, %j4z},⶯02ieHU4 F]Sr!𯋉j/冻ZJ>`0 }]9Y:d{;rBWzP"N@03p~3P|pQȪal=:I+4䞼TfNzzMh`%-4\h`_-a٢&yMw!L:7iL|wJ2sE|>*ZreX WrE_IfoA _Y'Y1.L^u!6 #6v,cT,QtR6_ 3CK@/orO[ (;u:{_%Ip:IrG*3]Ώ]ZeQhɭ*j6|! dBE..gFxgdVu7rC̫]F;}Lf2.)sgiFxNXfJ #q!]M6 non׶Te>h u[ '=bvE;eGF卬F!xGu1:]FvYt%5py{ƙZ$d|/9֦Խ1=A+߅/YFL9 ғQ?flQ_Rd^`6nmRE!{*Q\)Sz_ESU_ Ϝu sl"JxvɎ-D+/{t1!ŶA0 Fm5_9Z߂`}{)tF( vQKl0H>m̜͚o[* JOs=/D_#7"$8%'W-lx8pKEJM`83𔗡h*A >gjrNg<Qxލ-w/l(K\[!!_uN2"@ dqK:}SB MFcPN {.F;6+~1d`1Wq_pVX&X022q["mf y׌\+`Z84iڡFVy\29|r*\ɺ_ \z&᐀Ɣ('o?JVf? BLx7mT>j# era,'3Q.PX˒ru=&Nm9v$*^L]ae~`.}˨dO}O5+װPiJw3%t@nȻJKi?`/rJ͸G@9C>Hbu3CA.7}C>750lx(R.MVm=7+:Ǥq+ql@-CO/B>>e24KeIÄ՚uTp+jVYK+)Z: *W/F$bTc$x)U܀{\"I]%Wb|HCfѪ&~'(&c N/8GV !=R+)E'jڿy[p vAgu5UxHrד]F>R {%&fxqGg{)q)y(sGwu20OrH琌mC g7L,`EM3\D|Nzމr8ܻ). H58`[ t}[ pUk3!E66;":Զg=E(8q6[_CXF%odQX` Ƭ,] [m/ gIhR3tt|uP_"#pnhy@zLxR)#:YCWVuZwWLW oOX`>Y7G5J ~Jxl &S hleDd컖%/RJHtw<r\DaK ;6ܨOy<$17\>ݛ!_1_(V4 >=4xI 86l'y^eHGYDW8Ngz);f.X sͼVdSӃFB\+O&m\RXY<v1y}Y A$FNPU i+XCDɈV, O~$Le.TȦF 3..ob=d²Aw(7e_[Se=-^*~ c##_N#=3p+M&2!xSu56g(\4oj{W4``0VZaefmVcb+Tr-LeS6q*\0xp~}3V+d&̱B~|S ѳX퉮O1"GPJ9쉦mt<_m&Ua:,F1z;%)AY *W)&Rw>?_3?a 76N\ů~"& gu8p}>j=*94Zg (v{#9yh7/Y5&f'j/T! YW4ovz,Gz(e 2a>`teqd$Az:䵍)ujsh9 0ZuE}$mMqC[L#4SNLĔtU}쨶W1|rIի#]j!ndo'5okM-5ϑ& x<,?Z^,<sBSQ!7%pV̰gN3h"٪M>8;\Y_{%֭Jgt[} Ua \aNJĎ$ ZyuOWY!_ O=nMQmXAj 앢L0av|su<kNJT QCZsx#ދBnPS!e^BD383}9o `#ףTQr-^h[n~J۔} eXdڃ6_ NW$ ,VG!!k.W6 C08׺syPgH$ߩ xӮcm>@Rb=0%`+ǼwIAVJ7E3wU\aM'`LRZ!Zֻ58 A8l_< +sB;(D qhfoj{<0 &}gOQD'Gە00~ك//xz΍0Z:.){9}}nHޠ`KJ+\g5+ 3&wdžfӓ DN(%߶aQn5\! Ge]0sPοϏGΊ-9wh !Z DRN^2LHZ 1/VXbyIhD%tiu%j4C0(p`fdٲP|5oCjgeOY#?'"YA;wޭUlaJ]T悜DAҜ oPAğð;[1 wwǢ^j5W!b1ΓcP2TuzN5z|PȾ4u$]%?U̫T+R4kuU@ĥQ R3B Ut V5?QޜFu*n1v;p%cS(^h({cTlL#ܥфG\VP(є|ɡ"} C)̿|)[X宿 a/ &E+gzˬޔDuneZ9N^(rQ\ \lg%<ОfȐۗ炁b^DB(Ѐptl io%5}1/S:׋%/㭬jֵ\TSwIO4tP })el02H1&gdt+ @6I,xgCv~0 +%ݹQBB+D`I^(jA."C}JQv+l#]By|o$rڈ)Q1H6.^Ņ"7 r6= >VP…oh> 5J#/͍vqօ]a-*%rMBZMEȱ&>~x}NYPnC_2%K] _|;3*NCtPv޶p#]޷hl^(L͸0 ggsϝxAٙ8{ q;.j5\ Z>wbtZw7}zͼmM,]'\dnwT7[9u{@yw!%/3< ݓ|vm&)Vsũ.cN"4H߆,H35v~k@hfLM4C ]!ue4p4!ī8u;˥d~ًNlU~j‹ WK6 H8 Qp\:ɿJ:&@t ؕ~LL%I5k6Li+70=`wҺ+%RX6iMЩQ mΓj66I >H\81юaUj RitW14 2e19l4 qv9])tUh=q+D ɲDK-|&PV ):13)^Xo52lz:L3ߴQp8gke9mW6)FdqYmlx<&\ }B=9,qMeA+o^y]]†8Z5 #D.xlP! dׁ;ܐRjL{.oQ/Eq$0 傍4ly΄`b^0\ִqsL7a "lPQ&9( K :Mĵ{ 7ULikRr85N>hqe P@B l"> stream xڍT.Lw7RCw 9C0twHI(H ) *)!-Hԏn{uf{`e3UpكUaP/O@b ⰲAqXMpo * B˔A{6 q@QI@P@@?D\ 80(U 8 /ÁP! (@p{{t a0"_&8]OI~~???>7 , \`o02@+`sB`z߫@pw@ 8 h2V98<tO77WܗYC8Su\7(+ GO~c(s/[ FD$DE`/OoK|CH't8 8$_8@ ؃!PߋN,? sAn1: **A^A QPXD &&!=O PV:{_g8l'߶t` p=V"_y7濬_'#RqwsE?p=~t}k _RM6:t Pg ;A.M_r_`ސ_ ~/Xo*PEpP}_" F:2 Cܫ 88z An3P8"Dn?A q q ?*$?="? ˘ C~}<<~qG;(oP >{ߛp߂60q "G{M\Nޠ.Y +sD*gnښ1w\_>2YSx9HMk$|lچܣZ#NWFb7D5qgxS"fYK 稘0tX\$GgI'4qUY ^. zRP[Pѡf R֠r|1NM(S.B~W|g:R(WGsVIfen[Љ""֮R)d9X',4XH!Sj&ƭ "Nˏf-q`.J3_7Uc8'_q+י*T̾?+*gW"cޥafկl:_ T>-K+S~hW]},5isGX!kϊyLcfkm_eOe5yAJj9KK W{qݰPęfǏmZSogDZg_4[o)[ Vcc7䔱i>7 a}>\ }E(q3]o*絑Q2]VH+//>8!Jgۑؓq2 lmmۭPyT\u``=ys?lOb0.5rl"I4$1&㸬 gT9Rt0l:㣥GVbt>)}ǫ N5kO|&Z4($; x 93 OaaB"`~m]jW]hn F6.~y}ri5{֍:<y if~a,d塣70Iyg hQfɸIv;#'AHJ[ RÊN_5[)B4tXBjlg?9i7(,4 'o~QZ#efH}v r7 l7F o*z)0E5hu` ՅxH=gm;cʏX,wpfu~" 4Pr0I!X,}2;<9/2|&"OGY<5񚇙Z8|  a~bDRK%:uIބ)XIV\ J\lrDEz*=ISf┻}'^E1x8ImߦVN>5c3]8 WENW>xV}-AC6`5~E(fGLw.4puECsiu;GHQH04 \I3vqV(;HZ퍧|naWw:(7>+_ZY(ĈD_RD;ڐU'|zʤ0wql([0葭v&Nr 8#h$X%J)O EfRBb׋ޚ?Ә ^n08\_<9QwȥKcz(@$$<[gGݞC\|\JӁp# >ؐ 3dAV(0 uMk/}$}XVXC>`&t=iím!5蝲17ȡ7S7QlyoS31wZHax"jU(YhaZi]b[!wk22kZ"l㡎IB:Ljy%SWc%ovOQOW`M ;Ӈ%]'[;dvU /mrV;֞50\{#[ :jØ0|p IS[ {pvO0);sLYXw3NQoD=5`MҸ;̳Fm?|wIݚfV@u-%u7ngS3êһTᠵj"t~[|)bv FZ }&s\ |SC 22^[MOW2؊|$vƽ'%W- IkZ]|Bwa謟k>$HA;5-lIr.eQjM%C ?8)CaA mLm7Dm[ax{@f~VoP#!B^mdU{*ab Xpzk(<@"%iPncQ6h2s1D]:T-xvd[0Hv=TW@q.3s;;[94bgJț)/VK0f(p}rTgEN֍=fx-4%k`K,LǼ,rcM2um}}jnIEDCTSOd5Lb8.*0ӅWAdLHV\?Ssp,i^Ϋ=նIǽ*S*/E0DKMW,K!Qp:̰szc+kgޘrZnaՔDq@%cOq?LlGLX6> k:(¥āGJ#qI8o̪16hɰWA UQf0k.ԣ*Ds]oz0զjԬozPumz֞j⊮` Ed @NΨdUpLMLJWOoPegW xsTͼi>='[HW~|$'SatKt99Lc7Q+nO^Mlٹ&؃V|%rO S^򛚹S[=sMmrɊM ܕ]}c]?4`>Nkg3yn6z@xJcr c h,)0G\-dD'{UbDZ%UW&rN!1s1r|Q!C$ވ' _0A#xgqc2% qnDjҭ(%mI2awUeܩGtiFҤ5L|aK3x?LK_xx;:_ޏ|B"̒a|W=eR1E>5Hѻo}q4n?ar`(QaUd"gz;Ios @cU$ᐉ!PأVѷ&$b!۪1ʉO"΄BBkN[Avn,Gq܈8H :ˊ-U,1JKv[a~"̚@Z4̮U+iqHT-A*{ӡK0+M  p䄪I\sRqdp{(@FB'3L܎nRZ4tnacxDPC)ҳFU>͎^nPzrUf%r|%"W%uAY 䮷uL(z˼soSϡaz>M1|+ė{DK.:8Fڋ]v1;w`$NJ~=D=!U4nf VAp<;@jbK2;޳S]5)BP$EYFsfS^dJFQ:N*l,]熘U#N%֌R@e(܄^.g 7i|f\<\'=B\V8XAc7ʒHƍ*+`BoJb UL2 B5&Hiٰ=Hڹ=$á1RM-y v_8zg*Fx5;Hu.ΗT +-άUYb%EՑ㪦=TKڷa{UH-w /&4yG#GU?Nq E.4Tjh~@6ӯx?spcQ qKu7.WSp¶ZCRc,}7 aM]4}ѠK:*tIh!mҼ'L̮Ё/`C66P@% Bbn?Ȏc̹_@nj, _lItkLFRwp`sޱwQgM4BόQLO9Of`hrŃ9,KV}.+y%Blj3=gQoFA+lxYuߕT+thYBJ8 ->>AA8[ SQ(.ߥ »^^ܞ|@|:b\@4s%DyP'f1O wn kۜivDOum_\>Szd]hZD:rFVHh^R/ZmGܛ~.!ȭ\J)*1?A.$vRFWk|"X5hZd(zo{r=5nz9(ww. \b̡a_g^sw; ZD!GV[z̐>9Iz_Nƽ8uM"{mrȅ}hT2dJgW]T-;~@Y/h6.ǁwU( O<_ȳvcҾ˔KR5TQV>4]PnD2!ZJ@с=s$O2̂|LJhO=Op,h3vͲγRk[iTs fOsÆ&kqAQ чj#|lZOh9bgyG@;*o|f:2^Cth90 fǘ&aIr!Tj-j1*T>Zo;dkpۚqfόq80`KXlP9<+èTuEVcZ4Z=~e3Yq9&h7EGP ap"& Iٺ+endstream endobj 335 0 obj << /Filter /FlateDecode /Length1 1852 /Length2 11623 /Length3 0 /Length 12802 >> stream xڍT-;Bk@c t58w4h@wxdfkzoWSuήRdePVvA;V ǎFtbH͠6i33QPtpp8x9!]fn K +@J<]@6u``p# tY9T̠6@-` _)mP'A66wwwV3+Z5h!@7%wU3_l@?`+ lY!!@MeO׀6w'9lfavp2s9Z@@2+`hhf?Ǜ̟ nx0{ . '(#4,h)vp:B!h-ݓõs;zY-~aĦrv*Hy6cB<|\<3aa{-O'N|N6 +7 }oY@@k#?ٟ@?<d0K??M㭪:_-픔{Y8,<vn~Q7Uǿb~Q/05!N ~. y-8Gg*+u'7s{x+y TT]:Wj<ϒffeȂ< ͟Ӯ{A@u0ybgY=_#gm2<Cu8Z-O'/yL->{X]~4'MO`STF\6Ϳ34q<4BY8 o<o s_9?.k>GO / `r>gg_9?%?i?Er&@ﺜl xboW ?!5@\{K!..ce z-оρ-BlC:k%Y&ӯrL@dM5s*dsvJ:_̟yo6P6zr_PZS=]&y_jy*ReF" Uz@ˇ[;~,bhjWOmY2!6a-sbqцink׆Fp)z݂~фAqdɥkt ^畺dzX|XeLW=<=0bH1MuC㴄/_iN 2$tZAa07v杖`09Z%QromgU\;}m*Φ 3a6㾯Up }%C.Mhɒ@H{[..L7Pz !bKo/ǂ.I(h%̢l-2ꢥ/}j<֍žU^}EyHٜit/ QK` I.=pϜYD l;Fc;Ehߥ %&;l}^x[/fuۃ=XƏ16œW8ifܱ܎Mۃ-:Ö_YS.^b}HdmC-l.]KE?RoxMI %D^(9&A{9t~?Jbo \xJgQwj'<$ r7\9-dzrSO: $ &.*#aF K'cqn56LJ| ϿE5rfjte((!{kш[~dSK81yqo4N2{}z1nx,4YhC^ءo\rW qd6,=J0eZOGe( }M"d;..t'#ܣ5`B+) q^gi|E{:"^߹z: 껚r>?:9kcVd]@w3j9r$Ä kB9M?gnG(NQ0g͚e^hB1-x~KGx<ǻ%#TK(h=9RAK1S̾1?nY]VPj_W>x\ՙR6MS,Y #*Ix[ #˝pe7%d'1r策2`ؖ;jW~~QeCԲI|~L.k ì|ULO_Ho$$_d#Xv #FJ,rZL#h%+y%6G|ċ#z5;dje+ȆG]BtKfYr{=i!AxdK= ޶*gpϽ *[U)V:FAvslC} ?AGn^fIo>zkȺ'|>zYԆ_c(%\BIg>'o%D;6+jHqa\%Z)Bjlii=2vL&X>)OV~7`mѮ& o>p-1&{bMC: V ԏ:ِZ8TcbXX!Ž\Ǽ>+n~Z.-ށBal:KbO?4`SvK"'5V_&t/f '%)l`b_.VM}UK_)B~^f#HE4jq>j) ΦQq<.mLNfnW 8PVMf!.E6WN2J3Ҁꮡ'e c" M2ͳY}ə%᧒3W_gh)EU^)ywc"2 5ɬǜk. ły YoCC|tXNT%& s}Vq|$H\Z,DO쏢Vl La/^e0ks8g6^oI!za#w4*A1ӲZ2"n|Q/:.@9b % $-=ݱmy"M%&B7~D8Mt|>lQ9Iu|Dcp@CUΞcA<*oSu_i"xVZWABcPQRv6=z.T9ul[g2AI 䓡b,ބa `TJ`苀i2K+Gv TqPmN3FXk͇*9"UXwO9%ѣX.bK! 6 찞OqdzkH]vkk 62"C\Z=G AwY$Ԙih_-\<۴5HF">vtU`ZwvS2卝dZ`Hgԍ&AfWXr)hKKen3H0Ia% h&_q!8E+FosQʜKNCa8ji]u (h^hKW䜽owe [*k,%[/?ezm\iܝ $QMfo)V:đzun~TORDiILf[,+,Ő`>cΉ J`&&8|@zU68 A~)S|ioWj.lLH#!171s20{ˏJ{ߔt?G8vNX'U(\E*Qx%q/gu]Zd?;0E_ob1FXq`3఍r㣬Sޗ{>-8xZl.%5Cw^f~$iu)Un%m1 體Wvy>OdHݴŤFSR>J'e7 %SfWAr3 &M§:OĔt17o7T$l~Gfܢ?6]X=MJSIzJOD#@s/31Sui#|&g^2:–Mx F-`~+1yJ~`NV #~oiZ$6Ǹj(ᶒ bb!;[҈c` b=w#;薘P'G=3(aU|!,9ZN%=; !!.S)gcL|&oω9 jmZ v_y,BnSc-t=5^{dCk;Ș=da8̭2T*gnZG>Lauqjtp_-դ%Si)ԓ*JF5h-aFp'P*DW%dnR뺄 #q?^iOw{f%h=ٿ=݇B!Q 'o.L4oJYg4O2n5{_n,PxoHEmb,_74M0`ZENNZi/nV5D뷭$Jr&G Tss_c !$S49-rsVeMr^dGF`úIR4:"N 9 Sᑦ BBzkUmY sکptK@h$/Fc:Z"ڇqzw#{Tkh2̓ mǼׯzic'<%ʧ:ڶt,lrW- }V+ڣD, eC7#RHzzev+FV0|ӈσg;z:9+E.d\"HM1uaeG1{^hJ 擝b?m(`c{լ-֘؛i;cs DVb9JBϿF λ2=Axl%$c; 1ty̿e\ $4fYٹ ws9S}F:e{7r)KQ\ U7ox@ 4CooݪrX{|L;-I2j28LԇIwjve䳩A~v23$5[KS|}@ z& FwmJP5Fbx@Tn΅o>{k\'=-8OA_8ĕɇ{v˼fcb`R( QUY W}! ż5p.nV`]x 9s -~eC%=jǁ2ر(7j2Ŏi!h:ܮ+W;_tvF}st?H8`iݮr=+ۊ\_C|تSAkxBm iٯP5[OӊqģcJC{O;)u]x5 ,?ijRPɇlEF+P8Z ʂsāIsrFP?D-?tZ](Xg*呻l9 s?^H ʨ_BrTj?ާ~b _?\[Hl9 `odd6+nOC߻>.I^odtE".I_s(Om O9P KH0} 5rPw{ `mEOJNlc-_ri<έĕBW'`۝UzRdyE:_sQ`‰+Fc5N8YY*%hqnA3VϪ}>2Ky[ ?Gu"9FD^ rs&Lz9z>nŅ>_2mS4]TGY?usWпt܆r;*k~ܘDxVhlF^mabjILE\ E=^ݬzX;+2M"O͔t;`ZYj8+;z}=p"J2 H2<D FrԖzu ]E;A@smL0s'@W# <" L]V rJ )h՛8#$&)> g?o--s: 8Z;vrñNJeXyP^("iz̼W8q'؏yhmd 0gt[ڹɳe_'-+cvy~!|$%:;hC0*hck?C=)<+㻦w҆VKOnUB{2{47.iP+J:QސDe縺:sODb2sh?AҮK1/A;D',N@)ZЛedUl ddlE 3Wʵ6/S˱d6ƥ_d K]mVʌnm4u9Dn-ݒjMփ$W)܀ӄb 즔MXDmôSGj[,YI)֡LTuڢ,sI~re8:G͐vAZ$P)u)c|GbǶm_ b!\Qy*r?w˗{_JrߚwOԗH@U9G/To, jZуSH,hdV[/rĪNԛW`sjG7#'#*qyE2-kaN mK/>jřСl`2K,$R#6% ٬s cɟ8^0svb0聅=TNycQ&.ҽ. N%ܑ i ZjR|9s``# +*ED} LзO6L[ :t gf e':;M'w&n!L,>tǪNMo^@[GscR?Bjm 6Z.r1Z6!I$'f2K({gךVD_炐PR Q4vjlke^U`Ԡbmrn+=ֈo,˹*.`,/܎d=7[Lfa8BJ ^MŹ1AQ~b ]FO @6kUTmQWGEZRlՙG77#c*)Dd}+t-ڸfvKS eL/pbp?U7H#SM]V ٭gMLSrr/^2Su!M}Z !k n5[ Ll.o]a}JWBmSnQ/Й \M3};/̗NՊ f+ ~-¦{_W{$d{Ά amI|28 ܳ{ĸq#ޜgｍQ8`56ʠ) xe`KHaݥrF}7U5GN((G $\&X;Wd۳%`Mf N{Gq[QHXk5:MPS?~.|CO7_'-uz f {']d+]H9Qv3ɵ2<~i8m|0S/&DGo҈ѱ?ӼJӤa4x`' ЮEuQә8~a=LЂ|W@>U>N:HT`QiWK^ CISz-q;ɆX#0zSa8%c32l+D6Sd}8>@{0z|]?t>Ɵp{1pESbgzκ(dw"[4ҩ9a6_$#K7j?gD0=~} ]uڊ|v WJ 5VxDv]ӼR ˹V+ߺI?%{1{Lx@'_Cԟ]w'~1{n L/':X(&5oH9 %|]\)φ*]iuw$L>ĵCh9)"VcžKk˸y.B¸6c)E'LkpcNFZ']楫] >wR юW:f̺T 50,ܥ:WR[պ6hN3pW/[}8b [Чs2_{z賳hN}*_*YT{âB!B7F*yzZDGbcw'{1Ŧ̌6d]qrT1VD8J&]^b ~ДH}yU$-y MT>J%z'5cÒ9'=Yn/1 Q{/FydɍW>|kq"6HFUAQ'nE0nMƘ11MUPS*r8 A$ acjl$P&sK5ac}"~3R'2*=:)Hcɉm Uh|&[˂<:ڤ=SARlJhYs"9|^燔Jod;|WzA+3ϧ ԧު~Ro-Œ&!InO sސECf7rqD.4~]bKG m}x׽GXww_۫81(^찀*lc,`V9O/.eGU6SB;GaBD|9}clEmFY]_LOfƽ*?:9)v;I]V4+]jU Z(_ N5{Tj{2E9 ߈mG2ܻY-w%WL(iP?Rg#N4[@w0'~o(htbIvJ'?} 8)PC/$TGk(ع(QEuFPLK_ @5$~xR@yZ=BTgj˶+.UZ15wӴ69rDEW'@9W!cDt0@v.[B7rq"e VJ{FhOE$ iq[%vnij~ztJ >jn4%Г:V{pA ']ǚ2aY:)=5hz.YՒ[ m==~zQbcnBJƓsEPU%:ڝaqzDF}5o!e3G6؏[+xOκY6j[ꬥ.4cX>btendstream endobj 336 0 obj << /Filter /FlateDecode /Length1 1395 /Length2 6084 /Length3 0 /Length 7036 >> stream xڍwT[. " EChJЛ"K/!$ $&Az]8RH/"MzGr޵]Y+3L3!m!*H' PR  GzbDH/" `uJ D]@!PT(&) DI@np;@Ξ(8sb<N B@  r p_!8a$?; ͇DAe8yp ACPn;ϖ 'ȟ08iq  XWfit!` g 83 F:9p`wtT40arD# 7d*P F1h>4g?`Yatr 0h)Q0= [#aoBԔ`*tP " .&$. `ΐ_FO5_og3n{An ߆K@ l!P8X5? 00;$ipi?FWEb؃W az{Q6`H,u!n! "~FQLT\9~; +ZH2 j Z;[0 :#XJhN~9]$/vO4M 4v0S`u(#H'(" P Ob]S;/vH `D  $W`+ ج˿v񀀉'ǐ``jy:w;)'&VNaqS**Vo\N2^y eRY2پ9ek$F"T'.C$YӀσڎxwUC[۪5K<\4.R?Zp Z|nEC8νlg=ûu]P T3YEn/)mU)h0S(&4P[\0qHoPn}O>iO}m'=87Lule{ .wFU`Gfg~Jk|x2^%斺 жg:} dbѲ3Ɂ27h T 1>V 10Ch}17 -o_/ /ݽR5I~:mq*Dax$.l_@٘?LG?i-LXH(4ut982gJ/|LV{xr/йL5"&%U nd>;hlp;z6{őWVrfj—,ȇGgJ}ded~H[J(ףʷ6 'Z 6 5۾YۡPKj3Hγ<\V>vM\sȋNG<] Nפ䚘_yMzO$7 3C7<N6}>7*#lT.Qa>-ܠ#?>!:_ƈ6q(+ t!A>zMi=8eX67 䠙T,!EM`'rz% JBlMMNL[)%ĠN5 ]\I7)ڼa}3D%B|:FoL<_SbrsSPC ܾuͫuJ(iZ-$岍ƷbTޝ,wAC%:i \Og L?7$[5(WF.m>KGiHhVV 9"ۻY2B)9/i/S-Ko-.e^$6ߟB5ȸɕ=Жbݕrq'ČdLB{S@?"ͦg¦ ۪t}3Dijx)0XiOIMJdp=G%ӧǫ}iJ8d2H4O *xt!A ~vfGPbnhCsVS?Vps M>}>ʱ̆PuqB5L 7G2 O'O[E/ ;`o/_qھi7/eo|,j\]֮8=@݅˕|hPX<%x0B;n3N\oD령փPW*L֥^K]oZ:>TXj|?B:!qNۈ6ʯN;iuq!37$s)Sͱ_'iݶ훠^h(\++B3fLy+j2;LfІH.RPXԆqH۾rԒQn҄z{~!9²cbXw+4lݢ4^uJR~<, Ⱦhb` ~ yBl3z0-^6yFf!mwm2,: bj7IC|]n=~oL Zm1TNP<@=,CyTa9hdF揘^z.ξ$|*IQubCD'րiuרgl.$krAeV򂧾xxb({DA];S%qf1|NnszKbv *ʉ 3jN;WHZB)Miw7T454kOM}>W+􏙚\ 6fӂnl>zm0UEu5pę,jJv5Vd~]lqq[#$*0͕[٤\ׂ]cjJȇ :#dWrBy&0V=lgC9ϺR`qʍH0mߑN^-vٷExcV JT#! E,ar5(ǂ3gIJ_ sɑ)}*}>|1'W[ca㈛'f[.;=)E~cy*Iame aRQ>eTT \bxVtV[-m)Q^hdͱ dVid`x蠷$,9-.O2t7~/,3'W֠æxwH,)Y|+4F_B9RGRCuiHI\7x`V(А9* :w+0i2v3sq]\7DUJ+kɞbs!,"xC6QBGqv=wߔYB>dag@VƏ}4BåG@S^pN.XNx@<.La=ޣrTCxwd=(%VphԐ%ⓃpE'EFwJ!5zA!QڪfE-Q]`&e,NU"v&k<&V-ChDB[9΍.;nM$/r|ޞEu`E;F>wR _`HT><${U>{o _Qn/v:?{oMEzD3H>!H+<,sp!=ʥ7b%0.ޅU+xyg߿zZF~Yndi/YڕhƇUk<{2$"5MR6dGqk;lyFP;g5 SRJgw6,ɕEl,-G-so^YWXH'RB__7L YWͧuGR$*zH2\L q1=1rh)@hT%nZAX?'s/;*WBIvD pgʭM`\m4Ӿ9| wgOl6P9>XbT_} ^*n 0v[JfVi|$l7e]!L nymD ?P~mY9K!-̟f~*9q#& #, +s ۽Ap jMn"ݳȻ,ħl' 6 أ V/R8}XnLͻwa̗C<`UBcP!< _o-9`b޻psS">y|DcΫ5]̍F@ wȱV?0d쁀$; UWSl>S'١RH%}2~RF89NF׆>ߣ |UgJו7ܝHpmK~fAF)MJ<p +\& 6V^,*,.rt'[o^UH6%WշT fH<Iq -KoYU쮩}-X3s`͇S|i)BtG&~'-pBaGhgmp8D]zƤ1x+{uZaMUQ Cow8E_ ǵBtI~߹yy5Vr>/#w4Ϫpi֐\3xM`_H,g#$r3 i5to\ͲZE%k61m^@ETٵ:dۂT Je10Llgئ`M`[L]sp^_I`Gi1=W1~h/mqrB6*NKICO#RIv尥RF+o5Dn￶{HE.[S_:U.HZN^xL"9Zs|&MDj/Pr&$6zj6St_(\ـ>(:UG`T'w\Xl@+CQMy˘'MrYw-/̝pV<,^ڵ%*keS1RslIy/O]#O$z~|%sШ)ci?#(s>->Krv1V&.UlA*Ч~L;v{-CU }`HD8*&[-b\3@xK4Po #ymD=$@yt]Lb<'X:!JHlqb* E n.>5eyVY;Si Vir=, (GR:<mTI CU?wy1OsރB×ZSXZ{xxg ˿PӵSOs VBx7p7~eR^`&%ZobȐroyuzzB7DZ%8cxϝ^N"O\Ь3 GkZNՄϳpJ)bv9~gVh5+YutcXF]#i9_*y]cIt@y@I^c+ۄ@ V',E㬹QJ-/> stream xڍt4֮!z7 Q"1Q` FaD [E/[$ZM9{׺wZywrs<T, #("( PL%E`$p_h8թ@0X?0 pD$eDd@((/GZqA`! w"VF9VlP>p=B0c VB:((qG ^9k AFXUb$B[ \k~ ЂL&D еF8,14U!p6 uM#8߻;_(eA#VK)q H/G q XߝC Em;hI akD_i)HɯTh8{6kD"= $0ga=$" HJp7j^(%v#t3)`(`B I[G#@,D_aC!{*4Lo )(*fy APu% -ձ_%ɴPX P~D;_Y_ @vvͼbs3K0 K !۪`‚YPD\(Gp! d~Q?F9!~-( lX~AmL',0Kc>TPD%$4N]=V"KP7BHDI~Y(FFQFclswCIfQP7̮+rvN EL0ݪf1:isA]" S6-%ǓO=V׸ ֭-p'c=YnMSd$(qR#xS9z5HJ#Yݛit,[`,tW$x2?G 3 IJP$Ƶrwofk{.KMU>q 癅.)Tjt:l' $}9q ; &眄6i!ֱ$ -9)k֨bw3'oY-hm40N<{mi&4֥|+$C ]Tw\@5D9@=kb'V9YԔ1`47yJ,_:Mɿ`Wfˆ@/[Vg/@v'H&:1U"zEϿ(bކHGy. _I)~LBjA->vŢRjyE4ܚbWDqPJ%y1AEQ]AqFvn$˔,=).RЏ 1T~ \?3e?ެ>(0(â_q" 4+o\%+#$&\)ANxBÜuz`4y?V>\Čʄ rHoÏ$R!Lf Ϭ4;'gaڡ1"=]6fsxxMVBY` _x{mZ"z<{+BA]ݍȶ۠!20 m*,S#ëbÃ5Xŏ^wT%Ĕx%`0 rrv-cN 2jK ̇f$jW`s4ID׬ޫ9Bi]\qѤrdl}~CVXq*fz.GΗLg+ENhG6C9~ KrѬ#|N="( @,1^ndҤ<◴~>+ҲYܛ.T' 5-&x !/æ$4Pu4#\fߙ *FgUj 9qji>F+ C-g}JR;~tM2[ʙf{9~Ř]g:@Zkq>eԙkBE<6Fw7a_ b&FYvB[ KW!?5YS^K.'I^=e<|V]jh %>ڽ2'\WD8&¨6Ҡ!m~5pڗM!iս+!BdgGЕ*SGlU(2H-c7<w"'*~zR?L2,m{7=E"}k)Υr)Z̢,2¶IŞ]u*☩QJ;xьGմ2 uoYb1b2z!:I\B/hҵ;f$ƫmִx(yYo/#^ O@ )s'_? R׵ƿ@d%YwkqUS&]N(r 0XhwB&xľ*> A4Xh[kŸ](V{.9?>jY|џ )_qpO kDXyBtq3+${#XNG X2eYb&/ o^P$X ә1x_#rh P8ڜԚI|;zp3?c͡Uؘa;(~eͻ`Zm$zg7F~e0wE$"b9WO8ddIH:$le.[ٹ~/PKJī{83̾ka:hLpDs\Ylt ^idH|]A njB5'o.&)"S"Yl\|*^f,ds8 ?-0.BxA[\J>c4(#6"qYH̋S}m~O_%mr?|tGm&f7uruZ|iH|Чۣ'GUȢf[8>4i]6~,Ma\!zOsoj_nm>;xRZjw fiy iʵg[ƒ=hR<~tך<!䱼OV{`ypGir7Ua\ģ c CDKg2%#Α?4=<7I*OPnf6CRjZ>ٯU/uPP.[}^q&+bcF=X ıi=xqp^t؍.sn׉C.rĜ6E7u7r7LO#eDe cfd>~xF_4#8?8o:Z6.ީ\LI ҭgvjlV:(2ONVjt1b=yt6 pB.9Q~1 ^uΜ>m x`yvLȭ3y96aw&(FCFJ#%&D+ 7 *f'+h\5ٽ7->r6-1z|;PҾd'FU`YE.مDΜG#(l^I$S;P |4,imDޯ;xg _?0 h(} /Rup^Z8H$d1ntJCh/ì{J|ЏzrZA.Y-] [ h 4w`[Jfo +tᙷ8ÿM+Yfl(*gii7{4Y  (:R{4MYy C?E'\F˙rvܢDП*xHE T U;ї}YN䜀ΫQ }DŚds&|߅WBqɩJ|w0(.4$LĄ7qKf M IIRu_g~:evWk#P1wI oPzD O@AyWaN@SԻ#M# Ǐ%=\WEQZ!|?1,Ė[3}Zcac|D'|9oP*8>iXM-h]r%ݦ_)I"6sy;h0S}kHOZ޽s gz}ŶK!N=a3H;t5?CW20&VgLPIR#f f ݰ<&nBB~L+bQkQ.SM`$@`SrwZ\8iF6`btgEu}ڗۛ$MǞf < y8CX؎xr(y)͘읒Ʌ)N%|lU]K:ٱ؅nLe_FIJQsH>%^^~^Rů1aAhz_Ѯ.gP{4OŧugI8tVn1Qp?h4r*6qqy:/_Ȗp-?^:q8Zm>>A |"{Gt?c'2O 'ל;+uwDˢ|<ކtUt~Vz$~+?+6~E,4_Z_EN~h M !(%UGاP%Nn~ãgy{ u3=c'ٓotlhmCsÐKUkȾKQ#C%ab¾~>%| ~9?> stream xڍ46,D^"ޙ]^ `F{/{oA%-х ⓼995k=736*A<@Q0pu`(ff= G BPwq8@EAB@ W E qYTyJ8,ptآfqIH9B]`8@:h qh#,aP`EDyyy H;hAP77a3f- ]ar@w%p[A]wUNP_*p>rg.IXZ" pO` sUxP(.n;DC 0]!y)M.0' sMwS[ pw0ݱ{up;o` [Y&aī 9Be3c`0? zX.61vB8H@}`л?o$ @B}X,Q O;3/|w.0 @߿W&wB< sjJ1OZp-|wr]v_-wQ1 'O⿫T ɻ:8qGwuEM*nkjUV0W* w S37H(y@4`(Kۿ4]9P qw7`wN ȻiCz7O݇a{  P+ixy] ϫ`/? x^@>R.|B^$E!@PKOK`uRܛ1q,2FM&jgg-(WɛuI;Y;hx)pD~E$ Y|Ti:R>4 (·Ϭl _'<*R iSk+RyL#mM bPg|Fm,~^K20ΠLAC 㟌XvYI8_)dl".Ai a6VKZo†'/>a o8ve1*;ҎK4σΒp[q/*=rNCDumO5UNZ$lAwdDcA~h=Ug?QR)f3-^ R _Ly5S|NP]ϽW1B\*uӁIp?]aMsg%i2WtFq_=~뚛5>sͽ%}/MzT/bEҠG=_8w"NCw =,EKڢc|UĐp(.K嫯ٞHtV~jq RϹyOK}e:"-b|"uR$m Oө)Ԏ *D+5e[Y~}j^ !}+g.ДZƒB$5Y˭57;-⋏ /}M">Br;:;*8.M;xE jX>}Pox%mwaS}RYc^{UgDŔ󼏛ULKqb⺃1E6h/S2SXX_?US.5z0 `sQM*}`krKbDN(F^<֌YlO%ljq1d1b]D*NLu6,vA|ZNkYn7h)tjT>nfk:[DNj˔5sk): Ge|w/?%Y'V RɷG(?-O #R/f_:En]ZQF_Kh̩μ"-ג<ҹ>e  u~QR6l% Hm(NiNqc$:Fs)$f- '>R_cֱtAPhlf5(XÚjz"p7x%n6ewwr1ΰ=B/o=O E}yc 7 c^J]|flo(UEE-:k#Qƶ9iNZ2,oO}oH~BGb-]MzK2gtkxAA= p~KP+dH2q λJHTp cT(@~B{`f4S%1vӤ#6?FR(SY*]̆F#7]QQN4@G9;mc1 |j`('u[WNcNxru}v$'Z&{2܇˙{03ct,a4~5tI{.Iy&SgťB) f:u 8hٓ\z89pS]=O6D8x_o3PH²Z*WLϺ{ nƘa]_f9Av7qR23Yo#`wzEo3J=ZqEx2yKmfǟ*ᔲ_D] ͳU1x鈼{2ҴJkEk(qG#0fnC116p"Mܱ3.R¹Py[d[M+=2Rc}f =z)` e2G3lʏVU;~ ;ԫsɬͣ_ODfdgGʏj68`t>-̦dF: #_Mi^mKD19OWk #&SAMqϮ&ʸ} mP)dv&?ݴQDH;EK23}I?ޝ7B0aO+(o, dAk!\~Kh Ae ? +&yJya{.r?qp!~*I%_&sAb:$ƾp@2չ->'Z ԣq<46 NM7׿G肵- [< S[b^$ #=v4Iy4 Q+QW,o"˿t,aF*K)aNy}¼j+JH^|YmSXk $A[ Sk négԃGFGN5G5+ɓZLn_c^G]\ *Tݱ~Ng(ΪVXth#Rg~B[D#cR e x[YO?)qU?e.sSh8?Xz9]?lÔn0KH7\)3ѦBRŊyPnm=SɸӬ2v>Z]#|yw* in|؀BpΙ+!ILc}TN\FLi &q,f[ * !/JFkGCT`:rp:eYMHMNPKZ^)Jb7ZwͺpnXѭƜ.2zg:3\xQ{KDtړ^2YQkўe2r#̏{TNf(!/2KOv~ӦLK- M.> Ӛe<~e)־>$;)NKǹ* G'W1$!rZ)xiܛC֎PgNged@;*?Z2ی{\Y'ـ~ani1p Wn:p3{Ny;mw=i"X<\ Z8u1:o7 grDDH˘kYdO " } VO=lѥ_@5C &m^']*uW$8t)d$ISе/&Ih/;j,{ROq& '-pwҬ) tYAǖedA2~Vzv{I2KTP!`}QChQҭHIg)Ao4(dOkKyu2 W!IcidMv[ίj&K*W*80.2N~;雁I_PQ@?UP21;b@0{ǏY1>&E۱x9(HR24%Qq\Gg0w5 zǶDT`(wkwb@Y׮rҝc+׿&4wE\dQgÑK0$8,c[*\*(9==%o)%Jm@19RXZ΋rj6p>/?ꎲ&K0֋5<)_$+N֣|pz='[ t7‹W/>)\<]yK{cb$Mp}zY={b MYЯᚁ׻BeuV"džyU̓䋁R[?̩ =P \5|z("l$gQM}Y8%^vݷñ AQMܶ9 }o'$UT|NaP> R(1?= i<)owk;yL!ӑ6v/Չz Ūk"a49sGjD r&ز,cIs߷t62ҽWS`ͺP;vhB^R;Y֒\Dתѯ<]SM?l^5Mȯi]6.,>"Nw~lɻv|:4m8ƶm1'X"j%Ӓ4^]fi(,|V>oMK֔%22ia&D]EL[T# 1|cq|TY0ӀFZ?z)n|f{G&ˍW}HEA?zKc/ʉ3-oL<ڀ gϷVоRw~Ab.[׳a]hxUu1䋌2PҎ>.GypvU~\2)l]wbVo{!/=jqփCll ۺsӕؕ0wyR:ԅ, [K v%&I$ nc{[%UЮ̏Y~b(X{),T ^r*W,9vxʐD(li<}cadxNз刦/6_$&%$٩M`5u m?ɇ\ IxxPMнȚ{2~]<FcKge>-{ ֢zYp";$!i#76B] BX%6)!XMEXNnj*j6 A[ƽhyElv!&Q5iHXӛK+@XG kT$7tl̼f]L߈U_Lѣ{*&`WbJ}IYێ\$̼/ʾi8+ tx?/15?ۜh yݓ]4 n?BRciSV dG|)SnV{%3" ps%=Ju?~B1+)3Bq,M1i掖Pⅰ7Skdevf!4X55}hפWxSݯ9r@lGa2ѽ ʯ:<d> o8sUk>FXWÕv^cPF5k/'#Xw>|%5)jÆ84Ո;{%X.H*3#ysnE{@endstream endobj 339 0 obj << /Filter /FlateDecode /Length1 1421 /Length2 7256 /Length3 0 /Length 8221 >> stream xڍwuTTo6]*%)uAaC@P:D%) i %%Q<}uνu3ۡla*(_@PVW BDFg?"vcBJD x 7HmtBXT,&)  H D%%4PH;"w%bH]`h!0gE<|$qqGeC{ߤ onD쀑ψ! AÀ3 Cx"`hf{P] u!k u:OB H@(Wgq ~!| ;P 7"E#\=οI~9ge"p'ݟ /uB~p+! SW t"gDń$:~oa #ar7D`8ChOX";#DVq7@#|s?+١ξeߜ*(|?>'("" A5H8 ߛgdאp]Ku^-D7/H)wwK*B /ȍ|==nFAu3 59 (gS s kNΛoeHPNa1ɲ2ך~#ܧmO.o ^;R 8Y?iƅ~?B.k]SpUFigO`},7M}`e"kCUan6PS|qqXa-Y- cv^0lLY.XLܼy)!zOfc_P9O 9n uK.\Ϙ<:LWYUVr"x*]O[7Lz^kE_?1?S".]{] 4 q:Ag^~؎к-6>[J/0٤g^ vC^V%0? +XLFi!dܛ'}? * T (,s`]pvri&MSkܡ'~9xC9,-z<ƛ7؃TyWkVvcf_D1) -; P $_Q͈Mjapߣ+XgwKLf^vJltE\H|~ePA +,ӿQJP{{>2?&,)sAD'rO w^P#筱-ljiMUG9o_QўRۜ֯äI%ٹ[7F瞩* s#.#;6Q(KN!;E;N|s.U+9Gc#{95 78ʵ&zxv$9_KӪşI6$S{P\y:0&aQndRsHqLkW甎uϦ/OV6V&ZHVkGNv_ό/KekϿ8Xd7jnF]}VlcxJ6;GV3 IkR@TwXے( U75fsYz€mem mgLK64.4da!iD;0ψL:$h-W&<9|[یpzvh&#׌587|kb7NV(<ܯl$^pi͠ȧ[,umvIvO|BlEo%-9-%Mg#hUgj5ltJ>ŗrG" 4q;*PT P#9br8ZCG!t uL ȺVtFSgQW常2 D_`uHz+&.][fW;fcf _IG3;*{@1GRa C> {aAW<~HP{_nrR^S?1|T>XS!ҩѽ+ Mi8)~˚ rsɽK&S6\"ܿ@׍:8󗦬E'ԬHj;[ c Up`F]_EٛF Dv5˖nojrԕ dSyyǷoCQ 10b45<|YÔRaE!\`tw a<D[3ЕMb\>Bn_yh"'$`*LgM|Xw~@K[ JӲQԦk/zLU_F-M3xgTWy0a_DBfg}DoLNZ|҃n! Md= d2DŽk{2ޠ΄맏'6\%}xU65}/ks&k}Ec;mPq]*RM0Iؾl? S߶c5wLߧ)qh<B&8o>U0t~kf'~BiTj)MaҔ-ah_aeÌN<u+(X~;\śWJ ?4 ]P |%Pe\pjn>F*mV1/I,P&΋y5ԛh&NwLjGkGc>3^uN7[3 Nj ,fq6;J}c`ɮU#7_Rsfԡ,HuIcozqtI{ Skm`"|-` &MfR+!T-R򜵘I4JDlY@QoVWGd1ױk -^?3{aidN"3^ cE*| L,eY1As1k#/ӄk5G>|nfpWҒϟrX<0P랁VZT~QTfva"|˂p;QhT[N,=mE|͌+u;/vS_8Ī]fzw[ 5><+z3aDD^$V;'MX0]}ot bn5<NJcҵi|M33si8ṳ^< y+!GZz>d%.uspBbv׊22ф8o{Z#a`M`ph( F/i19xL$t ȹiw/ј nK2]Zu7[޿t|Z4K EX/dtU1"k#t-\z&[z3Js{=u kr+,]oCrn!W5xLܖV?m; zuN2!㬩kH7d41JY4*fc|S1.kѲ3i&>ۃ֬oq:G ZڱDgB#L B <m$"jy0tgE3aaܰfUMhc=Bp=_GfzbZ5ȸ[3Ytvγc6Z2bib3"1,\e|k)~S'Lq8V93OFukIa%eѺY$ /vϹK'i357N[.Q8 3杠qsp+XgD{tYJb라%~5CFz.E.)Lde;;}#:~-ʼS-Q ²kor^{Hb 4j,Tߍh*^pd1bZnE;V8@t(U0]P~fz AkjR/[ }aC6B2QzRPΏ?8>DJVTKN]K,=5鹸BwsqG/ؕd2>Ѣb_* iN yp0z0{Jǹ%|W`腳Ľo |W=<Hָ>jkz1"лDVGQlnKاW͂%Vť͙j= tz?{~9{/1ov9tHCc%,'EFcKL󋦁[ֵWy$Ά=_w,| )P,ݍ/&"#Stz>B8lfY0h2x_Rdǜ1pg,Ou9· \$s/呇ѥdְkgB%!=aPDŽw9_ Tv(7LH(=w$y|,xLV $Sp5{5\gJZɠ"pحWbipͼ4.r3{ I@ɶ].9JOD>!=VZ궀R|f$;E4<^枍:ާD|ա/eRv]j_/#KFS(J{%oj tN?deI5l8]%/\^:<Jj~Elq'WΚ4a$75AE_][ePc~)Y4JVX@q*qַA3xO,\z <_ :!*)OIh27dE~:D q>hM.9q4k8FS~BҚ?bl:Q>D H; ,2Z([+#}"Cr~YG~oC^\t{\m툈H؎9uب%~aB[,mzr PVo&8\z.Y8>wg~S;0lj r_a>zs~qP1.J#r KpB-+P5ފwǍ'³Sz~N#MÒMϛ(n/O/#>?QW-T mzJJY>;OA76JfsCS{R"|KVsZi+oY"}"%1m ?̇QԓoSE̒}"mjIMVk`EJتD<Ī1s3AɛaxaI:_o3 'M1RM[@lO+PiMwF0m̟ 3ߪ(.7 0к Ǭ-jxꚻxM>mN*Udw^].ERT׏=jSӄO%\ŊQۼt-NW*o$hAשDg$q3Z⒉tq?5A9pZkX)u) Dm9=!}}EXE_JY ݤܗHM#7AGxTIK)M]-҇-p?m~(E_X4QNT!3B5YK6kIE}]˺0Llb4!zNۼ+qV;3y^3?$d/WI˛6V߱t"^7Lw}+xt}DԸqDqCɛ(9\~"ZƷ Ϊq1 Fg%1]$k*|/!Pp;j4s֚ـ{ Ew{uillTetnqHӰ":yN3F DQ9t~ڶ!oWy@}y$( y%Ñr(!h SPɁOCn;f,QD'״ ?<:ݍG gNo@BARZG&|~ӄ5UӻcxZ(f´A QIloIh3h~:a\dr8l0-/3?"6uW~Qܦ}ws*gR^GՐ4s`?li&Jw('hmצּ"1#MfQAaJuW]jBPdw^ im4^3j}yh\;69$8A21 \m887 R]іazBፒ![XK^3K_0ZWKZ:/dȺ|"k| 9^&==ڹS &{$ָ%-Pjkhb4yh2O$O4Z\endstream endobj 340 0 obj << /Filter /FlateDecode /Length1 1392 /Length2 6059 /Length3 0 /Length 7014 >> stream xڍt4k.Dm$D5`m(3It=JB$ZBF{tQIwZYns]/-]>9+% DǏU@ P"ԃ`8HBȻ hO#UW0@PLR$%"]$ 71?@8N.p[4߯.(7@PBt# !h[##EB0JpI٢NG?FGt`( seg5~"N-;FC\`!PWUQh:?O?? !P( #lp@Ώ@ @ ɇAK XNlg?F?wYs̊+y# FObS#-k8VN+LE"gCD%3@ +(Ӎ Ƭ[0D( vqz-"AAXlc06]'@ bfD8xuZ`]ue?+'!=|>!Q @PH\:Z9 Ay1nHG!܀@b pt(yW??]~Ź~8+#H 5.`14#9 |"@a8 YiP߬78D~a0i@0"c"( 5 (п h߃("H@\\ DXoAJ` G јfe_5҅= UۿyD_ЇAvA-r|˟DH V~E˵D*7ڛEHNԶY[. PJm]Vڌ-V6 :=t{ˣJRw*Nmwoޫ'q^\\'U.T%7J6k|~k|dw}؍М]s2/7a: 2qʹ z\#_=q}#6f颞l[ZO21Hd> VxB]oL"$ïC++N݈yΛl}y[gSIf.ZkEM3Vsܢ)\ӓ UfM83Ú"9+d#>l.9"bc%s;7:KIOCqrń4 E L:Z珦mO=ڣ>[-X)[wx2uq4;Q_&ȴin3F1/wP8O6MTw2}QY$~WƕdndzD Fu|l yD w oGXnς$ؓm~v6jl/kǸH(H8v䇛4䞊6$}BBD \iV/zSTԟ$pq\ ޤYahj58a=/<2QYO8 EOEv؃nKZTV > ű'E|Px:SϿ>Z"b<]|SLKQg/y[/VDtRmvPHKVV)ieeoQH&+^]k f,Rď5k6;|&NB3{%}SINwE]+|3jM#S3;swH:Rl:@+wh` PҴ]hX?`L:Zgcy&-DZ<70iwг=ʼnzK^W9C@g(^[/Y 1l1ߢUzH^xx{6$Ϯ&lSA*L'ͰܮKtǡV}E!s;͊hJ"׫tFZW}2Jxy4-ԟY%4`}H3rWn^i: xo628UQ߲qlacJN}uVEP'DrE<) 4jqf*l$z;wE⟞L0TgxE)=GYѮ=݀M\NAY>4C\׋RcxfO&VS$1`AwERs{rĭ,Vق%qt=i%7loƑ$5+ MebUꈭ. 8oB߰J!̪&X(+f lLRmҥwsDR%ܱjxcs lJB*,6ŔצL^ c?l^+S^1NߦK[)˧&d |X~cXɰ\8ػWm޾gȼ;Gĉ wIyoBjNU!$V+Ђj~GgY3bw< JfHr*L~8çWu.xj*vHdo-MBff4_w5R}xe4?i!J7ʹBj%YH.Q[[L;rCjgS; ,scOX><"_hwY_*Cqvmh+Oi#.\!yuz/i%op>+-Q߬cSnB7 *)og`9I0hFKIj%k|RbLUFiJu|Z3OiJ•YT s@g`4\Qc@S:{;'q.ݞ>za7P4Wt7 N~r"ӗiq}um5 %\6E]R̋tv5kPnX\u5I9 t`ypp[Lm+R^SqTޘkKfQm-1 o{9_̼đ \RӯhװOT=IrI=d$Z-*h"[o}G牓&OcZgstyHUƠtFt9hR)BS3*S+p܃Xs; Zlee5+*&{f5{:"{wmM4 _ښ[J0Kwy Ps۠F=÷s4ٟ,l?X5uRF}lcM ѢHy+W4%//3o2NiJq*O"!wX'*YHpJ}WWnǯ^_Л ޜ&o?)BEFOlA2gl8y洛ko8VJ\Ræ&Tγ\[3`fONq]`HP*iydp~ 8*vbsUs"u"J ?1؈eU}TvkxK`%їy;FY6‘+w_IkU?͑bf'&:0=ҟmixm*/RB/(h?"}UKܻR~D_j|%-@;(K_K8x>g0 umewoԸ;W:JaA0j#x-ؾqq5%{>da | <%z<)YZ?GEX)JsĘa'-O u?@l*I]NJA%|8ô%{5z*f%Cx/9ڬ+,W=Ty}9GmsF8Pt߶X vɢWA{}5M~ edrvڑ6ixգ{^Z.M%rC#M'vT2AlZx 2Ob* CC#"O.Du$Vu, ~XBXj* 38D;0Й{-umSs| 2h9?EൗTIEdnp :;E 3硍rda__/2&fBjӷ' yE~>cTje[]ml(Z:A2҅O(Qihq`;P? G30w[ 'a[>f_$nsZuAO)u]i3!+oyq,S*8EWԠ;␢Pe _X`DowG<[kA>^#>n=l02ΐn|y!8==hG^D)yt?\^GMݼϧ:wU(Y{wM)PKxSz:}ol|7֔RxxJ)dL@}>Eg i?G ?a{nI Y|c"zOm׸ʤ ߢ;Y8=pĢH4 Xlg?M3V &&aʼn`)}оF/U5qŇsņk]wrendstream endobj 341 0 obj << /Filter /FlateDecode /Length1 2580 /Length2 22383 /Length3 0 /Length 23854 >> stream xڌp] Ǎmضm;i۶4Nj4lаic9̽d=kTEQ(WTce3SRjXSj]\0wd&n ;EG`ca @stS;:yX[Z@cF `f jt63q(YALf@7 A#`dbb)Dv].@s_ LtO аvGhivf@W9JPU(;1VǀlL _v613sw2qvXXR Ln^n  M\A&&v& +7HL@ ۞+_-24eIsqG{{+_IX@cfg ks0wwbtvvJkY,,,ܼ3efWx o'JֿĠ}&@x_W <++ ` v$ZAw豀 `O z;:y6{t5:11G//# ɸAF2upS-hL_{b-@,,f_? )w;4&vH:EG8_Sm?G4vZY7!:Xw֮R^@sk73\+v8ZZ0Vt2:\A[]t0s48&..&%'t@I `frpt@,]('Y/? ,q#o `/f0KFf߈ ,e#oE7բjQ@(FZx@Fj(oʮkFZ(oʧ_ ҙt&f փj5@zThOs\@/CD 0AC_6P Z^_>4/d` ZCNUwtw#< Xd$de۟fmG/ ruzP9;Ԍo5(`=d.3{vP.' )2k; 0i9;MO5+fkaL49AN@{e_6@?v jGP鿓nV.?5yAux)@-(T^4sw/zlº?x2w٥]*m]vȦ˭hh?ڮ$/ߓwɪO~Fj3?:ᗦN62j8iBwvAV)ĸj\X_%\1N3V?l4g ƍ e,z\"=i{->lxxq P,}]j(!CbH_cDe:d˪Vqh_aOQ|Kh4r!Sƪ4pgXwjYؤ~o|!Z>59}eHm.&dҋ^["Jtb2xk+ptdJ]7; :{Cm!9f'G$MUa@x~.8Ŧp13Wjw/U*h=:ʅ\x60zL%:!fh1`Ԙ# iWj*a|hh[Ӣr(uL˃ r`rn`T0 \Zӽ' 271cRdR)WQ~uo3-9Ĭ,~oGMKVa5GA͟?g  p`#CxpMˀ seȻ?ejA[gb7ɸ4z/So:_wts(sxev~h{oϲITu(R=˵?ps$cL+ϴ&{یݶe[ pǩO0']JmYœ+ʷ S"%l^$<Τ kw OXcGE>$8xXF&0b%CW6u ] Qe>_*蚈EFBUfRݲfZ =!z(0}أюβ/g{M:ia|7UV*g@Y,d>w5E| >x.+]K +C=$zby)d_E, 츼#⥔~L+HnWHu|czyL{eG(Uo!K<+z;i.~8<𠏨L|;87ӵ^Wκ{MeGg \ kE(1ް0DAJWO_酇# o)Y;vNg֞&|}yDC,h׊1sjtNLx#34C Y95ma]Uk|0}`jym&̀'7)("1viECx8[]9شR\gYd`GXRp3MhCaHZGV[ݣXɓR%*݃;3h d3]w*\y#wkN]VRJNG\g X"fiSqxW S̱i_`4x=U5}+A\16=@'n\j]Z5O EWf}wh57*R4-PhT环WX8s)z5q _"D,[ҍTy ?))Yxz{9+;"K,^UdEvyˍh--W{9j!HznդEcZ%pn3!RN&M t&|MTꥡmFqB]Ifxs΅Z~!GOO.o箩_ooBet V܍t4M^@%'1e|rzAς〰enɜqFnr.JA z_{@V#`Z 䰏wG(ɶQOXd^O6a.X㛮_:&EWHnEXܫxqɄc~n_&^D cɹ|-O6[sϚ6qfƩt[$-)r ybI KMHvg"Yu-D׀ *޻ֺ/cȦV+ܸ% }QuJ* hyh.fGho JFӫ1TEzkUcpue.*@3Ҟ{8k s?9qq{I^̴:}/a @1pBmJ.Mqe,,Վj8IS\G;a-V}=NrLM 4c9pY9yxf%umOYbA0w4+q=J]!.&E]i~b^8B]0pΠ|D!Q B]W,4}~酺)A~:rZ=),V]Y30u47认s(FpTV}%ЍI(w.,=fi%tZ‡mf ʹoûdih53Ht5_o[t )m&Iez.be`G'>=F6L^&ȵy 7S,DYS}![)4vZqkuN1gweD-B_lԘN~xP 3SOKt/y?r'c"Zo?j6lv4zw߼Z;7s 񡞵!IB ~ߢҒ׊|@Bx{-?gLI'Ԟh9hȦ.{uPuwt]#"_|q+J ɢnh' ;&ţV;SzseoIxah&:{-ʡz;^1áEP4io]6 ef~VĽ>;S q/&/Y\7.{ E OI֢2p3z<\ EMF->5!&@,ٷV0 A|0*T( eB]H׏X}WĤ81*P=A^ ) ׿V wx|j. kEul\"~g#,ב .nLgrdc{TLΣz[e4#]ĈAGLDauaߴб!M]IR4) \Qn#_5f6š?Jlyeu~&YUd@Man"w@̬C%!Zm+=Ů(ѷmܼ֙_zGLKWёC OEI)*d]䓉Rw/wsɐDp~j $97աO9#^mIoH*mLV)1 (ghmy|nݹk6ytA;(GeP*ư֯WR퓽9M+w&$usN]o^jK{&â]J*~iQPz8!R$ִ8Ϻ;]85h`O%{w}%WmNx,PH\j0iT.Y}[gQ-'QR^:Yf}2%, vW{RT6h%xPB5K=ik/-1a9mې׭aEYsF(ruDblI%Sد|x_40ߤ]dQ9oU/~p6(h޺,ֈM\Cxmvͭdžukk4VmL+޸G?<8uSTFBB6,հ& >>BUa3[ʭz351uNވоF\FC=C !XU: @'L!-Vtln!K̀O@IK:81sT?< G5Kt<>D<#vZJiAGlK2*}8ug{ڣ R蒊#bv( (Tw! wO? :y΄Y?Z8$Oh:|R7T1=ЬRpR-QR+Sv,~Vd2]/Bz~(j_s P&O6 Nߦ݇׆Q@:A#7e' ~@XI<] 瞹ՐĒ7x =qd+=lq*$<0<Q 4`+;9k/Bh]t~2sf#V)P(0HodMDʧ/Kd Q lJZ#+xysGF s(8"t'1ւOMDePNcPZ[Vsv:k<"|k.y1ǹl=̗r=pILSvܭQ!|Sn'N2[]os,_ƼsY7;7K8Oc%.:Ȏ0C^ڧ*Ev)~U%u-TE<>"xl˴9'om`q~XFP*I|2޷4`.Ѧb|d&R,E=%P‡.^Pr3$'g!C#da%0K0[B:rqCRY\X}=ڏAL^L<WmW:F15Qm*}ՁJWL!kwJ})R_Mq9}S8S|v,wb F`6 G*Y֎ߪ&sL8XڅX:V$~DB SNuͨeSa }l$;-g昿L!f]Z Y` ܙ#ȵf."pq_қBUl(QKLpΒ/x%$}Y*+9d3'15`3y(~ ÍJa@} RCZCŲg4$FCrMIs01niFHuMoK^8 0b#Y]]s%_3]G]`NE|Uw¡є$}4˿L+u7D$YIkd6":J7~2Vvݒ*bRӨCn1 {e_WY7?!Xg&=ＮEVA]d5:Y0/1>}2&8oU*+9J7j""bW")u=ri 4MWiJ_ԝxd6[鹂>\$u 6LXm۾˄=d628ϰ\ھot* mN}; lc͒/:+TYlհ^O\E@Yt:k$ZE3~=o2wkS /0<|ɷ͙XS{xKl>b?kfwI̶߇̞Î1JD&ʬ{L̈Zi"f)d?|ΠiZ Wyn!D2Ek; .?UܶG3% ѫ$[풟5fR|Z6SK. Qw q.Zr4@s=c{c!a{TyYw ҵCqIle(̻` 2&>{I\5$U6O4[ ΍MOwKeՠj&wA랄el?ދpat!8l}‘`=b4ȺeqI9Ζpǩ}G;\lڹw`fٛ"ྸ#fR~_uO03:zҿ1ggCIlƶ3\tB9oS@yZ$~n:H+iz>'㲹x{ka!F>9u,|E@r4pСW /FtGa @!1RrYk&ZTt't6TEfW.`ll ]wهkgDwN=z/Y̦ I^µVgﻊ[203ijp9(J퐀3md@[+&dH0POi-ġ63C_v65Y); )!!!H~a7KKNy|r^qA-/ Ӕ've=ƅl^~h+s?q1a8 \IOnGoy\-?c/Hp }$ Y­ dOMЊ̖_Kg/W+.TZzMY&rnAj$#rGf+b k gNoQD? -ePp+C {$2Պc)ݛO~n#wx۩̅fؚQB<;25,z0z4-.*tHiGOxC>D*.U%gqYgkG@pNe\w__fsnY{I3O}x鍚2v iyRiVQ`i8m+)oIri:_=;7c+a Ҭp3X!di&3,z@yԻLx_VPQa/;J޺yjɟUЗWvh^61VM`>AĘ\ҺI%AϯQm[{m8W|QH~[mϚ!&$?PEds5+>+ ٜZY+gr(;lr}NLL9^*5S/dI@fnM.N1⫋wϭ/Se9I^3j&8F|?8Gya^atdtR:ymk|s<tm Y.O|)BK((˺hؾL*ʨ*jK#vDlN&{Ұg-(})l.#17)N QukaڣXtC7$ r}XkMM\?yq (>Lh0+~㮓.OeFM/i2Ey*l^H8>E_=NR+W@~Lr6tX$9ܬV7xu#7 cm莉uUϛC[h*i E[$rnݗDmcK1p?O]1iXsInQQWE{"HA]IJ/ mL_O/zx 8~2-C,F'eqto.a؝^ໜìK*ZE[qKnj\#lj_Wt5c$l,)lVj"-ݎ8O0)H. __|Wn|Z߲;X E}1u:;Y)W:pرYdþNEpSSrxn Wɸ$kFAA$K.<桽#6|bJ/kдNʇtNGޖ_ j/G'E߭bR%&CJbU j<5D###^L&oWH p1ȄZY>k{2Yw !V^5p؜M&E\D{M]B‘>V">l늏9rt{u&iCveg&`ڧX7"_ϮH5㌹XIӢ깜oBm R&M|Ht7dQE|nj Ⱦ 2(Zrv l҂o Ct!UB0II5bY-E"ϋt2ڒb$C]RFeﯻK&]g`jWEϭ.PڭsiAyx\XjAkZeޘ62z0]}z+wK<}&?s K^ďuĮ"U6_}0P5nd69 Yqjޫ [躸G~fW]hBTaF6-2rkpa3GU¤bbѽ#~А#P̩dqmi*Ag} )hh^/ ,T~4WLln%<>K,M'&`{i3 ne(=vbzfL~9k2M!y WG-G8KtZ7edDut{j~O&v<`_,H b. k-F~U!d/ʤuŔy5_=z.p:b2q,NRAFg(#s藔M>Q(^_O(Y%?.' #wǺh{SSC8@$0^:,n4qT y;.NVRKhJNEdpp lţ0hmG?' yU;\ٌN6 ͑ (a| ' VP{9{(pC6/ &|ګn2&75J&W" =pڳٻXOf[+ϮjZm#&rt])ыS`{g!!h̊Gy^Ұc54g0P=6󌡖κ4fm|lH UpdژxЙЃZ\s;? Ο=BkK0@D\WY5U(%p=#RݼBp3؟Sgce&Z,uY}dܚb{- ib[hmn>DRq撥fM~82δdZԈ̲@#PY\o#j{Rb.\|ʟ&[zڑXb[} ?Sl߆L Azc@<|N* gϞ2wBW0O}[ڽ7Ҙ!0(nCQfVͰ\źq@=3(zrY4m=:3;wVŏYQ:7~A͟º }f[ݵvDDm/)6B /.`fd6 Ҽ7/ᣘDr5̡CDDKbϨn\k~30Qv3_a)+Ͽа> ʬv~p"!X/h?N g-.5=i|(q~[ G~U=?c|2!D 1§ttM28aiCw yc}_"&5Mq!v˂I>Z8[- %NJq`/˃ /(ԩsdMD\uԋO)V4G{-q=oNpv]} *O;j,W$`" 8{ +{ 51`hZ..JKӵqnQ85}֛D$-~jp݆p93.M E^#lNj\c\{g8ijËFd'ۧm\ݩaWm,QI&iÛ)(|(oHw=JE ^E\KbP/ߛFgQ9Z4ވ v)&&wƣy?}k݇}ni)Oz7\#hI:~U'}DF46 wB)=%땪Gܷo%r. o$J/·\b8Pq[B8/XzUq/UO4J%q  N{LcMdzNnv> !ن:<}CQ]+=45 +bXA)#推5RpO/!'ɩ!cBT`3P9T;M7u,g'$[4Lfrm&Vp^<hE,n@j&p~:[JcUx>&R qL#Yڬr\u_\poqDjfYK<yĊST/xzQ̇ mC6n l}8RkYݴԄ!▘if獵15r%;t1["˴E}"75ue5cs?"Xh$-v&nz' |[hm4r@wQXN猋 }ę[BxF8(<H#ts^2Q!Oprq=,?s2rIc_x) ]@VvUMנɵP6N$#hň}^<τŋQc[sTSkS1HA(sm+LY3Ra*=yFIqSAUkύe(*zI5J=R)3ET|h! gj} kdO|[iHU2r!mDEGA} }Vfxly=Q&jSawjVAYi_ ܔ6R!mU߶=se'0qVe[UR$TU^* J:mǸrVw;Ok<ެ~gDSk9#-rn';J! ^5"ڮ1^={>[[q _Tx/KC /i޳snj0xۂ7+{\8h/o;%2.5tyURp{E @0>: z8+*d;o|)$UM dM+9t> bT9ŖٯRkcjϭfxUdCr9I Lt@$ͦ9ݷZ\u`$N=9Q<tnt>R hhUJgE[`/ \S=*O7H>K4?*bod ma:-J, H?dP\oM_QZf㦭#}" 喈z0ߪwWlA~Yq8xi]+wrbjq3T=}+&y> //?参ҝȗ?LTBQTD]*-bzV:%pqYAi;v3"91RQzP,Sp| ,1_M9jb .+_Wyx.|j ho@E^[%/tࣖjL>I\ =")>ɂ$R|sЋZ>'cľ~FO~f>PP| ~ǂ-ܶ"@+Un RndDNFD<zw;_ l)vʋ ԣmf惟>2wʑ8{Wg@ذSi ~oL$®/Hw S560~0Y̾32 3Q | .28TiB815dF;^6ķӍ Ք+q/z. J5PU(SH 1B۽F(׃1ϺpE9KDu]~-'hmd;norV"-Z4o;Bg:'Cq7Uodn?SQZ;K+Œg'&s}SU8{)f֧'d'[FPba}'4Z 7r.9&{1EY /޷ZUl9D󛝰 tSE?v<|rBdy]KkdqϏqއj rh>A_!Eĕ ~Ne" lG䴑ce|iBM:*e#]q K) åBX(\Jp& fOD) r6% ႞vFox3&5z>pe-Qj;\,#To N"q`詐SDzP< 5F`HUd##R6YuVC醓Gz4k'\&W)hGV֞,>]ՄW&S -o4n]nO'q 6 OuV!fh#@Hr0S&H3k$`.-~+꜋=|f>J4$zboˉ#QXU5 (R=:UjȍwVgi˯S{+ʹ^_O .v rRvm]/ ژ>4< h{j4iQkh1#OTJ>;P>c) DdEb %?dD^ߖ@ԙh[:FB^m);[_bc@ÒqQie$P{Dim{662P$m |QiѴh+>c_aH§?|h$0#3U~@@4]XC? 2b@y2^5`WV^ò( Q K{6۬JQDsWL6 ah^3d_GGЗf-mR:u읫,f;)%UgÌE9+2LݎÈC[T;|ZzN z٢ !\lD~$&da0]Ӭ pS7PwN9;I".lm>WM|^CpMĚzc^IBrUb:: z(v}\"Qݘ8j_`7qlsbЮ{C|'dH@/ihXIycO(0d*sngwz#a}(G?|<ǎhMYcQbʯi_Sjɿ$[MrrsےźeA=Im<qH=VSϟ} RDjaL4KMꜬno¾ T{p{4'e6 7]S56Z_SwhqK_~Eϥ7Ƒa`@~/lﵜ //WRKaÒCLyjaBءc[vֽez~Ԉ]u`NDc kft&NuZ>GL ֣}%A\6l/N|;T [b|@dKEc@Ξo y|Q:vbD,׿5ǭߐ&G!Am*6%*6_q`y4D'״`z`_AIWPRH/e)]F\`t"$mdԸ~dz0޴ug|uIu51j5;0;L:z'aWs&Vz33w1qOוs0A5H`]X{զSPl̍T/B*@pM}k({9 xzYTsmZh&qq}=}Z%N>96i $;#`lMWnn': O]SOPZ}/ dteTX_rQbي0%D@5;=p09C惢A_X_ͪ+Ӫu՞fvWnۘ3F:ȝo'o|p:ӈFM! cWl9m|Ad{;cAZ@DTʜlֻkHƒtworB_d_%:S-6]7$*u Uzs-|ƲOP-W @ dd:uHܾy=.5iO M&~"{:,kœϜhQLWe xIs6D?IȡXٟNx_LMvBI 4K3oEk!xekeO9&r ]UzGRLa54!nt{tė-k8l\Q; AA DRQ10 `- Rfќ C|T5*zJ (v ?Sm{7kcYU[t4t{lXwJNW;}VM}y$ |+6?dZX/>312L~j8?lB#mcxk`_~y726JFX|vҲ ZȩȨXn _TƠ{dPSMǽnzFKl*=2.ivm .Ǡ"o-ȷ:ª?fGft$gԬ`m'8ԃ\-n<K]#`20QPBٱ3ң;42|Qݿ[[݃(^e[a#v#kۧNa,h(`GZ'}>TOu*GAC5owFE|Q.n883]!ZCLom1b䑈Mh479x4!^-@uYЗjk 6%{#1UK6{gQ3?ğΣFai jkjetU&07ƛ굜_t #imd 4B|z JʄޑܩY'YM^d0Q^Y3)p}X_-8qD!tNمL FQյބS68:(:e/HZa65jy2<9ɠHpgp\_/9X2L2zB9=ϫ=>T=F⿫S_6vSZy99%{!VGۛF3Ib{E-r‚(6 ?y<<ßvcl(0Y\BDԞ12`J,Y$ /{rx(vŢ=vh3 KTMm2W [Hm.; N&9% /㹂ab,oV3s7;2CGEZ+I[?5gSg[zzc mbl˾w90k}}oSNNcU,3q@:~Ȋ/@Sut4aFV"KEki3ĩ(VmIIs$%Ѽ?LDg6[>Z%jC@@C'_NkLyBH0u ^؁#}]r{Ϲ{|o[ٲo%%p,@nᝊG^0"'F!M\ K +/$|_S&$J!@qjF n4ZKOE` !xn_X֋;Mu)}jr{@/_^mscHom30xJiJPJGT?|l-(Rc?Z ^5X=m}(y)\4m"'jU4{'MÚ/JkP3_t$ћ2"T" %4@W-9i0={]Hv?)zs勺 45#>HPz燇"8Ez4 RnVKkdTB8FPw݉-A:ۈljPgi'H)CٱB=}i vɤhP Hu 0]KK ЌE5$(wo/~tpclPa WT拆D J@ޜ8 &n[{WfFӇҬ/.OIef2rFǫz#D }OPH"j4_[RȵhH೨&ɬSCAtmJj'iKoA2.R._vQv x_l[SDejcW*2Pc=01/hG(NI۽52љendstream endobj 342 0 obj << /Filter /FlateDecode /Length1 1579 /Length2 8399 /Length3 0 /Length 9435 >> stream xڍT.Skhq Np{ @[Kq@q-8Nܹ{+k%|g}}49M!r0gnN0@ZYr< ZPg[_fL ji8h;?).n^00A dPs2'@qdwC-_ d3 eC02 bxio8{YA͍ligaA'b0@l'&@ ۮioC[34`쀿f_DP؟`33{;0 X@m!U9%Ngwgvf+ldvCmVI ՞"/)̥ 0g'_@DZ{pY/`[jŁKut(hf q@AYqpe~`jyrBp;0P3g) /u Q^0[_.)}-m-{@ϿYп~83,s?`G@~L/ 9[??n㯀Gͺ8?_q ` sz{ {P'9;\ lf[,ڿ ;A*n |efr8=*Oqq},׆ p8($~~*C0fxl`auWL KozDqp? _Pe`CG2cK̶~<O#\Q^k k`k=wљkXC5kia=Ԉٵ8a[Q+f˟@8&~_-3j膖='\6Xm;GȍvZe(ߑfR\)Q)'f4֫a 1Œ^ymDA1:WJ@Y/__Q;i`KIWT +ȷS,dO;J{fHhYߝw0Po1q8ȸ7DfepiēxNpfjKP>e Yjz6i\[-A.U=$k֋lh! G7OJYܙ7byL,fpIGAQ,KG [UNqi%tҊ&H' ?(>JK\POa$ICbI/`Se" )偅d2Ɵ?7]}5_6zD4Tb #أPC͸fc Z9$sIս[+{iΨm؞5']S(\FՂv;vb9OLCfsrїz!޳Y+͒%4Ԡ(Z;G0QFϦB`[KalSZzqa⸳ƒ;p>:ݒ%2K?MR.5} :QeJCڼwzTMvHj.PzUjXv, YW65o&Lj160NəbtSJTThy o/(޺/c~R $SՂo?2`?H aI> cjC5ɚbr(`sOt x7/?Ë/C-`S;w0uAɉ1M<|3E+mkl6l_<`HV@ipS'VՈ7DmZ+EK^r%7%k,$kT>6]O<.G=ºLXr! T3c,G%iǀ$>jSd\ZREׄAW]Mג^ ˼i=E3vKw }Ι4"('gK`>J1lG ª\&?%w&'J1q^`/} zI!k $QPO~*"|-z >%?))>@ZPLwy[Їh[*UjVIRQB[ZmS$cK&6Z FY=s]̲RtN¨VoKب%Nu*vufc%ǜWءa'͔I[߇=a)8a!6EUw)lֶ9p+gʘ/<rtn8Urʓ8^d"iR@صi|k/k/l}97Xߞ;BQYWqjm&b!2 mMe{Veۇ:_iz~rZTOj=dDQrV<3Q^ Zj?>٫/UUHMm7Hr͞`DgRsn6Wy~^irC|kN׮>7,8ͿcCY'cNh3CoJ_us<Rbc[y}YPȮڈ.VH>oWKl;㳪V-VF:FOzEtFK ~W1 2Juo/->Vrw>ZT1$sHtϙ3ޗe472sp֥}IX^iPd .t%y}ax%$(w7ɔߜpUU?i5k 0tzZwj{5+:^GR3N/QVR.mq+*%xYXyzsD@J $!| V${%$ xf]D%1e4$$%^ b<4h [nM1p5gXXoe+c˳Gʇ8>D^COA*<MT2&CIx''qBŰ!x. M84cFYYl3<2K"lTAyzreUoHkz#`WZ>$oØ磓i~|ޞgCt)ji.MrB1fY7+Ƶ*,TũgL`]}R-@)2̌_%KSյ,D磒}6-9}|JxGiZ!m, 3#9θyY-BA; (Ƈn8/8𽏎k.jkf. B⛇%8k빒Su0nq'g{ Rra̠lT~o Hͦ[:"ヾSDA1L\zj)jPSoU?Y,m¿4xg8)e'tTD[[{»l6g bE.Ċ떆C]V6kIίzZk'Ԥ}n, Lܝ2~GT ƣ*$]F-Z.0"nhWӳ t_yDfba~ֱ?Y$ +3I!.Mղlsmb¥-e0-Ȋ{8I3 M+oQU{%"(EeU JUA7t+8@G1>W(@ƃ <~2nJEP1hj6FpSY# ,}Ψ`-wKRd7lA5#K#S <@~q (+ʐ═~埌j6zR֬MM_ '泯sME%(@p3Tfe?3,CļB&^3Q>Y靮5\Qi$M>lS`,?V;vu*"8<;$tu|VX9}o0>qD~ n!dO' &@RNR+09t 5gJs?$fKTli9K# ʁ :44$+ 8t>m$1a0zX0 vx dGqۖ=Io\zEK\}ڣh>H:=)H^)ӥHf;ع4֋5|ti _Ga"B?jr8%Fpz!TGtYNGB tWv"j_Y+o7pk,bT}c6l-ڤlпd4Hmx@->%b)bA}~e֯*-r-~(g&E+ʡ ހۮxdKP*k-eJ`s[YÑ{4~SbB-Sp!SfY'tfs9"^S#C(rR0&ގ)+_x('{Z׿qzO(k\7rDRUbl+_{eX=RbPm{l66oIj+5pfPgK#BK%Lcʣ) \j, 5K&4  5srzREV3a`b/ma*h9ǥk;H cf i*o*^ou^d<*I"5$ltm`/jGD@MT rЗ fIQrvΰ:+8=a6z3w۸Hؼ̞M|ce%׿.=L:e}X}ߗ:xfga>}ȍok(@ڃT\)mo~ 9rˑ]FuYcbUa ҖU8}aS１z+z A,/ Q+,}xŻ.SHmmϖ`O_h1瘽4\͚`Tr.GxwWO?|MHlK))BBHHN\AFv^c;wqPHk |/Z h C <>&K~yxs^{Q@Z9pN%;٠z-Fx̀#EENe/0|+X!8Z2;:=zŪ}޷Z[8?Trs Q5MOY!i54cX|Z53iS'G1d'mz-U&$FՓ_:HWJ ݧ݄9s}H2#1ré鄙2z 7;#}kŕbca2K|]47)E;RЅ{ }/ O#vNuqI(n()MO,l\/i l<1K[rS'(8DYoǜ3I wzWm5 :Aύ,G ^%umB1*X=m׆۾ӳ w^zs?gMyb Ki\ۥn:Qi21cmNe6\zs?7Hg@uY`Wx,s37g L Zc2|c;AZ%Pq㾍S-*}LJ}d) k4YV雗V wJ5T:?㞒Fx5P6xV+/>?ؕ};^/#zحDAE,h2)B`澏+k*Ն>ձݼ 8+F1. |-;ηu$sӁ\@ -#1'# > U-l|7%ȝ+'/4R`뀖0Lsպr="Gz{P,v6Hfe`mZoɕ/䒤zvpn3?NQ ^Pum7х y׊{JUYG9dv;ըGls:-JB-lȍs7 G 6$>r{b:>ZުO)viY5axADcn!~b( ~:xgk> xPIfݢIHHB"}8|tؐuCT- !: 3x#zD|á" rШ̊ݚT_/"&xf 0 {-Y-6VG0MMjErXUgIC/ V>GR"{rFfC;>AE0gX[4o+ x?36bkCv?QțB1\6x{>NGD{0έn>>\6p3Db>M3M1raDY^o+<`HKY|6x5G  *ƿEptTW? E7`h yieӿ":zs/:󕶢d ExN{}K>ΕU/FW4arh4b>=]l*%qѹ<IM1̓'%$oc=SꏊpH);{Xy;QrN-r16@ Fp.; {o6aӦ.;qendstream endobj 343 0 obj << /Filter /FlateDecode /Length1 1705 /Length2 10248 /Length3 0 /Length 11337 >> stream xڍP\.ܝ] w'xp \;3{UϷ|]BEI $`PRcr0#QSk]mA@.`{H8L]_evJy7[Cg~; w QK88z9-\_@ 09%SW+kF-@zWZA+WWG~fS;fgKa:F r9335@ \x؂ {W7{s359@]NXOF_g`cf;_޿p6M -,07mhjon 55{5rS*s:]]][d%@.H;dm<`{sM9hڃ@rY\\<|\ b^_oGGk _puvz[ `@`{A;=cfJ/s{[/ßwx3qpعX|\N>GQ1U?r?}=i :zJZr_lL࿣8ICQځm2x嬛+^MAfZ9W=.`O h'Yk^2[=HV0u67+#P^SJo;7 H\\oU4ya =_3pX~@ЫN`"/`~wb/` |i/ `2BU|_ k)}CR_s; &r ?5tsv~اQq9@ P ĺ.F؃ioBhzO;{ٹ >:3hF,ycuGZtaK=|xGնG'6)C/$L}~9h@@~urESǾ_m,laO{5S SfA`uY<8W&Rz3OYr$ߣX"oM*4]HƦz_.-hfe%ex$OAkm= /yt16tD=BwP]nV;UaLf Wyctў? ܿܶi o :(-ɻpˡ>8]K)aj-BPIi`U3&Q< :1& ]S3cIzۀzKӉ7dIfUAc{VKI ,.fO~dDn8YRKKͧhygmZLhadw n7ꞠլbɇjnC譃dt_E2CJy_EdnGхܗQpDᣁiD:9rϗ~ |LӮ0 'ƜpL%RSyU.s]տ%LgQ|:.R| >#i[Z )ՍD]/nY>Q!d7o)dB2)l@Ql_M/>BWyqknߟR/umgwśb ~{FӮ3ƙw+wEgDC-D N=O{D+ltk% > $(/`$T(Ve;yY2kӺm6 <BP4e ;NT$sq}|h)#[1)Aayq>)OVpa=MR~}Yl鋿̜'۶~݁ḾET/f7-#iH;t1=bZR5NQiEoh͛;K6 dM-z4?`bUw1^d#utB6}t}+' 54_B®.z.hvkљRs3)Uu?OTdB"ьg99B8H*>NO'{!ve;;#Q+ BRtt*)B k홺xs^@t v#["ɹA_ZkLʕɻ1@L#_(~b,J)̀4C#0m3$$͕%AyQaýi]g΋DzNIΛ.Եt!pyz XDckC @dxR^W'c6ĿzˠTҗ|1. 3?:$\Z78yr$Nm:ݖ(3ۘ]IH?" Sr0DZ+/&a+3L`mv'!kUPW~n{ }NJT49wՏiXLF ?? XdV$5{5`#6ңDwZ~-M`%v[{E G`ǩ^Pދ2!f.(?ݘ2[7ojO5+SkD;Cѳa_6Á4-NW#M ?&rm&:Im@D뮱v_g ܿi`?#{1uCaYi5o A/Soh'8F`y:"SO߯SR)]*0]/N'Bwj9P 1n#3=оNM=e&]$q]ȸ$WЛTM O#!K/˓BoP1?,l( Ϛd~queXI%I@F+hz$5t!0 6|!+h8)8CӂD2ʚ_y%I TM9STSB[~.T㪵uDJws"2?80E߲jq)5t X$8g ^%/,Xf'5ջi8 w~(R ҂J [><n#fڥQoQG*I#sk2}xI<-JZOH*d Rp\N(X QU/`%["*ߠp4a8?(A@d}4 A^2R^G)m#Y'05<, ;fynl{~V@>.y8a'TowVdh,CA SA] yR ESL~.!ItF$ex޳{]*(-4[ûm7?jU)kj \p!DiL't|@ oo¸N679͓x3$s# xg\沜o,SOαj:kS3~`iredjZQY5PM&}C= IV% Ze6hC^=FW]&`2`2 ҁč8*!)Gl:3YkB:NQh&ᗟ;Hvd׫V fOi_m3vA}j32u~Xhwg9{Ӿ.<㞤/Bj s61.٢AfU9Imaqr. U -GT$޹odںzAM/2T[d񼭾Gj}o[!=0ߢM((G/;DYcݍ`ܸ"KݬN yJ;zX:~.|_NI++J;#t"NFatNw\i`WynY_g?]4krRe2(Q=-B>N6݄S>,Ԋ'ˣxȷ'gѲgIoNb1h3*u"6uL۽,Bx"o9;DR2V;&e[y Zz^6?+kP/锴}T]>z$o1^e1ۀkmq1Zץ.a;QB7e&1Fgg͌ {ė$b!+l=W+*fW}N2$BDWl]/V=gzäz  hYCmDnJLX _HawNX;)\o9K/EP>ВXeitj`4uGԃ%vY:wa[8 P(gJ扐#ӃL E W3EOT2˧D7ǿ屝.쒴kR3E)B߫# 6zN".ho^Os(nb#f K,(dE]'K|%,-^jZnlia\!4x"3rXhHO! 5Jq 2T.KwvRMN5^S?05xfAHR?@E}5o%7?Ծ#߆`{JZ CN6R@SVHWo[$Q֎Vsh/~ ʗV;#z;]Ib,Yu_=)40Y'ӗfts]ݹ쏘֮ Gz_)8\7h_d{ܞk;i)97ynHS$aV&^7jN ?H״/DNhiBB|k4 UUJh4nmBy:Z gu5!Zq@iѕ8wBw6>G,K  vG fPB("8/6$] ƈ!'ly((#=gpq1ݟ7Vbp<#-ֈkXɟ -?|}z_>&`#uS1!)~ZCrA,xD`#F'jiiFA+qİa8KUZ9j .V&E k`il\tI -:7T(t n6DNzvMTeT|=W^E_ŃVj 1X mnAahFx3IVyCЄg\~Vo3f0; g\ KH(4 A)S&hƴ7"ْ #N DIaWcՇfcR9ǽb ";qM{߭|oW# %tCRv.bcӇ>@h?aY5qŽc&ZnR@:01)872) P.ЦoGhBY>`]fLt=gbVYszزD]l8@j;g _nUB0Nk{'[;NqyϐUr%(dUDsyΎlONN3JIL_fOc Z"Į8|Ҫ^"8ƃRjih>0g=M1}Q8sN@ ,Gr|Z7@ |9c]Wc)ERNΩ環6YZөo_d;- XyA]kN 5TZ$$}`TuD%sLXzϞ4xdAS[p|=b^xa t; hk$;_[Q%K wG8%d+G?;Wgϩ@ 8j)x% zc#P."US\Iqk;_%ު45KGN֧LD~aL@|vSx۝6)k)UFׁi2 x鳣3ة*gԎ1՝iPA|'ǼetW͸3A|& $a-L{)F/)z:sYJG~$k gQttAf+O:fZlѸ%WAN-%XVWU.F`/xr!bE]0ٕy9"~iF3G"C"xDK8}ӞpxG"qf: Mմ˦0G% |B2,+"n_:rtp|uapb~M)@t7F_ {d21蚦`<|''>YcJ FS*.Jjcp@{d uu[>nPjb-(8,EkҭU \̙B oʃ+N{hN0%[Dk6q|Piz0x H6( ,էh_c:cKcxj"'$ޤ\z TV-K#^2ImwC!CBSw6b}AQg҇NXR7D(}Lm>/Oɟ~HM[L6!: eX$5/\#~'a&oՓg{e"z6iqjU]lqtA ZAdon@UL>bE0O/yPrĠANj<~T:ػ!b%\D;J?# eeҵ֐lk2ҡSS&DƼ '5jO !s-劷-V% l˒f;0^ϯ"l}2E8!Q,XАs}w"*hE]/*8yv 7AUKkon]m(>[G =s$`\A%V46eWẗFV6 ϽiVy:%}N=XoKcŊBfEE9,$tʫj;!#pڗƔݘn>iS Rd˾?ռ6_|ܱ:d W/&˷]舀+8#5l]b,9ԚfhyΡEsP'CRo=%Eea3Z /<,M%RUzh+$,`w [Asz#Џ;_ )Ow?֯ Ao~HMܩbR{B|iuv!P/)wo4fE7.$VFuonIM%?~N0a8)" s7@bU0[|2KVV?ca9)!Z[{w3NS՘bh'xmY"4iM xT(9)FM qFʢ)rqQ$8{iboaAd) 3nk' `1tec̍v\X+dyOEoI}rOP>֍ϳeJ#[; zQٵ6 '}m3v2cĈh4k{G(8" #\c>Gs}S'IIȃ& )9 TC8qbs~NCp攫 SZQo[gxF*M XnbJw72UA@T$K5-:v*iJvԖK Btr2h9,2,] stB2&H,X QO׏BFdXG.;<4!ra3 8| mouN.ʼn2(;z`lnj2ym}ϴ/]"n̏9_6FeLͅN#cހ [1TS5?0磌BkbgW\ņb{ ccXLP: Ec_7FX45֝ eooi%\Z'*C qIcA/w2ӮZ3~zIS!Ίl**UD(4@|Ls^BiKfFy~YF^9fS> stream xڍWTlS@$T1:6QBc66CB@B 4P@N}w9=Ͽ{LHD"B`a,@T @@9#ZP^p$BP0'SqfH@ %eR @!% P]$ETCz`Qpg4.˿^(,##%Cv2B!n3$CcW{ #QΊ|_8` |`_ !ߍ S.p?b3p789x#a(.7LG`C1c k40 Bp8`#M}a4- Bܼ8q.T1@p՝@{ {~u(+ nG5; U:⦎VWG8:jCeQ-s HJZ0P_ͱJ/1@ ,P{A|`4QG8 p9GljaNͣ <0[Ho1UWUH _H`1(_UA8!2M_}޿g,C$0I/]7t?vsZ; Wo4HijCW#?:h*g h["3Fz=(!0:G *4L"KTBA X ܊q7 ?GCG7"$pB(~S\ {~ )Bh{0 A)f&Pmǵ*7|ƀVgPOIjQU^_{4˟gɦ#/)6UE~S\y%32ԕC-Mm\HwV ]쇨eI=ʳQxq`C Z= kyCl[ bK'~^\L}W]K׽>x!c'T߲1j]n,/3!N\bv{){ xޜ"FTQ Mr}ŁŕA EjRi۾b#ȴ-|Z8w6rS"gɱ/$u=٬J]*R쏦YX\ژ}ВJTEO^Nkn'UH~Y?]-V+H?<5+*ɐEɖ I+j"y X~%]y6Amo^^gHxF`^UH!5}R@AUxvV#kR%+HDᆩ(L۾ZHې_X^=Qy5\gBSV{x:zQU+^4Fa VV1a%?OiMv\u3@`%J;x\ZNu^W? KJTwBZ\Π]=s B)E;K3VR&,7S*EW׭<_!\ȥ'{12{{Nq~U;{/ˈ هI1u}.T. ]5͔H9vz/[h"/I:]H";mvX=L^hf\ .\p:V+zmLR1N9Ujp;[),x,w5!stjh\󺘹|mktI:5J;o^"-cJ5yZmߨn>$IOxLRz\G"nr$4B0$o5 !,*h2U\;"p:v17H`duu%K`Pv "sޛ] 6|g @"tQ:糙X  CgL` *n1L)& Iv%[w"֮`vrxL=1#J}fFG3oK4ǠkZyw}|mؘHhcwNE=Ԗq9aA}e#l-}DH1t{fE1SZN6_f9} dzD.HGKͰseQˢ"6f|.˨Kҕ*cWwؗV:y {) jZ\ʎ3]uMA}*`0X=xْ3k۫=ݲ+A_{:29^8l\3fffrzAW]&6*$ V>g]p_tO/*uu0V~jeʷVן!+%e NλpfSI#;TTp6p#uRaގ NbUjx @O?eHiƶܤWM<)(ِJ!|rї#U\}Bfuy#i!X}yv7ъntHtu:_Z__'_ȖfoF%o`I'sS}wJ0&[ 6m--5^?XLJiar@^ R-4,2f;Ӿ;@ʩ8,}Uڒux\n T:>Oms< m.wlrlH)biK k U{^t{jec%QAu+ f0Dտ,&K 0XR滏L߱l,8ڜbpVgWrS8T m I35UX6?*'QPByΔ;[E:W1(Tԗr]^@/ݰ6qV'tk'LYY>+ۓ$ ԕK]vccg J9 Ɋeh&W'4To㍩a}Eeq7P: 3,9Z-RUr&x348uxTk\+ife#^6Y0FVr%" ;aýqם"15KR*o#m1T(d Rtv~ȉPu1WC)͊7LLdFh.b:mwuj$".㒉ğvM(GeŔggcIޡ6o^9|H)M GCS+Ff*dUvV@Ny셼2GKEѮwl '_|"2')*W6XNWÚd1nzn CXK~)vWܸTlOH9{ g'/ۏ)ƅXӍp iNh wWxž{Ծ$bv[3zۤSݟTxE?,z&?hepD촎2ҋu%'}L> T'T98c7SQ`+ħn0vy}7'4!,} S4%=IũS} _j@{p㐋fvkpCِȠ8o[/ Ր=N0Y9;q=MJ$|.{١>5^}l G7c.ۓ}A Cjb6a9}Ssi* KToOŎJp*Vː{kG>(1[cgws7#ԷK/\XbXއZ oj֎ r6(TTT!+s\rzv<pZiRrг|P<:ewm [/`#(=/Ŗo=4cx۞z :dLdNqNqp85zSM!R-Ya\6Ƚ)KM7fA8p(3zgKk޹d̷g5">& rlZ @SZn۲=Mo/Vzcps s{wdL,g.֤G6x~-ܹ&zXav|ՒQ+{C9HD*a{VDMA#CO"-%&X6oLWWPGJf3*Tk@JpN5ϲt;_T,'J5T>|ޛԞn矇 ~#S~ۀv-ѼnۛwD6a:oU So¶D4Ts&}B+<%و1x@Pl@gF!tⶳEk5Q_4+)>#9SLyGXf$q¯ګ,h06#u5JXCf4Dtf[\G&Nsw`7;Mʫ33S!V #7P[u</-LҞuU\Aji_!6td_p:aܞmxV59/yi cLVUMx]ndk1&7A {3aOy`@`7EB\Qܓ9|5jړU)X"W4Ͱ/C9endstream endobj 345 0 obj << /Filter /FlateDecode /Length1 1536 /Length2 7709 /Length3 0 /Length 8743 >> stream xڍtT/]ҝ2t!) C ݈HtHtt# J|~ֽܻkϳ;0@J0(/ ర_( A%^D<` 3M@ ??@__0@l Wylgx_G5(.. -MK=FkK@f !#{YÃɕ{ #z Wd].@ 0^=/Xf𰄃l >8Am@p}U 3_܀[o߁?Ζ0'gKjC@m% ^'` mh q=[[!V(,:Wk8 w&+BmaNN (w~ `8^|y@}:ۂ6Kqs3]@ [<@8`v @_T@|x9(8Ü%?WKwwoJ8@ lXP? ۿS>=pxcg|Z5o#(Ec ; |U0_>t_ =}🱴`! ~a~\oAG e?N`! {> kU; `W%'F*ᆿ t` _v|x4\GzXRj ]"K8 a06 ? BaCy~[$>;"WK;|c*{5Tn ILeBIzF<<#VbΧ |8emd w i2&NEɇJҬTĐ!yUmSh+v"^"Zosb7QUDr;NJ`fJ}cسS]-R9R`O d;*p 0g͛{TGb/U\iZRh0|u:Pɵ++dGj䪍69  K=Yr<1U 0^[@Pl!1SU~ef+9X8S`n:a!k[Փ|X'lβ^vE#?vөݥz;{xP5 K]v ߔQpUX}# uDƞP鰖'C7`8KMM$Ӷ菒΁hy@OK=d؍J{Zvȑ0ifiVMC9rv80> S9IxQytg#DFW I9t@dcы@CC6ض$1JI_Gw [frG 7?gyJ[w}Zw5ҞмS%M:'k-MӆԳcz+v&kP ]+xw~ K9#hw0骣Bl0 +讘_JУIY(_"Z~m_#S%Ԇ^wם؈B;"ʼna; a\4r݋Ug8sCΐP[!ı w30J(5qcfj #7I*&wYU7gn,GiJx揚Q7vI3CCmޱ-~{ں2J9)L^Kz䝿0;9ȯj_Kq IZ1u9I.9?jmd3 8=#IgɯaeٞQn͂[,&&vIyJe>>NDRe1[%4}{Sy\o9%{dHzjk3Ĩ(LAQ7YuFVub(76B {F6AgHinQd(4? ^+EH=Q|x0\#A~vJX.k;H)xt{'iqЏG=]Ǵ}qvm4fq $`;"[Xa~>ivޓqIlth~ %8nʎg`~~Γ(c{T"̚3=Pn!#ڲ]5kOX\_0_3Nrf:wH%ۤj86oּ7pvQxmOӃIw!-t31*w[Jj /NvI Z]7K1N}-_j#Бwyɦw-(>PB 6< 'KSJK'iܕI ]()p2NM_ CU#P 0}V+N뜆M-p9b| x:tHr+qq'm@\ .RR7PYS}2<==[ɖzh\DM˝QfQg+ (R/lqsf=JkAG֩y\!Q/Ift$›+8j 1Mffp+g6~nRuYz@:|Zue?CQJTUFa*]U$z2?n Ia 0(xN.qmV*fv?![EO+ w5RᆪTY*U<{^7Y!OqBniy/L ޯ@{\;*q;բl(7?M-U MlMVlWHM is;$-CFeIj[JcL]R8|+d]8廇C헀%uSM0If~$p{ycudPHSDt6l''P됾~*D0JfۜY4kgҶ> +lNL~$O\KD%!)q3J> r [r\Z򃡿2{ %j/sF^o 1~V]Q$ NwqW7&"3yu[\ I5kWKJ6hZv@,msD7ǖ7{^u[eAmaRmm%*YE}O;( [ ithuw,5츶j׳%b ąZ;zN?jҘ{zgB<5aڦP|o7th|"0ƛdTyNy..JcmCa 7gBLŗsy?`s+KAU)^V}E_g]{X*"bZL@W'eo_;| '/bo>'-|Rn]G0vyN xHv5趞VT1r9(ݯZcSDك2HBj-2|ڥcj/}u41o>BDEWU?OEcoσ{ȓ6XQ,۔ˉyVZ7m%Sr22 f_ư2Q:*~ i#.duħlƼzq;v ʢayL8-~::b,S|@xOSdoGu(!:ՉSejq0uҴC5;Z6N~;|v@Kz@eo53;8J ,,HAuqU}/ LQ:}&:"ޱs&UvvQ+m=TSL󺃴U7 "N/ #&@q$/h:/ZbߓQiC÷z THƗ88eE! E}fC&'aB3k+.,?RŦy^t%'+b)Ow8. fHK|ZTbA qې$GF_迃+ʔP`2Ncn.)DG6Nn7y2K9-~%^u d\[>S䞨L.uXLR<ee 6tv @,ZJq*/!l4!CMk?nŻl {o+ڡ>kGdjDNoгuIBRszM~ɰqu:yޔy,5I{bkG`+?HB28:ץh㸅3ط\}AqJݽ=|̼ ₟X░{6 ww7'i&/pZ}Jm*uZtè۹W.*j7dI& p~,x[̆{rjVqɠg}*0$2{*; v'c\2b UE7@F{le{eEUzlQ#UCzHN 0TOY Y=VSؾ\K^U0ڴ rOe6#6.5DEۙ}`chMw1>Htm*z'[ P3_fbSA]w>^qGXE anY{qyC|}g!wE0i+vnliTyͨBTSwqE_s߯:{2hǭM3Zz}UQBM! 4,(|ˏ]%(I;םQg0fMk5n,&Z KVь ti >:Gm}GA1;+;at,@T>WվYS-TI4N3u+阧iɃ\͏jPM ߽YO!{zym|^^xGp?$QLt+Ne;rU_K Lf=,9ϳ*)6>wG}.TZe&g)!>)-Dg+vc~3ֆz;Dv Jdi=q0#TJϷNC?h Eud'ӐtEUڐE7nhTRwk (Ĕ#~F=7Cx.c6|/Sߝ](2r;C֧iD <@&4q*-c꼴\MJe_G"_l9DLY8ǸeĞlU[.foK@qkq)S|X <&y.S-bV@A zeoD6NY)X~jm{ RWw @j) H$6ĬZnf[cj/T󯫮R{B@M> _YNFwr8bJaFJD:x=_4)0 pTW0v*3.gom3ĮU ;;lbj$/6ZpQ7 %旆[N+(0˳dU }UxX=qQ2gUF+^:z }]N4; ~m.3d}ذAK/g!ɌIj/d{(lM*~}TkOϷf0Y;8~JseЏL=,^NbǦ23I[d ?۴f)û#׈/ƆhVU'/O8&,[;yTܙV+-"naCpƿE(|ǽSA<ꝵ"VT,jir| fKZ%/Uo}SS"$'sLʽAT-zVlu[5O]E=l5#:*K{0zZfgV_6nUm3~~h7Kk*ᗓ|󚽖Qk,t (3jlk>a<&Ĥ4WPgLB@pdh5rs)&nȢ4`66]m"g!>o@[#O!VZ _MFJck94>I& 3}E 2uHc٦S$Qf!.u.% 8Wf-E*j61oԢY&~RlD_Hal~ȟ1#D"G#G$Q7ְBɐzAЌQ5Y[Gڞ-鰰d^db!HCV850kulfN2cؚFBsL#n}_(ǔXK&>WSQ?'(ݘ YZZڟuNx%TnݤWVNo #ӟAnu55ޛuLdF4>.IQ_V,endstream endobj 346 0 obj << /Filter /FlateDecode /Length1 2540 /Length2 16264 /Length3 0 /Length 17754 >> stream xڌeT; qww'ii\'N!Hpۙ9dι]@ `tAwptO4V^^nv@g+Sc{1h>`jy Kȑݝ΅Bn]n@3vcB[ZRs0;`)ljot&0S+?cۑ_ƦvVs+[ @IJ bۛ&ۺ8݌lM7H9'CSg+G ,ZLhrA3\yOZlcn[ٛNՑY(#XGf8YXXx:̿Qtd-02 y gWXYfV wh7O@<?33{[?,.%BO<ތl,F6vv+7 ߎȿLe .AϞۗx?b {2^$jk(/8vAK @3+Wʀk!jomF^&V.RV@3e+_cXZ\~_5FVсw|/J}c;;{" ^N3_ `fwM }H[ `-q0KAf7 Y0A`;?l)Af?  ZG#?lgbjeejljj+?dp&bbljbkb )h?''m#pLALlO%vvR=6f@vp/lmGt؀ݿl 0r߇)-~SJp,=-beVf 'j.p޶\fw3}YH'( _jp"`Ou?%;8zG3S/*_2+?_yN܀x?s >O+d WCeg.z*:8< ;'H#V3uu|YzMLkﾊ3qiܼp EBn3A*ڔp]$eI(X UB+@C~%v` ?fPC@3y҇s(9 }FZ~M)$>#ѝqyA%<-/C੒ Pu`h lW=r-Ve|*O@LK:Ǻ,;D:!"r/n)Up"R'cl2JBt|(ֈ?,OcKsHӜ`NwYM(F |ʓ_Ԍ8mi:ƻyە30C~KDCWPqd@uV13- <񡟤I91ORJ]#qz`ϴM_WO^秺 )VR-nx/mx3.R4tl>u֟'g(f!}[tz ^DGi˛@@Ek`…ߛBzu%&+N4b9]&g?9g"DϹy'W<#75Vɮ{S$쇫Le*#$tnkfA&. ab|.}^{ҎXNƴvj#U$2bT<\ɰ9pׁ6\RUiGMnqV=N;dXBXCS0MO#̅N"{yV+2<8V#74Zx_6*xeR0,s"Lidß{ 1vaT2 &b7uM he /[kRǵ`|Q~\cd)5e,-_Sr{cIד&2bj-EBIQkrr)Rc^A?gʇa2TyAT.i\ #up~? `!Z| z:Q+Ma8+KyBR/dmn6,>vϸ$9Tj̦?cJ陣o='@Bn2ikF)y U~H񝯾dOQOjS<] zx#%W  :7g{vj<M;"5,\%QH?]zN9nzp1/{:ꯚ,A/cx)(aq3[f(3,CӫOrbԵ&>~8r`хN:{k3uU$\-FEyQQsevJ)" pb HF *Hˑn:ْkހp¹~s=)?w4R?dT^+d4S=6F*VA-u~_׎諁:cWݶc3d-,6,7}5e &hC}g*vg}F7ٙ4`a&~CՊ#,QIkdL"l˄;+Kz+Il6o1]P}!XyZE\IcH]KC='j®ī5؝ X YΥ;i&lׁ?{9H"t1X?1Zߖ+ۿ/z^T2U!B Yqs#iAX]Jq'Όs|0C8h[B$-_*L~{,шybĹ$M{搋Vqv9I C@XVZ+L)tD_d"NW#utJk %iN հQi*13Ca'3{z/UFydG"jHA{- 3hapM2  r^6cTs1ZifPFYHGL>gm븓݂BqEdpt5?nz,>nMŞ%"=5qm? sl ɡjy⠺-7{FGWi#n<;;qy<ᦥn6bZz9}U9ُMZ$8׸ '<]U×Fnl}ָ- G &͟/aLQIܦ_r۾tu*GN2i>Oթjk->p M$@Y&ear#IxX3亹,٢r|~`wپ=&~ :`ʫ`b};[N2T^]+<~ϞbV!Nc/:9: !<xίuuyNsJؒz\Jo]:7~͎;3Ըe'(@E _ںmė4D;;(tB v`@ t21_l`*`v /V-2J,Nm(L Y ;4m,g$ԥuW|1q2L" SSy<™=IJ2֠ZRt|dU/sĭj-zOroP5.RޥEXC!woq%t/zNcfAn-l]ejR,>z0]D-{po\ IQߒYEA֧t :>Y E+dg}UDžz8㲺9kn|E<2(8vcqI9R:1Ox~xؠyGoZNA1~5ᗦ+ө/jʜGYe“:7CK.eh1m)*#X=ϯ RQ\mF!k3w9]xlcƯh*ԏf:+@U?Mm>Cs#'_"/M5s~{@ |ceHo99z u#>[CTA:gSó0\6 20TbbZ~EboX*rՓWUbƘÙi`su{TF,Oe>I~?W B񟝬8_TE3kp[Ojʨ|z15*rl{ f)dp6qhfATcp ˯ 췺bvmߓxl=2LHRe-5gnK[ք:: M Cyc̴֯PTӤʾeݘq1aYzJڃ>KZDIų##/@@uJ|R]9LOsI+|ݥZGHE/hL,N)o4YR#,F, %v031ny_ 8V1<{Q1:O蔺f=?߹49#1X+O'F-a2,S tm p?"/*OkssZnG!i=C³ycFxtc%vz69Dv<3DAY^$AQӣSdR xz# A B.#7zj~5)* l蝾(_Sd@8%$̛ [VdgZzԘ!;k3Y3L tAu˝ݟz]8 +Xpd owx#WB.KM_>TI~uM sn!j+Β#f~m,T.T(L@!MpqY ;s4W(:Yb{4O 2gL{GO y":6Orq/ ƥefڞٲex)Yoga荝m&6XГ{JܛO&*VM(E@qa XJE{_L63}/l@~e+_"%qxw bD}':Phfli.jO=CL#WK7ΏouܓZO(#=M2&x#ڣE} U|>gZUƺ|8'A3pH+.#Eϟjz#ʟJoP:<&co|YGERRypȦq% luQJYJuFRJ}Ո(T` LSO ˬ_ ŘW9ɻ50?\tp9M!救٪i 1Yz=JSjvʀb7v갟*nlGFaewOΥg/D"[麚ei?ZV5CvM1PE&%O7bnjN? |bJPj -S¿Jܚ8 Ňn`]UE%mdUɍ\OQ"\E"ȵ"N xI_Ra}M)~t>@LZ؞ʜI +atZQ-\F(525v5G֎h>S=jT?VͶsdN3x{jԫaFrS\mX~[aRkY,,7sϹ*èo $^U+>2O$W76/O F64F34P0Z FpU]w@2\2< % ^aWf<6,m_x\֋rR-iHt ^DgqsrѼ@2zc'ưw%򋺑;[c ] pB4ރ*Kk\mE&c9[]B{u{Ѿd@ȕ\gmť~1:n`65!@yè[!~,Lv2k8=o@['/\6=$\#HN1P#?ͅG#DYgQlՎ%Kfn6mzOwæo^ ((J3f<}KURKR[Fd4J(Ga2)(Џ1ɓX"'}F䕶_Qb;}bRC}1G~E8rp.5#uvq;Agxm'AHfP- B 2W˃ypsqI}8c;+Yq}-k)*]q;6^=YF{b0FxVk Q$Sor^!gR؟-VT+/9Q~ĸ?_&}{6 W4xTr[?v$- "tXҝ~sm#o@Yar.wqi/7w;ǁ$!+r6ju>[R'࿫&*0y5X&YLeJ=ϙ8AL g Yq} COA ,̄1MEpaeD$940/ΥKZ_x(bw&ցD{X~&RyӎܹBdyE:ndd!&8C`=S]66Fe T`^+?ݡ~&Pm _ݿ@@FZ)vMѥP.Ff?dzSNpkߗ:FЯ"\`%Oy\0|MAK0bԄC*f'ʿh?Fp|込7_b A?C"}A٦B脠hQ4:ZT<5R:{%J65k7e5饥(y#F 'isvV_ N8ĀezZZdSynK|Y#U>#\\ͬJwwLkʿƻ%( m>885;q+c4Mxt\Otz1`M=)ɵ}}X͛vɬq-©$//LH| f(ҙwZ/.ĴR/UuR1)4 [Ť-1Hh,!Q_JoxڨP:XXV7J5("hL8U7v{#޼W^k#W:JW`>ͳ)%.11&)]33[p(C[Mik"naN艋5Up{*O>mٯISߝ mdYŠtֵ4TTz?:#%W`=@qgd2Ndd,ꈭE43ay|'K(J6.%Mbc%"Kנsz|06G3lRH(-.Ħx옎~tT$ۘ#(R GnjN:qDgPʎ> FR;heʅ)IͰ $& ӱ8;!!FiFM"Ӈ 7왋ͻQfFEC*bNч>LV'm sV_C:%JyR! +% JmRMWs /ꤥRHsazPԷsalq=B7?^b-F l}"eG8bZ=}E'Y '+#]- ы;0?,T.T]HFt'Q/ز p bmSEbZ')R@Ӈ1U3H:-b$GT]?gԼ[.Jg108لB%cz[ r\"T@s|CEv.g )PLFYU5iMIE9^H0¶#%:C7:Σ8~Vfr)ə3{ rx|!IV}t|}tu(WA'CVV( * }<, +P:󠹨&+l/<_N) `.wWd Z‰ūphS c`;rT+`7#x©2(sy!m 0NtFI%BA4|gI 5z< YIGؙ "3]kb㖪nn'^B&'LmwR(\SK#oggT)'O*E\;e}Ud`mNǻZsHUE3MP@༝(o[P(gd٪Dvf"zW;{Z!AAǓ> #G֩:Z{P?js{=%Qik'gU[ܳYNj5a4cy8mvξ.Nd@ʮxrS/YθU\Y.Gs٫m 8'Ys-zB-,z<@Ə'0 cZ7sQ% HLcc4-Z'΅;i25#?fK wv_n U%5,etlFxzXp15n eņ)}ɅM (XYjEDā\=hYovCR dLpY>́tVUBq!Z4$Z`%Qs_[뿾.ghזS S{,ddZr8"y 1_$-1M VL6d^ ž]gOvV*aywjمW,ב0Ӽewov0]bMuՕ}Cq6Oy B R^O a2b//̺Y/ L3n)gJ|Om@i)`۫UI|f&қ63^1 3>¨>N12:ݩ*O'ɣuj*֥~cUpO>DF?n4u˂`ӻpd!w5}RxYh7Б#kwt;#r(J%Ҿ|B(P;nhф,Z\|q&T"Pb|tY'W1Wx29R[B(UK 1GHٗCnI <^WY.j~<q#|PPjҔ,~BCdc,Uzy{1B=M&BNsf8/5ʼwַXt7İ8b=4Yo٘#Fe%2CU ʿ_VzEiATLoc0fHgPG#fsc:zԉorDM7 FnѪ556;Jl7rKkC3'ܔ2Epb3~ꟗ.vhœR w,ը8t(:ؚpf^GB^.dXx1xئf:}&<"[wxmjp#iZ€KNyKq+_/l Wl {Y \luڥ#o_qAƁNғY!jaOi-[&guxg rGIH(z&M#OV߈b|%gRWE]#ZRO*#9lTta)S3ek[C_y3E8x; CrKAlE!++ќ͍ ]R+h9&%̯f>Tjkir,3іП؜ Iq_ѐ売%Q$r]C͗WXWxЧ2Pꌖ G*c}^;ݶ8蒖 cP ~l`.a7I׬ W 6 [Yv@|&UvGㅖpT ҉1BkC9Jtܬ^`o$ߧ'ټCȏ1bE""krl8KYE3kst6BgJg8C>lڔ9p ~FʖoW,Jk7nY1 O r/Tp9翯D3V %3_ѷxwweղF"!%%!ә|ukEqЙЗðI/&RPGt-JjNc#l%: v_s/ &ߔQY UQxt{$ OT-s?j6^\P|V3'uLeyG̼)rM|];C$"Dz٘IusZ ɑA\|tIÝDr`3H ߆cGaoFD?i:'tiL##Mo_A( gF/mTǐf}l){r'Քy0v؊90x3PFOڷCov6]9b_IB}:,E5^K^բ C֢Z{yb,mgD6i+r,pR) oGz&,P-w?ڗTUwr eɤ~9 Bz5~!W9rƛ. k!*smҷh!r\xkh۵UVN6 ":|VE3jRV`";OψƸp[vM A;dn_֓ RS2dTxp+v oXғTcp~)~$>û[XݒQ[[H8TnK( VYI"m'iP&6|1ԂڣX+)g9xi d)S2 t *Hr;tiG"xMKc:*J}\#FEJلN:IDI~\Xu4'|-=n{t&T5CT剬Bŵȥҫ~g9KbG.3rbvϨBugM,!xL~W:}eZٛr* _tȜT!@qbc jGx I|20d4[5ѽ(I \hݤX cm[巷|ÛlTf̧!X+X7CQfYc^h ik2%9>uMOD̑%MG%ʅdO 'LiwĆ&ˇz7-~rİ%۾I9b JKF!Ln _ҖnHCD"!, (\$!hnqM<[Yo^ҲR XQ94"o :Odq豨԰>tGxo?!9=8ʱVVy%xS/zkj(k}j%%t\]\=mw[%Gz= {Q&NcK|V$UAm.$+4gG`m QZիDGkG2eʒgO/ ƈ|nhicV0;&"e褿eLF5䄙{tWOAVR?M-U]نO\CdCT}GhͲ;4 &.-uD$d.Ot3nS呇,3H Ctk/Bp[ [!46o dOs^2lBz@,̺aРD_F ͺ9E; `K|j!z/;by;Co4buqsᘦUd^šW[5!М1N?%a': h4Rʺk{CY5P9 f~'Ƽ V6tIa,sLD2 הH ej)t,^lbP?t>]'֗V,''nɍΒZMQ,̭)sp8a\ȓhFC_ne̴hƇZ֞!PUT׽n!N˺ MzL|{~{ޑNbc;`TgpJL"1>jdtױ50 Nl+E5gGg%HDcD C$ЙvuP[qkl2И6yE5HLXOɩ@\:vXSTEI>!Z7`jT>wؒjTScݭ"oYУ#bςeu_RB%@LZH i d"v,YYUT%LBgK8C*”卢3அnBIE6BҲ-^j&񼵄t޿񟙬nq{2mmG4;&^}0aK46வTCqZ$=E+ |1k >aU"ʹL<WErb2IB hȩNR( !6i*X-yw"jWON2<p4-{R&j,>Jkʻtoc\g`JtU;p9{+ue(l]\Nn%`)> stream xڍx4־ Z!z/{޻( 15D]Ht GM%ѻ 7ɛ[<}V&=C^ !y$Jچa>!~PB@;w@>O}{@+ U` %+DOG/0WW O7~c9 QQAw7! p@8Qx+>>*}IFM7OMш@cS9U*KKd.rd[İ[,kMwQ cg-\dZ&{f-'?USrOsE*`~04>$\ }!I1s$A!4xחzP!+4 +:/{!f)mQp=zD[I"HLTD53N΄ ~RoPmIZyݢ]ƻvuS2GEЊ>c>VIGGgRBܬ7u.D«$1M ~Ca|hN xkP9ۖ,ObIj/-kٟa_z o+WYd{ԝV9T+RqdIyB3=kU{jix>[mp SFz,ԣIK (AZ$NoT_rGA έE9paT9ۻgP9:{hA߭]#׈?AJ5u&1ߋ{;rɍ rT*aF<ǃr${/rV S-bu`Vb@&*v^e7Y!Pj$3>Ւ,](S#3E'o1sφ,qݻ^JiE9NxԄ6 !;z#ea󪶂]Q˂Y&-VLRE=g/>y%M1;h˝n-qMyP|D>"J,b} cVܡ%@_֬^GP) 6}07ddQc$N_N 33Wӆ/!ؕ}WmLgOшQ}EWrB~\ʳWyHS&;<Ecxk K#[ܷ#+qhZZ#-h~99n=7w(?Ǹk[^ZlRkZњ2a+"B&GyX3zw.{ v9FfYw\[F6a;eP/% HIb$~*}JOo0g_FF`\"6t֙aY (P&KXXk6:\}TZ  t5%[ȷٕ|^p(LPIՓVOaoB"<9FCC^*n 4M Q8ѵgRڑЎK4Ĉv!}^ W 0,ءe>\MS 4?ֳ"@?{RWc"$%;^ ,:eŇԛL^Qi:8i]K ߌ#$fD-s>RZw2<%q.h>~{ߣ U׷9kOڎ٥ۗ;qb!q\*"_[)˲`92EsMuīs;\4~$Ы%hMF7;ҽ]eչ+98B`J\lZfFBD 66"]ė,,nb wB]Sf~KEX煠BZe7ˌ1 2SMVI*ͳfh ;^aN>Ly>Lʧd7*U5^+ 0*3mY\ËZ=ldg)nzV(\αydǞjM3n& ~s9qa{jRIz2?k,jlmZ+CJ-$ҹ_.`1 v7r <B @dI0< \…GS%\!$B4*c ?y?,q&j)-@@a: g%DCI6vYI9R.YѧTd09yr Rr?Y突b#n Ydg\̍ vCDKc2DJ|@ gڰ7_d. W%I ]^_k.)O:|ӆm4XJeCu83վ&+)TuFr>,uo1-ssO{t]-5c>'4e0QR8B9tWQ[&HP^i>zNH zᯒL1X;dz9dy݉sbpޡࢊU 4]hR8#TELR ~;/R;T1mnH;ado ]5IIOuaZB>ޯyyu,)M;rď#W&J͙74p\Rxcʖu޿M!_ |ⰮX]9t_ei9>飼I 9Й-='p9M:+v]MfQrvjAr|Uh=2mي7NלX796Y$5SE[k ϔ 5hY j<#ZFr.+0~FsHd$wEۄyXLN#Ҫrt"0WMھ'e;E]a GM͋es5z;V~&~k,jB,ՔLh܎}ǟ7-ʴv)FaΝ<Ҝs}Sgل>hs`toqwWz2=5*CԷ{m.Q(|`!B1SCL87xky$H䢰LB|OISj)r/⌻f+RwqcJե^E5"`[ K7w,R.6#X)+SɵbĚKQSeo8-N:l6N+};@/M $B?|'pxp rW |OCA"$&+Ceܕ$E]ы#BL|m$rq=Gql 8O͊="(L, []wFz?RE&DŽ|r,#; {6d"kOsH΂jN#"W,22hF;Fan.['"1LLOY4l5~X=TI! ­|],'< wKiׂf&08aXt^onUl Iqc ˫-Gsj5 nt_j'.n g"4ۭiR ܎p2uH,ko8FF5Tܶ8G0}?KԊuGfNJQ9 sXIyg$Q-R˓V$Y];TrBt*͕gqɐԂ4cDlPt틷ηZ \2\WdIo-ܻf,FE IsQ8flOG >)7fAlG)X\ݟ۶8%nMKꢔJJչ_ ?ѿdW:)Bi1.5Ȁ)[L^|Ks*#]i,P0z,4KXᾱH/)IO~}O _F v]V*Gfo;5t9彭M2-l d&R_kㅏwͨibH`nil?)L`g) [yDkIU{o/p~У&o~ h'VebIh9+_i? Tsm1Z0w挠3vϽ &—u=m/ޤRqNe7&4WN_v|a9VtKZi6nf)fI5dN=V5Qꢍ(% f{B8-34<>ds͠|q]93P'^ 8Y\5∝Guh4'ՆP|S@"55bV>2M:WgUyV&B$2ڔp2Nr ~$'hƛdg>0u꛶ӽ1KﲅϾ>œj(YΖ̶i9Uf-ؠjle+ NkQK-`\"vANƈa+ #/Ђbn6yMiް!r-朩$\񆮁-CBz I 'z/M}|$q(FoM!]jsT_1*"f'Kk5sM#$d+{N>\'O%a hzPT<]ͪ|?[= R֨,s'\ 摶|KCCm *=%Oe̾dtS`F[{%X2Z=Onv*@Quy ݂ovy폮ݵ^_O%Y=KL3${q'x3/t.Mu:-7T>ѽT$*[Λ+ /NM=n ﴙ[EGj03%MkkY~&[;{޲nIdv'H*HB8C]~Qd0wAS3,B4 3C^*]:8UDɤz1J Iw Ʒ8XU/+KOYuz~u}›JfL(yDCO[m1N},>NbwXFn{ȝ׾KHwY dg\ńhX_ϛ-Ȼ(3 uYڧB6]d c= J=ƙ&hRNb$<"k+ !X8g;CTDn~8s1} /hWhi0-Tp.1w O1WUuB᝗Q=KrHvhlαg :i|Ȑ*ccy5dQF<v9L` P#im'lѨWBcd8[Hbb>'p$_:D,hRL9)I͔^ O;:ǠWl8:U.˒f4^hjJ.G=OYɘdUΧp7XHUGҩ)YCR8$-yY|049 G E@, Z5#MNqi^b#2{Jw}ޚO9߸\5 3x4x=:uh޺@L?9 {M!w Hw^ΉDž]"l1M2Sӿ,kqDQ\/N7y}IdQ~#-*^ITD40 ڗyXC[(b3^Deq(g%Mo0/MWs)_9?QV; ƛ#ۻyv"=˄0endstream endobj 348 0 obj << /Filter /FlateDecode /Length1 1389 /Length2 5998 /Length3 0 /Length 6956 >> stream xڍuTݶ-A@%Bґ.А%$ޫHQR Ht)"IX9?ɷk 2mFD@`Y4 ..$p!0X$%Ԡ8A4B`Ok`]+d q^P \0 @ ~s.P CC=Hf*DN`hW7(r#]@; 7NE.X4> E@ߝCw P0H7EQW)hWW O A#fQh/߅=5Mt@h!0("܁o&>nA_0~?7?"iPO@?W  H?07kO ^^p4?+lnvJC~Bb`PDDZ(%% g(oj@?_{_sY.Z?"Ka/oN)W;..üGtK7oSL#=\;⍠rYHD#ws#?/ Q4݂+u;`h/JH I~"xC޿ 8| ?cV0PB@a7 `- |#Z68ፀ'0pMGU,^B_ߓ~d-|{9Kc]>zTIȄ? Ѡu[N\zעʶP^n0$H&}1YTJry vJ;-@9;a%;Kk $Dt0ptI|7;ۛݕ.Q)YID͖۟D0GK"qZ5{1 ix2\~pN6b%HԨJ@ 0naH.qQsg ;(*kK^m~}wYg ?ΓWnw cOHg(|P7Ꭹv0߷/S4L =|zd7QTpu0IGOC2MQK i]— #@߅|v\ܛ?CʂbIBD7 EG߽|_kKMעM;>ATXG6:ax>P;M c,c6M(#CpII̝,3M ueV `~[gEm`R\=H%Ss+ufov' xÔզ6Em&CgpL.ktڿHd6?8v͒-v6b.H} 5)" Rl7f<&?ur*'k`)gͷ9M^бK5?WX|T [£eI( Fnc{|0:3"OX;ApdpKV2KgVefA Gu'- ZJ^z? AN%|Ʋh^w16lx'qj9L^1=߅04i,v_ H]-%%_~- 38{P,0l1[ۋpRR  1ȎKS% ȺaPHsS,YOw=6(~Wާb[MDV-Xsa{d3Eŵ_J;"sajAmNuVDՆ?f*:b 3WxEqBXn=4<mO xuӓgD _ɑn@b{'yxAU,]IfRCaW.-O>DBis^|Q{Z2)ґ{:$&~jy-RsJ$Pʬ|+M%,tXOMTrR!O:ln [T<5"P֕cg71\h9<`U8di}i>2 b6w˗6ߣB Ip7]d?9p@mpj5i`(\ҝmYx%9^{;4rHiaY)\Mwr%Ϗ^\&RZhstt74_l ? OeZ@7W?GK $KWk$*RYà|PyRR@]NZSMR63mhU7C7^J ~;GtNg/oEru's`HuIƺ}ɓY'K̭x4ͭEvr>N_bTD"6wޏ-8Ky;VNu$8BsӰ9Cwl[.۲/rwNNsFavf!VyxbY*--J4 j$?e YGs8\!pheIk?gѹg:Ee;ӟ4od98̮y@KuFQSONEN}HgQafk_ d}X2o}iqhS]EgbyiL&*m}e>^F(_lDBN3ioc@{ZܴXL.a8_Hx'Cu bG0ʁ|C%yEu:(CQWkH(ty m| xeAԭY(µ@ڵ全)to,hkhR3j>69t.-/ICQ7Mla0MoUIyBqekVzEv)fET`꧸e!!qk[KikNdS]RK hu9yaDJ݂1T4C 3 F )bb4([;)"8bPP]~<W}]tsIF:FN mh˂(flѡb9~̉θq[_qm{>rJxh,c;x =1eI.g] .w'Ie=⶜算Wod4(3`+yamk:iZmzHUc&?/1t|H_Ɩ"N6|tI$ڍ<>|/vץɖ{bK`M~d E{@X'6р&ͦSτ]߀J*ǩf.WIp]7ߍ\rFz?Aha(ß_&ϓm:j0*Xjj̢VWbs,F6%# Yz?A-3=sQKKʉ7ekuҨ_"1 ZvBd&՞VB:i`8 ?z zX45&7PJ.?̮k'@Z<^l94nS2>yP3N_,{Z\+W !*PVںvc-\Q c֒"S({4G>WZy7M䖒(4Lǘśbд0@W47Pw[:2 4|'l^M "'ӎJn{D5?s!Qj͈ 8x$N.{h$+;ѵTK,R%Ty '`9"* }j~lރ[+93ܭŖZ^Ma-RWC}.UߋNdH,"x(G ) wU@1HU=-:" h j}A |dmvfojivzh˶']S|6to_nzn]Snڭ+"%ȼf̎}[|~j_̩} 2w#"*уϯKik?-wk]b=F5y]eO~rQ,pdAPʈa|OW({GU WOf&}? ^n}OZBf ?Xnc%N `Y}5R. y ۿ7}ۺ ]畇yV*P4EMQpr¯'<{m~4 @R\fWqcDISY53Ǥ;g3O`=Ԩ ].o5  d<8Έ.C逵23Nj$2y9m3_>xyhY ܇Az HkWLQg (?"XY՛G+;;%M\ٍiyGTh;5<[ݹԚ[BB <.#}q#vm2,]ޅնޫ`Ik7,/d~`Ns r~sݟޜq@;G Twb⽆J Xy79tmj zfhK\żd xZw 8lnA_!*xIIVBߐ+ Vc&mR}<۵tXZ E!ODN\!i˸-u*OdbZ >.TL(Tu)ȭyuѭ\a?>V]wo.n.bv[Ltob;,]fI;{"/*aXY;RZ3N}.-y5xs2(Q%6] hv=z8ݫQIRTb΢ &{~endstream endobj 349 0 obj << /Filter /FlateDecode /Length1 1955 /Length2 15193 /Length3 0 /Length 16407 >> stream xڍPڶnkpwwww wwwn9}UUck oB&vF@q;[=37@DNE Ă@AbB dagG!&jH;[Y_,LL\h 5t01lN"vf栏>@eL `Jt  g2|t46([A9d`h`hOMpN@G ௑6ƀ@P1pCj|-N)ζ&@GGw,@h`s8fO_,llhllgcohnak0e@n :_Nv.ֆFnR~L-AN NWc5ڂ'j48ww\ S [ӿ0qgTppJ'Ä 311qp9_ Tr2e`19:=`ba ,laܿ@C~~ICa&v%DE4Ti3vnOzVv= ; ?<+ekj7ݏs.k}([:LL?_)TWW_FS;ohca:>@clo:߫+4p^)6ٚ}(v 'q 77 Uo_fma fd |Kfl8}H_.bv&- ;?;c+Mn3`jr2}08#.W߈ (70>j>(q~TQFyE\zTa5}t2/b`2]f4d0?P3p q6?[~з~,6ߥ?Rm?{z?9/0^ݝ,KΎw4FX3 j{"tߝ`aCSwW }f͋\݋|8f)zoa[JYk65ڦ{:vufٓ2`519oRrƥsܝK?l/7?p€1 Ɋ.^!\-43!Et%8qI1}k`b3^&A`bG ;UM[?Әg +ɫh)%& dHdBYnF_xh:EZ"U O1y6&ema:ڼM4T R}bdqIz4.{2!ZϘ.X,3v|] BZGE-eBBn*Iڒb1 Ui+Gs>x脁7FO^Mqv^mnoq9"XS#mVd Y2ᜆ zS7% xs7U~C!<}`R<%;U6Qo-% =LC5/,FƢاt{q" ܞ?1EPt#3JX^7/`:7X-ݠ q8\EcӨ.JkCr2`=QL#%bCbtc(]6H$D0ρo"5 #>OU\XUvo&~f},wxu)l'թ؝p)1ɓ7Uj&?BwB]gB@O+)W#P0x=4p"ݦGO&6?k}QsvgXɈ8Yl+kAUR\Dq[-g \K︩~Ǭ>D;)M݊<" ¨x4Qsn3BE}CXFYpQKt-ww@X; E!_t-y` 1~hYochuO;G\pBj֏tTQp9}&v6+Wld~&]mq=lG`D.v|mSJ]Igb4zԡz QUY%(wAVhxɋU e_n=f_xrXWOn|9R*&.0iwM fi 4GZ4?]ت?R4RMw3`!2B1Թ6Y,/};,Mo`G [aFP#& Lr '4CaOv*C!t g]t?`s&s[~O5& "bx8>ABGC*e,}XMBM~~zZOeo;/q3*S{0<;8p{T Y,|ru9W.QCS.{-IKK9, žbg|qG9u:lC跻.#6`n}0# v7QY8Myb,HCY R$z8`_x |*f ZFy8zS܈kϣRcP+ v[̉gJng7lS.D( 24fUt梬}/),#FS.3Wl!Wxd ]U֫a@ x#bGߋfIpfoRo,8^k'>acV56mcG_ƅ^G]s>k7Ϡ!vOSalF6F_gь!EqzBw37*vI݅׹[( y;jMށ7Ȋj1)vvJ\F-IN9Eomc]:g]Z]-&7eC K\{7yh5ǍDFOPf3]b8)55EW B6"C=E]cWGð =,ܮ9bJT3|:J v b]}[^Z{QiY^ZpBL3z"3+O:Sа{*)IjC'_?ln ַ_^0EB2A JzLB"e@sfµds碦|^Ŋ / T>EN.Ė)# V͈/j`Q몂g7t'z$ ӑOs[hľ}zdXo,͍*:U.2<π*TjyxGC<r2? @bq<;Be}G* QQBrL:fgbg2sثfW]wQ-?%,vmZ򓅪PZL^*4FUZL-VƉ*G,k e8ٻ*NqJR@C0ab`7S(mTW{:} j*=GppV v tAn:ph#$?'y 59-p+]L18$ 9`x*)|3Z![mد|D3L=[dRsaZ=e"~#x`6;?7[ Ewoюɳ3!Vo,x*)PgtO4ᥚj;(۴qFxf}Ĺ>?*56NoO07bHDLcޯpQ%]8৙(A]2ְӥ/rΧPn$_CE3(Il kJYR?y!$WO*!ݾ=>b "!#ʍ ݦT/Fxo"w2Ć9QSaBY'LgV_PM' T 5LװY3vk(ANyIyO jҥyqWd ρ h6'CcP'6[HHPk5윘2Zse 0;Q8|N* ͳtmI]T@W7Sq»QU$*upQ[84b7%KӦisx櫴?I9V l._GW^E"2[J7 X~qQ_o9g jXk2szVֲ\wIgYQϾj|qڹ #%N؛mWNt٦R'7 4_ Y;k&0(cmX^AdX 'G]|Z?jF4 <1i.Wl4%qELc6vtձu( "9=ڳ_4~V,Eِ¤l^9khZb ˟фU <;DI6aTڨH ~s(<')[+ PNˬ)MLHRlyTv\LG)̗'Uf9uz*]-Rs7 UJ?KZ{)0ȇ]ĞU,NAdZ DV 5y\Y Vq{P?JGm4Nu bf ѷ1dp7*~ښ9 t#].t#R O;ޭ1]^-O!݇&#sɡV.qbb㵶A4:/yt:5}Ƹ-/6d{5,ྫxF=#;SLb Q!.N/D0߇v6UK[*Y\`8@$!xw+$BabՆACw[*Rv6j0Wѿ8orǾ t/ޞ`ѵޕz:hDWs|B|ZC3^;?2{ڽmMnd0D A2;)e9%A9̨uhF&s#-MVL1?;Ur3ߴh|WR[sS•Wl+@@W, 2'\t ի߷jtyG}D6%f"Ϙ`"tI*Z&Zc<5JC?g_ __{0f `}hɨL":0I%cw/VP!R:Ͽdiz6wS<0<<~Q[4e7m ";:AE 鳈2-n!B8D!,CC뼿<)8҄Bͺ5 qvnKzel`V7QEUT 9cz\iƆ\(+JrQ5`zzri1qϻCzK-i W$[뎢v0f4"A8ĝhtv֝5 7&mm 9iLx͞5WqX$[g6>LO@FtL ό:"n c1/)"J2GWlzĈCB;y p;0CSt#҈* -舰{ǧ@_^N[L"Ǩ)r{Vy&7Vf$Un!٠{Bh ;o6]·?>ayѨiicNVy`:Ic9Ļ$_cH2sXi%i S7ܺ5iۍ'e>,yA vT9;:zRn4קIzW}ZͰQO1w tVm!AGV*PPhL} %V;6ö<-b 6~.tsU=r?w=#I4,V !xqX (oX.a&(H-B Y/8Gd+h_Dͷ1.ݠ*au}ۤo"?:u^QL[O_Љ~jA,,#Ҳt90eҭDB mS$}WTЗjH@Z#XP1( Cx 3.aQz97!c/łVXCTlx/Kr.2/,_BhBq?B4jֈ)?'@1vjUUC′Vw*-F`$B3b]`zzNX& _]U(`%3N0n:Y 0;(\Fe%. 8xO~֎" ׋Q)@kU/7:E X1swθvq})J߿6SF>@o YKnt2?l t9Ҫf:󼉪k6C a|,} k(qt\aNn߈BXmlI vAbiK M>uZ5ozo~ ץ.'0l!.&3P𒓴|U5.j$(CȻ{0wԣjJ X{1 #U>/OW3"Lt*M"/t%Y]"-x-8w,EnK,qBG3]){]E8ҌJ&xd!3ק@dρR UNCIQS R˔{v]hHarI.nIWq8c]1בKCآ߬qd8c0{ezrFjٴH/yc2f^Px>~{rQwg8}PoDY V2IqXOMWxKDzcz5a~b&G3JkN*subtz9 p~d0yg e~ncT8y"H֪x~Cx=.?$)?ϕKE%EN<+9qUB,AR`ib &O2Len+ܞH7d-r'h-ʋeB0wLgY1nOXXkq/[hsG`a9|[Fa` Xhw0C=!J=\=)o#1'b[z^+3Ћh,ݍG)]==S'rFu|QK$߻kK!<갱e,3O|"1%MstJ>d-634WM4yXq w%ZE,0GtH&M2Il5.=O+/ ]h:|h&K g뇠j5=ĐsaM O拐e<Ѕ*$sQ{ x>;JKߐUQj#W1:dΊt1ogNq7 %w a3Va\U:%Ä!}]C*(QbX{N†_TCO?w&(uU|D7k)"jf'ѩLt¶y+-\.)FGvFzS3R((\ -q K_y,S04N[ҸY[ D8d !ZZ{DnroׅL%?يc_3EUt`1Vbn=^LS[&8ٴh:B7 f#CgWópeԏT=_dߟ 7(9/Fn?ZV6$Ǩ>M/ kA'4SA !lmF[ii}L!JDޥU3^[LZgַҰ7: wv1 |gNE!?DL2 `!)VZ=a7U ] =OA3;y("EǰuOO4t#nYh+"κ5'y+̺>;'%\c3lmZk5jjV]+hգ\+eδFŲqW:A{9@2wu881ZX*t^v)d㯞*8@2o>VE•ZjpꪧϡY&DM홟ߞ ;C (UuWK0:+"'oUϦ~(\ʫ@h iE7-Gp59H9PPGZ8 c3=ctqE)ƓOcёבVOy#-Z!m>lyk+;"U"}:?  GT|NƩ@!-= [GPל& *;bK7QGdˉc]UQ-G:M}8yl6 I^O^uSEݵsHtwӽ5 9/ZQ@(/m݀4=n_j0f&~7΀=uY9=NZwRހ5@\3$w}A;坰0vc곭Tm icBbJGuJ#7ɟD"knMK3_ y_[B\a=b$mAW$gp?#V݆ջ"O3X]b!;iZcn=)Ц8,| /K*Ha)5,zFZ6Gșx(L^ 9~wۆ{tC)8K* q"(2k*ZĨ4L>u4W9!1#3mIaF騟(Q j$O"{ B_|CykЬHo*?Sȶ]JGG܋WFp/M#xfR54 7o`Zn$j0ޜ+Be\TIXsv?դjWaB;ug6 /gѣ=w0]z s#65N nod)T ! P7Zd8dY=+H{;\4َ:p Um<ݷbuyhoŨp]~OJd$(e z{8*,."s IIIQi!t=  Q夲\j]a\J>$d:j¤uT#,=k)l#?V]{Mh.rԎ܉_PzAorvWM*Epz}ZĿ-ї q:,Új'>B8h/R\E] E{k9w/<,M(=FN{KoAeOdX(bu}ga,D׍،(`eU*aΝa0Iue,#%ۚ/7)T6bLG:EnA0bBl>\Ml>Pն#P3!$ރ̡2p-9x A%l8)~$w[O0dRt2k[JJ8{)仿NJFb~|~=1sbkMȀLcy凣Đl8Jʲ˺>(QRSgpGUj++z.1b>]| WOe7-,Ռw]w:\=qXPh9s '2eðLP{TjqXst30><<1h&ԛL jُPJ/"Uu48Zm+ TpoK[b1SWT'_[c_R׷cBq/(R>YОCNP>X F)Pt2xZ.'*нܫhyO՗tNk",Dy;V[YMHSd$p/0udrZ ؍|^<1AI L?j!JWY||A۳^RW\ɏ \mH\1SA&\sxXxIPEW4R/HppZѕTZ$Y5-3u_͉?Etϖdh} O.,'}^?mv1hC;U(x6 $]I[rp>RUMK kg4t޺uBf[/unLHDwVc5PWse"1XGis"3Ʒf:E\ q?svm9v2%l _rʠϩwCvûqr'z|reϗ w!1\ *I`E~E8\3Ɵ} [-Du1neзzbaϤXV*`tr!yz|lz> stream xڍpk ǶN&=m;LlMl۶1$Ml;9skZZSMNB/djo sgf`ȩ23XXU-]lÑ-xa!4r|]m̬ffN&&  xFn9\#T&fnnNB@'K#;# @?!,\\xl.e3 h 2@oj pU K)T\܍ P(8e,/:`f`o{og#{[#;OK;s  .B03ҍBJldliGƿ|YTh W}N@{2p,Lafg ͇`gbbbe@ ƿz:V2%`04~y;.N@_*13L-M\@sK;??@w0}3>&G̨,))IoU {,vVN7(YxJٙUGSۿ'A Xs Ps]&v&/+ߊ]mlSGodkiouu9M-j\>vA濍t*ZX=g6v@E{g˿n=3},1LMZ2v'$?]>\|fNp);Q/ѿ'Q0qreK? (_1Qȧ_迈L>BAqaW⃃G0{f7'_[?Uu MmlaQO $K1\>~kQş>zd`Ňq샴q0 j1[k'?JwҰ1[ghyڛ#u?`j45?AGOΏK (-p3"~9;GS?|G ,Y=p:+쫉G\R??7$4[Y7 xwߝG`ωХ]j9h݀)>DPoʙvQ;eP$PYԈ~ i^E[\1&Xa8Hp9npx55;G3D E _?n  S SiPс J!;O&-biYC  YgSMf^hm>4P%USB٦=P"l#Rfm*xGJ(# rl _,ciP<bpH퇼Ϲz 4*+qXRs,6N㮅m!m>gN0<0:R)n8ʣHg9ޞ`~PP MgiՇ'Un'ݔ9{ߟk~,!r@ QܺwW=[Qx GnHqBL#3 rb9)Ý!9H-aN>@w]lmNi\0ec?B3Йօ< pxoc>G9J>›q!4"d7]eϭS=2wȁjJqdh"C+Ēh:t'+M:J#Q+Pk?%I" mAoT{kNAa2lbn&`|" oO2Tx'AB|c)O'VO!0' n^_`a-=L ~Q8 "IAƭ 2BހjRU,@Fbu'?(͈KUZ{\dXgK&0Png0Dπ88vcUzyЭzO9elsW56pLP]y^$)8nq=ax4 :!{6i ? ?D!==:ce{4?K|ג D.F;{QvNi5½n|&RzL *jƲkA~@xxvyU|9It/OZW&ŀ=fOX|C~٧d*/Mx5}+^i]Q_yե`՝҉WG[q.[TO.{HM݄.Rj8a}2$-ˌ%.0"N:a\<ԋDpjf<3Y gn%<VKcS8hEI5̡#ƫ kuu=~yQKg(l6I3 Rӌ_!M &*';LYe`&,Zh2Rޖ@69"MS_=KP MڔzYr9+jXfaΘўW#?{:4"pe.rPWK ZF'q0k^(\YqZڒ^Ct7+a˔BxPDܝ7.*$n|.B$SbECfC-GD#y]~4EAGӮ}jvzLv 怨2mgEKw߸flmUV eJT$Ԇ5>ݎtCw_<6!#?FKU8#.g$0Z(PPXyFS9`f 9E oE.y,BKH%;&A5KiKSTwMimO[bw 0mtgchpbJP-RY.V-.r4eo+wZ !ְvjsu~^JjiO7m7F_ *5a\LvVYC -cbUZh'*"We̍k^HsBQ<Έ7ӓx{d잝kVN!uMZ|2G MK&/޿2NZ6&n'A.GfpO8Ai 4tiJK%<)[S?i$--_aF#V,o֠!ʈT>R =f?_4n ZiU eJYZ͠nfi L ]J.c#.r}UU]tΊ4DíSn-n1T*4eCB',t"TǣB '= 3xJO/  bV!o_ƭSf4z^<k7I!wr& w7, i6kL J2' װ=N` [(Y Yz;oߚH{:(b4p5rcw<շVxe$E|:Ngv_ӜFyrS1f &fׅw\V5>k8eC 7-/:930A`Gc+R/ftt 4'$td: iC-\f!w܁TӸg $QL*\:6:kra Xo5|l59_v7PQ*X nFܪVHnX|Of{j n~]̵yz@7< h wǕb}h.} @7'"=٨Zy)i*UB}Y4k'91ʶ@p:E qHZڵ8w'g'GM|_ì-F<{nSޟ_I-S ]TVX ڢ,OL60 wzc .X5vL4`I0 E ` 91\ ΌČlT_n:_ 4|g⼨H&#Rmqfbr넥ƨM){['Xyi)cVPI ɨ-3!bӟ9,O lQgd6 )K$l bd힅W ?--\NS%^`5 + FY/bZg[ZkA GSÙi'2CDxǬDDi4qF30WVH/؇N䳞mCVѪJ^iLITChH $N%|O!rF8*&,3€Gh5ioSAfFYEoarG'Cj4=얠nN*b ob}7ǃ+sm-0H+0wZi[)urL iɿ[y]cK]¢%h1z8uq{(U~N88J%xQ$W!.΅DFvI oʅV𽾉 tآ)o4Z.OŸOhb+ A~*AbMEnl{Ήls ІVTAΜScUުSnT 5ደl2OΙxD"p!_Ǣ66sB79dh!R;Re+{ZO gYq!S<4&p֔6h-HvlɇԠwB~O_/2GLrvl4oNOð .naM0SX٢zœd";S!Sh`R΄=0JhҸjߗyA06a!6VNhukc%=im-v?]`w\J ߨQFBE<‘KW A'6bf~v* Sd¨"j-x $ˑDzi!޷}JMy|>D]icœ\DB2JE-dw;Ӓͻ_u؛ʕ"I8Nb eɺN2D<+ckxiJ:I汽oˮiuMNhZa]-nqRNU$Ma⬃fYEkK5--ʅnxz!qb"}] q*bmOD !"_ BPG_kԚ~PkSݢEWg?1-v n'^F;nd*Y"`/:״;5¦ۤWsDAU־J +X$\8UBhU9 P`]}/ . f'hA51g`a0VB88iVGT.tYb)gOhB͏Hd[JgMH sKC|ż"uQ JxgLMI&:BT$3ѽP ct/ʡWÚ=**l*p ,Gx V8[92 =Yzj|po.d{@R ȓ""+f2d` NPʡGg+ 5"dAu"TM-4j5W|?94mٟQ%M<EQOx@KFvt9-aDݚat"nNӘN<"2)vG8 6#dUe%ggֿ< *R!8ŘΏk2X4*)VnDaӱORgiF.1>C/eԪBWRלEf7?y0m@-N4tS+cMy0'3V c8\_-eQc_pBxosJcŒJP6̕ y͝ad=>U]SDI;pY@hq\lr֝,C b"d;G[J߇29iۦFd=N\b8eOx|LTs4%GV;/3n{KlI94Z Yɇ >uM!ZE^߹قbJJ~jr tʘ5.تEܑ " ȼ/ʄ0UXRZI@v 2ɟ6:'y  %Ʒ|cSԳoP4Rվ`\8={0|<5 w^8sΌ9FKa/SKo}ɏ^dwzR {')FL+)_%tr~vJhi9XI7JZOb*.bvR 0$}xo 3Is_}5 1OV(0I$T 1KW`Ķ 4'+{KcLLmKd[3u,尋-j(TZzm6|6&0RA ot3&|66%i Sօ N? Jr|pl 2|$k (lwg|Hci7T&%^4_E Op, '9c̉Ω|JӮKI|XԪ*s)#/7)EwpH e4jgo80 0j#%gA儜:Lp*`ƌz22lsTq =НSnaX[QP'eq~No ۑ3͹3#n>g#]vCH.'x95|DD6OqkRd糎>@  a%c ܶ#͈cŐ%AO?`ImHebVVa6}ZopO/P`!wX$|G{W0*V1~: %5ݬm3X6brAXLLFg٧lӀW^1Z0a=o޼ oЛp9Xha[CXVÊkd@g{QgJPn"HsIsP@Lŗ!rJSOmr+np!9ڬR 9nKOCbSzП@7&[T\ىg#s3>?$`XO|z%P./,o8'ZUz\6A_;72;V)J& 4:*qJ>Tw2Y:K*)p7ܾu|vΤصS+ w\)Xn!vWn-&Au-` Hruۮ"u9]  zqH2;5O?H%^,̉6;VXs~])P- CIOXĿ!RٌI1|WAj(eآ 7NWwO(=̈́SY׉,6^\ !6M0шZ]\nY"q%4Qqt~ƕIwUbs|!7h$w/)|2uD;lc(ӰqyG.=\,]BѰi='ahf}EǛD.>>1 #pBbD=xj&&2絧x㕾cLC N*oNjTh&QѴ-R%|<ēhQw z:A>i [prBdpU~xf?o)qBG {ZySy 10a8uoT  4vJ;DAV͆hKWhlN$ۊ 93ny`?pv={(F? ʢφFLCਜ਼mڥr5\!+pya p@9Rw|* vq~F c)l\_`YT,-k8zr zܺFVF6Ľ=mGБ3R#X&> I>ZokE3G4/oC E.l^is KV]0##H2Vy&yH]Y@d2|O%Fg =Rn ̺1)xt8gj[%ztJY8GW"~a̩/ݸJhephÆ _-Aq;. K`?gXʹx;Iɟ_ʘ(Du5hŭZ[P6K 'U, mğvu|_C^ǧZR8^v҆hH 򱐚8}6z}1%"l5!j:\{޲JBū I3D3(W!MC:W28g^4@t7Ո0Ry?Q`AMt>%vrؕqQ&jx]gg[|ӝ1kLs#QT (!/\yv#'>pJ ˓,ז$4[F~CV6;LgP,h#yO_?El $3uRӣT|LQiX;%~{rdH9 cfYcz-c1Ԇzz9%eG€w4ݔ΍AOS]"2츍HdckAC5nAw$om~kP%!u%HCÿy kp]$0_]`p7cjr#`iadFOLP chzf_t'/6F̓ғCg`&+FANƃm*Gt#.`B,n̎)!\=b,+&`UO҆V3 cYy{ʖ-fc1L uP/P!D7bh;S7}zd2 t6{ͯd+kHMI) oJT&`bu RRMY-@ю5rls5 bX!+%Āf_.7ɕ`д\טՇ^2AowT d xԃ ޾tk*8B/v"bŏtxH˕sgp՚@VRLL[?~IDz* 4[?+,JTW 0L,|fl;6ͦT-ڕ' %6FTdkai j.)N 85ə}I_S}$R3bG1iJgb'.L}41&3\cA15pCyN > stream xmwuTk5R5t 30 2tJ ]t4 HJIy}}׻ַ~>g?g=k8X5'TD@DPX`a/",##PCAAh,  " !!=Q0W4ۉo`A`0 G>9>}G( ]g P3Zih5 P>`8 s"<g$ '8!_x EsF!=*u5!S5iiGeN("U? sBPH/ߴH?0Ax@}pACQ}$B Ŀ, C s@0o X oϽC!0s$?G􍍁f|-euCL  ? >lZ῾#e"Dbqq hBA 3˿ߋAfNrn!E|㣎f|"s#G6^WS|_0I(Jy85nᲘ%jڨ6Ϝ(ݭ*Us,k'_y5?u̴M{G>tFrAZX5TIfuYx*h6h'gg~ʧd(MK~ 2@4KZ*,bfIvjA:7"I쮿eW3}ݔ0`o~ϔiRm.*2ua-ɗ!FYicD'jz>+dDBKx|'V6_x_w'ȽiB&Jw'M* {b#"߼p7)T)M¹hkXw6=Y,* ׷]ٌq or>+'~\"&3P"><_{3z `<,G/oM >+f4h,h3Ʈ V=6dEMo1dnhe>/ȍrf SN`f]ȃ)%IFڪڕEi,n]t!T>sffVx]ͭ](pxu8^\Efa }0iOO nMl: 9]%iL #ǥdOxԓ4Vu|K* eOtn>ʿ1ډ6fWqiڄ︯OBٛn0?tZUc7$GdXP*=kDɠyBe/r-r8wlt9*[ /{#NI53~rݡ0&xͮ >،}*6qDg%ҿG@j3KC 'eԩ 6짹3 '0wτ-}0|KH)'QAɸ nGCK=vrȐ޷?6j `#i9Iݝ“0u ^iV)g=qAp-`j*ǔAoS5ѝۆ>F:!jkTOTwq7OS7KD]a =Hh"xS#%o~+#+R:иa T<.l3_|V{{4.9jV Q^C)}RWG͖ P$a6]mM_42TUjj͆m~KNT]16RR q->hlsFcs~ ~OAɳ<z*}oLsGKa[@h;U1o9Uxqeb~gf/^$@:W=CZ J";K 8 EAgzE.M/1!ݑmН=<2+gեrPɛQh4c|& Ͼ'|aׇeޤ/ZEԌYk>!wn?Zʡ9l e/2@g;?z2$铵ЦO4~C.iJؔrIkRDP4*PWw+TO8!CՓ$S&O,o]ULUh2v͐N9Ռs&вĭMhc&WwڌRlu'~p晻 1g2p˒>(+4v$ pie`"!\3okWɥUT|NS?j K&?Rf ߠIeS[b[}{\w_SG'!Q31~XWΪwqjV cOtg[}i*`Aw9nd!.b :pr3oX!S1Qyez1H1;ۗ3>NN+ᭆld 6Ufi YB3VMZⷀga%ڵwL^O88 xP̷w-7;kKj},cv&ub:qD{qӦ95"  \YH${#)s`AXKn6Kݝ;c804rdYA74MAѡQ]$AJ'ݸ!􄕝M[KXeI͉tE"Tr}~is :u<1x=CmVyn25:A7|%55@x=dǍH>`ϱvBA}csoTur>KmY0s0G\ K-o9evVb*>䢻pKrZAf,LF ݄IՖ4;S)!Q޼񣮍@X=ah>c`"](umX^A"1Y2%L@ z߯wMK'ԎP&+b QLK /pb1Kk^1aaO145gZS瞍Q:Lc7slT6 Ҁ,1k3;KY6PvŷJY,L] D^\}K*̍bWQp [GCYgm9U2sd% FO;P/w wo"6{^Bgʨ$e%XP<֦mx4;5 ɱJռHg?:S0k.O=Œ7&I} +1{]o}yHwwK: wlyzMtg؏jx6[݆)Qƾ5-JzVansf8Gfϥaos/Q=e}ւc1T1˨ ߏ1`hWg@FLuyn %T]|,J9? -fZY0$atӫMG7<MNX2 +t0jАUU@5%)r`%6.tY29=E/wlaE ӤY&(Zuj>Y"l_я 1b}Tϓ)Ks,И nUoDnJTl~H 7z2UaӬm'a^kn~Yz?#4n.E/zMGR^Od,JJZΊ؉C-ا H5wk?\sutVrlm ;gפj 8߅}@9 (]jG2Ucًq|*1YݾfdE5läkFZ{1mDɝWjs3Ud4f5rv_JJi ď/<7ewt$|x >n{Ł#٥ 2?Z_iy\q^(P'6Х{+a8sY|:0Lx@ p}l^4)dh>`6A<3]oVŊ}%+ӟ=y[0 ." 3M-IY)^߫G{|+q"IbYLpp @Z-^: %4d L߉mcדm*}r<KwZ*_{f=uF\e&G'WfE ;R(nkK=$J0}]BuU~ ἅuֵiU;r .COvIM=*GE+ xOW-n"~_{z ?7 :Oԍ>~ZMMف9H~+yo* ƒ0n;)o.B춬u^# 8P˶8':wDO*3~6U'gs)>hN.{4|~Nc0FVhՎh&NB MٻȚl.cg+U1C,44#'`Lk)u*T/MFeIu:i8HQV$ 'ށOI@eBEwK2G?Z}N!V5W{ٟrf(Cm%ɧ Q v o%5akeO(kR![{Ma`s4s~L鲲>YQmyq3F6˒>v?eoJ]kfdU5  `7&b]rBYOm_Kv_Y}~7fŖ'‘Y S69v2~hu"^nRSm]7ٔ|޵ *Օ?ڱyg&mb|u_&> ӣfDt6rW\{t9Iܐt̺u_Uo nbVsnG թ9 C0]_ !<=ۼ a:q1aa7 T{Ү(kF3 2J,B*Kn> 3䑆Z-ZSGFJSendstream endobj 352 0 obj << /Filter /FlateDecode /Length1 737 /Length2 13137 /Length3 0 /Length 13718 >> stream xmysgn6~i۶mL۶m۶mO۶m[ӸssukuLBeچK4De&r<&'&]c3<.{0]0gBYRNJd?m"NH?E8,'fM?J%3iya7[֠J5& %m, kjPBC)d-]?w_-aw1aZ-qG fϝ"qظRSc6uf)A $Ya{pmsa3𕱲(^|m\C~-rݛ&e D.Om@ҼO[>2WGHQp%/=F$P_Yc GIf}xl}Q;=\[!z?ߒUrCwZ뗻St14<~;*S,> \'H:;ND1OL1ЎRvJOon69IP>h!M0@śd #SPb|1)b#0qP?݌JZz{&2ʐ"-rjg#&tQAf!Kh@ȚjbOpgNh;?°y~Z{vJ1nIȡzrKte]'@_Am~0{Ƅ̪++; ೎ْFh g߻g\ue4q0-l2H^QjSڊ@d0Z4@ce$Nh'T #OvqG*hFD%OU)f?u%U,@="l_=UtUP-tU)[땴=.3wB@:t:ufgpBpC.5 Y”D!ݓ Vǃy7iaԥZd~S}rBȼDh@|J)vn$Z˙h![,NvQ~&!dQqWNr1nBf?eDAqB EFj|^mٶvԥy^јA\R"CprgDfg&ZuqYqn 5r&n2rCͫVyL)U:{}|Kô8?^ħ DQ*(61dzo!q_=tXR'|bL -;dQhd0SʪiZO6.F]>sc&wBCciZI<iLu E|I IFy QidCKy25?צ:7|KR 5Mx{~HFɶs༧S9zz^y⣽Ժҽ8ela6ʃZnJl'/ 1'@IKǩ@LL-IWx6!uOp"ǝF䊯A3ʓt%9Y3 N.Ѳ+?;F<%1};XAGZa2' O"s1v~oN9Mѯ+S &.^|AkBn "K'%1d{a3(s͑cqhb,'Xl@2k?Xz %ΰ\c|4ś'/4ZDL40*DFyifoÒƌ9~%<`1)|mˀa֒N~JhѽHY#B -xǔXeT@\3^ {K/ X{b(yK8Iۗ5k@"6U gJVS]fA%(R$cR$!ѐULB#i۝|-6 [xL}y;uzK8Rlt{T_5ethv557K.Rɳ@P6#'QpJxhJ G_LjEZQv ;gsGF'U߸*UTƁPcHy1>zNH(׬oڵzn)u&QG@ T>\`[as{|BJq/bBK'ƥ*`_j/blvY2%}35K[joR% l CmNe2&^PkEQc!#5%(S?# #@$EV;gE`\lYԥCmhR~`K!ĄE b){Y4(k^C\ѡ b&t߱m"i )Zz ^k옐W+㪥iHE7& o~Gg?)D) %ȊgF ɘ zlTц&8Fj1qfVzhoiPgdQ3TI z1H3kȏs*o),PxBbwv_8`@!1mR4g)U6w VfIvnՓOxFeab^zޚv".&}#_Q|0<2*1!z-k#nG睨`b6CAqz9qfiJb5>R`_$clS#%F%u.S~v_GS,=4GA=a8/Yɵ#e9a.OXNpJ|Y9hnV=&2=ejcE?*KE9l7ȟ qJ:#ĦDrmF6%wwDkY5&oZb ]3PYmXztQT oZPn [cE0;pY`0[d ?aXۮ"jtI'TL@I nFP(˹^Y=^CªӶivGE >ur5;M#)ʽ=SZ3[<RhyctoXl X-!-ᥢzіcIB; 8cNnNk>rT +SfX@{6ͭTtC,OhP=$=߷_OI̩A\*=YurHFV`84{lI{)^:`ږ,:ʳ>x=\v bMpPGJtjLK`I='[vU>2W:5Lip^1d/UJN Ab_H\hCm> i^)K!O5 TkFKjr'i?}&}}2-*ztQNq V$<6+{gnA>꼫XY2藜qa* L[bj@b$O_diEZl7lꔎ?|;e _]ggJ*_po񒝯1^esVh:FQzzR8z) *waCm/ʗpBګ)'qt2>y-HJ%uEHX|픫Om%5ܗ| 5sdkMz wĥr`2l҈,jK @.Ïu4Og'Y*jnmvɫӶJp  @ϼիU0Uvof] dlFrEm&_1Yٔ`Wyks\(:TItt|O7}tu@ \p=+w2ݯ xp]pDAxs?x7]tr>"FfF՞\$ 'M4jѕz&G4KZ ҖqY;Eb1W٪{fqKVn7`O?KӢUwjFft _e[f?Doxxv1b.0{oICmpt@D஧Bc U ~8FT-Ϣ DJ{w0g]~JՊjR,O JH Ė]&:6'y=χ,AcHjA_b1hFiFLO6 /p^E1ZLrڐwR&obt„ʮի_)Ha۸hT=5X6٩{h90DH vgrI()^AOXǔSWRUt:vHK^u߻DGiL\6Gy3x'K7N4֝ pf2l* `x0k^J8)E >U#:C+6NXƞoZAGTD{qH LPnjȄw9Ÿ57$|h |%S/c}ΞW[%OǝX6#.-w{FRdHISۆ ~׭Qx&RD+p[Sd3_ˣٽ\(~Z5Uq"\ ԙuM_u?r[$IH뤮Z K1+M|;n!` ~Y\K󹐷}SXq㵞ݷʍtF}ȋāmOsnO7 T[inGq,yk}} %jG2b>.yoA}X nE7ۨP0UN%f%3+O8|N RgM?D "<"F7 lH~`P"is7ʭ:IZ3{>C eȇ{Ch/fs]]QDtX_D)`Z?Rb`j}EYNVdVf[f4Uy㼓\nVDx5zb\F HETY7%B-=63Ǚ[ay<ڿE&b1`U10᥺+J@*CeUᏢPK:"|\)tj'ӑ º ~rҵ5o~ xw2{Z_q aj%υ)uAf+rDNjx7ӫQD9bWB=\4i}PnOf];-^P/?[y5 B,53fq3!d|64D˲-`QOiJ2|WsI'N)mq΁:|#2f>&g6ʦv(ߢ\[h! 2_i5[yy Ne뫽y/b8P #m,+ g!uhw&azz~rej_mODK.V OxL_qāBozCqpOT' E r&kB<$# ƣQ+;#QLV_cx6Aq^ @RR ߱lUWD/uctsnPt#kkzTgX) ryZȠI{OU@,C k]c+UJD>B9edEG$ puTmB;vđ8OGZ/vG¡{KԖ렶GRA-6i-xՈY{oqre3H5zbOT~ ] !Gf=€ИBG*eօٴ+ OGl{ly󎇝2BP/)W 0iEb5-Ŏ:yϝe2O25/54KWp9M&!7 jP~p ow6~T Au6y#17x:SU^P HOO/EO4/i[_2flHB_b $2P{S^(p[3FG8nkz~<Ϋ^pnbru1HE;`60&zO 3#`I83]ͫѻXa1]=OFerF.zb{dNierWzX2$ Tjwgτ3"M w̃KSޠ!=ST[MʐދY+Ӑ կ[ MQs!>ѯ,kÉ .fWh28av-Ԡ.[QO* ;oCW7iF eOy .G15jG1fbڸ5"KW^{{N-) zj! !o}7ƥƽ;$>`7ۅ5/Gy.ʡbtwX(^dAÌp1,:d/2MQk(bXOCtȥs2XLDT.V1sM~(9'`mb u3aU߹$asZF_lqXtTkx0ӱrr&.hkh1ؓ@-+r-#%y_UN| \mZNrr6nA-֧Pa_ɧՄ;gkVY<*zZ~Mk G6 #Nz㲅'2gU~Rf?`W34Ak,$f0v8=kpv *rH?֑(XaV>(254fQuZn=Wu]"*1_]mͱ:dR: G_MЅ/X{ _u-niC"Ѱ}[Ҥ>€iy裆Ke: ZaN:Q*Qy_+OufNrI,[@<v;יNudC #zo#Pq|D6[giޖ]':&c9 2o0B01at3&O3(t*Y~ @z9:R'}83ݩYj\f]3ƁS%r RŻO!F9 FׯF+hՏOHlr"!JSO$>p~(?)ȽbXIy^ DdS[AI;0Y{ yY06פ>Cd􀅴lJluE(m&qO,)ҷ}`bՂ_K[b!4m?cיb}yS2hBEȧlv1eE0+7xI?-V[8^1³:(RjjW9rjdBMAUw!]ylBzQ_IlYtP~.%6/UQ?yw!BlCˁEqQRIDCQ+DBFu*Ontߛf Kٵ#2tC穚m7qJCdse2CZE^L, rtm,k'&&pē"4 }"1Ӫ?u"G >  ʓ.w3rQH.s۽x$M 6M'!UYC湃I`dm.fC ЛSd8#ϥيNd;PD_ s E"Ḅ\P+gxq'V.&B\V^GL{D̈́$H;fJ JZo.vgFubeY5cF7sBp Sx4]2I"If9 Pɻ ppX:K ]?Y/OfE P8eC/G: ԩ;*!zKF5EZLğlErl.ߚ(5 q"% {:҅R@uqN3T[f۵$Ө!ۅ{ľSʃ9DQqs'~WƀH&j}.Ie9JU+<E/Xh]y-b1-:,HeG A7("},Dw$3s(L~ ?ЊkP~Uf)6~MPiH #mL<,sRQS`msTTUAM=Bhb⌰EBN=EQXtH6m*LZ`Hɯ;p& i/`UF,,itiV* y*մMCdxy`"iwze[٠ŵR r$~^di|, ܥ`~k2]f)O48#ֿ*OhgShMAiQP% Kn9d\ V:ZvJT͞G;亅IV {. {J)gP_&sFT1%%xa+bM 7# VBdUWyO3 %hO[Mu\ (dMˊy׏9Aٯ6 Jn7ZvV.,1(>Q~w1-]h!Ok:cQwIvҧ4@&a3YS-&9o]Xgrf;{"YnvAxQw˹ԍȨ=xXG|L.r\<ם?Da^VeɟfA{Q)˻ki<vz<2|V:'++UǢyj3*ئ3]f9qtK>w U.@&G9&'C~Æg)\3DGBj/e9]a1X~PxwPkJ)[Ҕ[h.o"$[l^~VBvgY0kX);Ga zN19Z8JQjTw^ZTڥ`#YͰ5<8H0]1, sg}8 Gq|4rzbc Aף3l-g81t- SIq]^.ΈXϣCGKKhҭG͹5\vo C`vt s-+5^$3 LˑQq:*1klyZf5!LwbgUڀ:$V-tyT"Іf%w)9{LxDAbƣjʷ֐7z=LI/ex7Gf de@YP)*O ( _Z},i3+خDlM`҆(Bݪ;.Acu&ryd_ƊEuPJ{ '&S۩xG(sй.>wm$ߣm吗W? (v>IP5I-Klb%d)r)RhJE7Hʑ}X?<~ ,k8TTgpOk/Vnt=HMs-09|7} s^$n58T$QL.?v_ d2MΪ DІTM9J';"ޯMW#hu/pU߷6QU%R6ǁ^8h]:ѸpiDQ:VNr_XH(V?",0}݆pK$wQ6>:iW`'TuNl+ݻh((b'Ӽ a\E\0O(HXܐ E.Gڢ,>:ˊ) CMԤcrJɅ+XSOycҐ5/D8 d{끧2kvHɤwaaoldݹj7Hv+LӋoshS%d<dbUd5ݷ#\ G#F0zC\z^u,jYe(qQJqѽ@mEM(ߎvR17lԲ;K; pu]gR ڲ,?Ղmc!#9\QnIY rĒ~, zK4'g,p+k d^w4A ljpьw<i[endstream endobj 353 0 obj << /Filter /FlateDecode /Length1 725 /Length2 16424 /Length3 0 /Length 16926 >> stream xlc.]-\ze۶m۶mۮeۻl۶97g2XcȘ3V&)#-#@YLE@ CF&djbio'bbP75(:L 0da{O'Ks 1տ5CK[K'Mٕɕ$eSS) ,))'Sڙ:\l,2ƦvΦT3{'09?̜m*br*Qaza @Ft;gM]\_l W2_N`&.#SsK;&igf`\r&fDښ(m\]L&NvqdB m-m<O?dڙCLb& .jF?pϩxʿףSє"[N&k[??XW5tqh3D=iXlFfVF35vur2s711wUzkXh\8܌* #t6尅5΃ N;lծC a)T Q [)I05l[c9{̍ )켋R1H; kOvT(YZ?p4HsE7Fo {pdEGZ Vښ ڇ"a;nUq[A[+G: QE<[;w\9K_fGRZ[}R; bZB`~-oΕΛlOS $s"NjvIʼnC pd~.jcafgQxb]c~E990RFD4><+=(s qwtUm[<8"\cX`\F~C\rPܬumgSiTB'vk?q'9-4^ܑ&#dr1CwDwPڋkutJ9Ro,eE Em\9͕Z!W OIk=2=Qg9'>cn G `1L5~&96zv3CCHl ȊFg-N"}РVDU*eԢB~Jm\w!%+NIiAnWO%iwIM3[9\<91Nϻ'XHytY<4ՊzrjOz{+euLO+#,rCY-ݰmh Q9a a8JHsj&g-[9 A/ 1eSft\_yzS) vFd̎"YpxI~x=v)P|BY]|0z,Vg8rcbmH@S}񇙖ҹqg3J$Xޤzxx!GWbs"Pl_:!OM?ҷo׼ ! [@uX:nc &40ƢX p4ǂz.NI hA0 4'ZWϥQNEUH]9,8ŵW,d*nuj „>.bd[' 6U35NSmk9uw(G~nrIE4fD v@y͒CD͊VJfӲad6aCu0Y˙Yg*&MR?k&O'geCK6I3(hƁAzk ~jpkG*TvJ@olB'תyN&x41q@L8 4\ڠχHPϒH Ax5>02|W[4xSfn*6 :"'v(MYH4N`&) "'b' 8h҇5K:A~ђ^9١YM%3/5| {0ow++l}+/XC"*ę[́~OB"οj?5(u#ʢXJW(r~XÚdUW2 e\zf΍7BDqfp$QRܥ=缔e+YJ~KNANOJ[o|) r5e(J57m>3R]P̬f+T* e=26BQw@TMd7+{c\!$?0dip=YF4$G@ 1KZ}UxZ'$l~z3YZZqAz[EȊ ڭC:z@) nӦ4CiJʵbSv=m h=wBx&X6,G;?RVl\2{Et5ZS~@;f4h\3ߏm"r`6쌨^H+ɾ-sn6ZÞjyf> 쎎%D zA&gFny *r֞ wt& _K Tfvn7L\3wYB8y_bўu_b$«HG̺8NsqQ,zz/ ( ViV*uo_4ΪboS9Ox5Bv Hn|;gdB٫q8+Q>AMhJ",?>'SP_Uw+?WZi$ YqU8Nej-Nt8nJZc5fRpRЗڭWK@rV,) \xJv}S!=8샂/1o}&AQs8`{BM[u6XOn"D_pdc )]iLfKGtƚU#] 4 $ t?q)\Dmf˦ hK0z竏m1xMd2L˿/{sRJ&.MK%/۳GBfKq)*XϪkGK8] t$^دV| cn? CP_qfI;debE 94n=(:1C ӓ1Hn8Lgwn/`PD@7jAq4d L?A%<;pݽ|'Tuu$Kʏ; U mM5^Ŕ,9C\SdZW bhNL% "T,t聝=\ ȵL3ȆtEc!j B5'vi̜t;o_7_ 0Mzümqz 6º0d/=&yjrpIxF{]?3a35A4<+dډB<>'c8XTOPŀ14"c욱o kG@,K/t*[*, W b͏KkvL-%6DHqRe[]sQr>4ThO&)UZ-17MQni8%GB\\5y0Y_֦y"FCM ͶE0Bldicavoh/d!ٛOX2 ;ېOQ] < TP8_ި RYt\T{d#`ޙ5@LalҾ{ DWkux61Ul=0' -pǰ]Bqн݅F&G۷0;LþiMqψ|v>2Y5NxC@ñVr.c&"˙4R/c:֍!)N`]G3Q GD*#Ձ+j03㧻u{X T1~`׾Т2 7 xx{YWN)Zl_g=s 00R? >ܣS[p-B``K 6!$w]_X26+OqۂLWYN:пvzka3.̂u6ФÔWs)JEp|}xw0O`&EAI_H$V=F87S&g'k+)A/{^zy? (t^twZC\-긿*A>Xl+`lk< S*}ϙ 󳕓=\`.TPge~ *9xeTg_X3/aĘnSn Q4 ܯl#l)NAu7l$@ܹ0ל qgJTR l꣪Mg~9i:ZFPR6Րg%U@VGow E5l}2Lwi\<=b#'!hJ %G{JRA4C  (2uw+2"̪7*9pg B^ @ju+Z7C $@^pO)]Ӯs=``!T‹2k- uÌM٠*]P[",q$=CVp]ȿNpλCz>=mּ4 aoy5y ې}z_ tRi &z4֎B*Iv0'][9(83—H(?n'UDt꡼3LE%>O [O8b1+$4%N/kwʷ WzLf$Mgymg5k`Ez)o-a2Pex;/ЄQk2 =P ۘC bb{y51~ޚzyV6Efa(iw9H-d^k$S;՛fUҾH֦){f"{~~V?,,;3"\8>X6m#C,C fi_,ioe-q%:{kzF{(/n„m;@7 1M,$ʵQ@ODCk8=6u+/kH&"0R g,;Ke Qa~Nc*ѭ9I(ѵJz F):0Y1"x1*RQl; ??7?~e]tg\ԙcܱ+玩mHװK<CYlr\sJpuJ! 6ِ;(NTg}y:YKNFUGݴ7aj2nW1ɵ^q=ư d/mBW!#(CʓX\@~ /wnGNW*AhbAaAmϨ1̯g Q21 =aS'~ɮkP,Sy^z̯qt"Ӹ=$J& cN.нm~,i,^"Qua6)F1Uu Q8`V9,8wo@ڋ}"MMdto_fMsR ? ojgS] Y9akbA3\wL Аgzy ;rw$:Gj`Gli!~2>RJڋ 'ţ۴?A͚%k:7q˶hK;^4uu &6S{rxixwm@oq3=4emCTg$6'.Hv%dּMuXb1[]Wے^0YR ;83~g@fETQ=)D!N=c9lϨ3p^'_\yS|{۸ ymKucve $ "IƗ~.Ob\ yn}wkck&Gtǻ7Ezs1<0eXۊ(oM.ړ,Ncyb"CHnppqnaoUr,sK+,-R ۮTKOt3OU7#q!զoJG#-79]2x(aHRNp1j]$EBtR$7y ioY9F!37I¡~dgY*:oӕ#M 0+.;Pee G /G N:s38R } Q򘇶vG𜻯gF<(eUԜU cQ.&TfߚDsN,pY]¾5*"6䘰RC~.xO^8 ~}+mLFmi>Fď~_6g%v1됨c0p5t Wg. Rƨ >(iQ˽{z!?}b~/i*Rʬ+~og/?oB1~}9L&ty\i\볗D9(\tLDuB1s:QMMPŻQ{Cqub8}!8 3b26L B?P}~@ ?Hī#NNNZά4" 4v]ǡ9Y7BiST)HJ;X h?[B5j~&uϏJnuGQ^u=xȔ"1k"2u!J0''1iwZ֏Gd1\sNr+"Z}+#?tOc'.Qak -@N@X*»_M23c!LFQ7jY1M3J?y#" !a_:bWS(g!vbɤ$ `5IL[1S?5qy6(b- 0LS kT#Cۣ|&="G8n7YV O̳#nN 9@kPF7Fg^5c/zo/T!l fllд/ bY/hj~W7nܨlR|o~ۻ1$U7 DմbE5tQSe4j8>p07+}dƺ O)"{46QhoUܦJ2,,rc%p#LJ4<9ܲ w޽ظ,d-;߲*SĵzJ)\` &O։SIyvg2}}s ~plQ'e4[ SF;/g])SaDt=p``jiKN]߇;u>8bי潵8 QBY̧ Z7~4[Ze ?3~RMټ?zцTϳLsJ|l!|f2Ep.>bW$r,Q $ݑJJUR_߂%JI|Eo4=xl[z'pyS{BڏXE8A"-&8QaFhtq*|Nx $OrZ=aSP'V2DM|uUوhEmScUŲoY3f6)K;%xx9ĒCWoC2G~2,b*ıra[e][R vI+vty lrjNo||䑖 p2@ k_Y|/rLԚF6S@M2yG03u3 E/o|%C,9j$ChҜLsffʅ[>ͯ~}CwZ4!RfOjTogPe/g1ImZ#dMf+v|9fS ꆂʱi>F5OW@͒= c)\RP4`'*{w=b–4n[Z+ *U-E(@켆 UTƆ]"L\ݛ΢K,- x\#TZ d8]'i Q}ľp)5uDTQ>VG- ? y= ,R[Co3 #&F-i}T*ڋM^45QjRKЌE<3O'r㛾FpO{؄q fIHPDV&+ErwQ<޳#cB&uz9=s-E~Q!V%m&s=N]4h52zxӏǔ)S jK_8rF8-⯀Q #nGfc#_I?Mzq}:Y?}~;>H6Z lLeݖFtŒj#JEǷF6 "=}A֑~R3ƣl#1yO$'o``/ML1&cNq*>☚qx+ Kp>OЭ[$Wٲ20zWsJX-"$Y{Q9F A;yq`,B%lt7i_QԾ?{r %)U/6x|D؆]%`ΐKȇ3rg׫MRK:hح_\Ǎ.Bd@+_V(t;dc, d`X4b G3ƔLR7cJ­#1x kn)ԅ!r~!Y:s|q5x%dFsJl<)}È 43DS -βxX$feRNCOݎ+ޔ" dBRzi/#uM+Z`@2<.F|I1 ;n& bu/2"օ]"5<rNІxbHvdؾRy-d NK *ZR\>ʔg8tg1Q~̰86(t;=G ⩆ŘBYS,"P`.t܉ 5f[D V8^qv,hx*w {N. ` zUl\ ,p(ksJq1j xz򇻲Bʒ)Qxo}0G9CBfcGzUb^X;r1rU-Y%&U;| ѤI_^Yϧ[$yW=1?TWЀ׻ȇ*3t8:O1f^LV)_UkqIk+в^QҐ5`yt~kx aHJI}kt!O]t#|i̹cmX b!>Npt;lR,1p@ PkŋhSK>^̔c؁KQe1Z-V74jϙR`e]\r-v?&CO]e6Ly|’r 1ڌ\}٨<崧.!g~NJb{$X͘~>/8&4 Y?R~B'k(ݓR8y}xߚk;ԅVBl ]܇~hn=K]w~a^M5 l}Gi@Zܡ.SvۭۆSSe&Ӗ혦LY/8Ny@=uQ޶R5ntG O[(c"+6&&y-l*Sҕ[* )!)^K=uh=S7J ,@ A⅋hjnQ:(f<A7 y >D8C'\,1q'䟾w&?OqQNYgw%UJEhoN萿=[>\\d5)=ނA* )Jtغ|cp1;|鹿vg[,Um#AXDsS.H_ֳ 7: ѣ;.l4+Uxbt֫ {Ń:¹|#6Uˠcm|(9=F|X<;YS{O-zWn[ϨH[J2L*, _f{}`J]"Ւܖl$Ř77;S1|awr29`MB0m|@=rw0B ! @:l ol Q ~o"QQ,ܽHWR̦ "zM8!f+)$ +CE855Ì-#8M5ShWK^a Xp0ɅSqQźE Tv6,>R"p9T [+ j-(ś[Ytj#K[mup9Ԡ(\~ylW\Pv?ltX>cՆi:{KnHWrG  x8O6-]u^jxn{*MKkN[.Rx 'ɀc6g*!! fb%,baA-d t C)ܝH^d0{ `JVDɜRH((rz6% 'pq@-mqǟ̈#WM)cT{t93::8*s.]L(D&J_4$|i(=.=% A,Դy,u5CT,J6b- -P?Cӱ@M[F'57caWM_B2-EteG!p@9'T ) (kӺjn|I9ZR9kj'<_=f1LfPڴܰ,U7Y[Xb{r5s8,U;Fq::w[׷[ߗ|*vo л_¤ݛqƊ_9|d/J&Ϙ[Ž`VX6~e}z+7ꝳİm)yu1ݍNI=Eh$m=a,M]DK*:! [yMKԸFd$F\u1 0au6߁ "W˿zs &ۃUᴍ&4zٯKcuqvy_fU_p3{^ۑNkL+GTkײRg| h 7$ XAۛ(ي;;]G*,s а#+3N[}⏪6y̆mAjicυFt/j<b~rhL:?ԠnɩhlP2f\0j.RϤ٪v3>_{e Zטt2 uT :.扉j>By o U`DALmLU9ǚ.֒Z۩;w(ٚ!}Mv9Ke_.ѹDXbZH0 nqMXR`|#dN 3/孼ĕ,];DŪE7. W6Rö\M~Qd#q`9+W[AY ֘j (ikmRfPt(\SmA8Zujs=Q]2-w{$؅Zu4?vIpfɵ&' _ɡ [?uQҭL@g8j*N;V3pm'@K:_كx6b@X3]J*> ~?gB:bH^fY$ #=? "9yc~7ݪhP|i=>BCѤb9+RՁ^e`\msγtx4А|kHyg`-t=1pQ#~Ŭ랾Z]^|sr"6P7hb Nk<*<0Fn_I-D[c18{`[LUdkVd(&VJG`2h I,T} lMgyxKvKbAC7ճ}HF>oȭ!eG4T?>XԸ/ce][E3TQ|r^5C  I(M]4h-~ t39ݮ[ zpv3j"5Y(S,kvme9#X ä9À \#HYd5HDlԿأhL`y"*iH38e)<ΔZn(}?I;7_U{G|6-[9R@~|©g|?l|<,_&>{m*ZYYeuKʾHRÙO4NhCɜnkuhj8L+x1|)PѲӑS^x_& #ZH`t{rWh7 KDmߔu z#>).X4q9ʮ L%!mkku7 .&nAy<昹C!" *TX[8ioZhq&E9&z۫r V:} HѢޡʠ8~-#?>춆uH{{[''\.gYiϯ 㑟 .ϐ\* {t29L 1}zñf?I' sYpX-^3 _1DF_לby#g9F.G M='cݫ*;knY;G7IȚTEGGh\WDKPv6ܙ;vPkXУQnS(ndwZցgw aY{L2ZU̢U[wܶ/Ęc}b&D[qy{ 粖?m7?ඹe^Zҿ9D(.j竼T9o6-,}H2SL((eMU+vQ6TGp4CPEZw MA!YAEW#=n_drjj =Y 󵃤޿ͨc/'Bգ~ϳ7z@7[1]]B4+ ~wە1#?\[ L? + p3 $kܬ&7z9I%m^ËdOϝ؏;% q :Yy Hv.4|FXDh3.N|RH iP$q*k,A1Voe0 ?kSqg5͗cp{bq8ִ]P1?aj&+c!qNp.k\X], eIPN#؟l⌈ qi8c[nP0/:-G@ SPendstream endobj 354 0 obj << /Filter /FlateDecode /Length 1587 >> stream xXKo6W*t!i= Em!ZiGp(Y^I{HH| |~FT 7MaR+*\mOvQvC6}U\ōN|S546supm͕|sݪry Jou88g:6T7ٍHXӬ K\0lsM"-=.kwr:&HLD0QЉoN‰[Tlu-W ~W% BJ.hH4 DI6t-j EzN.!i ? V̒V )&lKZ4ο.ozL*=ȥ%Xc1+|MG6`h{56WI¶]_ s|U'QO\5\h$YH%C0عOGxڡ:`_ *9$*Y9BDVDV,sDQL\pS!b 8C&1 :?-k|n 퇱P @^_":rMIs  K.;UJx)ma{Yp6`]vh9BCkd7#FOM]1Pռs]V4xSBUDҙw .㡺=ZY;(,g׭,pU 4fZ9E дc5ą6pk?8c]}Kѕ{(w5e3ӭOEU>6K uVE=+ Ɂp8UJ5G0igKDZxb``4# \Cd Hwpv;f Ӗ+eD[)EDFœg=j{Y_6eMC~^\ծNm3}wkQh#w޸ƣ9{]Uۙ˨T 9)gyFrgg @&ӳ4=F(9GO3`kzc7r6SThP4%hj^婐s)r3מR)}y1Q<%1d&n&PU]ZzX$}rJzx{_̦!- `S-_x~xj'.:k͎''b(;OMB=%?$%ؽkQ/}2̼1zS"K\l`> stream xێ}@ # Ҟ ڃ6@R4Y -ڵZYΐK_6) >gwz(Ii kla!Z.7o8?Sӥ0._˕:Z5Iۗ.&] _Kn.|mmcaL4ábp &*' _Tb%zXo@.r>%xporɫ:1ȣesX1Ay,KNR8l%fB$uE]iA-8'.B>EC| Į+u4+??p3JpR;/?'Wl1YU؎6ClÔTk=޻S[<@*miἶYQj9eK\ @<-B\Cľd9g^_dgG<Ǻ,km!)'TL["~r@l-ZhI$7MN0]ז0DbXww~Ox -XU.gh P 2b+0@LW ,-=0Fe&UF,ݠ3oclpu23 T*ϝ&JY#âxT7)2Ζ 9#[0F+ 5P^ؼ#`?A0]PK3X Zޯ̥IA>Prȝ zBđGUלcC1;Sҧ` a%p4]:^so1x9"P_ӋHCEy 6LlIa. FFwrq 'MTmu3Ur 0l 04G0L)ϦT(&(xJ*B!825Gj/zT9sS,b 3t `қAugzw&RvI}$DKӛ(n8݆qL1R;fْи'z& AETarux ̸DΊR9!Gz iD7%Uò74Pq)cU{5+vXI\R~ 6o~p`,"o>J7Xwu=&M=9ಒEi@iZy +ΈҁeH,dXV,{XI!6o2KpuXxI0|^b< ڰ*)4y[lYjՏ(b̹zfKw ,:eS \4(7Fvc4pڟnv}#*_;Ou_m?Z(0*Wt|ϥSߘr i:z]&~GKЄ96݌Myɫu>=sT2((aQ] zT(0&V{42yMsJ<^աi Ȓ1 5C&*2CRe7C` 'ZsR曂e4宩.k?u(Lfy;dg G]DD*b{gM3M3L\G>à-v.V)3L9-=k˺fݸS5A^(_=C^v `x0p\ \6CFtwG?̚Җ>|d)ԧ¶ bo 3 Hqȳۣ̀OE9-ǚnP#/R=TsQ=?][}7ckoU},^:a&Mޮ!8a)k;'HB[2ʄe}b \TɎ*;3O)pT@ ڷxa , OӘQ0о3NZC&RPE' dϷ_ Z/)Xc 6 wy< M*i[TF T^ M['@E1#ts!Wz5:~xWBV,ӋI_T7"P'j3hQv. gXtsC0j~nxՍL[˲Dkcb e?;vp|ոFw%FX)kA^1!f;ar~TTɇC Ns S:C]vbɟd(gnL=:pt9 +҅8Y/oYHrMWy >WcҸϮEF{*` ԋow'Ѕ5 )J2 @ck]mkOݢI DO /#NzMMrf8v> ,*8wҞq1czEUQ']1cL7TOBV0׃ x%OHCZJ`x̤6=:|ji;fO%l'\ UϓܠF^e}G] r0(M}wU"zDZ=,PPLQ>DiUv>kwYYe< p'S~"b"yZ σd]}X:[cqI49scкv,!f:+PMv/pU -г> #9_sh!1H >򋞰J9?UgHh&p,Rp'0yG ~vo橽*8oǢp֎1.^F"H*+U endstream endobj 356 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-psi-functions.pdf) /PTEX.InfoDict 123 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 126 0 R >> /ExtGState << >> /Font << /F2 124 0 R /F6 125 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 14144 >> stream xM,qW^u ~m%l F0eKm3~qNdEna`ZzU72y$Y?zǯw<~q]#~?7Ǘc|z\R?:K ?Ux1磎U>~m/p>j'>}C>vy|wˏy189`_/ q`rZǺpcak}~\yG^ႉ|\+\0pxk1$\0@ǸC ֏\/ +:Oᜯ+J WT)~%+N!aiE~p:ZGrul>FɡByho_zȧ!9C_tG9t^PEvmOX&Cj͏ngz\ :)棃Nq?e`G9T>ɡUѬqZ Qc5:gPlԯI{s]CY?Zɡ7ܫ)"s:;cNDFϥ|r:u)csNJֹSza%tՏ}xs;hWCC_CTPS×ZޛCM+}g7:LSA,S2 'ꇚs}8tJ9R>,DU󎽴|{7Jyu<'.f8+ fEAI?xjr˱Cq܊] >*Fq?8Ga)h4l%Pl(_sSjN,ꧢu.>'IiQAQ\ȄfX͆srjXKŲT^rV{܊ 8d' xB[:F(8( X ){*K bE4u.hbG4彜(Z4.ʼnhHqZ@Q܈A)  q)VDw6Dw , A)"_Kw9ʢqP{EwD\A֒ X/K,-ؗwMDqKq#ryEcU)/{+VD 8=uET8 =Emi.Do=5EPP!'T }(vDc[ABho=E(.DT܈~BhԮĩ-bE4.ņhl{S!E98sAX!m7qphB4=MO\ >`c:Yq-ʢ<emߞjy 1^(7午(WOͼ$BR})Qʢ|UOul9'kQ(O-੼{;6|]Oc y(E*qguUnZn]YSt$FDf% Q [A6/rW.ȍIX/o&Y;|^O]|UU'ң|2^OӰ ͅh*HF^*zjndQfխ<&6Y.wI؝&amg^ -> XmXfO6ECGSn4܏=49ObM\'r!kPW:׬ =&54ǝ_/ 4vYۆxXlz5Xֽ[~~Fy|_br<'m E/vAIO3ES~|䅚BͿ86ﯽOH^+C :ECh)ꘋW(uХ9zpj''̨ĺvN!Gk#Y'r9VM~!۠RPs{Pe<#F+b]뭈'Gqh#+2QfO#;="+ F"JhD.ȸ#ZW'bϸ"6pD8#Z2b82]}D8#M_Ėqdj,cϸԡqFq]ewP3+S۔q;x'WƖqd1=cKF#"򫣆%c̯[Ƙ_5hÅc~1`̯>\21c~u:cYM1//l{pdOψ1:jm#Ξ򫣆Gʯf\gʯfKc~u,?㎸S~N=PTK(gĒJqG){3c̯fc~u0dG)󫣆{ƘߵR~2#{ec~=c錔1wה߃-c)c~u0c%W[c~u0.XĘ=R~u0c{0t kƘ߽R~u4c1:ze Uwj!ֱXcSM1WqFl3kgj!#8b~m(98c~%㌸b~[ƑqG1=chvȯdK̯ tdC~u4fW2!:S3!U3JƐ_2!:hT3!6ܟQ2{e=[j?F%d5TSՁ-v0=[Ƙ_cS~ c~M5Ř߃1uƮb̯1淮Tʖ0TS՟b+6c~;bIc~[M5Ř_˸#_˸"Jʯe{ʯewđ{g\go)gĕV#c̯g M5G+WTb~ 1:|Q2]ƖqdỌ=c̯_+#W^d+3Wfl)Jic~-c~ŮboR~{I=(c~{IỌ1:|̈́13b̯e=5ꤖ#5H=gj=82+巯߾R~NM1c~uMƘq+5tn'3bMỌ#clL3Ʀߍ16FO՟31kƞ16Lģ_##c̯*gWʯN"83]ƞ1W2JƘ_2]DIj: +S~gOM1:?>c3":{0w߃1W'elc~+5tn']%utn%c~u.c̯ElZʯETm=Z{0wTөr-av0w͔5SSm_u1vN=(c~j9gM5[ %clkﮩkʯecSmKAjlGƘ=R~1{cSM3-w1]Ɩ1WqG,1=coỌ1]Ɩ1WqGR U\{̯d m׈UlC~wj!+]-Ő_q*}' m:|1WqF,825Wg\[l)*Έj!#c~{q*JqƦbȯȸ#_ŞqE)eZ1:|g\Ko-):|]Ƒ1FbĞ1WqF)[Ƒ1nIĞ1Δ߃1淮ߺR~M5ŘߺS~M5Řv+6c~ەJj)joZokZoTSmzj)FoFofo[Vo[03=b+Wl)b Kl)JIjMjʯԔ_դJK+j1")"Ffc6oyu=[u5V]#`骫M}<յR`Aumݞb]g;/D^PyPtŌk{&] t];]NK PtJE>hCtŌ[t}!XQt틗k߼]ÜCup ޠ:L#E:Z](DW}-]Gǣ렟Du ]D~!]moySz_᢫i4[5B")]u=-!^I5oU]Lt-]tUtW5j@ti Q;jv)zjv!rZL֞d t O6"x6WCL9]~|!BtU.ZEՂs ^EɃjkIUy誌!Bp1V?E1zCtbMu ?DW_eEWto:|C\:[tm\EIuT"!b]Gqv ˟ /];.v/E5E׾g}RtE>Bt}i]},]1,E.1!Z yPTWm_ZV_5rt׻mK Z؏kh*..m \dm/0^o] r=4_>]}tZu;DgG1ΚDvYq qP2bHO`m$,tU*Ct!*.ŰX%dذsYdbчj:LZT!kQ=]jN={Y+Y/VXb=:yaj27X},”Y,;B ?+yQfJ!k}}0:,olOdY5물&KA)kMaȇ6PdY[7m'5'{u_^UUлïe'6dn/7e1.~9RI_և.or]\x,@e`l]^}}K$]A/_vnJeb-_vr2_vr6ӗ*/;9F_v67t_vr'_eG|=N—f&X^ˎ!!,eeˎ | { ef_o._{lbe 6eS1_ s_ 9e{c ]^1I_W60 / yҗ |~q_VῚqO*/,eeNC2Xo_= teWwx4ev/+y/+/+a/+\mxJaـ/+eSeb$g}ͲA_{eЗ劋n^+\S/ot$܅ۗEzo_6ۗ}ۗ}߾lķ/·/e}وo_o_|߾ ߾ۗ e#}وo_6ۗ}ۗ}߾lķ/·/e}وo_Ʒ/ɗlysi˾}o 5{k?ְ1^[ÎGz5l֑[VJ~5, {k[ְrkXv[vLa.o ]hElϕ[^[ZO%o +[dbh6fǸ7]ua^X A{˷.5la ְHcv6 0fS5Nbs].5ј 雰˜GIaF4f]1;9bh.N1\(1*&tҘ]Qj ZKcvq7>xcoTsWi̮q]lИ]|t1'$-@i.4f7>16?$M+n4f;cv_OݾuF]|+SҘշb1scv[˜ݕF]1ݸ10fϷ1'zӘ>n+|kZa֫0fwcvlnXanc[zakXBhoߚn܊nn0Øͯ/|Y V0fo Lcv77HaF'|+Tۍ ޚ쮜Ncv4hK1O10fw[an7hnnX~heȪ1@16'&Ә]Fuo5 cvKAcvV4fKwcvM/Vo5 cv 4fWmNcvJcvo= cvq}7fWAa̮Uy=ḫa.?4f15y˯ucַuc6L4`ir7ۘ4ݘMݘ̳.,7Y!Ƭ4fg4fgtaNvWܘnјV0f's7f_nn6nVn̺abܘ0ȥ1;^ǹ5lK[vwc/|nU P\ƍQ_Fl5i[Ә6{kk7fLm̺ƬK n.nmdpcW|pc A7fPwcvl}Zi̲l>4fִ0f4f;qcs 7f{|avڝlxܘuɍYnz},{1<1+321+ cV1+쾹1+ݍO"n˜c=ocVا1+nDӘX6f }R˜Wh̊?h+y1۶0foLcVos#sۀ&4f@c ͷR1|+m ln˜ml)a̶Ic5>_h6h6_l4f[ql+~>m7ٺޢ1[}շ1[Ic.7aV1;Y_W1_a1[ˠm0B"o&*5kN5oV*>>n*SnDo c>1s{:i(0hY=Dz^p)J֌r4Z꼱ursF*Aq5V26;Q?¦e:2lLf֚fJ2Cpjy},,3 ;/i5Aֺ xNjGf/Wi?y-?uyQ*~_"uaݮ`ؖ]_H=ݲe !VvP y]Z#k("鏌ٺg۱u; u;_+nѮxu;_gnDsh]к`Bv MӺ\"nhJ@vMvMvpZ,Ѻ_]Z66hݎ Z>BvxCt'D>u;/u;_ n{InBX}&ZҺѣu;.F3Һ[_mߨ6iZCn=u۹5[LxuۗSvuu9HZuu۹>Yr`F>лu9m.Ρ Z}º\m, n;nWn}P֭Kׇu?Y]CBԴn;ޠu9Gu۹0tHqL֗uuٌuk*2n{٬.+^av@}X ѺҺ\mXDabm@n;Wqu۹R[U֭pRZu+ۿYi Nкμu+h8Һi`֭kMVȬ[YabV8JV8LMVMV.([z֭\>~рu+u+HV8e֭\FnB֭x[֭\Һ )Zin+dX^9[_u+u+_nK۹uEݺnn:Z\Qۭg [vݺnmn[9uRnn hnVn7[n7nrU1n[ح[viݺan[mݢۍ֭Rn[tnn[޷uZnQQ-2x[(u;x[x-*ۺ[tnmM50nqۺuӉ\.DZ{1^֭ۺn_nmumݾmݾۀoom|[|\j^ڥmݾ۷unٺNnݮGn-/6S+nN.[Nn-/wuk#w/vPl-nr[܁ۭ[FnrB8q!n7Dr?-u nҺ툆[;ӭɭgir[ܨ֭Odu;;Yo'w@tr7n[ޭ[nH-Nji.Ӻ]\*ۀ߀+ ۀ߀3"ۀ'wDZ/WDZ/43"u‘qGužqEuB8#Һ}Y/WDZ/3"ۀ-ȸt6r+1gbX'xȰn#OjdXİn#O<>"ú?ܑaFnx;Jv6rL[ǀn8fާfS8ާ暂mun#OaFwŴn#nʹnʹnmxu8߭)n|[7ux'9n#-mZSiFމ{?+uy|Z'^W?3uy|Z'NuY>L\siF8mSiFOO6rӺ,8mSiݾmriFOO6r)n_\Rѭ)n#3[un}iN_e\e\yZ vNvMvNdҭ9Zu{; nmú+{pZS0 ͭ~к2(кխdX}kn[n'紺u;?u;o+|WXrhкv}iӺ<кnѺnӺniҺpvp֦[wu;|RZÍ#Z}u;|'VZ-@ZhayYhк^Ѳu; v6nEnGqK֭n4[j}[Σn}u-n;Ǔܺ۷Du]uۗo /A>ִn[ϴntmU:hvuۇ[n}.[6n{eavqKmP[~moiv_5[mwmTiv_%m/.^|\X-uZWu/afKVMaޫ0кirܻ֭º_֭neu+/[º֭IV˲Jmj_۴º_e֭Pn}[5[nú՟>X~|[|[Ol;F Vy?>ZmO6ӽ-S)ڪj{q5ko/\wf}_(`7>tV }UU| Z1 4qo3w6 W*^[%Ov濹 ;Cɵf&k+RUVr j7/bu3p\놸*Zf*]_ȫ\ˏkkp+/$]kLษS3jsq[uWvkU7 ȺʨaZ7z;Xqj®vӧ+ ʮ2_8xkvkP 3ރkAU.j{tֿw]A W/^eԿ0x_R@-?0%^f\{a l/E^ & leʘRW`NU*UfxVxðѫL~/*d*˽]mO^*c<^Lx` *BW]1wn2\2Ƚʐo`ڰ뵰ꆻw|ux?ԅ7V|mۏ/_w1rswiZGssMzL߽O5wsM߽/O7}7g)FGO⨙LM͹4}uv0f3}7UE"inEחl O7}Q#>;iu]`Q\TO`N-L)$4})0}v;LLLB9Lߵ\*5wM:0}-Cl黸M`h櫙Mis]iCwq^ Y]Cw5q]\s]n] LUl6wV0}S0}g].-\$ӽF00}'g<5(L9Y\"n4}[0}}bsDkqv:^0;k uFM}ShdW; fN|EwrSjMUFO7}}qg+A+ l4My;6kJ 0}vw;z;彰0C0}|yW[Uu($MYOB$L! LwI\J4}K0}G}y猃++L_Q /#Iw\n;)M+m`n^߬(`zo_nۗKV;â۹4M>YO$L_M=}\?׼;R?xFhOr~K#~o筘zmrz?K\|RNe=|>w9?W%HOz.IzsÛ7w7_|f=Nv;rObm^'&nbQemtmay ~ǛW>qMwwYo_o_ӵ6,sgnjݳ2!<-cZmw?[@ M||?C[;~X=>f9wX,\va*XyRzMׇSVn\ׇ?I=op_~sDz˯? NlPGOo WgP=W{]/+oXendstream endobj 357 0 obj << /Filter /FlateDecode /Length 1426 >> stream xXmo6_afoWLkC -Blٓ%dѡߊ`瞻{x<1|H?HqQڟ,{\)ft{M^Uw4"mAV=!XX%ifp7e6cr1e|h5DHcb**ߪS"Ld;툵#zr3.[TuZLѼ̧ubƦhif1hal}ۣ|K^3YV(/l1+Te@;y^U`IAPO eG,f#mQ@i 3-畗ƭeimWMirBg+" a}jRwUMieK[(\*9/\%(:CvM>"w͈ލl9 ޮ#"PBJV E][v!/ֱ&/֟^7ͤYrޤ{ZHG;-ΎLK>[}Y i2xh7ȎhsB RBƜB0k"r#@,|(2 8J pwsZ,VC^̝ΨA.=ňQ/`ʤTUrjͺcӎ!YUs֎^I%ؖ7@:,QXj2zָg3FO29˚v[k=dVgA1D>דكk`6aܞj!,H!m[jN`ؖC!D5sV&\u잜-E6YM:%%Crq}ck(E2wcn)8d*8eB'=tVKG󿌌O׶U{/WhdEWCɡGPf;]>Yʤ黕.ʸ-6TLY_{YM~(19F1nSPgLQi >T`t 20+tpv(qp ]qm3 iWs RTOxK^cVOed[:#Kq͋ $,QqOP0Q$pST:Ld~\%^_HGTorT(=_˚Nh1hcR/mendstream endobj 358 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 359 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-example-design.pdf) /PTEX.InfoDict 130 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 133 0 R >> /ExtGState << >> /Font << /F1 131 0 R /F2 132 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 27369 >> stream x̽M%r7?䀭L IX؀@H(}gFUDu\hak\Y_߿/~K_o?}ov}]O_/o?ҵ_O-Ys?4}j_2ײȢOi~}<&/x:GGW/_ oz_xR&w:Pk_hjXלz]_{{}~N|:~t6ǾD{WzKh7NWJٷ-_qU`qX:ۥCh88/RB\Pccq qqOqxVo^O}w,"_ lIB< b<~`4[A<p@<) \"n_/&7+)ٷvqWxʊSK/Du<`m%+jXbgR8 pB<(^)뛫o<`qq/1y|]Eq/_1O{i)%_fWW`'?;DwWDG`q#8Bxm~o"vk-w-%$bs H@VW\s(V;0A.`=GIjW;ċD.UƕYKQs-]$RDyS (Z~f66jJSs-?$1uBj+ēD7&?@GҠ]B$m4bQ⏤:Pրb*P\^ jcE%W \ol8!V+Z2ʮ"ߑlQ}UC%؉ IԐ1Ps1mԾ!+LX WR~`XF}q6 (N.W&CYu0U-`g\oHnb}q!1n FF}()(NVw'B\xA\xCl !t&S,)v`x9vGv7wGؚ~ZPj? icXqX̵`}? 1^ /؀bk\5_+6tvtof w.-5 &g`CD;/5wo_ꏤ{5X۪] 0k(@ʗۛ8}Cpu^Cb[RT9|(ZW ăWăW;ĝWl\^kֲ#9c6Bm25S'ą߼ FK`N1\s+v`87`_5cT7.pMcfّ辍jZߔ잛ksm5u8&6.Z.x7&s]mn?R#:uH/F#ڀ.H4x5L^Ϋ}MlTsm/΄j?¯0a+F#4'{*j\W'jcۂ|5Qmi icxRyQ˾)藙kn?R߽8 /GUeHFk ̵y{2'37acmJ4Y#5=\7GoTs1ktp@(#ؘ ׹c|T9W u Qg;w㤸*ً+s?[a;wG \7#ksͩ:޲`;`9Ͳq!F wk};QC VCUL.jw5>`׍bc 8Uk6. s]1ݘ!V?1>ycX(Ce\iH閙k2(?@# :cqa`y\0hc(W ąW;D\sܽQQ_%D3l,g\'~s?5Gب=cF\_p\_mif(Z !Vqb bdQT&L@GX0X|Բ`&v՚ aF12כdOs9 q"V,k ?̅k .U:ūD16G!K 3 (pwc"?*nCMQat1C|DU6Ltt`|T}mAuD&1cjHS&:qDdx107lOb6URc\dFκE'f{8Q8:0>Y5`h f ą ND12GU UUR$ӆ>-<\\yJ@[mko\mI3&Buicv b5;Xp`>VƅX=MylԉgA,o,X1-g\2M] qZɝjje:Z1NVawBĉ_%ZftHPE.:z]X!lX_g#{nje1o1> / E1WV웹>QxX}ԕ"]hEXbtZV[0A|.L\PkYtW\ qU#p04+x5kYZ nMtSuCSQ9(@acR:-SPF!)`9//F9)`5ubtW%s_^p^{(Q,ŗew8J@1k(NQ|yqGqK(N^ p#[(.QfˋGqKK(N^ pր#[(.QFˉB8#`v,Q8y1"QܢFq^^ {Dqˋ:9`5s{s@Fa9ax5<pabo9s5qk(Q5?abo9u؛kzsa%s{sqbabo9e#Nw8S%[(.Q؛kN8SC[{sI'qʡGrآFq{0לs5(QzJ-k{siRqաGuآDqb8i#N8;lQ\؛kNt;?%s{i\sa\s¡G\pH(.Q#.8暋>[(暋M?BCZq abovcqaabo0GqbG\tX؛k.G\Zuأ؛k.:Q5zsͥd-k( 78G7\vw؛k.;}*FqboE78Q57N8Q5d89(Q\8E7܂Лkn_qآDqboơ@nqآ؛knq؛kn"r57 9Q\8G7#nrآ؛knr؛kns59Q\8G7#nsآ؛kns؛kns57:Q\8G7ܚ#nktآ؛knt7[:q:Q57: xsͭU%s{?*q|čk{s-?`qk%s{ ?*q|ĭk{sM?oqs%s{-vw-k{sm?}q{%s{Ĥ\3aa9S{$ 8>b\318>bR\3]a1MơG%D7L1q|Ĵ =f‘)?bCo$Fqbou]{{s͔19f2CoEq\3S(Is{stBk0LTt5(f%s{s̈́P1abo0E7Lu5g(.Q؛k:("q8kd׏bTzKmH05JI}I' $'x3:I)ׅM0r_ :r떁_G}2o}@42[C|< Okj܊b)Z:Z:r떁_G}2]k)!ۿ|_/'}C$;E≿뗿/寿/ѧ&UĪHCZ2tbOZVCK?=$HK\1w&m/$bwEakYԙ4{1M]x[ ~o-MMOo-M㨄Kmw+udOԺ?״CZ:\ڛ箚D.^صْņ:yU}磰6>]y]U|. M/|Dtq R@Dwf:EYwe-躯3ʲteu ՓFɺqsgOk0[.+#@eZ5teu 댲]5(ΰQ>(h46ʚ#6Jym%_Dxdŝ3BQ¿e%.}eeM(}e%ݚ6Jmts( FYe,(K6޿n}e!ʒm(+QVռQVߏ."nѓ> ~W뻟%!%a KDX ,蹺U\bZVvs]fd\F(eX=C' =O1t n/_Zs]fR]Ld!&#*Bm까.3z.# |aMIB ` ,/c^Ԙ&H*ˢ/(l}F]I<0j?xQ  f}!/C^Aɤi_!~ZCe5ee4te4ti\&:È-2pU] 9㏄MߍE}2nxf$ާͼԐgҺ,vTnÍjeYڴֳ],}^ @r=ū*,^=W_*dM|o6K}u!n)f6nr si~5b'Aem\eū*.^Ӄ0rn2ՀAXAX¨oYՄޭjʫ0 1 ͼ￸m`yD ۫1XyN,A 뫹Za I넥zC J/cI/c2^ˈdޛq& }?1u'+N GIm?#)r!;Q@)@]G`uZnlOMNv4֝m?,`3⥬yZϳV8N,`Z\Vn7yA$Zd+YU! n3NN@Px^2 a%+{i}!}^i߷G)Mx?(+Yla>O軱'D~6r~?XWllmf{`:ぢ'gG|[a؃(}j;ͮ?z~>îg]lh <z`uk?aְÂ~SfeEٮw~Ok39hVV^}z!MʃܡGPt z?xO@[@`J?7kShe~ -ymFJ M_69?2 %Ů]_гin97uݮW.$$lEKi^1i |v7??YdgU [ekhO\OK!g_ {u=ܡt~_Ӵٞ1?f]Z# /RzW6=g6?uYоً͏u=U- r|^03; *̞z2|cڳb>{W~@[Ȳ6?/0?v?wud2?:OHA^#z0M׃1u6u} '1_$ ϘtYև,±0"zu>۾C7>dCb9_oO ?](||3u'ևx`.\B^ .(+! {_x8mFt诠GyзC_}S#?Gx/>Χ<|EзC_}>p>f7yU?||?|8z8898_9ηzn|?|88_989Χ{n|?|^99xn|9yt?zW\/<:qs;C}\;=CS=Xq=s;C}\׳=C=vqs;C}o9?W\}9?_9ܯs|xUsqr?~gys9n?~9ЗC=ܣ~?ˡO>?gCz|?~Mpvχ>G}q?~?~Y?~^C}o1~eО=ڞۡ>f7{=C{=C_}>0_s7}g}̗G| 0s|E<|ЗC}̇i1s1cz?`>=zˡχ>?z:\}=|eЗC}̧=C_}8|r|uЧC=|{ЗCOFgŷϖOs:'G,9A9a q?}v 'ex2փX96얭L,q?x,q+ƣ`[a76Phz>6BaG(_GK#)dBTݻ#)dxgR$P }OЦ믏бl~}.E9L;)ι}{4Ila)t>BN)>r}6rSٟq<َ`Ov>/?TP  Ğ#xaN0 s]QTI ָϪ { v; \v ܳ ܺї ں -`7:C+z,H>7'eaTq]?`^faœ,pN8 \,x9< ^~g+,@w]:J8.Dm'[2Ol(ma umPl֞-9@1cuiv3L ^r) ^s9 ^tase,#uY ^va^vq^w^x6A2D l/O` l/Ͻ` l/O` lBo xDV,aa ;0La ; ,NA~Nȗf} c>GAv;C!%g30Ao^)?+9u%lZU`:Ew'B1uӣ{q]:s\uv[qwGaMaQTne2u[:T?C[ v~31? CyG~?=1XWsy]E:= gOBPS;ӠnE~rp=d߹bn\(욱}Ԏ{v->잝ňEn{2٠vl;EQB܎v}*$HGG asA!͂dCQYg\D,4QNb3ʛMr(JcrOM@X3b-tbRay4+3~Sߛ(&q+5UD9b&}l e;hrf[T?(7R/?#ٌDjb9r&br';bF5q md푉'骕(R=ʱreZ6Ovj&jayr0eM,^sR|Ǡ )OV.yd%Ol,Βz(Sxh\D96wv<ʭMVudr傪u>n߿rEN3v+~Y{lǽXql׽hߤ%v\ԽӾۉۑۙ/WY "o+ʍo֗w{6lOۻa;rۋ.:У0޻2zr ˃J]WQnOBrnk`;_QNB$ezGcG]?X,t;ք?X|(Q' Oz5&`W- v}77cVNzOտ`>'赽\p<ޟv0k(<_x^q_ ?P%\?V'r-DxߌBw џe3l E2_}&/;>_Gq ;EVPU=*AY@_L_AuY`I>oSPwcO''rd*"x+K 1>vV!\g:%rcȃ3<餫ƓbI`̄ z>h _,,#aǽWnN}ϋ?( i%}3)~HzgSFOgtdUdUlh =s¾Hg62[ҺZb;ieƿ*, $ =oB9#*a̓a9layZ{a!Ok/D7 v7cy(ZX_vZZIV}mԥ RsC%, <}>88jhFajr]rRX/C_z.bپB[SҠ5ߓM-a* o~Jy}~@7_X/YTQfrxCXTm =~?ٱO}~Auk0⥬uS6Y_>fC4r"}|YdP\w26gW+2e _+U#9AO+]oLd•,/Ba8ʋ=WS̾euLZEZZb'r&'/ /R> z؛eOWx|0__y3b+煽zNr"OumUv,r3O{^{y"7F$ 'R~B^%p"?HBb1K?ptʍ<)8*r>3B$ADr'O-p')= %Vwr ? lO 7}^p!O/2W0^+Y8CVy}7}~@L&b_='YhУuTy?j=Ug&9CyᯋO%ІgC0K֝><>$WNs;"k_BȲ>0zm pܯN\+'r=Q;o 2}-`\rC.1LQo?GqJ&} 8X10 ܩA}"?qY&Ҡ=%ǝ0R?x𠾑gw?xܱp>ScDVCr+O:%r?ЗCˎvˊ} z9o8t?"C}6^sF`Axq=ЧCD`axq9gy|v#gЗC}6_8?q}=|lq6r`yۡ>OtG:3C_}>|lq;C}68?v\}9|x;O>?'x/>ps\/}=̇g\}\o}iD׃=Cכ=C׳=pЗC}\=CxN>W;x|?~ q?v?H1ox R R/ROG_)};p?t?~#pzˡχ>cyn|~1]sz?~dq?s=Cus?p|ӡ{{zlqg=Cx·>+Gzˡ)?9t诠oX>~/˗yg6o9r9Ч/Y>qۡ4#_A|*зC_}>)yZ#CW/vˡχ znG3?ˇ};Csz%r?{`ӡ?`>zˡχ>z9r?|b|e0s=CD|m0s=ЧC=0s̗=|}RJ k|Tۧkex\I?7*z Sћ׭7?%yjzwixJLt r-`!+mmŚݼf=p3r8Vmv[ l7Kf܏ P1~"p̸q X>oT[Pp:p(p;Ľ-=,-KRe^VrԳVm o+w/=%enD+wKH9_W^zK-eut-/x[[ ^+wAx?Pgx}TGO(wW~Ewn.V.Vן ޼n%y)VÛ] o`V<׉:/wL龫eZn*vm2wnk ָt[kP]b3k {Zf@w] :oTaR^fT7ô-Ս0mni/Ku3L{[aR݌FV7Ս(mnDioku#J{YQZ݈FV7(mnDi/ku3J{[QQї2J \?TvV.ES#\nSXnS<պMaպMT6U6S;wh]m (nN!+ȿZԣE-&~aWtٻ^7;m m^)^)zݦzݦxu> ?Eu[.z+.(Eu_X]2uF~T30?,C/ut%lbe WM)􏢱Z\H~:]0:SRVXaMqwG{+ߊ_aK\*|*?]` ?\ s7}WO,]7q_SKG'+Iחfׁ5-fEb{+@'(_9Ti$:y$Y6y+51vuR1 t,=YUȮYÊtݔ=Ra%H5w# tM+ݠqDuQωZ]sgb)[72GLXk"L3u?FtMq߀E`fֈꚣ=3K t N&mD 3'堺O5|k|.[4&q;iZˆ]lVXk:e1MlDդYb:q"|o^IOP5cZA Sz|PrWj8Ddd߼=k# su-t ۑ*7eUaϱ (h5`nRcalnN9:3't!UZ=bZqZhچ,.uZՀKAeeG8R1 }ed]!~.;.bEkTPZs%%*q+c8C_ 5[ƪimE >{*fCUE){ىYŨa3أL:Qghުo.{6N:uqbCWr l*&VnYᚍS7o{ݶzl]=*_Z }sTXIf}6\oؾjw5hUZV{hݢeհfb4a7-<ऑ/+4q ƬbءYˊ lVqCϐ\Vn%*m*_z{kј-=єMꅸZLL/ ,ˊO5VZOn iEaZY?*]Ʋv3I 2y"S\F }3eC/`M$[(<C%V6KC%ˈʼ߉ԕ;afУ=7Bq/=MCWN-rG66e>_˗ˊfF}~A/YYzW`*|cpvXgS+(pZ zo#,tp%7yȳG^A5 0p?ZeݯVrӎ*d{Z͵Wn=nENX=n6}~/~ϮU/3BP/ifѧitͶOE?r?]WX}2u3=Q\9F`iJ}_YG+U6_D{p3͸B_6r}6_[¸UzvrP4B\:Z.LT0qfYu~ 4\cYUٽׁCżI-I*m /(m҈bb$+c$2%԰pyxe×V+k8nڲKG_+뢣e#g4,?,+-=J۸&'9j ߳ ^@~= K1O^ZXyZyu'OܖvZݥssگįP.\+sM_`C.TmA ^MYQ._sM+}vV%MŰсKQ Vf NN" y.8fֆ0 fIlĦjb1׍*raH-T%T RI R- חm*Ͻ**T $MIOт(d=3aW\W 9ZIݮ.wcRqb9-XU Ij3L*fБ Nn$P]5`p"JP:.cO6R1HJRLĢbܬ$>b9}$8UG(C!<8wDyoWy5`<(XEqɋ8{-k1Eڽ=GqŻzL^qD~k(NQ|y(cQܢDqy8kmQ\8Eřr7GqŹL^N,GFqŗkq=k(9{<Gqkk(NQ|yyG أFqŗkq=[(Q5B{|5|\c1G7zx-k(kGyQ5xs{sGo1آDqbo1[{sA\cћkLxlQ\8G7ט&C<(,S{s 1E7טVSR?t5K(ac\cbУGT&$=(Q8E7טD&`=(S?´G0Eq)4G0F7ט&=zE-k(NQ52G\L8ؙk.Sz,Q5O=(nQ\ؙk.>ؼ?r\scŗWoGqŹL^\?₾ŭQ\8E9>`<DqˋGܒGq9S xyqqu,Qؙk5wxlQ\8G3`q[\sϒŗ_c5s;s͝^vOcbo cboͣ7Eq\cGc%S{s-`ң7M1<`[5=zsk(NQ5vx<(c=z͵?\-k(NQ56{[=(=z|a5s(=zk{sm?–wa5s(؂FGoDqbQ`,ћk$ZxI?b%s{0>bB\#UƣGHRt<(.Q#$yIG[(N7"ʣ7H5R<(NQRBj\#icboћk2zlQ\D7H|0z z ZG( F25s{ssGHأ؛k$zQ5R=zst]:%lF(Qi>gTmfFK6ZVm@wF^TmuOF^TmD#tuoׁuKuUm&j]5ɪ6uVmwFkj>}==㪍?bjcMz@h hj)j)x6wO=Eu QtK}GQ/Mƿc :?c?]s.] ?.CѯwYG6WVOYGSXYGS( [q_W}~>-E|k}ʏAa~Iʏ۞ʏʏx*?*?x+.o]]S}VXӷ`oiS}Ն>kCN!OP3] ? #ͯ]רp]\tח~_O_j w_K +Z躷= 2h+qo#`5uG ?ԋf -mÜzه?D ]9i~04ѽeYb^CׁzPjR=tn;Zeнu.|| Ţx{sw&k.^C3ÞȐ{ZS7?օJi˟LCtO+ 69>DF5wk(9Tks­́~iSLɯ2%1]eEȺ{SXLW)ġS@HkXu9?V,9~HMT s2Hr#)Zx`r_8*$2TfOmDgս1jUa? ajVL﬚U,Y{j>X1-VXbPPXI:p^^X5KX9lEw)U˴وd檹s FTͬwywe1jXE=j^TTVM/= Vzn:*&ATh~*FSxލn)+778]Q8ߴaM˝V\дkgRF t|eQ[b>BYWC,Meul;_ fJNe[m*K} vm3P'KlN-X|Z M T *Fj[^JSӴ㾟깂Kxjl +Kr]/]STYSuf}겖첇Zݙ겮Պ4r _u1ukA5C.{St.t/p_;UE\*F* gjmfתk f,wq?MDT*؈eB/1OwVM+WΨ~I׭ kڂx@ $ߵj]]$ glR1Kt-zbuEx@E뢁Z7zT Y f匝`R1l{װD0aFV,/(8Hh`- jDe5 }zz|K22Ss=id{ ę2F/bU1z]zG 8æa\߬uC9]55=k:Q/TpQENc麚a#Vs}ɶX®u=ɖ:Pd뾒jUd3]m*F۵D"ƮaXemҵpfIs umFN,5,.]]FWo=v18*F,f 7aT{h."-E=w5t% C%hġbXXb4l0})Sż o]ehƖ8swfAp7/#4EƂY8COx <_14F}ncyZ05_Sm֯f5bÊ.IpqeJj\ ^ĬfWKu]Ej|mP34iVhkVSشNuXZ5SX SlM,hV.HHAp}eHLA%fgZT 6uDLEWSGqsTT UbE'暷\՚.8C^z q$tHTt7IfkT|q$Kmt1S͋LW}v/$q]PzjZ?OqV}3GnC+̙#_D>dHZ&>ԟ-('"(Ç~#3X/ګ bMZ(C,BErCuA7!:T]]/ ;9ņ΂ݐĬSaQ^M=4i#ߔigNLgUkɳlO JtyɩqW):>*Oc9֘:+H'6pnL2hIQ,Α. OYxEEɅĩ2"U :d%^ɥ˹JJmUY`Zj|`JN󉲘k)ՉKΪv.ؙqٮ`ENe(G n*f[rcp|㯀ire4i95o6ٵQJ桘x|aW2U,jJJj0b<1B{t|yЂŗew lnBUoVG22*K)T|gٛS0\²cb=$*AC:b sw('fZS5_Z[Daajh<5@0K H8ny+)dG*.dje79\gn.*۽yZL]a1;)J*UKŰfK_7&|d>Gߤi}l2G$ZzfkQ/=--yYjTeMs#M%+NmHL\㛵 }A}Iy5b-`P3bx[vu{7mX3M)zrt::c9(⚉xZb1Y-Gu ֈIO7\*+pO f VDOo*V"8W^b8 B*X!VwP MĩlWzi!/ a fSP5;UsfU(* fBWbk nQpAG&Y"D-x0="50s}cOs=rb܆(Q\8G_6ocQx_.;$yn/t3bn[ /sbǎ%Y5)+ckd3dX5.o=v ተ lrv8;o7i@pqxIBFaP@g wN3ndrv8.&Á5:\pv89x=A.ᴚrk18\`28l_Pjr&pfpL'zD\s2YNGK&0u{P4溽>P&Bs^j(gaE94%r&D8\Rpv8:GN9;ND8 4mہ$ppx"<\pr8\LJqD s6(ÁJ6(0u۠B6(ga۶!etZ4̤,g4be?j۳4\kKҾ`6sjJkmtSiNIswpr8:LsCJ#(PiuTA!%͵P(0͵u(t$DYaepZX4:'4:?ҡeqZDžakDR\2;\hHDzptHŔGK/X\됚ZܔkS\؝29?q?%bG-2;LsJ#7P)48)`Z0͵L(BIpr8:LJkP4 ?R%“(0G Vet88L 1J#Qf4 lۥ)(rvZv0(f?R!erZ#5R\+`2:?R&%͵<)ak2?R`*0͵B^)4 V .eq8;Vx V1eq89V84%B)4 Ҧ \+ZptZG ,\+̞28Ls~JkSakEQ)8LsC0͵)iANGiTBI0͵L)4JVev89/8V4/%͵(0͵Ҡ(FVr%)鏔FYG鏔FIHsakQ)5Hi}ptHɆ4JT,gi IIJJ#%fRa#R\+Ք8nՐGJ?~[0͵RzwG}oY{Y7rhŔą$G !.:Q!I+H{Dj MPKM&' gMIK}W19>T{9{Ɯ}G·)N~ 1-JkϜ~x9LʃwC3'I.sOXȖBC3'gekΙWܪkoC_0˷?txΙ׳bڛW,ڥ3/fyw؛51'ܶ8-[W÷>k;cN~&k6J6@m1R1]t`F+B]jM0w󡦖/ p۪ ^Sq}׬3GSc=BС`rOCorm7yz_}z2?!+KZL_&ǢI>k1>k1?sXZy>v1^kB2 /z,fY ;˴qk42}fN\ڒꐅMˁE oZʛ,Yy68+ofgMO yM7z).xttIG3nMron2nW/}Y~j؊?wi9 >^:*\z5us|-N5~1P%j'غ8TC4Ƹ$D_ H*5ɇkVLkm;>3Յkmya넕6|.m+?c#Co# ՅymϮ| Zca$p1ojKb|+K%1^q~cMʫWu_F}_.g,\SHK\;68R1*j~Xnoע;/Vȏ<רu|:qu޾7mhE5ڻjto.[T{kQ΢>{ o[DїEMR_j{w^_cZF7~endstream endobj 360 0 obj << /Filter /FlateDecode /Length 2398 >> stream xY[o~ .}6XHRPDtTH~r9JsΜ,(~,3X3i5<_*BxŽ /y}~ӫu>2勗%-Xvyq&.l&d]}sZW*bW6vU_4d^HwL b@H(U;'jfv%XqE^vul{rOm?rhKէٚSʊ15p[~eOZM3_q/6P0oweb~|\) =630Qb K^Ҷ ̈lA^{yvSPkrG/TQNWdMsRaI!DonuB`כvM6/ ?_W}~_vvϑG6 Ҧv_(DamnoS/ ނBqe[5H.o(x3h P/ͨ9n> m,JxX0$"1hw)ix[(q$HS8ύi޿si[Rп3pI8v"-DfA,CuƉ5AR@UzA eHs_'-lK D*DsPR$1uADލJN2\.Y$Z;43ByKNkOhV?%gЫiQE(1 :cGQpU b!|&&DN*91wnus3uy }ӈdB%ɥUۙuShB@G%_/^.Z7y?㺀' ן+ͶxH$ztA{$h.?fVL=\'[P\6!KvxZps"T'D6, ?zR ŀ.nF\t5"+橚J2Q9at=D IV{ن8c^b]nL/ 8<ÞhF:##>(uSTMGR~Z'56&_!0aqY:ٱV,Aa`ĕ۱8g5[j1p ZyKDğ+\Q3+ i*t[AQA3D.Ҙ .Nhƍ[̅es3S7@EskWe_%S"J% D$ txjrF殫 ÿ2Lx0k m9a斻j{ظisqT~a+~<7e^,8gzOI.4/d;ׁO`@xƤ.[ɟdNNM4E}BFv4rB{?(&@PQDos,_mqGC}Ua>cc.=qL'apRj(fqHfCry{'\ewsWH$n(l#qvoV_C~Ԇc4'ȚN"Qu*5Q\ڵi!1Q0 'F =RʄB'왡ʌ dl{޹PIL%Ȅ;\w7Ƌ&V({x^K(CsK8=*NAIc~Jo'L.3aYim@&w ['f.8؊vP|[7)GfO8T"$yEvD8eOa+he< ~:k!NN>?o̠Tn?ZH>H%8%'=&ӥqvp1+wbp>L߸?0'/"O9 v5TR<\SsM4 C?ׇ&SO;c>2$EoA~Lb:S!73]i},8LxS}A` gT ǭtѴa )XN7A8,endstream endobj 361 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 362 0 obj << /Filter /FlateDecode /Length 1366 >> stream xڵXKs6W(N:&B|v؇δIlԴd!!!?&])vz oXԝxAOI$&q(ɟ<b5L5NqPp"K F5"i4=oC8t^2BB*ݲ%oWͿc"zw60kϽ-(YR*MxA]OLN ½(g͆%.R?N2lN,aiHvL0qK0?ɫaXbDVκ5o\ ;0Z}v(}/0++M}Q>S @gb;NW"H!cjJzhc=Hos̞{-F3|/<ND@٩IO4H `)C3$D,HQ\1`ABw> ˜i㘒F :=8&jeE?Y觋E%_ ?o7"nmZp7!C +$pV! &Ib q?Gcendstream endobj 363 0 obj << /Filter /FlateDecode /Length 1537 >> stream xXM60*kԷmHEO{. Z5%MwC*#; R$gHμy3/~XlvPQ.&r֭VG;pp[|VRim%k;D(U]2yŵm+U5hn+ UU͙[jS@}BiKx1"u+ ?^`.I94ݾ?Z BPv`agM( g5#IMcOkWanv5 vh64u+vuJ-4YDL}XװA#{A}\,`3j }6֦m%uE.Cǧ.h;}p(d {CҶ1m` f>to9Y, :E? +aTd{6پ9+]*Qc=qH&8j1<-Š.),Ls09Hw/зz%$\ahpkKnMƜ-4c H=*6ws.{JwR[\ew8JavP;J5 -A(Ch6X![#QROY0c~*l1Ǫk@ q[JB&𤬜;QUɄyܑz A8 T" ,2_@vk~^%XREoꔘ,ڞfH hZJQWBθ{sH@4Xzt~<}sQ.?G,qշ(C/*~{59zLtWE[Ky5+8=QBs,q+x //޾+.o0ƓuwK7꿺y=nYrm٧6;Hx~Zy &q|vs/z\endstream endobj 364 0 obj << /Filter /FlateDecode /Length 4057 >> stream xZIϯK50Y+6|HIgqw`p$v!h$TW|ܕʳ2/Ug(2onWmn妯qvsivߜvh:a}uu0z낚zk| ]0ڹʼn'}ŭKh)f%pHU~U&s]o7oTs ,w4Ѯޟ|اccacl(C|e%UB.-X=<s5 lʖ[3+= sj!cu[(y|6',6q&t(>> ct-:hMaì{ďb iB|º si WUA ]uQDYx]\sy%)w1 z4k"0pxZ)u{۝ϳ>ODeXԅR$= c5ի#79q6>'Uc7rExX\܌sq+>" <0-K|(>̺F?PJq(z%AgNO2}nLJ3|测^rkV*4ʦQ*ePHd&A`[Iaf lvOvOm+X2W4@H}4k YmP2s7}wiEVnˑ27~0~jсWe576mZ@AL[ ܂)Hh5Lx re jЀƠDWuc3H\#55HSt6-Iȶzd]ZbR3<']8D:DW\̅eѐjQ\> I(mdҞA[j2{%QE¤'% uIi;hA}-l <ϧz<אqw_e"ubˡlI׳cy&MC-+0jgt.s]ߝd;pJ0Y(g%̌X%L~!/ICv)v]\#Nny˜nҼx0)g!qd>2ÂQ}=S&LxE4=9RkWdQpu/3~5&t:N'7.IZ:lIѱqvS߽n/}慂J]YD` pӋ~ȯ"3PH]OW&W7/w\-dtr0Qcseߴ) SA͎)=P=fe7=OОf"qO r=ٛ7Ĭ1:o=X舯 D }$i$Rg%֐5EEP1yK A<|ipa BX t>4s|;R:ɠ x O&g'(lmT30xio4 yVʬZT̃7jwzG2+tU^j*4/fA@0TF- U6H4͢@C\E۬pJfɔE$"/ARph$ Oɻ 8*C N;]>JNV$ZـF&܀(=dcs Y iN~\wCԫ/ ?m?m~7|p,֞^EE忑9}jїi3S.n+=WV2WaÎvs{y9G0rX-ĵ0] sjJĜ!dQ{B,raǑm\2? c.b7ps#z(<} FCLEMKq2LfQ.M,vru*Px}%O%5@8jJ "hvyreeiϒEdzÓ,J˔V+f&vǖu("]9`8Sl&lLR"=Tk~$y2D'V%ЌU"Q 6P.RlfЩZEmգRE΁DlHdU d e:o,z ,%'jD.@l#0+Ijy2 yhcαRۆ|0JE}-&LLтb.@|(WZS_i8,윝o\03͠_'oO`R }jD?(l7"` p_Ap)ɼ>DZKlYȺE%zL>BC7y~.Êxmy\(lźGs 8cBw8tCJ\  Y&=ȑ.63~8{8//tq͜lbVΝkx3ńa+}=4:K9qB/ܘǤ@40[R }IvĴ 칗1F Փ siKh…}PKfH7A] |h,L8Gi=W~==แYߒbW_ja4ݼ/-Zʑ+%~3t-Q"/~;x M/oB^( B%r}LED 04a4}ezf~~YWVNY ~xnui,P e.銑z KO,W+,`򋼤wjZ̺d(ڗSΓ22C< p߼r@N%рq6(?u(,m >H SLegBzH$Gp:^)͹yܯ2  t }"hX)낧 )ܭNGX -.8N Hq*u?& ;LJ=L;装!R 0Nz6ld0TJL[-zI4_j$LW|l|{E"i(cCWy~WzVd5@n`~ߴ$zeEN 11zZCdr!saB[Z뗲-ΊBy>q,t'wA}3Ŝbt. pJeP{i2y ck1Ck?OӸ7\D=`6{9mf0 '}q X'OƬ8 ti(c1U9"t얇.v~ $0\^7Φv, ✲NwǢt,dmA^Ho;;ٴ,DZyn_^ӦA #"TyU!$V\(>U12Wt]VTT5RDETW5q'3/;=%U;=MG4YuH:$|d*BC5]'bo:z^2H=Vq"gYɧhtB>Lħ⚜VIiX3}aYb }W2=sK[ѩ/endstream endobj 365 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-meanscale.pdf) /PTEX.InfoDict 143 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 150 0 R >> /ExtGState << /GS1 146 0 R /GS2 147 0 R /GS257 148 0 R /GS258 149 0 R >> /Font << /F2 144 0 R /F6 145 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 10066 >> stream x]K$qϯtp *\)v(Žה-Ŭ$re"w3{,gYS?~uS?MW?GM]>G ߴGАFsu/H یHKD㯏x#gW|͕ H *:_?\Fu;M2s fCf=[u+圶_-_#p?io~gc6.dVH*~!_/iӯp~եo/psso̬*@, M0xYehgx#'nΆ╺6ҹgC+GǦ+J};xԊF UidVH*U"/p=:+uwzMNQԟk<-tYh~6<4bf~ixcRVs6j#` >vi:(i3#O|UrV0ZfV6%ވo>woYB,_Jx5ha0œT@X/^f!Ǐ9OR]Yvkx_ѳgid֣T+Q4!7K5V/ZzE񮎭'L>K/nb&#!Y yg:V?bݒ~|lf5OmK_~@rr{AI՗L'++@.* /V&;:6u3etYT[:`~˪Rbݾ2e GnF ^5rCcePNPWN,|/4u"VΊƺr7J/ߪgMI7"}!Y{AdLyţkUSix\*kuţ@7DsjeTx#r׵6k$5N0g$Z/Ez)_7[oXWEQ^G_ƖG9V>vq#] HKVjoУ`*7^irԦڋx G_el}[[x S{ a8"!9MC7> BZuBR oD6F:M=x) ح!U 94kl;[o=I{"}]\Gf^{ah4s1>7Bh5& ĺ%7~)i3oInF:/, H^/+wZ:dX++SU+/zבZ?cvA=C"Y }hױSz:+ҭmo5^r2ljHo' 84 |).'ţgIxXmTYv<-.,\;qeX/0fC|iJ˦ ϧ{:qx4)5R:(z C{hd:_fb7kwsNPq5 oѳɕci}o@fA@oY2ZDv e42TZݮgWtAڧj7$T(Sʿ^>ޣ@ tiïL3+4}g}L.lt*FiL9*$iBMd N5 c@nmj[]GE2.ٖ 9f3 `4^'V!9O㥄F*Tt4 ;7yXczv+kPeGk Yб>/sUt&Ħs<:bl8SS?R^iFڀMٷ ^&px<󰄃eY9clgri^&>>tyrNK}JuFٔ0l;+B$&$ڄn[55W o_c?r/ SdVN$Jj0r upL[dXTP^fN1ܱcޖ@mބ&1_d ҈ D3?:/W `q'q5&G: m_LZf2-P56o_e؍Y6i=7V.a<8 F'=$MelrfkZVmJ*9g}ŚiPMu:bSGkk;U@VUOԦZj=z=%G_3h7ʏ?ѨTcR pMeoTz`}:mbԘhYrx?y%AVY Q)}yb/#lM!FӫBiW MY$>Q9:)G"ZLn{!}ĨUbM-X<}',^Wr)(>V_FD>ԥT+_+WYBԒRqk&-=)hJXH+K)`{}+4[֢ӢڔTx#r׻h4c6': |W=AS}rX&Бa09yAkTDx99yL=e")#F<y ADe_dlTAwf 7HZe&:Xh_t&ya%l!:>&#ʫ"*756Nj-Ih˯:hb۪ko|STKċQ=L@G7OA^H˯.ʲgGT?]C>)C{!_CpcO:xQ4^<tOvbwnddW M5ݔScJyVNJ:ȩ#XͽF"}VL?#3xǙx0ŷMnT\;_X<ɶNWN ̓JWy.np!v2OU!NUØ)ହ]QBw.xNH3J2Ɍ9-ٰy}q7(P8VBNQOi1VozjP20s9S]`#cKs%)!v4Pnwf, `@i9f4 ͡4 $I7ۋ st&}$>#oYZ.= jTtыjF0F0Tɡ 2Du%-afi;{Fۣt}+8G2Wl~WlӪub"uioG,k8ʗF_^le1;]E+4] 0\9@KiIj牛L{Q!xڠ/ΆKۨQn+ΊV,΃Qgu&g˖xDl FѮڸo< b[xI-32)|;9ȅ;w-?0x d8H6'nƖ]_7*TF2v ~2R%Q<'y1w%#@V_20,?mLwVٖtKd~iSG&reTK|둨tEdCY+LIpjl2- ߗe6gFCY\W^W˪R*jJ"_*zT*j]5 cJ&{zY؎*ߴnimuomn6cc;kE5lK%+!n+U?^sruKR3k ~k .^#jiKYLϝ\ l*rȟ\h싪,PҀKCStkInؖtKd~<< z/LljV0qS\Y-7|Y齥$|>&RHWOE<2cp27P/ _VM,Pչ~]@ʹCl"]كkʌ4{e,^Hǫet)S~ D><ԉ>,a_"{{mu>xk,ux/kSE;h<:-s~5=,0˪Q7C>޶ه_YnSf}qcm~/γֳK55[V֨KHz0d ]Ϻ]9Ksg\Al/~RibYEN! J9ޮk @+$:!T C3ÅkLDQ ٕR4&+Bɥ#P-եY-D9- ؆;Q];0hގW.{QGdv`bW#Ÿ:^-fcm; F4Vj<+JVB)N J-Txzo2HY\-)WKTkgõޒ'o|)iƇ-cL7#9ޮ"- ΂~dx־1BDT j菎G.#@_[`!siAD>V,; sla+v'kv o|(AusT4ȡ2ϕs]Ǎ.O2 [(_aZ34BVY|\sRά%ƇZJ2dQ0v(_Ce=۽e ._X!(2 ip{;ρ|oȔt-0V!U R}f-j!ri!L5Rx,SbBZ|~T^ޢP䞯Cf!J|Eo:/Oj(O<_M>ѲN'DNKQ3EBpw:/E^߶_ke/o{:u훩o8a5 9'[c+qb/s_n,y~U~8ʾMt9 ({v.pnN'x{[w:kTﶲ}Yv麲_|ƍ6h:2!_U?+'l3I-ix5u&FI1WXoMtfC'Z)ެώ{qZƫIü3Y~'{ܾWhmWd5S=BĜ:kŽTvo.'vVv_v;6{èx7O7~KruU{_Ø n#. zpfA z}pSqQ/x;#]##}FGG =m5Z=oQd\wuu+<;Ao#.:Kw>2`|,6{xأDc!uoo#ma<-ߧX.~;b1 }D)Vpߜn2M֐R_o&9!xHAq'3tvv4\Gf@waŻ{']qxwqUT$etw_y87r]cwmQ?OR oұx.l06ӆ;kҊ]Qh7-%[U~&ݛ{(x=U"X~FE8rzY;l@G *1AZtKd~~eY{|oh: :ڱ+&x/Xu 7[ {-pǵqm~ .t L(רޙ5(X6d߇-_@YoWI±M,'Xgg_,ڔ#is]=cY VGoS o6,cZ:dڿWX3A_w-;|yc.ƽޒobj:Kysޫdܒ2ow.G7 6/l#F1j*/GDNAӠCUzV"B&T;_e4dg` ;2mu9ĺ])i*˷LVŲG4+(7eʵBX/1LwRNױNF;-s'I?Q: oұĝR%oijܢ ڎ e2k;:؀<6syn1pUnύvܨHFynoұsw,}1,}<CI?}yK-$U;<:^qIRwv1X#'HpP: Q9l>)Sc MSiF 8w Îr"#%&|t¦s_EL-ɗ P(| E5pIw6iivd9 43snN7[oG9|3N2]9Sx2ͯͿWO_} cI/7c<}~Fȟ];=NRϞo~oޱ.v۹~6xݟ7B$l6}=vx;]_ pB|1yo?~r<^^Uw;_d?H%=*$}~ 1*Iߢ{AO;< Z<Ƽ=%]xB,bIbT0s0snNñ5yx_P%䇬9,ӖL=č/??#[=N?7V'2ֻ^AB,R~tMOKG?:8:Xݦ2,L䍃Ē5Ba1?g |w߹x_ӯ~Z1׋ k {PkAn_HX\.t2H熚NtvmSO0nίӨ*_AzP>T!X1w]xAHjL6)Hr6ҫ~ ?<}pph7P7;+_K@=QNto\tn`ڌ9 aLwӯm!\gׂ1u=K ovk7t~ux)L3A#rF;K,PK1 Y>_6QXmï+cUw@b8^#dk3lk#lAƴ4 4]Xen.cZd&; `;WBuZpy@5;WZhiPUhgh:iihDMVYIK_ifԡTWʾ见}h ٜ(DH, kV]؋ڽX lͅ~Ҿ~E5n!o](zG B^w1JwQ u + z"jVcz$GMyiGm\ZtQ[$E..D.ډ Dcy2XA'z ?)ݘl,FD2t>CK ԯזbXݟYD["0YFe٢@/kOoSrDk/k4~AMlG+.*G]^%\ u%6pӇa­ɗ6(v} ek_a$^ztTbUuii?Uճ6܃s1@+XbnOOiߤendstream endobj 366 0 obj << /Filter /FlateDecode /Length 2334 >> stream xڕY}~_hV$ElX4)}hi%9;]e6H1>jڔYZ&TM=,k5_;9x}g6j+8W|zxIٍ:i?.lZiW.=nu%6W&5= {$@n|Ln~5' ac t<e7 R7:?nIm^3yr=2v{N"@v ?,)L*iG]%G}&fKHk#{5*ӼVdMD 5s~7tL|FGR֨V&IEuC84%4iOãѠPS F%`_pg::f)-UF [bu>GЅ[ 3 | w3Qǁr pqF=:+ UWxs|1N`zE.:'*1zGug@pOc 1a_*f2uIkXeihѪMeF2ia 5V kJL:BL Ղ^R:=[V90GsHb:IQUG^1K:5Y!4߯uZRingj߂4?[><14sB8t"ez$@$_9zy V.t=h_{&Gu뉈€ߣ1tW,V}d|7{+@) wyOecms@^, !p_Wiqug,Y5:=Q%l.<S./7YQM6M}ϸ7ҿn/F21;2Md8JUu7.qٺs~nsxlvqlxy{ Pq;^$OKufla/ԕ ?#gPendstream endobj 367 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 368 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-sdscale-1.pdf) /PTEX.InfoDict 154 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 161 0 R >> /ExtGState << /GS1 157 0 R /GS2 158 0 R /GS257 159 0 R /GS258 160 0 R >> /Font << /F2 155 0 R /F6 156 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 14467 >> stream x}ɒdInؽ"9/צFѴmƃD $Dz8KM/"2jCe 8o/?]S1?w|sOq= ^ASx?￿?}]~)bq_Q7*`.$%%^?) ~:,iST2PfhϟO- [yaUeB{aBOv/MWBOuH |f0T*{:| it{aFY7zyͽA{c,n=ڍ`W 5Tp/^᩺"Zı""$ u^eLq87fxJs-4i)ԫZGj1&qu\ ژS[]0SUyVMBZ{ i)WBRhO=B|E iqS&sI O`xoSJ3́-o|pee){mk* T=@(_?4x*^~M5ٽ _k߉Izg״勵վL3'GlƟ3k"4\3x}c0awRz>PGL +g Vgc)<\=w]=>ޅHzzh q$YU)hyA^[$_MfH_v/6.ԩ2ߢFCZhl|}q<i9< 2J9 |j<3 e}=~Ճ3}tP=XZ]y @j)ص+JrWn.A"rUBe_F֦zkUz?z*t WW=Q:GJcY󲾨ޕ;+l߬nzo{+c8^Lrr.z.jd0h&:l0.Q<-!c= 2-,*[*ii|r{1Mg7Deh] u7k$,HiSy0Vk.R+n Yc;-c "\WL²4De)U{1~䫷YK.jk 1*t WW U$\pc,KCt^sZ$cM{<7]|t}e{{^e=7d'=Een6< Z'czg,o7S<`Fb:خJ$HeJszzWocxzW/c^Qs,3mnKOk2XZV=ª\]zkzV]֓LkϵK'1ӪuLZ;i+F ~ › z<Ŵ^n^GlrbI4b + *뢴 C]aduM!2x*SHnOO5L~M~e<2#OXR_'Xp_,zl53O#^fm?/ ?_s {.Ѩ#ar_;Rĵ+!ńgrZBL3|^p=t\[qZ9-Z;{nah#% t;Ru]~- J'o4ƾSJ ejzJ >A}U4s\&hlGj*rYh KpV%c xh:Z N$sgAM lttz?V^% *˩3A9 :Ke;?~TcGOyxxz/R>ܘOVag GA\@vZ 5`[bӔ}-Ŧ)e6Y~܃GMlif&p ƪ4:[POIW-*^$x-ȓ4o# ͕N%]2`;cv a 6q› uCقgrS]$R$2h !, aYJc]yn 5d3> 2*>?`C{;D0hxeZɓ ^J΁1.;ūT,Bק'vƲ1eV؃` j"\ )*^tqHո 0Xt=!&ȝR*wL>unϝFg\L妺:Hs m'gNJ,'RU伊|Et WΕVx W9aYFNyЯSGNmJӯ8ZATj*_Mevʆb+\z oܶoE[=mVVon۷b-%[K` }+)9UVM޾o/ܷb4}9x1oE[.@~b< JWX+kj P @/UK}[b+ ]p r*e6YwU`yU1AE"lr *4ኀWPei˺rbXv?R)/>aY@Se&~VɰF aRGe"!ocρk@B+ZU_s~ePrMqMQ/a%ޗESqLk9J$\&²4TGeoct:i-P++Cl=!*i(qs:$<\QU?&R6ᝮwT9HO~fsIeCt mYeXJ,[')-reaG{D%P<iO \ƈvmAQ M&zB7MD (T +~ |@([\$'-dIzp:pF KAU'Jq&<2 }ANCk&|9ӽ t$`_xN{ZZ@ [IUwi7 4ԘGD+EX[DHMB|qU8M*q$L_(N+ <rg7K#UV2kES};\mJ}=~]ɍTNB~\NsQ}S 2),d"*=M +*owG~s\?Nz=z*kAW=B(hE8L$n bS}>ZoÇOF*a23$P]8ł$pkεpY$cow0'-zpojLZ1&{dd^-r2$PW~*+EF_9Z1/K~E gLosY#-=|X& 5ѶKoPjA bj8h|wŊuU {2עjκ-XBG@2c5=p/tm5ޚd,ItN-<tDX݃=`s*5  LG@!_2.pM.e2a:'=QEWiBtrPX LC@atb&AHqXGOKjqOSbՈq(5og5"{Ӡbc~Y\HqT29q'q_mѧq/xXBG Ȣ @hIaEILqKN7'NW/|d'#Wx̹<*g~`47|_ásTj~:'a_1"N7z(7pgPoyt N:Wp9b(y_{ٷn 9+7>/|uwnp0\)~;̥, ,&šE f]i=ilnAtx޵˭2yZ Aۭ'kQm555´uUN HTJS)xz{2#pfrƉژW23u懿J!@4NMA׈;3xf;T3N๚TA`lZyWjƉ".aoSىjhH&J+5bīVM-D " cEﵺ˺-L8B¤j5w&bD%~na$[/H]ZnA nf+iOYN6`, c7҅#!ˬrQ봰˺iJ#(ܠ<;[[N4oH&[lûEl;IJOt&K'Յy/J ^ fq~9ټᾅdsR$Mzqm Io#oXz~C.! n Kp#oHy20첤տaؿ2t. 7r[BtXboji?Is#ginFnyn It#oXyC2&h !%. 5˪İo)!ؿ7{eT@mZA{ .7BA<(]RzzˁZkt !Օ:*-wOR^2<-&^KWR8 wpɭ1Qկǭ[u{{yo'k{Z^+riWVCwT_{B1GJxS=(Υ&}8n>q4/[=>5nDHivTHzPVy긱Jioy 7Vǭq#40+`+~ue|f(͠09H/j=Riq*RjĽW_7y菹#Ѽ)}? )Ha3x7L>(< 2 [>çȕwtP0ov=0쪾aomUmu3It<]1h8)WMYEg']ӧO#x7LOSme|J߈\|UN!Z&T&O)ѡXKRiTcQde u"c烚=! d'нQ!fx2#]D ,'/J`_hلv\l>uo+4Է6t^)*x TVd^h1}Nye^"Mc]g׋M;'x-^/mOi0>ʕ`AMnpT2mA.rݑMxo)~}+?1|5uaW|]guV\]u5c]hu-ו\]KuM \&EO -@d#ɕa< ´ 1^$0(m Ne^"Mnҳ?ֳBi9mu,Eyu<>eH<>0Mw[l‹\D}NϺ^䴌¬vG:گcoL-=ל}|W[O|u5I#(._irT2´ZIi3wkl»ڍk-s<5d߯!Z}/zm0%>L&rӳ)EnS>%37b`~BgD JhR}h͘aExgԲr1׳?X2Mӄ\^ä"OӜ".B[r¹׵ENJ{fղpzVڧciyBs1-C]J]CM 2\6uqz9gu}E u5T א|=_]S9kj_ajZڱ_oK I=;=K$;ts ;Ad<@V.-fQZL+5OT.f= =40V5J`,$ _W ir>i07BDB]zڇc\B=ץM\rWkW_u߯~kOYiXWVWDZZV}][?uI:+GX'm>gfbn:dEHy3'UT՚Me1y> hk٤}AG.Y*{`޼0a~,H Ri G- BkRnh P1ѡW\|Y۵RNN7dh xSj r~Ht>6nzO yqY) #ʓs3vy~SjHF$V?Bs}0l2O{^&r2|οumom+yJ}mp{Š)Ť50)Lq܎+V8Vx |.匔\쬇E~^ǽ__[\Tc<{y^Mȕy]dgX( ;kh:W5[(  jŬ[kٌgv.ГWMO⡧uz=eڔ4{ O|l›!䦺h&Y' 5P g⒬e0NkPr&Y'(]h)$R9bi/YIGD&яUkhgYV7EBKM.e bZ/7 Ů4xFyF1ٻӥ_gOū:HsoLh9U9Mxh7_S=~a,GI PS 0:H˪i]yk"v-,z:Y;oj1<ɪeU'#^t:NNRN.娓oZ8\>i54[i7㣤B -%^ޖ]ʦ'*ru&f/ &WSϙ,1{`xJhd}٬OPKقׯM_|_83/*K y/5K AEFq$}v L_0 fZwߗ%%GE 1]qvj tm 1_tLկ$F`k*-]5_xh7zLs;}͓;{r ^TvP1?MpH#3^}l‹\D}&pw>ݼHڝAiFV54߃4vtk' ϵ#M p{ɖ]`dL3;QoR]癪k4"ƳbZjcx5xӯ AijwV%KkTty.")5H|>-&qWޚ]fAG4o%yw7dz$ӻk3߸gmV{d{,;%;-;%;-߻4$|,Ỽ! ]M<,a/_^  r!+%i߹N]M2KYwSƵ\\(7`r/Ƚ_kD-6[ rk!pݿP+YPpZzO ,͊r E^(H .,.9}՞\z!^@p2O^ Tϵw\=nb#P/ԑt=L8،?r{$/Wb@o"P/ɂ(ݙ/ ={g%MoM] j۞˞ 67̠aWw!H6*:w\EnTUMҟp-3$PW<QuRauk0|p'ClL@.A(X`,KCt^S'eҮz9rcoW=FNzR (r<ȸPcѶ5S$,KCt^ֻȕ7=@ug,~ $A Ep(\$2 uZm2\A5  V]W%ObZd,7\oHv 5ou`Dz ;.z`Isnm|⟾b#{V]Opl~v^2] At|E\Xes.su#A#Q`lH pWtJah; []ԤK2Lށ%E~BjE^7^ sa 7/{E̛n2~H7?^n;=Ԕa[+jO3҈ )6&rbx O&+AKEt+cߛZ޶ܫk8HBoAFΒFjl4mŔvힶӏ- b| }HP|}'B^^?FZB&m;i#Bv?mpPm]šRxHiҘjt%K1d1cmE?opm;BG@g7 R-6ƬykDm qN6.J1BxMW'𗝵 Y Y[?'mߣT{x{0'# 3N:~kP{H|t`^B~#hOֲ)Է'XvmYy'ti(!/&;Ŧi!* )0g*U(yGt w3>䱵jCnlR9p / ![HgW, }se#Όn|+!%e232׈QgU `r>8Ŧ7w?ܑd+P×,: 8|тWG*] Wendstream endobj 369 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-sdscale-all.pdf) /PTEX.InfoDict 163 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 172 0 R >> /ExtGState << /GS1 166 0 R /GS2 167 0 R /GS257 169 0 R /GS258 170 0 R /GS259 171 0 R /GS3 168 0 R >> /Font << /F2 164 0 R /F6 165 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 93793 >> stream xܽɎ%ɒh/mբHW~(\o},z=_DT"#]To/__/5Xߏx&dGxyė;#Bv>\Xk/q6~oZڔ^X2 a+)ouƗ#ӏ)h~@Aίq m~Pk?@z\ވL ^{W>C\yHE /Yi YzҦlRzi:HCH2Z)3;& /8_ -g)W&>_S^A8IT^Y3Ձ8˳S^MJS,9ڂˤ I&kl&[29Pxs}cLIo"ɵik¶$p6S, $l!Wo^-h޼&S]JLi WwZ3#QH:J[Bh( B5>DB}e HOF?HRWLުP0kv59~$٣_*Cs#o/-)Nj, O{H!O)7âE;=Ų&n5wV~rWHzGsiy+sZs h C!A.u_ 9O5!1fk447rޛ[p9C[z 9=6ï&57gnof ~UzDZL[: ͬ;Z07c]_]ͽfs֗ZlSw7zV}F;V{Ctϣ?<꼲d̝y6ŵIzSa$RSRZuxu^n~sY*xQ730u@?<꼲)mu}ߐ+8j;m]qC;t6q~nf94"஝ε\:k܇9O5(gm3/m XjK*^Ά$LRPj9P`HA9k3I؉G.xȥN,Wש8k¶r9S!ע44wP;Kti :bUcx!m Wxu^9AѯmԚ*fJm[՚_l5t2١L L]=x[KuKm&QFka)f a G\Y.9Y?l 7r6aìS85(gmsm\-mF4{ʹGѴ܈{'(q1UJ \,,jV[\e_r¯,QReUt'Yy"Yk7ur}B2)4X|ؔZomC),"K6e]NV%l_=]B&>E{-~zӮ5vyoWKl۵׽]3]guvۮov9u'ݖGnE#2Wit:)OȵtV'wN`L?@Ym[0~ 4>_u}LAYпE-qQϣ M@_Ȭ:?aY+Ղ0˓d/>]ɏzsHchHNl Αo?^20^\2s7˄3H;:YJʰ1s!8_Mc>2Υ3WFjsG"QDZtn3IǬǴ+1Ցl1\k k0#Y~O|OccNY΄>/?O۟=PuPMm)eZ.biwj 6D뵹'.ė9x t6={@!_Bw6fӢ(q# N8R2c _+a f9"ēuq$kOd Y[K}&D"mIl*-r$Gh5k}H!HA9kc m\\uś1㾘\KrҔkkra[`{[8ND>UUa(Hag>Q Va&uЭy紇*u*PH>l U5H"xc+ 廙T?*TC9&gc+A.6ڞFgr9'Zn.Wiv$U{ y.6Z/.imoEmo{ޭY Zo &O!A_jL-B#x[U~S9'(E2O橸!Ar%҉|:ӹ"NNϺx@ ׺M&ƻ_8I$YZ.ANHzF[ψ k/;3-u^5\U;VV:Y#+{xY;sg^S*Ot]i iU?<꼲>~ђII_*M2^ë^Ω  cnhv51&.-KP>*jLe.+KxͿ:[t]MfsZXrlިpȕP X,rMm++ѽwS6RZB1-Gr+-iԶKô\ZlQzߦCOL)I_HM~ PpӡmţSU|@_c'HM6!\9I6_6([VcYX(m˚:+ٴQDwSɛdZoېLL)b'[=2²Dn[dZ$o]$ko}rc ipKJ_hd.CMjS^RR P"m9bLrR;at&mFoZa/?b+>^/iYfXtKkʺqu )K #u)1tLJ;aɽԘ!ql=V[lNű4>6y-7ˤ#mmNmmMwql86&Fzs-{=.6&FJח;5N)#~u 3\d?VRvYMv_,6OOiw?n:t>O۟}߆kB`30 k_kyf]/jAf%wf_rmJ|dN2|p U I.n_Q̅,GDc"N됎**Gl'$5 l/mD5!J+!{ \*Zm 95MZ0䜭FfZozݶ޴7z֋մ^[jZoVo-Խ!G8,^g \z„Ia[!baoay*uJ0M&Bҳ2yeW5" KB>\T?w*TwA}1Yq1?&t'O|<1jkyH[9;\ǰWj_ ,#uFKstf;^<w":ޛ("$фglc{x:Cq73^X'& 鲵\魘㽙~~Lh[v=k8M IV~gp75kjߥ3$wIج޺[1v>53juݬZW=YR%WwO>d #@Z *g ^ë^d~'c p]{ϡ y+{x-YlV* kQ?<꼲s_1ť pL\Z}TӼ7H.v_ݵ%ftmH`@ي-_] +L.\^$[8RPNm@Bk^i r;)Z53MktqҸz@?K|?E*d 0ؕ7\߯>l@ZTQ~O- h X'ҚG'wm:^_2ƑX4X0UBQO&s(s9 msȃ|.߿2d2d-Ch7eFO!s=tؘKǤ ǓuFXgO7;q|3 ׀`>|#{d`D_zH1Ko{NVz-}0s Y{ 3OpԗĎ}%óNmoTb~kc+18ZuŌBϯ>R|.~1}9PRKU~1sj#s}4֎H֚s,at/MɣhսYG <4X fql86&߆XPDwNDZtn-L FF&eז 8΃Gdz$ Ovm2e1lJz#jv=u7zpJE`-+. +y"Yk-]/mwp);jvYhr{q%%@sbavAza$kwZT[w<|eK7-_#bp'NI{Ҋğh A9k+ateτX$p|NgJQ81\*x$wQX+xEkHz[jdma[o7l zqݴ^l륽mmMW]RrY}5@O \VX,+DDQQH-HiΐB82R =AzRhT CH !?&;/kPDj7 ,~&oU(O= W^LV_qu&,> \+?jt-x\mʿWiMI;}=CDn$S- ۧ+ ;OfG#BՁ /ZDeTs[p#M%Kﶖ|+g余>'>92;SP}ޝ7uiYG0 p`VoS:Yfn[wl]%g f61V >5>sZwi>+uW:F ɇۣ/ďKFS4]{!kO|?:ew2μn >c ؔ'K^ë^",7Wy7uTg[foV7u=JirTv\ڍ!-K#"06~r^l~݄MˋmWg+,PZiFٍP7BlHmF6v-!$L+lR5Aemǜ[\iMC.Bwyu]=q]^fc䬭C`>' $1b>'Ix\(م9ᙢb>/}m_5[f5[vQFxvS@ϊGX+rGo--g9xXZ\) rGtSjD{>-pfXD p1"waXp7>bbB4?FLA"0?hLr(܃"-9aGU"*5kǨI`Xq =11Hvë?F|mlo^s8ّo9ңf q,"7E֩ƒ("w`p?(^\=`Vy5;ﲙq5Έق;=~.mk_A/*MSjݻ^tNu/'c]eo{&V>-bw ŵh%PDvƥ3R|[ޜvrR0Է[^W0μ}JZ `KԼ*<ë^3*Bc^}W=g+#fUHEi<-iisֹn$*1s=-.DgXdt}H@In9@o98I2ײUPML߫_1kyBr`yp}HH}g 46GŋGXS9s@0)j k()CG_)Cg,`Ɂ# hP5A~:p7VЍ(__IOຍx{ƓrLQ6I C d&[xRC^>/}} "?uasWk;!Av>Hk58wtsv+s;;LC_l~H;+IloIim[Hzj%FNۊ2P,2H,S`'2ĩj [I !St0]][u/MioiսYFH[ۦ8_McqZeྯ<$~[A*7cӹi|lN*bF%Xe B'7ݴ'qPEoe,MxC;NetZ)ix ۬7vsESx/N|Y&Cu݅QJ[g" ;$*[Ef-|^e8{QjZP۵i\Ȃʵ)eeiwވ+yt>e`Ё\OJtA,E$Ԭ b\ґڊD_3!iwhkdža\*!ZMVr+RdHC9kc S#coj[֫{UzնZ/z9֣7z9֋z O up$愡GDXO \V)2y OJ,3$x =AzRG%5!;U򏉄*NT6LުP]!f^jL2'HFpm]AV~؜pUISg.W=E^v$8Ub>2^(0Y xo2(J ņR~sn:r7y wZ$tr<[fs2ӳG-iA B9 D;_U.=KlЬ+O0alUʼnMDZtnDD:ǦsIQP'Eoj;m:ǦsolDg'^J+1wuħdeޢNYȆX,0eWGXM6\8v5Isnb귑8|)[|I /*(%O<Eٌ:S_ʛhZopM)B6 d@QM/m (֜Ҧ\"YkM<߹Q9aՎm5h!] -S8cssr`\[Z%\嬭'Ϳ>b9gg l rLD /ⅽx/[xR()W[< FLYa0b2 S:a+JY ϹmxF'&8!~.[ey>H ^:U;S:)'#=a U3v%iU >Lsk]gllx:' {M=c_,g鬣#$NNt{ۣyHBF$HcNë^~'c 0Mף7Szaؾgjt:eoIIfs:}UM2:+{x[xR n/1|͋L{:abwf <1b=vb2m%sS).5qD~&_(Ԍ&y&yxȕh`8޺LjÓ"mT{1kiXwW'U٩%K}^W|7$Q0=gAXno ŵF[=K-;V;H_[Utë^Iܙg8S taHoMW=}<{g8ԏ?:e?'1%z7 Ͳm/| A#Df/⶗%FzAA.-V{Rru2'rnLogNP .5*=AbC}\3Ywy01iD̓hw) O"rdA 2Lk AbBoAI`]A;:.^3"wб8hqtƔf_2b6w<$Q`AQ'dpF2~3i,'A ߙ_5G>AK=#Lzfߩ>%w-`ћ6}.zsĎ}hw(sa]gAbV_hǩ&%UczНt+{uer;oׂF+s(?^DZtnYuoY^vCkMm υ~ql:7M܅Qgui%cű4>6"rGo1b]__Q𻺾@vu (-]źgD]˘/O] ]N?%`pwCEQT6#> r'DP.uv{aESvЃA2TP%iYM/H6EY7eشn<(d'tA$ޅULrD4 ]M arem Yki'$5 l/mZxad9+gC"Ǯe3K@9$P)^8V$L09gc S#mob[+{zŶ^[ozöXB2|t~^Nu I Ua HaV|U*SC!c091K_ Q⮐ɵi ;iN>Xiw& #r9'cq(PrE`/y.FS\wfq g{l{|~a8'{pBn!>iBs0:cP  1ϗ.[͜{t9cxٕ)[tiLHϐ4lo_1]㎭2# `\*u.ٺ/qsuW˾E9e퀔|?:eז2μ]fAқjf-?<꼲>~1%kV^jkZVk^]-b.kۋ+bm}nt}βZٷkV B8b Dt%O:~Bm÷!SE;(q!?{9)}Rr%>Ѻ G")q6`, żbb9YG]4E=Ǯ8H?e<-qc,}\ ..8)8۟Ft% tےOfI³%]9؅M|dݟXCצJWbC& P@ `fB$%2?*bٵX.ZCkmR3tNHkFփ/?_}A7iSvzYkjM>CWTiwo0LJ2)=c,?p-E!b,u ڔD1=Ec-$$<1C?_֠8 0ftH3~.jBX1KX|tq" MopHp ^^W4pKBJ1TmO]C'{q?}A̾ D6٥ Fg73GSt_H'O'OS͑)^iǟj-7\0ֳB)_AH`2;Z>Ҧ)jUr0)^uzf}o\K{s'~|i+w|G6Ww69a-n, IXXHë^c,ܙc,cyc,E=RKc,a,jԭVgq:w% W='0DXܶJUhϼ ؆]_+6-j[VViUe*V:i /VLB&XJD ~& $MJ $&WpĕiYm[vy-]^fW+Z4kF3h.o4X*'(8 -~cks][kCwd^!3m tE7˕~y"A9k??݀!aۮ[f*?sb*;W_łV5]Lk:l>dP) $9&@z}j>sż;ϴg33m癶ef;O;O嬭| WnG5iTã, ģ=v@| Ynţ|[}@ay S܇!Aݠh}^\[[j=} ] V4Bu 2 +B|}9$&q1p1$;%A!8"Ҋ +F\嬭|DQƺ>es5hÜĥg((!Ś?JP݃!WmC0` ~F`8uDYЪm>G[WI#3!9kaWMB$4ny=kΗ4UHnLwWגhDDvjWVg$4M(bj"i[\ 1Db =5^`* LZ,gm4a$00Wf'%'&x>iN۹#Wgoy;rn,M+wR@9"rEc`b#a;r;yVYSuIuQ$*+leV C@)qY a (~O~#]$ke0۲}B롾@=)[棭,KL2d{y3bYk+ vY2Se.DlY+Ҥ#JKCXaYI i'ħ>D@Iٴ^Kdz̪|qlvo}T-)WBk<>F|U$KT [R2A\YOvejVn&B\Y%:bVg_!ޭn\Y/_Lݾ,bpJol;Ԣ'R,G[Y& 8E\Ew7.vcYJZ9sBWS=<#^5O1,GDVRҚLXk=\嬭|n:g U(#$EI*%(@` Xf ,Ay")Bmb |p Vj>s@CkJr <+5dY[}灃:yD&:zB>q{r Q:Og@!<%kP=|cH9if$EI q]ް .UBq%kPv0\F\p/D>\(GĐvɁs>km܎D.Y陞J(:Ua&nm WqM#8 _vCn fT~+3.v{N,0t燔- ),JG)7$ qB&>dBveG&򅞬>NZe'Oވ/P3OTYdy_̹eD kRo~mc,QQ֪;QP?c'H%as&DR5Γva8OfCD'Kx/Γշ y2{'o3ÚITI8$ĥxUCD1 joym l(7$ļf|Ýsvy:Oh:ψ[td~obI܉_%q'LoMגug'( c>&<ď7=03bq^H6fB:2E> {(vu$i)o`+-<:irVY$r <wpij]"Yk/Y Aֵea>ʲCv,˽Y2 ʖdZ}Y&>kԔ5ԷuZe"OE˧iEJLeh2M+bYO{k ANxXMuP nߘ䬲DY r0)s0$ʥ1S"Yk.#HJY3MYOGeal0Tx2v"\uG9w伉Ov{+K`8^IؖovB|do/,Ҳ SK{8> _?~B|C$KTѯR`ٴ6D7P"Yk7C8Aa ,f|yn*b똸͏Jtj8f9xZQ%kP_+a!U *qFHO9Ð\Ҋ1d Y[9`ZHH3B˜O\4Hp䄸˅Xk#\嬭 ^ r\: x`ZD.uDsuȝwJi;̘Vyif$lA.u#"Mҵ#.kMTDt%gmg4i̧b?kryi#'kq(VyxQDPG͜;:r{9!Au;D.YrVOChZn=!ԭдDBc:C(e!q)(doJ(nbYߣ"^V\AF\zL4KupB˜O\U'j< >ӄ$;y4Z"' je/ai[i}TRz5!WHPQ+(uSʉ9r癦Mw|b ja"xjɒZʧte.Y\W!@՛c+OO/˧56[vvwG}MБU3 a'.-Ŏ<2yy>$;d;q-(MI.3hR|pekZgH j̺_cgdݶ,mz W"7B|ޟ`FWYϱ‡74nn_s(l4ТHٲ0Q{WƺmY&N, Ktmvo},cRXAyZ7}YO}hQFzQ׾ff>6PAdcS^EA4>߸񽣂-96~S`z`T_o6?DG}!PLLJ* r;jiݾ,僚g:cŌ5]Nx,<2Ѿ)XeiwYcݙqk$o](Vo'7,ڧ 5Za % ,QQ8N"At#μ94K,keYÕe,5ѷ`䇔- V%j@){6"M(Ɛ_ʒr0^&7/N(?LY,QE} )%Á&8pb݉=$o]$kXEIAX_c׽Lj8S6T⥯uy,xĊn{Ky_zUݾ]B &@Ͱn ).zgY;cYk/Kk{YZeiÖ,G[YVVmYZeie/ uݻ&fk\&fk ke9oٲ{5S_\ŋ Nl=А+iNT7UR+kZ 8O䊣fV絹7絙<(-&j>s/j~< H.3 iBg.YrVy:B|87NˑGv䪣fN~vNb0]2'.YrVޏ=( 9$׋K~(GD$']kZ+n8O5(gmSMЃUER(&͈I ,fr0_T}CMZ7M`~݀4`RͶy;_6`_cצzͨ>t,k޼*GOn@ea>y,QUn9xzk6 |ms3g2գ.xCuHXV<`Tb~wegTڽy/xR8ڌ+S=PMd:IuQ_*|tT6+!) ^cw`]y:_6CU bI)xά1\i*k޾ڳe„40 d8D}/Ä\ߚ$}/݄Ykaq%ڧrXe͐TV|8W8)D>MuG#o> k(L( P-%x[](LBP"CN Z%>( vrLH|PNH.5 po(O5(gmөƛ̈́¨̈́¨@FD4P!P>q+m0.ӆ€LK\42!]@rH H` ਫ਼ ˵5<\嬭p6(*C#(19 cc4g~Xw# # g>r%$VOhnf@\JV{Ԗ^Sf.%A\嬭o><כ@%` r#"貯j˾,|ه\9BamBaMa)2H`$GDqVxr+8)j>sU(\t8*y*EpwB+^3C'I w3d@$H'. `nútfw7n u3On3^UebJh6+wѝEL>|%gW_mCa=F0 QPՆ6FCat cPs1m(^{ ODq@}_G7]xi !00Y@rK;8۶a1u3ms3 8FLKK"X/d$%DHV7p̷@P2?ݢr \rDdx.Dg! %kPںjnBJ1C\qq{b榭u-#Zȃ<ȕMo @Um6UT{iPmcNFp6#8MiNs45XnOc|f~:L3ogg5淲߲ @lJ6U6XH"ʔl:&ٔZlZ1:_Ȍhs@#"i'7˅սYkO>䜭{){ȁlCDrhDe Oy:O)b:O+[itR4v {C ש7sF Kh&Qj}17{SoP䜭 {?/"Cw!!RpE>x͇L!Vw3boL{c\OʋmΆBDz#E'5P7R̗Amvo֓Hn /Pֳ]ҽ? Ykmt7_kzS8w,+=.n7[I}cMSX-'>}k6=ܚanp὇\Kq,3ee~17RmYf2-K,eՖe t/+Kxon/^3P&Okcx $\ В 'tD//kKh@9gY˟?"u>7)j?iX2|EƗ?i?QgZA$d׉kQL 02.^OA ~@ _QC )Îvn4Or$*~4?SF 퀹"l$=) 4 Bp$'[PSFp"iPEIZ'0ⱭϺ WАl A/\߃|S>Q)^OWO@ TXxq [jq,Fe~ 2TrӆymBcE:ӯWJJZDHA*yJP])e Цw\6eb%(5S}`ϖͪa}ZPz MDu(L)?&{H&EV>~X F)EĝhvD- L)PcHu7E3@ :\`{.1EZ&ށ>gLCF&S[?Y@MSR[EJuJ)0(;MP0;y* Ve b?4#e43\aVḇ<Z 2ͱ4.JmNpre9=mCAQFtZ.>}\{1Yc=|1|g6^f|rnS_ |cZM=!cߟ63UEwľuBFbE<|2|57(Q_m=l󊉝WL<ԧ%*N2q[(aEuO2ƾ;)<osS['j-R?$m fwv~k%mLP[7N%8_2RroCuźLEt3u)XÊm-ύ`nRxEfT '_ocmlYo<,ECH3dڋZ5+^H^fU_vk]'Oz.պ :PBc3ɧ ڑ4ҲOxu^ˢoḓA8{03iBxu^ُp`LdY|UYI0&^D?/ c!O< U1qEk*H[qsͿک>ZNX)k<W0)aB=󐞋%$I'qyzoۂ& -܄nki1*IqLU^ AtKAK+ß](S(%W+R }l?PE-wZKﻙ"MMH ~{C +,V;L)x͊6ʔ߶j)o*} *k4 (*[SQ C,kʔ1Ҍ'ƪIóNpr 7 Ap"^QqQA,$49='wg@="np>.eo9$5!DO#:X؇f~@laJy;&,?9J21X.0vAn p.qs0^Hk{n5zQm8bF?iC G"teOzNaP9olԨƅD??XE]3Ds r|Lxbgn\kMWrfGҴ9=Oo}u/kWVۦ/%XuH֝~T>Zn;>I;=왷^ë^0~'cnRU:RMbNë^N+.JWDc/CBj*6,';:'چl^V_^aȊ#ԁp97Z $.$Is ^J)$<3ۿ`sߔl4*جQ?F崶ܬE~U`JH\[<*d >Ūl]ժ|E3P!c2Vu-p= w_} qy8;;]bbVno |[L۲-&m1Ao󶘐De}|A{%t ӘG?چ<֛ Lyx3odXn^a4LѣDx+dc#؈9f0wKC"JRJ,{OmFHO!Oֳ070Pdx^ PVB"!U.̅o"Ifڠ<֐5Ȁ"N֙[?+pyO7z1+d5qC'*6@>CЏ~uAM@Hqzbcۚ|x\Yt5x=" q ;\ E2O wúߪs߳[ޛprBF.z<y9?YǟF۷[W5:>Wg~g_jp$M{+ݧioK˾x'?3=Y uHZZ>b |˞0=6^W=,^^FZCMn( adk*xu^޺.OL„=Z+qe*Rb%0:H".Z#b+]^|e///op1b*tmw%\PBx$Wa WtYCr{;םl(DS\ǟc*/oqA!ߝ'FPz+U~My!m@cb' y0`. [KD<6p2KGE  8W(+^k8E \e q .xoqѯ4pkxdi<2:H 8e7}-dK(+m6kX3qw4ݲ*fp~ *оɪ~)N8 `DD!U1[ *4u4C`:?w*'MQaXJ ~geۼiL4!'Ѓa,tyTJ ,x,&Àʮ-o!;ZcurF5 6d~ EXQ"xPpVzhp֯l0 x? }:UңV*՝-uAqflb$EvH} O9Y0O)ێU!fcR.hEskHگth3\P(w9,/:(!=,ZF:GE>ƥ.".'U;fʛ;o\@rL@K]ک퉵zo'vbhz $Ξ׺eoybw{d$Ϋ @fR:|/٤5ENR6iX'ʺ8,~g_Z.;ħLaEw{<ӻ .f*0ħ\SŧX*y=Ox!7}X#fQhl&VFQȻb|0 ᭙ݙ**ɥ|z /~[^.. xA:Yq1E۴' !kgdU Li6t4$Ќc8>`ICKNBr* k1/r@d #F . ."7gx/~K3^ 4t!xvXbsb(ŀĄDZŌ)=5\qXqi~&E2&0M`9XӧN3^tL(/2:q ?M@kXz' GUÌB#/GpGfxNƋLlkZ,yhFY xf80ghN5=@%~vg/ ɜ.͈1܌k&[J4fy гf@H H.s[~<5/~ f2^2ǣQ)JgE4Kc؜|͓/u [qd.06KyI -2]]Ь m "7lɘ?~wO3^4RMyhRI@&in! Ҥi~ I ^FRnȧ{FcoYcU)~c "āuDOrQ]X< ᏂFf7,;+N!Оȼ#c!,^Q~ypX"Q]'l^T.no a!ȵE"rXĭ j['fƁX'D~Ye,I5;>q76#qcM2lZ>qn=V%ZqO9-#@A͉Hpţ b6^@iѠ1{t0R!tPdb6WG}w${x:2آ7];DȑA>ۭxO~+ޓ݊;\/og[V4'{t8߶9vPq,lD\Ek}ԑ0q=j!x9&6{s7Gѹ;%Ol\0pn,rCrn]OgaO7 k ԛH$e;¿'= k0sD=F@bJl<ѱJ7_~DGu@H̖C'l H P ڝ$h VF PԔ6A+CX˲pPHү~ #zR&|`>gM L60AIr9T$@Psy, T.-4e뺂Y윆gZS^%,`Q4ܭp<&*QlSu -8%`m*hj#lo'v6/Y"pdoybwLCG;@hG #R h$G$@:kHm 4`-? $5Pfr832rN.Wo"2V"U uV)f<0M ~:9f~~`fO0|C7'pO.)ȟ'>vǟ p|i5Q.%B8v9w׀#UȚO2=D0 Hk(qХ n5\KHĶL{8SrQ&>)c5\ .Q@G_=\d0̔Ao7u2D)) n#'^ !7޷| $6 gR~cd ~PY4RRBl"4Fu7٣Lex`fEXJ '8BP(::  ?ÍSiuf9Ϫh&@+Q˴ qGJ\E0A\ UQƆtl2e\Qrt`<` d8 ZKx a7WzsD&6?hS1*_f)0n~F~39Vх2 v.oq&3,[bf3m?Lϰ &g4?hK{l3PVb?/oNsi9^%nN۶9fsZnj6lN޿5_DEͭ~X6hE~7ax52=SxLO98 F*M^[9FBڊ@>6aOX!cこi,Yvd F*IE7RэTM*nbR2+ #H#\! !NԨ[92q NG~T<,RCtT{XC|" VDcmjI8?|\f*EF $Fzꖶ#S;E謮XN%9,+I`Fzs]#6X~sCn5i˂NB$Յe9,Ǐym8 պ2RpE8;qH[92p u[hp08D$sbΆa$^ s>^I5Y~+T@%4 FZy:!<+ lQc#с$-fNN'BSõw\VJEu:2%q v,Y =s\AKBLESY#Tߍ%RSDI>b92q zP.@rLeo#;8c!N_, c*bb#$N IJ_RJƉeog߈$R֚ ,dʥ9,kű}NTkNTV "9@ i]D/Յe8x-R p eq`VXgΕ~92K8hCR|GX\%ŸjnImΥlۮwjז*Б*FΥ ^ cyr)*T)t\`}X:GٌcԀ R"<935.!YW3VJ%ΌV 8I ^vَS;`h-ĒSN[y.Ene!Ԙ k?&f@Ú)0(j%c1>LWd 6W5^V*(2G XAc*CY# N*&oHerLeL8ĤR$7Y$XƒIE*DH53MF1S>og"3I@ෑ ,Cqܢ ȐF*7c\%1 IL I X2gw9h`p_sFjG~hXƆ;C~7zȉ[TI &K}Le fLq 3{J<__S 25q $r kpr\"ϭ\uX:+TA5kbΡkE2kE֊d֊l s|j݃ṳlvb R)F$<*v1l(P3TWN,(x^lԅR\6JR|D\(j'2-.b艈GZRUd:b |rda44)@.i3*}*%n'˙]BwaqR>Vx*k1yW ˙]k ˈ6C2]SKW/<{ꃌVe*ƒ}* }*Tg6 ύcT (K~ibKbT" *}*%n'(̾m`Zu 8b'cΥx7LxN |s #^@jP3-:ԇe!ý1t!`R`g0-QEϥK" ).Z}7l#uS9E]h/4.!% JYw*Idl"3U<:#p]p 0+>H%D40s)0x$6Ht@JT;?qTձqnf1Lзy̥ !Py܊-yaK9Ʉcj_cqHgƊ#\j(CofհaKe9b' ̓_\jGze1KYJV#b X9#8Rάj׫j826Uh#Fps2>#z26g9Zh5(h\s)xdv%#"/*;7gyu"2ڈ\h v8\5pTjFp*C,:+#kSGe&}.p Q1k y@ß8@Tr"* kH|.ړ+4!ҜPO;c$NLoΨ Xv".BEE\Q)E,5-#s5B_e.vLgxVA#Z4W랦FpQX+rx0}5uN*e=:ߊSAb[o"@UK})ڡQTN|ۛDž=Q4}5>L;-ԺZIƺ c݇aj0s)rCxW~- >S,"EOlR6tiC%v"P)yPY[( Uʒ0"2TM\/c[91d{9h%sXQuR)[ąyuˍ;_;/};oО@qc֙}L| ؙ= ؍]B0=N/q[,qcaq[_qegSǔ,Ǖo㵿 Ͱ8cs-`75=@v^Xs:TO{v"ħ=roeai|gDE44'ßiJ`P/?𓟿S op/<ѫO#y77:!cs'0F ?|oa/;.`UKF{co, csBrcemXƊ);- QE9*N2q Otn#_ o9Q1 'i.m\V@ũʩ_X -gz17f'Yn!@R4Z#<" \ 1ekHcTF eԩGDwU8ReTqKM*lR-oɪmYգͥ "ß1 zjcx|iEc*(QUHϨ'ejh2bmTXjg19ybBϬFS$Վeswbx+p68*Lyͻ-,|@+J4Uͻ=j9{WݞqX31܅lv.II,վ1)ʷtmLIdUTvƙW5rfZe8-vx-l Agr!cL\tXko;m"jta 8}]$o 8M[D6҂F'F~ヿ~Dt&K"T%7ǟ[ݶ(Gi&>J4(m҂xT 礢zs3[7[VnVfV9Dt&K"dB8]Op2q~ƻ1y 1 =F6,GәTtf.SivT#>U_Q5ʣcg:{[awR a#@u%\Zn;^^5&%A<.<͙4E+b?s@ϥKFoT g꒯ڮR_~Q!)[ek,Dx~)iZç>McDx׋Ac!e@RQH36sŔlQ%/}*MTac^q'eN 8Ip؍$NkNcRqD˟sKh.r2.S$ 0cw nq ֕49,뮳[ SS1ʀ+ߙNt[p -ցap,q^*TSy,8O[y(%8'l-cH8ǟƦ65s qӘa%R18R%Npzb.EUw4bQ5kzYX1ꅧMx־^Ix+JYx}Y~xᙪR"<ëŭipSM[3LrAc[gr 85::&h ɅU*UygTU6Ua ܑz}yyj PN+V p7NTCg65XHjH5<6a6m{8-Hsx=: SWWZfH㶽qhnOk\&"yzFdl7(l|ѯ;_ yt<mQo'ݧZX,Vg7TŮqᢻH….*>΍Ojǫk&.O:'qm,d9vfn$S kO)'g"\_/.?a V2 "k\!3޵V?V.ZF1m|rsK.U:ٖd[*i)y HonVzK'+#P.қ_/I~ifL!ZYoէi9]nSHTnvR%F14z9C!ik 8\ @WT)j EC%HRp\46P/uITN|4zL[4zƪk2R_K8!V.@YDtFhGqTN|P}[He;3qyשc\5_7Nl&uSd߇=@~r}.SUOa_*օf[FFc2a242 "1n|jL˸:|:W7{ckuZݸ˸FS[9` iRi2|aW]y$Hsm/ӷFLTS|Yg@ô+IX"c.3uǝ Wc-AfRgr [;֎|;3Y{.Ҏ};jڑvSBC<M7@7LCi}m>>3 W+t?$\ 5̵a}z(4'=`mjuaT_Cv%3`3AOtF~-|͔m*K `X.;_ ;. @'Բc"9Dlvc|_&P_츜<$Ԏw:܍x.K#nA#:l\\칼Lϑ6B8ӏ8>q[6,޸m47 @mc33KR4nF<=y1v/Osxwh~s;ϣ~<\=};;]E.ܞt{5]ٗ@ﳠ\ou].]WuY\ߥ}Z7񙶈o ?q7st7s!mn榻n榻c;Sۘ.+zgÏ)cmLa-ܰΊB;MrHyH꾥=ZWErii`kiږκtV^7wfeNyi4m#\rCovfs?9(Comm|zWSɓ!QZ#tH*/ q n$>pdCzr\N|wL[wc zq}K%H i wFȶˑ/Ƶ|ﴷ($ WRBdvYKŭ`&4$~Yʩuk>iXW23ٶδEc-g]~!Ts2L9h C.CK[ikrk+K[kkNyitm}HǼSܸa+xE{` zmg |J# 1 #OiҜͧވ2Ls`$ ) ،{$ 8D+N!4^;aL:5@QoG#`Pc_S{.'f A=}w 'luHN0QVSltJp4^%Q j@֐*গ jKmEmCkxzOP| H7KdjH|--TK"(%)վ Pk9!d{z,4ģhuۋ FުƙtJ|$W=>qS݋r^]#yn/C41/UOv'2ݵe?e8LJ@ [wtT>fx``Ot<|,>e$ʇj{_8s HG\"e/n;Bs.\e;!y.ٯp=Sӓ:w.\^.GܹDrgsζm ڗrۈ#mQoOWh7DDMvm{(7 y+sTD iܶ7n͍}?y[_,/T^4nF}f߭7$eXӸmo63x )̟mBHݍu!w<4rނrYkK&Ӗ;=R lyR> j[6]n2-!$y7턛^hg/uSp`~<}ksrܭHvG30Hr^mii-5:ƕ-Tk}zzG;hcoikٖ4fm{K{-t6wt Yz Il3FlEZN&aIE vxB;oMS?-wFζuߙQ򤳩F$֢}/:63*r~\+yn3W*sLge]dش[.vkŶYNqdxl| {[GmmѶ3h[[mѶ1Znk\QA1X^:jݐvNj\)]FpjP>3Ɛ> >ضϭek^tm_X%a@Ee t q:N8c ̀.R'L5hX~\~˅Uo}:3uĭѷ:S-l! +Ͳ(Θ~⨆wZM )0&״!M0m÷aKW(ZCjVÉ|mM Gͧ4`/4~@LJmmUO^ !k}b]3{7K+ WPa;\:οs.^gBW}{IGdls54x"lg`Ie2/D?Ù21ޟ1= 2&lqm [.ׄ L,.?ҽ ΄^eUܮ·.g= }F<_F0+P]LٔSZ9<^p #Oʺ\=*uc9󅸎o9myce]\[XX$!V.Ƕ0.A@۶ve]ԍ:w?^X/};!d*q#\:۽qu8Ӯl"uc[ g;C =zWsRu2ZN zW-zYˍԦ3 MH}m,L}[\ TvFTpӺUډJX|!D's`LఔbXyMW䠭h4S(dDocOR> >͌*j 4>˘uMK-$D'S/N&fk4^;ᤆ{7֑& >+}Ѷ|UB H.'׹Q0OhRr8m!?8.Ix-IufY͘[֧ w)k(o'm %͠z;$5D5DλcxݐP8Kǧ饉&g186g =6r 6\r =& R _h ^ə*(.GFe%r\e߭ M&7&z=V<#_['T|exs>_rl~$ۏ=LteW;7<aY?~63%mAm%<1oFI$p)z+*vM~UmfD}U%}\2yfݏ88x˄29ӳ]rKDȎGO BqNgwh,ȧS(23q޸m47 i~M\q#5fy~W3޸m47 NYX=lj~mDFsx_dNLL+sbr\3'js7Fsx_g^J4nFdK>x(wJ9%Orcn-|o6@'؛Iu|i+쓈cm S m)BFvyB]v7pm#\Ό`H~LbÌvLGtvM(>56@nL\G1ԍf9aO" ˜h8Rwڝn7a.y!ȴ˙/u|,s\O۽2˘[3'옶IF\݀ PŎni2i6Sr0g\zfmlZr qǴpm[|b2B\m!\D)O Rhb mk^Ip߇w?|'*} ^qr7e[Aw3 mvR7y+߇w ?SUuK[Ǵ#\[㥭ѵ5K[kn~ZHEFh6 ~YyE6 HC3+(2e M~UBs4O<$a<!|WGO0wrܵ}):6u|$ .4#`C|$߻ɉQ:VGԏV'tweu6GѽkXwdWa65)'] mmC, ƙ@v҆bOz;KϬM ca\j[޹iޤ6H7# th@ P+9aP?6sO/ϼ]iC݉?OWkB_}T|K} Rj`V @ 씧e T>fJ&FF^SopP'\&lP"s&}A^eXeXผX/ݯ2OV,u,r.I,irF|'L ffGeJG|)½qhn>\/!xnGDϔg{(7;~" }n)[}q޸m47 Wv붣Y;[uz1\Vg`mQoGwzCy~t˷$s>B* …hB-Er]Is&?-/L; ̮+.#d[r*Kn(UB"_ɭ G⺱\o*F>dJ@S9vF%4fSRouƴ -lU-s$#?Qz[/-ͮٵ4_Z]K]^KX;*I^U9;/'#|BC?%hnG7dX!uS9EoSr8˺3. ="m+c[(W$,B8MZOFe\Z>P.ڇWq}|r mɂ(uSߧwڲZ6h@J(R9pշ5{zm[g Һ7OB(ּ;?R.$۲Pq vd}2x-^:F{AFB  ٗiwr=">!33?+ fh ͺ,q%ISdc8nZuǝp(Xx; Ɂ#6ÔvџP> #E_G[mNpM!<^=Ax4 4LTNi>eOo|+[pSk Vnj(s^YnS&pzP:ap]ߵZj K4 ^ϭ"xIk/j ZC!\6)[>\~A P+98< { W=>1odNJ$/|{|y#ArPKA_;\:l~6 UO·fooEl7#o4cFJ^43puR030`şL麚E)uݦh2we:b8uL<0f_5 f//֗)}[_^b70T|.oL/7s9p9Xhg K\l7>dC#< Geѹe lɉ}e-? 2r E=,9^$eѸmo6w"Wg{Mkq޸m47 ژ~Η~f={?筟yga? 4}Pv.OQ߸m47 OYsBFsxt5wJ95Cr ,]e&HlRf?-#'[!=W.Ƕ1.A@̥wNz뇐rN}ǔeô#ӱv[2#rcJ)Z]#;TcM5RޒvU[:wZ:Y'+-riۨgwRd*7m-rii_ffi[i ɬ0_֛}!w.2# A΢p\$;< BO]1+0c)m9#N#m?\_m+c[.Y . mt04z2@ҹ!V.Ƕ0.d3Y\(Y_&Ѳ@-w OluVdŷ7slœYwp^B3\^&'zY!F$DO?7CXey?ӬCWά-WN¾[~߃kKۦg4>s?L,JL`_*pK}3WO4ձM:b܇Lt.:Ͳ:' Ui[P65,nkXݻymCP.m[N#P?KO|qxOZO<ɐf G0b(|+x-g?|p@wU̧۪}^\KVO :䃶W.7_}=-F5æJYSg v._3pcاOlo9yOވ.epgYvPRLs}Δ͙h!\0\`̲Îx0ܠO_D.?ψ⿁˗ ӹѸmo6~E\\8=٫iܶ7n͍}?3e2<#x< eq޸m47 $/.4z~|`Lrư|"'z>7@ ֍!g%\)Za1.AI=+׀i#oc\|1wN[^B\{lV]#%1?ٶr9p ڮ4vi#dZwh>q]s5|qM2y\\uV;<u\|~fGܸRg;+ ppq2\ 'eLgpڥ-q-k .mmn7_e7_[>1h{[N,u^pXsWwi.'92MwYjl%||3m[S3%犥g 蓶q%Itctfcx8q'e41ui~[{.Ҏ9};mG-Bn}U [_=\N`jlNe -VХ`8`[9!u{5h$ SCOO c6!߆rRz]z^ON RCØERChqB171_\|~@BJRLQ3^hPn6<1o=!ɸzBӶuFC=y#vPߕ/i~;=LzϬ0/cCNaK;] W3`3N:׊7|{{A52 K-9Y.ÙB5ܜ?KxjNߗխn^7uyxUߗŶ|xF<^F1meDg _7:NzEzh[iG1Q F-{Kkc1ͮյf[ZPhm|TS'Y].Yxks} ~Q3.C'kb\U2mUrT.M?-;S%L%0́00XmA\m+2c8D!V.'N}QL[['&%H Vl[k(ZKt\KJYf͸Bd߇;ʼneo /OHv^֘l[){irжnۚV(ƾ}ӖQi~22W5B ȱe\Br=mZR4s[1"sii+Kj>19.>ɭc8/8L-m撖bh2|1|g*ta|&74 >>g 6$ (DV]ቹ'}qNŧo939 J:WI1pL;J(^&WuяwZG뾎f $C]\P᲍`8gBtk83<8.jHn]] @ N媙zzm|6TQOhֆr^S%,05Fkh' 6Rk@ ӆExW7i ^.*g?Wr&;x`BC<ɕWH׸k 4\5X*( @*rgjW+t.߶ο{.ߞdon\3lTg.mËO44.p9Nz *qoOlӾ<722If"q2De/Y}[/}讚2]ek/ۑp96.˅˲q9.\vn\xwBG8.቟L[_K_/IK!`R!Rr8F㶽qhn>~I\k9!:cs*ϖ>mQo;mcmߙn4u;=ь*1-ݍttL{c>P.cZ`("Iorқ.қ#w;tZ:/-m{S <|N\Ƕ7$=w $RϫK B!Wt $\6MOAĸk86B63cwL[wzMѳk|BR_ĕ ~¸!m lB!V.ݟъ2#ΙӶuB%W,Jiۊm[j?A8&GܸR^7wۺLiqikՄJ"@AVb:ˌ k+}Ӗ>|: 2_-gmLleGT\Z7cR>CD;8/8L3B$,F،gr_d5&;gь+K[sm2_mk_km}D&q͠/G* c^Z7ϣLd,Y/9iLyΤZҌӌwLSKŠp&w1O0iw Fi&wD;Z\BW}l}z:Gʉ1:x|/™cݹcexIVW=h||"fؕ5Db8?)چ!^6e9VCԐ.ڧYI/5w|7iMX<_R7 7 ^AWJhGX֭;clT7D\bk==DJsj^wu~{秾uY-|T}٪V;粝0Þ{oF[Hf 0tlf dx232Bm|͔N.f:s\k~f/Ѹmo6N8^4kq޸m47 $7وhlF[̢f1sh?84^Ow*ҕv`0H!R!R?OzvS̗>nO_>sȏ7z2zv,m}8O4\<1}VN%< p48O4]<-<-O]g]@Cx\)+'#mVu!@Բ'd|tY2 J\[+d)#vw/w,8^'+ e}e>²Dnk esҍl:w +Tv<ۺ9yAS2~(ٴ݉mkO}_ J%^h֞м'_HGΛg$I1Lh:w"𤋹qTpX|+ɻnG4v@Y7rZ%YgINCEȏ@C`_^1"jސwqGX''qֹpqANO4F'7:æigMtR댄:>H x!}W:ch矠eaWt"m;6z?G <%:6~$'~}4.YUjYxZ+8QRm$b|U'unnU*mu-אUߝs?C_qj wYEcȳ0i25v-$EZhx:JZh|~HmƇg_ )RPW!m-xK?tl\7jM.;. uE>Savr,V,~u+n=:+y/ԛ4+1iBDnAe@eFL';lyZ+F>bGA;K4h5 ӡߺfINixDxJ|jp}.(Ni=wl:Ow$>;2d4s\/_tPLj11S^|knvg>~+V/ tRVړ]%va >~~qC *Ae+nnjdZ ??dĜA%noeQF)+%j _Ss" |I5JndZ3u@%6~*+HV_KڢWn~mk݇} /U wXpxW2 f,ڋ"6ɮa$?x~k._)k._kq_ڦ ү>$*>l1JpKE?t.n"l2vB\y1CLq?T^=gFBZȗ㨺ڔ5I_t^3Yk84#lTmgP<4?PW,xw"!;gu4ղ?Ot=`:^z>ir@z m@C@ȒlٛN4kCa]HR,ƴ2bއz Sp I,gߟeY2l6Z^MUaO[kz| S]Y?:u2t,/E4?YI7PvL Dۦsx?hgq_>f#jK56Mge{w'a;nM}?S6ܓ_F澍=y/g>Yi©ܩ+[ttܶ;nM}?άR@gY<<=ӷlbmjƗ_07 ?%~&Ĭ6̕9rރe>z²DyRVtW>%mWZ3ٴi ڧA=:oܧė>m)y>m(OGtۧlvgQ/W#ktN7RS1@mn67ze67zf~ٟ}+})u̾rTCufu}c?_Wʲ]+<?)6W0JX>6j)'7%~,KT]YQd׈)f>Ųn5XC]_sH{iC=@Y_O,Qʇbu#e}e>Ų{Z~}CW\Eׯ*Lsx0c;\Se݇;I}oPt>5+#W_}-H+47wvk}_zGW^ |d W*_'ZONYzDz'ϪX5ml0}{HĖ"M;;*x`GuVv~{IBB4iiB ,t= pvPŇx?ݧpF[}mi ]j!t< - Z_&-xy;j:Cl ܑ.W5zM\k1UJsGn>oZ1o if4[7}{\ %p5 6__rt>yￇ-m!P| \;  D7jnW}N!v)͗/~1JBHV<%h' YrW%F}ͨ ?g9(nn1)bknev+?kד bo96V6ʦs|tg23n*j|V7.qm:7MwUGk%? ڌ!{#պw6&3߉WDW>mw6&s6߉7ۦsxwzonso~-G;ivfixz*$BDA< z*{)7wlt{zw{϶āPO68fбu߈qlx|m6B,zw#!g=`WFuHqy曬y4IV@[m%YC&DmG>dqż^n@Hׯ 9lα+uz^N+Mlƈ||țjc8'뫉".'`1 1jŷam nNׯkkw=9.\&ׯүkțoQbGEcGD8~ .~7mLw2voTGuVnR]wSyHQglcVL8!ʛu5&wLCt0mhGޏ,in9B}V}{V6#,~7#@6 oj8a޾F8o_Jo'QZ8Eއ]]V89BٺhO\}( Ji!FB{ -g1hZ[?Bk5dۨa\Mas0_t΢ #~yd!VؠF{rpXCO:~$;J& ^q_dGqT ^S_|!gZh[0\]ݾ&=[vۢx%~W]m_o,YY˳۳gYgYy%[9|.D]4~ne ʶ,n,[Ynܞγ| j$YUt- 9uܶ;nM}w?ʪVPF`dﳻuכvmӹioo*J3cΥ\ϹLϹ4nʿ뢿Pa6m\9Tosca/w͉YNN4e$luܶ;nM}'~2/*J "Wr\N!1iwґriwYJ[X EtW'm"Yk;k8>-ijOS45ۧ>-smhǽO{}Zf;OwOSh= q4DiӔwOSj=-uTiV/lq@KE΅_#?J.](^@Ł]\2pb-mQPD2.& YW"LEʲa7DwH M|4n5Hn^ӮIAJ|dBWʲX7RW擥(>ߙ/Z]Vׯүkua~S63^)2g_PV=/1\/v] ݇;#3/6ks^4FktƋ7wB-uH^\jP\\hqDJQFۉ i,iu6ؕP|u~᳸ +: GNw<a&c Ô}hjɶJw(6JL3Oٸ6m`lSgu~NSۀ{ ga}ib<%qjKxfg~{IŠ Ҷ릅Mӫ>I7DLk OiB]BemsLL] jZk~;:8XCrqw |> g" iSyBYv H|G`A(^ y]oK#TZiw;: |< <@~yFT3Qg>۝0~ukGfBm@33!1N;ޔ˖mȂ;wd®:e+sVs}G/ZYm\qN%YrY8oA le ZqFU+13C q|׷^OFS+ 8+N?CNPVa3ˆj{ i Ȃ~sdmw6&?Ҫ5ġ*HBhXwƊ47y [L0qtnAN߉Z;QnsmlH~47HgyE93=ݧqtnQί(_aYj0=솲n=bx:{mt{<̗n5ߵ1[O<`ڢez²LAex*| eG;}6}Ӑl9'YT>MiOKtۧfWuT~)dKksNa"Wf~=mk%jۅn=߱LCt,{Ιr{Ԫ؃ 2չ\i8lOXn<=$Q|K"I v PV{PMOuDw劤6'G>ciPڝ/vkRzc+z- wb~+Od^3M:>ۈNw(Di~'@~gPQgLߕn# twAdI(BE'鞎YV:4>?Y='o6>D.aW@";lXUrϿ⨅UM +B1}k}hC|ғBZB6al!̀[rGFH.#/o8a~r3UʵsG{>E}vmS'&^uBP}-#͇lX4k4B5+/((wDPSW. r\?ne/l=g¤Y2Fc*Jqm:7M~EL\PqO5ح MɿTgPKAcA9KMm47;/ublcdks88qtnIn[myf﮻~ٻn﮹;н񌪲eFDwS 6u&uw/w,1qWak3Ez|dB@J m]A~3=Hr vo nߗ-_[=Ҿ\קҧ[>mnmnGlȱ֠vX3Z'(k[9O]ۅn=߱L,o7 "F1~b2sFt_{awh矠eL:6RUqvEDt#փ014~}:.XN6<G2oL3lӯwk<5Widw61ntI+# :>Jó5ҶRГ>z:C3CE\;i!\=j-̭yia.ϾL y!o>C(nm/kķgZhӰ[ Zs3! yC(+{)v)P/|N(xΗ\UL팈2щ.f<:geYƲ?˸)<+?g hY^`s?}c;^vvݭ[I3ceKʣ;.6.e\nVe\sgmhZ@ڵxBVvmӹio+gZukI_I|ŌiΠsqm:7MuN| ,ϤS]a96Ϲs间 _:6"tܶ;nM}:fۙیxqtnIQ-*n﮻~ٻnni羟ݜ{|yuD {240QZ*dj\>Ia!e=%T};)sRzREKEvPA4Ȇ݁O1J]7Ow[f.:R/ё#EG%:\t$HDG$!ݯwflG'I۾2.s#`Nr1wi_y}avY}莊HHte(#5q6<` '>$6,R+Xd;unnld)Z ??d_b=H{P+ٞ(#^/$궾6+J/u_yNceTs+'K>4c!cӎ11 |.LY1\.n .n CLk kħIF}_/`}9_u\|V63vq[J2UUpKE/ lLtvN:>MdpDNpan?Q 넸YqWX#&c( w:^;$ҥ:6m4}6H`4^tmxQwO~VOlj!8߭J@Y4b 2.ˉZwYm BsiaOĮT(Ћ`>#3n!Bm^mh؇m!_ß=1?Gѩߑ/o8a}BLUކQ!烐/ 9mH:]|-{>B=WZF/=(oRэhTM^] #tLgD7aU1o (lٛUmRƨu\׉LTLRՍ&{al:}gjޙl{V)#cv=ǟw~n/[K',TMȳL[UY@7+oy d=_Gö056To9Fm:nM~iњ XD?Z*W2w47L5q_ɎUhۦsx3Mmlh/F166666AΩ6muΩx&׹ioGWǓ=D'BOv=P=O݄?$fw!'9rkfv#e=e>z²D}rf|.$n'H}iz\75 r>%Y-/O[ͭ۾ |Ŷ}ieO4^<`=E5vixڝzʺ3_ҧiq}Z.}Z\wp}:\Kȏ n DZc ϹI9&J_R&R35}̧Ok% t(QԸEzɺ /lvoaNqp˅z5Hz9 ef00n3Qė7/pVقʠ Qჭ"KTJz%HDk]LU!"|4n/m\tcl16/cl161׮67e57H}YUݣCIS'6~/kPV D1DvOEwidZe*sjʘ^2OxYc4죦̗]6 ah' $}GUIKY(Ѝwӕ%IAjލm3"Yket7WTHX*NΌ M&Y`uk7|+ZT&Xvf\~;QL#"|P-DA٦+]CM*e|~env~5W"1$Y<ƒ**KvclBMOcjzʍ1دޗ(_)AjHwm) >5(_IPY6&݉3 dzBdݛ/BguD ö|d 232ߗ=cB|zCHڽcI2J <d<8!>!%*I_, XwndZɗiR0)dX$a'r-'@JY䜼\꿤TOv26W"⣾٤=/G[Y(5+qdFF6.v;_y*Im~!"|Udʲz+!l;1M|4m+~#a]A*4NOcd*ѧcpe,DdI2m؏c{cE~Jnc 6kZՁiT,QEkЕcPgwW*M\B|e)ї׾d+3%` QúSpė7dnK&C} &LlV%JpS (,D 0I'Hڍ@a#C)W*wpl S{ba_p7| >`E«d6݉Bm]$k|yG=/G[Yʻrp,E6)3H'H|Y/p"q>XJ{D_ ,K S1dӂKy Llqh+\CG03n/'Hڽ/핉G hN-OA=,'4S$KTbL/Ȇ݁2m](ECRukv 5dF"O t**[*/6W(ޗyɕ௙.!e}a>UdI궾`Ԡ{Z/gP}Ykre+N-|vRrOX(ks!D?3 HY_#lv_Xj=w%*ڒ!k*ŏ1Ө"Yk/͙+elN]ڝl9*sN";򞨴M|dݛ/Ы안})f⓭${>z_ۥ ő>ʽ/ħ Yk6E+$P@y4Ho3]ɈA %Hw ndZybF,j|emXkh,Q]|a V*qdn] 5pMC|e+@WFَ!ҍ]kX/Pǭ/~ou,!e}a>ʲD ƹ\G4Xwmֱٽ!kK21gM'zv-i 8WkIXx$&Jc wAeTٽ gt" 1Vu$݂Ÿn7'ل@;q%i;alvo<~ l/}Z_}2%3 €܍͗e{csJ$V vc,v?\9v,r`x˹.窻~ɹ.j:*l9Wc}혜yH\KUț[U7H<o3yɮ<SLjFcHY_OvE?ƺ]>L`J(·i,0M3(C#a]nt=yr+c ye9QceE'*4 k<Ʀs#dYٽ1Wkuer\!%/qqRϢc'HڽBλ@4#nOюkⰖ})[ɲҭFvvoZyL~_3(4O7dy,y,]1P_Iz]Mz_5'QO]W4(Zi}(]a%c*BYgeWϢo@\f{O,SfR4ZtP]&>مncm2!;;l%YمmXcp c>1BY`s/k^~A|ovocC=Z{6K?ùQSty 2+T* #u7Jė?fK3#:gzIӛ}Cfof8ºᶉ/}YLҠҺ%gkd+2Ur\ ѝA&>مny}10/USh$ G(DE@] »`6/p / Y>6"|eeёyv6Ka~bsA}'zaa{D_,QE3J'&`IƹmKuΛKN֙dhX+N1F|C$+#:PY<;úM63M|Uylv~y|%79=v!eYar%b/l^$Ap.m]$k2j/y||,KTI,`bI1ndZ/k}( R棭,KT}i\湲,QrD AI2슜vocC]&{e`=]牵viL>)jQ4/QI%R3 ZE͗5안;Ҥ/ⓦT=f{ %*h&F9`]B|5ĺ:o&oq{'1J|+h1')4D[Yڽ]-o& l0l˻.˻P6] w1y3^rHDX_'HEairDfS_0UTS^0UTS_0UTQ|#L9Y3M0&)@|uQrkVV`s ,ٽ4YkIܞ10ӇGw%m|YR\5p|./'P}ɹ >1jBcx!<$#.ܞJܞglUcs6\ |%*AyWKlH52CUSJd2o2 Sd_ʼnKK֗v_l&ʪ/{t9(Kt9(=j^r˹9W}eͤ\A/̗7sm?vU7EsZE0L'Ó~~{A#wsŞ'Ygluڰ`f9˝WKZOTE!luQ__V|(JLZ"gMG Ӣ,Sw dltsہ'D}cwcq1&Qncq1c&Mc)X+7clvocqΕ\A &*t2, W E@9 9`PٽΗɀִO#b `Vl]d $4䋠/glb3->B(R.>t0>Ls0>Lw0C U>3p:c%H|gCe>Yjq\U#"[ٽő%L{{|FbRӝ+PG, -Ҷʹ`Yg%}u 6icS,+#.nױ]du%c]hu$XpquH\±XY-+' [v쏸}eݗm1'1x_f̼ByK֗Xw__}u{cd3t.kˇ!eC9T,+fW55|Oݗʅ.5 OKkʕurZcHN 6^VaYk߇\Sk\kҼ/jˆVS)ghuDJ=c̗ =nv>UY TY@GQam]$k21t%6RcOc6[/9$4CB7drHAʍ1keCuB%Y%,IxBEmW 5ffJ}Ɨ[R3o_|3_f@FL&gEf^ò/_*w[·fr!{*,v*=#VBêv% ɂ/Z0Z8CcX2X~C9Xэ N]aY o7fYoNؘEg~ÒI76׼.>\uYk#i+42.B)xi-uӣk7Ô7t,7 inȏ~W" ۘA@h ItrIG'AIbAk~hHcY`1.Sow(h@7 ioX;Ao@>4>Fޠ~"n/E($S@Lf,!K7$7p7TT5 g޹L^ze/iop 8D0M̅9@fF/ArK'lh[un}(ɃьbS̆ZB3 dZ{crqh [w >&]Ŕ&ǏT\8& >w GEkPUgrwH_;" 4Y!'Rx-҅"l[SiISy!:B3eQQfF#iUTƓ'}G `xR46||dݯu=-#L:%ږ fN.n$MwXjHwWGR"KsRkb[ CZMj]e_j4ǽEc]#$И?O@0rίLMjn71XbkQړ:hXWhAmG'Sڀ1ڑ4+TT!dPdHW0,glϖl/`Vqd]ϱ 8i d \Қ%ۛ$.ZCr,UXWa7 P` ,\f9 P+ފHGM5m$8=&s<3gW6EJ3t1#MmSd.8rHZx!@OJy=nhMCbg u' ǽeE/WyPaLIQg A439\7w_AJE"ɃϖHađLDo*>uDLŊU=F DG٢~z n+| DY‡OMؖ_UȞ3HtE=|ysv~MZn7Brt8k9]ˠ`KK5K~H0  "h32bcv }2Ph){nY(o^Wvs4KcVS婳v5B*=${Ekq^JMٵFrx5*d仅8MɻPU.7kQ$`>V/+KJe=72F HTz܈8c &!?I;hGheJ^ֶ궺w3F-,N. ?v; Ǟ<ќݴ?ϸ6>l‰_pKJo#izrcO]ˊs^uX]K%)i:(Mqw}{1hl|o0 9No꼲c1G3355a|O4e8SQ7+{ٓobK#~h,"jPlXb04.P]y"-"uuUG֐YYxM w00K8]6F3?])ɖĀr@PkTlhMd7웅4?;ߡ4ݜFf.f9$*#b9e@M5(gmo/mo?BDph"(Rzd.8rHň xV悜G¸G\䬭',&l?ȼ$+X\+^=`>V~6\бB&OY ϺsE.$nD?(ai m (q~&_V1V_ׯ*7\M z]*'|JbPZ@ڶNPB\\{J>31?^._N'5|/Ϟ'V'1bBgoZQH^ϥjw?n_Ӕ^ :1ACXW'9ɜ0"uv$e:yͫ^N?IR+"Ҋhtbz߼:eO_t yEf Jt^MeBr~W O[Fއa(J ٌH'؜_tzjFvx&[~Yitk\P~l]xHc]](%|4)jEVWOAs'Wݽ,JAP =JH +kLE߼:eb.Sd%# j$ʋ#4-Ҥq nV|e_\h-zI}l鲱m8I[QԳ `d sԉKdZb.堂쇹s,+5ds(JS6bn_q"CB+҅o(J)L֊ m273r sW{5aLPVD${X(t!`,VpV${EkHzs2gڰX?pܜIH)::B&b.ŝB4lp]73kA+~$E>_Mkdt / Bvh [OO50|X gbF`\ `9$ ㅶvX>Z Y19g+r柜rulZ2]QS}${o4CKUTĝ km ~m6ր t¸e(p[Rx  ŊeWLrgP#sE.dAcH)AL`XB}O)H b5HױgMQW9}t`HNkBq'dar>"<1nEO:ݯz+d SsnHup QSt)ZUrBY尦i.Yrַ1e-UvUD*P,ǠX38A zW>}G8mu@_c d@)fC 1I\:V>nCpDg$,0,gl}ӧ׸*,cBZ cS H+ Aw ~hx0r3 z1S 䄥Y sf"{ó$1>eGnv$G}V2}N3W-˳ʈ ]'>CAyҪ[=pXN:p6,sUDX~S;v%DFkP+TNW(jۈI Z Ѭgy5jNTֲhHZ߃Gk'>|꼲(1g(ȍͨWցæo꼲}vۥ0 epV^ĕ9. -+pZ[EFM"Y+=5(gm=fAݭBKm|1r]HXѿ+r OWH,+\*dAT@+w!L$zc!X#") QT?,B)8ʉDo*>Mjj_'cQD+% nF_·~V]ΌTlNf _=7~|Xh^фa[ f9nHW \PZc?.f?DVWr~TH+x+\)7UoU%[" acToQZmjTqzKWEW c)iZHa'LQe5EVGiŦ$GOBa]RFF̪-a ~U.JŖГz?Cqj[@ڵ0/RxdK~ f}ڢQ$է]'>ނbϫp`*lF$Ft~ hXRCa$GC ޹wg Z^b/{O֭!i[)Y{'/{^!{+r6fQo^Wvz˟aY窸JsS+k/YTyͫ^-t(+"(ȆHMF^M _hIjA9k5?Rr}Ws KC8\Rh+[8Znv \R0W,5-+ )х`N^ԋj s`9$:cg98Z+crEkHJb_\1ɝ)#C01`9$:(;UXCUذM5$gl=$Q"&KMXb<$rS QQ>D7zHޅD@"H_;"꣈Ks/.Y~ $"OEq2"! 1Y}JtGHjCLW 'f*0 ̀Ir7P&o5QTs`^n9 dt~M9ZNIGu.v0-ݍk{?ꗒB['\V48hߍF.q";M*ڇ$>8 fíCi9.i ZNBlh_:N;^Z!f|}0Y,濫S<]avc]xbaXpll;lgrϴ^d 꼲xb1gxb 5,&+C6 o^Wvo,*$W\E#Yo 9̪'Uk_0"0U,gluxb_S<"wD7x‡x@X<1ڐ( =2!sHk;&q3Rw]}k;j2}ǂӾc9cl>yCA%2BiS" 8'Z xCp ./[Z2!}`I !~ ~$*"c m.)@ghYl-dgbaDa v+`gȓW<?Z:3Gc"C} =(@j鰃$n +t &~e5GK!!6a+2y* ?hI֛#11OR%jae\IF(V:)jv$*#CpC߼:e7oGa액 ͍ L7Ͽyu^˾fͅ6xTv+J$]ȄK/5"{A- Mph&{=^?AB5k-R$.m} a$\Ȉ ebt8.q"R1wQJ,[ Z P 뒜Ձ MA 2y6 r񀻿D2\23 eN(9-TTRhYO+ B? Cpѿ~i{.oRúb)BS#426^$}2,uI{w8$P7+{Ygs4K+S/W:%RcIʄ:߼:eARDfdKPߩK*.Al dAWX&qA.9{[=4yb!]:s,tђ[:"W&!j PA!A eѼ`beAS@B[jqLB@"T:ZL t*ry-X+p+\嬭&?C{^gŽ l=$Gh5*ru嵱V {%kPz&W) J2gx70E WZDPL3 ɻ}P$`a. Tqf"&7\Hߝt . >&I;F_1>%rCqݲ;JݯӰ1e}9ۖ~=850f,qYm-ï~`5$+!2F:%\_.HcݚͻPOYX{kPgyH7+{Y9J/M3yncf 7ffd{ͫ^LLV3.֕c}+WZV^ג(k4DJ`b_`b25g*eK/&l$.N('3xvVN 6k\ED.Yrַ:262ށsAB` 0i;zc9zc;r%kPľ`bγ H1C`b3 1 1XLLLlq?,vo`b#cM\36`b7pɪ*d01L&/L6gr$L`bTLl`e Kxm蛅aqBz2,WXC`g `b,`b ,iI(`b,skZ/NgTN|ݧ`b=}L[ "܌IQ~ $/E ZcSTA$P !QQ4Kn K,("1   K:jF#X+גaqji,q6USo^WvK0 KJ")UxLv9(Wݽ{Xbil+uV^Eqy啄@~ʫڕWW^ծrXb_S,,G d%Vֺt ,qyҎJd9b Hc)\\k ]6R7@zVa Z,swA4\ (OfSe]CyHU^]#x匭x4\{Wlq[+ޒ*lY^rEInQ"o ouq;CUFP68f_p|v|t<6ǜ`vLY+khaeSu bx ZH;WܭT8kR 4jn'qwgGy gxgiywvv杧y9O oJ8Ap& D;pH"T-Шú\Ct*aq!<|»Վ5Ҭ_%N}_ŽU[e^Ⱦ^U⹊^Uw0WUOVܫ詖Uc_~Qܪi|Ha5uSЭ0QVM{>Suߥʫvb|j Ȭ~Å ֥çVaxuIIL⹖ILe ]LtaeRVQIsX7onTUJB|jQţSY˦QgMVULa(EmY4vb0D"$} UY.]^&Z ƴcw|5K!f2eyncV$W'GWwM;U7;๳IX8DڤӱW[Vh UHH]W5ZJZIL5=D]YOȎ|@/ٿuֲnXZQ;ur8 78}PS+i#RcIY=險sXw k9x"diNZѓZݜG.Wk*w_Z߱S쮫RS:yT P;:p`循fꚪsXw 5%@S Ѕ{9V@P?k%lV<|Kڱn/7NXd0EVBSljWdkYmjFVgbJ2vMm"1E/VPͷgrux-VuyKҘY0|jz^ ԕ1I__jF ~pSH[O{ܱ;O!f]OҔwroIK(Vi'8k&نkha:p#35%<  X(1ECJ 4,@evE2:k)D#v ~ 怩fʅ 8 @A2rc` aǺ\xtTUHʺZH;@)imY=t͈\s <0p,$SꉶZH;X\,֌QHz:Oؖ:O]9<kHhIOdӜHhjX0 ȿ9k:кf› Ј݆ |!~~'%2OW;ww_jy` uD{4 'P-C E@ vt/ kDrXτz&}1ySKB1/B̤H!@BhIyǺb8g>O-,>fuQq5|Z|O|jyڱ´<(6?IՂpgI(ʳB扅ǎLDb'yTk#Čvs:XStvS B_/uW{8jɗKެYz/fa=O?ڥ{]<|ݫ;)ںxwW;uyl_eΓy 8Բy־o $ΓΓ},w*ӻ)QZ- ; W f$֬ô@;u?ye+RD %˥ZTQ>N^8aMuMղv*Qw߀@"le) @եaBCEnjw Zgh`ΓaUnJlF5({Xhw[B旆M͎CΣZKk;yTpt9U-4<<^yCv~U/6e^UIWЮŹzCjf#v뚪y8i{rG@pUEaʰ g]uMMa5gJ>W"dCzϛBcP+i!- u`uMrMcǺU?+KTNuRZH;fH-@CmsO-v|i=Ylh>g`k~٪t,dym{ΝIwU>{?͓Fvl1'4<$u蚑jǺG)rNd!>v;}V;)YEpsX7Zu|iIx29!8Բ˺9 ~F]LIY( j \I4|jm;;30 iqK#8\&R-iq !E+LFl_(Y13ľhqh簞iy/Z'Z*jPi!ASKZ; TmOmSmS JU)$D6sGv²ǽ{RGJF:S1_*T@pZ.[{hӻVu;9;ǰ1>I(3 ް2JS-XjJ:#+25U 4j|̋T  %\Frvuq]ж._5ر9e]1LG 8EWcX&6Ja3fy;Ϫ:?,S͎UwjR;b@V|(ˢem㱷vʪOl֒\acNUr?lUj/-jĪ~U]XÉ/9+%!A-9/Y' Ǘ -.ֱ@;78(=>@￫<xR4f_De{|_WHg繺O}S}r >5xgú;O9ooq6qVq|D'D'zfDh %e'RC NJzbƯ3ԛ#ƈH1"Bޱ4c#tI\tfj-~; :3./ZO3"TKh; ~ZLz: jSѬ,> zî8Z)lXS7B#jutہZꜧg<#g<-Xw2S:ic@pUauUׁ+irVКpbh`籞 X,_~+8wTdL%Jv{tq4Oe9:Mۣ[{^ttYH4,3ktђNu7L_+wW~+7[EXKa).ۗĝgeEΪ+JͰ#wc_IMz 0jB&5vUW0k~5U4Xϙ!g ?vecަuFNոdz`;4ک`5.@Tyߌ}vy{e<4 y<@<ЎS<4_塝<4_*cQPVڹbFH՗i[̈ZFw2v2]rEw V_fi8^j;0|sa8#]c=86pYwiyjlju!ӒsvU<:<:iuǺ;O=V }/w!h RVVN[qKٱýck{jVwWc]Hcwl-qg$C˻_~-X9Oq-<Oϕ,|_zN3=W?𽝇4O?ԪdQ|E@ z*?t;οHr^܁'tiNc4]k:6Wfmm/o[-g0_v~*.}z~H8ӫhz}_M/sQ%PIEz;KI/g ȋ\} vHؖl6ݺ|*˴}~KՕbkJh@ xbG>%tQ=D?T_D7^UX/.0^1 wCc AZ'p^ZHK{w:6c̹ ^sounN~!vW? h5OQdˆqR[gXֲXCY=}C>xfoo@.-1H$XMp~;{˭1NŚQ Q>n*}QU2IiX&y)]2<{@t%]5֢5aװ˺w?~r> Sg_~=;M:!q鈢 pz)?r ! s !鰝x= "s#EB$Li{ zT_գ*an lv:7$k]zE ~L?ૻ-Wljኽ2,Y >gG؇q]ȍHR>u\՟Ԗ<,f+;lnbkYpTGG]+nb.C0? v{^+a\"#q~;9]o^Im)B#̲-9)zR W#G|x(ኍ +[7U:|^W uHSE ySRVm#2jtn+ak)Nm7^#|uǼobs̏aҷWyG؇q]oDGO2a7Ob#A|Oi7+63W#G|x(劝nT'"m*?c_uvngWom&*ySRj&̶&*y^qUw|ӏG]eq*ttIHx4)NQ{hݴ´J$iOE>͑כm>f@Ev*pjӆ>]7=N~8J%(C/:Qr?}2~mHs~} n8+|( m ֪B!ek~c/9Ʊk4}s1z1.h;n>R ^3ڋڈƗ\nYPzӎ~u1N3[ݛz~M{<~S$Z'Db3o>Fx< 5xIyili#cz#E)!UȒ6OjAYZ jz w| ң&@3]}ENۻ yv En=$c`8JkLIHK_0= f牷7~~UzztUzty30k'ђ$nӽUwZs-z !{ߍnEo˟SUt>OL,J~4 6+vHYwln퓽m=txnkP9Х*#謱*F ehtD9``$I39G~$h:qTrkH*|? E|(矕&V̍ؐ3^x0-k KP_𬉂e{ ;[a&C]mً1Ol}醃4;Hz_ns'r^/2~'>)eOb_׶c7AtȎg\Bendstream endobj 370 0 obj << /Filter /FlateDecode /Length 359 >> stream xڝR=O0+ 9C\_c6#J!E,4Ik)qA{ε[E.ȃ=xl8SUEĦbZTd7d0..cŽԘA){sN Xj gk uwyZVLKR7nڼ(%6GE_r%qּ|w,xCwOf;{;@'Sӧ2&73|HKZ_p55N#BS;./"DFOHA%BǕz" %,AĐwvg5{/$&v)?aUa\1*ሿeF+v'arqsKa0ӝTTku\vR)5vFAlDY)61endstream endobj 371 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 372 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 373 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-qscale.pdf) /PTEX.InfoDict 176 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 183 0 R >> /ExtGState << /GS1 179 0 R /GS2 180 0 R /GS257 181 0 R /GS258 182 0 R >> /Font << /F2 177 0 R /F6 178 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 5158 >> stream x\Mo$9rW>l ?kk,`q{ֻzz{ }Gċ #KTIsh^2~ |~_N!GɉKq}}X>}y1,O+ɏpKX!.?=D1ap0m/Lɵ> mJ2>.ʠ7>>?<@P@M0 pj 0TA˧t@z y ($D7n Wjů童6ns(t@_Nիb/QZODo59 j*?pt5^QHyD -O[ s>% c5*X6SmbLҔk|eT \&4!i-flG= ~ׅҴT->L9&9ҿl<&WUd Ň^)v^T%>i]C0,icLMShV $Si#u3=UnZ" @ݏm;e:T1K6j>h=F%rf|՞$ctfFHZgM]Н(h/Y5M2/Zނ>'=%]R]7&x}ļM'!+z./ϯ=Z.2LyfЏTu{3lg&Y#@i͎N~k:gr U2 ؂e4γC([rnBo@}ye6R]LwFDz_B|ߎcK zVkM}V=#d6O-\8fmFoչgV H5hdryRF 4 5pA4]<>`ӀL+spi9:*IAt0Mh怂hIyσCSISB"`,[63>3:`'y)-u63‚8l7`M֜_43+Yn ux1n̷z/ҬV,N7$FV%|V%,m.5MPwW.hPWzU%}J;L\\عZswvvۣd,NKl DeO'^?P$^êeJ0F+.̑6cYC]&!xC}UxWD ~bևO{Idأ}KZ=C1b/'$52-֮$Ɣe)n8,8 l~uKt Iސ/7S1DZmkݝǫ̬ǾKSXGGj(v;Livԣ _VM7`ϸ/DP_q.aVUs#}Pp][mMW`|Ys#TȗUӍ_Aא˺C7֎-ȗ/>خ[ُڇK#ta< $l0sg$ylc_\1]9<y Bj[/~lW·M!%oM"WVeQ]Cەֵ]>#o W֑( RO3u3,q IH3lډSB I2pcpT\׹* So*>TOgԗ`hÃaxgAB+e`nRK4jXjIw%I.hX]P R'x}!,xDreFUhb;vvP |: Br<,GځodD@[e;,Bִ6zuXd16>2hմ]Cj;i޹GMVi3hATC3ρ玪j4(;5GݾɈyVāG1b7; Q.`;1SN<9"hz* pqǢrnqsy*F:Ǟ=:xA7zc5.!ݮhc׃ 1&1oČ# H5yH'*N4T@;8πw8;P=x eLjQ)vEal*s cWf;2)S )澫Bڬ|fi4Or8`krơGrG\یN,˂6B;r#{ 1b|`P7t8>b|L3058>by! nɸ*qsHcY|\(3h"_lpqLK0$\cNU5Xlj*Q=+hJܒTG,Uq'X5}:Gۈ@{}pLi-"6Б}D,UN@ru!)ECj&Ry_1|/<@́ 4:Ҡ7F}䅇uz.h\R >< <²*p1| T ه"aՓMGHmj*Q=B <t~.C~M7t==7r, &Kʆf^~mwyOs[V&s 趚Y^lf8j(6k;]uI[̹-AѸ%*n|ph{ b1hsܦ fԑ[2  Z)689G ۵=_|hsMNCBW(;)suw><|ZLOq/X~W"XOߜ?O|:Bv/J}6!kϻvx|Rpv]ocw Ӻǭ??OO?o{QWX;$/xe@+wUeEx=r4տ4yȿt?tӭt+KΟ/kxmJ-c 6n"!Fv.N GS-iBH>dd>#FH>`Y"Kht{zX+Ga6ҵ8zKޭQbA\?ՠt{te0f2ќ>K[7j,/j(`wg;E[× zg^i׶6zv1X.p||YwYs&~,Kt?ȭr "L+MFP8.7iMU4x~G#4O\q:E3*DGz&;o~"])0^*S舴 qwmo+W4ˎ_d< س ƥW^rV%}ĸm\[T;:%z0{b65ި7}5<|91+A U4\)]oǚ- <I8ң iި§|EvG7ʵ㛂>cnfendstream endobj 374 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-Mscale.pdf) /PTEX.InfoDict 185 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 192 0 R >> /ExtGState << /GS1 188 0 R /GS2 189 0 R /GS257 190 0 R /GS258 191 0 R >> /Font << /F2 186 0 R /F6 187 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 6491 >> stream x]M$quPmdב2Ȁ=`w42/욞K>~AGNݿrZ2[}~t.?[o_I~[}?ݿi9.~Gty~^)m\)t.|}|ڇ>,}Bp;=ޥέ~{oD)8yeAq$? ő{Pҹ^(b#a?o{$~αa]{ ő43 8sT 8('Hh-H:F݊8y_#Ap$Aq$ss8Aq$lu*Ap$ОC8sJ<z #Aq$6@9τgBƁdF#8Yg\B,aGR1hm-# ~i+ DM X /PvK`(YC|BGSK8:m~ø-āUvq/+Rq=UGU=qdƽ8Nn> 30l Đ826=82zb5/&БVЃ&ӧ˔(:ix3iWiJS8R0$AS߾'YpOW*C0(ک#CgȀCN^yn)n煋32 Otq,z KᇁWm :w2vlcFgD[ >lg ]N@,PJ̆*eW{u<,4Xg&Rr#_P^u"|w|~{BbZʓ206H|񼊴lc:tlEֺ--En˦;6id |Vp]\Rxo3-@:kHE4_l6$oܿʠ-Py+VO|RPn+щռTSSۊD:H=ʢ+ɞآÇr[ܮdi479-/mly+oM/[Q7.澐LEmڟRF"̝]E ~8MK)'YIsĠOIfһOv\,,%N$YP 9`%ܶ#!u YKZH8I!NyAq$u#ބ!O !p$.G:N#a PEXLs#wqHh8BK ( ΄6G yVSGB2GzQzYl.S}M1`$3 `> 0ׄ;_WBwnep$gLHdLQ.%7$ )kjK(q x^.}K %c$Md\/Lrۃ?L7j0 vm}ԆOڐmT}Lg꺾"SFoh(|,+25\7ݤ;= ]ehb"S74EEUoF*yTlnKi!- rX"O3 CGAM|+Uġ3\av̺7)抆fNu9ˑj5rECް=U5$ uY0'ҫqU<&mZBCcI4/y6W ݦF+jx^ og=Gz#UW 01[;o-0Ǽ1c;=΀k71|΀swp3wayc 3w;e8.zg;}΀wp/1Mowp?3w;O3S zgW ;zg;ý!10wF;{g7F3a>{gZ;Ý1Qc:҇W8xUyQP{cj0Fa Y׽Ihݣgwo sc8a{c Khh.}{w NwTߥ{]]>L?ӕay$r.82D8#Bpdlztxvow_՚b{@3&ƲbHJY۞.j_R.%"w\ o}T֗ 9*U 1 q٫PG&=.`#^oDn7aU>IUO+S#/(GЭg0e]6ue:ƽ۸C2Bl(S#*6>KCU%Nt|h>4qn:$H9Yv)tPǴeo|X+oPXXCZ?؏l5KʢsdϢNԕoݬ8Sj' V_[GQ쫥k_,/Z6S\ee }tk3z҂5v+k ?تܻ59V 6‡'ce+n}풼s+csohY}Z{-]y~'_nݯ.uO wanb/t)XaN&QU0?꼦 j5-r^CๆkbbSó Ü6]n'ôe XUay c khMbc^Ca^TQye g ?f:@#aű$nQHQΖ0gK0g[3Gk;m-#yrPgg 6B3<ưpgcpgg mvՌggɽ"O D9caAA@Գ3<yrgg uv;ggl{9D>;ef"69C3>F1,#90Z D@;#ggvb1X/X1(hw#rս <Ap)\pNAgs蔅BO#  t F6a\''6aphm&L=څ]y@u a}^>}͜ +0o*ż)a0¢4I1A"ܘ{Q( u܋A}{Q{2\4ȷX{*?`FwoS au)toZ[tIlPWX ݋6Fn=5 p)tQ_x ȠFICa池94_es5؃/٧`dV5/UC`a^Dnt.[2ve nKviީyMVd16⋭ZA0[| v{6yanՉTm 򅶢=x Zl+"kʶ| `$䓠+U@Z5oY涢A]ƃ&685-;ЛRREWqH_`ˬz32C`gܚ|̌U? 6<ٝEn3) 6>aj3Ya`Sk} WaRl[΀k7aY-+V}f%RKڊxew A!LPKK5`hi&, j0Gڋ+b|~a{0(UI/@Ж.0bt3&w U^v"]1Zfrg݇~ WO4S:5wxW?} 2^f}9x=_> y-N?qj._/>Ӝ7 \r0y~q{b|Y~j3Kc"/>ʎⱻ7 奕o)˕qzg9r|G+eKo,7-=i:*2y+߭Y`uGoY`z Onm+doZal(o6)i$m+F.gƶd>53A$Η|zdy{e$d_9֌U23iNj9X_3\mf~l\7k|][S*wT;S!ߘ?}ӐoKŏtW*~4Rӧ!ߓ_> Tihkyc𶝽v>2nشz/ؽm[7mW"nbmuSM-~o݁l4‡F;wFgF;WFG q]QHw]QHw]ё `nwi_1n^۴ʴkqEWOv-O+;,PFKWAjyp4vǹw+YA8-Udb<{ob꯽rhY93ʼnU& i}Ϻ0*sjlڣ=X%%Vj> stream xڭj0 y CTɲx 0m!4 MW']R(l#o %*}H9 }8..6zch՚X7U&dHnC~j5fFBaϢΡ8 $yvy6HysvW%|g }NES )Fr؎BYToY4F_,g;endstream endobj 376 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 377 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 378 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-qscale-all.pdf) /PTEX.InfoDict 196 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 202 0 R >> /ExtGState << /GS1 198 0 R /GS2 199 0 R /GS257 200 0 R /GS258 201 0 R >> /Font << /F2 197 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 12254 >> stream x}]%9r{8 &$x g?h`VkK#oߺŬy{O[?C-F}ata/9 _-7͢6~߯uOR_.KY! a$2߷&noAB_֗} ?mv/&nU*w*+~z7 ݋'辈!_BMʀ3C/G v~3\J'τKs 8?EK=~CJ8n*] UnMׁ+F}6P_յ߾3ݤ[G{qwVIa`QvKvjժ8_喗V?jJE_)ǩy%onY; 6JvyH.{qY{|}_>?ݷi߸k"gR?i~dT7k']vyٷ[֦m/==w))oU?=G{1ۊrD7YΣl=䦤nC,_&{{T:^e4ϝe ȵl^rT>]ZM+7&}䆏eHDS r鈂<+EL@浗\0ZY)1ap ?*wqdp rU1j6ZHUڴRf8p䝦G T@U>bf'_1a9XAyq^:^VꯌB9}V?xeH2vuAӮT;b 4мPŠVy(7&}EkgxnxboiYd z^fB&_|#e&IyT zC}oOvV=2^;֧?u#i{z9`.}穽]aԮLyF-zn/"YMu#?-tǏ,ٗ3 )[֝P9O|#l:huh7w5ߚ|o=s| {g'o&C{MhPwuk1/?;:u̞= 85!CKB($^(Ov'-ڔSpjq)CI5n2 {wsh<:+uX fixn UwG <'*O2xnF?})z jrB@*/Fa{h WU5>&߳)4/gfs|cM|^?iZ <a o^On,Y8q^kxHwfPA@O5tpx ^倣>985GIfhOa{:%.iyMFųORU>=]naKb4ϟ%ËԜw8opob6/ewPy< xKt.yx@F;vrBjL8.p /c#_VsA $df3^Ɂv^:ݝ O|OC6=efj_NMn[b,tk䧁r9SHu;sv&Vo/_&{/'. FPl+ʳw%Lfԏe]V/=}39:Hi} "J&P5HB?QnAޘ\ /WBWOM!4L(ͳR4TklZSZY)1_W-2>ڍ3ٵs``8ʍQ!=(r#:H "FN^,uhަ334OAl8HTkh^ 2tc4y(T;ξ^eL,[8P4RZB (kA^ POӅԪ`,7&}]Xh MuЇp@hJ P]%@ή:{6Q L.q_z#"xV*ɉx9ӥL$eP>n<ҏL2Yn:w<]כxR<JMzaB nX3m:x\ x]+ څ LA&,/=QL<`9/>6ϟ -&GﰫLy~rӠr~rG202F~corm(:d-/m\W5=(, /i-F3O+V<|痦Gܚy~9ߠBBbow\yǴ=Ͽ0}S+r;mp{;s78~s (2}+54J}rGQmg3 VD+Qlpd3n8G\o~rY\o9|kPnp_ge aLym^HW貌I2(VD3-[ݢ ܽ,N"FlW&Q"mou'+.".kH|ykYƲCO@MyT!2mD<};|CaPTwzXMy{j AL%muW@~j :k(Is |]y(4kM Qx˚Hh%#4d2=k2 ZA9*Qf>L .NB[E\ahIʬE&aѤߝh.-ߡEVVvE2z3͘ &K`^H2ա"u^DycrKd$Zh^mo+ 9gPNԺr}7mԼ1~gzʨ`HA>LX{ഺ3̇mp7Ol=OߡEV^Cȥ7]]^ }{e2v$H2[f#=(f%m6}_duh$ Q1HO]!cJh%J~cߣEhdcgJhѦ;i6vF}|P2:اhEM#7 Qƾ;79&#}{P(3L&w66UYB~LֿѿWҀ-+3L&qFycD68k[O?fmU„mRL9jCƦN3šYY,cԽ5yN3µJO t?%9pWD b A̷mh02Ĵ잛7>Qk]6C9I[䔴HBVQal5LySڅx %FKvy?ti#[Hwo4DmÜϴͳ [*h\a%i#kHnuL d]ض>#]oByF[g}T~&q:6mDA䇙 %0Rygf窾 #FvhjEL#KȫӞ'Uc>>! p&_{ X{7SҰeIÖ441ҰҰJ3qZ: N8] {c%a8ְ0P ͻ XVWoš|%8|LnO3*{.=IF"7'T\ҚdXoc#~MFaN&'7Py9^:=JI<d}l6s_˔v6Sp;[l@EPgj`$cFy7ˬ|mi|RgCW\:5Ki0:.xn6ߘ:euOO>TL6*x7*}= wۨO|!-0d])yqZ@[G ,? /$81BߦBc0f$ɒز,5,5F$`$ɒ&Ο$I w4݇5 Ƕ픰 8)apa\ߨaɒxHr-*' {b!|[{\+:r}'J2B{K'iTLji_%7X2jkQx'Lm䮳7ﺄcz:p[Mg 8PO2H:[N\A}<&GWI[56cIe>TvD(  IsSף̿5o{A쀸߽Qm'd%u/ܖත~I6dl_mͧAڊ[r, 8M m[h^#rEԸ ݏlH!m; k'!aYGfcyƏTidu.Hw(_~O~w22[lpnOfPl+˭-Z&#IAYM#w(_~OM3֬ sJ[ ̶JoƐhT- FYRm/F'+G@6#y)Gb[YP0?h$C<*me9l{N*7W1?x/adQ$<ZxfxdՙeeܿnCVl~Ad? k{?b[Ynm,L#GtI$ee3^v݆b[QNOMGBbﰷ.b@\5 ¥XZ(-$,m[2&HRkL >]ȞXGNPn,uYz \A^`%̅a_,&Wuޗj,0Jт=XwFs9|ՁH>hbXP-Hz=Z/-ӆǾFÎei d`AfT9X0-HO =L(\ÊF4>3R4NIN9v:]'u4{96=h/SgL:f>J3L#$ǝN:R0P'fڮ>"ܭa]ӎtwITfbi9VΟa$зYa|dIU}'K™ ɒX~Xc$a Ó4WAfQaCV `B CLo$ÐNÆ] 1 VF|u`K9_ahx $ bE6_W_~Ð'beG8Ð-1:~a8Heae: >9F'!铳F^_drwm)Px}/יU&#:2vb+t&rVNL&muK{gW_->s{V| ݕ&vV>A:@z.qOp낎J(^#őVHՙ6F9lR C S[7wў|uc(2ݱMQVh(K1 Oy}W۟4" Lp0hZmDtԶXihX0-ԂVs@!Βcc|2D $+C 8Z/z MЅˈ7yO!B C;ܡ-Ob:/YFATop|!g ;B Ce!ސK_ah"unun) =mo /0d,St_a@ ʦ,#B C7cI1 Ot,E dI,+j6Tzɍ4[A8D[+AcrI w<CpG#HeU//~Ga}܇?|w?ongk~k?7rᏟov2]=Wn_%)o{=kSobty\}|[}y"SuUzB$ x%V5Vgn_kٮB^6B~#}YU}d߯Kaj[KE(ҔV`ń\ {r@/g3O;Yu/6mveD묨$NyV4I^$[eWc$lj~˿=,lcZ,lcZd?$Eda/ބKrOwaN`m{/(<}: F᯾v;Y5f L?㢬li*^]/7zu..V.(]y]PҺX9|$u)kX(@%w1haq<,rJn.C`ׇnsUw~س~;?̠h|J Z:`Q-dR$/2ZoIJN2nEfr)z)>d-]=Sa9+s]GyqinYVVbIiIp"{/%u(t 10ie-erynE>l`ّGz-"|̡Yӟv2uCy? Hbe${ا=Zߘ[/Bx$yӢ9&kF[GJY ^&AT蹍 "K'E_mO}_kN]v|?Z ޫ 8m84Eg^S=q<(;ި7&J_O=endstream endobj 379 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-Mscale-all.pdf) /PTEX.InfoDict 204 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 210 0 R >> /ExtGState << /GS1 206 0 R /GS2 207 0 R /GS257 208 0 R /GS258 209 0 R >> /Font << /F2 205 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 14618 >> stream x}Q6rh)A6`›I0in/bQk>bQHV)=)=??yY쟵d_w?=ӏ?JG7?~Z}yZߟ?%uWxJ\SZQ*^ U)k Xрs}Oi-k!~=zRT0󞢂⨰?oAaM G~=0mRPe BｩQAqPu0<+ǬO.j~9*( 9: tnPP<+cVhssiQAqTh'=4+w؞dA67s.2<+mVVerxVO Жó¾ t˵\`xVYa-g1VЖY.NOV;?Y~R>xG GEV~kCn0!7i7N Q#) &-w>1B>}>}>Sta8 ӈ8*EM [6x:mk~>vtVXkw C*^i>þA;aR?DԦz/e/}TQm0vیiA+/s /zrdF~>E<\` UUŅ]&(_}T|BYX?zkd]c"pUQyVf54Bkc9̓ճr{?2$qX}~ʜ2"'wjLjW}PdeԶiJ-2mE ߐ^(}+LM$k妺^|* `56OLW *b 4Rk#Py2Xm{`@h]@mTk{? M~d.: MTdk+VUg}FrLehUV')GzPd,4RUAWZC)`xި{([Cn4gu (ƈ|>ScPX] 2-QZO[wy&[9)uw)믃i9́PW]C۶%x0/ma  f.k!WA+J#vza|ҨW`SvvsaT0d5lyG{{:myGM8*첈 ;Ж O Gb OG}"㐷u!o5"c(y'F4Ái 8~V09FCǁi`]xh7UQ"_A+ sv?<=Q&gGttU+/қYn0r3/ZܮObY$ Lvp ẹ :CP^o,fHorþa`S%q3YA˜7GZ=Șu0OF8lytxyg0G&ט0s o,#'pe/<*5'TK_GM95Go,V5MrӪAQXX;̣Yyr}oC[ ]B2#!nL:WyPw ]"sDy?6@h}h kL*6&2'1m T% 2oL v=x&k~3 ~ON m~A )`guo]e["FCI dl0p_['K̞=(/ȴ(wγѢ̰y.#AF#ȀWUPF9c+HiLfu2~ i\,My%yhQPerB#>!ڠ\-n`:e'`g 5WXj56RQ. @\}BjAP;<];.r(H7{X)Keew& E=({gu2~w|0ɹ"?2hhdZk+ cYe{+ÕK1ebqR%Um;ڈdz߃VHX7 2UFӿIա@@ڻNm+ `u˦V{25+ ࢭ2Y)dV_ws }`*6BHΫfEEMV8 Yy`Kj"Q-yfvq|Gn[ QjUbj36L0;) UEKj~Vuuګz4Xy֍x>9;9/y5yFV(/C!]!^$rM[-c,ze9)xZ0iMcv2X.`B_ә'zɱ+-ped;?).C8'V##.glhX(@{چ-CْܜZEWXhаXyn0f—W線D"N{h 6[  k!HON04ne7y7Gt%[qn8~NQZD)=Cf?{@dc-0Y7ȱ>'`&@יy,I>v8Etk®̚[89Aף,WIǦ-'SB8e{dSRct t HI55zP˪c4{a9 &d8CpŎ{/% QC%hwx;ޯhU.6dτt<:{qEfvm/]# }KK9Oc/͆Ub%1.K/ǒAP}BR;X"B6qnwcrs.pL0e|^氜on0W|_Y5ێ>@< >͒/j23 ش|=чwrOz|]" , TrSO~+bH7/Iy(8/ z(;e-6|CzlE eM:(LE>b[)!ۚe٬g)hPl+)z_5_FϊqdDVrn2̌Gn咇|ӹmƕjQ~ڮ,tߐ^(}_C1U[l뱝۪re2 .m]sl+H5|EN`͈ƕ&ñO5CGm!O6E)^2ׯa[i÷Y/+;jeXH >b[),ڎmwfeK7䬗}_9+8,Y˸.B+qgHoԋrs,f cœD`dثnېio}S/+[3_94]UMqmmEY1ʦ;5=0߱1ΐ^(}q7F]FzA{KLD:~$=bw<mJX߽) ,ĥHTxȖ =q{ ;NTFʜo1ϡ9}}>=MɽzD݂R[7w`StFv0 vuDǠ흓w`stfm_]ch*UGu#AO Rוԁ8H2FV؟ӮacV󰹎 %{Iv~E7 Pu|mW{Ц$9M⻬c5>6uyUsLtJtJ55<թki>:u $;u OvvoB ;Hww5$Q&+d|4q@Sܧ䧮OF=f:O]ӟvh' $@u O46km@ TAcf#ǩmbCT@T4AczGԠ,pC*5xU\:Tt*!CRc$Dt/WSOg0<'k'&ߓIQ]YQ]ós^1|E 4UC?Wu KUxUU]cQyf'ت8a]m$ϩSu2|WeF85[ԙkۺ‘" Ö~xUe^a'aseI9;Zy;)l.t|Wz%UŦe29OϒK}Z73ef(0eAF+"KUe<9b<Ue6S<>]fC^Uc#r2 V6@ktRe^23_Y"+[= Ź.LBX[*z:>Or[[XHmǶ"*fKFۊb[)GP6sW}\85@ktfs'Z+;yU*P]nbX[rJ6ۺ/rn뾌֡|S[Ŷlö*By nYOūi}U坶; М \˕K@?W6M{Ehx!}CzY٩޷xUyXfY-Z} ŶRnmamAmŧh;8dY8d}W{e5sjӹF5% FJm]5^=+}Szl-^U~enPG[hVʭ-, =lWbL)l/9NK`Rl-^U5r2 9 >͏[:jJh/[+ذ&wGmū!}sY/9dVʭ-, c[{ol(k6mg?Cߐ^(umԸ:XO+ z$2eבxU͈'p`=S7;sw>UeC-}'q)׾KSɕ6XOz8Y뉔yՄ((a C"~WY Xϔ*ǨyU[`n_ΘKXOzJO8zz0cx0#x(;5kI?xW@u  ^UolVd BxUKUɃu|WlmUS>xY9Pom8P7xU f{oO7xUl&_4m"mUehW=+9R~L 9SB>RR&rmtry I^)O;y$FW,EN!'J!7*{L\W^њr{|{^)|-tXb$|h'}d||EG1y4G[f}wG+F7 b(Co0ra07 g(?|G(P2{  t0oМi)$B$\7n05!' :(/@=`7R5ۂNS&l/ &W'mAʀ7XM#𦍡Pha9")hйF9SHxl<qf/o068h9FA1`1%1 |4b"}Ix]Cbf0no1+>#:.lZ&•tQjDD9mwڅq6(̪QjAP[deª~JNK:+k 4Rm KrY԰ 4RVos]ov 9G} 4:Jc9)SfK-{LVb=i%dsx.UZCE:5RkXN]XNO{Ӫ 즸P4,5jr kqAwsmE&Qh$YyAO\U"V2 B]oq5.b HGEAj @9ihorV=u}B-Js]7OA |>" JOF+|WMz Fb$6L')Q.$8ҺAun#WyB 738< X'BopHpFœ۰\ۮ$ n]4i }3Gz՝4Z K`$.$ NRw`j`M%h0X_u8| QwgR 7d. ALk/#AʉJ&@{@׭ط[Gxm2XdoWnG8t7=3K J7xVN)::_`+HA2M}%Nkl"AkxڠYc? j]LPK6h묱w!Ժ' :kl'`]іYcڠqz5k?-cZl$Rc$t/WԺ' j}t>f-vǬ j] j]1|$ r8 ,pcӠ?0{)z{p԰oX QiÇ&VBCfhC5[ ta὏r 2 ßs\9OnA>Lnl?' ?O>K/eAfg1>v9Ekef3Կ !iR'O% z%◁7v# T!ix O+#jn(.6{ff'?z/SRЇ31ǻخ|ƥ+z:BsKNZe6\reVO+Jyjx*PBX{(7qc[&[?IS>b[),=y42k]-!GP6v{Sz=1~E7ŊA3c$,2/Ce6ՏA 4 9ꅲ5Xނh|(u}hʽu[VįTn{!GP6"-Q,^Oe4S RH3 >\/ MWlz٪mE ߐ^(}yE$Wtlm²@;A`nqۆb[)GP6bYyB>~>Nys``^uIvuۆL|Szl~EWv=/w4`[!,H+M3mwߐ^(}q-DXaI(9KKQ:O[^|;e.J:m{BX0l"&?9p3j(rk e~%;e5^x}CzlGQZvE=,$ɐ['QwI"z(|s'DIJ&39޻LI23 ֡KF0(M n a^?k#d8>,fxA5xq02Ybak+VysN!g"݃!'B S/]>!_-7Ц}~$;#)WlVy'O73>>䵬読̓WW>e1\) iSI|\%KmuP{ؑuzx;ؼ|۟> +bsY9/ikr+tZY]&]Z1W j'^xHPK &HPK &HPHP5kԺԺ'u $u OPK &HPHP5$Q&+$u $u OPHP5 j j]x搠6h^&HP4qHdB j]in\zun Ժ' NHP6hm֨۬ jƺ+G5SMD jA#2v!A-yUO Wu A^Ak >@TBHPK &HP^(&7`xZOL'ԺԺ'cx1 jq#piz pAk,A-׼ZUvK86ϩ)j)zWDW2 m!PW ܕ8Nw w} <|Sw}$'y:j} +:'J)vSy:|>P ^5ه~Mύ2iph!aY% h髤>\56 ^Ulbn>tn|3|Y j ('=P@5\'^h]k^v^VC&veZ 9ꅲ޷xU4񪚾9dgYC[[XHmǶXaMCOۊb[)Gr` ^JҸ4m&F+eve g ,.mCktՋecoRC[#m5*n5umݗCփaVȽr-^US.k;>$1qr!FM+0jm \QSūʬZc[m5JeW>U>48jnJ9Ub[ioplߧV=4s@xBW2,m'?!Bߐ^(}WdVY1J-֖` .=Hۊb[)GP6*ompȼtߧV@ktjiP֐\V}Gv1}Sl-^UVG۪U?Gm 9ڊ@OսRFn{- 9ꅲ_&đi2+wI5鸽f=nv9 XO/uF_U5!m`8z,'_h&XOͺ8*gIF]azOzW1X|}Όp {NWJѱ̫J`=uRK ܃K[YߕD]yU5l8PM= ^]͊dI|WyNNOlu|WdIGO𪚦xܷGw!Tip_?zS-By M~響/翾}kV~N>_wv|yȞaR?S~y"{[SΗEңv-^y5Z}[ͽVXGNFO>Zګ C{k&C/ r,蘞7F/ g?@hݹ"jOYH\&vyA4.g3_fgۅ.>QxhZϬESʖxu]/-F873{[H3SnjO cF~ccW5C74A?pIb?pIؑy~ptӁ!4CjLԘ"0в(}&̇O/߅%i✩۰8U}('&}.7()v1a $$ _Ac(|Ue7 $ ow o|_n^]_(x\znwrkpX*˖p###L1GC{/|_{r&s}AL>2}A<_-?h˱أ-۶|і`>}G;هK>h |mڷ_']>\K*Ǻj=M>Pgz|79+<̟+&GL:)>ϤILt|R|RIi?/AA3)?.yaHo5k_wz2 ӱJ/r !oߤɩ*]qb}:n7e PBXo9vsӑL6`g\zoiq(~vrU~J+ Vi݆WWQ#$Bq#ҵ*=L:IYXܢV|O~#J*#ě[R~T>.W~#Kj:niu=ˁ[>|"Y6._";zק_=s5h9y7Dv/-ʜXF{sL{hƵHX"D$,5 W#6,~K~X6ދjX.VO}3ty=oݎg_Z]x+\hƯ/ke9qtT:˭¬ :jr?ߧ4Wendstream endobj 380 0 obj << /Filter /FlateDecode /Length 278 >> stream xڭ=O@ p>3 H 1 eRZA6R[G!`(E&X&!NY<$Ǻ"'/L)5z]%y ڂ!BCH״&S4dS^Z3/sC|W sA_utoG0/J>9SYl o.ݩ Q$Ցшc!|w}^/w̝y3]zx$W_-)g7~HMendstream endobj 381 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 382 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 383 0 obj << /Filter /FlateDecode /Length 402 >> stream xڝRˎ0+|AJqǎcsDH $ 8d3YKy,N+ K.wW`1}vN1cg0ûx;gh=aeR-wopZ'vm@WJ'%?%T(_eml~U郟ߌ͑7Sn࣏q QI?/0wC՟|[T6O~3C>4n j}a$A")EMXۄl33L@Ƒg7d"3(gP;ٿJSV8EP4"u"(B8͊aI0n>\m'15ޞB^0O _X7;GUR҂%%w8hELF5z6ڱ:#j:)TOGȒendstream endobj 384 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-efficiency.pdf) /PTEX.InfoDict 213 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 222 0 R >> /ExtGState << /GS1 216 0 R /GS2 219 0 R /GS257 220 0 R /GS258 221 0 R >> /Font << /F2 214 0 R /F6 215 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 10393 >> stream x}ˮ,q|E-Kg۶56L7;c Jj c~Ode]>xgF'wǷr^|)_?Oo7O?r$N/o˹|ys_oXɥ|Vo]&'TlT`k8p.^o_9 1@0T9$3>sLXs@S/_zma7L65ƞfllM5Bgg+ ?%"K/'Ъy]J)WÂa[j0lji=ߟB_8sz-9;L {3G|+M#)Y ~9g#? _[*RGlVC.5og%n,S]6@ Z=^1J0ڤ T/LH }~p0ꔾ3 ąg gи֏ח"Lõ3Fxz lx1^-g?&6+- &\H@Qk}L{((NN?X./ 17&Kl,Z`{빢J}qL>1dc(ȣGm dQW VPnښ<6n@'j -%(Hix hU'4ge]kB "զByꥀ2zkQ))x U^ HoFz\u4G)-*;*V=*U|?{mn{ޣR%_GY?;uvZ@e,H53@ /N`\[ ehSmGpOzL ͼ\$%AnG^Gk?═ꚽյA]\u-ZVגί+BTu-y#t#8k0_p&dur҅qBVq*5 &"r=m/t >"%k^ 0JSZS˨?u]hmQ/E6/`Rc%<; ]^vs“JY³M^8ږ-*1"V=*+j{oc~AC-::yi8&]@@\fwAkFiSm Wj(fKR\;'e^8N#t]f~v]&\@Y.6"}ǍNi#dtrp'O<;ӯu_IҨ)_+_l_[7rn!gm5,^Ш~?}jD_Wl5|j(8.v尵w?  \v_`8rZFguO|mtXʖNkE_@6D' "SPkN^atu벻pwvnǹ7}?) >I,74˾ݾ_҄ ӓ>A^O+x u :>݊pML0õ]\eR 2JF ]Aer + {y>E LJ\wNz3RY64Æӌ M8.3} K[fOq'A#wy/;˝ S*ae$,vVtqz|`{sWg~e>8y,‘o_ɳn+]lɛ<DG{lvAfio3\gօ,l`."|C7XEa(32Ys{&ZRsS>(u+~B,&4R؋K[{ >5CӋ5%T?pb}u8*+-\Liݡe[#pOEz~.úpЏ A=\c~L <&z,ໂ#j2=~п->>~qnM&}cPBD@re{s!8ϡ9;"27ȸ6l0H+g؄i=ء?`Mp&CK({Bwms6C[>h1%c:ttc1Tc:̚*9BuI, YYmT٠P(*mj˰SV-JAG1gC~Xj I, YYoX"_\4'wZ)M–rZW mî7FzasEcT_8* Ɍ+Ҷ>%:n[`:7\;=.Ӿ/롯9uuk<Y]ta\Ɛ/ 7F"r?pN^[t+9)u#4Z2fÁ`ˡm2j2Z ٫/݇W*>8F}?w3_F:::w+rM/RZOm;Ԗ(~O-?ϲ<)[uzC+G1MQW+-V{e1x?eb^-ur& 1,o6=S잩dU=Sb|~ǟ}>`- 4᳏7 ~5q|87ǩ+9; ^oס x-ōSƉ&I'ڻi88⭀qUx4xu>əSzœ/;Me_ yo Y]>I7݇S`zΤ4Sj24=1 M}Ie~xORKzœ//D ~nR|vr]iU@W$8G,.W_eOl[g%ʍ)Gfgfo1a3odwƄ:1w+)\$ {H vx& ;<\a]jDPy1I6پmVS`[ceOklj (\ /&c֑l:=.E]jH>v{rF3 { mf0h mCMum^27dm ao͹q/0/Z,Ϡqmax6%C0 gr0'Ma#lx #!^[i+t4U|2]d'w1F Ǯm NcDXmvkx`\$Simm*oj#nxđ 0{D*) L w l3hi;c 'SZ?폱}̦4-{\~Cv%O1߶267b:M'WY,gM!uu=Dq_=Ǻ +3 2%=$`]DJ9ŸV sRC/VerdU;X8{7(o.7rouݛCO223iۼڶ+Ֆb-.Gֆ6ֆ<|^Fˇ>4[aꚖiڅe#abdn ё9Ve `(uy@pZYpϮ 6BTys9ŸVnZS^Gkk꺿+R\*K߫<Y]t\<衿EWp@hdurqsk>PHyJ90.֫$_nIp:c mRΒ2{nM1ʠ+Dޯ" _D3jr9%1r*cJllO3kx]>4uZx͐:SigyAys6rϭ)e=t_BF ׊ i5p)Uq"X[~oWLǴ "[YRƵr9et8)Y7K5UtMRJ!m+:CBILrqܓN!Q _2jè&r6!Ʀb\+9[F1B򄲵PՖZl5py99kUY.ƵrOSf~rUW?W?Waaܓk|KVFn{w5pL\-JF;nR\޿ܼ.kKzaM_9|[*AVW)o@^XwP.HИrqܓkJlӯz+T]a#+7[7l&W)WL 5XmP;4C.WцWpWh3iʛYoӥהnxM_+A\5io+Tuムxr.'ה@HYW%:UnJyz\ ByjZ#%f(+%U .z( ])o.gk2Ɓ/ F*`TRN.CY_$Q>J;ʛY.ƵrO)Sɋ0AUyJ9"t-“YUW]%e\+-66]Pp-vV$=!2Ztum*Sו\6čܓkJǩt-y55AAjt $yrյƍT"!6תGR?HPUµA8|-CU=9|1HRgNp rh#(DŽ8 9iea/CJڵVIn!DZL7\"sr"=͑EIWvQ8`H@!yt_a#8[UѯأiiJq'apX|\6 s+W'U/1$;W 3hs9#s1OL Wnj@F\ Q8cTp rƵc={~?zGB/\ROK,U`Kri\aw~n -72z_CU8WMW[>? _=:7TJu ŏ1={I)iod"@=>î=2]MYMPVSwV]{Up4weɳ&QZP^ m%VJ}2}!U8$ݡ;eb^=3G+'P)vQm܏b goh <4ģ\P#G7 EuKc{RTo:Man*Ew%P4ׂS8ףUOjhF~.Eh ϧG1MN4%Ph^܏, Z3<%Y)ah慧i;ۖ"/s~ Bazc4f&Ee%\TW4)܍ޏ\p4ںܞqӞz׋1fF=, ST8ףuE4} Ǘ:M碬 ~f>BS๨*9DOSC(*<-4xj^wwϾ =!̜0ezhg`!(HY*x&ҌqO3O5g|躻QGt4h钥yN{'Iy8S2>in7yX`H{*s';Gs˥. $[*gv7I/{ #᷹SU~1ʆ_$NӍə["7]pkr~Z~tǰuOZ+9>$z3ǤJ  ry)K0T$nOj *>cp8f TT\S GNOe*H)٩.=J{S/P.Jȋ(P<*qb*$ TS\R%YL:JxPNgJq6Iq}\I$`%RWuߐX 9 w> JјL4'YEBi>7$ |$aX@&$Q$ zd8H AQUX__=Hi";*gz4&[7p-˔ð QQ yT֓8kJ8x 1֙8 -Y05O-YOnpL #4 If5@1xNP|˄e0l&Z47mцX\T Mo @6p7K&4&Ѐic&|C4=qk6U=&IiüVKSfwy>p^ϸ'+l\o™t恋 ^f"4Mߑ7.;ԝVa&}Τ4ܤGc1hpևVnUݯ/T1Z\?q'iU;p5y˃k8ݮW\s=Pex,[*x±|~_0I}w8߼}󝑧u~/?Z眾TlA]\wO㏿8}Ƿ_}6>z{Lz< + óZn ^qT yXX<$( q<RR2`ZiBG}W|E2Rq r/@l? [YRƵrzhoqf9m4tv8Yo5;ػ5xy4%åtvt S .CIg_0D]qq6Bb\+ofQ !hҭ`' Uc~qNpӘ^iˇ1-V\yB~i+vQhQ`sj}h 3a,b ?d'6 `/2kh?B7WA:XpBDcq#ML!kRr%3(4̌p$2^—Yf4S'@c: kRN, 9ytj7HJ,~7@\d5n62vl к&d6 Yr+@howfY9dz3Θ)}So~stz: 0759CrҰʄim{Íms wQ$˺Aq5F2x~w_FF:F|ȿ#m?mD?~/ݯ/qLL(b~ׂHnY+撺gG>Je@3.?I6.^;R*T .CH,UV49LYGe<+2ی 3/quT7- 06a;a#w ɕWymU? n n5-`*1r: ^ x鹮| G/7EWe0>0njQ>endstream endobj 385 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-efficiency-all.pdf) /PTEX.InfoDict 224 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 231 0 R >> /ExtGState << /GS1 227 0 R /GS2 228 0 R /GS257 229 0 R /GS258 230 0 R >> /Font << /F2 225 0 R /F6 226 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 63912 >> stream x͎ܽ,n.8'(=0`6p}eD*#3"WZYv1(RC DI{7_o{O o?_ⶇ1?_Y?ַAucS? R~nԺ+'!WÄ o_4!a:@szcq%'ek~n Z%Ui([cD#s}iTVދ|$: K%V%l;KGRV6Bf{iVTd$5bߝF.T uޫ~/H?[ z[9n7[ =o_WwD E^m=4V (Չ\Br_:|:խ]V~y+ŷ_g{ƼT6dZy=4s爫V yȕ:ײ ˵>{פZFz5NWE]NٴjᡩMoSlmy;Cn.υ~}ԭ~+){r(_¡~)B g{]`(( Q½Wߛ n-OE ]0?l/ԿB?:?:eS &C2CW_o=g+-lYއ|o(>OT_|twV]UG<.tq魺`]m 0;gߝ6Cv=jITc=V~Ū.VxN j3Pyh2/VUvT D~rSPY~Ū.Vv:į=70n}H ⌈hzZįsHn-{c ۔N[Ch,lٴj{bܶb8X:)><~2;IO$:ͧp8I&~P#ENXS=?Ƽ}O!l^UCX<$GhUmeTKј\Br9Ox#O?luW8TrϲLn,MO\#" J ԍ|ƅ7: -ßiPdO2 (c+e tߪ(c+|JlMpKJ|%mlȂ{UtelEo~pq,m ptݣ\ߋvI+2GguY90t鈡3>+9qkmf0s0U_s_㰍6#S̺Uﭨ:>Ն$Skw#:ujZ3}{ds{rYY|9KU$.W:~CɮL\GJ : )%vNHMG՘ܨCy3Yɇ0wV%Ϲ'S>Q%@Ki>WևS4Ů8uAyGo ݭ2r"QzMN}yP+ŢolvZ\CGUҺ`+\Ọ}cJ,Iejψyn_~/_X*1>4Q2X&$m3ʬiMT܍`m0e*L:'ISyH4E_[&Z$_EQQ`ݎOHW8Fϱ-w*tei2ci4K4]YXZ,-'g@Y{Ӗ63dd|r2?(*Ŀ{oYvGp -%>P>* p6W0 {w?.1ѱDt჈0c"p/b6! ^D.9/ !cچ浤+IWd`ג2!ƃ5|oYD[WS2yNf6/hBZ/Z/SU^\-3N:H! B%8<>pCp7} < j&pKV{o-Ŗ'"dA&Mw[D"\}@jO@:xgxM\Cߑa@+rS9yoNk?|fsjU ŏ=7c,W CF¾XtἜƐt˿$~2g̗۠ 8KmHJ+!/G::w/>KW.F-dѥjѹݝ>2?/bz+t&wTM:~A]:ȡoä/VUv| u}H 8+/XuV{6=1ҍzV,PI~Ū.Vc>ToZ>It&\NP~PӅRҊX0Ѐė>!{ -A!ަ{lPar`G+p+|vC'[g< s(߅wwA2)1Zqw,uk 2 ֓G(sӆo٩Tb=#R,Nf~wAg% ucizoY6ºOHQ#?ƖG(7Pf[Ӷ6mmn9msVf[akH֐f[/4>yrhhغiiQZwH?kQ[Ƈ]INeV>p9l>BYJƞjtw.KW۠/xCgt%]߱H!NOVkg#n(/4uֱf_[~b1aQ)\KyO4_|0?P<U|LJol͟~:"B わ %Jz ^g4Q1Kzף (cQlQ6wM(یҟqZ  Ca(x[JA&LrrϭBYz~T.G S4/X*J,IeXψyn_jVVMu?cΫ '$%Q33S=LIfұL%I2ɟ:BɿtA)Gh/dܩWe r> :3Ǻܩ㺉OP#?Ɩ#?G(DZ,j,WVciՖRo,Re7 #[9U V#${Tg# „GVnx"N BB8;y%ftX呼كxzBB|RIPn 5ak+8yD?\̫ɛ・]hxM=e5Sߩy~}Rt|Ej{SG(vfm|(IԔԃ=#PI|vz=0d7/~?{!BB'5QtP\{bv b1ȇ ^|ywL.FbߝF篏K{N'.Y:*Eocq*XY8BL`焺yHqH4t`y`(c7X*XG(/t;B9^Dj_:beOyJ}WC=h}&KNGX0?$GDgc\~A1!%4(WxgwHCGmmr)ƹK8=!([B2pgfV q%4(:BISzlI6!,>O2#لGHwGn.ոOʟh#"+[[땭Znm%#Xf[Cж0>{ҳ"ʓЧ0R_P]*xO,Q=͊Ԛn'\$q;B kV:19>9fuhuֳS= :CS:>w[Poeй_Dc|^q}mm6hSm#Mu?B)#Bѻ'W]N\gPi|}#PJQDԹ5c2RCW}oWշprċjC9z|JsbkV)AV)yI ܆898$8uAyGޢsr0~ ,fixdznXRޟA]J56*tUI0j@ZPn"2%eG(-G(PdiRWΖ- X^YꍥX,R?>wRMkf0/XJ|dek)9 Hv#{#\7e)4> 自 ^n0[z6) *3En7F9&_k?(@rѓV$@+I\Br+zG_CǘeVl^엚ؼWx w?35Iǐӭ!5SQ3$W}qؕ6{cs>㍡N~U>&ϘU?٦e I.3 |8Mwg3_{ko| P2?!CFW UNƒ]D>VE~DGt42U_:".fA!&}O!H*&>N+XbYe+]9OxF7>'v P{@}(+XbYe+{a侎I*/XuVʞq,UVԏs5^N1 zEFY/gqRVY+!YK|iGbܾpHG7cy̓cy=DlvyYsֿ9%o'!.uƃ7~Q`19&!9tV q%4( R>zq3JoWNDBԉiI EA'XV (Չ\Br+__ǘd ?lm\UE2hɑ5UWf:WB\y٩ZCWzC``|\CX䳲bV jm0ZV\iZg8~"tgcd<,py|J^dۋFPH7@X4B7uY?yar[#S\IhO6m! oipCnpdIw`D7.!އ h>>POnL{3O5$_y o8P{h_N2r !Ȩ>{=q"I4̏xWKPkOjgx]> YI9πvݭy#>>ėi@W27"1ՠ8$뿞 C9Fn39I{v$Go#I-/VUvT`焺yPq>{ݒpZ s~Ee`.aLh 2v?s.문!,:#nNO]81ř2%eQ_T_W8ncd iSGMzj5ɠzkDZ=jع|ko:|;*˷ wܹs^cН-|g;I+)nԘovPޯɇ|}?K#‹fva*b c10%pP?D5Zǹ<(\zeս&K^A'(6(3ew't *92<1J @((Q6βs}` =rT5 kTtkՑ XˤsxjS:vDc0m0{މ.c6:24^&W)hzSysJ=ѾgZz!^$=$%dDZ$ F E uER߀pZx˺R$Rոjj!AX`, ҔgKMA@diT'ܧVӯn޳n&nT.ͲDn KnȨRj5|z7b\qԒK>Υ *O ?drrٟ`24ëF Kcg\(kprUm*%7ILlk'(—V>GX<+=ugx"XgvF&5ϺJWMzӮ]iWo5dvNѮ5 Noiל'ܧ\L '/>s:c߈:+]eLr uYYvxJJ? }t\>_UuJIxu/rKyϹJINN:hTwW^'=i7,8R +8ZCv %%:>1 KPU g*bJ5+= ©D\C8kL퇬L(Q2X&$gDu<3[_ҊK61t/V:24^&3R1f< }y[s=j3$UJz`VZ6͋_dR-~E'U/~kыZ/iՋ_e˱YzU*͖Ҝ9ϖ,v憥K-"X܄TJ aOMrX9XJ|Y%ɺ0ҺΖVӊ]>Ȼٺ~2IɃ9<  pfc bA\+c9Vg׸N3X)+?vn$jcV "9&<`&[l^!f93i,|`={8U2Z:zv`:zqn[/sezb=u!6#DQ # I8<>p7M4) }L =Ƈtj%/m 偼(W%N*' ﶐wwgÆHc^/LH-W5C;|SbF̯Cu q5Q3V5Jz<_׼l>sۜ*bӹZҎŁ_ }C/$OCVHP ?ݝ*!Pڌ)t ttMj]}Mwt͢K3d]].ww@3i @ګI{t=c>FG/VUv| uŋZfB3bV XB-'Q%eJ5(\ә}TCHRCPjb{Pe224^&yLƼ%IZu&~ G%ˤsx$x\CHL7bu,Se9iLy.)\ZƂ)H">( d!:*Z64nNSl9~[r7mDPhIt嶡%FH@Q^R1/ !cHQt[<C.rDHa`c2rȕz9HISZo[pK~jWGzGmhVT2^Jbt1~I/H2>O)됬+†3Ya;KS!,!̽1y^g]剼 ".RHhO6mYmr6aW'կz؝9B֫†!tEdC9yoNvFs3_<͘K{sġ5Casm.fwB+I#MtkjRQa "$iJ/HNֿS} =_jХ4KOb ]ʄӔtgwkknF=Uv""2jc*Xy*0_sBc\Br+_1{qxq@h+Em'bVb]uzI83ƹ-mFMr+Ԫli5sAdco i&I#:HJMFΕ$yJmcoճV I8Ut.ywy!;t g#Ȼb :NR Gj"u"GǧIGfX I(_#)LJy>ҍPfi"9ѴNd-HMo' ~"'u_)g NcN\l]x?ſGퟩN"Mf3iMs|]|?wʛcx:S{B;uSWTr&秘_0]B!KW1<3kJNﮭqoB.fr̻g#rSi‘TKhzj6lR'bUg]N`z/w3)R*/XuVʞO][.Ys':%W%bUg]DEbVY~xߙW A @^ ː:4!sfD/ /Cț?cy:46F6ÞlmUHMHML!WY$y:wOp2$҃~AJ<ƾfU|0T3>U:Kx;ʙ[dM#lߌӊLBBH~Ū.VvA>I 5Cd/XuVʞ fágsGLdP~Ū.V_"_7!@+z+H(qip| u,"P X_E q7\)uPUQNeU/pAIn#WC8ro}+;-)]Ėy~E0'ug@&U:+SDxL:1IEp|j=\u@Eh_E3mymu^ArwTDkCJz8 Z:Lj**k;DBO \%~W\IefZ[ɇN'Nj4էub\jS֑jX)2@ , ^1O=KDc zd~{ףsT3N fu`ZP`"5W=N+dCJFoxin: 56j ZгnSߨѱL%I2cgDu<7/ ˻R6+ "ܼVI2X&$&k5}?7Q9?|e*L:'I\jz~>iH :r,>MHV, Ep_7$.ո9kO0Vj/yDmigK/*Z𽐬ckZJ|YĔ:>(x.%#P]|Zxn9ynكG&?n[`>:y\Fr5eBH/8< !I re9=ȬձD.A9V2c1Fj9c^,Yb^ʼZ'je"[)pH`CXz2k֋n8^ԭv(Fme U{XݜȤC}Bw3ևtj;XWI<:e1=Mw[E ~$KѥnVC1YaԖ@N$DjUjob \?sߨԼtW~C5SQ3S?g<7fsm.mӇ 0_9'6ct # |hG~T_|twk[1g6EeK3`х]Ne>RwWwW[['tQT'xG7(}lΠor=*bjX :)f9M9j T28uAyGh 0v_[jAEj2e~P„ѬԨ#nK*nI*.˕̺9na7k]-N uX/!c;Z1/vZ뜵zYZ1C".ZZ1}XZazoujkzM[VeS빨Z/$z!Mj0-GVx̜32o#HAէ>O)zC!')&P5?h(̻QofYY '.SG?+$_vꮰ66?F?>zYWu;H~~'Vp31>ԀVMX| w?35Zu{?ѡQ;Y&͚S45my6V/֎qBi$!xtQ0YoON;Ѡ+mBWAM^mHZti5#}]Y[䱗rm61T(k'P^_un"Qg=kV~Ū.VVe~0_sB7`Kxޡ]'qꒁLm/VUvV; Y=@&$XbYe+@UᏌ)I~]` b,C9nԞP1!%4(կ }Cz.H)$h\e #ƭNGWЇqKhPNc} k)BS-j99ZsBSF7\ʸa\q9*{bX/[nۍ;gx[ײ 7vÍm噦o`HN3B(WCc/=qYI]ֱ\]qeVTvSe cQYw$U8 w̃e_NF'zdr1CO>ްwU{o\^?_F=M)[ %kqA2$ܖ6n ' @y3 oKmf#حtRl|"u>b Dњ$=kHl$aVEsTEQsMUAup|H" DGm).@\:(pv7COjLo- hſǀN<I&h5U}Wc('b@Oo{iѽm08 aUg-Ls VIo#p'GƩ.k6λ3& v: L ǿk+Zz{Y;c'Jfe_=R" Ƭco9lb jku"}S1k A{eBg<nUU[ix&#e hFXvIAb'n%gzQ@'#3nwM5 *g*(죠R<q/.J%d']LG w *] w1p,o;v ezÄiB dWY8I]L4o= ͩ*p2wH2s|eWzq@d>}\h=g:Fl[ٓY'({OxeOPDeϩ՛tywt8 0y ߠʥ!}uP y疂O'~ǫW^*ڢO@S-Aӄye)X}C$yh4Յ<~n5Χgp.3g8ˉϖ>vVMIM2( HJ_Gj*̤ʠ ɠ 9%3ǔȳ[~Z\dqTx H\tR&)bOKVɾܪbwPv[;QAV/H0嶲u% `ֿd{ݿ펱q$>tVf8T;*t-JҨʩ\?Ҡ"54džwt.Jn-b4=#7~/ToٹBH)XD3$qEAX44BruQжu4k*{u{Ј_QH>3!ᓾߨ.!QtA|6~]{cnrPo.SyexT.B66_J1fmm},I:a~1ANwzꈀ;}.o3a6I' -01"*NSsVNO)JNJ" #&ʐ#.rDVmLk奅bC.A9TH-ԝ}_jC.yq7+ ژM jݨL0@mQ)$\Px=%Bd_Db/Կ)'o'oW_ DQru>{./>FGjOˆ!^)2$ FgTK"tOuv|0P[s9X >~صmONi߳sqH)B%,qHIuԳ@{@M=HN4tAC5_:be,9sO uBBHw C{jM*/XuVʞKȈdŃrA)2enJ[ZՔ0~.b  5%$.A9s00ØA?ø[Q 6. #; es>ƲDH(Hr2V q%4(L9X{>Ac"Fs3A~mT2ߑwd `7xpޑGY_ j-K-pY[{Zh-hB 2bڢH6ѢІEtJ@, mXw*~Xc7rse.2*}?~]n6VqD""mDJWpȋ.sa"M}R}ݷ"۰ [ɡ~o+,@ifACE4seBg ی9]kTw#F@JәL~!\ TNҊ0X r,p!16_ \vG5pV{ݿeEAŢX b1vf͍{*" oHv1h2z.FD>Tw{(آn.j9XbpSypCҠkYS-=j i5A}cVad3Eº"d4>J=bVͯkύcX_Iu>;/{ h6DCK)2b!b[NGAZ9pI_$0 .L%.%9$P+˚䶟 ᕑkhEx(L[ O1n>mMtmњ%8uʘZ BU,#"ȌErBa/pĭtcdbJMs0&IbR:/pwIU)xa@ڧb0aj($% Q & R>:wR=5C?COLqwX$IIyFu>dƃ7j.|ɛ!T1.V-)GjylÒa |)ؾUJL02hhtsBF0|bgMZ'$|`5H~Ū.VV%z0G})I`0uTpڢ6|ڶS{]= 4"y2  o MxЏq˝{sޞxX9TP<@'j;W(HiNR),zfe96Q6g>L܌9ft ^vDXviGTUvNT;6QsAF U* 1QGS9s"8c3iFjhVuh~] w1='pУ n)jd35Y]v1h2z.F8Œ. Š4ZDȥZs5XiC nlgg?b;Wq8|#³8ZJ k 64ֳ_>DfDv@S13\M\h(\?mCA?ZP's )on훣H mkfz< yMD<|_SV/IN"SX3„~R7A,}Xx yQa0PRn$)}G؁D~8= soP֏'D-J,*XowPyW>'x>f(P2?QKwn5'>ǘ27goӒae.WO`Hܦۅw3D)kOv<,̳TxtwzMIR{}m7 6g  yc8呬+G-8YwIڵGC߱vyX*XY7"0G})w@zUFRCmtwD;n_:be8Y1x N i*$ԔAT>JS1'lѐ/ xGwkߜ\sY*j{`"e@su2_⪌dp8ZώёoZIms!Oˬmm=iB`~'Zc K%5Յ<Ā2 ._ j-_XV`-VAS4hBmƢ5EUYT'|gw3dr}g7JBcǯkkֲ?ʢFkӶR8X0#$ 'd}ܗ:tt>r6 W4냺k "\,{dPYotך4W6[)RϧURR({R"_pdNiFZm|xn=dBr}jp[*P-rL'cFn*T]UP5PaJ8 6'#$f" T$b4=#]πG=O^ BT']$b4=#wfL_㛽2[0Kn 1#CZj1#~'j?Q=fd19x̯h/lV.Y!ڳr3h!D?k{Jw =u{oeOles% \#O(yRy0f *h*Şd)؋ >^ EGĚ(C%VT.-BA(#WļyK| 3p5N \L\b'K_v'XVVloM(ΤճAnMǫ/};X' Cws;T;o.n\јf܂\AH(RU2m}Sg;Q5]Aad+ʎ6*)P>L8zCj[S=Ցs 9'ܩ .O] u#5' SΒː~0$'Ŵ>!6e=O$vB3D6EO'@wĄ"/[it@uBAA:/;-o Ԇv$07Ub*XY3D`SBX!uf9-{hh[!*i]9I\DCr |ۺlƑ?mP[,"Hύ`OrZ#gpZP'q i#?!'Eàys;Z= 2nIaЃ( Ҹ |⠻ l 6Gk8KxWQOFX O|+3t-wfkjx%{V}[빤 Ha-01dA4{ʨ_y?#ݝ^#nrN%+t;3\%t_2gb8!6o]#iu/Iu"xN~+X9t;)١gÿ>ge$tҙLH6Il;S]|)|SA|" [t7xMmQâE)[R<,*ZTבs|7+{ 8fKe(sdØῬNsm{k9+ܓHq - M}yD,FLq^,Y p7x5㔿:u_MlW8a3Fk:w]iDu7ǸJ\Q Uը8=*FU UӨ#Ot{ӹsJ\] w139ƿAz*s0LFȽZ.MFȝ1ppב32i#5S32]@3oQ8YȐ@F9_a^sġeʨH f'g>+9YG}#;1qX}S4g"$hY*P4R4*tIJ6 x?WҹѠjs$3yϒc|9Gbv/GUРܯrSp r3s8 rc1^`2@Pb]TcIc鿓c|H-Gc93ω@jX/xgSQ?Ql5#O4W?d'v/)}*]KܮT=y汆`H"TcON]Ggښ)jH?4*tgvXl{=w_:beus c!oUP\1/VUvM=nJ5+AV5% 2\S&@)!syYjr&X?¸9~&Po^=1oZȕ6Ъ㥸^_uu~Wyq!I4o1.CrhX &}ro,_٢H`-kɐ/3REc`-eEq ,wf͎z{W;~{^zQum{m#4=f+\UW\bI-}B}7(} 0"lgI,W X_92q+&cqIYotz W4KU4MNS}dǼJ3Ųkҫh(򷊑ŁfմO]iDucl5EQљA!T~ը(߼žèʙLwٹ騚ȡ9#&~ c*Xپ{*0}9vPWBm;Uj0 z1k#|=$1k$Rl&޼S >\V⣕ڳx@Aמ (0;qq5F<Q.^@LlQ/zBX9|S:]n:8ugQ*wbyg;fo"SSeQ&&oe$j=O=Õ埌fyMQc;)·euQiiDucQ5gQ5Q_=V<L*Tp"XP{)bs7e]&bF|p& _g3݄09[ Y#ta6#շUCs#xHL%3ζy'PbT=+ݽ34q΋ >Ru ^V<) Nq#[ك<Č274=st]V4qeA˜Zi]Ժ,uYe~~Zi]ԺLb۳|A_ТkZ6Nm);å X}6^'6<1CɊ(6>YY'0<5yG/YeiJ˅{5u^<uJXhkakCOSP-LjgDKY_,Q[^/q14mΜ߄o|՚n⛻ț 'j,IbQ+/-GRU%'΢tO/Wm˺дv|0HƆ$H}T?mk񰹂-%jӞl6E@@,~XTFkQ, "E5|ޜ10Ch-o31Wد1!*}Tfm=pוE[ ;v R!kԅ 2.T)xK=|g_{ ?(ѽDݫyC98ڊA?:u \e/=+ݍ̚ok[/ҫ[-"E4g%n6 &cbo}9[(jlU=߉vLj3UM,u*5sWqq&F;>P# {<jIKء#R}wzke (HvEo@' $áUF2i"@QS/ȣSԝ@ f9|| M D~@俠N rQ_ .&t`)9wjK"gC܂}:=Uz'094ǭh7+J׉oZC(;q;q;:ecg)·^&ihiDucl5UQbQQUoQqwETq!ٿjp&K߃ȡ5p r5<$/XmFŊTPz'$V<%4 7B*+bUg]!Ws+וTC2 ` 2^3RQiiL.3#(|&$ >: w>Kؐ)x%:$ό>Nu!1+gme}%>V[Ag-\PD~[LT4EB켃T|ػLJ~C=d멺PF=yaG="z<3fFbi's2946F¬ߛ\WSǷ80V {uu؀zo_4f1}ʽ#>oCj+78kK_ Nr,׌!ۨѺDRi(ѽm`oMߖG%%p6J KUCRZV%S3ස}cFi@Fi;D/%%^AZhG%ֶ{6lGZ86Q +y}"BtoWS?]ǖ#cw/=4= uSݎO]H'\$qr eX[S>%x2l!Y<kkR"Q9M|. [cl?WFwek36ck[9j[sm{5nk[,}>\L.>\L.2Jp!saJ0? gZŮm{Wfck6+[5k[su5غNxY1F=Lwչ7)i&N+n[}[0&a3Yp9]t{m=+/4&:ֱ߷dg=hg*|ĕ[ReD)X; %z9 6̊/hpSZǹyP[n)2e2vĄT u eBY'~FYWW(EyxWa "-!xDmP6/ @lQj@ZP^S{Ο|#s wo_00> 0UֱL%I2ɟـW˭c)c;op;,m+!.W Q9agPteK.:ƭcѦOt;_9~ՎU9'K@ʡ3]$qZjF=U :{ b6dِS &{S-_˯̉+i}f;|KD)KOn)%U#,ʍnl,^GV* KRj 8Opt F |O$[nXɇUJȒ1/_ULiw<3wı+g^"+a2 w &NWPز ~K[? 3W胣(c+-K6'q&~@[]Ajf(xm 깖/x2R5tok 8^Bpo/}av[>\ᒴ-MQ pڇG>,zãcfrsl4IWV丟dOq%YN} aSvuUi(>X\(] Fsc7?V{ ՚M?΁_ӸB٨+?DZe{ lК1=ܶ>Rz4(t4coGC'$K 2"U-)[[t.W et( t/uPv2n~Pݣ4c9tX]`=628x, r.#Q1ّrd,((B9<ژk@C<P' D  #ad\$?yET|=+Q5-Z,H;m$FW/s9as=a.suÜz.=YcN>}>ML$Fwbc R\$Vw}Ī `RlF`HNI+Qe/ GE6PjI j}[~OߡB2`m\hB @Dl9͗9?c-#9pƽ]v`a?46(c)3#^;kiǠXƑrBؖý]>Qkip+[ ʖe,T(mSl阳? po~]^zK{Qb{?C8MAým2i_]`&lZs?H研g.'JNp+nkvE7~Ɩ[Ixz+ujxҕm-\QlvyJW+BwvEfwmS5DmkVh[SԶmMU:,[KBؚýehk25k25 ~3+wpBzΦQ uOs:x~Q OrRvZ=rlcVQR<#C3p5،rVQcpve{uP>#PQ܃Or AWF0LrjִQO^ tBvBYEYE0aАová!sXzteQ²u2sIdL/~YL2$pr#ẋ˼SH4Pe hp*OD7d:wǏ _Փy1_Jܿ*y3>Ο|t#l11d11l1j1iY#7*sr3wWBtp'zܜL'7ܿa {߸ĽV?S?'zܜL'<&nd`R(0$e$n_5Ԝ>2܄H.ZTbV< ~VqF^4(1%f.EI{}-s"e}e{+8Fҽ#K[Ж-vґc-ϳ .e):[eWoS4kPjsEڗmwoR<̼PzZYZJ˶ *iꙖbXT=E]vg?NzjQqzTc[u7Ku\:iQJuyx S~#5cǙHxʼED!wl7vƅ7q[~O*/ҽj[5KlMJdkVlu^\R e+0pڴi[)@lMZok  Tek ^p7>܍wcjv[l-blmq_ q~ĦE ?y6G~U\dB.%+,i7q:ɼ &_~Zp2{◼+Հo = @Ik47xK߬ҷXx]:0ҁ)_|mّcjYc^]"LY\P:~y/^ʴ?t[Px(SzD^r FA䗆s6!w67.}>a?z8-n}ҫ?xpSohշcPha0$4e^Iw#zUgթBr4vm{uP>σN*YB٢ݣբB9khç'~4lQQPJw/^áف '~'~<}2\l'Pg(/sHh!79 {|=c璝o䧾QNoo&__(,knsB}'zܜL'w!N]Urb(XRjI3)+ de`[(׆θ,^~Շy?,QyOAqvx#3e d-v~;A^{' R&&JaN ґ#{KGֶp~xo1[N[{'VI71eάe4RJƓ`ٙ #5ui|~˔Jb FE73.51><ׁ_>a1SK /-˔$S+u /5lθ 2L*l+N!}3o|>ctJwNI+#st?ŝm㺵/t^QzL_6v1x.o28 g +$vLvMe{uP>ϳ4UiGN;i@+T}HbH0{85 b) B" zov,գ,UȜ^les(nZH74$|7y$M(rT(~9?ս>{s jhOI%ֆ[Dq2ntw^ճy1_JԟR=|I,ܴ0fd\$Ǻf $EV n`|zɸ7'I;_տU21'rܪƌ=nNxw2dYh:j3$TZvB7d:wǿUn[dl2 0}!T&HvK,#a;> Y-RJzuA-_CStENlM/+䁔[=7{' FJ(Ud4@K,0,gf-MKapwʮV-vg*-%ȻnZaTQYJlk */:{zQ2Fwyo{㡃//{/Ց9MW2j8-rFC➸/gElMp+BY7.ոزsmįX"uTm+սUB;Bb9Ge} 7+ZyފnjbpwOsEڊ**[[֍-\жm \pwO O'Ƈ5Aۚ5WU P·]l=`Cۚmk:жZx-V5^)΁ un?y~Jk2Oevwe a]WᤓU2ק,?ɼ &_ xWLzx#%.tD4er MG:ԧT7=\֍Kx҃׏p;?Z[b`jңa=I!-a L:y_]ħ9Pe{uP>ϸ/Ѡɣɢݢ6 %ee;PFes2F/t/fvċ{{IS>!Id@*օadN,=!]|Q"QΤ(\\Cq}Md7%UG٢$7d:wǏ'~_ճy1_Jԟ*ˊݕ,fqs2Ļ9+CCa11`1박$Ή_OgE X̥{JozܜL'wNBYŦL  <*sY9NJ #P:7KAl!ۨzHsV{@ey($턔x5n>.=fVJJ+@I3;^/8)x&  ^;)+J/r+"[/ j|]l9~vx*ϱryR5)p4O\bzVrW> $yQ"Q6J,~Y݇}އuN9NWDlzm׳CI) =Vw2nt//_~h~+ !(чYd9J>}M$Ή_/2Vt >ȸ7'I;\:Z\M rr'zܜL'Nʛ'P+ R7 ԚRK Ajrb@QkL2˲e7}[}?K?;+v`-xT,C[:te *AǼx -&A Mb[މ_⨸9E[]qDAKd Vl.VPkn'\īq{ӳ}-],Êdiio7)m wHF!.ϴ7{t`{8ӠmS(ۍSH?(k)7N"=jܛ'~GÂi~+Y4__jgj♟D+ *\$afaU$N"2ָزq-m'[̐ W:NekaDz2R:ýywmmMZTokִmx[ge0l=nk\=C:\Qabڴᐴ} Zܛ'~r^E Kb 5N2и?yzJ2kLJ2灄d2WWdB0Nm &_ۛxz5~?Sė5Da%jr_F:}xՒ0יRk*PWّ{UݽZGSܿ_ť#8=枇 ?:*4sT2) eԌ~PG=~'x˳8_.ζQ wң|wjI[_ROQ_A2fo~ho~.>O{FrQn pJE@ꑱf=;!<=41]ы/x:|hQR)22%ա ''ɡL'ѡ/'ޚ⭹',ʈes %KVO|'gsMtJZ:qs=nNxwp%Q=^g_r'~<)/V2ntįa'a'asp| ~6cqa>Np|8a>ot%l*jܓ]&Ro3r2ntį4\8jXe(DWgRWT zuB ZFvyocoh''~*RD[(XRvb-ͼbFiKvꖢ3+5{įS[ڋmi-ZS,޼Myu"(c)qo]vxo;yo3;'{p`wT{;'ߘ('QW RC)0|rR; /Q {$ 袛 j}[~ ȕ<7f>Lx NXNpgCh,[njzsg$o-x[]lA:umkl b(^Wy 턋x5©;utmVh'<?^cҶm b]LN\p L ?y6G~U\$2#[2;}LwqJfOV&R2Ujlej OjK_Å7[ʽxS~Pf;_ܗWǵo}XS:.Om_耂eJ S:`3q9ֽ^9wO3Ϡ ,cP5O/qtjt pZz$<'=>k<^ꯖ7}g%!GQ|twѨ{J=Q {>rkͯۋ/\=OqgsJNt-= &֓)`h`朗*=fnU tފ=jb4Ӳ*8|4C󀂡'O BOFY8)"&Aa?C+4S!=X(k(s(s(qB9vꉋ|{º y=q/ӮPTI5On`&)'C).D+巇vP^5C^K D 'zܜL'gx5Q=^0g0:a'%{{Sȸ7'I;_տ$$=,#[ %=3PS9GkơΛqs2Ļ ʫ_愀r+Zʁ7,s:RjIőxʜPzxZ"J-#Ipc}ly}GK-kiD[gLM3(Œ(m, Lji(c).ոwoiIҔ)yKSҖ--di36ci;Yڌ */{ C/篖.xXJFvwiF3N4NQ[ig 8mqڴ om3v0Q`6I <V'ձL*PJ],늼DlW:?F諝M߷e#~e✣PFIlrQb+PVlg[)m i&s jܛeY s۲umV0ll .iÌ> ihIJb]fwyѭ=}xvT]^=7 ,NA0o^X>bkaJ(c+/[m5gmk֜1;[_((o BC< }Qepev ҲLAZ89O-Doߔٞ'~L *ܭ5˾ -EgL,F:}x#\2V: 2DD:2#D0]'~^UwW'~ս:ܽ:Qձ]El4?HY?jY2~'Nk2Q/\pTz2 įm4yuuN{u7Fxjo)~fNmQOV7961cEԯt{dL&Q azHEp Ap瞙!yǐH9No~OF4ƔIK9P ]>.q;!/S [/#>>k[w(턋x5n -Ooh'ߵ`mrm .2&'-/KDZK" !2R,po~]YK;DXۀSRfvF)dTjSN .e{5v9MI{oH{Cޫ"t{-q͌Ӧ-m j63N[:|nzYڢD{3;8K ]eW1VX{Hhz$-(3;ByTW|hO o {H-J>uPbPemmO.|p{!(N_2@ i݅V2eO1]yM"ˊS~8,'L/_P~2m@cD0(,zܜL'!CYiOi.r-HkBӘSXc&7d:wǿU\O sCw\]}Q.i8"ex8G֘t#sO'OsOYZ5蹧/12nt+K~1R?-?zIőy ]s ˎruS;"^ocZI9ΖJL-A[F%* ]9 /*Ad#-vEVwu4k ThK{QݜXt~{9njێpo~]܌Gp~x=uVf4w&¶V(3sEc_y6G~UuV0Ŭ$zdzֶg'p2N^UD&s/yY+AD ?; /}KZ:ȕ蠢VD7\Do1jiX]<~{^ewWq{YNG_ӉXsMU*rUrm=~ǫPe!ζѪ'ê?E-. _S6*욻?XihGS6Zn)zU=GC㇤;S%xҀ"AD@ϽƿcoGyv2g !4PPXMA eу9~X((*?t/7^>DPPPP5a&# hk52ntj$gkcV000W8a9d11 =˸7'I;/0'{C&A6 }{R%g}He$iϦNJf%RdJ-#q;B^j-h'5~#%%E84qXKe, k?y4[bθު:҄dY=.OhcXK/hw Kخl V_佇xqxa77{{po]vn,~K u҄bi1_^726(M(MJRO GxT礻rm;sD""$S73.51><ׁ_i?alm]TlbI[m!^@yDxӬ-ҶR;B^{/+<ՕY57܎/[6\\>բ#}y X1 $ۚWؚ9QJd+2%!z^d ]tc; \xkkƤkL~Bɻk~kz95^g;;_^Ta ^?(R*ʴ?OKңvW#%eD=6.c1103(\pw;ϘD N /S X SZ~RlW *ɏ8UA8A8ɏӮ/ev__}^T+JW0 #;-@>*Q{q % dco'Dv*pMƖToi'e![[ $^dVDlvxruN@[] Lx(lu髐؆Tx]lUՏTl}b+YBJTKBއK5e\Sźez75>oQ> å;ܛߟlhl'[5[֙ Fa8apR=QXrGFDC4=e^ej.Rvɼ{~Wl@ee;UgU*gt2/x"s[c4_Mz?ܗWǵoti\;a:ik#;;֎Wݫluaul%1(DFW7R=Ɵ2Ϊהz9'A̍NeFKgѨͫMҏX$K=U̍RO'<ۦqU~s^+i/ऽy+*JU [Ko鱒YQj3iA?WR#=gD@}#PP&S SF%BYʺ}31ԛMW JNPdQQhQ_Fz%'UO'OO'/^eu( P&t/&bյL QJO5IPle\$?z~IT|=+a'aN'aNst)e7G|xa8p|Xa8FWs?00fRzZ\OO0NZZ/fK<Բ/,D0 -9ܔmly -$ճZ( ҄ˉ-Cj^F%u/( MW$fCZFVeqxKiГ:ಔRhKS1˂nT 5ׂnڶ#:[բ{h77{{f?hi2ϔdozFQW3Q<;MlTix[cGW`yڑ_.5I7Rո7)r SNWX¬@uAgO*3#/Q+U9_t̋YJUκ=rc8}[6oi'_rR>Ho,x$vx^\ E?. {3x`msø+elvn#i[焴l ߒý]Іk2Vs!<@[T9/T`@[]|G{3xb𶆮,+W]е1x[zXלxI۪2d"HI|R< }Qepe(UdX\2 -KL NU2llouUR|yWp< /ʜȏζ#&7g}2:K~ߥ/(XOZNnq;]xCt^9;<6j?W5?+-{Vdϩ\U?ȫiTHc.WWH}qI}pVhgscӨW)|=*\(zt6gO!tsIs|K3s KCv,fHd:wǿUԝ??7pܝ?7ϧ`u߽܆`A-GfH.onMQ [/#}&0ذ] v"^ocZIPW:Hۀ띣ڰ˛ Rlci[8XJ턋x5+۠ JkvQ~f9h J|E[Zoi-ڶ\ﲋ+RySAk_Gv?i +^hFsy~+%b\g4D)K(,_YT"[R=njGt1NO5SMSl80|!TSk56Wv-}+[~ vek+Z.ϮUu}݋f T<.Ϡ7 K[[Զm- bk֖Mp|8[WWE0TW0txamkgPNFck4ƓIm 55mkjԴ9ܿ/6_CTYd%_ &(ebe֫Z!fmWi~#D2ae˺~! _6 p:8'~oѭ}\hNGs:ӱYtdD\сx ~TP>V |tPFQoWOjj ＲI#sz؏[1R/QoHȱ<8/?P:s)_M81Ƀ58#4#pO^2\kil9ֲ̑ck9Fù02Pge^PfUJ=эSo i,ʚ<ʚtIPbQʆAEy`vo4KODGOěC2ӕgn~)uCIWTI+_L(6dPtH0x Iqs2ĻׁB}Ȕ0<)Iqs2Ļ~ObN7?x^,sV_\fot9czܜL'!x i6sOz#C~Q9NBPFx2ɄW9DN?Thb-B5-\I-|+[6oeУ4@AS0hk)g}WubԀ˜sS *#9NO /~OƙwE,jf8N}s]-[B«qBwzQ3Zg r^ޣz]g /pp)B 8ͧqj,MԼXZdi1po~kmH]2v 8`O]?!Kʆ|C*ܺjV )j}[6oi'_leUXWf0mbkUvy32_u%PqeU`NW .<*[g~mAe+3DlM]ۚ5umkfwylw>'kYl<@[mA<0lgv9{;B{?k+/[FuU)M0.)Vj# 2N'mgFJ `Φ ŵ?y"-DoXf+nJf8ÒIVm2 eŤ}l[2S2vkwBAB[$c Cs_^׾E<2#.R# uzHGLLh#`5A-;#9;cEGVS:au)ъ1iN}>kjv2•9'Au?rI5*QcGr+ϡOhSETj*݇>/JYC'>Srē:ZE˫5?}e;|D㣡qk+ dZHp"12X%{kggz~{uP>-)ưRrF!<,aE4 2d*{~ցLee%][(BgUT;$ĺpM߷i -$KaHJq@/4AΌ1ZlgK(- pzyC6FJ[턔x5ZK/w!/KTRl_,ecwli ![Jb[VWyA;yo1[xo;y0; e"SP>8@Ezj_R$+!4/E2+KB ^wQ _nU@qXoj۹3[!5[+vz2oȎ<߉nj'\īqc}ly}O[ʲЬU#k[GB;BbyhVnWmM b]^Zdk1ǶCۚm+*[m[ɇs-湖s-I-kpS5";ibMm8{[l׫?KyͷܹS0U1|B'<ȯʼDf/j%sJ棺f+ [5ΫWcK۞d-R4z7[BHsw./}k"g#|mќW'ï}oNG:}[ǃ5jM\p6ݽқ+Glſ]Ո?j@i8';K2G$5JC=~mQOIizHlםqW>WtUws_ظ ꅴky0G|V;68E{8Ċja{Ձ-ӝ@}lP?dAʄ5B%%Q(2+pLK {9EIiJmPQlQ*?%Q2ϧ''~'~J`.LeekPCw>O>Ei8W+%ɸ7'I;yMT|=++09Jî.%?ss3v2Ļ>'z| f3pk \q2nt'2%G0 ,LjQjI3yj)ˇ{o ZFvE7~ǖgw:y7m)7WFhFR;YBHlmi-ưǀHiKƽUvegiBdiR.,WmwvZ,sQ,XJb[ NWyA'{x$1kYK{]@NWO+Pj}P}AJ[ED%>[&W<,ف6nj'\īq~S]s($ '5pLxRhiy˔$ Gu6E73.51><ׁ_\s[YP<'xdN /StfVθ 2 8VckmS*3r;BLlm+^H-%vƅ^WV*ڠlv5vmk:):fJ+Pb5%{/|a9YLʇC> éjNpVV`D6PVl_>ýU~3j>4SIsZZ gsWe^E"3bW1&1/2ٓNMd%R(D۔Vv|evg(3`@g|d#MG4לi}%~eP>jPi5f ez(gʞP"mPsɗ~C2#su1u~*+Ϡ*TѠ`ovTX0ȹf0BGE'*$5o?V?8=?k@ D+ 3^KC֋F2ntw^ճy1_Jzf 'w2ntyyBa{15D7d\$O6Y'NZ1 oq2ntyW͐ڟv3gT,{ܜL'we_H3hYHH%3jeջLfDEl_op1>< ׁ_(lXP,hfܾ{ {e1}!FFz{'%Lb),{9,R;Y3[K Y.&>ϥCFsw{o1[֓VE{JϪ,U @꧘te?*=̡,J3͜z\RvDmi!fjUJpoz>7_ɘ-/It^g @>*Q;/QI89'Id˩;M턋x5nJ6lz~K[?I,+LE/kamM3!j!(Y7u%9ܛO򶖠mMAۚ5mk t[lpozVPN>GpԖrf|n'nƇýYZdk5VckC?ϕz~8[I?oY! 鄆tiz/ʼLǻdBn%J+*Pv~wĴJyY2ݮ=8ۛ}ƯYL,´d`絯w\0N~K}\!/}k"[DfJD[:O*5Zp@Ut*{usTJN2^:A)ع0)判yBH4R+xϩL¸4S6*FnUT\b4ڛO7ߩ?N׫,>S=%\]/ `Op\Xa WXyZg1=E<8-tiHk8|4[ %Wy\(B es1 %%8^('/tBvBYrB_o??NO'~&qP]0P+!v fHk33Vg5 "ZiU 0p*u+zܜL'!Kz66YIb̕^ʸ7'I;Ts?8p})g?;999;asrwN%X%0;߰,˸7'I;TUaҠ+/44,-Q;/Q ,#9 owXdg>}']cv)4ZI絨NKZ/ w-s9Y?R}8-TR}:-'Týyq-f>|Zf,wPO ,pozV^FLߡ%|PRxoTޫpvަ@lVg^&j:#uZ$}گټ/ER>XD՛˜-J_w35Z>8Eg* kxrG0@N+x8}==L<>(/p1 z4\_~Οo?\S_wV*?m[1?YIF2n g1ڑT!t>S^7,Tm0>t Rw(ꀤHiNK{hyل2z4H;njU܁WuB: ;̒Xeu@RL[]dnBԚd"Ǎ[ae>$@e+z;@Bq+!>lw76R8_˼Qy:w`>5 c^B8bz GšlQ /zPFFgRmyg>P!A/GK$fKDH?ߌDoQi ɾ{84m8K_,ʈm6O5 A[߬A@O4PԺTHĭin+3 `o]-TΜ_mu":?(Mm[x+ު&(vz5zuR6/>e;J̨m/+ofYaw˫bf+jPD W`pP0PctPah@ @m>0Q ĵZ~knI[%q-T拭!a_׺)&0rݜ`٨d# q*Wڸ $b 6ZWuOO)_(+2.ysh IŭuHBp⋰MRZ )o.}/?]/x1o<>!A+@|l+ ۞/IlQ ֗?ʮe~͕?8Y);&3W~~E凪#"7}njC _Y}~>7Y@f sC0)$L^udHRHmxAڱ'oD Hۖ$/ˤ9:h>m|$k1v fVN@q`gI-[G^. 7 Q :Yzt@ZtyמKU,߫foVv,{!0|%^; w/@-ABR T$NJ/cO|| V| >u;l~z!?AA73=A s XB3A0 Z )o.}O,w TG6ZCjp'H 6Zfº1>$幭 2bm&W~~EgTK d^/_#-/=($BfLǝUw_P`q"'#G/> )iwͲa͗/$}\$7mK'O9'Y'ܫ^5Skn>?JĐއJ$w-xt&:|Ooұ=}BW0,ҢàLt$\i^ 7+ [^B`kBt@鞪J-Ͷ߬8+nyi59ua@9z=;f(aIټR+ćD:f|q{g9TČtr+!>~翇q|ZfhA&!U$2)`f AS%J:ºeO-PgҏyNt> dW8i[sr{Y塲dop2[" 8{@d˦_ӿ/||%%nN/,t]P:$5{c]gs5sus2sgfoVvkys/ Aٽ[CmP:,n6 '~XѶtXU\׳ mJȭ҇|DTJtUE2kl%4ȧ"NVĸj \88xɱ6Z ܌qphT} e\θ:=yX\ځ4B> 4Y;$Gŏ0J@SI| _Hs;EX?$Q=H'"SXy>71}R3e>u ]7Fc]:M=yM ]J,t#:t0aѪ מ[y"I%s<fl͊ g>PPw ? Tg=Ͽr_D)w7M_fL5JzMv e^+ ޏRE6ReQ jܼ']ly',lOeNf3-{䡨)J \TvEr9L PcD-*|vQk/]|4b"KNjE4ħ1=obg{E p(UA6$6Z⫴pyyg>,5qI=fB p}(Hicq0c)c/I&ԊhpmHc=f{żOK μYTUL@Uծk7$y#)FrA+גź;dϟnjFS`s"_x;bb#"^m2GpSpS <($BvL:ȝAUw_Pdf" Τ3{ֈ<ǬuO"Mb0d'ѷ?7K섦mI^'lSnp<|vOr\gl4j?xjk!Ӂ v\!!F~-#^מX{Yұvl[BpĪU(Yku I%}U+;YfoVvXL<H9Iv&"rZmYqVn`x"]׳V(/'_`x[ؙo(Z9J:4LRR i=$/oW#DIQů8ETm\;GYjI&:5b0`:(GKJkv3sTۥEWU9h 1Y߿F-w1YͿh@?Vհ2 !ǶF[D$ceH@Uh+5&ԣy\*Ǥ4W>1ϪG/X) TJ(n e_~OJ ɧPMܮhMTw&7܁L$ z\+i%yx᧚Zpԭp< ڃqiU$uWU7rWGG5"Tcte8tE]]]: saσJ\7foVvkys/ A?>Ldˤ+/fc8TW߬8+ny_Eb/ ڠ6k`^|}J[11?E! jܦJZ4LJv1oE (H(+`>$@2qYW \#@(º%i'](pf 潫pIÑ𓒤NIVZ7Xx>YkZ6չŪa @h @>ec^gԙ/IBGlQrʮqUI=Oo_ex1_"pt# ~UMxnX w!D3x˾~,>_E`mLvzӢDn, CL4U!ҲR{]jwͲ5 e|ږ*%߹o|ѣ?xOa X cJp܈v)-=-xtBڔ= =\Jrp!IBA< ґTgı<7*t7+ [^, B`n#{=\^I։`H{ao^,[!IIӦH:6|*L̓NTY4Ȼ( z5' n3H{匭߳ޙ8Ewa4U6Rr\rFΆHsDEnT:h\| (,y; F(\X/ !(,),Svx/oڸ {e_P)aNܞSidz~[ޣy'1KYaJ犹׏ 8^<麞xѼrxc$GIP'i(Wv5ǒ\N"[ȅT Oqm4sV`'Оvo]uir֍ d3ki'hr :<꼲8ٟs7h cXr3Ho*奨)#;:e4F,{@ ЋLeGeY,N7?bQTMY bAk4GoÑy+ID;\B TqQȍc/{z[eQפMy}m= /EЋJ!j㪩OF;s,{i(ѕ\E V)xHm!9k߱G߈{E bŸ'hrŽjpF qսLX'wyFI:~+I}5 MubP1Ԍt '%+֛$O:ؿw( ׵i*qz3GULJ--$4 ?5ӽ-ozoV ϶PT]ˇRMykwt;/;O!{h'j"}\Xw^WvC͹4u}LƅTDMT<꼲=/%aʹ<`X A. K7mrT'. *wl>p15"PLcЂ"$|,FcP >;EEm= _K8c5%Ri D:̕bn ۩ G\󴺠_\嬭#' Yοe =G$DŽf9/m!9k!~֍GH(7RIDT`r\4DQ8 JZȞH-d?Ϩ@erZ}ӿOCp_(_=Co3y_ϲooxZ>Ju.<7Dq_D\kQ=a:zk-O 8^ kJfH8Bn`뱞6TZX|H󛂡9nЌ6fMj] SʛCw'kIcTƺ E,>RA)>J9AYD.hdiVΫN^@oȘ9wO@=1h?N %[;+;yc[‘.1c[2W7"2V׈5\x5I9i *wl>hphD`VsPNI"s¥8oM"YF8.aGM 1 u.42RlZ, ]p4\%/ȕecmVn UZ$/FIe#rżr=6;b.p3icF 9JDZs1D{Kz\匭 y=*8^5艄*S7P `0/:_,t|~_ `j1ղprkyouQ^O?PEg8 $[cr C£lљKLpt66@CFu ̓mcp< Lo[oRuٖYw@cVpbt@tH vm@.? T m7`VAy)j]%_޺~a]޺ |xoDZXTZu,y~ye'/k0Pknf|"}vwyu^^痤(|!pnS v¥l­b9nvI(\匭.οOf?PsRŤh E)rDV~$fayq:'\匭UN0bւ\'{Z q{.Z o.P8̡fH|`\匭R] +UsJ} , IMC1R4${̕J}tTNQ^cV;,^pRd"¡:H^RVEJp93WЂvu=|*!x?qt>RG_-gr{GNψ`Q\ѽ~7j Gh41p2 oPF6ϓm ]hF ސ$ĵ8*F%hP͈nR_j] 벵>Wnu#83DgG_!6*ko#i'6 \}}i;:eM0foݤ-X)=Vg |W畝*e UkSW}UDZ1#SBDPp 2&Y~lQUOwfȕaJB$1cвfleFc"h)pS\OuI+ֹ^I匭G13$A Єt!`%ʏMC`C*0DVU`YZ%CpWE"AR%kX*wl79~)i^{i0a^{e0q^)=8hrŽR0IHFwyG8> !IaWF`77Y f&ˮӿޡ2`#*,73yL@S6=GmAs_R:kv-ڧ|)ǰhZ\H\JӃmAvфI{Hg$8Oqm̚_uuXXWۭuҪ:$uF 9 ɸgw}w^WvC͹4u}qtqa*RSS+lb;:eaӸ2^!h!&έ1eLJIe>^V; D|eV|G{'P(\"ft(e UXOq(;GqSӍTlZ/ԃ3&U͡ 6_DsD+ΐl Y[=]G:p-X^Ns7BP(f9"v mWBzO?5?A@2UX)d\( מHŵtUopµqE?PeӟG?P>Cs{Dry!~/˶1ޟ=R-kCx,=6gixS.4>N|מh 7ȧ{)\$C3ۘ5su0Oa 2@˔ e`sFY)dE3(`g试j` L{E[-TzE%aߦ[x 70afxPJ[-Tz%EsBmU&.ޤ d.-YNޗʘCr YksnoK߹sqqkCŚ!HjF 7t]²к, ː+u7\aVt_Ϯ}/ ֛DI1XrВNIF! :+*)[ ǹNiHzVӪ)[$q]o?7h;L"6ӀLp1> -='{z|M-eX̷c7a2}`ƒA.@??|mE{cOyG3)>=)^!YR6=h|Oyxe2~㰣nO88ț?quX\] ㆶP+?Ӏh˔rCl! Ϧ|&?T8̯G?,:OPhcKؿhW:icdòdW_P>U|HO`1N ~ >e 74lOa{6(1ЉT,F@2.{ǤV5кL_|Nů6B~28̿0m3v_;X> ^=*xHg|X8#qn#Ha^ 4݁3BeJ{:ˑ'wR{o$pT‡BG[\h<-.ߚ;L&izW2<*?LcYP2=EvpMuRzGf>E+k'VëUoo~yNkkE3X;bDq᳛< O4 :ɡfHk+3Ēn#ͻ5նKâSMe!pT񂞪~3=^w Z?@,77gf65iėݖ=Fr1gY/pT?W tOɾu~}`҅+ߕ䁣;W m'i^:weRB$4WT(Em]$}qjc>pkā2[fS9 kp_˧^_q/ :3Qu0c\Zc#^{xE+fԅK֐ugsOȈỳ,G']dnTB#a4,DHetEkHidM6h802D^3)S|K;]0yj ra9A fKCrL R D.zU @`^,gm=6802D^3clK| xD[m < Uxh0\Rcb3|7jXja\dM1h802D^3ఙw.C^Pang|y>%ܐ nfGpҐb6 f6Dt# pɚ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 387 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 388 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-AdB2-1.pdf) /PTEX.InfoDict 235 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 242 0 R >> /ExtGState << /GS1 238 0 R /GS2 239 0 R /GS257 240 0 R /GS258 241 0 R >> /Font << /F2 236 0 R /F6 237 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 23716 >> stream xK'Kr,؎,@²zDJ"R$G+޿ӷk{""3"Uʈ߽/?o=%B+ko?_5?_Ao=_-_ۿ_2/|c9x-^[NuE=߆"B[!B ZS{E_~o'\ 0]ޯ [gk^@狕V[++f{8on8V8.%_}öҾ>Al쫀(seWB`b;+0\ϷGz=WmRpM~Qb{^h+_fv +xk^-Ig>_ &L@W/7Ϡg ||=gURy>_0+ Ns= `e "GWZ b_HAc~_k q_\'^\ Xs _%~)/XﹿPx]Zpl#эN/Ձ륕{fe/5_oH&=C])a]" i!^UlVP<*7B˟!$'rUz%ыT?%pZdnZG=F|ղSE_@S]2P4PV +]2Pk; d e.+]֚n|v_{YT~7z\ANK@GSgKuht},Tr#tkHɘTd4Ʀ`]@{hn%C6khk V:gLʯ0Ph*|ͮz5cUa:xVT.IPeR4r#tkwOHxx@gXxyޜl2 V:wjM=#-DY5.fT& .kR` rvs3$WڊW~j4M%l*z#!?#*^eQZxCKjAf!/EU*V74Qx͸Z)RWBM"ּ.i+\BmW4k7&եh|˗E E_,Z^?f8{J>f'[껼DZ,fywZ7y l/}c6E`vqv[~:xlnZCti9kuժӫƖMY y fg̵7X=-s3`>'}׌9~$@ "r%'O*NگUl+Hzv,?ss* {k${x2|I0{ &i ,rx:Pw;.&}<G):j˛ xաkʀqtwo\Vy+z%#"lΌ+VB _?=nfe^ȝW+&Sym Y-zmX,DH@ᗀ]@6VQ:;o~Š Tr(#f*@xź׫Rdk V:;okoIk)Bw? >!tV [֑^-~6@f/\ʩ"O<|,U:N^$5ZܸGJ{Y*ҹ0rτ: ~LE_3jZ?޼TXq+<+_nx))f@b_/tA!|"nML%>K˄[7!O ?23@ @b}H@"ZG7{I!~N/M}Rgh 򗧏E:w -xKhyi;ȫ4ҵ[P˞&ʝElZbnU̅|?6PGS gPA`BQIE4\TB`߻P 4"謓GrZƏ=~0!Sә1B`^EEXJP5G }6ӇΦGڊϬ7yYŷcT (տ&CRxc'̝6I8XNڊW~♰pȠ0/n&laY#gNC7T\rF@#t#Xya3n}ct>&`=W:θUUƸUǭ2ƭ ƭtlDtD&y ,^McZոuSr:Z2FwlޔlDu(idf/ !Xڵ!m_3"1Iay11/81=2W+Lh^GzQ U(I))m{U]ik+^RZQgL};)\?2tURU>exge 2kLiT_eHybӃ~)3mxdK  /FPa{6lnju<)^RZ)r6;Q8re\V!g*>ŋF+̍;.a"{;axTi'6*1i3Stn f: VMgSWaڮ b݋1~r\Aoօ&* _5`MxºD>72L9X)aE+ZˆUi rǑ[[j k}Gn- c=~op-z 5ֈ` Żk7`Dθ9wƩ|?b)hdMMv-$X n p>eD"LSŒ5`0$Cx#vc^*E\g&.Qfe-:*ˍ3#TY]uz@YVB ̦U2lVRPr#tѤ%Y1군V[eA/@x[Y1^Mh&yE&\&j h Cxºk܄_OO&| '}L9i>}{gHt rHC^3@ˈꖑedxV!?y#<6wlm+_J|?j#6W.ڈr]_n#*ޭa#B/~W~0r@Ek9X*F+qS`:9sfeM냑i؍a6ߌi?bݤ #lZ8U72蚂Uny} jgRJ3FFgLvH-<%gs%װ-2<~`aq~xHlN$N(e܉)[-~؉ _B{=@gՠ{lNemg`=jbUc-X*iwX\vY&/ FZ6ad4.@fJ?:k)qv'-t— PA'2+ /~QzΓfބWyOXw^# |B '>>ilZ&_^ffd= X ]XF%H:r{`g.#h`Y'(<MxֶLxWLxB@38ˣо\GLʍ!OzϦrN'4NVZA|QZVztK_[ʗ"ONŝ(Ӭ-y3 0F VaI'>-"+k|u†y "lon+ܘW-pc^S_(V w_( _( _723*bFSr&5f4I4cFO̷Թ+-femϖm{\ȣ>28#& 5 :|)-d^᥶zfX^ ΙaБax͠TZU L+D|l|m{g7+Z֕uKuԺ NsëpZ'jDja݋yWx_kmOX'W1,߅(|?y}o v=G4f?Z6hJl$Kj}%"sxKhT/)kc4b(^%Ւ8wBN;a_؉q'jd4 PiԺ!N%#96Ee]&!llek@dzd4SKQ;qQ1r@ț냖-RTrJ> R*ވP*R!X}PU-p bpDW2+s5t(AXʑ6roɗx v.GQ(Q8`ꂠ\Fi'Xdb}yO2>$^a}I>I$ ꓨ>Iph,aIn)^m@US}eB*4A&"Oڈ-۹֐aIU"ҪDe-ao}.ΉGu_k5vFZzDuDkxd{A!j냤O4Q58qΨ9#؉rE[#9#_rnYn(ܖ7nˇ=X/V7nk=@OO@O:f1yNrk@RT9CVuրJѐj'{E 8{e+fT['矃~>7ZSR%"] z 5gܳeMF-U?[CjO4\e|f73 !u(7bna*T'2LͲ\g+'8AiBI4hhSeJc%E-RHTSHT)QM!ENj/էNc8̰yftCk壯e$e$ 5+(RIoƧK > 8s(l0: pfq/ٚnxLSR_wd)SƔFQVN- Y 4gFQuJGHTGHT)Q!Q!Q_D%Z9$Zp&iu}u&v/QAL?B2_8/bA;nW 4gCgж8=QV^KC"ʼnV"4"-mZGgߧB]?~D ]S|wIpO ޓ "K&{^QMpVPfDY`hCSEcS, `t/UYj ]:k[lk*VQ:'>j'ВipwddՖOhB'a)Cmm_mPc(1=SίJƙ>g^gޯMYLB q mt+0%f'+iIQ/ 헖f/vXLgff4fyY[o,w7wIht=~M7&^m4d`[a)%Kg%VJ' -]8t$ c^@V!<)݅&5᧟Tv d5H8fmqDTp`'l֧4l.Iɯ\Cm "zsE4\t:SF郴-: aY/k "=yv[v[)o!o!oϧ^4q{(w֐׃ A]́?`a-h  ,h44P j}ߟWpYoO) OV'4=2:xV~vh$tstV@x{>W0<9B"#wD7e+Ly4C tNx﹪;K.ȻG;G;)!!h #-rQ,"3R>{*Y3CkkE1k`:Ͱ kև*Akke)sFV^yYX-ZoVscX߃GI(S1qP|qSစa9atVӟ:1j$СXaOOEdkĄ%{q^" m^iyÖaVu`Qɽ$M=.lxK0kF'z20P}~rٽr::6^^XP%`aS4[no$oXsĤq};؝r; ؝ ~;;؝y;'؝=jgqz*-w,+,+S޵/!v.}"{.Z"g(hX%tWP:Yڬ52dM*7B>hgw{p=adOh,oXOn@׿U~5-^vsny}؏0p>>>X<0N}}[@=8N9$汏㈓,d#Ǜ֎M!mQm<ݴdKǪhi xi4}[cAcal}u}{F_g=_yX[r X[ v6v tm%mvú`]u9@ ϶@k"n@k2tŰQ̰fmtռqt ûễh2]BWĤYKb^{>{`{צ\%wWp^3<ˋvk054u40tA>{^'nw&y7Ȼy 0y x_ߓiJm`IֺLbUeK.L瑯j)Yg^BGj;y}2<;Xnp-JJȱO2 .&^O @x*7 N۬{:׿s:w:cˡ7*|չsl:wisunM5.F:< {νo:{=w׶sdmVP尡*[^&=۱ d%|? y y<]<'x͆nC.Y`=lH]\Թi% 7̸783FP]ojmlʈ%8AhG#c1#:v"^'KiLX2k -%{szY3Kg|哕{>Y<)jRU2Zt09ȯY%1,a>Y%'˘OV'Cܮ-d~yHkN5$K|@ա>C2d>zRFvp9U<,:>Yz6;qZRsg1L5C1C1Oy̭}ʻ!.C\|{.qDOG'ÚsSov ^I?w5^ɅZJ<ݚÚ [)϶AMR^sй7VY͚.`Mssk5 dEq2Ͱ.Y3kz̓GQ%k.w dOX,kz8{2lZqHڢB/ kjk)d-2.}bd tMŚd;y{0cFh߽ aY<Ju;,9>f7XJ>O[f9O|UdJ rz1=壧75l ]ɖ|/{4,aQd^@;_lϟ#ɘ߃VE8D8&D8-qE"TWu-߳wh+"ŬKp42 +oX:Nz9{2±\'0BGGG8*5zu2RL".p 4¡XF'#Ro 5hLx/Pc+VbJ'g:0uik#vnk*VQ:|!jȇBsd4IWj0j<+NwORKk>Y]˚nl>=x2iL'ϊ|@=z2|~$^ >jgyڝ҇RNnws:;ΞظVqfw}?_'Z־ 4쫒*"QLFòt (rKYTq#tvvNSH.h A(xh J~lEml6^6s{Yv3,?E_<ev:[(X1"RT9Hn@u1"2~JqbGcyX>U<7]a-,9߳< +doVșkVȼY!VHY!VRVNaVjnQȩD'FXYǽO!u۫ά##8ߣVW^ՕG~#u>zHRUyeIKRa(,aXO{3'Zؤ QWܼ+NF+~>Xgu)%o?FT~)Ujhvg&䬀K,'}?+9)7}sV,{XF,%P[J6-ŢP`]+/; ؍_ .jI?uB`BJ]bR K 8o8eWdRk3ڛ;H/_\\/+Wl.AWSxI~ptR纸\R//q¯T5V>דÓ. R\F8F[@ ֜W0)ϖϩoC]o+rTܕrK1/q¯ȡ47l  xJ9]~~WG|0\^/.ů7kkXcs25ʫUC.Hiw̮7!4,r.Sa_C5~ӋQO9z;KB;=#^n)AތGڌv[ ZV%߯FCYuU6PVYW:3ʪ$ufh_PwT>zrA >rjIoVGyr-\-k1u4Ü>]V_pY(B\>IwFKk+^RZJZWG.KУJ=DkiwJCpZe'8֖:0_xo;!YpunNi]|u7dm탬퐮/"e0"glk(CvE 5 i`|db2NJڊW~ͦet9se5WJmx{A}M):˪xs~n>i李P;mN-2HItliF-PZtnZG.d A9!{EFS=~dվ9>C..u\VūLPon>c\WŴ'?ҹu_-j z{&GE%WL7)J]A-_,X.D cIE?*O¯6n,0ћ?BP 7 9/@@q+Щ@\m~W5^"o5SKjڛk}> qWPV(' UP 9ڃZPTwI 1G`+tp`nw`n+ddQY++؛2ċ`~_[ah+0|X!{=P3%O:z&_z: ~[\WSۆ}Xз]OYHzefO gy[+w$H9~jQxïY>g眥sS T%W|J;bt{0 ~͚^ιUVs_r~^*owwy|Ν9ٓs~ճ#F]֮fgOI,]$۫Yn#,ioe9n#(^mUmzaifݦko|?L،K: Ln0J-}'.e τy3[G(Fߨ"ei ܎*Ռ6q 6;y7[WZgg\F.w N  wu|dN\O8@W멎/VGdwNaO4N?UMh=v)m/͝, Vz{"f#N;}';1` wձZvb5܉n|?ɶoI;u9>DY֢0o2i/yv[ چO{Bg,#Ƞ5KŹwB*MCgRxVwV%ߏ',RސpMCtsD㗯klGh ͍A}l|mGL #Aku~=3jFĪNz N;}' Z &{h-؉5o|? 3ƍg-v6v9. H6r"/EyOۺwHN"Zƭ@IV#>H>eMbxTiG܎T>Dž˜%d ןm$S&6mVxKiglQN4mv]N;}'zÝ wbN̆;ۍm>h?lzآ-Z[h?UK4-:ڢWmѾn|?jNTVĖXr4cuFm'vasڊw!gs?Lh('% =SMc]X:,c]uPu-Sad;֝haN(^eob+T*ב"f5Yj<|13 sdO(sb|4bg%hJo:-6qez[H3 ~rDl ;axhJcVY3v.Q; wOɚ7Oh:uV9*OfgUT›`ϭri*W& OO}߉:q'ĝyNԉ;Q}';12wO'(;NW#u#uwp?!5;#;m],3V%O'O8<5Ԍqxj<5פ>dׂsN^9ڃgr#VX;c=KmG 1y-ඤwZ.zDr.eixr-jmfF[ -L,;V6O HCtLqLD+gON7lQR] öw[t5EYv[ԵmE芼Kf.ȻqnzQ9Eylѵn|?jrc'Ԙ"wb;xi*> ;v7sǑm#Ӟ|?G?pENt;(w|xvxGZkNط#vb7w}'rw2pb'jAsh\tYCV8nI8X!Զ<1 -}D8-f LiX`co wL_Bh'x.y~ }xm[ ^RZxG؉*DuvBY#vNz߉^q'jQ(_;d6۠{ovE,Õmq$udK|m+_B{p>fَ|R1c'l1ۑ9|!sm~? .U>6ZaV9# xxu]*ϐo 7v/gL'tj&hf Z&=߲ԬT)mh]"k+^RZ| |.1aǔ3g0,S񚏩 5k# m/EL~3 ,Sxt2 Y85BHh"Ȋ(ZD^ߏcfzM;QU;XvbJƱ#J*v{A%rȞ֍Gm5 ^ 3P$2 ZX=O͡vza7~83!^hEVZL| 5l7lmŇn|?-="'w#En"Ner"xq1C=62Ĝr=Y{Xc_G/=~4XS[mf+kYސY!VG-VƌҞ|?IuƑIoL@xSWTdY^L2 /u7V!(AˆT{YG>/ECj"$Dr7ϙ\QWHs*Jwr.%m[ҹ|)-*Ϣb$O)r̦ S䷏SOUSCR83s?HR9؉q'fǝN;aub$%܉p'JA|?#F%vvʎDPDvwD7ǜĝKל-kƘoʎ| i\}m+_7AMrDΎXoW=Gdg-x3.yXX|?$؈< n10u˼$g1vb;?)7;mCt 2R6h7m[ŒdyPpf8 ڶU*vGV駈^I7b`wԭ!#dDpA$2GyDD\;jM`zB g &VQZ脸:ꬨG\tqu-`kVa#.ڍGm&aAnbۓW[i*Qsmd1U;Clkˇʗh*NX*'?@X==N)ee-W0kT8 볥ߏ;' ^Evm{)E8柀ll)m_͝Lkh|w#QxGG!ޡ߉Zq'jD="?*c`wLsUEawP FR >+;k+9M~>2q'LN(-'}cvmGF#ͥߏq%ґq!lm2LGYqzdgЯ I̽[Ndxn;Ćc'Vǝ<ְ6K; εt{ :Q5N~ia9q76?kǑ\}c*A_"[tc֡[(ـ4 ܰv_d}.rsTXoK:rs8;nGKNnSm%4uNm~ۏtumꖯ ll&066 4%S -Ѭ^-kh; .nzw {BSz+^@/-x_4ܦ"kc7kܦh_7 ڶhW7NR jheQ_8]O4p[ܙ/똟7 |6VmN+mI-.WMۆz5kW@o6Ӌ Dö%_+fmkH%4mzD_m?^n'(CZ>mp"f'"?pjS;wTs;cu_]lnw1u V)NmM%uu]Tr#t-iq W WM<'sZ7g>wo O`60H"32Y,1 'Nf,+9XSr`II]Ǝ"6ҷ9I|Ys̈ aYiс%نǶ|شcKY6'-Cl5$]׳=NH3,'=j@VBWh!Z=kV3RfOVH젼WL<ƚxux^0kij.ި ^'j6h ,IpܒǺ0=sHBD,dGuM 7ج6?.ެ ^ ^7zBb!ޜ ޞ ޞ7eB/qRF?zνtva)m99w]*?Оlq>N5Hξ}g/ѓd׻/K& %~ڷL@r۳9y{=f\˳bhw DkB>J7)fRS ޗԼm DkF Ɍ1hsv&q֎ddShHf'z-|Bzko48e~}"3wckf Dk3Rŷ kфO5[CZ=|1#WLv!sRyBWG)Ybft:[HGiXi `n'oz·——u,>reS^@Y@Ynr`JصT9r劧$M((׸ r~ Փ%9qrnXF".<LXcuXǀ K;aqEe Уv 4i -tZ꤭XY+i&| <.Wq&eeVmk*ք_c%ܪ^ E/. j^) no]\ܝN:0ɽb^uq\^\~ZdiC$~'C /t t,[ȪLf^[Tpn] Tg`E0 _(J@G64=&EYUn2ҲYܬzƬ | W1{ygY8O|^c74>hqxՌy}PGcq1 C\Їa9atVOId!E8 ,s[Ež֦X)@Oqv.m7 2CMxƚ%>Xbs 61,F΀tMaU{DVɖ>X⚽T0ą[.| o k_ҋCcF[*Ih))VQ:In{H°|D E+հQ,FgV8 SհKN EŰQ2>imoviᰗa o9 .|Zy p ?ъvOt1\CSmpa9 #t@gMW2YC&7Lw u?;~zgᝅgwI4H(|X|u>X@⚰UȑEȑ5p;u:Y{KhZ]{5kmo'֌@{ބX.|7kGW3MY[!5k¯|==5Ɔ|A{&|`zjR-/_&Yo+ +(==7ą &|^ |](| _Q׻'ON=\,mu}0Ms)t+iۚny}ҞvdQmԛX{T].Xا~|'ڬmMŚ ?Gv9 --=h0h10hqV88~-ZE7Y،u~w ?0\'>.|B^oA-ș芨gТfhz-s8pĦ#6 Rz"6 :z2-\@6V]7&5~5~k5D:6\|'/A>^CӰ) M;ί  z>ɺ/>.<;U=hMNnd z 2dbͰt Za665̥7lԲ&gO~./&| | |7SK˼ P§ O'_'g|(QUS뱺\!VW~r Iσ+,N^+€Ӯg Z8X+ɍmƥ1@"Yr`GU:I>55Uo+pVTjB纮ixmuIguYTo9HI>օo//&| |gjM'>݅GuGW/~yS/r#Gj=Nu8pfY;X?w;N^aҮiCqTQ7̊w^:/P4Du9o悆UsCo kdY՜^Us@9S6!hSe>2n_ٍȪ7b:bE{W:e@}$$&uM 7J>7:!mp::׀KHE3V:xVHEFT4 7f>-Dۅ_E$b!j˧+ ۙ\-tV@x 7 B?_+ﹳ8WH dޮEJٮȬ^j-lC|gi4x}o/)9[C"^&| t\#u>t ۜU X bEU:w9+tmqm|UPo (n%S^o?hé.X̗iw 'E {^JD|=hyxIbQJ9! 撵R %f.YW¡|x]SO )vz$!}%yxmz2٩6%)tM2 e&uyF>WFс%:K kQ iյ[C#6>V%D}/P#6t 1,JSggzgkJa%"gjTkMX+QPL%EFM>iz7h~"E*iFWc?kqt]gсB/.M s@*a9ޙE<$Lwu۬@*a^KcӳL%L-cSd))Dܒ~tT k}'OV0i#lE&n74G vhb/.&b>OK k.]1@5@xȄ쩍jw>y}Оv8WWqsuUȷsusuְMsu6등2oЯWxb=/X7KЯWxM^^3V׽!Fl,#Sa/< >i@jx{Ć\5kO^vW-N?M>UMU=UxcU#Tu>36glW [36 MY1bq(c&n:9Y}3l O^›dݰb JgM?e)` s)aLQ2 :sw~K^Np+#jz&iq )ZurnaȘ+V$mT5v)4ٴ @v6yߞңuIώدS]ٚ!qwӟՍ7h>Nu*Pwkn¯GbN)@M@@ntdn2dk[^*Fcu)0htZK $ְ!X]8u`HCsgSA/ۗn_P/'OzKmzkuvLPoǩwI2vPoYLB4P只h#đBx/{>] y.*߲z'O#D=)f|h Պ,YhtljV/ԬR'[m,P6E S,,m?!Ua:Zo{$ @X݊. BΉ[R>R!mP*m!?ԦrA"Io4 E3A͋]LJEK>F,κ)zMSMv~ b)e6oֻɍ׷_o=ut߿{߄239&?O[ 3}~oo|2s<ސPcceltc7cmXNOPtn*vFh/?,?ʙfIQ6o'b }zr?ߦI '?a bN7yWp"RJKi r?3T(ixI"eu!Ix7P0sd#r+ j\ "H K 5xF8"崬ZڊWe?_?&u^jtp_s /29@ /E>45ziǡ %.}}~Xo o߰;popmkygi޷c9ǯ!%oY*"|SK~|MϺH?ʍ+29so90g{Vֿ#y'>3RsoEwZILJ麏~.R3+?Uav!֙Gua2OF,S<_6_6^ړ{h x 7#o[3'G~Dzu _&:%剓ytst t+iq> /ExtGState << /GS1 247 0 R /GS2 248 0 R /GS257 249 0 R /GS258 250 0 R >> /Font << /F2 245 0 R /F6 246 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 24825 >> stream x}K&Inݾ~] ؎g/d[% }g0y[3Zte0 # >o-w_c?O~?k0ۯS<[xO\(ŧcķX g8FaP9{ .@uAG˦[? uOs={W\$+WkIBawş^|JSueĺ.)/s֪b} ~0S>']Tx5ע帞kb`<q1W'I/_?VnY~lkMz@%ts(A=w{,rc=ոI _?}}#s@ׇz}_{9R<5=ޮ>=k@\;> h/~Z'v|WTdM[{D ȥ:'* 輬?}6kizÜMΦ^=Śyի׋Mb!yY}q Ѝ֍c򩋣$Ww2Q6- WH!mސBzMEZ/k4קSGnB绾< y]W]H Hx{]׷qnZyWoC.z_׾SPʁ񹥷, m, pK1{tU"W֥SFY_$i8U^9 "WO^7[ߘJ 84Bwㇽ.ijʪV< ׾ebàt\jە$]^r@.Ŝ}M/= ^kk (VKqQIۃ\p i;ZyGZ5y%_D!$v}֫1%Aڼk[ <w*h.CpƲ|7QJBZ@uuUJ<ƯUu\O Zܵ{x.vYKtwl|#|iw=K=}uלz?~${=iյ(Aj{&( C}#~ov{s_=ΰ\vt),kq,W/?g3LJf B_ Thƭ\0 -^__w=kE9^Z XHo1\Fx%{I|jνeS`~ے'ne]ݽ[Om/t{il_MbI_۰j905߄6,g^/K8,b^=.$ d~Od6~ӯp]F^ߺ/[_3~;Ư* iĝ]FSLAf)VDۜq= &Ǟs*(;OuF_o^&tK ԋ#7.ЮH[6 s|}Jd Q, J_ )WZBۯrM[x WxȥO<t y ML kψ:ۅpK9".WcŰFYx 6>M42 8֎n+|(7!#oU 2GgZJ"l&9b ^Ը\6RXmYh]\r?6 Q &me|ĴPfFnCAxGFIln!h܏ y+|De= {sS2Xpua"]E>,Q:/#o~(*S&&P᭹cf\;EƐ1$ZTSGXpD8XiA"L\1Z@E]Ӧ3H]Lh܏ 1+!VI4i:Vxh Z@X veB㭐_ Mnr?L $r=ԭ]W"r=צ\FQ:1!]\_ro4BwcxP]o0jؕ1v&dJvml@UYo1ҕG!85T,CmĢ.Ug#JnRh mD fq@0fRyY_lGXO^8 D|XO) ᒆŽzI:`K;>c#j~D;RtAcG"5DZ@8Rh087 ^glDx +LkI_ US~%.6+M1 r3&<[k`+S>˿bzm|O bԐIbEmGxd7P4bg?^mw>y+87)9M'lʥ[~nzz:E!#^' s Ɂ@pEp`-׆{w5[`')Wo)R%Uo)((AKZy($!Y}ڈ:6"g\+mDΩXHt^'c=|Fф E{=<؂FT:zi[kQQOY#f9P|8b#f]`q?q\#7S;tOY;Va`4dL֋B2"^-*ehWy[] yˈxH Z/6bw1XQgusl࠶cf#mTěM'#UO쁶S:Y\wsy`΁A:B>x׉~(_בY r髉)W^POW|^p%<)W݊>OY3&-I%sK (&͇M/ga\ ΡZؤS'큠E\&_"'\s0'w< tW^Wr%Ԏer };8Es~x\3 d}css/usw0o|-r?WxOc9VCpV!GtPFDH[58we*U=~20فl;ݿ]+3EHv+WZEO EtOuT>,_BBqʧvSzWlwESy=8e}.x.xe5]B~LrI ww/`!W`~Jc%ƱJc%Ɵp%~w -7$X-OSVo +vHL>عvtr\b-nSg øGs( ơ|XW+̇wX+ɼKl%YkVˌ7|6-GZ@gqmy7qn!hO^ q-f2Pڝ@m7MHi&jg97 ^g = =0 =tWغ+lG `-S' '*pH%d '* 똚#^s td0=yzX\+dCW kZ\[mD___-mu>l#曍xxۈGlܛm#SG @#cy<,oMn-7x ֲ yRmgi|CȻ7so-~2f\LNuΏPMxȥOI+N ueB'@̠TZBKhz i# 9 i[;pTW ;paa*%2h߶ed҅5s=S'mD݂fլh5hȝ`#COiϵ)td mz˸ۈe=[' wB71f5ܬوٟGr؝} Z/|竟yަs#mti|}>y~pQ<_X+3=)듑JȮhwE}To'_eX@ʗv_HXSS'KY]pD\0Z9dk`!hOGؖѥ[{vHSp}ZFLdܖ5fܶiZ,V+ܖ+|9+ܶVDW ۈ]z_mmFmm>WnJtJrJ3vgjݔjڍYV+ eJe|gr폘Phhbk04Wa8\Zu%aHN!F KVɗ]__9ٷt}r՚嵢&oB| Q'Wh܅S kwgdF@:p Ndy=MXXEW@ Q"&'DjUV, 4pL^U{$ޒ~{kDZk:1hL6яK-i%ThGC'y.X rLbRaA9J4d/ 2  /P_uP_PYwS2}ؓldDCF[ 2ųCp ؀ ?پkj<:)mhFpmuq++ Ij3zjr.p^VHZAO- (z7^Ici=.xD7As *hFAl\\^2.uG Λ?[]4Bl֦>!r-߆}n/I }b~;>^4oPꕀ6ô^ #bHAL^nPп8qCF.MZIK c.ũ JHGQN%y^FێN pȼ.|.yvbQ#; 'ǚj8Ҵ6}) H c#E\$km3+C.z?Dlvb` Tg[BNObE )s&OUk5' V#}.05eN TX3$YEƑvFSSH~ 9"`m ڙ0n;!R9NygCNs!`Cw$zF"kXc:ho,AS$uO1Wi}q}!ؐHp Ѹi4Fck©QJ[#;.5JC=֗hu}sfcJ1BZAX N^@tQ+׸3uN`U9Y?kV/vSIPXUt(W'tC>i઀SXoh+:}]\v.]^ ݮx˔r_e殠^A"w4j/tFG .E\F`^5֠89~rstB߭4v-]׭un5ojWѴo+KVqtt rkZ˼ UDj7Wss:^{FVsiKhFV*-^Uҝ^u>7k7U#`liz/ݒ[>Qݶ޾k!صv5%R`m=4z-;ڵ#z׮>Ц蒇[^oƸ湵Fco{kHؽ^x׀$z>>iEV]}ܴ zO5gm.w}*S$T.-ѿ+nF[GY|9~[ouvo۝;oNo|eIvqOY48sfG=[Q&m锟LJ{.풵[V-],Rv]*4ԝe/eEKTA;>[od8%K]n%੎kT]:/{ Dk܆<ϡx!>XcD09SA|Ṯ=Bp?+g ً6[RK .NY;{r49*]w]z Ca8Ψsj.k'9~v s)N^;:+!R;LG1áo[_Tq*jX }={0?m&isjNEM@ \U;(X:U}Z>,*Vǜ))i1DkǑbDK6-H<#Pz;&RC+Wʼ \vܝSq/]eԯܝ_qKC*DiMUԹ2(﹄!g"}W}2vyַS޷o}q]8!߃+)3b"&E-6wBT#ϜQ?x`KSF,`H+ZGj[f:w(%#ZIcw.(xȕݪ離Vi8c.E(P["D;"QE^;Oc.P(1+T<\d]#,=ۘvIqOڎ\,"Ed:v%~F7: 6`FD*F;}QݰZݘsG78=e]rgo ɭStPPفSFZdZb!z*vm}k{p6.\.N@龶Fr[|'ݤs>x9r[!>N %k&dtz׵4y]J ;WXފ6OY3PQ+!!F}ԶVO@b:P[y5Rf<4jV&>VZe@aì!R x }@^66N6jM9'*yYW*_tw)&UXNߍG.˛ 4u%Z\-ړ B{ĸ髶nӷ׭[_Mdƹ7έ|XB h5GR!0# t kS]N\j~J J]7*r}I밃a%gӡ @@SYѩ4s>wXR%P}5?2q$1Ju-(Tq=)9}ֹԷέoNx7;}7N|n|o|jWWJ*WWH:oNs9`={N{Cv5jw1C^l}g;vz2o}s=w{_{ޕIJā7)Nc?c;P~[.I̠iS~yq=< &s7uY} Ԣ V~N_IS]*ݫ^}WAkkHgp )40i?Č HSȀ2)@,5K<2 z9Y.uu,ևqWP[[#Qb%VZѵ.QXtN|⽲$`9~v&{?0hR v&o} el |Z6}vK ⨯7}W5[֗ڨQ<{u&6s@`۩ FV{ :.PS)xY4ZM<)qD˟1cmq48(r97mte0KސvIMb[H\N6ѿ+?|rFR0/[+q=Kvۀ_:\> 8hd x/{;}ހlbsYvYi8du&7*="6+q=x?Ͷ GcE_c#`rY0W@API{0ܑYj ĆT*bCj!UnHF̴,]@sҁWʐp{p>֎S:Ъ a=_\|1A鶮m$e VLx֬E=[ϴv$)eJYsz HUqkXF鼬9RH+VXJdy⹌Njv0p<m)w, N 7}78}M-Nrӷ8}!߃UyUxcPZ28,i%307 ^'=|~C0~,;lCnfdHwj:~0m()Mx$$WMej$=, 'K٧ދ7S` 7}[2h:/pԷo2}{ G}k:{0mUgURl)PIB",)TkziY ;*i )y[A=;3r?vH*FYS8;Uȯ)i5lj%mޅ{:xZ/shbNƌ&KRD<,5Ji,@#e.ϊ`b.ũ B{.mF-]ck]CuЃZwꛜn&o:{2hoH5 f 1Z!VLYHwYmf!(93mM5|ڑ!9NXM|Ɔ50 9ҹt7^yB>4h֛ zef؁%<`n$9k7; s@~0" _ WxՔ60ҵHhJ=4ލ67 ^F`$QZͥrV*X'YoNXj'W\g_gQ[ el_6j* |:ME2DÌ%s)Nehe=g&j)F}G* m#o [֘7C'uW'yu&oB0_wIs5c6v:bͯ_6XoKuW:7pOCR4$Ѥh{E-K#&MoOq꥝P˔3#cs>cM)W$u=@R $u)N,͒W\S\Vfk39dWu e|+U[В241Tq=xGJ[&u5w$#zp榠ѿyde&m{ ʐ{,^O, Al%/&dWDa[ `[AO R+Ħ8Ai|U'M-֐&o}@g($4QbO/w2(#C [>]bcyXUtGo z=8baKؖB7- aeXKj>'dh;ωsgׂhOU3f0Mm !):|󭴞]&Ŋe#Ʉ'8y[#8RāNp 45Xg uge-ʤ4N3&S!ۜosv<] -qTwo|zF< b#>Woĉ׭7i>Tڐ_,j5!)h܏us@qDfLq0$怢I<Hs1ܩ!Wsq5||ɪU9Oު'Q<_2>_R`*p*CK舘:TN}*-=;}G}CrQiH,G}C;~B=/ܒ\7.[l2ò,/Xch~Ml?TmdeRK):j< _Ф~]^PU^N3`F|7 ;>vz?=:gGB5(i>K>7;YV^В/W( +2C +P=Ӯ_l+>hꄶ+jWh}`(^Q^+>Z7ԮldWTM~+* E㊡NeB`ź]qE:C㊬슬-V+b]g|>- u:3ϧEY͞>wFGvd#oYvwI+WLy ﻤP]j` R=/.nR94˵ 9L~z hoPˆ_}=Jjnzp9HΠ*Mum-&/Ǭ ^O=lt 9"y=鞃K#Z@YoMX__X+X+kcsZ}~\WRֻ@x=hrՀy*S7v=Z($!đzy . J,\- _j  <وDH$DbOxH Z/k r|SL@3y7byꪝHd KލxZ/k<:~-S5Iy ~lᥨ*jH&B :7^+ibe#w0[f(u%^u!-.G6Rte@ue;Ň <=k=u8;ϑt$%㔴n9K,FPs6"Izy&X 'td8H܂FB@|.lHy՝޻w}BCRzy&FJ* HS?@; E,'F @ )y7ICYTZ] ZNҲ&^n*Ԭk S5 վstn!)hO'ZgN?cHX 5uPgNi-ҡ]3Bl1܏'ۈ|GP .B ߋOJcP<JKY. Gm}+A67 ^'mU}hgVPhLgE- Z@m[]XVr`cyr=AGY+W뻜_ J#;2F+a936'Ht-[ C.z}&f&MԻ iߩMtO ,h#C>8|D0uuyd (WvtF!!l56rg٢wQ%+l >h c ugXZ4pzؠeXZ, Ld\U.(xͅr|]BLk,G3YīߞkHefDwa& <|.Ǭ1둏ُ|.S#jSd|nr?X3ޱvݴ;9/Qˆ\&Ez6O0xZ/w3mPMf_Hfa,js@~>o_ز9m/Bn[{][˟7nqW.C.=~4;f"\*c,xFd@X]JLyS[5or?t'*M?FQw)sgbH'Y~Y!-hOc 7pX*CBX MQnjBac*tDr?Ysl$kfV9LA|"eHZ@w65A3,;0s>^'1Ke'i♄4E-RZJPݹ)bx;C.z> qRNTcB> x2$-XE8V++C!$d>?dz˔H\DWz3.'҄VZ4J@~]&yg!sg!i oo]&Bg!pB$rH٢@8W"HŤii7JeX6ix+WxH Z/1iHZ5/4vtF!!^#;do J>wuVQg^'c`H_Ϥ򕤴þxՔ_,5[o 3mn!hcE1"1if^Y v6 P@d!N! qh2OբG!hc-˲ 8&H,gצX ;=Aыs^ T!hO'Vk?Ae|AБ <1A hX)6ZЦC.zO\zD":fhijH;̣KmKWCT撶hHܪ3xZ/qQؤ8\u AJሸތ6iA67Ki䩆<;3إB|̜|>fM>v>f+Q3&s%|nr?$[gh V:(^i$iUU ]D5IZd lշ$:`&M& VjL1(vM~$j I 7νGGbA +VYc[YvP:5;,7qV˛8GqMGk!UwvݨWxBovzPUުƔpI[4XJZ3V4+ɚ<,,bC.zEcU?>%ˣtDcڭbVy,bc%c^'mQ}yXVr[AuBΊ'iDXԜďFphQTIZ/Ī6Mv;)hJ$}m]|rhn$wie : 7; tt0]c |`5nr?Zps bf]6#x U!}nDرz;SݶT܎;bv;|= }춣u,Ugr?YFd*tDϸv#ثr)!wۖoe|qFZ@*p$i^!h.OdqY\$Tϕ>&z4MV#AMm$iu;|`TorHw> "5-ohgW@I&$C/B\Y`2e~W'v&v739-)5&]VTF/G>/؁Ȭ|RڭT+=}=oҦ{olˡXc=/뽞|0_j{k!uwk -~/zG:]1ၟh͸]+>G9XIWh}E]1K]1u/h>EbWS+, Y&+>Hzt_LQzFx7X>\~/}z ذ߾%B5zNy4TG8DÞy r:oc4guxv}lpwmp vh Π=pZ ĶcFWc?5[}#v}3)?菟@NL4$Xe֋~M v?Тbص^D=y9y?Оo {z@kvy+'#|3c<_M)9G-OAkgfy!@1Tfbjc%|1RiՆaY8 G^"CbVҙ#Z,lh] āk̤bi]3.f^_ь7Ny Fy]$>y}F|]w&^^m·CA^u .v!Cq/^_ixK]yvS5ŶxC{mH"+7u$tw3#!uk|Wp{sORFmwQ;)uXx7'ns'ָ&{Q xKC|lGM֮q&{sj, ~(a9[Ю4֛qsz9]+%p @{ޏ"'׋ZZʻhv!lSbƒ뭯`# w#<hxJՋc<?\zEűw dȢPp!Tb][= g ))1uH]?iHj 94PX;uS1;c)-YtNSWu;%Ω٧TU(fhb]Prl9Ui@d}0ގ#v ՞*+_%tE)}swtN ,XR4=B` Oe*0A8`N;iU@}ˬX瀼)H3)VNN jG ,5>xiQe=Vee(>yAߎ+xAWҸr-zĜ4s>xiǭ|)NTVʧ/)oDGǔu\8o)_)kKnok+a~+eV@3gDi YE\~+F @.Ki'\?b$+eB Ua$zQ"ӊ('VQ:/듥_c?<]p24_4[ݭ6|kugxvүc}X|D~X|D}XqxXq*@ICC@!j(Gz9RhEmfs@~xDRq&K J7P;;VOM-/ԴƣOo1œor?XZEֶγUGDg#y#U>":UL J-6MK,6앐VaD*~%J+^VB7x[2or?y1[if8=m!:AÙKF J,m.\LB>D<#Z=:OiIH@MX,,~b>bC.z<ζdጚu-o舚8YgaN.*E- eC.z<&s%rnxӴ:׀#YvM%dm97 ^Kh1 /pf3R+t D! en]@ʜĪ4s>XM?)]5wR* xHpuw_$*o.6[{w PkOΝt t`٬tj_YYU5Vs>^qS4|jNnR;Z|N=ޔےcX:hP5po'`J3nMn{ .]zQMt^= ZYyVzrz:PXUt*w{Ni ^X9O!ooyAVdEwa :+lb^'-n CD Jo  o>>D m]rUx?g jޑSum9e[kJƹH,3)rԞE1w17 ^'-Pxzϸm=mb~k#Y6{7C.z6\~؃^yY8>t~NV[ђ@N<h*+ѣ_JX{ [ l߱=`Kӽ[Wb6Wb6~49WDe,T"G ; #9 25G9CR=~lXR܉H)h'(*-Dol[ݴI#)%Bŭ~eo}\hN!6 $-f-&9RiT%  <ɂgyDܭI6JWqӯDӯD7|&VVaZNKNsNrQMsʹZٟZډ, ,38e}27"N蕏^xW>zW9Wy]oO&K~l{:чSH)y+ɪGG*s+I:' C+%f@)~,@!'ek9ïk=oEx`OHo:I`Ym#-Kx-2NZ@i[Z2đe@al"KoVs\ r b96[tA(j┴$d-NKZB"*ɼŮ~ $u[pԽ]˂Y._HFWrUzlNY[;eKSGr[Vyt|+߼+7|;e}\yw;ˆV㤹PHsϕi.(-#QFz&f;ˑsQsj 7Vڏmٻ0Os@io]vٟNBvI{hclnul$KsɼHyDrVCZ삷K[^7Mb'xJW"F1W"F9ͯDmGgn7LbLCN=& B>uxM#-ݰt僶iJn֣sfKb\$FF4Z7xh Z@HrhlEþ]vI <$.uo{HR7Խ.uo5vc>w-uo'1"-'1#qIhm%j*{I=+DM7MbfZsdaU s o\<f`$ǶSػuNl7MbZXJWJlhm%xXpDxXpUJZ֍LMeiPE!!^2v>F-"mX;j*js@~2t:NJT+dDČ~%fII6:67~]$Ƽv>y|E<>;<>`5Mt d)(fptpN`R)I#qg()S>՛򂥾:]S:K~lӥFy(%mS'<#OS1s[gnzi;t@>Xg\p+Vڪ| Ny~My4U{powkHEG|o<霬f֚d`<<>|bdNSδirnFή&'kl(?/e鼉7=ΖuG9|af>a& rկD~%RD^Por?L7v&;u=W6 |7v9'SR8wH~4󙰑!#`^ݏhm]-is[TJ0yD:CdT2{T2E]^_cq#ZB]TrQyD%绨*4.~wTruQI> C{uHK QXml;u77win{s=r?Ę}%r+V"+$+_zD}XoGK Z!j~+㼩}t[ѵU.j.×~UW_萶iM&umYEqWѽ1kl7~;'[ W+w&{`((bo?=fxaJMZ,}E/o!t=~8fc݆w_~kMv߿O{݈ԃۍ+_vwI,&5PӔ 2V_ npW OE鞯,wtzD"~]5ǷHz*)B6L[򎶼L;䌗?[l{t!"}sH}HmR}Hx)|l4~KUƔ񗖴YC/oOPRkGs,zi|GKBW bCCj&)$QU~؈x6HTE97 ^ռk"tbBOz^UuaiRe_W)q㷕]C"g}WOq1T "@W:X4s~ Y)VNd/LWwCzc~i{\zO/~UBendstream endobj 390 0 obj << /Filter /FlateDecode /Length 369 >> stream xR=o0j*( p &RtTy;ݳs PʨN$5BTgIcG,.m#,hohQ lsVjW(+^C_DI">n.a|騱j-Rh(@yO/ J '8BK]P/lUEL1bJߙ^OpƝ"GUxҎG{#әqp*4&';N](!LWv3oܠ8|7(Զ!;%!|1pNx*> 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 392 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 393 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-emp-level.pdf) /PTEX.InfoDict 255 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 262 0 R >> /ExtGState << /GS1 258 0 R /GS2 259 0 R /GS257 260 0 R /GS258 261 0 R >> /Font << /F2 256 0 R /F6 257 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 13304 >> stream x}K-q.*^(Gx!ʲGX3\(FMF_od%FuYwq, _ Gnmx3Y˥?ۿ~~uO>nO?o;)oi[o?mtuOI}_|[Ҵ< - )cT|M4 -Ox)ϟCem HS  4PPay`p>œ!T08VcCE=T08VʮRvLMj9k:? PIVpQ:U%0j4z-MTjWapha}Shnqx(c 5ƾSX*,sٞlVKifpQZZC co ޵|٢sc[mq;M!i6ph(&l~OlR5|~/Q}rOR_>;8`~ρJy?Pv:aqm =}Tߞ)x~BJڶyq)@Ӣϕ`k<5qH*S}b7xKO9|&8!- /Pi}dT:}=K)@_A?b=ce= <>͡} tNSO %-4NM,[Mu鮤?;\ג1)l G8#{y<=}MΞsap15{8l[yRU{|$$jH)Kð2 |}02~m>~HP0@v(*_ߴjgm]J`P;"\璪M=By|e ;4<.i<秲4\Ol\@;QW׬DUzDvO VrӅO첔vJ횕Ynr7 ]d u7yL{F_ ,V;щ}͍Nj4Bx~,{89Lq08rfٍ6}Vq8Azr8pHuCҎYOjʭ,FMuDei"~ILYZ9Y?'Y6Ӹ='5i'y_Y.{`QOuC"_A]2kGuA_؇}Z/r8}aJji 6C0{ӳZM+`4.jyX_8JzԩL^עQOE&{SW0R_d]l'5${wI=˗F]@] _YQ2-1-읕)g9l AnA.^%AYN]@}ԍzOq*݆;zԓzsя{ը{Ы+Ec: rTî"bH9 첤Cߌ7NL v΁`e#HC4lC8}]D[Z:g CJZcid^6m}4ϭ> "@s5hNWٔfT_ei4^s5:3"{dRթ 2W÷Y#8a9$e 1oL2Hs;EF`=f*N039ݐ Ⱥ0 [(2_zqIܤChLGd { 3PД3~I;{5Vęa.{:)Fhl. Gu n}9 ~qAI&c"Y< CwPe YOI):峘4'~[ +zrx$j"1퀰 Yݟt}4inMxMc@V=MdSVW}n[D?w9:4>0(';EXw4ޡ^pm\VF+#E[1vPLwf[ep F pPdB1 %pPΩUP8T;HXaMnNOiLl܉ъ؊݅*Ѓ*Ё*3)ԭFX,+aDbFqDlcyeݥpc<.Z1ցTZDS1T"*1T.*6teDW]q;6<<w]w3ѣգdtџ6Miz|@m0%~.#O5ig4Ÿ,H=7-aXff(.y"rI͜6~;W4Iu."{^e=DT}CPsǘ4qp036s2 y_'},Y֫}?y|9ugy`N.fdoi`Ncf~/g䲨Fr]-"9(F!3e;cbPw)n [|5vo}t:7͖Ent R yf h񭧗hO,k)s#GQ6%g}Vi %s#2-֜}v흶f](#lhBoַM*7$7l,/ѯ hraqe2~A55Z`h_X_XeH5< k0 k/^ `'a fak 04Óg5I{ c*! PcLY|7 p,<0D0u 2hA*- G rh\0ޏ~d038ߤoFaplbjklE{ cdi}`pqŚCC^2էN41[_^U4۔c[y^? wcmJM|8ǣ}zm5ߥT 9-;skgF&n<Gp(TQjOknXRl+ɖo)N.yl'+y[<wӱk8V<?7XC>E.n?7.zxr:vS,V,hZ>᮱ex.p|M_sb;km8ycMQ/᮱KW0+ֿ3_]⬖iv0~z V, 9tr^Bz90i2H_g6w9Cҿv~a{ziz]ɶq&txilhy`?<(Ɵ@蕘W 3_I<ĩGy < n<^eJc8r9yxH|ȃpuXkZPZ{6v??mzW;ቦPYǶV60"waR*w~vYmr(wpR?ueB\@&dцk;W6(r50tQ(^dQkfq Zfe*됣 "n2lnۍةuKjUCi>I,wP>V(ry8"wN1,{]@ۖ1}9:0tdwcX̶Yr{? rH (w52[fDwUiOwVN w'wߚu5G$082?_ !LX^F^'Y WMvb2r(wߚC'ɮ w)OS^.a>=-qmKm?L,7IrF]u_uEk7Q36 }or]QIN]לs 96uKMdàB;]Qm)jM~n1(-MWvu[r90yؾ ݹ|5婇b#mڨCۯZA9p yb2yqב;;לUHVd'lWy/nHNbfB*Ϻ MJ4'H踣Ҝ Q58L'v.? O8A^.t|b2ڙۙQ\sf]kp8D3Ɛ}M<(/Ms#<R/N{yQ w2ڙ?71(rӅ?YLziϾ$oC%jN]kNG C1I7g#8D G'I7m 6a=a-\rw9 Y:]`93tE9t.Fލb3~|?$-qV&+\4X.{`1P\hT] \d]A6Iw/vq7-x.0j 9<3[cWhr AB8\؎qnq[A FG6r08rcpL,itӉN@[WM/EJ6;pZÛXtP(ȡAIhj; aƤ :jx:;g6).#pPϽGkCڎ/c?tiR;;}6ZǬVZ VZ,qi>r8*[?ؾC߾[OCaO2Gh5{B?4nAh%8<+S\| |$5.6NXC$Er"Cy'7Vx»FYFpVk]b^8s_@+sI4-Ӕ-[IdNir7^wMt?MzdGbk&m{td|M9`mspއ_y{CG3Gs_;,d˹Zr.kǹo8ԏ](+j<_9Nќ6 C|V_ SY' WE|VZ"<9M}o~؞B{Zx.>n!u }SfiIS@p14ki'ђ94>e8bϞvwӓk׳y$Bv0|;{Ͼ=w~[ $#d}/ C~7YO=bv;o~!i8a>%7~Hv;?;~KKFoa`!_]kAn aoJ>"ycRR-}9ʙ-9 -9iQe0g 0gk $ђ{ d1Ŝ5Ɯ5Zs1<@|x/T`>T@PaPQZg^.s(dЩ%3G9e3G983A>sg }xBs:d4|o7Fc=Tz*0* 2_{|ٹG#.۲;ۋ&? ߝ>ߘ#3CI|}"A}> $m_'gsPg @p@29w"P?$WF e BWY reI'nW ,5rpqnܰCe}H<&xrYe*pshl$z'D&DeUre`_[ʥ? 7PVΦFFM˳K[%. ٥QJnC hNbrXy9 OI&+ߙ?@TX =ttxJ$bQ}bny?Hyc ^T qJp)q- :d؍oQ[j]ZCeĀԃx4#Ic@Rf iHBL:;d2;bĀKU-H+]>#cI 0J-1,i ! ~ϴ|PLyų$2Ă'KM<Y/ENϯ@3!m?2BҦ#Hv. O'[tF9NKfI9?I<E]Y>z2\`M+16(rJj;/~;]+yh~)L|d9@J{, NW+\R~f+ide~T} O+4e#dO6Ǣ>^ގ@Oy<,pGڞyrMধ=XqS1 RUx(ՠ$fL7 Y:!uߜ^ Ѷi=\.;Yw n O{RytB5e}?zDQ)y2-9p yuwgy[92ܝܗT:eX͎,O%ټb /Y\ꩄJ!EY/'h:,YMcd:0<ڮtw<۷jՁ'J!EY/$hY@S)'b(Ȳ5sIӱxð O{kp>@s3qMOFyͺBs!pܗ6يd+(AO3pl€gy@Հ!KMY/9ml+[!H[!&JM|<xj[&:]=YIeJMTzbAu .Xj/uЛ"z"-!cK+SzˍKrH puwV'uNrH7K8[2=4E:&;>Rvg?p,{rt+{'Lgoԑԑ`gv-}$KMpX/6>uj!r(w3e08kn7Cl@]ܑIOd5vNq)s9cs'Y8|mqr6=߀Y89I}Լ .{ѯn`fEc`pܑcۑǽ%oi 79}t螳QW0P͌z]|Dxp̦KMrBb6k!x$ioF_&'A'Ǚ47/xxjxtxZjxtMSg+hH\Eq F/lܬ`Afa$xÛӂ7W{xPW]A +9xʑ +Oy݈_58E8|ycC62R$xsc[G n+ Ap,]8෰))hVPqEt9A< Mc*S=pW${ ߚߝ{a6~echf -{R׀t;ق]9/YkV^>̞<9Z͊3Zs^g6 &vxe M^թ99M\nLjwK 7L`JU޼rʰ?''ؓ?W~2n+'QP>ڽo<Ͽ}Ory<v?~O{Q-YJq }EX6ٿH/O>|l/[{Aα#?~N^w75[H5V}'iR@^:ɋ rr FS]w5j<^Á*<ʅm١^TU"؍k"ԍGcN<)>=ч}KOtay<,=сgr"K+>2me77[FXrm#)U:_ք]C.r$r˫{}%|Y:\"rLq<'bt F P6 lu]Vn`+S0wg n9q8LcXRu:xob@;u_wllyZ;jiRwalh(wZ+o޵='Xv9 >28E>iI?տM_Λ X:}E2߾}=׭8ܾ_oN>YWv6V6z򾋫q~Lz^f}#Vh_jS=]پO j̶V[y#ծzv]iT\p<;W'!/8&4\?yA%_L"ߝF=q9c|p8G[8;1xjK~X K񑨯X󢆾,W'6VӯFqj46.Os>$pd˝9c'$NJr`DMWs9mQ>1+4~et~x:hgtW٧“psm7Zk;. ~8텶.0~e7L`p~xu}=g{@=  ։mi$`u0q'i&A;y0;np0=w Ji{}?v{iʞDb m˭kю`)Nڤn 吴{azz}xdE&Pam(&P,&. L6M 8X8p0=w q 5 ^^#EuKoIɲNjQ[#ߘGo S^zߌֶ;4 6(74 lMY;OTþtl[T& [ {Izj|E.!|[L#5A'.읕GɌw~ٲ7|ԒgiW(fu5PR&80+¸,獺mN+?>hïͷF|<~VƓZ 1W}3endstream endobj 394 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-lqq-level.pdf) /PTEX.InfoDict 264 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 271 0 R >> /ExtGState << /GS1 267 0 R /GS2 268 0 R /GS257 269 0 R /GS258 270 0 R >> /Font << /F2 265 0 R /F6 266 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 21405 >> stream xݽM:_*A|Y4jTe 7ݣnehʤ/M 02ޫZd= I8_|{Y^J^u~/?|I%O~w,__KRsoܿ^㵦ך_Zy=Op//({`y״Kk~e58d(-dQȠ8dk[B!3(1hP2ө2 kcZb9K_bPaަCzZԉg 9,!ؘr3py568:4ű:4űuZŒu1B,P&R 8Yx(U/n3ca3З@_~3oAk6ruS隴u[jwL۾n* /Zx[9o;Oe?nKOEDgd_`n)A?N$wV_jڤ[f™[? gDw u9~™^~™?׆׎"pLd}M9ZP,S.X }8Xؤ™Zyc5Xji[`pJg꺽frXϊ=ygjM?  Ut9jNs>SUoSׄWXWuųY5I 6ge< Ń :m`2뎗6 3)tM_8u]$a' әk$V <(w>ôhVsO_~Sh7dwgn; T9h Us('OfZBx`cxWǎqФS):bxLe#P1"zL^0oTn1GK(L嵹# bxH^{-]L^]cx^:3op@ϯ-p[=UAg5$Τ5wSxqYCye5&[>꺁47m[:܍h2U{1ֳwJ;Qce:c!c=ˮu+be:]2I*[Q?GcEYC_Ysd7M7PdnQQpB'#(tBYC;1]u@t+be:Z6i/Pp~,؅n3ebVy)\җac{&R ݢBbxRL᫇p@΀j _×JoTnu4S>鋌v}!<\l^}ݓUyV1<|HK^{'8bxzJ/m^{E%k6cuGٸqXLN2{:f>>Rܽף.##B7 =><,<XxH1:wH~ Pru=2^R oC{Y{9^'8׎^ #.RMZ5+/8V L{{=w~]>:@=1P@ίmq"CUAr׹{D &^B)vA{VB^~K-%Cxw֜|I^:+ :&b }LB©yqWjP@2S^![P(-7(489]SDw0"ИQ489]^)Th@oU>%(9OTByso]YjhYfe=r89Mq8NKu~ Jza(@FccH/?8/; xMX"ÌU Ʋkl ݭcv:=GcJl]~d{)&;4Imc#5做ů$=rSK.],ϱ5F $lk;6 (oCu)d6<g8CrAy!y=!8!a+c1C!Ft(dtv7jݚ dw[:aO' {-ᐃnAs\%8Ĝ{qC{}ob@ 'Śk5nDvt-0^h!ݞxI=~yؾ}v{S|oث Ϝ<[DjvE&]?<;t'< ~}w=Ƿc߄`ς/Lhg&4>_f68Ng'>U®ɳ'{{e~|{H!;ߛؙ|zv8= ¦dp-"k61,v8Ne,xOfaz~Zg;AY:ܟ`o<'{[JпSn v°̄7솔&qc{'YF_j#]>{'YWc82ƑnSCS)2A|})p޷ Rzk:8g AZfMZ;Va|oR {iJH6T9[$ ;pQ;|o*kd)!X@k/+B􂹧rw }0*7K?Qc*jl3ϴ*F_oٿeJ7i䫙|VtpaM֐\Y{ͲXug[ᶙN ;}O}kU XX(kHuXLePf\/~{L.b- s=,_Xk.u b-C-xlcjX{}׽X/kju+beG~{kJ| Lz#J), NY &W´*ZK7*7z-bxho7n/A ^Q"'1ިʏm_2Sڛ#17Bhc4cxUr:hZJoTn;tCƆzuqk~K'\bH){K MyJodZNT~̷ίNahrYz UAZ*\[Jd)Cx|r)6G KɝL c*݃\[X[KP5 !A@SwȀ T/쭎{4g|o~Qq[S[qAZfM@vJΒF%ZK7{{t=d2G37 =pwQkhtr;|oe>e+,b,<2<t7/$iqXXhP{H7{NY|)v#)37K!Cx`72_R;Y)Q-m.%.E+d. |omMMWl7E7G8Cf|o)7fjN\bp3n [+ګ,f61>^{},L Wgwu|`?{K#_kg2&|n3e`fk|oi G`cG ;D m㽚hضha`f]_1p[X6[C ;YYƎǛmP-Աho?C|oQWA{=cLu?;;MͷRk3 ]~tV$[ZЎĺv!/} [Ǡ޵7 utVX؃Sx\6[{R-(lq ݰ*{xI~-N^;=<[i La,)${km 9!rmꦂ3L(;g|om5(\A75m 0B|oCoCi{|FT5]g7ҡp?,9hN g8[uV_|}q{@az6ۺsq`|o5+-^رc;h2ffc:[}{<k .5a 4cp{ Y|k#{mR@VloTmN=?K@m#uɀ=yKx1y#g˓GؓwK&yr[Ȓ3Hs|x'h|`%vf7*ƈg* ͶF*POM S}n$t۟=}Bv3kVٖnvjzfW0pե^ ;aؖHꩶ!7RBn,"n˘s4s?HnZrKno6I4O>uU, ]~D{kKPW1umB̬{(Kמ+OϠtذHyvXl|z-;]"]7r\x-Wt*{P2!'%z^7`׿03 W f"oMψ vt|X0ߝ4%Rw۠X?!#ywgV )G+L~у&kně6 #ԇ="`2ѿ;tj&utj:Bc=wiZgI@VB""ubہwCDH(#XrH{=Q0"M͓yL lTpI)Gw..l] $/ L-@.z'XOl3tH(1@ZCx#yV!bbI=>~BF*/T&wV 09^n5i)*ߪ/D67}ɖDٰ I8L/_oDٸ VF>e|զo,BDgVN1M ~Q9(nJ[H ݡ,XGh" ! ^g~\! Qm=ƈjQ6w,1׺/݊;D4}tU%@FG4biso07<~w'ӔIV}鶡)rt-pr*SV4{;ה|eEʛ2K}m! >@&w~ oʪ `w_ڵ {ϐkÎ`ubx8/S& W9fEAsRi֕da]M4Y֟$a{f M4Ȇ3(hްvM؏4+ u}޷>U׼4U})öٶG~yF;J ߸6Ct`4umm.Y l|R[yJRl;0Ny0HMV,M SkԦKh+k{ ͓^L$ %khkFm,)jQn>_-lCmh[؏&K0k3t{$)uǒF?\~oP}]KWX1T'<;z{*48O=u] «la W14g <먍,.kK}+gᾸO}j<4Aά*a]޺b1џK-Öہ9:o]Vѵ`31]lWcltȔqŗa 53xuU~kg[>K#˾||YXI!S99do-rXQ99HCsdt{KR{1ygr+59 k&9d}39hks쇮<!y-<p٩(؁cvF豵4Lxk᪞6P-lC=r0q!Vw>X1ǡǧr{Ez%!'Xۼ`YE, ĎgHx%˿ͯ4vGo~20\b`VtX8s/ev6wQlL6=xC8 -qC>e}P'KΕK'vYyˮև;Lخ7upL}},x G/s[^/7znn@*h67?wlnm1۪^Ćþ&vp'x̺psc6vvDʜ.,*N`c&fc_6+qpa=vuyd=oE^ ^:Gq]Xox6ڃ6Hpt0ͺZq肧27L'pSy sdݩcc+P~EZPxν1 DaOW_ٔHHY1]7rö/F'IY9*BXbXLc8dW]&hbNO)d\Lxeö%cW? .KXnz`KS!V/F']&m2mʾ2cM%ƚXۆڹV4t5~q_մV=V0Wtt5WaadC?i xLW%cM-n vv(_Ml=(?m2,nX!V/FWIQ_ѹ1qX(KO2bQ^@1VK_~ݯ&s:Ċܞhݟݞ/5{mھnu c+@ #cb 'A{&í.Ke+@nm3~Q6=~Lx ߑ' WkdծIY?;_i)eߓ.cܮcX5jzXs:+we==~7W~0sdQоUOà!4jsLckWlnɾtEFQWm2a?Y/mpdd="Xhq{(bEzg>ƚ9m: 2ݣ;'PZc ˗do@Ckl 83=0P}0h=^V}QK ߯~\=&(q.E ^KaDyjL"ԭ'zrԞN(Sd_Lc2#%vmy.9{Qn,v_ѓ^f$ㇻLg,%Z%nWnteYw7w,7ۖL6=6 VM؃=v4jպk@V Y )]lf:l#s!NZ[.凌t*h2vp kXECO9t7`a&ػdl\/t^g{^fǀ+]7?m){8ufa-,z7i-3/ҟj3mB2^[yY(scAHܚn.MsYƿfAXI9X['w~T -3i 6|]tqYp֚&@ hmYWM݂ƒB3-9>[y`-ªZ }-Son֖V<{Jr#V a.ʼ=TY=݂h!exͲߩ`e`*qk^tz0 د[VnaԱpSFu*=_Y('>b2=sj_c(sy쮓xI:LgN9 l\rn؃Ly>mxہLPNsLYA':fF*h;3_f7|c =#hYz\xvf×qiAkixv&(Jt:ggDeD5RVl6ni tb4<>Mg^s!t. IiYBT䛯pyW\9ߦM>úγ.KixG44wY:ϲ=/oRΝJ8"m497=%|kڻ/׺=G4}``o!q{\qt [os rK;8У}zoBٙ-CMWb8=G+xȱEh96[9=Ps.1Z!ž|caqc*NG9!_s !sFȷC=qqIȗX1v;+[ CYo-8+RhC '%s|/P~${␃|Aʏ|/?␃|As|oq<=OȧG ̝dN$snby!A)h#qUÅZrM~B4OrE]ncFH@'ƅ^X/<+.uwBރ 7rPJ9SGV B@86+ dž ǖ 4S9dNM=? BF'iB`cOۑ]=!{2֮y7B~fN2OyaF0|+剻|Y3 6ve6V*u~agxBȗq Dvb'!Hay۫kCX(KTU"{.RsXn[|eiUصۓPw(jdm9WV )ۊ6vL_1߷jWޟ +ɞde%Ww$e~mK_~"nb`X-,Q=J;ewqe߷f>%1cRފe"޶2ƺe$.KXqDe3(nӯŎ~"˓s="YI8q(-c 5ԼaW-:`/g5L_EOvX[cfOF/ce@i>%DPgnU=EZ藣-E1V#F.v٪mtWof ߷uE%1E%cg]d1dN ;}HfjbK_*Q 3{]({ɮ1 .t]Nf:l!_b-͉:zm#%Jޯ,:3KقM(j[|}1VXufcS!Knm,ȀO2XJRP(6؞"KvŤy?XDSӂ]xиGYHS͟?B~/nm1X [)O2'N5'Ts=kTsZBM@'6i[>E$ O:;RR-=h3ӄ|y@'TsM=M !VZ[8hh Ї`ay S9qZKf50 тo?Eȗ'e=bO׸Ϸ#O76-d[b8bK`f2vR|ytJQ|ѹ/F[=!:tN|!@E)]8 f93] gՠSQKi!_bs]' B!PZ;)]cZ ;AȗHO8Ʈ4|`%Lxft yBȗ4::e83R3R|3A,.ACƭM' Bs{~!_/BQ$s 2|\>i./ӄ|y[[}7V僽h !_{n y=P/u8b)B[=͎Gך>/ h9!pCz۰!]N=w\.ac}z,=77_ft,\;O?$"0PQGμ?|tn3H' ={%>7P `m)ᵍ3%Bmgm׶XuҮ8J\[iҲ]m{ҲYZ!ݖ 2\X_X(8p@fdnw إflRlpՁȼ]/|¨JS w7?aׄ^M!BVUOgTtn< @wg.c?a jp#՝ o[úlSNxc o0qά Sm nkm y6|\/=agH_qA33 |[ޤf 0 @7sT|jf7XX r-Y)\`\xŽ0uEй[7xvJ gXGtǨ?יe.;>ayA?΂~ya%̉*@k7HrWӜZo(M (|E~5E/Gm: gm=U>^ Bx oiw/<_8tڣ#Cxiɝgr݅9TxC-Rjoq2]=jou kV{K [Z(B[C-F_okCK=֍ d_;6 R 傯; J3SMF=͑fT2sr5 V~ bxL7 <%(l"A  T uv!n([l%HI\]}۰%@KΝ߆wi Cj(4_o1Էd.`2-[T%@i\UZR 傯Hg_91}(Y`r5'.8*1P.zn#is0EfvO) *d*\Ge?@c_Jʘf7Yev[ܴO@.Obv}U];`ԎbM{=tb]yheԍr^Lsնb{;5S5S{> |.e^;&,6ebxԺv]^,k߫4ϲwl\ ]a[^~o?>_fz ͏5ie66Jo+rގ ocTW4l*ܯg0bg+Y`LlM{㑪CS]M>ho ;YT_jcئuv]+ (&Z'Aͮն'„sMa> /[7òcR*4x}-I衇z #HqW3p ޠcŨvP\f op1 q n76sFB7XحaDdԇxoPOJ3x=Bk|~Dk3 VKy]m[M  㸁Mp1Tg IOu%]ˡ` Z覩} @dTLeK?Xx,2JZ`*fz LI5/#_ksX롡孽oq$5ș;c+v9xFi!N9섀C`9x&CaZ!GFijKx{(@=cE=NJSB=bq )ppCbA+yhPs959cYc3ȖxYd1v%9x@l-C;쇸_ fn3グOq|Oa3bYy\mXd|{73)\ui: :oן66!3(non#2׳Zqhs_;ث/2t6j3;)fc'ǥ1B,km^wQ`~plRs׎3(?_ϯe ΂uG7j߫6t`Cvc~Ͽ_U&A m}] SGU.d1D1˿2옸NvLM]|\!y|2~Pfqeכ_$_;=Or{YE1VKg,%J8ï,rϙFn/F'uA߰_iX|ppqO'ȍzv]Hu#7/l<׭i+epb=yzmPZee+nE1VK_~O_{dv]LwG66.DzG_Xk.6DW҃ߓ׮!m*=q:eGJ,m.[0Iݥ m35~Oޯa>7acLdzخOk6L_~Oޯ6"R5T=?@1VK5b H *duTum3~Q6=yYeV=kbm{U=}A*_ &st;ۉn>=^vw̷qC UϞ(-ʞ}JXUfM#Eg]Vuinf:d2ۿCY=^?@1VKG,5li_QZș.vFRꜦo1 f uyc PƃgxPp#(ry֙fNóL![:m~Y˽ߚgsqz4<;cY9CްI},[3DNoVk&_u&c$PFVܮoXY,~4iNΠ2g,8ۜZs3|::fsG`y74<7enNRix}͗UW;0ڮu$.16Mt L ix:?6ix 1?0ﭧX$k+-Hqn*n／^JG{_7 Jh#m bLOl-rg?_?gOȿCkUKȗst.qGz8G 9.96CzV?c{s rϡ8-𐣑Sf98e!ǎ o=n!|A+${␃|As!r9H=%!?ض#,Zp@l-8 ?P|kx ';^:ġHġtH!9H! !~y{OỷdΣ?d!_l(6p4Pa!l3 »}za*䨏l)e^&/Gh8o%0|#,ǑOB>lu9׎Q!ۮdu̶o.u>7l>B0VYF}4^熭-6XH'6@w|֝+gX4?Bj'S$=? B`#}6vfw}PZ:b1Y"c- %C%C݊bN(E몣!f/R'eG׎+Nٌ(j[?XV9\@$f;bc@ft%+,QuJ]Ѱ\6wV̞N(Eȗ{|߇X)a?@1VKG,&KcM]VtɶvL_~"䋆VXWZt{YAݟ)][cd.B0z D1VK_~"B yt9e:b1Y"Rdheuuܙm/FoծQ {p߯ ${]_ ޑ&WtE-B|ԁ.7Iz0f(jdpQ[՞@RtUeu wɯ]tI]U,X1VMg,mBYw0 t.o}w~)ݞ~ź?X-%Fz]Xu=u=b.ǃ߷r9aW.ʼnr(=c &KT .#i2/FoSq"_o%WjjX-c4%r"hͺ)m2Mwq"ٶtǃ߷f>%k6ګh9IK/}L%M5dn+.Ep7B {~2+Yd ¯<](--Bկd!X-PPWS* ce[|ѷZ8!V{,KGc-zǺ;dl)doó)hQʿǚkϦ{tFB>/k$g &;L9q($"ٶ_"D7ds٦⮱bWqu~['wv' [4b$ j.eA5'TsȭS5z0 ~<-CM,6,$N܂Rzo])=!R O)'P͉\=P~gfAK-&8޾?8 !,w֙f!kw[,X%Xg 4oۖbǰR)B~㺅qfa\՜8PZ т`x_/[G (o !=.zBSfO\f[p/#a>C/B9!_tDV ;Alwiz}BjԹrt [ '0ct7t_%4|crkԙA`r79:9< !_fs j!_9{y B~o]s}ΝN+]g !_}>0 Ho[;\(`: ztnlsnO:JQ |7 lv} R|[Йwli: XBz؅mc7|e(]s`KQ{H}`Qk ?|iVy{.Wvb}tMX$=a/a/h$=n/=}om_a|ffOfXe||<͎-Y{7_N/3sw7tHՋ~3,GL7aO_,_}_Zb 9o~ihuS+{7/[+OjU^_J|ψz&ycxOqWΏΣpӯ_~%p\;gCX=ǿտK^^~L칾sܟ=5@Tp|V){OzÝ /GR|{廧Տu<~Hǂ L&Xc|V}a~\GV ZåZ} Nv$j}-S,X*\<`Oǔz9TwhYk}1\3Q:+o:DhZ62-+{nl| 'yǑ}NtBO `OǡN5/]#c ,E:ja^Y?tc-gmy|vҰr +̇˰|XQn9Êr-&0Yڠh5daOlfnyYt" O7ü.27OC {C!fa@x כYŤvSXƐkwMatXhcr83J!HgT2ݏDz?~@%L)OY:>d}Lq2i%Y|c|}+H;07^Azw +LMW8{Lo[?Ț2?ƶwؾJWhaaT0P`T_-|pԭƦ S[ʹ-8M9˴.Q^̹JMO!k_ˇ9Enpod'՗_OaEfZkkF́>ݥ*MY][/d-3.Ϥ/_ﺼ'Y"]D]ʇ[jhj, 57Q?㽔[w/݌D'RۥC$//y9V\aWtۺ|>et,]ɐW]hDV]o!7m3=]eƇ SVs}Fa2iJߓ`7 ]/oz0hӛ?i neako *{oW VRоV= ھ8nF,'u)@6COn ie-}sw/URΏE;{BnQ292s!sELt+Uz|_#vwfD+Y1Y]MW_l3~Q6ӗ<♣sFOQ,9muYi<{QW|_b[,etԯżr]McC TO&]~dY"^?R~>R'|C͟ߪWѼB[֪P;N??VHl2ޔp֧U~]UΒ o\q¯~͞p *,~*RJM v_Uv࡭ZB[*YoZVuYLT8K*+b㷿},O—#/עA_΋3GӢ(4 |%Fe5 cY?K?_OͣKKQdm3މWKi|oEendstream endobj 395 0 obj << /Filter /FlateDecode /Length 483 >> stream x͔=0w~G3po"uz[%MHD1J1pEC`˼|< jM Q%&L湈>>v.(ɻ.]6Ea H[)ޢ8P*>ͤDtYX6񼩞Sx&Eסkqw|iZƐ>ja$-0Q&:q0Zj}rPMqc}rc΅m.s*:ChŏTiZ6jZ9w{pXi:{H28HgZ5e]?ȹV{!h?!cJAQB$Oʼn1D%!ߋ//RQToƖxsGG#M>ƛVn tGa9z H-d),s;Cݵ}3lN/RTjTx8^8Sv _O3<('LgJxDendstream endobj 396 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 397 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 398 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-power-1-0_2.pdf) /PTEX.InfoDict 275 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 284 0 R >> /ExtGState << /GS1 278 0 R /GS2 279 0 R /GS257 281 0 R /GS258 282 0 R /GS259 283 0 R /GS3 280 0 R >> /Font << /F2 276 0 R /F6 277 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 9222 >> stream x]M]mx˙ɛ,2+T"Uya{1S<?p~JUZL@\ ӯOw;sJgPoN9oW_~ska:ſo&/._?y[OOwߟ6#MM08|0mm ,)h5aΓUs. o`紜}8~1e/z[DfpP֞ ԒyZ y58| *9d`iF 9(T08~.9.b%FUXLkѱ9N@kOQ0yVSiXpctׯQTEKi(ԱNJ:\a8o) ?%RȦAx`M<ZC{&]c 7Fy }܅c{ ;71BUZ>R a!Zka =o@~ =k/T YvvWƭ3,yumt(VǠ _Ky}ϛxe)07 {~=?{%}]ɚW7{K^Ooo^RZnE$HXkerlA#-!۾F|sD{^Dzۆ'_F}5{ڸm u-|O)jbޢ& |N&n I_E]#jBN{/8ҽdI70VVkXt#&ITX}aWdd.4 ohAօtV1/ڧ 2p$+G+Ђ&X*,!(ZGiXpct#i鄯9#<hZ@񔮙9,+kMzWM6Q$;j2eK6kS:Vkng>W߅7 ,3ޖtc.G# ςU֖ՓSase|;'U?E,-^)4,1+.h鄯,2MuhQQp,{ D n.zĄ ;:ꮻšBް.5 _W鲜HV7Fy=bk~f?Ff?F7MxbE^B9sL[>ozLF|: 4UH@kmmO*7,1!{⺄uYbj}ٺ5WQ;q8-UҚ/˺˶_|'(5qӞ#č{bָ5Q7f 7u6nέAQě=MNk&Nv&n&u$kkBN^KU A& P<m䛚xX_GN|!_9s\12=2Oq'Mi<*'ökҜGpBo^1i,oҴNmmzvi ]c^uh4KnB/c{3~k;ހp/:j "sx`E^eyloR'dt 'd0Һ }΍۝'o;dpNswƥ-ϸsKxƥxW;e^Jk+xNumh^ڼ10oݬ-U5 n.z\ĎtT1F0clS7T>eʹȩ&j5 qq;¿MN\bZ9#lɦAx`!ZIӤK2YQxÂ"=mqR n6E@{[:Gl`E^S=3QfkcdβfMĪxZk})mx%E{Fy=04ySfѭ7e^[2l x4si6!7ZKiisyryY X;T59+`a66E^:~zVFa}aLA`CH;iMZg>d7FyWy {<@v{+hZ.yөZئaE^㕬m,='0x .濂@[U]"SB,¡5kw%[f%lѓ4,a)qr )0-% :Wu'" 8 @gq[)2b5q*Ok".MH0ǥeOs=^HгμDѺ4<mU5^5!y& lb -a!K`Om:M@>b cai"39SΥʼ 6&<nUk^2GM[0w Ν&]ꉃoݽmh#߇ˬeu,:9/d<Rnb'}OZ@#o0D+V#+W16 CVQԸntX"45ꎚ(KZ%6(jxp !Gh7qdmF 2n*TV֠ MRrKr κomh#߇V㐓xc ǫN (1L%hrڤw9۠ _|6!^.<ܛ'n2y q(~ C'XG5c>,X'3VӃ$1ΟOdd{B{lL'?;l-vP:|vtǦ|vtCggw=݅l> M>֞fۻ4Ky{ }"wS^g3:e^cPcdeWD-##Ghk^Hk9XwKƶ|[6B6/Lj_B5h7da㵛ga={uZͲu{6ox7ۙ%\-՚[gbF- g)@-@϶͖dh*^a'impbY2Ay8*Z#j>XG/xEZ,#nlxp 7d', Aڞ𹢏,}gޤywܳ6O [^Lf3}E,)ڞտ@$mWuiCxK<DmDm3S-STm o{@K>><h/J 2|m3a-a|FYR l-gCf< Ja?>ˀ#. qP+˼mXeM](PNQtoNi cx/Y٘͡buPp:@>Hu-hb.N%< R+IA>&6ODMgYo5tMltM-^HHKh=|6}3< 5a?tDn엎ȭAQCR{*^2M;m>/[[ h#:W,@Գǖ^!'V}uIX0ot6VOz65n@x=0Y6?J2tɦZ5Nx}KYı֙&wz^ g^6¯Il'V#Vk.c!]u[gWAxb=^`{ޢսϫ3hA@Xt< fĈp-j9M`^ ˔ta|V (l|Q-hZKfyളi.m|$lAym^qۼ$Jc%.Ɵ %M͹i¼ jyICs}`XGeo)"]m&=Q9hG~=C,8ֱ58"Vo)=XII;X`7 k-2M XozM͛#R~ t:։& U,vFln|E!5@gѪŏDf Kyz`DY %vf # ZjHxKJZ@K6+*8l." Y98l."NRCV)\DގWZ65@x=0Led#l$XtxL$NlSeM`g$,k끑1-! 42BkOMӔ6ҩ;y'ָ]`ܞ;wCS;3qD0>/ړ~)\B1];@Flh!7hʋv?Q ^lmh{!MΝ,i9xn<δ@K&F3b +4g^ y,(.6!u=S]kg3=SI:=Y{lXt9d`mfm'mp ay9/qaZָ-ͳ|w7!qsx7o<{Kj4ɜ1A@nqW.}>pS@":*\]oDpYjW}t6x5Jy&|qOUo{W:bO/xRHǂI[g~?:'|z}8?o ߼pgM#};o W\4Qw^o{/VWd8~to~€xkݡ/Mg'0 lM#@w '(x ugQ{}_ W9CHKEZRqm%#}hil?h`޶b1x)+cb1t)*E.sɷd¾†ns7Xmu`&:_=Z&KSz`@ٶfuܶU9d#+)og*Lʈfx/-2|ˢ <(֦IF㍦V͖&[ M Mλ14_Xnf Dyr36ykL칦bL/ txrW)Z M,aչKjm}o~2>^KϾO/&<]}Hsdj,nf$z?[&n[ LrGz k , f*/mu\^^bJBYGŭQ~@S4VwT\SMod;w?~/`=jwq&&j$RNv{:<>4*>NؔJ6 k_'\qJL/0q~vh y*MڢGxp|mǷ)?]y!ysZ*s,~_pt:Þ3bus7br^v~g NC3UN2(%4;U0MA:6<2ڎ' b1 'G:CusF%m}hG^G}4c8!}y}DZ}}4vҏӐNOʥwK_}j2H/o6MTS>- ~y7g[zG}endstream endobj 399 0 obj << /BBox [ 0 0 432 288 ] /Filter /FlateDecode /FormType 1 /PTEX.FileName (/tmp/Rtmp8iAqJj/Rbuild156e8c1847/robustbase/vignettes/plot-fig-power-1-0_4.pdf) /PTEX.InfoDict 286 0 R /PTEX.PageNumber 1 /Resources << /ColorSpace << /sRGB 295 0 R >> /ExtGState << /GS1 289 0 R /GS2 290 0 R /GS257 292 0 R /GS258 293 0 R /GS259 294 0 R /GS3 291 0 R >> /Font << /F2 287 0 R /F6 288 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 9528 >> stream x]K%mϯ8Ki&NU劒J*/l/䉜kz?} :sz$J9w@$o.˟._eN,s?V\g]^{Zt^On?v2]Uӫ}ꑪ?r&mT\/i%]mwx"4fs_a]  ZUu y 2ig2E  ZK`dXuY)[y]&_|ZBc]rr5eN2ԠC\9d08d(uB%CiYk R-)uQ)5bp̱napѸJ!~I.ީf˪yOmyukL̍ܪ E,rn-k@m%k h (tYڗ*NÂ~Ѡ24[Uǘ頎#VᲶ>T(u##֍lgt |'iYAx`E^oU֥qv&RD῍y[2\QxMxJ51oI.|-e?/XwG^-om.mH[oi |#W ]`Zjmkj+a͍.zCE睒۟M&1^ڟrj kͽ]s:iiٖ)u;zM{/[!ˍ_|14jbMn[Me)5!$i^v$ug y:jlBhASD%4B-h3&>.5AKL׼h+W<¹UhAl%Hۖ}AEM@>c\ui[6FfLhxktnSls,隊c #"&5;][Zf/UYP&x=cD% /0dӀ <&R?)|ՅW W^Y"f/[(*FWZ47,U: ͙ lEҶm[Q3BX<Ko#D6  񔎀߮s J+%AxM 7J7zGJ'y]ga@a8he!]uR [Q3:ˢ#OmHbhm?k l}w*+#؜LXe8$] fE7Fy=cCi-]e5@@KuUv^(a!E^X"#v-C W oXktN LhUZ1u nHC$@ް{ /C˷Z>zhyz'ב3<+0EmHh Px]xbU<Ri_bI7.KU O,1){i\ƔEwI@pڅ%@͎fg%e[n Ӷ{e+h/>eO4Sdef6Kc.{4v]wY2l&_F;}ʞ6X#ڥ& dߣi&[66Es Mo|v=q/GMmbM&t wM5Q&Ԃ&mb*GuB>eO7YGMXBASR%eXuK"S]8yWnK:MM<,$)׼|!߼r洺p@yx@(dXiYV|2CezN8VvḳdC^Be: MP٭at+ML{rLn~vgLH]*󃕕f|[+p5ě~Wb@8+5-tekR =J<%ulS<:&2 J>.2ebM=Ⱥ_|,C"(a[V:W+7R~,r)OY: rt>qDDŽYEa-A v4,1+,Ws)t^9Wu (+ۼAZBZvWr.^w%ހ¼xe߷ !VMc(Tc y}Vo<--ջ?#.U@ItNpYV~d龣 hiJk%8:&!sE,?hxt4q gvoY'd32Wg3ͅ1 fj $UAU 2̓`pʡ0 X]N@dN@dNrR[5, R3Jτ$jLHitԾ(W陠 XgtrR͏',bd]a hAe6&]C&y: n.zC<8D-'Yۜl*t]Cn9sw!]<i^:#mTM@}`\lrδ]Ͱ`"'?9.l-+@!1 E2RZ$u&3'\m;d i&UHg/$]+@Xt=O[/!#&T :jbxjnKy:uy=٤< f_V)_-t4}YQߑt*Rr6$r a?Yg}I)AG@K;NY%9ggSȍ U! dʚX Yg33: /f0BlXj rtyUHaն ۅ9_s7]u -.x6zW6`uo;fo@ްO fE2MnO3oY&ty}<ǂȀOi[*# 47F3`fNpƃ% N.+p97¥*vm :+O-PtRu]<_4qyok,B/ aXgt(|m鲬Xjju]<_EFSfB`MQsT}3s5=k;!2ӳgaUv YV tXe( S.`Ie/e/FO6iD8eqnʤpkP&)iU?gʦmq(۠ h#ߧQbd/&d1wM 6ׄ?psMo=hb5[<hbM-oOy jn.~IMﲗ)ͻn%e6-&xmBne9to}4HgJ#5 ׄ/\Cu YAMS6! n\wPR|5!W5'8"Wexi,F{! SC"Pߙ(綠jvkZ@/)=eiۂc߽l^;|6}JM렉MwifirkP&)ie-{JR?˞u@> -V&vke؄iq+- )2hgxr#H zhDj M Mu"bG |6},kdMN֠ MRJJiwLc煪h#g̢6yF5U^n8k؇q6>.|u@>%U{V}DC Wҡwȋ;L|K{w)wN؞qLXc2 $Y"HmtΗ˥7Y:-JL:{>x/FOًD3M&ڊ%7m5V֠ MRJ~IwhD/nh#ߧEY!R&Y%. ̔Y6ˆu@>e/# ?JMh/'^횮i*B޹-@iw+h>tM&94mb|1 M$mHz""yVNVIA­;>m>Mò ܨxrjg̢..DM44ٹ5(jx*kqi\˛덭`xrjg̢m>jb&52EMlS65DM7hb/Q[9},r'4a*41k&f5&&PSr{Ǭ!ռlu>>cg];7"9[wuiޝFMMX}6|hhzDhe.MVhKDp0h5ZhϘEYlSս\co:S"i[]SfzJjMre'޹z/FOEYb)\(z+qPЄ!)hU;i+S s5<mYAA5!xN&X BM\[QwMtYJ`k 8@w URuS,iS3y/FOEQbZ'ik\n $%-|]>ݹԶz}v3{POo(lmӨm.H`]ׇth(߭3WɃcjޑ~CB(uoي۟>R) 6j ޼&H  )CL ܣxp ȷa(W}̃%OvCx5O97hyx5OiNӼlu@Ky?cF|5O@i~ʷbO "h zɬ@7L?Wt}Tx2缊26Y_= |<##Qq F z. |2 d?2 @./  2Hl3=|F1փ11GA)tGx G8 tGүjȆY^S9Ğ-> ikEdH,/_+nh#'c48[.np-7=&8!$%- -{=ٞ6}mBvKX 45h.5h.[4 ,Ӊ5jpd.}NQw_cd՞6 4w=K T&SUqwFk.zr[Hd5xVք+w*L('">!,uaK qʭe;,Ar/Ae¯{~¯{.e]}\ܟ37quZ@ )6R/;1& <mDKks4;0&7bmߐ4ě4w!%Wz+ߐa/FOt Ql&Թ/U% JkbOQ|^:ƫ= kb/Ot@zQk"Qy>j"Q5uvׄlKMt=@PkbOt,P83Sps1 A0HSb"`E^O%u/ IŽ8^e$-o{ʦzmܺ{5OvD_dTԄ|9mĝtMoϤMեkB_}&UkrD_2XS >5sQhxnQmb.rze/< O~u}V̈́<t5X=^%LXdK9\'N^5n@x=An*`.[H5-cӀ <* 8I2WFWPAxbxROi *;\]AxbU<ҙ;#Gu}DžL)=Qe(t 绷<٩7¯>{ob;4tH+#%-z2}ǦD|k~LGD|j^LNMždչsWB ˲[M/0EW^`aO;QVk降ڪWsenoyvWڢ>49{;=lK<xl:=rYzd=n{d=j{¤L/M/_d^},eo^>u;tanrn~=\` Xjy,r-|lPa@5~ۯÖ\>go._}E?Ͽ|˧vZ.>^0)_nݔtL6yiZ@zN)??1n.rRHӳz"l-KS,%h}Cؕx;424곉؝6 _&~w˗\~a^ZwqLPM6.aZ9_.8^ )SXq[,x;h U8S6^AuOv[NIg>m)1'onzc=1 ;{ Fإ6aS @50h -ΔYݻIegw g݆'_F;V=d}=9=VXl  `5aM6[# xk` AA'5,Q{ jq0@{O C5szQŸc^X,֣4nA-BPOYllK.=3Đ=eh0ۊ74ر`?T=NJK{쭨U7:g @uv` @50h iy%mP4p}<@-nc P{N<={>{z~@ݤuWځ[H0). <ֶ[Lk߼{{]ThYVr?(c뻛xr.&z-<[}YugCwQ'}v-[H?3Hￍ:>_XxI4S Y lө7՚Gʿ|V}Qq?~Fqg[GG}߫ā!endstream endobj 400 0 obj << /Filter /FlateDecode /Length 429 >> stream xSMo@+Zj&T=D6lHV TXz)BZǼH ?$?dgŐV"Fm#W~\2/:/,YywzjtLPA69/lS9j՜<6+R}N CxD@DAK(Po `0j ,:-B?'j?Vgh"^/Ӏzڡd$+.W5l˺xQP?ڡY˃aK;WM߭%.sZRCDQ[y<x:k&&SQZM{Ζ6> 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 402 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 403 0 obj << /Filter /FlateDecode /Length 430 >> stream xSMo0+|4&3G^6j{*=T h!j}(]iCO1Ǽ7y$[+GZ!yMЄ#b}`q /n䑟,fd\B@b[SSSA_YN=MyK)/딗?R41^XajJG@";ϐh=ps|l V.)ݠ:H˧ko6%Y\@)dz C f90lw6DzZI(ؾk+B+XxXSwPC`>kMjۡp-mx@uz#˓ܮ G$9ۄlBΚ߄o|oo7B) L;a/;x }~endstream endobj 404 0 obj << /Alternate /DeviceRGB /Filter /FlateDecode /N 3 /Length 2596 >> 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 405 0 obj << /Type /XRef /Length 2030 /W [ 1 3 1 ] /Info 14 0 R /Root 13 0 R /Size 406 /ID [<63f211a18bed0282f50ea0d67fa9b49d><34a0e888b237ff5af0298e6cf72f5869>] >> stream          !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcTtttttttttt t t t t ttttttttttttttttttt t!t"t#t$t%t&t't(t)t*t+t,t-t.t/t0t1t2t3t4t5t6t7t8t9t:t;t<t=t>t?t@tAtBtCtDtEtFtGtHtItJtKtLtMtNtOtPtQtRtStTtUtVtWtXtYtZt[t\t]t^t_t`tatbtcz      !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcaG.Za\gfq F$?*44sTMK4WLwRCZ^> D.8"0hnyMt ?&HSc[  m *X Ex F Q \  |  d   +  *  z  ޘ !  )k ~        !   endstream endobj startxref 853665 %%EOF robustbase/inst/doc/psi_functions.Rnw0000644000176200001440000004152413012615634017527 0ustar liggesusers\documentclass[11pt, a4paper]{article} \usepackage[a4paper, text={16cm,25cm}]{geometry} %\VignetteIndexEntry{Definitions of Psi-Functions Available in Robustbase} %\VignetteDepends{robustbase} \SweaveOpts{prefix.string=psi, eps=FALSE, pdf=TRUE, strip.white=true} \SweaveOpts{width=6, height=4.1, echo=FALSE, fig=TRUE} %% --------------------- !! \usepackage{amsmath} \usepackage{amsfonts}% \mathbb \usepackage{natbib} \usepackage[utf8]{inputenc} \newcommand{\abs}[1]{\left| #1 \right|} \DeclareMathOperator{\sign}{sign} \newcommand{\R}{\mathbb{R}} \newcommand{\code}[1]{\texttt{#1}} \newcommand*{\pkg}[1]{\texttt{#1}} \newtheorem{definition}{Definition} %% The following is R's share/texmf/Rd.sty \usepackage{color} \usepackage{hyperref} \definecolor{Blue}{rgb}{0,0,0.8} \definecolor{Red}{rgb}{0.7,0,0} \hypersetup{% hyperindex,% colorlinks={true},% pagebackref,% linktocpage,% plainpages={false},% linkcolor={Blue},% citecolor={Blue},% urlcolor={Red},% pdfstartview={Fit},% pdfview={XYZ null null null}% } <>= # set margins for plots options(SweaveHooks=list(fig=function() par(mar=c(3,3,1.4,0.7), mgp=c(1.5, 0.5, 0)))) ## x axis for plots: x. <- seq(-5, 10, length=1501) require(robustbase) <>= source(system.file("xtraR/plot-psiFun.R", package = "robustbase", mustWork=TRUE)) @% = ../inst/xtraR/plot-psiFun.R --> p.psiFun() --> robustbase:::matPlotPsi() {for nice legends; lines ..} \begin{document} \setkeys{Gin}{width=0.9\textwidth} \setlength{\abovecaptionskip}{-5pt} \title{Definitions of $\psi$-Functions Available in Robustbase} \author{Manuel Koller and Martin M\"achler} \maketitle \tableofcontents \section*{Preamble} Unless otherwise stated, the following definitions of functions are given by \citet[p. 31]{MarRMY06}, however our definitions differ sometimes slightly from theirs, as we prefer a different way of \emph{standardizing} the functions. To avoid confusion, we first define $\psi$- and $\rho$-functions. \begin{definition}\label{def.psi} A \emph{$\psi$-function} is a piecewise continuous function $\psi: \R \to \R$ such that \begin{enumerate} \item $\psi$ is odd, i.e., \ $\psi(-x) = -\psi(x) \: \forall x$, \item $\psi(x) \ge 0$ for $x \ge 0$, and $\psi(x) > 0$ for $0 < x < x_r := \sup\{\tilde x : \psi(\tilde x) > 0\}$ \ \ ($x_r > 0$, possibly $x_r = \infty$). \item[3*] Its slope is $1$ at $0$, i.e., $\displaystyle \psi'(0) = 1$. \end{enumerate} Note that `3*' is not strictly required mathematically, but we use it for standardization in those cases where $\psi$ is continuous at 0. Then, it also follows (from 1.) that $\psi(0) = 0$, and we require $\psi(0)=0$ also for the case where $\psi$ is discontinuous in 0, as it is, e.g., for the M-estimator defining the median. \end{definition} \begin{definition} A \emph{$\rho$-function} can be represented by the following % definite integral of a $\psi$-function, \begin{equation}\label{def.rho} \rho(x) = \int_0^x \psi(u) du\;, \end{equation} which entails that $\rho(0) = 0$ and $\rho$ is an even function. \end{definition} A $\psi$-function is called \emph{redescending} if $\psi(x) = 0$ for all $x \ge x_r$ for $x_r < \infty$, and $x_r$ is often called \emph{rejection point}. Corresponding to a redescending $\psi$-function, we define the function $\tilde\rho$, a version of $\rho$ standardized such as to attain maximum value one. Formally, \begin{equation} \label{eq:tilde-rho} \tilde\rho(x) = \rho(x)/\rho(\infty). \end{equation} Note that $\rho(\infty) = \rho(x_r) \equiv \rho(x) \ \forall \abs{x} >= x_r$. $\tilde\rho$ is a $\rho$-function as defined in \citet{MarRMY06} and has been called $\chi$ function in other contexts. For example, in package \pkg{robustbase}, \code{Mchi(x, *)} computes $\tilde\rho(x)$, whereas \code{Mpsi(x, *, deriv=-1)} (``(-1)-st derivative'' is the primitive or antiderivative)) computes $\rho(x)$, both according to the above definitions. \textbf{Note:} An alternative slightly more general definition of \emph{redescending} would only require $\rho(\infty) := \lim_{x\to\infty}\rho(x)$ to be finite. E.g., \texttt{"Welsh"} does \emph{not} have a finite rejection point, but \emph{does} have bounded $\rho$, and hence well defined $\rho(\infty)$, and we \emph{can} use it in \texttt{lmrob()}.\footnote{E-mail Oct.~18, 2014 to Manuel and Werner, proposing to change the definition of ``redescending''.} %% \section{Weak Redescenders} %% \subsection{t_nu score functions} %% t_1 (=Cauchy) has been propagated as "Lorentzian merit function" %% regression for outlier detection \paragraph{Weakly redescending $\psi$ functions.}\ Note that the above definition does require a finite rejection point $x_r$. Consequently, e.g., the score function $s(x) = -f'(x)/f(x)$ for the Cauchy ($= t_1$) distribution, which is $s(x) = 2x/(1+x^2)$ and hence non-monotone and ``re descends'' to 0 for $x\to \pm\infty$, and $\psi_C(x) := s(x)/2$ also fulfills ${\psi_C}'(0) = 1$, but it has $x_r=\infty$ and hence $\psi_C()$ is \emph{not} a redescending $\psi$-function in our sense. As they appear e.g. in the MLE for $t_\nu$, we call $\psi$-functions fulfulling $\lim_{x\to\infty}\psi(x) = 0$ \emph{weakly redescending}. Note that they'd naturally fall into two sub categories, namely the one with a \emph{finite} $\rho$-limit, i.e. $\rho(\infty) := \lim_{x\to\infty}\rho(x)$, and those, as e.g., the $t_\nu$ score functions above, for which $\rho(x)$ is unbounded even though $\rho' = \psi$ tends to zero. %% --> ../../TODO section 'Psi/Rho/Chi/Wgt Functions' %% ~~~~~~~~~~ %% %% FIXME: where?? MM: can no longer find it in Hampel et al(1986) \citet{hamfrrs86}. %% FIXME: 0) Mention our psi_func class // and the C interface for "the other" functions %% ----- i.e., we currently have *both* and in addition there is all %% the (to be *deprecated* !) ../R/biweight-funs.R (& ../man/tukeyChi.Rd & ../man/tukeyPsi1.Rd) %% %% FIXME: 1) explain plot() {the plot method of psi_func} %% FIXME: 2) Show how to compute asymptotic efficiency and breakdown point: %% ------- %% a) end of ../../tests/psi-rho-etc.R has aeff.P() and bp.P() and chkP() %% which now uses the psi_func class to compute these *analytically* %% b) Of course, Manuel had used the numeric integration only, %% in ../../R/lmrob.MM.R, lmrob.efficiency(psi, cc, ...) and lmrob.bp(psi, cc, ...) %% ~~~~~~~~~~~~~~~~~~ %% c) *REALLY* nice general solution is via PhiI() in ../../R/psi-rho-funs.R %% for all piecewise polynomial psi()/rho() ~~~~~~~~~~~~~~~~~~~~~~ %%\clearpage \section{Monotone $\psi$-Functions} Montone $\psi$-functions lead to convex $\rho$-functions such that the corresponding M-estimators are defined uniquely. Historically, the ``Huber function'' has been the first $\psi$-function, proposed by Peter Huber in \citet{HubP64}. \clearpage \subsection{Huber} The family of Huber functions is defined as, \begin{align*} \rho_k(x) = {}& \left\{ \begin{array}{ll} \frac{1}{2} x^2 & \mbox{ if } \abs{x} \leq k \\ k(\abs{x} - \frac{k}{2})& \mbox{ if } \abs{x} > k \end{array} \right. \;,\\ \psi_k(x) = {} & \left\{ \begin{array}{ll} x & \mbox{ if } \abs{x} \leq k \\ k \ \sign(x)& \mbox{ if } \abs{x} > k %% -k & \mbox{ if } x < -k \\ %% k & \mbox{ if } x > k \end{array} \right. \;. \end{align*} The constant $k$ for $95\%$ efficiency of the regression estimator is $1.345$. \begin{figure}[h] \centering <>= plot(huberPsi, x., ylim=c(-1.4, 5), leg.loc="topright", main=FALSE) @ \caption{Huber family of functions using tuning parameter $k = 1.345$.} \end{figure} \bigskip \section{Redescenders} For the MM-estimators and their generalizations available via \texttt{lmrob()} (and for some methods of \texttt{nlrob()}), the $\psi$-functions are all redescending, i.e., with finite ``rejection point'' $x_r = \sup\{t; \psi(t) > 0\} < \infty$. From \texttt{lmrob}, the psi functions are available via \texttt{lmrob.control}, or more directly, \texttt{.Mpsi.tuning.defaults}, <>= names(.Mpsi.tuning.defaults) @ %$ and their $\psi$, $\rho$, $\psi'$, and weight function $w(x) := \psi(x)/x$, are all computed efficiently via C code, and are defined and visualized in the following subsections. \clearpage \subsection{Bisquare} Tukey's bisquare (aka ``biweight'') family of functions is defined as, \begin{equation*} \tilde\rho_k(x) = \left\{ \begin{array}{cl} 1 - \bigl(1 - (x/k)^2 \bigr)^3 & \mbox{ if } \abs{x} \leq k \\ 1 & \mbox{ if } \abs{x} > k \end{array} \right.\;, \end{equation*} with derivative ${\tilde\rho_k}'(x) = 6\psi_k(x) / k^2$ where, \begin{equation*} \psi_k(x) = x \left( 1 - \left(\frac{x}{k}\right)^2\right)^2 \cdot I_{\{\abs{x} \leq k\}}\;. \end{equation*} The constant $k$ for $95\%$ efficiency of the regression estimator is $4.685$ and the constant for a breakdown point of $0.5$ of the S-estimator is $1.548$. Note that the \emph{exact} default tuning constants for M- and MM- estimation in \pkg{robustbase} are available via \code{.Mpsi.tuning.default()} and \code{.Mchi.tuning.default()}, respectively, e.g., here, % \begin{small} <>= print(c(k.M = .Mpsi.tuning.default("bisquare"), k.S = .Mchi.tuning.default("bisquare")), digits = 10) @ % \end{small} and that the \code{p.psiFun(.)} utility is available via %\begin{small} <>= <> @ %\end{small} %\enlargethispage{3ex} \begin{figure}[h] \centering <>= p.psiFun(x., "biweight", par = 4.685) @ \caption{Bisquare family functions using tuning parameter $k = 4.685$.} \end{figure} \clearpage \subsection{Hampel} The Hampel family of functions \citep{hamfrrs86} is defined as, \begin{align*} \tilde\rho_{a, b, r}(x) ={}& \left\{ \begin{array}{ll} \frac{1}{2} x^2 / C & \abs{x} \leq a \\ \left( \frac{1}{2}a^2 + a(\abs{x}-a)\right) / C & a < \abs{x} \leq b \\ \frac{a}{2}\left( 2b - a + (\abs{x} - b) \left(1 + \frac{r - \abs{x}}{r-b}\right) \right) / C & b < \abs{x} \leq r \\ 1 & r < \abs{x} \end{array} \right. \;, \\ \psi_{a, b, r}(x) ={}& \left\{ \begin{array}{ll} x & \abs{x} \leq a \\ a \ \sign(x) & a < \abs{x} \leq b \\ a \ \sign(x) \frac{r - \abs{x}}{r - b}& b < \abs{x} \leq r \\ 0 & r < \abs{x} \end{array} \right.\;, \end{align*} where $ C := \rho(\infty) = \rho(r) = \frac{a}{2}\left( 2b - a + (r - b) \right) = \frac{a}{2}(b-a + r)$. As per our standardization, $\psi$ has slope $1$ in the center. The slope of the redescending part ($x\in[b,r]$) is $-a/(r-b)$. If it is set to $-\frac 1 2$, as recommended sometimes, one has \begin{equation*} r = 2a + b\;. \end{equation*} Here however, we restrict ourselves to $a = 1.5 k$, $b = 3.5 k$, and $r = 8k$, hence a redescending slope of $-\frac 1 3$, and vary $k$ to get the desired efficiency or breakdown point. The constant $k$ for $95\%$ efficiency of the regression estimator is $0.902$ (0.9016085, to be exact) and the one for a breakdown point of $0.5$ of the S-estimator is $0.212$ (i.e., 0.2119163). %% --> ../R/lmrob.MM.R, .Mpsi.tuning.defaults .Mchi.tuning.defaults \begin{figure}[h] \centering <>= ## see also hampelPsi p.psiFun(x., "Hampel", par = ## Default, but rounded: round(c(1.5, 3.5, 8) * 0.9016085, 1)) @ \caption{Hampel family of functions using tuning parameters $0.902 \cdot (1.5, 3.5, 8)$.} \end{figure} \clearpage \subsection{GGW}\label{ssec:ggw} The Generalized Gauss-Weight function, or \emph{ggw} for short, is a generalization of the Welsh $\psi$-function (subsection \ref{ssec:Welsh}). In \citet{ks2011} it is defined as, \begin{equation*} %% \label{eq:ggw} \psi_{a, b, c}(x) = \left\{ \begin{array}{ll} x & \abs{x} \leq c \\ \exp\left(-\frac{1}{2}\frac{(\abs{x} - c)^b}{a}\right)x & \abs{x} > c \end{array} \right. \;. \end{equation*} Our constants, fixing $b=1.5$, and minimial slope at $- \frac 1 2$, for $95\%$ efficiency of the regression estimator are $a = 1.387$, $b = 1.5$ and $c = 1.063$, and those for a breakdown point of $0.5$ of the S-estimator are $a = 0.204$, $b = 1.5$ and $c = 0.296$: <>= cT <- rbind(cc1 = .psi.ggw.findc(ms = -0.5, b = 1.5, eff = 0.95 ), cc2 = .psi.ggw.findc(ms = -0.5, b = 1.5, bp = 0.50)); cT @ Note that above, \code{cc*[1]}$= 0$, \code{cc*[5]}$ = \rho(\infty)$, and \code{cc*[2:4]}$ = (a, b, c)$. To get this from $(a,b,c)$, you could use <>= ipsi.ggw <- .psi2ipsi("GGW") # = 5 ccc <- c(0, cT[1, 2:4], 1) integrate(.Mpsi, 0, Inf, ccc=ccc, ipsi=ipsi.ggw)$value # = rho(Inf) @ \begin{figure}[h] \centering <>= p.psiFun(x., "GGW", par = c(-.5, 1, .95, NA)) @ \caption{GGW family of functions using tuning parameters $a=1.387$, $b=1.5$ and $c=1.063$.} \end{figure} \clearpage \subsection{LQQ} The ``linear quadratic quadratic'' $\psi$-function, or \emph{lqq} for short, was proposed by \citet{ks2011}. It is defined as, \begin{equation*} \psi_{b,c,s}(x) = \left\{ \begin{array}{ll} x & \abs{x} \leq c \\ \sign(x)\left(\abs{x} - \frac{s}{2b}\left(\abs{x} - c\right)^2 \right) & c < \abs{x} \leq b + c \\ \sign(x)\left(c+b-\frac{bs}{2} + \frac{s-1}{a} \left(\frac{1}{2}\tilde x^2 - a\tilde x\right) \right) & b + c < \abs{x} \leq a + b + c \\ 0 & \mbox{otherwise,} \end{array} \right. \end{equation*} where \begin{equation} \tilde x := \abs{x} - b - c \ \ \mathrm{and}\ \ a := (2c + 2b - bs)/(s-1).\label{lqq.a} \end{equation} The parameter $c$ determines the width of the central identity part. The sharpness of the bend is adjusted by $b$ while the maximal rate of descent is controlled by $s$ ($s = 1 - \min_x\psi'(x) > 1$). From (\ref{lqq.a}), the length $a$ of the final descent to $0$ is a function of $b$, $c$ and $s$. <>= cT <- rbind(cc1 = .psi.lqq.findc(ms= -0.5, b.c = 1.5, eff=0.95, bp=NA ), cc2 = .psi.lqq.findc(ms= -0.5, b.c = 1.5, eff=NA , bp=0.50)) colnames(cT) <- c("b", "c", "s"); cT @ If the minimal slope is set to $-\frac 1 2$, i.e., $s = 1.5$, and $b/c = 3/2 = 1.5$, the constants for $95\%$ efficiency of the regression estimator are $b=1.473$, $c=0.982$ and $s=1.5$, and those for a breakdown point of $0.5$ of the S-estimator are $b=0.402$, $c=0.268$ and $s=1.5$. \begin{figure}[h] \centering <>= p.psiFun(x., "LQQ", par = c(-.5,1.5,.95,NA)) @ \caption{LQQ family of functions using tuning parameters $b=1.473$, $c=0.982$ and $s=1.5$.} \end{figure} \clearpage \subsection{Optimal} The optimal $\psi$ function as given by \citet[Section~5.9.1]{MarRMY06}, \begin{equation*} \psi_c(x) = \sign(x)\left(-\frac{\varphi'(\abs{x}) + c} {\varphi(\abs{x})}\right)_+\;, \end{equation*} where $\varphi$ is the standard normal density, $c$ is a constant and $t_+ := \max(t, 0)$ denotes the positive part of $t$. Note that the \pkg{robustbase} implementation uses rational approximations originating from the \pkg{robust} package's implementation. That approximation also avoids an anomaly for small $x$ and has a very different meaning of $c$. The constant for $95\%$ efficiency of the regression estimator is $1.060$ and the constant for a breakdown point of $0.5$ of the S-estimator is $0.405$. \begin{figure}[h] \centering <>= p.psiFun(x., "optimal", par = 1.06, leg.loc="bottomright") @ \caption{`Optimal' family of functions using tuning parameter $c = 1.06$.} \end{figure} \clearpage \subsection{Welsh}\label{ssec:Welsh} The Welsh $\psi$ function is defined as, %% FIXME: REFERENCE MISSING %\def\xk{\frac{x}{k}} \def\xk{x/k} %\def\xkdt{-\frac{1}{2}\left(\xk\right)^2} \def\xkdt{- \left(\xk\right)^2 / 2} \begin{align*} \tilde\rho_k(x) ={}& 1 - \exp\bigl(\xkdt\bigr) \\ \psi_k(x) ={}& k^2\tilde\rho'_k(x) = x\exp\bigl(\xkdt\bigr) \\ \psi'_k(x) ={}& \bigl(1 - \bigl(\xk\bigr)^2\bigr) \exp\bigl(\xkdt\bigr) \end{align*} The constant $k$ for $95\%$ efficiency of the regression estimator is $2.11$ and the constant for a breakdown point of $0.5$ of the S-estimator is $0.577$. Note that GGW (subsection \ref{ssec:ggw}) is a 3-parameter generalization of Welsh, matching for $ b = 2 $, $ c = 0 $, and $ a = k^2$ (see R code there): <>= ccc <- c(0, a = 2.11^2, b = 2, c = 0, 1) (ccc[5] <- integrate(.Mpsi, 0, Inf, ccc=ccc, ipsi = 5)$value) # = rho(Inf) stopifnot(all.equal(Mpsi(x., ccc, "GGW"), ## psi[ GGW ](x; a=k^2, b=2, c=0) == Mpsi(x., 2.11, "Welsh")))## psi[Welsh](x; k) @ \begin{figure}[h] \centering <>= p.psiFun(x., "Welsh", par = 2.11) @ \caption{Welsh family of functions using tuning parameter $k = 2.11$.} \end{figure} \bibliographystyle{chicago} \bibliography{robustbase} \end{document} robustbase/inst/doc/lmrob_simulation.R0000644000176200001440000012676213465050123017664 0ustar liggesusers### R code from vignette source 'lmrob_simulation.Rnw' ### Encoding: UTF-8 ################################################### ### code chunk number 1: initial-setup ################################################### ## set options options(width=60, warn=1) # see warnings where they happen (should eliminate) ## number of workers to start if(FALSE) {## good for pkg developers options(cores= max(1, parallel::detectCores() - 2)) } else { ## CRAN allows maximum of 2: options(cores= min(2, parallel::detectCores())) } ## Number of Repetitions: N <- 1000 ## get path (= ../inst/doc/ in source pkg) robustDoc <- system.file('doc', package='robustbase') robustDta <- robustDoc ## initialize (packages, data, ...): source(file.path(robustDoc, 'simulation.init.R')) # 'xtable' ## set the amount of trimming used in calculation of average results trim <- 0.1 ################################################### ### code chunk number 2: graphics-setup ################################################### ## load required packages for graphics stopifnot(require(ggplot2), require(GGally),# for ggpairs() which replaces ggplot2::plotmatrix() require(grid), require(reshape2)) source(file.path(robustDoc, 'graphics.functions.R')) `%||%` <- function (x, orElse) if (!is.null(x)) x else orElse ## set ggplot theme theme <- theme_bw(base_size = 10) theme$legend.key.size <- unit(1, "lines")# was 0.9 in pre-v.3 ggplot2 theme$plot.margin <- unit(c(1/2, 1/8, 1/8, 1/8), "lines")# was (1/2, 0,0,0) theme_set(theme) ## old and new ggplot2: stopifnot(is.list(theme_G <- theme$panel.grid.major %||% theme$panel.grid)) ## set default sizes for lines and points update_geom_defaults("point", list(size = 4/3)) update_geom_defaults("line", list(size = 1/4)) update_geom_defaults("hline", list(size = 1/4)) update_geom_defaults("smooth", list(size = 1/4)) ## alpha value for plots with many points alpha.error <- 0.3 alpha.n <- 0.4 ## set truncation limits used by f.truncate() & g.truncate.*: trunc <- c(0.02, 0.14) trunc.plot <- c(0.0185, 0.155) f.truncate <- function(x, up = trunc.plot[2], low = trunc.plot[1]) { x[x > up] <- up x[x < low] <- low x } g.truncate.lines <- geom_hline(yintercept = trunc, color = theme$panel.border$colour) g.truncate.line <- geom_hline(yintercept = trunc[2], color = theme$panel.border$colour) g.truncate.areas <- annotate("rect", xmin=rep(-Inf,2), xmax=rep(Inf,2), ymin=c(0,Inf), ymax=trunc, fill = theme_G$colour) g.truncate.area <- annotate("rect", xmin=-Inf, xmax=Inf, ymin=trunc[2], ymax=Inf, fill = theme_G$colour) legend.mod <- list(`SMD.Wtau` = quote('SMD.W'~tau), `SMDM.Wtau` = quote('SMDM.W'~tau), `MM.Avar1` = quote('MM.'~Avar[1]), `MMqT` = quote('MM'~~q[T]), `MMqT.Wssc` = quote('MM'~~q[T]*'.Wssc'), `MMqE` = quote('MM'~~q[E]), `MMqE.Wssc` = quote('MM'~~q[E]*'.Wssc'), `sigma_S` = quote(hat(sigma)[S]), `sigma_D` = quote(hat(sigma)[D]), `sigma_S*qE` = quote(q[E]*hat(sigma)[S]), `sigma_S*qT` = quote(q[T]*hat(sigma)[S]), `sigma_robust` = quote(hat(sigma)[robust]), `sigma_OLS` = quote(hat(sigma)[OLS]), `t1` = quote(t[1]), `t3` = quote(t[3]), `t5` = quote(t[5]), `cskt(Inf,2)` = quote(cskt(infinity,2)) ) ################################################### ### code chunk number 3: tab-psi-functions ################################################### ## get list of psi functions lst <- lapply(estlist$procedures, function(x) { if (is.null(x$args)) return(list(NULL, NULL, NULL)) if (!is.null(x$args$weight)) return(list(x$args$weight[2], round(f.psi2c.chi(x$args$weight[1]),3), round(f.eff2c.psi(x$args$efficiency, x$args$weight[2]),3))) return(list(x$args$psi, round(if (is.null(x$args$tuning.chi)) lmrob.control(psi=x$args$psi)$tuning.chi else x$args$tuning.chi,3), round(if (is.null(x$args$tuning.psi)) lmrob.control(psi=x$args$psi)$tuning.psi else x$args$tuning.psi,3))) }) lst <- unique(lst) ## because of rounding, down from 21 to 5 ! lst <- lst[sapply(lst, function(x) !is.null(x[[1]]))] # 5 --> 4 ## convert to table tbl <- do.call(rbind, lst) tbl[,2:3] <- apply(tbl[,2:3], 1:2, function(x) { gsub('\\$NA\\$', '\\\\texttt{NA}', paste('$', unlist(x), collapse=', ', '$', sep='')) }) tbl[,1] <- paste('\\texttt{', tbl[,1], '}', sep='') colnames(tbl) <- paste('\\texttt{', c('psi', 'tuning.chi', 'tuning.psi'), '}', sep='') print(xtable(tbl), sanitize.text.function=identity, include.rownames = FALSE, floating=FALSE) ################################################### ### code chunk number 4: fig-psi-functions ################################################### getOption("SweaveHooks")[["fig"]]() d.x_psi <- function(x, psi) { cc <- lmrob.control(psi = psi)$tuning.psi data.frame(x=x, value=Mpsi(x, cc, psi), psi = psi) } x <- seq(0, 10, length.out = 1000) tmp <- rbind(d.x_psi(x, 'optimal'), d.x_psi(x, 'bisquare'), d.x_psi(x, 'lqq'), d.x_psi(x, 'hampel')) print( ggplot(tmp, aes(x, value, color = psi)) + geom_line(lwd=1.25) + ylab(quote(psi(x))) + scale_color_discrete(name = quote(psi ~ '-function'))) ################################################### ### code chunk number 5: fgen ################################################### f.gen <- function(n, p, rep, err) { ## get function name and parameters lerrfun <- f.errname(err$err) lerrpar <- err$args ## generate random predictors ret <- replicate(rep, matrix(do.call(lerrfun, c(n = n*p, lerrpar)), n, p), simplify=FALSE) attr(ret[[1]], 'gen') <- f.gen ret } ratios <- c(1/20, 1/10, 1/5, 1/3, 1/2)## p/n lsit <- expand.grid(n = c(25, 50, 100, 400), p = ratios) lsit <- within(lsit, p <- as.integer(n*p)) .errs.normal.1 <- list(err = 'normal', args = list(mean = 0, sd = 1)) for (i in 1:NROW(lsit)) assign(paste('rand',lsit[i,1],lsit[i,2],sep='_'), f.gen(lsit[i,1], lsit[i,2], rep = 1, err = .errs.normal.1)[[1]]) ################################################### ### code chunk number 6: fig-example-design ################################################### getOption("SweaveHooks")[["fig"]]() require(GGally) colnames(rand_25_5) <- paste0("X", 1:5) # workaround new (2014-12) change in GGally ## and the 2016-11-* change needs data frames: df.r_25_5 <- as.data.frame(rand_25_5) try( ## fails with old GGally and new packageVersion("ggplot2") >= "2.2.1.9000" print(ggpairs(df.r_25_5, axisLabels="show", title = "rand_25_5: n=25, p=5")) ) ################################################### ### code chunk number 7: lmrob_simulation.Rnw:369-370 ################################################### aggrResultsFile <- file.path(robustDta, "aggr_results.Rdata") ################################################### ### code chunk number 8: simulation-run ################################################### if (!file.exists(aggrResultsFile)) { ## load packages required only for simulation stopifnot(require(robust), require(skewt), require(foreach)) if (!is.null(getOption("cores"))) { if (getOption("cores") == 1) registerDoSEQ() ## no not use parallel processing else { stopifnot(require(doParallel)) if (.Platform$OS.type == "windows") { cl <- makeCluster(getOption("cores")) clusterExport(cl, c("N", "robustDoc")) clusterEvalQ(cl, slave <- TRUE) clusterEvalQ(cl, source(file.path(robustDoc, 'simulation.init.R'))) registerDoParallel(cl) } else registerDoParallel() } } else registerDoSEQ() ## no not use parallel processing for (design in c("dd", ls(pattern = 'rand_\\d+_\\d+'))) { print(design) ## set design estlist$design <- get(design) estlist$use.intercept <- !grepl('^rand', design) ## add design.predict: pc estlist$design.predict <- if (is.null(attr(estlist$design, 'gen'))) f.prediction.points(estlist$design) else f.prediction.points(estlist$design, max.pc = 2) filename <- file.path(robustDta, sprintf('r.test.final.%s.Rdata',design)) if (!file.exists(filename)) { ## run print(system.time(r.test <- f.sim(estlist, silent = TRUE))) ## save save(r.test, file=filename) ## delete output rm(r.test) ## run garbage collection gc() } } } ################################################### ### code chunk number 9: str-estlist ################################################### str(estlist, 1) ################################################### ### code chunk number 10: estl-errs ################################################### estlist$errs[[1]] ################################################### ### code chunk number 11: show-errs (eval = FALSE) ################################################### ## set.seed(estlist$seed) ## errs <- c(sapply(1:nrep, function(x) do.call(fun, c(n = nobs, args)))) ################################################### ### code chunk number 12: lmrob_simulation.Rnw:447-448 ################################################### str(estlist$output[1:3], 2) ################################################### ### code chunk number 13: simulation-aggr ################################################### if (!file.exists(aggrResultsFile)) { files <- list.files(robustDta, pattern = 'r.test.final\\.') res <- foreach(file = files) %dopar% { ## get design, load r.test, initialize other stuff design <- substr(basename(file), 14, nchar(basename(file)) - 6) cat(design, ' ') load(file.path(robustDta, file)) estlist <- attr(r.test, 'estlist') use.intercept <- if (!is.null(estlist$use.intercept)) estlist$use.intercept else TRUE sel <- dimnames(r.test)[[3]] ## [dimnames(r.test)[[3]] != "estname=lm"] n.betas <- paste('beta',1:(NCOL(estlist$design)+use.intercept),sep='_') ## get design lX <- if (use.intercept) as.matrix(cbind(1, get(design))) else as.matrix(get(design)) n <- NROW(lX) p <- NCOL(lX) ## prepare arrays for variable designs and leverages if (is.function(attr(estlist$design, 'gen'))) { lXs <- array(NA, c(n, NCOL(lX), dim(r.test)[c(1, 4)]), list(Obs = NULL, Pred = colnames(lX), Data = NULL, Errstr = dimnames(r.test)[[4]])) } ## generate errors lerrs <- array(NA, c(n, dim(r.test)[c(1,4)]) , list(Obs = NULL, Data = NULL, Errstr = dimnames(r.test)[[4]])) for (i in 1:dim(lerrs)[3]) { lerrstr <- f.list2str(estlist$errs[[i]]) lerr <- f.errs(estlist, estlist$errs[[i]], gen = attr(estlist$design, 'gen'), nobs = n, npar = NCOL(lX)) lerrs[,,lerrstr] <- lerr if (!is.null(attr(lerr, 'designs'))) { ## retrieve generated designs: this returns a list of designs lXs[,,,i] <- unlist(attr(lerr, 'designs')) if (use.intercept) stop('intercept not implemented for random desings') } rm(lerr) } if (is.function(attr(estlist$design, 'gen'))) { ## calculate leverages lXlevs <- apply(lXs, 3:4, .lmrob.hat) } ## calculate fitted values from betas if (!is.function(attr(estlist$design, 'gen'))) { ## fixed design case lfitted <- apply(r.test[,n.betas,sel,,drop=FALSE],c(3:4), function(bhat) { lX %*% t(bhat) } ) } else { ## variable design case lfitted <- array(NA, n*prod(dim(r.test)[c(1,4)])*length(sel)) lfitted <- .C('R_calc_fitted', as.double(lXs), ## designs as.double(r.test[,n.betas,sel,,drop=FALSE]), ## betas as.double(lfitted), ## result as.integer(n), ## n as.integer(p), ## p as.integer(dim(r.test)[1]), ## nrep as.integer(length(sel)), ## n procstr as.integer(dim(r.test)[4]), ## n errstr DUP=FALSE, NAOK=TRUE, PACKAGE="robustbase")[[3]] } tdim <- dim(lfitted) <- c(n, dim(r.test)[1], length(sel),dim(r.test)[4]) lfitted <- aperm(lfitted, c(1,2,4,3)) ## calculate residuals = y - fitted.values lfitted <- as.vector(lerrs) - as.vector(lfitted) dim(lfitted) <- tdim[c(1,2,4,3)] lfitted <- aperm(lfitted, c(1,2,4,3)) dimnames(lfitted) <- c(list(Obs = NULL), dimnames(r.test[,,sel,,drop=FALSE])[c(1,3,4)]) lresids <- lfitted rm(lfitted) ## calculate lm MSE and trim trimmed MSE of betas tf.MSE <- function(lbetas) { lnrm <- rowSums(lbetas^2) c(MSE=mean(lnrm,na.rm=TRUE),MSE.1=mean(lnrm,trim=trim,na.rm=TRUE)) } MSEs <- apply(r.test[,n.betas,,,drop=FALSE],3:4,tf.MSE) li <- 1 ## so we can reconstruct where we are lres <- apply(lresids,3:4,f.aggregate.results <- { function(lresid) { ## the counter li tells us, where we are ## we walk dimensions from left to right lcdn <- f.get.current.dimnames(li, dimnames(lresids), 3:4) lr <- r.test[,,lcdn[1],lcdn[2]] ## update counter li <<- li + 1 ## transpose and normalize residuals with sigma lresid <- t(lresid) / lr[,'sigma'] if (lcdn[1] != 'estname=lm') { ## convert procstr to proclst and get control list largs <- f.str2list(lcdn[1])[[1]]$args if (grepl('lm.robust', lcdn[1])) { lctrl <- list() lctrl$psi <- toupper(largs$weight2) lctrl$tuning.psi <- f.eff2c.psi(largs$efficiency, lctrl$psi) lctrl$method <- 'MM' } else { lctrl <- do.call('lmrob.control',largs) } ## calculate correction factors ## A lsp2 <- rowSums(Mpsi(lresid,lctrl$tuning.psi, lctrl$psi)^2) ## B lspp <- rowSums(lpp <- Mpsi(lresid,lctrl$tuning.psi, lctrl$psi,1)) ## calculate Huber\'s small sample correction factor lK <- 1 + rowSums((lpp - lspp/n)^2)*NCOL(lX)/lspp^2 ## 1/n cancels } else { lK <- lspp <- lsp2 <- NA } ## only calculate tau variants if possible if (grepl('args.method=\\w*(D|T)\\w*\\b', lcdn[1])) { ## SMD or SMDM ## calculate robustness weights lwgts <- Mwgt(lresid, lctrl$tuning.psi, lctrl$psi) ## function to calculate robustified leverages tfun <- if (is.function(attr(estlist$design, 'gen'))) function(i) { if (all(is.na(wi <- lwgts[i,]))) wi else .lmrob.hat(lXs[,,i,lcdn[2]],wi) } else function(i) { if (all(is.na(wi <- lwgts[i,]))) wi else .lmrob.hat(lX, wi) } llev <- sapply(1:dim(r.test)[1], tfun) ## calculate unique leverages lt <- robustbase:::lmrob.tau(list(),h=llev,control=lctrl) ## normalize residuals with tau (transpose lresid) lresid <- t(lresid) / lt ## A lsp2t <- colSums(Mpsi(lresid,lctrl$tuning.psi, lctrl$psi)^2) ## B lsppt <- colSums(Mpsi(lresid,lctrl$tuning.psi, lctrl$psi,1)) } else { lsp2t <- lsppt <- NA } ## calculate raw scales based on the errors lproc <- f.str2list(lcdn[1])[[1]] q <- NA M <- NA if (lproc$estname == 'lmrob.mar' && lproc$args$type == 'qE') { ## for lmrob_mar, qE variant lctrl <- lmrob.control(psi = 'bisquare', tuning.chi=uniroot(function(c) robustbase:::lmrob.bp('bisquare', c) - (1-p/n)/2, c(1, 3))$root) se <- apply(lerrs[,,lcdn[2]],2,lmrob.mscale,control=lctrl,p=p) ltmp <- se/lr[,'sigma'] q <- median(ltmp, na.rm = TRUE) M <- mad(ltmp, na.rm = TRUE) } else if (!is.null(lproc$args$method) && lproc$args$method == 'SMD') { ## for D-scales se <- apply(lerrs[,,lcdn[2]],2,lmrob.dscale,control=lctrl, kappa=robustbase:::lmrob.kappa(control=lctrl)) ltmp <- se/lr[,'sigma'] q <- median(ltmp, na.rm = TRUE) M <- mad(ltmp, na.rm = TRUE) } ## calculate empirical correct test value (to yield 5% level) t.val_2 <- t.val_1 <- quantile(abs(lr[,'beta_1']/lr[,'se_1']), 0.95, na.rm = TRUE) if (p > 1) t.val_2 <- quantile(abs(lr[,'beta_2']/lr[,'se_2']), 0.95, na.rm = TRUE) ## return output: summary statistics: c(## gamma AdB2.1 = mean(lsp2/lspp^2,trim=trim,na.rm=TRUE)*n, K2AdB2.1 = mean(lK^2*lsp2/lspp^2,trim=trim,na.rm=TRUE)*n, AdB2t.1 = mean(lsp2t/lsppt^2,trim=trim,na.rm=TRUE)*n, sdAdB2.1 = sd.trim(lsp2/lspp^2*n,trim=trim,na.rm=TRUE), sdK2AdB2.1 = sd.trim(lK^2*lsp2/lspp^2*n,trim=trim,na.rm=TRUE), sdAdB2t.1 = sd.trim(lsp2t/lsppt^2*n,trim=trim,na.rm=TRUE), ## sigma medsigma = median(lr[,'sigma'],na.rm=TRUE), madsigma = mad(lr[,'sigma'],na.rm=TRUE), meansigma.1 = mean(lr[,'sigma'],trim=trim,na.rm=TRUE), sdsigma.1 = sd.trim(lr[,'sigma'],trim=trim,na.rm=TRUE), meanlogsigma = mean(log(lr[,'sigma']),na.rm=TRUE), meanlogsigma.1 = mean(log(lr[,'sigma']),trim=trim,na.rm=TRUE), sdlogsigma = sd(log(lr[,'sigma']),na.rm=TRUE), sdlogsigma.1 = sd.trim(log(lr[,'sigma']),trim=trim,na.rm=TRUE), q = q, M = M, ## beta efficiency.1 = MSEs['MSE.1','estname=lm',lcdn[2]] / MSEs['MSE.1',lcdn[1],lcdn[2]], ## t-value: level emplev_1 = mean(abs(lr[,'beta_1']/lr[,'se_1']) > qt(0.975, n - p), na.rm = TRUE), emplev_2 = if (p>1) { mean(abs(lr[,'beta_2']/lr[,'se_2']) > qt(0.975, n - p), na.rm = TRUE) } else NA, ## t-value: power power_1_0.2 = mean(abs(lr[,'beta_1']-0.2)/lr[,'se_1'] > t.val_1, na.rm = TRUE), power_2_0.2 = if (p>1) { mean(abs(lr[,'beta_2']-0.2)/lr[,'se_2'] > t.val_2, na.rm = TRUE) } else NA, power_1_0.4 = mean(abs(lr[,'beta_1']-0.4)/lr[,'se_1'] > t.val_1, na.rm = TRUE), power_2_0.4 = if (p>1) { mean(abs(lr[,'beta_2']-0.4)/lr[,'se_2'] > t.val_2, na.rm = TRUE) } else NA, power_1_0.6 = mean(abs(lr[,'beta_1']-0.6)/lr[,'se_1'] > t.val_1, na.rm = TRUE), power_2_0.6 = if (p>1) { mean(abs(lr[,'beta_2']-0.6)/lr[,'se_2'] > t.val_2, na.rm = TRUE) } else NA, power_1_0.8 = mean(abs(lr[,'beta_1']-0.8)/lr[,'se_1'] > t.val_1, na.rm = TRUE), power_2_0.8 = if (p>1) { mean(abs(lr[,'beta_2']-0.8)/lr[,'se_2'] > t.val_2, na.rm = TRUE) } else NA, power_1_1 = mean(abs(lr[,'beta_1']-1)/lr[,'se_1'] > t.val_1, na.rm = TRUE), power_2_1 = if (p>1) { mean(abs(lr[,'beta_2']-1)/lr[,'se_2'] > t.val_2, na.rm = TRUE) } else NA, ## coverage probability: calculate empirically ## the evaluation points are constant, but the designs change ## therefore this makes only sense for fixed designs cpr_1 = mean(lr[,'upr_1'] < 0 | lr[,'lwr_1'] > 0, na.rm = TRUE), cpr_2 = mean(lr[,'upr_2'] < 0 | lr[,'lwr_2'] > 0, na.rm = TRUE), cpr_3 = mean(lr[,'upr_3'] < 0 | lr[,'lwr_3'] > 0, na.rm = TRUE), cpr_4 = mean(lr[,'upr_4'] < 0 | lr[,'lwr_4'] > 0, na.rm = TRUE), cpr_5 = if (any(colnames(lr) == 'upr_5')) { mean(lr[,'upr_5'] < 0 | lr[,'lwr_5'] > 0, na.rm = TRUE) } else NA, cpr_6 = if (any(colnames(lr) == 'upr_6')) { mean(lr[,'upr_6'] < 0 | lr[,'lwr_6'] > 0, na.rm = TRUE) } else NA, cpr_7 = if (any(colnames(lr) == 'upr_7')) { mean(lr[,'upr_7'] < 0 | lr[,'lwr_7'] > 0, na.rm = TRUE) } else NA ) }}) ## convert to data.frame lres <- f.a2df.2(lres, split = '___NO___') ## add additional info lres$n <- NROW(lX) lres$p <- NCOL(lX) lres$nmpdn <- with(lres, (n-p)/n) lres$Design <- design ## clean up rm(r.test, lXs, lXlevs, lresids, lerrs) gc() ## return lres lres } save(res, trim, file = aggrResultsFile) ## stop cluster if (exists("cl")) stopCluster(cl) } ################################################### ### code chunk number 14: simulation-aggr2 ################################################### load(aggrResultsFile) ## this will fail if the file is not found (for a reason) ## set eval to TRUE for chunks simulation-run and simulation-aggr ## if you really want to run the simulations again. ## (better fail with an error than run for weeks) ## combine list elements to data.frame test.1 <- do.call('rbind', res) test.1 <- within(test.1, { Method[Method == "SM"] <- "MM" Method <- Method[, drop = TRUE] Estimator <- interaction(Method, D.type, drop = TRUE) Estimator <- f.rename.level(Estimator, 'MM.S', 'MM') Estimator <- f.rename.level(Estimator, 'SMD.D', 'SMD') Estimator <- f.rename.level(Estimator, 'SMDM.D', 'SMDM') Estimator <- f.rename.level(Estimator, 'MM.qT', 'MMqT') Estimator <- f.rename.level(Estimator, 'MM.qE', 'MMqE') Estimator <- f.rename.level(Estimator, 'MM.rob', 'MMrobust') Estimator <- f.rename.level(Estimator, 'lsq.lm', 'OLS') Est.Scale <- f.rename.level(Estimator, 'MM', 'sigma_S') Est.Scale <- f.rename.level(Est.Scale, 'MMrobust', 'sigma_robust') Est.Scale <- f.rename.level(Est.Scale, 'MMqE', 'sigma_S*qE') Est.Scale <- f.rename.level(Est.Scale, 'MMqT', 'sigma_S*qT') Est.Scale <- f.rename.level(Est.Scale, 'SMDM', 'sigma_D') Est.Scale <- f.rename.level(Est.Scale, 'SMD', 'sigma_D') Est.Scale <- f.rename.level(Est.Scale, 'OLS', 'sigma_OLS') Psi <- f.rename.level(Psi, 'hampel', 'Hampel') }) ## add interaction of Method and Cov test.1 <- within(test.1, { method.cov <- interaction(Estimator, Cov, drop=TRUE) levels(method.cov) <- sub('\\.+vcov\\.(a?)[wacrv1]*', '\\1', levels(method.cov)) method.cov <- f.rename.level(method.cov, "MMa", "MM.Avar1") method.cov <- f.rename.level(method.cov, "MMrobust.Default", "MMrobust.Wssc") method.cov <- f.rename.level(method.cov, "MM", "MM.Wssc") method.cov <- f.rename.level(method.cov, "SMD", "SMD.Wtau") method.cov <- f.rename.level(method.cov, "SMDM", "SMDM.Wtau") method.cov <- f.rename.level(method.cov, "MMqT", "MMqT.Wssc") method.cov <- f.rename.level(method.cov, "MMqE", "MMqE.Wssc") method.cov <- f.rename.level(method.cov, "OLS.Default", "OLS") ## ratio: the closest 'desired ratios' instead of exact p/n; ## needed in plots only for stat_*(): median over "close" p/n's: ratio <- ratios[apply(abs(as.matrix(1/ratios) %*% t(as.matrix(p / n)) - 1), 2, which.min)] }) ## calculate expected values of psi^2 and psi' test.1$Ep2 <- test.1$Epp <- NA for(Procstr in levels(test.1$Procstr)) { args <- f.str2list(Procstr)[[1]]$args if (is.null(args)) next lctrl <- do.call('lmrob.control',args) test.1$Ep2[test.1$Procstr == Procstr] <- robustbase:::lmrob.E(psi(r)^2, lctrl, use.integrate = TRUE) test.1$Epp[test.1$Procstr == Procstr] <- robustbase:::lmrob.E(psi(r,1), lctrl, use.integrate = TRUE) } ## drop some observations, separate fixed and random designs test.fixed <- droplevels(subset(test.1, n == 20)) ## n = 20 -- fixed design test.1 <- droplevels(subset(test.1, n != 20)) ## n !=20 -- random designs test.lm <- droplevels(subset(test.1, Function == 'lm')) # lm = OLS test.1 <- droplevels(subset(test.1, Function != 'lm')) # Rob := all "robust" test.lm$Psi <- NULL test.lm.2 <- droplevels(subset(test.lm, Error == 'N(0,1)')) # OLS for N(*) test.2 <- droplevels(subset(test.1, Error == 'N(0,1)' & Function != 'lm'))# Rob for N(*) ## subsets test.3 <- droplevels(subset(test.2, Method != 'SMDM'))# Rob, not SMDM for N(*) test.4 <- droplevels(subset(test.1, Method != 'SMDM'))# Rob, not SMDM for all ################################################### ### code chunk number 15: fig-meanscale ################################################### getOption("SweaveHooks")[["fig"]]() ## ## exp(mean(log(sigma))): this looks almost identical to mean(sigma) print(ggplot(test.3, aes(p/n, exp(meanlogsigma.1), color = Est.Scale)) + stat_summary(aes(x=ratio), # <- "rounded p/n": --> median over "neighborhood" fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + geom_hline(yintercept = 1) + g.scale_y_log10_1() + facet_wrap(~ Psi) + ylab(quote('geometric ' ~ mean(hat(sigma)))) + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels=lab(test.3$Est.Scale))) ################################################### ### code chunk number 16: fig-sdscale-1 ################################################### getOption("SweaveHooks")[["fig"]]() print(ggplot(test.3, aes(p/n, sdlogsigma.1*sqrt(n), color = Est.Scale)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + ylab(quote(sd(log(hat(sigma)))*sqrt(n))) + facet_wrap(~ Psi) + geom_point (data=test.lm.2, alpha=alpha.n, aes(color = Est.Scale)) + stat_summary(data=test.lm.2, aes(x=ratio, color = Est.Scale), fun.y=median, geom='line') + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels= lab(test.3 $Est.Scale, test.lm.2$Est.Scale))) ################################################### ### code chunk number 17: fig-sdscale-all ################################################### getOption("SweaveHooks")[["fig"]]() print(ggplot(test.4, aes(p/n, sdlogsigma.1*sqrt(n), color = Est.Scale)) + ylim(with(test.4, range(sdlogsigma.1*sqrt(n)))) + ylab(quote(sd(log(hat(sigma)))*sqrt(n))) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = Error), alpha = alpha.error) + facet_wrap(~ Psi) + ## "FIXME" (?): the next 'test.lm' one give warnings geom_point (data=test.lm, aes(color = Est.Scale), alpha=alpha.n) + ##-> Warning: Removed 108 rows containing missing values (geom_point). stat_summary(data=test.lm, aes(x = ratio, color = Est.Scale), fun.y=median, geom='line') + ##-> Warning: Removed 108 rows containing non-finite values (stat_summary). g.scale_shape(labels=lab(test.4$Error)) + scale_colour_discrete("Scale Est.", labels=lab(test.4 $Est.Scale, test.lm$Est.Scale))) ################################################### ### code chunk number 18: fig-qscale ################################################### getOption("SweaveHooks")[["fig"]]() t3est2 <- droplevels(subset(test.3, Estimator %in% c("SMD", "MMqE"))) print(ggplot(t3est2, aes(p/n, q, color = Est.Scale)) + ylab(quote(q)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + geom_hline(yintercept = 1) + g.scale_y_log10_1() + facet_wrap(~ Psi) + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels=lab(t3est2$Est.Scale))) ################################################### ### code chunk number 19: fig-Mscale ################################################### getOption("SweaveHooks")[["fig"]]() print(ggplot(t3est2, aes(p/n, M/q, color = Est.Scale)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + g.scale_y_log10_0.05() + facet_wrap(~ Psi) + ylab(quote(M/q)) + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels=lab(t3est2$Est.Scale))) ################################################### ### code chunk number 20: fig-qscale-all ################################################### getOption("SweaveHooks")[["fig"]]() t1.bi <- droplevels(subset(test.1, Estimator %in% c("SMD", "MMqE") & Psi == 'bisquare')) print(ggplot(t1.bi, aes(p/n, q, color = Est.Scale)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + geom_hline(yintercept = 1) + g.scale_y_log10_1() + facet_wrap(~ Error) + ## labeller missing! ylab(quote(q)) + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels=lab(tmp$Est.Scale)), legend.mod = legend.mod) ################################################### ### code chunk number 21: fig-Mscale-all ################################################### getOption("SweaveHooks")[["fig"]]() print(ggplot(t1.bi, aes(p/n, M/q, color = Est.Scale)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + g.scale_y_log10_0.05() + facet_wrap(~ Error) + ylab(quote(M/q)) + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels=lab(tmp$Est.Scale)), legend.mod = legend.mod) ################################################### ### code chunk number 22: fig-efficiency ################################################### getOption("SweaveHooks")[["fig"]]() print(ggplot(test.2, aes(p/n, efficiency.1, color = Estimator)) + geom_point(aes(shape = factor(n)), alpha = alpha.n) + geom_hline(yintercept = 0.95) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + facet_wrap(~ Psi) + ylab(quote('efficiency of' ~~ hat(beta))) + g.scale_shape(quote(n)) + scale_colour_discrete(name = "Estimator", labels = lab(test.2$Estimator))) ################################################### ### code chunk number 23: fig-efficiency-all ################################################### getOption("SweaveHooks")[["fig"]]() t.1xt1 <- droplevels(subset(test.1, Error != 't1')) print(ggplot(t.1xt1, aes(p/n, efficiency.1, color = Estimator)) + ylab(quote('efficiency of '~hat(beta))) + geom_point(aes(shape = Error), alpha = alpha.error) + geom_hline(yintercept = 0.95) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + g.scale_shape(values=c(16,17,15,3,7,8,9,1,2,4)[-4], labels=lab(t.1xt1$Error)) + facet_wrap(~ Psi) + scale_colour_discrete(name = "Estimator", labels = lab(t.1xt1$Estimator))) ################################################### ### code chunk number 24: fig-AdB2-1 ################################################### getOption("SweaveHooks")[["fig"]]() t.2o. <- droplevels(subset(test.2, !is.na(AdB2t.1))) print(ggplot(t.2o., aes(p/n, AdB2.1/(1-p/n), color = Estimator)) + geom_point(aes(shape=factor(n)), alpha = alpha.n) + geom_point(aes(y=K2AdB2.1/(1-p/n)), alpha = alpha.n) + geom_point(aes(y=AdB2t.1), alpha = alpha.n) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + stat_summary(aes(x=ratio, y=K2AdB2.1/(1-p/n)), fun.y=median, geom='line', linetype=2) + stat_summary(aes(x=ratio, y=AdB2t.1), fun.y=median, geom='line', linetype=3) + geom_hline(yintercept = 1/0.95) + g.scale_y_log10_1() + scale_shape_discrete(quote(n)) + scale_colour_discrete(name = "Estimator", labels = lab(t.2o.$Estimator)) + ylab(quote(mean(hat(gamma)))) + facet_wrap(~ Psi)) ################################################### ### code chunk number 25: fig-sdAdB2-1 ################################################### getOption("SweaveHooks")[["fig"]]() t.2ok <- droplevels(subset(test.2, !is.na(sdAdB2t.1))) print(ggplot(t.2ok, aes(p/n, sdAdB2.1/(1-p/n), color = Estimator)) + geom_point(aes(shape=factor(n)), alpha = alpha.n) + geom_point(aes(y=sdK2AdB2.1/(1-p/n)), alpha = alpha.n) + geom_point(aes(y=sdAdB2t.1), alpha = alpha.n) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + stat_summary(aes(x=ratio, y=sdK2AdB2.1/(1-p/n)), fun.y=median, geom='line', linetype= 2) + stat_summary(aes(x=ratio, y=sdAdB2t.1), fun.y=median, geom='line', linetype= 3) + g.scale_y_log10_0.05() + scale_shape_discrete(quote(n)) + scale_colour_discrete(name = "Estimator", labels=lab(t.2ok$Estimator)) + ylab(quote(sd(hat(gamma)))) + facet_wrap(~ Psi)) ################################################### ### code chunk number 26: fig-emp-level ################################################### getOption("SweaveHooks")[["fig"]]() t.2en0 <- droplevels(subset(test.2, emplev_1 != 0)) print(ggplot(t.2en0, aes(p/n, f.truncate(emplev_1), color = method.cov)) + g.truncate.lines + g.truncate.areas + geom_point(aes(shape = factor(n)), alpha = alpha.n) + scale_shape_discrete(quote(n)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_hline(yintercept = 0.05) + g.scale_y_log10_0.05() + scale_colour_discrete(name = "Estimator", labels=lab(t.2en0$method.cov)) + ylab(quote("empirical level "~ list (H[0] : beta[1] == 0) )) + facet_wrap(~ Psi)) ################################################### ### code chunk number 27: fig-lqq-level ################################################### getOption("SweaveHooks")[["fig"]]() tmp <- droplevels(subset(test.1, Psi == 'lqq' & emplev_1 != 0)) print(ggplot(tmp, aes(p/n, f.truncate(emplev_1), color = method.cov)) + ylab(quote("empirical level "~ list (H[0] : beta[1] == 0) )) + g.truncate.line + g.truncate.area + geom_point(aes(shape = factor(n)), alpha = alpha.n) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_hline(yintercept = 0.05) + g.scale_y_log10_0.05() + g.scale_shape(quote(n)) + scale_colour_discrete(name = "Estimator", labels=lab(tmp$method.cov)) + facet_wrap(~ Error) , legend.mod = legend.mod ) ################################################### ### code chunk number 28: fig-power-1-0_2 ################################################### getOption("SweaveHooks")[["fig"]]() t2.25 <- droplevels(subset(test.2, n == 25))# <-- fixed n ==> no need for 'ratio' tL2.25 <- droplevels(subset(test.lm.2, n == 25)) scale_col_D2.25 <- scale_colour_discrete(name = "Estimator (Cov. Est.)", labels=lab(t2.25 $method.cov, tL2.25$method.cov)) print(ggplot(t2.25, aes(p/n, power_1_0.2, color = method.cov)) + ylab(quote("empirical power "~ list (H[0] : beta[1] == 0.2) )) + geom_point(# aes(shape = Error), alpha = alpha.error) + stat_summary(fun.y=median, geom='line') + geom_point (data=tL2.25, alpha = alpha.n) + stat_summary(data=tL2.25, fun.y=median, geom='line') + ## g.scale_shape("Error", labels=lab(t2.25$Error)) + scale_col_D2.25 + facet_wrap(~ Psi) ) ################################################### ### code chunk number 29: fig-power-1-0_4 ################################################### getOption("SweaveHooks")[["fig"]]() print(ggplot(t2.25, aes(p/n, power_1_0.4, color = method.cov)) + ylab(quote("empirical power "~ list (H[0] : beta[1] == 0.4) )) + geom_point(alpha = alpha.error) + stat_summary(fun.y=median, geom='line') + geom_point (data=tL2.25, alpha = alpha.n) + stat_summary(data=tL2.25, fun.y=median, geom='line') + ## g.scale_shape("Error", labels=lab(t2.25$Error)) + scale_col_D2.25 + facet_wrap(~ Psi) ) ################################################### ### code chunk number 30: fig-power-1-0_6 ################################################### getOption("SweaveHooks")[["fig"]]() print(ggplot(t2.25, aes(p/n, power_1_0.6, color = method.cov)) + ylab(quote("empirical power "~ list (H[0] : beta[1] == 0.6) )) + geom_point(# aes(shape = Error), alpha = alpha.error) + stat_summary(fun.y=median, geom='line') + geom_point (data=tL2.25, alpha = alpha.n) + stat_summary(data=tL2.25, fun.y=median, geom='line') + scale_col_D2.25 + facet_wrap(~ Psi) ) ################################################### ### code chunk number 31: fig-power-1-0_8 ################################################### getOption("SweaveHooks")[["fig"]]() print(ggplot(t2.25, aes(p/n, power_1_0.8, color = method.cov)) + ylab(quote("empirical power "~ list (H[0] : beta[1] == 0.8) )) + geom_point(alpha = alpha.error) + stat_summary(fun.y=median, geom='line') + geom_point (data=tL2.25, alpha = alpha.n) + stat_summary(data=tL2.25, fun.y=median, geom='line') + g.scale_shape("Error", labels=lab(t2.25$Error)) + scale_col_D2.25 + facet_wrap(~ Psi) ) ################################################### ### code chunk number 32: fig-power-1-1 ################################################### getOption("SweaveHooks")[["fig"]]() print(ggplot(t2.25, aes(p/n, power_1_1, color = method.cov)) + ylab(quote("empirical power "~ list (H[0] : beta[1] == 1) )) + geom_point(alpha = alpha.error) + stat_summary(fun.y=median, geom='line') + geom_point (data=tL2.25, alpha = alpha.n) + stat_summary(data=tL2.25, fun.y=median, geom='line') + ## g.scale_shape("Error", labels=lab(t2.25$Error)) + scale_col_D2.25 + facet_wrap(~ Psi) ) ################################################### ### code chunk number 33: fig-pred-points ################################################### getOption("SweaveHooks")[["fig"]]() pp <- f.prediction.points(dd)[1:7,] ## Worked in older ggplot2 -- now plotmatrix() is gone, to be replaced by GGally::ggpairs): ## tmp <- plotmatrix(pp)$data ## tmp$label <- as.character(1:7) ## print(plotmatrix(dd) + geom_text(data=tmp, color = 2, aes(label=label), size = 2.5)) if(FALSE) { tmp <- ggpairs(pp)$data tmp$label <- as.character(1:7) # and now? } ## ggpairs() + geom_text() does *NOT* work {ggpairs has own class} ## print(ggpairs(dd) + geom_text(data=tmp, color = 2, aes(label=label), size = 2.5)) try( ## fails with old GGally and new packageVersion("ggplot2") >= "2.2.1.9000" print( ggpairs(dd) )## now (2016-11) fine ) ################################################### ### code chunk number 34: fig-cpr ################################################### getOption("SweaveHooks")[["fig"]]() n.cprs <- names(test.fixed)[grep('cpr', names(test.fixed))] # test.fixed: n=20 => no 'x=ratio' test.5 <- melt(test.fixed[,c('method.cov', 'Error', 'Psi', n.cprs)]) test.5 <- within(test.5, { Point <- as.numeric(do.call('rbind', strsplit(levels(variable), '_'))[,2])[variable] }) print(ggplot(test.5, aes(Point, f.truncate(value), color = method.cov)) + geom_point(aes(shape = Error), alpha = alpha.error) + g.truncate.line + g.truncate.area + stat_summary(fun.y=median, geom='line') + geom_hline(yintercept = 0.05) + g.scale_y_log10_0.05() + g.scale_shape(labels=lab(test.5$Error)) + scale_colour_discrete(name = "Estimator (Cov. Est.)", labels=lab(test.5$method.cov)) + ylab("empirical level of confidence intervals") + facet_wrap(~ Psi) ) ################################################### ### code chunk number 35: maxbias-fn ################################################### ## Henning (1994) eq 33: g <- Vectorize(function(s, theta, mu, ...) { lctrl <- lmrob.control(...) rho <- function(x) Mchi(x, lctrl$tuning.chi, lctrl$psi, deriv = 0) integrate(function(x) rho(((1 + theta^2)/s^2*x)^2)*dchisq(x, 1, mu^2/(1 + theta^2)), -Inf, Inf)$value }) ## Martin et al 1989 Section 3.2: for mu = 0 g.2 <- Vectorize(function(s, theta, mu, ...) { lctrl <- lmrob.control(...) lctrl$tuning.psi <- lctrl$tuning.chi robustbase:::lmrob.E(chi(sqrt(1 + theta^2)/s*r), lctrl, use.integrate = TRUE)}) g.2.MM <- Vectorize(function(s, theta, mu, ...) { lctrl <- lmrob.control(...) robustbase:::lmrob.E(chi(sqrt(1 + theta^2)/s*r), lctrl, use.integrate = TRUE)}) ## Henning (1994) eq 30, one parameter case g.3 <- Vectorize(function(s, theta, mu, ...) { lctrl <- lmrob.control(...) rho <- function(x) Mchi(x, lctrl$tuning.chi, lctrl$psi, deriv = 0) int.x <- Vectorize(function(y) { integrate(function(x) rho((y - x*theta - mu)/s)*dnorm(x)*dnorm(y),-Inf, Inf)$value }) integrate(int.x,-Inf, Inf)$value }) inv.g1 <- function(value, theta, mu, ...) { g <- if (mu == 0) g.2 else g.3 uniroot(function(s) g(s, theta, mu, ...) - value, c(0.1, 100))$root } inv.g1.MM <- function(value, theta, mu, ...) { g <- if (mu == 0) g.2.MM else g.3.MM ret <- tryCatch(uniroot(function(s) g(s, theta, mu, ...) - value, c(0.01, 100)), error = function(e)e) if (inherits(ret, 'error')) { warning('inv.g1.MM: ', value, ' ', theta, ' ', mu,' -> Error: ', ret$message) NA } else { ret$root } } s.min <- function(epsilon, ...) inv.g1(0.5/(1 - epsilon), 0, 0, ...) s.max <- function(epsilon, ...) inv.g1((0.5-epsilon)/(1-epsilon), 0, 0, ...) BS <- Vectorize(function(epsilon, ...) { sqrt(s.max(epsilon, ...)/s.min(epsilon, ...)^2 - 1) }) l <- Vectorize(function(epsilon, ...) { sigma_be <- s.max(epsilon, ...) sqrt((sigma_be/inv.g1.MM(g.2.MM(sigma_be,0,0,...) + epsilon/(1-epsilon),0,0,...))^2 - 1) }) u <- Vectorize(function(epsilon, ...) { gamma_be <- s.min(epsilon, ...) max(l(epsilon, ...), sqrt((gamma_be/inv.g1.MM(g.2.MM(gamma_be,0,0,...) + epsilon/(1-epsilon),0,0,...))^2 - 1)) }) ################################################### ### code chunk number 36: max-asymptotic-bias ################################################### asymptMBFile <- file.path(robustDta, 'asymptotic.max.bias.Rdata') if (!file.exists(asymptMBFile)) { x <- seq(0, 0.35, length.out = 100) rmb <- rbind(data.frame(l=l(x, psi = 'hampel'), u=u(x, psi = 'hampel'), psi = 'Hampel'), data.frame(l=l(x, psi = 'lqq'), u=u(x, psi = 'lqq'), psi = 'lqq'), data.frame(l=l(x, psi = 'bisquare'), u=u(x, psi = 'bisquare'), psi = 'bisquare'), data.frame(l=l(x, psi = 'optimal'), u=u(x, psi = 'optimal'), psi = 'optimal')) rmb$x <- x save(rmb, file=asymptMBFile) } else load(asymptMBFile) ################################################### ### code chunk number 37: fig-max-asymptotic-bias ################################################### getOption("SweaveHooks")[["fig"]]() print(ggplot(rmb, aes(x, l, color=psi)) + geom_line() + geom_line(aes(x, u, color=psi), linetype = 2) + xlab(quote("amount of contamination" ~~ epsilon)) + ylab("maximum asymptotic bias bounds") + coord_cartesian(ylim = c(0,10)) + scale_y_continuous(breaks = 1:10) + scale_colour_hue(quote(psi ~ '-function'))) robustbase/inst/doc/psi_functions.R0000644000176200001440000001031313465050123017150 0ustar liggesusers### R code from vignette source 'psi_functions.Rnw' ### Encoding: UTF-8 ################################################### ### code chunk number 1: init ################################################### # set margins for plots options(SweaveHooks=list(fig=function() par(mar=c(3,3,1.4,0.7), mgp=c(1.5, 0.5, 0)))) ## x axis for plots: x. <- seq(-5, 10, length=1501) require(robustbase) ################################################### ### code chunk number 2: source-p-psiFun ################################################### source(system.file("xtraR/plot-psiFun.R", package = "robustbase", mustWork=TRUE)) ################################################### ### code chunk number 3: Huber ################################################### getOption("SweaveHooks")[["fig"]]() plot(huberPsi, x., ylim=c(-1.4, 5), leg.loc="topright", main=FALSE) ################################################### ### code chunk number 4: lmrob-psi ################################################### names(.Mpsi.tuning.defaults) ################################################### ### code chunk number 5: tuning-defaults ################################################### print(c(k.M = .Mpsi.tuning.default("bisquare"), k.S = .Mchi.tuning.default("bisquare")), digits = 10) ################################################### ### code chunk number 6: note-p-psiFun (eval = FALSE) ################################################### getOption("SweaveHooks")[["fig"]]() ## source(system.file("xtraR/plot-psiFun.R", package = "robustbase", mustWork=TRUE)) ################################################### ### code chunk number 7: bisquare ################################################### getOption("SweaveHooks")[["fig"]]() p.psiFun(x., "biweight", par = 4.685) ################################################### ### code chunk number 8: Hampel ################################################### getOption("SweaveHooks")[["fig"]]() ## see also hampelPsi p.psiFun(x., "Hampel", par = ## Default, but rounded: round(c(1.5, 3.5, 8) * 0.9016085, 1)) ################################################### ### code chunk number 9: GGW-const ################################################### cT <- rbind(cc1 = .psi.ggw.findc(ms = -0.5, b = 1.5, eff = 0.95 ), cc2 = .psi.ggw.findc(ms = -0.5, b = 1.5, bp = 0.50)); cT ################################################### ### code chunk number 10: rhoInf-ggw ################################################### ipsi.ggw <- .psi2ipsi("GGW") # = 5 ccc <- c(0, cT[1, 2:4], 1) integrate(.Mpsi, 0, Inf, ccc=ccc, ipsi=ipsi.ggw)$value # = rho(Inf) ################################################### ### code chunk number 11: GGW ################################################### getOption("SweaveHooks")[["fig"]]() p.psiFun(x., "GGW", par = c(-.5, 1, .95, NA)) ################################################### ### code chunk number 12: lqq-const ################################################### cT <- rbind(cc1 = .psi.lqq.findc(ms= -0.5, b.c = 1.5, eff=0.95, bp=NA ), cc2 = .psi.lqq.findc(ms= -0.5, b.c = 1.5, eff=NA , bp=0.50)) colnames(cT) <- c("b", "c", "s"); cT ################################################### ### code chunk number 13: LQQ ################################################### getOption("SweaveHooks")[["fig"]]() p.psiFun(x., "LQQ", par = c(-.5,1.5,.95,NA)) ################################################### ### code chunk number 14: optimal ################################################### getOption("SweaveHooks")[["fig"]]() p.psiFun(x., "optimal", par = 1.06, leg.loc="bottomright") ################################################### ### code chunk number 15: Welsh-GGW ################################################### ccc <- c(0, a = 2.11^2, b = 2, c = 0, 1) (ccc[5] <- integrate(.Mpsi, 0, Inf, ccc=ccc, ipsi = 5)$value) # = rho(Inf) stopifnot(all.equal(Mpsi(x., ccc, "GGW"), ## psi[ GGW ](x; a=k^2, b=2, c=0) == Mpsi(x., 2.11, "Welsh")))## psi[Welsh](x; k) ################################################### ### code chunk number 16: Welsh ################################################### getOption("SweaveHooks")[["fig"]]() p.psiFun(x., "Welsh", par = 2.11) robustbase/inst/doc/simulation.init.R0000644000176200001440000000530212321016045017410 0ustar liggesusers## initialize R simulations (also parallel workers) ## need to export the variables N, robustDoc and slave if (!exists("N")) N <- 1000 if (!exists("robustDoc")) robustDoc <- system.file('doc', package='robustbase') ## load required packages stopifnot(require(xtable), require(robustbase)) ## load more packages if this is a worker if (exists("slave")) stopifnot(require(robust), require(skewt), require(foreach)) ## default data set dd <- data.frame(X1 = c(0.0707996949791054, 0.0347546309449992, 1.30548268152542, 0.866041511462982, 0.275764343116733, 0.670798705161399, -0.549345193993536, -1.00640134962924, -1.22061169833477, -0.905619374719898, -0.678473241822565, 0.607011706444643, 0.304237114526011, -2.14562816298790, 2.34057395639167, 0.310752185537814, -0.972658170945796, 0.362012836241727, 0.925888071796771, -0.595380245695561), X2 = c(0.119970864158429, -0.738808741221796, 5.49659158913364, 3.52149647048925, 2.02079730735676, 3.82735326206246, -1.24025420267206, -4.37015614526438, -5.00575484838141, -3.56682651298729, -2.82581432351811, 0.0456819251791285, -0.93949674689997, -8.08282316242221, 9.76283850058346, 0.866426786132133, -2.90670860898916, 2.95555226542630, 4.50904028657548, -3.44910596474065), X3 = c(1.11332914932289, 3.55583356836222, 10.4937363250789, 0.548517298224424, 1.67062103214174, 0.124224367717813, 6.86425894634543, 1.14254475111985, 0.612987848127285, 0.85062803777296, 0.881141283379239, 0.650457856125926, 0.641015255931405, 1.51667982973630, 0.764725309853834, 1.61169179152476, 0.596312457754167, 0.262270854360470, 1.24686336241, 0.386112727548389)) ## load functions source(file.path(robustDoc, 'simulation.functions.R')) source(file.path(robustDoc, 'estimating.functions.R')) source(file.path(robustDoc, 'error.distributions.R')) ## set estlist and parameters estlist <- .estlist.confint ## nr. of repetitions estlist$nrep <- N estlist$seed <- 13082010 ## set errors estlist$errs <- c(estlist$errs, list(.errs.skt.Inf.2, .errs.skt.5.2, .errs.cnorm..1.0.10, .errs.cnorm..1.4.1)) robustbase/inst/doc/fastMcd-kmini.R0000644000176200001440000000136413465050107016763 0ustar liggesusers### R code from vignette source 'fastMcd-kmini.Rnw' ### Encoding: UTF-8 ################################################### ### code chunk number 1: init ################################################### # set margins for plots options(SweaveHooks=list(fig=function() par(mar=c(3,3,1.4,0.7), mgp=c(1.5, 0.5, 0))), width = 75) ################################################### ### code chunk number 2: h.alpha.ex ################################################### require(robustbase) n <- c(5, 10, 20, 30, 50, 100, 200, 500) hmat <- function(alpha, p) cbind(n, h.alpha = h.alpha.n (alpha, n,p), h. = floor(alpha * (n + p + 1)), alpha.n = round(alpha * n)) hmat(alpha = 1/2, p = 3) hmat(alpha = 3/4, p = 4) robustbase/inst/doc/fastMcd-kmini.Rnw0000644000176200001440000003113213012615634017324 0ustar liggesusers\documentclass[11pt, a4paper]{article} \usepackage[a4paper, text={16cm,25cm}]{geometry} %\VignetteIndexEntry{covMcd() -- Generalizing the FastMCD} %\VignetteDepends{robustbase} \SweaveOpts{prefix.string=mcd, eps=FALSE, pdf=TRUE, strip.white=true} \SweaveOpts{width=6, height=4.1} \usepackage{amsmath} \usepackage{amsfonts}% \mathbb \usepackage{mathtools}% -> \floor, \ceil \usepackage[utf8]{inputenc} %% The following is partly R's share/texmf/Rd.sty \usepackage{color} \usepackage{hyperref} \definecolor{Blue}{rgb}{0,0,0.8} \definecolor{Red}{rgb}{0.7,0,0} \hypersetup{% hyperindex,% colorlinks={true},% pagebackref,% linktocpage,% plainpages={false},% linkcolor={Blue},% citecolor={Blue},% urlcolor={Red},% pdfstartview={Fit},% pdfview={XYZ null null null}% } \usepackage{natbib} \usepackage[noae]{Sweave} %---------------------------------------------------- \DeclarePairedDelimiter{\ceil}{\lceil}{\rceil} \DeclarePairedDelimiter{\floor}{\lfloor}{\rfloor} \DeclareMathOperator{\sign}{sign} \newcommand{\abs}[1]{\left| #1 \right|} \newtheorem{definition}{Definition} \newcommand{\byDef}{\mathrm{by\ default}} \newcommand{\R}{{\normalfont\textsf{R}}{}} \newcommand{\code}[1]{\texttt{#1}} \newcommand*{\pkg}[1]{\texttt{#1}} \newcommand*{\CRANpkg}[1]{\href{https://CRAN.R-project.org/package=#1}{\pkg{#1}}} %---------------------------------------------------- \begin{document} \setkeys{Gin}{width=0.9\textwidth} \setlength{\abovecaptionskip}{-5pt} \title{covMcd() -- Considerations about Generalizing the FastMCD} \author{Martin M\"achler} \maketitle %\tableofcontents %% %% Pison, G., Van Aelst, S., and Willems, G. (2002) %% Small Sample Corrections for LTS and MCD. %% Metrika % ~/save/papers/robust-diverse/Pison_VanAelst_Willems.pdf %% <>= # set margins for plots options(SweaveHooks=list(fig=function() par(mar=c(3,3,1.4,0.7), mgp=c(1.5, 0.5, 0))), width = 75) @ \section{Introduction} The context is robust multivariate ``location and scatter'' estimation, which corresponds to estimating the first two moments in cases they exist. We assume data and a model \begin{align} \label{eq:data-model} x_i & \in \mathbb{R}^p, \ \ i=1,2,\dots,n \\ x_i & \sim \mathcal{F}(\mu, \Sigma), \ \ \mathrm{i.i.d.};\ \ \mu \in \mathbb{R}^p, \ \ \Sigma \in \mathbb{R}^{p \times p}, \ \textrm{positive definite}, \end{align} where a conceptual null model is the $p$-dimensional normal distribution. One typical assumption is that $\mathcal{F}$ is a mixture with the majority component (``good data'') being $\mathcal{N}_p(\mu, \Sigma)$ and other components modeling ``the outliers''. In other words, we want estimates $\bigl(\hat{\mu}, \hat{\Sigma}\bigr)$ which should be close to the true ``good data'' $(\mu, \Sigma)$ --- and do not say more here. \section{MCD and ``the Fast'' MCD (= \textsc{fastmcd}) Algorithm} The \CRANpkg{robustbase} \R{} package has featured a function \code{covMcd()} since early on (Feb.~2006) and that has been an interface to the Fortran routine provided by the original authors and (partly) described in \citet{RouPvD99}. %% Rousseeuw, P. J. and van Driessen, K. (1999) %% A fast algorithm for the minimum covariance determinant estimator. %% Technometrics {41}, 212--223. %% >> ~/save/papers/robust-diverse/Rousseeuw_VanD-FastMCD_1999.pdf % ------------------------------------------------------------ We describe shortly how the algorithm works, partly building on the documentation provided in the source (R, S, and Fortran) codes: %% R CMD Rdconv --type=latex ../../man/covMcd.Rd > covMcd.tex The minimum covariance determinant estimator of location and scatter (MCD) implemented in \code{covMcd()} is similar to \R{} function \code{cov.mcd()} in \CRANpkg{MASS}. The (``theoretical'') MCD looks for the $h = h_\alpha (> 1/2)$ out of $n$ observations whose classical covariance matrix has the lowest possible determinant. In more detail, we will use $h = h_\alpha = h(\alpha,n,p) \approx \alpha \cdot (n+p+1)$, where as \citet{RouPvD99} mainly use (the default) $\alpha = \frac 1 2$, where $h = h(1/2, n, p) = \floor[\Big]{\frac{n+p+1}{2}}$. For general $\alpha \ge \frac 1 2$, the \R{} implementation (derived from their original S code) uses $h = h(\alpha,n,p) =$ \code{h.alpha.n(alpha,n,p)} (function in \pkg{robustbase}), which is \begin{eqnarray} \label{eq:def-h} h = h_\alpha = h(\alpha,n,p) := \floor{2 n_2 - n + 2 \alpha (n - n_2)}, \ \mathrm{where\ } n_2 := \floor[\Big]{\frac{n+p+1}{2}}% %= (n+p+1)/2 \ \ (\mathrm{\ where ``/'' denotes \emph{integer} division}) . \end{eqnarray} The fraction $\alpha \ge \frac 1 2$ can be chosen by the user, where $\alpha = \frac 1 2$ is the most robust, and indeed, $h_{1/2} = n_2 = \floor[\Big]{\frac{n+p+1}{2}}$. Even in general, as long as $n \gg p$, $\alpha$ is approximately the \emph{proportion} of the subsample size $h$ in the full sample (size $n$): \begin{equation} \label{eq:h.approx} h \approx \alpha \cdot n \iff \alpha \approx \frac{h}{n}, \end{equation} <>= require(robustbase) n <- c(5, 10, 20, 30, 50, 100, 200, 500) hmat <- function(alpha, p) cbind(n, h.alpha = h.alpha.n (alpha, n,p), h. = floor(alpha * (n + p + 1)), alpha.n = round(alpha * n)) hmat(alpha = 1/2, p = 3) hmat(alpha = 3/4, p = 4) @ The breakdown point (for $h > \frac{n}{2}$) then is \begin{eqnarray} \label{eq:breakdown} \epsilon_{*} = \frac{n-h+1}{n}, \end{eqnarray} which is less than but close to $\frac 1 2$ for $\alpha = \frac 1 2$, and in general, $h/n \approx \alpha$, the breakdown point is approximately, \begin{eqnarray} \label{eq:eps-approx} \epsilon_{*} = \frac{n-h+1}{n} \approx \frac{n-h}{n} = 1 - \frac{h}{n} \approx 1 - \alpha. \end{eqnarray} The raw MCD estimate of location, say $\hat{\mu}_0$, is then the average of these $h$ points, whereas the raw MCD estimate of scatter, $\hat{\Sigma}_0$, is their covariance matrix, multiplied by a consistency factor \code{.MCDcons(p, h/n)}) and (by default) a finite sample correction factor \code{.MCDcnp2(p, n, alpha)}, to make it consistent at the normal model and unbiased at small samples. %% Both rescaling factors (consistency and finite sample) are returned in the length-2 vector %% \code{raw.cnp2}. In practice, for reasonably sized $n$, $p$ and hence $h$, it is not feasible to search the full space of all $n \choose h$ $h$-subsets of $n$ observations. Rather, the implementation of \code{covMcd} uses the Fast MCD algorithm of \citet{RouPvD99} to approximate the minimum covariance determinant estimator, see Section~\ref{sec:fastMCD}. Based on these raw MCD estimates, $\bigl(\hat{\mu}_0, \hat{\Sigma}_0\bigr)$, % (unless argument \code{raw.only} is true), a reweighting step is performed, i.e., \code{V <- cov.wt(x,w)}, where \code{w} are weights determined by ``outlyingness'' with respect to the scaled raw MCD, using the ``Mahalanobis''-like, robust distances $d_i\bigl(\hat{\mu}_0, \hat{\Sigma}_0\bigr)$, see (\ref{eq:Maha}). Again, a consistency factor and %(if \code{use.correction} is true) a finite sample correction factor %(\code{.MCDcnp2.rew(p, n, alpha)}) are applied. The reweighted covariance is typically considerably more efficient than the raw one, see \citet{PisGvAW02}. The two rescaling factors for the reweighted estimates are returned in \code{cnp2}. Details for the computation of the finite sample correction factors can be found in \citet{PisGvAW02}. \section{Fast MCD Algorithm -- General notation}\label{sec:fastMCD} \paragraph{Note:} In the following, apart from the mathematical notation, we also use variable names, e.g., \code{kmini}, used in the Fortran and sometimes \R{} function code, in \R{} package \CRANpkg{robustbase}. Instead of directly searching for $h$-subsets (among ${n \choose h} \approx {n \choose n/2}$) the basic idea is to start with small subsets of size $p+1$, their center $\mu$ and covariance matrix $\Sigma$, and a corresponding $h$-subset of the $h$ observations with smallest (squared) (``Mahalanobis''-like) distances \begin{align} \label{eq:Maha} d_i = d_i(\mu,\Sigma) := (x_i - \mu)' \Sigma^{-1} (x_i - \mu), \ \ i=1,2,\dots,n, \end{align} and then use concentration steps (``C~steps'') to (locally) improve the chosen set by iteratively computing $\mu$, $\Sigma$, new distances $d_i$ and a new set of size $h$ with smallest distances $d_i(\mu,\Sigma)$. Each C~step is proven to decrease the determinant $\det(\Sigma)$ if $\mu$ and $\Sigma$ did change at all. Consequently, convergence to a local minimum is sure, as the number of $h$-subsets is finite. To make the algorithm \emph{fast} for non small sample size $n$ the data set is split into ``groups'' or ``sub-datasets'' as soon as \begin{eqnarray} \label{eq:nmini} n \ge 2 n_0, \ \mathrm{ where}\ \ n_0 := \mathtt{nmini} \ ( = 300, \byDef). \end{eqnarray} i.e., the default cutoff for ``non small'' is at $n = 600$. %% The \emph{number} of such subsets in the original algorithm is maximally 5, and we now use \begin{eqnarray} \label{eq:kmini} k_M = \code{kmini} \ (= 5, \byDef), \end{eqnarray} as upper limit. As above, we assume from now on that $n \ge 2 n_0$, and let \begin{eqnarray} \label{eq:k-def} k := \floor[\Big]{\frac{n}{n_0}} \ge 2 \end{eqnarray} and now distinguish the two cases, \begin{eqnarray} \label{eq:cases} \begin{cases} A. & k < k_M \iff n < k_M \cdot n_0 \\ B. & k \ge k_M \iff n \ge k_M \cdot n_0 \end{cases} \end{eqnarray} \begin{description} \item[In case A] $k$ (\code{= ngroup}) subsets aka ``groups'' or ``sub datasets'' are used, $k \in\{2,3,\dots,k_M-1\}$, of group sizes $n_j$, $j=1,\dots,k$ (see below). Note that case~A may be empty because of $2 \le k < k_M$, namely if $k_M=2$. Hence, in case~A, we have $k_M \ge 3$. \item[in case B] $k_M$ (\code{= ngroup}) groups each of size $n_0$ are built and in the first stage, only a \emph{subset} of $k_M \cdot n_0 \le n$ observations is used. \end{description} In both cases, the disjoint groups (``sub datasets'') are chosen at random from the $n$ observations. %% For the group sizes for case~A, $n_j$, $j=1,\dots,k$, we have \begin{align} n_1 = \; & \floor[\Big]{\frac n k} = \floor[\bigg]{\frac{n}{\floor[\big]{\frac{n}{n_0}}}} \ \ (\; \ge n_0 \label{eq:n1})\\ n_j = \; & n_1,\hspace*{2.8em} j = 2,\dots,j_* \\ n_j = \; & n_1 + 1, \ \ \ j = j_* +1,\dots,k, \label{n1-plus-1}\\ & \qquad \mathrm{where}\ \ j_* := k - r \ \in \{1,\dots,k\}, \label{jstar}\\ & \qquad \mathrm{and}\ \ r := n - k n_1 = \label{r-rest} n - k\floor[\big]{\frac n k} \in \{0,1,\dots,k-1\}, \end{align} where the range of $j_*$, $1,\dots,k$ in (\ref{jstar}) is a consequence of the range of the integer division remainder $r \in \{0,1,\dots,k-1\}$ in (\ref{r-rest}). Consequently, (\ref{n1-plus-1}) maybe empty, namely iff $r=0$ ($\iff n = k \cdot n_1$ is a multiple of $k$): $j_* = k$, and all $n_j \equiv n_1$. Considering the range of $n_j$ in case~A, the minimum $n_1 \ge n_0$ in (\ref{eq:n1}) is easy to verify. What is the maximal value of $n_j$ , i.e., an upper bound for $n_{\max} := n_1+1 \ge \max_j n_j$? \ %% %% This is all correct but not useful: %% From (\ref{eq:n1}), $ n/k - 1 < n_1 \le n/k $, and %% from (\ref{eq:k-def}), $n/n_0 - 1 < k \le n/n_0$. %% Putting these two together, we get %% \begin{eqnarray} %% \label{eq:n1-ineq} %% \frac{n^2}{n_0} - 1 \le n/k - 1 < n_1 \le n/k < \frac{n n_0}{n - n_0}, %% \end{eqnarray} %% (the first $\le$ from $\frac{1}{k} \ge \frac{n_0}{n}$; the last $<$ from %% $\frac{1}{k} < \frac 1{n/n_0 -1} = \frac{n_0}{n-n_0}$.) Also, %% from (\ref{eq:k-def}), $n \ge k n_0$ and $n-n_0 \ge (k-1)n_0$ and since we %% are in case~A, $n < n_0 k_M$, which combines to %% \begin{eqnarray} %% \label{eq:nn0} %% \frac{n n_0}{n - n_0} < \frac{(n_0 k_M) n_0}{(k-1)n_0} = \frac{n_0 k_M}{k-1}. %% \end{eqnarray} Consider $n_{1,\max}(k) = \max_{n, \mathrm{given\ } k} n_1 = \max_{n, \mathrm{given\ } k} \floor{\frac n k}$. Given $k$, the maximal $n$ still fulfilling $\floor[\big]{\frac{n}{n_0}} = k$ is $n = (k+1)n_0 - 1$ where $\floor[\big]{\frac{n}{n_0}} = k + \floor[\big]{1 - \frac{1}{n_0}} = k$. Hence, $n_{1,\max}(k) =\floor[\big]{\frac{(k+1)n_0 - 1}{k}} = n_0 + \floor[\big]{\frac{n_0 - 1}{k}}$, and as $k \ge 2$, the maximum is at $k=2$, $\max n_1 = \max_k n_{1,\max}(k) = n_0 + \floor[\big]{\frac{n_0 - 1}{2}} = \floor[\big]{\frac{3 n_0 - 1}{2}}$. Taken together, as $n_j = n_1+1$ is possible, we have \begin{align} \label{eq:nj-range} n_0 \le & n_1 \le \floor[\Big]{\frac{3 n_0 - 1}{2}} \nonumber\\ n_0 \le & n_j \le \floor[\Big]{\frac{3 n_0 + 1}{2}}, \ \ j \ge 2. \end{align} Note that indeed, $\floor[\big]{\frac{3 n_0 + 1}{2}}$ is the length of the auxiliary vector \code{subndex} in the Fortran code. \bibliographystyle{chicago} \bibliography{robustbase} \end{document} robustbase/inst/doc/graphics.functions.R0000644000176200001440000005027412023604053020102 0ustar liggesusers## some additional functions to help plotting ## g.drop.labels <- function(breaks, labels) { ## ind <- breaks %in% labels ## breaks <- as.character(breaks) ## breaks[!ind] <- '' ## breaks ## } g.scale_y_log10_0.05 <- function(breaks = c(0.00001, 0.0001, 0.001, 0.01, 0.02, 0.03, 0.05, 0.07, 0.1, 0.14, 0.2, 0.4, 0.8), minor_breaks = seq(0,1,by = 0.01), ...) ## Purpose: add nice breaks and labels ## ---------------------------------------------------------------------- ## Arguments: just like scale_y_log10 ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 11 Nov 2009, 11:52 scale_y_log10(breaks = breaks, minor_breaks = minor_breaks, ...) ## the same for lattice: g.scale_y_log10_0.05_lattice <- list(at = log10(c(seq(0.1, 0.01, by = -0.01), 0.001, 0.0001, 0.00001)), labels = c("", 0.09, "", 0.07, "", 0.05, "", 0.03, "", 0.01, 0.001, 0.0001, 0.00001)) g.scale_y_log10_1 <- function(breaks = c(seq(0,1,by=0.1), seq(1.2, 3.5,by=0.2)), minor_breaks = seq(0,10,by = 0.1), ...) ## Purpose: add nice breaks and labels ## ---------------------------------------------------------------------- ## Arguments: just like scale_y_log10 ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 11 Nov 2009, 11:52 scale_y_log10(breaks = breaks, minor_breaks = minor_breaks, ...) g.scale_y_log10_1_l <- function(breaks = c(seq(0,.4,by=0.1), seq(0.6,1.4,by=0.2), seq(1.6, 3.4, by = 0.4)), minor_breaks = seq(0,10,by = 0.1), ...) ## Purpose: add nice breaks and labels ## ---------------------------------------------------------------------- ## Arguments: just like scale_y_log10 ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 11 Nov 2009, 11:52 scale_y_log10(breaks = breaks, minor_breaks = minor_breaks, ...) g.scale_shape_defaults = c(16, 17, 15, 3, 7, 8) g.scale_shape_defaults2 = c(g.scale_shape_defaults,9,1,2,4) g.scale_linetype_defaults = c("solid", "22", "42", "44", "13", "1343", "73", "2262", "12223242", "F282", "F4448444", "224282F2", "F1") g.scale_shape <- function(..., values=g.scale_shape_defaults2) scale_shape_manual(..., values = values) g.get_colors <- function(n, h=c(0,360) + 15, l=65, c=100, start=0, direction = 1) { rotate <- function(x) (x + start) %% 360 * direction if ((diff(h) %% 360) < 1) { h[2] <- h[2] - 360 / n } grDevices::hcl(h = rotate(seq(h[1], h[2], length = n)), c = c, l = l) } g.get_colors_brewer <- function(n, name='Dark2') { idx <- 1:n if (name=='Dark2') { idx <- c(6,2:5,1,7,8)[idx] } RColorBrewer::brewer.pal(n, name)[idx] } g.scale_colour <- function(..., n=8, values=g.get_colors_brewer(n=n)) scale_colour_manual(..., values=values) ########################################################################### ## some useful helper functions ########################################################################### f.range.xy <- function(x,...) UseMethod("f.range.xy") ## Purpose: get plot range for x and y axis and return as a data.frame ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 6 Oct 2009, 13:42 f.range.xy.default <- function(x, ...) data.frame(x = range(x$x), y = range(x$y)) f.range.xy.data.frame <- function(x, names = c('x','y'), ...) sapply(x[,names],range) f.range.xy.matrix <- function(x, names = c('x','y'), ...) sapply(x[,names],range) f.range.xy.list <- function(x,...) data.frame(x = range(sapply(x, function(x) x$x)), y = range(sapply(x, function(x) x$y))) f.range.xy.histogram <- function(x,...) data.frame(x = range(sapply(x, function(x) x$breaks)), y = range(sapply(x, function(x) x$counts))) f.trim <- function(data, trim = 0.05) { ## Purpose: trim alpha observations ## ---------------------------------------------------------------------- ## Arguments: data and trim ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 19 Nov 2009, 14:33 n <- length(data) lo <- floor(n * trim) + 1 hi <- n + 1 - lo sort.int(data, partial = unique(c(lo, hi)))[lo:hi] } f.seq <- function(x, ...) ## Purpose: make seq callable with an vector x = c(from, to) ## ---------------------------------------------------------------------- ## Arguments: x: vector of length two (from, to) ## ...: other arguments to seq ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 20 Nov 2009, 08:55 seq(from = x[1], to = x[2],...) curves <- function(expr, from = NULL, to = NULL, n = 101, add = FALSE, type = "l", ylab = 'values', xlab = 'x', log = NULL, xlim = NULL, xcol = NULL, geom = geom_path, wrap = TRUE, ...) { ## Purpose: curves: does the same as curve, but for multivariate output ## ---------------------------------------------------------------------- ## Arguments: same as curve ## xcol: column of data.frame to use for x instead of default ## geom: what geom function to use, defaults to geom_path ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 15 Jan 2010, 08:48 sexpr <- substitute(expr) if (is.name(sexpr)) { fcall <- paste(sexpr, "(x)") expr <- parse(text = fcall) if (is.null(ylab)) ylab <- fcall } else { if (!(is.call(sexpr) && match("x", all.vars(sexpr), nomatch = 0L))) stop("'expr' must be a function or an expression containing 'x'") expr <- sexpr if (is.null(ylab)) ylab <- deparse(sexpr) } if (is.null(xlim)) delayedAssign("lims", { pu <- par("usr")[1L:2L] if (par("xaxs") == "r") pu <- extendrange(pu, f = -1/27) if (par("xlog")) 10^pu else pu }) else lims <- xlim if (is.null(from)) from <- lims[1L] if (is.null(to)) to <- lims[2L] lg <- if (length(log)) log else paste(if (add && par("xlog")) "x", if (add && par("ylog")) "y", sep = "") if (length(lg) == 0) lg <- "" x <- if (lg != "" && "x" %in% strsplit(lg, NULL)[[1L]]) { if (any(c(from, to) <= 0)) stop("'from' and 'to' must be > 0 with log=\"x\"") exp(seq.int(log(from), log(to), length.out = n)) } else seq.int(from, to, length.out = n) y <- eval(expr, envir = list(x = x), enclos = parent.frame()) ## up this was an exact copy of curve if (length(dim(y)) == 1) { ydf <- data.frame(x = x, values = y) gl <- geom(data = ydf, aes(x = x, y = values), ...) ret <- if (add) gl else ggplot(ydf) + gl } else { ## check whether we have to transpose y if (NCOL(y) != n) { if (NROW(y) == n) y <- t(y) else stop(paste('output should have n =',n,' columns')) } ## add dimnames dm <- dimnames(y) if (is.null(dm)) dm <- list(1:NROW(y), 1:NCOL(y)) if (is.null(names(dm))) names(dm) <- c('rows', 'cols') if (is.null(dm[[1]])) dm[[1]] <- 1:NROW(y) if (is.null(dm[[2]])) dm[[2]] <- 1:NCOL(y) dimnames(y) <- dm ## restructure the output matrix to a data.frame ydf <- melt(y) ## un-factor the first two columns for (i in 1:2) { if (is.factor(ydf[[i]])) ydf[[i]] <- f.as.numeric.vectorized(levels(ydf[[i]]))[ydf[[i]]] } ## add x column ydf$x <- rep(x, each = NROW(y)) if (is.null(xcol)) { xcol <- 'x' } else { ## get desired x column lx <- ydf[idx <- ydf[,1] == xcol,3] ## remove it from the values ydf <- ydf[!idx,] ## add as additional column ydf[[xcol]] <- rep(lx, each = NROW(y) - 1) if (missing(xlab)) xlab <- xcol } if (wrap) { ## use facet wrap, or assume it was used before ## there seems to be a bug in ggplot that requires sorting for the rows variable ydf <- ydf[order(ydf[,1],ydf[,2]),] gl <- geom(data = ydf, aes_string(x = xcol, y = 'value'), ...) ret <- if (add) gl else ggplot(ydf) + gl + xlab(xlab) + facet_wrap(substitute(~ rows, list(rows = as.name(names(dm)[1])))) } else { ## factor 'rows' again ydf[, 1] <- factor(ydf[, 1], levels = unique(ydf[, 1])) ret <- if (add) geom(data = ydf, aes_string(x = xcol, y = 'value', color = names(dm)[1]), ...) else ggplot(ydf) + geom(aes_string(x = xcol, y = 'value', linetype = names(dm)[1]), ...) + xlab(xlab) } } if (!add && !is.null(log)) { ret <- ret + switch(log, xy = coord_trans(x = 'log', y='log'), x = coord_trans(x = 'log'), y = coord_strans(y = 'log'), list() ) } ret } f.get.range <- function(p, axis) { ## Purpose: get range of axis from ggplot object ## ---------------------------------------------------------------------- ## Arguments: p: ggplot return object ## axis: 'x' or 'y' ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 27 Jan 2010, 09:37 lr <- NULL ## get range in from base mapping, if available if (!is.null(p$mapping[[axis]])) lr <- range(p$data[[as.character(p$mapping[[axis]])]], na.rm = TRUE) ## walk layers for (llayer in p$layers) { lvar <- as.character(llayer$mapping[[axis]]) if (!is.null(lvar) && length(lvar) > 0) { ## check if the variable is available in custom data.frame if (!is.null(llayer$data) && NCOL(llayer$data) > 0 && lvar %in% colnames(llayer$data)) ## if so, update range lr <- range(c(llayer$data[[lvar]], lr), na.rm = TRUE) else ## try to update range with data from global data.frame if (!is.null(p$data) && NCOL(p$data) > 0 && lvar %in% colnames(p$data)) ## if so, update range lr <- range(c(p$data[[lvar]], lr), na.rm = TRUE) } } lr } ## makeFootnote: add footnote to plot (like stamp) ## from: http://www.r-bloggers.com/r-good-practice-%E2%80%93-adding-footnotes-to-graphics/ makeFootnote <- function(footnoteText= format(Sys.time(), "%d %b %Y"), size= .7, color="black") { ## require(grid) pushViewport(viewport()) grid.text(label= footnoteText , x = unit(1,"npc") - unit(2, "mm"), y= unit(2, "mm"), just=c("right", "bottom"), gp=gpar(cex= size, col=color)) popViewport() } ## ## Example ## ## plot(1:10) ## makeFootnote(footnote) ## using this and multicore results in segmentation fault ## print.ggplot <- function(..., footnote) ## { ## ## Purpose: print ggplot and add a footnote ## ## ---------------------------------------------------------------------- ## ## Arguments: see ?print.ggplot ## ## footnote: text to be added as footnote ## ## ---------------------------------------------------------------------- ## ## Author: Manuel Koller, Date: 25 Jan 2010, 16:32 ## ggplot2::print.ggplot(...) ## ## if (!missing(footnote)) grid.text(footnote, x = unit(1, 'npc') - unit(2, 'mm'), ## ## y = unit(2, 'mm'), ## ## just = c('right', 'bottom'), ## ## gp=gpar(cex=.7, col=grey(.5))) ## if (!missing(footnote)) makeFootnote(footnote)o ## } ## ## modify print.ggplot: update legend automatically ## print.ggplot <- function (x, newpage = is.null(vp), vp = NULL, ...) ## { ## set_last_plot(x) ## lg <- ggplotGrob(x, ...) ## ## edit grob: change legends ## ## get all legend texts ## lls <- getGrob(lg, gPath='legend.text.text', grep = TRUE, global = TRUE) ## for(le in lls) { ## print(le$label) ## if (!is.expression(le$label) && le$label %in% names(legend.mod)) { ## lg <- editGrob(lg, gPath=le$name, label = legend.mod[[le$label]]) ## } ## } ## if (newpage) ## grid.newpage() ## if (is.null(vp)) { ## grid.draw(lg) ## } ## else { ## if (is.character(vp)) ## seekViewport(vp) ## else pushViewport(vp) ## grid.draw(lg) ## upViewport() ## } ## } require(grid) print.ggplot <- function(x, newpage = is.null(vp), vp = NULL, ..., footnote = NULL, footnote.col = 'black', footnote.size = .7, footnote.just = c("right", "bottom"), legend.mod = NULL) { ## Purpose: print ggplot and add footnote ## ---------------------------------------------------------------------- ## Arguments: x, newpage, vp, ...: see ?print.ggplot ## footnote: text to be added as footnote ## footnote.col: color of footnote ## .size: size of footnote text (cex) ## .just: justification of footnote ## legend.mod: named list on what legend entries to replace ## by value ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 26 Jan 2010, 09:01 if ((missing(footnote) && missing(legend.mod)) || packageVersion("ggplot2") > "0.9.1") return(ggplot2:::print.ggplot(x, newpage, vp, ...)) ## this is mostly a copy of ggplot2::print.ggplot ggplot2:::set_last_plot(x) if (newpage) grid.newpage() grob <- ggplotGrob(x, ...) if (!missing(legend.mod)) { ## edit grob: change legends and strip text lls <- getGrob(grob, gPath='(xlab-|ylab-|title-|label-|legend.text.text|strip.text.x.text|strip.text.y.text)', grep=TRUE, global=TRUE) ## walk all legend texts for(le in lls) { if (!is.null(le$label) && !is.expression(le$label) && length(le$label) > 0 && le$label %in% names(legend.mod)) { grob <- editGrob(grob, gPath=le$name, label = legend.mod[[le$label]]) } } ## also: remove alpha in legend key points lls <- getGrob(grob, gPath='key.points', grep=TRUE, global=TRUE) for (le in lls) { if (is.character(le$gp$col) && grepl('^\\#', le$gp$col)) { lgp <- le$gp lgp$col <- substr(lgp$col, 1, 7) grob <- editGrob(grob, gPath=le$name, gp=lgp) } } ## also: change spacing of legends grob$children$legends$framevp$layout$heights <- grob$children$legends$framevp$layout$heights * .91 } if (missing(footnote)) grid.draw(grob) else { if (is.null(vp)) { ## add footnote to grob grob$children$footnote <- grid.text(label=footnote, x = unit(1, "npc") - unit(2, "mm"), y = unit(2, "mm"), just = footnote.just, gp=gpar(cex = footnote.size, col = footnote.col), draw = FALSE) llen <- length(grob$childrenOrder) grob$childrenOrder[llen+1] <- 'footnote' grid.draw(grob) } else { if (is.character(vp)) seekViewport(vp) else pushViewport(vp) grid.draw(grob) upViewport() ## add footnote to plot (from makeFootnote) pushViewport(viewport()) grid.text(label=footnote, x = unit(1, "npc") - unit(2, "mm"), y = unit(2, "mm"), just = footnote.just, gp=gpar(cex = footnote.size, col = footnote.col)) popViewport() } } } ## guide_legends_box <- function (scales, layers, default_mapping, horizontal = FALSE, ## theme) ## { ## print('hello') ## legs <- guide_legends(scales, layers, default_mapping, theme = theme) ## n <- length(legs) ## if (n == 0) ## return(zeroGrob()) ## if (!horizontal) { ## width <- do.call("max", lapply(legs, widthDetails)) ## heights <- do.call("unit.c", lapply(legs, function(x) heightDetails(x) * ## 10)) ## fg <- frameGrob(grid.layout(nrow = n, 1, widths = width, ## heights = heights, just = "centre"), name = "legends") ## for (i in 1:n) { ## fg <- placeGrob(fg, legs[[i]], row = i) ## } ## } ## else { ## height <- do.call("sum", lapply(legs, heightDetails)) ## widths <- do.call("unit.c", lapply(legs, function(x) widthDetails(x) * ## 1.1)) ## fg <- frameGrob(grid.layout(ncol = n, 1, widths = widths, ## heights = height, just = "centre"), name = "legends") ## for (i in 1:n) { ## fg <- placeGrob(fg, legs[[i]], col = i) ## } ## } ## fg ## } ### viewport test ## data <- data.frame(x = 1:10, y = 1:10) ## tg <- ggplot(data, aes(x, y)) + geom_line() + ## geom_text(data=data.frame(x=10, y=1), label='test') ## print(tg) ## tgrob2 <- ggplotGrob(tg) ## str(tgrob, max.level = 2) ## str(tgrob2, max.level = 2) ## tgrob$children$footnote <- grid.text(label= 'test haha2', x = unit(1,"npc") - unit(2, "mm"), ## y= unit(2, "mm"), just=c("right", "bottom"), ## gp=gpar(cex= .7, col=grey(.5)), draw=FALSE) ## tgrob$childrenOrder[7] <- 'footnote' ## grid.draw(tgrob) ## print(tg, footnote = 'footnote test text') ########################################################################## ## ggplot 0.8.7 bugfix ########################################################################## ## require(ggplot2) ## data <- data.frame(x = 1:10, y = exp(0:9)) ## ggplot(data, aes(x, y)) + geom_point() + ## geom_hline(yintercept = 9) + geom_vline(xintercept = 2) ## last_plot() + coord_trans(y = 'log', x = 'sqrt') ## GeomVline$draw <- function(., data, scales, coordinates, ...) { ## data$y <- if(coordinates$objname=="trans" && ## coordinates$ytr$objname%in%c("log", "sqrt")) 0 else -Inf ## data$yend <- Inf ## GeomSegment$draw(unique(data), scales, coordinates) ## } ## GeomHline$draw <- function(., data, scales, coordinates, ...) { ## data$x <- if(coordinates$objname=="trans" && ## coordinates$xtr$objname%in%c("log", "sqrt")) 0 else -Inf ## data$xend <- Inf ## GeomSegment$draw(unique(data), scales, coordinates) ## } ## Coord$munch_group <- function(., data, details, npieces=50) { ## n <- nrow(data) ## if(n==2 && (all(data$x==c(-Inf,Inf)) || all(data$y==c(-Inf,Inf)))) npieces=1 ## x <- approx(data$x, n = npieces * (n - 1) + 1)$y ## y <- approx(data$y, n = npieces * (n - 1) + 1)$y ## cbind( ## .$transform(data.frame(x=x, y=y), details), ## data[c(rep(1:(n-1), each=npieces), n), setdiff(names(data), c("x", "y"))] ## ) ## } cs <- function(x, y, ..., if.col) { ## Purpose: make aes dependent on global variable color ## ---------------------------------------------------------------------- ## Arguments: same arguments as for aes ## if.col: list of arguments that are only applied if ## color = TRUE ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 7 Sep 2010, 08:36 aes <- structure(as.list(match.call()[-1]), class = "uneval") if (globalenv()$color) { aes2 <- as.list(aes$if.col[-1]) for (item in names(aes2)) { aes[[item]] <- aes2[[item]] } } aes$if.col <- NULL rename_aes(aes) } ## replace levels by legend.mod lab <- function(..., lm=legend.mod) { factors <- list(...) lev <- unlist(lapply(factors, levels)) if (length(factors) > 1) lev <- sort(lev) ret <- as.list(lev) idx <- lev %in% names(lm) ret[idx] <- lm[lev[idx]] ret } ## my labeller mylabel <- function(name, value, lm) { str(name) str(value) if (value %in% names(lm)) lm[[value]] else value } robustbase/inst/doc/simulation.functions.R0000644000176200001440000014752012174500122020466 0ustar liggesusers## Called from ./lmrob_simulation.Rnw ## ~~~~~~~~~~~~~~~~~~~~~ ########################################################################### ## 1. simulation helper functions ########################################################################### f.estname <- function(est = 'lmrob') ## Purpose: translate between 'estname' and actual function name, ## defaults to 'lmrob' ## f.lmRob is just a wrapper for lmRob, since there are some ## problems with the weight and weights arguments ## ---------------------------------------------------------------------- ## Arguments: est: name of estimator ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 6 Oct 2009, 13:36 switch(est, lm.rbase = 'lmrob', lm.robust = 'f.lmRob', rlm = 'rlm', lm = 'lm', est) f.errname <- function(err, prefix = 'r') ## Purpose: translate between natural name of distribution and ## R (r,p,q,d)-name ## ---------------------------------------------------------------------- ## Arguments: err: name of distribution ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 6 Oct 2009, 13:36 paste(prefix, switch(err,normal="norm", t="t", cauchy="cauchy",cnormal="cnorm", err),sep = '') f.requires.envir <- function(estname) ## Purpose: returns indicator on whether estname requires envir argument ## ---------------------------------------------------------------------- ## Arguments: estname: name of estimating function ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 7 Oct 2009, 09:34 switch(estname, f.lmrob.local = TRUE, FALSE) f..paste..list <- function(lst) if (length(lst) == 0) return("") else paste(names(lst),lst,sep='=',collapse=', ') f..split..str <- function(str) { litems <- strsplit(str,', ') lst <- lapply(litems, function(str) strsplit(str,'=')) rlst <- list() for (llst in lst) { lv <- vector() for (litem in llst) lv[litem[1]] <- litem[2] rlst <- c(rlst, list(lv)) } rlst } f.list2str <- function(lst, idx) ## Purpose: convert a list into a string that identifies the ## function and parameter configuration ## ---------------------------------------------------------------------- ## Arguments: lst: list or list of lists ## idx: only take the elements in idx ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 7 Oct 2009, 10:03 f..paste..list(if(missing(idx)) unlist(lst) else unlist(lst)[idx]) f.as.numeric <- function(val) { ## Purpose: convert value to numeric if possible ## ---------------------------------------------------------------------- ## Arguments: vec: value to convert ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 26 Oct 2009, 12:10 r <- suppressWarnings(as.numeric(val)) if (is.na(r)) { ## is character, try to convert to TRUE and FALSE return(switch(casefold(val), "true" = TRUE, "false" = FALSE, val)) } else return(r) } f.as.numeric.vectorized <- function(val) sapply(val, f.as.numeric) f.as.integer <- function(val) { ## Purpose: convert value to numeric if possible ## ---------------------------------------------------------------------- ## Arguments: vec: value to convert ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 26 Oct 2009, 12:10 r <- suppressWarnings(as.integer(val)) if (is.na(r)) { ## is character, try to convert to TRUE and FALSE return(switch(casefold(val), "true" = TRUE, "false" = FALSE, val)) } else return(r) } f.str2list <- function(str, splitchar = '\\.') { ## Purpose: inverse of f.list2str ## ---------------------------------------------------------------------- ## Arguments: str: string or list of strings produced with f.list2str ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 8 Oct 2009, 14:20 ## split input string or strings into a list of vectors lst <- f..split..str(as.character(str)) rlst <- list() ## walk list for (lv in lst) { lrlst <- list() ## for each element of the vector for (ln in names(lv)) { ## split lnames <- strsplit(ln, splitchar)[[1]] ## set either directly if (length(lnames) == 1) lrlst[ln] <- f.as.numeric(lv[ln]) ## or, if it contains a dot, as a sublist else { if (is.null(lrlst[[lnames[1]]])) lrlst[[lnames[1]]] <- list() lrlst[[lnames[1]]][paste(lnames[-1],collapse='.')] <- f.as.numeric(lv[ln]) } } rlst <- c(rlst, list(lrlst)) } rlst } f.round.numeric <- function(num, digits = 0) { ## round only numeric values in list idx <- sapply(num, is.numeric) ret <- num ret[idx] <- lapply(num[idx],round,digits=digits) ret } f.errs2str <- function(errs) { ## Purpose: convert list of errors into pretty strings ## ---------------------------------------------------------------------- ## Arguments: errs: estlist element errs ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 8 Oct 2009, 14:51 rv <- vector() for (lerr in errs) { rv <- c(rv, switch(lerr$err, normal = paste("N(",lerr$args$mean,",", lerr$args$sd,")", sep=""), set =, t = paste("t",lerr$args$df,sep=""), paste(lerr$err,"(",paste(f.round.numeric(lerr$args,2), collapse=","),")",sep=""))) } rv } f.procedures2str <- function(procs) { ## Purpose: convert procedures element in estlist to pretty data.frame ## ---------------------------------------------------------------------- ## Arguments: proc: estlist element procedures ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 8 Oct 2009, 14:57 rdf <- rep(" ",7) for (lproc in procs) { method <- if(is.null(lproc$args$method)) switch(lproc$estname, lm = 'lsq', "SM") else lproc$args$method cov <- switch(lproc$estname, ## lm.robust, rlm, lmrob: set default arguments lm.robust = list(cov = 'Default', cov.corrfact = 'empirical', cov.xwx = TRUE, cov.resid = 'trick', cov.hubercorr = TRUE, cov.dfcorr = 1), rlm = list(cov = 'Default', cov.corrfact = 'empirical', cov.xwx = FALSE, cov.resid = 'final', cov.hubercorr = TRUE, cov.dfcorr = 1), ## lmrob = list(cov = 'f.avar1', ## method .vcov.MM equals f.avar1 ## cov.resid = 'final'), lmrob = do.call('lmrob.control', ## get default arguments from lmrob.control lproc$args)[c('cov', 'cov.corrfact', 'cov.xwx', 'cov.resid', 'cov.hubercorr', 'cov.dfcorr')], if (is.null(lproc$args)) list(cov = 'Default') else lproc$args) if (is.null(lproc$args$psi)) { psi <- switch(lproc$estname, rlm =, lmrob = 'bisquare', lm.robust = { if (is.null(lproc$args$weight)) { if (is.null(lproc$args$weight2)) 'optimal' else lproc$args$weight2 } else lproc$args$weight[2] }, "NA") } else { psi <- lproc$args$psi ## test if tuning.psi is the default one if (!is.null(lproc$args$tuning.psi) && isTRUE(all.equal(lproc$args$tuning.psi, .Mpsi.tuning.default(psi)))) psi <- paste(psi, lproc$args$tuning.psi) } D.type <- switch(lproc$estname, lmrob.u =, lmrob = if (is.null(lproc$args$method) || lproc$args$method %in% c('SM', 'MM')) 'S' else 'D', lmrob.mar = if (is.null(lproc$args$type)) 'qE' else lproc$args$type, rlm = 'rlm', lm.robust = 'rob', lm = 'lm', 'NA') rdf <- rbind(rdf,c(lproc$estname, method, f.args2str(lproc$args), cov$cov, f.cov2str(cov), psi, D.type)) } colnames(rdf) <- c("Function", "Method", "Tuning", "Cov", "Cov.Tuning", "Psi", "D.type") if (NROW(rdf) == 2) t(rdf[-1,]) else rdf[-1,] } f.chop <- function(str,l=1) ## Purpose: chop string by l characters ## ---------------------------------------------------------------------- ## Arguments: str: string to chop ## l: number of characters to chop ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 8 Oct 2009, 15:19 substr(str,1,nchar(str)-l) fMpsi2str <- function(psi) { ## Purpose: make pretty M.psi and D.chi, etc. ## ---------------------------------------------------------------------- ## Arguments: M.psi: M.psi argument ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 8 Oct 2009, 15:28 if (is.null(psi)) psi else if (psi == "tukeyPsi1" || psi == "tukeyChi") "bisquare" else if (grepl("Psi1$",psi)) f.chop(psi,4) else if (grepl("Chi$",psi)) f.chop(psi,3) else psi } f.c.psi2str <- function(c.psi) { ## Purpose: make pretty tuning.psi and D.tuning.chi, etc. ## ---------------------------------------------------------------------- ## Arguments: c.psi: tuning.psi argument ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 8 Oct 2009, 15:34 if (is.null(c.psi)) return(NULL) round(as.numeric(c.psi),2) } f.args2str <- function(args) { ## Purpose: convert args element in procedures element of estlist ## to a pretty string ## ---------------------------------------------------------------------- ## Arguments: args: args element in procedures element of estlist ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 8 Oct 2009, 15:11 lst <- list() lst$psi <- if (!is.null(args$weight)) args$weight[2] else if (!is.null(args$weight2)) args$weight2 else args$psi lst$c.psi <- if (!is.null(args$efficiency)) round(f.eff2c.psi(args$efficiency, lst$psi),2) else f.c.psi2str(args$tuning.psi) if (!is.null(args$method) && grepl("D",args$method)) { lst$D <- if (!is.null(args$D.type)) args$D.type else NULL lst$tau <- args$tau } f..paste..list(lst) } f.cov2str <- function(args) { ## Purpose: convert cov part in args element in procedures element of ## estlist to a pretty string ## ---------------------------------------------------------------------- ## Arguments: args: args element in procedures element of estlist ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 8 Oct 2009, 15:39 lst <- list() if (!is.null(args$cov) && !args$cov %in% c('Default','f.avarwh')) lst$cov <- sub('^f\\.', '', args$cov) else { lst$hc <- args$cov.hubercorr lst$dfc <- args$cov.dfcorr lst$r <- args$cov.resid lst$rtau <- args$cov.corrfact lst$xwx <- args$cov.xwx } ## convert logical to numeric lst <- lapply(lst, function(x) if (is.logical(x)) as.numeric(x) else x) f..paste..list(lst) } f.procstr2id <- function(procstrs, fact = TRUE) { ## Purpose: create short identifiers of procstrs ## ---------------------------------------------------------------------- ## Arguments: procstrs: vector of procstrs ## fact: convert to factor or not ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 3 Nov 2009, 08:58 lst0 <- f.str2list(procstrs) r <- sapply(lst0, function(x) { paste(c(x$estname, if (is.null(x$args$method)) NULL else x$args$method, substr(c(x$args$psi,x$args$weight2, x$args$weight[2]), 1, 3)), collapse = '.') }) if (fact) ru <- unique(r) if (fact) factor(r, levels = ru, labels = ru) else r } f.splitstrs <- function(strs, split = '_', ...) { ## Purpose: split vector of strings by split and convert the list into ## a data.frame with columns type and id ## ---------------------------------------------------------------------- ## Arguments: strs: vector of strings ## split: character vector to use for splitting ## ...: arguments to strsplit, see ?strsplit ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 19 Oct 2009, 08:46 lstr <- strsplit(strs, split, ...) ldf <- t(as.data.frame(lstr)) rownames(ldf) <- NULL as.data.frame(ldf, stringsAsFactors = FALSE) } f.abind <- function(arr1,arr2, along = ndim) { ## Purpose: like abind, but less powerful ## ---------------------------------------------------------------------- ## Arguments: arr1, arr2: arrays to bind ## along: dimension along to bind to, ## defaults to last dimension ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 20 Oct 2009, 11:33 ## if along =! last dimension: permutate array ndim <- length(dim(arr1)) if (along != ndim) { arr1 <- aperm(arr1, perm = c((1:ndim)[-along],along)) arr2 <- aperm(arr2, perm = c((1:ndim)[-along],along)) } ldmn1 <- dimnames(arr1) ldmn2 <- dimnames(arr2) ld1 <- dim(arr1) ld2 <- dim(arr2) if (length(ld1) != length(ld2)) stop('f.abind: Dimensions must be identical') if (!identical(ldmn1[-ndim],ldmn2[-ndim])) stop('f.abind: Dimnames other than in the along dimension must match exactly') if (any(ldmn1[[ndim]] %in% ldmn2[[ndim]])) stop('f.abind: Dimnames in along dimension must be unique') ldmn3 <- ldmn1 ldmn3[[ndim]] <- c(ldmn1[[ndim]], ldmn2[[ndim]]) ld3 <- ld1 ld3[ndim] <- ld1[ndim] + ld2[ndim] ## build array arr3 <- array(c(arr1, arr2), dim = ld3, dimnames = ldmn3) ## permutate dimensions back if (along != ndim) { lperm <- 1:ndim lperm[along] <- ndim lperm[(along+1):ndim] <- along:(ndim-1) arr3 <- aperm(arr3, perm = lperm) } arr3 } f.abind.3 <- function(...) f.abind(..., along = 3) f.rename.level <- function(factor, from, to) { ## Purpose: rename level in a factor ## ---------------------------------------------------------------------- ## Arguments: factor: factor variable ## from: level to be changed ## to: value ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 18 Aug 2010, 14:45 levels(factor)[levels(factor) == from] <- to factor } ########################################################################### ## 2. main simulation functions ########################################################################### f.sim <- function(estlist, .combine = 'f.abind', .combine.2 = 'f.abind.3', ## hack for foreach silent = TRUE) { ## Purpose: perform simulation according to estlist entry ec ## ---------------------------------------------------------------------- ## Arguments: ec: estlist, list consisting of: ## - design: data frame of design ## - nrep: number of repetitions ## - errs: list of error distributions including arguments ## - err: name of error distribution ## - args: list of arguments (to be passed to do.call() ## - procedures: list of parameter configurations and ## procedures to call ## - estname: name of estimation procedure ## - args: arguments that define the call ## silent: silent argument to try ## ---------------------------------------------------------------------- ## Author: Werner Stahel / Manuel Koller, Date: 21 Aug 2008, 07:55 ## get designs ldd <- estlist$design use.intercept <- if(is.null(estlist$use.intercept)) TRUE else estlist$use.intercept nobs <- NROW(ldd) npar <- NCOL(ldd) + use.intercept nrep <- estlist$nrep nlerrs <- nobs*nrep ## initialize: lestlist <- estlist ## 'evaluate' estlist$procedure list lprocs <- c() for (i in 1:length(estlist$procedures)) { ## generate lprocstr (identification string) lprocs[i] <- estlist[['procedures']][[i]][['lprocstr']] <- f.list2str(estlist[['procedures']][[i]]) } ## find all error distributions lerrs <- unique(sapply(lestlist$errs, f.list2str)) ## walk estlist$output to create output column names vector ## store result into lnames, it is used in f.sim.process lnames <- c() for (i in 1:length(estlist$output)) { llnames <- estlist[['output']][[i]][['lnames']] <- eval(estlist[['output']][[i]][['names']]) lnames <- c(lnames, llnames) } ## get different psi functions lpsifuns <- unlist(unique(lt <- sapply(estlist$procedures, function(x) x$args$psi))) ## get entries without psi argument lrest <- sapply(lt, is.null) if (sum(lrest) > 0) lpsifuns <- c(lpsifuns, '__rest__') ## Walk error distributions res <- foreach(lerrlst = estlist$errs, .combine = .combine) %:% foreach(lpsifun = lpsifuns, .combine = .combine.2) %dopar% { ## filter for psi functions lidx <- if (lpsifun == '__rest__') lrest else unlist(sapply(estlist$procedures, function(x) !is.null(x$args$psi) && x$args$psi == lpsifun)) cat(f.errs2str(list(lerrlst)), lpsifun, " ") ## get function name and parameters lerrfun <- f.errname(lerrlst$err) lerrpar <- lerrlst$args lerrstr <- f.list2str(lerrlst) ## --- initialize array lres <- array(NA, dim=c(nrep, ## data dimension length(lnames), ## output type dimension sum(lidx), ## estimation functions and arguments dimension 1), ## error distributions dimension dimnames = list(Data = NULL, Type = lnames, Procstr = lprocs[lidx], Errstr = lerrstr)) ## set seed set.seed(estlist$seed) ## generate errors: seperately for each repetition lerrs <- c(sapply(1:nrep, function(x) do.call(lerrfun, c(n = nobs, lerrpar)))) ## if estlist$design has an attribute 'gen' ## then this function gen will generate designs ## and takes arguments: n, p, rep ## and returns the designs in a list if (is.function(attr(ldd, 'gen'))) { ldds <- attr(ldd, 'gen')(nobs, npar - use.intercept, nrep, lerrlst) } ## Walk repetitions for (lrep in 1:nrep) { if (lrep%%100 == 0) cat(" ", lrep) lerr <- lerrs[(1:nobs)+(lrep-1)*nobs] if (exists('ldds')) { ldd <- ldds[[lrep]] ## f.sim.reset.envirs() } ## Walk estimator configurations for (lproc in estlist$procedures[lidx]) { ## call estimating procedure lrr <- tryCatch(do.call(f.estname(lproc$estname), c(if(use.intercept) list(lerr ~ . , data = ldd) else list(lerr ~ . - 1, data = ldd), lproc$args)), error=function(e)e) ERR <- inherits(lrr, 'error') if (ERR && !silent) { print(lproc$lprocstr) print(lrr) } if (!silent && !converged(lrr)) { print(lproc$lprocstr) browser() ## <<< } ## check class: if procedure failed: if (ERR) next ## check convergence of estimator if (!converged(lrr)) next ## process output for (lov in estlist$output) { llnames <- lov$lnames ret <- tryCatch(lres[lrep,llnames,lproc$lprocstr,lerrstr] <- eval(lov$fun), error= function(e)e) if (!silent && inherits(ret, 'error')) { cat('Error', dQuote(ret$message), 'in repetition',lrep, '\n for:',llnames,'procstr:',lproc$lprocstr,'\n') browser() ## <<< print(lov$fun) print(try(eval(lov$fun))) } } } } ## print debug information if requested if (!silent) str(lres) lres } ## restore original order of lprocs res <- res[,,match(lprocs, dimnames(res)[[3]]),,drop=FALSE] ## set attributes attr(res, 'estlist') <- lestlist cat("\n") res } ########################################################################### ## build estlist ########################################################################### f.combine <- function(..., keep.list = FALSE) { ## Purpose: creates a list of all combinations of elements given as ## arguments, similar to expand.grid. ## Arguments can be named. ## If an argument is a list, then its elements are considered ## as fixed objects that should not be recombined. ## if keep.list = TRUE, these elements are combined ## as a list with argument. ## ---------------------------------------------------------------------- ## Arguments: collection of lists or vectors with argument names ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 7 Oct 2009, 11:13 ## convert arguments into a big list args <- list(...) ## if more than two arguments, call recursively if (length(args) > 2) lst <- do.call("f.combine", c(args[-1], list(keep.list=keep.list))) else { ## if just two arguments, create list of second argument ## if this is a list, then there's nothing to do if (!keep.list && is.list(args[[2]])) lst <- args[[2]] ## else convert to a list of one-elements lists with proper name else { lst <- list() for (lelem in args[[2]]) { llst <- list(lelem) if (!is.null(names(args)[2])) names(llst)[1] <- names(args)[2] lst <- c(lst, list(llst)) } } } ## ok, now we can add the first element to all elements of lst lst2 <- list() if (keep.list && is.list(args[[1]])) args[[1]] <- lapply(args[[1]], list) for (lelem in args[[1]]) { for (relem in lst) { llst <- c(lelem, relem) if (nchar(names(llst)[1]) == 0 && nchar(names(args)[1])>0) names(llst)[1] <- names(args)[1] lst2 <- c(lst2, list(llst)) } } lst2 } ## some fragments to build estlist ## errors .errs.normal.1 <- list(err = 'normal', args = list(mean = 0, sd = 1)) .errs.normal.2 <- list(err = 'normal', args = list(mean = 0, sd = 2)) .errs.t.13 <- list(err = 't', args = list(df = 13)) .errs.t.11 <- list(err = 't', args = list(df = 11)) .errs.t.10 <- list(err = 't', args = list(df = 10)) .errs.t.9 <- list(err = 't', args = list(df = 9)) .errs.t.8 <- list(err = 't', args = list(df = 8)) .errs.t.7 <- list(err = 't', args = list(df = 7)) .errs.t.5 <- list(err = 't', args = list(df = 5)) .errs.t.3 <- list(err = 't', args = list(df = 3)) .errs.t.1 <- list(err = 't', args = list(df = 1)) ## skewed t distribution .errs.skt.Inf.2 <- list(err = 'cskt', args = list(df = Inf, gamma = 2)) .errs.skt.5.2 <- list(err = 'cskt', args = list(df = 5, gamma = 2)) ## log normal distribution .errs.lnrm <- list(err = 'lnorm', args = list(meanlog = 0, sdlog = 0.6936944)) ## laplace distribution .errs.laplace <- list(err = 'laplace', args = list(location = 0, scale = 1/sqrt(2))) ## contaminated normal .errs.cnorm..1.0.10 <- list(err = 'cnorm', args = list(epsilon = 0.1, meanc = 0, sdc = sqrt(10))) .errs.cnorm..1.4.1 <- list(err = 'cnorm', args = list(epsilon = 0.1, meanc = 4, sdc = 1)) .errs.test <- list(.errs.normal.1 ,.errs.t.5 ,.errs.t.3 ,.errs.t.1 ) ## arguments .args.final <- f.combine(psi = c('optimal', 'bisquare', 'lqq', 'hampel'), seed = 0, max.it = 500, k.max = 2000, c(list(list(method = 'MM', cov = '.vcov.avar1')), list(list(method = 'MM', cov = '.vcov.w', start = 'lrr')), f.combine(method = c('SMD', 'SMDM'), cov = '.vcov.w', start = 'lrr'))) ## use fixInNamespace("lmrob.fit", "robustbase") ## insert: ## N = { ## tmp <- lmrob..M..fit(x = x/init$tau, y = y/init$tau, obj = ## init) ## tmp$qr <- NULL ## tmp ## }, ## .args.final <- f.combine(psi = c('optimal', 'bisquare', 'ggw', 'lqq'), ## seed = 0, ## max.it = 500, ## k.max = 2000, ## c(list(list(method = "SMDM", cov = '.vcov.w')), ## list(list(method = "SMDN", cov = '.vcov.w', ## start = 'lrr')))) ## standard for lmRob .args.bisquare.lmRob.0 <- list(## initial.alg = 'random', efficiency = 0.95 ,weight = c('bisquare', 'bisquare'), trace = FALSE ) .args.optimal.lmRob.0 <- list(## initial.alg = 'random', efficiency = 0.95 ,weight = c('optimal', 'optimal'), trace = FALSE) .procedures.final <- c(list(list(estname = 'lm')), f.combine(estname = 'lmrob.u', args = .args.final, keep.list = TRUE), f.combine(estname = 'lmrob.mar', args = f.combine(psi = 'bisquare', seed = 0, max.it = 500, k.max = 2000, cov = '.vcov.w', type = c('qT', 'qE')), keep.list = TRUE), f.combine(estname = 'lm.robust', args = list(.args.bisquare.lmRob.0, .args.optimal.lmRob.0), keep.list = TRUE)) ## output .output.sigma <- list(sigma = list( names = quote("sigma"), fun = quote(sigma(lrr)))) .output.beta <- list(beta = list( names = quote(paste('beta',1:npar,sep='_')), fun = quote(coef(lrr)))) .output.se <- list(se = list( names = quote(paste('se',1:npar,sep='_')), fun = quote(sqrt(diag(covariance.matrix(lrr)))))) .output.sumw <- list(sumw = list( names = quote("sumw"), fun = quote(sum(robustness.weights(lrr))))) .output.nnz <- list(nnz = list( names = quote("nnz"), fun = quote(sum(robustness.weights(lrr) < 1e-3)))) ########################################################################### ## simulation results processing functions ########################################################################### ## use apply to aggregate data ## use matplot(t(result)) to plot aggregated data f.apply <- function(res, items = dimnames(res)[[2]], FUN, ..., swap = FALSE) { ## Purpose: similar to apply, return data not as matrix, but ## as data.frame ## ---------------------------------------------------------------------- ## Arguments: res: simulation results array ## items: items to use in apply ## FUN: function to apply ## ...: additional arguments to FUN ## swap: if TRUE: swap first two columns ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 8 Oct 2009, 13:39 ## aggregate data lz <- apply(res[,items,,,drop=FALSE], 2:4, FUN, ...) ## if return object has four dimensions (multidim output of FUN) ## rotate first three dimensions if (length(dim(lz)) == 4 && swap) aperm(lz, perm=c(2,1,3,4)) else lz } f.dimnames2df <- function(arr, dm = dimnames(arr), page = TRUE, err.on.same.page = TRUE, value.col = ndim - 2, procstr.col = ndim - 1, errstr.col = ndim, procstr.id = TRUE, split = '_') { ## Purpose: create data frame from dimnames: ## len_1 .. len_100, cpr_1 .. cpr_100 ## will yield a data frame with column id from 1 .. 100 ## column type with cpr and len and columns procstr and errstr ## It is assumed, that the max number (100) is the same for all ## output value types ## ---------------------------------------------------------------------- ## Arguments: arr: 3 or more dim array (optional) ## dm: dimnames to be used ## page: add a column page to simplify plots ## err.on.same.page: whether all errs should be on the same ## page ## value.col: index of value column (set to NULL for none) ## the values in this column are split name_id ## and put into two columns in the data frame ## procstr.col: index of procedure column ## (both: or NULL for not to be converted) ## errstr.col: index of error string column ## procstr.id: create procstr id ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 19 Oct 2009, 08:41 if (!is.list(dm)) stop('f.dimnames2df: dm must be a list') ## remove 'NULL' dimensions dm <- dm[!sapply(dm,is.null)] ndim <- length(dm) if (ndim == 0) stop('f.dimnames2df: dimnames all null') ldims <- sapply(dm, length) ## split and convert types into data.frame if (!is.null(value.col)) { ldf <- f.splitstrs(dm[[value.col]], split = split) lid <- NCOL(ldf) == 2 if (lid) lids <- unique(as.numeric(ldf[,2])) ## convert ids into numeric ## we do not need to repeat over different types of values, only ids ldims[value.col] <- ldims[value.col] / length(unique(ldf[,1])) } ## merge into one large data.frame: for each distribution rdf <- list() for (ld in 1:ndim) { lname <- if (is.null(lname <- names(dm)[ld])) length(rdf)+1 else lname ltimes <- if (ld == ndim) 1 else prod(ldims[(ld+1):ndim]) leach <- if (ld == 1) 1 else prod(ldims[1:(ld-1)]) if (!is.null(value.col) && ld == value.col) { if (lid) rdf[[paste(lname,'Id')]] <- rep(lids,times=ltimes,each=leach) ## value ids ## no else: the values will be added in the a2df procedures } else if (!is.null(procstr.col) && ld == procstr.col) { ## convert procstrs to data.frame with pretty names lprdf <- data.frame(f.procedures2str(f.str2list(dm[[ld]])), Procstr = factor(dm[[ld]], levels = dm[[ld]], labels = dm[[ld]])) if (procstr.id) lprdf$PId <- f.procstr2id(dm[[ld]]) ## repeat lprdf <- if (ltimes == 1 && leach == 1) lprdf else apply(lprdf,2,rep,times=ltimes,each=leach) lprdf <- as.data.frame(lprdf, stringsAsFactors=FALSE) ## convert all into nice factors (with the original ordering) for (lk in colnames(lprdf)) { luniq <- unique(lprdf[[lk]]) lprdf[[lk]] <- factor(lprdf[[lk]], levels = luniq, labels = luniq) } rdf <- c(rdf, lprdf) } else if (!is.null(errstr.col) && ld == errstr.col) { ## convert errstrs to data.frame with pretty names ledf <- f.errs2str(f.str2list(dm[[ld]])) ## repeat and convert to factor with correct ordering rdf[[lname]] <- factor(rep(dm[[ld]],times=ltimes,each=leach), levels = dm[[ld]], labels = dm[[ld]]) rdf[['Error']] <- factor(rep(ledf,times=ltimes,each=leach), levels = ledf, labels = ledf) } else { ## no conversion necessary rdf[[lname]] <- rep(dm[[ld]],times=ltimes,each=leach) } } ## add page argument if (page && !is.null(procstr.col)) { ltpf <- if (!is.null(errstr.col) && !err.on.same.page) interaction(rdf[['Procstr']],rdf[['Error']]) else interaction(rdf[['Procstr']]) rdf[['Page']] <- as.numeric(factor(ltpf, unique(ltpf))) } rdf <- as.data.frame(rdf) if (!is.null(value.col)) attr(rdf, 'Types') <- unique(ldf[,1]) rdf } f.a2df.2 <- function(arr, dm = dimnames(arr), err.on.same.page = FALSE, ...) { ## Purpose: convert arr to data.frame ## uses f.dimnames2df and adds a column to contain the values ## if ndim == 4 and dimnames NULL: assumes first dimension is ## data dimension which is ignored by f.dimnames2df ## add counter ## ---------------------------------------------------------------------- ## Arguments: arr: array to convert ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 23 Oct 2009, 12:29 ## ndim == 2 ?? ndim <- length(dim(arr)) ## if ndim == 4: check if dimnames of dim 1 are NULL if (ndim == 4 && is.null(dm[[1]])) dm[[1]] <- 1:dim(arr)[1] rdf <- f.dimnames2df(dm=dm, ...) ## just add values for all 'Types', possibly including Type.ID if (ndim > 2) for (lvt in attr(rdf, 'Types')) { llvt <- if (is.null(rdf$Type.Id)) lvt else paste(lvt,unique(rdf$Type.Id),sep='_') rdf[[lvt]] <- as.vector(switch(ndim, stop('wrong number of dimensions'), ## 1 arr, ## 2 arr[llvt,,], ## 3 arr[,llvt,,])) ## 4 } else rdf$values <- as.vector(arr) rdf } f.dimnames2pc.df <- function(arr, dm = dimnames(arr), npcs = NCOL(estlist$design.predict), ...) { ## Purpose: create data frame to be used in plotting of pc components ## calls f.dimnames2df and adds an additional column for ## identifying the principal components ## ---------------------------------------------------------------------- ## Arguments: arr, dm: see f.dimnames.df ## npcs: number of principal components ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 23 Oct 2009, 11:51 if (missing(npcs) && !is.null(attr(estlist$design.predict, 'npcs'))) npcs <- attr(estlist$design.predict, 'npcs') ## convert into data.frame rdf <- f.dimnames2df(dm = dm, ...) ## calculate number of points per principal component npts <- (length(unique(rdf$Type.Id)) - 1) / npcs ## add new column pc rdf$PC <- 1 if (npcs > 1) for (li in 2:npcs) { lids <- (1:npts + npts*(li-1) + 1) rdf$PC[rdf$Type.Id %in% lids] <- li ## fixme: center is not repeated } rdf$PC <- factor(rdf$PC, levels = 1:npcs, labels = paste('PC',1:npcs,sep=' ')) rdf } f.a2pc.df <- function(arr, ...) { ## Purpose: convert arr to data.frame ## uses f.dimnames2pc.df and adds a column to contain the values ## ---------------------------------------------------------------------- ## Arguments: arr: array to convert ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 23 Oct 2009, 12:29 ## convert dimnames rdf <- f.dimnames2pc.df(arr, err.on.same.page = FALSE,...) ## add values for (lvt in attr(rdf, 'Types')) rdf[[lvt]] <- as.vector(arr[paste(lvt,unique(rdf$Type.Id),sep='_'),,]) ## repeat values: only PC_1 has center value, add it for other PCs ## build index idx <- 1:NROW(rdf) rpc <- as.character(rdf$PC) for (lerr in levels(rdf$Error)) { for (lprc in levels(rdf$Procstr)) { for (lpc in levels(rdf$PC)) { if (lpc == 'PC 1') next ## get first entry of this PC lmin <- min(which(rdf$Error == lerr & rdf$Procstr == lprc & rdf$PC == lpc)) ## where is this in idx? lwm <- min(which(lmin == idx)) ## get first entry of PC_1 lmin1 <- min(which(rdf$Error == lerr & rdf$Procstr == lprc & rdf$PC == 'PC 1')) ## update idx idx <- c(idx[1:(lwm-1)], lmin1, idx[lwm:length(idx)]) ## update PC column of result rpc <- c(rpc[1:(lwm-1)], lpc, rpc[lwm:length(rpc)]) } } } ## repeat centers rdf <- rdf[idx,] ## update PC column rdf$PC <- factor(rpc) ## return rdf } f.calculate <- function(expr,arr,dimname = as.character(expr)) { ## Purpose: calculate formula and return as conformable array ## ---------------------------------------------------------------------- ## Arguments: expr: expression to calculate (string is also ok) ## arr: array (from f.sim) ## dimname: name of the calculated dimension ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 9 Oct 2009, 10:15 if (!is.expression(expr)) expr <- as.expression(expr) lnams <- dimnames(arr)[[2]] lst <- list() for (lnam in lnams) expr <- gsub(paste(lnam,'\\b',sep=''), paste("arr[,",lnam,",,,drop=FALSE]",sep='"'), expr) r <- eval(parse(text = expr)) dimnames(r)[[2]] <- dimname r ## maybe use abind to merge the two arrays? } f.calculate.many <- function(expr, arr, dimname = dims, dims) { ## Purpose: calculate formula and abind into array ## supply expr as string with # symbols to be replaced ## dimname can also contain # symbols ## ---------------------------------------------------------------------- ## Arguments: same as f.calculate and ## dims: vector of items to replace # with ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 14 Oct 2009, 10:11 for (i in 1:length(dims)) { lexpr <- gsub("#",dims[i],expr) ldimname <- if (length(dimname) > 1) dimname[i] else gsub("#",dims[i],dimname) if (i == 1) rarr <- f.calculate(lexpr,arr,ldimname) else rarr <- abind(rarr, f.calculate(lexpr,arr,ldimname), along=2) } rarr } f.errs <- function(estlist, err, rep, gen = NULL, nobs, npar) { ## Purpose: generate and return errors of specified repetition ## or, if missing, all errors as a matrix ## ---------------------------------------------------------------------- ## Arguments: estlist: estlist ## err: error distribution (estlist$errs[1] for example) ## rep: desired repetition (optional) ## gen: function to generate designs (optional) ## nobs: nr. rows, npap: nr. predictors (both optional) ## --------------------------------------------------------------------- ## Author: Manuel Koller, Date: 13 Oct 2009, 11:21 nobs <- NROW(estlist$design) nrep <- estlist$nrep nlerrs <- nobs*nrep npred <- NROW(estlist$design.predict) ## get function name and parameters lerrfun <- f.errname(err$err) lerrpar <- err$args lerrstr <- f.list2str(err) ## set seed set.seed(estlist$seed) ## generate errors: seperately for each repetition lerrs <- c(sapply(1:nrep, function(x) do.call(lerrfun, c(n = nobs, lerrpar)))) ## lerrs <- do.call(lerrfun, c(n = nlerrs, lerrpar)) ## to get to the same seed state as f.sim(.default) ## generate also the additional errors ## calculate additional number of errors for (i in 1:length(estlist$output)) { if (!is.null(estlist[['output']][[i]][['nlerrs']])) nlerrs <- nlerrs + eval(estlist[['output']][[i]][['nlerrs']]) } if (length(lerrs) < nlerrs) nowhere <- do.call(lerrfun, c(n = nlerrs - length(lerrs), lerrpar)) ## generate designs if (!is.null(gen) && is.function(gen)) { ldds <- gen(nobs, npar, nrep, err) } ## return errors ret <- if (!missing(rep)) lerrs[1:nobs+(rep-1)*nobs] else matrix(lerrs, nobs) if (exists('ldds')) attr(ret, 'designs') <- if (!missing(rep)) ldds[[i]] else ldds ret } f.selection <- function(procstrs = dimnames(r.test)[[3]], what = c('estname', 'args.method', 'args.psi', 'args.tuning.psi', 'args.type', 'args.weight2', 'args.efficiency'), restr = '') { ## Purpose: get selection of results: first one of the specified estimates ## ---------------------------------------------------------------------- ## Arguments: procstrs: what is the selection ## what: named vector to use in grep ## restr: do not select estimators with procstr ## that match this regexp parameters ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 2 Nov 2009, 09:06 ## match restrictions lrestr <- -(lall <- 1:length(procstrs)) ## no restrictions if (!missing(restr)) { lrestr <- grep(restr, procstrs) if (length(lrestr) == 0) lrestr <- -lall procstrs <- procstrs[-lrestr] } ## procstr2list, but do not split into sublists lproclst <- f.str2list(procstrs, splitchar='_____') ## helper function: select only items that occur what tfun <- function(x) x[what] lproclst <- lapply(lproclst, tfun) ## convert back to string lprocstr <- sapply(lproclst, f.list2str) ## get all unique combinations and the first positions lidx <- match(unique(lprocstr), lprocstr) r <- procstrs[lidx] attr(r, 'idx') <- lall[-lrestr][lidx] r } f.get.current.dimnames <- function(i,dn,margin) { ## Purpose: get current dimnames in the margins of array ## we're applying on ## ---------------------------------------------------------------------- ## Arguments: i: counter ## dn: dimnames ## margin: margin argument to apply ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 16 Apr 2010, 10:44 ## pos <- integer(0) lcdn <- character(0) for (lm in margin) { ## get length of current margin llen <- length(dn[[lm]]) ## i modulo llen gives the current position in this dimension lpos <- (if (i > 0) i-1 else 0) %% llen + 1 ## update pos ## pos <- c(pos, lpos) ## update lcdn lcdn <- c(lcdn, dn[[lm]][lpos]) ## update i: subtract lpos and divide by llen i <- (i - lpos) / llen + 1 } lcdn } f.n <- Vectorize(function(design) { ## Purpose: get n obs of design ## ---------------------------------------------------------------------- ## Arguments: design: design to get n of ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 19 Apr 2010, 11:19 NROW(get(design)) }) f.p <- Vectorize(function(design) { ## Purpose: get p par of design ## ---------------------------------------------------------------------- ## Arguments: design: design to get p of ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 19 Apr 2010, 11:19 NCOL(get(design)) + 1 }) f.which.min <- function(x, nr = 1) { ## Purpose: get the indices of the minimal nr of observations ## ---------------------------------------------------------------------- ## Arguments: x: vector of values ## nr: number of indices to return ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 4 May 2010, 12:18 match(sort(x)[1:nr], x) } f.which.max <- function(x, nr = 1) f.which.min(-x, nr) ## f.get.scale <- function(procstr, proclst = f.str2list(procstr)) ## { ## ## Purpose: get scale estimate used for procstrs ## ## ---------------------------------------------------------------------- ## ## Arguments: procstr: procstrs (dimnames(r.test)[[3]]) as output by ## ## f.list2str() ## ## proclst: list of procedures, as in estlist$procedures ## ## ---------------------------------------------------------------------- ## ## Author: Manuel Koller, Date: 9 Sep 2010, 13:52 ## ret <- list() ## for (lproc in proclst) { ## if (lproc$estname == 'lm') { ## ## least squares ## ret <- c(ret, list(list(fun='f.lsq'))) ## } else { ## ## default (S-scale): ## fun <- 'lmrob.mscale' ## lidx <- names(lproc$args)[na.omit(match(c('psi', 'tuning.chi', 'seed'), ## names(lproc$args)))] ## if (!is.null(lproc$args$method) && ## substr(lproc$args$method,1,3) == 'SMD') { ## ## D-scale ## fun <- 'lmrob.dscale' ## lidx <- names(lproc$args)[na.omit(match(c('psi', 'tuning.psi'), ## names(lproc$args)))] ## } else if (lproc$estname == 'lmrob.mar' ### continue here ## ret <- c(ret, list(list(fun=fun, args=lproc$args[lidx]))) ## } ## }) ########################################################################### ## functions related to prediction ########################################################################### f.prediction.points <- function(design, type = c('pc', 'grid'), length.out = 4*NCOL(design), f = 0.5, direction = +1, max.pc = 5) { ## Purpose: generate prediction points for design ## generate four points along the second principal component ## in the center, 2 intermediate distances and long distance ## (from the center) ## ---------------------------------------------------------------------- ## Arguments: design: design matrix ## type: type of prediction points: grid / principal components ## length.out: approximate number of prediction points ## f: extend range by f (like extendrange()) ## direction: +1 or -1: which direction to go from the center ## max.pc: maximum number of principal components to use ## ---------------------------------------------------------------------- ## Author: Manuel Koller, Date: 9 Oct 2009, 16:48 ## match type argument type = match.arg(type) ## get ranges lrange <- apply(design, 2, range) ## extend range by f lrange <- data.frame(apply(lrange, 2, extendrange, f = f)) switch(type, pc = { ## calculate robust covariance matrix rob <- covMcd(design) ## and use it to calculate the principal components rpc <- princomp(covmat = rob$cov) ## get corner with maximum distance from rob$center lidx <- apply(abs(lrange - rob$center),2,which.max) lcr <- diag(as.matrix(lrange[lidx,])) ## create grid points: rdf <- rob$center ## for each principal component for (id in 1:min(NCOL(rpc$loadings),max.pc)) { ## calculate factor to reach each boundary lfct <- (lcr - rob$center) / rpc$loadings[,id] ## calculate distances to boundaries and take the minimal one lmin <- which.min(sapply(lfct, function(x) sum((rpc$loadings[,id] * x)^2))) ## create sequence of multiplicands lmult <- seq(0,lfct[lmin],length.out=length.out/NCOL(rpc$loadings)) rdf <- rbind(rdf, rep(rob$center,each=length(lmult)-1) + direction*lmult[-1] %*% t(rpc$loadings[,id])) } }, grid = { ## generate sequences for every dimension lval <- as.data.frame(apply(lrange,2,f.seq, length.out = round(length.out^(1/NCOL(design))) )) ## return if 1 dimension, otherwise create all combinations rdf <- if (NCOL(design) > 1) t(as.data.frame(do.call('f.combine', lval))) else lval }) rdf <- as.data.frame(rdf) rownames(rdf) <- NULL colnames(rdf) <- colnames(design) if (type == 'pc') attr(rdf, 'npcs') <- id rdf } ## ## plot with ## require(rgl) ## plot3d(design) ## points3d(f.prediction.points(design), col = 2) ## d.data <- data.frame(y = rnorm(10), x = 1:10) ## pred <- f.prediction.points(d.data[,-1,drop=FALSE]) ## obj <- f.lmrob.local(y ~ x, d.data) ## f.predict(obj, pred, interval = 'prediction') ## as.vector(t(cbind(rnorm(4), f.predict(obj, pred, interval = 'prediction')))) ## estlist for prediction: ## start with .output.test ## we only need sigma .output.prediction <- c(.output.sigma,.output.beta,.output.se,.output.sumw,.output.nnz) .output.prediction$predict <- list(names = quote({ npred <- NROW(estlist$design.predict) paste(c('fit', 'lwr', 'upr', 'se.fit', 'cpr'), rep(1:npred,each = 5), sep = '_')}), fun = quote({ lpr <- f.predict(lrr, estlist$design.predict, interval = 'prediction', se.fit = TRUE) ##, df = 16) lpr <- cbind(lpr$fit, lpr$se.fit) lqf <- f.errname(lerrlst$err, 'p') lcpr <- do.call(lqf, c(list(lpr[,'upr']), lerrpar)) - do.call(lqf, c(list(lpr[,'lwr']), lerrpar)) as.vector(t(cbind(lpr,lcpr)))})) .estlist.prediction <- list(design = dd, nrep = 200, errs = .errs.test, seed = 0, procedures = .procedures.final, design.predict = f.prediction.points(dd), output = .output.prediction, use.intercept = TRUE) ## predict confidence intervals instead of prediction intervals .estlist.confint <- .estlist.prediction .estlist.confint$output$predict$fun <- parse(text=gsub('prediction', 'confidence', deparse(.output.prediction$predict$fun))) ########################################################################### ## Generate designs - function ########################################################################### f.gen <- function(n, p, rep, err) { ## get function name and parameters lerrfun <- f.errname(err$err) lerrpar <- err$args ## generate random predictors ret <- lapply(1:rep, function(...) data.frame(matrix(do.call(lerrfun, c(n = n*p, lerrpar)), n, p))) attr(ret[[1]], 'gen') <- f.gen ret } .output.sigmaE <- list(sigmaE = list( names = quote("sigmaE"), fun = quote({ ## estimate scale using current scale estimate. ## this amounts to recalculating the estimate ## with just an intercept llargs <- lproc$args llestname <- lproc$estname ## save time and just calculate S-estimate and no covariance matrix if (grepl('^lmrob', llestname)) { llestname <- 'lmrob' llargs$cov <- 'none' llargs$envir <- NULL ## drop envir argument if (llargs$method %in% c('MM', 'SM')) llargs$method <- 'S' if (grepl('M$', llargs$method)) llargs$method <- f.chop(llargs$method) } else if (lproc$estname == 'lm.robust') { llargs$estim <- 'Initial' } llrr <- tryCatch(do.call(f.estname(lproc$estname), c(list(lerr ~ 1), llargs)), error = function(e)e) ## check class: if procedure failed: class == 'try-error' if (inherits(llrr, 'error')) NA ## check convergence of estimator else if (lproc$estname != 'lm.robust' && !converged(llrr)) NA else sigma(llrr) }))) robustbase/inst/doc/aggr_results.Rdata0000644000176200001440000167431512321016053017635 0ustar liggesusersXIM1bBEńHƄ0`E@b΢(DPtsD]s^wg陞0it\\\<\/O>kmpolbeݷ~G~?T_O^6 L,aW_F$~09!>s؄qM= c/>m =wPjMC=#X֭'U-#yT /ӆ_ˌ};.?C_\ u MtkSO5>rTHv+P}x@㰡6i7OԔ>GG,%!) w<'C㥖L{Q=jo4 Ih0Wq)0cyL a" 9}u@SQJ|0R41QHXOcg%a&rġSҒxⰶ-uן~fhadgDg/g%Q]/r?._3ӏUSh,bzu'{+N׫hr1OjąV EBIzYF|ICmEM:=&2u5u5O*JJ̓#gk0b iii# Mmתi9O_?>u(2_#yO#%AqJ[':cMϲ=/9f6I?gsLz&I?gsLʤ39?/ BOvƿ6sV1gvsv1g?rDE z:Mk)PUJ7kWL/i>k%i~rq4tre?/.aRKri*HHKK+(KJϕKy׿tQvr*bR3ha"_=ljizCzN ibbF%)m4apOla 졞?%.BBAB!ф'N!F(F8PPPPPPPP󷜿-krr?]}e@doՅZP=bȠC׼ Aʃ "SY1݌vP!i#P5rkv!+%@/voB7,=iNyA:,waM7j/Y^Y{P!.mJ{@dmcVUO}GfʥW?h/bӬ&x~{w>,;>$׎x嬊94Y1Y!(rcnmjoBŴG}jBYM(dd>Qz#Y!yV({pb4|Qr@pԄA~PyQ8b Nm d?C;rAZ^ʾ'+Sv1pqY>e?__ 6/Ȟ' y.HOtXDCeT(̷O<SWO4Y~TkGVHP*;YU{xVe#j>!|-!g)MB/O|?U,l v9Py;d9oO|5!?j2"&UP`W_r!T_`*NvTTS} rV޸%buYiݦ/q\>ӠbӬmzUs#||.(3+: ODY;sPcH%z7a֭.PNY#*V:Gk߾si؅,17h0?"f"'Y9K+*W}b ,/X4kw*Tiؒ5|<#tNdd|X2Jjki+q /x~Nm{(gJ-qdn>0 9Pp픣r^ZPiw@KweM,y*:掳 ]5[f(!+Uv*;Tvꌁ7̷Kz'ϧ;@MKMD$}YO}2hHcvǟj+tDV2 Q_Uvi/ȊGM,V91Gi5APmaO8h/ooe{AM'p#Adn͚~ E_5JC;OS.[/`"/ձ+=L:f!Cy')"vcPݞrՆ 7<\麹(J)<)wP8T3r%?^)r$ktS.G*'\9GX5wh˾DV *uSBͬgVxlFV8 Xd{5j_~eW. / 7/޻Wd%Z̒=StPxd5IP9P|r+EP],jðwC22ZmnPΘKȊ9Co 0HMdybnxao _`P 3) 5)CCgG`grwX*5xjY/+SBVz蘽 *Kd.ߧas'doBbG?7y߯ׄ/@LԋfP=JKO}yWndeQK~|ٶ8뛷&Tb&iްcPx?/\#fCM]s[Ʋ;?3d0#av֥V0YS/ꦛ9-]{7rT3} Oثqߖv`PqS8>EOOgZgUKBg5P)m̭5䊿q /hrP9:0gP?ٲ3r3j7uߗ$O`%=O{3]=GvD<>dz%Y/)qPeZr6#YϜ.=s`}P5h#qK RRS9+U[QUλ?o۝s?%4"ԛ̜z^3\1 f5HE^'z ɴJHK8_, 7O=ѣ(,2xQcZ$|7ZLz5f}F:;@v֋8_-;ꥐCsS6,1_U~*^n?̅B7f3 VKGhI|;k*1vOnE~o~RJXn( sV<|&X|Ї`]3r=ļi~whf)ŰTF)8u[qbo{3$5<٬80; ѱ(gʱŃ=7 FI@e($pw8Y}Ku@@HpI|`Usu`=>2DYmw`/o**oΖĩ6!pcYv a:4Yrq|`?qOc_|lr(^2\qοs\P l x2b~Y"7<'2avd: t׺Xr6v2i>ea[N[vt-Efk ZHFvqr+>!}?y} KwZCPXK;!nƀ#;YiHJ~gLuʧT8iZ]h 0l88MlBە>w*H-^\^ q3]tKFp t, " LrbGe4@2y:$V#g殈Hqv9]A䚳Ҽn -=i !2 #!}"QH[c2^}Ao/SR32>^ Q,*CB\T Hw[[?k*wn><:Z$?iopEkCQad+y]%]e,?Q^!u쇐2ɶd~ߩl4$Mx6igWtUr/6lVI6#5]sj_`EzV''S0 eae6 Ar|Bv1PlZcG+2ʿFz#'>}g6پ@buضLIzlt4+rY 8-8qH Ʒϼ>8g j=_O}# yl=vv;ݐ>^nl . ȋN-aϑ+l_oɹ{S>g~jG~P-<"|=ezo+_5FKgwrAܴBo4*\HL .?fP9?,ߣj\žHiOY~P /Q_!ŪK?Q*,]i{29?ue,ٯs9JdZ#=?4!)!jW$P(e7||w쐄GmC;+{}}oO7ye^Lno3=/?H4"t.wyorwy{- 3T9}S:e_wzȑo}O!eGzؕ;!\Lu[н>&C`hjB]Q෤`íWA&Y g}Y1<#=bɵ5c!|Nm9\m%1"JB8#jev_[8ӗ)vK3=8 ҮA "<1#GG?%x5]/J_ۭӗќ-9LVc5 }yHoJնpe;y辧ol/BS>7MY`:ӓ6i]k0_ YܱP -pzNJs]g*A9|tTPoQbdA^po]ȆҮ7y%"6"egFU"ӭ!Oe!l_ytE\s_D'ײ~`z<26=,>vȵvdjѥFٙ^v2l\2z 9Ѱ5کt|]?yqFc/6Ce|pzHMzGo`m-+@v6 #beڶ?h7fF.i/2b tf9Oĕn8%P4>t̻"4\qtlk4:e34{lҸީCr @6??\2iOĝaZY /Mwo:.ׁlnܬ *:&V 9ݱoדs1woNqm4lϿSr;A0ı.;v5ڑl[l}FlVdITTd{'~01ףV$7Bm$Bٺ{Ac?a{kĐ˴JJ!nr"=ro q$NadMB Z4% [?ZGxIƘmW-/;ކF{x7<%'hăom@®@Ɇ-3#$#2κvVCFώ3_{2ASTe!2iwp)do!#%*5swG&7UUO=,D9x⢹ARuuQ'3bW+dkk#$߷,ၮ(ΩrhvyqȤ:RO~Cf.lvYLiq83{je{߸tH:h3dx6 [i Vjv@mkLӺ0n12Um>N?p_8qiK/Mz?4zC;V,TVjC򫯭/+ _+PhEF7[!5ڀ dHݛo#%.#+r_CPQyn( 7/ . E5:P\$N\(^Sg $y܀$gcɑݟ /kL2{9dA3,Qw֌dM2}a a̴իT!ʂِ\rn2|H15}׼q dV‚A׆  }5t؅i,L)"3,d,AszJhGY7mKAjJL=dO;1 26-g ogn2)eVOJ0g+=PL8>(a'U'?\:?v*RR0e iHҎi* IF/=X>O¢&Z!Y_N{̊ }QdҀEwr5zh+4*5X.R#b%2%7V}`_0 $H It$8ģrp=T_8CƴmPkzt\d}}G{t[|adC]S>WfƽvDw6l|dӪĞCwXӡ>OPe>[ *BkKBа{!OzXf:8]E0m&镵n>D6iހl|zҤBd _ʺ.@ ^l]ĂWLw; _}TT}B.tfMHB*ݟP~e Zm|-p>VJgmK >߾Ou w^ҸiZHyfA?v]߮څ ty Shv/ V]XuAqO_ W9|[ l0UP|Yuy}2VkLGַlxh0Ȧ}D#~De1P~xX:UuB)׸(%ez8pzEd/A&M~ 7zX"m}l9zhd9ˁw"[3vΕC6׊. ZHm,VnShoZ^O8,"A7ȔiB)g/"t.Eo6S=4[{""1V $7Dj): b~D ͳeSo&W@\熮TaB#O ӭlVL߭mLцg2Qc edկ#SY ӎڼ 9R]^HIq'ib4!;R;vYǔ96 ˗ܩe(K_kYYuKR8WAw,&VAOR( %;$T`((?"WH}adfj2ռJ"WCG&~/LVo~R7JɒVWL6 hPxX22M%)u$_sg-Hue7Mfb97$}[},2[-hldq/+MȬEKE!~#4hZ5d.#3,NԎ>yZ!HKt(f.k%N>-c^ULz<ָH4'Gҹlaφ"s6/^dťT]Χ"SԌKA'Nj7VOIcw-83Ҽ^@z[$2n9cdo7Sg!dí[yOӗF.1am,)r- )nʖwGP?r@ŻClBvW VݻSl-һhEU١Hkψ:#P 2įps}Vutp2#5O۲ x@ƨ}݃t,&ݏt?a;gvsd٪.!+lD/N iOHF}>G1Y<Ïz Z>DfNy[q, L]OW*D[,|lvOsd3q2P,z,?|>R#ţl8LP=~(uUˌ_εȐo")dX_ 9dlS:dge; .Qp5wgnȔ.Cз>C b}ADQu.( :ĻB!Y?Z#w82nӒ0diIQCduL!Sd|ߺ"sޭo7ݸS`IO5@c{W8bAÀuD8 +xSf%\N8n< 2PH#F˥ Yw i&XvxX^&=(qHT ^ `_~T!'~abzh)=+]w#ùg=E?7oY!SOEtʗLF~Zx[tpUOI7ROlWC39R4E-i{iuH?KGF72Xd ǑZKDvz<<"!,+o൑۽ "V#^;95 jk;~c5`ŠSϐo>?g.9}{LdT/ ,P!2ˡtkӧzu/=$ ]L̻kLڕu$}2I!|۠ȄQ VL݈Ot}u<2.;37H6nQHJ/! _H.nV|*92REȔ= Jd 27I( .6G& 9dr%_ 98HHsaC4M\Rv=dOS4NA)<~2.LE%4Y\Af -99 Sb[wwGn.ۑLLOm<b]s[HxhK;>9oA&.){"yj$KRgiHLo^u kOgc~zahSl?ZFgR2Ѵ7H㫄裃t3"\5QkᖷD ;NӞxdY(1--UtɈ~+&Ry$DW)_ֳwgB& *s{ZL|dCV8ֻg!YV7Lg#Əx`Sh_ ;ε AfCH]]WST$BqS;)|?d[ d7>aq9r$·o7I" Z#YdrB&INn1?f >p鰅7־7qqsâ9޺qJjRd  sFW@bqİArdnQdىȌY!ip86 2fGAԀhvށyYm02)K ꋤaB^!N)AFZ|@dV !/Ȩe/##/0X'"^H xvX]Muxڎ*qi'dʗ*H֕4{cjIE4Ј C&6ZC֚ V X_9>% XTN zٍWvt㡼մ4ʑIoFN^7Av/H֌I{NCƭ~F>%[d^KNHVZg֯}?ɀA]u!1R|02GI-s2:udNżȄwfRY-?1ZvޅG&λ>)x2?ːP%rh0gQJ~\=W uy5/{O?"_{G8`5YSoq)יޟt?rs{F/r.84~_Ag޺*G9~ 1ƁP_v_^cCc. ?~/.3Uh}SR^y⸏g{-5UE vV?/ڹ|㮴#g>Z=]="ǗX{sS唳8i߮XLo{ÙOѹ{*wًln굝8]!q\ya_vڵ&߯/q+)M^< *띎[zF_kG،+8GJWz 12[]>ZO˙^= Ï#g*rNtF]η^5uAˑ-?n 匳 Q:zϣ_M5= ^$#rN ~r ?lVݦ׆Vepů*>wS C==v;S|"N Nkz4zMOZ?t`q>a3} 1}\ l]NϜg^O'^؞kũglܗ4kq>8%.w\$MAu '*qգ\ j9Xz;_~3n)kEt~7ڧZ [5sO߽V n];U 匁O@92oM``ܥ8X/{%w=󪍃 }OMWE&rAA~UcDԟ2?  *2aNѵQΆ=s3n@qN'$;C9lb[htN6=}]\||:4 uoQ9䷮_}Ar)),,sr3>Tf% Ԟ;.aT/j.z\mx*GF' :W\= ' \9VլlVÓZBT-4 Nq  l 3]cYA6Cq҂2qՋ3`OWC>Q.dFXGhyU!367 D܀l.]-L+mgIhv 9)W oyMy{-U28 Zo~<> ]u3/Cns}ԉ`˵I.%#C쀹Ǡ +ˎA˰GseяreWws `h_{ٯ9}m15d_ ? \.xo?7ѶX-! .ꋯ+wZʼnԮfpٷ.7p^@jZ}Ǣ< BPwnF.l nOKzw0no <ǮNf.IരKB5&p#]ЦGNRnZb-wv̀GbDB[rugK|\I{zq$gLg>7#b}RB#g1ǟe ?{x?|Z/'CC^Jnžv&=FwDwKs‰o^ DH?'5ϟպ z-\$tg%`k"OC}sCE/gq ;'O.aDb_ j H>~6>>3~[y 4m̸ot/q= ]wھ>Ϻ=H۝==GǑϻWg \H퉾#czL ۃ])  o[A8gcW~z!hP~^gT/PGE?jGAY<zD|jT_P:}?#c{RO}"Vc*'͟S?LmXs=s4q?GS&jU!'O2ԾiPBr'zGۓ/OO1OZNZnf4 ۉ^Oӡ&OMn~+#ϋ'[byL?J/bDi>=hvg&a?Ek?-7_W1ꗞEEҋ?Pi?DꇖK>EO.9{La/)CZnzԟE$z$~I("777ھ$ ިL=%~5C{X~CT~,Gjz~Oz QZ_4q駩SRy>@cjssi܀~G퐒K?~ǗU<^SXt[mZӑf-O%j831oyBZX$nq/5mo/%/}zwGoz'1zL%rbMDG Gkt3FP 'kݱ&mw1C}Fg=%Qn̟5ghH/CqE&)MOZ$A;/Qf\NtZ>g~q?_F)i?W)qKX.;~W_Kr|13c~..T.Z/'Ĭ7z%>h1̇'>81HG!3N7bϰbğLuƛy&{Gr_HOzً3ەiGCP/d΋1rtzc7|˜z$rH}Mc~q|S4#AHǓz#/No7N @kXįHχt_8AIF4Jz_4ߘ? 1d\CC50'rD}?끖2ytJ}&u$ 'wfF!Zh91DvcH<@|WiE1Gaqg*=X!uty8}T>rΗq|0|ɧ WLǷTމ<1?QۋC1si;R8C~*ӞyOs/ATKɘhxh~'iH: VD;A= 3߅+ZX?N?'|<8Ү0 8R//;C~JGꅶ;./O_!4?Ӹ: &~q73^8˘a3M y;Geίu< s~9ÌxY^'֫džcu및('3>03dΓ0Mexo0όyhZ>J|:0wz1yNqs}qcb}1Df\6C1.d;q*L}aQaȍO2-yrS Gq1C#)|;t\72獱 ;3쨷u&>-?,9OȔ[8/d<#c<[ud~h!i2J*',3AʓA}&)o.ʹ#<HzK$^L?::./A3gv!yPH!KYlH%HZwwid3f$WsH?Xz6k֝P.5hE&Lbi?J_,N,gi\~;TW-H30 g3#=A4/]I\Gg:GI ]_4c4Nq L,z"?GDP,TS"G,NDŽ$L"Kҟ?? Y2YDoh{x+'bt]G\:~-;ZB{h~?%c+O`7+oi{o,ǢIyIkk~p 񧴽踙'qcc_ oB qgu+b43zo'3_9$f7sFvBRz+"|\'̫PHܙG>+$)$"bE_)&qT1ߢ:b ~,mo(AI2J/?, 8YHGO;L!)W IAIY@<NL?ʐgw9A4~%c ٧H^rA2id2O&zEh='>C%ğ8#9ݳxOʛOJ?#A,"]4NF+'i:r1-zRd:㧚L&O='\AǕxH9|O+!~AC 'KXD_H,ҞoѸ77N%!~]Zo餜8%E3OK|<^ȸ(ݯL)7Dހnq>8zL=oc:?OZ/2~k8LG夤t3O$*7&ٳ_' ?f\Nc4.24_B}8~qywrD.{G} ݞۓ#~4>cĽ `\ŌIyp_ig,7Z~\G#vKc{ho/[q1">\~4tGkqc_"͏izFcjLBڇފ~ĥ>K<$$u%Y$N%oU>H|SM*TUM柪\U$έ ('b9w0c,!QJ/#[Fr+h.'U7ML2WOZꞝxA9Gʈ_*!Pwi\D[1R?DoK:i YB/d^R!DdޮYd=CJ'zNʓN1ĥt^ޏq 4&2-Wq iAI|O-鸆_}"H1n'_dTDqP*!zZBb1+ r0 I80xƝiyhEi=d82KrVdm“3Yo"zI3HLYń4NzUN_Njt[I+߬$zXNQA$RQN22M-Myn!Y)$u!;GL'D Q(q7c~)@(_~7Ɠ?t_OA%q3={u z?Oߛ 4n={ޟ=~??J杂ɼ}@欤ϞvB/Oi\MBڟVğ3Wzi}oxܸ-|1Aq ͏'2cގoc8A3"Ki}i4 gJ@t1/?K R^Zr1+c;ccgw@ۑ3} zcIj8p|σ?o_ =~;%D?hjy%R=Sz|OciVnii8K9~OyIw+wZ<2CjϵjFۑI޻}4CU}oDzs?%m(0נD )2͟)s^'z✗|<~wJx&'< sޘggTh܅$M:OI2EO䢤8ߴ/~,D|_Γ}&zW2@3(s}OP?ߍvDR=bC@풾|o] 2f͟^!=@?=-?JwSi~m?jL;fԿtz|?Jۉqr3~b~B셎hS?\W~ܟGY?11'b|G~vD;t|N*u!wz{wɘ)uЏR=ƺ0oِcGw]1Oy9?8gcQ?JD~GarQ{zF27bzPyiL=]=IZ/&>Q0'7>W>iyThAubJIh~?`Z =y:?F(tݏJ7/T>lO߄#{^}=N ɗNz@`O4~s,c4ߓ~["~[A4D8F;c*7`t]<O35b$矫Or0CFC#q}]jWTqU>{t_1]t?{~T^臭t7P̛ӸT?hS}~3(cR~~wە&~/J~yHAg{4O%'}$_IhT'Ej[ux&[; Qe~;/~ s#X_t"?>vjWr%xi~d_ s {74"qf,/o^2։{t_Q?J^=~/1/I>Oz7NH p?X_~P{*==`1,0PGq4O:+ vB~ (}n? ?zoC(ۣcGK_~ÿxq3}5ksYɒˏkcu& h&#ޥȟJ9q.kICmrw^ sW62I>2|4thHKHQHoIO֟k1nrX[XWkxam '~'v_g}=@?ѫ<#aC=c{TrCF{JJ0NIsJ*YΫ9j.UT?zԟOH>F>@_~=@(UunC4ÆZh˴Mϰ~F%tOgǏjL#|jdS~ko '5 Eu~#zsiHnxɏNwPZC0z;ldO(5?k`9jlҋ4aǿ2 *̿{܇<OQ #v;BMÆѿ$>QSXVB~Ish2_+=?_~? Z2GLI48&qL:f w/&VwEN;s895뀦D?ahbyQEÆRg!y_axT#X I?cZF~<;Ns2#]fk;yCyi$1}08Nu$@gY/L&29LzIτޟ29Lz Ws&=EAqw?c??c? ?~OnChQOٽ c-E v_IfreP hq E N##I(N(A(I(E(M(C(K([r59Nnظ@mAPta2ԿR{/j וֹ%9!Ț1F/fD _!`:Aߠ:kf@V1M!PLDPԟŎ'>l$t6dI;ڛZ@}aCӑM6PV½x#&}znP%NXWY:k]dղP~bhUXքlX}4kjގ ,G6g _/6eCġ}ay?n#躻!lwxYw{PΕӔ6bTSHn_J]% '>_tYiコ,R1ښ~B lXOItoFe\ŚÑ+h[4`fbHEx9^u/7&8(9QZ)q\){{ѪqȖJſ|_rTdKک"l?[-.dOGhMI{:ZT}]-o#NL߁l*(, K M<KV b@|6;oXdO_RKuW؈omck 6 ӝ]}͕/[-bTz@SS,\xAאm[- m*z*м9J/|\Q*`wdl1|{%g\ *P7U vD%rٛ"aJhdS.MBSؔjhΰjMrPIJ;Oc멼s _R*qqTa9|eY#<ߟX׬N![r%C]^\{ن"P\4pA!_M[ a?WS,eJcQ&qXPo5t !:Pob83˳zJ3|1> ,hBzIri?yߦCCH 6I 4fm?ڥG,jB\neؿ-1sZ8ҿZ7y_mVǮOHoɮ0WZj6uÑ:EUٹкr8+ %(I-RSHcҶAJrr/iҠIϧF]HX;+% ·V\wb=@y; k2yw~B**,&Jts^6vv+Q9қ'iZj@W|OcSeS+[?,xNˊ+qxx}Ś-㻓Gzs5ZH$]#i^-4/X5b'~}y,F:ߎ1NC \C o_Y-<BZw 0w15;>(EeCڹ N;V]Q*:Oiu>}k'_zn`NS32e5mEz ͵p}GOqH_ OA>TK^. ~V DKWIp~G̯JOD:jDGޛb Vo&אַc΁oVq0Lbٷ#F߅m|g B7[okRg?o+Ex}%t0'Y dPS1ɺaf-6F/;;Csa# ͬeX;(? AxSIzCfgI(T4{rR߰)|]1ιJOd._wMz\vٔWc*%s^'q'/[uXwj颮`]S7n*߁$% |U!{!]Ď@"komu6H<{bVg=2U\0 $0I/cy>_!{҅RT8$4kP m983®ywH{6˚0`Pqc72uNߐVyfAzG&C!̞sѸ7A[ׁf7ߩQ :!y xa@8ϯ3"C_!C{V+}J^"}>L7:vܪg6LͫTYCЦO%OV#>w  .}A7]ym?N5݃r7'ڎ,yqV, 3"j#3|YvJ2_oPR@&[8  y"2 Ek ]!ދ9o^Ct!Px#hgd4IWVя;˗GC74(ϴݷ>%;^@wLؐ5Vk"_{=K( %>cjŔ2O WGڢElU|KJGlZu]IXJ;%Ncϖ3Dxm#dnL7ո7!vHVճFփ~" uj8dl9!q&Hv3L2# :R=g93/?5{rVSE>\)$~u;a4$Z42uD mɳ}WXVB)[ ėE.Jv}X%tMM)HOVS[ "&qrW-$e:iH/M]=gyc4'15ve,~ Rz? o<۟a#.&iPfm"G@"Z:F'2 a͜U5޿-wyCp翘7NC9n0|Ȫqtՠ 9ғʬ[tOn8{˾wVoԊKCY:ҰYۿ)Y/7c%dS΍/Hadi܂1=4;y vhzne.A؈özݻ -i!|\lTUH >l{Wxtmnqqˁw!W9_lp{\eUe!ME QlA7qdJ Ohp6geQN;/B87Mܾ{:Sd䗱=c`<&+wڟH {4([đOˡY-tX(=!I7#k)EI_d#)s{JSqq?d}͏bK-LG6}ٲ}- [wX Wψ/M^B{dַo-hS<"4 ~)e"۹KY@,pm~E@Kx>_>%VCow,axӷ% ϕ:AC6N7dݐRghE6f_CuG+<>S+z nzW81s2urhx9JEE-ly5azdSQUFU#4- ޥv#lrucKT=fh3l+4.. (aS\iя '~л_,cݪFHo)!5c}E JHoIOn#ۧs/.@z߷H8y6W߲"ۡet 'v|X^7B>^o˚v?0D\S|fCӊ#'7-Sb?ҴwQ4TYӾ2}8s^Mg:%={Oۜ%u-?&:PdHkhι;ߐ= YA,ݱ}4TLC "д+?y !,[B]| |& l\4Eox$2m} RDp2v @tݥ;jk=2!İC"#󄆵v89#,Ꮖ 慂 qJ#l. e#O ,V>#*~s{uGFdSq"}wW;g CvYU-!2l}+R/!7dl x7 :EȐ8%מ_/KSA|1cdh?\ CǞ.өz/P;1h_mWy" 4 {?&Y-ʀM衯yk7ෛ{F>HKjz Y*rG!= H@ԥsu1Tqh5nG"dMR1#.o#:\ PgۉjuRV6YlyRh5t'#K4ؼr#]E9'mz3j(,>rzdl@=d*5ڃ_x B>Pjᄂ yO (]ђ潭mlh2I0`wͽ!˧C6nY9 OYd=YA~KI~>D6I9*c7N6%}WC}V_s_= vzNS=4<^lt}'ƮޛOF6}MvٸqKjfݰ '4N["=omȦbAצ++kSueAJ}ϊ9F3xV;}TcȎy@v93l\' (A^##;>5[PB׬}7v}vľP,_ |2 Zԇf Mc$ ?OS;lZ( |Sc>-4.D6;/{g&dbi֭oZbSjy܌.',7攖SQk\'' wˑŮ-Yiu=${r_nL^lo||kE®,ndz9/]{Ƕ>Gn{ڕ]*ٟU~s=lWp/%G6خ{L1.0inJf?wPo=ѸD( R BǞp\zCf"E^V.8nlj̏lܱQI3E9޿nJ_V.W#RLrG?cs= [~תx4s`[~{ȏVvWK޾NuruHgcه%EzxWwXZH̐~5Yw& 'sNy)-MH]' n: .3(Rʸ`⠔SY<:"ǩ.(-!Pby%2@t6ydpȩ.\`'kY=Bod7d؆#K4z9pD]T'_cc7ANAJrχW3"?!u)_2m֒]HVʅՐ[EdMh<[^s6'tit`M aeH\zV~x F A K_6nf ʐ~U:?>!}'tlQ| sYs"% UA+h#CdO`?' PTF+wJvByvGD.KHxb{bΡwPUW*k!mZ]Ց ^t"CbwW!C-L SJغx (F*aEWSANB]2Af=g9萆N4_t涑wa)dp. ă C}׽_3jL!kRU!uriêŧꭦ VJ @7 h/~H*B}| uO6EkYoL'deg#&l~=y.pLvy4(P[ >y%(O_:ń5rm!vȂfqBW1^BfȂ0+'&"K^9,0"h<\dq~ gg>EB@7?"Wok&.%ZL~Ȥᳵg^\2<깱^5/%3dAsE!ƤӆD Y13C<h:P]d":rr%=^鵿t72w6#`dO7#Df\Zm̶?.Bx=2gqZsȞqE1r/d+6kAX>1 u3VƊHǝJm^o j\Ga {k/;g=,:mڎa<`vODz 7,چ0yhHgwi[?!aZ|B IgJ"/Q;:RJ2ۅ7ej>A A L7¡d~ לth{OweښS#w+!CIuڟg%qA@!1a(2TDp0wx{ 7afu\ ]'Mewa/X Kg#"~{9[n 2dl(2!WvJd({2ȤD#=;_vS]RT/`γb=al)>H`mdF}Ȃͅ!O2=DZǷĺ"K^?j)d{ bA[1Ppv0չP&r7"-ۏҜ$M} Ğ.7qO!d|e6ȤG_G&LA&OZⱒKx--dQőYi{WA,V?MYo?7+HQɒLƼ]2zSk{5ޏHEN=I0m2o)wٱғ#\RҲY R'+~@\<,7UEBJJqe'!'Z) z|/Fz_1I4PzqUdQ!xrH+pY[qecGe!d\kN44YxЁn6l7mtY dʫ֌@ƦV6KB,WvA&.}qRs8dުd܉ڥ4x /SqYGH|čB︃ }CV *+EQ’},%_>c쫾M"mfϑlcU2@g }4U{¦YE,Xwi9ҧV#3QJ%_!zq4ɪWs!f5$!_Yyd ;72pqcuJm"#CMU_@~y#[鯺DdUNFzKouk aYp(pS~:pXX2,eI;Q L> T I FF} Qv6QS:s25A g >‚:[v+ m̜/wBȕGz3 41*HoѳLB^W1g#籒}d#2L^m3@C鹭|},һS@aHϠ,>i ߤ.Rq#(tBhiVܟcU& 'pkgpCG`Q)i@![ -X0Ά͏vx/ _EO.@zO]887z KJ૱~yY; s(.v5 |殹@D=l/-HÐYpauǴ8'Hz5WBeۧoY}*lV䙊3=12`vp)y2:z+\rB)D=A~s~slS6!$"JX 8#g 2倫d@@{>!&*. z}$H~`|&iXaO*@F:? 6!ȨNJu6"Cs͑@F=3-2D7#_i2v|TDdؔXW=&rrخ& ak]'_5>Y4$L5sonNFzqzHםU\BwDKt*Dz*Qt_Ho(Lsn[zs8>UeYTq>X}5Z^K0n2nn- R+WԕgOEz4p-DG:x#G]x^fyAve۩앟 Cz8(J|'@z :.O劑ٵc*W'geު}u6t!}KEcMZ}~EոoJG4/ʪ*t DE%s dp׍c }nqG>[m^ ]JKvVJvaԏ'JESnqO==fŽ 1=e4s Ȼvg>Kn,{븠yFy#)o:O,=}zO7ޫko<$\sry_]۳OJ_:CvԴOs<mqʿZǢ>?s2v{zw5{Oy|>A! !;{Op {{qf\Gn[)g/^!d-.W,XŇی X)#.bSoj{ׯ¯SF^ci5}Lo1n+T,9ډVDK,/5<=9{[c"?oЛqE{S[S\`ƚ^_O`9ryyrZ pw9SU5eĒ+zsBɎ;9Xzu_sЯ]{MwZϽt! 8dO9[[O8o.n_zg^,C X>B/>/yͺYNwY{R7{?eSBUN;*7/isۭCя=ЌU\~/xo[罨0Yk8ӟo98bM$yѼ7? ?N:8XfuMVqA:ko(Ej%ٗO\{I/ug'RιPGKəP˳kd)T,``AkLJ{8ioD$4&,xсYB *>G z:';ST gGd1g]9pGՓ7E9XҾHRzChwjI;{2yt"HQ7tzxz0yw7X?TOQ?yz7ry#}$K3O^GO*/OTOD^ЏtwXoTs\T޻?o?9b ԿS\5A7[/X9ߪ# !Kɘr3%I墤Jw䘒sN&iSD)3_HyvlzLc??? O*gwD߱~{z@zdI*gO"?_ǡ>Zom?;0!׿i阰^h:C/H~ycFOYOLOzLSߘ(T>Nz7j_xڛ˔/VGxT9bȷXN*/}>G[z+oS=Im޴>hk*%)ii]1hDsIj:uZ|sssSE \7wڄB y:Qv}y?;pa%ۦ  y\ytrLyC9J lt r}T^D H{sP@gj^(`;YAk sXUMX `\(( *vw؊Ԧx78@>nQIq6eُFq4zI8\PI~b"|"IҀ$ZH7 *ȹ-C"[f4|xc,?O$ō0^}N|ϹQ~')z\"h$30gÑǹyDPB6я|2:;k rC/%-G =͍hOZ~=ی;ZI@Kx-Ώ#7AhE6[x6qY:"$xK(wn_ \\\7 U|Ks, -9v爥H쏊&t|~FI}4'S?zOG˅Ҩ]QS~.zM?+Q4/.DS]Po-ުc?u4,;b' -ڙLt5ɿEI"Wd%I%W-'Iu79\tikH˟x=OϝD$G_h?|`Ø$uBNf8riKm0Ƕi?B?Yz>$_Kq,$}`;t=ҮI:GSNv4_П~"vYKGH?$~6ƻ}TGR[ag*-7 bhMuʉ%Sȗ>?~K ?Yt/sЖӺZ_B$$-cH O-ᱮ|'hB|Yt#i>O@i?5_>Fk?Eu*E*?lZO4_FG*~ǡ8Z14x/I?LѯҼCI\I%%ZH|3*:AJ*G^~pxu(~PBˁS-Y \{n擒v) 7 V˳Wf/BB=~o)_$G-M gqD!;S)~e I/OˣO|[-f|ytcg>Q)q[!e6Յw|Tހ?ݲheQb@Kh=AE"Z?ETiHZ?%o-MJiSz]5n) GۣPn)AB/~ ⻘\@㣀Y>g.~Z@+]Hw |w_՟b:.q:E빘/@ zQB F{7ufL#%[DyQ/xGp ʧNji|)"Dmr6p^ܜLq_i 7mw:/z viUCPx˧O"t_H KWL>NhBڏBEt_۠s4Α4Ϧv>fTէlԟ8> 4i?evKGi\HW/'ڗOC}H1_Lf,g.3ڝO=>??YTiO)9@(Eu+3ϊcA>R28)ꗖ[BBE-y+A B?BVDۡW!7~t<P=(":N|Ji~_J; Ow+WJǓԆp1!ρMzz!1W <?Ki{q])l~/@(ut\JȥO(:\@ 4^Qu_.y4~ h߂ޔ|ډM+<FXPPqyg9ӎtgנ3TWz ?|n ՗6Rێ[gx>lC9Mg q gk|4f@dg$[ٺ.Χlq|`/u_WaQhh_S #n4/ɥ|}{ ,R?|%t'B^M{ hӼ4/qs.>:}>ܟQ4_8σt|_?@YqE1< 6[ț6ߍ]J[VGp}=~,EOwlmޗ֏7q>γ| Wh>0MR7f&;gxʧawq76w>%);>8#[~whx[+wGGYy*Kc<Lviom/y!^yWnx Ƒ!!0674^zO'[d}<D?ܮR~Oi\僟iNWȫDyIV^ʓxU^?~PO~N迬Tv:_ 6q8{ ooxU$;15/';{t={^޷6H+ws/8屷}cw p?{/sz7w_ tߛg~d14[ ﱂ}=wz^>,mG%xp=_z{rºv:9 >{{| d~ze%=QxOޯBN])NöCmUcc@yGߠ_xg ?CP\ZzqBz,Bm5a=WCzP>_N? MbK C۟9v]::%.E~ ;FՀނ~/ڣ-uJWډ]~(y?P}zx`9<~Rda7~]Chg{n 5Gy'z^\Wg??WX=`cCcHgmh\%c:~סB\ץ ySm켄訸[Ά^ (^P?+؋vC޳kY~~ ~JכA]e:g:Ov? (Wjw?l=b6{XonaQP)q`m}'p= {77l݅z^vܳ@:~_~7X 'l~Xwq7u]. avc3lc}zd~ uƥx> (;/aƓu棿Q2!b^@^߰<: zQ_7YYh4ldoXz+R[: ((mwx~Ǚl{q2NkAȟ[0ϣ~  bsQ xqv?e'Q.BCAXA'N]n+'ΐ,֕|vᗆ(S? 8/l]q`#k/;^?φ5eg,0ּ>==aYWΧ@v= fϧ`'\:7ּ|_֛I:ȣX:q';`@뷂<sGCddyDžs_QkVȳ&m?(j'C}=<qcO'Ni0ym$Q艹p vCBc\WuyfIy(k=Txwv_~&T'!n0q7uxEC4^AW1~B}Bތ"T15υ^yf/A;oQv{x w<5?laQi% /gyteܧuq8- q~uhe͛'|qL<~ЖR<GYqe b0Ef Y8{ ga9غa~ O`<-G=Im'\wQ;nn[GYv%;6(iO;?ßy)v+jt s)ac^UEiվ}W]wjվ}Wvc2"6m6-2W`l-abhn N޶فUS-v-ft-XT3ܭm!@g3 7IMY ˶hEas_w0c] ㌟.137l:lK똴_wH6cmuyΓl݃go?Y6n\HzXnmz*ʬ]j{(޳4y=k YKRu55uC 7FFMᰉ}nSpi8?@ jv'}ŽAt,t7sgȶh8 |G~觽22ZZz1ٶ; ~l똵PanFlѵf?㏂¬O{eCeԓ̡_ SB?a;؁?~Dl/+ẋ)6S Cc#H7wm44߾C GCuh416Շ|ۣ5~VUV[semi/_M"g&Fo;uT٩cvB^XLϑ⺻oHEw)jﯷfZf[X765n6w',Tk)TG{eCeF`6&lbdM5QI2"^f{PĆy/?`h/} 5BlƿolPMiq?܏$ߏo7-EK~:s?OG22 9[kapl21 HjOq2Oױ{T J@RĈp'RO?ÈO`]kRn0oDKyP O[hlqs >j9×pzg@Rwni!)Uz_ꢍ_F0&2"sHHJoO_fHk Ew3l}K_!j#kcw'gZ!E _I׽"@R'`I~,q=ʫ6nwׅݼq. !|9gؼ%皣B{WrP )x5FjeKF0Ս ֩d@Ro!ޗ|86f-÷Y V=z%5W50B-NZFWwlXO:}uC|yC {zQ+dխPE+fhkms?=\:k]ȂOUD Ur\wnu֤`fm~HRtd!֒JC%IYhhR~킐|RIV`^h0#}L ^켉;Fo,&Rc\s&X M :Yf "edB׾+ g>)Hd:t=XXp9)_&9CR6i{[Z S.BHe[vcdv~oWFjef1BKC<"FHG_8E=_5#>PZT4/9}i켠#ZO?-㔙23RħJ0Jo:&s䆧!S}„j&f:jzfy̏kKMfvY=Zp*O` fq`=?7trDNڌԦ)oĞg]0 Ӥ8V}_-X`7Ϛ?}*Fj@t-iCIcKQSySu_ HImJ@\M*U"iW6T#f0Sty7GgcS=pHU(R~ǣ=0ˮutjed{|)搸|]Ft=<G=XF8u$RþIC,t|e%fHUu~nV'#CUf"Z>9Z)-.K^-#e@[F H{ ,G_}*vl5>zWKan W!0-Y|$ߺ R`Eu[ ϺJENǻvvN`"NdTs\ˈuq ODm:34×P꽆VI4W$ul_%9TY2_ SO#Wۛ4OU׏6j2nFE@:Fnqle]?Ȧ)lt޿xi kٯ׿{}͟I:-Sy_ %X2)mZA[c[v|ψ59n6DKZ/9# )u]ac8յ>#r ψoNFz`\&l҉dZyO{i;׭4)=o5nx]<'j7օ!ꆃr+}XַW23Az+#s\]"2{|r߶SDMc ]4^pp]2XG lr|n^y#x؆*n&v/w'p!3o xw8(y(ӡQ:qEqGKGNKU!=yjCn?·{gom>Tg& ReG~z"@o}Lrv{Gsnn0dr^o2]"lx[_ON0f麗pUfzmu^8#9R|{~݅ٿmije!i&FP?Q /[!"ܼmMS˞v0%W9_Xaާb1׬g;bUUѫ9-튪/#w!I%vhog Z)F3ȫsjukbDsmr!vQ5S9tD7[%_KL9d䳰7T{:vN48=VY[vwFa~f¢CfϽ',@;v5!o 8WH:>-KOƌUٛ qHӫ8$sOAS2x;3>E'7%Ή!SWt s:cRs'Rh^ ;ފ+2;k !mS8o|trTfr/nOLy5} srV7jG3]'e{8"Þ6yHe:N?ncN°z5{MSEڕAFNY>ȌIzt7cS{/ ^I'~n&;֓郷?>}/[=pNɞwXdLu*HÓI|vUaGȌ'a}]T NB 񽲛4VV|kBjΌy,tC2)xuoe!˅FIFmsL^xu('G?T Y[?n)'lqR{gvgϚm'=, <]cR:F$c2yg3.ޚ$Πk2_c7]1T|TdRiWJDmU"_"u!Oi O'L.LffcGZ)I/y鴷}S8Ck5Xb4Ŝr9 {V)am*3yn"Esx"X5պĖxe9yICxT{bьV. ENMO`H 7&!kFt/{£Yh1=^o~Dėc&#ȵM3Â@޼ars'W'Gpؘ0$M+-K<#D%ގBk֐O}s]ԧ{BNƞJd&#5&?#kC6I^^Aǩ^$i7F"VԺi&!ƛ+NN[@*^.Iox?j$=,QhUI3Y1W">5eV.dVY(a]V fQHԳ4IqigW3[/Y9qY[Zt' &v˼@j3nsҗ"sf*9^U!& 瑲'B {#3w+ XXD2(d%zLEs }Mj?yW\|R)Q+U( %od4mM)?1¶G.I8sM?Nt9`{ FhUօNȂS;@ 87L}&R4FY278ӧ/˸N]ą쿪ȓxa%fܹcn8ivwlO;W6w]=>9-G#IlȻ=Ґ<{2DXdmt7ҥN@2"Gexm;[c#:?iDkd@ M?>>ǩv\!Bמ},&V8ݘZ;{wO; 'B "H&d鈸jO}ħ!?8 Ymv2]2YVNBٯ|,-Lh oRdrd)yX5N0QTi$% 8Z#SҴ/rU<\|Ȼb٪ >#4Vg_6YbfȲB2de[=FV@ )YbDR]~tE6ל;;+#+^XN*[+O,&V\Y%poޗqr7nȪ׎U ˓-^ZQ8/2ǚ\(Rn$zk):)+ޑش?"ў6")YFD~2Y!/(D6U=]1hjq _iݴ{=O^i՞L\O˽0TH} 9c'RP2RqJ=d%΃JbꙒl7"+{uùY=)z/#Rs T{[P0T+/|L*|`J/}qɾ S+Ů"k>ȍ:x|59.oYBjYg09Ț+"ͮylL4)Zs=VRsRpR]y+'H5Iε eRquS2>PRnv"ŎɤéslUSG~3g`J CT) o+CV(p=t V&W=D:~O"ҽ++ N$-B;O\Vm8],Xx l@~ ƍg Kׁӈ[M{[2͑bR6V"9릳-H|u!Hތ$s*, oK<}_ygY?6p0,ch BPs%>{⥘4Cz+ՓVg^z>;g!}?9t_){> Hځog!}u_]y]!=JV=@i}޷s'_n˟Z}yF}ykY>w*ktz+ =&:~!&UNԜGzˢ$?eoYCr^qW>|ƞz1.sGO|IZb9P3UvɚE/S~'1x5D|rHg7'!< #7ɖ(uxz:ؘ|%cGOJ<>rk\>xq Uux\y0Ho9+o"^B}/Ά}1H,G$~2>ZHzQ| KYfCV0h])5 Y6!}i,dT2+IBc#+tK~!e_嗯'e,'Gމ:] uꍡǦZAWO +,oyΡU\ge_T#'}<(O*8Y^@=ew41 2&5e/쾔iOYGLºL&%me{7Y1bшd| dș9RȊ'WV"6ܷ YaHyȊr7}Ot^r*eͯ]KJ7y։ԽJaz!)N{ݯ+GxcBH V3'r(2z2jǁ2Nԩّ)IY8H$B!WaONV)(dlǸARnWD}9Y[і''㐎n󛾹0L񔸜eץ7ov;5>c7ݡV&2QĽȳHB%CnfJ.B +ZtHI/Bz]Yro( Xv?pm{9MF3ISe)O!V";/riNBW| Gz=3+9w@l~D Veѝ~8 oM8X.a;33aú$͝Bc&#*]lG,ԤMQ{}OkL9 @q2*g[{i]N_hS6+D}> (f47$1&7l~ei_8G-Jpc=ky3JަH̠n .:Rǚn=.Ce@kx`DJ5+zlC,w=x*6ݚ@<3u=v-YX'o:{+u%=f٩5H%ou'>$vVn^iι='*]򭙶Qow-T9V/"? g~5Ǘ`);:>]w qԜ7q|dP?3QM뤷,2CّKHW"DLc{!]Osb &!.n&nK$HuXM;9gf"AgM_4!Sz؟x3'8dƼ״yŠ!s%6}#3o|,6o]2gu$#|IzҾVZ$vH}5/b¹u!jGdg !^pBs1Hbg##eff][S3ی'W ]شϘ#{V%VYF:v#O=D~8ɇ*'E!A'ض.沊M\<=YH\9K}qW,; IHk|l,|i17t+ħzV4ʎKoF>=2IS[+Nm$'ݵa[C+~اn;{eͭHCuD=YkRWbgbCS2ڠC]%FP5s{9^-3(η]i7kT7׽4Hq-Aވ=杉 ۧ1,ez 6vgŊ.nO\]| ls@OŸcOL=J7җOf3TNpKҵI ӑ&w!F?i2rԧ["M0uqRiysq\7X&>昛5e/ 52ˠ/Q lؾ#sj}K 3rwn,})2g٨[^$#wKIzT$z/3HdP<}2GzR~1/{o'dD|7L@wsn>#Vu(s]C*()Qk_$"g/ޅ6_`Kw>wYqj-fa+MIZ s2afmxw/܈x>HSM:o qjͅhkYsZy}wwI>v+U)N.̖nB:?ݾmk]յnÑ!]er1DǓJ\g_x=g;,m `sia0Fa+N[t}ѠZ#UHe޸t+6y!)w*!ѯqevRR"];}p[T3΅a5sꇄqj~FvGueݸ"{ҍoΰӦ[̩^뉻FYcF-$&L5$kңҾ&+Zɗ~ulH %/EW;0e#K}磖#?2T5"=¦٭@|׈ &z3|$yO44p+oˬgfBz|)xm}?qХ+H1 ut,lB"ݤ܈zp{_~ݞ,_#Ъ72RI! kK吶3iVU&m/93eh׏3}C6-w[,torܺϚwN_5}/ >_|uxo> Vm>*Ukx-?'=_!_,sĶ&u_WǍ޿jz[K|>^;b}.Tǧh P?k+ui;K.Gխ%Kv[?gw:Fm~j6?]sbvǭg\yûqoEctڿsݘ6p(7m;V_'*sȝ tصg<_;wĦۮoyG3x;/pOѣWMm?jNmNGoȵyw?3iwdCD;ݮN[]_j'=.:m i;߿[o>c0fXN*6td({a+N`eᯢjQf/{+ÞT]f-K+B#Lw/S:,gݚ,HKdIFMsHɐ'D>?'Io?s "yx"//Z=>7MTF%}L\_êq7/ǯZ*!g$rN$oʞt٤rgFR1}ɫq"hgU / NHkn}:k]*$Ern7Fm&E΃3xXy.>fdVAϻFJ#:\vVW6=fg<-=݊]1'k=N/ՙޞ mZNr`X%~v(>:\[.F}cg3^oUbUđsFbW[Yr .{s+Ȼwf.!6΍,70K^+T{_\Hh}ŗ 煅:wqL~8ʷpr.\|={ Y|*i>7orz<P_P'$gKޒUH<.@>'D9t yrxygGZi@ڍLGk=RsqY3]-`"AbvyNo(.q?}F_?}ޗ[*vOy^5#w zb !ewQh'<-aa Q'ީ}F]mZ.<'}.{OḗҼW;;`C=:%I/~vplLۿcv=W+Zl>PO _le_l{8cp+ %U_/w$%W-yA1G[X~: ?>p5+l]co.R}K7;dp_ ׁN6?p|Wwđ@7[iy}߂)-=]F;!?8ƃwݩX_,}~ο@PF;i}:RFyo;W y _a؉:b ^zni${t$qkZnDi}$4׶-@;-cH"Dn# $$HlyuI$IljIԾĖ" ~si\FJRo ;м/%ch $I^K$-D%I*mjZZ^@R[_RKiP?$㊐$~ ţ;[-5.jy'^~RIJWԹH"pn!"iD4~^F©v7K|u'M_YW_`kS ~BIHdaćƽ;og=|zӥ9'_5_Vxz|qD/n`Ø$ΚcgqH,{ImW -iF iq$wXoy$3h%mq $_{u#~ͥD;mӫv(_4|}v2LbZ*‡zygLm#1Ebs|*mqtosO}D"hs57B M8O4jg }X:nmqIG,؟FTz~ }N/]tK'Tcsq^ ?#[XD{b]cꖭ^iR}`56v7 ~F?AZN\ב8Q?GG#Fնiq~$x+s?S}BsGo;Zu#+PZ`G5;R{_ DzN'~:erSG&<σTRhxJnڰVAoyų妔:qۜ@3f Ec>2oI!w؎H/ۛFhJu7{ _ Xw|G?~ONB hqI$I`Q/y;)4^ea#l{5gχx=xW< h>X[$W@ЭaIxwPqUѥ7JQ#h~qv}H?~u[>4o+,~^Db/, 728'TdR]ͦq[Lux،ϢH>N#,clo|3r.m_3ZTshKͥys.'(ˣ]@7r-K:'_:Տusu g^3~7wA2?Q}+~U@'yb@z]>\OQϥS4/Cy` mB|l<_mB;^G&5h^[wV#-J[ҽT'2iÙԟiO0^if@=QȤy8cyt>kGxΡɥ媷ڧ3~AgBqK[k_`(Y:id(@x3,duu_i^MCgP=z}(1ANrm|oӸ.zqQ@?G(vv* <΋@sA?UDu?| 6۟IƼu_69ȵ&E>< 1Q.C3~@|RZ若_.RWM6XB'޸S!xsOU}vRx>Nmggot i38_J8g\{|! /_Jhzqq z;@AGѴ[NkVտgxsE/0[ӥn{Lt/_sZЪ0mm/xnt tdvCqSk]h><-r*)3h0:> !E4~99t-Y6w8 ]H=rv) > 'R]s@_/ C}nc?E'K鸪γCQH깈jr?+̳`ި^& vȣ_'8΋b90w-[e ~OmJ֪g߲r{K$%tOyt`ჾsu"nk|9sC<5i{m,乎w|bȃKUw*JJJazDiXD dO[o *TOnm3G~_r:V~@؏N>bmaT8b1gfv~׿y6Gӑ(_%̋y_jyڗ՜RV]q bx@?a| a' ǩ?[0fClz*s/m_z'ہGGS+>fЍ?Iۚ'7c$䕐o#CwϠ\ h Qg?mo(o<;㻿I>Qx/ ^(E6{t>| ߷r`x ck:Lz\2n6kz}6x_E}=7t==dձ~/ {+9=O=p|ώ3xd_ہ?º >^=jGWp? x%HXW֓nLkExG;az?ޣe? ~wdg/6sOe~?޳Š3XÁ~ º]ߟY|7h?Ԩ#}_/ޯ8:%wOЮ3=^=q ZW·r^AG`89Bq;@e.^Qi䡐úYu0z5k}%Q엚W⟽3 Ov qA~(x:%KO z:Jc'`B?`7G0^|1{v귱 Mx.\׫@PϠ7v=rCGP7z'z :HX7l~~>Qvֳy [Gi:JP﨣4/<c3{]$WY![o:nw>A?$x"p5':n롳dB 9J̟X.{]avWQe3 {\f~A0^Xc<:JU/8KGBgygXǛ㺭yc+Q\gkKQz_m׳C{@C |/q=kyv>Eb(x[3:66ud_ۚvQ0?aCy;C ]`(Kk{yt`'̣=5;gӶ6=QV?t<'y;]wBigP 㐷wٿCb167mO~ڥKivKjt s)ac^UEeJ]wjվ}W]w&Qi;Lt- m`kCtKp?=lTn.0ۦknaҧnm :mIjʪ`l_E,Zrgtfce[X_ǤeeCm~6ud<;1ߴPPDwwƦF;׳rm֫WQfR|(޳F{&Ycxς]p;pٯj?o1 74 5 o MM0sG7K4!555_hP?-% cLX=CE;$f'?#D?eBԫA ͶmTcXǬu2ws6Dd7{`_f}l/*,hd\XϝB Tx#^f{\ă(d>L ZAټk:f8lgBC󦁎>\狆Un9}ప +nÇO{eeh9S70xSީmN3ص 22p`}ݵx@u.K@WKuxM-0Ӳ03Bg!w;e_K٠:l/*05ac%kM؆g2%6D 6p΋1C{K"f6|glbO˨~$~|o)Z әo2%(`onacuO:f͕1R:ʆZ*ck.-5aܹt# 122%NӦMղm[Zv=?ZߺhĔ!}[|Řm 77;=+OWձm;~fMZmWoc?3y֟4D76he'Ni91 wIF۸ϡc\ZʪjjGkjjQjٲFT_](څOB!2OAe"d:587fZ .o٥ѺC%Jexs(NF5O֯]XRR ewޔ))QTF9RRRRRrngvGu+;OpЂ3v,vX"Yu3+-'%# J1m;ɭ#YɽFڙ;rݡ,M*VJoPvd{ϐ&Hoeڴ~9E?* 'Y+tWY-F os֓y2. RgEWcIİDRhRyZ3 s^aPnl $M|H=–.c$.Ĉ=/(HuzK~?mWfν:$!w*qZ1ec4;}ۑK18}5ļ|L;zȾk"¥̒E䜘: ]G$WA<7| 3;[,m-^]?n|c#w#{z+vaLo%H_ڐ~)Õi= ?# N۩H5]_l ՇrCAo:j(#SK&53vגF*"̐aF=1',ߓx RF~ORUe32.ίZW9x!#$d9L{#+;[?*#-Y1#gϷK(O$Pfx>b>K,#>\Zt3iDsiףH_xuᛞ|aDYu H39|7 YJg/* desmACcMCS#wA;psD7h?3hڰڌ¥[~gJg֟ͪSB f<{'}0O!af|`g#)hlA$GdwlwkdvGQ W?lAfL=Z62:~w<1$R4J)`%8DR$Mto{26e[dhӺ݃5'#e+ߍU2}z$sn|zdyN0_\*{l$[siª$w;)nIao cqDIn\E'tCؾIyw] .o&Rf׈ 5''ngBvr|VFaL̚4.;d\ZXA>~ʌK]=3U֝˙vj߾~cw}N?+~9a2M VnݕiPm--u,xhbQљM{*/˭q{nf426u>X}qqQ)LSLC)ƳL:iշ]iɊ=iû׿ÃIu"uqn{05]te?5@v#~oFb.#ξczWݱ/R2O[vi0"[Ȉ_ Maz\:ef#^@;? 4䧈==sDl}̌ !r˄Bf൚,rA;쯢+ԊFi7˳cD T.rt3 lggȲt)w>3M[2ڹm{=fHΪ6cQ$3HKZ{їBN,bv35)ALBa6ӣ|_t_H1jrN1¯Mgas]5eymDMӈKg>Ly`;Yuv+1Ce z}^{9'2A{`jQ =uy9Klݮz Q5H >2g3_s~5s{H3FNz/~s-3xK u(fR:&)hlz=jby2~l󠑗W*or[۾i<NjkճY'ulˎߑ9Ⱦ &6+}8-kz:R6aJ4ˏ*]#o 9^$&?lRnP;2˺&+m, )1ys\nЌ3ks1]~o5x^sbɆLyNF qč܈w#D;{e?} "O1 _51|IՆ?Q=m#숱iq΅7oṮXzfm)q6LtOt' `:t*6D䮇=ɰy% +E̪C skVVFcJCy♑x=VvytگId#mfdmI[M#"; !fW:#oH\R\;Wqoj} cwҙY۶K#>tܝXg[9lڒqoKEcKrCkn#Vґ{xo b=6qէRO4֘ț&ܼ\DE70q0mHd6 ;pnU=K\ra əJN+->JdKdgY]=qqب`'n:g#pf`221j;ցwHΚ~$6:D*}a܏T4sƾ'̰Q2UJ$V_HY_^Z}S1qn˙.ӥBϯC;k>),gWgR홍;^_):D651f.ZrT`9LfFGI2iR5w>3gY 7Z3e(:ʬ>q4 fvΡ,CK-0iדEkmȼ. Gl=W|ڀ]Ȣ#=;]LϟTOj@jU}/#|zIfiPoztb;+vj.fxc0&Q3WW(`5=RPYE/sEkX )cj#x -c$陥OReTȗᏽuc3:of4m8kG9nD-[y>3X/aN0bO#q@RUƕ|O2١mt{W )7=o/)3;m1?wn N[B") GRXǤ}uv$iwLxty$71VCD[s%ojb+[5z6miE u3j^yE])?R[ss&"t-|CLde{4`c_CL:iݚojs"/Ж vA'܃ KmZ097[b_]IdUsIL#!_= LJ@E^fqJƸ`s?Re1`R?޾:qF1 k>Oa6d :vFONX2o ^r# %WF|T<8{! 8m;3v2<^1#Dn5f!/Z}p#9פa<30Lmf儀Ռ)Hz,UmRGCמ#ڌV*#HzNJ@]_zU=9ɥ@RDуd i  ʀZH_'S3£Tg:~r?qcih)+Y"y.=T!8bP{;R݆wa:!0#Gmuنcmt㛳wz!Looivo/:=^d 4ҪX )קuN=q >K?H˻9{E ۲w$v(K#<}kǚNs]\e<ߊJ[ѻ-|rV0mggߵ1ۡˏ{os\Ō on}orsx{bgL&m;/,Xw1?x.geD2 sQR΁k0Ozu'wfIm] ّ* O}4=ڮǤ." /zs/I5A=K{\_-}cȅsv]61Sy[]%KH N>!f:2ߎ7KNO`Ls\fKAFlwY5Ҁ[ŕ4~jR "n,u|#dI@K8Hإji$#ϙ$?Yr0PR.QzD;uYlxbԙȊ:FEh}GVYx#{^)R0{s[IdCQ9瓯o Ҟ ecfTi"8"Ygg;=n^#\nVVV&eL,R Uô6t9f\6h@Dd]|n d%1YgH33rC2b HY9hhǤaӗOOPB6<_ճvoD&H4xUK@Fҭ˓̐ClL}gYBeo+! +ܛ"%IK#G@VdYw<띳tU%|{IU7Xf_CV+/oYcp뷯"ߗxنT%ORuu"R>i9Rn28y*nmR;i”uȚW:|kDV3?zǣCk H닲3dBU\^dux\f! 24n\?RR(TE_۰ YD{)뎄jdU3G߰J Y2H}qe0үW/zx S$@Kx1Qmo@v}Q ec@B0.^?9IrιI ݿ>K{l8kfkS?t$^3O"3x: 8f?񘟻A=RރEH!Ae*ĉ7|' gpA%1d2{"Z6w$޾Ǹfm&s ]UqDO#CqK!Kv"7#3N!KS\e>I0ª(%di8埢%ٟ'EݶsF'RfWC7vaGDnmQd:*Sun!eEzs&!]vj!d;R0Wq zՉUj'6Hv }OrSsIȐUeT+&g/;4Ho7Kd؍l(rȹ~Qdz,Vn4׼q, izz>ܾK)0YM ͅ&ř.&cwiW|!F{6v&e5;"7v35-dY ̐Uat5 qX@'j89Z%YzG2|yg '3}53**V2TݩS[B*}!3T'N哛v*fH i|o5r_fJEVt 5`u 5pW>wLGmUېa\d}3)Wrp'ە|-<x=*kHRi QRkB:R|fG>Ѓb{#sG!˟dȽ!+L=Yhɓ!"~j /Fc\bsaRҥK1RjՀ/q>ĸ_*wk臬*n*P(;8RB5.jflBUkpY0G`dUÀ+y-6%dHw$߭Cu48띔GV jh~&(7Ϻ{xz?HR;G^?`ㅯK/ނt^| ~OIicea#N.L ye{]<+J)LM |69['Ȫ_??sUpa҉ s gu{Br=N}+tS+[_!'9C/:Mg21'~ 'igEB_b4 (Bz'5p^Mq;R:ژM #'d;!c3?L5 (B l(8.h&d|Q͗9$a!$ba~w<% gE?WWAςېCD ܔO!=wZ.>`iīGƊs@H~MHsoAz2sx,2' !O;hpK^WXyx[8$̑qwsk|)gy2 AL#H߻U @ϮZJ΋/T__N|}mFEX-mwI3~NCG~%~[_kYJ'#sE0a9!Ȉ}rrS$,Ssmbu;{mZߕ|xI8 [M IhAwы'{EBd+~dй$h}2e{v@F<ͺ_mKjEjkA I8,AboO}kE IRo#HTS+ m+ˎJ\ntîa@4TD@3 c:xUl'cJn;@0$Gd'_ {q^I:΋nIHjI~K^9o iW3ca  4>ZH^ 8[%v -MʧBPsNsed-vѫ"v; {D42Ή:h+' ܦ`y'^m}Q# y6~|Hwsoe9ne݃W~y|5|LNdХ1f瑻^}0Ӊ{+:rUmID0L6'Hxǘ$$_x9oQr- 0d})̦@9M6# V3eo$:xbx \۾Z]/ۆא5'h$$r^=얤ybr+cCGվG:/|D Qm j:9,  |"|?2|:Td1ޙY =qz-WdY&dzSE$w.7ݺ$kӬyEy\ q@WD^sɵ_j_!_pF>.م\H2"ͶHkz}̑". vI]` +;_Tl> v9j;& V&yƎ$2'EFhjc =^,2)Ʋ{E,H1ĬHFT9HD1'YL3 3H*$ÒQT[Vg^sgLTWWU3GYWts3ُk#fXdܼ;1޷}YC_QO;csIT~(I,tXsqˬr8㈺$1nW.Xy$I.$) ѹ{D q5*Fo ݌)[YCb{vl$nuN~C&v=%i߳|j\/N2Gܑn$/wm++;ިɧdVs"b\Udσ$.=aԑԁ]SV^+ѣvL@96 mıx#aeqKֽnMɾ"yS4p2zE z)䟘\W~\DwOMܷp˂Ϳ#fP"PoPѤraJ5Mn\xy~(po;aO< sĐ!"84uYON1b4ȦEﺉ JVan z }11{}HcT=3`UlYp?P|#A e8x$sPb0#H`ҾՎսێo~'w1>iaQҶ2[5L}HХ+e`1IpA@j)bx_^C1e xl6Ĩ Zw=-:aHMxkDyH|G"sq ◬F+A ;.Ƭ=פ$$/~}vq"cr>)]n}M؎vyV+Nq NVO0A>TmkJ|؊58]#_YK }^} ?du`Ġ!{D"3s|'ب#>{In@^{KjhWwD_?;f^ L&^=O;iW@W?=I.| he;@p% 6I: =wFoD x%S;{˪,)賠¨Snފ >! V_s| .9cg$HcEʷFtNʪLoN|q/;Ip$A V xԵħG}N(o݀6-d=}}.3\N~ w4mM\$`LiU돑@q+g?86O6?Fl("-$P_jC_1Le|}yj+3MW;mp;"ܔ8Hn":W+lb\2&4o{{ˎ\e0J]) IUo$Wv}^;r3+ .*?E}˦/KV[W䷹=԰5+.vsKSm9+ :=ia,Xyy`}V9r;ߖt Ge.pEˇlWHBEE|~/9|BѠ>/LXj ʞIXڱJ|*T:Yz TI )X8Z/Ip;vUS/g1~[Πv2R&]ˎ{9\mC}O n^rr${|' ,w*Pp;xF{׈D|cow}Ϗ*z @c X5JCS3ΆG7(_UsO-WKjZ֒upNuTZ[r6}So);6 a1{"~_·KlcKw !fTym%$YwޫԚI(i>",4ʇ6wx{eoa>,sc6)S9DRwIu$\>䔉 мE}otBwp,ϒ„qeHN"(gڄy|X:X'fhRlAv|XDߒxRYVӷɕyd !R7kRo市7RO/R:u^~YF*D?>UHj+W9·uʧҧ: OC˲S^yծɦa|X8|iۦY¤6q@ '3od(sh%]zVYzzA|,5xV.3]7w>Դ_}[3/F63$r)fңU˘j/{vdV]!m)ϴ#Ka&ssٸv!t $CRa^ڔαƓ)ΒGCﳬn|zդH{6qn a9ct.)+i8 Τ2?+uɿ>М?,jdM\G 8SΏ} ~T7WǏݖ}~.);.L>b){!fʚATs۰}*bB>T8.X!>di'^ms$Le!Xthp OqsB'ĹuM" [`+>$-+j=bm#&c vv CwtWIIgR'3ni< URuCrQ1o/ΙEBe3j$TA.n1o$ U N-ggM"λs5!\WCw&5֒W͗M#NyŠN4+SD{]rKs7H\Pk'AWsE'SEnZDWPcϜM3ǐWNmO j][EG !ϸ>̐9ihB Z+}_v㾰hwVēfD|؛*Vhn,!빖0 }Rq97@֯ ~Ax)W UHO (d$+ /^_NoS y M~!.$qMb|Ls lp$trkW1~Y^劬t!ʇzronle{X73' |l~}whGzqO7wN5g@i)W_%LX.6~%ڧlπG/vz]5&[wAV@OBBC?]C=A^?A~*'=xN#xvtBt9aVQ qM={MK8cv ߃nCv~.qm.1j~BY I@Sܗ>Ǎg!xk 3;q jh ˑW^{ӧ[;I4~<=]i8~H2'/;:q164ϵC}Ko-_UXLbIM~$Q]֢5$Y$ W.2:IjtH mG2TT@y*fjM^CR$dr$R{K4UJeH\!Ih$S{JmVF74|mU!fX0ھ𤦎OiNMP@dPO4=}sƓXI(|ĹI~sr'IʜeU.$%F$ebKLHWrò5$Mw^*lV߬r+<AB}t:ܽ ēڡ 7\!`H(GиHY07Xt/Ems7jVE>Mj{g2 ]cHEI+ЉDMIBAɍrHbnF㑦ф 9ԟ@?3_gB =x7_.ԋv-wH# }σ$t9k|4$E7{M59k״=ި72Dg\$BG˨~ g}oRR5uѩ;6$E (S*IUJAI'3luH'RF˨}5RJʛٔorh;r9 9 '%F>JJ{02{~z$o;fjGJ9z.-&?&ugxzuURB{OwrS>8 *oL_2i'Q}BM\ӨfP=eQR?,d<5gY_s(_{7 ;RD2h{vWrhSyO>O^r4KH|6ʅvL)Q?̄8M氵m&J2?׹=#:o[_O2x=k+汅40yԀdj$׽N\nldѸIti|zOڗOJhYN,6SCBʟEh?˨S>/~/XHvr"tx{3 e$踢yl(<;/q.?chG-Y676{L$EGrbRwn|޹ ix*f ǥDIpR]l2ѷ"e4_h>ZF S)BŴh~ȣ\?%/ir('MM!-'lڿ94(T[apּ)nNu<5+}Xwm&s-q$߸ǜeY<\|d^=z AyӠWhM>RkLY&bq$}[?Ԏ h8e`);j94qF_ .r qH'ʩ?qR-yO1b EԎrCĜqo\GbZ_/#I|j'h\|Oy&5iT%"h_phF8 u~+hpW~<+l˹D*|M>W~L*hPYA94zB~ǡv%+};:*̷i -eh bε5<]IIJpҫWNuӌ7S6OpLN5ϳf jeԎGP9W!C xM {./i˥\9oԞ(CAy?:?QJ}8c#84II*N(vy)?~27_ =i9ͻ+% "!|[@8jXRJ0nYq/l!)vTGz)i[RFiWN)Nh 4-nIQ <iB 7"R{: z?-R \$3Mz7Fڅ7ByG y#r:ReeMǫ|WDh?o~`OvR?ApFw_ڹ]rB|MWyq}F*^1~!Κ;/T 櫊h- )!ʻ0QBa~ wt~ ?)_ /A?{Ayıo~+Wv'<ǔ`0D gVQq-a8D{q˾#3|Qŵ/lF.q'䃐זP~@}^~'+ @KmnC#/W\sp4:/I0cՇ{#ǣ0.<y4;]RB?* '"䕂zp?|PNK:~ >ίq\:#r oC:nNJ Sq Ϳ`^J 7Dʯ%4_x":5ίcx/ rs{NS%/<ש _PDq`܁4,5+Ir -NQ&YO8W?>v4 M{6E|Gy$ּt)r: |`~ Cd(7{~8 ,Ex'waIyEq|A7|!BЎ ;a=Az߯H`;;y{~/~}A~/_eo|ןR?>X<_Ox7M:fŔ {A/bo)|a9N+i?r> y0Ga\q=_y_SSȣ.}ID!O4j~o<̊Ӭ rţp>0CdΛ O +XBFT؎כnϡVM\ auO~-Xg-P?y|Lt χuqַ>T.\M utou>;a} NѕKu;1`adhk:PZ\[qt<zX >u^JN_\M} yWXz`=8wuBnG#z:@\ N]W,g ǰ?AN\L{f47āVcM%H3zAz}(?7U#ϛZ :L[:8. v !q? ~=B^ 0Q?$Ag)$Hic޸̓þM=yuЏe'^BN, eނ*_?A?xi N yh@9# Åup+֍:kX_C?tM`] { \Lׇ `/h= 'Lz@0%EwM_)x~=Ñ77zpXg}O?a] xқzh:OO^h?_ցS4?_;-hZ1a<~ O~C4~b#g5i_?:Ou=l 1QN;// 9}l֛|a_X |xևӰ>6ߣ4ޤb\gp_"Ϧ(\5< ϠbH ]'w$ p0#7tjvloyk#V+.S`Q:_ a Е|g8+[>hǔ ΃ܯ<(~vP(#v ϳ17 Rg}ܞ5t wy3Q:No7=uR}@B>:v yYQ[د'z'w9 Op'~O|*q=m4>xx}B!uЯ?+_(7OH~ q;u8׃+l㻬a #̛)xE.( إ³K:.y M̛> ~y=2'S=x )߄qwz%d/p'v~#KqQOp;?B=7S=b8"|7M+G+e`Yy(ίY0yJ,>})0Ѽg_}e0gD BAn>®?@8?Jy}~_qG?Q ~@qΓ橠r6ܠvDy;<>WK?@?͋'e^3O'}?< < +/8Ndogwh=ԮpŸIȣ)̚?ʚyqطMO uѴ#6{h`q{~/d/`{`妙d QQsjo0? z{q xw#+'QwXH?gw=MAda[6B{ANQ>=B^!-{qaވ-; v{ÜcaLjsx((YNȣiBeA>zyQȣyxm`-{^OllˡxTHT ۚjo] /NIT˩S-ZNj9rT˩S-SB7㐱۷lz&pd-T $O ]wmգG蘙uXtSS^Dho t@9?n:2T,i˺+~XOp6ktXO{KDkL6x_(v3xUm&\ocEgOr=FzNJ Vz˱N)jj,UcRJW6p'Vӟ'- ¿l ] {$},F\o0N£a`hj^GU^n2=Cp[٧MuTg] Y~>ӯ`,鲳3ޖ:[iԉo%N9MM9?52;pU ϕX oBJxwJ*H?O6iߥǞ;~ݿǞ;~'Z?mHPK35Ubb Mb6a j+!6* 8$<3鼎4Ӄڪ4y 7M22CNf.U%9EqTTT+ʿ[_ݵE Q_" yG) l\R¿x>;ɫ6ͧy':7ذ&PЁW0避X?a!;QFE))P80#((GQEEJRT-r"gkr Q.缰{8"6 ][CtRK Ǎ8rTl-)oT~ V,|j+X=!ƁT_uI iv.\0TZ|VIRlZwܕKPjۊ6+]ۿzq|lt<#Ty:{/bE[ %3zzJݻ߀Yb+1U>kR~HuҏRѽڿ@*8MF.3^T-~STKb(gGBO.w'mHAjKn Bl9%5TYs>-zGOQĪYNJV<$U/b^Ct>XgRYwsxRpXcR[u,aFzԐuӭOxuf6 N}(ͻUo21"ޢcwz0"y{_[δڼx$HI;OXgm"yz>4;N:ۥojR>B2.Vѓ5zģ|j_/ !ս$Y&+ӕV8DӗjW|%Ձv>sNtĚ]>o@j1GN'%GxNBz .qoDj6\Hk761a m8+# v6<Rtq[Bg2B"7g=懎?z|5sZ0#$!{rM؝}m?3,irHu k [єgbHGߑb'y`#%TtE~;:\eԿ~tn%UCW&UOJ\Jyh]Ru᫳d]W<<+&YɍS{m@]f9]}ƮT]k&9ɒ*ڹx[9&tM, 5fcpڻ!¡ոn\V9rb1ts}zRZ=gR9?RR.R>{ޝ<9Ws4K"֞:+N*qYRck{[Uj,Z\6 T>g7}M ܸ{`f]!V>rs/7BCTiXp&5]jnu*FX 2jrďf9_#հL9"֮3ڗu=x"}+Ry~bbq{R?^Me3R׮"qrp3ESv$Y_ ֻʩwF<%Ş2Egx e#9vU8\qj r;!Ib]?o849MҽvUJF_gy WHi+KRu96"͗nwYh5~CB;rΫ&uƄ^49lrWҠHNkenCjtl3|&gNűkG}c׷椪;TN$vIL;&ͷ/(ʈK/O#'lG>?G_y-n!ڊ+g>k8zuOΟ_EðxR; קQ7sKQw_[7+^n?yȇk=+%\/Aj4is/_Ѣv ]U"Ⱥ˯r֭5lÙԭ`isW'5 Q]Bm;ۧhH}R%6g[Ώo˗}E>z__?Ijk]oUK"mbk7F쎗Z;A1 R%ǭWƣ?|Btg=Fݓ8lM qvtm &yHoC"_}Aċw\(H.4`c)mw 9m;MlvtyPIpʓzC/0%e|3JPg^Ft,=K Rm:S׉_}}>\^HoNx_H܌Y줾P[ĜGbFʰҫIٱn5'+g '#kI>^TrFD-b`Î.}#lSHļգ=E ;wWqHhgY#.p^y}E& δXvsHĪNsRNءIG>bˎ,Ħ$N;!퟈4F+X:Q,D4.=)_ 1Ri֕+ϼIć& /N@ ИUE*$qN>ƾo!޿< L}Q:HwMzXk$e[ ý '#2׿RNQrKo#F@QyiR+[=XOĚ;5&xuCMR|1Ru!:m>}$UoC|gJ$?⤺ڡ2nnzKjetp4?xo83>< M)&:u^ |ѸOY{*bVpE$hi$NAqB8۱x$|W$ژ_HuQI$ҭ:$gm7I^)or>ejDdUj2I4}Tt"} yC %3.81^tHԹ5CҬ@z;uH vY64DȺNhyDϟqP=0)j;Gng3yil1&wFwn%ZǤ ퟉"$0uOz?JEGUm4v_?wcR|K5ݾr]kVl^<^,wT+6a&~IlS~8.7|s8vfkO PLkCg#^_ʻigGuIWICY2F>'uWC 5b|۠x,4WC#y19KB:o3n;.| nc1n+bRJR7$s]˚ˡq[-"~7Ru4Gďa63?SC2JÂK?ٷ2uiv0Mnhcne~|uw6T,ubwxzFh Ryr]۹%r*n=%É'UNK%U]nLqJu"\׎DیZobei2[߄u@)+X}ŞC'#V000=;OA+;k=]Tp~I]o=fW 0Ms蔢jQnQ¯DmEt,jO]{ѭ~cDG/G!cČ&!:v~kK+DYI!n=lV_ nB[^jE#>M2jY>'yTv +s@ }Wf]3xVGe"ѻwC#VC,z$Ԛۚϼ)Un Ӟ(ý7)D |U rpŅ#*yغa-MΨAcoC@}ZyW$@ aduٓЄ}^ZN :AZV4U6btGfD뙟W[#+mj=ݰRda%Di2E =F +آOnO| 5<;vcO J=L"y~^cD7?!j/#Z~ Vr:sx*MM/( -Gkm [oz>*K<\iSXFbڌÈ;woxX&s Q +Y>{+87n{'Cbe.BF0g+.8{ϋ SX~K-N=_9V VbNB#Vmz;XSh3&i!U깗< IlAHU=kGɒrmaěXϫ5XH꣛/Fv@9$%bX>Bд5{o?+ӘFRm0llWRݫow.2ZC${GS\/Ի"6|6'5ϜwF!66ӮE6dZ:Pj) Ő4|0?vd=K_u3;zDZ!6zZ=I*d]<4+ہ=m"Yyhx' l.;%3YDʺ\r(wg uX%63y8i=Rxx{V<\"z4X3dĪF_z~$zcn>p R5E*Rv ippH{#񰕃֡Ջ*l'XlZ]}VX1 שO7 V__d:"h_kdíH@WѤzV6a5R-C/}܇ ~ounnzԽGtn}<ݾH搊Vy}/ z$ p1▾!ծTI{uxNE'[u?Zh7Nۛ9mj-sCk7QUJ W"3=^sL@Ϻ{Coo}}g8bǘr$bOeӢوA=-ޭ|0Āzwf!i9z1 ڈ> N?h2JĀw',uC 9$wl+(K.nEb·.en{~Ę]K!&F$b'{$!K{G1V|ֈz=[~$fdߒM̊\0xM7bY@|Ko+݊9wPROO9/=_/A;gDe+>Dm4X~5{NSm!>6_9믉礈|16k7S{aşN桟AjnpGr4b g8D Ȏ?'cOlw3b[ҭZ%I5I+lHeyٯy;f^D#^i#D>B93-Z]L[n텉=̿ک{^ֆ#EN0yPx=`rpϠ! \?Xu:qwȥnsc=ێq} Q31X56;`55Ð>f^6oC]7>0{bU07^S]ȺmnnTgEֈ"9~#ⵐkSbVkN`` SrRZ +d {VA@ˠ~66ofw|Dˏ&1U߿\VJ^d+g]-!:Y_o_^庿@ <ѹ4Z\Đ!mTn$NG $/gi̊$=χir#I1e97Q@|Q8;/.oۣ'Q%+F{L!]V_?> Kq9L?]x=4 A 9q]sb|]]"&;'.dNuOxީ)="sICH7ϵkOrC>~I4d9o-}UBxEG{>u)K1țsvԆ fe.3DM$}sԔ=IwrUI׹DlI/rqX)\N03W":3CtKX򴭆ӡob}}vDtV-ɁvwxV*?yĿY瀕䈹ȣ^[Z s [hjU,ɂ[]p@drIv٥~#,T$C ,c^hin~W"=<@k!CbwjV9#:9} kL| 1pgT>,DZB q|gONO%'5 %S4G&VR7*%>ev :Jm}w#/ C^~;uEax\%xõG-7MJHځBO&p׺eSݲ̺ Sc˓3nڟxw1[jV{e*bN3+yiS6BHhWi7A2|WL ^ul卢gԤ)z$]u 9 w1a ^1)b$#Ə[~ 1ЮBۺ &۾P>zrٮ$S1$@eoRlG<'inǍm1ΊΞ+]VCtI_=\D13mFtRog:8#Ag=\_L#z-oI56nw-&#}r|𞯟QI sqa[5qK8pOڊd ݝGM B.5cW z,ghD}@) ѭGwqDOτ]kgW\pkIW+]]tGxG~du߷za=c8DƽUz/|4+6##Ηv=A-L==3Ǣ o{p."⎏#y}gea?n׮_]*WGܽGBtVtI}jSgGh w;ѩ}Y D n#:>18ѽ8FCfKq8ҝ+֮zuio91aj\32qJΈ^ ϫ~;}Fa՛5jo*EL {鯵}<7LJ%޹%8m EIz$xiRg4Kzg2ksM}ZiDo ;t됯GzhGD "S>Ӫn&Qq%GħFҸWw!A+%E.X!Gpm%bnbR:߀4ěK1G[顉ippJ@]q8̍@;3"kErCkKĞFt=mNr6a Ljg\F\O5g qup~b Xb o'} o]Bخ'0 62ˏ_T4bzFs[{]GTJYH*2olv;(5}S?ݞ9(!h[+>ɯAy BJI-畷'u׳"\>OBۧLoF~Ҿ?>6_nguzpΦgض,aDO{Mh>c%Wq=w'炰;/ pRp;J_xv,r;ESpyVwm( ݭ>#o_3)wQ=rT.H.wU;ILpI,|̏WY\#[dǏ~էX !K.qz&ܼ3pv6́WUC9w8ŏK{&5ѷޘoZs%5֚vLJ%cKHMJIvhu ?ޚ8q@Rz)mz 4x=(]e}]k>9;TfKy1pˌ~d6|PwjO٣ EVw7ЎP ];¹|wU"m^QE΄U97HŦ1(g])CdqZ}H+-vbsdsm2jHJTV^<#t׍"ރeNĒZDɂe\p#~?ݍ."7 ?.0ňDRǏO]@>d-7(o-ˏybo1"OBUʦG\7'j1"iU~q/AYP[`SÈ#b{|SV|p.Kjyŀk/aeXOa>oci(ZzhGnnSbfuɧ֪/G|yHbg'0xy"A$n7GwX&^ow휴R!O.( إB8SsifB3xGe3%7-Hj8pQN˟w@^N]%e'B}U.vuM$/mӵ"|j0y Xz45!| }aĵhai>L$NTu e#z_(VX/9~A_P񻂈m\ǾTcZzB?lqn~U N sj'Q^+jOp ;c@5t #[IzfI~Ln "ݰk|P ǓtW~~s j' [~[xzE_p Ϩ{'h/O@.@k|G^P/ _GA^sՐI[h=PK="&/&7i!/S~{;e?wl+8<,Kb+UY*"y/ yA/oOh<e`/le~yP`,}'ПzyIC{a_*^ث\N4D;'H  {ʟKr#<*g)qmly9NJkB{ [Bl~yEwޝ3E=ą;;@zd cͣ:d62:=!qInNcIFB'MC2Zd5&+8kmHVWA$늞Wr2IۛI4?7nZ&dr8ir9a$ӅHθ9O*^RFrwɥjdg4)flnϝnɽ,W>t1CI!X>"7vJSIbsHRL&4h6~$ʛA)liM$A]%q;A#I>Ib EyfGC!$k]53H$&zDPHh6q(FSrQ; ~l=Ix~@8DyK:13YHddhw8$mxHG[$-sU{5w2jve$'Os)@h1I"Ǵ;;ےsUU$ecFI# MIMy^KہMʥ,!<'HNԶ0)S32q!ԇ6֖k$j_?w4>gSȦM5>ɡ|#q ;)Tٔ'Y_AD?#i{#'|$on4OE6*  |Bi6:\:G!⩟C<{|~/IHy$7PT+Y )O@|8y CV p܀Sq]FCC좄>y jg7 6L \kP_iD?zzƿ<xi7r]R=qY2J)_<Ƒ2i +kЧx|ȣp- HC0g(.b;hpyUsz}@|Ҹʡv ȡי]7 i=z)?P//?Etq@CJ6W| m/+is3ħb4(_F 簜`weT2jOO'/HB}et~&'DU4c~A4C?C> vzKﻧ G1+_ *.,šk̓.!7!L*hCC "!Iy !>S~9}\ y~/`ECetz)#B;AT^}:Hk+?uzͫ wa\Bh7,r'@AC7pD>㿍A vE\9^'@ vB\\z/ǣ)]o#0CAm`'G0A:Y֔$}".1ALC=RگX?|< '(o1eW~d2_~88Oָ1/a 0ro{T^O_7~g7C 7i=bO:<I j7` E <<q씞y_qSP?̯qJ? ?||LoԮ^_ Bgyƫ?}y"wa|N_|Ǫޓ^?ۈg?_^<w=?Ohxo?ˣW~w>Ml/]?^/*7wFZϟs9ʣmݼ㿍"'G{Ka=d )< p]5 K \oIS>VL e\ XzqåzK8F9Xeֺ99,gutl=za=} duNSB}uq=2=@\O;=ŷ~^Wh[NXG˖@ yX_FXw^@^ou"eGeuPkp?7BR=#ph7=^g*g oB>W@ XkZZ +#<֯aדyo{3k X ]>a>(}Jh}``leò` SX q4f(ZOHs@=`xO+zNAߠg/h^8x~Lg-ԇ 08|J܀o@ȣu*m ;G\\n!~B܄u}XZ֣y~A^w; wuv_r T?hQ6< l6a@p?{?GnC?^Xr"R`{"iQ_Ϋq{־*[ ͣl_;|$\A rB{AQA!O GildaQ4|_(0GY~ɣ!?X& Qq >ki<γ?1e e;'G1켄ͣ8oCaǣ~Y"Q'<)< ;k,~eO<_({ x?{, Gow y*?{γWb װ Ɠ|}[Yix!^|?gASy8l}<85޷>//{NF>Q7X=3Gacʧ3N'}^z`C-aW#[8~ ;`pVZv!͏0|${Ǿ-8ｨ.t 7Z?vȗ8[h}=b Qv~#(Oav v >u?#lyюXҲC zEqoVɞbsAolfQ!o`<ţl{{#[q ϳm7}VyA;eQ(0}Y$=N{z/7G^/ȣx=7A<bopd@>WzyC T6'}tD CS8z|=<ʗ7W<} rٰE=(k=^fϣyT{R< wQ{6FOa~^B`<~~mģܟn˯?;ktϷoV|?/n$b-6whyy6ז76}^ѵÅDL&#"'J-u7d`բԪ MM6mW~hm;!=\ksWNL-u7SQK12* Ud4(O8-Xlk:quK-u}u% affjXͦS Ͷm6f9mBM[^?4j\X9 ρb9y?rï:[Dsko721Ӷ6aS;kNP[l?/&s:r]NF* 榆:koW3j=l ';wTUl:[!<5?'ldM$?ދ1QZlo'9V o[M15֏5$Qזk'FӇi흹._W׽Ζ::r0J33ߢma;<1mn:Cmbxޟ=~?fLRTO#N|(qijqf,8?^c%\JxwJxz?U;s%?V U ϕηGA8}I.m?c?c0?IhCZS^l 3]UHU;5] YW_UYy%硞AMu6PEl66Ve/U 5_ i r ?4Kv*)(*"2^ >UݺP׿ꮅ(ZQ&?Ja8d{ aM^7i>;ѹņ59&WM Q؉b7(JQHQ,!QAqE9(*RT8wlE9[_S跏TwgW&DP(ߕW@2Fm<H$Cǒd-I;-S\FfIOUg:Iv}26ߔCJ;7|tt;DU Ìԥ^Zye9j;3(87!ZTq!4h!sR6pHS]#{z0ǧ9vV!mg`Eq> hG57 7qKf[~>:3{3To옱#\Zv wSs̔zPN5ݞ C3ݓXsV8fuEaLjrgfͻ?F.YKyNOCҝyYLKgG܍(nnPj!È͗ {z\iY3Lk 5$WW1%Ơ+UDB\{9,}0Eb8_M*8HNfV42ҞQV;KvNt]ly鹸S]4ȌY.qmif ]P!GwzQp(y; 2C"f V9n6>$p3TΝ5ٲ>Oε<_Uœ;$0奖IYǫ[%9i53V,zdktym )༜913ǵ 1;Aes/޷ە$?@#[IWRnўj"5d0ߌTė~8|l•K&)2+zXvq2 a"-F)SrG3 4,eV|nBYP1,vv&ˀ~'ux r._DSCNrVj܉j|P41hՍjJגXUeTt)׫XUtQ5sU{p~sV[;wvRNjj95d5*I>rv Zo/̟3;UzPyq^ћKMy1[a:J* hk ,flPuwO}'t}hs-hۧ[~;{N>q[neUjc^)ܺrK'S{R۽vjnB /<1eFf;V̽I \g칋,Uݖ{?iGTP7CfZzd^$3i}ʭD /{g(}>yQyJwbGa+k23#NY|c ;T{Fqe}|O#*kw`}$>9rFAsa1_<u5aS̸sï?g63n Zk1oRpFDcIBbkǨ U_Yw9?{-4ٺnK# c)qqN#>ldfZK fX7Ѩ=R> #7]1y3ɹS^Bƪs3׺^p)v ɜͣl$KXՒʐۺu9,Y9*+/ӰRO*f'+/sw3%>2>PW 1c9^]f4-cr+ K7 T$s;0;Ml/W>RR$g43bŇY%, GgohGqjD^+7wd]쁪ՔMY1|Uʇ3N6XNG*j2{LJ+7zSX٤G;O3`k0ߔ\敿tBG4O->̍DN.$V;W*A\/xM{88:>wD?!Z4j9oa?rq/}hoˮZ,~YH]Ig M·"Vڡĭ6kD1k[A34"I!NzxBuK,JY7 r2j^rv@k(2!e{fJ͙BЩ] 31F*(ZJہ9gKvICl-%F.PtL_6=lHczjَ93k╺dfCcQ=N b S٣k.c< L񞘏SM27ROyhx[E𓹖 a/?(Xq'IB.stZ+}+#&֭Μ8C дsޫo*\OPEj3v{Vh@(fǩWHDDcLH)bS%SL|S'0m$VlM*e8fL/E*sTf0[XrVp?,8YlU8DEEYfewxP;ױm%nlޖ͋ӹ\gaJ@ҨM@@pse1ic6xhmc"rJWrj1D>WG`?*(- qM3mTe+g!vˬLWY(mMk{mη$%s(96U#3F0'v2#m WnejIYǣNK$0Bhv'"ŭ%DnV#^y$YN+y~NNSȕ9׿>REl 9N7i)DzE‹rQS>˷{v!{f4Z!o!޲y8Fӕ\S_I&Y5OkU ī.j OlX<[~{CfwfbVoZht+rMDnMlC\N%柝\GcodWkdsE9,:p| KLmP@, wn[C[. mhҏ1Hr|(B4+a.mld6v2Qiӈ1˸EmQl: f ß0BFz6uRטrL^uk!vtԝԊ*e^,`gX놄Zķ% Y"[FUgMR,ܮ}r*Nm_?ZKQ5签r-$M(#|3׆cڕkfNw9x-"Ρ:~bjY.3.ǝml/پipg軓Vȼ?{#Inju0ZHrD]|#MGLg'|~}@]j2sQ펶:o:iD~%[2KUYJ=e֏U}|9B2 pUn@8NںZ~>!K"֟U޾W!cO&O1ʫ֙=F8:~\ >C"8գ6UL ON`.2;|!^94sYpEN .3K>h^luL\UڹZ1e*ܯ@<1"e971Ob_zJp!8CEkPcK. =_6hדXA%g QC$}C:KQ63ח!WX>LPqiT<_W[;a%׍uپqJ48KNBrFYÖtWtj}1m6Ha>~9_BS ڊob$q_pٟTqnfB2J2Tnw\p'DuqRw2'^:o_B}Ynƌ|g' [,囥[zٯGm<XF'_I*VF3+ϟWdi)cƗ-z%O ma%}1F7U+2n}W0yfY;3i$geymɨ'J]/L> s0spP[Oweԝu۲\}e =ɚ 3fi^B,v]됎[n{g9O-Q'7tּ^Yb|j¹|Jgȯ}XTr<л@sїWOa._'0FWt+۬:/WwO|ήʹGJ?X|jAn{,kNB6NDIaX{1So"1BTUx|v\9җa9N~:l|Qb"]흜{˖=i<[X!}w \ ^36WrDN.)kg5fp]ꑯH́k56v%~E>>1|!x;Ī.wNX*buBF&FkM*gXmx/˖^ pT Xg3}PUjJ/FŒ0iA+OJj/wf_LgZUrNN_HSl>ز271B]7<Y﻾z5D-WA*ݟF0i%3{{2b"S7I1/kfEyv`ZwL]8\wȀTK){'hkS;{pGň5_..Xq=Ͳ*U夻q]iqJڪ>ޜHm [cZq<%*|e8INhXeRm)g b}C/FqĆ'gv% 33^_z 'V쇚Ia_m6γcDjF''LCAT3(),ѱVtLa9+}6V[T.e{37X}ƃZ{ߢHY0w"h~ԇ=TYBNh9&i{~PQ-۾7 `@Eň#JPĉY *9!(&A3t793dD _wý{cUj֬͵9{t쓃SKS굲Uaa[Gm,ag鼉UQNM8MS5zԉoM{GN K8Iٱ%_G,ycDhc %M!~4XADP39D,Ɏ]* 0X@1_b'70:F.ہqS /P?l&{V!¤e ~̾I18GNW3$L_@|TJ )a\8%>WEgH7hڙɇBo Wd /Iu)0~/UqB_-#Lpj3[ʔڼEo *L2W7Ԥe-E!SWm dkl *e(QYǴMdk'̈p=#E8⡳S ܧٕ-I2Y@S999Q#} $5p̒LoK\GۜuwEgAV 1@ `pv$.O=a .ɾ۪7 f"לZdCΑ/)^ӕ"?eW,$xו&I"W2x &C'2(r{L]SkMaPGnhxG BTMɌ0-C]mzT $[&BUg~tthJY7-x8g=3-Y6:=ب0*–eB}p%gI 0-'o}!cOfu!+:L}VwaNcz!^}hܳ(HڻaGMqhvOLHW.x%b@زY/iba[N@kh˾ho#yR} akTEЪ/~ٗWla6A"QLnxV@ˊ{B'l_-sMqҀ]߯$YMx6b$Žs;T^-3ʠI 4vObr@dY*mZg;cXLؕ}h$S=[ }оXMZcLeک[TuG2ށ ҪnT4PҍõvUx=׸pYف)죹AK"GW-PK^-g5\EczY YO'y:*-?J\ݧ[ž2Cyj;ڼo ;g|h&=[ -҆ ޓI}ͯ{mS]]5)yU" >ʾ7[ A>Жֳ?\9)M(„]_Vk\c/A5 .=5ߝj&|[3cC>v0jͻ5llv/}MEwEoGywGJCWDhbj._fͬ{l 2yBemO\ ڎpX-U|TH _ngtK^|F)g)s\;tt.92xRh1rˉ-8^={lw:dla{eA&+$ܓLؙ{atHKž$-IJn~nQŒnORˎAϮ{u/MLt^#.9<{jG*GS6vf(]JHvP"{0>4wBcSv܉:I69a$=i C/WI |w#!>W`q%#k<3b0m[iHZN=HFXkQDԀ2"PB?e EjvbSX򞐚{x+aZϧ5Hk8uh$LL\ej~)v*ńi'U"_WvHO{$u?ӘwUeE|PiaŚ{>&,_a/a'3ucFʾ0߄JaKwX,#W5`/s#vC듍wA{ˡmJ"Ll.+|r놄ʙ46&^z0><3ɦ yqp?P->_=ߐ0~%ϓ"q&]iI;w;w{:H{>^FR!~UeP=}YP{r?d<U|MH<\rf;ɧf7/!̸i=sܛl$۵9ܛNy콛993Qilڌs@RΏ.X7ǰcdPCb^?C59V S¾z;V~z Jw`b"a܏ y )k|Z nQA\Ķoe]@|E9za|KՐ1OO;ɻ m`aә޲@j b @ҋvgӣ#n(Rn0 &L1̓ mlC;)o>dʺWE#إ%+xkk@CE) j ^Hj]R.$Z%KcVb?elj%(/iWT sFؾ0fwQ1Ao~hDa~ vYCcW}MO~+kojw@TVv/n>A"kE63NG]T4Lx;z/evxb\o>d`BM7C숀`֨9Ǥceu}EyC`Cm8F-"$/qbGlQhEytsJ>|$q4Do{=+Yҳ[L0{Ro(څ#OCFQpGÆ: }^0 &l}/4T'ВCuʷc%uJ].{ >X^a*M;3&}jH,۹;ve:]i109od·.`LY7e;v\oȦ 8)=dz̨7}Bm~DŽ1w͊Z7F=do!&I:#;%2m<%(92캥.7+#!2{6JGkz0}`'&tj aNaQnwswCjxSm8F"x0-G?c0’ϒez|PWu/$' a .u4"( ٟ$rt,Gg-OEae&&ؾ^d8t:͜ULQ#,{fC6YPj=yͤj}ro#@5;mQ1Xv3'd NS:.w241Z˜OÄ/'wϵΆǺjQ3FQƄ~F W]~ߣ Odyh+&PԚLF{wU윣s<oj(mѥy '|uU CA+fIjc>3uy'&;yPpt`=od@Bөwkyr!?\%(TO80+qɯ,!9 3i=o Sppr*$<99=,HZFʻ'ɥO]մ04X6A#t E`ݯ @'ıϥZSMTk ^vٸl6abQ`*$X,Pn˜s 1 ړr妵Q~hU-/mfyn/2Kj{N S_7PNG1!y_'!r+aꨑAe4S܅CgT +qCu܁KaeT~¸c NkL_>[fEͤ̈́4)w#G-nH7Xoܸ˸=N)*$ _OZysHo]Ҋ.m}04ڧi10eo%SU `8/c ixG_w:g9㐶-cQ =js3|Ԫ3Ge)V& ^70.ݣs˼xV_熉NGH{UaV,Ծ}#3>uCGqː=!|hO|6 ҾnR@?051>Rnazf[ _l ]St Sh]CHY4raL!mtm@T$/(ezb vj7l_f Q2N?.g 2O0iaG3Nv/{a c@{C=sĕʹQ)؏^iC tRX?Vu %M4xYXq8<^Q \nޱj>y˱]ְ}6GUqSgOc+v9k5~tƾ 5TZve J18A fN<͸M$mŢO~4=Mo;t/v=u>Gvf,U4ktʽ{:MevGoi.O ⊷v9Soܠv T;{<΃V4B|ibr&OfၪQSᦷP{wyxcCj4\߇t-f unk J}sF?3i}S*Emj?jw<3K [H9k]fTKD)\lk}Z˟pmWDiۡM֬-Ƅ r{,}Ac&PtYKŜPT͞>r:pe4o ?~A}4'm_h4 :_~{*ws%/Mgehp}d\NfpFEx=N,fG߼nT9$.frLeOr+k#T9$LzvL@E'E^\e;Α'/Tޛ%gH}V/lrSyC3&p{}vAӶdߪ\gyf EobߑeviJjt1-^\xj'*AUF٤uFWr~{_1wٚy\6OHw&mZvz.7W ?x-. f[S_ۨ_/59H͇zuM@U]QM߫&aMk^qyO5.yrd%YJPIg BH4n$. N 7A3KG<)DI9KCC#ۡylN\l`xvn>֑sш5Zۢ'0E|=߹.-5E|7mʇg.E]D<4Idh e%~UPlo+8t+f&Lfw3GHB|2ѷg *-|303a~3"|rp1؇3ps2R>!']k;-g'?\o1kWܷ|2@V8bѐv:8ħq;s 7!Kǣl=!l!E{/ެSЀk=>삠-T7k_r? ȭ Vxd I|r]U{[H(@; ^ވYλw ́EW;w oʜZaq*||o/W&^ ,׿)l6OOV@%X (x'jtg78Pf1k֬O? U!Y s ;%9Bn,HFTrXci%{/W3cpA+jϬ:HEHewSkHAOf$-7hk!s>n!ڗ {Ȍ9I#/  n@aQ|f)dZ>Վ` 'E if2I>ՖBr+}m a\3[7Y ;M @`ZE'>q}-x|BDN>V5ow@ % eSA9)Գ0#4"3b=! E B=`n\%+܏|eŧ~T9 ~GQG,,?3+BïH̾9r_S ie[Yrb?X}& %~> 4d_ .ޟ8f D5y볇Z2l[ϊ#; au*_[AgCR ?*;vnofgg^Qbͪи#>9 UP _~jǜS=sc}!q66}#,G~&^eFiX'71&4Olp*W>IH$ݏUMHyZQs^L`wlH ۉ@ȮnSot@Ĭ-A_&C)ح5hS?|A+RYnQ x nh ,7 hb'lGJ)G?n&r=rvZ]c f ϰ?vZ6BkX^3mqKѨI'/uBd&YgB~E0{ cYi%)01=ѣD#)[X/bxvtvk4q ȏ$:>NeUl d IAuf̣fc)9R7B/{uU!E$V .q~)Cz|&%u<]]#6.H?[I&ЯM=by͑l' q,$⑽nEt#ַgS⧃rj/ћxGGOkwL^#OqVo3;W)l<53 'Cӣu|bƾO*\qu;Lѥh|ukךi0l!UϒYn#iBě/=A |{G8/;FPE# 3S?R uhbơP kW4^w>b! ujDOiq襨-&RAÂ?HXjRhwΝYH1_ ?$  =G_BP6)@';ĺ:|/} >C?u4`D8ڢLw6i|1h#◰?B /=:'?$MҜgp=`?Iƕ,diHb}gSom*Ǝ[Yv<ѣ?\ozѬBECİIsZI?Hї0= ߧ3{ԘT*dCV,f! 2QO {b Eq>+B,;C 5\VC S1lYNtpDHµů!]7h]h]~~37?Tp>q(bQNw+Bi:4h @v[BN#u 47&r$< @Gi(wT(cŴ,73u#AgɿF+jvk, q%bʱ8_ uIH&~i#/ꗈDH}|x@}1ܑ[q#<(Uh=kBvd~|Np(GzwO>J?JxA.QQmiBh#~_ X[1=l *PW>#eUՠנC^y:GWS9_}ۡ`j7#{+Gx dhͯjмGӱ2Fr}zPǺy74PݾCFPc5P9|4[>rtYf(dw5(C߫@vP.9\z4r Z=P0":j~.alׅcƷuwA=NJ!W%Hߗ"%Hy qƺ6 '<~q1Á Qd Hg~d|!jmLH@Hwl5J2Ѹ)#hSQQQ}屫{CqlˠUg^>)L*ط)ȱ/.uke MvB=ҋT ;D=<bOuCG8N].+g4Tɴ0_)u$BP}>J~qFj7⹶B`BqNktB݊]V_d ?ۙ;HGW ]Wki3(@\K%q]ZLZ5(U#uGLj|F5 PžA0\9~r4,EY⃕*PR][zEDz!ڀtv ԣ4"=YƵz'SD04uT94vBv]@5*w5_*L"l 5,5'FPo5ճe\h@S;lƠߪŏ6@y\5oV@ңhP?t\~KvC_8d\ml{PMq\;N5(NYe#ǹRJjF.C2Qi'x$Et/G1~.B% s@2hSC:;{'RYGW%wW@j٧P7~މ8=fI,wCEx+=Ɣ:DC%KNg@/ @yWs2L~ |v.1Z׬E$vlv Ќ99h\ODIXa?ϥ1,4l^^-~"k{AEeŠ۠*иI}*AgQ]gՂ 3=kDrHOX޻Pu-h%FbFR6T?TDUhܨiH/usd>8Cz>^|%H7V`c LgN-3QT\e*BNj . bl^CqBe ?Ԁ}5y>6zofuՑniE]:jwj騟 ҿ&6:jn@vUCӌ ٘.1l2vQZj챀VtM&mh:q%Q?mE'2&0~EGȭɵШ7U>ldhF )iZ,% ÞJi*ʊB5 7B+kRt4>!و滸Qo@FZ>тgKGiف?ҟHWgvB,A:Eau14#d}ල6;$A.r?M~q?nB:S4qt!h(QGm54leW 4j8wyMAh9ESA w7z?u -%zR:_å,hA}š%|V Bڛ=az /U"jzTߍ}nfGީYpE 矟1,?OyZXalV{r|Ӂi[Ͱ5o~s(GMOMh݄5(S[ th~@^ z.${ Ԏ>( Cԉ_qfd-hoA&]3rAs;VrT2R [X,9xv|0P#ƧFݽo%Gg* Ӫ=_a]u}7T[a(eВu::hEqGx 7~pңD:lm%X'gvB.F]_CL3d(DW<(^h}93< %vY2ctqi#:#myam/2^yk%_W+Pmp1iwl54}+G{뚲jCP?bM!vN.ֿX64:QKU Rw7BVaPƝB Q|?gmn?'~dz Ϸ~G< Uق(Okם8)w%7-Y#ͬN+y % M_J-uڨ ,7Y@[Z-h04s)4]Rp*wvhFm'~@sUC)絸7-QkoyY ۽N&k i}Mlwd\'+Q؏b?׍h:d DBteI9s Iu-r˖<Q21{OT}{xw~e3oEv@qH$GX9xW<0` ;úg_1[.zu0DMq\ {Kũj`s1@Y'T{A+ziȟ~t(鴆VBKC&8hlq~ho7`뽙J_ 7[_oё_#C:cљ_wѸVM"Sh~Pڹm#4Cvvz]\:j{癢tS "\g龋Pkۧ'[Q^3K6ҿ hlDaG?m ˓49ٟ .H٥y*4m/؞נ{fuΨ1?~,\ctrpܫ?U};-/mENU[CYhdˊ+д+-h|"ɫq`9>Ic.j7PƔ.MY|7f{´W: d;3k߲IkUIqR׬^{;{S9t1~vMs&]kAt` u:KYC+kxt/1|o_@7]fztZsnr(dOOQ1$)&NGq6ݣ- 3HGc=KtqZT̮ӘW. ̎Wm`^ #]<G%я~여GzEGq|1E1ɸzk/SgxjwREvڌ Fz6q?ߗ/AH<=O)Eq ܀=4^~Z|u 5轷1~/M=AM#+px{2lG 3&"~5n@qmt ?:wL;g;hhV >H' O0кS)XY1Pu%oQ轕j!`hE:|:4) Qܺ!bM(?t;׊D:Q|O9+*,OʹT dxw5;Yu~i>5dY;gNc3QaO"5]أG:[vv2Y0yx2s<3T(JEs=9DG {c h@Zoh}4Zf_";`Iy<*t'c/2;fHң hx4 =]=J.]rJ31ֆg/ǣA,W ]]~3Σ d 4ItL?zARי~Zp1Am%S\ǞWU?'_%?6u wbA4f?8ք޻-x[oq!qtx2s^z]~_К@wM}KFj'r̭~.f$!`&1ggq7_.@1ވXG׳~hE*7yӆ{&&~Wdeg#ݯ }-*{nBk56}`7VŴrt9Wazk/_?ڿYh`=L߂VqܲwHm-GiE_>~0 3ӊ6hyN" 'Z:k:ޙΒS?":z^T;[%T}o+GKA'mQ<B,ah|Bmux=/klu_!p(#z[4>uH'FzpYD#]Eգl@oG:0.Tw{;~B a Ij֣u!hxt⶜)o9Q ߏg}Pdx]m szPdGd'Z׭WuQd=z,G2$h~\~ KEJg%|gY߻BߎBz\n\x:S|ۀZ%K_QMzyY뗰]"ݏs x<`4Y'&BvOo~ ~ hOBq l h <Ax2nO~x.o5?zly$~9-{xYχ "?FӅ6/~ 1cف :_*x=02{S+PhUQ5j~~ωEB>_Z+ p)NYx;E*&RkxϜ.Q4OLcJ'Y_ś,?m&Y?o8vG!#oT/x](y} {n? Bo]!B<j`8Ǐ/Y53uh~Oz_Ou>H~׉,x?7I֑Nf9&_z&2>Q'u?י}+nPSJօƹ<LQGqk?ާezzg^Ley<"6Oɧ!xY'/"{|3 IZdȞ># ߞHeab}J^؁nRNo'x:Y*_F)t龝hp.o/DI9'Fhlx.^yӘ5#">.?J]:^hop?!~Szׯ؏uZ?aq%#ǿx'Yo>ִ7w-F8 Sx]}|SS\o?@Wo/Yܘ5/G>/ݾ9X%9 k"'W(ܶ(ȏפ=Q?/<ďp~4Q4Dx ȟuvx 7?ާ*CO ꇤ>%7{~'o~cJg>'7HApY5ɺ8bud=(XGY脒u~_UP|&r"}=ُC(^X`?כuh+ Gޢ굘=|ȼ?Q\KH?}4p4G|ڙQCߣeM'n7hNʉt^/׷cz\v<"Mdd8sN"~`?h%7 OX7GRˁ+?kjAW=엁%QֆOW%!~^ٟhxlocA(ԣd4z&<~p|ˏ;ZksbZl|OxPѠ0KBJxp|֗L*@Yg?p~;ޗ"^Զe׸惾H`Jt} yٯ= oG'G ~X=Ⱦy281KtǣB*ז02m ^EOxL$z7L\d\}t/'>>l~Xߡx\:۶_Hs\Ox\l0Ӱ[G7,Cd|BQG=C5EzkQdyޏzRUGM|TEq,磸.~>ˉESF⧈Bv/)ApD<αA$}k ..Dr9`~_>ξh} 4N}R%|߆h$0jVO9~'ڰO?8b,i[VQsa'#zǸ?9>SxD'~goC?$>p Q_Ϧ?b'oOTbS~Jpf<ѣEH-o6 Ǜ2#8>c/$Ql(>*[w/G؏rfh(xgy4XG`D%o|QkL] 玴|1NJx4p_GEq}~x<'"./P}qMR.iGϗ0LB,ѣ(S8~)~;֣xg%xOS˙N 8^u.:h'G~ӨވE'Qm˻º!,ln c-a=ui6ď6xN?`=G+uGqOEǰ.$G1hg\bd$00> _㏡Y Cd{a(?G~ry={rd_{3]e~ >C?Ne>C? !qCxX=?H&, HK:5tjЩSCN :5tjЩ?y  OcFVN]G0џJ5QJMI#t4\℁&z N>;3\kNVJx_8ɖIei8#Ɵ~bfdhi|LXHϜ}yhwLOܟ 4{9gȷxO?o9bl`ldnpSr#F <%?y⌑!CRNrb}kVpK[R>5K'd =?ܟ|k:IlnvҐt5#fS]X݅aߺhސ?il͋7 =3#/7D>g~23 }g(ϡ<Cy6 5#z֦VI68qZJﴞq0P9翜1Gi@s :̒نGذP068JZ15=sVYd1PPr ÷m-1*F k8BMdz?8(>Cy!yj?Ԟ.zE,NzbXiY#oaxg#Ld~& 9?_:$֭R#,? L8 3 _3s&_e9L87!_dmӟQ30O|F?_ _?q#%5P6?a4Y5ai87lxDYn9g7dt[/R2 2r7nQ 9?9 m ,jJy XZ`$xv[TKX]'$`]otª @8q* وs!G\q 4 ,rrpC*P9_+'򣿿r9 "R}hmRm+ns_kچwƯ )֎h/&Qƈ1>1n۟բҠ%n6vRM*hZ%|;hӊ1t`O׺ H_Ϡ]\rrB8ŤQ~s~B4g`}M߿S;{O1[lDžnvK|:4d}:re%V(zR8 Lf"lvc"hC[:)s.5=z msӻ˳iN9CUhf9͙б~ȷurT_u襌SÝƌTџ?_s:&~22^t$^,vamE·+2}3&1zt RcՆ;.߰ fPګfB_̆>5tBL%Ʊ*<%^8yfoc&? )k[vUrؑ@} mu5msO3rm.3IyөmoTDv6&lslR֚SBQbvæ_GMwgfRwbB7v!tlA㳀i#/qT?>[.ݟmF Whq{=_s8`w-[`dܭ^z:v6lL`-o];N?zdI@qg.C/KСԳeEiC{z 易tYԩáaʶ=e홢ڛm<3 {Tf;=k7b@{DGZ30/qSAYn{5Jftu*! S\y#M ;Uk37dn̢/ ;ˠC= [}L-#>v3BQOB±M.ڝGsK3MT.ҥ?`ӓ#X.9V,]`%m6=if61ims0caTÍ9.~ h 0W O;6;[h2Y;SCigCW|FI݁RW l~3?u?V'd<:m7IV@طK'_,d2U1#X5e8VtH[y6N+w$^ho{xF t%yJp)hv1wttQs"l*о>Fе&@m6,xʴO/QzaV,aQ|t+}zKPK?j}>!ӽkt)[m|UNw%b' !ˡOaؕO{ }&~[;o]]-:7konS1a[?|omߵM^5_֤L}]xa1 !|~pCw98-Cpm萊>zڎVֿQ'lW189@[cH a]u٫1U C{Vh?U:L6/>3im^[P#ɺqd^!2 3G&/QNȧrJ.~I{mvë~Q7a^:'o Ӡ]iu %l놎Pjr(d*tG_~5Ca>:t,)z$k/tD<Zb-_2s>f~z{˦o3[.H2wI$ 4Zh˚yޓ4--RDIt~tyv;|_.^"H5!*.圄0kVvd*62鞝n'd4O{oV=NZ-o'1AKBhw~NǔׂW7@wN}f@?:Hrw0 Gq9Z; 2hZ1^7@ܬ/xᦍAb?}|*w6<~;JXo/w=㏞Lo;ot'Mƕ[Yfk]sP+ȚuL=`.>2&طyB[NI\[N >?1WuMg ^i}s͡;=8qrcWz-KC+e]{GLVgnƚ>ӻg\6Bks/GyP7vp)P'.)vtΪ&r( 2;DCmqcu䘋0>;]V1BЭc~}v<"~_ :m}%Z;(om0˝ίus& /a팱l\u ]?WNP:2,W:&}9/Ax&??r6xjЅSLjÃJA_>*B@v&g .?bjāSfArHYn&;B煔KO=o/Ac (=/?E`HHɌ5%= ھ>|4&,*n!Ҍ0rDil=v~HX6y1 0Ahsr:mq翖 cWSk3fOˆԊ'OEC׈BR;BsçTD]sNJoH9%Ϗ&aItwT\ഛ#WIؘ015`sp ݝ0aޙb\H;bf俏0)j.<rG( y/{^BÕACK_ǭI9=^F--_YsK߭/3nY= ߝ'd :+aaUR?DXi{8,ד~ mW@pMU)23iďQlOsõZzL 38|td,HaW9 KSc߃_F !yӕ:ww?˩wA3W8 8tAZܖU {A?\4zd6E+ >׫&, ܽ6݄֙ȳ| 8!Q=_t!{ 1>6i_\iKnݓ\ ~|%L&O7a ׹Eypu 淘[ҙlP _!yhOsc !mҤ =YrJҰmQ-6nߺlT&-^G %E! Sذ I|Y I립L³uJp FhPuK.MVH[4(a4f0 $QI_Mۭ|iI ze8Z:GGԆ:9vW٢R\~{ѭ4%~u`H3}}INqDGHq9{{ad5CkJR6:PRlt ]cU4>N],i7I;ҁnV{fAq*yA9XȐ]`~;+ ܫoAV,#[&(9+T!R,p5‚_:7P.Q!aGkkYw6'2 rnO=A!LyO}. BъY< ̹)I9~6,H6 ,{Aʿ2 R1~RΪ$aBN*!+ɭp䖭P\0ps\t}}4M]nPapHuH4栾Nq0]ݐt#gQgy!_(}Td,֎w~@yr]'qFp|W(Կqo`ka־lpRs팝l 9d i2b[-Kk]͠C30rMY t^@+>I#cG1~t !FX1?5+}Py/pO%+%4]t ,1J\lDN8HzrwsSrE VݞjΕvE>]OJz#|=|vXWzO=۷2I#3"sm\).猈3 JOR9,Hi^ϕfs}DepոRRxe\o4IB=nBf*D]J/}$q\;p@rο]lfuȾ!` Wz W͐v]mWz[JG׹3^[kV (&6,\NE i&ۤp甤/zr|s+sg8Zac`K 﫳S*< '{|㶿uiS!YL];bHرrHׄ+=LZ`O ۛ+-}YkK)<$e+N 4j=l;B f9}Qx)ퟲe'if7v,=293ٸhWtt %ݺa.a /S¬Q8zQu'y?U"X`HOZGog᫱Veh]n#wbaъ* ט-CRnFL?7'%NgS!oAHk`UK f^ž0n_Xa„;:jFƉ V0v֯q3fg&x" V3C!a<:p³~P|(vL_Dp+ rt/Ԓou- wڗ$pbU)=PQ& nתq)sp7Z9ٗD8Ԧ̹؁ÍΡb;_kXp0sïl3Ȑ<-e d} r2ū2Ih߁R~ +:|>lمWUsL&,6.KR!\;쑚8%ݮ&j' 74]uO*fVAʤb&P#~W$ZFF F{2؟G!Yos0#'} L huk:aVu隄O+^#L~[20KZ #dg,b6FQz!=QID߹S=ո0VHpai;NfFwJf=? /NGMiga'3GlKfeP:ՌCr1ame)H4WZ0/o¤EG£~]L!LO,` !|-c6:JxSaJSϑ!mե^n8>:HѤ-~mw :I8ayysF$&}q8H9W[+"L,`d۱G!G'L9rt:T(i8$yTLcY3'=c37@vZqߒÔwWK?S!dT-4Mw"lFqZ!k6mchz*]d9qGڽ:thot>ʟԙW|፲[zn-M11vy-aUp@Žt+CۏIVHvXsWCAW C ~.60ᵜKb-9T3[5uF 0_$8?ǓMe4.UWov*:f=: _3V?CE|SѳA>QFV#wn 6QvrĮ꽄?hWOPʉ!LbbB)Ʋ//!yVX| = LFk)nݚ ҡD.amݟ*k 9.Д E=9R-McMq"laK#常z N~^}5{QЧziر-? {#}iNا|߼3N4@w:IGֹdiĕK9tH98m3rZ~>ez?@G:_/@BD͋giQ7 ;v9}"8\(<̄Ǘ_tC~ٝg,;қ r8bW>hk`rlh_g,hgop+6\L~a˾Ց9y ;*q8pJ?v/\0AUaGyʆA׳]WIm0n'w in@͍0NݍӄI{=Z=剉B5$,S%7iAs*K~B3ŭ987)cI&L>ܢ0usWe*^i4\55aOw5֌1!uzi˼= k҃3t6#L9ÿ0oI(^V"̈H^:U0sgsVު c~FBв@-.1U* "3~An U\-", rAXsGrC/ krgJBQxNd(nu\X0W.R ۔ WkϙoަF>pȳLVN}2f.H)kBڊD< #>MYl4h ]f~ZA_&sLֳha% rߊ*<97dGސO75G& AЋI]3{͢]G nO" ߵP`i+[3!愡5g !8tkD7 Jz -b/!;Wy>T'~{Ήza2~(wKr89g)(QΏɯnӄ ;k-]bǃBsJLӛuoau`yLux~^J_s?{^{BӴF͘)зtƲ/yJ3qyF{ߋJ#ogjؖQf2GX=/iV-%|霴>aB{:!-^'A3^\FcQmQ3!J4_""ӫCQ:!u/Ӷ@ɦ= g[}",͟9aEO |ާTVIL:ya9o5:[7+TZK\ҝ㻾)Aiه'' BA yl@VyBg4aZy)Y}R 3׮NmtzFaAY^ǔOUfv -RC?멄yuuq}@Xo2dJ>ThJ.}FXb.?k!aI܈Nkϟ1z.ab\g’uY'.xm'Ra됇V~~(995sR,S)Ui][&AžiI&2-m9ۏ(_})" ܹxCA;B}-b aԇϵ{6?x._vg槊,;Y\9 3w_s _p#{ۇ=$ y$>[adfC% 5.&y8=0fTb7-;:Mx(akY SY/J|̨QM0Eyb6-$f/#L]; :w?H7eU/:=4ARC Lf/I-q‚#̖t~0l1l¬} j:͟D=!0tY:[>k4Aw)qܵ(*pBڨ“!O39P KWwQL+a¶s?#AH3ܼ:0КRs!v H '>>)$KD=<*r]\~B⪦%T˺ Q"N:HH{YsgBx;}paik4]I I}A5C1Wvl  f}&L )_JHfCx`򣄔з&N/>EHwnH¤(I[i$$10{ )BJ`-DͼaHvFk”MmN%Lԕd" L~ȷ0c L@wڲK'*"Lg_(O׹P&=x$38~T57$G~R6\>J2a3}T~KTL¸C| &,90nƛ=8Ps>aޭղ;!NZ>H8tlI¤Z3~ ɇLs\W&\(xid# 'u]Kx.!-ɿS7i¹xAr:RȜ3] R'}E}M ”5F&i cf m,¤"&&Wy80u*k S\~_'eD37S*o',(f55˞n?GU{Cauw ̻q[F!JԺ/:g>aVlT(:Odٳ GWzB]1c%}|Qm"!|*B|I- ^NHg|6a,2 !Ql3cz%O;GP*&+ȹʰV} V)?x Z)bjrhrJDj ˤR<JHi!S(Ɔ0!ud<:m/ ^-P9o $=B0 3 _J̣&įQBHI<$a⌬3 )wDL$L>=n~]NK@Vǟ JmD=ݿ4|,丏'P LT|?h#TV鄉WGX2e/Ճ<̳#1>ע0xL%:+=N w~JztcKO跃.mV4x+i~g~l~ 6{q <fgOH9p>p#(7;O?jstk =3UgsLj9׺SMi/ts=.v% "t0o/3[V n/`O]<9C&m|&VM ~o^~Ŏ~8x_4[:F?崽qpyL&l {գin[ ߯ss~ -*|77+Ry%zcu~o踜*sm>fH%*6z Uپ0t1\ܲ ZSeڪ=J\\YџwʆORx~ŴU6>{WE\J_R/frM֫wd~=_0K,-+|/J߼#f?3]EKv߉Xe–f=c*}FfVAN[?3o.) ^*M j4bћ!.>>f _|G)tk4|F؇kVoZ!?̬2/sn+ \}6tJB;?>*wD#; bC T7! ]2QfXwJI9PzX]U{[RN|}\Oˇ#h Ս|>3sT[y˦rߚ_7fC rB᫒^fz\Aa6|_/c~pGvyop{c|}VivwcnqCzÿ#v5>>rvx6g)/WT.?;g CPpl?+!}@݀jvpAO8Yx!~~Dv {vk5?8>]vd"]b;GpUK}cB3ӌ9Et+A'ݑ}~QMHÿۏ7>yy8!&֣T0>bYS`XmJ5w;g+X{Vx18!5jH84thְ M'Ka _4v|@Ā,Y44ųO ZN@+u{1oH4, h"}0aQ"qH?ٳDRpPa ).?xG9PXq1 G ㈮:ǺxށHyB ҉]yM ?<ױnGae5pF R5ʧ>c6PcH'E"]t&Ő|p{cDz3p{"0Gv"l7H&[cgh~70_;v/I쎊I`Â&H9eFTwr.WoD#NtB=e<$ "nGܟ0}~jvnĺZp>0̌7IW&ANCCE"!=:!qy-G:I~!DۥQrSk(E"4>!Q9~ "/C=B)+$o%{rE BC %lY H_D)B:_R\7SC? =to8ֵx$=\0Pe#]+Scx^uP}Ӄ D|r"=&lToǖ!+ o6?Q=z,d:a\DYH?g!ݚ#Q^ӛ? / {A~]1RnNeM!]}Pa%*O*<7vEC>ih>QlHULʫU2ӡµoْPn!{D ]9?ήBvn]w,5%‘>E:$8\+Ͱ~$z ԞX!:]/PM%_G*TuH֢|jQ*.Dv^۫n|h^TUUhc![TG+d5(]ϊ#=_ʉۭ =z_P=yV1#?֗?5zj@:ft]|\H"XwEqu?p4lͩ#KsqC׌M(}یW3j*v7< 5jP`7vnFv،o~pz5H~s !qCȃ(GZjEn+ ]DGzwQ#: q:?h"!KΣqw9j oHysjNGQ([P$P:-(JG1Б"ߡQ zO:t_h\o@X7mE:(>,ЊFhфۊu|rB>K#:_C: *P=Tz }kATN^u>ntnQpyoD{Q|̿salHOy@[~ {iE#;c݋3olAvL;t4lF%/?ޚQf\3G8!?"A2eq c o>c < |yaq\Xr"}@{86<)I=@:됸* x݊e a ]Ch%DҊt i'n8Eg<;[QO2:_W5XWywա9NCe2nx3X/գvCz=o==Mոq} =FH7s__#D:G"u4]+U |#_`׈ڻ!G`]ۄt/ot]|šqܸ?ot̻py| f)3`|}1{F7kspuhH?@~E z.+G=M=:ΏEop~? !qC3~h}CC~tȏ!?:GC~tȏ!?:G8gȏqCD!?:!q3?ӆ>C?Ny>C?h=qCGdq,?3ɑz憇d :1tbЉC'N :1tBn^0b st, C|(:z4sO&jZ_IY;ikZ0 Dr_oaI`zGqk J;E/YGVdKÿ$4|O?1324>jGr,dfg>P5M$N67;iH:). +0o? n4oFlQy ŋPJOꈅ"l3<0Gfd &Է~]Ѩ_4sdw9IEZ>@2__ww@24^U=F`oXᬏ:'Q3'jKil󈹮byPBI^ vR?W_ThifddߧeQNEbջ,쩝~DGCe cֻ0?GWI9,{㏑R#No_V/? ȿ g$bgQ51yqJ\zKӥuz{<=jko!S?b%^r>mnKr=􋞦얝ywY^^(3cccyY.M $WexHVs@ZIa`>xy+audΊ/24~L3RI@2&2ZGO_?d2Ӗ_ ׃g_K%W 9fyE?dQuK OA0fAHw1t+rw_#G/41qFŶM1LjBL_.V3-=G̻\P#{jX1Ü02ET3S\ZSO3YQbSFNd4)+laֵW.y\Qf?*~%l Qmy㙵<);Y:JfA[fmJG2m||.0kss)wD.k얮̯[^US03fA&a7#c܊ÌZ[zUIrh׺;ݙ!ީcSjI*FZ-ݳCYQ9YV\Džr]SWUfHג B)!v|N VKwFy|{($Wy˾̭粝02#z1o0S5V9ܮƤG6p>CBBK*\uȚ fl%Rf>ƌ _E%ʱqOrѬĄ5|/;I^@oHi {@K[>=fKM)ԑR%!T&5 zOEk$dvio|>$dYRLo_\lԪ$ c\3G]b;/,By&I]]p@-o%Owf<}1|=/.K҅Us$;WR/S¬aIZL=ڰ~Pgw75?V3k&wf^QN0~&_\$&2OF"׏,Y[ w4Lb䤳c[Ll91šǎ*{䷛ND|Wa{c {.vE*'WjiOWVyHq7D8#uX_z<|\7*SO^7T,(pgj=RIW d F~_ly@5r_擋5U:w(/1eC$9Zon |5J-0vlO`2O^[?`><pzsn泃& =\Z;Y[@cvh9¦ȱptÌ^ӱx c*DX)~sg4E˭^, B9V9/"r!8Td}:dz3G.MY ៻I~sOJ=:mN bV|=m9z3T!Rqp#F ̡͂[ޑ&q-5c,Mo߰)XfŌL]D]l:}1(՗St_G{(R;[GyMMgHi/pW]}7>M08?0[uôH Cj_yj!Gym+v됅:N9[RITQ^v嗸Yfיr7ẙy2;%&qo4.?9@8{^Ϩlb҇\4Be)ѵۏ^rL8_ƬɻTS2GI,aLQܺGt!AcfEkFK'̱e,O*KZY$}͒Yy~u̓r qsݘ 8(_dQw%Nf˽6(;Gyf؅I %% ^-z,u2)֙q1?agOI̢GϺpȫ;,1Hm\l09xomf1YAGO 0_Q.2饭~Fjm}Rf2S#'r\c~EdNf-rɓ|KYFffrUc3]cV&}Q.ŶZydYaE@Z|>4W}|x^wmJ2Ӫbɭ"R$\T=h8u>w{VBª6otyUܵ[e0Jdo ݣqD# /PNk _rզ\- u "*޵j<쉧t6]ܸ͍$fJMTv>|}jBwN]kIػg-i'OŒ|./&\3 wmvpS6M!'b@Nfic#njƬ+=k0uf %g׶|,ݸ]!F)ktS`guWݘI':Va&]f`F5F0xGԵ+֋+6wƛcSw}{б%pHʩ>߭Old3}㍬#hۚrޗNv2mKKcZ)u]uw0[:hh-.9 v1w^(}g"]qinϬ{| t.h ӣeOe=`l/1dg' "'oq`[xs/#}n_v93cfk/b6 I_b+ci8x (#+mqs?1eRG.\~KfiH&Cb ro\oiv31:숈{ 3`cv7|gd]&;D{0I&@|\Lͧ#7,Oެ`h&zRrD{3#m~݂Ba[>O_cL甉.L祖ms:?pK4}(Ѩi8yinOO=&<9 =r9ydө ~PɳP_$isH5)枿>]Yus3T’l`ec̹$VV\Lz0ԓIڻaTB}rXr\]U"iisDΖYd`o sɼ0Ŗ$09Nd#6k3}:]G{:-Xn{=]#gAc 3߫%wcv~Z-8]4_岐̹;L,2{Gw}ğr\.aj\W:&d&<̞ ˻ꢤ.Br 2n3~,?` G}BWg1SNuo˹]aP#6k[9.bkc |)Ֆ̆S;C&p3UFdZ鄊Wm97?iIst?yr]b Г(_)SF)/`d={##r$ؿ-]z1U8 WXmc O.$|ݡy3\O2kF\^Q~&<';y`S[gIy'ewޝ,;AkalN효1`4VXPԟTM:0Vں/i6ɹu"JMA֔yhzdXȺiʶZ ֮yA,9dǾ2NȦo}EKjo0!ZeG4Qlv^eN_} $gJ~2\"Fpɏb; 7 =6<МEV<;W"nG;*LDKì仂tHdRO 4-By6w/ৌlsVxɤN祒M d#u6~HE6y\q l6eHʥ@v|+9W|;ddrY)#g ~Ϯ"Vz#[V F6Vk,>sVd#O7v"ux,"p!͊[9 GGɑC$5+}x=FVXm={YQGvBϐB:W^lE ٳHT,-~"d 5-qbbդ5hUR/|OvQ;6 ky"5{dq߀r6kTJKdnF5N)?rm繁k# dx䐺F RS&Te:hƯc? 3M=L~~Jo2f5ŦF#␱oJڃ*=oy~wt 2"zdӔ_ 936,20'#o:nA5o_1L$qi2}H{9e-G?Һ1ȃνN$N0tȤgyuhDŰ$jT1#Fs(L_r84Iq6)fsߜIÙ{C}7E>y$.N=W撤 V7ҒO-F$[} Iz>9eO"3;+.m2u,S̳Af$ ,@f?ugd.ӕj~$garŏ$( IzD47?&{mjZzd~ +?#O[wo12i] 5WO~<xɶY=[ZhS9^L`v6qZz) ],e֨nؓȴ'AvK q984F۽qB넾VLUu9=&rXzaq 26~8Ip:IQP o5Pg*OM*ؤ,c>{@fz=䃬Ojd٧IS"k t|o9I#/ XD__uQ94 H394Ij4Z("5mcUxY95~]N CVMK GitdLyJdó7E֟.Keh#U_4T\_i @eVFV?]x Yq"@H٥2jNEsdSrP#nCXMJF6)n\.@꧋lH*g¯ M|tJ~$z䡇FFw~B&ySh~2uf@d3Jmô%v]F&խOď_=@DΉDԏ=Tӗ$V~Pʃ/3.7jh du} 4: 'g3"gčKj$UĠc5'/Z12mSIRV“{H$*du.= n#2SmU;?/2j .2ryaG}dJ~__etZWߏF=oXzHIzuݩ$ukDE6!qIfǢH=M)w](=&Y"U?aB8(!C+v' klCTNh[l9`35T[tR0 O€&l&tGQq_02iUΖȌ2/y32Yd^ǻGlr9?hueÞRd _fS]!$vIڬ\ oGfiݦ]̫x3.9d1OI2Rj'i $d8Wb#2beakʜH2#ryM-$TӮdI{)bd2d]hۭUs:#rhan,xv#SٔE^G&qL8bv2YΧ,0W6{j\yW8? ;NY"S#O(}A&]^¯c tzd,m瑟Ʃu _Xy|e]jEg_ϗLؘun_FcV0Uu?=ue2Jq}dݝ"nyKN~O{ہsjɉ~^>ӀĿDL _#57oL~@_TQ% ";4IZN醖1@?!FFf"O(? $.Ş.kf&}jyHTTFG>s-\L>M^*dTNE#ΐG +k74w 1s|Vp=}5v)_4`iǕW#KvZY<Ѱ)Nt3cՑA9Bґe !g=U^"Y0:}Ba/)qZF)pS}F>?W1x4<ccVJx_μXuyZ~߇InȄ3+w"?|wgdo"nm w&j{#cR$ 3]%p@&8KoHCFtykAY<̱IHXSPayd!ȒOBŧbMF(*B{u Y6`39=yBd͢iڳyYXn5)x{H,_Ľ+m[?M$^eA!  N9ަK|Aиȇ-~d ROGƔttz;hmA+76yn=#ɗ.w}/+6ox&2T2t# ex,~a̒5{92&_m9&N*TGfkbIX5|zAd ڳ$Xl~N/}h3@x=t E:4c˲o'4A>*|WOl>>犾|e#o?CX~D\pd_9L7\:8oŜ@?%/~i%k8LH^q>1䬸#%fIcHl!Sfm*eݜl%g~ZZqp.G|;7&$z#dر">uFfx HLDE`62J#!,7BE 6F&saIjj)bNb^}98$_شAkof`Sd͂' EBRIZU{iv(29k$9WB_02!@v.2bWSgV!ɂYl?ȿWc,Itv<=!< > S<|=trez:d̅W'#Lqlr*2ˬXyx'Wya}t;dKHFKH6+<9jښS߳tm(VB2Niewop7^d'YMIC )AO|1H6|aEb$C;$GI/ĺLpi;f 2ɇ+#SMu-:LoЛrcȤR:uG#SM44 :0SA:QLR"7HwGDSoH0\K$y҆.oBf_ȪDj,@fq6=} 2wd6MMːl""ݠG\e].XlD-,o)U?$-~t29V^ LXxYvRK$ s$iÈ~c_sVA&.Ѻ2pqLI+v*y=^OhIn|L.?dq[<@&ѱJd &wȔAg .Mxr F`ڞoY7#NcǹI/1/tnmNy'_W|#s-0eO2fȌa]IYɗj *FJ;I. "?|Lt?SD}r$U|;_HF $an%bfΞy9e})2Ii“ >1vIVGW-s9Ò6GNܹf!2\H02{J9ETg~y:$}R+At3#g&hZ^ zΔyw?9JnrͿ*{;;w [)'W{u9%gt.iqzY>N](XpO_刿,g4L畨*Z琾U层;Xp/|y_oOEߕޞt!ky!qzO]ճ d5YάL?{\K^CN>+}2yġW$^^킳;S[GZ2HuBʩ^#Kջ]138ÎYf1^Sy"nGJv>Z͵xXӛ%?sqsJ_srN~.SRw}2ؙ<&TGfR:+бQ53# sBu#ilϲ0.!CJwq|R)Lp 6lc4}|)-]TE=I?KYvlei*5RC8MF$*|47Mqrq}- J^}Bڸ>"}HT5iLr5Rp~o#)X#s6Yj6*x&'M3 l!-OT H[ׅI[^`{EcHìHT  G U#mGY14G|M[đ+* '7|TO/vA+9qAX)!0{'GZe:R[]/¸T3p3,7gIo~YPzj!ufǺ3$a f_A6RKl ;u 3r? [P# !7IK?oZJ{/ϱW ??E^fkśpWE֙IY7w?/D~^vI$ݭ|aI,)8I=X̅ԗDM);wK]du_M,qI6u݂'Xh#!w?t2ՊE0>l0q?m(=d#_t{H~J"wl@Su>ǐDB7gC@,IֱrFـpPiww%2īu$g3Ywb׿!>"m*WP oigOnx;@+g"n/fD"t[u|]ܘ[F"OWKX7krZZJĕ7;mWhT.nm[F䧀l9{{|Va=]Y]z9=Z ,1`ȻSKAOXv|fSmZ;ߨ[{Q~ m0O"G=ڞ598ۍ Tzw#~H;wcXje/о?RqvSރFv,ĉw&? T?"I<kWvpjgpSYww_#^?7}m/ԮG_Y?;G>'POvb{ Vׅ؟J~ Շ,ޠ\_I|y0VJ[%a6WR@yqG) Gf?-ohh{R'fz с,z_wخ"&pw@8Bºa;o 9;Wz>ygЏR_SFd';TC1$9$v\y1y ԿZ~tD' XhOcǥq(՛+JfŶIkw1$D&޴>Ow=A]A@?Aߣ9~$+\='Km7 O4;9ᾠPN? #ۜC|iFIۚM"D"i;^D6F"d0;5_m-6 KPc{.O=ED88A$4br6iB}~x yy#pGx;ڮ.ߦjЯ`'p>&ԃ7r=x `TNyDq=>1{qHVԿ~Bv<;4?98 a.j p_P/%ׇ;9'oDw|@~PzB-.YbqG{3z?P8'!8 y+fk%8 #O S  ; >}v~xw%at0cӇnҲ'ǖ>f^}\BC|ۉ"S~C#i G?B.{h/跷 w&%*s5)w:QŋDgT?z'ߡq%~A^~ŠP;?y;A/0vz3j`.aj#l_Зuc?iNaYAc>>p>G~쇶+  Amş7aˁyTa^-s1 ha|)? a|@0~{`|?^g蟣OGD$7x H*_}8scaqTKO6CS~ "?4o; +/͊w=a\q+x ~@/};} 0Ȍe7:_ q ' ̫|"+v<p=?|8 q=rj +$j/AC6Λ'#'x rҏ)̏X_y([\_a?1H`uG8 /]C=p>'@ovʅzB?D-g׀y? K>WuH[X J{!ڿt\ u gȟ{z~ 3TqJ8 Tq:h/8Άy.0 |z'<{@{\ 0 BB>q\H< σ&= ?GC~ 77%'#]'\s=Maw}}DKc0NO< k}Ⱥn$ nG؏0}0~%Bx ~+ΓC/jJ\w{з8`_?#ރ^Oj<>t~ü4osQ~4X?=> _$]IP ~*K("IzE-LHE8G|zNPg#MUH\"٤5 OJYmk$] {Rg֓$çzh\ʦy[.]MzHjȷw1bM !r0uD` >dzT4ʠq(vOOQ ?c~:7şFwG}Y܌㰾"PgC~B|u۞y_ݟ=}=vt )xăΗ [>'a _2i>EK`} z~Ka|@GX`4jy7eA1O$ڎ44_!.83GyA\u=wD4,c]Ih6]oL$to! 㮞>t>>/yZW`"^Ɨ7pX_u7>ЏP/B^NsAׇ %ʠ[@R}9 CW:_j]^__jOi~ 08AG |?Mt/T0Il*4|% yawϡ-y !ށBEϕJƫo }gShxAU)[kp?"j NFTKytQhk0`ߜQi|+գڏ4ʡ qмTGB`!;p2}oC0NS{-e1m4jwtJaMSf80MSyJݣq5 7oC~S>g_๋*+‚.GHU$7;2i=9 8_E4ya%9 ?ƹ0q%M90y#KuI&w`_BL.0ߔK̛A8 z p?>k;s4uGϣI!kp"vBfn .L ԟRy y0 >;t 3E?Ar~ɧvzF+qOX8OO%]I2 q]CBA8~ ^6~w/+&qo+?#qB~ےKHımf <`Go˨_,yA9=<R0/= >&84S6l$5m ) |Pq i=i|Y&?A|,'?)TϠ@i}?)=6]HS=)/~o`GOKW<]w;׿.mWOEJzrqgE4q/ zQL/{Qu ȉxo>OP.i/OIsD0}V0< T:DIa W0z$<y/)r@\8hsFّ߶@R.ܱ$~= y1Gt\TBMXGȡO 0B0/ׅyp^ M?Z3C{F")zi9ԯ/zM0.( ye0MuL_Cv4)cb>rYyɧH \RK * ~)jTO0*\2#yCn%T`^  wa\Dc|Wt< 03y,C:c<6췀j]z| <S?q':>Hst^?gA}üqo<a}aS>N;_ͰH%~τq7q\=3ѽ :c:;@NX7$P?9vW$dj>[=׽ o}Ht  ~¾v| AnC9+؏ y[x^ v<`#>Ig=k0pڿ~t<υTa2 4l֞yx1B==I}4>EXW}m%>Q{z>-('ͷ!'wqr>l{|= p S|=WGA<] qyo}pchW/0G߃=^pp]N ?-{>O) J xO5 !9O`^da3/8'?cvGB wXp?5_q<N@܃:H}`> >_cyO3'ʇCQv {qs:׃#*/<}?oߧ}߃wOGacO@{J0BS99(O  W~ z旐ǁ?}}`װ. yV6mwͰ )+͟`__No ;Xo<slPp{Ճqe|" |{0=s?P}x_K?J=߄6gO?t$w ~5 q= v~|ߟDS=s_8y/O8u`G- 7S¾M'b'8Qw!p%a;'z>>WC< âiND4N G>\=k8nvOq>mNc==Qhx/Q:~IQߟE?v^zGi~=|doGCO ~g> ~ SQ(z8J'_о_a.7Qސ~8O vEK0¼ABsLRG[aA? <\øD}a1~R~/ס{>'y37?: =(<~?ׁ=u1$Oal\GQdb^k|*/=|g7k&lW <Y0o彉q2{1{Gv۰6>7#xΆʋz'`<'}OqOσ`;Q߫"0oI<ڳ=]iJ^X*'_Sj>E¼?g#yko z#!~4%:o0? ~hu~'}99zx~RTp~?ymw# wh74N~A?8N׃yx.cف߅۞xe(/G=q=kQujO\7+8\`~/~L0İQx?.s?|wN=Ր?5?P a 7JG!.AA9n8y ` KTNX??tH5(̓w9;3Ю 7< y+5AjL=l78?㽎8. CwG/8^`g rty3-Ǽ8qP?IB8z 1? 9X_e^('a qQȇ`}F> lxOQя{=G=Ä~#BߋM{?Xhv}=D?JǡO{a~ޏNu{$ԟ&Ti3:q#w:~~z`}o@>O#`|~=;?pG`\}:]@{o QxOr ~Wf€n??=ooEGXkiKF~#>#>#>#\|_MB|Ӱ410ѣxUYJpJU~]M`>ms 3_7c #x)gcmk}-~#z~.]R=p>K,9γ8R=>]?T矌d^#ssbxDM3=s?1Q_5JX(KCJ2Rx궒W -4,`Vu5տ,(Yz=ӏWShș,azu'{c9)87er1Ojĉ E`wp$Q,?8/޽1N KB}iNOcQTGt -{ a-4u(R9i_ܞnl׌wHi0@8%$Y3p9<ÿk%,W_+aO?W>k%*as%Ѝ"8`wkn'>=gvOs>?0䧉wnS âwL9rXʉ)(RSNI)I)E)M)C)K)G)[r59j%["-ׄTM{pCHʅR ZہQX#*̚Ԩ5?Bj').T~h35gL8y\il^爬\%fN%z;Oȃ+g/+Iغ;/Pz苛{#;v ˹ _O\SEVW}7FT}HTwVO(r$'ϝ"ucDLCVu^TKLt"UwwZμ@?Jn'o?!@굮d|_crvTXzٚslii-[!iΩ^)>ِ_i<_r8mh38ƗҗQbNyU“u% izZK  rb9%@NF@(c|5ig3!haS^xS]iͯ1!jwʒGOrJ";v7A:'s #][l UZGt&]>Ss?Ldx>*Up'>ؓo_YtDgB÷~Cʑ*[f= %; +f6 2ȫ kXSK'5n^grBI}3OfpGMaCIK,N?Pp!͔̅'U˶JIO/)|IU }Ajr%w*{OY!k\^'5,DjMv[Y]k1qxA*j?E꾌~>}7++Zɶj=_zyf䨫CHZE>Ead͛Q&^ia('ݤ!9(ּYg1YZ[pp ^e|To]T4GF߳ $+J*g:;Ax3:{ H:Mp.$ș6C9s#an= IE9GLt3rT1<1ǯV忪b~ȟ[Up"MrKf,gd gj{QgS(^(׳o  Wrw bxy4״Spԙ2e33r鏮Sv# VlqY׉B^ߛz3Ͳ Ҹː/-[EO)`3ٓ/ICJky%KyĐM ē&-TפAkҴhryH[Kf {m9gőV΋-CH_ԑVĐֽ׽ M$M"dS+bΙ:Jʎ4ŧc"ruҨMV\ kDIn'my 'ƎSJI#[':oDZVf<.lնB>lќ4;n7xs3Yqǡ[ь4mtl|v@Yp|rB ?/g`TtNiv%4i\[Zrv}䋴. g)bal6x'-R &?lן,izŷ`yߍ|;d5g{4di,k2$H(rѤVNqNj}P"MOryҾ4AfaGy^Fg i13lͅrJlI ΰOokYꙎ[ήM."]F\hSNY7]NZ<U4Q4M +oYxKNn,C<ĕwpQ?zw$5nf)q{ܨ$ Wy!uZ~9<hxfe$l~gvo2+"vW=D6mܦ]ߚ IGG-"QÖ 6$}ߍB9kLKp㛷ʂx/t#wǼ W"_ :%y%H{hAo<96n,@֫%|EzE qI cIds' <4H-Vs$I/\@9ݞ{Bb#+mO{#;C_IRȴ!&sI3 4Hъwa'j\%O|ǐ̽E*iy/;lIAܟ_NEj7plq{,H7|SwՓ{9>ōGC ?:-j`œI8m ds_$-_gMNid&;JIm\Ku#_TAdv}KHa.z~+/\eCZǖ4g$ngl=vlSlҠ{rn>7氥 H S}GW,"9Z Ym K8ه$v;L jqwCfrN쳇d]DHb_'9MN_yѵ L!.n(gIÏ+cGiv( XۘOJGto{YGi&)r3+ƶ8*9?"9Ff{$+jfc1K.;CH3%C8%^WT_m{D%/D"NGFTBI&=_Jo<5ݓ9w H׭}W|!3gO"?t-I⾆.A&7N~Eg_jXnHfj^q1:K6yorMP[؂ =sG! ?#3wj=s3#W#F;ktlǒE {&NmpYi iwpCV|KbʅR)%q\<{Lb.^D r?q9<$-ɜ7#H˶ . >^ÊO4̱G GO-ANܑs3yqXB`lN1$uDוH&s^5Z3 y>A49ї΢HϥDefElt͉᪵"H~d$oc~l7vٸ1i]5/oҢ|Ț c/W&Zڏ|8xgm~3m 츴Srto+.7-6<縭B[Kvԣg+ ]W Sol;.iN7w#˛Z#s[g$I#'-=I_7T.N꿐=>T- f)=3 :-1[%Ž?+ׄ&EcZ'Dzr Kr5E_Mg'UF捞a?b6Yy.lT>A*bRO]9hl9yFC';ꤪqx cH9,_Erʋs&UƋe2l.0G$z}v5` dw=Ƴ{GgNm-м G+Ǒf(w* KO-XoP?!4Ky K Hk 8s5 uŐ\S+Qa6HyߕyR p%%[8-hۼyʤcH-#NJnj&mͳKrW潵i }N}5~2BU4'it9ʓ-dCq;y`S탕b"Hͧaҋ.bnjsj}6 }[ 9bUC,͟uVrB6j a3Y#g?r ٰ7iYqȆ߷!J "Ǚn@s64{|p#o͌;fk\ih0B^sI^Y+"=lo>ӞEfC}.צּI ᦮}fг]Y*elfk6mhmQB6+~1r47]-7ۊt1}d|Ʈ*KHS٭kI3*[B j2bdma.ȶo[]@t 6yl?e?椻& eQQ2o'A>2fu4\JHp I͏uHݹ˖7骷en76KKνFK8_} 5gnuMl07d - eyn+ŵmےQ} I<%j;d݅Cd%woIl0{]he# _:hzKw">)xV͗Ic/9JARAJU< vf>|z%.]>'|t "y\[62hF-2fOA CF<&a&}jN/6& I8[c4>pg氹xǓ3ђ{|1F ~]a#Je\1D0 }#}xڃS$&1kn&1>G>oW%_}t2ԙ^xEϭB&pO职w{q3D9d /$،UCBcrKX׹}̙$n#٫Uu'I#+" 8]b(ձ9QwCy~Yl]QHgd>9o"_>tl9Y54[#֔#m$ {ɺ_1C?Ȩϓ?F[E)"_}kݗHdx(2G"dl}9sI!;אv[{A Y1IzImZ Sc2_T)2is /6@& A&g2鈠37oF.`[I+~ܧ$i?~$m_c$?l*N"VNb>M Nlv_o _ڨr 2^+d}ϑ?.o%fȘ/]1.A3-K>-&ꗢ7\I&Vk*b:Dspc"2Ȩ* ǎR6tn6D37b3OH02LLXd܆e VF?ZvD0(-XG8 y Y`T.wYdQ5d#un< >PN~ԮoIMggXNRU!i~ij;I]֔{z%#{9^1avENtT(t ۡ3ٰ}u+!><};|9M GUJ_\O"ߧ N|HꋧWil?%jQ$s_v!)upEoԱ&>B6Ōkzl H3}U1S{ UE2m$Nv7Yq\-Q҇"}m$1y Nv&om6s,CZԒ8c p ՚}뤊4t^ʵ]|1S?ng5LIs89~Bl^٬TMa ~lnΔbQĹ}Xz7nesb;;ݿ45q}k4%Wq-I3I CcYyԡOoBp9B ۾xP>`ŦǛG=n ۇLV|ӟqC9{!6Ol^81o"mڟ>9o%mkϓ6q?ʮ}!Mxkk/Ȧ;l~= ~SK)MlXQ6Ak!VQc|3ЊY9em/iZ-~*}Ǫ%:/i|7i!̛#+/Tx4i0ԋI)fbSo.EO_P;pt]'{`#r? !ƅ_C{Vl }td##en :QuCd] eEȨ??%TՅH r.Ir\bV20+4]V&2fqPdI1S}6~2fٓ]vn7_-2D̰ńuLPnc3ΗM#q:&qֱ j\ٸo%O;<(!yO}%l,r>p/CyQxxNd&S=% FﾏZ־2 Y1~hdgaɫ,u|JnLi,{%&;-Ny&ttFF{2^,oCGjDʽ|F87 #dn/LL9H26'܉$q$Wّn*D6V IT(g,M՞; ߷!fX`eufd!coڏLIU IeyT :#a|$bDQdM{A7(^İ&ndxS.Ⱥ**#õMs6J; #_ ]> nwU;&$/^~D&6YX[D"_R뙥5DgLJ3}2nȨK#P1ȨRl5uz6Ղ("ά]1g;2NI6dӅ$ڄ֬lگD?w\k+G>J6) #G ߭u<yԽvq+!OI5H'rxy~/#>{oиDJK#t1.== g_@&̻z2L#k4vTCZ]52`nE+yύjZ; sΡI~ Iw+IĕxX?@?=k=w!}_<?EF[m":OcE G~ڌ svqf$-pX q? w$'|Dod'DI~ ?Bqʚ&6G>ь,aң D=%,T4ZUdAx~X;gE$OHC^UZ+DD I]Fl# }zW,6b";l=8IW$E7ߙ$2t_dZi+O!=": #ث.2Tlzy 2 Y1bq72|o{6hHh!üŝPFszu m1b_ȣexBwn"##_lVXq%Am!묠V$h҅tM+yCl6)/tחGm^?_iZ@ӗ'Nr ZVjIjWá#$.&x)'ϺH6W0.zf#&Msr-l^vM̀^@L~Hx?e=$q՗o wΤ^ Y"ӿ_Ks8ᝐ8:9Oֱil~T`ӂ]"6w anD~^ 3cywvo.AO`dd)l2֜Un1/)]NmcԴ:au?\r)XdgE`9{F ydOpdq7J5"פ DFШ,?.gwQ$2zVI$뙻Iklf:ißrӅȰ!UCN#+En*Z1Od2̃Hj>HxggYi y8._zzOÖSs֖9u 5rڑ0gƛjZr5OvI '58vűV{w..RubŠZV_HOS`BƗŇH3Zd9Xj󤗤:kN'tnFR371TW&Ϊ?a*{ΰzn޹YC8)V|/<~n`C1=[dw`׸vM=̣oqRPҢ[Ig RI}WFV}//d :e&ߞ?5ZG~4i N{'׽];yC Nθm1T_.]CH5j0~Gܤ5r};r%6YeH߯ڛ8CDx%2f>]%\,\z\ktf;&8u>\nD3KH+neXPϪ2f[#؞5ן`퀧g;BZ.o-fWVN UTX>zN鴾#me1:"et<#hީdqo?H\qץߊxpGa}ۂ+/^j^59'I[Uu㔀݊8ݍ ( JXtw7!J78@|yyyYs5טc1sYݼklÊlo#Jrfg*D%Ci Ʃ3seMzM :w~[[+El~8v ~yɣCO# aS],Z(n]~̸"$!,^/+Ll .JfI.G<ꕴj̡b2Әʌ''wEwVn70ۺ)ً_yEh}`[j` _Zhm~قQgίc ](х}zqhy7g3+}D%ױCzVg؈_{ދC $zv`P?35:!E/أIߴɞCvg}_JϽ3ZWBz (Xʬz;b99{8P/jCϡ}o[̬gYUR@?o?k]/?^61:5թ/ r]rlfS^__"\f^g*!=!zSTQN[ʅ;p|QCOģ(/  y~ɾ)c{G8:{g˄LfV?g,f[+z?}^9cP~ou(&;ECE;EE{C9~RߌBp8h>'֣>Naя8v͏(6uBHv~G~q Gqߢy qɯG#⸠|wDloG/vϡa(}SQ[ | y<"A(.Aw ~vv(- xv`ģb9Jc+ؑ4,s4&~z`..'籜y@nu`sen]Gb.z8x+gO=a%N-km^y ^'tOwwrW&js 11u#ڋ՛^߯<؋'+'x3ߧ5 򡼮/ Fdw?'G5<{{U:y! ~>?w`r<~gg/u֧}q&| {9__P_$ r_b<= GrA )>(w Kk%|y V.ˮG޽^ ȯ/rxS7݇|vOD׆O n 8]eB(7<x5!YBFbހv~zE?GFDACA>A}c&/ʁy5&湘?9l7xv 4_^?boO!"_wGag|y(`^czz=^ȳpv$X.I,F?v邨,Rop7[# x1 #x?*qME<<vzayL"yW4!CC 8 yb\Ycq _Sد =\b ~'}@NĕneQrÙ(~<>/^Bi! yy0Oo0+xȿVz0ogoK~bc`/gA/2fQDA!> B @\D{=0^^({0+=cKؿP(Ch?a2տ}7G8ay G(䫨pB€=`Tv|@v <~<, ;y(&;Ayo;[,-|> R{XX_~@<~ SNZ, 1qW$z΢!OF^zx+,G^HE>thc r2boݰ-G"7o |ȣK%BGy?F@~|~ z"?"#  >FC{"_DA>OD?p@<` ?Qyſ )_, qAމAD}FCrb@^v y;'<y0C G~E}Ѹ#/C r 8B~0>C>v !HS$=gI?%B|B> ? _Q8^~yc^^ᔿPy G$M=gzi&) YY, ,WWCƄY3 ' E;.< +}km6f2N5C> u6iO:Y0?"΀xBd`i'@?ȯR~ yY:.- q$NM?;΄OIyaAF/G!?ZO)}vc!AAOa""7 x2 > ޓq2 <0I`IPN y"1+I"@7H!7?|.O4w$A:o2y`7ϩ00L; x6v*f*ON:#ʳ3A/_LK9$d |<ʟ ^FKxYg?R`i>L{ c3`ӀHC&đ4LSK?2?2 <vK,,K]RG-KXT4,o dC  >? ]} =9y`Oٞ+[zr ]"˛T=l3Q@r Ac+Ʌ_Dza\!̀ue+9ޕ ~ ט?b>2xO|¸<>Mנ$kȻp '[R!Φ|8 |R%@ Ʃtx.)'8bqEɅϣ+)i1H^K;T0〼ABDSg\OfC0ȆxlX_}eC~ xy4=_ ^@惙`?4<'?4v~ zF?> w_3y[Mx_>590y0A}w<eӯmg9Ӷyr;]%* !'E{ yd٘ߣ##gCޅ|?Sσ?8@އ}}yx"8;IqCLOqKALuט`;0%4Oy/Dxać _.G4ȀJA=Ώq}~Z|4 4w`~4ǀc(]גa1G ^?ul 0^@ޏq ?m<(y|+_xbrCw|?8Oa3[>wA>zh`q11X[wլ@ƮDLfYR{Argz<ɉEb8?DyQ_8 #os4ƙ<5{ȇ!~{p1/"yد8+8Ly0ǗO!'"y/oM"s*EYf,_9xb=D̃#T}AϘ|xC/B>Dy!;_~q|@j9Q '4G 2<0iӔtXx#Q̏ y:;aރl :X/< ˁ <reAy /`ja 7-^737^_N!N/Kē8υ@ט/AOG @xMa<~ʃGm9Nw-fW?נ߇~}@73ojsҾ}~P>~ߛi?;}w=~DWq9vwXNAOwwḯPl{PnM=P=v+a<i5}. P(gco(shv߿~D?Vi%Q^g cq~DAп>?"ѹ0^sP'g;?&އ>۽r߇8|ToyY9`5}f==U] 1Ѯp;}q:g&;^s8Gys5|Q<C`|}ObXOz' ߸_nq/G`9~;'< ?Ez~?8θ Glw|h?t~N_?Ec8ȏϡ@>y~y,_!|hDy ' FQ;BD9Q<3^ >7~{tG<(< y?׆S>>1i\+~| |O=:{P@>|>< Gvh0\*:oyϯsམdO!bA}<_㉼8;l< = CßWj?QǍ̓ϣzsP~ @s0GG<;k9XO @}GOQ޹yģυ? &jp|G~?n?yo8|?EtKh>\b;O풿ǑoB<ʋ87;7|Q^LQ+QNs}agt+%z[<?.(7G['/t~?{޺˨7>!~ 8+km(]ȋg|寻b>(q1%ͧ?yXw=guQ< 엿ȷo|Rky͋h/8sC>?5z(Ky"6z(~߀O[y(Gc1Ӽ ]99΀}=(|OoӶ srdO>ϣς L(oyy/Һ~9|;%=OLߓ{ Qy&>?ȣB0?aAo]>M?hbMß_y)j&l&l*Wǣ""TD*5 1VW<nDh \KۤW+ -*Y9d}\I6ݤgfnJMֵMM* 6lݵ؀8jJ(t?na{;~{@h.]q@פ6,g㦵?'{i(D:x 7o4ضr& UTxEjEuw k]wi5R.,jwYF6yŰ/~#Phꢛx>9DPrfuR,Oſ%э6h6Zo^h^8 J9\DKG>Mm6Ygbh`b 7nZ]ץiCdy#"ig.~9ǿr ߽n4?N ,Y|U1 t&Ÿ?XlI@_LI >RMm6ϵ?H%PffiFL7m٪kJͺ[ЅZ]5lu!zJuÕ4FA}ރժJ*~Wƿ{>Mm6L40ݺMiަmJtMi jSMm9%--h:=-!`enjAV-F˺pbia:ljj_NafÈg&K5IH'{q}OSMmCm%:ؖ65;]9[! "##ۍ$>mvO{CSMmsmpn`fnklEα~axZ3?%fZ*pakddꊴTm- ށ[`溦ZMqVy:(uX4.K>QOo?"ʿc!uŘ6. OZǞ779)㯫ckry'-bA/(+OQuM1~y(?x5N,6Z~ã4JJ- ֮3W X_lng5i܌y:?3 |۟\=glͦ66) -q*( WTV7"pHC4HÂ4HCjF[&^+b]X6UWvuW#H?hC,YTdiCЬ/efZ݉YPKac;}6V5.je{ ߪ/oXc]70wI7 [~뗞0%U 5#44TT5Fßնֿ]Q4Br@!m_识>;ΫE m]l`S sEm^¿XpnJH?NPP=`g }8P PPP pp@_$gMr6"?@|vDy,aA,Lu̠,QUzȞׁe7li2=`6fV_s)9ò3:~?;IGda؛7NK,ġAZ,=];_fRzyg*5}/!#ə5ƍ0Kҭ/,\J\Yśz2{OũFnU!̴8Np_` Xn+wC6fT]<~z&8e%Uξo%&mXoQ,Š^]۴f?cZ) 6vw)˿p/ zN75AG{]G(t@{˷IJ,YUˤ}ǪF. ]:cDVy=[YͫV h~uy&mB;Gդl4a~* ~aky"rѬ-'Fyķ;1 9g$ tی̉޾|gҚ*U6M*&Up9-aY útѓXzWƄ;Xr'~o߱ksb9ѵӕ=Yt];k{(X5'%L5^;PġCʣ9gESٍ*}ZUrƠu|&~vC8Ӌq#/fۻьk$,*ģ#%4|b>ff͞Weeiq:~IV~9!a|^gr*XDz=CXA7OfKxh-8#_|[(lc; gYZm·EKX~ˮrg^=4 r7maVCANi}:~Zǭ;XAjkqVPfvI2=d?-"OaN%62%JsۼҩSsN媫C# NFr,ض0uN+\z;u9kv#xdYS74ftlj;^8*~"UF%Ka{DVsHOfYIuyN<~db*N259SXeUaq} 䵴̴[ZP|gA\r'tu==\H&97#)7Pur9?9{;-ŵ?yFBϚfsRE=YζkmXewWW )=F_~mDqbnUZ/qo N}9U"qWy4IvOV`(=+.BP1w>+\e jpצB*hɋ=8 _yqNcrw (j {o$Q=KV m,ƾ(>vH!+ΰ;;@>_B>_+ߕk[fk\{9"T/ ~U 'y.տ-grV{^82Ptk _]2Hy*!}w}^ω t.Yž[;/F7^[- ꐿ>g|`NԦ?Ʋ#,+]7h%;⤻;OӎY; rg+O]> ^I9ػY4O(2=]^޻:%mm Җnyyhq읦Ih3+#O٢a^76׏HPӗA};gP$|\J2=[zrGvDNv/Zl{]x}= iqvFE,XHv{QNNaȃՄӻKp<''͞jtlDv0a=E͖LXt;bZt3UEcCvgEH ,ȏGw갇C<ר&D^f/9}gغ^2'u9AS5|* G/v;1"v롓6ЊΈ!X4׳cں2ͳ eodԅ3f4efo=wѵ\cWrhuמŵbɆb8A$\-B(65bN4LfE䕽GqAf,?}6HdS²ȭcv.g4EyJpR'Si^}er.~)Vֵi{Va0PmkSaüƽ~=@(zXxDYV^U.HX"@i VGFi̻+wNbU],[ ,v]3%+t=۔~] U)@'T(Pޒ`6 9FPB N6\Ή+}K"SM[U_eŒG Of>~; W0.w?aҷE;?7ɛyΟUOeq |>ZnւE/e{ ŘLdAco$^&|0tۣUê_;aFk~j3^Yʱb>g^ł.Wmy]i4ܴj9hv\bJb^Ks０~IU. bCNĿ~٤Y#a=+{Z|scND97j=JVgiNėqr3N$9?O7ل0un۹\l΅-9OwzPހs;to6Wٮ3k G=|{R_nȚ_ovS|Z|=hC.&?tͿ[:QS02k2Sо' =0㆘~tc'a[r!"+n)|Or40U 10WūmgXqvgOC#Ň$,vy콼5+~ygYm٠sbj^7sQ&Y36s4m{'l}O2{,'nوoQV3^=86kfzZnGrEmǻt8ѾlDVQ_,[:Ieqӭ  9#Z3ngT.IhkI8HFΣ7xrOUϔc'FDd?89knXlc.9wtcٹgXyV^F"P.KVy!N9qV]P=Um{nqT/!9g9ӝpsSE^m8*P>ot{#A|J|cZ/a}<l:j훶o90buJnH. 7[}zcg'(#m ?xG +;w̙uߎ@NRZY}l]\q s_myUr/¼iS޽?IX/ǽӄN~2t($,9^-;ٽC`T6kҬDI::{B/ԜD*BF2 $[>yƂb׶҄s%1J+cmύmt\pA$Zg _O# |-{vc}ru3aQф&wm7NFXr-GeEE?~%,ռ2Dy04br\ŬT5?`buLT IQ9R/LXͪ x| V0ɉ&{s]KDNt!' RYŋ>[gma9rͶg4egb8m /K[T߳ ךӘ-Z|aE+9{Xmm4!,sx;-{. ~FXth}*>Y^~6taɲa;RgAY G i]Q.˺%bOI~(қ#ykLn;Kn+b>k2#( MнϾzx>J!tMݛjзs%2EgЎ[^0+EUSY'mg-aF<1k Vgw d a`oWl0pS4|p0dJVOY#ZaA]e wd?f鶺ԗ`oAztcO B"9ؾ݄A){KyLT o+cLUg̝p# _dgAK]{ORbY~s9e cRclYx/_nxl|wGmá̧$́- -_7Z(<^0tayr] }l,BꥁXBg<# [.9=S;28,ֻZUS,>s &S5o,ߢxa],J{ꭈXG/-E _ھ!>UT6Gna5W:umG(j;m'[/^07B7:f~‚۟z [a2CVaA}{zNQs G"B{#.cK;Vܾi:= gOTb+g ,$9yݑnK%,zwk5a=x9rݢEi҄nѾHXZk,|L6+TXx.MVxawy7P.ȤM+|kiHDTV¢4/<|-/x : ,59WHXݶC ˤ%xNX6hǬ~e>_dZܷ& >󉋳lIIx,aC\p3Ӕjo% LC)Y{{{Yobm+ .[F¤YDᖽH0Y=E S^>ڭ?aGsab;׉K GZ;ǒMP%.{6*%^s[rwgzO|+ڔ񄾕%%!bIAc< %>fv8:ap8Xw0he׵ ֜feq݃yKYY&ߝDe#ӿe`ykv#6daͪGc{ݚ9a5Vq:v/"2}BpmbYSY]-pqfn7@}ǗYW^uJ8kGZ{Z="Xplx'zC01Ó /$myyEijШe]bv,5I ٮշd;7Ov|gї7>WZ·LK.TNx;L 5BkC_\%tW8Я QgO YN._m6{E#4Jۭe- n88͏j}D0ѷ]g nE5E6rk'ng Y*oMd%B,#3٥Z%hqТLL-ܜpK0xU-9*-990G% FB?f_' ;0g/ mZq n4#z1 <#P ~+,h,p~x8C"=˛KԎ%K?Zي>=pC&ʌ |V»svm$ b>ֻn Yʆ}Ɋ': x4E.QGߙ6IazBۭÊf2s a޷); R[' &`_ZFz-q< ATi S-+a0`3= n{S3k}hPeiY1o{b:_1N73'[xs&G2Q]{q,:%N" X#!խU~ }&t嬜}yc\#BUr]֞R{šĽR`Pgg4`ggb?N_p2԰# <6 j?-nϒTz)gi9|çFz]6 ?Y˪?9'wbW!E,PѩOyS]r]" "`au;~- %lU5Tn'Ǵ[&M?tݓԼ$|Ү?m <~10_ZPkEL'BR xpA'gMFm >r|ۮdBa9%]n^u,9ݼ CڼoжcRX:VLda>0 mVٲ/ }>޲=ai>5m]N0oѰz/O^YLs/3/nfܑ)L݉\oblǹ!=v^y3a@EBvH[ n^\<пf\:C/cY)Q:la?V AHUveAk/,6`E)WSܪ9sQjD İ ** QlNVkqi{¨I-Z:w_廝05Ka K֦cdᒷ}nw71[{L`i.>oam ڌ柧!^,l8u HsLo=|X*j}0(o {8M! YF<Rucz;7Q_Я@B׹#:o4k/h?cƹ;a( 2w* GJy HͲm kyk+T^5qƞn'd &x}Wnnl~6G ˩y[Ad{.β5ZHZ;_2,7,T^8)_3s}ɉL.\iw4OyAw owow*Ol>P͡|P(z}.gsV7^"ZϞ7$:xƃY_登ڱCJRʹg}[a9׈=9vvqťJodR\Q;#G/x27Zo#?*XkUFU~xï 6O*Pf'5v_WԾcۆ0˻Yh\Y;h9uhݿ,[ohܟlOyBr޻XۂTfP'9YN_9 F|~3 f5Zo`(v$P,Yd\X|@Kouu88ANdaor^m/{5΃v~q5qYBw}ִa,{wM.|rHv;TFlb?#lgN,tuƸUsȷ۽-usFnEx8wQ!6u?~>|tz?dnJl+1Xa n+r>r (몷e;əY{40'XbuYTO!,2nŷvh6V;v8e?{H>+uR Vd*[Vmѕ,KϒEoS+l߶a?dy,щ^hkq܈ژdʳq,mxXA?)ג` Y('7䡉_,+ ;f2y{O\Y[57&,V0#E#kMPG竹~}VF:~ʍ:vobn\}>>s׶=xʾ+>؟yE~F70juE !!*9Ke+z03\wxDV܋faySn~r<6J'9ˣr:NZYSt a儚SY9|'Ysh{+0} \#JUv;h$aO+<4HHaIf.|%,g_ cHcX}[D.(b_kS'.reO\3MW{D<>2d%/sDYQju@%gQ̝>|X|D#!>h௜fǙnjNCDz~|de#ʸj''<^=a +WvdžZF`099{eFh_4w8e>{nB.~ɾK㎳W\.WdWUgmg/~~տ|2< v=Aʌ'~whJu+$#8pܿ@ajErXϲ .~ >ԫ͌Y nwxa9ʉ﷪U Q/(a?1i;hJ̾]@?a#< _tyNxZph`(7ڥ}֫7ɉa]7̪JFhhǡn;_$9.uIr|hIbw׵3{dVϺ>9qoP#*w#OP yA8bm :l#X!A=ͣ6(3ۧkcswCF"X2W*G}!?`9\?5)))ϾNQ?8>ʁ=O+s,,cth[ysh|@;#"@chUoaON أ/"$?G{{vvGD;Fzx?A~~;c{|Da '/Gr'ػٟ C_+coXwd&`fTvIrg)!N&~C.* QN׶'$'whhW6hǨg|/3Wxwģ^'C.gNo#bނyƜ6sF\cn;Կf,fNg/p<~G "# w&9x:8P?_W9eW&ׄqF=/_K!:x؈MEϧԱ֖zh߇s^~l71_D{msDɮ<|̎'|?FDC?! "'#ʁzޏ]+??]{ȳ?Gp!8a<ϏKםKiegOVUeNGuO\ۻ8\z 2WB _KG=/ƛϗ|;?TT[mxB%;ģc_8+o_S\],^0V?.g+q<]Mȑu^]>^'tOV `q80SDyC?ՠqnt^|y#~D'~1oA;Ⱦh)΂4X+9q&oo7Ggkω7FMBcǍxƍaHGi-P8к,+ϝ =\GQmS؃C~֣.!cnE1w7P^ʻ`0~a+=G DžAy%޳ndz_?#"??a^vB< s WXZp;+Vv!~D.ˢϢb"  q2J`jX,8;Y99> b>c10ou6|ow\,Y$ x_,O4b033P_mT ,haW~ RQ ysu <!0!ПЧ/ȁo(Q0]x:71_G~e^o>a^do08| Wϟ}~?o3?^:8EMAx rP!`g!0aWauRJcaݷ8+k@aP Eя}_;> #8?c'~@?_7Qo0-Ud=}J ~"x@W1Xo4̗#NEb;xp;0>`G1W888ģGcWA_ȟW6}bR 5;e"woY 1>-g{Xص^TO~KxƳؾ/ ߃y W닷=#o|ϼiqOqy C>|!1ȋ#! 19q/]/?iQ7p!@~  x@\v ~y=$_S}:hgG:.aȚlc2>2!}A| sM(ƿ ~ c<%e(ϛ8`Ea,a %/_biitXJutttt3!΀~*vC:3 #)T;)KR@o0=f"zs頗t/%CTYT[_,d23wD.EƳhsjIJ~cHI<; 7v~y"X ΃`=!)cw#AoQ_`7[`Wʷ瀟0B/A_I0`Oo@k#8_CJEDA :p^ OHc"7o`ȋv ]ƒ/Mdz =,c0x0i~QiYRp,KxzFA=%C>.xv3k%A)p?Q/EiD_G3I0_H|0 3 & #qBCLywì>Kqx4(_*a`)א3`!O&>|$ +7.Ɵ 㝊ֶN<ݨ~YR4iKKv|v|L_п!ߡqH~o~%h4UH ` MODA $/8o qDyΧп`J< G}[DWDaW۾x]$?: [qq[1`8o{Eypޔ}qH u]̫}=E' De`RЁ%}Uң%ͪ*gK8veI,=$%׶Ӹ@ y4S$p27ȟN~$ORW) 919``ģyfB\˂TU3 ̅q΅|& \\x_.9 r?sao*K!φ L_Ey ˅Q\[q~iGg sI,e_V]fOc4K]BP^b^q׍s`~]׭rfY]=>aYu]U3[Y)7ҽ,CO+X^}C>\[h`_4gP^q2 < ~C:@9'@^~yH8=y{&D'g&YBK< qOG?瀟~sp lȗ/2nsAģȋȧH>\>?#1F2v8x2ϟxQ]?@屶,A ?"S~ '[`^ބD{l> h 8{A|ra~ˇ,9 /|q I9 / q=.$'!kj!fb<v.L`A.%=sp\0^bkO5;o\uTSp~y%l*M;0ceo_?]c|y9'CCy ò<Q~\7A>ʄ *̛ϳ2!g` Ac57x絸^q;^h by;y("׉'y|v{]|C@_f{+rgWtStcWw$u{4~JKϑ/2!@~qp}}cyr2̿{d(Oͫh] iy5 SAdހߋ0g< Y 65#i6#jkȉGO7/Cb>ï"}N;47>>/o^ Axe=>f'vW{@a(W~`93}K ߌ}{OqCG>ǁ p"O{i"/ߍ@ I {o7߇r>(]76פ}> >~~nD#=µ菠GH K%xi=q;)}d ϯ߇vG~/7GxO>Q+(pT5wGA&􂸎Kg1;|| ȟx~C:_nџ`G_p(Sܘ>q7G;}րXvx}dȟ('t^>O[%Ks9 _(/ΔEQ]D Q߸_ϛ0vA?('-o>1Oq]Of6S׸ k8ף>qDDKEiq9;y|k`9_: =Fs]}G0+_/y߇r>3x0/&E;{Q3[t.EE]'xzQ~w0Xv?_ 387FFykEyўPx $?q O-3'ƫ_x(_# y?%^ӹ4s}n O}">U{v={ <'GŠE'|JQ1]sk{Pq<y Aost|硍Sq)tޓ;3 |M~~vHcn^|>yZ<77Bs()\oD9e8~W4_qrs:7rȃ4iB?lϗQX%(wdxNpgQ_x?>o]] ѹy|s _EdPyr_' /<ǝ{3%Q:~M`އr=a;D%.;'Ρ|~L癔ox7'Ρ(?S_ G;OG8^gG@?Q̛<;@~B^u\ \/!q狡hƁ.+=?_ll^O:ȣ 9^\?@oC>Ƞ7z=Q|#)o[_P> Gg>r!b~v+@σ).?r?1LߋJ<GP1|?_ƼyTZ巏z m @B?tuPxK:=N1nϟWh矏 G= Q zXB>6t;\hW<y篈GwoGzBiyy-y?yh]sA^ONvo~d?9ȣ>JsN^Q~^,j }%声^(ȋyb=W9x3 D/~y~q7:{0&?\_<(/?n7|ωqBq`<%U)y} yQ{Z'=aJA>`GywOoUǣOOiOϯ~ڄM؄M؄ 8TGE$D *5UMMMMMMMMMMM""bOȯy8 =i&10_Io512Y W6m?[Tr>5Q|fmIܔJk6T4\m ٺkqՔTQj\K]7TQL@_wZc]㺥I}mY SwMkN'PBwn?t.CC#=# ohmZ %߼t*%^pQ]Å.|]w ]QA3ͦ^~1_~(f61ެO0@0&ܥY-+vrItM6d֛8(FpGzuzf~jbkuuײoU7N;ҤPR[zKOkڈ*#{j[kꮉ(OD!9sUE6aWXj@"6.6ΩTԹ"V6T {_p,87P'( (3`w@y@ 8 p8/lI&9MN wF~kCRo5=2 YZS8'KM}3u,FW S[3K |5{rI*nlTOT+9XןUYJG,Ufa7~<ٷe\ڰ}vmm2tfHvpҒ0u|;9,ջu =iF,uauM"˪Uu0%CBYbzKR}'z,[bMLLV8Kph[g)qЧq{nSX\V/KجWjg8u_Z'xזPc79K8,&椆pY"ce&=rwťhcW8=}zdUoFunb,,Jrr^>Ǧnpҟ.PpS9wEoB\uGdyNM9n4z9PE"i59N墎l9 T,ฎS|)LBѱ8BgM+ǜ25z7O okgn+/Ƶu{7͖7[)<*QNja_9ؒ^BIYc[ E/ؿU:>.t6;^<, Tr84y9vîzf(xs_{2k.nvc/OqQٰ0I,[?X*)wsl K{nkGD>i:dif=>2<3>=놩-|n5euW}z ߆<{EaҜK?;vs}k%?mx<Ӷ~==LOrm, 9/p~GB kW]/pQose6y?r]ە{,?3D*p8r QF*,ۼw#͝ӱ7RJx68K#]ܙۣ 7pXWp{upFpԇ+\qq;ylk;R:bZ$^v}~#<5C>9|$)qzdPk)ĵ]\ZN%zBJRưKv\ۉKnl?|P6=ĉ`#ڝkٓaFT= {~MM#6WHNV&.s"||,p eq; ii͕7zOG2:fWi {lahUr] ?붥ք2^ %ӡGHpkV4utV٧6Mr>h975n^H\o%z$lm#K8d>?zdI֎P%j\wN{JqrK svRrĂJrRgxEI.(8?[$y㫺 \Pgxϵ9[F%d5#h1+8<䎧p(խ+Y☋AÄ-j9.:sSZ`/SjLYŒ{ܗe {+马u{$(ˬ>x$0h{>K>݃ev|l܈՚[seÔf(w~w˨{ շ;^n5\G(/֛+\uŗ[ΙWp]_|ڤcV&T?ݵ+qn"[o\6'QB|aYs?pK/M[.T9^GV\!Tvɍ6W}"d\kIʎrr=>S2δ9~Lϴ-ss "ގx'TʒiQAϸnw]ҧu\XS)}->KG]Ә}ܣXj-=]oAy6#9mjԔnZ١CJ%܈E#k^-h7OAԸ@a}ٸ{.iõ>rXBu9c'kK9MlX)fWsvΥ \#~⽏>'bףw-vi7v39oZuݽR;6xp{Y;"wLԕ-oKegO)?d$}mj)AOSlzsj5;qc8c D+vVmgubǫYG7z(Hk|vd<)Ah3A~fm'nr9aQ;+|+sJ>Y'gϐ('~xʀy/5໷\"7썭~ޜџ&7ާ4iNL}F\҈*}ײ*KŔ8&zȊg-ŠZTieUmErZM:5hء?76%mu nNHl}n7F+bՇ3ޜ( ܄v-"=F.9NsB׹ѥ3K8TֽC9CnTsszdvFw1vY3I7sx']#Y,%"]Ieц8ѐܰ]ֺ"ec?\t7D\Ȋ]>IU:.'>>Գǭ/s|b9|dˏsINMNh*-{nX7ߋfGn-m~ VGV+ I:*Y"o}ۃ\y_9ʝJcq5)=/].Q1vJgZO12֊og^nu|[7[3g6>5]/ ̂yVmn`DE^b]0jnl:[c>; [&h_-lBuig%9, X&ݍFgGgog=h980 VAB߰rV |daf_=>hÙ6ssbV x]ʝ}nэ; :x >6ZQ_2_+z5J0O0|n~Y}۩ܰ^*צn~I~- 9- F-:5OofNS?Չ\ cZjgQSƍ;)3O QqGMu2&K)k?nЧ[gx+=ԿRL-~&#LR8pqW- 8 :tTS&:ZdcBj\/}x7Z kCZZnXI!|xel}V qܼf7Lد9wݍ#tLN]>[JM{fr2מjYsWX1p ,d5m>)u^qqقwܜ ׋rsLr"w24E-HΌ"n_yT.HwKŸ- /~2+[ukɵ<7ΐI܀;isCm-ȼ=sn\qS>OXF,~ƞO4X˩^mfߞӕi&k^[5llue\+='Z9q_xs: 2 zKdHo!K7v\.VxȓANƜ57[ rew?_yPsjuh۪rMv:6?C\+FG8oMoamnc;nu03GȜzV#G^ۯ_a@ŀ;ENBolVTpwW9fsyHS"s?,s =5UYq|Qźy,3/7w{)FRGߕz,yȸoTs& ==zW8RN.Tص9qPn7:q"gw\seYNFd̈́T+.S^2dP#eN_5WE/iU܂Mu{Z<7Eea}ګ-zZvoIEͨ-/s^s_^O8-enVm9O_ 7'ܣfjz9E9թV}?T"TuZ|U^ շU h{n:ZbnsSK";M<\ǀo ڽk%bB~T;yk@Q}NНCq~KnڣWv7pg%T/7a/KNnחg…'_TZT|h'@i&=, {'!f =P!,P*0G-خ}‚P\KQkeX‚]=EX<[,6ngWY,eRJlJTȱ7='~}CX~*!K>N ,zfzaAs+O`@pI;[dK<맨-7_嚰!Sl$?<{9~ؚ?ž7u2٪Ja%$8 ,:tH.a ˄iS>m_]wxz5L1oעBVN3+GCwVjW.q]:Ka) nz]v\9jvV/WU]և -3JFD־h_ռNe~]7υVȳ/Ų'ϪZ̚/T>cކ%",^~+p+U /Ƙ)@Xpf8믄9sv4@X8w %V<|X,q{Y2Oxowk+RtjܥergcK[M'p0K3;&?-?…,~S=_-ٳ-N˰2/-| o=|C+]ľ>Vrs*OiGLZ$1H摆x‚3jIX,m=a2:-)n@kYʴ6÷;Xް.؏m?e Z|]M #N<76#,lu@aiW lvL|oN}l~Y.ŊiWcEC¦¾1/'uw\_Y#DZ OKЛлMf΄^]fz+ܜ~C*Wvetcy+c!SP7]قg7O3 Zd*7?i:%aAӛ YqbHzaPur'4hXE๧ZINl6am`AY:aX-ϯl]Em˵|͂~,eCeS)KvrY-!u0ɥC?t.m@~r3Ym+BW&g;rSos~Ǔ^ϋ{s_h+QڜYSЙ6z3M`ފs>wcW0S!̿e|=F¢SK xWy`JXiHMTYzӀ_toU$gp5ScXY1ۙQ5 #B|\%ƪG"&dϴyӂzs_(CE^Y:;+j?V`h}]쾬Pe4*ўy/xHxKBЎ;^5\} c}t?/t!{Wu>sc7nN{? (0-ILs#e:E+q#XQ+M-j>iGtkr1pɄA6MԀcd65`II]4`:au5y,j¹/GXзttX%XO/,Ǚ;لr$ ]t⏲"pgYOo&Kyniktöw_?\ƀ0X f,V_K~.`K. ܝ2Sc,u{Ni]%g%LiQ!}y6Eti>4MY/a?"L?6=amo s?Ϛb,mfM{ R!NYOLgTׅ vkml}@35>u`!Zv$ 5$ =$ V(đ▯,`YX͖{FfaݧMq'z~JV6%U _̹xa'=Y͍PmO!]FjlEۯS7wc |"\GyٱEWB"~z;=${0n4g~60EM+".ikK[ߔ0pkMrP;v!7ȏkb8OG"r:Xx|?LQ<3H wP֞0HS ?ˆqk& gnu\ӹn=з嘫Cm٩{-:|UeA~iP˂V+ly7;SGB/U}Ҍ{KP |5ֿNBO_7'kۖʄ GxhvrYSoN~{CGʉ7t 'f=y [gF,X*c@?B5ژ}#~ "YrPBbYA(3(*ւ9%H2s# yIɒ$d$忋]^9s}ezfzU31~ !hx/;O-~|` "b#D1҃1O]g,g}; 5@jw`ڞw1) |B1=7W`€)+Hb6 2KJ+ Iٜ mxSLvG";RZLn_[QoQb?+(0BQox  |vNu6]7DM5k ZeAN">.zI1"W ~b]} e>+6Gک5}Y{DF1ܢöXBy"^(ZFbr)z]P:3჋b){,Y9Ĺc3PhlNniX,xkYyЮq^ݨktgTٱn6P,8<8Lh~P8JEP$ !״(ThXml]r9O\I'΍U@Ie R-$;m)',xIK%a(U_pb˼BBqQL?W&Š׌N(`%}9|=ݬ]N߆@5}9Bz򓐧q o?jܬv0dua3QL\^2-Ō eS6-/sGv&-WRIY_崾^R]+ AQw j|m !]w3Mc݀wVY)&(2MYf/Dp_T]hq-}!"w1բ M,qeLqk(=}|bd}JD]w]2M흐Q]'4x|P "بYG}~8b~h7ms֋);|^+>nI+#)Y5HY)}}0q} ;*=uJ8o 'n j!!0ń g^6'kv%ۉV]=F/8eI1QӢ$ ڃA½M=-!q0k ݵ$]pqN1}۰}.r DcL('O1q <1"mМ#u ] d, aH4NOH3A*|MePL5`J6Ť/*PL{1b)a=(&l3ubҍ'?cd9O Ťz0] Ԃd5q|'}㡡p!]7d QL:AŬ A֖]S@c 2)fE9D1{ThŜsV8RL t a[{sH8ƦI,y^ ƅxY"_aƾzt$wBJJ=gGrn!FI2(e]a&Ťn<)QbOmWm'FXkb\ɍ!.y ~gwH:Ehm7 >IHFUO) vF3X{RoL\bXrbc(F ={vzq_Yt e;R)&|^YNRL\]z3ŘwM2)&<gyϛd$߁nĪeXP?{,Ť{VkMN PB1MiHv0G1i-u(ՖXtkڕcd%$`_} \3k_@1k{WPL+23&qr ; [*DbftQG) PXO1Q8P4Ŵ&@ZV=|>ʶ2p7H|>k&'D&?ˢBnSNYԬC1R.Nqa*|n bQ+@1*:nIvm4/ߜW357z9ć ,$A1p)" i=IR}Wn׾}A1fM+q.ٻ'^s_6ń=λXyxFfap!V^XsUu0HԽ st@7 en_Hb sҒ)F5Nb„#o6S͡>JK8H0y $첛ey<4AI7Xys])M5qxыQL"8ͣm2S(FeK7=Wk=VN< nN9pyL^뛺<_:gLsf}ew |g>\卼2[k?=ZM]6t(*/UpT{5Z:#ƛvf=<_#>ȥqF O:uMnkv_}/vs^mMrT4}}t~;mٱ塠^λ1F]?guaLu}p54Q]r˹~#j]!l,s]WU34,#Ӵl絢Ac$tymy/1%?zvţqE1zVJR{8ߌa Pkij#z,JtC kՍQ|nra$]A+^A} %D(z'o Tne}+7~dl|sjN!Ņٹ:N+6$scREP?n݆ܸQi ԜsL57N7+}j/vs2 n'x64<"l 7UW]pƂmMiŚ+y\ؘi65h\Y%L,{ _CMo+y 5/ʍۦu3Cu\PBNC$ϖ\(P'ږ!5Hp算\(r4cYAB 2KUbϿj[AET;s6qaMA3P#[ F_v.i"qaoy4;rj\e5[ }hAmm}oݩB&f{F+GNw~28 H9yЉ|`ݫs}`:8vTNk{:0Dž={]u/q`![DoNfMώ IzVie;d%": !}|Y'{mDEB2V^㳱 uT ;zo]g VLkld߸^MRHb{F@N雿C0:'{rKZ/ԧ##OOR|Oi!ͩ؟lo~Ra)R'c{P: :cB"?]>r!rʉv"Iq~O5y#=Q7{kLJ 7!1\Sh/rr(a.3A9h@x ~ƼPwD^|..|#A蟜'cwGt07( aL1/ bg9oۜz؇9%_Ѽ4a:qľh`Lsԟ>_xg1 AW/ȧ(vr;gx=o4&Phhߨw~#+8.mot\D)P{ qIc|> ?ʏzBTbq"~$Q_ʊJzy#XS38!"Ƒ`̯ިvchbQF EAG^BD?xNw|ʣ!?@CB=c|@ $ }'q: AN'AdyC8qMoux>7(/pEw8oĮPOvB}^e=+yljt8IzyOIyNy_zg{i}Dt`?I5ht<^{?qi7#_H{8'i?rb<q ul7j\sʧ~NWl:?'qq ^hg=c">s%4^7l'm1Oxƒ#: Ϋ&L&d"o ׾G)Ğ?x"R4!g,x{>ݑh‡H|!@*OIܡ H'~O'|m7b%H\#I ~H.g?!y3݉#٥>'1l5H3(+r}ǿi4.`J%rGÈ?߱}t\Gu] D"93vI9C !#!$~K'̻ *G2?:=$?BL$|$yI& /d~DJ%qہ8w@"GQ8DK",T5XwCQDD(f;|O!q^~OxgZ՗ưv|$#H#vLGD{`҇Kx7ը&Tv#T"''gc64gYلW^3ɼ!^<~M8<#6g6@WQ$>q=CِB#'Nz-9Dߐ< cßȆ@(G(!oc~ވ`p"#ϡ\h?G#9D'{$OAQ>̿`\|yYl_c_J.1{Da^0A~xCNT)u R^Uǭ^>nMRl0KlGզO/ Dtb> ~1^b\p{h‡Q~Sl7q ;QU"{3(a!M$yH.\£yrI; BRGMaBg?'OS@g"{!'WD"E$~;'#zøO{%'7*/y_ y$^$ywOg^. |O%-;E| 7D.I~٤ Q?`zH\9k?W|O?73Ю1<\?/2="aN /0P$J&;='$N)$3W1ߧeIA׃q$I;:5S8CYD9$O%~sO8>C#yjY |N 7|9=EA$N}"#B.!v\Lbe<)1W`82 _>B?#GAy譀WH7\_D"2~- g1NO'gC?@{'"$_C($蹘] +?-$`;qy cIvKD'E6ɻcR aLyQwN} $)i;wP`~EG 0?18os#d <|>Uh)ľpAa:q<g<p|h7 %edeqVD.nGpyk7I?~| y4whwd܁+d]AYFSJ0K%>3 /a`?, ^B[L쮄QUH쩈o)"vPFQ2eD?%)b;ț8~Hx%;Ⱦ11 sB/ZLE>>Ayn?dzIy6.yc;Dydc|G{ 8s|&[y3ةBysB{ƪ6PHcK UTT"VA1Uȏyȷ~:%z'PBO aey/$|B-&?3b_ S"ym.yd~xy]))/%(#<_BxQN촂䥥dUAWIx/&%h#=D/'*e+_R$y%[轒irb8^Bڇt8~rN ˉ?< 8BAhe^KID JϷLt8/;X1>lU MGo@Zs`3i;H 8K=$a^F1z"y^LpܘMat#=pQAOi&X>>'@? y~qAG?o1/v!_c>v2@;B'<:B#qY6k:ͧ>/FQ,$Ϙg\ߩn%r"!ah73,YO( r<y Ǘ8P1߃~dCy-W<.#v[Iyj$>W?B{&q衚[5J`Ec>\N4#,# TjR}>_5jTU|+/988oYJ즂;ƛJbd>-dTEWE])o_ @O # {ϟA>D8ߒEEtj^2I~q 乘7R!|QB-% _2Cq'Η$~UN'q> I.%K P/4(~;e$!w#rbݞ߬áq֌;P} F88q^%J׫+H?!A 5$D?CpS~O _CP(?xVE OK _S$*#ɣď<'/P_U$nTxPMƍQ$.S}ޭ!|_M wX)27 ]*r/f%iOsijHRCm>i7#'Wpޖs~RFd uGUx}>A*4 DdW:&~]Y

SN "l+>-&|QĞҀ*f T/T3H~RAl̯0Ç"`țH*!W~~.']s.pMGzp;,"~ߵw=~ϊ-Dn3ùN ׳uq7w6|w ~u{k-(/~D9ۏI {O]@P\_zs~ώwո :~Jp}=]J>~̱ qL(' *??\Oz8)xMz8ׅr# sw/\q7+\I[XYqCY$@D}I>Y;[{zXJPu(wzHv/K%>+Ўp=s8CDWoʣ8܇G} #b*D~\/|.:pR/ I&a~K ~MWpxyu.ϹOk)S2_w>Oȉ9[R'/B9~^= OßiQ>X/z$>Xgw/ݸ~LU wt A9\!<˹^s}焜~ c(U? CM|\ܟs;|Fyv\W9A= sE ?M'l7' G| (7%Fc:(/hWnI=z4Ύ܇(g^cS^G1/8yD2?)r?E.Y](?pRp ]g@kLE;\̙8Q/K$/=!"?>+ğ9#hG/s% s \¹ M[wi^OqGz)QR?z{oOȣĞQܷs :'170\gס^"DQ"@<8 ~*Q#\@}29sq\N?9գ9ֵY;~8ǣ4/}(Gq"/^yQ"sJ(獼܏G~4_韮某ю7z!{II8tcކs$N\~ܟ vegh/s_Q]'/~0G>ȹO')ʣ5J }$+4$ϡyW+<k~8݇M1;(t:,GQ4WGs}=> /{&\_ʹ*縜s\z'+?Q}so'8<)O7>Nsb>BsO瘉#(լ3/匟y19D9gak1 'p<o:Q/S ~|zgOB@i+N?<#ż/a\78rqzv"b~<"_g"SBq=(O'+~B|3(}D?8~QGq-W羁?6wi\vEɣد_q7BǙʣps/<Ƽ?89ʣD>KY;?N=>z\Fks8?D7&{<4D;&~AQRʍcoPt?|sY7=slewhݿϼu7vc7vc7[P6b< xxz`y~s+tT 5uu1A]5n5}~^#]I~uv7ɶh=U8yX[_wCmqVa¯j~:ǿr =뮳οߜdW{(``۬ٓ'جQ9I翖^ t]Wo @,hz*1d48bOGGЅzhM~i8Uq\qir~/Ӓ~Uƿ{?_~uv7,SP1:l&nk,bO?\3Afr`1?eOgQR4󠪬qj/kz&N=&+KPuv7/0=0b r$k|?I;{pm':77f=l-G_bwX>__o7$'`~ opwu}uqn`.Køcbx8⿍;J d%ȁ1qMCyXp]$+%A ;n*(QPEP>N|g%٬OrϫhײtNs_?+(\eZVOZ'w3Mbyuu-ϑ?igޕ7A$^)޺6 >)jܸՃb!oKu[(ڸ3,HPzDҩP!K?(I\b8_IX\5;FHkmeSfܓB9#3j}8!CA>ԝ`}XAic2̓%3DZs~>E^^-} Jk&V}T>4^>N1\/[tS!~T݄1U~yr> +/fv6 2>;gU#ƣϸ|N; IeNJyIhG")=]>; &KI s)1&lp`~ks}xOJ918'~{@=H.ug2ju D]}.).߼zmA6W+0Ed> aj{-kcQշƎ ½>Ė c쁒1GϞsj(70mzol/~K(ܝBq%ucޭOJ(Wd aq; vk1f($1wh1<(|_sq(*߇yeNn\i'o[,}'qrk-+Wv{KU%7wjHm| "#O]a[&;rז/Pbܫݟfr Y^=uyTz7XVm;|œ]V0&,IXGЈ0%_yZRTsƈGeNף2ۗwkNd40`BߦfL1!Nr =.x1_B'JV:qǦ&"ZNY oSvnjS! ~.|v85 ee |6e_y⨥5](Fv%cdzņ/Qlqwb clƘ˙wR^-3tnOr&ʩ!8οuE? Rcxۺ4Ƙ(4:Ȁo61T{T /5jfV~EFcQ־iCpY_w)?+{Řmoܗ C~r!Q>aF6<>5lrÌiOQ0#!I92^=;/Y$|TcM*\C}Hoߖ14qˇ0FLۧi ~8+bG9JJm{{.)|S>bL!ԾԽy/t%!,t!4}hsYV7HuPtJ\+~v{Sk ɐ;}~F=cIՃOLQ&WҸ΋(~SaA gQ|iy|âcϻ^zɯ'uiakSЩuV{ &7rnyϰDC][=8O!:\O]=/b7U':W,ai JpޢEњ1YkREq/W]e8P[[Nf =2,皷R 0Vh^1\|j{62e ^+U3"آ kz-P?RDD׋"U]^\uSW%<֯Eƽ:oϽL7&›ɻOD9R9D6@T wB7ܬ`C1;%N:6Iġ )K)Fo>V5f+|TD3z>Ev"T\p$izW!Yjr{hFbޮV̦\X,_EBSR듷3f榜g*R9C+l(I⫏xp_;n+ns)5sm v闬ax׾Em>,ǰ8ܱr]o(*:,@2WB; F2UIV)^6ƛhS9?a?CQ JFP1`Θ6iޑY_AYʃzo- km閎yi}{X/ԷX@%~UPU'^sgm`^yc1^Q9gOC5B72FJj@Dy!%Vd#d]>PeSe9T鯵K Ge,?,ڹ($V,5ꯣN+0DKKIJrk$/9y"Ma\dbDTۘ1(fn9R퇮*}[#FPLqf~l $.(4e T|34 gQ"Ƨ@rxU*zF[FftD\PӾ3t4m|nl:Ţ Ӟ9̅́^ f9T|Emw1Ӡtp+IO^ IEU}@AWi<(۞냬NdF行Q6Kͣ nj2f Cv)x 7qG׿5G΂'_iϯQmSC먼̧h/Ri?my\?ToঁxVq,;{{X'>ysngF_IKmE>Q{/6\<> Ƃ{Q&x\v4 = oXCQ)ST~ٗx9;ガHp$k_+x[Qwتڃg?.N>Mqݽ[K7X%Pxq crǨv"g$}"X[C(fs4D(vV)Qe@O;{3Sgy4bA: uƀec52ԨsYFʶ2Gd A(OP6qjz{O=*R,`VD7{.n''?>47r)^SΖKj6mȨ{8u^)r{_g*`z)rQC>`\6瑦K=nS}TRSRϩ9Ca>f銌}d#B$e P0y~ >F6;J25?9e_]@o?xT D6G1+J(iFT 5)>8PzId;chL-&EyneCkdH٥U(]InFϨ7=`2F^²Хb gw2i?70Udq^|ϩG ?z)ŭ[[˜YjlRdR?*6 JLn y]#ǗAK4żKOWU\u?Gg !L;8+,#ʞFwCzG3s\%?=Vg/H,e\]䔫çQ[R:6UDžcLgI "|=>Wж}>ߛ}[ijC9+Wf:)1Mtڇ #<wSeKQN7K߂-\_Ψ*PX)R_:}~ªM vۋ[^4^9Mj5K9GG=nKf5}ƟOT-ǑVMÍ]ۓ~oq?LQ,k$ũr2UF }`0.k?C뼈Ķ3^3?:KJ˾ձ*PZ[n?i.Pg?~E͠,QfxoqQ2<ƇskŹ?[xtyG/"%v-#XP_SuVy@ɀͪ7ҭG\G|!P:VԝZQ) o:_Zpzֱ9PJY΋}> %0.Ns:s֬Zw܊]=s̓Ynqm=i97\oej_Xm_՝'@՘p'l|x y9h>e{(;Mh_Svdf<\3fC OsfmIt;s?wΥRho8Y4=.|eGg)P`?nnu皔P}hT=y jͬ$Lz݅M<k3b#\6'K( ~p! ?k4jśUAjҪP6lp&5y:T8:[3nXb]ņy;m6oYJ27ņQp~5 (;˂-qbГۄ(oSS&0˜WP7nẼŒ Wm /e)~n<#_5n;ߖ[f8rQ^GF DWea3yEnp(6 M%z@QPSKsnB1BŶo⻍i@chaO͚EP'l>q@e>NM- FBsv+F̞U_B+TQ]]t UK+:_J~ܵ4XhgET~d'w#(>2ZnR ,_C F:[ ~SGE?Y_B݉~ϏnGZ_/NS݂ [f zQPh%/+ַy$_l0|%rxV9؁!UwRl8D`ҏ X _k9D|Sܮ]$^VPparu!?_Occ,5DV-Ybː$b71bԞ9dtbiRLQ7CD^P+Aqr1>0>){mKM+ Fhdb]/8y04tY&W GPt"s~Wc`Jx5JfD 5D0pY4av$n6wxM{\nEEv~oZQ0Ic|}?HjGZF\U)s;0o\{Fa%0twsE)\i/Yߐ _4vʀʱnZS/}$=KJ"K~T(M[ QV jzKĆ^Xsf5P;;~(ֺkC8fi%P}h[.B߹3L`ڮ PvJdP?4< U7^Xw1T w>c.Q?0!2x ]I+0fZ9e5"Oˍa/z34̗)2x?FY0ݾ1 {恩oTnzj >ާX7d^å+e#䅎@)aۊ)6M߸;~MMoW?Slp5siljРb̙,;z7)UGY=|'4:_Em)M56⬕Zp$3%,i.b){KBWFAp#d(~=hTq*gAaK2|45aU{QVCWoƲ jy@޹kx,Xňw(7> aEPUwDB:"ņ+"|y"UM$t"RqϚYn 410fbG= Yi ָEGt%rr'ӟJ_uV&]v[Ekh/qKaF GXO74Y+.O1_ǨM3?ȷ|]SSW!I)\kw`V1)#oM.a.+؁[(2l- a]} p~AL\~$y'0߄fY Ξ/'.s)vaJų^^kHYqVR=C RV - R{L`^GǕ&,oU?<`)p{w;n""WHBuԲ5|a/)+aL7_:"Ы`r("TO9$MC+j9UyيpuYi_@ mׄ[vf…^?)z,,T#1*M@ ^SIF1jڳu/R\8]v>0.K>bTzbN{]f3PY_<Ȅ^JA%Moo烨䃳i% ֐btbmof;LzVAcv,>o>f3۽]4"+F_h7,y͙ CQmiouE1+U~ղ*6nryQwP3m#D2@1&8u|hυ֋!zlg:O&11`sƋb3 /ka3M&ߴj8lt $ tؾ_J_@C'ӞWLXM1o!6Ct51OKx̉V®m97Ի$U-3K`"[d}3LRwp y,ڰ>A_v7q S(.+X@[;.mwdb ڱr.r= <GሉZog> /z<3|+ZHpO0u ~{蛚.d3zO3Z{, b^ut+7}i9tvgEKsAѦ:+C +)rPgS=_1ۃdU+WZn8 U*گpr<чBPz`vݥPx]al1J{Jk nUP w7=r?EǢugSL66kX s<)&~1GH,$0S &j;dY!&3Ė#vh:Hnky!Y]5hjх…fFCՏ[QL)NS/[XbsNV rt<|п}][bN(ECNBPuգgPT]r  ;6k8]),ms{.G2t}|r/EzMuR pY[|~}}5~G^wk $d[gueJE!q Xi/3c x* |ć 8fӌ ?/O z{n nnZhMӤ-~>xc;^SbGw^_Ty͑r#fnU2ALXAXƸYу]ËPgt\o3|ග)z)߱bD|t27e}Nhz.#eA+ma渘čUmeVYKv?fҘ{>{-`-tܾw]1ymc!)zlަ͚Ek)\+;;z8Pt;v 8m]kv\Ыj~ ^sDbVNlR ΀`Y_ڌ-f- D35ӸrbpM[ډ-||uć`Ա(29FD!A:ee]ִfmʐp!85S.u?Rq7Rt/X6UY?F9yԘ 9q$ 'ty~U KM+Lv oFn6 ŝDQ-u 0?i<\ǗLOæz\*\1CҿPx&Ы(]?ȜwW!}Xv ggJE{c̗)7Kco):Dm7byo+L`3N>&2hq Jo)z>%':P2QKj8HvWcvߛധ"lE+U[y4+'l?;G*\g9?y{/upzI>^Al"u-l}'Zgugmf5NODeQN;^&qMx:RpspI(ɻ)}Zs}#p{yJ<\,ybOQ<`}.EWӈZOPtRsM-כCʳY_,;_3oڹ):(fDSpuZm' >^Sy~ƾy8²=sQkv逫;aFK,Z pSh=.la5V./hjc( +_: j_^;?K|ǼGLљa7]aϤ +6a9{h<gٽ% le.烎A(=bpoL/r#):2$WiGܢ&8DIea6õ֨ͬ=X[3:Rg'NoZkGų=NaPp]599v:gN,^,@UpJ!I.bKnO[ŗ#ׯf_L>3{7"7.hᄥ{QW4KuUf|9ஸ63jkNMpQsuImΣТ&"SC`ԞoWX ?{(0gR)Ba{wఊJGp۱-}pebCZ.mNn/V"SF9c zFh /+5V1c]yEiߏBFmeFV*9_spzjrE}_ ;Esrs8pkuk-kp'`yLAv|.-zaq6v>?{=!|㺾ޫj.׶]Yy/v}<שV߫tϻ#u\>Z\ᱲ󈮟ӛ͇{WSǻ>US[1\ҥ~ܱb[Sω;/ްÍJϯY p?u9vZΚTzm]3%]?=Œ9?tq>zx{᧺jbb=\X~Px/*y2.s5_Ye 7V:{kWsaC1"nB[iyrрP&iQuTؼp*.l\o|i*Ξ *~O6e6JAxZ,K 22Ԇtƹk#㠲djtlmo17zvKyr2 Xj=jVoPc81l7JΕ0w0_]1PnU ̋͢1[̗j}DgauJߕDR}qnpr_n >dc ޽54.|(} k`jvL1A똍w@ZiyPU_o(RM,^5J[ 3l>0; f'W>r9͸߅ Pj#J/8@e04.gj8 ߗ]I 3rgM0̈́l|ۓ ye*yEo3xWZȍUg-yӤ;aׅ雴 rU#Y61|-4fKf1%~M*gҬI6xh S*ϸ{dۖgi#/{=b ;/6NY&={)#&}zK͑We6ʣvC.w $}+=|}DJN)?[D Y+;?}˞)IW j^se guSmR\3oVWz%ĆK6-zށJag 3[>+/WBBسׅ[ ճJ`r빋h]+='ΨdޛÒižlw=nT*7Ga%<qe{Sb= i=7V._<$\Hm'퉞mW!{LAoF}sxZz݇{Ɖ p2X <{\JUfmmU(GAsIo&<ϵjPp=eq#b4LyB ui۰wmgӚCs/էZUG>X]y7kbpޢ8 .+DhxAc_!ޮ ^埔3{$$|oZnI2:%[GAk3BowwH5y8K\t%Mn&8FMz˜[@Wp C,+ߑ<ǩ S!!uKf߻|prb-x,lӚYVU6d@!`:T3;eE|%9]&;[g_($v{of5f'\#=dӖ׮煃[L/ayO^j:)GXŘjaUؿ쨀փGݲC0u]r@0W/Q$9l%Sv}xa$7ʓ-ϭmygX 5yYYa73ʣO6L <?o/Yz[b4xk>Gyej:S>_ ưZ|~eKg\z;o }5lÑ4b=wPx]9M:!kkbo=o۳ڻ5g֌- ejЦ3(o;6 4Oq?;ުY|:S8ǰ BaCZ@5'i'rzN{6):zܳ]lCk50ݴQ n҃-gџ02 O#r=a{ qD^NDN7}!0Ŧ/jI"Qju.>zl%WHq%ݡɣUJH(%}ى|(gӸPFˠRrH@ՊOvb PYU;v|;o"TZoKPq#!n4T?*'ovt@(/t⋗PlRyg/|*/J1eKCO7¢R(ҫo^exT`>KFF15^?u)QgTu3P^s 1_^E}X#PD"v= 'ie n;ʀIF24yH0s=$IzyO IlwV $BigGĜ>gLɄwR|Dβ#sԶLˢkK#A%Tě"YK;.9 ksG KBmnjB(~>G(Ѻf.l= WUNf/}zz3&/ԕK A":Uס-(}ATPJ_LB7ߠHn<nț@5*V85y .S\;3 ^PgSzu(@yǰf$/$vP@~Pzq=]0WګI~Pԑ~M^O_;RU("NE&Py.itQ|vZo[ďN۱r9;*lEX,ʢR("V])ˡ]>1,^4?>~ ,#ry?C<4֒yOamnGbm/s=~ tj7gƼӉR?7[?ڎN$D@BZ5j8* >΢z(kl|1Ud\]1 5j"iPJMġlD1pߥ\55,4@͜ TF=U^EPN@wwl6X܉&o,xܵj_gW\C5$אxJıgZ2(EjN!'@횳ZgC&k{A-ZU@E ;\rHZKDe?/u?$?%y2w)Ihvgq2|~~΃p(.(ꋳ]^.vԌ=v5@q|Z>gUb$^)4whj{w=V0}tYst'=8yN܉r2X9E9tUEjT:Sh1PaydK.PA>34'mvPF%w@7@5/u"|r;2)#E7䉵u~7q67 g=]5g7|;SUc" wkٯ9ư+™4vZ*p/˝4lI[vP#yԔYTIѩ?9y1! :}ܷqGuqOԒ<Nq⯃5w]ߡN(R$|?xx4lYw\?3]}˺_F}a~7'}gysO 1ޫGdٹ(_;jg_<8bK4_$qjԟ?ծx6i9vE^}oţ]_a_)sϧ~_kk}y"ɖяGA)(gaRfN_s̉fč8~ؑq?'1"uY_^A"gry(v>OYJndG@W?ͣZwv)̛w%ɣt>y?9o^۱Lo'NrksE9yj?o~Fa <F|m '1@0/IqoLwe/yGqW"?{O &߽xk ު~C^lQبh :*\Fևzθ~ ױz=O=/7H<%w]R_m ^d}`Ctegлדp}<ŝKUzQ^&t=[ޏQ5"f;]f;r>XULuLtxf/pYIlȺF~\ȹ. c{+"/ϖ //l͞vu~_i< KyT~ d\/s8 .|E[p훼OH|sj/Ɠ$m p:ɚCyq;wS}p}}<(~G;,%gXiJQxJ4#}B/1es/0veC `2}}>q#Dq\@q8PQ}u}eQs풂^}ػ삧J|; ol/Ɨx~^"vlAwg= 쯞 vX'plqfP'%:U=nrQ?"J,gw ru.@yD{L{3܉"N5YT><"_B(}9/)װdKbzᣚ!O̓vv١yť?YIX[˞l;HpQ' SIIMIףݣx̽7/ 0٫_.`Ԙs5:;69k:@^B#\>1~?ȧl )Omx=84ZgΞwR(~?8?țԂ=fzȺPeQܧuMQ%ɧpDt}=;l(Wwd*)}JpoǘPGyThȳ@yKi'S<`xN*hĖ#{>%wPK̋g)G9Y瘉# r!zB)>@9)eGMyC SBQ{k=q(G>rǓuG~d>d>*EQ>EJ쎶+%hP᯦x(ysCq9̋<I˜<:<|œY1qkM I _£oۨWv9GB~Bļ((wV&n%((g>Jy9s\@Qb'G }]R%Vuȣď^[2JBkG<ʜ;\@Q>ȣAd^ |1Whqf. UELO'~th $| !{uH b>rؐ(+8x)9dECH;ػ0(NP2DO}Ae7~paݗ xEC1=9Sgi{QbÇͦ#s?a{p@?r?(g|%Vܧ p "?Kd2Ofԧɋ8vZ} q>Eq՜7QW<0p7 /pWu>r>)d9Cy݅[y c?Iځm xyԝ iQqk߼Փ׹_ 'i\"o~(΋z=ņe }Gd?RlΏ:~A~$Oͣdɺ`SGzH'P~q=gѯ< {ռGg*:>1^q(EPdu ΓџG1rV9pcjhgh7t\H9gQldmF[FƯ A<('Qb_(ϙċW(}x{W<@NʣG==Gqm|?O#(SQy~E;Gyqߜ+.-C9xZR\B/9گw˯::s4>e*F čUuUU0g+p&uv߬_L0g,,>JfT5NMe 5U0T1Udɱd%c)::F6Ad3Q'Igx]gwS?݌оǑ-"r@1lcTa|?}7e~7tuCmuYƝ%óƩ0mlQb&+AUkΓC"Y) Zv[VAӏb*q?+feZ (^-Gsj石W^[Dw,?/˟W~°:N>wlϫèk9~_:9~r93]l׌::)pM#) RR,KZ ˅U%ſWYk%zUY{%V +,4x”qu![.m?Yٿ9w8g ~OFĒ'wMw40PTU}%f5 y].W58˩:,~-;ye+M:j/R]s%ϗ^0?gK]n&KD8Mbt6 ѿп:_|v۫y:\l۩$f]O<1?X2x !80#8$SN#8,%J"8\~brv-69y뷻76PX5vBT9Z߇ZI\=W|/N!]T$ z 'Z/LĻ ,4=<UvC oT hf݁F^Y|5~?S;2T4{Ql}F ,K*1^pͽWvO/wn,hԹwa6ٲņǕ,,E;[@uF3q~oq%xAs7*g󬤆{]MVg[Ffz&]1gʪjh++b 8MaaQRjhX CünPw|T2d78aR(n1p4Im~4&b:-{k&S>mEa')=LaшSRCS}7(%VW܏o RfrHub&{iވsY\4xO9O'$B e{<_Y%bmR6Eo"AkSU& ڬg;^A]{kg^ G=:OrY]Q?e{j u5=W@}+2P-r6zšN;{Efk>B}yHK}k]eڕł6d ܓP\?{ŚRֽ,u#lfvJߊx~Ǘ̠nm^P_bT>ڳyhL~'ܘoi_s"qKDdc +m jWCAvFפԈ>G=1M3X,!0d4ԧڹ_; Z&XK& *PHR@E< "$$d0(bD%@$%)$H9gޙݻw>wC>]][{jag?< қd Q%oϦGvbݑ1L͗x10HD\yXle胫SK+kt\75`L; ԧkT.-/3cV.t[1->ZX19uZ-r} he빆DW6 IY)/_CW?Z67s=s`#fi0hoCOz C pO{QM~y9lcuWđ뽗ٮmM\0"J8|o*؈|ZzX"u8~ɶ\b}l~ Dx}}5^;(C zo_RגʦY}bX(!qe0R7ƀ]1.6_OAg(U:CM5ID\Y,KdwY /$8 v~i8O| C/C]6[ !?UlDD"N?p'lvݹ%E<"I}dBqz}^<D! }[`rrYBa9ac6>Or%'p؟XW36Pڽk= ~55vOj8D:nњ5iQæs'X7Au}G4)sQ-K[QimhQT}NYşqt_sR=_w&'R؇LǰKcG( àMh-.i%&g8o~bFbﷂK?~/uJ0D=)Gk2Bb(K/Vmhc4LRn pd* JMUD.YY@y3smha0rf!&h C;~^>-0_mN&f~|l9za76/ѡ4vDpmon~`z{}~:] ׁZ(#{M>^Ж۫Fٞ{vShe&a @ӹ)ZGgϰ qb](4L>jȧsS֤ 0?o;;:beåVLgL#NAw赡CEQ4ӡQ ݉׳f{hG?K2έmx,,X5o}ZUxTYF^r%ruF|5ӣ̨ >Jrr? gNkqOhL?b˃s_n0 ?n"1XcH]t4%y7$47#nׅX,B.-b9Cksv3JҝV !&YȘaɂ჏!^.n;*H Il{ ͡rg7ӓuf) OqɍEΊXUZ1Lm={nPD 3AQ4$QTCV8i "6hwԕMm^h. }+l4tEqg Ǧ C[b햐<'/Su"F kB:YR>Fg4L~@"."FZ(Ȼ]m!{*9];)uC~Hs M(a٠绪 TU@C_w4\9ReI|2<)m#k1mgyNm\(me7{K8A ϝI _{uJӢf᥻oPO h0#W;Ļ>`ug%HBo- ]0s4j21 cY[9q\?g[PCкW!(mY4u5܁S@cy"s BR{^bA&9yEVZH9xMy ;b*7"L](d>ݧkeK^kAQe^K౛>bcNA\lJrhau,m]9#Pȼm;HG.<Q t5ܴFu}#GD{v]L-jwYGW歞?`SםSĞF9 40̿a7R 7߆16ٸ^%V1[7xC$ˇg|tE6PPZ '.t*ذ*o Ɉa;'2 , KH~/b)+f'd]!j).},y2u9hb ~|{J!6 [Gb!`I5- ZefMDN ,zCFd!eD˫WĈp RHZy;H~ aۜ s0Ǚ3Ԭ>EN~8bcbQكn`C6ĝ@ _tf7}+ bGϿٻV1Q.;g)VM\fus.}ia ))rne|qj'2Yv~۹ $٢wdc1}v~ bwjq AߗȆC1I{C,krא#)u9#&D9"m􍨛.zB|e<9tFY>{M;\upEҁv^m`Nɇ-}eupFjT םJࣰG9s9"LO'7l2K+OR>tC߶8~bk[>3j4΋<^e7YM)Zyr`PK6yFc5/gqXH;pãĬ nHٞW^$6\p#a! {kmaujL ~ӫ??o 9F\5ʷ1|L~\>lGa'_S=ɮqO3@V1HS:8J^PsO=,eX[ ^P?Haf}Է&9qdD}0#L9Ha-^|(bdv*e=[[=MVn޳i5E i^ɪ=מc4b?no~dA_V~ b ] /1/#اsZb9 +ӷۃ_ضx|OU}=~%]_~2y7{g)~(-śljLjUlF|tj=%U~oYm6ҹ*u35Þ{WI~OR0xWI6}V0!9=rTFƖDޢĚ] <2ޚh5GC\)5|,7 [WgaU|v0"{W:;afp,k'f"{%߰@:FKdUpA d2;`wtCAı >"3beM^̄q,[<_|8fc@5?Ȇ8Qm8=Xjy/72YLg5"ԍ0: ^o9^sE7Β}k ɽkps 9U!@~Ynf7y %c" |"X@ 0qJ|FZ_"w~(qp%]~CġҘhFA%}2#,9Btf_yqԞ>9<%* C'3<: >=oAQ:wo y^'j}}#ԛ=DK"F;kbZ_^y_E/ēW~_!R IIc_ %{3bB >| 1bq#m.`M2_V#LkMX"o~Q!bhGGa-Np+p#ANv1q|dQ"!F"İ҄GO@ wa:1Kffyw;]bXbppOͲpX咖>R{>Dlwⶻ$ϑQMp/$gcǕivs+qtǸBdS#":>j)Dc";nn1ۂؿxܙq}/3 /.?qbbڀi:n~Գ"7!09J7Zq2zߨQ:yrnǎ/YWR,ƥqD:GG}F|lmKVDm6|h,t1. ;``']g]wWm@o uf9}|ӭc8{BVA1+^aSڊA 98"ܸq~!//e"aހpy\ xj]vRaN=|[@ MMRA譪vCL8mH[;3zSS GVLiÉQ3>J- `b:n2a>LE} {Sei3`5#yβY,  pj/35?RA,%M=՟$1-ו:G.۸F_~Yզ#\FC09{>;~IY = ۄ8VtxRf:YVxpems#އ#Nşv8>!VwqKBI57x'<0^#+ .0oUpAc2U5-{{(;:N!~!58p5sn+Β5g1 6/_hO3~|uKvBWY~w1`fvq0qZ )đeT?.FUxQq~lDƝ嶇!Y mT[D|B% 75IJ[Nև=9~^Ao~ wіZ2>epB<[yџ4=' w}A6_L!DH0'WoC 1ܺr$bpY 2Ġ;t R6:sK_炰/]#*vD iqlD u'kbKc$ 3_# ,B9TFG!l,֟yK=0)x *h>bz< xT!7iňjY?LDq1j+N-":! J4}Ap;bsڱ{ড়_p|b X1_(=n1qnW,u{F2m67T)Dplb*V)l )bޛЧ![= Ajaׯ| b͛M"v#w2p?D{ŷ7,b |0İ6ňyffJ k:b:u$rfE)D.R9 f@-(^2*+?Pvq-fĀlӦY*&[$5u}E z}BKTѿ}gkbZ@L~ Dƒ̽!Hnwx'W8)1L)1K'ў^C[";d#K,:1ϫ{5!+.اE+@0 F,6ma\G 6 VNwNȭQ nj9F^x7 NPaZ ۻ;qN+4ķۗ5֕ގa 厄we#ZOPXhd!DL_* 1rnl5=bwy MDS>)hxAUĨ+/ͣYYF\LFLȼ"WĎi*9l+?ƿkfz;5R׿B]1JƈɈǟ.lGR1Pi -Y:!g1ijx'bWFKs/utt: pF :uL a˔_;%+?oz ;zMW"ֵ><ؼXC~r4#|=b=.c%sXt;69 ի{蝄4ϿBSM` s 1UEKS5bx]U b\8}篈bif  Nd !F5C̴oTB$OIƬn !+֦"sH*z`f$bȳ' L0A̫?ޯt3b]kbh,ӟמC2GDn5}O[v݂4mZR:|c#{.h|j9b+Mt(b.吶;]fGD>iYɌ^Jy)懙nҜs1A(f"J&ڝ!Cw:yYliZ i5.1~\ by=ww"q1COn=>g.7(G,ݽ{1W;G#)nJ<(.6ܴs͇RNG"VUZeX1~K(S/OcDk;y8Xb=e݈풇#DܮsjK pc]рV#pn}p 6T[<5El%XLd0g7ޅSrK7ɻ~c102Gy5[WwnOkz޺M(Ȗv&qC+D̽Eb品/Дr:Y ",9,x댬i~]IňuiuȢ0]qfhr9TiJo9Ův$@LøabG3BOSC`qnG&8t"j{2"Fwm߄ЀHƥk'yd@xK Eag['=?ImV|OXl؎8bC[ |tW83O #{>= GOtLOXȮ\\ +ikAja5$r={['M+KADov9 fTyێ5At<;׋g!}IT+woDO^D?Y ֜*M/.QB{n|탠/Uv#~1һ}e*D+/= >T݁gA+v 1ktғ9+#9* A[iPI@`T)(cVl&>_~0Ɓ5AU0*3Li@ 6j`.ŖrY!K}LAu4/`[4n~a009%8YMXt?iڀ blzH!eK%=y/#FSu3 Ɨ KE4' Fz܈,{t"=g^+zl#Y{VK}46"z^SD񯈞㡼Vy.3?;y06Gb~tS2͌-|B,&|wG&7=U[~W{3 -fy|]ڲO>-JWw!N0C?e9Y 5L˯r~qqEEӹ];~)ŬL&{>cGԚ"W>rѷTmGج!DOx8 >XF 1@?F-RWeS|p9M p ƳtXCoܰA."Nw'_s^De, J,6MDtKyM2`L1:W&.Q}?Z;Rw?rk^NՖ~>nӓ Y=ѯ߆jyDl+~yyFya迪7- }_r<GsruPj3]}1P;6Z,61s#ud??~Eo4B}:4ֈ77]mCvW^ 1h A8 z|4AC㛫[_CpS& :N!^{-[&'1GbR^bPmznAĀ(/k!WoJ` <lnzzK™G JU"1Bz qo&_YN#Ɲ+ 11sU{#۬zl̞})RD7"WmӂR jêt%L_ ߵCey0ҍVDeO ׶O=ډI&PDDOiv1@9oNTnD>eqDߕfAE/=֌3ct wVw)DZ me!sI| T~0knS8y[9D/ Yξ2 Ear?sѿ/YF"뵗7 J4#0ZoހcIJ27A T`hkz ;' `춾jĐwL+"6L6]5ПW7g&ZD%rF$mis=?#)?qQqW0*[SZZ~WJFr3=ޭ<>XL{/zR(9qe[闲G"m/.gn{YEŔ7z3>웚_[!Asۣ^o5={rRޔ ztt.4[єb Y~ngWPG}9lw<5{x:qHjn{WKsq:یğ}tmfR:D>]e ZɝG+y漏t6^?\ǝx9v=vn{Y|miv~YKV-v֫ $綟R_rnە{oZH'Ge;[!rúY-eblN sv%S%vsQytxQv{OיϤѫ)ԫh]y>uEsOqf=: vnO,2Od.s.pN_}?4W uް}ן& m;w{R10fn ש]nO6y?Pϊ'lv|0K\QaNyNNwSv'LAy=_~ůT#̃#K(_Q2q~:xE9?h]OSOw[GA[ϥs z}xGR^v7)P7(p~yGO@yJW$ 6$&CeyߪwB/#>L sQ&ɬ]UC<,h))g, dp2u˔ ii(ט>gt k8 CX4v0А\i=/ZCmƘa*;ۜuu%]|Lc0mतZԆkCv/yw3`I`XLR Ll.㽲3ywtgSM2W%ƬpKueg̬\ PP`\z3;n42y(YxL-`cYHڈY]"XqjϾf=)eq6\[RK7{,I]Ke2t*C(10-7Ml@?>1d|kNI ad/9Ig)Spt ͜GS{)%/JޱF1x}oaDFqSDh}:;݇E\mO,X)sv[OE҅[$Z x~nho͓;ȓ=+f;,>3zfM3 5'xnze6x/nGx|qDfjGud+ѧN:D!'"ޞ$='kVh/Xcf9߮hoψޟLgIjޗmsV[y}ifymn»:Ft~荝MI߾XKucFohHl-#Q< "y!ؿ l%u8Y^ Rwks%mItL8eC^]$]"zCl&=v(UL?p'*oC ZIۺgCA+/'NCVJ҅Vd)->&{Ow7]u?;ڳgf,efaYC(~ m2Lim-bNnoR2g~3\3U}~aNTA{uuh8>Wb=|)RY^Ytz'RxM)eՊjts|f}GH蛹]?J ~,q"WͿ82q? Ў6[}:G?@ūcf*Y7 l~tx]SwKI:?]|;IϷv?w?x=ຈHjo||#vO))~}#/B~*ҽ:uדvT8"5OR5IzS86no m-ipj'-n3Ws?eJbv"Q(X{1$ vO(jlMgIvxw/HzX3DEi,/IBQO%OxJVR{;܉:h=x>]˟:[${ˌCsq+%ҡۋ/HyJL3 IoQ~kfIҕnIbY*i,8Zu{ ylLЭ"aϳtU8AuO9-)goa_kS'~I~3$)(_u^l|X4KҸ?Yoo?KƳ\OHKGMm<Gzn%wygs[QyY|?ޢUxw~t[uμ6;:3T:>/ч Ťo_{C?/1[uz>O?Fp?/1[u~WT:+{XB>?/1pi<+|^> {I m2Sq/竒ϳy?`yh>7>7|%͓#q>3yQ}|z|6R{&ͫ'.?t??'Q G>ɉ%'w$ͧwJsh=>Ϟb^(^~h>%YĤ&4_ox%w$qxIN4O|'ZO'ylx"]gO;'v ||||nyoyA?]tK'q֯ *ޞ!k>#~IhĞb>dz'_?P';_㟤h'i-%[߄\P%+=ys͟''yd뇠ydz[;y\POghyu຀ϻ'GqX߄q}S#+ :%dqLtA딠qsjM Zl|XOT}u&]z"oO?v%_W+^mu^vUSd흳Y?Qq亊k !O/rE@3ޮ.瑨}uVt\7׋ Q?|y^@P(Y~JN/ c*_ןu=/ʫ!ۉ~Εx#sB:K7}:?Ebzk#Edu%C-G(t|!d뵐W߸ޑ=ΥxKfpk> 95]I~R(:GhԾup%7Q<CGי!;?s(^H^?Gɞ"Q?d E:xsRQwF:?S%{+!(t4HSkG!skGC<^Qg||NoO(I'w}$Mz8 0)s'%ON> :?\r% KIDQ!Q~{IxoKs?ld߷TN!uߡ_dm<,ŷSGԾ:׋_!nDQ4.xl}\r$7s(DoI8Q=)ttqs(:_Gk=4)"CFozNߛoum<L}.hU 3%%Ld?-{(vC:[L$ɿSGI~Iu{*\'qXw,Ez'Y>J=+s({?2=CHqLGxޟH$%ϗ Gun.%:J::d~C(%(KGtBGID>>w?x?ZCZ3:Jj 4w *UWѯ_E~*UW[D`]\2Ҳ76"m/Rб3Ʒ]27%mg|R46Ǐ淸fCڢ9lfenaE735,$n k,Ԗ6̖Ŭ\d,mbmk5PGgc>ƺ?n~~%h/jS|/uzchbsY|[ ?Y0e^;(A(^{ /Z%aTP¿7Ż: n624F CF™pyM?6~["<8_}?|{Q7D[Bq;qƟN5z/?Iϯ:79ӫzW30XjmjK.[ khY߂̿_uMu!(z|s|\*H\@/wT/y3oC_u}u!hH= h&x9SonzI =mΔ!tfSOD?hc/dgyp_ 7ƿU::hȑ9q7ZƗ5.kߊBqsf8z媄,eÛW0% bdmlom>UTbcQ~1~dc1'똙I3Eل쉏%D(>G9^LߙdΓ6t5 5$_˲Q*we1M20&^.Kwץ%_HTXXLLTTPHtv"_P&XEO6,D___cvLT ,Y$2[gm *AP g ;fN'I'qkId&Dv9I&q $O B$ $_~󗟿'IGUZĚ9-洧7Wd 4'>BXI4| Z]{xe߲DjCtLeVN\; j-q#PQ<4?. SvԪhfV rB10 jtŘW@@pbu3-{.XyycPW̝,hYVE[~hZ|@[󲺟 jΊfd5P988'&yм{rOw+&r(qoYgˢTGLe0&ED[<ʭg݌1WLkd7Z[oáCؖy;-z0V@kӭHzڻ_=1'eʑG nFt }A8Zps#- `]7ϏV8tX-., b|qZ`k=,!-xŗX܈ 4[`!"ۏa~ƿ9߂e{ӂTe69J6ۘx?Ρ0L5n;"k_˅غS1.F +^+2m^~w=!v}FהZXj}(lɪإan>5yk #?Ck "^h .Z)ꞕ&`:&A(_w;^D޷^i`lv3.DmnJ3U1z&٘`j9Km}e:&583LIJIA4Sl뷘MZK-5]1 ]kFO&^u7{։ 3A\vfƸ^lRWH/,DcE0Xݝ1Novkm7 8Z&$ؿCdu.LVhL\}rD+{`Ϸի\pZ`j[1oę9vAqY)l 6ge%UySaLnB؞w :ZIX7Xu* ,u']:X/(\ M_B].{즭INU}ڎ2b9S*P/wKx)4Sw2B}UBumPa0|O ewTk#O|2b"bYBh:nxt:tj*Ozm)ݽkt("J/gz:;BD(g41rVW#os%o'&OD<{Sru{%O%0ț+5wډ%xǜT.nt ~ >4[|\a]XS3Qhh/P NڥYTމ L}rAԞy19Qj睫#I˝TUBv;WJ\tu!ք;=&RWH ӟX4(sR|)vKKag[#rQێx]qrf zLy>D.6Lc#rM=-شz㱃Sxbۻyb& y&9+A+*8%Imo\!jǍ#l+|;R ?9Z'QNPeL`X( gnֽ︍I,iuwa7b6:JN9|8Aau>i.ϩmEap)ISuw_\?# <;_Aڵy08E';keBؚ3~)G/^ު{ZnU?;ϻ3ĜԾ%YMa7~\<يy.>ax¾=ϻI::|oƣ*R#6xH1͌%;nk;FaЗtK70r~8]:hʼnYij4!fÝK8L zok_#dաp*еYP6tnKXNd3H:js v!ڰf(EꐳB }ŵ8l>A)fgBp{tL=YxCp/w鴛m{XHwsqyj? Bj^ŌhQ?$;UA x߻n; {؜E|ź f?=!gw6=<'VF*uu| >1BوȓuG.?ڼGyv>Ol{a!B>g*}8aHID ؆+|=sƯUi:g#mVؚiZ2jGaʳU9_&yҟqaɑG '5[0'3$7_ۇexXI y{xaEhkrvO½/#pzG#?EzFԦTi9H7=Q?\*J/H,9HݢO׿I3N_L9~88GL&fa b0~yRvۡӓpΩ0"zS/8_cwx7v,.Fc iUӳ$–ъ1oAj}1գn{\T:g7+Sh-ks8푣pBt}c4cξݱc[gʀcCc F%Z] /s:b^ Ą ]ȡ0rlӉ;?+<0,t;8.K0L o2T[ N/#G17f9 ^9Vҽq/Ofܫib@T*c(d”Vo* -ݚ9އ.uυ3؆ 2^ 1 $0D\&U 6O96[IӤ'tp}֢i<հ^үk`Bhq]AEJj؞ϧ؟yQtBxkD` j`qU:5WS@tPX( {?>,Ն6U<jzO$ j( g4%7 NZ_ 5c{&^+<5^ O IvUbzO -x閉Ո Aă~3}󳜆O)5|e1 yo.“C Gt*汀.Y+ƥi" oGw~J.XcUM9D1[vO%vt1M* co\z;~@MX1ƁM䦕˱uE:azT2"__BzLP3~WU;^ekih6ֳ-h:7ҭp2Q ۬N}HnAg] =!wDtuW)A9[e"vlmW۴1Ö>Y8|}gloܘUOSWl%eN22El(=*hʻj+:}72X ˈ\n <=W7moӰCVXPcG_5/Gdp~CpI–ϻ7-XݪVuݼ,[+^^1Sr׭+C>-9srpO{g{,]UJ V+ص7Z`jD!#3S8qTu"]olўE0YV_|R ۧ.|00,9e=Fg# bVσ R]{Gb9-Ͷ83)aq1c5mC# [0 = ".c΅˸6/&Zg_dghV^M$MW'QrB`UGI\瘺 =c9 P}Ea5} uf9rxT14p.; ;)>;3B]sNs {qs;3Me5Ws `=) ^?]\So/L8u] y/Eal\}` ΖpRZ%V{!gqc٢ٱiX[R*_!(Jǿ8q{wB&,HbZ2뫾O1LQY9ocSsZS,– Ktu-毐$" n]؍e)/5d0J:rd22xUs](vgΊboOdQ7}aӭbehN7e?=x6XylV?>m+`={w:hFإ-p3B{Z6{{ybk\la|VKsn5bˁIBg>*B6%bEQĮřwCIвaǧЦ ?RM} .#:;=rjWަGWh`dG!$B$f%:`) l5 N\ޯP S4.7ϕAGȋcٓmP&Տ(_&uo"J#l<)8pXs8!)Fzޥ0u#_nS-qsD{\Rau0S=]bU~,Hwv>`Q]+dl S&kC!7P6ː«/jVzQ}cؼSk}b}aT֮~ qOVgysD3'ݹRjGk1jfgcAq2bO\YC_n+ +/F,Oi;#4X }rE2t?Rcڄ8\,U\qV/f90|p{ ͺw8M\ue?Cj/K#W>C8vqdekG ۆaͳnk׺e9#`evD܋K`MZ0Z$dP&&\.6A8ΗFWmRuOE1%;ҿ^6Gt9Y={>Y&t4Fdk|JEgtػEο`4U /^J:9W[U2N0s0NFgd}oطh\8Cq]ܲH)#5wTh4蓆IvaNA_tCez_qXw| g5&7܉-# *l!#h'pGw ƪn/p,>qFBC[Jj`ñ_?FC1Ƃ3 B+) ^ uAcBlI굽7>C#NprN<>)KTC$}*bmsH8z/qZzE~1MɴMwFWW">61VA-uœS]\((?b0~NceqC&z^4 mdmE,8ޱb9)YJ PJ.bxz%xPm=M!{Om# <#pvC'ynR>+yoHrKۜ1>$t-EL~6Ĉ{S7Rz}߽ewB-f"ymX b{g`C1]%yi"D-If !> H^hyl 1Ǒ 9Չ@̤dFdL&*${~bh=-, 1!T> ƿВad'[΁jIHXhU1Nv9)W#N\݉w֕C8ݴ/͟ :1S]"$ mϯ'nD^~"';(@Ws_ F1=lstv$$g2pwP0flj<r-9V-vHD±#ʟܲ1u'] ?%H<=ж"F7NH}<ۅg9)Pqoq r8!GG!Apԧ|m1Rk|Gz 6}&"0ts<kйFn1O=!HJL@&Z<NM9>ј.Еy7wxX Z6&*>6m0Ut?yz,bg u={+}oZWhž0bzRbU>~ϵR0<Y\aɈNh%rC1֑gb>Z_ :>ڤ;Fv/I-wC"<+{vLӸ!=i)ā\&*\0<Ӵ=aK_g#]g@ SS#C-iD*eRW!V 0"fV|-|1Wfd^cA5k[. Sc 9"P(^,[6^H+GlmeqP3D^8m8Q d:G!.HRՐU<آ&kq nb:}O^.y6ؓjh#b)bۧm;?nZ7186'>JSZ0C.?"3F`g 0G%82MCShZΜEOkОcJ_(8g#Rrgc7Kn짉1XT^if@|-U͵'f#D˱sҋVRjSҙ֫=DJժfyՄHX(ڣ])cKu &}ĸPfjA8[P-@R{Nj"qd%)!!%~ś´w5w]bvƤXe|?Mw@\ץ*2Kc Z2Ǔ{"^p ʅwP-%{CrMuDO?1/.5EL3[ka諬zٝzb=3V\Q*57].1B| hc"n;JqL w7w@ɑ{QgOB[14d0iĪFAOZ &(~~.}7³F6/ BEzu(ja$*\ Ő= O7T/%XeC@+il\gZCܣͼW p];iVHop< i:c*v p ZcK=ΆD%B* *%yxp ~݆yۣ R@]ݖ'IeUx,A+?\ -:.!*pBNgF{#-kEL]1qR /gcV;vW#F+H݂hEQX7 eK.A=e!DY҅xn 'h+#b՚TU:JؿPR2?x |毚oWGxUǕ _wmwG ;i0nBeQO ]s^!s?t-0w{o~_킽t {T6^­ _XRܶiCּ0psndUcA{AjpO ^aNHVѬ>#iI/y/#y'dO!+sj=1u\sv/ъnBe>zo}'!t7ME ey'D>[qq"* B8PNb-67, %[6XJ@I)k6neJ/4ko_e2-'ڡmk8-bC؏-:m4Ff+{HW2vCδčJGbiqZo: "Nd]r%Tk]H:lV:+9L{I(YZ,Q݇bI(: Lo xzC̲A/YX+qBc&$(p?FHyN'֝]ci k *O.5(8YMxUߙz7rS `S@]{U"qP$/}Vy+m'ltxT}6q9CʊY|k4D9iMSѴ#$~7ތwď-_!߬B4{F[󌐿R"@>/#^6kZ y\J8!{ 풛6@j*ETNr\ jf-&b[B\GNǡ\`9D-K>h4wr<-[1(Ҁeu݌5[Uz履~J@jO&Dl,q#4/?QCd{$WVqڝdh|e-$%frw{<|hԡu2:|͇d˻SM{ŧ'O F[[M"(A!NlM9J>IM gc9pBAGL]8X5bTށv"5;BFL=+jC!Nfac_md%TVmqsbmF"U. ROf^2HPEL&B-|!1^_i> Z"~ܿO" џNCgvf7kvZ)Ro'@*Off QnlkUIB6KO_Z!YW܁ ~Ү#]Pk5vl DˍH%7:qBj;t$na@xOI'|i^9Sh|i<.F`KvtN ľJVq̿ o9gCx40uJ cO|}׾ɞnӶ~dFѯrbrrS4$Q j4Zd)vPgq]xr=_rT:V-#"[!}x ODym?휀8XSJb Fo21ۻLE>1XVk.P7lh.WPu;J\A*!ՑΉ* rTS˝-8c%"!c CL1 t"K)e~bp nrd +.XW̽1svDy+ ?)A;S]O@J|ܪPZ5^GLup>QhD1 q_!rWV sP.O%Cr%JP[1ݽ̀V֓D~r2;[ Q%4<(sn ~IЪL&tkR?bjz\1򕑛$:- +z+A2G#F.&t ",Zx 'nG W[abMA]1\ ^:HG#jJ?sNg!猪6b媈V+2UO!&mt,t;!'"F풛 ¿.nQW5k#v0͵7/.1N'͆2 ֲ m}IJ=v"A-Z12Bid 1J{$Y]dl93_؅r"B8 ֱ/HHk,X <ފz*dC$VZOby'a#x~_cSgVbLJ Fm]NrE/!fU![* 'z?c",u:0QvR%tkrXN׽ Cm_C4m$柇\]z!bSCZڐP 1YPմ$문Xљ O9pіBn-;ݻ툡SЖ7̩1sjdۊ#*r8Ǿb ]$ꥉjHnȽqϗBL=}.`Ę ^{ҕ']!)1Y*ĚŴɱ}2l7=Wk'$c 1A4XX|h9ّ; x3xYy|E:-rS^i,u>^6ʱ?^pyPf rT黮1ԳPH8@ ju]@x=LYU^Sn!F1EAyĨ/ljö硐<ȃ~;DRoy_ksbH X D`Lv[t16IZ&!*CȻ1NNAYȍ>6=Q|8/WB%ي숩I/AypUbrh4Qb)A; Q<m"q|{ q=Ǥޏݞ=: R5|ڼOU9qG>Ԕ12%yzۜ";+(Crgֻn s_GN|̟SriXZFQyNK|퟿%ߙ)^Mc=l+?+Qއ*4My?_w=L/ iwW,U kW0Eme*ޯ,vRf霿vc&lr֕QL702i*ez0=S;uP{ֵ|;؜Aɦ /Kn_Ja/wÐҚ^ NhĿ ]ʺX)^yFr a|pG 4Edg|ˑؖA&vrMj|xKF}v B- ]FOLݮ|׍  -H6Շ//Ak']q },!ZL79A:e?8گP;Hl7c3% U@*/;J)ؙq=4{2gRɽPh WەP[Yu۶Bs.}r\V Ij;:lG:X([u@*mKѱJ&Er/PPؼɵ |/] j~~XHlxLi|ޕF%!%g=/!-rN.ڽa~8f(~?)Z yy|"!n*PwzHi(Hpk JJ&R6lut?9\ҐI R7zɞzi[ߚ!?R7d+z >KC0%ŭ¢!Z4|zuva-Tp_{Sm!v=zS4T 5~ŵ.P/ Wn Ql+?-E3_>* zE/A|d 97o9'HLbC7 čS@̑Q/ Of}'R8-0,_:ێ;@EmWKbJ[8]:fBRlTP~˘u ^io",7݆hE]kqib.5D;xkJ u'?MԐڿXx fFRz<~ٸKu1ABQHfJx}qCi/W#ܺޒ)a2eywL}8*D*[HMi tM;w5ՠ'X葘~(A;("@0GߟR1\R?;'39H6vP~ x^vG҃ 1/x7\7:umw9q>Z,+@8xӸ{ҶB$)?eI2BxZ}pGYv@%3Ws ֤0A>wn͐񠮱;dE.hE-0/;!.lu7W\ kGvg ⺘t*1 +9$Js,ft̷;1e'~^| v~Iqlڏu48HS{-< ʐ]<^,r M{ . p& ryb/ +"[ iͭt?e*'ݨK'oC/pڍtAJ1PH*opQ 3KBrQIN;/n$fyB㛭Ee!Vp!ILqf(:`b)D&*gB޽~rS?ӊbf,9GfSYk[ P/L   '=} i pc26ȅSM7tB~ʴT קؗ{fAI㚞lz ]OO9Ն^Qo<{߉w{W̨Z9Ue>v„7GeTBKkUUsAꤟon{}toyx3~SgjH&M-i \ I6~f45QSf&,siBG>DH%JI_!dF.ԮqwxC][W!$myWoB(^4Kjff4~Thz\HªZh_"ԋz6tҜ3Рc[ ;6uqA]\O(  *|^_./|t?#i\H#yes趖#($_rJNr(CьlN 6FkQP7Pio_eY =q8KE}h$=Os?|QzR^_vFHA{LGTFN5ƷFY'Z4~ *OϜh{Z9w@UeW-:Pe340~Ãwۏwax#[s4Τu>킆JY4Skb1ĥz14Ϥuw\mt2{P{$/j>:- ebX߄JIg_nP w98 Hy^L3DLi5gMU'vRxs`3}(/+253j$a:K1hD~b"Mq4I45~Sen_r†th4H6K,mJ6u>SGd8 m{ޯc,\Obb+" &~WQDZ@LL.QRNڥ;83s={ٝg|gcKVOUV4T/BXU%H &x씲%%UP~Η{<~A;k磡2#}b童gtɩ7n *C]r=Ogq0tdBo" oEa޽ J~q ?/}8{AS#6 ?fN?^d~~`"|3LD 6-aPTFIt#;l8w( 6 G§]Oǵ8ޢE+XT_󭆜S3 vfw[]R0zk)}û$кIq dk}B Hޣ<{0VFAM gЭՓÒsGbw9 叠q}}|OirC1Z;ˠB̬m TX'6}Ttunt}eL{#7}D։>0(vWP8r[&FF7Ȧ虜{#R/Ww;!Fa J3VN%hgFP7V= m;KԻ"(*z^^{!N-}>hhGYFrB^KHӯ_TdkA}_Qf:Y2OqZktFyډ4^Hugꏴ3}TdҐ=BX6:Ե|J3[ \i[ he&2̧2Mр쳪eCAuXaN#ޥ=ܨqj:9𵪛IOTͯz:QxjMwF퇾ՄPM!wgwHt]wRu&T \Z7t֘ [ Ōֱ,ަCM eEGX_Ѻ{yʿ𱹯>a_WrZBRk;f}oz3i$TOCmVB)Ժlvy#]$KH-8am$qqS`{ UO({) 0&luk4.Pg̠ۚemgoY#QIȊ(74Wk΄@=㉃t333G*gQKh4gK-~sęHag5P&3z!hb뿻N`(OľSGQ6c89P]CuPC?y 5v(ZƮҺ]LDDGW$jG&:^_擩=LMܜݍ@L e/.y(m*>f*S?-מA赫}܄R Kt7;kKQ9yD9i(W\qT Wr[ȁjh&Ӎ}ϵwWv C6۫ -LYmUE^QľRzҊmAʝVFKU/m87ߙ{-P кxZ/Cv(f=9w(wlej6>O[*4xAW4'F;osrPx|f =}5h_saor ԼyX!m "џG}źQy֜i2i}J&d/P7| a߆l;wtˣәu4=pI|f}lU/&:J׋MǿQ$g-'բu>YZ hnt;rcaz~64 zKrd֬1Zē@m'0}wNm7z8"E+y[]h}x0O#?1ukL1N?}47޲mepd׿M,ʯW9b5&]~Øu3w3#ah?*.V桕h?>tO)aD}E)T0t%kaW|w4Bq5*zEϧ~&:}[T_OcXQKO7\j_^^}ߨzF$’Wz1*5b-Z_m2i:ЖRjguPRnz1VsD8ʬ|UP$qI=mRn'LU7_!$t?k{fV:sy=4QI_~<z`Hxʧ3qn>~\OGԽ,N}:Zѷ:j׮dq(>/$h:TqN]~ckT f{%NBɐ}:PҬk/5}gk*սϿ֠u-l_R{U]?s(}#&ED{^jWogߺzFՓb+zom} 6ۭy Lb'yȏcn7_+{U C{k#K'ao51nj9;ۅ_!Yv"[Q4uԙ?gh>o|?俚4`j6<]Ux4?OFTxݖSg8x?ˌHt"c#j/R<ꓓAߋ@mcq֋h ~)4CC71<{NMˬuHGGz?GegEoÿg|:u(9ul?^\UdOνz?Eڧ7 -=ܘZa:w|p0)ڌQ>2b/ |'c~wwogS4BOGQ?٣轗~GGk .O=(~}S;^R6{5Vdߋ &m]{wҵ3e#6E|9(Gt߳l/F?/ۣ6{e˧焣27h2z>8Dtbdy+}<ǬXO]glwwcZ/)点/n> ݞ m3U\(zϵs#{/)NC75BڨXKE -Xyٛ%;^p=>g˫s}˸:rq@|9w ݙw X} {Dh?4HF*)d=r HxP1hn$ѹz[t>3~s x4ga"O%"G21u^ 9?r.t9HV}ĉ36 7E{C~ mg9WEEic{BjS'ⷑzPIa&-cClӦ#[x9{rO,)Np)P6}/j\u P|:_#] <&ڛmW~=> B\{|{*z-c{|zOڑv{H>ht!xYyHt^:oO :7: \>__C:I6zOHE\XvB-boM}ne ay\NYOeeO.hwBO*/5U3imljح|?m9 b,.G-R_Hί9Ruw;<|y\R|p괹?z/$U^_?_N;A1UoR {Ry> , Ϭ Γc|Q2srwx1y{"?qt5;|-=DG:?f2:1tKo}ȹ\K{:8M/ a+Z? 04~gzsn E9tƋd°NOB'Ƌgg+ȏ:G ] yW }q Dilx6ڿz4g,4g#]H~1?.bcfwh,zSq` ᳅0 F\$fywyuF9!I$a%Hb?߷01  q\Sk5EB)qi,8Q\x< 䛦b?گu47{'7 8}PaHtgQ430J<2f\m67SRv<Se%sNK!֓yu::m?Rftqw5}6"%H0U_'> nJk~Wl4^f[O:aJ'"MN2CGF 0<O~ `=%}J;E*~%մ'e݅'DG~ow tD/c'D3$~<7ÕDH4`N 8rJ'Y-?z''dpgWGZޜ(>Db]oBQOt^]ۆL`1M:dt8\t]vEsѹ%KBto>nW3l(^@`%:[gBx`="~?~uvPm3EyQ"Jb-TixC={o~^MZױhWؘWRteXA+$]~:Q|7Q07~[d98YvxA"8WйPρ3b{??(R,;4^GJ:=!uZ{Qf?$~p={ ?Z#r^1\{&dZ+=2%:Jϱ"?I|$FhC)b?%XG~b?%%:80=\˚=S{luMq%(Ә g3x H\W-ߺ+xUv3;Wu@᪕ϲ(ѱ(BL)}ڞ-;u6Dz^vIz?%h":Q]mՈ?W,_E8٣yWV/YBGݐ b}\6wR"?nˀWw7 1udM$Gs"O&Qt bݕd>'߲l:=azQ>ΪYy{fl7}#zGXGѹZ7_w?deI h$( ێ]{]أ }L¾#DGG3 l:gEan":m/g3uۣ:Z{%ǝZ)RNuT޾H~bϛ7 >RM֦y}r&Db Z:S~1'A:8Otq{[.O+G{ڧBQ~Px9=oz?O<ޣ%G/ *klxDlcY-^ItW4>^Y xg>lO]?蘂3WƲc^xT|^$rabE.Oo3isN3G듲%FAD#L2!~WveZvz3_Pj'f>_*\4ӏ/79~ۥ8b?d(1|IDOl;^ia?XGT8nhI8ʦ^QluR><öP6s}ܨS38-\:3MYs Z\A1aO-n:ʺо=b{4`uA6=hB-'š7F{/5taɗPY":}̄{f&oFd^QlwUǜ=mwo#u4R2./~D]1V2uT)۪#xk!ƹ \"n,y[?"{P=b(*Wh^C=_L{#;dc}" 39 (HZDGcyZܞ 1 /E߱٣hAtx21dm4kG c<_fݧ}%}TtN,ځ<=ǠsGEp n=(ٯEX?Rĸ+WcDG5[ є˴(/o\qlѫL hUO(3MQ/u:Dt)uE~IҐ'7V\œL{;vA2(ڏH71QNJDdg:Zp4Q.JGQ~Xu4(@<E'C~=ɾ{EG?H%GQ~􉎢x퓅xBQƬ^ _u@Ex~鉎>K,> 'bbE%|<6}[ûMSXGg4::qA~XuGLDGdĸ/$B%:ûYaB-ͣ /{u;X2RpD5\}GdvN9>8#hx1&G4d$$Ԥ$$ z9~̗dw5?agt]*ji+U#zGtjca?~j fvX ] jbajfBĄ1~e/xxWj$`ƕ3Ta,??PKTOP\r=PKH_i0#sbfQ"̜khSc976:e&&!$ dؿ%-9o-f%k al?_|!pikE#? Fwal'pYw׏p^܍f с6WѾō'Mu3u1muC-Uc4uq2FHs Ϳ(MF­j.C,&FqWqin Ax5Ï:̿{=3@QtA%sqK* O8KEO֎*<:{4? F-hzFfzd3=jnBf0 c\kMGbk1%(~Oђbr\5pHs Ϳ _:79 Zf0:&~L݄LcǺ:@arbǜQ.3š}073Чan.ehGd ''L6\i/0\[VWm4xL5~F^Hs Ϳ(_/d͋S\GU_kp11:3Ę fEpgǏ ƋP3K9_/BҵL͎jɓqҷ0,*nc*ܼ/TKKS^]3 y) `ط-w~8A3u3y}͉ʥ=+X>~VZKﴐ^xws;\;mo/cw+;7$/_bn /;5X0oטK-Eǵtt$Y3#X5D]CK~*vZvZn|jZ?[iLi4N1EE1z+8?) D& 9/0Ms"_% 5fH"?eo$Q(W6_a]+>Ňu g_E69|r mCHE#ݘ|f N kglNZ!j~0W<=7^Wa!cP+zodP𣈍T0agc%OAס!;fISUvRnkKa(_j/!lXPr!m󻀶zǭr3_<9g%IkIc5M@]h:GjTl\A٦xLxALl\L0.~+P/Z]h:s"z5g9EBǼ/b_)7+9"j_a*ZF8[QAA52wOCMSB=:/ χz=2A/YTVIgP$3N\jE"@G! )ϖGC(!lljYZ|KNdh*;74Zg˸nۛ4~&"̋BO4T̹-*v6Yym44-޸}y4]a: {CslJ[h1YV[LN=H`38=2',L9h~}8NH?؅hϻ9t<ۡc~iz-_u0ȫΜ*WClA3Mc2~)MٹkKD ¶AC:mܓOؼ{²=Q͏w>)8Cذogа7 4[V|Վ~ wցC 5)ku6-w:(jMzoc&B|=|:$l)Ѣ-*9BKZM ;)MLt\ҍ0]@X~yO4 ݺ_hT_ tz+J$)m.ގat!աͳ >pNcԡq詇NrXt PZgOzڎ k?1j[Y,u<<گ^ (PˡZ:.ǜ? 6`SNjֽhZ*u6<83 itOX}}3 _9wua7@ I3~5 m{"F&cn# ^6I'G vBGœ}*:4z͂@ϳOee\&6{탎*xz@wYEՄYAҒYxZhAޟsqa3ʡ8MRoSΨ sI9OMB~f GSL7_Ps}> ge)=^mͤwŀpѢ#oR쓴{K߿s;i|ޙ&PfIy:ؤ{eS}H+Emc_^"Vf3?J4ͅ9\c<=klܕnc*<;\kwhnL2Z]s=b6O3FO> ~6{ә>U"/jyPCc667jea|`m&~Wzq2akCkgh'h??ڗ,07#^ϰz ݗz;6/&t~9LtNhXNUDu1whkP_ؤJبtyM=:e C+M lX*:WtAx$m3tp>pp+cyU1uKV^͆[)^am l>0eżЮ[\>N۟mVQ}(t\6u NtFˍGCC{Ҡ >N nr:J˶}Jo Q`7| ԝ:~pX'{ɋqg}ȋ| m_)C­3F C4z8͖ oU5eLd] {>OBiY]IU§5+@њMl8Η]˕mSI0d':͞_Jc+hjU\O窽c7^P#`5! `rVۛ{2P{yX'%BN4%"hh1!k==.n]hZ&^OYɁt|,̈́>/[/󜫶 K'5L/g"{y`i}|n>p/tC*n\e pU+\Ix鼈hXU6ܷ=hIxk*|xn ܯe9mMhuF[s^H9u!m~C51IE!.Eӵ"Crx!\iR&HLt1Ղ]J2%)0ON'Ȗyi=e'ebEI¹%uO)s$O~nD~?ĢqS&;P ef9ل|n*)M"L(d<ńI3ag<ʸ L\hճ7V PfdLL3Al1/̪k;FjûdGF/|ql D:t{7DOO=N% >!oJ:9HF[|<ĮP2gW 1cx!aj/7I>ӷq;^IzGn~W.$XL'Q]Q#bveTh񛿖~|Fyѷl9D\vs /ٻ'NkyiQn͊bi%u-H颮$|oiWm!̼:oD>aN5H^EJHt1vLeN A/{! !cߙ@杹k!Z{@4a$5q]2oG*O fҬir$pk<Y \Ǔ3Uyeϭ|O݁ mܗON$ډOHXA:" K!$0E2aqnj'~ x-lKH=<"o.y_E Rz.i+TZz}9f/x <҂F>!4kU) G̓vUI]I`n\+-cV>)wBYkot^Zա^u1i)gݪm oEҟ@@F!vެ=}gXϿR'rT/!@0'QzdBZ^\,铨xO[ WWlYYԎLK]/$%?(QwEz tRxm4n [Hn5{ 9γ*^c)$m>Q?$:jnVllQ)縌}CSOzBmiVW'Qreɍ AGde$WA4jp6[C1aSH~-GY"eo)osm>*)㷭Yz$ )eקl! ؛x ƯjWߗGvqr;ܞiv$Mt7[Ovё7]s"AK4$SԿB\և!!k}ɤ'7!sz6#ΏJbgY0.bYD%k D!4j˜crQo/d8Bs1ar $g_oşXV_ˁh)ez=Ⱥ>At! np#|)iokܤ}. ~.Xɼvn7gHW)B+ٮ͏ܽKfg=ss TܛDOgzwcHZ\$j\+>7/KH,;knWs< {.KCӖpL:9H,@0Bj;gWxx÷ sU 1nzW BӷwykCߥes!)f1,p*4yGsZlW fT8l[+]5hTNI/GpwaH-ӛgS0IƼ:J厦ݚú;<_dY1a 8|}qW -Џ,dOzKs- جS(@K$Jd-GOÛkB6E5l>);/?pNNqhvL,IN~-~71Sx->.NLvi)NduvMyjxGxm_})ANO]YnsgdyϨ;sğ.e`bh,2b%4f<nS^J(,@Y>i_Ao~n'؂#^ a9> " n+/E>$ ʝsaR8Ok ]]g cBdzCCijB{R&@ӯ>&lU| nTWߴ6yi{eh^uc]֜8ޢIؼZts 4]<^cÒ=MFzx,dyFд^qs1?h&7L("J?ZDua2YLFZ/LVh&Ϲ-_mLGؾ.3g԰ msx&FWZ$~ĶQKL06b]k]Gn$ٲ#KWf![;vQ}( !뾋U|YJ6.DM<΁E}q\ *k< mJ& v]BgOٸлkG{BsqlD>?< =#%n.Qu%n|zyvOaڣB_4CMe|Vi*!-Eki7oZ [<*p-<ºSyyvsuoPfl"a݈ǻ't:SncZܬs>5-; BƖs{nn:8R&>p[ȑBº8;AƄ 6t5}pJ`Aija6tT+^ֽPG~wb޽P5yZX)g?<7t^4,ի*6z0ݞ3˥{K;J? &l1۽8aõCNw8Xͪmc$tCcA½Р[nMin1R([G Ovk{ %Ӊtޅg%-ℝZ7o`RbXpKaO;7}¤pZn1RF:p]E {w*= -w+ l?*F|Ϡ^6Otn]jMk?B@ԶxKg8y|?|E9rl|ezZ2rQƀ0dB#_0TH*+C:3*bC-O<0*p[y̹ Dzp4 ^ؤC6/""vb~Xf x\vPy)-*MYYG8< z\>.䇅'<~.5?<1?0ߧ;r1WQ MpZ;kEPSAG޹o"%sQ`"bbԷ́/6㋙T⏻'3+|]'PٰF>YU|'֎! T(MԕG O܄s H㾳F$&J\R]5(3wwn,-+BkƄJMW+ J2;@NQxKiMXTm1OlJC'N ,@LZ$ K[oY I8EyryjIfKH2ta !{sZVc0%i*@a!ck"0%RuVL銾y;/DAFW!@-(Q{ mMt`ÃELJM4!Me7˭̂]AuNit*^XQ։laA[Ǣj(hݼFC ƈ)s=~4 >Za鏦{swʜ$x<42ʐe:4*aņG ˰gk_A>Z!lSg ߶ z;0ZEۉnapsݰl[Vǽc w_a )H&L-P6atfaƇV[ cw儚=yq8Q 0ZK Ÿ[^BTwJx '9 o;0@{Eƌ9abLP h*{ ;wKAenΕ1AFg\h%ІfHρ]KGE.4@=?RRި0 ǝ| {!s赇b wa7{0%t90&]L=B%OGQ/FMz&S_H}N )mၶlKp(#sk&K= 臞4 Ss5jԜj vFaXW̙E\%}faT0'J't)a9à2po>(5S,g*|LXv[>nt5] u%Xi=>E->$t:VYE:t͈FmFۑdFHBb >j#WGES΂{Kz.8K*h;5,P`*8 rj>Nu?Dnη0mΣFWD'o7 >a*˜{uy}\u(9R˜/_x7<-[bN貾y[=s<%tlңC>~ g&굷ֆû/njKρo&gmuf⣄^ֹG W1bՊ>gzi y;TB/E'cbHձt x1IAHK=]/AE3f\>gW[~$[e* +997B%s2%[AY%Kvƍ%w7'&1^s]uTE|G cLSܷ|* K^Rf54]VaJz6ς-_ҦqC v;à~VSî+pl>aД`1'@Wo@Qd[AOA4HA8M==nZ/>y7}cLB^(҆i:zrX\GqCn,sT'tLl t+$!"BE؎3J Y)Wݏ]†a?_Ȍ7 ёw*{2qB𝉩:SGLkj]FL%t1»$B|Dg$BBNOwZLZ6DFQǝ}y4p_;K~tp:AYjQ-?Y vϩlXMYЫjLNey$>vu/&t=`i1U ]KB8{'zʉ^*G*GnQ/u^6qyfvq]BbE0]rGQл;C]wj|XxFc ՞ބ>KI%j:K5x-zm&9y_^1y"|[, ԀSǿx An $ K۝/(a"/@2=={f&asGOR A/O !5 LE0! CCzKb;=_YE#z;+Ɉ5ox,.?nO8gYL ^px^κB証|p\]eyf'Z$t _>~=qwѵk*~k"+`n]Fw@jŻv)%{)]ܒL ].-O{.GO\ŲOn*uOo {;.5vKVsoS&Cu8=|K/Zh,5rͤW\zq:e7oT$PzVS7(w Nnܻu-K@Cnׄǎ|6hH'P6BkW,?ޟS[&..~_q&_ۈ׹#?)"rwNw?O7T?W/o?{ |ҚcJ}.F?<"zݷ̇g݆ύcx>?={vW>qO?>d<}@=~lǥ<-Nܶx#u6^ rwvd=_?wUvd׹wv?hs:q^)k8} :n],o8#_԰SzJ+p'oJ5A~o{MϡrdY{Ð;aF8^O41sA-N%æ,{dHtlҭ}N)לj.8os<#h\vψ]UW_jϜo?>}͞ϑ!ni~%K_'JͰZkv]wk(]sp@+VeIW:/MYIw)6R^Uj+Q+H=*`Pl̅N4s&|Ksj\Po$>j,UL|;FYoqbA;'iJC#Zv\4 8U+b(ogPN/cvH8IO?r[??VrD g!<4sbiz`K;;u(YCݽgʕsSCЩߐ{*ݡNu\/csOvOrBxjG} jl<.3n Q9xh,4i)ѓNf5JE(G~nN])g 'NJ9y|b^RlIy8[sCyPkY/(X3'J +3ifI|,I%όN)VGzel ŊUêM I;7<ͦ@YO c" H>[sWFe>Shzw՞unտ]yo(ܼV3a#r*z[{hn/A̢S+cH>۝{T^3p*;PqbcD+Kwfר0Ԟmc %~KupNx8f_!Vu_#>y7ۀW49{8kzMx*uk^shpbv{ɧO܏IU:߰}tXjm8x,;w8] #E&81B3;Fo.xI,X͖ohIin<ru׈ i?ppu]E*qk //L7Mt,N~vHnO[8=}?uŖwUǜW{m3sQؤ J0!~WzѫْwWpWׄ^HxfuB'`n[e!B8s=xO?qi} `!x\4y %scιo_wTv}7H׃_ʑ|zpz&+\Fi[\j5y~n]"ޞ]"G$swϱ҆PS@x=/.O8]ܮ񵇷T$8߸=Ƽq #n.S?w[\1<F3:tmvG%kKd>n_X't˛3zn|ө1d͋pg>ptyW ? DNpĺӑceD@0p,qtaxѮLNo'/K~zK~Kxy1/#?[t:Ugipjx9XN%^W7d&ZnxyE1Puz -޼Ǔa1'. hjH0zqF~v|r~i/S渘]Gq?C#O~q}t Wc5&-S{S-~݀;.tqBî߼*Y͸ֆ7;ItM***s&P'UhnL }nZe @5/zKWTUQwPiP'}VQgAhk@kPޙ]3+ ׮ϫW6j4%h9y= ڦW] hK{xMp&fe*ФzB%)k偶qs4%ҧ0jl_ACM;{@e^DϧP Tԏ>^j UeNH@10d@5]T&Bۍ95@:,1e?Pn^I5T!hWqP22,eJI;4Yu|Ta |͠Oo1v`uBz6uH{ٻtP){rMjPyZr*#MJFqt7im,#qP蹪Q{F*hZ+vt5kj[6PZ9~۲`Qm߱A&QezVTl㖭P6'>ΖQP&wTq?J4ɂ2ԢEUW]6-P̠M.&[@}?`+J֬"׸=x:;+ YPgp̢%@I9 On8^M5P`?W *dPd S꫞Z [w*n>;2 KtnҋK?~v2ׇvmnIS&kےx#/=q]V&7=9I4^~_c}BwӿϬ/| |v5WtT]e@oO^jH]&F-r׸rZAuby }Ш=CՍk -b&5[׻(Aխ 7 I{zI&[=tUh$ *Vգ*h7BAw@U_]UQuՁAsȸIS/9"E/ϰŠvLN]K*< !榭 T 3f /4r+ZBڂ}cF3^g~.څ֠u4N0FYk cڞ T&7N䀯ULeXT3\j~zKI"]>fڃh}W-ሗcXP嘕;)T>;*N~ŶDC_FoWj|?T>OGv>:(5Z?xg0#8=p@Gt}r LG:p@Gf L<>k|ua~0Epa])L7v~K[,<_Č#yYr΅ss|<㔨@'9oő=p|.g;W#KzYے|(:w@s3#Y<>z$;|_C#֐sp?$=QG8ɹu|0&=wr;9Aȹl<\(.'?|_sׁ\gv qs2y]_|3=:G΅亻c+]~E"p$POcsQ;z.jD3?ʙ(Nտ?:'Ǘv`:Ae7i /x}qv8oq ͦWq:Tş 2P{ rgKsvz ?OX'XLK*d 'ˁb=@09@Tb!~vP;b?OG1YuG#tsIRX7fV9/.5'Ox}I>eQ?Y'ɺ8V{ 7$Dx|Xg݄u#xt w;(߱}J^E:nb]fp=Cy2~za]QoY;|5RX8Q #d^Q8(zhq(/"#K,GY;;UȺ%K>q}dqx=4Tl8XQ< Xbb xzg}XuDa=,8}엖kX8s]CON\#wZ`(j_5=.'"+X?iV &,:](q`v*YEIj g8_Ŀ/^Aze߈?t^Y׵Yp:ˣ_xY;Qo:[^z$~sL=K&g"daQELƦd^ϲ΅ :N(]UG9N՟/QcٯC`DG(z%QlnQP:ʲ:G(g :2aQV{[VE<$ﴰ2ѝ~G}Qz:-XCd%:QI=(J]GgQ}~&__k(xŞfQ4bQ%:Ӱ؟xI:w>n>&/m:1&G4d$$蟁61A_tͫekT͏AWܫ?5rIc-t5x f ٪]JJLgx/׃WfhS_j`oC-MS=CurpC-#}?kw t~a?g{#![G[ZzzZG4N2sehluLZ 踖K{[2ߒaؿ[8h(R$`ɯR?_H|!r?_,%:1>bhI:*.݅LeA]?yq75F_F7n^B4ŴM W=opnh}xg ́44 jԪ @3]ǥ 3@bnjOV0[?:ǿ83 @iEi)m`U.EjK kjDDOC18~B^3pq 9_濜pmYG_ !,7PEF2yg ́44o5/NsU%]П~c6??v7/xB?g,#8@]t AɁt Xm)ª'[1 *c#4}ۄ_ߩJ+_'@ݗc>6C@^=^S`UK_{uKQPViP'$ENIKZ| aՍ*5jP2ikΜpj)GTڡRVZABBv'.vnW{r +NJJV}N SʪՃ.r'[_p>)ClރkGAG;R46͘HȡyyG)ڭ>R8ۣ>ZiflNò=ݟ -3j-'R8QgPO.2|f@Ɋ=.|^0Z\G;Hx#W,Ňr"e뱇f]T!T,js= ]Ωg'ܺ:bnjϨp鄲| ,*U}&8]%9oNJY *(k\M}V:V&mZ5o˸ [pѺWLh\rIRZ渥Apt|# z_?%F톞.P"l;w ]BkX2гT4c 5(\cbo(1P5҂:Ŭb Ň(ufXQc$)\;VS:`BNa%S89a+ odB Myf#'Hu9 V;Rg92S2\|v`@BiOCZ}ɽ uS:ʭH٩űkЮ|*Cоl坰 ( aB ed2ΖZ'} ]N[[w>U.!}$#G>Hr&Zyaй23G.w2ٙa/d ccB,!WCˈ3&Rx4 <-„֎L]B;Ɂ$[]ݜ)*|zl;$lK=C6j@XY̝{.e%VLuyj4,KXs{h|T,v6t >@ץNОCNʻPwlfh(+y?3CKՋbRܾm +vACF.n*/Ɯ腪1M)M +/>%< xߧw_~fj; +DÞJq;\tr:x|4ԯZuSgy.D8QsUcRk ?>DRe kܙ2)KϾńΈ:Y3mݔ  p:A{hN/) |ÿgRΊ<_E7j>/6"r,;u}ϕOvLudo\w%l[̘cK:73z0%Anña{ =V^8̱ _[UCHEYƒ [J.Y\MSS'RG-K|{]3>O좤Hy8|5ۋSɒS3ٳL3){42Ւ˜Щ$$ӓ:w5ϩI&))d O߬XӫGQj@sW rxx ͒"$6ޟ¯T~PƧ]e</^~Y?>;{)ԍlT'լ4^ |Res PF?| [1{Alzb-t5XO֦\缷/c2h Wړ6}8~Jl a[O:M'ӈnOUy٬pԫiU Y߲u k_䅗*WjFăRvsv6Ca21S¹av^6d^[J g\P>\hѺ<@isv*;Mc I: |0/mU=2<ۣ-xNx~ƹq6ᬹAnYkgڻ&u^ "V-BGWEt^56 ^.T~Of[%>Ek6aкGVBփJq+%Cs w!LҺw*HһkȑSm^aJ H01e9|Al="PٻJKVIypNFf%Y@y\'7܎~NJLr8IAPXUO\lvsZ^M?Z aKɱΔ+Nʳ#&LM=`VK2DC/eA Fj ByhǷw YW}#Yb Yn'|˿oW.8]V^>^ =çB뗕6H>klZ7HsGAܵfPʩ_}kHCid،u+BA܄Rg+e )W7uVIZfqUy(PY,#gՌY6 P7CNw&T~H8s靳+];0AK !$w|{5r<60.abu$NR$Y^FlH5ErW$@jBz!_TlV*8Au>e8(`k@&̏F/|V.xgfkJ@+|Bv^dH$X!|J;L[dJnů͟h`kSz;'>+Y,8l6u܊'0=rz+ҝ[HhaOd>XɶXd,k9 ߹Q%X::΍8 ˷,~jkS)e> 7_DM C ӂ2w#RRm ^Z..0}֝t(Ո5[/(|+=s}6iknǎ%Ofw5;k,<tƦSȜfrS0ӹ'\(tzc|#tO~5}h(=m,K6VD55:7[s—w$i# zL]@i/L"9`1hܠ)DD.|luy0aI`z f.t>0v;)coŕ(' i8JC-KqJa w?]tōrH7U>QkykŇU'6yUQiyw~ Yz L(M}F;u#R%Cۑֱ>Q6_lj>ل9]KiBЩ#bC)O=K /G/tqRYVJފ,, gBO%I]ZОov<m tUt)z뻣 CWh(kд!$n4a ՚wm-յq:s]NiZTzaT KOy'5 hVLmB9*&t|NrZj+bPwdFtA!-19㌯\4َq_O Ca9"NẺA֜iՇeg[M oA}C''T-r9oF?K MO{F[ˉslH(̍>9.0uyαMzj3!Ą0;Y>7k uA]εQӡb+/DyuXVe%UP/bܻl/(+lwoƏ9u_/GpnM__H-<)[ژ۞VWS*Ǐ_<2'C/[ a] ʁct>ۆOtDh9lfj0k]J*wdG9=N;!|R-8A@ atSe=%dAlώ%t /}Qa-~1o~ʊ7;ty%AB-gnVLHo`7TC"J>p9->Ź*x"KHQa6?zg{3dO@U-U!Dj$k&_2aҳ%S/"!-k̃/u|>DJAK\ilY}~jL[+MrUHs/t.!kqeN?>Kx,ޏ>l2}#'<)`Xt2=p~| [{sd WɎk}۔uP{)BjjP{$O|z2Jkq.Ue~h΅u#:D߸BX1}U:΅ytn{hx--FF9zPe-l9h}uk*=~T5VAH[?UFp]i\'vIo6ȧ96D 4 t.:!>il9GX{*2ITn;êW: 6X9vIoHppF2!_@i))Nx^8Y2Ut=..i}&ly(Vr\ iv_NM;}4Aʢ\awFС"x=3|Λtyp,t~Yda ՏLZ?~rZL 4131HL 䎶k(\_KvS8؜co^= OƞͶ>O#lҬړXüc06DoJ6/͟7d\+aqk8f.oݩBNjYn3&\hz=vJhhn. 2r?!tu\#ͣougrT_GWuQ9[ \Z@P=Y\ M47VN#J.S;x*oAy^Zk3}s}.<*th~ը^ʡsܡ+@ӝ$a]h%>:Vh6=2>7s$whbM_1٠uBN)w a'MSU;Bݼg)m O> j|:ih' u.: :㿛Γ4͔~7_^F¦\'և?_;+e/ m&l^9]x uFU%hxB׭#u }1j1c7@#AX9h K5^]wy_-O '@ĺH癟՜0h\$p%MWRq' t}T: }zOzk&}^>ď,`\YQIՂ9_Jk/K#5Q=^dqN1l?aܤB/A+N@\'] \DdZ w>ݠTv ̱_vCBXH~#R6-i^'w^,r05z9x? 8ޑ`r3o3v>_X9>MRICGO#9*eBb!wdǓtUϫH-|F 25@9oOIR 4Iԥ~gVfm3㿧@.bLIL;N[Lf]Axjo >.&W, /s]a Rϴ̻!m X&@ \ƥ !Ƚ;ǴYkk.6ҌnB=2b#&n<*rݣ <Ӛ_ڃ$[&zGZj >'3Pdx&B?#.ݽ9Yyi=< c>'×N)d0@HF+S״/Uo% }`BdFvܞdϺNq*x7 \O+3Bݏ0|ߪGRzѤ)r ZM\T>L 9Es@怀Jb3*fP@rΠ$(sF@=sݽ}ه}Nꪧ{{ǂ;/'Pi:o5{[c̅jGCq[Yv)V n974~4JK]T\LRh1(=A|Ruy1׊bE*aqH"Pox (:e;}cůT*<>GCLg1iˆ4kO|a]UO@g']qӚb|cQ(?\D2rIe63Z(Vm!~n=v5N#FO&Um)wWI ݊ UL0cÕltzr8%4>ZXeU[>|] *?u.ܙY&xn%YOѱ0mp̝m w]dH`gzUzsl}h v® Q]o&]:UC4H~dA'㶂/n+xcz3B%PqVpYPkx͏!Ŏ&IѩOSt7s/U nz -\0*^rB! 9 Ζ{VaF%t.kc0'f%g*Ӊu7!lYe4#+ߋ/w[RNJ)šg(z%Y!fip 2S%(39 2朗ԗWVKx$n~/~!T2bgrwߙSCroXm3hd.~sb>eMxDzJmx9 ģA<7 E泮L Jyŷ/6Q]q:8dseXnM1yx}٘g\~"6znU;:b5S̼ٸVH=D/w?Oro?tۑ'>StOueq:Dt )RVޤq*4z"Dߐ1Z>D_4pw&{'W6M1Gȣ^CN9H _/ZLZ~llȸ@IPc6|QLl{+Pm>AҐbn/W}*!UKF[6Q{?~8Xw2_+B[S1C=EN*EwLcI*|Jz3C|֙US"ppAa6pa%!r:_M.!šB]`؄-}s=ߖ⵵rBgM.yrܱM52$tޛ=uWD}*<$O&$J-:YԹ#')dĐk1C-nlM~e?7{I}.ni oڕvu/,{PP> ~WY)6م[djӸ4c%ǚ!|e=]":Cb5>Zka1ʟ&쥘S<3gn .J]}`1b-M&P9wD5qJ}z9rFl>- N6d˳Qkg#H7HFu{ [۷Gm|ol !:'n쬠,4vipw{n`wj6"Oby l<i;/bZU=52ןXrXW<nʗ@]ݽ<*yqvLLӤq4W VyA i_^_=aN۾ow  5|-@" YwC Ў[dCO~w~j˷L|{ldr K"O6g\Bkیm@C؇7JtBoFcJ@9Bت<`u8zF-!},e~>a}F]ͅ9)z;^sO}=^ PL:ӆbf#SL=㹐j*9b?>a/5ŏ˝㧡kW B|Ewjm|n^ Tp>::i4 8f<ȟލۍы?!o\Gp[QAc:*6 Ffp4c,zd8})d 8[c[˞wxzN' \^ I婶_):W)۫M7ͻE5"9'LY.feW$x]Zpvp :KktOe~qi=eYKM>b 4p7')Y|x,xd<ҪY''3;Q"kep 类nur[KGStɑ96W\>/k'0D1xcb]sIA6bP[5|!7G|*M\>v`#<$18_8lz{WeM(:m髪y6ٲ CE{GN܄,7Ε+/4R5|am5⓾o 5}&SuV`,Z%=ߨ2w\7897G\pQww3ŵ%\ުE6˞_{$_g,)i(:m/KakA/PhQ٤-\㎁SQ[(7ʖh}\t:pΞWz8_Xcp5~ }wVnFp閹E>7X.œ-%saU9} R=V-\5YM)ߕjfˡtȸ{k;GiX{'ǞW/]3k$ !E52]Vl9X3j)䫖OxMG瘦:ŀ*o89ѥ+ʅY>CF/Wel:7nA(NXs|" 5zʹ'|U=ѪfTE/?Yg<5b"‹74?/禅Or!;^?a jr)B3ԟk3\˦_o>eRUJr]f4NC~T {+>Tzr {}Iq!ToZdSRulX4w9rZUPzG OnWL;Qݾ\97?-3Qzs݈uM~/fmH~;J2N)SR|PMqHa(]pńYzJ<֜2 Ԙ~PXUxI ]^^X4ݫ=@aMPx]jh9< j(M,|a΁Eo_)0|n,ʉ>|# JNjoklP|G$l }6hUlcZQ j͠^B)Xb9[쫛^s`%'r6,:E-&.d4}ֵ<ŁE{擆GoJ!6B}AdpDH>O苫 Afo@ٸs οw2n4׏WX^\0:*Sz \3ܧi)zβeEcа')\UnpgwpQ#9*EF'wls6 ?TZv #zoJ}t8ZvsX_ԅ<<{Ȉ˧Mk"xjzGonMJƃ#YUGL^D^9[(9y/[n/;Ru׷JC%iW!`qʬS{A:tM%pSm ^gF=u%af @h|ռ]'9~'V~\tbV}%LgC=lVo)i~1rrMrsx|rk.p?~<+p z&GkC65#ob?^~&v>Yg}sȳןgQe;UrD(#iMxOY?{N>Gkbs¤1mćb& Q};/*RwB%'=' vq;,0抡vz_OyenӷtƃTͫwSEy]?]\ik;r?^;<*z<{y'cI68^a'ooBy՞گӢ׃ͬ3:y LE8fG2z?xdA"x?&ot[w %f~a_Q9~p2>1Heua.:;(G&Am^N% By='r?V,z ؉;"~!OEp?Tڿ8_^*gLJOY| w}6ִ!ܝw7,)#!<:p']OvS%%~QzGyy}R-H@ѣq<5P1# @1œ;bl18p/f-EcO ^zs.s5mR6ֈ+(0S. z^az-HNS H^(7Nte8.[ه\܆ ڠ}ϒ7NaE (P@챠C>ڻVRH!~G?uWr}Ǜ0*7;xdȾaPD%e$n^mXvgGoxńO3ؚ|屚)PcZ\y(`U T2YH)(iwqP} yƔ4!-nPJgM7gџ)evn 8] Cb'-˔cA(`)PUJ(,'w*8oξ5X6n,bkO&[f_Qaۏo?=pt@Q;1JCoqHyxWS)R^Eeڡƈ5P֬17N^@>E^z2enc , U% :Byą_|7׵kCZJ!;_=U֪;ԠIQΦE:I^W]lwJ&%hԯZtngBׇ@Z\2 ;^֣[YRPfs\>#!AD;O~{eelK: C;(.=kJAoN \e >[gM#JO-UUx }3FoZ8 d|2$3Sx\2=wd|>t>/qw8k)bg_ZOR#Cɏ{u!PJggP^3'2NYGǵR(H7BaR@TrXۛW=ɗ =Hgm>,ɗ$>gW fZWZktک* "mmXHCx#ą_ :yq͢ȵjw8mbj?4+&|>׫Ž4 gl>s C;EQǼv4BY^wCjG4Uf7 ẗ́jp@<*|⇲vu[=p|T̋VH'* bgkO##A |;A(!岹 H>][R rͧī:5ټ. /~SV4|gϠ1*,S|S٬Ǧ>(HG2ٌ_زNO]m̏Fk;#^/T b?ո_T|X d鵲%; vRqĖ;Ur|ᵭ\_a7P _??7\v(olƩ~߇bwɦ;l;Ծ҉ {rv:`97·<ДqU2yRU1z>x|*4{8{6-/'v4o.X eGvLJՠ9?n\Fx!!ĥEzqcy-N$9Wluamؼy$bw'q µ# qG ?z=[ҏ(Y%q?i9ʇN<%Y7Z#c:`f,C|{}-O@_8'y&yJ_f('\GI\/^ai9aޕ(y 5~]VE~  p~+k^*ߕB3>ur;kZ 'C@ǶmZ$[Ƴ u $8Yޑ&P}>'n_ؚƘLvm={H 9߃v5?xn'sm'_@[\nuf}R o9x^_KcO;ܿg8vWW=ܔu'LBQgy'sI|_{E>Hܗ Ƒ [zAaST^<G>}d?K`D2wd_߀`<@f(GG}!_!(@zOW x=㸻,ir=7"yd/~@ K'WGrk^M7z;~p:_葞2sxb;˭y$t=C'NcU v4h7<~r0ޙx^COϞs6:60clcnI"Þqъ'?f(_:x<>k}֜=)_yEv56t ۝瞐_zEmߥx=^zD{Iyz^b>ōG1CDRs59S2xM&<7(Ǹ<݃3w>(G] "e>)'O&h/4q0(Yw8Oyk\z(s̟G(Oʣ 9><w< }?'bG R%|:ǝZsL#O'LeKQf>jM k>3|F1u9^؞q."|\z#( H09ȗ8nɹx."c?i>X~y Rgؒ8y"|jV㋼|DIy$Ǽ y퓞GI׻EDR红_y?*>(Ky7Hy3?鼞\3S<ɣ\2uRg[<9e@ɣhy39''74CQ_QCehHVPx)hONCd QW3g}G\Oވ"(b/6iQ\o@#佪y=g>JxϝFd< |@3>'Sy+z)wx(2Pʣ(9Q~wI΃qpx8QGXPy2(\(/g2Qem| z>E^P\<(#O|~<ʜ ɣq&}QKpQ yc};ʋG1'xQ;ʫ&<9ef~Ky|$_])jק_8ۅ]؅]؅9O;tgcO#u}dew̔************{x؟6inM5Lt ɵMZgM `){>PP\ huV B@U]9_^FVZʤXƚG4uo=; ~m^39_~q_z~Cڽ[GCGK_ìSr-=}Zv0QrCZF;v09y4λ8Rk&]X@j~!_/z1 _/fFy Z_P:B-Ptvwi_;O[[ƟBF]6ev?/n#u=-Ï!O>fWSV͇V-@o>=#]2j?/ԍ: d%&\Dh ;{)PZjͿߜBX2>c|*Xת,$ b*$-3OjͿAX2Mьu Mta^Kxmۏ.ԣr>4ׇ&Ԑi&HUK2kjͿ=gnu}&o24 ȨP7؟EcLPj濜`e,>H&P4Rsw)heangþl'Rl6S0buc$kI7{p}"677Z|ѿ֯ٺ?"'Ӌ?%eqӿͮ66s8K26WRqcaxHu#mc%ZZJBOtY,^$/K :VRQ!:;Au#}F}柕d?-\?e\aTQ 9c]vOZoMG0.ϙ?i_7@$^)ƿnDqbj:7"8eTTd+Xf_R6vHgtHotHgjF:{SEޔqua6]?Uٿ\;>\a;>BGt?F7bɣ :f~i6aj;16kVΥ|*rlgL{_&zzJkQN7.츱;Ӥ}~-_4UFNA^~ Y9Sl[~iꮋ(Q$'نtTWljjy|{G΂.&T]+D:+O8_XnGp GMP8R'DP,A9FpO쒳K.9oh[#b~R,Qyt ՚::Te+~XScO](ڤwF(?{,$N";m=Q,,+$_žo7 ]<{;(6| ZSr't۸FbQnjIϵP4Si#0-zba e@d߁ 7B1!]f ?!% }׹B 4(D]zi((M`W-9Oܓʝ%cVC9Yº.78Dl_7q#ֱvf?>?~|4{7`Y=DR.}f%S^A(S<&!E{L֙? ewق, 5jTi3#X2gJxUɳfm3ukܓFy( x4vyW J>='D*.’SoO-kP`L:žY%?cU"k߲Ɩ.2b}sv#Kw4-TnZ/f7qS;0_6孈6UCKzD݇#_$,e"|WYtG.|.lhR4'{3(;>81<+uierʞ"ߜHGx?\0h\y/Dh- ZN4m~^KdzMkC]h7`(}6nlK{n6LQs)-foY.2`4DsP9V}Z?@5!jK(6lq:JV V)ˬCDȊoPweOiK>sh". [3Z TZyfy%3{:B*@tOuhçs%X*c}o8 '(O&],^S&݄&X?FT?FxjX=ӳY+x5IH3gDmgQ,꺉Yʲ$nz(k<zLxͫ:Ǡ+ʞ@]5C)պG w4:~T.dƳy3ΕCC9gbT7AڪLPy-d!k}wP)gr=X*wly4S*>MI1/? ϟ|x*oͽj[CRP̿߾fT^úHh&x"JoxƮ۵sQ隵VP|i5T7-hؐ- R췔W%Y] C)N^WT͑}LF$G2Y/EOZ;ZAۊ? `Bz"2R9%GJQ4VzXG.nuKgg /^,>_v#BӎXqa$-o/8d'eD)qrḀ̇̄T!B%1lTo@9YV;oUl9 x>[OQlm3q{ǩU`C5y5μQa}RzKDV]' .CȇS6^pM-)%,lOy٫nieN?}%f=u{˱h-b񙘖Gf;?fbf#Oșx$T%4gZ>-:UJ^}_~ky\v?/Ꟛ=jkQTKSjc;A$aQ׍]JQH3@/%8-%bٹS<}cbJ=;G&+"Bs U<~,M#nDѓ%6Q5ք5y52yP8eQR!TB|7~mWrcyc̷r *78lP_%79J8r"TV<#KmCmBh͂c;&?/jfzeWdrV> G)G^/{O߳8?h{WޯY߲佫ktB^ C{J0g^lGw>Rt;i%ζ3-BUfCJ_C䤴^WoZrxs?GƑg^3Sx~Ė/Q,-$3iW(1¿7G@|UP8ץ#(fdM:s"2 _:M{Yg]eoP˝*,,15t~{,X?5j>gue۝(JWNjjeˮ%Ոb[\1: -.,vCbxd#usOQKQ6)ő/}lXNj8%u"B"SOԡ>,K y"B?+B=TG ֠el+# /%ؿ$pg~TA kҁ!WE9'xJWCG Ύ3ǥ_~VwΩ蚘l?d*md+ O%[l1Kbjk7GW<)2ܞPm)r%mY/LD&Oe[y,k/m/bEeP4:.wV!SF1*o{5^{þIAES/"_Go΃ hW#uٓY[_~)[~QQ.YL=Á~:n| YUxc4)ΓX:bDD0PXaX&2*sn"}DvZTA=Q외\zVo߷F-NW[3%EgvUm/ z%# +\:cTd/R^O\ m ϰ{& 79j%/-͒dcVж; ό5AT)}qn'?jKXx{CIcu^|Mߛ,2.vJ,iǣXsz]y!(ɣL?9^s5V2sF.G0iI.["v r!O[P_%Z#W݋%R>ni_ԇ=o;4}pnuq9s EN[ja DFnҾgh-kj^PQ7B!7%7/ G}^T9P#YNeaE]6~{CѬk_8Q_:T<;?ݫW_S<ŸU,9UZt\I ctZpSh#k^mYp7țbO{,/שa ygsNxG%q$Ճǖ8[4XpuVPr$""Ri(%`<Ŋ-(.nB#Ŋf'^Q,,ui@l|) $sޝbEjlhA݋+MRl8m|''E Js)6|h&,dQl7~˭ SIɓ{Im* .Kl^P?XJFW;xyGP* ΅bj0tPws&|j DORܘT}fR~0 -,+F /r fǺA:P.nh>XBzsN|<ơş(~z+obL=(՞%Hz. ->:ڝ< AUyc&_3wh~8aUʣ/su~3[YubnRt6?Őуf<1J#*Ő]mQ ! ŗ\P^m[5u Dqovʇ#[IB}c6KgȧƟo(kwᮭ`W3 5ubjТN v{f'j?I#bkL"W( QOLQf7Is .TwԞAVQDlG1.7i &^͢Zuy'ӶFhUwʲxoNo'h.xgKO,kY#3s}[;U)+>~finB=)ݍ!-`E1T顒)Y=ʳb^7QR6KAŊCT{ށ>5A= j{<_N:j;NsyMi/x5bbu۔)F\!=y ŨG<.?@.oJ!Jo~ ĄR{p b*=: b7otbENZ~V'ztp.qko6Z֟qZ)@S;~DA|큝{!Rj\HI@q4D(bt8OLj 7b}s;qg􎶾#;܉cCV^D1:mc߈:;"tnk0M7|ϑIz! $RCEq]׳hdN(3DO!:d0,cBG*?8ZNMUz Z:Y2VVC+ڰ,R;j[(I\!a|b #)<)XsvY1&X*"ԉ.Cѣu\y]{kcĚy_Zslņ;(~YO+S&Pl,p2/OJشU~.ņ6DhPlJ>i5RAcP_1l9e=:~mp5Xi׸Z_(qX#a{J1u]1(v7wM Xӽ:d\w[HVCrӎm/̇ f|G%l+!6`NTy*Z&DMX{I3X{ܼꝥ* )6L ?)bxq QP?˗4Z]:eEg>,z.o-]J15ѦRNԊ貱bHq yÍ+g~E1DiȹßƺU?(F]JzgIz _ӷf ᖫ3eO*Ad"c|nQF(O1zn(F]&׉^$JiwbhubP8rya=е/+b)D}|Y[j;fjC!>(&l7Cjcqv{OϺqbQ|>bѩw5T))=\v \uˑC) ~j q' K[eB܇5g?S~ޔC1cQT?s k>)=Ó*(f前aӫ}/򶧘k6ⷓoN   "J;qΞϐv׈=Fλ\nYB1z1$v„bEKSnkňl}UbdSj-ײ"wl? 1 ڻ>=XOAa]Yh4hhޝ/QUJ ~+/x6b܏6? N/8WkAPL1aHx:w H02HPiHi"|_C1zm^YQ˟nR?GwM,>#/_щw|ZҦ]X{ya16} 2V42q*Df] ۾6BԱ 2ngPLi/إF1zJb]:wwvWs(F߮#2ɖb/)YN{WHY./aϟ?? y4䬲oB"hW:aPt;{RS(]-- Y|7S U%nOvEn󕊄S=$8 {(k"oG>7M 5"^,x(b!/#BbâcB(ic,q1#sx_tE#6Vuj(\j8k3SHx|DW^v~2}xb͗ 5(Իx ~+$f+g"͒bfm &, "(;ïz!83_B Ϸ\ \=5?dKR=.%zUnΝIӀy;7S|Vd<+[]vo_^ﷹ+ƽG B ;UYO}`9dS5e*UC\#z4Aj#[s#\hl" :4^vguO9;bԶgXj]_z^ ·(J y}cJyA s[N]S CX}bi)R)PjO1E\r&qI[O3&.A :Mb(ՠ0kgHįK&~hy:tOCLYKQn~)/YVs+);ooC  Oϭ{4iǦCC6H0:7t0r}1`kgcP=+{sDk4yX= `6HSQ<~a:%Gҩg>UyP[Ҏ=~(ڧS v[n].Eő)GLM%_v$DoˋVvR,׻,wVY++): U~cpt\)+!t&_Wv/)5&{P4ŌCEyP̺j0љb=uQ͘vvW߃bsS,z4ZVYl}FeY. {?h%q Bnf{C /(F >7g wG7,\惣Ek){7잕*Ŕ8GBV fYoZ!oU~܊_ K{;6C̉תQt˄9^RMW8l ŏbk >O,v8RaK _wMX]Lznw˂ҷnUFT/sCL^~hݢVWCl7yoQuF>w7m2\! XrKAo Zs2ŰATjTS]J1im){I%:Jn,ܱzZ]ȝy7&׸l߻="=ڞ4Q TRA2[M!AW_j)Ŕw3~dS gjqi'ŏ7=c?bŖaW+՜GU<@ؼ9}yqy=oYie'no}4оQs W%\-RUecW%E1ӓlR%v"D& Q;bfA>KB]g (l?Ũ'"'1sNQ#'d ^ÎNxb#PQ72Jvw+GCTIy9\P5kg+7SqW$S-D]>)wmech)#-^=%8f8uZzj-VPqbZB4Y'?Cyo.DJ<4 ?9b %75_5/䉏;Q|/E`)'(I gM}u$~]p^N\QTDܲ^pO'JݥkI'nNbٙ ')7MV~ O#FVDQ(F"^~f Dn3 1vP}?|Y>BKbDlyt#g)Sz;Ƚ'Q xC#[P|uj4NHAd| lS9kkeuunkC1je SJS8T/QC L4OGe$(1;YI1\c;y'QR.{Q?υ3uCs¥!AI?k>_bܰu׷ B1f‰'(F[n>?,CIQ%86/ά)٨e\F1`$BQ2<ͯ O_暉Cեs̀ĕݤ\C]\~#z8t]GQ i2zA_!l_uV09Dz\]dC儕&:@D9[(\f0Ű/ߊ̡qhIbQ!w]C炛CD口E!i_]>QVnDN9؉J^mD֙K+RqevQ2Č)?7ňl) 0G%(UWJow[EW%3CS'șJ13}h8ň|1B_xK?~2HwjCNG1e^fA1R]0Suqw]1׋ֻ,{;O\띶DQ{?|qRI:\=$yԥޏ;/롐~|7GK_"i9_[˵Mh zwaYF8fQZg/-_j~7dwq†p7^>+?sg^sWQW7F-W5=r7rsI\))s g[(ͽkNNµM0uC)9wxO5%w9lwr1Isw|ݒ>_Z|i9kE/Zoҭѳl3̶k]vn嵜]gyn< <T}_>{TsG/gwG{Fmv7k/ˉ_3KD|7AmғC=8ndكlhllUw%jjvF9Yˊ(rM/g-[)=G]t#f`^x؃ AwͶe@F]0$NTL2^r5%3DXO-oz)wf? :H'Zo6_ &s,E0N,}9ϕ,ď@l.h 'o}dxgُO}u [$O뵜gCss+pե꿺/u<GF>YN9k~/E֯Cπs7qEf>I-d5Ac%Cx/Op D*nK%ܾ͋-w$W9#(<^5sIEN llQhϝSB_ )Nf׀rǞZ/90ñ>G!h/q28D&Ӯ G7`(p㔣-Кi]ƪO/3xڇg9ͦ8|% Wt(]{{b7~# ]}9KՅ_*MkOYK\בr}'r>PhgLD{~HCP>3iC0or_inި>ZvɴCcp9MG q!zvI@yQ~o"Qly47RܞPc/³8<ʃ`9/rQ~B^%vE=b?џPo_᲎K&a[7"I;KPN/f PfԾ.3UX;} +y=gɃ"c_^e^9ڞ(|?O2L0yt}bv0.!oR= oѼyz״8(/!Oprzԣ=R>'vsf=? e;[ǻGEE $v~;8 OhD#^{3o"DR5# 'Ñ~ğ^_΂S^zꐃxvcg$J ~ M{32 t)ķkk:Bv$F$`y$Ϥv󒪇wngyK&#w^ I>;؀7etO_AOGyJ8?wQ*P;K"b8Q S=֭(qD[J,Mq)T`ICH}]x٬17_xulUAFxE!ȅסdyD__ Ŀ~|_@Op;2I܇Y$$b_}}! sv;n_ w|3 ڰAf8y(o$>bX@4;vq`:\8w_7xHtH| vU=IN%LɄ>B<>~|"㋘FEߧ M) ?˟ɼ#O/Į~H'vE3oi/{3HHJ)E^Bx=?ɺG_~ %~1$|C;~\2|ү\d ^"M7%!|O&AlD/ecy:/Dl/8K?=#Ie?ʣ9$Cg$relw?lw$"f|O6;I6ɿ:c?'Ko |ϹD/xy/O  Hy<y&{&?O$΢#{Bx:P.wrd#gbȫid|z'f8AxHx3S'>_IހFD·SH^B‹4.Q..\2yDnʣ ]qE''|IaIoIܥKg"A#$ aL'|:C=%z@I#<-t'?eʣEDb"w /,#VF]FYB{(#(!yFG922e$/%~[x?v)-%^N+'GXHx3 ?8#'XHELJ b%8/!DYs哼#?R}vQ$gJodCH=M3Dh$NR!.%F9 /I9_m)s#dPN햐~?=;+!O)$PHF#*%|ZJWH ǥ<乔GOI|)&q- 賄ėR2ʈ_`{ed~[J-%q yH/#vAy1ʣĞˉzbo9qI}q,"~B3_ a;.BOKH~Lf!׸D/=t^Kʿ>ՔW,{%z=8:=٘g?yGm|DvA%\ HQڑRE?"E#~P@t]ĉk?Fׅp]U@]?"༸A}<,-9pHob*8J|HNQ»?=Q@$Q> .%&Oȓ$#O?KDd^q*)'p0. v~F%G?%AG+0O$z YAS9 b_Nˉb΂y3!굔/x"t>HZB=%dމ㼪K1>HWĞ.PПo#z "wo9'l_J<=!O78PF/tH*N@Ďi$Oż䭝|?(Y\x{t0$ץ$3gO8seݥ+a]M\?"\'_bCXfSkd@q;|u'y$cYg?h<%J;S$u'O9YOqO)LE$} d=o< ן|wk$zQ\"z![1|x\o@ 'Ǩf>7Џq>FABc[=W=!O#8dh?\:>AƝ]bĞ9|%4?kGȗ\IV 1cW(b?0k&qgK$S{aŘ1~Pg;7=ʿ֬ ~Ӓ<-{RX (3npض&CK:K1Η0`8BdQ=83/l<ĜcJj'\ /{*#߃2/]gh00++W&ZyF/<$w= Y̛wg>How2xʃ~GO8qj,Kqc8e'G8G0vq}(:/=zcщ-?Cqv 7!(yE(OY>{q>O277Y,&y$ߥ=ȣ̼ Nʹ7&x͈8:Dt~Hx- GN~2,_}_bp&i/23kvdIdp<ژqF}ksZeshω>F0}7K4& 99q#?]ܿY[`/y>_; bG? ociKҙIa '2v$Gvq-?~lâxvv~cK2؎%A_KܧAbK03]s#wbOz}7 d!G~p)AG; &pq_0#ǡ OR9(S|Ϙ=<M֫>wCq|ў^1^0 Z[1 0.'o]2z?J?zy =h`!c_;+qg'd//#y9>=/l։|Tl0aBϩ`G7}D^ySz c\v }}W=7q*ܷ8= cQzG#>gsjq,;gvɴO&` {OfG bȣ< <*[;ż{hX`C{n|s1a vL^{8'y//FG}1y*F>ec(=G'#IF~vBdoCBbkL>E;C3C y.=7  8 |'%r`>Q#^Dxk7Yf9s=1ʣ~#ƒ~nQ}21nG\.WQQszYWsdĕNb><<8qhOh4o"y3?e`9ֽp= #s<2QK4c~ ^&2ϥC>?ˣ4%!0Ϗy(CxŬg(ד~ ~~DʰSr1O0y>MO< '(9h|R̛ʃ \#?'(0?>y y3>qK}oy2=7Oԫ{(t>=H\@{ d(20g$s\u=nguGsɣy#|y3``iԾ)?B%\uas漞"c}XnϴS9sw7ތ8\/f39z3΃0E^̟9u|r>UcPro h|DFyw8v8뢸3֕|RCQo_3q\qQ!* pGGq0Q8_Bkw:c̸r2P} &>q7y2!ȣ32f/Q.Gq?;@IAD^w#h|#c ?[FE#{.*?=0ϝ}Gɼ =GPvfGϿg(ͻ"p~ȣ7#?3{"~X3gGIhNIQ\|I+1ף7=-{{&1y9]iO3/-"ysvava[><#ӽW5wL!'UUUUUUUUUUUGiO#wt[lacOTLh:S}}mrſ6SJUc|jV52061-/22d_66 4Os ,۵pIgo=5ty/iihk߮{iwgs"*^%. ޥ{YZz`^ˣv퐕as5iw)pޥyLλ;%{<-04B׋^Lb ^@b&uZ.Ҿw?˅Ѝ$lFN0/~4/^MuuFzZ;;8m7凟|ȧͮ66ۭZX5>=$}zFdL~^uȰKLM8nu v9S0 fWS9 d}WT0UYH`|kU?0IZfz#fW_0d(th~Su#:l/۷]Gu=C-|hM!~=MFA=X-'#WefWC9?zBLdhQ?nD?\v91#6w%N?Y|Mܣ$7i0R21DTIKP}N<$KP]mv7/0|+a=aH;5!o(D>]mv7oo5/޵N-B12_juc:fEOOo78-JZ?O?W]m}mqelD@gIF2;J4dɅ!XHI^u|Buwb&F&Jp?+ZZ(^-ҹ0*¨-;r+ƈ0󟴎O̭'9)8a]3"N~97-o߱BIREOo#.Η0NWBur[oxde҃Z:{LB,gkh)-b-N믽{/:9~r.35jͿfJ}8DqʨȰẀm,,_aHgt4x)vmwLJw|LJw|?~nĒGk)ulXS S>wblܭ4KT.Θr 㽿T-M.ԕײ8o/o\qc{70w`I [KCi r 3{ٶֿ]Qt%Z)%;IN ί>+@};\Lݩd'"VtVLkp,!؏@C $8$qN 8 AYr N%8%g]rv&'ѶF"wrAsc}ziyv~ |2)n}(;|)%S(=kcK5;.u.QyUp)^qr}{_8 y r]6o8dR(9pJ5xg%VS9 Ny74p Mo٣J%lb4m+y!pHߡ3bN̞/@ۏL"_(UPZO1`׹G@{B@nBKS2Z](Cd(/8{R5hZ^u]%KTgܻO{9؛ս4ljVǎOZ),rX"=&JQ{,IUg֘7 lnc]ͳK\ەbQ9O3cwkldNh=ZcKYg5w1_[M*o>=DQ䱐+sYr|8˚jv@1ʏ:o`IOңXŒQZT?"B#c 7;5 ]~4bY%\m94`KT)?/lNqe1 XBoWKQ˴Im,Dg9~tt Y7{~Y=:8E!qWa Os\"4TDQd5pgS9*[Ч(8HVuKdfɬ>^+OS<4}|"K:D}KݵȝeriEbJ4쒲Lcu=[rV< %k&`%[>?#ձ,a 4ߋ8ѩf\X@q 欁WETT˶9b@0"(" *V11" H0'̘0 I$(&$9$k5g}w{ Z֬Y3Uuuv0i6H{_Nf^|dS{ƠK/߯&\6cY:xxs}@q4䜝4Q," S߽ dLU |z'V.1rdɄ/>zReIKH.)_owYL"e><p|c)}6RS53}w`.Qp()?eKRUu1ԎXo4LY)K*> Yʼn iG9LF^ﭢ{:L*r]ԛ__iYvIYcHE:7L&&ʍ;H*!KMP@Jnj?&e:Hu짺ďIwKdI,pOY<9h:dV0mptg(>ԯ`ā `/ݔ&\#n٢rn!|K󮸡IڳN-؉;=qUST)(edØujg<G>xz2F|sdyΉ[B +/#9^ו1n蟉h26ZWʽ Q~,<4{;Tvg 㔝n@8r{N{Gr^..b&2a$:]>QDۮnX?+v(5Frʘ+P{q;rXkwTuWo[̨L:CJۃ%.935öOҌa*sOdHM8sKv]ƶ rbOPΈ ;|_wyuk{;;Le{颵*)5eN/a +?iG >rnrcbn{J!EIaJvcJl)Cq:!!Όij9֯fݳ[[O~}ruѵ{"qU`L7,Zqk7ƈ~ QV'0)%vZU! :1i.[?뷊^[QW!$%bV1Ħt_xݎ>Szlkch ȣCoSi'c:4E)r̩vG:}Y?l-!NHWx![Ҵ=1&t6HyG\)"$fŒQlgb{2VqQny,IpO{]T746ms0\g}[[Y805MyO5oxf8g<[sT?z9[44gON ZwK}},Gӈ฿i[9N=b|:[YV}}̤1 (yڅw/8۔o˹E:M]-cc3cX wXyG`i`x!5:](Y?T\~o9O]yg!VK ƘN <SxxcZAϼM^wscЄ5Ar2hzacivV^?o稺1Xyc 8iC-$.6Tz S&w8zXȞ) VqD9 ~bo|X$nt;n>D}Uߒz|9I'beqMu=. $xiG$uJv$f{ .NuG=;gLEkbJ;??THBmmJ-o%ռOқGG~ұ_dlIB\Vot|xyﵦ^) Z$WAW<:MBV㛫o%ɘ*?uR=rݰC?=d|wl@G2e;6Ld\]k4HN1Wu'CXNI YKi  T\9)c#>xLP䊩(QG.yU4qUS%Z . B&**OR~Uv#秋|{.!?d+ ʼns~쌜a^~9ch(c:1 7_+U>"5I,;QN;[݃k#o|3˙1r-?[rC>/H{4~XPUed >&2uиƤ9y0+r5H3ϓ,2h&<C0FL-pF9fpRdA *'[1c>>"HA%#;1tB@BxΎF4زH{h;LI:FV1m~ƮT#.̝zqK2rhRf0)?gj첀CTQ)!F~~]4Yfd)0N/!]5Byt1{k:}TU6>@o} K+\;%).Uf*$- ;ZI7+ 0Wv6NDLd|kƜo?GCnGiHH0tuX>9Y;9C|!r[ij/eƒe͌a½ 0f|xsaO <Zå+'L.͎"1cc"H7/a+]E6yUxs-]Iˎ؏p@JQg?#~=*qho*k0\F d0x}C'͌{J1 :Dп0x%b-jfcLG˄ _fp=[9a"] U)a(hښů" :mZ_)c̻M7r1Q/W1F0 ưҏN֑c萖a |#7kf}Hi4 `S[2$ &_͘=_&ь+aƊf( 1M[Q0grpc޹\z.Cvec<UBrVe_Ilcdt@9ƫHk'acO[͐}aOƲUfk3S(7DQI$Rv1OkDiyy 엣 {Mql~HN#gNڍI81u;ywO!￙ݹH*[F;;BV֏V Y7C&Ye1W>d}S[Ȫ<'"뙚Z984[c%ڬp?D)OՃT=;=!4ep)p8.aQTu>\:2ɚ|<5 YU_.~zZ,d$g/rxb]h /)R4xb>g 'r8\%q@.?^ɺfhPD9owL^~vExC&Wvۖ W[I![ZMB^+N@L\~uH#[&}x#xg!z#Eš=Ș4/?thU$ٱgt"[?m79Ơa~gj*d9CőT=#G/js2lxW ӗG{NZ$;%-i&sǒ~#-G/_&u=, k,.BiLߏilLuiȺN1,7[|mD[ 5:$ڵ$$t+:ya΀`H_9} wK "֎w"9ƵZkUg]PO=ZC_eO,C=?ղٺٮ=9XidшU"zMgxmP -Rq4px͢Pban3+2RixY&2tC7˃!|s&^G^'R#2]NE:24H+2h.GqH#I_=ǩЬ/^nI+&fW1y^ .G2KX&qV%E,FKu8Lϝ^C$!̜G)NgHבãn/|O"מeI$1D'M{ToE&mhŠȄr!u2,GƸE\0i[wd|<[bBV_ '2IR|$VGC֘?# |/pF ~Z%uda$~#,_\dQ˹/Y<<`zdmaLdDգÃjacF"cG"zGDSM"ck!)~dI F;I1׼ۑq7C%n U$B rUM.6!y%pajM g6f-2%5a2^9OY$NϨį"@' Lѭˑ1]fLG2-!&ɜ"8[528Ӑ+| ႌzcȨ| 4~B|w\}N|G_KO@?np}427~j$KEvMds8q²h/,]AYx$;:=cG|JE>4vvEIUOBFlڛVO\ۓ!e$l`N Xl|T;uy啾MDF{9Hۭ2amN=;t nr㖧=:>!GΏD2_ݟfcN"g y5O]z7DP8,pO8_J#<2a dUhdmurdL6x"_z1|n\uK|\bːS=RxرQ*җ>Qk§N%lG{NQEh֜"%+Rj:zan ?,/gK=])ψkfD?F"nxd=2mjdtڋE 3  / TMvܻߺ +dwɦARSrD= ILgDgێ n^hDb V }2Ö!.v=ز%>4"c2+xX/WݡwHl!ȸCoL]$sIo/@OM_}{3IPS8S)" ?TMc ogC%#Û*AFܼi{<*oqdwxpĢ.AQt}12Zb@zlB"mtQjI$[]7<;xqdE/Ks ɂϷZF)o%s[pxFOrN\[I~ _%r-'m=pdTY3X!+'Z볤_mp2a&"XcDscd_!Kqr"Rn?ycmeX"osd򅏹RU`hZPo`CskJ藒X̸@w&kC!O*_t+fHKU*V#U$!%M퀁6F*\Wl#aϕ⌝ 'vgs*3t>ziϞ6xe ^(Dsx$v92zm laL˔矲Sr˒dk M~,VJ!Ss2Y(CϴV{R|QyN>d\GJ4dq8\%*r/Y4a30RX}\Id:pz5jM8Rڒ$wmޙP[=G r.'£A%l0_Lt8*Ko~]@#2ɰG;]Bvdm7Q5dbD!CHa$`OռKM R' wY$^y|a:2$hFf\0@m9&2W5ISNa7yg+k@lVAR]Mru$YcUy:w@@cN^/.9Vt}, zz+.^$A9u~>?ݼ@”jռDNj|ڠ;y~3 8tKc`ruq|d4u䣇onzz SJ]_oYe`B̗9"S}_Y: V]]ǩ琉7N3"A W.&>ZvWWn%R2:50^ښ}c`~QwߙP (|F~Ũѷ7җF Ɉ#5Hfַ5rȫ1Rh  ֌5;:NY@f՞{D?=?_覼D%\,jܣU<.GYvS$&)arY=N`N>JlrCIiƇGxba;[ۄI$)ٻ//JΝ? /5kfǓEg?!f^ o]ksdMއKgC&9eN >SlU% Y8w)MR"ǭE9=8: ~026٬Q$%ku+e$n$9Hvо!"3]ې=l].:gǨ0+}hk~H wZ0ܒȏ@,MNjWrSNשV)NsUNjmxٻ|VGS,Qtnv`2N}О/vwe<&c+2m_O!ENtC9MdbޝfOs]v B88m κ~o5OÊZD& #9MjVtj4a=2(L֣aoA*vO;~XC=?*&ⷀD![)01/76f!gX~M9(d*p\jd װH٣#C3Sr8yÚhvR$>0DqkyC+_(D_tdB&j}{,|ZzX7ų/@Fn9;9tH oCF_Tɬu9\%-*{qKY=[Wa0SaX=S@ꭒF!SΆzGsAj[c'VEFfz9xh_s9D'IEOגۢ3>ݧEH@ƪ>9>r`dd%;moWTK@7?rr42RGswdC\Nd$NtGC$$ڛI> km:ԳIܧc󓨍7ۄhtFF9>oCyT),QF2.Q@F)":i2Zu?2Z@2[gjsy@DU:yI6]HCqw!o@&&>Nd:ÐI)_E,)n$ITupA$ibY#ds6 ]7K$Z%gڐirzqJuL{ G*S* NJFc9f=dxkeAn|-XDG$ǽ6Cؠ?4k 07^'o!fʐQck;̸n3O wV <  $!"E 3 SV&VdȔw-EFT;!LTy*i5cp`6qh♱w~h䦛X5ώ=AF|Y{.ˮK:$6M3 qTQG/5ߕr4 f,ﳽaJہ}J~k'gԮ97rsNWߔwR;nqt>Q e(9e97}l^Hp۫^K޷ʪ嬯YΚMq^}V}>ȜPwM׽ʿȐyjп>Jǿշ>+#F;^;1ea=RϳAFjA}?}[%>|H?yɷ7ѧyb)˙7mEٱ̴qu}ײַr+_&]Sc-L?HtU`|~R?,ysrSfy.Fr/[@f힯N_-gi⮎fszu~rsBȚ+q}^d|Jynnuu9]͗gCם[ي#Rl.u";+ؗ))NZ ݞg{N|4讬>({ɯ$r@e_y%?}۾PƤ}ۧ]_êRMIef)6<3P w2anԦ8ҨY˛G7xV" ?f% /3 cVCMw.%أ<,^z³?Fe3Y4{j񞯭b@Aʧ\tQӃ4>0ӻa/Bj4<9dUyyit(`6,0#4ml^6㻘=4%>U_w*m$͓^dS08j0%aSc;i|׵,옷Z9^-Og.xagi=ߣ]w~<Ҙ(`|i7I{9{Iת7WH/w Mw>݄%!T]q$%rV>gK$->sMi"3dGĿ\ΊzSzosbm ݲxGz)vxGz6k۔Gcө]Hc/ɛ҃,6NoA~;z $,7gPzFo3DTNUvAWGt< uϿP^'VTqOģwGkZ&Jxh|TP4lH!}uЏ7S'3,#2w<[Q(=7!6ëf=j *o[c $G{ψWW[/sAܹw~ky_P~OO:Ot_ڇGLP.nyEx+{Hbj h`7G a0:Ol^y|f- H[jWpGz kO' uT ~5kY-q]%Yr|qӖP=Od p?>D`q1#UwPp? C{c QW%?Q\L7K7= >?&Cw[n{vq =8'Lzu{Nqo~_wIfa\D9P}0; C\Nׁg>Ԏ@ﾦ\L0QQ?9!ރ|氋y2|;j :':'=Q\8 #rRmƿAC=B<8}T_"\ywQ|*%Gi~~CY"?h;{Oz=ȁq?üy7*;3=gX'A<  jxy%5+(7m4i;!u쇒hx^uȑMM"{::R<3W2C8Ƌp^ˉ7tch= n9:Q0{MzӚ=}wHccUhE]!=xU&踙RDNrjA)-.x¨]\g_`#z'YTOZaEbzT.. $$#"!4N[ 9/H?߁_:._Z_Ay%r?Ոz_8(c\Rp?H~ q>]D$zoa@"zMi;{G±+*WXnaB}Zwq5ܙfF>Ch> 0B{.gΡ~E? {v'K^C,IDю#iqy?¤Ny,+L*gop?&C"i~yB|!8>*a7G``4`q %Q:~TrPϣ^i|= 7U`4Ohބ C0j.$'۟NϠ7ky̟;`_=n‘Dz8o`H_{9j!^Bu w. 7;=*·x r@|bA矻>񂾠 ;2S?H}.}?@/^8 y֛h4>`IBi~;< q%?b^# zu& 'S >A>O j __xAߒ0% u6c58 zjhTJ"N^\zEt~ P WHw1#<{͝N)TD罐ƱbW{ )rT5aV8)S_>Q))>кhSDA}uti|=P{A.,4Q?qPfPh#qlx3E d:I1ItF$OC4.$"c;:4$(- f$P9b CIozSdq(s?M]xTLqbZ7}iyɢW4.gR=BE[INMyYʟJF~ c>g%2 _pBZ@̠ jW9=ő<w1.R{AS?)~RH q' ~G!C|Z7| vM`> {̵K"/hPLSPh~$a)f]]0}z6pv )ug >kit K&j?0iT/ߦSi?SJ,Z/Sɠuso!>l"''G ֹP㺈ƥ× !77[+l9l4@y!G EtFL:Y|S_4|oh;?-E\94~ h5P*})-cE$~OC Nz!7sh*h]RDRʨ>hWNU5jZwB\NWAt>z+!-t*g{T#3MP+OXSy^s|CLP:4_i|Rʩ}끰(vSJJjG54oXBD;.rT:_jo:ߕ4Bus#U4oCWKHg9%ď gi;A9]xTC R_N穂m_5o ͻ .0Oiu/SH/Jg謉($ 9#rgVϊr9rjTxal4RF jUT*w9?q/2쟕S8JQAR9]oU;IePk?C^VA8z ԉ4VQ}@8Z#{0_C^;5Tu4!ިG}Z*\_Ov89VK-ޟ_k1+;x|'v5#럝njzg3Ԯ NҼvFN|qQ:uta4z휮/1^R8 c|-~?SJ(A ~R}R2W6"á)^J1z5i*W6 BPC}:'_,q)~/NѾ ^R?OCDc\u>::/멝B\8 e]o@*pCb]~_`gsiO/|N 9)a>ޭƸ #y^jb>}!'WPuI%4Q9a]ݬYW^JN9rU'Hg Iُ>@P/:m'u;/%?onv@5_C=W\Iwzz 7sjPeWgh+$:`=}AzʏvM xwO ~ u Խp?X¾!~BfEɱ ȏBJi=]W\zi]JN;, u%e}a_ 曻mPq]qH+ 8W<}R]&bvO3a%s C0a}mԎa}:y&a\1{Xc= tb݆Bs=Re0{ R7H%{+9ZW:khO=4.;Xq3{?kv߃)?`)p o|Ou1+9@t#_d@\~x>ן:E-POqY&-ov)`'vhax]Q|/+ ɒ+JWyC՟+xn~.4|Σ?<'D;Toh8~'rVƲ]zĭҫg 9k@x2yk` N\=|>H R;}s!_h1'7 |=s[5~xW;W.Gy9=Ia ?Q"o>>H _?}9 #: xy> x.}/}NOr;)ob;C|~.T;~S@opf!?|}9k[z ߇\os8g/S3^A;]]cx? ϳ:ߟ@q);%'|=\Ͻs_ [s5+ g {9R^P)nz"S > n σq)S|G׎ ȍIO<=0[|@m?!ޣy}sPP;u1üs_ߧ@=.3D:x ωsU4Gx? C=|{pHT;HyKQ7S >?o/q$-/) ~q(8e_P_A.}?R8 x; sPc\U@&8 <qC3ߨB ~qwBs@nVq/}`}O;osu3+Sp?|`yY1r' x;w^}cT4@ 'C;v(#K|ޛ=9킿~=$T?mkx=oO| OȐwAPsכ1'q (·}3w|(8J$ϋ08q?s>:|G!/~輁Gi\ O aúQ\'{53^(8 8UBy|X|ɢ/ys4/q]O/S,w vQ*?֡ǰõqM({n%s|~(+QQ\̝[R"g:-rfK@OuO=ʵ~w ORqQoTGpG!o~xޛH 3|okߑ=Z q\8OӨ<=mG}yT>A]U7{&S|z:M[/)|!E{M`^!.{[7AxkC=𽎔'_v ~?.ϕ~9}kAG='?C8 A|y~qʍyԟ` ~#]OA=q f\i?`0KtmuQ\ ASQ?A|G:֝Wb>a?\x ra RA;سz$rGqL}rg^G>%7~s({Y@3W^sqg=J|oQsgqIzz;gΣ;@ ~Aߏ{`ŕgxG?3mT;>)q>0=fa߁;{/E/3`^a>O'B=rB1'&_ܟu W>~/p=^%O9q;rջ ;Sr8exO*=Q i?OwyqfX/s ພkݎ+`? uGz_ s_ X`}gG83 ?a?R?Hc{|14>0?g9ϙs3?g9ϙߜG}^!PT!=ܨcz6m333ԥG+F5=JY3F:HH1^{_eli>:4ueʁ˱Pϑ)D_EL>0+m=]M?d>,LThCsꐞ 3Mc\m?.$sxDH>$͙%s@VQ}YNvr?+z O_M?]oZ_ 6abMS "dy/7a>? y =mU"zل" (npz(}8oo$oo?}qѰJ1154QA89ӻ1Bƍlk8ˎ:=O|;as_;s' s_;s':N8cx1={g?ǽ;aO / / %lSKclbxܘ4{~Մ zܬ}XE}~${kSZ@W@S~-+{¿pe=Àځ]&gCVOӸTeWRRT'P~ޫWZ_(  fΛ#7 S<58ggx|S {]lfS͛0Ӱ]zcQ SE)F)N9r*tʙ)PRΣO)OR#?r#?rMN>G#מCuNXZ6ԕV OtG DWOx_6iXDgkd}\nH}ReAL"<&Y!ެ~% %R/)s[sN^(-00# -Ovɡ7 d; .'-sFuM=\dm%FZ~%863b?vkyy.PfqY&6pD6献dwk@! 6arS9ŭej`EfӬ\/ERiAҼodq6'HK+Ȇ&l}4o,- ٠\:4}g:ºs ?i>6oi}.m {Eڤ/u UApء`ψ!c*1E(Q)5①!4k!*'I~Amֹn)nO䛑-;5(8MZO|9Zґ$Prt/A}~c3Vt:ϱϰ~&K#/m ;2юZHc[HցA~ aW߿"*Gr$]9Y^G3Džʈn' g9y[i|$?p_spᧂ}-!ɼ%>L;$ i;O:j̇d,8ܽ񒰶oϼ¡Ye!".dAKu/[{=}w4VMq';Msnz ɪҐnЛGXϛ.&w~MJl6n'%"s-lS4NR<aY)l7`#iMxvzi4;ՀIulƒaڿQV9Ñ-*Oe.n{ H@`e>_zKɢ!IȆqo$ ?ob:Ok#fU4Rw_Pš*i33$neW1oV>GO;!ꂬ0}RkM#ix?5n5;}5MU, <Ƕ7̂gI)'bO#Ր37Ic]UߺǶ :@e3ZFB6Nua>@$Oޓ/@6:Ń4 6=e9N4sY3kvQx{YݭhDɾWy͝.! ".LXN]M} 8M.VTC9x-Vl=o+v\ i{"47:ObD,Ώgi癯LIQΎҤqmIsNE~ȆА~x:V4 9xۤeV~'f R>/z/8*U:irУ-eq6& ُ_sl~S̈́tF_iٖ:RƯV/ ӾOAy!vlYq jF7JuIҩUnQ[+g}vs:HcMө8q."RϘCt uۭ9ST񦉥 kX;nZUViEM_KF>EX. j Fs*mQ1>8-w3m)w/) h78yEX>Fi!׌ 09Ѹa.(tg&i<- %!0#vAo8v|R,>O^m%,f;1W[N|vqYd놝ѧHpcoqiŊUMSkOOܟ͢mgVs" bJ$e. M7Ll8F9!iuM{"x[ۦ'Ikvˎ4;GYA9Puy@W)C:sq:iKxd%}ɴ|,`vHMac6VҪ֒ [T_ږ_':+\䎣$ G*eǽV#GS7U2L:t03O];"u[R%GaI zq.>mqC"I}Ţ%6i&Ol9e06γ<4.",G+yYl{ryXQaB iA3 A奻 mg|s.g#n{+]uyjFʦQm®Wgh;۶oB6Yi'7*4W02gobhB6aܮ7B]a=\k-g+I%UŢiT`s]Xm^~}vgH}B6~Z] j/h.rL~ [1K"]uG&4o0ͪa|3Ҷ)rui{뚖ezaHa'uZϲZ<|4^='ŖXȯ>lL˟I%u>xDZ%~{e@m Z2^tQfBɛ%'6폜N g:Cz4X|ێx,q1 1!"('`/|ٿH$.|7ʙʷS +C,#!'G.7~N^x6LB٭Z|J")$yk9mmg:e^-3)V$ >$D&Ƴk? 'vIyn,, 652u|s{ԥ HʯV :dx@zA+M_$vE:}1jpǚ$ǟ|H9n}9oXv}8g!$i߼UlHҒɫ .,raPg 6:ǎ&]Ƥgʻo⁦׻8Cȼ^ !ye +A[cJ'MV 9IύF7ߒ&azY.d')a[ $< k2JJݍWHpBqp^JdԸX$j5-V$q9ن_$:J.$~&˧&zzA%97ǣMH% ,%I)U!qE./e]Hq%cHxOc3*ȤUJV Y+(Hξyxt02Vqگ$əIb_t9O;Ϟdž_I֥[&wF9#C\yx>=IRZ~bЯȈ ?}uN&CO^IH_cuU"sGl|OKxG[?r0'+T D#S?8ُN "[$+qPΌs˜)7;=")Ku.yLxCFW\DQs8dŋ? ʬb6nYE&Ip?MjU~$!Ёo`VcK_ϸ6T ^\۴y,W$rXٚ#g^XJ#a7SrFz69\xx z|e4.oLB~e6w4G!S_D{ץ? >jFG>qw8%҅զw>]/W'& [q6v<-r:2Ӎ]_ސPSw  iJ#F呌omT !sMtpM1$&鷚y3;x؄p蓆ϑȰ㋧>Dd YHʀ3R)(HZ[IAE<@U9\8)% dH~'9`xW|7o"- s#kv.=uSmRH[fY;Kn)7c񰘄,3u )1 o0x%-3GH?+mH~7$>3>ߔn鏌|bF$Z&JxRo1衱W>HN&Q>+eƑDc5O>VEj#VNDKk;W;"bk$^QSI|/NVXa$I9>ڧ[\F_{zuI8Ȩik7RmHEkcOժ'ç9t;'4!}QC/]l0B>o6)$~7fP7`IrfbmUdR̽3HGY={B~L2ru$rqGe۞Y[ [%XM/ϩ !WIY1{ q2!cX٠:L}'I6hGV먏=A)C ۡ,ۭC$bfN?/HM$ G:rC޻xomt=-ì俏XE-ELO{kHNi/ؗWR$ޛ3cޭpJ`Qw^?9*Ry<5{_HYei NE+w[]'sy_}X2ޱ/ȆN !_6l5zZqD>9r|d3J59|?=aU+'fH}~cH|DjovP݉/P~Hț"jI6d6-E{!9h$i*it}6" 5*H[U&_32^Ows'7MN7^CN߀l8KɺrlW>dWoA6[bӼ62̊}7?~j"ǐ,Qvkp..ٶ)" ,ڀSTi 7Cv}]y>qFOi sr n1~^|'O=;}ӼIN!- |A6(Ób\C a9c$V5Ҿ9&c@Fٚ77_qraJW?~U~ FF:<<V!N9"Bο^gWG9^t@0~پ&ӥn:"fB9}x1S9t5E^+5XR9i_X^ibn{# _laX/l\vOU<6Yz54>!Y+|l4O2A|}ȡϳfl[6:4i&% .7"6D NZ.G {HͅտN#KMd=vkbٺֲ@)dӆqBoUT0;^4{.aNٽh_Q٧.v$&EZ~#%l ;}5?v CȠ;#K/H")Mi?c ٥?wmÁ3IP*HPI#ߐ`FP$Rau`w3 -6n|o 3 }^U2yd(ǐp!dXeDfdJo#/=H:Gn C>ϸ$B X.jԉa[%IW#c 򺈌*Q) [92ʎI3## F9䁌*r/ڑC}fHԘp{$jDy__r\LHwY#rlTői?!s Bzj2of fȴtl%Bz!I:K$m $mϓeH3]C"̉K/}DKY }Gx<4r薝Yp%{đAk\>A?!2ȪŇYK-/*MI;S#ᇓ_T ڝO#QdtI;R nuJ $ScdЈ;W E{_:4+C+qw/If+5~Dm9[]GyJI[A$$O_nol> Yg3m3ٷC'񉴴C\0Ǒ(}d~I#II[6yvSHHǭH/Iؘųv 6[K< -ՀUS8Vr.dZRdL]B]%g.Wj y-Ў ye,fv';{=9A߷D=^ĩGڍ>-'[0姭GX/dÈk#7"cZG6R~V8 Ywd$cusi0i"MtV\vm S݅H̥nC_!wilzv(uص= xPb|\$+09ad1>6cIٲ/izckkzBxfީ8ܛ$Oq9c#Yvk%N!ٴ2AEڤ-BP'ф%v󈁣8C wn,.LEEl<[Zo]_ˤmpz3|y +N 12:UDěZH{GKԌ$^*Ɔx{Rlor^-i1k}iO~ pfX9q(c^᫭+lpcLЪZdkzs{]rQtHCWcM4>=Qޖt=C2i0m ##]!۷[|cal_?n-nơc8*DPvM'ˬ1g'vw.zc*iyn"ʶ߬+W rª*U9|1ep;sUm\ր.HVtܸ+ 7*^-{J45:?Cx]f&mjNXG>Ȇ s&!Y_զ!,ξzTɲ||jK9cֈH֣W8^lbia^|+LXZogք_"fb{|Yf/ u ]GX"6sOيo&A\ltcn<DmP,vT*2Dg6M$oA HPiGWO<[d2dƮܻlZ͡]Cԃ9wi߇ H|pmul&*xs(8~b> (vP4٫HՈ/7"ლ,D >S؟7Y6 IQcס6"kϭ 17Tg4ne-!1;p0a]JT5AF;}nw^!9jI$Խ+;8[!W4rY]\iaC / s}Yv.kwJ*g|uM{,SANdXqqmPU͟OHڜDzd]#2ƹm ӑ#Պ3g_ )JGK+Z ?W,m5dCFw9 {h* ]5eZ8d湑y w rL4䀣; ҟDO3+߭noϮNIe$oГ"d,_`E;2M1zdpaԹ:dF-iCn: [|-OLzRT8 HBrd] #e*_`׻-m!#:0t2v6t#R߽Cv4i OmA7#/KB?czAk v٨>K: ub灶%6lތh.T0s OmOܼ_͔B>=7XJ&!3f ![}yMDx@gМ q7Oyuj>:?md?8`ILgMtL[d?4+N" ۾mEX9o;g@r<-$ɫ,E5wLx8=kKdaC"qC&[LŐdrGp{] w!ov76G#"KI蹗{瑜C=\[2wdvѯΟG/ s| 8!Q 2we-) <]aK^vP#9q7l?DrlL9艞u{:IAdq3>\bG!=* u"?O\K/a}K9JjHymoI,EӐ<wxLzԘ;x:4)-$n\gM"$O{W]D~8s_dPջgGBF߹C|!kLܰڨkȴAFLhmI  a@k`%I#}L?فj/o}S:Ts[x5XxSesf"k/h; \Sݒ=2`eE ;Mg'"CcZoC<&cqc ɎOe?%H91V$ے  C-TC8m9z5yodpsϣ|qf!Cv+~4F&ort!p:$jDTXYx1ǺÐy&f#?\yCŹ|FÐB/A濈f.,1)dZ=wDX;ngSde"q{REi:G i)D=ߎC&Gx]kE&\id12k@,d[͚:~dς .{~'#gH|7I~7sci)c`2sɼᛓrڻBfg/r2;z9널96s?ک sOUD{ci,>w{Y{-aɝ"9&^Fv/FjZI܏d￈tv5!%~Z1$"f"^Hp-)_Ҩr f} z+1e4Tg!A Q/Ie5HK >ft7&2FyvL5Vq%g=Lf6Ԣd󕪧E`A%H0:k[. aW}g]o}弐. 3dqaTtM/\xsw 6`m%)TcE'2xɮ_L?Y<}}dȚCj}4I! <ВKI[aZcV_y&OX/\sc|vu%d蚁*z`~}#CvK{6T>pdն+IX}'A'H[хH9}A2+Ɔuc"lW-ުdI1~ ؙ ]ײcL92L[];Psū 忑S*0S}]hC箽zZF/$*Ob,݆L*T90h<2Iʉ#*Df˰]1K|G& +2P|ӿH6FrKI3۷Gfo'.$I&/ߎ-gcd`@bBHWӲB>?h;^ H_KuN@}|gA$p"U$hM#HD֯ZMKH3{u0b9l/c]FL:lG̤q@ar~~akdg~ϳh}6a]ZJ'BF(Į:^4G. CG6aPԹ?8 Q|>֡V ~2ץ@[!7uc?\6oc" 8)Ks8|pc*u[a$s{td.uɌ%y3gY~Feh*"'e==`OZScA$DDc2 1Ju‰NKHN#Yߐ/k3KGŦ&mD7'ҟ nY2?fA]F}?!2G2Єyߎа|I# mI U.ε}ЦWBSЭw{f*DnP}(ZK5V̌tavEkٴ>;4M-OȈ'$ViJ- ׯ8zZ2ի岚AIU d/氾amPsKYa__` 2Ep%BK?}3˝UWɍߌ!UGD {r#Iy!cg60ciod[n ȇlZvPw 2\_2:$(߮v8t|$7Fy^5H{"'m\f 35oyV|D{\:h mFxQ+& ]o|O->xl l*yE$h]JxȀȠFt@~} Z'}RCƭ϶F0槩 |15p<2Z߶ݿO{?Px`vcF#̃UR6m!Ey=͡wnȐ^S z79dpS!QA"1[AkK~>Ei_3FM=xyx/De1v]54.2d$̒Y ^l8qȐm6CȠ;'/G~ j'j +V9t!;UODB,/8qR])Iv:n /T=2Y,)sao?_/:wS2u}qsx)z.t(8G,~mKnj5aQ:]n_v$#n_Sk/.r>PWU?R7/?Ob~u,p%?~my4ȴN{?wI߄%pfc/F.xwdzUn)_~_ޣ&Cn׾}A~=M&jw wq%l8bXl;=Tޞ9~YD8=՜kY}<4}OH]yKD/n&l8ڀcy;gq`^9ܥ|ex~lY(혵;|TqLSpOnLμgK>K/|F(:=G~m UvwN7~IF+esS:jDž.^ x2]/l1}cW7}[|R;>=ՖZ[|5/wt} {>wd}=y D9kZEeqhlJ?igdKOK5&0J4̌UadIgա[^`iꈥ쯴uot) 'cM痛׌y6kIzh5uLFYX2 %lx[sd dW6=$`_<albxƶn>ZZ ue5>2yskʅ={?yXķrQ RkWwxy8?)p^&yHEIaιZƤNetvRn}('k}uor:G7}>>53:Geӆ4=N* y3yr6հ?a-tw8aY/D9[67ߙsN ڏY{?7sCjO*owoV0/d&i2{VVRҲ#yh *p@^ ?2Myq_tv\6 *N1@D<ek_`he6Փ/ÚX_C=5>c791IXnz$b6C|9(@\ž{{$ʋQ~ la*cГ]O[jp|}J.PڀrG10NQ@_wch;OM쑀msSq~W} ?5U B;c+#Ky z.sg U]Gy0P}@ߞxWtɶ蠫q>SD9}@N vS=(/?ErzǠo c ycn=|r_R=y'wj/@c}|¶Yxsʇq>ǖ??z~Qw}/}\>\x򁝡?a8?\mߠ' ׁ~Kcsv\籎u:pÏUAO Syy7 W}q4w/Ğ/Ir$ʑA{HKH4Bi=ө$g{RIwHROs+<Oϳgl1dZ!{APDnuXB"j )tywH OIjϧ&!|Jɑ{Ӝ U0FqD0T]ID(?V'X3"{3Pyb=X[0d='^sQG{ AԞh+ Ls֟^Qoc$M(o r; cII"g7Dz=uJ7Pjyz0j' ^%.1$l)ID{'(D"t^èyd\N|NAjWpޣCt~=q7 s=Nh܊5Qh/tATL$$Ѹ7$At߃iIvK{cL-;9O .Ѹ{]`z q0'7M1qT 4O@&=z HB~yK4"Lq>vKād:=Oj=Qt'~ҸB'Om $T:4/p C!@QN?~s*{c"|꩒JpJJJ:/4n`4xz_H[N~kྠ2Z'i<ҼYLb_1C4˨:94:KhˤE5C`;~>;t dE*)Y9͋ԯi>(L:Oy4~G3ֽy4o!iϦẓ=!迌']HS"~,/YDXL1XGdA8.UDU`Ŵ)yƻ*gUtA02`)+ʨRj`e4oQBTʞ0L2UL/WA=4A\xI(%IC\_I室JW0Rt94_zW5rjp\F8M/uCo1;./ɴ}o2hDR}[gP`@SD+TBP{.q9ĭgTHgTh7=E4O:1gߨ^boSzh=[O uW=z:_4|@hy s]:j4OxWG uu4Q!'S;CvXO]O3u4UC~uCK5 >kxӵ4*fM:~yc X~U?"O Lop\Q"ϡl~)v+D柰[|WOCO0?[t=_?|4V/C~`;!ID`y?dc #;|f̎1gz|y2S>7+0}g!s E,dBʣc~H?q^_DVo(@GE¸z] <|Tm!O<^c<#'Џ!"!ݱ DwEL߉qyTFeb;#蘏}/ljP>ﲸCH~gy!8>P>c d_|=b-tG;b~&;ʍg4.h'xy|Gy?cSǏ/ymgiGdw<%mj<>ÎwN1>oj^3:3>c7=c[>|.QȮ8&gsL~\˞0(`|y~6'o_13gXb#O?d|Nօxu1X|CBV?,bAqY;=<=!3 ;(''X}x|M:CօM-DcM^OFY;??߃zn{NUꟅ'iOc^f[ ՏS]g'YIu/cǃ￨"v> @&f&qz^?5w4ag6?&^_!Bq3~a̓1׋Y=[X'P𾚺?#|ˏo4e œ|OxA~[];7IhQxM=>:/\_g~uyMub^'~qpLh=˓q=;\7?cMywq]+7q%3j.bli=><оxqH>OY~__zY<7b1_lEi"{Nxcz{Lp}+mj]:QcGh](}(돿c篓'F`QPNW4|l^~u}Oxl ߧǝ7xz?7&7 >&S`<#oQ&?x ̞<#>^=='w_8?si>"|}>썿O{d<}#C}6Ͼgxx#W i ~hO}Oߏϻ G1?yO<ϏC|2ȿ~@x8lQ) xL@9/bL.OU8|~>P/~쒗_1^$e]! '/"/?< yܯHSIq/>]W^?NChBƋ5a~ɋkg~'ģ8nؼ~9}$b;xGq$S!|y}rA;&I)k 턿oO)aI_Q 3&7ߎqQ|wh*Vڧ-O]Ӿi'~ ƣǏGQNQ\ūW>MO7yG}FvujB!E>Fy 0_q<"?6{ zJ|1Jϙ2$D7O{DX&8Y섷o(?᩾<ʫG&l9SS#o*~8GYꌼ}d<ʋp^Q~]ϓ('sF^zp@zŋϙG(yy/N|AiG{ȣM_7Gy((kB|hy6.:2OSyQsx?oB<{GQv.ģ8''uΟ/<Q^݉8~$7g!ж<*(:o 8TGEH PTXWSINS'~}'~}'~Pi&&ԉ7+ ZNjcnhb̎%4כƆH|O_ⷦʚo߬ǎZ75137ԩi G&xlv ;YAVq#f3_[ ?}HOH~9nmep>~=ѦM&?~w]3tC713(Mzc֛M,L55dyO_(|UW) _5N*<%WzBN4lc~>P@∢nfcͺdSSa47>-:[GImP/qT/Q]-s-Y}S-#=8\Dyӌ}~zCnƴZl&#Sm٭hji6jfބHk ?_ 7}~_9dMfW4б/Ҙl&O-7T> 42uO}{h4YB43CUFZ0ܬ?mhe)e6mAjU^h~_WGXQVYwwY^VNoσG>LںMBBVB˔?NY?@>}}N{ AӖԈ:#7FZ[U6 6mk!>/Sj1~ Z5@Mi^o=J>mHmPKtؖ44So,P}RiȊւO?nԿܞ.-t|: >2O}Y*E㙆ȾZf gtU؁6YCsU%9<0jxuw-Cs-SsMX>dԿ,ʡ(}X,ӏbVS?7fѐyY6- OjǞ_nwtbT>[?Q/? ȿ3A1U#-8U~ Ɵfeɪ(zBqZTKGOuڜEsz~,~=w2Q.?G?G?/P#NY Y=` R?;4Ƃ/4?w"pӿvx-O%'Gߥï~eć_a'>O?6Z2Mgjjlb4hLWCU+7*5q~L籟u6Ԥn Tm~—* 6\X;¤M&t~/1 c*++*վt(~OD!1wHam+_cZo ɆSJ'LlhQɍ7ElhؠX~r" [2b(ð+Þ 2p 2p$CYr *0P[rakkN<#!{e^[ q*T܅wJ ˢ]7&>Jգ R%s^w{~4.0c`k`H'pKF Ѳ7O#(Oz\sN>l;=?0яPJXu ;]VsI.SfiʍrsOP{ʍO9/qeS-v';õUmN;3h)q2SAʾCĞW-_O) =}|*e\a78հY%E”cOt׀"ju9+'4~ݶϝ0}vO|ӋɺX+F^~lWsv[6mHhVWrh8gܺKă֍#v~{Jm":W1SdÃՖ Q9'PmWjRQմZEH7B5zgզhn\#myo{.R*r84%g5n#,Wx@l]7+j"[ٜ;_xޢ Q9lMȹpbÍKgRG.ZM[u:;Yn^┯ͲP0*yVEm\W&ӬzNk?L쩱ڴno.K?PcIѧň\Z7%%ةzZr>qG hl/~r2Xiå/GvW/㑰;|UTL=~֋0}q\M.Z"–ݍ"ǂi\gr[ D \׫ǫo f[t:amz]5\!͙89z'7sC, U^4+FY<[Ap3Ԛ/|Ggg{ꠒjb7 >A䲻 h^ޗ4?x 9~s!pk\d}!Vgr:tuS.Vj/ܲ(m=w3VfiAܜQrVWJg8QX5ddrCAA_" afwbۈ[q/҅5 U][pJܻ +-n$6'WDŽ~;ōn7ȩߖSk#3I#mNEB*~aj {[;{[wQBg{^%ʝ2uXߖsqBUއܒ5,j_*-\%([tQ7B3赻G^/jZyr\oyGn}>7 o61Ef|v4I9Mm-j]^C]' ]34gJsdr7_d@EIȠ5Br6zܨCSj,d9nLU+1rj?y,Z%Yt↬ Qfc, v~ƆXn 7}H[@u6<"G6u3GYܮ| 89$U5DS`^2}O1'fUׯ\7\;c<%P~Od| ǖmǧNUmXx/*.pw}gl9+b͌n~];ޫB'«J40G*z>e|npwlI]pP*| +}$\9ק}mcqc:hC8߆=,vs#8r`6Y,aowI[Jؾhp>)*?^*R(sOƳc;npKrN16~g -| ܥP9iv8\Շ}^{闆qz:js[OǏ^%+)!ܫ@nDvX.PhmK3Mop:v"9Ui}pr4Ez8rX1ȯ)E\6zP&fNzЏqRo=_^xjUI=+,ҙ`ōnuH|nBov$s>{Hcu޻Gq:K?ғpXgFnff%f DS܀YO*>#m ƜZ_ aDʊbqڵlVE4T;wyPcزsqt,og^s0XcE\:ON|mZpbCs}GG$l~1\W4$¸{w<u;\nNu3Hť utsi\\n.FnpC׈[MnJ_Н\Ocov$}"N$:ܤzgp J7൮ȇ*3!KvF7U=puc{9E7uwf]W >&7\ri%1OͽW51-ošԝWqcQԉwka62$&43»O/G8^sn^6,Z{ƣ x|)"1 l]J{wŖOY0r!g[e-; LXn+[=?ڃÙ PNN+'\V)^qm܇IWޘ9Sucw'5>_'$qcBNqQ]͜XOgn"mgPrnB赎 "QQ?G'tp{7&r(t3jj3Y9W]Nݕh]#<&[u6|8!cܩp{hϖ{ iE}9 -d ޤۜF J[8k276O.pĩ[vշ-D3gpێMb坹EΗZ)&W;zSËOzKߖspȴS ?Wy\+Ծ٣TsfhK}އ% rj~e6'Rbߖs_޹ÿ:QxxPn|}iH=ڷt3ݲbG1T )ya:[Nu6gN ןO8JX?یٹtu/NoN5]G/U/!>jQ0Vn _U>v;pߟ0PaDrU,e|j׸oe8|gpLmg{O%q uF@`θa7$ys̯K>a!k!W{nq߾t"a#v%,і23M> պw^ %^ o<>J<ߪ} a G KvsQ0obHf3DWM%,2y[WkĝO:y ݝ{ՎVO@eϒK# ͯ]ϋzPBXbWy4庋_$,u?+#J *fշi ߜ/Iw'2Jh\2'm1ƤCiU.7ATǚ̓+V,xѓPY=1+Ix{V >8ѥVt3'GPy{ mk'[C(1l\9Y8ѽf?8V+$@մᚗ%CŨ =w","t$a:3;'=Pc3 ʓAϒYP:,ao'M[JŶPH' UCPzȤUThL|waɏUȩ'Xu`ձL1y-K@eWgXֶTtTG6J׫F|շfO9<۟閷 *{ԎOA~QPSUQd]c7Fh*QKW<0Ho#g?_mW7_=is$!#L0\V' ~s$LZ~ aU2Wz+춼% Xiכ0Ϫɢ_4WfBN ggf@p;q;D'O,{^Fy|W}OwDuj.aw?(s7 0[wѡ5o 里9BIJAr Wx^{A̡dJl0gy,n W_} kT<9ݴu28Bg2Mdc쳕6W4 k;zlDXްFlW0Ϋ:}k.ѹd> ~w _Fxmu0j~ k~85a {Gޢ}ߺCi#j2E[j]1f0jyO#gG@ͱpG'!L~Zu[[t+1 -֛ ?W90vˆ{>yqm.tq"l, jUK:F~$hU""?uS҈0dF ]q= o  Gt<ީBL4k3.Yvľ#X^r0J&`soؒ00av~AWFd\xO0fmZ ~CP%!n&{ C:UAx{W" q6omC Ik@:EV/Ok0Maa#J;*hE^>x8lUu}x@~)^?02|bS{:m!{ 9YcNxmqIנ_oS$7  z yӵAXkAfr}tN%,Y7 Qɷ[sxYRB[DG<*",R[~GZmt#vvɑ?KX4Z°Z;FLXtݧS\rZ7[ވ} ʧ,[3<;mJ/l0j93T|ݵ(aY^R)ң]UudOX*69ae>PYm٬G-uJINXuiEP?e耣P&󭡼ԃ܈I"ոv'A(rX:Uvs{YON(q '|JBqi}+ K_ aq_M"rZ,'Jy^NBKɜx+{Uڏ\[ ŝ[1#,{S6vC~NE^6>NNmW\(#}TI.?F^s+ 6'&6|>b(Ϯng蝅9*ӲkU3,oLXqPsY%: WT.JVNX+/9{P0Qw@HElk*/j {5TN}&TRÏ$8J ",Yt^¢+Q#K?toJX1m9a=\ e_%:Ve;׌9(?k g#J{u3jWޛZ _t',?%e/{DXqDo67iC7NʽUAy-"ѕ(KXaKTˮnݠsڈ"P1$q݉G=D=)r_Vۆ[{4w2av_vB˴G<+k!ע7Bq }/)Ǐ;j}g vуo D_.. iƧ;d^?a2RV #(9.rIX=9;kn0N/j+;m0'W, t՛C!_@T&JFWT'|:a* >*Fzˋ #DN~Q\U|ނ<ˆEγZFGxZTC0oEAIwJw-gP6&a8\ [̟ Qo"?ކ6_SZ G $,Pozf:a`uaK|ZhU=2UhEGv;r^p78 &na~a[NP402D5Ͽ"2%:p!x#7)&?i@&rGK?8y0C!"N|p[';t\m΃[mkѶٿe6L%fW/hMf YY¸*+{mK=P/nĖĝE\>a'GjDφ!۷3ӒY7|۱CzB㧫kC^m~3;ŭ>Vx4HPU n{ & 77>i)FԮYB^w9axMq̽>6N?~;X+A֤Q er<>aDnPa~} C>Z0x2A3G(x qB\tF<;fv' (y:^0ҩxGI>׎S!df{!EK yռ(ΗcEF% \УلQWhkK\xwkD[ $|DŽᓕ˟$N*a #!o+^ݔ/rG^U-WEf$tl|&-6zd:Vs< \={qD}ZDO+Ynw6烳f29)W#7]~F6$: x=Lp8']pKoӯ#t1IMsk̓u\zI_z7"QpfD݀"p$ 7 ' Ѯﻛ pZ^ݏU}H?p({#>,؟o@qо#ց$!-0f77|m.e O.]D](~KZ+NOX2bR8H,v>;ua3;K&xm$J)f 󪺭>> 5_GϜ/Dt}d0Bg> \ۄb6 r9L=]ms<ޕs/>PΫTmF jǂ;Cwu:ɭ2k.pWL\X/AufwU?\lsMf atlv'YV|8ljAAF]f~:t%8j}x?,b^0~l~n13Vq\нk Ǭޝ/m9Μ0,! Vhm-/*]7z쏩`2 Vok]_45qtǵSFtp .1{}]ʞ_CO6'to=s唲eQW_y WɃ^/[ 52 ʎg>]Bx>27}cVUZ'$ {an:=Ѻh<6H~I1҈-g?|"u,n o*mഅ ߲ 4[;a}LK!|%kN* cd--ja~O {¼{  ;/cIXV(r <5d#M 6e6gӒ|ߘniAh?dRǞjbչsV'`^\x:Bo>x=xPpB@Qv֟:~nDҚmZA;Y)GI•uFG/WAkAs=;lk(ӱiQ?&^z*i&. L3w״͐t`6BHf Sn/h&a2RH)jSb'c>ϕ<4bKV>'y:Enp1!B殸]|_%tg3ǍoYf"a#?sanR0t( 8#j~tg #jm8eJu|;Gƍmo,naڜ TO) bP!K}K!8ka'5bJ䷍ r0!1lCv 9)!]!c({AUڡ! @ #TWc=@=% ħGxBӄCt8"L0r!r5nV-VUj?(o>RQE!dn !oƙCNH^O*!*Bȗ7+!ls-xyGX;FLV% ~u,ˆw7LR^IN" ~&qɇY~kǞVUP5!q{v{!x GbX6p^ja5p'ݦ!Oa~iS5_l'cu€TS!%ل~ '~Rzz]Lp՗Ы`]GڹɋnT}!2=ytmCfE7 õ{=vA/v-a.:!tۃ!D~^SJm$ PrC2r9Bfԍ ӹS^B_9[m-LT'}~BHm'ߤ?/s:Ck3#’ =ޝ05q ;rAv,o-pJ&Gz);U-a!ҙ!h59'!pQO^yto){P^SXWݜ\l/Ƥro nʉ}+nQ{ݴC-?|d{Iյ |n}̤eJ_t}il?NN&ۋWxg]tۼcħ G_3]׶6ٞ?:`&vkt{-jG yThJ˿>K ܧbΞkM*ˣn!m"˪O_Ɲڡ.S: Mۄ\̰ sa[=u9{;xqb|sSr Kϛ_0ޅYVYUxx@&ۋv?ҹe/w|?/g<4?sE9acaj*M;oWXNefII~>5riMi_1#F -o9/1j'M{lMy[4 ީ lZoOj/y\97ۖsIdkj+t^^ap"i~HH̛4,xZz@yS7ijǻ˸u=˚s ;?sxUX.wJS< ""y$qdu,~Fz"'>zWk a˔ӡHBXzg(|s5¡9=m%]̚6]Ilk_v.тIon(^(sNBX:|[P*TG\⺮\|_$z= {$]\;GrM20>P$2 j\'2+aZ!r}{K!3@| |KܔqS'-LjҎMu4O~S;CUY;ZL+Dsxu]g!̘RjP4}QLP>³  ƙ[.Ґ5ew ]3w[n Y;GB~dqӔo1߳񱮯2QZ_r1¯$f=J*^-=7-qqu YAҾ}Xka2ldq a15BQaBm-Ap]+ k[˷\2%>c[(|'޷xLw#CWgBc tÐUv g×qbZ =qfNP2‷5(oi% lt#oaOm"n:9~ !FZiJlYnśs窪xM:eJ.`l}z>uf<.i6tzh)?8\*M6=ۂý/(G:'Umen=7¶:oo@z@T!@ |,HJfGj_b`sH|#rpninv7}'AԎ&Z)mHpZqv0A2z؃key1ӫAL(jG|z(g=OC}NޏK Nvlʞ~t;ޱP7}?XL4A\ry^;xjOPQoNSݭT&|̓AsGdM`\-Τ 8/l|}d` Iw#W"Z,G g>f)4 7JQ7 e4;DZqqcE-فOɲUǫA0Af4̾p_5\ޭ>j_A§Ep<<<Q΄xԓнY~g(;|f'|kԎro`bۇ Hvv nsLn3T/нF!A/,Za>b݋#q:#?[ &؃sz[ʋ%g?%p#Gf@[ z7}!ݿðO'^gͅOVJ!м3CegӀT} 8+;G_88t^^u_ߟͻx%G|}|7{iJ=|VALnv >Cg`Cɭ "Mr>=Bpk֖=ݢ?F{(Y}+ՠCHߐ]:8޶#8?Sxpa\~QП}`]G?:miއh^O/^7h<߭{Wt4<]҂N1GIwL7J=ma?o}Q"}-׮ a!`'`cp0A$av 501p}2zhgO,plx)xMbW&Q4 1zsᕛt0f68>īG_I~w; y󊏌_QOq0n@ɮ>U[nH<6;Ⰻ LQ_Q1/B6]S pѾ0~1{$\M= x6~0w'CÀ5͵)>b纫ayhO;'jr {:Tr;794K6^ȃo~0GS+[ ՛鉋v'̨^'SʛMq;ާނ<S.G w'1OC~${evO7wu7]&8nxP|LgˏLOܦsl CtYE^I=:N)NY9hO4ެ? 1 '?g<#6v= 7/K<0Ls!qp;, [] gG1~g~9џF8i R'z̗_aE-L]҅dwc{$X|7 ?q$3^BIfB o&1~L?>| D W᪟:&Mj3&iA˧Ø1`[!ċ۹n6SR>9~L߱?EkX)Gn,Ÿ _i'00%̟1fXz롺 5޻~N@V>gΐ b8Tg(ICXirMܨA;`|' ֵYVgb!GW>&6\N|YnT4O0?Bѳ~΂wz>>Ï'?~Ju?g'iP)Wp ֺэd/ ԫ6QD0?Kd5TWA%z wϓMr&6gt*Yuv"!diR.q4c>,\8 ꫥ!?b^b?58N&2hz7Ͷ`3#{Vz2x=~81LO'#Y>IԃhƇģ}@xT7Je2?|oG(uxQIQIhR}ɁGP{q̲Wu9qLX0D;î6a QlI~k-Hy91c ka!6Tf&#X'>euj>j[| ?{n|Gb=y$v[{ g o1~b~2#M}uD%Qtb8vp^1j\Uuxũ~WݪE߀``;9E糑,/AA{b|?@lޅ3cX>K:\)_s% 歟U}D21wOțX|Y+Sl#4<셯NSЏ _2>@{ź=-m~kKwG=%1~L8=Me%Uux2}Ig]VOc;oy̯Ĥ͞ rXk_!l64;l*Sl3gq`!=G9s~eex?Ź9O,BNĤͺ&x8}3SY~'-)VQGS!Jd1c}b~4i糘e~ +~9P??Ubyks?3#sh~NV?}:K:'Qo1â=y![<qLx~bl _wnvDzN14KaRZovۢ!GY永$aZAOwqSOCDI2WM5ʓ?y¸8= <]VY<Þ3{Ib k_cX<x4@e}* L&G)+UË ?UO. \{'?Hc '݊7geC.ϒƒLO‘gY^{/"^HטG2?!Q0i 7 C }02f18WSCF>͂;>KJ<ƥi,LcjHWa0mӺzOd$ŋ9^&O0~eq^vw^avbz6زCKҙ}d"t^x7^30= g/gs|TZz f(1Qӧ.a (6QLX&#[C{3>3bןu*2}'훣 #^գzB™1<3C~q ٮ !~Րzv_5jm7Hr'd0 &wm"T=OɎ=ny} 2^;xaU x h b9=VŲ&3x&8NJUJ>Oztfi4Ǡ2<1t[xfyB6eV/]!Ճ3ΐ 7LdhALM7 o1b|L092/տYih -)y$S-HvyrxEm߇ZϢsGx0=c8t wiNGCn}@9}BD!1>.buNb'iB!Mv_ YXXݒGGr0Ec|W"E=Z{eQI~fE~VZdDYv,by|~|ͷBk_G8^>a_?=L`~8懰upʇ PGR}}c9VOQ!Z)vj¨f!FT͌|&6|h=aq+%Ɠ8ٌ_s*N+)R<"F?~W I>3+웯ji;;c=akG|]}Wl9|ʀ4tMq`& w?f7LsVc[yueqA><$M>|l~ ~33Er+*c{]2~+duV!{6[ 5pų/$&Qf,3|UZȳ %V%Br4fϞ0{yƼ7 Wjw3D.IJ<6s?'b~.CuzyEﲺM?Oˏps"v\Ef(6?Vi ^Y3{cvJ37٬?|3?|ubW#|kflSǂlvyv,Meyj&Cܘ?ʶ=_so?,zXt:ODC~3Nv t-lLa}<ɇ?#6D0> gƸ1_ $6KbywNq D9QaJ1=x+L NZ9OϜ(R0_Ozn Yz1JOW )dy&Yia}&tfϘO'?~r3 % :W e)(@uX1a`y+X\Kx@}a4~; ȟdW,*b9Hgq']LXOk=$&G\|}4 mQBvqB>'>Y܇7=y G{{` ס`Bv^P }9=:5'S|n7dGY^uV):zƞxʻ1ļKf7/6*8GY;Ƒ0( "Lz8z? zx{~r3;zVZ]m7~{O9>pzz?Bq@,/'=<7dionL/i}{z1>w/t9I#=e { :\GCx0`=]'˺k ?PNZGV^׿>K,ޤrq8M>ܯ[~C\Gl;u~<οm}C@'#{] tch{"YY}4\c;)FwoIO[_^l4gѺ>7h'n-ۿ-gi5ҸoOȣ_\Oq')/ox@a0Fe<xޫ%|H:KOlaL ^ \Փ,藐'Q~\?r:'wO a}@G\o<-9i{bCpoboL1O+9~T^S Cu3W{('(%ƧNnCH`'*v ;i7;v>}JD\ﻺ kI?yrҺ6׸1++icq?<q /W!NOq{uPh=*Nr`+?S?G'U 5=j\w@ƙZد/'q'Sz&f:7S¾zzIb ]PGW#|!8$ɸ>l=:K%\gN뺑G6 lz;~O1{8k1Dpo3\ۢZ3Gq_"|>S \D=ֽ0縞㢃J3~ףbUOWnwn#|=?&jؼ2vEpڇϣqxx4gKmȟkվt !c:i_L?ȏc^^ڋ"?ԣ}3deu/?#o ^~.@S֬j}+GN^G=%DWx?kaαǝeGQ^ :6]zi^>JܑG3}02N8|QѾywy}X گQ}W!z,rl Y0yB$e<Ɵ b{xx3s w|h?Q/1xǗ\q<紻{a \T=Gr,Q}>8+z.GQ7$q==ev~'/y=grް 1p."=Bu'Q`^_O|>BqPs^?Grq<`Զq}+w?GcPyt!:>G; fq:?ː@8ȣ/gw^{ {xV1}jqV%`݁W#TguG ڧ':5<%?͞o}1楨_sa:%#vpHlYrGqY7ɉ.λ2-33)AFy=[Mkri_YύɅţ,x;O',ú%~*S\~"?1hd'_vm9L=g(Xú/{~D0x_H'RQ"/i[L^uI(_8/2b:ţ ɏ8#/oxutKGߦ|Ǻ9#yڇ,2ml|}φP< )c1}k]qUQ߄x ף=Ӿx=C}ds&z?qK_oȌzƼ3zƣXQ $LO2QQ;LG' 4+җţϠ|XǛQ6>=>D}4H?q-p2fWXw L>SbvO'ȣX'}}V|s:ʒyGC|#s6{a^e?/Qbo;ȣO׫&nmZy"(v?a47Ho&")VZƺJr J>3>3>7gD >H >슖ӷc =&xx;bb q!~kz|S3sSNzfj\pdk`jdQ ?2ol6. \Wt XFzZ '~mdb|gx׵iWG}>Yb͘Vm2Bddj-MC#-3[̛0 }-sAq+@a>Q4g, :VESٟiE'fZfNBi}s}b-&PffjHk Ͷl2lܦ-hBkm/uK#+*.?6)-Cy0c>>14qzZ[7ZXjYhR)5Si/PwUa;hxڒ^GU~d_]0U575(\kfCa;fMU-d>>e #6W =Ư[K^&I ދcG >> y.?0۲&bj㭟Z > YZi#Ӎ۳ޥOGGF}s}b0K3372S%h(fbe׿JqOcba:U9Y%vR`<_?N+OjNWNܯگgX9Ghw%S*c)!+XYtZ?_s'W4?wXӿvxN_uxNϷ%I8dhOUï~u+G?i?FKLMUMLf{Mb*U%f]}U&Ώi<3Ɵԍف*-ORyԆ ocADp?ݖO:FV^YAaXee9yqc^ڗO}~o($)? s%k \`CZ pJt 7* /ߥT'°%C)2 2ɰ/ 2p( G2e(P1 *-o9MNƣu5(^6nuz(P:K8}" h[kR_(ʙ+/ EǗ{BnvC{֚ >tSu~<JUGɎRYc5Hβ=NAXأ@(*]J_:$= ,̛<3V(f杉P:w儅sVCy- ӔnɄ wr8 vkͼҡ$Rb.Bfw} e=j,Br֥צݗ#zYi-|}i7|'5GSaEH֍K"tGI:*wprŻCyؖP驖ieuPzX(P7v('שٗ \Pyg)F݌;oūKZk;;Jx]"%mfz/im,nTj"YS=q-;=PւkSd24KwN~*iˋAEш)kWHA: Ptʩc^̳q/~!N̈́c~r]ܘҡ͠BoxPR-N#9¯ZZX _)=?L;twšy7I7= 5ډgVW||@Sw,IMuVY*tޭOm,0jk,TI%9?WY;V7;ʸŅJ~U+eMqʣ:~#n@T ozgBe'&,3IIZS4ʶ(ocʭTȌg6u9jΥǟr}ځ#&fa*P[5^ >m T\}F`2 F(r> jmW²[g:_ȄM/2@m *˄xhZ|m8!-{0ESu.ⓟ:AK^u E_qe*.? +nLFX{8'(h2v;Fa4aWt1v+3/CZ0uw( -(J|bd(ڱY$g+W? ,m0IBcWNXT~蜊&-y:6HٙH}嘮x?w{pnpΖP4j_@ٍ{߇yLo.?I3|/P4qbն̂=BWVm6sN޽j<OXݹًPQ}[P3͂ÄW@쨗Cՠ1Q߂/;˝~g95hrɩyFsu7Ss95_w=OV\{3r~2&}{qNY~,;Iڽq0A'Nj˔qVՙ\'–q;F혬׳}4Pj/bfC>~NVwrz TUܻ q74@Xqً-ȷWa{J'\vҌ4uu B[AbۅkbDjH'<0OsVD(:|y u,73O!"OO͑oxi&9>W|߱|^]?P{9kAIWNNQr9cNjw)_;Gߩ˻6#T{P{i_C; +w ԌJ>m9u?R=qMBɵt{u; ͦ K&XT?;͵a{eHkuǵHaaO=Ont;:Qlc\FaTvRPsCZt1YwTٞW#_]*`=}Npn[I 7;Z3|{/jrqtz#aPo!gGJK+"rR: J YJn>qۓs xPxU[xŌΉ8\xxCr#|pŃBd_-ʵm4|Go>Am17^*g|]o.+_,U:|Z"ǽlsC/:u,+p|'qzÐ% olfݻ*17ݎ΂Z.n2|^n׍&cߑ5mfIIڄ 9q{/#I b;Bk$gqUs'r@] 2#n"R9p⯏lsh}VgjI/o,ISC!SZV;bAw3-[=* xߘagC9Oo{1$z؇gK?Stcv1 1OL\^0Cv֏_'?) 'Woof~ yn?ܧ>6WK+@FJE3cgfj[\25Y҃6Hڢ"-JQ 7׈GF VܵiM#z P|#$}6aoT)$b1K=Q8r-ᢝe:*G%}?YXyÍuS8rm|0x3pwY,ge:R0(R;vNUk?+!DykL㦧d=?Aeaҝ9]kt^fMs೷?oIq U jOv|dH{ aNۯk@ fC^DB i_!qvBِ8{g]P 5Tw=Qyˍj@ 3||m͝0s邮>~1|]}j'Zu- }$s3Z-ON"CUO՝^[u*}Q&\kǐ+ސjVMmc\j+ #^! ])iq;a͘!q~ķpZiÝ,"1_#[nպg='[9KS`೐~6`A¿j< k ~O-I /V2 +DpY%]@DA{&m9K'&~ : tNF kF퍀 K2v }T&I,,<1{*73yD𽧒뢅"ϡhoA%6;JXlAd7MXڙ 1#K[29>J8tRIAiזּnRoAgZAS@Q٠PF%'>&aiK-YcFX.NOa;',.zkxK=?]x/2[!g+&Mp $rL0 w>g?=&uPJX~ü|My#ZGŠ D&.",_ u2a%QHXko2!z0ŠOJϤ[Byj }yBOӱ7nj~+/GX3>á>?/[ZrT%*2Dq2KmU[~7ĿPDN [εjfMuP^%j۾1}UӫLr}7;Zln ڇ\{-ae#RtZ'nMXP5,=da^}A御זoʬ7']S"7CЇ㗫gͻ?߈7l_ԟfv\ȳF{T6rk8}ڈ6◳=-G@MOkZCNĥ~rV=ȓ)uxnnqXUe67'=^# / ,$]o WS7͉a};>,|o&m =+5캿mx_).R' zhoCtٛ1.G :vO'Qwr'?ֶ|€4oDnMuͨ=6f9'9z=^Da&ń'E&n:i;a ~Zn*1N$nTL"L^3]"f!aL愔X;lЯv.c yWp5x$;jO >dUuC g*>$tWrYDm^}r ~*o9;}-jc{Xw t!~)_~Vjjو}5buބ9nG~8zC3Agz{EKmzw&CfCpG{85 Nm sg;z=5M% =->HHzj>^+]gWwL{WISbot p=pO*-EϺԥ8倸B;MzOt~/׳ݶAަfN',j'c^*8@X&mZ7¶a~ֶub6ay%0hɥӂG.4)LˈCf/ Cٳi_w8?JUoDوˇm$RC\'}.au˷gΩEXVQaE|fx[e|;e~\=QSiDXKDȵ_>H^jw*g"?5l$lQ¯[N:ȉrG/D __[{Ⱦ j0?TOR*ݾѵ/4 . "&u+ʈOev)VpU׈~W`8PʒNUO:gl{u#tM|VB63 t{eUk~/~9 L2>R)a˰eRJW(NY|S~ƊiDvO&mwћ3zmhӇbϫgjKƻs3JO 1Ү&Q=N068;$Ya򹕧B*zhv}aD:kcMrm*d3no0>͵ sv- K3c*f8xk}"xwy5BB!^Mt蘳&[UL~8^$G!{?űww־3$Ls| Mʲȥ׺ۂ6] |*% nqQXX [46Pc1=v*{51$"`i KQ *v+]wV 4W3Lhb/9^Gh 2voR/&ke~Tv1㍰A"1wu c6r&{\0Ơ?f E 琉>?>z]~w|_i"7w/yƾ}S?)`s+f[>tIBoѵ_֯zŸY=mU<Ε OO5qS ',`chw@[j\hzM.Ls../m3q]xᴵB3G'WVr`<3cUIzpÂ1zO1LFxkkzWxdqsYGOMqz:'ՎsnXq8ִUa"p2uzV2(Ao8yxc/vYsׅm7m qQOc0a; ʊ0?MvMuz[lkr. {}Tt1֜(jcS)d]AEc~Ō˽1s֤LּczTAFVD&WmV?6P$ix:ѭ"|QȚM}^bTZT1fUG2F ;"1&jK> cN7g݁/""?VDO1 \f%"&n8c-?צyCYUR5]3>IwcbK1&ؓwDvvz=c^̘۵j17jݏ~&F;XFW52i;H C7a<;ϛW3rK޽EM]np`\`tU4 Su0 CN\pU}߫8>"ٴm٢w-etR~;Φwݓ攁Q1pÝgeyqg_Neܫ%TO-N/*mZ\O,Ŕϫ>yt}&<.e>㖺 ]-^2WWŜF :x`!}ezctgJ~VHDտw9k"jV˴m"хc+{-x;|8CGİ.CĘlwTk:}ɘ8ag./y_zcj)kX͛] ,.*=f:\TfΌ,50~7G-]Ng X>+F'lOe Z(>at)Y[O 4!lj6sɍ$qW̎7ͩđ˙V2q{*1&FւQmi?}c ;]c ˿c-WUyBݴlJ7g7JͅbNCb FoZZhϨlqՏ :]aT7_=jSDqM q zV-55BfB3 &3Ku$+ncpʵzUզ[Ԋ1 Z2{ _T?Kqm|ZAFv'y-u}&AnW}?=-n"X{8chګ3o9hhccKqਢ8FͻB3wZ<AV[ga N$B#|*L.^VšS+vB=ݎ"Ga8~ cboC?a~s8cL<ܕ1]]1Z9]_gjĈE!įf"\"ճz=ԥF;mO۵IzU1cT =_2B挪[.ek\U u m~Yn~m:rnsf-xȽwބ 1/kQ;l3r|BFߞZw0l]^#e;wuİ[FXܙQyeQzkCwGof!4łsBJq^&{5Wv10n.e \٢[֎Se cq׺˒Og tFw5̨ڛYFu}WnZ̪XϿP|N4ɶ>BW{EZ@uveT >Gwc3gTYtvovT7ֶ*b =u,w#K+~u>&xhJg׬;¨jxn+? f|1c`̜kS` `jv)wk!B}t_Bf=/۶/YN[%4-:Z1i+w5aTi}[Uowmͨ>5D5CCfճw nxd FM#ڗz{ZFh>S/'9nuߕJ( 6 ܾiv{xo_wżw4Ry-6_7|1.xMB*ޫݫ-&ģ<1~rY3ӍO:ohV*{"Όs>rԜ3}hТY[zq9gq^XAQ_ɷm?lTq}"͜}PsYsKgLvisǑnׯ=gǹt@qߣ׻Ggj>l8O (Kb5oht!e^9 gU;'NW|0>2Z~cq[>u}/9*ݮw8|pr׃2nS]mA19"2k_=w`ƿ#NtꚃFCuJ\[T"-.wqU7u~ZUZf~fxaQZ^ff{Qb;ӕ4V6HS72rhGGn=zI|ע(z~b=mMExG1Q6C &c6z`w֧iՊ;*/n,?$W]}coM>HCG~YxXG(vó[E Viеԥ9;̶x-%WlWxĉvsEƉS)iG71[S9%i-xx]W}sxRc PnXǹv(^\>.H_:cmS=B0bS~$0iIxBpCŕ\/|8qS՝S]<wM{->)O>>'[=Ug9(\[=WZ~=ӣDCW8x|tO8 vG7$'E0B]QxCNCA^;|W^3a="9ޠ_%wy#r׎z0hF\zH??ꡍ^%,/ṭ!zv&>_W)Sk¿=Mk8ߢy ҃?wȉ$9GIO?쎸= ) '>yF뫔$ᵥ/rh7RSv!;|ooј{TD ?eH@"}A("hцό"K}贈(1-J1|PDѸE|,ؒD'T+^/aT]"#E ?d6DLSĐqKDxD^O87P6]lV{5ڣ;%%ɮh~4[^5K7,qFBM]#^''=7%ӐQߨN*m?~ɮb5گDG%|_Cr|hzG>f0_Qj"/&w$T"$Z!E r4*&`g9?KN_M=F__^D(e?x;RTD "jV/q;C.)G| )q'7;qw:츈5Wf5W3yoa"RṂķ "OAoц0@T?P!ATπTQ`OL oBg%GInc%C~{ȥw% [E6Mٔ^C#̢M̦qgSA\[.\,3\RҸf>rΞo<:;7\F?DV/DG" ωd$C|.{S99,w}C\{Gu{ +#?Ss]7ÄE!'C]r]iq=;3ȗ~:{&$^ˤzg )$_ t^ɟEMk }'x/a&ə"pG{=;}/ާyڡ$T{գi x/x3MMp|PKqAA%;Q=OqGCupEyTOfeSܧQ^ˤ5"EJA$g&]}?IiįiO!\ZT+Ox+Qodw/" |E^YT'3SoTȺsL"qz 28 )gṢ+琏o9N;=wnσhܙ;#J2P`"oްxhFBTX!b~P? 9hIw<#C]r8zDzG8?t #3(^IT%Qwx!Q;#kR Q7O;&Nx҆۹_B%r(>ZZё)kGudGnvy[4<1xK6O4O#(8;ˈKIdϧxu=<+G:Cu\O{[4^I/w)daˠg,Z?Ȣ ?d>~%yɯiGR<"{Rށ}귔G>~^KO:ė9ϊZ\?8;*(<*4?j)^t'2jp9n=[Y4/dDt]@s!^OZʏ_؍?H_#=KN /~y:L:4ʣ7niOTny(+}T!os%^*Kr>!XO|O8<:+2y^?:87^72/#c~y{xd:_~) ^i诀ƣz6ċ's3|xF ?`} =ˈx3GA7Yo# !87߀h~+_緲oTCnz;eQ}vY){>/3C FInw/0W'Ov O\/o ;!&>C~Rzy,C^E.uZD=x~o(Gk2OBo$O!Ϳ`O^w54Oz ~"cG*|q:QOP_S}OR]/; w?zבW\GoI>C h]/ygdG~N`иrRryxģ|~z?և/_?OQ_I6i?|naOyѺUC|~B~/)G8SR,+CNǐ ;>@x}s@\Cȋ?}9Sއǰ|b?~]x5N3g<'f<'u"!>Qb<̣8E:H|!?.ȍ׈K?yBǼ9[4>^E. uTp^Λ168֣K$yJ7x^$Eކ8/KPOR`y%ϡ zλRF+xT'ȋxyC3"Q.DŽ>ür?Qb2K\z^Wxrbe2_X y,(xYSG|4溝/C?8yuu<<%͟OD o_dP!yy=BQOUR='o.Kߓ | uz%7=2BWi"J;dܼR KRy^%Xה|Τy ;뿈#œxIO>y^;ݘ1>xT>OƺVtky~vρsXzR:yЧoN^#x8s>4r92ar_uXȅ<序WH/zRya8Owy=L+2 &|r<>IF|*w+/.qY8{IJ^?Jq|ϑ+)MoR29Q7)~ϓߒIϷu#ٿY:xa^a=K^U-3\8s7ǿ@uyz)G̣%(ƋGr;ZQ7I~dϑm}r\HI^F\qGzh^'8sR}y^Qw9.OzQn߃Hr]y_xN}]QsI<ϓx㍏7>x Keߙ`?q"{8qY<9tUߢemKW.OF8,с{PPAGL*շSxp]RrXڼtߚMΒ^^t|=oUln|oT-yf9W{ $=W?Uf g(={y3WJnkxu'Hxr[vh/ꤼUTS]OY)R>MnUS~ߨ0s/:}xË.^X~xaEWh^f1o7pP.%eݻWD5}ܫܫ 2k޾[;:̳3y\k<"1robustbase/inst/doc/asymptotic.max.bias.Rdata0000644000176200001440000000774112321016053021021 0ustar liggesusersYgPYDN # ,"A" ( (QE@@$(A$䜾YUU֭9oszJ~~D!QF4 D&H|+{m+ /m^ 2NÇ^uU$h27 7_(/}WטOw/S:kyF6MomȃFFqзKY:|-η K qT e8`i!67X"8 Å7#'$NèښC09ʮ0vuӳ [ zh0%5]&=3̼z?VLM2ba:lqzޡ k^|;\3}-F![? W~Cq{޺KHŏIHJPS\]#-TW2R;},ròkdۜ}\;'6ﷵ,,[E3_V mNNiѐPWxqA(CC}&d0P(!kI- ; ˚ڳP⾐{(}]Y4߭ǐ(庚W&41"uh7(fטPNy|EΞ#.T;%Aʒ (a#U%/0<~O!SAѥ2 Wts`Ȓ87|pAm=J,Fe(&ed\olsa&.,+_^܊GQ',T8sN)h: [Dr:>h\V: ;Q)2!,3+gmu7Gur2wq"#4 B%h:K҅~Lb}-;~]҂ E |q2Kׁn8Gx9Xze}fk~%tB.׃0ڻ>_=h7'Ð=J90| VfpO%F/O7R-]:wƜ zBꖿ"`i 2LH${F!0ҿ2VxsSaZxD56Vm0YaL>0(}`ywOS-!IjgЪb$&I_CFG~:XR^Mބ+A2g!bE/W2BM4f![v#WӇhi1zw{>]*3<'lF^.{SbSgťI _I;UG5wunO@jܢ(hGt6 m 3C4Ki=Y6w>(@K>i ڊzH0pP4 xJU_سy/ma(߳ {0\z4xIV#nFԴ8 jjmP&iW800!}vL菞]m-;;7錥]U0z|SY;J7J0=2۪ 33z_`VS9̎Wk~/~ Ny,=HQy$3$$$Amjl^?n[*KVǢ)YXHU4-a4S(V KCҺ\GEgj6ܖ=R w[N"OL빆%[  FIG6*#?.p{-7oTZEA@ύv(ظ%v D{;D2}QDTyHMGBaﭽ-a[Q(LpCl^0JnRFAU=(+"^p :B9ٶ"w|6i-lmcg,!KХ6h6 >ȵC43K^U,_ӋsmqcV*'+̮J S0myFX-t6߷>M/Է z^?qRT `t`>HgwU'2[V% qA< 6\jCd~Zl ( ˆȶM\ 0|cwI Èî$ak6k+ lpZ"=Bi0ҝƆ^ fRTJ'+|\!ʢ)^G/{>FJ”1LU^5=i-e0CAv%D e,kY͉V_&亝0wok0l" {*v"i[mg߶!i<-GVwWJ#9qBvRX#6#匃u;~Mc>R(EjviM/=L>Qiw͵%9.YGnk;Ϥ@y4YqybWSuoF<>ړ1o ȜytK4 -FA. MR57:*/CGn;"_<҆tE§:H*RlQA5H:\Wb-U{Li>2.~Dqi'(iW:*S(IJU$#SZdEIR{Bm_3FFKUU.T)CĴ^I%u#M 9%N=O(UԩCœ̡ o6Ҫ1im\pln)T|%B%7c*r_e4쿶ܹmO:c?f.?=<.cǭ=m{7w/kxq>rdHğj$󘚏> Y1AYpj| n㷍z )AG(tk;~T==R iRdH#>X _D,ti7xF{R#4C67G7 G<"xL:^ۗD^ x^?=z( ,8n | -^PH]QLs?𚨣X|V8Og,z%D]%m!ADd!|:H򳵄2޲_-Qs%7D\FġGrͳ~9>TT݉׀*-"[&Y2}@5[us1# !!8GWʒZZSu@-kmPK[7J'5:xڛX"nLA=Џh~p~p~_e? "܏9;|n?u~:U'{ )-robustbase/inst/doc/psi_functions.pdf0000644000176200001440000113466013465050200017531 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4597 /Filter /FlateDecode /N 96 /First 799 >> stream x\[s8~_鮮ATWv\\l'Nvd9-KnJe~ $dlnmA<sL0%J1Ʉ GYƤ̙f*3<n\0z? %1~ *k sęKD,?S&2q_1鹌4M̈́Ԋ%9Y1K9 Ҕ*',r#J<ĤzL1?"grLǩQSji΁D8JKTNus75ˆQps%z.y)4:)`ˌ8KP/PeS)UB@9-Ee8g4KRa./Qe K* z2PV Zr\eb"3PVhUQe㘡XJX&Z68ƫ9Lg a Y (g::+S`05(k!>)1rM0@cGΩ@،shP,bɅr1)rb? opړQ2anHX.ngWܩᢜMrI&ecHZ$o=s:(݂vU~8Y5ڃ!x9*@);QU/Xǯ}O-/ʻa W j yXu ; e1v :砥-G `)U! [n=2їϿ 8h6.7k^<VMb@WMڢ:y *]lkxqKdj}1}>**c:tRaI M2i Ԯf\E|*L Bq(on)I%zEY4QTDu!2-QMi4"ZF~5`h> 'Û9q 8}E;.'bSwE"锣H !(sL,]\9_wMK=Pm<?)1P3CUt `>Dab.k#373PzU9Gh^ VEa|Z=[D9NiXt[/S+J}!kG7o>žt6H-}{#>&P]ZW$KDp֊<^UP ǯ@HJS.bJT] 3iy\+9 w5INf5=)kʸU[0Uh/Ʃݫb> hgֿ+@' ß=-dR2tޕ }2YZet3HŮ!&ЫPQSbx1^(tb'mtuwGAnhE|Py[r=ah:Txe ҂Vq.yε=fX!-MN hv!ZsuGu3D:Olt7zBc5khk&2/sxاF;g<>EB([͇1,z2Nȴ1Xr8!Aedt;I0.-Q>ȴjJMtrlQ&;u{_]i?/?VNΊ}#EAE;ؤ1qw)4B3$3^/f4n)y*)گд6_i["dfOqk?G ct2H9xV=[ŰNϸmLUllz^> 0+uͳsi uܡTQ-ͽ$.?[ۗk%a 9^Kd>$6(~K(&Lȕ%]R&R֐_̞ݜz| mafV BJJ8nOi\WM7;!*{\|zz5V̍ۼmŜq_([9!Ⱥnx.RR^?-Hw:U5njXסX9&;2oI1ΑC9.qrt=uU#`o,[q]?Rp5'+ͺ*],on߳jz!8ӧW2km̻nWCޒ3@&܊!Fo> 4_`@Ays> ]9^,EqS 'r~?\ >jxª9j et3[oN>_龋wpozbHJ[MbרN_nze`֡ܖ+3K92[W='Y]QN݅)lYw )•)CʚޝeLp"Kݳ;S,=KUg=+)sv//^VѦhZO"}Gg졯R{kֻKíW۹7$ )7Z;7p^fDv]wʺzդΠ^2 .w%ͷb$diMM0q8 tvWF7T_͞%_S~ܼ dCoH-|cZy =q;s<\-S.b /2]K`Ш9:?>ܘuҳI[NqR#Y\wu]ݣ-0M@st>0|썹 6n9Ud3-Խ?fjN96jkc7rޭe1&|wmr:|G)EbDL u,\ZY1kOjoi:{g@mwtǍ|Wz_2Nʨ,Ge5Z⧌gɰꮸ] lX.UQ˛~REj0I8٣УIb{އpiZyHkS1/>|U1V,O͸=v' Bd6|w͈I3/f3F ڞYD>mi<敿+o1'rITs{R3jmZ9yw5~Zӷf#Msizߖ3 SYh]Bϭv|y387}C\pɆI%:CnU 85g> L{譔 @;D:f[utV{"K^ܞD쵽zҚ`gUvf,Dޱ3sW&T!Mh/xNI` &bՕN\ ue߅Rendstream endobj 98 0 obj << /Subtype /XML /Type /Metadata /Length 1557 >> stream GPL Ghostscript 9.26 2019-05-09T18:08:32+02:00 2019-05-09T18:08:32+02:00 LaTeX with hyperref package endstream endobj 99 0 obj << /Filter /FlateDecode /Length 5487 >> stream x\KGrɇ.>Ž{. ct} ԒpE/2*#g(.abMVfddLn.nF7CQn<˟ʍCpn<{{F8 j iڇn9bt_!س˳bitfBxfPFE_f4P 2D F}X):턉X9F3ekHݠ~^-}c|dk+ m 19N1De#2s2s3CVaϙRnL`S?]^=H1#]F `v{ 3 GeJsz .lɉf{ޝ=)=mRH%VQ}+Ffz{Ao.<Ҋx! XPkd4`^C0d0"l(ggccM+䷴zFAPAL(|@"o#Dt8ܲO 2s X-fe $# ˥P= [ n.&-x+czpV"tFi,FcQvE).[[jﳬӵ[xUᒒ/EZFkEf&"WA¹01 ̬ #^&*؀;&$6> >vA ɆI#C}K:cKRC4h}9/v$$0z?% y˧fSSVGF )i'E}|_}wywծ'9j˹k)=+7k_}Vqd(2=HH [*-Kt\ Lt^ZC~d>#6FI奅U@S8Pa2{^@E_%C\/(TyMF̢'EGn>yzP#o/۫x]i}GKnӓR(}ΐRdQDmK$8}&FB1y Uta.՞|uTM7B9G ,z[$qMciq-X4@:dm6J jn *++OC~E!LNs, (L0/:HS#XWyKrqY|&qIӀ?D$0~y*рEoT(a>jQd{5I]EйqU,2͐4#V.DZZ"ώ2o(@E:Pτāzy>t;AÍ Ϊ}R)JSRSzU:NI9>&š>B8|*dm}Vg\iYrWLCqed"i,$ 7lc I:L&vYz7I 3z@Nh6E߄lH\q:Ak )"T|!)s.芥 e R:?7B)HS8!+C[YO(;iY90;M܌L,=ǘo\ΒkR/'.eDh_gDc!M{F4A$Et2ϱ …p¼J+>)i0s[ -!v4!(eRޛڄX*H_v=zAkE%~3&vrzZ>eSO]Ձn5p|p #h4UB"5k+a,n遜OZ1FH!HcxeAlZN^aŞ]O1:f *A$DVZr_c7iqm ޓ̸k]I!,>DzKqP)$ ({C2r *Zi| ng+IMu>MQJ]<Qdf0Gqߌ`SwS_+M#A RѨa;BFϧI.v:Nq6FmׄJnN1%+BK7'"xY;*ڑ?rώ Rl-"fmwcȌm)~oCgyA ݭAU8sS3נ f+ic4p^PFmvA7-0Ak |\.6~ћA:??ǵԞ beN VZt50zQ[Ղ&t"]6a?r܈.O<4ϙTzWItP~(ND sαWucW#1Yׅ78mG9@$h1A^'CU> dU[:sQIlew3{CFσ,܅. ))-~Q^S걌m9w{i WTQV}\K~@KHi2-;BZ5Lz$$ Y<͏dĮՐٵۉ!*HT 'RanܖjV 227tHg\(k-XTLyՇ._W}HB)IQϻ`2OACse }e$N`LDCԂXoٗ1 S&PĔ(~8呬=)Q ~U+:/ [;Yeg< 9o]Gb Q6+tת٪\m.@NjLosG-mEKNGtJpѷМkm6XgDvz+%e5V~`ڮ4dMrw~EmIR㖩͐nmaHϮz597!#7uv6u"g%Yz+ΰMF# X'jfmec%(;;p~Œ3ӝFbqr}󡹠f`9E$UUey6]e?C@Z-~.Yy3fT EF?^ .R(sB5X[IXC)q#s72W+ݻnaV+>SdkztZT,촨uބW{0)6O3K R s9 5&* ƩdHygNQ)̑/XH\2j3*YQy^O*vH_PgB= 9`=7Ss&f{s.ߍ `7{ =/mb!(^1berGHqt7C4o/331Cju}ᄖr< nrHϿICcRrZ" -' QR第a.'78yŖF@}V="4$;JFj,v<+ |ҩ){UM˛%UFm{P_)~q'꜡voaM#!h,=t" .Ū03"jVZOX_Ϡ!͸y{R@ӛ7gJ mLTw1$)E7EC]FmT_@IIK̔05X4Pt5]x`*,#6/l}fd!dA am fdamׂ/i!2q+-7N~ ʄ^EX@gCǓ;)~gEȩ#ri)A!%.K,7?j'UI"(ħ ggG a/,U<6peEI#['gb1_].dz J?|MWJȂ7# Q1m]e?˖fCO;d#w \1\!Na}endstream endobj 100 0 obj << /Filter /FlateDecode /Length 35723 >> stream xԽ6EUVY}0Sd7N Ë8IhSU,R߹t7dN]?____~~対/XGo[~/~ß|gsݵU]_xُuݳ~[=I놾5o\ӎ~ſݟ|.UfWuYNXkjFBOz\7|?}w||}_$Ϝ,suK_7Q̺9Gn?VyUF- xl_.NwkguK>|oyu iu<,ZfSxz6羞l߈7~~g?|o~Y!z8Y*ۏW|p|w8?~{owh>}v-=zO]*_; s?gr뾇s~c/W]GؾRJenrS?W3o? -_J_ő?_yy@)*NY: ?rF~W[q|_-{q9<՝OЇ9^A_cx(t]o7zGkF;S9pjt]#}kD~wsb`KGn?]oq|kI#IbL֐_r x(CXw6k/A0NU;:W[/hu4*mkzd|C;<9C2_S:?eiA|]ך9G9 q=5µ?趞qt?j@#FC?|4w8+~ ϊp5%9˜w/c3kp_x {Wp WC>V`ZyH;M|>z{k ?+ XZO]q֜7_`ңup-u|[ʯr- GׇQO. ׺Bsݖ#cX~ ym4܏r-F0Ͻ%вnloOpǫ7yX'/r/շ[~ǟC~c˥Κ+g?ǿ?g{6^k{`1֦,?NךHvϿ?zO5:8F?dX_ԯlHqy?m71?l?#>_5±;'Ͽɟ?'~dDl->܄K+ȟj?k_>oY۾{/~?~ ׮5>(#ӻuL.s kakE @ EXB$/ȳ YQk!c W ׇ-ķyV 5zȚpҾ2V dmr;υlB5iT"kDyG1X=fhZNyZۻi; Ldz5"ϊ2^+/DV>@֭n1kZy {sMV.eB kd Vc$a Ix[MYn3yLu~Kkhm{4yU7nr6api, xn6{==˳oypG#oWx+v-:.(HV_yVd׵ ȔV_}Uގ,B`}WHuhc:{ߍ s}@ ^EiAB /Z~O!+HCqm}&_qE]<'Q6|5tOrB,<2 EۮVQyN[ x}R\xK ѹ:п[h dKcDFb"w.".;zs>s!7_K>Ob}nA,p< ^Cֺs{C/d :Fg EF*Cih-{B=xKOBu|zX1VcacDt1f!E'5 2֡ i:"[e'Yք/ ڲ;!騯Tz8CiBj4Szh^z_?>Ocdl}_ت5)q2G,머4/7nψQk6n\y}?6p$k}p˂tbbݮ/Z^K- >x1M;NGkAgg| \|}".k-h}NKsE[3m>|VIsE=YQC_21+HH/[#!V!Z-.Yq5{Փ+ң2l4)@lCLe}>Y]~Y%gn~YZsv!3e/.ʵb-вޗJ izMIv!g 6*\hz9--HV012=,KVn ;"aBW[ZoA8tWbsNK.L윖ʵF]L7Voz߅B=7q=˴_t,DZ1k~M]*-D⣅Ri!b ku=D28 )ʵ>tQz)m]|+]J0ɬT2z#s?^kcdi%s?$PdG{&x<]zdKp{xH2_ ^,'>Qe濮RqXzT |kC4U&(cر]x۩9t>#BtTZ oP7,` i&TNKfM,0 ǿ٭ !<2&Ǽrsz+LT],~TT~qqLzĬ0w /羢+cHCy4WK@WK 1\Zd&81-c^eg8YǵZCvJl<],-0CdA\ʼTD4ii24Cy 4CR8--d⿵> YtrK`Bp񪫥Ds-# 6^:IzW/Z*(z):-"w߰)z s U7~MLt4(H\|}B7O*,3ւ0|κX*Hգ zL×zv}4ȋߒZM7z]ҙ'y$|[`iX+ ie=^#:h.SnIoi Eq.>L<׆o6XQp' i:.B.. $\ֵR)C2 ѵRAP/],-D )[AEln$ @.ݐͬ eYﯽM9oRҴGyT\{ͧ_>6AW2?RQ.]ǥ1޽DNd4UdpiHt!*`ejP!-oE-thZ 07d"U td\І[хH!U= lmLMR ֭KïʄB$B^MmX]ϴH"@u=56Q]T6+ ^tMΥ B, «3hSGH5/Dyl(8Lth&#zOWɂ0^<ɿdȪwaL!]H< >zLQGov#|tۯ4-^>4%K=?8>#~^B^ /p [Z/(o[з'?rƌ-B!L_+U|BH7Uȡud23r0ƑG Yh>7;8%}q 4Ƕc!?q|_YQa(hwXvKx P{eg!ti;2@lw4>a9!y ,>o;A~}3K}^utϽ|CAJ9_6σf! uh 6ĥ;,ӾG%eȥE76V RpERx v|҇,IX ^*!2b ,qgg}M֧Хa݆,>޸Хa8.K:rg5-tiXfǚuBu. kQ. c=iFM ӽG ^=v>k -Wb@*~F. N3,9c&c< 1Jޘ1AtgU#iȼcꑝ!&f.-D chtKC6itKC Dю^3Wcyv E_wl $C <;&GώmP_NqHKsvJC'y=0?|A%CԾa"rڒ<$HvtOQλ0wiy7&L-ӉSÜӥHK=:L!:!5;!};ES;wx/>2ų YɳJ,24J򝹞 m@"<ل, Yrw&l^ζȃCĿ(Dd3|, At$P  J.T;BS+f406HIL7/o˩9Ȭ!t&_43s [8p]73 SHDaK7T 5UQ+DW |S\eD fUV@UpxONU8n 1;qWLyrdGhB-$awXQ-lQFG.DR,Ք-5Zs!E|c>+UaKGOlQz.UvʖQeK̭ څ-5·^EHኪH/@M-C-&|N?W(reRNc/&6,eRNW#4;*T9ꤜx(J RNW.X]+Pq *󚃊@-%t.,D]߰Kw DŭP#QA("]k!Lc— }%,;Jb{WT/pd!B } }PR@ױT<tPu<3Tp#,D]WSP%7Js*#dG,D&] !KwPţF U^wTTj"l_Z`8ջ [*XvtQ`QT [+ tʪY*e[<4ݪ*v) iX ="!יURgh5b^*kCVVE/¸ }P__ĽG=kk{W03ѯ aK+LVFz|^_!Ƽu ok"ټU4D 2_ e3&_%<;J\Q.XH _QQkt4*xvL.&XȠ!f,Pib’ }I>GTqx\Rt\z[ SAcw 6b>SԬ tKn*FDY[S1Vg—nOm["Kb8[gTAH1yJ$ }4U!y\Tu`wiT!6Tm N ª` C]UA8 4u1W8} `\V1rcwXyЃf=7%UM]V Js[ŀߟ ``nE{&H.o[W⽊Y=}I~.򣃚JJaE_{*5ЭKMK]K]ոK]X[Y[GuB(0uBT`jJ ]֬`E`jΊ J\ LMZ1e=AjPG.d =Bb&o-+ȅ{gPW֯7(W.˳_Hvb{W~fM–}0o+d5'PϽ@Eq'B-m  !٠bGmruGXapBE xPAվWCl~l&a{>,Dҽ/DEt"I ;:o/Q\z؂b!I6s,"t"$lK ͨ L 7*$;M<*},DͽB.TxWH͎-%|ߑ EH!A66+<)Fi U7ُCf~+Bjkoc紛٣(:A(-R GyR8 z(EQm=eqVT ǀ55H[򀈖TT0r*PC7bqP0Crv'\"UAC;hyb:KA< Y\WuWʋSqW*[\QaåR1.'7^^Iz>u@gQCP1CR1⩿ZLn+: #"]G:2~ TR2JDTꀝR*ucSeHF5I}-"Ax$EOCh6!":DDEF(uJ"BCD(uC'!";Dr!";DD! *x!"*x 6b! *xM7C@jn LTR@2@RR?UÁty@}8NÁ3f3Á30Á30C@Tp Lp *8:=?DGfg`)g`ysO(8z&8z0xSPp 5E*8* "@ā@@jT@HOa* "Bā3Z5ā@jTq VM* Ѫ* `^ ))Pā3^5 DD8^ d@@uRR:驧""AH={ d:))^UāQ @@u2R:)J ""AH/:! !xU~RP q 5B@Oj!8@8@ 'RBDZ)e@rj!"B-ā@zꦪh!S q #*8VUCH/rPq -8)˃~J=ā " 8BC8CCHIoKSU!U2RGU=ā @zTJ"X)PYāt"SE@MUu2R$))P]ā.""EHMq"dy+EHI.@"0@u0@RRʈySUJ#i+FHO-Wmā6@6""FHMj#8@6@Wtj#"BmāOUq =R?UmāRmāQp=S#"2R ` ?:OH~ے=u?#Шg 4S=R؆Pˎ3R$KOMzF)1vTY+@!{>S 9րL4ks7fsXB|vJ4kwY+X}s3 wY,f$B'~d3 5Ӭ0{Wfnug>5%6绒 ډd}jiVa|͊](  f4f=Ӭ`W3:GY4fGFȧDB64+(# hؕDu? Q@E?N Ѭ:y;Ѭ }?/^ͺf}XK?J4kC?΋D.$Ѭ yn*2-Ѭ f-Ѭ+k[Y(y^|}#7'">;/&aGxV={YZx^'axVѬt$u!3әx~WG]yxv_gm ώ DNxV@I6$@ϟ!B uݴ]c@y6݉c]HXbu4]lΫıS`w3 A^*3X-dϫדcb|`0@΋Ч?cUiz]OX[{*:3&ڛ8V*L`@^'8GysGXEzxQgXŃ ƒ@ПsF)şqsߩ"s=/}'A.c- $Uİ#8*FEg/Xg  @Χı699V2:g4 V7qM/Mk;vRhS7c]HXE{mOOk8qrTcm8OgX8VQo WXJ =V`ώ qA盀ı6h:P[*LgGCkXE|m:3Af>;*NgGAIkͩOX&?)4g y7=Q;>=Q {?#Q ǓHxMavN-bmϨ'(V/HJhϖ;Q 9)V9~"bm؞즽$u!bmϖC%ukX~(VQGQ|}^=-Qp-* 3 ~g7=^z7Q IhSD6πD:(nU>l̝:Hmll-O {m"mߋUf+2G= ""ֺ9"ͭu aPOaCDYPx# oF +Z46JDn)l)l{@@T!Zt2G${Dfܩ4h#B="$#B= eIdHOԴQ-sDHG${DFnj#RiUQ-sDHG${DF >[rvT2GZ̳9"li#0wZ成d!9$#B="#\)g7u-sDd-W-sDHG9{kZ!Q-sDHG${DzjjZ戴MUqncZ'R2G$FLyյ}#B@eIMM2GMʴ9 \ziZ成c{Fej#R(g Z怨9" \qeHIԴ_4 \Z戌3fs-sD9" \˼2Gk#2ΎjZ戤ֵy8Q-sD9" \reț[~Z3\u-sDzꥦeHIaj#(Q-sDjL2@i) 0-sD9"5wR2G0Q-sD9"#eHMqi#hյQ-sD9#R2G8gZ怨9"5.2Gd@))^5-sDzꩦej#RϞjZ戌SMU2GMP-sDj LU2GJ-s 9 eH/K!Ͼ2GxմyS?5-s@T2Gxմ))0-sD9 2G<{DKM2GeZ戼ej#RSjZMMj#rU2Gմe9 eHKqi#2r?U-sDjeHOi7bZ戴 9" Lޖi#SM2Gմ9"%eHOiZ 9#eHMW-sDznjB-sjꨦeHi#RR(`Z戜R-s@T2Gdy+2Gv9"o~Seވi#RS`Z3 0-sDJ L7ܴQ-sDꙶ2-sDzji#RR`Z戼) 0-s@TU2G8Q-sDWt2D9"=ej#R?5-sDFJ\9"5Eme@TQ-sDZ L:i#RR$`Z 9 eHM+2Gdʹ)gjZt2D9"쨦eHIi#S `Z怨9" LV2G䖫9"o T2G~jZ9"%ejZTZZ9"o L;ѬeI9"3eHY]DRYskY]D9"f5-sZ$յI4k&յI4kZ$յI4k#hV2G$ѬeHY]L4k#hV2G$ѬeHYeL4kRZ$յf5-sD2jZdմ4j#iV2G$ӬeHYM7ѬeHYMiV2G$Ӭe@YML9"f5-sDjZdմ̎9"fu-sDNյZ$յ)f5-sZ$յI4k#rҬeH-ofu-sDZ戴9" Lij9"gu-s@zY]ij9 #eȓHZ戜k#(V2G$QeHXMD9 %QeHX]zReHX]D9"b5-sZ$յIkr^eHX]D9"b5-sZ$յIk-vZW@F2߈1aH0W!TwaB"!de߈'%TCq0)D0FyE\c $ #D"q,DK 91L/y{ S) I/`eH "Do2S Vf* `rf`HAoو4>L7ؘ2x3(xx3%HH@=Tyy;/3@"+x;/3@ oeByLT%Q`(Dq/MgHLTi<15^`]HijSi<,?&@&f2O@»%Ry7y |U%yGcnh LSH4)GQ+a)8)UoJ0M'.E.k AxY E@o2K#{:, ,r`@f5 QmGA+W;oRϥSXZAX_0C!KIE3@:/ IEPyx lgg>/~ogBVxgv(-U?VEK@6tH@*m"kN_"1K|!?_ 0?C?ߔc^ʂ0?D"{^uv!ߝ|^鉇@ KQ/ [@82C_&b?_#ۉ ^Σ2=&b?k,DŽ{!>M>ɳ9~U.^k@'SB5 .Znd_s>%@8!kl^f'tBdž7Li@:0;!3;L Ol`rAMLN<, $u.x09!" x09D,nxJr1e'¹O&'Ӣ0Sk'F$F;p @x%4N1}M>n&O܄1e=pErPp^d MaHNś>"27@"و07m4X-E‘u4&$ 6& s@8l6S"64s@ -za7V#ºo("ͺo 2TdJ6pIA~}na7hSXpuiaAX\ 뾟1HU}u7˿g2ʺoQ̍uX"3l2yƺoHdЂ~ vFBC;z{wF: 1 MG?$~lHN v{CAzv뽑zohJ;K/f~SnnV{C*R !LD!&f~I M^)ҫ#|r*bo$G.Eī]{SR.a7䬓hR 5+?X 5+{`yXݯIyX/]bbG#F O[2(ȠF <,CNy^|r#x3 :줺 ?:[ -Rj)םgGžHg }@`W]R B~_`cr^ܩ'8"WF-鵥@ak4Nqh5uT#8[#?%Z5o)Nt5Ia~a%mMumuuΑu΢uδuƙuؙuuuuNug͹h'!͹h'*͹h'3͹h'<͹h'EչhM͹hV͹h_͹hh͹hq͹hz͹h͹hg͹hg͹hg͹hg͹hg͹hg͹hg͹hg͹hg͹hg͹hg͹ȓf\f\93.4m*6`E0Zqf6̸hf\3.,mE6cE1qf}̸h3Cf\9ENAoT[T9Eƈmfn[Ěws"'ܳ;,r=t"' ݳD,r=t"-ݳȩM,r="u"QͳȉV,r2=u"tݲi_,rj->6"'ݲIh,r-v"'ݲIq,r,Zw"ݲ)z,r-w"/p"/0"+*p";p"+Mp"^p"pp"p"0"p"p"p"p"p"p"1"/"q"/4q"/F1"Wq"iq"{q"q"q"q"q"q"q"q" r"r"/r"Ar"Sr"2[W:[WC[WL[WU[W^[f[o[x[ׁ[׊[ד[ל[[[[[ɹ[ѹYڙYYWWWWWW!W*W3WۙHv3l+JSQ;63UL !`Ds&ug" t׬Ica /Y#%j-0_"f^|ݗ`D%B]"4 bMK4u%Jm_"޲ K0_"%j0_"'*f d̗hZ6}KgMuKD4 R0["_njK"g|tt[hr[%FOnK4-koDH){fa:DԖD̖h6 ܖhjJ]JAóͪ#ͪ]eܕ;1W"&s%1WY+6`̕T+Ԅ͢ $7%B%"cִ!v)F\EԔh:b)9L0)Ѽu wSyDѳfJ4onJ4"ߦD@'*P$~I0nDP5I #'a~D(~DYƫ#Zݏh:2xubr?"t^>#GC#Z?#jƣqO#F̙|6fG4܎hXP~dA0)T 2 6;#޶#˶#mG4mG4xwE$.mE&VD`Q+".>hhw[](VD(C͊|Ѩ\kl+Q9l+QAm+"l[Zʬ1+5Cۊ"jE4 gmE4.vՈhhz1j6"Jn#mDDO0"ZPfT&>.3"b' ͙o#"/D̈+>.3"Z[Y{>DZۆh\ ڊІd!6D⧹m Q@ԆOۆOۆOX݆3"jCRlh 6D]mC QUۆ϶!1l Q# lF .D}G.D]BmQs!B/S@]ۅFۅ Q@ԅkv!J Q B"Bԕ7.D(.D7.DQu\5Ks"!?h|xA (RE}߹"tBIw uC]Y>w qu&Pb>s¾6/ub~܇C~juB">uF>DP@}CY!]P5`t础PR<ԕCQ!Dy{:͙P@y+Q;u-CQ确t;KG6wڈ9u-C]9<uW CԜCH|#<$bO0Bڀuewۡx.6Fvrm;N#v( j;*m?< Sc );uRtۡЫvUڈa˸ADmP@v*m;JB@]6C47 (Ra[/O3ڈZMӡ/`:5zaZMC(6MCo)Mޮ=M?tyn:5zn:ndmLP HvCslӡC/K>r}u7ˡ ,CQˡ5^%FrJC q }Fr`9Xa[D-^lٖC1!n% C!q +CQˡWkf7-lˡdC1ˡW5Hr( j9>qˡ85zYӳAِӜ^NC5i( 4r9 D^-%NCQ!,IPi=Q4qtNCQNC:miOp : QЫETi( 4]U>ih4jv : ArQT 2EX+c%LQ̮e.C)[%L髅b2䀻 .CQZ6E0݈ aoD0  (aTE0݈ Zȶ]b2uz.?e( ʘZ!e( ʘE2eLQWc-7@WKP@1}U]i@2}U.CJ!0v/u^- C!] bFK7bCn(_K_l!C~8:wtpbs%nnFC&MJplsBwnPCѺY )pwŐ|D=bw6! Cn~nC@ԞG=Hf=CV->1ԪJcHUC@)y ECjU{ 9,aH= h600FT [F,vU7! ud=+ f$@Af$0TES"f$C@H-g; PcAZժ#wju: 0D-aZ\Ð+a@Q@2G|D}bHjJn CZ QjML#mF;/Ը5g A w?;j"PkZCH[ a  0Oj0B" a>ZR{! BU3R{! V>JZĽl Ap) k1! a.57\D3:6T/f-/Υ7Ē4i. h h.˄ fvf0dC 'D4, 6w/  Q! /ĕY"/^_bP϶*R5ܭ 0A텀p5{!(fxf/M""a*} gBt'϶o dBH( C4B@8u:͘N.:9+Plw! 꺣Bѽ]@}$IG70qk! [gWMWMxMnMFM==mmmmhm@mmmmVe y y Yi y y Yi y y yi y џm*d)LZ騧ǻU⻥1f2uQK!I-\B@hbBpO! WTiv M\BrS!W*Ezj*dr+Dԙ+Sȥh)0;ٞB.sO!$ԔI=\hBFVUE[VnM٦BHfq:3r M\VB C,vͱ =kQȵ(nwr;  \BwC!䛧KSHz =U 7BMB=A !CS{0O!wBAYT ;>L*z,)[RxBw?='\ ҝlBQ'"ʶuqOi_Bϣ.֍J XBc; ! @([ d) RF@ꪲvG!$zG|(w¾RS=l+( JQhߙ3懎B߫(0~lGg2pC! H*نB~Bn~Bۧ m5i'6<״3C!pl !x+¢m O[jQ?f~BHq3?!쵨~UrNREH5EhO("Z{Vm;b~BѪhv@j; OO("ZVmoD"Ui_~Bhv@t; ,ހ EDK斫P@O("Z'*MW?hv@v; Zn[_EDkQ?hv@X{ E{_ED nGO("5.2Q?(SJSO5?PDSO("ʘnD"i@Zn Edo"i@r E~BP4 3\"RS?5?(e E@9ӀpP@O("ʙi3݈ ED9Ӏ(gL2SO(ʙI"FO("ʚ=[n~BQ?(keMi@5"rO("#'eMnj~B)0?PDF' EP~Bi)0?30?h!w@ PDf O("5wTH"RR,`~B)0?PDjO(#'n~BQ4 3': EdH"RR(`~B9/~BQ?PDFn EvPDO( 'H?ÀsY8xjCM/%Bv  ѓn/!9|WWWWN'P&n*P&J>L,y7 O(|Ba|B̻a}B 'I W'}BLw` J>Lꮙ'e7 O(2vT>LpU>LnFP]3O(2vU2YvT>L@@>L.|B' JP" e2*}B\NP2*P&n P&n P&@@>Dʤnm e e2>Lݰ>ʤ|B\v2w2wT>Dʤ/}B\Gn> ݠM>LݠM>!SCmZ_>!LN$= S(oӐ Œ'xOh,o3 uRmV\>!ZLBqd| <4 !}BY>!L 2}B(*_(*e-#e *m^>^W~4b1Uԕ?s)k03ۣB]y ' gq'f,:!$sS !靧:!TƩ\B兠Nsb= P|:(P}~ *qꄐoQ.z=z# q>:!nuB(QO}uB2Cm5 awm6KoۡM3tS&)`[2!Դ wɄm6![&لjQ!lلoe¼ MVI6!T·m a&6zm|[tB, TE|*LBHRW2 azA}SŔսP< 0GmE$o(B=x(<5Bu,MVJ6!T\ qrTQS'2 }NR'kz~b(M+Gm X6!+(PU' 5E a6!Z&jT&z&V=N6!jTtȓNz'N / ! @ }B ' @ "r`'BU+q)Pp6bA:tB VVM:!TsBtB@вC̅a(uBtQ'զNĊJ'-UA PDP$aKQ'mN6w=MNB&-&BImB  hw6!;(P= @P%l m.6AYC= %/B]R}B~OE5*cU^>2@S  P'bg6!lBu١M;4&#WE;[ dI'80 1ru PUP>! R'`m@:^MVE J'bwtBuV1J NYG/j ZzN2k5 u:!:B=kH +=Z-6_ȊaX˒MDb &+iڄz)۔لjlB aK'T/*(,ڄP͑6! R'T/I'bO@h*R u -@RՆ6!oh !j ل\&`5lB 4M>/P7#MĊ$K'bOv鄪x*%b5s Cp Up }>t #uCN jЙDPcCMK.!ڙb.!Zw\B 4A%BPc .!:ul9.!{%:}Ct +=T UNq 5YT Q%HĢ J%bOKW"h*j`f 3A*ȫ R gWW ؀K*!:c TBF, B UB blgL$#HW#H?z(\B Q$RI,ZWϗHd&T(H"Js'HbTJhꍃB K$@7MB 6HJ?щ*^MUB @Q%¶EșBM*!*!pv`IP]dId[" 4`Q%o;t@͢JPILr!P,CP66Y+VD\*!ZÆ*!$T-&NR$ۿX ͹IJR dԺJ)=T X-P|H&R ;%2NgYk^.!UB 8W&!{$B ~TH, b ꪷdkk@$=At }Nt 3F.!,{ X"P&RT u`g.!*\B g\BI˭\B v%_}'P&E\Bu]BEQAdӵk꺺ȢLlI%TWKsPFh“F"@諡I(QSQsL8fʀJCZ*!jTB P% oJ 2a |%b}\B P&DP a$"[E &7Gh*s#D"!*c(˺2a@Fj@M2JjCP杍0"!q$@MB0ZFvT2 CP& b{4jIP&2 V P"懆JԝJȁLB9n*L) P"$$V&RePI(FOf:$EG7 %i8IL2<$eJ&D=-V7 %i d=-RYJ0M7TB0\%QR %dTɇ⟒8!IES R2 5f P"LCE~ &4\ew%LrfDZX1$B05b>Ξ$BP"TdCuP"LE-% P"V P"LE-=D("sQ Za2j-B05&YJYa2*n LF LE 5#P"D- A(f&LrF 2&cA(f&BPH#Px5 BA(* ֆC(JB.JD(*,(J!)'#D(J.J$BC"DD(*BDh "PQLhJ!5YD"-BE"YEد B"T7k29C(9jDJJD25BJAS]#P"t%BP9xC(/g K"-B"TTg-B"DDh*نE(Z"TֽE(ZE %BP";=G9qP"%B ՈyG(1%2YHM(4M7sqPQiY-U@٦N$BɈM(4]D٦N(JzCQieJDmD٦A.?mDDm*7Qaie8(eJDXY2eaQieM0 R%l6 lS'R%l 6~APDDnDAnDNdL:(]DNJDAnDAVZF4HDnDNJDAn@AnZ J6u\S7RߣP_%e:X"g(썓@ `zR?VJƠDJY* d JDA8dQji唝+>go"J-u"kP"RK(4x R5(QjYQjiPjiկA(tG֠DZ֠h JDAZ %h"& 18D֠D"M֠D$MA v%% i"?nI1bޚa4 & ia4Ia4IE~p{9l_=j5o#M7+ri}[YG]?Ko7~T^o$Y纽82Nݯ!5L/oo~\1w i9Z;˾ehƳOGzoYMr \V[nPq<>(ڹ싗ٟUKo_,*w?Ӻ׾5(𓻊<{RB,Ck`m%]Vy r:]ڮ캭ug/F>ce=Rs+o X 9r\.W.z~s-ӫq=^:v]yYoȍ_ڕ)acikx U;b./wi/ej˗yܱsgoX]kY˲KwY|l |nQCa\DY/b?/|кKtYT('kD߱/Fxz7m|{}b6Fmo'D綇KoϘo什%)'?oٺ,>,{2'P] Zx&:8I_q3} t# [dCPaOn!^ziոnxYirZrϭsg. e6+ym=w;r~?+_ /zG#vm0C}<-H-v~zz/HfK>vwg>Olm iG.\ߩs!i> E?4ѰMP 6 E]US}߹2!5i~xobY;T;|ޖA8f϶OmGx#@!qn_2\S_y*vWbs۰M?m\v)>|}G_cwit6!߽! |x} ^㑶U!w $#L!v1X}wjm{v5?'5Mjj=9uA^Ƕ]||}?zSC^m e.3̺Lvuyl=_ʟ5]~l]9v pq ~1-!>~.Õ/W.nc?/-~&ܮY5o|;JM-|`aꪨӤ}Ǘ2i]~^5>rJ4(ׇp[ƣ6CNpׇíne#­u1><<}Yv;}uf:t#y^,mÏ7O.C(ϥL9<=ĀJn==|ܣYV)tnȻBHI|8@kۮ6_K.ӏ_2.j%{) gc;<8Lƣn3 m|x XcwQti/{6ҧtOp}1^폎~iǓWl{Ű}Z)6kG{dRRŏQ;]}4?~ݟ}KҼp_o;قWn #YDԺ< [> stream x˯.qgOȣO:[UYUא5lX,q-ݢ5)4\VD>K]_UeV>"??t}W_8~U"֮+}/s<]>|?ty~|x3yv} \VZ~AhJy^q㯿(gii^q qjݷ~/C?|Ï_}Y[=;8ԏ?2=y)f8\>3Z9|jro3S6jmZy4#WOq{k}>jJGkW?/?y\cW͗m/zo>/8o ,Gz>ɗHӞsǯթzvt|g3{/a[o~>|u};ko/~nmM5un\?qlv꥚?=[+}?AuS>jp|P5-)}VK?|{_/alG}oGaM1s2-U~4-j TnݮcYߞտE۽>o}[vݩ)u[[O~IO8l˿j;%%g6 }>y{tΟh}N_8cR{>7,)IZz=7y2ݹo׳M1g}O轿[ϙt} XoPg5&@ǿr=6S~ʧ>4bXW?+ֿVX9g[_÷H Oꃥ>^*\.y}xycsp~[_׿ok+Zm[ǯq>i&-l# ~ylj>c+VwNC/3o]OQ]F?oԎ$߷<4Rb ͟Ͼ?w;(٣mٵ6m_-.Y[P %|}x?=PMJi*"9?!#g|s-W_'m+J ݍ-c(Xjәbe/ yw=Zr^sW_/ӏ]o}pߩoow_>#$/~͵u-p_]o:i־+ pI_]&_ߨOHPoBS CY>uYcY1>NUnlCQ޹z:b:\Ey|VVP7㭨GMrh9y.sbx{}z >9ٻ-׼lϸSJ~[>>?,7GS9vxlƏT.[ ZXGf0egޡ!>ΦظeP@z<7>~7[20Ŵy=cӛ%c;#iSz|2h=h4]W(yz)7EWꞃL E}/ַ:m 5{`;WS5LfFTZby)|a==[~1z(_OSܿFU_c4Zsחg F&@zqQquz؜vj߭OA8ØulQOAN̢׮0lП ?]Od447o҃<=K?_4}zeLĩ'a(.'|<9my؀IWo8C53_g-lu2~ )F>O8FW_Z}عli/IŹi;񻯤a{׳qxfbM?:T=99vas=hZk̬[o;|w~/ٻ/7L*rA_; E.%}?<7^.O]W־xӓ[NS&S=Ot?چz}ϧ1?տSM_^mոß?ϱOlY׮D_BnKOt7Srʾ=ٟ?1~?1dwͦ w!|biW/ʖWToqZf#.>xwnkZݗ^ۧϾ|?oO*Lg@p# Cd0(dQn݁7k(i*KKv__5/Ɵw}>}~Ww7}?}s5y:=M?.wi;y{ͦ%yZzhw/柼 `Bf9^kΟ?~yi~/ǟ?_?]}S{;4i7 4c߼߼;ݦ c֤YM|wwg=k/a޾Ao}:Qߞz*B@?'Wz3o8?tuߙ,\r;[?|yݥ~!yAr c/%C + VIMƐwQ4Jh˔ܒoIJL̷i|RI$[%};/^  ,%{&Bk~[)IS7lŘ5O>HI;}*t~)lj y͓ޞJɩk.ky#,>2$ѣuC zAR[-\$7FhmśgGdM/ 3GM뱇i+^Яz~_;p_4]pGJ6w G@{ݼMm=Ey g}>H1d<jNKx6"77><)C}W/c\PL<@2%}jApc^ƛwI6I}>'*lv}}(0e3uʐXLl~xS?}$}v?KY_ MHHR_'ks_]rܽ+nHrܣٞQ5f[s= |mߵO5WOqx!u$[e̛ZlVHb|$}^leꃧs(IonXD.I%gpLƶlGCO_ǰ `_kz \!<59m׿̎vCO`îKƖ_Da}ƏG<\tj[VV o}$i^G] 'l7>: Rl#~dSWؚ)k]RrA]NSPꃭ!pW+ٸxM׵}Rh]ݲKi Aɛ|*訜G v>9 ֐ Iݞ+U,~=E;+H$mK iiW_9[W0H>Xrv]*>0JsG+^S;U|o}K%jδ>_yC {nCXW%m^}Z]|mdh5p5aƀb*Ϳa6"K`f#yx>;0BqfrҺKp⓺rbZ_wo( lCr_4\)|l/}3I:ނZiIN%# &QR>3%]ޏ!kD$J9$ wHV͘&HmP 3tm]/%նDW;PeK .l٨>;0@fv5k]*dO&shxNZ4%,#fCʅO]>ޟvMW-lT1OS+F?5]r~ #0CrpLzS_(nc/S O|ǔΜ}`>OviS_>.d>~zKۧ74aƆ?ÿp׹' D>s2)?o:љrXL`bd1]r߷5y%q:öGBI4xykVwɍRG ץ.= z1ixx6E(=]Ƕ|TP7$]Pl?^GOdbJ',|T15#9r>ECZk\Wp/|ՒS**FWOwgDuQF>E0ԣ +|6>. |dx]LIRfj>&) `k#iƷǛg`5/A'z_N[ vd  *avY ꐺyWuI_!HTgk@~"7L}`kN-i$n5 *MAeO 7LcI  >lzΟnؐKf`#Kj AF Xj\R6Lvι . )ּ>:i)nJQJ\uAI8,j Xo/j]H-XO<;]ZSg'ߟS}d&972M!KDŽ=O?t`}|Z˟Əέz{pJF2 AفO#)6@q|v >=|XLh^om-ǑAd[풾CXⅇa}zc)ʇwz}c(vh]RN&p[Ó9]`z||'3/=$15 Ĭk>pLd &g֖(A2$E hK@phq̈+;%I+)B} T> kU6Fq&䍳)ɬ|[7}7X<#O#١e|<:ui3!uQ5L(Azs2Bfd C34Ekxz.}2נ~mTllc}1yZ&-Zmc?'< ijI8\f]cKpQ3.!jC M.8@`%d-0x%ct$, 1|rڒ%f0Lq$fgJCG_p[Η]r,Mh3ɭe9Pm!dnAS ȲA, ` UംWgQZ`_j;Zw zd+K8QjMS z5 ]rsYq7EmO,rg-XQ`.`oxg⧢]$6/Rp[/qv>~6)6xI 5c!+%+״KV+%l4Sraa%59tyMM*(t/>NlS q\ʾT1 ij3u%6V2iq梹$4\WͲ:W%/ F ==]..1sI4ƦR#ţI8e ~.$I_^0?t~f[(j<*GitNϹ I>uf^sN on'ϓ5>Myܧ52`Axܭ1Nt 02Ԍw: ('z~nחtZMmC4V2*iႪgy:PyoS_UJ}Xiqj|?vV1鴪i7Ǽ3kz1tԱ|.m;S0TsNu:}BV:`@i@q0]@g=1Lyh?4q-YONSrOSn=:p 3-NGnF@GrX{Lw{˳i#XGm (د |]V/4|>e>R1J^@0VSosssF[BvYd3ۖ`4U؟,hQA:Xd2Uغd6zYbǻ٨ªf62!:lsUgB0Fw'aOBD55 }wFI͌K &ۦE).O ?ڒuda0ضЌF]ݱ/fF p؏aԆ0l-uCV݊mÜ݊Osx+=FsY]=,C;vf8Y[HhhO'ggB}:c/{fE{Llx@ZtIyqRrJĴJִF}3}=o@i8SAk۹K: W5pwu..4fh/\XNf]i纄pe89 7_pv =.Dϩ;@Sw:f8sꧥ.ԝ'9ug$sKs*GiӽN.ݭ9ulsn.5jh9uoF[..1i8p4#<ጶO i84]Bi8pgx>i46bzT2iQ\ F䀍2Gt }t4У4"ӈvYO.DDӈsȋ.1SG4<2HJ,>%69A' Lq)>wNEJtķtO#fbONy$WZ^~wjje_uĕu9PGYݢ<8Ḱk(>qOGJ1C25OtU)%EAy]{%/ةƖ{`p'# ̃:3#6).AmYxwY:Fp|=޶6w3"6;rɟ|gl7)be󟎬-3 vx2߳2mJP肛%yF{*D:jK6k'R%0va;7ޓ'z ]bOn}O$]t {R2פֿ.0Hk;yOGKd柸C=tyOG)s"N$xN>yLU.1H 2C]bӑ^w\9X3Hddz"!t瞒2JY=ʴ4^e83ge82pe{FWS*X.4t /LSJ)7ϔr`J3eZ$esSr[Z$eKlrӽ)kCrIvk't)Y/SB_'u SN#1K.PODmm~(/p[F f9ݞH˘uwsX֩DzfY7%=Y_vOMǙShxJpt\SZicI=3ԗ29z|yW -`3yT M%J<[˜b%znO=Kx]H iC5SyJ2p2%"wvNT|殄24r3l3M]ݷ̫)/-43'3ervۮ)ۻKx]eidgS{$\{%ϔ^9딿wSq7NS|iOU#s&Β[ɜ>x:Kx:Kx:K,tL<%L<%L<%Z>$<$2Og3Ogɳj<3t!a,!)=%=%=%L>%L>$Wڛ~Y,_L>$7OgI8ffΒ٧%LYIR}:K}:KM6p]%L@%N I*5w[%IU'ھUҶυs&Β{8 p]eX,(*;1$'1us-z[*2܏_Y$I'l_ Ir@}do&N $-KBqɭ!CqER9Iޛ\RT6$m8<"VZN,i!I"`~هik"ͪ,SJδJv{{slj@;ۦtJ]Hs?G>:r*4sUUxW=z~ToծcJ'U乯j@U_mw޴W-yԞc_i{ʦ~-禮©j^(Ϧ }kyKoYro*PI^Ԗ^G|]mY.)0{V t dMpKU (p9jUe+igP뾵\PZ I[i's\?u몫P_uU \~?0풶l>)%tIݛ^U (pi}VMK>N۹j>4MpQJ[%i'M`ynVM4:-5>VtjAɢ ב|c}zj&PP vkzΫ&\ևcZ(TW7:WEKvɵ>ziz@;ן<'j\zmY$imܫPo۹1LkT侯ieoy7>U༺Jچi9c+}_޵M@ߪ-tSV_56侯㴤kSJz65n%.{SVt9 ʱSW5ǭmj[ӯ)K>UUo~j@I\$*WeւxU c-o-/ ftkX`1jkZP_~Xc-pί 0x6kA㪬A\5 X mZPs~_"Bj~]6XPX lWEeׁ ΜqzZPx~UPx~ZpЯ @EUkC:P_ym.ւ[˯ZPz~U_)WE׷y6kAU~kX *ϧusN>Lb-2]o-o?jm<W596k{n\זX\*\yB:LQ~X]^ז#~ ׇZ_m.ւU @U @vb-ȃZ~m.ւU @u>W?֪z! zUQ~~UQ~~kX W A%nBٞO AaHg5!@1qQKO/4]t|lw/쯞.9o8yɇ#ЦW}Ï/?U8jǗl5^QΏ1P:ұ*}~(6$YRa(3]U KdZ|/,W]ú jXX=ѾS/?% 5@>Yi.iwGi~m-4vKTW>F(h򫿛 ^0^opEeq(H,O-9"eUwXN@YjpıpD\PoSFɭzjY?N X*9.V=5 UkʩCJ0I$ #!I*FX*G0T TQ¡* %KҩP%^X#_*+LX*S#mIPY4A3r$uZdB`aT95bIrjb@qt Uʌ|*ɐ UfZ zW@XВ&j^rmb H$Be58oqXItWVIJyPYO*+ b%5N*y7&*!) 1Jj75cSP)J Gէ#jE UyPYuVoa͉"j1T pѿzCPYCeEh&#*4T,; :P|o(1TV[!0T .NT,DDhHrɷ 6$Q%8_D-7!y>QYd.cQYer*g)*W*+L̉8T ^2gUeEPP% Ceլ !*!WO"d;' UG$`(TVԐ]%* Jn 1Tɲ2PYQq1TV\G *X*A%*!JbP>9TlӶȡJH?gU * MJj EUB;^Pb5dq' շ/BL8jD+CK.Ce6"*!% UBHJhbNT/DJg U:s H2AʨYDe`Q%S_ɐ Q%p" D"fAT{Qe#ÝAĠCesP%EU:"*!%/kBQ$!T`l?I2,nb*#wMw$P%T'*h@[Ž@6 hɥY(!K*PuO.eORE3IO%#맡)sOT`KKW*- HBPٹnOWґTK<0ِ9|= u !Q*OZS Q3~*!/iQDxS u償2Ђ2 fH*⍉2*<SD<~D,i,S'Mo,S_*3~Mb_?e'aXDkS'"d92ZQOQ>e)5)/\}:QFK_Jmjp9~lV<߅:qQ)^h)KvӊIvV?u⫝̸SuIl(dF~S'JE}w=) ,O[Ce^Oȇfi"~Fs"O),'ټlD S KPb:NK/eXO3IMYS'/]ca6n"~DHKOquZO녉:- '~T+S'%ea6tS'Nѥ!QOh^5H|!29l-y,)Y[2IlmH)yq^Lr)[ ?eSgm2,ֺ~; c1 )?u*s)S&~$?eD~ʶ&e2Z-7fMO/H܈Lh'Ss_??-O>{j.OMߎ)7vFS {jHbOMMi@ >5 Z§l\g.POxD4S\|jOMSZiڋ?eVOڡ#djZğuJ}a)[tOS" ?e& ?e =--)N= | zOOAOctOd0HOd^F)K5V&VSaEK)§&%SPÈ"p0W} YPb>ӧsUHΥ} IO!:} HOPKpeK)TOG>GOAmDB"T>0ROAYH >ՈSG SLbzO&(o,Ґ=^S9X{ʔ>[3S;|TBqO2 <*)XzBS z N:"NB!y]TBRI$ry2u ԩ0u'~ BwQH:kD.Qt)|S(Am.NHSص{N!WF0AG7–/+TJ*HЩD;k@ߪN!)d 2`N s*,53P,Q>RefNa w2O^:<uSJQۡS&<Sة$s RNRlCb :~_NYE{CPg1-)l+ SB:sNYDBDBycNa77KԩנNrHRbLM†SXGtb֯DʷNf:jSX-SDB*" ~4OrxNl4h:u.Щ+J4N%8:a)U)ԻЯĜʳ2.s l3.Sz+s e)Ds9s)o+rR9U9U] TSX@N56 +w q;d\AةMa% ;`5κ"Km"y$B< ̔y쵅"x*548x$U25SS&)k(DOrxS&yfT; 3 I:+s8e:3+,Sʾ8eNK*:N2&9J, TN\7`7en54}:N!o ^t^aSt"pS>KHS8lQgڒsNL.UOgZn'֔E6#3;R XS ߔXS<ĚJYS 5Ѩ 7P7)ފm@MhS 5ۊ$I*hS 3B(ҦRtWLaSܢ"l*6P `S6sͰT=Ax;m*HTH2WMYP7jѦ뽂6e@>ҦLrҦE/Ѧ,H~w6T%[)PMm S2k5eJ*3 ԔII0GM-:L' QSY!!jja:K0%ZQS-.YB,te:IZ$3tf QS>YB,yKZ$ei "t5H3%3g:IZ$LgIPS>Yrm_KEҶ%"tHjj5Hi: 4%tf QS$oUERׁ*"tk 5H4$DM-v2QSIHZ$io9QSnYq*"8jjm:IZ$ts΂{DMI?QSZN"tm 5H6LZ$tΒmnYҨ QSlKERUjjo:KDMzI)QSJ QS$Kko7mI  QSH[zu:IZ$yo:QSYҶQ*")" ""$E6E@EÔI""8U"[ۅZ$i^\oK"iE75@ER75@U$mUElUYB"{ 5Z$iS'H?%mSZyZ$uSZ$iBM-{%DM-iBM-gZ$mЁ:KM]jjH5H8jjPSER6@ER7eUEq*"y65@YM hܛJ,([JɵBM-BM-)BM- TIɳBM͒ܔUɽTfI=6=@ER6=@E6eEڮM jj5HҦ5HmZ$yZ$u5Z9jjBM-{S%ɵ)DM͂rlʪPSd:jjl>VGM-ꨩEX5H6cu,y6cu"|Z$QSd:jj}ꨩEX5H6cu"|BM-ꨩY6cu,1"H8jjl.VGM͒X5H6f QSdu:jj<{˯ꨩEX5HVbu"\%us 5}ꨩEꨩEX5H6bu"\BM-ꨩY6bu,ɫQSds:jjl.VGM-*"\Z$QSds:jjPSds:jjl.VGM-*"\Z$QSds:tiH3n1c:'HLʪ ^It& ECAYv#FEQc53)Ľ#jXgRqpqdPŶ#0wI#skpdcZΑp J¨FҡA@Qbx$IZH20İdB! I2tXBIHez @O8H&)G7820 X"L@^ǁ(Dy_.$$" ~IKa,$k0΀$[+/HXuW(<+>_"sz~Pd /"mY\DaJE$_DAXN.(2ȈSG"9}DRb bud#9E4QdUx <u;q cQ/pQdX)2Ap̩v !z\!$$>B'.v r)BFΞ`Ƞ 9LΐA8#b |3dN CAz( gȠ80d,!dPY,1d,1d+s1dSZ!sz`Ȝ'!™" W0Ȝ^$ 2(x +cgP1Jmn]@Bɠ EbɠX2 $JҎ,/ea`KYգd`JH,9KF`ɜ,KH]ϱ:LeXxE9Pd0i&P'@cF8f90U°1u˒p2I.Wd\Cnjjd\B'c%9,d'cU๣ 'cU9 ȅ2:S8t+h2IWdL8A[/oɘc Ip}?Ohy$Ŝ!OmтȓµOƔK*ᣍ<6u'd9ēIl'cE"Of*n+LB.3d,)j%1D11at/ vB~tzRq`d .XE\MAFȕh2V WddRfv+h2 gi2Veq8E"0fޘ0;z\`20[fYJ0$70&cUu/݄p&Xmt݄0\MX]0+N|&5dXsK 懲?Ɇ,a$H&ѻd1d5A2V\OyZAyENdҼɀh^ Teԋq4d^FAɹ@XrHA2 Ƌx4\d7!IA Kl3HR) KɌMXgZFAJgX_PKN9jŒ$%c >GLReй[U#a2# a24O&c齂 m^}L0Ǧ-ɰ7[NU 0KNfcd,90t" &c!Lƪu CLà^$a6ɌDm$$_o`2 .3Mu{&EIf|$d4+9ŗaLuyMne0'o*! O&ɕ +h@+K,tZz%X CzQ@ΰ*iL?J"XH2#z$(&eω2INWeELB..X-6e罀2Vu À^$$ Sx^^:ע'~+ y2V81煽O9d064t/(B@'n9NJ$_Ѽ9rѼHU'c;XW$Xaw̰;Vf+3. ceg¹2{\p8WfxJ+3)ƕ se2ó`q9X&H GSedQ52 L8-α@˄2b L-@˄;/2 (hQUhp.Z&W-3 :Z& heihpZ&\ le…hpZ&\ we¡lp:[& uelp[&Ζ Wzep, ˄S?2L8Y,(DBe"!2`pLDMX&"+, DGe<#2 ` LX&N,)0%2T T&"m*8`DLO0e"'2H LDS&)Jh`DS0e"**29LrL_S&b)q\XD+aQʜ#LV&T+`D@l`e"hֱ2VX LV#x+A@Dp`e"82tXLL/V&+A@x(u`e":2\vV&b+ΕDype"=2\iLX&B,D~peĖL#L$Y&h,6NT DNe"'2dH LZ&R-IHC2c9Z&-IQĩ`Dre"*2lH gz[&- c2gxYe"--2tHo L]&0tdDB^ftH L]&R.A àDbe"S12csLd<]&"/3vWDvee"32x Ld{a&2B0YҀDi@ffVg$L$ 3C03$ 3C0#g$LY$m?f&g$Lτ!L$ 33af|&̸3afH>f3a% 33a& 3!L% 33afH>fB03$ 33af|& g̐|& g̐|&H0V?G``L?]*1X10#V $B~,*HHkpV $@0:]g<~ \KU /b~ V $7X[^@^ <;+c%X $c˪JԂXY1fFrb -Fנ d @–;-'-~y \ Jo#\ $l]oh1\-KDgp1pl9.>w^ $j71.1x}z'TNkEHJKy b 9DJ18qr80&l: X\+yL} ^meO,+//D@H+y} ^ #^ c!cB v]"cph^1fEp*BX̻ 2:Vzt c_t AA)B Cwqw H~\1(WWhLaDk@ctb4B3=Ccm/NUbcEfLa٢`Ơ (d f :3bŕѩ>DŌ51ϢTD{j109+Sڵ1cP֙1HŞG0K< 3TbP!p1ס xD `BcPʏK^  2,y~DV90buU  Ac.fJ1:1&cP#UT l"1}^_C;kcp/XV厌$JHsш% v/MAR?b` .F֙Š-Š`(X&Jp B\c!ͳ$L:ʜ 3&v>?{lcb|LՁ<1;>&DŽ.34 -1Cq|vcW9?&T/ 1Cs|3A e1Ct~P:3S 1C?fΏzcBv|ж34r 1Cw|3Nnjca1h3<0Hnj1t89;fќ3qΎg=gnjcƙ1\q vLOg`971qxL'ĩ;1q2xL'DŽ1R z̰%8=f3lNv ۆc1F"z̰8=fY3l1N c16$|̰9>fX3P* kc1*&|̰9>f3o c1a 4~0:?f3̎Ώ ˤc1a?fI3LV d2ôaṵ;@fX 3,h dU2aw̰;@fXٝ 3,Nz' d 21Gd|O Ȉ dAF!#qJ@H. d2)LHQ drЂ #A tdr # AF% 2r*Y DF&"c3  DFB"#CHQd$02RE#tFF ##儑HKad$02RWnad022`91LQd(2h5XEF"#GȈeF&(2zq>EF,"#:H/̊"EFH"#HvDRd 2+29WyFd.!2M'DF "#* '͈)DF("# nBdd!2ȈBdDv!2b_x0EF"#fLEȈ+SdD)2bhLNOCd)229m,7EF##ɱSd)2!v;EF"sN#d2" G3dd2 CF׀! ZDF"QȨYPdT1"uD !(dK2'YQO!Ȩd\20uJ AF& 29AF (DQ&"(eAF% DQm"Ȩ?drC DQʀ*@F] Q"Ȩd2*fYQAC,g&dT2n8BF.2w=EFя" HQ(Rd)2E#EF"mJfDF+" N'CFG!G US:*CFe"J|hbd4h92ZM\.GF#`0FF#̑QRΎ3GF$ љUdtI2!m7HF$+N''蜓dϒ:IF$Nё'ѓdtI2Y'hd4I2@q ,LIftrH2]$s9L1L1222mR}= i?%ty6nE:W*^}>M86nތůa@wszĥr:2]yQ}p`6j,V;$Ӈ9C6ߤmӅ)۵м|٦qLtqvC|̾fA뛇HcI;ތxhݸӣD)W~rmE [<ߦmv LKQپZyq82QΞ∦g55iyb> stream x&Ir&_a>=uG$ ô|X0+RݑvI'2+"{gIQ VUTFfF]ɯU\~Ϳ&鿾__~&W.׼g 5Z{{gWsTjRv]e׼_}ߵ\r?,߷2ÿ́򏣕w???ܻ: K)*#sߗ)Wȍh>7;Jo,.x"- k\[sM*?%_#?(oy2?zǜ4Ͼ(H~C,#Л _m/vSs_k̫NPF;K}yWɯ9]f|ԝ.\>|]_d[On=mjQT8Q>O[uz|iU߼!Ѽ apk,/E!^%Z,ʅ?9=?_S*~c~y|ybx g(~}سGW.u5)񚲈>5/Xղ +̟8Yk>Z{4"kVzYd~.߸ |)|m}ɸ̯]>(+~MNo0>~xU2WM85~ՌW.<>?qP;5i#^U~zalZ\hUe+6E0G%K֘,zλ!=ӧ/HAOli6YJ7.8զ,;PƼ u!?]R J߽dJ=䰖e vEt?p''}T!,i|rbJ~rV3gyM~M"w}.DZ[*S 5 >a6dŞxGm\ȲfxO\l·$_ =~li?` ?rc+|t_>kW%q/3>nq4>^ÜN-XF~"?"d+]SS=O8>D8ϵ:x^3)\,:пh ǏYE¿Y5\:v47*b}Z`_CT cFNx?/T1o_h6lt_An'X3ӧ$Gݷ\9EaF?x"NB??PbhY,KC'Tچ_2>8b>~thh]~f*Hk}:TOy OsCܙ΄`1u?w_zN|OXu],JƒhXR鋇-p]*C}R'yGkyvO';-%9]5pآ~Ὓ{Y2# ߇^yfJԏ[ 9lsy> +#ȔO a;D~'q̪xGwavvQ&ˇ*UGo@_Wu4(I^BKKYdgY9]]^9~d}ڃ x|bA;_]H|L^qy֌G+YOŘkW l\W2Kwj))}xRm?5(7ԷOJ+xSV(si^xz)WpWR8fΚ'|Yݯ]V>{Hڹ'W~d;hs'D/!N? .o /U.V4jny-cпMOVU"&hj jw]\b~GS޲m{L엩=_<jx_mq{|j~Yl^_5կ!23x I?9cs#U1-\ZҢ N5f=CHnOkI77woh ;jV-t8cSo;݋𯟜Mî3]-/Y3CjUkI3;+uG~l~VqL_ `/f,~ĶC_?"#*FGha29 {][D?GKڤo<|n}U"˱:+_߃R>涟HWb o?#̟7n¦/߸dW '.Zzw-|/F~d=[̩~ԝA;U:—gyާ7#h%݊fd p>Elp?q{ e7nN+A;52zW,Gʷ 90R̹"tl$|w#GLQ?q6-K͞?uf&+Q~p̩s_ZI~-ẕ3^lΦPi5[ Rt~vϻ iq[~xV܌o^rbi6nG9}!4;wG.zNo-C?}%w'̟q1t?}lٸ{xϤ1.( K|nNWMVzu߯D~}r2m{}^򥴗Z(ɉo56rr< VQ#To-)w~<(Ir:+3/Ꝟee;R]z~d€\5'mt#6mk m/2>rl5g 9|j!g?t ;d%'8hF.| $[3¥)A'Ja1gAIb2LM8fۃ:bŔ*+K{ ],իww_iZl)/*ՎP/Q S"DL*L-EdQL=yWӔ?9N ڀi7 o*H›+R^\:x_9L>p/ޤtKx(LDVax̶(? W.)Dw6H\zUxv2³eHƻ P\"z|e|Ί1$#)G,o@." ~;&x ln15⓪,&h"U+ُ>NWw(T%t~ /qr']x 2D!7>,F[p"rC9\n Á,E_ZrÅ8Aܝİ "mo} 9xz Ff.7Deɤ{Ng%qQDNJӈt,}~"lל 5D5 =hd9pn Y\Mx VF<0H@ ȍ$e!OI>%& MtQlEɆ]S3偲>@ۅUJdvuT@uUl4O]E4UQ9/`(2^z(jI/ [|#4^:HĊtJ}M[U A;YU:}"+NEopSL{UNl_ ahAs-@XR^vW(p* "REЬBAnx<_ V dT<J$o`5T$ *1˼'Q 5Nȹ._gܘhg"!!EóE{>)à H[AH]$et]#]fFƳz ⏬Qa'@⯭Ϸ]f ..@$tk"67<+͐!jIETd/FJ@8JC,Y T  t32)d3QrE+9ZCU1G H* _B]cY2$ix(7QtZHWjÐk*f1*24[b6CnL)N@91A]Kяꆧ絵yj84>tlDD'"U,S,ƭSr,|?YE T*8& ^0 ?5C.| }aC3aV$c6ʱT@9[_ okuI@M+@MSxԭݾ`/e6*TCJk1"s 2uú:?Jzz) MDO8ܶ`MUNfN։'';M*uf OYÀ Pg#pe{[``Nr%V#dKL^0o͢~IlrVt`F3z_bVՅ DpB OV:S)Paj7O!4"EfF ').KwydHmoca|2bv":L0p46w+'O ękٕデ_N)<pS:d=$4S V}/p4}'HՑR k} J@%.5Z±m)SY]hAnUz4چaV1DtJvʗ6/^ QNA.%q_KYr ^|8B(x8.ܺלyVy†q=ה R(:T|zU _rkT`+"w[}Ʃ [X:< 2uӂKq`9ɓ I|2\J4Iey92=`!/ ~̇%U U7~t*|8;/!e@IE*b/Q(|؛glJ_rVA*+ȵ䔙dsRu/bIx )[Iəd,<8u/01sQ3]Ag v,sMOhG1Av<c!U<2퐜dz&դ>IΟS6ܪ1gM)`5Ⴭecφ ϖЍ?x A#)\6곐a\*8=|) ~bxQ_ ļڦ9%&, <[>)#%dɉ%Lk,1Gql.y*M5Oe Xb<%&ȵ(b-9e;r*p4r}u*T[OhE!ϛ! 9u& bv\G{?C8jV\_z*m1wKxt13ɤH#W3N&Z*fet]bMRӍ_Ƞ̸lݥJfH֝?]w@BB';9 0uѤ1T2;0NL_>%dE] }V͘Ћe׃նb+XMF5< '%g.*5vONB>!~NL}<[6$U32 |k ,l7*v6+.>6wę]ӑ,(@2D270NW2Zu\FU !C(*,"yu=ܐ}?"Y}7JI3UK5h `h9,VRV KJME^* : z'?#DA- {A7 $Sc5m9m- LYY q l[OiU@4*hfE"sQh@tH7zL WJ55H$J?N4F> }ܮ$_?k~ڥW7-%5舮LuGWzv::%_z^[@AgDC ?gZ)6]yhNuO?[U?刮WV_)Z@鳘3כvYӯZpm>߭{~elM/nDdAh>vUu [Zcͯ戫W|D: Imi d ޣxMmcͤ5n^KDG{j.ڥkY4KwxևzJJZۖv鞿mDuvKٌe m!!f鶢\Wt[ZhfSt[lhYuPmuqk] H.FfR(]f*bjmS[."YfUmWVinۻFl ۆvz;_׻Pϑ+>v؂&XfvUuVth;(a&´Ut0'U}&ÜTttNRDx*u`"`!K0Oeܓc.H))73ZXm &ǃo?Ѐ=Eky0ZAJ>25}h#tdǍɐh!Ю.Wy1dbq1΋ nLQvgĈI#SUFFenUK >Yvtp1zܼt{'BPY2D2~|ΈS&u{526}ۘm|VJ9숕>^taO;f7~ >{$!}|H'|Xa' @}bvJh쌕>/"VDE0{񑓉XY'`A'3'O4hNFKwĨ S#Q+S OavN h_Z!S E0PYA}` P+HEttAt 숖 )Յ rw-ݡF]dZH,KYT,X@Gw R R4\ ?Y_!VYx,ZjQX]$>CEw0WW+DKw Qb }X/DKwhG-]g],jY,A$pDv Q /&=r],!uysKwؽA+4/;|gE,{42 K&ҝoPdGt$`[(h,o ; ]~DA}'r,Jw&FQ5 Нс&+YX_%XNҝ`Re.`Sх:.E[AEwKA+% >|LAi5b;Fr;|eT`Yݴ?ݴT({Tb6JmI-,k6J?ԍ NQԍMV 1}RuK,C2)t)iIDOX5NWfYidӕ);FL$PA4b$ J%nZiy|TY5\$TbIL6]bɱqgepb+K4܂SuuӅmy wʯ .}҂p:,.֍N@mXåO .}#ғ,hݽ;gZ >yՂht^ dg4ֿ3KQUjLpAty h!; Ҏ'R'1] >hIpDåO|A]SW|A}d>&ѕo/`%YpQpK/kW[B-_=L1%">4T(0XXb5 jyhaU9a E%LB K)/_l:6]!I5VdW S J >\IAp}W ,]"I5qĪ^ ZT c|xF_^#@fQ*Q+.)k]*DG"{ AҧhH ʊ 볻#Q1u>Ij:a%Lh)sRc .DON>Uj^8S]%ԥ @S&YXAt22Fwf=Car4A4Pl UGwm8ҲY])*S;.+cߥzjHS'Ν, *wkު+,(SWW &T0 sr,.[U]+)ζR$]5u$]uu$]uZI;JU*+IJTV شN]+IW= VIjVJUZ_JU4]ZIc Ss5 ;:[Y5Jpź妻h󪭚+d }ʂ4Mv^Q]yqAzrj᪔XU|* *v.* *UU5FVjnժ.k.p aҧ[2]- x <%尔]yAz*] Z] <>]WsUb'U ո]x b]6TtWNB (A>]5Sw]ө`O7кʽjk A;'H[aBAd]^ ԯ8e-$VAt?xA,cQ\5!Vʧ =$Vs A4T4XgEA|]{HF7|; uϘ&9O OSX; p=H!@g "d,."!v!:R  KZߘIA:(n\SPiUi)q9 SU}Pi9{dc8۸L VM9G!Ď6'H94RZq /5+RF &bs1ߎ9Gc:zHiE:wY)͡Y#t_D!%I h\7rb+en'8D\ihX>8?D͘UCp {Q6'f&@~kP Qᤶuq3D,\5\LHdl Vm2UG:!{rRҡ bhGڿ@iI~5.J>,q {?\tB쪤Ž`XdsȈBS0qZ7՞SBfr  ?e8I-QdS(aO%QZ< @,'{8 t;d7*RmIkIDn~#k|">Y^~ɣ͎P^NqnZfGnO@Eo NZ6[Nlp\@|}H@n'U /RrdRk^.رkXi*k*p7[i3q8VaCt Vd솲u"*$bu Vx)]=^ ~Ҋb^h-\%Dlk٫`+6˽[%|٩r{ӧm{skVPI9ii&Ƞ҃䐫RAn:q4L"zn&7rQ>z͠4ZZN  QvlGv ҳ-sᝋFK+Ddji-Z ;6e8\W-}ݸhQC,UnInQv[Jj;Xk*DL@@ NK*0; T{JtLQ ~'v"-(cv]Z*F\5N'FK+I]h.|HJT8Z抹"WFU ~ "6smp8+`{c&gpYMʊا.с]4.12]*'z䍓KzpDåL8i"xYå)w*rnxiE e?x"*/pehT_̩(|)&TYk*Bɓ-oh֩?j ?rՀ"o ^|) 3Wxuр"7Ϧ@Ak]&bY 6"8"&C׈iEAɳe?NFL+bjkhTͤsjT/85q~҇ͬ>:PtUM%Tg! ]4\u*R ¯N ,'< A<tED >;+H'WiI= MDWvu1LduJ2 *ߔ6PERT"ɘe#5aTdIfw0DpEAo*0U$R^v G.މC4`H 2%}=o*rӀh4 '=Ӏ6PME72.шi@FLSL DMED hR5+Hl)53 :\=5h'DѠGeJ 4 }^Ԃ FM=R҅h4 `J oAOn DaQπGRΡjPR8j_ܝx=F釖Nrh`'^s&[zx=RO'{zdơ=j)H;$a<4^ZD8|G&MrHn逰CuH^،#PR IflSZ^QqY#7z$j̀S^6}h)#>_ x VfԎ0IXH3sAɗkR=W tif>ȈfQO?30jh|S {ZuG;v@mLՍdꃔ@A{|xf@LJz(h?Dst,0.>Hی*G;ahJAE{Fh z^:$zyh)G3@_0V?a]|4B8d%H3fQGQUdF3j0JC Xy0Vo5dvڣhcvYRW2>7P|43>zGC=t͏#R =*ZGC(:ڣ!@G9K>uq5>V0jCG9zhH~@h i@6:L vv=mT1{vj bu|4;>)U?M2nɇ5+WQ yQM>>G+(9*m0^a" ߏ_CMQV @!s稦M/@G[㣭C6[`<^%AF|(~~X+hhjx]3%7_3H~<6ç+̾j#*y.Z|V/?KS|-zl"E~07ۇ `}"A ,5FnA JzqW-$\2_ʿח},|bkG 7k76@W'_F8e@E,Yg$!^!T1"BGXDY{N3 b)Xo. ϔ= 욿]ϻ|K݈g+7jA,߻Ͼ1^RoA,'q1i*XNrHeNVO \\Qi+7F!=}b@'[bQ$[Fǥb#"v뢌F O&XWJ"Ӯ_7!XƑ(H ($ Q6vgLH]LHe2$}XFIā$}XF6>L[v ;xiB>Lx aڍϔ>,MH҇i7a@'A/ƶx7 6y63!InQ0m&W<{XƇ7!-LHe=SHi:aclB=Lݙ&$ÀH75ri=a&$ô I -%?ô]4 &Yqi? iaXôW 4zJia\v [l5˨ )qejװ5޽.<,+1PôI򰌵$yP a I\W"^&&11<,ýeR&$2L=҄$yXJkr2{<.5싇dxF5qm]ir2{\E0xpd&(2 >aofyJ 6MN^XF Q$Ӧ&' 2*LNiO#XwdS C. b.Wi beTmb~KH Ib]cBG8-12ʴ(1iWT i bncV&$1)A,?mBAL;dui@,׻/!I ]MH)Z@LCexMLi Yb~x bx4t 71 cw` v LLeDLLftgd49AL$mA,k؂bALdˈud&&Yb쎇I2FSĴk0KbjbXFT4F" ]x8~RLӶƔx2bCXy>ӨIJ& "lyH!W%]9YkE ARS(2[;^eI&u36&e!$XF$XFFI21E]x%fRISZbLLXGˈ;^B%MN5bK,#$661%5oC.1mbKLdba{Haz2pw}HNFs#d H=b`R, 7tjX@ꩤJ)AH)B!7 SII) R, 5բ Ȉ/Ndj.N̨S, 6CT BRdZi8G5]b!X@);I2NI*|oKVLBViS2h>{$GE]b2.ZSp 8NJ ,i8 pHI+`# @FC!$ PS`X@rZjb!X@,,rJNfCr2yR55jh,j܇X@&!X@lҢ`b X@)9ңMB1rưk6LcZ3)jL ئOLcx4&Qi4Mʼư뛐6û icf+=cy0p ~&i/Vhc˕d41A'`옐$ԛl R6>2apF6d4zƔƮ!!)[adtڛmLIselc1mklto1R!2.1_eTcE`޼Q!qtёjL{RL+2jL@5vӮ!7׺Sg |9Sv#m 3d41xLF~v y6d4Mc6Z/F4hj }fц/g$c ~)[d Hc31&Dc abhIyDc H4dDcJ ׈crZ~iLLcMH2wDŽdQ$|2%dBhL*&2-?f+0!4gXA41YuO5Vk@F5Vޟ$%SXH5ΰ4pZhTԅF/YTct)-n:"D1uIWrE5.>Xioj, a59Ũ19 U09NWmQeBc.9Nʪ9k 2"ftKNe$!DYt%gHKfSrțEOZk,F=E!=틠Ǹl?Z{1#XvܞkL4LHreE1M0!I592iBI1ELL2=jLKLLRev01I5([X֎SƲ%JI1Mj=X Tc'i,c֒ט4{iDc $zތh,II14)4<&%4aE뢎&XjeRi;]Lck\`\#s1e400b40)LKMXqDchXjuZŬF4RծѸߒɈV"tB'#,"XF3 /!ϘS$X-'xeli&&y4E3&&yV:h s&41MϜv L\F*vl~eL<)eؤŮa. X,ce$˘fbknJibI +$Ϙxƴ$Ϙ"ӴX@T $Si7Lʤ$˘m(%YƲ"פ8ab6ZeX,caGXfzKXg!X@Xg֙zu:0#XE'X@XguBS!d H Y2S!d H9,caC2zu釖˘G2rh)Y2Ρbʀ#8T2֚z˘G2|h)YjS!d H9$7!2VzJj,caC2֛zDM=zSe, PSc H|e#2֛z>XHʇ2+:u>HSCOe, 0z?d/0e, AF4e, 0e,  0XݩC9\8X;X;Xt֪/ PTv=n}Sdu H9ujn}n}ɇ-`[y$CS__@ZT| H=Lyr(5 8,|ִ/ Auv5 H9kqݮ`Ӿ`}Z㾀 } }ɇjN8kxMpfus H>kvl H9Uk~ֺ#l:vֻ#r H?k H=d檵 H96 @?yRsdzjC`sH? ݿAV>X>SQWYE] OwPi!=j|Ca~9Dms8 !}5sH;̶V?CQw?M;`us@;tsH9ya>~iѶ9yf5@?s/ C6]2C>ɇyfrثϟGaFFh!##V?X?COW?8!#ڬӟ!#0V?CQW?X<K`sS<M]b#_:k@6 ? W@LR|d\*J vi!7ȝWd=: v$IW`"TE' &@O NLK&ՈSدSgT2-x2z*PH"O0ITd f ( T6- o1( T2-XdLEF D:Tnc*Lt":}+&bn$Pn *@tMZ'n R79n)>VS*>T"&*B7'}H(GQ> Q}~VYһ1iyx+$V%cX 0, aO("Ũ9 @Ri5 d&VdpQ2{T藔m%_2S"-D+(4&EH?%&?a6:dQj^M)dz(ь?e*I`)2?zF |Pw6J`(l?%Be o[wN1z'ތ)qŒ%@o$CL`՜Hc@߯9 7:'T`s>~Jm?M47>=N^~J$Y/0TCB&@C]]כtMs5Rh"{\%0S@A&@=Z+,?eЬP nۤs"tMXK *zݧh>Uje vrhAO$bB$=M`鶿 JK >\ vZ} "tMlZOw}vlQߋK2So]pQn[0S?M"Lt41QAeG ͶDKFit ޷ۜG ͎MZnr蒤$H;{6 ͹WМy]]f8$ܡ fn<)BfM0Cƃn 1tKiT&g* ,ʡH}&ԇ7[T<8  uGFdi fnXTc5FQT;J,^i7. @*Xxt76)Mۏ@!ʴojuؽ|Wb݋'dIfZ}R٤)"|> R+ItP]hZObpP[i!TGY߷!Ś#Wo6/>?T E%?ĠCUP ]TIk)|AuN21( \;0ݑT?2xeXUyٺle;1uF lJ}οuGt&BUƞIIFM ~VK*'r1UAiG)3@h:+>2f̀˚A*&:Έ-Ev }ּ M_PtEϛhΏw!0q$G~-wt4FRrk*ݯl1e=ON tERvwRnr]6՚2JIvw#INDvw^0jwacQ/ )zbHv׌ EQk3 e9jnd`B9FgD(A3&zQޓ`@ᕑ  dگ&cޘD ^03{jt)P=Ǡ)3zdyo .'1`$fvAYn-9֊0[E93[kxBY&j_vLXZY)9QizhA^ab"^ӵަVO?^D{=>O?K_D_{guadвQ Avxa؞Aj1bN4n.hc"5e}&/>UO4~hn>m?|DD>(#O4J jDDb>ѨjO4*Q hO'5'5F&xQ h{'5(NDe :'DQĂN*h"`(&47D@QMDq4@DB&x,2Q}q1Jǀ(W& (UODFv,UDB%D 2.T"JP(C%d*EeDQJD*EnD%T(tD܁QJD(}DaP"@#%³_P"@bL"0pa$©7L"0pIH"% IC$.D8]@  D"<5@$›D"<>A$+(v"D8JH<"M?##<"VƂGd0"\|#0"e0#¤#0"n0#4c]`DXŝ,"L~0"Wv 0"”(EHDX!aDEQ\aDfM@Ds! [("a.C&U8DYavC?,",aC \0DxaC fa0DC!r [2"P7C! iDxAA~mDxAA7<" †(NuD!ax@O<"l |Cx~$!H"uCp?DA C)~H!bv"~!b$?DCZ|?l !3Ї؄>DACy>L!bC>DPI0"{(!RT=D ,C`=D A1C"l{@!Bk"{!Bta=Dq=CD`=D4AC$ a%z"!;J$IC$+!!A9DCt9D Er~ ir r b!!z0@O!z9@!zB@JCt8D C48D C48^ho t9 ѼP{!ڄ!# 4-6D_hC>6DhCP mڬ68ڐCiYTцԩ^!)fCRϯ IWhC Iڐһ>CcڐІڐ B 6Ly.ؐ6tzٟ]!)~ lH*w'NYC|G5 kHPC+/Ԑk(NgjH/T0EPׁ u :XkCPC}A/Ԑ: 5$RPCCQ!U=%5$q,LARD: iHAuҐPBJHCR|ih؂r~w fhvu`18!)Rb0CR|!fg= I9X\?2=PW(CRkB(CRН+ eH_}CRkT˩ 5!}~ dHoeP+7mdu0K{a I.+Ɛ&_a IƐ1ACRw K՞A IrCRĐ_A IPoQ!)ubH7S! B9 !\|k ahvu12Ǭ0$ųBC_S0!)>;a7J LCRQCRP+R|]+ .QϨBwT!=/*$ef*$`BRNޫ GR.B{*4T!)>C*[:B]Z6CRm e3WmLm>Zw=[!ǟ?g[W=S/6ߥV rx!}exWݫrn#֏o>쎯G ڼ;W̳'w^;Ӌ׎fK]r=;&Bd>Ԉyio*s߷s0M˼l ݛu]쾺W2ݫO޲?Wl}ߴBC[^[YUkmnijxq,#A4~MgFSqͨ )y\ӢwrZo$[oM}Tڥ~ڽK.C4͓61mxsx|㏞zߌ 8q[QJkfx]_W[bүnˢ-6\~~Yjg'Rqݾ*_#`{z3_2y+'K+s|UI{t!A ~A ab&7N˔cp ~AG9H?gvKU}O˹=yk==hb׬A܊KDendstream endobj 103 0 obj << /Filter /FlateDecode /Length 38136 >> stream x5ukb$@ꃓ񝮪jO<@H 0A,}!-KIa_zkuM\~oUWo>>|?~R/?hC)oq|8sWcmQǷOc+moۧR_ m>3yk T>|Aݶz?~~֮2!PzPR>K+)\v|9>+:޵?Nxnep~y14~d?~3xMixWZe9>Vg|y~\O W:h9mY[]K|y>l7<_7DcFio}''<5ys|KKpjq~q:7,j6678^o?5^Og?]NkrWz+qV{Ϣ;' uBkz;cnov#nOճ= o/=l߯^pc<<^_uƳy7;^3o>׶~'WK/v?;>GZ''<(~GÇaq\>мkqO3}S=c/qFo:|O~y2wls@kN}.Ow#NϸsFyk{Σ ݽq8|[)~Ko?߮j>HˎjW/')j}+tG9=LJ60Rf{恪̡#%C>7`luK?IҶ([ Lrcv9;ssϞC|_|oGV?sgx˘q昀T֋9?~6dqעܗai7O5~|oԊv#M/ؿq}s@g>_=}uKأfOu+rq7מn]vvٙi'%M=Gmޚ/>߫-|5gOF?rmc_wJ{V*o~8d0W=qiu}3V'>6>{@/u8`6ߴꉮ]VU=j=8js8Gyv^er~O_s7'r-Bv]s({y7Oʹ"x)q[)h%`صC_}ufe\ )bľki5ůЃėA5:}ٚo>;$9'm1t򽧄yȷCλ)Qo{1,i7x.s :]0J:zX6M/Αky=6nS]|ż10Fޒ^/}~g?~XJ_/Ag9 %vlY`{˕ѼXk?OgW>12{OkeٱHk_0^Ιny[C\};߱ysd}/-*^ӷUs~K?<1;hl{;3Q܍6Ŵhއmj(D+w>vqn"ws; ˾ȹKuUK̘~.QaO+=ߘs3C\Np }s<~U:6w?inzo}9fM8=<{_7Gc`82;z}=(=帾3W}a~XşOuۿuwa:̻R^\7+?3OFKٞuqD'ګs>pN\H <Ӯؾ_"?RcDžB<Vrǿ?Υo~ro~u[yˏݟw/n?uM\%g?yy=ӗًit/ع"xn#?W?w-19~?^P>_ݏ[q\>ŭ~qxvq)Y=ގm^pvem?u^=j58bȦ.7W(4p_nΗwhl{Nj5<z1;>g/!˛p#_=Vԗ >^-+}o/^|]n ˫#'AijlŐwj~-H.Cw g:˺o˲m|zeMig'ǿx_~6y}^>~5ي/mq_'?xo?}e{{{4/ouY=y=E,۾.K_sS|}uWr?4O:!@/_|ӗR_[fޝ|եozEv}j|[B7W'=j?w/߰['/KqRo)/gGwíO 2DM31sP__'sy7Oʇ9|F"À?*_ ʘFe>Oe個J~TU` RA*)zO(vѯgOeϧ~u7h* coIo'f{!ۼ>_u( ǧ*e[A˷Vm uqG2,MSJ;$oj̪sǰcs _ mUʼ>j^%e^;0 X@Ne޴SkS4!5j* q\:NCN>Sim*S76|yQh^Ǵ 2!]j~MWw5OSZ¼8seiy\T܈aΊxC9w5f;?uU y#W3剆jЛqM(syƣ}Jv5nTkK~=Y'GTC׼9ߎif, oi{w|9p,^$S8ҝh82%P8Le+vJ۩>rqyEJGkJRKeGZa\Ԉr{vX D=2sͮ4o't{.DV.c%u=n|5Ҭ!2; (q+SRq^@ipr+zN/pQgr7o5{bpD#eT.y^ꎓw%7]݀) /dž%r9<=oIkTN UPʦ;*oTjiΝ>6w^pU?/t̩~ vPW1Km|0ٻVvqyG>3^,Tt}rz*0jboq epa;[uHC>NP'G-^G~sL܏9c\ǙClo| m[4l62N4u0q`Ձ;;TGw:i_ұn4ߍySA&J9&ޘy7 hz:,G/Z^;>*;fz^Burίg 6}-Ƽ)뼏ΘzhƬ1_χ!kbL3 ~=vqJDxtcJG9i9ܖS שt(O,sڒ3`TW({ۨFE6q~U`'eYZqݞy Ln~Ƽ Z7ڥul@c[kq Iǘ/;ϩ2ǼKVlik0-׈sh}PfǕ=  Q?z g; LL]=9|>8y0-XWT@sJ>f?eLZTg~~MuN񴦹%+CG-uvL[8;T}$g?j*PBV`\(a/0tysMεqXU0~mU-oa\pndSu)''2 dB7m_Jy^0(wݰt94c/I5GxtmNQQIyhnӺ9` QN׼Kh6Ď\9b_LzL{2M(6 gV;vf>4NqقfWC;y@m:w>m/~yi+jk[Rv._88ouh{f¯0YE+kZiN \O!^k>|zXaܳhZz=ߎ5J2*ʈsoE0uօ S?'\prܒC@~95spPJQʁ.:'w65}NN\MBʦ)E q*OP 0dMOz*lͷDNkt!J6TQQi ,;͞Sij:L$ȘB |\WhxZty/cTƺW;=ü.k~* ANͷS:Nϊu\/VLYEGSѵ zJǍPs(J\7LETZݪ1b-5Oa) |=CalGu8DϺd9DQAvU1 k#|OΧF/ 6"Z_P3Ok>\< 0U\|"zm]χ먳yW1 n89Le^s͗hǙ㻀xΜk>'YS5BULlvi~ ε ?2-\f#@V ֊9lrpu]q ,S9d*T#Sf*V|3z ܾXk!],SBGϧ%q7(˛B䦙Q|*Qƌ5Õ<'M{{Z_\S8ShqfATRiP͜i {CEiUѵ"ݏV$S ҕ]ʎ'_1Tv٘PSaVlBjPrs>2>|u83vtTG™̳ףIpp0yboPGT>ouρ9 Vl`oԲq*'[gW*|4ae&sU)8+t1A<@B唏m*aGG\]Xf2Ҹʮڊ--L ی]/Fyz/Jyn`qJy Lp(iIjگ0rzm@MԁCOl9-v\j|~|3`b6n=aVYWvA\OG[c16oa vbTlb7upb;'f~_|Rp;ؽ`v0N:_ ܩ%1iճ‹Tz[gUb]J9(j\Ũ?W: }[iصZM_Te8k+]SoսrY=#<&Lҏ]SrZZr4ڧtv9E׋e.TRݳ7+qʕ&~LJUF#BnyUZ?\dnôC8YT4G4Ҋ-4NgLNGkŦZt:Kih#j69k7o爧=*= .΃bhUZk)eeU][u~<%'f_>\8Lq&Cù{ rlz-0Ŏ֋c·=J%-/^$EJS;zKPtxG8T0/tI)-`F{nvLP:TSVaE M>KgWse^MV]-iޝsts;|F΍>剞SZjK8?vX)gg˳>+ckw?+]+q"}}iNV X_g羹cu~km N9X;}ˀe0h:A20ޯu:vwt.ɻ I2r-y^9$Ne>;_prYs:LI~v:'*8گs΋Ne;/L)?ݳ)W2.e[̟tv9=vij RdڦiRr6MB43mp[.궓ii<4M4M \4Ml.ŴicCl8M留Ӱ3>l]iXh6NâcZ~t٦imsצ{Xeݵ2Mӌic꿗zNd@}cL+dYyN4W'pcS^tS.>\ eWXT8EW ~],ކb~|"pl4ZcZbrߖ(t.Rگ(tkQ-][,j"v.s-.]y'vL-{*?݅3tـWOQ~]686::e;d˯%𲣋[*req6=ܾ ၗ[q JYFڒʭ$]%Mp?nIYzo[Q%[[ppKJSB܏38a[l㢣tن׮ܪv\:-k+ }Z}76:JE8¸o𯏱Q^j01/E7/{bЫSv߻tu޻p.wpaǜqzoùX6&W齡 $~o:ޘаl^@%{*7]{>vf:x\~[b⿷ek>v?ouSz{>h\3>X;2Wv|[ v͎u;Pq;a!girdǼ{K%t]ۨm|X4}O Nv^_"oi"oiT\7F+_n*r1ӿbm>Y~BEO,)Y;dLƶz-kix6RGYXS4/6,Ÿ og$G["%r- MF3ڲa lX{Iefڛq0:KƵw[C_}, F_F6x .eV m;u*L#8m]zG2ˀseP;"3ǎepGttF7şm u,Q KX"hhf k wPuc-} FF38Y nf6\=K0U) tь&g#✩ ㏨e>#r}*]aδ$dȆ}Q4IfxF*%ad%SǙ)L8g۝ɔ1"yLO+ԩL?Q&?d66% 0Yɬ@zpτo;R-3)HmأɵSQi&αXYmcm^grmdNEY <3]xgFBq}KqCzYҒL]n ۏ%vG tظ4u;R˘xbi&d7ڙI XnGWiOE)Bް6ڒf>7aT+4٧LyopkIo^%urL3~*͎|@hhf~z)4r簣,а߷Kɀ7{oKY7hH^/M0ef(4K4x(аkxK9 *T6av(А4:43D~2LvLSϢ CD'?-ⓟ6ɝtX*ؤp=G:[~8zKihV҆ =zWF?`֑h:򠷴oؠޞ1}S-JS=)Bk lv8ه;!# R9tCwL\>Υh` Oj^DqSO mMnӆ_x j*:IgFCrU3Ϯ{r͂W-E=;ǝ^S*CG6ď۠הK zM:8GvzMBp\@!f ynQt*6>ձ:T)&ceLc.Sg )EcpCM5uє |i%Es۹*)5TLQmӑ|g8w0CQ)U>S&){3uvZ^癫0o|LH:aMG0t]yG͆C>/=C?vJPǂw)=?/{~a E] ^;Wv; 7)u^]]L?zܙ.驫26?ͻ(o;/EI͊P4z#x_zjŽ/]i@H]i8/(wx8wcڤ_ ;;__zvxw ] E3i7)^ui|Ȋ ;{"W EeE4.EdmbGϲ6Jh`BPWcANeB9+6-i=n!G)B~RnJ~B{Ґ?dېtT'r}s_xi:Q<兟|gcUAT7ÍKQKB7"Eo#eX{q|PՋNRً{#w䬳R$" A;ݑs;C& 9w(ڛb2КJs˛m3>Em.zRkۛG A!~rZ:wxp;vxٯ<ӹvI!]nR(CwMzjݳAÍH;Ft˽#m]*eG~0t|HpRC>{(z.nE>=#  uix̅k}X! "=tGz6en;E& 9xֻ> Ϻ:sv89wopbN")s^tR4L[B3~L*RHOuxh 0I((6qNZg1VIirBQGzљm0iPGzF:{soSpT#r{w,X]kWĉ!)bE.R(ac^Lz(RO?w%k6ҥ")"wPјI.^Rfo9Iϡ,n/cזzRHhT[K w'mRlWѣ_rǪKl h;8&2R(\>8]sɇ2WpÎm|nD gصM)+BZ Gl`;θST:I!hĮ$ME1d߹7+rB̊6Q8(`Nx7 RC ")ؽǣ")nE3wlQ4\8x QJ9+Rwf]lƝd WyPpV~e^o-G_J5Wuk%J}Շ'TU >)ʇn|'?g.WЫ?8*ѣ|,kJZ<~8oawgrQKY%gή@K{,B|oYY4ٙo-X-+ro-=<]?l˧S>xƸ1Kt , Njww+O_Unה]u%Q?~4c7:3m4ti7'3_y8QDË`r|(eu5(ieIbVEJALߠʨS!ZY/ЁE+cnQL+bFpe.QX+cּ ϪJ WƚW*:peuk0"3H+Xd,ʨT ܬ,X\\$ʨl*Ȇ W>pe^gC΄+"qe•MťߓXBIXFE@ e&Xƒ:e6ei⚈e,{`y]Y YVCJ- BG$#˨,H1QD,c9|*uXTC__QWݶ q(>X1wB2BXA#Sm e,;G#bYEx ["Ud!(-*!cb!pXVXF`.3wK D,+ .'niAgbYA`LwD,#Ae4|"aNe18ne$L%bYANW-VE,B̆"h\ZVP M -beDi-B%0f++b`0IO&XF$E/! NJ&:0"fR<tmbYA & URp _e=4 nLO2RQ4,YVm# @NYF!bYAT["ԓo2R\4YVPƐ0"ˈ~ J15L:Qwe YF"bYA bA4&J0-M2l4DXVPGW'^Yb^99~"#Te1eVXV騩IJE&"}L[AH"=ye++ :7J $D•LtX>iAm%{+#<5H<0T+^9Izn敕8x'xe++++6H&C++,+ųWFG d5ÛWVDq(q++,WFC\YA],ƕFǸjZ2+#JCqe\%\YA#\XFb WF|FFWMʈ|{*^YI3/+#37oʈu-^YA u救71ɼ2"^ xe:peƕq%\Y3L \/'\SG b@5غqw@]2".ʸ25?ʈ^ 6g\%lZ"= Rw&ZYa%>X2)-+cm`\YA<["Z]۸2"4peegWVPHye|yWLE^YAF"Gݱ++:peY!]•qq+H%\YApeeG~$Z5SD+M;mVTc`eeD6A4PE4TL2V@ie@.L++ `eY0{`e+ehe)KVNrʙ)+ȃ26K=]U3P)G@dX%Te3s7ǙTVլ0HV Rm5hR- 5 LM*+63oMDьQ!m t.d\b UV1*QUVUg<Hh(&VYAQ\*}gBXe4MqS C'1ibѸ`3Oҕ꿺•юUaNh•:]ĕC긢фqE++ȡ&ZYacW2Vy 9UԨU=ie\'$ZYAjuVV2K2zie\fhe\aVVL+]eٮϝJXVPZ5- ,+˸8a`YA)`Y#=e)zS%OXu$^YR++SވWդ|iũs XVֹ,:տbBIa~%`WX^^9@yXVHxb& YVX\osĄ,+ ZY%YV dY=eneЁ,+ ԑ,BdY9XeTaJ0τ++cڸ2.Xzeb]ƶIYBM$bzF,*1! *T1#؄,G{YdbR[X&V J\i04LqO!˸jdYG@,V Ȳ2Gw$#˸7XL25YVXU) dF Y}L\eÍ,7q,Ə1kZ2-uŊxN(.7kc` X%꿛Y-: fq!2jhc yv3ˊ@c-N-FN\H%hU2òp -7Zjð-㞷Qgq12&j7u}q@:-Tjȁe\j5-L,*Ԩ1r Րib=HzM,`.Ң0epeb$YZ6 @_e[b˰t?,5Xƌajtx hٖ^C˘fZ~Q3epk jdZt!WjC˶a)n2d63-OSo@ːk2e5K2.+mIeht-̲mo eXi4 k5 9Zi$l,bՐ̲-8,̲R}Ł,+GقYҤ *F%O;e0-##7e-`Ή,kGʌ,k.r# 8e 8e{odf[Z҂X؏o& HbYwM,Ne=I,Nb b8=fbPXvO ,Q,P,_4#_˰12$iLIJ2n4 9eXT+ը2-^Y 2[4j E5j 5Wem敡f_ʪL7K]ye7])xePĕaG•aVʐk׸2Va+ I+Bcfʰ0Yθ2g^YUY䕡2qy!q6ʐ8sXŃXA,Cf-XvXvL,IA,cN.2 4 )G,C @5%G2.2Tւ%eI7 fY&!SCfZ,fb|A,C2X&+e(7eTW d75d`ebY;IJ+ \5b Xֺ & 5id15f 3,c]V52T4Ȳ"7^[@ːd7efhl]eH*+e05F2'-<7C`Ck hK ߙY+f"d#5ly,aN,C2f@eXq"`Xedj2>j2ؿ# uu`ː#`VH2B(XƬ&2j b buv%2XXP-XUe[5 :evYJnZв#<~ -M_ ZZ@OHв#$% E"5jO gD-c-GSԲi^/!ie-5 Ʉ{YMԌ,cC=#i# -C6-Z(J2w{YvFM2bJ` `i d~;FA3Id,7 ,C4@RӀ22VU;,;z"`I0%nu&2Xf Q/ d1l,; de\ 0I0l?A,c;eTS#XvƂX8yXIJ$ZHbY -eMbYDEXۍ,sXM,kobYr,F$z{&ըǝIJF=PFY^2,@2 b#˒2ɍ, 2,cmi3TYv`H xex6˼2*IȲ3YvndVFaP@ahAIJ% ݾ>C˸( Zz=!|ƕYbԗpesLO#+LS+40ʸ.U%pWլxet •q >"\YE ƕѓ WFos•qA˸2T@ܸ2.}•ѭ 4Q@W)ͦoVFwYFA2n*L19CH+@&@R29tʸȰM2GֽcV*@hX3NKʸcPetj3޷ Tۆ U F=U6ɼҽʜ2jqʸd8et&Nw4SVQL9eĊq5q*])Θ9erR떋SVQW,N\ۺbq*Jir)#*݀6qD׫`Nw|)ݧ_U*9ekB7;]<ÿۑ$O)'SƤ2h246ml'{nRYe:H2F7v%RTJR<3(ʸ5k֕He Й*Y"qW&6TmaA2FzERYmgK<b@e=^vAeܣ6fK/hUlIRuu1`0ʸ?à2Fhn3F *c4*]@eܯsbQa䎏,P>)m{ ΜXSV1詚9eB&PYPYܬ2F(i3 S*cT"TYEK SF'ƨ*bPe w*/*΄*chU%dr"4+*#S2~NjJTYmfхvUVQV+bnԙ*,*S*cE2t-"QTp8O*frͽMfA~VB2SFg_Q S=e>(e๗R?5G2*#/)]FzE)L;#nL)b\(e9VG^RXWT{b}0"'eFP*,;J8IjL:SVa!Z%L2cl8,Ru)ANeTƘPs*S~%f-P7J`@eT@~pdPVuvʨhoRYn^He ~V TvTZ7'L2*<(טaPYW2*JU"`u)WB2* *X T8aQȢI?@e 7QlP#*(G3SF7P2h4AeTLК] *cȂkʨJ%PY7J@&EqW⽣#TFEԠ2pWQP)Xj5qڵ2+LY"'J&Xӳ8eƵ39e(cH2*տ$N%NC)\W P0L2F&GL*ޤ2*qʠZvIp1`Ƽ3ʨ'PYEwQq+*cr3ʨsh]@e6F^R'R)i@SF4q !(h 2;o%R]IeKP J]*C":PeT  UF*9@QdTs?kaܚUVA`V+cdQ1"K2*x VD72 h VV&A2 1 Xݿ^Z7Ub`eI3M2*BVVAZ[gX++Xvt*S#7igR'յ܃UEIKI2*~*Uk AeTdiTFŠ97դ2*WTt!E^Z1PQ0KYQѠeP ͠*4L;0HeTF0)ʨh<2IY&T4-Y2*zM*cc"e@d(Tƌ0)GLք TFAÂAeTm *cxf%"Ġ2*2 * &P%(&RYŮo"Q(jTE2j41IeTܷH*̤2*j@eLJ`'E;@eT 3n$1&VQpQq*(kP5X"QQtj _ʨXIeTTؤ2LnR(fxTFEM*"UPp TFEZ*p%T5tUFE*cVbQQqʨUEQ wT"G)TQ1M2f2xr* TFE*`@ewvʨ&R6Hedn@egUx JTFW2*~ݑ*fQ1M2*UF.jQ{ʨV+bae~K6cbQ1K2*mVY[2ʨYeTҬJEjUVj5J2*zь*bPeTTX2 &eV<yQo+Q |冗@V**/ZӿD+Ӵ2*z9M+Y~V)ۊܥE]2iheT 8z+⮥?!+Sޅ.O*5p͂ܥH_W|ʨ&\Ru}*N7ʨa\Y- fyexeTN rB0`\F+I1pe@1K2*WFA+VWFE ʨyWVq-[ZF7& ˨z&`nyY7T2*Q ,b eT "zeR(XFAv=39KˈQ5IJ;1(eT4"XFESe L,12*KI,s+ fQ0ff=Ff @0bQVS`*,)2*,ble̬2Y2 KYFd11t`Q1J2*,beT:LQ C}2*FjYzR,2*fuYFS( .[˨FpكpfMNerك")`k %xgeeYuv=(Bfn-{P3,g*Binك"iQ{r˨hkn٪0gb]! eg刜@=(B:E>S(z.{P3[tU[XVE2*Js/yMIoAfE^U٣S.SRlx=(M)=(rBltكR]c Ÿ6`yLh0AJB*e*aC15ANE^S( ] wkyMWxW4s]*b=(rʮQNwPȂ]*gyS^S(͊ҳݡkJlUEwYD![FAcV'}u+%z)7w]NY@n.ݛ tFib.岉7ˣ"E\ƻ@WN.U {H.ЕPEQΛ t9pR .p力 4cL`F^N, .Ј"2(@#j5'hP :j@=F7hD=82 >Pb'@1)@kPa#hԠ* H 4a}#FԟN$ܯ 4=HD+;A'I$N5;@с ]e74@u%^L `3ng0zR ԏ$ UϺ@!kS\(0L  Fa3Zi$u#X ! DUd1h;g$+Y^sD\9s"*C-Ap +ڇ3 DŤ#̙yEb݅%쿙@TĐ0ng@X"fQ1PIL V]{`Q1bIP (Spum(Qo"zk6jЛDEUMbQ8" .!(kK :@u; (A&HH)P * T6IP *: @M6"h(6%4 De}]fUd C!(V }f DE3^ j7 D-n@TvFLabuA3 "ȉ@~~H1T *  ;pT # D¡o@ X *QXo_3@TG3HTD ڇ CT U׽h$ CJXh.]2@I$."IѤ+q@T4 (@v!X * DE\c"@T)bILNa.u sHmmyX *n@d7me,>aXӀa$,o"'BX *Gv@AN5hD DE@,26 DA@$Fm0z@0*vb3H ]@*CH *!̡'"B4<"Q}J͢&Q1IDgi$S?aWYFQ1IH *kFL#(#$ IF-L!H *LS! 5Up Q1GD *Dܦ2"Q1MGz`j4,Nb1F@ *$\.F@i +t &-PȐa9"' U&Qa$Y_FQ1HH */@gkAD[Q}+(z @ *& DE8X(T چhᤚ 6A>]MDesEnpSQ}>[]VWPUniPEo *}W t'@ * twQ1GTsH`Hn#aX t_/^`rJPvA0HT{`*2[ R@np@.@78@T|C Ac$*5Hs#*=JP3U-@*j0R4n k@TԹo@ FFpn$@7:@z-t`qh(@,Ѝ,6d``rԫ@\ n>r(\etĭoJ D+\wBXۼ,Wn|iUCOX .>Էﵪ ;@,@ /@\:x^KRJX .}UGX .#.c}`i 1CW#*w?4 1JP6vgB thj,Ъ|ȃUQ(~{QzP*^oʥZBB.ЃUQUQ (|{U* ^o/@J{n@EdE۫UQ({QDzP**w* ^=?zWzWzWr=7rEQE8WբբO-ox=uRKzP\jQբ ~JբբO|E%na-]jQ.yu+K^-J{=(y(sϨyu+QVխDͫTKzP\jQ\jQ\VFyUEUa ZPЭ rK*דUٟVa< ZPWx2ڂ*דdR*-7)hUƓUuUnU@d+hUS? VЪ~UO@ŬUٟLx4* ^ZЪ\O@ЂV=wTӂVe ZדUiOv@Ve<ĠUO61hU'ebТ* bЪG3 AR @r#ȠU?u'3 AȠUOf@ V|2 Z#V= Zd3hQ ZI8̀`-AҞi@V? ZSVeA Zd5hUړfj*nԠE15hU's5A2ib> Zd$6V(-Qt+ ZQt+  叀|2t+Zd$9hQ![ tТG-A2 D-J}nz|2t FJ{Zd;hU`v*O4AbvЪevЪ疋 h |ЪOF[UiOfAП̀-A??,Ve<=qf ~ЪOf@VzZ ~Ъ'3 Bҟ - B?AZtV=7UO&[Uٟ @!t!t !ބ @>@~@ݾ@@>@~@ݾ"n_L nM nN nO nP nQ0ǔ tC%C(]U JwVB t%C(gJZ0 t%C(xJW_2 t&C(Jc"5t_&E(]I /hBQtD(ݭ JlBmt&E(ݿIJqRҍt4'E(IJuRҩt|'E(IJzPŞt'E(]IJw~R HPE(c "IECr2!9B PFT$G(.#  eG2 $AB) &IP$I(R$q+Iؖ$ eK2F&IBbP$IhUNW $(& Jupխȿ*!VXbЪ4X%*#CRV3Khb -7,٘%aBX0 OP'M(B&Q  e@„2 aBu04O('  eD2"qBn8LP&m$O(;' eI2$yByoP$O(2Z'I/Ę eL"&iB4LIP&$N(r}&@Iʔ eZQ҄2(hB4L`JP&9%M(fId eBU҄r4LJPn%N(ӻ')`4 E&Y҄2,hB4LXKP%M(ޒ&qI e]Є2 /qB8LKP&%N('%}20qB8cLP:&N(!'9ʼ ee2?3yB[IQ Pf&L(3E&٤ʄӤ eRj҄2q5iBۚ4MP&M(h&It܄ en„r3(aB0 NP&'L(&IID e.s29qB8̛NPV'N(' ew2B%H̤OPf'R(3)9ʼD e">@"@"@"T BY BY BY BY!BY7!BY[!BY!BY!BY!BY!BY "BY1"BYU"B*;8,K8,]8,o8,84,4,8,Ǒ8,ّ8,8,8,<,!<,3)@%gD|)d7MlJ,X~?sl6-8#v-c_~hNHiNHIMhԄlMHIXф: ]G+`9%Єor )M愔#7MH9u. MHI= i vcLZRRnaB7> )1jR( -RR)sBbޢMRRAU2UpD(@ --VBJyaPhYPH?j`5BJDB v** s/` )ZV2(k*j'(YzZjsBw ͺkڠE )(wѠznRc(^!pBcoB mޢOHkR}L )Of`qQHA}R )$->ZM -9I!%`6BK/}NRh)RHPLYl**` )eRBJ gJxJ(d%酢FRR(l~(PB*3t@!+|PL:c@!%נ $L!%:ئ!L!% IBJ`fFZ6c2B jYsH!}`Rh$6K6!6J80IFNL!m)Y։)J/F}oBBt4nEj~6Qh;,FY(MQHI$B)($(3 )uL mFB mqBiǤBiǤf)#=M dS62>))q$eB(B[')qeBz5` mb mwIShjSh{eB h83M!}aGئ/I02 Ǥ(/vBWDqdQh (, (B .I1I Rh5 )4hHUHX1)4>-b Ǥ~@ !T+W)5$E kn! {'$jȤP=#Bø\LAxBc)4}%BQ*)4ݭ6嫂"fɤ0Shlmw1Sh 86ԚO)4eOSh5M1 Ի)4VP ?*4 FZ2T*4THkoL!u_Ma0؍ R3# (Ce RMqiSh_)Li ÔMaѦРZ9qeOh&OhpD{zB?4P T=qdO%xB U,sB3Ҫ380(eN%pBa0ǜ>cO%BǠx1(4BǠJZ(4?A ocZ( o|j *% 5PK&B-oMQ(A!u8V'ߌAj >*'< OH1'STPKjszB-1'" P.O!P.!}X(2$-zfWO P/m-U% 31'Ԓ~9P19 iK)8ZBɴ%L fbN%LuGR5P3m 5әڙPK-'iLPK 8Z#$ Ph0(9PB VRR; Ř':PxBJj=Vi< ʎ'dK;PxB! )uґ@C&k sBL"GZ" )M*Q(zD²G( 8 u]@!%ܠPxBc )E6X1Rل)d ;m -660` )-6%A i: RH wzB q|- A/B"v:"Οge!{i4jZh=mf:"}h!-xB/YZO :"xB@Hꀄc,9 ZvR! i<n%&T}ҤyI_4- }I\Z9TGSh0,i-bX׹ iOZ sBߊc +EqR'@-+M:BįOv4S m7?pTíl\!N&B(pQpTíAuW=&[[ϺB܁Ҕ?WVh[? Vc 3a-VHt` i7<Nu/:XkUgRMZ+Q7 WH {dMk+t-3چp TP[VHR+J67+<.BZA0[XDBoG]8MX:Bמ֞X+Ĭ:*^`D I%P*٪V٠ iv0z.H[Mr4X!aInuao0pԆ ?+ƌQAp1ΥTEp])tQuC ?Mqc.g). XL!ui?)&d)4ռzRƣ.Ph,w3IBcY)Ph/Php]фԯQoքԯτ&tFsEr0hBZP4!FQBSPo\k愴`'М#ԋ''ԓONh&''4ON%PK>9L>9|rB-z "Z ''ԓON%PONZo cf,{B`OhV% ʅ=Yݰ'4+ fĞа TEYg0Y1&4k5Ƅf=ǘЬ(dIhV, I(ŧHB)PEJ+P ]R %Y(r-+rQR"^@E(ED3B)3J)2PʕaR #gF|jG(8BJ6PJaR #pF(0B)PJ;P aR #F(0B)߇r?PQPz  [k!P:!P:$"P,#P5#P>3ČPG$PPO%[Y%P:bk&P:k&P:t'P:}(P:(7)P)PW*PʈPdEJVuEJWEJYJ#Z4JC[4Jc\4J!wJ^ !J_J`Ja4'Jc49J#d 4KJCeBi!Bi܌!B!B"5!6BiE !vBii!Bi!YBi!Bi !VBi !Bi!Bi?!Bic!VBi#(B驎"(B{#0B#^q3B&"0BiJ#0Bin#0Bi#F0Bi#0Bُ#8B#8B!#98BE#q8Bi#@B$@B$1 CB$a@B$T!Q22E(c%Q2zbE()Q2F(C.a<E(2Q2NF(#7f2F(;a2G?a2"F(cDa2jdFȳHQ2E(#MQ2E(QQ2>E(#VV2E(ZQ2E(_Q2E(ca2\fF(ga2F3la2F(pa2.F(#uf2tF(ya2F(~a<E(cQ2JE(ӆQ2E(SQ2E(ӏQ2!E(SQ2iE(ӘQ2H(S2H(ӡ2AjH(C2H(ê<G(q2G(q2]G(2H(c2H(22I(cő2zI(ɖ2I(SΑ2 I(ґ2QJ(Sס2mJ(ۡ2J(3ࡄ<&I(䑄2mI(E eb=PC y=Pf# e~>Pf# eߒP&# e?P&# e+@$l$Pv`BuLb ecB,lU% !P7ʎXBKȫ"B eD(l&ф"P[DhBYN{4 eՆ5,&ф#PDrhBY M(KF y I0l* &m&$PhBٮbM,ϩ )HB5FRR&s MH O@44!%'IUO@ -w+愖*1/'00pBJDhB š3@URdR(li/ʠ'$BBg)BوB獏BmӈB:DI(tx(t2)H!U4)$BBhF fB *IL` )s-ƢBRZ PKV(nDnHɢPK+gTdQHx(Ԓ;45(t](DQH$$B3A:\P(tQHIB >O8 m әX:n* ,-J/Ԃ5S'{,'O[ȣEb^%O[rL -0/Ufb^(Ixy %/4B31/4B31/$Lf`^h&慒ɚ[^&/4B3r0yyJ^h&f/4B3y" /4-B39r L ļrtBI ļL?ɟJ^h&fb^h&GNyH3 14C39zC % 14'Jbh&&fI-"/_~u__^/_|YϘ_VOoN.z1vpuW^_ICzc 0=Ix?IHI$$+$j7}}h'!}Y ǯ/? }cԟ|ZS6ۼ~??8Ci~y޺ ǟ9݃[)m<7ׇƾOϜ^}URuUU:ލr~O?=kaO\e_{;}}ջ)~3BJ{hן~Wۿ= {^^?WhֽmkW^;K?znA"ڹ]=6E?=m}q?~߾kz~Zxo}̗g߾kM}Y?B?k7::k x,]\>~߮鯾粦>v;_7wq{xh:`?ڽ^/~[q;L=tƿ7_E^yƿexZwǨ\Ʋ)nn6 %=4yn~93tp>o?w:|־|ݷ0}͙u ڗ׹Az~Yy}]]6/z<ڛ:Pendstream endobj 104 0 obj << /Filter /FlateDecode /Length 37637 >> stream x[%Iz'  XyH2` 鋞I&)ow/"2kWw5Iپ0^232#𝞿~9~϶,_??uFRzmǑ?|õp]7?uozlecJy=^_Is޶)kS~z_Ͼk|;o[n_\_~Osvu=/o_rxw_}̭)/+ܶl/_7خp۶חoMHq~~Mi+g}K{GÅ֮+p~q;O^ߒ{w\N:~?|^^o쏬/¥~=h楤Z{[?oyr-qU\./l 0})>˻ F~^}֘G|mhI[?|:s^Ӷղhc|~R oߩ8'@0>Nn甮ט5}=u3i}W4ќ16G+}O,լ{m5]R<|tk_?kjgpǿBIg_ϫ{ ~}_`o-[1~+=;qO|Ds*}+#A_4/lzC!}Bu]~?)[y}Y(יSZAo*Tik/y\!/|>/}csjdǴC %%E_XվopoÉ>߅o=?15=yguľ8ˑZG͏}JᴿEur8m2."[W?s>޾#A;FMx|dE߯h\}?qYZv TӇ۾,ȯ~|fÆuz︷;is\O]osRW}Rn_]\knн7&]}{ܻo.ogX|mK/2Ӗ?IJx&kݣOskx?|](glM7BI}X?3)}NW>~c3fv灷R;y<XS߽WN}ep?>FuOn̦[gߥ/|ص-tƱ`9Ox?Wg,JD*_ }U1CZZbZ|/7ΗPf>J}+an??a{o_6?}c:|fYGVc{o}j{weG9ݧqbn+>|欽}a>]j`||*{,ֻjGSa<~kxmݼֳw>oI-IjZT{W2օ>^Z^<ǽcg ;a<#W7:|ee7M}#GKvnuNw#EJƬ6/{ߒt܅/nZ}../91|ڎM'_L/;dOd{͸+,'^_}e:zř;s{yc+7TВ/:][Uo󛵓F۷n:\QDo>yoa?ǑH ￅ=&.6{/t_~N7}>GoSF>Y.jhG_^~~k~ і;_R_w3xvFxӏE_s/? _z.6*K3zNcMu[V¿&v+x,ؿn IVNV̻6Bkpݳpǿc}X`Ӏxn^Ƃnl%l~c'Tr['>ڼ^}YgR  wԇxHjNQsp!$<-fzMjzKr/5L5bsZ`uG>Ү/Ycx3[mXVqmwV`͏˴n/h~aoe4>i V}[&`tu8/_2drz: 1>/ۛއoc9>ϢZ}:*3?פ wReo/Ώo9h~|_Ώo߼q`1?~;?Eq48݋8ߟ?v~a9E 廭zXS7mzd<6?8FPq9q4|I|XΤOO9/NW#b_| qTnn~|Q7/c^߾{w^޻}‹vn9޿tEtxi5q-a-OjLS]}~|wZ͏ux{ks$.1:*;~lk+^w${#wҗݑE㫫vv1aδyݷ;W_-?>t\Zaੵ9)#>ηo,Fkr6'c?kBEFHΈ{7c[[2=}ӣd^xG9Q3%㹿ʻoR^-! ''V"O TlGy%?7Br^ܭ+ꏼ*{~C;+o~*xю'޸ys,X͟in FŽA <>\M/Z΂L!gvbqEio8N^Y>۷em(^na_}lWg<7#Dw[<41D.yo٘at-.=G, ƌN#g>7,is} `w}g>\;S%}؛ཌྷ?i|~=G0KcH$O -gƖ4e ?R9o1=?otkZ1|6 tI>F|Waؘwn]]ެ5[z'qW?|(}\E^L9ވ\# t, 7ח4ooBs_?'~>/)ldH_:K?zI~m_>ae2W+[K;9.{ig<~ʸM~۷ɽNz=4msǏI_ "bO \mx5h}ֶ>g&ڏ}?͏}XYmSٹJׇޮ(s&?~˺w ‰HT Pm7{&A 5(5RZ١ѳPi])зQWَ>CJŧ}Wo%!/%!ʅӞRK)wAP0PجBAd@W &WOJ.~7}h͎#AUf4s52CЖKgzù 6]ذ_w4Ʉ:ӾAml.dC_Tp9pn:7T{CD~'!h>~|гO{;#5COW:hw_݉#Nq6P߸z~JA_n`GG.7qvw-)CʎKGD!f/){?5h"?qJzCCDR-R$>v!9 ztjgAu?w`ԑϢ` }s>s" '{ᅓÐ0J$FxLAPFo giT וqʉYunaZ=&+gt~ևTfg 'Zqgzkp޸ ;gY_I@j$l(. 8yz`s< CJDI':77O>TrbEPjOz:q~%]N.FٽW/0#…8pPԫ|N}hJf]W`Cs 6әܗQgyi J$dT=h7tnn7ΝN;0 :r;p.h"΃>.R vlh8ކ$ygg{Zur?O6b84$2"zkrD5:r骍~d1++ثv!Bqy<[* ]9k_iagW>Uu H8kkGsﵚKǴDԟ/O_$,MQyM]ݏY9;͓~WhSύXSB']ߩsV g8d.|^_&h٧{'E…FKX_eL]ܕ[]8(E6Tt strsە]`=O#Մ?|38Y+fTeјϠΝR<* $]I a;rO뷮69Uw %LP.pa0G잰5]pϰY#-޵?ߦeF`WCZƪ':bAm&ST>bkЕ_fGaƮW89:%ģϰgߕ"i^ffQ]{anl6aMϽ3gaFK]M+6t䓂!_/36Ca[̺@2'ݰI졻:3\I> ;b Kob;u?lpT @m |X|G)v7d wzN;\>c 9/vTrb39Oߡ>:^GwޓLSn5ðu;f]R<`c!#\'rr/a)JcK|)&~ zh[ҏ>Zc_}Q> ӑG9PDQ=~ٛ_+=6 EՋ2l@·=KZl ̕A[xN%bo9Üg MgƒǹSbK F&,JNܠ$Rh=a9R~(*QFٖ W#|Ɇk3W7fXdGǁQ.XM{˚N 1$atI['&]^}+ EbMwT#"ØmHvh/8{Y&AeifƉ tzQX|SqtUAp9Ϩ3 GO?sphۥpӕQz (gK=]AF1 {; <M 3bgzJS2+^UڕBWiW 8H2FŚE=N~,_5Ef ,Maa$o ttrqv s^3G.*6NzJ{~LJ,LV*Qo66|OqG/JsڽEKR5ζ -1rx}!]bkS5h+m*=\@Kh\5vIw(//pFSlijlιVК}xpy{ultro96+pcinWC87ߥS *]SgI3leIѡ .a8pcGA>5)MҡSTi!l5դB7)]nv+^]x=xY5),w=1HB')a`ҩ婨!aa 7sCEۭ,[80-j;NJ+!1ÿ^u*oun77nꟋiZ.n喏SUJi܊zhUtmx L M>-qn1gun.{8v_-t㜉ҥoqxu]^|fzJ}i)pb$ZߗuxN\,.oojx{ϝ^:rc8wIQ?sxׯpuF8+ݤˬXΙ嬻f1v:'Ζ4ߏYl. l3\ :=kwcs-{yf v1w_ ?wxdXV Wt.$DSָҥ~G.VKY,W^īr||j#Ȱ"+(9UUzX]^ekgOj,hc]xzX:Eik^u-JczŋXƘ.- H53\MN:HUu<̯e:Vs:f .vemp~6[Xt.Xz6q[6Iuz^6cݏ]CѲg%huѹzah[H2ktى»n՚h[va]o.;cxׯu :f)?H}zesûjfPwHB9/8ױܙ 81F=%]tb)otZS<z2fԓ^rSOzIlk9j؈evz6GastD9jXj-2G \Ojo0F'baNŚGX^-~ 4 —F{0퐽tဣpYt('%9I%:I1%9Iu6;l-G:ͮ-G:MMk|x\tXnbx91Okr+N3|XNtLu#G:mt\?퐏tuǷC>i[ iׇ{+io=NyI r'C%~8۱*t3%Gx!5='gU9JU9J59JuLv&G1p)uEvb/0\S]t"Opq1.puE*c(CV,GpuE+c_puE^,[t`/i <1,n7 AϮKNz]ܦ 84\}4ܯ SWmW&N/i8z"w+]t /p)#ٖKv&pM3p_wE ^_p\p<)=.MEs9olQ:" G"#Ҁ!PFE08 %)f4(,q;k(b b#`ߊi_T#B`SA;PKGG4H!`$f'aLZ]"NJ*rFPJ6RMD-]tĿEЌ|#vGM.pM &S[DŽ?z |#`χ9D14sDlQF>FE$%Z+r.9IG;GdTw=U[ x.1X d`Tix\d^{)F\b qc]Ɋ 2F2z/  |ދ mf#OpZpTE@]iS[)u_ :G_V- @2x/7 %,2x/ ̋Ȁ_FEbW&]t?"ٕP20KĤ#d3KP]-sl&5t2 #ڈ]tvPlil7?a'ޖpY#jl@?nr[ZGe;GBf4|iKpZ-`zݗ㒵~A%+4z.+\Xҏ.< v]tFc3qͬ$of7]vx!u+#T+ dwp0j? m g.g#7%,D~Q9(X3j?b|ґPf~ VzޗŴ%09#=ʾ00aG*xH T0hM`#1iE]9rCܒHaGs[]%N6aTKBJXVr¬,<--Y9hfFH2JG*NW':vґ -i?LbC#3ynGY w-ELCjHAM#Mꀨet3%lxM1+0/UL,̽bn/Y?DfH*%͋)xT#i{YŘy-d̞גrƜK4e"d1w#ױ1%Ѵ)ZR~1zKZ_WQ:RrFz j"Lڋ,C呉ȜޜlŮ8 ]pB6osFiE2}tN2Oy_:L+,MH3429XJ##)ǒ4ʤ5ʶPδMe9]qZi2uivFlA:J#Vkm+J[FGR/K$v3Lf0td`ؙY.v,]QV/JGFxWU: |,]|uL#;*쨯Źdxدd$#td˗)tdʎrZ\FR~) ?#ے%,u m4PAWU:*tEYQԠ~A$6BoT:'tIBَ$ CPCA:CWS:=Z&DWS:Fxk[JKa(?Q`c%(Q%2]QV(uQfg)(Q֒E5pQx~Kq7;KI~GAzK(t)04bB |V.&Rhzz#]]$0FډtډkUO rU5RœRUQߗk2J)e ݒڍPЦpKWSKM9TN`FRS-GˢRVRig3yMO;X(C_)E9(db vqUJW$ϕTaPJ*Y_?*)ŸvQQQN)FJm/, /쮝Rj䮔R?;LA:RpJ)KAS8WsWw^0!ikCiPNebPְz(EYCw*ô71Ј)؅yu)#&*ծO;<K.%Bq3JOEEYf"jWU)!+*EMmEa+ՔUyQV);*uVWn*E)JwUwUz*JRV)&$M5)lGGœUnpiUJOSQZ)5jVZ) hM8Bɴު%OMiS{y?;֦/uY ъ:L9~H^w:L +d'-sO+ڌz]JEL1/k/;:(h|h'ݥqT.l.XBQB:ۍ&\Rс/K(ݥT|?+ݥ̻gM'[JŝreSPƭRy/*Z^y+nqcACBo) mHRp"!cS[4췭g[(RB*/t+_FU (2ݥTԭhxX g};T tR.9 P,2tBwY._ ZAE#Qѻ 7m#M?6#zjucSE rОa=R4 ]>B4$hh'TFÎIT=zKhNj ~\IY˨JEkv]JET:R  lGtR* .Q5z{1^O)zrl1$hVhR*2:s…> [Q+Gb3gjK.NvIّxrϽ]CfS%K:UJөr:6 ;=v*Ǧy%*\rŽ#aSRo '꣇=R0Sn {QÑstRVh-Itv,й+^U8{qTM ;LUBs8ÛqJr{<:^+6;yriz z9MψړS$ݽSNSGSN")]O4"":j%"g A7t U.S U>S( } )z26J48#i %YtU4uG:")pi(INS(zstU.i "d9MWENS(rtU4]"kʒVP5]yMeOStU6@ԎP)ܦr!g*r.))fGN:9MFCtU4]kP4]*骔Rǣ4]9MWe6i*&y9MW|v"sMɣB*k*.JtUʣpɳRGˋN"]nUt6]CnUɏnZMWEnUiϖtܦr9;)_r1\E]AXgk}kyvj(c'ir_qZLoIwEnEIۣp_9rFB{aY/h6%Fxe)W@3L4phPFD3O|D4KQՈh-!WEf 7hF_"ڮhPgFHHu)+,!ލҌ(7BH3bDz2,UA2ҌTxD3iD4K@iB 4#&;, Ey"͌ì3KJ@)I;hfd &Tl>Fe& ,5eFxN#Bj e9 _b%MRˌ"Mf%[c5ˌh#Ff,T#"Xf&%YBXLZTJRB(ügeXeJW,Nbbf}'Nj}d,T#-XfDL(B% p-RBA2#r.ȻrP.Qb4-)YӘdjd,U YB0`dPTx6R̓T'A_ T YB.F n TwfBa4^9f!:8fd=%YB ]_Ľƌ?VY>,:Ƙ%Wih*Uj7,f)T#<0flƘ%k7,!ވ-aRpVk0Ƭ?tE~0ŋ4,!_!f f b-oC2 1+YW6)0KHS,1B+_F=!647aء]f|F,ixBqhШfYB yZB%HC^]8,i,bdY ڒe4rԊ3ZBbȉ YT-(f~YF#iBNϚ[:S*3mj(f ?ebF1ㄡ!J"u|SkCD܊BN( j f43b@-E&fB܄qZ4M:Fk` 1|M,!sKo!fȵxkl@r̀%䃹 b`Q0Kk,!"1̸.aKR+]ZiӢ.e"&j~:INn 2nEM2K qD2@4B}D2HM2Ksʌ)w c%L=st`̸sI2Kʟ {"i%Yb°nHfEu̸4FM$3(S<]_mEMƌJZ]j1V.1.w% )'T3*f]cAfT[v 6@fT Ȍ dFAnjfLmTTG(3* eFE(rStU2[,zr lmęD7BERכ%zC2C'`2ӟ׬O 3 bGd̨h|4lk"?\IfTD4ɌZK2 Qf|5T(3>&Ie7,d6YB̖7(3͗ ofPfe Fql1YM(3?Fe1J-7ˌ㘑^~ϱNcYfYf3 "ˌêqgbq r٩un(ߪnxӻD2$ZD2D$nLvdPU@uM2㴥r&qj3{M$3N.G$3NJ[$3Np:>晿M$3N>Pf475+,G{^_̸0O(3.;T(3ڛ2F,3.z|U>{Xfc5e[& eUZRÅ2JNO(ZFqh.Pf\W%מhq}@ FqA,3.}X̸kfYb] 7\ɛEWBgeBa2„1̸ǩu̸[r 37T03nĽ93I=0q wn`fܣ0*`ō#C]=uh 2L﹟׏2F`tn ^ e&[ żKF)XurhhW2K@o>2HoQfh3ʌf*ք2Fhp(U s]Y3ўg,.03DfF+h=iaOir֣if4io{J03:4ofF)s\aiOi91vSjj%OeFSD J[W8Jc5͌M3~۠`Zu}g YJhkvj6hfk7͌5;JkFE3KHaM;3@cqfhk3CFƎa<3m@3d{]ehBUhnL4N^ofضkD3l 2 yہAl@ P 4C@mAv8f؃k R|  f!t23ͰL32׏4C~F@a7-@ ͰwL3)L3Nag64CYr]fȓCHAwHA Y c@=u4^br1f>fN@:hV\pJcl`h6Q44۝ДLh"*uQf|APΨ?'S,1匁 按r՛rHȃ %;>:{)g[]7K3FVT B8e#J#(h` gy !gTi"伅є3\ Lj(gTt\2M!j(g3$(g95ErFE”36EY~rƄCl-1gee2A2 sQ|_1gT0c ;0g挊f/cXnO3&~#sa2N3*&s\QpLi(:(g)2O3&hmH9IorX`} Ew˔3M9˰GQnâvSt\AΨ'L=7VZqF,1Θߌ :7 g 뒅Ռ̲_1Ψ+rjޖvELKRW3㌊̲b1Le3ΨhUaL\,Jz:rc13er]1Ȭ3*uOES uFwB qLSj-gJ:c }E1E0BeȨ3*u:2PK3*pua:"QgP<)D%9VA9X3zN!pY36OT#)&sFŰ6Pɜ3FuQx-”)g3;(g?6M3*+F ]Q9t` T #䌁U䌊.X3 ngqFeq8bgL )sڴb^gc^$39Nd=91 w pFŷ\3*N)3/G3*i&QcτLX")u>(d3D8A8bPgT,xpF80Ψ+&D8cbM!&ԊK̆; gLTP7lf.䌊pQv?+G㌕=݌3*߉q1r+ S ㌊"b|ܦP6 !Θ3y B͜`Qfo:Q2O7" 9q٘3*6œQ1M#9bҜ0gT9b1gx1AПr"EH#T?^^#Ψ?ibx \6"qFEogTN+Bψ3*:gtQ(adENS( 8c $QΨFJkJbڛg7?1CN3*f pF%Y4mLpvSNw.l tI "a A,*] Af77KW1p"w)NKWf*Xn9ܥ"MB߆KWEEQM)_*. f7AUA"a(9LWUtQ7)ytP1]pU91]yLW4yLEpKpr>Z.٪(e*r즂 f7a\p"T 7)EnjMi"M=OEnUtQ7)O 7)'g7)֧"WGinJdNz6}wT7)N:]訆'.NI"\ie M9=pU:].Nz6:t*-=V+ώڜv(;f7yE6"M)^LkP;]nJpr5@(K 7)K 7)Gݔ<clf"M) nvSG52pr>f7EU9P5l:p>tVEpRTpr=-f7e<-nܧ"M)Uf7Pc!`M nJ}tTnB~SnXn*OW|tTVEpUnlf"M)~jM~jMɏuf7z 7[Tppf7fr_znvSZpkUn褂݄XnvSc`MRB ?EuB#^Tx"CŖAS%RAF"S( Uug(A*3)qZUQ{ヨfd|Yb">c;}J1-H-ى *o~6@l i BdbB,lBTjaѩD?e`ATD1>%0> DE=(=fAT|LJ *ۊbA).O lozPN Ӄ[D!$+jU!*YQ P FB,eSXQ[! &4UłQj.9.BTLqj.EpX[,X#DEO *??Dۂj[  >5AA3;d5;Rjofd5c`:EIjGܩ`5WV젶Ǎ vjK-;5vuԂ83A(3?Ac2<.r j!1D7ex/Ã~\A-"APtwjm APԫZ`q Bv}  (A x -H (f$% c~C ??U1@~ZU1"B1@ Rǘ E*B AI+AUᚂ EȎ p8&AQMA"H!BVSbB`BPNcbBMķB,j[ !T2BoBP 42B?+1uţ2Cv@Mc ;!PF3ț`Aq6Ch!S BPt"EkÀPG!(F".{!hccdL!(F#4jFW`rc"8 v-]e`cʘd#!F$"4JPrmPCŘl4ePL(Q h!v+(B,>0BPPT?!րљL%B͢S$E ӑ_$7=f$4ZHh< {e?(&3@B +R[I& AQ j,L 5<&Hv `nWGo#Vtp[GJB 9BP<4GB],1= MiY91R1E)Bv"j!L -#Ԏ Fh!(9].0dۂ(B1FMyj P$mbb%PB Qy0h DD!( !ԤjVbݪCBPT=3B%;BM5&CQ,B7; BPT) Bs".V⯈!Aς!E婂!SBPT/B,US!4!4B BMޖ#`W !LCg-nBc X +ozj5++BGT@#] Vn 4BqS⒝7K1M#FMkO hԮJ!>֖R07bq}!fbPVCX`A2 [mbikD B|,̼Puˍ(ZU4DOUGC(FnB,S7 Y3CO1Lț86o"QoJ%  b8t12]u5beԒJVʽ PӮP* PF`U3xc5!İR3ChChBw-Bf1&\ -R =3.o`Cbr#"1BWrYzmh4"sGOP115IL[p47Rp]gs47@s+4ù[5D- Z S"4 S!ƟB̖4H !faj(6CPlm:=SR5!4s]!įjb0CQ"A%%MbYI*o5"i.1wK!q()BL7{Hf!fF$SQ3D)[1߀%AX!@ bb ƆN)h06Cc[bHAHb؄yTbeD3j06C.2X%=!P+b f b)lEܨHb@rYDqa%bC\0XSECB,͢ !s1F Y&B.t1b&nB,m !1I !Xlf!2=P C+V ZFU"&AD"bXwp-kp+Hf  8`%{! ĪWMEMZW"XSp)\k 5XSp)կ\j *~ ^q/¸`f*(|  Z9FA~E_tXA@|  Z9Da4VUhbF*磭-@]PtoyA=*6*{4h@.*[-y-@ "-Zy>aW7 hڽbǽ ryNEs[[4#AEs\y: h? 7LYկZ Þ? ^hi?Up޻Y?o~Aq׋E5g ,BytAc~޻`@~!J{c5*C0gʭBe}}^"{cB,B ww,BOAY|S3}',B}4E㉘3|,ueR ,BYFQ/99=Cv"E8s=oc{WAY>'g F,zɁ왂=P0x=pLE0X=P ,BY00=S0g0=P=0=rzʁ療<|Di"tg 3 A. DSŦpZg:63L'Jy%<3<_3<<<<=bxÃ=I03LbF !jIA߈Vxb$PxڽeD)A"I#"x;)~6il $t&D `˔Lx9bO`Wh$<߇FxLϴfZ j#gfs/BxLU1Bxfh@W$L4F ҧ$vþM$"Ħ7K6i% 7/W:<Ӗfiib:<(OA" IKUrx&^L;A H 9yWrx!$zDÊ@ץHA<$$vnh@$(#hLعdM$_(%i'8Rnz*xP@YZ[7lRvغD$xuI<Ŕx]') #Irx:Q)rDo%RfE$vMձS-I`IK9<$8J'}iቄlYҒ !<1 t`\D+m4bDzqqOzDxb9!<'=Z@,oyzęͪs16j=x˫#Xq$B<1F3MC'ˈrϥ≄G .O̭Ec+] !HD9zvKtxjDHؐkCytxj$p9q-'/txj/DŽOMck p !~≄xbrB<hXUrDf`yp(t4]HNi=\@W9H<1(Nlz)QO $M}j[ x:FE_9k6)cVE>k<)4k}Û`FKEX); ,*2Q1R<5OC,65\IԈ+S<1R_>ҡ)X-St:5k K95kU9bVO2qq<(?+gfȕ?ǃftX=O^q<WAǃ .x0NTu񠐥63sUHHɑoG]8KHDǃC7ê43sjU fOT]= !1S<}?x*xYuB{5lO'q'~j<٬o'Sɖxr,@r<9: 9OH'ƓC xrA<9!A *Ǔ xrCz<9"=I$Ɠ&ɉxrfEb<9"1}OH#4)i$xrXGZ<9#-OI'$ƓF!$x4*yԺٵ~ $64, #ƃ`{`bYsU;O "gL6:,$y<W|dxЫ{g"qUOt>(1987S6XZxDJxlJ6S_ HR]$x*ƃ,!y S)$_óE>njg NMTAWRgGg a23OD*UzϫW_5/(R<^C ??yx6}_k{x0~?>|\au~E6o. e~['Iu+"u+Q$b_=pcm?C!}{?&Tm[Oo9F{G߿w\pcX?C:?Kp^۷Wvh_z x<^^6G"'yuR?ggg_ _~v b|5*b>Ao۷>M~{o?|󼿾O+c>~#Za֟|/W߾EP~٦8w}wtyUW8-o%ޗ^&Lxc|. s%iގ_S{ oz>ICpK|~?6MC/Xmw| G!2bxZ[|g\nC~1>~fKE/|t8':+.L;,Wo}9c_<};c<zy:*ϟ;ŏͻ?ŧK[}?Ws?F|Wr^endstream endobj 105 0 obj << /Filter /FlateDecode /Length 21824 >> stream x]-qc`.f1\ߩo @٦MM;7>2#wa {VUeUVFTۗq\o>?O|^nW߼ϴEN/? __|O_Oף9z%֏;G}O`^WW}uz7_.׷_~SԠӤ}'G/짯u4Qf?)(tz G+N䚳I'B߻A 1ȭ',. _j,+]˛N̶9_[{-7r/!v+yҫk|hZz+~6.m1u&)2`#߫7?6_~#}%6UJ*qk\U{U)8<_rD5w*{dM}w9{<=s GڼRm?S˝qBzxɾR~n4wsL}ǺsyGtQB_𥺨O<&-2?=ݏFB|%{Cyܭs L>ӡj>2mMSq߸}u^{GXݟXyW3]JcR5Go1Ow}6p;}c*7񦮩~S~`֯\=}w4S_ O#͈ͨw]c-t)*&=}/={cR ū}W =D;䥼}?퇆r~e퍭ųy7iп&etn5Nj|8ZՇ:/wzO).Ɲ޿7U>O:~vLv)hx/Q\2e%{ps<]$ўNuk\Q76 +o͢qh" AFB&wB]R;@ Om_5qz]yDWG9TZΰP52]2%`+z ;E}zIJIVOR32۟<_R,R_"{a/=|f_id\uk(N;9y穠=% h*uߴ?Yxi_C;؜iwh?>_GCIOt]s>tngnxP~L.y4\gG ?©ݢܲ_gIr6L;'Rq\?>O~WO[I]#okr׻~N@W jۛ䘠;X%F jEѷϿvwnܶQ]k;nK}`k`".Q}|-5xs/?a2?0e-NG?oʵG_2]ַB^zi9D/ߕVFf^ϸCNDtǛ q~YpO C@N7uT;u{|޾߳YcL#Oj2X6wIh װ&h%1g\mE? ]w{^:QUBtuva$4_]ƻ4DH&MݕXW{Tqy4||%7:`\9׻77vUK8Џ4LɟR#~|wH^?\oD?usJ;Sx٣Lu%]럽?/Щ݇O~wx?{^7hߘ~0 M~2iS Ud-K6+qQ GNP0 & (eBE~u pnnQ8WDN(Ǭ%7b<*J”() WzC@ɥkq*+qt|r'.)JMLBҥe r6. ծVI'RƨRhDSXic\n*_IRh҄ʷjRn䲻P;kJ/h]Tqñq @WЛp[zߪCp1s[3`NG;4n3RܡwV.|RG;}kUg .pX+­ .1 L(XAKo0fVܨƢ!JCB[)!xU!-٤֕[d:T4RdkR2VйdzRОZqUGo+׮ҮYΙ R=st\oV*LRtIR:wҚ TGy3 D\C\C7ڎTXvUshН[eD; JR#0^jҔvc@%uX [qR.;H H)Ӷ鉻i6pph 8)< i{l3ImFfc A×hrN$ =#ysJBv' )4N(ymC#?ym31Fr6lt8Fd]3]lۄSB2D\tL7fqpwQPAJJN]Oy݂}>vaDMJG|iZqH:t5[{ :6沛%XI%"'cNK%dt6: 'V@OtZ*`Xv(4 '~SZEwN]1%d6ZddCC&MRx܃BZGƩs6EJecq=j_~Ca )m;?^R:G\&Wn,( 씞<('%!`&XKoMɄvj1M#,7:<4rq({^h.J/drv_EefC@`LW?ԬpQJO{ ^7?F'HG)UrЫ\h'H4a$< ՎME:ɱ"# H7A.869ACp8!M!vgV. =y.c"h6rZr|DD'QWapp7dǔܠ^HUrv/ x AP.z ^r]P-pXdC-Vȃ Wˠ* 'a2mg0ưCe~BHHX}IItǪ $ cde88^/E(Hv¥qKJJ[ײrkH)z9uܥQv"zXAJՔџ[o5Fs:Tgxg#ط nN_2Ǿ׭LW3.FI ".,<Rnye%eQw>K7&d X\4(3%h(.7R>͙P.R/} yf ޛ cj`"4 $}B =! F XPcOv9JT<`SؽHb)Ym­Gho85ǡ΋ФխI-x80pf[9)rkFW*6.Ml.BƍF7HFVg dMJCkiR"w |h'iv4Ԏ$ǡpdX4^wR59F^,Pf{; O)uPfliD!ehBc4=)]ouc@0:“Li5 ϯCb?.5+rOJI4\xY!]mrҐ釄WԂ'ˎ('{#~i''*^0Ic".^ n7EiTDix](I;6`>~`>1m +Ѥ+Vag }!a¼ u+fbҝ[jG鎽JW|W޹bxLlLf}CJ(!]ʁþ%%x8[ƌOlIC=oeGqHJw}eY*;W&97l &|:JNj%$vJ$)4wLRdqÒu즄|wa̸=7>H;[Nz?~lzl_L:%[3\{\mh%=} W[pk.w]t z8űEr4q(. ooܩߑ,uF{2ްGbԽf{Sly\?2nV?yQ,us 3pCB@ǨlyQayQLEQ(u-?9ɌN鞶LM~qgFO2fF/2fpLl٪1n 1LD9/gDԚ9lϮd*j&]ZtcOfMtOK|5Nk:ϓyM/-67ktbiRtؤk&u&qIdL Yt']a?y]XL,Yڽfgth"&EL=3w&=UL5>x{~VH<$'?wM,m&6 ft EH?1XØ],s!B` r)sE=<z_fNHwg&wt{@sI||]b.+1Iݔ %E˶xK-2%Y>FxfWtYqG w2ux#E| )bR$]u7Ijs2w2fR$]u@C5WIY);'ʰ׹j2u$R&]KM&]5PC>z骓ᓮZ8IWV- {1JW}XFe$!ˈ&\%5f:*C#KyaUΖ-#! }dW:nW\}ɽ+Fͩ[ VIatR _3uϮ86'<9uvKw-)l*\4| l:a;Tn]_i/Oɓz^` zM-X3xR/AeN`QQyH\Bbo lzQ/1EB%g_q{Ne8laK {^/O/xW >^HG{Ny/L6@ g6@Z嚡;3p.3;NHתW!i!/iVyzv+vRR))Bm-CPo{^Rz; #좕Itd^` 5vqSℑƎ"qz MWF,a=p^.b 聳JB([ G|  Kh ˀ|_ wUzl,^jةLjy!-4I0b.x5ף\a_Ö[Vl!\Q>u*e߱ĸ\QZK>{ϸňa+&!Wxc}Ơ\_9e!(rEAz\4?\B;Ȝ1g!&9=v_+1T!ŘE_!&7˽0bL]-k0C[–S2XbLa~1-l%ǴVz 0CPn5?uĴ-Q[=Bj /;ޕ~Ǩ7[o1-l]I'+m*=4~G3FeXرĨfQ ,a3~x[25g8bkcȕ\bXFDh,j#BXF!DpC䊆pT/)H/)FeWifpz.:\PQ1/AtUB~ǠBS2jb[GAqvt1{2|ܔYcL;:+q)gǯ}ǘ<c#ncL%b2*BZpSok|4Q [g QҤQJ~G`Ę zc2bKk9!LAGk1(6bN:(5CL />;fsQH1$cvlLĩX!+CrAم$~Br<B2 !$PB$I7 G\C#\!pԜBRXңX` +䂅رLB!=9! %t@qS18i)dT =t@fȓ <*Z$ 1/ᰣ=pIGwVE9w8!,ً8tA>S"?.f LXx3!S*wBVHB a}Kp4CX.wr9#\&tA=~\:6!*qCx+vApVBP.0G8j hi!-$qdI(A 11b2 \`o`% I +}}VX\P_y>G,QStH +{C+9:x$D +< Kp;}W`Җ[Ң}GBJ!$;}W҈]1}G8nɌ]W3w$@,?x!$`,5_Ѿ+]ᒲp;wBJNѾ#!Ƕ2W35EJ-~ %v?X!'9wUm%wn8H]'eZhX! L.>G.?8!'RsOMѾ+vAz A4 y!'&я8}W:b3wnpvCk Kg}W94Ѿ#!w$D i=K][}W9%G`x 1hߑЏƖh5wmѾ+E A CKy 9Gsh,qѾ+( 3w$D+wu!( 9a 5\Q/]g7ei1SH}];Ѿ+(# 1ݐ (Ѿ+; 1h%whk }]zV0hߑPҢ}W5|Ghߑ;}W토!Al܎ƎhX!(6;}W톻o7DvEh↙ brHhߑo74CTF%o-E M)@P7ޑݻo7Dexau ݻ톦 Ƕޕ֢{Wu!*ܻ"␁ݻk7Gޕ6{W` :Gt CLn3mѽ+vCb ̥%ѽ+pvCLFqhk{WP37GMѽ`a|pvC[y{bZstxz_/:!kCHst VǶޑPbHB{M )VޑЏ,7YRѽ#!w;dغ!%JGѽ+u}H #'%'] Km^ad+b ReI22j)n+9~2_5WzA zK@5ɶO_&F{ƫ-kQ'if){O s" RljL~ˀK ׂgKڴ >~*Xsw\ 5} /;+1B%3c&@ ?E[[. )bh,$rl_iPFYYos lu{ཊ>:(5Qd&Ӧsx[dTtS^DٱP B6n.MD/,Qڹ,GRq6ȟΔ΋Q6<0E`BD+ɱ^xі~K7am"ziRA蜻*"#6 `RfRB ":f(]lίH7JMWXBDǛBʅ^P, _۫*Y$[.<,BӚ :O&D K ؑ)@t+='.@5Ky\ D/XO%T+PBӹ6΀^,+윫sسgiK^.: z*D/^0)\xk)؇"#.~ҹL`1 ΅:ƣV:r6Ahgn WP-ۢ{!a@Cg4W^`Vp:`!ޅ_6C]xlٜv ,šX8t\" š"TaȝַCC Aq(^p|Ɗ:J Co:)Bpb/BұxV9,VW VKK:p4(^/ĕa킴af+]`lg @Ia"pmOTs.a[VP',Ύ g=dB/(tf ]j6b^VKZ$!E/:) 0[hBPQ}Υ>lE&\S,4{[,t8( 0C%,taQza܇2̹ާ0[,,¯5Ζ<0B/I֓-:C7ߪ>t8T:^@ = }C/is…Ʋ JC/@JLG ri^FXFesr INJGڟUs!_:[FGOw  CJtO:b  ʞ)\`ȥхlٱV: ˑeۆc} CreLy4ܔe4tb+]h0~FCǚ^%o+ o+]`0z/e =pazхθk% X+ѳ,z@t$ʊsW :[AD/^H :@t,MSC+QѱWp+ $! )H@C/ɢ d}Y4tP 8t,!px}p0fC/e8t^fsC/mQ C/Cɢ4C:iy-moU˰(j8t`nb7Bl+Ҥ£TdбbVWy6^HCUU:T+H^ϫ Y[CZ3z"" 8~.< p6:mʰ`Б =_2-$z)Dw藘' V$zjDgKHBC$HhCn.<xV]ՂDOizHt|5Ex.HtXsID#!y~I)絍`Q*\k[Ht|!]%*Ecr,EK(BG s{D.r`HtXJ;>NvDtJz8F1n./@tt1y4Jv@t}P :?%+HB 2 :s U{Q}%#BhӎD2ֶ}83TXxطt˔UZo ^Q4?}/kDB@%󛺞_bIIet.0 zJ; ˰R#dݞ3: _̀BD߿fDt1<^0S2ѹ|^%Dt)":+HYr,%e7k˧0# P|P摬*>(褂8%ibҏdU^2|Pʑ(>(HV|6]AGʦx">(Hq$J:TPNQV|POq]yAIOAG# Pl|PƑ(8>(訊J?:"̏8䃒4@AiGy0F>$q$@J:b8yO>((~dʔJzB9+%ARb75|PF08{A2㴕aRbfGl惒ϖ l>(=fRb75|PFL9njyx>(%&@8.~>(=f胒c&` >(ʡJ10}PteĤpAI10 }Pz Ia%LAxp%UAi106WN861_5>WPCi+BJqҏ^(>-Fʼc`ԳE;AA)1 0j}PFLW[gUr}^Ij6뽒Aga+Y ch+Ye>rxJ>oU;(jX{cU}^jpXoX qc5}PU1A8( +-z+X cU~ A9{8);KC ޛ됚¼yzƘ5~u{gz 3ޛKdJ&#xoC⽹ӽ6C;н^BZ{g< 7Wzz{gW̴нLWNн3nc,XC]-pHNlk77<@%+ti8+7Xi{gEr+ڻ6Z/4dy)4AII^w6k3 47 ޘƓƚƜ.aN+d@2.xF] RW2\RUSF9"CUARVſcE{aTȃoF*f퍢J*n۳{.FnW7 7W@{!w\`(]#` ('J (Z-e(>BQڪpOlA)N ' \8?+ h EN-( vqOݽ%wR,pBϰ[PjДjn'Hj쀆vк nY#M1R;aqRt;!mUH$b vD8hn'؊s]o]nz`n'R-̣v3wɽcr;A Nh9t?q;!g4n'zpBy ނb N \?+ RvU[Pr~v98aU RCcL6 3dcn;AJBL6cᶝ u N%k 9#m;aĠlm'HAj vŒQNȡ` #ek;AP*\ 3ck;!Ǡldm'HR1Hm' Bi)fFvB=X[Pr >I )ei;Š\hR!0cP6J ʊvGFvBYcL6r>vˆ1٠N1-4dz)ނPbP6ZFvB=PN1.({ vBq0N!.$ R0c\6>b`64z ނc`V0iy{bi/;BN;s1ِ^G[b /4W 4*Q4 ȗ7=_[iTi`i/W4^]>Kq\}(i[~)z{|&QZuTq6M'm:Oڴ'mz Oڴ i[xҦMOtʓ6Mǯ> stream xԽM-ugO ? y3sE~٦ K8PER6IܴcujYF5}޻wfFfdĊX?|ZO ~,~Woi]}>?OO~ǧ<ߏǿ_m_}^}_/kx;[{~˲o?WcY;^/Kl\o/8/^W#>x1~CgA?# WWC9ﻝ{?'~_N_ᔸ>>s ~{s?˲+leoWwO4o|ztr/q_al]_?{x??<?)\8~o_nu4?O E~߸Ww<]/;{,[cѿw8_u>7 ?Ϗ\{zr|܎-oۯlۏZmul;8Z-_N/ǧ~UqtޭU>2cκ!wG|.':u[; $z~\krG_&_iq^gFTՇ[?O}Q`z\m;?QmxT\GǺ2ў_-5݅?jD[3hp;3tǍF;z>t=^(n]z\x~p/=^MV7|Go5@ q z2x#гymO| /~٬Yc7c׿5Fv5z=}t;[?W+`9Ҽn U_g?>"}xK߷FKVW{۽W=:[=)roC\+.>麱koro.8/nqOw\ɞǹOWڗwfy^uoOdZSjtygn6wnB_To_}GYAc%UG_Vdkd,3psޭ~ynMR]n|޾f?G`;h+xk+>3Ϋ?[ ,}{Z[q7Mr&ߴ>bMo OwpvKEG檑ssѿ} I<5ҫ7g׾V`[ny?'}xo{eF~G~c_}or8_ǟ}W}ti5}5?}4y&o~!6P z^]d]ӭ?m9>{{?|1~t}vt+|6n۽7;gWbϛyik粴_}w1FM8z oGRyGbWsk:w>  2g~}a?ݟyﺿ}ΓKۢw>L~9/@0c_ݎ֥V1j ݏ\Jw~[x}(7yGyg|ԍylSoU?luc'Ge>پ{iv &v㈏/&vO|ۀaؔid bf]&}~9O+ }i+h7 ~7BK7ʟ_?qS\xǏ|u|VF|^~qrܞ/ǟ;>~]?h~|oǷ_Ͽq}~q Q_=hPOkN?~o2>h|ߌ6>@:b?7< џ/{І:? {_uon7ߏcO?|~[1 {m`ϿN}y_ O?q^h O|gb|.7@/\75O xǿ?Gww_Z-U AƲĿ\>gj~LgUwoz7u-\@cnn_ۧػQ~Oڗ3g|>ӯ\}d7I>m_{v½i?,|zu‚[`vxolB[ʉO]i.~o@ӯ'g )ݠu~}jݯ?p@ 7]9cU,֕x?)} a{#"N(뻅]B)s_jPN\/qa~y8// B:J_jT6}߷e}_)ĊjynAD~gM}y8masxCuܾR;p>*ﺼ/oQb+G`ۅ~j=O3aʆr ]չڽ^gss ʭvS{cxȋ9=p}{t5vc[Vϩ Fk{;h۔J{o8wwa]sQYA߈+S'/6@W4ʉ+ 7 oSWr/.Z9ʉ+({6NGIo6ZbeweqBXϪ&J8zx|94 ~p5 m]WAӺ@Y1Jow~kΌMd~9zA鏨_CWN'T|-`#S#oS4ϴû eq@ /QaӁrԽc<`0Xq3Gã׹yX8N(@Yo8ynat~ 'obPVGTt V]A]9SRve`w1FQ~WJ}W67AW"++IWgGЫf'w+NJSTV8Zlk+{fW߈xPZ}lWV[g7ll_D<]xDBGw1,o^@g=EOP}W¯u]YYmgTWvcŽ8h>pn[dλҕN{b'ýyσ@%Hc}alxnXg5ďҙE}"{]O Nϖ-nюGjg0?ULg ww}C_a#ļbaq5gZb^pus.hvk*vRnPY}諘BĶ 3f~z9{hx5]}cH`pO\Mv찠7( #ŠK!at94OJx1#ʼmSLOw``pw ? ]i!6>%+M^Tn>*,ZamWKTN = u6q0au'8woxϋݳ3A9we ~D_9Ҟ؎yNT͵\s{ZXwwNϥ'tGr!=ݼ`arymNp]a%쳦 aps~OŴ`VFb}蛁ՏM-L7kW~Tu;\ly-y?lТ_\>ueg>pI -fWnϐ[w8+:DA4Kpuӕޗ(htmzF4=Br+'h,n|WnDܖ~ lo~?]ڽ]cNo{ 퀲k 0ur`5W0a۴jvWnQb%򮜜>.Vzfu{^7_N7>j0 X4@oީlWX ̿:h ]Y|sԅSG|˜=ïfW.uᔿw됮lH!tU8TL+]hmt]xO]+B'$[? ;3꽆l+944-Ԃ62 =nbW0n(MSW[9wD3B-pOz.{tBGkcAYWڥK 6} t5ʹ|  s9ٕ}/`i.X`bYtOmF\"%T7LX:Ź+M鮄ZCN۾~0а{V{h`/FVFsGv>p<է֦ {lwsQ`OrWv\y`Q7qétF{s|[&̊9pv~hLAG3gOS(Uͬ#,CXB_Vօ fƭ 1Enˮpym}}` Zʺ~l]v۶Sҹ@swIԍI 7mOW6LU ]iM}!`]`(ucJ Mog%ӽEc.t یj{ӂ np 'g?vs©W/r4!݀S# 1nmٝ! ;C`e.—'ҤlJ.THyƙՖB lhItMpA?ѝ~o8r^dvg7i+_'/8:beb'"C.|CN޶-6~~}c[ݜvI-G跩J-m_y][W HgF;9ġ(*l `[;~nu^!he'L:oom!5GĹ<P^i_ѥؕpo2@Fh_h[^zwpI խLSue tXԏV -h(ENjc4> /Zzߡ \taǒrǩL zKNnuKIc# ~OAU4/~+Khktvnv5s`_ݶDw' }rjm;]|;ӠN'=.svV66+ܧJK\Ӯ.cZW~l5+Dv NڱZyj]]I3 vXh _ʽ(`ܹnzLMW|cpV1:iG/t8.Ӏ;Xǽ 4iSbSMy+x]FגNˊ}#7gWrҀǛ.v0c,K~r==ՅS]hjuy9A{oU]f(mQ tO_mWvKI|Pyɍ3@dGTstRтg_bhV&vJm>qz-_`Hǔ>xG`.YuIٰ)P2}(Z>Nug:]M|wF|Kߗhݜct.kfA }x~#掁u;'k_K>Ap_ܗX};qʇUo Cu|0caV?У-jyGtzb *0<*`1C=Zdy;#>Y8]1p_-p^8W:M'8aw멩lX~>lsk+4,%xXi5u,S/d66l2" ';:جD!7kCMO*ۢܜ=S8^E$ځE,%fI}`c#NvLcc?cǾN{׼?}7FjL{؈am: m#=tَ;}Ӿ;"sayFݟ-ӱϸ{v1y>pE|pg:)m0%>{YpQpO}m:57txt~^\ !~BT:"i9v^a:atK3+^M*iĺ i{rn |eߴt]ߴxg; 87Mg`W7e6Mb7McN]4]Mi7ѫ_.ЮnҀ4Mni:db}]4ݺ;˃.m.o.fb4w;媎ߴ]ߴ\]ߴw5g;ܦZߴ]ߴ\AivM-it~ӊTM+ 6؄XM+~+rVCW60@/<(:HkZ]۴"2]ʐܧ`ݦ@u te<  #$k(XYdzO,]tĻt+_sL@pXt #+~8RLG[ygߕv">*H\*C>+ʹtEiU; F}*s)育LAWeZ!۝cyЭfYTw9V  t-T+K DdJ]9\^$c͂rӝ&t*/єhZ-FqM/c} W$s 2]8\U#CإO\y/%=cͲ]Qi }|}{=UCQ$`J yۧ(Gkq WE d]4KP8Uuʺƹ3H^S~twpkcUV7,-_󭢋-_Ob_r^ 0wAiMG[Kp8dp89bItn.c?Wйqv3 or ^S46ۓ!E-n4&>؂׉];5.ӮuIeT1;1ݱ[=4l4Ei!"}mR4-cS[nBym{)"!@{.ݑ& SzyIAWBS}ɾbt~iDld*"dՍ׶5gUC3LƤ΄C3Ļ,2Oo%K489n뱸8Oi޿ip_>[z܏?O:Nwt 穬'T6]I)rq}(\QiV8_>zN=DꓟVr)>Qu2uJer+<5 +R :N 6(Mߴ0+Tv+>Mpk+JoJ)pڋ]oJE|T7KCߔṀl +*aSrCCE==񗲮TPvOM yPPlw ͶPCZQCꥩMr?ۦC<yeɿ} mGӦ-ԋ_QY8lpUlYtv%J=pm6wJhϿjS ♿iaAZi !z2%?:ui!l?>mp{Oa[E8vx/᪞(9[uC {= gz*99D'.h5¾T_gjv ZShᨉsASVE[ϳt ZZC.[)(mv/z-JC㛅haIYsuy-߇ 3AGDCAx8v>ۊ!8k4%ecYTl,DMg[Y}VvV>q#ʞ9i]Ƥs+B{v?v~)Zµi!jg w.ӆf8O~U'Ig淆Ue|k([_*a|kj|sϮ`gՁ]aqW/8I7  }}[[JRJU) ^- Śibӷ\fVծ>N߲2![<ᚯ+Ƿܢ[SwBRşׯ>b:ʂCCm| SOA}-ȝR%mR >an&XoNwF>en~;mG A:Y$`J-›σ_Kcl  o3=,Pw2aW}ÂV)ԷKLMzXpA1/ a 7=Y*ozX`KCMc.j2ᡎ82)azx>QtÔs7Dc6jTN0&HԂ )ז%O[ z21#񈸏f   l?a0L0tC?Ø*"ʍa2Rȫԝ>,;3)_I)zƇ,^TØ袂ƇD3>L1^) >,P2b*mWe/|XYH/Ø>"|S|aL 0\&zXt&5M0f =aR2M> U1i'QÂGyØ4U f, D+PtadAb S TE4אJxX̪aR19L4YY0W  leaztd^LI=,PLV<,A/aM|A c-Ø\gxX;`a0f:azMcor#,*|X!a"lT /*zX 4T2=,^1MØӨa0=o p p01R)Øt)aKz352=,'=,zԑ?Un+wPØHI@`g **tXaKQ<ƼVӚcgb 3Ø.y'I谀P5b8D1WL*Ø-a>-ޖ1 86+U P& Έk&jfM&\_pVT  "&1Aca]BŖ1F1[OEڑOE谀Z9 iSUNn=.;F0fE>[ƣ':,6m /0rQcSaLOR1^ƒ"_(ɛ\~ m=$p+h58%DJ58,5E B&c F 0%LUbڊƺ8 ` cE=sXt!)a*0j0Kܰ@FsbcUذ@udaX'BCakƆ)X†a^GHlX Fva,mÐQ ]a5,000M00M#b=T,aA^N.h|Y MҜohK"s D= c cY_Q<`AL4,bhX0k*xմ ʤh,64,ۥ'jk++O*g-2 Da&hK*14,VJz%4,45d \L#4g4 47jJ@l+$LEPx2q{ c F~%tX N-X,tX Р0XGcakv"%vXcRa,"d[kvXaxIS" * K?:Xȼ7ơƪH$bD3ba8 *8 [540:,$:,ַJaei'3:,SA(G`#tQas LnD13è,%p58lzLњ%pqc}aTT0+1 MZ&.39 FELB&acr6&MaT2:8D39Yg".P0Fz1bacTKtr#: /j';)2bÜ*vߵCa/Wc^#vؘ$`1AaL%hRc%E0$:lvcxSaxu0_epZxQ0  9z [G0MpXS2kPN/[\x;8l98luMø۞Z-qIK Eݮ$a \ kur!^]?q3K ;DZ%8HvÎ4 e8ܿW"vJpX! vJp]G}0LyLQ +0ar2u' ;23 W6vk p"dO 2 `35 .|YI <`ݼ3Oml~SvjRM50FkK`faq%i0_qB0.Xch; C!ˊ\dzqvpk@"8$apkS0 t\3C70a~kLfؙUҋ|6zbzF%Ragj"Hҹ Dqa.aYz6W5Kd[:a瞯m"»:aeapA˖Id|{fd""32 ^g CY/ ;;y f̆g:^&B^ v&ka(fjv wvڄ̮ZV::a%A X-75 bvSPT.cXKg76R]2*lþBc]66 E C _5apkї0բ/aW FU")JnG򗲬.O00 v ,l|eluI6 _݊ĆGr+ aיVbîS>vv]25 _Y[I \a9=a0 JnmeԘapZ /Xg23bKy /1CPT"w)þ炆$Qа[5^a(kFa(voHlt]V/E'6 Eu\ 8sPt9sTNEr*aw$!0jK;66 5ahZF3Ϝ0y #ZaCelj#%6Ka- kKnؾq C{ Ć_0˒'Ka̰,_8a{z'[H&aGN( Z3, s`i3, fXF fؑx1Îv v\BKhXF%4P1_u5Rqo P4,Ghԉ"a4#̰_'2|Φb&ٸ3yVBQiƁ]z022_z2YTbQQC1ͭdQQ>3è aTt\!X6n") ɩ ME `aTT0*HibbȕbabA\PV+t톗"h|A6_as [.l|s4S7Pذ& 0cg%ljy67P8MTa7 .`rèaTT`Q0vm# bbҨaTTF0{D-ۘ0 *s(p`kQQG8v\w5;#[bQQM\8n5-i m+tC=:8aPqJLS ͘Uh8~b1 a,a08l&I#p'&u;z~%M1%8b;r{ cAN?;8ۺq #7ӺAq>9zo3a:tҨq vGrhQ↱RʬFƴ;qhʼn%>l,S^SrL8ørSk7a5$vX- UaL`t; W!ь BX%t׹ی ϚLӳ39 h]a\dDr ]%rzSM ,(5*Xt%rjaD3}DiBVɲL c]p# k58,70VW18Eu9q+qø0LY\?7ll$76nn˨mdqƘFfEqP=qD07 e< oȚayK4,_ أs!7TpR(-&ij Ɗnam% l=>Epw "3IʈfE.SU0n*O%pX`?mB)v"8, بg 0^/0Jఢ'7,IS|ĆyyO/aSQ܏]x ѡ00r #!D?5^$ax_a-5D #tESxV g%jXᠯU05xЦfpgh56ƆŹ%T0^dSFW†K\†?.=WG&4"ᆆ;ZF9Si?a:?"\L FǖaǔJ2L RwA0b{dF9Y}Y9aKd5pd`z1 #kFoi+yÈ4Ң0bud`Xhei ORaפK4:Z*faA'.%]GtT01xnVVL'3WGat Qh`!VbE^E $jbXͬ_Fnalm\7L05F~WB4=cfXyt FRX3]w̰8k03,bnak3eʘ12N}-Ҍ D3 FŏE@$`$`X 6eDk`X6Y!Ac0W)ae^w/eP#ku?(%^X(_T)ÂEs%xhbXfB60  cY38@h&hX0*G4Ê[.h)bX -55P P0F&`%qc`X-8PNJ 0㭮F@qkq6L0*)8,e`a% F2ӁZ)bXɃ9DaTG si2 ^ a? t[e^&8U0Yii^tqNyaAf*T̊/,P(F8%^C(8}]94Ɖ]oya &!k^=Ih nFESya@==hg%^g cl$^bWrB1J@ gQxib#L1j"xR51 4FEqa4FAޜpWhQЈoZX F0*‰F3ҽM0*:5\F%$SJfd F4&d0Q}kX1J8)¨B%ZeuQ¨n%Z=Kբ(&g) ]0¨h0*zƅ1SoqaTtD "_z=QКʹ@x}¨P1-a\hp60VA៤#L %iaTwb\Xdlb¨}6.l¸^2.zqa M:<'FH0R/9yaܷ *3M0*,g3%.Z…qhpaTx׍ `^paPXa oG0*FI F*ո_ baa,LKU97hK0*s F/¨jha\e:9ia (޷aaT%,o`a y "jaaTB, VFA%_ 7bQQJ´ߠ+h9fQ1K0*ƛ)==P/`B1&M0*bFE$¨d^Llr~-ݔ"m]Re…Q0J0*FY ̃)rB1$0 k F8.¨%\=a¸5daJ"`S<!/L;LjxaT 8/!h2@n5"\$6FEcxa4TFYzyaTV+r]3u¨\V_1K0*9JcdZL aɴ0*bʭ?3-iERfب2ި4+2Cha0 Fa G)EO[0B&kuz.f¨h4,yqQ10 ÆQ٬Q EaaE]C^ (i5.eev %.LyJ!b KfQiVج(sfER(FEYaʦyJ'E:T.+BH0 "6+bQ٭'M˕*VCQfQYP\mqbf=IH+R,KZIS {(ߘ.&RSʄ ¨v&XCinyԸr[а"/)ST("6aesaAR( qèh27Q "G餐("$aER"O餈FE#aY̙Wq>:yJHtj^Q<&M԰Y5l~T$5j.O6M {(rNdISf԰YijؤP3/M {(PnOFYir8r(Na٥DOSK'家[ gFCM {(.e9tR24A=K"jCq~46+K'Iq~aLg)ZT_:)/r~8tK`aENYtRX!i:+rΊC15iENYtVrN2"i E*SʖNANY9dLzk:+NaTv+ΊܦrTStRD {(t΂ܦrV"jCtVZ=T"vrU'PYt3L'A.!(w{0>F%]:f!sZt+{<&QhZ= rNꐩ7:)b=˖&PqJTLEYst(EM{(rNrL{(2[졜_\t;H'-&J[kO%jOe+gMV{(vNJ >i*W=,+ b餜_t(Ҫr&x+5W'M >&xHD"  V=9@D](@[/ 2W)mgL\peP6oh&ڠ!d R6Tt R%T`q}L&Cڲ'V.| * ,euuA6t*cwbڒEt<α $G;0@wb t'0@7 tIн'&9@#$nIIba T$.Nbokan-rL1@* B t٥>0@azBa U 0j1@מi|MJ Ւu ZKtE!)@* е%)1@זT~0@ɿ& Е]K:0@Yn`[{[t|t:8@ܧW>ps+9@PDIw1A@UNHB&k<~c!KoPHuLfƘ$ IEƠ( L j#ŀ(B_TeL4(Sb -$($l0!e&q :k(` 4Q`<$hğF`' F$Ҏ_E#v$ ^2!EPsw!khlHD ([( Xlڐ,S]cK*UF6(܍ml7(HbD;Q@vm h5P@Xtq4Xb(LnQ@M1{/@j[$( |H\6( 2 +s_Q@ Q@-)Q@Hf+Q@M\sӵ^HbPkY>A@({KP6J_rbNB+Sg9@I1ŧU849@(>Sם ]&hTNysuZq5 41I2&טDZHK~kwXQv˂4#Pxml5+8騳b!xmTj djבM0 ɷnY@Ⱦ5, TVٴҵ{a@ExmV€ka@C  ^\+a@Vr; ⶒ0 +d€ kٽ BJ9&  ƦbطloY?y@(B1l.KP&(8 TANU`-i@ %TAIB%1fDFl/3]p@>Zkg}*ʿp@y28 $3b‐76'uIΓj' [OhvT5i@S4 $ܸ aI0 l<]V}6 J*ii6nÀ Bi+cWخܳ!! " Ba@HS?7 |*0J,v/)؆gqFh :T5h@fJ`"+ElJi & [MElQ【jvwv&/Nl#Whdy@HUBK!Mo]?󀐣9y@կ¶RJ)j0I Сk@V4J R6~j "h|JǓ m%ՠM(4o&J*ЛP T Яƒﻰ@W}7H% * *8L TR[L l-c&1: JL +ߍ¶zc"dX@]ȉBy UME®]% aS|k@U2o@ l+F$ ЩUkk stkW!GW/|+7 *^[n H t.3'hO vuvv4J'&G' Utk>-˫6@Փ#91y@ؑ:Vjy@UJx@,︶URQ =fŵ5-]ELK vLq1Z$9y@Hn\jK2RF!'XÍq@28kK e‐$'q@m^Qdi?Y|aˠpe/Q‪dVူfHq@W t4-y@3<+1ғ c< $$љ5M9Bpe]{r+4*'jY̛VX(T!Y#`1g`@Ht=6;ujy@(f@y@ػBy84hӓTLU< l$:R< ;r".[ &l*^w1ŮV4 >lP+RŢJ(<, l> aʂX@֏j†1:FAѶ@9Lh( lsj$Q@UxX@P&2 udÀhOM "t-0 (ĝX+rBQAtT[ 4+ӞyKf՟r+0hH45qC4nZƍMи (@!&h<`/ }*@%ho?=Ix4޷w2)@&h o?!@ctHA!& @c J4Ʋ$1"&h #kB1B'dq 1$h3J2Ƭ 13%h^3@cLИ'4҄6!@cNNPM3@cOа4l ;#!@IаW4lCՓ24ld *!@Kа4l s/!@a6&,da&hF +7@Nа4,c0m (-dU@2jZI$h,64$IPG&M' @CIJXg%h34kIk$u_0@cLX&hU4ֳkDu@cNX'hT D~"~@c @7H1h$h$h$h$h$:>ݣ]ݬ/ƞXƾYZ[]>^^?c30@c0@cS1@c1@cs2@c3@c )MLMpMO&gl&gl&g&g'g"'h4'hF'hX'hj'h|'h'h'h'h'h'h'hl'h84D D""@× H$hM~ KB&!@I$hxTޢC @t*P9 b{@+(eP9ҊTζbC@+zE*_5rE*'dQYrfEJhiZr*mʉ[r *wqʥ\r;\*u]r')Wz^r)~(OE" STTC*!@Q(PEX0 ThUG*(@8R .IPşbTTq,XUHbeP!*@sTK*P.HMTT**@gU*Pkb a_ȰUX*@V S+P T!qU`]*@W +PTIʈUa*0@X p,PA%E@"Ue* @Y ,PDT!0BU(j!*\@Z {-P&g T"UnA* @[ .P Te s1*̹@ ] .PETTUwA* a5A0.< XbMG$hW5 _B5#\ >0 Tcl b%Źcүx5 hl<' 6"\z, pX`Y@4unt?UkbڹgbS, (=QP#jb,, (5ƀd BڕdA, 8(<2 h,5   bДa@P4% $aLbEW N.-/K€y& K+m& .=\9;' ut-k&&6a@X& V9 jc z& b,Ndr#a@Pĵ\3}ҀXLG6 l)Ӏd$Ӏ44Ɣ׀5a;^4j ^aH.Aq711:y@XA[by@MJAА< AMݹP< ,'hIS%:Zd$h-Z$H ͲׄZ %hd$h%(ZH%'@ԩ6'.v $Zv,$bX!=)3Zd$Zl &rL&ТJ@-gby +;@Ux1,b kb(`$bko >@˝D-w =@8@b%- \k)5@aI кeH"к%p%@떔$&"к%D5l("P5 "II"pA¿rdjO֖(yғ<%g3hmE1l:WKjx@08̊q@'EtIZ.eJ"z$)@2@$ z&'@)A5T,5^L5 @^I9J"FJ+"WZVL@AZ2%h'h$eFzn6sHދDږ$h[DmIr@HQ`"hI0@4@ۚDWf&h[HmMO"59=ք$HuZ^q3V/$B_hےPH mWۼ<\.Vr!v b{}1:+ii ~ "*B_IP)""IP)Yړ< Kp@e5%6I J$А Tf^L'I:IHУMhHH#7 T8$I>%6@e_#hH(lH(hHB*tS*l@8S;~P T8"@Pp ݤ4$J%f(@])֩D!T(@CBmJ$qD =ChhE6?PʀPl$,J3,axi -§i -Lh4$- ȉ-xi -!T8z*-Lda.Z@CB hHh\4$Φ4$/ -!4$0DPPHAZ@CB (Y@ecCАZ@]}i -!4$ZE H%  d !@dq`e"ȉ dq`e"HI@D;Re2DP&2vrb(@Df @DP&4ٜH(@s%2ʄP2v6rb(@,>XJde"ȉg*@DP&XʄPw]0me2*@LHdR"(@NqeB(@rb(@HdwAe"(r`)# 'F2ꂪDNCA @PP&\ '2]N dW92=W"((AAN e2`).J91I+L$bDPP& $C  )I()I(HIBAJ bP$$ % 1 % )= &$ % )I(HIBAL Pl &$ %$d&& )I(HIBAJ I;(#Z-7@A5([ZAj)aYA B% BG:YaDՊĤSA}^|6 (bjQA5ƻޒ 4 {&,VŪʴDzá$VT jBjtޒ k|TPA}=$RAHbAgYA5VfS! bPsƊ㄂  BߜPP_d)_@AX< A  ®4 ;0 OAPP_) $] B $Tbޑo%s!!C&CX$>J߷TD1ԗ#aGnՍc! -`;L"Ci?$$P$= ,sABR5! !I@*90% $7퐸D!$0Akwn$ZC"sRp].d#5%"$\؁ z+ na&c"].~u\%  BBĊHP=[6%$kR PRzkn_1rH:bP!AhmplHцFPj!6M$o B3Ƈ mN { 5eb]D!A@ubpB " 4v¤"T;B㱢l4beARFKƪB0I+6o'"1ܘEHжjk!A? -G5J$(@ =u'"AX&hnJSDQ |0>TK|x(A M$w2)"A1&{~6 !n{E$˸8>onHжO:RD0,m Fү[$17MQF!B$gubeaXA1;Wd㔒9nqJX2 ܞEE!"࢒"1yqQoicEUAw6XmD($O}40BŸFn w&Fpc @#(WIyF~=517OAX( L/#7,L4b|Mč~<4p_ L\ō;UI40+ ܼʵi!ō_q L.$C&51 c %~ |8 rrH+e \]P CN(hVX]P:2YƜ ܣ. tșIMˊ ŒI~=BAEa6!!D(EP ˨H!V\Q]Pg !N:A}ђr LoC&hW2A LLN"!AAXeIPP*F;A^ NP] JENB ;[v*TVvVխv+K_$jX R.IAhYgQ xoFOBA0 =VNcI(h*vU@6 B, PкdPzHHdP T ڮ'(hcSBA m5P^o#(h+:vYސR m a'hk'hi'(nm|Nжx ڴH v6mߚNi1A@m`6-#o&hж c&")题RP2@Iٚ@tb>T$dID(ALBK AS-$!u U\K5B|-dI@H|2+ _ h PA@.|Ek ` Anr;@21 5 ]e m/Ajr >yƢ} 7( i! S AnJrBN䶴 -Mn!HvAn ֿC7"FCDPތA=ֈBP=I;, A i^N@P {BAy( (-G^W@P;fAyW- 7\>P޿ {|A@ ({ eoqBBPnAC""({QDeO=6"WGJPP ʾ!)A$%(e?쫒YRϋJPI ʞ3)Aٻ&%({e/ɓ}] @)Ae(%(eף잔]RJAeWN]R[VLPv݊ ]1A,&({#YJP5K h)Ag-%(e߷.t!A.$({eoB|x $(/ gB9|!$(w g"BؤATEFP>yOgd!AGHP> EF@H: )#A~xe%HϷ ?&iFHP<uHH A!A~xh$! ?4䇙FHJ cS+A~j%ȏ_ ?ƵGV8XJ[ Ce+A~l%HϦ ?RJ[ w+A~(o%ᾕ 1VyP 1%BG`~@osyހy -7<@gdx@/osyֽ} ̷<>u %\M H zf k` k&U y%A^@Wt0K>X恼ny /-aO恴u /taȋaXҁu /aKs恼ćy /bKj"恼y -JbX&ցu " ˨BBX@M@ѳ3BW!aѧ }HC$NAH'"WS$\jyJ]DZ0$M $фԗ D%$B!.$$J< gC!(y AH< *"De'"Pբxl$.L բ6x $qB"\-j7B߆:Pb?^@X܅u $QI$U@}I&\jJ-ITҁjZYBp!Z@:POz@AT Bp z8A<0E5p $qTB&}T~Kmb0 W耘" IT@z Iѡ} $q4&'RU!=" q1XHv BEJ8ИT:&hL)%Px`ZgSꋅ1cL,Li[@cRXF?!R=' DhL)&E4x`ړB67iY'6i mCz"oF6P& m! ԒޢH(@svChh=6А'):6А9\6PfKNhHh my#(@h@CBhh@C@hHt!4SMhH uy"y$ȁl hKhH qLZ8Аq%ābm8Аf"O(@CBKΑ@@U|!4$24'5}!u%e hHń@АûD@HACB (ACB TP ACr ACB!hH AH ACBP AU!4$եT ! !ȁADBP&XDBP&2CLde"#(ANle"#(]W"#rb#(A@FAܿFP&BW91CDLP&b DLP&b2 'fj9f2CLP&b2YJer<e"'({DN;A$k`P ߫Wf #H ssR Krd2 @4@9  䠸L2 @$@ ={qՅL 6Zg>}A ^f4  kG /}5@d8`2.J6%Wgb(+Yθ31첨D P&XWrxיD P&XW?ݿ P&K+vu3@Ne"(|91I]IJ6_ޕrb(w%rb (i@,+λnȉ8 f¤d=2)+v;s@̾++P&~2Y}uWr21RDP&eR|uWd=9 '27l(e9LJ2BP&2n*Sr*P&)Xϻnȉ9Ls95櫽td92P&cJ) UrP&/JV_짂j(r*e"(tDP&멠&P&~?es@̧rP&}9M(v2P&`dwÔ9Lye/e2ir@ln01Ir@J)HHq:V#d>R|$$9 %)Ot䀔$| 䀔,V)k)IHvb2p@JS!8 0r@JS+`䀔lVw/}y} oi?DnًE߿]˳NϜT]N!tl ߚr`훽:)JR} o~x F/m[0pƷ0ǯ07|^L^?^o[KCW%/֎T_|ً˗ǣ/o/,?\Vsa +OlgjRn!_[yҾ#ZSoξ5ߩ孾ߩZ60֢x?y}v2j_n+z7k%zJQ7Èi{ҟ_ m_k~z~^/+hc)p)0|}'ٓe?U<k 8l*;~*{E+bz-v_>᱕NWԈ>1eǥ-@m|/=hzM(PR^|r} oĬvE ;}7o7FZ}?G|~|}̒_\ƽ}jJ- Zi?zI+>owtn-hχ|}m"7Kd^y,_[> "8#Zs{(/:3_|W֪#kw]ףQi꘏^FfE͸NwG\vKǑZ9ͭ/^ͻ_F9:KmG!zycocx{Gi6roȶ}(2uZQM|G+o<)}oTJ7Zd\K7]Lq^m#z87?oխq1| gS? e[Inc޹iWhk;W/?ryaޕc'm>K~GlU 7yfJebO֪vvyW+n_9^uZhn|)tS~GC|P[wxN8u"sElYh-O3kηѯTW,9hkOf89>gܾ?&<~~^νoY[k_1נ}/ܡy- p(c޷P?м&}Z?n_e|x5̘])V{{O.)-jH%3+՘oopR6m3huY5t,QO ܖۃ-{/-8N ?U5g\<8[two-Vq{ﻒb>헝xBL'>rk:j]Mǒx|tm~/}Nit\w_8~ahoL>Wz"5r#_?GOt.{:>^qo%*/ Ϝy0~п[nqע,oR5pG,f&k[45gjޖ8Wnbn|%q 픯#1?j쟹:[׶;B p-Q:K_ 5Twf`ik (dJ<Mzj A&nW? 5>I;cWP򽽼7KFpp0'R[y?~at7њe݁Mm7Ezc;x, x|Kێ}}uӚI76튥.C/Ye_F{ǩGo9ܿݍB46χoc{{ MozM_ȟmpߪ2w޶{qLqV^]/z8%>~S*}l(%~ =  endstream endobj 107 0 obj << /Filter /FlateDecode /Length 5396 >> stream x\Yq~I= Lôe6p(’#<ı=@.H+YbA!쭮z#z_OTvszs"6'_MOiH+i˓H%{kG?]V:Zlbe>gg+ !j]wg#q!C|齎N{]{c!}*Qt7۝[I־{I=OH{!|OMn7yѻwoKB,ĥglþy_FJ 1⺟Y0 ݛUx3~dy!d̀M*GȼӅU^9J}"$:u4ʸ4۰;|3naO )om3 I> ђ}V Pk)}>&iByRKl@|%fK<CC^ &lk:m2P2Ӽiln'\ | [/(-St˜t"W|qy4o ĉ5WQϙ[Xd|9kuh8'-Mq6t68#r]dx2FTL2˧6XDEmYTd#3= !fQ6kcX-IVdb=D]a1y-0?ތ2,o@(iĄyd" >\sX_ʂ0ಷw$-7c_0aPlj8 N,%=1Coyl| fM:YI{h)"z'eynZde襕'H$ H? s/,ƍ$*4gĎp6H`Èh[R 5~ã}g>_>4FJwQH|\:}.)yw[<2Uh02֑T0Tb|LvzŧkӼN [>zE9d+5}\p1(Ypɒz!LB ( agC镝 bVmU1k6f Nt@ mY>jJ7Z]_}CZ)5}f}ku1Vz$~& o G{X%!B3Ub}|)m%,\%v *x]xA6Q'e& ~4*7h)~C . 1~#ȱr]O7>}~r+?檩O04Kk}u,]2~H~^UJ sE SaPAKD.myE>6'JE-%id?5 J*gcv(P6L8 J^^1~flGB 0&J/ڴd+5bgch m:]B $nB+;c]6;{kBȂ*#A6& xnʅ|Ik匠ʨ(Yfto譌>N2xyB{Ʒ@ >rUG0Ї7pŘ$t?b3F]G/-BN' ylEl3Ri .ꀷl 2^gXZK7h @Sd#@@HD0kw&DվN`!|1$ɂS6r>hz2j^_e 6a /F>)N>du rk-*BݱR|lJ릚C3,<: wygy=Q>vCq<@ocŹV4sؤC糒Hfv|.ؐJ=:/#bgG 8`磕㳪ܤgڣfł/$/'3ɇlt6`,k.1 |:d΄9;mT W\,d9! 9.!%_ٶpH3H,u?/$G$Rrc J_x2]ډfDrbIg ^ p# şe_d{\ tKA|oo,Ôo ô}~I@LhuHIoaʼ늭3MEDdoR苓qj/jFaa>ɕAY(^6)nlj&X8/ a0lZz5' F3\C\ݯR\mnS/XD ;jZ̄%C{ Q[cXLM C>`1rQ0>̏"Ϊ *NF,%Hw%}V^6Hۀw,s$r>(L =Ag4OZTYџ?Σ]г5d:O2_/-3ςMȵ(|gU Xo6R"v U/Tu*h9G3R\n>q-1,o109 *bcIPFʷJ5to<)guA&o)fG2fEP(}}Adl;r2 7gRQ\EJa \p-rCDy#1eu7S}ZHT2ITCbS$f\GS&^'\68d$n6)v9U䣰e)$WMVLKFrYgiip7Yn01!ĩ-(Qu$.;+򽯮,š\՘@f&I(>e.YƗQG,k51 mwbgMܭPQ b/C!lQ%vM2|a%ԋs/x\>ϩhP`Vm=&vb͑C\HX.`4%(`ޤA\r:CZfn%DZeco:T̪/3iݛu+(!u452PJ i#U0-U&K]R,AIW}iF d\2N6'-hWA;zWCIq)(5:ʄ-`8T~RlZzY +AjHQa|TLJo[z>^F}}Jcְ81e)r¨LS;~oxjPc[١^w-w/:W@^jA{IUW&]Suy{戥KYR9^L QHvkw L0 'Xn`JoΪ5+LZ/Q)r$YPd7jࡨk(mzŒTq^!OH}KL3yvdvvl6OhOvi/Df`~T PĉT}wX-9;7~7CcYLLx}09TJ ~IYvFGĪG ݁8KtA + ¼P?&ߨ2<sOm7ysm}rB1CkŕH `-GNlK4YlSǎM}lmUy>Z4A BOPKq7wӡ@htљWnV"Sn!iheKxmtǝ޾eQ-Jh3b05A_a&'J?fc+QA'L5dbT D'^~bmYaYǟNC֚HS^zZ^* Re5oo&9#'u߱hҷ^ Ftʴ iݬ-)5}̇rG_9fQ=~ÔrPV+S}{ÍogggBa ES" TOC:9h֍@z[od i]hI7~&~Kc_MWDO9\Ӈr*_J=ðu~A:Ù2w&^X}r@]{ hd8nk=:4a %)1dg ;YIDznG/RUƔW|$i#L}xR vsq.BzCA~naW I~V$ \-|{W^W1Y.SZgb3s%yp%9|~ ȓ4VX+-^gj״|uI80m,ZK(c*\˕I);+ՁArk'wl_JLgO>~bi֠}/}H$t pvI /6dp)'8&HoOendstream endobj 108 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2063 >> stream x}Pw9]OcwcKJZ"hNcy9Cy7V10icdjd& ftvvgvϳ|~$D$)  [/,&%NR''x)Apwn]j: C I&$g I1TZ J[I1yPVԊqjERkجj7[N:r<%F+I'@uV'2^)i{OiI u2) W&&ku'"ʣ1qk g{^b!BAb@l'ě."Bq 3Nu4.yMDуMt?uGq5?9.j$0))g]opnS~Bo?D,6weB.lciL" Z^W#8 G0G@qVەt1wz#b~Q3^|vBD%VW-<I7<ƄNH&f4'!2 ՠq 1hڋWa.c|A+'Qւn9Kp 'rqkc!rD?BfF:[2â2\z/mPW㾜ǽY٢3Axm6ڄ*Ȇv.A61v%d6LgsMrMaž}>N4es7jM5Z#CmyVlNR`1X,laIe}aiubfǃWԟؘV7"Cޭ봣bV֒S`p2\u jKja,GA)T N n=:2^5?LPT͊aѳ0if ۶/w,sC `Q8_AC]֠ _5[܊]%a,%bt)uXi7'pCUtGC5頁LpvC`E硒uP|8$A97PeqhQx—@ Xtm(V}s}E Y*c&Ev=QࠝGug?4͹\͍+6}pj/ݸ?* 7_eg@ V| =ƴ(e3Cޏt|p8bg~dUUzbƛĎ'O%hσ7Gs0`kU@6ÇDR$DžrUbUF;Pm zejPEMym;{}уfD7eei&N)8%~чrJ}Y"^AL~X~W,}ï=\r(,3nbu;BbBD'(|L[*"-p .`gZΊP9лNgܒa:0J~4S^i*e,H5ƊbG:E#^,v/l~hE`@:\dSm"@еH˟==`V;/ŵ/xO 4!*"rB";Zq/btFj8}L!e&.gW.B F3~iKQ,>}c+qǭ\:T$h0:Aju,vĭ.~ϯzu 9AJhNu})?:o AWPh/%28?\\sӴyms6Cua7lޚ<"WzUԲbAlKKwmNa؉î/ߺ@r83mT +lRQB9 s jwW[`\7b h'endstream endobj 109 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 470 >> stream xcd`ab`dddw441 ~H3a!;'O/VY~'YS|<<,+8 }=]19(3=DA#YS\GR17(391O7$#57QOL-Tа())///K-/JQ(,PJ-N-*KMQp+QKMU8TB9)槤g2000*00v1012Sw‚ ^;;)#맑hwO)M]m5r-jYL}\{a]f0{.ǎ1iU&M/ 9n.]]ҭ};iKsNKvsNK~w;G^-mnŚ+w6u'8Nj,.-..7iYAwxwz]wn7_قSM^wT\gXp.&endstream endobj 110 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2239 >> stream xUkPWaHSh{dbX-%V4`4@"ldax(wf0<Pỹf1$A1$IeVܘz\jGo9;9w$!H1qkgB'%Bzj:ghĖK~K V.APH %^[ThStIA`5ke/d*4Ir^#ץ)2:'CKVnJTCBV3烂eY4YBɲmJ^'g*ds8WϽ#*N( WjtzdEZzƚе2 '^#"`"J&^$'1b XN'D6oD|#)%O{ iRZMPSt&&?îgH ѐiޣlW,/K?'Psϟ-+ͷ5::UrւH)^3UB't5h$07[B{svɽ1$&zp K-M}v wQ _zc:U*'ofVG]xA?{BԆĭ[ K "Z R;NOk):B\^zxC5˶&?K\C&3bcH<(VjnvB>@Ko(״9 7|پ[+4Ў7]T@Íl qp=g#A_“BԈXJ{(\W@g))_V7<&PZs8 ᠝?e$p3.*vu$/D."(Q(wVWYˬF(7C=5Y:[&"vLǕw*m0̰kJN9Pb6VcZ\ vڜJP!q!#px,x sEinJtFv p]>k(=)/؉< xDLa 6Zm=W^؈YԬ B>ȿՕb*4q@nFhWCOn~d)%4(w:)Yiۥ׫SJJ{4>,j 4 tpJ sAuQUi=,kMm#󯜹!M1GYzS$7*T n:k,l|?/;J-7?2xwNJ0ҿ!3C6 >*jf{d*kVcvh 5НXw4WR=϶ʆ" D:-.m8%\fWHG猸+WI?0PjUSZE3-TpK;w :Ƞ֙~D] AoB4襦WJD3q.Q4|&.Ez*G{ wMYb}|1:5dC q;8 >ZA2SSvUL:_%}[JOB̷y!1-Cȉ^B? nԅsv?չ[)p[::<=`ag׉@wouLsJghc'`h6͊h8v5&zʦll8\SVUUB%V(0Po/Wa6k&Bd#RqH,[.>bk]Dendstream endobj 111 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3658 >> stream xW T׶DlTF5FEQQhdQeFC JdRejQF=Sys /Lt$^=ԭs9{}vL&cݜO6}, IC{H@V5 p7q=LL%XҬvhx/#B"SCBc}"TcǪgpcLf\)BƍYLgL?3ywhZDƌ and{h{<;ʿ35;k>ёe`OagBJ,p^#G-kywQ祿+Mb܅]kN[CIWA_e8 E#B 8 tDdf'+ ㅕX6 G\B)-MKJYUqU.> '.5 )i![} "〼;FVi=PTjIvqA{Z͌. #D²!%?GѢ&p.`<:M}H^с4w!<{^NܵD*8JWԿq%+򷌊 p%:'Zd! Bâw&a99OSg?%7o>.P]!ea쟔ɽ+qjvǘ1ֻqFBz  Wr lc/c Ҩҡ^Czidw$=l0 TtQi+QxbKi + ײnZ8{ >a&r5 38'Ⱥ@(JɘGrU^GN b>S^YQRSr(= E]Y2LL䓐/g-Т(%IS\ PE~CLz/qН`=jTŧc!lPGeFxyjߓax{=j o=6$|rzg)p/ygEv2*gLհmOh)g^|K~ؓKZm|=tppBS[&ā9miZ6C+0N]{{^E\Q]gv8ˡ:zE*qORIQtCWn.SQ%v_] G t!#MN,B޿VviNQ{tnI/ğ$HFWgZȢ.4ᣦy: .4k5,!Yz]TH__ҾWZ#V]l.zhoTh#ep2fQݰe4¤i#Iz> qC+Uܶ5ʃ! 3]}fmR#=M2sMA|MG_C@-DkyGG?"(F02_Tk C+Nr_4{|b>˺_GڨY<7 cs _Pxepv_<45 (sŋ/ tڌl!.1)81GK s'p97ȫ?i44z~ v{6thr!?n6!Y+zLH r$'/B^M}^ s+=mo9k¹IٮPR{Kw^wõ7zw]0l vHFh2܉r| YDVv" hͮ,%'۠x ntkZe >ӣRS!j@wW[ kЛ[4a1Pr!$pPwuO pg;;vINL=+*VnZ2>`fRxG3քrͪUPWxvVѧxv&1+V%tlu;V(:UX!Gh =-CHMfCqw9\K i=bґyhϷIsG{b2 .^ K=$Q=GnhBxr@wװNy4(s C7A[N.|8LWki/k3 -Qظc} JI Stt!1V$Ի'e'44>UٲbGum[lz{mC%ü=<Ů!џGcY3Vw҆ivPη&oƩw^ӼOEv~zi==޷y{.n.ޟ sXz fŖ=s--QVf;R0 +ڣendstream endobj 112 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3090 >> stream xWyTSw~1-+ک tTԺFe-AEd1& "*[Bd0Vt2VOc̴:e}Ggmg?srNKn 2H$  a(a .1~+&n,X")xLꉗ_c0r,%HOk4:K:[p%8UPN?ӫ^7/55unhlxmԲU:jSdR6%2BST=t˪؄d]V(jb\jm@.9T>M1l3wE{Pj#5LR[6ʏIR<* ޤQkuT%PzORX)ʅJnIfH%Gt:s};7"ݣ3O.cQ> <F9L 3%;~jYѿia.ɡm1{v.:+8N(wh/EWm$5Y 7atc1oP g6@֐ZWPzekvN;tP襚Ǫ+~xK`Fj9o:":GXCURcZ2'd&P%Wz 27x6C⛗ؚ(ٷ ה\Nkr[r+OP?b. X"+"bUlQ; 26[1'%8A`S ٧ p@Չ.-"{}gDRi48,bL)#EWnl?G dͦ\.qݮ``зW/#th<sjO"|//t7K g2m >Dd{2H6IF uҥOԦv m#lzo["h~\z,|*D~162"2G&|NgBbA$NL2#PtԉtN6 M bˎƓi?[D&?JEpnc ɣ3a[uiQֵ%v֘8FwE8rEW^a3-)_I*h!wa!|BqRGCRWgZ`l,Ҹ " CX.642-fHfgrFs3T ww(vl; ƹx"L|v<=y* rr)6Ŭ-&򜋵^yLk:@7/_E1!A7q݄ =2TG}\l;zL\zfN1!Mig*ڣ T(q}vn;P?Jq5JsG^o37î.={EJ"b.lxre}yb5eўԟ9stMjf/?ZRwʖaa :b1FX@5?xV}΍7͵`$nȵ-lSPN&+EEl%/݀2|h0ӡ@;3U8=^Y;X %J"S53@F}J6rc {Nα  iELX vފL~ oJd9+ìU%Ⱦn*|-rwF~w_N?'q-PLm$V Q!MHHg+T XartG<𼅷:<\x~`*ꢂ]|<L285]orhn49m!`('K1_(+-.|x:kg\ yƢg d!ְO債:,Z>ŖS9$%5\t -8i*P fiDBD$+7{aWNFρof6L Os<@~ |l_RP~6ooߊR~_K5)F?krm&LK~4П'R 퐔Lmƥ+dky43\Fj3喝]?lG*y8pR3/)T(C-Sa?˯~^X!.[k[KX";00ed5gMY(3%p딉`5L=~\mLW}o&!xCo#2<zaO@\~ښ? &*N;;1ENVFI~*̢jjxH|>M*s3D%:.IFdJq|OAZY*l,=%2Qj[kj=F[<uendstream endobj 113 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2976 >> stream xVipeq 4ģ{P@*]$"DP dL&;=&t #QDqEUTp*K6U[{}yn#5z\#O;3O} g4!Lyw tALZrezU^F Yu%%Z*W) 2xمLĹbJ^$-)S2ib Q55¢=>Qn-υF{$5&pp71!hAaS2`h,k-ahx *ri|^i9djxpyP_Z]8|bdXd |+DD~63tޢRNNѪ\zЃ\&Oep9?|MҾC< k% @B.zGa7@h؅֑+n8I-Tڀ-l%>PIM?d~;Mj|'*[.o/h37iÕ@TPQ:IPʵG_Ou_hBwx/c,.DM0yS0!74a|xbwjV,ˡJ$Ej2u g7hQY.WfuGGssNmƔw[;S=d6ZNk3as4 &TX}q#דC±'9(!:Z8a[`Cs3V@Fh7,LrBo|%f]h6~[Js,޼ |hw͍|hTuTRcq_8ByY!]_ZJT"V#4G8,-+>戢Q?dvz*BhdCrḴ03tn_Χ˻1ɷł+qdl[磐EgŊ7fe6dvt xYٵGFb|S4i?^|lc'#Vv^㼧Ò>̈́ľX0y+~m9}JVJw*aolsuKoecx>-D?7?9x,na?c乲įp%ҽ??~ @.}AB4 !2hچTQw T$By7 g?! ,=[IOyahR8d_|&9T.]c/;7Σ/ ZXe,Ϻ[zxawН /E bؕg8oYOc"M趑0³Y0)d$]wW7bx2 в\N4G26 Dt;>Դ-i|endstream endobj 114 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 8221 >> stream xz XSㄕx*=upjyByy@yB p ZVkkUmmVna}@ -^v?[~чC莵/oP-|4  fGLw F-kP  K\'fx9sfO>m6k]}<\ ݞQ6ϝ:5""bk@ؔPOc33tͲpu6]8( Xj634Mv/^4tYҕ{VEt[6cz }6%`1S\N1s֨g3go5l;'߂FQj.5HImޢ쩱fj@PDjDmSj ZJMQӨ-NfPjjzZKͦQPQT5SBT5apj%h*MQT5POП'E(`P[Lhbo4TZ cbO.[ϵ?Ѐ;>f5nڥk| .2f=vm<4pVʬw;lÂie~#1MByg#ҌtbLo_:5$H#nWvB~T6%_1aﬢ:\}HFhW֪m*Fr 5G :'S5rH`Οn~U(MD!.SV`="s|KE|;yd)ZJ{N3?w;p̌_ǃϠ"/*H̢uv-3^Gzhhu7/D-(b,Я=6IMksop摸<`^Od mOd <.ĴdFϚCy5WaFA)'glvyj2•p]y֨ HHTYV p5֕+@e `pWtM4<24)ii99Rd1 W>@ةȗo=o_eC.H;O|v5W"8OT9:<oxB^alqc~),) K उA"Lơ}xTormC42N_iU}XT=1T.M=!GZwE;qe.DWRK-?Kʱ%^Љm5 wngfE8T$wرŻv6AZwc,Z첲N}6! ?o B72!bMJq_h4b]2!:"LK7ÁL;æm]FA&;pXEe*y&eʬxcƧηSIeXCaa Je Gupw?uܸAJQ] 5ТRmr>Ͽk%ˏ!KL 6y}S= Uz҄0]B0=ZZzV,[YY"GZ*je [1WR3ǘ("XFC)s @CHgvr}O_pFPBf9bwusצrP8"u ~ "o4rIIIVKRBGw ҶEQ#QUM^2%-BOQ.lR@dI>hB*%>W/l5cZȢi|SͧOWp26LJo8E,}Dyw=禐@<RQ]+邃S1_Err0\NY2%x9lH1M+#QP/t8K:ݘ (C&^ Jg3;<=$8qjEz-t3u ,!|1 G4'I')91ƀ"4K+D=:?vx,r\x&v#n Uh"85} Pz%87fOX3]df Ňh1E Br!LxQDUMѫnҷ0=W*nt7EK,/BՓ}ߐXѢ@,*6Ehg[9tN9rhv3CſP(Z΄'UB$+ {066|qƈ~.,q3@~n^׶Rtd_#6/o-k;q@a.2YK'oyvɀ'좱ϞBWX6(A櫇шY8k~9r>'=w|0]܂#J K%+ߖtI\Is$ 49M2gdpd >Y@,QW%;#tu[ Q/ay}',:¥zznD]B }_9T,ʣM yRq'u{,r?AFſX7 X͞sVu 1nOT(쀤G7.\Jlƾ.bšGh)6?ΖV}RSAx7M+SJ?в ipH>Xm(%]jVmy2+)o!Ƶ'g'?w28=2*UB2)ƭy:13Fsb`Inj[gьQUjB̒g.H?xRqAՠIEkwrjMn&jqd#_'+o֑!Ҥ>++۟h*)/Lym_6S) EEl=tG%cYMXE``XX``EXMMEE ^$sʐ],cJ"4MeY* ! q8wQ)%Ϡ ((oc%iХѠзV(EūF#[IդQ>6#S#q곚2"nkT5y"z T!X}g6a !|G@xH\/EL*q3oVFWyG9RR$3mUh̔; pNK* ;++mu[Ȼ+,LŮzX6oY|x6/84J18 _Ru`o| e! p1d)5@DŨq9֐>].[;iSiK]APh</c[pnȥ+BR[$]zmm44?hy9r[:/i;wX#MlN?ʨJ$%\'s>oZ ތ}e&/f-~Ӣjd罱I+ /LLޘr紐 -݇ c B[Ug>#5ķ_૏15!3LRgI݊PU*L Ideĝ2Y&sE#:,,>#O1 sh% o}ʑ[í5Gu' 3$íHvINq{LH83:zT'ƱNDiMZ,Vk:ZGCo[qE'w@XLtVZ'K%ugg(ғUJPH"wDwؕXUL3{!)FQTfqE'v0ʊ*xvFp00]H6>%mL4C]"瓼k֥ L"1OGb@xI>e az* MŽD7 r2 Ѩj`4ꗼxZIBYINOMϽ%ǡ-'ueU~&Cŝ }VDʽV"߭bɿ"V_/9Cp{C$X%𻿑ӿBNܹEdP|]QpJOF G{E$K N{(l,*O-eBE؍mQ̌O.-%&)ѣp$kY' S'Q1xaTy8l~k_~(f> [oعއDz7k駧k7%J&4{1pa#x̿Kg YʢA#[`­sf- _vr~)"& e֏wmvg 1+N}XbF ?}7rrܜ]a!3q_>3 ~=6vF8&l-k:~ hNy~ik` 3.GA=[#"ɴq(C MgZ}Iӟ-~)d.9w@~~15/z1Tj2M^Hm2Wa]#B-ۛ,/_Z=, Ͻz}dV{%{Oi/͘VYu:j)$hr8?Xw?/;f7 S[o;>YDoӴy-5ÍH/h}<n@窅k@V1o86GO4}zeMK頒=w!2RH6OpZ%7}ܧ_d摮s&8 뙷Cuܥgc'q?tzf6 ;M`rܙa!˻ޱ0Ҡ^7M'pӑu$81Yرd KA8IH(B t+(}EwyGn!GNG,oC_3;F1*OGœh.(*3H6X+ؽ\ULIr1R})ER5hI|ѭm~CP$֖ ~<#Dwp2K&F~h#ɀ@ 48"Z^Xۆ$`!s9<`2Ҵ/bȵ[24p32_x/0TQƝ3{^װe|wi9>E\꓇pҳYX6Mx9q~X@2t  x&!?E zqkQJ#" 2uE "DqAi#!Do0(yhm~ {43MM4LQ*b-R*!n8E?mh_p禔A [_Z^^)6, ͏&F 򢼌N1WUq9;Jr.ݸhnÜ'y]|tOo6=̦dьGt{gg.>=Iي)ɿQR,2jXu$90m:*8DH`0MXĮ=몛wodPHM;Կ[czWv`&㾤vb$ԗ,ɽg+S8ebD4/$(07C/nyߥ\?ٺ}\ HQ ҍendstream endobj 115 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6637 >> stream xy TTgu%u"hir/qj581@SLQ h CF5j6c%ުB}G&c0zӎ ;}v9V=hV젅˖-˂V&Ǧ%DG6E&G$mONMj|z:^ʚ|h~JZke%m=&9296A?:%)%&6`0JY35m͡YM91coK~pGbRy#,|ů̘9k1s4tVm팙]9݌=UPj^ƛ}` 5uo16163x SqF c<dHfe,5g gۙ67#{##N$7(I/yaȱOT :NS99x&zB'~}oa?{&?\9L^A[cRl[gWjRB$,N}ˏe{Jyn&GY(ݖr$K +>D!,sS8=:/%hdI߈frP@&|@d նJu >DDB}AV0Y-ZBs^6WNxD)R WbuXˬv\'{ˤ/&r+buMZ4'Qk> >&mH3I"[(Ar4UQV'ȕ򵓇~lb ahκvorI`ZũsOQ^ۣ򯲼|"iCOgLzq$i \FTs@ 1=1 <5pr`Go[Dt6Vʈ+[CKGщt-_q:"nD;R*@+q_bKgUh-4?w G(UQ_b"]4wVސY_9$&FG0fhx/=`qXզbaͩ.>h4 1Dވ% OPPBM|.ǶH>=Ebͨ7l<Ls`z:G[ /=F[v2дWAs(o3&7 [xtȒmoF.bPFR'ĸʼ9À I\|ץ6fѣ%5WR1BINQS,+MG4 `"n;/?[A#K۩6A4!t@Z$$"wYȉ30C-%DP"Sxw !)9Sv$nf =Aݍ́ךY s}ɞQ 4 & 23cuA#iUd4(v.ѝFItB?M })dL u.EO<ܡ;HBᘦWq{> l&0pJB/nSA>!'()N"|zVI!y e}q9-ȿQv2KcRe[5'AJH,9%QG# ^Wazj&9*Nc8v92׮<,Mfb}_[yL[tNB7ptO>Rs1d7b+[k?R~1XpS^ɵ*K Z+H%&<˔\eDAOxz! &SzHϋRSWnbQJtg Sڒ߇ :tT.CImD*>>*!nay'x`_1 5 (cChübQm2:f [bZmСi꣣6թ2"hA+4=tUaQD<@S&zNIᾆkbKNҒO,;^FU5у(?i*G˄)~R C )]M'9hoQ4NuMN;1m Bmv}jGZ܎V0q})9'd?!c̦˨ '*T:2CX8Iͥ?>'Oo'nzepEFΪݑZJ퍖 o[n橻.DKqU|ގ{R2^[3w҇ b3UYV ңP(ZpC!)٫δ2ƴw?R_BTI4 B_ D?akEm {k9F<16сv&.Bg6+1J6J u9@%jmzC몚rp87G& طM,Nj" kZ 6IiZqV{FT:4"5/!@hͲ'MY9tV[yUm-qfHX3[iQ_,?J~Y+TR[*eNxXۜguz˜/2* b $_T"H:;իeaՖiZ9=lpD:[,鱉 2i@5X? 27"JƜ6nӌ}ZXHzxxf\+}ƩtKmm|pe,nNz; ~zY:]v+yiwy뱑]xķEWmSGp˵dU!"2JUUi3 2W, "<{H&i2+O)zsa%wC֑ 8-q{x˿>eѸEy{smlg3+fGTkN zSgwt,N9fŪ78l3Qмbn/($PhKmA03^Ele%rLmے0<7Ujb4~م5yte*)pI=;~3ϐE!2LfcbqcQ4sZ jVx6(iD~Bi8nayJ䃩9Ս{,W<|C8ϵ||?*8ڌGf#;Z92ԗ31 G^@.^U9!jxHB =l߂^;$F>#tiw#mG7 D̥2틍6~)t1a)MJN+&_iT>XLE',MHz O(a:Эy#!%g G/gz,Z]o=;՗aQ|ehM~z8 z2:lC%f;R*k)U*%YM"S6K-ȿeEKgm!"w/nJ#YfUTg{2ZXэV9T^T̺u16)cO ZnɞXto=?w_>wLn JZvYl٬!TJia ;PDKhCgjhLM䃦qoÉSė񚛻z$֨$:r^xjB/R-">C܈уڮPѩ8cOД)*.|a_)* ZUQaYaXiTXJu݉:NlJ<Csojf4ʖX6t5 [DcY]KT[%qUx&7o,z;*wJ!G/v&oO8BWJBRbRzqVm'5ÍT_cd@{y2o/WoK^4DhO *KzE p< y>Dyy.'|%X%8~,WW9/Uz C>G"fPZFqQGD+%ve.m,iP%`xU@Ϟ@ QXc$jRBx[oVZdG{ rBvO}y@(jR2-#h!&ʼnFFS?'0ރv>km}unD`G?pj^rH:+pJ L~ќSJF]@Tk5$4Z7m-* ɧ/BfɕNs3\Mo3fM^SkJmjsM3OLisp@7 жu* \@cp=fz@WWH<Y)h@C+Z"NkG\)z EU'>i2nj':d(vHϨˣQ×ƌtnja0'endstream endobj 116 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 510 >> stream xcd`ab`ddd v541H3a!3#,)Cnnn? ~!Ș_Z_PYQ`hii`d``ZXX('gT*hdX뗗%i(gd(((%*@\KsRa`ad3{\e݋u}\}sپkZ8eZE;uRS|䨳ū[FdÍ߹9VK9ʪyݓLh\]U9{e`Tu7O#=btoz {˖w9j^*C׊.^s֌\Es*~}NtS8~wO^<;[]uwyw ǟݍ+9>_-:grzggvςC|Oylo-b>s e`endstream endobj 117 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1396 >> stream xu Lg("mUQ镹LM JƘ s9tQZڂ@ҵJDp3Y\tKe8%ƼW޺ѱ,s?!$I%ӏ]ތ[ryo#> 2yzj)h|9"$ -CO\ۤ7j5: Jq~QUH\d4rT%*2J(j+ku k j*a;9L1x$|D?eM5M'MNerI;lUe-= E^]N肮VWGx{.P63;|[.lCHuԓF1JPpN 3$Ы;a>۽]1ԻpCmV-F! 50 +bʤ =4щ~xp[i$'y7baGOOJ1Xǡg?\g+'q)y{_u-H$~x^!.̚q.`3ZLqXlv`~.4(D.pz NXp aVOӰfjx[>6JAHPxX\x[4_^r۫.nxT^M`n>w׫0}b6g np3YvQbl-`z[ ^S7!GMH0+!ms;Y ͭf]T~!ok5Ca9,X{!DN9+ش,`dQFjsfzXf&w%߸endstream endobj 118 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1607 >> stream xTmPw5ѻzfUnUֳۙ]'WQZD"B y#l6/ o@Ū=\jnn;_fo}y~ ,p_VRV6~ί_oPpe تm><ȕ@n &iV`989\%jIۤluԶ;^.oݺzEm29ݨhO3u@]פMWiZ^0 [--jrWaeh NmSS*+oQPOny-QhBKZJa؊Nn<^wrj +`b0VVz̋Sxr_iʥޓ_x<~daba?`.p}_XkvC8)bEIxLxz~qN)HaKB.9xD//9_YY#da}1p o%dpr y=Wci jL8`{ĕ*JhHßKJҖfxG {}1DW72^Z_a-w/R>͞>F.p~xW?JiZHD9Z&\^tHDP#AϬxBml鲀J}+7W!Dl㶃wߠ *0 @ ~K;["y{ɇ~=/u &!V 2a{C1Yl'\ȥGc i=hvSQYht: 1uknTHJj; Q:3'5 ŋmiuTg%'T*{Mߢ/HxVzN"=8yS Պ4Y?. E_BPlӹY .J̥owJy mkAȀ1E8:zĕ8rsϡԀe\vFE~ NޑmYloxd! VE)|= Blmp4ys.0F 4 14 hڈ6vUdRo44- R}cbCtfꜘ#5 z\Zαj Shk>Tz Bt7|{F ŖUt7b]`qnrDe١߽+޾ b:*㺈1):(ݹ[,%D m֚#xo<#2[F79(־IĥE%;[E23ao?"|~U;Hӡ&! !O_M._u_<4-=^CKIо޴V8@ucFWOFb0fqd淊]@/-Bg&f $XdR֪ ְJ\k|dt7QtEP^b2`6;5Nr`vlj&چ`i ?_p%")_n.*wendstream endobj 119 0 obj << /Filter /FlateDecode /Length 207 >> stream x] <o0`fjpыQ_A1dGۤniͱ ) Q=) mdH~zh6{W. ~p7hNmKC~ p/Cu W1Z9V: c -PoTm0e uQj9.-HeP=/Yvp?j> stream xUmL[U樓^֮×&I{Ma/0jfL٦Dq@vK }uBKi֖Z``bnc%3Q-/]4999'y~_+,p/ohC& MmyI7neP]V) m{JՋvkšX0b1kʸ4ϦN܊}=LgBgn^1b0@2Ҋ!wy"LGQ!C_zCG%YɝCaګR d<&8ל/9ku-@8Sɴ~; ["t =j)\]6tx}b[qϯ@MbXl|36 j e%d;ȖN |<ɤz?Za0_;ʲHsO_zaiS{c02:1V1DWѶp B".vϗ~gƁHuM0uxzm8^EUM7eeH^?1$v \:Kה&TjuG#Aa xU~qyQ*L'VK@"Xr7'[gvME=F\WCC"4cB!>}HQ;/Jx'%Bf4wpWD٭YIvB*6 6M6endstream endobj 121 0 obj << /Filter /FlateDecode /Length 181 >> stream x]1 E{N caИ"L 8XUS;jWᅉtoO8[DõtUXT`pS j)AOb7׸u-{c$CZn1y$tFȌJ2^ $el $eliS9l1Kt.iY _1endstream endobj 122 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1658 >> stream x]T}P[ 8r U1zZ!"LY/β:)x;o? |K_56{~^W#L xOz:0 û:vvW1\;]C,jۛ)^B%vΑQ@٩`!7pSAR<Xk(2cٽwQe5L€)I0R6-6C w7jȄ܄`n`+80_z \&e(0FWkUз{ S N+#;1+MRZ.պy @U@ Tqq|p>ņG[Q|U|CKdh%d +f ۨdz_b2x+[RWk4a= Zz=\_]Fn+ŏp퇫{]\:<.݁)B!{YMd .ڹf?tϯ1yuh9A|plPX`5ͽ\vihםO=JJ/esIR3 i[sNF.չÏzƘq4VqSVO4 ǧuṚ!Q^8#}%%;+3nΦSF>Ųx ǾbF󲬴kt!F|hRrj5*I#:9U  IDwbi4#nɦes+u45rP1m$ij~SxsW)I740O!dFĭ׀~΅3ԏR;Sdq"2dū+<ֿ/\prƓ2YOBۤbk O9vN"zhaendstream endobj 123 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 965 >> stream xEmLSw^[^ vв% CBbEJrKAR pHD-} P&u a"A058ܖ|I6#;r|yh*:i:tC%l(!EĹyrDL ~#XN@Kn/2ZZϥUsꜜl%Rp ZZjx֠â+7V| ySnfj3wҕUFI{+66\Ơ".3"h0Yx+5њ(Y廊x*zzBI)bhZߦDɢLQ!'=5`[2}ns}@5' >WBoM< !Xks “E6\9σ#pn\P{}P˛v 0C}EK񲱞>pF%0u1Wǘ%5RO9W܇) Iפ"lg7,¯#Ѕ9Wx橲}:K#?0ZOd$DA!=1bIG>Cő⾼"<(}g-lef@EgVzGMcRcO~ۻO#cS}5#g=ɣnK].wn֪0=eͽN8AMgWS6ק}mg$ez,X~i}[+萓$I `N&:V/-wtvuCˮ@$NdĒUmmt9;g.cr,dͥT/ޘ-$M6!|<HHb-k ECh$(]K=@?.[)?zTƁendstream endobj 124 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4453 >> stream xW XS׶>!pr!:ZPG*(NU@@F3L&27%ZH"Sā>Zϱ[4zc8;[-!n"@?z}DgRtwh,3~~(?_땢0ZP?L'R'v  DFIwt  1s͜/X}K~8XOl 6nDl&<-XF,'f+'*™p!kWb-aK,%F%aEQMC&c >1O00”0#a˜H$:xvJaF2qsr` R)v6g׬|᳇~qEE?YzZZf%:+4nQFt#tHws-kG źQt#*aX1 FIe<7Q,+Hɗw=_,Z`o]~̡W[3¯V!h;;U_ixP!Y/165[b`F~+{koܸu,WG50[7BBrO_bI l|xR#b/}) d2po0i8תCuATb=u7" OxO橖CjoĉQhH%*e#4t޸ѥ.7':3C聙ZXhIZ+?pFQ&BTFղ5 6"ߞuw.6,чX'O x0A{Rˇ .|Ud Ë YhyU̝{-+azA2Aou[ h+8 $[% =, b11 ҟj*4"]xP4G;obYo7۽;f[=1V^%e bTRĴϨ0iV 9U=A#i5\> 2v^#srRD0 ׍{%ZU}̵hVQ9U>YOx@ l`{!_Wӵwa1tlK>sЭUuN\ CfC-yۤO+b#'A=¦WKvOPsAD ,:ȶ[Y^*ھ.1r_fҥ&dy%wEճWqO$+mEY嚪G JIxaE1 j9ڝ=!3j+BN+ yJf!DpkӷS:Eɠ|RY< s!Ya^[l>n5׌0u5P\6. xdD:|&0FȇV@TVf0x@5_T\o&|I[I0SH_V ala"`{{Oʹ4`'8C_ԛKJQ*F}sCL}y_z͆JCWJeWūUh3h?AMm/8q7o`YG$zrvO}R]L-.>s(e?nؔM- 8Q3;,YT 1: ='(Zf-Qo:kRyWA 2ţ8*3S`S(/hlTUz-r9e@}b>_1M*}ڿ<]9HVr%ЩG!wCji1W (2R$Ջ-QX7n7o6ͧHUC Q2 k'hlq}Gs08*p>La*L־{C<OuKF7BkWӸxNMHHcz$Fg*2<{ӻF 6j3}޹nL'%!9RJxDK Z$ٟ^8u}Cn<-]X>TV[v ))9pQ1oŶ ly<5V'zUu|@u OWUU͊Sbn۲g=CD qQ_1gWmXgia[8TTeJ, |g{>G_q BuI(Ir0j22 =h !RRK ~-苾[`43ӞZPpuc䕲+"08A4ggj_2'\>ZnhuEj~j4*.4` /_i 8[=: ?Oè41'IE2*\Z]*o08<{27x/;/߂9z#y ]Xc mj2rBl( :c>QQΫgq*]KkNh/q13=Qr\VVX@ 'Uyf&*1!Z*߁(2?OT-NkZw]z%K;8q{>~BSs],Ͱ"Om:zøiO%X=y劣ǍsVsڏO.YͶ.C"*3Ľ?u:-0?{%fy^cqYQ ++9GӧPM#Lι24;''Q2UX\kopmu?ٖ|48ꞟCN_Vi)[Tk2( eǢ$}F[`y:zbw>]xGt|+8?5)iϠ[ N&q3-\Y6S9#M4*Iɖ#¸K Q ;\Niʜwv9!}B#08;J Sr`y%xrASvcۛ\iU.X[^kTV7ucKkwkb3Q>TK 2쓦b );R٨·#eV+@u\yk BAIaJp( S[ )H:620vFMBAMMNEF5c(bu Fo4Z-{ʟanoZvVeRmű>yuu4gqcq~WSi|zHBMy> stream xcd`ab`dddu 21H3a!.,)Ccnn߷ }O=F19(3=DA#YS\GR17(391O7$#57QOL-Tа())///K-/JQ(,PJ-N-*KMQp+QKMU9RD8)槤1000201012{ӏg!?EWwyzvws/>}|9ǟ^:C7C{y7%tX#WS'/`8}=n9.<'ܛ sendstream endobj 126 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3282 >> stream xW TS1{x7i-V"謠d߶>! T "$ 卆WH h,ij[o:;/;g7wl=sF@ kP?#؉B<:Xxo; ͥuǞ5sB((AutdF:%|/ `t,_\.4QrL?(TrMtJ`F7o̤$2G\8u4)Z%(OJUZR.uR)5r4DW%B[N$CEDFE+7wM'uzb1Dl&K_>2"%+*"XK1$M$hBI&{EGߌ8peK6RGVQӨlFn92g˨Qnn'p_`]VOtÈ>/Y\_?Ru wܥl3Y%NyIr+p3 CQcl "qcֺ*O 2K{J-Z;;*!4zMzypRn,7@wߡ%q[m j>o1t98 ˚c*eƭ ؠSڕ${ρӭkvg}X5%މ+>-@N|Pymc$L`7^9-%⓽$7YMsnPsp8ǁ'( Bvp0! .d4 Q+Djnf|(N*کombĎU9銩5 B_o)礔]N~5g7}p0E67L*@ueuY e}:,D8'4/1WD.G8Uke} 0cP4FVT)|-S_(iPμq1]Ձ#dS'Cw]錮`N*H(6QsQI^^˞s:+?[&%'#--nDuHM1J*| $jbWڇB;E;8o\" sޚH垦z՛Lj D<`=cIkMa8muvk w, 7U ;UԜy>Jl"W<#C2fNJX1Zz{w%ޡG[[WE%T 鋥v*ʰa ufƝݩcuvA=;ޟ T|ERmm1Ǖegscߑrc8T8X :-d1M[ZNA߻m=%]z5K1(p62:t+D=ס :'4B=?鼽 \ Cu 6G* `(HXAwؠ eeKK (lhh\^j^V1|\¡\Sf)/Ea{x~Nڹ:śMRŴ`R3!geR *%#t>LBԔ{+hw +v>p<}\x1=ViG֧5EzNx2w\뻭5~"[]@=in5]'hƳbp8*xOX[i.fypE& 9n'+ ?9`H`C4+r9œXqBeƷȢ,q%%G h4eʵ;Bye 6g~1}Ѓu%vZi^뿲eٲu5 }pz8ߛgK#kbc_GPeLxH x]]h?=OysA1v|Xz[{n49a_烖{ъFږlJK۬`JkJL\ȣ3s[]+kilVWpzML48CG>l>`ed) RUZݛs"e82-;CH5%XVYUN>X 9`jѽ~S{_ZVfdؠc[dq{IȾQHn?F4endstream endobj 127 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5858 >> stream xX XSWھ1z]~ދҺ/kպ  %@ ' %a_:jFkUZZv}$Aqcs6o7 F&b31B"mXb;XJ$7Db1XI"!Tb51XCL'fLbM,$z>D_џ@ b0H!DWb(!  ݉| Jx޵.k<"xE _!:}B={ֳ+g{/}Ϸ}W`6p/]P9hРA;X1uU<4rhPnaa_:s{MᾠuZkdHYсg)4 փ)YZR= i4JV ק8 ѥG' (!dA^(\ xk|sp(H{ " H0[p̐*n^=,MxFc0S';%~[۬uէϞrd8!WW qv|-4B}C}`o3H!aݿw㷷.0xJvIޠ^åigrS@W`/]ߜyO8g䗺a 23c铂>hPo_)SgywgLjYzH' eި;g71(Zp؉؉}$ZX;OyM\qkMu04DZ PSMIĔl,-ڊCq:پ\ "[`jImjn$P)j[*^îӞB?N 9L4ǒGl9c,v|ʪ'jFB*:v 6EԍWo&&CDP |\HLKu]<i8ԤPQ h=;ˈP3h(  OCK'(?Od{\0Bt E`ǜg'sd}C#,`4-] ]|%ȥ2rSJ wWBNf hOA!Nj`jeI#y5U[.Z;pi.xŻVђdpPnɲiȌjծې! }^ޥ68Lp&.-4=CQ3z,Ek<`!GP( CzN [TJ =䁫_*yp1n6|>4 ?2Z&s`2_Huν,OJ05Y mh*{q%8rfWjKCt*S;r eoղzsF[/}~dxԷo8$0'ȽCCQ_ݗV4[Q: gQw",tk+%hy}k<T*X *zasvNȣ,л=TĀXɎ[ EP /A@wzh55EM16;2EE!mi $E 0dpk ,O.-\xB`AC(l;8-P(vYK=ǘ곀&S99fF'eω#W`Vľ :.giN ^-`'DX!A84CW-Hy٧5GteH8CtFL 4L NMlp.z^$*n;< 77y ;_z UdIF6\WoO~L;IįV>p?YK~I}tzsX(2!#VgK_g^pk7>'GB{ |ãeYh~hw&Y 'BM"djs:Yw_nSN(0]EyIMix[叮kʽz9g&6@,zn(uS6Vkr*zӷ!ݿY*MX\xTW>$Q&ԔO 3}q 8fQX@:1;vt\M8}p ha[$j>AzpUgdIwnaۏlEM@fȁN5`ou'h=1?,B`SdN}#k|&uPL;0hؗ?)"P|X^Y2H|\6"t‘OJ.%\䕞?v j.aHR# +'ワWr4Ɏ+2yfQ:~7䈵ӧN5X$;% D3ȗTjݵp>3a`7zw|K/j>gݦ =vCr[nXzDgB >b'p1Uf:]|δ}Vv,~*'2QH BȔ4C1S(jm+p=.z˚'zH_S:EG bT6! Pdlf[!xy~_ތ׻YR #/wv*eH鉖u}M$`БK3E%*u>UJE-z;՘rR֡ʽ8Oܼ:!ͫ6ׁj8UG^x6y}w<3]NaHHmi`ЄgF_G"߃7 h2I|5vm3GGUrz oDb|t?}jae[XTaf;rg4oX6-یfPWKHs2MZPg9ZH.Ø֬6N\#6q֔F]r'd"gOrt.HC٪hŪz5WF<.=/D',&8C$ڀ}O_yNy_'FYΣOI&vM|(ND׆flek@'?)F+{>7s D]nB{_އS;~T[=E'ؖ=57/rPEh^R8 ^|֛͒'@>Sx-޲?Bd'd(ԥC^Ǫ@=Divcs\ C՟3 G{(X7 ȽNպwј# K"v`5d(Y RhR8ZtQ(}>E== I8Jk(-n dL#of;$'iC7k=+n`ݤ߃hC p$x dX`5mm15:)11N#wq;|#-ԸQ:@Rқf {^fCҬ7@jWxχҍxg⑖ƣnv.sއ6"".ʳsg[X+ת@NĖQYQh-g^W\7Z{ah3 G ­0A6:/0ՍS؉hΥJ7M޼*mi &YL%է@<Ϩmk/w62+k,ogٹkݴZ;\OFC{oo|u}reQUSjL3G/-Xސ*9@YA~( z>:;;pqq(cگ8Z2@L@&Ao=#2DVMU>[z6Oe835:&|u@WC%^nPRn2Y,;/Ѵm K'ﴟEExSeU iv|~Ok'iRwu~v :k8V*2(MR-yuԠ1wB`[[#jö(K- SjX6YSWeSg]pwѷ7ς[ԭ.hȘp@OL&v>>}n~-^;~qdXebλL/rÛ^}7[9}Xe셂p.`2Z*˪ߧ WtN&ЁĦݞ@Oys ak1\7B'=# Z,f+DY05I{մ(8N6ѓȅO_+k;àw#@}\a* ӫ֮رȻ98]ga 8R87cKғTr s ws|v G#|/4t:7g8ML;,x'Hmp57n0_mouS^tr\YW _UQ2eN&RQiϏ,b r`DmF)bt[y`>pl5$đH0\F<ڌ&ciI^)fT{ڛ`toS2j!JbUUZ L^T |¬RjC)NuYuAց-QMTzR)~y@}3I2leTV7`SiQذ#r;9;0L_\&]_Z)$Cb3.V*0IҬgPT-†z@W>S`S^48j7JV UV% ,h'J@UL2*ǜ^ۆ;v<_d?VzuXqj:DTtpa%Ê*FV3^exuBIFh02Ы153J%FsCX/Fa-\KR*Nɋoî}ﾤCѵiMF`012 \THRZOGWWw?GEwendstream endobj 128 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 986 >> stream xmL[eǟ*&&F`fPa E`XJycpf4aP$#.+edkmF~o?9 r!aSFPZׅH\yZ #,c[^ @K!gTĚzCyI,iV;Q& BѨ7VM U%W7'V}""cވ C(d䉼7zq$P: @qBEEb)pÐi'06WFԒCZ)|d!]^# m%s %ji'M=M|idۂ*W_fkb"\C7F>kWo-J:Z-XP(m[#:ԃ̘ɺsS rΨ*;WfRaz@Fl5>.†n!l*V ŻmNwg>=ӻӿ\lH)8TO׷}zR`'ݲ80e.WhriH{(?bd(o9}s]d(&"''"T7{Yvdu+[X7^17S`ԟamAk\)'pendstream endobj 129 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 404 >> stream xcd`ab`ddds4H3a!7,)C;nn? ~O/ȘW_PYQ`hii`d``ZXX('gT*hdX뗗%i(gd(((%*]&s JKR|SRYfq1޾}kN=7KDUW]Ww1G͌+&uϐl+#ќۨ7˵ߥP's~Urscߊߌi!yI9s=Ew+[yi Nʾ|u<< ,$endstream endobj 130 0 obj << /Type /XRef /Length 151 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 131 /ID [<5b1adb4bf4703fc9e49252c9ebdfe373><88dada2e20e7f2f630e162e01bd3c649>] >> stream xcb&F~0 $8J$lT$D\5Aڅ Tg{J buY DrI-ysA$oP"<@$sd="HF X=?v,""_6SDۂeMTp endstream endobj startxref 309254 %%EOF robustbase/inst/external/0000755000176200001440000000000013465050072015224 5ustar liggesusersrobustbase/inst/external/d1k27.rda0000644000176200001440000035650511762754374016600 0ustar liggesusersRDX2 X  d1k27@%~O"}@'R*o?R@(eO@&*8@&A(9-@(!6@$.2@&*A c @(}@&"S @) ^#@(3B¤@(¹M@'Ew@'hr!@&c^J8@'g@&8K@'/ @)| |[@$.2@'͛t@%Qm݃@'qpO4@'5inX@&g@*R`@&o@&OD)@(ŗN@&^lLYt@'2#@&gM3H@(JA @(8Go*Z@&>W@&ha@&_#cW@'-f@'M/^ @&e{z@'lnm@&NΚ,@(Mj@'PfB@'3cHk@&e+a@'|ϕ@)ܱF_@&6@'ZpU@&rT~@&}2f@((zc@'ƞFJ@( ~+U@(AH@)]Ww@%1y|ß@'th@&"}@'h73@&P@%HӮh^@(v'|E˼@'2<64@&Zqx@$b1Q@(āoh@'xuO7u@'W7@%?@&ha@(@(FFV@'^ @)yhH@&A(9-@' ǎk@'E1L@*_6@&"Y5@'G@&c^J8@'h73@(i_@'z$'@'E1L@'@@%wr(@'3]$@&r Ĝ@&*A c @)]x@#ef@(> @&^ N@&T ǎ@&8\g@&LB@'x*")@(v@&NΚ,@'H˒@'76g@'9K@&]ce@&Zqx@)&ݬ@'Jw@)o@'Gth@&90 )@'< oTK@'ѷX@&9 @$@'.y@'҈p@()QX(@'//t@&ЫNP@(ałU6@&D"@'7k;<@(\C@(L@#2i@&X@'X:S@'7@&`d@(tSM@'`N@&(@'c@'ٞ@(V@(*EM@(@4m9@& >l@'=@*~@&- @&!-w2@'FJ@&+@'_@@'n<`@'[\|ؘ@(F]c@'.y@'D Ri@&Zqx@&޳"@%$@% xF@(008@':@'䎊q@&~J@'T*0@(1;@&(@&ЫNP@&LB@& ǎk@'!bw@& 6P@&A(9-@(Iԕ*@(7@')A!la@( /@+.۵@&_ô@<6@&D@(O?R&W@&`d@)m ֶ@&fA@&A(9-@'FJ@&ۥS@'EwUq@(98R~@'X:S@'CfQm@'Цv @)F@(L/{J@( u"@'7k;<@) D @) @'xK@&x@'G@(X@'Ë@'Y/n@%fP@&ynX/E@&FIm@'P3@&*A c @'ܩiu@'ѷX@'eU.@%wN&@'5@&x@'+S@)AJM+,@(1 @)i>BZ@&9 @&`V. @%muO7v@'::э&@'N-b8<@'Q@(X@&*A c @'`V.@(\C@(v'|E˼@)b"@(e@'x*")@( @&LB@)1&y@& @'W7@'p*@(^ F@#ef@*ݕW@'W@'> @&X@&7@&Zqx@'28@(U;'@$.2@%HӮh^@(u"@'Bw\@(¹M@'/Y@&!-w2@'ޭՐ@'$s@'ߏG0@'@ =q@&NΚ,@&ha@&vݭ@'8Ck@)%@)͉/@&l@@'g @'ѷX@'@( /@'|ϕ@(NzVC@'28@'- @&P]@&^ N@&i}@&lsG@'EwUq@')A!la@(5H@%!Z@$$/@'2<64@' gw@&'!Wi@'c@(008@(K/V@'FJ@'[\|ؘ@&A(9-@%@'Bk΅4@&8K@&FIm@(R@({@)i>BZ@'D Ri@(s@&u^޾@&޳"@)6;%o@)Kq @'klC@(@*_@&6;%p@&^ N@&bM@&ha@'Ew@&WCcH@&Y@&o@&A(9-@&@gS@'28@&6;%p@'_@@'4@&P@&^lLYt@&ܜM@(AH@)fSP -@(#@'FJ@&?z:@%nY@'ϕ@' '76@&6;%p@&e+a@''(b@(]yg@(i;yS@&c^J8@'|ϕ@'.y@&>W@&Zqx@%Ԇ-@&OD)@'ϕ@#TEJ@';D=G@(ԊԿ@'B؃@(I^5?@*j?@&@'L@(v'|E˼@&^lLYt@&D@'W7@&(9-@#Ε*@&JL@%Ԇ-@'B؃@'@(TS@'҈p@%o@%+@'K@(lj@&z\|ؙ@)9XdE@'=@'7k;<@&E˼+@&5inX@'X:S@(}^_1@$xW@&lsG@)͉/@%0եb@'[ @(ӀP@'K@'āoh@' gw@)fWx@(I^5?@'g @(_ô@$@եb@&+@'x*")@$D<@'@ =q@&aQR@&?g@*|hs@'P@'om@(@%HӮh^@'27@&ЫNP@&ѢY@+],{ Z@&A c @(@&@&ha@'nCz@(ͳ|@'^ @&>B@&^ N@(եc@&>W@&@~@&@'FJ@%^"S@(ŗN@'.y@' ǎk@&FIm@%y k~@'N-b8<@'c @'EwUq@'-@&"S @%r@'L@'7@&i}@(O?R&W@'\(@')A!la@&@% $ @'^ @'N-b8<@&z\|ؙ@%$@&`d@&P]@&T ǎ@(@4m9@&]ce@'| (x@(Iԕ*@' @'r/Y@';D=G@(DZ1@'f3@&쪸@){J#9@&P]@'ߤ?@'>Y@(X@&sRC@'0h3@(-@&sRC@&D@'_@@%y k~@(6fffff@($')@(1;@'r ě@(}@(\C@&Zqx@(L/{J@)͉/@'4@'RwkQ@&@'X:S@'gwZ@'s-@$h<ϕ@&T ǎ@'Y/n@'Jw@(AH@&^lLYt@'>Y@(>p@%y k~@(L/{J@$.2@(tqq@(3B¤@'B؃@&P]@(SE @)e;K@'ɯ@'lnm@) 27@( /@'7k;<@%!Z@(1;@&ha@)#ᆘ5@'FJ@'c@)7ޓ@(NzVC@*/ M;@$.2@&wFz@'SE @#{`I@'FJ@'1@'7@'ce@%1y|ß@'ۋq @'W7@&rq6@%M@'ѷX@'>WS@&}w1@'wkP@(ioiD@'28@&@'GM3H,@'N-b8<@(UoiDg@&hb@%r@&c^J8@)3PH@&*A c @&lsG@&D@'PfW@'|ϕ@)'n@&Y@'q Eb@'n<`@&g@(eK@'aR~R@((zc@'@&ha@'7k;<@'S@&LB@&]ce@&u!S@&ha@'|ϕ@&P@&NΚ,@'#@'9K@&ZڹY@'ߏG0@'2<64@'FJ@'x*")@&ЫNP@'< oTK@'E1L@)H>BZc@(WE84@'Ë@&NΚ,@'>Y@'ZpU@&hW @'䎊q@'ߏG0@'< oTK@'p*@(ɯ@(Hh@)JE@''=["@& @&u@(%#M@&T ǎ@'҈p@%DSMj@&P]@#Ε*@'Bk΅4@'IA!la@%˒:)@*AJM+@(O?R&W@(rd2n@&A c @'ܩiu@%r@& `V. @&"&r@'ߏG0@&쪸@&*8@%HӮh^@).H@(+@&9 @'.y@)s")@(L/{J@(_*ZFs@'h73@'28@'@ =q@&- @&e{z@'c@(i_@&6;%p@'nCz@'5@&9 @&6@'z$'@(,<@&ɃQX(@&P]@&LB@(\C@&*A c @&X@'P3:~@'N-b8<@(UoiDg@'x*")@&ha@(i;yS@&!-w2@&j@(@4m9@( @& (@'B؃@''(b@&=`N@'RwkQ@&E˼+@)KCW@'hr!@''(b@(AH@&f3@( 6@%!Z@&gM3H@'Bk΅4@((zc@(AH@&E˼+@&P]@)F@'hH@(L/{J@&Zqx@'7@(O?R&W@)m8Y@( @(O?R&W@'5@&6;%p@'|ϕ@'h73@'tW}W@)*cP@#Rş@'āoh@#Rş@)Z'(b@'7@'wk@(1;@)fWx@&o]@'䎊q@&*A c @*EwU@(3B¤@(a@N@)*cP@*_Ë@'@ =q@(@'+S@' ǎk@'lK[@&ЫNP@(3H+@'c@&&`V.@(L/{J@'2<64@'- @&o@&Zqx@&)Dg8~@(v'|E˼@%w#d@)KCW@&>B@)*cP@'EwUq@(:!B@%I@(U=@'.y@(As@')A!la@&g@'jS|@%v5B@&j@)Ad2@'c@(a@O@*>LX@%!Z@&A(9-@(s@)>3@'-@'6/e@(K/V@&_I@(F]c@*UDR@&1߹8R@'hA_@'Ë@(v'|E˼@'[\|ؘ@'7k;<@$6}2f@'fWx@&*A c @&@%Б}kf@)l@(¹M@'҈p@&+@&*A c @&@'*o?R@&>"@'2<64@'N-b8<@'d@'d@%!Z@& k;=@'@ =q@(K/V@&P@'@ =q@&z\|ؙ@#L7@'&]cf@'d@'[\|ؘ@&u%F @'G@%0H@@(WE84@(ӀP@&6@'EwUq@' Fd@&N@'2#@%+@'ޭՐ@&|ßa@'%@%DSMj@&?g@&e{z@'2#@(L/{J@'[\|ؘ@):=B@%>< @&޳"@&Zqx@&9 @'-@&Y >@'76g@'C]@(o;dZ@'EwUq@&@N@'7k;<@'>-b9@("S@(c 4@%Pa@&ѢY@')A!la@'&]cf@#Ε*@'g @%1y|ß@%Jt}^_@*!$Jb#@&gM3H@(L/{J@'28@'Jw@'x*")@'Q@#;Jm3@'7k;<@)+jg@'L@'!5`@'E1L@'B؃@&h`@$h<ϕ@'IW@'2<64@&@(;@' qiC@%Y@'7k;<@'EwUq@&^ N@'ѷX@(^ F@'B؃@&YE@'x*")@'3cHk@&g@&H߹8@'2<64@%y k~@*ȊG@&x@&6@'7k;<@&$Jb$@'8Ck@(Ma@&ZڹY@'- @'_@@(L/{J@'_@@(#@'< oTK@%Ԇ-@("S@&sRC@'Q@' ǎk@'W7@*GK]d@(E@&P]@'z$'@&NΚ,@&6;%p@)͉/@' :@(&V@@)^)@'̸@'VWx- <(%VW2 JP1 2?/%Z)b 4 >'1eB 2$.")+T+$I+A(4/-T-(-+P=,**,O-)   K9=d>'+;#)9+A,#*'U@ %$(-O *&+#cA&$K5c51*!3&0+1$KxX '(=YY(G(7**`,DD)"-)& d # ><#K431;"<1E 5 2(#+?$?"e6) +:*3 0 Z(4,2$',<+(6+>5N%V"71 >+*1XJ#!H&2- 0c,2!,8+:<( 4!I @7 K30,&d?-316++$'6 ,#(Kb7(-" +*%*D_ @$ 4K-5A8.# 0,,% _($-Z<<,B'd0kd(+K!3Y0+9 +-,+6PK+*E0K4='K#-)-!-4'-)* U A*-7,79K2 -(b+!-.">P 9=+UY !K.?d# b!Y,!5Z(KT##"-d$P)dG)2'" "2+)3$)+ #,7 :$$> P .(<)20R3!L&dN J//#"&.3 I3J3d.2G-'d/<1J'K( '")H"8d(% #< =,'1+_/Ld,!'Y P0(= :#$?)!56L+2*":c2,>K d9S< 2*!=32L*5eK )+046122"P',-F2 .K"6/7221:@,$M$(2-G.-#-)(T.c2 +1Fdc2*) )5!A9.P%03d,1BL)-*$XF.+( 4&P"@53$#??@??@??@ @@@@@@?@?@@ ?@ ?@@?@ ??@?@?@@???@??@?@@?@@@@ ?@@@?@@??@@@?@ @@@?@?@???@@?@??@??@?@@??@@@??@@@@?@???@ ?@ @@@???@???@?@@@ ?@???@??@@@@ @@?@??@@???@??@ ?@??@@@@@ ?@@@??@ ???@ @@??@@@@?@?@ ?@?@@????@??@?@???????@@?@?@@@ ??@???@@@@?@?@@@?@@@@@@??@@@@?@@??@?@??@@??@??@@@?@@????@??@@@@@ ???@?@????@@@@@ @@@@@ @@??@?@???@?@@@?@?@@ @@ ????@@@??@@@@@@ @@ ?@@@?@ @@??@?@??@ @@@@@?@@???@@@??@@@ ?@@@??@?@?@??@???@@@@??@??@@@@@ ?@@@ ?@@???@??????@??@???@@ @ ???@?@??@@ @@@?@??@?@@@@@?@@???????@@ @ @@?@@?@@?@?@@??@?@@?@?@@?@??@?@?@@ ?@@?@@?@????@@@??@@????@?@???@@???@@?@@???@@?????@@@@@@@?@?@ ?@?@@?@?@??@@@?@@@@ @@?@@@@??@@@??@?@?@?@?@@??@ ?@?@?@ @?@ @@ ?@???@@@?@???@??@@??@?@??@@ ????@@@@??@@???@ ?@??@?@@@?@????@??@@?@@?@?@?@@@?@@?@ @@?@@@ ???@?@????@?@@@?@???@???@ @?@@@@@@?@??@@@@@@@@??@@??@?@@@@@?@@ ?@@@@@@?@@?@???@@??@@@@?@@ @@@?@@@@?@?@ ?@@@ @??@ @@@@ ?@@@@@@??@@@???@ ?@@@ @@?@?@?@@?@@@@@??@@@@@?@@?@@@@??@???@@ @??@@?@@@@???@????@@@???@@??@???@?@?@??@@@ ????@?@?@@??@@@???@@???@ ?@@@???@@@@?@?????@??@@?@@ @?@@??@?@ ????@@?@@@@@@@@?@@?@@?@@?@@@@ @@ 4 ``  "L 5 xY u  8lrL ^ D  _k: L| n<  a D Me %/?i @x)  Y $8Q#0 .2 RLT  8thL 4F" .5SL ~@N%O a rZWt  L /O lre . X ]j eL ` PFd lrRL  Z 6fb  HOp1=XX%j~ t`te  rl'tx{ K@ :  x 0Bl H Gr~8   hALf LLhoe Z Y bi@l z: : ` KJL  i 4  Fd.e J {T D4T(dLV ( ` @'y HC"xL,$L 6@R^jt  : `, T#c . ? Y T|] # dJ x f  /x(F CH 7 r OHy=hL9Y T 1 V M~C  t.\=@ = >r` F 0@ (lmoFy5 {    @ZYL LYWe@ ~ 9( c $ f,T4  T> `r  i dX "#4 c*: ` w! L ;g KD,r$ ] Z~ G  s:4-l\ L< lTxKDzRx +-  LIfAFD|au 8I s}9q  T| H 5 ^ 1?4 z 4Lt i$'r@FUjU xp nY! 8f~ p T? =p ? =p ?p =q?(\)?Q?QR?Q?Q?(\)?Gz?zG{?p =q?zG{?zG{?\(?QR?p =q?Gz?Gz?ffffff??У =p?\(?333333?ə?(\)?QR?Q?ə?\(?ə?ҏ\(??Q?Q?Gz?\(?(\)?\(?\(?333333? =p ?333333?У =p?ə?(\)@ =p ?У =p?\(?ҏ\(???\(\?ə?\(?GzH?Gz?(\)?zG{?333333?θQ? =p ?zG{?޸Q?Q? =p ?(\)?p =q?QR? =p ?\(?zG{?zG{?zG{?Gz?p =q?Q?ٙ?Gz? =p ?? =p ?zG{?p =q? =p?(\)?Gz?QR?\(?ə?Q?QR?Q?Gz?QR??Gz?Q?(\)?=p =?Q?\(? =p ?Q?ə?ҏ\(?p =q??\(?Q?333333?zG{?zG{?333333?(\)?Q?\(?333333?Gz?ffffff?ffffff??(\)?ə?ə?zG{?Q?zG? =p ?У =p??У =p?=p =?ٙ?p =q?(\)?׮zG?θQ?У =p? =p?Gz?Q?У =p?(\)?QR?p =q?333333?ٙ?\(?=p =?θQ?ə?zG{?Q?zG{?Gz?GzH??\(?ə?\(?У =p?QR??\(?(\)?(\)?(\)?Gz?Q?Q?Gz?ffffff?333333??Q?QR? =p ?QR??Q?\(?\(?θQ?ҏ\(?QR?\(?Q?zG{?Gz?333333?(\)?ə?Q? =p?zG{?p =q???Q?333333?QR?Q??p =q?333333?333333?Gz?Q?ٙ?zG{?ҏ\(? =p ? =p ?Q?Q?333333?θQ?(\)?zG{?Q? =p ?333333???QR?(\)?Q?zG{?(\)?Q?Gz?Gz??Q?(\)?GzH?Q??ə? =p?333333?zG{?(\)? =p ?Gz?θQ?zG?Q?Gz?333333?θQ?\(?\(?? =p ?=p =?\(?(\)@Q?zG{?Q?zG{?Gz?\(?θQ? =p?QR? =p ?Gz?333333?Gz? =p ?333333?zG{?Q?Q?Gz?(\)? =p?Gz?ə?ə?zG{?333333?Q?\(?(\)?333333?QR?(\)? =p?θQ?׮zG?(\)?GzH??Q? =p?(\)?zG{? =p ?333333?ə?(\)?Q?p =q? =p??ə?GzH? =p?QR?ᙙ?ҏ\(???Gz?p =q?QR?\(?p =q? =p ?p =q? =p ? =p?p =q?\(?GzH?(\)?=p =?QR?zG{?Gz?θQ?QR?Gz? =p@zG???У =p?(\)?Q?Gz?Gz?Q? =p?QR?θQ?zG{?\(?Gz?zG{?(\)?p =q?У =p?Q?zG{?(\)?\(?Q? =p ?Gz?θQ?ə?\(?p =q?Q?333333?(\)?GzH? =p?ə?p =q?(\)?޸Q?p =q?Gz?zG{?? =p ?333333?Q?p =q?GzH?Gz?zG{?Gz?ҏ\(?? =p ? =p ?\(?Gz?zG{? =p ?zG{?GzH?=p =?(\)?θQ?333333?Q??zG?GzH?Q?333333?333333?zG{?Q?ə? =p?(\)? =p?QR?333333?ᙙ?У =p? =p?Gz?Q?ۅQ?\(?\(?Gz?Gz? =p ?Gz?Q?\(? =p ?У =p?ҏ\(?=p =?\(?(\)?zG{?(\)?Q??ҏ\(??Q? =p ?p =q?ə?Q?QR? =p ?Q?? =p ?Gz?Q?QR??(\)? =p ?Q?zG{?\(?У =p?Q?(\)?Gz?޸Q?θQ? =p ? =p ?\(?ə?\(?Q?(\)??ə?Gz?Q?Gz? =p ?(\)??zG{?=p =?333333?Gz? =p?Q?333333?Q? =p ??zG{?\(?GzH? =p? =p ?zG{?(\)?Q?GzH?p =q?=p =?Q??ə?(\)?Gz?zG?Q?Q?Gz?Q?zG{?p =q?Gz?zG{? =p ?Q??ffffff??Q?(\)?У =p? =p@QR?\(?zG{?GzH?Q?θQ?(\)?GzH?Q?p =q??ə??\(? =p?(\)?Gz?zG{?Gz?θQ?QR? =p ?Q? =p ?p =q?333333?Gz?zG{?QR?Q?GzH?(\)?Q?Gz? =p ?p =q?ə?QR?zG{? =p ?ə?(\)?zG{?p =q@\(\?Gz?zG{?ə?Q?QR??zG{?(\)?Gz?׮zG?zG{??\(?333333? =p ?zG{?333333?zG{?zG{?QR?޸Q?Q?ə?(\)??QR?ٙ?333333? =p?ҏ\(? =p ? =p ??ҏ\(?Gz?\(?(\)?(\)??=p =?\(?(\)?У =p?\(?Q?333333?333333? =p ?Q? =p ?ҏ\(?ə? =p?QR?Gz?(\)? =p ?(\)?p =q?zG{?θQ?Gz?ə???Q?zG{?Q?p =q? =p ?QR?\(?ə? =p?p =q?Gz?zG{? =p ? =p ?=p =?(\)?333333?p =q??333333?333333?p =q??p =q?Gz?p =q?Q?p =q? =p ?Q?ҏ\(? =p ?ə?Q? =p?Gz?\(?Gz?ə?\(?Q?(\)?zG?\(?Gz?\(? =p?Q?Gz?θQ?\(?p =q?(\)?zG{?Q?ffffff?Gz?Gz?p =q?Gz?zG{?QR?p =q??p =q?Q?θQ?Q?\(?Q?\(?Gz?Gz?陙?Gz?θQ??(\)?Q?Q?Q?\(?p =q?zG{???ٙ? =p?\(?GzH?\(?zG{?333333??zG{? =p?(\)?GzH?QR?\(?Gz?θQ??Gz?\(?GzH?ҏ\(?zG{?333333?? =p?\(?(\)? =p ?QR?Gz?Gz?QR??Q?GzH?Q?zG{? =p ?Q?У =p? =p ?\(?Q?ə?Q?θQ?\(?Gz? =p?ۅQ?θQ?Gz?\(?\(?У =p? =p ?θQ?Q?\(??ٙ?Q?У =p?ffffff?У =p??zG{?(\)?zG{?Q?Q?Q?Q?ҏ\(?θQ?zG{?? =p?zG{??У =p? =p?У =p?333333?ٙ?zG?333333?QR??p =q?QR?У =p?У =p?zG{?Q? =p ??Gz?ҏ\(? =p ??zG{??ffffff?p =q?=p =?GzH?zG{? =p?333333?(\)??Q? =p?(\)? =p ?QR?\(?(\)? =p ?\(?Q?θQ?p =q?У =p? =p?zG{?p =q?\(?zG{??QR?Q?\(?޸Q?У =p?QR? =p ?(\)? =p ? =p ?zG{?Q?陙?Q?333333?\(?GzH?ə?У =p?\(? =p ?333333?ə?333333?(\)?(\)?Q?zG{?GzH?333333?Q?333333?\(? =p ?(\)?p =q? =p ? =p?GzH?(\)?(\)?Gz? =p?p =q?(\)?Gz?333333?\(? =p ?\(? =p?ffffff?p =q?θQ?zG{? =p ?Q? =p?(\)?ə?Gz?\(?=p =?Gz?θQ? =p ?zG{?(\)?zG{?ۅQ?p =q?ə?Gz?333333?Q?Q?zG{?zG{??GzH?У =p? =p?zG{?Q?Gz?Q?333333?޸Q?\(?QR?Q? =p???ə??Q??p =q?(\)?ə?? =p ?QR??Q?\(?ə?(\)?QR??QR?zG{?ٙ?zG{?Q?QR?p =q?Q?\(?? =p?Gz?QR?(\)?333333? =p ?Q?QR??ۅQ?Gz?QR?=p =?Gz?Q? =p ?zG{? =p?333333?p =q?Gz?Gz?Gz?Q  levels 0 1 class factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor  0 1 factor names y a tb tf A r2 r3 r4 r5 r6 r7 r8 r9 t01 t02 t03 t04 t05 t06 t07 t08 t09 t10 t11 t12 t13 t14 row.names  data.frame robustbase/inst/include/0000755000176200001440000000000013465050072015025 5ustar liggesusersrobustbase/inst/include/robustbase.h0000644000176200001440000000541113177447140017356 0ustar liggesusers#ifndef __robustbase_h__ #define __robustbase_h__ #include // for SEXP #include #ifdef __cplusplus extern "C" { #endif SEXP C_psifun(SEXP x_, SEXP c_, SEXP ipsi_, SEXP deriv_) { static SEXP(*fun)(SEXP, SEXP, SEXP, SEXP) = NULL; if (fun == NULL) fun = (SEXP(*)(SEXP, SEXP, SEXP, SEXP)) R_GetCCallable("robustbase","R_psifun"); return fun(x_, c_, ipsi_, deriv_); } SEXP C_chifun(SEXP x_, SEXP c_, SEXP ipsi_, SEXP deriv_) { static SEXP(*fun)(SEXP, SEXP, SEXP, SEXP) = NULL; if (fun == NULL) fun = (SEXP(*)(SEXP, SEXP, SEXP, SEXP)) R_GetCCallable("robustbase","R_chifun"); return fun(x_, c_, ipsi_, deriv_); } SEXP C_wgtfun(SEXP x_, SEXP c_, SEXP ipsi_) { static SEXP(*fun)(SEXP, SEXP, SEXP) = NULL; if (fun == NULL) fun = (SEXP(*)(SEXP, SEXP, SEXP)) R_GetCCallable("robustbase","R_wgtfun"); return fun(x_, c_, ipsi_); } double C_rho(double x_, const double* c_, int ipsi_) { static double(*fun)(double, const double[], int) = NULL; if (fun == NULL) fun = (double(*)(double, const double[], int)) R_GetCCallable("robustbase","rho"); return fun(x_, c_, ipsi_); } double C_psi(double x_, const double* c_, int ipsi_) { static double(*fun)(double, const double[], int) = NULL; if (fun == NULL) fun = (double(*)(double, const double[], int)) R_GetCCallable("robustbase","psi"); return fun(x_, c_, ipsi_); } double C_psip(double x_, const double* c_, int ipsi_) { static double(*fun)(double, const double[], int) = NULL; if (fun == NULL) fun = (double(*)(double, const double[], int)) R_GetCCallable("robustbase","psip"); return fun(x_, c_, ipsi_); } double C_psi2(double x_, const double* c_, int ipsi_) { static double(*fun)(double, const double[], int) = NULL; if (fun == NULL) fun = (double(*)(double, const double[], int)) R_GetCCallable("robustbase","psi2"); return fun(x_, c_, ipsi_); } double C_wgt(double x_, const double* c_, int ipsi_) { static double(*fun)(double, const double[], int) = NULL; if (fun == NULL) fun = (double(*)(double, const double[], int)) R_GetCCallable("robustbase","wgt"); return fun(x_, c_, ipsi_); } double C_rho_inf(double x_, const double* c_, int ipsi_) { static double(*fun)(double, const double[], int) = NULL; if (fun == NULL) fun = (double(*)(double, const double[], int)) R_GetCCallable("robustbase", "rho_inf"); return fun(x_, c_, ipsi_); } double C_normcnst(double x_, const double* c_, int ipsi_) { static double(*fun)(double, const double[], int) = NULL; if (fun == NULL) fun = (double(*)(double, const double[], int)) R_GetCCallable("robustbase", "normcnst"); return fun(x_, c_, ipsi_); } #ifdef __cplusplus } #endif #endif robustbase/tests/0000755000176200001440000000000013465050200013560 5ustar liggesusersrobustbase/tests/comedian-tst.R0000644000176200001440000000442112437665430016312 0ustar liggesusersrequire(robustbase) source(system.file("test-tools-1.R", package="Matrix", mustWork=TRUE)) showProc.time() data(hbk); hbk.x <- data.matrix(hbk[, 1:3]) covComed(hbk.x) covComed(hbk.x, n.iter=4) showProc.time() data(radarImage) covComed(radarImage) covComed(radarImage[,3:5], n.iter = 5) showProc.time() data(bushfire) ; covComed(bushfire) data(heart); covComed(heart[, 1:2]) data(starsCYG); covComed(starsCYG) data(stackloss); covComed(stack.x) showProc.time() if(!robustbase:::doExtras()) quit() ## if ( doExtras ) ----------------------------------------------------------------- ## ============== i.rr <- c("raw.cov", "raw.center", "cov", "center") n <- 1024 ; p <- 7 set.seed(47) showSys.time( rX <- replicate(100, covComed(matrix(rnorm(n*p), n,p))[i.rr], simplify=FALSE)) ## Computing simulation-average (cov / center) <==> looking at Bias ## _FIXME_ Really look at "MSE = Var + Bias^2" -- or something like ## "simulation-average Squared Error or other Loss" C0 <- Reduce("+", lapply(rX, `[[`, "raw.cov")) / length(rX) C. <- Reduce("+", lapply(rX, `[[`, "cov")) / length(rX) round(1000 * C0) round(1000 * C.) assert.EQ(C0, diag(p), tol= 0.04, giveRE=TRUE) #-> 0.02805 assert.EQ(C., diag(p), tol= 0.09, giveRE=TRUE) #-> 0.06475 ## Hmm.. raw.cov is better than cov ?? c00 <- Reduce("+", lapply(rX, `[[`, "raw.center")) / length(rX) c0 <- Reduce("+", lapply(rX, `[[`, "center")) / length(rX) stopifnot(print(sqrt(mean( (c00 - rep(0, p))^2 ))) < 0.005)# 0.004188 stopifnot(print(sqrt(mean( (c0 - rep(0, p))^2 ))) < 0.005)# 0.003434 n <- 4096 ; p <- 11 set.seed(17) showSys.time( r4 <- replicate(64, covComed(matrix(10+rnorm(n*p), n,p))[i.rr], simplify=FALSE)) C0 <- Reduce("+", lapply(r4, `[[`, "raw.cov")) / length(r4) C. <- Reduce("+", lapply(r4, `[[`, "cov")) / length(r4) round(1000 * C0) round(1000 * C.) assert.EQ(C0, diag(p), tol = 0.025, giveRE=TRUE) # 0.0162 assert.EQ(C., diag(p), tol = 0.06 , giveRE=TRUE) # 0.0486 ## Again... raw.cov better than cov ?? c00 <- Reduce("+", lapply(r4, `[[`, "raw.center")) / length(r4) c0 <- Reduce("+", lapply(r4, `[[`, "center")) / length(r4) assert.EQ(c00, rep(10, p), tol = 2e-4, giveRE=TRUE)# 7.97267e-05 = "raw" is better ? assert.EQ(c0 , rep(10, p), tol = 2e-4, giveRE=TRUE)# 0.0001036 robustbase/tests/MT-tst.R0000644000176200001440000001537412413747102015053 0ustar liggesusersrequire("robustbase") ##---> ./poisson-ex.R ## ~~~~~~~~~~~~~~ for more glmrobMT() tests source(system.file("test-tools-1.R", package="Matrix", mustWork=TRUE)) ## -> assertError(), showSys.time(), ... source(system.file("xtraR/ex-funs.R", package = "robustbase")) ## -> newer assert.EQ() {TODO: no longer needed in 2015} if(!require("sfsmisc")) { eaxis <- axis # so we can use eaxis() below } (doExtras <- robustbase:::doExtras()) ## Explore the espRho() function: --------------------------------------------- if(!dev.interactive(orNone=TRUE)) pdf("MT-E_rho.pdf") E.rho <- robustbase:::espRho lambdas <- ((1:10)/2)^2 cws <- c(1, 1.5, 1.75, 2, 2.25, 3) (gr <- expand.grid(lam = lambdas, cw = cws)) Egr <- apply(gr, 1, function(r) { lam <- r[["lam"]]; cw <- r[["cw"]]; sL <- sqrt(lam) xx <- seq(lam - 2*sL, lam + 2*sL, length=17) vapply(xx, function(X) E.rho(lam, xx=X, cw=cw), NA_real_) }) str(Egr)# 17 x 60 mLeg <- function(pos, type="o") legend(pos, legend=paste("lambda = ", format(lambdas, digits=2)), lty=1:5, col=1:6, pch= c(1:9, 0, letters, LETTERS), bty="n") matplot(Egr[, gr[,"cw"]== 1.0 ], type="o",main="c_w = 1.0" ); mLeg("bottomright") matplot(Egr[, gr[,"cw"]== 1.5 ], type="o",main="c_w = 1.5" ); mLeg("bottomright") matplot(Egr[, gr[,"cw"]== 1.75], type="o",main="c_w = 1.75"); mLeg("bottomright") matplot(Egr[, gr[,"cw"]== 2.0 ], type="o",main="c_w = 2.0" ); mLeg("bottomright") matplot(Egr[, gr[,"cw"]== 2.25], type="o",main="c_w = 2.25"); mLeg("bottomright") matplot(Egr[, gr[,"cw"]== 3.0 ], type="o",main="c_w = 3.0" ); mLeg("bottomright") dev.off() ## Explore the m() function: --------------------------------------------- if(!dev.interactive(orNone=TRUE)) pdf("MT-m_rho.pdf") mkM <- robustbase:::mk.m_rho # itself calling splinefun(*, "monoH.FC") getSpline.xy <- function(splfun) { ## Depending on the version of R, the ## environment of splinefun() slightly changes: stopifnot(is.function(splfun), length(e <- environment(splfun)) > 0) if("x0" %in% ls(e)) list(x = e$x0, y = e$y0) else list(x = e$x, y = e$y) } m21 <- mkM(2.1, recompute=TRUE)# the default 'cw = 2.1' m16 <- mkM(1.6, recompute=TRUE) p.m2 <- function(mrho, from = 0, to, col=2, addKnots=TRUE, pchK=4, cexK=1.5, ...) { stopifnot(is.function(mrho)) curve(mrho, from, to, col=col, ...) curve(sqrt(x), add=TRUE, col=adjustcolor("gray",.5), lwd=2) if(addKnots) points(getSpline.xy(mrho), pch=pchK, cex=cexK) } p.m.diff <- function(mrho, from = 0, to, col=2, addKnots=TRUE, pchK=4, cexK=1.5, ...) { stopifnot(is.function(mrho)) curve(mrho(x) - sqrt(x), from=from, to=to, n=512, col=col, ...) abline(h=0,lty=3) if(addKnots) { xy <- getSpline.xy(mrho) if(is.numeric(x <- xy$x)) points(x, xy$y - sqrt(x), pch=pchK, cex=cexK) else warning("'addKnots' not available: No knots in function's environment") } } p.m2(m21, to=10) p.m2(m16, to=10) p.m2(m21, to=50) p.m2(m21, to=120, cexK=.8) p.m.diff(m21, to=120, cex=.5)# pchK="." p.m.diff(m16, to=120, cex=.5)# pchK="." mm21 <- function(.) robustbase:::mm(., m21) environment(mm21) <- environment(m21)# <- for p.m() p.m2(mm21, to=120, cexK=.8) p.m.diff(mm21, to=120, cexK=.8)#-- discontinuity at 100 !! ## TODO: ways to improve! ## Here: look at "larger lambda" (and more cw) la2 <- 5*2^seq(0, 10, by = 0.25) c.s <- .25*c(1:10, 15, 50) mL <- lapply(c.s, function(cc) mkM(cc, lambda = la2, recompute=TRUE)) str(mL, max=1) # a list of functions.. assert.EQ(la2, getSpline.xy(mL[[1]])$x) mmL <- sapply(mL, function(F) getSpline.xy(F)$y) matplot(la2, mmL, type ="l") # "all the same" from very far ... mm.d. <- mmL - sqrt(la2) matplot(la2, mm.d., type ="l", xlab=quote(lambda)); abline(h=0, lty=3) legend("bottom", legend= paste("cw=",c.s), col=1:6, lty=1:5, ncol = 3, bty="n") matplot(la2, -mm.d., type ="l", xlab=quote(lambda), log = "xy", axes=FALSE) eaxis(1); eaxis(2) legend("bottom", legend= paste("cw=",c.s), col=1:6, lty=1:5, ncol = 3, bty="n") ## ok, that's the correct scale c.s2 <- c.s [c.s >= .75] mm.d2 <- mm.d.[, c.s >= .75] matplot(la2, -mm.d2, type ="l", xlab=quote(lambda), log = "xy", axes=FALSE) eaxis(1); eaxis(2) legend("bottomleft", legend= paste("cw=",c.s2), col=1:6, lty=1:5, ncol = 3, bty="n") ##-> log (sqrt(lam) - m(lam)) = a[c] - beta * log(lam) : dd2 <- data.frame(m.d = c(mm.d2), cw = rep(c.s2, each = length(la2)), lambda = rep(la2, length(c.s2))) ## gives a pretty nice picture: summary(fm <- lm(log(-m.d) ~ 0+factor(cw) + log(lambda), data = dd2, subset = lambda >= 50)) ##=> slope of log(lambda) = -1/2 dd3 <- within(dd2, { ld2 <- log(-m.d) + 1/2 * log(lambda) })[dd2[,"lambda"] >= 50,] plot(ld2 ~ cw, data = dd3, type = "b") plot(ld2 ~ cw, data = dd3, type = "b", log="x") coplot(ld2 ~ cw|lambda, data = dd3) coplot(ld2 ~ cw|log(lambda), data = dd3) coplot(ld2 ~ log10(cw) | log10(lambda), data = dd3) dev.off() ##-------------------------------------------------------- end m(.) ------------- ## The simple intercept example from ./glmrob-1.R set.seed(113) y <- rpois(17, lambda = 4) y[1:2] <- 99:100 # outliers y.1 <- y x.1 <- cbind(rep(1, length(y))) options("robustbase:m_rho_recompute" = TRUE)#-> recompute in any case: showSys.time( r <- glmrob(y ~ 1, family = poisson, method = "MT", nsubm=100) )# some output str(r) ## was c(ini = 1.30833281965018, est = 1.29369680430613) ## then c(ini = 1.30833281965018, est = 1.29369680422799) ## c(ini = 1.30833281965018, est = 1.29369680430627) r.64b <- c(ini = 1.30833281965018, est = 1.29369680452016) stopifnot(r$converged) assert.EQ(r$initial, r.64b[["ini"]], check.attributes=FALSE, tol = 1e-13)# rel.diff: 3.394.e-16 assert.EQ(r$coefficients, r.64b[["est"]], check.attributes=FALSE, tol = 1e-09)# as long we use different optim()) ## now, as the algorithm has a random start: set.seed(7) nSim <- if(doExtras) 20 else 2 showSys.time(LL <- replicate(nSim, glmrob(y ~ 1, family = poisson, method = "MT"), simplify=FALSE)) ini <- sapply(LL, `[[`, "initial") est <- sapply(LL, `[[`, "coefficients") ## surprise: all the 20 initial estimators are identical: stopifnot(diff(range(ini)) == 0, diff(range(est)) == 0) ## probably too accurate ... but ok, for now assert.EQ(est[1], r.64b[["est"]], check.attributes=FALSE, tol = 1e-10)# Winbuilder needed ~ 2e-11 assert.EQ(ini[1], r.64b[["ini"]], check.attributes=FALSE, tol = 1e-10) ccvv <- sapply(LL, `[[`, "cov") stopifnot(ccvv[1] == ccvv) assert.EQ(print(ccvv[1]), 0.0145309081924157, tol = 1e-7, giveRE=TRUE) cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' ## "Platform" info (SysI <- Sys.info()[c("sysname", "release", "nodename", "machine")]) if(require("sfsmisc") && SysI[["sysname"]] == "Linux") ## not on the Mac (yet) c(SysI, MIPS=Sys.MIPS(), Sys.sizes()) else SysI robustbase/tests/lmrob-psifns.R0000644000176200001440000001515513310763444016337 0ustar liggesusers#### Tests psi(), chi(),... etc and tuning.psi, tuning.chi : library(robustbase) source(system.file("xtraR/plot-psiFun.R", package = "robustbase", mustWork=TRUE)) source(system.file("test-tools-1.R", package = "Matrix", mustWork=TRUE))# assert.EQ ### (1) Test the functions themselves -------------------------------- if(!dev.interactive(orNone=TRUE)) pdf("rob-psifns.pdf") ## Simple version, no error checking, no derivative, nothing: psiGGW <- function(x, a,b,c) { ifelse((ax <- abs(x)) < c, x, ifelse((ea <- -((ax-c)^b)/(2*a)) < -708.4, 0, x * exp(ea))) } assert.EQ(Mpsi (5:9, cc=c(0, a=1/8,b=2,c=1/8, NA), "GGW"), psiGGW(5:9, a=1/8,b=2,c=1/8), tol = 1e-13) ## Check that psi() |-> works; ditto for +-Inf, NA,.. cG <- c(-.5, 1, .95, NA) # one of the 6 "builtin"s d0 <- numeric() IoI <- c(-Inf, 0, Inf) NN <- c(NaN, NA) cGs <- list( c(-.4, 1.5, 0.85, NA) , c(-.4, 1.5 , 0.90, NA) , c(-.4, 1.5 , 0.95, NA) , c(-.4, 1.5, 0.975, NA) , c(-.4, 1.5, 0.99 , NA) , c(-.4, 1.5, 0.995, NA) ## , c(-.4, 1.25, 0.975, NA) , c(-.4, 1.1, 0.975, NA) , c(-.4, 1.025, 0.975, NA) , c(-.4, 1.0125, 0.975, NA) ## ## FIXME , c(-.1, 1.25, 0.95, NA) ## FIXME , c(-.1, 1.25, 0.99, NA) ) st <- system.time( cG.cnst <- lapply(cGs, function(cc) lmrob.control(psi = "ggw", tuning.psi = cc)$tuning.psi) ) cat('Time for constants computation of tuning.psi: ', st,'\n') cGct <- t(sapply(cG.cnst, attr, "constants"))[,-1] colnames(cGct) <- c("a","b","c", "rhoInf") signif(cGct, 4) assert.EQ(sapply(cG.cnst, function(cc) MrhoInf(cc, "ggw")), cGct[,"rhoInf"], tol = 1e-8) ## Do these checks for a *list* of (c.par, psi) combinations: c.psi.list <- list( list(1.345, "Huber"), list(1.8, "Huber"), list(cG, "GGW"), list(c(2,4,8), "Hampel"), list(c(1.5,3.5,8)*0.90, "Hampel"), list(par=c(-.5,1.5,.95,NA), "lqq"), list(bcs=c(1, 1, 1.25), "lqq"), list(1.1, "optimal"), list(0.1, "optimal"), list(2.3, "Welsh") ) for(c.psi in c.psi.list) { tPar <- c.psi[[1]]; psi <- c.psi[[2]] stopifnot(is.numeric(tPar), is.character(psi)) cat("Psi function ", psi,"; tuning par. c[]= (", paste(formatC(tPar, width=1), collapse=", "),")\n") for(FUN in list(Mpsi, Mchi, Mwgt)) stopifnot(identical(d0, FUN(d0, tPar, psi=psi)), identical(NN, FUN(NN, tPar, psi=psi))) stopifnot(identical(c(0,1,0), Mwgt(IoI, tPar,psi=psi))) if(isPsi.redesc(psi)) stopifnot(identical(c(0,0,0), Mpsi(IoI, tPar,psi=psi)), identical(c(1,0,1), Mchi(IoI, tPar,psi=psi))) else if(psi == "Huber") { stopifnot(identical(c(-tPar,0,tPar), Mpsi(IoI, tPar,psi=psi)), identical(c( Inf,0, Inf), Mchi(IoI, tPar,psi=psi))) } cat("chkPsi..(): ") isHH <- psi %in% c("Huber", "Hampel") # not differentiable tol <- switch(tolower(psi), "huber"=, "hampel"= c(.001, 1.0), "optimal" = .008, "ggw" = c(5e-5, 5e-3, 1e-12), "lqq" = c(1e-5, 5e-5, 1e-5, .08)) # .08 needed for bcs=c(1, 1, 1.25) if(is.null(tol)) tol <- 1e-4 # default otherwise cc <- chkPsi..(c(-5, 10), psi=psi, par=tPar, doD2 = !isHH, tol=tol) ## -------- cc. <- cc[!is.na(cc)] if(is.logical(cc) && all(cc.)) cat(" [Ok]\n") else { cat(" not all Ok:\n") print(cc.[cc. != "TRUE"]) } cat("------------------------\n\n") } ## Nice plots -- and check derivatives ---- head(x. <- seq(-5, 10, length=1501)) ## [separate lines, for interactive "play": ] stopifnot(chkPsiDeriv(p.psiFun(x., "LQQ", par=c(-.5,1.5,.95,NA)))) stopifnot(chkPsiDeriv(p.psiFun(x., "GGW", par= cG))) stopifnot(chkPsiDeriv(p.psiFun(x., "optimal", par=2))) stopifnot(chkPsiDeriv(p.psiFun(x., "Hampel", par = ## Default, but rounded: round(c(1.5, 3.5, 8) * 0.9016085, 1)), tol = 1e-3)) stopifnot(chkPsiDeriv(p.psiFun(x., "biweight", par = 4))) stopifnot(chkPsiDeriv(p.psiFun(x., "Welsh", par = 1.5))) stopifnot(chkPsiDeriv(p.psiFun(x., "huber", par = 1.5), tol = c(1e-10, 5e-3))) ## "huber"-rho via Mpsi(*, deriv=-1) was badly wrong till 2018-06 ## The same 6, all in one plot: op <- par(mfrow=c(3,2), mgp = c(1.5, .6, 0), mar = .1+c(3,3,2,.5)) p.psiFun2(x., "LQQ", par=c(-.5,1.5,.95,NA)) p.psiFun2(x., "GGW", par= cG) p.psiFun2(x., "optimal", par=1.3) p.psiFun2(x., "Hampel", par = round(c(1.5, 3.5, 8) * 0.9016085, 1)) p.psiFun2(x., "biweight", par = 4) p.psiFun2(x., "Welsh", par = 1.5) par(op) ### (2) Test them as arguments of lmrob() or lmrob.control(): ----- data(aircraft) set.seed(1) summary(mp0 <- lmrob(Y ~ ., data = aircraft, psi = 'bisquare', method = 'SMDM')) set.seed(2) summary(mp1 <- update(mp0, psi = 'optimal')) set.seed(3) summary(mp2 <- update(mp0, psi = 'ggw')) set.seed(4) summary(mp3 <- update(mp0, psi = 'welsh')) set.seed(5) summary(mp4 <- update(mp0, psi = 'ggw', tuning.psi = c(-.5, 1.5, 0.85, NA), tuning.chi = c(-0.5, 1.5, NA, 0.5))) set.seed(6) summary(mp5 <- update(mp0, psi = 'ggw', tuning.psi = c(-0.5, 1.0, 0.95, NA), tuning.chi = c(-0.5, 1.0, NA, 0.5))) set.seed(7) summary(mp6 <- update(mp0, psi = 'hampel')) set.seed(8) ctr7 <- lmrob.control(psi = 'ggw', tuning.psi = c(-0.3, 1.4, 0.95, NA), tuning.chi = c(-0.3, 1.4, NA, 0.5)) ctr7$tuning.psi ## -> "constants" ctr7$tuning.chi summary(mp7 <-lmrob(Y ~ ., data = aircraft, control = ctr7)) # *not* converging in k.max=200 set.seed(9) summary(mp8 <- update(mp0, psi = 'lqq')) set.seed(10) ## c(.) drops attributes : ctr9 <- lmrob.control(psi = 'lqq', tuning.psi = c(ctr7$tuning.psi), tuning.chi = c(ctr7$tuning.chi)) ctr9$tuning.psi ctr9$tuning.chi ## Confirm these constants above (against the ones we got earlier) ## by recomputing them using higher accuracy : (tpsi. <- do.call(.psi.lqq.findc, c(ctr9$tuning.psi, list(rel.tol=1e-11, tol=1e-8)))) (tchi. <- do.call(.psi.lqq.findc, c(ctr9$tuning.chi, list(rel.tol=1e-11, tol=1e-8)))) (tol4 <- .Machine$double.eps^.25) Rver <- getRversion() integr.bug <- "2.12.0" <= Rver && Rver <= "3.0.1" integr.bug if(integr.bug) tol4 <- 8*tol4 assert.EQ(attr(ctr9$tuning.psi, "constants"), tpsi., tol=tol4, giveRE=TRUE) assert.EQ(attr(ctr9$tuning.chi, "constants"), tchi., tol=tol4, giveRE=TRUE) summary(mp9 <- lmrob(Y ~ ., data = aircraft, control = ctr9)) cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' robustbase/tests/small-sample.R0000644000176200001440000000216111757675047016322 0ustar liggesuserslibrary(robustbase) ## testing functions: source(system.file("xtraR/ex-funs.R", package = "robustbase")) set.seed(152) Nmax <- 12 nn <- length(nset <- c(2:Nmax, 20, 50))## NOTA BENE: n == 1 etc are NOT YET TREATED! Sim <- 2^9 # = 512 sn <- qn <- numeric(Sim) cpu <- numeric(nn) names(cpu) <- as.character(nset) for(n in nset) { nS <- Sim ## if(n < 20) Sim else round(10*Sim/n) cat("\nn = ",n,"\n------\nno.Sim. = ",nS,"\n") cpu[as.character(n)] <- system.time(for(i in 1:nS) { x <- rnorm(n) sn[i] <- Sn0R(x) qn[i] <- Qn0R(x) Sn.x <- Sn(x, const = 1) Qn.x <- Qn(x, const = 1) if(!is.all.equal(Sn.x, sn[i], tol = 1e-5)) cat("i=",i," Sn() != Sn0R(): ", Sn.x, "!=", sn[i],"\n") if(!is.all.equal(Qn.x, qn[i], tol = 1e-5)) cat("i=",i," Qn() != Qn0R(): ", Qn.x, "!=", qn[i],"\n") })[1] cat("Mean and its. std.err; Quartiles of Sn(x_1 .. x_n) and Qn(...):\n") print(c(mean(sn), sd(sn)/sqrt(nS), quantile(sn, p = (1:3)/4))) print(c(mean(qn), sd(qn)/sqrt(nS), quantile(qn, p = (1:3)/4))) } rbind("Time (CPU) used:" = summary(cpu)) robustbase/tests/weights.Rout.save0000644000176200001440000005155213326344173017065 0ustar liggesusers R version 3.5.1 Patched (2018-07-24 r75005) -- "Feather Spray" Copyright (C) 2018 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## test handing of weights and offset argument > require(robustbase) Loading required package: robustbase > > ## generate simple example data (extension of the one in ./NAcoef.R ) > data <- expand.grid(x1=letters[1:3], x2=LETTERS[1:4], rep=1:3) > ## generate offset column > data$os <- 1:nrow(data) > set.seed(1) > data$y <- data$os + rnorm(nrow(data)) > ## add collinear variables > data$x3 <- rnorm(nrow(data)) > data$x4 <- rnorm(nrow(data)) > data$x5 <- data$x3 + data$x4 ## lm() will have 'x5' "aliased" (and give coef = NA) > ## add some NA terms > data$y[1] <- NA > data$x4[2:3] <- NA ## to test anova > ## generate weights > ## some obs with weight 0 > data$weights <- as.numeric(with(data, x1 != 'c' | (x2 != 'B' & x2 != 'C'))) > ## some obs with weight 2 > data$weights[data$x1 == 'b'] <- 2 > ## data2 := {data + weights}, encoded in "data2" (-> "ok" for coef(), not for SE) > data2 <- rbind(subset(data, weights > 0), + subset(data, weights == 2)) > ## using these parameters we're essentially forcing lmrob() to > ## fit a classic model --> easier to compare to lm() > ctrl <- lmrob.control(psi="optimal", tuning.chi = 20, bb = 0.0003846154, + tuning.psi=20, method="SM", cov=".vcov.w") > ## SM = MM == the case where .vcov.avar1 was also defined for > > ## Classical models start with 'cm', robust just with 'rm' (or just 'm'): > (cm0 <- lm (y ~ x1*x2 + x3 + x4 + x5 + offset(os), data)) Call: lm(formula = y ~ x1 * x2 + x3 + x4 + x5 + offset(os), data = data) Coefficients: (Intercept) x1b x1c x2B x2C x2D 0.01008 -1.14140 0.48156 0.01357 0.86985 0.15178 x3 x4 x5 x1b:x2B x1c:x2B x1b:x2C -0.01655 -0.02388 NA 1.05416 -0.32889 0.69954 x1c:x2C x1b:x2D x1c:x2D -0.73949 1.08478 -1.31578 > (cm1 <- lm (y ~ x1*x2 + x3 + x4 + x5 + offset(os), data, weights=weights)) Call: lm(formula = y ~ x1 * x2 + x3 + x4 + x5 + offset(os), data = data, weights = weights) Coefficients: (Intercept) x1b x1c x2B x2C x2D -0.002961 -1.132857 0.492904 0.017959 0.858031 0.208510 x3 x4 x5 x1b:x2B x1c:x2B x1b:x2C -0.021632 -0.079147 NA 1.040529 NA 0.736944 x1c:x2C x1b:x2D x1c:x2D NA 1.099090 -1.371953 > (cm2 <- lm (y ~ x1*x2 + x3 + x4 + x5, data2, offset=os)) Call: lm(formula = y ~ x1 * x2 + x3 + x4 + x5, data = data2, offset = os) Coefficients: (Intercept) x1b x1c x2B x2C x2D -0.002961 -1.132857 0.492904 0.017959 0.858031 0.208510 x3 x4 x5 x1b:x2B x1c:x2B x1b:x2C -0.021632 -0.079147 NA 1.040529 NA 0.736944 x1c:x2C x1b:x2D x1c:x2D NA 1.099090 -1.371953 > (rm0 <- lmrob(y ~ x1*x2 + x3 + x4 + x5 + offset(os), data, control=ctrl)) Call: lmrob(formula = y ~ x1 * x2 + x3 + x4 + x5 + offset(os), data = data, control = ctrl) \--> method = "MM" Coefficients: (Intercept) x1b x1c x2B x2C x2D 0.01008 -1.14140 0.48156 0.01357 0.86985 0.15178 x3 x4 x5 x1b:x2B x1c:x2B x1b:x2C -0.01655 -0.02388 NA 1.05416 -0.32889 0.69954 x1c:x2C x1b:x2D x1c:x2D -0.73949 1.08478 -1.31578 > set.seed(2) > (rm1 <- lmrob(y ~ x1*x2 + x3 + x4 + x5 + offset(os), data, weights=weights, control=ctrl)) Call: lmrob(formula = y ~ x1 * x2 + x3 + x4 + x5 + offset(os), data = data, weights = weights, control = ctrl) \--> method = "MM" Coefficients: (Intercept) x1b x1c x2B x2C x2D -0.002961 -1.132857 0.492904 0.017959 0.858031 0.208510 x3 x4 x5 x1b:x2B x1c:x2B x1b:x2C -0.021632 -0.079147 NA 1.040529 NA 0.736944 x1c:x2C x1b:x2D x1c:x2D NA 1.099090 -1.371953 > set.seed(2) > (rm2 <- lmrob(y ~ x1*x2 + x3 + x4 + x5, data2, offset=os, control=ctrl)) Call: lmrob(formula = y ~ x1 * x2 + x3 + x4 + x5, data = data2, offset = os, control = ctrl) \--> method = "MM" Coefficients: (Intercept) x1b x1c x2B x2C x2D -0.002961 -1.132857 0.492904 0.017959 0.858031 0.208510 x3 x4 x5 x1b:x2B x1c:x2B x1b:x2C -0.021632 -0.079147 NA 1.040529 NA 0.736944 x1c:x2C x1b:x2D x1c:x2D NA 1.099090 -1.371953 > > sc0 <- summary(cm0) > sc1 <- summary(cm1) > sc2 <- summary(cm2) > (sr0 <- summary(rm0)) Call: lmrob(formula = y ~ x1 * x2 + x3 + x4 + x5 + offset(os), data = data, control = ctrl) \--> method = "MM" Residuals: Min 1Q Median 3Q Max -1.50524 -0.48219 0.01663 0.42714 1.59122 Coefficients: (1 not defined because of singularities) Estimate Std. Error t value Pr(>|t|) (Intercept) 0.01008 0.76421 0.013 0.990 x1b -1.14140 1.02228 -1.117 0.278 x1c 0.48156 1.01891 0.473 0.642 x2B 0.01357 0.95276 0.014 0.989 x2C 0.86985 0.94762 0.918 0.370 x2D 0.15178 0.99480 0.153 0.880 x3 -0.01655 0.22284 -0.074 0.942 x4 -0.02388 0.25629 -0.093 0.927 x5 NA NA NA NA x1b:x2B 1.05416 1.30705 0.807 0.430 x1c:x2B -0.32889 1.30044 -0.253 0.803 x1b:x2C 0.69954 1.37279 0.510 0.616 x1c:x2C -0.73949 1.30141 -0.568 0.577 x1b:x2D 1.08478 1.32102 0.821 0.422 x1c:x2D -1.31578 1.33335 -0.987 0.336 Robust residual standard error: 1.007 (3 observations deleted due to missingness) Multiple R-squared: 0.9933, Adjusted R-squared: 0.9887 Convergence in 1 IRWLS iterations Robustness weights: All 33 weights are ~= 1. Algorithmic parameters: bb refine.tol rel.tol scale.tol 3.846e-04 1.000e-07 1.000e-07 1.000e-10 solve.tol eps.outlier eps.x warn.limit.reject 1.000e-07 3.030e-03 4.369e-12 5.000e-01 warn.limit.meanrw 5.000e-01 nResample tuning.chi tuning.psi max.it best.r.s 500 20 20 50 2 k.fast.s k.max maxit.scale trace.lev mts 1 200 200 0 1000 compute.rd fast.s.large.n 0 2000 psi subsampling cov "optimal" "nonsingular" ".vcov.w" compute.outlier.stats "SM" seed : int(0) > (sr1 <- summary(rm1)) Call: lmrob(formula = y ~ x1 * x2 + x3 + x4 + x5 + offset(os), data = data, weights = weights, control = ctrl) \--> method = "MM" Residuals: Min 1Q Median 3Q Max -1.52261 -0.57370 -0.07248 0.39247 1.61986 Coefficients: (3 not defined because of singularities) Estimate Std. Error t value Pr(>|t|) (Intercept) -0.002961 0.977109 -0.003 0.998 x1b -1.132857 1.133342 -1.000 0.333 x1c 0.492904 1.297399 0.380 0.709 x2B 0.017959 1.213927 0.015 0.988 x2C 0.858031 1.204169 0.713 0.487 x2D 0.208510 1.275792 0.163 0.872 x3 -0.021632 0.284226 -0.076 0.940 x4 -0.079147 0.324629 -0.244 0.811 x5 NA NA NA NA x1b:x2B 1.040529 1.443384 0.721 0.482 x1c:x2B NA NA NA NA x1b:x2C 0.736944 1.530596 0.481 0.637 x1c:x2C NA NA NA NA x1b:x2D 1.099090 1.461384 0.752 0.464 x1c:x2D -1.371953 1.698858 -0.808 0.432 Robust residual standard error: 1.281 (3 observations deleted due to missingness) Multiple R-squared: 0.9923, Adjusted R-squared: 0.9866 Convergence in 1 IRWLS iterations Robustness weights: 6 observations c(3,6,15,18,27,30) are outliers with |weight| = 0 ( < 0.0037); 27 weights are ~= 1. Algorithmic parameters: bb refine.tol rel.tol scale.tol 3.846e-04 1.000e-07 1.000e-07 1.000e-10 solve.tol eps.outlier eps.x warn.limit.reject 1.000e-07 3.704e-03 5.094e-12 5.000e-01 warn.limit.meanrw 5.000e-01 nResample tuning.chi tuning.psi max.it best.r.s 500 20 20 50 2 k.fast.s k.max maxit.scale trace.lev mts 1 200 200 0 1000 compute.rd fast.s.large.n 0 2000 psi subsampling cov "optimal" "nonsingular" ".vcov.w" compute.outlier.stats "SM" seed : int(0) > (sr2 <- summary(rm2)) Call: lmrob(formula = y ~ x1 * x2 + x3 + x4 + x5, data = data2, offset = os, control = ctrl) \--> method = "MM" Residuals: Min 1Q Median 3Q Max -1.52261 -0.51773 0.06925 0.38640 1.61986 Coefficients: (3 not defined because of singularities) Estimate Std. Error t value Pr(>|t|) (Intercept) -0.002961 0.742168 -0.004 0.997 x1b -1.132857 0.860835 -1.316 0.200 x1c 0.492904 0.985445 0.500 0.621 x2B 0.017959 0.922044 0.019 0.985 x2C 0.858031 0.914632 0.938 0.357 x2D 0.208510 0.969033 0.215 0.831 x3 -0.021632 0.215885 -0.100 0.921 x4 -0.079147 0.246574 -0.321 0.751 x5 NA NA NA NA x1b:x2B 1.040529 1.096329 0.949 0.351 x1c:x2B NA NA NA NA x1b:x2C 0.736944 1.162571 0.634 0.532 x1c:x2C NA NA NA NA x1b:x2D 1.099090 1.110001 0.990 0.331 x1c:x2D -1.371953 1.290375 -1.063 0.297 Robust residual standard error: 0.9728 (4 observations deleted due to missingness) Multiple R-squared: 0.9923, Adjusted R-squared: 0.989 Convergence in 1 IRWLS iterations Robustness weights: All 38 weights are ~= 1. Algorithmic parameters: bb refine.tol rel.tol scale.tol 3.846e-04 1.000e-07 1.000e-07 1.000e-10 solve.tol eps.outlier eps.x warn.limit.reject 1.000e-07 2.632e-03 4.369e-12 5.000e-01 warn.limit.meanrw 5.000e-01 nResample tuning.chi tuning.psi max.it best.r.s 500 20 20 50 2 k.fast.s k.max maxit.scale trace.lev mts 1 200 200 0 1000 compute.rd fast.s.large.n 0 2000 psi subsampling cov "optimal" "nonsingular" ".vcov.w" compute.outlier.stats "SM" seed : int(0) > > ## test Estimates, Std. Errors, ... > stopifnot(all.equal(coef(cm1), coef(cm2)), + all.equal(coef(rm1), coef(rm2)), + all.equal(coef(sc0), coef(sr0)), + all.equal(coef(sc1), coef(sr1)), + all.equal(coef(sc2), coef(sr2))) > > ## test class "lm" methods that do not depend on weights > meths1 <- c("family", + "formula", + "labels", + "model.matrix", + "na.action", + "terms") > for (meth in meths1) + stopifnot(all.equal(do.call(meth, list(rm0)), + do.call(meth, list(rm1)))) > > ## class "lm" methods that depend on weights > ## FIXME: > meths2 <- c(#"AIC", + "alias", + #"BIC", + "case.names", + "coef", + "confint", + #"cooks.distance", + #"deviance", + "df.residual", + #"dfbeta", + #"dfbetas", + #"drop1", + "dummy.coef", + #"effects", + #"extractAIC", + #"hatvalues", + #"influence", + "kappa", + #"logLik", + #"model.frame", ## disable because of zero.weights attribute + "nobs", + "predict", + #"proj", + #"rstandard", + #"rstudent", + #"simulate", + ##"summary", ## see above + "variable.names", + ##"vcov", ## see below + "weights") > op <- options(warn = 1)# print immediately > for (meth in meths2) { + cat(meth,":") + .SW. <- if(meth == "weights") suppressWarnings else identity # for suppressing + ## No weights defined for this object. Use type="robustness" .... + stopifnot(all.equal(do.call(meth, list(cm1)), + do.call(meth, list(rm1))), + all.equal(do.call(meth, list(cm2)), + .SW.(do.call(meth, list(rm2))))) + cat("\n") + } alias : case.names : coef : confint : df.residual : dummy.coef : kappa : nobs : predict : variable.names : weights : > options(op)# reverting > > ## further tests: > anova(rm1, update(rm1, ~ . - x4 - x5)) Robust Wald Test Table Model 1: y ~ x1 * x2 + x3 + x4 + x5 + offset(os) Model 2: y ~ x1 + x2 + x3 + x1:x2 + offset(os) Largest model fitted by lmrob(), i.e. SM pseudoDf Test.Stat Df Pr(>chisq) 1 18 2 22 0.059442 1 0.8074 > anova(rm2, update(rm2, ~ . - x4 - x5)) Robust Wald Test Table Model 1: y ~ x1 * x2 + x3 + x4 + x5 Model 2: y ~ x1 + x2 + x3 + x1:x2 Largest model fitted by lmrob(), i.e. SM pseudoDf Test.Stat Df Pr(>chisq) 1 23 2 27 0.10303 1 0.7482 > > stopifnot(all.equal(fitted(cm0), fitted(rm0)), + all.equal(fitted(cm1), fitted(rm1)), + all.equal(fitted(cm2), fitted(rm2))) > > nd <- expand.grid(x1=letters[1:3], x2=LETTERS[1:4]) > set.seed(3) > nd$x3 <- rnorm(nrow(nd)) > nd$x4 <- rnorm(nrow(nd)) > nd$x5 <- rnorm(nrow(nd)) > nd$os <- nrow(nd):1 > wts <- runif(nrow(nd)) > stopifnot(all.equal(predict(cm0, nd, interval="prediction"), + predict(rm0, nd, interval="prediction")), + all.equal(predict(cm1, nd, interval="prediction"), + predict(rm1, nd, interval="prediction")), + all.equal(predict(cm2, nd, interval="prediction"), + predict(rm2, nd, interval="prediction")), + all.equal(predict(cm0, nd, interval="prediction", weights=wts), + predict(rm0, nd, interval="prediction", weights=wts)), + all.equal(predict(cm1, nd, interval="prediction", weights=wts), + predict(rm1, nd, interval="prediction", weights=wts)), + all.equal(predict(cm2, nd, interval="prediction", weights=wts), + predict(rm2, nd, interval="prediction", weights=wts), + tolerance=1e-7)) There were 14 warnings (use warnings() to see them) > > ## Padding can lead to differing values here > ## so test only full rank part > qrEQ <- function(m1, m2) { + q1 <- qr(m1) + q2 <- qr(m2) + r <- 1:q1$rank + stopifnot(q1$rank == q2$rank, + all.equal(q1$pivot, q2$pivot), + all.equal(q1$qraux[r],q2$qraux[r]), + all.equal(q1$qr[r,r], q2$qr[r,r])) + } > qrEQ(cm0, rm0) > qrEQ(cm1, rm1) > qrEQ(cm2, rm2) > > stopifnot(all.equal(residuals(cm0), residuals(rm0)), + all.equal(residuals(cm1), residuals(rm1)), + all.equal(residuals(cm2), residuals(rm2)), + all.equal(resid(cm0, type="pearson"), resid(rm0, type="pearson")), + all.equal(resid(cm1, type="pearson"), resid(rm1, type="pearson")), + all.equal(resid(cm2, type="pearson"), resid(rm2, type="pearson"))) > > ## R 3.5.0: vcov(*, complete=TRUE) new default ==> same NA's as coef() > if(interactive()) withAutoprint({ + op <- options(width = 130, digits = 2) # --> vcov() rows fit on 1 line + vcov(cm0) # 'x5' is NA + vcov(cm2) # 'x5', 'x1c:2B', 'x1c:2C' rows & columns are NA + options(op) + }) > > (no.C <- is.na(match("complete", names(formals(stats:::vcov.lm))))) ## temporary _FIXME_ [1] FALSE > vcovC <- if(no.C) function(M, ...) vcov(M, complete=FALSE, ...) else vcov # (complete=TRUE) > stopifnot(all.equal(vcov(cm0), vcovC(rm0), check.attributes=FALSE), + all.equal(vcov(cm1), vcovC(rm1), check.attributes=FALSE), + all.equal(vcov(cm2), vcovC(rm2), check.attributes=FALSE)) > > ## "clean": > cln <- function(vc) structure(vc, weights=NULL, eigen=NULL) > ## .vcov.avar1() is not recommended here, but also should work with singular / NA coef case: > ok0 <- !is.na(coef(rm0)) > vr0.NA<- vcov(rm0, cov=".vcov.avar1", complete=NA) # "almost singular" warning Warning messages: 1: In lf.cov(object, complete = complete, ...) : X'WX is almost singular. Consider using cov = ".vcov.w" 2: In lf.cov(object, complete = complete, ...) : .vcov.avar1: negative diag() fixed up; consider 'cov=".vcov.w."' instead > vr0.T <- vcov(rm0, cov=".vcov.avar1", complete=TRUE) > vr0.F <- vcov(rm0, cov=".vcov.avar1", complete=FALSE) > stopifnot(identical(dim(vr0.NA), dim(vr0.T)), + identical(dim(vr0.F), dim(vr0.T) - 1L), dim(vr0.F) == 14, + all.equal(cln(vr0.F), vr0.T[ok0,ok0], tol = 1e-15)) > > if(!no.C) { + vc0.T <- vcov(cm0, complete=TRUE) + vc0.F <- vcov(cm0, complete=FALSE) + } > > ok1 <- !is.na(coef(rm1)) > ## cannot work because init/fit residuals are not of full length > tools::assertError(vr1.NA<- vcov(rm1, cov=".vcov.avar1", complete=NA)) > tools::assertError(vr1.T <- vcov(rm1, cov=".vcov.avar1", complete=TRUE )) > tools::assertError(vr1.F <- vcov(rm1, cov=".vcov.avar1", complete=FALSE)) > ## instead, must refit > rm1. <- update(rm1, control = within(ctrl, cov <- ".vcov.avar1")) > vr1.NA<- vcov(rm1., complete=NA) > vr1.T <- vcov(rm1., complete=TRUE) > vr1.F <- vcov(rm1., complete=FALSE) > > stopifnot(identical(vr1.F, vr1.NA), # in this case + identical(dim(vr1.F), dim(vr1.T) - 3L), dim(vr1.F) == 12, isSymmetric(vr1.T), + identical(rownames(vr1.F), rownames(vr1.T)[ok1]), + all.equal(cln(vr1.F), vr1.T[ok1,ok1], tol=1e-15)) > > if(FALSE) ## ERROR "exact singular" (probably *NOT* to fix, as TRUE/FALSE do work !) + vr2.NA<- vcov(rm2, cov=".vcov.avar1", complete=NA) # "almost singular" warning > vr2.T <- vcov(rm2, cov=".vcov.avar1", complete=TRUE) > vr2.F <- vcov(rm2, cov=".vcov.avar1", complete=FALSE) > stopifnot(TRUE, # identical(dim(vr2.NA), dim(vr2.T)), + identical(dim(vr2.F), dim(vr2.T) - 3L), dim(vr2.F) == 12, + identical(rownames(vr2.F), rownames(vr1.F)), + identical(rownames(vr2.T), rownames(vr1.T)), + all.equal(cln(vr2.F), vr2.T[ok1,ok1], tol=1e-15)) > > ## Hmm, the supposedly heteroscedastic-robust estimates *are* very different: > all.equal(vcov(cm0), vcovC(rm0, cov = ".vcov.avar1"), check.attributes=FALSE) # rel.diff. 0.5367564 [1] "Mean relative difference: 0.5367564" > if(FALSE) # does not make sense + all.equal(vcov(cm1), vcovC(rm1, cov = ".vcov.avar1"), check.attributes=FALSE) > all.equal(vcov(cm2), vcovC(rm2, cov = ".vcov.avar1"), check.attributes=FALSE) # rel.diff. 0.5757642 [1] "Mean relative difference: 0.5757642" > > > ## Null fits (rank(X)==0) are tested in NAcoef.R > > ## testing weight=0 bug > lmrob(y ~ x3, data, weights=weights) Call: lmrob(formula = y ~ x3, data = data, weights = weights) \--> method = "MM" Coefficients: (Intercept) x3 18.7474 0.1751 > > proc.time() user system elapsed 0.329 0.049 0.371 robustbase/tests/Rsquared.Rout.save0000644000176200001440000002436613326544553017210 0ustar liggesusers R version 3.5.1 (2018-07-02) -- "Feather Spray" Copyright (C) 2018 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > require(robustbase) Loading required package: robustbase > > set.seed(17)# reproducibility! > ## to check: > ## - for the empty model > summary(lmrob(Y ~ 0, coleman)) Call: lmrob(formula = Y ~ 0, data = coleman) \--> method = "" Residuals: Min 1Q Median 3Q Max 22.70 32.78 35.86 39.95 43.10 No Coefficients > ## - with and without an intercept in the model > summary(lmrob(Y ~ 1, coleman)) Call: lmrob(formula = Y ~ 1, data = coleman) \--> method = "MM" Residuals: Min 1Q Median 3Q Max -12.8605 -2.7855 0.2945 4.3895 7.5395 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 35.560 1.342 26.5 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 5.48 Convergence in 9 IRWLS iterations Robustness weights: one weight is ~= 1. The remaining 19 ones are summarized as Min. 1st Qu. Median Mean 3rd Qu. Max. 0.5611 0.8986 0.9553 0.9044 0.9918 0.9987 Algorithmic parameters: tuning.chi bb tuning.psi refine.tol 1.548e+00 5.000e-01 4.685e+00 1.000e-07 rel.tol scale.tol solve.tol eps.outlier 1.000e-07 1.000e-10 1.000e-07 5.000e-03 eps.x warn.limit.reject warn.limit.meanrw 1.819e-12 5.000e-01 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd fast.s.large.n 200 0 1000 0 2000 psi subsampling cov "bisquare" "nonsingular" ".vcov.avar1" compute.outlier.stats "SM" seed : int(0) > writeLines(sfm <- capture.output( + summary(lmrob(Y ~ ., coleman)))) # and this must be "identical": Call: lmrob(formula = Y ~ ., data = coleman) \--> method = "MM" Residuals: Min 1Q Median 3Q Max -4.16181 -0.39226 0.01611 0.55619 7.22766 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 30.50232 6.71260 4.544 0.000459 *** salaryP -1.66615 0.43129 -3.863 0.001722 ** fatherWc 0.08425 0.01467 5.741 5.10e-05 *** sstatus 0.66774 0.03385 19.726 1.30e-11 *** teacherSc 1.16778 0.10983 10.632 4.35e-08 *** motherLev -4.13657 0.92084 -4.492 0.000507 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 1.134 Multiple R-squared: 0.9814, Adjusted R-squared: 0.9747 Convergence in 11 IRWLS iterations Robustness weights: observation 18 is an outlier with |weight| = 0 ( < 0.005); The remaining 19 ones are summarized as Min. 1st Qu. Median Mean 3rd Qu. Max. 0.1491 0.9412 0.9847 0.9279 0.9947 0.9982 Algorithmic parameters: tuning.chi bb tuning.psi refine.tol 1.548e+00 5.000e-01 4.685e+00 1.000e-07 rel.tol scale.tol solve.tol eps.outlier 1.000e-07 1.000e-10 1.000e-07 5.000e-03 eps.x warn.limit.reject warn.limit.meanrw 1.569e-10 5.000e-01 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd fast.s.large.n 200 0 1000 0 2000 psi subsampling cov "bisquare" "nonsingular" ".vcov.avar1" compute.outlier.stats "SM" seed : int(0) > sfm2 <- capture.output(summary(lmrob(Y ~ ., coleman, model=FALSE, x=FALSE, y=FALSE))) > iCall <- grep("lmrob.*coleman", sfm)# the only line that differs > stopifnot(sfm[-iCall] == sfm2[-iCall]) > ## w/o intercept: > summary(lmrob(Y ~ . - 1, coleman, model=FALSE, x=FALSE, y=FALSE)) Call: lmrob(formula = Y ~ . - 1, data = coleman, model = FALSE, x = FALSE, y = FALSE) \--> method = "MM" Residuals: Min 1Q Median 3Q Max -4.86146 -0.59195 -0.04679 0.87826 5.40639 Coefficients: Estimate Std. Error t value Pr(>|t|) salaryP -1.97540 0.45262 -4.364 0.000555 *** fatherWc 0.03388 0.02220 1.526 0.147749 sstatus 0.55922 0.07590 7.367 2.34e-06 *** teacherSc 1.60446 0.19039 8.427 4.51e-07 *** motherLev -0.48903 0.90805 -0.539 0.598097 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 1.344 Multiple R-squared: 0.9987, Adjusted R-squared: 0.9983 Convergence in 14 IRWLS iterations Robustness weights: 3 weights are ~= 1. The remaining 17 ones are summarized as Min. 1st Qu. Median Mean 3rd Qu. Max. 0.06899 0.89030 0.95860 0.82750 0.98700 0.99820 Algorithmic parameters: tuning.chi bb tuning.psi refine.tol 1.548e+00 5.000e-01 4.685e+00 1.000e-07 rel.tol scale.tol solve.tol eps.outlier 1.000e-07 1.000e-10 1.000e-07 5.000e-03 eps.x warn.limit.reject warn.limit.meanrw 1.569e-10 5.000e-01 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd fast.s.large.n 200 0 1000 0 2000 psi subsampling cov "bisquare" "nonsingular" ".vcov.avar1" compute.outlier.stats "SM" seed : int(0) > > ## - when prior-weights are included > wts <- c(rep(0.05, 10), rep(2, 10)) > summary(lmrob(Y ~ . - 1, coleman, model=FALSE, x=FALSE, y=FALSE, + weights = wts)) Call: lmrob(formula = Y ~ . - 1, data = coleman, weights = wts, model = FALSE, x = FALSE, y = FALSE) \--> method = "MM" Residuals: Min 1Q Median 3Q Max -4.53960 -0.03032 0.10984 1.55271 6.36480 Coefficients: Estimate Std. Error t value Pr(>|t|) salaryP -2.68644 0.05871 -45.761 < 2e-16 *** fatherWc 0.04761 0.00721 6.603 8.39e-06 *** sstatus 0.58362 0.00314 185.842 < 2e-16 *** teacherSc 1.77115 0.07918 22.369 6.20e-13 *** motherLev -1.03171 0.34154 -3.021 0.0086 ** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 0.423 Multiple R-squared: 0.9985, Adjusted R-squared: 0.998 Convergence in 5 IRWLS iterations Robustness weights: 3 observations c(12,16,18) are outliers with |weight| = 0 ( < 0.005); 5 weights are ~= 1. The remaining 12 ones are summarized as Min. 1st Qu. Median Mean 3rd Qu. Max. 0.5441 0.9257 0.9833 0.9303 0.9956 0.9985 Algorithmic parameters: tuning.chi bb tuning.psi refine.tol 1.548e+00 5.000e-01 4.685e+00 1.000e-07 rel.tol scale.tol solve.tol eps.outlier 1.000e-07 1.000e-10 1.000e-07 5.000e-03 eps.x warn.limit.reject warn.limit.meanrw 2.219e-10 5.000e-01 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd fast.s.large.n 200 0 1000 0 2000 psi subsampling cov "bisquare" "nonsingular" ".vcov.avar1" compute.outlier.stats "SM" seed : int(0) > ## - should work for object with NA in the coefficients, and > ## - should work for object with NA in the observations --> both in ./NAcoef.R > > ## check equality with lm() for classical model > test <- function(formula, data, + items=c("coefficients", "residuals", "df", "scale", + "r.squared", "adj.r.squared", "weights"), + tol = 1e-4, ...) + { + lmrCtrl <- lmrob.control(psi = "hampel", tuning.psi = c(1000, 2000, 3000), + method="SMDM", ...) + sc <- summary(lm (formula, data)) + sr <- summary(lmrob(formula, data, control= lmrCtrl)) + names(sc)[names(sc) == "sigma"] <- "scale" + if(sc$df[1] == 0 && getRversion() <= "3.5.1" && as.numeric(R.version$`svn rev`) < 74993) + ## in the past, lm() returned logical empty matrix + storage.mode(sc$coefficients) <- "double" + ret <- all.equal(sc[items], sr[items], tolerance=tol) + if (!isTRUE(ret)) { + print(sr) + for (i in seq_along(items)) { + print(sc[items[i]]) + print(sr[items[i]]) + } + print(ret) + stop(sprintf("all.equal(sc[items], sr[items], tol.. = %g) are not all TRUE", + tol)) + } + ret + } > > set.seed(101) > > test(Y ~ 0, coleman, c("residuals", "df", "coefficients", + "r.squared", "adj.r.squared"), tol=1e-10) [1] TRUE > test(Y ~ 1, coleman, tol = 2e-4) [1] TRUE > test(Y ~ ., coleman, tol = 4e-4) [1] TRUE > test(Y ~ . - 1, coleman, tol = 4e-4) [1] TRUE > > > proc.time() user system elapsed 0.277 0.039 0.311 robustbase/tests/glmrob-specials.R0000644000176200001440000000151112271657124017000 0ustar liggesuserslibrary(robustbase) ## Model without coefficients [ print.glmrob() tests for this ..] ### very simple model [with outliers] set.seed(1) y <- rpois(1000, lambda = 4) ## without outliers m0o <- glm(y ~ 0, family = poisson, epsilon = 1e-12) m1o <- glm(y ~ 1, family = poisson, epsilon = 1e-12) y[1:3] <- 99:101 # outliers m0 <- glm(y ~ 0, family = poisson, epsilon = 1e-12) m1 <- glm(y ~ 1, family = poisson, epsilon = 1e-12) ## these both failed in version 0.1-2: rm0 <- glmrob(y ~ 0, family = poisson, acc = 1e-12) rm1 <- glmrob(y ~ 1, family = poisson, acc = 1e-12) rm0 rm1 (s0 <- summary(rm0)) (s1 <- summary(rm1)) str(s1) stopifnot(all.equal(c(coef(s1)), c(1.390672035557, 0.016213613600955, 85.77187478275, 0), tolerance = 1e-13))# 32-b: 4.7e-15 cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' robustbase/tests/Rsquared.R0000644000176200001440000000426613326360567015521 0ustar liggesusersrequire(robustbase) set.seed(17)# reproducibility! ## to check: ## - for the empty model summary(lmrob(Y ~ 0, coleman)) ## - with and without an intercept in the model summary(lmrob(Y ~ 1, coleman)) writeLines(sfm <- capture.output( summary(lmrob(Y ~ ., coleman)))) # and this must be "identical": sfm2 <- capture.output(summary(lmrob(Y ~ ., coleman, model=FALSE, x=FALSE, y=FALSE))) iCall <- grep("lmrob.*coleman", sfm)# the only line that differs stopifnot(sfm[-iCall] == sfm2[-iCall]) ## w/o intercept: summary(lmrob(Y ~ . - 1, coleman, model=FALSE, x=FALSE, y=FALSE)) ## - when prior-weights are included wts <- c(rep(0.05, 10), rep(2, 10)) summary(lmrob(Y ~ . - 1, coleman, model=FALSE, x=FALSE, y=FALSE, weights = wts)) ## - should work for object with NA in the coefficients, and ## - should work for object with NA in the observations --> both in ./NAcoef.R ## check equality with lm() for classical model test <- function(formula, data, items=c("coefficients", "residuals", "df", "scale", "r.squared", "adj.r.squared", "weights"), tol = 1e-4, ...) { lmrCtrl <- lmrob.control(psi = "hampel", tuning.psi = c(1000, 2000, 3000), method="SMDM", ...) sc <- summary(lm (formula, data)) sr <- summary(lmrob(formula, data, control= lmrCtrl)) names(sc)[names(sc) == "sigma"] <- "scale" if(sc$df[1] == 0 && getRversion() <= "3.5.1" && as.numeric(R.version$`svn rev`) < 74993) ## in the past, lm() returned logical empty matrix storage.mode(sc$coefficients) <- "double" ret <- all.equal(sc[items], sr[items], tolerance=tol) if (!isTRUE(ret)) { print(sr) for (i in seq_along(items)) { print(sc[items[i]]) print(sr[items[i]]) } print(ret) stop(sprintf("all.equal(sc[items], sr[items], tol.. = %g) are not all TRUE", tol)) } ret } set.seed(101) test(Y ~ 0, coleman, c("residuals", "df", "coefficients", "r.squared", "adj.r.squared"), tol=1e-10) test(Y ~ 1, coleman, tol = 2e-4) test(Y ~ ., coleman, tol = 4e-4) test(Y ~ . - 1, coleman, tol = 4e-4) robustbase/tests/tmcd.R0000644000176200001440000001544512433570705014656 0ustar liggesuserslibrary(robustbase) source(system.file("xtraR/test_MCD.R", package = "robustbase"))#-> doMCDdata ## ../inst/xtraR/test_MCD.R source(system.file("test-tools-1.R", package="Matrix", mustWork=TRUE)) ## -> assertError(), relErr(), and: showProc.time() ## -- now do it: options(digits = 5) set.seed(101) # <<-- sub-sampling algorithm now based on R's RNG and seed doMCDdata() doMCDdata(method="DetMCD"); warnings() ## vvvv no timing for 'R CMD Rdiff' outputs doMCDdata(nrep = 12, time=FALSE) doMCDdata(nrep = 12, time=FALSE, method="DetMCD"); warnings() doMCDdata(nrep = 12, time=FALSE, method = "MASS") ###--- now the "close to singular" mahalanobis case: set.seed(6) (c3 <- covMcd(mort3)) (c3. <- covMcd(mort3, nsamp="deterministic")) stopifnot(log(c3$crit) <= log(c3.$crit), print(log(c3.$crit / c3$crit)) <= 0.8) ## see 0.516 / 0.291 {with seed 7} ## ## rescale variables: scaleV <- c(0.1, 0.1, 1, 1, .001, 0.1, 0.1, 100) mm <- data.matrix(mort3) * rep(scaleV, each = nrow(mort3)) C3 <- covMcd(mm) C3. <- covMcd(mm, nsamp="deterministic") stopifnot(C3$mcd.wt == c3$mcd.wt)# here, not for all seeds! ## error ("computationally singular") with old (too high) default tolerance: try( covMcd(mm, control= rrcov.control(tol = 1e-10)) ) try( covMcd(mm, control= rrcov.control(tol = 1e-10), nsamp="deterministic") ) showProc.time() ## "large" examples using different algo branches {seg.fault in version 0.4-4}: n <- 600 ## - partitioning will be triggered set.seed(1) X <- matrix(round(100*rnorm(n * 3)), n, 3) (cX <- covMcd(X)) cX. <- covMcd(X, nsamp="deterministic", scalefn = scaleTau2) i <- names(cX); i <- i[!(i %in% c("call", "nsamp", "method", "raw.weights"))] stopifnot(sum(cX.$raw.weights != cX$raw.weights) <= 2, all.equal(cX[i], cX.[i], tol= 1/9)) n <- 2000 ## - nesting will be triggered set.seed(4) X <- matrix(round(100*rnorm(n * 3)), n, 3) set.seed(1) summary(cX <- covMcd(X)) # <- show newly activated print.summary.mcd(.) cX. <- covMcd(X, nsamp="deterministic", scalefn = scaleTau2) i2 <- i[i != "mcd.wt"] stopifnot(print(sum(cX.$raw.weights != cX$raw.weights)) <= 3, # 2 all.equal(cX[i2], cX.[i2], tol= 1/10))# 1/16 set.seed(1) ## testing of 'raw.only' : cXo <- covMcd(X, raw.only=TRUE) i <- paste0("raw.", c("cov", "center", "cnp2")) stopifnot(cXo$raw.only, all.equal(cX[i], cXo[i], tol = 1e-15), c("best", "mah") %in% setdiff(names(cX), names(cXo))) showProc.time() ## Now, some small sample cases: ## maximal values: n. <- 10 p. <- 8 set.seed(44) (X. <- cbind(1:n., round(10*rt(n.,3)), round(10*rt(n.,2)), matrix(round(10*rnorm(n. * (p.-3)), 1), nrow = n., ncol = p.-3))) ## 2 x 1 ---> Error r <- tryCatch(covMcd(X.[1:2, 2, drop=FALSE]), error=function(e)e) stopifnot(inherits(r, "error"), grepl("too small sample size", r$message)) ## 3 x 2 --- ditto r <- tryCatch(covMcd(X.[1:3, 2:3]), error=function(e)e) stopifnot(inherits(r, "error"), grepl("too small sample size", r$message)) ## 5 x 3 [ n < 2 p ! ] --- also works for MASS X <- X.[1:5, 1:3] set.seed(101) ## the finite-sample correction is definitely doubtful: summary(cc <- covMcd(X, use.correction = FALSE)) str(cc) ## best = 2 3 4 5 mcc <- MASS::cov.mcd(X) stopifnot(cc$best == mcc$best, all.equal(cc$center, mcc$center, tolerance = 1e-10), all.equal(c(mcc$cov / cc$raw.cov), rep(0.673549282206, 3*3))) ## p = 4 -- 6 x 4 & 7 x 4 [ n < 2 p ! ] p <- 4 n <- 7 X <- X.[1:n, 1+(1:p)] stopifnot(dim(X) == c(n,p)) (cc <- covMcd(X, use.correction = FALSE)) str(cc) ## best = 1 2 4 5 6 7 mcc <- MASS::cov.mcd(X) stopifnot(cc$best == mcc$best, all.equal(cc$center, mcc$center, tolerance = 1e-10), all.equal(c(mcc$cov / cc$raw.cov), rep(0.7782486992881, p*p))) n <- 6 X <- X[1:n,] (cc <- covMcd(X, use.correction = FALSE)) mcc <- MASS::cov.mcd(X) stopifnot(cc$best == mcc$best, all.equal(cc$center, mcc$center, tolerance = 1e-10), all.equal(c(mcc$cov / cc$raw.cov), rep(0.7528695976179, p*p))) showProc.time() ## nsamp = "exact" -- here for p=7 coleman.x <- data.matrix(coleman[, 1:6]) showSys.time(CcX <- covMcd(coleman.x, nsamp= "exact")) showSys.time(Ccd <- covMcd(coleman.x, nsamp= "deterministic")) stopifnot(all.equal(CcX$best, c(2, 5:9, 11,13, 14:16, 19:20), tolerance=0), intersect(CcX$best, Ccd$best) == c(2,5,7,8,13,14,16,19,20), relErr(CcX$crit, Ccd$crit) < 0.35 # see ~ 0.34 ) summary(Ccd) demo(determinMCD)## ../demo/determinMCD.R ## ----------- including simple "exactfit" (code = 3) warnings() showProc.time() if(!robustbase:::doExtras()) quit() ## if ( doExtras ) ----------------------------------------------------------------- ## ============== ## (nmini, kmini) examples: set.seed(7) ; X1 <- gendata(10000, p=13, eps = 0.30) showSys.time(c1 <- covMcd(X1$X)) # 0.87 sec chk.covMcd <- function(ans, ind) { stopifnot(inherits(ans, "mcd")) ## check that all outliers were detected: mod.outl <- which(ans$mcd.wt == 0) outl.detected <- (ind %in% mod.outl) if(!all(outl.detected)) { cat("The following outliers are *not* detected:\n") print(which(!outl.detected)) } fp <- !(mod.outl %in% ind) if(any(fp)) { cat(sprintf("False positive \"outliers\" (a few expected) %d of %d (= %.2f%%):\n", sum(fp), nobs(ans), 100*sum(fp)/nobs(ans))) print(which(fp)) } else cat("** No ** false positive outliers -- exceptional!\n") } ## chk.covMcd(c1, X1$xind) cat("\ncovMcd(*, kmini=12, trace=2) ...\n------\n") showSys.time(c2 <- covMcd(X1$X, kmini=12, trace=2))# slower.. chk.covMcd(c2, X1$xind) ## Comparing: ii <- !(names(c1) %in% c("call", "method")) cat("\ncovMcd(*, nsamp=\"deterministic\")\n") showSys.time(cD <- covMcd(X1$X, nsamp="deterministic"))# quite slower than FASTMCD chk.covMcd(cD, X1$xind) cat("<.>$crit = log(det(.)) [minimal = best] :\n") print(cbind(sort(c(default = c1$crit, kmini.12 = c2$crit, determin = cD$crit)))) i2 <- names(c1)[ii]; i2 <- i2[i2 != "nsamp"] ## closer coincidence if "raw.*" are dropped: i3 <- i2; i3 <- i3[ - grep("^raw", i3) ] stopifnot(all.equal(c1[ii], c2[ii], tol= 0.02), all.equal(cD[i2], c1[i2], tol= 0.02), all.equal(cD[i3], c1[i3], tol= 6e-4), # 4.60e-4 ## the 0/1 weights coincide : cD$mcd.wt == c1$mcd.wt, c2$mcd.wt == c1$mcd.wt) showProc.time() ## Radarexample --- already some in ../man/radarImage.Rd <<<------------- data(radarImage) print(d <- dim(radarImage)); n.rI <- d[1] ## The 8 "clear" outliers (see also below) ii8 <- c(1548:1549, 1553:1554, 1565:1566, 1570:1571) set.seed(7) showSys.time( L1 <- lapply(0:200, function(n) n+ which(0 == covMcd(unname(radarImage[(n+1L):n.rI,]), trace=2)$mcd.wt))) ## check for covMcd() consistency: print(tablen <- table(vapply(L1, length, 1))) plot(tablen) print(iCommon <- Reduce(intersect, L1)) stopifnot(ii8 %in% iCommon) ## robustbase/tests/binom-no-x.R0000644000176200001440000000102012271657124015673 0ustar liggesusers library(robustbase) ### "intercept only" : "no x" set.seed(101) k <- rbinom(100, size=3, pr = 0.2) y <- cbind(k, n.k = 3 - k) gg <- glm(y ~ 1, family = "binomial") (cfK <- coef(summary(gg))) Inf. <- 1e5 # FIXME (note that much larger values *deteriorate* slightly!) rg.Inf <- glmrob(y ~ 1, family = "binomial", tcc= Inf.) stopifnot(all.equal(unname(cfK[1:2]), unname(unlist(coef(summary(rg.Inf))[1:2])), tolerance = 1e-7))# 4.09e-8 rg.0 <- glmrob(y ~ 1, family = "binomial") summary(rg.0) str(rg.0, digits= 6) robustbase/tests/small-sample.Rout.save0000644000176200001440000001415012271657124017774 0ustar liggesusers R version 3.0.2 Patched (2014-01-26 r64896) -- "Frisbee Sailing" Copyright (C) 2014 The R Foundation for Statistical Computing Platform: x86_64-unknown-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(robustbase) > ## testing functions: > source(system.file("xtraR/ex-funs.R", package = "robustbase")) > > set.seed(152) > > Nmax <- 12 > nn <- length(nset <- c(2:Nmax, 20, 50))## NOTA BENE: n == 1 etc are NOT YET TREATED! > Sim <- 2^9 # = 512 > > sn <- qn <- numeric(Sim) > cpu <- numeric(nn) > names(cpu) <- as.character(nset) > > for(n in nset) { + nS <- Sim ## if(n < 20) Sim else round(10*Sim/n) + cat("\nn = ",n,"\n------\nno.Sim. = ",nS,"\n") + cpu[as.character(n)] <- system.time(for(i in 1:nS) { + x <- rnorm(n) + sn[i] <- Sn0R(x) + qn[i] <- Qn0R(x) + Sn.x <- Sn(x, const = 1) + Qn.x <- Qn(x, const = 1) + if(!is.all.equal(Sn.x, sn[i], tol = 1e-5)) + cat("i=",i," Sn() != Sn0R(): ", Sn.x, "!=", sn[i],"\n") + if(!is.all.equal(Qn.x, qn[i], tol = 1e-5)) + cat("i=",i," Qn() != Qn0R(): ", Qn.x, "!=", qn[i],"\n") + })[1] + cat("Mean and its. std.err; Quartiles of Sn(x_1 .. x_n) and Qn(...):\n") + print(c(mean(sn), sd(sn)/sqrt(nS), quantile(sn, p = (1:3)/4))) + print(c(mean(qn), sd(qn)/sqrt(nS), quantile(qn, p = (1:3)/4))) + } n = 2 ------ no.Sim. = 512 Mean and its. std.err; Quartiles of Sn(x_1 .. x_n) and Qn(...): 25% 50% 75% 1.17177829 0.03695327 0.52951343 1.05306039 1.62748640 25% 50% 75% 1.17177829 0.03695327 0.52951343 1.05306039 1.62748640 n = 3 ------ no.Sim. = 512 Mean and its. std.err; Quartiles of Sn(x_1 .. x_n) and Qn(...): 25% 50% 75% 0.46255834 0.01739738 0.15475882 0.36551414 0.65869811 25% 50% 75% 0.46255834 0.01739738 0.15475882 0.36551414 0.65869811 n = 4 ------ no.Sim. = 512 Mean and its. std.err; Quartiles of Sn(x_1 .. x_n) and Qn(...): 25% 50% 75% 0.84170614 0.02015695 0.51981874 0.77630479 1.12005284 25% 50% 75% 0.84170614 0.02015695 0.51981874 0.77630479 1.12005284 n = 5 ------ no.Sim. = 512 Mean and its. std.err; Quartiles of Sn(x_1 .. x_n) and Qn(...): 25% 50% 75% 0.64309841 0.01561957 0.35812751 0.60223019 0.87200727 25% 50% 75% 0.5591093 0.0133655 0.3273456 0.5337290 0.7412843 n = 6 ------ no.Sim. = 512 Mean and its. std.err; Quartiles of Sn(x_1 .. x_n) and Qn(...): 25% 50% 75% 0.81292713 0.01603854 0.54635157 0.78437781 1.03135301 25% 50% 75% 0.70787958 0.01251911 0.47540581 0.70464628 0.88664634 n = 7 ------ no.Sim. = 512 Mean and its. std.err; Quartiles of Sn(x_1 .. x_n) and Qn(...): 25% 50% 75% 0.71007470 0.01209913 0.52623935 0.69253904 0.88255673 25% 50% 75% 0.533802144 0.009128141 0.376988927 0.520001355 0.663751417 n = 8 ------ no.Sim. = 512 Mean and its. std.err; Quartiles of Sn(x_1 .. x_n) and Qn(...): 25% 50% 75% 0.82650425 0.01419433 0.58883395 0.79562656 1.00574823 25% 50% 75% 0.6645775 0.0103031 0.4938057 0.6323886 0.8027008 n = 9 ------ no.Sim. = 512 Mean and its. std.err; Quartiles of Sn(x_1 .. x_n) and Qn(...): 25% 50% 75% 0.75759768 0.01136142 0.57868634 0.74677447 0.91852270 25% 50% 75% 0.52259364 0.00736039 0.39618164 0.51826059 0.63137960 n = 10 ------ no.Sim. = 512 Mean and its. std.err; Quartiles of Sn(x_1 .. x_n) and Qn(...): 25% 50% 75% 0.83182112 0.01239199 0.62462885 0.80885273 1.01920116 25% 50% 75% 0.623637627 0.008403906 0.474993989 0.613887533 0.750270402 n = 11 ------ no.Sim. = 512 Mean and its. std.err; Quartiles of Sn(x_1 .. x_n) and Qn(...): 25% 50% 75% 0.76832479 0.01118554 0.59020462 0.76690177 0.93425844 25% 50% 75% 0.512979423 0.007139196 0.388824484 0.506239908 0.621525112 n = 12 ------ no.Sim. = 512 Mean and its. std.err; Quartiles of Sn(x_1 .. x_n) and Qn(...): 25% 50% 75% 0.85538366 0.01139366 0.66084900 0.84512561 1.01552717 25% 50% 75% 0.607337007 0.007056424 0.496338090 0.596697510 0.703213097 n = 20 ------ no.Sim. = 512 Mean and its. std.err; Quartiles of Sn(x_1 .. x_n) and Qn(...): 25% 50% 75% 0.84113700 0.00812507 0.71508462 0.82864901 0.94684680 25% 50% 75% 0.542464499 0.004534141 0.473622699 0.541929347 0.612841843 n = 50 ------ no.Sim. = 512 Mean and its. std.err; Quartiles of Sn(x_1 .. x_n) and Qn(...): 25% 50% 75% 0.846902031 0.004784579 0.780334229 0.846165240 0.917926909 25% 50% 75% 0.4860477 0.0023965 0.4492734 0.4853898 0.5220596 > > rbind("Time (CPU) used:" = summary(cpu)) Min. 1st Qu. Median Mean 3rd Qu. Max. Time (CPU) used: 0.284 0.321 0.385 0.4803 0.462 1.515 > > proc.time() user system elapsed 7.506 0.077 7.725 robustbase/tests/exact-fit-categorical.R0000644000176200001440000000145511726415440020060 0ustar liggesusers## recreating exact fit problem for categorical data require(robustbase) ## some simple balanced dataset with one grouping variable ngrp <- 10 nrep <- 10 set.seed(2) data <- data.frame(y = rnorm(ngrp*nrep), grp=rep(letters[1:ngrp], each=nrep)) ## this works fine m1 <- lmrob(y ~ grp, data) ## now contaminate the dataset data2 <- data data2$y[1:48] <- 1e10 try(m2 <- lmrob(y ~ grp, data2, trace.lev = 3)) ## All observations of group "e" get rob. weight of 0: weights <- c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) ## from trace output weights %*% m1$x robustbase/tests/wgt-himed-xtra.R0000644000176200001440000000706312271657124016566 0ustar liggesusers library(robustbase) ## testing functions: source(system.file("xtraR/ex-funs.R", package = "robustbase")) x <- c(0.26, 0.161, 1.33, -0.925, 0.199, -1.476, 0.489) iw <- c(5, 4, 4, 1, 5, 1, 5) stopifnot(0.26 == (himR <- weighted.median(rep(x,iw))), himR == wgt.himedian(x, iw), ## (once gave infinite loop) himR == wgt.himedian(x, as.integer(iw))) ## same result, but *different wweigted.median() debug output! ##-- even when having EXACT data (& exact differences!) all.equal(Qn(c(2:1,4:3)), 1.1376128) ###--- another inifinite loop {solved}: (z4 <- round(qnorm(ppoints(4)), 2)) ## both the same (also wweigted.median debug output) (all.equal(weighted.median(z4, 4:1), print(wgt.himedian (z4, 4:1))))# 3.97e-8 (all.equal(weighted.median(z4, c(4,2,3,17)), print(wgt.himedian (z4, c(4,2,3,17)))))# 4.54e-8 Sn (z4)## = 0.8533053 Sn (z4, const = 1)# = 0.75 ##-- now Qn (z4)# --> gave (another) infinite loop ##--> now "works" after (float) rounding of differences! ##--- DIFFERENT whimed() output! stopifnot(all.equal(Qn(z4, const = 1), print(Qn0R(z4)))) ## yet another problem: Sn0R(c(1.1, -0.93, -0.11, -0.74))# 0.82 Sn (c(1.1, -0.93, -0.11, -0.74))# 0.9329471 ## gave segmentation fault at Sat Mar 16 23:54:30 2002 ## not anymore but 0.9329471 ### Check validity of basic algorithm few times set.seed(471) for(sim in 1:100) { # had '500' cat(".") x <- rnorm(rpois(1, lam=80))# not too large the *n0R() use time! ##--> Sn0R() "fails" for odd n stopifnot(all.equal(Sn(x, const = 1), Sn0R(x)), all.equal(Qn(x, const = 1), Qn0R(x), tolerance = 7e-8)) x <- round(x,2) stopifnot(all.equal(Sn(x, const = 1), Sn0R(x)), all.equal(Qn(x, const = 1), Qn0R(x), tolerance = 7e-8)) if(sim %% 50 == 0) cat(sim, "\n") } ###---- Last series of problems: when n^2 > max.integer: ## Large x with 1% outliers N <- 1e5 n.o <- round(0.01 * N) nSim <- 24## interesting nSim <- 4 ## for package testing estim.lst <- c("mad", "Sn", "Qn") Res <- array(NA, dim = c(nSim, length(estim.lst), 1 + 2), dimnames= list(NULL,estim.lst, c("Tx","cpu1", "cpu3"))) set.seed(101) for(i in 1:nSim) { x <- sample(c(rnorm(N), 10*min(1, abs(rt(1, df=2))) + rnorm(n.o))) cat(i) for(S in estim.lst) { cpu <- system.time(Tx <- get(S)(x))[1:3] Res[i, S,] <- c(Tx, cpu[c(1,3)]) } cat(" ") }; cat("\n") options(digits = 5) (Tx <- Res[,, "Tx"]) stopifnot(abs(range(Tx - 1)) < 0.03) q() ### -- Rest: rather for demo -- keep here for reference apply(Res, c(2,3), mean) ## Variation: robust or not: 1000* apply(Tx, 2, sd)#-> Qn < Sn < mad 1000* apply(Tx, 2, Qn)#-> Qn > Sn > mad if(dev.interactive(orNone=TRUE)) { boxplot(Tx, main = sprintf("n=%d x N(0,1) + %d (1%%) outliers to the right", N,n.o)) abline(h = 1, lty = 3, lwd = 2, col = "gray") } if(interactive()) { ## i.e. not when package testing .. N <- 500 set.seed(101) str(iw <- 1L+ as.integer(rpois(N, 1))); str(w <- as.double(iw)) cr <- ci <- numeric(50) for(nn in seq_along(ci)) { x <- round(rnorm(N),1) cat(".") cr[nn] <- system.time(for(i in 1:1000) rr <- wgt.himedian(x, w))[1] ci[nn] <- system.time(for(i in 1:1000) ri <- wgt.himedian(x, iw))[1] stopifnot(rr == ri) };cat("\n") ## Or rather (as correctly) a "paired" comparsion: boxplot(cr - ci, notch=TRUE) ## rather t.test( cr, ci, paired = TRUE) ##-> P-value of 0.0219 t.test(log(cr), log(ci), paired = TRUE) ##-> P-value of 0.0088 wilcox.test(cr, ci, paired = TRUE) ##-> P-value of 2.23e-5 (!!) } robustbase/tests/OGK-ex.Rout.save0000644000176200001440000001160412271657124016440 0ustar liggesusers R version 2.4.0 Patched (2006-10-03 r39576) Copyright (C) 2006 The R Foundation for Statistical Computing ISBN 3-900051-07-0 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(robustbase) > > ## minimal testing only > data(ruspini, package = "cluster") > > rub1 <- covOGK(ruspini, 1, scaleTau2, covGK, hard.rejection, consistency=FALSE) > rub2 <- covOGK(ruspini, 2, scaleTau2, covGK, hard.rejection, consistency=FALSE) > > AE <- function(x,y) all.equal(x,y, tolerance = 2e-15) > ## The following test is already fulfilled by Kjell Konis' original code: > stopifnot(AE(c(rub1$wcov)[c(1,3:4)], + c(917.99893333333, 94.9232, 2340.319288888888)), + all.equal(rub1$wcov, rub2$wcov, tolerance=0) + , + AE(c(rub1$cov)[c(1,3:4)], + c(923.5774514441657, 91.5385216376565, 2342.4556232436971)) + , + AE(c(rub2$cov)[c(1,3:4)], + c(927.2465953711782, 91.8009184487779, 2346.5790105548940)) + ) > > data(milk) > cM1 <- covOGK(milk, 1, sigmamu = scaleTau2, weight.fn = hard.rejection) > cM2 <- covOGK(milk, 2, sigmamu = scaleTau2, weight.fn = hard.rejection) > > symnum(cov2cor(cM1 $cov)) [1,] 1 [2,] 1 [3,] . . 1 [4,] . * 1 [5,] . . * * 1 [6,] . . * * * 1 [7,] . . . . . . 1 [8,] . , . . . . 1 attr(,"legend") [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 > symnum(cov2cor(cM2 $cov)) [1,] 1 [2,] 1 [3,] . . 1 [4,] . . B 1 [5,] . . * * 1 [6,] . . B * * 1 [7,] . , . . . . 1 [8,] . . . . . . 1 attr(,"legend") [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 > symnum(cov2cor(cM1 $wcov)) X1 X2 X3 X4 X5 X6 X7 X8 X1 1 X2 1 X3 1 X4 B 1 X5 * * 1 X6 * * * 1 X7 . . 1 X8 . . . . . . 1 attr(,"legend") [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 > symnum(cov2cor(cM2 $wcov)) X1 X2 X3 X4 X5 X6 X7 X8 X1 1 X2 1 X3 1 X4 . B 1 X5 * B 1 X6 B B B 1 X7 . , . . . . 1 X8 . . . . . . 1 attr(,"legend") [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 > > cMQn <- covOGK(milk, sigmamu = s_Qn, weight.fn = hard.rejection) > cMSn <- covOGK(milk, sigmamu = s_Sn, weight.fn = hard.rejection) > cMiqr <- covOGK(milk, sigmamu = s_IQR, weight.fn = hard.rejection) > cMmad <- covOGK(milk, sigmamu = s_mad, weight.fn = hard.rejection) > > as.dist(round(cov2cor(cMQn$wcov), 3)) X1 X2 X3 X4 X5 X6 X7 X2 0.091 X3 0.227 0.187 X4 0.288 0.176 0.964 X5 0.256 0.132 0.943 0.952 X6 0.241 0.196 0.954 0.956 0.957 X7 0.445 0.634 0.360 0.372 0.377 0.370 X8 0.014 0.452 0.440 0.380 0.340 0.350 0.479 > as.dist(round(cov2cor(cMSn$wcov), 3)) X1 X2 X3 X4 X5 X6 X7 X2 0.096 X3 0.242 0.219 X4 0.305 0.200 0.960 X5 0.269 0.142 0.945 0.952 X6 0.260 0.233 0.948 0.953 0.964 X7 0.445 0.636 0.391 0.399 0.395 0.408 X8 0.020 0.448 0.453 0.384 0.331 0.360 0.484 > as.dist(round(cov2cor(cMiqr$wcov), 3)) X1 X2 X3 X4 X5 X6 X7 X2 0.162 X3 0.181 0.215 X4 0.225 0.199 0.964 X5 0.210 0.140 0.945 0.954 X6 0.187 0.239 0.950 0.951 0.954 X7 0.453 0.660 0.350 0.354 0.355 0.367 X8 0.111 0.454 0.470 0.407 0.345 0.404 0.516 > as.dist(round(cov2cor(cMmad$wcov), 3)) X1 X2 X3 X4 X5 X6 X7 X2 0.077 X3 0.228 0.175 X4 0.289 0.159 0.962 X5 0.257 0.092 0.945 0.952 X6 0.238 0.189 0.954 0.956 0.962 X7 0.451 0.588 0.345 0.358 0.353 0.358 X8 -0.003 0.392 0.488 0.412 0.353 0.380 0.439 > > > cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' Time elapsed: 1.925 0.07 2.512 0 0 > robustbase/tests/lmrob-methods.R0000644000176200001440000000352512343540301016464 0ustar liggesusers### tests methods argument of lmrob.control library(robustbase) data(stackloss) ## S set.seed(0) summary(m0 <- lmrob(stack.loss ~ ., data = stackloss, method = "S", compute.outlier.stats = "S")) set.seed(0) m0a <- lmrob.S(m0$x, stack.loss, lmrob.control()) all.equal(m0[c('coefficients', 'scale', 'rweights')], m0a[c('coefficients', 'scale', 'rweights')]) ## MM set.seed(0) summary(m1 <- lmrob(stack.loss ~ ., data = stackloss, method = "MM", compute.outlier.stats = "S")) set.seed(0) m2 <- update(m1, method = "SM") all.equal(m1[c('coefficients', 'scale', 'cov')], m2[c('coefficients', 'scale', 'cov')]) set.seed(0) m3 <- update(m0, method = "SM", cov = '.vcov.w') ## SMD set.seed(0) summary(m4 <- lmrob(stack.loss ~ ., data = stackloss, method = "SMD", psi = 'bisquare', compute.outlier.stats = "S")) summary(m4a <- lmrob..D..fit(m3)) ## rearrange m4a and update call m4a <- m4a[names(m4)] class(m4a) <- class(m4) m4a$call <- m4$call all.equal(m4, m4a) ## SMDM set.seed(0) summary(m5 <- lmrob(stack.loss ~ ., data = stackloss, method = "SMDM", psi = 'bisquare', compute.outlier.stats = "S")) summary(m5a <- lmrob..M..fit(obj=m4)) ## rearrange m5a m5a <- m5a[names(m5)] class(m5a) <- class(m5) all.equal(m5, m5a) ## Fast S large n strategy (sped up) model <- model.frame(LNOx ~ . ,data = NOxEmissions) control <- lmrob.control(fast.s.large.n = 10, n.group = 341, groups = 2) set.seed(0) try(ret <- lmrob.S(model.matrix(model, NOxEmissions)[1:682,], NOxEmissions$LNOx[1:682], control)) ## do what the error says control <- lmrob.control(fast.s.large.n = Inf) try(ret <- lmrob.S(model.matrix(model, NOxEmissions)[1:682,], NOxEmissions$LNOx[1:682], control)) ## this still fails, but this error is to be expected since only a part ## of the design matrix is given robustbase/tests/NAcoef.Rout.save0000644000176200001440000004661213344170716016547 0ustar liggesusers R version 3.5.1 (2018-07-02) -- "Feather Spray" Copyright (C) 2018 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## test handing of NA coefficients / singular fits > ## also check: > ## -- what would have to be done if class "lm" was added. > ## -- general compatibility to class lm. > require(robustbase) Loading required package: robustbase > source(system.file("test-tools-1.R", package="Matrix", mustWork=TRUE)) Loading required package: tools > ##-> assertError(), etc > options(digits = 5)# -> higher chance of platform independence > > ## generate simple example data (almost as in ./weights.R ) > data <- expand.grid(x1=letters[1:3], x2=LETTERS[1:3], rep=1:3) > set.seed(1) > data$y <- rnorm(nrow(data)) > ## drop all combinations of one interaction: > data <- subset(data, x1 != 'c' | (x2 != 'B' & x2 != 'C')) > ## add collinear variables > data$x3 <- rnorm(nrow(data)) > data$x4 <- rnorm(nrow(data)) > data$x5 <- data$x3 + data$x4 > ## add some NA terms > data$y[1] <- NA > data$x4[2:3] <- NA ## to test anova > > ## Classical models start with 'cm', robust just with 'rm' (or just 'm'): > cm0 <- lm (y ~ x1*x2 + x3, data) > cm1 <- lm (y ~ x1*x2 + x3 + x4 + x5, data) > set.seed(2) > rm1 <- lmrob(y ~ x1*x2 + x3 + x4 + x5, data) > m3 <- lmrob(y ~ x1*x2 + x3 + x4, data) # same column space as rm1 > rm0 <- lmrob(y ~ x1*x2 + x3, data) > > ## clean version of rm1 (to check predict) > data2 <- data.frame(y=data$y[-(1:3)], rm1$x[,!is.na(rm1$coef)]) > set.seed(2) > rm1c <- lmrob(y ~ x1b + x1c + x2B + x2C + x3 + x4 + x1b:x2B + x1b:x2C, data2) > > ## add class lm to rm1 (for now) > class(rm1) <- c(class(rm1), "lm") > class(rm0) <- c(class(rm0), "lm") > > ## the full matrix (data) should be returned by model matrix (frame) > stopifnot(all.equal(model.matrix(cm1), model.matrix(rm1)), + all.equal(model.frame (cm1), model.frame (rm1))) > ## qr decomposition should be for the full data and pivots identical lm result > qr.cm1 <- qr(cm1)$qr > qr.rm1 <- rm1$qr$qr > stopifnot(NCOL(qr.rm1) == NCOL(qr.cm1), + NROW(qr.rm1) == NROW(qr.cm1), + length(rm1$qr$qraux) == length(qr(cm1)$qraux), + all.equal(rm1$qr$pivot, qr(cm1)$pivot), + all.equal(dimnames(qr.rm1),dimnames(qr.cm1))) > ## the alias function should return the same result > stopifnot(all.equal(alias(cm1), alias(rm1))) > > #### > ## these helper functions should print NAs for the dropped coefficients > print(rm1) Call: lmrob(formula = y ~ x1 * x2 + x3 + x4 + x5, data = data) \--> method = "MM" Coefficients: (Intercept) x1b x1c x2B x2C x3 0.4381 0.5968 0.0344 0.2012 0.1789 -0.1320 x4 x5 x1b:x2B x1c:x2B x1b:x2C x1c:x2C -0.2155 NA -1.8763 NA -0.8651 NA > summary(rm1) -> s1 > confint(rm1) -> ci1 > stopifnot(identical(is.na(coef(cm1)), apply(ci1, 1L, anyNA)), + identical(sigma(rm1), s1$ sigma), + identical(vcov(rm1, complete=FALSE), s1$ cov ), + TRUE) > > print(s1, showAlgo=FALSE) Call: lmrob(formula = y ~ x1 * x2 + x3 + x4 + x5, data = data) \--> method = "MM" Residuals: Min 1Q Median 3Q Max -1.4584 -0.3556 0.0246 0.3651 1.0296 Coefficients: (3 not defined because of singularities) Estimate Std. Error t value Pr(>|t|) (Intercept) 0.4381 0.5443 0.80 0.44 x1b 0.5968 0.6423 0.93 0.38 x1c 0.0344 0.6880 0.05 0.96 x2B 0.2012 0.7164 0.28 0.79 x2C 0.1789 0.6871 0.26 0.80 x3 -0.1320 0.4155 -0.32 0.76 x4 -0.2155 0.1694 -1.27 0.24 x5 NA NA NA NA x1b:x2B -1.8763 1.2153 -1.54 0.16 x1c:x2B NA NA NA NA x1b:x2C -0.8651 0.7466 -1.16 0.28 x1c:x2C NA NA NA NA Robust residual standard error: 0.927 (3 observations deleted due to missingness) Multiple R-squared: 0.338, Adjusted R-squared: -0.251 Convergence in 15 IRWLS iterations Robustness weights: 2 weights are ~= 1. The remaining 16 ones are summarized as Min. 1st Qu. Median Mean 3rd Qu. Max. 0.787 0.937 0.985 0.952 0.988 0.994 > ci1 2.5 % 97.5 % (Intercept) -0.79333 1.66946 x1b -0.85607 2.04973 x1c -1.52188 1.59076 x2B -1.41948 1.82189 x2C -1.37549 1.73320 x3 -1.07182 0.80783 x4 -0.59863 0.16756 x5 NA NA x1b:x2B -4.62539 0.87283 x1c:x2B NA NA x1b:x2C -2.55391 0.82381 x1c:x2C NA NA > ## drop1 should return df = 0 > #drop1(rm1) ## drop.lm does not return valid results (yet)! > > #### > ## methods that should just drop the NA coefficients > ## m3 is actually the same as rm1, so anova should raise an error > assertError(anova(rm1, m3, test="Wald")) > assertError(anova(rm1, m3, test="Deviance")) > ## but comparing rm1 and rm0 should be ok > anova(rm1, rm0, test="Wald") Robust Wald Test Table Model 1: y ~ x1 * x2 + x3 + x4 + x5 Model 2: y ~ x1 * x2 + x3 Largest model fitted by lmrob(), i.e. SM pseudoDf Test.Stat Df Pr(>chisq) 1 6 2 10 1.62 1 0.2 > anova(rm1, rm0, test="Deviance") Robust Deviance Table Model 1: y ~ x1 * x2 + x3 + x4 + x5 Model 2: y ~ x1 * x2 + x3 Largest model fitted by lmrob(), i.e. SM pseudoDf Test.Stat Df Pr(>chisq) 1 6 2 10 1.4 1 0.24 > ## commands with single #: > ## they do (or might) not return sensible results for robust fits > ## and need to be checked again > #cooks.distance(rm1) > #deviance(rm1) > #dfbeta(rm1) > #dfbetas(rm1) > #effects(rm1) ## fails > #extractAIC(rm1) > #influence(rm1) > stopifnot(all.equal(hv1 <- hatvalues(rm1), .lmrob.hat(wqr=rm1$qr), tol=1e-15), + all.equal(hv1, stats:::hatvalues.lm(rm1), tol=1e-15), + all.equal(hat(cm1$qr), unname(hatvalues(cm1)), tol=1e-15), + all.equal(unname(hv1), hat(rm1$qr), tol=1e-15), + ## ditto : + all.equal(hv1c <- hatvalues(rm1c), stats:::hatvalues.lm(rm1c), tol=1e-15)) > > ## kappa() & labels() : > stopifnot(is.infinite(kr1 <- kappa(rm1)), kr1 == kappa(cm1), # = +Inf both + identical(labels(rm1), labels(cm1))) > logLik(rm1)# well, and what does it mean? 'log Lik.' -17.67 (df=10) > ## plot(rm1, which=1) ## plot.lmrob() fails "singular covariance" .. FIXME! > par(mfrow=c(2,2)) > plot(rm1, which=2:4) > stopifnot(all.equal(predict(rm1), predict(rm1c), tol=1e-15), + all.equal(predict(rm1, se.fit=TRUE, interval="confidence"), + predict(rm1c, se.fit=TRUE, interval="confidence"), tol=1e-15)) > predict(rm1, type="terms", se.fit=TRUE, interval="confidence") $fit x1 x2 x3 x4 x5 x1:x2 4 -0.26908 0.074520 -0.166290 0.17233795 0 0.45689 5 0.32774 0.074520 0.026620 -0.03309916 0 -1.41939 7 -0.26908 0.052168 -0.038119 0.28384254 0 0.45689 8 0.32774 0.052168 0.020155 -0.26844357 0 -0.40816 10 -0.26908 -0.126688 0.194821 -0.38642275 0 0.45689 11 0.32774 -0.126688 0.067831 0.11957373 0 0.45689 12 -0.23465 -0.126688 0.065098 0.26547275 0 0.45689 13 -0.26908 0.074520 0.020882 -0.08237063 0 0.45689 14 0.32774 0.074520 -0.132148 0.06953345 0 -1.41939 16 -0.26908 0.052168 -0.087685 -0.47721028 0 0.45689 17 0.32774 0.052168 0.034769 0.04888197 0 -0.40816 19 -0.26908 -0.126688 0.046496 -0.10823918 0 0.45689 20 0.32774 -0.126688 -0.078945 0.03438888 0 0.45689 21 -0.23465 -0.126688 -0.060426 0.20062634 0 0.45689 22 -0.26908 0.074520 0.103967 -0.00026715 0 0.45689 23 0.32774 0.074520 0.106440 0.42945756 0 -1.41939 25 -0.26908 0.052168 -0.035072 -0.27545520 0 0.45689 26 0.32774 0.052168 -0.088392 0.00739277 0 -0.40816 attr(,"constant") [1] 0.32347 $se.fit x1 x2 x3 x4 x5 x1:x2 4 0.35192 0.42010 0.523390 0.13540939 0 0.29013 5 0.29582 0.42010 0.083786 0.02600668 0 0.95012 7 0.35192 0.40345 0.119979 0.22302078 0 0.29013 8 0.29582 0.40345 0.063436 0.21092151 0 0.53827 10 0.35192 0.40191 0.613190 0.30362011 0 0.29013 11 0.29582 0.40191 0.213494 0.09395148 0 0.29013 12 0.40411 0.40191 0.204892 0.20858727 0 0.29013 13 0.35192 0.42010 0.065724 0.06472026 0 0.29013 14 0.29582 0.42010 0.415930 0.05463383 0 0.95012 16 0.35192 0.40345 0.275984 0.37495370 0 0.29013 17 0.29582 0.40345 0.109434 0.03840755 0 0.53827 19 0.35192 0.40191 0.146343 0.08504570 0 0.29013 20 0.29582 0.40191 0.248476 0.02702003 0 0.29013 21 0.40411 0.40191 0.190187 0.15763614 0 0.29013 22 0.35192 0.42010 0.327230 0.00020991 0 0.29013 23 0.29582 0.42010 0.335015 0.33743343 0 0.95012 25 0.35192 0.40345 0.110386 0.21643068 0 0.29013 26 0.29582 0.40345 0.278210 0.00580864 0 0.53827 $lwr x1 x2 x3 x4 x5 x1:x2 4 -1.06517 -0.87582 -1.35028 -0.1339794 0 -0.19943 5 -0.34144 -0.87582 -0.16292 -0.0919303 0 -3.56872 7 -1.06517 -0.86049 -0.30953 -0.2206655 0 -0.19943 8 -0.34144 -0.86049 -0.12335 -0.7455812 0 -1.62581 10 -1.06517 -1.03588 -1.19231 -1.0732591 0 -0.19943 11 -0.34144 -1.03588 -0.41513 -0.0929593 0 -0.19943 12 -1.14880 -1.03588 -0.39840 -0.2063844 0 -0.19943 13 -1.06517 -0.87582 -0.12780 -0.2287780 0 -0.19943 14 -0.34144 -0.87582 -1.07305 -0.0540569 0 -3.56872 16 -1.06517 -0.86049 -0.71200 -1.3254145 0 -0.19943 17 -0.34144 -0.86049 -0.21279 -0.0380019 0 -1.62581 19 -1.06517 -1.03588 -0.28455 -0.3006259 0 -0.19943 20 -0.34144 -1.03588 -0.64104 -0.0267347 0 -0.19943 21 -1.14880 -1.03588 -0.49066 -0.1559714 0 -0.19943 22 -1.06517 -0.87582 -0.63628 -0.0007420 0 -0.19943 23 -0.34144 -0.87582 -0.65142 -0.3338699 0 -3.56872 25 -1.06517 -0.86049 -0.28478 -0.7650554 0 -0.19943 26 -0.34144 -0.86049 -0.71775 -0.0057473 0 -1.62581 attr(,"constant") [1] 0.32347 $upr x1 x2 x3 x4 x5 x1:x2 4 0.52701 1.02486 1.01770 0.47865527 0 1.11321 5 0.99693 1.02486 0.21616 0.02573203 0 0.72993 7 0.52701 0.96483 0.23329 0.78835059 0 1.11321 8 0.99693 0.96483 0.16366 0.20869402 0 0.80949 10 0.52701 0.78250 1.58195 0.30041366 0 1.11321 11 0.99693 0.78250 0.55079 0.33210673 0 1.11321 12 0.67950 0.78250 0.52860 0.73732993 0 1.11321 13 0.52701 1.02486 0.16956 0.06403677 0 1.11321 14 0.99693 1.02486 0.80875 0.19312376 0 0.72993 16 0.52701 0.96483 0.53663 0.37099391 0 1.11321 17 0.99693 0.96483 0.28233 0.13576588 0 0.80949 19 0.52701 0.78250 0.37755 0.08414755 0 1.11321 20 0.99693 0.78250 0.48315 0.09551244 0 1.11321 21 0.67950 0.78250 0.36981 0.55722407 0 1.11321 22 0.52701 1.02486 0.84421 0.00020769 0 1.11321 23 0.99693 1.02486 0.86430 1.19278501 0 0.72993 25 0.52701 0.96483 0.21464 0.21414502 0 1.11321 26 0.99693 0.96483 0.54096 0.02053283 0 0.80949 attr(,"constant") [1] 0.32347 $df [1] 9 $residual.scale [1] 0.92726 > #proj(rm1) ## fails "FIXME" > residuals(rm1) 4 5 7 8 10 11 12 13 1.003436 1.029645 -0.321738 0.691394 -0.498376 0.342960 -0.359752 -1.145548 14 16 17 19 20 21 22 23 -1.458427 -0.043483 -0.395061 0.498376 -0.342960 0.359752 0.092640 0.232325 25 26 0.366908 -0.270349 > #rstandard(rm1) > #rstudent(rm1) > #simulate(rm1) ## just $weights needs to be changed to prior weights > V1 <- vcov(rm1, complete=FALSE) > ## but don't show the "eigen" part {vectors may flip sign}: > attributes(V1) <- attributes(V1)[c("dim","dimnames", "weights")]; V1 (Intercept) x1b x1c x2B x2C x3 (Intercept) 0.296312 -0.321429 -0.338842 -0.238010 -0.3289125 0.1357438 x1b -0.321429 0.412501 0.369763 0.253038 0.3616767 -0.1594475 x1c -0.338842 0.369763 0.473317 0.274811 0.3497592 -0.1464335 x2B -0.238010 0.253038 0.274811 0.513277 0.2342086 -0.0640599 x2C -0.328913 0.361677 0.349759 0.234209 0.4721185 -0.2294044 x3 0.135744 -0.159448 -0.146434 -0.064060 -0.2294044 0.1726038 x4 -0.035258 0.039598 0.060587 0.035359 0.0024864 0.0037187 x1b:x2B 0.305162 -0.399754 -0.273260 -0.557840 -0.5219539 0.3087350 x1b:x2C 0.321423 -0.414159 -0.349092 -0.233097 -0.4394078 0.2039253 x4 x1b:x2B x1b:x2C (Intercept) -0.0352579 0.305162 0.321423 x1b 0.0395980 -0.399754 -0.414159 x1c 0.0605871 -0.273260 -0.349092 x2B 0.0353593 -0.557840 -0.233097 x2C 0.0024864 -0.521954 -0.439408 x3 0.0037187 0.308735 0.203925 x4 0.0286797 0.063743 -0.012435 x1b:x2B 0.0637434 1.476860 0.498060 x1b:x2C -0.0124347 0.498060 0.557368 attr(,"weights") 4 5 7 8 10 11 12 13 14 16 0.89614 0.89081 0.98906 0.94998 0.97385 0.98757 0.98633 0.86577 0.78729 0.99980 17 19 20 21 22 23 25 26 0.98353 0.97385 0.98757 0.98633 0.99909 0.99429 0.98578 0.99227 > set.seed(12); sc <- simulate(cm1, 64) > set.seed(12); rc <- simulate(rm1, 64) > > stopifnot(all.equal(sqrt(diag(V1)), coef(summary(rm1))[,"Std. Error"], tol=1e-15), + all.equal(sc, rc, tolerance = 0.08),# dimension *and* approx. values (no NA) + identical(variable.names(rm1), variable.names(cm1)), + all.equal(residuals(rm1), residuals(cm1), tolerance = 0.05),# incl. names + all.equal(rstudent (rm1), rstudent (cm1), tolerance = 0.06), + identical(dimnames(rm1), dimnames(cm1)), + all.equal(dummy.coef(rm1), dummy.coef(cm1), tolerance= .5)) ## check mostly structure > > ## other helper functions > stopifnot(identical(case.names(rm1), case.names(cm1)), + all.equal(family(rm1), family(cm1)),# identical() upto environment + identical(formula(rm1), formula(cm1)), + nobs(rm1) == nobs(cm1)) > #add1(rm0, ~ . + x3 + x4 + x5) ## does not return valid results (yet)! > > > ## test other initial estimators > lmrob(y ~ x1*x2 + x3 + x4 + x5, data, init="M-S") Call: lmrob(formula = y ~ x1 * x2 + x3 + x4 + x5, data = data, init = "M-S") \--> method = "M-SM" Coefficients: (Intercept) x1b x1c x2B x2C x3 0.4358 0.5996 0.0346 0.2005 0.1877 -0.1395 x4 x5 x1b:x2B x1c:x2B x1b:x2C x1c:x2C -0.2185 NA -1.8957 NA -0.8698 NA Warning message: In lmrob.M.S(x, y, control, mf = mf) : Skipping design matrix equilibration (DGEEQU): row 12 is exactly zero. > lmrob(y ~ x1*x2 + x3 + x4 + x5, data, init=lmrob.lar) Call: lmrob(formula = y ~ x1 * x2 + x3 + x4 + x5, data = data, init = lmrob.lar) \--> method = "lM" Coefficients: (Intercept) x1b x1c x2B x2C x3 0.561131 0.444339 0.000184 0.530303 -0.251794 0.236541 x4 x5 x1b:x2B x1c:x2B x1b:x2C x1c:x2C -0.082680 NA -1.298418 NA -0.597602 NA > > ## test all zero design matrix > data <- data.frame(y=1:10,x1=0,x2=0,os=2,w=c(0.5, 1)) > (m5 <- lmrob(y ~ 1+x1+x2+offset(os), data, weights=w)) Call: lmrob(formula = y ~ 1 + x1 + x2 + offset(os), data = data, weights = w) \--> method = "MM" Coefficients: (Intercept) x1 x2 3.64 NA NA > (sm5 <- summary(m5)) Call: lmrob(formula = y ~ 1 + x1 + x2 + offset(os), data = data, weights = w) \--> method = "MM" Residuals: Min 1Q Median 3Q Max -4.641 -2.391 -0.141 2.109 4.359 Coefficients: (2 not defined because of singularities) Estimate Std. Error t value Pr(>|t|) (Intercept) 3.64 1.03 3.53 0.0064 ** x1 NA NA NA NA x2 NA NA NA NA --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 3.24 Convergence in 8 IRWLS iterations Robustness weights: 1 2 3 4 5 6 7 8 9 10 0.909 0.889 0.970 0.977 0.998 0.999 0.992 0.952 0.952 0.842 Algorithmic parameters: tuning.chi bb tuning.psi refine.tol 1.55e+00 5.00e-01 4.69e+00 1.00e-07 rel.tol scale.tol solve.tol eps.outlier 1.00e-07 1.00e-10 1.00e-07 1.00e-02 eps.x warn.limit.reject warn.limit.meanrw 1.82e-12 5.00e-01 5.00e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd fast.s.large.n 200 0 1000 0 2000 psi subsampling cov "bisquare" "nonsingular" ".vcov.avar1" compute.outlier.stats "SM" seed : int(0) > (m6 <- lmrob(y ~ 0+x1+x2+offset(os), data, weights=w)) Call: lmrob(formula = y ~ 0 + x1 + x2 + offset(os), data = data, weights = w) \--> method = "MM" Coefficients: x1 x2 NA NA > (sm6 <- summary(m6)) Call: lmrob(formula = y ~ 0 + x1 + x2 + offset(os), data = data, weights = w) \--> method = "MM" Weighted Residuals: Min 1Q Median 3Q Max -3.83 -1.37 1.09 3.54 6.00 Coefficients: (2 not defined because of singularities) Estimate Std. Error t value Pr(>|t|) x1 NA NA NA NA x2 NA NA NA NA Robust residual standard error: NA Convergence in 0 IRWLS iterations Robustness weights: [1] NA NA NA NA NA NA NA NA NA NA Algorithmic parameters: tuning.psi rel.tol scale.tol solve.tol 4.69e+00 1.00e-07 1.00e-10 1.00e-07 eps.outlier warn.limit.reject warn.limit.meanrw 1.00e-02 5.00e-01 5.00e-01 max.it maxit.scale trace.lev compute.rd fast.s.large.n 50 200 0 0 2000 eps.x 0 psi cov compute.outlier.stats "bisquare" ".vcov.avar1" "SM" seed : int(0) > > sc5 <- summary(cm5 <- lm(y ~ 1+x1+x2+offset(os), data, weights=w)) > sc6 <- summary(cm6 <- lm(y ~ 0+x1+x2+offset(os), data, weights=w)) > > if(getRversion() <= "3.5.1" && as.numeric(R.version$`svn rev`) < 74993) + ## in the past, lm() returned logical empty matrix + storage.mode(sc6$coefficients) <- "double" > > stopifnot(all.equal(coef(m5), coef(cm5), tolerance = 0.01), + all.equal(coef(m6), coef(cm6), tolerance = 1e-14), + all.equal(coef(sm5), coef(sc5), tolerance = 0.05), + all.equal(coef(sm6), coef(sc6), tolerance = 1e-14), + identical(sm5$df, sc5$df), + identical(sm6$df, sc6$df)) > > proc.time() user system elapsed 0.631 0.094 0.721 robustbase/tests/lmrob-outlierStats.R0000644000176200001440000000457513326344173017544 0ustar liggesuserslibrary(robustbase) if (FALSE) { ## artificial data example, also used in example(outlierStats): data <- expand.grid(grp1 = letters[1:5], grp2 = letters[1:5], rep=1:3) set.seed(101) data$y <- c(rt(nrow(data), 1)) control <- lmrob.control(method = "SMDM", compute.outlier.stats = c("S", "MM", "SMD", "SMDM")) set.seed(2) fit1 <- lmrob(y ~ grp1*grp2, data, control = control) fit2 <- lmrob(y ~ grp1*grp2, data, setting = "KS2014") fit1$ostats ## SMDM fit1$init$ostats ## SMD fit1$init$init$ostats ## SM fit1$init$init$init.S$ostats ## S } ## real data example that is prone for local exact fit: ## NOxEmissions example ## use a subset: selDays <- c( ## days ranked according to number of outliers ## (according to main effects model of the full data): "403", "407", "693", "405", "396", "453", "461", ## "476", "678", "730", "380", "406", "421", "441" ## ,"442", "454", "462", "472", "480", "488" ## some other days ## "712", "503", "666", "616", "591", "552", "624", "522", "509", "388", "606", "580", "573", "602", "686", "476", "708", "600", "567" ) opts <- options(warn=2) ## this happens for specific seeds only set.seed(18) res <- try(lmrob(LNOx ~ (LNOxEm + sqrtWS)*julday, NOxEmissions, julday %in% selDays, setting='KS2011')) ## this should give a warning and suggest setting KS2014 options(opts) stopifnot(is(res, "try-error"), grepl("setting", res)) if (FALSE) { ## some other datasets: ## ambienNOxCH data <- cbind(stack(ambientNOxCH[,-1]), day = factor(ambientNOxCH[, 1])) str(data) ## 'data.frame': 4758 obs. of 3 variables: ## $ values: num 12 17 12.3 13.5 47 ... ## $ ind : Factor w/ 13 levels "ad","ba","ef",..: 1 1 1 1 1 1 1 1 1 1 ... ## $ day : Factor w/ 366 levels "2004-01-01","2004-01-02",..: 1 2 3 4 5 6 7 8 9 10 ... ## ## Takes > 1 hour (how much ?) : system.time(fit <- lmrob(values ~ ind + day, data, setting="KS2014", fast.s.large.n = Inf)) summary(fit) ## CrohnD produces an error as well set.seed(11) fit <- lmrob(BMI ~ age*country*sex*treat, CrohnD) summary(fit) fit$ostats ## wagnerGrowth set.seed(4) fit <- lmrob(y ~ ., data=wagnerGrowth) fit$ostats fit <- lmrob(y ~ ., data=wagnerGrowth, setting="KS2014") } robustbase/tests/lmrob-ex12.R0000644000176200001440000001634713210011166015602 0ustar liggesusers library(robustbase) source(system.file("test-tools-1.R", package="Matrix", mustWork=TRUE)) ##-> assertError(), etc set.seed(1) # since now .Random.seed is used by default! ## EX 1 data(coleman) ## "empty model" (not really a lot of sense) (m0 <- lmrob(Y ~ 0, data = coleman)) summary(m0) stopifnot(is.numeric(coef(m0)), length(coef(m0)) == 0, residuals(m0) == coleman[,"Y"]) ## "Intercept" only: robust mean (m1 <- lmrob(Y ~ 1, data = coleman)) summary(m1) stopifnot(all.equal(coef(m1), c("(Intercept)" = 35.56048875388), tol = 1e-11)) (mC <- lmrob(Y ~ ., data = coleman, control = lmrob.control(refine.tol = 1e-8, rel.tol = 1e-9))) summary(mC) ## Values will change once we use R's random number generator ! stopifnot( all.equal(unname(coef(mC)), c(30.50232, -1.666147, 0.08425381, 0.6677366, 1.167777, -4.136569), tolerance = 2e-7)# 6.112 e-8 (32-b) ) dput(signif(unname(coef(mC)), 7)) ## 64b(0.2-0): c(30.50232, -1.666147, 0.08425381, 0.6677366, 1.167777, -4.136569) ## 32b(0.2-0): "exactly" same ! ## Full precision: dput(unname(coef(mC))) ## 2012-06-04: ## 32-bit:c(30.5023184450149, -1.66614687548007, 0.0842538074792178, 0.667736590070332, 1.16777744029117, -4.13656885405815) ## 64-bit:c(30.5023184450148, -1.66614687548008, 0.0842538074792178, 0.667736590070332, 1.16777744029117, -4.13656885405814) ## ## 32-bit:c(30.5023183940104, -1.66614687550933, 0.0842538074635567, 0.667736589938547, 1.16777744089398, -4.13656884777543) ## 64-bit:c(30.5023184150851, -1.66614687537736, 0.0842538074722959, 0.667736589980183, 1.16777744061092, -4.1365688503035) str(mC) ## EX 2 gen <- function(n,p, n0, y0, x0, beta = rep(1, p)) { stopifnot(n >= 1, p >= 1, n0 >= 0, length(beta) == p) x <- matrix(rnorm(n*p),n,p) # iid x's y <- x %*% beta + rnorm(n) xc <- matrix(0,n0,p) xc[,1] <- x0 xc <- xc + 0.1*matrix(rnorm(n0*p),n0,p) x[1:n0,] <- xc y[1:n0] <- y0 + .001*rnorm(n0) list(x=x, y=y) } ## generate --a sample of n observations with p variables ## and 10% of outliers near (x1,y) = (10,10) n <- 500 ; n0 <- n %/% 10 p <- 7 ## p = 20 is more impressive but too slow for "standard test" set.seed(17) a <- gen(n=n, p=p, n0= n0, y0=10, x0=10) plot(a$x[,1], a$y, col = c(rep(2, n0), rep(1, n-n0))) system.time( m1 <- lmrob(y~x, data = a, control = lmrob.control(compute.rd = TRUE, trace.lev=4))) plot(m1, ask=FALSE) ##-> currently 5 plots; MM:I don't like #3 (Response vs fitted) S1 <- m1$init.S resS1 <- drop(a$y - model.matrix(m1, data=a) %*% coef(S1)) all.equal(S1$residuals, resS1)## hmm, but still close ## "Mean relative difference: 2.655326e-07" ctr.t3 <- lmrob.control(trace.lev = 3) (mS <- lmrob.S(x=a$x, y=residuals(S1), only.scale=TRUE, control = ctr.t3)) all.equal(S1$scale, mS) ## "Mean relative difference: 0.003015849" -- too different, why? (mS. <- lmrob.S(x=a$x, y=resS1, only.scale=TRUE, control = ctr.t3)) all.equal(mS, mS., tol=0)# 2.401 e -10 -- ok/perfect stopifnot(all.equal(mS, mS.), all.equal(mS, S1$scale, tol = 0.008)) # at least that ## don't compute robust distances --> faster by factor of two: system.time(m2 <- lmrob(y~x, data = a, control = lmrob.control(compute.rd = FALSE))) ## ==> half of the CPU time is spent in covMcd()! (sm2 <- summary(m2)) l1 <- lm(y~x, data = a) cbind(robust = coef(sm2)[,1:2], lm = coef(summary(l1))[,1:2]) m2.S1 <- with(a, lmrob.S(cbind(1,x), y, trace.lev = 2, ## trace.lev = 2 : quite a bit of output control= lmrob.control(seed = .Random.seed, nRes = 80, k.max = 20, refine.tol = 1e-4))) S.ctrl <- lmrob.control(seed = .Random.seed,## << keeps .Random.seed unchanged nResample = 1000, best.r.s = 15, refine.tol = 1e-9) m2.S <- with(a, lmrob.S(cbind(1,x), y, control = S.ctrl, trace.lev = 1)) str(m2.S) ##--- Now use n > 2000 --> so we use C internal fast_s_large_n(...) n <- 2500 ; n0 <- n %/% 10 a2 <- gen(n=n, p = 3, n0= n0, y0=10, x0=10) plot(a2$x[,1], a2$y, col = c(rep(2, n0), rep(1, n-n0))) rs <- .Random.seed system.time( m3 <- lmrob(y~x, data = a2) ) m3 nrs <- .Random.seed # <-- to check that using 'seed' keeps .Random.seed system.time( m4 <- lmrob(y~x, data = a2, seed = rs, compute.rd = FALSE)) (sm4 <- summary(m4)) ## random seed must be the same because we used 'seed = *' : stopifnot(nrs == .Random.seed, identical(coef(m3), coef(m4))) dput(signif(cf <- unname(coef(m3)), 7)) ## 2012-06-04:c(-0.05108914, 1.005971, 1.003201, 0.9833263) - 32 AND 64 bit ## ## 0.2-0: c(0.007446546, 1.000712, 1.027921, 0.9896527) ## 0.2-1: c(0.03148659, 0.9980933, 1.016364, 1.03243) ## both for 32 and 64 bit dput(signif(100 * (sd <- unname(coef(sm4)[, "Std. Error"])), 7)) ## 2012-06-04:c(2.213815, 0.2864678, 2.202318, 2.180886) - 32 AND 64 bit ## ## 0.2-0: c(2.219388, 0.274644, 2.196982, 2.26253) ## 0.2-1: c(2.194914, 0.2737579, 2.371728, 2.206261) ## both for 32 and 64 bit stopifnot( all.equal(cf, c(-0.05108914, 1.00597115, 1.00320052, 0.98332632), tolerance= 7e-7) , # ... e-7 needed on 64b all.equal(100*sd,c(2.2138147, 0.2864678, 2.2023182, 2.1808862),tolerance= 7e-7) ) # 1.334 e-7 needed on 64b cat('Time elapsed: ', proc.time(),'\n') # "stats" ## rm(a,m1, m2, m3, m4, sm2, l1) ## Small examples from R-SIG-robust ## First example from René Locher : dat1 <- data.frame(lconc= log(c(21.8, 23.7, 12.2, 38.5, 21, 38.9)), dist = c( 100, 180, 280, 30, 220, 6)) m5 <- lmrob(lconc ~ dist, data = dat1) ## Warning messages: ## ... S refinements did not converge (to tol=1e-07) in 200 iterations ## " " " m5$init.S$converged # FALSE m5. <- lmrob(lconc ~ dist, data = dat1, control = lmrob.control(refine.tol = 1e-5)) m5.$init.S$converged # TRUE ## gives TRUE as the IRWLS iterations after the lmrob.S() have converged. ## 2nd example from René Locher , 6 Jun 2007 dat2 <- data.frame(lconc=log(c(29.5,40.1,21.1,25.3,27.3,25.2,26.9,19.1,16.4)), dist = c(520, 1480,1780, 740, 540,1050,1100,1640,1860)) res2 <- lmrob(lconc~dist, data = dat2) ## Used to give Warning messages: ## 1: rwls(): not converged in 1000 lambda iterations ## ... ## 4: rwls(): ............ res2 <- lmrob(lconc~dist, data = dat2, trace.lev = 3) ## ------------- summary(res2) stopifnot(dim(model.matrix(res2)) == c(9,2)) ## Check predict(): dd <- seq(300, 2000, by = 50) with(dat2, plot(dist, lconc, pch=20, cex=2, xlim = range(dd))) new.d <- data.frame(dist=dd) fit.dd <- predict(res2, new.d) lines(dd, fit.dd, col=2, type="o") predict(res2, new.d, se=TRUE)$se.fit matlines(dd, predict(res2, new.d, interval="confidence")[, 2:3], col=3) ## Check handling of X of not full rank test <- function(n, ...) { X <- matrix(c(rep(1:3, length.out = n), rnorm(2*n)), n, 4) y <- rnorm(n) X[,4] <- X[,2] + X[,3] X <- data.frame(X) X$X1 <- factor(X$X1) fail <- suppressWarnings(try(lmrob(y ~ ., X, ...), silent=TRUE)) stopifnot(is(fail, "lmrob")) } set.seed(0) test(12) ## fast_S() test(2500) ## fast_S_large_n() test(200, trace.lev = TRUE) ## Check a case, where cov() matrix needs "posdefify": coleman16 <- coleman[ -c(2, 7, 16, 19),] (m16 <- lmrob(Y ~ ., data = coleman16, tuning.psi = 3.44, trace.lev = TRUE)) ## failed in 0.9_0 assertWarning( lmrob(Y ~ ., data = coleman, setting = "KS2011", control = lmrob.control()) ) cat('Time elapsed: ', proc.time(),'\n') # "stats" robustbase/tests/plot-ex.R0000644000176200001440000000275710353034413015307 0ustar liggesuserslibrary(robustbase) n <- 1:50 (qnn <- sapply(n, function(n)Qn(1:n, const=1))) plot(n, qnn, type = 'b', col = 2, ylab = "Qn", main = "Qn(1:n) [unscaled]") (snn <- sapply(n, function(n)Sn(1:n, const=1))) plot(n, snn, type = 'b', col = 2, ylab = "Sn", main = "Sn(1:n) [unscaled]") matplot(n, cbind(qnn, snn),type = 'b', ylab = "Qn & Sn", main = "Qn(1:n) & Sn(1:n) [unscaled]") (sdn <- c(1, sapply(n[-1], function(n)sd(1:n)/n))) ## sd(1) => NA for(Sample in c(function(n) ppoints(n), function(n) qnorm(ppoints(n)))) { ##mult.fig(2) : op <- par(mfrow=c(2,1), mgp = c(1.5,.6,0), mar = .1 + c(4,4,2,1)) for(N in c(50, 200)) { n <- 1:N sdn <- c(1, sapply(n[-1], function(m)sd(Sample(m)))) r <- cbind(Qn = sapply(n, function(m)Qn(Sample(m))), Sn = sapply(n, function(m)Sn(Sample(m)))) / sdn matplot(n, r, type = 'b', col = 2:3, lty = 1, ylab = "Qn & Sn", main = "Qn(Sample(n)) & Sn(..) [consistently scaled]") legend(.85*N, 0.4, c("Qn()", "Sn()"), col = 2:3, lty = 1, pch = paste(1:2)) abline(h=1, col = "gray", lty = 2) } par(op) ## Hmm, the above does not look 100% consistent to *my* eyes... ## Investigate: matplot(n, r, ylim = c(0.9, 1.1), type = 'b', col = 2:3, lty = 1) abline(h=1, col = "gray", lty = 2) matplot(n, r^2, ylim = c(0.7, 1.3), type = 'b', col = 2:3, lty = 1) abline(h=1, col = "gray", lty = 2) } rownames(r) <- paste(n) r robustbase/tests/huber-etc.R0000644000176200001440000000230710377104055015572 0ustar liggesuserslibrary(robustbase) ### Test sets (all kinds odd/even, constant/regular/outlier) ## n = 0,1,2,3 : x0 <- numeric(0) x1 <- 3 x2 <- 1:2 x3 <- c(1:2,10) ## constant (0 mad) + 0--2 outliers xC <- rep(1, 12) xC. <- rep(1, 11) xC1 <- c(xC, 10) xC1. <- c(xC., 10) xC2 <- c(xC1, 100) xC2. <- c(xC1., 100) ## "uniform" + 0--2 outliers y <- 1:10 y. <- 1:11 y1 <- c(y, 100) y1. <- c(y., 100) y2 <- c(y1, 1000) y2. <- c(y1., 1000) nms <- ls(pat="^[xy]"); nms; names(nms) <- nms lx <- lapply(nms, function(n) { x <- get(n) m <- mad(x) hx <- if(!is.na(m) && m > 0) MASS::huber(x) else list(m=NA, s=NA) hMx <- huberM(x) list(loc = c(median = median(x), huber = hx$m, huberM = hMx$m), scale= c(mad = m, huber = hx$s, huberM = hMx$s)) }) r <- list(mu = sapply(lx, function(x) x$loc), s = sapply(lx, function(x) x$scale)) r cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' robustbase/tests/poisson-ex.R0000644000176200001440000002170613441022761016022 0ustar liggesusers library(robustbase) source(system.file("test-tools-1.R", package="Matrix", mustWork=TRUE)) ## -> assertError(), showSys.time(), ... source(system.file("xtraR/ex-funs.R", package = "robustbase")) ## -> newer assert.EQ() {TODO: no longer needed in 2015} #### Poisson examples from Eva Cantoni's paper ### Using Possum Data ### ================ data(possumDiv) ## Try to follow closely Cantoni & Ronchetti(2001), JASA dim(X <- possum.mat[, -1]) # 151 13 str(y <- possum.mat[, "Diversity"]) ##--- reduce the matrix from singularity ourselves: X. <- possum.mat[, -c(1, match(c("E.nitens", "NW-NE"), colnames(possum.mat)))] dim(X.)# 151 11 ## "classical via robust: c = Inf : Inf. <- 1e5 ## --- FIXME ## The following used to fail because glm.fit() returns NA coefficients ## now fine .. keep this as test! glm.cr <- glmrob(y ~ X, family = "poisson", tcc = Inf.) (scr <- summary(glm.cr)) scl <- summary(glm.cl <- glm (Diversity ~ . , data=possumDiv, family=poisson)) sc2 <- summary(glm.c2 <- glmrob(Diversity ~ . , data=possumDiv, family=poisson, tcc = Inf.)) assert.EQ(coef(scl), coef(sc2), tol = 6e-6, giveRE=TRUE) # 1.37e-6 ## c = 2.0 summary(g2 <- glmrob(Diversity ~ . , data=possumDiv, family=poisson, tcc = 2.0, trace=TRUE)) ## c = 1.6 glm.r <- glmrob(Diversity ~ . , data=possumDiv, family=poisson, tcc = 1.6, trace=TRUE) (s.16 <- summary(glm.r)) str(glm.r) ## Now with *smaller* X (two variablesless): glm.c2 <- glmrob(y ~ X., family = "poisson", tcc = Inf.) summary(glm.c2) ## c = 1.6, x-weights, as in Cantoni-Ronchetti glm.r2 <- glmrob(y ~ X., family = "poisson", tcc = 1.6, weights.on.x = "hat") ## Now the same, for the direct possum data (no matrix), ## This indeed gives the same coefficients as in ## Table 3 of Cantoni+Ronchetti(2001): .. (tech.rep.): glm.r2. <- glmrob(Diversity ~ ., family = "poisson", data=possumDiv, tcc = 1.6, weights.on.x = "hat", acc = 1e-15) ## here iterate till convergence (acc = 10^(-15)) (sglm.r2 <- summary(glm.r2.)) ## This is too accurate for S.E. (but we have converged to end) cf2 <- matrix(c(-0.898213938628341, 0.269306882951903, 0.00717220104127189, 0.0224349606070713, -0.25335520175528, 0.288588183720387, 0.0403970350911325, 0.0113429514237665, 0.0411096703375411, 0.0145996036305452, 0.0730250489306713, 0.0386771060643486, 0.0176994176433365, 0.0107414247342375, -0.0289935051669504,0.194215229266707, 0.149521144883774, 0.271648514202971, 0.0503262879663932, 0.191675979065398, 0.0909870068741749, 0.192192515800464, -0.512247626309172, 0.250763990619973), 12,2, byrow=TRUE) cfE <- unname(coef(sglm.r2)[, 1:2]) assert.EQ(cfE, cf2, tol = 1e-9, giveRE=TRUE)#-> show : ~ 1.46e-11 stopifnot(abs(glm.r2.$iter - 18) <= 1) # 18 iterations on 32-bit (2008) ## MT estimator -- "quick" examples if(!robustbase:::doExtras()) { cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' quit() } ## if ( doExtras ) ----------------------------------------------------- X1 <- cbind(1, X.) if(FALSE) ## for debugging ... options(warn = 1, error=recover) RNGversion("3.5.0") ## [TODO: adapt to "current" RNG settings] set.seed(57) showSys.time( ## m1 <- glmrobMT(x=X1, y=y) m1 <- glmrob(Diversity ~ ., data=possumDiv, family=poisson, method="MT") ) writeLines(tail(capture.output(warnings()))) stopifnot(m1$converged) assert.EQ(m1$initial, c(-0.851594294907422, -0.0107066895370536, -0.226958540075445, 0.0355906625338308, 0.048010654640958, 0.0847493155436896, 0.0133604488401352, -0.024115201062159, 0.0270535337324518, 0.146022135657894, -0.00751380783260833, -0.417638086169033) , tol = 1e-13, check.attributes=FALSE, giveRE=TRUE) ## MM: I'm shocked how much this changes after every tweak ... (arch <- Sys.info()[["machine"]]) .M <- .Machine; str(.M[grep("^sizeof", names(.M))]) ## differentiate long-double.. if(arch == "x86_64" && .M$sizeof.longdouble != 16) arch <- paste0(arch, "--no-long-double") dput(signif(unname(coef(m1)), 11)) ## --> ## Something strange going on: R CMD check is different from interactive R, here. ## ???? [I see that the byte compiler is not listed in sessionInfo] ## In any case, take the dput(.) output from the *.Rout[.fail] file ## 2015-07-21: on 32-bit, the results *change* when re-run ??? beta1 <- list(i686 = ## old florence: ## c(-0.83715700394, 0.0085488694315, -0.16734609346, 0.040965601691, ## 0.042387113444, 0.063146240793, 0.018632137866, -0.0062886781262, ## 0.11466679192, 0.091457894347, -0.025009954018, -0.66867971209) ## for a "moment": f32sfs-2; 2015-07-20 ## c(-0.83818366695, 0.0085885492587, -0.1680548609, 0.040969491636, ## 0.042401438906, 0.063170238296, 0.018647880253, -0.0058039548495, ## 0.11500468542, 0.091940159895, -0.024804291737, -0.66861710581) ## f32sfs-2; 2015-07-21; in "R CMD check"/BATCH, *not* interactive c(-0.83701057367, 0.0085408263511, -0.16692955779, 0.040980220489, 0.042389760873, 0.063145608346, 0.018632314682, -0.0062819674369, 0.11513144785, 0.091268054568, -0.025531439815, -0.66981350787) ## f32sfs-2; 2015-07-21, in R-devel, several times in a row: ## c(-0.83734949811, 0.008554484224, -0.16727333284, 0.040980350692, ## 0.042391751765, 0.06315585848, 0.018633222478, -0.0062978140762, ## 0.11509071086, 0.091463771235, -0.025113314023, -0.66955433495) , "x86_64" = c(-0.83723213945, 0.0085385261915, -0.16697112315, 0.040985126003, 0.042400738973, 0.063168847366, 0.01863253681, -0.0064477807228, 0.11488937188, 0.091283185006, -0.025627390293, -0.66995658693) , "x86_64--no-long-double" = c(-0.83710423989, 0.0085428949874, -0.16713845989, 0.040973904414, 0.042391910971, 0.063159426394, 0.018629240073, -0.006362108938, 0.1145563969, 0.091490891317, -0.025378427464, -0.66943593439) ) ## just FYI: difference 32-bit vs 64-bit: assert.EQ(beta1[[1]], beta1[[2]], tol = 0.004, check.attributes=FALSE, giveRE=TRUE) ## Mean relative difference: 0.00142 [~ 2013-12]; 0.00273 [f32sfs-2; 2015-08]; then (R-devel 2015-07-21): 0.000916 assert.EQ(beta1[[2]], beta1[[3]], tol = 0.002, check.attributes=FALSE, giveRE=TRUE) ## Mean relative difference: 0.00082849 [2014-11] ## when bypassing BLAS in matprod() vvvvv seen 0.001385 [Lx 64b]: assert.EQ(coef(m1), beta1[[arch]], tol = 0.002, # typically 1e-10 is ok !! check.attributes=FALSE, giveRE=TRUE) ## The same, with another seed: set.seed(64) showSys.time( ## m2 <- glmrobMT(x=X1, y=y) m2 <- glmrob(Diversity ~ ., data=possumDiv, family=poisson, method="MT") ) writeLines(tail(capture.output(warnings()))) stopifnot(m2$converged) if(FALSE) dput(signif(unname(m2$initial), 13)) ## --> assert.EQ(m2$initial, ## so this is *not* platform (32bit/64bit) dependent: c(-1.204304813829, 0.02776038445201, -0.3680174045842, 0.04325746912892, 0.03895315289169, 0.04537145479989, 0.02847987541025, 0.07073207523212, 0.355491639539, 0.1822955449528, 0.1323720331562, -0.3419939094877) , tol = 1e-12, check.attributes=FALSE, giveRE=TRUE) dput(signif(unname(coef(m2)), 11)) ## --> beta2 <- list(i686 = ## florence?, Nov. 2014 (or even Dec 2013) ## c(-0.83698669149, 0.0085587296184, -0.16778044558, 0.040960021262, ## 0.042402954975, 0.063188868629, 0.018630275088, -0.0061015509403, ## 0.11385896307, 0.090966386294, -0.02572887737, -0.66945784056) ## f32sfs-2, July 2015, "R CMD .." (non-interactive!): c(-0.83644647378, 0.0085365454367, -0.16770422458, 0.040958113098, 0.04238796628, 0.063174324485, 0.018618360015, -0.0062357940483, 0.11380146782, 0.090988141307, -0.025500338638, -0.66949122367) ## f32sfs-2, July 2015, interactive ## c(-0.83675287265, 0.0085383816807, -0.16763418359, 0.040968861778, ## 0.042399340988, 0.063148815999, 0.018624181637, -0.0061320761338, ## 0.11423331389, 0.0912474233, -0.025508101291, -0.66971416165) , "x86_64" = c(-0.83687097624, 0.0085341676033, -0.1674299545, 0.040968820903, 0.042397459287, 0.063159075944, 0.018625582804, -0.0063140636571, 0.11426134017, 0.091317308575, -0.025373078819, -0.66957444238) , "x86_64--no-long-double" = c(-0.8370370234, 0.008538975248, -0.1671607287, 0.040976013861, 0.042393702043, 0.06314300867, 0.018631172062, -0.0063382132536, 0.11445827857, 0.091409918881, -0.025308999173, -0.66935766843) ) ## just FYI: difference 32-bit vs 64-bit: assert.EQ(beta2[[1]], beta2[[2]], tol = 0.001, check.attributes=FALSE, giveRE=TRUE) ## Mean relative difference: 0.0009487 [2013-12 approx.] assert.EQ(beta2[[2]], beta2[[3]], tol = 0.001, check.attributes=FALSE, giveRE=TRUE) ## Mean relative difference: 0.0005119 [2014-11] ## when bypassing BLAS in matprod() vvvvv seen 0.0002766 [Lx 64b]: assert.EQ(coef(m2), beta2[[arch]], tol = 0.001, # typically 1e-10 is ok !! check.attributes=FALSE, giveRE=TRUE) ## slight changes of algorithm often change the above by ~ 4e-4 !!! ###---- Model Selection ----- ## (not yet) [ MM had this in ../../robGLM1/tests/quasi-possum.R ] cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' robustbase/tests/glmrob-1.R0000644000176200001440000001667012553432042015342 0ustar liggesuserslibrary(robustbase) source(system.file("xtraR/ex-funs.R", package = "robustbase")) source(system.file("test-tools-1.R", package = "Matrix", mustWork=TRUE))# assert.EQ ###>> 1 ------------------- family = poisson ------------------------------------ ### very simple model [with outliers] set.seed(113) y <- rpois(17, lambda = 4) ## -> target: beta_0 = log(E[Y]) = log(4) = 1.386294 y[1:2] <- 99:100 # outliers y rm1 <- glmrob(y ~ 1, family = poisson, trace = TRUE, acc = 1e-13) # default is just 1e-4 ## and check the robustness weights: assert.EQ(c(0.0287933850640724, 0.0284930623638766, 0.950239140568007, 0.874115394740014), local({w <- rm1$w.r; w[ w != 1 ] }), tol = 1e-14) assert.EQ(coef(rm1), c("(Intercept)" = 1.41710946076738),tol = 1e-14) cm1 <- glm (y ~ 1, family = poisson, trace = TRUE) rmMT <- glmrob(y ~ 1, family = poisson, trace = TRUE, method="MT") (sMT <- summary(rmMT)) if(FALSE) # for manual digging: debug(robustbase:::glmrobMqle) allresid <- function(obj, types = c("deviance", "pearson", "working", "response")) { sapply(types, residuals, object = obj) } okFit <- function(obj, check.attr=FALSE, ...) { all.equal(obj$y, obj$fitted.values + residuals(obj, "response"), check.attributes=check.attr, ...) } ## check validity of several methods simultaneously: y. <- model.response(model.frame(rm1)) stopifnot(okFit(cm1), okFit(rm1), y. == y) alr.c <- allresid(cm1) alr.r <- allresid(rm1) ## MM --- just for now -- plot(resid(cm1), resid(rm1), asp=1); abline(0,1, col=2) plot(resid(cm1,type="pearson"), resid(rm1, type="pearson"), asp=1); abline(0,1, col=2) plot(resid(cm1,type="working"), resid(rm1, type="working"), asp=1); abline(0,1, col=2) ## leave away the outliers -- cm0 <- glm (y ~ 1, family = poisson, trace = TRUE, subset = -(1:2)) plot(resid(cm0), resid(rm1)[-(1:2)], asp=1); abline(0,1, col=2) plot(resid(cm0,type="pearson"), resid(rm1, type="pearson")[-(1:2)], asp=1); abline(0,1, col=2) plot(resid(cm0,type="working"), resid(rm1, type="working")[-(1:2)], asp=1); abline(0,1, col=2) plot(resid(cm0,type="response"), resid(rm1, type="response")[-(1:2)], asp=1); abline(0,1, col=2) ## Use weights (slow convergence !) w2 <- c(rep(1,8), rep(10,9)) rm2 <- glmrob(y ~ 1, family = poisson, trace = TRUE, weights = w2, maxit = 500, acc = 1e-10) # default is just 1e-4 ## slow convergence stopifnot(okFit(rm2)) ###>> 2 ------------------- family = binomial ----------------------------------- ## Using *factor* y ... x <- seq(0,5, length = 120) summary(px <- plogis(-5 + 2*x)) set.seed(7) (f <- factor(rbinom(length(x), 1, prob=px))) summary(m.c0 <- glm (f ~ x, family = binomial)) summary(m.r0 <- glmrob(f ~ x, family = binomial)) ## add outliers --- in y: f. <- f f.[i1 <- 2:3] <- 1 f.[i0 <- 110+c(1,7)] <- 0 m.c1 <- glm (f. ~ x, family = binomial) summary(m.r1 <- glmrob(f. ~ x, family = binomial)) ## hmm, not so robust? stopifnot(m.r1$w.r[c(i0,i1)] < 1/3, # well, at least down weighted ## and coefficients change less : (coef(m.r1) - coef(m.c0)) / (coef(m.c1) - coef(m.c0)) < 1) assert.EQ(c("(Intercept)" = -3.10817337603974, x = 1.31618564057790), coef(m.r1), tol= 1e-14, giveRE=TRUE) y <- as.numeric(as.character(f.)) m.r2 <- BYlogreg(x0=x, y=y, trace=TRUE, maxhalf= 10) m.r2A <- BYlogreg(x0=x, y=y, trace= 2 , maxhalf= 15) ## different.. but not so much: iB <- 1:5 assert.EQ(m.r2A[iB], m.r2[iB], tol = .003, giveRE=TRUE) assert.EQ(c("Intercept" = -2.9554950286, x = 1.2574679132), ## 32-bit{ada-5} -2.95549502890363 1.25746791332613 m.r2$coef, tol=8e-10, giveRE=TRUE)# seen 5.316e-10 for --disable-long-double assert.EQ( c(0.685919891749065, 0.256419206157062), ## 32-bit{ada-5}: ## 0.685919891858219, 0.256419206203016) m.r2$sterror, tol=4e-9)# seen 1.025e-9 for --disable-long-double data(foodstamp) str(foodstamp) ## Model with 'income' instead of log(income+1) is "interesting" ## because BYlogreg() needs maxhalf > 10 for convergence! m.fs0 <- glm (participation ~ ., family=binomial, data=foodstamp) m.fs0QL <- glmrob(participation ~ ., family=binomial, data=foodstamp) y.fs <- foodstamp[,"participation"] X.fs0 <- model.matrix(m.fs0) head(X.fs0) ## (former default) maxhalf = 10 leads to too early convergence: m.fsWBY. <- BYlogreg(x0=X.fs0, y=y.fs, addIntercept=FALSE, trace=TRUE, maxhalf=10) m.fs.BY. <- BYlogreg(x0=X.fs0, y=y.fs, initwml=FALSE, addIntercept=FALSE, trace=TRUE, maxhalf=10) m.fsWBY <- BYlogreg(x0=X.fs0, y=y.fs, addIntercept=FALSE, trace=TRUE, maxhalf=18) m.fs.BY <- BYlogreg(x0=X.fs0, y=y.fs, initwml=FALSE, addIntercept=FALSE, trace=TRUE, maxhalf=18) assert.EQ(m.fsWBY.[iB], m.fsWBY[iB], tol= 0.07)## almost 7% different assert.EQ(m.fs.BY.[iB], m.fs.BY[iB], tol= 0.08) foodSt <- within(foodstamp, { logInc <- log(1 + income) ; rm(income) }) m.fsML <- glm (participation ~ ., family=binomial, data=foodSt) m.fsQL <- glmrob(participation ~ ., family=binomial, data=foodSt) X.fs <- model.matrix(m.fsML) stopifnot(dim(X.fs) == c(150, 4)) # including intercept! try(## FIXME -- Mahalanobis fails with singular matrix, here: m.fsWBY <- BYlogreg(x0=X.fs, y=y.fs, addIntercept=FALSE, trace=TRUE, maxhalf=18) ) ## maxhalf=18 is too much --> no convergence (in 1000 steps) m.fs.BY <- BYlogreg(x0=X.fs, y=y.fs, initwml=FALSE, addIntercept=FALSE, trace=TRUE, maxhalf=18) signif( rbind(ML = coef(m.fsML), QL =coef(m.fsQL), WBY0=coef(m.fsWBY.), BY0=coef(m.fs.BY.), WBY =coef(m.fsWBY ), BY =coef(m.fs.BY) ) , 4) if(FALSE) { ## *scaling* of X ( ?? <==> ?? 'sigma1' ) ------------------ ## no "W" (Mahalanobis fail because of *singular* X): m.fs.BY100 <- BYlogreg(x0=100*X.fs, initwml=FALSE, y=y.fs, addIntercept=FALSE, trace=TRUE, maxhalf=18) ## ==> no convergence X1c <- cbind(1, 100*X.fs[,-1]) m.fsWBY1c <- BYlogreg(x0=X1c, y=y.fs, addIntercept=FALSE, trace=TRUE, maxhalf=18) ## ==> illegal singularity$kind }## not yet ###-------- Gamma ------------ ## Realistic "data" {from help(glmrob)}: mu <- c(122.131, 53.0979, 39.9039, 33.9232, 28.007, 24.923, 21.5747, 19.6971, 18.4516) ns.resid <- c(-0.0338228, 0.0923228, 0.0525284, 0.0317426, -0.035954, 0.00308925, -0.026637, -0.0353932, -0.0244761) Vmu <- c(14915.9, 2819.38, 1592.32, 1150.78, 784.39, 621.156, 465.467, 387.978, 340.462) Hp2 <- robustbase:::Huberprop2 ## Hp2. <- robustbase:::Huberprop2. ## was: phis <- 2^(-70:-1) -- but that was *not* reliable (on 32-bit e.g.) phis <- 2^(-42:-1) H1 <- sapply(phis, function(phi) Hp2(phi, ns.resid=ns.resid, mu=mu, Vmu=Vmu, tcc = 1.345)) ## H2 <- sapply(phis, function(phi) ## Hp2.(phi, ns.resid=ns.resid, mu=mu, Vmu=Vmu, tcc = 1.345)) dput(signif(H1)) H2 <- c(9.91741, 9.88674, 9.89438, 9.88674, 9.88961, 9.88961, 9.88961, 9.88984, 9.88973, 9.88964, 9.8897, 9.88975, 9.88976, 9.88975, 9.88974, 9.88974, 9.88974, 9.88974, 9.88974, 9.88974, 9.88974, 9.88974, 9.88975, 9.88975, 9.88975, 9.33161, 8.70618, 8.39347, 8.23714, 8.15902, 8.12006, 7.16275, 3.38703, -0.0879886, -2.3322, -4.16929, -5.26821, -5.80526, -6.04822, -6.11538, -6.02613, -5.66718) all.equal(H1,H2, tolerance = 0) # -> see 8.869e-7 stopifnot(all.equal(H1,H2, tolerance = 1e-5)) if(dev.interactive(TRUE)) # shows that phi < 1e-12 is doubtful matplot(phis, cbind(H1,H2), log="x", ylim = rrange(H1), type="o") robustbase/tests/m-s-estimator.R0000644000176200001440000001400113244325717016415 0ustar liggesusers## Test implementation of M-S estimator require(robustbase) source(system.file("xtraR/m-s_fns.R", package = "robustbase", mustWork=TRUE)) source(system.file("xtraR/ex-funs.R", package = "robustbase", mustWork=TRUE)) source(system.file("test-tools-1.R", package = "Matrix", mustWork=TRUE))# assert.EQ ## dataset with factors and continuous variables: data(education) education <- within(education, Region <- factor(Region)) ## for testing purposes: education2 <- within(education, Group <- factor(rep(1:3, length.out=length(Region)))) ## Test splitFrame (type fii is the only problematic type) testFun <- function(formula, x1.idx) { obj <- lm(formula, education2) mf <- obj$model ret <- splitFrame(mf, type="fii") if (missing(x1.idx)) { print(ret$x1.idx) return(which(unname(ret$x1.idx))) } stopifnot(identical(x1.idx, which(unname(ret$x1.idx)))) } testFun(Y ~ 1, integer(0)) testFun(Y ~ X1*X2*X3, integer(0)) testFun(Y ~ Region + X1 + X2 + X3, 1:4) testFun(Y ~ 0 + Region + X1 + X2 + X3, 1:4) testFun(Y ~ Region*X1 + X2 + X3, c(1:5, 8:10)) testFun(Y ~ Region*X1 + X2 + X3 + Region*Group, c(1:5, 8:18)) testFun(Y ~ Region*X1 + X2 + X3 + Region*Group*X2, c(1:6, 8:29)) testFun(Y ~ Region*X1 + X2 + Region*Group*X2, 1:28) testFun(Y ~ Region*X1 + X2 + Region:Group:X2, 1:21) testFun(Y ~ Region*X1 + X2*X3 + Region:Group:X2, c(1:6, 8:10, 12:23)) testFun(Y ~ (X1+X2+X3+Region)^2, c(1:7,10:12,14:19)) testFun(Y ~ (X1+X2+X3+Region)^3, c(1:19, 21:29)) testFun(Y ~ (X1+X2+X3+Region)^4, 1:32) testFun(Y ~ Region:X1:X2 + X1*X2, c(1:1, 4:7)) control <- lmrob.control() f.lm <- lm(Y ~ Region + X1 + X2 + X3, education) splt <- splitFrame(f.lm$model) y <- education$Y ## test orthogonalizing x1 <- splt$x1 x2 <- splt$x2 tmp <- lmrob.lar(x1, y, control) y.tilde <- tmp$resid t1 <- tmp$coef x2.tilde <- x2 T2 <- matrix(0, nrow=ncol(x1), ncol=ncol(x2)) for (i in 1:ncol(x2)) { tmp <- lmrob.lar(x1, x2[,i], control) x2.tilde[,i] <- tmp$resid T2[,i] <- tmp$coef } set.seed(10) mss1 <- m_s_subsample(x1, x2.tilde, y.tilde, control, orth = FALSE) mss1 <- within(mss1, b1 <- drop(t1 + b1 - T2 %*% b2)) set.seed(10) mss2 <- m_s_subsample(x1, x2, y, control, orth = TRUE) stopifnot(all.equal(mss1, mss2)) res <- vector("list", 100) set.seed(0) time <- system.time(for (i in seq_along(res)) { tmp <- m_s_subsample(x1, x2.tilde, y.tilde, control, FALSE) res[[i]] <- unlist(within(tmp, b1 <- drop(t1 + b1 - T2 %*% b2))) }) cat('Time elapsed in subsampling: ', time,'\n') ## show a summary of the results {"FIXME": output is platform dependent} summary(res1 <- do.call(rbind, res)) ## compare with fast S solution fmS <- lmrob(Y ~ Region + X1 + X2 + X3, education, init="S") coef(fmS) fmS$scale ### Comparing m-s_descent implementations() {our C and R} : ------------------- ctrl <- control #ctrl$trace.lev <- 5 ctrl$k.max <- 1 mC <- m_s_descent (x1, x2, y, ctrl, mss2$b1, mss2$b2, mss2$scale+10) mR <- m_s_descent_Ronly(x1, x2, y, ctrl, mss2$b1, mss2$b2, mss2$scale+10) nm <- c("b1","b2", "scale", "res") stopifnot(all.equal(mC[nm], mR[nm], check.attributes = FALSE, tolerance = 4e-14)) # seen 5.567e-15 in OpenBLAS ^^^^^ ## control$k.m_s <- 100 res3 <- vector("list", 100) time <- system.time(for (i in seq_along(res3)) { ri <- res[[i]] res3[[i]] <- unlist(m_s_descent(x1, x2, y, control, ri[1:4], ri[5:7], ri[8])) }) cat('Time elapsed in descent proc: ', time,'\n') ## show a summary of the results {"FIXME": output is platform dependent} res4 <- do.call(rbind, res3) summary(res4[,1:8]) stopifnot(all.equal( # 'test', not only plot: res1[, "scale"], res4[,"scale"], tol = 0.03), res1[, "scale"] >= res4[,"scale"] - 1e-7 ) # 1e-7 just in case plot(res1[, "scale"], res4[,"scale"]) abline(0,1, col=adjustcolor("gray", 0.5)) ## Test lmrob.M.S x <- model.matrix(fmS) control$trace.lev <- 3 ## --------- -- set.seed(1003) fMS <- lmrob.M.S(x, y, control, fmS$model) resid <- drop(y - x %*% fMS$coef) assert.EQ(resid, fMS$resid, check.attributes=FALSE, tol = 1e-12) ## Test direct call to lmrob ## 1. trace_lev output: set.seed(17) fMS <- lmrob(Y ~ Region + X1 + X2 + X3, education, init = "M-S", trace.lev=2) set.seed(13) fiMS <- lmrob(Y ~ Region + X1 + X2 + X3, education, init = "M-S") out2 <- capture.output(summary(fiMS)) writeLines(out2) set.seed(13) fiM.S <- lmrob(Y ~ Region + X1 + X2 + X3, education, init=lmrob.M.S) out3 <- capture.output(summary(fiM.S)) ## must be the same {apart from the "init=" in the call}: i <- 3 stopifnot(identical(out2[-i], out3[-i])) ## the difference: c(rbind(out2[i], out3[i])) ### "Skipping design matrix equilibration" warning can arise for reasonable designs ----- set.seed(1) x2 <- matrix(rnorm(2*30), 30, 2) data <- data.frame(y = rnorm(30), group = rep(letters[1:3], each=10), x2) obj <- lmrob(y ~ ., data, init="M-S", trace.lev=1) ## illustration: the zero row is introduced during the orthogonalization of x2 wrt x1 ## l1 regression always produces p zero residuals ## by chance, the zero residuals of multiple columns happen to be on the same row sf <- splitFrame(obj$model) x1 <- sf$x1 x2 <- sf$x2 control <- obj$control ## orthogonalize x2.tilde <- x2 for(i in 1:ncol(x2)) { tmp <- lmrob.lar(x1, x2[,i], control) x2.tilde[,i] <- tmp$resid } x2.tilde == 0 ## Specifying init="M-S" for a model without categorical variables ## used to cause a segfault; now uses "S" lmrob(LNOx ~ LNOxEm, NOxEmissions[1:10,], init="M-S") ## Now an ANOVA model with *only* categorical variables n <- 64 # multiple of 16 stopifnot(n %% 16 == 0) d.AOV <- data.frame(y = round(100*rnorm(64)), A=gl(4,n/4), B=gl(2,8, n), C=gl(2,4,n)) fm <- lmrob(y ~ A*B*C, data = d.AOV, init = "M-S", trace.lev=2) ## lmrob_M_S(n = 64, nRes = 500, (p1,p2)=(16,0), (orth,subs,desc)=(1,1,1)) ## Starting subsampling procedure.. Error in lmrob.M.S(x, y, control, mf) : ## 'Calloc' could not allocate memory (18446744073709551616 of 4 bytes) ## BTW: Can we compute an M-estimate (instead of MM-*) as we ## --- cannot have any x-outliers in such an ANOVA! robustbase/tests/nlrob-tst.R0000644000176200001440000002601013266661732015647 0ustar liggesuserslibrary(robustbase) source(system.file("test-tools-1.R", package = "Matrix", mustWork=TRUE)) ## -> assert.EQ(), identical3(), .. DNase1 <- DNase[ DNase$Run == 1, ] Y <- DNase1[,"density"] # for convenience below ## classical fm1 <- nls(density ~ Asym/(1 + exp(( xmid - log(conc) )/scal ) ), data = DNase1, start = list(Asym = 3, xmid = 0, scal = 1), trace=TRUE) summary(fm1) wm1 <- update(fm1, weights = sqrt(conc)) # (weights as function of ) ## robust rm1 <- nlrob(formula(fm1), data = DNase1, trace = TRUE, start = list(Asym = 3, xmid = 0, scal = 1)) (sm1 <- summary(rm1)) stopifnot(all.equal(Y, fitted(fm1) + residuals(fm1), check.attributes=FALSE), ## fitted() has "label" attribute identical3(c(fitted(fm1)), predict(fm1), predict(fm1, newdata=DNase1)), ## robust fit : identical3(fitted(rm1), predict(rm1), predict(rm1, newdata=DNase1)), all.equal(Y, unname(fitted(rm1) + residuals(rm1)))) print(coef(rm1), digits=12) ## 2.35963008460 1.49945088410 1.04506391722 F19 Lx 64b ## 2.35963008460 1.49945088410 1.04506391722 Win(Serv.2003) 64b ## 2.35963008613 1.49945088600 1.04506391793 F19 Lx 32b ## 2.35963008613 1.49945088600 1.04506391793 Win(Serv.2003) 32b assert.EQ(coef(rm1), giveRE=TRUE, c(Asym=2.35963008, xmid=1.49945088, scal=1.04506392), tol = 4e-8) assert.EQ(sqrt(diag(sm1$cov)), giveRE=TRUE, ## 32b 0.08626872273, 0.0902194541, 0.03503833759 c(Asym=0.0862687305, xmid=0.0902194608, scal=0.0350383389), tol = 7e-7) ## examples with weights: rm. <- update(rm1, weights = NULL)# 'NULL' but not missing() ww <- sqrt(DNase1[,"conc"]) wr1 <- update(rm1, weights = sqrt(conc), trace=FALSE) wr1. <- update(rm1, weights = ww, trace=FALSE) ii <- names(rm1) != "call" stopifnot(all.equal(rm1[ii], rm.[ii], tol = 1e-15), all.equal(wr1[ii],wr1.[ii], tol = 1e-15)) ## From: "Pascal A. Niklaus" ## To: ## Subject: nlrob problem ## Date: Tue, 20 Dec 2011 07:04:38 +0100 ## For psi-functions that can become zero (e.g. psi.bisquare), weights in ## the internal call to nls can become zero. ## Was ## psiTuk <- robustbase:::psi.bisquare ## psiHamp <- robustbase:::psi.hampel lmrob.control(psi="bisquare")$tuning.psi psiTuk <- function(x, der=0) { ## cc: dput( lmrob.control(psi="bisquare")$tuning.psi ) if(der == 0) Mwgt(x, cc=4.685061, psi="Tukey") else Mpsi(x, cc=4.685061, psi="Tukey", deriv=1) } c.Ha <- lmrob.control(psi="hampel"); c.Ha$tuning.psi psiHamp <- function(x, der=0) { ## cc: dput( lmrob.control(psi="hampel")$tuning.psi ) if(der == 0) Mwgt(x, cc=c(1.35241275, 3.15562975, 7.212868), psi="Hampel") else Mpsi(x, cc=c(1.35241275, 3.15562975, 7.212868), psi="Hampel", deriv=1) } d <- data.frame(x = -6:9, y = 43 + c(7, 52, 21, 12, 10, -4, -5, -4, 0, -77, -8, -10, 22, 33, 38, 51)) nlr1 <- nlrob(y ~ a*(x + b*exp(-c*x)), start=list(a= 4, b= 1, c= 1.2), data = d, maxit = 50, # default 20 is *not* sufficient model = TRUE, trace=TRUE) ## These failed in robustbase version 0.8-0 and earlier nlr2 <- update(nlr1, psi = psiTuk) # now *does* converge... ## check 'model' and dataClasses stopifnot(is.list(mod <- nlr2$model), is.data.frame(mod), inherits(attr(mod, "terms"), "terms"), identical(dCl <- attr(attr(mod, "terms"),"dataClasses"), nlr2$dataClasses), identical(dCl, c(y = "numeric", x = "numeric"))) ## 'port' ditto: nlr2. <- update(nlr2, algorithm= "port") nlr3 <- update(nlr1, psi = psiHamp) # *does* converge, too... nlr3. <- update(nlr3, algorithm= "port") summary(nlr2.) summary(nlr3.) i. <- -c(2, 15) # <- drop 'call' and 'iter' components stopifnot(all.equal(nlr2[i.], nlr2.[i.], tolerance = 2e-5), all.equal(nlr3[i.], nlr3.[i.], tolerance = 1e-4), ## The redescending psi() give some exact 0 weights : identical(which(abs(nlr2$rweights) < 1e-9), c(1L, 10 :12)), identical(which(abs(nlr3$rweights) < 1e-9), c(1L, 10L,12L)) ) ## Different example with more data: pp <- list(a=10, b=4, c=1/4) x <- seq(-6,9, by = 1/8) f.x <- with(pp, a*(x + b*exp(-c*x))) set.seed(6); y <- y0 <- f.x + 4*rnorm(x) iO <- c(2:3,20,70:71,90); y[iO] <- y[iO] + 32*c(-1,-1,1)*(2+rlnorm(iO)); y <- round(y) plot(x,y); lines(x, f.x, col="tomato", lty = 2) dd <- data.frame(x,y) nlc1 <- nls(formula(nlr1), start = coef(nlr1), data=dd, trace=TRUE) nlR1 <- update(nlr1, data = dd)# update the model with the new data summary(nlR1) lines(x, predict(nlc1), col=3) lines(x, predict(nlR1), col=4) legend("top", c("f(x)", "least squares", "robust"), col=c("tomato", palette()[3:4]), lty=c(2,1,1)) ## These both now *do* converge, but failed earlier (nlbi <- update(nlR1, psi = psiTuk)) (nlFH <- update(nlR1, psi = psiHamp)) lines(x, predict(nlbi), col=5) lines(x, predict(nlFH), col=6) stopifnot(nlR1$status == "converged", nlbi$status == "converged", nlFH$status == "converged") assert.EQ(coef(nlR1), c(a=9.914874, b=3.98612416, c=0.250896252), tol = 4e-9) assert.EQ(coef(nlbi), c(a=9.947458207, b=3.954210623, c=0.2535835248), tol = 4e-9) ## This is suddently quite different : ???!?!?? ## assert.EQ(coef(nlFH), c(a=9.94242831, b=3.97370746, c=0.252907618)) assert.EQ(coef(nlFH), c(a=9.952893755,b=3.949047387,c=0.2536216541), tol = 1e-7) assert.EQ(1000*diag(vcov(nlR1)), c(a=16.167493, b=10.0986644, c=0.0200814189), tol = 7e-7, giveRE=TRUE) assert.EQ(1000*local({V <- vcov(nlFH); V[lower.tri(V, diag=TRUE)]}), c(16.33774615, -9.704702857, 0.3149189329, 10.03560556, -0.4079936961, 0.02039106329), tol = 7e-7) assert.EQ(predict(nlR1), predict(nlbi), tol = 0.05, giveRE=TRUE) assert.EQ(predict(nlR1), predict(nlFH), tol = 0.05, giveRE=TRUE) nlFH2 <- update(nlFH, psi = .Mwgt.psi1("Hampel", c(2,4,8))) ## TODO: and compare ## TODO: same with Tukey ##----- *Vector* parameters indexed by factor levels ------------- ##----- MM: ~/R/MM/Pkg-ex/robustbase/nlrob-vectorpar.R data(biomassTill)## see also smaller example in ../man/biomassTill.Rd if(!dev.interactive(orNone=TRUE)) pdf("nlrob-biomT.pdf") require(lattice) xyplot(Biomass ~ DVS | Tillage, data = biomassTill) xyplot(Biom.2 ~ DVS | Tillage, data = biomassTill) ## starting values m0.st <- list(Wm = rep(200, 3), a = rep( 1, 3), b = rep( 2, 3)) ##-> nls(), even with -expm1(.) fails to start properly (and hence nlrob() fails too): try( m.c0 <- nls(Biomass ~ Wm[Tillage] * (- expm1(-(DVS/a[Tillage])^b[Tillage])), data = biomassTill, start = m0.st, trace=TRUE) ) ## several other versions of the above fail similarly. This works: m00st <- list(Wm = rep(300, 3), a = rep( 1.5, 3), b = rep( 2.2, 3)) m.c00 <- nls(Biomass ~ Wm[Tillage] * (- expm1(-(DVS/a[Tillage])^b[Tillage])), data = biomassTill, start = m00st, trace=TRUE) ## These were the "true" beta for simulating in creation of {Biomass, Biom.2}: m1.st <- list(Wm = c(219.8, 265.9, 343.4), a = c(1.461, 1.493, 1.294), b = c(2.889, 2.838, 4.046)) m.cl <- nls(Biomass ~ Wm[Tillage] * (1 - exp(-(DVS/a[Tillage])^b[Tillage])), data = biomassTill, start = m00st, trace=TRUE) ## this now fails to converge: try( m.c2 <- nls(Biom.2 ~ Wm[Tillage] * (1 - exp(-(DVS/a[Tillage])^b[Tillage])), data = biomassTill, start = m00st, trace=TRUE) ) str(C1 <- nls.control(minFactor=1e-6, warnOnly=TRUE, printEval=TRUE, maxiter=500)) try( m.c2 <- nls(Biom.2 ~ Wm[Tillage] * (1 - exp(-(DVS/a[Tillage])^b[Tillage])), data = biomassTill, start = m00st, trace=TRUE, control=C1) ) ## fails (!) too {numericDeriv() in iteration 129} even though we have ## 'warnOnly' ! ==> bug in nls() !!!!!!!!!!!!!!!!!!!!!!!!!!! ## -expm1(u) is better than (1 - exp(u)) : m.c00 <- nls(Biom.2 ~ Wm[Tillage] * (- expm1(-(DVS/a[Tillage])^b[Tillage])), data = biomassTill, start = m00st, trace=TRUE, control=C1) ## "fails" but returns .. very bad.. m.c00 ## Use better starting values, as we have such problems: m.c2 <- nls(Biom.2 ~ Wm[Tillage] * (- expm1(-(DVS/a[Tillage])^b[Tillage])), data = biomassTill, start = m1.st, trace=TRUE, control=C1) ## "fails" but returns at least: singular gradient iteration 126 m.c2 ## Robust: not converging in 20 steps (only warning) mrob <- nlrob(Biomass ~ Wm[Tillage] * (-expm1(-(DVS/a[Tillage])^b[Tillage])), data = biomassTill, start = m00st, trace=TRUE) stopifnot(identical(mrob$dataClasses, c(Biomass = "numeric", Tillage = "factor", DVS = "numeric"))) try(## now: singular gradient in nls mr.2 <- nlrob(Biom.2 ~ Wm[Tillage] * (-expm1(-(DVS/a[Tillage])^b[Tillage])), data = biomassTill, start = m00st, trace=TRUE) ) ## Compare coeffs: rbind(c.true = unlist(m1.st), cl0 = coef(m.c00), cl = coef(m.cl), rob = coef(mrob), c2 = coef(m.c2))#, r.2 = coef(mr.2)) ## Compare fit ## Now for plotting --- nice would be xyplot, but I don't easily see how: (yl2 <- range(biomassTill[,"Biom.2"])) (ylim <- range(biomassTill[,"Biomass"]))# --> *not* showing the two outliers! ## or even a bit more robustly: ## sfsmisc::rrange(biomassTill[,"Biom.2"]) ##-> -201.3064 394.0914 ## using global data + fits from above p.biomass.fits <- function(ylim = c(-200, 400), n = 257, f.DVS = 0.1, leg.txt = c(outer(c("nls() ", "nlrob()"), c("", "[ + 2 outl.]"), paste)), col = c("blue2","blue3","tomato","red3"), lty = c(2,1,2,1), lwd = 2) { ## more and equispaced DVS values for nice plot: rr <- extendrange(biomassTill[,"DVS"], f=f.DVS) bbDVS <- seq(rr[1], rr[2], length = n) b.Till <- biomassTill[,"Tillage"] nP <- nlevels(b.Till) # == 3 m <- length(leg.txt) col <- rep_len(col, m) lwd <- rep_len(lwd, m) lty <- rep_len(lty, m) ## Prefer xyplot() - this is ugly but works (and tests predict(*, )): op <- par(mfrow = c(nP,1), mar = .1 + c(3, 3, 2, 1), mgp = c(1.25, 0.6, 0)) on.exit(par(op)) for(lev in levels(b.Till)) { cat(lev,":\n--------\n") dsub <- subset(biomassTill, Tillage == lev) plot(Biom.2 ~ DVS, data = dsub, ylim=ylim, main = paste("Tillage = ", lev)) grid() dd <- data.frame(Tillage = factor(rep.int(lev, n), levels=levels(b.Till)), DVS = bbDVS) lines(predict(m.cl, dd) ~ DVS, data=dd, col=col[1], lty=lty[1], lwd=lwd[1]) lines(predict(mrob, dd) ~ DVS, data=dd, col=col[2], lty=lty[2], lwd=lwd[2]) lines(predict(m.c2, dd) ~ DVS, data=dd, col=col[3], lty=lty[3], lwd=lwd[3]) ## lines(predict(mr.2, dd) ~ DVS, data=dd, col=col[4], lty=lty[4], lwd=lwd[4]) if(lev == "CA-") legend("top", leg.txt, col = col, lty=lty, lwd=lwd, inset=.02, bg = "gray96") #, bty="n") } } ## showing all data points: p.biomass.fits(ylim = yl2) ## more interesting: p.biomass.fits() cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' robustbase/tests/LTS-specials.R0000644000176200001440000000337612271657124016173 0ustar liggesusers#### Test special cases for ltsReg() library(robustbase) ## Platform - and other such info -- so we find it in old saved outputs .libPaths() SysI <- Sys.info() structure(Sys.info()[c(4,5,1:3)], class="simple.list") sessionInfo() c(robustbase = packageDescription("robustbase")$Built, DEoptimR = packageDescription("DEoptimR")$Built) if(SysI[["sysname"]] == "Linux" && require("sfsmisc")) local({ nn <- names(.Sc <- sfsmisc::Sys.cpuinfo()) nn <- names(.Sc <- .Sc[nn != "flags"]) print(.Sc[grep("\\.[0-9]$", nn, invert=TRUE)]) }) ### 1) p = 1 ---------------------------------------------------- set.seed(1) x <- c(rnorm(50),100, 1e10) (r1 <- ltsReg(x ~ 1)) # failed in Valentin's 1.0-3 (pre-version) summary(r1) (r1. <- ltsReg(y = x)) i1 <- 15:17; ii <- (1:20)[-i1] UN <- function(lis) lapply(lis, unname) dimnames(r1.$X)[1] <- dimnames(r1$X)[1] stopifnot(all.equal( r1[ii], r1.[ii], tolerance= 1e-15), all.equal(UN(r1[i1]), UN(r1.[i1]), tolerance= 1e-15)) ## intercept=FALSE, p > 1 -- coefficients were switched once n <- 100; theta <- c(x=10, x2=40) set.seed(7) X <- cbind(x = rt(n, 4), x2 = rnorm(n)) dat <- data.frame(X, y = X %*% theta + rt(n, df=3)/10) summary(M <- ltsReg(y ~ . -1, data = dat)) stopifnot(all.equal(coef(M), theta, tolerance = 1e-3)) ## with alpha = 1 (r1.1 <- ltsReg(x ~ 1, alpha = 1)) summary(r1.1) ### 1b) p = 1, constant scale (rc <- ltsReg(y = rep(1,12))) str(rc) summary(rc) ## with alpha = 1 (rc1 <- ltsReg(y = rep(1,12), alpha = 1)) summary(rc1) stopifnot(residuals(rc) == 0, all.equal(unname(coef(rc )), 1), residuals(rc1) == 0, all.equal(unname(coef(rc1)), 1)) ### 2) alpha = 1 : classical estimates --- for general cases -------- cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' robustbase/tests/MCD-specials.R0000644000176200001440000000141410377104102016107 0ustar liggesusers#### Test special cases for covMcd() library(robustbase) ### 1) p = 1 ---------------------------------------------------- set.seed(1) x <- c(rnorm(50),100, 1e10) (r1 <- covMcd(x)) str(r1) summary(r1) ## with alpha = 1 (r1.1 <- covMcd(x, alpha = 1)) str(r1.1) summary(r1.1) ### 1b) p = 1, constant scale (rc <- covMcd(rep(1,12))) str(rc) summary(rc) ## with alpha = 1 (rc1 <- covMcd(rep(1,12), alpha = 1)) str(rc1) summary(rc1) ### 2) constant observations { multivariate scale == 0 } ----------- (X <- matrix(rep(2*(1:4), 12), nrow = 12, byrow = TRUE)) (rC <- covMcd(X)) summary(rC) (rC1 <- covMcd(X, alpha = 1)) summary(rC1) ### 3) alpha = 1 : classical estimates --- for general cases -------- cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' robustbase/tests/weights.R0000644000176200001440000002171713266635627015412 0ustar liggesusers## test handing of weights and offset argument require(robustbase) ## generate simple example data (extension of the one in ./NAcoef.R ) data <- expand.grid(x1=letters[1:3], x2=LETTERS[1:4], rep=1:3) ## generate offset column data$os <- 1:nrow(data) set.seed(1) data$y <- data$os + rnorm(nrow(data)) ## add collinear variables data$x3 <- rnorm(nrow(data)) data$x4 <- rnorm(nrow(data)) data$x5 <- data$x3 + data$x4 ## lm() will have 'x5' "aliased" (and give coef = NA) ## add some NA terms data$y[1] <- NA data$x4[2:3] <- NA ## to test anova ## generate weights ## some obs with weight 0 data$weights <- as.numeric(with(data, x1 != 'c' | (x2 != 'B' & x2 != 'C'))) ## some obs with weight 2 data$weights[data$x1 == 'b'] <- 2 ## data2 := {data + weights}, encoded in "data2" (-> "ok" for coef(), not for SE) data2 <- rbind(subset(data, weights > 0), subset(data, weights == 2)) ## using these parameters we're essentially forcing lmrob() to ## fit a classic model --> easier to compare to lm() ctrl <- lmrob.control(psi="optimal", tuning.chi = 20, bb = 0.0003846154, tuning.psi=20, method="SM", cov=".vcov.w") ## SM = MM == the case where .vcov.avar1 was also defined for ## Classical models start with 'cm', robust just with 'rm' (or just 'm'): (cm0 <- lm (y ~ x1*x2 + x3 + x4 + x5 + offset(os), data)) (cm1 <- lm (y ~ x1*x2 + x3 + x4 + x5 + offset(os), data, weights=weights)) (cm2 <- lm (y ~ x1*x2 + x3 + x4 + x5, data2, offset=os)) (rm0 <- lmrob(y ~ x1*x2 + x3 + x4 + x5 + offset(os), data, control=ctrl)) set.seed(2) (rm1 <- lmrob(y ~ x1*x2 + x3 + x4 + x5 + offset(os), data, weights=weights, control=ctrl)) set.seed(2) (rm2 <- lmrob(y ~ x1*x2 + x3 + x4 + x5, data2, offset=os, control=ctrl)) sc0 <- summary(cm0) sc1 <- summary(cm1) sc2 <- summary(cm2) (sr0 <- summary(rm0)) (sr1 <- summary(rm1)) (sr2 <- summary(rm2)) ## test Estimates, Std. Errors, ... stopifnot(all.equal(coef(cm1), coef(cm2)), all.equal(coef(rm1), coef(rm2)), all.equal(coef(sc0), coef(sr0)), all.equal(coef(sc1), coef(sr1)), all.equal(coef(sc2), coef(sr2))) ## test class "lm" methods that do not depend on weights meths1 <- c("family", "formula", "labels", "model.matrix", "na.action", "terms") for (meth in meths1) stopifnot(all.equal(do.call(meth, list(rm0)), do.call(meth, list(rm1)))) ## class "lm" methods that depend on weights ## FIXME: meths2 <- c(#"AIC", "alias", #"BIC", "case.names", "coef", "confint", #"cooks.distance", #"deviance", "df.residual", #"dfbeta", #"dfbetas", #"drop1", "dummy.coef", #"effects", #"extractAIC", #"hatvalues", #"influence", "kappa", #"logLik", #"model.frame", ## disable because of zero.weights attribute "nobs", "predict", #"proj", #"rstandard", #"rstudent", #"simulate", ##"summary", ## see above "variable.names", ##"vcov", ## see below "weights") op <- options(warn = 1)# print immediately for (meth in meths2) { cat(meth,":") .SW. <- if(meth == "weights") suppressWarnings else identity # for suppressing ## No weights defined for this object. Use type="robustness" .... stopifnot(all.equal(do.call(meth, list(cm1)), do.call(meth, list(rm1))), all.equal(do.call(meth, list(cm2)), .SW.(do.call(meth, list(rm2))))) cat("\n") } options(op)# reverting ## further tests: anova(rm1, update(rm1, ~ . - x4 - x5)) anova(rm2, update(rm2, ~ . - x4 - x5)) stopifnot(all.equal(fitted(cm0), fitted(rm0)), all.equal(fitted(cm1), fitted(rm1)), all.equal(fitted(cm2), fitted(rm2))) nd <- expand.grid(x1=letters[1:3], x2=LETTERS[1:4]) set.seed(3) nd$x3 <- rnorm(nrow(nd)) nd$x4 <- rnorm(nrow(nd)) nd$x5 <- rnorm(nrow(nd)) nd$os <- nrow(nd):1 wts <- runif(nrow(nd)) stopifnot(all.equal(predict(cm0, nd, interval="prediction"), predict(rm0, nd, interval="prediction")), all.equal(predict(cm1, nd, interval="prediction"), predict(rm1, nd, interval="prediction")), all.equal(predict(cm2, nd, interval="prediction"), predict(rm2, nd, interval="prediction")), all.equal(predict(cm0, nd, interval="prediction", weights=wts), predict(rm0, nd, interval="prediction", weights=wts)), all.equal(predict(cm1, nd, interval="prediction", weights=wts), predict(rm1, nd, interval="prediction", weights=wts)), all.equal(predict(cm2, nd, interval="prediction", weights=wts), predict(rm2, nd, interval="prediction", weights=wts), tolerance=1e-7)) ## Padding can lead to differing values here ## so test only full rank part qrEQ <- function(m1, m2) { q1 <- qr(m1) q2 <- qr(m2) r <- 1:q1$rank stopifnot(q1$rank == q2$rank, all.equal(q1$pivot, q2$pivot), all.equal(q1$qraux[r],q2$qraux[r]), all.equal(q1$qr[r,r], q2$qr[r,r])) } qrEQ(cm0, rm0) qrEQ(cm1, rm1) qrEQ(cm2, rm2) stopifnot(all.equal(residuals(cm0), residuals(rm0)), all.equal(residuals(cm1), residuals(rm1)), all.equal(residuals(cm2), residuals(rm2)), all.equal(resid(cm0, type="pearson"), resid(rm0, type="pearson")), all.equal(resid(cm1, type="pearson"), resid(rm1, type="pearson")), all.equal(resid(cm2, type="pearson"), resid(rm2, type="pearson"))) ## R 3.5.0: vcov(*, complete=TRUE) new default ==> same NA's as coef() if(interactive()) withAutoprint({ op <- options(width = 130, digits = 2) # --> vcov() rows fit on 1 line vcov(cm0) # 'x5' is NA vcov(cm2) # 'x5', 'x1c:2B', 'x1c:2C' rows & columns are NA options(op) }) (no.C <- is.na(match("complete", names(formals(stats:::vcov.lm))))) ## temporary _FIXME_ vcovC <- if(no.C) function(M, ...) vcov(M, complete=FALSE, ...) else vcov # (complete=TRUE) stopifnot(all.equal(vcov(cm0), vcovC(rm0), check.attributes=FALSE), all.equal(vcov(cm1), vcovC(rm1), check.attributes=FALSE), all.equal(vcov(cm2), vcovC(rm2), check.attributes=FALSE)) ## "clean": cln <- function(vc) structure(vc, weights=NULL, eigen=NULL) ## .vcov.avar1() is not recommended here, but also should work with singular / NA coef case: ok0 <- !is.na(coef(rm0)) vr0.NA<- vcov(rm0, cov=".vcov.avar1", complete=NA) # "almost singular" warning vr0.T <- vcov(rm0, cov=".vcov.avar1", complete=TRUE) vr0.F <- vcov(rm0, cov=".vcov.avar1", complete=FALSE) stopifnot(identical(dim(vr0.NA), dim(vr0.T)), identical(dim(vr0.F), dim(vr0.T) - 1L), dim(vr0.F) == 14, all.equal(cln(vr0.F), vr0.T[ok0,ok0], tol = 1e-15)) if(!no.C) { vc0.T <- vcov(cm0, complete=TRUE) vc0.F <- vcov(cm0, complete=FALSE) } ok1 <- !is.na(coef(rm1)) ## cannot work because init/fit residuals are not of full length tools::assertError(vr1.NA<- vcov(rm1, cov=".vcov.avar1", complete=NA)) tools::assertError(vr1.T <- vcov(rm1, cov=".vcov.avar1", complete=TRUE )) tools::assertError(vr1.F <- vcov(rm1, cov=".vcov.avar1", complete=FALSE)) ## instead, must refit rm1. <- update(rm1, control = within(ctrl, cov <- ".vcov.avar1")) vr1.NA<- vcov(rm1., complete=NA) vr1.T <- vcov(rm1., complete=TRUE) vr1.F <- vcov(rm1., complete=FALSE) stopifnot(identical(vr1.F, vr1.NA), # in this case identical(dim(vr1.F), dim(vr1.T) - 3L), dim(vr1.F) == 12, isSymmetric(vr1.T), identical(rownames(vr1.F), rownames(vr1.T)[ok1]), all.equal(cln(vr1.F), vr1.T[ok1,ok1], tol=1e-15)) if(FALSE) ## ERROR "exact singular" (probably *NOT* to fix, as TRUE/FALSE do work !) vr2.NA<- vcov(rm2, cov=".vcov.avar1", complete=NA) # "almost singular" warning vr2.T <- vcov(rm2, cov=".vcov.avar1", complete=TRUE) vr2.F <- vcov(rm2, cov=".vcov.avar1", complete=FALSE) stopifnot(TRUE, # identical(dim(vr2.NA), dim(vr2.T)), identical(dim(vr2.F), dim(vr2.T) - 3L), dim(vr2.F) == 12, identical(rownames(vr2.F), rownames(vr1.F)), identical(rownames(vr2.T), rownames(vr1.T)), all.equal(cln(vr2.F), vr2.T[ok1,ok1], tol=1e-15)) ## Hmm, the supposedly heteroscedastic-robust estimates *are* very different: all.equal(vcov(cm0), vcovC(rm0, cov = ".vcov.avar1"), check.attributes=FALSE) # rel.diff. 0.5367564 if(FALSE) # does not make sense all.equal(vcov(cm1), vcovC(rm1, cov = ".vcov.avar1"), check.attributes=FALSE) all.equal(vcov(cm2), vcovC(rm2, cov = ".vcov.avar1"), check.attributes=FALSE) # rel.diff. 0.5757642 ## Null fits (rank(X)==0) are tested in NAcoef.R ## testing weight=0 bug lmrob(y ~ x3, data, weights=weights) robustbase/tests/mc-strict.R0000644000176200001440000002552413443724410015627 0ustar liggesusers #### Testing medcouple mc() and related functions ### here, we do "strict tests" -- hence no *.Rout.save ### hence, can also produce non-reproducible output such as timing library(robustbase) for(f in system.file("xtraR", c("mcnaive.R", # -> mcNaive() "platform-sessionInfo.R"), package = "robustbase", mustWork=TRUE)) { cat("source(",f,"):\n", sep="") source(f) } source(system.file("test-tools-1.R", package="Matrix", mustWork=TRUE)) assertEQm12 <- function(x,y, giveRE=TRUE, ...) assert.EQ(x,y, tol = 1e-12, giveRE=giveRE, ...) ## ^^ shows *any* difference ("tol = 0") unless there is no difference at all ## c.time <- function(...) cat('Time elapsed: ', ..., '\n') S.time <- function(expr) c.time(system.time(expr)) DO <- function(...) S.time(stopifnot(...)) mS <- moreSessionInfo(print.=TRUE) (doExtras <- robustbase:::doExtras())# TRUE if interactive() or activated by envvar n.set <- c(1:99, 1e5L+ 0:1) # large n gave integer overflow in earlier versions DO(0 == sapply(n.set, function(n) mc(seq_len(n)))) DO(0 == sapply(n.set, function(n) mc(seq_len(n), doRefl=FALSE))) DO(0 == sapply(1:100, function(n) mcNaive(seq_len(n), "simple"))) DO(0 == sapply(1:100, function(n) mcNaive(seq_len(n), "h.use" ))) x1 <- c(1, 2, 7, 9, 10) mcNaive(x1) # = -1/3 assertEQm12(-1/3, mcNaive(x1)) assertEQm12(-1/3, mcNaive(x1, "h.use")) assertEQm12(-1/3, mc(x1)) x2 <- c(-1, 0, 0, 0, 1, 2) mcNaive(x2, meth="simple") # = 0 - which is wrong mcNaive(x2, meth="h.use") # = 1/6 = 0.16666 assertEQm12(1/6, mc(x2)) assertEQm12(1/6, mcNaive(x2, "h.use")) x4 <- c(1:5,7,10,15,25, 1e15) ## - bombed in orignal algo mcNaive(x4,"h.use") # 0.5833333 assertEQm12( 7/12, mcNaive(x4, "h.use")) assertEQm12( 7/12, mc( x4, doRefl= FALSE)) assertEQm12(-7/12, mc(-x4, doRefl= FALSE)) set.seed(17) for(n in 3:50) { cat(" ") for(k in 1:5) { x <- rlnorm(n) mc1 <- mc(x) mc2 <- mcNaive(x, method = "simple") mc3 <- mcNaive(x, method = "h.use" ) stopifnot(all.equal(mc1, mc3, tolerance = 1e-10),# 1e-12 not quite ok mc2 == mc3) cat(".") } }; cat("\n") ###---- Strict tests of adjOutlyingness(): ### ================= changed after long-standing bug fix in Oct.2014 ## as this calls, sample.int() and we carefully compare specific seed examples, need RNGversion("3.5.0") ## [TODO: adapt to "current" RNG settings] set.seed(1); S.time(a1.1 <- adjOutlyingness(longley)) set.seed(11); S.time(a1.2 <- adjOutlyingness(longley)) ## set.seed(2); S.time(a2 <- adjOutlyingness(hbk)) set.seed(3); S.time(a3 <- adjOutlyingness(hbk[, 1:3]))# the 'X' space set.seed(4); S.time(a4 <- adjOutlyingness(milk)) # obs.63 = obs.64 set.seed(5); S.time(a5 <- adjOutlyingness(wood)) set.seed(6); S.time(a6 <- adjOutlyingness(wood[, 1:5]))# the 'X' space ## 32-bit <-> 64-bit different results {tested on Linux only} is32 <- .Machine$sizeof.pointer == 4 ## <- should work for Linux/MacOS/Windows isMac <- Sys.info()[["sysname"]] == "Darwin" isSun <- Sys.info()[["sysname"]] == "SunOS" Rnk <- function(u) rank(unname(u), ties.method = "first") ## to use for testing below: cat("\nRnk(a3 $ adjout): "); dput(Rnk(a3$adjout), control= {}) cat("\nRnk(a4 $ adjout): "); dput(Rnk(a4$adjout), control= {}) (i.a4Out <- which(!a4$nonOut)) # varies "wildly" { if(is32 && !isMac) all.equal(i.a4Out, c(1, 2, 41, 70)) ## and this is "typically" true, but not for a 64-bit Linux version bypassing BLAS in matprod else if(isSun || isMac) TRUE else all.equal(i.a4Out, c(9:19, 23:27,57, 59, 70, 77)) } ## only for ATLAS (BLAS/Lapack), not all are TRUE; which ones? if(!all(a5$nonOut)) print(which(!a5$nonOut)) # if we know, enable check below stopifnot(exprs = { which(!a2$nonOut) == 1:14 which(!a3$nonOut) == 1:14 ## 'longley', 'wood' have no outliers in the "adjOut" sense: ## FIXME: longley is platform dependent too { if(isMac) TRUE else if(mS$ strictR) sum(a1.2$nonOut) >= 15 # sum(.) = 16 [nb-mm3, Oct.2014] else ## however, openBLAS Fedora Linux /usr/bin/R gives sum(a1.2$nonOut) = 13 sum(a1.2$nonOut) >= 13 } if(doExtras) { if(mS$ strictR) a5$nonOut else ## not for ATLAS sum(a5$nonOut) >= 18 # 18: OpenBLAS } else TRUE a6$nonOut[-20] ## hbk (n = 75) : abs(Rnk(a3$adjout) - c(62, 64, 68, 71, 70, 65, 66, 63, 69, 67, 73, 75, 72, 74, 25, 52, 44, 5, 11, 33, 6, 21, 29, 28, 59, 9, 12, 13, 37, 27, 43, 35, 22, 55, 14, 2, 26, 46, 54, 15, 23, 41, 40, 32, 60, 30, 61, 19, 16, 8, 39, 53, 51, 48, 20, 47, 50, 42, 7, 38, 17, 57, 45, 18, 24, 34, 3, 58, 56, 4, 1, 10, 31, 36, 49) ) <= 3 ## all 0 on 32-bit Linux }) ## milk (n = 86) : -- Quite platform dependent! r <- Rnk(a4$adjout) r64 <- ## the 64-bit (ubuntu 14.04, nb-mm3) values: c(65, 66, 61, 56, 47, 51, 19, 37, 74, 67, 79, 86, 83, 84, 85, 82, 81, 73, 80, 55, 27, 3, 70, 68, 78, 76, 77, 53, 48, 8, 29, 33, 6, 32, 28, 31, 36, 40, 22, 58, 64, 52, 39, 63, 44, 30, 57, 46, 43, 45, 25, 54, 12, 1, 9, 2, 71, 14, 75, 23, 4, 10, 34, 35, 17, 24, 15, 20, 38, 72, 42, 13, 50, 60, 62, 26, 69, 18, 5, 21, 7, 49, 11, 41, 59, 16) r32 <- ## Linux 32bit (florence: 3.14.8-100.fc19.i686.PAE) c(78, 79, 72, 66, 52, 61, 22, 41, 53, 14, 74, 85, 82, 83, 84, 80, 81, 56, 73, 65, 30, 3, 16, 17, 68, 57, 58, 63, 54, 8, 32, 37, 6, 36, 31, 35, 40, 44, 25, 69, 77, 62, 43, 76, 48, 34, 67, 51, 47, 49, 28, 64, 12, 1, 9, 2, 33, 15, 59, 26, 4, 10, 38, 39, 20, 27, 18, 23, 42, 86, 46, 13, 60, 71, 75, 29, 50, 21, 5, 24, 7, 55, 11, 45, 70, 19) d <- (r - if (is32) r32 else r64) cbind(r, d) table(abs(d)) cumsum(table(abs(d))) # <=> unscaled ecdf(d) ## For the biggest part (79 out of 86), the ranks are "close": ## 2014: still true, but in a different sense.. ## ^ typically, but e.g., *not* when using non-BLAS matprod(): sum(abs(d) <= 17) >= 78 sum(abs(d) <= 13) >= 75 ## check of adjOutlyingness *free* bug ## reported by Kaveh Vakili set.seed(-37665251) X <- matrix(rnorm(100*5),100,5) Z <- matrix(rnorm(100*5,0,1/100),10,5) Z <- sweep(Z, 2, c(5,rep(0,4)), FUN="+") X[91:100,] <- Z for (i in 1:10) { ## this would produce an error in the 6th iteration aa <- adjOutlyingness(x=X,ndir=250) } ## "large n" (this did overflow sum_p, sum_q earlier ==> had inf.loop): set.seed(3); x <- rnorm(2e5) (mx <- mc(x, trace.lev=3)) stopifnot(print(abs(mx - -0.000772315846101988)) < 1e-15) # 3.252e-19, 64b Linux # 1.198e-16, 32b Windows ### Some platform info : local({ nms <- names(Si <- Sys.info()) dropNms <- c("nodename", "machine", "login") structure(Si[c("nodename", nms[is.na(match(nms, dropNms))])], class="simple.list") }) if(identical(1L, grep("linux", R.version[["os"]]))) { ##----- Linux - only ---- ## Sys.procinfo <- function(procfile) { l2 <- strsplit(readLines(procfile),"[ \t]*:[ \t]*") r <- sapply(l2[sapply(l2, length) == 2], function(c2)structure(c2[2], names= c2[1])) attr(r,"Name") <- procfile class(r) <- "simple.list" r } ## Scpu <- Sys.procinfo("/proc/cpuinfo") Smem <- Sys.procinfo("/proc/meminfo") print(Scpu[c("model name", "cpu MHz", "cache size", "bogomips")]) print(Smem[c("MemTotal", "SwapTotal")]) } ##' Checking the breakdown point of mc() --- Hubert et al. theory said : 25% ##' using non-default doReflect=FALSE as that corresponds to original Hubert et al. ##' ##' @title Medcouple mc() checking ##' @param x ##' @param Xfun ##' @param eps ##' @param NAiferror ##' @param doReflect ##' @param ... ##' @return mc(*,..) or NaN in case mc() signals an error [non-convergence] ##' @author Martin Maechler mcX <- function(x, Xfun, eps=0, NAiferror=FALSE, doReflect=FALSE, ...) { stopifnot(is.numeric(x), is.function(Xfun), "eps" %in% names(formals(Xfun))) myFun <- if(NAiferror) function(u) tryCatch(mc(Xfun(u, eps=eps), doReflect=doReflect, ...), error = function(e) NaN) else function(u) mc(Xfun(u, eps=eps), doReflect=doReflect, ...) vapply(x, myFun, 1.) } X1. <- function(u, eps=0) c(1,2,3, 7+(-10:10)*eps, u + (-1:1)*eps) ## ==> This *does* breakdown [but points are not "in general position"]: r.mc1 <- curve(mcX(x, X1.), 10, 1e35, log="x", n=1001) rt1 <- uniroot(function(x) mcX(exp(x), X1.) - 1/2, lower=0, upper=500) exp(rt1$root) # 4.056265e+31 ## eps > 0 ==> No duplicated points ==> theory says breakdown point = 0.25 ## ------- but get big numerical problems: if(FALSE) { # ==> convergence problem [also in maxit = 1e5] .. really an *inf* loop! r.mc1.1 <- curve(mcX(x, X1., eps= .1 ), 10, 1e35, log="x", n=1001) r.mc1.2 <- curve(mcX(x, X1., eps= .01 ), 10, 1e35, log="x", n=1001) r.mc1.3 <- curve(mcX(x, X1., eps= .001), 10, 1e35, log="x", n=1001) r.mc1.5 <- curve(mcX(x, X1., eps= 1e-5), 10, 1e35, log="x", n=1001) r.mc1.8 <- curve(mcX(x, X1., eps= 1e-8), 10, 1e35, log="x", n=1001) r.mc1.15 <- curve(mcX(x, X1., eps=1e-15), 10, 1e35, log="x", n=1001)# still! } ## practically identical to eps = 0 where we have breakdown (see above) r.mc1.16 <- curve(mcX(x, X1., eps=1e-16), 10, 1e35, log="x", n=1001) all.equal(r.mc1, r.mc1.16, tol=1e-15)#-> TRUE ## Quite bad case: Non convergence X2. <- function(u) c(1:3, seq(6, 8, by = 1/8), u, u, u) try(mc(X2.(4.3e31)))## -> error: no convergence if(FALSE) # and the same here -- after longer waiting: mc(X2.(4.3e31), eps1=1e-7, eps2=1e-100, maxit = 1e6)## -> error: no convergence ## related, more direct: X3. <- function(u) c(10*(1:3), 60:80, (4:6)*u) mc(X3.(1e31), trace=5) # fine convergence in one iter. try( mc(X3.(1e32), trace=3) # no convergence... )# bad try(mc(X3.(1e32), trace=5, maxit=6)) # no convergence... ### TODO : find example with *smaller* sample size -- with no convergence X4. <- function(u, eps, ...) c(10, 70:75, (2:3)*u) mc(X4.(1e34))# "fine" ## whoa: jump down and up: r.mc4 <- curve(mcX(x, X4.), 100, 1e35, log="x", n=2^12) X5. <- function(u) c(10*(1:3), 70:78, (4:6)*u) try(mc(X5.(1e32), maxit=1000)) X5. <- function(u, eps,...) c(5*(1:12), (4:6)*u) (r.mc5 <- mc(X5.(1e32), doReflect=FALSE, maxit=1000)) all.equal(1, ## <- i.e. complete breakdown r.mc5) ## platform dependent! yes, on 64-bit try(mc(X5.(5e31), maxit=10000)) # no convergence.. r.mc5Sml <- curve(mcX(x, X5.), 1, 100, log="x", n=1024) ## quite astonishing r.mc5Lrg <- curve(mcX(x, X5.), 1, 1e30, log="x", n=1024) ## ok.. ## but then going higher -- we have problems: r.mc5Big <- curve(mcX(x, X5., NAiferror=TRUE), 1, 1e38, log="x", n = 2^12, type = "o", cex = 1/4) warnings() summary(r.mc5Big$y) ## 15 NA's at x : with(r.mc5Big, x[is.na(y)]) ## ~= [4.3, 5.8] * 10^31 c.time(proc.time()) summary(warnings()) # seen 15 x In mcComp(....) : ## maximal number of iterations (100 =? 100) reached prematurely robustbase/tests/lmrob-psifns.Rout.save0000644000176200001440000007370513313011777020027 0ustar liggesusers R Under development (unstable) (2018-06-19 r74919) -- "Unsuffered Consequences" Copyright (C) 2018 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > #### Tests psi(), chi(),... etc and tuning.psi, tuning.chi : > > library(robustbase) > source(system.file("xtraR/plot-psiFun.R", package = "robustbase", mustWork=TRUE)) > source(system.file("test-tools-1.R", package = "Matrix", mustWork=TRUE))# assert.EQ Loading required package: tools > > ### (1) Test the functions themselves -------------------------------- > if(!dev.interactive(orNone=TRUE)) pdf("rob-psifns.pdf") > > ## Simple version, no error checking, no derivative, nothing: > psiGGW <- function(x, a,b,c) { + ifelse((ax <- abs(x)) < c, + x, + ifelse((ea <- -((ax-c)^b)/(2*a)) < -708.4, 0, x * exp(ea))) + } > assert.EQ(Mpsi (5:9, cc=c(0, a=1/8,b=2,c=1/8, NA), "GGW"), + psiGGW(5:9, a=1/8,b=2,c=1/8), tol = 1e-13) > > > ## Check that psi() |-> works; ditto for +-Inf, NA,.. > cG <- c(-.5, 1, .95, NA) # one of the 6 "builtin"s > d0 <- numeric() > IoI <- c(-Inf, 0, Inf) > NN <- c(NaN, NA) > > cGs <- list( c(-.4, 1.5, 0.85, NA) + , c(-.4, 1.5 , 0.90, NA) + , c(-.4, 1.5 , 0.95, NA) + , c(-.4, 1.5, 0.975, NA) + , c(-.4, 1.5, 0.99 , NA) + , c(-.4, 1.5, 0.995, NA) + ## + , c(-.4, 1.25, 0.975, NA) + , c(-.4, 1.1, 0.975, NA) + , c(-.4, 1.025, 0.975, NA) + , c(-.4, 1.0125, 0.975, NA) + ## + ## FIXME , c(-.1, 1.25, 0.95, NA) + ## FIXME , c(-.1, 1.25, 0.99, NA) + ) > st <- system.time( + cG.cnst <- lapply(cGs, function(cc) + lmrob.control(psi = "ggw", tuning.psi = cc)$tuning.psi) + ) > cat('Time for constants computation of tuning.psi: ', st,'\n') Time for constants computation of tuning.psi: 0.16 0.001 0.161 0 0 > cGct <- t(sapply(cG.cnst, attr, "constants"))[,-1] > colnames(cGct) <- c("a","b","c", "rhoInf") > signif(cGct, 4) a b c rhoInf [1,] 1.0170 1.500 0.4996 2.384 [2,] 1.2810 1.500 0.5826 3.242 [3,] 1.8100 1.500 0.7335 5.139 [4,] 2.4430 1.500 0.8959 7.666 [5,] 3.4380 1.500 1.1250 12.090 [6,] 4.2970 1.500 1.3050 16.280 [7,] 1.3780 1.250 1.4350 7.654 [8,] 1.0140 1.100 1.7000 7.643 [9,] 0.8873 1.025 1.8130 7.712 [10,] 0.8693 1.012 1.8300 7.733 > assert.EQ(sapply(cG.cnst, function(cc) MrhoInf(cc, "ggw")), + cGct[,"rhoInf"], tol = 1e-8) > > > ## Do these checks for a *list* of (c.par, psi) combinations: > c.psi.list <- list( + list(1.345, "Huber"), + list(1.8, "Huber"), + list(cG, "GGW"), + list(c(2,4,8), "Hampel"), + list(c(1.5,3.5,8)*0.90, "Hampel"), + list(par=c(-.5,1.5,.95,NA), "lqq"), + list(bcs=c(1, 1, 1.25), "lqq"), + list(1.1, "optimal"), + list(0.1, "optimal"), + list(2.3, "Welsh") + ) > > for(c.psi in c.psi.list) { + tPar <- c.psi[[1]]; psi <- c.psi[[2]] + stopifnot(is.numeric(tPar), is.character(psi)) + cat("Psi function ", psi,"; tuning par. c[]= (", + paste(formatC(tPar, width=1), collapse=", "),")\n") + for(FUN in list(Mpsi, Mchi, Mwgt)) + stopifnot(identical(d0, FUN(d0, tPar, psi=psi)), + identical(NN, FUN(NN, tPar, psi=psi))) + stopifnot(identical(c(0,1,0), Mwgt(IoI, tPar,psi=psi))) + if(isPsi.redesc(psi)) + stopifnot(identical(c(0,0,0), Mpsi(IoI, tPar,psi=psi)), + identical(c(1,0,1), Mchi(IoI, tPar,psi=psi))) + else if(psi == "Huber") { + stopifnot(identical(c(-tPar,0,tPar), Mpsi(IoI, tPar,psi=psi)), + identical(c( Inf,0, Inf), Mchi(IoI, tPar,psi=psi))) + } + cat("chkPsi..(): ") + isHH <- psi %in% c("Huber", "Hampel") # not differentiable + tol <- switch(tolower(psi), + "huber"=, "hampel"= c(.001, 1.0), + "optimal" = .008, + "ggw" = c(5e-5, 5e-3, 1e-12), + "lqq" = c(1e-5, 5e-5, 1e-5, .08)) # .08 needed for bcs=c(1, 1, 1.25) + if(is.null(tol)) tol <- 1e-4 # default otherwise + cc <- chkPsi..(c(-5, 10), psi=psi, par=tPar, doD2 = !isHH, tol=tol) + ## -------- + cc. <- cc[!is.na(cc)] + if(is.logical(cc) && all(cc.)) + cat(" [Ok]\n") + else { + cat(" not all Ok:\n") + print(cc.[cc. != "TRUE"]) + } + cat("------------------------\n\n") + } Psi function Huber ; tuning par. c[]= ( 1.345 ) chkPsi..(): Not checking psi''() := Mpsi(*, deriv=2) [Ok] ------------------------ Psi function Huber ; tuning par. c[]= ( 1.8 ) chkPsi..(): Not checking psi''() := Mpsi(*, deriv=2) [Ok] ------------------------ Psi function GGW ; tuning par. c[]= ( -0.5, 1, 0.95, NA ) chkPsi..(): Not checking psi''() := Mpsi(*, deriv=2) [Ok] ------------------------ Psi function Hampel ; tuning par. c[]= ( 2, 4, 8 ) chkPsi..(): Not checking psi''() := Mpsi(*, deriv=2) [Ok] ------------------------ Psi function Hampel ; tuning par. c[]= ( 1.35, 3.15, 7.2 ) chkPsi..(): Not checking psi''() := Mpsi(*, deriv=2) [Ok] ------------------------ Psi function lqq ; tuning par. c[]= ( -0.5, 1.5, 0.95, NA ) chkPsi..(): [Ok] ------------------------ Psi function lqq ; tuning par. c[]= ( 1, 1, 1.25 ) chkPsi..(): [Ok] ------------------------ Psi function optimal ; tuning par. c[]= ( 1.1 ) chkPsi..(): Not checking psi''() := Mpsi(*, deriv=2) [Ok] ------------------------ Psi function optimal ; tuning par. c[]= ( 0.1 ) chkPsi..(): Not checking psi''() := Mpsi(*, deriv=2) [Ok] ------------------------ Psi function Welsh ; tuning par. c[]= ( 2.3 ) chkPsi..(): Not checking psi''() := Mpsi(*, deriv=2) [Ok] ------------------------ > > > ## Nice plots -- and check derivatives ---- > > head(x. <- seq(-5, 10, length=1501)) [1] -5.00 -4.99 -4.98 -4.97 -4.96 -4.95 > ## [separate lines, for interactive "play": ] > stopifnot(chkPsiDeriv(p.psiFun(x., "LQQ", par=c(-.5,1.5,.95,NA)))) > stopifnot(chkPsiDeriv(p.psiFun(x., "GGW", par= cG))) > stopifnot(chkPsiDeriv(p.psiFun(x., "optimal", par=2))) > stopifnot(chkPsiDeriv(p.psiFun(x., "Hampel", + par = ## Default, but rounded: + round(c(1.5, 3.5, 8) * 0.9016085, 1)), + tol = 1e-3)) > > stopifnot(chkPsiDeriv(p.psiFun(x., "biweight", par = 4))) > stopifnot(chkPsiDeriv(p.psiFun(x., "Welsh", par = 1.5))) > stopifnot(chkPsiDeriv(p.psiFun(x., "huber", par = 1.5), + tol = c(1e-10, 5e-3))) > ## "huber"-rho via Mpsi(*, deriv=-1) was badly wrong till 2018-06 > > ## The same 6, all in one plot: > op <- par(mfrow=c(3,2), mgp = c(1.5, .6, 0), mar = .1+c(3,3,2,.5)) > p.psiFun2(x., "LQQ", par=c(-.5,1.5,.95,NA)) > p.psiFun2(x., "GGW", par= cG) > p.psiFun2(x., "optimal", par=1.3) > p.psiFun2(x., "Hampel", par = round(c(1.5, 3.5, 8) * 0.9016085, 1)) > p.psiFun2(x., "biweight", par = 4) > p.psiFun2(x., "Welsh", par = 1.5) > par(op) > > > ### (2) Test them as arguments of lmrob() or lmrob.control(): ----- > > data(aircraft) > > set.seed(1) > summary(mp0 <- lmrob(Y ~ ., data = aircraft, psi = 'bisquare', method = 'SMDM')) Call: lmrob(formula = Y ~ ., data = aircraft, method = "SMDM", psi = "bisquare") \--> method = "SMDM" Residuals: Min 1Q Median 3Q Max -8.5552 -1.8395 -0.2113 2.8205 46.6311 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 6.8785690 6.5321336 1.053 0.306256 X1 -3.2192206 1.0907887 -2.951 0.008543 ** X2 1.5876658 0.7442079 2.133 0.046912 * X3 0.0018266 0.0004293 4.255 0.000477 *** X4 -0.0008677 0.0003685 -2.355 0.030083 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 5.335 Multiple R-squared: 0.7958, Adjusted R-squared: 0.7504 Convergence in 22 IRWLS iterations Robustness weights: observation 22 is an outlier with |weight| = 0 ( < 0.0043); 3 weights are ~= 1. The remaining 19 ones are summarized as Min. 1st Qu. Median Mean 3rd Qu. Max. 0.3958 0.8772 0.9738 0.9139 0.9892 0.9972 Algorithmic parameters: tuning.chi bb tuning.psi refine.tol 1.548e+00 5.000e-01 4.685e+00 1.000e-07 rel.tol scale.tol solve.tol eps.outlier 1.000e-07 1.000e-10 1.000e-07 4.348e-03 eps.x warn.limit.reject warn.limit.meanrw 8.399e-08 5.000e-01 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd numpoints 200 0 1000 0 10 fast.s.large.n 2000 psi subsampling cov "bisquare" "nonsingular" ".vcov.w" compute.outlier.stats "SMDM" seed : int(0) > > set.seed(2) > summary(mp1 <- update(mp0, psi = 'optimal')) Call: lmrob(formula = Y ~ ., data = aircraft, method = "SMDM", psi = "optimal") \--> method = "SMDM" Residuals: Min 1Q Median 3Q Max -6.6691 -2.4291 0.2249 3.8876 54.2841 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 9.5007403 5.5576768 1.709 0.10455 X1 -3.0487969 0.9158751 -3.329 0.00374 ** X2 1.2100330 0.6469186 1.870 0.07777 . X3 0.0013810 0.0003910 3.532 0.00238 ** X4 -0.0005549 0.0003269 -1.697 0.10687 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 4.545 Multiple R-squared: 0.8159, Adjusted R-squared: 0.775 Convergence in 1 IRWLS iterations Robustness weights: 2 observations c(16,22) are outliers with |weight| = 0 ( < 0.0043); 21 weights are ~= 1. Algorithmic parameters: tuning.chi bb tuning.psi refine.tol 4.047e-01 5.000e-01 1.060e+00 1.000e-07 rel.tol scale.tol solve.tol eps.outlier 1.000e-07 1.000e-10 1.000e-07 4.348e-03 eps.x warn.limit.reject warn.limit.meanrw 8.399e-08 5.000e-01 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd numpoints 200 0 1000 0 10 fast.s.large.n 2000 psi subsampling cov "optimal" "nonsingular" ".vcov.w" compute.outlier.stats "SMDM" seed : int(0) > > set.seed(3) > summary(mp2 <- update(mp0, psi = 'ggw')) Call: lmrob(formula = Y ~ ., data = aircraft, method = "SMDM", psi = "ggw") \--> method = "SMDM" Residuals: Min 1Q Median 3Q Max -8.4418 -1.7993 -0.1711 2.8466 47.0906 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 6.8192703 6.5041383 1.048 0.30831 X1 -3.1718079 1.0869559 -2.918 0.00918 ** X2 1.5705706 0.7510236 2.091 0.05096 . X3 0.0017983 0.0004300 4.182 0.00056 *** X4 -0.0008434 0.0003691 -2.285 0.03466 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 5.367 Multiple R-squared: 0.7942, Adjusted R-squared: 0.7484 Convergence in 20 IRWLS iterations Robustness weights: observation 22 is an outlier with |weight| <= 0.00044 ( < 0.0043); 16 weights are ~= 1. The remaining 6 ones are 3 4 12 16 17 19 0.9892 0.9891 0.8770 0.4139 0.9796 0.9839 Algorithmic parameters: tuning.chi1 tuning.chi2 tuning.chi3 tuning.chi4 -5.000e-01 1.500e+00 NA 5.000e-01 bb tuning.psi1 tuning.psi2 tuning.psi3 5.000e-01 -5.000e-01 1.500e+00 9.500e-01 tuning.psi4 refine.tol rel.tol scale.tol NA 1.000e-07 1.000e-07 1.000e-10 solve.tol eps.outlier eps.x warn.limit.reject 1.000e-07 4.348e-03 8.399e-08 5.000e-01 warn.limit.meanrw 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd numpoints 200 0 1000 0 10 fast.s.large.n 2000 psi subsampling cov "ggw" "nonsingular" ".vcov.w" compute.outlier.stats "SMDM" seed : int(0) > > set.seed(4) > summary(mp3 <- update(mp0, psi = 'welsh')) Call: lmrob(formula = Y ~ ., data = aircraft, method = "SMDM", psi = "welsh") \--> method = "SMDM" Residuals: Min 1Q Median 3Q Max -8.7243 -1.9199 -0.2471 2.8060 45.9435 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 6.6404575 6.5552085 1.013 0.324482 X1 -3.2329194 1.0954988 -2.951 0.008546 ** X2 1.6174887 0.7443222 2.173 0.043367 * X3 0.0018656 0.0004279 4.360 0.000378 *** X4 -0.0008941 0.0003680 -2.430 0.025803 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 5.408 Multiple R-squared: 0.7958, Adjusted R-squared: 0.7504 Convergence in 18 IRWLS iterations Robustness weights: observation 22 is an outlier with |weight| <= 0.0003 ( < 0.0043); 2 weights are ~= 1. The remaining 20 ones are summarized as Min. 1st Qu. Median Mean 3rd Qu. Max. 0.4284 0.8583 0.9701 0.9112 0.9874 0.9985 Algorithmic parameters: tuning.chi bb tuning.psi refine.tol 5.774e-01 5.000e-01 2.110e+00 1.000e-07 rel.tol scale.tol solve.tol eps.outlier 1.000e-07 1.000e-10 1.000e-07 4.348e-03 eps.x warn.limit.reject warn.limit.meanrw 8.399e-08 5.000e-01 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd numpoints 200 0 1000 0 10 fast.s.large.n 2000 psi subsampling cov "welsh" "nonsingular" ".vcov.w" compute.outlier.stats "SMDM" seed : int(0) > > set.seed(5) > summary(mp4 <- update(mp0, psi = 'ggw', tuning.psi = c(-.5, 1.5, 0.85, NA), + tuning.chi = c(-0.5, 1.5, NA, 0.5))) Call: lmrob(formula = Y ~ ., data = aircraft, method = "SMDM", psi = "ggw", tuning.psi = c(-0.5, 1.5, 0.85, NA), tuning.chi = c(-0.5, 1.5, NA, 0.5)) \--> method = "SMDM" Residuals: Min 1Q Median 3Q Max -7.2207 -2.2226 0.3446 3.5745 52.2885 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 9.6540916 6.6414237 1.454 0.16327 X1 -3.2353135 1.0947329 -2.955 0.00847 ** X2 1.3343505 0.7636515 1.747 0.09762 . X3 0.0015256 0.0004619 3.303 0.00395 ** X4 -0.0006913 0.0003903 -1.771 0.09343 . --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 5.117 Multiple R-squared: 0.7832, Adjusted R-squared: 0.7351 Convergence in 15 IRWLS iterations Robustness weights: observation 22 is an outlier with |weight| <= 2.8e-08 ( < 0.0043); 15 weights are ~= 1. The remaining 7 ones are 3 4 12 16 17 19 23 0.87262 0.79602 0.73029 0.06024 0.96761 0.73117 0.97769 Algorithmic parameters: tuning.chi1 tuning.chi2 tuning.chi3 tuning.chi4 -5.000e-01 1.500e+00 NA 5.000e-01 bb tuning.psi1 tuning.psi2 tuning.psi3 5.000e-01 -5.000e-01 1.500e+00 8.500e-01 tuning.psi4 refine.tol rel.tol scale.tol NA 1.000e-07 1.000e-07 1.000e-10 solve.tol eps.outlier eps.x warn.limit.reject 1.000e-07 4.348e-03 8.399e-08 5.000e-01 warn.limit.meanrw 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd numpoints 200 0 1000 0 10 fast.s.large.n 2000 psi subsampling cov "ggw" "nonsingular" ".vcov.w" compute.outlier.stats "SMDM" seed : int(0) > > set.seed(6) > summary(mp5 <- update(mp0, psi = 'ggw', + tuning.psi = c(-0.5, 1.0, 0.95, NA), + tuning.chi = c(-0.5, 1.0, NA, 0.5))) Call: lmrob(formula = Y ~ ., data = aircraft, method = "SMDM", psi = "ggw", tuning.psi = c(-0.5, 1, 0.95, NA), tuning.chi = c(-0.5, 1, NA, 0.5)) \--> method = "SMDM" Residuals: Min 1Q Median 3Q Max -8.4182 -1.7447 -0.1322 2.8735 47.0376 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 6.7557666 6.0919101 1.109 0.282039 X1 -3.1767976 1.0196958 -3.115 0.005974 ** X2 1.5756461 0.7050185 2.235 0.038339 * X3 0.0018004 0.0004003 4.497 0.000279 *** X4 -0.0008432 0.0003446 -2.447 0.024897 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 5.502 Multiple R-squared: 0.7941, Adjusted R-squared: 0.7484 Convergence in 19 IRWLS iterations Robustness weights: 21 weights are ~= 1. The remaining 2 ones are 16 22 0.423706 0.005042 Algorithmic parameters: tuning.chi1 tuning.chi2 tuning.chi3 tuning.chi4 -5.000e-01 1.000e+00 NA 5.000e-01 bb tuning.psi1 tuning.psi2 tuning.psi3 5.000e-01 -5.000e-01 1.000e+00 9.500e-01 tuning.psi4 refine.tol rel.tol scale.tol NA 1.000e-07 1.000e-07 1.000e-10 solve.tol eps.outlier eps.x warn.limit.reject 1.000e-07 4.348e-03 8.399e-08 5.000e-01 warn.limit.meanrw 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd numpoints 200 0 1000 0 10 fast.s.large.n 2000 psi subsampling cov "ggw" "nonsingular" ".vcov.w" compute.outlier.stats "SMDM" seed : int(0) > > set.seed(7) > summary(mp6 <- update(mp0, psi = 'hampel')) Call: lmrob(formula = Y ~ ., data = aircraft, method = "SMDM", psi = "hampel") \--> method = "SMDM" Residuals: Min 1Q Median 3Q Max -8.706 -1.937 -0.234 2.825 46.037 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 6.4297956 6.7818616 0.948 0.35564 X1 -3.1885813 1.1366401 -2.805 0.01170 * X2 1.6224243 0.7839018 2.070 0.05315 . X3 0.0018590 0.0004445 4.182 0.00056 *** X4 -0.0008851 0.0003832 -2.310 0.03295 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 5.475 Multiple R-squared: 0.7946, Adjusted R-squared: 0.7489 Convergence in 11 IRWLS iterations Robustness weights: observation 22 is an outlier with |weight| = 0 ( < 0.0043); 20 weights are ~= 1. The remaining 2 ones are 12 16 0.8504 0.4975 Algorithmic parameters: tuning.chi1 tuning.chi2 tuning.chi3 bb 3.179e-01 7.417e-01 1.695e+00 5.000e-01 tuning.psi1 tuning.psi2 tuning.psi3 refine.tol 1.352e+00 3.156e+00 7.213e+00 1.000e-07 rel.tol scale.tol solve.tol eps.outlier 1.000e-07 1.000e-10 1.000e-07 4.348e-03 eps.x warn.limit.reject warn.limit.meanrw 8.399e-08 5.000e-01 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd numpoints 200 0 1000 0 10 fast.s.large.n 2000 psi subsampling cov "hampel" "nonsingular" ".vcov.w" compute.outlier.stats "SMDM" seed : int(0) > > set.seed(8) > ctr7 <- lmrob.control(psi = 'ggw', + tuning.psi = c(-0.3, 1.4, 0.95, NA), + tuning.chi = c(-0.3, 1.4, NA, 0.5)) > ctr7$tuning.psi ## -> "constants" [1] -0.30 1.40 0.95 NA attr(,"constants") [1] 0.0000000 2.0011562 1.4000000 0.4125717 5.6874488 > ctr7$tuning.chi [1] -0.3 1.4 NA 0.5 attr(,"constants") [1] 0.00000000 0.24044569 1.40000000 0.09081713 0.27558437 > summary(mp7 <-lmrob(Y ~ ., data = aircraft, control = ctr7)) # *not* converging in k.max=200 Call: lmrob(formula = Y ~ ., data = aircraft, control = ctr7) \--> method = "S" Residuals: Min 1Q Median 3Q Max -7.6919 -1.9269 0.1767 3.7081 48.5801 Algorithm did not converge Coefficients of the *initial* S-estimator: Estimate Std. Error t value Pr(>|t|) (Intercept) 13.155499 NA NA NA X1 -4.349383 NA NA NA X2 1.647243 NA NA NA X3 0.001817 NA NA NA X4 -0.001035 NA NA NA Robustness weights: 2 observations c(16,22) are outliers with |weight| <= 0.0003 ( < 0.0043); 4 weights are ~= 1. The remaining 17 ones are summarized as Min. 1st Qu. Median Mean 3rd Qu. Max. 0.03668 0.20120 0.58420 0.52290 0.71930 0.99110 Algorithmic parameters: tuning.chi1 tuning.chi2 tuning.chi3 tuning.chi4 -3.000e-01 1.400e+00 NA 5.000e-01 bb tuning.psi1 tuning.psi2 tuning.psi3 5.000e-01 -3.000e-01 1.400e+00 9.500e-01 tuning.psi4 refine.tol rel.tol scale.tol NA 1.000e-07 1.000e-07 1.000e-10 solve.tol eps.outlier eps.x warn.limit.reject 1.000e-07 4.348e-03 8.399e-08 5.000e-01 warn.limit.meanrw 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd fast.s.large.n 200 0 1000 0 2000 psi subsampling cov "ggw" "nonsingular" ".vcov.avar1" compute.outlier.stats "SM" seed : int(0) Warning message: In lmrob.S(x, y, control = control) : S refinements did not converge (to refine.tol=1e-07) in 200 (= k.max) steps > > set.seed(9) > summary(mp8 <- update(mp0, psi = 'lqq')) Call: lmrob(formula = Y ~ ., data = aircraft, method = "SMDM", psi = "lqq") \--> method = "SMDM" Residuals: Min 1Q Median 3Q Max -8.280 -1.717 -0.138 2.857 47.743 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 7.0858566 6.3506262 1.116 0.279194 X1 -3.1657682 1.0600204 -2.987 0.007914 ** X2 1.5402736 0.7336570 2.099 0.050145 . X3 0.0017612 0.0004222 4.171 0.000574 *** X4 -0.0008188 0.0003616 -2.265 0.036118 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 5.319 Multiple R-squared: 0.7944, Adjusted R-squared: 0.7487 Convergence in 19 IRWLS iterations Robustness weights: observation 22 is an outlier with |weight| = 0 ( < 0.0043); 16 weights are ~= 1. The remaining 6 ones are 3 4 12 16 17 19 0.9861 0.9842 0.8921 0.3720 0.9820 0.9782 Algorithmic parameters: tuning.chi1 tuning.chi2 tuning.chi3 tuning.chi4 -5.000e-01 1.500e+00 NA 5.000e-01 bb tuning.psi1 tuning.psi2 tuning.psi3 5.000e-01 -5.000e-01 1.500e+00 9.500e-01 tuning.psi4 refine.tol rel.tol scale.tol NA 1.000e-07 1.000e-07 1.000e-10 solve.tol eps.outlier eps.x warn.limit.reject 1.000e-07 4.348e-03 8.399e-08 5.000e-01 warn.limit.meanrw 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd numpoints 200 0 1000 0 10 fast.s.large.n 2000 psi subsampling cov "lqq" "nonsingular" ".vcov.w" compute.outlier.stats "SMDM" seed : int(0) > > set.seed(10) ## c(.) drops attributes : > ctr9 <- lmrob.control(psi = 'lqq', tuning.psi = c(ctr7$tuning.psi), tuning.chi = c(ctr7$tuning.chi)) > ctr9$tuning.psi [1] -0.30 1.40 0.95 NA attr(,"constants") [1] 1.3007171 0.9290836 1.3000000 > ctr9$tuning.chi [1] -0.3 1.4 NA 0.5 attr(,"constants") [1] 0.2763568 0.1973977 1.3000000 > ## Confirm these constants above (against the ones we got earlier) > ## by recomputing them using higher accuracy : > (tpsi. <- do.call(.psi.lqq.findc, c(ctr9$tuning.psi, list(rel.tol=1e-11, tol=1e-8)))) [1] 1.3007495 0.9291068 1.3000000 > (tchi. <- do.call(.psi.lqq.findc, c(ctr9$tuning.chi, list(rel.tol=1e-11, tol=1e-8)))) [1] 0.2763425 0.1973875 1.3000000 > (tol4 <- .Machine$double.eps^.25) [1] 0.0001220703 > > Rver <- getRversion() > integr.bug <- "2.12.0" <= Rver && Rver <= "3.0.1" > integr.bug [1] FALSE > if(integr.bug) tol4 <- 8*tol4 > > assert.EQ(attr(ctr9$tuning.psi, "constants"), tpsi., tol=tol4, giveRE=TRUE) Mean relative difference: 2.495013e-05 > assert.EQ(attr(ctr9$tuning.chi, "constants"), tchi., tol=tol4, giveRE=TRUE) Mean relative difference: 5.155651e-05 > > summary(mp9 <- lmrob(Y ~ ., data = aircraft, control = ctr9)) Call: lmrob(formula = Y ~ ., data = aircraft, control = ctr9) \--> method = "MM" Residuals: Min 1Q Median 3Q Max -10.4061 -2.6517 -0.4156 3.7945 38.6444 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 3.5003005 12.9625202 0.270 0.79021 X1 -3.2953770 0.9467913 -3.481 0.00267 ** X2 1.8957842 0.9928099 1.910 0.07227 . X3 0.0022793 0.0014340 1.589 0.12936 X4 -0.0011563 0.0008966 -1.290 0.21347 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 6.127 Multiple R-squared: 0.7973, Adjusted R-squared: 0.7523 Convergence in 33 IRWLS iterations Robustness weights: 17 weights are ~= 1. The remaining 6 ones are 3 4 12 16 17 22 0.97698 0.99840 0.82584 0.78662 0.91318 0.06838 Algorithmic parameters: tuning.chi1 tuning.chi2 tuning.chi3 tuning.chi4 -3.000e-01 1.400e+00 NA 5.000e-01 bb tuning.psi1 tuning.psi2 tuning.psi3 5.000e-01 -3.000e-01 1.400e+00 9.500e-01 tuning.psi4 refine.tol rel.tol scale.tol NA 1.000e-07 1.000e-07 1.000e-10 solve.tol eps.outlier eps.x warn.limit.reject 1.000e-07 4.348e-03 8.399e-08 5.000e-01 warn.limit.meanrw 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd fast.s.large.n 200 0 1000 0 2000 psi subsampling cov "lqq" "nonsingular" ".vcov.avar1" compute.outlier.stats "SM" seed : int(0) > > > cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' Time elapsed: 1.616 0.136 1.756 0.001 0.001 > > proc.time() user system elapsed 1.617 0.137 1.756 robustbase/tests/tlts.Rout.save0000644000176200001440000003505113162677266016407 0ustar liggesusers R Under development (unstable) (2017-09-26 r73351) -- "Unsuffered Consequences" Copyright (C) 2017 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(robustbase) > ## library(MASS)## MASS::lqs > > source(system.file("xtraR/test_LTS.R", package = "robustbase")) > ## ../inst/test_LTS.R > > y20 <- c(2:4, 8, 12, 22, 28, 29, 33, 34, 38, 40, 41, 47:48, 50:51, 54, 56, 59) > > test_location <- function() { + ## Improve: print less, and test equality explicitly + Y <- y20 + print(ltsReg(y=Y)) + print(ltsReg(y=Y, intercept=TRUE)) + print(ltsReg(y=Y, intercept=FALSE)) + print(ltsReg(y=Y, alpha=1)) + print(ltsReg(Y ~ 1)) + print(ltsReg(Y ~ 0))# = Y ~ 1 - 1 : empty model (no coefficients) + print(ltsReg(Y ~ 1, alpha=1)) + } > > test_rsquared <- function() { + x1 <- y20 + y1 <- c(1, 1, 1, 1, 1, 1, 1, 1, 1, 3.5, 1, 1, 1, 1, 1, 1, 1, 1, 1, 5) + ll1 <- ltsReg(x1,y1, alpha = 0.8) + ## print() ing is platform-dependent, since only ~= 0 + stopifnot(all.equal(unname(coef(ll1)), c(1,0), tolerance=1e-12), + ll1$scale < 1e-14) + print(ltsReg(y1,x1, alpha = 0.8)) + print(ltsReg(y1,x1, alpha = 0.8, intercept = FALSE)) + } > > options(digits = 5) > set.seed(101) # <<-- sub-sampling algorithm now based on R's RNG and seed > > doLTSdata() Call: doLTSdata() ======================================================== Data Set n p Half obj Time [ms] ======================================================== heart 12 2 8 0.065810 Best subsample: [1] 1 2 4 5 6 7 11 12 Outliers: 4 [1] 3 8 9 10 ------------- Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Coefficients: Intercept height weight 63.353 -1.227 0.688 Scale estimate 1.52 Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Residuals (from reweighted LS): 1 2 3 4 5 6 7 8 9 10 11 -1.393 0.169 0.000 0.443 -0.341 0.165 -0.115 0.000 0.000 0.000 0.666 12 0.404 Coefficients: Estimate Std. Error t value Pr(>|t|) Intercept 63.3528 4.0227 15.75 1.9e-05 *** height -1.2265 0.1403 -8.74 0.00032 *** weight 0.6884 0.0528 13.04 4.7e-05 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 0.765 on 5 degrees of freedom Multiple R-Squared: 0.991, Adjusted R-squared: 0.988 F-statistic: 286 on 2 and 5 DF, p-value: 6.99e-06 -------------------------------------------------------- starsCYG 47 1 25 1.880169 Best subsample: [1] 2 4 6 10 13 15 17 19 21 22 25 27 28 29 33 35 36 38 39 41 42 43 44 45 46 Outliers: 6 [1] 7 9 11 20 30 34 ------------- Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Coefficients: Intercept log.Te -8.50 3.05 Scale estimate 0.456 Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Residuals (from reweighted LS): Min 1Q Median 3Q Max -0.784 -0.214 0.000 0.227 0.592 Coefficients: Estimate Std. Error t value Pr(>|t|) Intercept -8.500 1.926 -4.41 7.8e-05 *** log.Te 3.046 0.437 6.97 2.4e-08 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 0.341 on 39 degrees of freedom Multiple R-Squared: 0.554, Adjusted R-squared: 0.543 F-statistic: 48.5 on 1 and 39 DF, p-value: 2.39e-08 -------------------------------------------------------- phosphor 18 2 11 0.245377 Best subsample: [1] 1 2 3 4 6 7 11 12 14 15 18 Outliers: 1 [1] 17 ------------- Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Coefficients: Intercept inorg organic 60.9149 1.2110 0.0883 Scale estimate 13.5 Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Residuals (from reweighted LS): Min 1Q Median 3Q Max -30.297 -3.591 -0.692 4.251 17.116 Coefficients: Estimate Std. Error t value Pr(>|t|) Intercept 60.9149 10.1995 5.97 3.4e-05 *** inorg 1.2110 0.3549 3.41 0.0042 ** organic 0.0883 0.2574 0.34 0.7366 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 12.7 on 14 degrees of freedom Multiple R-Squared: 0.519, Adjusted R-squared: 0.45 F-statistic: 7.55 on 2 and 14 DF, p-value: 0.00597 -------------------------------------------------------- stackloss 21 3 13 0.083378 Best subsample: [1] 5 6 7 8 9 10 11 12 15 16 17 18 19 Outliers: 4 [1] 1 3 4 21 ------------- Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Coefficients: Intercept Air.Flow Water.Temp Acid.Conc. -37.6525 0.7977 0.5773 -0.0671 Scale estimate 1.92 Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Residuals (from reweighted LS): Min 1Q Median 3Q Max -2.506 -0.424 0.000 0.576 1.934 Coefficients: Estimate Std. Error t value Pr(>|t|) Intercept -37.6525 4.7321 -7.96 2.4e-06 *** Air.Flow 0.7977 0.0674 11.83 2.5e-08 *** Water.Temp 0.5773 0.1660 3.48 0.0041 ** Acid.Conc. -0.0671 0.0616 -1.09 0.2961 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 1.25 on 13 degrees of freedom Multiple R-Squared: 0.975, Adjusted R-squared: 0.969 F-statistic: 169 on 3 and 13 DF, p-value: 1.16e-10 -------------------------------------------------------- coleman 20 5 13 0.028344 Best subsample: [1] 1 2 6 7 8 9 11 13 14 15 16 19 20 Outliers: 2 [1] 3 18 ------------- Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Coefficients: Intercept salaryP fatherWc sstatus teacherSc motherLev 29.7577 -1.6985 0.0851 0.6662 1.1840 -4.0668 Scale estimate 1.12 Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Residuals (from reweighted LS): Min 1Q Median 3Q Max -1.216 -0.389 0.000 0.306 0.984 Coefficients: Estimate Std. Error t value Pr(>|t|) Intercept 29.7577 5.5322 5.38 0.00017 *** salaryP -1.6985 0.4660 -3.64 0.00336 ** fatherWc 0.0851 0.0208 4.09 0.00149 ** sstatus 0.6662 0.0382 17.42 6.9e-10 *** teacherSc 1.1840 0.1643 7.21 1.1e-05 *** motherLev -4.0668 0.8487 -4.79 0.00044 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 0.782 on 12 degrees of freedom Multiple R-Squared: 0.988, Adjusted R-squared: 0.983 F-statistic: 203 on 5 and 12 DF, p-value: 3.65e-11 -------------------------------------------------------- salinity 28 3 16 0.065610 Best subsample: [1] 2 3 4 6 7 12 14 15 17 18 19 20 21 22 26 27 Outliers: 4 [1] 5 16 23 24 ------------- Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Coefficients: Intercept X1 X2 X3 38.063 0.443 -0.206 -1.373 Scale estimate 1.23 Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Residuals (from reweighted LS): Min 1Q Median 3Q Max -2.482 -0.390 0.000 0.339 1.701 Coefficients: Estimate Std. Error t value Pr(>|t|) Intercept 38.063 5.172 7.36 4.1e-07 *** X1 0.443 0.086 5.15 4.9e-05 *** X2 -0.206 0.138 -1.50 0.15 X3 -1.373 0.195 -7.06 7.7e-07 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 1.03 on 20 degrees of freedom Multiple R-Squared: 0.899, Adjusted R-squared: 0.884 F-statistic: 59.3 on 3 and 20 DF, p-value: 3.92e-10 -------------------------------------------------------- aircraft 23 4 14 0.298554 Best subsample: [1] 1 5 6 7 8 9 10 11 13 14 15 17 20 23 Outliers: 2 [1] 16 22 ------------- Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Coefficients: Intercept X1 X2 X3 X4 9.500740 -3.048797 1.210033 0.001381 -0.000555 Scale estimate 5.69 Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Residuals (from reweighted LS): Min 1Q Median 3Q Max -6.67 -2.43 0.00 2.79 6.79 Coefficients: Estimate Std. Error t value Pr(>|t|) Intercept 9.500740 5.577532 1.70 0.1078 X1 -3.048797 0.919147 -3.32 0.0044 ** X2 1.210033 0.649230 1.86 0.0808 . X3 0.001381 0.000392 3.52 0.0028 ** X4 -0.000555 0.000328 -1.69 0.1102 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 4.35 on 16 degrees of freedom Multiple R-Squared: 0.826, Adjusted R-squared: 0.782 F-statistic: 19 on 4 and 16 DF, p-value: 6.47e-06 -------------------------------------------------------- delivery 25 2 14 0.112945 Best subsample: [1] 2 5 6 7 8 10 12 13 14 15 17 21 22 25 Outliers: 3 [1] 1 9 24 ------------- Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Coefficients: Intercept n.prod distance 3.7196 1.4058 0.0163 Scale estimate 2.38 Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Residuals (from reweighted LS): Min 1Q Median 3Q Max -5.0321 -1.0306 -0.0124 0.3474 4.2371 Coefficients: Estimate Std. Error t value Pr(>|t|) Intercept 3.71959 0.91011 4.09 0.00063 *** n.prod 1.40578 0.13128 10.71 1.7e-09 *** distance 0.01625 0.00301 5.40 3.3e-05 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 2.32 on 19 degrees of freedom Multiple R-Squared: 0.962, Adjusted R-squared: 0.958 F-statistic: 243 on 2 and 19 DF, p-value: 2.9e-14 -------------------------------------------------------- wood 20 5 13 0.070258 Best subsample: [1] 2 3 9 10 11 12 13 14 15 16 17 18 20 Outliers: 4 [1] 4 6 8 19 ------------- Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Coefficients: Intercept x1 x2 x3 x4 x5 0.377 0.217 -0.085 -0.564 -0.400 0.607 Scale estimate 0.0124 Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Residuals (from reweighted LS): Min 1Q Median 3Q Max -0.00928 -0.00177 0.00000 0.00115 0.01300 Coefficients: Estimate Std. Error t value Pr(>|t|) Intercept 0.3773 0.0540 6.99 3.8e-05 *** x1 0.2174 0.0421 5.16 0.00042 *** x2 -0.0850 0.1977 -0.43 0.67634 x3 -0.5643 0.0435 -12.98 1.4e-07 *** x4 -0.4003 0.0654 -6.12 0.00011 *** x5 0.6074 0.0786 7.73 1.6e-05 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 0.00745 on 10 degrees of freedom Multiple R-Squared: 0.958, Adjusted R-squared: 0.937 F-statistic: 46 on 5 and 10 DF, p-value: 1.4e-06 -------------------------------------------------------- hbk 75 3 40 3.724554 Best subsample: [1] 11 12 14 16 17 18 20 25 26 30 31 32 33 34 35 36 37 39 40 41 42 44 45 46 48 [26] 50 55 56 58 59 60 61 63 64 66 67 69 71 72 74 Outliers: 10 [1] 1 2 3 4 5 6 7 8 9 10 ------------- Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Coefficients: Intercept X1 X2 X3 -0.1805 0.0814 0.0399 -0.0517 Scale estimate 0.744 Call: ltsReg.formula(formula = form, data = dataset, mcd = FALSE) Residuals (from reweighted LS): Min 1Q Median 3Q Max -0.926 -0.396 0.000 0.397 1.011 Coefficients: Estimate Std. Error t value Pr(>|t|) Intercept -0.1805 0.1044 -1.73 0.089 . X1 0.0814 0.0667 1.22 0.227 X2 0.0399 0.0405 0.99 0.328 X3 -0.0517 0.0354 -1.46 0.149 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 0.557 on 61 degrees of freedom Multiple R-Squared: 0.0428, Adjusted R-squared: -0.00429 F-statistic: 0.909 on 3 and 61 DF, p-value: 0.442 -------------------------------------------------------- ======================================================== > if(FALSE) { ## FIXME: These *FAIL* ! + doLTSdata(nrep = 12, time = FALSE) + doLTSdata(nrep = 12, time = FALSE, method = "MASS") + } > > test_rsquared() Call: ltsReg.default(x = y1, y = x1, alpha = 0.8) Coefficients: Intercept y1 25.9 5.3 Scale estimate 18 Call: ltsReg.default(x = y1, y = x1, intercept = FALSE, alpha = 0.8) Coefficients: y1 31.4 Scale estimate 24.6 Warning messages: 1: In covMcd(X, alpha = alpha, use.correction = use.correction) : Initial scale 0 because more than 'h' (=16) observations are identical. 2: In covMcd(X, alpha = alpha, use.correction = use.correction) : Initial scale 0 because more than 'h' (=16) observations are identical. > test_location() Call: ltsReg.default(y = Y) Coefficients: [1] 44.6 Scale estimate 19.7 Call: ltsReg.default(y = Y, intercept = TRUE) Coefficients: [1] 44.6 Scale estimate 19.7 Call: ltsReg.default(y = Y, intercept = FALSE) Coefficients: [1] 44.6 Scale estimate 20 Call: ltsReg.default(y = Y, alpha = 1) Coefficients: [1] 33 Scale estimate 19.3 Call: ltsReg.formula(formula = Y ~ 1) Coefficients: [1] 44.6 Scale estimate 19.7 Call: ltsReg.formula(formula = Y ~ 0) No coefficients Call: ltsReg.formula(formula = Y ~ 1, alpha = 1) Coefficients: [1] 33 Scale estimate 19.3 > > if(length(W <- warnings())) print(if(getRversion() >= "3.5") summary(W) else W) 2 identical warnings: In covMcd(X, alpha = alpha, use.correction = use.correction) : Initial scale 0 because more than 'h' (=16) observations are identical. > > cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' Time elapsed: 0.332 0.058 0.463 0.002 0.001 > > proc.time() user system elapsed 0.334 0.059 0.463 robustbase/tests/lmrob-data.R0000644000176200001440000002010213326344173015733 0ustar liggesusers### lmrob() with "real data" library(robustbase) set.seed(0) data(salinity) summary(m0.sali <- lmrob(Y ~ . , data = salinity)) (A1 <- anova(m0.sali, Y ~ X1 + X3)) ## -> X2 is not needed (m1.sali <- lmrob(Y ~ X1 + X3, data = salinity)) (A2 <- anova(m0.sali, m1.sali)) # the same as before stopifnot(all.equal(A1[2,"Pr(>chisq)"], A2[2,"Pr(>chisq)"], tolerance=1e-14)) anova(m0.sali, m1.sali, test = "Deviance") ## whereas 'X3' is highly significant: m2 <- update(m0.sali, ~ . -X3) (A3 <- anova(m0.sali, m2)) (A4 <- anova(m0.sali, m2, test = "Deviance")) cX3 <- c(Estimate = -0.627327396, `Std. Error` = 0.15844971, `t value` = -3.9591577, `Pr(>|t|)` = 0.000584156) stopifnot(all.equal(cX3, coef(summary(m0.sali))["X3",], tolerance = 1e-6)) ## example(lmrob) set.seed(7) data(coleman) summary( m1 <- lmrob(Y ~ ., data=coleman) ) stopifnot(c(3,18) == which(m1$w < 0.2)) if(FALSE) # to find out *why setting = "KS201x" fails trace(lmrob.S, exit = quote({cat("coef:\n"); print(b$coefficients)})) if(FALSE) # to find out via setting = "KS201x" fails here in the *initial* estimate debug(lmrob.S) data(starsCYG) lmST <- lm(log.light ~ log.Te, data = starsCYG) (RlmST <- lmrob(log.light ~ log.Te, data = starsCYG, control=lmrob.control(trace = 1))) summary(RlmST) ## Least Sq. w/ negative slope, where robust has slope ~= 2.2 : stopifnot(coef(lmST)[["log.Te"]] < 0, all.equal(coef(RlmST), c("(Intercept)" = -4.969, log.Te=2.253), tol = 1e-3), c(11,20,30,34) == which(RlmST$w < 0.01)) ## ==> Now see that "KS2011" and "KS2014" both break down -- and it is the fault of "lqq" *only* : (RlmST.11 <- update(RlmST, control = lmrob.control("KS2011", trace= 1))) (RlmST.14 <- update(RlmST, control = lmrob.control("KS2014", trace= 1))) (RlmSTM11 <- update(RlmST, control = lmrob.control("KS2011", method="MM", trace= 1))) (RlmSTM14 <- update(RlmST, control = lmrob.control("KS2014", method="MM", trace= 1))) ## using "biweight" instead of "lqq" fixes the problem : (RlmSTbM11 <- update(RlmST,control = lmrob.control("KS2011", method="MM", psi="biweight",trace= 1))) (RlmSTbM14 <- update(RlmST,control = lmrob.control("KS2014", method="MM", psi="biweight",trace= 1))) (RlmSTb.11 <- update(RlmST,control = lmrob.control("KS2011", psi="biweight",trace= 1))) (RlmSTb.14 <- update(RlmST,control = lmrob.control("KS2014", psi="biweight",trace= 1))) ## NB: RlmST has component 'init.S' the others have "init" -- documented in ?lmrob.fit == ../man/lmrob.fit.Rd R.ini.cf <- t(sapply(mget(ls(patt = "^RlmST")), function(OB) OB$init$coef)) R..cf <- t(sapply(mget(ls(patt = "^RlmST")), coef)) cbind(R.ini.cf, R..cf) ##---> "lqq" is *NOT* robust enough here -- but "biweight" is !! options(digits = 5)# less platform dependence ## Directly look at init.S(): x.s <- model.matrix(~ log.Te, data = starsCYG) y.s <- model.response(model.frame(log.light ~ log.Te, data = starsCYG)) ini.df <- lmrob.S(x.s, y.s, control=lmrob.control()) ini.11 <- lmrob.S(x.s, y.s, control=lmrob.control("KS2011")) ini.14 <- lmrob.S(x.s, y.s, control=lmrob.control("KS2014")) ## but these are fine !! : rbind(deflt = ini.df$coef, KS.11 = ini.11$coef, KS.14 = ini.14$coef) ##==> No, it is *not* the init.S() ini.14$scale # 0.48144 ## More clearly shows how M-estimate is converging to *WRONG* solution: (RlmST.lqq <- update(RlmST, init=ini.14, control = lmrob.control(method="MM", psi="lqq", trace= 4))) ## --> break down ## The 10 largest residuals from the robust init. S-estim: (i10 <- head(order(abs(residuals(ini.14)), decreasing=TRUE), 10)) residuals(ini.14)[i10] ## ==> and their weights for the different psi() and their default (95% efficiency) tuning: PSIs <- names(.Mchi.tuning.defaults) sapply(PSIs, function(PSI) Mwgt(residuals(ini.14)[i10], cc = .Mpsi.tuning.defaults[[PSI]], psi=PSI)) ## All MM: RlmST.MM <- lapply(setNames(,PSIs), function(PSI) update(RlmST, init=ini.14, control = lmrob.control(method="MM", psi = PSI))) cf.MM <- t(sapply(RlmST.MM, coef)) cf.MM[order(cf.MM[,1], cf.MM[,2]),] ## only 'bisquare' and 'optimal' are robust enough ##=== Werner's analysis: Sensitivity curves for the most-left obs ========================================= dd <- starsCYG dd <- dd[order(dd[,"log.Te"]),] # ==> leverage points come first (and easier plotting) (rr <- lmrob(log.light ~ log.Te, data = dd)) (rr14 <- update(rr, control = lmrob.control("KS2014"))) dd[1,2] # 6.05 will be replaced for sensitivity curve leg.s <- c("default, biweight" ,"KS14, lqq" ,"KS14, biweight" ,"KS14, optimal" ,"KS14, Hampel" ,"KS14, GGW" ,"KS14, Welsh" ) nEst <- length(leg.s) # == number of estimators used below nn <- length(y1 <- c(NA, seq(2,9, length=64))) nCf <- length(coef(rr)) + 1 # +1: sigma r.coef <- matrix(NA, length(y1), nEst*nCf) t.d <- dd oo <- options(warn = 1) ## vary the left-most observation and fit all three for (i in seq_along(y1)) { cat(sprintf("%3d: %11.6g -- ", i, y1[i])) t.d[1,2] <- y1[i] ## the (old) default does not converge in 4 cases lr <- update(rr, data=t.d, control = lmrob.control(maxit=500)) ; cat("1") lr14 <- update(rr14, data=t.d, control = lmrob.control("KS2014", psi="lqq") ) ; cat("2") lr14b <- update(rr14, data=t.d, control = lmrob.control("KS2014", psi="biweight") ) ; cat("3") lr14o <- update(rr14, data=t.d, control = lmrob.control("KS2014", psi="optimal" ) ) ; cat("4") lr14h <- update(rr14, data=t.d, control = lmrob.control("KS2014", psi="hampel" ) ) ; cat("5") lr14g <- update(rr14, data=t.d, control = lmrob.control("KS2014", psi="ggw" ) ) ; cat("6") lr14a <- update(rr14, data=t.d, control = lmrob.control("KS2014", psi="welsh" ) ) ; cat("7") r.coef[i,] <- c(coef(lr ), sigma(lr), coef(lr14 ), sigma(lr14), coef(lr14b), sigma(lr14b), coef(lr14o), sigma(lr14o), coef(lr14h), sigma(lr14h), coef(lr14g), sigma(lr14g), coef(lr14a), sigma(lr14a)) cat("\n") } options(oo) ## cbind(y=y.1, r.coef) ## y1[1] = where the NA is pMat <- function(j, main, x.legend, col = 1:8, lty=1:6, lwd = 2, ylab=NA, ...) { stopifnot(j %in% seq_len(ncol(r.coef))) matplot(y1, r.coef[, j], type="l", xlab = quote("varying obs." ~ ~ y[1]), ylab=ylab, main=main, col=col, lty=lty, lwd=lwd, ...) xx <- par("usr")[1:2]; yL <- .99* xx[1] + .01*xx[2] matpoints(yL, r.coef[1, j, drop=FALSE], pch = 20, col=col, lwd=lwd) abline(h = r.coef[1, j, drop=FALSE], col = col, lwd=1, lty=3) legend(x.legend, leg.s, lty=lty, col=col, lwd=lwd, bty = "n") abline(v = dd[1,2], col=adjustcolor("tomato", 1/4)) # true y value } (jj0 <- nCf*(seq_len(nEst)-1L)) sfsmisc::mult.fig(2)$old.par -> op pMat(j = 2+jj0, main = quote("slope" ~~ hat(beta[2])), "bottomleft") pMat(j = 3+jj0, main = quote(hat(sigma)), "topleft") par(op) ## -------------------------------- set.seed(47) data(hbk) m.hbk <- lmrob(Y ~ ., data = hbk) summary(m.hbk) stopifnot(1:10 == which(m.hbk$w < 0.01)) data(heart) summary(mhrt <- lmrob(clength ~ ., data = heart)) # -> warning 'maxit.scale=200' too small stopifnot(8 == which(mhrt$w < 0.15), 11 == which(0.61 < mhrt$w & mhrt$w < 0.62), c(1:7,9:10,12) == which(mhrt$w > 0.90)) iN <- c(3,5,7,11) heartN <- heart; heartN[iN, "clength"] <- NA lmN <- lm (clength ~ ., data = heartN) # default na.action=na.omit mhN <- lmrob(clength ~ ., data = heartN) # default na.action=na.omit # ==> everything just uses the n=8 complete obs summary(mhN) # now *does* note the 4 omitted obs. mhNex <- lmrob(clength ~ ., data = heartN, na.action=na.exclude) summary(mhNex) mhNx1 <- update(mhNex, ~ . - weight) mhNx0 <- update(mhNex, ~ 1) stopifnot( length(r.mNex <- resid(mhNex)) == nrow(heartN) , iN == which(iNAr <- is.na(r.mNex)) , identical(iNAr, is.na(r.mN1 <- residuals(mhNx1))) , identical(iNAr, is.na(r.mN0 <- residuals(mhNx0))) ) data(stackloss) mSL <- lmrob(stack.loss ~ ., data = stackloss) summary(mSL) cat('Time elapsed: ', proc.time(),'\n') # "stats" robustbase/tests/subsample.R0000644000176200001440000001276212271657124015722 0ustar liggesusers### test subsample ### LU decomposition and singular subsamples handling require(robustbase) source(system.file("xtraR/subsample-fns.R", package = "robustbase", mustWork=TRUE)) source(system.file("test-tools-1.R", package="Matrix", mustWork=TRUE)) require(Matrix) cat("doExtras:", doExtras <- robustbase:::doExtras(),"\n") showProc.time() A <- matrix(c(0.001, 1, 1, 2), 2) set.seed(11) str(sa <- tstSubsample(A)) A <- matrix(c(3, 2, 6, 17, 4, 18, 10, -2, 12), 3) tstSubsample(A) ## test some random matrix set.seed(1002) A <- matrix(rnorm(100), 10) tstSubsample(A) ## test singular matrix handling A <- matrix(c(1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 1), 4, byrow=TRUE) tstSubsample(A) ## test subsample with mts > 0 data <- data.frame(y = rnorm(9), expand.grid(A = letters[1:3], B = letters[1:3])) x <- model.matrix(y ~ ., data) y <- data$y ## this should produce a warning and return status == 2 showSys.time(z <- Rsubsample(x, y, mts=2)) stopifnot(z$status == 2) ## test equilibration ## columns only X <- matrix(c(1e-7, 2, 1e-10, 0.2), 2) y <- 1:2 tstSubsample(t(X), y) ## rows only X <- matrix(c(1e-7, 2, 1e10, 0.2), 2) y <- 1:2 tstSubsample(X, y) ## both X <- matrix(c(1e-7, 1e10, 2, 2e12), 2) y <- 1:2 tstSubsample(X, y) showProc.time() ## test real data example data(possumDiv)## 151 * 9; the last two variables are factors with(possumDiv, table(eucalyptus, aspect)) mf <- model.frame(Diversity ~ .^2, possumDiv) X <- model.matrix(mf, possumDiv) y <- model.response(mf) stopifnot(qr(X)$rank == ncol(X)) ## this used to fail: different pivots in step 37 str(s1 <- tstSubsample(X, y)) s2 <- tstSubsample(X / max(abs(X)), y / max(abs(X))) s3 <- tstSubsample(X * 2^-50, y * 2^-50) ## all components *BUT* x, y, lu, Dr, Dc, rowequ, colequ : nm <- names(s1); nm <- nm[is.na(match(nm, c("x","y","lu", "Dr", "Dc", "rowequ", "colequ")))] stopifnot(all.equal(s1[nm], s2[nm], tolerance=1e-10), all.equal(s1[nm], s3[nm], tolerance=1e-10)) showProc.time() set.seed(10) nsing <- sum(replicate(if(doExtras) 200 else 20, tstSubsampleSing(X, y))) stopifnot(nsing == 0) showProc.time() ## test example with many categorical predictors set.seed(10) r1 <- lmrob(Diversity ~ .^2 , data = possumDiv, cov="none") ## lmrob.S used to fail for this seed: set.seed(108) r2 <- lmrob(Diversity ~ .^2 , data = possumDiv, cov="none") #, trace=4) showProc.time() ## investigate problematic subsample: idc <- 1 + c(140, 60, 12, 13, 89, 90, 118, 80, 17, 134, 59, 94, 36, 43, 46, 93, 107, 62, 57, 116, 11, 45, 35, 38, 120, 34, 29, 33, 147, 105, 115, 92, 61, 91, 104, 141, 138, 129, 130, 84, 119, 132, 6, 135, 112, 16, 67, 41, 102, 76, 111, 82, 148, 24, 131, 10, 96, 0, 87, 21, 127, 56, 124) rc <- lm(Diversity ~ .^2 , data = possumDiv, subset = idc) X <- model.matrix(rc) y <- possumDiv$Diversity[idc] tstSubsample(X, y)## have different pivots ... could not find non-singular lu <- LU.gaxpy(t(X)) stopifnot(lu$sing) zc <- Rsubsample(X, y) stopifnot(zc$status > 0) ## column 52 is linearly dependent and should have been discarded ## qr(t(X))$pivot image(as(round(zc$lu - (lu$L + lu$U - diag(nrow(lu$U))), 10), "Matrix")) image(as( sign(zc$lu) - sign(lu$L + lu$U - diag(nrow(lu$U))), "Matrix")) showProc.time() ## test equilibration ## colequ only X <- matrix(c(1e-7, 2, 1e-10, 0.2), 2) y <- 1:2 tstSubsample(t(X), y) ## rowequ only X <- matrix(c(1e-7, 2, 1e10, 0.2), 2) y <- 1:2 tstSubsample(X, y) ## both X <- matrix(c(1e-7, 1e10, 2, 2e12), 2) y <- 1:2 tstSubsample(X, y) showProc.time() ### real data, see MM's ~/R/MM/Pkg-ex/robustbase/hedlmrob.R ## close to singular cov(): attach(system.file("external", "d1k27.rda", package="robustbase", mustWork=TRUE)) fm1 <- lmrob(y ~ a + I(a^2) + tf + I(tf^2) + A + I(A^2) + . , data = d1k27) ## ^^^^^ gave error, earlier, now with a warning -- use ".vcov.w" ## --> cov = ".vcov.w" fm2 <- lmrob(y ~ a + I(a^2) + tf + I(tf^2) + A + I(A^2) + . , data = d1k27, cov = ".vcov.w", trace = TRUE) showProc.time()# 2.77 if(doExtras) {##----------------------------------------------------------------- ## Q: does it change to use numeric instead of binary factors ? ## A: not really .. d1k.n <- d1k27 d1k.n[-(1:5)] <- lapply(d1k27[,-(1:5)], as.numeric) fm1.n <- lmrob(y ~ a + I(a^2) + tf + I(tf^2) + A + I(A^2) + . , data = d1k.n) fm2.n <- lmrob(y ~ a + I(a^2) + tf + I(tf^2) + A + I(A^2) + . , data = d1k.n, cov = ".vcov.w", trace = 2) print(summary(weights(fm1, type="robustness"))) hist(weights(fm1, type="robustness"), main="robustness weights of fm1") rug(weights(fm1, type="robustness")) showProc.time()## 2.88 ## fmc <- lm (y ~ poly(a,2)-a + poly(tf, 2)-tf + poly(A, 2)-A + . , data = d1k27) print(summary(fmc)) ## -> has NA's for 'a, tf, A' --- bad that it did *not* work to remove them nform <- update(formula(fm1), ~ . +poly(A,2) -A -I(A^2) +poly(a,2) -a -I(a^2) +poly(tf,2) -tf -I(tf^2)) fm1. <- lmrob(nform, data = d1k27)# now w/o warning !? !! fm2. <- lmrob(nform, data = d1k27, cov = ".vcov.w", trace = TRUE) ## now lmrob takes care of NA coefficients automatically print(lmrob(y ~ poly(a,2)-a + poly(tf, 2)-tf + poly(A, 2)-A + . , data = d1k27)) showProc.time() ## 4.24 } ## only if(doExtras) ##-------------------------------------------------------- ## test exact fit property set.seed(20) data <- data.frame(y=c(rep.int(0, 20), rnorm(5)), group=rep(letters[1:5], each=5)) x <- model.matrix(y ~ group, data) lmrob.S(x, data$y, lmrob.control()) (ret <- lmrob(y ~ group, data)) summary(ret) showProc.time() robustbase/tests/binom-ni-small.R0000644000176200001440000000644312271657124016544 0ustar liggesuserslibrary(robustbase) ### Binomial example with *small* ni N <- 51 set.seed(123) table(ni <- rpois(N, lam=4))# has 4 '1's, (no '0') n0 <- ni; n0[print(which(ni == 1)[1:2])] <- 0 # has two '0's x <- seq(0,1, length=N) pr.x <- plogis(5*(x - 1/2)) k <- rbinom(N, size = ni, prob = pr.x) k0 <- rbinom(N, size = n0, prob = pr.x) cbind(k,ni, k0,n0) g1 <- glm(cbind(k , ni-k ) ~ x, family = binomial) coef(summary(g1))[,1:2] g0 <- glm(cbind(k0, n0-k0) ~ x, family = binomial)# works too g0. <- glm(cbind(k0, n0-k0) ~ x, family = binomial, subset = n0 > 0) ## all.equal(g0, g0.) stopifnot(all.equal(print(coef(summary(g0))), coef(summary(g0.)))) rg1 <- glmrob(cbind(k , ni-k ) ~ x, family = binomial) rg1. <- glmrob(cbind(k , ni-k ) ~ x, family = binomial, acc = 1e-10) # default is just 1e-4 stopifnot(all.equal(unname(coef(rg1.)), c(-2.37585864, 4.902389143), tolerance=1e-9), all.equal(coef(rg1), coef(rg1.), tolerance=1e-4), all.equal(vcov(rg1.), vcov(rg1), tolerance = 1e-4)) rg1$iter which(rg1.$w.r != 1) ## 7 of them : str(rg1.["family" != names(rg1.)]) rg2 <- glmrob(cbind(k , ni-k ) ~ x, family = binomial, acc = 1e-10, tcc = 3) # large cutoff: almost classical vcov(rg2) # << already close to limit rg10 <- glmrob(cbind(k , ni-k ) ~ x, family = binomial, tcc = 10) rgL <- glmrob(cbind(k , ni-k ) ~ x, family = binomial, tcc = 100) no.comp <- - match(c("call", "data", "family", "control", "tcc"), names(rg10)) stopifnot(all.equal(rg10[no.comp], rgL[no.comp], tolerance= 1e-14)) vcov(rgL) # is now the same as the following: if(FALSE) { ## tcc=Inf fails: non-convergence / singular matrix from GOTO/Atlas3 rgI <- glmrob(cbind(k , ni-k ) ~ x, family = binomial, tcc = Inf) ## tcc = Inf still *FAILS* (!) stopifnot(all.equal(rgL[no.comp], rgI[no.comp], tolerance= 0)) ## and is quite close to the classic one: (all.equal(vcov(rgI), vcov(g1))) } rg0 <- glmrob(cbind(k0, n0-k0) ~ x, family = binomial) ## --> warning.. rg0. <- glmrob(cbind(k0, n0-k0) ~ x, family = binomial, subset = n0 > 0) coef(summary(rg0)) # not yet good (cf. 'g0' above!) -- but the one of rg0. is stopifnot(all.equal(coef(rg0), coef(rg0.))) ### Example where all ni >= 3 -- works better, now also correct as.var. !! ### ----------------- ======= min(n3 <- ni + 2)# = 3 k3 <- rbinom(N, size = n3, prob = pr.x) g3 <- glm(cbind(k3 , n3-k3) ~ x, family = binomial) (cfg <- coef(summary(g3))[,1:2]) stopifnot(all.equal(sqrt(diag(vcov(g3))), cfg[,2])) rg3 <- glmrob(cbind(k3 , n3-k3) ~ x, family = binomial) (s3 <- summary(rg3)) summary(rg3$w.r) rg3.5 <- glmrob(cbind(k3 , n3-k3) ~ x, family = binomial, tcc = 5) (s3.5 <- summary(rg3.5)) summary(rg3.5$w.r)# all 1 stopifnot(all.equal(coef(s3)[,1:2], coef(s3.5)[,1:2], tolerance = 0.02)) rg3.15 <- glmrob(cbind(k3 , n3-k3) ~ x, family = binomial, tcc = 15, acc=1e-10) (s3.15 <- summary(rg3.15)) stopifnot(all.equal(coef(s3.15)[,1:2], cfg, tolerance = 1e-5),# 2e-6 all.equal(cfg[,"Estimate"], rg3.15$coeff, tolerance= 1e-8) # 6.05e-10 ) ##rg3.15$eff # == 1 ## doesn't change any more: rg3.1000 <- glmrob(cbind(k3 , n3-k3) ~ x, family = binomial, tcc = 1000, acc=1e-10) stopifnot(all.equal(rg3.1000[no.comp], rg3.15 [no.comp], tol = 1e-13)) cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' robustbase/tests/lmrob-methods.Rout.save0000644000176200001440000003606013210011041020135 0ustar liggesusers R version 3.4.2 Patched (2017-11-09 r73697) -- "Short Summer" Copyright (C) 2017 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ### tests methods argument of lmrob.control > > library(robustbase) > > data(stackloss) > > ## S > set.seed(0) > summary(m0 <- lmrob(stack.loss ~ ., data = stackloss, method = "S", + compute.outlier.stats = "S")) Call: lmrob(formula = stack.loss ~ ., data = stackloss, method = "S", compute.outlier.stats = "S") \--> method = "S" Residuals: Min 1Q Median 3Q Max -9.46226 -0.82076 0.02249 0.80806 8.31829 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) -36.92542 5.41708 -6.816 3.0e-06 *** Air.Flow 0.84957 0.07892 10.765 5.2e-09 *** Water.Temp 0.43047 0.19507 2.207 0.0414 * Acid.Conc. -0.07354 0.07216 -1.019 0.3224 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 1.912 Multiple R-squared: 0.9863, Adjusted R-squared: 0.9839 Convergence in IRWLS iterations Robustness weights: 5 observations c(1,3,4,13,21) are outliers with |weight| = 0 ( < 0.0048); one weight is ~= 1. The remaining 15 ones are summarized as Min. 1st Qu. Median Mean 3rd Qu. Max. 0.4126 0.7595 0.8726 0.8270 0.9718 0.9986 Algorithmic parameters: tuning.chi bb tuning.psi refine.tol 1.548e+00 5.000e-01 4.685e+00 1.000e-07 rel.tol scale.tol solve.tol eps.outlier 1.000e-07 1.000e-10 1.000e-07 4.762e-03 eps.x warn.limit.reject warn.limit.meanrw 1.692e-10 5.000e-01 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd fast.s.large.n 200 0 1000 0 2000 psi subsampling cov "bisquare" "nonsingular" ".vcov.w" compute.outlier.stats "S" seed : int(0) > set.seed(0) > m0a <- lmrob.S(m0$x, stack.loss, lmrob.control()) > > all.equal(m0[c('coefficients', 'scale', 'rweights')], + m0a[c('coefficients', 'scale', 'rweights')]) [1] TRUE > > ## MM > set.seed(0) > summary(m1 <- lmrob(stack.loss ~ ., data = stackloss, method = "MM", + compute.outlier.stats = "S")) Call: lmrob(formula = stack.loss ~ ., data = stackloss, method = "MM", compute.outlier.stats = "S") \--> method = "MM" Residuals: Min 1Q Median 3Q Max -10.50974 -1.43819 -0.09134 1.02503 7.23113 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) -41.52462 5.29780 -7.838 4.82e-07 *** Air.Flow 0.93885 0.11743 7.995 3.68e-07 *** Water.Temp 0.57955 0.26296 2.204 0.0416 * Acid.Conc. -0.11292 0.06989 -1.616 0.1246 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 1.912 Multiple R-squared: 0.9593, Adjusted R-squared: 0.9521 Convergence in 17 IRWLS iterations Robustness weights: observation 21 is an outlier with |weight| = 0 ( < 0.0048); 2 weights are ~= 1. The remaining 18 ones are summarized as Min. 1st Qu. Median Mean 3rd Qu. Max. 0.1215 0.8757 0.9428 0.8721 0.9797 0.9978 Algorithmic parameters: tuning.chi bb tuning.psi refine.tol 1.548e+00 5.000e-01 4.685e+00 1.000e-07 rel.tol scale.tol solve.tol eps.outlier 1.000e-07 1.000e-10 1.000e-07 4.762e-03 eps.x warn.limit.reject warn.limit.meanrw 1.692e-10 5.000e-01 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd fast.s.large.n 200 0 1000 0 2000 psi subsampling cov "bisquare" "nonsingular" ".vcov.avar1" compute.outlier.stats "S" seed : int(0) > > set.seed(0) > m2 <- update(m1, method = "SM") > > all.equal(m1[c('coefficients', 'scale', 'cov')], + m2[c('coefficients', 'scale', 'cov')]) [1] TRUE > > set.seed(0) > m3 <- update(m0, method = "SM", cov = '.vcov.w') > > ## SMD > set.seed(0) > summary(m4 <- lmrob(stack.loss ~ ., data = stackloss, method = "SMD", psi = 'bisquare', + compute.outlier.stats = "S")) Call: lmrob(formula = stack.loss ~ ., data = stackloss, method = "SMD", psi = "bisquare", compute.outlier.stats = "S") \--> method = "SMD" Residuals: Min 1Q Median 3Q Max -10.50974 -1.43819 -0.09134 1.02503 7.23113 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) -41.5246 8.9525 -4.638 0.000235 *** Air.Flow 0.9388 0.1175 7.990 3.71e-07 *** Water.Temp 0.5796 0.3199 1.812 0.087756 . Acid.Conc. -0.1129 0.1176 -0.960 0.350512 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 2.651 Multiple R-squared: 0.9593, Adjusted R-squared: 0.9521 Convergence in 17 IRWLS iterations Robustness weights: observation 21 is an outlier with |weight| = 0 ( < 0.0048); 2 weights are ~= 1. The remaining 18 ones are summarized as Min. 1st Qu. Median Mean 3rd Qu. Max. 0.1215 0.8757 0.9428 0.8721 0.9797 0.9978 Algorithmic parameters: tuning.chi bb tuning.psi refine.tol 1.548e+00 5.000e-01 4.685e+00 1.000e-07 rel.tol scale.tol solve.tol eps.outlier 1.000e-07 1.000e-10 1.000e-07 4.762e-03 eps.x warn.limit.reject warn.limit.meanrw 1.692e-10 5.000e-01 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd numpoints 200 0 1000 0 10 fast.s.large.n 2000 psi subsampling cov "bisquare" "nonsingular" ".vcov.w" compute.outlier.stats "S" seed : int(0) > summary(m4a <- lmrob..D..fit(m3)) Call: lmrob(formula = stack.loss ~ ., data = stackloss, method = "SMD", compute.outlier.stats = "S", cov = ".vcov.w") \--> method = "MM" Residuals: Min 1Q Median 3Q Max -10.50974 -1.43819 -0.09134 1.02503 7.23113 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) -41.5246 9.3676 -4.433 0.000365 *** Air.Flow 0.9388 0.1230 7.636 6.84e-07 *** Water.Temp 0.5796 0.3348 1.731 0.101505 Acid.Conc. -0.1129 0.1231 -0.917 0.371736 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 2.651 Multiple R-squared: 0.9593, Adjusted R-squared: 0.9521 Convergence in 17 IRWLS iterations Robustness weights: observation 21 is an outlier with |weight| = 0 ( < 0.0048); 2 weights are ~= 1. The remaining 18 ones are summarized as Min. 1st Qu. Median Mean 3rd Qu. Max. 0.1215 0.8757 0.9428 0.8721 0.9797 0.9978 Algorithmic parameters: tuning.chi bb tuning.psi refine.tol 1.548e+00 5.000e-01 4.685e+00 1.000e-07 rel.tol scale.tol solve.tol eps.outlier 1.000e-07 1.000e-10 1.000e-07 4.762e-03 eps.x warn.limit.reject warn.limit.meanrw 1.692e-10 5.000e-01 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd fast.s.large.n 200 0 1000 0 2000 psi subsampling cov "bisquare" "nonsingular" ".vcov.w" compute.outlier.stats "S" seed : int(0) > > ## rearrange m4a and update call > m4a <- m4a[names(m4)] > class(m4a) <- class(m4) > m4a$call <- m4$call > > all.equal(m4, m4a) [1] "Component \"control\": Component \"method\": 1 string mismatch" [2] "Component \"init\": Component \"control\": Component \"method\": 1 string mismatch" [3] "Component \"cov\": Attributes: < Component \"corrfact\": Mean relative difference: 0.1167673 >" [4] "Component \"cov\": Attributes: < Component \"scorr\": Mean relative difference: 0.01959345 >" [5] "Component \"cov\": Mean relative difference: 0.09488594" > > ## SMDM > set.seed(0) > summary(m5 <- lmrob(stack.loss ~ ., data = stackloss, method = "SMDM", psi = 'bisquare', + compute.outlier.stats = "S")) Call: lmrob(formula = stack.loss ~ ., data = stackloss, method = "SMDM", psi = "bisquare", compute.outlier.stats = "S") \--> method = "SMDM" Residuals: Min 1Q Median 3Q Max -9.6746 -1.7721 0.1346 1.2041 6.6080 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) -41.9398 9.7719 -4.292 0.000494 *** Air.Flow 0.8747 0.1231 7.107 1.76e-06 *** Water.Temp 0.8099 0.3363 2.408 0.027656 * Acid.Conc. -0.1188 0.1284 -0.926 0.367655 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 2.651 Multiple R-squared: 0.9384, Adjusted R-squared: 0.9275 Convergence in 17 IRWLS iterations Robustness weights: 2 weights are ~= 1. The remaining 19 ones are summarized as Min. 1st Qu. Median Mean 3rd Qu. Max. 0.1546 0.9139 0.9597 0.8874 0.9866 0.9966 Algorithmic parameters: tuning.chi bb tuning.psi refine.tol 1.548e+00 5.000e-01 4.685e+00 1.000e-07 rel.tol scale.tol solve.tol eps.outlier 1.000e-07 1.000e-10 1.000e-07 4.762e-03 eps.x warn.limit.reject warn.limit.meanrw 1.692e-10 5.000e-01 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd numpoints 200 0 1000 0 10 fast.s.large.n 2000 psi subsampling cov "bisquare" "nonsingular" ".vcov.w" compute.outlier.stats "S" seed : int(0) > summary(m5a <- lmrob..M..fit(obj=m4)) Call: lmrob(formula = stack.loss ~ ., data = stackloss, method = "SMDM", psi = "bisquare", compute.outlier.stats = "S") \--> method = "SMD" Residuals: Min 1Q Median 3Q Max -9.6746 -1.7721 0.1346 1.2041 6.6080 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) -41.9398 9.7719 -4.292 0.000494 *** Air.Flow 0.8747 0.1231 7.107 1.76e-06 *** Water.Temp 0.8099 0.3363 2.408 0.027656 * Acid.Conc. -0.1188 0.1284 -0.926 0.367655 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robust residual standard error: 2.651 Multiple R-squared: 0.9384, Adjusted R-squared: 0.9275 Convergence in 17 IRWLS iterations Robustness weights: 2 weights are ~= 1. The remaining 19 ones are summarized as Min. 1st Qu. Median Mean 3rd Qu. Max. 0.1546 0.9139 0.9597 0.8874 0.9866 0.9966 Algorithmic parameters: tuning.chi bb tuning.psi refine.tol 1.548e+00 5.000e-01 4.685e+00 1.000e-07 rel.tol scale.tol solve.tol eps.outlier 1.000e-07 1.000e-10 1.000e-07 4.762e-03 eps.x warn.limit.reject warn.limit.meanrw 1.692e-10 5.000e-01 5.000e-01 nResample max.it best.r.s k.fast.s k.max 500 50 2 1 200 maxit.scale trace.lev mts compute.rd numpoints 200 0 1000 0 10 fast.s.large.n 2000 psi subsampling cov "bisquare" "nonsingular" ".vcov.w" compute.outlier.stats "S" seed : int(0) > > ## rearrange m5a > m5a <- m5a[names(m5)] > class(m5a) <- class(m5) > > all.equal(m5, m5a) [1] "Component \"control\": Component \"method\": 1 string mismatch" [2] "Component \"init\": Component \"control\": Component \"method\": 1 string mismatch" [3] "Component \"init\": Component \"init\": Component \"control\": Component \"method\": 1 string mismatch" > > ## Fast S large n strategy (sped up) > model <- model.frame(LNOx ~ . ,data = NOxEmissions) > control <- lmrob.control(fast.s.large.n = 10, n.group = 341, groups = 2) > set.seed(0) > try(ret <- lmrob.S(model.matrix(model, NOxEmissions)[1:682,], NOxEmissions$LNOx[1:682], control)) Error in lmrob.S(model.matrix(model, NOxEmissions)[1:682, ], NOxEmissions$LNOx[1:682], : Fast S large n strategy failed. Use control parameter 'fast.s.large.n = Inf'. In addition: Warning message: In lmrob.S(model.matrix(model, NOxEmissions)[1:682, ], NOxEmissions$LNOx[1:682], : 'control$n.group' is not much larger than 'p', probably too small > ## do what the error says > control <- lmrob.control(fast.s.large.n = Inf) > try(ret <- lmrob.S(model.matrix(model, NOxEmissions)[1:682,], NOxEmissions$LNOx[1:682], control)) Error in lmrob.S(model.matrix(model, NOxEmissions)[1:682, ], NOxEmissions$LNOx[1:682], : DGEEQU: column 30 of the design matrix is exactly zero. > ## this still fails, but this error is to be expected since only a part > ## of the design matrix is given > > proc.time() user system elapsed 0.203 0.043 0.240 robustbase/tests/binom-ni-small.Rout.save0000644000176200001440000002756212553432042020227 0ustar liggesusers R Under development (unstable) (2015-07-18 r68693) -- "Unsuffered Consequences" Copyright (C) 2015 The R Foundation for Statistical Computing Platform: x86_64-unknown-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(robustbase) > > ### Binomial example with *small* ni > > N <- 51 > set.seed(123) > table(ni <- rpois(N, lam=4))# has 4 '1's, (no '0') 1 2 3 4 5 6 7 8 10 4 8 10 9 7 4 5 3 1 > n0 <- ni; n0[print(which(ni == 1)[1:2])] <- 0 # has two '0's [1] 6 18 > x <- seq(0,1, length=N) > pr.x <- plogis(5*(x - 1/2)) > k <- rbinom(N, size = ni, prob = pr.x) > k0 <- rbinom(N, size = n0, prob = pr.x) > cbind(k,ni, k0,n0) k ni k0 n0 [1,] 0 3 0 3 [2,] 1 6 2 6 [3,] 0 3 0 3 [4,] 1 6 2 6 [5,] 0 7 2 7 [6,] 0 1 0 0 [7,] 1 4 1 4 [8,] 2 7 1 7 [9,] 0 4 0 4 [10,] 1 4 2 4 [11,] 0 8 1 8 [12,] 0 4 0 4 [13,] 0 5 3 5 [14,] 2 4 1 4 [15,] 0 2 0 2 [16,] 3 7 2 7 [17,] 2 3 2 3 [18,] 1 1 0 0 [19,] 1 3 1 3 [20,] 4 8 2 8 [21,] 3 7 3 7 [22,] 3 5 1 5 [23,] 0 5 2 5 [24,] 4 10 3 10 [25,] 1 5 2 5 [26,] 2 5 5 5 [27,] 2 4 3 4 [28,] 3 4 4 4 [29,] 3 3 3 3 [30,] 2 2 1 2 [31,] 4 8 5 8 [32,] 5 7 3 7 [33,] 3 5 3 5 [34,] 6 6 3 6 [35,] 1 1 1 1 [36,] 1 4 3 4 [37,] 3 5 3 5 [38,] 1 2 1 2 [39,] 3 3 1 3 [40,] 2 2 2 2 [41,] 2 2 2 2 [42,] 3 3 3 3 [43,] 2 3 3 3 [44,] 3 3 3 3 [45,] 2 2 1 2 [46,] 1 2 2 2 [47,] 2 2 2 2 [48,] 4 4 4 4 [49,] 3 3 3 3 [50,] 5 6 5 6 [51,] 1 1 1 1 > g1 <- glm(cbind(k , ni-k ) ~ x, family = binomial) > coef(summary(g1))[,1:2] Estimate Std. Error (Intercept) -2.515884 0.3784211 x 5.123650 0.7344629 > g0 <- glm(cbind(k0, n0-k0) ~ x, family = binomial)# works too > g0. <- glm(cbind(k0, n0-k0) ~ x, family = binomial, subset = n0 > 0) > ## all.equal(g0, g0.) > stopifnot(all.equal(print(coef(summary(g0))), coef(summary(g0.)))) Estimate Std. Error z value Pr(>|z|) (Intercept) -1.913157 0.3346560 -5.716786 1.085574e-08 x 4.061024 0.6512647 6.235596 4.500620e-10 > > > rg1 <- glmrob(cbind(k , ni-k ) ~ x, family = binomial) > rg1. <- glmrob(cbind(k , ni-k ) ~ x, family = binomial, + acc = 1e-10) # default is just 1e-4 > > stopifnot(all.equal(unname(coef(rg1.)), c(-2.37585864, 4.902389143), tolerance=1e-9), + all.equal(coef(rg1), coef(rg1.), tolerance=1e-4), + all.equal(vcov(rg1.), vcov(rg1), tolerance = 1e-4)) > rg1$iter [1] 5 > which(rg1.$w.r != 1) ## 7 of them : [1] 11 18 23 29 34 36 46 > str(rg1.["family" != names(rg1.)]) List of 27 $ coefficients : Named num [1:2] -2.38 4.9 ..- attr(*, "names")= chr [1:2] "(Intercept)" "x" $ residuals : Named num [1:51] -0.528 0.622 -0.582 0.435 -0.981 ... ..- attr(*, "names")= chr [1:51] "1" "2" "3" "4" ... $ fitted.values : Named num [1:51] 0.085 0.093 0.102 0.111 0.121 ... ..- attr(*, "names")= chr [1:51] "1" "2" "3" "4" ... $ w.r : num [1:51] 1 1 1 1 1 1 1 1 1 1 ... $ w.x : num [1:51] 1 1 1 1 1 1 1 1 1 1 ... $ ni : num [1:51] 3 6 3 6 7 1 4 7 4 4 ... $ dispersion : num 1 $ cov : num [1:2, 1:2] 0.144 -0.253 -0.253 0.55 ..- attr(*, "dimnames")=List of 2 .. ..$ : chr [1:2] "(Intercept)" "x" .. ..$ : chr [1:2] "(Intercept)" "x" $ matM : num [1:2, 1:2] 0.625 0.287 0.287 0.163 ..- attr(*, "dimnames")=List of 2 .. ..$ : chr [1:2] "(Intercept)" "x" .. ..$ : chr [1:2] "(Intercept)" "x" $ matQ : num [1:2, 1:2] 0.551 0.252 0.252 0.143 ..- attr(*, "dimnames")=List of 2 .. ..$ : chr [1:2] "(Intercept)" "x" .. ..$ : chr [1:2] "(Intercept)" "x" $ tcc : num 1.34 $ linear.predictors: Named num [1:51] -2.38 -2.28 -2.18 -2.08 -1.98 ... ..- attr(*, "names")= chr [1:51] "1" "2" "3" "4" ... $ deviance : NULL $ iter : int 11 $ y : Named num [1:51] 0 0.167 0 0.167 0 ... ..- attr(*, "names")= chr [1:51] "1" "2" "3" "4" ... $ converged : logi TRUE $ model :'data.frame': 51 obs. of 2 variables: ..$ cbind(k, ni - k): int [1:51, 1:2] 0 1 0 1 0 0 1 2 0 1 ... .. ..- attr(*, "dimnames")=List of 2 .. .. ..$ : NULL .. .. ..$ : chr [1:2] "k" "" ..$ x : num [1:51] 0 0.02 0.04 0.06 0.08 0.1 0.12 0.14 0.16 0.18 ... ..- attr(*, "terms")=Classes 'terms', 'formula' language cbind(k, ni - k) ~ x .. .. ..- attr(*, "variables")= language list(cbind(k, ni - k), x) .. .. ..- attr(*, "factors")= int [1:2, 1] 0 1 .. .. .. ..- attr(*, "dimnames")=List of 2 .. .. .. .. ..$ : chr [1:2] "cbind(k, ni - k)" "x" .. .. .. .. ..$ : chr "x" .. .. ..- attr(*, "term.labels")= chr "x" .. .. ..- attr(*, "order")= int 1 .. .. ..- attr(*, "intercept")= int 1 .. .. ..- attr(*, "response")= int 1 .. .. ..- attr(*, ".Environment")= .. .. ..- attr(*, "predvars")= language list(cbind(k, ni - k), x) .. .. ..- attr(*, "dataClasses")= Named chr [1:2] "nmatrix.2" "numeric" .. .. .. ..- attr(*, "names")= chr [1:2] "cbind(k, ni - k)" "x" $ call : language glmrob(formula = cbind(k, ni - k) ~ x, family = binomial, acc = 1e-10) $ formula :Class 'formula' language cbind(k, ni - k) ~ x .. ..- attr(*, ".Environment")= $ terms :Classes 'terms', 'formula' language cbind(k, ni - k) ~ x .. ..- attr(*, "variables")= language list(cbind(k, ni - k), x) .. ..- attr(*, "factors")= int [1:2, 1] 0 1 .. .. ..- attr(*, "dimnames")=List of 2 .. .. .. ..$ : chr [1:2] "cbind(k, ni - k)" "x" .. .. .. ..$ : chr "x" .. ..- attr(*, "term.labels")= chr "x" .. ..- attr(*, "order")= int 1 .. ..- attr(*, "intercept")= int 1 .. ..- attr(*, "response")= int 1 .. ..- attr(*, ".Environment")= .. ..- attr(*, "predvars")= language list(cbind(k, ni - k), x) .. ..- attr(*, "dataClasses")= Named chr [1:2] "nmatrix.2" "numeric" .. .. ..- attr(*, "names")= chr [1:2] "cbind(k, ni - k)" "x" $ data : $ offset : NULL $ control :List of 4 ..$ acc : num 1e-10 ..$ test.acc: chr "coef" ..$ maxit : num 50 ..$ tcc : num 1.34 $ method : chr "Mqle" $ prior.weights : num [1:51] 1 1 1 1 1 1 1 1 1 1 ... $ contrasts : NULL $ xlevels : Named list() > > rg2 <- glmrob(cbind(k , ni-k ) ~ x, family = binomial, + acc = 1e-10, tcc = 3) # large cutoff: almost classical > vcov(rg2) # << already close to limit (Intercept) x (Intercept) 0.1430407 -0.2501886 x -0.2501886 0.5388665 > rg10 <- glmrob(cbind(k , ni-k ) ~ x, family = binomial, tcc = 10) > rgL <- glmrob(cbind(k , ni-k ) ~ x, family = binomial, tcc = 100) > > no.comp <- - match(c("call", "data", "family", "control", "tcc"), names(rg10)) > stopifnot(all.equal(rg10[no.comp], rgL[no.comp], tolerance= 1e-14)) > > vcov(rgL) # is now the same as the following: (Intercept) x (Intercept) 0.1432102 -0.2504843 x -0.2504843 0.5394659 > if(FALSE) { ## tcc=Inf fails: non-convergence / singular matrix from GOTO/Atlas3 + rgI <- glmrob(cbind(k , ni-k ) ~ x, family = binomial, tcc = Inf) + ## tcc = Inf still *FAILS* (!) + stopifnot(all.equal(rgL[no.comp], rgI[no.comp], tolerance= 0)) + ## and is quite close to the classic one: + (all.equal(vcov(rgI), vcov(g1))) + } > > rg0 <- glmrob(cbind(k0, n0-k0) ~ x, family = binomial) Warning message: In glmrobMqle(X = X, y = Y, weights = weights, start = start, offset = offset, : fitted probabilities numerically 0 or 1 occurred > ## --> warning.. > rg0. <- glmrob(cbind(k0, n0-k0) ~ x, family = binomial, subset = n0 > 0) > > coef(summary(rg0)) # not yet good (cf. 'g0' above!) -- but the one of rg0. is Estimate Std. Error z value Pr(>|z|) (Intercept) -1.852918 NaN NaN NaN x 3.847520 NaN NaN NaN > stopifnot(all.equal(coef(rg0), coef(rg0.))) > > > ### Example where all ni >= 3 -- works better, now also correct as.var. !! > ### ----------------- ======= > > min(n3 <- ni + 2)# = 3 [1] 3 > k3 <- rbinom(N, size = n3, prob = pr.x) > g3 <- glm(cbind(k3 , n3-k3) ~ x, family = binomial) > (cfg <- coef(summary(g3))[,1:2]) Estimate Std. Error (Intercept) -2.945565 0.3420351 x 5.546417 0.6259260 > stopifnot(all.equal(sqrt(diag(vcov(g3))), cfg[,2])) > > rg3 <- glmrob(cbind(k3 , n3-k3) ~ x, family = binomial) > (s3 <- summary(rg3)) Call: glmrob(formula = cbind(k3, n3 - k3) ~ x, family = binomial) Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) -2.8901 0.3499 -8.260 <2e-16 *** x 5.5039 0.6447 8.537 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robustness weights w.r * w.x: 48 weights are ~= 1. The remaining 3 ones are 42 44 51 0.5127 0.7846 0.7388 Number of observations: 51 Fitted by method 'Mqle' (in 5 iterations) (Dispersion parameter for binomial family taken to be 1) No deviance values available Algorithmic parameters: acc tcc 0.0001 1.3450 maxit 50 test.acc "coef" > summary(rg3$w.r) Min. 1st Qu. Median Mean 3rd Qu. Max. 0.5127 1.0000 1.0000 0.9811 1.0000 1.0000 > rg3.5 <- glmrob(cbind(k3 , n3-k3) ~ x, family = binomial, tcc = 5) > (s3.5 <- summary(rg3.5)) Call: glmrob(formula = cbind(k3, n3 - k3) ~ x, family = binomial, tcc = 5) Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) -2.9454 0.3420 -8.611 <2e-16 *** x 5.5461 0.6259 8.861 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robustness weights w.r * w.x: All 51 weights are ~= 1. Number of observations: 51 Fitted by method 'Mqle' (in 1 iterations) (Dispersion parameter for binomial family taken to be 1) No deviance values available Algorithmic parameters: acc 1e-04 maxit tcc 50 5 test.acc "coef" > summary(rg3.5$w.r)# all 1 Min. 1st Qu. Median Mean 3rd Qu. Max. 1 1 1 1 1 1 > stopifnot(all.equal(coef(s3)[,1:2], coef(s3.5)[,1:2], tolerance = 0.02)) > > rg3.15 <- glmrob(cbind(k3 , n3-k3) ~ x, family = binomial, tcc = 15, acc=1e-10) > (s3.15 <- summary(rg3.15)) Call: glmrob(formula = cbind(k3, n3 - k3) ~ x, family = binomial, tcc = 15, acc = 1e-10) Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) -2.9456 0.3420 -8.612 <2e-16 *** x 5.5464 0.6259 8.861 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Robustness weights w.r * w.x: All 51 weights are ~= 1. Number of observations: 51 Fitted by method 'Mqle' (in 1 iterations) (Dispersion parameter for binomial family taken to be 1) No deviance values available Algorithmic parameters: acc 1e-10 maxit tcc 50 15 test.acc "coef" > > stopifnot(all.equal(coef(s3.15)[,1:2], cfg, tolerance = 1e-5),# 2e-6 + all.equal(cfg[,"Estimate"], rg3.15$coeff, tolerance= 1e-8) # 6.05e-10 + ) > ##rg3.15$eff # == 1 > > ## doesn't change any more: > rg3.1000 <- glmrob(cbind(k3 , n3-k3) ~ x, family = binomial, tcc = 1000, + acc=1e-10) > stopifnot(all.equal(rg3.1000[no.comp], + rg3.15 [no.comp], tol = 1e-13)) > > cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' Time elapsed: 0.389 0.082 0.561 0 0.008 > > proc.time() user system elapsed 0.389 0.090 0.561 robustbase/tests/mc-etc.R0000644000176200001440000000670613325654361015101 0ustar liggesusers #### Testing medcouple and related functions ### Strict (and timing) tests are in ./mc-strict.R ### ~~~~~~~~~~~~ ### Here, we produce output which is *compared* with ./mc-etc.Rout.save library(robustbase) source(system.file("xtraR/mcnaive.R", package = "robustbase"))# mcNaive() ## This is somewhat interesting {diff the output !} ## particularly since *most* give the 'not found' diagnostic set.seed(17) for(n in 1:100) { cat(sprintf("n =%3d:\n------\n", n)) mcval <- mc(rlnorm(n), trace=TRUE, doRefl=FALSE) cat(sprintf(" --> mc(rlnorm(%d)) = %.6f\n", n, mcval)) } allEQ <- function(x,y) all.equal(x,y, tolerance = 1e-12) x3 <- c(-2, rep(-1,4), rep(0,6), 2, 2, 2:4) mcNaive(x3,"h.use") # 1/3 mcNaive(x3,"simple")# 0 mcComp <- robustbase:::mcComp mcComp. <- function (x, doScale, doReflect = FALSE, maxit = 15, eps1 = 1e-13, eps2 = eps1, trace.lev = 1, ...) { mcComp(x, doReflect=doReflect, doScale=doScale, maxit=maxit, eps1=eps1, eps2=eps2, trace.lev=trace.lev, ...) } try( mc(x3, doRefl = FALSE, maxit = 15, trace = 3)) ## "non-convergence" (32-bit) str(mcComp.(-x3, doScale=TRUE, trace = 4)) ### And here is the "real" problem of the whole 'eps' idea: x4 <- c(1:5,7,10,15,25, 1e15) ## this is also in mc-strict.R (but differently) mcNaive(x4,"h.use") # 0.5833333 mcNaive(x4,"simple")# == " == 7/12 mc(x4) # now ok, == 7/12 str(mcComp.( x4, doScale=TRUE, trace= 3))## = 0: conv.quickly str(mcComp.(-x4, doScale=TRUE, trace= 3)) # *not* conv! if(FALSE) { ## a much more extreme eps seems the cure: str(mcComp.( x4, doScale=TRUE, eps1=.Machine$double.xmin)) str(mcComp.(-x4, doScale=TRUE, eps1=.Machine$double.xmin)) } ### Examples "like x3" (non-convergence on 32-bit) xClist <- list(## length 5 : c(0,0, 1, 3,3), c(0,0, 1, 3:4), ## ## length 6 : c(0,0, 2, 4:6), c(0,0, 2, 3, 4, 6), c(0,0, 4, 5, 7, 8), c(0, 1,1, 2, 6,6), c(0, 3,3, 4, 6,6), c(0,0, 1, 3, 5,5), c(0,0, 1, 4,4, 6), c(0,0, 1, 4,4, 7), c(0,0, 1, 5,5, 6), ## n = 9 : c(-2,-2,-2, -1,-1, 1,1,1, 3), c(-3,-1,-1, 0, 1, 2,2,2,2) ) rlis <- lapply(xClist, function(x) try(mc(x, maxit=9), silent=TRUE)) table(sapply(rlis, class)) ## if(R.version$arch == "x86_64") { print(unlist(rlis)) rl2 <- lapply(xClist, mc, maxit=9) ##, eps1= 1e-10) stopifnot(allEQ(rlis, rl2), allEQ(unlist(rlis), sapply(xClist, mcNaive))) ##} set.seed(47) for(n in 3:60) { cat(" ") x <- round(2 * rnorm(n)) # many ties, often at median -- not converging ## if(R.version$arch == "x86_64") { ## non-convergence BUG rarely and only on 32-bit (solved, MK) mc1 <- mc(x) mc2 <- mcNaive(x, method = "simple") mc3 <- mcNaive(x, method = "h.use") stopifnot(allEQ(mc1, mc3)) if(mc2 != mc3) { cat("d"); if(!isTRUE(allEQ(mc2, mc3))) cat("!!") } ## } cat(".") }; cat("\n") cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' quit('no') ## ------ ## Find short example of non-convergence (32-bit) --> for above xClist n <- 9 for(ii in 1:100) { x <- round(2 * rnorm(n)) # many ties, often at median -- not converging mc1 <- mc(x) } ## x5 <- c(-3, -3, -2, -1, -1, 0, 0, 1, 2, 2, 3, 4) x6 <- c(-5, -2, -1, -1, -1, 0, 0, 0, 2, 2, 2, 4) robustbase/tests/psi-rho-etc.R0000644000176200001440000001464712271657124016065 0ustar liggesusersrequire(robustbase) ## see also ./lmrob-psifns.R <<<<<<<< source(system.file("xtraR/plot-psiFun.R", package = "robustbase", mustWork=TRUE)) EQ <- function(x,y) all.equal(x,y, tolerance = 1e-13) ## Demonstrate that one of tukeyChi() / tukeyPsi1() is superfluous x <- seq(-4,4, length=201) suppressWarnings(## as tukeyPsi1(), tukeyChi() are deprecated for(c. in c(0.1, 1:2, pi, 100)) { ix <- abs(x) != c. stopifnot(EQ(tukeyChi(x, c.), 6/c.^2* tukeyPsi1(x, c., deriv=-1)), EQ(tukeyChi(x, c., deriv= 1), 6/c.^2* tukeyPsi1(x, c., deriv= 0)), EQ(tukeyChi(x, c., deriv= 2), 6/c.^2* tukeyPsi1(x, c., deriv= 1)), ## Now show equivalence with Mpsi(): EQ(tukeyPsi1(x, c.), Mpsi(x, c., "tukey")), EQ(tukeyPsi1(x, c., d=1), Mpsi(x, c., "tukey", d=1)), EQ(tukeyPsi1(x[ix], c., d=2), Mpsi(x[ix], c., "tukey", d=2)) ) } ) ## Test if default arguments are used h2Psi <- chgDefaults(huberPsi, k = 2) x <- 1:10 stopifnot(h2Psi@ rho(x, k=2) == h2Psi@ rho(x), h2Psi@ psi(x, k=2) == h2Psi@ psi(x), h2Psi@Dpsi(x, k=2) == h2Psi@Dpsi(x), h2Psi@ wgt(x, k=2) == h2Psi@ wgt(x), h2Psi@Dwgt(x, k=2) == h2Psi@Dwgt(x)) ## Test default arguments for E... slots stopifnot(EQ(h2Psi@Erho (), 0.49423127328548), EQ(h2Psi@Epsi2(), 0.920536925636323), EQ(h2Psi@EDpsi(), 0.954499736103642)) stopifnot(EQ(1, huberPsi@psi(1, k = 1e16)), huberPsi@wgt(0.1591319494080224, 0.5 + 1/13) <= 1) ## both used to fail because of numeric instability in pmin2/pmax2 f1 <- function(.) rep.int(1, length(.)) F1 <- function(x, .) rep.int(1, length(x)) ## correct "classical psi": cPs <- psiFunc(rho = function(x,.) x^2 / 2, psi = function(x, .) x, wgt = F1, Dpsi = F1, Erho = function(.) rep.int(1/2, length(.)), Epsi2 = f1, EDpsi = f1, . = Inf) validObject(cPs); cPs ## incorrect dummy psi cP <- psiFunc(rho = F1, psi = F1, wgt = F1, Dpsi = F1, Erho = f1, Epsi2 = f1, EDpsi = f1, . = Inf) cP ## Check the autogenerated Dwgt(): x <- seq(0,2, by=1/4) stopifnot(## strict symmetry { including Dwgt(0) == 0 } : huberPsi @Dwgt(-x) == -huberPsi @Dwgt(x), hampelPsi@Dwgt(-x) == -hampelPsi@Dwgt(x), huberPsi @Dwgt(x)[x < 1.345] == 0, hampelPsi@Dwgt(x)[x < 1.487] == 0, EQ(huberPsi @Dwgt(x[x >= 1.5]), c(-0.597777777777778, -0.439183673469388, -0.33625)), EQ(hampelPsi@Dwgt(x[x >= 1.5]), c(-0.660883932259397, -0.485547378802822, -0.371747211895911)) ) .defDwgt <- robustbase:::.defDwgt (ddd <- .defDwgt(psi = function(u, k) pmin.int(k, pmax.int(-k, u)), Dpsi = function(u, k) abs(u) <= k)) stopifnot(is.function(ddd), names(formals(ddd)) == c("u","k"), EQ(ddd(x, 1.345), huberPsi@Dwgt(x))) ## TODO: Provide some functionality of this as a Plot+Check function ## ---- and then call the function for all our psiFunc objects (with different 'k') kk <- c(1.5, 3, 8) psiH.38 <- chgDefaults(hampelPsi, k = kk) c1 <- curve(psiH.38@psi(x), -10, 10, n=512, col=2) abline(h=0, v=0, lty=3, lwd=.5, col="gray25") c2 <- curve(x * psiH.38@wgt(x), add=TRUE, n=512, col=adjustcolor("blue", .5), lwd=2) title("psi_Hampel_(1.5, 3, 8) : psi(x) = x * wgt(x)") axis(1, at=kk, expression(k[1], k[2], k[3]), pos=0) axis(2, at=kk[1], quote(k[1]), pos=0, las=1) stopifnot(all.equal(c1,c2, tolerance= 1e-15)) r1 <- curve(psiH.38@rho(x), -10, 10, col=2, main = quote(rho(x) == integral(phi(t) * dt, 0, x))) axis(1, at=kk, expression(k[1], k[2], k[3]), pos=0) curve(psiH.38@psi(x), add=TRUE, n=512, col=adjustcolor("blue", .5), lwd=2) abline(h=0, v=0, lty=3, lwd=.5, col="gray25") ## check rho(x) = \int_0^x psi(x) dx {slightly *more* than rho' = psi !} rhoH.38.int <- function(x) integrate(function(u) psiH.38@psi(u), 0, x, rel.tol=1e-10)$value r2 <- curve(sapply(x, rhoH.38.int), add = TRUE, lwd=4, col=adjustcolor("red", 1/4)) ## numerical integration == "formula" : stopifnot(all.equal(r1,r2, tolerance=1e-10)) curve(psiH.38@Dpsi(x), -10, 10, n=512, col=2, main = quote(psi*minute(x))) abline(h=0, v=0, lty=3, lwd=.5, col="gray25") ## check rho'(x) = phi(x) etc {TODO: for all our psiFun.} head(xx <- seq(-10, 10, length=1024)) FrhoH.38 <- splinefun(xx, rho.x <- psiH.38@rho (xx)) FpsiH.38 <- splinefun(xx, psi.x <- psiH.38@psi (xx)) F1psH.38 <- splinefun(xx, Dps.x <- psiH.38@Dpsi(xx)) curve(FpsiH.38(x, deriv=1), -10,10, n=512) curve(F1psH.38, add=TRUE, col=4, n=512) stopifnot(all.equal(FpsiH.38(xx, deriv=1), Dps.x, tolerance = 0.02))# not better because of discontinuities curve(FrhoH.38(x, deriv=1), -10,10, n=512) curve(FpsiH.38, add=TRUE, col=4, n=512) stopifnot(all.equal(FrhoH.38(xx, deriv=1), psi.x, tolerance = 1e-4)) E.norm <- function(FUN, tol=1e-12, ...) { integrate(function(x) FUN(x) * dnorm(x), -Inf, Inf, rel.tol=tol, ...)$value } ##' asymptotic efficiency -- both integrate + "formula"(@Epsi, @EDpsi) version aeff.P <- function(psiF, k, ...) { stopifnot(is(psiF, "psi_func")) if(!missing(k)) psiF <- chgDefaults(psiF, k = k) ## E[ psi'(X) ] ^2 / E[ psi(X) ^ 2 ] : c(int = E.norm(psiF@Dpsi, ...)^2 / E.norm(function(x) psiF@psi(x)^2, ...), form= psiF@EDpsi()^2 / psiF@Epsi2()) } ## Breakdown Point --- for redescenders only, ## both integrate + "formula"(@Erho) version bp.P <- function(psiF, k, ...) { stopifnot(is(psiF, "psi_func")) if(!missing(k)) psiF <- chgDefaults(psiF, k = k) if(!is.finite( rhoInf <- psiF@rho(Inf) )) stop("rho(Inf) is not finite: ", rhoInf) integ <- function(x) psiF@rho(x) c(int = E.norm(integ, ...), form= psiF@Erho()) / rhoInf } ## Print & Check the result of aeff.P() or bp.P() chkP <- function(rp, tol = 1e-9) { print(rp) ae <- all.equal(rp[[1]], rp[[2]], tolerance=tol) if(isTRUE(ae)) invisible(rp) else stop(ae) } chkP(aeff.P(huberPsi)) chkP(aeff.P(huberPsi, k = 1.5)) chkP(aeff.P(huberPsi, k = 2)) chkP(aeff.P(huberPsi, k = 2.5)) chkP(aeff.P(hampelPsi)) chkP(aeff.P(hampelPsi, k = c(1.5, 3, 8))) chkP(aeff.P(hampelPsi, k = c(2, 4, 8), tol=1e-10),# fails with tol=1e-11 tol = 1e-4) ## Now works too: chkP(bp.P(hampelPsi)) chkP(bp.P(hampelPsi, k = c(1.5, 3, 8))) chkP(bp.P(hampelPsi, k = c(2, 4, 8))) ## test derivatives (adapted from ./lmrob-psifns.R) head(x. <- seq(-5, 10, length=1501)) ## [separate lines, for interactive "play": ] stopifnot(chkPsiDeriv(plot(huberPsi, x.))) ## ToDo: improve accuracy of derivative check stopifnot(chkPsiDeriv(plot(hampelPsi, x.), tol=c(1e-4, 1e-1))) robustbase/tests/NAcoef.R0000644000176200001440000001407313344170716015056 0ustar liggesusers## test handing of NA coefficients / singular fits ## also check: ## -- what would have to be done if class "lm" was added. ## -- general compatibility to class lm. require(robustbase) source(system.file("test-tools-1.R", package="Matrix", mustWork=TRUE)) ##-> assertError(), etc options(digits = 5)# -> higher chance of platform independence ## generate simple example data (almost as in ./weights.R ) data <- expand.grid(x1=letters[1:3], x2=LETTERS[1:3], rep=1:3) set.seed(1) data$y <- rnorm(nrow(data)) ## drop all combinations of one interaction: data <- subset(data, x1 != 'c' | (x2 != 'B' & x2 != 'C')) ## add collinear variables data$x3 <- rnorm(nrow(data)) data$x4 <- rnorm(nrow(data)) data$x5 <- data$x3 + data$x4 ## add some NA terms data$y[1] <- NA data$x4[2:3] <- NA ## to test anova ## Classical models start with 'cm', robust just with 'rm' (or just 'm'): cm0 <- lm (y ~ x1*x2 + x3, data) cm1 <- lm (y ~ x1*x2 + x3 + x4 + x5, data) set.seed(2) rm1 <- lmrob(y ~ x1*x2 + x3 + x4 + x5, data) m3 <- lmrob(y ~ x1*x2 + x3 + x4, data) # same column space as rm1 rm0 <- lmrob(y ~ x1*x2 + x3, data) ## clean version of rm1 (to check predict) data2 <- data.frame(y=data$y[-(1:3)], rm1$x[,!is.na(rm1$coef)]) set.seed(2) rm1c <- lmrob(y ~ x1b + x1c + x2B + x2C + x3 + x4 + x1b:x2B + x1b:x2C, data2) ## add class lm to rm1 (for now) class(rm1) <- c(class(rm1), "lm") class(rm0) <- c(class(rm0), "lm") ## the full matrix (data) should be returned by model matrix (frame) stopifnot(all.equal(model.matrix(cm1), model.matrix(rm1)), all.equal(model.frame (cm1), model.frame (rm1))) ## qr decomposition should be for the full data and pivots identical lm result qr.cm1 <- qr(cm1)$qr qr.rm1 <- rm1$qr$qr stopifnot(NCOL(qr.rm1) == NCOL(qr.cm1), NROW(qr.rm1) == NROW(qr.cm1), length(rm1$qr$qraux) == length(qr(cm1)$qraux), all.equal(rm1$qr$pivot, qr(cm1)$pivot), all.equal(dimnames(qr.rm1),dimnames(qr.cm1))) ## the alias function should return the same result stopifnot(all.equal(alias(cm1), alias(rm1))) #### ## these helper functions should print NAs for the dropped coefficients print(rm1) summary(rm1) -> s1 confint(rm1) -> ci1 stopifnot(identical(is.na(coef(cm1)), apply(ci1, 1L, anyNA)), identical(sigma(rm1), s1$ sigma), identical(vcov(rm1, complete=FALSE), s1$ cov ), TRUE) print(s1, showAlgo=FALSE) ci1 ## drop1 should return df = 0 #drop1(rm1) ## drop.lm does not return valid results (yet)! #### ## methods that should just drop the NA coefficients ## m3 is actually the same as rm1, so anova should raise an error assertError(anova(rm1, m3, test="Wald")) assertError(anova(rm1, m3, test="Deviance")) ## but comparing rm1 and rm0 should be ok anova(rm1, rm0, test="Wald") anova(rm1, rm0, test="Deviance") ## commands with single #: ## they do (or might) not return sensible results for robust fits ## and need to be checked again #cooks.distance(rm1) #deviance(rm1) #dfbeta(rm1) #dfbetas(rm1) #effects(rm1) ## fails #extractAIC(rm1) #influence(rm1) stopifnot(all.equal(hv1 <- hatvalues(rm1), .lmrob.hat(wqr=rm1$qr), tol=1e-15), all.equal(hv1, stats:::hatvalues.lm(rm1), tol=1e-15), all.equal(hat(cm1$qr), unname(hatvalues(cm1)), tol=1e-15), all.equal(unname(hv1), hat(rm1$qr), tol=1e-15), ## ditto : all.equal(hv1c <- hatvalues(rm1c), stats:::hatvalues.lm(rm1c), tol=1e-15)) ## kappa() & labels() : stopifnot(is.infinite(kr1 <- kappa(rm1)), kr1 == kappa(cm1), # = +Inf both identical(labels(rm1), labels(cm1))) logLik(rm1)# well, and what does it mean? ## plot(rm1, which=1) ## plot.lmrob() fails "singular covariance" .. FIXME! par(mfrow=c(2,2)) plot(rm1, which=2:4) stopifnot(all.equal(predict(rm1), predict(rm1c), tol=1e-15), all.equal(predict(rm1, se.fit=TRUE, interval="confidence"), predict(rm1c, se.fit=TRUE, interval="confidence"), tol=1e-15)) predict(rm1, type="terms", se.fit=TRUE, interval="confidence") #proj(rm1) ## fails "FIXME" residuals(rm1) #rstandard(rm1) #rstudent(rm1) #simulate(rm1) ## just $weights needs to be changed to prior weights V1 <- vcov(rm1, complete=FALSE) ## but don't show the "eigen" part {vectors may flip sign}: attributes(V1) <- attributes(V1)[c("dim","dimnames", "weights")]; V1 set.seed(12); sc <- simulate(cm1, 64) set.seed(12); rc <- simulate(rm1, 64) stopifnot(all.equal(sqrt(diag(V1)), coef(summary(rm1))[,"Std. Error"], tol=1e-15), all.equal(sc, rc, tolerance = 0.08),# dimension *and* approx. values (no NA) identical(variable.names(rm1), variable.names(cm1)), all.equal(residuals(rm1), residuals(cm1), tolerance = 0.05),# incl. names all.equal(rstudent (rm1), rstudent (cm1), tolerance = 0.06), identical(dimnames(rm1), dimnames(cm1)), all.equal(dummy.coef(rm1), dummy.coef(cm1), tolerance= .5)) ## check mostly structure ## other helper functions stopifnot(identical(case.names(rm1), case.names(cm1)), all.equal(family(rm1), family(cm1)),# identical() upto environment identical(formula(rm1), formula(cm1)), nobs(rm1) == nobs(cm1)) #add1(rm0, ~ . + x3 + x4 + x5) ## does not return valid results (yet)! ## test other initial estimators lmrob(y ~ x1*x2 + x3 + x4 + x5, data, init="M-S") lmrob(y ~ x1*x2 + x3 + x4 + x5, data, init=lmrob.lar) ## test all zero design matrix data <- data.frame(y=1:10,x1=0,x2=0,os=2,w=c(0.5, 1)) (m5 <- lmrob(y ~ 1+x1+x2+offset(os), data, weights=w)) (sm5 <- summary(m5)) (m6 <- lmrob(y ~ 0+x1+x2+offset(os), data, weights=w)) (sm6 <- summary(m6)) sc5 <- summary(cm5 <- lm(y ~ 1+x1+x2+offset(os), data, weights=w)) sc6 <- summary(cm6 <- lm(y ~ 0+x1+x2+offset(os), data, weights=w)) if(getRversion() <= "3.5.1" && as.numeric(R.version$`svn rev`) < 74993) ## in the past, lm() returned logical empty matrix storage.mode(sc6$coefficients) <- "double" stopifnot(all.equal(coef(m5), coef(cm5), tolerance = 0.01), all.equal(coef(m6), coef(cm6), tolerance = 1e-14), all.equal(coef(sm5), coef(sc5), tolerance = 0.05), all.equal(coef(sm6), coef(sc6), tolerance = 1e-14), identical(sm5$df, sc5$df), identical(sm6$df, sc6$df)) robustbase/tests/tlts.R0000644000176200001440000000262113162677266014717 0ustar liggesuserslibrary(robustbase) ## library(MASS)## MASS::lqs source(system.file("xtraR/test_LTS.R", package = "robustbase")) ## ../inst/test_LTS.R y20 <- c(2:4, 8, 12, 22, 28, 29, 33, 34, 38, 40, 41, 47:48, 50:51, 54, 56, 59) test_location <- function() { ## Improve: print less, and test equality explicitly Y <- y20 print(ltsReg(y=Y)) print(ltsReg(y=Y, intercept=TRUE)) print(ltsReg(y=Y, intercept=FALSE)) print(ltsReg(y=Y, alpha=1)) print(ltsReg(Y ~ 1)) print(ltsReg(Y ~ 0))# = Y ~ 1 - 1 : empty model (no coefficients) print(ltsReg(Y ~ 1, alpha=1)) } test_rsquared <- function() { x1 <- y20 y1 <- c(1, 1, 1, 1, 1, 1, 1, 1, 1, 3.5, 1, 1, 1, 1, 1, 1, 1, 1, 1, 5) ll1 <- ltsReg(x1,y1, alpha = 0.8) ## print() ing is platform-dependent, since only ~= 0 stopifnot(all.equal(unname(coef(ll1)), c(1,0), tolerance=1e-12), ll1$scale < 1e-14) print(ltsReg(y1,x1, alpha = 0.8)) print(ltsReg(y1,x1, alpha = 0.8, intercept = FALSE)) } options(digits = 5) set.seed(101) # <<-- sub-sampling algorithm now based on R's RNG and seed doLTSdata() if(FALSE) { ## FIXME: These *FAIL* ! doLTSdata(nrep = 12, time = FALSE) doLTSdata(nrep = 12, time = FALSE, method = "MASS") } test_rsquared() test_location() if(length(W <- warnings())) print(if(getRversion() >= "3.5") summary(W) else W) cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' robustbase/tests/huber-etc.Rout.save0000644000176200001440000000555710377104055017271 0ustar liggesusers R : Copyright 2006, The R Foundation for Statistical Computing Version 2.2.1 Patched (2006-02-18 r37407) ISBN 3-900051-07-0 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(robustbase) Loading required package: MASS > > ### Test sets (all kinds odd/even, constant/regular/outlier) > > ## n = 0,1,2,3 : > x0 <- numeric(0) > x1 <- 3 > x2 <- 1:2 > x3 <- c(1:2,10) > ## constant (0 mad) + 0--2 outliers > xC <- rep(1, 12) > xC. <- rep(1, 11) > xC1 <- c(xC, 10) > xC1. <- c(xC., 10) > xC2 <- c(xC1, 100) > xC2. <- c(xC1., 100) > ## "uniform" + 0--2 outliers > y <- 1:10 > y. <- 1:11 > y1 <- c(y, 100) > y1. <- c(y., 100) > y2 <- c(y1, 1000) > y2. <- c(y1., 1000) > > nms <- ls(pat="^[xy]"); nms; names(nms) <- nms [1] "x0" "x1" "x2" "x3" "xC" "xC." "xC1" "xC1." "xC2" "xC2." [11] "y" "y." "y1" "y1." "y2" "y2." > lx <- lapply(nms, + function(n) { + x <- get(n) + m <- mad(x) + hx <- + if(!is.na(m) && m > 0) MASS::huber(x) + else list(m=NA, s=NA) + hMx <- huberM(x) + list(loc = + c(median = median(x), + huber = hx$m, + huberM = hMx$m), + scale= + c(mad = m, + huber = hx$s, + huberM = hMx$s)) + }) > r <- list(mu = sapply(lx, function(x) x$loc), + s = sapply(lx, function(x) x$scale)) > r $mu x0 x1 x2 x3 xC xC. xC1 xC1. xC2 xC2. y y. y1 y1. median NA 3 1.5 2.000000 1 1 1 1 1 1 5.5 6 6.000000 6.500000 huber NA NA 1.5 2.611949 NA NA NA NA NA NA 5.5 6 6.167169 6.606518 huberM NA 3 1.5 2.611949 1 1 1 1 1 1 5.5 6 6.167169 6.606518 y2 y2. median 6.500000 7.000000 huber 6.834339 7.213034 huberM 6.834339 7.213034 $s x0 x1 x2 x3 xC xC. xC1 xC1. xC2 xC2. y y. y1 y1. mad NA 0 0.7413 1.4826 0 0 0 0 0 0 3.7065 4.4478 4.4478 4.4478 huber NA NA 0.7413 1.4826 NA NA NA NA NA NA 3.7065 4.4478 4.4478 4.4478 huberM NA 0 0.7413 1.4826 0 0 0 0 0 0 3.7065 4.4478 4.4478 4.4478 y2 y2. mad 4.4478 4.4478 huber 4.4478 4.4478 huberM 4.4478 4.4478 > > cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' Time elapsed: 1.09 0.1 1.68 0 0 > robustbase/tests/OGK-ex.R0000644000176200001440000000300012271657124014742 0ustar liggesuserslibrary(robustbase) ## minimal testing only data(ruspini, package = "cluster") rub1 <- covOGK(ruspini, 1, scaleTau2, covGK, hard.rejection, consistency=FALSE) rub2 <- covOGK(ruspini, 2, scaleTau2, covGK, hard.rejection, consistency=FALSE) AE <- function(x,y) all.equal(x,y, tolerance = 2e-15) ## The following test is already fulfilled by Kjell Konis' original code: stopifnot(AE(c(rub1$wcov)[c(1,3:4)], c(917.99893333333, 94.9232, 2340.319288888888)), all.equal(rub1$wcov, rub2$wcov, tolerance=0) , AE(c(rub1$cov)[c(1,3:4)], c(923.5774514441657, 91.5385216376565, 2342.4556232436971)) , AE(c(rub2$cov)[c(1,3:4)], c(927.2465953711782, 91.8009184487779, 2346.5790105548940)) ) data(milk) cM1 <- covOGK(milk, 1, sigmamu = scaleTau2, weight.fn = hard.rejection) cM2 <- covOGK(milk, 2, sigmamu = scaleTau2, weight.fn = hard.rejection) symnum(cov2cor(cM1 $cov)) symnum(cov2cor(cM2 $cov)) symnum(cov2cor(cM1 $wcov)) symnum(cov2cor(cM2 $wcov)) cMQn <- covOGK(milk, sigmamu = s_Qn, weight.fn = hard.rejection) cMSn <- covOGK(milk, sigmamu = s_Sn, weight.fn = hard.rejection) cMiqr <- covOGK(milk, sigmamu = s_IQR, weight.fn = hard.rejection) cMmad <- covOGK(milk, sigmamu = s_mad, weight.fn = hard.rejection) as.dist(round(cov2cor(cMQn$wcov), 3)) as.dist(round(cov2cor(cMSn$wcov), 3)) as.dist(round(cov2cor(cMiqr$wcov), 3)) as.dist(round(cov2cor(cMmad$wcov), 3)) cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' robustbase/tests/wgt-himed.Rout.save0000644000176200001440000001057412271657124017300 0ustar liggesusers R : Copyright 2006, The R Foundation for Statistical Computing Version 2.2.1 Patched (2006-02-01 r37236) ISBN 3-900051-07-0 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > himed <- function(x) { n2 <- 1 + length(x) %/% 2; sort(x, partial = n2)[n2] } > > ## Tolerance 2e-7 {13 * higher than default 1.49e-8 } > is.all.equal <- function(x,y, tol = 2e-7) { + is.logical(r <- all.equal(x,y, tolerance = tol)) && r } > > > library(robustbase) Loading required package: MASS > > options(digits = 7)# single precision! > set.seed(15) > > cat(" n | range(x) | wgt.Himed\n", + "------------------------------\n",sep="") n | range(x) | wgt.Himed ------------------------------ > for(i in 1:100) { + n <- rpois(1, lam = 10) + cat(formatC(n,wid=3)," ") + x <- round(rnorm(n),3) + iw <- 1 + rpois(n, lam = 2) + him <- himed(rep(x, iw)) ## == naive R solution + whim <- wgt.himedian (x, iw) + if(!is.all.equal(whim, him)) + cat("whim != him: ", whim, "!=", him,"\n") + cat(formatC(range(x), wid = 6, flag="-"), "", + formatC(whim, wid = 6, flag="+"), "\n") + } 10 -1.255 1.831 +0.488 9 -1.167 1.412 +0.032 18 -2.253 1.611 +0.471 10 -1.589 0.754 +0.004 11 0.2 1.575 +0.712 16 -2.587 1.552 -0.04 8 -1.499 1.055 +0.041 15 -1.069 1.966 +0.621 15 -1.829 1.193 -0.177 13 -2.088 1.33 +0.022 15 -1.905 2.1 +0.104 18 -1.827 1.43 -0.338 15 -1.494 1.409 +0.378 6 -1.266 1.263 -0.162 11 -1.243 1.458 +0.227 9 -1.609 1.146 +0.609 6 -0.898 1.625 -0.659 14 -1.379 1.898 -0.123 6 -1.928 0.656 -0.44 9 -1.286 2.61 +0.442 8 -1.196 1.169 -0.376 5 -1.871 0.875 +0.004 10 -1.618 1.87 -0.023 11 -0.979 1.337 +0.156 6 -0.357 1.723 +0.519 8 -2.566 2.334 -0.416 14 -1.909 2.04 -0.051 15 -2.229 2.505 +0.377 9 -0.409 1.553 +0.452 7 -0.924 1.009 -0.645 13 -2.14 0.711 -0.348 9 -1.697 1.601 +0.369 12 -2.227 1.793 +0.508 14 -2.308 1.808 +0.444 11 -1.85 3.437 +0.285 9 -1.312 0.601 +0.017 7 -1.792 0.005 -0.247 10 -2.178 1.51 -0.905 10 -1.121 1.464 -0.133 8 -0.246 1.299 +0.885 14 -1.666 2.306 +0.234 9 -0.752 2.056 +0.151 13 -0.472 1.625 -0.055 6 -1.795 0.449 +0.122 10 -2.023 2.992 +0.141 8 -1.265 1.476 +0.083 11 -1.715 0.966 +0.137 8 -1.943 0.374 -0.215 8 -2.377 1.483 +0.029 8 -0.659 2.699 +1.052 8 -0.671 1.426 +0.033 12 -1.462 2.075 -0.13 14 -1.865 1.406 -0.478 6 -0.324 2.014 +1.453 12 -1.519 1.072 -0.106 12 -1.511 1.232 +0.055 14 -0.516 1.865 +0.31 8 -2.402 0.218 -0.319 10 -2.724 0.983 -0.47 5 -1.566 1.034 +0.676 7 -1.98 1.7 -0.002 11 -2.203 1.736 -0.209 8 -1.782 0.435 +0.035 15 -0.835 1.668 +0.166 12 -1.938 0.838 -0.228 8 -1.257 1.542 -0.527 11 -2.394 2.062 -0.007 14 -2.574 2.356 +0.095 10 -1.691 1.387 -0.217 14 -0.601 2.453 +0.951 9 -0.631 0.953 +0.601 9 -1.501 1.146 -0.337 7 -1.826 1.32 +0.621 6 -0.859 0.343 +0.009 4 -1.038 1.396 +1.375 9 -1.325 0.892 +0.399 10 -0.632 1.347 +0.026 4 -0.926 0.666 -0.555 11 -1.67 2.158 -0.355 17 -0.818 1.842 +0.054 6 -1.296 1.066 +0.384 11 -1.494 1.224 -0.222 11 -2.397 2.254 +0.165 11 -1.76 2.115 +0.008 9 -0.542 1.41 +0.412 7 -1.078 1.596 -0.43 9 -1.161 1.527 -0.12 7 0.112 1.656 +0.929 13 -1.175 2.39 +0.627 11 -1.177 1.838 +0.359 8 -1.601 0.792 +0.313 12 -2.57 1.827 +0.019 5 -0.463 0.505 +0.49 11 -2.077 1.694 +0.032 7 -1.139 1.232 -0.141 9 -0.814 1.482 +0.331 5 -0.542 0.405 +0.244 13 -2.127 1.754 -0.424 7 -1.082 1.015 -0.1 11 -0.773 2.253 -0.011 > > cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' Time elapsed: 0.92 0.05 0.96 0 0 > robustbase/tests/nlregrob-tst.R0000644000176200001440000004141513443724410016341 0ustar liggesusersstopifnot(require("robustbase")) source(system.file("xtraR", "platform-sessionInfo.R", # moreSessionInfo() etc package = "robustbase", mustWork=TRUE)) ## testing functions: source(system.file("test-tools-1.R", package = "Matrix", mustWork=TRUE))# assert.EQ c.time <- function(...) cat('Time elapsed: ', ..., '\n') S.time <- function(expr) c.time(system.time(expr)) showProc.time <- local({ ## function + 'pct' variable pct <- proc.time() function(final="\n") { ## CPU elapsed __since last called__ ot <- pct ; pct <<- proc.time() ## 'Time ..' *not* to be translated: tools::Rdiff() skips its lines! cat('Time elapsed: ', (pct - ot)[1:3], final) } }) mS <- moreSessionInfo(print.=TRUE) ## as long as we don't export these (nor provide an nlrob(., method=.) interface: nlrob.MM <- robustbase:::nlrob.MM nlrob.tau <- robustbase:::nlrob.tau nlrob.CM <- robustbase:::nlrob.CM nlrob.mtl <- robustbase:::nlrob.mtl (doExtras <- robustbase:::doExtras()) if(doExtras) { NP <- 30 ; tol <- 1e-11 } else { ## "fast" NP <- 15 ; tol <- 1e-7 } start.from.true <- !doExtras # (but not necessarily ..) if(start.from.true) { # population size = NP (random) + 1 (true parameters) init_p <- c(1, 0.2) init_p_sigma <- c(1, 0.2, 1) } else { init_p <- init_p_sigma <- NULL } if(!dev.interactive(orNone=TRUE)) pdf("nlregrob-tst.pdf") RNGversion("3.5.0") # -- TODO once R >> 3.5.0 : update results !! ## Stromberg, Arnold J. (1993). ## Computation of high breakdown nonlinear regression parameters. ## J. Amer. Statist. Assoc. 88(421), 237-244. ## exponential regression Expo <- function(x, a, b) exp(a + b*x) set.seed(2345) # for reproducibility ## data without outliers: d.exp30 <- data.frame(x = sort( runif(30, 0, 10) ), err = rnorm(30)) d.exp30 <- transform(d.exp30, y = Expo(x, 1, 0.2) + err) ## classical (starting at truth .. hmm) op <- options(digits=12) Cfit <- nls(y ~ Expo(x, a, b), data = d.exp30, start = c(a = 1, b = 0.2), control = nls.control(tol = 8e-8, printEval = TRUE), trace=TRUE) showProc.time()# ---- OS X needing 6e-8 options(op) ## robust Rfit.MM.S.bisquare <- nlrob.MM(y ~ Expo(x, a, b), data = d.exp30, lower = c(a = -10, b = -2), upper = c(10, 2), NP = NP, tol = tol, add_to_init_pop = init_p ) if(doExtras) { Rfit.MM.S.lqq <- update(Rfit.MM.S.bisquare, psi = "lqq") Rfit.MM.S.optimal <- update(Rfit.MM.S.bisquare, psi = "optimal") Rfit.MM.S.hampel <- update(Rfit.MM.S.bisquare, psi = "hampel") } showProc.time() Rfit.MM.lts.bisquare <- update(Rfit.MM.S.bisquare, init = "lts") Rfit.MM.lts.lqq <- update(Rfit.MM.S.bisquare, init = "lts", psi = "lqq") Rfit.MM.lts.optimal <- update(Rfit.MM.S.bisquare, init = "lts", psi = "optimal") Rfit.MM.lts.hampel <- update(Rfit.MM.S.bisquare, init = "lts", psi = "hampel") showProc.time() S.time(Rfit.tau.bisquare <- nlrob.tau( y ~ Expo(x, a, b), data = d.exp30, lower = c(a = -10, b = -2), upper = c(10, 2), NP = NP, add_to_init_pop = init_p )) S.time(Rfit.tau.optimal <- update(Rfit.tau.bisquare, psi = "optimal")) S.time(Rfit.CM <- nlrob.CM( y ~ Expo(x, a, b), data = d.exp30, lower = c(a = -10, b = -2, sigma = 0), upper = c( 10, 2, 10), NP = NP, add_to_init_pop = init_p_sigma )) S.time(Rfit.mtl <- nlrob.mtl(y ~ Expo(x, a, b), data = d.exp30, lower = c(a = -10, b = -2, sigma = 0), upper = c( 10, 2, 3), NP = NP+10, # <- higher prob. to get close tol = tol, trace=TRUE, details=TRUE, add_to_init_pop = init_p_sigma )) showProc.time() plot(y ~ x, d.exp30, main = "Data = d.exp30") cTr <- adjustcolor("red4", 0.5) cLS <- adjustcolor("blue2", 0.5) cE <- curve(Expo(x, a=1, b=0.2), 0, 10, n=1+2^9, col=cTr, lwd=2, lty=2, add=TRUE) lines(d.exp30$x, fitted(Cfit), col=cLS, lwd=3) ll <- length(m1 <- sapply(ls.str(patt="^Rfit"), get, simplify=FALSE)) .tmp <- lapply(m1, function(.) lines(d.exp30$x, fitted(.))) legend("topleft", c("true", "LS", names(m1)), lwd=c(2,3, rep(1,ll)), lty=c(2,1, rep(1,ll)), col=c(cTr,cLS, rep(par("fg"),ll)), bty="n", inset=.01) showProc.time() ## 40% outliers present {use different data name: seen in print() d.exp40out <- within(d.exp30, y[15:27] <- y[15:27] + 100) op <- options(digits=12) Cfit.40out <- update(Cfit, data = d.exp40out, trace=TRUE, control = nls.control(tol = Cfit$control$tol)) if(FALSE) ## this fails for "bad" non-R BLAS/LAPACK Cfit.no.out <- update(Cfit.40out, subset = -(15:27)) ## help giving it a good start *and* raise tolerance (from 8e-8): ## still fails for all three of {ATLAS, MKL, OpenBLAS} with ## Error in nls(formula = y ~ Expo(x, a, b), data = d.exp.Hlev, start = c(a = 1, : ## step factor 0.000488281 reduced below 'minFactor' of 0.000976562 Cfit.no.out <- tryCatch(error = function(e) e, update(Cfit.40out, subset = -(15:27), start = c(a = 1, b = 0.2), trace=TRUE, control = nls.control(maxiter = 1000, tol = 5e-7, printEval=TRUE)) ) Cfit.no..ok <- !inherits(Cfit.no.out, "error") options(op) if(doExtras) { Rf.out.MM.S.bisquare <- update(Rfit.MM.S.bisquare, data=d.exp40out) Rf.out.MM.S.lqq <- update(Rf.out.MM.S.bisquare, psi = "lqq") Rf.out.MM.S.optimal <- update(Rf.out.MM.S.bisquare, psi = "optimal") Rf.out.MM.S.hampel <- update(Rf.out.MM.S.bisquare, psi = "hampel") showProc.time() } Rf.out.MM.lts.bisquare <- update(Rfit.MM.S.bisquare, data=d.exp40out, init= "lts") Rf.out.MM.lts.lqq <- update(Rf.out.MM.lts.bisquare, psi= "lqq") #----------- Rf.out.MM.lts.optimal <- update(Rf.out.MM.lts.bisquare, psi= "optimal") Rf.out.MM.lts.hampel <- update(Rf.out.MM.lts.bisquare, psi= "hampel") showProc.time() Rf.out.tau.bisquare <- update(Rfit.tau.bisquare, data=d.exp40out) Rf.out.tau.optimal <- update(Rfit.tau.bisquare, data=d.exp40out, psi = "optimal") Rf.out.CM <- update(Rfit.CM, data=d.exp40out) Rf.out.mtl <- update(Rfit.mtl, data=d.exp40out) showProc.time() plot(y ~ x, d.exp40out, main = "Data = d.exp40out") cE <- curve(Expo(x, a=1, b=0.2), 0, 10, n=1+2^9, col=cTr, lwd=2, lty=2, add=TRUE) ll <- length(m1 <- sapply(ls.str(patt="^Rf.out"), get, simplify=FALSE)) .tmp <- lapply(m1, function(.) lines(d.exp40out$x, fitted(.))) xx <- local({p <- par("usr"); seq(p[1],p[2], length.out=256)}) if(Cfit.no..ok) lines(xx, predict(Cfit.no.out, list(x=xx)), col=cLS, lwd=3) lines(xx, predict(Cfit.40out , list(x=xx)), col=cLS, lty=2) legend("topleft", c("true", "LS [w/o outl]", "LS", names(m1)), lwd=c(2,3, rep(1,1+ll)), lty=c(2,1,2, rep(1,ll)), col=c(cTr,cLS,cLS, rep(par("fg"),ll)), bty="n", inset=.01) showProc.time() ## presence of high leverage point outliers d.exp.Hlev <- within(d.exp40out, { x[28:30] <- x[28:30] + 10 ## shift 10 y <- Expo(x, 1, 0.2) + err y[28:30] <- y[28:30] + 500 }) op <- options(digits=12) Cfit.Hlev <- tryCatch(error = function(e) e, update(Cfit.40out, data = d.exp.Hlev, start = c(a = 1, b = 0.2), trace=TRUE, control = nls.control(maxiter = 100, tol = 5e-7, printEval=TRUE)) ) if(Cfit.Hlev..ok <- !inherits(Cfit.Hlev, "error")) { Cfit.no.Hlev <- update(Cfit.Hlev, subset = -(28:30)) } else { ## substitute -- better? Cfit.no.Hlev <- update(Cfit, subset = -(28:30)) } showProc.time() options(op) if(doExtras) { Rf.Hlev.MM.S.bisquare <- update(Rfit.MM.S.bisquare, data = d.exp.Hlev) Rf.Hlev.MM.S.lqq <- update(Rf.Hlev.MM.S.bisquare, psi = "lqq") Rf.Hlev.MM.S.optimal <- update(Rf.Hlev.MM.S.bisquare, psi = "optimal") Rf.Hlev.MM.S.hampel <- update(Rf.Hlev.MM.S.bisquare, psi = "hampel") showProc.time() } Rf.Hlev.MM.lts.bisquare <- update(Rfit.MM.S.bisquare, data = d.exp.Hlev, init="lts") Rf.Hlev.MM.lts.lqq <- update(Rf.Hlev.MM.lts.bisquare, psi= "lqq") Rf.Hlev.MM.lts.optimal <- update(Rf.Hlev.MM.lts.bisquare, psi="optimal") Rf.Hlev.MM.lts.hampel <- update(Rf.Hlev.MM.lts.bisquare, psi= "hampel") showProc.time() Rf.Hlev.tau.bisquare <- update(Rfit.tau.bisquare, data = d.exp.Hlev) Rf.Hlev.tau.optimal <- update(Rf.Hlev.tau.bisquare, psi = "optimal") Rf.Hlev.CM <- update(Rfit.CM, data = d.exp.Hlev) Rf.Hlev.mtl <- update(Rfit.mtl, data = d.exp.Hlev) showProc.time() plot(y ~ x, d.exp.Hlev, main = "Data = d.exp.Hlev") cE <- curve(Expo(x, a=1, b=0.2), 0, par("usr")[2], n=1+2^9, col=cTr, lwd=2, lty=2, add=TRUE) x.H <- seq(par("usr")[1], par("usr")[2], length.out = 256) ll <- length(m1 <- sapply(ls.str(patt="^Rf.Hlev"), get, simplify=FALSE)) .tmp <- lapply(m1, function(.) lines(x.H, predict(., list(x=x.H)))) lines(x.H, predict(Cfit.no.Hlev, list(x=x.H)), col=cLS, lwd=3)## L.S.() if(Cfit.Hlev..ok) { lines(x.H, predict(Cfit.Hlev, list(x=x.H)), col=cLS, lty=2)## L.S. legend("topleft", c("true", "LS [w/o outl]", "LS", names(m1)), lwd=c(2,3, rep(1,1+ll)), lty=c(2,1,2, rep(1,ll)), col=c(cTr, cLS,cLS, rep(par("fg"),ll)), bty="n", inset=.01) } else { cat("no Cfit.Hlev lines as nls() failed there\n") cat(" : legend(...) !?\n") } showProc.time() cfcl <- coef(Cfit) if(Cfit.no..ok) { cfcl.n.o <- coef(Cfit.no.out) } else { cfcl.n.o <- cfcl } # use substitute - for code below cfcl.n.H <- coef(Cfit.no.Hlev) ## no outliers present assert.EQ(coef(Rfit.MM.S.bisquare), cfcl, tol = 0.01, giveRE=TRUE) if(doExtras) { assert.EQ(coef(Rfit.MM.S.lqq), cfcl, tol = 0.01, giveRE=TRUE) assert.EQ(coef(Rfit.MM.S.optimal), cfcl, tol = 0.01, giveRE=TRUE) assert.EQ(coef(Rfit.MM.S.hampel), cfcl, tol = 0.01, giveRE=TRUE) } assert.EQ(coef(Rfit.MM.lts.bisquare), cfcl, tol = 0.01, giveRE=TRUE) assert.EQ(coef(Rfit.MM.lts.lqq), cfcl, tol = 0.01, giveRE=TRUE) assert.EQ(coef(Rfit.MM.lts.optimal), cfcl, tol = 0.01, giveRE=TRUE) assert.EQ(coef(Rfit.MM.lts.hampel), cfcl, tol = 0.01, giveRE=TRUE) assert.EQ(coef(Rfit.tau.bisquare), cfcl, tol = 0.02, giveRE=TRUE)# 0.009873 assert.EQ(coef(Rfit.tau.optimal), cfcl, tol = 0.01, giveRE=TRUE) assert.EQ(coef(Rfit.CM)[-3], cfcl, tol = 0.01, giveRE=TRUE) assert.EQ(coef(Rfit.mtl)[-3], cfcl, tol = 0.02, giveRE=TRUE) ## 40% outliers present -- compare with L.S.(good.data) if(doExtras) { assert.EQ(coef(Rf.out.MM.S.bisquare), cfcl.n.o, tol = 7e-4, giveRE=TRUE) assert.EQ(coef(Rf.out.MM.S.lqq), cfcl.n.o, tol = 1e-5, giveRE=TRUE) assert.EQ(coef(Rf.out.MM.S.optimal), cfcl.n.o, tol = 1e-5, giveRE=TRUE) assert.EQ(coef(Rf.out.MM.S.hampel), cfcl.n.o, tol = 1e-5, giveRE=TRUE) } assert.EQ(coef(Rf.out.MM.lts.bisquare), cfcl.n.o, tol = 6e-4, giveRE=TRUE) assert.EQ(coef(Rf.out.MM.lts.lqq), cfcl.n.o, tol = 1e-5, giveRE=TRUE) assert.EQ(coef(Rf.out.MM.lts.optimal), cfcl.n.o, tol = 1e-5, giveRE=TRUE) assert.EQ(coef(Rf.out.MM.lts.hampel), cfcl.n.o, tol = 1e-5, giveRE=TRUE) assert.EQ(coef(Rf.out.tau.bisquare), cfcl.n.o, tol = .007, giveRE=TRUE) assert.EQ(coef(Rf.out.tau.optimal), cfcl.n.o, tol = .002, giveRE=TRUE) assert.EQ(coef(Rf.out.CM)[-3], cfcl.n.o, tol = .012, giveRE=TRUE)# 0.00708,0.01079 assert.EQ(coef(Rf.out.mtl)[-3], cfcl.n.o, tol = .002, giveRE=TRUE)# better in 64b ## presence of high leverage point outliers -- compare with LS(good.data) if(doExtras) { assert.EQ(coef(Rf.Hlev.MM.S.bisquare), cfcl.n.H, tol = .01, giveRE=TRUE) assert.EQ(coef(Rf.Hlev.MM.S.lqq), cfcl.n.H, tol = .02, giveRE=TRUE) assert.EQ(coef(Rf.Hlev.MM.S.optimal), cfcl.n.H, tol = .005, giveRE=TRUE) assert.EQ(coef(Rf.Hlev.MM.S.hampel), cfcl.n.H, tol = .02, giveRE=TRUE) } assert.EQ(coef(Rf.Hlev.MM.lts.bisquare),cfcl.n.H, tol = .01, giveRE=TRUE) assert.EQ(coef(Rf.Hlev.MM.lts.lqq), cfcl.n.H, tol = .015, giveRE=TRUE) assert.EQ(coef(Rf.Hlev.MM.lts.optimal), cfcl.n.H, tol = .002, giveRE=TRUE) assert.EQ(coef(Rf.Hlev.MM.lts.hampel), cfcl.n.H, tol = .02, giveRE=TRUE) assert.EQ(coef(Rf.Hlev.tau.bisquare), cfcl.n.H, tol = .05, giveRE=TRUE)# 0.0363, 0.0415 assert.EQ(coef(Rf.Hlev.tau.optimal), cfcl.n.H, tol = .03, giveRE=TRUE) assert.EQ(coef(Rf.Hlev.CM)[-3], cfcl.n.H, tol = .12, giveRE=TRUE)# 0.032, 0.082 assert.EQ(coef(Rf.Hlev.mtl)[-3], cfcl.n.H, tol = .08, giveRE=TRUE) length(mods <- sapply(ls.str(patt="^Rf"), get, simplify=FALSE)) # 36 is.conv <- sapply(mods, `[[`, "status") == "converged" prblm <- mods[!is.conv] if(length(prblm)) { cat("\n*** NON-converged model fits:\n") print(prblm) mods <- mods[is.conv] } else cat("\n All models converged\n") ## Now, all mods are converged ----------- dKnd <- as.factor(vapply(mods, function(.m.) as.character(getCall(.m.)[["data"]]), "")) table(dKnd) ## (iKnd <- setNames(seq_len(nlevels(dKnd)), levels(dKnd))) ## Coefficients: Some have 'sigma', some not: pcf <- vapply(lcf <- lapply(mods, coef), length, 1) table(pcf) ## 2 and 3 stopifnot(min(pcf) + 1 == max(pcf)) # +1 : those which have 'sigma pp <- min(pcf) ccf <- t(simplify2array(lapply(lcf, `[`, 1:max(pcf)))) ## take the "Scale" for those that do not have 'sigma' among coef(): i.n <- is.na(ccf[,"sigma"]) ccf[i.n, "sigma"] <- vapply(mods[i.n], `[[`, 0, "Scale") ## not yet: vapply(mods[i.n], sigma, 0.) ccf ## well, the 'sigma's are definitely *not* unbiased estimates of ## true sqrt(var(eps)) ... [FIXME] ## --> indeed, this can be found in the CM paper [TODO: write more here] plot(ccf[,1:2], pch = as.integer(dKnd))## use 'method' to get color legend("topright", inset=.01, names(iKnd), pch = iKnd) points(rbind(cfcl.n.H, cfcl, cfcl.n.o), # <- order from iKind col=adjustcolor("tomato",.5), cex=2, pch=1:3, lwd=5) ## optional labs <- sub("^Rfit\\.", '', sub("^Rf\\.[A-Za-z]+\\.", '', rownames(ccf))) labs <- sub("hampel$", "Ham", sub("optimal$", "opt", sub("bisquare$", "biS", labs))) labs text(ccf[,1:2], labs, cex=0.75, col=adjustcolor(1, 0.5), adj= -1/5, srt=75, xpd=NA) points(rbind(cfcl), col=adjustcolor("tomato",.5), cex=2, pch=3, lwd=5) showProc.time() ###------- Extended Tests for the DNase1 example from >>>> ../man/nlrob-algos.Rd <<<< ### ===================== DNase1 <- DNase[DNase$Run == 1,] form <- density ~ Asym/(1 + exp(( xmid -log(conc) )/scal )) pnms <- c("Asym", "xmid", "scal") psNms <- c(pnms, "sigma") ##' a version that recycles x: setNames. <- function(x, nm) setNames(rep_len(x, length(nm)), nm) ## for comparisons, later: all.eq.mod <- function(m1, m2, sub=FALSE, excl = c("call", "ctrl"), ...) { nm1 <- names(m1) stopifnot(if(sub) nm1 %in% names(m2) else nm1 == names(m2)) ni <- if(sub) nm1[is.na(match(nm1, c("call","ctrl")))] else is.na(match(names(m1), excl))## <<- all but those with names in 'excl' all.equal(m1[ni], m2[ni], ...) } set.seed(47) # as these by default use randomized optimization: fMM <- robustbase:::nlrob.MM(form, data = DNase1, lower = setNames.(0, pnms), upper = 3, ## call to nlrob.control to pass 'optim.control': ctrl = nlrob.control("MM", optim.control = list(trace = 1), optArgs = list(trace = TRUE))) showProc.time() if(doExtras) { ftau <- robustbase:::nlrob.tau(form, data = DNase1, lower= setNames.(0, pnms), upper= 3, trace=TRUE) ## fCM <- robustbase:::nlrob.CM (form, data = DNase1, lower= setNames.(0, psNms), upper= 3, trace=TRUE) ## fmtl <- robustbase:::nlrob.mtl(form, data = DNase1, lower= setNames.(0, psNms), upper= 3, trace=TRUE) ## mods <- list(MM=fMM, tau=ftau, CM=fCM, MTL=fmtl) print(sts <- sapply(mods, `[[`, "status")) stopifnot(sts == "converged") print(sapply(mods, `[[`, "data")) # currently 'language' %% FIXME print(sapply(mods, `[[`, "coefficients")) # nice matrix showProc.time() } ## Compare with traditional M-estimate, a) started robustly b) psi = Tukey's: fM <- nlrob(formula(fMM), data=eval(fMM$data), start = coef(fMM), psi = .Mwgt.psi1("bisquare"), trace = TRUE) rbind(M=coef(fM), MM=coef(fMM)) # "similar" ... well, no: the sigma's get much different ## stopifnot(%%____FIXME___ all.equal(coef(fM), coef(fMM), tolerance = 1e-4) ## ) # had 3.26e-5 ## FIXME: nlrob( "M") should allow to keep specify an initial sigma *and* keep that fixed showProc.time() ### Now call the above methods via nlrob(): set.seed(47) # (same as above) ## without "sigma" gMM <- nlrob(form, data = DNase1, method = "MM", lower = setNames(c(0,0,0), pnms), upper = 3) gtau <- nlrob(form, data = DNase1, method = "tau", lower = setNames(c(0,0,0), pnms), upper = 3) ## those with "sigma" -> must be in (lower, upper), too : gCM <- nlrob(form, data = DNase1, method = "CM", lower = setNames(c(0,0,0,0), psNms), upper = 3) gmtl <- nlrob(form, data = DNase1, method = "mtl", lower = setNames(c(0,0,0,0), psNms), upper = 3) showProc.time() ## list {and test print() for these}: (mod2 <- list(MM=gMM, tau=gtau, CM=gCM, MTL=gmtl)) if(doExtras) { stopifnot(mapply(all.eq.mod, mods, mod2, sub=TRUE)) } robustbase/tests/MCD-specials.Rout.save0000644000176200001440000003003513162424403017601 0ustar liggesusers R Under development (unstable) (2017-05-19 r72698) -- "Unsuffered Consequences" Copyright (C) 2017 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > #### Test special cases for covMcd() > > library(robustbase) > > ### 1) p = 1 ---------------------------------------------------- > set.seed(1) > x <- c(rnorm(50),100, 1e10) > (r1 <- covMcd(x)) Minimum Covariance Determinant (MCD) estimator approximation. Method: Univariate Fast MCD(alpha=0.5 ==> h=27); nsamp = 500; (n,k)mini = (300,5) Call: covMcd(x = x) Log(Det.): -2.13 Robust Estimate of Location: x 0.1922 Robust Estimate of Covariance: x x 0.7483 > str(r1) List of 15 $ call : language covMcd(x = x) $ nsamp : num 500 $ method : chr "Univariate Fast MCD(alpha=0.5 ==> h=27); nsamp = 500; (n,k)mini = (300,5)" $ cov : num [1, 1] 0.748 ..- attr(*, "dimnames")=List of 2 .. ..$ : chr "x" .. ..$ : chr "x" $ center : Named num 0.192 ..- attr(*, "names")= chr "x" $ n.obs : int 52 $ alpha : num 0.5 $ quan : num 27 $ raw.cov : num [1, 1] 0.839 ..- attr(*, "dimnames")=List of 2 .. ..$ : chr "x" .. ..$ : chr "x" $ raw.center: Named num 0.325 ..- attr(*, "names")= chr "x" $ crit : num -2.13 $ mcd.wt : num [1:52] 1 1 1 1 1 1 1 1 1 1 ... $ X : num [1:52, 1] -0.626 0.184 -0.836 1.595 0.33 ... ..- attr(*, "dimnames")=List of 2 .. ..$ : chr [1:52] "1" "2" "3" "4" ... .. ..$ : NULL $ raw.cnp2 : num [1:2] 6.45 1.14 $ cnp2 : num [1:2] 1.47 1.01 - attr(*, "class")= chr "mcd" > summary(r1) Minimum Covariance Determinant (MCD) estimator approximation. Method: Univariate Fast MCD(alpha=0.5 ==> h=27); nsamp = 500; (n,k)mini = (300,5) Call: covMcd(x = x) Log(Det.): -2.13 Robust Estimate of Location: x 0.1922 Robust Estimate of Covariance: x x 0.7483 Eigenvalues: [1] 0.7483 Robustness weights: 4 observations c(14,24,51,52) are outliers with |weight| = 0 ( < 0.0019); 48 weights are ~= 1. > ## with alpha = 1 > (r1.1 <- covMcd(x, alpha = 1)) Minimum Covariance Determinant (MCD) estimator approximation. Method: MCD(alpha=1 ==> h=52) alpha = 1: The minimum covariance determinant estimates based on 52 observations are equal to the classical estimates. Call: covMcd(x = x, alpha = 1) Log(Det.): 42.1 Robust Estimate of Location: x 2.059 Robust Estimate of Covariance: x x 223.9 > str(r1.1) List of 15 $ call : language covMcd(x = x, alpha = 1) $ nsamp : num 500 $ method : chr "MCD(alpha=1 ==> h=52) \nalpha = 1: The minimum covariance determinant estimates based on 52 observations \nare "| __truncated__ $ cov : num [1, 1] 224 ..- attr(*, "dimnames")=List of 2 .. ..$ : chr "x" .. ..$ : chr "x" $ center : Named num 2.06 ..- attr(*, "names")= chr "x" $ n.obs : int 52 $ alpha : num 1 $ quan : num 52 $ raw.cov : num [1, 1] 1.92e+18 ..- attr(*, "dimnames")=List of 2 .. ..$ : chr "x" .. ..$ : chr "x" $ raw.center: Named num 1.92e+08 ..- attr(*, "names")= chr "x" $ crit : num 42.1 $ mcd.wt : num [1:52] 1 1 1 1 1 1 1 1 1 1 ... $ X : num [1:52, 1] -0.626 0.184 -0.836 1.595 0.33 ... ..- attr(*, "dimnames")=List of 2 .. ..$ : chr [1:52] "1" "2" "3" "4" ... .. ..$ : NULL $ raw.cnp2 : num [1:2] 1 1 $ cnp2 : num [1:2] 1.14 1 - attr(*, "class")= chr "mcd" > summary(r1.1) Minimum Covariance Determinant (MCD) estimator approximation. Method: MCD(alpha=1 ==> h=52) alpha = 1: The minimum covariance determinant estimates based on 52 observations are equal to the classical estimates. Call: covMcd(x = x, alpha = 1) Log(Det.): 42.1 Robust Estimate of Location: x 2.059 Robust Estimate of Covariance: x x 223.9 Eigenvalues: [1] 223.9 Robustness weights: 2 observations c(51,52) are outliers with |weight| = 0 ( < 0.0019); 50 weights are ~= 1. > > ### 1b) p = 1, constant scale > (rc <- covMcd(rep(1,12))) Minimum Covariance Determinant (MCD) estimator approximation. Method: Univariate Fast MCD(alpha=0.5 ==> h=7); nsamp = 500; (n,k)mini = (300,5) Call: covMcd(x = rep(1, 12)) Initial scale 0 because more than 'h' (=7) observations are identical. Log(Det.): -Inf Robust Estimate of Location: rep(1, 12) 1 Robust Estimate of Covariance: rep(1, 12) rep(1, 12) 0 Warning message: In covMcd(rep(1, 12)) : Initial scale 0 because more than 'h' (=7) observations are identical. > str(rc) List of 16 $ call : language covMcd(x = rep(1, 12)) $ nsamp : num 500 $ method : chr "Univariate Fast MCD(alpha=0.5 ==> h=7); nsamp = 500; (n,k)mini = (300,5)" $ singularity:List of 2 ..$ kind: chr "identicalObs" ..$ q : num 7 $ cov : num [1, 1] 0 ..- attr(*, "dimnames")=List of 2 .. ..$ : chr "rep(1, 12)" .. ..$ : chr "rep(1, 12)" $ raw.cov : num [1, 1] 0 ..- attr(*, "dimnames")=List of 2 .. ..$ : chr "rep(1, 12)" .. ..$ : chr "rep(1, 12)" $ center : Named num 1 ..- attr(*, "names")= chr "rep(1, 12)" $ raw.center : Named num 1 ..- attr(*, "names")= chr "rep(1, 12)" $ n.obs : int 12 $ alpha : num 0.5 $ quan : num 7 $ crit : num -Inf $ mcd.wt : num [1:12] 1 1 1 1 1 1 1 1 1 1 ... $ X : num [1:12, 1] 1 1 1 1 1 1 1 1 1 1 ... ..- attr(*, "dimnames")=List of 2 .. ..$ : chr [1:12] "1" "2" "3" "4" ... .. ..$ : NULL $ raw.cnp2 : num [1:2] 4.97 1.41 $ cnp2 : num [1:2] 1 1 - attr(*, "class")= chr "mcd" > summary(rc) Minimum Covariance Determinant (MCD) estimator approximation. Method: Univariate Fast MCD(alpha=0.5 ==> h=7); nsamp = 500; (n,k)mini = (300,5) Call: covMcd(x = rep(1, 12)) Initial scale 0 because more than 'h' (=7) observations are identical. Log(Det.): -Inf Robust Estimate of Location: rep(1, 12) 1 Robust Estimate of Covariance: rep(1, 12) rep(1, 12) 0 Eigenvalues: [1] 0 Robustness weights: All 12 weights are ~= 1. > ## with alpha = 1 > (rc1 <- covMcd(rep(1,12), alpha = 1)) Minimum Covariance Determinant (MCD) estimator approximation. Method: MCD(alpha=1 ==> h=12) alpha = 1: The minimum covariance determinant estimates based on 12 observations are equal to the classical estimates. Call: covMcd(x = rep(1, 12), alpha = 1) The classical covariance matrix is singular. Log(Det.): -Inf Robust Estimate of Location: rep(1, 12) 1 Robust Estimate of Covariance: rep(1, 12) rep(1, 12) 0 > str(rc1) List of 16 $ call : language covMcd(x = rep(1, 12), alpha = 1) $ nsamp : num 500 $ method : chr "MCD(alpha=1 ==> h=12) \nalpha = 1: The minimum covariance determinant estimates based on 12 observations \nare "| __truncated__ $ cov : num [1, 1] 0 ..- attr(*, "dimnames")=List of 2 .. ..$ : chr "rep(1, 12)" .. ..$ : chr "rep(1, 12)" $ center : Named num 1 ..- attr(*, "names")= chr "rep(1, 12)" $ n.obs : int 12 $ singularity:List of 1 ..$ kind: chr "classical" $ alpha : num 1 $ quan : num 12 $ raw.cov : num [1, 1] 0 ..- attr(*, "dimnames")=List of 2 .. ..$ : chr "rep(1, 12)" .. ..$ : chr "rep(1, 12)" $ raw.center : Named num 1 ..- attr(*, "names")= chr "rep(1, 12)" $ crit : num -Inf $ mcd.wt : num [1:12] 1 1 1 1 1 1 1 1 1 1 ... $ X : num [1:12, 1] 1 1 1 1 1 1 1 1 1 1 ... ..- attr(*, "dimnames")=List of 2 .. ..$ : chr [1:12] "1" "2" "3" "4" ... .. ..$ : NULL $ raw.cnp2 : num [1:2] 1 1 $ cnp2 : num [1:2] 1 1 - attr(*, "class")= chr "mcd" > summary(rc1) Minimum Covariance Determinant (MCD) estimator approximation. Method: MCD(alpha=1 ==> h=12) alpha = 1: The minimum covariance determinant estimates based on 12 observations are equal to the classical estimates. Call: covMcd(x = rep(1, 12), alpha = 1) The classical covariance matrix is singular. Log(Det.): -Inf Robust Estimate of Location: rep(1, 12) 1 Robust Estimate of Covariance: rep(1, 12) rep(1, 12) 0 Eigenvalues: [1] 0 Robustness weights: All 12 weights are ~= 1. > > ### 2) constant observations { multivariate scale == 0 } ----------- > (X <- matrix(rep(2*(1:4), 12), nrow = 12, byrow = TRUE)) [,1] [,2] [,3] [,4] [1,] 2 4 6 8 [2,] 2 4 6 8 [3,] 2 4 6 8 [4,] 2 4 6 8 [5,] 2 4 6 8 [6,] 2 4 6 8 [7,] 2 4 6 8 [8,] 2 4 6 8 [9,] 2 4 6 8 [10,] 2 4 6 8 [11,] 2 4 6 8 [12,] 2 4 6 8 > (rC <- covMcd(X)) Minimum Covariance Determinant (MCD) estimator approximation. Method: Fast MCD(alpha=0.5 ==> h=8); nsamp = 500; (n,k)mini = (300,5) Call: covMcd(x = X) The covariance matrix of the data is singular. There are 12 observations (in the entire dataset of 12 obs.) lying on the hyperplane with equation a_1*(x_i1 - m_1) + ... + a_p*(x_ip - m_p) = 0 with (m_1, ..., m_p) the mean of these observations and coefficients a_i from the vector a <- c(1, 0, 0, 0) Log(Det.): -Inf Robust Estimate of Location: [1] 2 4 6 8 Robust Estimate of Covariance: [,1] [,2] [,3] [,4] [1,] 0 0 0 0 [2,] 0 0 0 0 [3,] 0 0 0 0 [4,] 0 0 0 0 Warning message: In covMcd(X) : The covariance matrix of the data is singular. There are 12 observations (in the entire dataset of 12 obs.) lying on the hyperplane with equation a_1*(x_i1 - m_1) + ... + a_p*(x_ip - m_p) = 0 with (m_1, ..., m_p) the mean of these observations and coefficients a_i from the vector a <- c(1, 0, 0, 0) > summary(rC) Minimum Covariance Determinant (MCD) estimator approximation. Method: Fast MCD(alpha=0.5 ==> h=8); nsamp = 500; (n,k)mini = (300,5) Call: covMcd(x = X) The covariance matrix of the data is singular. There are 12 observations (in the entire dataset of 12 obs.) lying on the hyperplane with equation a_1*(x_i1 - m_1) + ... + a_p*(x_ip - m_p) = 0 with (m_1, ..., m_p) the mean of these observations and coefficients a_i from the vector a <- c(1, 0, 0, 0) Log(Det.): -Inf Robust Estimate of Location: [1] 2 4 6 8 Robust Estimate of Covariance: [,1] [,2] [,3] [,4] [1,] 0 0 0 0 [2,] 0 0 0 0 [3,] 0 0 0 0 [4,] 0 0 0 0 Eigenvalues: [1] 0 0 0 0 Robustness weights: All 12 weights are ~= 1. > (rC1 <- covMcd(X, alpha = 1)) Minimum Covariance Determinant (MCD) estimator approximation. Method: MCD(alpha=1 ==> h=12) alpha = 1: The minimum covariance determinant estimates based on 12 observations are equal to the classical estimates. Call: covMcd(x = X, alpha = 1) The classical covariance matrix is singular. Log(Det.): -Inf Robust Estimate of Location: [1] 2 4 6 8 Robust Estimate of Covariance: [,1] [,2] [,3] [,4] [1,] 0 0 0 0 [2,] 0 0 0 0 [3,] 0 0 0 0 [4,] 0 0 0 0 > summary(rC1) Minimum Covariance Determinant (MCD) estimator approximation. Method: MCD(alpha=1 ==> h=12) alpha = 1: The minimum covariance determinant estimates based on 12 observations are equal to the classical estimates. Call: covMcd(x = X, alpha = 1) The classical covariance matrix is singular. Log(Det.): -Inf Robust Estimate of Location: [1] 2 4 6 8 Robust Estimate of Covariance: [,1] [,2] [,3] [,4] [1,] 0 0 0 0 [2,] 0 0 0 0 [3,] 0 0 0 0 [4,] 0 0 0 0 Eigenvalues: [1] 0 0 0 0 Robustness weights: All 12 weights are ~= 1. > > ### 3) alpha = 1 : classical estimates --- for general cases -------- > > > cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' Time elapsed: 0.211 0.038 0.31 0.002 0 > > proc.time() user system elapsed 0.515 0.072 0.664 robustbase/tests/wgt-himed.R0000644000176200001440000000156612271657124015614 0ustar liggesusershimed <- function(x) { n2 <- 1 + length(x) %/% 2; sort(x, partial = n2)[n2] } ## Tolerance 2e-7 {13 * higher than default 1.49e-8 } is.all.equal <- function(x,y, tol = 2e-7) { is.logical(r <- all.equal(x,y, tolerance = tol)) && r } library(robustbase) options(digits = 7)# single precision! set.seed(15) cat(" n | range(x) | wgt.Himed\n", "------------------------------\n",sep="") for(i in 1:100) { n <- rpois(1, lam = 10) cat(formatC(n,wid=3)," ") x <- round(rnorm(n),3) iw <- 1 + rpois(n, lam = 2) him <- himed(rep(x, iw)) ## == naive R solution whim <- wgt.himedian (x, iw) if(!is.all.equal(whim, him)) cat("whim != him: ", whim, "!=", him,"\n") cat(formatC(range(x), wid = 6, flag="-"), "", formatC(whim, wid = 6, flag="+"), "\n") } cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' robustbase/tests/psi-rho-etc.Rout.save0000644000176200001440000002031612271657124017540 0ustar liggesusers R version 3.0.2 Patched (2014-01-26 r64896) -- "Frisbee Sailing" Copyright (C) 2014 The R Foundation for Statistical Computing Platform: x86_64-unknown-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > require(robustbase) Loading required package: robustbase > ## see also ./lmrob-psifns.R <<<<<<<< > source(system.file("xtraR/plot-psiFun.R", package = "robustbase", mustWork=TRUE)) > > EQ <- function(x,y) all.equal(x,y, tolerance = 1e-13) > > ## Demonstrate that one of tukeyChi() / tukeyPsi1() is superfluous > x <- seq(-4,4, length=201) > suppressWarnings(## as tukeyPsi1(), tukeyChi() are deprecated + for(c. in c(0.1, 1:2, pi, 100)) { + ix <- abs(x) != c. + stopifnot(EQ(tukeyChi(x, c.), + 6/c.^2* tukeyPsi1(x, c., deriv=-1)), + EQ(tukeyChi(x, c., deriv= 1), + 6/c.^2* tukeyPsi1(x, c., deriv= 0)), + EQ(tukeyChi(x, c., deriv= 2), + 6/c.^2* tukeyPsi1(x, c., deriv= 1)), + ## Now show equivalence with Mpsi(): + EQ(tukeyPsi1(x, c.), Mpsi(x, c., "tukey")), + EQ(tukeyPsi1(x, c., d=1), Mpsi(x, c., "tukey", d=1)), + EQ(tukeyPsi1(x[ix], c., d=2), Mpsi(x[ix], c., "tukey", d=2)) + ) + } + ) > ## Test if default arguments are used > h2Psi <- chgDefaults(huberPsi, k = 2) > > x <- 1:10 > stopifnot(h2Psi@ rho(x, k=2) == h2Psi@ rho(x), + h2Psi@ psi(x, k=2) == h2Psi@ psi(x), + h2Psi@Dpsi(x, k=2) == h2Psi@Dpsi(x), + h2Psi@ wgt(x, k=2) == h2Psi@ wgt(x), + h2Psi@Dwgt(x, k=2) == h2Psi@Dwgt(x)) > > ## Test default arguments for E... slots > stopifnot(EQ(h2Psi@Erho (), 0.49423127328548), + EQ(h2Psi@Epsi2(), 0.920536925636323), + EQ(h2Psi@EDpsi(), 0.954499736103642)) > > stopifnot(EQ(1, huberPsi@psi(1, k = 1e16)), + huberPsi@wgt(0.1591319494080224, 0.5 + 1/13) <= 1) > ## both used to fail because of numeric instability in pmin2/pmax2 > > f1 <- function(.) rep.int(1, length(.)) > F1 <- function(x, .) rep.int(1, length(x)) > ## correct "classical psi": > cPs <- psiFunc(rho = function(x,.) x^2 / 2, psi = function(x, .) x, + wgt = F1, Dpsi = F1, Erho = function(.) rep.int(1/2, length(.)), + Epsi2 = f1, EDpsi = f1, . = Inf) > validObject(cPs); cPs [1] TRUE psi function > ## incorrect dummy psi > cP <- psiFunc(rho = F1, psi = F1, wgt = F1, Dpsi = F1, + Erho = f1, Epsi2 = f1, EDpsi = f1, . = Inf) > cP psi function > ## Check the autogenerated Dwgt(): > x <- seq(0,2, by=1/4) > stopifnot(## strict symmetry { including Dwgt(0) == 0 } : + huberPsi @Dwgt(-x) == -huberPsi @Dwgt(x), + hampelPsi@Dwgt(-x) == -hampelPsi@Dwgt(x), + huberPsi @Dwgt(x)[x < 1.345] == 0, + hampelPsi@Dwgt(x)[x < 1.487] == 0, + EQ(huberPsi @Dwgt(x[x >= 1.5]), + c(-0.597777777777778, -0.439183673469388, -0.33625)), + EQ(hampelPsi@Dwgt(x[x >= 1.5]), + c(-0.660883932259397, -0.485547378802822, -0.371747211895911)) + ) > > .defDwgt <- robustbase:::.defDwgt > (ddd <- .defDwgt(psi = function(u, k) pmin.int(k, pmax.int(-k, u)), + Dpsi = function(u, k) abs(u) <= k)) function (u, k) { y <- u u <- u[not0 <- u != 0] y[not0] <- (Dpsi(u, k) - psi(u, k)/u)/u y } > stopifnot(is.function(ddd), names(formals(ddd)) == c("u","k"), + EQ(ddd(x, 1.345), huberPsi@Dwgt(x))) > > ## TODO: Provide some functionality of this as a Plot+Check function > ## ---- and then call the function for all our psiFunc objects (with different 'k') > kk <- c(1.5, 3, 8) > psiH.38 <- chgDefaults(hampelPsi, k = kk) > c1 <- curve(psiH.38@psi(x), -10, 10, n=512, col=2) > abline(h=0, v=0, lty=3, lwd=.5, col="gray25") > c2 <- curve(x * psiH.38@wgt(x), add=TRUE, n=512, col=adjustcolor("blue", .5), lwd=2) > title("psi_Hampel_(1.5, 3, 8) : psi(x) = x * wgt(x)") > axis(1, at=kk, expression(k[1], k[2], k[3]), pos=0) > axis(2, at=kk[1], quote(k[1]), pos=0, las=1) > stopifnot(all.equal(c1,c2, tolerance= 1e-15)) > > r1 <- curve(psiH.38@rho(x), -10, 10, col=2, + main = quote(rho(x) == integral(phi(t) * dt, 0, x))) > axis(1, at=kk, expression(k[1], k[2], k[3]), pos=0) > curve(psiH.38@psi(x), add=TRUE, n=512, col=adjustcolor("blue", .5), lwd=2) > abline(h=0, v=0, lty=3, lwd=.5, col="gray25") > ## check rho(x) = \int_0^x psi(x) dx {slightly *more* than rho' = psi !} > rhoH.38.int <- function(x) integrate(function(u) psiH.38@psi(u), 0, x, rel.tol=1e-10)$value > r2 <- curve(sapply(x, rhoH.38.int), add = TRUE, + lwd=4, col=adjustcolor("red", 1/4)) > ## numerical integration == "formula" : > stopifnot(all.equal(r1,r2, tolerance=1e-10)) > > curve(psiH.38@Dpsi(x), -10, 10, n=512, col=2, + main = quote(psi*minute(x))) > abline(h=0, v=0, lty=3, lwd=.5, col="gray25") > > ## check rho'(x) = phi(x) etc {TODO: for all our psiFun.} > head(xx <- seq(-10, 10, length=1024)) [1] -10.000000 -9.980450 -9.960899 -9.941349 -9.921799 -9.902248 > FrhoH.38 <- splinefun(xx, rho.x <- psiH.38@rho (xx)) > FpsiH.38 <- splinefun(xx, psi.x <- psiH.38@psi (xx)) > F1psH.38 <- splinefun(xx, Dps.x <- psiH.38@Dpsi(xx)) > > curve(FpsiH.38(x, deriv=1), -10,10, n=512) > curve(F1psH.38, add=TRUE, col=4, n=512) > stopifnot(all.equal(FpsiH.38(xx, deriv=1), Dps.x, + tolerance = 0.02))# not better because of discontinuities > > curve(FrhoH.38(x, deriv=1), -10,10, n=512) > curve(FpsiH.38, add=TRUE, col=4, n=512) > stopifnot(all.equal(FrhoH.38(xx, deriv=1), psi.x, tolerance = 1e-4)) > > E.norm <- function(FUN, tol=1e-12, ...) { + integrate(function(x) FUN(x) * dnorm(x), -Inf, Inf, + rel.tol=tol, ...)$value + } > > ##' asymptotic efficiency -- both integrate + "formula"(@Epsi, @EDpsi) version > aeff.P <- function(psiF, k, ...) { + stopifnot(is(psiF, "psi_func")) + if(!missing(k)) + psiF <- chgDefaults(psiF, k = k) + ## E[ psi'(X) ] ^2 / E[ psi(X) ^ 2 ] : + c(int = E.norm(psiF@Dpsi, ...)^2 / E.norm(function(x) psiF@psi(x)^2, ...), + form= psiF@EDpsi()^2 / psiF@Epsi2()) + } > > > ## Breakdown Point --- for redescenders only, > ## both integrate + "formula"(@Erho) version > bp.P <- function(psiF, k, ...) { + stopifnot(is(psiF, "psi_func")) + if(!missing(k)) + psiF <- chgDefaults(psiF, k = k) + if(!is.finite( rhoInf <- psiF@rho(Inf) )) + stop("rho(Inf) is not finite: ", rhoInf) + integ <- function(x) psiF@rho(x) + c(int = E.norm(integ, ...), form= psiF@Erho()) / rhoInf + } > > ## Print & Check the result of aeff.P() or bp.P() > chkP <- function(rp, tol = 1e-9) { + print(rp) + ae <- all.equal(rp[[1]], rp[[2]], tolerance=tol) + if(isTRUE(ae)) invisible(rp) else stop(ae) + } > > chkP(aeff.P(huberPsi)) int form 0.9500003 0.9500003 > chkP(aeff.P(huberPsi, k = 1.5)) int form 0.9642358 0.9642358 > chkP(aeff.P(huberPsi, k = 2)) int form 0.9897156 0.9897156 > chkP(aeff.P(huberPsi, k = 2.5)) int form 0.9977041 0.9977041 > > chkP(aeff.P(hampelPsi)) int form 0.9613126 0.9613126 > chkP(aeff.P(hampelPsi, k = c(1.5, 3, 8))) int form 0.9632396 0.9632396 > chkP(aeff.P(hampelPsi, k = c(2, 4, 8), tol=1e-10),# fails with tol=1e-11 + tol = 1e-4) int form 0.989679 0.989679 > > ## Now works too: > chkP(bp.P(hampelPsi)) int form 0.08615786 0.08615786 > chkP(bp.P(hampelPsi, k = c(1.5, 3, 8))) int form 0.06696027 0.06696027 > chkP(bp.P(hampelPsi, k = c(2, 4, 8))) int form 0.04942297 0.04942297 > > > ## test derivatives (adapted from ./lmrob-psifns.R) > head(x. <- seq(-5, 10, length=1501)) [1] -5.00 -4.99 -4.98 -4.97 -4.96 -4.95 > ## [separate lines, for interactive "play": ] > stopifnot(chkPsiDeriv(plot(huberPsi, x.))) > ## ToDo: improve accuracy of derivative check > stopifnot(chkPsiDeriv(plot(hampelPsi, x.), tol=c(1e-4, 1e-1))) > > > proc.time() user system elapsed 1.167 0.079 1.301 robustbase/src/0000755000176200001440000000000013465050200013205 5ustar liggesusersrobustbase/src/Makevars0000644000176200001440000000021710477324431014713 0ustar liggesusers## Dear Emacs, make me -*- Makefile -*- ## we use the BLAS and now also the LAPACK library: PKG_LIBS= $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) robustbase/src/rllarsbi.f0000644000176200001440000002301212401436721015171 0ustar liggesusersc--- For lmrob.lar() in ../R/lmrob.M.S.R c--- ~~~~~~~~~~~ C======================================================================= SUBROUTINE rlSTORm2(Y,N,J,YJ) C....................................................................... IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION Y(N) C----------------------------------------------------------------------- C rlSTORm2 SEARCHES THE J-TH VALUE IN ORDER OF MAGNITUDE IN C A VECTOR OF LENGTH N. C----------------------------------------------------------------------- C--- copied from robust package: src/lmrobmm.f ------------------------- L=1 LR=N 20 IF (L.GE.LR) GOTO 90 AX=Y(J) JNC=L JJ=LR 30 IF(JNC.GT.JJ) GOTO 80 40 IF (Y(JNC).GE.AX) GOTO 50 JNC=JNC+1 GOTO 40 50 IF(Y(JJ).LE.AX) GOTO 60 JJ=JJ-1 GOTO 50 60 IF(JNC.GT.JJ) GOTO 70 WA=Y(JNC) Y(JNC)=Y(JJ) Y(JJ)=WA JNC=JNC+1 JJ=JJ-1 70 GOTO 30 80 IF(JJ.LT.J) L=JNC IF(J.LT.JNC) LR=JJ GOTO 20 90 YJ=Y(J) RETURN END C======================================================================= SUBROUTINE rlCOLbi(V1,V2,MLT,M,IOUT) C....................................................................... DOUBLE PRECISION V1(M),V2(M),MLT C----------------------------------------------------------------------- C AUXILIARY ROUTINE FOR rlLARSbi C----------------------------------------------------------------------- C--- copied from robust package: src/lmrobbi.f ------------------------- DO 220 I=1,M IF (I .EQ. IOUT) GOTO 220 V1(I)=V1(I)-V2(I)*MLT 220 CONTINUE RETURN END C======================================================================= SUBROUTINE rlICHGbi(A,B) C....................................................................... C AUXILIARY ROUTINE FOR rlLARSbi C----------------------------------------------------------------------- C--- copied from robust package: src/lmrobbi.f ------------------------- DOUBLE PRECISION A,B,C C=A A=B B=C RETURN END C======================================================================= SUBROUTINE rlLARSbi(X,Y,N,NP,MDX,MDT,TOL,NIT,K, + KODE,SIGMA,THETA,RS,SC1,SC2,SC3,SC4,BET0) C....................................................................... IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION X(MDX,NP),Y(N),THETA(MDT),RS(N),SC1(N),SC2(NP), + SC3(NP),SC4(NP) INTEGER OUT LOGICAL STAGE,TEST DATA ZERO,TWO,EPS,BIG/0.D0,2.D0,1.0D-10,3.401D38/ cMM would think rather this: double precision --- but it breaks our checks C DATA ZERO,TWO,EPS,BIG/0.D0,2.D0,2.22D-16,1.796D308/ C----------------------------------------------------------------------- C LEAST ABSOLUTE RESIDUALS -- aka L_1 - Regression C --> Result in THETA[1:NP] C----------------------------------------------------------------------- C--- copied from robust package: src/lmrobbi.f ------------------------- DO J=1,NP SC4(J)=DBLE(J) SC2(J)=ZERO end do SUM=ZERO DO I=1,N SC1(I)=DBLE(NP+I) THETA(I)=Y(I) IF (Y(I) .lt. ZERO) then DO J=1,NP X(I,J)=-X(I,J) end do THETA(I)=-THETA(I) SC1(I)=-SC1(I) endif SUM=SUM+THETA(I) end do C----------------------------------------------------------------------- C COMPUTE THE MARGINAL COSTS. C----------------------------------------------------------------------- SUMIN=SUM DO J=1,NP SUM=ZERO DO I=1,N SUM=SUM+X(I,J) end do SC3(J)=SUM end do C----------------------------------------------------------------------- C STAGE I. DETERMINE THE VECTOR TO ENTER THE BASIS. C----------------------------------------------------------------------- TEST=.FALSE. ! -Wall STAGE=.TRUE. KOUNT=0 KR=1 KL=1 IN=1 ! -Wall c-- ---------------- LOOP (Stage I) ------------------------------------ 70 VMAX=-1.D0 DNP=DBLE(NP) DO J=KR,NP IF (DABS(SC4(J)) .GT. DNP) cycle ! = continue D=DABS(SC3(J)) IF (D-VMAX .LE. ZERO) cycle IF (D-VMAX .LE. EPS) cycle VMAX=D IN=J end do IF (SC3(IN) .lt. ZERO) then ! swap signs do I=1,N X(I,IN)=-X(I,IN) end do SC3(IN)=-SC3(IN) SC4(IN)=-SC4(IN) endif C----------------------------------------------------------------------- C DETERMINE THE VECTOR TO LEAVE THE BASIS. C----------------------------------------------------------------------- cvvv ------------ 2nd-level loop --------------------------------- 100 K=0 DO I=KL,N D=X(I,IN) IF (D .LE. TOL) cycle K=K+1 Y(K)=THETA(I)/D RS(K)=DBLE(I) TEST=.TRUE. end do C--- -------------- 3rd-level loop ------------------ 120 IF (K .le. 0) then TEST=.FALSE. ! and GOTO 150 else ! 130 VMIN=BIG DO I=1,K IF (Y(I)-VMIN .GE. ZERO) cycle IF (VMIN-Y(I) .LE. EPS) cycle J=I VMIN=Y(I) OUT=INT(RS(I)) end do Y(J)=Y(K) RS(J)=RS(K) K=K-1 endif C----------------------------------------------------------------------- C CHECK FOR LINEAR DEPENDENCE IN STAGE I. C----------------------------------------------------------------------- c 150 IF (.not.TEST .and. STAGE) then DO I=1,N CALL rlICHGbi(X(I,KR),X(I,IN)) end do CALL rlICHGbi(SC3(KR),SC3(IN)) CALL rlICHGbi(SC4(KR),SC4(IN)) KR=KR+1 c GOTO 260 else c 170 IF (.not. TEST) then KODE=2 GOTO 350 endif c 180 PIVOT=X(OUT,IN) IF (SC3(IN)-PIVOT-PIVOT .gt. TOL) then ! not converged DO J=KR,NP D=X(OUT,J) SC3(J)=SC3(J)-D-D X(OUT,J)=-D end do D=THETA(OUT) SUMIN=SUMIN-D-D THETA(OUT)=-D SC1(OUT)=-SC1(OUT) GOTO 120 c -----------end{ 3rd-level loop } ----------------- endif C----------------------------------------------------------------------- C 200 PIVOT ON X(OUT,IN). C----------------------------------------------------------------------- DO J=KR,NP IF (J.EQ.IN) cycle ! = continue X(OUT,J)=X(OUT,J)/PIVOT end do THETA(OUT)=THETA(OUT)/PIVOT DO J=KR,NP IF (J .EQ. IN) cycle D=X(OUT,J) SC3(J)=SC3(J)-D*SC3(IN) CALL rlCOLbi(X(1,J),X(1,IN),D,N,OUT) end do SUMIN=SUMIN-SC3(IN)*THETA(OUT) DO I=1,N IF (I .EQ. OUT) cycle D=X(I,IN) THETA(I)=THETA(I)-D*THETA(OUT) X(I,IN)=-D/PIVOT end do SC3(IN)=-SC3(IN)/PIVOT X(OUT,IN)=1.D0/PIVOT CALL rlICHGbi(SC1(OUT),SC4(IN)) KOUNT=KOUNT+1 IF (.NOT. STAGE) GOTO 270 C----------------------------------------------------------------------- C INTERCHANGE ROWS IN STAGE I. C----------------------------------------------------------------------- KL=KL+1 DO J=KR,NP CALL rlICHGbi(X(OUT,J),X(KOUNT,J)) enddo CALL rlICHGbi(THETA(OUT),THETA(KOUNT)) CALL rlICHGbi(SC1(OUT),SC1(KOUNT)) endif IF (KOUNT+KR .NE. NP+1) GOTO 70 c ======= C----------------------------------------------------------------------- C STAGE II. DETERMINE THE VECTOR TO ENTER THE BASIS. C----------------------------------------------------------------------- STAGE=.FALSE. cvvv 270 VMAX=-BIG DO J=KR,NP D=SC3(J) IF (D .lt. ZERO) then IF (D+TWO .GT. ZERO) cycle D=-D-TWO endif IF (D-VMAX .LE. ZERO) cycle IF (D-VMAX .LE. EPS) cycle VMAX=D IN=J end do IF (VMAX .gt. TOL) then ! not converged IF (SC3(IN) .le. ZERO) then DO I=1,N X(I,IN)=-X(I,IN) end do SC3(IN)=-SC3(IN)-2.D0 SC4(IN)=-SC4(IN) endif GOTO 100 c ======== endif C----------------------------------------------------------------------- C 310 PREPARE OUTPUT C----------------------------------------------------------------------- L=KL-1 DO I=1,N RS(I)=ZERO IF (I .GT. L .OR. THETA(I) .GE. ZERO) cycle do J=KR,NP X(I,J)=-X(I,J) end do THETA(I)=-THETA(I) SC1(I)=-SC1(I) end do KODE=0 IF (KR .eq. 1) then ! first time only do J=1,NP D=DABS(SC3(J)) IF (D .LE. TOL .OR. TWO-D .LE. TOL) GOTO 350 end do KODE=1 endif c--- 350 DO I=1,N K=INT(SC1(I)) D=THETA(I) IF (K .le. 0) then K=-K D=-D endif IF (I .lt. KL) then SC2(K)=D else K=K-NP RS(K)=D endif end do K=NP+1-KR SUM=ZERO DO I=KL,N SUM=SUM+THETA(I) end do SUMIN=SUM NIT=KOUNT DO J=1,NP THETA(J)=SC2(J) end do DO I=1,N Y(I)=DABS(RS(I)) end do N2=N/2+1 CALL RLSTORM2(Y,N,N2,SIGMA) SIGMA=SIGMA/BET0 RETURN END robustbase/src/R-rng4ftn.c0000644000176200001440000000033610441335044015137 0ustar liggesusers#include void F77_SUB(rndstart)(void) { GetRNGstate(); } void F77_SUB(rndend)(void) { PutRNGstate(); } double F77_SUB(normrnd)(void) { return norm_rand(); } double F77_SUB(unifrnd)(void) { return unif_rand(); } robustbase/src/rowMedians.c0000644000176200001440000000764013434014350015472 0ustar liggesusers/*************************************************************************** Authors: Adopted from rowQuantiles.c by R. Gentleman. Copyright Henrik Bengtsson, 2007; Martin Maechler, 2014; History --> EOF **************************************************************************/ #include // Public methods: SEXP rowMedians_Real (SEXP x, int nrow, int ncol, int narm, int hasna, int byrow); SEXP rowMedians_Integer(SEXP x, int nrow, int ncol, int narm, int hasna, int byrow); void C_rowMedians_Real (double* x, double* res, int nrow, int ncol, int narm, int hasna, int byrow); void C_rowMedians_Integer(int* x, double* res, int nrow, int ncol, int narm, int hasna, int byrow); /* TEMPLATE rowMedians_(...): - SEXP rowMedians_Real(...); - SEXP rowMedians_Integer(...); */ #define METHOD rowMedians #define X_TYPE 'i' #include "rowMedians_TYPE-template.h" #define X_TYPE 'r' #include "rowMedians_TYPE-template.h" #undef METHOD /* TODO: implement: hasNA in {NA,TRUE,FALSE}; and = NA <==> code should *check* R code {for error message}: ../R/comedian.R */ SEXP R_rowMedians(SEXP x, SEXP naRm, SEXP hasNA, SEXP byRow, SEXP keepNms) { // Argument checking and "C type coercion": if (!isMatrix(x)) error("Argument 'x' must be a matrix."); int narm = asLogical(naRm); // error if it ain't if (narm != TRUE && narm != FALSE) error("Argument 'naRm' must be either TRUE or FALSE."); int hasna = asLogical(hasNA); // error if it ain't if (hasna == NA_INTEGER) hasna = TRUE;// <- for now; TODO ? become smarter and check int byrow = INTEGER(byRow)[0]; int keepnms = asLogical(keepNms); /* Get dimensions of 'x'. */ SEXP ans = PROTECT(getAttrib(x, R_DimSymbol)); int nrow, ncol; if (byrow) { // rowMedians nrow = INTEGER(ans)[0]; ncol = INTEGER(ans)[1]; } else { // colMedians nrow = INTEGER(ans)[1]; ncol = INTEGER(ans)[0]; } UNPROTECT(1); // and reprotect : if (isReal(x)) { ans = PROTECT(rowMedians_Real (x, nrow, ncol, narm, hasna, byrow)); } else if (isInteger(x)) { ans = PROTECT(rowMedians_Integer(x, nrow, ncol, narm, hasna, byrow)); } else { error("Argument 'x' must be numeric (integer or double)."); } if(keepnms) { SEXP xDnms = getAttrib(x, R_DimNamesSymbol); if(xDnms != R_NilValue) { PROTECT(xDnms); setAttrib(ans, R_NamesSymbol, duplicate(VECTOR_ELT(xDnms, byrow ? 0 : 1))); UNPROTECT(1); } } UNPROTECT(1); return(ans); } /* R_rowMedians() */ /*************************************************************************** HISTORY: 2014-12-09 [M.Maechler] o Copied to 'robustbase' CRAN package - to replace many apply(*., 2, median) NB: 'Biobase' also contains rowQ = general row/col Quantiles o argument checking all in C o add 'keepNms' argument {and do keep names by default!} 2013-01-13 [HB] o Added argument 'byRow' to rowMedians() and dropped colMedians(). o Using internal arguments 'by_row' instead of 'by_column'. 2011-12-11 [HB] o BUG FIX: rowMediansReal(..., na.rm=TRUE) did not handle NaN:s, only NA:s. Note that NaN:s does not exist for integers. 2011-10-12 [HJ] o Added colMedians(). o Now rowMediansInteger/Real() can operate also by columns, cf. argument 'by_column'. 2007-08-14 [HB] o Added checks for user interrupts every 1000 line. o Added argument 'hasNA' to rowMedians(). 2005-12-07 [HB] o BUG FIX: When calculating the median of an even number (non-NA) values, the length of the second sort was one element too short, which made the method to freeze, i.e. rPsort(rowData, qq, qq) is now (...qq+1, qq). 2005-11-24 [HB] o By implementing a special version for integers, there is no need to coerce to double in R, which would take up twice the amount of memory. o rowMedians() now handles NAs too. o Adopted from rowQuantiles.c in Biobase of Bioconductor. **************************************************************************/ robustbase/src/rowMedians_TYPE-template.h0000644000176200001440000001443212441664610020155 0ustar liggesusers/* included 2 x from ./rowMedians.c ~~~~~~~~~~~~ *********************************************************************** TEMPLATE: SEXP rowMedians_(...) GENERATES: SEXP rowMedians_Integer(SEXP x, int nrow, int ncol, int narm, int hasna, int byrow) SEXP rowMedians_Real(SEXP x, int nrow, int ncol, int narm, int hasna, int byrow) Arguments: The following macros ("arguments") should be defined for the template to work as intended. - METHOD: the name of the resulting function - X_TYPE: 'i' or 'r' Authors: Adopted from rowQuantiles.c by R. Gentleman. Template by Henrik Bengtsson. Copyright: Henrik Bengtsson, 2007-2013; Martin Maechler 2014 ***********************************************************************/ #include // MM{FIXME}: only #include #include /* Expand arguments: X_TYPE => (X_C_TYPE, X_IN_C, X_ISNAN, [METHOD_NAME]) */ #include "templates-types.h" #if X_TYPE == 'i' #define PSORT iPsort #elif X_TYPE == 'r' #define PSORT rPsort #endif SEXP METHOD_NAME(SEXP x, int nrow, int ncol, int narm, int hasna, int byrow) { /* R allocate a double vector of length 'nrow' Note that 'nrow' means 'ncol' if byrow=FALSE. */ SEXP ans = PROTECT(allocVector(REALSXP, nrow)); C_METHOD_NAME(X_IN_C(x), REAL(ans), nrow, ncol, narm, hasna, byrow); UNPROTECT(1); return(ans); } // "C-only" method [SEXP free, can be called from "pure C" : void C_METHOD_NAME(X_C_TYPE *x, double *res, int nrow, int ncol, int narm, int hasna, int byrow) { Rboolean isOdd; int ii, jj, kk, qq; int *colOffset; X_C_TYPE value, /* R allocate memory for the 'rowData'. This will be taken care of by the R garbage collector later on. */ *rowData = (X_C_TYPE *) R_alloc(ncol, sizeof(X_C_TYPE)); if (!hasna) // If there are no missing values, don't try to remove them narm = FALSE; /* When narm is false, isOdd and qq are the same for all rows */ if (!narm) { isOdd = (ncol % 2 == 1); qq = (int)(ncol/2) - 1; } else { isOdd = FALSE; qq = 0; } value = 0; /* Pre-calculate the column offsets */ colOffset = (int *) R_alloc(ncol, sizeof(int)); // HJ begin if (byrow) { for(jj=0; jj < ncol; jj++) colOffset[jj] = (int)jj*nrow; } else { for(jj=0; jj < ncol; jj++) colOffset[jj] = jj; } // HJ end if (hasna) { for(ii=0; ii < nrow; ii++) { if(ii % 1000 == 0) R_CheckUserInterrupt(); int rowIdx = byrow ? ii : ncol*ii; //HJ kk = 0; /* The index of the last non-NA value detected */ for(jj=0; jj < ncol; jj++) { value = x[rowIdx+colOffset[jj]]; //HJ if (X_ISNAN(value)) { if (!narm) { kk = -1; break; } } else { rowData[kk] = value; kk = kk + 1; } } if (kk == 0) { res[ii] = R_NaN; } else if (kk == -1) { res[ii] = R_NaReal; } else { /* When narm is true, isOdd and qq may change with row */ if (narm) { isOdd = (kk % 2 == 1); qq = (int)(kk/2) - 1; } /* Permute x[0:kk-1] so that x[qq] is in the correct place with smaller values to the left, ... */ PSORT(rowData, kk, qq+1); value = rowData[qq+1]; if (isOdd) { res[ii] = (double)value; } else { if (narm || !X_ISNAN(value)) { /* Permute x[0:qq-2] so that x[qq-1] is in the correct place with smaller values to the left, ... */ PSORT(rowData, qq+1, qq); if (X_ISNAN(rowData[qq])) res[ii] = R_NaReal; else res[ii] = ((double)(rowData[qq] + value))/2; } else { res[ii] = (double)value; } } } } // for(..) } else { // no NAs for(ii=0; ii < nrow; ii++) { if(ii % 1000 == 0) R_CheckUserInterrupt(); int rowIdx = byrow ? ii : ncol*ii; //HJ for(jj=0; jj < ncol; jj++) rowData[jj] = x[rowIdx+colOffset[jj]]; //HJ /* Permute x[0:ncol-1] so that x[qq] is in the correct place with smaller values to the left, ... */ PSORT(rowData, ncol, qq+1); value = rowData[qq+1]; if (isOdd) { res[ii] = (double)value; } else { /* Permute x[0:qq-2] so that x[qq-1] is in the correct place with smaller values to the left, ... */ PSORT(rowData, qq+1, qq); res[ii] = (double)((rowData[qq] + value))/2; } } // for(..) } /* if (hasna ...) */ } /* Undo template macros */ #undef PSORT #include "templates-types_undef.h" /*************************************************************************** HISTORY: 2014-12-09 [MMaechler] o do not use '== TRUE' '== FALSE' -- as we have no NA here o resolve REAL(ans) outside for(ii ..) o add "SEXP-free" C routines, others can call: C_rowMedians_(Real|Integer) 2013-04-23 [HB] o BUG FIX: The integer template of rowMedians_() would not handle ties properly. This was because ties were calculated as '(double)((rowData[qq] + value)/2)' instead of '((double)(rowData[qq] + value))/2'. 2013-01-13 [HB] o Merged rowMedians_Integer() and rowMedians_Read() into template rowMedians_(). 2013-01-13 [HB] o Using internal arguments 'by_row' instead of 'by_column'. 2011-12-11 [HB] o BUG FIX: rowMediansReal(..., na.rm=TRUE) did not handle NaN:s, only NA:s. Note that NaN:s does not exist for integers. 2011-10-12 [HJ] o Added colMedians(). o Now rowMediansInteger/Real() can operate also by columns, cf. argument 'by_column'. 2007-08-14 [HB] o Added checks for user interrupts every 1000 line. o Added argument 'hasNA' to rowMedians(). 2005-12-07 [HB] o BUG FIX: When calculating the median of an even number (non-NA) values, the length of the second sort was one element too short, which made the method to freeze, i.e. rPsort(rowData, qq, qq) is now (...qq+1, qq). 2005-11-24 [HB] o By implementing a special version for integers, there is no need to coerce to double in R, which would take up twice the amount of memory. o rowMedians() now handles NAs too. o Adopted from rowQuantiles.c in Biobase of Bioconductor. **************************************************************************/ robustbase/src/wgt_himed.c0000644000176200001440000000446012676775240015351 0ustar liggesusers/* * R : A Computer Language for Statistical Data Analysis * Copyright (C) 2006--2007 the R Development 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Used to be part of ./qn_sn.c Note by MM: We have explicit permission from P.Rousseeuw to licence it under the GNU Public Licence. See also ../inst/Copyrights */ #include /* ^^^^^^^^^^ is supposedly more common and standard than * #include * or #include */ /* --> int64_t ; if people don't have the above, they can forget about it.. */ /* #include "int64.h" */ #include /* -> and much more */ #include "robustbase.h" // whimed() and whimed_i() function called from C : in ./mc.c , ./qn_sn.c : #define _i_whimed_ #include "wgt_himed_templ.h" #define _d_whimed_ #include "wgt_himed_templ.h" /* Interface routines to be called via .C() : */ void wgt_himed_i(double *x, Sint *n, Sint *iw, double *res) { double *a_srt, *acand; int *iw_cand, nn = (int)*n; char *vmax; vmax = vmaxget(); acand = (double *)R_alloc(nn, sizeof(double)); a_srt = (double *)R_alloc(nn, sizeof(double)); iw_cand= (int *) R_alloc(nn, sizeof(int)); *res = whimed_i(x, (int *)iw, nn, acand, a_srt, iw_cand); vmaxset(vmax); } void wgt_himed(double *x, Sint *n, double *w, double *res) { double *a_srt, *a_cand, *w_cand; int nn = (int)*n; char *vmax; vmax = vmaxget(); a_cand = (double *) R_alloc(nn, sizeof(double)); a_srt = (double *) R_alloc(nn, sizeof(double)); w_cand = (double *) R_alloc(nn, sizeof(double)); *res = whimed(x, w, nn, a_cand, a_srt, w_cand); vmaxset(vmax); } robustbase/src/templates-types_undef.h0000644000176200001440000000035012441664610017706 0ustar liggesusers#undef CONCAT #undef CONCAT_MACROS #undef METHOD_NAME #undef C_METHOD_NAME #undef X_C_TYPE #undef X_IN_C #undef X_ISNAN #undef ANS_SXP #undef ANS_NA #undef ANS_C_TYPE #undef ANS_IN_C #undef X_TYPE #undef ANS_TYPE #undef MARGIN robustbase/src/wgt_himed_templ.h0000644000176200001440000000440411070730050016526 0ustar liggesusers/*------ Definition of a template for whimed(_i) : * * -------- ~~~~~~ * i.e., included several times from ./wgt_himed.c * ~~~~~~~~~~~~~ */ #ifdef _d_whimed_ # define _WHIMED_ whimed # define _WGT_TYPE_ double # define _WGT_SUM_TYPE_ double # undef _d_whimed_ #elif defined (_i_whimed_) # define _WHIMED_ whimed_i # define _WGT_TYPE_ int # define _WGT_SUM_TYPE_ int64_t # undef _i_whimed_ #else # error "must define correct whimed_ macro !" #endif double _WHIMED_(double *a, _WGT_TYPE_ *w, int n, double* a_cand, double *a_srt, _WGT_TYPE_* w_cand) { /* Algorithm to compute the weighted high median in O(n) time. The whimed is defined as the smallest a[j] such that the sum of the weights of all a[i] <= a[j] is strictly greater than half of the total weight. Arguments: a: double array containing the observations n: number of observations w: array of (int/double) weights of the observations. */ int n2, i, kcand; /* sum of weights: `int' do overflow when n ~>= 1e5 */ _WGT_SUM_TYPE_ wleft, wmid, wright, w_tot, wrest; double trial; w_tot = 0; for (i = 0; i < n; ++i) w_tot += w[i]; wrest = 0; /* REPEAT : */ do { for (i = 0; i < n; ++i) a_srt[i] = a[i]; n2 = n/2;/* =^= n/2 +1 with 0-indexing */ rPsort(a_srt, n, n2); trial = a_srt[n2]; wleft = 0; wmid = 0; wright= 0; for (i = 0; i < n; ++i) { if (a[i] < trial) wleft += w[i]; else if (a[i] > trial) wright += w[i]; else wmid += w[i]; } /* wleft = sum_{i; a[i] < trial} w[i] * wmid = sum_{i; a[i] == trial} w[i] at least one 'i' since trial is one a[]! * wright= sum_{i; a[i] > trial} w[i] */ kcand = 0; if (2 * (wrest + wleft) > w_tot) { for (i = 0; i < n; ++i) { if (a[i] < trial) { a_cand[kcand] = a[i]; w_cand[kcand] = w[i]; ++kcand; } } } else if (2 * (wrest + wleft + wmid) <= w_tot) { for (i = 0; i < n; ++i) { if (a[i] > trial) { a_cand[kcand] = a[i]; w_cand[kcand] = w[i]; ++kcand; } } wrest += wleft + wmid; } else { return trial; /*==========*/ } n = kcand; for (i = 0; i < n; ++i) { a[i] = a_cand[i]; w[i] = w_cand[i]; } } while(1); } /* _WHIMED_ */ #undef _WHIMED_ #undef _WGT_TYPE_ #undef _WGT_SUM_TYPE_ robustbase/src/templates-types.h0000644000176200001440000000212612441664610016530 0ustar liggesusers/* * Sets type-specific macros */ #define CONCAT(x,y) x ##_## y #define CONCAT3(x,y,z) x ##_## y ##_## z #define CONCAT_MACROS(x,y) CONCAT(x,y) #define CONCAT_3MACROS(x,y,z) CONCAT3(x,y,z) /* Data type macros for argument 'x' */ #if X_TYPE == 'i' # ifndef METHOD_NAME # define METHOD_NAME CONCAT_MACROS(METHOD, Integer) # define C_METHOD_NAME CONCAT_3MACROS(C, METHOD, Integer) # endif #define X_C_TYPE int #define X_IN_C INTEGER #define X_ISNAN(x) (x == NA_INTEGER) #elif X_TYPE == 'r' # ifndef METHOD_NAME # define METHOD_NAME CONCAT_MACROS(METHOD, Real) # define C_METHOD_NAME CONCAT_3MACROS(C, METHOD, Real) # endif #define X_C_TYPE double #define X_IN_C REAL #define X_ISNAN(x) ISNAN(x) #endif /* Data type macros for result ('ans') */ #ifndef ANS_TYPE /* Default to same as 'x' */ #define ANS_TYPE X_TYPE #endif #if ANS_TYPE == 'i' #define ANS_SXP INTSXP #define ANS_NA NA_INTEGER #define ANS_C_TYPE int #define ANS_IN_C INTEGER #elif ANS_TYPE == 'r' #define ANS_SXP REALSXP #define ANS_NA NA_REAL #define ANS_C_TYPE double #define ANS_IN_C REAL #endif robustbase/src/mc.c0000644000176200001440000002622713325654361013776 0ustar liggesusers/* Algorithm for the skewness estimator medcouple (MC) -------------------------------------------------- ( originally matlabmc.c and also mc/mcrsoft/spmc.c ) */ #include #include #include // -> int64_t #include /* -> fmax2(.,.) */ #include /* Interface routines to be called via .C() and those from API : */ #include "robustbase.h" /* including whimed_i(a,iw,n): the weighted high median of an array a of length n, using the positive integer weights iw[]. * which is in ./wgt_himed.c_templ * ~~~~~~~~~~~~~~~~~ */ /* Includes the auxiliary function h_kern(a,b, ai,bi,ab, eps): the values h(a,b) needed to compute the mc */ static double h_kern(double a, double b, int ai, int bi, int ab, double eps, Rboolean do_scale); // Called via .C() : void mc_C(double *z, int *in, double *eps, int *iter, double *out, int *scale) { *out = mc_C_d(z, *in, eps, iter, *scale); return; } /* MM: The tolerance 'eps1' and 'eps2' can now be passed from R; * the original code had only one 'eps' for both and hardcoded * eps = 0.0000000000001; (== 1e-13 ) * * MK: eps1: for (relative) "equality" checks * eps2: used to check for over- and underflow, respectively * therefore I suggest eps1 = DBL_EPS and eps2 = DBL_MIN */ double mc_C_d(double *z, int n, const double eps[], int *iter, int scale) { /* NOTE: eps = c(eps1, eps2) iter := c(maxit, trace.lev) as input = c(it, converged) as output */ int trace_lev = iter[1], it = 0; Rboolean converged = TRUE, do_scale = (Rboolean) scale; double medc; // "the" result static const double Large = DBL_MAX / 4.; if (n < 3) { medc = 0.; goto Finish; } /* copy data before sort()ing in place, also reflecting it -- dealing with +-Inf. NOTE: x[0] "empty" so we can use 1-indexing below */ double *x = (double *) R_alloc(n+1, sizeof(double)); x[0] = 0; for (int i = 0; i < n; i++) { double zi = z[i]; x[i+1] = - ((zi == R_PosInf) ? Large : (zi == R_NegInf ? -Large : zi)); } R_rsort(&x[1], n); /* full sort */ double xmed; // := median( x[1:n] ) = - median( z[0:(n-1)] ): if (n%2) { // n odd xmed = x[(n/2)+1]; } else { // n even int ind = (n/2); xmed = (x[ind] + x[ind+1])/2; } double x_eps = eps[0] * (do_scale ? eps[0] + fabs(xmed) : fabs(xmed)); if (fabs(x[1] - xmed) <= x_eps) { medc = -1.; goto Finish; } else if (fabs(x[n] - xmed) <= x_eps) { medc = 1.; goto Finish; } /* else : median is not at the border ------------------- */ if(trace_lev) Rprintf("mc_C_d(z[1:%d], trace_lev=%d, scale=%s): Median = %g (not at the border)\n", n, trace_lev, do_scale ? "T" : "F", -xmed); int i,j; /* center x[] wrt median --> such that then median( x[1:n] ) == 0 */ for (i = 1; i <= n; i++) x[i] -= xmed; if(do_scale) { /* MM: ==> This scaling is extremely outlier-dependent -- it *kills* equivariance when e.g. x[n] --> very large. e.g., below '(eps[0] + fabs(xmed))' depends on rescaling Should *NOT* be needed if everything else is *relative* instead of absolute Consider replacing 1) eps[0] * (eps[0] + fabs(xmed)) with eps[0]*fabs(xmed) 2) x[j] > x_eps with x[j] >= x_eps (>= : for 0) */ /* Now scale to inside [-0.5, 0.5] and flip sign such that afterwards * x[1] >= x[2] >= ... >= x[n] */ double xden = -2 * fmax2(-x[1], x[n]); for (i = 1; i <= n; i++) x[i] /= xden; xmed /= xden; x_eps = eps[0] * (eps[0] + fabs(xmed)); if(trace_lev >= 2) Rprintf(" x[] has been rescaled (* 1/s) with s = %g\n", -xden); } else { // no re-scaling; still flipping signs : for (i = 1; i <= n; i++) x[i] *= -1.; } j = 1; while (j <= n && x[j] >= x_eps) { /* test relative to xmed */ /* x1[j] = x[j]; */ j++; } if(trace_lev >= 2) Rprintf(" x1[] := {x | x_j > x_eps = %g} has %d (='j-1') entries\n", x_eps, j-1); i = 1; double *x2 = x+j-1; /* pointer -- corresponding to x2[i] = x[j]; */ while (j <= n && x[j] >= -x_eps) { /* test relative to xmed */ /* x1[j] = x[j]; */ /* x2[i] = x[j]; */ j++; i++; } /* now x1[] := {x | x_j > -eps} also includes the median (0) */ if(trace_lev >= 2) Rprintf("'median-x' {x | -eps < x_i <= eps} has %d (= 'k') entries\n", i-1); int h1 = j-1, /* == size of x1[] == the sum of those two sizes above */ /* conceptually, x2[] := {x | x_j <= eps} (which includes the median 0) */ h2 = i + (n-j);// == size of x2[] == maximal size of whimed() arrays if(trace_lev) Rprintf(" now allocating 2+5 work arrays of size (1+) h2=%d each:\n", h2); /* work arrays for whimed_i() : allocate *once* only !! */ double *acand = (double *) R_alloc(h2, sizeof(double)), *a_srt = (double *) R_alloc(h2, sizeof(double)); int *iw_cand= (int *) R_alloc(h2, sizeof(int)), /* work arrays for the fast-median-of-table algorithm: * currently still with 1-indexing */ *left = (int *) R_alloc((h2+1), sizeof(int)), *right = (int *) R_alloc((h2+1), sizeof(int)), *p = (int *) R_alloc((h2+1), sizeof(int)), *q = (int *) R_alloc((h2+1), sizeof(int)); for (i = 1; i <= h2; i++) { left [i] = 1; right[i] = h1; } int64_t nr = ((int64_t) h1) * ((int64_t) h2), // <-- careful to *NOT* overflow knew = nr/2 +1; if(trace_lev >= 2) Rprintf(" (h1,h2, nr, knew) = (%d,%d, %.0f, %.0f)\n", h1,h2, (double)nr, (double)knew); double trial = -2./* -Wall */; double *work= (double *) R_alloc(n, sizeof(double)); int *iwt = (int *) R_alloc(n, sizeof(int)); Rboolean IsFound = FALSE; int nl = 0, neq = 0; /* MK: 'neq' counts the number of observations in the * inside the tolerance range, i.e., where left > right + 1, * since we would miss those when just using 'nl-nr'. * This is to prevent index overflow in work[] later on. * left might be larger than right + 1 since we are only * testing with accuracy eps_trial and therefore there might * be more than one observation in the `tolerance range` * between < and <=. */ while (!IsFound && (nr-nl+neq > n) && it < iter[0]) { int64_t sum_p, sum_q; it++; j = 0; for (i = 1; i <= h2; i++) if (left[i] <= right[i]) { iwt[j] = right[i] - left[i]+1; int k = left[i] + (iwt[j]/2); work[j] = h_kern(x[k], x2[i], k, i, h1+1, eps[1], do_scale); j++; } if(trace_lev >= 4) { Rprintf(" before whimed(): work and iwt, each [0:(%d-1)]:\n", j); if(j >= 100) { for(i=0; i < 90; i++) Rprintf(" %8g", work[i]); Rprintf("\n ... "); for(i=j-4; i < j; i++)Rprintf(" %8g", work[i]); Rprintf("\n"); for(i=0; i < 90; i++) Rprintf(" %8d", iwt [i]); Rprintf("\n ... "); for(i=j-4; i < j; i++)Rprintf(" %8d", iwt [i]); Rprintf("\n"); } else { // j <= 99 for(i=0; i < j; i++) Rprintf(" %8g", work[i]); Rprintf("\n"); for(i=0; i < j; i++) Rprintf(" %8d", iwt [i]); Rprintf("\n"); } } trial = whimed_i(work, iwt, j, acand, a_srt, iw_cand); double eps_trial = eps[0] * (do_scale ? eps[0] + fabs(trial) : fabs(trial)); if(trace_lev >= 3) Rprintf("%2s it=%2d, whimed(*, n=%6d)=%11.5g ", " ", it, j, trial); j = 1; for (i = h2; i >= 1; i--) { while (j <= h1 && h_kern(x[j],x2[i],j,i,h1+1,eps[1], do_scale) - trial > eps_trial) { // while (j <= h1 && h_kern(x[j],x2[i],j,i,h1+1,eps[1], do_scale) > trial) { if (trace_lev >= 5) Rprintf("\nj=%3d, i=%3d, x[j]=%g, x2[i]=%g, h=%g", j, i, x[j], x2[i], h_kern(x[j],x2[i],j,i,h1+1,eps[1], do_scale)); j++; } /* for(; j <= h1; j++) { */ /* register double h = h_kern(x[j],x2[i],j,i,h1+1,eps[1], do_scale); */ /* if(h > trial) break; */ /* } */ p[i] = j-1; } j = h1; for (i = 1, sum_p=0, sum_q=0; i <= h2; i++) { while (j >= 1 && trial - h_kern(x[j],x2[i],j,i,h1+1,eps[1], do_scale) > eps_trial) // while (j >= 1 && h_kern(x[j],x2[i],j,i,h1+1,eps[1], do_scale) < trial) j--; q[i] = j+1; sum_p += p[i]; sum_q += j;/* = q[i]-1 */ } if(trace_lev >= 3) { if (trace_lev == 3) Rprintf("sum_(p,q)= (%.0f,%.0f)", (double)sum_p, (double)sum_q); else { /* trace_lev >= 4 */ Rprintf("\n%3s p[1:%d]:", "", h2); Rboolean lrg = h2 >= 100; int i_m = lrg ? 95 : h2; for(i = 1; i <= i_m; i++) Rprintf(" %2d", p[i]); if(lrg) Rprintf(" ..."); Rprintf(" sum=%4.0f\n%3s q[1:%d]:", (double)sum_p, "", h2); for(i = 1; i <= i_m; i++) Rprintf(" %2d", q[i]); if(lrg) Rprintf(" ..."); Rprintf(" sum=%4.0f\n", (double)sum_q); } } if (knew <= sum_p) { if(trace_lev >= 3) Rprintf("; sum_p >= kn\n"); for (i = 1, neq = 0; i <= h2; i++) { right[i] = p[i]; if (left[i] > right[i]+1) neq += left[i]-right[i]-1; } nr = sum_p; } else { /* knew > sum_p */ IsFound = (knew <= sum_q); /* i.e. sum_p < knew <= sum_q */; if(trace_lev >= 3) Rprintf("; s_p < kn ?<=? s_q: %s\n", IsFound ? "TRUE": "no"); if(IsFound) { medc = trial; } else { /* knew > sum_q */ for (i = 1; i <= h2; i++) { left[i] = q[i]; if (left[i] > right[i]+1) neq += left[i]-right[i]-1; } nl = sum_q; } } R_CheckUserInterrupt(); } /* end while loop */ converged = IsFound || (nr-nl+neq <= n); if(!converged) { warning("maximal number of iterations (%d =? %d) reached prematurely\n", iter[0], it); /* still: */ medc = trial; } if (converged && !IsFound) { /* e.g., for mc(1:4) : */ j = 0; for (i = 1; i <= h2; i++) { if (left[i] <= right[i]) { for (int k = left[i]; k <= right[i]; k++) { work[j] = -h_kern(x[k],x2[i],k,i,h1+1,eps[1], do_scale); j++; } } } if(trace_lev) Rprintf(" not found [it=%d, (nr,nl) = (%d,%d)]," " -> (knew-nl, j) = (%d,%d)\n", it, nr, nl, knew-nl, j); /* using rPsort(work, n,k), since we don't need work[] anymore:*/ rPsort(work, /* n = */ j, /* k = */ knew-nl-1); medc = - work[knew-nl-1]; } if(trace_lev >= 2) Rprintf(converged ? "converged in %d iterations\n" : "not converged in %d (maxit) iterations; try enlarging eps1, eps2 !?\n", it); Finish: iter[0] = it; /* to return */ iter[1] = converged; return medc; } /* end{ mc_C_d } */ /* h_kern() -- was called calwork() in original rmc.c code and did if (fabs(a-b) < 2.0*eps) { if (ai+bi == ab) { return 0; } else { return (ai+bi < ab) ? 1 : -1 ; } } else { return (a+b)/(a-b); } */ static double h_kern(double a, double b, int ai, int bi, int ab, double eps, Rboolean do_scale) { // eps := 'eps2' in R's mc() /* if (fabs(a-b) <= DBL_MIN) */ /* check for zero division and positive b */ // MK added a check '|| b > 0' ("or positive b"), but said "_and_ positive b" (r221) /* if (fabs(a-b) < 2.0*eps || b > 0) */ // MM: don't see why (but it seems needed); the check should be *relative* to |a+b| if (b > 0 || fabs(a-b) <= eps*(do_scale ? 2. : fabs(a+b))) // '<=' since RHS maybe 0 return sign((double)(ab - (ai+bi))); /* else */ return (a+b)/(a-b); } /* Local variables section * Local variables: * mode: c * kept-old-versions: 12 * kept-new-versions: 20 * End: */ robustbase/src/rfltsreg.f0000644000176200001440000011645312432362556015233 0ustar liggesuserscccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc cc rrcov : Scalable Robust Estimators with High Breakdown Point cc cc This program is free software; you can redistribute it and/or modify cc it under the terms of the GNU General Public License as published by cc the Free Software Foundation; either version 2 of the License, or cc (at your option) any later version. cc cc This program is distributed in the hope that it will be useful, cc but WITHOUT ANY WARRANTY; without even the implied warranty of cc MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the cc GNU General Public License for more details. cc cc You should have received a copy of the GNU General Public License cc along with this program; if not, write to the Free Software cc Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA cc cc I would like to thank Peter Rousseeuw and Katrien van Driessen for cc providing the initial code of this function. cc cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc subroutine rfltsreg(dat,n,nvar,nhalff,krep, inbest,objfct, * intercept,intadjust,nvad,datt, * weights,temp,index1,index2,aw2,aw,residu,y,nmahad,ndist, * am,am2,slutn, * jmiss,xmed,xmad,a,da,h,hvec,c,cstock,mstock,c1stock, * m1stock,dath,sd,means,bmeans, i_trace) c c dat = cbind(x,y) hence n x (p+1) c nvar = p c nvad = p+1 c nhalff: 'quan' = quan.f = h.alpha.n(alpha, n, rk) which is c = (n + p + 1) %/% 2 when alpha= 1/2 c krep = nsamp (e.g. = 5000 for "best") c implicit none integer kmini, nmini, k1,k2,k3,km10,nmaxi,maxmini integer i_trace integer i_aux(4) ! just for printing when i_trace > 0 c ccc parameter (nvmax=115) ccc parameter (nmax=57000) cc parameter (kmini=5) parameter (nmini=300) parameter (k1=2) parameter (k2=2) parameter (k3=100) cc krep := the total number of trial subsamples cc to be drawn when n exceeds 2*nmini; c krep = 0 :<==> "exact" <==> all possible subsamples cc ccc parameter (nvmax1=nvmax+1) ccc parameter (nvmax2=nvmax*nvmax) ccc parameter (nvm11=nvmax*(nvmax+1)) parameter (km10=10*kmini) parameter (nmaxi=nmini*kmini) C-- VT parameter (maxmini=int((3*nmini-1)/2)+1) parameter (maxmini=450) cc integer n,nvar,nvad,nhalff integer inbest(nhalff) double precision dat(n,nvad) double precision datt(n,nvad) double precision weights(n) integer temp(n) integer index1(n) integer index2(n) double precision aw2(n),aw(n) double precision residu(n) double precision y(n) double precision nmahad(n) double precision ndist(n) double precision am(n),am2(n),slutn(n) integer krep, matz,iseed, seed, tottimes,step integer intercept,intadjust integer pnsel, replow integer i,ii,iii, j,jj,jjj, jndex, k,kk, lll, m,mm, nn integer jmin,jmax, jerd,jnc, jreg, kstep,kount c unused integer jdefaul, jbreak integer minigr integer nfac,nerr, ngroup, nhalf,nlen,nmax,nmore, nmore2, nquant integer nvmax1, nvm11, nvmax, nsel, nstop, nrep double precision bstd, dist2, eps, factor, objfct, object double precision fckw, fckwi, fckw1, percen double precision MADeps logical all,part,fine,final,rfodd,more1,more2 c unused integer rfnbreak integer rfncomb integer flag(km10) integer mini(kmini) integer subdat(2,nmaxi) integer subndex(maxmini) double precision faclts(11) double precision mcdndex(10,2,kmini) c Function double precision rffindq ccc integer jmiss(nvmax1) ccc double precision xmed(nvmax1) ccc double precision xmad(nvmax1) ccc double precision a(nvmax1), da(nvmax1) ccc double precision h(nvmax,nvmax1),hvec(nvm11) ccc double precision c(nvmax,nvmax1) ccc double precision cstock(10,nvmax2) ccc double precision mstock(10,nvmax) ccc double precision c1stock(km10,nvmax2) ccc double precision m1stock(km10,nvmax) ccc double precision dath(nmaxi,nvmax1) ccc double precision sd(nvmax) ccc double precision means(nvmax) ccc double precision bmeans(nvmax) integer jmiss(nvad) double precision xmed(nvad) double precision xmad(nvad) double precision a(nvad), da(nvad) double precision h(nvar,nvad),hvec(nvar*nvad) double precision c(nvar,nvad) double precision cstock(10,nvar*nvar) double precision mstock(10,nvar) double precision c1stock(km10,nvar*nvar) double precision m1stock(km10,nvar) double precision dath(nmaxi,nvad) double precision sd(nvar) double precision means(nvar) double precision bmeans(nvar) data faclts/2.6477,2.5092,2.3826,2.2662,2.1587, * 2.0589,1.9660,1.879,1.7973,1.7203,1.6473/ if(i_trace .ge. 2) then call intpr('Entering rfltsreg() - krep: ',-1,krep,1) endif call rndstart C -------- == GetRNGstate() in C CCCC 10.10.2005 - substitute the parameters nmax and nvmax nmax = n nvmax = nvar nvmax1 = nvmax+1 nvm11 = nvmax*(nvmax+1) nrep = krep if(nvar .lt.5 ) then eps=1.0D-12 else if(nvar .ge. 5 .and. nvar .le. 8) then eps=1.0D-14 else eps=1.0D-16 endif endif c Tolerance for rfstatis(): |MAD| < MADeps : <==> "problem" MADeps=1.0D-6 cc nhalff=int((n+nvar+1)/2) jmin=(n/2)+1 jmax = max((3*n/4)+(nvar+1)/4, nhalff) nquant=min(11, 1+ nint(40*(dble(nhalff)/n - 0.5))) factor=faclts(nquant) c unused jbreak=rfnbreak(nhalff,n,nvar) c unused jdefaul=(n+nvar+1)/2 percen = (1.D0*nhalff)/(1.D0*n) if(nvad.eq.1) goto 9000 cc CDDD CALL INTPR('>>> Enter RFLTSREG ... iseed=',-1,iseed,1) seed=iseed matz=1 nsel=nvar ngroup=1 part=.false. fine=.false. final=.false. all=.true. do 21,i=1,nmaxi subdat(1,i)=1000000 subdat(2,i)=1000000 21 continue cc mini(1)=0 mini(2)=0 mini(3)=0 mini(4)=0 mini(5)=0 if(krep.gt.0 .and. n.gt.(2*nmini-1)) then kstep=k1 part=.true. ngroup=int(n/dble(nmini)) if(n.ge.(2*nmini) .and. n.le.(3*nmini-1)) then if(rfodd(n)) then mini(1)=int(n/2) mini(2)=int(n/2)+1 else mini(1)=n/2 mini(2)=n/2 endif else if(n.ge.(3*nmini) .and. n.le.(4*nmini-1)) then if(3*(n/3) .eq. n) then mini(1)=n/3 mini(2)=n/3 mini(3)=n/3 else mini(1)=int(n/3) mini(2)=int(n/3)+1 if(3*(n/3) .eq. n-1) then mini(3)=int(n/3) else mini(3)=int(n/3)+1 endif endif else if(n.ge.(4*nmini) .and. n.le.(5*nmini-1)) then if(4*(n/4) .eq. n) then mini(1)=n/4 mini(2)=n/4 mini(3)=n/4 mini(4)=n/4 else mini(1)=int(n/4) mini(2)=int(n/4)+1 if(4*(n/4) .eq. n-1) then mini(3)=int(n/4) mini(4)=int(n/4) else if(4*(n/4) .eq. n-2) then mini(3)=int(n/4)+1 mini(4)=int(n/4) else mini(3)=int(n/4)+1 mini(4)=int(n/4)+1 endif endif endif else mini(1)=nmini mini(2)=nmini mini(3)=nmini mini(4)=nmini mini(5)=nmini endif nhalf=int(mini(1)*percen) if(ngroup.gt.kmini) ngroup=kmini nrep=int(dble(krep)/ngroup) minigr=mini(1)+mini(2)+mini(3)+mini(4)+mini(5) if(i_trace .ge. 2) call intpr(' rftls.... minigr=',-1,minigr,1) call rfrdraw(subdat,n,minigr,mini,ngroup,kmini) else c krep == 0 or n <= 2*nmini-1 ( = 599 by default) minigr=n nhalf=nhalff kstep=k1 C VT::25.11.2010 - added krep==0 means "exact" (all combinations) if(krep.eq.0 .or. n.le.replow(nsel)) then c use all combinations; happens iff nsel = nvar = p <= 6 nrep=rfncomb(nsel,n) if(i_trace .ge. 2) then call intpr('will use *all* combinations: ',-1,nrep,1) endif else nrep = krep all=.false. endif endif seed=iseed cc CDDD CALL INTPR('>>> Start initialization ... nrep=',-1,nrep,1) do 31, j=1,nvmax do k=1,10 mstock(k,j)=1000000.D0 do kk=1,kmini m1stock((kk-1)*10+k,j)=1000000.D0 end do do i=1,nvmax do kk=1,kmini c1stock((kk-1)*10+k,(j-1)*nvmax+i)=1000000.D0 end do cstock(k,(j-1)*nvmax+i)=1000000.D0 end do end do means(j)=0.D0 bmeans(j)=0.D0 sd(j)=0.D0 do k=1,nvmax1 c(j,k)=0.D0 h(j,k)=0.D0 end do 31 continue do 41, j=1,nmax nmahad(j)=0.D0 ndist(j)=0.D0 index1(j)=1000000 index2(j)=1000000 temp(j)=1000000 weights(j)=0.D0 aw(j)=0.D0 aw2(j)=0.D0 residu(j)=0.D0 y(j)=0.D0 am(j)=0.D0 am2(j)=0.D0 slutn(j)=0.D0 41 continue do j=1,km10 flag(j)=1 end do do 45, j=1,nvmax1 jmiss(j)=0 xmed(j)=0.D0 xmad(j)=0.D0 a(j)=0.D0 da(j)=0.D0 do k=1,nmaxi dath(k,j)=0.D0 end do 45 continue do j=1,maxmini subndex(j)=0 end do do j=1,nvm11 hvec(j)=0.D0 end do if(i_trace .ge. 2) + call intpr(' rftls.... initialization ready',-1,0,1) 9000 continue if(nvad.eq.1) then do jj=1,n ndist(jj)=dat(jj,1) end do call rfshsort(ndist,n) call rfmcduni(ndist,n,nhalff,slutn,bstd,am,am2,factor, * n-nhalff+1) goto 9999 endif cc if(.not.fine .and. .not.final) then call rfstatis(dat,xmed,xmad,aw2,intercept,nvad, nvmax1,nmax,n, * nstop,MADeps,weights,y,nvar,index2) if(nstop.eq.1) goto 9999 endif cc jreg=1 call rflsreg(nvmax1, nvmax,nvar,n,a,dat, weights, da, h, * fckw,hvec,nvm11,jmiss,nvad,n) cc nfac=nvad-1 nfac=nvar-1 call rfrtran(nvar,intercept,nfac,nvad,nvmax1,xmed, * xmad,a,nvad,fckw) call rftrc(h,da,nvmax,nvmax1,nvar,intercept,nfac,nvad, * xmed,xmad) jerd=0 tottimes=0 c---- - - - - - - - - Outermost loop - - - - - - - - - - - - - - - - - - - c---- 5555 object=10.D25 if(.not. part .or. final) nn=n if(part .and. fine .and. .not. final) nn=minigr if(fine.or.(.not.part.and.final)) then nrep=10 nsel=nhalf kstep=k2 if (final) then nhalf=nhalff ngroup=1 if (n*nvar .le.100000) then kstep=k3 else if (n*nvar .gt.100000 .and. n*nvar .le.200000) then kstep=10 else if (n*nvar .gt.200000 .and. n*nvar .le.300000) then kstep=9 else if (n*nvar .gt.300000 .and. n*nvar .le.400000) then kstep=8 else if (n*nvar .gt.400000 .and. n*nvar .le.500000) then kstep=7 else if (n*nvar .gt.500000 .and. n*nvar .le.600000) then kstep=6 else if (n*nvar .gt.600000 .and. n*nvar .le.700000) then kstep=5 else if (n*nvar .gt.700000 .and. n*nvar .le.800000) then kstep=4 else if (n*nvar .gt.800000 .and. n*nvar .le.900000) then kstep=3 else if (n*nvar .gt.900000 .and. n*nvar .le.1000000) then kstep=2 else kstep=1 endif if (n .gt. 5000) nrep=1 else nhalf= int(minigr*percen) endif endif if(i_trace .ge. 2) then i_aux(1) = nrep i_aux(2) = kstep i_aux(3) = nhalf call intpr('Main (number of trials nrep, kstep, nhalf):', + -1, i_aux, 3) endif do i=1,nsel-1 index1(i)=i end do index1(nsel)=nsel-1 cc if(.not. final) then do i=1,10 do j=1,ngroup mcdndex(i,1,j)=10.D25 mcdndex(i,2,j)=10.D25 end do end do endif if (fine .and. .not. final) then do j=1,minigr do k=1,nvad dath(j,k)=dat(subdat(1,j),k) end do end do endif kount=0 CDDD CALL INTPR('>>> MAIN LOOP BY GROUPS: NGROUP= ',-1,ngroup,1) do 1111 ii = 1,ngroup if(i_trace .ge. 3) + call intpr(' rftls.... looping by group ii=',-1,ii,1) if(.not.fine) kount=0 if(part .and. .not. fine) nn=mini(ii) do i=1,nn index2(i)=i end do if(part .and. .not. fine) then jndex=0 do j=1,minigr if(subdat(2,j).eq.ii) then jndex=jndex+1 subndex(jndex)=subdat(1,j) endif end do do j=1,mini(ii) do k=1,nvad dath(j,k)=dat(subndex(j),k) end do end do endif do 1000 i=1,nrep if(i_trace .ge. 4) + call intpr(' rftls.... for(i = 1,nrep): i=',-1,i,1) pnsel=nsel tottimes=tottimes+1 fckwi=0.D0 fckw1=0.D0 step=0 132 if((part.and..not.fine).or.(.not.part.and..not.final)) then if(part) then call rfrangen(mini(ii),nsel,index1) else if(all) then call rfgenpn(n,nsel,index1) else call rfrangen(n,nsel,index1) endif endif endif c 9550 continue if(.not.fine .and. part) then do j=1,pnsel do m=1,nvad c(j,m)=dath(index1(j),m) end do end do else if(.not.part .and. .not.final) then do j=1,pnsel do m=1,nvad c(j,m)=dat(index1(j),m) end do end do endif if((.not.part.and..not.final).or.(.not.fine.and.part)) then if(nvar.gt.1) then call rfequat(c,nvmax,nvmax1,hvec,nvm11,nvar,1,nerr) if(nerr.lt.0) then jerd=jerd+1 if(.not.all .and. i.gt.2) goto 132 goto 1000 endif else if(c(1,1).ne.0.D0) c(1,1)=c(1,2)/c(1,1) endif do jnc=1,nvar a(jnc)=c(jnc,1) end do endif if (final) then if(mstock(i,1).ne.1000000.D0) then do jj=1,nvar a(jj)=mstock(i,jj) end do else goto 1111 endif endif if (fine.and..not.final) then if(m1stock((ii-1)*10+i,1).ne.1000000.D0) then do jj=1,nvar a(jj)=m1stock((ii-1)*10+i,jj) end do else goto 1111 endif endif do jnc=1,nn residu(jnc)=0.D0 do j=1,nvar if(part.and..not.final) then residu(jnc)=residu(jnc)+a(j)*dath(jnc,j) else residu(jnc)=residu(jnc)+a(j)*dat(jnc,j) endif end do if(part.and..not.final) then residu(jnc)=dath(jnc,nvad)-residu(jnc) else residu(jnc)=dat(jnc,nvad)-residu(jnc) endif aw(jnc)=residu(jnc) end do more1=.false. more2=.false. nmore=200 nmore2=nmore/2 if(intadjust.eq.1) then CDDD CALL INTPR('>>> INTERCEPT ADJUSTMENT 1',-1,i,1) if(intercept.eq.1.and.((.not.fine.and.part).or. * .not.part.or.((nn-nhalf).le.nmore))) then call rfshsort(aw,nn) call rfmcduni(aw,nn,nhalf,slutn,bstd,am,am2, * factor,nn-nhalf+1) a(nvar)=a(nvar)+slutn(1) do jnc=1,nn residu(jnc)=residu(jnc)-slutn(1) end do else if(intercept.eq.1) then call rfshsort(aw,nn) do jj=1,nn am2(jj)=abs(aw(jj)) end do dist2=rffindq(am2,nn,nhalf,index1) do jj=1,nhalf aw2(jj)=aw(index1(jj)) end do dist2=rffindq(aw2,nhalf,1,index2) jnc=index1(index2(1)) if(jnc+nmore-nmore2+nhalf-1.gt.nn.or.jnc-nmore2.lt.1) * then call rfmcduni(aw,nn,nhalf,slutn,bstd,am,am2, * factor,nn-nhalf+1) a(nvar)=a(nvar)+slutn(1) do jnc=1,nn residu(jnc)=residu(jnc)-slutn(1) end do else 555 do jj=0,nhalf-1+nmore aw2(jj+1)=aw(jnc-nmore2+jj) end do nlen=nmore+1 call rfmcduni(aw2,nhalf+nmore,nhalf,slutn, * bstd,am,am2,factor,nlen) if(nlen.eq.1.and..not.more1) then if(.not.more2) then nmore=nmore2 nmore2=nmore2+nmore2 more1=.true. if(jnc-nmore2.ge.1) goto 555 endif else if(nlen.eq.(nmore+1).and..not.more2) then if(.not.more1) then nmore=nmore2 nmore2=-nmore2 more2=.true. if(jnc+nmore-nmore2+nhalf-1.le.nn) * goto 555 endif else if(nlen.eq.1.and.more1) then if(.not.more2) then nmore2=nmore2+100 if(jnc-nmore2.ge.1) goto 555 endif else if(nlen.eq.(nmore+1).and.more2) then if(.not.more1) then nmore2=nmore2+100 if(jnc+nmore-nmore2+nhalf-1.le.nn) goto 555 endif endif a(nvar)=a(nvar)+slutn(1) do jnc=1,nn residu(jnc)=residu(jnc)-slutn(1) end do endif endif endif do jnc=1,nn residu(jnc)=abs(residu(jnc)) end do dist2=rffindq(residu,nn,nhalf,index2) c 9555 do step=1,kstep tottimes=tottimes+1 do j=1,nhalf temp(j)=index2(j) end do call rfishsort(temp,nhalf) do j=1,nhalf if(.not.part.or.final) then do mm=1,nvad datt(j,mm)=dat(temp(j),mm) end do else do mm=1,nvad datt(j,mm)=dath(temp(j),mm) end do endif end do call rflsreg(nvmax1, nvmax,nvar,n,a,datt, weights, da, h, * fckw,hvec,nvm11,jmiss,nvad,nn) do jnc=1,nn residu(jnc)=0.D0 do j=1,nvar if(part.and..not.final) then residu(jnc)=residu(jnc)+a(j)*dath(jnc,j) else residu(jnc)=residu(jnc)+a(j)*dat(jnc,j) endif end do if(part.and..not.final) then residu(jnc)=dath(jnc,nvad)-residu(jnc) else residu(jnc)=dat(jnc,nvad)-residu(jnc) endif aw(jnc)=residu(jnc) end do more1=.false. more2=.false. nmore=200 nmore2=nmore/2 if(intadjust.eq.1) then CDDD CALL INTPR('>>> INTERCEPT ADJUSTMENT 2',-1,step,1) if(intercept .eq. 1 .and. ((.not.fine.and.part) .or. * .not.part.or.((nn-nhalf).le.nmore))) then call rfshsort(aw,nn) call rfmcduni(aw,nn,nhalf,slutn,bstd,am,am2, * factor,nn-nhalf+1) a(nvar)=a(nvar)+slutn(1) do jnc=1,nn residu(jnc)=residu(jnc)-slutn(1) end do else if(intercept.eq.1) then call rfshsort(aw,nn) do jj=1,nn am2(jj)=abs(aw(jj)) end do dist2=rffindq(am2,nn,nhalf,index1) do jj=1,nhalf aw2(jj)=aw(index1(jj)) end do dist2=rffindq(aw2,nhalf,1,index2) jnc=index1(index2(1)) if(jnc+nmore-nmore2+nhalf-1.gt.nn.or.jnc-nmore2.lt.1) * then call rfmcduni(aw,nn,nhalf,slutn,bstd,am,am2, * factor,nn-nhalf+1) a(nvar)=a(nvar)+slutn(1) do jnc=1,nn residu(jnc)=residu(jnc)-slutn(1) end do else c--- repeat { .... 666 continue do jj=0,nhalf-1+nmore aw2(jj+1)=aw(jnc-nmore2+jj) end do nlen=nmore+1 call rfmcduni(aw2,nhalf+nmore,nhalf,slutn,bstd, * am,am2,factor,nlen) if(nlen.eq.1.and..not.more1) then if(.not.more2) then nmore=nmore2 nmore2=nmore2+nmore2 more1=.true. if(jnc-nmore2.ge.1) goto 666 endif else if(nlen.eq.(nmore+1).and..not.more2) then if(.not.more1) then nmore=nmore2 nmore2=-nmore2 more2=.true. if(jnc+nmore-nmore2+nhalf-1.le.nn) goto 666 endif else if(nlen.eq.1.and.more1) then if(.not.more2) then nmore2=nmore2+100 if(jnc-nmore2.ge.1) goto 666 endif else if(nlen.eq.(nmore+1).and.more2) then if(.not.more1) then nmore2=nmore2+100 if(jnc+nmore-nmore2+nhalf-1.le.nn) goto 666 endif endif c } (end repeat) c update a[nvar] a(nvar)=a(nvar)+slutn(1) do jnc=1,nn residu(jnc)=residu(jnc)-slutn(1) end do endif endif endif do jnc=1,nn residu(jnc)=abs(residu(jnc)) end do dist2=rffindq(residu,nn,nhalf,index2) fckw=0.D0 do jnc=1,nhalf fckw=fckw+residu(jnc)**2 end do if(step.ge.2 .and. fckw.eq.fckw1) exit ! break {step loop} fckw1=fckwi fckwi=fckw if(final .and. ((i.eq.1.and.step.eq.1 .and. .not.fine) * .or.fckw.lt.object)) then if(i_trace .ge. 3) then call dblepr('Setting objfct= ', -1, fckw,1) endif object=fckw objfct=fckw do jjj=1,nhalf inbest(jjj)=index2(jjj) end do call rfcovcopy(a,bmeans,nvar,1) endif end do ! step in 1..kstep c 5000 if(.not. final) then if(part .and. .not. fine) then iii=ii else iii=1 cc At the end of the algorithm, only the ten cc best solutions need to be stored. endif if( flag((iii-1)*10+1).eq.1) then lll=1 else lll=2 endif do j = lll,10 if (fckw .le. mcdndex(j,2,iii)) then if(fckw.ne.mcdndex(j,2,iii)) then if(.not.fine.and.part) goto 203 goto 205 else do k=j,10 if(fckw.eq.mcdndex(k,2,iii)) then do jjj=1,nvar if(part.and..not.fine) then if(a(jjj).ne.m1stock((iii-1)*10+ * k,jjj)) then goto 203 endif else if(a(jjj).ne.mstock(k,jjj)) goto 205 endif end do endif end do endif exit ! j-loop c ---- cvvv using m1stock[,] 203 do k=10,j+1,-1 do kk=1,nvar m1stock((iii-1)*10+k,kk)= * m1stock((iii-1)*10+k-1,kk) end do mcdndex(k,1,iii)=mcdndex(k-1,1,iii) mcdndex(k,2,iii)=mcdndex(k-1,2,iii) end do do kk=1,nvar m1stock((iii-1)*10+j,kk)=a(kk) end do mcdndex(j,1,iii)=i mcdndex(j,2,iii)=fckw exit ! j-loop c ---- cvvv using mstock[,] 205 do k=10,j+1,-1 do kk=1,nvar mstock(k,kk)= mstock(k-1,kk) end do mcdndex(k,1,iii)=mcdndex(k-1,1,iii) mcdndex(k,2,iii)=mcdndex(k-1,2,iii) end do do kk=1,nvar mstock(j,kk)=a(kk) end do mcdndex(j,1,iii)=i mcdndex(j,2,iii)=fckw exit ! j-loop c ---- endif end do ! j-loop endif 1000 continue c..... end for( i = 1..nrep ) 1111 continue c---- -------- end for( ii = 1..ngroup ) cc if(part .and. .not. fine) then fine=.true. goto 5555 endif if(.not. final .and. (.not.part .or. fine)) then final=.true. goto 5555 endif 9999 continue call rndend C ------ == PutRNGstate() in C return end ccccc end {rfltsreg} =================================================== subroutine rfstatis(x,xmed,xmad,aw2,intercept,nvad,nvmax1, * nmax,n,nstop,MADeps,weights,y,nvar,index2) cc implicit none integer intercept, nvad,nvmax1, nmax, n, nstop, nvar double precision xmed(nvmax1), x(n,nvad), xmad(nvmax1) double precision aw2(nmax) double precision weights(nmax) double precision y(nmax) double precision MADeps double precision rfamdan integer index2(nmax) c integer j,jnc cc nstop=0 c nstop=0: success; =1 : "problem": mad ~= 0 if (intercept.eq.0) then c regression without intercept do 50 j=1,nvad xmed(j)=0.0 do jnc=1,n aw2(jnc)=abs(x(jnc,j)) end do xmad(j)=rfamdan(nmax,aw2,n,index2)*1.4826 if(abs(xmad(j)) .le. MADeps) then xmad(j)=0.0 do jnc=1,n xmad(j)=xmad(j)+aw2(jnc) end do xmad(j)=(xmad(j)/n)*1.2533 if(abs(xmad(j)) .le. MADeps) then nstop=1 return endif endif do jnc=1,n x(jnc,j)=x(jnc,j)/xmad(j) end do 50 continue else c regression with intercept xmed(nvar)=0.D0 xmad(nvar)=1.D0 do 120 j=1,nvad if(j.eq.nvar) goto 120 do jnc=1,n aw2(jnc)=x(jnc,j) end do xmed(j)=rfamdan(nmax,aw2,n,index2) do jnc=1,n aw2(jnc)=abs(aw2(jnc)-xmed(j)) end do xmad(j)=rfamdan(nmax,aw2,n,index2)*1.4826 if(abs(xmad(j)) .le. MADeps) then xmad(j)=0.0 do jnc=1,n xmad(j)=xmad(j)+aw2(jnc) end do xmad(j)=(xmad(j)/n)*1.2533 if(dabs(xmad(j)) .le. MADeps) then nstop=1 return endif endif do jnc=1,n x(jnc,j)=(x(jnc,j)-xmed(j))/xmad(j) end do 120 continue endif do jnc=1,n weights(jnc)=1.0 y(jnc)=x(jnc,nvad) end do return end cc function rfamdan(nmax,aa,n,index2) cc implicit none integer nmax, n, index2(nmax) double precision aa(n) double precision rffindq, rfamdan integer jndl cc jndl=int(n/2.0) if(mod(n,2).eq.0) then rfamdan=(rffindq(aa,n,jndl, index2)+ * rffindq(aa,n,jndl+1,index2))/2.0 else rfamdan=rffindq(aa,n,jndl+1,index2) endif return end cc subroutine rflsreg(nvmax1, nvmax,k, n, f, x, w, da, h,fckw, * hvec,nvm11,jmiss,nvad,nnn) cc Arguments implicit none integer nvmax1, nvmax, k, n, nvm11, nvad, nnn integer jmiss(nvmax1) double precision x(n,nvad), f(k), w(n), da(k) double precision hvec(nvm11), h(nvmax,nvmax1), fckw cc External Functions double precision rfqlsrg cc Var double precision dfckw,dfact, dwjnc,dyj,dfka double precision ank,anul, hda integer j,l, jnc,ka,kplus, mm cc kplus=k+1 do jnc=1,k do j=1,kplus h(jnc,j)=0.D0 end do end do anul=0.0 do 30 jnc=1,nnn call rffcn(k,f,x,jnc,n,nvad) dwjnc=dble(w(jnc)) anul=anul+w(jnc) dyj=dble(x(jnc,kplus)) do ka=1,k dfka=dble(f(ka)) h(ka,k+1)=h(ka,k+1)+dwjnc*dfka*dyj do l=1,ka h(ka,l)=h(ka,l)+dwjnc*dfka*dble(f(l)) end do end do 30 continue do j=1,k do jnc=1,j h(jnc,j)=h(j,jnc) end do end do call rfmatnv(h,nvmax,nvmax1,hvec,nvm11,k,1,jmiss) mm=k+1 fckw = rfqlsrg(k,n,nvmax1,nvmax,f,x, w,h,mm,nvad,nnn) do jnc=1,k f(jnc)=h(jnc,k+1) end do dfckw=dble(fckw) ank=anul-k dfact=dble(ank) dfact=dfckw/dfact do jnc=1,k do j=1,k h(jnc,j)=h(jnc,j)*dfact end do end do do jnc=1,k hda=h(jnc,jnc) da(jnc)=sqrt(hda) end do return end ccccc ccccc subroutine rffcn(k,f,x,jnc,n,nvad) cc implicit none integer k, jnc,n,nvad, j double precision f(k), x(n,nvad) cc do 10,j=1,k f(j)=x(jnc,j) 10 continue return end ccccc ccccc subroutine rfmatnv(an,nvmax,nvmax1,hvec,nvm11,na,nb, jmiss) cc implicit none integer nvmax,nvmax1,nvm11, na,nb integer jmiss(nvmax1) double precision an(nvmax,nvmax1), hvec(nvm11) double precision deter,turn,swap integer j,n, nc, jcl,jdelc,jdla,jdlb,jdm,jhfd, * jnc,jncb,jncc,jncd,jnk,jpaal, nma,npnb, ldel deter=1.0D0 n=na npnb=n+nb jnk=0 do j=1,npnb jnk=(j-1)*nvmax do nc=1,nvmax jnk=jnk+1 hvec(jnk)=an(nc,j) end do end do ldel=0 jdm=nvmax nma=n-1 jdelc=1-jdm do 130 jhfd=1,n turn=0.0D0 jdelc=jdelc+jdm jdla=jdelc+jhfd-1 jdlb=jdelc+nma do 40 jncb=jdla,jdlb if(dabs(hvec(jncb)) .gt. dabs(turn)) then turn=hvec(jncb) ldel=jncb endif 40 continue if (turn .eq. 0) goto 180 jpaal=ldel-jdelc+1 jmiss(jhfd)=jpaal if(jpaal .gt. jhfd) then deter=-deter jpaal=jpaal-jdm jncd=jhfd-jdm do 70 jnc=1,npnb jpaal=jpaal+jdm jncd=jncd+jdm swap=hvec(jncd) hvec(jncd)=hvec(jpaal) hvec(jpaal)=swap 70 continue endif deter=deter*turn turn=1.0D0/turn jncd=jdelc+nma do jnc=jdelc,jncd hvec(jnc)=-hvec(jnc)*turn end do hvec(jdla)=turn jncb=jhfd-jdm jpaal=1-jdm do 120 jnc=1,npnb jpaal=jpaal+jdm jncb=jncb+jdm if(jnc .ne. jhfd) then jcl=jpaal+nma swap=hvec(jncb) jncd=jdelc-1 do jncc=jpaal,jcl jncd=jncd+1 hvec(jncc)=hvec(jncc)+swap*hvec(jncd) end do hvec(jncb)=swap*turn endif 120 continue 130 continue do 160 jncb=1,n jhfd=n+1-jncb ldel=jmiss(jhfd) if(ldel .ne. jhfd) then jpaal=(ldel-1)*jdm+1 jcl=jpaal+nma jdelc=(jhfd-1)*jdm+1-jpaal do jncc=jpaal,jcl jncd=jncc+jdelc swap=hvec(jncc) hvec(jncc)=hvec(jncd) hvec(jncd)=swap end do endif 160 continue c--- 180 jnk=0 do j=1,npnb do nc=1,nvmax jnk=jnk+1 an(nc,j)=hvec(jnk) end do end do return end ccccc ccccc double precision * function rfqlsrg(k,n,nvmax1,nvmax,f,x, w,h,mm,nvad,nnn) cc implicit none integer k,n,nvmax1,nvmax, mm,nvad,nnn double precision f(k), x(n,nvad), w(n), h(nvmax,nvmax1) double precision q,hsum integer jnc,jncb cc q=0.D0 do 30 jnc=1,nnn call rffcn(k,f,x,jnc,n,nvad) hsum=0.D0 do jncb=1,k hsum=h(jncb,mm)*f(jncb)+hsum enddo q=(hsum-x(jnc,mm))*(hsum-x(jnc,mm))*w(jnc)+q 30 continue rfqlsrg=q return end ccccc ccccc subroutine rfrtran(nvar,jcst,nfac,nvad,nvmax1, * xmed,xmad, aa,jal,fckw) cc implicit none integer nvar,jcst,nfac,nvad,nvmax1, jal double precision aa(jal), xmed(nvmax1), xmad(nvmax1), fckw c Var integer j if(nvar.le.1) then aa(1)=aa(1)*xmad(nvad)/xmad(1) else do j=1,nfac aa(j)=aa(j)*xmad(nvad)/xmad(j) end do if(jcst.eq.0) then aa(nvar)=aa(nvar)*xmad(nvad)/xmad(nvar) else aa(nvar)=aa(nvar)*xmad(nvad) do j=1,nfac aa(nvar)=aa(nvar)-aa(j)*xmed(j) end do aa(nvar)=aa(nvar)+xmed(nvad) endif endif fckw=fckw*(xmad(nvad)*xmad(nvad)) return end ccccc ccccc subroutine rftrc(h,da,nvmax,nvmax1,nvar,jcst,nfac,nvad, * xmed,xmad) cc implicit none integer nvmax,nvmax1,nvar,jcst,nfac,nvad double precision h(nvmax,nvmax1), da(nvmax) double precision xmed(nvmax1),xmad(nvmax1) double precision xmp2,hnn integer j,k, k2 cc xmp2=dble(xmad(nvad))*dble(xmad(nvad)) if(jcst.eq.0) then do 10 j=1,nvar do k=1,j h(j,k)=h(j,k)*(xmp2/(dble(xmad(j))*dble(xmad(k)))) end do da(j)=dsqrt(h(j,j)) 10 continue else do j=1,nvar h(j,nvad)=h(j,j) end do do 30, j=1,nvar do k=1,j h(j,k)=h(j,k)*xmp2/(dble(xmad(j))*dble(xmad(k))) end do da(j)=dsqrt(h(j,j)) 30 continue do 50 k=1,nfac h(nvar,k)=h(k,nvar)*xmp2/dble(xmad(k)) do 60 k2=1,nvar if(k.eq.k2) then h(nvar,k)=h(nvar,k)-dble(xmed(k))*xmp2/ * (dble(xmad(k2))*dble(xmad(k)))*h(k2,nvad) else if(k.lt.k2) then h(nvar,k)=h(nvar,k)-(dble(xmed(k2))*xmp2)/ * (dble(xmad(k2))*dble(xmad(k)))*h(k,k2) else ! k > k2 h(nvar,k)=h(nvar,k)-dble(xmed(k2))*xmp2/ * (dble(xmad(k2))*dble(xmad(k)))*h(k2,k) endif 60 continue 50 continue h(nvar,nvar)=h(nvar,nvad)*xmp2 do 70 k=1,nvar h(nvar,nvar)=h(nvar,nvar)+ * (dble(xmed(k))*dble(xmed(k)))*xmp2/ * (dble(xmad(k))*dble(xmad(k)))*h(k,nvad) 70 continue do 80 k=1,nvar if(k.ne.nvar) then h(nvar,nvar)=h(nvar,nvar)-2.0D0*xmp2*dble(xmed(k))/ * (dble(xmad(k)))*h(k,nvar) else h(nvar,nvar)=h(nvar,nvar)-2.0D0*xmp2*dble(xmed(k))/ * (dble(xmad(k)))*h(nvar,nvad) endif 80 continue do j=1,nfac do k=j+1,nvar hnn=2.0D0*dble(xmed(j))*dble(xmed(k))*xmp2 h(nvar,nvar)=h(nvar,nvar)+hnn/ * (dble(xmad(j))*dble(xmad(k)))*h(j,k) end do end do da(nvar)=dsqrt(h(nvar,nvar)) endif return end ccccc ccccc subroutine rfequat(am,nvmax,nvmax1, hvec,nvm11,na,nb,nerr) implicit none integer nvmax,nvmax1, nvm11, na,nb,nerr double precision am(nvmax,nvmax1), hvec(nvm11) double precision turn,swap,deter integer j,n, ldel, jbegc,jbegx,jdel,jdm,jendc,jendx,jhfd,jmat, * jnc,jncb,jncc,jncd,jnce,jncf,jnk,jrow, lclpl, nc,neqa,nznde ldel=0 jdm=nvmax deter=1.0D0 n=na jmat=n+nb jnk=0 do j=1,jmat jnk=(j-1)*nvmax do nc=1,nvmax jnk=jnk+1 hvec(jnk)=am(nc,j) end do end do nznde=n-1 lclpl=-jdm do 120 jhfd=1,n turn=0.D0 lclpl=lclpl+jdm+1 jdel=lclpl+n-jhfd do jncb=lclpl,jdel if(dabs(hvec(jncb)) .gt. dabs(turn)) then turn=hvec(jncb) ldel=jncb endif end do if(dabs(turn) .le. 1D-8) then nerr=-1 goto 180 endif if(ldel .ne. lclpl) then deter=-deter ldel=ldel-jdm jncb=lclpl-jdm do jncc=jhfd,jmat ldel=ldel+jdm jncb=jncb+jdm swap=hvec(jncb) hvec(jncb)=hvec(ldel) hvec(ldel)=swap end do end if deter=deter*turn if(jhfd.eq.n) goto 120 turn=1./turn jncb=lclpl+1 do jncc=jncb,jdel hvec(jncc)=hvec(jncc)*turn end do jncd=lclpl jrow=jhfd+1 do jncb=jrow,n jncd=jncd+1 jnce=lclpl jncf=jncd do jncc=jrow,jmat jnce=jnce+jdm jncf=jncf+jdm hvec(jncf)=hvec(jncf)-hvec(jnce)*hvec(jncd) end do end do 120 continue nerr=0 neqa=n+1 jbegx=nznde*jdm+1 do 150 jnc=neqa,jmat jbegx=jbegx+jdm jendx=jbegx+n jbegc=n*jdm+1 jendc=jbegc+nznde do 140 jncb=1,nznde jendx=jendx-1 jbegc=jbegc-jdm jendc=jendc-jdm-1 hvec(jendx)=hvec(jendx)/hvec(jendc+1) swap=hvec(jendx) jncd=jbegx-1 do jncc=jbegc,jendc jncd=jncd+1 hvec(jncd)=hvec(jncd)-hvec(jncc)*swap end do 140 continue hvec(jbegx)=hvec(jbegx)/hvec(1) 150 continue jnc=-jdm jbegx=nznde*jdm+1 jendx=jbegx+nznde do 160 jncb=neqa,jmat jbegx=jbegx+jdm jendx=jendx+jdm jnc=jnc+jdm jncd=jnc do jncc=jbegx,jendx jncd=jncd+1 hvec(jncd)=hvec(jncc) end do 160 continue 180 jnk=0 do j=1,jmat do nc=1,nvmax jnk=jnk+1 am(nc,j)=hvec(jnk) end do end do return end ccccc C-- VT-- The following functions were added C-- C-- MM: moved to ./rf-common.f - since they are used from ./rffastmcd.f too robustbase/src/rob-utils.c0000644000176200001440000000574212440116711015303 0ustar liggesusers/* * Copyright (C) 2014 Martin Maechler, ETH Zurich * * 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, a copy is available at * http://www.r-project.org/Licenses/ */ #include /* ^^^^^^^^^^ is supposedly more common and standard than * #include * or #include */ /* --> int64_t ; if people don't have the above, they can forget about it.. */ /* #include "int64.h" */ #include /* -> and much more */ // Interface routines to be called via .C(), .Call() : #include "robustbase.h" //-> , -> XLENGTH, R_xlen_t /* Smooth Weighting Function -- typically for computing weights from large distances * ------------------------- * \ <-- quartic polynomial here * \ * --------------------------- * In fact a 2-parameter generalization of Tukey's 1-parameter "biweight" * * --- see also psi, rho, ... utilities in ./lmrob.c */ double wgt_flex(double x, double c, double h) { double h2 = h/2.; x = fabs(x); if (x >= c+h2) return 0. ; if (x <= c-h2) return 1. ; // non-trivial {biweight like} down weighting: x = (x - (c-h2)) / h; // is in (0, 1) x = 1 - x*x; return x*x; // = (1 - ((|x| - (c - h/2))/ h)^2)^2 {in original 'x'} } SEXP R_wgt_flex(SEXP x_, SEXP c_, SEXP h_) { // TODO?: add , SEXP keep_attributes /* * Calculate Flexible weight function for vectorized x */ int nprot = 1; if (isInteger(x_)) { x_ = PROTECT(coerceVector(x_, REALSXP)); nprot++; } if (isInteger(c_)) { c_ = PROTECT(coerceVector(c_, REALSXP)); nprot++; } if (isInteger(h_)) { h_ = PROTECT(coerceVector(h_, REALSXP)); nprot++; } if (!isReal(x_)) error(_("Argument '%s' must be numeric or integer"), "x"); if (!isReal(c_) || LENGTH(c_) != 1) error(_("Argument '%s' must be numeric or integer of length 1"), "c"); if (!isReal(h_) || LENGTH(h_) != 1) error(_("Argument '%s' must be numeric or integer of length 1"), "h"); R_xlen_t i, n = XLENGTH(x_); SEXP res = PROTECT(allocVector(REALSXP, n)); // the result double *x = REAL(x_), *r = REAL(res), c = asReal(c_), h = asReal(h_); for(i = 0; i < n; i++) r[i] = ISNAN(x[i]) ? x[i] : wgt_flex(x[i], c, h); /* if(asLogical(keep_attributes)) { */ // do the "no exception" version of copyMostAttrib() in ..R/src/main/attrib.c /* } */ UNPROTECT(nprot); return res; } robustbase/src/monitor.c0000644000176200001440000000432712433727627015070 0ustar liggesusers// Flexible printing of informative messages from Fortran // ----------------- ------------ // other MM versions: ~/R/Pkgs/cobs99/src/monitor.c ~/R/Pkgs/lokern/src/monitor.c #include /* called for trace >= 2 : ----------------------------------------------- */ void F77_SUB(pr1mcd)(int *i_trace, int *n, int *nvar, int *nhallf, int *krep, int *nmini, int *kmini) { Rprintf("rffastmcd(n=%d, nvar=%d, nhallf=%d, krep=%d, nmini=%d, kmini=%d, i_trace=%d)\n", *n, *nvar, *nhallf, *krep, *nmini, *kmini, *i_trace); } void F77_SUB(pr2mcd)(Rboolean *part, Rboolean *all, // <- logical int *kstep, int *ngroup, int *minigr, int *nhalf, int *nrep) { Rprintf("pr[2]: (part=%d, all=%d); (kstep=%d, ngroup=%d, minigr=%d, nhalf=%d, nrep=%d)\n", *part, *all, *kstep, *ngroup, *minigr, *nhalf, *nrep); } void F77_SUB(pr3mcd)(Rboolean *part, Rboolean *fine, int *final, // <- logical int *nrep, int *nn, int *nsel, int *nhalf, int *kstep, int *nmini, int *nmaxi) { char* phase_kind = (*part) ? ((*fine && !*final) ? "fine (2 of 3)" : ((*final) ? "final (3 of 3)" : "first (of 3)")) : ((*final) ? "final" : "one"); Rprintf(" Main loop, phase[%s]:\n (nrep=%4d, nn=%4d, nsel=%4d, nhalf=%4d, kstep=%d, nmini=%d, nmaxi=%d)\n", phase_kind, *nrep, *nn, *nsel, *nhalf, *kstep, *nmini, *nmaxi); } void F77_SUB(prp1mcd)(int *n, int *ngroup, int *minigr, int *nhalf, int *nrep, int mini[]) { // int mini[*kmini]; Rprintf(" Partitioning n=%d into at most kmini groups: ngroup=%d, minigr=%d, nhalf=%d, nrep=%d;" "\n groups are of sizes (", *n, *ngroup, *minigr, *nhalf, *nrep); for(int j=0; j < *ngroup; j++) Rprintf(" %d", mini[j]); Rprintf(")\n"); } void F77_SUB(pr9mcd)(int *ntot) { Rprintf(" -- finishing: total times = %d\n", *ntot); } /* called for trace >= 3 : ----------------------------------------------- */ void F77_SUB(prgrmcd)(int *ii, int *nn, int *i_trace) { Rprintf(" group ii = %d (nn = %d)%s\n", *ii, *nn, (*i_trace >= 4) ? ": i=1..nrep loop: " : ""); } void F77_SUB(pr4mcd)(int *i) { Rprintf(" i = %d "); } void F77_SUB(pr5mcd)(int *step, int *ntot) { Rprintf("(step %d, tot=%d)", *step, *ntot); } robustbase/src/eigen.f0000644000176200001440000005117112432357143014461 0ustar liggesusersc--- EISPACK Eigen Value Computation --- c--- ================================ --- c--- This has been /src/appl/eigen.f from the 1990's upto 2013 c--- when it has become deprecated and unused in R's own sources ---------- c--- c--- "TODO": Use LAPACK's eigen routines instead ------------------------ c--- ====== -------------------------------------------------------------- c DOUBLE PRECISION FUNCTION EPSLON (X) DOUBLE PRECISION X C C ESTIMATE UNIT ROUNDOFF IN QUANTITIES OF SIZE X. C DOUBLE PRECISION A,B,C,EPS C C THIS PROGRAM SHOULD FUNCTION PROPERLY ON ALL SYSTEMS C SATISFYING THE FOLLOWING TWO ASSUMPTIONS, C 1. THE BASE USED IN REPRESENTING FLOATING POINT C NUMBERS IS NOT A POWER OF THREE. C 2. THE QUANTITY A IN STATEMENT 10 IS REPRESENTED TO C THE ACCURACY USED IN FLOATING POINT VARIABLES C THAT ARE STORED IN MEMORY. C THE STATEMENT NUMBER 10 AND THE GO TO 10 ARE INTENDED TO C FORCE OPTIMIZING COMPILERS TO GENERATE CODE SATISFYING C ASSUMPTION 2. C UNDER THESE ASSUMPTIONS, IT SHOULD BE TRUE THAT, C A IS NOT EXACTLY EQUAL TO FOUR-THIRDS, C B HAS A ZERO FOR ITS LAST BIT OR DIGIT, C C IS NOT EXACTLY EQUAL TO ONE, C EPS MEASURES THE SEPARATION OF 1.0 FROM C THE NEXT LARGER FLOATING POINT NUMBER. C THE DEVELOPERS OF EISPACK WOULD APPRECIATE BEING INFORMED C ABOUT ANY SYSTEMS WHERE THESE ASSUMPTIONS DO NOT HOLD. C C THIS VERSION DATED 4/6/83. C A = 4.0D0/3.0D0 10 B = A - 1.0D0 C = B + B + B EPS = DABS(C-1.0D0) IF (EPS .EQ. 0.0D0) GO TO 10 EPSLON = EPS*DABS(X) RETURN END DOUBLE PRECISION FUNCTION PYTHAG(A,B) DOUBLE PRECISION A,B C C FINDS DSQRT(A**2+B**2) WITHOUT OVERFLOW OR DESTRUCTIVE UNDERFLOW C DOUBLE PRECISION P,R,S,T,U P = DMAX1(DABS(A),DABS(B)) IF (P .EQ. 0.0D0) GO TO 20 R = (DMIN1(DABS(A),DABS(B))/P)**2 10 CONTINUE T = 4.0D0 + R IF (T .EQ. 4.0D0) GO TO 20 S = R/T U = 1.0D0 + 2.0D0*S P = U*P R = (S/U)**2 * R GO TO 10 20 PYTHAG = P RETURN END SUBROUTINE RS(NM,N,A,W,MATZ,Z,FV1,FV2,IERR) C INTEGER N,NM,IERR,MATZ DOUBLE PRECISION A(NM,N),W(N),Z(NM,N),FV1(N),FV2(N) C C THIS SUBROUTINE CALLS THE RECOMMENDED SEQUENCE OF C SUBROUTINES FROM THE EIGENSYSTEM SUBROUTINE PACKAGE (EISPACK) C TO FIND THE EIGENVALUES AND EIGENVECTORS (IF DESIRED) C OF A REAL SYMMETRIC MATRIX. C C ON INPUT C C NM MUST BE SET TO THE ROW DIMENSION OF THE TWO-DIMENSIONAL C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM C DIMENSION STATEMENT. C C N IS THE ORDER OF THE MATRIX A. C C A CONTAINS THE REAL SYMMETRIC MATRIX. C C MATZ IS AN INTEGER VARIABLE SET EQUAL TO ZERO IF C ONLY EIGENVALUES ARE DESIRED. OTHERWISE IT IS SET TO C ANY NON-ZERO INTEGER FOR BOTH EIGENVALUES AND EIGENVECTORS. C C ON OUTPUT C C W CONTAINS THE EIGENVALUES IN ASCENDING ORDER. C C Z CONTAINS THE EIGENVECTORS IF MATZ IS NOT ZERO. C C IERR IS AN INTEGER OUTPUT VARIABLE SET EQUAL TO AN ERROR C COMPLETION CODE DESCRIBED IN THE DOCUMENTATION FOR TQLRAT C AND TQL2. THE NORMAL COMPLETION CODE IS ZERO. C C FV1 AND FV2 ARE TEMPORARY STORAGE ARRAYS. C C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY C C THIS VERSION DATED AUGUST 1983. C C ------------------------------------------------------------------ C IF (N .LE. NM) GO TO 10 IERR = 10 * N GO TO 50 C 10 IF (MATZ .NE. 0) GO TO 20 C .......... FIND EIGENVALUES ONLY .......... CALL TRED1(NM,N,A,W,FV1,FV2) CALL TQLRAT(N,W,FV2,IERR) GO TO 50 C .......... FIND BOTH EIGENVALUES AND EIGENVECTORS .......... 20 CALL TRED2(NM,N,A,W,FV1,Z) CALL TQL2(NM,N,W,FV1,Z,IERR) 50 RETURN END SUBROUTINE TQL2(NM,N,D,E,Z,IERR) C INTEGER I,J,K,L,M,N,II,L1,L2,NM,MML,IERR DOUBLE PRECISION D(N),E(N),Z(NM,N) DOUBLE PRECISION C,C2,C3,DL1,EL1,F,G,H,P,R,S,S2,TST1,TST2,PYTHAG C C THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TQL2, C NUM. MATH. 11, 293-306(1968) BY BOWDLER, MARTIN, REINSCH, AND C WILKINSON. C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 227-240(1971). C C THIS SUBROUTINE FINDS THE EIGENVALUES AND EIGENVECTORS C OF A SYMMETRIC TRIDIAGONAL MATRIX BY THE QL METHOD. C THE EIGENVECTORS OF A FULL SYMMETRIC MATRIX CAN ALSO C BE FOUND IF TRED2 HAS BEEN USED TO REDUCE THIS C FULL MATRIX TO TRIDIAGONAL FORM. C C ON INPUT C C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM C DIMENSION STATEMENT. C C N IS THE ORDER OF THE MATRIX. C C D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX. C C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX C IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY. C C Z CONTAINS THE TRANSFORMATION MATRIX PRODUCED IN THE C REDUCTION BY TRED2, IF PERFORMED. IF THE EIGENVECTORS C OF THE TRIDIAGONAL MATRIX ARE DESIRED, Z MUST CONTAIN C THE IDENTITY MATRIX. C C ON OUTPUT C C D CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN C ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT BUT C UNORDERED FOR INDICES 1,2,...,IERR-1. C C E HAS BEEN DESTROYED. C C Z CONTAINS ORTHONORMAL EIGENVECTORS OF THE SYMMETRIC C TRIDIAGONAL (OR FULL) MATRIX. IF AN ERROR EXIT IS MADE, C Z CONTAINS THE EIGENVECTORS ASSOCIATED WITH THE STORED C EIGENVALUES. C C IERR IS SET TO C ZERO FOR NORMAL RETURN, C J IF THE J-TH EIGENVALUE HAS NOT BEEN C DETERMINED AFTER 30 ITERATIONS. C C CALLS PYTHAG FOR DSQRT(A*A + B*B) . C C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY C C THIS VERSION DATED AUGUST 1983. C C ------------------------------------------------------------------ c c unnecessary initialization of C3 and S2 to keep g77 -Wall happy c C3 = 0.0D0 S2 = 0.0D0 C IERR = 0 IF (N .EQ. 1) GO TO 1001 C do I = 2, N E(I-1) = E(I) end do C F = 0.0D0 TST1 = 0.0D0 E(N) = 0.0D0 C DO 240 L = 1, N J = 0 H = DABS(D(L)) + DABS(E(L)) IF (TST1 .LT. H) TST1 = H C .......... LOOK FOR SMALL SUB-DIAGONAL ELEMENT .......... DO 110 M = L, N TST2 = TST1 + DABS(E(M)) IF (TST2 .EQ. TST1) GO TO 120 C .......... E(N) IS ALWAYS ZERO, SO THERE IS NO EXIT C THROUGH THE BOTTOM OF THE LOOP .......... 110 CONTINUE C 120 IF (M .EQ. L) GO TO 220 130 IF (J .EQ. 30) GO TO 1000 J = J + 1 C .......... FORM SHIFT .......... L1 = L + 1 L2 = L1 + 1 G = D(L) P = (D(L1) - G) / (2.0D0 * E(L)) R = PYTHAG(P,1.0D0) D(L) = E(L) / (P + DSIGN(R,P)) D(L1) = E(L) * (P + DSIGN(R,P)) DL1 = D(L1) H = G - D(L) IF (L2 .GT. N) GO TO 145 C DO I = L2, N D(I) = D(I) - H end do C 145 F = F + H C .......... QL TRANSFORMATION .......... P = D(M) C = 1.0D0 C2 = C EL1 = E(L1) S = 0.0D0 MML = M - L C .......... FOR I=M-1 STEP -1 UNTIL L DO -- .......... DO 200 II = 1, MML C3 = C2 C2 = C S2 = S I = M - II G = C * E(I) H = C * P R = PYTHAG(P,E(I)) E(I+1) = S * R S = E(I) / R C = P / R P = C * D(I) - S * G D(I+1) = H + S * (C * G + S * D(I)) C .......... FORM VECTOR .......... DO 180 K = 1, N H = Z(K,I+1) Z(K,I+1) = S * Z(K,I) + C * H Z(K,I) = C * Z(K,I) - S * H 180 CONTINUE C 200 CONTINUE C P = -S * S2 * C3 * EL1 * E(L) / DL1 E(L) = S * P D(L) = C * P TST2 = TST1 + DABS(E(L)) IF (TST2 .GT. TST1) GO TO 130 220 D(L) = D(L) + F 240 CONTINUE C .......... ORDER EIGENVALUES AND EIGENVECTORS .......... DO 300 II = 2, N I = II - 1 K = I P = D(I) C DO 260 J = II, N IF (D(J) .GE. P) GO TO 260 K = J P = D(J) 260 CONTINUE C IF (K .EQ. I) GO TO 300 D(K) = D(I) D(I) = P C DO 280 J = 1, N P = Z(J,I) Z(J,I) = Z(J,K) Z(J,K) = P 280 CONTINUE C 300 CONTINUE C GO TO 1001 C .......... SET ERROR -- NO CONVERGENCE TO AN C EIGENVALUE AFTER 30 ITERATIONS .......... 1000 IERR = L 1001 RETURN END SUBROUTINE TQLRAT(N,D,E2,IERR) C INTEGER I,J,L,M,N,II,L1,MML,IERR DOUBLE PRECISION D(N),E2(N) DOUBLE PRECISION B,C,F,G,H,P,R,S,T,EPSLON,PYTHAG C C THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TQLRAT, C ALGORITHM 464, COMM. ACM 16, 689(1973) BY REINSCH. C C THIS SUBROUTINE FINDS THE EIGENVALUES OF A SYMMETRIC C TRIDIAGONAL MATRIX BY THE RATIONAL QL METHOD. C C ON INPUT C C N IS THE ORDER OF THE MATRIX. C C D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX. C C E2 CONTAINS THE SQUARES OF THE SUBDIAGONAL ELEMENTS OF THE C INPUT MATRIX IN ITS LAST N-1 POSITIONS. E2(1) IS ARBITRARY. C C ON OUTPUT C C D CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN C ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT AND C ORDERED FOR INDICES 1,2,...IERR-1, BUT MAY NOT BE C THE SMALLEST EIGENVALUES. C C E2 HAS BEEN DESTROYED. C C IERR IS SET TO C ZERO FOR NORMAL RETURN, C J IF THE J-TH EIGENVALUE HAS NOT BEEN C DETERMINED AFTER 30 ITERATIONS. C C CALLS PYTHAG FOR DSQRT(A*A + B*B) . C C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY C C THIS VERSION DATED AUGUST 1983. C C ------------------------------------------------------------------ c c unnecessary initialization of B and C to keep g77 -Wall happy c B = 0.0D0 C = 0.0D0 C IERR = 0 IF (N .EQ. 1) GO TO 1001 C DO I = 2, N E2(I-1) = E2(I) end do C F = 0.0D0 T = 0.0D0 E2(N) = 0.0D0 C DO 290 L = 1, N J = 0 H = DABS(D(L)) + DSQRT(E2(L)) IF (T .GT. H) GO TO 105 T = H B = EPSLON(T) C = B * B C .......... LOOK FOR SMALL SQUARED SUB-DIAGONAL ELEMENT .......... 105 DO 110 M = L, N IF (E2(M) .LE. C) GO TO 120 C .......... E2(N) IS ALWAYS ZERO, SO THERE IS NO EXIT C THROUGH THE BOTTOM OF THE LOOP .......... 110 CONTINUE C 120 IF (M .EQ. L) GO TO 210 130 IF (J .EQ. 30) GO TO 1000 J = J + 1 C .......... FORM SHIFT .......... L1 = L + 1 S = DSQRT(E2(L)) G = D(L) P = (D(L1) - G) / (2.0D0 * S) R = PYTHAG(P,1.0D0) D(L) = S / (P + DSIGN(R,P)) H = G - D(L) C DO I = L1, N D(I) = D(I) - H end do C F = F + H C .......... RATIONAL QL TRANSFORMATION .......... G = D(M) IF (G .EQ. 0.0D0) G = B H = G S = 0.0D0 MML = M - L C .......... FOR I=M-1 STEP -1 UNTIL L DO -- .......... DO 200 II = 1, MML I = M - II P = G * H R = P + E2(I) E2(I+1) = S * R S = E2(I) / R D(I+1) = H + S * (H + D(I)) G = D(I) - E2(I) / G IF (G .EQ. 0.0D0) G = B H = G * P / R 200 CONTINUE C E2(L) = S * G D(L) = H C .......... GUARD AGAINST UNDERFLOW IN CONVERGENCE TEST .......... IF (H .EQ. 0.0D0) GO TO 210 IF (DABS(E2(L)) .LE. DABS(C/H)) GO TO 210 E2(L) = H * E2(L) IF (E2(L) .NE. 0.0D0) GO TO 130 210 P = D(L) + F C .......... ORDER EIGENVALUES .......... IF (L .EQ. 1) GO TO 250 C .......... FOR I=L STEP -1 UNTIL 2 DO -- .......... DO 230 II = 2, L I = L + 2 - II IF (P .GE. D(I-1)) GO TO 270 D(I) = D(I-1) 230 CONTINUE C 250 I = 1 270 D(I) = P 290 CONTINUE C GO TO 1001 C .......... SET ERROR -- NO CONVERGENCE TO AN C EIGENVALUE AFTER 30 ITERATIONS .......... 1000 IERR = L 1001 RETURN END SUBROUTINE TRED1(NM,N,A,D,E,E2) C INTEGER I,J,K,L,N,II,NM,JP1 DOUBLE PRECISION A(NM,N),D(N),E(N),E2(N) DOUBLE PRECISION F,G,H,SCALE C C THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TRED1, C NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). C C THIS SUBROUTINE REDUCES A REAL SYMMETRIC MATRIX C TO A SYMMETRIC TRIDIAGONAL MATRIX USING C ORTHOGONAL SIMILARITY TRANSFORMATIONS. C C ON INPUT C C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM C DIMENSION STATEMENT. C C N IS THE ORDER OF THE MATRIX. C C A CONTAINS THE REAL SYMMETRIC INPUT MATRIX. ONLY THE C LOWER TRIANGLE OF THE MATRIX NEED BE SUPPLIED. C C ON OUTPUT C C A CONTAINS INFORMATION ABOUT THE ORTHOGONAL TRANS- C FORMATIONS USED IN THE REDUCTION IN ITS STRICT LOWER C TRIANGLE. THE FULL UPPER TRIANGLE OF A IS UNALTERED. C C D CONTAINS THE DIAGONAL ELEMENTS OF THE TRIDIAGONAL MATRIX. C C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE TRIDIAGONAL C MATRIX IN ITS LAST N-1 POSITIONS. E(1) IS SET TO ZERO. C C E2 CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF E. C E2 MAY COINCIDE WITH E IF THE SQUARES ARE NOT NEEDED. C C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY C C THIS VERSION DATED AUGUST 1983. C C ------------------------------------------------------------------ C DO 100 I = 1, N D(I) = A(N,I) A(N,I) = A(I,I) 100 CONTINUE C .......... FOR I=N STEP -1 UNTIL 1 DO -- .......... DO 300 II = 1, N I = N + 1 - II L = I - 1 H = 0.0D0 SCALE = 0.0D0 IF (L .LT. 1) GO TO 130 C .......... SCALE ROW (ALGOL TOL THEN NOT NEEDED) .......... DO K = 1, L SCALE = SCALE + DABS(D(K)) end do C IF (SCALE .NE. 0.0D0) GO TO 140 C DO 125 J = 1, L D(J) = A(L,J) A(L,J) = A(I,J) A(I,J) = 0.0D0 125 CONTINUE C 130 E(I) = 0.0D0 E2(I) = 0.0D0 GO TO 300 C 140 continue DO K = 1, L D(K) = D(K) / SCALE H = H + D(K) * D(K) end do C E2(I) = SCALE * SCALE * H F = D(L) G = -DSIGN(DSQRT(H),F) E(I) = SCALE * G H = H - F * G D(L) = F - G IF (L .gt. 1) then C .......... FORM A*U .......... DO J = 1, L E(J) = 0.0D0 end do C DO 240 J = 1, L F = D(J) G = E(J) + A(J,J) * F JP1 = J + 1 IF (L .ge. JP1) then DO K = JP1, L G = G + A(K,J) * D(K) E(K) = E(K) + A(K,J) * F end do end if E(J) = G 240 CONTINUE C .......... FORM P .......... F = 0.0D0 C DO J = 1, L E(J) = E(J) / H F = F + E(J) * D(J) end do C H = F / (H + H) C .......... FORM Q .......... DO J = 1, L E(J) = E(J) - H * D(J) end do C .......... FORM REDUCED A .......... DO J = 1, L F = D(J) G = E(J) DO K = J, L A(K,J) = A(K,J) - F * E(K) - G * D(K) end do end do end if c 285 DO J = 1, L F = D(J) D(J) = A(L,J) A(L,J) = A(I,J) A(I,J) = F * SCALE end do C 300 CONTINUE RETURN END SUBROUTINE TRED2(NM,N,A,D,E,Z) C INTEGER I,J,K,L,N,II,NM,JP1 DOUBLE PRECISION A(NM,N),D(N),E(N),Z(NM,N) DOUBLE PRECISION F,G,H,HH,SCALE C C THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TRED2, C NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). C C THIS SUBROUTINE REDUCES A REAL SYMMETRIC MATRIX TO A C SYMMETRIC TRIDIAGONAL MATRIX USING AND ACCUMULATING C ORTHOGONAL SIMILARITY TRANSFORMATIONS. C C ON INPUT C C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM C DIMENSION STATEMENT. C C N IS THE ORDER OF THE MATRIX. C C A CONTAINS THE REAL SYMMETRIC INPUT MATRIX. ONLY THE C LOWER TRIANGLE OF THE MATRIX NEED BE SUPPLIED. C C ON OUTPUT C C D CONTAINS THE DIAGONAL ELEMENTS OF THE TRIDIAGONAL MATRIX. C C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE TRIDIAGONAL C MATRIX IN ITS LAST N-1 POSITIONS. E(1) IS SET TO ZERO. C C Z CONTAINS THE ORTHOGONAL TRANSFORMATION MATRIX C PRODUCED IN THE REDUCTION. C C A AND Z MAY COINCIDE. IF DISTINCT, A IS UNALTERED. C C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY C C THIS VERSION DATED AUGUST 1983. C C ------------------------------------------------------------------ C DO I = 1, N DO J = I, N Z(J,I) = A(J,I) end do D(I) = A(N,I) end do C IF (N .EQ. 1) GO TO 510 C .......... FOR I=N STEP -1 UNTIL 2 DO -- .......... DO 300 II = 2, N I = N + 2 - II L = I - 1 H = 0.0D0 SCALE = 0.0D0 IF (L .LT. 2) GO TO 130 C .......... SCALE ROW (ALGOL TOL THEN NOT NEEDED) .......... DO K = 1, L SCALE = SCALE + DABS(D(K)) end do C IF (SCALE .NE. 0.0D0) GO TO 140 130 E(I) = D(L) C DO J = 1, L D(J) = Z(L,J) Z(I,J) = 0.0D0 Z(J,I) = 0.0D0 end do C GO TO 290 C 140 CONTINUE DO K = 1, L D(K) = D(K) / SCALE H = H + D(K) * D(K) end do C F = D(L) G = -DSIGN(DSQRT(H),F) E(I) = SCALE * G H = H - F * G D(L) = F - G C .......... FORM A*U .......... DO J = 1, L E(J) = 0.0D0 end do C DO 240 J = 1, L F = D(J) Z(J,I) = F G = E(J) + Z(J,J) * F JP1 = J + 1 IF (L .ge. JP1) then do K = JP1, L G = G + Z(K,J) * D(K) E(K) = E(K) + Z(K,J) * F end do end if E(J) = G 240 CONTINUE C .......... FORM P .......... F = 0.0D0 C do J = 1, L E(J) = E(J) / H F = F + E(J) * D(J) end do C HH = F / (H + H) C .......... FORM Q .......... do J = 1, L E(J) = E(J) - HH * D(J) end do C .......... FORM REDUCED A .......... DO J = 1, L F = D(J) G = E(J) C do K = J, L Z(K,J) = Z(K,J) - F * E(K) - G * D(K) end do C D(J) = Z(L,J) Z(I,J) = 0.0D0 end do C 290 D(I) = H 300 CONTINUE C .......... ACCUMULATION OF TRANSFORMATION MATRICES .......... do I = 2, N L = I - 1 Z(N,L) = Z(L,L) Z(L,L) = 1.0D0 H = D(I) IF (H .EQ. 0.0D0) GO TO 380 C do K = 1, L D(K) = Z(K,I) / H end do C DO J = 1, L G = 0.0D0 C do K = 1, L G = G + Z(K,I) * Z(K,J) end do C do K = 1, L Z(K,J) = Z(K,J) - G * D(K) end do end do 380 continue do K = 1, L Z(K,I) = 0.0D0 end do end do C 510 CONTINUE DO I = 1, N D(I) = Z(N,I) Z(N,I) = 0.0D0 end do Z(N,N) = 1.0D0 E(1) = 0.0D0 RETURN END robustbase/src/lmrob.c0000644000176200001440000026034313326344173014507 0ustar liggesusers/* -*- mode: c; kept-new-versions: 40; kept-old-versions: 40 -*- * Indentation (etc) style: C-c . gnu */ /* file lmrob.c * was roblm/src/roblm.c - version 0.6 by Matias Salibian-Barreras * Includes the stable correct asymptotic variance estimators * of Croux, Dhaene, Hoorelbeke * Includes the fast-s algorithm */ /* Robust MM regression estimates * * ------------------------------ */ /* comment code * * * adapt other sampler <<<<<<<<<< R's random number generator !!!! * replace abort for too many singular resamples by * returning the number of singular ones */ /* MM: - Done: fast_s[_large_n]() both had FIXED seed (= 37), and effectively discarded the seed_rand argument below - Done: drop 'register' : today's compilers do optimize well! - Done: using Calloc() / Free() instead of malloc()/free() */ /* kollerma: Added alternative psi functions callable via psifun, chifun and wgtfun. ipsi is used to distinguish between the different types. The ipsi argument works for the S-estimator as well as for the MM-estimator. - Added implementation of M-S algorithm. - Modified subsampling behaviour: avoiding singular resamples by using customized LU decomposition. - Replaced C style matrices with Fortran style matrices, with as little copying as possible. - Using LAPACK's DGELS instead of local lu() decomposition. - Code clean up: removed all subroutines that were unused. */ #include #include #include #include #include "robustbase.h" //-> , -> XLENGTH, R_xlen_t /* these will also move to "lmrob.h" --- * but first make many of these 'static' <<< FIXME! */ void fast_s_large_n(double *X, double *y, int *nn, int *pp, int *nRes, int *max_it_scale, double *res, int *ggroups, int *nn_group, int *K, int *max_k, double rel_tol, double inv_tol, double scale_tol, int *converged, int *best_r, double *bb, double *rrhoc, int *iipsi, double *bbeta, double *sscale, int trace_lev, int mts, Rboolean ss); void fast_s(double *X, double *y, int *nn, int *pp, int *nRes, int *max_it_scale, double *res, int *K, int *max_k, double rel_tol, double inv_tol, double scale_tol, int *converged, int *best_r, double *bb, double *rrhoc, int *iipsi, double *bbeta, double *sscale, int trace_lev, int mts, Rboolean ss); Rboolean rwls(const double X[], const double y[], int n, int p, double *estimate, double *i_estimate, double *resid, double *loss, double scale, double epsilon, int *max_it, double *rho_c, const int ipsi, int trace_lev); static void sample_noreplace(int *x, int n, int k, int *ind_space); double norm2 (double *x, int n); double norm (double *x, int n); double norm1(double *x, int n); double norm_diff2 (double *x, double *y, int n); double norm_diff (double *x, double *y, int n); double norm1_diff(double *x, double *y, int n); /* moved to robustbase.h * * double normcnst(const double c[], int ipsi); * double rho_inf (const double c[], int ipsi); * double rho(double x, const double c[], int ipsi); * double psi(double x, const double c[], int ipsi); * double psip(double x, const double c[], int ipsi);// psi' * double psi2(double x, const double c[], int ipsi);// psi'' * double wgt(double x, const double c[], int ipsi); */ double rho_huber(double x, const double c[]); double psi_huber(double x, const double c[]); double psip_huber(double x, const double c[]); double psi2_huber(double x, const double c[]); double wgt_huber(double x, const double c[]); double rho_biwgt(double x, const double c[]); double psi_biwgt(double x, const double c[]); double psip_biwgt(double x, const double c[]); double psi2_biwgt(double x, const double c[]); double wgt_biwgt(double x, const double c[]); double rho_gwgt(double x, const double c[]); double psi_gwgt(double x, const double c[]); double psip_gwgt(double x, const double c[]); double wgt_gwgt(double x, const double c[]); double rho_opt(double x, const double c[]); double psi_opt(double x, const double c[]); double psip_opt(double x, const double c[]); double wgt_opt(double x, const double c[]); double rho_hmpl(double x, const double c[]); double psi_hmpl(double x, const double c[]); double psip_hmpl(double x, const double c[]); double psi2_hmpl(double x, const double c[]); double wgt_hmpl(double x, const double c[]); double rho_ggw(double x, const double c[]); void psi_ggw_vec(double *x, int n, void *k); double psi_ggw(double x, const double c[]); double psip_ggw(double x, const double c[]); double wgt_ggw(double x, const double c[]); double rho_lqq(double x, const double c[]); double psi_lqq(double x, const double c[]); double psip_lqq(double x, const double c[]); double psi2_lqq(double x, const double c[]); double wgt_lqq(double x, const double c[]); double sum_rho_sc(const double r[], double scale, int n, int p, const double c[], int ipsi); void get_weights_rhop(const double r[], double s, int n, const double rrhoc[], int ipsi, /* --> */ double *w); int refine_fast_s(const double X[], double *wx, const double y[], double *wy, double *weights, int n, int p, double *res, double *work, int lwork, double *beta_cand, int kk, Rboolean *conv, int max_k, double rel_tol, int trace_lev, double b, double *rrhoc, int ipsi, double initial_scale, double *beta_ref, double *scale); void m_s_subsample(double *X1, double *y, int n, int p1, int p2, int nResample, int max_it_scale, double rel_tol, double inv_tol, double scale_tol, double *bb, double *rrhoc, int ipsi, double *sscale, int trace_lev, double *b1, double *b2, double *t1, double *t2, double *y_tilde, double *res, double *x1, double *x2, int *NIT, int *K, int *KODE, double *SIGMA, double *BET0, double *SC1, double *SC2, double *SC3, double *SC4, int mts, Rboolean ss); Rboolean m_s_descent(double *X1, double *X2, double *y, int n, int p1, int p2, int K_m_s, int max_k, int max_it_scale, double rel_tol, double scale_tol, double *bb, double *rrhoc, int ipsi, double *sscale, int trace_lev, double *b1, double *b2, double *t1, double *t2, double *y_tilde, double *res, double *res2, double *x1, double *x2, int *NIT, int *K, int *KODE, double *SIGMA, double *BET0, double *SC1, double *SC2, double *SC3, double *SC4); int subsample(const double x[], const double y[], int n, int m, double *beta, int *ind_space, int *idc, int *idr, double *lu, double *v, int *p, double *Dr, double *Dc, int rowequ, int colequ, Rboolean sample, int mts, Rboolean ss, double tol_inv, Rboolean solve); Rboolean fast_s_with_memory(double *X, double *y, double *res, int *nn, int *pp, int *nRes, int *max_it_scale, int *K, int *max_k, double rel_tol, double inv_tol, double scale_tol, int trace_lev, int *best_r, double *bb, double *rrhoc, int *iipsi, double **best_betas, double *best_scales, int mts, Rboolean ss); /* for "tracing" only : */ void disp_mat(double **a, int n, int m); void disp_vec(double *a, int n); void disp_veci(int *a, int n); double kthplace(double *, int, int); int find_max(double *a, int n); double find_scale(const double r[], double b, const double rrhoc[], int ipsi, double initial_scale, int n, int p, int* iter, // input: max_iter, output: #{iterations used} double scale_tol, Rboolean trace); double median_abs(double *, int, double *); double MAD(double *a, int n, double center, double *tmp, double *tmp2); void zero_mat(double **a, int n, int m); #define INIT_WLS(_X_, _y_, _n_, _p_) \ /* Determine optimal block size for work array*/ \ F77_CALL(dgels)("N", &_n_, &_p_, &one, _X_, &_n_, _y_, \ &_n_, &work0, &lwork, &info); \ if (info) { \ warning(" Problem determining optimal block size, using minimum"); \ lwork = 2*_p_; \ } else \ lwork = (int)work0; \ \ if (trace_lev >= 4) \ Rprintf(" Optimal block size for DGELS: %d\n", lwork); \ \ /* allocate */ \ work = (double *) Calloc(lwork, double); \ weights = (double *) Calloc(n, double); #define CLEANUP_WLS \ Free(work); Free(weights); #define CLEANUP_EQUILIBRATION \ Free(Dr); Free(Dc); Free(Xe); #define CLEANUP_SUBSAMPLE \ Free(ind_space); Free(idc); Free(idr); Free(pivot); \ Free(lu); Free(v); \ CLEANUP_EQUILIBRATION; #define FIT_WLS(_X_, _x_, _y_, _n_, _p_) \ /* add weights to _y_ and _x_ */ \ for (j=0; j<_n_; j++) { \ wtmp = sqrt(weights[j]); \ _y_[j] *= wtmp; \ for (k=0; k<_p_; k++) \ _x_[_n_*k+j] = _X_[_n_*k+j] * wtmp; \ } \ /* solve weighted least squares problem */ \ F77_CALL(dgels)("N", &_n_, &_p_, &one, _x_, &_n_, _y_, \ &_n_, work, &lwork, &info); \ if (info) { \ if (info < 0) { \ CLEANUP_WLS; \ error("DGELS: illegal argument in %i. argument.", info); \ } else { \ if (trace_lev >= 4) { \ Rprintf(" Robustness weights in failing step: "); \ disp_vec(weights, _n_); \ } \ CLEANUP_WLS; \ error("DGELS: weighted design matrix not of full rank (column %d).\nUse control parameter 'trace.lev = 4' to get diagnostic output.", info); \ } \ } #define SETUP_EQUILIBRATION(_n_, _p_, _X_, _large_n_) \ /* equilibration of matrix _X_ */ \ /* solve (Dr X Dc) b = Dr y with beta = Dc b instead of */ \ /* X beta = y */ \ /* see Demmel (1997) APPLIED NUMERICAL LINEAR ALGEBRA */ \ /* Section 2.5.2 Equilibration */ \ double *Dr, *Dc, *Xe, rowcnd, colcnd, amax; \ int rowequ = 0 , colequ = 0; \ Dr = (double *) Calloc(_n_, double); \ Dc = (double *) Calloc(_p_, double); \ Xe = (double *) Calloc(_n_*_p_, double); \ COPY(_X_, Xe, _n_*_p_); \ F77_CALL(dgeequ)(&_n_, &_p_, Xe, &_n_, Dr, Dc, &rowcnd, \ &colcnd, &amax, &info); \ if (info) { \ if (info < 0) { \ CLEANUP_EQUILIBRATION; \ error("DGEEQ: illegal argument in %i. argument", -1 * info); \ } else if (info > _n_) { \ if (_large_n_) { \ error("Fast S large n strategy failed. Use control parameter 'fast.s.large.n = Inf'."); \ } else { \ error("DGEEQU: column %i of the design matrix is exactly zero.", info - _n_); \ } \ } else { \ /* FIXME: replace dgeequ by our own version */ \ /* that does not treat this as error */ \ warning(" Skipping design matrix equilibration (DGEEQU): row %i is exactly zero.", info); \ } \ } else { \ /* scale _X_ */ \ char equed; \ F77_CALL(dlaqge)(&_n_, &_p_, Xe, &_n_, Dr, Dc, &rowcnd, \ &colcnd, &amax, &equed); \ rowequ = equed == 'B' || equed == 'R'; \ colequ = equed == 'B' || equed == 'C'; \ } #define SETUP_SUBSAMPLE(_n_, _p_, _X_, _large_n_) \ /* (Pointers to) Arrays - to be allocated */ \ int *ind_space, *idc, *idr, *pivot; \ double *lu, *v; \ ind_space = (int *) Calloc(_n_, int); \ idc = (int *) Calloc(_n_, int); \ idr = (int *) Calloc(_p_, int); \ pivot = (int *) Calloc(_p_-1, int); \ lu = (double *) Calloc(_p_*_p_, double); \ v = (double *) Calloc(_p_, double); \ SETUP_EQUILIBRATION(_n_, _p_, _X_, _large_n_); #define COPY(from, to, len) Memcpy(to, from, len) /* This assumes that 'p' is correctly defined, and 'j' can be used in caller: */ /* #define COPY(BETA_FROM, BETA_TO, _p_) \ */ /* for(j=0; j < _p_; j++) BETA_TO[j] = BETA_FROM[j]; */ /* In theory BLAS should be fast, but this seems slightly slower, * particularly for non-optimized BLAS :*/ /* static int one = 1; */ /* #define COPY(BETA_FROM, BETA_TO, _p_) \ */ /* F77_CALL(dcopy)(&_p_, BETA_FROM, &one, BETA_TO, &one); */ #define EPS_SCALE 1e-10 #define INFI 1e+20 /* Called from R's lmrob.S() in ../R/lmrob.MM.R, * help() in ../man/lmrob.S.Rd, this function computes an S-regression estimator ~~~~~~~~~~~~~~~~~ */ void R_lmrob_S(double *X, double *y, int *n, int *P, int *nRes, // = nResample ( = 500, by default) double *scale, double *beta_s, double *rrhoc, int *iipsi, double *bb, int *best_r, int *Groups, int *N_group, int *K_s, int *max_k, int *max_it_scale, double *rel_tol, double *inv_tol, double *scale_tol, // <- new, was hardwired to EPS_SCALE := 1e-10 int *converged, int *trace_lev, int *mts, int *ss, int *cutoff) { /* best_r = 't' of Salibian-Barrera_Yohai(2006), * = no. of best candidates to be iterated further ("refined") * = 2, by default */ if (*nRes > 0) { double *res = (double *) R_alloc(*n, sizeof(double)); // residuals if (*n > *cutoff) { if(*trace_lev > 0) Rprintf("lmrob_S(n = %d, nRes = %d): fast_s_large_n():\n", *n, *nRes); fast_s_large_n(X, y, n, P, nRes, max_it_scale, res, Groups, N_group, K_s, max_k, *rel_tol, *inv_tol, *scale_tol, converged, best_r, bb, rrhoc, iipsi, beta_s, scale, *trace_lev, *mts, (Rboolean)*ss); } else { if(*trace_lev > 0) Rprintf("lmrob_S(n = %d, nRes = %d): fast_s() [non-large n]:\n", *n, *nRes); fast_s(X, y, n, P, nRes, max_it_scale, res, K_s, max_k, *rel_tol, *inv_tol, *scale_tol, converged, best_r, bb, rrhoc, iipsi, beta_s, scale, *trace_lev, *mts, *ss); } COPY(res, y, *n); // return the 'residuals' in 'y' } else { // nRes[] <= 0 <==> 'only.scale = TRUE' if(*trace_lev > 0) Rprintf("lmrob_S(nRes = 0, n = %d): --> find_scale(*, scale=%g) only:", *n, *scale); *scale = find_scale(y, *bb, rrhoc, *iipsi, *scale, *n, *P, max_it_scale, *scale_tol, *trace_lev >= 3); if(*trace_lev > 0) Rprintf(" used %d iterations\n", *max_it_scale); } } /* Called from R, this function computes an M-S-regression estimator */ // not only called from ../R/lmrob.M.S.R, but also ../inst/xtraR/m-s_fns.R // ~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~ void R_lmrob_M_S(double *X1, double *X2, double *y, double *res, int *nn, int *pp1, int *pp2, int *nRes, int *max_it_scale, double *scale, double *b1, double *b2, double *rho_c, int *ipsi, double *bb, int *K_m_s, int *max_k, double *rel_tol, double *inv_tol, double *scale_tol, int *converged, int *trace_lev, int *orthogonalize, int *subsample, int *descent, int *mts, int *ss) { /* Initialize (some of the) memory here, * so that we have to do it only once */ int i, n = *nn, p1 = *pp1, p2 = *pp2, one = 1; /* (Pointers to) Arrays - to be allocated */ double *t1, *t2, *y_tilde, *y_work, done = 1., dmone = -1.; double *x1, *x2, *ot1, *oT2, *ptr; if(*trace_lev > 0) Rprintf( "lmrob_M_S(n = %d, nRes = %d, (p1,p2)=(%d,%d), (orth,subs,desc)=(%d,%d,%d))\n", n, *nRes, p1, p2, *orthogonalize, *subsample, *descent); t1 = (double *) R_alloc(n, sizeof(double)); /* size n needed for rllarsbi */ t2 = (double *) R_alloc(p2, sizeof(double)); ot1 = (double *) R_alloc(p1, sizeof(double)); oT2 = (double *) R_alloc(p2*p1, sizeof(double)); y_work = (double *) R_alloc(n, sizeof(double)); COPY(y, y_work, n); y_tilde = (double *) R_alloc(n, sizeof(double)); x1 = (double *) R_alloc(n*p1, sizeof(double)); x2 = (double *) R_alloc(n*p2, sizeof(double)); COPY(X2, x2, n*p2); /* Variables required for rllarsbi * (l1 / least absolut residuals - estimate) */ int NIT=0, K=0, KODE=0; double SIGMA = 0., *SC1 = (double *) R_alloc(n, sizeof(double)), *SC2 = (double *) R_alloc(p1, sizeof(double)), *SC3 = (double *) R_alloc(p1, sizeof(double)), *SC4 = (double *) R_alloc(p1, sizeof(double)); double BET0 = 0.773372647623; /* = pnorm(0.75) */ /* STEP 1: Orthgonalize X2 and y from X1 */ if (*orthogonalize) { COPY(X1, x1, n*p1); F77_CALL(rllarsbi)(x1, y_work, &n, &p1, &n, &n, rel_tol, &NIT, &K, &KODE, &SIGMA, t1, y_tilde, SC1, SC2, SC3, SC4, &BET0); COPY(t1, ot1, p1); for (i=0; i < p2; i++) { COPY(X1, x1, n*p1); ptr = X2+i*n; COPY(ptr, y_work, n); F77_CALL(rllarsbi)(x1, y_work, &n, &p1, &n, &n, rel_tol, &NIT, &K, &KODE, &SIGMA, t1, x2+i*n, SC1, SC2, SC3, SC4, &BET0); ptr = oT2+i*p1; COPY(t1, ptr, p1); } COPY(y_tilde, y_work, n); /* compare with Maronna & Yohai 2000: * y_work and y_tilde now contain \tilde y, ot1 -> t_1, * x2 -> \tilde x2, oT2 -> T_2 */ } /* STEP 2: Subsample */ if (*subsample) { m_s_subsample(X1, y_work, n, p1, p2, *nRes, *max_it_scale, *rel_tol, *inv_tol, *scale_tol, bb, rho_c, *ipsi, scale, *trace_lev, b1, b2, t1, t2, y_tilde, res, x1, x2, &NIT, &K, &KODE, &SIGMA, &BET0, SC1, SC2, SC3, SC4, *mts, *ss); if (*scale < 0) error("m_s_subsample() stopped prematurely (scale < 0)."); } /* STEP 3: Transform back */ if (*orthogonalize) { /* t1 = ot1 + b1 - oT2 %*% b2 */ for(int i=0; i < p1; i++) t1[i] = ot1[i] + b1[i]; F77_CALL(dgemv)("N", &p1, &p2, &dmone, oT2, &p1, b2, &one, &done, t1, &one); COPY(t1, b1, p1); /* restore x2 */ COPY(X2, x2, n*p2); } /* update / calculate residuals */ COPY(y, res, n); F77_CALL(dgemv)("N", &n, &p1, &dmone, X1, &n, b1, &one, &done, res, &one); F77_CALL(dgemv)("N", &n, &p2, &dmone, X2, &n, b2, &one, &done, res, &one); /* STEP 4: Descent procedure */ if (*descent) { *converged = m_s_descent( X1, X2, y, n, p1, p2, *K_m_s, *max_k, *max_it_scale, *rel_tol, *scale_tol, bb, rho_c, *ipsi, scale, *trace_lev, b1, b2, t1, t2, y_tilde, res, y_work, x1, x2, &NIT, &K, &KODE, &SIGMA, &BET0, SC1, SC2, SC3, SC4); } } /* This function performs RWLS iterations starting from * an S-regression estimator (and associated residual scale). * So, in itself, this is ``just'' an M-estimator -- called from R's * lmrob..M..fit() [ ../R/lmrob.MM.R ] * ~~~~~~~~~~~~~~~ * NOTE: rel_tol now controls the *relative* changes in beta, * instead of being hard-wired to EPS = 1e-7 and bounding the * absolute || beta_1 - beta_2 || */ void R_lmrob_MM(double *X, double *y, int *n, int *P, double *beta_initial, double *scale, double *beta_m, double *resid, int *max_it, double *rho_c, int *ipsi, double *loss, double *rel_tol, int *converged, int *trace_lev, int *mts, int *ss) { /* starting from the S-estimate (beta_initial), use * irwls to compute the MM-estimate (beta_m) */ if(*trace_lev > 0) Rprintf("lmrob_MM(): rwls():\n"); *converged = (int)rwls(X,y,*n,*P,beta_m, beta_initial, resid, loss, *scale, *rel_tol, max_it, rho_c, *ipsi, *trace_lev); if (!converged) COPY(beta_initial, beta_m, *P); } /* Call subsample() from R, for testing purposes only */ void R_subsample(const double x[], const double y[], int *n, int *m, double *beta, int *ind_space, int *idc, int *idr, double *lu, double *v, int *p, double *_Dr, double *_Dc, int *_rowequ, int *_colequ, int *status, int *sample, int *mts, int *ss, double *tol_inv, int *solve) { int info; /* set the seed */ GetRNGstate(); SETUP_EQUILIBRATION(*n, *m, x, 0); *status = subsample(Xe, y, *n, *m, beta, ind_space, idc, idr, lu, v, p, Dr, Dc, rowequ, colequ, (Rboolean)*sample, *mts, (Rboolean)*ss, *tol_inv, (Rboolean)*solve); COPY(Dr, _Dr, *n); COPY(Dc, _Dc, *m); *_rowequ = rowequ; *_colequ = colequ; CLEANUP_EQUILIBRATION; PutRNGstate(); } //---- Psi(), Rho(), Functions----------------------------------------------------------- SEXP R_psifun(SEXP x_, SEXP c_, SEXP ipsi_, SEXP deriv_) { /* * Calculate psi for vectorized x, scaled to get psi'(0) = 1 * deriv -1: rho(x) {*not* normalized} * deriv 0: psi(x) = rho'(x) * deriv 1: psi'(x) = rho''(x) {we always have psip(0) == 1} * deriv 2: psi''(x)= rho'''(x) */ int nprot = 1, ipsi = asInteger(ipsi_), deriv = asInteger(deriv_); if (isInteger(x_)) { x_ = PROTECT(coerceVector(x_, REALSXP)); nprot++; } if (!isReal(x_)) error(_("Argument '%s' must be numeric or integer"), "x"); if (!isReal(c_)) error(_("Argument '%s' must be numeric or integer"), "cc"); R_xlen_t i, n = XLENGTH(x_); SEXP res = PROTECT(allocVector(REALSXP, n)); // the result double *x = REAL(x_), *r = REAL(res), *cc = REAL(c_); // put the for() loop *inside* the switch (--> speed for llength >> 1) : #define for_i_n_NA for(i = 0; i < n; i++) r[i] = ISNAN(x[i]) ? x[i] : switch(deriv) { // our rho() is rho~(), i.e., scaled to max = 1 case -1: if(is_redescender(ipsi)) { double rho_Inf = rho_inf(cc, ipsi); for_i_n_NA rho(x[i], cc, ipsi) * rho_Inf; } else { // huber, .. for_i_n_NA rho(x[i], cc, ipsi); } break; case 0: for_i_n_NA psi (x[i], cc, ipsi); break; case 1: for_i_n_NA psip(x[i], cc, ipsi); break; case 2: for_i_n_NA psi2(x[i], cc, ipsi); break; default: error(_("'deriv'=%d is invalid"), deriv); } UNPROTECT(nprot); return res; } SEXP R_chifun(SEXP x_, SEXP c_, SEXP ipsi_, SEXP deriv_) { /* * Calculate chi for vectorized x, i.e. rho~(.) with rho~(inf) = 1: * deriv 0: chi (x) = \rho(x) / \rho(Inf) =: \rho(x) * nc == our rho() C-function * deriv 1: chi'(x) = psi(x) * nc * deriv 2: chi''(x) = psi'(x) * nc */ int nprot = 1, ipsi = asInteger(ipsi_), deriv = asInteger(deriv_); if (isInteger(x_)) { x_ = PROTECT(coerceVector(x_, REALSXP)); nprot++; } if (!isReal(x_)) error(_("Argument '%s' must be numeric or integer"), "x"); if (!isReal(c_)) error(_("Argument '%s' must be numeric or integer"), "cc"); R_xlen_t i, n = XLENGTH(x_); SEXP res = PROTECT(allocVector(REALSXP, n)); // the result double *x = REAL(x_), *r = REAL(res), *cc = REAL(c_); // our rho() is rho~() == chi(), i.e., scaled to max = 1 double rI = (deriv > 0) ? rho_inf(cc, ipsi) : 0./* -Wall */; switch(deriv) { case 0: for_i_n_NA rho(x[i], cc, ipsi); break; case 1: for_i_n_NA psi (x[i], cc, ipsi) / rI; break; case 2: for_i_n_NA psip(x[i], cc, ipsi) / rI; break; case 3: for_i_n_NA psi2(x[i], cc, ipsi) / rI; break; default: error(_("'deriv'=%d is invalid"), deriv); } UNPROTECT(nprot); return res; } SEXP R_wgtfun(SEXP x_, SEXP c_, SEXP ipsi_) { /* * Calculate wgt(x) = psi(x)/x for vectorized x */ int nprot = 1, ipsi = asInteger(ipsi_); if (isInteger(x_)) { x_ = PROTECT(coerceVector(x_, REALSXP)); nprot++; } if (!isReal(x_)) error(_("Argument '%s' must be numeric or integer"), "x"); if (!isReal(c_)) error(_("Argument '%s' must be numeric or integer"), "cc"); R_xlen_t i, n = XLENGTH(x_); SEXP res = PROTECT(allocVector(REALSXP, n)); // the result double *x = REAL(x_), *r = REAL(res), *cc = REAL(c_); for_i_n_NA wgt(x[i], cc, ipsi); UNPROTECT(nprot); return res; } #undef for_i_n_NA SEXP R_rho_inf(SEXP cc, SEXP ipsi) { if (!isReal(cc)) error(_("Argument 'cc' must be numeric")); if (!isInteger(ipsi)) error(_("Argument 'ipsi' must be integer")); return ScalarReal(rho_inf(REAL(cc), INTEGER(ipsi)[0])); } double rho_inf(const double k[], int ipsi) { /* * Compute \rho(\infty) for psi functions * (Note that our C function rho() is "rho~" and has rho(Inf) = 1) */ double c = k[0]; switch(ipsi) { default: error("rho_inf(): ipsi=%d not implemented.", ipsi); case 0: return(R_PosInf); // huber case 1: return(c*c/6.); // biweight case 2: return(c*c); // GaussWeight / "Welsh" case 3: return(3.25*c*c); // Optimal case 4: return(0.5*k[0]*(k[1]+k[2]-k[0])); // Hampel case 5: // GGW (Generalized Gauss Weight) switch((int)c) { default: case 0: return(k[4]); break; // k[4] == cc[5] in R -- must be correct! case 1: return(5.309853); break; case 2: return(2.804693); break; case 3: return(0.3748076); break; case 4: return(4.779906); break; case 5: return(2.446574); break; case 6: return(0.4007054); break; }; case 6: // LQQ aka 'lin psip' return (k[2]*k[1]*(3*k[1]+2*k[0]) + (k[0]+k[1])*(k[0]+k[1])) / (6.*(k[2]-1.)); } } // rho_inf() double normcnst(const double k[], int ipsi) { /* * return normalizing constant for psi functions := 1 / \rho(\infty) */ double c = k[0]; switch(ipsi) { default: error("normcnst(): ipsi=%d not implemented.", ipsi); case 0: return(0.); // huber {normcnst() should never be used for that!} case 1: return(6./(c*c)); // biweight case 2: return(1./(c*c)); // GaussWeight / "Welsh" case 3: return(1./3.25/(c*c)); // Optimal case 4: return(2./(k[0]*(k[1]+k[2]-k[0]))); // Hampel case 5: // GGW switch((int)c) { default: case 0: return(1./ k[4]); break; // k[4] == cc[5] in R -- must be correct! case 1: return(1./5.309853); break; case 2: return(1./2.804693); break; case 3: return(1./0.3748076); break; case 4: return(1./4.779906); break; case 5: return(1./2.446574); break; case 6: return(1./0.4007054); break; }; case 6: // LQQ aka 'lin psip' return((6*(k[2]-1))/(k[2]*k[1]*(3*k[1]+2*k[0])+(k[0]+k[1])*(k[0]+k[1]))); } } // normcnst() double rho(double x, const double c[], int ipsi) { /* * return the correct rho according to ipsi * This rho() is normalized to 1, called rho~() or chi() in other contexts */ switch(ipsi) { default: error("rho(): ipsi=%d not implemented.", ipsi); case 0: return(rho_huber(x, c)); // huber case 1: return(rho_biwgt(x, c)); // biweight case 2: return(rho_gwgt(x, c)); // GaussWeight / "Welsh" case 3: return(rho_opt(x, c)); // Optimal case 4: return(rho_hmpl(x, c)); // Hampel case 5: return(rho_ggw(x, c)); // GGW (Generalized Gauss Weight) case 6: return(rho_lqq(x, c)); // LQQ := Linear-Quadratic-Quadratic // was LGW := "lin psip" := piecewise linear psi'() } } double psi(double x, const double c[], int ipsi) { /* * return the correct psi according to ipsi * this is actually rho' and not psi */ switch(ipsi) { default: error("psi(): ipsi=%d not implemented.", ipsi); case 0: return(psi_huber(x, c)); // huber case 1: return(psi_biwgt(x, c)); // biweight case 2: return(psi_gwgt(x, c)); // GaussWeight / "Welsh" case 3: return(psi_opt(x, c)); // Optimal case 4: return(psi_hmpl(x, c)); // Hampel case 5: return(psi_ggw(x, c)); // GGW case 6: return(psi_lqq(x, c)); // LQQ (piecewise linear psi') } } double psip(double x, const double c[], int ipsi) { /* * return the correct ppsi according to ipsi * this is actually rho'' and not psip */ switch(ipsi) { default: error("psip(): ipsi=%d not implemented.", ipsi); case 0: return(psip_huber(x, c)); // huber case 1: return(psip_biwgt(x, c)); // biweight case 2: return(psip_gwgt(x, c)); // GaussWeight / "Welsh" case 3: return(psip_opt(x, c)); // Optimal case 4: return(psip_hmpl(x, c)); // Hampel case 5: return(psip_ggw(x, c)); // GGW case 6: return(psip_lqq(x, c)); // LQQ (piecewise linear psi') } } double psi2(double x, const double c[], int ipsi) { /* Compute psi''(x) == rho'''(x) */ switch(ipsi) { // default: error("psi2: ipsi=%d not implemented.", ipsi); case 0: return(psi2_huber(x, c)); // huber case 1: return(psi2_biwgt(x, c)); // biweight case 4: return(psi2_hmpl(x, c)); // Hampel case 6: return(psi2_lqq(x, c)); // LQQ (piecewise linear psi') default: error("psi2(): ipsi=%d not implemented.", ipsi); /* case 2: return(psi2_gwgt(x, c)); // GaussWeight / "Welsh" case 3: return(psi2_opt(x, c)); // Optimal case 5: return(psi2_ggw(x, c)); // GGW */ } } double wgt(double x, const double c[], int ipsi) { /* * return the correct wgt according to ipsi * wgt: rho'(x) / x */ switch(ipsi) { default: case 0: return(wgt_huber(x, c)); // huber case 1: return(wgt_biwgt(x, c)); // biweight case 2: return(wgt_gwgt(x, c)); // GaussWeight / "Welsh" case 3: return(wgt_opt(x, c)); // Optimal case 4: return(wgt_hmpl(x, c)); // Hampel case 5: return(wgt_ggw(x, c)); // GGW case 6: return(wgt_lqq(x, c)); // LQQ (piecewise linear psi') } } //--- Huber's rho / psi / ... //--- ------- /* Huber's rho(): contrary to all the redescenders below, this can NOT be scaled to rho(Inf)=1 : */ double rho_huber(double x, const double c[]) { return (fabs(x) <= c[0]) ? x*x*0.5 : c[0]*(fabs(x) - c[0]/2); } double psi_huber(double x, const double c[]) { // Huber's psi = rho'() return (x <= -c[0]) ? -c[0] : ((x < c[0]) ? x : c[0]); } double psip_huber(double x, const double c[]) { // psi' = rho'' : Second derivative of Huber's loss function return (fabs(x) >= c[0]) ? 0. : 1.; } double psi2_huber(double x, const double c[]) { // psi'' = rho''' : Third derivative of Huber's loss function return 0; // FIXME? return NaN when |x| == c ?? -- then also for psi2_hmpl() } double wgt_huber(double x, const double c[]) { /* * Weights for Huber's loss function w(x) = psi(x)/x */ return (fabs(x) >= c[0]) ? c[0]/fabs(x) : 1.; } //--- Biweight = Bisquare = Tukey's Biweight ... //--- -------------------------------------- double rho_biwgt(double x, const double c[]) { /* * Tukey's bisquare loss function == R's tukeyChi() */ if (fabs(x) > (*c)) return(1.); else { double t = x / (*c); t *= t; /* = t^2 */ return( t*(3. + t*(-3. + t)) ); } } double psi_biwgt(double x, const double c[]) { /* * First derivative of Tukey's bisquare loss function */ if (fabs(x) > (*c)) return(0.); else { double a = x / (*c), u = 1. - a*a; return( x * u * u ); } } double psip_biwgt(double x, const double c[]) { /* * Second derivative of Tukey's bisquare loss function */ if (fabs(x) > (*c)) return(0.); else { x /= *c; double x2 = x*x; return( (1. - x2) * (1 - 5 * x2)); } } double psi2_biwgt(double x, const double c[]) { /** 3rd derivative of Tukey's bisquare loss function rho() *= 2nd derivative of psi() : */ if (fabs(x) >= c[0]) // psi''() *is* discontinuous at x = c[0]: use "middle" value there: return (fabs(x) == c[0]) ? 4*x/c[0] : 0.; else { x /= c[0]; double x2 = x*x; return 4*x/c[0] * (5 * x2 - 3.); } } double wgt_biwgt(double x, const double c[]) { /* * Weights for Tukey's bisquare loss function */ if( fabs(x) > *c ) return(0.); else { double a = x / (*c); a = (1. - a)*(1. + a); return( a * a ); } } //---------- gwgt == Gauss Weight Loss function =: "Welsh" -------------------- double rho_gwgt(double x, const double c[]) { /* * Gauss Weight Loss function */ double ac = x / (*c); return(-expm1(-(ac*ac)/2)); } // Largest x such that exp(-x) does not underflow : static double MIN_Exp = -708.4; // ~ = M_LN2 * DBL_MIN_EXP = -log(2) * 1022 = -708.3964 */ // Largest x such that exp(-x^2/2) does not underflow : static double MAX_Ex2 = 37.7; // ~ = sqrt(- 2. * M_LN2 * DBL_MIN_EXP); /* max {x | exp(-x^2/2) < .Machine$double.xmin } = * min {x | x^2 > -2*log(2)* .Machine$double.min.exp } = * = sqrt(-2*log(2)* .Machine$double.min.exp) = {IEEE double} * = sqrt(log(2) * 2044) = 37.64031 */ double psi_gwgt(double x, const double c[]) { /* * Gauss Weight Psi() */ double a = x / (*c); if(fabs(a) > MAX_Ex2) return 0.; else return x*exp(-(a*a)/2); } double psip_gwgt(double x, const double c[]) { /* * Gauss Weight Psi'() */ x /= (*c); if(fabs(x) > MAX_Ex2) return 0.; else { double ac = x*x; return exp(-ac/2) * (1. - ac); } } double wgt_gwgt(double x, const double c[]) { /* * Gauss Weight Loss function */ double a = x / (*c); return(exp(-(a*a)/2)); } double rho_opt(double x, const double c[]) { /* * Optimal psi Function, thank you robust package */ double ac = x / (*c), // AX=S/XK ax = fabs(ac); // AX=ABST/XK if (ax > 3) // IF (AX .GT. 3.D0) THEN return(1); // rlRHOm2=3.25D0*XK*XK else if (ax > 2.) { const double R1 = -1.944/2., R2 = 1.728/4., R3 = -0.312/6., R4 = 0.016/8.; ax *= ax; // = |x/c| ^ 2 return (ax*(R1+ ax*(R2+ ax*(R3+ ax*R4))) +1.792)/3.25; // rlRHOm2=XK*XK*(R1*AX**2+R2*AX**4+R3*AX**6+R4*AX**8+1.792D0) } else return(ac*ac/6.5); // rlRHOm2=S2/2.D0 } double psi_opt(double x, const double c[]) { /* * Optimal psi Function, thank you robust package */ double R1 = -1.944, R2 = 1.728, R3 = -0.312, R4 = 0.016; double ax, ac; ac = x / (*c); // AX=S/XK ax = fabs(ac); // AX=ABST/XK if (ax > 3.) // IF (AX .GT. 3.D0) THEN return(0); // rlPSIm2=0.D0 else if (ax > 2.) { // ELSE IF(AX .GT. 2.D0) THEN double a2 = ac*ac; if (ac > 0.) // IF (AX .GT. 0.D0) THEN return fmax2(0., (*c)*((((R4*a2 +R3)*a2 +R2)*a2 +R1)*ac)); // rlPSIm2=DMAX1(0.D0,XK*(R4*AX**7+R3*AX**5+R2*AX**3+R1*AX)) else return -fabs((*c)*((((R4*a2 +R3)*a2 +R2)*a2 +R1)*ac)); // rlPSIm2=-DABS(XK*(R4*AX**7+R3*AX**5+R2*AX**3+R1*AX)) } else return x; } double psip_opt(double x, const double c[]) { /* * psi'() for Optimal psi Function, thank you robust package */ double ac = x / (*c), ax = fabs(ac); if (ax > 3.) return 0; else if (ax > 2.) { const double R1 = -1.944, R2 = 1.728, R3 = -0.312, R4 = 0.016; ax *= ax; // = |x/c| ^ 2 return R1 + ax*(3*R2 + ax*(5*R3 + ax * 7*R4)); } else return 1; } double wgt_opt(double x, const double c[]) { /* * w(.) for optimal psi Function, thank you robust package */ double ac = x / (*c), ax = fabs(ac); if (ax > 3.) return 0.; else if (ax > 2.) { const double R1 = -1.944, R2 = 1.728, R3 = -0.312, R4 = 0.016; ax *= ax; // = |x/c| ^ 2 return fmax2(0., R1+ ax*(R2 + ax*(R3 + ax*R4))); } else return 1.; } double rho_hmpl(double x, const double k[]) { /* * rho() for Hampel's redescending psi function * constants (a, b, r) == k[0:2] s.t. slope of psi is 1 in the center * * This function is normalized s.t. rho(inf) = 1 */ double u = fabs(x), nc = k[0]*(k[1]+k[2]-k[0])/2; if (u <= k[0]) return( x*x/2 / nc ); else if (u <= k[1]) return( ( u - k[0]/2 ) * k[0] / nc ); else if (u <= k[2]) return( ( k[1] - k[0]/2 + (u - k[1]) * (1 - ( u - k[1] ) / ( k[2] - k[1] ) / 2 )) * k[0] / nc); else return( 1 ); } double psi_hmpl(double x, const double k[]) { /* * psi() for Hampel's redescending psi function * constants (a, b, r) == k[0:2] s.t. slope of psi is 1 in the center */ // double sx = sign(x), u = fabs(x); : double sx, u; if (x < 0) { sx = -1; u = -x; } else { sx = +1; u = x; } if (u <= k[0]) return( x ); else if (u <= k[1]) return sx * k[0]; else if (u <= k[2]) return sx * k[0] * (k[2] - u) / (k[2] - k[1]); else return 0.; } double psip_hmpl(double x, const double k[]) { /* * psi'() for Hampel's redescending psi function * constants (a, b, r) == k[0:2] s.t. slope of psi is 1 in the center */ double u = fabs(x); if (u <= k[0]) return( 1 ); else if (u <= k[1]) return( 0 ); else if (u <= k[2]) return( k[0] / ( k[1] - k[2] ) ); else return( 0 ); } double psi2_hmpl(double x, const double k[]) { /* * psi''() for Hampel's redescending psi function * constants (a, b, r) == k[0:2] s.t. slope of psi is 1 in the center */ return 0.; // even though psi'() is already discontinuous at k[j] } double wgt_hmpl(double x, const double k[]) { /* * w(x) = psi(x)/x for Hampel's redescending psi function * Hampel redescending psi function * constants (a, b, r) == k[0:2] s.t. slope of psi is 1 in the center */ double u = fabs(x); if (u <= k[0]) return( 1 ); else if (u <= k[1]) return( k[0] / u ); else if (u <= k[2]) return( k[0] * ( k[2] - u ) / ( k[2] - k[1] ) / u ); else return( 0 ); } //--- GGW := Generalized Gauss-Weight Koller and Stahel (2011) //--- --- // rho() & chi() need to be calculated by numerical integration -- apart from 6 pre-stored cases double rho_ggw(double x, const double k[]) { /* * Gauss Weight with constant center */ if (k[0] > 0) { // for hard-coded constants --- use a *polynomial* approximation const double C[6][20] = { // 0: b = 1, 95% efficiency {0.094164571656733, -0.168937372816728, 0.00427612218326869, 0.336876420549802, -0.166472338873754, 0.0436904383670537, -0.00732077121233756, 0.000792550423837942, -5.08385693557726e-05, 1.46908724988936e-06, -0.837547853001024, 0.876392734183528, -0.184600387321924, 0.0219985685280105, -0.00156403138825785, 6.16243137719362e-05, -7.478979895101e-07, -3.99563057938975e-08, 1.78125589532002e-09, -2.22317669250326e-11}, // 1: b = 1, 85% efficiency {0.174505224068561, -0.168853188892986, 0.00579250806463694, 0.624193375180937, -0.419882092234336, 0.150011303015251, -0.0342185249354937, 0.00504325944243195, -0.0004404209084091, 1.73268448820236e-05, -0.842160072154898, 1.19912623576069, -0.345595777445623, 0.0566407000764478, -0.00560501531439071, 0.000319084704541442, -7.4279004383686e-06, -2.02063746721802e-07, 1.65716101809839e-08, -2.97536178313245e-10}, // 2: b = 1, bp 0.5 {1.41117142330711, -0.168853741371095, 0.0164713906344165, 5.04767833986545, -9.65574752971554, 9.80999125035463, -6.36344090274658, 2.667031271863, -0.662324374141645, 0.0740982983873332, -0.84794906554363, 3.4315790970352, -2.82958670601597, 1.33442885893807, -0.384812004961396, 0.0661359078129487, -0.00557221619221031, -5.42574872792348e-05, 4.92564168111658e-05, -2.80432020951381e-06}, // 3: b = 1.5, 95% efficiency {0.104604570079252, 0.0626649856211545, -0.220058184826331, 0.403388189975896, -0.213020713708997, 0.102623342948069, -0.0392618698058543, 0.00937878752829234, -0.00122303709506374, 6.70669880352453e-05, 0.632651530179424, -1.14744323908043, 0.981941598165897, -0.341211275272191, 0.0671272892644464, -0.00826237596187364, 0.0006529134641922, -3.23468516804340e-05, 9.17904701930209e-07, -1.14119059405971e-08}, // 4: b = 1.5, 85% efficiency {0.205026436642222, 0.0627464477520301, -0.308483319391091, 0.791480474953874, -0.585521414631968, 0.394979618040607, -0.211512515412973, 0.0707208739858416, -0.0129092527174621, 0.000990938134086886, 0.629919019245325, -1.60049136444912, 1.91903069049618, -0.933285960363159, 0.256861783311473, -0.0442133943831343, 0.00488402902512139, -0.000338084604725483, 1.33974565571893e-05, -2.32450916247553e-07}, // 5: b = 1.5, bp 0.5 {1.35010856132000, 0.0627465630782482, -0.791613168488525, 5.21196700244212, -9.89433796586115, 17.1277266427962, -23.5364159883776, 20.1943966645350, -9.4593988142692, 1.86332355622445, 0.62986381140768, -4.10676399816156, 12.6361433997327, -15.7697199271455, 11.1373468568838, -4.91933095295458, 1.39443093325178, -0.247689078940725, 0.0251861553415515, -0.00112130382664914}}; double end[6] = {18.5527638190955, 13.7587939698492, 4.89447236180905, 11.4974874371859, 8.15075376884422, 3.17587939698492}; int j = ((int)k[0]) - 1; double c; switch(j) { // c : identical numbers to those in SET_ABC_GGW below case 0: c = 1.694; break; case 1: c = 1.2442567; break; case 2: c = 0.4375470; break; case 3: c = 1.063; break; case 4: c = 0.7593544; break; case 5: c = 0.2959132; break; default: error("rho_ggw(): case (%i) not implemented.", j+1); } x = fabs(x); if (x <= c) return(C[j][0]*x*x); else if (x <= 3*c) return(C[j][1] + x*(C[j][2] + x*(C[j][3] + x*(C[j][4] + x*(C[j][5] + x*(C[j][6] + x*(C[j][7] + x*(C[j][8] + x*(C[j][9]))))))))); else if (x <= end[j]) return(C[j][10] + x*(C[j][11] + x*(C[j][12] + x*(C[j][13] + x*(C[j][14] + x*(C[j][15] + x*(C[j][16] + x*(C[j][17] + x*(C[j][18]+ x*(C[j][19])))))))))); else return(1.); } else { // k[0] == 0; k[1:4] = (a, b, c, rho(Inf)) = "general parameters" x = fabs(x); double a = 0., epsabs = R_pow(DOUBLE_EPS, 0.25), result, abserr; int neval, ier, last, limit = 100, lenw = 4 * limit; int *iwork = (int *) R_alloc(limit, sizeof(int)); double *work = (double *) R_alloc(lenw, sizeof(double)); // --> calculate integral of psi(.); Rdqags() is from R's official API ("Writing R Extensions") Rdqags(psi_ggw_vec, (void *)k, &a, &x, &epsabs, &epsabs, &result, &abserr, &neval, &ier, &limit, &lenw, &last, iwork, work); if (ier >= 1) error("Error from Rdqags(psi_ggw*, k, ...): ier = %i", ier); return(result/k[4]); } } void psi_ggw_vec(double *x, int n, void *k) { for (int i = 0; i piecewise constant psi''(): double psi2_lqq (double x, const double k[]) { // double sx = sign(x), ax = fabs(x); : double sx, ax; if (x < 0) { sx = -1; ax = -x; } else { sx = +1; ax = x; } // k[0:2] == (b, c, s) : if (ax <= k[1]) return 0.; else { double k01 = k[0] + k[1]; if (/*k[1] < ax && */ ax <= k01) return sx * (- k[2]/k[0]); else { double s5 = 1. - k[2], // = (1-s) a = (k[0] * k[2] - 2 * k01)/ s5; if (/* k01 < ax && */ ax < k01 + a) return sx * (- s5 / a); else return 0.; } } } double psi_lqq (double x, const double k[]) { double ax = fabs(x); if (ax <= k[1]) return(x); else { // k[0:2] == (b, c, s) : double k01 = k[0] + k[1]; if (ax <= k01) return((double) (x>0 ? 1 : (x<0 ? -1 : 0)) * (ax - k[2] * pow(ax - k[1], 2.) / k[0] / 2.)); else { double s5 = k[2] - 1., // s - 1 s6 = -2 * k01 + k[0] * k[2]; // numerator( -a ) ==> s6/s5 = -a if (/* k01 < ax && */ ax < k01 - s6 / s5) return((double) (x>0 ? 1 : -1) * (-s6/2. - pow(s5, 2.) / s6 * (pow(ax - k01, 2.) / 2. + s6 / s5 * (ax - k01)))); else return 0.; } } } double rho_lqq (double x, const double k[]) { double ax = fabs(x), k01 = k[0] + k[1]; if (ax <= k[1]) return((3. * k[2] - 3.) / (k[2] * k[1] * (3. * k[1] + 2. * k[0]) + pow(k01, 2.)) * x * x); else if (/* k[1] < ax && */ ax <= k01) { double s0 = ax - k[1]; return((6. * k[2] - 6.) / (k[2] * k[1] * (3. * k[1] + 2. * k[0]) + pow(k01, 2.)) * (x * x / 2. - k[2] / k[0] * pow(s0, 3.) / 6.)); } else { double s5 = k[2] - 1., s6 = -2 * k01 + k[0] * k[2]; if (/* k01 < ax && */ ax < k01 - s6 / s5) { double s7 = ax - k01, k01_2 = pow(k01, 2.); return((6. * s5) / (k[2] * k[1] * (3. * k[1] + 2. * k[0]) + k01_2) * (k01_2 / 2. - k[2] * k[0] * k[0] / 6. - s7/2. * (s6 + s7 * (s5 + s7 * s5 * s5 / 3. / s6)))); } else return 1.; } } double wgt_lqq (double x, const double k[]) { double ax = fabs(x); if (ax <= k[1]) return(1.); else { double k01 = k[0] + k[1]; if (ax <= k01) { double s0 = ax - k[1]; return(1. - k[2] * s0 * s0 / (2 * ax * k[0])); } else { double s5 = k[2] - 1., s6 = -2 * k01 + k[0] * k[2]; if (ax < k01 - s6 / s5) { double s7 = ax - k01; return(-(s6/2. + s5 * s5 / s6 * s7 * (s7/2. + s6 / s5)) / ax); } else return(0.); } } } /*============================================================================*/ /* this function finds the k-th place in the * vector a, in the process it permutes the * elements of a */ double kthplace(double *a, int n, int k) { int jnc,j; int l,lr; double ax,w; k--; l=0; lr=n-1; while (l < lr) { ax=a[k]; jnc=l; j=lr; while (jnc <= j) { while (a[jnc] < ax) jnc++; while (a[j] > ax) j--; if (jnc <= j) { w=a[jnc]; a[jnc]=a[j]; a[j]=w; jnc++; j--; } } if (j < k) l=jnc; if (k < jnc) lr=j; } return(a[k]); } /* This is from VR's bundle, MASS package VR/MASS/src/lqs.c : */ /* Sampling k from 0:n-1 without replacement. */ static void sample_noreplace(int *x, int n, int k, int *ind_space) { int i, j, nn=n; #define II ind_space for (i = 0; i < n; i++) II[i] = i; for (i = 0; i < k; i++) { j = nn * unif_rand(); x[i] = II[j]; II[j] = II[--nn]; } #undef II } /* RWLS iterations starting from i_estimate, * ---- the workhorse of the "lmrob_MM" algorithm, called only from R_lmrob_MM(), * which itself is called only from R's lmrob..M..fit(). * In itself, ``just'' an M-estimator : */ Rboolean rwls(const double X[], const double y[], int n, int p, double *estimate, double *i_estimate, double *resid, double* loss, double scale, double epsilon, int *max_it, /* on Input: maximal number of iterations; on Output: number of iterations */ double *rho_c, const int ipsi, int trace_lev) { int lwork = -1, one = 1, info = 1; double work0, *work, wtmp, *weights; double done = 1., dmone = -1., d_beta = 0.; int j, k, iterations = 0; Rboolean converged = FALSE; double *wx = (double *) R_alloc(n*p, sizeof(double)), *wy = (double *) R_alloc(n, sizeof(double)), *beta0 = (double *) R_alloc(p, sizeof(double)); INIT_WLS(wx, wy, n, p); COPY(i_estimate, beta0, p); /* calculate residuals */ COPY(y, resid, n); F77_CALL(dgemv)("N", &n, &p, &dmone, X, &n, beta0, &one, &done, resid, &one); /* main loop */ while(!converged && ++iterations < *max_it) { R_CheckUserInterrupt(); /* compute weights */ get_weights_rhop(resid, scale, n, rho_c, ipsi, weights); /* solve weighted least squares problem */ COPY(y, wy, n); FIT_WLS(X, wx, wy, n, p); COPY(wy, estimate, p); /* calculate residuals */ COPY(y, resid, n); F77_CALL(dgemv)("N", &n, &p, &dmone, X, &n, estimate, &one, &done, resid, &one); d_beta = norm1_diff(beta0,estimate, p); if(trace_lev >= 3) { /* get the loss for the new estimate */ *loss = sum_rho_sc(resid,scale,n,0,rho_c,ipsi); Rprintf(" it %4d: L(b1) = %#.12g ", iterations, *loss); if(trace_lev >= 4) { Rprintf("\n b1 = ("); for(j=0; j < p; j++) Rprintf("%s%.11g", (j > 0)? ", " : "", estimate[j]); Rprintf(");"); } Rprintf(" ||b0 - b1||_1 = %g\n", d_beta); } /* check for convergence */ converged = d_beta <= epsilon * fmax2(epsilon, norm1(estimate, p)); COPY(estimate, beta0, p); } /* end while(!converged & iter <=...) */ if(0 < trace_lev) { if(trace_lev < 3) *loss = sum_rho_sc(resid,scale,n,0,rho_c,ipsi); Rprintf(" rwls() used %2d it.; last ||b0 - b1||_1 = %#g, L(b1) = %.12g; %sconvergence\n", iterations, d_beta, *loss, (converged ? "" : "NON-")); } *max_it = iterations; CLEANUP_WLS; return converged; } /* rwls() */ /* sets the entries of a matrix to zero */ void zero_mat(double **a, int n, int m) { int i,j; for(i=0; i < n; i++) for(j=0; j < m; j++) a[i][j] = 0.; } /* * * 2004 / 5 -- Matias Salibian-Barrera & Victor Yohai * Department of Statistics, University of British Columbia * matias@stat.ubc.ca * Department of Mathematics, University of Buenos Aires * vyohai@uolsinectis.com.ar * * * Reference: A fast algorithm for S-regression estimates, * 2005, Salibian-Barrera and Yohai. */ /* This function implements the "large n" strategy */ void fast_s_large_n(double *X, double *y, int *nn, int *pp, int *nRes, int *max_it_scale, double *res, int *ggroups, int *nn_group, int *K, int *max_k, double rel_tol, double inv_tol, double scale_tol, int *converged, int *best_r, double *bb, double *rrhoc, int *iipsi, double *bbeta, double *sscale, int trace_lev, int mts, Rboolean ss) { /* *X = the n x p design matrix (incl. intercept if appropriate), * in column order as sent by R) * *y = the ( n ) response vector * *nn =: n = the length of y * *pp =: p = the number of columns in X * *nRes = number of re-sampling candidates to be used in each partition * *ggroups = number of groups in which to split the * random subsample * *nn_group = size of each of the (*ggroups) groups * to use in the random subsample * *K = number of refining steps for each candidate (typically 1 or 2) * *max_k = number of refining steps for each candidate (typically 1 or 2) [used to be hard coded to MAX_ITER_REFINE_S = 50 ] * *rel_tol= convergence tolerance for iterative refinement iterations [used to be hard coded to EPS = 1e-7 ] * *converged: will become 0(FALSE) iff at least one of the best_r iterations * did not converge (in max_k steps to rel_tol precision) * *best_r = no. of best candidates to be iterated further ("refined") * *bb = right-hand side of S-equation (typically 1/2) * *rrhoc = tuning constant for loss function * (this should be associated with *bb) * *iipsi = indicator for type of psi function to be used * *bbeta = final estimator * *sscale = associated scale estimator (or -1 when problem) */ int i,j,k, ij, freedsamp = 0, initwls = 0; int n = *nn, p = *pp, kk = *K, ipsi = *iipsi; int groups = *ggroups, n_group = *nn_group, sg = groups * n_group; double b = *bb, sc, best_sc, worst_sc; /* (Pointers to) Arrays - to be allocated */ int *indices, *ind_space; double **best_betas, *best_scales; double *xsamp, *ysamp, *beta_ref; double **final_best_betas, *final_best_scales; #define CALLOC_MAT(_M_, _n_, _d_) \ _M_ = (double **) Calloc(_n_, double *); \ for(int i=0; i < _n_; i++) \ _M_[i] = (double *) Calloc(_d_, double) beta_ref = (double *) Calloc(p, double); CALLOC_MAT(final_best_betas, *best_r, p); final_best_scales = (double *) Calloc(*best_r, double); k = *best_r * groups; best_scales = (double *) Calloc(k, double ); CALLOC_MAT(best_betas, k, p); indices = (int *) Calloc(sg, int); ind_space = (int *) Calloc(n, int); xsamp = (double *) Calloc(n_group*p, double); ysamp = (double *) Calloc(n_group, double); /* assume that n > 2000 */ /* set the seed */ GetRNGstate(); /* get a sample of k indices */ sample_noreplace(indices, n, sg, ind_space); /* FIXME: define groups using nonsingular subsampling? */ /* would also need to allow observations to be part */ /* of multiple groups at the same time */ Free(ind_space); /* FIXME: Also look at lqs_setup(), * ----- and xr[.,.] "fortran-like" matrix can be used from there!*/ /* For each (of 'groups') group : get the *best_r best betas : */ #define X(_k_, _j_) X[_j_*n+_k_] #define xsamp(_k_, _j_) xsamp[_j_*n_group+_k_] for(i=0; i < groups; i++) { /* populate matrix */ for(j = 0; j < n_group; j++) { ij = i*n_group + j; for (k = 0; k < p; k++) xsamp(j, k) = X(indices[ij], k); ysamp[j] = y[indices[ij]]; } if (trace_lev) Rprintf(" Subsampling to find candidate betas in group %d:\n", i); if(fast_s_with_memory(xsamp, ysamp, res, &n_group, pp, nRes, max_it_scale, K, max_k, rel_tol, inv_tol, scale_tol, trace_lev, best_r, bb, rrhoc, iipsi, best_betas + i* *best_r, best_scales+ i* *best_r, mts, ss)) { *sscale = -1.; /* problem */ goto cleanup_and_return; } } Free(xsamp); Free(ysamp); freedsamp = 1; #undef xsamp /* now iterate (refine) these "best_r * groups" * best betas in the (xsamp,ysamp) sample * with kk C-steps and keep only the "best_r" best ones */ /* initialize new work matrices */ double *wx, *wy; wx = (double *) R_alloc(n*p, sizeof(double)); // need only k here, wy = (double *) R_alloc(n, sizeof(double)); // but n in the last step xsamp = (double *) Calloc(sg*p, double); ysamp = (double *) Calloc(sg, double); freedsamp = 0; #define xsamp(_k_,_j_) xsamp[_j_*sg+_k_] for (ij = 0; ij < sg; ij++) { for (k = 0; k < p; k++) xsamp(ij, k) = X(indices[ij],k); ysamp[ij] = y[indices[ij]]; } int lwork = -1, one = 1, info = 1; double work0, *work, *weights; INIT_WLS(wx, wy, n, p); initwls = 1; Rboolean conv = FALSE; int pos_worst_scale = 0; for(i=0; i < *best_r; i++) final_best_scales[i] = INFI; worst_sc = INFI; /* set the matrix to zero */ zero_mat(final_best_betas, *best_r, p); for(i=0; i < (*best_r * groups); i++) { if(trace_lev >= 3) { Rprintf(" Sample[%3d]: before refine_(*, conv=FALSE):\n", i); if(i > 0) { Rprintf(" beta_cand : "); disp_vec(best_betas[i],p); Rprintf(" with scale %.15g\n", best_scales[i]); } } refine_fast_s(xsamp, wx, ysamp, wy, weights, sg, p, res, work, lwork, best_betas[i], kk, &conv/* = FALSE*/, *max_k, rel_tol, trace_lev, b, rrhoc, ipsi, best_scales[i], /* -> */ beta_ref, &sc); if(trace_lev >= 3) { Rprintf(" after refine: beta_ref : "); disp_vec(beta_ref,p); Rprintf(" with scale %.15g\n", sc); } if ( sum_rho_sc(res, worst_sc, sg, p, rrhoc, ipsi) < b ) { int scale_iter = *max_it_scale; /* scale will be better */ sc = find_scale(res, b, rrhoc, ipsi, sc, sg, p, &scale_iter, scale_tol, trace_lev >= 3); int k2 = pos_worst_scale; final_best_scales[ k2 ] = sc; COPY(beta_ref, final_best_betas[k2], p); pos_worst_scale = find_max(final_best_scales, *best_r); worst_sc = final_best_scales[pos_worst_scale]; } } Free(xsamp); Free(ysamp); freedsamp = 1; /* now iterate the best "best_r" * betas in the whole sample until convergence (max_k, rel_tol) */ best_sc = INFI; *converged = 1; k = 0; if(trace_lev) Rprintf(" Now refine() to convergence for %d very best ones:\n", *best_r); for(i=0; i < *best_r; i++) { conv = TRUE; int it_k = refine_fast_s(X, wx, y, wy, weights, n, p, res, work, lwork, final_best_betas[i], kk, &conv/* = TRUE */, *max_k, rel_tol, trace_lev, b, rrhoc, ipsi, final_best_scales[i], /* -> */ beta_ref, &sc); if(trace_lev) Rprintf(" Best[%d]: %sconvergence (%d iter.)", i, conv ? "" : "NON ", it_k); if(best_sc > sc) { if(trace_lev) Rprintf(": -> improved scale to %.15g", sc); best_sc = sc; COPY(beta_ref, bbeta, p); } if (trace_lev) Rprintf("\n"); if (!conv && *converged) *converged = 0; if (k < it_k) k = it_k; } *sscale = best_sc; *max_k = k; /* Done. Now clean-up. */ cleanup_and_return: PutRNGstate(); Free(best_scales); k = *best_r * groups; for(i=0; i < k; i++) Free( best_betas[i] ); Free(best_betas); Free(indices); for(i=0; i < *best_r; i++) Free(final_best_betas[i]); Free(final_best_betas); Free(final_best_scales); Free(beta_ref); if (freedsamp == 0) { Free(xsamp); Free(ysamp); } if (initwls) { CLEANUP_WLS; } #undef X #undef xsamp } /* fast_s_large_n() */ Rboolean fast_s_with_memory(double *X, double *y, double *res, int *nn, int *pp, int *nRes, int *max_it_scale, int *K, int *max_k, double rel_tol, double inv_tol, double scale_tol, int trace_lev, int *best_r, double *bb, double *rrhoc, int *iipsi, double **best_betas, double *best_scales, int mts, Rboolean ss) { /* * Called from fast_s_large_n(), the adjustment for large "n", * same as fast_s, but it returns the best_r best betas, * and their associated scales. * * x : an n x p design matrix (including intercept if appropriate) * y : an n vector * res : an n vector of residuals * *nn = n, *pp = p * *nRes = number of re-sampling candidates to be taken * *K = number of refining steps for each candidate * *best_r = number of (refined) to be retained for full iteration * *bb = right-hand side of the S-equation (typically 1/2) * *rrhoc = tuning constant for loss function * (this should be associated with *bb) * *iipsi = indicator for type of loss function to be used * *best_betas = returning the best ... coefficient vectors * *best_scales = returning their associated residual scales */ int i,j,k; int n = *nn, p = *pp, nResample = *nRes; Rboolean conv = FALSE, sing = FALSE; // sing = TRUE|FALSE the final result int ipsi = *iipsi; double b = *bb, sc, worst_sc = INFI; double work0, *weights, *work; int lwork = -1, one = 1, info = 1; SETUP_SUBSAMPLE(n, p, X, 1); INIT_WLS(X, y, n, p); double *wx = (double *) Calloc(n*p, double), *wy = (double *) Calloc(n, double), *beta_cand = (double *) Calloc(p, double), *beta_ref = (double *) Calloc(p, double); for(i=0; i < *best_r; i++) best_scales[i] = INFI; int pos_worst_scale = 0; /* resampling approximation */ for(i=0; i < nResample; i++) { R_CheckUserInterrupt(); /* find a candidate */ sing = (Rboolean) // 0 |--> FALSE (= success); {1,2} |-> TRUE subsample(Xe, y, n, p, beta_cand, ind_space, idc, idr, lu, v, pivot, Dr, Dc, rowequ, colequ, 1, mts, ss, inv_tol, 1); if (sing) { for (k=0; k< *best_r; k++) best_scales[i] = -1.; goto cleanup_and_return; } /* FIXME: is_ok ?? */ /* improve the re-sampling candidate */ /* conv = FALSE : do *K refining steps */ refine_fast_s(X, wx, y, wy, weights, n, p, res, work, lwork, beta_cand, *K, &conv/* = FALSE*/, *max_k, rel_tol, trace_lev, b, rrhoc, ipsi, -1., /* -> */ beta_ref, &sc); /* FIXME: if sc ~ 0 ---> return beta_cand and be done */ if ( sum_rho_sc(res, worst_sc, n, p, rrhoc, ipsi) < b ) { int scale_iter = *max_it_scale; /* scale will be better */ sc = find_scale(res, b, rrhoc, ipsi, sc, n, p, &scale_iter, scale_tol, trace_lev >= 3); k = pos_worst_scale; best_scales[ k ] = sc; for(j=0; j < p; j++) best_betas[k][j] = beta_ref[j]; pos_worst_scale = find_max(best_scales, *best_r); worst_sc = best_scales[pos_worst_scale]; if (trace_lev >= 2) { Rprintf(" Sample[%3d]: found new candidate with scale %.7g in %d iter.\n", i, sc, scale_iter); Rprintf(" worst scale is now %.7g\n", worst_sc); } } } /* for(i ) */ cleanup_and_return: CLEANUP_SUBSAMPLE; CLEANUP_WLS; Free(wx); Free(wy); Free(beta_cand); Free(beta_ref); return sing; } /* fast_s_with_memory() */ void fast_s(double *X, double *y, int *nn, int *pp, int *nRes, int *max_it_scale, double *res, int *K, int *max_k, double rel_tol, double inv_tol, double scale_tol, int *converged, int *best_r, double *bb, double *rrhoc, int *iipsi, double *bbeta, double *sscale, int trace_lev, int mts, Rboolean ss) { /* *X = the n x p design matrix (incl. intercept if appropriate), * in column order as sent by R) * *y = the ( n ) response vector * *nn =: n = the length of y * *pp =: p = the number of columns in X * *nRes = number of re-sampling candidates to be taken * *K = number of refining steps for each candidate * *best_r = number of (refined) to be retained for full iteration * *converged: will become FALSE iff at least one of the best_r iterations * did not converge (in max_k steps to rel_tol precision) * *bb = right-hand side of the S-equation (typically 1/2) * *rrhoc = tuning constant for loss function * (this should be associated with *bb) * *iipsi = indicator for type of loss function to be used * *bbeta = final estimator * *sscale = associated scale estimator (or -1 when problem) */ int i,k; int n = *nn, p = *pp, nResample = *nRes, ipsi = *iipsi; double b = *bb; double sc, best_sc, aux; int lwork = -1, one = 1, info = 1; double work0, *work, *weights; /* Rprintf("fast_s %d\n", ipsi); */ SETUP_SUBSAMPLE(n, p, X, 0); // More arrays, allocated: double *wx = (double *) R_alloc(n*p, sizeof(double)), *wy = (double *) R_alloc(n, sizeof(double)), *beta_cand = (double *) Calloc(p, double), *beta_ref = (double *) Calloc(p, double), *best_scales = (double *) Calloc(*best_r, double), // matrix: **best_betas = (double **) Calloc(*best_r, double *); for(i=0; i < *best_r; i++) { best_betas[i] = (double*) Calloc(p, double); best_scales[i] = INFI; } INIT_WLS(wx, wy, n, p); /* disp_mat(x, n, p); */ int pos_worst_scale = 0; Rboolean conv = FALSE; double worst_sc = INFI; /* srand((long)*seed_rand); */ GetRNGstate(); /* resampling approximation */ if (trace_lev) Rprintf(" Subsampling to find candidate betas:\n", i); for(i=0; i < nResample; i++) { R_CheckUserInterrupt(); /* find a candidate */ Rboolean sing = (Rboolean) // 0 |--> FALSE (= success); {1,2} |-> TRUE subsample(Xe, y, n, p, beta_cand, ind_space, idc, idr, lu, v, pivot, Dr, Dc, rowequ, colequ, 1, mts, ss, inv_tol, 1); if (sing) { *sscale = -1.; goto cleanup_and_return; } if (trace_lev >= 5) { Rprintf(" Sample[%3d]: idc = ", i); disp_veci(idc, p); } /* disp_vec(beta_cand,p); */ /* improve the re-sampling candidate */ /* conv = FALSE : do *k refining steps */ refine_fast_s(X, wx, y, wy, weights, n, p, res, work, lwork, beta_cand, *K, &conv/* = FALSE*/, *max_k, rel_tol, trace_lev, b, rrhoc, ipsi, -1., /* -> */ beta_ref, &sc); if(trace_lev >= 3) { double del = norm_diff(beta_cand, beta_ref, p); Rprintf(" Sample[%3d]: after refine_(*, conv=FALSE):\n", i); Rprintf(" beta_ref : "); disp_vec(beta_ref,p); Rprintf(" with ||beta_ref - beta_cand|| = %.12g, --> sc = %.15g\n", del, sc); } if(fabs(sc) == 0.) { /* exact zero set by refine_*() */ if(trace_lev >= 1) Rprintf(" Too many exact zeroes -> leaving refinement!\n"); *sscale = sc; COPY(beta_cand, bbeta, p); goto cleanup_and_return; } if ( sum_rho_sc(res, worst_sc, n, p, rrhoc, ipsi) < b ) { int scale_iter = *max_it_scale; /* scale will be better */ sc = find_scale(res, b, rrhoc, ipsi, sc, n, p, &scale_iter, scale_tol, trace_lev >= 3); k = pos_worst_scale; best_scales[ k ] = sc; COPY(beta_ref, best_betas[k], p); pos_worst_scale = find_max(best_scales, *best_r); worst_sc = best_scales[pos_worst_scale]; if (trace_lev >= 2) { Rprintf(" Sample[%3d]: found new candidate with scale %.7g in %d iter.\n", i, sc, scale_iter); Rprintf(" worst scale is now %.7g\n", worst_sc); } } } /* for(i ) */ /* now look for the very best */ if(trace_lev) Rprintf(" Now refine() to convergence for %d very best ones:\n", *best_r); best_sc = INFI; *converged = 1; k = 0; for(i=0; i < *best_r; i++) { conv = TRUE; if(trace_lev >= 4) Rprintf(" i=%d:\n", i); int it_k = refine_fast_s(X, wx, y, wy, weights, n, p, res, work, lwork, best_betas[i], *K, &conv /* = TRUE */, *max_k, rel_tol, trace_lev, b, rrhoc, ipsi, best_scales[i], /* -> */ beta_ref, &aux); if(trace_lev) Rprintf(" Best[%d]: %sconvergence (%d iter.)", i, (conv) ? "" : "NON ", it_k); if(aux < best_sc) { if(trace_lev) Rprintf(": -> improved scale to %.15g", aux); best_sc = aux; COPY(beta_ref, bbeta, p); } if(trace_lev) Rprintf("\n"); if (!conv && *converged) *converged = 0; if (k < it_k) k = it_k; } *sscale = best_sc; *max_k = k; cleanup_and_return: PutRNGstate(); CLEANUP_SUBSAMPLE; CLEANUP_WLS; Free(best_scales); Free(beta_cand); Free(beta_ref); for(i=0; i < *best_r; i++) Free(best_betas[i]); Free(best_betas); return; } /* fast_s() */ int refine_fast_s(const double X[], double *wx, const double y[], double *wy, double *weights, int n, int p, double *res, double *work, int lwork, double *beta_cand, int kk, Rboolean *conv, int max_k, double rel_tol, int trace_lev, double b, double *rrhoc, int ipsi, double initial_scale, double *beta_ref, double *scale) { /* * X = matrix (n x p) of explanatory variables * y = vector ( n ) of responses * weights = robustness weights wt[] * y[] (of length n) * res = residuals y[] - x[,] * beta (of length n) * conv: FALSE means do kk refining steps (and conv stays FALSE) * TRUE means refine until convergence(rel_tol, max_k) * and in this case, 'conv' *returns* TRUE if refinements converged * beta_cand= candidate beta[] (of length p) Input *and* Output * is = initial scale input * beta_ref = resulting beta[] (of length p) Output * scale = final scale Output * for FIT_WLS, DGELS: * wx = matrix (n x p) * wy = vector of length n * work = vector of length lwork * lwork = length of vector work */ int i,j,k, zeroes=0, one = 1, info = 1; Rboolean converged = FALSE;/* Wall */ double s0, done = 1., dmone = -1., wtmp; if (trace_lev >= 4) { Rprintf(" beta_cand before refinement : "); disp_vec(beta_cand,p); } /* calculate residuals */ COPY(y, res, n); F77_CALL(dgemv)("N", &n, &p, &dmone, X, &n, beta_cand, &one, &done, res, &one); for(j=0; j < n; j++) { if( fabs(res[j]) < EPS_SCALE ) zeroes++; } /* if "perfect fit", return it with a 0 assoc. scale */ if( zeroes > (((double)n + (double)p)/2.) ) /* <<- FIXME: depends on 'b' ! */ { COPY(beta_cand, beta_ref, p); *scale = 0.; return 0; } if( initial_scale < 0. ) initial_scale = MAD(res, n, 0., wy, weights);// wy and weights used as work arrays s0 = initial_scale; if(*conv) kk = max_k; for(i=0; i < kk; i++) { /* one step for the scale */ s0 = s0 * sqrt( sum_rho_sc(res, s0, n, p, rrhoc, ipsi) / b ); /* compute weights for IRWLS */ get_weights_rhop(res, s0, n, rrhoc, ipsi, weights); /* solve weighted least squares problem */ COPY(y, wy, n); FIT_WLS(X, wx, wy, n, p); COPY(wy, beta_ref, p); if(*conv) { /* check for convergence */ double del = norm_diff(beta_cand, beta_ref, p); double nrmB= norm(beta_cand, p); if(trace_lev >= 4) Rprintf(" it %4d, ||b[i]||= %#.12g, ||b[i] - b[i-1]|| = %#.15g\n", i, nrmB, del); converged = (del <= rel_tol * fmax2(rel_tol, nrmB)); if(converged) break; } /* calculate residuals */ COPY(y, res, n); F77_CALL(dgemv)("N", &n, &p, &dmone, X, &n, beta_ref, &one, &done, res, &one); COPY(beta_ref, beta_cand, p); } /* for(i = 0; i < kk ) */ if(*conv) { /* was "if(0)", since default lead to 'NOT converged' */ if(!converged) { *conv = FALSE; warning("S refinements did not converge (to refine.tol=%g) in %d (= k.max) steps", rel_tol, i); } } *scale = s0; return i; /* number of refinement steps */ } /* refine_fast_s() */ /* Subsampling part for M-S algorithm */ /* Recreates RLFRSTML function found in src/lmrobml.f */ /* of the robust package */ void m_s_subsample(double *X1, double *y, int n, int p1, int p2, int nResample, int max_it_scale, double rel_tol, double inv_tol, double scale_tol, double *bb, double *rrhoc, int ipsi, double *sscale, int trace_lev, double *b1, double *b2, double *t1, double *t2, double *y_tilde, double *res, double *x1, double *x2, int *NIT, int *K, int *KODE, double *SIGMA, double *BET0, double *SC1, double *SC2, double *SC3, double *SC4, int mts, Rboolean ss) { int i, one = 1, p = p1 + p2, info; double b = *bb, sc = INFI, done = 1., dmone = -1.; *sscale = INFI; if (trace_lev >= 2) Rprintf(" Starting subsampling procedure.. "); SETUP_SUBSAMPLE(n, p2, x2, 0); /* set the seed */ GetRNGstate(); if (trace_lev >= 2) Rprintf(" [setup Ok]\n"); for(i=0; i < nResample; i++) { R_CheckUserInterrupt(); /* STEP 1: Draw a subsample of size p2 from (X2, y) */ Rboolean sing = (Rboolean) // 0 |--> FALSE (= success); {1,2} |-> TRUE subsample(Xe, y, n, p2, t2, ind_space, idc, idr, lu, v, pivot, Dr, Dc, rowequ, colequ, /* sample= */ TRUE, mts, ss, inv_tol, /*solve = */ TRUE); if (sing) { *sscale = -1.; goto cleanup_and_return; } /* calculate partial residuals */ COPY(y, y_tilde, n); F77_CALL(dgemv)("N", &n, &p2, &dmone, x2, &n, t2, &one, &done, y_tilde, &one); /* STEP 3: Obtain L1-estimate of b1 */ COPY(X1, x1, n*p1); F77_CALL(rllarsbi)(x1, y_tilde, &n, &p1, &n, &n, &rel_tol, NIT, K, KODE, SIGMA, t1, res, SC1, SC2, SC3, SC4, BET0); if (*KODE > 1) { REprintf("m_s_subsample(): Problem in RLLARSBI (RILARS). KODE=%d. Exiting.\n", *KODE); *sscale = -1.; goto cleanup_and_return; } /* STEP 4: Check if candidate looks promising */ if (sum_rho_sc(res, *sscale, n, p, rrhoc, ipsi) < b) { int scale_iter = max_it_scale; /* scale will be better */ /* STEP 5: Solve for sc */ sc = find_scale(res, b, rrhoc, ipsi, sc, n, p, &scale_iter, scale_tol, trace_lev >= 4); if(trace_lev >= 2) Rprintf(" Sample[%3d]: new candidate with sc = %#10.5g in %d iter\n", i, sc, scale_iter); /* STEP 6: Update best fit */ *sscale = sc; COPY(t1, b1, p1); COPY(t2, b2, p2); if (sc < EPS_SCALE) { REprintf("\nScale too small\n", "Aborting m_s_subsample()\n\n"); *sscale = -1.; goto cleanup_and_return; } } } /* for(i ) */ /* STEP 7: Clean up and return */ if (trace_lev >= 1) { Rprintf(" Finished M-S subsampling with scale = %.5f\n",*sscale); #define maybe_SHOW_b1_b2 \ if (trace_lev >= 3) { \ Rprintf(" b1: "); disp_vec(b1,p1);\ Rprintf(" b2: "); disp_vec(b2,p2);\ } maybe_SHOW_b1_b2; } cleanup_and_return: CLEANUP_SUBSAMPLE; PutRNGstate(); } /* m_s_subsample() */ /* Descent step for M-S algorithm * Return value: convergence; note that convergence is *not* guaranteed */ Rboolean m_s_descent(double *X1, double *X2, double *y, int n, int p1, int p2, int K_m_s, int max_k, int max_it_scale, double rel_tol, double scale_tol, double *bb, double *rrhoc, int ipsi, double *sscale, int trace_lev, double *b1, double *b2, double *t1, double *t2, double *y_tilde, double *res, double *res2, double *x1, double *x2, int *NIT, int *K, int *KODE, double *SIGMA, double *BET0, double *SC1, double *SC2, double *SC3, double *SC4) { int j, k, nnoimpr = 0, nref = 0; int p = p1 + p2; Rboolean converged = FALSE; double b = *bb; double sc = *sscale, done = 1., dmone = -1.; int lwork = -1, one = 1, info = 1; double work0, *work, wtmp, *weights; COPY(b1, t1, p1); COPY(b2, t2, p2); COPY(res, res2, n); if (trace_lev >= 2) Rprintf(" Starting descent procedure...\n"); INIT_WLS(x2, y, n, p2); if (trace_lev >= 3) { Rprintf(" Scale: %.5f\n", *sscale); if (trace_lev >= 5) { Rprintf(" res2: "); disp_vec(res2,n); } } /* Do descent steps until there is no improvement for */ /* K_m_s steps or we are converged */ /* (convergence is not guaranteed) */ while ( (nref++ < max_k) & (!converged) & (nnoimpr < K_m_s) ) { R_CheckUserInterrupt(); /* STEP 1: update b2 (save it to t2) */ /* y_tilde = y - x1 %*% t1 */ COPY(y, y_tilde, n); COPY(X1, x1, n*p1); F77_CALL(dgemv)("N", &n, &p1, &dmone, x1, &n, t1, &one, &done, y_tilde, &one); /* compute weights */ get_weights_rhop(res2, sc, n, rrhoc, ipsi, weights); /* solve weighted least squares problem */ FIT_WLS(X2, x2, y_tilde, n, p2); COPY(y_tilde, t2, p2); /* get (intermediate) residuals */ COPY(y, res2, n); F77_CALL(dgemv)("N", &n, &p2, &dmone, X2, &n, t2, &one, &done, res2, &one); /* STEP 2: Obtain L1-estimate of b1 */ COPY(res2, y_tilde, n); F77_CALL(rllarsbi)(x1, y_tilde, &n, &p1, &n, &n, &rel_tol, NIT, K, KODE, SIGMA, t1, res2, SC1, SC2, SC3, SC4, BET0); if (*KODE > 1) { CLEANUP_WLS; error("m_s_descent(): Problem in RLLARSBI (RILARS). KODE=%d. Exiting.", *KODE); } /* STEP 3: Compute the scale estimate */ int scale_iter = max_it_scale; sc = find_scale(res2, b, rrhoc, ipsi, sc, n, p, &scale_iter, scale_tol, trace_lev >= 4); // <- here only if higher trace_lev /* STEP 4: Check for convergence */ /* FIXME: check convergence using scale ? */ double del = sqrt(norm_diff2(b1, t1, p1) + norm_diff2(b2, t2, p2)); double nrmB = sqrt(norm2(t1, p1) + norm2(t2, p2)); converged = (del < rel_tol * fmax2(rel_tol, nrmB)); if (trace_lev >= 3) { if(converged) Rprintf(" -->> converged\n"); if (trace_lev >= 4) { Rprintf(" Ref.step %3d: #{no-improvements}=%3d; (del,dB)=(%12.7g,%12.7g)\n", nref, nnoimpr, del, rel_tol * fmax2(rel_tol, nrmB)); if (trace_lev >= 5) { Rprintf(" weights: "); disp_vec(weights,n); Rprintf(" t2: "); disp_vec(t2,p2); Rprintf(" t1: "); disp_vec(t1,p1); Rprintf(" res2: "); disp_vec(res2,n); } } } /* STEP 5: Update best fit */ if (sc < *sscale) { COPY(t1, b1, p1); COPY(t2, b2, p2); COPY(res2, res, n); *sscale = sc; if (trace_lev >= 2) Rprintf(" Refinement step %3d: better fit, scale: %#10.5g\n", nref, sc); nnoimpr = 0; } else { if (trace_lev >= 3) Rprintf(" Refinement step %3d: no improvement, scale: %#10.5g\n", nref, sc); nnoimpr++; } } // while(.) if ( (!converged) & (nref == max_k) ) warning(" M-S estimate: maximum number of refinement steps reached."); if (trace_lev >= 1) { Rprintf(" Descent procedure: %sconverged (best scale: %.5g, last step: %.5g)\n", converged ? "" : "not ", *sscale, sc); if (nnoimpr == K_m_s) Rprintf(" The procedure stopped after %d steps because there was no improvement in the last %d steps.\n To increase this number, use the control parameter 'k.m_s'.\n", nref, nnoimpr); else if (trace_lev >= 2) Rprintf(" No improvements in %d out of %d steps.\n", nnoimpr, nref); maybe_SHOW_b1_b2; } CLEANUP_WLS; return converged; } /* m_s_descent() */ /* draw a subsample of observations and calculate a candidate * * starting value for S estimates * * uses a custom LU decomposition, which acts on the transposed design * * matrix. In case of a singular subsample, the subsample is modified * * until it is non-singular (for ss == TRUE (== 1)). * * * * Parts of the algorithm are based on the Gaxpy version of the LU * * decomposition with partial pivoting by * * Golub G. H., Van Loan C. F. (1996) - MATRIX Computations */ int subsample(const double x[], const double y[], int n, int m, double *beta, int *ind_space, int *idc, int *idr, double *lu, double *v, int *pivot, double *Dr, double *Dc, int rowequ, int colequ, Rboolean sample, int mts, Rboolean ss, double tol_inv, Rboolean solve) { /* x: design matrix (n x m) y: response vector n: length of y, nrow of x m: ncol of x ( == p ) beta: [out] candidate parameters (length m) ind_space: (required in sample_noreplace, length n) holds the index permutation idc: (required in sample_noreplace, !! length n !!) [out] index of observations used in subsample idr: work array of length m lu: [out] LU decomposition of subsample of xt (m x m) Note: U has is not rescaled by 1 / *cf, as it should, this is done R_subsample(). v: work array of length m pivot: [out] pivoting table of LU decomposition (length m-1) Dr: row equilibration (as calculated in SETUP_EQUILIBRATION) Dc: column equilibration rowequ: whether rows were equilibrated coleq: whether cols were equilibrated sample: whether to sample or not mts: the number of singular samples allowed before giving up (Max Try Samples) ss: type of subsampling to be used: 0 (FALSE): simple subsampling 1 (TRUE): nonsingular subsampling tol_inv: tolerance for declaring a matrix singular solve: solve the least squares problem on the subsample? (0: no, 1: yes) return value ('condition'): 0: success 1: singular (matrix xt does not contain a m dim. full rank submatrix) 2: too many singular resamples (simple subsampling case) */ int j, k, l, one = 1, mu = 0, tmpi, i = 0, attempt = 0; double tmpd; Rboolean sing; #define xt(_k_, _j_) x[idr[_k_]*n+idc[_j_]] #define U(_k_, _j_) lu[_j_*m+_k_] #define u(_k_, _j_) lu + (_j_*m+_k_) #define L(_k_, _j_) lu[_j_*m+_k_] #define l(_k_, _j_) lu + (_j_*m+_k_) Start: /* STEP 1: Calculate permutation of 1:n */ if (sample) { sample_noreplace(ind_space, n, n, idc); } else for(k=0;k 51: %x\n", fabs(v[46]) > fabs(v[50])); */ /* Rprintf("47 < 51: %x\n", fabs(v[46]) < fabs(v[50])); */ /* } */ /* continue only if pivot is large enough */ if (tmpd >= tol_inv) { pivot[j] = mu; tmpd = v[j]; v[j] = v[mu]; v[mu] = tmpd; tmpi = idr[j]; idr[j] = idr[mu]; idr[mu] = tmpi; for(k=j+1;k 0) { for(k=0;k= mts) { warning("Too many singular resamples. Aborting subsample().\n See parameter 'subsampling; in help of lmrob.config()."); return(2); } goto Start; } /* drop observation and try next one */ i++; } else { sing = FALSE; U(j, j) = v[j]; } } while(sing); } /* end for loop */ /* Rprintf("lu:"); disp_vec(lu, m*m); */ /* Rprintf("pivot:"); disp_veci(pivot, m-1); */ /* Rprintf("idc:"); disp_veci(idc, m); */ /* STEP 3: Solve for candidate parameters if requested */ if (solve == 0) { for(k=0;k=0;k--) { tmpd = beta[k]; beta[k] = beta[pivot[k]]; beta[pivot[k]] = tmpd; } } return(0); #undef Xt #undef U #undef u #undef L #undef l } void get_weights_rhop(const double r[], double s, int n, const double rrhoc[], int ipsi, double *w) { for(int i=0; i < n; i++) w[i] = wgt(r[i] / s, rrhoc, ipsi); } double find_scale(const double r[], double b, const double rrhoc[], int ipsi, double initial_scale, int n, int p, int* iter, // input: max_iter, output: #{iterations used} double scale_tol, Rboolean trace) { if(initial_scale <= 0.) { warning("find_scale(*, initial_scale = %g) -> final scale = 0", initial_scale); return 0.; } // else double scale = initial_scale; if(trace) Rprintf("find_scale(*, ini.scale =%#15.11g):\nit | new scale\n", scale); for(int it = 0; it < iter[0]; it++) { scale = initial_scale * sqrt( sum_rho_sc(r, initial_scale, n, p, rrhoc, ipsi) / b ) ; if(trace) Rprintf("%2d | %#13.10g\n", it, scale); if(fabs(scale - initial_scale) <= scale_tol*initial_scale) { // converged: *iter = it; return(scale); } initial_scale = scale; } warning("find_scale() did not converge in '%s' (= %d) iterations with tol=%g, last rel.diff=%g", "maxit.scale", /* <- name from lmrob.control() */ *iter, scale_tol, (scale - initial_scale) / initial_scale); return(scale); } // As R's which.max(a), return()ing zero-based k in {0,1,...,n-1} int find_max(double *a, int n) { int k = 0; if(n > 1) { double tt = a[0]; for(int i=1; i < n; i++) if(tt < a[i]) { tt = a[i]; k = i; } } return k; } double sum_rho_sc(const double r[], double scale, int n, int p, const double c[], int ipsi) { double s = 0; for(int i=0; i < n; i++) s += rho(r[i]/scale, c, ipsi); return(s / ((double) n - p)); } /* ||x||_2^2 */ double norm2(double *x, int n) { double s = 0.; int one = 1; s = F77_CALL(dnrm2)(&n, x, &one); return( s*s ); } /* ||x||_2 */ double norm(double *x, int n) { int one = 1; return(F77_CALL(dnrm2)(&n, x, &one)); } double norm1(double *x, int n) { int one = 1; return(F77_CALL(dasum)(&n, x, &one)); } /* ||x-y||_2^2 */ double norm_diff2(double *x, double *y, int n) { int i; double s = 0; for(i=0; i < n; i++) s += (x[i]-y[i])*(x[i]-y[i]); return( s ); } /* ||x-y||_2 */ double norm_diff(double *x, double *y, int n) { int i; double s = 0; for(i=0; i < n; i++) s += (x[i]-y[i])*(x[i]-y[i]); return( sqrt(s) ); } /* ||x-y||_1 */ double norm1_diff(double *x, double *y, int n) { int i; double s = 0; for(i=0; i < n; i++) s += fabs(x[i]-y[i]); return(s); } double MAD(double *a, int n, double center, double *b, double *tmp) { /* if center == 0 then do not center */ int i; /* if( fabs(center) > 0.) { */ for(i=0; i < n; i++) b[i] = a[i] - center; /* } */ return( median_abs(b,n,tmp) * 1.4826 ); } double median(double *x, int n, double *aux) { double t; for(int i=0; i < n; i++) aux[i]=x[i]; if ( (n/2) == (double) n / 2 ) t = ( kthplace(aux,n,n/2) + kthplace(aux,n,n/2+1) ) / 2.0 ; else t = kthplace(aux,n, n/2+1 ) ; return(t); } double median_abs(double *x, int n, double *aux) { double t; for(int i=0; i < n; i++) aux[i]=fabs(x[i]); if ( (n/2) == (double) n / 2 ) t = ( kthplace(aux,n,n/2) + kthplace(aux,n,n/2+1) ) / 2.0 ; else t = kthplace(aux,n, n/2+1 ) ; return(t); } void disp_vec(double *a, int n) { for(int i=0; i < n; i++) Rprintf("%lf ",a[i]); Rprintf("\n"); } void disp_veci(int *a, int n) { for(int i=0; i < n; i++) Rprintf("%d ",a[i]); Rprintf("\n"); } void disp_mat(double **a, int n, int m) { for(int i=0; i < n; i++) { Rprintf("\n"); for(int j=0; j < m; j++) Rprintf("%10.8f ",a[i][j]); } Rprintf("\n"); } void R_find_D_scale(double *rr, double *kkappa, double *ttau, int *llength, double *sscale, double *cc, int *iipsi, int *ttype, double *rel_tol, int *max_k, int *converged) { /* compute D_scale using iterative algorithm type: 1: d1 2: d2 3: dt1 4: dt2 */ *converged = 0; for (int k=0; k < *max_k; k++) { double scale = *sscale, tsum1 = 0, tsum2 = 0; // calculate weights for(int i=0; i < *llength; i++) { double a, w = wgt(rr[i] / ttau[i] / scale, cc, *iipsi); switch(*ttype) { case 1: // d1 a = rr[i]/ttau[i]; tsum1 += a*a*w; tsum2 += w; break; case 2: // d2 a = rr[i]/ttau[i]*w; tsum1 += a*a; tsum2 += w*w; break; default: case 3: // dt1 tsum1 += rr[i]*rr[i]*w; tsum2 += w*ttau[i]*ttau[i]; break; case 4: // dt2 a = rr[i]*w; tsum1 += a*a; a = ttau[i]*w; tsum2 += a*a; break; }; } *sscale = sqrt(tsum1 / tsum2 / *kkappa); // Rprintf("\n type = %d, scale = %10.8f \n", *ttype, *sscale); if (fabs(scale - *sscale) < *rel_tol * fmax2(*rel_tol, scale)) { *converged = 1; break; } } } /* specialized function calc_fitted */ /* calculates fitted values from simulation output array. */ /* this is used to process simulation output in the */ /* lmrob_simulation vignette */ void R_calc_fitted(double *XX, double *bbeta, double *RR, int *nn, int *pp, int *nnrep, int *nnproc, int *nnerr) { unsigned long A, B, C, D, E; A = (unsigned long)*nnerr; B = (unsigned long)*nnproc; C = (unsigned long)*nnrep; D = (unsigned long)*nn; E = (unsigned long)*pp; // calculate fitted values over errstr, procstr and replicates for(unsigned long a = 0; a < A; a++) { // errstr for(unsigned long b = 0; b < B; b++) { // procstr for(unsigned long c = 0; c < C; c++) { // replicates // check for NAs if (!ISNA(bbeta[c + /* 0*C + */ b*C*E + a*B*E*C])) { for(unsigned long d = 0; d < D; d++) { // observations RR[d + c*D + b*C*D + a*B*C*D] = 0; // initialize result for(unsigned long e = 0; e < E; e++) { // predictors RR[d + c*D + b*C*D + a*B*C*D] += bbeta[c + e*C + b*C*E + a*B*E*C] * XX[d + e*D + c*E*D + a*C*E*D]; } } } } } } } robustbase/src/init.c0000644000176200001440000000762613325654361014344 0ustar liggesusers #include #include "robustbase.h" #define CDEF(name) {#name, (DL_FUNC) &name, sizeof(name ## _t)/sizeof(name ## _t[0]), name ##_t} #define CALLDEF(name, n) {#name, (DL_FUNC) &name, n} static R_NativePrimitiveArgType Qn0_t[] = { REALSXP, INTSXP, REALSXP }; static R_NativePrimitiveArgType Sn0_t[] = { REALSXP, INTSXP, INTSXP, REALSXP, REALSXP }; static R_NativePrimitiveArgType mc_C_t[] = { REALSXP, INTSXP, REALSXP, INTSXP, REALSXP, LGLSXP }; static R_NativePrimitiveArgType wgt_himed_i_t[] = { REALSXP, INTSXP, INTSXP, REALSXP }; static R_NativePrimitiveArgType wgt_himed_t[] = { REALSXP, INTSXP, REALSXP, REALSXP }; static R_NativePrimitiveArgType R_lmrob_S_t[] = { REALSXP, REALSXP, INTSXP, INTSXP, INTSXP, REALSXP, REALSXP, /* rrhoc */ REALSXP, INTSXP, REALSXP, /* best_r */ INTSXP, INTSXP, INTSXP, /* K_s */ INTSXP, INTSXP, INTSXP, /* rel_tol*/ REALSXP, REALSXP, REALSXP, /* converged */ LGLSXP, INTSXP, INTSXP, INTSXP, INTSXP }; static R_NativePrimitiveArgType R_lmrob_MM_t[] = { REALSXP, REALSXP, INTSXP, INTSXP, /* beta_initial */ REALSXP, REALSXP, /* beta_m */ REALSXP, REALSXP, /* max_it */ INTSXP, REALSXP, INTSXP, /* loss */ REALSXP, REALSXP, LGLSXP, INTSXP, INTSXP, INTSXP }; static R_NativePrimitiveArgType R_find_D_scale_t[] = { REALSXP, REALSXP, REALSXP, INTSXP, REALSXP, /* c */ REALSXP, INTSXP, INTSXP, REALSXP, /* max_k */ INTSXP, LGLSXP }; static R_NativePrimitiveArgType R_calc_fitted_t[] = { REALSXP, REALSXP, REALSXP, INTSXP, INTSXP, INTSXP, INTSXP, INTSXP }; static R_NativePrimitiveArgType R_lmrob_M_S_t[] = { REALSXP, REALSXP, REALSXP, REALSXP, /* nn */ INTSXP, INTSXP, INTSXP, INTSXP, INTSXP, /* scale */ REALSXP, REALSXP, REALSXP, /* rho_c */ REALSXP, INTSXP, REALSXP, /* K_m_s */ INTSXP, INTSXP, /* rel_tol */ REALSXP, REALSXP, REALSXP, /* converged */ LGLSXP, INTSXP, /* orthogonalize */ LGLSXP, LGLSXP, LGLSXP, INTSXP, INTSXP }; static R_NativePrimitiveArgType R_subsample_t[] = { REALSXP, REALSXP, INTSXP, INTSXP, REALSXP, INTSXP, INTSXP, INTSXP, REALSXP, REALSXP, INTSXP, REALSXP, REALSXP, INTSXP, INTSXP, INTSXP, LGLSXP, INTSXP, INTSXP, REALSXP, LGLSXP }; static const R_CMethodDef CEntries[] = { CDEF(Qn0), CDEF(Sn0), CDEF(mc_C), CDEF(wgt_himed_i), CDEF(wgt_himed), CDEF(R_lmrob_S), CDEF(R_lmrob_MM), CDEF(R_find_D_scale), CDEF(R_calc_fitted), CDEF(R_lmrob_M_S), CDEF(R_subsample), {NULL, NULL, 0} }; static R_CallMethodDef CallEntries[] = { CALLDEF(R_rho_inf, 2), // -> lmrob.c CALLDEF(R_psifun, 4), CALLDEF(R_chifun, 4), CALLDEF(R_wgtfun, 3), CALLDEF(R_wgt_flex, 3), // -> rob-utils.c CALLDEF(R_rowMedians, 5),// -> rowMedians.c [Biobase also has rowQ for quantiles] {NULL, NULL, 0} }; static R_FortranMethodDef FortEntries[] = { {"rffastmcd", (DL_FUNC) &F77_SUB(rffastmcd), 49},/* ./rffastmcd.f */ {"rfltsreg", (DL_FUNC) &F77_SUB(rfltsreg), 41}, /* ./rfltsreg.f */ {"rllarsbi", (DL_FUNC) &F77_SUB(rllarsbi), 18}, /* ./rllarsbi.f */ {NULL, NULL, 0} }; void R_init_robustbase(DllInfo *dll) { R_registerRoutines(dll, CEntries, CallEntries, FortEntries, NULL); R_useDynamicSymbols(dll, FALSE); R_RegisterCCallable("robustbase", "R_psifun", (DL_FUNC) &R_psifun); R_RegisterCCallable("robustbase", "R_chifun", (DL_FUNC) &R_chifun); R_RegisterCCallable("robustbase", "R_wgtfun", (DL_FUNC) &R_wgtfun); R_RegisterCCallable("robustbase", "rho", (DL_FUNC) &rho); R_RegisterCCallable("robustbase", "psi", (DL_FUNC) &psi); R_RegisterCCallable("robustbase", "psip", (DL_FUNC) &psip); R_RegisterCCallable("robustbase", "psi2", (DL_FUNC) &psi2); R_RegisterCCallable("robustbase", "wgt", (DL_FUNC) &wgt); R_RegisterCCallable("robustbase", "rho_inf", (DL_FUNC) &rho_inf); R_RegisterCCallable("robustbase", "normcnst", (DL_FUNC) &normcnst); } robustbase/src/rffastmcd.f0000644000176200001440000017327512440116711015346 0ustar liggesuserscc -*- mode: fortran; kept-new-versions: 25; kept-old-versions: 20 -*- cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc cc rrcov : Scalable Robust Estimators with High Breakdown Point cc cc This program is free software; you can redistribute it and/or modify cc it under the terms of the GNU General Public License as published by cc the Free Software Foundation; either version 2 of the License, or cc (at your option) any later version. cc cc This program is distributed in the hope that it will be useful, cc but WITHOUT ANY WARRANTY; without even the implied warranty of cc MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the cc GNU General Public License for more details. cc cc You should have received a copy of the GNU General Public License cc along with this program; if not, write to the Free Software cc Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA cc cc I would like to thank Peter Rousseeuw and Katrien van Driessen for cc providing the initial code of this function. cc cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc cc cc Computes the MCD estimator of multivariate location and scatter. cc This estimator is given by the subset of h observations for which cc the determinant of their covariance matrix is minimal. The MCD cc location estimate is then the mean of those h points, and the MCD cc scatter estimate is their covariance matrix. This value of h may be cc chosen by the user; its default value is roughly n/2. cc cc The MCD estimator was first introduced in: cc cc Rousseeuw, P.J. (1984), "Least Median of Squares Regression," cc Journal of the American Statistical Association, Vol. 79, cc pp. 871-881. [See page 877.] cc cc The MCD is a robust estimator in the sense that the estimates are cc not unduly influenced by outliers in the data, even if there cc are many outliers. Its robustness was proved in: cc cc Rousseeuw, P.J. (1985), "Multivariate Estimation with High cc Breakdown Point," in Mathematical Statistics and Applications, cc edited by W. Grossmann, G. Pflug, I. Vincze, and W. Wertz. cc Dordrecht: Reidel Publishing Company, pp. 283-297. cc cc Rousseeuw, P.J. and Leroy, A.M. (1987), Robust Regression and cc Outlier Detection, Wiley-Interscience, New York. [Chapter 7] cc cc The program also computes the distance of each observation cc from the center (location) of the data, relative to the shape cc (scatter) of the data: cc cc * Using the classical estimates yields the Mahalanobis distance cc MD(i). Often, outlying points fail to have a large Mahalanobis cc distance because of the masking effect. cc cc * Using the MCD estimates yields a robust distance RD(i). cc These distances allow us to easily identify the outliers. cc cc For applications of robust distances in a regression context see: cc cc Rousseeuw, P.J. and van Zomeren, B.C. (1990), "Unmasking cc Multivariate Outliers and Leverage Points," Journal of the cc American Statistical Association, Vol. 85, 633-639. cc cc There also a diagnostic plot is given to distinguish between cc regular observations, vertical outliers, good leverage points, cc and bad leverage points. cc cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc cc cc The new FAST_MCD algorithm introduced here is due to cc cc Rousseeuw, P.J. and Van Driessen, K. (1997), "A Fast cc Algorithm for the Minimum Covariance Determinant cc Estimator," in preparation. cc cc The algorithm works as follows: cc cc The dataset contains n cases, and nvar variables are used. cc Let n_0 := 2 * nmini (== 600 by default). cc When n < n_0, the algorithm will analyze the dataset as a whole, cc when n >= n_0, the algorithm will use several subdatasets. cc cc 1. n < n_0 : When the dataset is analyzed as a whole, a trial cc subsample of nvar+1 cases is taken, of which the mean and cc covariance matrix is calculated. The h cases with smallest cc relative distances are used to calculate the next mean and cc covariance matrix, and this cycle is repeated k1 times. cc [For small n we can consider all subsets of nvar+1 out of n, else cc the algorithm draws 500 random subsets.] cc Afterwards, the best 10 solutions (covariance matrices and cc corresponding means) are used as starting values for the final cc iterations. These iterations stop when two subsequent determinants cc become equal. (At most k3 iteration steps are taken.) cc The solution with smallest determinant is retained. cc cc 2. n > n_0 --- more than n_0 = 2*nmini cases: The algorithm cc does part of the calculations on (at most) kmini nonoverlapping cc subdatasets, of (roughly) nmini cases. cc cc Stage 1: For each trial subsample in each subdataset, cc k1 iterations are carried out in that subdataset. cc For each subdataset, the 10 best solutions are stored. cc cc Stage 2 considers the union of the subdatasets, called the cc merged set. (If n is large, the merged set is a proper subset of cc the entire dataset.) In this merged set, each of the 'best cc solutions' of stage 1 are used as starting values for k2 cc iterations. Also here, the 10 best solutions are stored. cc cc Stage 3 depends on n, the total number of cases in the cc dataset. If n <= 5000, all 10 preliminary solutions are iterated cc k3 times. If n > 5000, only the best preliminary cc solution is iterated, and the number of iterations decreases to 1 cc according to n*nvar. (If n*nvar <= 100,000 we iterate k3 times, cc whereas for n*nvar > 1,000,000 we take only one iteration step.) cc cc An important advantage of the algorithm FAST_MCD is that it allows cc for exact fit situations, where more than h observations lie on cc a hyperplane. Then the program still yields the MCD location and cc scatter matrix, the latter being singular (as it should be), as cc well as the equation of the hyperplane. cc cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc subroutine rffastmcd(dat, n,nvar, nhalff, krep, nmini,kmini, * initcov, initmean, * inbest, det, weight, fit, coeff, kount, adcov, * temp, index1, index2, indexx, nmahad, ndist, am, am2, slutn, * med, mad, sd, means, bmeans, w, fv1, fv2, * rec, sscp1, cova1, corr1, cinv1, cova2, cinv2, z, * cstock, mstock, c1stock, m1stock, dath, * cutoff, chimed, i_trace) cc VT::10.10.2005 - a DATA operator was used for computing the cc median and the 0.975 quantile of the chisq distribution cc with nvar degrees of freedom. Since now we have no cc restriction on the number of variables, these will be cc passed as parameters - cutoff and chimed implicit none cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c ALGORITHM PARAMETERS: c c The number of iteration steps in stages 1,2 and 3 can be changed c by adapting the parameters k1, k2, and k3. integer k1,k2,k3, int_max parameter (k1=2) parameter (k2=2) parameter (k3=100) c int_max: easily recognized, slightly smaller than 2147483647 = .Machine$integer.max parameter (int_max = 2146666666) c Arguments integer n,nvar ! (n, p) integer nhalff ! == quan := h(alpha) >= n/2 "n half" integer krep ! krep == nsamp c krep := the total number of trial subsamples c to be drawn when n exceeds 2*nmini; c krep = 0 :<==> "exact" <==> all possible subsamples c was hardcoded krep := 500; now an *argument* integer kmini ! the maximal number of subdatasets and integer nmini ! their minimal size double precision dat(n,nvar) double precision initcov(nvar*nvar), initmean(nvar) integer inbest(nhalff) double precision det integer weight(n), fit double precision coeff(kmini,nvar) integer kount double precision adcov(nvar*nvar) integer temp(n) integer index1(n), index2(n), indexx(n) double precision nmahad(n), ndist(n) double precision am(n), am2(n), slutn(n) double precision med(nvar), mad(nvar), sd(nvar), means(nvar), * bmeans(nvar), w(nvar), fv1(nvar), fv2(nvar) double precision rec(nvar+1), * sscp1((nvar+1)*(nvar+1)), corr1(nvar*nvar), * cova1(nvar*nvar), cinv1(nvar*nvar), * cova2(nvar*nvar), cinv2(nvar*nvar), * z(nvar*nvar) double precision cstock(10,nvar*nvar), mstock(10,nvar), * c1stock(10*kmini, nvar*nvar), * m1stock(10*kmini, nvar*nvar), * dath(nmini*kmini, nvar) double precision cutoff, chimed integer i_trace c Functions from ./rf-common.f : integer replow integer rfncomb double precision rffindq c ------------------------------------------------------------------ c Variables integer i,ii,iii, ix, j,jj,jjj, k,kk,kkk,kstep, * l,lll, m,mm,minigr, * nn, ngroup,nhalf,nrep,nsel, nv_2 double precision bstd, deti,detimin1,dist,dist2, eps, * object, qorder, t c km10, nmaxi: now *variable* as nmini integer km10, nmaxi, * ierr,matz,pnsel, tottimes, step, * flag(10*kmini), mini(kmini), * subdat(2, nmini*kmini) double precision mcdndex(10,2,kmini) c subndex: vector of indices; c length(subndex) = maximal value of n_j := mini(j) {j in 1:ngroup} below; n0 := nmini c mini(j) = n1 or n1+1, where n0 <= n1 < n_max := max_j n_j <= n1+1 <= 1+ (3 n0 - 1)/2 = (3 n0 + 1)/2 c ==> see vignette ../vignettes/fastMcd-kmini.Rnw integer subndex((3*nmini + 1)/ 2) double precision med1,med2, percen, pivot,rfmahad,medi2 logical all,part,fine,final,class c -Wall (false alarm): all = .true. part= .false. c Consistency correction now happens in R if(i_trace .ge. 2) then call pr1mcd(i_trace, n, nvar, nhalff, krep, nmini, kmini) endif call rndstart C -------- == GetRNGstate() in C nrep = krep kstep = k1 medi2 = 0 cc From here on, the sample size n is known. cc Some initializations can be made. First of all, h (= the number of cc observations on which the MCD is based) is given by the integer variable cc nhalff. cc If nhalff equals n, the MCD is the classical covariance matrix. cc The logical value class indicates this situation. cc The variable jbreak is the breakdown point of the MCD estimator cc based on nhalff observations, whereas jdefaul = (n+nvar+1)/2 cc would be the optimal value of nhalff, with maximal breakdown point. cc The variable percen is the corresponding percentage (MM: rather "fraction"). cc c unused jbreak=rfnbreak(nhalff,n,nvar) percen = dble(nhalff) / n ! the fraction, also called 'alpha' if(nvar.lt.5) then eps=1.0D-12 else if(nvar.ge.5.and.nvar.le.8) then eps=1.0D-14 else eps=1.0D-16 endif endif class = (nhalff .ge. n) if(class) goto 9500 ! compute *only* the classical estimate if(nvar.eq.1) then do jj=1,n ndist(jj)=dat(jj,1) end do call rfshsort(ndist,n) cc. consistency correction now happens in R code cc. nquant=min(int(real(((nhalff*1.D0/n)-0.5D0)*40))+1,11) cc. factor=faclts(nquant) cc. call rfmcduni(ndist,n,nhalff,slutn,bstd,am,am2, factor, call rfmcduni(ndist,n,nhalff,slutn,bstd,am,am2, 1.d0, * n-nhalff+1) initmean(1)=slutn(1) adcov(1)=bstd initcov(1)=bstd goto 9999 endif cc p >= 2 in the following cc ------ c These are "constants" given the arguments: nmaxi = nmini*kmini km10 = 10*kmini nv_2 = nvar*nvar cc Some initializations: cc matz = auxiliary variable for the subroutine rs, indicating whether cc or not eigenvectors are calculated cc nsel = number of variables + 1 cc ngroup = number of subdatasets, is in {1,2,.., kmini} cc part = logical value, true if the dataset is split up cc fine = logical value, becomes true when the subsets are merged cc final = logical value, to indicate the final stage of the algorithm cc all = logical value, true if all (p+1)-subsets out n of should be drawn; cc always true for (very) small n, but also when krep=0 (special value) cc subdat = matrix with a first row containing indices of observations cc and a second row indicating the corresponding subdataset cc matz=1 nsel=nvar+1 ngroup=1 fine=.false. final=.false. do i=1,nmaxi subdat(1,i)=int_max subdat(2,i)=int_max end do cc Determine whether the dataset needs to be divided into subdatasets cc or can be treated as a whole. The subroutine rfrdraw constructs cc nonoverlapping subdatasets, with uniform distribution of the case numbers. cc For small n, the number of trial subsamples is determined. c part := Shall we partition the data into sub-datasets / "groups"? part = (krep.gt.0 .and. n .ge. (2*nmini)) all = .not. part if(part) then do i=1,kmini mini(i)=0 end do kstep=k1 ngroup = n / nmini ! =: k = n % nmini (integer division) if(ngroup .lt. kmini) then c we distribute n evenly into ngroup subdatasets, of size mm = n / ngroup ! =: n_0 = n % k ==> rest r = n - k*N = n-k*n_0 c The rest r in {0,..,k-1} gives one extra obs. in the last r groups, i.e., c group numbers j > jj := k - r : ii = n - ngroup*mm ! =: r jj = ngroup - ii ! = k - r do j = 1,jj mini(j) = mm end do do j = jj+1,ngroup mini(j) = mm +1 end do minigr = ngroup*mm + ii else ! ngroup = k := floor(n/nmini) >= kmini =: k_0 : ngroup = kmini do j=1,kmini mini(j)=nmini end do minigr = kmini*nmini end if nhalf = int(mini(1)*percen) nrep = krep / ngroup ! integer division if(i_trace .ge. 2) + call prp1mcd (n,ngroup,minigr,nhalf,nrep, mini) call rfrdraw(subdat,n,minigr,mini,ngroup,kmini) else c "not part" : not partitioning; either krep == 0 or n <= 2*nmini-1 ( = 599 by default) minigr=n nhalf=nhalff kstep=k1 if(krep.eq.0 .or. n.le.replow(nsel)) then c use all combinations; happens iff nsel = nvar+1 = p+1 <= 6 nrep = rfncomb(nsel,n) if(i_trace .ge. 2) call intpr('*all* combinations ',-1,0,0) else nrep=krep all = .false. endif endif c seed=iseed c above: pr1mcd(i_trace, n, nvar, nhalff, krep, nmini, kmini) if(i_trace .ge. 2) then call pr2mcd(part, all, kstep, ngroup, minigr, nhalf, nrep) endif cc cc Some more initializations: cc m1stock = matrix containing the means of the ngroup*10 best estimates cc obtained in the subdatasets. cc c1stock = matrix containing the covariance matrices of the ngroup*10 cc best estimates obtained in the subdatasets. cc mstock = matrix containing the means of the ten best estimates cc obtained after merging the subdatasets and iterating from cc their best estimates. cc cstock = matrix containing the covariance matrices of the ten best cc estimates obtained after merging the subdatasets cc and iterating from their best estimates. cc means = mean vector cc bmeans = initial MCD location estimate cc sd = standard deviation vector cc nmahad = vector of mahalanobis distances cc ndist = vector of general (possibly robust) distances cc inbest = best solution vector cc index1 = index vector of subsample observations cc index2 = index vector of ordered mahalanobis distances cc indexx = temporary index vector, parallel to index1, used when cc generating all possible subsamples cc temp = auxiliary vector cc flag = vector with components indicating the occurrence of a cc singular intermediate MCD estimate. cc do j=1,nvar do k=1,10 mstock(k,j)=1234567.D0 do kk=1,kmini m1stock((kk-1)*10+k,j)=1234567.D0 end do do i=1,nvar do kk=1,kmini c1stock((kk-1)*10+k,(j-1)*nvar+i)=1234567.D0 end do cstock(k,(j-1)*nvar+i)=1234567.D0 end do end do means(j)=0.D0 bmeans(j)=0.D0 sd(j)=0.D0 end do do j=1,n nmahad(j)=0.D0 ndist(j)=0.D0 index1(j)=int_max index2(j)=int_max indexx(j)=int_max temp(j)=int_max end do do j=1,km10 flag(j)=1 end do 9500 continue c==== ********* Compute the classical estimates ************** c call rfcovinit(sscp1,nvar+1,nvar+1) do i=1,n do j=1,nvar rec(j)=dat(i,j) end do call rfadmit(rec,nvar,sscp1) end do call rfcovar(n,nvar,sscp1,cova1,means,sd) do j=1,nvar if(sd(j).eq.0.D0) goto 5001 end do call rfcovcopy(cova1,cinv1,nvar,nvar) det= 0. do j=1,nvar pivot=cinv1((j-1)*nvar+j) det=det + log(pivot) if(pivot.lt.eps) goto 5001 call rfcovsweep(cinv1,nvar,j) end do call rfcorrel(nvar,cova1,corr1,sd) c if just classical estimate, we are done if(class) goto 9999 goto 5002 c singularity '1' (exact fit := 1) : 5001 continue call rs(nvar,nvar,cova1,w,matz,z,fv1,fv2,ierr) call rfdis(dat,z,ndist,n,nvar,n,nvar,means) call rfexact(kount,n,ndist, nvar, * sscp1,rec,dat, cova1,means,sd,weight) call rfcovcopy(cova1,initcov,nvar,nvar) call rfcovcopy(means,initmean,nvar,1) do j=1,nvar coeff(1,j)=z(j) end do fit=1 goto 9999 5002 continue cc cc Compute and store classical Mahalanobis distances. cc do j=1,n do i=1,nvar rec(i)=dat(j,i) end do nmahad(j)=rfmahad(rec,nvar,means,cinv1) end do cc ******* Compute the MCD estimates ************** ---------------------------- cc Main loop: inspects the subsamples. cc Every time the sscp of the subsample is placed in sscp1, cc its covariance matrix in cova1, and its inverse in cinv1 . cc The minimum covariance determinant matrix is placed in cova2, cc and its inverse in cinv2. cc The robust distances are placed in ndist. cc c tottimes := counting the total number of iteration steps in the main loop cc cc The algorithm returns here twice when the dataset is divided cc at the beginning of the program. According to the situation, cc new initializations are made. c fine == TRUE : <==> We are in the second stage, where the subdatasets are merged, c final == TRUE : <==> We are in the last stage, when the whole dataset is considered c In the last stage, the number of iterations 'nrep' c is determined according to the total number of observations and the dimension. tottimes=0 5555 object=10.D25 if(.not. part .or. final) then nn=n else if (fine) then !-> part & fine & .not. final nn=minigr else !-> part - "phase 1" (.not. fine & .not. final) nn=-1 endif if(i_trace .ge. 2) ! " Main loop, phase[%s]: ... " 1 call pr3mcd(part, fine, final, nrep, nn, 2 nsel, nhalf, kstep, nmini, kmini) if(fine .or.(.not.part.and.final)) then nrep = 10 c ---- == hardcoded nsel = nhalf kstep = k2 if (final) then ! "final": stage 3 -- nhalf=nhalff ngroup=1 c ksteps := k3 (= 100) unless n*p is "large" where c ksteps jumps down to at most 10 <<- "discontinuous!" FIXME if (n*nvar .le.100000) then kstep=k3 ! = 100 ("hardcoded default") else if (n*nvar .gt.100000 .and. n*nvar .le.200000) then kstep=10 else if (n*nvar .gt.200000 .and. n*nvar .le.300000) then kstep=9 else if (n*nvar .gt.300000 .and. n*nvar .le.400000) then kstep=8 else if (n*nvar .gt.400000 .and. n*nvar .le.500000) then kstep=7 else if (n*nvar .gt.500000 .and. n*nvar .le.600000) then kstep=6 else if (n*nvar .gt.600000 .and. n*nvar .le.700000) then kstep=5 else if (n*nvar .gt.700000 .and. n*nvar .le.800000) then kstep=4 else if (n*nvar .gt.800000 .and. n*nvar .le.900000) then kstep=3 else if (n*nvar .gt.900000 .and. n*nvar .le.1000000) then kstep=2 else ! n*p > 1e6 kstep=1 endif if (n.gt.5000) then nrep=1 endif else nhalf=int(minigr*percen) endif endif do i=1,nsel-1 index1(i)=i indexx(i)=i end do index1(nsel)=nsel-1 indexx(nsel)=nsel-1 cc cc Initialization of the matrices to store partial results. For the cc first stage of the algorithm, the currently best covariance matrices and cc means are stored in the matrices c1stock and m1stock initialized earlier. cc The corresponding objective values and the number of the trial subset cc are stored in the matrix mcdndex. cc For the second stage of the algorithm or for small datasets, only the cc currently best objective values are stored in the same matrix mcdndex cc and the corresponding covariance matrices and mean vectors are stored in cc the matrices cstock and mstock initialized earlier. cc if(.not. final) then do i=1,10 do j=1,ngroup mcdndex(i,1,j)=10.D25 mcdndex(i,2,j)=10.D25 end do end do endif if(.not.fine .and. .not.final) then !-- first phase do j=1,nvar do i=1,n am (i)=dat(i,j) am2(i)=dat(i,j) end do if(2*n/2 .eq. n) then med1=rffindq(am, n, n/2, index2) med2=rffindq(am2,n,(n+2)/2,index2) med(j)=(med1+med2)/2 else med(j)=rffindq(am,n,(n+1)/2,index2) endif do i=1,n ndist(i)=dabs(dat(i,j)-med(j)) end do mad(j)=rffindq(ndist,n,nhalff,index2) if(mad(j)-0.D0 .lt. eps) then do k=1,j-1 do i=1,n dat(i,k)=dat(i,k)*mad(k)+med(k) end do end do call rfcovinit(sscp1,nvar+1,nvar+1) do k=1,nsel do m=1,nvar rec(m)=dat(index2(k),m) end do call rfadmit(rec,nvar,sscp1) end do call rfcovar(nsel,nvar,sscp1,cova1,means,sd) call rs(nvar,nvar,cova1,w,matz,z,fv1,fv2,ierr) C VT::15.11.2014, fixing array overrun, found by MM C The following code expects that z (the plane coefficients) C are all zeros with 1 in the position of the variable with MAD=0 C If not, tries to find it. C if(.FALSE.) then if(z(j).ne.1) then do kk=1,nvar if(z(kk*nvar+j).eq.1) then do l=1,nvar z(l)=z(kk*nvar+l) end do goto 76 ! break endif end do endif 76 continue else C Instead of this, we set all coefficients to 0 and the one of C variable j to 1. The exactfit code will be set 3 and will be C handled respectively by the R code. do kk=1,nvar z(kk) = 0 end do z(j) = 1 end if call rfdis(dat,z,ndist,n,nvar,n,nvar,means) call rfexact(kount,n,ndist, nvar, * sscp1,rec,dat, cova1,means,sd,weight) call rfcovcopy(cova1,initcov,nvar,nvar) call rfcovcopy(means,initmean,nvar,1) do jjj=1,nvar coeff(1,jjj)=z(jjj) end do fit=3 goto 9999 endif do i=1,n dat(i,j)=(dat(i,j)-med(j))/mad(j) end do end do endif cc cc The matrix dath contains the observations to be used in the cc algorithm. In the first stage of the split-up procedure dath contains cc nmini objects, corresponding to the original observations, with the index cc of the processed group in the array subdat. For the second stage, the cc data points of all the subdatasets are merged in dath. cc The variable kount indicates the occurrence of a singular subsample leading cc to the corresponding plane. In some situations the variable kount counts cc the number of observations on that plane. cc if (fine .and. .not. final) then do j=1,minigr do k=1,nvar dath(j,k)=dat(subdat(1,j),k) end do end do endif kount=0 c---- For-Loop over groups - - - - - - - - - - - - - - - - - - - - - do 1111 ii= 1,ngroup if(.not.fine) kount=0 if(part .and. .not. fine) then nn=mini(ii) kk=0 do j=1,minigr if(subdat(2,j).eq.ii) then kk=kk+1 subndex(kk)=subdat(1,j) endif end do do j=1,mini(ii) do k=1,nvar dath(j,k)=dat(subndex(j),k) end do end do endif if(i_trace .ge. 3) call prgrmcd(ii, nn, i_trace) do i=1,nn index2(i)=i end do cc The number of trial subsamples is represented by nrep, which depends cc on the data situation. cc When all (p+1)-subsets out of n can be drawn, the subroutine rfgenpn cc is used. Otherwise, random subsamples are drawn by the routine cc rfrangen. The trial subsamples are put in the array index1. The cc same thing happens for large datasets, except that the number of cc observations is nmini instead of n. cc cc When a trial subsample is singular, the algorithm counts the number of cc observations that lie on the hyperplane corresponding to this sample. cc If, for small datasets, this number is larger than nhalff, the program cc stops (exact fit) and gives the mean and the covariance matrix cc of the observations on the hyperplane, together with the equation cc of the hyperplane. cc For large datasets, the algorithm first checks whether there are more cc than nhalff observations on the hyperplane. If this is the case, the cc program stops for the same reason of exact fit and gives the covariance cc matrix and mean of the observations on the hyperplane. If not, the cc algorithm counts the number of observations that lie on the hyperplane. cc When this number is smaller than the current nhalf in the subdataset, these cc observations are extended to nhalf observations by adding those cc observations that have smallest orthogonal distances to the hyperplane cc and the algorithm continues. cc When larger, the coefficients of the hyperplane are stored in the matrix cc m1stock for use as starting value in the next stage, and the flag of this cc estimate gets the value zero. cc cc In the second stage of the algorithm, when the subdatasets are merged, cc the array index2 contains the indices of the observations cc corresponding to the nhalf observations with minimal relative distances cc with respect to the best estimates of the first stage. cc When the estimate of the first stage is a hyperplane, the algorithm cc investigates whether there are more than the current nhalf observations of cc the merged subdataset on that hyperplane. If so, the coefficients of the cc hyperplane are again stored, now in the matrix mstock, for the final cc stage of the algorithm. cc If not, the observations on the hyperplane are extended to nhalf cc observations by adding the observations in the merged dataset with cc smallest orthogonal distances to that hyperplane. cc For small datasets or for larger datasets with n <= nmaxi := nmini*kmini, cc the algorithm already stops when one solution becomes singular, cc since we then have an exact fit. cc cc In the third stage, the covariance matrices and means of the best cc solutions of the second stage are used as starting values. cc Again, when a solution becomes singular, the subroutine 'exact' cc determines the hyperplane through at least nhalff observations and stops cc because of the exact fit. cc cc When the program stops because of an exact fit, the covariance matrix and cc mean of the observations on the hyperplane will always be given. cc C VT::27.10.2014 - an issue with nsamp="exact" fixed: do ix=1,n indexx(ix)=index1(ix) end do do 1000 i=1,nrep pnsel=nsel tottimes=tottimes+1 if(i_trace .ge. 4) call pr4mcd(i) call rchkusr() ! <- allow user interrupt deti= -1.d300 detimin1=deti step=0 call rfcovinit(sscp1,nvar+1,nvar+1) if((part.and..not.fine).or.(.not.part.and..not.final)) then if(part) then call rfrangen(mini(ii),nsel,index1) else if(all) then call rfgenpn(n,nsel,indexx) do ix=1,n index1(ix)=indexx(ix) end do else call rfrangen(n,nsel,index1) endif endif cc cc The covariance matrix and mean of the initial subsamples are cc calculated with the subroutine covar and represented by cc the variables cova1 and means. cc cc In the following stages of the algorithm, the covariance matrices and means cc used as starting values are already stored in the matrices c1stock cc and m1stock (for the second stage), and in the matrices cstock and mstock cc (for the third stage). cc cc The inverse cinv1 of the covariance matrix is calculated by the cc subroutine rfcovsweep, together with its determinant det. c c Repeat 9550 call rfcovinit(sscp1,nvar+1,nvar+1) if(.not.fine.and.part) then do j=1,pnsel do m=1,nvar rec(m)=dath(index1(j),m) end do call rfadmit(rec,nvar,sscp1) end do call rfcovar(pnsel,nvar,sscp1,cova1,means,sd) endif if(.not.part.and..not.final) then do j=1,pnsel do m=1,nvar rec(m)=dat(index1(j),m) end do call rfadmit(rec,nvar,sscp1) end do call rfcovar(pnsel,nvar,sscp1,cova1,means,sd) endif if (final) then if(mstock(i,1) .ne. 1234567.D0) then do jj=1,nvar means(jj)=mstock(i,jj) do kk=1,nvar cova1((jj-1)*nvar+kk)=cstock(i,(jj-1)*nvar+kk) end do end do else goto 1111 endif if(flag(i).eq.0) then qorder=1.D0 do jjj=1,nvar z(jjj)=coeff(1,jjj) end do call rfdis(dat,z,ndist,n,nvar,nn,nvar, means) dist2=rffindq(ndist,nn,nhalf,index2) goto 9555 endif endif if (fine .and. .not.final) then if(m1stock((ii-1)*10+i,1) .ne. 1234567.D0) then do jj=1,nvar means(jj)=m1stock((ii-1)*10+i,jj) do kk=1,nvar cova1((jj-1)*nvar+kk)=c1stock((ii-1)*10+i, * (jj-1)*nvar+kk) end do end do else goto 1111 endif if(flag((ii-1)*10+i).eq.0) then qorder=1.D0 do jjj=1,nvar z(jjj)=coeff(ii,jjj) end do call rfdis(dath,z,ndist,nmaxi,nvar,nn,nvar, means) call rfshsort(ndist,nn) qorder=ndist(nhalf) if(dabs(qorder-0.D0).lt.10.D-8 .and. kount.eq.0 * .and. n.gt.nmaxi) then kount=nhalf do kkk=nhalf+1,nn if(dabs(ndist(kkk)-0.D0).lt.10.D-8) then kount=kount+1 endif end do flag(1)=0 do kkk=1,nvar coeff(1,kkk)=z(kkk) end do call rfstore2(nvar,cstock,mstock,nv_2, * kmini,cova1,means,i,mcdndex,kount) kount=1 goto 1000 else if(dabs(qorder-0.D0).lt.10.D-8 .and. * kount.ne.0 .and. n.gt.nmaxi) then goto 1000 else flag(1)=1 dist2=rffindq(ndist,nn,nhalf,index2) goto 9555 endif endif endif call rfcovcopy(cova1,cinv1,nvar,nvar) det=0. do 200 j=1,nvar pivot=cinv1((j-1)*nvar+j) det=det + log(pivot) if(pivot.lt.eps) then call rs(nvar,nvar,cova1,w,matz,z,fv1,fv2,ierr) qorder=1.D0 if(.not.part.or.final) then call rfdis(dat,z,ndist,n,nvar,nn,nvar,means) else call rfdis(dath,z,ndist,nmaxi,nvar,nn,nvar,means) endif call rfshsort(ndist,nn) qorder=ndist(nhalf) if(dabs(qorder-0.D0).lt. 10.D-8 .and. .not.part) then call transfo(cova1,means,dat,med,mad,nvar,n) call rs(nvar,nvar,cova1,w,matz,z,fv1,fv2,ierr) call rfdis(dat,z,ndist,n,nvar,nn,nvar,means) call rfexact(kount,n,ndist, nvar, * sscp1,rec,dat, cova1,means,sd,weight) call rfcovcopy(cova1,initcov,nvar,nvar) call rfcovcopy(means,initmean,nvar,1) do jjj=1,nvar coeff(1,jjj)=z(jjj) end do fit=2 goto 9999 else if(dabs(qorder-0.D0).lt. 10.D-8 .and. part .and. * kount.eq.0) then call rfdis(dat,z,ndist,n,nvar,n,nvar, means) call rfshsort(ndist,n) if(dabs(ndist(nhalff)-0.D0).lt.10.D-8) then call transfo(cova1,means,dat,med,mad,nvar,n) call rs(nvar,nvar,cova1,w,matz,z,fv1,fv2,ierr) call rfdis(dat,z,ndist,n,nvar,nn,nvar,means) call rfexact(kount,n,ndist, nvar,sscp1, * rec,dat, cova1,means,sd,weight) call rfcovcopy(cova1,initcov,nvar,nvar) call rfcovcopy(means,initmean,nvar,1) do jjj=1,nvar coeff(1,jjj)=z(jjj) end do fit=2 goto 9999 endif call rfdis(dath,z,ndist,nmaxi,nvar,nn,nvar, means) call rfshsort(ndist,nn) kount=nhalf do kkk=nhalf+1,nn if(dabs(ndist(kkk)-0.D0) .lt. 10.D-8) then kount=kount+1 endif end do flag((ii-1)*10+1)=0 do kkk=1,nvar coeff(ii,kkk)=z(kkk) end do call rfstore1(nvar,c1stock,m1stock,nv_2, * kmini,cova1,means,i,km10,ii,mcdndex, kount) kount=1 goto 1000 else if(dabs(qorder-0.D0).lt. 10.D-8 .and. part .and. * kount.ne.0) then goto 1000 else C C VT::27.10.2014 - an issue with nsamp="exact" fixed: C C Add one more observation and return to recompute the C covariance. In case of complete enumeration, when all C p+1 subsamples are generated, the array 'index1' must C be preserved 8around label 9550). C if(i_trace .ge. 2) * call intpr('Singularity -> extended subsample: ', * -1,index1,nsel) call rfishsort(index1,pnsel) call prdraw(index1,pnsel, nn) pnsel=pnsel+1 goto 9550 c --------- until endif endif call rfcovsweep(cinv1,nvar,j) 200 continue cc cc Mahalanobis distances are computed with the subroutine rfmahad cc and stored in the array ndist. cc The k-th order statistic of the mahalanobis distances is stored cc in dist2. The array index2 containes the indices of the cc corresponding observations. cc do j=1,nn if(.not.part.or.final) then do mm=1,nvar rec(mm)=dat(j,mm) end do else do mm=1,nvar rec(mm)=dath(j,mm) end do endif t=rfmahad(rec,nvar,means,cinv1) ndist(j)=t end do dist2=rffindq(ndist,nn,nhalf,index2) cc cc The variable kstep represents the number of iterations of the current stage (1,2, or 3), cc i.e., the situation of the program, kstep = k1, k2, or k3. Within each cc iteration the mean and covariance matrix of nhalf observations are cc calculated. The nhalf smallest corresponding mahalanobis distances cc determine the subset for the next iteration. cc The best subset for the whole data is stored in the array inbest. cc The iteration stops when two subsequent determinants become equal. cc 9555 do 400 step=1,kstep tottimes=tottimes+1 if(i_trace .ge. 4) call pr5mcd(step, tottimes) call rchkusr() ! <- allow user interrupt call rfcovinit(sscp1,nvar+1,nvar+1) do j=1,nhalf temp(j)=index2(j) end do call rfishsort(temp,nhalf) do j=1,nhalf if(.not.part.or.final) then do mm=1,nvar rec(mm)=dat(temp(j),mm) end do else do mm=1,nvar rec(mm)=dath(temp(j),mm) end do endif call rfadmit(rec,nvar,sscp1) end do call rfcovar(nhalf,nvar,sscp1,cova1,means,sd) call rfcovcopy(cova1,cinv1,nvar,nvar) det= 0. do 600 j=1,nvar pivot=cinv1((j-1)*nvar+j) det=det + log(pivot) if(pivot.lt.eps) then if(final .or. .not.part .or. * (fine.and. .not.final .and. n .le. nmaxi)) then call transfo(cova1,means,dat,med,mad,nvar,n) call rs(nvar,nvar,cova1,w,matz,z,fv1,fv2,ierr) if(final.or..not.part) then call rfdis(dath,z,ndist,n, nvar,nn, * nvar,means) else call rfdis(dath,z,ndist,nmaxi,nvar,nn, * nvar,means) endif call rfexact(kount,n,ndist,nvar,sscp1, * rec,dat, cova1,means,sd,weight) call rfcovcopy(cova1,initcov,nvar,nvar) call rfcovcopy(means,initmean,nvar,1) do jjj=1,nvar coeff(1,jjj)=z(jjj) end do fit=2 goto 9999 endif if(part.and..not.fine.and.kount.eq.0) then call rs(nvar,nvar,cova1,w,matz,z,fv1,fv2,ierr) call rfdis(dat,z,ndist,n,nvar,n,nvar, means) call rfshsort(ndist,n) if(dabs(ndist(nhalff)-0.D0).lt.10.D-8) then call transfo(cova1,means,dat,med,mad,nvar,n) call rs(nvar,nvar,cova1,w,matz,z, * fv1,fv2,ierr) call rfdis(dat,z,ndist,n,nvar,n,nvar,means) call rfexact(kount,n,ndist,nvar,sscp1, * rec,dat, cova1,means,sd,weight) call rfcovcopy(cova1,initcov,nvar,nvar) call rfcovcopy(means,initmean,nvar,1) do jjj=1,nvar coeff(1,jjj)=z(jjj) end do fit=2 goto 9999 endif call rfdis(dath,z,ndist,nmaxi,nvar,nn, * nvar,means) call rfshsort(ndist,nn) kount=nhalf do,kkk=nhalf+1,nn if(dabs(ndist(kkk)-0.D0).lt.10.D-8) then kount=kount+1 endif end do flag((ii-1)*10+1)=0 do kkk=1,nvar coeff(ii,kkk)=z(kkk) end do call rfstore1(nvar,c1stock,m1stock,nv_2, * kmini,cova1,means,i,km10,ii,mcdndex, kount) kount=1 goto 1000 else if(part.and..not.fine.and.kount.ne.0) then goto 1000 endif endif if(fine.and..not.final.and.kount.eq.0) then call rs(nvar,nvar,cova1,w,matz,z,fv1,fv2,ierr) call rfdis(dat,z,ndist,n,nvar,n,nvar, means) call rfshsort(ndist,n) if(dabs(ndist(nhalff)-0.D0).lt.10.D-8) then call transfo(cova1,means,dat,med,mad,nvar,n) call rs(nvar,nvar,cova1,w,matz,z, * fv1,fv2,ierr) call rfdis(dat,z,ndist,n,nvar,n,nvar,means) call rfexact(kount,n,ndist,nvar,sscp1, * rec,dat, cova1,means,sd,weight) call rfcovcopy(cova1,initcov,nvar,nvar) call rfcovcopy(means,initmean,nvar,1) do jjj=1,nvar coeff(1,jjj)=z(jjj) end do fit=2 goto 9999 endif call rfdis(dath,z,ndist,nmaxi,nvar,nn, * nvar,means) call rfshsort(ndist,nn) kount=nhalf do kkk=nhalf+1,nn if(dabs(ndist(kkk)-0.D0).lt.10.D-8) then kount=kount+1 endif end do flag(1)=0 do kkk=1,nvar coeff(1,kkk)=z(kkk) end do call rfstore2(nvar,cstock,mstock,nv_2, * kmini,cova1,means,i,mcdndex,kount) kount=1 goto 1000 else if(fine.and..not.final.and.kount.ne.0) then goto 1000 endif endif endif call rfcovsweep(cinv1,nvar,j) 600 continue if(step.ge.2 .and. det.eq.detimin1) then goto 5000 endif detimin1=deti deti=det do j=1,nn if(.not.part.or.final) then do mm=1,nvar rec(mm)=dat(j,mm) end do else do mm=1,nvar rec(mm)=dath(j,mm) end do endif t=rfmahad(rec,nvar,means,cinv1) ndist(j)=t end do dist2=rffindq(ndist,nn,nhalf,index2) dist=dsqrt(dist2) if(final .and. ((i.eq.1 .and. step.eq.1 .and. .not.fine) * .or. det .lt. object)) then medi2=rffindq(ndist,nn,int(n/2),index1) object=det do jjj=1,nhalf inbest(jjj)=index2(jjj) end do call rfcovcopy(cova1,cova2,nvar,nvar) call rfcovcopy(cinv1,cinv2,nvar,nvar) call rfcovcopy(means,bmeans,nvar,1) endif 400 continue if(i_trace .ge. 4) call intpr("", -1,1,0) cc After each iteration, it has to be checked whether the new solution cc is better than some previous one and therefore needs to be stored. This cc isn't necessary in the third stage of the algorithm, where only the best cc solution is kept. 5000 if(.not. final) then if(part .and. .not. fine) then iii=ii else iii=1 endif c At the end of the algorithm, only the ten c best solutions need to be stored. cc For each data group : cc If the objective function is lower than the largest value in the cc matrix mcdndex : cc A distinction is made between different stages of the algorithm: cc * At the first stage of the split-up situation: cc -If the new objective value did not yet occur in mcdndex cc its value and corresponding covariance matrix and mean are cc stored at the right place in the matrices mcdndex, c1stock and cc m1stock, and other values are shifted to their new position cc in these arrays. cc -If the new objective value already occurs in mcdndex, a cc comparison is made between the new mean vector and covariance matrix cc and those estimates with the same determinant. cc When for an equal determinant, the mean vector or covariance matrix cc do not correspond, both of them are kept in the matrices mcdndex cc and nbest. cc * In the second stage of the algorithm, the covariances and means cc are stored : cc - If the new objective value did not yet occur cc in the matrix mcdndex, it is inserted by shifting the greater cc determinants upwards and doing the same in the arrays mstock cc and cstock. cc - If the new objective value already occurs in the array mcdndex, cc it is compared with all solutions with the same determinant. cc In the case of an equality, the means and covariances cc are compared to determine whether or not to insert the cc new solution. cc Otherwise nothing happens. When a singularity occurs, cc the determinant in the matrix mcdndex is zero and the cc corresponding flag is zero too, so the search in the arrays mcdndex, cc m1stock, c1stock, mstock and cstock is done on the rows with flag one. cc if( flag((iii-1)*10+1).eq.1) then lll=1 else lll=2 endif do j=lll,10 if (det .le. mcdndex(j,2,iii)) then if(det.ne.mcdndex(j,2,iii)) then if(.not.fine.and.part) goto 203 goto 205 else do kkk=j,10 if(det.eq.mcdndex(kkk,2,iii)) then do jjj=1,nvar if(part.and..not.fine) then if(means(jjj) .ne. * m1stock((iii-1)*10+ kkk,jjj)) * goto 203 else if(means(jjj).ne.mstock(kkk,jjj)) * goto 205 endif end do do jjj=1,nvar*nvar if(part.and..not.fine) then if(cova1(jjj) .ne. * c1stock((iii-1)*10+ kkk,jjj)) * goto 203 else if(cova1(jjj).ne.cstock(kkk,jjj)) * goto 205 endif end do endif end do ! kkk endif goto 1000 c--- 203 do k=10,j+1,-1 do kk=1,nvar*nvar c1stock((iii-1)*10+k,kk)= * c1stock((iii-1)*10+k-1,kk) end do do kk=1,nvar m1stock((iii-1)*10+k,kk)= * m1stock((iii-1)*10+k-1,kk) end do mcdndex(k,1,iii)=mcdndex(k-1,1,iii) mcdndex(k,2,iii)=mcdndex(k-1,2,iii) end do do kk=1,nvar do kkk=1,nvar c1stock((iii-1)*10+j,(kk-1)*nvar+kkk)= * cova1((kk-1)*nvar+kkk) m1stock((iii-1)*10+j,kk)=means(kk) end do end do mcdndex(j,1,iii)=i mcdndex(j,2,iii)=det goto 1000 c--- 205 do k=10,j+1,-1 do kk=1,nvar*nvar cstock(k,kk)= cstock(k-1,kk) end do do kk=1,nvar mstock(k,kk)= mstock(k-1,kk) end do mcdndex(k,1,iii)=mcdndex(k-1,1,iii) mcdndex(k,2,iii)=mcdndex(k-1,2,iii) end do do kk=1,nvar do kkk=1,nvar cstock(j,(kk-1)*nvar+kkk)= * cova1((kk-1)*nvar+kkk) mstock(j,kk)=means(kk) end do end do mcdndex(j,1,iii)=i mcdndex(j,2,iii)=det goto 1000 endif end do ! j endif c (not final) 1000 continue !end{ i = 1..nrep } 1111 continue c---- - - - - - end [ For (ii = 1 .. ngroup) ] - - - - - - - - - cc Determine whether the algorithm needs to be run again or not. cc if(part .and. .not. fine) then fine= .true. goto 5555 else if(.not. final .and. ((part.and.fine).or. .not.part)) then final= .true. goto 5555 endif cc******** end { Main Loop } ************** -------------------------------- c MM: 'temp' is thrown away in calling R code: c do j=1,nhalf c temp(j)=inbest(j) c end do c call rfishsort(temp,nhalf) do j=1,nvar means(j)=bmeans(j)*mad(j)+med(j) end do call rfcovcopy(means,initmean,nvar,1) do i=1,nvar do j=1,nvar cova1((i-1)*nvar+j)=cova2((i-1)*nvar+j)*mad(i)*mad(j) end do end do call rfcovcopy(cova1,initcov,nvar,nvar) det=object do j=1,nvar det=det + 2*log(mad(j)) end do cc VT::chimed is passed now as a parameter cc call rfcovmult(cova1,nvar,nvar,medi2/chimed(nvar)) cc call rfcovmult(cova2,nvar,nvar,medi2/chimed(nvar)) cc call rfcovmult(cinv2,nvar,nvar,1.D0/(medi2/chimed(nvar))) medi2 = medi2/chimed call rfcovmult(cova1, nvar,nvar, medi2) call rfcovmult(cova2, nvar,nvar, medi2) call rfcovmult(cinv2, nvar,nvar, 1.D0/medi2) call rfcovcopy(cova1, adcov,nvar,nvar) cc cc The MCD location is in bmeans. cc The MCD scatter matrix is in cova2, cc and its inverse in cinv2. cc cc For every observation we compute its MCD distance cc and compare it to a cutoff value. cc call rfcovinit(sscp1,nvar+1,nvar+1) do i=1,n do mm=1,nvar rec(mm)=dat(i,mm) end do dist2=rfmahad(rec,nvar,bmeans,cinv2) if(dist2.le.cutoff) then weight(i)=1 else weight(i)=0 endif end do call transfo(cova2,bmeans,dat,med,mad,nvar,n) goto 9999 cc ****************************************************************** 9999 continue if(i_trace .ge. 2) call pr9mcd(tottimes) call rndend C ------ == PutRNGstate() in C return end ccccc end {rffastmcd} ccccc ccccc ccccc ccccc subroutine rfexact(kount,nn,ndist, nvar,sscp1, * rec,dat, cova1,means,sd,weight) cc cc Determines how many objects lie on the hyperplane with equation cc z(1,1)*(x_i1 - means_1)+ ... + z(p,1)* (x_ip - means_p) = 0 cc and computes their mean and their covariance matrix. cc double precision ndist(nn) double precision sscp1(nvar+1,nvar+1) double precision rec(nvar+1) double precision dat(nn,nvar) double precision cova1(nvar,nvar) double precision means(nvar), sd(nvar) integer weight(nn) call rfcovinit(sscp1,nvar+1,nvar+1) kount=0 do kk=1,nn if(dabs(ndist(kk)-0.D0).lt.10.D-8) then kount=kount+1 weight(kk)=1 do j=1,nvar rec(j)=dat(kk,j) end do call rfadmit(rec,nvar,sscp1) else weight(kk)=0 endif end do call rfcovar(kount,nvar,sscp1,cova1,means,sd) return end ccccc ccccc subroutine transfo(cova,means,dat,med,mad,nvar,n) cc implicit none integer n, nvar double precision dat(n,nvar), cova(nvar,nvar) double precision means(nvar), med(nvar), mad(nvar) integer i,j,k do j=1,nvar means(j)=means(j)*mad(j)+med(j) do k=1,nvar cova(j,k)=cova(j,k)*mad(j)*mad(k) end do do i=1,n dat(i,j)=dat(i,j)*mad(j)+med(j) end do end do return end ccccc ccccc subroutine rfcovmult(a,n1,n2,fac) cc cc Multiplies the matrix a by the real factor fac. cc double precision a(n1,n2) double precision fac cc do i=1,n1 do j=1,n2 a(i,j)=a(i,j)*fac end do end do return end ccccc ccccc subroutine rfadmit(rec,nvar,sscp) cc cc Updates the sscp matrix with the additional case rec. cc double precision rec(nvar) double precision sscp(nvar+1,nvar+1) cc sscp(1,1)=sscp(1,1)+1.D0 do j=1,nvar sscp(1,j+1)=sscp(1,j+1)+rec(j) sscp(j+1,1)=sscp(1,j+1) end do do i=1,nvar do j=1,nvar sscp(i+1,j+1)=sscp(i+1,j+1)+rec(i)*rec(j) end do end do return end ccccc ccccc subroutine rfcovar(n,nvar, sscp,cova, means,sd) cc cc Computes the classical mean and covariance matrix. cc implicit none integer n,nvar, i,j double precision sscp(nvar+1,nvar+1), cova(nvar,nvar) double precision means(nvar), sd(nvar), f do i=1,nvar means(i)=sscp(1,i+1) sd(i)=sscp(i+1,i+1) f=(sd(i)-means(i)*means(i)/n)/(n-1) if(f.gt.0.D0) then sd(i)=dsqrt(f) else sd(i)=0.D0 endif means(i)=means(i)/n end do do i=1,nvar do j=1,nvar cova(i,j)=sscp(i+1,j+1) end do end do do i=1,nvar do j=1,nvar cova(i,j)=cova(i,j)-n*means(i)*means(j) cova(i,j)=cova(i,j)/(n-1) end do end do return end ccccc ccccc subroutine rfcorrel(nvar,a,b,sd) cc cc Transforms the scatter matrix a to the correlation matrix b: <==> R's cov2cor(.) cc implicit none integer nvar double precision a(nvar,nvar), b(nvar,nvar), sd(nvar) integer j,i do j=1,nvar sd(j)=1/sqrt(a(j,j)) end do do i=1,nvar do j=1,nvar if(i.eq.j) then b(i,j)=1.0 else b(i,j)=a(i,j)*sd(i)*sd(j) endif end do end do return end subroutine prdraw(a,pnsel, nn) implicit none integer nn, a(nn), pnsel c double precision unifrnd integer jndex, nrand, i,j jndex=pnsel c OLD nrand=int(uniran(seed)*(nn-jndex))+1 nrand=int(unifrnd() * (nn-jndex))+1 C if(nrand .gt. nn-jndex) then C call intpr( C 1 '** prdraw(): correcting nrand > nn-jndex; nrand=', C 2 -1, nrand, 1) C nrand=nn-jndex C endif jndex=jndex+1 a(jndex)=nrand+jndex-1 do i=1,jndex-1 if(a(i).gt.nrand+i-1) then do j=jndex,i+1,-1 a(j)=a(j-1) end do a(i)=nrand+i-1 goto 10 c ------- break endif end do 10 continue return end ccccc ccccc double precision function rfmahad(rec,nvar,means,sigma) cc cc Computes a Mahalanobis-type distance. cc double precision rec(nvar), means(nvar), sigma(nvar,nvar), t t = 0. do j=1,nvar do k=1,nvar t = t + (rec(j)-means(j))*(rec(k)-means(k))*sigma(j,k) end do end do rfmahad=t return end ccccc ccccc subroutine rfdis(da,z,ndist,nm,nv,nn,nvar, means) cc cc Computes the distance between the objects of da and a hyperplane with cc equation z(1,1)*(x_i1 - means_1) + ... + z(p,1)*(x_ip - means_p) = 0 cc double precision da(nm,nv) double precision z(nvar,nvar) double precision ndist(nn) double precision means(nvar) do i=1,nn ndist(i)=0 do j=1,nvar ndist(i)=z(j,1)*(da(i,j)-means(j))+ndist(i) end do ndist(i)=dabs(ndist(i)) end do return end ccccc ccccc subroutine rfstore2(nvar,cstock,mstock,nv_2, * kmini,cova1,means,i,mcdndex,kount) cc cc Stores the coefficients of a hyperplane cc z(1,1)*(x_i1 - means_1) + ... + z(p,1)*(x_ip - means_p) = 0 cc into the first row of the matrix mstock, and shifts the other cc elements of the arrays mstock and cstock. cc double precision cstock(10, nv_2), mstock(10, nvar) double precision mcdndex(10, 2, kmini) double precision cova1(nvar,nvar), means(nvar) do k=10,2,-1 do kk=1,nvar*nvar cstock(k,kk)= cstock(k-1,kk) end do do kk=1,nvar mstock(k,kk)= mstock(k-1,kk) end do mcdndex(k,1,1)=mcdndex(k-1,1,1) mcdndex(k,2,1)=mcdndex(k-1,2,1) end do do kk=1,nvar mstock(1,kk)=means(kk) do jj=1,nvar cstock(1,(kk-1)*nvar+jj)=cova1(kk,jj) end do end do mcdndex(1,1,1)=i mcdndex(1,2,1)=kount return end ccccc ccccc subroutine rfstore1(nvar,c1stock,m1stock,nv_2, * kmini,cova1,means,i,km10,ii,mcdndex,kount) double precision c1stock(km10, nv_2), m1stock(km10, nvar) double precision mcdndex(10,2,kmini) double precision cova1(nvar,nvar), means(nvar) do k=10,2,-1 do kk=1,nvar*nvar c1stock((ii-1)*10+k,kk)= * c1stock((ii-1)*10+k-1,kk) end do do kk=1,nvar m1stock((ii-1)*10+k,kk)= * m1stock((ii-1)*10+k-1,kk) end do mcdndex(k,1,ii)=mcdndex(k-1,1,ii) mcdndex(k,2,ii)=mcdndex(k-1,2,ii) end do do kk=1,nvar m1stock((ii-1)*10+1,kk)=means(kk) do jj=1,nvar c1stock((ii-1)*10+1,(kk-1)*nvar+jj)= * cova1(kk,jj) end do end do mcdndex(1,1,ii)=i mcdndex(1,2,ii)=kount return end CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ccccc ccccc subroutine rfcovinit(a,n1,n2) cc cc Initializes the matrix a by filling it with zeroes. cc double precision a(n1,n2) cc do i=1,n1 do j=1,n2 a(i,j)=0.D0 end do end do return end ccccc ccccc subroutine rfcovsweep(a,nvar,k) cc double precision a(nvar,nvar) double precision b, d cc d=a(k,k) do j=1,nvar a(k,j)=a(k,j)/d end do do i=1,nvar if(i.ne.k) then b=a(i,k) do j=1,nvar a(i,j)=a(i,j)-b*a(k,j) end do a(i,k) = -b/d endif end do a(k,k)=1/d return end ccccc robustbase/src/rf-common.f0000644000176200001440000002356012432425613015266 0ustar liggesusersc c-- Routines common to c-- fastLTS ( ./rfltsreg.f ) and c-- fastMCD ( ./rffastmcd.f ) c c subroutine rfrangen(n, nsel, index) c c Randomly draws nsel cases out of n cases. c Here, index is the index set. c implicit none integer n, nsel, index(nsel) c unifrnd() == R C API's unif_rand() --> see ./R-rng4ftn.c double precision unifrnd integer i,j, num c do i=1,nsel cOLD 10 num=int(uniran(seed)*n)+1 10 num=int(unifrnd()*n)+1 C if(num .gt. n) then C call intpr('** rfrangen(): num > n; num=', -1, num, 1) C num=n C endif if(i.gt.1) then do j=1,i-1 if(index(j).eq.num) goto 10 end do endif index(i)=num end do return end c --------------------------------------------------------- cOLD function uniran(seed) cOLD cc cOLD cc Draws a random number from the uniform distribution on [0,1]. cOLD cc cOLD real uniran cOLD integer seed cOLD integer quot cOLD cc cOLD seed=seed*5761+999 cOLD quot=seed/65536 cOLD seed=seed-quot*65536 cOLD uniran=float(seed)/65536.D0 cOLD return cOLD end c --------------------------------------------------------- subroutine rfgenpn(n,nsel,index) cc cc Constructs all subsets of nsel cases out of n cases. cc implicit none integer n,nsel,index(nsel) cc integer k,i k=nsel index(k)=index(k)+1 c while 10 if(k.eq.1 .or. index(k).le.(n-(nsel-k))) goto 100 k=k-1 index(k)=index(k)+1 do i=k+1,nsel index(i)=index(i-1)+1 end do goto 10 c end{while} 100 return end c --------------------------------------------------------- subroutine rfshsort(a,n) cc cc Sorts the array a of length n. cc implicit none integer n double precision a(n) c double precision t integer gap, i,j, nextj gap=n c --- repeat 100 gap=gap/2 if(gap.eq.0) goto 200 do 180 i=1,n-gap j=i 120 if(j.lt.1) goto 180 nextj=j+gap if(a(j).gt.a(nextj)) then t=a(j) a(j)=a(nextj) a(nextj)=t else j=0 endif j=j-gap goto 120 180 continue goto 100 c ---- --- end repeat 200 return end c --------------------------------------------------------- subroutine rfishsort(a,n) cc cc Sorts the integer array a of length n. cc implicit none integer n, a(n) c integer t, gap, i,j, nextj gap=n c --- repeat 100 gap=gap/2 if(gap.eq.0) goto 200 do 180 i=1,n-gap j=i 120 if(j.lt.1) goto 180 nextj=j+gap if(a(j).gt.a(nextj)) then t=a(j) a(j)=a(nextj) a(nextj)=t else j=0 endif j=j-gap goto 120 180 continue goto 100 c ---- --- end repeat 200 return end c --------------------------------------------------------- integer function replow(k) cc cc Find out which combinations of n and p are cc small enough in order to perform exaustive search cc Returns the maximal n for a given p, for which cc exhaustive search is to be done cc cc k is the number of variables (p) cc implicit none integer k c integer irep(6) data irep/500,50,22,17,15,14/ c if(k .le. 6) then replow = irep(k) else replow = 0 endif return end c --------------------------------------------------------- integer function rfncomb(k,n) cc cc Computes the number of combinations of k out of n. cc (To avoid integer overflow during the computation, cc ratios of reals are multiplied sequentially.) cc For comb > 1E+009 the resulting 'comb' may be too large cc to be put in the integer 'rfncomb', but the main program cc only calls this function for small enough n and k. cc implicit none integer k,n c double precision comb,fact integer j c comb=dble(1.0) do j=1,k fact=(dble(n-j+1.0))/(dble(k-j+1.0)) comb=comb*fact end do c Should give error now instead of integer overflow! c Don't know how to get .Machine$integer.max in Fortran, portably if(comb .gt. 2147483647) then comb=2147483647. call + dblepr('** too many combinations; using max.integer instead:', + -1,comb,1) endif rfncomb=int(comb+0.5D0) return end c --------------------------------------------------------- subroutine rfcovcopy(a,b,n1,n2) cc cc Copies matrix a to matrix b. cc double precision a(n1,n2) double precision b(n1,n2) c do i=1,n1 do j=1,n2 b(i,j)=a(i,j) end do end do return end c --------------------------------------------------------- double precision function rffindq(aw, ncas, k, index) c c Finds the k-th order statistic of the array aw[1..ncas], c sorting the array aw[.] until aw[k] is sure to contain the k-th value c c MM{FIXME}: "rather" use R's C API rPsort (double* X, int N, int K) implicit none integer ncas,k,index(ncas) double precision aw(ncas) c double precision ax,wa integer i,j,l,lr,jnc c do j=1,ncas index(j)=j end do c lower (= l) and upper ( =lr ) bounds: l=1 lr=ncas c--- while(l < lr) 20 if(l .lt. lr) then ax=aw(k) jnc=l j=lr c--- while(jnc < j) 30 if(jnc .le. j) then 40 if(aw(jnc).ge.ax) goto 50 jnc=jnc+1 goto 40 50 if(aw(j).le.ax) goto 60 j=j-1 goto 50 60 if(jnc .le. j) then ! swap jnc <--> j i=index(jnc) index(jnc)=index(j) index(j)=i wa=aw(jnc) aw(jnc)=aw(j) aw(j)=wa jnc=jnc+1 j=j-1 endif goto 30 end if if(j.lt.k) l=jnc if(k.lt.jnc) lr=j goto 20 end if rffindq=aw(k) return end c --------------------------------------------------------- subroutine rfrdraw(a,n,ntot,mini,ngroup,kmini) cc cc Draws ngroup nonoverlapping subdatasets out of a dataset of size n, cc such that the selected case numbers are uniformly distributed from 1 to n. cc implicit none integer n, ntot, kmini, a(2,ntot), mini(kmini), ngroup c unifrnd() == R C API's unif_rand() --> see ./R-rng4ftn.c double precision unifrnd c integer jndex, nrand, k,m,i,j cc jndex=0 do k=1,ngroup do 20 m=1,mini(k) cOLD nrand=int(uniran(seed)*(n-jndex))+1 nrand=int(unifrnd()*(n-jndex))+1 C if(nrand .gt. n-jndex) then C call intpr( C 1 '** rfrdraw(): need to correct nrand > n-jndex; nrand=', C 2 -1, nrand, 1) C nrand=n-jndex C endif jndex=jndex+1 if(jndex.eq.1) then a(1,jndex)=nrand a(2,jndex)=k else a(1,jndex)=nrand+jndex-1 a(2,jndex)=k do i=1,jndex-1 if(a(1,i).gt.nrand+i-1) then do j=jndex,i+1,-1 a(1,j)=a(1,j-1) a(2,j)=a(2,j-1) end do a(1,i)=nrand+i-1 a(2,i)=k goto 20 c ------- break endif end do endif 20 continue end do return end c --------------------------------------------------------- logical function rfodd(n) rfodd=.true. if(2*(n/2).eq.n) rfodd=.false. return end c --------------------------------------------------------- c unused function rfnbreak(nhalf,n,nvar) c unused cc c unused cc Computes the breakdown value - in percent! - of the MCD estimator c unused cc c unused implicit none c unused integer rfnbreak, nhalf, n, nvar c unused c unused if (nhalf.le.(n+nvar+1)/2) then c unused rfnbreak=(nhalf-nvar)*100/n c unused else c unused rfnbreak=(n-nhalf+1)*100/n c unused endif c unused return c unused end c --------------------------------------------------------- subroutine rfmcduni(w,ncas,jqu,slutn,bstd,aw,aw2,factor,len) cc cc rfmcduni : calculates the MCD in the univariate case. cc w contains the ordered observations cc c This version returns the index (jint) in 'len' c which is used in rfltreg.f implicit double precision (a-h,o-z), integer(i-n) integer ncas, jqu, len double precision w(ncas), aw(ncas), aw2(ncas) double precision slutn(len) cc sq=0.D0 sqmin=0.D0 ndup=1 do j=1,ncas-jqu+1 slutn(j)=0.D0 end do do jint=1,ncas-jqu+1 aw(jint)=0.D0 do j=1,jqu aw(jint)=aw(jint)+w(j+jint-1) if (jint.eq.1) sq=sq+w(j)*w(j) end do aw2(jint)=aw(jint)*aw(jint)/jqu if (jint.eq.1) then sq=sq-aw2(jint) sqmin=sq slutn(ndup)=aw(jint) len=jint else sq=sq - w(jint-1)*w(jint-1) + w(jint+jqu-1)*w(jint+jqu-1) * - aw2(jint) + aw2(jint-1) if(sq.lt.sqmin) then ndup=1 sqmin=sq slutn(ndup)=aw(jint) len=jint else if(sq.eq.sqmin) then ndup=ndup+1 slutn(ndup)=aw(jint) endif endif endif end do slutn(1)=slutn(int((ndup+1)/2))/jqu bstd=factor*sqrt(sqmin/jqu) return end c --------------------------------------------------------- robustbase/src/robustbase.h0000644000176200001440000001357513344174616015560 0ustar liggesusers/* External and interal API of C and Fortran routines in robustbase */ #include // for SEXP #include /**< For internationalized messages */ #ifdef ENABLE_NLS #include #define _(String) dgettext ("Matrix", String) #else #define _(String) (String) #define dngettext(pkg, String, StringP, N) (N > 1 ? StringP : String) #endif /* --------- ./qn_sn.c : -------- */ #define Sint int void Qn0(double *x, Sint *n, double *res); void Sn0(double *x, Sint *n, Sint *is_sorted, double *res, double *a2); /* * void Qn (double *x, Sint *n, Sint *finite_corr, double *res); * void Sn (double *x, Sint *n, Sint *finite_corr, double *res); */ /* call via .C() from R : */ void wgt_himed_i(double *x, Sint *n, Sint *iw, double *res); void wgt_himed (double *x, Sint *n, double *w, double *res); /* call from C: */ double pull(double *a, int n, int k); double whimed_i(double *a, int *iw, int n, double *acand, double *a_srt, int *iw_cand); double whimed(double *a, double *w, int n, double *acand, double *a_srt, double *w_cand); /* --------- ./mc.c -------- */ /* call via .C() from R : */ void mc_C(double *z, int *in, double *eps, int *iter, double *out, int *scale); /* call from C: *iter is both input and output */ double mc_C_d(double *z, int n, const double eps[], int *iter, int scale); /* --------- ./lmrob.c --------- */ static inline Rboolean is_redescender(int ipsi) {// a simple wrapper for readability // for now, fastest: if(ipsi == 0) return FALSE; return TRUE; /* if have many more, maybe switch(ipsi) { default: error("ipsi=%d not implemented.", ipsi); case 0: // huber and future other non-redescenders return FALSE; case 1: case 2: case 3: case 4: case 5: case 6: return TRUE; } */ } SEXP R_rho_inf(SEXP cc, SEXP ipsi); void R_lmrob_S(double *X, double *y, int *n, int *P, int *nRes, double *scale, double *beta_s, double *C, int *iipsi, double *bb, int *best_r, int *Groups, int *N_group, int *K_s, int *max_k, int *max_it_scale, double *rel_tol, double *inv_tol, double *scale_tol, // ^^^^^^^^^ = refine.tol in R int* converged, int *trace_lev, int *mts, int *ss, int *cutoff); void R_lmrob_M_S(double *X1, double *X2, double *y, double *res, int *n, int *p1, int *p2, int *nRes, int *max_it_scale, double *scale, double *b1, double *b2, double *rho_c, int *ipsi, double *bb, int *K_m_s, int *max_k, double *rel_tol, double *inv_tol, double *scale_tol, int *converged, int *trace_lev, int *orthogonalize, int *subsample, int *descent, int *mts, int *ss); void R_lmrob_MM(double *X, double *y, int *n, int *P, double *beta_initial, double *scale, double *beta_m, double *resid, int *max_it, double *rho_c, int *ipsi, double *loss, double *rel_tol, int *converged, int *trace_lev, int *mts, int *ss); void R_subsample(const double *x, const double *y, int *n, int *m, double *beta, int *ind_space, int *idc, int *idr, double *lu, double *v, int *p, double *_Dr, double *_Dc, int *_rowequ, int *_colequ, int *status, int *sample, int *mts, int *ss, double *tol_inv, int *solve); SEXP R_psifun(SEXP x_, SEXP c_, SEXP ipsi_, SEXP deriv_); SEXP R_chifun(SEXP x_, SEXP c_, SEXP ipsi_, SEXP deriv_); SEXP R_wgtfun(SEXP x_, SEXP c_, SEXP ipsi_); double rho(double x, const double c[], int ipsi); double psi(double x, const double c[], int ipsi); double psip(double x, const double c[], int ipsi);// psi' double psi2(double x, const double c[], int ipsi);// psi'' double wgt(double x, const double c[], int ipsi); double rho_inf (const double c[], int ipsi); // == \rho(\infty) double normcnst(const double c[], int ipsi); // == 1 / \rho(\infty) == 1 / rho_inf() void R_find_D_scale(double *rr, double *kkappa, double *ttau, int *llength, double *sscale, double *cc, int *iipsi, int *ttype, double *rel_tol, int *max_k, int *converged); void R_calc_fitted(double *XX, double *bbeta, double *RR, int *nn, int *pp, int *nnrep, int *nnproc, int *nnerr); // ------- ./rob-utils.c --------------- SEXP R_wgt_flex(SEXP x_, SEXP c_, SEXP h_); // ------- ./rowMedians.c --------------- SEXP R_rowMedians(SEXP x, SEXP naRm, SEXP hasNA, SEXP byRow, SEXP keepNms); /* ------- ./rffastmcd.f ------------ */ int F77_NAME(rffastmcd)( double *dat, int *n, int *nvar, int *nhalff, int *krep, double *initcov, double *initmean, int *inbest, double *det, int *weight, int *fit, double *coeff, int *kount, double *adcov, int *iseed, int *temp, int *index1, int *index2, double *nmahad, double *ndist, double *am, double *am2, double *slutn, double *med, double *mad, double *sd, double *means, double *bmeans, double *w, double *fv1, double *fv2, double *rec, double *sscp1, double *cova1, double *corr1, double *cinv1, double *cova2, double *cinv2, double *z__, double *cstock, double *mstock, double *c1stock, double *m1stock, double *dath, double *cutoff, double *chimed); /* ------- ./rfltsreg.f ------------ */ int F77_NAME(rfltsreg)( double *dat, int *n, int *nvar, int *nhalff, int *krep, int *inbest, double *objfct, int *intercept, int *intadjust, int *nvad, double *datt, int *iseed, double *weights, int *temp, int *index1, int *index2, double *aw2, double *aw, double *residu, double *y, double *nmahad, double *ndist, double *am, double *am2, double *slutn, int *jmiss, double *xmed, double *xmad, double *a, double *da, double *h__, double *hvec, double *c__, double *cstock, double *mstock, double *c1stock, double *m1stock, double *dath, double *sd, double *means, double *bmeans); /* ------- ./rllarsbi.f -------------- */ void F77_NAME(rllarsbi)( double *X, double *Y, int *N, int *NP, int *MDX, int *MDT, double *TOL, int *NIT, int *K, int *KODE, double *SIGMA, double *THETA, double *RS, double *SC1, double *SC2, double *SC3, double *SC4, double *BET0); robustbase/src/qn_sn.c0000644000176200001440000003076112140440344014477 0ustar liggesusers/* * Copyright (C) 2005--2007 Martin Maechler, ETH Zurich * * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ /* This is a merge of the C version of original files qn.f and sn.f, * translated by f2c (version 20010821). ==== ==== * and then by f2c-clean,v 1.9 2000/01/13 13:46:53 * and further clean-edited manually by Martin Maechler. * * Further added interface functions to be called via .C() from R or S-plus * Note that Peter Rousseeuw has explicitely given permission to * use his code under the GPL for the R project. */ /* Original comments by the authors of the Fortran original code, * (merged for Qn & Sn in one file by M.M.): This file contains fortran functions for two new robust estimators of scale denoted as Qn and Sn, decribed in Rousseeuw and Croux (1993). These estimators have a high breakdown point and a bounded influence function. The implementation given here is very fast (running in O(n logn) time) and needs little storage space. Rousseeuw, P.J. and Croux, C. (1993) Alternatives to the Median Absolute Deviation", Journal of the American Statistical Association, Vol. 88, 1273-1283. For both estimators, implementations in the pascal language can be obtained from the original authors. This software may be used and copied freely for scientific and/or non-commercial purposes, provided reference is made to the abovementioned paper. Note by MM: We have explicit permission from P.Rousseeuw to licence it under the GNU Public Licence. See also ../inst/Copyrights */ #include /* ^^^^^^^^^^ is supposedly more common and standard than * #include * or #include */ /* --> int64_t ; if people don't have the above, they can forget about it.. */ /* #include "int64.h" */ #include /* -> and much more */ /* Interface routines to be called via .C() : */ #include "robustbase.h" /* ----------------- Further Declarations ------------------------------ */ /* sn0() and qn0() --- but also mc_C() in ./mc.c * ----- ---- ------ use pull(a,n,k): finds the k-th order statistic of an array a[] of length n (preserving a[]) */ /* whimed_i(a,iw,n): finds the weighted high median of an array a[] of length n, with positive int weights iw[] (using auxiliary arrays acand[], a_srt[] & iw_cand[] all of length n). */ /* qn0() uses (and for C API:) */ /* Main routines for C API */ double qn(double *x, int n, int finite_corr); double sn(double *x, int n, int is_sorted, int finite_corr); /* these have no extra factors (no consistency factor & finite_corr): */ double qn0(double *x, int n); double sn0(double *x, int n, int is_sorted, double *a2); /* ----------- Implementations -----------------------------------*/ void Qn0(double *x, Sint *n, double *res) { *res = qn0(x, (int)*n); } void Sn0(double *x, Sint *n, Sint *is_sorted, double *res, double *a2) { char *vmax; vmax = vmaxget(); *res = sn0(x, (int)*n, (int)*is_sorted, a2); #ifdef DEBUG_Sno REprintf("Sn0(* -> res=%g)\n", *res); #endif vmaxset(vmax); } double qn0(double *x, int n) { /*-------------------------------------------------------------------- Efficient algorithm for the scale estimator: Q*_n = { |x_i - x_j|; i=2) */ double *y = (double *)R_alloc(n, sizeof(double)); double *work = (double *)R_alloc(n, sizeof(double)); double *a_srt = (double *)R_alloc(n, sizeof(double)); double *a_cand = (double *)R_alloc(n, sizeof(double)); int *left = (int *)R_alloc(n, sizeof(int)); int *right = (int *)R_alloc(n, sizeof(int)); int *p = (int *)R_alloc(n, sizeof(int)); int *q = (int *)R_alloc(n, sizeof(int)); int *weight = (int *)R_alloc(n, sizeof(int)); double trial = R_NaReal;/* -Wall */ Rboolean found; int h, i, j,jj,jh; /* Following should be `long long int' : they can be of order n^2 */ int64_t k, knew, nl,nr, sump,sumq; h = n / 2 + 1; k = (int64_t)h * (h - 1) / 2; for (i = 0; i < n; ++i) { y[i] = x[i]; left [i] = n - i + 1; right[i] = (i <= h) ? n : n - (i - h); /* the n - (i-h) is from the paper; original code had `n' */ } R_qsort(y, 1, n); /* y := sort(x) */ nl = (int64_t)n * (n + 1) / 2; nr = (int64_t)n * n; knew = k + nl;/* = k + (n+1 \over 2) */ found = FALSE; #ifdef DEBUG_qn REprintf("qn0(): h,k= %2d,%2d; nl,nr= %d,%d\n", h,k, nl,nr); #endif /* L200: */ while(!found && nr - nl > n) { j = 0; /* Truncation to float : try to make sure that the same values are got later (guard bits !) */ for (i = 1; i < n; ++i) { if (left[i] <= right[i]) { weight[j] = right[i] - left[i] + 1; jh = left[i] + weight[j] / 2; work[j] = (float)(y[i] - y[n - jh]); ++j; } } trial = whimed_i(work, weight, j, a_cand, a_srt, /*iw_cand*/ p); #ifdef DEBUG_qn REprintf(" ..!found: whimed("); # ifdef DEBUG_long REprintf("wrk=c("); for(i=0; i < j; i++) REprintf("%s%g", (i>0)? ", " : "", work[i]); REprintf("),\n wgt=c("); for(i=0; i < j; i++) REprintf("%s%d", (i>0)? ", " : "", weight[i]); REprintf("), j= %3d) -> trial= %7g\n", j, trial); # else REprintf("j=%3d) -> trial= %g:", j, trial); # endif #endif j = 0; for (i = n - 1; i >= 0; --i) { while (j < n && ((float)(y[i] - y[n - j - 1])) < trial) ++j; p[i] = j; } #ifdef DEBUG_qn REprintf(" f_1: j=%2d", j); #endif j = n + 1; for (i = 0; i < n; ++i) { while ((float)(y[i] - y[n - j + 1]) > trial) --j; q[i] = j; } sump = 0; sumq = 0; for (i = 0; i < n; ++i) { sump += p[i]; sumq += q[i] - 1; } #ifdef DEBUG_qn REprintf(" f_2 -> j=%2d, sump|q= %lld,%lld", j, sump,sumq); #endif if (knew <= sump) { for (i = 0; i < n; ++i) right[i] = p[i]; nr = sump; #ifdef DEBUG_qn REprintf("knew <= sump =: nr , new right[]\n"); #endif } else if (knew > sumq) { for (i = 0; i < n; ++i) left[i] = q[i]; nl = sumq; #ifdef DEBUG_qn REprintf("knew > sumq =: nl , new left[]\n"); #endif } else { /* sump < knew <= sumq */ found = TRUE; #ifdef DEBUG_qn REprintf("sump < knew <= sumq ---> FOUND\n"); #endif } } /* while */ if (found) return trial; else { #ifdef DEBUG_qn REprintf(".. not fnd -> new work[]"); #endif j = 0; for (i = 1; i < n; ++i) { for (jj = left[i]; jj <= right[i]; ++jj) { work[j] = y[i] - y[n - jj]; j++; }/* j will be = sum_{i=2}^n (right[i] - left[i] + 1)_{+} */ } #ifdef DEBUG_qn REprintf(" of length %d; knew-nl=%d\n", j, knew-nl); #endif /* return pull(work, j - 1, knew - nl) : */ knew -= (nl + 1); /* -1: 0-indexing */ rPsort(work, j, knew); return(work[knew]); } } /* qn0 */ double qn(double *x, int n, int finite_corr) { /* Efficient algorithm for the scale estimator: Qn = dn * 2.2219 * {|x_i-x_j|; i= n) containing the observations n : number of observations (n>=2) is_sorted: logical indicating if x is already sorted a2 : to contain a2[i] := LOMED_{j != i} | x_i - x_j |, for i=1,...,n */ /* Local variables */ double medA, medB; int i, diff, half, Amin, Amax, even, length; int leftA,leftB, nA,nB, tryA,tryB, rightA,rightB; int n1_2; if(!is_sorted) R_qsort(x, 1, n); a2[0] = x[n / 2] - x[0]; n1_2 = (n + 1) / 2; /* first half for() loop : */ for (i = 2; i <= n1_2; ++i) { nA = i - 1; nB = n - i; diff = nB - nA; leftA = leftB = 1; rightA = rightB = nB; Amin = diff / 2 + 1; Amax = diff / 2 + nA; while (leftA < rightA) { length = rightA - leftA + 1; even = 1 - length % 2; half = (length - 1) / 2; tryA = leftA + half; tryB = leftB + half; if (tryA < Amin) { rightB = tryB; leftA = tryA + even; } else { if (tryA > Amax) { rightA = tryA; leftB = tryB + even; } else { medA = x[i - 1] - x[i - tryA + Amin - 2]; medB = x[tryB + i - 1] - x[i - 1]; if (medA >= medB) { rightA = tryA; leftB = tryB + even; } else { rightB = tryB; leftA = tryA + even; } } } } /* while */ if (leftA > Amax) { a2[i - 1] = x[leftB + i - 1] - x[i - 1]; } else { medA = x[i - 1] - x[i - leftA + Amin - 2]; medB = x[leftB + i - 1] - x[i - 1]; a2[i - 1] = fmin2(medA,medB); } } /* second half for() loop : */ for (i = n1_2 + 1; i <= n - 1; ++i) { nA = n - i; nB = i - 1; diff = nB - nA; leftA = leftB = 1; rightA = rightB = nB; Amin = diff / 2 + 1; Amax = diff / 2 + nA; while (leftA < rightA) { length = rightA - leftA + 1; even = 1 - length % 2; half = (length - 1) / 2; tryA = leftA + half; tryB = leftB + half; if (tryA < Amin) { rightB = tryB; leftA = tryA + even; } else { if (tryA > Amax) { rightA = tryA; leftB = tryB + even; } else { medA = x[i + tryA - Amin] - x[i - 1]; medB = x[i - 1] - x[i - tryB - 1]; if (medA >= medB) { rightA = tryA; leftB = tryB + even; } else { rightB = tryB; leftA = tryA + even; } } } } /* while */ if (leftA > Amax) { a2[i - 1] = x[i - 1] - x[i - leftB - 1]; } else { medA = x[i + leftA - Amin] - x[i - 1]; medB = x[i - 1] - x[i - leftB - 1]; a2[i - 1] = fmin2(medA,medB); } } a2[n - 1] = x[n - 1] - x[n1_2 - 1]; return pull(a2, n, n1_2); } /* sn0 */ double sn(double *x, int n, int is_sorted, int finite_corr) { /* Efficient algorithm for the scale estimator: Sn = cn * 1.1926 * LOMED_{i} HIMED_{i} |x_i-x_j| which can equivalently be written as Sn = cn * 1.1926 * LOMED_{i} LOMED_{j != i} |x_i-x_j|*/ double cn, r; double *a2 = (double *)R_alloc(n, sizeof(double)); r = 1.1926 * /* asymptotic consistency for sigma^2 */ sn0(x, n, is_sorted, a2); /* === */ cn = 1.; /* n >= 10 even, or no finite_corr[ection] */ if (finite_corr) { if (n <= 9) { if (n == 2) cn = 0.743; else if (n == 3) cn = 1.851; else if (n == 4) cn = 0.954; else if (n == 5) cn = 1.351; else if (n == 6) cn = 0.993; else if (n == 7) cn = 1.198; else if (n == 8) cn = 1.005; else if (n == 9) cn = 1.131; } else if (n % 2 == 1) /* n odd, >= 11 */ cn = n / (n - 0.9); } return cn * r; } /* sn */ /* pull(): auxiliary routine for Qn and Sn * ====== ======== --------------------- */ double pull(double *a_in, int n, int k) { /* Finds the k-th order statistic of an array a[] of length n * -------------------- */ int j; double *a, ax; char* vmax = vmaxget(); a = (double *)R_alloc(n, sizeof(double)); /* Copy a[] and use copy since it will be re-shuffled: */ for (j = 0; j < n; j++) a[j] = a_in[j]; k--; /* 0-indexing */ rPsort(a, n, k); ax = a[k]; vmaxset(vmax); return ax; } /* pull */ /* Local variables section * Local variables: * mode: c * kept-old-versions: 12 * kept-new-versions: 20 * End: */ robustbase/NAMESPACE0000644000176200001440000001356313326360567013665 0ustar liggesusersuseDynLib(robustbase, .registration=TRUE) if(FALSE) {##MM stopifnot(require(codetoolsBioC), require(robustbase)) findExternalDeps("robustbase") } importFrom("grDevices", dev.interactive, extendrange) importFrom("graphics", abline, box, legend, lines, matplot, mtext, panel.smooth, par, plot, points, strheight, text, title) importFrom("stats", aggregate, alias, as.formula, binomial, coef, cor, cov, cov.wt, cov2cor, delete.response, deviance, dnorm, dpois, family, fitted, fivenum, formula, gaussian, glm, glm.fit, hatvalues, integrate, is.empty.model, lm.fit, lm.wfit, mad, mahalanobis, median, model.frame, model.matrix, model.matrix.lm, model.offset, model.response, model.weights, na.fail, na.omit, na.pass, napredict, naprint, naresid, nlminb, nls, nls.control, nobs, optim, optimize, pbinom, pchisq, pf, pgamma, pnorm, poisson, ppois, predict, printCoefmat, pt, qchisq, qnorm, qpois, qqline, qqnorm, qt, quantile, resid, residuals, residuals.lm, setNames, splinefun, symnum, terms, uniroot, var, vcov, weights, .checkMFClasses, .getXlevels, ## S3 generics (*not* shown yet by findExternalDeps() above): anova, case.names, confint, dummy.coef, logLik, profile, variable.names ) ## ^^^^ MASS has a bit more; take it as example if(getRversion() >= "3.1.0") importFrom("stats", .lm.fit, confint.lm, dummy.coef.lm) if(getRversion() >= "3.3.0") { importFrom("stats", sigma) } else { export(sigma) S3method(sigma, nls) } importFrom("utils", globalVariables, str) ## MASS has many rlm S3 methods; should we use some of them - for rnls() ?! ## we also currently use MASS::cov.rob(); but probably only temporarily importFrom("methods", is, new, setClass, setMethod, slot, "slot<-", ## needed, e.g. for 'robustlmm' to work w/o warning: as, "as<-", coerce, "coerce<-") importFrom("DEoptimR", JDEoptim) ## Functions defined in this package export(Sn, Qn, Qn.old, s_Sn, s_Qn, s_mad, s_IQR, summarizeRobWeights, wgt.himedian, h.alpha.n, covMcd, .MCDcons, .MCDcnp2, .MCDcnp2.rew, .MCDsingularityMsg, robMD, mahalanobisD, # <- still "internal" ltsReg, tolEllipsePlot, ## RENAME ?!? : covPlot, ltsPlot, ## NO! ddplot, distplot, chi2qqplot rrcov.control,## << RENAME --- FIXME huberM, colMedians, rowMedians, covOGK, covGK, hard.rejection, scaleTau2, covComed, ## comedian, COM, -- not yet smoothWgt, .wgtFUN.covMcd, .wgtFUN.covComed, psiFunc, huberPsi, hampelPsi, ## Not yet: ## tukeyPsi, # = biweight / bisquare tukeyChi, tukeyPsi1, # TODO deprecate: see ./TODO Mpsi, Mchi, Mwgt, MrhoInf, .Mpsi, .Mchi, .Mwgt, .MrhoInf, .Mwgt.psi1, .Mchi.tuning.default, .Mpsi.tuning.default, .regularize.Mpsi, .Mchi.tuning.defaults, .Mpsi.tuning.defaults, .psi2ipsi, .psi.const, .psi.ggw.findc, .psi.lqq.findc, lmrob, lmrob.fit, lmrob.fit.MM, lmrob..M..fit, lmrob..D..fit, lmrob.S, lmrob.lar, lmrob.M.S, lmrob.control, .lmrob.hat, # was lmrob.leverages() splitFrame, outlierStats, mc, # Mia Hubers's medcouple adjbox, adjboxStats, adjOutlyingness, fullRank, glmrob, nlrob, nlrob.control , glmrobMqle.control, glmrobBY.control, glmrobMT.control , BYlogreg ## R/BYlogreg.R FIXME: add to glmrob() and "deprecate" ## , glmrobMT ## R/MTestimador2.R , estimethod ## related to detMCD() and to be used in rrcov etc: , r6pack, doScale , rankMM, classPC, .signflip ) ## S3 methods for ``our own'' S3 generics: S3method(ltsReg, default) S3method(ltsReg, formula) S3method(adjbox, default) S3method(adjbox, formula) ## Register all the methods for S3 generics elsewhere ## in case namespace is loaded but not currently attached. S3method(anova, lmrob) S3method(anova, glmrob) S3method(alias, lmrob) S3method(case.names, lmrob) S3method(confint, lmrob) S3method(confint, nlrob) S3method(dummy.coef, lmrob) S3method(estimethod, nlrob) S3method(family, lmrob) S3method(hatvalues, lmrob) S3method(kappa, lmrob) S3method(labels, lmrob) S3method(model.matrix, lmrob) S3method(nobs, lmrob) S3method(nobs, lmrob.S, nobs.lmrob)# use the same as "lmrob" S3method(nobs, mcd) S3method(residuals, lmrob) S3method(variable.names, lmrob) S3method(weights, glmrob) S3method(weights, lmrob) S3method(weights, lmrob.S, weights.lmrob)# use the same as "lmrob" S3method(weights, nlrob, weights.lmrob)# use the same as "lmrob" S3method(formula, nlrob) S3method(fitted, nlrob) S3method(plot, lts) S3method(plot, mcd) S3method(plot, lmrob) S3method(predict, lmrob) S3method(predict, glmrob) S3method(predict, nlrob) S3method(print, glmrob) S3method(print, lts) S3method(print, mcd) S3method(print, nlrob) S3method(print, lmrob) S3method(print, lmrob.S) S3method(print, summary.glmrob) S3method(print, summary.lmrob) S3method(print, summary.nlrob) S3method(print, summary.lts) S3method(qr, lmrob) ## lmrob uses residuals.default S3method(residuals, nlrob) S3method(residuals, glmrob) S3method(summary, glmrob) S3method(summary, lmrob) S3method(summary, lts) S3method(summary, mcd) S3method(summary, nlrob) S3method(sigma, lmrob) S3method(sigma, nlrob) S3method(vcov, glmrob) S3method(vcov, lmrob) S3method(vcov, nlrob) S3method(print, summary.mcd) ## S4 Generics {only those defined in this package}: export( chgDefaults ) exportClasses( "functionX", # function(x, ): VECTORIZED in 'x' "functionXal", # a functional: function of tuning par.s only "psi_func" # containing rho(), psi(), psi'(), ... ) exportMethods( chgDefaults, plot ) robustbase/demo/0000755000176200001440000000000013465050072013351 5ustar liggesusersrobustbase/demo/determinMCD.R0000644000176200001440000001072112432407066015632 0ustar liggesuserslibrary(robustbase) source(system.file("xtraR/test_MCD.R", package = "robustbase"))#-> doMCDdata() ##' This version of domcd() runs *both* "Fast" and "deterministic" MCD ##' @title covMcd() "workhorse" function -- *passed* to and from doMCDdata() ##' @param x data set: n x p numeric matrix ##' @param xname "promise" which will be substituted() and printed ##' @param nrep number of repetition: only sensible for *timing* ##' @param time ##' @param short ##' @param full ##' @param lname optional: ##' @param seed optional: ##' @param trace optional: domcd.2 <- function(x, xname, nrep=1, do.exact = NULL, # <- smart default, globally customizable time = get("time", parent.frame()), # compromise short = get("short", parent.frame()), # compromise full = get("full", parent.frame()), # compromise lname=20, seed=123, trace=FALSE) { if(short && full) stop("you should not set both 'full' and 'short' to TRUE") force(xname)# => evaluate when it is a data(<>, ..) call n <- dim(x)[1] p <- dim(x)[2] metha <- "FastMCD" methb <- "detMCD" if(is.null(do.exact)) { nLarge <- if(exists("nLarge", mode="numeric")) get("nLarge", mode="numeric") else 5000 do.exact <- choose(n, p+1L) < nLarge } set.seed(seed); mcda <- covMcd(x, trace=trace) set.seed(seed); mcdb <- covMcd(x, nsamp="deterministic", trace=trace) if(do.exact) { methX <- "exactMCD" set.seed(seed); mcdX <- covMcd(x, nsamp="exact", trace=trace) } mkRes <- function(mcd) sprintf("%3d %3d %3d %12.6f\n", n,p, mcd$quan, mcd$crit) xresa <- mkRes(mcda) xresb <- mkRes(mcdb) if(do.exact) xresX <- mkRes(mcdX) if(time) { tim1 <- function(meth) sprintf("%10.3f\n", system.time(repMCD(x, nrep, meth))[1]/nrep) xresa <- paste(xresa, tim1(metha)) xresb <- paste(xresb, tim1(methb)) if(do.exact) xresX <- paste(xresX, tim1(methX)) } if(full) { header <- get("header", parent.frame()) header(time) } ## lname: must fit to header(): x.meth <- paste(xname, format(c(metha, methb, if(do.exact) methX))) cat(sprintf("%*s", lname, x.meth[1]), xresa) cat(sprintf("%*s", lname, x.meth[2]), xresb) if(do.exact) cat(sprintf("%*s", lname, x.meth[3]), xresX) cat("Best subsamples: \n") cat(sprintf(" %10s: ", metha)); print(mcda$best) if(identical(mcdb$best, mcda$best)) cat(sprintf(" %s is the same as %s\n", methb, metha)) else { cat(sprintf(" %10s: ", methb)); print(mcdb$best) cat(sprintf(" Difference %s - %s:", methb, metha)) print(setdiff(mcdb$best, mcda$best)) } if(do.exact) { if(identical(mcda$best, mcdX$best)) cat(sprintf(" %s is the same as %s\n", methX, metha)) else if(identical(mcdb$best, mcdX$best)) cat(sprintf(" %s is the same as %s\n", methX, methb)) else { cat(sprintf(" %10s: ", methX)); print(mcdX$best) } } if(!short) { cat("Details about", metha,": ") ibad <- which(mcda$wt==0) names(ibad) <- NULL nbad <- length(ibad) cat("Outliers: ",nbad,"\n") if(nbad > 0) print(ibad) if(full){ cat("-------------\n") print(mcda) } cat("--------------------------------------------------------\n") } } doMCDdata(domcd = domcd.2) warnings() ## in one example n < 2 * p .. ###' Test the exact fit property of CovMcd -------------------------------- ##' generate "exact fit" data d.exact <- function(seed=seed, p=2) { stopifnot(p >= 1) set.seed(seed) n1 <- 45 x1 <- matrix(rnorm(p*n1), nrow=n1, ncol=p) x1[,p] <- x1[,p] + 3 n2 <- 55 m2 <- 3 x <- rbind(x1, cbind(matrix(rnorm((p-1)*n2), n2, p-1), rep(m2,n2))) colnames(x) <- paste0("X", 1:p) x } plot(d.exact(18, p=2)) pairs(d.exact(1234, p=3), gap=0.1) for(p in c(2,4)) for(sid in c(2, 4, 18, 1234)) { cat("\nseed = ",sid,"; p = ",p,":\n") d.x <- d.exact(sid, p=p) d2 <- covMcd(d.x) ## Gave error {for p=2, seeds 2, 4, 18 also on 64-bit}: ## At line 729 of file rffastmcd.f ## Fortran runtime error: Index '6' of dimension 1 of array 'z' above upper bound of 4 print(d2) if(FALSE) ## FIXME fails when calling eigen() in "r6pack()" d2. <- covMcd(d.x, nsamp = "deterministic", scalefn = Qn) stopifnot(d2$singularity$kind == "on.hyperplane") } ## TODO: also get examples of other singularity$kind's robustbase/demo/00Index0000644000176200001440000000012312423467231014501 0ustar liggesusersdeterminMCD Compute (and compare) the deterministic MCD for "standard datasets" robustbase/data/0000755000176200001440000000000013465050071013335 5ustar liggesusersrobustbase/data/radarImage.rda0000644000176200001440000004025311754203337016071 0ustar liggesusers xWu$i xc[dْeki3kYd2*$@)J 冡a,Z|aPX!P S(4ko{@?&qyy~ka7V޲휖sN:G{=ԣ9%LL׌ devO8Ｌ3X\Ÿ5frumh:빮纁뷚jk;>ϫ:=Qϫ:IWy>=D=+D=3{wbj=k:A=Vp]g#v1wb;EyeiWzurO><Ϲ-/6w,EƎ|NṄc|_;}ϣϕ7=\/~wqse':nη12gk^y<{ǹ+ϟx>XL}ޱ39%Oci=N/VY/^Eo]~ ,Z?4gpHZ~+h,Ҹ,Z?4g"ba k?>~+o~,VX9ֺcw?}=Q.}O<ŏpgv n^v'OPOpO^ ktsŸ,ѿ۶;g۽}>~ڎpW|8/ ?Σ?kSe>՝~+v/Gn#{*k}T{4]/?}W۵}/{]jokռVE.yo:sZ^v4]}KUzlACk_'?f< [Xe9Mr.Kw ^z#~~}]zؿw\ڼJ e>W=HwZx\{U-L=Knμgŧ[Fu鵌Z4Ƽ~gsoH~ ʥ_Ml}knzS"ԛ>$yF' h>sPzk̿SAsߪui׵Eܣv(胫%g$;D|`֪uWicM|M:5;sZVQLV[)>|2LOo;&,>Zү?ۋ^/_)>ƷqK_kи,h9no^i[?0Fz# }:Y5N:g#_M?oWnU#zX>uI Z%zFWܻYϤM{Ї-VMgeٱB䶓qűBVNJJբO{-N+d 9xmXvΆkKt`"Х zw&<'d_m:__~GdZ׆Լ y;_k&Uctߡ`g7ľ/;2 zAl 3(:&Jic9TH {:dl{ UV~fy8z>+ǒV>m@6-zUqT*&e_mCc//|Tv_Մ;yގڴ@x٥:Чq _O#裪IOuםݖNYӺ͛4Yh;r37B뜵sk>iأ&=zCleg_'ycs~?>qH DmpSp#o$}2etK?٤)KET}I8E8u{IDvS t2α7oc7Zi-%p%$?A^oÞ/z3u=}Xz9a&oaOᷚ_p?/?Zểz~|@#?҈Fnl}t_hE& _71Ǚ3I/ID6XD^A^hceOjOm\ U,_O`/uv:%sM9=d{0Ì^{ۄ}pmZo,5mN;<iƿA/g_Ηl_S؝tֱgG$6o{7~/n$5GSO7|\uFI3ⷋσ׀=e'A;yY8H;}[o-_ h6IeثȻ^~w)pz(4| G5 c4W~~@W}HtE_<ώOGK/5o>3_8=U7U^Lo/T8ȣ͌{\1]=7)B|'fPfnc/6jC=j`o2~s -}?BnGGkd 8 8ZZ:Սz?Sğb7!xGE q?3acL I#S4 }_%> :$r_{/t7@S`>/FFdk7h_yHm+z!UޯF/Z5|zEOn0xauFO6ފcI+/ZG}_p+g깹CQ%!xV%T١aU0~ v>>8xy b(~H:=Ynb|M ?OUW~X~NL zWtqǧ^OqG^zv-t"cCm|u#EjA?86pA//\Q& ɭKCl Csw}o[pK'y= rt~nǺGwj}|6%qqo:q0$r|m<-}eر@?H- qv(n<.M}ApI5#aBu-?/u%q-8Yx{By ?H﫮w >x5#9QIbc=Mۻ_eӷw9^4v]NwbwgbŁm6=˞b'q]:[qNޭ;|?mEp8e[>cw&9kГ.ޢO\z 'q|iTv>a7|{=%=6R?Xa1o"^MWIBOʉtwয়&]B3ol/%b<ߓ^"?aeo׉LC+Zř;u] }.Az>>/Tce/Ƿ xu:ċ}~AM~~d!.:4>?\O ?}ee?uj/ge 2fA2?/>ۯ|؇OQsK#lͣ}Ս _6H ["ݒ+N#gqp4 뵮K_~G{eGl`OD75s쥍 =; 7w`/C=JTBϼ;H%oNjvWZӬWՃ\bGɧb'&|v:ڣo^Bz>zqm ~WnR5nG`❶<{!J/6=!{֍7S҇|J[@c/[[ÌW8uQ.(+gUOcGnܻ[b-w[9 Ğ cIz?qȨ?)K|=ҧ%<: ߆ߋh/[-t1Rғǭ]텞>>Ix_"^W("=*etK$|`'3{5]eqt1N(=mz*{?D=ap]S y~oAAnv/`apA}Fan'^ׇ8\zi|WrcSqb?THO{^g"Il҅rR?~Υ6-a>!4:re/KdB~=҃Y&Y$~Gу$YĹcʛj|avmc&.(*}=S^ys>naÏC-p6'\f1ggf&.s "Mtj':akI/υɧ v*ͶAv:Wzև$wP@BKce?A>!nlm!yN/ (\v+˿^1N_xkXuCLw>8Fu趃8 œmiր)_ڰ Cm^ O9aŌB4KH0ocݤ v6xCߧ\lBy?D́ߪV}@rۀEoXuG/1+6_ gʻ5wi^'U_OS?x.At1#_;GvW߭xj>:5諐?]a>ĩ"~mɳF~kGcz_NA!?G_M+C~k ,o$mCq8rk,?|qod6k|߅8rCR[6'b;7^+O3!X'H!uJW,]H}ܘO>Nr$e# Px_#}U~_gsgKg`/|K~gIpFwg)~ n *ĕgڷp_>mgQ ij2y>!ܷ<94S3Zq;[Lc'TW pC񂀻CJa72 Lf嗍zKE_CK/&ݬ(wB=| w1{vsPu9l%[>nw~ѺTR7Bf#?ǎn}-ac#uAW/U^A<67z~Ϧ6J\bGSOOѿ@<bǯ@ϡ6`bIYcN*WF4zi} ?x@&Q|#? "K>~i:IaMssw3_;h={ĵ=_?PW@z.QO/ElD.+Y>:m:Njk U=]IeK[Bg>m/vx0z-?6;ǎ#y qba&= 6sCfކ~no qIu{֋l.z'ףWs]&D/Ğ%ƻ_O/$?= ~LK{/S⍙CV:]1O/ .c_`9EiF=FC[_&޸;u.M4o"-ؑ#yn'iO,8[O˔aRz5>+K])K ^$~gr=KX7t^>Y]2u !i s™7r. A;GjrEB#A|l; vQwUD^Kl"R7_zc}"_+}W8"Gvh+9w䫚4 |XD٧J?/˿kx~j.I8 EҺt]@ќ3鱔~NaG1Q~cY̗:ڰ܃>CyԃSea$fG7^~/=]Եx3Ԩ9 u׭Uj[W[v_<^:FV*+~B?X%b\>*=Lg{Ruь; 6"=`w[~!cvyu`]Nk /S>Nߣk'k~3~7ocص}蛰ϻA׃>-N ~p ;z^2!7ߟ6FcBڡJ[_,\쇄3Pc_:rr{눜ȏR?ξs)x=/#hlS}Oz|pŭg >~T6-I㑛EY=佮'VJr/j>]e¹jA6w!,z-|Mp ɱ?ą+{_c3F]k4rsQ>&|jeq/wQ\xqzMk}.~@쳓'M@Cey}Kp~e.q]YuLE v nɥŰἴ@y-x0v^CҳxB&8:>!y 6^pwPF]f4ziqFoCϰڑ|#> FoPt7ןj%ҧvi,ІFQ]艐'܋^n:Pתшƛ>^ ~D4˨{5p6SP2>Ƣ1B~Yzo=䓜?Aᰏ'/x(??z=yip~ ,QO?L?48ǃ 8C8tt]u0~LU.-;dj߄-SQ*=*ɫw+%d3;-n_qmo6=ac  Ky=x H]^⟁¾&Q%]B8F.DĽsEv>W/W}]۬u./e*\V^:ط!?˾[dA.P([_ؿj]!E DVg຾sI9N{~Jn<ÝdOݾ;0 }Q'+y?fs86{bЇ},3=PuDriAgjCP//8:_#uq`ȿ|L;:ҢyxH3U&I/S;u@o'>YϬ!a8ۓGLK{? /Q EyRPK˜WBp>@ka>\z 8ˉWsKz_ov/Jkg}>J9+Fݍ87y;>xZP|!/K+t'_؉pI).u,S_/ YoXrZ>@ F߂,?gSaߌ`|o0OragG}JF[>:u5~ uU`6>>PFkw^zs A쪳y 3עO:Qs.KX!\׾ >bU!~Ӎy-\/V?OCǃĻ_}+yC؃Y+;,}/G#I~O؃-^xMrjZvhuY {<y9is.W߼\xȇy94 {Ͽ/־BǟF%s\!q+_,`+йeğɟ:Ub =usŅo2Ǵ+- }8r@|}%8e>\ڪ]{y~9増n:Z bd>=uݡ)?ETm ?Ġc| *Kv}o‘)~N6.6=?ON'h>R~W?%C?sAY?J}%Wb߄#ga̪Q|҅|v//(N㊷eX+zͰọ:&Ϝc1ݵZ+m'86=/ q5ut~5އ^P()u&=i ;=;#`q둛&n5mŲ׶-Y(~i]=y Z]tq3{TuS&p߆oPw8bpTUIXNܦyzGTzqC-'~?5b _E[vˠ[ YL!ʾR)Z;}@I3B?ԙVO>g 'cw?e믦1ܽTx7*2Y!Βd^㌞[MozN,8;CM9VqE؇Y~ډ> [GYIZYO y| m^僣(/(d%ԣSSٖ#d &r3-չ^Wf*.e¾𻗓_zW {5qoݖUb7I{%s ݵп{xx~F7S}Z?TEw-yfJpdùM~:pMu4{kxg n PNz;$9d߶;_X| s:mwXx^ 9▜g)Ι9'lu&,J>uHnM>x% M fJ0=?O~:f-~zw7YMiS>trNxa_:/kcNC| ^BtZf[ ywѾa/G7ha^|swAl^\coU?_8( KWOsj^CULݗ)yͪs.U_d+rB_sqaײ!nLw.?`瑧ݲ_E8g_ʠѳa_Jp`5~;[tRi clBt 0jgP/^?~ODzR࿾< )@:^_S 8੫QɋwG#ԅ9 YPgUG< d |]F^#F 1s~|/*$?\CEoLG7-)oiwr{#q(*ؽBE( ukM$}p~9~εl Ipx">GPmK$^wumV!%.8.rs|w38s(3%0.z:˲!yIޢ ?{.*eį GM6gM|9+ރ!:F=zޗ}`QóeO|8> *#^vUio9$_-q֨mg\0}=NemޗN("UWg^B嚵NˉÏӿ閝)cv`ĺ'WN9@ ?g$*iss9)"9ح7ׁC'u߶ or&=<z$/G`G.Y&[;wx@ EM,}~ʯ&* ? ql>٠yGsCuOعj+?݆%7C^M‰sgʏU79zJ m_=ϛWi|nu,GϬDcn=b Wc+N<[uɡ =u==r+jK+ H?pq<4I#KA͊ x/t+!|ܓ/|lZj]׆`}b;8 h3u$i,{Sy~Ces:! ރGؽR?:k<7Ox?V;g/g:5Z䡒̫F<@~yNC承Үku^ܷxOjݫfƟ$.2L6[IR|C']!g_hR= 9EG7f bwύ>+C--|\X~nZT 7L=D#r^@o~ƱQ#;9[ q$j| 6ZE.@2TLrL|慊'xҟZ՝Ƚ+^]oc%ĝ~Ok!Ợ/(oMؗbd_^L!Ⱥ$r=q5Fɲ?`A$#?⇦vϺX} G}<^B3γTYBmٷזz$fWb֯L[9μo"OyHio.\aM؟pp=oϧZ+WR%{ANE/&>=" sO㉉|8Yu\שЇ=Fmu+w_o8| ^?^E ބsy9"7g}rhOCCץ ō}ٍ*.!@__9` c{=7׬Jy:B\pNOjX=)?ʪ/Q?m1u™LԀcs/{z.^+^ ľ~xߴ?yXj1&yOcv'/[T),=!m˨x V1$8 u7qxx$}R-b+U=mBARu/~Jg _D>BɫzVG~Ht?:6N?Q|/$L V:ԣuzG3% |-})gߒmO==qhKx;uwog&&|xNlϖ飿?z¿robustbase/data/cloud.rda0000644000176200001440000000037311754203337015142 0ustar liggesusers r0b```b`@& `d`aҬ9) `E @ b3A@ ف *り3C@t0 , 8`c 6@*oCiS<yv>s| j5TʷZ d= H-JN+ILO8- ?33DaRKҊf),/׃ |&Ha rrobustbase/data/education.rda0000644000176200001440000000160011754203337016001 0ustar liggesusersYlLQϽmZK[S[EŨۡSHLi-F;!$ OHy!O"BHx ^k$ ;_y<|}=k*pRV_a͏ AѦ6<$R3!@>{S`X tW9P@0 FPY0 a4L4B=ZqL0}hU`&0 {Tz‚SZ;Fd*VIT#:7*/((QUTJFˤr]pIEڍBnJ*HjQtqD#Q_Trs VJHT'<(AݠjQ_#JC2oHa7Z+K%W/E_}C‰HnltBIs1Am?a%$0~!aRZUC hn݁/pE/8N5AL}{fw? 9i3;}Dl=nð2b ؏41XLx71hc"If2OfP2X9![0!ه K_rGq#g>>ww{ȱ޳Bn8or{YZU5XU@w%Ϛ Ns_,5=ʠB0̹xFVZO|8Zc)6Z?-9 J6C{^0k[U? tްW>gC} _)<𤷿9Ԡ7=f-Kȶk)n2ĢD[PP"Ldw ))7w0Y'+w>O<gܫ7wrobustbase/data/milk.rda0000644000176200001440000000315211754203337014766 0ustar liggesusersX}hUe?M\%?VZ2hݏ5{bVBMǕ * EPHH keG0XP$H(P'C`~}Ds}~9.qzCo7#U=7JoN%'xbh0޵[sr8}dCaGF_Nw9aNr` m?0u俯qj1~Ma<0w͌N4v>_[u]]~fWʭ/;]/\tT6_B̺D~zu~kͦWگ%w^<9?uJqsmu^\+uk>w-gu)6|~Ly.UJčXYB\ bȐ~mǔX'S?Sd\7G⚑qe<+v֣tux]Љ .oΥDQ`-ɧ䞂'WO|wO=z/W;Qx'o彰僒<]q1:/Q{1Ox{Pss<8;S_WPm_uMm?Uԏz 6}++O!oev+:Ճ ~9^%#S/ q7~OVA2^ \s' ?2 ks`~/lsK6=ess&wY/﫴5-,0\XBW ?4 "? ?G;l|@yeC5&>ļɲN+a` pC|i%9e7Ƥ@ >~}6h2j0>LΚ 0xc_Y>eR6Z. yS$sOX|ţŐ|vo7[`0KܵƆUi<= O򔓧.@ ظos_S҇riÖ,5͘ԡD\N1yrobustbase/data/epilepsy.rda0000644000176200001440000000220411754203337015661 0ustar liggesusersŖoU8qĉS5$i@!MR) ;BX!$rS'i!*_ )@x !Xe#|sgή1`㙄BfZ݋V1A <(u4x< z`\/Wkux|>7' | ng - v@\ρ+y` ok1>kp |~VI \KG t;Fe!s8qˌ NZ2%c}xϪ9eLYyb-9m̿{wVdžzk6=Cr=yUkJfx9k^OZ1G̰e37aa{)<N2s]sMs,RGk+rbϦ,p]jgs5 RWMv }/294dz Vo=I cWfp>hN[W[ Otjp:;/VWvsk#fxFi6JSKC7xH[(cQGSÒ~O&=t ;=mD-OCesɖe&s¼wC>}U؇<-۠^kD\7`CڜX}~_-À5-Q'3/U$,J_?A"] #5t2 H'_./drՒlyqq~&ӈt;:}5PF= QxFu*Zh>'F;Y~h,_?`=^} `b bUxNjxI(|E?/`䂴:64C=CR.} ޣduIܑ8O?N༄߷'O;gIУxKGe%t.ٞq́XܼԦǘaibywZ=`:9N+􅵽_\ϕM#c7'!o랋,V5 C[kZR /;uMcVjY|܊?w&NbC*b'yZs|ewۿDBE\GڱܘؠٕOAѐl\3|^ {[m߾ȵkVF ټ0`h2 1"r v/.0EL塌&ABGaJMb])%J8> robustbase/data/vaso.rda0000644000176200001440000000063011754203337015000 0ustar liggesusers}S=L@B4U'` FaA@MpqqvEggf\u6$.hbDD{.՗ܽZN/i1f2sJ!)Z fRrЌ3.ϼ*:%oy~u?.;(9#y" \o!5C|'PG0 AyZZ]G׋;ŋ;;+,МߣHD?AR⥈?p}{ͅ>A0]sjsj'qO߁=jGFW'l3ҾÀ3Gt_6ϔ0Bn/'r*$Z|T8HP5y$x m2"TD$6Rrobustbase/data/CrohnD.rda0000644000176200001440000000324111045055460015201 0ustar liggesusers[PUc匾4ZBR:c1hKek&+"*^RǮ㳥iNLC/v!gz2{=g]4z?~sTɘ!p gC8]8!tC EBF`fn˄( '(?BT6` Z6M4xς( j"P !@s@9<(D,x AB,FL0ƂqB,M ~p )ĉ;=Okځv/@Ww'݉zw]+U^M.tAK`ZH!$xΩ'CĵZʾr웱Fc1){ﰭ%n64\uLaߴ6i )\35H0F{. =N l9 Ị{J=wn۰ /鿔nP#-!5ꑲ?~xS2lmDދ >!#ނgC_ ;6ﲎ*@'h~ VuϐYJBi+ Cڟw -f|ٺ 2ww:(=m2,=t^&9zG* ޠѿ?C d.:D{/8>T@{/M:n}H)|`n'դsYwknæw3 Z>y{75zYWǹˮU'Iץ_cgyaԓ-:޼z?syu/csӷ9(1{FsW{^ l*{*; Os2G ڸl߃\nvוvSak4>qe۩xմJ6m{!Uo[hg'n;Jv[ożfc͌gwuϠpw\[kBo^uVM$hVEBhUsC+s9ZFY2|{Cqt8JH$=}?\r.oB}\DžG9oeH\DLXٹz`4$p9H{qY+Am)6_-Dc7$O)bx" "Qkci+ b2!3vBз9UlA un&^@;4;ު%p?KeXTpQ/ [)*EE6}xp3ýx+l7sEU)s(gPԪ+U7續ga 2G՟ 壒vK㣬d(SJg{Z6) G=ᄏNq+͙dvd~;п߁KJ\m OۑĞK\[d{c{]vZc]*| T}T}ҘnH'ΙEF>^P#WlY-^TQZUòF)tbFe]%96'DoX1Dεs- hstjM*:9qoayrobustbase/data/wood.rda0000644000176200001440000000150211754203337014777 0ustar liggesusers]TkHTAf%eb&Y=)-3:,LH1+WMDLm4HJʬ$zE'QjZaoz>{5QwJ͌so̜;ܻ.")%E@VGTdq(//C'L+0w|E^D{F1i?RLTwg)}rO^kZivW?S>q(*WX:RC+W\ם\D@}aJ tvNMמq³;|b4lH\qkI c7J vc-+-d;/-xwWoH=ݑt:um‘lO4p> mjj=44Ožmz&*r^oFoGө;?fœkH z?|]Lgj0T(s|B&_9'nX!;%a-,j) rg6r%!Inik PxJ _|G}`$Qz}/gFV㢫7m/XB*%R,O0C]>0{3" .Vio8_{6DZ; a>I`F[y_jnˢ z)jب bο0z:$\!UPAnd&UWeQAnBC/+~ie6ُ}#r[~Ç*h+(## KP0SCRx}&hLe< ,CCCV~robustbase/data/condroz.rda0000644000176200001440000000247311754203337015515 0ustar liggesusers[h\eǏIDEQ "QYD,6{=9B %Xo (RE">R!E#(z $s ߙo$k`x07ד}\b^6Zan9ofWe'+^>!h`RB^אWmcg -i8m6:L=Gp yC 6t롏nExZ Ŕ8Һ]i-+y{iaaOb`GGk2>5"ZoX^Zw ^\k4w9/Jμ%xV=>qkznc! zH>N 0;üiY+]'?+4WMz>6|?˞*3I%U0ۻO%|MпBOeߋJ=Dn<x>q>sm8)H֐׾|`/F@nᯅ]K"{'d5>}xym?ӯes;}9M_!5]y8=WOf]'}}u9< k["o yRbuy9o-Xw/^l7)3zzi|:slJ^ќr?]7zG5^!~E߀O=pOE_ù٤n'ü?W_<5:+[Deh9ۜ mK`/RH=֩,_fqD踌ǽԕ{0OC{GyD /ʼ}O<~Gp:/%/H/K1;lP1&(-Ĭ@,\Hj8|6$3bRPyz]L@Y!@:^@:/T @(u[XHkTCc`N:u0pzAP?qA"n$qP3&|E˶`u.S:m(m|B[@PZo18CPڱ u0|^`5CW؋y` :$1/9gF}Hfn*I90`\)%ziE9`b ?R@robustbase/data/hbk.rda0000644000176200001440000000134311754203337014576 0ustar liggesusersukQ7D'OERUS<E9r "q7 dgߛy3ߙypwv$IBxԒF.d٣R^{a,GXYXOauRv軲"U9⵪FH+?\~JfS>cͿȾ#?VC7}?%qk5& I|CI -#?R7[݉ا~š;6jyǿzWæ曗}eߓ)7$oInKG+]hKRIs:S~Ȯ]\~qx|~4aTz/MuIs@/Ippr=8|:fGg&CB"Eg&[pV9+$K!R/nK9RFLa]i9KiϾ-_a$^O8v«0 wB a o.N(Ć785V =#;ͧ4sgP7k"-mٵ[Μ%.FO{s}Lo7Ξ ~m6 `_'q[shB.̮{7p.ynn?o ЇO1 !.xY{X|rol:Vrobustbase/data/airmay.rda0000644000176200001440000000061111754203337015311 0ustar liggesusers]JQόf:bHfI?v2BE$ue` Ah]tu=C#2Y{>{3sYRT>~CUp;mI)ߌX`r8GzBBO@4 mh\"Iك*͎d?5|Oߊ9+7S_ky꺜g1O_RCgm?V; jט{^5+3WZ`y^ ;7 /LŽPȜAZ {f@$<7ui_uDAT`d{{4oMҹw{:wYS~ ?Է}arobustbase/data/pilot.rda0000644000176200001440000000031711754203337015161 0ustar liggesusers]? AQq (FA$Y I L7ý͟( lQ޼ tzz9nǫ:#"JT%&db=_v"gH$, uQip;n84{袆 h"\tZueNqJn a_i֫ k0<#sH > dn!}2 .wOɿ}E} r'RWd<{ 8ב|I2 _s}-sҌqx.|a[Zlg^("t}q2 IbgT$kjc1>~z&gcK97N+-S/3?<:8w2n.#Ni?\ҝ@aΛx7Ҩῦ!<sOxiփS{J#!DD'Q !_zFe]h|8^:>㿇9Qcyԑϱ]@g'AQ*`l#-t¿8=QzP9Xz9V lW8/sє{p6Vꖭjgն ny=K;?9robustbase/data/telef.rda0000644000176200001440000000047711754203337015140 0ustar liggesusers r0b```b`@& `d`aҬ%9i `E @,F@l &@l f@l@l V@l 6@l v@l@N@ .@ n@@ | {h|=iO:8DV=*#uB["o@}Q?י 0u.ۂv`sP?g4N8CFsL fҬ!|KM-2 dLM,)pN)FוX JI,IK+(\f(_ Wrobustbase/data/SiegelsEx.R0000644000176200001440000000010210357044573015350 0ustar liggesusersSiegelsEx <- data.frame(x = c(-4:3, 12), y = c(rep(0,6), -5,5,1)) robustbase/data/possumDiv.rda0000644000176200001440000000333011754203337016021 0ustar liggesusersZKsG}豲cBr‡PvUN\#*qI2)n8;?ͬ4kIMh^)~랈ߤqI*Yfӛ˓GdMAQ)jĴ(VWRMFL뀍x%y7BF :b2sܰELxb+s6^¸ھv|;O@ݢuLtT}ct#Zs큁MvGkภ(ϖ1ܞη= fw/-"-żBd@죑$鿫kͱ _Lp؃`']o)c6J(\S,*MXMug ;s>bVeߩk{R5'enAiڗ261ޑB[X|3"xnK5grŘϵՓj g:b^?5ȇ|ѽHȋOzNcGJu/q&~s^{t]ySjGpy{Gmյ=wέWGRJJ 3K0-)7YAT7{듎I'쪮ХE0Ό.|F3 Cww@p&rdgW>DZ:2)cI5 fp7"T}0{sXK;iϱ!KB >6<>Ӿ3B2cq|\W:9";)<)~>CǾ UGuAew8G2'P`yi/7{x:쫎Cc#]bc|!3hjEG ZE[ )lwl{$;N}ꪽ Bl0|.]`-L('"gy[pB?2hTlg2z_Muvt1zFW1Wc76Zxg&E3y8|擁27' ִb#ǞȾ5+">V62`HkOo QZ_4gNy>_$soe)\/Oipv78;}~nPH@Uǿ/Gp '㏣t<?&7oBlvsy=c)eu$˕JH~OZׁ {]kXdX3徧 qM=ơ?usץUe||'g{gOs ^iIRnSwTz[.{Ƭn5{wokVф}!ܳUVNuRwZKjǽ[^R0}sŃ?|\[Ɔv4=SlbgNL6XdYgy`ۼj ,hQ=mcja0%{ϿSN8hh 4Ww>}q];e{ͳVnǝi ~TOm2v-Y"i|bewDgh#H'JT~MD[JT\$} ̙/*^HEo0T8W7m춨Cwp|jEXrT}*`k\U52,yF59U2PTTcsʗbIAm`,N!2>x]ʗWhh$kф5RX9qeB g9~tF1(İk>:<+<щ{ĵbI*Z_3WTRғTXyA'1G9hd aFeu8ؼ&3;%TE}HgXEGjZQXv.Tɀ N.ܫcL_e_5q6ZǩQrKӖޡެ_nsw`uTi0X?f~8W?8tX5e݈<^tй׳_yзjDQ& eZY:ejt'd?(<]ƊW- Ck8gQTtxJ@bgOV?J74hyFGa菙9 ͘ qԁX?]Ph߆:96xn]@|ݱMZ)nԓPž֠^UCg#;qϹuox~ @W&(b MmwsH.#:xx}Y1{r=_R6<~E{( H|}#PbW :Ex?}+on~~! x$+2X( ׂ}"O#QGrn< N Ox3\!UHP=.K;?DԟrJ)/ L_x)O(@) E7>Ox9Krʍ;y!95y'rVrCN> !n>|Lg|@9ҟdO qo_(Wt/W/S4~-U4@ y8uowu 57%WhW'ϤyP-Ro2 Srv͉:!uG;Sr~j[+99sO`??{ uAWv~ٿ;;;]7~`蹍WqѶ}m}]r#3robustbase/data/aircraft.rda0000644000176200001440000000106311754203337015624 0ustar liggesusers]S=hSQ晚:$h Ƙц3XRS>Rb5w 8 ݄(TAG x>;pιc+9b0`y0x! ]ZoⱇG'BRJkܾ#z'=AR>V^U~DAq͊?/Q2/oIp%٧q7U=C+ xסzQVէGDBKH@ 8#@0:Yd c @~ ?a`s=VƁkD,xtsnh~N,'?95'G97`6+]ƥ8o>pf}G_3K/M:0'-\~/E ԡxϯy}%ϩQKKYԳ(yήq&37$/ oE >2cDUЗso=t["OYW/Ͱq> csk;eNZ3M nej6ԍn@ܜ!ΰh|c-?@ robustbase/data/Animals2.tab0000644000176200001440000000267110353034413015474 0ustar liggesusers "body" "brain" "Mountain beaver" 1.35 8.1 "Cow" 465 423 "Grey wolf" 36.33 119.5 "Goat" 27.66 115 "Guinea pig" 1.04 5.5 "Dipliodocus" 11700 50 "Asian elephant" 2547 4603 "Donkey" 187.1 419 "Horse" 521 655 "Potar monkey" 10 115 "Cat" 3.3 25.6 "Giraffe" 529 680 "Gorilla" 207 406 "Human" 62 1320 "African elephant" 6654 5712 "Triceratops" 9400 70 "Rhesus monkey" 6.8 179 "Kangaroo" 35 56 "Golden hamster" 0.12 1 "Mouse" 0.023 0.4 "Rabbit" 2.5 12.1 "Sheep" 55.5 175 "Jaguar" 100 157 "Chimpanzee" 52.16 440 "Rat" 0.28 1.9 "Brachiosaurus" 87000 154.5 "Mole" 0.122 3 "Pig" 192 180 "Artic fox" 3.385 44.5 "Owl monkey" 0.48 15.5 "Roe deer" 14.83 98.2 "Verbet" 4.19 58 "Chinchilla" 0.425 6.4 "Ground squirrel" 0.101 4 "Artic ground squirrel" 0.92 5.7 "African giant pouched rat" 1 6.6 "Lesser short-tailed shrew" 0.005 0.14 "Star-nosed mole" 0.06 1 "Nine-banded armadillo" 3.5 10.8 "Tree hyrax" 2 12.3 "N.A. opossum" 1.7 6.3 "Big brown bat" 0.023 0.3 "European hedgehog" 0.785 3.5 "Galago" 0.2 5 "Genet" 1.41 17.5 "Grey seal" 85 325 "Rock hyrax-a" 0.75 12.3 "Water opossum" 3.5 3.9 "Yellow-bellied marmot" 4.05 17 "Little brown bat" 0.01 0.25 "Slow loris" 1.4 12.5 "Okapi" 250 490 "Baboon" 10.55 179.5 "Desert hedgehog" 0.55 2.4 "Giant armadillo" 60 81 "Rock hyrax-b" 3.6 21 "Raccoon" 4.288 39.2 "E. American mole" 0.075 1.2 "Musk shrew" 0.048 0.33 "Echidna" 3 25 "Brazilian tapir" 160 169 "Tenrec" 0.9 2.6 "Phalanger" 1.62 11.4 "Tree shrew" 0.104 2.5 "Red fox" 4.235 50.4 robustbase/data/cushny.R0000644000176200001440000000007210647075756015010 0ustar liggesuserscushny <- c(0, 0.8, 1, 1.2, 1.3, 1.3, 1.4, 1.8, 2.4, 4.6) robustbase/data/steamUse.rda0000644000176200001440000000135713212607767015633 0ustar liggesusersU=LSQ~寀bhAJ˟8F%& ,/jHpqa1&:h U'cb(qx;߭wϹy-ݘ17*3bFĦKaDRV3rghdwkv' ^p;MʽQ-><݋S~y%ޥ/67'ؗ{4d ~Y 쳾oH,(wEFP%Fs?r?p1:VQ ŀX@|*#m\4Ѵ'R}80590q`V=h`#D3(Ƀ-',5LNpe59'n`ZbrI~]y^bn*L9 ,y&'M)/Í䧧r!2G+%$Q/hEz0AA$Fw66Erobustbase/data/foodstamp.rda0000644000176200001440000000125112137052541016017 0ustar liggesusersA_뢫`(`&b(,L/ff x** &b 8~E$Mwu/cï}ԫ6O)MDđ~RJZl=kvD2 2,0mi~IryB|,myq6Η A,rw\8f5FzIKV')>Ҭ+ͬtI$4*,'Dir)I:;Qq6[K>Ecrrm(N𷱝y7"诂C__-@O{ejEƮWd|yEr{C`<[Ћ ϓk> bY2 %π{#~)֑z~^'9G>ZQؙSC֗3j+]ĭF3bj9ӣdbuԧ,k\@UufQR~C ,(軔+)T}r}_~1t#O"752c|>З Z5k=y/gF9~Rx~ yZ݁874Vݬ\ tyPFmg~3K {ɮ_1w robustbase/data/phosphor.rda0000644000176200001440000000044511754203337015676 0ustar liggesusers r0b```b`@& `d`a@\, ͙ 0 F;pA +A*P:քҪPysIy0t& _8XA>n MXAUb vb bY bU b#@匑sb vb[ 6b_ X(H,v'+k^bnj1!T`f^~Q:d&e& rJMII,JI,IK+Z(\f1wL @?lʶrobustbase/data/toxicity.rda0000644000176200001440000000324711754203337015713 0ustar liggesusersWWTeaW$Kt,' 6$Qcq=*(j.yJK$hyCLP4JKIE}C{~#A]ؐq:VgY_;_6:':ffNK@3ʼ"IxGu4ʷĪ>O X;$-v8f. ;&\S*+s`qaz+(VQN=.wp#p@U^>H}/S-7'uIh֊f' G;gcm ):iz8^w.8vN)~ǩ쑾&o+||?׉=ru2{:cD^G/λTċUij_TNWoAy70b<Hq790R#>p8w<8E,JV\G"nMaGc OAF "N7k—^`%&p8zc4aݛa߄~ s؏raxq@X>Yx3}ŏ4d,#|:ExC2$o@~+Q~R_cq%;Dhfs!݋xB pQSկ՛Dy2S$L(EOsS:~[R4(cRMJsJy{Tͽ$Tnfq=ybK%+SUmK6*wJuι6 bVC L^DU>~hrG[$-q= @y8`x<%qJFHMB|(م gNP(CHH!\O[s “þX&V;/םw}pjA? ę7D?H:8D~:4rl(INDLЙ266oӛg$sH|9%1#wm;q9}J.W?>V robustbase/data/salinity.rda0000644000176200001440000000074611754203337015674 0ustar liggesusers r0b```b`@& `d`aʼn9y% I b40pBPZ g,0p Pq:->M(_ uPӂC͓U|  է PZMց2yA" PX q>H3z`~ČbBy3,El|`9mwpt0sS/JCI }fy" _h:%By:%a$s9I/oWJL96(` u]\V^ gp9 44@쥏L@7M K?x$6G@QFKhG'.8J~bKM-2d0,c(1݌b0AĒD"h9`ւ4S Ɲrobustbase/data/exAM.tab0000644000176200001440000000016610353034413014655 0ustar liggesusers x y 1 3 2 2 4 4 3 5 6 4 7 7 5 7 8 6 5 8 7 4 8 8 5 9 9 6 11 10 8 13 11 8 15 12 14 6 robustbase/data/NOxEmissions.rda0000644000176200001440000044544210441333762016442 0ustar liggesusersw Vy3$2.EH(%M-i($"(ICEC) Jw>Oy}#s|]uce&###'#'/?(QT,V [:LFF/P_22:=FcyQ`EQbcTFaFaX fpca!0|0a4Faf ea 0: 3atf1HgQ 3a0Ìeq 3a&0!LdI c0 c0 #b1Ø19X0d0Sƒa1aaƚalƖAƞaf:`G0Ɖaf6ø0+a 0 0 0ƛa3Y0Ƈa3/1g a3Lì` 0A aV3L0Ä0H(ìa0Y0f=l` 0&a630f;`H0f7a 0&a390&a3ec($01Id$90'$Übd90) 0g&a2H:Üc d,f sar&a.2%0W"a25g0 san2Lb S0waJa.T0L%c*0 a2#y05 a23e:y0/%übzy0oa2;id aa>3iaVicv0 0] 0= az;` a~3L3`A,2 #0r #0 0J 0* 0j 0,a3 a 1 0Ð c>F0 Z 3a20f0 3af$3(0cƀa280Ɛa&2$1bc1aS1aƜa,f2La c0F00V c06 c0v c0 3af0#dY 0 3a\ƕa0蕂_&???-obfMѡѡ:4G$th!f#k]XwaYL'MBFCSt(Bbth!f!kFȚf!kFȚf!kȚ1f#kȚ f k&Ț f"kȚ)f"kȚ)f"k"dM5&BDȚY!k"dM51&FȚY#kbdM51f!kfcSǦȏM"?6E~l)cSǦcMyy"?6E~l)cSǦȏM"?6E~lXXXXXXXXXXXXttXX RF3Yش`K \Ҿ,ǭ= UOxH/I-S3cSlb 엘q6]7\_pKnexp^8UwBϵ}{h.o+O]o Spޮs+V*a胊Ǭ@̾fP Tn5,K`k?ʘ'Tug  /#;kc(:=Iʬo9j\k}Ծ$NwϢJCMMv`"#:kz:Ȑ׉X z5*ž{Uws"\ O:@ 6z9EOs(ǧj/,9*~W]MߨZxگu%nc@+.Mj9ߔ@C6 S }&9G H}9g6O򷻙t/Oqz DÃmԀouS,eUZ %9h\⚢UtalmHh*^xқU%@^r޺[T{kr?@fH)^~H `{#fҬnA|)Aad۳O~Į^g] 8s#定\|R |%g>fcǀQkV{Q[?䗽/qhy1ȟg7_^?) ܭ8x<~qa3^-+싃 `Ee%qvމݟ@v)3%.]:? ڋ[nUͮ@MҾӏ;l>ʕ; xX%Ck[2[i*qќrEflޠtڎi-)X4oZ*'vXW={NoYog+tT~ x e~J懍^Ze-V,Whr@\68gO0/BySzw%P;Gބ콷ۖe'^q/pSxݵmZ&SoP'kxPX*Ƚ kntJ2hR2-Ɓ{r-2ѻo/>+^ަ;?ݐgg[_WmdJ`}թQ눷 yv5wOZ6:惺9B1+*mv{} 3_DnbɖsLЃ~9gRS."\?YԪd?kn2rB?Ao+?㯬y.FѼ'>߫SV˃Jw-L{b=˫F'Y].NTSH\#` )Z-=to/\Οܯ^OYd/]'ܓ\fhi1mq g Z YlյYᱽNi[ơ|_483WJ,A^ѾqOK- J7vRn^XZ#FSNfU=\4Zx< vI^0 ^.K@-y(q ' u {FWsr!ȍQp }=V7 ߷`Y. ,_Op@*uz5WИFhX2~Sϳ8%AEJN&D98Yֲx5 ]T߱6w–Z+UwnoȭH SvJs;sQ`^͋| X|[m$( zC g}# xK 6I}ovFK:XU.BIyS|X/: 7@vٔz1@nab76Soۺ&y ϩN#kW;7lMŗOODݙǵnʑg6F%OwRQp ?qsL,Udͱ C~^+5Gѳ]&ɉYpT L<j R:,<à4n^x(g qU%W x"Uq.n/a1X 5I6ĆX3?zOnu ږ>^Cּ{+r{^OGfyo6{ BڦBޞ@r1,MϹwɊONS2q kcdTysoՀ){eb i46l2F]h4 >mU>qw~Uu<@8#iS p\8'K <u5痁 ՠɎ@$s(mm,i'?YH, [d3JZwݿӖzk}TvwʹV 3.YSKrA!PH ? q@|@o]GAc'ȃSkWv7jBCw m^ރ0;w\>.x{] Bw9KM:NT<ԊS<@1spa:ڿr.ےG-|XZyĤqO{{#q:@ aO ;0ǀ%:ɿ[kmٍ:K8ɒk5?儩 wxo;?~iwv@;Je׾k!o =:2[:4(wڎ0o'H[y3vN5 xSuXƒҮTv3mɻ@"Zdo!|ig5A+u5vV<dFY#@ftWb|`8M41l_3A=Eϒ7Si[iuG_(=054v_9t |  ^>=nVwá%'l_ )F3Vv5k0opqI]44w;N]4]WQ-W{z`TW s2~l@m<'=1ͣaof J H2(pj'>tbnIn<:~tj]LFLy95 jm z$oJe2\L]oOJo<+1,n”Rq;&yBD޹E$EI@8ӞIfŽIkegVsf0F Sw2p  UsVq)cc/qtYy4JuA9X뙾mzkH$>*[ϑ 4?o? گto٨#Uw5fBͳ-%])_$ygQ<4}e^hWw1ubϻ}eX`c(f]8_5Ve`Il7t܃ r08svMd4pdCh^kN'lԎɥۏ,鮲և_xc$}f$7/0Է tIWcThvvv5?/xsyj@۾haaMg^S9+U~eTРY[3xo\9E)JWW𶃆N^ |]n*Θ$ :Ϳ6i^#*G(g|{-iʀk;a >fݤiY}yb՟2drQ[a;M5m5=.F<-~F%z?kyE[=;Of=~k'գj1e㷠x>G? Ua R;{:v&Z m=JH+;+?+̏z\E:7zWGl_*Xo]rNn-zz;Z J7%>x_)ڵ\y@9RͭccKv_  _pwA/jFmlI( =\Uv#\o6;D6f_ dA+a#կoM' d@C4ʗskA:t[59p\ ">KN"|f TEh@Rv7~޻KP?.wݑS0_\$+oYA`D|s_ S@c0A0oԩ_@9<ҥEM|(k61mϜSTa{<˓sM3xj !gϙ#. sCɯ h]RpwXG׵k@5#j֥QNy7imޗgP5d : 蛝^`CnS7A ҡ|끨Y,7TlGߠL~1xԳy*|7{.!|M7nRVix{^1jܞ|yBnoI&PoR}XmO1T48 .c?}B*p~hA=W鏓6Á(J}^xUD}:9\ů#ֶNM p\O_^^ oo\^IΌI??{?eoP"Cy7/I: n|w<6"#]jvHC W;Jt\4[: 2r]JgX%xVyyJ+Lk7a x m+S?r-]_`[UC̈́)Y> L/W\ éZ=u Sx5Zg^3 xɷ9)>#m#oj v9gen {G yۜgeJƝAqÆQ?QwHb'I~ay޴K~zlZl$~ڨŒ^}/p6=E[<:6{|ɑqܦjL{ `o.vRQG{:mɴ}:Y|1 C緽;w唹 Q`UdF*~wַQ9m!g^67,^Xҕ/?ol.޳Qi@ r}f//O٘`1uMC/T>=׸u{|P7_i|@'ٵgO\Axu์o!mG`N|O&wҴ}woہWexi;:f^J'gǙp>fwu0.=ȈO|cƖD>BޭԀ +~; 2ڻ&vCwQqяj:;vuIP/mJҗtKW SK%3]DO:ogsM=9  S>D/iX;AR|ݔHϏN9cRX86G7j(ÑmsQ2{|6f }ypao{|,l ~fyxrs+Sy~̧wSUJ FTL<'U;Uok**?xi7%:\yZln퓜R<a_3e:gR4{;Pq }ttf~s|Ψ8`|LI JmK&N_SڞC?jGmM2×gtz\K1?=?iG~qD`R[??DЗ#~麖R# gE ۧwp= ;ª_3ɿFqחÝ:9 ްE6o2- 8?&7Wr{&i$jMB;$۞lA/(,| uY_@;S? S2|]MO9sq&t]o1XGfA(oXGgQ-b!X%nMZEtEL2vʃ/K{&Hϓ7kI#EߦSqSt;@xwzU??OucAshT]XH{昖,g.'%Y,.KW]j!,k 4Y; u@ٸ(z{iL ǞrɊcȼsYcSMA[ 'iyZq>Nijn4;w.1Ö;gkﱆ@Yp3:f|OEm Oz˿ni3&RN[9.kÎxҹ?~us^@Spj/Vٷҩq"G.tmҎhWw^:ُ?wҹ Pnwm~`St݁/ݸxؐl; ?MRR)Mh]P]ً~[t%SoxúJ}E\%4GrSPc)gXv'e18;["5 }J!='O&\(A[[T6D>Ub{5Wo+4CL۷'[TזNC1Y.QhG_p otan5 {>J[@A̿}I&gATF{Ո.q鼍0WF[J}[vM.kMÖsjsύ Kaֿ1mct7x9ΊέTGpWx'x {4nH'"Z/cl[ ?ʥ\>UݠocA:&q>Mܵ 8o}aBqV Ĺ B#shs/q#c%_[bQHIEQn*T XkRq4W^-!ب:z .Tٝ87P@Co %cXǹmŅh6*=7HWoJuY X'a`팀0EۅrWx%zcA*~7~(ׇRZ[< >Y lA5 ftR=7ڢx#2; Xx[:N)кOfh*~K{d5R3c >m1 v5Frilp8dqWIpp]ZxMӅրV]N݃ ,/%xO);޵_+ؤLoLT|Wu1eFѼ@-n=W}oƠj/ p.*Jiv׆? ]]T-H~gꥱv3nvh?$ݤGѣEaEuoLWm_p+e|ԁ=!< MAzZ@԰Ԟ )؋ckzj} 'ᆾGp>zW.xu8jUl6ݑoBc ՜j_NIjr*{NeaTH?Kڭ)pƭ/:AKN2x ;c6},;{#@y1j*=Lp4E@ϹqѣNoy$W@嬝diĎyKs f~W~%:l[/^|c בoL%Ip>*XY'Apwɤ9^tx7g  &^sCA"AxAY hT{kBG6֣eZ߱5n {:3їŜ*ۗ4+mOSNrņ};}g*Xp:{d4}:dg+&H guT%eD7/ݼTv _{B_h 9 ^>Ta]@~9SO|>=fZ? 3<1fg\~3i|;c<AU^CWwn]No);oOσbVnC\gx;j]|^` ]CtT$:s+<>#z}Z-i>`Gk׼I*A תNay;I0=O5}B秒zpyA?=O+5?EsޮfA巕{8ޚw7bqs/Sr ʟM>֏u7g^FWϼe\0*_1W떴_0r|h4@ZUX%m0z=m=Q,NZ3IL֌bNk*㤭t=pϿ0g{];DdL❧]+5%G{£*;,yǔ. O)^ )밊o?ԛ 8}$% -@>_=B#8n44 AqQiDzמĮ;טPû;WZTHjOQ4<S@ ?ZyA >{͑11 j qa;ʳm|Fecк/h]ncNFalP9ԥ0"T_2ߓd5sɸLۛiFFC{PI{յYYt^gTi1]*gHs(dY~6 ] {QΧ}bҼ~`|Q3wռ4ɬ1]+\X PoM:Zke 6Fr|˽ܓ` ꑗ|"A)Z xiJvβ<{^uE:{Oz-Z[v?#s8:Ϛϩhٿto# z_9wOQѷZ\jsN{/m={R@ZsgTo=VN&Vyt?Ϧ/#gx*/&Ҽ|rHT@dՕwI~7+?}RPp7YL=c>[W}nTWVU\xg_V7<Ǣ sG-oi֟HRk4΃>}72[ر`U1q8R:KKԳʲl$rIpZҝ s8>_#+|Tp deunoTگ"3Le-H޽ T)9 tNKJ wVqZն[zKdN1|E:oK$o+OKsƸW׾PW n3ݴG'*-IY%9Ď}Xҷm'ݲi8_YMixLj{T~TfAT*/^X\R>KU;;k})˥U)KMVu=,P/ww|^ z~)I_A^`k @5Yo9ܹ{zV4xw~2KMsmWqHN)~>b+r| L|NM3dԓ;!=zur`zkn潗&Q5{M֮t ;;CT\ |[R2)S4/'D.V^PxcO>ցTXZB3CRʟZՋ@mSi ]] dfv<D j7bL[Zթ[Ap?C|񈚽/wȗO7SqCl[ߕ{ wg{RyӒuYTy(zV;a5 $i"Gj%Z-4Sً~LCޑ3t%>ɧbYAx`ɽ rC&N_f?@t=Wz,_x#=[Bs3e&:J}d<1g!{Q4l 'Ƭ8y1t]۲H(+M6MCWbR};|{z.Grk7b-mb7VT<;b,QAĨ-@|rzZ ]i Br~?Z(^H8}J8 姽Kw~AO=}xVEW+;w\}2ns>r읯%Iо#_>jhN ̳̿hpˀ#=Nh嵭I ~ {GqJqT\:",] IҾs2s-EEH[3y}@VdVsB3}܇@_H:!]9GVz<ZFlAW=a/yeAWwB_%$3>>A_/|1g,c3+zD.\sFe3͚ub9qT52g #q890=qT^$`9X**i$t(Q(@KTFKi&B%E[(R! Iyqn_z|>x Y>2ӾK{B r_:emNlOr#`c07 JGP1q3 W,A_T@g_&C>`JFZ?ܖ\*{{nũs߃"56e~P](}ߙu^|Hc:Y9E11C}7YOa.=`oObzH7~9T|!tte+oGkX6n+{CsEf۰K@$ CW'݌1x׾?'MӱD-J&t ʬSZ xX車]C:CM3 祫tP51xӈ~现rV?X\J >DͱRǬiEقڛ=)p*q9W;"fǵ4}X]ZW9<^8.:V_ ,3,tꔓv/Mh J#s *w35Flc}9YEyȝN~hH}rͶo坥m̤[W"kJS]_EJM W$ȊyBaR'ɻmשwjZ5uL(^њjp12ffy;+hN}+/_(O ԯ>^QZ(Mo vz 1tq*PGzͬKU'.Оѝ7t4oz9tN}pe3l ̻NO gƷH3Ss:֋ۂɓCy=l<4ĪzHӲ&`0A'c\I{wLz$l-cP'GIu|_F$_PׇϷ8Q]&.mmD:[k>>Qu> k}~:OX?xC3FGrF>vNm|9*p(|:~tZ)'`}@ϻA)dHdp.?btՂxհ6A`iN0ע{lE`g/LkOygzn002|U ۸>:$%*{w5H= >IP'|`$gpaXң]oYQ=]˷~{~0^6xfsXBǏC&}==1٠jy1;/s|U%ZPA~eEbymXt {ꃑ9ַhά|c}oi>'_U)@5lݫk$"}X_\xalzqi//Vp*^cV=vO7Rd福Ź' ^O\ 8O4BW[6zPj0E һx""oL}S6^_* ޻']L}헏T4vS{}u[[uu HVPCP(00Sg*ͬ~UO) Z>O:GG|uq8n8Y2:v坾AzݦUc3߄<Ƒ7?_̡rףE\Lmϒ].ߤt"ue0Kuly'>>F~?= [roNM#ӗ?z#R } +ߓE8f}MSzN~A>~UVY5:E]p0 we}:+u=I碞d/@ETP=/x.;t ۥS?.ﭞϠj8f8 Q?y=eP @ߥ5;u 33<QZ:sB`MK /YYt>_͕G2kGî;W<d3ً' O.[i X(mh~oA lL_7QLI>[Zf~D6W_C0#5;OA-9YKZQRԣ AwXjt0~G>mD3zקfQ`|CFF?>.ι:|;B fx:*,ΪW=-ZF3o.i96鞘>x3^vDҍg϶ ˑGE_Q]g=Zl% TJWoxK<_G(Op˶gEj PEPc\kǩ y"9[^*̌8(W&P7B#acNܖxPmv; }FY6:OK&.緁NY{=1PjLW(u3v!]1wCc;T_ :kYT׊Ta Ho;==/~?T⋋5"7GO#4 77,kUuerH:IǛ|*UwyE*19#Sgn/qT?T/湼;gdn(t(my± 0`Hj y~*XLjAfso{3R=_xgukz`4sS߀pgHO\*g^yȵ}>-r˙o1 'm2}S' y ]fGyv7\4Qwj|+בf!ijAXQv2'phk`#l/Zܙ*_k*,$8{OrI*53t_yT28G_M~ 0S^GkKHZ[IGTN=VD{o' >cbN )Oi6K΃AŪWQ_6ppm$^@uwVƴpg-j9LNZ)F>XD)~&l]h9u& 0PG:ծT yꃉ}qu vsD!:>iX}.8"ڱ.p`RA LQwU*sE[6F%hl I.}e Ku~͊c~^asEZPh 7IbUW)X Wũj+b\lfazP+Hses6y Oye gTM^jDjanxy[7!XЏjghu%°>ȹ'e~׎H']z< 3z}L}^vsuGQV/Y~':!`u7Ƚ*F}7Y%֙{Tݰ^}}.J +IW; oXЕwA.8k]靺K`IzoGb֟jSf] ?MuE~ui'JHou {Cݴdf_# EiTl^q!rȯ;r8jIM}a=at@Ƽk l‡9U3A0>O^ʙS}c/IO}g߳'鑾/`WWQ*W/\3'˞\:[UI4V%M:gARl)~ r]ʹ%5S9kn=¹ntO؂{&H>=[In~It  ڦw\g}g/19{td%yYS%eNIO8jW"M?[{p͜ڬlfVa Tuuk*Sߍ{,pKݺ:oV%{269{4/o mVo(dpK+&}B|A#nm$>3S Fyjڒu[L |F׊'&q$b}Ͽ!)9Ww7+[B\ 1Q]U9N<7C0C-"do3+5F˾9ZsfdF`^eӞ^rUov3~}vm]ȍwM=iKU |Eɞˏ}V^_48Ǽ&h>*yo*HY=tB_(aCIGOیz ㇌ +v'f# 5=^sioA:C*Q:U&FW'8G~OOG<-Nro$^shރ'/f }{vm=?X>3#?O~%)_4#gT [fvʈ't5q1C%JBw^⁈sj?IgNWf#O.q+q tI&O؇sm6Ѱ͜8`mN?/ˑlV }loVtzW!x*T.Jlo&흺kwF+#vMن5V#w]tjTLjym_i$XޏN?|PmaPO=qXΠwdҜِ9w 8%~<ɧ9_mU {{#͹wg;ݽJU$;!B'<􉪴3|zi{*-Z^gᜄzBCf,qw:9|lwOl (6 v'iAü zŹstܶswu|j{haOz1OQo6?438 FZR#sD dwjڛ%y*kx趘X7" D=My\Sq~&?dl@>O']˧x|?M{WttojO O{,|I^9nNu;0|Fu҃W Ww|h7?\kWKsO\qPs6ֱLL?W;PQ_\:L:}*~"ʽMd57vg%Ω>;$>M{?uS^:aqrgdǝ eHu羜?;++スr!mFTU|?T⇉w]g $֓AkA7x Ƴwа \pp^K`>rQO{_܁ľW6vKȇRz?>e wW1HX2_p_hV=upZolA;~+:c뾤6%F X1lGoX0pL)-;SomgrpO~{&mzlj?,5 @s#GϫMy8F}4:5'cCXf%K,霓r['n3>B};M)\=VzLM>zfwp;Opy[OҞ3HYu.u)qtyb_sNKw8VCZΧ=]Z[k@3|'nQ)t,p:\^uwT1F&nدIy~Xc=N7^_v}nA}faKmJQ-ouʾLVy$~s_]f506e^)qiܴGxn9 LӮ]'$}3MG[Ϸ|N~uQ]4}Ey )GM~m^'ǩڃAvU[Mv8P@ω|z bwe_mYDodR=nz|鞣N//[rͣvrU`#=`{]ȫCdJhcfjX4>?\Q2.Mi)g~>9R )3r.äZع^( L*|iG@g"w}WGı CA98z88>WShXnjKzfSՃǤ%;vm)U9q=VIy2}b2 3GGCdC}ǹ'C_Lb}8 Ͼ25ȃ2s霤l1ՐKS} q=w.KVul.0SΒ/Kr\USsdrecX_[?XoyNsu\`܂x,'A]IyyԼÛ[jYlQ& ۼ.~['K}8'`:xXvYuMzftcv,y:]GWklA}o$>kZ=yŕa#9T߉-x~ ƌ[`u(,ó7(y3l!O9S7Xo+H|$ ?>E>Ig.>슴J #w}SA\矖n|E| I+s_q~3/}ÔDžJk;|o?bC oyڳf3;m14'ڛ`.:gŽn~Nc8`݊~x̫iWsϧ94֔y~}Aׂ͐N4Ds}}5 +M:4pBӉagz fǝm V&=vۑXa+}n'Gl~2Xpo243?V6j$3:.ZI%v}`/"99^_v0!_TLyUkwbt#u^kckFܓs!'cpӢbs_[=RqtΘ7}j )ieJcn.$}~>Ugn0S cX8`G(Y雮kJn^C&WNjrPImf0EW6~' O1x߹dcR`'%kSP;Í8BΥ[,)[GVϗmJmM#f\(Yc{sZ{.PTD#ܔxikVӞ5xO(kpNfLS_7<_4'=cLSdC(.p8(Ľ3D߆'Ė*c7ifkEą>\+rӜgXe׬Vf=i{zgImEc HEni.8zOO8ӥw>~.X8E (żI\؛jF4b=J^')3kա>Ψ/sƼ~~}ađ}Cm ]wjǵ8#ƤϓK]x¿h{:ꞏ-ȓa>nx8K'yJUT07hsw95hnI)t)6ӒM~g[OŎ@ȃ|/Z6/xs";/-s;C˸e)WvIϿ'u!3v6Tx?QbbDn%rY_Qեa;~ ԟoLNsԵXÄB:^﨧uy(j+夲G+ @Q0zoW5MƅW#Kc- wTGtN&-!kbAOJxOG:qHq5Hs&-߻ܫkAeۇ4զ= 9xu#,3E _mKSud,~ X |Q\u2!'}$< m+}=Gٓ?u5, ZͩB~>&݋LW8݁_YpOyzsSUcT\?fPL0a:(<"bR\%_`罙/(gLS<Σq!.ϰZe}騗B `۳ثl.59n*u籼E#[`(pHuq^:C'scf,!WIj1gϊR,/X3R)񍗗vgu$%4?qn{;z:7$$ KqQ3/<:Jԃu3֕=G-xE>k. u"w0ĕTnzn qrGm>u5?9}`_Cy"oC6PNJeaf0#7 &ޛ|^C]?FODwOy,rU G? [w)Yi:_9?UBY;P鴦 >?wFxל߳/,uQ(kyB>}XlА0aZ!m*aȟ2ܸ nL^ȇ[A)cFҼGhur[4e{^ÿt\wٷ-؊~Iq|scUS)k7.梛>NKGrl-宋<!_]OP/ސT7)cos7_:9޳k:Yy2#SuMxZL}_XF̋.}f$Q崠MP'PIƼ`Rz;jLr ![cS(C*oo.赁ێh>~բuۀ.u~w2H IhiGQAnHg(׎(@䓃+Wd䘶@}wº 9-A˟Q8G.:E5tЧy' 5qެuIbG }hE~ :x]<QDiH9 C/MIIa.=piaj|Nʌd }JZC?jX!斒 EItܼ֒wKU%Gh8pw|m(yd|/&`~rpϲOӯ#^oo4y糦[zFkem۲PΊzk7=f+mxio|fqTfP5(ftI5e|,ml9m_ѲTZ#@=KmҴI |Hkܻ!uorn"? gi9 x)I}M PX=y{з~pa`̻׋pQ3i/}6`V\NXFNr;i/4ب Jo&0կU7/q!rOK9FGn7h 04w, ao<4[0{i}mG|"Q#cVnagUVߊlW_OLy}]췖K]5̉g? ҷmWGstCc%N ߈7d.YYGrЏ%~R%cIKA˿M6*XP(bPo%.=xxMoA7lYZ]^Y$M-0hN: ٜp]󏯿< x_vm1ylrcf}1<^(F m͉ =$;/}F/L{oʵEB_tӢ`s^ҁfxQ9kN8E6sF^!=E":¤O,`EnN'09rǶa꓉k9h`/%: yLx:;511\T&wTw㾇r\E_0 ռ2>.=OAuI/ww\G EĜ[(AssSq|L\En_ԫC1[^aߤUmU2uDM堄3>өuOf=*#Yxǧr"_w|Xڶ/8f[໚%,>ocĽTcJ W0V6mc#I`S:Mv/vQ/v;۪z>uW7~MvdWv.x-ftϓ|z }DjGWRɾߤɠ x_8j,(7U|"7g{{26_zP-OLv R3 A24 gQrC_Ξ~J~N#\=R.+O{7goIƫlROwQ Fnޓuh>5d廲:duD9iY?4z`–9һn뫐qȻE8L}oߠ2yvJx:~1YvWL ܒs߃_^T-<w;ZI:pq>VTΑ?4.?{)Ҫo7Oosl :04n"W%Ͻ<Z8MȑbnY lf.qp%ٴT#=r2ipy>v[9>zЫGy ׾mj +Iˉ*zЇPә-n~p<|dg݋@nc~.L\=ou}Xhn687ecn1 /^=w~k0X*0~ S 4^o-sv3M_@a/˸ﺜt{Ե⾏r{ucA9L߰&y̳rȗ#/Fk3?~Siy x>`Qjes?9^ѪQ shPҝTH!]nN'C@_QF5}|l̏GޒbhpUu +Klϛl}٪wΥl-W49ҠܘB|CoH<+*7Uh5g q״9wf[ _Rnբw}r7/(ޜJovUh{x>4bγ_8ذm\A}E*@~ΒE9UUuVqʇZzn^7eՊw]Aã7ԭ}2(γc.?^:.c?R A!]=PMv[6`= ~| 9s|x#>S8>kJ69L(iE ʾ;<6^&) +m2%ɠnv&0.nn"0aL#Ɉ/uE/K΁LܻRC._FbPMcxа mK SsO ;}olfϕ~ݟaH9P_v4ryD\ѡ7ՀqXVTwʬ6`w|S)(\=*/Q}[(Q=^k!rp?.~ryşVӞ˙1[{J "_9r}Noe}w@9s'W@9iW{_dEgHs)~ _V#8eq,([e.֑ B9'ԋMO;7vdMXPq;Hml@hfv`ʻq}䭷ϭ9ncS7#Ryc5iAcZ~کb(OI{wE,dk+ȇ@&tJ@ 3&l(H{s8O9mk /[:9-U)[Ǿk]g>ߞ21A~煺[jKM_o(\ԏ_ 8GUv)[2twk+`A͟c-XesGwҷc~~7Egw;>蝹>db=g; ?u)QQAg햘D\?rSS<6jϠӴ_\J _aw W~:upo /;]ݛx12[LִWɷMn?akO`wG7`w6g3UPO{WvK̷v:Z t/~~)/ j y~=(|?E˙GHd;-cO/1E6:!Ftyv^U,^꫟UB~=Fq|M>ćǽჺeI)wvJ⾛rX* k hNyXөza{OƮ-S6MW ~9[?07KnYJyREv'Q~ 6$ʵ0RZܹ Z%h˭4uĿ-wViΎ~L͟g/ ۂI/%t?VZG&/ufg2_޽OtlNxj/xOI.^ N_qqޚof_8骔=6TX_jvB{ED-"?WHjnweZf({'ߔnsKx_cR?u|C^ü,yLK{P rH ͹?Iq a"I{&җր@~=#3o"[?bmU~ ξjNydžݙZLrXE~p>qU&n ]ƹ9e40m/oN~}_N~E8_۰͔9he$pYu2 T8z( ꀏ2!:N_HI񶴧Pq hIq~r|4[9*ǜ߈󫈽j'K/sdf+lvbEE^u 9QA{#ܣ2q,ER{{cV>:J:Qp^vQ|?\EC%P.Ѩ?O̷E=%TjX#_kJ?G=n1y }-۲@yx@{>/$ :(zǧee[ܟyfv%O'NO)D C]fw|> ;DYwA?-G YC-ZE7)xn7ZIy(8aO.PϷzzЪᎠ,-{(﷚S^x?BjwpGxX̹k?a P/3pY?涌FoSAqbīƜUŮW9xvГ| '|~Ŋ!/>OuoρnO1 7J-@{F?G%SwYM'uA9ݕBie_U?;Y>g?b^={P?Z YoB;9dP~3W,t0u3.;,V (_ =~6{X]Sx@u(!y߅CYatgWMV>(-;@^y#ZuG]|c@ ]sm>gsr"{Uw ށ}^'y1cagXoܗ|];?Y5G8GFRo_ o7B&4J٧|Ƃ۞% Hi9+_dnG5WOIOʤ:&P7VȪvҿ+1y-·mksA1I`WsLXpaVC,r_P:3?߽nM[0 6m /N[6I0mwov_ekx^'eۑk\kNq:Pn^eSyZ-ch/N<^-[xޖ]TZݢh\q= ]}fp7=(+>uh">|עԱAai |Sq!b#k˜X^P\ e*t/iɂ:u/,t{F"ou1 sy]k _Mvq$zA~杧GeYxz::ܑ5\[Vp?MVLVXb1[5*g&o8:|{v(>t"DO߱y H̟-&;eϣG^p^ x}~ 0>"^=R9?c?t'y^m7,SX}2=shu~ͦ&~ Sug&# hL漶*m:xjB9+5'r)F)ߐ7?~NL~s͉5,lM>%ۧ`CcK;0w/s?| <> xoA1JCk`gt0Κ}᜔&@&}ŧ;Q^$W;繁uq@.sKI ay5 ˇ'^*[ÖZNQ)QC~q^#eṁ{<{9ajn}Vm!18U7>QxUf 'uO2Tvnss7:W ѣ\vϛU/, ?킙!B6Df5 {C<΀2T*l)G^یt5pgl|^D)\ӆt8"?/[n* J sY>Ĭ:~0?B&}4t@FX_ Gk/9,A$ N^Ux}< dw 1@oJYuwl`:ukPNТ~#֑W89#A2ʖ߻S J#q=k;c%(s Z?ɗUc *Q~:޳ o;ݷol;2%ywvzx1;ǎYB0'h(M`ț1N~ȵeww(l)qboī sey)txCvUi"k2N]rCkp ΢ u`꙾ ӳ\5[xt~>hK{>SGGG眒5HylçA7jЉ|bNGc9`>8:Ʊ1Ef;6̍|ߨwOw̦Zk\2̍eWdۆJUq>g4sBdq :7|Nw`)PKguX %ُgf -q2 22B;)JV-J$+DȨ$RB~uz^>xqs:.тfu eiπ{¯g<g찟l_?>Nj}tO=rlCD~bYD^?pXAZK lz>'Z1]G B.~yʢɞ'oY(05O*aAr˭2️в39_}Po>R*9d(b-m̉L1k2o8P.> t_ rM^v'>ʝB>F\g݋N|/4Fy:>GMЇH6wBfrfb~?E?_}p~1LXglZdU Gɩ'~yhDjhUwΈ嗺Ӿ:#ta+̙ߝ}ة""C;%1O(l#՜>y9>~iAhycœ#͘+)B$Hr:h-M ^%cNX5e i<HRr {B/g}"pCDl,huVh|sQ=^Vb#~oRy>G+k7+9FbNsV2˰kK%.^_S^D;| @x,EPف6m!wo'ǁ}ͻ`F},Oj@[d~G~S|1ǃI86ӂ?Fy]~`޶n&'&˧v115zy,S U>؍6i8p&}I"@zZ7Wzw-u$?|!8Wuy*sey~ Q\>3y!h\w66@kz2uSO(1C_ Kޱ@4 3ړg:F?~l:z~s fh^Q櫵ޞ&O:]}B{<\e7/5uBerX`eH&Us*$'b~H/"$O gɜㅳ|ԯ"- |Qf*J(~^]໥W%eKc0@jٴŠE94Nc''"ioxfDf 9eLN^wOt9'Y#~^dM͓^@L %&ZZfg57mϖu'椩|92X@?vXA==8Rh‹9F+i9Cb΋+略J%HJl't&CIZ >^3͊\}xp'Po<9G>FHn]CDsx, IY!|Fq`A!}[ ٽ|*?GZOӐ=[z{J%-I &FX">9J =~B./+RO1bM4c+u-@#~i|J?#Ϯwʢ|aLm8O-E暼G=-QxI'h+,Q~xo@ۚ^hT*o:%PşKxFPyI= B+)`H>*vfX`GRIzzo$]v"@S yh#Gv"jS MZJHBW&|gR|\}ǔ7n0XbInǮgex<=4*ճW,݇@⧖sМڬ&߈O\}VXJB:+g۠(C^sd:Snq1O2szH^~W 8s DViK!>q=d^cfiwhmN{׺M]c㎗A->7M,fYOv?#R[_OMO5@nI9a |mNg|vM}G/H6sOX^ZX | -_[]%ܮiCsX;ozFd>1+u@r@bnT P嶛"m@NN7ZqډKFG2hB>&7W{ϩ5ÖW,3xlsnʕd@ዻ bgw8[ypOLjQ*&οDRX^5{.U_B'nz^:F=$}Qr@׵k |plۢ@9 ';tۘD)>Iw !) _;Mb9gBUK8w .j"p06q c xД¯mm>Nf>5GJ_9N~Vs_@/ܾ/0h:k3@p2eȚ^9ݸP_CbUD-pT>}cղ>3PKʔd&Cg'-s%w /v*>jȁ@A$SjDKk([U3Ͳ%2\]xBY,OV,DbCqMѪ.CxM+L%a/݊=d_ֻ|@ݰ=ڍ_+v\yׁ|R;K̀`cl45i5 2-X@ϷXϴaT6x9}`Ƒh(Ϫz(9 ljE}qdązje}>Ї4˛z!17BFHTjs3o&>Q|A6˛H]}y(xj|DžhOc/U{i`JX̭J#{eDcnrⰣ|@q kemuK$Z1@հ3snN'(H5'|p}~ ܯś_{ݒ#~X \E{O`+|E@k+-s5Tň;G.9\M{n冐(̔jZe}zZ;=:@MG^o3Ĝ])=?_:6|hn|V҉8ڗo Wj夀nw!ʗK~=#?EDݲ??~Ŋ|/S:} t z??8o V\vq ׇ]GRhW}:sϏq] 9 3 %$W5 c5Pkn[:[r%P/=O[侯ӸޗL ihfnS֟9h|5e=fC{ y!)[]D!LI/XtW g_#.-/Ӹ] MOzn?ۄp=m맏@Hr3ЏMZF>(L:Ys}5 l:>ԸЭ(ίmZ,[Vc|9oDR/G }w;(Ϥ_4OS]@T4s2(?l}~M"dj{u/K"˽q uG1=N?9Ac~w>n*ӈ۴?!ω䶡t;8i"heO=ǀVrRfC;*±ާ]WnMh.By0 J֔((q^˙-7'O(ЗR1bŢ,Һ9/p$%|q?-ܨjDYZYj\5w7.ħ&R#ȰcLr]}„ :/ B)j5M ;?B1K Dz?H"w:H-=A֫5TA۵\x$ۗ{ 5|߷RA3e}BZl)^7j' !%sFoc"99o8ǝ(Rs / (DύΟ~y~G +N$˨Mr/\T-o)猡8xybz3KyQ}fN@YRCH)%i]O[_䬚uWB̞3Es:#mP >o+ U_@ ILNQyL7C@Wq_wKZV{?9:{-qDIan+y"(:7vH+ _tr]n>Zޯ}@|N oC G@wf?DZxxxxx(\p&3Q*@$|jftDdܰFX73-4>0Sq{SꥺJN} 5m potZ,PGIX >qEfLo#05Br#)pR[/腍,0We[(ZcY]a@1BW._ħ+-2v>Z| `dxwgQManzJVgP*Z \>'O'h˙Mi& ǧݓ}(8j;r%`u+VU ,`*0e^A|/D?T  >ޮL'[f?hŻ?]ڴϨR5U"DDrGgkW#11'XG\8KsY03[< $]wlƩo@J=@RURQJz|}_׏ Wι=3u'n%82sX[mض*)SNnG@O%DWF}et ^Ӯ ՞jiHx`mǼom49"-/DžC偮Е!\4}/վ%{jy~O_8d3gYMpsC|{ĔѻVf(v11s 7XAoؾGq}d;-tCvev` f1^V~ 0ec,QZx9M2C[$Gݥpz%{6U _]IOb^ݦ4xo ;>}5jR^N⚙\}QɘJv5?;Xcu&&gr8|`ccVNo#pW]M7 F6  It}ԃVp\@Y u{/yk%UZe>ϰF@EـܒHBgo'iZXIlU=ؒ m]U~u$ 3=yu[0k3t޹yy31#@+G9 aU׀xb}`' 'z6ps(ۯ%:d԰ '~8,*݁S7q^ܢ\ZK#TW$u#ku89*1oցeA:{7Эg1`XY}}A5@+3(cLyNJjˀkQ$p0G+uWISnQ=7G]+C̕1xͽ(G>?&e/ŸK4w{6Ck p +'2Hܟl!` ƦxFP>el"V!ݧ6h_4>Qo-B|k%@6/Onx ~fx.%1NI]Տ/,'l~ "As§4] (?Y^҂!~VGٵ>0c4`+a` };`h ϟAoP;,իna@^/JN HN޳'?,Cu-z84Mjmۂ7٘,XSR옜#qqtU=6=?{aC7q:#sOYxjF&njIS@~u*' SoTDpNޛ ,7K?`@N]A݂(m,(9@Eȷ>^ C<~pjvzL$)JM/: \'Vv?*p_2΃2;^xݖh)fRJ.`Efnx<{tтRT<1r8 q*WkPj>6*;ێDr 9e2@N>q+PŢN VD40cC$) L?R$66zOݎ}Fա:~FeX^byfDیi7`wQP~;{֓P7Ǘ ϮB8~)kQ-O,4Z7w?}x`oEaAyO*E7znn׿- ;|}E׬7ϥX4k\:!=#VOvW=}iҕ{"Mu#%`H>+/ áǻ.[~yd&h-69B`2P<2oj~@sg;n](]UII0kiz沤Z&H*c}A>G8w` N6=n8MC8qMTW5 FNZwOluzHl偦.c~- ٨uYޔC@zc=ᆙWkWN\=3{EZ%ȃ2.,u/t{5{6Z{P~56. X mB8 17oPǯqOM?\XwGnB=.=~^Păzҗ?JYہd7I H]9 e X,KvJ h9mڸqU0`9Ru(w\~g}*vk^GJ<9n B^}';(<؏s HHz.GSp>pJ fGSp~E@5v5P߳m c@ Q4PwȟJӝV^.+I EU1IKICOS z{wU*?Gv͑G ݞNG"ya}8(.!7 xձcTXى.]Ƽ٦]Gν hhO <r{D;H}}EMUSkZ~NI?C65h< X3jWzsUv>)>e3.̣_?/.OA'{ÛQ} CyAQt=%?O䜵@-^-R (-ނCa@>0ʫ:"@w|ll9< qޏ|`jQ\.~/ݯmոGoG8~c`.OԔ\rJQz_yYQ`眀&ۋa **ra!0/1\轔e@Kˉ츗WBm@h;̮鈠E˗/Q~+Zq_ Ss^;ǫ B\߳LsI\w֥7jhW>Yhbdz^8Ř+S}}z? i@Az`(Oľ̎SܿMjf|y^eW1UIn@{įդ օnH6`}'W< ,WWxO,%|ʃ@~/?Md]VG H|dn;@IySCĻېD`q&^#5.D@k)tnםn]Y|^s:5Nv#>pw?'M RnM~ -Vbg.t X5g4X@e~pԪR@>)jk-zR4Gz+Vq95z;8Kq3-Q}V5WP> pʫ֢7ɞኺ [];!(|d8ߵE}()K>θqu&<-{lPiT4,CQJR PhyK""~qP|7kB6İ?%ޏכdg&/@GvP ʋSuJ:!?·G[qJ pceLhEw_Ҟ.D-B탤8zOV,5,G煙E;Pskg`x^o>ͧJCIbNPouoLG^mVE_l3kใ~%\/nLZA $俑L^((nѕsp!WN!ߝOˁc6>ZnR`F3Nks4S7a10b}ˆϔW$ƫV7a ɢnrf$jxC Uʃ|ԅ.~VUs`ܿqEO&M55 K}"!syv󊞽|58Ł8/. ~xO`DF lzBhf~M~i/_;1?X'H>>vl;KGszљ'iaƚ m-0F86:LV u7c;Xr2pc_q^U`.^G\ʟ3](_dGyy ̒GqJZRXt =n®@4k#ܘOf 䗶 MY!"Axv-!h@yߋ`.on4Ԉ^ #(F9]^ W?/ é}_Vw4rWSp$UdzoqdT ᰄ5R| FrrKi|e-Sкh0X8pE2}oЯ] ԿI@>9cxMbwhe{:;^q-GH(jËox^e/ Dϗ{t=kؓ~ya*w_ڙ3_B^ z?>!Q}ȫ:uM] V~aG,_ ѕ/Ut]qX5~~,&Jh`HuС56_,pi?P"xhl?:q#=W<ϻQ[tn&c{/` z:iJߟ݈wdl _N\oms^/Ďρ!}6 .f֣O/m8kP0Z-}"F[%zy|bi@㙔sJCy揭} 6I׎0`+\'@zKcv;]X~TV$4kj:hjS}{(]2;k;t?:VoAxZEXk#k,Eģie0^ j@'sJGGqsgxYLF /XQ9PߜnRNHݯ+pYNW/샑$sw($vy cYp+c g|}7!3Mh.)Axoؓ5Y\Zâ\K{ARCngvEP;vY[(12NEu 2 N<1J Z@v`cb6!-O-ᰩ_}Ij ;D@!H\1QA%s?uOվ!uet)Z+ "xpmΨۗpu %w; XEa-OW8:W8ti\}cePw }|n?VQ9OovDskT>,/ XςQbZ~x#/گ;wu#;O>E̍{?7+^nxY XU?ސ <(_ t5VEڿ:5zHtUYkik߃XTj<6\g@IwTQsj:qzueWbG }m~+r*HܐE^6S}[:`Aͻ|omz>f>Cy֤D{0Pxͻwl .IIJrKꃕځ)ypO5]<ljT?OG߾~6;bޮ^ݺ3z6s×Y(jӉvm wKsu .8p灀v+t8(oZS/A:f>kZ]O< Er^GYƵ@{z^1 aDEN}ɲ|`>_% ??hݻ[2 KGwiEL=q wb:RuF)`K={+~hv#;& `fNn(Fyg8lOrv@1lr5GyR8i */f# mE@?ymq3`|·?u``Ig5%r`[6XŻρ5sIX_iֻ k75 1ShD&OCt&ayERgPlY_ob7A{0s~oӓUOoD|o+`3[3$!1L-yڂ;>F`A/eQ߂{)~~dM7xns7/t1waThzQ1[`l`ңSY|1Sw $3wOx(U_Zym閙;70`/0MN7%i_uYHʋ,ή7f+ ;]ػ-O 2Q~vTᎾ%Q 9y֭M@ｈ;9n`wXVU`uRL>j2lJoC]ˋhZ4wcҒ`-8[K>MCqbr-`'9/UO}3<ʷf [UY5525;d2e73͟|, k鿝{ I7O;0~3lơDɥ,攺Y}nx8fKQ~QPI^ܯ+2C>@=L6LY\X䘷ܳs)=Oz>`Gdo{}Ҋ!bM)UXf PiIń@T]PHJ|cGL+)< ܎KN<*6e]0*廓o`P;57PIkd= mic.?'PϨ^W~uj0T="T T-BK ;?`Tqpƞj=x]%PZ;K,Rs#ܕT2?'6 dX*zT|qKw%{Gn_%'%OR::ފRZVٸbAG];o]$&8#"?GVZp`FZꟊ؁3ᚂ@sƃP[H:IaU`}C#h5n( YpTn -CXr p\žl#1`gWnƂn6kD(z^S)ֺ2IكہtyFmo@][!ծEh3:gkMI}"sE`/9%Nh~L hS&{}~uw3c6OY -g.' py+$ t)P!}ExFܶΠ_޲BoEw}n:_:{y?;`o7Gqⷺ XX]YضA1ϽƘ zZud]_y~Xi8nE2*|l"I(}EIJ)2(DDҠȊ$BFv%e%23">r9z0DyP_׸j}el=j(!V|-˫c*VKx eFm"_x[R|@Zkd4ЬK֟XY r}w@a!+ݹ?_I+uT ӮN,UƼ+& koD>qvP5䰦0=%^ {̑4܋Mm{&i}ViSTHFyѴ@;Ss}Ȳ?*`(p?_w) s}wH`.DnYd=HI=@>Xy?e܀Y_q#km%m( g?`erWr^2o͋72^ϛ-G^2w8) r ;H}׎60[: b}635竡3 f|Pg.n+~% ۟,J+<`h EcXDW_hjYctDGA;hʋ I⥺^9PuuO;P̓yu +kǯy\խ[oLc߯kpW% ~)Δe6!c3mx>gҖ 5Z| H+HX--raZb#Z9p>^_$0Wewh.^UVEhgۀ*@Y?jݛQGC_[5|g\!|tU#%џ4 f;q}dlp} "w֩$Ի"w5ubꝺ)lWvŹ.*\=[>зCewgwj^\(^\3к-1KZllQ"@/.O\2wS @<֖ kOp)x[/ 2 sfO|ߴT(w]rs>" +Gxws5ڃ aX*J\?bso~9q~hs^|_Բ1,p*u%3ݣggC Ng` tae"dtL=7ԙPUcǙ*E,i;ӾVޫ^/z7>j<+iHQ+9ʟs!#7ѥ/tN ǦdÏ*N|;% Dˌ>ld|g{IyYX[-' s ~vɿ%3}՟~ 8SZig|{}GrC'ҘEoN0l*eløw@op[&0vyL6Z]w5pV..@_ )Wy&q? 46Y$ߺĽ4 %C 3ke5򁤁_ ?."YȟzN.+'rF` ̾2}\UyDh ׁ7:K6Hͻ{=M̞Vnҙ^bߏ.&t_)9"9]Rg`)%?qf.6mRȧK,Kumetuѐ_qa`?eɿgj?02{a8l5Iw*@&{ZCx额m78j?NK ?m1/ ?9m7r𮘖?B;sunq-:G&jGYSᵂ.ԟsۋa7.!_A3.wmZ@0~s GdzPg=H h&@( #w@|\O ]ߗ '{^9|$Ux{i!谌ɣ8qK1>8y>q6; ZߦnzU]sYCڼs5 k-f 1ع ^ֵw/Qn,ky,OR ӏo~ط@FR)_wzWTgo_6gTQ'TrK #gIe/u[ 1p^|,x2B~>#BF5/d}b4b99E3 ,-7J!pے3 ?~:# 4벿*#L_|p(r*7;aI;D/} X*Ÿ@ft.V8){ -:=rRy[{}v9$XbgMZC(ro=1`ǖe@560G~0}Zex*ps;ࣱ* K, d@> Ĉ@8x5|%2rO:߇T"B 6_:]I8pl&/:۟3(eYONkkZn}0Y@}і;?5 hڏXܞ(ok >3jǬ :=R@qX/]5 π\|z76'~2ue)>d x8 =$H@ 8F|Twp?˼+s0_ yn>t>Q]ރ~tѹjl'/A>{({, ~>=_sx6  ?v^q{h{yʤ_bmG j.M$MܯVp/0];(]+fbLj /D?ط8J&3@T| C#-u&K_9v@+Pn_&.r?oepNo>r'uvPv[u6/*ܮpYwPG =T3`;:RTR(t`:͊ ÃV肹W}{c}u+ LOc#PY#rdwpe5!r7 %qäU\a7n|C@􈫸QPaWi™@Ԇbޒ mGƽ?poRү/&О,Z@kg{̍N1m䑮64 ?3=ȕN˘>VM>>6{j ˁ駅ﾴ g=CW\zU:|3tDIY>!=Wy{\^jO}x?( yvp[O^`~1ѯAFɲn[1]rf0g+54ne;n{0/`a@_wG/m/z'pmw8XEoVK7VLsZvSY'qr (F"^78{ EAzobq=*WT}\oD=7jЗ 櫢˝=sXfeEe6~Dp/Ԣvqc!3 [-I`^~QX$LkF7@?|0< smS`B?ƿvao0kedߝrD]jewyi^MȠG2@g/ՙ?}kvE湜p_/&J@Q`oݠ?ͼu^'t-K4>g̻P fKU?O-xl}."Yʍ@l:J"$_8Ijao&3:;!W m7>?؏G'.z߱3C\<ffHW|_,/}czg<@|+yerWL?7 ?O/Ma^9 @B%rαf]^jc2r;ߋ'}%#o$/Wr;;6VO\KH5"rzO`||o)߅g&AY"Ou"bxe5oAyo/YzyCv>^x/M[)PON=srޓ@]+󁟶4PC~@{')P"dn9tu} ` ù{o=m,[Azga'|2)? 2z1 l|ϧ,.LX Bshk䉤T3P;-ۀP }eeƐ3.klQׇMy3ND7 >jb j=9*4#f|/04 އ}^E1g:?ƗO~g/ptwWޱ=@lZ}OMwY|BY!>WS@Tރ@(/C;ئw \|p%R.x]inUG+xuVt"fXUo J#[TA` 8"(Н%Ya7?r0]' pS`#7h NWxBkpZVl`|GF %e\Hw讛NY\@4{X68g 98s7=E־bl{ڔJ`Et@zO@Ӫmiy ;G@>Z|oҔEE_+煿*[u5Pkn`kۈΖNj=@ǔIbyۃ~~aGV_Q!s ~Yn}k^릸kpXi7A<.M?2 "MNIn4S@b[u=oMp_iS@ [=tρOЗFyjTa_N;xyDZvܖ.F?6u~ڂ9F|`~ Pt #ꀻC0W0_ )ԟSok3m#@W(H5-Rֲ3|Tiy8NewcbgوR0v+oջIcOm9yXiqnw+&%l>}+xr}k< `/J\$@ E1xXdG2Y&v%޲0 S^^@9jrݷgmwL/{3Ll sXcaT)a$MCz%39q伐Muq-|Uޖ6Xa>؃ f2ƀYF-L>:$Et1.0ªO"NOpiL=K10rO$nK.WX; ;mnde܄qMˁ싖mzdg߮1x|{go7o7ۧ_jbd&^~VH..#p~ NZ>-}X[ZGqjr_;.'VZ. tE*[^_t{fbohPy( +RKN(WcN8;̓Re燽{Sj3>:oo2GQ,dT8"^A7[] + ̘Q pr7\Ae : o@{&$)7HoL)o;G NQ.^+Kuz/ɞk^=yzٔQ߁F7?떷等z4xrO툅$ꗶш,P]:m*Vl@^xh+!-} XY.s>LS+ZGڵ}uZg/4ϥ=@O:B~^U5u#7?%9\zlog-Qcjڒ&~ W>%~9M975)~Qqi{VtA9AUW|X{#}@/;= hrtqzA_'Ѝ]ҶaݯuҁԖľJsnqtfO>A޼W%=w>gKǿ T+ 䋺JNdM:CkN ruLۡrYg圁!R4LƾMboji{S:uy uDFniԮ )SqFCɎ!>vH57_ Xo|> ;S}'.Hjt=-Dݑf܇`/1fi*'7y0E_;cD pWY|-pVOV{3+5%?37 3h ʞd;yߔzfC T30ˍ|'=z[S֨_2ӛc֬"}y㯘x а"SuY@nqc赩,sb׺nO@Zky ߳۽[I92e }U7+@=I8h<-+A:;0Vc|:NOqtmbdy}s7]zk,P8 O旓L79Ԑޫ.8zE׏z[F\SPGrO}TߛY>b?AfԁB<iotea/c35D]bNFMQݡa MQKn8+z$1_=:rg3ϱ?KW.n2QG>ى;d}]BQ7PNPR}:07>QdVvU*:@"h"W)k"i(O -)-U0:jWk!-ϼ%B~[; bT8.&Cg9b,0J/@z씭D9ͣ|mŷm8!r$r7O\us"z@FtL*ڱbz75ePU?'QJ>wY5|_E/Wbn\QpTGAI`>y8)lk_À1Y;.wӢ]miqcjՕ "\~,r7T"G230/fQ_)X톋0Ue֊_Q:)nZq+!&MU{ ng!k^kʏ94͑ O/ k|3LW·"ȵߕ{wn9p^Mξ:m~i5`<X ?EFYgӈy&^Z<cTV^#Kأo2ܫp-?[CRX ktٯB?h5嵧,q P}΍^^ NjV@zv"Ofz0 -Ԥ # >_ [D߯%-]V?12x+8gGza&+i50K}G&qOO^ĮCd)YfnyE ^71:6F˜;ƵY;}#rri$aQi@@igrwI㡺%=}^g,I`Wj*&Cv`L.X4hI[Xto?%@FG+K\[5o9H_ 9,=G;]73!an MBp2]A w||- 3 \BSymkߒ4J EX*}'ѺLbV~LZ=]rHY]IcZ^O?9:~9JDr'Oޯ_6@^~!}Y-UN?ebgL Ma[e76#nI@]eY`_*]*6\"kǼvuq8S?A~Nn|K/nFjv[]Qܟqܮo.6_(V4g_̀tGڋ@3vp'OV߶j|]*aז* #^z"7Xk)~>>W̵" ߙ9>kbJa^4lʏH:1"P*s"_V.pg]̑ 4Eqۿo>- ږ@TItFá@{Y&uysv+x~ྐu/Bޱy> @]UI. o򒻙v^iq+\݇L^zw-+Z~i3︗*H6IJp#ԛg;en(F93PY}^Pg7x.A]6-m"  9w89rüù 8;w[yփho_{.V}QZcmbՆ1٢ZWGXۃ924p:c@ʅ%U c~ox(crޔ_pw7?Yj򤺠\3pK]k}}ډu>;g9 곷"7ח.wK֮bV,g!r\u |{?[۔+$Rggہq0WQf9ˡuܥ-܁{pv)rY) :>=oĸglEp%@^L6>=TCTLl>pi\onΘP敭{^Om嶞m3@>ґ:O6Eȫ.Ǥ{qC^Ļ^;; %3/muf;0o {9ҝU %x\5z5@ 89.TaQu 'eyG-O?ҾB;W}}G;H_8RS)] Aq}Z3u` l{-|HQydku+vCɰL|㍯ 16ձjglP5@ͨʗ?zaS,jMuHsrV)1gzA>Jpr:0tWES**Wrsd8r^bpO$QOpwo]qjѺy:RP ·M0>-09W)!^~[@'ײGü>;ρ+hD2{5b7'jpc>ۛWfWGLD}`EJĠBK0 : 5 88ls!:Awkgp5g%MmD7xc=|F @֭ŀj:3U6G6g?GS+w? wbe}uG|𖫝@'0s\) lK4w'/Bry-ʕ)`6~W0~dU]u'='S s3?@iO!m6^e'U}򨣉dG|aH²j?pGqN>\:Vvߎ:yB}@M4 A+{= =/ޟ^{s1Ro ,o5ws 們ɨƀ虇[/c!a]ˁS4A_6&rSÄ#x赧gmPt5(/9!XX$Q#uG?wPA'y}!wߩsA7]}+';1XJы/GWhJX{`*?-Beyzw; ف9V0e9p?"/r:_6G)RPu@^\`䪱;̎hU1x`y 8*!):C]Njb Cr(),Fe1c?|:/TPAI{&eo#xZ{U2N' LmjE]}bU4F0P ٻeqΎoXpZ~Q։`) vߞ0)#{&{D/Q@yZ XŶ,/%"@Wn;v m^+[#e #ݗ΋^,Vt'X꟝#xuGoe]) Mg{U@}6B/yG@;"?sr<~G@ +l<_x*D.[v>*'Ήa,\t+0,Y?۸Hygrնz*-o`8Y X\Yp 0&1]QOs{~ywCxo$18 'OI"Ͻ^m :yk>x .ma<\douCkpM&37|nK hy·o<+F@}JIʟ)?ӎǓKl(t}ܴ}zϤm*z};-ׄ=gi-E[MܐDͯ|@'u<ޡ?]=bg%D͔$Bzce }.)JӺ gOjiu HJ K=^ .GW` wl'T}JeͮɆ@˳t s7/AΧ@xy-|>kOC8009)*sAZ|ߪ< .$--wyVBn-O0i琓+Vy#o"?L ?4iN=ʁ5>P OoFۿ>43>ۣRiB곹a[2*(E }~8OOnƧI?u%X;bBr -(Uxݛ)Bw0- T7okYaݽwY [5YV+_ \JGL'[bC`?wWv5%_NX ˫Mb_iu ƚꚊqG#܋QCjqvjJx;5i>LwU 􊣏,ÀWvĒ.j:i0p4#d۳sY` 6?C`iɊ ہUW@TlCu/TW.U3Fl[ 䛜N@(ed@oa@]!9} U^@$m}Hs"pŽת7x'{+$#O~Sunֻ5̹KBs|w?R@,kM+m`tOMC v;tźu^=5ݮΒ{9G?!,~:~: h ͦǀ~xGjȟ$4M^w)|:l(;9b7#W ԟE6չuWe<怑-{^ͷ)96t5zo#83laazN_uƹTy풇]D+9,>\*߅KJ\r鼔cOs蘃χz.ɧb>OHrjѼ, n8R\ݺ?nN `9_u[5Fєg`8H? #tw*d>-Y;t?w@겥 [ yĢΥ;(f=wr c{i{XZ1+oHA-rNgc@mKxXo\_~\tٱ7][79 _> +<,mWqX9%G{K~nHƫ@Z:V䨶 p;klvX=tO̿mI5@qXW}k* [ZgHN_@hu-BY iRI} vRMh`{]Q7ǾNʝ_I+^df;ZfWY#uJ:srE˖9Qr'N|e>MU\E[> ȣ+x~yOx.vsg*B^X(Mc+@[&8f=,\ SK@t4zGAqٿ8[okLVve6ZMn@Ϸ|?ߓT =i7$ej'쏪") X;KwK,Y^`NnR{bf}9 %>bsIVٿar [>SRG4{ TK5ͻSJ~pb 5#߼\fTL 1uM jWeȖ vC 켩\CZ jpANߟ{-^[ZK\iϹ(պ jN9*˅޵j]@Bv '~`Ǣ@li P\Ko8e(ƼWQ'_;L*1{Ⱥe #1U_A]eHɱz? TdnyyNNk SOFr[qVebX`O3+f҂v6o C@+S}F4V ?|Nɑ&nm1 u?!=4:y])wo\^ڱ7~l7=fB #Ϻ|+{̅$?G?i $Y JGڥ7;[I6mYѳ4UIUG`o:WSđ:~߶1KnXs{,Hs_7ƹ-٘;:-\O5}E0*y.%4r7?C_cׁ@,6|u#1 FlK5jeUGZfi4` Y͎%T`ܒ(+_xa!vu>ti\eAOh]wTʐ~uSY]Ar}b8(;(OfQX,>{@7l`_.| hkcep٭EW{+zsq&i 7rLD/||c?aq˝?MX75Kv99@ܙr#u훝~NOH 9Mvp %^baZw LhOh26͎uC]]]_Nfʴ7ȝ#|}Z(5n̠ls!9N7D_Z{_%@<|x(OYNuϲ Ϻآ!]#_\=9OβbgOK# :Y8Vv[8Q5f*k|SPub Wg@&z^S}ݡcZ ys٭ '~rd9ꬅU.:)'8oM>C?݋>|`r<h 7M )Z~)t7"7lqKnGL.wA >Ϳzӵ o*VdΗXљTGg_)>cbUvY쏄մǨW_B͘=T v"7w=(q\ofiͺA;+a7#imitY:]$E{%&c3|Y9tЍ@ի+*էTo8rG ~ 4$Np-~OLPX6]>DfQ227`fdGs}r`} 1}⼥="(JUzo2#)Koۏ"!^`Myv'~ΪgTA!w䩩zϛ"mT}fg>oF=;o]DkR @r_jA_;}M8삄M<-px@kl&h䨒ip1 hʺ"X8o ?'g^Ecgdb=/@;t0uɸ2sdFM n1-)J~+ !ǝݤ-y$@=/x>r*UTVaq-_ПK=]L=?aOhIbSf$ }̍VF·;mď"6YT5G CrUtwGͶA_B/ok%^y̏78;K rW,G2c6vstއ;\OGrJ4d^)3MzX #ho,vi{\#]ZZ4oẃvgDc pj#䑻 u Tm?IbvmYbŏmEF]3¼7qk_hV)6S쯥t¾e۪b)<̀ ѣh, }V|qmж+n0T?dc&%X)hW5Op ǜ:MzCq!Y}oqb 6%j`o bK|Oz~)>}hw % {CzXS̫5wW_$|VkB+%|/vƺ}zu0?\@WW.޿}d%p44;|C^5R&}YC;Lw:Tlzt5u.t{h>{jWLv ǻ9'9MƬ_ L/D OCB`^EE[-O{\`[:W6-8k|w|80'Dz1[Lh5g 5ڏnqOQtnɘ]ȑG2G% @*,oۊ{3̗@ݧ>y߷?\?7$eXKܪg3p;Omݶo0ݮbS[PyzցEV jbt̕~p??̭LH, fNrZ:et+&w_~~Dp7!`9D'[}4QIe{*z`ԝ+]{)JL&r;kum1.KH.\uqȓAح@vH9+OZc.ǷYKfP 4ِޔ:γ=@d̿AJO@c?賞׋y%h 2mY9@;r;ꥴ^@(^v&~Ns(_ 䏮GCPG?JoDn H/Q*orU KGvȁ*+)G췽{o͘7% jζmW@ `VF%@,}@ {=T.:EdB)'n uίد]k8> bGE1w?iP윶rM;-[䲺i?͘Í ̜Cۼ. 'ȢSqs_;_㱼ȷ!CcC1 ZTK;W¯fԟʏ~a@[]E1oC#v]_I>] 9|5?- p[@uE}4qΡX)?u[ ALQ[KL軿,D^"mݥoWkd~ \zrNE@tzC`!K r'!,ulM,0>Vm-AlYbѯ # :i@N?w0Hc:fŶcX x1Q/;5a^qVI5=䵣]tsXB6oX|k"{؟*r˼'{dؠ^>Q7=_eЅקӛcޏ|]*0sjoӫ\}<@t R~ֵ\r}C;|#\5?JHr*r[\ᘓU'/x@.N | ܃$7֑ b]}޿i!_ťK{Ni+Z/9-g 梱Ub~ciu/p Uf↋h+:?vWvͪ;o?_cX/o$:'A Eg_m\%yqAղ XO8,L'JCxun5ТRhM$XÆ,sрNy7nNgHt,\{M]VE箕unᘭ>kyg9rDNoDz<;_*_߷uk_)/dH2!`h2w?3KD9P)bn PGqɷuޮ)xU O|UX#?v|h?ؖd| -\hSP Em\.U5|2ho) z4ߎ'K-{#g G0}-jҁN}6hnOnB>2y_U:~Zg`OtKڛ~ hLȍw3px|a El}۱lBߨ{:\1?wͲRQM=}_&+{9`H*i,U\'V,cwS cJ?cq Ж|W2 oz H-Ӷk-E.Zyc'?!fl~%<#_,uaEMW9 ̜)̵4} v٦7^/B=}u 0[ dEiˇ_sڏΏVr9-#hKΎCʕX, zK8D 4 F<ۋu5|˱@Z↻qGo+ne#C΁eȱwo|'Д>.ê36Nb9]y JWxFfw'tOoP>/L眼}ہѽlg YG 1>>u@@g}NBNhܟ[EhRM7-cޕ*`Nm|kOf-}=㼺RCN=૷]Rz|R_l @+>XEJPpWuK֘LۅsXphVQ}`{p3k~2yy>HMԒ9஗N؈7vP}H1ݚطe9X;x_}yz/NJdI5c=41n/=H O9.9+2xenw,~}lE=9 8}Q y3\%U۪nܟ{F+_anP. WUʣ1qmme`J5LKi@?mrtO;@cR{KoP6B\X Ğ]Wig @n*1;&U=:S[S'^<-|+yaIagu'|pF-o9*;QNOIyJ*x`)p~?9Z@zH7<‹r WGz'-u_T#UN珁+Ӯ?Ӕ ec.4(juS}cP7M?2"σ X$>Oic]؋`RO? /ʀY~]0؍[\RN X5~KH\}00L?IF΋E'Ѷrσ@` ܰ c~Qo1~`=RHvj$mDJnc9J6$Ԥw.u~+m<.@Ŵg޻Ħ$m mNKfu+sn`Znx{0&#%O$|C'`5=LZ3U|@oq˛FGwT?`^J7#'ᛛԶ r[Ja%s>,!2$prrȃ'Ś;$|"AΣp"ůտ:E*xle`(˹~O 5@j? #?үhg//G.Ųˍ;V4Rl@k.~@9sK%H}fgþͻX1}bMcB͝y׽U3n~\;2a`6S5A-⟺/oLvM.О>:!!@xr;P=HXs P9e˛}bإQ6] [8/7I@Y8Xu]\!ݨ[iT]S|q禝㖺9&EϑN`n: _]mv|10;܍[.ϚBbb@ 4d-}JX UO)dzgdW[O~u%=Ҹ;P_xe?\x[{Bӧ3֨ȥNiy%> `蒂s`P?$!` 7=-5bK ln\Njq@1q5֠)TY i&@r&%nVR9:i3 o\}keUj1_$ba|v|W~F?K|?ՎHt8OYt۹IJI| LS{v6Ψ`n?5jGO`Q*Lsૌ#<7Sy L!ƱbܷVXc > Br\|J ÓBZPO,>@}yss |ʳqRT(Ti3+q̭wkpAھs \{0?1C5X̖>PTɗ:Jsfځc| dy))Byg D:1` WE[f&>>`jQ+gI5-@ HyB >a^sq<_{)?=3Qo-gMotsKIw} .VEb".-7iO'^X:t-WY. 0Ή s#&в[A=@[ִb(m[~@?}_}Aj'd d۾m;y!>nb!:p7'Jļ`l ̮SS[dү@xDf=1/kWأk$(@4|W#uAr:j}Xߊ/"џ}~1ތ: %3ihw4,摣 26hpjpƴ.׏fwZE 8]D.5^\@XwN9Db6nG?Q# J[6UnIL0>ʆ#F_Sk_@d9o3plA ~<'19Ύ) OލStA}vڦ1Fֿ_Hj \qaRը%ɟ0 df㆓+1d%mC]n5wm] g]ȟw~n 4ժߨvK}u,Pgέ7.-/|J:3*6/I@^| s1gׯv O?x^C^;7yjkwɸ6xeO,T[R}u;_1ON^ٟø{):$Y$ |bv5`Z<%J+^XZ@nUS'7;{_q ~~%ˇ懲X߆Bdi?D`e0p2nvՄ`,0<@i8ۆy%{ˬJ7,DZPGfU9׍O4=&~>$lÿlogw-z8w=D}Z2xgRV-~81 k_n,`1 be"s>^٘UdUƩU Z;ŁtO9#=myGkTtQ;@: 9s 3BOT-:# IMlmR.vлO'|rW)ѾL+@>z>p.e5cj<1C\ǫk\;i{6Sn|L11yϓ& BoVWoSZs9o[uSFC`]+%Xb/nG20tǁJw:V 4݇AVH%#-ty&`z;v9 3a6YǮbk:s0J?unKj @Svd"RZJW_Yp_u SiρFX[F:sܦ?|g @_<.hbIsrýP/ j~1 V?D}ajfpފ̉;mا6v#n/A]:6&Ǟ|~} ~ =:rqU\fuƞV;?3 ?a (+sL}ya`puYyCfK~Z\n::,TL?֘ P~E9&i aor\YE ^ d\gϝpWԵ ,<^j_,xQrY;@>9>\9z>ygFy_XS`xCE}_RV5\@ݹ_}2qjJI`kLBwX reRǜ7돕F }d'{rTJ[} _PO b}$Zj=`S1)ݓB;P׬Bvq]|l)N;*9w W3h&f~`$F5=@_]`C!yﺻo-<8o_HѪcB0{}{RF& )/gVo]Wkf7{%?DaED! %lN"O+dP8p>]M:  NQ?9 [T5T#OY_XKx_1rb]y\ոΜ<&]Oc^ȼ -f_\ۈy%Ecqom rZ@P}|}8~K`Y= <䍋сzb66r /lR|f5]Wu t'[6P/J*u؆7jKtp~쟼p݅ר*[yp1ב9/QܽR1 | dSG,?l,?=c 2]Hmc$I+B8}HX[|ï1ew}Xw竒@Z-4C j?ǣoIJ7+ŝ/؎4aU?| ?Ь?Jqk]w4cs/iz>+BbN&mӞ:?^1"Z7.b@%S2 1AkZ`<G5ug#M|Jg0,8]tGoQ`: K>7ce{`8W`56^ܹf+=컣6pF,A.R}ْu-czՐ}0^ zSw|AVpy,l̯K60/ǸՕ$iwѥ0xonJ@JR`^OKwr@,ȇ; G/\'Rԣ$#/<,Zf헵= j4^na=3$~-Σs=U|n rM,GX]aW:՟u߀.RE+ (7?7N4l@+RA[ DN"Hg& >"ZT}ٮqJb eUȅs{8D]'2ZS&˔URw"ӰsFhMpxኇ"Q dV!FSu n!qu@ߴ mekLQzX o9eߍh=`zL:o},ХhuoxS<⣚ \7 %|@n{LK4r&ڲ9\W#4XwT3c>b"C>JUZ\?ck I+9}Mh uemƙw@]=*e+!sI 0Ə5 MDZPu~=p>|:@ʨSevD} _9FM7/8,m|eA+{+ꪀ9|0D)D"sr„n`<^G\ ʃwRf* yp:n+(|KFYV+ԕݱPg*mpm1o'ORJxkcI&Q=u u(c#Oب 6n8nݿiscʋi۰Nc\MS:Ҥ{βvHJbv`>aXwHЪ`?v_Whhm^[gnŊC@W Ԟ۞g2 )X% ߍI͔Њ^{7wɫv>#^Qz#$ZP;F2,Emya@٩w#8?ra;zPy]6?{WEް!4P'edA]_HsV 2O 3,p'JKYeg8̊qeq oV,9ݢȡlk8J~ w yb[T#sOŘckOW_C-U"Kdb*j%H{ӁdZSᐝ+殯ˁ&4,$( =~:upԇon .(V<[eQ?=KҘj_|U==BHU;'?{0ntgQ+~Q9$~'XcY*.XK'>ܧõCBX{G,bG+f Xj5$b~ɑ0 5n8am 7#j\E.jÜF," fCTʮY [J=_ߧZ2pcr>Lr@lc\8m2O.} _?J z9M D5ltJ ǚx.X¹MDhy?2p8am\R[bn|e}jB6rPEq2 vZටFDsd0~-zy 96y ܿ5kbPT3# *pDĹƀ*F §>r rV`ܳ/VrП2>ܝȬҔy%X9w`VrO n?hoex$o Nyyw'0/fY`eY?yﺰ+G D9qaOD=Uոh_z ?Y)tZ}Es(WHgWP霅rhЁGo0 z\@꜎X^p]u@X%ސ:6,o[Ev8~ cbO-< Ӗ9^@/2!2$--Ԏl^M- !܊jqsQV`7V+ yK@xy;Xdx>ؼ:ZX~z8ރ05[=L%;rq>Z6G~utn{:EWMxs20N|@rlr ;{Th?6~)E+'ꀀ}/n@#rZ15olz7bP_=F>֒|?{~ܖgGtNt~lxc9\#ƇOB-8Qǔ@,@ _hu|PQC]̗٫ZcWn?]܋,RZ9\HcS}`7>),CnW( CjV h{x׽JRZ䈋%kcJʗŦK [S̿0QFt LK8[\p}앓zy6mtPvEԩ❳.&ș}bQt=N/ y2ʵI@lm^~U"ս90+9rtm0Te8 t:}ƵиZӾ_z(c?+e_wK~\KCKpAo|rU%gߑؿ#^ph?Knx (\C2y`g7|aQ0_F{^Li@oS> t%< 퇛P x`.8~rx d#E\J>zwU` -7ֈ` *B\goKz>pxhB7jq_KfXrŝ/AG3<8r/}t#qXYnHfr0whv9"7[5|"v2}D4L4z sc#Ok/߇vУ福نOU|I1AWX*מ I̤2#RBvH$+4HRJFH"EiH}z:vsnq1{m(מB6KLqz !'/=)C}(Rт' voKkm 5b2:}.h~}tGR8+MC{~g2n`Tii;Hj̯D~+&m@toEmJ[V7hg߈Ew~Pq[@V /LL:uLJa𒮵![;ܪ9s?Nܹ8_zX퇃ce8qOo{̳]# 9=O ס~?v^Gm߲UA5=V;]ATB;Ԥi Lmx`݊퍐;@h*]< S֯܀.(& VʏATJo*=Zle69pF-7l+C5[o#5i慆0T'߲ϼڭxTyNwO3WrmɎ/!ݽL ꟼ^a5磁ױHω,%>ts=^L,'UgW.To+? }⿂x!J|?<-sY} "~u}q"  Ԋ>ӨNZts'}UW&DnT! eUz%@_%`M9]vʻE' PjUڏڀj/`] c83RxcIJ)Y+y b%sP~*M|v} );Ngiz1ҡ N~(PεZ/ N?ң3{jmK\A__pۯfFqgA:?:FGPSci~ >|}M͠YZp踍s1fh>"JDp׍ߝQFޱs˫4xY/d}G* ׺>9ls]Ss:5nǴ!]tCu8c5y$"ȎOmQj*,AIM<R˨NK\k|TNg^#T! heȇ3v?P[ :\EƏN]J'\^?<׮lx+IvMT/qT?h07ĵ*5BjfeP[yWK6oZ .@>u4H)#}Z :z8յwlm#oޥIq@yt‡y{-#?Un0ʯ;G߀S6az\'){ĀYHVeze_Zz;Qm(s4nAżF)`臹UzR=?n^mjcoEn@o|͡Q] ]yda$(9f7-!З ݭ[/=o(G/Q0FxΔD*-e PGy{poU?mx >S(!D[+"Pm{z<Ү@_wŽ(kθt38w:Pb"l<)^ fw':! K@P٭vs7 So't.߬z:ڋWυ!xy ű{!@s(G:AFKE(r/ h@{YsV(NVY9LHu1CT<= Sa|^ˊIUăi`l. Wz8ЧtKNpy\uE&;O< fp1] W!́Fdpm:Osj/]qUJms+wot00 zLCP>9TƁt@Wn R5\*#S])q;{m[n˿ @j귥.;$3 0.jak:gϑק?ZF>gܥ~'}\]hN&O>ؖt(aJ6k:8 L8WKgTv\aѓu{鐉|^Q\9"cfާHsGZ`8l*Cno+yLz3G>B;ׄ!ڀWpþUwVzm#G"VB H {*a*goƦP(< jRdb?OOuI?2˵*CvoQ9,< 8QF o8m1sh3N΄=SQHj喑Q_ۿz8tݕ}~UkkQ/+끋sF_b'ՀA#iaΊFmhq ;o;/=z:,]S{v3o+nl^=aEf$ =+F!yBD'}LM&4PÊz\c~h. ~F+ٸ8[rMH>>>Ws|K8+z=@?$^cct>Di wutM u?iOwWÁ0p˃n9 }P3@8/tGb%;Мas{'m1E.Ir h}rP\3+6ЋtHOC,5fͧTT snm~s!3"sHOtr5ܮh>^Γc̒\fO/<uHQ5ɺfͼ;coB|ԯRvzyS)hܩ]@?P+ 6M6| Js@kȋ1._ml9zqg\_6#6.O V-J%'keu~H;vF6G)hZIJ*- e{&7|p P/q琁SYdmOL7Zj>95H=NΈ3 g,egt"Yy'}$"pf6Kkڇ7Uѹ@T=teZ]mL/M$xHokx=7觇4 ^{Of_5)?G+[K%4j$%o?Ҳ[᳆szZSo}e #y5ʣ[<|MNbD%#ne )=tw$vς-? $au^+/ V 2y<GM܁. f*j/8oz |B@Vsm91o AhTYM/;DZ@Xi_cH~hd{(]ut W >~OM+Y+x-Ҹ0ʴU5Pm-F11 jLg>{K =lwS0^`~,û :[c'\n߯Z_(xS$}V$m-W.Gxu>qݏ -hglJ~,qP>D8vD%P'DAⷢi~F~d=ƿƒlЯi(0;^ٗf_[5yY&_dDe'27LGvxΎV vm/HT"SDr-2OjZeLdiv ,6D|+ҪI 7?i!]PZ߮Csc0r@:0R>65zpmQ}f⤗ ;^E~eG/۶-K)ܗ3fXB)j4h4nF aRGuXauQ]}~7q~[z:(#_>,=׶l*w^A8VĹs2J$9=qm俱WЕ[GZ.#I1ΗJ"`F _Y̸[ Os8흤1˶@Il@$#PѾÂc!w6Z7 pgi&.z4RK4?J1?nX.hL esi]~KPu2 d^nB ţwThmڎpI(024S@{hC]#Vd%ȫ/kt񃿩x <ox{㽪9 (|Ut{ΌͲ%0dm#q#Sc&7sy !~CVl"#->y?胪wf[ng~K w:=Q˾9-sj%+ofjx/\KApd9v OBۮ@4 KE1.}yrFD|/w UXGπ=&h#ߏJyt9d8鎠9Vpb…]Z'Dnd(;[d՝s@]sy,l%rOgM@^Fc *qWv!^^7t-w~iSsDX0=:#Tսo! 36D :|#vfʵN[`]]m  (!?T7>84px`h=s@:6wL= H.@j03,>ݵ,j[t~ZDMnO؍p$2˕&Ұ}@KgbV7j!uS8{+V!z<(pzk-:ZnS@?xF|h k+"$mʳZjp2t5p<] V͛yZ6i[_:jg.AŹ|Y_Wt #|u08jL ᕨn$N䏃L=D|5T@ze ;\vbu*0ukvͣgL<0p#f_QOp3~&*h>~g艎ylLzvs( kRztEz둕$wQ6>Kg ̃יPAcGe,_os''6a+'=LCM;cPBH{Hw_A:mnA g"#>4Ge? ,CNX1%#.J nh 0iż7kw.07ܨ O74Z|ݍ+=@6!W\%wifCޟy :G>m˺l e{wá]SC7H>L6-Ht-xHu (3pn-ẁ8"6 X{͍@t<[mÀjG jr DzdaSr FxU:3us.TW wOˁ|Z>Q^œ, n f~"?`*?(bOT>AYLk!}Q0*xC#ߝ{<0ⶕ fCxio^>wZ 12_M4Z_4X5[USV2Oۣ-hx-Cgra:7@URW7 PY~z'~\;$Dc?Ȕ6EŶh#IU-]}3.M%4_7?lBxj2ͷl@s"Oĭ/!ofo/o8TZo3#(M; tΉ@ϴ\ / $@:C+umUs@:@|j| ymʍ))o癔/߫ C (f BaBVfG8=r S qB;7ҭq w.=Gkvy^G҂|5t+ K؀Ot- O$c?"@vJ+Y #^+ķe(@=jh"DmCiKнH9!>>VJZNCD<$7|S A`>ОY ǘHGM<7W}w*I[@O*rZaOPFyPꣷӣ@3z-vhe:h.y^h۔F $`(z"T?\;80q7WcK:Lސ!I<:?_1jNeP3f3*/+yxWPND_D&;pvemT'mRl;Ą8o2o/]^fe4"3ِHl;߬Bs!`[dG;tтH'"O(蛵V& o>?*9]_.nw5׭sA\aw֞'z;ln,+Wc"'$ ཌྷ |+WSܳܰb`]y?Tx> J `|ѿtp_8ұ-qAo"]X"0$#g#- PT^w%Շ7xMHkW46n t sI 7D: G-]jDVyL{}=mǺ!?G|b[Oo~?1+T\pJMɵq@I:<< =[B[2Sֶks?n/Jbb@z"$6Hs3'踚}/ YߟJ5'm`L4OUWDz좏@W3ˑ#dI^W}ynJ OlXd@J=hn }N | $Z6 c֛lí{jُ,v|?#n*lȌ};43yvsiC (9\@ (wyS(Hyh_'_<K.SZO H_/*e"8s:'u-[g:uVmA|;]?yn)ta/}8-wpe:3~Y5ͫwKg!+O˻D COw =*bxPm)>L7nhΛ{z)-1["Q*]E ] lm6 [d­˅@UP ۝[{5Z.~s9!8aA4ߜe}*G0y}(=oز}QN[r^ osqGW:"蘬ݼw57 O(:[e,н%DyiuS  '0ZZܥxctOo,}Aք=~x;M6@[wcs+tjO߭?E>Ũ6ܛ˃~=c:ˑosjXk33! _?@E?m|N>:]bߊ7|R񢱗EA{")^1hs#|kʍ>?yxM`Zz LL5-ҫOL] \Ӻtb+I^6O y|3ҭF-q#8\I ϗwmJA =byI9aG]$sBHUjWK%XG~Ρ݅ L=3N_t g+Zc}Mqwr%@t+rD;wva٦}{Z$B2'GBTl[tӯ̮x]kX=2/~ #=-dc5nyQ 69'9k/U[2O.@O89&hj0eWDv( f5f:0N}v^%a@|QVZR74SzՇ@=θDn4~:p;xGmXLh1kR]嬗C|6.EQԷt/"|R 08(h_pE?j ,]7ft'hB/Zҏ}$;@  #h~9ޝ(R@|{OpJbՓ@Zng>NW;xQ.I=x ETf~AEB^8ND~Vq#G2Dtz/w3o6溁ϾÜ ydzs?@7V$0 Tbj[Xh ![4" %ߐ~ɩ@x(=&5RGEB4?z;mqfCi8q-7_||zAğKP~Ö_L0`;Y鶼j>cEu wz,f#1 `*"Gڅ=>c@:]VW$' QFr9 Y'1,Dhcs|L 5}枠*@V]twʗJζGqE&`^_30.\s* #/pU؀7>x'*ͭ39I.n>s,>ctCQ˱@.Q٨ d[n@u#GBY@h:׶K vL1,UDr  | ͩS`ރ{.y T6` ad UI4|z?W迈?邴$)[xd4@-2Ze'oqGQҊe~@85AL8+ǁpCEeLY;)mkkpպBxF-/E|.3c(۲@xWC4x9΢WCNP;{Elpқu>u-~:f3Њ{~YQD+%RrC)HZ)l^w7MKnq3Wb[\SkCE0*IOxġ9զbL"Sxmk/>F~}O z}E~f_`fy_pH v u%KߏC ??ַ|=RPj ]u"֌$> sD{z>=a {cD> :0׫ʿ ptb10ϨmX|ŝ(4_"i[դ.GW[8ݾmN!$(}~|*G3#`JZdmA{k{2Ȫf م7tD ͯRj k\e@P#$_4 tjۑ`ns -JМt#h[~/̷tO6tnBuQPf͹2֧6*I(GPK'3&[$M}i3Y@EY ݞs 3kÿ^LJ'qL}CߧԪ2_-GZm`jlE:'fHWff~LMH J>ukD֞ Gxnֲ= (|,CӼ80^CsaB+^Ut7EB\vbMkP;'~բ/ -ʖ#l ~U!1Ee7 O`b=#n)`iù}Ӯ@y)O=bڔ^ bc:6Z)qOׂg f9tl9Xض>?{>Sďx#@Ӈh- 2߉)nc@IƩ`x4i;(F$k[tB4P Pn>IxrbP ݪ@0:(3na0qrK<б2u?QTU~˥H2`l3_{\6FO2`P j%#_40V]@68|Zf\/ͼMyw ;D8/),A/ >jXsBz8;W_>[qRHbsY`|P5F@V0j/ĮoƟ:o0(g3H2M!RT[49QWrnQ ;ϵ^@;>{虌f|)3P 0NjRAfLg ?X#~+`xJ'y̦jQu{jjI{ W`xW֯xvqW;bz3068^ 'x s\$Dxmz04 @̷O58H_FSB%99U C%*{ 'Vʥ']-ޛηں,Ϧ/٘tU @T|OݴJ&t_k׼HxZ)Qyb[N=F (sa3/>y}nA _~||wlY_q6wvsppsp0nOqoKa 584p5^yBAQυOLd ۬ϒGkֱlz5LlkeX.~KͰF7LV`htܩF.}Id_xVpt5qvS`tMcTjwMMB k8#ƉFcdMݫ̚LN:ɚZTRkd*aupddgͱV.=jv6,M{rPauZ 'I!emb=(n5.7ĚJ`MuҎ'VJW.kʹOEͱu^=C་k_Y=1&o \cljp/=;zit$i\XrZNஐ>pvi-Gm>N6ZZEw~*=<Î fއ; ~rf\Fk*F7qM-|Ϸ5Zt8kDց'f5~"OظGz5Vw4E-͚Ŀ)j9٩Y߆FYC}C^Nׄ(v~X}fzY*]( }ʮG?^E({u^ )4K'Q#VY4m`-*d͜P{ʞl= sAJ)q.Bmq}o~Im2`?|:ZЬ_5wAa/G6y:\vaͅۆe'skփ'Ł+:٭4* ,\ Ng>e,۵xpe}N4f]inV4԰go}H:bqV{C6>bs0a6{X0h~6c1q}8))1)X\X`p;pkX>VdŚd~9p4?d]p1ffu7{sk$$=k42p { qJ[Pu5:'~Kŏ X aK|3Bm)i5sE'y VÎ#,Vhvv0j2[qgϰ-/XcD[1~._26[x{4)_ǣ;xpMrk +㋴2Tro'_d}[qտa lҾ͗bx(E#6>cO6;.#X F?巫]`MEz֔iqzw+kRǎ+cռCj܏f[~6d[JX:-,Ưo.0_t?փp g1p z<|/Ksb#d|FxV @#d c^E_ +>x3YCqk"U]UL^7 ?WHH>ٸ!gK=GT} GH &ce~|h]!Tiaë煻@CRpf;rtzwf=4LXM5߱9AbBpWŖl^ӲNo7lOOa:bdQ;-ܥ==gb?lsk|l?0&k6Ͽb>/غgla812zPNٱmٸl?L ;}LG`ѩ{MQ sjek$y~:jkdÅ5so) @o[G,O0+7VڜAM*y8Xzp  O~=?֧Ána?1+B|s2Մ?X_O4q 3 q<a>_M-E|VtjIM Z,G+"^MIy>#ׁ}ܣCgrs_{wfπ7I7p_$73壤7v^Ҿ֒"?zku{]ǝݯi-=}_W }⧿/~;gSB߈硗O'Q ;U'u~O~73Ѿ܇8F]1;>7>mwG?ܷ/y}ѓ'ʟ3߾ᤩO=O_{{?z{N|n</;ُnO.og;o=sSG-~bC.x1" '?[qWk?G;mqd>#nj7|-ݰ/Y?NW?q<7^\ k7=grV]g/sD`7?_ wo㗳+'/߻gn6yكkG=*ܿpNlF}ø:n{7WEaӋ:߷?~?v$05۴wys#}{ť WO?O\n'^%7u⧗˨OuGX:GUI=C?vy CKkܷ{ًCx\ևo#M ~3>/#?_so,i.{=#5N?.tп~[w/Ojd ]W8<|~z;?V3׾~Z s6gN=f?kxק[f?s/E̲s?8g葿0<eoڲ}꧗_8ڂN>bG3'M.x]3/|oO5azuN9.[ US~M?v i|#hoy+ʻ󋫍r ɓCb~{?U8 xL^6qfK.s>:w?G?+vZ[-_P?zg ߈1ylo/Olyev{NuyAB =tAS/]P!x?&-7Xu1!<t}|)7]pװ~W>S y[ƆQ#=y"%|O'`4>y_V/t?xύ^ùh7}~f|=B2;}_XwN{~xLy?i3q|?wr/6鵔/E?μ+.s~!?W}g9Owxmoq~ޟg{KXx7蟟~B^x2Ͻ+ۼKo@y6KpogG^%'[}[ȳ|%ޟq9.6'}67d?ućN97p#x< q.e׾k;?j'y|z |͈;|/'j[[1)gz9GqF z^HuD^ys#܆ݼyΖW'.A\{WO=kɽV ?y>­f~RKtnW_?]߁{q<΅x9B <oxFu:㘍?uAw_XqW'?}5"?`_'O?>^zcW~}/Ї+~#?vw3秝| {vaW/މErJ?N}꿇߹}Qkf<7#ت/2l]?/X7Kκ~kgbo?3wnq ~}jow<n?0v_~ ~kEȏ݌snwόmuVﲼWiO@B9e{W?[?8o؝ٳz[ד%<+fJw+\xz/y6;OE> {op_n8| %Gpt8> ;}ᄧpzϛqt3|?~<= 3=?Gxn_aw/Gv{=\o{Ol/f>?!qsAShw|8p~yl@=M'dX>2v6gNq h3_+ػȋ@^psB\ <C:Aҏs_(M>noz~pOBy*?c<^!xM_2~G7MuW/'>yWWj8z(o7_x!}<P&o/p%C:µ' |y#wzCQvcW烐~ov 9x0x<:)Czy\s?pq/vM^7{ϙy_?S@>{ ;ż.|<_{ :d޵/b ZS'`'9&w\mLlv1 y|aG. -zKQG->~S__'&࿃x -!.  ' ą ??/%\78/?k>uS?~z?\~8㾕?\zq/wCn\U}7j=zPm=nB*?}7#>^~O|xzѻ>Gqhā!:0 |6}prG$ɼr|<qWrQoC~Yq5]̳ QL~{=v]NτxWr<#OϑV{ulο)y]7v>!ox 1nqI >gO=n C;<#;w~<_u?k?u>xg%kxY<^;ޥw879 xC∮ȟ3sżEۇ] {p=ߎz?|>o߅8 ];[/^|,į`߀e;Oprx9`7|/_y x# q\?=0<;籯aүE?+COÎYǬu=QY /κQ/8 Co~x>(>z C7'oc9x?~Пv ;~ ~Nø B>#x|~1^h7q_Ϗ_7Ge~B^y_//M8_#WA ~yr 8&J!% # Sɢ>קO_.}<e#.^E< ī۰IAPV#yUW'u/G9! yCq?u <|^OsA[]|A?ϘF_K>a_kmQCᏐv]nE ?du 1^Q<o3/wx2^'qyEſ'=qa #Wy<zxr y/ >z/$P?! TS=?1&̿ސov>ȇŽ$$ډyv؉;'xU?B 'v ׯj@GH%~T?%+{`3NbOe9 {Ƕ5/N]mggtwQ?' YOκe}؟g>?>kz_Kb!/}B=σA'gyקΧ8'q%0Ϸ/3OqWgq5E@ y߇zoe S+A*xq=ȯ(W@}".Ctί-y vFO-_< 98gؙWm/^z!u}WG}{ =nL/r;t簋/e^/~9OϺ%׷{yŹ~!h#~{M=;~੡n'>1Nx ;|t5o\ֿ%yw ^3p}^B>Y]Zϡx[G'vyF>}js^s@ yuWlv  _ aӬ> ?T7=?هvt:qwA(?./8WqG8={9eNe%b_N=|q=8ٿ.qo=A y޹F;#:xW-G%9/8sѿyEqn|zKB><_KhWɷ8YzyO0|WY̌络|XeO*+#!g/_2 ^<_ς/4/!# _-qiOƺ?`XogƼn\̾'E |:?/<?KP~&kӟ'yL'9 gYܨgq~?։@4=9Ggyxxnƹ:O={+qSr31< ڈ@mOCWg}ù3gr< ̀'N|ӮiWzG׹h/p=9Y{~a^)D}]X4˿7?*Q_A ;qdK{snG" }^ g~{pq'N=~8gĹ{?(}'Oy(</'?5]9{z<~ľ!o}9'[@s"+'>^Lj"ΓW^'b=]ùtEs= 2!~8O7ϛՅo4XBu.x. ~b}R~+'yE*pP зFo7B/uqA~}|GZ'C0?fAAo݂8I3}o}a:?`gfhP8!|} q;%-'=6>1SeoO^v. S|=.W\#w+&g Iy 8G8OD ~"/>7jcP_J^,@.kaW|݉xas`!~+o_D| CvE8aסO n@_|3%⍌'"x S|א~p蓋8xcX8~*YGU\{2xY?\CGw?QD~}6o1jxysnRO=BHq;_/a(<߫@B'5ul'=}WɻC&>ۛ3Gp|:Ebǰg:{?Oi^+{=^$<?ہf?(zއvO̧OB{[FVhOPP?q" qR"6?d]#2CN+ŻC >{WN<.-7'E]߲~8Ϲx?RqaG }u'^Awq4y%n?1N~'n7p#y},?֭g-7C?lq^O̸%5EK$~6.s؎CǑy";2qc7 a0gG܊wJ^?ǿ/B~mzf.y8O Cϐ[kȋ~=ϧ\de< x8>`~ ϗϗ?@?I?|3^uecV>G|!̿y6J@~qgo=F^@~5 G/^}\\`g}DxWOYXoyخ8:ݯ |DdO`]h^5އs]~x! /[p3W|⸷fqďXBސ7~S3|~ F=x>puӆ9WC|}Y9G`^ ;nc?f<ށǼ7C` ynwqoxP\_<ۍ~lx~a9/b}}E8}?e!:p.󓐇b*-C^xϺ{z 벏gE8 wݿ881W<ܞg_D7 9ϰ|{/ ̑/&;c?A~s=}`7z)Y|c1s%ou\g_<߇g< AB>] G+5!ݟe*'~j_)8C;yD_CNgYԝx賂:븞zA% x}[eQ?a%?b/|^yגa= ^s}<ۅyx}u?ߨE/.'óC/<>|>[9Wyds\w:ln>/sǓ|(KЗ?7௻~8uy99 |gG~[ k蝼"yߟks}ͽއ:qx?Xd&KCa~ϽbP] d_QԹ0j^:EA8z\~!?? E=)mG+P_xW C>CA/\Ѿm˄?x5o&ͯBsoBgB=6?p1?y\l5y~q\<ܬ/z_%̷o Ч~m9}˹PÇnϘ\>Y;׉G:o_|+zoio8.xl)7~6+kԏ@ !/5ˎ G|3`7%+=Îg%=D]Igb{g+)|Y 7,OA^.A)ǂ.'㐗qk_} %߰>x 1?"o&/?[{#C'ϸ?|@=sd=yux8΃1I{E?ۿ?AV',~Ǯ;w}/ סO?ow?//0/89;q$O<<1mo@0#_+O/ 9nNYGN9sN>+P"q>)"@~'y0쫂z .a^ 4Ѽ>?pS_uء~OOğx;Q{9??W.Mk|hE/o{`9c߆Fy/Jw͹e\EfSM@~ u"^`+yc? ̽>~^lvEw?/8=G7Kxϖ:s#D)-ҬwEWqNo8_-a\q7g+9}ѧ"{ 4:{e|狻ü(PynsΔ+lk+m*/uWn3_?\k~j/=vybe}?m~fG{ ~*T|pv%x^Nj?y$>`Ɖ_u|?ߜ P7@D>q^L?v;&\"ĭ'xPy" !yu_ [q>?s<ƾE`u1'Cu# =/2piz~:>/)yc7yQo B8ڿ8Ա#^> e6oc~u.;q| _ ec9g-鑧C6 B}|/O|(uB܏|Bο|>>V6scFQ3N)^}qi|oΧ'xv?W"x\ &ϧW |w ǟ7qqXrc.=(xgeџ9e>y%38(J+pn/?9ϋWy ݈fsWfb[{Գ1F >q!ăs>,]pısNA=;|ev,Ǔ?kO~~^&. uW=ށ~ 5sFqyTYq9Y9./"5ᓇ x,cy0__cjkET|?F= 4z:_#{yao?e9s|\N3|% AG:>?C={q#_y {V9P9.ӡO۝'բ/9[@ޅ|U̯:g> D.Η7sCM'8ߗui#s=>jeSޯ~f.LP/Aρ_? }yŽ> ~+<﹜3`?l7~osy޸|WEw!>菑$ y_G<r܇p.'#dss}y.sg]apg;~DueY~y]_QOu忏s\f[9}}yخ|'u6zO뜧Ⱥ̟q}~eyy$벏,^K ^~={f?ׯ??!? >s σ3}wyr?|{_C]ۡxAƇBC }Bx8{ Aލr|I?)/wd}sbu }|򾒹>,ϺXAb^H:O5x /?s}Y'z|:9E #F ܞ#n>ruqMs9g|\n~o~_g=9cy{ p6x~?/ ?G[9cF9 C}\N٧sv?}Ȳ~ny|Ns(\ؿ.[CZ#~y'q!|&D,yI+B]"ϱ?7 y_A;įC}&*Јwz/? %Uʸpp`]x-yB?y>g!3>#Cr~w=A? ~Yg9_?:&qxz}58yf`^cns$3_򮗭?\ȻŹCh7f.8Rs!?zr#b>sw_NNӃ|t?&_3L0?qNso9z*S׽y㣜uņ/D}>=Vy椂߀r79Jc!utϏnd'?33Y.7vjK9Ҙ c x2. {.Va~窡^sO}Pq#8֎__ŸOA$W;`+e:}g~~o6=~ñ7n{!lG{jE78_qY=_oWzs?+t ?O`?vO .㪿>v~s{Awg_?{![+/+xMw>kһɧrE2{iW{ ~9}w7n=X׊gη<%$~xχ ߄y>]ByxiGÿD~8 ĭ>nF?vY+oO㇈DZ`_R+{`}Q Y#O9?B| O11Jn sWy:E=P] q ?kaNtχ}Ⱦ'ߌ--dCX?# }sE/X7KκxLN^/8l 7z~6J> =A[v9`o}xs{>vWފ~\𫽾~ʝ|ɮZm_kw>B s0xKo#cqɏs{y?w>fst D:m|..]~aw0yPW9ǘwq<0_!Dո"Kz~ >MznA^Sgvc?W~pTJ}T0Orst{q#Y_līY~?[Ϣ^f;-nB}0@}x-}8'I?qڛYqO7eoXDiQߎ<yy5M ;gqqAayH}+o5볞 sIF^)xۇÞG~ Qo>JK_`.=A-s1OzҬ>'Py6x^+>~.KȏfyE ?E}yfyVNrg| K(0*a/2c αAX6?{!!'Z ^=#χ9%/ȳ?opy'Onk<_~/O+_rz a^s^<+濡u֧;k'ϕD܎`_ojޗxxԏOcV?u;}ou3z|s==?s8o}u9l ˄~Fu!/?+#ŜOߢO?{3DŽgWna|s`o'o9vy|n_|UX8<.࿺?)=&~_ɸYoG_UC;qޝA'<<>{Ո#_x->Wx <g{|l#x0_q7ОGg_<<`{~y`ƅt~ag|/P;w/wo2WȹŮP@ŽpYM*Lq.=>?mާ_Ln:G>o\O֖ωs`#=sx@yG~~-7 ,Mޫ)s3F_{x?8p𖐿;qBey08!)Ϝ/83u5ɺp9e~Q'H/rnMל7ϋ?=o>҈? ?'?{??kگdMt~B~*GwFʉO\gC6v-OsDK̽E== z/|iszbN޵ƛ7ѧj}@0W.7GPksgy_Z'8K~s|l?p{ϰ[9"/W<5[au77=_p{{.my}pn/<½Ƕv~ ']/o_l~;q'9_/w߿i3Ϝ+.{b~_xO{_xv/ ?uat՜w~ܓgowf_낾ѧ?y[_௱+{d^==~:<^|(cӎ"Oۜ?Jޱ΃~P`uz3 /<['&NNḼ~G?b.鴖`}vqO7{?YzOko-W}w?Ţ_*|=i-[1ٴVJ+gLhJi*i='UZ-znZKi 5Z3Z;uZ7^KZ/^+zeZi*aZeZV(qZuZMZmZ]ZNk^ֆiv)L,MNL.קQZIZoHi)76Mkޚz{ZEZH+Ėimֻ:wIk۴KimzZ;>֎i}(SZ;vIk״vKk#NobLkNk|<}DZT8 ˧LZMkO뀴LsikZO ii}1C֗:4:<մHȴJki1iqi}=ou|Z'ubZ'ʹiַ:5:=3:3:;O?:'s:/u~ZM?^Z+uaZQZ.N'ILc2=}.\$sI璼%yK>}.\$s<撼ϥ3Kg2d.\:t&sLҙ̥3Kg2d.\:t&sLҙ̥3Kg2Y黬\9Z3%=Z3%=tN/H2/HXFSk$=FSk$=FSk&|\3 Lf5>q KmevRh Ë /Fx1Ƌ/hS启J2jWc᫖q={0aøqG=*Qq{TܣLj{Lj{Lj{Lj{Lj{ǘ{ǘ{ǘ{ǘ{ǘ{G=jQs{ܣ5G=jp{4ܣ hG=p{ܣ-hG=Zr{ܣG=:q{tܣGQ񲌗/x9xY&^2v+c2v+c2v+c2v+c2v+c2vb7,vb7,vb*vb*vb*vb*vb*vbQ6F(vnmbQ6Ʊ8vnmcq6Ʊ8vc:vc:vc:vc:vc:vkb&vkb&vkb&vkb&vkb&vkc6vkc6vkc6vkc6vkc6vb.v#U<*qϸg<66666666666666666666666666666666g1g1g1泘NG@K_Wz$׍nuɖ}峍ƲX˾cw,e߱[˾[˾[˾[˾[˾ȾȾȾȾȾʾʾʾʾʾɾɾɾɾɾ];u)M^Wz$׍n[ʾ+k\ʾ[ʾ[ʾ[ʾ&kɾ&kɾ&[ɾ[ɾ[ɾ[ɾ[ɾ;}ƂWcXj,x5 ^ƂWc+ұXj,x5 ^ƂWcXj,x5 ^ƂWcXj,x5 ^ƂWcXj,x5 ^ƂWcXj,x5 ^ƂWcXj,x5 ^ƂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWU-xU ^ՂWu|J^X^׭X^Lkw,e߱;}DzXeZeZeZeZeZmdFgZ 3WxXUɕQQQQQQ$$$$$$$-}]kו;׵nu+x]ʾ[ʾ[ʾ[ʾ[ʾkɾ&kɾ&kɾ[ɾ[ɾ[ɾ[ɾ[ɾ#7dc$hrL^3$U?cy]k~Y4ߥ}kO#\#\#\#\#\#XV4`E#XV42X3*Tၤ[CP>FQ(a0 |>FQ(a0 |>FQ(a0 |>FQ(a0 |>FQ(a0 |>"VD,ZI"rhEЊȠ@+"VDYɳ"rgEΊȜ8+"oVDڬYI"rfE̊Ș0+"_VDlYɲ"reEʊȔ(+"OVD,YI"rdEȊȐ +"?VDzXɱ"rcEƊȌ+"/VDZXI"rbEĊȈ+"VD:lXɰ"raEŠȄ+"QD,FI"rE0`("QDEɋ"rE.\("oQDڢEn~nnn^nNn"Ed+HV("UQDDEy"Ed)HR("EQDE"Ed'HN("5QDfDy"Ed%HJ("%QDFD"Ed#HF("QD&DDy"Ed!HB("QDD"EdH>{("PD案Cy"EdH:s("PDơC" EdH6k("PDDCy" EdH2c("PDC" EdH.[("PDfBy" EdH*S("PDFB" EdH&K("PD&DBzԁ%u`IXRԁ%u`IXRԁ%u`IXRԁ%u`IXRԁ%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%M`IX4%m`IX%m`IX%m`IX%m`IX%m`IX%m`IX%m`IX%m`IX%m`IX%m`IX%m`I-$EˋH-/"Y^DTy"EɋH%/"I^DWY"^E伊Hy*"UDnx"EŋH/")^n%m`IX%m`IXDʲez%m`IX%m`IX%m`IX%m`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%]`IXt%09 s(LΡ09 s(LΡ09 s(LΡ09 s(LΡ09 s(LΡ09 s(LΡ09 s(LΡ09 s(LΡ09 s(LΡ09 s(LΡ09 s(LΡ09S {N)Z&PCar9&PCar9&0kWCar9&PCar9&PCar9&PCar9&PCar9&PCay>PCay>PCay>PCay>PCay>a)R0Ka<,yX a)R0Ka<,yX a)R0Ka<,yX a)R0Ka<,yX a)R0Ka<,yX a)ò*JR*JR*JR*JR*JR*JR*JR*JR*JR*JR*JR*JR*JR*JR*LLLJ ^ ^ ^ ^ ^sK2+2+2+2+2+2+2+2+a&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeW&xeWU%xU ^UWU%xU ^UWU%xU ^UW`T%U FUQ`T%U FUQ`T%U FUQ`T%U FUQ`T%U FUQ`T%U FUQ`T%U FUQ`T%U FIE)e%U FUQ`T%U FUA0*J0*J0*J0*J0*J0*J0*J0*J0*J0*J0J*J0j$5 FFQ#`H0j$5 FFڍDj$x5 ^FW#Hj$x5 ^FW#Hj$x5 ^FW#Hj$x5is-\<"ϵs-\<"ϵs-\<"ϵs-\<"ϵs-\<7"ύs#܈<7"ύs#܈<7"ύs#܈<7"ύs#܈<7"ύs#܈<7"ύs#܈<7"ύs#܈<7"ύs#܈<7"ύs#܈<7"ύs#܈<7"ύFo#ۈmD6ѿFo#ۈmD6ѿFo#ۈmD6ѿFo#ۈmD6ѿFo#ۈmD6ѿU#x^5WU#x^5WU#x^5WU#x^5WU#x^WU+x ^WU+x ^WU+x ^WU+x ^WU+x ^WU+x ^WU+x ^WU+x ^WU+x ^WU+x ^WlSD)"JQJR:E)Nt(SD)"JQJR:E)NTR]Jw)ߥTR]Jw)"JQJR:E)Nt(SD ^WU+x ^WU+x ^IE)e+x ^WU+x ^WU+x ^WU+x ^WU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uWU'x ^uW1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1prL89&N 'DŽc1a1sL9&~ ?DŽc1sL9&~ ?DŽc1sL9&~ ?DŽc1sL9&~ ?DŽc1sL9&~ ?DŽc1sL9&~ ?DŽc1sL9&~ ?DŽc1sL9&~ ?DŽc1sL9&~ ?DŽc1sL9&~ ?DŽc1sL9&~ ?DŽc1sL9&~ ?DŽc1sL9&~ ?DŽc1sL9&~ ?DŽc1sL9&~ ?DŽc1sL9&~ ?DŽc2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&SLL 0`25dj%K&ӗL/L_2d2}d%K&ӗL/L_2d2}dҁɤI&L&L:0t`d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%&M:t7o2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2d2}d%K&ӗL/L_2$v~ ݄no7ᷛM&v~ ݄no7ᷛM&v~ ݄no7ᷛM&v~ ݄no7ᷛM&v~ ݄no7ᷛM&v~ ݄no7ᷛM&v~ ݄no7ᷛM&v~ ݄no7ᷛM&v~ ݄no7ᷛM&v~ ݄no7ᷛM&v~ ݄no7ᷛM&v~ ݄no7kqeb(>~""Fб;' b`Wh;oooooooooooooooooooooooooooowNx~{'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|'?|r \'>ɅO.|r \'>ɅO.|r \'>ɅO.|r \'>ɅO.|r \'>ɅO.|r \'>ɅO.|r \'>ɅO.|r \$&0ɅI.Lra \$&0ɅI=x]vew]vc=vc=vc`v?`Ӑ1ɅI.Lra \$&0ɅI.Lra \$&0ɅI.Lra \$&0ɅI.Lra \$&0ɅI.Lra \$&0ɅI.Lra \$&0ɅI.Lra \$&0ɅI.Lra \$&0ɅI.Lra \$&0ɅI.Lra \$&0ɅI.Lra \$&0ɅI.Lra \$&0ɅI.Lra \$&0ɅI.Lra \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.r \8!pȅC.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Žv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZŽv-haG ;ZѢ\6rF.Eh#m䢍\6rF.Eh#m䢍\6rF.Eh#m䢍\6rF.Eh#m䢍\6rF.Eh#m䢍\6rF.Eh#mDž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\Dž=.qa {\7Ǎ=nqc{7Ǎ=nqc{7Ǎ=nqc{7Ǎ=nqc{7Ǎ=nqc{7Ǎ=nqc{7Ǎ=nqc{7i#7qȍCnr8!7qȍCnr8!7qȍCnr8!7qȍCnr8!7qȍCnr8!7q m\hBڸƅ6.q m\hBڸƅ6.q m\hBڸƅ6.q m\hBڸƅ6.q m\hBڸƅ6.q m\hBڸƅ6.q m\hBڴj#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1mhcD#ƈ6F1MmhE/xƋ6^mhE/xƋ6^mhE/xƋ6^mhE/xƋ6^mhE/xƋ6^mhE/xƋ6^mhE/xƋ6^mhE/xƋ6^mhE/xƋ6^mhE/xƋ6^mhE/xƋ6^mhE/xƋ6^mhE/xƋ6^mhEVmӪmZMi6ڦU۴jVmӪmZMi6ڦU۴jVmӪmZMi6ڦU۴jVmӪmZMi6ڦU۴jVmӪmZMi6ڦU۴jVmӧmM6}ڦO7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7Ƹ1ƍ1nqcc7č%n,qcKX7č%n,qcKX7č%n,qcKX7č%n,qcKX7č%n,qcKX7č%n,qcKX7č%n,qcKX7č%n,qcKX7č%n,qcKX7č%n,qcKX7č%n,qcKX7č%n,qcKX7č%n,qcKX7č%n,qcKX7č%n,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qK,qhqhqhqhqhqhqhqhqhqhqhqhqhqhqhqhqhqhqhqhqhqhqhqhqhqhqzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzc=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8؃c=8ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=ۃo=}o|>}o|>}o|>}o|>}o|>}o>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W>x^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xǾؗc_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_|߾ŷ/}o_LbӾŴ/}1i_LbӾŴ/}1i_Ǿ8ű/}qc_Ǿ8ű/}qc_Ǿ8ű/}qc_Ǿ8ű/}qc_Ǿ8ű/}qc_Ǿ8ű/}qc_Ǿ8ű/}qc_Ǿ8ű/}qc_Ǿ8ű/}qc_Ǿ8ű/}qc_Ǿ8ű/}qc_Ǿ8ű/}qc_Ǿ8ű/}qc_Ǿ8ű/}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xū/^}W_xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<xc/{؋^<x/xƋ7^ox/xƋ7^ox/xƋ7^ox/xƋ7^ox/xƋ7^ox/xƋ7^ox/xƋ7^ox/xƋ7^ox/xƋ7^ox/xƋ7^ox/xƋ7^ox/xƋ7^ox/xƋ7^ox/xƋ7^ox/xƋ7^ox/xƋ7^oxƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|xƇ7>o|x㣧}LJ=>a{|LJ=>a{||8!pȇC>|8!pȇC>|8!pȇC>|8!pȇC>|8!pȇC>|8!pȇC>|8!pȇC>|8!pȇC>|8!pȇC>|8!pȇC>|8!pȇC>|8!pȇC>|8!pȇC>|8!pȇC>zGOɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||'>ɇO>||䣧}>zGOi=}>zGOi=}>zGOi=o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}o~ۇ>}廿?~ן~~>x 2 robustbase/data/heart.rda0000644000176200001440000000037011754203337015134 0ustar liggesusers r0b```b`@& `d`aҬE% @Hy\88Aig(;@hm9vҾ 0qOЎPs^Pڐ>ETs|S(|f/ Vb# Vb bT\ՀX=sS p A2R33J`rd{rNj^zI990s`\)%ziE@+Дs R@2robustbase/data/wagnerGrowth.rda0000644000176200001440000000257611221416617016515 0ustar liggesusersW[lUmwۅ޷iĦ vRڞjKd×+֣DR=(MQ@]IH!RHb! lh1*vS!RJԊj ZR-!H:R4e }ߒٴ{hXSYFMI #縞nH ;I3*s7_fĉj^ ^sЙDNQ=ؗS?0w|rg]隅K'ؿQ,SߐVQo[}=KMztJװHC|~9=PqNסO?uฬa:?=?қu|U_Dx_Z@d 7:vzz1Yҹ2`7惸j޷ &^މwH;=ʡ;,۽/d~7++Ǿ fXQ`W?<1WP\){NqbA,pUOv_#.ԵWI;.xS=ԹW: (&h-~P:p[=W7uڑj|7knu~w(7x()WqO,;x H[ĵ/l0%fouBdϓ+- ai+3IoIW/!:9)`Zs夔v%wKP}3[Ob[ߨ;)EEwռ8s9u A5yM9'[uj4B| q[x`6<~i$^-pޟ[Eg[_6Wo|6G^G<}}} q~g+˟G/*70~vWw>k԰̋;nn^됊ݻ> +`mt|FU{rcvbsfw~˰V8Q\arobustbase/data/starsCYG.rda0000644000176200001440000000065111754203337015532 0ustar liggesuserseS;LA]nNmI&l!\p$&PSk555ZXQSc,vvf̛O|Z9*c,9y&5KԛQ7D'cIWxo8*eek>惽1827;3xʓQOhۄ/&p&|6yW`'.2X?MoJ ;4 78cSOLʦu -Z;JiC>Ju~5Mr4'%h's9u- GMbur̳C/(4 > M{OIץ2?]x[?ǯsjkhռi\w㱗0XrZWa7,;2m DX.R}ɼrobustbase/data/ambientNOxCH.rda0000755000176200001440000010463510737747431016334 0ustar liggesuserst8o?pTdoez;+2*iPQʈ"BIvJIFϯ:9bHCCCGC@KCGO":_44l˨#֬gjECCI}LCwMh=S)ĦĦffĖĖVV66ĶĶvvĎĎNN..ĮĮnnĞĞ^^īW&^MGGOO@@HHx qqZ!!ġġ'^Oxqqq8q8qqFě7GGo&LEEMMCCx q,q,Vqq ۈ''''o'NLLxNĻw&MBBJJFFx^'ONN|AęęYYć&>L|QLj'>N|IħO&>M| q!q!qqq1q1Y%%ĥĥ'>O\F\F|Eė/_&L\A\A\I\I\E\E\M\M| U55׈_'N\K\K\G\G\O\O@@|q#q#qqMķo77&MJJFF|]'ONNCĝĝď?&~LEEMMCC q/q/Sψ?'~NKį_&~M qq['~O 23t,-9+ri&X>3ax2%svM"AEg -vkՀ'kEsK @| krTl6y<=Ԅӣ}~ipW ? uL}Sa -uR!e^i7[ Kq-KJIX4=/z:!Uα,ING&h fX=!"1=̞Mߤ "!u\H&2wm}Aya?8jAt|}:ciM]Y7lI`[n0]̖}d9W@E-=VЛW1t|*ڒrO'-rNJ<%1U^NK)=ABp뚲ы nr:Mf Y@zѝүs}}rQoOm$\Qӯ UVU[fɰ##, cq/(7-#V_\- &7=LEdƓP.mk N\us̪|3;9HYaQ O#HD^3 2M>P u XNFU-"\ !k0fwLh\ X`$xvajH owdyYƸ}r9SXZ5cLGyK5;#ryRr@W %PQWMCU)|LhtWe9+Aِ\ȅiOrnt02Kϯn7>"oņ'B-ne0CwJ9LRtY ڱwACC~v]?ߦp@dO(4x/f&l#Ɵ,qVv {wjT}9$j{33 tƬQ<8+ىw\xۗG^_( /[Ҏ$ҌнgA01!)XmdvGW C2YDTk8?/.*ӳڶ/2648@#hTn1 kSmgƧ_fͭ9ՐOsH* 7'B%sj U挠h=yU*ujR j}:"),9H>=6U4mv\ [$FAar(߸?2y/=l‹vc}j j󺮵BYmQ8ӳ U0wJo?w ner~e mr_֠A4D2[=?OY 9Ph]fzhoSVoKS{8 g?s!5-L: k a6Hʶ7n =0;_p6V!4.X: yʰ t8y^̾]MPq؜7$ o)TքSYP~xQ SW`ٓ@ӬA;zjF̦4rwڄa3C?#mӈGvǵPñRϤmf8 |aֱc6nα< 5ءȖMEp9nc l&2>} [}&!ƇӒZ]ߘa:KzW7оu2 w:_H#WѾ=0`c$ f,๵Wp(@BȆ>x2w|/ 'ݧ;K̦*pwxf/ƪeR dcǙpﾯ)S>Ő>~Pf393YWͮJf( =V1ǃ|=PPg+Lɲ ssY%~)'Xt-Jv,_3K 1\vz1 S DŽxEy9SY ~U"`1^55mڅIyμ{+-̓J& (42è~zE߾[ua/TѤ_Ս5TP#\3hDoJDDTcg9 4'!|w!&ô; 踍q؍++6"3fj߆vfImZ6;*ŸSeފMRt 0zf=Ns}tl^) p((7M[!enkߺql{BXyY5K%ˋFjkoU;BҺڳP{LW$t +`aIh4(7+w=ZǴ_h!M]_oC[SĔfzB@>P9Bh'WCPS Ď%5ˇ7Ej' Q!PA{:㛬ض =ڗbk&YYd%3d8C _LҦ Pu'9s9 LPߠ,2l.v%Skm $ׁPY5!i ?L5e5"ep[wN}n!z3>_׽*g"ۡ%g9jH,P -CR;9Yy;52(P}2辡WLEu;X۠;D8z[׽ űϹAf;ϚДݛj?U-zLt%(x 6Cj?30z'~ZMyV)uYڧԎ2CDlhbc;K#?@gE[x_e SBѕw UŶ@_\NJ@R.:Ho]Ex T/ Z~\ Z1HJgמ@ù\OH}zc(-}>I 5 Bmڇ?fW u,c>oVAPH^򬆻okj" ,M?=<ϻ2=Q &~bgAhdf\ cPc@,WfY~R_Z=DMkrq@2-rTЩJ\ )(>3r:J몊z{ZP9~ 6?7>=z$Fc9VA"fchJ[BCAE Pf:ѿ'XY6Zژ_1]ЪQUT5P2j~2nL  Q4; | '<#NA2cM4b&7H@!C{H6+_億 [a\15-}p%YE%w>sZ\#Jcr>U~ %yݱ>V ,T:8rF6B-U^W bεCpDs'dfω}_OЈ~9LGfAxG/Ό}HX˸j/T']5\Hjw%B{I_Ħ @-~Jr. >$94VVQGrz]Ưmգ<s) CS׸i -LwN[ҘY"t>]mhm!lQsa5v:l$%4k>o>3Ft= 9ap9&χ^fS &.1mQ}ͭ6t4?ajSB'OK}C?)o0U ySPVJ:CbP{1 s _`o"_= Es!1h̊ 0w, wWe.) AM3x@ 𥇠ʼZAwWsA9GNcRY`̨^\6\7 m/MᏏ@4HXT, 6xA)EL3ݒdָM۰4]b ёp*՞d\HU=~t;AAi#:v'Lv=;ĹagàةA SzGW:oNLce7ۯÒWg_Sȗ>qA8ƞa{y½xg:@n/}b2>/.A[9Fm3d+=\\ 7 @rC"WЏRۚv@,e]eɥ`JM{l{uKz;V5+Յ*UU{a fFn{:`7ڃbz5ʦ(ԽxTrǡ!&qyn3d|WjΓ|I1kIa΄5~k@p~! W0@u˵ϚL5g\0Ӱ (d cRb8r 꺡΁+}맯׬ a҂pKK⨬YBkq+6Lk&5$!tUeU:kW2U>$sa}(.`yx/!0,p7x(xJxhW] l:16 t m+o9{n#ܙkGM/>68;+= Kn'JEG / +܂ba[/dKoKvƢ4G4]ӛQJsew 4ˋw[ǡ5g5zsx^zY% Enr7a4f8ja BUa˵5[^PnkŠGQkT}5҅f꺰u s+{نrE 7`P*C`>ް!vsTy޻Dz-OaBj%X4ia(;&lz,~0z6v/~pZ$oVF7pG{f^X24ݝ/ь6V6r2q10 ^ ;laM:,nant4*z fr-,8~\KX8ײOK` Ц0Jzr뺚~:KS`}3(\R} ?`~mՁHAXŧdbvNp|2=K3;ha2?%o}/njFILS/M;`KYT "X 7\8 բtz|L"/>b_rs;iTʷ7 ְuZAX/:Kݻ}7S`gh%iw_X.& &mKF|OW0#imU᫡Kg|Xa8a\Z'LẨ4weL^w_ϲaH!A\VON|jQӗ0Q?U %n'Ck]fcp^dς Vka{V kB pQM՛sɒ˟1٨g9#C FPQkYaӇzS?Yg_E0`e}SF vdcmO+Qڪv{+m7;mKopz4h1 n&FC ˏn36sz+LZg- ~QHXLWD2™ŬMm\/RU݉0 XMKmBCJGd˾3oxedě"az8 (rNCW>pU?xCE {WINle`Ki6Hk{WAo6vo9^y\Iggݗ7ۭ/='j|7^9uQ ƦO0Z+D 'CJbQe*x[8s\%-ZʔL WE2e'2,l7!'&uˡwW˧wWo#[I%JǷMs["r(nD ZXW5~{ طϺcr8k$Y/>;  u;hmg:p!W0ٹ'#d̋(~2 L}Gji.y(mg<obY. c }: lBZ۾ 8{(n2LMte'D FªFp\Ζ>[J42ClCoG4"QK-BĦإsX}m( F( iy!$Ÿ`9py,[dd{P۵s~у0Mm/!UXaXbR5ֵl`1jW͈_/\SOs`~]@rY$?VK5a7!oyb-cytt$#]m󗁯Xmx *1^χ,d{^%Puګ QR<òZ[{?CZiy w,r̀PMԱPk3 ٚ4O^LEO!q^zA ˧{C]7IpCn2m+ ׻fW%=&VA&|Ze|̹̞C_AGSVqDtS.@OI\!_ϵ;Cϲ:_@uGMup<:IL.wg׼xÐDZ6S)Kv&p(Yp߹~}vFH yٷ*('L#`:-#.cZQkovp N?oN`~w)3pb./WBg'^_^y%Xtj;  mB8WKg) .jPi@O(C&lBL?mOhe:}U4`zw,<޵?9&H)״ow;w]E%?&g4Y|ֿX'S3̭:[} p+=E9Vg;8=ޮ]6`kIp/L uZ&ܩo΅pl?_SC (iM,:Sn9l6'naA5,\0)P v @][Ay[ԫ);IsS`dܢ-,z=wAc!R}Tc~{JZ!v%=,:x R7 h0|ҁe /|\++*sR`wF=y0ӔRWwr/l}ՍESCqڑ' l>hƯѣq3dB۞y Π_Z wypnqXV`_O)\og,`^6 4ɺc7ySѺ B;Sej󥆚t{!6z)nXJʨ X(OBE9yv7¶Sp[_ρ⽰̃waBUYpW{8~B3w'-xjy S/CEX(3ݜ ޅvj6p٦}b9l[C'EmY1^`/H]J| Iw:Zxy,pIIJO!'8n?ؚ  Ͷrʟ0Q\,` Ak ڶͩ\/8ƀ>nB<0x8VLI |:kM M` gˠN!zRLԕ|ܾōK..$KSugX.0Ȇy@2f!`X('9MgsIj?1P ̻C05J IAP99dT>B$d7?Oh4B@BǟzwTQ9 eI Ry_QhT|\ڭZc ^:-l?]?n6̖٠# ,z[ BABA6B#</ ΃gy cD ?$/ o߭UY,{hjzK@6}vvU< {>|kWO4٫S)&S?C*)1X :QX.f@VCPn:Z;i![}q) z}qPobU#pɃa$A ~5Su0{'.J=l20}pXFw17rdhE%l{l(%ݦjId<> = OVxvJV98830=Ǖ*9dP|%L2ȋ A6\>cAvм+9#jZ_>w< &mY'?oҧ@ADϱvh6\톮V/VXrp}3v|Ga􄜪5̌1A2(6, AԣPεX\I΁|ݍC_iˠ'd[ /B _>h@Fea9&O UaqF9@ZIھɧRe7\幠ZR({G-Sɇ+[k^ ,+~XN[* W|NA4V/})XtGd)\ГVcꁕ~ً4qJ+-f΁Dh iA+'Xw{fhpz_{ZQuo>eCNǶ&r'~+Fq]h~[Iϒٖ^/8&wnPNƒPMdMCWEO⨅`0DӞ " ȻntXkO+$0зbd#&d7BmyhU^󤮳})1:NyˡJvǎ0[a4L2]6Dh.O^ UWL5mkgC!x'ͼAw56^+CFP{6yd:lzLSyph1J^x8 ?\g?RNZ` 3 4SN o&m ?Y'AlG5͡4=[8#U m/OC%uM@%5r~AnX0c~ZkewKt~Rm_9!)#-% # ՝n'h8f.*ѷƏʿΩBcˡ!}RnjO[.Dh*mu:^{$Kr>7^!*H/k uvcA5h Y`tc(mV&P}mB3ns {]>9 ORcfv|ja^t*k^_ a;_@C ($ʯʟEg͜B(_'y\]ЊP,I-އE\Yx^k:s[v@4\4&|-ׅR:(ܻ;E]3rXD޷PL o Jv}y׿g$4mEhŅ @ѕVJ ow6Q7͢YK7[@[GFaUa2{ŵj9Z< 3͡뼡tɏ][`X &$VeXq]MS{lk9z8LBv.sV< _ ױhV@]3`[(GfNy[Jߺ^1 >6NPk,?-KgG pT4L5unJ-avLxЮ1"6X Ϫ:rPTTUϴMҼZ6,,6==s <羆ﱅ70vY V_w]easR{8u5t?^% h]V#B*ӣ'ȧCӰvW`,+MU1K@aa* K˙*1aq=\B3}K|UB,˺,@{,D+u|. Ai+gU,Fumn}eAs0x,!}a6y0<4|o߭!2P9j ˷CC,؈^n?"fm^lPx1Wj`Y.Zw,ߨ vB#HXit '/RtaIhZ 3j< +"[b%_ˋ8Lp^Eh[\}Q6찜>&"3I5CSI+=,1mCp k>Y,蟗$nn5E!𫏢ѻ5Vb<oPjOCMscNh?4fё;-p0[zїs\ vL$7ی paY:*2,_u_`Ep*+<8 '/Wb8 sgþY<,|: 3׉?§dQj4Hߔ Q (WMZ 0T2 e[s .D< VmOZ7?~{8`'}g6&R  &I=ع6eՍيkԾ)> { /;{)j 8 - H]?/qV vZ`%خ/qqQɱЈۑ ]^`I)jCpn#^ s?_; g}Fl0}/>x<ҡA_Zz1h( UG vݒfoum u=[qm)6on gI+CfI _ɰ1v{{#pcIչ}?gmzagjd%Ab3<9"WF;LC@&ãagZ]|ЏOR{KS5ASJuI}6٘zXi?lmQ]5!|˷y?i;0g)Ž-{i=a^:OG5S ̧`^UðE:ls[&IůƗXn`h0e3Zj{>`CƞF~"2 svvX_K~ k!"f0`vMvI亳,zV\kӅWq/,b;}`9ė~#i3oCݟ/ȁ-C'kX[h/mYCEzg">QOn G5EVv^Xr5@huʺ.j؎.? [YI\h`.ydj*([eYl&9x`+Lj(U;Жc}b','WTGöM0TIW C[8}&ch3k_Iʞ=>w'Iw}6 Y) |&Qޓu0->^kUêgݝgϰ<[x'fk^Áa S%Rkml6, c{bypL1},W|Xsec\; &/䌁cbcpIL Cb@9 ./e`cFTȷE,URMj-ǵ^7n~4;(돜:% ;80[f& Wfp<,<aƯ)(u*\GIݦ{3ﬢ`&ef1Цk+e <ˈIK\ji5{oX{HoLG)j\1AjഒMPy4פ4BWd GfS- cc"<.'썚iŰ_{X*k*][OLZ\0 v{ p(jO]|h>94y4k}}c}߉,)HY*m()"R(mJ)JִH%$$Kgw<ޙ= ;srRk= )T!מ[p֗f, ୷rQo_ /gCù:R# C+ iE!|~Ͼ$v MZHI~؛`z0Ynfl?5o1#;f7{ &dPU /sak\UߡnNpۣuwtG<;Ū oe6; - ?]@jƂ0SF-J $BfȬZfEjLyf!`v܁В+3VUdDwV߼s=ӭ'_'%_Kpl@#?𱆭 cԅXK]ŐY7ŗ*EL| v;mg`Gˠv쿾/o_mj%,Tβ zdF xva-k+ `]wnO|B?>Qg:`R'(odԟ}PvkއWE|k\7-lP3wOf3tl/n>ҺllMpt/ܬXԫ 8%%Dɿ|urXKp΂/CY}YNNey@>P#ݯpK[IO‹X|GNEp Hs_XNE0~/䂿Cw5t_Znr8Ӑ|h1e؁k~e@;{!% V ?=d@r3mfr-u/GH\ QO꯿˼3,iklg[n:]a8D_aP6A`Y,ϫUÂwe)*,D[r,P$VŇ|ev0ro!`]*q[`{rOq8$0.lt _u_]`ڸؐ3,&q5˴:辋Ux"&BE<,Q:Ui.qw#Pڤ~}uz!_s3O12˦B Xcc;b /Zh|T" ѥ)TŌw^أ7^T:7 QpuvjuHn5!!+`v>W(d6hdb EtmuuޏPb>l~.j2 ]S '&*|1@qھϜ| 6嵮S >(t]ra!)lRPbb}beSNޡ:@MQ,njFߋA:OR'io"_ΣN-չzF[A>Xx!{7WBj%'K0M|,½Ey{?}L8M '\Kܢ蒮sF  (-h*/O+ZI K|w KۙFZM\a!JJuPˡy"'(/`n+sElY:׷By*/)Fl8˖cmŭu!)g/;u[ȝPA]^ڻ@o~]Fc}ꯅr6 ֿ::?/+Uo]R 2" r/6u/GY,^L[Q\S@Xv__:Xm-6tR x.rN.^pṣbCZ93K]Zp~[E WCS$D+ĠCvK{r~j 9G dp6> A=8kȹ݊ށ\ K TE[a~K@0Lo[ctv3\y 35'Yll *~o`ZBXpN; ^`g[~@?<ʈ.GJ%lpn}k-d dȀ}eZ lD)Lؓ\ָ= ]wb֚LR5z@>nEVs%,= `ɻ! ϊ?6[ ȯ\^;2ޭ#1Pg]n'G N5.ᾀ&m%0Ll_pNz7S_rNY~y1v=}ֻ`p؁$X$9zJfPֻK >'2鯰t ㊣^`'NkS|!'6d^&?&;o )'DPJ؀srH:u# Ro;S ϊ}q/R6b'Rkf%76 tkc#P,H}] }li ̋.C&-H6\j01]%.)f~!og'.c͠sykPs$Ƀ\O)eGApJmȳ>ODp^)\۔[ tʜ_f8t8m Ȟ좪'@˖PY(;0rº]@aEUFݐɦ=3@.Kھ4&: *NR>2 wͤ<4b3.eKi}WlS'tBʤҭqr>k>pzcDž:}d~2rjFz!3? 7o49Mx^SW vIh1w[bҦ!TIIbҏ 3 )::6 rN9z@HP(UF^B݄jKzhz]3Q ߿}}FOS,܆]乗U9:t{C?D}~Cr*}84nPy,WxE#vV@i C² Dυ6P rzC}c' 1[QCV(%[S"GV=l0ir*C֑ۡQW>umjc,v}DP?XCe5wO=O5rU0n9|FjW@o&9P>| f⠬iH`A)~>)vCa~HP l|jNJZf4芧8B{V{[u9 2x?<5D֜24&Xq&ǘJVx1K!z.AXmzT{(|LLE*a؝ie8\}Źe@Dt_h1m> I, 4<ϪGPvU0W18ldflAfR*6礸"8uDF?auh{^F 5P=F.tFs5r^L<%6gb7,صcBac9eC,7qj ^pSk B,]shK< @v1Kۗyjg/5iF|k2<ȃi,[.k<>PHdihO0a^Br^3O?cU< = <*3g~&A$C?ݭ5q'g}Evvʆ gqX}rs-҈~-530w'tp2]YZE'ҷRh~{z.dzZħ O桵:~<_sCVqf>w̫^EftX: _54 (*!;~`3XCP+m>}J r|4hH؂ ?Nb !0}! JZhs qs/TC||Uȧ͜Qt쏤CzK:MW~m֘?b}Y33&?`mkl3i> gҎܳ '† @xx ~ԵRՂ' =W;䍞o7y6 ǝ.ae^r8}JR;7@g=^K֐90\&Nw3t^cP2f2ޘqq/ teGARj?$B@i鮰P?g հ;y@kȭxуa[ӳPx&ruA8JatLy]5; Cc*?A\nPB]eX -ׂKy]8LC1ڴ *U@:#A&֯)$};zGx9@~5C>oN H[8/[dAv<Ɨr̾CUO\Ǝ&?w2j }cuu9}( }O m AW+7!\K'T2 xb9dNnPMry2;xeOf󎰲E}c>@ tЯ@:{ oSCC2pTkﲁ_nN-%2 1Z]ؿ'Jᆈ裗$`мW~rJvN.%3DrPVQ9'̓| |`YZ޿|T OO⮂wo:NV(\M/z> ;<#-ơ*S-P6NM:yCL0H8tE?FKwMTd((qbvA5Nfȅͽ: 5n(턡ePPo^ATPW%$rf更pM#r8 N*&v~,6mnmzլ3]E/C(i7PtT[k܃tN:DHӯWća!Afݖu@rF&Ӵ?7F,޽k\m,z&FN_}ݭzPܿ6zm`ij a°ݡ1bԺʔ js DRf<P=ΦƾR0{W,rMY Vo/`|d/O{p=@Yؑ81TJ>B 6yGtU(SZosWoBXGʘzlWV+ w-| s̆)ؔ Xp?"vI~QW]'z]dŠ^?e` e3`}~lsp4:2crn~D̤yQV@kmS;]! ^n۶:o6Q&α1rH^:kyZ{E&0n]as}su% < oo\Oivs]#4(5L%?Qmc=S}P9PL_tywd(rL &>DZ4cq&w>Km~(OC?{Ka-4@S33& ef5V-U㖇EU> ^c rnoT'tE.jNUT[k83Ga-za{!g5&惘ChCo:os2 5Da_s65$BNqЫM9dN?^V ]C'(\ (R}lѷP{dy?J*y u淞RZٲOw)ELנilt<zz@Ț[czQs?(ceA*A>SjqP-iA NYuケ>A-6tN(tޫ6&Cv"Ut aݡ!./A~3=ΌnlbvKPxI4h,F zpݯW7cGA tνvJD -z.n@Dfb<rsV2q&&n B'c?3@ۃz6 ǚt',O=pcϡ&yuS3>.ejѫڡ3"F |\ׂuj-^~* :WE׀?} =4p@Mj}d_!AS7HW]\׵LHn򡳫ߴH+8p7儧z.LdOJg=G  ¥Nw[P@ՈVH\] GW %"aJۄʂTx/#dXf>JIZmx+HG/J]im97L!5f,2uo6)kt7# B+5c $kՃPd;} ĺ͇ΕzǃrKYFp/d#}VPZ{U.- l%M]Ԗ.$t1^ ߛm2@HQvP?'@;"N-Y yF4$nZ= \ 7V7Bf(ՄLM$$Ss(~"Ta-6oMz^q;9g{F7nB~aNϗ7mw9j h)ӊ)Urk %_R9ސҼN+L BxL0CZjӁsgppWؽn,j8d* $'[3CoeAr-gnϣ_<&ˠ93@YʐɎԼXgH "%w6> 7b { ߵ{'w5 OY rr(O 9އ%)s9/R?\`x[H=rm {q8tyv}IJԛ@?e HԎ?:Ug oA7P_/008J;\]D@khrఝ;lt myXeщ m $E[w үCKYNB#?9J,KjlsbfOm.H;|}}|'wq@!#̜yyGzBKC XsN9^8."}OC<w}{](s} 㽼}4ƫ+B9D-g[>@/{im|Yhx3J9soB٫ؽkSM^3z;|9+O ٹDDBOʾ2dRe#uzSܭ.Ӈn9CIWq(UA5y}/L6FrNL'AP>Wpr=ħQg}3R|V}wgwl: 4=^!*Cٹ} _RC1i[ :6axOjXt LBgL5w9Q oEi;{)f퍲jj/,5^)dWgi={27tv0nc Awajs7rօ¤z`zm/lk> |5Qm5+-JqՊ h  vg>g{\Y}o3@0ٿ 4W Ue#eB9%O]BzϾSSt1/0:D+̷2.y]¼?ςF vēV0KFf%?isOJ>حӱzvZtJޠw/'~KP-v>MX{#}3] I@bq{䯛3sZ:17]աq=ԓ;m"`Q2 +.tNJ9.2 {rp8mPl_0܃E s!\׷^w{(,؉CL!n]:ii2$^9|}{߷qrmmE$𭀧kp=:G+YH*u*ݢ2 ;4} ^~0_W϶Npgທ`~ .?Ea#%zC;\UkapV*eB9w@KxN^."7/f;_CyprEUf?^*rQgX]? 8BLMHﾺ(oX}9?7^wi}I [JFvq7 - 7X@+<Z:CK^; :jYϠFb e} F3w&s _wHc y+gݓ3TI¹SM `5 踼n^"=amJ/>!ۄ.J98ZwOqݏasrwn txa {,Mv`Y,>^sl')eݙ&vAuE&ͯOoNne] &=QU1OJE]A9ʾ2XyH/yl.lnx,཰hRk%yrR1v"c'7"un~2_|3$& [e%tjBhw'_˾1 mru3%j)*0pʖB G,j{>?J+xa>V Ɖ")0ӋޤFnGj6qSy,U0+,6 > `Qt:7g LF:4[ci,L:%:/Lew [Uo8Qw*Uk+>;@h?:iQ e֢e |y+ 0\#u`xXa>(;4 )7Aym?<^[=lHDWvR%CSPoxQ U)I!yIb2V ̲}eH-㛮nAȾuv{寤w? KxcRG@iefKJːʶ6R<u ^1hr &i,px>O ]ucnX΍5~,<9sZlzv'UT^ߺGZACWVyݯ-~sV.mX0Ű ,edzvA<=k$UBS@u$p.gR_+/3R&G_]PȻs_ఌܻ 3-]|xN|0S/3 :'?1P94otUijlaz+[@;?a?vNN$f:;[[Y;G\\HF t1Sb&<\}Ы¢c}?p)3w9.iJVnjopaxs6[>%lJY{Q6MRӸ`Exlx+Ze }\dPB~s:i:K< *%%D)ufk[z۞сVBU;A):fFգ; !ܵrkx(j6>Ӏ`ӛ6jhkj『G4>?aiZ#/a/s57Qa݅äj%6{5~u?O\q ?<;40<0Qd '.@K M?<\_ @(]A1LOm{%P$m\òǘ;kanzy,̊OpyB3Љ9rDvS(rpkYql8W[=XŲpֽءOp_S{ Ѧ#BtVߘ0Gy5ޡVSS@Jqi8 u ;G(Y@ "~~ltf⡉4=fMF"(h5tv_lK^s9vkq˹>HbaEh$ tӓn<?Z_aL’J(2)P{ak섾ku%=2@<;_; wAKJLoljk?$>b]Tuݕʾ5nܢEy{w^i6: %,H&=}?V%jLJ9BWiL"5G|Ȗ-v8u(4ynyAiG2nBin邷'B ~jzUjaTv &(Hٹǿ}|>YM{/A<1&Hh[_|lw[LAܩswlc!Rr]hZ} #.++B3@3f&1ŽBk=]A9MJrh]#}]3rꔌUJlqAV#~=% $@[Q/ܻ ?@休"ugǯ`۫LACS(ʽJzRHjR#dH5Rhsv0w݊T  <& s,[ZsoP}q("u+HÕ om2}>g1$aqh EgwAáʜΛ(u>_8~;鮜HCcYS42;4RoO3ύ[A$?iEWqrZܐ^/Y3 EpJ1(SW\~1o!j QEd(ךز T؍P(Lj<ߗ{Q: iSIV槳A GW-b)i(I98wduϔm2~=(OGW:ۼL\M͐}V~A{n7iei"P{{[<{^O/VG.c!Ϙ m\3?e+Ͽjbޖ;ydE-GEFR?z̮ԝ\)~-?;4˾oT2"YV4UEdr( v_|M(]>tF7ZUڛC.~Vb %Cu]L$s2%=)$0p(鸬X,W:i$X_R z=SFJ^ac'Be,V]+$d2?mU5㏴nJ?1 }?#B MX^r:m J$Y7AmÍ{ n䮺(LcnmsJ0H'>nrK2yzVۜaZl-W8(IuM@C oF:ݫ'j:hovXyԧuȒ\d}צr(m>`?.Xyts=,¡o]K#vȒ E1H;A=vZggP>Y}+A[;i}R'$ 9V9JB]nh$2浮b5BX W3=>i+_R_B{G f9;) Ɨ:x„P1o^S۔́8a,uWb;T`C:W_e^C o.&q rٰ~/!UK{uD<ߝ"Bӫr)AĶtaϵGan"v]%`6HZO~|_=st/10/ ayʝw&?^&K“bEyBLE`+psL$tSu$Y~hVޯV˨~0z9}w'`XnE-3%缔=ۭIԗ0(u']o,p\+ UDJ#">x>vpng@~3Pvt*jJa:VTUM q+* bƗ~6cpg]>?t v'vBVٚ^.R.i`Z8tuPfoE6"브3fw`6%eʭBPjYUB,lFVmUj~8}s>y<}] `y6*S^3vI=k)`Ux6>,`oTAtc-q/Ykl <oa1ͳ|p8k> a鷫rޗ[g>^P lĆm քQlCI5pLK\'1JQ5&غQ$@٬a`ޣxc8qtR_5YLmmG ȕAILByxe!(rW5P[5#+L|Q$ZU9uR ~֓^~{Oud 5C`=>ULg3WhuaPK=\a2(vXŸlvv`.~c幂ݾ1Ϻ^ýM`L 4VM^H)ks0 04t40jg(U-B&bsoL%h њOTʒ@M?:.[Cw 3VnpRc ۖDKMǿYy~JRT ΩuU'Byi<^*%޺Wh ޕ'm%cwN[=C;5*3P;FuV7D|:QAa9˘}Um$5#ۄQEGBXl||J^\*Cs}kvr=$ {A/Z!Y/MP^H\꒵үJ0ɼ]WrsmL; }c(w4V?HԷv )emY0U=^F!1O>z!`TT6˴jS˞>LJ/ȃJt a/ELXA[@IWiArN\N?Wdx6"?_#CŤ ?N4Taa%,Jd4Š[ ~ܛ͊Gba`e RR(?!ݳ;f =2XqAS#0(*Y V@{qVQ63+geLaiqJYCѶ`F*6S±wC,K7~4?epM;`sjrd#7¨[/sb@>V2ܣovydG#(Ŋ#@[Hb%͓˱Ρ5kJϩãlrm0L&[Bvi2r<𶛅Z Mo3N4qIOUݮq5TЫGjzݢid8F)_NN\X W&˕u$qlXj;fu}fYT߼};2:#~$L%1]YGOU=v`ω8a;PRXk]DNͣ.wv(xF^ku{)t80Q0176|7^``Cͻ3Óp;^f"&>ə`LxBj8wUK(F=Q) 4 ܌)5c-k{`\Ӓ9'AݹTo0#+hXX'-[jf+R uqG-u|lZKf]Kf̰4v=̃:w8v Q^9(< 1APKGDŐg}`'|p·NY"lge +`Z|Op6y&BxY!}zD~/}{*Cj hI)a`vbqLlSb_?Q]h p z;kNo,.VO]G(EDDEDHpXoB?x__CPYh26"xE~Eˢ/c#P|MU2bgte?$^ C(?3D?+M0 0B\}3k\robustbase/data/bushfire.rda0000644000176200001440000000075111754203337015643 0ustar liggesusersuOHQfWiB5$kNx.ZwAiD52bAKuHO OI] CtCX~q:|޼ A>RE+ ]J^Ow(+Gp})F WD=c/ "V/{qcx(-8/p#f #ϻptal==sc(ŏNg:3s:6gG;xH_Cr\C16ڕPxwp>= @ 68^~Xɡ~@!Bw9dJk6ѡIգ9^|]ޯgJSOF _fAq{^;f 4;gww;W^t9!?bwAOIԓ7;WC錕Nb lN}N:<[,DC|bG -|P|F6,^'i8Pstxjv xE-sSa6 TT+&}`ڄ L ?WJbI^Z4[9`6\ c Ґrobustbase/R/0000755000176200001440000000000013465050067012632 5ustar liggesusersrobustbase/R/glmrob.R0000644000176200001440000002561213325654420014243 0ustar liggesusersglmrob <- function (formula, family, data, weights, subset, na.action, start = NULL, offset, method = c("Mqle", "BY", "WBY", "MT"), weights.on.x = c("none", "hat", "robCov", "covMcd"), control = NULL, model = TRUE, x = FALSE, y = TRUE, contrasts = NULL, trace.lev = 0, ...) { call <- match.call() if (is.character(family)) family <- get(family, mode = "function", envir = parent.frame()) if (is.function(family)) family <- family() fami <- family$family if(is.null(fami)) stop(gettextf("'%s' is not a valid family (see ?family)", as.character(call[["family"]])), domain=NA) if (!(fami %in% c("binomial", "poisson", "Gamma", "gaussian"))) { stop(gettextf("Robust GLM fitting not yet implemented for family %s", fami), domain=NA) } if (missing(data)) data <- environment(formula) ## mf <- match.call(expand.dots = FALSE) m <- match(c("formula", "data", "subset", "weights", "na.action", "offset"), names(mf), 0) mf <- mf[c(1, m)] mf$drop.unused.levels <- TRUE mf[[1]] <- as.name("model.frame") mf <- eval(mf, parent.frame()) if(identical(method, "model.frame")) return(mf) mt <- attr(mf, "terms") Y <- model.response(mf, "any")# "numeric" or "factor" if (length(dim(Y)) == 1) { nm <- rownames(Y) dim(Y) <- NULL if (!is.null(nm)) names(Y) <- nm } X <- if (!is.empty.model(mt)) model.matrix(mt, mf, contrasts) else matrix(NA_real_, NROW(Y), 0) weights <- model.weights(mf) offset <- model.offset(mf) if (!is.null(weights) && any(weights < 0)) stop("'weights' must be non-negative") if (!is.null(offset) && length(offset) != NROW(Y)) stop(gettextf("Number of offsets is %d, should rather equal %d (number of observations)", length(offset), NROW(Y)), domain=NA) method <- match.arg(method) meth. <- if(method == "WBY") "BY" else method ### FIXME: the whole 'control' should be changed to "copy" lmrob() and lmrob.control() ## ------- --> *one* exported glmrob.control() function with 'method' and switch() inside... ## see >>> ./lmrob.MM.R if(is.null(control)) # -> use e.g., glmrobMqle.control() control <- get(paste0("glmrob", meth., ".control"))(...) if(missing(weights.on.x) || is.character(weights.on.x)) weights.on.x <- match.arg(weights.on.x) else if(!(is.function(weights.on.x) || is.list(weights.on.x) || (is.numeric(weights.on.x) && length(weights.on.x) == NROW(Y)))) stop("'weights.on.x' must be a string, function, list or numeric n-vector") if(!is.null(start) && !is.numeric(start)) { ## initialization methods if(!is.character(start)) stop("'start' must be a numeric vector, NULL, or a character string") start <- switch(start, "lmrob" =, "lmrobMM" = { if(!is.null(weights)) warnings("weights are not yet used in computing start estimate") lmrob.fit(x = X, y = family$linkinv(Y), control=lmrob.control())$coefficients }, stop("invalid 'start' string")) } fit <- switch(method, "cubif" = stop("For method 'cubif', use glmRob() from package 'robust'") , "Mqle" = ## --> ./glmrobMqle.R glmrobMqle(X = X, y = Y, weights = weights, start = start, offset = offset, family = family, weights.on.x = weights.on.x, control = control, intercept = attr(mt, "intercept") > 0, trace=trace.lev), "BY" =, "WBY" = { if(fami != "binomial") stop(gettextf( "method='%s' is only applicable for binomial family, but family=\"\"", method, fami), domain=NA) ### FIXME: use glmrobBY(..) with these arguments, including 'weights' glmrobBY(X=X, y=Y, weights=weights, start=start, method=method, ## == "BY" / "WBY" weights.on.x = weights.on.x, control = control, intercept = attr(mt, "intercept") > 0, trace.lev=trace.lev) }, "MT" = { glmrobMT(x=X,y=Y, weights=weights, start=start, offset = offset, family=family, weights.on.x=weights.on.x, control=control, intercept = attr(mt, "intercept") > 0, trace.lev=trace.lev) }, stop("invalid 'method': ", method)) ##- if (any(offset) && attr(mt, "intercept") > 0) { ##- fit$null.deviance <- glm.fit(x = X[, "(Intercept)", drop = FALSE], ##- y = Y, weights = weights, offset = offset, ##- control = control, intercept = TRUE)$deviance ##- } fit$na.action <- attr(mf, "na.action") if (model) fit$model <- mf if (x) fit$x <- X if (!y) ## fit$y <- NULL warning("setting 'y = FALSE' has no longer any effect") fit <- c(fit, list(call = call, formula = formula, terms = mt, data = data, offset = offset, control = control, method = method, prior.weights = if(is.null(weights)) rep.int(1, nrow(X)) else weights, contrasts = attr(X, "contrasts"), xlevels = .getXlevels(mt, mf))) class(fit) <- c("glmrob", "glm") fit } summary.glmrob <- function(object, correlation=FALSE, symbolic.cor=FALSE, ...) { dispersion <- object$dispersion if(is.null(dispersion)) dispersion <- 1 coefs <- object$coefficients aliased <- is.na(coefs)# needs care; also used in print method if(any(aliased)) coefs <- coefs[!aliased] covmat <- object$cov s.err <- sqrt(diag(covmat)) zvalue <- coefs/s.err pvalue <- 2 * pnorm(-abs(zvalue)) coef.table <- cbind("Estimate" = coefs, "Std. Error" = s.err, "z value" = zvalue, "Pr(>|z|)" = pvalue) ans <- c(object[c("call", "terms", "family", "iter", "control", "method", "residuals", "fitted.values", "w.r", "w.x")], ## MM: should rather keep more from 'object' ? ## currently, cannot even print the asympt.efficiency! list(deviance=NULL, df.residual=NULL, null.deviance=NULL, df.null= NULL, df= NULL, ## (because of 0 weights; hmm,...) aliased = aliased, coefficients = coef.table, dispersion = dispersion, cov.scaled = covmat)) if (correlation) { ans$correlation <- cov2cor(covmat) ans$symbolic.cor <- symbolic.cor } structure(ans, class = "summary.glmrob") } ## almost a copy of vcov.glm() [if that didn't have summmary.glm() explicitly] vcov.glmrob <- function (object, ...) { so <- summary(object, corr = FALSE, ...) ## so$dispersion * so$cov.unscaled ## changed from cov.unscaled to cov.scaled so$cov.scaled } print.glmrob <- function (x, digits = max(3, getOption("digits") - 3), ...) { cat("\nCall: ", deparse(x$call), "\n\n") if (length(coef(x))) { cat("Coefficients") if (is.character(co <- x$contrasts)) cat(" [contrasts: ", apply(cbind(names(co), co), 1, paste, collapse = "="), "]") cat(":\n") print.default(format(x$coefficients, digits = digits), print.gap = 2, quote = FALSE) } else cat("No coefficients\n\n") cat("\nNumber of observations:", length(x$residuals), "\nFitted by method ", sQuote(x$method), "\n") invisible(x) } print.summary.glmrob <- function (x, digits = max(3, getOption("digits") - 3), symbolic.cor = x$symbolic.cor, signif.stars = getOption("show.signif.stars"), ...) { cat("\nCall: ", deparse(x$call), "\n\n") if (length(cf <- coef(x))) { if(nsingular <- sum(x$aliased)) # glm has df[3] - df[1] cat("\nCoefficients: (", nsingular, " not defined because of singularities)\n", sep = "") else cat("\nCoefficients:\n") printCoefmat(cf, digits = digits, signif.stars = signif.stars, na.print = "NA", ...) summarizeRobWeights(x$w.r * x$w.x, digits = digits, header = "Robustness weights w.r * w.x:", ...) } else cat("No coefficients\n\n") n <- length(x$residuals) cat("\nNumber of observations:", n, "\nFitted by method", sQuote(x$method)," (in", x$iter, "iterations)\n") cat("\n(Dispersion parameter for ", x$family$family, " family taken to be ", format(x$dispersion), ")\n\n",sep = "") if(any(!is.null(unlist(x[c("null.deviance", "deviance")])))) cat(apply(cbind(paste(format(c("Null", "Residual"), justify="right"), "deviance:"), format(unlist(x[c("null.deviance", "deviance")]), digits=max(5, digits + 1)), " on", format(unlist(x[c("df.null", "df.residual")])), " degrees of freedom\n"), 1L, paste, collapse=" "), "\n", sep = "") else cat("No deviance values available \n") correl <- x$correlation if (!is.null(correl)) { p <- NCOL(correl) if (p > 1) { cat("\nCorrelation of Coefficients:\n") if (isTRUE(symbolic.cor)) { print(symnum(correl, abbr.colnames=NULL)) } else { correl <- format(round(correl, 2), nsmall=2, digits=digits) correl[!lower.tri(correl)] <- "" print(correl[-1, -p, drop=FALSE], quote=FALSE) } } } printControl(x$control, digits = digits) cat("\n") invisible(x) } weights.glmrob <- function(object, type = c("prior", "robustness"), ...) { type <- match.arg(type) w <- if (type == "prior") { ## Issue warning only if called from toplevel. Otherwise the warning pop ## up at quite unexpected places, e.g., case.names(). if (is.null(object[["weights"]]) && identical(parent.frame(), .GlobalEnv)) warning("No weights defined for this object. Use type=\"robustness\" argument to get robustness weights.") object[["weights"]] } else object$w.r * object$w.x ## those also used summarizeRobWeights(x$w.r * x$w.x, ..) if (is.null(object$na.action)) w else naresid(object$na.action, w) } ## Stems from a copy of residuals.glm() in ## ~/R/D/r-devel/R/src/library/stats/R/glm.R residuals.glmrob <- function(object, type = c("deviance", "pearson", "working", "response", "partial"), ...) { type <- match.arg(type) y <- object$y r <- object$residuals mu <- object$fitted.values wts <- object$prior.weights # ok p <- length(object$coefficients) switch(type, deviance=, pearson=, response= if(is.null(y)) { mu.eta <- object$family$mu.eta eta <- object$linear.predictors ## we cannot use 'r <- ...$residuals' __ FIXME __ stop("need non-robust working residuals for this model type") y <- mu + r * mu.eta(eta) }) res <- switch(type, ## deviance = if(object$df.residual > 0) { deviance = if((nobs(object) - p) > 0) { d.res <- sqrt(pmax.int((object$family$dev.resids)(y, mu, wts), 0)) ifelse(y > mu, d.res, -d.res) } else rep.int(0, length(mu)), pearson = (y-mu)*sqrt(wts)/sqrt(object$family$variance(mu)), working = r, response = y - mu, partial = r ) if(!is.null(object$na.action)) res <- naresid(object$na.action, res) if (type == "partial") ## need to avoid doing naresid() twice. res <- res+predict(object, type="terms") res } robustbase/R/detmcd.R0000644000176200001440000004123012441664745014224 0ustar liggesusers### -*- mode: R ; delete-old-versions: never -*- ##' Computes the MCD estimator of a multivariate data sets in a \emph{deterministic} ##' way. ##' ##' The MCD estimator is given by the subset of h observations with smallest ##' covariance determinant. The MCD location estimate is then ##' the mean of those h points, and the MCD scatter estimate is ##' their covariance matrix. The default value of h is roughly ##' 0.75n (where n is the total number of observations), but the ##' user may choose each value between n/2 and n. Based on the ##' raw estimates, weights are assigned to the observations such ##' that outliers get zero weight. The reweighted MCD estimator ##' is then given by the mean and covariance matrix of the cases ##' with non-zero weight. ## ##' To compute an approximate MCD estimator deterministically, six initial robust h-subsets are ##' constructed based on robust transformations of variables or robust and ##' fast-to-compute estimators of multivariate location and shape. Then ##' C-steps are applied on these h-subsets until convergence. Note that the ##' resulting algorithm is not fully affine equivariant, but it is often ##' faster than the FAST-MCD algorithm which is affine equivariant ##' (see covMcd()). ##' Note that this function can not handle exact fit situations: if the ##' raw covariance matrix is singular, the program is stopped. In that ##' case, it is recommended to apply the covMcd() function. ##' ##' The MCD method is intended for continuous variables, and assumes that ##' the number of observations n is at least 5 times the number of variables p. ##' If p is too large relative to n, it would be better to first reduce ##' p by variable selection or robust principal components (see the functions ##' robust principal components in package 'rrcov'). ##' ##' @title Compute the MCD estimator of multivariate data in a deterministic way ##' @references ##' Hubert, M., Rousseeuw, P.J. and Verdonck, T. (2012), ##' "A deterministic algorithm for robust location and scatter", Journal of ##' Computational and Graphical Statistics, in press. ##' @param x a numerical matrix. The columns represent variables, and rows represent observations. ##' @param h The quantile of observations whose covariance determinant will ##' be minimized. Any value between n/2 and n may be specified. ##' @param hsets.init If one gives here already a matrix with for each column an ##' ordering of the observations (first the one with smallest statistical ##' distance), then the initial shape estimates are not calculated. ##' Default value = NULL. ##' @param save.hsets ##' @param full.h ##' @param scalefn function (or "rule") to estimate the scale. ##' @param maxcsteps ##' @param warn.nonconv.csteps ##' @param warn.wrong.obj.conv ##' @param trace ##' @param names ##' @return ##' @author Valentin Todorov; many tweaks by Martin Maechler .detmcd <- function(x, h, hsets.init=NULL, save.hsets = missing(hsets.init), full.h = save.hsets, scalefn, maxcsteps = 200, warn.nonconv.csteps = getOption("robustbase:warn.nonconv.csteps", TRUE), warn.wrong.obj.conv = getOption("robustbase:warn.wrong.obj.conv",FALSE), trace = as.integer(trace), names = TRUE) { stopifnot(length(dx <- dim(x)) == 2, h == as.integer(h), h >= 1) n <- dx[1] p <- dx[2] stopifnot(p >= 1, n >= 1) scalefn <- robScalefn(scalefn, n) ## kmini <- 5 # number of sub-data sets(if we use them some day) ## # for now we use it as number of rows in the returned ## # matrix 'coeff' for exact fit (also not used currently). ## cutoff <- qchisq(0.975, p) ## chimed <- qchisq(0.5, p) ## Center and scale the data vnms <- colnames(x) # speedup only: store and put back at end z <- doScale(unname(x), center=median, scale=scalefn) z.center <- z$center z.scale <- z$scale z <- z$x ## Assume that 'hsets.init' already contains h-subsets: the first h observations each if(is.null(hsets.init)) { hsets.init <- r6pack(z, h=h, full.h=full.h, scaled=TRUE, scalefn=scalefn) dh <- dim(hsets.init) } else { ## user specified, (even just *one* vector): if(is.vector(hsets.init)) hsets.init <- as.matrix(hsets.init) dh <- dim(hsets.init) if(dh[1] < h || dh[2] < 1) stop("'hsets.init' must be a h' x L matrix (h' >= h) of observation indices") ## TODO?: We could *extend* the sets to large h, even all n ## ====> could input the 'best' sets, also e.g. from fastmcd if(full.h && dh[1] != n) warning("'full.h' is true, but 'hsets.init' has less than n rows") ## stop("When 'full.h' is true, user specified 'hsets.init' must have n rows") if(min(hsets.init) < 1 || max(hsets.init) > n) stop("'hsets.init' must be in {1,2,...,n}; n = ", n) } nsets <- ncol(hsets.init)# typically 6, currently ## Some initializations. hset.csteps <- integer(nsets) bestobj <- Inf for(i in 1:nsets) { if(trace) { if(trace >= 2) cat(sprintf("H-subset %d = observations c(%s):\n-----------\n", i, pasteK(hsets.init[1:h,i]))) else cat(sprintf("H-subset %d: ", i)) } for(j in 1:maxcsteps) { if(j == 1) { obs_in_set <- hsets.init[1:h,i] # start with the i-th initial set } else { # now using 'svd' from last step score <- (z - rep(svd$center, each=n)) %*% svd$loadings mah <- mahalanobisD(score, center=FALSE, sd = sqrt(abs(svd$eigenvalues))) obs_in_set <- sort.list(mah)[1:h] #, partial = 1:h not yet } ## [P,T,L,r,centerX,meanvct] = classSVD(data(obs_in_set,:)); svd <- classPC(z[obs_in_set, ,drop=FALSE], signflip=FALSE) obj <- sum(log(svd$eigenvalues)) if(svd$rank < p) { ## FIXME --> return exact fit property rather than stop() ?? stop('More than h of the observations lie on a hyperplane.') ## TODO exactfit <- TRUE ## coeff <- ... } if(j >= 2 && obj == prevdet) { ## MM:: 2014-10-25: objective function check is *not* good enough: if(identical(obs_in_set, prevobs)) break ## else : if(warn.wrong.obj.conv) warning(sprintf( "original detmcd() wrongly declared c-step convergence (obj=%g, i=%d, j=%d)", obj, i,j)) } prevdet <- obj prevobs <- obs_in_set } hset.csteps[i] <- j # how many csteps necessary to converge. if(trace) cat(sprintf("%3d csteps, obj=log(det|.|)=%g", j, obj)) if(obj < bestobj) { if(trace) cat(" = new optim.\n") ## bestset : the best subset for the whole data. ## bestobj : objective value for this set. ## initmean, initcov : the mean and covariance matrix of this set bestset <- obs_in_set bestobj <- obj initmean <- svd$center L <- svd$loadings ## MM speedup: was L Diag L' = L %*% diag(svd$eigenvalues) %*% t(L) initcov <- tcrossprod(L * rep(svd$eigenvalues, each=nrow(L)), L) ## raw.initcov <- initcov ## rew.Hsubsets.Hopt <- bestset ind.best <- i # to determine which subset gives best results. } else if(obj == bestobj) ## store as well: ind.best <- c(ind.best, i) else if(trace) cat("\n") } ## for(i in 1:nsets) if(warn.nonconv.csteps && any(eq <- hset.csteps == maxcsteps)) { p1 <- paste(ngettext(sum(eq), "Initial set", "Initial sets"), pasteK(which(eq))) warning(sprintf("%s did not converge in maxcsteps=%d concentration steps", p1, maxcsteps), domain=NA) } ## reweighting <- FALSE # it happens in covMcd() ## if(reweighting) { ## svd <- classPC(z[bestset, ], signflip=FALSE) # [P,T,L,r,centerX,meanvct] = classSVD(data(bestset,:)); ## mah <- mahalanobisD((z - rep(svd$center, each=n)) %*% svd$loadings, ## FALSE, sqrt(abs(svd$eigenvalues))) ## sortmah <- sort(mah) ## } ## factor <- sortmah[h]/qchisq(h/n, p) ## raw.cov <- factor*initcov ## raw.cov <- initcov ## We express the results in the original units [restoring var.names]: raw.cov <- initcov * tcrossprod(z.scale) raw.center <- initmean * z.scale + z.center if(names) { dimnames(raw.cov) <- list(vnms, vnms) names(raw.center) <- vnms } raw.objective <- bestobj + 2*sum(log(z.scale)) # log(det = obj.best * prod(z.scale)^2) ## raw.mah <- mahalanobis(x, raw.center, raw.cov, tol=1E-14) ## medi2 <- median(raw.mah) list(initcovariance = raw.cov, initmean = raw.center, best = bestset, mcdestimate = raw.objective, # determinant (goes to crit) ## , weights=NULL# FIXME - goes to raw.weights iBest = ind.best, n.csteps = hset.csteps, initHsets = if(save.hsets) hsets.init, exactfit = 0 # <- FIXME ## once we'd test for exact fit, we'd return: ## , coeff=matrix(rep(0, kmini*p), nrow=kmini) ## , kount=0 # FIXME ) } ## .detmcd() robScalefn <- function(scalefn, n) { if(missing(scalefn) || is.null(scalefn)) scalefn <- .scalefn.default if(is.function(scalefn)) scalefn else switch(scalefn, ## Hubert, Rousseeuw, Verdonck, JCGS 2012 : "hrv2012" = if(n < 1000) Qn else scaleTau2, ## Version of 2014: "v2014" = if(n < 5000) Qn else scaleTau2, ## otherwise stop(gettextf("Invalid scalefn='%s': must be function or a valid string", scalefn), domain=NA)) } doScale <- function (x, center, scale) { stopifnot(is.numeric(p <- ncol(x))) ## MM: follow standard R's scale.default() as much as possible centerFn <- is.function(center) doIt <- if(centerFn) { centerName <- deparse(substitute(center)) # "median" typically center <- apply(x, 2L, center) TRUE } else { if(length(center) == p && is.numeric(center)) TRUE else if(missing(center) || is.null(center)) { center <- 0; FALSE } else stop(gettextf("'%s' must be a function, numeric vector of length p, or NULL", "center"), domain=NA) } if(doIt) x <- sweep(x, 2L, center, `-`, check.margin=FALSE) scaleFn <- is.function(scale) doIt <- if(scaleFn) { scale <- apply(x, 2L, scale) TRUE } else { if(length(scale) == p && is.numeric(scale)) TRUE else if(missing(scale) || is.null(scale)) { scale <- 1 FALSE } else stop(gettextf("'%s' must be a function, numeric vector of length p, or NULL", "scale"), domain=NA) } if(doIt) { if(any(is.na(scale)) || any(scale < 0)) stop("provide better scale; must be all positive") if(any(s0 <- scale == 0)) { ## FIXME: ### Better and easier alternative (and as "FAST MCD"): return "singular cov.matrix" ### since scale 0 ==> more than 50% points are on hyperplane x[,j] == const. ## find scale if there is any variation; otherwise use s := 1 S <- if(centerFn && centerName == "median") abs else function(.) abs(. - median(.)) non0Q <- function(u) { alph <- c(10:19, 19.75)/20 # not all the way to '1' {=> finite qnorm()} qq <- quantile(S(u), probs=alph, names=FALSE) if(any(pos <- qq != 0)) { ## the first non-0 if there is one i <- which.max(pos) qq[i] / qnorm((alph[i] + 1)/2) } else 1 } scale[s0] <- apply(x[,s0, drop=FALSE], 2L, non0Q) } x <- sweep(x, 2L, scale, `/`, check.margin = FALSE) } ## return list(x=x, center=center, scale=scale) } ##' @title Robust Distance based observation orderings based on robust "Six pack" ##' @param x n x p data matrix ##' @param h integer ##' @param full.h full (length n) ordering or only the first h? ##' @param scaled is 'x' is already scaled? otherwise, apply doScale(x, median, scalefn) ##' @param scalefn function to compute a robust univariate scale. ##' @return a h' x 6 matrix of indices from 1:n; if(full.h) h' = n else h' = h r6pack <- function(x, h, full.h, scaled=TRUE, scalefn = rrcov.control()$scalefn) { ## As the considered initial estimators Sk may have very ## inaccurate eigenvalues, we try to 'improve' them by applying ## a transformation similar to that used in the OGK algorithm. ## ## After that compute the corresponding distances, order them and ## return the indices initset <- function(data, scalefn, P, h) { stopifnot(length(d <- dim(data)) == 2, length(h) == 1, h >= 1) n <- d[1] stopifnot(h <= n) lambda <- doScale(data %*% P, center=median, scale=scalefn)$scale sqrtcov <- P %*% (lambda * t(P)) ## == P %*% diag(lambda) %*% t(P) sqrtinvcov <- P %*% (t(P) / lambda) ## == P %*% diag(1/lambda) %*% t(P) estloc <- colMedians(data %*% sqrtinvcov) %*% sqrtcov centeredx <- (data - rep(estloc, each=n)) %*% P sort.list(mahalanobisD(centeredx, FALSE, lambda))[1:h]# , partial = 1:h } ## ## Compute the raw OGK estimator. For m(.) and s(.) (robust ## univariate estimators of location and scale) use the median ## and Qn for reasons of simplicity (no choice of tuning parameters) ## and to be consistent with the other components of DetMCD. ## ogkscatter <- function(Y, scalefn, only.P = TRUE) { stopifnot(length(p <- ncol(Y)) == 1, p >= 1) U <- diag(p) for(i in seq_len(p)[-1L]) {# i = 2:p sYi <- Y[,i] ii <- seq_len(i - 1L) for(j in ii) { sYj <- Y[,j] U[i,j] <- (scalefn(sYi + sYj)^2 - scalefn(sYi - sYj)^2) / 4 } ## also set the upper triangle U[ii,i] <- U[i,ii] } ## now done above: U <- lower.tri(U) * U + t(U) # U <- tril(U, -1) + t(U) P <- eigen(U, symmetric=TRUE)$vectors if(only.P) return(P) ## else : Z <- Y %*% t(P) sigz <- apply(Z, 2, scalefn) lambda <- diag(sigz^2) list(P=P, lambda=lambda) } stopifnot(length(dx <- dim(x)) == 2) n <- dx[1] p <- dx[2] ## If scalefn is missing or is NULL, use Qn for smaller data sets (n < 1000) ## and tau-scale of Yohai and Zamar (1988) otherwise. scalefn <- robScalefn(scalefn, n) ## If the data was not scaled already (scaled=FALSE), center and scale using ## the median and the provided function 'scalefn'. if(!scaled) { ## Center and scale the data to (0, 1) - robustly x <- doScale(x, center=median, scale=scalefn)$x } nsets <- 6 hsets <- matrix(integer(), h, nsets) ## Determine 6 initial estimates (ordering of obs) ## 1. Hyperbolic tangent of standardized data y1 <- tanh(x) R1 <- cor(y1) P <- eigen(R1, symmetric=TRUE)$vectors hsets[,1] <- initset(x, scalefn=scalefn, P=P, h=h) ## 2. Spearmann correlation matrix R2 <- cor(x, method="spearman") P <- eigen(R2, symmetric=TRUE)$vectors hsets[,2] <- initset(x, scalefn=scalefn, P=P, h=h) ## 3. Tukey normal scores y3 <- qnorm((apply(x, 2L, rank) - 1/3)/(n + 1/3)) R3 <- cor(y3, use = "complete.obs") P <- eigen(R3, symmetric=TRUE)$vectors hsets[,3] <- initset(x, scalefn=scalefn, P=P, h=h) ## 4. Spatial sign covariance matrix znorm <- sqrt(rowSums(x^2)) ii <- znorm > .Machine$double.eps x.nrmd <- x x.nrmd[ii,] <- x[ii, ] / znorm[ii] SCM <- crossprod(x.nrmd)# / (n-1) not needed for e.vectors P <- eigen(SCM, symmetric=TRUE)$vectors hsets[,4] <- initset(x, scalefn=scalefn, P=P, h=h) ## 5. BACON ind5 <- order(znorm) half <- ceiling(n/2) Hinit <- ind5[1:half] covx <- cov(x[Hinit, , drop=FALSE]) P <- eigen(covx, symmetric=TRUE)$vectors hsets[,5] <- initset(x, scalefn=scalefn, P=P, h=h) ## 6. Raw OGK estimate for scatter P <- ogkscatter(x, scalefn, only.P = TRUE) hsets[,6] <- initset(x, scalefn=scalefn, P=P, h=h) ## Now combine the six pack : if(full.h) hsetsN <- matrix(integer(), n, nsets) for(k in 1:nsets) ## sort each of the h-subsets in *increasing* Mah.distances { xk <- x[hsets[,k], , drop=FALSE] svd <- classPC(xk, signflip=FALSE) # [P,T,L,r,centerX,meanvct] = classSVD(xk) if(svd$rank < p) ## FIXME: " return("exactfit") " stop('More than half of the observations lie on a hyperplane.') score <- (x - rep(svd$center, each=n)) %*% svd$loadings ord <- order(mahalanobisD(score, FALSE, sqrt(abs(svd$eigenvalues)))) if(full.h) hsetsN[,k] <- ord else hsets[,k] <- ord[1:h] } ## return if(full.h) hsetsN else hsets } ## {r6pack} robustbase/R/adjbox.R0000644000176200001440000000752612221620231014217 0ustar liggesusers#### Skewness (MC) - Adjusted Boxplots ### modeled closely after boxplot() etc in R/src/library/graphics/R/boxplot.R : adjbox <- function(x, ...) UseMethod("adjbox") adjbox.default <- function (x, ..., range = 1.5, doReflect=FALSE, width = NULL, varwidth = FALSE, notch = FALSE, outline = TRUE, names, plot = TRUE, border = par("fg"), col = NULL, log = "", pars = list(boxwex = 0.8, staplewex = 0.5, outwex = 0.5), horizontal = FALSE, add = FALSE, at = NULL) { args <- list(x, ...) namedargs <- if(!is.null(attributes(args)$names)) attributes(args)$names != "" else logical(length(args))# all FALSE ## pars <- c(args[namedargs], pars) groups <- if(is.list(x)) x else args[!namedargs] if(0 == (n <- length(groups))) stop("invalid first argument") if(length(class(groups))) groups <- unclass(groups) if(!missing(names)) attr(groups, "names") <- names else { if(is.null(attr(groups, "names"))) attr(groups, "names") <- 1:n names <- attr(groups, "names") } cls <- sapply(groups, function(x) class(x)[1]) cl <- if(all(cls == cls[1])) cls[1] # else NULL for (i in 1:n) groups[i] <- list(adjboxStats(unclass(groups[[i]]), coef=range, doReflect=doReflect)) # do.conf=notch) stats <- matrix(0, nrow=5, ncol=n) conf <- fence <- matrix(0, nrow=2, ncol=n) ng <- out <- group <- numeric(0) ct <- 1 for(i in groups) { stats[,ct] <- i$stats conf [,ct] <- i$conf fence[,ct] <- i$fence ng <- c(ng, i$n) if((lo <- length(i$out))) { out <- c(out,i$out) group <- c(group, rep.int(ct, lo)) } ct <- ct+1 } if(length(cl) && cl != "numeric") oldClass(stats) <- cl z <- list(stats = stats, n = ng, conf = conf, fence = fence, out = out, group = group, names = names) if(plot) { if(is.null(pars$boxfill) && is.null(args$boxfill)) pars$boxfill <- col do.call("bxp", c(list(z, notch = notch, width = width, varwidth = varwidth, log = log, border = border, pars = pars, outline = outline, horizontal = horizontal, add = add, at = at), args[namedargs])) invisible(z) } else z } adjbox.formula <- function (formula, data = NULL, ..., subset, na.action = NULL) { if(missing(formula) || (length(formula) != 3)) stop("'formula' missing or incorrect") m <- match.call(expand.dots = FALSE) if(is.matrix(eval(m$data, parent.frame()))) m$data <- as.data.frame(data) m$... <- NULL m$na.action <- na.action # force use of default for this method ## require(stats, quietly = TRUE): model.frame m[[1]] <- as.name("model.frame") mf <- eval(m, parent.frame()) response <- attr(attr(mf, "terms"), "response") adjbox(split(mf[[response]], mf[-response]), ...) } ## modeled after boxplot.stats() from R/src/library/grDevices/R/calc.R : adjboxStats <- function(x, coef = 1.5, a = -4, b = 3, do.conf = TRUE, do.out = TRUE, ...) { if(coef < 0) stop("'coef' must not be negative") nna <- !is.na(x) n <- sum(nna)# including +/- Inf stats <- fivenum(x, na.rm = TRUE) iqr <- diff(stats[c(2, 4)]) fence <- rep(NA_real_, 2) if(coef == 0) do.out <- FALSE # no whiskers to be drawn else { ## coef > 0 out <- if (!is.na(iqr)) { medc <- mc(x, ..., na.rm = TRUE) fence <- if (medc >= 0) c(stats[2] - coef * exp(a * medc) * iqr, stats[4] + coef * exp(b * medc) * iqr) else c(stats[2] - coef * exp(-b * medc) * iqr, stats[4] + coef * exp(-a * medc) * iqr) x < fence[1] | fence[2] < x } else !is.finite(x) if (any(out[nna], na.rm = TRUE)) stats[c(1, 5)] <- range(x[!out], na.rm = TRUE) } conf <- if (do.conf) stats[3] + c(-1.58, 1.58) * iqr/sqrt(n) list(stats = stats, n = n, conf = conf, fence = fence, out = if (do.out) x[out & nna] else numeric(0)) } robustbase/R/BYlogreg.R0000644000176200001440000003574713167157117014512 0ustar liggesusers#### http://www.econ.kuleuven.be/public/NDBAE06/programs/roblog/ : #### #### August 06, 2010 2:14 PM 9121 BYlogreg.r.txt == BYlogreg.R (*this* original) #### May 04, 2005 9:24 AM 6702 BYlogreg.txt == BYlogreg.R.~2005~ #### May 04, 2005 9:25 AM 6720 WBYlogreg.txt == WBYlogreg.R #### #### Sep. 27, 2017: available at #### #### NB: Splus original Version of this file: BYlogreg.ssc in the #### -- in FunctionsRob/ (from FunctionsRob.zip) from Wiley's book supplements #### http://www.wiley.com/legacy/wileychi/robust_statistics/robust.html #### see my ../misc/MMY-book/Wiley-supplements/FunctionsRob/BYlogreg.ssc ## Computation of the estimator of Bianco and Yohai (1996) in logistic regression ## ------------- ## Christophe Croux, Gentiane Haesbroeck ## (thanks to Kristel Joossens and Valentin Todorov for improving the code) - ## ==> Now "contains" both the *weighted* and regular, unweighted BY-estimator ## ## This program computes the estimator of Bianco and Yohai in ## logistic regression. By default, an intercept term is included ## and p parameters are estimated. ## ## For more details we refer to ## Croux, C., and Haesbroeck, G. (2003), ## ``Implementing the Bianco and Yohai estimator for Logistic Regression'', ## Computational Statistics and Data Analysis, 44, 273-295 ## ## Changes by Martin Maechler, ---> ../man/BYlogreg.Rd ## ------------------ BYlogreg <- function(x0, y, initwml=TRUE, # w.x=NULL, addIntercept=TRUE, const=0.5, kmax = 1000, maxhalf = 10, sigma.min = 1e-4, trace.lev=0) { if(!is.numeric(y)) y <- as.numeric(y) ## if(!is.null(w.x)) ## warning("x weights 'w.x' are not yet made use of") if(!is.null(dim(y))) { if(ncol(y) != 1) stop("y is not onedimensional") y <- as.vector(y) } n <- length(y) if(is.data.frame(x0)) { x0 <- data.matrix(x0) } else if (!is.matrix(x0)) { x0 <- matrix(x0, length(x0), 1, dimnames = list(names(x0), deparse(substitute(x0)))) } if(nrow(x0) != n) stop("Number of observations in x and y not equal") na.x <- !is.finite(rowSums(x0)) na.y <- !is.finite(y) ok <- !(na.x | na.y) if(!all(ok)) { x0 <- x0[ok, , drop = FALSE] y <- y [ok] # y[ok, , drop = FALSE] } if(addIntercept) { x <- cbind("Intercept" = 1, x0) } else { # x0 := x without the "intercept column" x <- x0 all1 <- apply(x == 1, 2, all) if(any(all1)) x0 <- x[,!all1, drop = FALSE] else message("no intercept in the model") } dx <- dim(x) n <- dx[1] if(n == 0) stop("All observations have missing values!") p <- dx[2] # == ncol(x) family <- binomial() ## Computation of the initial value of the optimization process gstart <- if(initwml) { ###_ FIXME: Should allow many more schemes: ###_ 1) using MVE with much less singular cases ###_ 2) Instead of {0,1}-weighting with cutoff, w/ weights --> 0 *continuously* ### --> glm() with "prior" weights instead of 'subset' ## hp <- floor(n*(1-0.25))+1 ## mcdx <- cov.mcd(x0, quantile.used =hp,method="mcd") ## rdx=sqrt(mahalanobis(x0,center=mcdx$center,cov=mcdx$cov)) ## mcdx <- CovMcd(x0, alpha=0.75) ## rdx <- sqrt(getDistance(mcdx)) mcd <- covMcd(x0, alpha=0.75) ## ----- FIXME: argument! D <- sqrt( mahalanobis(mcd$X, mcd$center, mcd$cov) ) vc <- sqrt(qchisq(0.975, p-1)) ## ----- FIXME: 'vc' should be argument! wrd <- D <= vc ### FIXME_2: use weights and "weights.on.x' as in Mqle ( ./glmrobMqle.R ) ## glm(y~x0, family=binomial, subset = wrd)$coef glm.fit(x[wrd,,drop=FALSE], y[wrd], family=family)$coef } else { glm.fit(x, y, family=family)$coef } sigma1 <- 1/sqrt(sum(gstart^2)) xistart <- gstart*sigma1 stscores <- x %*% xistart ## Initial value for the objective function oldobj <- mean(phiBY3(stscores/sigma1, y, const)) converged <- FALSE kstep <- 1L while(kstep < kmax && !converged) { unisig <- function(sigma) mean(phiBY3(stscores/sigma, y, const)) ## ------ optimsig <- nlminb(sigma1, unisig, lower=0)# "FIXME" arguments to nlminb() ## ====== if(trace.lev) cat(sprintf("k=%2d, s1=%12.8g: => new s1= %12.8g", kstep, sigma1, optimsig$par))# MM: jhalf =!?= 1 here ?? sigma1 <- optimsig$par if(sigma1 < sigma.min) { if(trace.lev) cat("\n") warning(gettextf("Implosion: sigma1=%g became too small", sigma1)) kstep <- kmax #-> *no* convergence } else { ## gamma1 <- xistart/sigma1 scores <- stscores/sigma1 newobj <- mean(phiBY3(scores, y,const)) oldobj <- newobj grad.BY <- colMeans((derphiBY3(scores,y,const) %*% matrix(1,ncol=p))*x) h <- -grad.BY + (grad.BY %*% xistart) *xistart finalstep <- h/sqrt(sum(h^2)) if(trace.lev) { if(trace.lev >= 2) cat(sprintf(", obj=%12.9g: ", oldobj)) cat("\n") } ## FIXME repeat { ... } {{next 4 lines are also inside while(..) below}} xi1 <- xistart+finalstep xi1 <- xi1/sum(xi1^2) scores1 <- (x %*% xi1)/sigma1 newobj <- mean(phiBY3(scores1,y,const)) ## If 'newobj' is not better, try taking a smaller step size: hstep <- 1. jhalf <- 1L while(jhalf <= maxhalf & newobj > oldobj) { hstep <- hstep/2 xi1 <- xistart+finalstep*hstep xi1 <- xi1/sqrt(sum(xi1^2)) scores1 <- x %*% xi1/sigma1 newobj <- mean(phiBY3(scores1,y,const)) if(trace.lev >= 2) cat(sprintf(" jh=%2d, hstep=%13.8g => new obj=%13.9g\n", jhalf, hstep, newobj)) jhalf <- jhalf+1L } converged <- not.improved <- (jhalf > maxhalf && newobj > oldobj) if(not.improved) { ## newobj is "worse" and step halving did not improve message("Convergence Achieved") } else { jhalf <- 1L xistart <- xi1 oldobj <- newobj stscores <- x %*% xi1 kstep <- kstep+1L } } } ## while( kstep ) if(kstep == kmax) { warning("No convergence in ", kstep, " steps.") list(convergence=FALSE, objective=0, coefficients= rep(NA,p)) } else { gammaest <- xistart/sigma1 V <- vcovBY3(x, y, const, estim=gammaest, addIntercept=FALSE) list(convergence=TRUE, objective=oldobj, coefficients=gammaest, cov = V, sterror = sqrt(diag(V)), iter = kstep) } } ### -- FIXME: nlminb() allows many tweaks !! ### -- ----- but we use nlminb() for ONE-dim. minimization over { sigma >= 0 } - really?? ## MM: my version would rather use optimize() over over log(sigma) glmrobBY.control <- function(maxit = 1000, const = 0.5, maxhalf = 10) ## FIXME: sigma.min ## MM: 'acc' seems a misnomer to me, but it's inherited from MASS::rlm ## TODO acc = 1e-04, test.acc = "coef", tcc = 1.345) { ## if (!is.numeric(acc) || acc <= 0) ## stop("value of acc must be > 0") ## if (test.acc != "coef") ## stop("Only 'test.acc = \"coef\"' is currently implemented") ## if (!(any(test.vec == c("coef", "resid")))) ## stop("invalid argument for test.acc") if(!is.numeric(maxit) || maxit <= 0) stop("maximum number of \"kstep\" iterations must be > 0") if(!is.numeric(maxhalf) || maxhalf <= 0) stop("maximal number of *inner* step halvings must be > 0") ## if (!is.numeric(tcc) || tcc <= 0) ## stop("value of the tuning constant c (tcc) must be > 0") if(!is.numeric(const) || const <= 0) stop("value of the tuning constant c ('const') must be > 0") list(## acc = acc, consttest.acc = test.acc, const=const, maxhalf=maxhalf, maxit=maxit #, tcc = tcc ) } ##' @param intercept logical, if true, X[,] has an intercept column which should ##' not be used for rob.wts glmrobBY <- function(X, y, weights = NULL, start = NULL, offset = NULL, method = c("WBY","BY"), weights.on.x = "none", control = glmrobBY.control(...), intercept = TRUE, trace.lev = 0, ...) { ### THIS is *NOT* exported method <- match.arg(method) if(!is.null(weights) || any(weights != 1)) ## FIXME (?) stop("non-trivial prior 'weights' are not yet implemented for \"BY\"") if(!is.null(start)) stop(" 'start' cannot yet be passed to glmrobBY()") if(!is.null(offset)) stop(" 'offset' is not yet implemented for \"BY\"") const <- if(is.null(cc <- control$const )) 0.5 else cc kmax <- if(is.null(cc <- control$maxit )) 1e3 else cc maxhalf <- if(is.null(cc <- control$maxhalf)) 10 else cc if(!identical(weights.on.x, "none")) stop("'weights.on.x' = ", format(weights.on.x)," is not implemented") ## w.x <- robXweights(weights.on.x, X=X, intercept=intercept) ## ## MM: all(?) the BY3() functions below would need to work with weights... r <- BYlogreg(x0=X, y=y, initwml = (method == "WBY"), ## w.x=w.x, addIntercept = !intercept, ## add intercept if there is none const=const, kmax=kmax, maxhalf=maxhalf, ## FIXME sigma.min (is currently x-scale dependent !????) trace.lev=trace.lev) ## FIXME: make result more "compatible" with other glmrob() methods r } ### Functions needed for the computation of estimator of Bianco and Yohai ---------------------- ## From their paper: ## A last remark is worth mentioning: when huge outliers occur in ## the logistic regression setting, often numerical imprecision occurs in the computation ## of the deviances given by ## d(s;y_i)= -y_i log F(s) - (1-y_i) log{1-F(s)} . ## ## Instead of directly computing this expression, it can be seen that a ## numerically more stable and accurate formula is given by ## log(1 + exp(-abs(s))) + abs(s)* ((y-0.5)*s < 0) ## in which the second term equals abs(s) if the observation is misclassified, 0 otherwise. dev1 <- function(s,y) log(1+exp(-abs(s))) + abs(s)*((y-0.5)*s<0) dev2 <- function(s,y) log1p(exp(-abs(s))) + abs(s)*((y-0.5)*s<0) dev3 <- function(s,y) -( y * plogis(s, log.p=TRUE) + (1-y)*plogis(s, lower.tail=FALSE, log.p=TRUE)) ## MM[FIXME]: first tests indicate that dev3() is clearly more accurate than ## their dev1() !! ## MM{FIXME2}: In code below have (or "had") three cases of same formula, but ## with 's>0' instead of 's<0' : This is == dev?(-s, y) !! ## for now, 100% back-compatibility: devBY <- dev1 rm(dev1, dev2, dev3) ## MM: This is from my vignette, but *not* used log1pexp <- function(x) { if(has.na <- any(ina <- is.na(x))) { y <- x x <- x[ok <- !ina] } t1 <- x <= 18 t2 <- !t1 & (tt <- x <= 33.3) r <- x r[ t1] <- log1p(exp(x[t1])) r[ t2] <- { x2 <- x[t2]; x2 + exp(-x2) } r[!tt] <- x[!tt] if(has.na) { y[ok] <- r ; y } else r } phiBY3 <- function(s,y,c3) { s <- as.double(s) ## MM FIXME log(1 + exp(-.)) ... but read the note above !! --- dev. <- devBY(s,y) ## FIXME: GBY3Fs() computes the 'dev' above *again*, and ## GBY3Fsm() does with 's>0' instead of 's<0' rhoBY3(dev.,c3) + GBY3Fs(s,c3) + GBY3Fsm(s,c3) } rhoBY3 <- function(t,c3) { ec3 <- exp(-sqrt(c3)) t*ec3* (t <= c3) + (ec3*(2+(2*sqrt(c3))+c3) - 2*exp(-sqrt(t))*(1+sqrt(t)))* (t > c3) } psiBY3 <- function(t,c3) { exp(-sqrt(c3)) *(t <= c3) + exp(-sqrt( t)) *(t > c3) } ## MM: This is shorter (but possibly slower when most t are <= c3 : ## psiBY3 <- function(t,c3) exp(-sqrt(pmax(t, c3))) ##' d/dt psi(t, c3) derpsiBY3 <- function(t, c3) { r <- t r[in. <- (t <= c3)] <- 0 if(any(out <- !in.)) { t <- t[out] st <- sqrt(t) r[out] <- -exp(-st)/(2*st) } r } ## MM: FIXME this is not used above sigmaBY3 <- function(sigma,s,y,c3) { mean(phiBY3(s/sigma,y,c3)) } derphiBY3 <- function(s,y,c3) { Fs <- exp(-devBY(s,1)) ds <- Fs*(1-Fs) ## MM FIXME: use expm1() dev. <- devBY(s,y) Gprim1 <- devBY(s,1) Gprim2 <- devBY(-s,1) -psiBY3(dev.,c3)*(y-Fs) + ds*(psiBY3(Gprim1,c3) - psiBY3(Gprim2,c3)) } der2phiBY3 <- function(s, y, c3) { s <- as.double(s) Fs <- exp(-devBY(s,1)) ds <- Fs*(1-Fs) ## MM FIXME: use expm1() dev. <- devBY(s,y) Gprim1 <- devBY(s,1) Gprim2 <- devBY(-s,1) der2 <- derpsiBY3(dev.,c3)*(Fs-y)^2 + ds*psiBY3(dev.,c3) der2 <- der2+ ds*(1-2*Fs)*(psiBY3(Gprim1,c3) - psiBY3(Gprim2,c3)) der2 - ds*(derpsiBY3(Gprim1,c3)*(1-Fs) + derpsiBY3(Gprim2,c3)* Fs ) } GBY3Fs <- function(s,c3) { e.f <- exp(0.25)*sqrt(pi) ## MM FIXME: Fs = exp(..) and below use log(Fs) !! Fs <- exp(-devBY(s,1)) resGinf <- e.f*(pnorm(sqrt(2)*(0.5+sqrt(-log(Fs))))-1) ## MM FIXME: use expm1(): resGinf <- (resGinf+(Fs*exp(-sqrt(-log(Fs)))))*as.numeric(s <= -log(exp(c3)-1)) resGsup <- ((Fs*exp(-sqrt(c3)))+(e.f*(pnorm(sqrt(2)*(0.5+sqrt(c3)))-1))) * as.numeric(s > -log(exp(c3)-1)) resGinf + resGsup } GBY3Fsm <- function(s,c3) { e.f <- exp(0.25)*sqrt(pi) ## MM FIXME: Fsm = exp(..) and below use log(Fsm) !! Fsm <- exp(-devBY(-s,1)) resGinf <- e.f*(pnorm(sqrt(2)*(0.5+sqrt(-log(Fsm))))-1) ## MM FIXME: use expm1(): resGinf <- (resGinf+(Fsm*exp(-sqrt(-log(Fsm))))) * as.numeric(s >= log(exp(c3)-1)) resGsup <- ((Fsm*exp(-sqrt(c3)))+(e.f*(pnorm(sqrt(2)*(0.5+sqrt(c3)))-1))) * as.numeric(s < log(exp(c3)-1)) resGinf + resGsup } ## Compute the standard erros of the estimates - ## this is done by estimating the asymptotic variance of the normal ## limiting distribution of the BY estimator - as derived in Bianco ## and Yohai (1996) ## sterby3 <- function(x0, y, const, estim, addIntercept) { sqrt(diag(vcovBY3(x0, y, const=const, estim=estim, addIntercept=addIntercept))) } vcovBY3 <- function(z, y, const, estim, addIntercept) { stopifnot(length(dim(z)) == 2) if(addIntercept) z <- cbind(1, z) d <- dim(z) n <- d[1] p <- d[2] argum <- z %*% estim matM <- IFsqr <- matrix(0, p, p) for(i in 1:n) { myscalar <- as.numeric(der2phiBY3(argum[i],y[i], c3=const)) zzt <- tcrossprod(z[i,]) matM <- matM + myscalar * zzt IFsqr <- IFsqr + derphiBY3(argum[i],y[i], c3=const)^2 * zzt } matM <- matM/n matMinv <- solve(matM) IFsqr <- IFsqr/n ## Now, asymp.cov = matMinv %*% IFsqr %*% t(matMinv) ## provide vcov(): the full matrix (matMinv %*% IFsqr %*% t(matMinv))/n } robustbase/R/anova-glmrob.R0000644000176200001440000001337512425760522015351 0ustar liggesusers anova.glmrob <- function(object, ..., test = c("Wald", "QD", "QDapprox")) { dotargs <- list(...) if (!is.null(names(dotargs))) { named <- (names(dotargs) != "") if (any(named)) { warning("the following arguments to 'anova.glmrob' are invalid and", "dropped:\n", pasteK(deparse(dotargs[named]))) dotargs <- dotargs[!named] } } is.glmrob <- vapply(dotargs, inherits, NA, what="glmrob") if(!all(is.glmrob) || !inherits(object, "glmrob")) stop("anova.glmrob() only works for 'glmrob' objects") test <- match.arg(test) if (length(dotargs) > 0) anovaGlmrobList(c(list(object), dotargs), test=test) else { ## ## "'Anova Table' for a single model object stop("'Anova Table' for a single model object not yet implemented") } } anovaGlmrobList <- function (object, test=NULL) { nmodels <- length(object) stopifnot(nmodels >= 2) responses <- as.character(lapply(object, function(x) deparse(formula(x)[[2]]))) if (!all(responses == responses[1])) stop("Not the same response used in the fitted models") nobs <- sapply(object, function(x) length(x$residuals)) if (any(nobs != nobs[1])) stop("models were not all fitted to the same size of dataset") methods <- as.character(lapply(object, function(x) x$method)) if(!all(methods == methods[1])) stop("Not the same method used for fitting the models") note <- paste("Models fitted by method '", methods[1], "'", sep="") tccs <- sapply(object, function(x) length(x$tcc)) if(!all(tccs == tccs[1])) stop("Not the same tuning constant c used in the robust fits") ## tbl <- matrix(rep(NA, nmodels*4), ncol = 4) tbl[1,1] <- nobs[1] - length(coef(object[[1]])) for(k in 2:nmodels) tbl[k,] <- anovaGlmrobPair(object[[k-1]], object[[k]], test=test) ## return dimnames(tbl) <- list(1:nmodels, c("pseudoDf", "Test.Stat", "Df", "Pr(>chisq)")) title <- switch(test, Wald = "Robust Wald Test Table", QD = "Robust Quasi-Deviance Table", QDapprox = "Robust Quasi-Deviance Table Based on a Quadratic Approximation", "") variables <- lapply(object, function(x) paste(deparse(formula(x)), collapse = "\n")) topnote <- paste("Model ", format(1:nmodels), ": ", variables, sep = "", collapse = "\n") structure(as.data.frame(tbl), heading = c(title, "", topnote, note,""), class = c("anova", "data.frame")) } anovaGlmrobPair <- function(obj1, obj2, test) { if(length(coef(obj1)) < length(coef(obj2))){ Sign <- 1 full.mfit <- obj2 reduced.mfit <- obj1 } else { Sign <- -1 full.mfit <- obj1 reduced.mfit <- obj2 } X <- model.matrix(full.mfit) asgn <- attr(X, "assign") tt <- terms(full.mfit) tt0 <- terms(reduced.mfit) tl <- attr(tt, "term.labels") tl0 <- attr(tt0, "term.labels") numtl0 <- match(tl0 , tl, nomatch = -1) if(attr(tt0, "intercept") == 1) numtl0 <- c(0, numtl0) if(any(is.na(match(numtl0, unique(asgn))))) stop("Models are not nested!") mod0 <- seq(along = asgn)[!is.na(match(asgn, numtl0))] if (length(asgn) == length(mod0)) stop("Models are not strictly nested") H0ind <- setdiff(seq(along = asgn), mod0) H0coef <- coef(full.mfit)[H0ind] df <- length(H0coef) pp <- df + length(mod0) if(test == "Wald") { t.cov <- full.mfit$cov t.chisq <- sum(H0coef * solve(t.cov[H0ind, H0ind], H0coef)) statistic <- c(chisq = t.chisq) } else if(full.mfit$method=="Mqle" && (test == "QD" || test == "QDapprox")) { matM <- full.mfit$matM if(test == "QDapprox") { ## Difference of robust quasi-deviances ## via the asymptotically equivalent quadratic form matM11 <- matM[mod0, mod0, drop=FALSE] matM12 <- matM[mod0, H0ind, drop=FALSE] matM22 <- matM[H0ind, H0ind, drop=FALSE] matM22.1 <- matM22 - crossprod(matM12, solve(matM11, matM12)) Dquasi.dev <- nrow(X) * c(H0coef %*% matM22.1 %*% H0coef) } else { quasiDev <- switch(full.mfit$family$family, poisson = glmrobMqleDiffQuasiDevPois, binomial = glmrobMqleDiffQuasiDevB, Gamma = glmrobMqleDiffQuasiDevGamma, stop("This family is not implemented")) ## note that qdev and qdev0 do depend on an incorrectly specified ## lower limits in the integration. But this does't matter in ## the following difference, because the difference does not ## deepend on it! (Hence I could use the centered nui ## (cnui= nui - Enui) in quasiDev as the function to be integrated. Dquasi.dev <- quasiDev(mu = full.mfit$fitted.values, mu0 = reduced.mfit$fitted.values, y = full.mfit$y, ni = full.mfit$ni, w.x = full.mfit$w.x, phi=full.mfit$dispersion, tcc = full.mfit$tcc) } ## Asymptotic distribution: variance and weights of the sum of chi2 matQ <- full.mfit$matQ matM11inv <- solve(matM[mod0,mod0]) Mplus <- matrix(0, ncol = pp, nrow = pp) Mplus[mod0, mod0] <- matM11inv d.ev <- Re(eigen(matQ %*% (solve(matM)-Mplus), only.values=TRUE)$values) d.ev <- d.ev[1:df] ## just the q (=df) lagest eigenvalues are needed if(any(d.ev < 0)) warning("some eigenvalues are negative") ## p-value: exact computation for q=1, approximated for q>1 (q=df) statistic <- c(quasi.dev = Dquasi.dev/mean(d.ev)) } else stop("non-implemented test method:", test, "for fitting method", full.mfit$method) ## return c(nrow(X)-pp+df*(Sign<0), Sign*statistic, Sign*df, pchisq(as.vector(statistic), df=df, lower.tail = FALSE)) } robustbase/R/MTestimador2.R0000644000176200001440000003657212553432042015276 0ustar liggesusers##-*- mode: R; kept-new-versions: 50; kept-old-versions: 50 -*- #### MT Estimators: [M]-Estimators based on [T]ransformations #### ------------- Valdora & Yohai (2013) ##' Defining the spline to compute the center of the rho function ##' @title Provide mu(lambda) as spline function ##' @param cw tuning parameter for rho ##' @return a function, resulting from \code{\link{splinefun}} ##' @author Victor Yohai; many changes: Martin Maechler mk.m_rho <- function(cw, opt.method = c("L-BFGS-B", "Brent", "Nelder-Mead", "BFGS", "CG", "SANN"), ##optim(): method = c("Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN", "Brent"), ## MM: 'Brent' seems best overall lambda = c(seq(0,2.9, by=0.1), seq(3,100)), reltol = sqrt(.Machine$double.eps), trace = 0, sFile = paste0("MTesSpl_", format(cw), ".rda"), recompute = getOption("robustbase:m_rho_recompute", FALSE)) { ## FIXME: Solution without files, but rather cache inside an environment ## ------ For the default cw, cache even in robustbase namespace! ## Instead of saving splinefun() ... just save (lambda, mm.la), it is much smaller if(recompute) { useFile <- FALSE } else { useFile <- file.exists(sFile) if (useFile) { ## load the spline load(sFile)#-> 'm.approx' ## check if its cw was very close to this one: if(cw.ok <- is.numeric(cw0 <- environment(m.approx)$cw)) cw.ok <- (abs(cw - cw0) < 0.001) } } if(!useFile || !cw.ok) { nl <- length(lambda) mm.la <- numeric(nl) s.la <- sqrt(lambda) ## MM: Speedwise, Brent > L-BFGS-B > BFGS > .. for cw >= ~ 1.5 ## L-BFGS-B > Brent for cw ~= 1 opt.method <- match.arg(opt.method) oCtrl <- list(reltol=reltol, trace=trace) if(opt.method %in% c("Brent", "L-BFGS-B")) { ## use bounds if(opt.method == "L-BFGS-B")# yuck! why is this necessary!! oCtrl <- list(factr = 1/(10*reltol), trace=trace) for(i in seq_len(nl)) mm.la[i] <- optim(s.la[i], espRho, lam = lambda[i], cw = cw, method = opt.method, control = oCtrl, lower = 0, upper = .01 + 2*s.la[i])$par } else { for(i in seq_len(nl)) mm.la[i] <- optim(s.la[i], espRho, lam = lambda[i], cw = cw, method = opt.method, control = oCtrl)$par } m.approx <- splinefun(lambda, mm.la, method = "monoH.FC") e <- environment(m.approx) assign("lambda.max", max(lambda), envir=e) assign("cw", cw, envir=e) save(m.approx, file = sFile) } m.approx } ## result 'm.approx' will be used in mm(.), and "everywhere" below ####################################################### ##' Tukey's Bisquare (aka "biweight") rho function: rho~() = rho scaled to have rho(Inf) = 1 rho <- function(x,cw) pmin(1, 1 - (1-(x/cw)^2)^3) ## faster: rho <- function(x,cw) Mchi(x, cc=cw, psi="tukey") ## NB: in sumaConPesos(), mm(.), ... we make use of the fact that rho(Inf) = 1 psi <- function(x,cw, deriv=0) Mpsi(x, cc=cw, psi="tukey", deriv=deriv) espRho <- function(lam, xx, cw) { ## compute E := E_lambda [ rho_{cw}( sqrt(Y)-xx ) ], given (lambda, xx, cw) ## for Y ~ Pois(lambda) ; rho(.) = Tukey's Bisquare ## ==> E = \sum_{k=0}^\infty rho( sqrt(k)-xx, .) * dpois(k, .) k <- seq(as.integer((max(0,xx-cw))^2), as.integer((xx+cw)^2)+1L) inner <- (rhoS.k <- rho(sqrt(k)-xx, cw)) < 1 ii <- k[inner] terminos <- rhoS.k[inner] * dpois(ii,lam) if((len.ii <- length(ii)) > 0) { primero <- ii[1] ultimo <- ii[len.ii] ppois(primero-1,lam) + sum(terminos) + ppois(ultimo,lam, lower.tail=FALSE) } else 1 } ################################################# ##' @title Compute m(lambda) := the value of x minimizing espRho(lambda, x, cw) ##' @param lam numeric vector of non-negative values \lambda ##' @param m.approx the spline function to be used for "small" lambda, from mk.m_rho() ##' @return mm <- function(lam, m.approx) { la.max <- environment(m.approx)$lambda.max z <- ((m <- lam) <= la.max) m[z] <- m.approx(lam[z]) if(any(i <- !z)) m[i] <- sqrt(lam[i]) m } ############################################################################### ##' @title Compute the loss function for MT-glmrob() ##' @param beta beta (p - vector) ##' @param x design matrix (n x p) ##' @param y (Poisson) response (n - vector) ##' @param cw tuning parameter 'c' for rho_c(.) ##' @param w weight vector (length n) ##' @param m.approx the spline for the inner part of m_c(.) ##' @return \sum_{i=1}^n w_i \rho(\sqrt(y_i) - m( g(x_i ` \beta) ) ) ##' where g(.) = exp(.) for the Poisson family sumaConPesos <- function(beta,x,y,w, cw, m.approx) { eta <- x %*% beta s <- rho(sqrt(y) - mm(exp(eta), m.approx), cw) sum(s*w) } ############################################################################### beta0IniCP <- function(x,y,cw,w, m.approx, nsubm, trace.lev = 1) { ## computes the initial estimate using subsampling with concentration step stopifnot(is.matrix(x), (nsubm <- as.integer(nsubm)) >= 1) p <- ncol(x) n <- nrow(x) s2.best <- Inf; b.best <- rep(NA_real_, p) kk <- 0 for(l in 1:nsubm) { if(trace.lev) { if(trace.lev > 1) cat(sprintf("%3d:",l)) else cat(".", if(l %% 50 == 0) paste0(" ",l,"\n")) } i.sub <- sample(n, p) estim0 <- as.vector( betaExacto(x[i.sub,], y[i.sub]) ) if(any(is.na(estim0))) ## do not use it next eta <- as.vector(x %*% estim0) ## adev := abs( 1/2 * dev.residuals(.) ) ## y+(y==0) : log(0) |-> -Inf fine; but if eta == -Inf, we'd get NaN adev <- abs(y*(log(y+(y == 0)) - eta) - (y-exp(eta))) ## poisson()'s dev.resids(): 2 * wt * (y * log(ifelse(y == 0, 1, y/mu)) - (y - mu)) ## == 2*wt* (y * ifelse(y == 0, 0, log(y) - log(mu)) - (y - mu)) ## == 2*wt* ifelse(y == 0, mu, y*(log(y) - log(mu)) - (y - mu)) ## where mu <- exp(eta) if(trace.lev > 1) cat(sprintf(" D=%11.7g ", sum(adev))) half <- ceiling(n/2) srt.d <- sort(adev, partial=half) podador <- adev <= srt.d[half] # those smaller-equal than lo-median(.) xPod <- x[podador,] yPod <- y[podador] length(xPod) + length(yPod) # codetools fitE <- tryCatch(glm(yPod ~ xPod-1, family = poisson()), error = function(e)e) if(inherits(fitE, "error")) { message("glm(.) {inner subsample} error: ", fitE$message) if(trace.lev > 1) cat("\n") ## s2[l] <- Inf } else { ## glm() call succeeded betapod <- as.vector( fitE$coefficients ) if(any(is.na(betapod))) ## do not use it next kk <- kk+1 s2 <- sumaConPesos(betapod, x=x, y=y, w=w, cw=cw, m.approx=m.approx) ## estim.ini[l,] <- betapod if(trace.lev > 1) cat(sprintf("s2=%14.9g", s2)) if(s2 < s2.best) { if(trace.lev > 1) cat(" New best!\n") b.best <- betapod s2.best <- s2 } else if(trace.lev > 1) cat("\n") } } ## s0 <- order(s2) ## beta0ini <- estim.ini[s0[1],] list(beta = b.best, nOksamples = kk, s2 = s2.best) }## beta0IniCP() ##################################################################### betaExacto <- function(x,y) { ## to each subsample assign the maximum likelihood estimator and ## fixing the case mle has NA components p <- ncol(x) fitE <- tryCatch(glm.fit(x=x, y=y, family = poisson()), ## TODO , weights = weights, offset = offset error = function(e)e) if(inherits(fitE, "error")) { message("betaExacto glm(.) error: ", fitE$message) return(rep(NA_real_, p)) } ## else -- glm() succeeded ## if_needed_-- MM finds it unneeded ## beta. <- fitE $ coefficients ## sinNas <- na.exclude(beta.) ## long <- length(sinNas) ## lugaresNas <- na.action(sinNas)[1:(p-long)] ## beta.SinNas <- beta. ## beta.SinNas[lugaresNas] <- 0 ## beta.SinNas fitE $ coefficients } ###--- Utilities for Asymptotic Covariance Matrix ----------------- ##' computes the First Derivative of mm() mmd <- function(lam,cw, m.approx) { qq1 <- qpois(.001,lam) qq2 <- qpois(.999,lam) ind <- qq1:qq2 k.. <- sqrt(ind) - mm(lam, m.approx) dP <- dpois(ind,lam) rr1 <- (-dP+(ind*dP/lam)) * psi(k..,cw) rr2 <- dP*psi(k..,cw, deriv=1) rr1 <- sum(rr1) rr2 <- sum(rr2) list(ind=ind, rr1=rr1, rr2=rr2, d = rr1/rr2) } ##' computes the Second Derivative of mm() mmdd <- function(lam,cw, m.approx) { out <- mmd(lam,cw, m.approx) ## FIXME: can reuse even more from mmd() ! ind <- out[["ind"]] NUM <- out[[2]] DEN <- out[[3]] mm1 <- out[["d"]] ## = mm'(.) k.. <- sqrt(ind) - mm(lam, m.approx) dP <- dpois(ind,lam) NUMP <- ddpois(ind,lam) * psi(k..,cw) - (-dP+(ind*dP/lam))* psi(k..,cw, deriv=1) * mm1 DENP <- (-dP+(ind*dP/lam)) * psi(k..,cw, deriv=1) - dP*psi(k..,cw, deriv=2) * mm1 NUMP <- sum(NUMP) DENP <- sum(DENP) (NUMP*DEN - DENP*NUM) / DEN^2 } ############################################################### ddpois <- function(x,lam) { ## The second derivative of the Poisson probability function dpois(x,lam)*(1-(2*x/lam)+((x^2)/(lam^2))-(x/(lam^2))) } ##' Compute asymptotic covariance matrix of the MT estimator covasin <- function(x,y,beta,cw, m.approx,w) { p <- ncol(x) n <- length(y) mm1 <- mm2 <- numeric(n) de <- nu <- matrix(0,p,p) lam <- x%*%beta elam <- exp(lam) r <- sqrt(y) - mm(elam, m.approx) psi0 <- psi(r,cw) psi1 <- psi(r,cw, deriv=1) for ( i in 1:n) { ## FIXME: Make more efficient!! {mmd is used in mmdd()) mm1[i] <- mmd (elam[i], cw, m.approx)[[4]] mm2[i] <- mmdd(elam[i], cw, m.approx) } nu1 <- w*psi0*mm1*elam de1 <- -psi1*(mm1^2)*(elam^2)+psi0*mm2*(elam^2)+psi0*mm1*elam de1 <- w*de1 for (i in 1:n) { ## FIXME (?) -- can be vectorized zzt <- tcrossprod(x[i,]) nu <- nu+ (nu1[i]^2)*zzt de <- de+ de1[i]*zzt } nu <- nu/n de <- solve(de/n) ## Cov_{asympt.} = de %*% nu %*% t(de) / n } ## cw = 2.1, nsubm = 500, maxitOpt = 200, tolOpt = 1e-6, glmrobMT.control <- function(cw = 2.1, nsubm = 500, acc = 1e-06, maxit = 200) { if (!is.numeric(acc) || acc <= 0) stop("value of acc must be > 0") ## if (test.acc != "coef") ## stop("Only 'test.acc = \"coef\"' is currently implemented") ## if (!(any(test.vec == c("coef", "resid")))) ## stop("invalid argument for test.acc") if (!is.numeric(nsubm) || nsubm <= 0) stop("number of subsamples must be > 0") if (!is.numeric(maxit) || maxit <= 0) stop("maximum number of iterations must be > 0") if (!is.numeric(cw) || cw <= 0) stop("value of the tuning constant c (cw) must be > 0") list(cw=cw, nsubm=nsubm, acc=acc, maxit=maxit) } ################################################################################### ##' @param intercept logical, if true, x[,] has an intercept column which should ##' not be used for rob.wts glmrobMT <- function(x,y, weights = NULL, start = NULL, offset = NULL, family = poisson(), weights.on.x = "none", control = glmrobMT.control(...), intercept = TRUE, trace.lev = 1, ...) { ## MAINFUNCTION Computes the MT or WMT estimator for Poisson regression with intercept starting from the estimator computed in the function ## beta0IniC. ## INPUT ## x design matrix with nrows and p columns. ## y respone vector of length n ## cw tuning constant. Default value 2.1 ## iweigths indicator for weights penalizing high leverage points, iweights=1 indicates to use weights iweights=0 ## indicate notto use way. Default value is iw=0, Our simulation study suggests not to use weights. ## nsubm Number of subsamples. Default calue nsubm=500 ## OUTPUT ##$initial is the inital estimate (first component is the intercept) ##$final is the final estimate (first component is the intercept) ##$nsamples is the number of well conditioned subsamples ## REQUIRED PACKAGES: tools, rrcov stopifnot(is.numeric(cw <- control$cw), cw > 0, is.numeric(nsubm <- control$nsubm)) if(family$family != "poisson") stop("Currently, only family 'poisson' is supported for the \"MT\" estimator") n <- nrow(x) p <- ncol(x) if (is.null(weights)) weights <- rep.int(1, n) else if(any(weights <= 0)) stop("All weights must be positive") if(!is.null(offset)) stop("non-trivial 'offset' is not yet implemented") ## if (is.null(offset)) ## offset <- rep.int(0, n) else if(!all(offset==0)) ## warning("'offset' not fully implemented") linkinv <- family$linkinv variance <- family$variance ## Copy-paste from ./glmrobMqle.R [overkill currently: Poisson has sni == ni == 1] ni <- as.vector(weights) sni <- sqrt(ni) comp.V.resid <- expression({ Vmu <- variance(mu) if (any(is.na(Vmu))) stop("NAs in V(mu)") if (any(Vmu == 0)) stop("0s in V(mu)") sVF <- sqrt(Vmu) # square root of variance function residP <- (y - mu)* sni/sVF # Pearson residuals }) m.approx <- mk.m_rho(cw) w <- robXweights(weights.on.x, x, intercept=intercept) if(is.null(start)) { if(trace.lev) cat("Computing initial estimate with ", nsubm, " sub samples:\n") out <- beta0IniCP(x, y, cw = cw, w = w, m.approx = m.approx, nsubm = nsubm, trace.lev = trace.lev) start <- out[[1]] } else { ## user provided start: if(!is.numeric(start) || length(start) != p) stop(gettextf("'start' must be an initial estimate of beta, of length %d", p), domain=NA) } oCtrl <- list(trace = trace.lev, maxit = control$maxit, ## "L-BFGS-B" specific lmm = 9, factr = 1/(10*control$acc)) if(trace.lev) cat("Optim()izing sumaConPesos()\n") ### FIXME: quite slow convergence e.g. for the Possum data ( ../tests/glmrob-1.R ) ### ----- maybe improve by providing gradient ?? estim2 <- optim(start, sumaConPesos, method = "L-BFGS-B", x = x, y = y, w = w, cw = cw, m.approx = m.approx, control = oCtrl) o.counts <- estim2$counts if(estim2$convergence) ## there was a problem warning("optim(.) non-convergence: ", estim2$convergence, if(nzchar(estim2$message)) paste0("\n", estim2$message)) beta <- estim2$par cov <- covasin(x,y, beta=beta, cw=cw, m.approx=m.approx, w=w) eta <- as.vector(x %*% beta) # + offset mu <- linkinv(eta) eval(comp.V.resid)#-> residP ==(here!) == residPS ## As sumaConPesos() computes ## eta <- x %*% beta ## s <- rho(sqrt(y) - mm(exp(eta), m.approx), cw) ## sum(s*w) ## we could say that "psi(x) / x" -- weights would be w.r <- Mwgt(sqrt(y) - mm(exp(eta), m.approx), cw, psi="tukey") names(mu) <- names(eta) <- names(residP) # re-add after computation names(beta) <- names(start) <- nmB <- colnames(x) ## maybe: dimnames(cov) <- list(nmB, nmB) list(coefficients = beta, initial = start, family = poisson(), # <- only case for now coefficients = beta, residuals = residP, # s.resid = residPS, fitted.values = mu, linear.predictors = eta, cov = cov, nsubm = nsubm, "nOksub" = out[[2]], converged = (estim2$convergence == 0), iter = o.counts[[1]], optim.counts = o.counts, optim.control = oCtrl, cw=cw, weights.on.x=weights.on.x, w.x = w, w.r = w.r) } robustbase/R/comedian.R0000644000176200001440000001401712441664610014535 0ustar liggesusers### -*- mode: R ; delete-old-versions: never -*- ## 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, a copy is available at ## http://www.r-project.org/Licenses/ ### From package 'Biobase' (has only rowMedians + rowQ) / 'matrixStats' ### MM: all type checking now in C ## --- TODO: implement hasNA=NA ==> do check maybe differently than = TRUE ## --> ../src/rowMedians.c + ../src/rowMedians_TYPE-template.h colMedians <- function(x, na.rm=FALSE, hasNA=TRUE, keep.names=TRUE) .Call(R_rowMedians, x, na.rm, hasNA, FALSE, keep.names) rowMedians <- function(x, na.rm=FALSE, hasNA=TRUE, keep.names=TRUE) .Call(R_rowMedians, x, na.rm, hasNA, TRUE, keep.names) ### Maria Anna di Palma, without consistency factor 15.11.2014 ### Fixes by Valentin Todorov ### Martin Maechler: added mad() consistency factor, 27.11.2014 ### new name, class; more compatible to 'covMcd' covComed <- function (X, n.iter = 2, reweight = FALSE, tolSolve = control$ tolSolve,# had 1e-10 hardwired {now 1e-14 default} trace = control$ trace, wgtFUN = control$ wgtFUN, control = rrcov.control()) { ## ATTENTION ## ## Med(abs(X))^2=Med(X*X) only if the number of rows is odd d <- dim(X <- as.matrix(X)) n <- d[1] p <- d[2] if(is.character(wgtFUN)) wgtFUN <- .wgtFUN.covComed[[wgtFUN]](p=p, n=n, control) if(!is.function(wgtFUN)) stop("'wgtFUN' must be a function or a string specifying such a function") madX <- apply(X, 2, mad) I.mad <- 1/madX rho <- I.mad * COM(X) * rep(I.mad, each = p) ## better than ## D <- diag(1/madX) ## rho <- D %*% COM(X) %*% t(D) U <- svd(rho, p, nv = 0L)$u ## DD <- diag(madX) ## Q <- DD %*% U ## invQ <- solve(Q) ## == t(U) %*% D -- since U is orthogonal! t.inv.Q <- I.mad * U # = t(solve(Q)) = t(t(U) * D) == t(D) U = D U Z <- X %*% t.inv.Q ## much faster than for (i in 1:n) Z[i,] <- invQ %*% X[i,] out <- comedian(rho, Z, X) ## Mahalanobis distance for(it in seq_len(n.iter))# allow n.iter = 0 out <- comedian(out$S., out$Z, X) mm <- colMedians(out$Z) mx <- drop(out$Q %*% mm) ## MM: These are "raw" distances compared to covMcd() mah <- mahalanobis(X, mx, out$S., tol = tolSolve) ## compute weights weights <- wgtFUN(mah) covW <- cov.wt(X, wt=weights)[c("cov", "center", "n.obs")] covW$weights <- if(reweight) { ## above 'mah' = 'raw.mah' .. ==> allow another reweighting as in covMcd() covW$raw.weights <- weights covW$mah <- mahalanobis(X, covW$center, covW$cov, tol = tolSolve) wgtFUN(mah) } else # no re-weighting weights structure(class = "comed", c(list(Z = out$Z, raw.cov = out$S., raw.center = mx, raw.mah = mah, wgtFUN=wgtFUN), covW)) } ##' Martin Maechler's simple proposal for an *adaptive* cutoff ##' i.e., one which does *not* reject outliers in good samples asymptotically .COM.adaptWgt.c <- function(n,p, eps = 0.2 / n^0.3) { ## default eps ==> 1-eps(n=100) ~= 0.95; 1-eps(n=10) ~= 0.90 ## using upper tail: 1.4826 * qchisq(eps, p, lower.tail=FALSE) / qchisq(0.5, p) } ## Default wgtFUN() constructors for covComed(): .wgtFUN.covComed <- list("01.original" = function(p, ...) { cMah <- .COM.adaptWgt.c(p=p, eps = 0.05)# 1 - eps = 0.95 function(d) as.numeric(d < median(d)*cMah) }, "01.flex" = function(p, n, control) { ## 'beta' instead of 0.95 stopifnot(is.1num(beta <- control$beta), 0 <= beta, beta <= 1) cMah <- 1.4826 * qchisq(beta, p) / qchisq(0.5, p) function(d) as.numeric(d < median(d)*cMah) }, "01.adaptive" = function(p, n, ...) { ## 'beta_n' instead of 0.975 cMah <- .COM.adaptWgt.c(n,p) function(d) as.numeric(d < cMah) }, "sm1.flex" = function(p, n, control) { ## 'beta' / smooth weight stopifnot(is.1num(beta <- control$beta), 0 <= beta, beta <= 1) cMah <- 1.4826 * qchisq(beta, p) / qchisq(0.5, p) function(d) smoothWgt(d / median(d), c=cMah, h = 1) }, "sm1.adaptive" = function(p, n, ...) { cMah <- .COM.adaptWgt.c(n=n, p=p) function(d) smoothWgt(d / median(d), c = cMah, h = 1) }, "sm2.adaptive" = function(p, n, ...) { cMah <- .COM.adaptWgt.c(n=n, p=p) function(d) smoothWgt(d / median(d), c = cMah, h = 2) } ) comedian <- function (rho, Z, X) { p <- ncol(X) U <- svd(rho, nv = 0L)$u madX <- apply(X, 2, mad) I.mad <- 1/madX ## D <- diag(madX) ## Q <- D %*% U Q <- madX * U ## invQ <- solve(Q) t.inv.Q <- I.mad * U # = t(solve(Q)) = t(t(U) * D) == t(D) U = D U Z <- X %*% t.inv.Q ## for (i in 1:n) Z[i,] <- invQ %*% X[i,] madZ <- apply(Z, 2, mad) list(Q=Q, Z=Z, S. = tcrossprod(Q * rep(madZ, each=p))) ## better than ## S. = Q %*% diag(madZ)^2 %*% t(Q) } COM <- function(X) { ## Comedian *with* consistency factor. Falk(1997) was without it. stopifnot(is.1num(p <- ncol(X)), p >= 1) med <- colMedians(X) Y <- sweep(X, 2L, med, `-`) COM <- matrix(0., p,p) madY <- numeric(p) for(i in 1:p) { madY[i] <- madYi <- mad(Yi <- Y[,i]) for(j in seq_len(i-1)) { # j <= i ==> madY[j] "exists" COM[j,i] <- COM[i,j] <- median(Yi * Y[,j]) / (madYi * madY[j]) ## COM[i,j] <- median((Y[,i])*(Y[,j])) ## COM[i,j] <- (1.4826^2)*median((Y[,i])*(Y[,j])) } ## j == i : COM[i,i] <- median(Yi^2) / (madYi^2) } ## return [ 1.4826 = formals(mad)$constant = consistency factor of mad()] 1.4826^2 * COM } robustbase/R/covPlot.R0000644000176200001440000002667113434014060014404 0ustar liggesusers#### This is from the R package #### #### rrcov : Scalable Robust Estimators with High Breakdown Point #### #### by Valentin Todorov ### 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, a copy is available at ## http://www.r-project.org/Licenses/ ## I would like to thank Peter Filzmoser for providing the initial code of ## this function. plot.mcd <- function(x, which=c("all", "dd","distance","qqchi2","tolEllipsePlot","screeplot"), classic= FALSE, ask = (which[1] == "all" && dev.interactive()), cutoff = NULL, id.n, labels.id = rownames(x$X), cex.id = 0.75, label.pos = c(4,2), tol = 1e-7, ...) { if (!inherits(x, "mcd")) stop("Use only with 'mcd' objects") covPlot(x$X, which= which, classic= classic, ask= ask, m.cov = x, cutoff= cutoff, id.n = id.n, labels.id, cex.id = cex.id, label.pos = label.pos, tol = tol, ...) } covPlot <- function(x, which = c("all", "dd", "distance", "qqchi2", "tolEllipsePlot", "screeplot"), classic = FALSE, ask = (which[1] == "all" && dev.interactive()), m.cov = covMcd(x), cutoff = NULL, id.n, labels.id = rownames(x), cex.id = 0.75, label.pos = c(4,2), tol = 1e-7, ...) { ##@bdescr ## Make plots based on the covariance structure of a data set: ## dd - distance-distance plot: Robust distances versus ## Mahalanobis distances ## distance - a plot of the robust distances ## qqchi2 - a qq-plot of the robust distances versus the ## quantiles of the chi-squared distribution ## tolEllipsePlot- a tolerance ellipse ## screeplot- a screeplot of the eigenvalues ov the covariance matrix ## ## Distance Plot: ## Draw a Distance-Distance Plot: Plots the robust distances ## versus the classical Mahalanobis distances as introduced by ## Rousseeuw, P. J., and van Zomeren, B. C. (1990). Unmasking ## Multivariate Outliers and Leverage Points. Journal of the American ## Statistical Association, 85, 633-639. ## ## The dashed line is the set of points where the robust distance is ## equal to the classical distance. ## The horizontal and vertical dotted lines are drawn at values equal cutoff ## which defaults to square root of the 97.5% quantile of a chi-squared ## distribution with p degrees of freedom. Points beyond these lines can ## be considered outliers. ## ##@edescr ## ##@in x : [matrix] A data.frame or matrix, n > 2*p ##@in which : [character] A plot option, one of: ## classic: index plot of the classical mahalanobis distances ## robust : index plot of the robust mahalanobis distances ## dd : distance-distance plot ## index : parallel index plot of classical and robust distances ## all : all three plots --- this is the default ## ##@in classic : [logical] If true the classical plot will be displayed too ## default is classic = FALSE ##@in m.cov : [list] An object like class "mcd" - only its attributes ## center and cov will be used ##@in cutoff : [number] The cutoff value for the distances ##@in id.n : [number] number of observations to be identified with a label. ## Defaults to the number of observations with ## distance larger than cutoff -- missing is propagated ##@in tol : [number] tolerance to be used for computing the inverse ## - see 'solve'. defaults to 1e-7 ## NOTE: The default tolerance 1e-7, will not work for some example ## data sets, like milk or aircraft myscreeplot <- function(x, m.cov = covMcd(x)) { erob <- eigen(m.cov$cov,symmetric = TRUE, only.values = TRUE)$values eclass <- eigen(var(x), symmetric = TRUE, only.values = TRUE)$values leg.txt <- c("Robust", "Classical") leg.col <- c("green", "red") leg.pch <- c(1,24) leg.lty <- c("solid", "dotted") eall <- c(erob,eclass) ylim <- c( min(eall), max(eall)) plot(erob, ylim=ylim, ylab="Eigenvalues", xlab="Index", type="n") legend("topright", leg.txt, pch = leg.pch, lty = leg.lty, col = leg.col) lines(erob, type="o", pch= leg.pch[1], lty= leg.lty[1], col=leg.col[1]) lines(eclass, type="o", pch= leg.pch[2], lty= leg.lty[2], col=leg.col[2]) title(main = "Scree plot") } mydistplot <- function(x, cutoff, classic = FALSE, id.n) { ## Index Plot: ## Plot the vector x (robust or mahalanobis distances) against ## the observation indexes. Identify by a label the id.n ## observations with largest value of x. If id.n is not supplied, ## calculate it as the number of observations larger than cutoff. ## Use cutoff to draw a horisontal line. ## Use classic = FALSE/TRUE to choose the label of the vertical axes n <- length(x) if(missing(id.n)) # maybe propagated id.n <- length(which(x > cutoff)) ylab <- paste("Square Root of", if(classic) "Mahalanobis" else "Robust", "distance") plot(x, type = "p", ylab = ylab, xlab = "Index", main = "Distance Plot") label(1:n, x, id.n) abline(h = cutoff) } myddplot <- function(md, rd, cutoff, id.n) { ## Distance-Distance Plot: ## Plot the vector y = rd (robust distances) against ## x = md (mahalanobis distances). Identify by a label the id.n ## observations with largest rd. If id.n is not supplied, calculate ## it as the number of observations larger than cutoff. Use cutoff ## to draw a horisontal and a vertical line. Draw also a dotted line ## with a slope 1. n <- length(md) if(missing(id.n)) # maybe propagated id.n <- length(which(rd > cutoff)) xlab <- "Mahalanobis distance" ylab <- "Robust distance" plot(md, rd, type = "p", xlab = xlab, ylab = ylab, main = "Distance-Distance Plot") label(md, rd, id.n) abline(0, 1, lty = 2) abline(v = cutoff, h = cutoff) } qqplot <- function(x, p, cutoff = sqrt(qchisq(0.975, p)), classic = FALSE, id.n) { ## Chisquare QQ-Plot: ## Plot the vector x (robust or mahalanobis distances) against ## the square root of the quantiles of the chi-squared distribution ## with p degrees of freedom. ## Identify by a label the id.n observations with largest value of x. ## If id.n is not supplied, calculate it as the number of observations ## larger than cutoff. ## Use classic = FALSE/TRUE to choose the label of the vertical axes ## parameters and preconditions n <- length(x) if(missing(id.n)) # maybe propagated id.n <- length(which(x > cutoff)) qq <- sqrt(qchisq(((1:n)-1/3)/(n+1/3), p)) x <- sort(x, index.return = TRUE) ix <- x$ix x <- x$x ylab <- paste(if(classic) "Mahalanobis" else "Robust", "distance") xlab <- "Square root of the quantiles of the chi-squared distribution" plot(qq, x, xlab = xlab, ylab = ylab, main = "Chisquare QQ-Plot") label(qq, x, id.n, ind = (n-id.n+1):n, labs = ix) abline(0, 1, lty = 2) } ## end{qqplot} label <- function(x, y, id.n, ind = sort.list(y, decreasing = TRUE)[1:id.n], labs = labels.id, adj.x = TRUE) { if(id.n > 0) { ## label the largest 'id.n' y-values labpos <- if(adj.x) label.pos[1+ as.numeric(x > mean(range(x)))] else 3 text(x[ind], y[ind], labs[ind], cex = cex.id, xpd = TRUE, pos = labpos, offset = 0.25) } } ## Begin{covPlot} -- arguments checking of preconditions if(is.data.frame(x)) x <- data.matrix(x) if(!is.matrix(x) || !is.numeric(x)) stop("x is not a numeric dataframe or matrix.") n <- dim(x)[1] p <- dim(x)[2] if(!is.numeric(m.cov$center) || !is.numeric(m.cov$cov)) stop("argument 'm.cov' must have numeric components 'center' and 'cov'") if(length(m.cov$center) != p) stop("Data set and provided center have different dimensions!") ## ?covPlot says it only needs 'cov' and 'center' ## Maybe should be smarter and *test* for non-singularity if(is.numeric(m.cov$crit) && m.cov$crit == 0) stop( "The covariance matrix is singular!") if(is.null(cutoff)) cutoff <- sqrt(qchisq(0.975, p)) ## now "more in line" with plot.lm()'s labeling: if(is.null(labels.id)) labels.id <- as.character(1:n) if(!missing(id.n) && !is.null(id.n)) { id.n <- as.integer(id.n) if(id.n < 0 || id.n > n) stop(sQuote("id.n")," must be in {1,..,",n,"}") } which <- match.arg(which) md <- sqrt(mahalanobis(x, colMeans(x), var(x), tol = tol)) rd <- sqrt(mahalanobis(x, m.cov$center, m.cov$cov, tol = tol)) ## *Never* here : par(mfrow = c(1,1), pty = "m") op <- if (ask) par(ask = TRUE) else list() on.exit(par(op)) if(which == "all" || which == "distance") { if(classic) { opr <- if(prod(par("mfrow")) == 1) par(mfrow = c(1,2), pty = "m") else list() } ## index plot of mahalanobis distances: mydistplot(rd, cutoff, id.n = id.n) if(classic) { ## index plot of robust distances: mydistplot(md, cutoff, classic = TRUE, id.n = id.n) par(opr) } } if(which == "all" || which == "dd") { myddplot(md, rd, cutoff = cutoff, id.n = id.n) # distance-distance plot } if(which == "all" || which == "qqchi2") { if(classic) { opr <- if(prod(par("mfrow")) == 1) par(mfrow = c(1,2), pty = "m") else list() } ## qq-plot of the robust distances versus the ## quantiles of the chi-squared distribution qqplot(rd, p, cutoff = cutoff, id.n = id.n) if(classic) { ## qq-plot of the mahalanobis distances qqplot(md, p, cutoff = cutoff, classic = TRUE, id.n = id.n) par(opr) } } if(which == "all" || which == "tolEllipsePlot") { if(p == 2) tolEllipsePlot(x, m.cov = m.cov, cutoff = cutoff, id.n = id.n, classic = classic, tol = tol) else if(which != "all") warning("For tolerance ellipses the dimension 'p' must be 2!") } if(which == "all" || which == "screeplot") { myscreeplot(x, m.cov = m.cov) } } ## end { covPlot } ## ddplot <- function(x,...) { ## covPlot(x, which="dd", ...) ## } ## distplot <- function(x,...) { ## covPlot(x, which="distance", ...) ## } ## chi2qqplot <- function(x,...) { ## covPlot(x, which="qqchi2", ...) ## } ## ellipse() exists in other packages ## ellipse <- function(x,...) { ## covPlot(x, which="tolEllipsePlot", ...) ## } robustbase/R/ltsReg.R0000644000176200001440000007101313325654420014215 0ustar liggesusers#### This is originally from the R package #### #### rrcov : Scalable Robust Estimators with High Breakdown Point #### #### by Valentin Todorov ## I would like to thank Peter Rousseeuw and Katrien van Driessen for ## providing the initial code of this function. ### 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, a copy is available at ### http://www.r-project.org/Licenses/ ltsReg <- function(x, ...) UseMethod("ltsReg") ltsReg.formula <- function(formula, data, subset, weights, na.action, model = TRUE, x.ret = FALSE, y.ret = FALSE, contrasts = NULL, offset, ...) { cl <- match.call() ## method <- match.arg(method) ## keep only the arguments which should go into the model frame mf <- match.call(expand.dots = FALSE) m <- match(c("formula", "data", "subset", "weights", "na.action", "offset"), names(mf), 0) mf <- mf[c(1, m)] mf$drop.unused.levels <- TRUE mf[[1]] <- as.name("model.frame") mf <- eval.parent(mf) ## if (method == "model.frame") return(mf) mt <- attr(mf, "terms") y <- model.response(mf, "numeric") ## was model.extract(mf, "response") if (is.empty.model(mt)) { # "y ~ 0" : no coefficients x <- offset <- NULL fit <- list(method = "ltsReg for empty model", coefficients = numeric(0), residuals = y, fitted.values = 0 * y, lts.wt = 1 + 0 * y, rank = 0, intercept = FALSE, df.residual = length(y)) ## alpha = alpha from "..." class(fit) <- "lts" } else { w <- model.weights(mf) offset <- model.offset(mf) x <- model.matrix(mt, mf, contrasts) ## Check if there is an intercept in the model. ## A formula without intercept looks like this: Y ~ . -1 ## If so, remove the corresponding column and use intercept=TRUE ## in the call to ltsReg.default(); by default, intercept=FALSE. xint <- match("(Intercept)", colnames(x), nomatch = 0) if(xint) x <- x[, -xint, drop = FALSE] fit <- ltsReg.default(x, y, intercept = (xint > 0), ...) } ## 3) return the na.action info fit$na.action <- attr(mf, "na.action") fit$offset <- offset ## 4) return the contrasts used in fitting: possibly as saved earlier. fit$contrasts <- attr(x, "contrasts") fit$xlevels <- .getXlevels(mt, mf) fit$call <- cl fit$terms <- mt if(model) fit$model <- mf if(x.ret) fit$x <- x # or? if(xint == 0) x else x[, c(2:p,1), drop=FALSE] if(y.ret) fit$y <- y fit } ltsReg.default <- function (x, y, intercept = TRUE, alpha = control$ alpha, nsamp = control$ nsamp, adjust = control$ adjust, mcd = TRUE, qr.out = FALSE, yname = NULL, seed = control$ seed, trace = control$ trace, use.correction = control$ use.correction, wgtFUN = control$ wgtFUN, control = rrcov.control(), ...) { ## Analyze and validate the input parameters ... ## if a control object was supplied, take the option parameters from it, ## but if single parameters were passed (not defaults) they will override the ## control object. ### MM: FIXME: this sucks ('control' may contain *some* but not all parts!): if(!missing(control)) { defCtrl <- rrcov.control() # default control if(is.null(alpha) && control$alpha != defCtrl$alpha) alpha <- control$alpha if(nsamp == defCtrl$nsamp) nsamp <- control$nsamp if(identical(seed, defCtrl$seed)) seed <- control$seed if(use.correction == defCtrl$use.correction) use.correction <- control$use.correction if(adjust == defCtrl$adjust) adjust <- control$adjust } else defCtrl <- control ## == rrcov.control() ## For back compatibility, as some new args did not exist pre 2013-04, ## and callers of covMcd() may use a "too small" 'control' list: if(missing(wgtFUN)) getDefCtrl("wgtFUN", defCtrl) if(length(seed) > 0) { if(length(seed) < 3 || seed[1L] < 100) stop("invalid 'seed'. Must be compatible with .Random.seed !") if(exists(".Random.seed", envir=.GlobalEnv, inherits=FALSE)) { seed.keep <- get(".Random.seed", envir=.GlobalEnv, inherits=FALSE) on.exit(assign(".Random.seed", seed.keep, envir=.GlobalEnv)) } assign(".Random.seed", seed, envir=.GlobalEnv) } if(alpha < 1/2 || alpha > 1) stop("alpha not inside [1/2, 1]") ## FIXME: change this analogously to covMcd()'s and covComedian()'s ## quantiel <- qnorm(0.9875) if(is.character(wgtFUN)) { switch(wgtFUN, "01.original" = { cW <- qnorm(0.9875) wgtFUN <- function(r) as.numeric(abs(r) <= cW) }, stop("unknown 'wgtFUN' specification: ", wgtFUN)) } else if(!is.function(wgtFUN)) stop("'wgtFUN' must be a function or a string specifying one") ## vt::03.02.2006 - raw.cnp2 and cnp2 are vectors of size 2 and will ## contain the correction factors (concistency and finite sample) ## for the raw and reweighted estimates respectively. Set them initially to 1. ## If use.correction is set to FALSE (default=TRUE), the finite sample correction ## factor will not be used (neither for the raw estimates nor for the reweighted) raw.cnp2 <- rep(1,2) cnp2 <- rep(1,2) ##cat("++++++ Entering ltsReg() ...\n") y <- data.matrix(y) if (!is.numeric(y)) stop("y is not a numeric") if (dim(y)[2] != 1) stop("y is not onedimensional") oneD <- (missing(x) || is.null(x) || NCOL(x) == 0) ## location model - no x if(oneD) { x <- matrix(1, nrow(y), 1) } else { ## x is present if(is.data.frame(x)) x <- data.matrix(x) else if (!is.matrix(x)) x <- matrix(x, length(x), 1, dimnames = list(names(x), deparse(substitute(x)))) } if (nrow(x) != nrow(y)) stop("Number of observations in x and y not equal") na.x <- !is.finite(rowSums(x)) na.y <- !is.finite(y) ok <- !(na.x | na.y) x <- x[ok, , drop = FALSE] y <- y[ok, , drop = FALSE] dx <- dim(x) n <- dx[1] if (n == 0) stop("All observations have missing values!") dimny <- dimnames(y) rownames <- dimny[[1]] yn <- if(!is.null(yname)) yname else if(!is.null(dimny[[2]])) dimny[[2]] has.yn <- !is.null(yn) if(!has.yn) yn <- "Y" storage.mode(y) <- "double" storage.mode(x) <- "double" if (!oneD) { is.const <- function(x) { c1 <- range(x) c1[1] == c1[2] } if (any(apply(x, 2, is.const))) stop("There is at least one constant column. Remove it and set intercept=TRUE") } ##cat("++++++ Prepare: Ready.\n") xn <- (dnx <- dimnames(x))[[2]] xn <- if(!is.null(xn)) xn else if (dx[2] > 1) paste("X", 1:dx[2], sep = "") else if (dx[2]) "X" ## else : p = 0 dimnames(x) <- list(dnx[[1]], xn) # also works if(is.null(dnx)) y <- as.vector(y) if(all(x == 1)) { ## includes 'oneD' and empty x (p = 0) if(qr.out) { warning("'qr.out = TRUE' for univariate location is disregarded") qr.out <- FALSE } h <- h.alpha.n(alpha, n, dx[2]) p <- 1 if (alpha == 1) { scale <- sqrt(drop(cov.wt(as.matrix(y))$cov)) center <- as.vector(mean(y)) ## xbest <- NULL } else { sh <- .fastmcd(as.matrix(y), as.integer(h), nsamp = 0, # (y *is* 1-dim.!) nmini = 300, kmini = 5) center <- as.double(sh$initmean) qalpha <- qchisq(h/n, 1) calphainvers <- pgamma(qalpha/2, 1/2 + 1)/(h/n) raw.cnp2[1] <- calpha <- 1/calphainvers raw.cnp2[2] <- correct <- LTScnp2(1, intercept = intercept, n, alpha) if(!use.correction) # do not use finite sample correction factor raw.cnp2[2] <- correct <- 1.0 scale <- sqrt(as.double(sh$initcovariance)) * sqrt(calpha) * correct ## xbest <- sort(as.vector(sh$best)) # fastmcd in the univariate case does not return inbest[] } resid <- y - center ans <- list(method = "Univariate location and scale estimation.", best = NULL, # xbest, coefficients = center, alpha = alpha, quan = h, raw.coefficients = center, raw.resid = resid/scale, raw.weights = rep.int(NA, length(na.y))) if(abs(scale) < 1e-07) { ans$raw.weights[ok] <- weights <- as.numeric(abs(resid) < 1e-07) ans$scale <- ans$raw.scale <- 0 ans$crit <- 0 ans$method <- paste(ans$method, "More than half of the data are equal!",sep="\n") } else { ans$raw.scale <- scale ans$raw.weights[ok] <- weights <- wgtFUN(resid/scale) sum.w <- sum(weights) reweighting <- cov.wt(as.matrix(y), wt = weights) ans$coefficients <- reweighting$center ans$scale <- sqrt(sum.w/(sum.w - 1) * drop(reweighting$cov)) resid <- y - ans$coefficients ans$crit <- sum(sort((y - center)^2, partial = h)[1:h]) if (sum.w != n) { qdelta.rew <- qchisq(sum.w/n, 1) cdeltainvers.rew <- pgamma(qdelta.rew/2, 1/2 + 1)/(sum.w/n) cdelta.rew <- sqrt(1/cdeltainvers.rew) correct.rew <- if(use.correction) LTScnp2.rew(1, intercept = intercept, n, alpha) else 1 cnp2 <- c(cdelta.rew, correct.rew) ans$scale <- ans$scale * cdelta.rew * correct.rew } weights <- wgtFUN(resid/ans$scale) } fitted <- ans$coefficients ans$resid <- resid/ans$scale ans$rsquared <- 0 ans$intercept <- intercept if(has.yn) names(ans$coefficients) <- names(ans$raw.coefficients) <- yn } ## end {all(x == 1)} -- else { ## ------------------ usual non-trivial case --------------------- if(mcd) ## need 'old x' later X <- x if (intercept) { ## intercept must be *last* (<- fortran code) {"uahh!"} x <- cbind(x, "Intercept" = 1) dx <- dim(x) xn <- colnames(x) } p <- dx[2] if (n <= 2 * p) stop("Need more than twice as many observations as variables.") ## VT:: 26.12.2004 ## Reorder the coefficients so that the intercept is at the beginning .. getCoef <- ## simple wrapper (because of above "intercept must be") if(p > 1 && intercept) function(cf) cf[c(p, 1:(p - 1))] else function(cf) cf ans <- list(alpha = alpha, raw.weights = rep.int(NA, length(na.y))) if(alpha == 1) { ## alpha == 1 ----------------------- ## old, suboptimal: z <- lsfit(x, y, intercept = FALSE) z <- lm.fit(x, y) qrx <- z$qr cf <- z$coef names(cf) <- xn ans$raw.coefficients <- getCoef(cf) resid <- z$residuals ans$quan <- h <- n s0 <- sqrt((1/(n - p)) * sum(resid^2)) ##cat("++++++ B - alpha == 1... - s0=",s0,"\n") if(abs(s0) < 1e-07) { fitted <- x %*% z$coef ans$raw.weights[ok] <- weights <- as.numeric(abs(resid) <= 1e-07) ans$scale <- ans$raw.scale <- 0 ans$coefficients <- ans$raw.coefficients } else { ans$raw.scale <- s0 ans$raw.resid <- resid / s0 ans$raw.weights[ok] <- weights <- wgtFUN(ans$raw.resid) sum.w <- sum(weights) ## old, suboptimal: z <- lsfit(x, y, wt = weights, intercept = FALSE) z <- lm.wfit(x, y, w = weights) ans$coefficients <- getCoef(z$coef) fitted <- x %*% z$coef ans$scale <- sqrt(sum(weights * resid^2)/(sum.w - 1)) if (sum.w != n) { qn.w <- qnorm((sum.w + n)/(2 * n)) cdelta.rew <- 1/sqrt(1 - (2 * n)/(sum.w/qn.w) * dnorm(qn.w)) ans$scale <- ans$scale * cdelta.rew } ans$resid <- resid/ans$scale weights <- wgtFUN(ans$resid) } names(ans$coefficients) <- getCoef(xn) s1 <- sum(resid^2) ans$crit <- s1 sh <- (if (intercept) y - mean(y) else y) ^ 2 ans$rsquared <- max(0, min(1, 1 - (s1/sh))) ans$method <- "Least Squares Regression." } ## end {alpha == 1} : "classical" else { ## alpha < 1 ----------------------------------------------- coefs <- rep(NA, p) names(coefs) <- xn qrx <- if(qr.out) qr(x) else qr(x)[c("rank", "pivot")] rk <- qrx$rank if (rk < p) stop("x is singular") ## else : h <- h.alpha.n(alpha, n, rk) z <- .fastlts(x, y, h, nsamp, intercept, adjust, trace=as.integer(trace)) if(z$objfct < 0) stop("no valid subsample found in LTS - set 'nsamp' or rather use lmrob.S()") ## vt:: lm.fit.qr == lm.fit(...,method=qr,...) cf <- lm.fit(x[z$inbest, , drop = FALSE], y[z$inbest])$coef if(any(ic <- is.na(cf))) stop(gettextf("NA coefficient (at %s) from \"best\" subset", paste(which(ic), collapse =","))) ans$best <- sort(z$inbest) fitted <- x %*% cf resid <- y - fitted piv <- 1:p coefs[piv] <- cf ## FIXME? why construct 'coefs' so complicatedly? use 'cf' ! ans$raw.coefficients <- getCoef(coefs) ans$quan <- h correct <- if(use.correction) LTScnp2(p, intercept = intercept, n, alpha) else 1 raw.cnp2[2] <- correct s0 <- sqrt(mean(sort(resid^2, partial = h)[1:h])) sh0 <- s0 qn.q <- qnorm((h + n)/ (2 * n)) s0 <- s0 / sqrt(1 - (2 * n)/(h / qn.q) * dnorm(qn.q)) * correct if (abs(s0) < 1e-07) { ans$raw.weights[ok] <- weights <- as.numeric(abs(resid) <= 1e-07) ans$scale <- ans$raw.scale <- 0 ans$coefficients <- ans$raw.coefficients } else { ans$raw.scale <- s0 ans$raw.resid <- resid/ans$raw.scale ans$raw.weights[ok] <- weights <- wgtFUN(resid/s0) sum.w <- sum(weights) ## old, suboptimal: z1 <- lsfit(x, y, wt = weights, intercept = FALSE) z1 <- lm.wfit(x, y, w = weights) ans$coefficients <- getCoef(z1$coef) fitted <- x %*% z1$coef resid <- z1$residuals ans$scale <- sqrt(sum(weights * resid^2)/(sum.w - 1)) if (sum.w == n) { cdelta.rew <- 1 correct.rew <- 1 } else { qn.w <- qnorm((sum.w + n)/(2 * n)) cnp2[1] <- cdelta.rew <- 1 / sqrt(1 - (2 * n)/(sum.w / qn.w) * dnorm(qn.w)) correct.rew <- if (use.correction) ## use finite sample correction LTScnp2.rew(p, intercept = intercept, n, alpha) else 1 cnp2[2] <- correct.rew ans$scale <- ans$scale * cdelta.rew * correct.rew } ans$resid <- resid/ans$scale weights <- wgtFUN(ans$resid) } ## unneeded: names(ans$coefficients) <- names(ans$raw.coefficients) ans$crit <- z$objfct if (intercept) { sh <- .fastmcd(as.matrix(y), as.integer(h), nsamp = 0, # (y *is* 1-dim.!) nmini = 300, kmini = 5) y <- as.vector(y) ## < ?? sh <- as.double(sh$adjustcov) iR2 <- (sh0/sh)^2 } else { s1 <- sum(sort(resid^2, partial = h)[1:h]) sh <- sum(sort(y^2, partial = h)[1:h]) iR2 <- s1/sh } ans$rsquared <- if(is.finite(iR2)) max(0, min(1, 1 - iR2)) else 0 attributes(resid) <- attributes(fitted) <- attributes(y) ans$method <- "Least Trimmed Squares Robust Regression." } ## end { alpha < 1 } ans$intercept <- intercept if (abs(s0) < 1e-07) ans$method <- paste(ans$method, "\nAn exact fit was found!") if (mcd) { ## compute robust distances {for diagnostics, eg. rdiag()plot} mcd <- covMcd(X, alpha = alpha, use.correction=use.correction) if ( -determinant(mcd$cov, logarithm = TRUE)$modulus > 50 * p) { ans$RD <- "singularity" } else { ans$RD <- rep.int(NA, length(na.y)) ans$RD[ok] <- sqrt(mahalanobis(X, mcd$center, mcd$cov)) names(ans$RD) <- rownames } } } ## end { nontrivial 'x' } ans$lts.wt <- rep.int(NA, length(na.y)) ans$lts.wt[ok] <- weights ans$residuals <- rep.int(NA, length(na.y)) ans$residuals[ok] <- resid ans$fitted.values <- rep.int(NA, length(na.y)) ans$fitted.values[ok] <- fitted names(ans$fitted.values) <- names(ans$residuals) <- names(ans$lts.wt) <- rownames if(has.yn) { ## non-sense otherwise: names(ans$scale) <- names(ans$raw.scale) <- yn names(ans$rsquared) <- names(ans$crit) <- yn } ans$Y <- y ans$X <- if(p > 1 && intercept) x[, c(p, 1:(p - 1))] else x dimnames(ans$X) <- list(rownames[ok], names(ans$coefficients)) if (qr.out) ans$qr <- qrx ans$raw.cnp2 <- raw.cnp2 ans$cnp2 <- cnp2 class(ans) <- "lts" ans$call <- match.call() ans } ## {ltsReg.default} summary.lts <- function (object, correlation = FALSE, ...) { z <- object r <- z$residuals f <- z$fitted int <- z$intercept w <- as.vector(z$lts.wt) n <- sum(w) Qr <- qr(w * z$X)# 'w * z$X': more efficient than t(t(object$X) %*% diag(w)) p <- Qr$rank p1 <- seq(length = p) ## even for p = 0 rdf <- n - p mss <- if(int) { m <- sum(w * f /sum(w)) sum(w * (f - m)^2) } else sum(w * f^2) rss <- sum(w * r^2) r <- sqrt(w) * r resvar <- rss/rdf R <- if (p > 0) chol2inv(Qr$qr[p1, p1, drop = FALSE]) else matrix(NA_real_,p,p) ## no need to reorder R anymore, since 'X' already has "intercept first" se <- sqrt(diag(R) * resvar) est <- z$coefficients tval <- est/se ans <- c(z[c("call", "terms")], ## not again attr(ans, "call") <- attr(z,"call") list(residuals = r, coefficients = { cbind("Estimate" = est, "Std. Error" = se, "t value" = tval, "Pr(>|t|)" = 2*pt(abs(tval), rdf, lower.tail = FALSE)) }, sigma = sqrt(resvar), df = c(p, rdf, NCOL(Qr$qr)))) df.int <- if(int) 1 else 0 if(p - df.int > 0) { ans$r.squared <- mss/(mss + rss) ans$adj.r.squared <- 1 - (1 - ans$r.squared) * ((n - df.int)/rdf) ans$fstatistic <- c(value = (mss/(p - df.int))/resvar, numdf = p - df.int, dendf = rdf) } else ans$r.squared <- ans$adj.r.squared <- 0 ans$cov.unscaled <- R dimnames(ans$cov.unscaled) <- dimnames(ans$coefficients)[c(1,1)] if (correlation) { ans$correlation <- (R * resvar)/outer(se, se) dimnames(ans$correlation) <- dimnames(ans$cov.unscaled) } class(ans) <- "summary.lts" ans } print.lts <- function (x, digits = max(3, getOption("digits") - 3), ...) { cat("\nCall:\n", deparse(x$call), "\n\n", sep = "") if (length(coef(x))) { cat("Coefficients:\n") print.default(format(coef(x), digits = digits), print.gap = 2, quote = FALSE) cat("\nScale estimate", format(x$scale, digits = digits) ,"\n\n") } else cat("No coefficients\n") invisible(x) } print.summary.lts <- function(x, digits = max(3, getOption("digits") - 3), signif.stars = getOption("show.signif.stars"), ...) ## signif.stars = FALSE, ...) ## ^^^^^ (since they are not quite correct ?) { cat("\nCall:\n", paste(deparse(x$call), sep = "\n", collapse = "\n"), "\n\n", sep = "") resid <- x$residuals df <- x$df rdf <- df[2] cat("Residuals (from reweighted LS):\n") ## "cut & paste" from print.summary.lm(): if(rdf > 5) { nam <- c("Min", "1Q", "Median", "3Q", "Max") rq <- if(length(dim(resid)) == 2) structure(apply(t(resid), 1, quantile), dimnames = list(nam, dimnames(resid)[[2]])) else structure(quantile(resid), names = nam) print(rq, digits = digits, ...) } else if(rdf > 0) { print(resid, digits = digits, ...) } else { # rdf == 0 : perfect fit! cat("ALL", df[1], "residuals are 0: no residual degrees of freedom!\n") } if(NROW(x$coefficients)) { if (nsingular <- df[3] - df[1]) cat("\nCoefficients: (", nsingular, " not defined because of singularities)\n", sep = "") else cat("\nCoefficients:\n") printCoefmat(x$coefficients, digits = digits, signif.stars = signif.stars, ...) } else cat("\nNo coefficients\n") cat("\nResidual standard error:", format(signif(x$sigma, digits)), "on", rdf, "degrees of freedom\n") if(!is.null(x$fstatistic)) { cat("Multiple R-Squared:", formatC(x$r.squared, digits = digits)) cat(",\tAdjusted R-squared:",formatC(x$adj.r.squared,digits = digits), "\nF-statistic:", formatC(x$fstatistic[1], digits = digits), "on", x$fstatistic[2], "and", x$fstatistic[3], "DF, p-value:", format.pval(pf(x$fstatistic[1], x$fstatistic[2], x$fstatistic[3], lower.tail = FALSE), digits = digits), "\n") } correl <- x$correlation if(!is.null(correl)) { p <- NCOL(correl) if(p > 1) { cat("\nCorrelation of Coefficients:\n") correl <- format(round(correl, 2), nsmall = 2, digits = digits) correl[!lower.tri(correl)] <- "" print(correl[-1, -p, drop = FALSE], quote = FALSE) } } cat("\n") invisible(x) } ### --- Namespace hidden (but parsed once and for all) : ------------- ##' Compute Finite Sample Correction Factor for the "raw" LTSreg() scale LTScnp2 <- function(p, intercept = intercept, n, alpha) { stopifnot(0.5 <= alpha, alpha <= 1) if (intercept) p <- p - 1 stopifnot(p == as.integer(p), p >= 0) if (p == 0) { fp.500.n <- 1 - exp( 0.262024211897096) / n^ 0.604756680630497 fp.875.n <- 1 - exp(-0.351584646688712) / n^ 1.01646567502486 if ((0.5 <= alpha) && (alpha <= 0.875)) { fp.alpha.n <- fp.500.n + (fp.875.n - fp.500.n)/0.375 * (alpha - 0.5) fp.alpha.n <- sqrt(fp.alpha.n) } if ((0.875 < alpha) && (alpha < 1)) { fp.alpha.n <- fp.875.n + (1 - fp.875.n)/0.125 * (alpha - 0.875) fp.alpha.n <- sqrt(fp.alpha.n) } } else { ## p >= 1 if (p == 1) { if (intercept) { fp.500.n <- 1 - exp( 0.630869217886906 ) / n^ 0.650789250442946 fp.875.n <- 1 - exp( 0.565065391014791 ) / n^ 1.03044199012509 } else { fp.500.n <- 1 - exp(-0.0181777452315321) / n^ 0.697629772271099 fp.875.n <- 1 - exp(-0.310122738776431 ) / n^ 1.06241615923172 } } else { ## --- p > 1 --- if (intercept) { ## "alfaq" "betaq" "qwaarden" coefgqpkwad875 <- matrix(c(-0.458580153984614, 1.12236071104403, 3, -0.267178168108996, 1.1022478781154, 5), ncol = 2) coefeqpkwad500 <- matrix(c(-0.746945886714663, 0.56264937192689, 3, -0.535478048924724, 0.543323462033445, 5), ncol = 2) } else { ## "alfaq" "betaq" "qwaarden" coefgqpkwad875 <- matrix(c(-0.251778730491252, 0.883966931611758, 3, -0.146660023184295, 0.86292940340761, 5), ncol = 2) coefeqpkwad500 <- matrix(c(-0.487338281979106, 0.405511279418594, 3, -0.340762058011, 0.37972360544988, 5), ncol = 2) } y.500 <- log(- coefeqpkwad500[1, ] / p^ coefeqpkwad500[2, ]) y.875 <- log(- coefgqpkwad875[1, ] / p^ coefgqpkwad875[2, ]) A.500 <- cbind(1, - log(coefeqpkwad500[3, ] * p^2)) coeffic.500 <- solve(A.500, y.500) A.875 <- cbind(1, - log(coefgqpkwad875[3, ] * p^2)) coeffic.875 <- solve(A.875, y.875) fp.500.n <- 1 - exp(coeffic.500[1]) / n^ coeffic.500[2] fp.875.n <- 1 - exp(coeffic.875[1]) / n^ coeffic.875[2] } if(alpha <= 0.875) fp.alpha.n <- fp.500.n + (fp.875.n - fp.500.n)/0.375 * (alpha - 0.5) else ## 0.875 < alpha <= 1 fp.alpha.n <- fp.875.n + (1 - fp.875.n)/0.125 * (alpha - 0.875) }## else (p >= 1) return(1/fp.alpha.n) } ## LTScnp2 ##' Compute Finite Sample Correction Factor for the REWeighted LTSreg() scale LTScnp2.rew <- function(p, intercept = intercept, n, alpha) { stopifnot(0.5 <= alpha, alpha <= 1) if (intercept) p <- p - 1 stopifnot(p == as.integer(p), p >= 0) if (p == 0) { fp.500.n <- 1 - exp( 1.11098143415027) / n^ 1.5182890270453 fp.875.n <- 1 - exp(-0.66046776772861) / n^ 0.88939595831888 if(alpha <= 0.875) fp.alpha.n <- fp.500.n + (fp.875.n - fp.500.n)/0.375 * (alpha - 0.5) else ## 0.875 < alpha <= 1 fp.alpha.n <- fp.875.n + (1 - fp.875.n)/0.125 * (alpha - 0.875) ## MM: sqrt() {below} is ''different logic'' than below.. (??) fp.alpha.n <- sqrt(fp.alpha.n) } else { if (p == 1) { if (intercept) { fp.500.n <- 1 - exp(1.58609654199605 ) / n^ 1.46340162526468 fp.875.n <- 1 - exp(0.391653958727332) / n^ 1.03167487483316 } else { fp.500.n <- 1 - exp( 0.6329852387657) / n^ 1.40361879788014 fp.875.n <- 1 - exp(-0.642240988645469) / n^ 0.926325452943084 } } else { ## --- p > 1 --- if (intercept) { ## "alfaq" "betaq" "qwaarden" coefqpkwad875 <- matrix(c(-0.474174840843602, 1.39681715704956, 3, -0.276640353112907, 1.42543242287677, 5), ncol = 2) coefqpkwad500 <- matrix(c(-0.773365715932083, 2.02013996406346, 3, -0.337571678986723, 2.02037467454833, 5), ncol = 2) } else { ## "alfaq" "betaq" "qwaarden" coefqpkwad875 <- matrix(c(-0.267522855927958, 1.17559984533974, 3, -0.161200683014406, 1.21675019853961, 5), ncol = 2) coefqpkwad500 <- matrix(c(-0.417574780492848, 1.83958876341367, 3, -0.175753709374146, 1.8313809497999, 5), ncol = 2) } y.500 <- log( - coefqpkwad500[1, ] / p^ coefqpkwad500[2, ]) y.875 <- log( - coefqpkwad875[1, ] / p^ coefqpkwad875[2, ]) A.500 <- cbind(1, - log(coefqpkwad500[3, ] * p^2)) coeffic.500 <- solve(A.500, y.500) A.875 <- cbind(1, - log(coefqpkwad875[3, ] * p^2)) coeffic.875 <- solve(A.875, y.875) fp.500.n <- 1 - exp(coeffic.500[1]) / n^ coeffic.500[2] fp.875.n <- 1 - exp(coeffic.875[1]) / n^ coeffic.875[2] } if(alpha <= 0.875) fp.alpha.n <- fp.500.n + (fp.875.n - fp.500.n)/0.375 * (alpha - 0.5) else ## 0.875 < alpha <= 1 fp.alpha.n <- fp.875.n + (1 - fp.875.n)/0.125 * (alpha - 0.875) }## else (p >= 1) return(1/fp.alpha.n) } ## LTScnp2.rew .fastlts <- function(x, y, h.alph, nsamp, intercept, adjust, trace = 0) { dx <- dim(x) n <- dx[1] p <- dx[2] ## Parameters for partitioning --- *IDENTICAL* to those in ../src/rfltsreg.[fc] kmini <- 5 nmini <- 300 km10 <- 10*kmini nmaxi <- nmini*kmini ## vt::03.02.2006 - added options "best" and "exact" for nsamp if(!missing(nsamp)) { if(trace) cat("non-missing nsamp = ", nsamp, "\n") if(is.numeric(nsamp) && nsamp <= 0) { warning("Invalid number of trials nsamp=",nsamp,"! Using default.\n") nsamp <- -1 } else if(nsamp == "exact" || nsamp == "best") { myk <- p if(n > 2*nmini-1) { warning("'nsamp' options 'best' and 'exact' not allowed for n greater than ", 2*nmini-1,". Will use default.\n") nsamp <- -1 } else { ## FIXME: Add a test case for this ! nall <- choose(n, myk) if(nall > 5000 && nsamp == "best") { nsamp <- 5000 warning("Maximum 5000 subsets allowed for option 'best'.\n", "Computing 5000 subsets of size ",myk," out of ",n,"\n") } else { nsamp <- 0 #all subsamples if(nall > 5000) cat("Computing all ",nall," subsets of size ", myk, " out of ",n, "\n This may take a very long time!\n") } } } if(nsamp == -1) { ## still not defined - set it to the default nsamp <- rrcov.control()$nsamp } } nsamp <- as.integer(nsamp) ## y <- as.matrix(y) ## xy <- matrix(0, ncol = p + 1, nrow = n) xy <- cbind(x, y) storage.mode(xy) <- "double" # {keeping dim(.)} storage.mode(n) <- "integer" storage.mode(p) <- "integer" ; p1 <- p+1L # integer storage.mode(h.alph) <- "integer" ## Allocate temporary storage for the fortran implementation temp <- index1 <- index2 <- integer(n) weights <- aw2 <- aw <- residu <- yy <- nmahad <- ndist <- am <- am2 <- slutn <- double(n) .Fortran(rfltsreg, ## -> ../src/rfltsreg.f xy = xy, n, p, h.alph, # = nhalff nsamp, # = krep inbest = integer(h.alph), objfct = -1.,# double, if remains at -1 : have *nothing* found intercept = as.integer(intercept), intadjust = as.integer(adjust), nvad = as.integer(p1), datt = matrix(0., ncol = p1, nrow = n), weights, temp, index1, index2, aw2, aw, residu, yy, nmahad, ndist, am, am2, slutn, jmiss = integer(p1), ## integer jmiss(nvad) --> p+1 xmed = double(p1), ## double xmed(nvad) --> p+1 xmad = double(p1), ## double xmad(nvad) a = double(p1), ## double a(nvad) da = double(p1), ## double da(nvad) h = matrix(0., p, p1), ## double h(nvar,nvad) p*(p+1) hvec = double(p*(p1)), ## double hvec(nvar*nvad) p*(p+1) c = matrix(0., p, p1), ## double c(nvar,nvad) p*(p+1) cstock = matrix(0., 10, p*p),## double cstock(10,nvar*nvar) 10*p*p mstock = matrix(0., 10, p), ## double mstock(10,nvar) 10*p c1stock =matrix(0., km10, p*p),## double c1stock(km10,nvar*nvar) km10*p*p m1stock =matrix(0., km10, p),## double m1stock(km10,nvar) km10*p dath = matrix(0., nmaxi, p1),## double dath(nmaxi,nvad) nmaxi*(p+1) sd = double(p), ## double sd(nvar) p means = double(p), ## double means(nvar) p bmeans= double(p), ## double means(nvar) p i.trace= as.integer(trace))[ c("inbest", "objfct") ] } robustbase/R/huber.R0000644000176200001440000000570313175561506014072 0ustar liggesusers ## A modified "safe" (and more general) Huber estimator: huberM <- function(x, k = 1.5, weights = NULL, tol = 1e-06, mu = if(is.null(weights)) median(x) else wgt.himedian(x, weights), s = if(is.null(weights)) mad(x, center=mu) else wgt.himedian(abs(x - mu), weights), se = FALSE, warn0scale = getOption("verbose")) { ## Author: Martin Maechler, Date: 6 Jan 2003, ff ## implicit 'na.rm = TRUE': if(any(i <- is.na(x))) { x <- x[!i] if(!is.null(weights)) weights <- weights[!i] } n <- length(x) sum.w <- if(!is.null(weights)) { stopifnot(is.numeric(weights), weights >= 0, length(weights) == n) sum(weights) } else n it <- 0L NA. <- NA_real_ if(sum.w == 0) # e.g 'x' was all NA return(list(mu = NA., s = NA., it = it, se = NA.)) # instead of error if(se && !is.null(weights)) stop("Std.error computation not yet available for the case of 'weights'") if (s <= 0) { if(s < 0) stop("negative scale 's'") if(warn0scale && n > 1) warning("scale 's' is zero -- returning initial 'mu'") } else { wsum <- if(is.null(weights)) sum else function(u) sum(u * weights) repeat { it <- it + 1L y <- pmin(pmax(mu - k * s, x), mu + k * s) mu1 <- wsum(y) / sum.w if (abs(mu - mu1) < tol * s) break mu <- mu1 } } list(mu = mu, s = s, it = it, SE = if(se) s * sqrt(tauHuber(x, mu=mu, s=s, k=k) / n) else NA.) } ## this is a compatible improvement of MASS' huber() : ## 1) returning median() if mad()=0 ## 2) " NA when y has only NAs (or length 0) if(FALSE) huber <- function (y, k = 1.5, tol = 1e-06) { y <- y[!is.na(y)] n <- length(y) if(n == 0) # e.g 'y' was all na return(list(mu = NA, s = NA))# instead of error mu <- median(y) s <- mad(y) if (s == 0) { # FIXME? make this warning optional if(n > 1) warning("scale MAD is zero for this sample") } else repeat { yy <- pmin(pmax(mu - k * s, y), mu + k * s) mu1 <- sum(yy)/n if (abs(mu - mu1) < tol * s) break mu <- mu1 } list(mu = mu, s = s) } ## Originally from /u/ftp/NDK/Source-NDK-9/R/rg2-fkt.R : tauHuber <- function(x, mu, k=1.5, s = mad(x), resid = (x - mu)/s) { ## Purpose: Correction factor Tau for the variance of Huber-M-Estimators ## ------------------------------------------------------------------------- ## Arguments: x = data, mu = location, k = tuning parameter of Huber Psi-function ## ------------------------------------------------------------------------- ## Author: Rene Locher Update: R. Frisullo 23.4.02; M.Maechler (as.log(); s, resid) inr <- abs(resid) <= k ## psi <- ifelse(inr, resid, sign(resid)*k) # psi (x) -- more efficiently: psi <- resid; out <- which(!inr); if(length(out)) psi[out] <- sign(resid[out]) * k psiP <- as.logical(inr)# = ifelse(abs(resid) <= k, 1, 0) # psi'(x) length(x) * sum(psi^2) / sum(psiP)^2 } robustbase/R/plot.lmrob.R0000644000176200001440000001164712514020510015036 0ustar liggesusers## MM: more following of plot.lm() : ~/R/D/r-devel/R/src/library/stats/R/plot.lm.R plot.lmrob <- function (x, which = 1:5, caption = c("Standardized residuals vs. Robust Distances", "Normal Q-Q vs. Residuals", "Response vs. Fitted Values", "Residuals vs. Fitted Values" , "Sqrt of abs(Residuals) vs. Fitted Values"), panel = if(add.smooth) panel.smooth else points, sub.caption = deparse(x$call), main = "", compute.MD = TRUE, # maybe (n < 1000 && p < 20) ask = prod(par("mfcol")) < length(which) && dev.interactive(), id.n = 3, labels.id = names(residuals(x)), cex.id = 0.75, label.pos = c(4,2), qqline = TRUE, add.smooth = getOption("add.smooth"), ..., p = 0.025) { if (!inherits(x, "lmrob")) stop("Use only with 'lmrob' objects") if (!is.numeric(which) || any(which < 1) || any(which > 5)) stop("'which' must be in 1:5") show <- rep(FALSE, 5) show[which] <- TRUE r <- residuals(x) n <- length(r) sr <- r/x$scale yh <- fitted(x) if (is.null(id.n)) id.n <- 0 else { id.n <- as.integer(id.n) if(id.n < 0L || id.n > n) stop(gettextf("'id.n' must be in {1,..,%d}", n), domain = NA) } if(id.n > 0L) { ## label the largest residuals if(is.null(labels.id)) labels.id <- paste(1L:n) iid <- 1L:id.n show.r <- sort.list(abs(r), decreasing = TRUE)[iid] ## if(any(show[2L:3L])) ## show.rs <- sort.list(abs(rs), decreasing = TRUE)[iid] text.id <- function(x, y, ind, adj.x = TRUE) { labpos <- if(adj.x) label.pos[1+as.numeric(x > mean(range(x)))] else 3 text(x, y, labels.id[ind], cex = cex.id, xpd = TRUE, pos = labpos, offset = 0.25) } } one.fig <- prod(par("mfcol")) == 1 if (ask) { op <- par(ask = TRUE) on.exit(par(op)) } if (show[1]) { if(is.null(x[['MD']]) && compute.MD) { message("recomputing robust Mahalanobis distances") x$MD <- ## need to recompute robMD(x = if(!is.null(x[['x']])) x$x else if(!is.null(x[['model']])) model.matrix(x, x$model) else stop("need 'model' or 'x' component for robust Mahalanobis distances"), intercept = attr(x$terms,"intercept"), wqr = x$qr) ## try to "cache" them with the object .ge <- .GlobalEnv if(identical(parent.frame(), .ge) && exists((cnx <- as.character(match.call()[["x"]])), .ge)) { assign(cnx, x, envir = .ge) message("saving the robust distances 'MD' as part of ", sQuote(cnx)) } } if(!is.null(xD <- x[['MD']])) { if (p < 0 || p > 1) stop ("Tolerance range must be between 0% to 100%") else chi <- sqrt( qchisq(p = 1-p, df = x$rank) ) ylim <- range(sr, na.rm=TRUE) if(id.n > 0) ylim <- extendrange(r = ylim, f = 0.08) plot(xD, xlab = "Robust Distances", sr, ylab = "Robust Standardized residuals", ylim=ylim, main = main, type = "n", ...) panel(xD, sr, ...) mtext(caption[1], 3, 0.25) if (one.fig) title(sub = sub.caption, ...) if(id.n > 0) { y.id <- sr[show.r] y.id[y.id < 0] <- y.id[y.id < 0] - strheight(" ")/3 text.id(xD[show.r], y.id, show.r) } abline(h = c(2.5,-2.5), lty = 3) abline(v = chi, lty = 3) } } if (show[2L]) { ## Normal qq <- qqnorm(r, ylab = "Residuals", main = main,...) if(qqline) qqline(r, lty = 3, col = "gray50") mtext(caption[2], 3, 0.25) if (one.fig) title(sub = sub.caption, ...) if(id.n > 0) text.id(qq$x[show.r], qq$y[show.r], show.r) } if (show[3]) { y <- if(!is.null(x[['model']])) model.response(x$model) else yh + r m1 <- min(yh,y) m2 <- max(yh,y) plot(yh, y, xlab = "Fitted Values", ylab = "Response", xlim = c(m1,m2), ylim = c(m1,m2), main = main, type = "n", ...) panel(yh, y, ...) mtext(caption[3], 3, 0.25) if (one.fig) title(sub = sub.caption, ...) if(id.n > 0) text.id(yh[show.r], y[show.r], show.r) abline(a = 0,b = 1) } if (show[4]) { plot(yh, r, xlab = "Fitted Values", ylab = "Residuals", main = main, type = "n", ...) panel(yh, r, ...) mtext(caption[4], 3, 0.25) if (one.fig) title(sub = sub.caption, ...) if(id.n > 0) { y.id <- r[show.r] y.id[y.id < 0] <- y.id[y.id < 0] - strheight(" ")/3 text.id(yh[show.r], y.id, show.r) } abline(h = c(2.5*x$scale,0,-2.5*x$scale), lty = 3) } if (show[5]) { sqrtabsr <- sqrt(abs(r)) plot(yh, sqrtabsr, xlab = "Fitted Values", ylab = "Sqrt of abs(Residuals)", main = main, type = "n", ...) panel(yh, sqrtabsr, ...) mtext(caption[5], 3, 0.25) if (one.fig) title(sub = sub.caption, ...) if(id.n > 0) text.id(yh[show.r], sqrtabsr[show.r], show.r) } invisible() } robustbase/R/nlregrob.R0000644000176200001440000004760313266661623014606 0ustar liggesusers#### nlrob.() functions for high breakdown point nlrob() methods ## concept (and original version) from lme4/R/lmer.R getOptfun <- function(optimizer, needArgs = c("fn","par","lower","control")) { if (((is.character(optimizer) && optimizer=="optimx") || deparse(substitute(optimizer))=="optimx") && !("package:optimx") %in% search()) stop(shQuote("optimx")," package must be loaded in order to ", "use ",shQuote('optimizer="optimx"')) optfun <- if (is.character(optimizer)) tryCatch(get(optimizer), error=function(e) NULL) else optimizer if (is.null(optfun)) stop("couldn't find optimizer function ",optimizer ) if (!is.function(optfun)) stop("non-function specified as optimizer") if (any(is.na(match(needArgs, names(formals(optfun)))))) stop("optimizer function must use (at least) formal parameters ", pasteK(sQuote(needArgs))) optfun } ##' Utility for all nlrob.(): Find how and where to get parameter ##' names from, also check lower, upper, and replicate if needed. ##' ##' @param lower possibly unnamed numeric vector ##' @param upper as \code{lower}; both will be replicated to ##' \code{length(pnames)} if that is specified and longer. ##' @param var.nms character vector of which 'pnames' must be a subset of. ##' @param envir if not missing and an \code{\link{environment}: possibly assign ##' 'lower', 'upper' of full length in the environment \code{envir}. .fixupArgs <- function(lower, upper, var.nms, envir) { if(is.null(pnames <- names(lower))) pnames <- names(upper) if(is.null(pnames)) stop("Provide 'upper' or 'lower' with names()") if(any(is.na(match(pnames, var.nms)))) stop("parameter names must appear in 'formula'") hasE <- !missing(envir) && is.environment(envir) npar <- length(pnames) if (npar > 1 && length(lower) == 1) { if(hasE) envir$lower <- rep.int(lower, npar) } else if (length(lower) != npar) stop(gettextf("lower must be either of length %d, or length 1", npar)) if (npar > 1 && length(upper) == 1) { if(hasE) envir$upper <- rep.int(upper, npar) } else if (length(upper) != npar) stop(gettextf("upper must be either of length %d, or length 1", npar)) stopifnot(is.numeric(lower), is.numeric(upper), lower <= upper) pnames } nlrob.MM <- function(formula, data, lower, upper, tol = 1e-6, psi = c("bisquare", "lqq", "optimal", "hampel"), init = c("S", "lts"), ctrl = nlrob.control("MM", psi=psi, init=init, fnscale=NULL, tuning.chi.scale = .psi.conv.cc(psi, .Mchi.tuning.defaults[[psi]]), tuning.psi.M = .psi.conv.cc(psi, .Mpsi.tuning.defaults[[psi]]), optim.control = list(), optArgs = list(...)), ...) { if(missing(ctrl)) { init <- match.arg(init) psi <- match.arg(psi) force(ctrl) # } else { init <- ctrl$ init psi <- ctrl$ psi } c1 <- ctrl$tuning.chi.scale c2 <- ctrl$tuning.psi.M if(is.character(ctrl$optimizer)) { ### TODO } else if(is.function(ctrl$optimizer)) { ### TODO } else stop(gettextf("'%s' must be character string or function, but is \"%s\"", "ctrl$optimizer", class(ctrl$optimizer)), domain=NA) ## Preliminary psi-specific checks / computations: switch(psi, "lqq" = { # lqqMax = rho(Inf), used in rho.inv() *and* 'constant': c12 <- c1[1]+c1[2] lqqMax <- (c1[1]*c1[3] - 2*c12)/(1-c1[3]) + c12}) rho1 <- function(t) Mchi(t, c1, psi) rho2 <- function(t) Mchi(t, c2, psi) rho.inv <- switch(psi, "bisquare" = function(y) { ## Find x := u^2 which solves cubic eq. 3*x - 3*x^2 + x^3 = y ## <==> (x-1)^3 + 1 = y <==> (1-x)^3 = 1-y <==> x = 1 - (1-y)^(1/3) ## (where we assume 0 <= y <= 1, i.e, y-1 < 0) c1 * sqrt(1 - (1 - y)^(1/3)) }, "lqq" = function(y) { uniroot( function(x) rho1(x) - y, lower = 0, upper = lqqMax )$root }, "optimal" = function(y) { ## Salibian-Barrera, Matias, Willems, Gert, and Zamar, Ruben (2008). ## The fast-tau estimator for regression. ## Journal of Computational and Graphical Statistics 17, 659-682. sqrt(y/1.38) * c1 * 3 }, "hampel" = function(y) { C <- MrhoInf(c1, psi) a <- c1[1]; b <- c1[2]; r <- c1[3] if (y <= a/C) sqrt(2*C*y) else if (y <= (2*b - a)/C) 0.5*a + C/a*y else r + sqrt( r^2 - ( (r - b)*(2*C/a*y + (b - a)) - b*r ) ) }, stop(gettextf("Psi function '%s' not supported yet", psi))) M_scale <- function(sigma, u) sum( rho1(u/sigma) )/nobs - 0.5 objective.initial <- switch(init, "lts" = function(par) { ## and (h, formula, data, pnames) y.hat <- eval( formula[[3L]], c(data, setNames(par, pnames)) ) sum(sort.int( (y - y.hat)^2, partial = h )[1:h]) }, "S" = function(par) { ## and (constant, formula, data, pnames) y.hat <- eval( formula[[3L]], c(data, setNames(par, pnames)) ) res <- y - y.hat ## Rousseeuw, Peter J., and Leroy, Annick M. (1987). ## Robust Regression & Outlier Detection. ## John Wiley & Sons, New York, p. 137. med_abs_res <- median(abs(res)) uniroot(M_scale, lower = constant[1L] * med_abs_res, upper = constant[2L] * med_abs_res, u = res )$ root ## == 'sigma' }, stop(gettextf("Initialization 'init = \"%s\"' not supported (yet)", init))) objective.M <- function(par, sigma) { y.hat <- eval( formula[[3L]], c(data, setNames(par, pnames)) ) sum(rho2( (y - y.hat)/sigma )) } ## => psi(.) / wgt(.) for robustness weights is ## Mpsi(x, c2, psi) or Mwgt(x, c2, psi) formula <- as.formula(formula) dataName <- substitute(data) varNames <- all.vars(formula) obsNames <- rownames(data <- as.data.frame(data)) data <- as.list(data)# to be used as such if (length(formula) == 2L) { ## as nls formula[[3L]] <- formula[[2L]] formula[[2L]] <- 0 } npar <- length(pnames <- .fixupArgs(lower, upper, varNames, environment())) ## ^^^^^^^^^ -> possibly changes (lower, upper) in envir. y <- eval(formula[[2L]], data) nobs <- length(y) stopifnot(nobs >= npar) if (is.null(fnscale <- ctrl$ fnscale)) fnscale <- sum((y - mean(y))^2) ctrl$fnscale <- NULL # remove it there stopifnot(is.numeric(fnscale), fnscale > 0) ## is used in M_scale() in any case, and in init-estim. if "S" constant <- c( switch(psi, bisquare = 1/c1, lqq = 1/lqqMax, optimal = 1/c1 * 1/3, hampel = 1/c1[3]), if(nobs %% 2) 2/rho.inv(2/(nobs+2)) else 1/rho.inv(1/(nobs+1))) switch(init, lts = h <- (nobs + npar + 1)%/%2) ## FIXME: "optimizer": initial <- do.call(JDEoptim, c(list(lower, upper, objective.initial, tol=tol, fnscale=fnscale), ctrl$optArgs)) names(initial$par) <- pnames res <- y - eval( formula[[3L]], c(data, initial$par) ) med_abs_res <- median(abs(res)) sigma <- uniroot( M_scale, lower = constant[1L] * med_abs_res, upper = constant[2L] * med_abs_res, u = res )$root M <- optim(initial$par, objective.M, sigma = sigma, method = "L-BFGS-B", lower = lower, upper = upper, control = c(list(fnscale = initial$value, parscale = initial$par), ctrl$optim.control), hessian = TRUE) ## 'hessian': experimental - FIXME: eliminate if unused coef <- setNames(M$par, pnames) status <- if (M$convergence == 0) "converged" else if (M$convergence == 1) "maximum number of iterations reached without convergence" else M$message fit <- eval( formula[[3L]], c(data, coef) ) names(fit) <- obsNames structure(list(call = match.call(), formula=formula, nobs=nobs, coefficients = coef, fitted.values = fit, residuals = y - fit, crit = M$value, initial = initial, Scale = sigma, status = status, counts = M$counts, data = dataName, hessian = M$hessian, ctrl=ctrl), class = "nlrob") } ## nlrob.MM nlrob.tau <- function(formula, data, lower, upper, tol = 1e-6, psi = c("bisquare", "optimal"), ctrl = nlrob.control("tau", psi=psi, fnscale=NULL, tuning.chi.scale = NULL, tuning.chi.tau = NULL, optArgs = list(...)), ...) { if(missing(ctrl)) { psi <- match.arg(psi) force(ctrl) # } else { psi <- ctrl$ psi } if(is.null(.chi.s <- ctrl$tuning.chi.scale)) .chi.s <- switch(psi, bisquare = list(b = 0.20, cc = 1.55), optimal = list(b = 0.5, cc = 0.405)) if(is.null(.chi.t <- ctrl$tuning.chi.tau)) .chi.t <- switch(psi, bisquare = list(b = 0.46, cc = 6.04), optimal = list(b = 0.128, cc = 1.060)) b1 <- .chi.s$b c1 <- .chi.s$cc b2 <- .chi.t$b c2 <- .chi.t$cc ## Preliminary psi-specific checks / computations: switch(psi, "bisquare" = { b1 <- b1/MrhoInf(c1, psi) b2 <- b2/MrhoInf(c2, psi) }) rho1 <- function(t) Mchi(t, c1, psi) rho2 <- function(t) Mchi(t, c2, psi) rho.inv <- switch(psi, "bisquare" = function(y) { c1 * sqrt(1 - (1 - y)^(1/3)) }, "optimal" = function(y) { ## Salibian-Barrera, Matias, Willems, Gert, and Zamar, Ruben (2008). ## The fast-tau estimator for regression. ## Journal of Computational and Graphical Statistics 17, 659-682. sqrt(y/1.38) * c1 * 3 }) M_scale <- function(sigma, u) sum( rho1(u/sigma) )/nobs - b1 tau_scale2 <- function(u, sigma) sigma^2 * 1/b2*sum( rho2(u/sigma) )/nobs objective <- function(par) { fit <- eval( formula[[3L]], c(data, setNames(par, pnames)) ) res <- y - fit ## Rousseeuw, Peter J., and Leroy, Annick M. (1987). ## Robust Regression & Outlier Detection. ## John Wiley & Sons, New York, p. 137. med_abs_res <- median(abs(res)) sigma <- uniroot( M_scale, lower = constant[1L] * med_abs_res, upper = constant[2L] * med_abs_res, u = res )$root tau_scale2(res, sigma) } formula <- as.formula(formula) dataName <- substitute(data) varNames <- all.vars(formula) obsNames <- rownames(data <- as.data.frame(data)) data <- as.list(data)# to be used as such if (length(formula) == 2L) { ## as nls formula[[3L]] <- formula[[2L]] formula[[2L]] <- 0 } npar <- length(pnames <- .fixupArgs(lower, upper, varNames, environment())) ## ^^^^^^^^^ -> possibly changes (lower, upper) in envir. y <- eval(formula[[2L]], data) nobs <- length(y) stopifnot(nobs >= npar) if (is.null(fnscale <- ctrl$ fnscale)) fnscale <- mean((y - mean(y))^2) ctrl$fnscale <- NULL # remove it there stopifnot(is.numeric(fnscale), fnscale > 0) constant <- c( switch(psi, bisquare = 1/c1, optimal = 1/c1 * 1/3), if (nobs %% 2) 2/rho.inv(2/(nobs+2)) else 1/rho.inv(1/(nobs+1))) optRes <- do.call(JDEoptim, c(list(lower, upper, objective, tol=tol, fnscale=fnscale), ctrl$optArgs)) iter <- optRes$iter status <- if (optRes$convergence == 0) "converged" else paste("failed to converge in", iter, "steps") coef <- setNames(optRes$par, pnames) fit <- eval( formula[[3L]], c(data, coef) ) names(fit) <- obsNames structure(list(call = match.call(), formula=formula, nobs=nobs, coefficients = coef, fitted.values = fit, residuals = y - fit, crit = optRes$value, Scale = sqrt(optRes$value), status = status, iter = iter, data = dataName, ctrl=ctrl), class = "nlrob") } ## nlrob.tau nlrob.CM <- function(formula, data, lower, upper, tol = 1e-6, psi = c("bisquare", "lqq", "welsh", "optimal", "hampel", "ggw"), ctrl = nlrob.control("CM", psi=psi, fnscale=NULL, tuning.chi = NULL, optArgs = list(...)), ...) { if(missing(ctrl)) { psi <- match.arg(psi) force(ctrl) # } else { psi <- ctrl$ psi } if (is.null(t.chi <- ctrl$tuning.chi)) t.chi <- switch(psi, bisquare = list(b = 0.5, cc = 1, c = 4.835), stop("unable to find constants for psi function")) ## FIXME: b <- t.chi$b ## b = epsilon (in paper) = fraction of outlier ~= breakdown cc <- t.chi$cc ## cc = k; make c <- t.chi$c ## c = the factor in objective c*rho(.) - log(sigma) rho <- function(t) Mchi(t, cc, psi) M_scale <- function(sigma, u) sum( rho(u/sigma) )/nobs - b formula <- as.formula(formula) dataName <- substitute(data) varNames <- all.vars(formula) obsNames <- rownames(data <- as.data.frame(data)) data <- as.list(data)# to be used as such if (length(formula) == 2L) { ## as nls formula[[3L]] <- formula[[2L]] formula[[2L]] <- 0 } npar <- length(pnames <- .fixupArgs(lower,upper, c(varNames,"sigma"),environment())) ## ^^^^^^^^^ -> possibly changes (lower, upper) in envir. if ("sigma" %in% pnames) { if ("sigma" %in% varNames || "sigma" %in% names(data)) stop("As \"sigma\" is in 'pnames', do not use it as variable or parameter name in 'formula'") stopifnot(lower[pnames == "sigma"] >= 0) objective <- function(par) { par <- setNames(par, pnames) fit <- eval( formula[[3L]], c(data, par) ) sigma <- par[["sigma"]] c * sum(rho( (y - fit)/sigma ))/nobs + log(sigma) } con <- function(par) { par <- setNames(par, pnames) fit <- eval( formula[[3L]], c(data, par) ) M_scale(par[["sigma"]], y - fit) } } else { ## hmm, this case *really* is not CM properly objective <- function(par) { fit <- eval( formula[[3L]], c(data, setNames(par, pnames)) ) resid <- y - fit sigma <- mad(resid) c * sum(rho( resid/sigma ))/nobs + log(sigma) } con <- NULL } y <- eval(formula[[2L]], data) nobs <- length(y) stopifnot(nobs >= npar) if (is.null(fnscale <- ctrl$ fnscale)) fnscale <- mean((y - mean(y))^2) ctrl$fnscale <- NULL # remove it there stopifnot(is.numeric(fnscale), fnscale > 0) optRes <- do.call(JDEoptim, c(list(lower, upper, objective, constr=con, tol=tol, fnscale=fnscale), ctrl$optArgs)) iter <- optRes$iter status <- if (optRes$convergence == 0) "converged" else paste("failed to converge in", iter, "steps") coef <- setNames(optRes$par, pnames) fit <- eval( formula[[3L]], c(data, coef) ) names(fit) <- obsNames structure(list(call = match.call(), formula=formula, nobs=nobs, coefficients = coef, fitted.values = fit, residuals = y - fit, crit = optRes$value, status = status, iter = iter, data = dataName, ctrl=ctrl), class = "nlrob") } ## nlrob.CM nlrob.mtl <- function(formula, data, lower, upper, tol = 1e-6, ctrl = nlrob.control("mtl", cutoff = 2.5, optArgs = list(...)), ...) { stopifnot(is.numeric(cutoff <- ctrl[["cutoff"]]), length(cutoff) >= 1) trim <- function(t) { # t = residuals Res, or Res / sigma t <- sort.int(t) i <- which(t >= cutoff) h <- if (length(i) > 0) max(hlow, floor(min( (i - 1)/(2*pnorm(t[i]) - 1) ))) else nobs list(h = h, t = t) } formula <- as.formula(formula) dataName <- substitute(data) varNames <- all.vars(formula) obsNames <- rownames(data <- as.data.frame(data)) data <- as.list(data)# to be used as such if (length(formula) == 2L) { ## as nls formula[[3L]] <- formula[[2L]] formula[[2L]] <- 0 } npar <- length(pnames <- .fixupArgs(lower,upper, c(varNames,"sigma"), environment())) ## ^^^^^^^^^ -> possibly changes (lower, upper) in envir. constant <- log(2*pi) if ("sigma" %in% pnames) { if ("sigma" %in% varNames || "sigma" %in% names(data)) stop("As \"sigma\" is in 'pnames', do not use it as variable or parameter name in 'formula'") stopifnot(lower[pnames == "sigma"] >= 0) objective <- function(par) { par <- setNames(par, pnames) fit <- eval( formula[[3L]], c(data, par) ) sigma <- par[["sigma"]] tp <- trim( abs( (y - fit)/sigma ) ) h <- tp$h h*(constant + 2*log(sigma)) + sum(tp$t[1L:h]^2) } } else { ## hmm... this is not really MTL objective <- function(par) { fit <- eval( formula[[3L]], c(data, setNames(par, pnames)) ) resid <- y - fit sigma <- mad(resid) tp <- trim( abs(resid/sigma) ) h <- tp$h h*(constant + 2*log(sigma)) + sum(tp$t[1L:h]^2) } } y <- eval(formula[[2L]], data) nobs <- length(y) stopifnot(nobs >= npar) if (is.null(fnscale <- ctrl$ fnscale)) fnscale <- sum((y - mean(y))^2) ctrl$fnscale <- NULL # remove it there stopifnot(is.numeric(fnscale), fnscale > 0) hlow <- (nobs + npar + 1)%/%2 optRes <- do.call(JDEoptim, c(list(lower, upper, objective, tol=tol, fnscale=fnscale), ctrl$optArgs)) coef <- setNames(optRes$par, pnames) crit <- optRes$value iter <- optRes$iter status <- if (optRes$convergence == 0) "converged" else paste("failed to converge in", iter, "steps") fit <- eval( formula[[3L]], c(data, coef) ) names(fit) <- obsNames resid <- y - fit quan <- trim( resid/(if ("sigma" %in% pnames) coef["sigma"] else mad(resid)) )$h structure(list(call = match.call(), formula=formula, nobs=nobs, coefficients = coef, fitted.values = fit, residuals = resid, crit = crit, quan = quan, status = status, iter = iter, data = dataName, ctrl = ctrl), class = "nlrob") } ## nlrob.mtl nlrob.control <- function(method, psi = c("bisquare", "lqq", "welsh", "optimal", "hampel", "ggw"), init = c("S", "lts"), optimizer = "JDEoptim", optArgs = list(), ...) { psi <- match.arg(psi) init <- match.arg(init) dots <- list(...) argNms <- names(dots) ##' argument or default -> return list of length 1 a. <- function(nm,def) { L <- list( if(nm %in% argNms) dots[[nm]] else def ) names(L) <- nm L } switch(method, "M" = { list(method = method) # not yet used }, "MM" = { c(list(method = method, init = init, psi = psi), a.("fnscale", NULL), a.("tuning.chi.scale", .psi.conv.cc(psi, .Mchi.tuning.defaults[[psi]])), a.("tuning.psi.M", .psi.conv.cc(psi, .Mpsi.tuning.defaults[[psi]])), a.("optim.control", list()), list(optimizer = optimizer, optArgs = optArgs)) }, "tau" = { c(list(method = method, psi = psi), a.("fnscale", NULL), a.("tuning.chi.scale", NULL), a.("tuning.chi.tau", NULL), list(optimizer = optimizer, optArgs = optArgs)) }, "CM" = { c(list(method = method, psi = psi), a.("fnscale", NULL), a.("tuning.chi", NULL), list(optimizer = optimizer, optArgs = optArgs)) }, "mtl" = { c(list(method = method), a.("fnscale", NULL), a.("cutoff", 2.5), list(optimizer = optimizer, optArgs = optArgs)) }, stop("Method ", method, "not correctly supported yet")) } robustbase/R/qnsn.R0000644000176200001440000000744712321063405013736 0ustar liggesusers### Note: till 2010, a slightly wrong constant = 2.2219 was in use. ### Error reported by Peter Ruckdeschel, U.Bayreuth, 15.Juli 2010 ### correct constant == 1 / (sqrt(2) * qnorm(5/8)) == 2.219144 ### -- but wrong constant, 2.2219, is already in the the original Fortran qn.f Qn.corr <- 2.2219 / 2.21914 ##' Qn finite sample correction factor (not exported, but "available") ##' Version 1 Qn.finite.c <- function(n) (if (n %% 2) 1.6069 +(-2.333 - 3.1/n)/n # n odd else 3.6667 +( 2.591 - 5.5/n)/n # n even )/n + 1 ## Version built on res <- cbind(Res.sml, Res.mid) ## and the models there Qn.finite.c <- function(n) (if (n %% 2) 1.60188 +(-2.1284 - 5.172/n)/n # n odd else 3.67561 +( 1.9654 +(6.987 - 77/n)/n)/n # n even )/n + 1 Qn <- function(x, constant = 2.21914, finite.corr = missing(constant)) { ## Purpose: Rousseeuw and Croux's Q_n() robust scale estimator ## Author: Martin Maechler, Date: 14 Mar 2002, 10:43 n <- length(x) if(n == 0) return(NA) else if(n == 1) return(0.) r <- constant * .C(Qn0, as.double(x), n, res = double(1))$res if (finite.corr) { if (n <= 12) ## n in 2:12 --> n-1 in 1:11 ## n=2: E[Q_2] = E|X - Y| = sqrt(pi)/2, fc = sqrt(pi)/2/2.21914 r* c(.399356, # ~= fc = 0.3993560233 ## These are from MM's simulation("Res3"), Nsim = 2^27 ~= 134 mio: ## ~/R/MM/Pkg-ex/robustbase/Qn-simulation.R .99365, .51321, .84401, .61220, .85877, .66993, .87344, .72014, .88906, .75743)[n - 1L] else r / Qn.finite.c(n) } else r } ## This is the old version -- available for back "compatibility": Qn.old <- function(x, constant = 2.2219, finite.corr = missing(constant)) { ## Purpose: Rousseeuw and Croux's Q_n() robust scale estimator ## Author: Martin Maechler, Date: 14 Mar 2002, 10:43 n <- length(x) if(n == 0) return(NA) else if(n == 1) return(0.) r <- constant * .C(Qn0, as.double(x), n, res = double(1))$res if (finite.corr) (if (n <= 9) { # n in 2:9 --> n-1 in 1:8 c(.399,.994, .512,.844, .611,.857, .669,.872)[n - 1] } else { if (n %% 2) ## n odd n / (n + 1.4) else ## n even n / (n + 3.8) } ) * r else r } Sn <- function(x, constant = 1.1926, finite.corr = missing(constant)) { ## Purpose: Rousseeuw and Croux's S_n() robust scale estimator ## Author: Martin Maechler, Date: 14 Mar 2002, 10:43 n <- length(x) if(n == 0) return(NA) else if(n == 1) return(0.) r <- constant * .C(Sn0, as.double(x), n, as.integer(!is.unsorted(x)),# is.sorted res = double(1), a2 = double(n))$res ## NB: a2[] could be used for confidence intervals and other estimates! if (finite.corr) ( if (n <= 9) { c(0.743, # n = 2 1.851, 0.954,# 3 & 4 1.351, 0.993,# 5 & 6 1.198, 1.005,# 7 & 8 1.131)[n - 1] } else if (n %% 2) # n odd, >= 11 n / (n - 0.9) else # n even, >= 10 1 ) * r else r } wgt.himedian <- function(x, weights = rep(1,n)) { ## Purpose: weighted hiMedian of x ## Author: Martin Maechler, Date: 14 Mar 2002 n <- length(x <- as.double(x)) stopifnot(storage.mode(weights) %in% c("integer", "double")) if(n != length(weights)) stop("'weights' must have same length as 'x'") ## if(is.integer(weights)) message("using integer weights") .C(if(is.integer(weights)) wgt_himed_i else wgt_himed, x, n, weights, res = double(1))$res } ## To be used directly as 'scaleFun' in 'covOGK()' : s_Qn <- function(x, mu.too = FALSE, ...) c(if(mu.too) median(x), Qn(x, ...)) s_Sn <- function(x, mu.too = FALSE, ...) c(if(mu.too) median(x), Sn(x, ...)) robustbase/R/classPC.R0000644000176200001440000000355112661565243014315 0ustar liggesusers##' @title Simple Matrix Rank ====> ../man/rankMM.Rd rankMM <- function(A, tol = NULL, sv = svd(A,0,0)$d) { d <- dim(A) stopifnot(length(d)==2, length(sv)==min(d), diff(sv) <= 0) # must be sorted decreasingly if(is.null(tol)) tol <- max(d) * .Machine$double.eps * abs(sv[1]) else stopifnot(is.numeric(tol), tol >= 0) sum(sv >= tol) } ##' Flip the signs of the loadings ##' - comment from Stephan Milborrow .signflip <- function(loadings) { apply(loadings, 2L, function(x) if(x[which.max(abs(x))] < 0) -x else x) } ##' @title Classical Principal Components ... ==> ../man/classPC.Rd classPC <- function(x, scale=FALSE, center=TRUE, signflip=TRUE, via.svd = n > p, scores=FALSE) { if(!is.numeric(x) || !is.matrix(x)) stop("'x' must be a numeric matrix") else if((n <- nrow(x)) <= 1) stop("The sample size must be greater than 1 for svd") p <- ncol(x) x <- scale(x, center=center, scale=scale) ## ----- if(isTRUE(scale)) scale <- attr(x, "scaled:scale") if(isTRUE(center)) center <- attr(x, "scaled:center") if(via.svd) { svd <- svd(x, nu=0) rank <- rankMM(x, sv=svd$d) loadings <- svd$v[,1:rank, drop=FALSE] eigenvalues <- (svd$d[1:rank])^2 /(n-1) ## FIXME: here .^2; later sqrt(.) } else { ## n <= p; was "kernelEVD" e <- eigen(tcrossprod(x), symmetric=TRUE) evs <- e$values tolerance <- n * max(evs) * .Machine$double.eps rank <- sum(evs > tolerance) evs <- evs[ii <- seq_len(rank)] eigenvalues <- evs / (n-1) ## MM speedup, was: crossprod(..) %*% diag(1/sqrt(evs)) loadings <- crossprod(x, e$vectors[,ii]) * rep(1/sqrt(evs), each=p) } ## VT::15.06.2010 - signflip: flip the sign of the loadings if(signflip) loadings <- .signflip(loadings) list(rank=rank, eigenvalues=eigenvalues, loadings=loadings, scores = if(scores) x %*% loadings, center=center, scale=scale) } robustbase/R/tolEllipse.R0000644000176200001440000001100112440116711015051 0ustar liggesusers#### This is from the R package #### #### rrcov : Scalable Robust Estimators with High Breakdown Point #### #### by Valentin Todorov ### 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, a copy is available at ### http://www.r-project.org/Licenses/ ## I would like to thank Peter Filzmoser for providing the initial code of ## this function. tolEllipsePlot <- function(x, m.cov = covMcd(x), cutoff = NULL, id.n = NULL, classic = FALSE, tol = 1e-07, xlab = "", ylab = "", main = "Tolerance ellipse (97.5%)", txt.leg = c("robust", "classical"), col.leg = c("red", "blue"), lty.leg = c("solid","dashed")) { ##@bdescr ## Tolerance Ellipse Plot: ## Plots the 97.5% tolerance ellipse of the bivariate data set (x). ## The ellipse is defined by those data points whose distance (dist) ## is equal to the squareroot of the 97.5% chisquare quantile with ## 2 degrees of freedom. ##@edescr ## ##@in x : [matrix] A data.frame or matrix, n > 2*p ##@in m.cov : [mcd object] An object of type mcd - its attributes ## center and cov will be used ##@in cutoff : [number] Distance needed to flag data points outside the ellipse ##@in outflag : [logical] Whether to print the labels of the outliers ##@in tol : [number] tolerance to be used for computing the inverse see 'solve'. ## defaults to 1e-7 ## MM: This is nothing else but a version cluster::ellipsoidPoints() !! -- FIXME ellips <- function(loc, cov) { ## calculates a 97,5% ellipsoid ## input: data set, location and covariance estimate, cutoff dist <- sqrt(qchisq(0.975, 2)) A <- solve(cov) eA <- eigen(A) ev <- eA$values lambda1 <- max(ev) lambda2 <- min(ev) eigvect <- eA$vectors[, order(ev)[2]] z <- seq(0, 2 * pi, by = 0.01) z1 <- dist/sqrt(lambda1) * cos(z) z2 <- dist/sqrt(lambda2) * sin(z) alfa <- atan(eigvect[2]/eigvect[1]) r <- matrix(c(cos(alfa), - sin(alfa), sin(alfa), cos(alfa)), ncol = 2) t(loc + t(cbind(z1, z2) %*% r)) # xmin <- min(x, z[, 1]) } ## parameters and preconditions if(is.data.frame(x)) x <- data.matrix(x) if(!is.matrix(x) || !is.numeric(x)) stop("x is not a numeric dataframe or matrix.") n <- dim(x)[1] p <- dim(x)[2] if(p != 2) stop("Dimension {= ncol(x)} must be 2!") if(!is.numeric(m.cov$center) || !is.numeric(m.cov$cov)) stop("argument 'm.cov' must have numeric components 'center' and 'cov'") x.loc <- m.cov$center x.cov <- n/(n - 1) * m.cov$cov xM <- colMeans(x) z1 <- ellips(loc = xM, cov = n/(n - 1) * cov.wt(x)$cov) z2 <- ellips(loc = x.loc, cov = x.cov) x1 <- c(min(x[, 1], z1[, 1], z2[, 1]), max(x[,1],z1[,1], z2[,1])) y1 <- c(min(x[, 2], z1[, 2], z2[, 2]), max(x[,2],z1[,2], z2[,2])) md <- sqrt(mahalanobis(x, xM, cov(x), tol=tol)) rd <- sqrt(mahalanobis(x,m.cov$center, m.cov$cov, tol=tol)) ## Note: the *calling* function may pass a 'missing' value if(missing(cutoff) || is.null(cutoff)) cutoff <- sqrt(qchisq(0.975, df = 2)) if(missing(id.n) || is.null(id.n)) id.n <- sum(rd > cutoff) ### (2,1) is wrong for 'classic' -- we *overplot*: ## if(classic) ## opr <- if(prod(par("mfrow"))== 1) par(mfrow=c(1,2), pty="m") else list() ## MM: this is *NOT* good : ## else par(mfrow = c(1, 1)) ## 1. Robust tolerance ## define the plot, plot a box, plot the "good" points, ## plot the outliers either as points or as numbers depending on outflag, ## plot the ellipse, write a title of the plot plot(x, xlim = x1, ylim = y1, xlab = xlab, ylab = ylab, main = main) box() xrange <- par("usr") xrange <- xrange[2] - xrange[1] if(id.n >= 1) { ind <- sort(rd, index.return=TRUE)$ix[(n-id.n+1):n] text(x[ind, 1] + xrange/50, x[ind, 2], ind) } points(z2, type = "l", lty=lty.leg[1], col=col.leg[1]) ## 2. Classical tolerance if(classic){ points(z1, type = "l", lty=lty.leg[2], col=col.leg[2]) legend("bottomright", txt.leg, lty = lty.leg, col = col.leg) ## par(opr) } invisible() } robustbase/R/OGK.R0000644000176200001440000001617413162422556013406 0ustar liggesusers####========== Pairwise methods for covariance / correlation ================= ### From: Kjell Konis ### To: R-SIG-Robust@stat.math.ethz.ch, Ricardo Maronna ... ### Cc: Rand Wilcox ... ### Subject: Re: [RsR] [R] M-estimator R function question ### Date: Mon, 5 Dec 2005 10:29:11 +0000 ### Here is an implementation of the OGK estimator completely in R. I ### haven't touched it for a while and I forget how thoroughly I tested ### it so use it with a bit of caution. ### http://www.stats.ox.ac.uk/~konis/pairwise.q ### -------------------------------------------- ##------------------------------------------------------------------------------- ## Computes the orthogonalized pairwise covariance matrix estimate described in ## in Maronna and Zamar (2002). ## Use: pairwise(X, 2, gk.sigmamu, gk, hard.rejection) for the ## Gnanadesikan-Kettenring estimate. ## Alternatively, supply your own functions. ## MM replaced sweep(X, 1, .., '*') which is inefficient! ## == used crossprod() where appropriate ## ## I don't like the names gk.sigmamu() and gk(), ## "gk":= Gnanadesikan-Kettenring; particularly not for the Tau-estimator ## which is not at all related to G.-K. ## ---> replacements s/gk.sigmamu/scaleTau2/ ## s/gk/covGK/ ## -- also in the line of the many other cov*() functions I've renamed ## s/pairwise/covOGK/ ## NOTA BENE: Is *now* consistent, since MM made scaleTau2() consistent ### Documentation -----> ../man/covOGK.Rd ## ============= ================ ##' Compute the mahalanobis distances for *diagonal* var/cov matrix: ##' @param x n x p numeric data matrix ##' @param center numeric p-vector (or length 1 - is recycled) or FALSE ##' @param sd numeric p-vector of "standard deviations" ##' @examples all.equal(mahalanobisD(x, FALSE, sd), ##' mahalanobis (x, rep(0,p), diag(sd^2))) mahalanobisD <- function(x, center, sd) { ## Compute the mahalanobis distances (for diagonal cov). if(!identical(center, FALSE)) x <- sweep(x, 2L, center, check.margin=FALSE) rowSums(sweep(x, 2L, sd, '/', check.margin=FALSE)^2) } covOGK <- function(X, n.iter = 2, sigmamu, rcov = covGK, weight.fn = hard.rejection, keep.data = FALSE, ...) { stopifnot(n.iter >= 1) call <- match.call() X <- as.matrix(X) p <- ncol(X) if(p < 2) stop("'X' must have at least two columns") Z <- X # as we use 'X' for the (re)weighting U <- diag(p) A <- list() ## Iteration loop. for(iter in 1:n.iter) { ## only a few iterations ## Compute the vector of standard deviations d and ## the covariance matrix U. d <- apply(Z, 2L, sigmamu, ...) Z <- sweep(Z, 2L, d, '/', check.margin=FALSE) for(i in 2:p) { # only need lower triangle of U for(j in 1:(i - 1)) U[i, j] <- rcov(Z[ ,i], Z[ ,j], ...) } ## Compute the eigenvectors of U and store them as columns of E: ## eigen(U, symmetric) only needs left/lower triangle E <- eigen(U, symmetric = TRUE)$vectors ## Compute A and store it for each iteration A[[iter]] <- d * E ## Project the data onto the eigenvectors Z <- Z %*% E } ## End of orthogonalization iterations. ## Compute the robust location and scale estimates for ## the transformed data. sqrt.gamma <- apply(Z, 2L, sigmamu, mu.too = TRUE, ...) center <- sqrt.gamma[1, ] sqrt.gamma <- sqrt.gamma[2, ] distances <- mahalanobisD(Z, center, sd=sqrt.gamma) ## From the inside out compute the robust location and ## covariance matrix estimates. See equation (5). ## MM[FIXME]: 1st iteration (often the only one!) can be made *much* faster ## ----- covmat <- diag(sqrt.gamma^2) for(iter in n.iter:1) { covmat <- A[[iter]] %*% covmat %*% t(A[[iter]]) center <- A[[iter]] %*% center } center <- as.vector(center) ## Compute the reweighted estimate. First, compute the ## weights using the user specified weight function. weights <- weight.fn(distances, p, ...) sweights <- sum(weights) ## Then compute the weighted location and covariance ## matrix estimates. ## MM FIXME 2 : Don't need any of this, if all weights == 1 ## ----- (which is not uncommon) ==> detect that "fast" wcenter <- colSums(X * weights) / sweights Z <- sweep(X, 2L, wcenter, check.margin=FALSE) * sqrt(weights) wcovmat <- crossprod(Z) / sweights list(center = center, cov = covmat, wcenter = wcenter, wcov = wcovmat, weights = weights, distances = distances, n.iter = n.iter, sigmamu = deparse(substitute(sigmamu)), weight.fn = deparse(substitute(weight.fn)), rcov = deparse(substitute(rcov)), call = call, ## data.name = data.name, data = if(keep.data) X) } ## a version with weights and consistency (but only one tuning const!!) ## is in /u/maechler/R/other-people/Mspline/Mspline/R/scaleTau.R ## scaleTau2 <- function(x, c1 = 4.5, c2 = 3.0, consistency = TRUE, sigma0 = median(x.), # = MAD(x) {without consistency factor} mu.too = FALSE) { n <- length(x) medx <- median(x) x. <- abs(x - medx) if(sigma0 <= 0) { # no way to get tau-estim. if(!missing(sigma0)) warning("sigma0 =", sigma0," ==> scaleTau2(.) = 0") return(c(if(mu.too) medx, 0)) } mu <- if(c1 > 0) { ## w <- pmax(0, 1 - (x. / (sigma0 * c1))^2)^2 -- but faster: x. <- x. / (sigma0 * c1) w <- 1 - x.*x. w <- ((abs(w) + w)/2)^2 sum(x * w) / sum(w) } else medx x <- (x - mu) / sigma0 rho <- x^2 rho[rho > c2^2] <- c2^2 ## sigma2 <- sigma0^2 * sum(rho)/ n if(!identical(consistency,FALSE)) { Erho <- function(b) ## E [ rho_b ( X ) ] X ~ N(0,1) 2*((1-b^2)*pnorm(b) - b * dnorm(b) + b^2) - 1 Es2 <- function(c2) ## k^2 * E[ rho_{c2} (X' / k) ] , where X' ~ N(0,1), k= qnorm(3/4) Erho(c2 * qnorm(3/4)) ## the asymptotic E[ sigma^2(X) ] is Es2(c2): ## TODO: 'n-2' below will probably change; therefore not yet documented nEs2 <- (if(consistency == "finiteSample") n-2 else n) * Es2(c2) } else nEs2 <- n ## return c(if(mu.too) mu, ## sqrt(sigma2) == sqrt( sigma0^2 / n * sum(rho) ) : sigma0 * sqrt(sum(rho)/nEs2)) } ## Two other simple 'scalefun' to be used for covOGK; ## s_Qn(), s_Sn() are in ./qnsn.R s_mad <- function(x, mu.too= FALSE, na.rm = FALSE) { if (na.rm) x <- x[!is.na(x)] mx <- median(x) c(if(mu.too) mx, mad(x, center = mx)) } s_IQR <- function(x, mu.too= FALSE, na.rm = FALSE) { Qx <- quantile(x, (1:3)/4, na.rm = na.rm, names = FALSE) c(if(mu.too) Qx[2], (Qx[3] - Qx[1]) * 0.5 * formals(mad)$constant) } covGK <- function(x, y, scalefn = scaleTau2, ...) { ## Gnanadesikan-Kettenring's, based on 4*Cov(X,Y) = Var(X+Y) - Var(X-Y) (scalefn(x + y, ...)^2 - scalefn(x - y, ...)^2) / 4 } hard.rejection <- function(distances, p, beta = 0.9, ...) { d0 <- median(distances) * qchisq(beta, p) / qchisq(0.5, p) wts <- double(length(distances))# == 0, but wts[distances <= d0] <- 1.0 wts } ##-- TODO "pairwise QC" ... etc ##--> ~maechler/R/MM/STATISTICS/robust/pairwise-new.R robustbase/R/lmrob.M.S.R0000644000176200001440000001577613325654420014502 0ustar liggesuserslmrob.lar <- function(x, y, control = lmrob.control(), ...) { ## LAR : Least Absolute Residuals -- i.e. L_1 M-estimate ## this function is identical to lmRob.lar of the robust package ## '...': to be called as 'init(**, mf)' from lmrob() x <- as.matrix(x) p <- ncol(x) n <- nrow(x) stopifnot(p > 0, n >= p, length(y) == n, is.numeric(control$rel.tol)) storage.mode(x) <- "double" storage.mode(y) <- "double" bet0 <- 0.773372647623 ## bet0 = pnorm(0.75); only for normalizing scale=SIGMA tmpn <- double(n) tmpp <- double(p) z1 <- .Fortran(rllarsbi, ##-> ../src/rllarsbi.f x, y, as.integer(n), as.integer(p), as.integer(n), as.integer(n), as.double(control$rel.tol), NIT=integer(1), K=integer(1), KODE=integer(1), SIGMA=double(1), THETA=tmpn, RS=tmpn, SC1=tmpn, SC2=tmpp, SC3=tmpp, SC4=tmpp, BET0=as.double(bet0))[c("THETA","SIGMA","RS","NIT","KODE")] if (z1[5] > 1) stop("calculations stopped prematurely in rllarsbi\n", "(probably because of rounding errors).") names(z1) <- c("coefficients", "scale", "residuals", "iter", "status") ## c("THETA", "SIGMA", "RS", "NIT", "KODE") z1$converged <- TRUE length(z1$coefficients) <- p z1 } splitFrame <- function(mf, x = model.matrix(mt, mf), type = c("f","fi", "fii")) { mt <- attr(mf, "terms") type <- match.arg(type) x <- as.matrix(x) p <- ncol(x) ## --- split categorical and interactions of categorical vars. ## from continuous variables factors <- attr(mt, "factors") factor.idx <- attr(mt, "dataClasses") == "factor" if (!any(factor.idx)) ## There are no factors return(list(x1.idx = rep.int(FALSE, p), x1=matrix(NA_real_,nrow(x),0L), x2=x)) switch(type, ## --- include interactions cat * cont in x1: fi = { factor.asgn <- which(factor.idx %*% factors > 0) }, ## --- include also continuous variables that interact with factors in x1: ## make sure to include interactions of continuous variables ## interacting with categorical variables, too fii = { factor.asgn <- numeric(0) factors.cat <- factors factors.cat[factors.cat > 0] <- 1L ## fix triple+ interactions factors.cat[, factor.idx %*% factors == 0] <- 0L for (i in 1:ncol(factors)) { comp <- factors[,i] > 0 ## if any of the components is a factor: include in x1 and continue if (any(factor.idx[comp])) { factor.asgn <- c(factor.asgn, i) } else { ## if there is an interaction of this term with a categorical var. tmp <- colSums(factors.cat[comp,,drop=FALSE]) >= sum(comp) if (any(tmp)) { ## if no other continuous variables are involved ## include in x1 and continue ## if (identical(factors[!comp, tmp], factors.cat[!comp, tmp])) if (!all(colSums(factors[!factor.idx & !comp, tmp, drop=FALSE]) > 0)) factor.asgn <- c(factor.asgn, i) } } } }, ## --- do not include interactions cat * cont in x1: f = { factor.asgn <- which(factor.idx %*% factors & !(!factor.idx) %*% factors) }, stop("unknown split type")) x1.idx <- attr(x, "assign") %in% c(0, factor.asgn) ## also include intercept names(x1.idx) <- colnames(x) ## x1: factors and (depending on type) interactions of / with factors ## x2: continuous variables list(x1 = x[, x1.idx, drop=FALSE], x1.idx = x1.idx, x2 = x[, !x1.idx, drop=FALSE]) } ##' Compute M-S-estimator for linear regression ---> ../man/lmrob.M.S.Rd lmrob.M.S <- function(x, y, control, mf, split = splitFrame(mf, x, control$split.type)) { if (ncol(split$x1) == 0) { warning("No categorical variables found in model. Reverting to S-estimator.") return(lmrob.S(x, y, control)) } if (ncol(split$x2) == 0) { warning("No continuous variables found in model. Reverting to L1-estimator.") return(lmrob.lar(x, y, control)) } ## this is the same as in lmrob.S(): if (length(seed <- control$seed) > 0) { if (exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE)) { seed.keep <- get(".Random.seed", envir = .GlobalEnv, inherits = FALSE) on.exit(assign(".Random.seed", seed.keep, envir = .GlobalEnv)) } assign(".Random.seed", seed, envir = .GlobalEnv) ## why not set.seed(seed) } x1 <- split$x1 x2 <- split$x2 storage.mode(x1) <- "double" storage.mode(x2) <- "double" storage.mode(y) <- "double" c.chi <- .psi.conv.cc(control$psi, control$tuning.chi) traceLev <- as.integer(control$trace.lev) z <- .C(R_lmrob_M_S, ## NB: If you change this, adapt ../inst/xtraR/m-s_fns.R x1, x2, y, res=double(length(y)), n=length(y), p1=ncol(x1), p2=ncol(x2), nResample = as.integer(control$nResample), max_it_scale=as.integer(control$maxit.scale), scale=double(1), b1=double(ncol(x1)), b2=double(ncol(x2)), tuning_chi=as.double(c.chi), ipsi = .psi2ipsi(control$psi), bb=as.double(control$bb), K_m_s=as.integer(control$k.m_s), max_k=as.integer(control$k.max), rel_tol=as.double(control$rel.tol), inv_tol=as.double(control$solve.tol), scale_tol=as.double(control$scale.tol), converged = logical(1), trace_lev = traceLev, orthogonalize=TRUE, subsample=TRUE, descent=TRUE, mts=as.integer(control$mts), ss=.convSs(control$subsampling) )[c("b1","b2", "res","scale", "converged")] conv <- z$converged ## FIXME? warning if 'conv' is not ok ?? ## coefficients : idx <- split$x1.idx cf <- numeric(length(idx)) cf[ idx] <- z$b1 cf[!idx] <- z$b2 ## set method argument in control control$method <- 'M-S' obj <- list(coefficients = cf, scale = z$scale, residuals = z$res, rweights = lmrob.rweights(z$res, z$scale, control$tuning.chi, control$psi), ## ../src/lmrob.c : m_s_descent() notes that convergence is *not* guaranteed converged = TRUE, descent.conv = conv, control = control) if (control$method %in% control$compute.outlier.stats) obj$ostats <- outlierStats(obj, x, control) obj } robustbase/R/anova.lmrob.R0000644000176200001440000001245212737461447015210 0ustar liggesusersanova.lmrob <- function(object, ..., test = c("Wald", "Deviance"), verbose=getOption("verbose")) { dotargs <- list(...) named <- if (is.null(names(dotargs))) logical(length(dotargs))# FALSE else (names(dotargs) != "") if (any(named)) warning("the following arguments to 'anova.lmrob' are invalid and \n", "dropped: ", pasteK(deparse(dotargs[named]))) dotargs <- dotargs[!named] test <- match.arg(test) ## method argument has to end with 'M' (req. for refitting) if (test == "Deviance" && !grepl('M$', object$control$method)) stop("For test = 'Deviance', the estimator chain has to end with 'M'") if (length(dotargs) > 0) { length.tl <- function(x) length(attr(terms(x),"term.labels")) isFormula <- vapply(dotargs, inherits, NA, what = "formula") h <- vapply(dotargs, length.tl, 0L) if(all(isFormula)) { if(any(h >= length.tl(object))) stop("The first object does not contain the largest model") modform <- dotargs } else { if(verbose) message("All models are refitted except the largest one") if(any(h >= length.tl(object))) { h <- c(length.tl(object),h) dotargs <- c(list(object), dotargs)[order(h, decreasing = TRUE)] object <- dotargs[[1]] if(!inherits(object, "lmrob")) stop("anova.lmrob() only works for 'lmrob' objects") dotargs <- dotargs[-1] } modform <- lapply(dotargs, formula) } initCoef <- lapply(dotargs, coef) return(anovaLmrobList(object, modform, initCoef, test = test)) } ## ## "'Anova Table' for a single model object stop("'Anova Table' for a single model not yet implemented") } anovaLmrobList <- function (object, modform, initCoef, test) { responses <- as.character(lapply(modform, function(x) deparse(x[[2]]))) if (!all(responses == deparse(formula(object)[[2]]))) stop("Not the same response used in the fitted models") ## nobs <- length(object$residuals) nmodels <- length(modform) + 1 tbl <- matrix(rep(NA, nmodels*4), ncol = 4) tbl[1,1] <- nobs[1] - length(coef(object)) obj0 <- object for(k in 2:nmodels) { obj0 <- anovaLmrobPair(obj0, modform[[k-1]], initCoef[[k-1]], test = test) tbl[k,] <- obj0$anova obj0$scale <- object$scale } ## return dimnames(tbl) <- list(1:nmodels, c("pseudoDf", "Test.Stat", "Df", "Pr(>chisq)")) title <- switch(test, Wald = "Robust Wald Test Table", Deviance = "Robust Deviance Table", stop("invalid 'test'")) variables <- c(list(formula(terms(object))), modform) topnote <- paste("Model ", format(1:nmodels), ": ", variables, sep = "", collapse = "\n") note <- paste("Largest model fitted by lmrob(), i.e.", object$control$method) ## paste("Models fitted by method '", methods[1], "'", sep="") structure(as.data.frame(tbl), heading = c(title, "", topnote, note,""), class = c("anova", "data.frame")) } anovaLmrobPair <- function(FMfit, reduced.model, initCoef, test) { ## 'FM': full model; 'RM' : reduced model X <- model.matrix(FMfit, data = FMfit$model) FMod <- FMfit$qr$pivot[1:FMfit$rank] asgn <- attr(X, "assign") FMt <- terms(FMfit) RMt <- terms(reduced.model) FMtl <- attr(FMt, "term.labels") RMtl <- attr(RMt, "term.labels") RMnumtl <- match(RMtl , FMtl, nomatch = -1) if(attr(RMt, "intercept") == 1) RMnumtl <- c(0, RMnumtl) if(any(is.na(match(RMnumtl, unique(asgn))))) stop("Models are not nested!") RMod0 <- seq(along = asgn)[!is.na(match(asgn, RMnumtl))] RMod <- intersect(RMod0, FMod) if (length(FMod) == length(RMod)) stop("Models are not strictly nested") H0ind <- which(!FMod %in% RMod) H0coef <- coef(FMfit)[H0ind] df <- length(H0coef) pp <- FMfit$rank switch(test, "Wald" = { t.cov <- FMfit$cov t.chisq <- sum(H0coef * solve(t.cov[H0ind, H0ind], H0coef)) ## return c(FMfit, list(anova = c(nrow(X)-pp+df, t.chisq, df, pchisq(as.vector(t.chisq), df = df, lower.tail = FALSE)))) }, "Deviance" = { y <- FMfit$residuals + FMfit$fitted.values s0 <- FMfit$scale fCtrl <- FMfit$control psi <- function(u, deriv = 0) Mpsi(u, cc = fCtrl$tuning.psi, psi = fCtrl$psi, deriv) iC <- if(is.null(initCoef)) { res <- as.vector(y - X[,RMod] %*% FMfit$coef[RMod]) psiRes <- psi(res/s0) if(sum(abs(psiRes) < 1e-08) > 0.6*nrow(X)) stop("Please fit the nested models by lmrob") FMfit$coef[RMod] } else { idx <- !is.na(initCoef) if (any(idx != RMod0 %in% RMod)) stop("NA coefs in full and reduced model do not match") initCoef[idx] } RMfit <- lmrob..M..fit(x = X[,RMod, drop=FALSE], y = y, beta.initial = iC, scale = s0, control = fCtrl, method = fCtrl$method) FMres <- as.vector(y - X[,FMod] %*% FMfit$coef[FMod]) RMres <- RMfit$resid ## as.vector(y - X[,RMod] %*% RMfit$coef) FM_sRho <- sum(psi(FMres/s0, deriv = -1)) RM_sRho <- sum(psi(RMres/s0, deriv = -1)) tauStar <- mean(psi(FMres/s0, deriv = 1)) / mean(psi(FMres/s0)^2, deriv = 0) t.chisq <- 2*tauStar*(RM_sRho - FM_sRho) ## return c(RMfit, list(anova = c(nrow(X)-pp+df, t.chisq, df, pchisq(as.vector(t.chisq), df = df, lower.tail = FALSE)))) }, stop("test ", test, " not yet implemented")) } ## anovaLmrobPair robustbase/R/psi-rho-funs.R0000644000176200001440000004200312737461431015310 0ustar liggesusers#### Psi(), Rho(), weight() etc functions for M-Estimation and extensions ## Use an S4 class for such function classes ## Follow a similar idea as nlsModel() {in "stats"} which returns ## a list of functions sharing a common {non-small!} environment ## NOTA BENE: Experiments etc are currently in ../misc/experi-psi-rho-funs.R ## --------- (FIXME: move those to ../tests/psi-rho-etc.R and the vignette ## ../vignettes//psi_functions.Rnw (and see ../inst/xtraR/plot-psiFun.R) ## ---> look for 'FIXME' below !!! ## ------- ### A. (Symmetric) Location / Regression ## A single function(x, tuningPars) ## a. 1st argument 'x', numeric; must work vectorized on x ## b. further arguments: tuning parameters *with a default* setClass("functionX", contains = "function", validity = function(object) { ## "function" is already because of 'contains' if(names(ff <- formals(object))[1] != "x") return("first argument must be 'x'") f0 <- object(0) fI <- object(Inf) if(!identical(c(f0,fI), object(c(0,Inf)))) return("F(x, *) does not vectorize in 'x'") ## Otherwise : valid TRUE }) ## A functional --- i.e. function of "tuning pars only", such as ## Ep(hc) = Int_{-Inf}^{+Inf} psi(x; hc)^2 dnorm(x) dx ##' This one is *not* checked for vectorization: needed when length(k) > 1 setClass("functionXal", contains = "function") ##' Here F(k) must vectorize in k setClass("functionXal1", contains = "functionXal", validity = function(object) { f0 <- object(0) fI <- object(Inf) if(!identical(c(f0,fI), object(c(0,Inf)))) return("F(k) = I_k[f(.)] does not vectorize in 'k'") ## Otherwise : valid TRUE }) setClass("psi_func", slots = c(rho = "functionX", psi = "functionX", ## psi(x) == d/dx rho(x) = x * wgt(x) wgt = "functionX", ## wgt(x) == psi(x) / x Dpsi = "functionX",## psi'(x) == d/dx psi(x) = rho''(x) Dwgt = "functionX", ## wgt'(x) == d/dx wgt(x) ## tuning parameters, i.e., formals(rho)[-1] tDefs = "numeric",## *named* values of tuning parameters ## FIXME !! {see 4 lines below} Erho = "functionXal", # = E_X[rho(X)]; X~N(0,1); Epsi2 = "functionXal", # = E_X[psi(X)^2]; X~N(0,1); 'A' EDpsi = "functionXal", # = E_X[psi'(X)]; X~N(0,1); 'B' ## name = "character", xtras = "list" ## for flexible extensions.. )) ## FIXME: need other E[] than just wrt N(0,1) ## ----- e.g. for robglm(), need E[] wrt Gamma(.) ### Constructors / "Examples" [the examples are the objects, we'll really use!] psiFunc <- function(rho,psi,wgt, Dpsi,Dwgt, Erho=NULL, Epsi2=NULL, EDpsi=NULL, name, ...) { lent <- length(dotsargs <- list(...)) ## '...' must contain all tuning parameters and their defaults: ## NOTA BENE: Now want at least one tuning parameter.. "worst case": a dummy stopifnot(lent >= 1, length(nt <- names(dotsargs)) == lent, all(nchar(nt)) >= 1) ## Definition of Dwgt is optional if (missing(Dwgt)) Dwgt <- .defDwgt(psi, Dpsi) ## rho, psi,... checking: must have argument names argn <- c("x", nt) for(fnam in list("rho", "psi", "wgt", "Dpsi", "Dwgt", "Erho", "Epsi2", "EDpsi")) { f <- get(fnam, inherits = FALSE) ef <- environment(f) nf <- names(formals(f)) # "x" and "k" for Huber's if (fnam %in% c("Erho", "Epsi2", "EDpsi")) { if(!identical(nf, argn[-1])) stop("arguments of function '",fnam,"' are (", paste(nf, collapse=","),") but should be (", paste(argn[-1],collapse=","),").") formals(f) <- dotsargs } else { if(!identical(nf, argn)) stop("arguments of function '",fnam,"' are (", paste(nf, collapse=","),") but should be (", paste(argn,collapse=","),").") formals(f)[-1] <- dotsargs } environment(f) <- ef assign(fnam, f, inherits = FALSE) } fnctl.typ <- if(lent == 1 && length(dotsargs[[1]]) == 1) "functionXal1" else "functionXal" new("psi_func", rho = new("functionX", rho), psi = new("functionX", psi), wgt = new("functionX", wgt), Dpsi= new("functionX", Dpsi), Dwgt= new("functionX", Dwgt), ## tNams = if(lent) nt else character(0), tDefs = unlist(dotsargs), Erho = new(fnctl.typ, Erho), Epsi2= new(fnctl.typ, Epsi2), EDpsi= new(fnctl.typ, EDpsi), name = if (missing(name)) character(0) else name, xtras= list(tuningP = dotsargs)) } ## Generate default Dwgt function ## Unfortunately, MM can't see how to make this works nicely; ## ._.. = args should really be something like 'x, k' {no parens}: .defDwgt <- function(psi, Dpsi) { args <- formals(Dw <- psi)# -> same formals body(Dw) <- substitute({ y <- .X. .X. <- .X.[not0 <- .X. != 0] y[not0] <- ( Dpsi(._..) - psi(._..)/.X. ) / .X. y }, list(.X. = as.name(names(args[1])), ._.. = args)) environment(Dw) <- environment() Dw } ## so we use this "less nice" variant: .defDwgt <- function(psi, Dpsi) { nf <- names(formals(psi)) eval(parse(text = gsub("_,_", paste(nf, collapse=","), gsub("x", nf[1], "function(_,_) { y <- x x <- x[not0 <- x != 0] y[not0] <- ( Dpsi(_,_) - psi(_,_)/x ) / x y }")))) } chgDefaults <- function(object, ...) standardGeneric("chgDefaults") setMethod("chgDefaults", signature("psi_func"), function(object, ...) { lent <- length(dotsargs <- list(...)) ## '...' must contain all tuning parameters and their defaults: stopifnot(lent >= 1, length(nt <- names(dotsargs)) == lent, all(nchar(nt)) >= 1) ## rho "..." must conform to rho, etc: nf <- names(ff <- formals(object@rho)) if(!identical(nf[-1], nt)) stop("invalid tuning parameter names: ", paste(nt, collapse=",")," instead of ", paste(nf[-1],collapse=","),".") for(fnam in list("rho", "psi", "wgt", "Dpsi", "Dwgt", "Erho", "Epsi2", "EDpsi")) { f <- slot(object, fnam) ef <- environment(f) if (is(f, "functionXal")) formals(f) <- dotsargs else formals(f)[-1] <- dotsargs environment(f) <- ef ## lowlevel {faster than}: slot(..) <- new("functionX", f) slot(object, fnam)@.Data <- f } object@tDefs <- unlist(dotsargs) if(identical(nt, names(object@xtras$tuningP)))# TODO: should update even if there are others object@xtras$tuningP <- setNames(eval(dotsargs), nm=nt) object }) .sprintPsiFunc <- function(x, short=FALSE, round=3) { v <- x@tDefs n <- names(v) ## do not print a single dummy parameter "." if (length(n) == 1 && n == ".") v <- numeric(0) if (!length(name <- x@name)) name <- "" if (!short) name <- sprintf("%s psi function", name) if (length(v) >= 1) { if (short) paste(name, paste(n, round(v, round), sep = "=", collapse = "\n"), sep = "\n") else paste0(name, " (", pasteK(n, round(v, round), sep = " = "), ")") } else name } setMethod("show", signature("psi_func"), function(object) cat(.sprintPsiFunc(object), "\n")) ## moved here from inst/xtraR/plot-psiFun.R; called plot.psiFun originally matplotPsi <- function(x, m.psi, psi, par, main = "full", col = c("black", "red3", "blue3", "dark green"), leg.loc = "right", lty = 1, ...) { ## Original Author: Martin Maechler, Date: 13 Aug 2010, 10:17 ## Modified by Manuel Koller, Date: 7 Jan 2013 fExprs <- quote(list(rho(x), psi(x), {psi*minute}(x), w(x) == psi(x)/x, {w*minute}(x))) ## build legend map <- if (is.null(colnames(m.psi))) { 1:(ncol(m.psi)+1) } else { c(1, c(rho=2, psi=3, Dpsi=4, wgt=5, Dwgt=6)[colnames(m.psi)]) } fExprs <- fExprs[map] ## ... title if(is.character(main)) { shortMain <- (main == "short") elist <- list(FF = if(shortMain) fExprs[[2]] else fExprs, PSI = psi, PPP = paste(formatC(par), collapse=",")) tit <- if(shortMain) substitute(FF ~ "etc, with" ~ psi*"-type" == PSI(PPP), elist) else substitute(FF ~~ ~~ " with "~~ psi*"-type" == PSI(PPP), elist) } else tit <- NULL ## plot matplot(x, m.psi, col=col, lty=lty, type="l", main = tit, ylab = quote(f(x)), xlab = quote(x), ...) abline(h=0,v=0, lty=3, col="gray30") fE <- fExprs; fE[[1]] <- as.name("expression") legend(leg.loc, inset=.02, eval(fE), col=col, lty=lty, bty="n") invisible(cbind(x=x, m.psi)) } setMethod("plot", signature(x = "psi_func"), function(x, y, which = c("rho", "psi", "Dpsi", "wgt", "Dwgt"), main = "full", col = c("black", "red3", "blue3", "dark green", "light green"), leg.loc = "right", ...) { ## x: psi_func object ## y: points to plot at (x-Axis in plot) which <- match.arg(which, several.ok = TRUE) if(missing(y)) y <- seq(-5, 10, length=1501) ## For backcompatibility: if(!is.null(sm <- list(...)$shortMain)) { if(!missing(main)) stop("You cannot specify both 'main' and the deprecated 'shortMain'") warning("'shortMain' is deprecated and will get defunct.\n", "Use 'main = \"short\"' instead of 'shortMain = TRUE'") if(sm) main <- "short" } tmp <- lapply(which, function(name) slot(x, name)(y)) m.psi <- do.call(cbind, tmp) colnames(m.psi) <- which matplotPsi(y, m.psi, x@name, unlist(formals(x@rho)[-1]), main=main, col=col, leg.loc=leg.loc, ...) }) ##-------- TODO: Rather write short __vignette__ with these formulae: ##' \Phi_j(t) := \int_{-\infty}^t u^j \phi(u) \;du ##' --------- where \phi(.) (= \code{dnorm()}) ##' is the density of the standard normal distribution N(0,1). ##' @title "Truncated" Moments of the Gaussian: Int u^j phi(u) du ##' @param t numeric vector ##' @param j an integer (valued scalar), >= 0 ##' @return Phi_j(t), i.e. a numeric vector of the same length as t. ##' @author Martin Maechler PhiI <- function(t, j = 0) { stopifnot(j == as.integer(j), length(j) == 1, is.numeric(t)) if(j >= 4) ## recursion formula -t^(j-1)*dnorm(t) + (j-1)* PhiI(t, j-2) else switch(j+1, ## 0: pnorm(t), ## 1: -dnorm(t), ## 2: pnorm(t) - t*dnorm(t), ## 3: -(2 + t^2)*dnorm(t)) } if(FALSE) { ## Checking PhiI() visually: tt <- seq(-4,10, length=64) j.max <- 5 oo <- sfsmisc::mult.fig(j.max+1, main = "Checking PhiI(., j)", marP=-c(1,1,1,0)) cols <- c("red2", adjustcolor("blue", 0.25)) for(j in 0:j.max) { curve(PhiI(x, j=j), -4, 10, col=cols[1], main = bquote(j == .(j))) if(j == j.max %/% 2) legend("right", c("PhiI()", "integrate(..)"), col=cols, lwd = c(1,3), lty = c(1,3), inset = 1/40) I <- sapply(tt, function(t) integrate(function(u) u^j * dnorm(u), -Inf, t)$value) lines(tt, I, col= cols[2], lwd=3, lty = 3) } par(oo$old.par) } ## Huber: huberPsi <- psiFunc(rho = function(x, k) { r <- u <- abs(x); I <- u < k r[ I] <- u[I]^2 / 2 r[!I] <- k*(u[!I] - k / 2) r }, psi = function(x, k) pmin.int(k, pmax.int(-k, x)), wgt = function(x, k) pmin.int(1, k/abs(x)), Dpsi = function(x, k) abs(x) <= k, Erho = function(k) {iP <- pnorm(k, lower=FALSE) 1/2 - iP + k*(dnorm(k) - k*iP)}, Epsi2= function(k) ifelse(k < 10, 1 - 2*(k*dnorm(k) + (1-k*k)*pnorm(k, lower=FALSE)), 1), EDpsi= function(k) 2*pnorm(k) - 1, name = "Huber", ## the tuning pars and default: k = 1.345) ## Hampel: hampelPsi <- psiFunc(rho = function(x, k) { u <- abs(x) a <- k[1] ; b <- k[2]; r <- k[3] Lg <- r <= u I <- u < a m1 <- !I & (I2 <- u < b) # a <= u < b : 'constant' m2 <- !I2 & !Lg # b <= u < r : 'descending' x[ I] <- u[I]^2 / 2 x[m1] <- a*(a/2 + (u[m1] - a)) ##x[m2]<- a*(a/2 + (b - a)) + a*(u^2 - b^2)/(2*(r - b)) ##x[m2]<- a*(b - a/2) + a*(u^2 - b^2)/(2*(r - b)) x[m2] <- a*(b - a/2 + (u[m2] - b)*(r - (b+u[m2])/2)/(r - b)) ##u=r: a*(b - a/2 + (b + r)/2) x[Lg] <- a/2*(b - a + r) x }, psi = function(x, k) { ## this is "optimized" ==> factors faster than using ifelse()! u <- abs(x) lrg <- k[3] <= u mid <- k[1] < u & !lrg # constant _and_ descending ## x is result for |x| < k[1] x[lrg] <- 0 if(any(mid)) x[mid] <- k[1] * sign(x[mid])* pmin.int(1, (u[mid] - k[3])/(k[2] - k[3])) x }, wgt = function(x, k) { x <- abs(x) lrg <- k[3] <= x I <- x < k[1] mid <- !I & !lrg # contains constant and descending x[I] <- 1 x[lrg] <- 0 if(any(mid)) x[mid] <- k[1] / x[mid] * pmin.int(1, (x[mid] - k[3])/(k[2] - k[3])) x }, Dpsi = function(x, k) { stopifnot(length(k) == 3, diff(k) >= 0) # for now u <- abs(x) lrg <- k[3] <= u I <- u < k[1] m1 <- !I & (I2 <- u < k[2]) # k_1 <= u < k_2: 'constant' m2 <- !I2 & !lrg # k_2 <= u < k_3 : 'descending' x[lrg | m1] <- 0 x[I ] <- 1 x[m2] <- k[1] / (k[2] - k[3]) x }, Erho = function(k) { names(k) <- c("a","b","r") a <- k[["a"]] ; b <- k[["b"]]; r <- k[["r"]] ph <- dnorm(k) Ph <- pnorm(k) ## rho(x) = c0 for |x| >= r c0 <- a/2*(b - a + r) ## coeff. of rho(x) = a/2(c1 + c2|x| + c2 x^2), for |x| in [b,r] D2 <- r - b c1 <- -(a*r+ b*(b-a)) / D2 c2 <- 2*r / D2 c3 <- - 1 / D2 dPh.rb <- Ph[["r"]] - Ph[["b"]] dph.rb <- ph[["r"]] - ph[["b"]] ## Phi_2(r) - Phi_2(b) := dPh2.rb <- Ph[["r"]] - Ph[["b"]] - r*ph[["r"]] + b*ph[["b"]] ## E[rho(X)] = ## [0,a] : 2* 1/2*(Phi_2(a) - Phi_2(0)) (Ph[["a"]]-a*ph[["a"]] - 1/2) + ## [a,b] : 2* a*( -a/2*(Phi(b) - Phi(a)) + (Phi_1(b) - Phi_1(a)) ) 2*a*(-a/2*(Ph[["b"]]-Ph[["a"]]) + (ph[["a"]] - ph[["b"]])) + ## the upper two can be simplified to ## -1/2 + a*ph[["a"]] + (1+a^2)*Ph[["a"]] -2*a*ph[["b"]] - a^2*Ph[["b"]] + ## [b,r] : a*(c1*dPh.rb + c2*(-dph.rb) + c3*dPh2.rb) + ## [r,Inf] : 2*c0*(1 - Ph[["r"]]) } , Epsi2 = function(k) ## E[psi^2]=: 'A' in Hampel et al.(1986), p.150 { names(k) <- c("a","b","r") a <- k[["a"]] ; r <- k[["r"]] ph <- dnorm(k) Ph <- pnorm(k) Ph2 <- Ph - k*ph # = Phi_2(k) {see PhiI(.) above} 2*(Ph2[["a"]] - 1/2 + a^2*(Ph[["b"]] - Ph[["a"]]) + (a / (r - k[["b"]]))^2 * ( r^2 *(Ph[["r"]] - Ph[["b"]]) -2*r *(ph[["b"]] - ph[["r"]]) + Ph2[["r"]] - Ph2[["b"]])) }, EDpsi= function(k) ## E[psi'] =: 'B' in Hampel et al.(1986) { a <- k[1] ; b <- k[2]; r <- k[3] 2*(pnorm(a) - 1/2 - a* (pnorm(r) - pnorm(b)) / (r - b)) }, name = "Hampel", ## the tuning pars and default: k = c(2,4,8) / 1.345)# 1/1.345 = 0.7435 ## TODO: Biweight : ## ---- -------- but note that we have ## (non-S4) ./biweight-funs.R already {used by lmrob.*()} ## ~~~~~~~~~~~~~~~ if(FALSE) tukeyPsi <- c() ########## ## maybe TODO: Optimal tanh() estimator for location ### B. M-Estimators of Scale --- need chi() and slightly different functionals ### --- ---------------------- ### ## one "challenge" is the a(b) needed in chi(x; a,b) = [x^2 -1 -a]_b^b ## for V-optimal M-Estimates of scale ## --> but that's solved (!) in ./scale-chi-opt.R ## ~~~~~~~~~~~~~~~~~ ## Then, I'd also want the optimal chi for s robustbase/R/rrcov.control.R0000644000176200001440000000430112440116711015554 0ustar liggesusers## rrcov : Scalable Robust Estimators with High Breakdown Point ## ## 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, a copy is available at ## http://www.r-project.org/Licenses/ ## "FIXME": If you change this, you must "sync" with ../man/rrcov.control.Rd ## 1) covMcd()'s default in ./covMcd.R ## 2) ltsReg.default()'s default in ./ltsReg.R ## 3) covComed()s default in ./comedian.R rrcov.control <- function(alpha = 1/2, method = c("covMcd", "covComed", "ltsReg"), nsamp = 500, nmini = 300, kmini = 5, seed = NULL, tolSolve = 1e-14, scalefn = "hrv2012", maxcsteps = 200, trace = FALSE, wgtFUN = "01.original", beta, use.correction = identical(wgtFUN, "01.original"), adjust = FALSE) { method <- match.arg(method) if(missing(beta) || !is.numeric(beta)) beta <- c("covMcd" = 0.975, "ltsReg" = 0.9875, "covComed" = 0.95)[[method]] list(alpha=alpha, nsamp=nsamp, nmini=as.integer(nmini), kmini=as.integer(kmini), seed = as.integer(seed), tolSolve=tolSolve, scalefn=scalefn, maxcsteps=as.integer(maxcsteps), trace=trace, wgtFUN=wgtFUN, beta=beta, use.correction=use.correction, adjust=adjust) } ## allow direct fast access: .scalefn.default <- eval(formals(rrcov.control)$scalefn) ## Only for back compatibility, as some new args did not exist pre 2013-04, ## and callers of ltsReg() / covMcd() may use a "too small" 'control' list: getDefCtrl <- function(nm, defCtrl = rrcov.control()) { callerEnv <- parent.frame() if(is.null(get(nm, envir = callerEnv))) assign(nm, defCtrl[[nm]], envir=callerEnv) } robustbase/R/adjoutlyingness.R0000644000176200001440000001503513170062205016171 0ustar liggesusers#### -*- mode: R; kept-new-versions: 30; kept-old-versions: 20 -*- #### MC-adjusted Outlyingness #### ------------------------ ### ### Original code from the web site from the Antwerpen Statistics Group : ### http://www.agoras.ua.ac.be/Robustn.htm ### which has a "MC" section and for the software links to ### ftp://ftp.win.ua.ac.be/pub/software/agoras/newfiles/mc.tar.gz ### and that contains mcrsoft/adjoutlyingness.R ##_NEW_ (2014): moved from Antwerpen to Leuwen, ## ===> http://wis.kuleuven.be/stat/robust/software ## has several links to 'robustbase', and S-plus code ## http://wis.kuleuven.be/stat/robust/Programs/adjusted-boxplot/adjusted-boxplot.ssc ## (copy in ../misc/Adjusted-boxplot.ssc ## MM [ FIXME ]: ## ----------- ## 1) Use *transposed* B[] and A[] (now called 'E') matrices -- DONE ## 2) use IQR() instead of quantile(., .75) - quantile(., .25) ##--> but only *after* testing original code ## ^^^^^^^^^^^^^^^^^^^^^^^^ adjOutlyingness <- function(x, ndir = 250, p.samp = p, clower=4, cupper=3, alpha.cutoff = 0.75, coef = 1.5, qr.tol = 1e-12, keep.tol = 1e-12, only.outlyingness = FALSE, maxit.mult = max(100, p), trace.lev = 0) ## Skewness-Adjusted Outlyingness { x <- data.matrix(x) n <- nrow(x) p <- ncol(x) stopifnot(n >= 1, p >= 1, p.samp >= p, is.numeric(x)) if (p <= n) { B <- matrix(0, p, ndir) E <- matrix(1, p, 1) x. <- unname(x) # for speed in subsequent subsetting and solve maxit <- as.integer(maxit.mult * ndir) ## ^^ original code had 'Inf', i.e. no iter.count check; ## often, maxit == ndir would suffice if(trace.lev >= 2) p10 <- 10 ^ max(0, min(6 - trace.lev, floor(log10(maxit)))) i <- 1L it <- 0L while (i <= ndir && (it <- it+1L) < maxit) { P <- x.[sample.int(n, p.samp), , drop=FALSE] if ((qrP <- qr(P, tol = qr.tol))$rank == p) { B[,i] <- solve(qrP, E, tol = qr.tol) if(trace.lev) cat(" it=",it,"; found direction # ", i,"\n", sep="") i <- i+1L } else if(trace.lev >= 2) { if(it %% p10 == 0) cat(" it=",it,": rank(qr(P ..)) = ", qrP$rank, " < p = ",p,"\n", sep="") } } if(it == maxit) { rnk.x <- qr(x, tol = qr.tol)$rank if(rnk.x < p) stop("Matrix 'x' is not of full rank: rankM(x) = ",rnk.x," < p = ",p, "\n Use fullRank(x) instead") ## else stop("** direction sampling iterations were not sufficient. Maybe try increasing 'maxit.mult'") } Bnorm <- sqrt(colSums(B^2)) Nx <- mean(abs(x.)) ## so the comparison is scale-equivariant: keep <- Bnorm*Nx > keep.tol Bnormr <- Bnorm[ keep ] B <- B[, keep , drop=FALSE] A <- B / rep(Bnormr, each = nrow(B)) } else { stop('More dimensions than observations: not yet implemented') ## MM: In LIBRA(matlab) they have it implemented: ## seed=0; ## nrich1=n*(n-1)/2; ## ndirect=min(250,nrich1); ## true = (ndirect == nrich1); ## B=extradir(x,ndir,seed,true); % n*ri ## ======== % Calculates ndirect directions through ## % two random choosen data points from data ## for i=1:size(B,1) ## Bnorm(i)=norm(B(i,:),2); ## end ## Bnormr=Bnorm(Bnorm > 1.e-12); %ndirect*1 ## B=B(Bnorm > 1.e-12,:); %ndirect*n ## A=diag(1./Bnormr)*B; %ndirect*n } Y <- x %*% A # (n x p) %*% (p, nd') == (n x nd'); ## nd' = ndir.final := ndir - {those not in 'keep'} ## Compute and sweep out the median med <- colMedians(Y) Y <- Y - rep(med, each=n) ## central :<==> non-adjusted <==> "classical" outlyingness central <- clower == 0 && cupper == 0 if(!central) ## MM: mc() could be made faster if we could tell it that med(..) = 0 tmc <- apply(Y, 2, mc) ## original Antwerpen *wrongly*: tmc <- mc(Y) ## == Q13 <- apply(Y, 2, quantile, c(.25, .75), names=FALSE) Q1 <- Q13[1L,]; Q3 <- Q13[2L,] IQR <- Q3 - Q1 ## NOTA BENE(MM): simplified definition of tup/tlo here and below ## 2014-10-18: "flipped" sign (which Pieter Setaert (c/o Mia H) proposed, Jul.30,2014: tup <- Q3 + coef* (if(central) IQR else IQR*exp( cupper*tmc*(tmc >= 0) + clower*tmc*(tmc < 0))) tlo <- Q1 - coef* (if(central) IQR else IQR*exp(-clower*tmc*(tmc >= 0) - cupper*tmc*(tmc < 0))) ## Note: all(tlo < med & med < tup) # where med = 0 ## Instead of the loop: ## for (i in 1:ndir) { ## tup[i] <- max(Y[Y[,i] < tup[i], i]) ## tlo[i] <- -min(Y[Y[,i] > tlo[i], i]) ## ## MM: FIXED typo-bug : ^^^ this was missing! ## ## But after the fix, the function stops "working" for longley.. ## ## because tlo[] becomes 0 too often, YZ[.,.] = c / 0 = Inf ! ## } Yup <- Ylo <- Y Yup[!(Y < rep(tup, each=n))] <- -Inf Ylo[!(Y > rep(tlo, each=n))] <- Inf tup <- apply(Yup, 2, max) # = max{ Y[i,] ; Y[i,] < tup[i] } tlo <- -apply(Ylo, 2, min) # = -min{ Y[i,] ; Y[i,] > tlo[i] } tY <- t(Y) ## Note: column-wise medians are all 0 : "x_i > m" <==> y > 0 ## Note: this loop is pretty fast for (j in 1:n) { # when y = (X-med) = 0 ==> adjout = 0 rather than ## 0 / 0 --> NaN; e.g, in set.seed(3); adjOutlyingness(longley) non0 <- 0 != (y <- tY[,j]); y <- y[non0]; I <- (y > 0) tY[non0, j] <- abs(y) / (I*tup[non0] + (1 - I)*tlo[non0]) } ## We get +Inf above for "small n"; e.g. set.seed(11); adjOutlyingness(longley) adjout <- apply(tY, 2, function(x) max(x[is.finite(x)])) if(only.outlyingness) adjout else { Qadj <- quantile(adjout, probs = c(1 - alpha.cutoff, alpha.cutoff)) mcadjout <- if(cupper != 0) mc(adjout) else 0 ## === cutoff <- Qadj[2] + coef * (Qadj[2] - Qadj[1]) * (if(mcadjout > 0) exp(cupper*mcadjout) else 1) list(adjout = adjout, iter = it, ndir.final = sum(keep), MCadjout = mcadjout, Qalph.adjout = Qadj, cutoff = cutoff, nonOut = (adjout <= cutoff)) } } ##' Compute a "full rank" version of matrix x, ##' by removing columns (or rows when nrow(x) < ncol(x)), using qr() and it's pivots fullRank <- function(x, tol = 1e-7, qrx = qr(x, tol=tol)) { d <- dim(x) n <- d[[1L]]; p <- d[[2L]] if(n < p) return( t(fullRank(t(x), tol=tol)) ) ## else n >= p >= rank(.) rnk <- qrx$rank if(rnk == p) x else x[, qrx$pivot[seq_len(rnk)], drop=FALSE] } robustbase/R/nlrob.R0000644000176200001440000004656413266661732014116 0ustar liggesusers## Directly use nls()-internals, i.e., its 'm', to get a next 'start' (coef-like list): ## (In principle useful also outside robustbase) .nls.get.start <- function(nls.m) { ## stopifnot(is.list(nls.m), is.function(gg <- nls.m$getPars), ## is.environment(em <- environment(gg))) stopifnot(is.list(nls.m), is.environment(em <- environment(nls.m$getPars))) mget(names(em$ind), em$env) } nlrob <- function (formula, data, start, lower, upper, weights = NULL, na.action = na.fail, method = c("M", "MM", "tau", "CM", "mtl"), psi = .Mwgt.psi1("huber", cc=1.345), scale = NULL, test.vec = c("resid", "coef", "w"), maxit = 20, tol = 1e-06, acc, algorithm = "default", doCov = FALSE, model = FALSE, control = if(method == "M") nls.control() else nlrob.control(method, optArgs = list(trace=trace), ...), trace = FALSE, ...) { ## Purpose: ## Robust fitting of nonlinear regression models. The fitting is ## done by iterated reweighted least squares (IWLS) as in rlm() of ## the package MASS. In addition, see also 'nls'. ## ## --> see the help file, ?nlrob (or ../man/nlrob.Rd in the source) ## ------------------------------------------------------------------------- ##- some checks mf <- call <- match.call() # << and more as in nls() formula <- as.formula(formula) if (length(formula) != 3) stop("'formula' should be a formula of the type 'y ~ f(x, alpha)'") ## Had 'acc'; now use 'tol' which is more universal; 'acc' should work for a while if(!missing(acc) && is.numeric(acc)) { if(!missing(tol)) stop("specifying both 'acc' and 'tol' is invalid") tol <- acc message("The argument 'acc' has been renamed to 'tol'; do adapt your code.") } method <- match.arg(method) dataName <- substitute(data) hasWgts <- !missing(weights) # not eval()ing ! ## we don't really need 'start' for non-"M" methods, but for the following logic, ## Want 'dataClasses' -> need 'mf' --> 'varNames' -> 'pnames' -> 'start' : varNames <- all.vars(formula) var.nms <- c(varNames, if(method %in% c("CM", "mtl")) "sigma") # <--> "sigma" part of 'pnames' ## FIXME: nls() allows a missing 'start'; we allow *iff* lower | upper has names: if(missing(start) && (!missing(lower) || !missing(upper))) pnames <- .fixupArgs(lower, upper, var.nms) else if(length(pnames <- names(start)) != length(start)) stop("'start' or 'lower' or 'upper' must be fully named (list or numeric vector)") else if(any(is.na(match(pnames, var.nms)))) # check also in .fixupArgs() stop("parameter names must appear in 'formula'") ## If it is a parameter it is not a variable varNames <- varNames[is.na(match(varNames, pnames))] ## do now: need 'dataClasses', hence the model.frame 'mf' for all 'method' cases obsNames <- rownames(data <- as.data.frame(data)) ## From nls: using model.weights() e.g. when formula 'weights = sqrt()' mf$formula <- # replace by one-sided linear model formula as.formula(paste("~", paste(varNames, collapse = "+")), env = environment(formula)) mf[c("start", "lower", "upper", "method", "psi", "scale", "test.vec", "maxit", "tol", "acc", "algorithm", "doCov", "model", "control", "trace")] <- NULL mf[[1L]] <- quote(stats::model.frame) mf <- eval.parent(mf) dataCl <- attr(attr(mf, "terms"), "dataClasses") ## mf <- as.list(mf) if(method != "M") { if(hasWgts) ## FIXME .. should not be hard, e.g. for MM stop("specifying 'weights' is not yet supported for method ", method) if(!missing(psi)) warning(gettextf("For method = \"%s\", currently 'psi' must be specified via 'control'", method), domain=NA) ## lifted from Martin's 'sfsmisc' package : missingCh <- function(x, envir = parent.frame()) { eval(substitute(missing(VAR), list(VAR=as.name(x))), envir = envir) } aNms <- c("start", "na.action", "test.vec", "maxit", "algorithm", "doCov") not.missA <- !vapply(aNms, missingCh, NA, envir=environment()) if(any(not.missA)) { warning(sprintf(ngettext(sum(not.missA), "For method = \"%s\", argument %s is not made use of", "For method = \"%s\", arguments %s are not made use of"), method, pasteK(sQuote(aNms[not.missA]))), domain=NA) } force(control) fixAns <- function(mod) { mod$call <- call # replace the nlrob.() one mod$data <- dataName # (ditto) ctrl <- mod$ctrl if(is.character(psi <- ctrl$psi) && is.numeric(cc <- ctrl$tuning.psi.M)) {# MM: psi <- .Mwgt.psi1(psi, cc=cc) res.sc <- with(mod, residuals/Scale) mod$psi <- psi mod$w <- # as we have no 'weights' yet mod$rweights <- psi(res.sc) } ## else mod$rweights <- mod$psi <- NULL mod$dataClasses <- dataCl if(model) mod$model <- mf mod } ## {fixAns} ## switch(method, ## source for these is all in >>> nlregrob.R <<< "MM" = { return(fixAns(nlrob.MM (formula, data, lower=lower, upper=upper, tol=tol, ctrl= control))) }, "tau" = { return(fixAns(nlrob.tau(formula, data, lower=lower, upper=upper, tol=tol, ctrl= control))) }, "CM" = { return(fixAns(nlrob.CM (formula, data, lower=lower, upper=upper, tol=tol, ctrl= control))) }, "mtl" = { return(fixAns(nlrob.mtl(formula, data, lower=lower, upper=upper, tol=tol, ctrl= control))) }) } ## {non-"M" methods} ## ## else: method == "M", original method, the only one based on 'nls' : env <- environment(formula) if (is.null(env)) env <- parent.frame() if (!((is.list(start) && all(sapply(start, is.numeric))) || (is.vector(start) && is.numeric(start)))) stop("'start' must be a named list or numeric vector") test.vec <- match.arg(test.vec) if(missing(lower)) lower <- -Inf if(missing(upper)) upper <- +Inf updateScale <- is.null(scale) if(!updateScale) { ## keep initial scale fixed through iterations (e.g. for "MM") if(is.1num(scale) && scale > 0) Scale <- scale else stop("'scale' must be NULL or a positive number") } nm <- "._nlrob.w" if (nm %in% c(varNames, pnames, names(data))) stop(gettextf("Do not use '%s' as a variable name or as a parameter name", nm), domain=NA) data <- as.list(data)# to be used as such ## 'mf' now defined before "dispatch" to method ! nobs <- nrow(mf) if (hasWgts) hasWgts <- !is.null(weights <- model.weights(mf)) if (hasWgts && any(weights < 0 | is.na(weights))) stop("'weights' must be nonnegative and not contain NAs") ## initialize testvec etc fit <- eval(formula[[3]], c(data, start), env) y <- eval(formula[[2]], data, env) coef <- unlist(start) resid <- y - fit ## if (any(is.na(data)) & options("na.action")$na.action == "na.omit") ## stop("if NAs are present, use 'na.exclude' to preserve the residuals length") irls.delta <- function(old, new) sqrt(sum((old - new)^2, na.rm = TRUE)/ max(1e-20, sum(old^2, na.rm = TRUE))) ## Robust loop -- IWLS / IRLS iterations converged <- FALSE status <- "converged" method.exit <- FALSE for (iiter in seq_len(maxit)) { if (trace) cat("robust iteration", iiter, "\n") previous <- get(test.vec) if(updateScale) Scale <- median(abs(resid), na.rm = TRUE)/0.6745 if (Scale == 0) { convi <- 0 method.exit <- TRUE warning(status <- "could not compute scale of residuals") ## FIXME : rather use a "better" Scale in this case, e.g., ## ----- Scale <- min(abs(resid)[resid != 0]) } else { w <- psi(resid/Scale) if (hasWgts) w <- w * weights data$._nlrob.w <- w ## use a variable name the user "will not" use ._nlrob.w <- NULL # workaround for codetools "bug" ## Case distinction against "wrong warning" as long as ## we don't require R > 3.0.2: out <- if(identical(lower, -Inf) && identical(upper, Inf)) nls(formula, data = data, start = start, algorithm = algorithm, trace = trace, weights = ._nlrob.w, na.action = na.action, control = control) else nls(formula, data = data, start = start, algorithm = algorithm, trace = trace, lower=lower, upper=upper, weights = ._nlrob.w, na.action = na.action, control = control) coef <- unlist(start <- .nls.get.start(out$m)) ## same sequence as in start! Ok for test.vec: resid <- residuals(out) convi <- irls.delta(previous, get(test.vec)) } converged <- convi <= tol if (converged) break else if (trace) cat(sprintf(" --> irls.delta(previous, %s) = %g -- *not* converged\n", test.vec, convi)) }## for( iiter ...) if(!converged || method.exit) { warning(st <- paste("failed to converge in", maxit, "steps")) status <- if(method.exit) { converged <- FALSE; paste(status, st, sep="; ") } else st } if(hasWgts) { ## or just out$weights ?? tmp <- weights != 0 w[tmp] <- w[tmp]/weights[tmp] } ## --- Estimated asymptotic covariance of the robust estimator rw <- psi(res.sc <- resid/Scale) asCov <- if(!converged || !doCov) NA else { ## a version of .vcov.m(.) below AtWAinv <- chol2inv(out$m$Rmat()) dimnames(AtWAinv) <- list(names(coef), names(coef)) tau <- mean(rw^2) / mean(psi(res.sc, d=TRUE))^2 AtWAinv * Scale^2 * tau } if(is.null(call$algorithm)) call$algorithm <- algorithm ## returned object: == out$m$fitted() [FIXME?] fit <- setNames(eval(formula[[3]], c(data, start)), obsNames) structure(class = c("nlrob", "nls"), list(m = out$m, call = call, formula = formula, new.formula = formula, nobs = nobs, coefficients = coef, working.residuals = as.vector(resid), fitted.values = fit, residuals = y - fit, Scale=Scale, w=w, rweights = rw, cov = asCov, test.vec=test.vec, status=status, iter=iiter, psi=psi, data = dataName, dataClasses = dataCl, model = if(model) mf, control = control)) } ##' @title The nlrob() method used ##' @param obj an \code{"nlrob"} object ##' @return characer string .method.nlrob <- function(obj) if(inherits(obj, "nls")) "M" else obj$ctrl$method .vcov.m <- function(object, Scale, resid.sc) { if(.method.nlrob(object) == "M") { AtWAinv <- chol2inv(object$m$Rmat()) stopifnot(length(Scale) == 1, Scale >= 0, is.numeric(resid.sc), length(resid.sc) == nobs(object), is.character(nms.coef <- names(coef(object))), length(nms.coef) == nrow(AtWAinv), is.function(psi <- object$psi)) dimnames(AtWAinv) <- list(nms.coef, nms.coef) tau <- mean(psi(resid.sc)^2) / mean(psi(resid.sc, d=TRUE))^2 AtWAinv * Scale^2 * tau } else if(is.function(psi <- object$psi)) { form <- object$formula ## call method="M", with fixed Scale mM <- nlrob(form, data = eval(object$data, environment(form)), method = "M", start = coef(object), psi = psi, scale = Scale, doCov=TRUE) mM$cov ## stop(".vcov.m() not yet implemented for nlrob.MM objects") ## using 'chol(): --- is wrong, unfortunately ## AtWAinv <- chol2inv(chol(object$hessian)) } else { NA ## instead of error } } ## The 'nls' method is *not* correct formula.nlrob <- function(x, ...) x$formula sigma.nlrob <- function(object, ...) if(!is.null(s <- object$Scale)) s else object$coefficients[["sigma"]] estimethod <- function(object, ...) UseMethod("estimethod") estimethod.nlrob <- function(object, ...) if(is.list(object$m) && inherits(object, "nls")) "M" else object$ctrl$method fitted.nlrob <- function (object, ...) { val <- as.vector(object$fitted.values) if (!is.null(object$na.action)) val <- napredict(object$na.action, val) ##MM: attr(val, "label") <- "Fitted values" val } ## formula() works "by default" predict.nlrob <- function (object, newdata, ...) { if (missing(newdata)) return(as.vector(fitted(object))) if (!is.null(cl <- object$dataClasses)) .checkMFClasses(cl, newdata) if(estimethod(object) == "M") # also for start = list(..) object$m$predict(newdata) else eval(formula(object)[[3]], c(as.list(newdata), coef(object))) } print.nlrob <- function (x, ...) { cat("Robustly fitted nonlinear regression model", if((meth <- .method.nlrob(x)) != "M") paste0(" (method ", meth, ")"), "\n", sep="") cat(" model: ", deparse(formula(x)), "\n") cat(" data: ", deparse(x$data), "\n") print(coef(x), ...) cat(" status: ", x$status, "\n") invisible(x) } residuals.nlrob <- function (object, type = c("response", "working", "pearson"), ...) { type <- match.arg(type) R <- switch(type, "pearson"= { stop("type 'pearson' is not yet implemented") ## as.vector(object$working.residuals) }, "working"= { ## FIXME(?): from nls, these used to *contain* weights, but no longer object$working.residuals }, "response"= { object$residuals }, stop("invalid 'type'"))# ==> programming error, as we use match.arg() if (!is.null(object$na.action)) R <- naresid(object$na.action, R) ## FIXME: add 'names'! ##MM no labels; residuals.glm() does neither: attr(val, "label") <- "Residuals" R } vcov.nlrob <- function (object, ...) { if(is.numeric(cv <- object$cov)) cv else { sc <- object$Scale .vcov.m(object, Scale = sc, resid.sc = as.vector(object$residuals) / sc) } } summary.nlrob <- function (object, correlation = FALSE, symbolic.cor = FALSE, ...) { w <- object$w ## weights * rweights, scaled such that sum(w)=1 n <- sum(w > 0) param <- coef(object) p <- length(param) rdf <- n - p no <- names(object) no <- no[match(c("formula", "residuals", "Scale", "w", "rweights", "cov", "call", "status", "counts", "iter", "control", "ctrl"), no, 0L)] ans <- object[no] conv <- ans$status == "converged" if(is.null(sc <- ans$Scale)) ans$Scale <- sc <- sigma(object) if(conv && !is.matrix(ans$cov)) ans$cov <- .vcov.m(object, Scale = sc, resid.sc = as.vector(object$residuals) / sc) if((ok.cov <- is.matrix(ans$cov))) if(!all(dim(ans$cov) == p)) stop("'cov' must be a p x p matrix") ans$df <- c(p, rdf) cf <- if(ok.cov) { se <- sqrt(diag(ans$cov)) tval <- param/se cbind(param, se, tval, 2 * pt(abs(tval), rdf, lower.tail = FALSE)) } else cbind(param, NA, NA, NA) dimnames(cf) <- list(names(param), c("Estimate", "Std. Error", "t value", "Pr(>|t|)")) ans$coefficients <- cf if(correlation && ok.cov && rdf > 0) { ans$correlation <- ans$cov / outer(se, se) ans$symbolic.cor <- symbolic.cor } class(ans) <- "summary.nlrob" ans } print.summary.nlrob <- function (x, digits = max(3, getOption("digits") - 3), symbolic.cor = x$symbolic.cor, signif.stars = getOption("show.signif.stars"), ...) { cat("\nCall:\n") cat(paste(deparse(x$call), sep = "\n", collapse = "\n"), "\n\n", sep = "") ## cat("\nFormula: ") ## cat(paste(deparse(x$formula), sep = "\n", collapse = "\n"), "\n", sep = "") if(is.null(ctrl <- x$ctrl)) meth <- "M" else { meth <- ctrl$method cat("Method \"", meth, if(!is.null(cc <- ctrl$init)) paste0("\", init = \"", cc), if(!is.null(ps <- ctrl$psi )) paste0("\", psi = \"", ps), "\"\n", sep="") } resid <- x$residuals df <- x$df rdf <- df[2L] cat(if (!is.null(x$weights) && diff(range(x$weights))) "Weighted ", "Residuals:\n", sep = "") if (rdf > 5L) { nam <- c("Min", "1Q", "Median", "3Q", "Max") rq <- if (NCOL(resid) > 1) structure(apply(t(resid), 1, quantile), dimnames = list(nam, dimnames(resid)[[2]])) else setNames(quantile(resid), nam) print(rq, digits = digits, ...) } else print(resid, digits = digits, ...) cat("\nParameters:\n") printCoefmat(x$coefficients, digits = digits, signif.stars = signif.stars, ...) if(x$status == "converged") { cat("\nRobust residual standard error:", format(signif(x$Scale, digits)), "\n") correl <- x$correlation if (!is.null(correl)) { p <- NCOL(correl) if (p > 1) { cat("\nCorrelation of Parameter Estimates:\n") if(is.logical(symbolic.cor) && symbolic.cor) { print(symnum(correl, abbr.colnames = NULL)) } else { correl <- format(round(correl, 2), nsmall = 2, digits = digits) correl[!lower.tri(correl)] <- "" print(correl[-1, -p, drop=FALSE], quote = FALSE) } } } if(is.null(ctrl)) cat("Convergence in", x$iter, "IRWLS iterations\n\n") else { if(length(it <- ctrl$iter) == 1) cat("Convergence in", it, "iterations\n\n") else if(length(cnts <- x$counts) > 0) cat("Convergence after", cnts[["function"]], "function and", cnts[["gradient"]],"gradient evaluations\n\n") else ## length(it) >= 2 : cat("Convergence\n\n") } if(!is.null(x$rweights)) summarizeRobWeights(x$rweights, digits = digits, ...) } else if(meth == "M") cat("** IRWLS iterations did *not* converge!\n\n") else cat("** Iterations did *not* converge!\n\n") invisible(x) } ## Confint(): ideally built on profile, the same as stats:::confint.nls() ## -------- which eventually calls stats:::profile.nls ## Also, do emulate (to some extent) ## str(lme4:::confint.merMod) ## function (object, parm, level = 0.95, method = c("profile", "Wald", "boot"), ## zeta, nsim = 500, boot.type = c("perc", "basic", "norm"), quiet = FALSE, ## oldNames = TRUE, ...) confint.nlrob <- function(object, parm, level = 0.95, method = c("profile", "Wald", "boot"), zeta, nsim = 500, boot.type = c("perc", "basic", "norm"), quiet = FALSE, oldNames = TRUE, ...) { method <- match.arg(method) boot.type <- match.arg(boot.type) if (!missing(parm) && !is.numeric(parm) && method %in% c("profile", "boot")) stop("for method='", method, "', 'parm' must be specified as an integer") switch(method, profile = { stop("profile() method not yet implemented for \"nlrob\" objects. Use method = \"Wald\".") ## hence unused for now : if (!quiet) message("Computing profile confidence intervals ...") utils::flush.console() pp <- if (missing(parm)) { profile(object, signames = oldNames, ...) } else { profile(object, which = parm, signames = oldNames, ...) } confint(pp, level = level, zeta = zeta) }, Wald = { cf <- coef(object) pnames <- names(cf) if (missing(parm)) parm <- pnames else if (is.numeric(parm)) parm <- pnames[parm] a <- (1 - level)/2 a <- c(a, 1 - a) ## for now, a short version of R's formatting in quantile.default(): format_perc <- function(x, digits = max(2L, getOption("digits"))) paste0(formatC(x, format = "fg", width = 1, digits = digits)) pct <- format_perc(a, 3) fac <- qnorm(a) ci <- array(NA, dim = c(length(parm), 2L), dimnames = list(parm, pct)) sdiag <- function(x) if (length(x) == 1) c(x) else diag(x) ses <- sqrt(sdiag(vcov(object)[parm, parm])) ci[] <- cf[parm] + ses %o% fac ci }, boot = { stop("\"boot\" method not yet implemented for \"nlrob\" objects. Use confint(*, method = \"Wald\").") }) } robustbase/R/lmrob.MM.R0000644000176200001440000016040713326344173014410 0ustar liggesusers## The "regularized" psi-function names: ## .R: the redescending ones: .Mpsi.R.names <- c('bisquare', 'lqq', 'welsh', 'optimal', 'hampel', 'ggw') ## .M: the monotone ones: .Mpsi.M.names <- c('huber') ## Note: there could be more: non-redescending, non-monotone {such as Cauchy score} .Mpsi.names <- c(R= .Mpsi.R.names, M= .Mpsi.M.names) ##' This allows synonyms as "Tukey" *and* partial matches such as "opt" : .regularize.Mpsi <- function(psi, redescending = TRUE) { stopifnot(is.character(psi), length(psi) == 1) psi <- tolower(psi) psi <- switch(psi, 'tukey'= , 'biweight'= "bisquare", ## otherwise keep psi) nms <- if(redescending) .Mpsi.R.names else .Mpsi.names if (is.na(i <- pmatch(psi, nms))) stop(gettextf("'psi' should be one of %s", pasteK(dQuote(nms))), domain = NA) nms[i] } .Mpsi.tuning.defaults <- list( 'huber' = 1.345 , 'bisquare' = 4.685061 , 'welsh' = 2.11 , 'ggw' = c(-0.5, 1.5, .95, NA) ## (min{slope}, b , eff, bp) , 'lqq' = c(-0.5, 1.5, .95, NA) ## (min{slope}, b/c, eff, bp) , 'optimal' = 1.060158 , 'hampel' = c(1.5, 3.5, 8) * 0.9016085 ## a, b, r ) .Mpsi.tuning.default <- function(psi) { if(is.null(p <- .Mpsi.tuning.defaults[[psi]])) stop(gettextf("invalid 'psi'=%s; possibly use .regularize.Mpsi(%s)", psi, "psi, redescending=FALSE"), domain=NA) p } .Mchi.tuning.defaults <- list( ## Here, psi must be redescending! -> 'huber' not possible 'bisquare' = 1.54764 , 'welsh' = 0.5773502 , 'ggw' = c(-0.5, 1.5, NA, .50) ## (min{slope}, b , eff, bp) , 'lqq' = c(-0.5, 1.5, NA, .50) ## (min{slope}, b/c, eff, bp) , 'optimal' = 0.4047 , 'hampel' = c(1.5, 3.5, 8) * 0.2119163 ## a, b, r ) .Mchi.tuning.default <- function(psi) { if(is.null(p <- .Mchi.tuning.defaults[[psi]])) stop(gettextf("invalid 'psi'=%s; possibly use .regularize.Mpsi(%s)", psi, "psi"), domain=NA) p } lmrob.control <- function(setting, seed = NULL, nResample = 500, tuning.chi = NULL, bb = 0.5, tuning.psi = NULL, max.it = 50, groups = 5, n.group = 400, k.fast.s = 1, best.r.s = 2, k.max = 200, maxit.scale = 200, k.m_s = 20, ## ^^^^^^^^^^^ had MAX_ITER_FIND_SCALE 200 in ../src/lmrob.c refine.tol = 1e-7, rel.tol = 1e-7, scale.tol = 1e-10, # new, was hardcoded to EPS_SCALE = 1e-10 in C code solve.tol = 1e-7, ## had ^^^^^^^^ TOL_INVERSE 1e-7 in ../src/lmrob.c trace.lev = 0, mts = 1000, subsampling = c("nonsingular", "simple"), compute.rd = FALSE, method = 'MM', psi = 'bisquare', numpoints = 10, cov = NULL, split.type = c("f", "fi", "fii"), fast.s.large.n = 2000, eps.outlier = function(nobs) 0.1 / nobs, eps.x = function(maxx) .Machine$double.eps^(.75)*maxx, compute.outlier.stats = method, warn.limit.reject = 0.5, warn.limit.meanrw = 0.5, ...) { p.ok <- missing(psi) # if(p.ok) psi does not need regularization if (!missing(setting)) { if (setting %in% c('KS2011', 'KS2014')) { if (missing(method)) method <- 'SMDM' psi <- if(p.ok) 'lqq' else .regularize.Mpsi(psi) ; p.ok <- TRUE if (missing(max.it)) max.it <- 500 if (missing(k.max)) k.max <- 2000 if (missing(cov) || is.null(cov)) cov <- '.vcov.w' if (setting == 'KS2014') { if (missing(best.r.s)) best.r.s <- 20 if (missing(k.fast.s)) k.fast.s <- 2 if (missing(nResample)) nResample <- 1000 } } else { warning("Unknown setting '", setting, "'. Using defaults.") } } else { if(p.ok && grepl('D', method)) psi <- 'lqq' if (missing(cov) || is.null(cov)) cov <- if(method %in% c('SM', 'MM')) ".vcov.avar1" else ".vcov.w" } if(!p.ok) psi <- .regularize.Mpsi(psi) subsampling <- match.arg(subsampling) ## in ggw, lqq: if tuning.{psi|chi} are non-standard, calculate coefficients: compute.const <- (psi %in% c('ggw', 'lqq')) if(is.null(tuning.chi)) tuning.chi <- .Mchi.tuning.default(psi) else ## wd like to compute.const *always* -- but slightly changes KS2011/14 !! if(compute.const) tuning.chi <- .psi.const(tuning.chi, psi) if(is.null(tuning.psi)) tuning.psi <- .Mpsi.tuning.default(psi) else ## wd like to compute.const *always* -- but slightly changes KS2011/14 !! if(compute.const) tuning.psi <- .psi.const(tuning.psi, psi) c(list(setting = if (missing(setting)) NULL else setting, seed = as.integer(seed), nResample=nResample, psi=psi, tuning.chi=tuning.chi, bb=bb, tuning.psi=tuning.psi, max.it=max.it, groups=groups, n.group=n.group, best.r.s=best.r.s, k.fast.s=k.fast.s, k.max=k.max, maxit.scale=maxit.scale, k.m_s=k.m_s, refine.tol=refine.tol, rel.tol=rel.tol, scale.tol = scale.tol, solve.tol=solve.tol, trace.lev=trace.lev, mts=mts, subsampling=subsampling, compute.rd=compute.rd, method=method, numpoints=numpoints, cov=cov, split.type = match.arg(split.type), fast.s.large.n=fast.s.large.n, eps.outlier = eps.outlier, eps.x = eps.x, compute.outlier.stats = sub("^MM$", "SM", compute.outlier.stats), warn.limit.reject = warn.limit.reject, warn.limit.meanrw = warn.limit.meanrw), list(...)) } ##' Modify a \code{\link{lmrob.control}} list to contain only parameters that ##' were actually used. Currently used for \code{\link{print}()}ing of lmrob ##' objects. ##' ##' @title Minimize lmrob control to non-redundant parts ##' @param control a list, typically the 'control' component of a ##' \code{\link{lmrob}()} call, or the result of \code{\link{lmrob.control}()}. ##' @return list: the (typically) modified \code{control} ##' @author Martin Maechler {from Manuel's original code} lmrob.control.neededOnly <- function(control) { if(is.null(control)) return(control) switch(sub("^(S|M-S).*", "\\1", control$method), S = { # remove all M-S specific control pars control$k.m_s <- NULL control$split.type <- NULL # if large_n is not used, remove corresp control pars if (length(residuals) <= control$fast.s.large.n) { control$groups <- NULL control$n.group <- NULL } }, `M-S` = { # remove all fast S specific control pars control$refine.tol <- NULL control$groups <- NULL control$n.group <- NULL control$best.r.s <- NULL control$k.fast.s <- NULL }, { # else: do not keep parameters used by initial ests. only control$tuning.chi <- NULL control$bb <- NULL control$refine.tol <- NULL control$nResample <- NULL control$groups <- NULL control$n.group <- NULL control$best.r.s <- NULL control$k.fast.s <- NULL control$k.max <- NULL control$k.m_s <- NULL control$split.type <- NULL control$mts <- NULL control$subsampling <- NULL } ) if (!grepl("D", control$method)) control$numpoints <- NULL if (control$method == 'SM') control$method <- 'MM' control } lmrob.fit.MM <- function(x, y, control) ## defunct .Defunct("lmrob.fit(*, control) with control$method = 'SM'") ## .Deprecated() till robustbase 0.92-6 (2016-05-28) lmrob.fit <- function(x, y, control, init=NULL, mf=NULL) { if(!is.matrix(x)) x <- as.matrix(x) if(!missing(mf)) warning("'mf' is unused and deprecated") ## old notation: MM -> SM if (control$method == "MM") control$method <- "SM" ## Assumption: if(is.null(init)) method = "S..." else method = "..." ## --------- where "..." consists of letters {"M", "D"} est <- if (is.null(init)) { ## --- initial S estimator if ((M1 <- substr(control$method,1,1)) != 'S') { warning(gettextf("Initial estimator '%s' not supported; using S-estimator instead", M1), domain = NA) substr(control$method,1,1) <- 'S' } init <- lmrob.S(x, y, control = control) 'S' } else { stopifnot(is.list(init)) if (is.null(init$converged)) init$converged <- TRUE if (is.null(init$control)) { init$control <- control M <- init$control$method <- 'l' } else if(!length(M <- init$control$method) || !nzchar(M)) M <- "l" M } stopifnot(is.numeric(init$coef), length(init$coef) == ncol(x), is.numeric(init$scale), init$scale >= 0) if (est != 'S' && control$cov == '.vcov.avar1') { warning( ".vcov.avar1 can only be used when initial estimator is S; using .vcov.w instead") control$cov <- ".vcov.w" } trace.lev <- control$trace.lev if (init$converged) { ## --- loop through the other estimators; build up 'est' string method <- sub(paste0("^", est), '', control$method) if(trace.lev) { cat(sprintf("init converged (remaining method = \"%s\") -> coef=\n", method)) print(init$coef) } for (step in strsplit(method,'')[[1]]) { ## now we have either M or D steps est <- paste0(est, step) init <- switch(step, ## 'control' may differ from 'init$control' when both (init, control) are spec. ## D(AS)-Step D = lmrob..D..fit(init, x, control=control, method = init$control$method), ## M-Step M = lmrob..M..fit(x = x, y = y, obj = init, control=control, method = init$control$method), stop('only M and D are steps supported after "init" computation')) if(trace.lev) { cat(sprintf("step \"%s\" -> new coef=\n", step)); print(init$coef) } ## break if an estimator did not converge if (!init$converged) { warning(gettextf( "%s-step did NOT converge. Returning unconverged %s-estimate", step, est), domain = NA) break } } } ## << FIXME? qr(.) should be available from earlier if (is.null(init$qr)) init$qr <- qr(x * sqrt(init$rweights)) if (is.null(init$rank)) init$rank <- init$qr$rank control$method <- est ## ~= original 'method', but only with the steps executed. init$control <- control ## --- covariance estimate init$cov <- if (init$scale == 0) { ## exact fit matrix(0, ncol(x), ncol(x), dimnames=list(colnames(x), colnames(x))) } else if (!init$converged || is.null(x)) { NA } else { if (is.null(control$cov) || control$cov == "none") NA else { lf.cov <- if (!is.function(control$cov)) get(control$cov, mode='function') else control$cov lf.cov(init, x=x) } } df <- NROW(y) - init$rank ## sum(init$r?weights)-init$rank init$degree.freedom <- init$df.residual <- df init }## end{lmrob.fit} globalVariables("r", add=TRUE) ## below and in other lmrob.E() expressions .vcov.w <- function(obj, x=obj$x, complete = FALSE, # <- differing from vcov.lmrob()s default scale=obj$scale, cov.hubercorr=ctrl$cov.hubercorr, cov.dfcorr=ctrl$cov.dfcorr, cov.resid=ctrl$cov.resid, cov.corrfact=ctrl$cov.corrfact, cov.xwx=ctrl$cov.xwx) { ## set defaults ctrl <- obj$control if (is.null(cov.hubercorr)) cov.hubercorr <- !grepl('D', ctrl$method) else if (!is.logical(cov.hubercorr)) stop(':.vcov.w: cov.hubercorr must be logical (or NULL)') valid.corrfact <- c('tau', 'empirical', 'asympt', 'hybrid', 'tauold') if (is.null(cov.corrfact)) { cov.corrfact <- if (cov.hubercorr) 'empirical' else 'tau' } else if(length(cov.corrfact) != 1 || is.na(match(cov.corrfact, valid.corrfact))) stop(":.vcov.w: cov.corrfact must be one of ", pasteK(dQuote(valid.corrfact))) valid.dfcorr <- c("mean", "none", "mn.vc", "varc", "mn.df") ## old: cov.dfcorr = -1 | 0 | 1 | 2 | 3 if (is.null(cov.dfcorr)) { cov.dfcorr <- if (cov.hubercorr || cov.corrfact %in% c('tau', 'hybrid')) "mn.vc" else "mean" } else if(length(cov.dfcorr) != 1 || is.na(match(cov.dfcorr, valid.dfcorr))) stop(":.vcov.w: cov.dfcorr must be one of ", pasteK(dQuote(valid.dfcorr))) valid.cov.resid <- c('final', 'initial', 'trick') if (is.null(cov.resid)) cov.resid <- 'final' ## do warn only for *specified* cov.resid: else if (cov.resid == 'final' && (class(obj)[1] == 'lmrob.S')) warning("ignoring cov.resid == 'final' since est != final") else if (length(cov.resid) != 1L || is.na(match(cov.resid, valid.cov.resid))) stop("cov.resid must be one of ", pasteK(dQuote(valid.cov.resid))) if (is.null(cov.xwx)) cov.xwx <- TRUE # == _THE_ typical case: not part of 'obj$control' else if (!is.logical(cov.xwx)) stop(':.vcov.w: cov.xwx must be logical (or NULL)') if (is.null(x)) x <- model.matrix(obj) ## set psi and c.psi psi <- ctrl$psi if (is.null(psi)) stop('parameter psi is not defined') c.psi <- if (cov.resid == 'initial') ctrl$tuning.chi else if (ctrl$method %in% c('S', 'SD')) ctrl$tuning.chi else ctrl$tuning.psi if (!is.numeric(c.psi)) stop("parameter 'tuning.psi' is not numeric") ## MM: lmrob(..., method = "S") triggers this wrongly if (is.null(scale)) { warning(":.vcov.w: scale missing, using D scale") scale <- lmrob..D..fit(obj)$scale } n <- NROW(x) ## --- calculations: matrix part ## weighted xtx.inv matrix w <- if (cov.xwx) obj$rweights else rep(1,n) ## use qr-decomposition from lm.wfit (this already includes the robustness weights) ## update qr decomposition if it is missing or we don't want the robustness weights if (!is.qr(obj$qr) || !cov.xwx) obj$qr <- qr(x * sqrt(w)) p <- if (is.null(obj$rank)) obj$qr$rank else obj$rank cinv <- if(is.qr(obj$qr)) tryCatch(tcrossprod(solve(qr.R(obj$qr))), error = function(e)e) if(inherits(cinv, 'error')) cinv <- matrix(NA,p,p) ## --- calculation: correction factor if (cov.corrfact == 'asympt') { ## asympt correction factor if(cov.hubercorr) warning("option 'cov.hubercorr' is ignored for cov.corrfact = \"asympt\"") ## precalculated default values if applicable corrfact <- if (psi == 'ggw') { if ( isTRUE(all.equal(c.psi, c(-.5, 1.0, 0.95, NA)))) 1.052619 else if (isTRUE(all.equal(c.psi, c(-.5, 1.5, 0.95, NA)))) 1.0525888644 else if (isTRUE(all.equal(c.psi, c(-.5, 1.0, 0.85, NA)))) 1.176479 else if (isTRUE(all.equal(c.psi, c(-.5, 1.5, 0.85, NA)))) 1.176464 else lmrob.E(psi(r)^2, ctrl) / lmrob.E(r*psi(r), ctrl)^2 ## MK: using r*psi(r) instead of psi'(r) is much more accurate ## when using Gauss-Hermite quadrature (= default in lmrob.E()) ## but integrate(.) is more accurate } else if (isTRUE(all.equal(c.psi, .Mpsi.tuning.default(psi)))) { switch(psi, bisquare = 1.0526317574, welsh = 1.0526704649, optimal = 1.0526419204, hampel = 1.0526016980, lqq = 1.0526365291, stop(':.vcov.w: unsupported psi function')) } else lmrob.E(psi(r)^2, ctrl) / lmrob.E(r*psi(r), ctrl)^2 ## r*psi(r): see above varcorr <- 1 } else { ## empirical, approx or hybrid correction factor rstand <- if (cov.resid == 'initial') { ## if the last estimator was a D or T estimator ## then use obj$init$init otherwise use obj$init ## that way for SMD we use the S residuals (and S scale) ## and for SMDM we use the M residuals (and D scale) lobj <- if (grepl('[DT]$',ctrl$method)) obj$init$init else obj$init resid(lobj) / lobj$scale } else if (cov.resid == 'trick') { ## residuals are in fact from earlier estimator, use its scale to standardize them obj$init$resid / obj$init$scale } else obj$resid / scale tau <- if (cov.corrfact %in% c('tau', 'hybrid', 'tauold')) { ## added hybrid here if (!is.null(obj$tau)) obj$tau else if (!is.null(obj$init$tau)) obj$init$tau else stop("(tau / hybrid / tauold): tau not found in 'obj'") } else rep(1,n) rstand <- rstand / tau r.psi <- Mpsi(rstand, c.psi, psi) r.psipr <- Mpsi(rstand, c.psi, psi, deriv = 1) if (any(is.na(r.psipr))) warning(":.vcov.w: Caution. Some psi'() are NA") ## mpp = E[ psi'(.) ] mpp2 = mpp^2 mpp2 <- (mpp <- mean(r.psipr, na.rm=TRUE))^2 ## Huber's correction hcorr <- if (cov.hubercorr) { vpp <- sum((r.psipr - mpp)^2) / n # vpp := var[psi.prime] ## ~= var(r.psipr, na.rm=TRUE) ~= Var[ psi'( e_i / (sigma * tau_i) ) ] (1 + p/n * vpp/mpp2)^2 } else 1 ## sample size correction for var(r.psi^2) ## use tau if 'tau' correction factor, but only if it is available varcorr <- if (cov.corrfact == 'tau' && any(tau != 1)) 1 / mean(tau^2) else n / (n - p) ## changed from 1 / mean(tau) ## if hybrid: replace B^2 (= mpp2) by asymptotic value if (cov.corrfact == 'hybrid') { mpp2 <- if (psi == 'ggw') { if ( isTRUE(all.equal(c.psi, c(-.5, 1.0, 0.95, NA)))) 0.7598857 else if (isTRUE(all.equal(c.psi, c(-.5, 1.5, 0.95, NA)))) 0.6817983 else if (isTRUE(all.equal(c.psi, c(-.5, 1.0, 0.85, NA)))) 0.4811596 else if (isTRUE(all.equal(c.psi, c(-.5, 1.5, 0.85, NA)))) 0.411581 else lmrob.E(r*psi(r), ctrl)^2 ## more accurate than psi'(r) } else if (isTRUE(all.equal(c.psi, .Mpsi.tuning.default(psi)))) switch(psi, bisquare = 0.5742327, welsh = 0.5445068, optimal = 0.8598825, hampel = 0.6775217, lqq = 0.6883393, stop(':.vcov.w: unsupported psi for "hybrid" correction factor')) else lmrob.E(r*psi(r), ctrl)^2 ## more accurate than psi'(r) } ## A / B^2 * Huber.corr : corrfact <- mean({ if (cov.corrfact == 'tauold') 1 else tau^2 } * r.psi^2)/mpp2 * hcorr } ## simple sample size correction sscorr <- switch(cov.dfcorr, # old: codes in {-1, 0, 1,2,3 } "mean" = mean(w), # -1 "mn.vc" = mean(w) * varcorr, # 1 "none" = 1, # 0 "varc" = varcorr, # 2 "mn.df" = mean(w)^2 / (1 - p / sum(w)), # 3 stop("invalid 'cov.dfcorr': ", cov.dfcorr)) structure(scale^2 * sscorr * corrfact * .vcov.aliased(aliased = is.na(coef(obj)), vc=cinv, complete=complete), ## scale^2 * a/b2 * Huber's correction * Cinv -- with attributes weights = w, scale = scale, scorr = sscorr, corrfact = corrfact) }## end{.vcov.w} .vcov.avar1 <- function(obj, x=obj$x, complete = FALSE, # <- differing from vcov.lmrob()s default posdef.meth = c("posdefify", "orig")) { ## was .vcov.MM stopifnot(is.list(ctrl <- obj$control)) ## works only for MM & SM estimates: if (!is.null(ctrl$method) && !ctrl$method %in% c('SM', 'MM')) stop('.vcov.avar1() supports only SM or MM estimates') ## set psi and chi constants psi <- chi <- ctrl$psi if (is.null(psi)) stop('parameter psi is not defined') stopifnot(is.numeric(c.chi <- ctrl$tuning.chi), is.numeric(c.psi <- ctrl$tuning.psi)) ## need (r0, r, scale, x, c.psi,c.chi, bb) r0 <- obj$init$resid r <- resid(obj) scale <- obj$scale if (is.null(x)) x <- model.matrix(obj) bb <- 1/2 ## this is always 1/2 for S estimates by convention ### --- start code from .vcov.MM --- ## scaled residuals n <- length(r) stopifnot(is.matrix(x), n == nrow(x)) if(n != length(r0)) stop("initial estimate residuals length differs from final ones. Typically must refit w/ lmrob()") r.s <- r / scale # final scaled residuals r0.s <- r0 / scale # initial scaled residuals w <- Mpsi(r.s, cc = c.psi, psi = psi, deriv = 1) w0 <- Mchi(r0.s, cc = c.chi, psi = chi, deriv = 1) p <- ncol(x) # possibly p > rankMatrix(x) in singular/aliased case ## 'complete' handling for singular/aliased case if(is.na(complete)) { ## previous default: work with full rank-deficient 'x' } else { aliased <- is.na(coef(obj)) if(any(aliased)) x <- x[, !aliased] if(isTRUE(complete)) { ## nothing } else { ## isFALSE(complete) : p <- obj$rank } } ## FIXME for multivariate y : x.wx <- crossprod(x, x * w) if(inherits(A <- tryCatch(solve(x.wx) * scale, error=function(e)e), "error")) { warning("X'WX is almost singular. Consider using cov = \".vcov.w\"") A <- tryCatch(solve(x.wx, tol = 0) * scale, error=function(e)e) if(inherits(A, "error")) stop("X'WX is singular. Rather use cov = \".vcov.w\"") } a <- A %*% (crossprod(x, w * r.s) / mean(w0 * r0.s)) w <- Mpsi( r.s, cc = c.psi, psi = psi) ## 3) now the standard part (w, x, r0.s, n, A,a, c.chi, bb) w0 <- Mchi(r0.s, cc = c.chi, psi = chi) # rho() Xww <- crossprod(x, w * w0) u1 <- A %*% crossprod(x, x * w^2) %*% (n * A) u2 <- a %*% crossprod(Xww, A) u3 <- A %*% tcrossprod(Xww, a) u4 <- mean(w0^2 - bb^2) * tcrossprod(a) ## list(cov = matrix((u1 - u2 - u3 + u4)/n, p, p), ## wt = w / r.s, a = a) ### --- end code from .vcov.MM --- ret <- (u1 - u2 - u3 + u4)/n ## this might not be a positive definite matrix ## check eigenvalues (symmetric: ensure non-complex) ev <- eigen(ret, symmetric = TRUE) if (any(neg.ev <- ev$values < 0)) { ## there's a problem posdef.meth <- match.arg(posdef.meth) if(ctrl$trace.lev) message("fixing ", sum(neg.ev), " negative eigen([",p,"])values") Q <- ev$vectors switch(posdef.meth, "orig" = { ## remove negative eigenvalue: ## transform covariance matrix into eigenbasis levinv <- solve(Q) cov.eb <- levinv %*% ret %*% Q ## set vectors corresponding to negative ev to zero cov.eb[, neg.ev] <- 0 ## cov.eb[cov.eb < 1e-16] <- 0 ## and transform back ret <- Q %*% cov.eb %*% levinv }, "posdefify" = { ## Instead of using require("sfsmisc") and ## ret <- posdefify(ret, "someEVadd",eigen.m = ev,eps.ev = 0) lam <- ev$values lam[neg.ev] <- 0 o.diag <- diag(ret)# original one - for rescaling dn <- dimnames(ret)# to preserve ret <- Q %*% (lam * t(Q)) ## == Q %*% diag(lam) %*% t(Q) ## rescale to the original diagonal values ## D <- sqrt(o.diag/diag(ret)) where they are >= 0 : if(any(o.diag < 0)) warning(".vcov.avar1: negative diag() fixed up; consider 'cov=\".vcov.w.\"' instead") D <- sqrt(pmax.int(0, o.diag)/diag(ret)) ret <- D * ret * rep(D, each = nrow(Q)) ## == diag(D) %*% ret %*% diag(D) if(!is.null(dn)) dimnames(ret) <- dn }, stop("invalid 'posdef.meth': ", posdef.meth)) } if(isTRUE(complete)) ret <- .vcov.aliased(aliased, ret) attr(ret,"weights") <- w / r.s if(!any(neg.ev)) attr(ret,"eigen") <- ev ret }## end{.vcov.avar1} lmrob..M..fit <- function (x = obj$x, y = obj$y, beta.initial = obj$coef, scale = obj$scale, control = obj$control, obj, mf = obj$model, method = obj$control$method) #<- also when 'control' is not obj$control { c.psi <- .psi.conv.cc(control$psi, control$tuning.psi) ipsi <- .psi2ipsi(control$psi) stopifnot(is.matrix(x)) if(!missing(mf)) warning("'mf' is unused and deprecated") n <- nrow(x) p <- ncol(x) if (is.null(y) && !is.null(obj$model)) y <- model.response(obj$model, "numeric") stopifnot(length(y) == n, length(c.psi) > 0, c.psi >= 0, scale >= 0, length(beta.initial) == p) trace.lev <- as.integer(control$trace.lev) ret <- .C(R_lmrob_MM, x = as.double(x), y = as.double(y), n = as.integer(n), p = as.integer(p), beta.initial = as.double(beta.initial), scale = as.double(scale), coefficients = double(p), residuals = double(n), iter = as.integer(control$max.it), c.psi = as.double(c.psi), ipsi = as.integer(ipsi), loss = double(1), rel.tol = as.double(control$rel.tol), converged = logical(1), trace.lev = trace.lev, mts = as.integer(control$mts), ss = .convSs(control$subsampling) )[c("coefficients", "scale", "residuals", "loss", "converged", "iter")] ## FIXME?: Should rather warn *here* in case of non-convergence ret$fitted.values <- drop(x %*% ret$coefficients) names(ret$coefficients) <- colnames(x) names(ret$residuals) <- rownames(x) ret$rweights <- lmrob.rweights(ret$residuals, scale, control$tuning.psi, control$psi) ret$control <- control if (!missing(obj)) { ## "copy" from 'obj' to the return value 'ret' : if(trace.lev) cat("lmrob..MM..fit(*, obj) --> updating .. ") if (!grepl('M$', method)) { ## update method if it's not there already method <- paste0(method, 'M') } if (!is.null(obj$call)) { ret$call <- obj$call ret$call$method <- method } if (method %in% c('SM', 'MM')) { ret$init.S <- obj } else { ret$init <- obj[intersect(names(obj), c("coefficients", "scale", "residuals", "loss", "converged", "iter", "rweights", "fitted.values", "control", "ostats", "init.S", "init", "kappa", "tau"))] class(ret$init) <- 'lmrob' ret <- c(ret, obj[intersect(names(obj), c("df.residual", "degree.freedom", "xlevels", "terms", "model", "x", "y", "na.action", "contrasts", "MD"))]) } ret$qr <- qr(x * sqrt(ret$rweights)) ret$rank <- ret$qr$rank if(trace.lev) cat(" qr(x * rweights) -> rank=", ret$rank) ## if there is a covariance matrix estimate available in obj ## update it, if possible, else replace it by the default .vcov.w if (!is.null(obj$cov)) { if (!method %in% c('SM', 'MM') && ret$control$cov == '.vcov.avar1') ret$control$cov <- '.vcov.w' lf.cov <- if (!is.function(ret$control$cov)) get(ret$control$cov, mode='function') else ret$control$cov if(trace.lev) cat(", cov() matrix ") ret$cov <- lf.cov(ret, x=x) } if (!is.null(obj$assign)) ret$assign <- obj$assign if (method %in% control$compute.outlier.stats) { ## only true for last step in lmrob.fit() if(trace.lev) cat(", outlierStats() ") ret$ostats <- outlierStats(ret, x, control) } if(trace.lev) cat("\n") } class(ret) <- "lmrob" ret }## --- lmrob..M..fit ##' Compute S-estimator for linear model -- using "fast S" algorithm --> ../man/lmrob.S.Rd lmrob.S <- function (x, y, control, trace.lev = control$trace.lev, only.scale = FALSE, mf = NULL) { if (!is.matrix(x)) x <- as.matrix(x) n <- nrow(x) p <- ncol(x) if(!missing(mf)) warning("'mf' is unused and deprecated") nResample <- if(only.scale) 0L else as.integer(control$nResample) groups <- as.integer(control$groups) nGr <- as.integer(control$n.group) large_n <- (n > control$fast.s.large.n) if (large_n) { if (nGr <= p) stop("'control$n.group' must be larger than 'p' for 'large_n' algorithm") if (nGr * groups > n) stop("'groups * n.group' must be smaller than 'n' for 'large_n' algorithm") if (nGr <= p + 10) ## FIXME (be smarter ..) warning("'control$n.group' is not much larger than 'p', probably too small") } if (length(seed <- control$seed) > 0) { if (exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE)) { seed.keep <- get(".Random.seed", envir = .GlobalEnv, inherits = FALSE) on.exit(assign(".Random.seed", seed.keep, envir = .GlobalEnv)) } assign(".Random.seed", seed, envir = .GlobalEnv) ## why not set.seed(seed) } bb <- as.double(control$bb) c.chi <- .psi.conv.cc(control$psi, control$tuning.chi) best.r <- as.integer(control$best.r.s) stopifnot(length(c.chi) > 0, c.chi >= 0, length(bb) > 0, length(best.r) > 0, best.r >= 1, length(y) == n, n > 0) b <- .C(R_lmrob_S, x = as.double(x), y = as.double(y), n = as.integer(n), p = as.integer(p), nResample = nResample, scale = if(only.scale) mad(y, center=0) # initial scale else double(1), coefficients = double(p), as.double(c.chi), .psi2ipsi(control$psi), bb, best_r = best.r, groups = groups, n.group = nGr, k.fast.s = as.integer(control$k.fast.s), k.iter = as.integer(control$k.max), maxit.scale = as.integer(control$maxit.scale), refine.tol = as.double(control$refine.tol), inv.tol = as.double(control$solve.tol), scale.tol = as.double(control$scale.tol), converged = logical(1), trace.lev = as.integer(trace.lev), mts = as.integer(control$mts), ss = .convSs(control$subsampling), fast.s.large.n = as.integer(if (large_n) control$fast.s.large.n else n+1L) ## avoids the use of NAOK = TRUE for control$fast.s.large.n == Inf )[if(only.scale) "scale" else c("y", # the residuals (on return) "coefficients", "scale", "k.iter", "converged")] scale <- b$scale if (scale < 0) stop("C function R_lmrob_S() exited prematurely") if (scale == 0) warning("S-estimated scale == 0: Probably exact fit; check your data") if(trace.lev) if(only.scale) cat(sprintf("lmrob.S(): scale = %g\n", scale)) else { cat(sprintf("lmrob.S(): scale = %g; coeff.=\n", scale)); print(b$coefficients) } if(only.scale) return(scale) ## --- ----- b$residuals <- setNames(b$y, rownames(x)) b$fitted.values <- y - b$y # y = fitted + res b$y <- NULL # rm'it names(b$coefficients) <- colnames(x) ## robustness weights b$rweights <- lmrob.rweights(b$residuals, scale, control$tuning.chi, control$psi) ## set method argument in control control$method <- 'S' b$control <- control ## add call if called from toplevel if (identical(parent.frame(), .GlobalEnv)) b$call <- match.call() class(b) <- 'lmrob.S' if ("S" %in% control$compute.outlier.stats) b$ostats <- outlierStats(b, x, control) b }## --- lmrob.S() lmrob..D..fit <- function(obj, x=obj$x, control = obj$control, mf = obj$model, method = obj$control$method) #<- also when 'control' is not obj$control { if (is.null(control)) stop('lmrob..D..fit: control is missing') if (!obj$converged) stop('lmrob..D..fit: prior estimator did not converge, stopping') if(!missing(mf)) warning("'mf' is unused and deprecated") if (is.null(x)) x <- model.matrix(obj) w <- obj$rweights if (is.null(w)) stop('lmrob..D..fit: robustness weights undefined') if (is.null(obj$residuals)) stop('lmrob..D..fit: residuals undefined') r <- obj$residuals psi <- control$psi if (is.null(psi)) stop('lmrob..D..fit: parameter psi is not defined') c.psi <- .psi.conv.cc(psi, if (method %in% c('S', 'SD')) control$tuning.chi else control$tuning.psi) if (!is.numeric(c.psi)) stop('lmrob..D..fit: parameter tuning.psi is not numeric') obj$init <- obj[names(obj)[na.omit(match( c("coefficients","scale", "residuals", "loss", "converged", "iter", "ostats", "rweights", "fitted.values", "control", "init.S", "init"), names(obj)))]] obj$init.S <- NULL if (is.null(obj$kappa)) obj$kappa <- lmrob.kappa(obj, control) kappa <- obj$kappa if (is.null(obj$tau)) obj$tau <- lmrob.tau(obj, x, control) tau <- obj$tau ## get starting value for root search (to keep breakdown point!) scale.1 <- sqrt(sum(w * r^2) / kappa / sum(tau^2*w)) ret <- .C(R_find_D_scale, r = as.double(r), kappa = as.double(kappa), tau = as.double(tau), length = as.integer(length(r)), scale = as.double(scale.1), c = as.double(c.psi), ipsi = .psi2ipsi(psi), type = 3L, ## dt1 as only remaining option rel.tol = as.double(control$rel.tol), k.max = as.integer(control$k.max), converged = logical(1))[c("converged", "scale")] obj$scale <- if(ret$converged) ret$scale else NA obj$converged <- ret$converged if (!grepl('D$', method)) { ## append "D" to method if it's not there already method <- method if (method == 'MM') method <- 'SM' method <- paste0(method, 'D') } ## update call if (!is.null(obj$call)) obj$call$method <- method obj$control <- control class(obj) <- "lmrob" ## if there is a covariance matrix estimate available in obj ## update it, if possible, else replace it by the default ## .vcov.w if (!is.null(obj$cov)) { if (control$cov == '.vcov.avar1') control$cov <- '.vcov.w' lf.cov <- if (!is.function(control$cov)) get(control$cov, mode='function') else control$cov obj$cov <- lf.cov(obj, x=x) } if (method %in% control$compute.outlier.stats) obj$ostats <- outlierStats(obj, x, control) obj }## --- lmrob..D..fit globalVariables(c("psi", "wgt", "r"), add=TRUE) ## <- lmrob.E( ) lmrob.kappa <- function(obj, control = obj$control) { if (is.null(control)) stop('control is missing') if (control$method %in% c('S', 'SD')) control$tuning.psi <- control$tuning.chi fun.min <- function(kappa) lmrob.E(psi(r)*r - kappa*wgt(r), control = control) uniroot(fun.min, c(0.1, 1))$root } ## "FIXME" How to get \hat{tau} for a simple *M* estimate here ?? ## lmrob.tau() is used in lmrob..D..fit() lmrob.tau <- function(obj, x=obj$x, control = obj$control, h, fast = TRUE) { if(is.null(control)) stop("'control' is missing") if(missing(h)) h <- if (is.null(obj$qr)) .lmrob.hat(x, obj$rweights) else .lmrob.hat(wqr = obj$qr) ## speed up: use approximation if possible if (fast && !control$method %in% c('S', 'SD')) { c.psi <- control$tuning.psi tfact <- tcorr <- NA switch(control$psi, optimal = if (isTRUE(all.equal(c.psi, 1.060158))) { tfact <- 0.94735878 tcorr <- -0.09444537 }, bisquare = if (isTRUE(all.equal(c.psi, 4.685061))) { tfact <- 0.9473684 tcorr <- -0.0900833 }, welsh = if (isTRUE(all.equal(c.psi, 2.11))) { tfact <- 0.94732953 tcorr <- -0.07569506 }, ggw = if (isTRUE(all.equal(c.psi, c(-.5, 1.0, 0.95, NA)))) { tfact <- 0.9473787 tcorr <- -0.1143846 } else if (isTRUE(all.equal(c.psi, c(-.5, 1.5, 0.95, NA)))) { tfact <- 0.94741036 tcorr <- -0.08424648 }, lqq = if (isTRUE(all.equal(c.psi, c(-.5, 1.5, 0.95, NA)))) { tfact <- 0.94736359 tcorr <- -0.08594805 }, hampel = if (isTRUE(all.equal(c.psi, c(1.35241275, 3.15562975, 7.212868)))) { tfact <- 0.94739770 tcorr <- -0.04103958 }, {}) if (!is.na(tfact)) return(sqrt(1 - tfact*h) * (tcorr*h + 1)) } ## else "non-fast" -- need to compute the integrals : ## kappa kappa <- if(is.null(obj$kappa)) lmrob.kappa(obj, control) else obj$kappa ## local variables ## n <- length(h) ## set psi and cpsi psi <- control$psi if (is.null(psi)) stop('parameter psi is not defined') cpsi <- if (control$method %in% c('S', 'SD')) control$tuning.chi else control$tuning.psi cpsi <- .psi.conv.cc(psi, cpsi)# has its test ipsi <- .psi2ipsi(psi) ## constant for stderr of u_{-i} part and other constants inta <- function(r) .Mpsi(r, cpsi, ipsi)^2 * dnorm(r) intb <- function(r) .Mpsi(r, cpsi, ipsi, deriv = 1) * dnorm(r) ## intc <- function(r) .Mpsi(r, cpsi, ipsi) * r * dnorm(r) # changed from psi/e to psi*e ta <- integrate(inta, -Inf,Inf)$value tb <- integrate(intb, -Inf,Inf)$value ## tE <- integrate(intc, -Inf,Inf)$value ## calculate tau for unique h hu <- unique(h) nu <- length(hu) ## Initialize tau vector tau <- numeric(length=nu) tc <- ta/tb^2 ## --- Gauss-Hermite integration gh <- ghq(control$numpoints) ghz <- gh$nodes ghw <- gh$weights ## Calulate each tau_i for (i in 1:nu) { ## stderr of u_{-i} part s <- sqrt(tc*(hu[i]-hu[i]^2)) tc2 <- hu[i]/tb ## function to be integrated fun <- function(w, v, sigma.i) { t <- (v - tc2*.Mpsi(v, cpsi, ipsi) + w*s)/sigma.i psi.t <- .Mpsi(t, cpsi, ipsi) (psi.t*t - kappa*psi.t/t) * dnorm(v)*dnorm(w) } ## integrate over w wint <- function(v, sigma.i) { ## sapply(v,function(v.j) integrate(fun,-Inf,Inf,v.j,sigma.i)$value) sapply(v, function(v.j) sum(fun(ghz, v.j, sigma.i)*ghw)) } ## integrate over v vint <- function(sigma.i) { ## integrate(wint,-Inf,Inf,sigma.i)$value sum(wint(ghz, sigma.i)*ghw) } ## find tau tau[i] <- uniroot(vint, c(if (hu[i] < 0.9) 3/20 else 1/16, 1.1))$root } tau[match(h, hu)] } lmrob.tau.fast.coefs <- function(cc, psi) { ## function that calculates the coefficients for 'fast' mode of lmrob.tau ctrl <- lmrob.control(tuning.psi = cc, psi = psi) levs <- seq(0, 0.8, length.out = 80) ## calculate taus taus <- lmrob.tau(list(), control=ctrl, h=levs, fast=FALSE) ## calculate asymptotic approximation of taus ta <- lmrob.E(psi(r)^2, ctrl, use.integrate = TRUE) tb <- lmrob.E(psi(r, 1), ctrl, use.integrate = TRUE) tfact <- 2 - ta/tb^2 taus.0 <- sqrt(1 - tfact * levs) ## calculate correction factor tcorr <- coef(lmrob(taus / taus.0 - 1 ~ levs - 1)) c(tfact = tfact, tcorr = tcorr) } lmrob.hatmatrix <- function(x, w = rep(1, NROW(x)), wqr = qr(sqrt(w) * x), names = FALSE) { H <- tcrossprod(qr.qy(wqr, diag(1, NROW(x), x$rank))) if(names && !is.null(rnms <- dimnames(wqr$qr)[[1L]])) dimnames(H) <- list(rnms,rnms) H } .lmrob.hat <- function(x, w = rep(1, NROW(x)), wqr = qr(sqrt(w) * x), names = TRUE) { if (missing(wqr) && !is.matrix(x)) x <- as.matrix(x) ## Faster than computing the whole hat matrix, and then diag(.) : ## == diag(lmrob.hatmatrix(x, w, ...)) h <- pmin(1, rowSums(qr.qy(wqr, diag(1, NROW(wqr$qr), wqr$rank))^2)) if(names && !is.null(rnms <- dimnames(wqr$qr)[[1L]])) names(h) <- rnms h } hatvalues.lmrob <- function(model, ...) { if (is.null(wqr <- model$qr)) .lmrob.hat(model$x, model$rweights) else .lmrob.hat(wqr = wqr) } ##' psi |--> ipsi \in \{0,1,...6} : integer codes used in C .psi2ipsi <- function(psi) { psi <- .regularize.Mpsi(psi, redescending=FALSE) i <- match(psi, c( 'huber', 'bisquare', 'welsh', 'optimal', ## 0 1 2 3 'hampel', 'ggw', 'lqq' ## 4 5 6 )) if(is.na(i)) stop("internal logic error in psi() function name: ", psi, " Please report!") i - 1L } ##' Given psi() fn (as string), possibly convert the tuning-constant vector cc ##' such that it "fits" to psi(). ##' ##' @param psi a string such as \code{"lqq"}. ##' @param cc numeric tuning-constant vector, for "ggw" and "lqq", ideally ##' with an \code{\link{attr}}ibute \code{"constants"} as from ##' \code{\link{lmrob.control}(.)$tuning.psi} or from ##' \code{\link{.psi.const}(psi, *)}. .psi.conv.cc <- function(psi, cc) { if (!is.character(psi) || length(psi) != 1) stop("argument 'psi' must be a string (denoting a psi function)") if(!is.numeric(cc)) stop("tuning constant 'cc' is not numeric") ## "FIXME": For (ggw, lqq) this is much related to .psi.const() below switch(tolower(psi), 'ggw' = { ## Input: 4 parameters, (minimal slope, b, efficiency, breakdown point) _or_ c(0, a,b,c, m.rho) ## Output 'k': either k in {1:6} or k = c(0, k[2:5]) ## prespecified 6 cases all treated in C ( ../src/lmrob.c ) via these codes: if ( isTRUE(all.equal(cc, c(-.5, 1 , 0.95, NA)))) return(1) else if (isTRUE(all.equal(cc, c(-.5, 1 , 0.85, NA)))) return(2) else if (isTRUE(all.equal(cc, c(-.5, 1. , NA, 0.5)))) return(3) else if (isTRUE(all.equal(cc, c(-.5, 1.5, 0.95, NA)))) return(4) else if (isTRUE(all.equal(cc, c(-.5, 1.5, 0.85, NA)))) return(5) else if (isTRUE(all.equal(cc, c(-.5, 1.5, NA, 0.5)))) return(6) else if (length(cc) == 5 && cc[1] == 0 || (length(cc <- attr(cc, 'constants')) == 5 && cc[1] == 0)) return(cc) else stop('Coefficients for ',psi,' function incorrectly specified.\n', 'Use c(minimal slope, b, efficiency, breakdown point) [6 hard-coded special cases]\n', ' or c(0, a,b,c, max_rho) as from .psi.const(',psi,', cc).') }, 'lqq' = { ## Input: 4 parameters, (minimal slope, b/c, efficiency, breakdown point) _or_ (b, c, s) [length 3] ## Output: k[1:3] = (b, c, s) if (isTRUE(all.equal(cc, c(-.5, 1.5, 0.95, NA)))) return(c(1.4734061, 0.9822707, 1.5)) else if (isTRUE(all.equal(cc, c(-.5, 1.5, NA, 0.5)))) return(c(0.4015457, 0.2676971, 1.5)) else if (length(cc) == 3 || length(cc <- attr(cc, 'constants')) == 3) return(cc) else stop('Coefficients for ',psi,' function incorrectly specified.\n', 'Use c(minimal slope, b, efficiency, breakdown point) [2 special cases]\n', ' or c(b, c, s) as from .psi.const(',psi,', cc).') }, 'hampel' = { ## just check length of coefficients if (length(cc) != 3) stop('Coef. for Hampel psi function not of length 3') }, { ## otherwise: should have length 1 if (length(cc) != 1) stop('Coef. for psi function ', psi,' not of length 1') }) return(cc) } ##' @title For GGW's psi(), find x with minimal slope, and the min.slope ##' @param a "scale" of GGW's psi ##' @param b exponent of GGW's psi ##' @param c "huber-cutoff" of GGW's psi ##' @param ... further arguments passed to optimize(), notably 'tol' ##' @return the return value of optimize(): list(minimum, objective) ##' @author Manuel Kohler and Martin Maechler .psi.ggw.mxs <- function(a, b, c, tol = .Machine$double.eps^0.25) { ipsi <- .psi2ipsi('ggw') ccc <- c(0, a, b, c, 1) ## == .psi.conv.cc('ggw', cc=c(0, a, b, c, 1)) optimize(.Mpsi, c(c, max(a+b+2*c, 0.5)), ccc=ccc, ipsi=ipsi, deriv = 1, tol = tol) } .psi.ggw.ms <- function(a, b, c, tol = .Machine$double.eps^0.25) ## find minimal slope .psi.ggw.mxs(a, b, c, tol=tol)[["objective"]] .psi.ggw.finda <- function(ms, b, c, tol = .Machine$double.eps^0.25, maxiter = 1000, ms.tol = tol / 64,...) ## find constant 'a' (reparametrized to 1/o scale). { val <- uniroot(function(a) .psi.ggw.ms(1/a, b, c, tol=ms.tol) - ms, c(200, if (b > 1.4) 1/400 else if (b > 1.3) 1/50 else 1/20), tol=tol, maxiter=maxiter) 1/val$root } .psi.ggw.eff <- function(a, b, c) ## calculate asymptotic efficiency { ipsi <- .psi2ipsi('ggw') ccc <- c(0, a, b, c, 1) lmrob.E(.Mpsi(r, ccc, ipsi, deriv=1), use.integrate = TRUE)^2 / lmrob.E(.Mpsi(r, ccc, ipsi) ^2, use.integrate = TRUE) } .psi.ggw.bp <- function(a, b, c, ...) { ## calculate kappa ipsi <- .psi2ipsi('ggw') abc <- c(0, a, b, c) nc <- integrate(.Mpsi, 0, Inf, ccc = c(abc, 1), ipsi=ipsi, ...)$value lmrob.E(.Mchi(r, ccc = c(abc, nc), ipsi), use.integrate = TRUE) } .psi.ggw.findc <- function(ms, b, eff = NA, bp = NA, subdivisions = 100L, rel.tol = .Machine$double.eps^0.25, abs.tol = rel.tol, tol = .Machine$double.eps^0.25, ms.tol = tol/64, maxiter = 1000) { ## find c by eff for bp c. <- if (!is.na(eff)) { if (!is.na(bp)) warning('tuning constants for ggw psi: both eff and bp specified, ignoring bp') ## find c by matching eff tryCatch(uniroot(function(x) .psi.ggw.eff(.psi.ggw.finda(ms, b, x, ms.tol=ms.tol), b, x) - eff, c(0.15, if (b > 1.61) 1.4 else 1.9), tol=tol, maxiter=maxiter)$root, error=function(e)e) } else { if (is.na(bp)) stop("neither breakdown point 'bp' nor efficiency 'eff' specified") ## find c by matching bp tryCatch(uniroot(function(x) .psi.ggw.bp(.psi.ggw.finda(ms, b, x, ms.tol=ms.tol), b, x) - bp, c(0.08, if (ms < -0.4) 0.6 else 0.4), tol=tol, maxiter=maxiter)$root, error=function(e)e) } if (inherits(c., 'error')) stop(gettextf('unable to find constants for "ggw" psi function: %s', c.$message), domain=NA) a <- .psi.ggw.finda(ms, b, c., ms.tol=ms.tol) nc <- integrate(.Mpsi, 0, Inf, ccc= c(0, a, b, c., 1), ipsi = .psi2ipsi('ggw'))$value ## return c(0, a, b, c., nc) } lmrob.efficiency <- function(psi, cc, ccc = .psi.conv.cc(psi, cc=cc), ...) { ipsi <- .psi2ipsi(psi) integrate(function(x) .Mpsi(x, ccc=ccc, ipsi=ipsi, deriv=1)*dnorm(x), -Inf, Inf, ...)$value^2 / integrate(function(x) .Mpsi(x, ccc=ccc, ipsi=ipsi)^2 *dnorm(x), -Inf, Inf, ...)$value } lmrob.bp <- function(psi, cc, ccc = .psi.conv.cc(psi, cc=cc), ...) { ipsi <- .psi2ipsi(psi) integrate(function(x) .Mchi(x, ccc=ccc, ipsi=ipsi)*dnorm(x), -Inf, Inf, ...)$value } ##' @title Find tuning constant 'c' for "lqq" psi function ---> ../man/psiFindc.Rd ##' @param cc numeric vector = c(min_slope, b/c, eff, bp) ; ##' typically 'eff' or 'bp' are NA and will be computed ##' .... ##' @return constants for c function: (b, c, s) == (b/c * c, c, s = 1 - min_slope) .psi.lqq.findc <- function(ms, b.c, eff = NA, bp = NA, interval = c(0.1, 4), subdivisions = 100L, rel.tol = .Machine$double.eps^0.25, abs.tol = rel.tol, tol = .Machine$double.eps^0.25, maxiter = 1000) { ## b.c == b/c bcs <- function(cc) c(b.c*cc, cc, 1-ms) t.fun <- if (!is.na(eff)) { ## 'eff' specified if (!is.na(bp)) warning("tuning constants for \"lqq\" psi: both 'eff' and 'bp' specified, ignoring 'bp'") ## find c by b, s and eff function(c) lmrob.efficiency('lqq', bcs(c), subdivisions=subdivisions, rel.tol=rel.tol, abs.tol=abs.tol) - eff } else { if (is.na(bp)) stop('Error: neither breakdown point nor efficiency specified') ## breakdown point 'bp' specified function(c) lmrob.bp('lqq', bcs(c), subdivisions=subdivisions, rel.tol=rel.tol, abs.tol=abs.tol) - bp } c. <- tryCatch(uniroot(t.fun, interval=interval, tol=tol, maxiter=maxiter)$root, error=function(e)e) if (inherits(c., 'error')) stop(gettextf('unable to find constants for "lqq" psi function: %s', c.$message), domain=NA) else bcs(c.) } ##' For ("ggw", "lqq"), if cc is not one of the predefined ones, ##' compute the tuning constants numerically, from the given specs (eff / bp). ##' Much related to .psi.conv.cc() above .psi.const <- function(cc, psi) { switch(psi, "ggw" = { ## only calculate for non-standard coefficients if (isTRUE(all.equal(cc, c(-.5, 1, 0.95, NA))) || isTRUE(all.equal(cc, c(-.5, 1, 0.85, NA))) || isTRUE(all.equal(cc, c(-.5, 1, NA, 0.5))) || isTRUE(all.equal(cc, c(-.5, 1.5, 0.95, NA))) || isTRUE(all.equal(cc, c(-.5, 1.5, 0.85, NA))) || isTRUE(all.equal(cc, c(-.5, 1.5, NA, 0.5)))) { ## treated with in C code: in ../src/lmrob.c, functions *_ggw() } else attr(cc, 'constants') <- .psi.ggw.findc(ms=cc[[1]], b=cc[[2]], eff=cc[[3]], bp=cc[[4]]) }, "lqq" = { ## use pre-computed values for (the two) "standard" coefficients: attr(cc, 'constants') <- ## b.c :== b/c if (isTRUE(all.equal(cc, c(-.5, 1.5, 0.95, NA)))) c(1.4734061, 0.9822707, 1.5) # as in .psi.conv.cc() {FIXME? only in 1 place} else if (isTRUE(all.equal(cc, c(-.5, 1.5, NA, 0.5)))) c(0.4015457, 0.2676971, 1.5) else .psi.lqq.findc(ms=cc[[1]], b.c=cc[[2]], eff=cc[[3]], bp=cc[[4]]) }, stop("method for psi function ", psi, " not implemented")) cc } Mpsi <- function(x, cc, psi, deriv=0) { x[] <- .Call(R_psifun, x, .psi.conv.cc(psi, cc), .psi2ipsi(psi), deriv) x } .Mpsi <- function(x, ccc, ipsi, deriv=0) .Call(R_psifun, x, ccc, ipsi, deriv) Mchi <- function(x, cc, psi, deriv=0) { x[] <- .Call(R_chifun, x, .psi.conv.cc(psi, cc), .psi2ipsi(psi), deriv) x } .Mchi <- function(x, ccc, ipsi, deriv=0) .Call(R_chifun, x, ccc, ipsi, deriv) Mwgt <- function(x, cc, psi) { x[] <- .Call(R_wgtfun, x, .psi.conv.cc(psi, cc), .psi2ipsi(psi)) x } .Mwgt <- function(x, ccc, ipsi) .Call(R_wgtfun, x, ccc, ipsi) ## only for nlrob() -- and to use instead of MASS:::psi.huber etc: ## returns a *function* a la psi.huber() : .Mwgt.psi1 <- function(psi, cc = .Mpsi.tuning.default(psi)) { ipsi <- .psi2ipsi(psi) ccc <- .psi.conv.cc(psi, cc) ## return function *closure* : function(x, deriv = 0) if(deriv) .Mpsi(x, ccc, ipsi, deriv=deriv) else .Mwgt(x, ccc, ipsi) } ##' The normalizing constant for rho(.) <--> rho~(.) MrhoInf <- function(cc, psi) { cc <- .psi.conv.cc(psi, cc) .Call(R_rho_inf, cc, .psi2ipsi(psi)) } .MrhoInf <- function(ccc, ipsi) .Call(R_rho_inf, ccc, ipsi) lmrob.rweights <- function(resid, scale, cc, psi, eps = 16 * .Machine$double.eps) { stopifnot(is.numeric(scale), length(scale) == 1L, scale >= 0) if (scale == 0) { ## exact fit m <- max(ar <- abs(resid), na.rm=TRUE) if(m == 0) numeric(seq_len(ar)) else as.numeric(ar < eps * m)# 1 iff res ~= 0 } else Mwgt(resid / scale, cc, psi) } lmrob.E <- function(expr, control, dfun = dnorm, use.integrate = FALSE, obj, ...) { expr <- substitute(expr) if (missing(control) && !missing(obj)) control <- obj$control lenvir <- if (!missing(control)) { psi <- control$psi if (is.null(psi)) stop('parameter psi is not defined') c.psi <- control[[if (control$method %in% c('S', 'SD')) "tuning.chi" else "tuning.psi"]] if (!is.numeric(c.psi)) stop('tuning parameter (chi/psi) is not numeric') list(psi = function(r, deriv = 0) Mpsi(r, c.psi, psi, deriv), chi = function(r, deriv = 0) Mchi(r, c.psi, psi, deriv), ## change? wgt = function(r) Mwgt(r, c.psi, psi)) ## change? } else list() pf <- parent.frame() FF <- function(r) eval(expr, envir = c(list(r = r), lenvir), enclos = pf) * dfun(r) if (isTRUE(use.integrate)) { integrate(FF, -Inf,Inf, ...)$value ## This would be a bit more accurate .. *AND* faster notably for larger 'numpoints': ## } else if(use.integrate == "GQr") { ## require("Gqr")# from R-forge [part of lme4 project] ## ## initialize Gauss-Hermite Integration ## GH <- GaussQuad(if(is.null(control$numpoints)) 13 else control$numpoints, ## "Hermite") ## ## integrate ## F. <- function(r) eval(expr, envir = c(list(r = r), lenvir), enclos = pf) ## sum(GH$weights * F.(GH$knots)) } else { ## initialize Gauss-Hermite Integration gh <- ghq(if(is.null(control$numpoints)) 13 else control$numpoints) ## integrate sum(gh$weights * FF(gh$nodes)) } } ghq <- function(n = 1, modify = TRUE) { ## Adapted from gauss.quad in statmod package ## which itself has been adapted from Netlib routine gaussq.f ## Gordon Smyth, Walter and Eliza Hall Institute n <- as.integer(n) if(n<0) stop("need non-negative number of nodes") if(n==0) return(list(nodes=numeric(0), weights=numeric(0))) ## i <- seq_len(n) # 1 .. n i1 <- seq_len(n-1L) muzero <- sqrt(pi) ## a <- numeric(n) b <- sqrt(i1/2) A <- numeric(n*n) ## A[(n+1)*(i-1)+1] <- a # already 0 A[(n+1)*(i1-1)+2] <- b A[(n+1)*i1] <- b dim(A) <- c(n,n) vd <- eigen(A,symmetric=TRUE) n..1 <- n:1L w <- vd$vectors[1, n..1] w <- muzero * w^2 x <- vd$values[n..1] # = rev(..) list(nodes=x, weights= if (modify) w*exp(x^2) else w) } ##' (non)singular subsampling - code to be passed to C, as `ss` in ../src/lmrob.c .convSs <- function(ss) switch(ss, "simple"= 0L, "nonsingular"= 1L, stop(gettextf("unknown setting for 'subsampling': %s", ss), domain=NA)) outlierStats <- function(object, x = object$x, control = object$control, epsw = control$eps.outlier, epsx = control$eps.x, warn.limit.reject = control$warn.limit.reject, warn.limit.meanrw = control$warn.limit.meanrw ) { ## look at all the factors in the model and count ## for each level how many observations were rejected. ## Issue a warning if there is any level where more than ## warn.limit.reject observations were rejected or ## the mean robustness weights was <= warn.limit.meanrw rw <- object$rweights ## ^^^^^^^^^^^^^^^ not weights(..., type="robustness") as we ## don't want naresid() padding here. if (is.function(epsw)) epsw <- epsw(nobs(object, use.fallback = TRUE)) if (!is.numeric(epsw) || length(epsw) != 1) stop("'epsw' must be numeric(1) or a function of nobs(obj.) which returns a numeric(1)") rj <- abs(rw) < epsw if (NROW(x) != length(rw)) stop("number of rows in 'x' and length of 'object$rweights' must be the same") if (is.function(epsx)) epsx <- epsx(max(abs(x))) if (!is.numeric(epsx) || length(epsx) != 1) stop("'epsx' must be numeric(1) or a function of max(abs(x)) which returns a numeric(1)") xnz <- abs(x) > epsx cc <- function(idx) { nnz <- sum(idx) ## <- if this is zero, 'Ratio' and 'Mean.RobWeight' will be NaN Fr <- sum(rj[idx]) c(N.nonzero = nnz, N.rejected = Fr, Ratio = Fr / nnz, Mean.RobWeight = mean(rw[idx])) } report <- t(apply(cbind(Overall=TRUE, xnz[, colSums(xnz) < NROW(xnz)]), 2, cc)) shout <- FALSE # should we "shout"? -- scalar logical, never NA lbr <- rep.int(FALSE, nrow(report)) if (!is.null(warn.limit.reject)) { lbr <- report[, "Ratio"] >= warn.limit.reject shout <- any(lbr & !is.na(lbr)) } if (!is.null(warn.limit.meanrw)) { lbr <- lbr | report[, "Mean.RobWeight"] <= warn.limit.meanrw shout <- shout || any(lbr & !is.na(lbr)) } if (shout) { nbr <- rownames(report)[lbr] attr(report, "warning") <- paste("Possible local breakdown of", paste0("'", nbr, "'", collapse=", ")) warning("Detected possible local breakdown of ", control$method, "-estimate in ", if (length(nbr) > 1) paste(length(nbr), "coefficients") else "coefficient", " ", paste0("'", nbr, "'", collapse=", "), ".", if ("KS2014" %in% control$setting) "" else "\nUse lmrob argument 'setting=\"KS2014\"' to avoid this problem." ) } report } robustbase/R/lmrobPredict.R0000644000176200001440000001667412221620231015402 0ustar liggesusers# File .../lmrobPredict.R # Part of the R package 'robustbase', http://www.R-project.org # Based on predict.lm (cf. src/library/stats/R/lm.R) # # 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. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ # Note that '# *rob' indicate adjustment for the robust case predict.lmrob <- function(object, newdata, se.fit = FALSE, scale = NULL, df = NULL, # *rob interval = c("none", "confidence", "prediction"), level = .95, type = c("response", "terms"), terms = NULL, na.action = na.pass, pred.var = res.var/weights, weights = 1, ...) { tt <- terms(object) if(!inherits(object, "lmrob") && !inherits(object, "glmrob")) # *rob warning("calling predict.lm() ...") # *rob if(missing(newdata) || is.null(newdata)) { mm <- X <- model.matrix.lm(object) mmDone <- TRUE offset <- object$offset } else { Terms <- delete.response(tt) m <- model.frame(Terms, newdata, na.action = na.action, xlev = object$xlevels) if(!is.null(cl <- attr(Terms, "dataClasses"))) .checkMFClasses(cl, m) X <- model.matrix(Terms, m, contrasts.arg = object$contrasts) offset <- rep.int(0, nrow(X)) if (!is.null(off.num <- attr(tt, "offset"))) for(i in off.num) offset <- offset + eval(attr(tt, "variables")[[i+1]], newdata) if (!is.null(object$call$offset)) offset <- offset + eval(object$call$offset, newdata) mmDone <- FALSE } n <- length(object$residuals) # NROW(qr(object)$qr) p <- object$rank if(is.null(p)) { # *rob df <- Inf p <- sum(!is.na(coef(object))) piv <- seq_len(p) } else { p1 <- seq_len(p) piv <- if(p) qr(object)$pivot[p1] } if(p < ncol(X) && !(missing(newdata) || is.null(newdata))) warning("prediction from a rank-deficient fit may be misleading") beta <- object$coefficients X.piv <- X[, piv, drop = FALSE] predictor <- drop(X.piv %*% beta[piv]) if (!is.null(offset)) predictor <- predictor + offset interval <- match.arg(interval) if (interval == "prediction") { if (missing(newdata)) { # *rob: this and next if statement are combined warning("Predictions on current data refer to _future_ responses") if (missing(weights)) { w <- weights(object) # *rob if (!is.null(w)) { weights <- w warning("Assuming prediction variance inversely proportional to weights used for fitting") } } } if (!missing(newdata) && missing(weights) && !is.null(object$weights) && missing(pred.var)) warning("Assuming constant prediction variance even though model fit is weighted") if (inherits(weights, "formula")){ if (length(weights) != 2L) stop("'weights' as formula should be one-sided") d <- if(missing(newdata) || is.null(newdata)) model.frame(object) else newdata weights <- eval(weights[[2L]], d, environment(weights)) } }## "prediction" interval type <- match.arg(type) if(se.fit || interval != "none") {# *rob: whole 'then' statement is different df <- object$df.residual res.var <- if (is.null(scale)) object$s^2 else scale^2 ip <- if(type != "terms") diag(X.piv %*% object$cov %*% t(X.piv)) else rep.int(0, n) } if (type == "terms") { ## type == "terms" ------------ if(!mmDone){ mm <- model.matrix.lm(object) # *rob: call of model.matrix.lm # instead of model.matrix mmDone <- TRUE } aa <- attr(mm, "assign") ll <- attr(tt, "term.labels") hasintercept <- attr(tt, "intercept") > 0L if (hasintercept) ll <- c("(Intercept)", ll) aaa <- factor(aa, labels = ll) asgn <- split(order(aa), aaa) if (hasintercept) { asgn$"(Intercept)" <- NULL if(!mmDone){ mm <- model.matrix.lm(object) # *rob: call of model.matrix.lm # instead of model.matrix mmDone <- TRUE } avx <- colMeans(mm) termsconst <- sum(avx[piv] * beta[piv]) } nterms <- length(asgn) if(nterms > 0) { predictor <- matrix(ncol = nterms, nrow = NROW(X)) dimnames(predictor) <- list(rownames(X), names(asgn)) if (se.fit || interval != "none") { ip <- predictor # *rob: just this assignment is needed } if(hasintercept) X <- sweep(X, 2L, avx, check.margin=FALSE) unpiv <- rep.int(0L, NCOL(X)) unpiv[piv] <- p1 for (i in seq.int(1L, nterms, length.out = nterms)) { iipiv <- asgn[[i]] # Columns of X, ith term ii <- unpiv[iipiv] # Corresponding rows of cov iipiv[ii == 0L] <- 0L predictor[, i] <- if(any(iipiv > 0L)) X[, iipiv, drop = FALSE] %*% beta[iipiv] else 0 if (se.fit || interval != "none"){ ip[, i] <- if(any(iipiv > 0L)){# *rob: next steps modified h.X <- X[, iipiv, drop = FALSE] diag(h.X %*% object$cov[ii, ii] %*% t(h.X)) } else 0 } } if (!is.null(terms)) { predictor <- predictor[, terms, drop = FALSE] if (se.fit) ip <- ip[, terms, drop = FALSE] } } else { # no terms predictor <- ip <- matrix(0, n, 0L) } attr(predictor, 'constant') <- if (hasintercept) termsconst else 0 } ### Now construct elements of the list that will be returned if(interval != "none") { tfrac <- qt((1 - level)/2, df) hwid <- tfrac * switch(interval, confidence = sqrt(ip), prediction = sqrt(ip+pred.var) ) if(type != "terms") { predictor <- cbind(predictor, predictor + hwid %o% c(1, -1)) colnames(predictor) <- c("fit", "lwr", "upr") } else { if (!is.null(terms)) hwid <- hwid[, terms, drop = FALSE] lwr <- predictor + hwid upr <- predictor - hwid } } if(se.fit || interval != "none") { se <- sqrt(ip) if (type == "terms" && !is.null(terms)) se <- se[, terms, drop = FALSE] } if(missing(newdata) && !is.null(na.act <- object$na.action)) { predictor <- napredict(na.act, predictor) if(se.fit) se <- napredict(na.act, se) } if(type == "terms" && interval != "none") { if(missing(newdata) && !is.null(na.act)) { lwr <- napredict(na.act, lwr) upr <- napredict(na.act, upr) } list(fit = predictor, se.fit = se, lwr = lwr, upr = upr, df = df, residual.scale = sqrt(res.var)) } else if (se.fit) list(fit = predictor, se.fit = se, df = df, residual.scale = sqrt(res.var)) else predictor } robustbase/R/ltsPlot.R0000644000176200001440000002347213434014060014413 0ustar liggesusers#### This is from the R package #### #### rrcov : Scalable Robust Estimators with High Breakdown Point #### #### by Valentin Todorov ### 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, a copy is available at ### http://www.r-project.org/Licenses/ plot.lts <- function(x, which = c("all", "rqq","rindex", "rfit", "rdiag"), classic = FALSE, ask = (which[1] == "all" && dev.interactive()), id.n, ...) { if (!inherits(x, "lts")) stop("Use only with 'lts' objects") ltsPlot(x, which, classic, ask, id.n, ...) } ltsPlot <- function(x, which = c("all", "rqq","rindex", "rfit", "rdiag"), classic = FALSE, ask = FALSE, id.n, ...) { ##@bdescr ## Make plots for model checking and outlier detection based on ## the LTS regression estimates: ## rqq - normal quantile plot of the LTS and LS residuals ## rindex - standardized LTS/LS Residuals versus index ## rfit - standardized LTS/LS Residuals versus fitted values ## rdiag - regression diagnostic plot ## ##@edescr ## ##@in x : [object] An lts object ##@in which : [character] A plot option, one of: ## rqq: ## rdiag: ## rfit: ## rindex: ## default is "rqq" ##@in classic : [logical] If true the classical plot will be displayed too ## default is classic=FALSE ##@in id.n : [number] number of observations to be identified with a label. label <- function(x, y, ord, lab, id.n, ...) { if(id.n) { n <- length(y) which <- order(ord)[(n - id.n + 1):n] lab <- if(missing(lab)) which else lab[which] ## how to adjust the labels? ## a) adj=0.1 ## b) x=x+xrange ## c) pos=4 (to the left of the observation) ## d) additionaly to pos specify offset=0.2 (fraction of a character) xrange <- par("usr") xrange <- (xrange[2] - xrange[1])/50 text(x[which], y[which], pos = 4, offset = 0.2, lab, ...) } } ## The R function 'qqline' (package::stats) adds a line to a ## normal quantile-quantile plot which passes through the ## first and third quartiles. In S this function returns the ## slope and intercept of the line, but not in R. ## Here we need the slope and intercept in order to sort the ## residuals according to their distance from the line. myqqline <- function(y, datax = FALSE, ...) { y <- quantile(y[!is.na(y)],c(0.25, 0.75)) x <- qnorm(c(0.25, 0.75)) if(datax) { slope <- diff(x)/diff(y) int <- x[1] - slope*y[1] } else { slope <- diff(y)/diff(x) int <- y[1]-slope*x[1] } abline(int, slope, ...) invisible(list(int = int, slope = slope)) } myqqplot <- function(r, classic = FALSE, lab, id.n, ...) { ## Normal QQ-plot of residuals: ## Produces a Quantile-Quantile plot in which the vector r is plotted ## against the quantiles of a standard normal distribution. xlab <- "Quantiles of the standard normal distribution" ylab <- if(classic) "Standardized LS residual" else "Standardized LTS residual" qq <- qqnorm(r, mgp = mgp, xlab = xlab, ylab = ylab, ...) ll <- myqqline(r, lty = 2, ...) ord <- abs(qq$y - ll$int - ll$slope * qq$x) label(qq$x, qq$y, ord, lab, id.n, ...) } indexplot <- function(r, scale, classic = FALSE, lab, id.n, ...) { ## Index plot of standardized residuals: ## Plot the vector r (LTS or LS residuals) against ## the observation indexes. Identify by a label the id.n ## observations with largest value of r. ## Use classic=FALSE/TRUE to choose the label of the vertical axes ## VT:: 26.12.2004 if(scale == 0) stop("Index plot of standardized residuals is not avalable if scale = 0") xlab <- "Index" ylab <- if(classic) "Standardized LS residual" else "Standardized LTS residual" x <- 1:length(r) y <- r/scale ylim <- c(min(-3, min(y)), max(3, max(y))) plot(x, y, ylim = ylim, mgp = mgp, xlab = xlab, ylab = ylab, ...) label(x, y, ord = abs(y), lab, id.n, ...) abline(h = 0, lty = 4, ...) abline(h = c(-2.5, 2.5), ...) mtext(c("-2.5","2.5"), side = 4, line = 1.2, at = c(-2.5, 2.5), ...) title(main = "Residuals vs Index") } ##' Tukey-Anscombe Plot (rename ?!) fitplot <- function(obj, classic = FALSE, lab, id.n, ...) { ## Standardized residuals vs Fitted values plot: ## Plot the vector r (LTS or LS residuals) against ## the corresponding fitted values. Identify by a ## label the id.n observations with largest value of r. ## Use classic=FALSE/TRUE to choose the label of the vertical axes ## VT:: 26.12.2004 if(obj$scale == 0) stop("Standardized residuals vs Fitted values plot is not avalable if scale = 0") ## x <- obj$X %*% as.matrix(obj$coef) x <- obj$fitted.values y <- obj$residuals/obj$scale ylim <- c(min(-3, min(y)), max(3, max(y))) yname <- names(obj$scale) xlab <- paste("Fitted :", yname) ylab <- if(classic) "Standardized LS residual" else "Standardized LTS residual" plot(x, y, ylim = ylim, mgp = mgp, xlab = xlab, ylab = ylab, ...) label(x, y, ord = abs(y), lab, id.n, ...) abline(h = 0, lty = 4, ...) abline(h = c(-2.5, 2.5), ...) mtext(c("-2.5","2.5"), side = 4, line = 1.2, at = c(-2.5, 2.5), ...) title(main = "Residuals vs Fitted") } ## fitplot() rdiag <- function(obj, classic = FALSE, lab, id.n, ...) { ## Regression diagnostic plot: ## Plot the vector of the standardized residuals against ## the robust distances of the predictor variables ## Identify by a label the id.n observations with largest value of r. ## Use classic=FALSE/TRUE to choose the label of the vertical axes p <- if(obj$intercept) length(obj$coef) - 1 else length(obj$coef) if(p <= 0) warning("Diagnostic plot is not available for univar\niate location and scale estimation") ## VT:: 26.12.2004 if(obj$scale <= 0) stop("Regression Diagnostic plot is not avalable if scale = 0") if(is.null(obj$RD)) stop("Regression Diagnostic plot is not avalable: option mcd=F was set in ltsReg().") if(obj$RD[1] == "singularity") stop("The MCD covariance matrix was singular.") if(classic) { xlab <- "Mahalanobis distance" ylab <- "Standardized LS residual" } else { xlab <- "Robust distance computed by MCD" ylab <- "Standardized LTS residual" } ## VT:: 18.01.20045 ## set id.n to the number of all outliers: ## regression outliers (weight==0)+ leverage points (RD > cutoff) if(missing(id.n)) { id.n <- length(unique(c(which(obj$RD > sqrt(qchisq(0.975, p))), which(obj$lts.wt == 0)))) } quant <- max(c(sqrt(qchisq(0.975, p)), 2.5)) x <- obj$RD y <- obj$residuals/obj$scale ## xlim <- c(0, max(quant + 0.1, max(x))) ylim <- c(min(-3, min(y)), max(3, max(y))) plot(x, y, ylim = ylim, mgp = mgp, xlab = xlab, ylab = ylab, main = "Regression Diagnostic Plot", ...) ord <- apply(abs(cbind(x/2.5, y/quant)), 1, max) label(x, y, ord = ord, lab, id.n, ...) abline(v = quant, h = c(-2.5, 2.5), ...) mtext(c("-2.5","2.5"), side = 4, line = 1.2, at = c(-2.5, 2.5), ...) } ## rdiag() ## parameters and preconditions which <- match.arg(which) r <- residuals(x) n <- length(r) id.n.missing <- missing(id.n) || is.null(id.n) ## if id.n is missing, it will be set to a default for each plot. if(!id.n.missing) { id.n <- as.integer(id.n) if(id.n < 0 || id.n > n) stop("'id.n' must be in {1,..,",n,"}") } mgp <- c(2.5, 1, 0) # set the margin line (in 'mex' units) for the: ## - axis title, ## - axis labels and ## - axis line. ## The default is 'c(3, 1, 0)'. if(!classic) par(mfrow = c(1,1), pty = "m") else { par(mfrow = c(1,2), pty = "m") ## calculate the LS regression (using LTS with alpha = 1) ## if intercept, obj$X is augmented with a column of 1s - remove it if(x$intercept && # model with intercept length(dim(x$X)) == 2 && # X is 2-dimensional (nc <- ncol(x$X)) > 1 && # X has more than 1 column all(x$X[,nc] == 1)) # the last column of X is all 1s X <- x$X[, -nc] else X <- x$X obj.cl <- ltsReg(X, x$Y, intercept = x$intercept, alpha = 1) } if (ask) { op <- par(ask = TRUE) on.exit(par(op)) } ## set id.n to the number of regression outliers (weight==0): nx <- if(id.n.missing) length(which(x$lts.wt == 0)) else id.n if(which == "all" || which == "rqq") { ## VT::20.12.2006 - the standardized residuals are in x$resid ## - no change for the other plot functions - the residuals will be standardized ## inside indexplot(), fitplot(), etc myqqplot(x$resid, id.n = nx, ...) # normal QQ-plot of the LTS residuals if(classic) # normal QQ-plot of the LS residuals myqqplot(obj.cl$resid, classic = TRUE, id.n = nx, ...) } if(which == "all" || which == "rindex") { indexplot(x$residuals, x$scale, id.n = nx, ...) # index plot of the LTS residuals if(classic) # index plot of the LS residuals indexplot(obj.cl$residuals, obj.cl$scale, classic = TRUE, id.n = nx, ...) } if(which == "all" || which == "rfit") { fitplot(x, id.n = nx, ...) if(classic) fitplot(obj.cl, classic = TRUE, id.n = nx, ...) } if(which == "all" || which == "rdiag") { rdiag(x, id.n = id.n, ...) if(classic) rdiag(obj.cl, classic = TRUE, id.n = id.n, ...) } } robustbase/R/lmrob.R0000644000176200001440000006305413326344173014100 0ustar liggesusers ### The first part of lmrob() much cut'n'paste from lm() - on purpose! lmrob <- function(formula, data, subset, weights, na.action, method = 'MM', model = TRUE, x = !control$compute.rd, y = FALSE, singular.ok = TRUE, contrasts = NULL, offset = NULL, control = NULL, init = NULL, ...) { ## to avoid problems with setting argument ## call lmrob.control here either with or without method arg. if (miss.ctrl <- missing(control)) control <- if (missing(method)) lmrob.control(...) else lmrob.control(method = method, ...) else if (length(list(...))) ## "sophisticated version" of chk.s(...) warning("arguments .. in ", sub(")$", "", sub("^list\\(", "", deparse(list(...), control = c()))), " are disregarded.\n", " Maybe use lmrob(*, control=lmrob.control(....) with all these.") ret.x <- x ret.y <- y cl <- match.call() mf <- match.call(expand.dots = FALSE) m <- match(c("formula", "data", "subset", "weights", "na.action", "offset"), names(mf), 0) mf <- mf[c(1, m)] mf$drop.unused.levels <- TRUE mf[[1]] <- as.name("model.frame") mf <- eval(mf, parent.frame()) mt <- attr(mf, "terms") # allow model.frame to update it y <- model.response(mf, "numeric") w <- as.vector(model.weights(mf)) if(!is.null(w) && !is.numeric(w)) stop("'weights' must be a numeric vector") offset <- as.vector(model.offset(mf)) if(!is.null(offset) && length(offset) != NROW(y)) stop(gettextf("number of offsets is %d, should equal %d (number of observations)", length(offset), NROW(y)), domain = NA) if (!miss.ctrl && !missing(method) && method != control$method) { warning("The 'method' argument is different from 'control$method'\n", "Using the former, method = ", method) control$method <- method } if (is.empty.model(mt)) { x <- NULL singular.fit <- FALSE ## to avoid problems below z <- list(coefficients = if(is.matrix(y)) matrix(NA_real_, 0, ncol(y)) else numeric(), residuals = y, scale = NA, fitted.values = 0 * y, cov = matrix(NA_real_,0,0), weights = w, rank = 0, df.residual = if(!is.null(w)) sum(w != 0) else NROW(y), converged = TRUE, iter = 0) if(!is.null(offset)) { z$fitted.values <- offset z$residuals <- y - offset z$offset <- offset } } else { x <- model.matrix(mt, mf, contrasts) contrasts <- attr(x, "contrasts") assign <- attr(x, "assign") p <- ncol(x) if(!is.null(offset)) y <- y - offset if (!is.null(w)) { ## checks and code copied/modified from lm.wfit ny <- NCOL(y) n <- nrow(x) if (NROW(y) != n | length(w) != n) stop("incompatible dimensions") if (any(w < 0 | is.na(w))) stop("missing or negative weights not allowed") zero.weights <- any(w == 0) if (zero.weights) { save.r <- y save.w <- w save.f <- y ok <- w != 0 nok <- !ok w <- w[ok] x0 <- x[nok, , drop = FALSE] x <- x[ ok, , drop = FALSE] n <- nrow(x) y0 <- if (ny > 1L) y[nok, , drop = FALSE] else y[nok] y <- if (ny > 1L) y[ ok, , drop = FALSE] else y[ok] ## add this information to model.frame as well ## need it in outlierStats() ## ?? could also add this to na.action, then ## naresid() would pad these as well. attr(mf, "zero.weights") <- which(nok) } wts <- sqrt(w) save.y <- y x <- wts * x y <- wts * y } ## check for singular fit if(getRversion() >= "3.1.0") { z0 <- .lm.fit(x, y, tol = control$solve.tol) piv <- z0$pivot } else { z0 <- lm.fit(x, y, tol = control$solve.tol) piv <- z0$qr$pivot } rankQR <- z0$rank singular.fit <- rankQR < p if (rankQR > 0) { if (singular.fit) { if (!singular.ok) stop("singular fit encountered") pivot <- piv p1 <- pivot[seq_len(rankQR)] p2 <- pivot[(rankQR+1):p] ## to avoid problems in the internal fitting methods, ## split into singular and non-singular matrices, ## can still re-add singular part later dn <- dimnames(x) x <- x[,p1] attr(x, "assign") <- assign[p1] ## needed for splitFrame to work } if (is.function(control$eps.x)) control$eps.x <- control$eps.x(max(abs(x))) if (!is.null(ini <- init)) { if (is.character(init)) { init <- switch(init, "M-S" = lmrob.M.S(x, y, control, mf=mf), "S" = lmrob.S (x, y, control), stop('init must be "S", "M-S", function or list')) if(ini == "M-S") { ## "M-S" sometimes reverts to "S": ini <- init$control$method ## if(identical(ini, "M-S")) ## control$method <- paste0(ini, control$method) } } else if (is.function(init)) { init <- init(x=x, y=y, control=control, mf=mf) } else if (is.list(init)) { ## MK: set init$weights, init$residuals here ?? ## (needed in lmrob..D..fit) ## or disallow method = D... ? would need to fix also ## lmrob.kappa: tuning.psi / tuning.chi choice if (singular.fit) { ## make sure the initial coefficients vector matches ## to the reduced x init$coef <- na.omit(init$coef) if (length(init$coef) != ncol(x)) stop("Length of initial coefficients vector does not match rank of singular design matrix x") } } else stop("unknown init argument") stopifnot(is.numeric(init$coef), is.numeric(init$scale)) ## modify (default) control$method, possibly dropping first letter: if (control$method == "MM" || substr(control$method, 1, 1) == "S") control$method <- substring(control$method, 2) ## check for control$cov argument if (class(init)[1] != "lmrob.S" && control$cov == '.vcov.avar1') control$cov <- ".vcov.w" } z <- lmrob.fit(x, y, control, init=init) #-> ./lmrob.MM.R ## --------- if(is.character(ini) && !grepl(paste0("^", ini), control$method)) control$method <- paste0(ini, control$method) if (singular.fit) { coef <- numeric(p) coef[p2] <- NA coef[p1] <- z$coefficients names(coef) <- dn[[2L]] z$coefficients <- coef ## Update QR decomposition (z$qr) ## pad qr and qraux with zeroes (columns that were pivoted to the right in z0) d.p <- p-rankQR n <- NROW(y) z$qr[c("qr","qraux","pivot")] <- list(matrix(c(z$qr$qr, rep.int(0, d.p*n)), n, p, dimnames = list(dn[[1L]], dn[[2L]][piv])), ## qraux: c(z$qr$qraux, rep.int(0, d.p)), ## pivot: piv) } } else { ## rank 0 z <- list(coefficients = if (is.matrix(y)) matrix(NA_real_,p,ncol(y)) else rep.int(NA_real_, p), residuals = y, scale = NA, fitted.values = 0 * y, cov = matrix(NA_real_,0,0), rweights = rep.int(NA_real_, NROW(y)), weights = w, rank = 0, df.residual = NROW(y), converged = TRUE, iter = 0, control=control) if (is.matrix(y)) colnames(z$coefficients) <- colnames(x) else names(z$coefficients) <- colnames(x) if(!is.null(offset)) z$residuals <- y - offset } if (!is.null(w)) { z$residuals <- z$residuals/wts z$fitted.values <- save.y - z$residuals z$weights <- w if (zero.weights) { # compute residuals, fitted, wts... also for the 0-weight obs coef <- z$coefficients coef[is.na(coef)] <- 0 f0 <- x0 %*% coef ## above ok := (w != 0); nok := (w == 0) if (ny > 1) { save.r[ok, ] <- z$residuals save.r[nok, ] <- y0 - f0 save.f[ok, ] <- z$fitted.values save.f[nok, ] <- f0 } else { save.r[ok] <- z$residuals save.r[nok] <- y0 - f0 save.f[ok] <- z$fitted.values save.f[nok] <- f0 } z$residuals <- save.r z$fitted.values <- save.f z$weights <- save.w rw <- z$rweights z$rweights <- rep.int(0, length(save.w)) z$rweights[ok] <- rw } } } if(!is.null(offset)) z$fitted.values <- z$fitted.values + offset z$na.action <- attr(mf, "na.action") z$offset <- offset z$contrasts <- contrasts z$xlevels <- .getXlevels(mt, mf) z$call <- cl z$terms <- mt z$assign <- assign if(control$compute.rd && !is.null(x)) z$MD <- robMD(x, attr(mt, "intercept"), wqr=z$qr) if (model) z$model <- mf if (ret.x) z$x <- if (singular.fit || (!is.null(w) && zero.weights)) model.matrix(mt, mf, contrasts) else x if (ret.y) z$y <- if (!is.null(w)) model.response(mf, "numeric") else y class(z) <- "lmrob" z } if(getRversion() < "3.1.0") globalVariables(".lm.fit") ##' @title Warn about extraneous arguments in the "..." (of its caller) ##' @return ##' @author Martin Maechler, June 2012 chk.s <- function(...) { if(length(list(...))) warning("arguments ", sub(")$", '', sub("^list\\(", '', deparse(list(...), control=c()))), " are disregarded in\n ", deparse(sys.call(-1), control=c()), call. = FALSE) } ##' Robust Mahalanobis Distances ##' internal function, used in lmrob() and plot.lmrob() ##' also "wanted" by 'robustloggamma' pkg robMD <- function(x, intercept, wqr, ...) { ## NB: 'wqr' only needed when covMcd() is not (entirely) successful if(intercept == 1) x <- x[, -1, drop=FALSE] if(ncol(x) >= 1) { rob <- tryCatch(covMcd(x, ...), warning = function(w) structure("covMcd produced a warning", class="try-error", condition = w), error = function(e) structure("covMcd failed with an error", class="try-error", condition = e)) if (inherits(rob, "try-error")) { warning("Failed to compute robust Mahalanobis distances, reverting to robust leverages.") .lmrob.hat(wqr = wqr) } else sqrt( mahalanobis(x, rob$center, rob$cov) ) } ## else NULL } ### Method Functions for class lmrob objects ### ### ---------------------------------------- ### ## Many are just wrapper functions for the respective .lm methods ## ---- sorted *ALPHABETICALLY* ---- alias.lmrob <- function(object, ...) { ## Purpose: provide alias() for lmrob objects ## Cannot use alias.lm directly, since it requires a "clean" object$qr, ## i.e., without the robustness weights if (is.null(x <- object[["x"]])) x <- model.matrix(object) weights <- weights(object) if (!is.null(weights) && diff(range(weights))) x <- x * sqrt(weights) object$qr <- qr(x) class(object) <- "lm" alias(object) } ## R (3.1.0)-devel copy of case.names.lm() ...../R/src/library/stats/R/lm.R case.names.lmrob <- function(object, full = FALSE, ...) { w <- weights(object) dn <- names(residuals(object)) if(full || is.null(w)) dn else dn[w!=0] } ## coef(): no own method ==> using coef.default(OO) == OO$coefficients ## ------------- ## use confint.lm instead of confint.default ## mainly to get t instead of normal quantiles ## Either imported from 'stats' or then copy-paste-defined in ./zzz.R : confint.lmrob <- confint.lm dummy.coef.lmrob <- dummy.coef.lm family.lmrob <- function(object, ...) gaussian() ## == stats:::family.lm ## fitted.default works for "lmrob" ## base::kappa.lm() is "doomed"; call what kappa.lm() has been calling for years: kappa.lmrob <- function(z, ...) kappa.qr(z$qr, ...) ## == kappa.lm(z, ...) ## instead of stats:::qr.lm() qrLmr <- function(x) { if(!is.list(r <- x$qr)) stop("lmrob object does not have a proper 'qr' component. Rank zero?") r } ## Basically the same as stats:::labels.lm -- FIXME: rank 0 fits? labels.lmrob <- function(object, ...) { tl <- attr(object$terms, "term.labels") asgn <- object$assign[qrLmr(object)$pivot[seq_len(object$rank)]] tl[unique(asgn)] } ## Works via lm's method [which is still exported]: model.matrix.lmrob <- model.matrix.lm ## identical to stats:::nobs.lm {but that is hidden .. and small to copy}: nobs.lmrob <- function(object, ...) if (!is.null(w <- object$weights)) sum(w != 0) else NROW(object$residuals) if(FALSE) ## now replaced with more sophsticated in ./lmrobPredict.R ## learned from MASS::rlm() : via "lm" as well predict.lmrob <- function (object, newdata = NULL, scale = NULL, ...) { class(object) <- c(class(object), "lm") object$qr <- qr(sqrt(object$rweights) * object$x) predict.lm(object, newdata = newdata, scale = object$s, ...) } print.summary.lmrob <- function (x, digits = max(3, getOption("digits") - 3), symbolic.cor = x$symbolic.cor, signif.stars = getOption("show.signif.stars"), showAlgo = TRUE, ...) { cat("\nCall:\n", paste(deparse(x$call, width.cutoff=72), sep = "\n", collapse = "\n"), "\n", sep = "") control <- lmrob.control.neededOnly(x$control) cat(" \\--> method = \"", control$method, '"\n', sep = "") ## else cat("\n") resid <- x$residuals df <- x$df rdf <- df[2L] cat(if (!is.null(x$weights) && diff(range(x$weights))) "Weighted ", "Residuals:\n", sep = "") if (rdf > 5L) { nam <- c("Min", "1Q", "Median", "3Q", "Max") rq <- if (NCOL(resid) > 1) structure(apply(t(resid), 1, quantile), dimnames = list(nam, dimnames(resid)[[2]])) else setNames(quantile(resid), nam) print(rq, digits = digits, ...) } else print(resid, digits = digits, ...) ## FIXME: need to catch rdf == 0? if( length(x$aliased) ) { if( !(x$converged) ) { if (x$scale == 0) { cat("\nExact fit detected\n\nCoefficients:\n") } else { cat("\nAlgorithm did not converge\n") if (control$method == "S") cat("\nCoefficients of the *initial* S-estimator:\n") else cat(sprintf("\nCoefficients of the %s-estimator:\n", control$method)) } printCoefmat(x$coef, digits = digits, signif.stars = signif.stars, ...) } else { if (nsingular <- df[3L] - df[1L]) cat("\nCoefficients: (", nsingular, " not defined because of singularities)\n", sep = "") else cat("\nCoefficients:\n") coefs <- x$coefficients if(!is.null(aliased <- x$aliased) && any(aliased)) { cn <- names(aliased) coefs <- matrix(NA, length(aliased), 4, dimnames=list(cn, colnames(coefs))) coefs[!aliased, ] <- x$coefficients } printCoefmat(coefs, digits = digits, signif.stars = signif.stars, na.print="NA", ...) cat("\nRobust residual standard error:", format(signif(x$scale, digits)),"\n") if(nzchar(mess <- naprint(x$na.action))) cat(" (",mess,")\n", sep = "") if(!is.null(x$r.squared) && x$df[1] != attr(x$terms, "intercept")) { cat("Multiple R-squared: ", formatC(x$r.squared, digits = digits)) cat(",\tAdjusted R-squared: ", formatC(x$adj.r.squared, digits = digits), "\n") } correl <- x$correlation if (!is.null(correl)) { p <- NCOL(correl) if (p > 1) { cat("\nCorrelation of Coefficients:\n") if (is.logical(symbolic.cor) && symbolic.cor) { print(symnum(correl), abbr.colnames = NULL) } else { correl <- format(round(correl, 2), nsmall = 2, digits = digits) correl[!lower.tri(correl)] <- "" print(correl[-1, -p, drop = FALSE], quote = FALSE) } } } cat("Convergence in", x$iter, "IRWLS iterations\n") } cat("\n") if (!is.null(rw <- x$rweights)) { if (any(zero.w <- x$weights == 0)) rw <- rw[!zero.w] eps.outlier <- if (is.function(EO <- control$eps.outlier)) EO(nobs(x)) else EO summarizeRobWeights(rw, digits = digits, eps = eps.outlier, ...) } } else cat("\nNo Coefficients\n") if (showAlgo && !is.null(control)) printControl(control, digits = digits, drop. = "method") invisible(x) } print.lmrob <- function(x, digits = max(3, getOption("digits") - 3), ...) { cat("\nCall:\n", cl <- deparse(x$call, width.cutoff=72), "\n", sep = "") control <- lmrob.control.neededOnly(x$control) if(!any(grepl("method *= *['\"]", cl)))## 'method = ".."' not explicitly visible above cat(" \\--> method = \"", control$method, '"\n', sep = "") else cat("\n") if(length((cf <- coef(x)))) { if( x$converged ) cat("Coefficients:\n") else { if (x$scale == 0) { cat("Exact fit detected\n\nCoefficients:\n") } else { cat("Algorithm did not converge\n\n") if (control$method == "S") cat("Coefficients of the *initial* S-estimator:\n") else cat(sprintf("Coefficients of the %s-estimator:\n", control$method)) } } print(format(cf, digits = digits), print.gap = 2, quote = FALSE) } else cat("No coefficients\n") cat("\n") invisible(x) } print.lmrob.S <- function(x, digits = max(3, getOption("digits") - 3), showAlgo = TRUE, ...) { cat("S-estimator lmrob.S():\n") if(length((cf <- coef(x)))) { if (x$converged) cat("Coefficients:\n") else if (x$scale == 0) cat("Exact fit detected\n\nCoefficients:\n") else cat("Algorithm did not converge\n\n") print(format(cf, digits = digits), print.gap = 2, quote = FALSE) } else cat("No coefficients\n") cat("scale = ",format(x$scale, digits=digits), "; ", if(x$converged)"converged" else "did NOT converge", " in ", x$k.iter, " refinement steps\n") if (showAlgo && !is.null(x$control)) printControl(x$control, digits = digits, drop. = "method") invisible(x) } ## practically identical to stats:::qr.lm : qr.lmrob <- function (x, ...) { if (is.null(r <- x$qr)) stop("lmrob object does not have a proper 'qr' component. Rank must be zero") r } residuals.lmrob <- function(object, ...) residuals.lm(object, ...) ## even simpler than residuals.default(): residuals.lmrob.S <- function(obj) obj$residuals summary.lmrob <- function(object, correlation = FALSE, symbolic.cor = FALSE, ...) { if (is.null(object$terms)) stop("invalid 'lmrob' object: no terms component") p <- object$rank df <- object$df.residual #was $degree.freedom sigma <- object[["scale"]] aliased <- is.na(coef(object)) cf.nms <- c("Estimate", "Std. Error", "t value", "Pr(>|t|)") if (p > 0) { n <- p + df p1 <- seq_len(p) se <- sqrt(if(length(object$cov) == 1L) object$cov else diag(object$cov)) est <- object$coefficients[object$qr$pivot[p1]] tval <- est/se ans <- object[c("call", "terms", "residuals", "scale", "rweights", "na.action", "converged", "iter", "control")] if (!is.null(ans$weights)) ans$residuals <- ans$residuals * sqrt(object$weights) ## 'df' vector, modeled after summary.lm() : ans$df <- c(p, rdf, NCOL(Qr$qr)) ## where p <- z$rank ; rdf <- z$df.residual ; Qr <- qr.lm(object) ans$df <- c(p, df, NCOL(object$qr$qr)) ans$coefficients <- if( ans$converged) cbind(est, se, tval, 2 * pt(abs(tval), df, lower.tail = FALSE)) else cbind(est, if(sigma <= 0) 0 else NA, NA, NA) dimnames(ans$coefficients) <- list(names(est), cf.nms) if (p != attr(ans$terms, "intercept")) { df.int <- if (attr(ans$terms, "intercept")) 1L else 0L ## This block is based on code by Olivier Renaud resid <- object$residuals pred <- object$fitted.values resp <- if (is.null(object[["y"]])) pred + resid else object$y wgt <- object$rweights ## scale.rob <- object$scale ## correction = E[wgt(r)] / E[psi'(r)] = E[wgt(r)] / E[r*psi(r)] ctrl <- object$control c.psi <- ctrl$tuning.psi psi <- ctrl$psi correc <- if (psi == 'ggw') { if (isTRUE(all.equal(c.psi, c(-.5, 1.0, 0.95, NA)))) 1.121708 else if (isTRUE(all.equal(c.psi, c(-.5, 1.5, 0.95, NA)))) 1.163192 else if (isTRUE(all.equal(c.psi, c(-.5, 1.0, 0.85, NA)))) 1.33517 else if (isTRUE(all.equal(c.psi, c(-.5, 1.5, 0.85, NA)))) 1.395828 else lmrob.E(wgt(r), ctrl) / lmrob.E(r*psi(r), ctrl) } else if (any(psi == .Mpsi.R.names) && isTRUE(all.equal(c.psi, .Mpsi.tuning.default(psi)))) { switch(psi, bisquare = 1.207617, welsh = 1.224617, # 1.2246131 optimal = 1.068939, hampel = 1.166891, lqq = 1.159232, stop('unsupported psi function -- should not happen')) } else lmrob.E(wgt(r), ctrl) / lmrob.E(r*psi(r), ctrl) resp.mean <- if (df.int == 1L) sum(wgt * resp)/sum(wgt) else 0 yMy <- sum(wgt * (resp - resp.mean)^2) rMr <- sum(wgt * resid^2) ans$r.squared <- r2correc <- (yMy - rMr) / (yMy + rMr * (correc - 1)) ans$adj.r.squared <- 1 - (1 - r2correc) * ((n - df.int) / df) } else ans$r.squared <- ans$adj.r.squared <- 0 ans$cov <- object$cov if(length(object$cov) > 1L) dimnames(ans$cov) <- dimnames(ans$coefficients)[c(1,1)] if (correlation) { ans$correlation <- ans$cov / outer(se, se) ans$symbolic.cor <- symbolic.cor } } else { ## p = 0: "null model" ans <- object ans$df <- c(0L, df, length(aliased)) ans$coefficients <- matrix(ans$coefficients[0L], 0L, 4L, dimnames = list(NULL, cf.nms)) ans$r.squared <- ans$adj.r.squared <- 0 ans$cov <- object$cov } ans$aliased <- aliased # used in print method ans$sigma <- sigma # 'sigma': in summary.lm() & 'fit.models' pkg if (is.function(ans$control$eps.outlier)) ans$control$eps.outlier <- ans$control$eps.outlier(nobs(object)) if (is.function(ans$control$eps.x)) ans$control$eps.x <- if(!is.null(o.x <- object[['x']])) ans$control$eps.x(max(abs(o.x))) ## else NULL structure(ans, class = "summary.lmrob") } ## R (3.1.0)-devel copy of variable.names.lm() ...../R/src/library/stats/R/lm.R variable.names.lmrob <- function(object, full = FALSE, ...) { if(full) dimnames(qrLmr(object)$qr)[[2L]] else if(object$rank) dimnames(qrLmr(object)$qr)[[2L]][seq_len(object$rank)] else character() } vcov.lmrob <- function (object, cov = object$control$cov, complete = TRUE, ...) { if(!is.null(object$cov) && (missing(cov) || identical(cov, object$control$cov))) .vcov.aliased(aliased = is.na(coef(object)), object$cov, complete= if(is.na(complete)) FALSE else complete) else { ## cov is typically = ".vcov.w" or ".vcov.avar1", but can be *any* user func. lf.cov <- if (!is.function(cov)) get(cov, mode = "function") else cov lf.cov(object, complete=complete, ...) } } sigma.lmrob <- function(object, ...) object$scale weights.lmrob <- function(object, type = c("prior", "robustness"), ...) { type <- match.arg(type) res <- if (type == "prior") { ## Issue warning only if called from toplevel. Otherwise the warning pop ## up at quite unexpected places, e.g., case.names(). if (is.null(object[["weights"]]) && identical(parent.frame(), .GlobalEnv)) warning("No weights defined for this object. Use type=\"robustness\" argument to get robustness weights.") object[["weights"]] } else object[["rweights"]] if (is.null(object$na.action)) res else naresid(object$na.action, res) } #### functions hidden in namespace #### printControl <- function(ctrl, digits = getOption("digits"), str.names = "seed", drop. = character(0), header = "Algorithmic parameters:", ...) { ## Purpose: nicely and sensibly print a 'control' structure ## currently for lmrob(), glmrob() ## Author: Martin Maechler, Date: 31 May 2006 PR <- function(LST, ...) if(length(LST)) print(unlist(LST), ...) cat(header,"\n") is.str <- (nc <- names(ctrl)) %in% str.names do. <- !is.str & !(nc %in% drop.) is.ch <- vapply(ctrl, is.character, NA) real.ctrl <- vapply(ctrl, function(x) length(x) > 0 && is.numeric(x) && any(x %% 1 != 0), NA) PR(ctrl[do. & real.ctrl], digits = digits, ...) ## non-real, non-char ones (typically integers), but dropping 0-length ones PR(ctrl[do. & !is.ch & !real.ctrl], ...) ## char ones PR(ctrl[do. & is.ch], ...) if(any(is.str)) for(n in nc[is.str]) { cat(n,":") str(ctrl[[n]], vec.len = 2) ## 'vec.len = 2' is smaller than normal, but nice for Mersenne seed } } summarizeRobWeights <- function(w, digits = getOption("digits"), header = "Robustness weights:", eps = 0.1 / length(w), eps1 = 1e-3, ...) { ## Purpose: nicely print a "summary" of robustness weights stopifnot(is.numeric(w)) cat(header,"\n") cat0 <- function(...) cat('', ...) n <- length(w) if(n <= 10) print(w, digits = digits, ...) else { n1 <- sum(w1 <- abs(w - 1) < eps1) n0 <- sum(w0 <- abs(w) < eps) if(any(w0 & w1)) warning("weights should not be both close to 0 and close to 1!\n", "You should use different 'eps' and/or 'eps1'") if(n0 > 0 || n1 > 0) { if(n0 > 0) { formE <- function(e) formatC(e, digits = max(2, digits-3), width=1) i0 <- which(w0) maxw <- max(w[w0]) c3 <- paste0("with |weight| ", if(maxw == 0) "= 0" else paste("<=", formE(maxw)), " ( < ", formE(eps), ");") cat0(if(n0 > 1) { cc <- sprintf("%d observations c(%s)", n0, strwrap(paste(i0, collapse=","))) c2 <- " are outliers" paste0(cc, if(nchar(cc)+ nchar(c2)+ nchar(c3) > getOption("width")) "\n ", c2) } else sprintf("observation %d is an outlier", i0), c3, "\n") } if(n1 > 0) cat0(ngettext(n1, "one weight is", sprintf("%s%d weights are", if(n1 == n)"All " else '', n1)), "~= 1.") n.rem <- n - n0 - n1 if(n.rem <= 0) { # < 0 possible if w0 & w1 overlap if(n1 > 0) cat("\n") return(invisible()) } cat0("The remaining", ngettext(n.rem, "one", sprintf("%d ones", n.rem)), "are") if(is.null(names(w))) names(w) <- as.character(seq(along = w)) w <- w[!w1 & !w0] if(n.rem <= 10) { cat("\n") print(w, digits = digits, ...) return(invisible()) } else cat(" summarized as\n") } print(summary(w, digits = digits), digits = digits, ...) } } robustbase/R/glmrobMqle-DQD.R0000644000176200001440000001276412150222661015465 0ustar liggesusers#### Quasi-Deviance Differences --- for Model Selection #### --------------------------------------------------- -> ./anova-glmrob.R ## MM: These function names are really too long ## but then, they are hidden in the name space ... ## (Maybe it would be nice to do this as one function with "family" .. ) glmrobMqleDiffQuasiDevB <- function(mu, mu0, y, ni, w.x, phi, tcc) { ## f.cnui <- function(u, y, ni, tcc) { pr <- u/ni Vmu <- pr * (1 - pr) ## = binomial()$variance residP <- (y-pr)*sqrt(ni/Vmu) ## First part: nui nui <- pmax.int(-tcc, pmin.int(tcc, residP)) ## Second part: Enui H <- floor(u - tcc*sqrt(ni*Vmu)) K <- floor(u + tcc*sqrt(ni*Vmu)) ## Actually, floor is not needed because pbinom() can cope ## with noninteger values in the argument q! ## what follows is similar to glmrob.Mqle.EpsiB except a ## different vectorisation h1 <- (if(ni == 1) as.numeric(- (H < 0) + (K >= 1) ) * sqrt(Vmu) else (pbinom(K-1,1,pr) - pbinom(H-1,ni-1,pr) - pbinom(K,ni,pr) + pbinom(H,ni,pr)) * pr * sqrt(ni/Vmu)) ## pmax was needed to get numeric returns from pbinom Enui <- (tcc*(1 - pbinom(K,ni,pr) - pbinom(H,ni,pr)) + h1) return((nui - Enui) / sqrt(ni*Vmu)) } ## f.cnui() nobs <- length(mu) stopifnot(nobs > 0) QMi <- numeric(nobs) ## Numerical integrations for(i in 1:nobs) QMi[i] <- integrate(f.cnui, y = y[i], ni = ni[i], tcc = tcc, subdivisions = 200, lower = mu[i]*ni[i], upper = mu0[i]*ni[i])$value ## robust quasi-deviance ## -2*(sum(QMi1)-sum(QMi2)) ## Andreas' interpretation of (4) and (5) ## -2*(sum(QMi1)-sum(QMi2)/nobs) ## Eva's interpretation of (4) and (5) ## According to Andreas' interpretation -2*sum(QMi*w.x) } ## glmrobMqleDiffQuasiDevB glmrobMqleDiffQuasiDevPois <- function(mu, mu0, y, ni, w.x, phi, tcc) { ## f.cnui <- function(u, y, ni, tcc) { Vmu <- u ## = poisson()$variance residP <- (y-u)/sqrt(Vmu) ## First part: nui nui <- pmax.int(-tcc, pmin.int(tcc, residP)) ## Second part: Enui H <- floor(u - tcc*sqrt(Vmu)) K <- floor(u + tcc*sqrt(Vmu)) ## what follows is similar to Epsipois except a ## different vectorisation h1 <- u/sqrt(Vmu)*(dpois(H,u)- dpois(K,u)) Enui <- tcc*(1 - ppois(K,u) - ppois(H,u)) + h1 return((nui - Enui) / sqrt(Vmu)) } nobs <- length(mu) stopifnot(nobs > 0) QMi <- numeric(nobs) ## Numerical integrations for(i in 1:nobs) QMi[i] <- integrate(f.cnui, y = y[i], ni = ni[i], tcc = tcc, lower = mu[i], upper = mu0[i])$value ## robust quasi-deviance ## -2*(sum(QMi1)-sum(QMi2)) ## Andreas' interpretation of (4) and (5) ## -2*(sum(QMi1)-sum(QMi2)/nobs) ## Eva's interpretation of (4) and (5) ## According to Andreas' interpretation -2*sum(QMi*w.x) }## glmrobMqleDiffQuasiDevPois glmrobMqleDiffQuasiDevGamma <- function(mu, mu0, y, ni, w.x, phi, tcc, variant = c("V1", "Eva1", "Andreas1")) { ## Notation similar to the discrete case (Cantoni & Ronchetti, 2001) f.cnui <- function(u, y, ni, phi, tcc) { s.ph <- sqrt(phi) ## First part: nui sV <- s.ph * u ## = sqrt(dispersion * Gamma()$variance) residP <- (y-u)/sV nui <- pmax.int(-tcc, pmin.int(tcc, residP)) ## Second part: Enui ## what follows is similar to glmrob.Mqle.Epsipois except a ## different vectorisation nu <- 1/phi ## form parameter nu snu <- 1/s.ph ## sqrt (nu) pPtmc <- pgamma(snu - tcc, shape=nu, rate=snu) pPtpc <- pgamma(snu + tcc, shape=nu, rate=snu) Enui <- tcc*(1-pPtpc-pPtmc) + Gmn(-tcc,nu) - Gmn( tcc,nu) ( nui/sV - Enui/u*s.ph ) } f.cnui1 <- function(u, y, ni, phi, tcc) { ## First part: nui sV <- sqrt(phi) * u ## = sqrt(dispersion * Gamma()$variance) residP <- (y-u)/sV nui <- pmax.int(-tcc, pmin.int(tcc, residP)) (nui / sV) } f.cnui2 <- function(u, y, ni, phi, tcc) { ## First part: nui s.ph <- sqrt(phi) sV <- s.ph * u ## = sqrt(dispersion * Gamma()$variance) snu <- 1/s.ph ## sqrt (nu) ## Second part: Enui ## what follows is similar to EpsiGamma except a ## different vectorisation nu <- 1/phi ## form parameter nu pPtmc <- pgamma(snu - tcc, shape=nu, rate=snu) pPtpc <- pgamma(snu + tcc, shape=nu, rate=snu) Enui <- tcc*(1-pPtpc-pPtmc) + Gmn(-tcc,nu) - Gmn( tcc,nu) return(Enui/u * s.ph) } nobs <- length(mu) stopifnot(nobs > 0) variant <- match.arg(variant) ## robust quasi-deviance if(variant == "V1") { QMi <- numeric(nobs) ## Numerical integrations for(i in 1:nobs) QMi[i] <- integrate(f.cnui, y = y[i], ni = ni[i], phi=phi, tcc = tcc, lower = mu[i], upper = mu0[i])$value -2*sum(QMi*w.x) } else { ## "Eva1" or "Andreas1"; Using two terms QMi1 <- QMi2 <- numeric(nobs) for(i in 1:nobs) QMi1[i] <- integrate(f.cnui1, y = y[i], ni = ni[i], phi=phi, tcc = tcc, lower = mu[i], upper = mu0[i])$value for(i in 1:nobs) QM2i[i] <- integrate(f.cnui2, y = y[i], ni = ni[i], phi=phi, tcc = tcc, lower = mu[i], upper = mu0[i])$value if(variant == "Eva1") { ## Eva Cantoni's interpretation of (4) and (5) -2*(sum(QMi1)-sum(QMi2)/nobs) } else if (variant == "Andreas1") { ## Andreas' interpretation of (4) and (5) -2*(sum(QMi1)-sum(QMi2)) } else stop("invalid 'variant': ", variant) } } robustbase/R/glmrobMqle.R0000644000176200001440000004264513325654420015067 0ustar liggesusers#### Mallows quasi-likelihood estimator of E. Cantoni and E. Ronchetti (2001) #### based originally on Eva Cantoni's S-plus code "robGLM" ## FIXME{MM}: All these expression()s and eval()s -- once were really slick and fast. ## ----- Nowadays, with 'codetools' and the byte-compiler, they "just don't fit anymore" ## including those globalVariables() {also in other places!}: globalVariables(c("residP", "residPS", "dmu.deta", "snu"), add=TRUE) ##' @title ##' @param wts a character string \dQuote{weights.on.x} specifying how weights should be computed ##' *or* a numeric vector of final weights in which case nothing is computed. ##' @param X n x p design matrix aka model.matrix() ##' @param intercept logical, if true, X[,] has an intercept column which should ##' not be used for rob.wts ##' @return n-vector of non-negative weights ##' @author Martin Maechler robXweights <- function(wts, X, intercept=TRUE) { stopifnot(length(d <- dim(X)) == 2, is.logical(intercept)) nobs <- d[1] if(d[2]) { ## X has >= 1 column, and hence there *are* coefficients in the end if(is.character(wts)){ switch(wts, "none" = rep.int(1, nobs), "hat" = wts_HiiDist(X)^2, # = (1 - Hii)^2 "robCov" = wts_RobDist(X, intercept, covFun = MASS::cov.rob), ## MCD is currently problematic: many singular subsamples "covMcd" = wts_RobDist(X, intercept, covFun = covMcd), stop("Weighting method", sQuote(wts), " is not implemented")) } ## (new; 2013-07-05; -> robustbase 0.9-9) else if(is.list(wts)) { if(length(wts) == 1 && is.function(covF <- wts[[1]])) wts_RobDist(X, intercept, covFun = covF) else stop("if a list, weights.on.x must contain a covariance function such as covMcd()") } else if(is.function(wts)) { wts(X, intercept) } else { if(!is.numeric(wts) || length(wts) != nobs) ## FIXME: "when not a string, a list, or a function, then ..." stop(gettextf("weights.on.x needs %d none-negative values", nobs), domain=NA) if(any(wts) < 0) stop("All weights.on.x must be none negative") } } else ## p = ncoef == 0 {maybe intercept, but that's not relevant here} rep.int(1,nobs) } ##' @param intercept logical, if true, X[,] has an intercept column which should ##' not be used for rob.wts glmrobMqle <- function(X, y, weights = NULL, start = NULL, offset = NULL, family, weights.on.x = "none", control = glmrobMqle.control(), intercept = TRUE, trace = FALSE) { ## To DO: ## o weights are not really implemented as *extra* user weights; rather as "glm-weights" ## o offset is not fully implemented (really? -- should have test case!) if(!is.matrix(X)) X <- as.matrix(X) ## never used: ## xnames <- dimnames(X)[[2]] ## ynames <- if (is.matrix(y)) rownames(y) else names(y) nobs <- NROW(y) stopifnot(nobs == nrow(X)) if (is.null(weights)) weights <- rep.int(1, nobs) else if(any(weights <= 0)) stop("All weights must be positive") if (is.null(offset)) offset <- rep.int(0, nobs) else if(!all(offset==0)) warning("'offset' not fully implemented") variance <- family$variance linkinv <- family$linkinv if (!is.function(variance) || !is.function(linkinv)) stop("illegal 'family' argument") mu.eta <- family$mu.eta if (is.null(valideta <- family$valideta)) valideta <- function(eta) TRUE if (is.null(validmu <- family$validmu)) validmu <- function(mu) TRUE ncoef <- ncol(X) w.x <- robXweights(weights.on.x, X=X, intercept=intercept) ### Initializations stopifnot(control$maxit >= 1, (tcc <- control$tcc) >= 0) ## note that etastart and mustart are used to make 'family$initialize' run etastart <- NULL; mustart <- NULL ## note that 'weights' are used and set by binomial()$initialize ! eval(family$initialize) ## --> n, mustart, y and weights (=ni) ni <- as.vector(weights)# dropping attributes for computation ## if(is.null(start)) start <- glm.fit(x = X, y = y, weights = weights, offset = offset, family = family)$coefficients if(any(ina <- is.na(start))) { cat("initial start 'theta' has NA's; eliminating columns X[, j];", "j = ", pasteK(which(ina)),"\n") theta.na <- start X <- X[, !ina, drop = FALSE] start <- glm.fit(x = X, y = y, weights = weights, offset = offset, family = family)$coefficients if(any(is.na(start))) stop("start 'theta' has still NA's .. badly singular x\n") ## FIXME ncoef <- length(start) } thetaOld <- theta <- as.vector(start) # as.v*(): dropping attributes eta <- as.vector(X %*% theta) mu <- linkinv(eta) # mu estimates pi (in [0,1]) at the binomial model if (!(validmu(mu) && valideta(eta))) stop("Cannot find valid starting values: You need help") ## switch(family$family, "binomial" = { Epsi.init <- EpsiBin.init Epsi <- EpsiBin EpsiS <- EpsiSBin Epsi2 <- Epsi2Bin phiEst <- phiEst.cl <- 1 }, "poisson" = { Epsi.init <- EpsiPois.init Epsi <- EpsiPois EpsiS <- EpsiSPois Epsi2 <- Epsi2Pois phiEst <- phiEst.cl <- expression({1}) }, "gaussian" = { Epsi.init <- EpsiGaussian.init Epsi <- EpsiGaussian EpsiS <- EpsiSGaussian Epsi2 <- Epsi2Gaussian phiEst.cl <- phiGaussianEst.cl phiEst <- phiGaussianEst }, "Gamma" = { ## added by ARu Epsi.init <- EpsiGamma.init Epsi <- EpsiGamma EpsiS <- EpsiSGamma Epsi2 <- Epsi2Gamma phiEst.cl <- phiGammaEst.cl phiEst <- phiGammaEst }, ## else stop(gettextf("family '%s' not yet implemented", family$family), domain=NA) ) sV <- NULL # FIXME workaround for codetools comp.V.resid <- expression({ Vmu <- variance(mu) if (any(is.na(Vmu))) stop("NAs in V(mu)") if (any(Vmu == 0)) stop("0s in V(mu)") sVF <- sqrt(Vmu) # square root of variance function residP <- (y - mu)* sni/sVF # Pearson residuals }) comp.scaling <- expression({ sV <- sVF * sqrt(phi) residPS <- residP/sqrt(phi) # scaled Pearson residuals }) comp.Epsi.init <- expression({ ## d mu / d eta : dmu.deta <- mu.eta(eta) if (any(is.na(dmu.deta))) stop("NAs in d(mu)/d(eta)") ## "Epsi init" : H <- floor(mu*ni - tcc* sni*sV) K <- floor(mu*ni + tcc* sni*sV) eval(Epsi.init) }) ### Iterations if(trace && ncoef) { cat("Initial theta: \n") local({names(theta) <- names(start); print(theta) }) digits <- max(1, getOption("digits") - 5) w.th.1 <- 6+digits # width of one number; need 8 for 2 digits: "-4.8e-11" width.th <- ncoef*(w.th.1 + 1) - 1 cat(sprintf("%3s | %*s | %12s\n", "it", width.th, "d{theta}", "rel.change")) mFormat <- function(x, wid) { r <- formatC(x, digits=digits, width=wid) sprintf("%*s", wid, sub("e([+-])0","e\\1", r)) } } sni <- sqrt(ni) eval(comp.V.resid) #-> (Vmu, sVF, residP) phi <- eval(phiEst.cl) ## Determine the range of phi values based on the distribution of |residP| Rphi <- c(1e-12, 3*median(abs(residP)))^2 conv <- FALSE if(ncoef) for (nit in 1:control$maxit) { eval(comp.scaling) #-> (sV, residPS) eval(comp.Epsi.init) ## Computation of alpha and (7) using matrix column means: cpsi <- pmax.int(-tcc, pmin.int(residPS,tcc)) - eval(Epsi) EEq <- colMeans(cpsi * w.x * sni/sV * dmu.deta * X) ## ## Solve 1/n (t(X) %*% B %*% X) %*% delta.coef = EEq DiagB <- eval(EpsiS) /(sni*sV) * w.x * (ni*dmu.deta)^2 if(any(n0 <- ni == 0)) DiagB[n0] <- 0 # instead of NaN Dtheta <- solve(crossprod(X, DiagB*X)/nobs, EEq) if (any(!is.finite(Dtheta))) { warning("Non-finite coefficients at iteration ", nit) break } theta <- thetaOld + Dtheta eta <- as.vector(X %*% theta) + offset mu <- linkinv(eta) ## estimation of the dispersion parameter eval(comp.V.resid) phi <- eval(phiEst) ## Check convergence: relative error < tolerance relE <- sqrt(sum(Dtheta^2)/max(1e-20, sum(thetaOld^2))) conv <- relE <= control$acc if(trace) { cat(sprintf("%3d | %*s | %12g\n", nit, width.th, paste(mFormat(Dtheta, w.th.1), collapse=" "), relE)) } if(conv) break thetaOld <- theta } ## end of iteration else { ## ncoef == 0 conv <- TRUE nit <- 0 } if (!conv) warning("Algorithm did not converge") eps <- 10 * .Machine$double.eps switch(family$family, "binomial" = { if (any(mu/weights > 1 - eps) || any(mu/weights < eps)) warning("fitted probabilities numerically 0 or 1 occurred") }, "poisson" = { if (any(mu < eps)) warning("fitted rates numerically 0 occurred") }) eval(comp.V.resid) #-> (Vmu, sVF, residP) eval(comp.scaling) #-> (sV, residPS) ## Estimated asymptotic covariance of the robust estimator if(ncoef) { eval(comp.Epsi.init) alpha <- colMeans(eval(Epsi) * w.x * sni/sV * dmu.deta * X) DiagA <- eval(Epsi2) / (ni*sV^2)* w.x^2* (ni*dmu.deta)^2 matQ <- crossprod(X, DiagA*X)/nobs - tcrossprod(alpha, alpha) DiagB <- eval(EpsiS) / (sni*sV)* w.x * (ni*dmu.deta)^2 if(any(n0 <- ni == 0)) DiagB[n0] <- 0 # instead of NaN matM <- crossprod(X, DiagB*X)/nobs matMinv <- solve(matM) asCov <- matMinv %*% matQ %*% matMinv / nobs } else { ## ncoef == 0 matM <- matQ <- asCov <- matrix(NA_real_, 0,0) } if(any(ina)) {# put NA's back, extending theta[] to "original length" ok <- !ina theta.na[ok] <- theta ; theta <- theta.na ## also extend the "p x p" matrices with NA's -- ##No : lm() and glm() also do *not* do this ##No p <- length(theta) ##No nm <- names(theta) ##No M <- matrix(NA_real_, p, p, dimnames = list(nm,nm)) ##No Mn <- M; Mn[ok, ok] <- asCov ; asCov <- Mn ##No Mn <- M; Mn[ok, ok] <- matM ; matM <- Mn ##No Mn <- M; Mn[ok, ok] <- matQ ; matQ <- Mn } w.r <- pmin(1, tcc/abs(residPS)) names(mu) <- names(eta) <- names(residPS) # re-add after computation list(coefficients = theta, residuals = residP, # s.resid = residPS, fitted.values = mu, w.r = w.r, w.x = w.x, ni = ni, dispersion = phi, cov = asCov, matM = matM, matQ = matQ, tcc = tcc, family = family, linear.predictors = eta, deviance = NULL, iter = nit, y = y, converged = conv) } ## NB: X is model.matrix() aka design matrix used; typically including an intercept wts_HiiDist <- function(X) { ## Hii := diag( tcrossprod( qr.Q(qr(X)) ) ) == rowSums( qr.Q(qr(X)) ^2 ) : x <- qr(X) Hii <- rowSums(qr.qy(x, diag(1, nrow = NROW(X), ncol = x$rank))^2) (1-Hii) } ##' Compute robustness weights depending on the design 'X' only, ##' using robust(ified) Mahalanobis distances. ##' This is an auxiliary function for robXweights() activated typically by ##' weights.on.x = "..." from regression functions ##' @title Compute Robust Weights based on Robustified Mahalanobis - Distances ##' @param X n x p numeric matrix ##' @param intercept logical; should be true iff X[,1] is a column with the intercept ##' @param covFun function for computing a \bold{robust} covariance matrix; ##' e.g., MASS::cov.rob(), or covMcd(). ##' @return n-vector of non-negative weights. ##' @author Martin Maechler wts_RobDist <- function(X, intercept, covFun) { D2 <- if(intercept) { ## X[,] has intercept column which should not be used for rob.wts X <- X[, -1, drop=FALSE] Xrc <- covFun(X) mahalanobis(X, center = Xrc$center, cov = Xrc$cov) } else { ## X[,] can be used directly if(!is.matrix(X)) X <- as.matrix(X) Xrc <- covFun(X) S <- Xrc$cov + tcrossprod(Xrc$center) mahalanobis(X, center = FALSE, cov = S) } p <- ncol(X) ## E[chi^2_p] = p 1/sqrt(1+ pmax.int(0, 8*(D2 - p)/sqrt(2*p))) } ## MM: 'acc' seems a misnomer to me, but it's inherited from MASS::rlm glmrobMqle.control <- function(acc = 1e-04, test.acc = "coef", maxit = 50, tcc = 1.345) { if (!is.numeric(acc) || acc <= 0) stop("value of acc must be > 0") if (test.acc != "coef") stop("Only 'test.acc = \"coef\"' is currently implemented") ## if (!(any(test.vec == c("coef", "resid")))) ## stop("invalid argument for test.acc") if (!is.numeric(maxit) || maxit <= 0) stop("maximum number of iterations must be > 0") if (!is.numeric(tcc) || tcc <= 0) stop("value of the tuning constant c (tcc) must be > 0") list(acc = acc, test.acc = test.acc, maxit = maxit, tcc = tcc) } ### ----------------- E[ f(psi ( X ) ) ] ------------------------------- ## MM: These are now expressions instead of functions ## since 'Epsi*' and 'Epsi2*' are *always* called together ## and 'EpsiS*' when called is always after the other two ## ==> do common computations only once in Epsi*.init ==> more efficient! ## ## FIXME(2): Some of these fail when Huber's "c", 'tcc' is = +Inf ## ----- --> ../../robGLM1/R/rglm.R ## FIXME: Do use a "robFamily", a *list* of functions ## ------ which all have the same environment ## ===> can get same efficiency as expressions, but better OOP ### --- Poisson -- family --- EpsiPois.init <- expression( { dpH <- dpois(H, mu); dpH1 <- dpois(H-1, mu) dpK <- dpois(K, mu); dpK1 <- dpois(K-1, mu) pHm1 <- ppois(H-1, mu) ; pH <- pHm1 + dpH # = ppois(H,*) pKm1 <- ppois(K-1, mu) ; pK <- pKm1 + dpK # = ppois(K,*) E2f <- mu*(dpH1 - dpH - dpK1 + dpK) + pKm1 - pHm1 }) EpsiPois <- expression( { tcc*(1 - pK - pH) + mu*(dpH - dpK)/sV }) Epsi2Pois <- expression( { ## Calculation of E(psi^2) for the diagonal elements of A in matrix Q: tcc^2 * (pH + 1 - pK) + E2f }) EpsiSPois <- expression( { ## Calculation of E(psi*s) for the diagonal elements of B in the ## expression matrix M = 1/n t(X) %*% B %*% X: tcc*(dpH + dpK) + E2f / sV }) ### --- Binomial -- family --- EpsiBin.init <- expression({ pK <- pbinom(K, ni, mu) pH <- pbinom(H, ni, mu) pKm1 <- pbinom(K-1, pmax.int(0, ni-1), mu) pHm1 <- pbinom(H-1, pmax.int(0, ni-1), mu) pKm2 <- pbinom(K-2, pmax.int(0, ni-2), mu) pHm2 <- pbinom(H-2, pmax.int(0, ni-2), mu) ## QlV = Q / V, where Q = Sum_j (j - mu_i)^2 * P[Y_i = j] ## i.e. Q = Sum_j j(j-1)* P[.] + ## (1- 2*mu_i) Sum_j j * P[.] + ## mu_i^2 Sum_j P[.] QlV <- mu/Vmu*(mu*ni*(pK-pH) + (1 - 2*mu*ni) * ifelse(ni == 1, (H <= 0)*(K >= 1), pKm1 - pHm1) + (ni - 1) * mu * ifelse(ni == 2, (H <= 1)*(K >= 2), pKm2 - pHm2)) }) EpsiBin <- expression( { tcc*(1 - pK - pH) + ifelse(ni == 1, (- (H < 0) + (K >= 1) ) * sV, (pKm1 - pHm1 - pK + pH) * mu * sni/sV) }) Epsi2Bin <- expression( { ## Calculation of E(psi^2) for the diagonal elements of A in matrix Q: tcc^2*(pH + 1 - pK) + QlV }) EpsiSBin <- expression( { ## Calculation of E(psi*s) for the diagonal elements of B in the ## expression matrix M = (X' B X)/n mu/Vmu*(tcc*(pH - ifelse(ni == 1, H >= 1, pHm1)) + tcc*(pK - ifelse(ni == 1, K > 0, pKm1))) + ifelse(ni == 0, 0, QlV / (sni*sV)) }) ### --- Gaussian -- family --- EpsiGaussian.init <- expression({ dc <- dnorm(tcc) pc <- pnorm(tcc) }) EpsiGaussian <- expression( 0 ) EpsiSGaussian <- expression( 2*pc-1 ) Epsi2Gaussian <- expression( 2*tcc^2*(1-pc)-2*tcc*dc+2*pc-1 ) phiGaussianEst.cl <- expression( { ## Classical estimation of the dispersion paramter phi = sigma^2 sum(((y - mu)/mu)^2)/(nobs - ncoef) }) phiGaussianEst <- expression( { sphi <- mad(residP, center=0)^2 }) ### --- Gamma -- family --- Gmn <- function(t, nu) { ## Gm corrresponds to G * nu^((nu-1)/2) / Gamma(nu) snu <- sqrt(nu) snut <- snu+t r <- numeric(length(snut)) ok <- snut > 0 r[ok] <- { nu <- nu[ok]; snu <- snu[ok]; snut <- snut[ok] exp((nu-1)/2*log(nu) - lgamma(nu) - snu*snut + nu*log(snut)) } r } EpsiGamma.init <- expression({ nu <- 1/phi ## form parameter nu snu <- 1/sqrt(phi) ## == sqrt (nu) pPtc <- pgamma(snu + c(-tcc,tcc), shape=nu, rate=snu) pMtc <- pPtc[1] pPtc <- pPtc[2] aux2 <- tcc*snu GLtcc <- Gmn(-tcc,nu) GUtcc <- Gmn( tcc,nu) }) EpsiGamma <- expression( tcc*(1-pPtc-pMtc) + GLtcc - GUtcc ) EpsiSGamma <- expression( ((GLtcc - GUtcc) + snu*(pPtc-pMtc))/mu ) Epsi2Gamma <- expression({ (tcc^2*(pMtc+1-pPtc) + (pPtc-pMtc) + (GLtcc*(1-aux2) - GUtcc*(1+aux2))/snu ) }) phiGammaEst.cl <- expression( { ## Classical moment estimation of the dispersion parameter phi sum(((y - mu)/mu)^2)/(nobs-ncoef) }) phiGammaEst <- expression( { ## robust estimation of the dispersion parameter by ## Huber's proposal 2 sphi <- uniroot(Huberprop2, interval=Rphi, ns.resid=residP, mu=mu, Vmu=Vmu, tcc=tcc)$root }) Huberprop2 <- function(phi, ns.resid, mu, Vmu, tcc) { eval(EpsiGamma.init) compEpsi2 <- eval(Epsi2Gamma) nobs <- length(mu) ## return h := sum(pmax.int(-tcc, pmin.int(ns.resid*snu, tcc))^2) - nobs*compEpsi2 } if(FALSE) ## no-eval version Huberprop2 <- function(phi, ns.resid, mu, Vmu, tcc) { nobs <- length(mu) nu <- 1/phi ## form parameter nu snu <- 1/sqrt(phi) ## sqrt (nu) pPtc <- pgamma(snu + c(-tcc,tcc), shape=nu, rate=snu) pMtc <- pPtc[1] pPtc <- pPtc[2] ts <- tcc*snu GLtcc <- Gmn(-tcc,nu) *(1-ts)/snu GUtcc <- Gmn( tcc,nu) *(1+ts)/snu ## compEpsi2 <- tcc^2 + (pPtc - pMtc)*(1-tcc^2) + GLtcc - GUtcc ## return h := sum(pmax.int(-tcc, pmin.int(ns.resid*snu, tcc))^2) - nobs*compEpsi2 } robustbase/R/mc.R0000644000176200001440000000626313325654361013365 0ustar liggesusers## Left Medcouple lmc <- function(x, na.rm = FALSE, ...) { -mc(x[x <= median(x, na.rm = na.rm)], na.rm = na.rm, ...) } ## Right Medcouple rmc <- function(x, na.rm = FALSE, ...) { mc(x[x >= median(x, na.rm = na.rm)], na.rm = na.rm, ...) } ## ## Generic function ## mc <- function (x, ...) ## UseMethod("mc") ## ## Default method (for numeric vectors): ## mc.default <- function(x, na.rm = FALSE, mc <- function(x, na.rm = FALSE, doReflect = (length(x) <= 100) , doScale = TRUE # <- chg default to 'FALSE' ? , eps1 = 1e-14, eps2 = 1e-15 # << new in 0.93-2 (2018-07..) , maxit = 100, trace.lev = 0 , full.result = FALSE ) { x <- as.numeric(x) ina <- is.na(x) if (na.rm) x <- x[!ina] else if (any(ina)) return(NA_real_) ## ==> x is NA-free from here on ## if(length(l.. <- list(...))) ## stop("In mc(): invalid argument(s) : ", ## paste(sQuote(names(l..)), collapse=","), call. = FALSE) rr <- mcComp(x, doReflect, doScale=doScale, eps1=eps1, eps2=eps2, maxit=maxit, trace.lev=trace.lev) if(!(conv1 <- rr[["converged"]]) | (doReflect && !(conv2 <- rr[["converged2"]]))) { stop("mc(): not 'converged' ", if(!conv1) paste("in", rr[["iter"]], "iterations"), if(doReflect && !conv2) paste(if(!conv1)" *and*", "'reflect part' in", rr[["iter2"]], "iterations")) } m <- if (doReflect) (rr[["medc"]] - rr[["medc2"]]) / 2 else rr[["medc"]] structure(m, mcComp = if(full.result) rr) } ## eps1 = 1e-13, eps2 = eps1 <==> original code which only had 'eps = 1e-13' ## hardcoded in C code. ## These defaults do *not* make sense here, but in mc(). ## However, currently they are used in ../tests/mc-etc.R mcComp <- function(x, doReflect, doScale, eps1, eps2, maxit = 1000, trace.lev = 1) { stopifnot(is.logical(doReflect), length(doReflect) == 1L, !is.na(doReflect), is.logical(doScale), length(doScale) == 1L, !is.na(doScale), is.1num(eps1), eps1 >= 0, is.1num(eps2), eps2 >= 0, length(maxit <- as.integer(maxit)) == 1, length(trace.lev <- as.integer(trace.lev)) == 1 ) ## Assumption [from caller, = mc()]: 'x' has no NAs (but can have +-Inf) x <- as.numeric(x) n <- as.integer(length(x)) eps <- as.double(c(eps1, eps2)) c.iter <- c(maxit, trace.lev) ## NAOK=TRUE: to allow +/- Inf to be passed ans <- .C(mc_C, x, n, eps = eps, iter = c.iter, medc = double(1) , doScale = doScale , NAOK=TRUE)[c("medc", "eps", "iter")] it <- ans[["iter"]] ans[["converged"]] <- it[2] == 1 ans[["iter"]] <- it[1] if (doReflect) { ## also compute on reflected data a2 <- .C(mc_C, -x, n, eps2 = eps, iter2 = c.iter, medc2 = double(1) , doScale = doScale , NAOK=TRUE)[c("medc2", "iter2", "doScale")] it <- a2[["iter2"]] a2[["converged2"]] <- it[2] == 1 a2[["iter2"]] <- it[1] c(ans, a2) } else ans } robustbase/R/biweight-funs.R0000644000176200001440000000446012420464132015524 0ustar liggesusers#### These Chi() and Psi() used to be called by lmrob() functions #### but no longer --> Have interface via .psi2ipsi() and .C(..) #### FIXME: integrate these with the psi-rho objects --> ./psi-rho-funs.R ## In the vignette ../vignettes/psi_functions.Rnw, we call this ## scaled \rho "\tilde{\rho}" ##- Maronna et al (2006) define their rho to be standardized ##- (only if possible <==> only if redescending psi !) ##- {TODO: *Where* in the Hampel_et_al book ??? } ## Hampel et al (1986): \chi(x) := \rho(x) / \rho(\infty) ## ====== ## <==> chi() is a scaled version of rho(.) such that ## \chi(\infty) = \max_x \chi(x) = 1 ## ==> Chi'() is just a scaled version of psi() : ## with current scale (new for psi()): ## i) Chi'(x, c) == (6/c^2) Psi(x,c) ## ==> ii) Chi''(x,c) == (6/c^2) Psi'(x,c) ## and Chi (x, c) == (6/c^2) Rho(x,c), where Psi(.) = Rho'(.) tukeyChi <- function(x, cc, deriv = 0) { .Deprecated("Mchi") x <- x / cc x2 <- x*x out <- x2 > 1 switch(deriv + 1, { ## deriv = 0 r <- x2*(3 + x2*(-3 + x2)) r[out] <- 1 }, { ## deriv = 1 r <- 6/cc * x * (1-x2)^2 r[out] <- 0 }, { ## deriv = 2 r <- 6/(cc^2) * (1 - x2) * (1 - 5*x2) r[out] <- 0 }, stop("deriv must be in {0,1,2}")) r } ## we call this '*Psi1' such as to not be confounded with ## the (future!) S4 object tukeyPsi() ! tukeyPsi1 <- function(x, cc, deriv = 0) { .Deprecated("Mpsi") ## This version of psi() is scaled such that psi'(0) = 1 x2 <- (x / cc)^2 if(deriv < 0) out <- x2 > 1 else in. <- x2 < 1 switch(deriv + 2, { ## deriv = -1 c. <- cc^2/6 r <- c.*(1 - (1- x2)^3) r[out] <- c. r }, { ## deriv = 0 in. * x * (1-x2)^2 }, { ## deriv = 1 in. * (1 - x2) * (1 - 5*x2) }, { ## deriv = 2 in. * 4*x/cc^2 * (5*x2 - 3) }, stop("deriv must be in {-1,0,1,2}")) } if(FALSE) tukeyPsi1Ex <- function (x, cc, deriv = 0) ## tukeyPsi1Ex <- function (x, cc = 4.685, deriv = 0) ## ^^^^^^^^^ { ## This version of psi() is scaled such that psi'(0) = 1 u <- pmin((x/cc)^2, 1) if(deriv < 0) return((1 - (1-u)^3)*cc^2/6) if(deriv == 0) return(x * (1 - u)^2) return((1 - u) * (1 - 5 * u)) } robustbase/R/covMcd.R0000644000176200001440000012226713175631765014212 0ustar liggesusers### This is originally from the R package #### #### rrcov : Scalable Robust Estimators with High Breakdown Point #### #### by Valentin Todorov ## I would like to thank Peter Rousseeuw and Katrien van Driessen for ## providing the initial code of this function. ## 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, a copy is available at ## http://www.r-project.org/Licenses/ ## No longer hidden in namespace : ## easier to explain when user-available & documented if h.alpha.n <- function(alpha, n, p) { ## Compute h(alpha) := size of subsample, given alpha, (n,p) ## Same function for covMcd() and ltsReg() n2 <- (n+p+1) %/% 2 floor(2 * n2 - n + 2 * (n - n2) * alpha) } ## MM: the way it's set up, *must* be kept in sync with rrcov.control()'s ## defaults --> ./rrcov.control.R : covMcd <- function(x, cor = FALSE, raw.only = FALSE, alpha = control$ alpha, nsamp = control$ nsamp, nmini = control$ nmini, kmini = control$ kmini, scalefn=control$scalefn, maxcsteps=control$maxcsteps, initHsets = NULL, save.hsets = FALSE, names = TRUE, seed = control$ seed, tolSolve = control$ tolSolve, # had 1e-10 hardwired {now 1e-14 default} trace = control$ trace, use.correction = control$ use.correction, wgtFUN = control$ wgtFUN, control = rrcov.control()) { logdet.Lrg <- 50 ## <-- FIXME add to rrcov.control() and then use that ## Analyze and validate the input parameters ... if(length(seed) > 0) { if(length(seed) < 3 || seed[1L] < 100) stop("invalid 'seed'. Must be compatible with .Random.seed !") if(exists(".Random.seed", envir=.GlobalEnv, inherits=FALSE)) { seed.keep <- get(".Random.seed", envir=.GlobalEnv, inherits=FALSE) on.exit(assign(".Random.seed", seed.keep, envir=.GlobalEnv)) } assign(".Random.seed", seed, envir=.GlobalEnv) } ## For back compatibility, as some new args did not exist pre 2013-04, ## and callers of covMcd() may use a "too small" 'control' list: defCtrl <- if(missing(control)) control else rrcov.control() if(missing(wgtFUN)) getDefCtrl("wgtFUN", defCtrl) if(is.null (nmini)) getDefCtrl("nmini", defCtrl) ## vt::03.02.2006 - added options "best" and "exact" for nsamp ## nsamp will be further analized in the wrapper .fastmcd() if(is.numeric(nsamp) && nsamp <= 0) stop("Invalid number of trials nsamp = ",nsamp, "!") if(is.data.frame(x)) x <- data.matrix(x, rownames.force=FALSE) else if (!is.matrix(x)) x <- matrix(x, length(x), 1, dimnames = if(names) list(names(x), deparse(substitute(x)))) if(!names) dimnames(x) <- NULL # (speedup) ## drop all rows with missing values (!!) : ok <- is.finite(x %*% rep.int(1, ncol(x))) x <- x[ok, , drop = FALSE] if(!length(dx <- dim(x))) stop("All observations have missing values!") n <- dx[1]; p <- dx[2] if(names) dimn <- dimnames(x) ## h(alpha) , the size of the subsamples h <- h.alpha.n(alpha, n, p) if(n <= p + 1) # ==> floor((n+p+1)/2) > n - 1 -- not Ok stop(if (n <= p) # absolute barrier! "n <= p -- you can't be serious!" else "n == p+1 is too small sample size for MCD") ## else if(n < 2 * p) { ## p+1 < n < 2p warning("n < 2 * p, i.e., possibly too small sample size") ## was stop("Need at least 2*(number of variables) observations ") } ## jmin <- (n + p + 1) %/% 2 ## if(alpha < 1/2) ## FIXME? shouldn't we rather test 'alpha < jmin/n' ? ## stop("The MCD must cover at least", jmin, "observations") ## MM: I think this should be sufficient; ## we should even omit the (n < 2p) warning if(h > n) stop("Sample size n < h(alpha; n,p) := size of \"good\" subsample") else if(2*h < n) warning("subsample size h < n/2 may be too small") if(is.character(wgtFUN)) { if(is.function(mkWfun <- .wgtFUN.covMcd[[wgtFUN]])) wgtFUN <- mkWfun(p=p, n=n, control) } if(!is.function(wgtFUN)) stop(gettextf("'wgtFUN' must be a function or one of the strings %s.", pasteK(paste0('"',names(.wgtFUN.covMcd),'"'))), domain=NA) ## vt::03.02.2006 - raw.cnp2 and cnp2 are vectors of size 2 and will ## contain the correction factors (concistency and finite sample) ## for the raw and reweighted estimates respectively. Set them ## initially to 1. If use.correction is false (not the default), ## the finite sample correction factor will not be used ## (neither for the raw estimates nor for the reweighted ones) raw.cnp2 <- cnp2 <- c(1,1) ans <- list(call = match.call(), nsamp = nsamp, method = sprintf("MCD(alpha=%g ==> h=%d)", alpha, h)) if(h == n) { ## <==> alpha ~= 1 : Just compute the classical estimates -------- mcd <- cov(x) #MM: was cov.wt(x)$cov loc <- as.vector(colMeans(x)) obj <- determinant(mcd, logarithm = TRUE)$modulus[1] if ( -obj/p > logdet.Lrg ) { ans$cov <- mcd if(names) dimnames(ans$cov) <- list(dimn[[2]], dimn[[2]]) if (cor) ans$cor <- cov2cor(ans$cov) ans$center <- loc if(names && length(dimn[[2]])) names(ans$center) <- dimn[[2]] ans$n.obs <- n ans$singularity <- list(kind = "classical") weights <- 1 } else { mah <- mahalanobis(x, loc, mcd, tol = tolSolve) ## VT:: 01.09.2004 - bug in alpha=1 weights <- wgtFUN(mah) # 0/1 sum.w <- sum(weights) ans <- c(ans, cov.wt(x, wt = weights, cor = cor)) ## cov.wt() -> list("cov", "center", "n.obs", ["wt", "cor"]) ## Consistency factor for reweighted MCD -- ok for default wgtFUN only: FIXME if(sum.w != n) { cnp2[1] <- .MCDcons(p, sum.w/n) ans$cov <- ans$cov * cnp2[1] } obj <- determinant(mcd, logarithm = TRUE)$modulus[1] if( -obj/p > logdet.Lrg ) { ans$singularity <- list(kind = "reweighted.MCD") } else { mah <- mahalanobis(x, ans$center, ans$cov, tol = tolSolve) weights <- wgtFUN(mah) # 0/1 } } ans$alpha <- alpha ans$quan <- h ans$raw.cov <- mcd ans$raw.center <- loc if(names && !is.null(nms <- dimn[[2]])) { names(ans$raw.center) <- nms dimnames(ans$raw.cov) <- list(nms,nms) } ans$crit <- obj # was exp(obj); but log-scale is "robust" against under/overflow ans$method <- paste(ans$method, "\nalpha = 1: The minimum covariance determinant estimates based on", n, "observations \nare equal to the classical estimates.") ans$mcd.wt <- rep.int(NA, length(ok)) ans$mcd.wt[ok] <- weights if(names && length(dimn[[1]])) names(ans$mcd.wt) <- dimn[[1]] ans$wt <- NULL ans$X <- x if(names) { if(length(dimn[[1]])) dimnames(ans$X)[[1]] <- names(ans$mcd.wt)[ok] else dimnames(ans$X) <- list(seq(along = ok)[ok], NULL) } if(trace) cat(ans$method, "\n") ans$raw.cnp2 <- raw.cnp2 ans$cnp2 <- cnp2 class(ans) <- "mcd" return(ans) } ## end { alpha = 1 <==> h = n } mcd <- if(nsamp == "deterministic") { ans$method <- paste("Deterministic", ans$method) .detmcd (x, h, hsets.init = initHsets, save.hsets=save.hsets, # full.h=full.h, scalefn=scalefn, maxcsteps=maxcsteps, trace=as.integer(trace), names=names) } else { ans$method <- paste0("Fast ", ans$method, "; nsamp = ", nsamp, "; (n,k)mini = (", nmini,",",kmini,")") .fastmcd(x, h, nsamp, nmini, kmini, trace=as.integer(trace)) } ## Compute the consistency correction factor for the raw MCD ## (see calfa in Croux and Haesbroeck) calpha <- .MCDcons(p, h/n) ## VT::19.3.2007 correct <- if(use.correction) .MCDcnp2(p, n, alpha) else 1. raw.cnp2 <- c(calpha, correct) if(p == 1) { ## ==> Compute univariate location and scale estimates ans$method <- paste("Univariate", ans$method) scale <- sqrt(calpha * correct) * as.double(mcd$initcovariance) center <- as.double(mcd$initmean) if(abs(scale - 0) < 1e-07) { ans$singularity <- list(kind = "identicalObs", q = h) ans$raw.cov <- ans$cov <- matrix(0) ans$raw.center <- ans$center <- center ans$n.obs <- n ans$alpha <- alpha ans$quan <- h if(names && !is.null(nms <- dimn[[2]][1])) { names(ans$raw.center) <- names(ans$center) <- nms dimnames(ans$raw.cov) <- dimnames(ans$cov) <- list(nms,nms) } ans$crit <- -Inf # = log(0) weights <- as.numeric(abs(x - center) < 1e-07) # 0 / 1 } ## end { scale ~= 0 } else { ## Compute the weights for the raw MCD in case p=1 weights <- wgtFUN(((x - center)/scale)^2) # 0/1 sum.w <- sum(weights) ans <- c(ans, cov.wt(x, wt = weights, cor=cor)) if(sum.w != n) { cdelta.rew <- .MCDcons(p, sum.w/n) ## VT::19.3.2007 correct.rew <- if(use.correction) .MCDcnp2.rew(p, n, alpha) else 1. cnp2 <- c(cdelta.rew, correct.rew) ans$cov <- cdelta.rew * correct.rew * ans$cov } ans$alpha <- alpha ans$quan <- h ans$raw.cov <- as.matrix(scale^2) ans$raw.center <- as.vector(center) if(names && !is.null(nms <- dimn[[2]][1])) { dimnames(ans$raw.cov) <- list(nms,nms) names(ans$raw.center) <- nms } ans$crit <- ## log(det) = log(sum(sort((x - as.double(mcd$initmean))^2, partial = h)[1:h])/max(1,h-1)) center <- ans$center scale <- as.vector(sqrt(ans$cov)) weights <- wgtFUN(((x - center)/scale)^2) } ## end{ scale > 0 } } ## end p=1 else { ## p >= 2 : --------------------------------------------------------- ## Apply correction factor to the raw estimates ## and use them to compute weights mcd$initcovariance <- matrix(calpha * correct * mcd$initcovariance, p,p) if(raw.only || mcd$exactfit != 0) { ## If not all observations are in general position, i.e. more than ## h observations lie on a hyperplane, the program still yields ## the MCD location and scatter matrix, the latter being singular ## (as it should be), as well as the equation of the hyperplane. dim(mcd$coeff) <- c(5, p) ans$cov <- ans$raw.cov <- mcd$initcovariance ans$center <- ans$raw.center <- as.vector(mcd$initmean) if(names && !is.null(nms <- dimn[[2]])) { dimnames(ans$cov) <- list(nms, nms) names(ans$center) <- nms } ans$n.obs <- n if(raw.only) { ans$raw.only <- TRUE } else { ## no longer relevant: ## if(mcd$exactfit == -1) ## stop("The program allows for at most ", mcd$kount, " observations.") ## if(mcd$exactfit == -2) ## stop("The program allows for at most ", mcd$kount, " variables.") if(!(mcd$exactfit %in% c(1,2,3))) stop("Unexpected 'exactfit' code ", mcd$exactfit, ". Please report!") ## new (2007-01) and *instead* of older long 'method' extension; ## the old message is still *printed* via .MCDsingularityMsg() ## ## exactfit is now *passed* to result instead of coded into 'message': ans$singularity <- list(kind = "on.hyperplane", exactCode = mcd$exactfit, p = p, h = h, count = mcd$kount, coeff = mcd$coeff[1,]) } ans$alpha <- alpha ans$quan <- h if(names && !is.null(nms <- dimn[[2]])) { names(ans$raw.center) <- nms dimnames(ans$raw.cov) <- list(nms,nms) } ans$crit <- -Inf # = log(0) weights <- mcd$weights } ## end (raw.only || exact fit) else { ## have general position (exactfit == 0) : ------------------------ ## FIXME? here, we assume that mcd$initcovariance is not singular: mah <- mahalanobis(x, mcd$initmean, mcd$initcovariance, tol = tolSolve) weights <- wgtFUN(mah) sum.w <- sum(weights) ans <- c(ans, cov.wt(x, wt = weights, cor=cor)) ## simple check for singularity, much cheaper than determinant() below: sing.rewt <- any(apply(ans$cov == 0, 2, all)) ## Compute and apply the consistency correction factor for ## the reweighted cov if(!sing.rewt && sum.w != n) { cdelta.rew <- .MCDcons(p, sum.w/n) ## VT::19.3.2007 correct.rew <- if(use.correction) .MCDcnp2.rew(p, n, alpha) else 1. cnp2 <- c(cdelta.rew, correct.rew) ans$cov <- cdelta.rew * correct.rew * ans$cov } ##vt:: add also the best found subsample to the result list ans$best <- sort(as.vector(mcd$best)) ans$alpha <- alpha ans$quan <- h ans$raw.cov <- mcd$initcovariance ans$raw.center <- as.vector(mcd$initmean) if(names && !is.null(nms <- dimn[[2]])) { names(ans$raw.center) <- nms dimnames(ans$raw.cov) <- list(nms,nms) } ans$raw.weights <- weights ans$crit <- mcd$mcdestimate # now in log scale! ## 'mah' already computed above ans$raw.mah <- mah ## mahalanobis(x, ans$raw.center, ans$raw.cov, tol = tolSolve) ## Check if the reweighted scatter matrix is singular. if(sing.rewt || - determinant(ans$cov, logarithm = TRUE)$modulus[1]/p > logdet.Lrg) { ans$singularity <- list(kind = paste0("reweighted.MCD", if(sing.rewt)"(zero col.)")) ans$mah <- mah } else { mah <- mahalanobis(x, ans$center, ans$cov, tol = tolSolve) ans$mah <- mah weights <- wgtFUN(mah) } } ## end{ not exact fit } } ## end{ p >= 2 } ans$mcd.wt <- rep.int(NA, length(ok)) ans$mcd.wt[ok] <- weights if(names) { if(length(dimn[[1]])) names(ans$mcd.wt) <- dimn[[1]] if(length(dimn[[1]])) dimnames(x)[[1]] <- names(ans$mcd.wt)[ok] else dimnames(x) <- list(seq(along = ok)[ok], NULL) } ans$X <- x ans$wt <- NULL if(trace) cat(ans$method, "\n") ans$raw.cnp2 <- raw.cnp2 ans$cnp2 <- cnp2 if(nsamp == "deterministic") ans <- c(ans, mcd[c("iBest","n.csteps", if(save.hsets) "initHsets")]) class(ans) <- "mcd" ## warn if we have a singularity: if(is.list(ans$singularity)) warning(paste(strwrap(.MCDsingularityMsg(ans$singularity, ans$n.obs)), collapse="\n"), domain=NA) ## return ans } ## {covMcd} smoothWgt <- function(x, c, h) { ## currently drops all attributes, dim(), names(), etc ## maybe add 'keep.attributes = FALSE' (and pass to C) .Call(R_wgt_flex, x, c, h) } ##' Martin Maechler's simple proposal for an *adaptive* cutoff ##' i.e., one which does *not* reject outliers in good samples asymptotically .MCDadaptWgt.c <- function(n,p) { eps <- 0.4 / n ^ 0.6 # => 1-eps(n=100) ~= 0.975; 1-eps(n=10) ~= 0.90 ## using upper tail: qchisq(eps, p, lower.tail=FALSE) } ## Default wgtFUN()s : .wgtFUN.covMcd <- list("01.original" = function(p, ...) { cMah <- qchisq(0.975, p) function(d) as.numeric(d < cMah) }, "01.flex" = function(p, n, control) { ## 'control$beta' instead of 0.975 ## FIXME: update rrcov.control() to accept 'beta' stopifnot(is.1num(beta <- control$beta), 0 <= beta, beta <= 1) cMah <- qchisq(beta, p) function(d) as.numeric(d < cMah) }, "01.adaptive" = function(p, n, ...) { ## 'beta_n' instead of 0.975 cMah <- .MCDadaptWgt.c(n,p) function(d) as.numeric(d < cMah) }, "sm1.orig" = function(p, n, ...) { cMah <- qchisq(0.975, p) function(d) smoothWgt(d, c = cMah, h = 1) }, "sm2.orig" = function(p, n, ...) { cMah <- qchisq(0.975, p) function(d) smoothWgt(d, c = cMah, h = 2) }, "sm1.adaptive" = function(p, n, ...) { cMah <- .MCDadaptWgt.c(n,p) function(d) smoothWgt(d, c = cMah, h = 1) }, "sm2.adaptive" = function(p, n, ...) { cMah <- .MCDadaptWgt.c(n,p) function(d) smoothWgt(d, c = cMah, h = 2) }, "smE.adaptive" = function(p, n, ...) { cMah <- .MCDadaptWgt.c(n,p) ## TODO: find "theory" for h = f(cMah), or better c=f1(n,p); h=f2(n,p) function(d) smoothWgt(d, c = cMah, h = max(2, cMah/4)) } ) .MCDsingularityMsg <- function(singList, n.obs) { stopifnot(is.list(singList)) switch(singList$kind, "classical" = { "The classical covariance matrix is singular." }, "reweighted.MCD" = { "The reweighted MCD scatter matrix is singular." }, "identicalObs" = { sprintf("Initial scale 0 because more than 'h' (=%d) observations are identical.", singList$q) }, "on.hyperplane" = { stopifnot(c("p", "count", "coeff") %in% names(singList)) obsMsg <- function(m, n) paste("There are", m, "observations (in the entire dataset of", n, "obs.)", "lying on the") invisible(obsMsg)# <- codetools with(singList, c(switch(exactCode, ## exactfit == 1 : "The covariance matrix of the data is singular.", ## exactfit == 2 : c("The covariance matrix has become singular during", "the iterations of the MCD algorithm."), ## exactfit == 3: paste0("The ", h, "-th order statistic of the absolute deviation of variable ", which(coeff == 1), " is zero.")), if(p == 2) { paste(obsMsg(count, n.obs), "line with equation ", signif(coeff[1], digits= 5), "(x_i1-m_1) +", signif(coeff[2], digits= 5), "(x_i2-m_2) = 0", "with (m_1,m_2) the mean of these observations.") } else if(p == 3) { paste(obsMsg(count, n.obs), "plane with equation ", signif(coeff[1], digits= 5), "(x_i1-m_1) +", signif(coeff[2], digits= 5), "(x_i2-m_2) +", signif(coeff[3], digits= 5), "(x_i3-m_3) = 0", "with (m_1,m_2) the mean of these observations." ) } else { ## p > 3 ----------- paste(obsMsg(count, n.obs), "hyperplane with equation ", "a_1*(x_i1 - m_1) + ... + a_p*(x_ip - m_p) = 0", "with (m_1, ..., m_p) the mean of these observations", "and coefficients a_i from the vector a <- ", paste(deparse(zapsmall(coeff)), collapse="\n ")) })) }, ## Otherwise stop("illegal 'singularity$kind'") ) ## end{switch} } nobs.mcd <- function (object, ...) object$n.obs print.mcd <- function(x, digits = max(3, getOption("digits") - 3), print.gap = 2, ...) { cat("Minimum Covariance Determinant (MCD) estimator approximation.\n", "Method: ", x$method, "\n", sep="") if(!is.null(cl <- x$call)) { cat("Call:\n") dput(cl) } if(is.list(x$singularity)) cat(strwrap(.MCDsingularityMsg(x$singularity, x$n.obs)), sep ="\n") if(identical(x$nsamp, "deterministic")) cat("iBest: ", pasteK(x$iBest), "; C-step iterations: ", pasteK(x$n.csteps), "\n", sep="") ## VT::29.03.2007 - solve a conflict with fastmcd() in package robust - ## also returning an object of class "mcd" xx <- NA if(!is.null(x$crit)) xx <- format(x$crit, digits = digits) else if (!is.null(x$raw.objective)) xx <- format(log(x$raw.objective), digits = digits) cat("Log(Det.): ", xx , "\n\nRobust Estimate of Location:\n") print(x$center, digits = digits, print.gap = print.gap, ...) cat("Robust Estimate of Covariance:\n") print(x$cov, digits = digits, print.gap = print.gap, ...) invisible(x) } summary.mcd <- function(object, ...) { class(object) <- c("summary.mcd", class(object)) object } print.summary.mcd <- function(x, digits = max(3, getOption("digits") - 3), print.gap = 2, ...) { print.mcd(x, digits = digits, print.gap = print.gap, ...) # see above ## hmm, maybe not *such* a good idea : if(!is.null(x$cor)) { cat("\nRobust Estimate of Correlation: \n") dimnames(x$cor) <- dimnames(x$cov) print(x$cor, digits = digits, print.gap = print.gap, ...) } cat("\nEigenvalues:\n") print(eigen(x$cov, only.values = TRUE)$values, digits = digits, ...) if(!is.null(x$mah)) { cat("\nRobust Distances: \n") print(summary(x$mah, digits = digits), digits = digits, ...) } if(!is.null(wt <- x$mcd.wt)) summarizeRobWeights(wt, digits = digits) invisible(x) } ## NOTE: plot.mcd() is in ./covPlot.R ! ## ---- ~~~~~~~~~~~ ### Consistency and Finite Sample Correction Factors ### .MCDcons() .MCDcnp2() & .MCDcnp2.rew() ### now exported and documented in ../man/covMcd.Rd ##' Compute the consistency correction factor for the MCD estimate ##' (see calfa in Croux and Haesbroeck) ##' @param p ##' @param alpha alpha ~= h/n = quan/n ##' also use for the reweighted MCD, calling with alpha = 'sum(weights)/n' MCDcons <- # <- *not* exported, but currently used in pkgs rrcov, rrcovNA .MCDcons <- function(p, alpha) { qalpha <- qchisq(alpha, p) caI <- pgamma(qalpha/2, p/2 + 1) / alpha 1/caI } MCDcnp2 <- # <- *not* exported, but currently used in pkg rrcovNA ##' Finite sample correction factor for raw MCD: .MCDcnp2 <- function(p, n, alpha) { stopifnot(0 <= alpha, alpha <= 1, length(alpha) == 1) if(p > 2) { ## "alfaq" "betaq" "qwaarden" coeffqpkwad875 <- matrix(c(-0.455179464070565, 1.11192541278794, 2, -0.294241208320834, 1.09649329149811, 3), ncol = 2) coeffqpkwad500 <- matrix(c(-1.42764571687802, 1.26263336932151, 2, -1.06141115981725, 1.28907991440387, 3), ncol = 2) y.500 <- log( - coeffqpkwad500[1, ] / p^coeffqpkwad500[2, ] ) y.875 <- log( - coeffqpkwad875[1, ] / p^coeffqpkwad875[2, ] ) A.500 <- cbind(1, - log(coeffqpkwad500[3, ] * p^2)) A.875 <- cbind(1, - log(coeffqpkwad875[3, ] * p^2)) coeffic.500 <- solve(A.500, y.500) coeffic.875 <- solve(A.875, y.875) fp.500.n <- 1 - exp(coeffic.500[1]) / n^coeffic.500[2] fp.875.n <- 1 - exp(coeffic.875[1]) / n^coeffic.875[2] } else if(p == 2) { fp.500.n <- 1 - exp( 0.673292623522027) / n^0.691365864961895 fp.875.n <- 1 - exp( 0.446537815635445) / n^1.06690782995919 } else if(p == 1) { fp.500.n <- 1 - exp( 0.262024211897096) / n^0.604756680630497 fp.875.n <- 1 - exp(-0.351584646688712) / n^1.01646567502486 } ## VT:18.04.2007 - use simulated correction factors for several p and n: ## p in [1, 20] n in [2*p, ...] if(alpha == 0.5 && !is.na(fp.x <- MCDcnp2s$sim.0(p, n))) fp.500.n <- 1/fp.x fp.alpha.n <- if(alpha <= 0.875) fp.500.n + (fp.875.n - fp.500.n)/0.375 * (alpha - 0.5) else ## 0.875 < alpha <= 1 fp.875.n + (1 - fp.875.n)/0.125 * (alpha - 0.875) 1/fp.alpha.n } ## end{.MCDcnp2 } MCDcnp2.rew <- # <- *not* exported, but currently used in pkg rrcovNA ##' Finite sample correction factor for *REW*eighted MCD .MCDcnp2.rew <- function(p, n, alpha) { stopifnot(0 <= alpha, alpha <= 1, length(alpha) == 1) if(p > 2) { ## "alfaq" "betaq" "qwaarden" coeffrewqpkwad875 <- matrix(c(-0.544482443573914, 1.25994483222292, 2, -0.343791072183285, 1.25159004257133, 3), ncol = 2) coeffrewqpkwad500 <- matrix(c(-1.02842572724793, 1.67659883081926, 2, -0.26800273450853, 1.35968562893582, 3), ncol = 2) y.500 <- log( - coeffrewqpkwad500[1, ] / p^ coeffrewqpkwad500[2, ] ) y.875 <- log( - coeffrewqpkwad875[1, ] / p^ coeffrewqpkwad875[2, ] ) A.500 <- cbind(1, - log(coeffrewqpkwad500[3, ] * p^2)) coeffic.500 <- solve(A.500, y.500) A.875 <- cbind(1, - log(coeffrewqpkwad875[3, ] * p^2)) coeffic.875 <- solve(A.875, y.875) fp.500.n <- 1 - exp(coeffic.500[1]) / n^ coeffic.500[2] fp.875.n <- 1 - exp(coeffic.875[1]) / n^ coeffic.875[2] } else if(p == 2) { fp.500.n <- 1 - exp( 3.11101712909049 ) / n^ 1.91401056721863 fp.875.n <- 1 - exp( 0.79473550581058 ) / n^ 1.10081930350091 } else if(p == 1) { fp.500.n <- 1 - exp( 1.11098143415027 ) / n^ 1.5182890270453 fp.875.n <- 1 - exp( -0.66046776772861) / n^ 0.88939595831888 } ## VT:18.04.2007 - use simulated correction factors for several p and n: ## p in [1, 20] n in [2*p, ...] if(alpha == 0.5 && !is.na(fp.x <- MCDcnp2s$sim.rew(p, n))) fp.500.n <- 1/fp.x fp.alpha.n <- if(alpha <= 0.875) fp.500.n + (fp.875.n - fp.500.n)/0.375 * (alpha - 0.5) else ## 0.875 < alpha <= 1 fp.875.n + (1 - fp.875.n)/0.125 * (alpha - 0.875) 1/fp.alpha.n } ## end{.MCDcnp2.rew } .fastmcd <- function(x, h, nsamp, nmini, kmini, trace = 0) { dx <- dim(x) n <- dx[1] p <- dx[2] ## parameters for partitioning {equal to those in Fortran !!} ## kmini <- 5 ## nmini <- 300 stopifnot(length(kmini <- as.integer(kmini)) == 1, kmini >= 2L, is.1num(nmini), is.finite(nmaxi <- as.double(nmini)*kmini), nmaxi * p < .Machine$integer.max) nmaxi <- as.integer(nmaxi) km10 <- 10*kmini ## vt::03.02.2006 - added options "best" and "exact" for nsamp ## nLarge <- 100000 # was 5000 before Nov.2009 -- keep forever now; user can say "exact" if(is.numeric(nsamp) && (nsamp < 0 || nsamp == 0 && p > 1)) { nsamp <- -1 } else if(nsamp == "exact" || nsamp == "best") { if(n > 2*nmini-1) { warning("Options 'best' and 'exact' not allowed for n greater than 2*nmini-1 =", 2*nmini-1,".\nUsing default.\n") nsamp <- -1 } else { myk <- p + 1 ## was 'p'; but p+1 ("nsel = nvar+1") is correct nall <- choose(n, myk) msg <- paste("subsets of size", myk, "out of", n) if(nall > nLarge && nsamp == "best") { nsamp <- nLarge warning("'nsamp = \"best\"' allows maximally ", format(nLarge, scientific=FALSE), " subsets;\ncomputing these ", msg, immediate. = TRUE) } else { ## "exact" or ("best" & nall < nLarge) nsamp <- 0 ## all subsamples -> special treatment in Fortran if(nall > nLarge) { msg <- paste("Computing all", nall, msg) if(nall > 10*nLarge) warning(msg, "\n This may take a", if(nall/nLarge > 100) " very", " long time!\n", immediate. = TRUE) else message(msg) } } } } if(!is.numeric(nsamp) || nsamp == -1) { # still not defined ## set it to the default : nsamp.def <- rrcov.control()$nsamp warning(gettextf("Invalid number of trials nsamp=%s. Using default nsamp=%d.", format(nsamp), nsamp.def), domain=NA) nsamp <- nsamp.def } if(nsamp > (mx <- .Machine$integer.max)) { warning("nsamp > i_max := maximal integer -- not allowed;\n", " set to i_max = ", mx) nsamp <- mx } ## Allocate temporary storage for the Fortran implementation, ## directly in the .Fortran() call. ## (if we used C + .Call() we would allocate all there, and be quite faster!) .Fortran(rffastmcd, x = if(is.double(x)) x else as.double(x), n = as.integer(n), p = as.integer(p), ## = 'nvar' in Fortran nhalff = as.integer(h), nsamp = as.integer(nsamp), # = 'krep' nmini = as.integer(nmini), kmini = kmini, initcovariance = double(p * p), initmean = double(p), best = rep.int(as.integer(10000), h), mcdestimate = double(1), ## = 'det' weights = integer(n), exactfit = integer(1), # output indicator: 0: ok; 1: ..., 2: .. coeff = matrix(double(5 * p), nrow = 5, ncol = p), ## plane kount = integer(1), adjustcov = double(p * p), ## used in ltsReg() ! ## integer(1), ## << 'seed' no longer used temp = integer(n), index1 = integer(n), index2 = integer(n), indexx = integer(n), nmahad = double(n), ndist = double(n), am = double(n), am2 = double(n), slutn = double(n), med = double(p), mad = double(p), sd = double(p), means = double(p), bmeans= double(p), w = double(p), fv1 = double(p), fv2 = double(p), rec = double(p+1), sscp1 = double((p+1)*(p+1)), cova1 = double(p * p), corr1 = double(p * p), cinv1 = double(p * p), cova2 = double(p * p), cinv2 = double(p * p), z = double(p * p), cstock = double(10 * p * p), # (10,nvmax2) mstock = double(10 * p), # (10,nvmax) c1stock = double(km10 * p * p), # (km10,nvmax2) m1stock = double(km10 * p), # (km10,nvmax) dath = double(nmaxi * p), # (nmaxi,nvmax) cutoff = qchisq(0.975, p), chimed = qchisq(0.5, p), i.trace= as.integer(trace) )[ ## keep the following ones: c("initcovariance", "initmean", "best", "mcdestimate", "weights", "exactfit", "coeff", "kount", "adjustcov") ] } ## ## VT:18.04.2007 - use simulated correction factors for several p and n ## and alpha = 1/2 (the default in rrcov.control()) ## ~~~~~~~~~~~ ## p in [1, 20] n in [2*p, ...] ## see the modifications in.MCDcnp2() and.MCDcnp2.rew ## ## VT::08.06.2007 - fixed the simulated values (especially for p=1) ## VT::11.05.2007 - reduce the usage of the simulated correction factors to only those that ## are definitvely wrong (negative or very large). This is done by: ## a) reducing p.max ## b) reducing n.max ## NB: In general, "wrong" are the factors for the reweighted matrix, but whenever a simulated ## value for the reweighted is used, the corresponding simulated must be used for the raw too. ## ## MM::2014-04 : MCDcnp2s <- local({ p.min <- 1L p.max <- 9L # was 20 ncol <- 20L # the number of column in the matrices n.min <- as.integer( ### p = 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 c(1, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30, 32, 34, 36, 38, 40)) n.max <- as.integer( c(2, 6, 10, 13, 16, 18, 20, 20, 20, 40, 42, 44, 46, 48, 50, 52, 54, 56, 58, 60)) ##was c(22, 24, 26, 28, 30, 32, 34, 36, 38, 40, 42, 44, 46, 48, 50, 52, 54, 56, 58, 60) ## these are the right (simulated) values for n.max n.min.rew <- n.min n.max.rew <- n.max m.0 <- matrix( c(1, 3.075819, 1.515999, 2.156169, 1.480742, 1.765485, 1.460206, 1.603707, 1.427429, 1.504712, 1.334528, 1.48297, 1.355308, 1.383867, 1.319241, 1.36065, 1.307467, 1.365596, 1.255259, 1.352741, 1.239381, 3.15342, 1.799889, 2.258497, 1.688312, 1.906779, 1.548203, 1.724785, 1.500873, 1.573442, 1.417137, 1.540805, 1.395945, 1.472596, 1.394247, 1.377487, 1.337394, 1.369354, 1.333378, 1.3181, 1.313813, 1.315528, 2.12777, 2.718898, 1.993509, 2.220433, 1.820585, 1.97782, 1.672455, 1.770151, 1.587478, 1.685352, 1.539295, 1.584536, 1.499487, 1.50702, 1.41952, 1.449058, 1.393042, 1.432999, 1.369964, 1.400997, 1.333824, 2.950549, 2.145387, 2.382224, 1.927077, 2.032489, 1.8371, 1.877833, 1.710891, 1.756053, 1.620778, 1.657761, 1.558978, 1.56257, 1.508633, 1.534406, 1.46709, 1.468734, 1.432529, 1.455283, 1.386975, 1.417532, 2.229573, 2.494447, 2.016117, 2.190061, 1.877996, 1.978964, 1.767284, 1.836948, 1.677372, 1.743316, 1.616383, 1.655964, 1.55484, 1.594831, 1.502185, 1.543723, 1.467005, 1.491123, 1.44402, 1.446915, 1.401578, 2.580264, 2.109121, 2.240741, 1.944719, 2.043397, 1.821808, 1.89725, 1.748788, 1.786988, 1.659333, 1.697012, 1.610622, 1.616503, 1.538529, 1.562024, 1.499964, 1.529344, 1.474519, 1.483264, 1.441552, 1.434448, 2.165233, 2.320281, 2.007836, 2.086471, 1.884052, 1.950563, 1.76926, 1.843328, 1.708941, 1.741039, 1.627206, 1.644755, 1.580563, 1.593402, 1.527312, 1.568418, 1.501462, 1.502542, 1.464583, 1.467921, 1.431141, 2.340443, 2.048262, 2.161097, 1.926082, 1.995422, 1.81446, 1.853165, 1.738533, 1.784456, 1.679444, 1.696463, 1.612931, 1.629483, 1.548186, 1.580026, 1.52198, 1.531111, 1.482914, 1.484824, 1.442726, 1.447838, 2.093386, 2.185793, 1.948989, 2.02804, 1.867137, 1.907732, 1.771923, 1.800413, 1.691612, 1.720603, 1.642705, 1.649769, 1.589028, 1.598955, 1.539759, 1.55096, 1.503965, 1.50703, 1.471349, 1.469791, 1.436959, 2.218315, 1.997369, 2.041128, 1.887059, 1.928524, 1.79626, 1.827538, 1.716748, 1.735696, 1.658329, 1.664211, 1.599286, 1.611511, 1.553925, 1.562637, 1.516805, 1.529894, 1.476064, 1.482474, 1.453253, 1.458467, 2.0247, 2.07899, 1.921976, 1.949376, 1.824629, 1.851671, 1.744713, 1.765647, 1.683525, 1.685592, 1.625113, 1.624961, 1.571921, 1.581223, 1.535257, 1.537464, 1.497165, 1.504879, 1.468682, 1.469319, 1.448344, 2.092315, 1.941412, 1.969843, 1.844093, 1.866133, 1.766145, 1.783829, 1.703613, 1.709714, 1.646078, 1.654264, 1.594523, 1.598488, 1.545105, 1.555356, 1.514627, 1.521353, 1.483958, 1.487677, 1.449191, 1.459721, 1.958987, 1.985144, 1.87739, 1.879643, 1.786823, 1.799642, 1.720015, 1.724688, 1.663539, 1.662997, 1.609267, 1.615124, 1.56746, 1.562026, 1.520586, 1.52503, 1.493008, 1.502496, 1.471983, 1.468546, 1.435064, 1.994706, 1.880348, 1.894254, 1.805827, 1.815965, 1.744296, 1.743389, 1.665481, 1.681644, 1.624466, 1.626109, 1.584028, 1.5818, 1.54376, 1.547237, 1.504878, 1.515087, 1.479032, 1.47936, 1.450758, 1.45073, 1.892685, 1.91087, 1.825301, 1.827176, 1.745363, 1.746115, 1.693373, 1.701692, 1.648247, 1.637112, 1.594648, 1.592013, 1.554849, 1.55013, 1.522186, 1.520901, 1.492606, 1.493072, 1.460868, 1.46733, 1.440956, 1.92771, 1.835696, 1.841979, 1.775991, 1.766092, 1.703807, 1.708791, 1.654985, 1.655917, 1.602388, 1.611867, 1.570765, 1.573368, 1.53419, 1.529033, 1.506767, 1.503596, 1.481126, 1.471806, 1.444917, 1.451682, 1.850262, 1.855034, 1.778997, 1.789995, 1.718871, 1.717326, 1.667357, 1.666291, 1.619743, 1.631475, 1.582624, 1.58766, 1.546302, 1.545063, 1.512222, 1.517888, 1.489127, 1.487271, 1.466722, 1.463618, 1.444137, 1.8709, 1.794033, 1.80121, 1.736376, 1.740201, 1.673776, 1.682541, 1.638153, 1.642294, 1.604417, 1.597721, 1.559534, 1.559108, 1.533942, 1.529348, 1.499517, 1.501586, 1.473147, 1.473031, 1.457615, 1.452348, 1.805753, 1.812952, 1.746549, 1.747222, 1.696924, 1.694957, 1.652157, 1.650568, 1.607807, 1.613666, 1.577295, 1.570712, 1.543704, 1.538272, 1.515369, 1.517113, 1.487451, 1.491593, 1.464514, 1.464658, 1.439359, 1.823222, 1.758781, 1.767358, 1.70872, 1.712926, 1.666956, 1.667838, 1.62077, 1.621445, 1.592891, 1.58549, 1.55603, 1.559042, 1.521501, 1.523342, 1.499913, 1.501937, 1.473359, 1.472522, 1.452613, 1.452448), ncol = ncol) m.rew <- matrix( c(1, 0.984724, 0.970109, 0.978037, 0.979202, 0.982933, 1.001461, 1.026651, 0.981233, 1.011895, 1.017499, 0.964323, 1.026574, 1.006594, 0.980194, 1.009828, 0.998083, 0.966173, 1.009942, 0.99916, 1.021521, 2.216302, 1.418526, 1.635601, 1.31402, 1.33975, 1.251798, 1.210917, 1.133114, 1.150666, 1.138732, 1.096822, 1.076489, 1.058343, 1.045746, 1.036743, 1.008929, 1.049537, 1.028148, 1.027297, 1.020578, 1.00074, 1.73511, 2.06681, 1.545905, 1.659655, 1.456835, 1.47809, 1.331966, 1.334229, 1.231218, 1.220443, 1.198143, 1.193965, 1.142156, 1.146231, 1.124661, 1.112719, 1.089973, 1.070606, 1.082681, 1.061243, 1.053191, 2.388892, 1.847626, 1.96998, 1.630723, 1.701272, 1.521008, 1.553057, 1.382168, 1.414555, 1.326982, 1.321403, 1.265207, 1.264856, 1.200418, 1.21152, 1.17531, 1.168536, 1.140586, 1.14457, 1.111392, 1.112031, 1.968153, 2.168931, 1.784373, 1.894409, 1.667912, 1.693007, 1.545176, 1.582428, 1.45319, 1.480559, 1.371611, 1.358541, 1.330235, 1.30264, 1.257518, 1.244156, 1.221907, 1.22455, 1.178965, 1.177855, 1.166319, 2.275891, 1.866587, 2.014249, 1.750567, 1.829363, 1.650019, 1.689043, 1.562539, 1.561359, 1.473378, 1.488554, 1.411097, 1.416527, 1.35117, 1.361044, 1.30205, 1.299037, 1.250265, 1.260083, 1.218665, 1.236027, 1.95771, 2.074066, 1.847385, 1.905408, 1.71393, 1.768425, 1.63908, 1.67234, 1.564992, 1.562337, 1.49229, 1.499573, 1.420813, 1.424067, 1.383947, 1.378726, 1.33062, 1.330071, 1.279404, 1.295302, 1.263947, 2.164121, 1.871024, 1.979485, 1.782417, 1.84489, 1.706023, 1.734857, 1.622782, 1.634869, 1.55196, 1.554423, 1.482325, 1.509195, 1.440726, 1.436328, 1.386335, 1.396277, 1.347939, 1.346732, 1.310242, 1.309371, 1.938822, 2.050409, 1.834863, 1.882536, 1.737494, 1.761608, 1.65742, 1.687579, 1.591863, 1.60158, 1.520982, 1.535234, 1.470649, 1.486485, 1.42892, 1.435574, 1.384132, 1.382329, 1.343281, 1.346581, 1.315111, 2.063894, 1.880094, 1.907246, 1.78278, 1.806648, 1.6952, 1.720922, 1.63084, 1.635274, 1.565423, 1.56171, 1.512015, 1.4986, 1.463903, 1.456588, 1.422856, 1.407325, 1.376724, 1.373923, 1.346464, 1.34259, 1.898389, 1.950406, 1.812053, 1.849175, 1.72649, 1.737651, 1.646719, 1.655112, 1.587601, 1.597894, 1.539877, 1.53329, 1.495054, 1.490548, 1.445249, 1.446037, 1.410272, 1.412274, 1.375797, 1.369604, 1.341232, 1.992488, 1.830452, 1.857314, 1.758686, 1.763822, 1.683215, 1.679543, 1.619269, 1.608512, 1.565, 1.562282, 1.498869, 1.51325, 1.470912, 1.464654, 1.427573, 1.439301, 1.402308, 1.391006, 1.37074, 1.367573, 1.855502, 1.891242, 1.77513, 1.790618, 1.706443, 1.713098, 1.642896, 1.636577, 1.580366, 1.581752, 1.542937, 1.531668, 1.487894, 1.492039, 1.460304, 1.449762, 1.4219, 1.420953, 1.390137, 1.388677, 1.360506, 1.908277, 1.802091, 1.806128, 1.723757, 1.727249, 1.659883, 1.670056, 1.605209, 1.611481, 1.558846, 1.551762, 1.512951, 1.511515, 1.468948, 1.476073, 1.441508, 1.434997, 1.412687, 1.406782, 1.380452, 1.375924, 1.811415, 1.822311, 1.740544, 1.739355, 1.68127, 1.685342, 1.620281, 1.622572, 1.579611, 1.570103, 1.529881, 1.530097, 1.490041, 1.4947, 1.457329, 1.456344, 1.423363, 1.428653, 1.399988, 1.390069, 1.376594, 1.837723, 1.76039, 1.771031, 1.697404, 1.690915, 1.634409, 1.63713, 1.589594, 1.586521, 1.552974, 1.545571, 1.505923, 1.512794, 1.477833, 1.477821, 1.444241, 1.44452, 1.419258, 1.421297, 1.394924, 1.389393, 1.779716, 1.781271, 1.706031, 1.71224, 1.655099, 1.654284, 1.608878, 1.605955, 1.565683, 1.565938, 1.523594, 1.531235, 1.492749, 1.486786, 1.457635, 1.461416, 1.432472, 1.430164, 1.404441, 1.400021, 1.378273, 1.798932, 1.735577, 1.727031, 1.671049, 1.677601, 1.624427, 1.617626, 1.579533, 1.579987, 1.544635, 1.538715, 1.504538, 1.50726, 1.477163, 1.477084, 1.450861, 1.444496, 1.428416, 1.422813, 1.400185, 1.39552, 1.750193, 1.752145, 1.690365, 1.692051, 1.642391, 1.63858, 1.600144, 1.596401, 1.558305, 1.555932, 1.525968, 1.522984, 1.491563, 1.492554, 1.467575, 1.45786, 1.437545, 1.430893, 1.413983, 1.409386, 1.391943, 1.762922, 1.701346, 1.704996, 1.6556, 1.655548, 1.611964, 1.615219, 1.569103, 1.571079, 1.540617, 1.541602, 1.503791, 1.50195, 1.478069, 1.47678, 1.452458, 1.451732, 1.429144, 1.426547, 1.40363, 1.402647), ncol = ncol) rm(ncol) list( sim.0 = function(p, n) { p. <- p - p.min + 1L if(p.min <= p && p <= p.max && n.min[p.] <= n && n <= n.max[p.]) { nind <- n - n.min[p.] + 1L m.0[nind, p.] ##= } else NA }, sim.rew = function(p, n) { p. <- p - p.min + 1L if(p.min <= p && p <= p.max && n.min.rew[p.] <= n && n <= n.max.rew[p.]) { nind <- n - n.min.rew[p.] + 1L m.rew[nind, p.] ##=== } else NA }) }) ## end{MCDcnp2s} if(FALSE) { ## For experimentation: ls.str( ee <- environment(MCDcnp2s$sim.0) ) matplot(1:21, ee$m.0, type = "o", xlab = "p - p.min + 1") } robustbase/R/glmrobPredict.R0000644000176200001440000000547712113111622015547 0ustar liggesusers# File .../glmrobPredict.R # Part of the R package 'robustbase', http://www.R-project.org # Based on predict.glm (cf. src/library/stats/R/) # # 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. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ # # Note that '# *rob' indicate adjustment for the robust case predict.glmrob <- function(object, newdata = NULL, type = c("link", "response", "terms"), se.fit = FALSE, dispersion = NULL, terms=NULL, na.action = na.pass, ...) { type <- match.arg(type) na.act <- object$na.action object$na.action <- NULL # kill this for predict.lm calls object$rweights <- object$w.r # *rob: used for predict.lmrob() if (!se.fit) { ## No standard errors if(missing(newdata)) { pred <- switch(type, link = object$linear.predictors, response = object$fitted.values, terms = predict.lmrob(object, se.fit=se.fit, scale = 1, type="terms", terms=terms, ...) # *rob ) if(!is.null(na.act)) pred <- napredict(na.act, pred) } else { pred <- predict.lmrob(object, newdata, se.fit, scale = 1, type = if(type=="link") "response" else type, terms = terms, na.action = na.action, ...) # *rob switch(type, response = {pred <- family(object)$linkinv(pred)}, link =, terms= ) } } else { ## summary.survreg has no ... argument. if(inherits(object, "survreg")) dispersion <- 1. if(is.null(dispersion) || dispersion == 0) dispersion <- summary(object, dispersion=dispersion)$dispersion residual.scale <- as.vector(sqrt(dispersion)) pred <- predict.lmrob(object, newdata, se.fit, scale = residual.scale, type = if(type=="link") "response" else type, terms = terms, na.action = na.action, ...) # *rob fit <- pred$fit se.fit <- pred$se.fit switch(type, response = { se.fit <- se.fit * abs(family(object)$mu.eta(fit)) fit <- family(object)$linkinv(fit) }, link =, terms=) if( missing(newdata) && !is.null(na.act) ) { fit <- napredict(na.act, fit) se.fit <- napredict(na.act, se.fit) } pred <- list(fit=fit, se.fit=se.fit, residual.scale=residual.scale) } pred } robustbase/R/AAA.R0000644000176200001440000001211613170446321013333 0ustar liggesusers ## if(getRversion() < "2.13") { ## nobs <- function (object, ...) UseMethod("nobs") ## ## also used for mlm fits *and* lmrob : ## nobs.lm <- function(object, ...) ## if(!is.null(w <- object$weights)) sum(w != 0) else NROW(object$residuals) ## ## for glmrob : ## nobs.glm <- function(object, ...) sum(!is.na(object$residuals)) ## } ## Here and in NAMESPACE: if(getRversion() < "3.1.0") { ## cut'n'paste from R's source src/library/stats/R/confint.R format.perc <- function(probs, digits) ## Not yet exported, maybe useful in other contexts: ## quantile.default() sometimes uses a version of it paste(format(100 * probs, trim = TRUE, scientific = FALSE, digits = digits), "%") confint.lm <- function(object, parm, level = 0.95, ...) { cf <- coef(object) pnames <- names(cf) if(missing(parm)) parm <- pnames else if(is.numeric(parm)) parm <- pnames[parm] a <- (1 - level)/2 a <- c(a, 1 - a) fac <- qt(a, object$df.residual) # difference from default method pct <- format.perc(a, 3) ci <- array(NA, dim = c(length(parm), 2L), dimnames = list(parm, pct)) ses <- sqrt(diag(vcov(object)))[parm] # gives NA for aliased parms ci[] <- cf[parm] + ses %o% fac ci } ## cut'n'paste from R's source src/library/stats/R/dummy.coef.R dummy.coef.lm <- function(object, use.na=FALSE, ...) { Terms <- terms(object) tl <- attr(Terms, "term.labels") int <- attr(Terms, "intercept") facs <- attr(Terms, "factors")[-1, , drop=FALSE] Terms <- delete.response(Terms) vars <- all.vars(Terms) xl <- object$xlevels if(!length(xl)) { # no factors in model return(as.list(coef(object))) } nxl <- setNames(rep.int(1, length(vars)), vars) tmp <- unlist(lapply(xl, length)) ## ?? vapply(xl, length, 1L) nxl[names(tmp)] <- tmp lterms <- apply(facs, 2L, function(x) prod(nxl[x > 0])) nl <- sum(lterms) args <- setNames(vector("list", length(vars)), vars) for(i in vars) args[[i]] <- if(nxl[[i]] == 1) rep.int(1, nl) else factor(rep.int(xl[[i]][1L], nl), levels = xl[[i]]) dummy <- do.call("data.frame", args) pos <- 0 rn <- rep.int(tl, lterms) rnn <- rep.int("", nl) for(j in tl) { i <- vars[facs[, j] > 0] ifac <- i[nxl[i] > 1] if(length(ifac) == 0L) { # quantitative factor rnn[pos+1] <- j } else if(length(ifac) == 1L) { # main effect dummy[ pos+1L:lterms[j], ifac ] <- xl[[ifac]] rnn[ pos+1L:lterms[j] ] <- as.character(xl[[ifac]]) } else { # interaction tmp <- expand.grid(xl[ifac]) dummy[ pos+1L:lterms[j], ifac ] <- tmp rnn[ pos+1L:lterms[j] ] <- apply(as.matrix(tmp), 1L, function(x) paste(x, collapse=":")) } pos <- pos + lterms[j] } ## some terms like poly(x,1) will give problems here, so allow ## NaNs and set to NA afterwards. mf <- model.frame(Terms, dummy, na.action=function(x)x, xlev=xl) mm <- model.matrix(Terms, mf, object$contrasts, xl) if(any(is.na(mm))) { warning("some terms will have NAs due to the limits of the method") mm[is.na(mm)] <- NA } coef <- object$coefficients if(!use.na) coef[is.na(coef)] <- 0 asgn <- attr(mm,"assign") res <- setNames(vector("list", length(tl)), tl) for(j in seq_along(tl)) { keep <- asgn == j ij <- rn == tl[j] res[[j]] <- setNames(drop(mm[ij, keep, drop=FALSE] %*% coef[keep]), rnn[ij]) } if(int > 0) { res <- c(list("(Intercept)" = coef[int]), res) } class(res) <- "dummy_coef" res } }# if R <= 3.1.0 ## Not exported, and only used because CRAN checks must be faster doExtras <- function() { interactive() || nzchar(Sys.getenv("R_robustbase_check_extra")) || identical("true", unname(Sys.getenv("R_PKG_CHECKING_doExtras"))) } if(getRversion() < "3.5") { isTRUE <- function(x) is.logical(x) && length(x) == 1L && !is.na(x) && x isFALSE <- function(x) is.logical(x) && length(x) == 1L && !is.na(x) && !x if(getRversion() < "3.3") { sigma <- function(object, ...) UseMethod("sigma") ## For completeness, and when comparing with nlrob() results: sigma.nls <- function(object, ...) ## sqrt ( sum( R_i ^ 2) / (n - p) ) : sqrt( deviance(object) / (nobs(object) - length(coef(object))) ) } } ## shortcut -- used often in print() etc: pasteK <- function(...) paste(..., collapse = ", ") ## stopifnot(..) helper : is.1num <- function(x) is.numeric(x) && length(x) == 1L ##' return 'x' unless it is NULL where you'd use 'orElse' `%||%` <- function(x, orElse) if(!is.null(x)) x else orElse ##' Augment a vcov-matrix by NA rows & cols when needed; from */R/src/library/stats/R/vcov.R .vcov.aliased <- asNamespace("stats")$.vcov.aliased %||% function(aliased, vc, complete = TRUE) { ## Checking for "NA coef": "same" code as in print.summary.lm() in ./lm.R : if(complete && nrow(vc) < (P <- length(aliased)) && any(aliased)) { ## add NA rows and columns in vcov cn <- names(aliased) VC <- matrix(NA_real_, P, P, dimnames = list(cn,cn)) j <- which(!aliased) VC[j,j] <- vc VC } else # default vc } robustbase/vignettes/0000755000176200001440000000000013465050200014426 5ustar liggesusersrobustbase/vignettes/plot-fig-sdAdB2-1.pdf0000644000176200001440000007102313465050117020047 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180743) /ModDate (D:20190509180743) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 24825 /Filter /FlateDecode >> stream x}K&Inݾ~] ؎g/d[% }g0y[3Zte0 # >o-w_c?O~?k0ۯS<[xO\(ŧcķX g8FaP9{ .@uAG˦[? uOs={W\$+WkIBawş^|JSueĺ.)/s֪b} ~0S>']Tx5ע帞kb`<q1W'I/_?VnY~lkMz@%ts(A=w{,rc=ոI _?}}#s@ׇz}_{9R<5=ޮ>=k@\;> h/~Z'v|WTdM[{D ȥ:'* 輬?}6kizÜMΦ^=Śyի׋Mb!yY}q Ѝ֍c򩋣$Ww2Q6- WH!mސBzMEZ/k4קSGnB绾< y]W]H Hx{]׷qnZyWoC.z_׾SPʁ񹥷, m, pK1{tU"W֥SFY_$i8U^9 "WO^7[ߘJ 84Bwㇽ.ijʪV< ׾ebàt\jە$]^r@.Ŝ}M/= ^kk (VKqQIۃ\p i;ZyGZ5y%_D!$v}֫1%Aڼk[ <w*h.CpƲ|7QJBZ@uuUJ<ƯUu\O Zܵ{x.vYKtwl|#|iw=K=}uלz?~${=iյ(Aj{&( C}#~ov{s_=ΰ\vt),kq,W/?g3LJf B_ Thƭ\0 -^__w=kE9^Z XHo1\Fx%{I|jνeS`~ے'ne]ݽ[Om/t{il_MbI_۰j905߄6,g^/K8,b^=.$ d~Od6~ӯp]F^ߺ/[_3~;Ư* iĝ]FSLAf)VDۜq= &Ǟs*(;OuF_o^&tK ԋ#7.ЮH[6 s|}Jd Q, J_ )WZBۯrM[x WxȥO<t y ML kψ:ۅpK9".WcŰFYx 6>M42 8֎n+|(7!#oU 2GgZJ"l&9b ^Ը\6RXmYh]\r?6 Q &me|ĴPfFnCAxGFIln!h܏ y+|De= {sS2Xpua"]E>,Q:/#o~(*S&&P᭹cf\;EƐ1$ZTSGXpD8XiA"L\1Z@E]Ӧ3H]Lh܏ 1+!VI4i:Vxh Z@X veB㭐_ Mnr?L $r=ԭ]W"r=צ\FQ:1!]\_ro4BwcxP]o0jؕ1v&dJvml@UYo1ҕG!85T,CmĢ.Ug#JnRh mD fq@0fRyY_lGXO^8 D|XO) ᒆŽzI:`K;>c#j~D;RtAcG"5DZ@8Rh087 ^glDx +LkI_ US~%.6+M1 r3&<[k`+S>˿bzm|O bԐIbEmGxd7P4bg?^mw>y+87)9M'lʥ[~nzz:E!#^' s Ɂ@pEp`-׆{w5[`')Wo)R%Uo)((AKZy($!Y}ڈ:6"g\+mDΩXHt^'c=|Fф E{=<؂FT:zi[kQQOY#f9P|8b#f]`q?q\#7S;tOY;Va`4dL֋B2"^-*ehWy[] yˈxH Z/6bw1XQgusl࠶cf#mTěM'#UO쁶S:Y\wsy`΁A:B>x׉~(_בY r髉)W^POW|^p%<)W݊>OY3&-I%sK (&͇M/ga\ ΡZؤS'큠E\&_"'\s0'w< tW^Wr%Ԏer };8Es~x\3 d}css/usw0o|-r?WxOc9VCpV!GtPFDH[58we*U=~20فl;ݿ]+3EHv+WZEO EtOuT>,_BBqʧvSzWlwESy=8e}.x.xe5]B~LrI ww/`!W`~Jc%ƱJc%Ɵp%~w -7$X-OSVo +vHL>عvtr\b-nSg øGs( ơ|XW+̇wX+ɼKl%YkVˌ7|6-GZ@gqmy7qn!hO^ q-f2Pڝ@m7MHi&jg97 ^g = =0 =tWغ+lG `-S' '*pH%d '* 똚#^s td0=yzX\+dCW kZ\[mD___-mu>l#曍xxۈGlܛm#SG @#cy<,oMn-7x ֲ yRmgi|CȻ7so-~2f\LNuΏPMxȥOI+N ueB'@̠TZBKhz i# 9 i[;pTW ;paa*%2h߶ed҅5s=S'mD݂fլh5hȝ`#COiϵ)td mz˸ۈe=[' wB71f5ܬوٟGr؝} Z/|竟yަs#mti|}>y~pQ<_X+3=)듑JȮhwE}To'_eX@ʗv_HXSS'KY]pD\0Z9dk`!hOGؖѥ[{vHSp}ZFLdܖ5fܶiZ,V+ܖ+|9+ܶVDW ۈ]z_mmFmm>WnJtJrJ3vgjݔjڍYV+ eJe|gr폘Phhbk04Wa8\Zu%aHN!F KVɗ]__9ٷt}r՚嵢&oB| Q'Wh܅S kwgdF@:p Ndy=MXXEW@ Q"&'DjUV, 4pL^U{$ޒ~{kDZk:1hL6яK-i%ThGC'y.X rLbRaA9J4d/ 2  /P_uP_PYwS2}ؓldDCF[ 2ųCp ؀ ?پkj<:)mhFpmuq++ Ij3zjr.p^VHZAO- (z7^Ici=.xD7As *hFAl\\^2.uG Λ?[]4Bl֦>!r-߆}n/I }b~;>^4oPꕀ6ô^ #bHAL^nPп8qCF.MZIK c.ũ JHGQN%y^FێN pȼ.|.yvbQ#; 'ǚj8Ҵ6}) H c#E\$km3+C.z?Dlvb` Tg[BNObE )s&OUk5' V#}.05eN TX3$YEƑvFSSH~ 9"`m ڙ0n;!R9NygCNs!`Cw$zF"kXc:ho,AS$uO1Wi}q}!ؐHp Ѹi4Fck©QJ[#;.5JC=֗hu}sfcJ1BZAX N^@tQ+׸3uN`U9Y?kV/vSIPXUt(W'tC>i઀SXoh+:}]\v.]^ ݮx˔r_e殠^A"w4j/tFG .E\F`^5֠89~rstB߭4v-]׭un5ojWѴo+KVqtt rkZ˼ UDj7Wss:^{FVsiKhFV*-^Uҝ^u>7k7U#`liz/ݒ[>Qݶ޾k!صv5%R`m=4z-;ڵ#z׮>Ц蒇[^oƸ湵Fco{kHؽ^x׀$z>>iEV]}ܴ zO5gm.w}*S$T.-ѿ+nF[GY|9~[ouvo۝;oNo|eIvqOY48sfG=[Q&m锟LJ{.풵[V-],Rv]*4ԝe/eEKTA;>[od8%K]n%੎kT]:/{ Dk܆<ϡx!>XcD09SA|Ṯ=Bp?+g ً6[RK .NY;{r49*]w]z Ca8Ψsj.k'9~v s)N^;:+!R;LG1áo[_Tq*jX }={0?m&isjNEM@ \U;(X:U}Z>,*Vǜ))i1DkǑbDK6-H<#Pz;&RC+Wʼ \vܝSq/]eԯܝ_qKC*DiMUԹ2(﹄!g"}W}2vyַS޷o}q]8!߃+)3b"&E-6wBT#ϜQ?x`KSF,`H+ZGj[f:w(%#ZIcw.(xȕݪ離Vi8c.E(P["D;"QE^;Oc.P(1+T<\d]#,=ۘvIqOڎ\,"Ed:v%~F7: 6`FD*F;}QݰZݘsG78=e]rgo ɭStPPفSFZdZb!z*vm}k{p6.\.N@龶Fr[|'ݤs>x9r[!>N %k&dtz׵4y]J ;WXފ6OY3PQ+!!F}ԶVO@b:P[y5Rf<4jV&>VZe@aì!R x }@^66N6jM9'*yYW*_tw)&UXNߍG.˛ 4u%Z\-ړ B{ĸ髶nӷ׭[_Mdƹ7έ|XB h5GR!0# t kS]N\j~J J]7*r}I밃a%gӡ @@SYѩ4s>wXR%P}5?2q$1Ju-(Tq=)9}ֹԷέoNx7;}7N|n|o|jWWJ*WWH:oNs9`={N{Cv5jw1C^l}g;vz2o}s=w{_{ޕIJā7)Nc?c;P~[.I̠iS~yq=< &s7uY} Ԣ V~N_IS]*ݫ^}WAkkHgp )40i?Č HSȀ2)@,5K<2 z9Y.uu,ևqWP[[#Qb%VZѵ.QXtN|⽲$`9~v&{?0hR v&o} el |Z6}vK ⨯7}W5[֗ڨQ<{u&6s@`۩ FV{ :.PS)xY4ZM<)qD˟1cmq48(r97mte0KސvIMb[H\N6ѿ+?|rFR0/[+q=Kvۀ_:\> 8hd x/{;}ހlbsYvYi8du&7*="6+q=x?Ͷ GcE_c#`rY0W@API{0ܑYj ĆT*bCj!UnHF̴,]@sҁWʐp{p>֎S:Ъ a=_\|1A鶮m$e VLx֬E=[ϴv$)eJYsz HUqkXF鼬9RH+VXJdy⹌Njv0p<m)w, N 7}78}M-Nrӷ8}!߃UyUxcPZ28,i%307 ^'=|~C0~,;lCnfdHwj:~0m()Mx$$WMej$=, 'K٧ދ7S` 7}[2h:/pԷo2}{ G}k:{0mUgURl)PIB",)TkziY ;*i )y[A=;3r?vH*FYS8;Uȯ)i5lj%mޅ{:xZ/shbNƌ&KRD<,5Ji,@#e.ϊ`b.ũ B{.mF-]ck]CuЃZwꛜn&o:{2hoH5 f 1Z!VLYHwYmf!(93mM5|ڑ!9NXM|Ɔ50 9ҹt7^yB>4h֛ zef؁%<`n$9k7; s@~0" _ WxՔ60ҵHhJ=4ލ67 ^F`$QZͥrV*X'YoNXj'W\g_gQ[ el_6j* |:ME2DÌ%s)Nehe=g&j)F}G* m#o [֘7C'uW'yu&oB0_wIs5c6v:bͯ_6XoKuW:7pOCR4$Ѥh{E-K#&MoOq꥝P˔3#cs>cM)W$u=@R $u)N,͒W\S\Vfk39dWu e|+U[В241Tq=xGJ[&u5w$#zp榠ѿyde&m{ ʐ{,^O, Al%/&dWDa[ `[AO R+Ħ8Ai|U'M-֐&o}@g($4QbO/w2(#C [>]bcyXUtGo z=8baKؖB7- aeXKj>'dh;ωsgׂhOU3f0Mm !):|󭴞]&Ŋe#Ʉ'8y[#8RāNp 45Xg uge-ʤ4N3&S!ۜosv<] -qTwo|zF< b#>Woĉ׭7i>Tڐ_,j5!)h܏us@qDfLq0$怢I<Hs1ܩ!Wsq5||ɪU9Oު'Q<_2>_R`*p*CK舘:TN}*-=;}G}CrQiH,G}C;~B=/ܒ\7.[l2ò,/Xch~Ml?TmdeRK):j< _Ф~]^PU^N3`F|7 ;>vz?=:gGB5(i>K>7;YV^В/W( +2C +P=Ӯ_l+>hꄶ+jWh}`(^Q^+>Z7ԮldWTM~+* E㊡NeB`ź]qE:C㊬슬-V+b]g|>- u:3ϧEY͞>wFGvd#oYvwI+WLy ﻤP]j` R=/.nR94˵ 9L~z hoPˆ_}=Jjnzp9HΠ*Mum-&/Ǭ ^O=lt 9"y=鞃K#Z@YoMX__X+X+kcsZ}~\WRֻ@x=hrՀy*S7v=Z($!đzy . J,\- _j  <وDH$DbOxH Z/k r|SL@3y7byꪝHd KލxZ/k<:~-S5Iy ~lᥨ*jH&B :7^+ibe#w0[f(u%^u!-.G6Rte@ue;Ň <=k=u8;ϑt$%㔴n9K,FPs6"Izy&X 'td8H܂FB@|.lHy՝޻w}BCRzy&FJ* HS?@; E,'F @ )y7ICYTZ] ZNҲ&^n*Ԭk S5 վstn!)hO'ZgN?cHX 5uPgNi-ҡ]3Bl1܏'ۈ|GP .B ߋOJcP<JKY. Gm}+A67 ^'mU}hgVPhLgE- Z@m[]XVr`cyr=AGY+W뻜_ J#;2F+a936'Ht-[ C.z}&f&MԻ iߩMtO ,h#C>8|D0uuyd (WvtF!!l56rg٢wQ%+l >h c ugXZ4pzؠeXZ, Ld\U.(xͅr|]BLk,G3YīߞkHefDwa& <|.Ǭ1둏ُ|.S#jSd|nr?X3ޱvݴ;9/Qˆ\&Ez6O0xZ/w3mPMf_Hfa,js@~>o_ز9m/Bn[{][˟7nqW.C.=~4;f"\*c,xFd@X]JLyS[5or?t'*M?FQw)sgbH'Y~Y!-hOc 7pX*CBX MQnjBac*tDr?Ysl$kfV9LA|"eHZ@w65A3,;0s>^'1Ke'i♄4E-RZJPݹ)bx;C.z> qRNTcB> x2$-XE8V++C!$d>?dz˔H\DWz3.'҄VZ4J@~]&yg!sg!i oo]&Bg!pB$rH٢@8W"HŤii7JeX6ix+WxH Z/1iHZ5/4vtF!!^#;do J>wuVQg^'c`H_Ϥ򕤴þxՔ_,5[o 3mn!hcE1"1if^Y v6 P@d!N! qh2OբG!hc-˲ 8&H,gצX ;=Aыs^ T!hO'Vk?Ae|AБ <1A hX)6ZЦC.zO\zD":fhijH;̣KmKWCT撶hHܪ3xZ/qQؤ8\u AJሸތ6iA67Ki䩆<;3إB|̜|>fM>v>f+Q3&s%|nr?$[gh V:(^i$iUU ]D5IZd lշ$:`&M& VjL1(vM~$j I 7νGGbA +VYc[YvP:5;,7qV˛8GqMGk!UwvݨWxBovzPUުƔpI[4XJZ3V4+ɚ<,,bC.zEcU?>%ˣtDcڭbVy,bc%c^'mQ}yXVr[AuBΊ'iDXԜďFphQTIZ/Ī6Mv;)hJ$}m]|rhn$wie : 7; tt0]c |`5nr?Zps bf]6#x U!}nDرz;SݶT܎;bv;|= }춣u,Ugr?YFd*tDϸv#ثr)!wۖoe|qFZ@*p$i^!h.OdqY\$Tϕ>&z4MV#AMm$iu;|`TorHw> "5-ohgW@I&$C/B\Y`2e~W'v&v739-)5&]VTF/G>/؁Ȭ|RڭT+=}=oҦ{olˡXc=/뽞|0_j{k!uwk -~/zG:]1ၟh͸]+>G9XIWh}E]1K]1u/h>EbWS+, Y&+>Hzt_LQzFx7X>\~/}z ذ߾%B5zNy4TG8DÞy r:oc4guxv}lpwmp vh Π=pZ ĶcFWc?5[}#v}3)?菟@NL4$Xe֋~M v?Тbص^D=y9y?Оo {z@kvy+'#|3c<_M)9G-OAkgfy!@1Tfbjc%|1RiՆaY8 G^"CbVҙ#Z,lh] āk̤bi]3.f^_ь7Ny Fy]$>y}F|]w&^^m·CA^u .v!Cq/^_ixK]yvS5ŶxC{mH"+7u$tw3#!uk|Wp{sORFmwQ;)uXx7'ns'ָ&{Q xKC|lGM֮q&{sj, ~(a9[Ю4֛qsz9]+%p @{ޏ"'׋ZZʻhv!lSbƒ뭯`# w#<hxJՋc<?\zEűw dȢPp!Tb][= g ))1uH]?iHj 94PX;uS1;c)-YtNSWu;%Ω٧TU(fhb]Prl9Ui@d}0ގ#v ՞*+_%tE)}swtN ,XR4=B` Oe*0A8`N;iU@}ˬX瀼)H3)VNN jG ,5>xiQe=Vee(>yAߎ+xAWҸr-zĜ4s>xiǭ|)NTVʧ/)oDGǔu\8o)_)kKnok+a~+eV@3gDi YE\~+F @.Ki'\?b$+eB Ua$zQ"ӊ('VQ:/듥_c?<]p24_4[ݭ6|kugxvүc}X|D~X|D}XqxXq*@ICC@!j(Gz9RhEmfs@~xDRq&K J7P;;VOM-/ԴƣOo1œor?XZEֶγUGDg#y#U>":UL J-6MK,6앐VaD*~%J+^VB7x[2or?y1[if8=m!:AÙKF J,m.\LB>D<#Z=:OiIH@MX,,~b>bC.z<ζdጚu-o舚8YgaN.*E- eC.z<&s%rnxӴ:׀#YvM%dm97 ^Kh1 /pf3R+t D! en]@ʜĪ4s>XM?)]5wR* xHpuw_$*o.6[{w PkOΝt t`٬tj_YYU5Vs>^qS4|jNnR;Z|N=ޔےcX:hP5po'`J3nMn{ .]zQMt^= ZYyVzrz:PXUt*w{Ni ^X9O!ooyAVdEwa :+lb^'-n CD Jo  o>>D m]rUx?g jޑSum9e[kJƹH,3)rԞE1w17 ^'-Pxzϸm=mb~k#Y6{7C.z6\~؃^yY8>t~NV[ђ@N<h*+ѣ_JX{ [ l߱=`Kӽ[Wb6Wb6~49WDe,T"G ; #9 25G9CR=~lXR܉H)h'(*-Dol[ݴI#)%Bŭ~eo}\hN!6 $-f-&9RiT%  <ɂgyDܭI6JWqӯDӯD7|&VVaZNKNsNrQMsʹZٟZډ, ,38e}27"N蕏^xW>zW9Wy]oO&K~l{:чSH)y+ɪGG*s+I:' C+%f@)~,@!'ek9ïk=oEx`OHo:I`Ym#-Kx-2NZ@i[Z2đe@al"KoVs\ r b96[tA(j┴$d-NKZB"*ɼŮ~ $u[pԽ]˂Y._HFWrUzlNY[;eKSGr[Vyt|+߼+7|;e}\yw;ˆV㤹PHsϕi.(-#QFz&f;ˑsQsj 7Vڏmٻ0Os@io]vٟNBvI{hclnul$KsɼHyDrVCZ삷K[^7Mb'xJW"F1W"F9ͯDmGgn7LbLCN=& B>uxM#-ݰt僶iJn֣sfKb\$FF4Z7xh Z@HrhlEþ]vI <$.uo{HR7Խ.uo5vc>w-uo'1"-'1#qIhm%j*{I=+DM7MbfZsdaU s o\<f`$ǶSػuNl7MbZXJWJlhm%xXpDxXpUJZ֍LMeiPE!!^2v>F-"mX;j*js@~2t:NJT+dDČ~%fII6:67~]$Ƽv>y|E<>;<>`5Mt d)(fptpN`R)I#qg()S>՛򂥾:]S:K~lӥFy(%mS'<#OS1s[gnzi;t@>Xg\p+Vڪ| Ny~My4U{powkHEG|o<霬f֚d`<<>|bdNSδirnFή&'kl(?/e鼉7=ΖuG9|af>a& rկD~%RD^Por?L7v&;u=W6 |7v9'SR8wH~4󙰑!#`^ݏhm]-is[TJ0yD:CdT2{T2E]^_cq#ZB]TrQyD%绨*4.~wTruQI> C{uHK QXml;u77win{s=r?Ę}%r+V"+$+_zD}XoGK Z!j~+㼩}t[ѵU.j.×~UW_萶iM&umYEqWѽ1kl7~;'[ W+w&{`((bo?=fxaJMZ,}E/o!t=~8fc݆w_~kMv߿O{݈ԃۍ+_vwI,&5PӔ 2V_ npW OE鞯,wtzD"~]5ǷHz*)B6L[򎶼L;䌗?[l{t!"}sH}HmR}Hx)|l4~KUƔ񗖴YC/oOPRkGs,zi|GKBW bCCj&)$QU~؈x6HTE97 ^ռk"tbBOz^UuaiRe_W)q㷕]C"g}WOq1T "@W:X4s~ Y)VNd/LWwCzc~i{\zO/~UBendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS257 14 0 R /GS258 15 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.400 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /ca 0.400 >> endobj 15 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 16 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000025190 00000 n 0000025273 00000 n 0000025448 00000 n 0000025481 00000 n 0000000212 00000 n 0000000292 00000 n 0000028176 00000 n 0000028433 00000 n 0000028530 00000 n 0000028608 00000 n 0000028657 00000 n 0000028706 00000 n 0000028755 00000 n trailer << /Size 16 /Info 1 0 R /Root 2 0 R >> startxref 28804 %%EOF robustbase/vignettes/lmrob_simulation.Rnw0000644000176200001440000016440013312257746020521 0ustar liggesusers\documentclass[11pt, a4paper]{article} \usepackage[a4paper, text={16cm,25cm}]{geometry} %\VignetteIndexEntry{Simulations for Robust Regression Inference in Small Samples} %\VignetteDepends{robustbase, xtable, ggplot2,GGally, RColorBrewer, grid, reshape2} \usepackage{amsmath} \usepackage{natbib} \usepackage[utf8]{inputenc} \newcommand{\makeright}[2]{\ifx#1\left\right#2\else#1#2\fi} \newcommand{\Norm}[2][\left]{\mathcal N #1( #2 \makeright{#1}{)}} \newcommand{\norm}[1] {\| #1 \|} \newcommand{\bld}[1]{\boldsymbol{#1}} % shortcut for bold symbol \newcommand{\T}[1] {\texttt{#1}} \DeclareMathOperator{\wgt}{w} \DeclareMathOperator{\var}{var} \DeclareMathOperator{\diag}{diag} \DeclareMathOperator{\median}{median} \DeclareMathOperator{\mad}{mad} \DeclareMathOperator{\Erw}{\mathbf{E}} \SweaveOpts{prefix.string=plot, eps = FALSE, pdf = TRUE, strip.white=true} \SweaveOpts{width=6, height=4} \usepackage[noae]{Sweave} \begin{document} \setkeys{Gin}{width=\textwidth} \setlength{\abovecaptionskip}{-5pt} <>= ## set options options(width=60, warn=1) # see warnings where they happen (should eliminate) ## number of workers to start if(FALSE) {## good for pkg developers options(cores= max(1, parallel::detectCores() - 2)) } else { ## CRAN allows maximum of 2: options(cores= min(2, parallel::detectCores())) } ## Number of Repetitions: N <- 1000 ## get path (= ../inst/doc/ in source pkg) robustDoc <- system.file('doc', package='robustbase') robustDta <- robustDoc ## initialize (packages, data, ...): source(file.path(robustDoc, 'simulation.init.R')) # 'xtable' ## set the amount of trimming used in calculation of average results trim <- 0.1 <>= ## load required packages for graphics stopifnot(require(ggplot2), require(GGally),# for ggpairs() which replaces ggplot2::plotmatrix() require(grid), require(reshape2)) source(file.path(robustDoc, 'graphics.functions.R')) `%||%` <- function (x, orElse) if (!is.null(x)) x else orElse ## set ggplot theme theme <- theme_bw(base_size = 10) theme$legend.key.size <- unit(1, "lines")# was 0.9 in pre-v.3 ggplot2 theme$plot.margin <- unit(c(1/2, 1/8, 1/8, 1/8), "lines")# was (1/2, 0,0,0) theme_set(theme) ## old and new ggplot2: stopifnot(is.list(theme_G <- theme$panel.grid.major %||% theme$panel.grid)) ## set default sizes for lines and points update_geom_defaults("point", list(size = 4/3)) update_geom_defaults("line", list(size = 1/4)) update_geom_defaults("hline", list(size = 1/4)) update_geom_defaults("smooth", list(size = 1/4)) ## alpha value for plots with many points alpha.error <- 0.3 alpha.n <- 0.4 ## set truncation limits used by f.truncate() & g.truncate.*: trunc <- c(0.02, 0.14) trunc.plot <- c(0.0185, 0.155) f.truncate <- function(x, up = trunc.plot[2], low = trunc.plot[1]) { x[x > up] <- up x[x < low] <- low x } g.truncate.lines <- geom_hline(yintercept = trunc, color = theme$panel.border$colour) g.truncate.line <- geom_hline(yintercept = trunc[2], color = theme$panel.border$colour) g.truncate.areas <- annotate("rect", xmin=rep(-Inf,2), xmax=rep(Inf,2), ymin=c(0,Inf), ymax=trunc, fill = theme_G$colour) g.truncate.area <- annotate("rect", xmin=-Inf, xmax=Inf, ymin=trunc[2], ymax=Inf, fill = theme_G$colour) legend.mod <- list(`SMD.Wtau` = quote('SMD.W'~tau), `SMDM.Wtau` = quote('SMDM.W'~tau), `MM.Avar1` = quote('MM.'~Avar[1]), `MMqT` = quote('MM'~~q[T]), `MMqT.Wssc` = quote('MM'~~q[T]*'.Wssc'), `MMqE` = quote('MM'~~q[E]), `MMqE.Wssc` = quote('MM'~~q[E]*'.Wssc'), `sigma_S` = quote(hat(sigma)[S]), `sigma_D` = quote(hat(sigma)[D]), `sigma_S*qE` = quote(q[E]*hat(sigma)[S]), `sigma_S*qT` = quote(q[T]*hat(sigma)[S]), `sigma_robust` = quote(hat(sigma)[robust]), `sigma_OLS` = quote(hat(sigma)[OLS]), `t1` = quote(t[1]), `t3` = quote(t[3]), `t5` = quote(t[5]), `cskt(Inf,2)` = quote(cskt(infinity,2)) ) @% end{graphics-setup} \title{Simulations for Sharpening Wald-type Inference in Robust Regression for Small Samples} \author{Manuel Koller} \maketitle \tableofcontents \section{Introduction} In this vignette, we recreate the simulation study of \citet{KS2011}. This vignette is supposed to complement the results presented in the above cited reference and render its results reproducible. Another goal is to provide simulation functions, that, with small changes, could also be used for other simulation studies. Additionally, in Section~\ref{sec:maximum-asymptotic-bias}, we calculate the maximum asymptotic bias curves of the $\psi$-functions used in the simulation. \section{Setting} The simulation setting used here is similar to the one in \citet{maronna2009correcting}. We simulate $N = \Sexpr{N}$ repetitions. To repeat the simulation, we recommend using a small value of $N$ here, since for large $n$ and $p$, computing all the replicates will take days. \subsection{Methods} We compare the methods \begin{itemize} \item MM, SMD, SMDM as described in \citet{KS2011}. These methods are available in the package \T{robustbase} (\T{lmrob}). \item MM as implemented in the package \T{robust} (\T{lmRob}). This method will be denoted as \emph{MMrobust} later on. \item MM using S-scale correction by $q_{\rm T}$ and $q_{\rm E}$ as proposed by \citet{maronna2009correcting}. $q_{\rm T}$ and $q_{\rm E}$ are defined as follows. \begin{equation*} q_{\rm E} = \frac{1}{1 - (1.29 - 6.02/n)p/n}, \end{equation*} \begin{equation*} \hat q_{\rm T} = 1 + \frac{p}{2n}\frac{\hat a}{\hat b\hat c}, \end{equation*} where \begin{equation*} \hat a = \frac{1}{n}\sum_{i=1}^n \psi\left(\frac{r_i}{\hat\sigma_{\rm S}}\right)^2, \hat b = \frac{1}{n} \sum_{i=1}^n\psi'\left(\frac{r_i}{\hat\sigma_{\rm S}}\right),%' \hat c = \frac{1}{n}\sum_{i=1}^n \psi\left(\frac{r_i}{\hat\sigma_{\rm S}}\right) \frac{r_i}{\hat\sigma_{\rm S}}, \end{equation*} with $\psi = \rho'$,%' $n$ the number of observations, $p$ the number of predictor variables, $\hat\sigma_{\rm S}$ is the S-scale estimate and $r_i$ is the residual of the $i$-th observation. When using $q_{\rm E}$ it is necessary to adjust the tuning constants of $\chi$ to account for the dependence of $\kappa$ on $p$. For $q_{\rm T}$ no change is required. This method is implemented as \T{lmrob.mar()} in the source file \T{estimating.functions.R}. \end{itemize} \subsection{$\psi$-functions} We compare \emph{bisquare}, \emph{optimal}, \emph{lqq} and \emph{Hampel} $\psi$-functions. They are illustrated in Fig.~\ref{fig:psi.functions}. The tuning constants used in the simulation are compiled in Table~\ref{tab:psi-functions}. Note that the \emph{Hampel} $\psi$-function is tuned to have a downward slope of $-1/3$ instead of the originally proposed $-1/2$. This was set to allow for a comparison to an even slower descending $\psi$-function. %% generate table of tuning constants used for \psi functions \begin{table}[ht] \begin{center} <>= ## get list of psi functions lst <- lapply(estlist$procedures, function(x) { if (is.null(x$args)) return(list(NULL, NULL, NULL)) if (!is.null(x$args$weight)) return(list(x$args$weight[2], round(f.psi2c.chi(x$args$weight[1]),3), round(f.eff2c.psi(x$args$efficiency, x$args$weight[2]),3))) return(list(x$args$psi, round(if (is.null(x$args$tuning.chi)) lmrob.control(psi=x$args$psi)$tuning.chi else x$args$tuning.chi,3), round(if (is.null(x$args$tuning.psi)) lmrob.control(psi=x$args$psi)$tuning.psi else x$args$tuning.psi,3))) }) lst <- unique(lst) ## because of rounding, down from 21 to 5 ! lst <- lst[sapply(lst, function(x) !is.null(x[[1]]))] # 5 --> 4 ## convert to table tbl <- do.call(rbind, lst) tbl[,2:3] <- apply(tbl[,2:3], 1:2, function(x) { gsub('\\$NA\\$', '\\\\texttt{NA}', paste('$', unlist(x), collapse=', ', '$', sep='')) }) tbl[,1] <- paste('\\texttt{', tbl[,1], '}', sep='') colnames(tbl) <- paste('\\texttt{', c('psi', 'tuning.chi', 'tuning.psi'), '}', sep='') print(xtable(tbl), sanitize.text.function=identity, include.rownames = FALSE, floating=FALSE) @ %def \vspace{15pt} \caption{Tuning constants of $\psi$-functions used in the simulation.} \label{tab:psi-functions} \end{center} \end{table} \begin{figure} \begin{center} <>= d.x_psi <- function(x, psi) { cc <- lmrob.control(psi = psi)$tuning.psi data.frame(x=x, value=Mpsi(x, cc, psi), psi = psi) } x <- seq(0, 10, length.out = 1000) tmp <- rbind(d.x_psi(x, 'optimal'), d.x_psi(x, 'bisquare'), d.x_psi(x, 'lqq'), d.x_psi(x, 'hampel')) print( ggplot(tmp, aes(x, value, color = psi)) + geom_line(lwd=1.25) + ylab(quote(psi(x))) + scale_color_discrete(name = quote(psi ~ '-function'))) @ \end{center} \caption{$\psi$-functions used in the simulation.} \label{fig:psi.functions} \end{figure} \subsection{Designs} Two types of designs are used in the simulation: fixed and random designs. One design with $n=20$ observations, $p=1+3$ predictors and strong leverage points. This design also includes an intercept column. It is shown in Fig.~\ref{fig:design-predict}. The other designs are random, i.e., regenerated for every repetition, and the models are fitted without an intercept. We use the same distribution to generate the designs as for the errors. The number of observations simulated are $n = 25, 50, 100, 400$ and the ratio to the number of parameters are $p/n = 1/20, 1/10, 1/5, 1/3, 1/2$. We round $p$ to the nearest smaller integer if necessary. The random datasets are generated using the following code. <>= f.gen <- function(n, p, rep, err) { ## get function name and parameters lerrfun <- f.errname(err$err) lerrpar <- err$args ## generate random predictors ret <- replicate(rep, matrix(do.call(lerrfun, c(n = n*p, lerrpar)), n, p), simplify=FALSE) attr(ret[[1]], 'gen') <- f.gen ret } ratios <- c(1/20, 1/10, 1/5, 1/3, 1/2)## p/n lsit <- expand.grid(n = c(25, 50, 100, 400), p = ratios) lsit <- within(lsit, p <- as.integer(n*p)) .errs.normal.1 <- list(err = 'normal', args = list(mean = 0, sd = 1)) for (i in 1:NROW(lsit)) assign(paste('rand',lsit[i,1],lsit[i,2],sep='_'), f.gen(lsit[i,1], lsit[i,2], rep = 1, err = .errs.normal.1)[[1]]) @ An example design is shown in Fig.~\ref{fig:example.design}. \begin{figure} \begin{center} <>= require(GGally) colnames(rand_25_5) <- paste0("X", 1:5) # workaround new (2014-12) change in GGally ## and the 2016-11-* change needs data frames: df.r_25_5 <- as.data.frame(rand_25_5) try( ## fails with old GGally and new packageVersion("ggplot2") >= "2.2.1.9000" print(ggpairs(df.r_25_5, axisLabels="show", title = "rand_25_5: n=25, p=5")) ) @ \end{center} \caption{Example random design.} \label{fig:example.design} \end{figure} \subsection{Error Distributions} We simulate the following error distributions \begin{itemize} \item standard normal distribution, \item $t_5$, $t_3$, $t_1$, \item centered skewed t with $df = \infty, 5$ and $\gamma = 2$ (denoted by \emph{cskt$(\infty,2)$} and \emph{cskt}$(5,2)$, respectively); as introduced by \citet{fernandez1998bayesian} using the \T{R} package \T{skewt}, \item contaminated normal, $\Norm{0,1}$ contaminated with $10\%$ $\Norm{0, 10}$ (symmetric, \emph{cnorm}$(0.1,0,3.16)$) or $\Norm{4, 1}$ (asymmetric, \emph{cnorm}$(0.1,4,1)$). \end{itemize} \subsection{Covariance Matrix Estimators} For the standard MM estimator, we compare ${\rm Avar}_1$ of \citet{croux03} and the empirical weighted covariance matrix estimate corrected by Huber's small sample correction as described in \citet{HubPR09} (denoted by \emph{Wssc}). The latter is also used for the variation of the MM estimate proposed by \citet{maronna2009correcting}. For the SMD and SMDM variants we use the covariance matrix estimate as described in \citet{KS2011} (\emph{W$\tau$}). The covariance matrix estimate consists of three parts: \begin{equation*} {\rm cov}(\hat\beta) = \sigma^2\gamma\bld V_{\bld X}^{-1}. \end{equation*} The SMD and SMDM methods of \T{lmrob} use the following defaults. \begin{equation} \label{eq:gammatau} \hat\gamma = \frac{\frac{1}{n}\sum_{i=1}^n\tau_i^2 \psi\left(\frac{r_i}{\tau_i\hat\sigma}\right)^2} {\frac{1}{n}\sum_{i=1}^n\psi'\left(\frac{r_i}{\tau_i\hat\sigma}\right)} \end{equation} where $\tau_i$ is the rescaling factor used for the D-scale estimate (see \citet{KS2011}). \noindent\textbf{Remark: } Equation \eqref{eq:gammatau} is a corrected version of $\gamma$. It was changed in \texttt{robustbase} version \texttt{0.91} (April 2014) to ensure that the equation reduces to $1$ in the classical case ($\psi(x) = x$). If the former (incorrect) version is needed for compatibility reasons, it can be obtained by adding the argument \texttt{cov.corrfact = "tauold"}. \begin{equation*} \bld{\widehat V}_{\bld X} = \frac{1}{\frac{1}{n}\sum_{i=1}^n\wgt_{ii}}\bld X^T\bld W\bld X \end{equation*} where $\bld W = \diag\left(\wgt\left(\frac{r_1}{\hat\sigma}\right), \dots, \wgt\left(\frac{r_n}{\hat\sigma}\right)\right)$. The function $\wgt(r) = \psi(r)/r$ produces the robustness weights. \section{Simulation} The main loop of the simulation is fairly simple. (This code is only run if there are no aggregate results available.) %% set eval to TRUE for chunks simulation-run and simulation-aggr %% if you really want to run the simulations again. %% (better fail with an error than run for weeks) <>= aggrResultsFile <- file.path(robustDta, "aggr_results.Rdata") <>= if (!file.exists(aggrResultsFile)) { ## load packages required only for simulation stopifnot(require(robust), require(skewt), require(foreach)) if (!is.null(getOption("cores"))) { if (getOption("cores") == 1) registerDoSEQ() ## no not use parallel processing else { stopifnot(require(doParallel)) if (.Platform$OS.type == "windows") { cl <- makeCluster(getOption("cores")) clusterExport(cl, c("N", "robustDoc")) clusterEvalQ(cl, slave <- TRUE) clusterEvalQ(cl, source(file.path(robustDoc, 'simulation.init.R'))) registerDoParallel(cl) } else registerDoParallel() } } else registerDoSEQ() ## no not use parallel processing for (design in c("dd", ls(pattern = 'rand_\\d+_\\d+'))) { print(design) ## set design estlist$design <- get(design) estlist$use.intercept <- !grepl('^rand', design) ## add design.predict: pc estlist$design.predict <- if (is.null(attr(estlist$design, 'gen'))) f.prediction.points(estlist$design) else f.prediction.points(estlist$design, max.pc = 2) filename <- file.path(robustDta, sprintf('r.test.final.%s.Rdata',design)) if (!file.exists(filename)) { ## run print(system.time(r.test <- f.sim(estlist, silent = TRUE))) ## save save(r.test, file=filename) ## delete output rm(r.test) ## run garbage collection gc() } } } @ The variable \T{estlist} is a list containing all the necessary settings required to run the simulation as outlined above. Most of its elements are self-explanatory. <>= str(estlist, 1) @ \T{errs} is a list containing all the error distributions to be simulated. The entry for the standard normal looks as follows. <>= estlist$errs[[1]] @ \T{err} is translated internally to the corresponding random generation or quantile function, e.g., in this case \T{rnorm} or \T{qnorm}. \T{args} is a list containing all the required arguments to call the function. The errors are then generated internally with the following call. <>= set.seed(estlist$seed) errs <- c(sapply(1:nrep, function(x) do.call(fun, c(n = nobs, args)))) @ All required random numbers are generated at once instead of during the simulation. Like this, it is certain, that all the compared methods run on exactly the same data. The entry \T{procedures} follows a similar convention. \T{design.predict} contains the design used for the prediction of observations and calculation of confidence or prediction intervals. The objects returned by the procedures are processed by the functions contained in the \T{estlist\$output} list. <<>>= str(estlist$output[1:3], 2) @ The results are stored in a 4-dimensional array. The dimensions are: repetition number, type of value, procedure id, error id. Using \T{apply} it is very easy and fast to generate summary statistics. The raw results are stored on the hard disk, because typically it takes much longer to execute all the procedures than to calculate the summary statistics. The variables saved take up a lot of space quite quickly, so only the necessary data is stored. These are $\sigma$, $\bld\beta$ as well as the corresponding standard errors. To speed up the simulation routine \T{f.sim}, the simulations are carried out in parallel, as long as this is possible. This is accomplished with the help of the \T{R}-package \T{foreach}. This is most easily done on a machine with multiple processors or cores. The \T{multicore} package provides the methods to do so easily. The worker processes are just forked from the main \T{R} process. After all the methods have been simulated, the simulation output is processed. The code is quite lengthy and thus not displayed here (check the Sweave source file \T{lmrob\_simulation.Rnw}). The residuals, robustness weights, leverages and $\tau$ values have to be recalculated. Using vectorized operations and some specialized \T{C} code, this is quite cheap. The summary statistics generated are discussed in the next section. <>= if (!file.exists(aggrResultsFile)) { files <- list.files(robustDta, pattern = 'r.test.final\\.') res <- foreach(file = files) %dopar% { ## get design, load r.test, initialize other stuff design <- substr(basename(file), 14, nchar(basename(file)) - 6) cat(design, ' ') load(file.path(robustDta, file)) estlist <- attr(r.test, 'estlist') use.intercept <- if (!is.null(estlist$use.intercept)) estlist$use.intercept else TRUE sel <- dimnames(r.test)[[3]] ## [dimnames(r.test)[[3]] != "estname=lm"] n.betas <- paste('beta',1:(NCOL(estlist$design)+use.intercept),sep='_') ## get design lX <- if (use.intercept) as.matrix(cbind(1, get(design))) else as.matrix(get(design)) n <- NROW(lX) p <- NCOL(lX) ## prepare arrays for variable designs and leverages if (is.function(attr(estlist$design, 'gen'))) { lXs <- array(NA, c(n, NCOL(lX), dim(r.test)[c(1, 4)]), list(Obs = NULL, Pred = colnames(lX), Data = NULL, Errstr = dimnames(r.test)[[4]])) } ## generate errors lerrs <- array(NA, c(n, dim(r.test)[c(1,4)]) , list(Obs = NULL, Data = NULL, Errstr = dimnames(r.test)[[4]])) for (i in 1:dim(lerrs)[3]) { lerrstr <- f.list2str(estlist$errs[[i]]) lerr <- f.errs(estlist, estlist$errs[[i]], gen = attr(estlist$design, 'gen'), nobs = n, npar = NCOL(lX)) lerrs[,,lerrstr] <- lerr if (!is.null(attr(lerr, 'designs'))) { ## retrieve generated designs: this returns a list of designs lXs[,,,i] <- unlist(attr(lerr, 'designs')) if (use.intercept) stop('intercept not implemented for random desings') } rm(lerr) } if (is.function(attr(estlist$design, 'gen'))) { ## calculate leverages lXlevs <- apply(lXs, 3:4, .lmrob.hat) } ## calculate fitted values from betas if (!is.function(attr(estlist$design, 'gen'))) { ## fixed design case lfitted <- apply(r.test[,n.betas,sel,,drop=FALSE],c(3:4), function(bhat) { lX %*% t(bhat) } ) } else { ## variable design case lfitted <- array(NA, n*prod(dim(r.test)[c(1,4)])*length(sel)) lfitted <- .C('R_calc_fitted', as.double(lXs), ## designs as.double(r.test[,n.betas,sel,,drop=FALSE]), ## betas as.double(lfitted), ## result as.integer(n), ## n as.integer(p), ## p as.integer(dim(r.test)[1]), ## nrep as.integer(length(sel)), ## n procstr as.integer(dim(r.test)[4]), ## n errstr DUP=FALSE, NAOK=TRUE, PACKAGE="robustbase")[[3]] } tdim <- dim(lfitted) <- c(n, dim(r.test)[1], length(sel),dim(r.test)[4]) lfitted <- aperm(lfitted, c(1,2,4,3)) ## calculate residuals = y - fitted.values lfitted <- as.vector(lerrs) - as.vector(lfitted) dim(lfitted) <- tdim[c(1,2,4,3)] lfitted <- aperm(lfitted, c(1,2,4,3)) dimnames(lfitted) <- c(list(Obs = NULL), dimnames(r.test[,,sel,,drop=FALSE])[c(1,3,4)]) lresids <- lfitted rm(lfitted) ## calculate lm MSE and trim trimmed MSE of betas tf.MSE <- function(lbetas) { lnrm <- rowSums(lbetas^2) c(MSE=mean(lnrm,na.rm=TRUE),MSE.1=mean(lnrm,trim=trim,na.rm=TRUE)) } MSEs <- apply(r.test[,n.betas,,,drop=FALSE],3:4,tf.MSE) li <- 1 ## so we can reconstruct where we are lres <- apply(lresids,3:4,f.aggregate.results <- { function(lresid) { ## the counter li tells us, where we are ## we walk dimensions from left to right lcdn <- f.get.current.dimnames(li, dimnames(lresids), 3:4) lr <- r.test[,,lcdn[1],lcdn[2]] ## update counter li <<- li + 1 ## transpose and normalize residuals with sigma lresid <- t(lresid) / lr[,'sigma'] if (lcdn[1] != 'estname=lm') { ## convert procstr to proclst and get control list largs <- f.str2list(lcdn[1])[[1]]$args if (grepl('lm.robust', lcdn[1])) { lctrl <- list() lctrl$psi <- toupper(largs$weight2) lctrl$tuning.psi <- f.eff2c.psi(largs$efficiency, lctrl$psi) lctrl$method <- 'MM' } else { lctrl <- do.call('lmrob.control',largs) } ## calculate correction factors ## A lsp2 <- rowSums(Mpsi(lresid,lctrl$tuning.psi, lctrl$psi)^2) ## B lspp <- rowSums(lpp <- Mpsi(lresid,lctrl$tuning.psi, lctrl$psi,1)) ## calculate Huber\'s small sample correction factor lK <- 1 + rowSums((lpp - lspp/n)^2)*NCOL(lX)/lspp^2 ## 1/n cancels } else { lK <- lspp <- lsp2 <- NA } ## only calculate tau variants if possible if (grepl('args.method=\\w*(D|T)\\w*\\b', lcdn[1])) { ## SMD or SMDM ## calculate robustness weights lwgts <- Mwgt(lresid, lctrl$tuning.psi, lctrl$psi) ## function to calculate robustified leverages tfun <- if (is.function(attr(estlist$design, 'gen'))) function(i) { if (all(is.na(wi <- lwgts[i,]))) wi else .lmrob.hat(lXs[,,i,lcdn[2]],wi) } else function(i) { if (all(is.na(wi <- lwgts[i,]))) wi else .lmrob.hat(lX, wi) } llev <- sapply(1:dim(r.test)[1], tfun) ## calculate unique leverages lt <- robustbase:::lmrob.tau(list(),h=llev,control=lctrl) ## normalize residuals with tau (transpose lresid) lresid <- t(lresid) / lt ## A lsp2t <- colSums(Mpsi(lresid,lctrl$tuning.psi, lctrl$psi)^2) ## B lsppt <- colSums(Mpsi(lresid,lctrl$tuning.psi, lctrl$psi,1)) } else { lsp2t <- lsppt <- NA } ## calculate raw scales based on the errors lproc <- f.str2list(lcdn[1])[[1]] q <- NA M <- NA if (lproc$estname == 'lmrob.mar' && lproc$args$type == 'qE') { ## for lmrob_mar, qE variant lctrl <- lmrob.control(psi = 'bisquare', tuning.chi=uniroot(function(c) robustbase:::lmrob.bp('bisquare', c) - (1-p/n)/2, c(1, 3))$root) se <- apply(lerrs[,,lcdn[2]],2,lmrob.mscale,control=lctrl,p=p) ltmp <- se/lr[,'sigma'] q <- median(ltmp, na.rm = TRUE) M <- mad(ltmp, na.rm = TRUE) } else if (!is.null(lproc$args$method) && lproc$args$method == 'SMD') { ## for D-scales se <- apply(lerrs[,,lcdn[2]],2,lmrob.dscale,control=lctrl, kappa=robustbase:::lmrob.kappa(control=lctrl)) ltmp <- se/lr[,'sigma'] q <- median(ltmp, na.rm = TRUE) M <- mad(ltmp, na.rm = TRUE) } ## calculate empirical correct test value (to yield 5% level) t.val_2 <- t.val_1 <- quantile(abs(lr[,'beta_1']/lr[,'se_1']), 0.95, na.rm = TRUE) if (p > 1) t.val_2 <- quantile(abs(lr[,'beta_2']/lr[,'se_2']), 0.95, na.rm = TRUE) ## return output: summary statistics: c(## gamma AdB2.1 = mean(lsp2/lspp^2,trim=trim,na.rm=TRUE)*n, K2AdB2.1 = mean(lK^2*lsp2/lspp^2,trim=trim,na.rm=TRUE)*n, AdB2t.1 = mean(lsp2t/lsppt^2,trim=trim,na.rm=TRUE)*n, sdAdB2.1 = sd.trim(lsp2/lspp^2*n,trim=trim,na.rm=TRUE), sdK2AdB2.1 = sd.trim(lK^2*lsp2/lspp^2*n,trim=trim,na.rm=TRUE), sdAdB2t.1 = sd.trim(lsp2t/lsppt^2*n,trim=trim,na.rm=TRUE), ## sigma medsigma = median(lr[,'sigma'],na.rm=TRUE), madsigma = mad(lr[,'sigma'],na.rm=TRUE), meansigma.1 = mean(lr[,'sigma'],trim=trim,na.rm=TRUE), sdsigma.1 = sd.trim(lr[,'sigma'],trim=trim,na.rm=TRUE), meanlogsigma = mean(log(lr[,'sigma']),na.rm=TRUE), meanlogsigma.1 = mean(log(lr[,'sigma']),trim=trim,na.rm=TRUE), sdlogsigma = sd(log(lr[,'sigma']),na.rm=TRUE), sdlogsigma.1 = sd.trim(log(lr[,'sigma']),trim=trim,na.rm=TRUE), q = q, M = M, ## beta efficiency.1 = MSEs['MSE.1','estname=lm',lcdn[2]] / MSEs['MSE.1',lcdn[1],lcdn[2]], ## t-value: level emplev_1 = mean(abs(lr[,'beta_1']/lr[,'se_1']) > qt(0.975, n - p), na.rm = TRUE), emplev_2 = if (p>1) { mean(abs(lr[,'beta_2']/lr[,'se_2']) > qt(0.975, n - p), na.rm = TRUE) } else NA, ## t-value: power power_1_0.2 = mean(abs(lr[,'beta_1']-0.2)/lr[,'se_1'] > t.val_1, na.rm = TRUE), power_2_0.2 = if (p>1) { mean(abs(lr[,'beta_2']-0.2)/lr[,'se_2'] > t.val_2, na.rm = TRUE) } else NA, power_1_0.4 = mean(abs(lr[,'beta_1']-0.4)/lr[,'se_1'] > t.val_1, na.rm = TRUE), power_2_0.4 = if (p>1) { mean(abs(lr[,'beta_2']-0.4)/lr[,'se_2'] > t.val_2, na.rm = TRUE) } else NA, power_1_0.6 = mean(abs(lr[,'beta_1']-0.6)/lr[,'se_1'] > t.val_1, na.rm = TRUE), power_2_0.6 = if (p>1) { mean(abs(lr[,'beta_2']-0.6)/lr[,'se_2'] > t.val_2, na.rm = TRUE) } else NA, power_1_0.8 = mean(abs(lr[,'beta_1']-0.8)/lr[,'se_1'] > t.val_1, na.rm = TRUE), power_2_0.8 = if (p>1) { mean(abs(lr[,'beta_2']-0.8)/lr[,'se_2'] > t.val_2, na.rm = TRUE) } else NA, power_1_1 = mean(abs(lr[,'beta_1']-1)/lr[,'se_1'] > t.val_1, na.rm = TRUE), power_2_1 = if (p>1) { mean(abs(lr[,'beta_2']-1)/lr[,'se_2'] > t.val_2, na.rm = TRUE) } else NA, ## coverage probability: calculate empirically ## the evaluation points are constant, but the designs change ## therefore this makes only sense for fixed designs cpr_1 = mean(lr[,'upr_1'] < 0 | lr[,'lwr_1'] > 0, na.rm = TRUE), cpr_2 = mean(lr[,'upr_2'] < 0 | lr[,'lwr_2'] > 0, na.rm = TRUE), cpr_3 = mean(lr[,'upr_3'] < 0 | lr[,'lwr_3'] > 0, na.rm = TRUE), cpr_4 = mean(lr[,'upr_4'] < 0 | lr[,'lwr_4'] > 0, na.rm = TRUE), cpr_5 = if (any(colnames(lr) == 'upr_5')) { mean(lr[,'upr_5'] < 0 | lr[,'lwr_5'] > 0, na.rm = TRUE) } else NA, cpr_6 = if (any(colnames(lr) == 'upr_6')) { mean(lr[,'upr_6'] < 0 | lr[,'lwr_6'] > 0, na.rm = TRUE) } else NA, cpr_7 = if (any(colnames(lr) == 'upr_7')) { mean(lr[,'upr_7'] < 0 | lr[,'lwr_7'] > 0, na.rm = TRUE) } else NA ) }}) ## convert to data.frame lres <- f.a2df.2(lres, split = '___NO___') ## add additional info lres$n <- NROW(lX) lres$p <- NCOL(lX) lres$nmpdn <- with(lres, (n-p)/n) lres$Design <- design ## clean up rm(r.test, lXs, lXlevs, lresids, lerrs) gc() ## return lres lres } save(res, trim, file = aggrResultsFile) ## stop cluster if (exists("cl")) stopCluster(cl) } <>= load(aggrResultsFile) ## this will fail if the file is not found (for a reason) ## set eval to TRUE for chunks simulation-run and simulation-aggr ## if you really want to run the simulations again. ## (better fail with an error than run for weeks) ## combine list elements to data.frame test.1 <- do.call('rbind', res) test.1 <- within(test.1, { Method[Method == "SM"] <- "MM" Method <- Method[, drop = TRUE] Estimator <- interaction(Method, D.type, drop = TRUE) Estimator <- f.rename.level(Estimator, 'MM.S', 'MM') Estimator <- f.rename.level(Estimator, 'SMD.D', 'SMD') Estimator <- f.rename.level(Estimator, 'SMDM.D', 'SMDM') Estimator <- f.rename.level(Estimator, 'MM.qT', 'MMqT') Estimator <- f.rename.level(Estimator, 'MM.qE', 'MMqE') Estimator <- f.rename.level(Estimator, 'MM.rob', 'MMrobust') Estimator <- f.rename.level(Estimator, 'lsq.lm', 'OLS') Est.Scale <- f.rename.level(Estimator, 'MM', 'sigma_S') Est.Scale <- f.rename.level(Est.Scale, 'MMrobust', 'sigma_robust') Est.Scale <- f.rename.level(Est.Scale, 'MMqE', 'sigma_S*qE') Est.Scale <- f.rename.level(Est.Scale, 'MMqT', 'sigma_S*qT') Est.Scale <- f.rename.level(Est.Scale, 'SMDM', 'sigma_D') Est.Scale <- f.rename.level(Est.Scale, 'SMD', 'sigma_D') Est.Scale <- f.rename.level(Est.Scale, 'OLS', 'sigma_OLS') Psi <- f.rename.level(Psi, 'hampel', 'Hampel') }) ## add interaction of Method and Cov test.1 <- within(test.1, { method.cov <- interaction(Estimator, Cov, drop=TRUE) levels(method.cov) <- sub('\\.+vcov\\.(a?)[wacrv1]*', '\\1', levels(method.cov)) method.cov <- f.rename.level(method.cov, "MMa", "MM.Avar1") method.cov <- f.rename.level(method.cov, "MMrobust.Default", "MMrobust.Wssc") method.cov <- f.rename.level(method.cov, "MM", "MM.Wssc") method.cov <- f.rename.level(method.cov, "SMD", "SMD.Wtau") method.cov <- f.rename.level(method.cov, "SMDM", "SMDM.Wtau") method.cov <- f.rename.level(method.cov, "MMqT", "MMqT.Wssc") method.cov <- f.rename.level(method.cov, "MMqE", "MMqE.Wssc") method.cov <- f.rename.level(method.cov, "OLS.Default", "OLS") ## ratio: the closest 'desired ratios' instead of exact p/n; ## needed in plots only for stat_*(): median over "close" p/n's: ratio <- ratios[apply(abs(as.matrix(1/ratios) %*% t(as.matrix(p / n)) - 1), 2, which.min)] }) ## calculate expected values of psi^2 and psi' test.1$Ep2 <- test.1$Epp <- NA for(Procstr in levels(test.1$Procstr)) { args <- f.str2list(Procstr)[[1]]$args if (is.null(args)) next lctrl <- do.call('lmrob.control',args) test.1$Ep2[test.1$Procstr == Procstr] <- robustbase:::lmrob.E(psi(r)^2, lctrl, use.integrate = TRUE) test.1$Epp[test.1$Procstr == Procstr] <- robustbase:::lmrob.E(psi(r,1), lctrl, use.integrate = TRUE) } ## drop some observations, separate fixed and random designs test.fixed <- droplevels(subset(test.1, n == 20)) ## n = 20 -- fixed design test.1 <- droplevels(subset(test.1, n != 20)) ## n !=20 -- random designs test.lm <- droplevels(subset(test.1, Function == 'lm')) # lm = OLS test.1 <- droplevels(subset(test.1, Function != 'lm')) # Rob := all "robust" test.lm$Psi <- NULL test.lm.2 <- droplevels(subset(test.lm, Error == 'N(0,1)')) # OLS for N(*) test.2 <- droplevels(subset(test.1, Error == 'N(0,1)' & Function != 'lm'))# Rob for N(*) ## subsets test.3 <- droplevels(subset(test.2, Method != 'SMDM'))# Rob, not SMDM for N(*) test.4 <- droplevels(subset(test.1, Method != 'SMDM'))# Rob, not SMDM for all @ \section{Simulation Results} \subsection{Criteria} The simulated methods are compared using the following criteria. \textbf{Scale estimates.} The criteria for scale estimates are all calculated on the log-scale. The bias of the estimators is measured by the $\Sexpr{trim*100}\%$ trimmed mean. To recover a meaningful scale, the results are exponentiated before plotting. It is easy to see that this is equivalent to calculating geometric means. Since the methods are all tuned at the central model, ${\mathcal N}(0,1)$, a meaningful comparison of biases can only be made for ${\mathcal N}(0,1)$ distributed errors. The variability of the estimators, on the other hand, can be compared over all simulated error distributions. It is measured by the $\Sexpr{trim*100}\%$ trimmed standard deviation, rescaled by the square root of the number of observations. For completeness, the statistics used to compare scale estimates in \citet{maronna2009correcting} are also calculated. They are defined as \begin{equation} \label{eq:def.q.and.M} q = \median\left(\frac{S(\bld e)}{\hat\sigma_S}\right), \quad M = \mad\left(\frac{S(\bld e)}{\hat\sigma_S}\right), \end{equation} where $S(e)$ stands for the S-scale estimate evaluated for the actual errors $\bld e$. For the D-scale estimate, the definition is analogue. Since there is no design to correct for, we set $\tau_i = 1\ \forall i$. \textbf{Coefficients.} The efficiency of estimated regression coefficients $\bld{\hat\beta}$ is characterized by their mean squared error (\emph{MSE}). Since we simulate under $H_0: \bld\beta = 0$, this is determined by the covariance matrix of $\bld{\hat\beta}$. We use $\Erw\left[\norm{\bld{\hat\beta}}_2^2\right] = \sum_{j=1}^p \var(\hat\beta_j)$ as a summary. When comparing to the MSE of the ordinary least squares estimate (\emph{OLS}), this gives the efficiency, which, by the choice of tuning constants of $\psi$, should yield \begin{equation*} \frac{{\rm MSE}(\bld{\hat\beta}_{\rm OLS})}{{\rm MSE}(\bld{\hat\beta})} \approx 0.95 \end{equation*} for standard normally distributed errors. The simulation mean of $\sum_{j=1}^p \var(\hat\beta_j)$ is calculated with $\Sexpr{trim*100}\%$ trimming. For other error distributions, this ratio should be larger than $1$, since by using robust procedures we expect to gain efficiency at other error distributions (relative to the least squares estimate). $\bld\gamma$\textbf{.} We compare the behavior of the various estimators of $\gamma$ by calculating the trimmed mean and the trimmed standard deviation for standard normal distributed errors. \textbf{Covariance matrix estimate.} The covariance matrix estimates are compared indirectly over the performance of the resulting test statistics. We compare the empirical level of the hypothesis tests $H_0: \beta_j = 0$ for some $j \in \{1,\dots, p\}$. The power of the tests is compared by testing for $H_0: \beta_j = b$ for several values of $b>0$. The formal power of a more liberal test is generally higher. Therefore, in order for this comparison to be meaningful, the critical value for each test statistic was corrected such that all tests have the same simulated level of $5\%$. The simple hypothesis tests give only limited insights. To investigate the effects of other error distributions, e.g., asymmetric error distributions, we compare the confidence intervals for the prediction of some fixed points. Since it was not clear how to assess the quality prediction intervals, either at the central or the simulated model, we do not calculate them here. A small number of prediction points is already enough, if they are chosen properly. We chose to use seven points lying on the first two principal components, spaced evenly from the center of the design used to the extended range of the design. The principal components were calculated robustly (using \T{covMcd} of the \T{robustbase} package) and the range was extended by a fraction of $0.5$. An example is shown in Figure~\ref{fig:design-predict}. \subsection{Results} The results are given here as plots (Fig.~\ref{fig:meanscale-1} to Fig.~\ref{fig:cpr}). For a complete discussion of the results, we refer to \citet{KS2011}. The different $\psi$-functions are each plotted in a different facet, except for Fig.~\ref{fig:qscale-all}, Fig.~\ref{fig:Mscale-all} and Fig.~\ref{fig:lqq-level}, where the facets show the results for various error distributions. The plots are augmented with auxiliary lines to ease the comparison of the methods. The lines connect the median values over the values of $n$ for each simulated ratio $p/n$. In many plots the y-axis has been truncated. Points in the grey shaded area represent truncated values using a different scale. \begin{figure} \begin{center} <>= ## ## exp(mean(log(sigma))): this looks almost identical to mean(sigma) print(ggplot(test.3, aes(p/n, exp(meanlogsigma.1), color = Est.Scale)) + stat_summary(aes(x=ratio), # <- "rounded p/n": --> median over "neighborhood" fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + geom_hline(yintercept = 1) + g.scale_y_log10_1() + facet_wrap(~ Psi) + ylab(quote('geometric ' ~ mean(hat(sigma)))) + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels=lab(test.3$Est.Scale))) @ \end{center} \caption{Mean of scale estimates for normal errors. The mean is calculated with $\Sexpr{trim*100}\%$ trimming. The lines connect the median values for each simulated ratio $p/n$. Results for random designs only. } \label{fig:meanscale-1} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(test.3, aes(p/n, sdlogsigma.1*sqrt(n), color = Est.Scale)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + ylab(quote(sd(log(hat(sigma)))*sqrt(n))) + facet_wrap(~ Psi) + geom_point (data=test.lm.2, alpha=alpha.n, aes(color = Est.Scale)) + stat_summary(data=test.lm.2, aes(x=ratio, color = Est.Scale), fun.y=median, geom='line') + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels= lab(test.3 $Est.Scale, test.lm.2$Est.Scale))) @ \end{center} \caption{Variability of the scale estimates for normal errors. The standard deviation is calculated with $\Sexpr{trim*100}\%$ trimming. } \label{fig:sdscale-1} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(test.4, aes(p/n, sdlogsigma.1*sqrt(n), color = Est.Scale)) + ylim(with(test.4, range(sdlogsigma.1*sqrt(n)))) + ylab(quote(sd(log(hat(sigma)))*sqrt(n))) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = Error), alpha = alpha.error) + facet_wrap(~ Psi) + ## "FIXME" (?): the next 'test.lm' one give warnings geom_point (data=test.lm, aes(color = Est.Scale), alpha=alpha.n) + ##-> Warning: Removed 108 rows containing missing values (geom_point). stat_summary(data=test.lm, aes(x = ratio, color = Est.Scale), fun.y=median, geom='line') + ##-> Warning: Removed 108 rows containing non-finite values (stat_summary). g.scale_shape(labels=lab(test.4$Error)) + scale_colour_discrete("Scale Est.", labels=lab(test.4 $Est.Scale, test.lm$Est.Scale))) @ \end{center} \caption{Variability of the scale estimates for all simulated error distributions.} \label{fig:sdscale-all} \end{figure} \begin{figure} \begin{center} <>= t3est2 <- droplevels(subset(test.3, Estimator %in% c("SMD", "MMqE"))) print(ggplot(t3est2, aes(p/n, q, color = Est.Scale)) + ylab(quote(q)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + geom_hline(yintercept = 1) + g.scale_y_log10_1() + facet_wrap(~ Psi) + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels=lab(t3est2$Est.Scale))) @ \end{center} \caption{$q$ statistic for normal errors. $q$ is defined in \eqref{eq:def.q.and.M}.} \label{fig:qscale-1} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(t3est2, aes(p/n, M/q, color = Est.Scale)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + g.scale_y_log10_0.05() + facet_wrap(~ Psi) + ylab(quote(M/q)) + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels=lab(t3est2$Est.Scale))) @ \end{center} \caption{$M/q$ statistic for normal errors. $M$ and $q$ are defined in \eqref{eq:def.q.and.M}.} \label{fig:Mscale-1} \end{figure} \begin{figure} \begin{center} <>= t1.bi <- droplevels(subset(test.1, Estimator %in% c("SMD", "MMqE") & Psi == 'bisquare')) print(ggplot(t1.bi, aes(p/n, q, color = Est.Scale)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + geom_hline(yintercept = 1) + g.scale_y_log10_1() + facet_wrap(~ Error) + ## labeller missing! ylab(quote(q)) + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels=lab(tmp$Est.Scale)), legend.mod = legend.mod) @ \end{center} \caption{$q$ statistic for \emph{bisquare} $\psi$. } \label{fig:qscale-all} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(t1.bi, aes(p/n, M/q, color = Est.Scale)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_point(aes(shape = factor(n)), alpha = alpha.n) + g.scale_y_log10_0.05() + facet_wrap(~ Error) + ylab(quote(M/q)) + scale_shape_discrete(quote(n)) + scale_colour_discrete("Scale Est.", labels=lab(tmp$Est.Scale)), legend.mod = legend.mod) @ \end{center} \caption{$M/q$ statistic for \emph{bisquare} $\psi$. } \label{fig:Mscale-all} \end{figure} \clearpage% not nice, but needed against LaTeX Error: Too many unprocessed floats. \begin{figure} \begin{center} <>= print(ggplot(test.2, aes(p/n, efficiency.1, color = Estimator)) + geom_point(aes(shape = factor(n)), alpha = alpha.n) + geom_hline(yintercept = 0.95) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + facet_wrap(~ Psi) + ylab(quote('efficiency of' ~~ hat(beta))) + g.scale_shape(quote(n)) + scale_colour_discrete(name = "Estimator", labels = lab(test.2$Estimator))) @ \end{center} \caption{Efficiency for normal errors. The efficiency is calculated by comparing to an OLS estimate and averaging with $\Sexpr{trim*100}\%$ trimming. } \label{fig:efficiency} \end{figure} \begin{figure} \begin{center} <>= t.1xt1 <- droplevels(subset(test.1, Error != 't1')) print(ggplot(t.1xt1, aes(p/n, efficiency.1, color = Estimator)) + ylab(quote('efficiency of '~hat(beta))) + geom_point(aes(shape = Error), alpha = alpha.error) + geom_hline(yintercept = 0.95) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + g.scale_shape(values=c(16,17,15,3,7,8,9,1,2,4)[-4], labels=lab(t.1xt1$Error)) + facet_wrap(~ Psi) + scale_colour_discrete(name = "Estimator", labels = lab(t.1xt1$Estimator))) @ \end{center} \caption{Efficiency for all simulated error distributions except $t_1$. } \label{fig:efficiency-all} \end{figure} \begin{figure} \begin{center} <>= t.2o. <- droplevels(subset(test.2, !is.na(AdB2t.1))) print(ggplot(t.2o., aes(p/n, AdB2.1/(1-p/n), color = Estimator)) + geom_point(aes(shape=factor(n)), alpha = alpha.n) + geom_point(aes(y=K2AdB2.1/(1-p/n)), alpha = alpha.n) + geom_point(aes(y=AdB2t.1), alpha = alpha.n) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + stat_summary(aes(x=ratio, y=K2AdB2.1/(1-p/n)), fun.y=median, geom='line', linetype=2) + stat_summary(aes(x=ratio, y=AdB2t.1), fun.y=median, geom='line', linetype=3) + geom_hline(yintercept = 1/0.95) + g.scale_y_log10_1() + scale_shape_discrete(quote(n)) + scale_colour_discrete(name = "Estimator", labels = lab(t.2o.$Estimator)) + ylab(quote(mean(hat(gamma)))) + facet_wrap(~ Psi)) @ \end{center} \caption{Comparing the estimates of $\gamma$. The solid line connects the uncorrected estimate, dotted the $\tau$ corrected estimate and dashed Huber's small sample correction. } \label{fig:AdB2-1} \end{figure} \begin{figure} \begin{center} <>= t.2ok <- droplevels(subset(test.2, !is.na(sdAdB2t.1))) print(ggplot(t.2ok, aes(p/n, sdAdB2.1/(1-p/n), color = Estimator)) + geom_point(aes(shape=factor(n)), alpha = alpha.n) + geom_point(aes(y=sdK2AdB2.1/(1-p/n)), alpha = alpha.n) + geom_point(aes(y=sdAdB2t.1), alpha = alpha.n) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + stat_summary(aes(x=ratio, y=sdK2AdB2.1/(1-p/n)), fun.y=median, geom='line', linetype= 2) + stat_summary(aes(x=ratio, y=sdAdB2t.1), fun.y=median, geom='line', linetype= 3) + g.scale_y_log10_0.05() + scale_shape_discrete(quote(n)) + scale_colour_discrete(name = "Estimator", labels=lab(t.2ok$Estimator)) + ylab(quote(sd(hat(gamma)))) + facet_wrap(~ Psi)) @ \end{center} \caption{Comparing the estimates of $\gamma$. The solid line connects the uncorrected estimate, dotted the $\tau$ corrected estimate and dashed Huber's small sample correction. } \label{fig:sdAdB2-1} \end{figure} \begin{figure} \begin{center} <>= t.2en0 <- droplevels(subset(test.2, emplev_1 != 0)) print(ggplot(t.2en0, aes(p/n, f.truncate(emplev_1), color = method.cov)) + g.truncate.lines + g.truncate.areas + geom_point(aes(shape = factor(n)), alpha = alpha.n) + scale_shape_discrete(quote(n)) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_hline(yintercept = 0.05) + g.scale_y_log10_0.05() + scale_colour_discrete(name = "Estimator", labels=lab(t.2en0$method.cov)) + ylab(quote("empirical level "~ list (H[0] : beta[1] == 0) )) + facet_wrap(~ Psi)) @ \end{center} \caption{Empirical levels of test $H_0: \beta_1 = 0$ for normal errors. The y-values are truncated at $\Sexpr{trunc[1]}$ and $\Sexpr{trunc[2]}$. } \label{fig:emp-level} \end{figure} \begin{figure} \begin{center} <>= tmp <- droplevels(subset(test.1, Psi == 'lqq' & emplev_1 != 0)) print(ggplot(tmp, aes(p/n, f.truncate(emplev_1), color = method.cov)) + ylab(quote("empirical level "~ list (H[0] : beta[1] == 0) )) + g.truncate.line + g.truncate.area + geom_point(aes(shape = factor(n)), alpha = alpha.n) + stat_summary(aes(x=ratio), fun.y=median, geom='line') + geom_hline(yintercept = 0.05) + g.scale_y_log10_0.05() + g.scale_shape(quote(n)) + scale_colour_discrete(name = "Estimator", labels=lab(tmp$method.cov)) + facet_wrap(~ Error) , legend.mod = legend.mod ) @ \end{center} \caption{Empirical levels of test $H_0: \beta_1 = 0$ for \emph{lqq} $\psi$-function and different error distributions. } \label{fig:lqq-level} \end{figure} \begin{figure} \begin{center} <>= t2.25 <- droplevels(subset(test.2, n == 25))# <-- fixed n ==> no need for 'ratio' tL2.25 <- droplevels(subset(test.lm.2, n == 25)) scale_col_D2.25 <- scale_colour_discrete(name = "Estimator (Cov. Est.)", labels=lab(t2.25 $method.cov, tL2.25$method.cov)) print(ggplot(t2.25, aes(p/n, power_1_0.2, color = method.cov)) + ylab(quote("empirical power "~ list (H[0] : beta[1] == 0.2) )) + geom_point(# aes(shape = Error), alpha = alpha.error) + stat_summary(fun.y=median, geom='line') + geom_point (data=tL2.25, alpha = alpha.n) + stat_summary(data=tL2.25, fun.y=median, geom='line') + ## g.scale_shape("Error", labels=lab(t2.25$Error)) + scale_col_D2.25 + facet_wrap(~ Psi) ) @ \end{center} \caption{Empirical power of test $H_0: \beta_1 = 0.2$ for different $\psi$-functions. Results for $n = 25$ and normal errors only. } \label{fig:power-1-0_2} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(t2.25, aes(p/n, power_1_0.4, color = method.cov)) + ylab(quote("empirical power "~ list (H[0] : beta[1] == 0.4) )) + geom_point(alpha = alpha.error) + stat_summary(fun.y=median, geom='line') + geom_point (data=tL2.25, alpha = alpha.n) + stat_summary(data=tL2.25, fun.y=median, geom='line') + ## g.scale_shape("Error", labels=lab(t2.25$Error)) + scale_col_D2.25 + facet_wrap(~ Psi) ) @ \end{center} \caption{Empirical power of test $H_0: \beta_1 = 0.4$ for different $\psi$-functions. Results for $n = 25$ and normal errors only. } \label{fig:power-1-0_4} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(t2.25, aes(p/n, power_1_0.6, color = method.cov)) + ylab(quote("empirical power "~ list (H[0] : beta[1] == 0.6) )) + geom_point(# aes(shape = Error), alpha = alpha.error) + stat_summary(fun.y=median, geom='line') + geom_point (data=tL2.25, alpha = alpha.n) + stat_summary(data=tL2.25, fun.y=median, geom='line') + scale_col_D2.25 + facet_wrap(~ Psi) ) @ \end{center} \caption{Empirical power of test $H_0: \beta_1 = 0.6$ for different $\psi$-functions. Results for $n = 25$ and normal errors only. } \label{fig:power-1-0_6} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(t2.25, aes(p/n, power_1_0.8, color = method.cov)) + ylab(quote("empirical power "~ list (H[0] : beta[1] == 0.8) )) + geom_point(alpha = alpha.error) + stat_summary(fun.y=median, geom='line') + geom_point (data=tL2.25, alpha = alpha.n) + stat_summary(data=tL2.25, fun.y=median, geom='line') + g.scale_shape("Error", labels=lab(t2.25$Error)) + scale_col_D2.25 + facet_wrap(~ Psi) ) @ \end{center} \caption{Empirical power of test $H_0: \beta_1 = 0.8$ for different $\psi$-functions. Results for $n = 25$ and normal errors only. } \label{fig:power-1-0_8} \end{figure} \begin{figure} \begin{center} <>= print(ggplot(t2.25, aes(p/n, power_1_1, color = method.cov)) + ylab(quote("empirical power "~ list (H[0] : beta[1] == 1) )) + geom_point(alpha = alpha.error) + stat_summary(fun.y=median, geom='line') + geom_point (data=tL2.25, alpha = alpha.n) + stat_summary(data=tL2.25, fun.y=median, geom='line') + ## g.scale_shape("Error", labels=lab(t2.25$Error)) + scale_col_D2.25 + facet_wrap(~ Psi) ) @ \end{center} \caption{Empirical power of test $H_0: \beta_1 = 1$ for different $\psi$-functions. Results for $n = 25$ and normal errors only. } \label{fig:power-1-1} \end{figure} %\clearpage \begin{figure} \begin{center} %% now (2016-11 GGally) works --- but fails with new 2018-05 ggplot2: <>= pp <- f.prediction.points(dd)[1:7,] ## Worked in older ggplot2 -- now plotmatrix() is gone, to be replaced by GGally::ggpairs): ## tmp <- plotmatrix(pp)$data ## tmp$label <- as.character(1:7) ## print(plotmatrix(dd) + geom_text(data=tmp, color = 2, aes(label=label), size = 2.5)) if(FALSE) { tmp <- ggpairs(pp)$data tmp$label <- as.character(1:7) # and now? } ## ggpairs() + geom_text() does *NOT* work {ggpairs has own class} ## print(ggpairs(dd) + geom_text(data=tmp, color = 2, aes(label=label), size = 2.5)) try( ## fails with old GGally and new packageVersion("ggplot2") >= "2.2.1.9000" print( ggpairs(dd) )## now (2016-11) fine ) @ \end{center} \caption{Prediction points for fixed design. The black points are the points of the original design. The red digits indicate the numbers and locations of the points where predictions are taken.} \label{fig:design-predict} \end{figure} \begin{figure} \begin{center} <>= n.cprs <- names(test.fixed)[grep('cpr', names(test.fixed))] # test.fixed: n=20 => no 'x=ratio' test.5 <- melt(test.fixed[,c('method.cov', 'Error', 'Psi', n.cprs)]) test.5 <- within(test.5, { Point <- as.numeric(do.call('rbind', strsplit(levels(variable), '_'))[,2])[variable] }) print(ggplot(test.5, aes(Point, f.truncate(value), color = method.cov)) + geom_point(aes(shape = Error), alpha = alpha.error) + g.truncate.line + g.truncate.area + stat_summary(fun.y=median, geom='line') + geom_hline(yintercept = 0.05) + g.scale_y_log10_0.05() + g.scale_shape(labels=lab(test.5$Error)) + scale_colour_discrete(name = "Estimator (Cov. Est.)", labels=lab(test.5$method.cov)) + ylab("empirical level of confidence intervals") + facet_wrap(~ Psi) ) @ \end{center} \caption{Empirical coverage probabilities. Results for fixed design. The y-values are truncated at $\Sexpr{trunc[2]}$. } \label{fig:cpr} \end{figure} \clearpage \section{Maximum Asymptotic Bias} \label{sec:maximum-asymptotic-bias} The slower redescending $\psi$-functions come with higher asymptotic bias as illustrated in Fig.~\ref{fig:max-asymptotic-bias}. We calculate the asymptotic bias as in \citet{berrendero2007maximum}. <>= ## Henning (1994) eq 33: g <- Vectorize(function(s, theta, mu, ...) { lctrl <- lmrob.control(...) rho <- function(x) Mchi(x, lctrl$tuning.chi, lctrl$psi, deriv = 0) integrate(function(x) rho(((1 + theta^2)/s^2*x)^2)*dchisq(x, 1, mu^2/(1 + theta^2)), -Inf, Inf)$value }) ## Martin et al 1989 Section 3.2: for mu = 0 g.2 <- Vectorize(function(s, theta, mu, ...) { lctrl <- lmrob.control(...) lctrl$tuning.psi <- lctrl$tuning.chi robustbase:::lmrob.E(chi(sqrt(1 + theta^2)/s*r), lctrl, use.integrate = TRUE)}) g.2.MM <- Vectorize(function(s, theta, mu, ...) { lctrl <- lmrob.control(...) robustbase:::lmrob.E(chi(sqrt(1 + theta^2)/s*r), lctrl, use.integrate = TRUE)}) ## Henning (1994) eq 30, one parameter case g.3 <- Vectorize(function(s, theta, mu, ...) { lctrl <- lmrob.control(...) rho <- function(x) Mchi(x, lctrl$tuning.chi, lctrl$psi, deriv = 0) int.x <- Vectorize(function(y) { integrate(function(x) rho((y - x*theta - mu)/s)*dnorm(x)*dnorm(y),-Inf, Inf)$value }) integrate(int.x,-Inf, Inf)$value }) inv.g1 <- function(value, theta, mu, ...) { g <- if (mu == 0) g.2 else g.3 uniroot(function(s) g(s, theta, mu, ...) - value, c(0.1, 100))$root } inv.g1.MM <- function(value, theta, mu, ...) { g <- if (mu == 0) g.2.MM else g.3.MM ret <- tryCatch(uniroot(function(s) g(s, theta, mu, ...) - value, c(0.01, 100)), error = function(e)e) if (inherits(ret, 'error')) { warning('inv.g1.MM: ', value, ' ', theta, ' ', mu,' -> Error: ', ret$message) NA } else { ret$root } } s.min <- function(epsilon, ...) inv.g1(0.5/(1 - epsilon), 0, 0, ...) s.max <- function(epsilon, ...) inv.g1((0.5-epsilon)/(1-epsilon), 0, 0, ...) BS <- Vectorize(function(epsilon, ...) { sqrt(s.max(epsilon, ...)/s.min(epsilon, ...)^2 - 1) }) l <- Vectorize(function(epsilon, ...) { sigma_be <- s.max(epsilon, ...) sqrt((sigma_be/inv.g1.MM(g.2.MM(sigma_be,0,0,...) + epsilon/(1-epsilon),0,0,...))^2 - 1) }) u <- Vectorize(function(epsilon, ...) { gamma_be <- s.min(epsilon, ...) max(l(epsilon, ...), sqrt((gamma_be/inv.g1.MM(g.2.MM(gamma_be,0,0,...) + epsilon/(1-epsilon),0,0,...))^2 - 1)) }) @ \begin{figure}[h!] \begin{center} <>= asymptMBFile <- file.path(robustDta, 'asymptotic.max.bias.Rdata') if (!file.exists(asymptMBFile)) { x <- seq(0, 0.35, length.out = 100) rmb <- rbind(data.frame(l=l(x, psi = 'hampel'), u=u(x, psi = 'hampel'), psi = 'Hampel'), data.frame(l=l(x, psi = 'lqq'), u=u(x, psi = 'lqq'), psi = 'lqq'), data.frame(l=l(x, psi = 'bisquare'), u=u(x, psi = 'bisquare'), psi = 'bisquare'), data.frame(l=l(x, psi = 'optimal'), u=u(x, psi = 'optimal'), psi = 'optimal')) rmb$x <- x save(rmb, file=asymptMBFile) } else load(asymptMBFile) <>= print(ggplot(rmb, aes(x, l, color=psi)) + geom_line() + geom_line(aes(x, u, color=psi), linetype = 2) + xlab(quote("amount of contamination" ~~ epsilon)) + ylab("maximum asymptotic bias bounds") + coord_cartesian(ylim = c(0,10)) + scale_y_continuous(breaks = 1:10) + scale_colour_hue(quote(psi ~ '-function'))) @ \end{center} \caption{Maximum asymptotic bias bound for the $\psi$-functions used in the simulation. Solid line: lower bound. Dashed line: upper bound.} \label{fig:max-asymptotic-bias} \end{figure} \bibliographystyle{chicago} \bibliography{robustbase} \end{document} robustbase/vignettes/plot-fig-sdscale-1.pdf0000644000176200001440000004463513465050114020434 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180739) /ModDate (D:20190509180739) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 14467 /Filter /FlateDecode >> stream x}ɒdInؽ"9/צFѴmƃD $Dz8KM/"2jCe 8o/?]S1?w|sOq= ^ASx?￿?}]~)bq_Q7*`.$%%^?) ~:,iST2PfhϟO- [yaUeB{aBOv/MWBOuH |f0T*{:| it{aFY7zyͽA{c,n=ڍ`W 5Tp/^᩺"Zı""$ u^eLq87fxJs-4i)ԫZGj1&qu\ ژS[]0SUyVMBZ{ i)WBRhO=B|E iqS&sI O`xoSJ3́-o|pee){mk* T=@(_?4x*^~M5ٽ _k߉Izg״勵վL3'GlƟ3k"4\3x}c0awRz>PGL +g Vgc)<\=w]=>ޅHzzh q$YU)hyA^[$_MfH_v/6.ԩ2ߢFCZhl|}q<i9< 2J9 |j<3 e}=~Ճ3}tP=XZ]y @j)ص+JrWn.A"rUBe_F֦zkUz?z*t WW=Q:GJcY󲾨ޕ;+l߬nzo{+c8^Lrr.z.jd0h&:l0.Q<-!c= 2-,*[*ii|r{1Mg7Deh] u7k$,HiSy0Vk.R+n Yc;-c "\WL²4De)U{1~䫷YK.jk 1*t WW U$\pc,KCt^sZ$cM{<7]|t}e{{^e=7d'=Een6< Z'czg,o7S<`Fb:خJ$HeJszzWocxzW/c^Qs,3mnKOk2XZV=ª\]zkzV]֓LkϵK'1ӪuLZ;i+F ~ › z<Ŵ^n^GlrbI4b + *뢴 C]aduM!2x*SHnOO5L~M~e<2#OXR_'Xp_,zl53O#^fm?/ ?_s {.Ѩ#ar_;Rĵ+!ńgrZBL3|^p=t\[qZ9-Z;{nah#% t;Ru]~- J'o4ƾSJ ejzJ >A}U4s\&hlGj*rYh KpV%c xh:Z N$sgAM lttz?V^% *˩3A9 :Ke;?~TcGOyxxz/R>ܘOVag GA\@vZ 5`[bӔ}-Ŧ)e6Y~܃GMlif&p ƪ4:[POIW-*^$x-ȓ4o# ͕N%]2`;cv a 6q› uCقgrS]$R$2h !, aYJc]yn 5d3> 2*>?`C{;D0hxeZɓ ^J΁1.;ūT,Bק'vƲ1eV؃` j"\ )*^tqHո 0Xt=!&ȝR*wL>unϝFg\L妺:Hs m'gNJ,'RU伊|Et WΕVx W9aYFNyЯSGNmJӯ8ZATj*_Mevʆb+\z oܶoE[=mVVon۷b-%[K` }+)9UVM޾o/ܷb4}9x1oE[.@~b< JWX+kj P @/UK}[b+ ]p r*e6YwU`yU1AE"lr *4ኀWPei˺rbXv?R)/>aY@Se&~VɰF aRGe"!ocρk@B+ZU_s~ePrMqMQ/a%ޗESqLk9J$\&²4TGeoct:i-P++Cl=!*i(qs:$<\QU?&R6ᝮwT9HO~fsIeCt mYeXJ,[')-reaG{D%P<iO \ƈvmAQ M&zB7MD (T +~ |@([\$'-dIzp:pF KAU'Jq&<2 }ANCk&|9ӽ t$`_xN{ZZ@ [IUwi7 4ԘGD+EX[DHMB|qU8M*q$L_(N+ <rg7K#UV2kES};\mJ}=~]ɍTNB~\NsQ}S 2),d"*=M +*owG~s\?Nz=z*kAW=B(hE8L$n bS}>ZoÇOF*a23$P]8ł$pkεpY$cow0'-zpojLZ1&{dd^-r2$PW~*+EF_9Z1/K~E gLosY#-=|X& 5ѶKoPjA bj8h|wŊuU {2עjκ-XBG@2c5=p/tm5ޚd,ItN-<tDX݃=`s*5  LG@!_2.pM.e2a:'=QEWiBtrPX LC@atb&AHqXGOKjqOSbՈq(5og5"{Ӡbc~Y\HqT29q'q_mѧq/xXBG Ȣ @hIaEILqKN7'NW/|d'#Wx̹<*g~`47|_ásTj~:'a_1"N7z(7pgPoyt N:Wp9b(y_{ٷn 9+7>/|uwnp0\)~;̥, ,&šE f]i=ilnAtx޵˭2yZ Aۭ'kQm555´uUN HTJS)xz{2#pfrƉژW23u懿J!@4NMA׈;3xf;T3N๚TA`lZyWjƉ".aoSىjhH&J+5bīVM-D " cEﵺ˺-L8B¤j5w&bD%~na$[/H]ZnA nf+iOYN6`, c7҅#!ˬrQ봰˺iJ#(ܠ<;[[N4oH&[lûEl;IJOt&K'Յy/J ^ fq~9ټᾅdsR$Mzqm Io#oXz~C.! n Kp#oHy20첤տaؿ2t. 7r[BtXboji?Is#ginFnyn It#oXyC2&h !%. 5˪İo)!ؿ7{eT@mZA{ .7BA<(]RzzˁZkt !Օ:*-wOR^2<-&^KWR8 wpɭ1Qկǭ[u{{yo'k{Z^+riWVCwT_{B1GJxS=(Υ&}8n>q4/[=>5nDHivTHzPVy긱Jioy 7Vǭq#40+`+~ue|f(͠09H/j=Riq*RjĽW_7y菹#Ѽ)}? )Ha3x7L>(< 2 [>çȕwtP0ov=0쪾aomUmu3It<]1h8)WMYEg']ӧO#x7LOSme|J߈\|UN!Z&T&O)ѡXKRiTcQde u"c烚=! d'нQ!fx2#]D ,'/J`_hلv\l>uo+4Է6t^)*x TVd^h1}Nye^"Mc]g׋M;'x-^/mOi0>ʕ`AMnpT2mA.rݑMxo)~}+?1|5uaW|]guV\]u5c]hu-ו\]KuM \&EO -@d#ɕa< ´ 1^$0(m Ne^"Mnҳ?ֳBi9mu,Eyu<>eH<>0Mw[l‹\D}NϺ^䴌¬vG:گcoL-=ל}|W[O|u5I#(._irT2´ZIi3wkl»ڍk-s<5d߯!Z}/zm0%>L&rӳ)EnS>%37b`~BgD JhR}h͘aExgԲr1׳?X2Mӄ\^ä"OӜ".B[r¹׵ENJ{fղpzVڧciyBs1-C]J]CM 2\6uqz9gu}E u5T א|=_]S9kj_ajZڱ_oK I=;=K$;ts ;Ad<@V.-fQZL+5OT.f= =40V5J`,$ _W ir>i07BDB]zڇc\B=ץM\rWkW_u߯~kOYiXWVWDZZV}][?uI:+GX'm>gfbn:dEHy3'UT՚Me1y> hk٤}AG.Y*{`޼0a~,H Ri G- BkRnh P1ѡW\|Y۵RNN7dh xSj r~Ht>6nzO yqY) #ʓs3vy~SjHF$V?Bs}0l2O{^&r2|οumom+yJ}mp{Š)Ť50)Lq܎+V8Vx |.匔\쬇E~^ǽ__[\Tc<{y^Mȕy]dgX( ;kh:W5[(  jŬ[kٌgv.ГWMO⡧uz=eڔ4{ O|l›!䦺h&Y' 5P g⒬e0NkPr&Y'(]h)$R9bi/YIGD&яUkhgYV7EBKM.e bZ/7 Ů4xFyF1ٻӥ_gOū:HsoLh9U9Mxh7_S=~a,GI PS 0:H˪i]yk"v-,z:Y;oj1<ɪeU'#^t:NNRN.娓oZ8\>i54[i7㣤B -%^ޖ]ʦ'*ru&f/ &WSϙ,1{`xJhd}٬OPKقׯM_|_83/*K y/5K AEFq$}v L_0 fZwߗ%%GE 1]qvj tm 1_tLկ$F`k*-]5_xh7zLs;}͓;{r ^TvP1?MpH#3^}l‹\D}&pw>ݼHڝAiFV54߃4vtk' ϵ#M p{ɖ]`dL3;QoR]癪k4"ƳbZjcx5xӯ AijwV%KkTty.")5H|>-&qWޚ]fAG4o%yw7dz$ӻk3߸gmV{d{,;%;-;%;-߻4$|,Ỽ! ]M<,a/_^  r!+%i߹N]M2KYwSƵ\\(7`r/Ƚ_kD-6[ rk!pݿP+YPpZzO ,͊r E^(H .,.9}՞\z!^@p2O^ Tϵw\=nb#P/ԑt=L8،?r{$/Wb@o"P/ɂ(ݙ/ ={g%MoM] j۞˞ 67̠aWw!H6*:w\EnTUMҟp-3$PW<QuRauk0|p'ClL@.A(X`,KCt^S'eҮz9rcoW=FNzR (r<ȸPcѶ5S$,KCt^ֻȕ7=@ug,~ $A Ep(\$2 uZm2\A5  V]W%ObZd,7\oHv 5ou`Dz ;.z`Isnm|⟾b#{V]Opl~v^2] At|E\Xes.su#A#Q`lH pWtJah; []ԤK2Lށ%E~BjE^7^ sa 7/{E̛n2~H7?^n;=Ԕa[+jO3҈ )6&rbx O&+AKEt+cߛZ޶ܫk8HBoAFΒFjl4mŔvힶӏ- b| }HP|}'B^^?FZB&m;i#Bv?mpPm]šRxHiҘjt%K1d1cmE?opm;BG@g7 R-6ƬykDm qN6.J1BxMW'𗝵 Y Y[?'mߣT{x{0'# 3N:~kP{H|t`^B~#hOֲ)Է'XvmYy'ti(!/&;Ŧi!* )0g*U(yGt w3>䱵jCnlR9p / ![HgW, }se#Όn|+!%e232׈QgU `r>8Ŧ7w?ܑd+P×,: 8|тWG*] Wendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS257 14 0 R /GS258 15 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.400 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /ca 0.400 >> endobj 15 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 16 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000014832 00000 n 0000014915 00000 n 0000015090 00000 n 0000015123 00000 n 0000000212 00000 n 0000000292 00000 n 0000017818 00000 n 0000018075 00000 n 0000018172 00000 n 0000018250 00000 n 0000018299 00000 n 0000018348 00000 n 0000018397 00000 n trailer << /Size 16 /Info 1 0 R /Root 2 0 R >> startxref 18446 %%EOF robustbase/vignettes/plot-fig-qscale.pdf0000644000176200001440000002247613465050114020127 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180740) /ModDate (D:20190509180740) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 5158 /Filter /FlateDecode >> stream x\Mo$9rW>l ?kk,`q{ֻzz{ }Gċ #KTIsh^2~ |~_N!GɉKq}}X>}y1,O+ɏpKX!.?=D1ap0m/Lɵ> mJ2>.ʠ7>>?<@P@M0 pj 0TA˧t@z y ($D7n Wjů童6ns(t@_Nիb/QZODo59 j*?pt5^QHyD -O[ s>% c5*X6SmbLҔk|eT \&4!i-flG= ~ׅҴT->L9&9ҿl<&WUd Ň^)v^T%>i]C0,icLMShV $Si#u3=UnZ" @ݏm;e:T1K6j>h=F%rf|՞$ctfFHZgM]Н(h/Y5M2/Zނ>'=%]R]7&x}ļM'!+z./ϯ=Z.2LyfЏTu{3lg&Y#@i͎N~k:gr U2 ؂e4γC([rnBo@}ye6R]LwFDz_B|ߎcK zVkM}V=#d6O-\8fmFoչgV H5hdryRF 4 5pA4]<>`ӀL+spi9:*IAt0Mh怂hIyσCSISB"`,[63>3:`'y)-u63‚8l7`M֜_43+Yn ux1n̷z/ҬV,N7$FV%|V%,m.5MPwW.hPWzU%}J;L\\عZswvvۣd,NKl DeO'^?P$^êeJ0F+.̑6cYC]&!xC}UxWD ~bևO{Idأ}KZ=C1b/'$52-֮$Ɣe)n8,8 l~uKt Iސ/7S1DZmkݝǫ̬ǾKSXGGj(v;Livԣ _VM7`ϸ/DP_q.aVUs#}Pp][mMW`|Ys#TȗUӍ_Aא˺C7֎-ȗ/>خ[ُڇK#ta< $l0sg$ylc_\1]9<y Bj[/~lW·M!%oM"WVeQ]Cەֵ]>#o W֑( RO3u3,q IH3lډSB I2pcpT\׹* So*>TOgԗ`hÃaxgAB+e`nRK4jXjIw%I.hX]P R'x}!,xDreFUhb;vvP |: Br<,GځodD@[e;,Bִ6zuXd16>2hմ]Cj;i޹GMVi3hATC3ρ玪j4(;5GݾɈyVāG1b7; Q.`;1SN<9"hz* pqǢrnqsy*F:Ǟ=:xA7zc5.!ݮhc׃ 1&1oČ# H5yH'*N4T@;8πw8;P=x eLjQ)vEal*s cWf;2)S )澫Bڬ|fi4Or8`krơGrG\یN,˂6B;r#{ 1b|`P7t8>b|L3058>by! nɸ*qsHcY|\(3h"_lpqLK0$\cNU5Xlj*Q=+hJܒTG,Uq'X5}:Gۈ@{}pLi-"6Б}D,UN@ru!)ECj&Ry_1|/<@́ 4:Ҡ7F}䅇uz.h\R >< <²*p1| T ه"aՓMGHmj*Q=B <t~.C~M7t==7r, &Kʆf^~mwyOs[V&s 趚Y^lf8j(6k;]uI[̹-AѸ%*n|ph{ b1hsܦ fԑ[2  Z)689G ۵=_|hsMNCBW(;)suw><|ZLOq/X~W"XOߜ?O|:Bv/J}6!kϻvx|Rpv]ocw Ӻǭ??OO?o{QWX;$/xe@+wUeEx=r4տ4yȿt?tӭt+KΟ/kxmJ-c 6n"!Fv.N GS-iBH>dd>#FH>`Y"Kht{zX+Ga6ҵ8zKޭQbA\?ՠt{te0f2ќ>K[7j,/j(`wg;E[× zg^i׶6zv1X.p||YwYs&~,Kt?ȭr "L+MFP8.7iMU4x~G#4O\q:E3*DGz&;o~"])0^*S舴 qwmo+W4ˎ_d< س ƥW^rV%}ĸm\[T;:%z0{b65ި7}5<|91+A U4\)]oǚ- <I8ң iި§|EvG7ʵ㛂>cnfendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS257 14 0 R /GS258 15 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.400 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /ca 0.400 >> endobj 15 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 16 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000005522 00000 n 0000005605 00000 n 0000005780 00000 n 0000005813 00000 n 0000000212 00000 n 0000000292 00000 n 0000008508 00000 n 0000008765 00000 n 0000008862 00000 n 0000008940 00000 n 0000008989 00000 n 0000009038 00000 n 0000009087 00000 n trailer << /Size 16 /Info 1 0 R /Root 2 0 R >> startxref 9136 %%EOF robustbase/vignettes/plot-fig-qscale-all.pdf0000644000176200001440000004021313465050115020663 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180741) /ModDate (D:20190509180741) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 12254 /Filter /FlateDecode >> stream x}]%9r{8 &$x g?h`VkK#oߺŬy{O[?C-F}ata/9 _-7͢6~߯uOR_.KY! a$2߷&noAB_֗} ?mv/&nU*w*+~z7 ݋'辈!_BMʀ3C/G v~3\J'τKs 8?EK=~CJ8n*] UnMׁ+F}6P_յ߾3ݤ[G{qwVIa`QvKvjժ8_喗V?jJE_)ǩy%onY; 6JvyH.{qY{|}_>?ݷi߸k"gR?i~dT7k']vyٷ[֦m/==w))oU?=G{1ۊrD7YΣl=䦤nC,_&{{T:^e4ϝe ȵl^rT>]ZM+7&}䆏eHDS r鈂<+EL@浗\0ZY)1ap ?*wqdp rU1j6ZHUڴRf8p䝦G T@U>bf'_1a9XAyq^:^VꯌB9}V?xeH2vuAӮT;b 4мPŠVy(7&}EkgxnxboiYd z^fB&_|#e&IyT zC}oOvV=2^;֧?u#i{z9`.}穽]aԮLyF-zn/"YMu#?-tǏ,ٗ3 )[֝P9O|#l:huh7w5ߚ|o=s| {g'o&C{MhPwuk1/?;:u̞= 85!CKB($^(Ov'-ڔSpjq)CI5n2 {wsh<:+uX fixn UwG <'*O2xnF?})z jrB@*/Fa{h WU5>&߳)4/gfs|cM|^?iZ <a o^On,Y8q^kxHwfPA@O5tpx ^倣>985GIfhOa{:%.iyMFųORU>=]naKb4ϟ%ËԜw8opob6/ewPy< xKt.yx@F;vrBjL8.p /c#_VsA $df3^Ɂv^:ݝ O|OC6=efj_NMn[b,tk䧁r9SHu;sv&Vo/_&{/'. FPl+ʳw%Lfԏe]V/=}39:Hi} "J&P5HB?QnAޘ\ /WBWOM!4L(ͳR4TklZSZY)1_W-2>ڍ3ٵs``8ʍQ!=(r#:H "FN^,uhަ334OAl8HTkh^ 2tc4y(T;ξ^eL,[8P4RZB (kA^ POӅԪ`,7&}]Xh MuЇp@hJ P]%@ή:{6Q L.q_z#"xV*ɉx9ӥL$eP>n<ҏL2Yn:w<]כxR<JMzaB nX3m:x\ x]+ څ LA&,/=QL<`9/>6ϟ -&GﰫLy~rӠr~rG202F~corm(:d-/m\W5=(, /i-F3O+V<|痦Gܚy~9ߠBBbow\yǴ=Ͽ0}S+r;mp{;s78~s (2}+54J}rGQmg3 VD+Qlpd3n8G\o~rY\o9|kPnp_ge aLym^HW貌I2(VD3-[ݢ ܽ,N"FlW&Q"mou'+.".kH|ykYƲCO@MyT!2mD<};|CaPTwzXMy{j AL%muW@~j :k(Is |]y(4kM Qx˚Hh%#4d2=k2 ZA9*Qf>L .NB[E\ahIʬE&aѤߝh.-ߡEVVvE2z3͘ &K`^H2ա"u^DycrKd$Zh^mo+ 9gPNԺr}7mԼ1~gzʨ`HA>LX{ഺ3̇mp7Ol=OߡEV^Cȥ7]]^ }{e2v$H2[f#=(f%m6}_duh$ Q1HO]!cJh%J~cߣEhdcgJhѦ;i6vF}|P2:اhEM#7 Qƾ;79&#}{P(3L&w66UYB~LֿѿWҀ-+3L&qFycD68k[O?fmU„mRL9jCƦN3šYY,cԽ5yN3µJO t?%9pWD b A̷mh02Ĵ잛7>Qk]6C9I[䔴HBVQal5LySڅx %FKvy?ti#[Hwo4DmÜϴͳ [*h\a%i#kHnuL d]ض>#]oByF[g}T~&q:6mDA䇙 %0Rygf窾 #FvhjEL#KȫӞ'Uc>>! p&_{ X{7SҰeIÖ441ҰҰJ3qZ: N8] {c%a8ְ0P ͻ XVWoš|%8|LnO3*{.=IF"7'T\ҚdXoc#~MFaN&'7Py9^:=JI<d}l6s_˔v6Sp;[l@EPgj`$cFy7ˬ|mi|RgCW\:5Ki0:.xn6ߘ:euOO>TL6*x7*}= wۨO|!-0d])yqZ@[G ,? /$81BߦBc0f$ɒز,5,5F$`$ɒ&Ο$I w4݇5 Ƕ픰 8)apa\ߨaɒxHr-*' {b!|[{\+:r}'J2B{K'iTLji_%7X2jkQx'Lm䮳7ﺄcz:p[Mg 8PO2H:[N\A}<&GWI[56cIe>TvD(  IsSף̿5o{A쀸߽Qm'd%u/ܖත~I6dl_mͧAڊ[r, 8M m[h^#rEԸ ݏlH!m; k'!aYGfcyƏTidu.Hw(_~O~w22[lpnOfPl+˭-Z&#IAYM#w(_~OM3֬ sJ[ ̶JoƐhT- FYRm/F'+G@6#y)Gb[YP0?h$C<*me9l{N*7W1?x/adQ$<ZxfxdՙeeܿnCVl~Ad? k{?b[Ynm,L#GtI$ee3^v݆b[QNOMGBbﰷ.b@\5 ¥XZ(-$,m[2&HRkL >]ȞXGNPn,uYz \A^`%̅a_,&Wuޗj,0Jт=XwFs9|ՁH>hbXP-Hz=Z/-ӆǾFÎei d`AfT9X0-HO =L(\ÊF4>3R4NIN9v:]'u4{96=h/SgL:f>J3L#$ǝN:R0P'fڮ>"ܭa]ӎtwITfbi9VΟa$зYa|dIU}'K™ ɒX~Xc$a Ó4WAfQaCV `B CLo$ÐNÆ] 1 VF|u`K9_ahx $ bE6_W_~Ð'beG8Ð-1:~a8Heae: >9F'!铳F^_drwm)Px}/יU&#:2vb+t&rVNL&muK{gW_->s{V| ݕ&vV>A:@z.qOp낎J(^#őVHՙ6F9lR C S[7wў|uc(2ݱMQVh(K1 Oy}W۟4" Lp0hZmDtԶXihX0-ԂVs@!Βcc|2D $+C 8Z/z MЅˈ7yO!B C;ܡ-Ob:/YFATop|!g ;B Ce!ސK_ah"unun) =mo /0d,St_a@ ʦ,#B C7cI1 Ot,E dI,+j6Tzɍ4[A8D[+AcrI w<CpG#HeU//~Ga}܇?|w?ongk~k?7rᏟov2]=Wn_%)o{=kSobty\}|[}y"SuUzB$ x%V5Vgn_kٮB^6B~#}YU}d߯Kaj[KE(ҔV`ń\ {r@/g3O;Yu/6mveD묨$NyV4I^$[eWc$lj~˿=,lcZ,lcZd?$Eda/ބKrOwaN`m{/(<}: F᯾v;Y5f L?㢬li*^]/7zu..V.(]y]PҺX9|$u)kX(@%w1haq<,rJn.C`ׇnsUw~س~;?̠h|J Z:`Q-dR$/2ZoIJN2nEfr)z)>d-]=Sa9+s]GyqinYVVbIiIp"{/%u(t 10ie-erynE>l`ّGz-"|̡Yӟv2uCy? Hbe${ا=Zߘ[/Bx$yӢ9&kF[GJY ^&AT蹍 "K'E_mO}_kN]v|?Z ޫ 8m84Eg^S=q<(;ި7&J_O=endstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 11 0 R /GS2 12 0 R /GS257 13 0 R /GS258 14 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /ExtGState /CA 0.400 >> endobj 12 0 obj << /Type /ExtGState /CA 1.000 >> endobj 13 0 obj << /Type /ExtGState /ca 0.400 >> endobj 14 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 15 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000012619 00000 n 0000012702 00000 n 0000012866 00000 n 0000012899 00000 n 0000000212 00000 n 0000000292 00000 n 0000015594 00000 n 0000015851 00000 n 0000015948 00000 n 0000015997 00000 n 0000016046 00000 n 0000016095 00000 n trailer << /Size 15 /Info 1 0 R /Root 2 0 R >> startxref 16144 %%EOF robustbase/vignettes/plot-fig-power-1-0_6.pdf0000644000176200001440000003354613465050121020531 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180745) /ModDate (D:20190509180745) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 9641 /Filter /FlateDecode >> stream x]M%mϯKifNU8劒J*/l/䉜k!s@u{=\.-F  ~ n.|~.uϒgg6///?~*{M?j~tW_%WT0^RYyetIS) Uh%50T\s}|]wo^}\s,S``Ieor]4:ko`yPEײ/ _ 4I5sjlK`&6>h=|`|Puߺ[ M :DSpIB%?gMS UՆ/?K5kGkmB^2K`[mڹX;Z>m]caA(y!*3Nju i.'9f֕Mg`#Vu޽`AtMAy+zJG@Fuq偅4Fe=*_76\ Qy'(_tƣI*@T^ uKʂʷa D uuTTjAcKOb^*߆+*tK߯KvkT^a]%[ԫ.۔6;)kØׂޱkWT\t:oQyBx6 m{~]YZ<#~]eq:i)o%D6 n!hg~#f` tK-I XBn%0K[u=ZBn>c* }\Mv$.BĻJz7ރ%V]I[ ,<my9rz]%еK` ]%@{Z[h$n`tsiC/(KF[0ACi!g6׷묆`nR5OܤnIۺضGĦ^HG@S-Xkq|݊sU@WԩFYϘ$ɰͺuPM y偅zJG@FKzvW^Pd=c^öYrTdيP:'W^aM=#\EOhmA&]רPd=c* AEj SaKAYH%iArM$S uُ]3'Rv{Ǽaѱr^QzWV@ie=cun{մ_7S$;ҭsZ+4`{tWbkT] kZkZ\/QyBy\s{0ZރI] {l*}lG D r+җɵ: i.zƄuAyuVXzF疘Ay 頼`]41TeG6PBi=4 (:;7rt!]i8WBr&NvTْƒYϞ2u,M!QeNK(>%i. z In!rr&zĶDKKĺ-!nmm/紓F [brr&CH޺4.B% u_2l'7@;}ʙ띖cHs>GK}".i9 #8:r=Ż>LLKxI:\,6smnfn$i'#NvxeܴÚNr5uGL-ل 5= N+_P nyÛcezl5Tձ*529g^hBe:Ce튕F},e+ĠYZbeP-vUzgPmwoe-^BbF?Al\AYPJ5^mTŇa!EYe?lNE海kR k5(!szPY%zpZ=]8gQ <mtZ/ywK-;{z݅~eέډxWva_oO;2}[xve5#lL%^[̝dfmA7 ^)(װ{mQ L+v4'x[No#=vcΔ5a_{Uvt՝Q9tUiU߳UJUZP-n4-lC oYSNrh&ϔdttD`~LU|Eϔa!EY[ֶHuISC6z&57Ǎn3r]:5i@db!XLx 1x^H=t1X vUε_<ċUq$.X?Ǹ69R[ }R3[ Bi{P^MyY}27<r@K0DK[@;C%K/V}h؁zDŽgڏ_~-gVMX{/Vu*ka, `/B~0H{L1`pxw!<&/ꢻREn}s ~0LNd/ʀ_Ts:=`2~ѓSVu? 0 ֕RG*n?kB 8El_YշٝXpA:-ܐ;hti;²D֌KޓY7 QSq(p74%i 4%-,nn }=r6}ʉL%}hIK%Si )he?vK2IڤN+`{ |ߡ%z oocv,3K~jD.Xb%h-к]{ݎ/Yd,PA`qӬ'YH (g%i w@! <m&pl.d EF^`L.AěTy }y1x()M8qtxJ3Gk<4-ĮƳOl'G/m`'/2HѱJdKʮޥ]GMA 0:68m!33myg `ɮ(ͮ(Aě5xGKFcy#o%r:,hm1aܾ7cnÌ 3,1iבw; <mR}ͣ%%ȟ¬0O8H|wjat(4u'm;=KT+}Œ7È~&=CYR5ș.{Bx()gQp,U4EKoPKFڢF.dC.FO9vS=ZBϔFһ޵-1h z3%đ-!ftK(-1O9vxs,!'-y; Ż%-Zn 9]vK[%( )gαGK~.nRP[h-K3hW[[% )gѿ³h.% XRĒP뾦7q,)ǐK\ ,<mUTS H<ۓ*y9"c͓mH;g |w:XIKh /rp,G;6<2A3VQr̛$Ȼ%U1iĿEKoUN)mo%\F;}*8-Qs`%[a["m ,oXEqI2GK,^Y_$)h %4^K;W΄@A3VѠwͣ%0wK,@XktKM{ۦ؟wox>c'^:G_ECܥɥxUKt%tZ]%^)rzN']ƒE<|SدzH㫼rZ@~/$No?󺁇\r<]KH\H`q֠h MS%x5ZM`= <mUsm`\%-1գ%-1h xƒ%[e>Zy>}*JxifyEKMA hMTNrK+CC.FOYEQRmJhWf` MS.d@]-|  r6}*fuۥHP[.oW:Bu@[]>3lOYEJ7@^R1OX;>tX;pWͺkǒځsnX;aP(K~( U|U'L vN^rf9X6OWP_/"=1B;~#[ƧÝ8X_b}ztl#i6)$ԷYp=!$Wc^gVnR4v{sCs%e@2 ꌌ QμDQ-LGt@嶀jg^ypfny)c- y%ioyu/iΓIJgسz3z 7"iOg[QӛQr0>6]x^мDSeY8*z4Ոsh y4?viY|{*4?m=b64Z=mW&^(qV3)b{R4 aZ4h\[ﹶ`!F<@>`CѠA xGGрh4&Hz4̇F*30 n?|||!h}&I* YblYW-uwZ@x [<#NaQ)R婘n4s%7MI (ŭXtZR=:-<m }$ϣ%7-ai KMoKBBA{ A!=lq.'smm:ZB9sޞRuAÐi "alxZ]67!K,tY\'֤]cɭ] ;XĪz3`ԃ(t{\ kҀ.zbq[;t,(ؠz'TXUt,=& )П kҀ.zb|qu35;i\5DN6Ik$]ĠII]X*eJtc鴀*xb;b;^7 Q&5h 04 :5(ZxӔV^ky ; ;Z^7 Q&59l9ZBKXwK9Zb-GK[ĶEKl-nO g>OJ\}nsxh ZK9 Iv]<u/ aa=M v{?m- M=M 6WHxhZ"ijP-袸'Ye/=/-t?L $/ī%e/ڤ䝸 Ov`0}ͣ%;4ҥ]ɵm˚GKd`v=3 6|}-O nFK켵-vK}T-A<4w,Q-8ƭ]Kr .rч 7f6q7 8PU( (= s;]V0fN`MYOp=I' vPAd~(xՐxNTs1)j5@=1ɜ樿&e)`=|ii]Ir4+ҩS l[@G<[[xr"zRZXZ`/+}^-o j$,vOsb?=u絹{|/;^ k׶#'zZ=ctioxz{6\{mk rHFm>=}\ěћ%cvsXbF ލ7wQӻ-"5l<.o 7¿}/v8rǟӴp#Cq~x3lŕ&7o?~پ(Q{kY!~ջow_?vhg"SCc}q?~}~/ROTthпhdJAVm݁ *uF=('cS r"><'ҿd۹it {D/a]z)eI{eTAܡkF5>{$4E#1v;!덥.mtO] g.6|O\l=m1xއ!zAV̋:.>knuV- x8lހ ~9c=6pp<8n`@:EF#YEOG#P?w=M~їo껏'Wxs/_g|wwWa֧٧IlVy2indH,/iu\7M@(nzw}wْkzT-4k$rӂ8r89Y;9.^Z{~Vd83բ9gV =v\K3f!LeɮiO[[qkh& #7<%y"K=e^USA5r aYg0 gI ~ӝ?5H=gĮqY#筛{;@]IB}c#T5ɠ-O($k6ig &nS.~6=f`#;؟jb5b˿ ZRi4ţB:y4"dc(h J;t8y?nx0@GO c5sFl;(y+ ƽ`)L%nKIɠ-Ŀ^$ l[.|!u縭 a0w4q`?V=gJٗ[n9&>X`VymA[@50h %L6IX\SDFf`#`؟C7sF?@8T\֣#C>{( xk`ZT##-ё#xUNwt'#ot;w?5@=c5o|cL91%1 O/h G?ƔcàSo~oY ~r>`SX M;=vռmAϿ6{/n B ie>&%>1BlS -o~ZCXO.o>7n@k'IXIEfc ! <ֶ51d߽{Ak0;Vь-r?i}1@M\},VV>hl/kN6z6nLFF9h$u|w_<]>˻?(sޛ,)K#?VEO;ܦMnH/w'HO<Ƃendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS3 14 0 R /GS257 15 0 R /GS258 16 0 R /GS259 17 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.302 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /CA 0.400 >> endobj 15 0 obj << /Type /ExtGState /ca 0.302 >> endobj 16 0 obj << /Type /ExtGState /ca 0.400 >> endobj 17 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 18 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000010005 00000 n 0000010088 00000 n 0000010289 00000 n 0000010322 00000 n 0000000212 00000 n 0000000292 00000 n 0000013017 00000 n 0000013274 00000 n 0000013371 00000 n 0000013449 00000 n 0000013498 00000 n 0000013547 00000 n 0000013596 00000 n 0000013645 00000 n 0000013694 00000 n trailer << /Size 18 /Info 1 0 R /Root 2 0 R >> startxref 13743 %%EOF robustbase/vignettes/plot-fig-pred-points.pdf0000644000176200001440000004717513465050122021125 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180746) /ModDate (D:20190509180746) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 16036 /Filter /FlateDecode >> stream xŝˎ%ɑ.$4HT H`V#͂` rחE<]l-#ا^xM2tV,]U`[:Τy| S-X7.#+Μ*:UꙓCscT/ r$SEYW6͋r9'9)8{UXLT%sPAR9Yu%S4A'*;ZdJ9o( D ( Xփ'Ϯj-gX :xQ (!wRpzQ7hO"WAG}tϫ+Оa E]KSl6QDr>(!G13dZ>(W| T/᥌JF4V~Ph8\bңUA5@ƪsrP {?T4Z-4G9(N"](5߃0v n߃a5bE!v(Rh~;j7PAUPC@oAjA\T%#2qy-,U2dV[- )= -$ [ !,p6[,vm未Y54ǭ;G7\AHAnJ"N^"Ffro\+Y}ֆՎg]㴯EV 7V7e;>U udu^a1шEc +:bm&,Vҿ BH|t"Dkd]*w,u8Rm_U.+"J12bIg'YW$,T뚙Qa]4'DrF@I"\PT /Ft~䪖[ɛ,LRCXa;Y*ݎ7[FlXRm|W^*cFxnjR&.v&ߍ]).sAI^Xv HNlϻhHO O2M!8 }[DV/7 OYt` qoǂSpȧmWDMA*-AYDYxriEۂ(IXREXI&/Du p铂P'Yތ7kĻD$j1f;nO)1'PpT}u &˟L_DWD# U,dMȺ5TmE͡B{cgw2k!uM 6yk"] s(xA\J^}~e|TD{b+ "T >9,*%Z6`Űpxaﯪ{~\1urx搜صF `07y |]7ba?Ʈ3ydeK6e[UWʕ\2g~f|Vxb|{{˶6 @8rbV50%+;. \m(C5u<yc\k[\xȃ")\/ȑ늜x 3En+rS^3}F-rO=%ܯsD5r}n)rכ<n;ry{8?xȭG.㓿_+{\K O91/pY< ;yB$pNC]=4Qvw1?w 0;|7QY|O+}`L>v v@y;J? 2PABC?OR^~K,7O?_~ӟџ?YqydOWw#/7UFi@ӣ(/=4;Vs GwlIf^膄 ]wUCUSMv"3_H̨ZLGA}n3STt!-k؟o,K|S/rqG=`Ox;}sLs7beɦM[Í=\uxzLy:mG4Nܵu D GQ6e״SzxA :%钠;ГI}gi=?rS s$M))WP~"LM.;vYΣXϷQ؟ߙVFJ~AgmsQ؞>YϨ,ϐ-+a_]{B ?q3dSߟvg 3Pv֋) tejZFխ*^~<tM%-SY;þ~|3ߏ}>ݪtvs5}u=h"?gCJ@s~?dџ0wu|vIל^=d>팳 nN$gfn1}dsJTs?uП0X:nRsIB]H{?-(( kN&^@fצ<+0NBl$,[tي9%wYa(I",a-!:"QL\\,V:/p*l$,;R p J[ɒ}ѬľicLQN}Pz ˦4Yd'Ȓ7"]-6kpX[~qg&a H2g' ɲ->v\;{: vQ$[o6[ZH]d¢|쪑h!/B2Enf I"Obp?H b!cX󈥭#lM#]d4"OB%;.(jb5Cd2/y:̿413:~#f| WcÊ7Rt$cum!fr#gߤ+yC[H.VC. }1X7W]/& XXiZ)1,ZTf}Hɚf625 lhYhOv.T32b55?&+c~mdMb}%܋0o# nZ,iwkf5;,_񾑂7MlmJ* }7F~ߴhE!فVGBydCjWy׮$x}^%e ICif)ڥ+|^މQGTyO6/^7>/\ :ER]8~ǎN{~S_rh 'rNNp>םl/pI^ÿ/sB:<3^z"o/8YϓE7Md"6O'a ¥T/w,~(׃ڀYQ:0=y*|KWy:aۼuw̯!O1 3ÿVyb3@V!fO,'YjW .q=.Y}ծq]"OX2]exxcAy`s9b1_^i?Vo< ~Cb# >vl;>/A5.3!1~~Po5LĔG Te؟bo70zTq?bKWAawA\1󻠈msvILW&J}WP!7=/I&'F!?e7YXBSP7L? SRb׏ù5R%0 hq٢vx%}E_D{ZO ܍UL+iYfbE1+*A(7K=Ӥ%&k; wa a/jX;}.*iX}Wfuv]HdW~X_u&JWSW"_( nw{u6./rzfb{EUFQl*kCȢʐxZe_?O15^yiUU 7Ÿh(4BR*dcov4)iY~5*O_,\Rl~ &n`'oA_w j++>舧&FjD +_"?Ko3Ϳٲy/xZfTXUf3SCسJ@?-lT`<@[dWy"&}YJ$fW;.?eo G0W#pwnjZCz#rokx5rKs{92#yw O7^{D{AOx=r'+ӟ쯗"}EsKȑ"y?9Q/{-r'LjXx"yzsW\x~sW\Oyn;rW\݌ O\z~"{o7xz=yȭE.zc<=>O~[칥9\oY>#)o =91fۈ\j7,s-[=:#}5c<<}5c<oQ_OzDA_OzGAfY= O3Ӭ^siV9ӌ47ixճz4bN yAst8=NW{׆/.y ˲}_uk{gw;qua쌻a쌻a쌻]ؕҁ]_* }ٟ ?c6|3Z7agdZ^֯W%bxy|?sg?;I?dg ݳ8JʚYY@髅BSf;3:ܝ |}{}h>GM4_7V}L~Na޿O{'}{mGum]@w\S@ x/Fj-f@w| e=q/F75%[$:}]wt:t%q $>f@w791'mNDw|bˎMN4{6:k+hMQrp6g%t e&#n3ZH8gk2UgX;)`GL+LqjZYv5cNVmmX>x+ewbGe-|Yl($xڈa o$Pgue5ioM<2a3]G󚵥My,}'mκlmM=Voڌ _Dz6)(c&eAIc[դA)|#}M"A$} |+Yø_gbC3q$SsZ"Q,r j^7v]$iS*#&]\y46hY;;,7<:.^"V+{9?"ߍx~s1fUJ괫U1+Uva PZQlWAr.4^UCoYpicnwL,Z] q5Zs3d>ѭӛc'Sݨ/ 8 #גWYML%УFX ; n? "ݮJ QGVF]юv(jM)6VqJA 冣zk]*72*!*Rj $4 ejh,6|WS"7jûoՖeyE"d vKL6.S9bJh":5aE7}蘪3 `Ѿ'iZWdp} gX}VQhҐ.%\ 7u) 1jU/5CCC/_hү!Mo% @~ƚz~}ƽ"kakC~p% _mq7m 8rD{a{8[.R\~,rӽj ]X|w'FwM'R4q[$; >[р4Eĥ(:KPx`n'o((e Dc1oW/* YsXڅ]50StM ˆg5P7yGC}i.TKpPKTl5Nak8{OR<v-{(ح¨)V;:bT_8cCW(ґCoGz_5:3644TDCCCs 7.glt؟Im⪷3644t9cy9ccbihhrƆVU6csRTP1.)`r״'ԇ>'E/,iyWznd&U/U^"PR9954$X#6xS .gljh$S۾XQ ]'D7gDa#cQ`^ u;ch|9cSCC3ӗ3ؗ3f'9h!8s$36'/ݤv؜I 4/hh]DIDNĬd[ 8i[/0ZU^*fq95#`s0V3kXf8v;cu-59559`og \5i/Z5]uv]ӵkHлBCлBCлBCD;ЅFVzt#J%sau{#iߡ݂kQлkZۭv7ѨD#ݪ`w UF6 %Lkpg=ړ'׿p>bܓs/T ߽({q 7 "{5ٛe'C vQPgKa Tz5Շ#&8ң)0o܀'!9yp]cq\&P=[oW nރE|p {|qM]qw:EG=o7>8K7 "eKXY<,j’aAf*5W22Q%CCdRC4%k|k}_ }Z_XXBzѸz%s,. w8PCdfqXS@dfdxǣ n,2epǾz@/lEΣ lׇm7[>lJ~ho6m)efCa?$< I$xH3);;;qЋƝta̝,މ"̕drWʅ^-zѸc.J+!B/W2υ2ȡL"0,ɡW25+BCLL !cyJ}k|q9^6ȺڻMf}WYMf}WY;v7sEɷy+~Xڳ{[C){+o(u) ` /Jq_7_Gj|3~~,I߯&'~Ua=t~W~ͪקxL$O>v˧lu)JN `rN? )ٍX\Mvu获n|<$b8}R˘sVkq]RȔGwpޝsw]^ǁܠ8û7kYї*\)3VGhͲe'Xem#}o>EGݗ!=CGQ=z}@ xv?Ոendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font << /F1 10 0 R /F2 11 0 R >> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F1 /BaseFont /ZapfDingbats >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000016401 00000 n 0000016484 00000 n 0000016608 00000 n 0000016641 00000 n 0000000212 00000 n 0000000292 00000 n 0000019336 00000 n 0000019593 00000 n 0000019677 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 19774 %%EOF robustbase/vignettes/psi_functions.Rnw0000644000176200001440000004152413012615634020015 0ustar liggesusers\documentclass[11pt, a4paper]{article} \usepackage[a4paper, text={16cm,25cm}]{geometry} %\VignetteIndexEntry{Definitions of Psi-Functions Available in Robustbase} %\VignetteDepends{robustbase} \SweaveOpts{prefix.string=psi, eps=FALSE, pdf=TRUE, strip.white=true} \SweaveOpts{width=6, height=4.1, echo=FALSE, fig=TRUE} %% --------------------- !! \usepackage{amsmath} \usepackage{amsfonts}% \mathbb \usepackage{natbib} \usepackage[utf8]{inputenc} \newcommand{\abs}[1]{\left| #1 \right|} \DeclareMathOperator{\sign}{sign} \newcommand{\R}{\mathbb{R}} \newcommand{\code}[1]{\texttt{#1}} \newcommand*{\pkg}[1]{\texttt{#1}} \newtheorem{definition}{Definition} %% The following is R's share/texmf/Rd.sty \usepackage{color} \usepackage{hyperref} \definecolor{Blue}{rgb}{0,0,0.8} \definecolor{Red}{rgb}{0.7,0,0} \hypersetup{% hyperindex,% colorlinks={true},% pagebackref,% linktocpage,% plainpages={false},% linkcolor={Blue},% citecolor={Blue},% urlcolor={Red},% pdfstartview={Fit},% pdfview={XYZ null null null}% } <>= # set margins for plots options(SweaveHooks=list(fig=function() par(mar=c(3,3,1.4,0.7), mgp=c(1.5, 0.5, 0)))) ## x axis for plots: x. <- seq(-5, 10, length=1501) require(robustbase) <>= source(system.file("xtraR/plot-psiFun.R", package = "robustbase", mustWork=TRUE)) @% = ../inst/xtraR/plot-psiFun.R --> p.psiFun() --> robustbase:::matPlotPsi() {for nice legends; lines ..} \begin{document} \setkeys{Gin}{width=0.9\textwidth} \setlength{\abovecaptionskip}{-5pt} \title{Definitions of $\psi$-Functions Available in Robustbase} \author{Manuel Koller and Martin M\"achler} \maketitle \tableofcontents \section*{Preamble} Unless otherwise stated, the following definitions of functions are given by \citet[p. 31]{MarRMY06}, however our definitions differ sometimes slightly from theirs, as we prefer a different way of \emph{standardizing} the functions. To avoid confusion, we first define $\psi$- and $\rho$-functions. \begin{definition}\label{def.psi} A \emph{$\psi$-function} is a piecewise continuous function $\psi: \R \to \R$ such that \begin{enumerate} \item $\psi$ is odd, i.e., \ $\psi(-x) = -\psi(x) \: \forall x$, \item $\psi(x) \ge 0$ for $x \ge 0$, and $\psi(x) > 0$ for $0 < x < x_r := \sup\{\tilde x : \psi(\tilde x) > 0\}$ \ \ ($x_r > 0$, possibly $x_r = \infty$). \item[3*] Its slope is $1$ at $0$, i.e., $\displaystyle \psi'(0) = 1$. \end{enumerate} Note that `3*' is not strictly required mathematically, but we use it for standardization in those cases where $\psi$ is continuous at 0. Then, it also follows (from 1.) that $\psi(0) = 0$, and we require $\psi(0)=0$ also for the case where $\psi$ is discontinuous in 0, as it is, e.g., for the M-estimator defining the median. \end{definition} \begin{definition} A \emph{$\rho$-function} can be represented by the following % definite integral of a $\psi$-function, \begin{equation}\label{def.rho} \rho(x) = \int_0^x \psi(u) du\;, \end{equation} which entails that $\rho(0) = 0$ and $\rho$ is an even function. \end{definition} A $\psi$-function is called \emph{redescending} if $\psi(x) = 0$ for all $x \ge x_r$ for $x_r < \infty$, and $x_r$ is often called \emph{rejection point}. Corresponding to a redescending $\psi$-function, we define the function $\tilde\rho$, a version of $\rho$ standardized such as to attain maximum value one. Formally, \begin{equation} \label{eq:tilde-rho} \tilde\rho(x) = \rho(x)/\rho(\infty). \end{equation} Note that $\rho(\infty) = \rho(x_r) \equiv \rho(x) \ \forall \abs{x} >= x_r$. $\tilde\rho$ is a $\rho$-function as defined in \citet{MarRMY06} and has been called $\chi$ function in other contexts. For example, in package \pkg{robustbase}, \code{Mchi(x, *)} computes $\tilde\rho(x)$, whereas \code{Mpsi(x, *, deriv=-1)} (``(-1)-st derivative'' is the primitive or antiderivative)) computes $\rho(x)$, both according to the above definitions. \textbf{Note:} An alternative slightly more general definition of \emph{redescending} would only require $\rho(\infty) := \lim_{x\to\infty}\rho(x)$ to be finite. E.g., \texttt{"Welsh"} does \emph{not} have a finite rejection point, but \emph{does} have bounded $\rho$, and hence well defined $\rho(\infty)$, and we \emph{can} use it in \texttt{lmrob()}.\footnote{E-mail Oct.~18, 2014 to Manuel and Werner, proposing to change the definition of ``redescending''.} %% \section{Weak Redescenders} %% \subsection{t_nu score functions} %% t_1 (=Cauchy) has been propagated as "Lorentzian merit function" %% regression for outlier detection \paragraph{Weakly redescending $\psi$ functions.}\ Note that the above definition does require a finite rejection point $x_r$. Consequently, e.g., the score function $s(x) = -f'(x)/f(x)$ for the Cauchy ($= t_1$) distribution, which is $s(x) = 2x/(1+x^2)$ and hence non-monotone and ``re descends'' to 0 for $x\to \pm\infty$, and $\psi_C(x) := s(x)/2$ also fulfills ${\psi_C}'(0) = 1$, but it has $x_r=\infty$ and hence $\psi_C()$ is \emph{not} a redescending $\psi$-function in our sense. As they appear e.g. in the MLE for $t_\nu$, we call $\psi$-functions fulfulling $\lim_{x\to\infty}\psi(x) = 0$ \emph{weakly redescending}. Note that they'd naturally fall into two sub categories, namely the one with a \emph{finite} $\rho$-limit, i.e. $\rho(\infty) := \lim_{x\to\infty}\rho(x)$, and those, as e.g., the $t_\nu$ score functions above, for which $\rho(x)$ is unbounded even though $\rho' = \psi$ tends to zero. %% --> ../../TODO section 'Psi/Rho/Chi/Wgt Functions' %% ~~~~~~~~~~ %% %% FIXME: where?? MM: can no longer find it in Hampel et al(1986) \citet{hamfrrs86}. %% FIXME: 0) Mention our psi_func class // and the C interface for "the other" functions %% ----- i.e., we currently have *both* and in addition there is all %% the (to be *deprecated* !) ../R/biweight-funs.R (& ../man/tukeyChi.Rd & ../man/tukeyPsi1.Rd) %% %% FIXME: 1) explain plot() {the plot method of psi_func} %% FIXME: 2) Show how to compute asymptotic efficiency and breakdown point: %% ------- %% a) end of ../../tests/psi-rho-etc.R has aeff.P() and bp.P() and chkP() %% which now uses the psi_func class to compute these *analytically* %% b) Of course, Manuel had used the numeric integration only, %% in ../../R/lmrob.MM.R, lmrob.efficiency(psi, cc, ...) and lmrob.bp(psi, cc, ...) %% ~~~~~~~~~~~~~~~~~~ %% c) *REALLY* nice general solution is via PhiI() in ../../R/psi-rho-funs.R %% for all piecewise polynomial psi()/rho() ~~~~~~~~~~~~~~~~~~~~~~ %%\clearpage \section{Monotone $\psi$-Functions} Montone $\psi$-functions lead to convex $\rho$-functions such that the corresponding M-estimators are defined uniquely. Historically, the ``Huber function'' has been the first $\psi$-function, proposed by Peter Huber in \citet{HubP64}. \clearpage \subsection{Huber} The family of Huber functions is defined as, \begin{align*} \rho_k(x) = {}& \left\{ \begin{array}{ll} \frac{1}{2} x^2 & \mbox{ if } \abs{x} \leq k \\ k(\abs{x} - \frac{k}{2})& \mbox{ if } \abs{x} > k \end{array} \right. \;,\\ \psi_k(x) = {} & \left\{ \begin{array}{ll} x & \mbox{ if } \abs{x} \leq k \\ k \ \sign(x)& \mbox{ if } \abs{x} > k %% -k & \mbox{ if } x < -k \\ %% k & \mbox{ if } x > k \end{array} \right. \;. \end{align*} The constant $k$ for $95\%$ efficiency of the regression estimator is $1.345$. \begin{figure}[h] \centering <>= plot(huberPsi, x., ylim=c(-1.4, 5), leg.loc="topright", main=FALSE) @ \caption{Huber family of functions using tuning parameter $k = 1.345$.} \end{figure} \bigskip \section{Redescenders} For the MM-estimators and their generalizations available via \texttt{lmrob()} (and for some methods of \texttt{nlrob()}), the $\psi$-functions are all redescending, i.e., with finite ``rejection point'' $x_r = \sup\{t; \psi(t) > 0\} < \infty$. From \texttt{lmrob}, the psi functions are available via \texttt{lmrob.control}, or more directly, \texttt{.Mpsi.tuning.defaults}, <>= names(.Mpsi.tuning.defaults) @ %$ and their $\psi$, $\rho$, $\psi'$, and weight function $w(x) := \psi(x)/x$, are all computed efficiently via C code, and are defined and visualized in the following subsections. \clearpage \subsection{Bisquare} Tukey's bisquare (aka ``biweight'') family of functions is defined as, \begin{equation*} \tilde\rho_k(x) = \left\{ \begin{array}{cl} 1 - \bigl(1 - (x/k)^2 \bigr)^3 & \mbox{ if } \abs{x} \leq k \\ 1 & \mbox{ if } \abs{x} > k \end{array} \right.\;, \end{equation*} with derivative ${\tilde\rho_k}'(x) = 6\psi_k(x) / k^2$ where, \begin{equation*} \psi_k(x) = x \left( 1 - \left(\frac{x}{k}\right)^2\right)^2 \cdot I_{\{\abs{x} \leq k\}}\;. \end{equation*} The constant $k$ for $95\%$ efficiency of the regression estimator is $4.685$ and the constant for a breakdown point of $0.5$ of the S-estimator is $1.548$. Note that the \emph{exact} default tuning constants for M- and MM- estimation in \pkg{robustbase} are available via \code{.Mpsi.tuning.default()} and \code{.Mchi.tuning.default()}, respectively, e.g., here, % \begin{small} <>= print(c(k.M = .Mpsi.tuning.default("bisquare"), k.S = .Mchi.tuning.default("bisquare")), digits = 10) @ % \end{small} and that the \code{p.psiFun(.)} utility is available via %\begin{small} <>= <> @ %\end{small} %\enlargethispage{3ex} \begin{figure}[h] \centering <>= p.psiFun(x., "biweight", par = 4.685) @ \caption{Bisquare family functions using tuning parameter $k = 4.685$.} \end{figure} \clearpage \subsection{Hampel} The Hampel family of functions \citep{hamfrrs86} is defined as, \begin{align*} \tilde\rho_{a, b, r}(x) ={}& \left\{ \begin{array}{ll} \frac{1}{2} x^2 / C & \abs{x} \leq a \\ \left( \frac{1}{2}a^2 + a(\abs{x}-a)\right) / C & a < \abs{x} \leq b \\ \frac{a}{2}\left( 2b - a + (\abs{x} - b) \left(1 + \frac{r - \abs{x}}{r-b}\right) \right) / C & b < \abs{x} \leq r \\ 1 & r < \abs{x} \end{array} \right. \;, \\ \psi_{a, b, r}(x) ={}& \left\{ \begin{array}{ll} x & \abs{x} \leq a \\ a \ \sign(x) & a < \abs{x} \leq b \\ a \ \sign(x) \frac{r - \abs{x}}{r - b}& b < \abs{x} \leq r \\ 0 & r < \abs{x} \end{array} \right.\;, \end{align*} where $ C := \rho(\infty) = \rho(r) = \frac{a}{2}\left( 2b - a + (r - b) \right) = \frac{a}{2}(b-a + r)$. As per our standardization, $\psi$ has slope $1$ in the center. The slope of the redescending part ($x\in[b,r]$) is $-a/(r-b)$. If it is set to $-\frac 1 2$, as recommended sometimes, one has \begin{equation*} r = 2a + b\;. \end{equation*} Here however, we restrict ourselves to $a = 1.5 k$, $b = 3.5 k$, and $r = 8k$, hence a redescending slope of $-\frac 1 3$, and vary $k$ to get the desired efficiency or breakdown point. The constant $k$ for $95\%$ efficiency of the regression estimator is $0.902$ (0.9016085, to be exact) and the one for a breakdown point of $0.5$ of the S-estimator is $0.212$ (i.e., 0.2119163). %% --> ../R/lmrob.MM.R, .Mpsi.tuning.defaults .Mchi.tuning.defaults \begin{figure}[h] \centering <>= ## see also hampelPsi p.psiFun(x., "Hampel", par = ## Default, but rounded: round(c(1.5, 3.5, 8) * 0.9016085, 1)) @ \caption{Hampel family of functions using tuning parameters $0.902 \cdot (1.5, 3.5, 8)$.} \end{figure} \clearpage \subsection{GGW}\label{ssec:ggw} The Generalized Gauss-Weight function, or \emph{ggw} for short, is a generalization of the Welsh $\psi$-function (subsection \ref{ssec:Welsh}). In \citet{ks2011} it is defined as, \begin{equation*} %% \label{eq:ggw} \psi_{a, b, c}(x) = \left\{ \begin{array}{ll} x & \abs{x} \leq c \\ \exp\left(-\frac{1}{2}\frac{(\abs{x} - c)^b}{a}\right)x & \abs{x} > c \end{array} \right. \;. \end{equation*} Our constants, fixing $b=1.5$, and minimial slope at $- \frac 1 2$, for $95\%$ efficiency of the regression estimator are $a = 1.387$, $b = 1.5$ and $c = 1.063$, and those for a breakdown point of $0.5$ of the S-estimator are $a = 0.204$, $b = 1.5$ and $c = 0.296$: <>= cT <- rbind(cc1 = .psi.ggw.findc(ms = -0.5, b = 1.5, eff = 0.95 ), cc2 = .psi.ggw.findc(ms = -0.5, b = 1.5, bp = 0.50)); cT @ Note that above, \code{cc*[1]}$= 0$, \code{cc*[5]}$ = \rho(\infty)$, and \code{cc*[2:4]}$ = (a, b, c)$. To get this from $(a,b,c)$, you could use <>= ipsi.ggw <- .psi2ipsi("GGW") # = 5 ccc <- c(0, cT[1, 2:4], 1) integrate(.Mpsi, 0, Inf, ccc=ccc, ipsi=ipsi.ggw)$value # = rho(Inf) @ \begin{figure}[h] \centering <>= p.psiFun(x., "GGW", par = c(-.5, 1, .95, NA)) @ \caption{GGW family of functions using tuning parameters $a=1.387$, $b=1.5$ and $c=1.063$.} \end{figure} \clearpage \subsection{LQQ} The ``linear quadratic quadratic'' $\psi$-function, or \emph{lqq} for short, was proposed by \citet{ks2011}. It is defined as, \begin{equation*} \psi_{b,c,s}(x) = \left\{ \begin{array}{ll} x & \abs{x} \leq c \\ \sign(x)\left(\abs{x} - \frac{s}{2b}\left(\abs{x} - c\right)^2 \right) & c < \abs{x} \leq b + c \\ \sign(x)\left(c+b-\frac{bs}{2} + \frac{s-1}{a} \left(\frac{1}{2}\tilde x^2 - a\tilde x\right) \right) & b + c < \abs{x} \leq a + b + c \\ 0 & \mbox{otherwise,} \end{array} \right. \end{equation*} where \begin{equation} \tilde x := \abs{x} - b - c \ \ \mathrm{and}\ \ a := (2c + 2b - bs)/(s-1).\label{lqq.a} \end{equation} The parameter $c$ determines the width of the central identity part. The sharpness of the bend is adjusted by $b$ while the maximal rate of descent is controlled by $s$ ($s = 1 - \min_x\psi'(x) > 1$). From (\ref{lqq.a}), the length $a$ of the final descent to $0$ is a function of $b$, $c$ and $s$. <>= cT <- rbind(cc1 = .psi.lqq.findc(ms= -0.5, b.c = 1.5, eff=0.95, bp=NA ), cc2 = .psi.lqq.findc(ms= -0.5, b.c = 1.5, eff=NA , bp=0.50)) colnames(cT) <- c("b", "c", "s"); cT @ If the minimal slope is set to $-\frac 1 2$, i.e., $s = 1.5$, and $b/c = 3/2 = 1.5$, the constants for $95\%$ efficiency of the regression estimator are $b=1.473$, $c=0.982$ and $s=1.5$, and those for a breakdown point of $0.5$ of the S-estimator are $b=0.402$, $c=0.268$ and $s=1.5$. \begin{figure}[h] \centering <>= p.psiFun(x., "LQQ", par = c(-.5,1.5,.95,NA)) @ \caption{LQQ family of functions using tuning parameters $b=1.473$, $c=0.982$ and $s=1.5$.} \end{figure} \clearpage \subsection{Optimal} The optimal $\psi$ function as given by \citet[Section~5.9.1]{MarRMY06}, \begin{equation*} \psi_c(x) = \sign(x)\left(-\frac{\varphi'(\abs{x}) + c} {\varphi(\abs{x})}\right)_+\;, \end{equation*} where $\varphi$ is the standard normal density, $c$ is a constant and $t_+ := \max(t, 0)$ denotes the positive part of $t$. Note that the \pkg{robustbase} implementation uses rational approximations originating from the \pkg{robust} package's implementation. That approximation also avoids an anomaly for small $x$ and has a very different meaning of $c$. The constant for $95\%$ efficiency of the regression estimator is $1.060$ and the constant for a breakdown point of $0.5$ of the S-estimator is $0.405$. \begin{figure}[h] \centering <>= p.psiFun(x., "optimal", par = 1.06, leg.loc="bottomright") @ \caption{`Optimal' family of functions using tuning parameter $c = 1.06$.} \end{figure} \clearpage \subsection{Welsh}\label{ssec:Welsh} The Welsh $\psi$ function is defined as, %% FIXME: REFERENCE MISSING %\def\xk{\frac{x}{k}} \def\xk{x/k} %\def\xkdt{-\frac{1}{2}\left(\xk\right)^2} \def\xkdt{- \left(\xk\right)^2 / 2} \begin{align*} \tilde\rho_k(x) ={}& 1 - \exp\bigl(\xkdt\bigr) \\ \psi_k(x) ={}& k^2\tilde\rho'_k(x) = x\exp\bigl(\xkdt\bigr) \\ \psi'_k(x) ={}& \bigl(1 - \bigl(\xk\bigr)^2\bigr) \exp\bigl(\xkdt\bigr) \end{align*} The constant $k$ for $95\%$ efficiency of the regression estimator is $2.11$ and the constant for a breakdown point of $0.5$ of the S-estimator is $0.577$. Note that GGW (subsection \ref{ssec:ggw}) is a 3-parameter generalization of Welsh, matching for $ b = 2 $, $ c = 0 $, and $ a = k^2$ (see R code there): <>= ccc <- c(0, a = 2.11^2, b = 2, c = 0, 1) (ccc[5] <- integrate(.Mpsi, 0, Inf, ccc=ccc, ipsi = 5)$value) # = rho(Inf) stopifnot(all.equal(Mpsi(x., ccc, "GGW"), ## psi[ GGW ](x; a=k^2, b=2, c=0) == Mpsi(x., 2.11, "Welsh")))## psi[Welsh](x; k) @ \begin{figure}[h] \centering <>= p.psiFun(x., "Welsh", par = 2.11) @ \caption{Welsh family of functions using tuning parameter $k = 2.11$.} \end{figure} \bibliographystyle{chicago} \bibliography{robustbase} \end{document} robustbase/vignettes/plot-fig-lqq-level.pdf0000644000176200001440000006226713465050120020560 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180743) /ModDate (D:20190509180743) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 21405 /Filter /FlateDecode >> stream xݽM:_*A|Y4jTe 7ݣnehʤ/M 02ޫZd= I8_|{Y^J^u~/?|I%O~w,__KRsoܿ^㵦ך_Zy=Op//({`y״Kk~e58d(-dQȠ8dk[B!3(1hP2ө2 kcZb9K_bPaަCzZԉg 9,!ؘr3py568:4ű:4űuZŒu1B,P&R 8Yx(U/n3ca3З@_~3oAk6ruS隴u[jwL۾n* /Zx[9o;Oe?nKOEDgd_`n)A?N$wV_jڤ[f™[? gDw u9~™^~™?׆׎"pLd}M9ZP,S.X }8Xؤ™Zyc5Xji[`pJg꺽frXϊ=ygjM?  Ut9jNs>SUoSׄWXWuųY5I 6ge< Ń :m`2뎗6 3)tM_8u]$a' әk$V <(w>ôhVsO_~Sh7dwgn; T9h Us('OfZBx`cxWǎqФS):bxLe#P1"zL^0oTn1GK(L嵹# bxH^{-]L^]cx^:3op@ϯ-p[=UAg5$Τ5wSxqYCye5&[>꺁47m[:܍h2U{1ֳwJ;Qce:c!c=ˮu+be:]2I*[Q?GcEYC_Ysd7M7PdnQQpB'#(tBYC;1]u@t+be:Z6i/Pp~,؅n3ebVy)\җac{&R ݢBbxRL᫇p@΀j _×JoTnu4S>鋌v}!<\l^}ݓUyV1<|HK^{'8bxzJ/m^{E%k6cuGٸqXLN2{:f>>Rܽף.##B7 =><,<XxH1:wH~ Pru=2^R oC{Y{9^'8׎^ #.RMZ5+/8V L{{=w~]>:@=1P@ίmq"CUAr׹{D &^B)vA{VB^~K-%Cxw֜|I^:+ :&b }LB©yqWjP@2S^![P(-7(489]SDw0"ИQ489]^)Th@oU>%(9OTByso]YjhYfe=r89Mq8NKu~ Jza(@FccH/?8/; xMX"ÌU Ʋkl ݭcv:=GcJl]~d{)&;4Imc#5做ů$=rSK.],ϱ5F $lk;6 (oCu)d6<g8CrAy!y=!8!a+c1C!Ft(dtv7jݚ dw[:aO' {-ᐃnAs\%8Ĝ{qC{}ob@ 'Śk5nDvt-0^h!ݞxI=~yؾ}v{S|oث Ϝ<[DjvE&]?<;t'< ~}w=Ƿc߄`ς/Lhg&4>_f68Ng'>U®ɳ'{{e~|{H!;ߛؙ|zv8= ¦dp-"k61,v8Ne,xOfaz~Zg;AY:ܟ`o<'{[JпSn v°̄7솔&qc{'YF_j#]>{'YWc82ƑnSCS)2A|})p޷ Rzk:8g AZfMZ;Va|oR {iJH6T9[$ ;pQ;|o*kd)!X@k/+B􂹧rw }0*7K?Qc*jl3ϴ*F_oٿeJ7i䫙|VtpaM֐\Y{ͲXug[ᶙN ;}O}kU XX(kHuXLePf\/~{L.b- s=,_Xk.u b-C-xlcjX{}׽X/kju+beG~{kJ| Lz#J), NY &W´*ZK7*7z-bxho7n/A ^Q"'1ިʏm_2Sڛ#17Bhc4cxUr:hZJoTn;tCƆzuqk~K'\bH){K MyJodZNT~̷ίNahrYz UAZ*\[Jd)Cx|r)6G KɝL c*݃\[X[KP5 !A@SwȀ T/쭎{4g|o~Qq[S[qAZfM@vJΒF%ZK7{{t=d2G37 =pwQkhtr;|oe>e+,b,<2<t7/$iqXXhP{H7{NY|)v#)37K!Cx`72_R;Y)Q-m.%.E+d. |omMMWl7E7G8Cf|o)7fjN\bp3n [+ګ,f61>^{},L Wgwu|`?{K#_kg2&|n3e`fk|oi G`cG ;D m㽚hضha`f]_1p[X6[C ;YYƎǛmP-Աho?C|oQWA{=cLu?;;MͷRk3 ]~tV$[ZЎĺv!/} [Ǡ޵7 utVX؃Sx\6[{R-(lq ݰ*{xI~-N^;=<[i La,)${km 9!rmꦂ3L(;g|om5(\A75m 0B|oCoCi{|FT5]g7ҡp?,9hN g8[uV_|}q{@az6ۺsq`|o5+-^رc;h2ffc:[}{<k .5a 4cp{ Y|k#{mR@VloTmN=?K@m#uɀ=yKx1y#g˓GؓwK&yr[Ȓ3Hs|x'h|`%vf7*ƈg* ͶF*POM S}n$t۟=}Bv3kVٖnvjzfW0pե^ ;aؖHꩶ!7RBn,"n˘s4s?HnZrKno6I4O>uU, ]~D{kKPW1umB̬{(Kמ+OϠtذHyvXl|z-;]"]7r\x-Wt*{P2!'%z^7`׿03 W f"oMψ vt|X0ߝ4%Rw۠X?!#ywgV )G+L~у&kně6 #ԇ="`2ѿ;tj&utj:Bc=wiZgI@VB""ubہwCDH(#XrH{=Q0"M͓yL lTpI)Gw..l] $/ L-@.z'XOl3tH(1@ZCx#yV!bbI=>~BF*/T&wV 09^n5i)*ߪ/D67}ɖDٰ I8L/_oDٸ VF>e|զo,BDgVN1M ~Q9(nJ[H ݡ,XGh" ! ^g~\! Qm=ƈjQ6w,1׺/݊;D4}tU%@FG4biso07<~w'ӔIV}鶡)rt-pr*SV4{;ה|eEʛ2K}m! >@&w~ oʪ `w_ڵ {ϐkÎ`ubx8/S& W9fEAsRi֕da]M4Y֟$a{f M4Ȇ3(hްvM؏4+ u}޷>U׼4U})öٶG~yF;J ߸6Ct`4umm.Y l|R[yJRl;0Ny0HMV,M SkԦKh+k{ ͓^L$ %khkFm,)jQn>_-lCmh[؏&K0k3t{$)uǒF?\~oP}]KWX1T'<;z{*48O=u] «la W14g <먍,.kK}+gᾸO}j<4Aά*a]޺b1џK-Öہ9:o]Vѵ`31]lWcltȔqŗa 53xuU~kg[>K#˾||YXI!S99do-rXQ99HCsdt{KR{1ygr+59 k&9d}39hks쇮<!y-<p٩(؁cvF豵4Lxk᪞6P-lC=r0q!Vw>X1ǡǧr{Ez%!'Xۼ`YE, ĎgHx%˿ͯ4vGo~20\b`VtX8s/ev6wQlL6=xC8 -qC>e}P'KΕK'vYyˮև;Lخ7upL}},x G/s[^/7znn@*h67?wlnm1۪^Ćþ&vp'x̺psc6vvDʜ.,*N`c&fc_6+qpa=vuyd=oE^ ^:Gq]Xox6ڃ6Hpt0ͺZq肧27L'pSy sdݩcc+P~EZPxν1 DaOW_ٔHHY1]7rö/F'IY9*BXbXLc8dW]&hbNO)d\Lxeö%cW? .KXnz`KS!V/F']&m2mʾ2cM%ƚXۆڹV4t5~q_մV=V0Wtt5WaadC?i xLW%cM-n vv(_Ml=(?m2,nX!V/FWIQ_ѹ1qX(KO2bQ^@1VK_~ݯ&s:Ċܞhݟݞ/5{mھnu c+@ #cb 'A{&í.Ke+@nm3~Q6=~Lx ߑ' WkdծIY?;_i)eߓ.cܮcX5jzXs:+we==~7W~0sdQоUOà!4jsLckWlnɾtEFQWm2a?Y/mpdd="Xhq{(bEzg>ƚ9m: 2ݣ;'PZc ˗do@Ckl 83=0P}0h=^V}QK ߯~\=&(q.E ^KaDyjL"ԭ'zrԞN(Sd_Lc2#%vmy.9{Qn,v_ѓ^f$ㇻLg,%Z%nWnteYw7w,7ۖL6=6 VM؃=v4jպk@V Y )]lf:l#s!NZ[.凌t*h2vp kXECO9t7`a&ػdl\/t^g{^fǀ+]7?m){8ufa-,z7i-3/ҟj3mB2^[yY(scAHܚn.MsYƿfAXI9X['w~T -3i 6|]tqYp֚&@ hmYWM݂ƒB3-9>[y`-ªZ }-Son֖V<{Jr#V a.ʼ=TY=݂h!exͲߩ`e`*qk^tz0 د[VnaԱpSFu*=_Y('>b2=sj_c(sy쮓xI:LgN9 l\rn؃Ly>mxہLPNsLYA':fF*h;3_f7|c =#hYz\xvf×qiAkixv&(Jt:ggDeD5RVl6ni tb4<>Mg^s!t. IiYBT䛯pyW\9ߦM>úγ.KixG44wY:ϲ=/oRΝJ8"m497=%|kڻ/׺=G4}``o!q{\qt [os rK;8У}zoBٙ-CMWb8=G+xȱEh96[9=Ps.1Z!ž|caqc*NG9!_s !sFȷC=qqIȗX1v;+[ CYo-8+RhC '%s|/P~${␃|Aʏ|/?␃|As|oq<=OȧG ̝dN$snby!A)h#qUÅZrM~B4OrE]ncFH@'ƅ^X/<+.uwBރ 7rPJ9SGV B@86+ dž ǖ 4S9dNM=? BF'iB`cOۑ]=!{2֮y7B~fN2OyaF0|+剻|Y3 6ve6V*u~agxBȗq Dvb'!Hay۫kCX(KTU"{.RsXn[|eiUصۓPw(jdm9WV )ۊ6vL_1߷jWޟ +ɞde%Ww$e~mK_~"nb`X-,Q=J;ewqe߷f>%1cRފe"޶2ƺe$.KXqDe3(nӯŎ~"˓s="YI8q(-c 5ԼaW-:`/g5L_EOvX[cfOF/ce@i>%DPgnU=EZ藣-E1V#F.v٪mtWof ߷uE%1E%cg]d1dN ;}HfjbK_*Q 3{]({ɮ1 .t]Nf:l!_b-͉:zm#%Jޯ,:3KقM(j[|}1VXufcS!Knm,ȀO2XJRP(6؞"KvŤy?XDSӂ]xиGYHS͟?B~/nm1X [)O2'N5'Ts=kTsZBM@'6i[>E$ O:;RR-=h3ӄ|y@'TsM=M !VZ[8hh Ї`ay S9qZKf50 тo?Eȗ'e=bO׸Ϸ#O76-d[b8bK`f2vR|ytJQ|ѹ/F[=!:tN|!@E)]8 f93] gՠSQKi!_bs]' B!PZ;)]cZ ;AȗHO8Ʈ4|`%Lxft yBȗ4::e83R3R|3A,.ACƭM' Bs{~!_/BQ$s 2|\>i./ӄ|y[[}7V僽h !_{n y=P/u8b)B[=͎Gך>/ h9!pCz۰!]N=w\.ac}z,=77_ft,\;O?$"0PQGμ?|tn3H' ={%>7P `m)ᵍ3%Bmgm׶XuҮ8J\[iҲ]m{ҲYZ!ݖ 2\X_X(8p@fdnw إflRlpՁȼ]/|¨JS w7?aׄ^M!BVUOgTtn< @wg.c?a jp#՝ o[úlSNxc o0qά Sm nkm y6|\/=agH_qA33 |[ޤf 0 @7sT|jf7XX r-Y)\`\xŽ0uEй[7xvJ gXGtǨ?יe.;>ayA?΂~ya%̉*@k7HrWӜZo(M (|E~5E/Gm: gm=U>^ Bx oiw/<_8tڣ#Cxiɝgr݅9TxC-Rjoq2]=jou kV{K [Z(B[C-F_okCK=֍ d_;6 R 傯; J3SMF=͑fT2sr5 V~ bxL7 <%(l"A  T uv!n([l%HI\]}۰%@KΝ߆wi Cj(4_o1Էd.`2-[T%@i\UZR 傯Hg_91}(Y`r5'.8*1P.zn#is0EfvO) *d*\Ge?@c_Jʘf7Yev[ܴO@.Obv}U];`ԎbM{=tb]yheԍr^Lsնb{;5S5S{> |.e^;&,6ebxԺv]^,k߫4ϲwl\ ]a[^~o?>_fz ͏5ie66Jo+rގ ocTW4l*ܯg0bg+Y`LlM{㑪CS]M>ho ;YT_jcئuv]+ (&Z'Aͮն'„sMa> /[7òcR*4x}-I衇z #HqW3p ޠcŨvP\f op1 q n76sFB7XحaDdԇxoPOJ3x=Bk|~Dk3 VKy]m[M  㸁Mp1Tg IOu%]ˡ` Z覩} @dTLeK?Xx,2JZ`*fz LI5/#_ksX롡孽oq$5ș;c+v9xFi!N9섀C`9x&CaZ!GFijKx{(@=cE=NJSB=bq )ppCbA+yhPs959cYc3ȖxYd1v%9x@l-C;쇸_ fn3グOq|Oa3bYy\mXd|{73)\ui: :oן66!3(non#2׳Zqhs_;ث/2t6j3;)fc'ǥ1B,km^wQ`~plRs׎3(?_ϯe ΂uG7j߫6t`Cvc~Ͽ_U&A m}] SGU.d1D1˿2옸NvLM]|\!y|2~Pfqeכ_$_;=Or{YE1VKg,%J8ï,rϙFn/F'uA߰_iX|ppqO'ȍzv]Hu#7/l<׭i+epb=yzmPZee+nE1VK_~O_{dv]LwG66.DzG_Xk.6DW҃ߓ׮!m*=q:eGJ,m.[0Iݥ m35~Oޯa>7acLdzخOk6L_~Oޯ6"R5T=?@1VK5b H *duTum3~Q6=yYeV=kbm{U=}A*_ &st;ۉn>=^vw̷qC UϞ(-ʞ}JXUfM#Eg]Vuinf:d2ۿCY=^?@1VKG,5li_QZș.vFRꜦo1 f uyc PƃgxPp#(ry֙fNóL![:m~Y˽ߚgsqz4<;cY9CްI},[3DNoVk&_u&c$PFVܮoXY,~4iNΠ2g,8ۜZs3|::fsG`y74<7enNRix}͗UW;0ڮu$.16Mt L ix:?6ix 1?0ﭧX$k+-Hqn*n／^JG{_7 Jh#m bLOl-rg?_?gOȿCkUKȗst.qGz8G 9.96CzV?c{s rϡ8-𐣑Sf98e!ǎ o=n!|A+${␃|As!r9H=%!?ض#,Zp@l-8 ?P|kx ';^:ġHġtH!9H! !~y{OỷdΣ?d!_l(6p4Pa!l3 »}za*䨏l)e^&/Gh8o%0|#,ǑOB>lu9׎Q!ۮdu̶o.u>7l>B0VYF}4^熭-6XH'6@w|֝+gX4?Bj'S$=? B`#}6vfw}PZ:b1Y"c- %C%C݊bN(E몣!f/R'eG׎+Nٌ(j[?XV9\@$f;bc@ft%+,QuJ]Ѱ\6wV̞N(Eȗ{|߇X)a?@1VKG,&KcM]VtɶvL_~"䋆VXWZt{YAݟ)][cd.B0z D1VK_~"B yt9e:b1Y"Rdheuuܙm/FoծQ {p߯ ${]_ ޑ&WtE-B|ԁ.7Iz0f(jdpQ[՞@RtUeu wɯ]tI]U,X1VMg,mBYw0 t.o}w~)ݞ~ź?X-%Fz]Xu=u=b.ǃ߷r9aW.ʼnr(=c &KT .#i2/FoSq"_o%WjjX-c4%r"hͺ)m2Mwq"ٶtǃ߷f>%k6ګh9IK/}L%M5dn+.Ep7B {~2+Yd ¯<](--Bկd!X-PPWS* ce[|ѷZ8!V{,KGc-zǺ;dl)doó)hQʿǚkϦ{tFB>/k$g &;L9q($"ٶ_"D7ds٦⮱bWqu~['wv' [4b$ j.eA5'TsȭS5z0 ~<-CM,6,$N܂Rzo])=!R O)'P͉\=P~gfAK-&8޾?8 !,w֙f!kw[,X%Xg 4oۖbǰR)B~㺅qfa\՜8PZ т`x_/[G (o !=.zBSfO\f[p/#a>C/B9!_tDV ;Alwiz}BjԹrt [ '0ct7t_%4|crkԙA`r79:9< !_fs j!_9{y B~o]s}ΝN+]g !_}>0 Ho[;\(`: ztnlsnO:JQ |7 lv} R|[Йwli: XBz؅mc7|e(]s`KQ{H}`Qk ?|iVy{.Wvb}tMX$=a/a/h$=n/=}om_a|ffOfXe||<͎-Y{7_N/3sw7tHՋ~3,GL7aO_,_}_Zb 9o~ihuS+{7/[+OjU^_J|ψz&ycxOqWΏΣpӯ_~%p\;gCX=ǿտK^^~L칾sܟ=5@Tp|V){OzÝ /GR|{廧Տu<~Hǂ L&Xc|V}a~\GV ZåZ} Nv$j}-S,X*\<`Oǔz9TwhYk}1\3Q:+o:DhZ62-+{nl| 'yǑ}NtBO `OǡN5/]#c ,E:ja^Y?tc-gmy|vҰr +̇˰|XQn9Êr-&0Yڠh5daOlfnyYt" O7ü.27OC {C!fa@x כYŤvSXƐkwMatXhcr83J!HgT2ݏDz?~@%L)OY:>d}Lq2i%Y|c|}+H;07^Azw +LMW8{Lo[?Ț2?ƶwؾJWhaaT0P`T_-|pԭƦ S[ʹ-8M9˴.Q^̹JMO!k_ˇ9Enpod'՗_OaEfZkkF́>ݥ*MY][/d-3.Ϥ/_ﺼ'Y"]D]ʇ[jhj, 57Q?㽔[w/݌D'RۥC$//y9V\aWtۺ|>et,]ɐW]hDV]o!7m3=]eƇ SVs}Fa2iJߓ`7 ]/oz0hӛ?i neako *{oW VRоV= ھ8nF,'u)@6COn ie-}sw/URΏE;{BnQ292s!sELt+Uz|_#vwfD+Y1Y]MW_l3~Q6ӗ<♣sFOQ,9muYi<{QW|_b[,etԯżr]McC TO&]~dY"^?R~>R'|C͟ߪWѼB[֪P;N??VHl2ޔp֧U~]UΒ o\q¯~͞p *,~*RJM v_Uv࡭ZB[*YoZVuYLT8K*+b㷿},O—#/עA_΋3GӢ(4 |%Fe5 cY?K?_OͣKKQdm3މWKi|oEendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS257 14 0 R /GS258 15 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.400 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /ca 0.400 >> endobj 15 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 16 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000021770 00000 n 0000021853 00000 n 0000022028 00000 n 0000022061 00000 n 0000000212 00000 n 0000000292 00000 n 0000024756 00000 n 0000025013 00000 n 0000025110 00000 n 0000025188 00000 n 0000025237 00000 n 0000025286 00000 n 0000025335 00000 n trailer << /Size 16 /Info 1 0 R /Root 2 0 R >> startxref 25384 %%EOF robustbase/vignettes/plot-fig-AdB2-1.pdf0000644000176200001440000006667613465050117017542 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180742) /ModDate (D:20190509180742) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 23716 /Filter /FlateDecode >> stream xK'Kr,؎,@²zDJ"R$G+޿ӷk{""3"Uʈ߽/?o=%B+ko?_5?_Ao=_-_ۿ_2/|c9x-^[NuE=߆"B[!B ZS{E_~o'\ 0]ޯ [gk^@狕V[++f{8on8V8.%_}öҾ>Al쫀(seWB`b;+0\ϷGz=WmRpM~Qb{^h+_fv +xk^-Ig>_ &L@W/7Ϡg ||=gURy>_0+ Ns= `e "GWZ b_HAc~_k q_\'^\ Xs _%~)/XﹿPx]Zpl#эN/Ձ륕{fe/5_oH&=C])a]" i!^UlVP<*7B˟!$'rUz%ыT?%pZdnZG=F|ղSE_@S]2P4PV +]2Pk; d e.+]֚n|v_{YT~7z\ANK@GSgKuht},Tr#tkHɘTd4Ʀ`]@{hn%C6khk V:gLʯ0Ph*|ͮz5cUa:xVT.IPeR4r#tkwOHxx@gXxyޜl2 V:wjM=#-DY5.fT& .kR` rvs3$WڊW~j4M%l*z#!?#*^eQZxCKjAf!/EU*V74Qx͸Z)RWBM"ּ.i+\BmW4k7&եh|˗E E_,Z^?f8{J>f'[껼DZ,fywZ7y l/}c6E`vqv[~:xlnZCti9kuժӫƖMY y fg̵7X=-s3`>'}׌9~$@ "r%'O*NگUl+Hzv,?ss* {k${x2|I0{ &i ,rx:Pw;.&}<G):j˛ xաkʀqtwo\Vy+z%#"lΌ+VB _?=nfe^ȝW+&Sym Y-zmX,DH@ᗀ]@6VQ:;o~Š Tr(#f*@xź׫Rdk V:;okoIk)Bw? >!tV [֑^-~6@f/\ʩ"O<|,U:N^$5ZܸGJ{Y*ҹ0rτ: ~LE_3jZ?޼TXq+<+_nx))f@b_/tA!|"nML%>K˄[7!O ?23@ @b}H@"ZG7{I!~N/M}Rgh 򗧏E:w -xKhyi;ȫ4ҵ[P˞&ʝElZbnU̅|?6PGS gPA`BQIE4\TB`߻P 4"謓GrZƏ=~0!Sә1B`^EEXJP5G }6ӇΦGڊϬ7yYŷcT (տ&CRxc'̝6I8XNڊW~♰pȠ0/n&laY#gNC7T\rF@#t#Xya3n}ct>&`=W:θUUƸUǭ2ƭ ƭtlDtD&y ,^McZոuSr:Z2FwlޔlDu(idf/ !Xڵ!m_3"1Iay11/81=2W+Lh^GzQ U(I))m{U]ik+^RZQgL};)\?2tURU>exge 2kLiT_eHybӃ~)3mxdK  /FPa{6lnju<)^RZ)r6;Q8re\V!g*>ŋF+̍;.a"{;axTi'6*1i3Stn f: VMgSWaڮ b݋1~r\Aoօ&* _5`MxºD>72L9X)aE+ZˆUi rǑ[[j k}Gn- c=~op-z 5ֈ` Żk7`Dθ9wƩ|?b)hdMMv-$X n p>eD"LSŒ5`0$Cx#vc^*E\g&.Qfe-:*ˍ3#TY]uz@YVB ̦U2lVRPr#tѤ%Y1군V[eA/@x[Y1^Mh&yE&\&j h Cxºk܄_OO&| '}L9i>}{gHt rHC^3@ˈꖑedxV!?y#<6wlm+_J|?j#6W.ڈr]_n#*ޭa#B/~W~0r@Ek9X*F+qS`:9sfeM냑i؍a6ߌi?bݤ #lZ8U72蚂Uny} jgRJ3FFgLvH-<%gs%װ-2<~`aq~xHlN$N(e܉)[-~؉ _B{=@gՠ{lNemg`=jbUc-X*iwX\vY&/ FZ6ad4.@fJ?:k)qv'-t— PA'2+ /~QzΓfބWyOXw^# |B '>>ilZ&_^ffd= X ]XF%H:r{`g.#h`Y'(<MxֶLxWLxB@38ˣо\GLʍ!OzϦrN'4NVZA|QZVztK_[ʗ"ONŝ(Ӭ-y3 0F VaI'>-"+k|u†y "lon+ܘW-pc^S_(V w_( _( _723*bFSr&5f4I4cFO̷Թ+-femϖm{\ȣ>28#& 5 :|)-d^᥶zfX^ ΙaБax͠TZU L+D|l|m{g7+Z֕uKuԺ NsëpZ'jDja݋yWx_kmOX'W1,߅(|?y}o v=G4f?Z6hJl$Kj}%"sxKhT/)kc4b(^%Ւ8wBN;a_؉q'jd4 PiԺ!N%#96Ee]&!llek@dzd4SKQ;qQ1r@ț냖-RTrJ> R*ވP*R!X}PU-p bpDW2+s5t(AXʑ6roɗx v.GQ(Q8`ꂠ\Fi'Xdb}yO2>$^a}I>I$ ꓨ>Iph,aIn)^m@US}eB*4A&"Oڈ-۹֐aIU"ҪDe-ao}.ΉGu_k5vFZzDuDkxd{A!j냤O4Q58qΨ9#؉rE[#9#_rnYn(ܖ7nˇ=X/V7nk=@OO@O:f1yNrk@RT9CVuրJѐj'{E 8{e+fT['矃~>7ZSR%"] z 5gܳeMF-U?[CjO4\e|f73 !u(7bna*T'2LͲ\g+'8AiBI4hhSeJc%E-RHTSHT)QM!ENj/էNc8̰yftCk壯e$e$ 5+(RIoƧK > 8s(l0: pfq/ٚnxLSR_wd)SƔFQVN- Y 4gFQuJGHTGHT)Q!Q!Q_D%Z9$Zp&iu}u&v/QAL?B2_8/bA;nW 4gCgж8=QV^KC"ʼnV"4"-mZGgߧB]?~D ]S|wIpO ޓ "K&{^QMpVPfDY`hCSEcS, `t/UYj ]:k[lk*VQ:'>j'ВipwddՖOhB'a)Cmm_mPc(1=SίJƙ>g^gޯMYLB q mt+0%f'+iIQ/ 헖f/vXLgff4fyY[o,w7wIht=~M7&^m4d`[a)%Kg%VJ' -]8t$ c^@V!<)݅&5᧟Tv d5H8fmqDTp`'l֧4l.Iɯ\Cm "zsE4\t:SF郴-: aY/k "=yv[v[)o!o!oϧ^4q{(w֐׃ A]́?`a-h  ,h44P j}ߟWpYoO) OV'4=2:xV~vh$tstV@x{>W0<9B"#wD7e+Ly4C tNx﹪;K.ȻG;G;)!!h #-rQ,"3R>{*Y3CkkE1k`:Ͱ kև*Akke)sFV^yYX-ZoVscX߃GI(S1qP|qSစa9atVӟ:1j$СXaOOEdkĄ%{q^" m^iyÖaVu`Qɽ$M=.lxK0kF'z20P}~rٽr::6^^XP%`aS4[no$oXsĤq};؝r; ؝ ~;;؝y;'؝=jgqz*-w,+,+S޵/!v.}"{.Z"g(hX%tWP:Yڬ52dM*7B>hgw{p=adOh,oXOn@׿U~5-^vsny}؏0p>>>X<0N}}[@=8N9$汏㈓,d#Ǜ֎M!mQm<ݴdKǪhi xi4}[cAcal}u}{F_g=_yX[r X[ v6v tm%mvú`]u9@ ϶@k"n@k2tŰQ̰fmtռqt ûễh2]BWĤYKb^{>{`{צ\%wWp^3<ˋvk054u40tA>{^'nw&y7Ȼy 0y x_ߓiJm`IֺLbUeK.L瑯j)Yg^BGj;y}2<;Xnp-JJȱO2 .&^O @x*7 N۬{:׿s:w:cˡ7*|չsl:wisunM5.F:< {νo:{=w׶sdmVP尡*[^&=۱ d%|? y y<]<'x͆nC.Y`=lH]\Թi% 7̸783FP]ojmlʈ%8AhG#c1#:v"^'KiLX2k -%{szY3Kg|哕{>Y<)jRU2Zt09ȯY%1,a>Y%'˘OV'Cܮ-d~yHkN5$K|@ա>C2d>zRFvp9U<,:>Yz6;qZRsg1L5C1C1Oy̭}ʻ!.C\|{.qDOG'ÚsSov ^I?w5^ɅZJ<ݚÚ [)϶AMR^sй7VY͚.`Mssk5 dEq2Ͱ.Y3kz̓GQ%k.w dOX,kz8{2lZqHڢB/ kjk)d-2.}bd tMŚd;y{0cFh߽ aY<Ju;,9>f7XJ>O[f9O|UdJ rz1=壧75l ]ɖ|/{4,aQd^@;_lϟ#ɘ߃VE8D8&D8-qE"TWu-߳wh+"ŬKp42 +oX:Nz9{2±\'0BGGG8*5zu2RL".p 4¡XF'#Ro 5hLx/Pc+VbJ'g:0uik#vnk*VQ:|!jȇBsd4IWj0j<+NwORKk>Y]˚nl>=x2iL'ϊ|@=z2|~$^ >jgyڝ҇RNnws:;ΞظVqfw}?_'Z־ 4쫒*"QLFòt (rKYTq#tvvNSH.h A(xh J~lEml6^6s{Yv3,?E_<ev:[(X1"RT9Hn@u1"2~JqbGcyX>U<7]a-,9߳< +doVșkVȼY!VHY!VRVNaVjnQȩD'FXYǽO!u۫ά##8ߣVW^ՕG~#u>zHRUyeIKRa(,aXO{3'Zؤ QWܼ+NF+~>Xgu)%o?FT~)Ujhvg&䬀K,'}?+9)7}sV,{XF,%P[J6-ŢP`]+/; ؍_ .jI?uB`BJ]bR K 8o8eWdRk3ڛ;H/_\\/+Wl.AWSxI~ptR纸\R//q¯T5V>דÓ. R\F8F[@ ֜W0)ϖϩoC]o+rTܕrK1/q¯ȡ47l  xJ9]~~WG|0\^/.ů7kkXcs25ʫUC.Hiw̮7!4,r.Sa_C5~ӋQO9z;KB;=#^n)AތGڌv[ ZV%߯FCYuU6PVYW:3ʪ$ufh_PwT>zrA >rjIoVGyr-\-k1u4Ü>]V_pY(B\>IwFKk+^RZJZWG.KУJ=DkiwJCpZe'8֖:0_xo;!YpunNi]|u7dm탬퐮/"e0"glk(CvE 5 i`|db2NJڊW~ͦet9se5WJmx{A}M):˪xs~n>i李P;mN-2HItliF-PZtnZG.d A9!{EFS=~dվ9>C..u\VūLPon>c\WŴ'?ҹu_-j z{&GE%WL7)J]A-_,X.D cIE?*O¯6n,0ћ?BP 7 9/@@q+Щ@\m~W5^"o5SKjڛk}> qWPV(' UP 9ڃZPTwI 1G`+tp`nw`n+ddQY++؛2ċ`~_[ah+0|X!{=P3%O:z&_z: ~[\WSۆ}Xз]OYHzefO gy[+w$H9~jQxïY>g眥sS T%W|J;bt{0 ~͚^ιUVs_r~^*owwy|Ν9ٓs~ճ#F]֮fgOI,]$۫Yn#,ioe9n#(^mUmzaifݦko|?L،K: Ln0J-}'.e τy3[G(Fߨ"ei ܎*Ռ6q 6;y7[WZgg\F.w N  wu|dN\O8@W멎/VGdwNaO4N?UMh=v)m/͝, Vz{"f#N;}';1` wձZvb5܉n|?ɶoI;u9>DY֢0o2i/yv[ چO{Bg,#Ƞ5KŹwB*MCgRxVwV%ߏ',RސpMCtsD㗯klGh ͍A}l|mGL #Aku~=3jFĪNz N;}' Z &{h-؉5o|? 3ƍg-v6v9. H6r"/EyOۺwHN"Zƭ@IV#>H>eMbxTiG܎T>Dž˜%d ןm$S&6mVxKiglQN4mv]N;}'zÝ wbN̆;ۍm>h?lzآ-Z[h?UK4-:ڢWmѾn|?jNTVĖXr4cuFm'vasڊw!gs?Lh('% =SMc]X:,c]uPu-Sad;֝haN(^eob+T*ב"f5Yj<|13 sdO(sb|4bg%hJo:-6qez[H3 ~rDl ;axhJcVY3v.Q; wOɚ7Oh:uV9*OfgUT›`ϭri*W& OO}߉:q'ĝyNԉ;Q}';12wO'(;NW#u#uwp?!5;#;m],3V%O'O8<5Ԍqxj<5פ>dׂsN^9ڃgr#VX;c=KmG 1y-ඤwZ.zDr.eixr-jmfF[ -L,;V6O HCtLqLD+gON7lQR] öw[t5EYv[ԵmE芼Kf.ȻqnzQ9Eylѵn|?jrc'Ԙ"wb;xi*> ;v7sǑm#Ӟ|?G?pENt;(w|xvxGZkNط#vb7w}'rw2pb'jAsh\tYCV8nI8X!Զ<1 -}D8-f LiX`co wL_Bh'x.y~ }xm[ ^RZxG؉*DuvBY#vNz߉^q'jQ(_;d6۠{ovE,Õmq$udK|m+_B{p>fَ|R1c'l1ۑ9|!sm~? .U>6ZaV9# xxu]*ϐo 7v/gL'tj&hf Z&=߲ԬT)mh]"k+^RZ| |.1aǔ3g0,S񚏩 5k# m/EL~3 ,Sxt2 Y85BHh"Ȋ(ZD^ߏcfzM;QU;XvbJƱ#J*v{A%rȞ֍Gm5 ^ 3P$2 ZX=O͡vza7~83!^hEVZL| 5l7lmŇn|?-="'w#En"Ner"xq1C=62Ĝr=Y{Xc_G/=~4XS[mf+kYސY!VG-VƌҞ|?IuƑIoL@xSWTdY^L2 /u7V!(AˆT{YG>/ECj"$Dr7ϙ\QWHs*Jwr.%m[ҹ|)-*Ϣb$O)r̦ S䷏SOUSCR83s?HR9؉q'fǝN;aub$%܉p'JA|?#F%vvʎDPDvwD7ǜĝKל-kƘoʎ| i\}m+_7AMrDΎXoW=Gdg-x3.yXX|?$؈< n10u˼$g1vb;?)7;mCt 2R6h7m[ŒdyPpf8 ڶU*vGV駈^I7b`wԭ!#dDpA$2GyDD\;jM`zB g &VQZ脸:ꬨG\tqu-`kVa#.ڍGm&aAnbۓW[i*Qsmd1U;Clkˇʗh*NX*'?@X==N)ee-W0kT8 볥ߏ;' ^Evm{)E8柀ll)m_͝Lkh|w#QxGG!ޡ߉Zq'jD="?*c`wLsUEawP FR >+;k+9M~>2q'LN(-'}cvmGF#ͥߏq%ґq!lm2LGYqzdgЯ I̽[Ndxn;Ćc'Vǝ<ְ6K; εt{ :Q5N~ia9q76?kǑ\}c*A_"[tc֡[(ـ4 ܰv_d}.rsTXoK:rs8;nGKNnSm%4uNm~ۏtumꖯ ll&066 4%S -Ѭ^-kh; .nzw {BSz+^@/-x_4ܦ"kc7kܦh_7 ڶhW7NR jheQ_8]O4p[ܙ/똟7 |6VmN+mI-.WMۆz5kW@o6Ӌ Dö%_+fmkH%4mzD_m?^n'(CZ>mp"f'"?pjS;wTs;cu_]lnw1u V)NmM%uu]Tr#t-iq W WM<'sZ7g>wo O`60H"32Y,1 'Nf,+9XSr`II]Ǝ"6ҷ9I|Ys̈ aYiс%نǶ|شcKY6'-Cl5$]׳=NH3,'=j@VBWh!Z=kV3RfOVH젼WL<ƚxux^0kij.ި ^'j6h ,IpܒǺ0=sHBD,dGuM 7ج6?.ެ ^ ^7zBb!ޜ ޞ ޞ7eB/qRF?zνtva)m99w]*?Оlq>N5Hξ}g/ѓd׻/K& %~ڷL@r۳9y{=f\˳bhw DkB>J7)fRS ޗԼm DkF Ɍ1hsv&q֎ddShHf'z-|Bzko48e~}"3wckf Dk3Rŷ kфO5[CZ=|1#WLv!sRyBWG)Ybft:[HGiXi `n'oz·——u,>reS^@Y@Ynr`JصT9r劧$M((׸ r~ Փ%9qrnXF".<LXcuXǀ K;aqEe Уv 4i -tZ꤭XY+i&| <.Wq&eeVmk*ք_c%ܪ^ E/. j^) no]\ܝN:0ɽb^uq\^\~ZdiC$~'C /t t,[ȪLf^[Tpn] Tg`E0 _(J@G64=&EYUn2ҲYܬzƬ | W1{ygY8O|^c74>hqxՌy}PGcq1 C\Їa9atVOId!E8 ,s[Ež֦X)@Oqv.m7 2CMxƚ%>Xbs 61,F΀tMaU{DVɖ>X⚽T0ą[.| o k_ҋCcF[*Ih))VQ:In{H°|D E+հQ,FgV8 SհKN EŰQ2>imoviᰗa o9 .|Zy p ?ъvOt1\CSmpa9 #t@gMW2YC&7Lw u?;~zgᝅgwI4H(|X|u>X@⚰UȑEȑ5p;u:Y{KhZ]{5kmo'֌@{ބX.|7kGW3MY[!5k¯|==5Ɔ|A{&|`zjR-/_&Yo+ +(==7ą &|^ |](| _Q׻'ON=\,mu}0Ms)t+iۚny}ҞvdQmԛX{T].Xا~|'ڬmMŚ ?Gv9 --=h0h10hqV88~-ZE7Y،u~w ?0\'>.|B^oA-ș芨gТfhz-s8pĦ#6 Rz"6 :z2-\@6V]7&5~5~k5D:6\|'/A>^CӰ) M;ί  z>ɺ/>.<;U=hMNnd z 2dbͰt Za665̥7lԲ&gO~./&| | |7SK˼ P§ O'_'g|(QUS뱺\!VW~r Iσ+,N^+€Ӯg Z8X+ɍmƥ1@"Yr`GU:I>55Uo+pVTjB纮ixmuIguYTo9HI>օo//&| |gjM'>݅GuGW/~yS/r#Gj=Nu8pfY;X?w;N^aҮiCqTQ7̊w^:/P4Du9o悆UsCo kdY՜^Us@9S6!hSe>2n_ٍȪ7b:bE{W:e@}$$&uM 7J>7:!mp::׀KHE3V:xVHEFT4 7f>-Dۅ_E$b!j˧+ ۙ\-tV@x 7 B?_+ﹳ8WH dޮEJٮȬ^j-lC|gi4x}o/)9[C"^&| t\#u>t ۜU X bEU:w9+tmqm|UPo (n%S^o?hé.X̗iw 'E {^JD|=hyxIbQJ9! 撵R %f.YW¡|x]SO )vz$!}%yxmz2٩6%)tM2 e&uyF>WFс%:K kQ iյ[C#6>V%D}/P#6t 1,JSggzgkJa%"gjTkMX+QPL%EFM>iz7h~"E*iFWc?kqt]gсB/.M s@*a9ޙE<$Lwu۬@*a^KcӳL%L-cSd))Dܒ~tT k}'OV0i#lE&n74G vhb/.&b>OK k.]1@5@xȄ쩍jw>y}Оv8WWqsuUȷsusuְMsu6등2oЯWxb=/X7KЯWxM^^3V׽!Fl,#Sa/< >i@jx{Ć\5kO^vW-N?M>UMU=UxcU#Tu>36glW [36 MY1bq(c&n:9Y}3l O^›dݰb JgM?e)` s)aLQ2 :sw~K^Np+#jz&iq )ZurnaȘ+V$mT5v)4ٴ @v6yߞңuIώدS]ٚ!qwӟՍ7h>Nu*Pwkn¯GbN)@M@@ntdn2dk[^*Fcu)0htZK $ְ!X]8u`HCsgSA/ۗn_P/'OzKmzkuvLPoǩwI2vPoYLB4P只h#đBx/{>] y.*߲z'O#D=)f|h Պ,YhtljV/ԬR'[m,P6E S,,m?!Ua:Zo{$ @X݊. BΉ[R>R!mP*m!?ԦrA"Io4 E3A͋]LJEK>F,κ)zMSMv~ b)e6oֻɍ׷_o=ut߿{߄239&?O[ 3}~oo|2s<ސPcceltc7cmXNOPtn*vFh/?,?ʙfIQ6o'b }zr?ߦI '?a bN7yWp"RJKi r?3T(ixI"eu!Ix7P0sd#r+ j\ "H K 5xF8"崬ZڊWe?_?&u^jtp_s /29@ /E>45ziǡ %.}}~Xo o߰;popmkygi޷c9ǯ!%oY*"|SK~|MϺH?ʍ+29so90g{Vֿ#y'>3RsoEwZILJ麏~.R3+?Uav!֙Gua2OF,S<_6_6^ړ{h x 7#o[3'G~Dzu _&:%剓ytst t+iq> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS257 14 0 R /GS258 15 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.400 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /ca 0.400 >> endobj 15 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 16 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000024081 00000 n 0000024164 00000 n 0000024339 00000 n 0000024372 00000 n 0000000212 00000 n 0000000292 00000 n 0000027067 00000 n 0000027324 00000 n 0000027421 00000 n 0000027499 00000 n 0000027548 00000 n 0000027597 00000 n 0000027646 00000 n trailer << /Size 16 /Info 1 0 R /Root 2 0 R >> startxref 27695 %%EOF robustbase/vignettes/plot-fig-power-1-0_2.pdf0000644000176200001440000003270313465050120020516 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180744) /ModDate (D:20190509180744) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 9222 /Filter /FlateDecode >> stream x]M]mx˙ɛ,2+T"Uya{1S<?p~JUZL@\ ӯOw;sJgPoN9oW_~ska:ſo&/._?y[OOwߟ6#MM08|0mm ,)h5aΓUs. o`紜}8~1e/z[DfpP֞ ԒyZ y58| *9d`iF 9(T08~.9.b%FUXLkѱ9N@kOQ0yVSiXpctׯQTEKi(ԱNJ:\a8o) ?%RȦAx`M<ZC{&]c 7Fy }܅c{ ;71BUZ>R a!Zka =o@~ =k/T YvvWƭ3,yumt(VǠ _Ky}ϛxe)07 {~=?{%}]ɚW7{K^Ooo^RZnE$HXkerlA#-!۾F|sD{^Dzۆ'_F}5{ڸm u-|O)jbޢ& |N&n I_E]#jBN{/8ҽdI70VVkXt#&ITX}aWdd.4 ohAօtV1/ڧ 2p$+G+Ђ&X*,!(ZGiXpct#i鄯9#<hZ@񔮙9,+kMzWM6Q$;j2eK6kS:Vkng>W߅7 ,3ޖtc.G# ςU֖ՓSase|;'U?E,-^)4,1+.h鄯,2MuhQQp,{ D n.zĄ ;:ꮻšBް.5 _W鲜HV7Fy=bk~f?Ff?F7MxbE^B9sL[>ozLF|: 4UH@kmmO*7,1!{⺄uYbj}ٺ5WQ;q8-UҚ/˺˶_|'(5qӞ#č{bָ5Q7f 7u6nέAQě=MNk&Nv&n&u$kkBN^KU A& P<m䛚xX_GN|!_9s\12=2Oq'Mi<*'ökҜGpBo^1i,oҴNmmzvi ]c^uh4KnB/c{3~k;ހp/:j "sx`E^eyloR'dt 'd0Һ }΍۝'o;dpNswƥ-ϸsKxƥxW;e^Jk+xNumh^ڼ10oݬ-U5 n.z\ĎtT1F0clS7T>eʹȩ&j5 qq;¿MN\bZ9#lɦAx`!ZIӤK2YQxÂ"=mqR n6E@{[:Gl`E^S=3QfkcdβfMĪxZk})mx%E{Fy=04ySfѭ7e^[2l x4si6!7ZKiisyryY X;T59+`a66E^:~zVFa}aLA`CH;iMZg>d7FyWy {<@v{+hZ.yөZئaE^㕬m,='0x .濂@[U]"SB,¡5kw%[f%lѓ4,a)qr )0-% :Wu'" 8 @gq[)2b5q*Ok".MH0ǥeOs=^HгμDѺ4<mU5^5!y& lb -a!K`Om:M@>b cai"39SΥʼ 6&<nUk^2GM[0w Ν&]ꉃoݽmh#߇ˬeu,:9/d<Rnb'}OZ@#o0D+V#+W16 CVQԸntX"45ꎚ(KZ%6(jxp !Gh7qdmF 2n*TV֠ MRrKr κomh#߇V㐓xc ǫN (1L%hrڤw9۠ _|6!^.<ܛ'n2y q(~ C'XG5c>,X'3VӃ$1ΟOdd{B{lL'?;l-vP:|vtǦ|vtCggw=݅l> M>֞fۻ4Ky{ }"wS^g3:e^cPcdeWD-##Ghk^Hk9XwKƶ|[6B6/Lj_B5h7da㵛ga={uZͲu{6ox7ۙ%\-՚[gbF- g)@-@϶͖dh*^a'impbY2Ay8*Z#j>XG/xEZ,#nlxp 7d', Aڞ𹢏,}gޤywܳ6O [^Lf3}E,)ڞտ@$mWuiCxK<DmDm3S-STm o{@K>><h/J 2|m3a-a|FYR l-gCf< Ja?>ˀ#. qP+˼mXeM](PNQtoNi cx/Y٘͡buPp:@>Hu-hb.N%< R+IA>&6ODMgYo5tMltM-^HHKh=|6}3< 5a?tDn엎ȭAQCR{*^2M;m>/[[ h#:W,@Գǖ^!'V}uIX0ot6VOz65n@x=0Y6?J2tɦZ5Nx}KYı֙&wz^ g^6¯Il'V#Vk.c!]u[gWAxb=^`{ޢսϫ3hA@Xt< fĈp-j9M`^ ˔ta|V (l|Q-hZKfyളi.m|$lAym^qۼ$Jc%.Ɵ %M͹i¼ jyICs}`XGeo)"]m&=Q9hG~=C,8ֱ58"Vo)=XII;X`7 k-2M XozM͛#R~ t:։& U,vFln|E!5@gѪŏDf Kyz`DY %vf # ZjHxKJZ@K6+*8l." Y98l."NRCV)\DގWZ65@x=0Led#l$XtxL$NlSeM`g$,k끑1-! 42BkOMӔ6ҩ;y'ָ]`ܞ;wCS;3qD0>/ړ~)\B1];@Flh!7hʋv?Q ^lmh{!MΝ,i9xn<δ@K&F3b +4g^ y,(.6!u=S]kg3=SI:=Y{lXt9d`mfm'mp ay9/qaZָ-ͳ|w7!qsx7o<{Kj4ɜ1A@nqW.}>pS@":*\]oDpYjW}t6x5Jy&|qOUo{W:bO/xRHǂI[g~?:'|z}8?o ߼pgM#};o W\4Qw^o{/VWd8~to~€xkݡ/Mg'0 lM#@w '(x ugQ{}_ W9CHKEZRqm%#}hil?h`޶b1x)+cb1t)*E.sɷd¾†ns7Xmu`&:_=Z&KSz`@ٶfuܶU9d#+)og*Lʈfx/-2|ˢ <(֦IF㍦V͖&[ M Mλ14_Xnf Dyr36ykL칦bL/ txrW)Z M,aչKjm}o~2>^KϾO/&<]}Hsdj,nf$z?[&n[ LrGz k , f*/mu\^^bJBYGŭQ~@S4VwT\SMod;w?~/`=jwq&&j$RNv{:<>4*>NؔJ6 k_'\qJL/0q~vh y*MڢGxp|mǷ)?]y!ysZ*s,~_pt:Þ3bus7br^v~g NC3UN2(%4;U0MA:6<2ڎ' b1 'G:CusF%m}hG^G}4c8!}y}DZ}}4vҏӐNOʥwK_}j2H/o6MTS>- ~y7g[zG}endstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS3 14 0 R /GS257 15 0 R /GS258 16 0 R /GS259 17 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.302 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /CA 0.400 >> endobj 15 0 obj << /Type /ExtGState /ca 0.302 >> endobj 16 0 obj << /Type /ExtGState /ca 0.400 >> endobj 17 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 18 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000009586 00000 n 0000009669 00000 n 0000009870 00000 n 0000009903 00000 n 0000000212 00000 n 0000000292 00000 n 0000012598 00000 n 0000012855 00000 n 0000012952 00000 n 0000013030 00000 n 0000013079 00000 n 0000013128 00000 n 0000013177 00000 n 0000013226 00000 n 0000013275 00000 n trailer << /Size 18 /Info 1 0 R /Root 2 0 R >> startxref 13324 %%EOF robustbase/vignettes/plot-fig-efficiency-all.pdf0000644000176200001440000020530213465050116021522 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180742) /ModDate (D:20190509180742) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 63912 /Filter /FlateDecode >> stream x͎ܽ,n.8'(=0`6p}eD*#3"WZYv1(RC DI{7_o{O o?_ⶇ1?_Y?ַAucS? R~nԺ+'!WÄ o_4!a:@szcq%'ek~n Z%Ui([cD#s}iTVދ|$: K%V%l;KGRV6Bf{iVTd$5bߝF.T uޫ~/H?[ z[9n7[ =o_WwD E^m=4V (Չ\Br_:|:խ]V~y+ŷ_g{ƼT6dZy=4s爫V yȕ:ײ ˵>{פZFz5NWE]NٴjᡩMoSlmy;Cn.υ~}ԭ~+){r(_¡~)B g{]`(( Q½Wߛ n-OE ]0?l/ԿB?:?:eS &C2CW_o=g+-lYއ|o(>OT_|twV]UG<.tq魺`]m 0;gߝ6Cv=jITc=V~Ū.VxN j3Pyh2/VUvT D~rSPY~Ū.Vv:į=70n}H ⌈hzZįsHn-{c ۔N[Ch,lٴj{bܶb8X:)><~2;IO$:ͧp8I&~P#ENXS=?Ƽ}O!l^UCX<$GhUmeTKј\Br9Ox#O?luW8TrϲLn,MO\#" J ԍ|ƅ7: -ßiPdO2 (c+e tߪ(c+|JlMpKJ|%mlȂ{UtelEo~pq,m ptݣ\ߋvI+2GguY90t鈡3>+9qkmf0s0U_s_㰍6#S̺Uﭨ:>Ն$Skw#:ujZ3}{ds{rYY|9KU$.W:~CɮL\GJ : )%vNHMG՘ܨCy3Yɇ0wV%Ϲ'S>Q%@Ki>WևS4Ů8uAyGo ݭ2r"QzMN}yP+ŢolvZ\CGUҺ`+\Ọ}cJ,Iejψyn_~/_X*1>4Q2X&$m3ʬiMT܍`m0e*L:'ISyH4E_[&Z$_EQQ`ݎOHW8Fϱ-w*tei2ci4K4]YXZ,-'g@Y{Ӗ63dd|r2?(*Ŀ{oYvGp -%>P>* p6W0 {w?.1ѱDt჈0c"p/b6! ^D.9/ !cچ浤+IWd`ג2!ƃ5|oYD[WS2yNf6/hBZ/Z/SU^\-3N:H! B%8<>pCp7} < j&pKV{o-Ŗ'"dA&Mw[D"\}@jO@:xgxM\Cߑa@+rS9yoNk?|fsjU ŏ=7c,W CF¾XtἜƐt˿$~2g̗۠ 8KmHJ+!/G::w/>KW.F-dѥjѹݝ>2?/bz+t&wTM:~A]:ȡoä/VUv| u}H 8+/XuV{6=1ҍzV,PI~Ū.Vc>ToZ>It&\NP~PӅRҊX0Ѐė>!{ -A!ަ{lPar`G+p+|vC'[g< s(߅wwA2)1Zqw,uk 2 ֓G(sӆo٩Tb=#R,Nf~wAg% ucizoY6ºOHQ#?ƖG(7Pf[Ӷ6mmn9msVf[akH֐f[/4>yrhhغiiQZwH?kQ[Ƈ]INeV>p9l>BYJƞjtw.KW۠/xCgt%]߱H!NOVkg#n(/4uֱf_[~b1aQ)\KyO4_|0?P<U|LJol͟~:"B わ %Jz ^g4Q1Kzף (cQlQ6wM(یҟqZ  Ca(x[JA&LrrϭBYz~T.G S4/X*J,IeXψyn_jVVMu?cΫ '$%Q33S=LIfұL%I2ɟ:BɿtA)Gh/dܩWe r> :3Ǻܩ㺉OP#?Ɩ#?G(DZ,j,WVciՖRo,Re7 #[9U V#${Tg# „GVnx"N BB8;y%ftX呼كxzBB|RIPn 5ak+8yD?\̫ɛ・]hxM=e5Sߩy~}Rt|Ej{SG(vfm|(IԔԃ=#PI|vz=0d7/~?{!BB'5QtP\{bv b1ȇ ^|ywL.FbߝF篏K{N'.Y:*Eocq*XY8BL`焺yHqH4t`y`(c7X*XG(/t;B9^Dj_:beOyJ}WC=h}&KNGX0?$GDgc\~A1!%4(WxgwHCGmmr)ƹK8=!([B2pgfV q%4(:BISzlI6!,>O2#لGHwGn.ոOʟh#"+[[땭Znm%#Xf[Cж0>{ҳ"ʓЧ0R_P]*xO,Q=͊Ԛn'\$q;B kV:19>9fuhuֳS= :CS:>w[Poeй_Dc|^q}mm6hSm#Mu?B)#Bѻ'W]N\gPi|}#PJQDԹ5c2RCW}oWշprċjC9z|JsbkV)AV)yI ܆898$8uAyGޢsr0~ ,fixdznXRޟA]J56*tUI0j@ZPn"2%eG(-G(PdiRWΖ- X^YꍥX,R?>wRMkf0/XJ|dek)9 Hv#{#\7e)4> 自 ^n0[z6) *3En7F9&_k?(@rѓV$@+I\Br+zG_CǘeVl^엚ؼWx w?35Iǐӭ!5SQ3$W}qؕ6{cs>㍡N~U>&ϘU?٦e I.3 |8Mwg3_{ko| P2?!CFW UNƒ]D>VE~DGt42U_:".fA!&}O!H*&>N+XbYe+]9OxF7>'v P{@}(+XbYe+{a侎I*/XuVʞq,UVԏs5^N1 zEFY/gqRVY+!YK|iGbܾpHG7cy̓cy=DlvyYsֿ9%o'!.uƃ7~Q`19&!9tV q%4( R>zq3JoWNDBԉiI EA'XV (Չ\Br+__ǘd ?lm\UE2hɑ5UWf:WB\y٩ZCWzC``|\CX䳲bV jm0ZV\iZg8~"tgcd<,py|J^dۋFPH7@X4B7uY?yar[#S\IhO6m! oipCnpdIw`D7.!އ h>>POnL{3O5$_y o8P{h_N2r !Ȩ>{=q"I4̏xWKPkOjgx]> YI9πvݭy#>>ėi@W27"1ՠ8$뿞 C9Fn39I{v$Go#I-/VUvT`焺yPq>{ݒpZ s~Ee`.aLh 2v?s.문!,:#nNO]81ř2%eQ_T_W8ncd iSGMzj5ɠzkDZ=jع|ko:|;*˷ wܹs^cН-|g;I+)nԘovPޯɇ|}?K#‹fva*b c10%pP?D5Zǹ<(\zeս&K^A'(6(3ew't *92<1J @((Q6βs}` =rT5 kTtkՑ XˤsxjS:vDc0m0{މ.c6:24^&W)hzSysJ=ѾgZz!^$=$%dDZ$ F E uER߀pZx˺R$Rոjj!AX`, ҔgKMA@diT'ܧVӯn޳n&nT.ͲDn KnȨRj5|z7b\qԒK>Υ *O ?drrٟ`24ëF Kcg\(kprUm*%7ILlk'(—V>GX<+=ugx"XgvF&5ϺJWMzӮ]iWo5dvNѮ5 Noiל'ܧ\L '/>s:c߈:+]eLr uYYvxJJ? }t\>_UuJIxu/rKyϹJINN:hTwW^'=i7,8R +8ZCv %%:>1 KPU g*bJ5+= ©D\C8kL퇬L(Q2X&$gDu<3[_ҊK61t/V:24^&3R1f< }y[s=j3$UJz`VZ6͋_dR-~E'U/~kыZ/iՋ_e˱YzU*͖Ҝ9ϖ,v憥K-"X܄TJ aOMrX9XJ|Y%ɺ0ҺΖVӊ]>Ȼٺ~2IɃ9<  pfc bA\+c9Vg׸N3X)+?vn$jcV "9&<`&[l^!f93i,|`={8U2Z:zv`:zqn[/sezb=u!6#DQ # I8<>p7M4) }L =Ƈtj%/m 偼(W%N*' ﶐wwgÆHc^/LH-W5C;|SbF̯Cu q5Q3V5Jz<_׼l>sۜ*bӹZҎŁ_ }C/$OCVHP ?ݝ*!Pڌ)t ttMj]}Mwt͢K3d]].ww@3i @ګI{t=c>FG/VUv| uŋZfB3bV XB-'Q%eJ5(\ә}TCHRCPjb{Pe224^&yLƼ%IZu&~ G%ˤsx$x\CHL7bu,Se9iLy.)\ZƂ)H">( d!:*Z64nNSl9~[r7mDPhIt嶡%FH@Q^R1/ !cHQt[<C.rDHa`c2rȕz9HISZo[pK~jWGzGmhVT2^Jbt1~I/H2>O)됬+†3Ya;KS!,!̽1y^g]剼 ".RHhO6mYmr6aW'կz؝9B֫†!tEdC9yoNvFs3_<͘K{sġ5Casm.fwB+I#MtkjRQa "$iJ/HNֿS} =_jХ4KOb ]ʄӔtgwkknF=Uv""2jc*Xy*0_sBc\Br+_1{qxq@h+Em'bVb]uzI83ƹ-mFMr+Ԫli5sAdco i&I#:HJMFΕ$yJmcoճV I8Ut.ywy!;t g#Ȼb :NR Gj"u"GǧIGfX I(_#)LJy>ҍPfi"9ѴNd-HMo' ~"'u_)g NcN\l]x?ſGퟩN"Mf3iMs|]|?wʛcx:S{B;uSWTr&秘_0]B!KW1<3kJNﮭqoB.fr̻g#rSi‘TKhzj6lR'bUg]N`z/w3)R*/XuVʞO][.Ys':%W%bUg]DEbVY~xߙW A @^ ː:4!sfD/ /Cț?cy:46F6ÞlmUHMHML!WY$y:wOp2$҃~AJ<ƾfU|0T3>U:Kx;ʙ[dM#lߌӊLBBH~Ū.VvA>I 5Cd/XuVʞ fágsGLdP~Ū.V_"_7!@+z+H(qip| u,"P X_E q7\)uPUQNeU/pAIn#WC8ro}+;-)]Ėy~E0'ug@&U:+SDxL:1IEp|j=\u@Eh_E3mymu^ArwTDkCJz8 Z:Lj**k;DBO \%~W\IefZ[ɇN'Nj4էub\jS֑jX)2@ , ^1O=KDc zd~{ףsT3N fu`ZP`"5W=N+dCJFoxin: 56j ZгnSߨѱL%I2cgDu<7/ ˻R6+ "ܼVI2X&$&k5}?7Q9?|e*L:'I\jz~>iH :r,>MHV, Ep_7$.ո9kO0Vj/yDmigK/*Z𽐬ckZJ|YĔ:>(x.%#P]|Zxn9ynكG&?n[`>:y\Fr5eBH/8< !I re9=ȬձD.A9V2c1Fj9c^,Yb^ʼZ'je"[)pH`CXz2k֋n8^ԭv(Fme U{XݜȤC}Bw3ևtj;XWI<:e1=Mw[E ~$KѥnVC1YaԖ@N$DjUjob \?sߨԼtW~C5SQ3S?g<7fsm.mӇ 0_9'6ct # |hG~T_|twk[1g6EeK3`х]Ne>RwWwW[['tQT'xG7(}lΠor=*bjX :)f9M9j T28uAyGh 0v_[jAEj2e~P„ѬԨ#nK*nI*.˕̺9na7k]-N uX/!c;Z1/vZ뜵zYZ1C".ZZ1}XZazoujkzM[VeS빨Z/$z!Mj0-GVx̜32o#HAէ>O)zC!')&P5?h(̻QofYY '.SG?+$_vꮰ66?F?>zYWu;H~~'Vp31>ԀVMX| w?35Zu{?ѡQ;Y&͚S45my6V/֎qBi$!xtQ0YoON;Ѡ+mBWAM^mHZti5#}]Y[䱗rm61T(k'P^_un"Qg=kV~Ū.VVe~0_sB7`Kxޡ]'qꒁLm/VUvV; Y=@&$XbYe+@UᏌ)I~]` b,C9nԞP1!%4(կ }Cz.H)$h\e #ƭNGWЇqKhPNc} k)BS-j99ZsBSF7\ʸa\q9*{bX/[nۍ;gx[ײ 7vÍm噦o`HN3B(WCc/=qYI]ֱ\]qeVTvSe cQYw$U8 w̃e_NF'zdr1CO>ްwU{o\^?_F=M)[ %kqA2$ܖ6n ' @y3 oKmf#حtRl|"u>b Dњ$=kHl$aVEsTEQsMUAup|H" DGm).@\:(pv7COjLo- hſǀN<I&h5U}Wc('b@Oo{iѽm08 aUg-Ls VIo#p'GƩ.k6λ3& v: L ǿk+Zz{Y;c'Jfe_=R" Ƭco9lb jku"}S1k A{eBg<nUU[ix&#e hFXvIAb'n%gzQ@'#3nwM5 *g*(죠R<q/.J%d']LG w *] w1p,o;v ezÄiB dWY8I]L4o= ͩ*p2wH2s|eWzq@d>}\h=g:Fl[ٓY'({OxeOPDeϩ՛tywt8 0y ߠʥ!}uP y疂O'~ǫW^*ڢO@S-Aӄye)X}C$yh4Յ<~n5Χgp.3g8ˉϖ>vVMIM2( HJ_Gj*̤ʠ ɠ 9%3ǔȳ[~Z\dqTx H\tR&)bOKVɾܪbwPv[;QAV/H0嶲u% `ֿd{ݿ펱q$>tVf8T;*t-JҨʩ\?Ҡ"54džwt.Jn-b4=#7~/ToٹBH)XD3$qEAX44BruQжu4k*{u{Ј_QH>3!ᓾߨ.!QtA|6~]{cnrPo.SyexT.B66_J1fmm},I:a~1ANwzꈀ;}.o3a6I' -01"*NSsVNO)JNJ" #&ʐ#.rDVmLk奅bC.A9TH-ԝ}_jC.yq7+ ژM jݨL0@mQ)$\Px=%Bd_Db/Կ)'o'oW_ DQru>{./>FGjOˆ!^)2$ FgTK"tOuv|0P[s9X >~صmONi߳sqH)B%,qHIuԳ@{@M=HN4tAC5_:be,9sO uBBHw C{jM*/XuVʞKȈdŃrA)2enJ[ZՔ0~.b  5%$.A9s00ØA?ø[Q 6. #; es>ƲDH(Hr2V q%4(L9X{>Ac"Fs3A~mT2ߑwd `7xpޑGY_ j-K-pY[{Zh-hB 2bڢH6ѢІEtJ@, mXw*~Xc7rse.2*}?~]n6VqD""mDJWpȋ.sa"M}R}ݷ"۰ [ɡ~o+,@ifACE4seBg ی9]kTw#F@JәL~!\ TNҊ0X r,p!16_ \vG5pV{ݿeEAŢX b1vf͍{*" oHv1h2z.FD>Tw{(آn.j9XbpSypCҠkYS-=j i5A}cVad3Eº"d4>J=bVͯkύcX_Iu>;/{ h6DCK)2b!b[NGAZ9pI_$0 .L%.%9$P+˚䶟 ᕑkhEx(L[ O1n>mMtmњ%8uʘZ BU,#"ȌErBa/pĭtcdbJMs0&IbR:/pwIU)xa@ڧb0aj($% Q & R>:wR=5C?COLqwX$IIyFu>dƃ7j.|ɛ!T1.V-)GjylÒa |)ؾUJL02hhtsBF0|bgMZ'$|`5H~Ū.VV%z0G})I`0uTpڢ6|ڶS{]= 4"y2  o MxЏq˝{sޞxX9TP<@'j;W(HiNR),zfe96Q6g>L܌9ft ^vDXviGTUvNT;6QsAF U* 1QGS9s"8c3iFjhVuh~] w1='pУ n)jd35Y]v1h2z.F8Œ. Š4ZDȥZs5XiC nlgg?b;Wq8|#³8ZJ k 64ֳ_>DfDv@S13\M\h(\?mCA?ZP's )on훣H mkfz< yMD<|_SV/IN"SX3„~R7A,}Xx yQa0PRn$)}G؁D~8= soP֏'D-J,*XowPyW>'x>f(P2?QKwn5'>ǘ27goӒae.WO`Hܦۅw3D)kOv<,̳TxtwzMIR{}m7 6g  yc8呬+G-8YwIڵGC߱vyX*XY7"0G})w@zUFRCmtwD;n_:be8Y1x N i*$ԔAT>JS1'lѐ/ xGwkߜ\sY*j{`"e@su2_⪌dp8ZώёoZIms!Oˬmm=iB`~'Zc K%5Յ<Ā2 ._ j-_XV`-VAS4hBmƢ5EUYT'|gw3dr}g7JBcǯkkֲ?ʢFkӶR8X0#$ 'd}ܗ:tt>r6 W4냺k "\,{dPYotך4W6[)RϧURR({R"_pdNiFZm|xn=dBr}jp[*P-rL'cFn*T]UP5PaJ8 6'#$f" T$b4=#]πG=O^ BT']$b4=#wfL_㛽2[0Kn 1#CZj1#~'j?Q=fd19x̯h/lV.Y!ڳr3h!D?k{Jw =u{oeOles% \#O(yRy0f *h*Şd)؋ >^ EGĚ(C%VT.-BA(#WļyK| 3p5N \L\b'K_v'XVVloM(ΤճAnMǫ/};X' Cws;T;o.n\јf܂\AH(RU2m}Sg;Q5]Aad+ʎ6*)P>L8zCj[S=Ցs 9'ܩ .O] u#5' SΒː~0$'Ŵ>!6e=O$vB3D6EO'@wĄ"/[it@uBAA:/;-o Ԇv$07Ub*XY3D`SBX!uf9-{hh[!*i]9I\DCr |ۺlƑ?mP[,"Hύ`OrZ#gpZP'q i#?!'Eàys;Z= 2nIaЃ( Ҹ |⠻ l 6Gk8KxWQOFX O|+3t-wfkjx%{V}[빤 Ha-01dA4{ʨ_y?#ݝ^#nrN%+t;3\%t_2gb8!6o]#iu/Iu"xN~+X9t;)١gÿ>ge$tҙLH6Il;S]|)|SA|" [t7xMmQâE)[R<,*ZTבs|7+{ 8fKe(sdØῬNsm{k9+ܓHq - M}yD,FLq^,Y p7x5㔿:u_MlW8a3Fk:w]iDu7ǸJ\Q Uը8=*FU UӨ#Ot{ӹsJ\] w139ƿAz*s0LFȽZ.MFȝ1ppב32i#5S32]@3oQ8YȐ@F9_a^sġeʨH f'g>+9YG}#;1qX}S4g"$hY*P4R4*tIJ6 x?WҹѠjs$3yϒc|9Gbv/GUРܯrSp r3s8 rc1^`2@Pb]TcIc鿓c|H-Gc93ω@jX/xgSQ?Ql5#O4W?d'v/)}*]KܮT=y汆`H"TcON]Ggښ)jH?4*tgvXl{=w_:beus c!oUP\1/VUvM=nJ5+AV5% 2\S&@)!syYjr&X?¸9~&Po^=1oZȕ6Ъ㥸^_uu~Wyq!I4o1.CrhX &}ro,_٢H`-kɐ/3REc`-eEq ,wf͎z{W;~{^zQum{m#4=f+\UW\bI-}B}7(} 0"lgI,W X_92q+&cqIYotz W4KU4MNS}dǼJ3Ųkҫh(򷊑ŁfմO]iDucl5EQљA!T~ը(߼žèʙLwٹ騚ȡ9#&~ c*Xپ{*0}9vPWBm;Uj0 z1k#|=$1k$Rl&޼S >\V⣕ڳx@Aמ (0;qq5F<Q.^@LlQ/zBX9|S:]n:8ugQ*wbyg;fo"SSeQ&&oe$j=O=Õ埌fyMQc;)·euQiiDucQ5gQ5Q_=V<L*Tp"XP{)bs7e]&bF|p& _g3݄09[ Y#ta6#շUCs#xHL%3ζy'PbT=+ݽ34q΋ >Ru ^V<) Nq#[ك<Č274=st]V4qeA˜Zi]Ժ,uYe~~Zi]ԺLb۳|A_ТkZ6Nm);å X}6^'6<1CɊ(6>YY'0<5yG/YeiJ˅{5u^<uJXhkakCOSP-LjgDKY_,Q[^/q14mΜ߄o|՚n⛻ț 'j,IbQ+/-GRU%'΢tO/Wm˺дv|0HƆ$H}T?mk񰹂-%jӞl6E@@,~XTFkQ, "E5|ޜ10Ch-o31Wد1!*}Tfm=pוE[ ;v R!kԅ 2.T)xK=|g_{ ?(ѽDݫyC98ڊA?:u \e/=+ݍ̚ok[/ҫ[-"E4g%n6 &cbo}9[(jlU=߉vLj3UM,u*5sWqq&F;>P# {<jIKء#R}wzke (HvEo@' $áUF2i"@QS/ȣSԝ@ f9|| M D~@俠N rQ_ .&t`)9wjK"gC܂}:=Uz'094ǭh7+J׉oZC(;q;q;:ecg)·^&ihiDucl5UQbQQUoQqwETq!ٿjp&K߃ȡ5p r5<$/XmFŊTPz'$V<%4 7B*+bUg]!Ws+וTC2 ` 2^3RQiiL.3#(|&$ >: w>Kؐ)x%:$ό>Nu!1+gme}%>V[Ag-\PD~[LT4EB켃T|ػLJ~C=d멺PF=yaG="z<3fFbi's2946F¬ߛ\WSǷ80V {uu؀zo_4f1}ʽ#>oCj+78kK_ Nr,׌!ۨѺDRi(ѽm`oMߖG%%p6J KUCRZV%S3ස}cFi@Fi;D/%%^AZhG%ֶ{6lGZ86Q +y}"BtoWS?]ǖ#cw/=4= uSݎO]H'\$qr eX[S>%x2l!Y<kkR"Q9M|. [cl?WFwek36ck[9j[sm{5nk[,}>\L.>\L.2Jp!saJ0? gZŮm{Wfck6+[5k[su5غNxY1F=Lwչ7)i&N+n[}[0&a3Yp9]t{m=+/4&:ֱ߷dg=hg*|ĕ[ReD)X; %z9 6̊/hpSZǹyP[n)2e2vĄT u eBY'~FYWW(EyxWa "-!xDmP6/ @lQj@ZP^S{Ο|#s wo_00> 0UֱL%I2ɟـW˭c)c;op;,m+!.W Q9agPteK.:ƭcѦOt;_9~ՎU9'K@ʡ3]$qZjF=U :{ b6dِS &{S-_˯̉+i}f;|KD)KOn)%U#,ʍnl,^GV* KRj 8Opt F |O$[nXɇUJȒ1/_ULiw<3wı+g^"+a2 w &NWPز ~K[? 3W胣(c+-K6'q&~@[]Ajf(xm 깖/x2R5tok 8^Bpo/}av[>\ᒴ-MQ pڇG>,zãcfrsl4IWV丟dOq%YN} aSvuUi(>X\(] Fsc7?V{ ՚M?΁_ӸB٨+?DZe{ lК1=ܶ>Rz4(t4coGC'$K 2"U-)[[t.W et( t/uPv2n~Pݣ4c9tX]`=628x, r.#Q1ّrd,((B9<ژk@C<P' D  #ad\$?yET|=+Q5-Z,H;m$FW/s9as=a.suÜz.=YcN>}>ML$Fwbc R\$Vw}Ī `RlF`HNI+Qe/ GE6PjI j}[~OߡB2`m\hB @Dl9͗9?c-#9pƽ]v`a?46(c)3#^;kiǠXƑrBؖý]>Qkip+[ ʖe,T(mSl阳? po~]^zK{Qb{?C8MAým2i_]`&lZs?H研g.'JNp+nkvE7~Ɩ[Ixz+ujxҕm-\QlvyJW+BwvEfwmS5DmkVh[SԶmMU:,[KBؚýehk25k25 ~3+wpBzΦQ uOs:x~Q OrRvZ=rlcVQR<#C3p5،rVQcpve{uP>#PQ܃Or AWF0LrjִQO^ tBvBYEYE0aАová!sXzteQ²u2sIdL/~YL2$pr#ẋ˼SH4Pe hp*OD7d:wǏ _Փy1_Jܿ*y3>Ο|t#l11d11l1j1iY#7*sr3wWBtp'zܜL'7ܿa {߸ĽV?S?'zܜL'<&nd`R(0$e$n_5Ԝ>2܄H.ZTbV< ~VqF^4(1%f.EI{}-s"e}e{+8Fҽ#K[Ж-vґc-ϳ .e):[eWoS4kPjsEڗmwoR<̼PzZYZJ˶ *iꙖbXT=E]vg?NzjQqzTc[u7Ku\:iQJuyx S~#5cǙHxʼED!wl7vƅ7q[~O*/ҽj[5KlMJdkVlu^\R e+0pڴi[)@lMZok  Tek ^p7>܍wcjv[l-blmq_ q~ĦE ?y6G~U\dB.%+,i7q:ɼ &_~Zp2{◼+Հo = @Ik47xK߬ҷXx]:0ҁ)_|mّcjYc^]"LY\P:~y/^ʴ?t[Px(SzD^r FA䗆s6!w67.}>a?z8-n}ҫ?xpSohշcPha0$4e^Iw#zUgթBr4vm{uP>σN*YB٢ݣբB9khç'~4lQQPJw/^áف '~'~<}2\l'Pg(/sHh!79 {|=c璝o䧾QNoo&__(,knsB}'zܜL'w!N]Urb(XRjI3)+ de`[(׆θ,^~Շy?,QyOAqvx#3e d-v~;A^{' R&&JaN ґ#{KGֶp~xo1[N[{'VI71eάe4RJƓ`ٙ #5ui|~˔Jb FE73.51><ׁ_>a1SK /-˔$S+u /5lθ 2L*l+N!}3o|>ctJwNI+#st?ŝm㺵/t^QzL_6v1x.o28 g +$vLvMe{uP>ϳ4UiGN;i@+T}HbH0{85 b) B" zov,գ,UȜ^les(nZH74$|7y$M(rT(~9?ս>{s jhOI%ֆ[Dq2ntw^ճy1_JԟR=|I,ܴ0fd\$Ǻf $EV n`|zɸ7'I;_տU21'rܪƌ=nNxw2dYh:j3$TZvB7d:wǿUn[dl2 0}!T&HvK,#a;> Y-RJzuA-_CStENlM/+䁔[=7{' FJ(Ud4@K,0,gf-MKapwʮV-vg*-%ȻnZaTQYJlk */:{zQ2Fwyo{㡃//{/Ց9MW2j8-rFC➸/gElMp+BY7.ոزsmįX"uTm+սUB;Bb9Ge} 7+ZyފnjbpwOsEڊ**[[֍-\жm \pwO O'Ƈ5Aۚ5WU P·]l=`Cۚmk:жZx-V5^)΁ un?y~Jk2Oevwe a]WᤓU2ק,?ɼ &_ xWLzx#%.tD4er MG:ԧT7=\֍Kx҃׏p;?Z[b`jңa=I!-a L:y_]ħ9Pe{uP>ϸ/Ѡɣɢݢ6 %ee;PFes2F/t/fvċ{{IS>!Id@*օadN,=!]|Q"QΤ(\\Cq}Md7%UG٢$7d:wǏ'~_ճy1_Jԟ*ˊݕ,fqs2Ļ9+CCa11`1박$Ή_OgE X̥{JozܜL'wNBYŦL  <*sY9NJ #P:7KAl!ۨzHsV{@ey($턔x5n>.=fVJJ+@I3;^/8)x&  ^;)+J/r+"[/ j|]l9~vx*ϱryR5)p4O\bzVrW> $yQ"Q6J,~Y݇}އuN9NWDlzm׳CI) =Vw2nt//_~h~+ !(чYd9J>}M$Ή_/2Vt >ȸ7'I;\:Z\M rr'zܜL'Nʛ'P+ R7 ԚRK Ajrb@QkL2˲e7}[}?K?;+v`-xT,C[:te *AǼx -&A Mb[މ_⨸9E[]qDAKd Vl.VPkn'\īq{ӳ}-],Êdiio7)m wHF!.ϴ7{t`{8ӠmS(ۍSH?(k)7N"=jܛ'~GÂi~+Y4__jgj♟D+ *\$afaU$N"2ָزq-m'[̐ W:NekaDz2R:ýywmmMZTokִmx[ge0l=nk\=C:\Qabڴᐴ} Zܛ'~r^E Kb 5N2и?yzJ2kLJ2灄d2WWdB0Nm &_ۛxz5~?Sė5Da%jr_F:}xՒ0יRk*PWّ{UݽZGSܿ_ť#8=枇 ?:*4sT2) eԌ~PG=~'x˳8_.ζQ wң|wjI[_ROQ_A2fo~ho~.>O{FrQn pJE@ꑱf=;!<=41]ы/x:|hQR)22%ա ''ɡL'ѡ/'ޚ⭹',ʈes %KVO|'gsMtJZ:qs=nNxwp%Q=^g_r'~<)/V2ntįa'a'asp| ~6cqa>Np|8a>ot%l*jܓ]&Ro3r2ntį4\8jXe(DWgRWT zuB ZFvyocoh''~*RD[(XRvb-ͼbFiKvꖢ3+5{įS[ڋmi-ZS,޼Myu"(c)qo]vxo;yo3;'{p`wT{;'ߘ('QW RC)0|rR; /Q {$ 袛 j}[~ ȕ<7f>Lx NXNpgCh,[njzsg$o-x[]lA:umkl b(^Wy 턋x5©;utmVh'<?^cҶm b]LN\p L ?y6G~U\$2#[2;}LwqJfOV&R2Ujlej OjK_Å7[ʽxS~Pf;_ܗWǵo}XS:.Om_耂eJ S:`3q9ֽ^9wO3Ϡ ,cP5O/qtjt pZz$<'=>k<^ꯖ7}g%!GQ|twѨ{J=Q {>rkͯۋ/\=OqgsJNt-= &֓)`h`朗*=fnU tފ=jb4Ӳ*8|4C󀂡'O BOFY8)"&Aa?C+4S!=X(k(s(s(qB9vꉋ|{º y=q/ӮPTI5On`&)'C).D+巇vP^5C^K D 'zܜL'gx5Q=^0g0:a'%{{Sȸ7'I;_տ$$=,#[ %=3PS9GkơΛqs2Ļ ʫ_愀r+Zʁ7,s:RjIőxʜPzxZ"J-#Ipc}ly}GK-kiD[gLM3(Œ(m, Lji(c).ոwoiIҔ)yKSҖ--di36ci;Yڌ */{ C/篖.xXJFvwiF3N4NQ[ig 8mqڴ om3v0Q`6I <V'ձL*PJ],늼DlW:?F諝M߷e#~e✣PFIlrQb+PVlg[)m i&s jܛeY s۲umV0ll .iÌ> ihIJb]fwyѭ=}xvT]^=7 ,NA0o^X>bkaJ(c+/[m5gmk֜1;[_((o BC< }Qepev ҲLAZ89O-Doߔٞ'~L *ܭ5˾ -EgL,F:}x#\2V: 2DD:2#D0]'~^UwW'~ս:ܽ:Qձ]El4?HY?jY2~'Nk2Q/\pTz2 įm4yuuN{u7Fxjo)~fNmQOV7961cEԯt{dL&Q azHEp Ap瞙!yǐH9No~OF4ƔIK9P ]>.q;!/S [/#>>k[w(턋x5n -Ooh'ߵ`mrm .2&'-/KDZK" !2R,po~]YK;DXۀSRfvF)dTjSN .e{5v9MI{oH{Cޫ"t{-q͌Ӧ-m j63N[:|nzYڢD{3;8K ]eW1VX{Hhz$-(3;ByTW|hO o {H-J>uPbPemmO.|p{!(N_2@ i݅V2eO1]yM"ˊS~8,'L/_P~2m@cD0(,zܜL'!CYiOi.r-HkBӘSXc&7d:wǿU\O sCw\]}Q.i8"ex8G֘t#sO'OsOYZ5蹧/12nt+K~1R?-?zIőy ]s ˎruS;"^ocZI9ΖJL-A[F%* ]9 /*Ad#-vEVwu4k ThK{QݜXt~{9njێpo~]܌Gp~x=uVf4w&¶V(3sEc_y6G~UuV0Ŭ$zdzֶg'p2N^UD&s/yY+AD ?; /}KZ:ȕ蠢VD7\Do1jiX]<~{^ewWq{YNG_ӉXsMU*rUrm=~ǫPe!ζѪ'ê?E-. _S6*욻?XihGS6Zn)zU=GC㇤;S%xҀ"AD@ϽƿcoGyv2g !4PPXMA eу9~X((*?t/7^>DPPPP5a&# hk52ntj$gkcV000W8a9d11 =˸7'I;/0'{C&A6 }{R%g}He$iϦNJf%RdJ-#q;B^j-h'5~#%%E84qXKe, k?y4[bθު:҄dY=.OhcXK/hw Kخl V_佇xqxa77{{po]vn,~K u҄bi1_^726(M(MJRO GxT礻rm;sD""$S73.51><ׁ_i?alm]TlbI[m!^@yDxӬ-ҶR;B^{/+<ՕY57܎/[6\\>բ#}y X1 $ۚWؚ9QJd+2%!z^d ]tc; \xkkƤkL~Bɻk~kz95^g;;_^Ta ^?(R*ʴ?OKңvW#%eD=6.c1103(\pw;ϘD N /S X SZ~RlW *ɏ8UA8A8ɏӮ/ev__}^T+JW0 #;-@>*Q{q % dco'Dv*pMƖToi'e![[ $^dVDlvxruN@[] Lx(lu髐؆Tx]lUՏTl}b+YBJTKBއK5e\Sźez75>oQ> å;ܛߟlhl'[5[֙ Fa8apR=QXrGFDC4=e^ej.Rvɼ{~Wl@ee;UgU*gt2/x"s[c4_Mz?ܗWǵoti\;a:ik#;;֎Wݫluaul%1(DFW7R=Ɵ2Ϊהz9'A̍NeFKgѨͫMҏX$K=U̍RO'<ۦqU~s^+i/ऽy+*JU [Ko鱒YQj3iA?WR#=gD@}#PP&S SF%BYʺ}31ԛMW JNPdQQhQ_Fz%'UO'OO'/^eu( P&t/&bյL QJO5IPle\$?z~IT|=+a'aN'aNst)e7G|xa8p|Xa8FWs?00fRzZ\OO0NZZ/fK<Բ/,D0 -9ܔmly -$ճZ( ҄ˉ-Cj^F%u/( MW$fCZFVeqxKiГ:ಔRhKS1˂nT 5ׂnڶ#:[բ{h77{{f?hi2ϔdozFQW3Q<;MlTix[cGW`yڑ_.5I7Rո7)r SNWX¬@uAgO*3#/Q+U9_t̋YJUκ=rc8}[6oi'_rR>Ho,x$vx^\ E?. {3x`msø+elvn#i[焴l ߒý]Іk2Vs!<@[T9/T`@[]|G{3xb𶆮,+W]е1x[zXלxI۪2d"HI|R< }Qepe(UdX\2 -KL NU2llouUR|yWp< /ʜȏζ#&7g}2:K~ߥ/(XOZNnq;]xCt^9;<6j?W5?+-{Vdϩ\U?ȫiTHc.WWH}qI}pVhgscӨW)|=*\(zt6gO!tsIs|K3s KCv,fHd:wǿUԝ??7pܝ?7ϧ`u߽܆`A-GfH.onMQ [/#}&0ذ] v"^ocZIPW:Hۀ띣ڰ˛ Rlci[8XJ턋x5+۠ JkvQ~f9h J|E[Zoi-ڶ\ﲋ+RySAk_Gv?i +^hFsy~+%b\g4D)K(,_YT"[R=njGt1NO5SMSl80|!TSk56Wv-}+[~ vek+Z.ϮUu}݋f T<.Ϡ7 K[[Զm- bk֖Mp|8[WWE0TW0txamkgPNFck4ƓIm 55mkjԴ9ܿ/6_CTYd%_ &(ebe֫Z!fmWi~#D2ae˺~! _6 p:8'~oѭ}\hNGs:ӱYtdD\сx ~TP>V |tPFQoWOjj ＲI#sz؏[1R/QoHȱ<8/?P:s)_M81Ƀ58#4#pO^2\kil9ֲ̑ck9Fù02Pge^PfUJ=эSo i,ʚ<ʚtIPbQʆAEy`vo4KODGOěC2ӕgn~)uCIWTI+_L(6dPtH0x Iqs2ĻׁB}Ȕ0<)Iqs2Ļ~ObN7?x^,sV_\fot9czܜL'!x i6sOz#C~Q9NBPFx2ɄW9DN?Thb-B5-\I-|+[6oeУ4@AS0hk)g}WubԀ˜sS *#9NO /~OƙwE,jf8N}s]-[B«qBwzQ3Zg r^ޣz]g /pp)B 8ͧqj,MԼXZdi1po~kmH]2v 8`O]?!Kʆ|C*ܺjV )j}[6oi'_leUXWf0mbkUvy32_u%PqeU`NW .<*[g~mAe+3DlM]ۚ5umkfwylw>'kYl<@[mA<0lgv9{;B{?k+/[FuU)M0.)Vj# 2N'mgFJ `Φ ŵ?y"-DoXf+nJf8ÒIVm2 eŤ}l[2S2vkwBAB[$c Cs_^׾E<2#.R# uzHGLLh#`5A-;#9;cEGVS:au)ъ1iN}>kjv2•9'Au?rI5*QcGr+ϡOhSETj*݇>/JYC'>Srē:ZE˫5?}e;|D㣡qk+ dZHp"12X%{kggz~{uP>-)ưRrF!<,aE4 2d*{~ցLee%][(BgUT;$ĺpM߷i -$KaHJq@/4AΌ1ZlgK(- pzyC6FJ[턔x5ZK/w!/KTRl_,ecwli ![Jb[VWyA;yo1[xo;y0; e"SP>8@Ezj_R$+!4/E2+KB ^wQ _nU@qXoj۹3[!5[+vz2oȎ<߉nj'\īqc}ly}O[ʲЬU#k[GB;BbyhVnWmM b]^Zdk1ǶCۚm+*[m[ɇs-湖s-I-kpS5";ibMm8{[l׫?KyͷܹS0U1|B'<ȯʼDf/j%sJ棺f+ [5ΫWcK۞d-R4z7[BHsw./}k"g#|mќW'ï}oNG:}[ǃ5jM\p6ݽқ+Glſ]Ո?j@i8';K2G$5JC=~mQOIizHlםqW>WtUws_ظ ꅴky0G|V;68E{8Ċja{Ձ-ӝ@}lP?dAʄ5B%%Q(2+pLK {9EIiJmPQlQ*?%Q2ϧ''~'~J`.LeekPCw>O>Ei8W+%ɸ7'I;yMT|=++09Jî.%?ss3v2Ļ>'z| f3pk \q2nt'2%G0 ,LjQjI3yj)ˇ{o ZFvE7~ǖgw:y7m)7WFhFR;YBHlmi-ưǀHiKƽUvegiBdiR.,WmwvZ,sQ,XJb[ NWyA'{x$1kYK{]@NWO+Pj}P}AJ[ED%>[&W<,ف6nj'\īq~S]s($ '5pLxRhiy˔$ Gu6E73.51><ׁ_\s[YP<'xdN /StfVθ 2 8VckmS*3r;BLlm+^H-%vƅ^WV*ڠlv5vmk:):fJ+Pb5%{/|a9YLʇC> éjNpVV`D6PVl_>ýU~3j>4SIsZZ gsWe^E"3bW1&1/2ٓNMd%R(D۔Vv|evg(3`@g|d#MG4לi}%~eP>jPi5f ez(gʞP"mPsɗ~C2#su1u~*+Ϡ*TѠ`ovTX0ȹf0BGE'*$5o?V?8=?k@ D+ 3^KC֋F2ntw^ճy1_Jzf 'w2ntyyBa{15D7d\$O6Y'NZ1 oq2ntyW͐ڟv3gT,{ܜL'we_H3hYHH%3jeջLfDEl_op1>< ׁ_(lXP,hfܾ{ {e1}!FFz{'%Lb),{9,R;Y3[K Y.&>ϥCFsw{o1[֓VE{JϪ,U @꧘te?*=̡,J3͜z\RvDmi!fjUJpoz>7_ɘ-/It^g @>*Q;/QI89'Id˩;M턋x5nJ6lz~K[?I,+LE/kamM3!j!(Y7u%9ܛO򶖠mMAۚ5mk t[lpozVPN>GpԖrf|n'nƇýYZdk5VckC?ϕz~8[I?oY! 鄆tiz/ʼLǻdBn%J+*Pv~wĴJyY2ݮ=8ۛ}ƯYL,´d`絯w\0N~K}\!/}k"[DfJD[:O*5Zp@Ut*{usTJN2^:A)ع0)判yBH4R+xϩL¸4S6*FnUT\b4ڛO7ߩ?N׫,>S=%\]/ `Op\Xa WXyZg1=E<8-tiHk8|4[ %Wy\(B es1 %%8^('/tBvBYrB_o??NO'~&qP]0P+!v fHk33Vg5 "ZiU 0p*u+zܜL'!Kz66YIb̕^ʸ7'I;Ts?8p})g?;999;asrwN%X%0;߰,˸7'I;TUaҠ+/44,-Q;/Q ,#9 owXdg>}']cv)4ZI絨NKZ/ w-s9Y?R}8-TR}:-'Týyq-f>|Zf,wPO ,pozV^FLߡ%|PRxoTޫpvަ@lVg^&j:#uZ$}گټ/ER>XD՛˜-J_w35Z>8Eg* kxrG0@N+x8}==L<>(/p1 z4\_~Οo?\S_wV*?m[1?YIF2n g1ڑT!t>S^7,Tm0>t Rw(ꀤHiNK{hyل2z4H;njU܁WuB: ;̒Xeu@RL[]dnBԚd"Ǎ[ae>$@e+z;@Bq+!>lw76R8_˼Qy:w`>5 c^B8bz GšlQ /zPFFgRmyg>P!A/GK$fKDH?ߌDoQi ɾ{84m8K_,ʈm6O5 A[߬A@O4PԺTHĭin+3 `o]-TΜ_mu":?(Mm[x+ު&(vz5zuR6/>e;J̨m/+ofYaw˫bf+jPD W`pP0PctPah@ @m>0Q ĵZ~knI[%q-T拭!a_׺)&0rݜ`٨d# q*Wڸ $b 6ZWuOO)_(+2.ysh IŭuHBp⋰MRZ )o.}/?]/x1o<>!A+@|l+ ۞/IlQ ֗?ʮe~͕?8Y);&3W~~E凪#"7}njC _Y}~>7Y@f sC0)$L^udHRHmxAڱ'oD Hۖ$/ˤ9:h>m|$k1v fVN@q`gI-[G^. 7 Q :Yzt@ZtyמKU,߫foVv,{!0|%^; w/@-ABR T$NJ/cO|| V| >u;l~z!?AA73=A s XB3A0 Z )o.}O,w TG6ZCjp'H 6Zfº1>$幭 2bm&W~~EgTK d^/_#-/=($BfLǝUw_P`q"'#G/> )iwͲa͗/$}\$7mK'O9'Y'ܫ^5Skn>?JĐއJ$w-xt&:|Ooұ=}BW0,ҢàLt$\i^ 7+ [^B`kBt@鞪J-Ͷ߬8+nyi59ua@9z=;f(aIټR+ćD:f|q{g9TČtr+!>~翇q|ZfhA&!U$2)`f AS%J:ºeO-PgҏyNt> dW8i[sr{Y塲dop2[" 8{@d˦_ӿ/||%%nN/,t]P:$5{c]gs5sus2sgfoVvkys/ Aٽ[CmP:,n6 '~XѶtXU\׳ mJȭ҇|DTJtUE2kl%4ȧ"NVĸj \88xɱ6Z ܌qphT} e\θ:=yX\ځ4B> 4Y;$Gŏ0J@SI| _Hs;EX?$Q=H'"SXy>71}R3e>u ]7Fc]:M=yM ]J,t#:t0aѪ מ[y"I%s<fl͊ g>PPw ? Tg=Ͽr_D)w7M_fL5JzMv e^+ ޏRE6ReQ jܼ']ly',lOeNf3-{䡨)J \TvEr9L PcD-*|vQk/]|4b"KNjE4ħ1=obg{E p(UA6$6Z⫴pyyg>,5qI=fB p}(Hicq0c)c/I&ԊhpmHc=f{żOK μYTUL@Uծk7$y#)FrA+גź;dϟnjFS`s"_x;bb#"^m2GpSpS <($BvL:ȝAUw_Pdf" Τ3{ֈ<ǬuO"Mb0d'ѷ?7K섦mI^'lSnp<|vOr\gl4j?xjk!Ӂ v\!!F~-#^מX{Yұvl[BpĪU(Yku I%}U+;YfoVvXL<H9Iv&"rZmYqVn`x"]׳V(/'_`x[ؙo(Z9J:4LRR i=$/oW#DIQů8ETm\;GYjI&:5b0`:(GKJkv3sTۥEWU9h 1Y߿F-w1YͿh@?Vհ2 !ǶF[D$ceH@Uh+5&ԣy\*Ǥ4W>1ϪG/X) TJ(n e_~OJ ɧPMܮhMTw&7܁L$ z\+i%yx᧚Zpԭp< ڃqiU$uWU7rWGG5"Tcte8tE]]]: saσJ\7foVvkys/ A?>Ldˤ+/fc8TW߬8+ny_Eb/ ڠ6k`^|}J[11?E! jܦJZ4LJv1oE (H(+`>$@2qYW \#@(º%i'](pf 潫pIÑ𓒤NIVZ7Xx>YkZ6չŪa @h @>ec^gԙ/IBGlQrʮqUI=Oo_ex1_"pt# ~UMxnX w!D3x˾~,>_E`mLvzӢDn, CL4U!ҲR{]jwͲ5 e|ږ*%߹o|ѣ?xOa X cJp܈v)-=-xtBڔ= =\Jrp!IBA< ґTgı<7*t7+ [^, B`n#{=\^I։`H{ao^,[!IIӦH:6|*L̓NTY4Ȼ( z5' n3H{匭߳ޙ8Ewa4U6Rr\rFΆHsDEnT:h\| (,y; F(\X/ !(,),Svx/oڸ {e_P)aNܞSidz~[ޣy'1KYaJ犹׏ 8^<麞xѼrxc$GIP'i(Wv5ǒ\N"[ȅT Oqm4sV`'Оvo]uir֍ d3ki'hr :<꼲8ٟs7h cXr3Ho*奨)#;:e4F,{@ ЋLeGeY,N7?bQTMY bAk4GoÑy+ID;\B TqQȍc/{z[eQפMy}m= /EЋJ!j㪩OF;s,{i(ѕ\E V)xHm!9k߱G߈{E bŸ'hrŽjpF qսLX'wyFI:~+I}5 MubP1Ԍt '%+֛$O:ؿw( ׵i*qz3GULJ--$4 ?5ӽ-ozoV ϶PT]ˇRMykwt;/;O!{h'j"}\Xw^WvC͹4u}LƅTDMT<꼲=/%aʹ<`X A. K7mrT'. *wl>p15"PLcЂ"$|,FcP >;EEm= _K8c5%Ri D:̕bn ۩ G\󴺠_\嬭#' Yοe =G$DŽf9/m!9k!~֍GH(7RIDT`r\4DQ8 JZȞH-d?Ϩ@erZ}ӿOCp_(_=Co3y_ϲooxZ>Ju.<7Dq_D\kQ=a:zk-O 8^ kJfH8Bn`뱞6TZX|H󛂡9nЌ6fMj] SʛCw'kIcTƺ E,>RA)>J9AYD.hdiVΫN^@oȘ9wO@=1h?N %[;+;yc[‘.1c[2W7"2V׈5\x5I9i *wl>hphD`VsPNI"s¥8oM"YF8.aGM 1 u.42RlZ, ]p4\%/ȕecmVn UZ$/FIe#rżr=6;b.p3icF 9JDZs1D{Kz\匭 y=*8^5艄*S7P `0/:_,t|~_ `j1ղprkyouQ^O?PEg8 $[cr C£lљKLpt66@CFu ̓mcp< Lo[oRuٖYw@cVpbt@tH vm@.? T m7`VAy)j]%_޺~a]޺ |xoDZXTZu,y~ye'/k0Pknf|"}vwyu^^痤(|!pnS v¥l­b9nvI(\匭.οOf?PsRŤh E)rDV~$fayq:'\匭UN0bւ\'{Z q{.Z o.P8̡fH|`\匭R] +UsJ} , IMC1R4${̕J}tTNQ^cV;,^pRd"¡:H^RVEJp93WЂvu=|*!x?qt>RG_-gr{GNψ`Q\ѽ~7j Gh41p2 oPF6ϓm ]hF ސ$ĵ8*F%hP͈nR_j] 벵>Wnu#83DgG_!6*ko#i'6 \}}i;:eM0foݤ-X)=Vg |W畝*e UkSW}UDZ1#SBDPp 2&Y~lQUOwfȕaJB$1cвfleFc"h)pS\OuI+ֹ^I匭G13$A Єt!`%ʏMC`C*0DVU`YZ%CpWE"AR%kX*wl79~)i^{i0a^{e0q^)=8hrŽR0IHFwyG8> !IaWF`77Y f&ˮӿޡ2`#*,73yL@S6=GmAs_R:kv-ڧ|)ǰhZ\H\JӃmAvфI{Hg$8Oqm̚_uuXXWۭuҪ:$uF 9 ɸgw}w^WvC͹4u}qtqa*RSS+lb;:eaӸ2^!h!&έ1eLJIe>^V; D|eV|G{'P(\"ft(e UXOq(;GqSӍTlZ/ԃ3&U͡ 6_DsD+ΐl Y[=]G:p-X^Ns7BP(f9"v mWBzO?5?A@2UX)d\( מHŵtUopµqE?PeӟG?P>Cs{Dry!~/˶1ޟ=R-kCx,=6gixS.4>N|מh 7ȧ{)\$C3ۘ5su0Oa 2@˔ e`sFY)dE3(`g试j` L{E[-TzE%aߦ[x 70afxPJ[-Tz%EsBmU&.ޤ d.-YNޗʘCr YksnoK߹sqqkCŚ!HjF 7t]²к, ː+u7\aVt_Ϯ}/ ֛DI1XrВNIF! :+*)[ ǹNiHzVӪ)[$q]o?7h;L"6ӀLp1> -='{z|M-eX̷c7a2}`ƒA.@??|mE{cOyG3)>=)^!YR6=h|Oyxe2~㰣nO88ț?quX\] ㆶP+?Ӏh˔rCl! Ϧ|&?T8̯G?,:OPhcKؿhW:icdòdW_P>U|HO`1N ~ >e 74lOa{6(1ЉT,F@2.{ǤV5кL_|Nů6B~28̿0m3v_;X> ^=*xHg|X8#qn#Ha^ 4݁3BeJ{:ˑ'wR{o$pT‡BG[\h<-.ߚ;L&izW2<*?LcYP2=EvpMuRzGf>E+k'VëUoo~yNkkE3X;bDq᳛< O4 :ɡfHk+3Ēn#ͻ5նKâSMe!pT񂞪~3=^w Z?@,77gf65iėݖ=Fr1gY/pT?W tOɾu~}`҅+ߕ䁣;W m'i^:weRB$4WT(Em]$}qjc>pkā2[fS9 kp_˧^_q/ :3Qu0c\Zc#^{xE+fԅK֐ugsOȈỳ,G']dnTB#a4,DHetEkHidM6h802D^3)S|K;]0yj ra9A fKCrL R D.zU @`^,gm=6802D^3clK| xD[m < Uxh0\Rcb3|7jXja\dM1h802D^3ఙw.C^Pang|y>%ܐ nfGpҐb6 f6Dt# pɚU(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.302 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /ca 0.302 >> endobj 15 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 16 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000064277 00000 n 0000064360 00000 n 0000064535 00000 n 0000064568 00000 n 0000000212 00000 n 0000000292 00000 n 0000067263 00000 n 0000067520 00000 n 0000067617 00000 n 0000067695 00000 n 0000067744 00000 n 0000067793 00000 n 0000067842 00000 n trailer << /Size 16 /Info 1 0 R /Root 2 0 R >> startxref 67891 %%EOF robustbase/vignettes/plot-fig-sdscale-all.pdf0000644000176200001440000030003713465050114021033 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180740) /ModDate (D:20190509180740) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 93793 /Filter /FlateDecode >> stream xܽɎ%ɒh/mբHW~(\o},z=_DT"#]To/__/5Xߏx&dGxyė;#Bv>\Xk/q6~oZڔ^X2 a+)ouƗ#ӏ)h~@Aίq m~Pk?@z\ވL ^{W>C\yHE /Yi YzҦlRzi:HCH2Z)3;& /8_ -g)W&>_S^A8IT^Y3Ձ8˳S^MJS,9ڂˤ I&kl&[29Pxs}cLIo"ɵik¶$p6S, $l!Wo^-h޼&S]JLi WwZ3#QH:J[Bh( B5>DB}e HOF?HRWLުP0kv59~$٣_*Cs#o/-)Nj, O{H!O)7âE;=Ų&n5wV~rWHzGsiy+sZs h C!A.u_ 9O5!1fk447rޛ[p9C[z 9=6ï&57gnof ~UzDZL[: ͬ;Z07c]_]ͽfs֗ZlSw7zV}F;V{Ctϣ?<꼲d̝y6ŵIzSa$RSRZuxu^n~sY*xQ730u@?<꼲)mu}ߐ+8j;m]qC;t6q~nf94"஝ε\:k܇9O5(gm3/m XjK*^Ά$LRPj9P`HA9k3I؉G.xȥN,Wש8k¶r9S!ע44wP;Kti :bUcx!m Wxu^9AѯmԚ*fJm[՚_l5t2١L L]=x[KuKm&QFka)f a G\Y.9Y?l 7r6aìS85(gmsm\-mF4{ʹGѴ܈{'(q1UJ \,,jV[\e_r¯,QReUt'Yy"Yk7ur}B2)4X|ؔZomC),"K6e]NV%l_=]B&>E{-~zӮ5vyoWKl۵׽]3]guvۮov9u'ݖGnE#2Wit:)OȵtV'wN`L?@Ym[0~ 4>_u}LAYпE-qQϣ M@_Ȭ:?aY+Ղ0˓d/>]ɏzsHchHNl Αo?^20^\2s7˄3H;:YJʰ1s!8_Mc>2Υ3WFjsG"QDZtn3IǬǴ+1Ցl1\k k0#Y~O|OccNY΄>/?O۟=PuPMm)eZ.biwj 6D뵹'.ė9x t6={@!_Bw6fӢ(q# N8R2c _+a f9"ēuq$kOd Y[K}&D"mIl*-r$Gh5k}H!HA9kc m\\uś1㾘\KrҔkkra[`{[8ND>UUa(Hag>Q Va&uЭy紇*u*PH>l U5H"xc+ 廙T?*TC9&gc+A.6ڞFgr9'Zn.Wiv$U{ y.6Z/.imoEmo{ޭY Zo &O!A_jL-B#x[U~S9'(E2O橸!Ar%҉|:ӹ"NNϺx@ ׺M&ƻ_8I$YZ.ANHzF[ψ k/;3-u^5\U;VV:Y#+{xY;sg^S*Ot]i iU?<꼲>~ђII_*M2^ë^Ω  cnhv51&.-KP>*jLe.+KxͿ:[t]MfsZXrlިpȕP X,rMm++ѽwS6RZB1-Gr+-iԶKô\ZlQzߦCOL)I_HM~ PpӡmţSU|@_c'HM6!\9I6_6([VcYX(m˚:+ٴQDwSɛdZoېLL)b'[=2²Dn[dZ$o]$ko}rc ipKJ_hd.CMjS^RR P"m9bLrR;at&mFoZa/?b+>^/iYfXtKkʺqu )K #u)1tLJ;aɽԘ!ql=V[lNű4>6y-7ˤ#mmNmmMwql86&Fzs-{=.6&FJח;5N)#~u 3\d?VRvYMv_,6OOiw?n:t>O۟}߆kB`30 k_kyf]/jAf%wf_rmJ|dN2|p U I.n_Q̅,GDc"N됎**Gl'$5 l/mD5!J+!{ \*Zm 95MZ0䜭FfZozݶ޴7z֋մ^[jZoVo-Խ!G8,^g \z„Ia[!baoay*uJ0M&Bҳ2yeW5" KB>\T?w*TwA}1Yq1?&t'O|<1jkyH[9;\ǰWj_ ,#uFKstf;^<w":ޛ("$фglc{x:Cq73^X'& 鲵\魘㽙~~Lh[v=k8M IV~gp75kjߥ3$wIج޺[1v>53juݬZW=YR%WwO>d #@Z *g ^ë^d~'c p]{ϡ y+{x-YlV* kQ?<꼲s_1ť pL\Z}TӼ7H.v_ݵ%ftmH`@ي-_] +L.\^$[8RPNm@Bk^i r;)Z53MktqҸz@?K|?E*d 0ؕ7\߯>l@ZTQ~O- h X'ҚG'wm:^_2ƑX4X0UBQO&s(s9 msȃ|.߿2d2d-Ch7eFO!s=tؘKǤ ǓuFXgO7;q|3 ׀`>|#{d`D_zH1Ko{NVz-}0s Y{ 3OpԗĎ}%óNmoTb~kc+18ZuŌBϯ>R|.~1}9PRKU~1sj#s}4֎H֚s,at/MɣhսYG <4X fql86&߆XPDwNDZtn-L FF&eז 8΃Gdz$ Ovm2e1lJz#jv=u7zpJE`-+. +y"Yk-]/mwp);jvYhr{q%%@sbavAza$kwZT[w<|eK7-_#bp'NI{Ҋğh A9k+ateτX$p|NgJQ81\*x$wQX+xEkHz[jdma[o7l zqݴ^l륽mmMW]RrY}5@O \VX,+DDQQH-HiΐB82R =AzRhT CH !?&;/kPDj7 ,~&oU(O= W^LV_qu&,> \+?jt-x\mʿWiMI;}=CDn$S- ۧ+ ;OfG#BՁ /ZDeTs[p#M%Kﶖ|+g余>'>92;SP}ޝ7uiYG0 p`VoS:Yfn[wl]%g f61V >5>sZwi>+uW:F ɇۣ/ďKFS4]{!kO|?:ew2μn >c ؔ'K^ë^",7Wy7uTg[foV7u=JirTv\ڍ!-K#"06~r^l~݄MˋmWg+,PZiFٍP7BlHmF6v-!$L+lR5Aemǜ[\iMC.Bwyu]=q]^fc䬭C`>' $1b>'Ix\(م9ᙢb>/}m_5[f5[vQFxvS@ϊGX+rGo--g9xXZ\) rGtSjD{>-pfXD p1"waXp7>bbB4?FLA"0?hLr(܃"-9aGU"*5kǨI`Xq =11Hvë?F|mlo^s8ّo9ңf q,"7E֩ƒ("w`p?(^\=`Vy5;ﲙq5Έق;=~.mk_A/*MSjݻ^tNu/'c]eo{&V>-bw ŵh%PDvƥ3R|[ޜvrR0Է[^W0μ}JZ `KԼ*<ë^3*Bc^}W=g+#fUHEi<-iisֹn$*1s=-.DgXdt}H@In9@o98I2ײUPML߫_1kyBr`yp}HH}g 46GŋGXS9s@0)j k()CG_)Cg,`Ɂ# hP5A~:p7VЍ(__IOຍx{ƓrLQ6I C d&[xRC^>/}} "?uasWk;!Av>Hk58wtsv+s;;LC_l~H;+IloIim[Hzj%FNۊ2P,2H,S`'2ĩj [I !St0]][u/MioiսYFH[ۦ8_McqZeྯ<$~[A*7cӹi|lN*bF%Xe B'7ݴ'qPEoe,MxC;NetZ)ix ۬7vsESx/N|Y&Cu݅QJ[g" ;$*[Ef-|^e8{QjZP۵i\Ȃʵ)eeiwވ+yt>e`Ё\OJtA,E$Ԭ b\ґڊD_3!iwhkdža\*!ZMVr+RdHC9kc S#coj[֫{UzնZ/z9֣7z9֋z O up$愡GDXO \V)2y OJ,3$x =AzRG%5!;U򏉄*NT6LުP]!f^jL2'HFpm]AV~؜pUISg.W=E^v$8Ub>2^(0Y xo2(J ņR~sn:r7y wZ$tr<[fs2ӳG-iA B9 D;_U.=KlЬ+O0alUʼnMDZtnDD:ǦsIQP'Eoj;m:ǦsolDg'^J+1wuħdeޢNYȆX,0eWGXM6\8v5Isnb귑8|)[|I /*(%O<Eٌ:S_ʛhZopM)B6 d@QM/m (֜Ҧ\"YkM<߹Q9aՎm5h!] -S8cssr`\[Z%\嬭'Ϳ>b9gg l rLD /ⅽx/[xR()W[< FLYa0b2 S:a+JY ϹmxF'&8!~.[ey>H ^:U;S:)'#=a U3v%iU >Lsk]gllx:' {M=c_,g鬣#$NNt{ۣyHBF$HcNë^~'c 0Mף7Szaؾgjt:eoIIfs:}UM2:+{x[xR n/1|͋L{:abwf <1b=vb2m%sS).5qD~&_(Ԍ&y&yxȕh`8޺LjÓ"mT{1kiXwW'U٩%K}^W|7$Q0=gAXno ŵF[=K-;V;H_[Utë^Iܙg8S taHoMW=}<{g8ԏ?:e?'1%z7 Ͳm/| A#Df/⶗%FzAA.-V{Rru2'rnLogNP .5*=AbC}\3Ywy01iD̓hw) O"rdA 2Lk AbBoAI`]A;:.^3"wб8hqtƔf_2b6w<$Q`AQ'dpF2~3i,'A ߙ_5G>AK=#Lzfߩ>%w-`ћ6}.zsĎ}hw(sa]gAbV_hǩ&%UczНt+{uer;oׂF+s(?^DZtnYuoY^vCkMm υ~ql:7M܅Qgui%cű4>6"rGo1b]__Q𻺾@vu (-]źgD]˘/O] ]N?%`pwCEQT6#> r'DP.uv{aESvЃA2TP%iYM/H6EY7eشn<(d'tA$ޅULrD4 ]M arem Yki'$5 l/mZxad9+gC"Ǯe3K@9$P)^8V$L09gc S#mob[+{zŶ^[ozöXB2|t~^Nu I Ua HaV|U*SC!c091K_ Q⮐ɵi ;iN>Xiw& #r9'cq(PrE`/y.FS\wfq g{l{|~a8'{pBn!>iBs0:cP  1ϗ.[͜{t9cxٕ)[tiLHϐ4lo_1]㎭2# `\*u.ٺ/qsuW˾E9e퀔|?:eז2μ]fAқjf-?<꼲>~1%kV^jkZVk^]-b.kۋ+bm}nt}βZٷkV B8b Dt%O:~Bm÷!SE;(q!?{9)}Rr%>Ѻ G")q6`, żbb9YG]4E=Ǯ8H?e<-qc,}\ ..8)8۟Ft% tےOfI³%]9؅M|dݟXCצJWbC& P@ `fB$%2?*bٵX.ZCkmR3tNHkFփ/?_}A7iSvzYkjM>CWTiwo0LJ2)=c,?p-E!b,u ڔD1=Ec-$$<1C?_֠8 0ftH3~.jBX1KX|tq" MopHp ^^W4pKBJ1TmO]C'{q?}A̾ D6٥ Fg73GSt_H'O'OS͑)^iǟj-7\0ֳB)_AH`2;Z>Ҧ)jUr0)^uzf}o\K{s'~|i+w|G6Ww69a-n, IXXHë^c,ܙc,cyc,E=RKc,a,jԭVgq:w% W='0DXܶJUhϼ ؆]_+6-j[VViUe*V:i /VLB&XJD ~& $MJ $&WpĕiYm[vy-]^fW+Z4kF3h.o4X*'(8 -~cks][kCwd^!3m tE7˕~y"A9k??݀!aۮ[f*?sb*;W_łV5]Lk:l>dP) $9&@z}j>sż;ϴg33m癶ef;O;O嬭| WnG5iTã, ģ=v@| Ynţ|[}@ay S܇!Aݠh}^\[[j=} ] V4Bu 2 +B|}9$&q1p1$;%A!8"Ҋ +F\嬭|DQƺ>es5hÜĥg((!Ś?JP݃!WmC0` ~F`8uDYЪm>G[WI#3!9kaWMB$4ny=kΗ4UHnLwWגhDDvjWVg$4M(bj"i[\ 1Db =5^`* LZ,gm4a$00Wf'%'&x>iN۹#Wgoy;rn,M+wR@9"rEc`b#a;r;yVYSuIuQ$*+leV C@)qY a (~O~#]$ke0۲}B롾@=)[棭,KL2d{y3bYk+ vY2Se.DlY+Ҥ#JKCXaYI i'ħ>D@Iٴ^Kdz̪|qlvo}T-)WBk<>F|U$KT [R2A\YOvejVn&B\Y%:bVg_!ޭn\Y/_Lݾ,bpJol;Ԣ'R,G[Y& 8E\Ew7.vcYJZ9sBWS=<#^5O1,GDVRҚLXk=\嬭|n:g U(#$EI*%(@` Xf ,Ay")Bmb |p Vj>s@CkJr <+5dY[}灃:yD&:zB>q{r Q:Og@!<%kP=|cH9if$EI q]ް .UBq%kPv0\F\p/D>\(GĐvɁs>km܎D.Y陞J(:Ua&nm WqM#8 _vCn fT~+3.v{N,0t燔- ),JG)7$ qB&>dBveG&򅞬>NZe'Oވ/P3OTYdy_̹eD kRo~mc,QQ֪;QP?c'H%as&DR5Γva8OfCD'Kx/Γշ y2{'o3ÚITI8$ĥxUCD1 joym l(7$ļf|Ýsvy:Oh:ψ[td~obI܉_%q'LoMגug'( c>&<ď7=03bq^H6fB:2E> {(vu$i)o`+-<:irVY$r <wpij]"Yk/Y Aֵea>ʲCv,˽Y2 ʖdZ}Y&>kԔ5ԷuZe"OE˧iEJLeh2M+bYO{k ANxXMuP nߘ䬲DY r0)s0$ʥ1S"Yk.#HJY3MYOGeal0Tx2v"\uG9w伉Ov{+K`8^IؖovB|do/,Ҳ SK{8> _?~B|C$KTѯR`ٴ6D7P"Yk7C8Aa ,f|yn*b똸͏Jtj8f9xZQ%kP_+a!U *qFHO9Ð\Ҋ1d Y[9`ZHH3B˜O\4Hp䄸˅Xk#\嬭 ^ r\: x`ZD.uDsuȝwJi;̘Vyif$lA.u#"Mҵ#.kMTDt%gmg4i̧b?kryi#'kq(VyxQDPG͜;:r{9!Au;D.YrVOChZn=!ԭдDBc:C(e!q)(doJ(nbYߣ"^V\AF\zL4KupB˜O\U'j< >ӄ$;y4Z"' je/ai[i}TRz5!WHPQ+(uSʉ9r癦Mw|b ja"xjɒZʧte.Y\W!@՛c+OO/˧56[vvwG}MБU3 a'.-Ŏ<2yy>$;d;q-(MI.3hR|pekZgH j̺_cgdݶ,mz W"7B|ޟ`FWYϱ‡74nn_s(l4ТHٲ0Q{WƺmY&N, Ktmvo},cRXAyZ7}YO}hQFzQ׾ff>6PAdcS^EA4>߸񽣂-96~S`z`T_o6?DG}!PLLJ* r;jiݾ,僚g:cŌ5]Nx,<2Ѿ)XeiwYcݙqk$o](Vo'7,ڧ 5Za % ,QQ8N"At#μ94K,keYÕe,5ѷ`䇔- V%j@){6"M(Ɛ_ʒr0^&7/N(?LY,QE} )%Á&8pb݉=$o]$kXEIAX_c׽Lj8S6T⥯uy,xĊn{Ky_zUݾ]B &@Ͱn ).zgY;cYk/Kk{YZeiÖ,G[YVVmYZeie/ uݻ&fk\&fk ke9oٲ{5S_\ŋ Nl=А+iNT7UR+kZ 8O䊣fV絹7絙<(-&j>s/j~< H.3 iBg.YrVy:B|87NˑGv䪣fN~vNb0]2'.YrVޏ=( 9$׋K~(GD$']kZ+n8O5(gmSMЃUER(&͈I ,fr0_T}CMZ7M`~݀4`RͶy;_6`_cצzͨ>t,k޼*GOn@ea>y,QUn9xzk6 |ms3g2գ.xCuHXV<`Tb~wegTڽy/xR8ڌ+S=PMd:IuQ_*|tT6+!) ^cw`]y:_6CU bI)xά1\i*k޾ڳe„40 d8D}/Ä\ߚ$}/݄Ykaq%ڧrXe͐TV|8W8)D>MuG#o> k(L( P-%x[](LBP"CN Z%>( vrLH|PNH.5 po(O5(gmөƛ̈́¨̈́¨@FD4P!P>q+m0.ӆ€LK\42!]@rH H` ਫ਼ ˵5<\嬭p6(*C#(19 cc4g~Xw# # g>r%$VOhnf@\JV{Ԗ^Sf.%A\嬭o><כ@%` r#"貯j˾,|ه\9BamBaMa)2H`$GDqVxr+8)j>sU(\t8*y*EpwB+^3C'I w3d@$H'. `nútfw7n u3On3^UebJh6+wѝEL>|%gW_mCa=F0 QPՆ6FCat cPs1m(^{ ODq@}_G7]xi !00Y@rK;8۶a1u3ms3 8FLKK"X/d$%DHV7p̷@P2?ݢr \rDdx.Dg! %kPںjnBJ1C\qq{b榭u-#Zȃ<ȕMo @Um6UT{iPmcNFp6#8MiNs45XnOc|f~:L3ogg5淲߲ @lJ6U6XH"ʔl:&ٔZlZ1:_Ȍhs@#"i'7˅սYkO>䜭{){ȁlCDrhDe Oy:O)b:O+[itR4v {C ש7sF Kh&Qj}17{SoP䜭 {?/"Cw!!RpE>x͇L!Vw3boL{c\OʋmΆBDz#E'5P7R̗Amvo֓Hn /Pֳ]ҽ? Ykmt7_kzS8w,+=.n7[I}cMSX-'>}k6=ܚanp὇\Kq,3ee~17RmYf2-K,eՖe t/+Kxon/^3P&Okcx $\ В 'tD//kKh@9gY˟?"u>7)j?iX2|EƗ?i?QgZA$d׉kQL 02.^OA ~@ _QC )Îvn4Or$*~4?SF 퀹"l$=) 4 Bp$'[PSFp"iPEIZ'0ⱭϺ WАl A/\߃|S>Q)^OWO@ TXxq [jq,Fe~ 2TrӆymBcE:ӯWJJZDHA*yJP])e Цw\6eb%(5S}`ϖͪa}ZPz MDu(L)?&{H&EV>~X F)EĝhvD- L)PcHu7E3@ :\`{.1EZ&ށ>gLCF&S[?Y@MSR[EJuJ)0(;MP0;y* Ve b?4#e43\aVḇ<Z 2ͱ4.JmNpre9=mCAQFtZ.>}\{1Yc=|1|g6^f|rnS_ |cZM=!cߟ63UEwľuBFbE<|2|57(Q_m=l󊉝WL<ԧ%*N2q[(aEuO2ƾ;)<osS['j-R?$m fwv~k%mLP[7N%8_2RroCuźLEt3u)XÊm-ύ`nRxEfT '_ocmlYo<,ECH3dڋZ5+^H^fU_vk]'Oz.պ :PBc3ɧ ڑ4ҲOxu^ˢoḓA8{03iBxu^ُp`LdY|UYI0&^D?/ c!O< U1qEk*H[qsͿک>ZNX)k<W0)aB=󐞋%$I'qyzoۂ& -܄nki1*IqLU^ AtKAK+ß](S(%W+R }l?PE-wZKﻙ"MMH ~{C +,V;L)x͊6ʔ߶j)o*} *k4 (*[SQ C,kʔ1Ҍ'ƪIóNpr 7 Ap"^QqQA,$49='wg@="np>.eo9$5!DO#:X؇f~@laJy;&,?9J21X.0vAn p.qs0^Hk{n5zQm8bF?iC G"teOzNaP9olԨƅD??XE]3Ds r|Lxbgn\kMWrfGҴ9=Oo}u/kWVۦ/%XuH֝~T>Zn;>I;=왷^ë^0~'cnRU:RMbNë^N+.JWDc/CBj*6,';:'چl^V_^aȊ#ԁp97Z $.$Is ^J)$<3ۿ`sߔl4*جQ?F崶ܬE~U`JH\[<*d >Ūl]ժ|E3P!c2Vu-p= w_} qy8;;]bbVno |[L۲-&m1Ao󶘐De}|A{%t ӘG?چ<֛ Lyx3odXn^a4LѣDx+dc#؈9f0wKC"JRJ,{OmFHO!Oֳ070Pdx^ PVB"!U.̅o"Ifڠ<֐5Ȁ"N֙[?+pyO7z1+d5qC'*6@>CЏ~uAM@Hqzbcۚ|x\Yt5x=" q ;\ E2O wúߪs߳[ޛprBF.z<y9?YǟF۷[W5:>Wg~g_jp$M{+ݧioK˾x'?3=Y uHZZ>b |˞0=6^W=,^^FZCMn( adk*xu^޺.OL„=Z+qe*Rb%0:H".Z#b+]^|e///op1b*tmw%\PBx$Wa WtYCr{;םl(DS\ǟc*/oqA!ߝ'FPz+U~My!m@cb' y0`. [KD<6p2KGE  8W(+^k8E \e q .xoqѯ4pkxdi<2:H 8e7}-dK(+m6kX3qw4ݲ*fp~ *оɪ~)N8 `DD!U1[ *4u4C`:?w*'MQaXJ ~geۼiL4!'Ѓa,tyTJ ,x,&Àʮ-o!;ZcurF5 6d~ EXQ"xPpVzhp֯l0 x? }:UңV*՝-uAqflb$EvH} O9Y0O)ێU!fcR.hEskHگth3\P(w9,/:(!=,ZF:GE>ƥ.".'U;fʛ;o\@rL@K]ک퉵zo'vbhz $Ξ׺eoybw{d$Ϋ @fR:|/٤5ENR6iX'ʺ8,~g_Z.;ħLaEw{<ӻ .f*0ħ\SŧX*y=Ox!7}X#fQhl&VFQȻb|0 ᭙ݙ**ɥ|z /~[^.. xA:Yq1E۴' !kgdU Li6t4$Ќc8>`ICKNBr* k1/r@d #F . ."7gx/~K3^ 4t!xvXbsb(ŀĄDZŌ)=5\qXqi~&E2&0M`9XӧN3^tL(/2:q ?M@kXz' GUÌB#/GpGfxNƋLlkZ,yhFY xf80ghN5=@%~vg/ ɜ.͈1܌k&[J4fy гf@H H.s[~<5/~ f2^2ǣQ)JgE4Kc؜|͓/u [qd.06KyI -2]]Ь m "7lɘ?~wO3^4RMyhRI@&in! Ҥi~ I ^FRnȧ{FcoYcU)~c "āuDOrQ]X< ᏂFf7,;+N!Оȼ#c!,^Q~ypX"Q]'l^T.no a!ȵE"rXĭ j['fƁX'D~Ye,I5;>q76#qcM2lZ>qn=V%ZqO9-#@A͉Hpţ b6^@iѠ1{t0R!tPdb6WG}w${x:2آ7];DȑA>ۭxO~+ޓ݊;\/og[V4'{t8߶9vPq,lD\Ek}ԑ0q=j!x9&6{s7Gѹ;%Ol\0pn,rCrn]OgaO7 k ԛH$e;¿'= k0sD=F@bJl<ѱJ7_~DGu@H̖C'l H P ڝ$h VF PԔ6A+CX˲pPHү~ #zR&|`>gM L60AIr9T$@Psy, T.-4e뺂Y윆gZS^%,`Q4ܭp<&*QlSu -8%`m*hj#lo'v6/Y"pdoybwLCG;@hG #R h$G$@:kHm 4`-? $5Pfr832rN.Wo"2V"U uV)f<0M ~:9f~~`fO0|C7'pO.)ȟ'>vǟ p|i5Q.%B8v9w׀#UȚO2=D0 Hk(qХ n5\KHĶL{8SrQ&>)c5\ .Q@G_=\d0̔Ao7u2D)) n#'^ !7޷| $6 gR~cd ~PY4RRBl"4Fu7٣Lex`fEXJ '8BP(::  ?ÍSiuf9Ϫh&@+Q˴ qGJ\E0A\ UQƆtl2e\Qrt`<` d8 ZKx a7WzsD&6?hS1*_f)0n~F~39Vх2 v.oq&3,[bf3m?Lϰ &g4?hK{l3PVb?/oNsi9^%nN۶9fsZnj6lN޿5_DEͭ~X6hE~7ax52=SxLO98 F*M^[9FBڊ@>6aOX!cこi,Yvd F*IE7RэTM*nbR2+ #H#\! !NԨ[92q NG~T<,RCtT{XC|" VDcmjI8?|\f*EF $Fzꖶ#S;E謮XN%9,+I`Fzs]#6X~sCn5i˂NB$Յe9,Ǐym8 պ2RpE8;qH[92p u[hp08D$sbΆa$^ s>^I5Y~+T@%4 FZy:!<+ lQc#с$-fNN'BSõw\VJEu:2%q v,Y =s\AKBLESY#Tߍ%RSDI>b92q zP.@rLeo#;8c!N_, c*bb#$N IJ_RJƉeog߈$R֚ ,dʥ9,kű}NTkNTV "9@ i]D/Յe8x-R p eq`VXgΕ~92K8hCR|GX\%ŸjnImΥlۮwjז*Б*FΥ ^ cyr)*T)t\`}X:GٌcԀ R"<935.!YW3VJ%ΌV 8I ^vَS;`h-ĒSN[y.Ene!Ԙ k?&f@Ú)0(j%c1>LWd 6W5^V*(2G XAc*CY# N*&oHerLeL8ĤR$7Y$XƒIE*DH53MF1S>og"3I@ෑ ,Cqܢ ȐF*7c\%1 IL I X2gw9h`p_sFjG~hXƆ;C~7zȉ[TI &K}Le fLq 3{J<__S 25q $r kpr\"ϭ\uX:+TA5kbΡkE2kE֊d֊l s|j݃ṳlvb R)F$<*v1l(P3TWN,(x^lԅR\6JR|D\(j'2-.b艈GZRUd:b |rda44)@.i3*}*%n'˙]BwaqR>Vx*k1yW ˙]k ˈ6C2]SKW/<{ꃌVe*ƒ}* }*Tg6 ύcT (K~ibKbT" *}*%n'(̾m`Zu 8b'cΥx7LxN |s #^@jP3-:ԇe!ý1t!`R`g0-QEϥK" ).Z}7l#uS9E]h/4.!% JYw*Idl"3U<:#p]p 0+>H%D40s)0x$6Ht@JT;?qTձqnf1Lзy̥ !Py܊-yaK9Ʉcj_cqHgƊ#\j(CofհaKe9b' ̓_\jGze1KYJV#b X9#8Rάj׫j826Uh#Fps2>#z26g9Zh5(h\s)xdv%#"/*;7gyu"2ڈ\h v8\5pTjFp*C,:+#kSGe&}.p Q1k y@ß8@Tr"* kH|.ړ+4!ҜPO;c$NLoΨ Xv".BEE\Q)E,5-#s5B_e.vLgxVA#Z4W랦FpQX+rx0}5uN*e=:ߊSAb[o"@UK})ڡQTN|ۛDž=Q4}5>L;-ԺZIƺ c݇aj0s)rCxW~- >S,"EOlR6tiC%v"P)yPY[( Uʒ0"2TM\/c[91d{9h%sXQuR)[ąyuˍ;_;/};oО@qc֙}L| ؙ= ؍]B0=N/q[,qcaq[_qegSǔ,Ǖo㵿 Ͱ8cs-`75=@v^Xs:TO{v"ħ=roeai|gDE44'ßiJ`P/?𓟿S op/<ѫO#y77:!cs'0F ?|oa/;.`UKF{co, csBrcemXƊ);- QE9*N2q Otn#_ o9Q1 'i.m\V@ũʩ_X -gz17f'Yn!@R4Z#<" \ 1ekHcTF eԩGDwU8ReTqKM*lR-oɪmYգͥ "ß1 zjcx|iEc*(QUHϨ'ejh2bmTXjg19ybBϬFS$Վeswbx+p68*Lyͻ-,|@+J4Uͻ=j9{WݞqX31܅lv.II,վ1)ʷtmLIdUTvƙW5rfZe8-vx-l Agr!cL\tXko;m"jta 8}]$o 8M[D6҂F'F~ヿ~Dt&K"T%7ǟ[ݶ(Gi&>J4(m҂xT 礢zs3[7[VnVfV9Dt&K"dB8]Op2q~ƻ1y 1 =F6,GәTtf.SivT#>U_Q5ʣcg:{[awR a#@u%\Zn;^^5&%A<.<͙4E+b?s@ϥKFoT g꒯ڮR_~Q!)[ek,Dx~)iZç>McDx׋Ac!e@RQH36sŔlQ%/}*MTac^q'eN 8Ip؍$NkNcRqD˟sKh.r2.S$ 0cw nq ֕49,뮳[ SS1ʀ+ߙNt[p -ցap,q^*TSy,8O[y(%8'l-cH8ǟƦ65s qӘa%R18R%Npzb.EUw4bQ5kzYX1ꅧMx־^Ix+JYx}Y~xᙪR"<ëŭipSM[3LrAc[gr 85::&h ɅU*UygTU6Ua ܑz}yyj PN+V p7NTCg65XHjH5<6a6m{8-Hsx=: SWWZfH㶽qhnOk\&"yzFdl7(l|ѯ;_ yt<mQo'ݧZX,Vg7TŮqᢻH….*>΍Ojǫk&.O:'qm,d9vfn$S kO)'g"\_/.?a V2 "k\!3޵V?V.ZF1m|rsK.U:ٖd[*i)y HonVzK'+#P.қ_/I~ifL!ZYoէi9]nSHTnvR%F14z9C!ik 8\ @WT)j EC%HRp\46P/uITN|4zL[4zƪk2R_K8!V.@YDtFhGqTN|P}[He;3qyשc\5_7Nl&uSd߇=@~r}.SUOa_*օf[FFc2a242 "1n|jL˸:|:W7{ckuZݸ˸FS[9` iRi2|aW]y$Hsm/ӷFLTS|Yg@ô+IX"c.3uǝ Wc-AfRgr [;֎|;3Y{.Ҏ};jڑvSBC<M7@7LCi}m>>3 W+t?$\ 5̵a}z(4'=`mjuaT_Cv%3`3AOtF~-|͔m*K `X.;_ ;. @'Բc"9Dlvc|_&P_츜<$Ԏw:܍x.K#nA#:l\\칼Lϑ6B8ӏ8>q[6,޸m47 @mc33KR4nF<=y1v/Osxwh~s;ϣ~<\=};;]E.ܞt{5]ٗ@ﳠ\ou].]WuY\ߥ}Z7񙶈o ?q7st7s!mn榻n榻c;Sۘ.+zgÏ)cmLa-ܰΊB;MrHyH꾥=ZWErii`kiږκtV^7wfeNyi4m#\rCovfs?9(Comm|zWSɓ!QZ#tH*/ q n$>pdCzr\N|wL[wc zq}K%H i wFȶˑ/Ƶ|ﴷ($ WRBdvYKŭ`&4$~Yʩuk>iXW23ٶδEc-g]~!Ts2L9h C.CK[ikrk+K[kkNyitm}HǼSܸa+xE{` zmg |J# 1 #OiҜͧވ2Ls`$ ) ،{$ 8D+N!4^;aL:5@QoG#`Pc_S{.'f A=}w 'luHN0QVSltJp4^%Q j@֐*গ jKmEmCkxzOP| H7KdjH|--TK"(%)վ Pk9!d{z,4ģhuۋ FުƙtJ|$W=>qS݋r^]#yn/C41/UOv'2ݵe?e8LJ@ [wtT>fx``Ot<|,>e$ʇj{_8s HG\"e/n;Bs.\e;!y.ٯp=Sӓ:w.\^.GܹDrgsζm ڗrۈ#mQoOWh7DDMvm{(7 y+sTD iܶ7n͍}?y[_,/T^4nF}f߭7$eXӸmo63x )̟mBHݍu!w<4rނrYkK&Ӗ;=R lyR> j[6]n2-!$y7턛^hg/uSp`~<}ksrܭHvG30Hr^mii-5:ƕ-Tk}zzG;hcoikٖ4fm{K{-t6wt Yz Il3FlEZN&aIE vxB;oMS?-wFζuߙQ򤳩F$֢}/:63*r~\+yn3W*sLge]dش[.vkŶYNqdxl| {[GmmѶ3h[[mѶ1Znk\QA1X^:jݐvNj\)]FpjP>3Ɛ> >ضϭek^tm_X%a@Ee t q:N8c ̀.R'L5hX~\~˅Uo}:3uĭѷ:S-l! +Ͳ(Θ~⨆wZM )0&״!M0m÷aKW(ZCjVÉ|mM Gͧ4`/4~@LJmmUO^ !k}b]3{7K+ WPa;\:οs.^gBW}{IGdls54x"lg`Ie2/D?Ù21ޟ1= 2&lqm [.ׄ L,.?ҽ ΄^eUܮ·.g= }F<_F0+P]LٔSZ9<^p #Oʺ\=*uc9󅸎o9myce]\[XX$!V.Ƕ0.A@۶ve]ԍ:w?^X/};!d*q#\:۽qu8Ӯl"uc[ g;C =zWsRu2ZN zW-zYˍԦ3 MH}m,L}[\ TvFTpӺUډJX|!D's`LఔbXyMW䠭h4S(dDocOR> >͌*j 4>˘uMK-$D'S/N&fk4^;ᤆ{7֑& >+}Ѷ|UB H.'׹Q0OhRr8m!?8.Ix-IufY͘[֧ w)k(o'm %͠z;$5D5DλcxݐP8Kǧ饉&g186g =6r 6\r =& R _h ^ə*(.GFe%r\e߭ M&7&z=V<#_['T|exs>_rl~$ۏ=LteW;7<aY?~63%mAm%<1oFI$p)z+*vM~UmfD}U%}\2yfݏ88x˄29ӳ]rKDȎGO BqNgwh,ȧS(23q޸m47 i~M\q#5fy~W3޸m47 NYX=lj~mDFsx_dNLL+sbr\3'js7Fsx_g^J4nFdK>x(wJ9%Orcn-|o6@'؛Iu|i+쓈cm S m)BFvyB]v7pm#\Ό`H~LbÌvLGtvM(>56@nL\G1ԍf9aO" ˜h8Rwڝn7a.y!ȴ˙/u|,s\O۽2˘[3'옶IF\݀ PŎni2i6Sr0g\zfmlZr qǴpm[|b2B\m!\D)O Rhb mk^Ip߇w?|'*} ^qr7e[Aw3 mvR7y+߇w ?SUuK[Ǵ#\[㥭ѵ5K[kn~ZHEFh6 ~YyE6 HC3+(2e M~UBs4O<$a<!|WGO0wrܵ}):6u|$ .4#`C|$߻ɉQ:VGԏV'tweu6GѽkXwdWa65)'] mmC, ƙ@v҆bOz;KϬM ca\j[޹iޤ6H7# th@ P+9aP?6sO/ϼ]iC݉?OWkB_}T|K} Rj`V @ 씧e T>fJ&FF^SopP'\&lP"s&}A^eXeXผX/ݯ2OV,u,r.I,irF|'L ffGeJG|)½qhn>\/!xnGDϔg{(7;~" }n)[}q޸m47 Wv붣Y;[uz1\Vg`mQoGwzCy~t˷$s>B* …hB-Er]Is&?-/L; ̮+.#d[r*Kn(UB"_ɭ G⺱\o*F>dJ@S9vF%4fSRouƴ -lU-s$#?Qz[/-ͮٵ4_Z]K]^KX;*I^U9;/'#|BC?%hnG7dX!uS9EoSr8˺3. ="m+c[(W$,B8MZOFe\Z>P.ڇWq}|r mɂ(uSߧwڲZ6h@J(R9pշ5{zm[g Һ7OB(ּ;?R.$۲Pq vd}2x-^:F{AFB  ٗiwr=">!33?+ fh ͺ,q%ISdc8nZuǝp(Xx; Ɂ#6ÔvџP> #E_G[mNpM!<^=Ax4 4LTNi>eOo|+[pSk Vnj(s^YnS&pzP:ap]ߵZj K4 ^ϭ"xIk/j ZC!\6)[>\~A P+98< { W=>1odNJ$/|{|y#ArPKA_;\:l~6 UO·fooEl7#o4cFJ^43puR030`şL麚E)uݦh2we:b8uL<0f_5 f//֗)}[_^b70T|.oL/7s9p9Xhg K\l7>dC#< Geѹe lɉ}e-? 2r E=,9^$eѸmo6w"Wg{Mkq޸m47 ژ~Η~f={?筟yga? 4}Pv.OQ߸m47 OYsBFsxt5wJ95Cr ,]e&HlRf?-#'[!=W.Ƕ1.A@̥wNz뇐rN}ǔeô#ӱv[2#rcJ)Z]#;TcM5RޒvU[:wZ:Y'+-riۨgwRd*7m-rii_ffi[i ɬ0_֛}!w.2# A΢p\$;< BO]1+0c)m9#N#m?\_m+c[.Y . mt04z2@ҹ!V.Ƕ0.d3Y\(Y_&Ѳ@-w OluVdŷ7slœYwp^B3\^&'zY!F$DO?7CXey?ӬCWά-WN¾[~߃kKۦg4>s?L,JL`_*pK}3WO4ձM:b܇Lt.:Ͳ:' Ui[P65,nkXݻymCP.m[N#P?KO|qxOZO<ɐf G0b(|+x-g?|p@wU̧۪}^\KVO :䃶W.7_}=-F5æJYSg v._3pcاOlo9yOވ.epgYvPRLs}Δ͙h!\0\`̲Îx0ܠO_D.?ψ⿁˗ ӹѸmo6~E\\8=٫iܶ7n͍}?3e2<#x< eq޸m47 $/.4z~|`Lrư|"'z>7@ ֍!g%\)Za1.AI=+׀i#oc\|1wN[^B\{lV]#%1?ٶr9p ڮ4vi#dZwh>q]s5|qM2y\\uV;<u\|~fGܸRg;+ ppq2\ 'eLgpڥ-q-k .mmn7_e7_[>1h{[N,u^pXsWwi.'92MwYjl%||3m[S3%犥g 蓶q%Itctfcx8q'e41ui~[{.Ҏ9};mG-Bn}U [_=\N`jlNe -VХ`8`[9!u{5h$ SCOO c6!߆rRz]z^ON RCØERChqB171_\|~@BJRLQ3^hPn6<1o=!ɸzBӶuFC=y#vPߕ/i~;=LzϬ0/cCNaK;] W3`3N:׊7|{{A52 K-9Y.ÙB5ܜ?KxjNߗխn^7uyxUߗŶ|xF<^F1meDg _7:NzEzh[iG1Q F-{Kkc1ͮյf[ZPhm|TS'Y].Yxks} ~Q3.C'kb\U2mUrT.M?-;S%L%0́00XmA\m+2c8D!V.'N}QL[['&%H Vl[k(ZKt\KJYf͸Bd߇;ʼneo /OHv^֘l[){irжnۚV(ƾ}ӖQi~22W5B ȱe\Br=mZR4s[1"sii+Kj>19.>ɭc8/8L-m撖bh2|1|g*ta|&74 >>g 6$ (DV]ቹ'}qNŧo939 J:WI1pL;J(^&WuяwZG뾎f $C]\P᲍`8gBtk83<8.jHn]] @ N媙zzm|6TQOhֆr^S%,05Fkh' 6Rk@ ӆExW7i ^.*g?Wr&;x`BC<ɕWH׸k 4\5X*( @*rgjW+t.߶ο{.ߞdon\3lTg.mËO44.p9Nz *qoOlӾ<722If"q2De/Y}[/}讚2]ek/ۑp96.˅˲q9.\vn\xwBG8.቟L[_K_/IK!`R!Rr8F㶽qhn>~I\k9!:cs*ϖ>mQo;mcmߙn4u;=ь*1-ݍttL{c>P.cZ`("Iorқ.қ#w;tZ:/-m{S <|N\Ƕ7$=w $RϫK B!Wt $\6MOAĸk86B63cwL[wzMѳk|BR_ĕ ~¸!m lB!V.ݟъ2#ΙӶuB%W,Jiۊm[j?A8&GܸR^7wۺLiqikՄJ"@AVb:ˌ k+}Ӗ>|: 2_-gmLleGT\Z7cR>CD;8/8L3B$,F،gr_d5&;gь+K[sm2_mk_km}D&q͠/G* c^Z7ϣLd,Y/9iLyΤZҌӌwLSKŠp&w1O0iw Fi&wD;Z\BW}l}z:Gʉ1:x|/™cݹcexIVW=h||"fؕ5Db8?)چ!^6e9VCԐ.ڧYI/5w|7iMX<_R7 7 ^AWJhGX֭;clT7D\bk==DJsj^wu~{秾uY-|T}٪V;粝0Þ{oF[Hf 0tlf dx232Bm|͔N.f:s\k~f/Ѹmo6N8^4kq޸m47 $7وhlF[̢f1sh?84^Ow*ҕv`0H!R!R?OzvS̗>nO_>sȏ7z2zv,m}8O4\<1}VN%< p48O4]<-<-O]g]@Cx\)+'#mVu!@Բ'd|tY2 J\[+d)#vw/w,8^'+ e}e>²Dnk esҍl:w +Tv<ۺ9yAS2~(ٴ݉mkO}_ J%^h֞м'_HGΛg$I1Lh:w"𤋹qTpX|+ɻnG4v@Y7rZ%YgINCEȏ@C`_^1"jސwqGX''qֹpqANO4F'7:æigMtR댄:>H x!}W:ch矠eaWt"m;6z?G <%:6~$'~}4.YUjYxZ+8QRm$b|U'unnU*mu-אUߝs?C_qj wYEcȳ0i25v-$EZhx:JZh|~HmƇg_ )RPW!m-xK?tl\7jM.;. uE>Savr,V,~u+n=:+y/ԛ4+1iBDnAe@eFL';lyZ+F>bGA;K4h5 ӡߺfINixDxJ|jp}.(Ni=wl:Ow$>;2d4s\/_tPLj11S^|knvg>~+V/ tRVړ]%va >~~qC *Ae+nnjdZ ??dĜA%noeQF)+%j _Ss" |I5JndZ3u@%6~*+HV_KڢWn~mk݇} /U wXpxW2 f,ڋ"6ɮa$?x~k._)k._kq_ڦ ү>$*>l1JpKE?t.n"l2vB\y1CLq?T^=gFBZȗ㨺ڔ5I_t^3Yk84#lTmgP<4?PW,xw"!;gu4ղ?Ot=`:^z>ir@z m@C@ȒlٛN4kCa]HR,ƴ2bއz Sp I,gߟeY2l6Z^MUaO[kz| S]Y?:u2t,/E4?YI7PvL Dۦsx?hgq_>f#jK56Mge{w'a;nM}?S6ܓ_F澍=y/g>Yi©ܩ+[ttܶ;nM}?άR@gY<<=ӷlbmjƗ_07 ?%~&Ĭ6̕9rރe>z²DyRVtW>%mWZ3ٴi ڧA=:oܧė>m)y>m(OGtۧlvgQ/W#ktN7RS1@mn67ze67zf~ٟ}+})u̾rTCufu}c?_Wʲ]+<?)6W0JX>6j)'7%~,KT]YQd׈)f>Ųn5XC]_sH{iC=@Y_O,Qʇbu#e}e>Ų{Z~}CW\Eׯ*Lsx0c;\Se݇;I}oPt>5+#W_}-H+47wvk}_zGW^ |d W*_'ZONYzDz'ϪX5ml0}{HĖ"M;;*x`GuVv~{IBB4iiB ,t= pvPŇx?ݧpF[}mi ]j!t< - Z_&-xy;j:Cl ܑ.W5zM\k1UJsGn>oZ1o if4[7}{\ %p5 6__rt>yￇ-m!P| \;  D7jnW}N!v)͗/~1JBHV<%h' YrW%F}ͨ ?g9(nn1)bknev+?kד bo96V6ʦs|tg23n*j|V7.qm:7MwUGk%? ڌ!{#պw6&3߉WDW>mw6&s6߉7ۦsxwzonso~-G;ivfixz*$BDA< z*{)7wlt{zw{϶āPO68fбu߈qlx|m6B,zw#!g=`WFuHqy曬y4IV@[m%YC&DmG>dqż^n@Hׯ 9lα+uz^N+Mlƈ||țjc8'뫉".'`1 1jŷam nNׯkkw=9.\&ׯүkțoQbGEcGD8~ .~7mLw2voTGuVnR]wSyHQglcVL8!ʛu5&wLCt0mhGޏ,in9B}V}{V6#,~7#@6 oj8a޾F8o_Jo'QZ8Eއ]]V89BٺhO\}( Ji!FB{ -g1hZ[?Bk5dۨa\Mas0_t΢ #~yd!VؠF{rpXCO:~$;J& ^q_dGqT ^S_|!gZh[0\]ݾ&=[vۢx%~W]m_o,YY˳۳gYgYy%[9|.D]4~ne ʶ,n,[Ynܞγ| j$YUt- 9uܶ;nM}w?ʪVPF`dﳻuכvmӹioo*J3cΥ\ϹLϹ4nʿ뢿Pa6m\9Tosca/w͉YNN4e$luܶ;nM}'~2/*J "Wr\N!1iwґriwYJ[X EtW'm"Yk;k8>-ijOS45ۧ>-smhǽO{}Zf;OwOSh= q4DiӔwOSj=-uTiV/lq@KE΅_#?J.](^@Ł]\2pb-mQPD2.& YW"LEʲa7DwH M|4n5Hn^ӮIAJ|dBWʲX7RW擥(>ߙ/Z]Vׯүkua~S63^)2g_PV=/1\/v] ݇;#3/6ks^4FktƋ7wB-uH^\jP\\hqDJQFۉ i,iu6ؕP|u~᳸ +: GNw<a&c Ô}hjɶJw(6JL3Oٸ6m`lSgu~NSۀ{ ga}ib<%qjKxfg~{IŠ Ҷ릅Mӫ>I7DLk OiB]BemsLL] jZk~;:8XCrqw |> g" iSyBYv H|G`A(^ y]oK#TZiw;: |< <@~yFT3Qg>۝0~ukGfBm@33!1N;ޔ˖mȂ;wd®:e+sVs}G/ZYm\qN%YrY8oA le ZqFU+13C q|׷^OFS+ 8+N?CNPVa3ˆj{ i Ȃ~sdmw6&?Ҫ5ġ*HBhXwƊ47y [L0qtnAN߉Z;QnsmlH~47HgyE93=ݧqtnQί(_aYj0=솲n=bx:{mt{<̗n5ߵ1[O<`ڢez²LAex*| eG;}6}Ӑl9'YT>MiOKtۧfWuT~)dKksNa"Wf~=mk%jۅn=߱LCt,{Ιr{Ԫ؃ 2չ\i8lOXn<=$Q|K"I v PV{PMOuDw劤6'G>ciPڝ/vkRzc+z- wb~+Od^3M:>ۈNw(Di~'@~gPQgLߕn# twAdI(BE'鞎YV:4>?Y='o6>D.aW@";lXUrϿ⨅UM +B1}k}hC|ғBZB6al!̀[rGFH.#/o8a~r3UʵsG{>E}vmS'&^uBP}-#͇lX4k4B5+/((wDPSW. r\?ne/l=g¤Y2Fc*Jqm:7M~EL\PqO5ح MɿTgPKAcA9KMm47;/ublcdks88qtnIn[myf﮻~ٻn﮹;н񌪲eFDwS 6u&uw/w,1qWak3Ez|dB@J m]A~3=Hr vo nߗ-_[=Ҿ\קҧ[>mnmnGlȱ֠vX3Z'(k[9O]ۅn=߱L,o7 "F1~b2sFt_{awh矠eL:6RUqvEDt#փ014~}:.XN6<G2oL3lӯwk<5Widw61ntI+# :>Jó5ҶRГ>z:C3CE\;i!\=j-̭yia.ϾL y!o>C(nm/kķgZhӰ[ Zs3! yC(+{)v)P/|N(xΗ\UL팈2щ.f<:geYƲ?˸)<+?g hY^`s?}c;^vvݭ[I3ceKʣ;.6.e\nVe\sgmhZ@ڵxBVvmӹio+gZukI_I|ŌiΠsqm:7MuN| ,ϤS]a96Ϲs间 _:6"tܶ;nM}:fۙیxqtnIQ-*n﮻~ٻnni羟ݜ{|yuD {240QZ*dj\>Ia!e=%T};)sRzREKEvPA4Ȇ݁O1J]7Ow[f.:R/ё#EG%:\t$HDG$!ݯwflG'I۾2.s#`Nr1wi_y}avY}莊HHte(#5q6<` '>$6,R+Xd;unnld)Z ??d_b=H{P+ٞ(#^/$궾6+J/u_yNceTs+'K>4c!cӎ11 |.LY1\.n .n CLk kħIF}_/`}9_u\|V63vq[J2UUpKE/ lLtvN:>MdpDNpan?Q 넸YqWX#&c( w:^;$ҥ:6m4}6H`4^tmxQwO~VOlj!8߭J@Y4b 2.ˉZwYm BsiaOĮT(Ћ`>#3n!Bm^mh؇m!_ß=1?Gѩߑ/o8a}BLUކQ!烐/ 9mH:]|-{>B=WZF/=(oRэhTM^] #tLgD7aU1o (lٛUmRƨu\׉LTLRՍ&{al:}gjޙl{V)#cv=ǟw~n/[K',TMȳL[UY@7+oy d=_Gö056To9Fm:nM~iњ XD?Z*W2w47L5q_ɎUhۦsx3Mmlh/F166666AΩ6muΩx&׹ioGWǓ=D'BOv=P=O݄?$fw!'9rkfv#e=e>z²D}rf|.$n'H}iz\75 r>%Y-/O[ͭ۾ |Ŷ}ieO4^<`=E5vixڝzʺ3_ҧiq}Z.}Z\wp}:\Kȏ n DZc ϹI9&J_R&R35}̧Ok% t(QԸEzɺ /lvoaNqp˅z5Hz9 ef00n3Qė7/pVقʠ Qჭ"KTJz%HDk]LU!"|4n/m\tcl16/cl161׮67e57H}YUݣCIS'6~/kPV D1DvOEwidZe*sjʘ^2OxYc4죦̗]6 ah' $}GUIKY(Ѝwӕ%IAjލm3"Yket7WTHX*NΌ M&Y`uk7|+ZT&Xvf\~;QL#"|P-DA٦+]CM*e|~env~5W"1$Y<ƒ**KvclBMOcjzʍ1دޗ(_)AjHwm) >5(_IPY6&݉3 dzBdݛ/BguD ö|d 232ߗ=cB|zCHڽcI2J <d<8!>!%*I_, XwndZɗiR0)dX$a'r-'@JY䜼\꿤TOv26W"⣾٤=/G[Y(5+qdFF6.v;_y*Im~!"|Udʲz+!l;1M|4m+~#a]A*4NOcd*ѧcpe,DdI2m؏c{cE~Jnc 6kZՁiT,QEkЕcPgwW*M\B|e)ї׾d+3%` QúSpė7dnK&C} &LlV%JpS (,D 0I'Hڍ@a#C)W*wpl S{ba_p7| >`E«d6݉Bm]$k|yG=/G[Yʻrp,E6)3H'H|Y/p"q>XJ{D_ ,K S1dӂKy Llqh+\CG03n/'Hڽ/핉G hN-OA=,'4S$KTbL/Ȇ݁2m](ECRukv 5dF"O t**[*/6W(ޗyɕ௙.!e}a>UdI궾`Ԡ{Z/gP}Ykre+N-|vRrOX(ks!D?3 HY_#lv_Xj=w%*ڒ!k*ŏ1Ө"Yk/͙+elN]ڝl9*sN";򞨴M|dݛ/Ы안})f⓭${>z_ۥ ő>ʽ/ħ Yk6E+$P@y4Ho3]ɈA %Hw ndZybF,j|emXkh,Q]|a V*qdn] 5pMC|e+@WFَ!ҍ]kX/Pǭ/~ou,!e}a>ʲD ƹ\G4Xwmֱٽ!kK21gM'zv-i 8WkIXx$&Jc wAeTٽ gt" 1Vu$݂Ÿn7'ل@;q%i;alvo<~ l/}Z_}2%3 €܍͗e{csJ$V vc,v?\9v,r`x˹.窻~ɹ.j:*l9Wc}혜yH\KUț[U7H<o3yɮ<SLjFcHY_OvE?ƺ]>L`J(·i,0M3(C#a]nt=yr+c ye9QceE'*4 k<Ʀs#dYٽ1Wkuer\!%/qqRϢc'HڽBλ@4#nOюkⰖ})[ɲҭFvvoZyL~_3(4O7dy,y,]1P_Iz]Mz_5'QO]W4(Zi}(]a%c*BYgeWϢo@\f{O,SfR4ZtP]&>مncm2!;;l%YمmXcp c>1BY`s/k^~A|ovocC=Z{6K?ùQSty 2+T* #u7Jė?fK3#:gzIӛ}Cfof8ºᶉ/}YLҠҺ%gkd+2Ur\ ѝA&>مny}10/USh$ G(DE@] »`6/p / Y>6"|eeёyv6Ka~bsA}'zaa{D_,QE3J'&`IƹmKuΛKN֙dhX+N1F|C$+#:PY<;úM63M|Uylv~y|%79=v!eYar%b/l^$Ap.m]$k2j/y||,KTI,`bI1ndZ/k}( R棭,KT}i\湲,QrD AI2슜vocC]&{e`=]牵viL>)jQ4/QI%R3 ZE͗5안;Ҥ/ⓦT=f{ %*h&F9`]B|5ĺ:o&oq{'1J|+h1')4D[Yڽ]-o& l0l˻.˻P6] w1y3^rHDX_'HEairDfS_0UTS^0UTS_0UTQ|#L9Y3M0&)@|uQrkVV`s ,ٽ4YkIܞ10ӇGw%m|YR\5p|./'P}ɹ >1jBcx!<$#.ܞJܞglUcs6\ |%*AyWKlH52CUSJd2o2 Sd_ʼnKK֗v_l&ʪ/{t9(Kt9(=j^r˹9W}eͤ\A/̗7sm?vU7EsZE0L'Ó~~{A#wsŞ'Ygluڰ`f9˝WKZOTE!luQ__V|(JLZ"gMG Ӣ,Sw dltsہ'D}cwcq1&Qncq1c&Mc)X+7clvocqΕ\A &*t2, W E@9 9`PٽΗɀִO#b `Vl]d $4䋠/glb3->B(R.>t0>Ls0>Lw0C U>3p:c%H|gCe>Yjq\U#"[ٽő%L{{|FbRӝ+PG, -Ҷʹ`Yg%}u 6icS,+#.nױ]du%c]hu$XpquH\±XY-+' [v쏸}eݗm1'1x_f̼ByK֗Xw__}u{cd3t.kˇ!eC9T,+fW55|Oݗʅ.5 OKkʕurZcHN 6^VaYk߇\Sk\kҼ/jˆVS)ghuDJ=c̗ =nv>UY TY@GQam]$k21t%6RcOc6[/9$4CB7drHAʍ1keCuB%Y%,IxBEmW 5ffJ}Ɨ[R3o_|3_f@FL&gEf^ò/_*w[·fr!{*,v*=#VBêv% ɂ/Z0Z8CcX2X~C9Xэ N]aY o7fYoNؘEg~ÒI76׼.>\uYk#i+42.B)xi-uӣk7Ô7t,7 inȏ~W" ۘA@h ItrIG'AIbAk~hHcY`1.Sow(h@7 ioX;Ao@>4>Fޠ~"n/E($S@Lf,!K7$7p7TT5 g޹L^ze/iop 8D0M̅9@fF/ArK'lh[un}(ɃьbS̆ZB3 dZ{crqh [w >&]Ŕ&ǏT\8& >w GEkPUgrwH_;" 4Y!'Rx-҅"l[SiISy!:B3eQQfF#iUTƓ'}G `xR46||dݯu=-#L:%ږ fN.n$MwXjHwWGR"KsRkb[ CZMj]e_j4ǽEc]#$И?O@0rίLMjn71XbkQړ:hXWhAmG'Sڀ1ڑ4+TT!dPdHW0,glϖl/`Vqd]ϱ 8i d \Қ%ۛ$.ZCr,UXWa7 P` ,\f9 P+ފHGM5m$8=&s<3gW6EJ3t1#MmSd.8rHZx!@OJy=nhMCbg u' ǽeE/WyPaLIQg A439\7w_AJE"ɃϖHađLDo*>uDLŊU=F DG٢~z n+| DY‡OMؖ_UȞ3HtE=|ysv~MZn7Brt8k9]ˠ`KK5K~H0  "h32bcv }2Ph){nY(o^Wvs4KcVS婳v5B*=${Ekq^JMٵFrx5*d仅8MɻPU.7kQ$`>V/+KJe=72F HTz܈8c &!?I;hGheJ^ֶ궺w3F-,N. ?v; Ǟ<ќݴ?ϸ6>l‰_pKJo#izrcO]ˊs^uX]K%)i:(Mqw}{1hl|o0 9No꼲c1G3355a|O4e8SQ7+{ٓobK#~h,"jPlXb04.P]y"-"uuUG֐YYxM w00K8]6F3?])ɖĀr@PkTlhMd7웅4?;ߡ4ݜFf.f9$*#b9e@M5(gmo/mo?BDph"(Rzd.8rHň xV悜G¸G\䬭',&l?ȼ$+X\+^=`>V~6\бB&OY ϺsE.$nD?(ai m (q~&_V1V_ׯ*7\M z]*'|JbPZ@ڶNPB\\{J>31?^._N'5|/Ϟ'V'1bBgoZQH^ϥjw?n_Ӕ^ :1ACXW'9ɜ0"uv$e:yͫ^N?IR+"Ҋhtbz߼:eO_t yEf Jt^MeBr~W O[Fއa(J ٌH'؜_tzjFvx&[~Yitk\P~l]xHc]](%|4)jEVWOAs'Wݽ,JAP =JH +kLE߼:eb.Sd%# j$ʋ#4-Ҥq nV|e_\h-zI}l鲱m8I[QԳ `d sԉKdZb.堂쇹s,+5ds(JS6bn_q"CB+҅o(J)L֊ m273r sW{5aLPVD${X(t!`,VpV${EkHzs2gڰX?pܜIH)::B&b.ŝB4lp]73kA+~$E>_Mkdt / Bvh [OO50|X gbF`\ `9$ ㅶvX>Z Y19g+r柜rulZ2]QS}${o4CKUTĝ km ~m6ր t¸e(p[Rx  ŊeWLrgP#sE.dAcH)AL`XB}O)H b5HױgMQW9}t`HNkBq'dar>"<1nEO:ݯz+d SsnHup QSt)ZUrBY尦i.Yrַ1e-UvUD*P,ǠX38A zW>}G8mu@_c d@)fC 1I\:V>nCpDg$,0,gl}ӧ׸*,cBZ cS H+ Aw ~hx0r3 z1S 䄥Y sf"{ó$1>eGnv$G}V2}N3W-˳ʈ ]'>CAyҪ[=pXN:p6,sUDX~S;v%DFkP+TNW(jۈI Z Ѭgy5jNTֲhHZ߃Gk'>|꼲(1g(ȍͨWցæo꼲}vۥ0 epV^ĕ9. -+pZ[EFM"Y+=5(gm=fAݭBKm|1r]HXѿ+r OWH,+\*dAT@+w!L$zc!X#") QT?,B)8ʉDo*>Mjj_'cQD+% nF_·~V]ΌTlNf _=7~|Xh^фa[ f9nHW \PZc?.f?DVWr~TH+x+\)7UoU%[" acToQZmjTqzKWEW c)iZHa'LQe5EVGiŦ$GOBa]RFF̪-a ~U.JŖГz?Cqj[@ڵ0/RxdK~ f}ڢQ$է]'>ނbϫp`*lF$Ft~ hXRCa$GC ޹wg Z^b/{O֭!i[)Y{'/{^!{+r6fQo^Wvz˟aY窸JsS+k/YTyͫ^-t(+"(ȆHMF^M _hIjA9k5?Rr}Ws KC8\Rh+[8Znv \R0W,5-+ )х`N^ԋj s`9$:cg98Z+crEkHJb_\1ɝ)#C01`9$:(;UXCUذM5$gl=$Q"&KMXb<$rS QQ>D7zHޅD@"H_;"꣈Ks/.Y~ $"OEq2"! 1Y}JtGHjCLW 'f*0 ̀Ir7P&o5QTs`^n9 dt~M9ZNIGu.v0-ݍk{?ꗒB['\V48hߍF.q";M*ڇ$>8 fíCi9.i ZNBlh_:N;^Z!f|}0Y,濫S<]avc]xbaXpll;lgrϴ^d 꼲xb1gxb 5,&+C6 o^Wvo,*$W\E#Yo 9̪'Uk_0"0U,gluxb_S<"wD7x‡x@X<1ڐ( =2!sHk;&q3Rw]}k;j2}ǂӾc9cl>yCA%2BiS" 8'Z xCp ./[Z2!}`I !~ ~$*"c m.)@ghYl-dgbaDa v+`gȓW<?Z:3Gc"C} =(@j鰃$n +t &~e5GK!!6a+2y* ?hI֛#11OR%jae\IF(V:)jv$*#CpC߼:e7oGa액 ͍ L7Ͽyu^˾fͅ6xTv+J$]ȄK/5"{A- Mph&{=^?AB5k-R$.m} a$\Ȉ ebt8.q"R1wQJ,[ Z P 뒜Ձ MA 2y6 r񀻿D2\23 eN(9-TTRhYO+ B? Cpѿ~i{.oRúb)BS#426^$}2,uI{w8$P7+{Ygs4K+S/W:%RcIʄ:߼:eARDfdKPߩK*.Al dAWX&qA.9{[=4yb!]:s,tђ[:"W&!j PA!A eѼ`beAS@B[jqLB@"T:ZL t*ry-X+p+\嬭&?C{^gŽ l=$Gh5*ru嵱V {%kPz&W) J2gx70E WZDPL3 ɻ}P$`a. Tqf"&7\Hߝt . >&I;F_1>%rCqݲ;JݯӰ1e}9ۖ~=850f,qYm-ï~`5$+!2F:%\_.HcݚͻPOYX{kPgyH7+{Y9J/M3yncf 7ffd{ͫ^LLV3.֕c}+WZV^ג(k4DJ`b_`b25g*eK/&l$.N('3xvVN 6k\ED.Yrַ:262ށsAB` 0i;zc9zc;r%kPľ`bγ H1C`b3 1 1XLLLlq?,vo`b#cM\36`b7pɪ*d01L&/L6gr$L`bTLl`e Kxm蛅aqBz2,WXC`g `b,`b ,iI(`b,skZ/NgTN|ݧ`b=}L[ "܌IQ~ $/E ZcSTA$P !QQ4Kn K,("1   K:jF#X+גaqji,q6USo^WvK0 KJ")UxLv9(Wݽ{Xbil+uV^Eqy啄@~ʫڕWW^ծrXb_S,,G d%Vֺt ,qyҎJd9b Hc)\\k ]6R7@zVa Z,swA4\ (OfSe]CyHU^]#x匭x4\{Wlq[+ޒ*lY^rEInQ"o ouq;CUFP68f_p|v|t<6ǜ`vLY+khaeSu bx ZH;WܭT8kR 4jn'qwgGy gxgiywvv杧y9O oJ8Ap& D;pH"T-Шú\Ct*aq!<|»Վ5Ҭ_%N}_ŽU[e^Ⱦ^U⹊^Uw0WUOVܫ詖Uc_~Qܪi|Ha5uSЭ0QVM{>Suߥʫvb|j Ȭ~Å ֥çVaxuIIL⹖ILe ]LtaeRVQIsX7onTUJB|jQţSY˦QgMVULa(EmY4vb0D"$} UY.]^&Z ƴcw|5K!f2eyncV$W'GWwM;U7;๳IX8DڤӱW[Vh UHH]W5ZJZIL5=D]YOȎ|@/ٿuֲnXZQ;ur8 78}PS+i#RcIY=險sXw k9x"diNZѓZݜG.Wk*w_Z߱S쮫RS:yT P;:p`循fꚪsXw 5%@S Ѕ{9V@P?k%lV<|Kڱn/7NXd0EVBSljWdkYmjFVgbJ2vMm"1E/VPͷgrux-VuyKҘY0|jz^ ԕ1I__jF ~pSH[O{ܱ;O!f]OҔwroIK(Vi'8k&نkha:p#35%<  X(1ECJ 4,@evE2:k)D#v ~ 怩fʅ 8 @A2rc` aǺ\xtTUHʺZH;@)imY=t͈\s <0p,$SꉶZH;X\,֌QHz:Oؖ:O]9<kHhIOdӜHhjX0 ȿ9k:кf› Ј݆ |!~~'%2OW;ww_jy` uD{4 'P-C E@ vt/ kDrXτz&}1ySKB1/B̤H!@BhIyǺb8g>O-,>fuQq5|Z|O|jyڱ´<(6?IՂpgI(ʳB扅ǎLDb'yTk#Čvs:XStvS B_/uW{8jɗKެYz/fa=O?ڥ{]<|ݫ;)ںxwW;uyl_eΓy 8Բy־o $ΓΓ},w*ӻ)QZ- ; W f$֬ô@;u?ye+RD %˥ZTQ>N^8aMuMղv*Qw߀@"le) @եaBCEnjw Zgh`ΓaUnJlF5({Xhw[B旆M͎CΣZKk;yTpt9U-4<<^yCv~U/6e^UIWЮŹzCjf#v뚪y8i{rG@pUEaʰ g]uMMa5gJ>W"dCzϛBcP+i!- u`uMrMcǺU?+KTNuRZH;fH-@CmsO-v|i=Ylh>g`k~٪t,dym{ΝIwU>{?͓Fvl1'4<$u蚑jǺG)rNd!>v;}V;)YEpsX7Zu|iIx29!8Բ˺9 ~F]LIY( j \I4|jm;;30 iqK#8\&R-iq !E+LFl_(Y13ľhqh簞iy/Z'Z*jPi!ASKZ; TmOmSmS JU)$D6sGv²ǽ{RGJF:S1_*T@pZ.[{hӻVu;9;ǰ1>I(3 ް2JS-XjJ:#+25U 4j|̋T  %\Frvuq]ж._5ر9e]1LG 8EWcX&6Ja3fy;Ϫ:?,S͎UwjR;b@V|(ˢem㱷vʪOl֒\acNUr?lUj/-jĪ~U]XÉ/9+%!A-9/Y' Ǘ -.ֱ@;78(=>@￫<xR4f_De{|_WHg繺O}S}r >5xgú;O9ooq6qVq|D'D'zfDh %e'RC NJzbƯ3ԛ#ƈH1"Bޱ4c#tI\tfj-~; :3./ZO3"TKh; ~ZLz: jSѬ,> zî8Z)lXS7B#jutہZꜧg<#g<-Xw2S:ic@pUauUׁ+irVКpbh`籞 X,_~+8wTdL%Jv{tq4Oe9:Mۣ[{^ttYH4,3ktђNu7L_+wW~+7[EXKa).ۗĝgeEΪ+JͰ#wc_IMz 0jB&5vUW0k~5U4Xϙ!g ?vecަuFNոdz`;4ک`5.@Tyߌ}vy{e<4 y<@<ЎS<4_塝<4_*cQPVڹbFH՗i[̈ZFw2v2]rEw V_fi8^j;0|sa8#]c=86pYwiyjlju!ӒsvU<:<:iuǺ;O=V }/w!h RVVN[qKٱýck{jVwWc]Hcwl-qg$C˻_~-X9Oq-<Oϕ,|_zN3=W?𽝇4O?ԪdQ|E@ z*?t;οHr^܁'tiNc4]k:6Wfmm/o[-g0_v~*.}z~H8ӫhz}_M/sQ%PIEz;KI/g ȋ\} vHؖl6ݺ|*˴}~KՕbkJh@ xbG>%tQ=D?T_D7^UX/.0^1 wCc AZ'p^ZHK{w:6c̹ ^sounN~!vW? h5OQdˆqR[gXֲXCY=}C>xfoo@.-1H$XMp~;{˭1NŚQ Q>n*}QU2IiX&y)]2<{@t%]5֢5aװ˺w?~r> Sg_~=;M:!q鈢 pz)?r ! s !鰝x= "s#EB$Li{ zT_գ*an lv:7$k]zE ~L?ૻ-Wljኽ2,Y >gG؇q]ȍHR>u\՟Ԗ<,f+;lnbkYpTGG]+nb.C0? v{^+a\"#q~;9]o^Im)B#̲-9)zR W#G|x(ኍ +[7U:|^W uHSE ySRVm#2jtn+ak)Nm7^#|uǼobs̏aҷWyG؇q]oDGO2a7Ob#A|Oi7+63W#G|x(劝nT'"m*?c_uvngWom&*ySRj&̶&*y^qUw|ӏG]eq*ttIHx4)NQ{hݴ´J$iOE>͑כm>f@Ev*pjӆ>]7=N~8J%(C/:Qr?}2~mHs~} n8+|( m ֪B!ek~c/9Ʊk4}s1z1.h;n>R ^3ڋڈƗ\nYPzӎ~u1N3[ݛz~M{<~S$Z'Db3o>Fx< 5xIyili#cz#E)!UȒ6OjAYZ jz w| ң&@3]}ENۻ yv En=$c`8JkLIHK_0= f牷7~~UzztUzty30k'ђ$nӽUwZs-z !{ߍnEo˟SUt>OL,J~4 6+vHYwln퓽m=txnkP9Х*#謱*F ehtD9``$I39G~$h:qTrkH*|? E|(矕&V̍ؐ3^x0-k KP_𬉂e{ ;[a&C]mً1Ol}醃4;Hz_ns'r^/2~'>)eOb_׶c7AtȎg\Bendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS3 14 0 R /GS257 15 0 R /GS258 16 0 R /GS259 17 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.302 >> endobj 13 0 obj << /Type /ExtGState /CA 0.400 >> endobj 14 0 obj << /Type /ExtGState /CA 1.000 >> endobj 15 0 obj << /Type /ExtGState /ca 0.302 >> endobj 16 0 obj << /Type /ExtGState /ca 0.400 >> endobj 17 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 18 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000094158 00000 n 0000094241 00000 n 0000094442 00000 n 0000094475 00000 n 0000000212 00000 n 0000000292 00000 n 0000097170 00000 n 0000097427 00000 n 0000097524 00000 n 0000097602 00000 n 0000097651 00000 n 0000097700 00000 n 0000097749 00000 n 0000097798 00000 n 0000097847 00000 n trailer << /Size 18 /Info 1 0 R /Root 2 0 R >> startxref 97896 %%EOF robustbase/vignettes/plot-fig-power-1-1.pdf0000644000176200001440000003271213465050122020300 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180745) /ModDate (D:20190509180745) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 9229 /Filter /FlateDecode >> stream x]KemϯKik>Te9S(dT兓2SvIqݷ{Ό)-v H| N/~K ?[N/F~7o_ő./UzWKx}ꑪ0&K,5KµK #_ a0["Z_zUw߾z =_KwRb,.V[r [n;No׭0 _Kx>v-}RIC`c1;dY`!k]]=\[s \{, 8n e5lNf}-_Bacp]% T?޲οx+}u].yD٤;̈́r%#`H; !aJYft 6+.Ur#t7XцGWtd8bISQ*|nԍM߉tZ x(|m4snms  |ݝ) ?uwV[t=fٟ *4*a!Aw"|yb ߽(|2D~; yyS\y=WGcJ[[]%c]dl2)^KEr=ovn?f xF#(&K<^9ҝ7{4JƓ:h%TjVֱV@[^RZJkY]5vʦ=4Q1 &/VyR6F񲊲7LV/|1ZEfmrТ ūJN Q'lYP->c^t}.ut4ft25 .{(&OPТ +_J>cD{kbOT=Ӝn^$B K ?hi}C /|1cnzd@F'fT.%6[k,^@Kլ<xJeW -1IJ;q/hnk&^xxLKtJ={4ExN7LzƼ8ey⅑ʦNxŪxL75Q"~4π1NYC8?SZ' ="Ʉ? x9ôz!HlfNB6kQlynon˿lk^u+ %lpk 6GB{nt 0ltg+Ϊu V:8T~7e02s:eS'bEL٦hgtDes14Т CvdTK)-7lZ݊Wv31J~54)48ۂk~Je/h崄Z4xKhO9}Egb)2D  9M/4tI;|e34axKh% d`X.MDJ7TyB1 > `omV&;>LY nyL@#Y\eܥfeb[+58O^qmrl,ȝk̡2>#JD21([f'|߰:;Ηj&u/ jiy#vy+Q%l} ʾJ#aijDתjS r2óhⲝ, iz|Gleln+_JYz[dSkv؏4eqa_ryߎwߏ*c;\F MC]ڡ.|灠mUnvh8tLqi90 WX lŽI WXw(u8 <0Qu}:#omǝa^n M恒~o3p &˂>ghOdtVx߈pVZq&6V_6gefPW ќ獀SرF@S 92'| cp |-_|˗c򹬼t';7kBެmn ,A'@&D>*]츬u*VQ:~&#= 3US ,:$D7(y`HnzkIh` B(VS:mՄnt (5MWShW^O&nFBsy EB% V-ȿG߱A~ CJ=sݩ+dJ`ܨtvH(טn#!Qfӣ ^p&%zlNP'tV;$"gV;/-99Sx?ם~?քsϙdfZ5a _y9A 9A9tX<'\˧Z>C˧5 +,:ݙb>"b!إ4㲭L Qwx^jUnzS\4d |> VS:*9HiB;ZAUnz^"|>5'|jSsnZ"| t۵&+/`uՄ,USMMrD/S̙^b]5 ]@ hv&ops=H|&mL n CvuzI&mjYXqMoWmcm뾙--6[cfݗsD]duIw{5mg]WזYtY256T&uC^CqhF$OV~hidi䊫EF;^)+7Ƅ]q rHҁg U(ab)Q((-7X[ʗz%sB%ړB鰅ړBPynvslk[VW^KܘPLw;L'F*C4/xLB hZE2-!%$,/ĵ))W&ґ_~%W >QIh)}cSPAs ȁ 1#*Л#]w96|ucA̴ȡqVvf`Ȏ }FV@V@Z9[9flwJ&=KEVj1nVNKD^=5ѣI ZK>>˱OeQOyMv k-!:\RyA2\8"cwM3OHʖܚ]rBu**)1D)M |Af2fAP7ʩzOqB&ưBкmLūJj"WFC[ -P|D9}*^6i'R'X{z,KB!%^h#숧ZV/|FJ&\0nќ &IAPĮRl CmlͶmu | +Qu9MkpSɱĸxe(47 wk7 DnXE]5QMEMEuDGM |gN{M~Uԏj"jbG  ƫBJ^5QPڍ+{Jcu ލ9Odu凴jbC @K&MҾ@R2m(E j6څSV],]vۖ%FW:$S T16&l-)ZqAInx(UTK5eʭ@^U(j(W;de35򥴞SVY:MD,16ی}IxD\4.NiĶhb{Gۢ|D Ai)w妊rkQ(Mū+3pDIE1v W}*;wH@ݸ)2)yM/VYLwS={-&*Uԍ n@:O D̓2ܨx&m@CZvխ9ߧ+W+Y6hY;*e{M].[弖]ku+^RZK=YX#hG#1o_mOG"tfhgFWY>䓀$N".y iGvO=q/k}n仼ٝ|q㫾> f*߭']}]be5K=|}aMq6Zͼ*,yU(Uekܖl_Xvg6ovsPlL8>~8uG61 mA(mQڠ8i fNK}g/ pw¯efP% ֦B!Z4)?õA)xmȁm1ʤNhkw๯ԱefP~6ԭCmŗ^5/R V" h:*6 /\o);G-dr+_J>эBD7 X^x*wOLSLMp.ӄE2M(Z('Rx/7~*qu'i?I::hbibu'i5ђDKGM5':*i/^wUɖv݁n3,^@'vùn7hvm89^OM]}C Y gYIZR.Ϝde@Y>-K)W(/wM ;LiūJfbEJnɤ({=^-etv)̍|p6 Fi*B;R뱠-Ĭe3i4':^@pxb|t5Z,p\7oVE|)DKRhʍʭ[)TERЪs@NiAWN;?R 4QD^%5QD^CF|sU.Vt2Z&˵N}q#ݜg(A+|Si5<ױ. h4z3vD2LR8*iÄ&,iB"j±ьæYU<څ]>)Mk1g)"8rƭ3i gMʶ`sV9>yBe R 0bTșd &WUɠR@+!g5J9} E9h"%&^$B b4VfVkxKi=':P5QL5xD^pD D\?[|<üU&Jv~¤QJS/yDn.J 4"{9xsVJh9[՛o.,"pm.wlHpToonWwa4՗} .D7Bc97jz.nBq3nFsFfތm3nR8kڝp^hXt%y{e[,:;|/.KA.A.ݾ@arvb5cLHlmZ=מ=WK~יּjuҪP׍zƫmRg)||O'": 8OcuqH$IHly]oA6f sfm~@u,6yȷ3z}Wc\W'ͱ_9~F*ߎqvztGDQ@.}__}uʎ/\  Wwo4wG{]S yfh>iLj{ǹ N!oƀxoi[Y?QbB!KsEZ{5hРTcs9t/)8dw*!'v7Ζ)O[\} Uھ޻Wyw*w;Wyg*/UѾq`0~~p=Nɶk]"Uq Lq ]i3i #hG!GŞ3D;(6zFQ ,CYBY3-K,~GEndxQ ?}/?F0[قx뾚<54nB."US<˔/l#5T0jg|~|d)o/ 3gx_/_ƺteºn>>H[NMJ |!14_>">,7 wUڿz{'R={;?D׵0$c4'38ASt~gԾHֵ_&F8PwGws޺9?e(krH,_z.7y|]i5s-EJeқle ĹnŃ/]&C#̝vx7ę% No%=`?`tyu`,BycMTV_*xi`R2gm(;<څ':mT-~r>`sT [Fc@ k{IXI VZlW"a2k݊O(p[1tUu4q`?U=gsGcqr"+s)~\a2 K# ;J R6Vl.0;m.|?n+j #;؟jؔSE#VrA2;@/rIX)׍шK+- .wq-9D _O(Dt@b@G?7nПoyz;}Mvuxi` xCP3d;W8ʾ<xZ|爽shg^oxz͊_юc1JG;Fގc_+e?sOZ~r>`sT sN?21o?[=X1ZsF XZ?0{SY/pX_G!] O[(B?A =M$d{/޺^I7~1o0$@rZGw6&$龒B#,kO;޶5afo߾}Qk/.Fjcj$ʬO/ӿ}~Ir;35B^76J)nY*ϑw$m|T'^/4endstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS3 14 0 R /GS257 15 0 R /GS258 16 0 R /GS259 17 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.302 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /CA 0.400 >> endobj 15 0 obj << /Type /ExtGState /ca 0.302 >> endobj 16 0 obj << /Type /ExtGState /ca 0.400 >> endobj 17 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 18 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000009593 00000 n 0000009676 00000 n 0000009877 00000 n 0000009910 00000 n 0000000212 00000 n 0000000292 00000 n 0000012605 00000 n 0000012862 00000 n 0000012959 00000 n 0000013037 00000 n 0000013086 00000 n 0000013135 00000 n 0000013184 00000 n 0000013233 00000 n 0000013282 00000 n trailer << /Size 18 /Info 1 0 R /Root 2 0 R >> startxref 13331 %%EOF robustbase/vignettes/plot-fig-meanscale.pdf0000644000176200001440000003415413465050113020602 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180739) /ModDate (D:20190509180739) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 10066 /Filter /FlateDecode >> stream x]K$qϯtp *\)v(Žה-Ŭ$re"w3{,gYS?~uS?MW?GM]>G ߴGАFsu/H یHKD㯏x#gW|͕ H *:_?\Fu;M2s fCf=[u+圶_-_#p?io~gc6.dVH*~!_/iӯp~եo/psso̬*@, M0xYehgx#'nΆ╺6ҹgC+GǦ+J};xԊF UidVH*U"/p=:+uwzMNQԟk<-tYh~6<4bf~ixcRVs6j#` >vi:(i3#O|UrV0ZfV6%ވo>woYB,_Jx5ha0œT@X/^f!Ǐ9OR]Yvkx_ѳgid֣T+Q4!7K5V/ZzE񮎭'L>K/nb&#!Y yg:V?bݒ~|lf5OmK_~@rr{AI՗L'++@.* /V&;:6u3etYT[:`~˪Rbݾ2e GnF ^5rCcePNPWN,|/4u"VΊƺr7J/ߪgMI7"}!Y{AdLyţkUSix\*kuţ@7DsjeTx#r׵6k$5N0g$Z/Ez)_7[oXWEQ^G_ƖG9V>vq#] HKVjoУ`*7^irԦڋx G_el}[[x S{ a8"!9MC7> BZuBR oD6F:M=x) ح!U 94kl;[o=I{"}]\Gf^{ah4s1>7Bh5& ĺ%7~)i3oInF:/, H^/+wZ:dX++SU+/zבZ?cvA=C"Y }hױSz:+ҭmo5^r2ljHo' 84 |).'ţgIxXmTYv<-.,\;qeX/0fC|iJ˦ ϧ{:qx4)5R:(z C{hd:_fb7kwsNPq5 oѳɕci}o@fA@oY2ZDv e42TZݮgWtAڧj7$T(Sʿ^>ޣ@ tiïL3+4}g}L.lt*FiL9*$iBMd N5 c@nmj[]GE2.ٖ 9f3 `4^'V!9O㥄F*Tt4 ;7yXczv+kPeGk Yб>/sUt&Ħs<:bl8SS?R^iFڀMٷ ^&px<󰄃eY9clgri^&>>tyrNK}JuFٔ0l;+B$&$ڄn[55W o_c?r/ SdVN$Jj0r upL[dXTP^fN1ܱcޖ@mބ&1_d ҈ D3?:/W `q'q5&G: m_LZf2-P56o_e؍Y6i=7V.a<8 F'=$MelrfkZVmJ*9g}ŚiPMu:bSGkk;U@VUOԦZj=z=%G_3h7ʏ?ѨTcR pMeoTz`}:mbԘhYrx?y%AVY Q)}yb/#lM!FӫBiW MY$>Q9:)G"ZLn{!}ĨUbM-X<}',^Wr)(>V_FD>ԥT+_+WYBԒRqk&-=)hJXH+K)`{}+4[֢ӢڔTx#r׻h4c6': |W=AS}rX&Бa09yAkTDx99yL=e")#F<y ADe_dlTAwf 7HZe&:Xh_t&ya%l!:>&#ʫ"*756Nj-Ih˯:hb۪ko|STKċQ=L@G7OA^H˯.ʲgGT?]C>)C{!_CpcO:xQ4^<tOvbwnddW M5ݔScJyVNJ:ȩ#XͽF"}VL?#3xǙx0ŷMnT\;_X<ɶNWN ̓JWy.np!v2OU!NUØ)ହ]QBw.xNH3J2Ɍ9-ٰy}q7(P8VBNQOi1VozjP20s9S]`#cKs%)!v4Pnwf, `@i9f4 ͡4 $I7ۋ st&}$>#oYZ.= jTtыjF0F0Tɡ 2Du%-afi;{Fۣt}+8G2Wl~WlӪub"uioG,k8ʗF_^le1;]E+4] 0\9@KiIj牛L{Q!xڠ/ΆKۨQn+ΊV,΃Qgu&g˖xDl FѮڸo< b[xI-32)|;9ȅ;w-?0x d8H6'nƖ]_7*TF2v ~2R%Q<'y1w%#@V_20,?mLwVٖtKd~iSG&reTK|둨tEdCY+LIpjl2- ߗe6gFCY\W^W˪R*jJ"_*zT*j]5 cJ&{zY؎*ߴnimuomn6cc;kE5lK%+!n+U?^sruKR3k ~k .^#jiKYLϝ\ l*rȟ\h싪,PҀKCStkInؖtKd~<< z/LljV0qS\Y-7|Y齥$|>&RHWOE<2cp27P/ _VM,Pչ~]@ʹCl"]كkʌ4{e,^Hǫet)S~ D><ԉ>,a_"{{mu>xk,ux/kSE;h<:-s~5=,0˪Q7C>޶ه_YnSf}qcm~/γֳK55[V֨KHz0d ]Ϻ]9Ksg\Al/~RibYEN! J9ޮk @+$:!T C3ÅkLDQ ٕR4&+Bɥ#P-եY-D9- ؆;Q];0hގW.{QGdv`bW#Ÿ:^-fcm; F4Vj<+JVB)N J-Txzo2HY\-)WKTkgõޒ'o|)iƇ-cL7#9ޮ"- ΂~dx־1BDT j菎G.#@_[`!siAD>V,; sla+v'kv o|(AusT4ȡ2ϕs]Ǎ.O2 [(_aZ34BVY|\sRά%ƇZJ2dQ0v(_Ce=۽e ._X!(2 ip{;ρ|oȔt-0V!U R}f-j!ri!L5Rx,SbBZ|~T^ޢP䞯Cf!J|Eo:/Oj(O<_M>ѲN'DNKQ3EBpw:/E^߶_ke/o{:u훩o8a5 9'[c+qb/s_n,y~U~8ʾMt9 ({v.pnN'x{[w:kTﶲ}Yv麲_|ƍ6h:2!_U?+'l3I-ix5u&FI1WXoMtfC'Z)ެώ{qZƫIü3Y~'{ܾWhmWd5S=BĜ:kŽTvo.'vVv_v;6{èx7O7~KruU{_Ø n#. zpfA z}pSqQ/x;#]##}FGG =m5Z=oQd\wuu+<;Ao#.:Kw>2`|,6{xأDc!uoo#ma<-ߧX.~;b1 }D)Vpߜn2M֐R_o&9!xHAq'3tvv4\Gf@waŻ{']qxwqUT$etw_y87r]cwmQ?OR oұx.l06ӆ;kҊ]Qh7-%[U~&ݛ{(x=U"X~FE8rzY;l@G *1AZtKd~~eY{|oh: :ڱ+&x/Xu 7[ {-pǵqm~ .t L(רޙ5(X6d߇-_@YoWI±M,'Xgg_,ڔ#is]=cY VGoS o6,cZ:dڿWX3A_w-;|yc.ƽޒobj:Kysޫdܒ2ow.G7 6/l#F1j*/GDNAӠCUzV"B&T;_e4dg` ;2mu9ĺ])i*˷LVŲG4+(7eʵBX/1LwRNױNF;-s'I?Q: oұĝR%oijܢ ڎ e2k;:؀<6syn1pUnύvܨHFynoұsw,}1,}<CI?}yK-$U;<:^qIRwv1X#'HpP: Q9l>)Sc MSiF 8w Îr"#%&|t¦s_EL-ɗ P(| E5pIw6iivd9 43snN7[oG9|3N2]9Sx2ͯͿWO_} cI/7c<}~Fȟ];=NRϞo~oޱ.v۹~6xݟ7B$l6}=vx;]_ pB|1yo?~r<^^Uw;_d?H%=*$}~ 1*Iߢ{AO;< Z<Ƽ=%]xB,bIbT0s0snNñ5yx_P%䇬9,ӖL=č/??#[=N?7V'2ֻ^AB,R~tMOKG?:8:Xݦ2,L䍃Ē5Ba1?g |w߹x_ӯ~Z1׋ k {PkAn_HX\.t2H熚NtvmSO0nίӨ*_AzP>T!X1w]xAHjL6)Hr6ҫ~ ?<}pph7P7;+_K@=QNto\tn`ڌ9 aLwӯm!\gׂ1u=K ovk7t~ux)L3A#rF;K,PK1 Y>_6QXmï+cUw@b8^#dk3lk#lAƴ4 4]Xen.cZd&; `;WBuZpy@5;WZhiPUhgh:iihDMVYIK_ifԡTWʾ见}h ٜ(DH, kV]؋ڽX lͅ~Ҿ~E5n!o](zG B^w1JwQ u + z"jVcz$GMyiGm\ZtQ[$E..D.ډ Dcy2XA'z ?)ݘl,FD2t>CK ԯזbXݟYD["0YFe٢@/kOoSrDk/k4~AMlG+.*G]^%\ u%6pӇa­ɗ6(v} ek_a$^ztTbUuii?Uճ6܃s1@+XbnOOiߤendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS257 14 0 R /GS258 15 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.400 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /ca 0.400 >> endobj 15 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 16 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000010431 00000 n 0000010514 00000 n 0000010689 00000 n 0000010722 00000 n 0000000212 00000 n 0000000292 00000 n 0000013417 00000 n 0000013674 00000 n 0000013771 00000 n 0000013849 00000 n 0000013898 00000 n 0000013947 00000 n 0000013996 00000 n trailer << /Size 16 /Info 1 0 R /Root 2 0 R >> startxref 14045 %%EOF robustbase/vignettes/plot-fig-cpr.pdf0000644000176200001440000012312513465050123017434 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180746) /ModDate (D:20190509180746) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 38203 /Filter /FlateDecode >> stream x͎ܽ%Io%'o4T -@)@-ǍqoeUV\dH#h4Zyo?{ן>So: |oC>o~~ya|?36Ųᓬ囗u{[d{G(p:Mo/XP`)@^ηoCu~aȋpJP*W$\߷#%{ )x_3)/IM)Vג>E- ܶZ\u(k@?e2{O0luخuUDG$SY:4˲jc1[p5m-u(R+5"ٱ9;ʤTDwŹ`I'tYڏ9[K-rxo~HWY?TJ,_,%ޕ5hGez#sF{lpTbW>ޒg<%_R/%u~Ie/U/,⇖]>RÞƫ|rÞƫհkFŀh² AGFÞk\n҈Ѱ4˲_^s4~ֿ6<_^5{#RzzTReYk2Vvju!v_R| !RaF?V#oWkXֵ6يI]2e+iAx&ϼP9C-9U0vLcv -~hٵ-#5/{K4PaY#RzzTReY/XKׇplZqftuc҇nWKrS\ XRkd;WXֶ_5պT>z1//s`gIaem}G^j?:}S]r[ZIwCkyiN*]·_1~|/Am'CZv-GK [T#~憍Qg)7kH\ H XJct藧bopI@h Ԍ.X[PqzZ"XRSXJ,k헢=oE2b֯m_گ+Z1~O veXNmN3ʢ=`?M¬uDʴ!uņ3R&:5vs=4ʋ]yKi@eE,W=ܕiNm,S~Goi 25nA!!5&r6];d=k^gR4~XGM[O%}雾ZVխ[)pmqҬ!4`Y[ v*RFN󨲶)%7SsJNֱ߂I{Y2[cni%:`:&d)L 4G޵4j^mpټo w ~OY4yG.xL55EmLKژ1B8ν {~snSY蔛e rlWߎ=zoS5OQ6uNݮߧ; 4mo+84cgㄏ8$_]d0ttpiwih4܎SLՈN &S:]:|kKVߡq&i|4:Kzȼܖ1mL v}ȰLxaj}5I# h|5ڮS>aۅ3;ܡ;4L_\YPC% i|w#wwD׉O۰eqnW!~ȭovF9~lOy'N'䂲u*A]~ =;pL7.[6H;g$U¿O?sYyNGՏJPuRۊҷqWs6ynιh/8J9JOl_.s|ںF WNյ{68?+yӳ،rע8kb/*ċwO}ٴ?`~byΆ γ_xdYz*Ѩx=(/ʩZ"["mo-̮u o*?хNXbe9L`&L9]h ~NŶ!>tޒ-ޘf7vsmxze;XGqmGu#֚ˍCN GC=Ɨoڡ ϣ{.d[<8S$1:meڡ ϣ{&yYzE=]CwhCéhZ Ce& U^!hcEW7~_G1/)L'뗭g'񴯟]Rsfkﴇ42+,R[ps#3}wY?_XbZkTNcQD;L,`IG&Եlm%$eb) 責}fD$l Ah84 5&X##?o 8$_YFF.%KWq4Bz!b$͵:ۋߡq 4I> ):-FfSrْ[v.&R_hx,uA~;idM,]6gʙLٝ%ί¯NPvm,-qJUTvKv Xfbkn1-7;XJL$rv#%ruq]DHhaS*5ynĻ<65ygw8 fbk p:y3\wy8g@46XXo:X/L|҄T/@ԇ>(=N-5رuyvE<әe KUh4STeR KC+' ːKCoȐ9aHl"C>1s|j@d[s Hƕw $5B';Zy֩[ZAέps.ZβUm!Lw̢j=m;h8Kرs+عV(5gTGkĻ8Oձ_wm?Zfk 'Š!E vh85| &fn}Ƀ= `S}majl7%)#9t4i:jh;4>îphK}VnF7qcXܧ>>XHTή]1#Nb ɢÔd,V^GI IdwW)ᱮ[-;kcE'v8$_k³"X Y&yHd>}x 9~jA}$z0OmP]8賅R? iL93%lIYaxuSY0ՁF1s @J,.=qMTa:S|QeAL0 ?gRd?G N>  |E/HqaM0uk@=i \SAjKٮ4I~;idMCzks&U`ܳFAj eFA.~g2&cQ'9p{+7-pO+c*z;nuҨs#clt"7: 7EgEͅ/osi+`$UFqM(5` } S.;4ej_3 kU وh6"DCSfOOMWODO7^;&rmKiU%g@y]\33, 6u}K (FFq1o!Ir<w3בi@oHQElQҞgjb{ȥXv֞~y)vEUf:➫waㅕ%@r#B9aa* NT|8|P#\4 %KcXZu  GCui4=/gqъ'{WrYիP8NT $O {W-٣N|ܥ& aeFs4CN GCŅq40 > kCéh辶 dV+hȬV>kvhCéhz,.7F8zy"YR w=ZB $zl/LOo2gAfK6N^>C^i>|=ءٱFyk8-5g},8 iJpҡ|}@ݍnP vՀIUx-,`\#^ ~_BIF> HNa_lp"ĝ$bN`/ _IB^ę Y^HXAb.fZ;4LwIJxì:&~ln 8Ȱѫ볼K\l@ F9P:!5hF^hC~FAX^ENfd5~6c0v1b ]c% ] gF.@nqW?97A=v;P0@! g%!L`W9; q_u:uK,hsDu(0#Brk\>YI!vuxwaW{\.Y>9NgsלS;8a{aiBZ,sylk{4!i=%u4cR1b7ψ_coU1btF9[8kc"}Q{h\|)wm!BpV켧YpS;fC2,H{ Kxma;漮t̯iDA]sXK~`Pu&[DW͏͏R&6?vу]6N9ǰr{|~[oT D6m B~g `"+.}[4/-~hٵ-׶6`s56KCN GCմ a{!9 KC;4ءy4t_^>״[_XpeC4֗6DYmT>PNTI?Oʸ7]y~Co|׬/X$Ng\8BeYl/ Aᣞ;!ݎL!o "q&;iۯ34yƁ#/ h|}s\`twG"(p.u=a|`^A$l/Auxb%AgR} l4/ EdM~25я'*^%;A=Vp;N7>Enz䆠Q/pc{Qw@K!n)Hu^ ɏGx,̔g.o b,s$U`ǻ(LÓ~ӽ ϼmؖؖtl+p}e+i?{;wwnn<4$mr4ei}u%=urZ5&\ڔX!*4a$5GO,,vi.rGcd wȚ(R?{J7;ŌNW7Ǟ]DRs*}E$FdHFyIu^DrʞDPDE{D~E30v;* qJ~Wi?Zfk JXǕ,œ+(d5CN GC} \ȷ(W;y>{.H vh85| >$ `Sgw_iHP {/(I,'X tb~\y $Ҁ.co4J㩕hSR]\Q,[)LϪQ93K9rmT\{l9z"Aе<`!b k N>aJtf%^AB%Y{?ޱh:2a15\,GEX+T4!m b 1DKgX,|3$c 1 oh JYZ,@*JY^q6O comyBGۜ;;~mKMY襦Z87uoGC?8P_Shk/Î5簋>069XĔê==kW28ܺEJ!í#uUEZX繟 ڳC)o|GH?Vj V .8J9f^hues:nՑ!$8i)!%JG 8 K2N2;tqdk<#\H7c(/ OB|N^F:^J:iH:Ӑ8t1R 77׶%Ȃ+*EW c 5r~hCˮehi62E7 nC tZвk=ZگML~X#$79~hCˮehi{N?k;^'J_.PTxߤ%dEx MeM\r^jzֱQUKQ&I+<5!EnkjP)1N9bSfb=\CS@MOMHKx7NRS|t} ,w:/m|=Q|EO廙G/meO$S7񔋴ܝ*ȳ4>r;X  ySbeq:5)yQlq5 iH,]Tei_*vÚBͼö/YϦV)/4I=b)責*x2}%5HdX(01#>1 :#׈G<4˲vԱd⃱n⃱eϓK&2G]F2I ?YM yq rdHT1B*72USUuSd$2%1񧦤[){J?ao v:&}ep޽~7&@@6,a߷eeѰrs(so%|RO+P2U)0ULUҩT$|,Ih۫&xm_r xw+1R 77}E"c$U,dj?ZfX/R'Qg)KCZv-GKaBr-QvzljZX.`sgвk=Z.cO0Vih@ ^Rs"-eWH\X +7 ]ƪkk딦5 %:iM0w7۶2V_cY+#`S Xiҙ@Wi]VScz2VA4Uӱ^gslnY7Z<㯽\]-ZG雏T_0ckי[hy;nh 6.Aזt]z.hKZKdh^o/I[{q 1=2g|R !+IY.ᎃ0U dX-2b~0YC8SRx,-ݿW|o-5O?cA>ZsGLۿx&@LW%L(TǍ9R)S0 mJqՁ sy 9bQ#&ŁH@HQ'm [+_J)e|<է-ϋs W{RLվ1F )ŭpzR=NxG yzaz1Z4KKxS l)bΥSo)\:]k/)Ea%f _A2[`e@6k]8VNKx#5xQ &#[xE,wa ii8]EA-HWpˀuxg]ɸ858yʺ OII585~F`i7<{8PW{aTtbq|;NA53OtΛ<%Ocn]2s`+\F5W74P2K#hZp|ü\rwj[MwwOI+Gwڜ hJgYVS)i]VmfnA|ZS^d;H#yE{7rlIrkuBz 5&)^%Tnīlv8FrŲ ._쌳\&i)<d_ݝV_}s\sɞ7񔋴YN?ifHngw6u%VЦ4v8N1x~[HyOH4f)}Yl*ye].4[_&iD[쮓xur6iͦu5> tmh>0NvKE'Ģwrmq[@̯l yx@Z0#}uJ o9ωG#7z*=:F/;NE<9AoqfYT_jnSm_y|]k9\s0923~A<ݥ3/(_qq|(_Eyfgܣv#[ #Ymρpʡ3_twon=p\;4t4/v"{ yMREO!^ePگ7AӀ.g?Ukbv/2ݔh6ֺ|WU~50 >cԉd'ЉRKT nKB5ZY>o)?5iϲ9U;sE>vjsm4?Stp1R 77}_SS:'̙u_jy ÍFa$˃v&u%wZ-bq|;Jo?IfF| <[q0sC7_K}t2-pywc_(qf a/Qxf[QnX1}k kSRfy[lm F%i6[d7biQ=&D))i]~ތ/uƗڲBtO ZoƗoRF5@YS)ג/λ/җf:vaB K =LDCk^h/̛xmexptM˹qP6 6h#x~\rw7sfrdk^}>{ǹ~NK(BNkk_폠yS.f;!|Oye].%d3h(e]\rwI #6󣁛$8PFl-aWS.f;?/)죰H[j3BIWǛ.NKhQX_&IE[l⣰&r6e0/Y9!\O ﰉsL .y.,)0,}n!' {O;^]wY|p؍L]%Ov1a ]uO@~@( uJsHHy0g:F/;>?>L wVr}=Q!O;ݫ1wcO4MOẃn+U.ö])Pqw@uw FG"Owȡjc,xU,/jwon=p\;4| J"{ Se# 6Bk=>Zd0k]PW;(:gqdYٟ|֥qastv[)@Mﷵ.d@&O T2yƂ`^r!wCS +D+J,xsTRR+_c(6y5k*YϞzѮ(,ޭ,ZKa$"~62,@R,| rviRNB@HB}-N-UJ)=#n|sb=Zn;ZpK1x8>n~M'5.Qlp cn7& f>!ppK1x8>n~_دdpK1x8>n~c+$zL}zinzy ÍFex~Y00@cWiX3 i9? o`/7eax7M.c6\c V 2l@1۹1AŞwN佺_yOH2ǶOb 1-$/ZE9}&IZ sSV7񔋴Y.c(N_2VrV%ceM纇Ŷ)ISMrw5c Ш8F19ߓP }\ -||9U4Kݎt0zYMS\S>U_f{ B= ޓWS.f;IFa}aKyQ ]DK(B )ia0 +o)iܝ~q+Ȕ8V+J}yH=0o))i]~2" c>W35n~?yl')Gh;-bq|;13Lcf?Tm|-bq|軌د9 {hW c? s$-G0 2}S~ֈrwc&DƁ 1"L(BmOPĐā-bDGV(M<"mدGsˎ44ٖ۽AxHK(bAkŴ*׵&&q/0Eјh4>%chr+ȁÍԔx_cM.cfl"/Os\01\贄w6]}Snϝr많\kλ 9-͘/W9zg!ƤlG/գAҘ/WH1Әļm4f)l}Y9kwAʺ ]H+h/$b@]+o%h;*|/B^ş,Wzm@jM.IWh;AX0:Y1:y1J<m*syjn\̺\bu]Λܝ~ҌSӗ9:.YW@YW iMLM_âmу)o%hkd?|Y{%!2ɳ^O]1/9g 1Ύ ύ=I7s΃rgC0x:eW _E~2knc Γ!PΈ^;C4 sCU[cCpWF:PEQve> IS_znr ?Rϖ:5jc132Z-pywZ'fi5` 5}a׌^BfFgJ)ЄZWz<^̛xI F>cGU}ATFF^jx́ _fDZU-<%%m/nlC=[8Bye].%d5dcGE\r|_̈ekn/{7{z#-!7fv]q/]OH3; H/E? j.*kR&ݭIeGv& ղxE3.}Y7؍r17Qn열c@a/f-asc6i쯁০V5SUVՏMÞFD j5NʼrwI=1$c?P{˜/aWS.f;*0 *[UaW,Y; -Z; ʛxU /4.v(t,!jxBZ|[]-^Ӗj.s5MMNc?i³߿w ~+n~Rnr ?Rϖ:5 8||~<[q2$cck$Q\s=Zɘ]36Ib~8ƹ5I[22ujد-8_%|S/NHZ&?=RDްR)i2C4VMZ gm|?2akO{)=p9-Z ÉJ5,^H=UN!!".AƳ) /E#^`qߧDO F:O }/ppaf&&WFvFfb}%Zbl'WoM_UO5m!hu;O#%Z9;9I+/ AGʎH}侭 i1oN;m}soq4ؕzc!R_<j rbB*Ťw>fˇ|>VEƞ s>c"2񖼻˵Dd~6-R,|G)G,U[I©Qik׏R~4&<2TҾ4zI )&\Yz>,Mo zSagbӸ\QR.b*|$[OZ)CP{O—"ޏpHRR4ʕze܁vиX%KH-٣KӮfQKӪΦa~hCˮehi;Bsqj:jn5MM{SiB4j⇖]vDb>W;߸af?-~hٵ-mWP+_{_\kk 8| /JtZv{_쳹1nduf'tI֮8V?rUF v#et$Q刅aF{^e2 )',!]+Z 6[ixYʙ;d*G,'MQj=U;:V7j8vm2}-՛kTQ "%/WyސS tINH4m'vՆ%d5X(@:[ ab.iur@ZJT/NTXh6KS{Q=ؕ^XtINI1+ؕ(HX(&Ttv%pMV'),!]U$P8lè\w1Mf(, ӹpiC]v2\6O2TAXE| e+$K+ni $ɴ4!+ H2-ALaMLKh<dZBB<%Y;MK$Ym%>Xj˂lcVOX(@:G B DgB%Y;MK$F|(beVħ X(@:w7Ϋ߭8$5iDd2-Ca\j@ڝ: .xEB}Fre CP%2y1bPXẪƝ5*-4"Հ1fϟWY[ Yl .42q^h;w /]?UaYOVdu>Gp3WwpOvO~^=^}9<ȽU܋o\)~ S*Tq7r4oߪJ!sRl,b@_?0e>$o?v!~Bs{/⷏NcO+}|:,eΓ*z6!~F'4Icc)C{$do|4~}&ZעzQF{xq(9EC>sxL njmTwVV~3ttW3޳tk%n[ܡX6,R:"|xK춐]xd\,C]|w%˶8qQ#|M1R 77}M%ӲݷEFm>mfвk=ZC[-٣)!۔;ٔ|u&QMZвk=Z.ì䃆J#dD$o2+AHa1NcoGO$Ґ.eVs[RFv 7ي($.~ۊdƬxWnʕv|r5%3=Ӈ꽭9b5Qd,*%&WO:F1h] O<$Gۺ<;-0~KWUm&׊r$ڊ=q᫧pwpO?=C%že"0|`z'^ 侺+ ilNsaыA~),! L(z*_8gb?*Ҍ˼93֙)g|[P  \漏M#}:,ye_Xj/Haͱ0hSn!-LWڧXو?hd#~u %;L8f±cOuk5[X/ViB:K;֥30Kg1c\ڪєncٖJ4'Jt Mnq4JW~HdWo; ݒF N?nZ2Y_u_ȁE{*O=bhq8|.}cJэ+sq/7]ה~@}2IquX鹣EWxǙiVRǙB:J"o)Kj}?i{.Ysm>0w'N;5fozZEM?y&sAlERӿRȚ?Zf;4{ׁE%G,*?Zfl;Pac(DLcl#/l7E;R5%^r(%dӗb.ՠ4g3A;iJ6":IMb}69]ƩDɯƓݩc|#{sᎷhSNKO*o!hܝoWܰߣ0š0 0t=s\4Lauqzq$;v`ʶd;I,bNǎߊW!c3SXHC$k#$qS>I[Y[)\b8qcn 3inr S8Ґ.ִ:Ti T}zپHEG$H8 zfCO1q0$"1%4s bA#74RɌRi6Rg҈N#@ZS#ҽvp9H yg½\Abo`Etڽ V={xr6ynSR*V׸pΡnᰇ'|w2øV`V֯xs`|U'mۭ[2j:RG%Ow78g}b㑼k90 (I۔w{jW9O|RG bqHe[ٿ>ҥGi?P w4xziypj,w)-?GBRx!;eWۄ)-qt=`9!?jԿn)Ǎ_?؅-S)#CZv-GK/w&ōS-⇖]vcfy\7Ðh-~hٵ-m?k(8_`|ӍSVxh"ZBn/f`r)bQ)%I Iy,W..夘}&בA.?;:esyzn̟-2˶?jsGXavXleL{kt_n|YdsvBZ{,y ‡1iorwbN4e8FSC%|2P͏d71/@j;+`jj+0=ijP)n*dMy-l[/aڜϛܿ~97G-v*8#A C9ĒU'=v"r/GTF-s>J.Ζ-UF#h蚎 tWyF&_7=ꗌ%9)}׻~^/Ļ$h~h$'\c>oN _nrwz]f'ŢTȚbtd,E~@^%4/dӎ*o)iܝ'r$]\B|yo8-HD M<"m!#4V\,Xyz5VWu3 jP+ݼtM8d *.$O8dH^ i CЩt \rw:df^,#]H#]FMM5_o g G6ҕx.GrL_V`f#[mx=%4zhKꯇP9z˙x[{wCOنX+]rМ<{=%y :$!x8w8d/I޴pos9E5&Cdྶr$cIp,c2bCF2l2~۪qN/qGPy, jsGWoi aQv=#sX")9:uEܱ:$ǂ7X1cSry:v??DžWb='O,QJ#tTWR=9rуe"~jTʡt8X8+W}RC͗V鐋))뫦 Ţ#H(BR|ΝI<@)4}9B" *1@==9LZ'ozSlxS|z}\@&7?=Um[huv޾$tַ42tAu;džg](CrAb wA]$`(rh'n :AcTϺKg{6K/)mRVܑHY%xg, /ox.%6!NJ%Nϒ"ܖuBuMmےk|BjBm9>(lg q`pX}ix ÍF~j-O?rQN)ZdX7<[qpPy9ãFzod=rcnЗb(b6Q_5•:I9-?!̜URI¾FєqeH[dVW߂uYj^9THIw,mWn4}}%)WTZșZ? N 眳*=TI ;?]A97/]A97/AFbtAfx -[XdigWVB. ρ~ `X,K @,х]$AFbtAfx ^sP&59kN- 1 3H<&/Vm?u{Xp,VmjuԤX&{KT7c뱘LM&-KӴ6h*:nse#RtM'㾦9E(-/l&Q+܌>pF9-EK)%__X)S.Zn_ _:׶P-4u󗭯s6'JԹ6$^f/͙] |Bض55`D[ -Q¶z_O--X4ClSUj eu8_X U>KO[ BA~VCg59{|S`#6=>"y˅wm <RsH}~)%GH)9pC#PJ<7;l[fCpvcy-`'6?~6TX]% # U w8&p!y9Na1苋cKS y/7)W@>s_b !dyʥBMU)jq11hNi߉麇Mi կ;@W*&ȀK@c3iy ؀6 ^dؔz=ݰ)1t`ն1JKum郹@Vw(7 bpcu"O -e ,~4JLJ?KU: NՖ_S8k.$ќL0 D-EFbtAfx -Z]nr꒕ 2so_ >o -K~Q ?bDW:'[2 2so_އwu{0qbtAfx g}. #(_/j]A97/b]cU bPHvu,i ۔%\R z7/lV0BRxj/D[%:f3t" yz6:`sp)FVJ0UT%on_cUrJ㨟:Q$t/=xɵNV%m W ׻ ~v,U9pW PK8:/hU6Q>@~kIv6Sk̎Z$c8MyFikkwY06e_HxJ7̡\yHsmSgƩ)XG*2L=%]-m93a"}օ ^X6ǖ/+ݜ^ LqlNᢩz@a.IO@_缀W( ˠ/6PҖpKxލ ٴyiDzSd.y^9ڟ<DN` *#^w#Bx0 Reͳ0ӗ%/˔ W_"$mn_O}Up_a򺯏53LUy]|׻~a5v ve?XC ypɫjj,kвbH^> P6IO }缀W( 3076ҖpKxM !Ck]^@Ef:c_ HYd#p#xqÉ)~o~6Bם)t.>Pw UYp*h s ϣsɴ%Pq.%?ysP@ؗ* ϊ}AY/6~=]_* Nו>pj>/f%#]4[fC׶^badtam  #YG|fais2{k1G%VRTN~ۆ<-K> "$Vpkee9uYaM4)<׃`h3lY27A=㢠XDzY(YA6acz)SAO/.dc 2so_aQH-E}^{W[l|^ bZ!2DZ:Ŷ*~[O[U/T&yBe|V[]>yBq++hT.tˑ)00y,@:Giqi0miA$>&xd!ѣ\OB|wY|pgi@of&g"B7/| ʟJĿ!e1#-=nWl]um7Zm7n>Lٮl;C GhW.=W;HAv]5uU|,"_h py CBRN`:5ԩ^꼱gtÉ<B ןu'| #M7Te^m_Mw¯b z wk9<_T.AêG{ wܗ'E}~C }乣<ǘ҆b?n[2B}Rp-&On7ǵjl: 9 bЬCp(_[$dM[E/z/c Bz}WE8B0B"![}i.z ׻ ~"0 -CP!m$\&B긔ԉ3TUµm-Sл ~@JWl{ߦ*b7ee fᢩzCثĘ n?|Bd*Bdnw/Ef_@fB&C'L&&&` )0y  ]{OR]Y_~-tnsµaqi0mid~(]nkگMUx thW!|3_qrHKt.J!/l|YpzCiڡ/x8RV|9**7G}>@߆_^e]Mn͇y7ͦ31MBِF”kϳ4E!;DEn_h    )GR0!q|5<4%̈oh䲳A/; qml8)t.tCU&|4bc¥: (4<@q#~{p;F kXZbs q-3GKy?n[yM/4j_бM@[)B2 OkS^n_h(}) ++lbY"\l&J}S_ -as*7z/XvH4 eQ9J[s*7՜KΛ)-s:nA s%;ܩjS>Ycys+xs>C%^Σݗ\W-Tf+1ٕMҺߞIH[­- NBu=tG]}L/ s:M/]vé?OȝS[T=V!m\,sʘetor~mX|:DJfS%_˒3/}M~5M0<\A|>O)Z]1w~91\AsC.Y=W@}țޑѸ|Mr`G.s>[3vg NJ$6%ajЧ)ᅯGNSO9DX>k7O7.瑮fyGHys=m 2WXk'NԼ>Yݸou`{1jK\JD={yNR1N?hLPT^ ݌c}?|`<[/NξiYWU?iO)~*?"|\G㏯O_g+/}ګkI쪰^Oo۳7[h)#UʫRyRVYR iua7#]*4Po9j)O,c5i7#t+-"V~7fx3uRmVBo{H.w#dzP{ҒZ6*9?FvfISx2'bnJkg`9ِN7e̱p[Ja:'#KX6){Pn̼K>*{ga^df_̜;܄1ZYKNeE&`y5 tK pu(3R&]x@8pPD'Bl j;d =m[X*^N_ xZ` /Ʒ8) ]{="L⯏+'.| LTuqOttpޭW.^^oyKWW}r2KNo{7ߜO}N^JN=}wzӷ?+mapq9x?d7)?A y;mC*#'gX{kMTL>!=;"s=2Q؅Y8Zs؍9*幣\TjҲUA/b L(o"ɐԹ2pż֣ `ߞ0}s3s嬐h䥀(=J},JK9fzN B?))BJ&RP6r\yy_n/uc;F]`KaLAv>v"XV]OSq1#|>:xzܗI2XN}*b0Ǡ*6hU“\IHNRHKy6k\F7iWB. ρO.i=t,$k52UGƄ˔S5v#cX(lȈpIpIѲ O|;Sa>UIgO~PFtk֙YGzh^TLcˣT΄,EU.~TG֞EUsAIt|Z}IoaڥC=Nj~κS>b(}/\IhO^M5XWo~(_ۯ''ktme*J#wuM)~zu*n &ʑOޟ~wOe/oϟ^-#ٗ339m3ʾg %<,)?CA8@TƳN(/Tv³6C/~}vm `"ִһm(]܌)G`mF%ߓ5`ϔ7?ټvY-E0*:2Wݏ R0;OB{Y}:'1 % 7ezKf}LP&vW ~\ |5Za}G@Fʩ2JH/d0 P2 ѫ/50oܨo^'L8K(k#|^?.KIL>JG;>bpto44k)e'~MÄ38Bɤ' ױ0qfwJ36kd, .%3\#pUF&qA >f7cdR"ػ \ gp mz!, .%395Kh4[:67o0mC(֯n6,aV58mry]o, .%3Oَݳ=]֕lMG7gcOG7g>!0gÚLVhnD>sxVn.EllLz{]_|ɍm.h/޿S:뇟>݇o^th>O^?;;vSi{v5+o9W:1n*^|{G9ĨT^0.HĿ?]sZfs9zgU//,]k@{[ݟ7U 5uVi/_4 =ixKQ1{su^lt|yqhI4_Зendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS257 14 0 R /GS258 15 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.302 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /ca 0.302 >> endobj 15 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 16 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000038568 00000 n 0000038651 00000 n 0000038826 00000 n 0000038859 00000 n 0000000212 00000 n 0000000292 00000 n 0000041554 00000 n 0000041811 00000 n 0000041908 00000 n 0000041986 00000 n 0000042035 00000 n 0000042084 00000 n 0000042133 00000 n trailer << /Size 16 /Info 1 0 R /Root 2 0 R >> startxref 42182 %%EOF robustbase/vignettes/robustbase.bib0000644000176200001440000001361012737467727017311 0ustar liggesusers@PREAMBLE{ " " # "\providecommand{\noop}[1]{} " # " \ifx\undefined\SfSbibINI\else\SfSbibINI\fi" } @PREAMBLE{ " " # "\providecommand{\noop}[1]{} " # " \ifx\undefined\SfSbibINI\else\SfSbibINI\fi" } @Manual{robustbase-pkg, title = {robustbase: Basic Robust Statistics}, author = {Martin Maechler and Valentin Todorov and Andreas Ruckstuhl and Matias Salibian-Barrera and Manuel Koller and Eduardo L. T. Conceicao}, year = 2016, note = {R package version 0.92-6}, url = {http://CRAN.R-project.org/package=robustbase}, url = {http://robustbase.r-forge.r-project.org/}, } @article{RouPvD99, author = {Peter J. Rousseeuw and Katrien van~Driessen}, title = {A Fast Algorithm for the Minimum Covariance Determinant Estimator}, year = 1999, journal = {Technometrics}, volume = 41, pages = {212--223}, number = 3, month = aug, issn = {0040-1706}, numpages = 12, url = {http://dx.doi.org/10.2307/1270566}, doi = {10.2307/1270566}, publisher = {American Society for Quality Control and American Statistical Association}, address = {Alexandria, Va, USA}, keywords = {breakdown value, multivariate location and scatter, outlier detection, regression, robust estimation}, } @article{PisGvAW02, author = {Pison, G. and Van Aelst, S. and Willems, G.}, year = 2002, title = {Small sample corrections for LTS and MCD}, journal = {Metrika}, volume = 55, pages = {111--123}, number = {1-2}, doi = {10.1007/s001840200191}, issn = {0026-1335}, url = {http://dx.doi.org/10.1007/s001840200191}, publisher = {Springer-Verlag Berlin Heidelberg}, keywords = {Key words: Robustness; Least Trimmed Squares estimator; Minimum Covariance Determinant estimator; Bias}, language = {English} } %% ------ was ./lmrob_simulation.bib ------------------------ %% ~~~~~~~~~~~~~~~~~~~~ @Article{berrendero2007maximum, title = {{On the maximum bias functions of MM-estimates and constrained M-estimates of regression}}, author = {Berrendero, J.R. and Mendes, B.V.M. and Tyler, D.E.}, journal = {Annals of statistics}, volume = 35, number = 1, pages = 13, year = 2007, publisher = {IMS INSTITUTE OF MATHEMATICAL STATISTICS} } @TechReport{croux03, author = {Croux, C. and Dhaene, G. and Hoorelbeke, D.}, title = {Robust standard errors for robust estimators}, institution = {Dept. of Applied Economics, K.U. Leuven}, year = 2003 } @Article{fernandez1998bayesian, title = {On Bayesian Modeling of Fat Tails and Skewness}, author = {Fern{\'a}ndez, C. and Steel, M.F.J.}, journal = {Journal of the American Statistical Association}, volume = 93, number = 441, pages = {359--371}, year = 1998, publisher = {American Statistical Association} } @article{HubP64, author = {Peter J. Huber}, title = "Robust estimation of a location parameter", year = 1964, journal = {Ann. Math. Statist.}, volume = 35, pages = {73--101}, } @Book{hubpr09, author = {Peter J. Huber and Elvezio M. Ronchetti}, title = {Robust Statistics, Second Edition}, publisher = {Wiley and Sons Inc.}, address = {NY}, year = 2009 } @Article{ks2011, title = "Sharpening Wald-type inference in robust regression for small samples", journal = "Computational Statistics \& Data Analysis", volume = 55, number = 8, pages = "2504--2515", year = 2011, issn = "0167-9473", doi = "DOI: 10.1016/j.csda.2011.02.014", url = "http://www.sciencedirect.com/science/article/pii/S0167947311000739", author = "Manuel Koller and Werner A. Stahel", keywords = "MM-estimator", keywords1 = "Robust regression", keywords2 = "Robust inference" } @Misc{ks2014, author = "Manuel Koller and Werner A. Stahel", year = 2014, title = {Nonsingular subsampling for regression {S}~estimators with categorical predictors}, journal = {under review (2012 version from arXiv)}, keywords = "MM-estimator", keywords1 = "Robust regression", } @Comment url = {http://arxiv.org/abs/1208.5595}, @Misc{kolm2012, author = {Manuel Koller}, year = 2012, title = {Nonsingular subsampling for S-estimators with categorical predictors}, url = {http://arxiv.org/abs/1208.5595}, keywords = "MM-estimator", keywords1 = "Robust regression", } @Article{maronna2009correcting, title = {Correcting {MM} estimates for "fat" data sets}, volume = 54, number = 12, issn = "0167-9473", risfield_0_m3 = "doi: DOI: 10.1016/j.csda.2009.09.015", url = "http://www.sciencedirect.com/science/article/B6V8V-4X6VMB1-5/2/3a9a08575ea5e5e69ad06d720c627ec9" , author = "Ricardo A. Maronna and Victor J. Yohai", journal = "Computational Statistics \& Data Analysis", pages = "3168--3173", year = 2010 } @Book{MarRMY06, author = {Ricardo A. Maronna and R. Douglas Martin and Victor J. Yohai}, title = {Robust Statistics, Theory and Methods}, year = 2006, publisher = {John Wiley \& Sons, Ltd}, pages = 408, ISBN = {0-470-01092-4}, series = {Wiley Series in Probility and Statistics}, } @Book{hamfrrs86, author = {Frank Hampel and Elvezio Ronchetti and Peter Rousseeuw and Werner Stahel}, title = {Robust Statistics: The Approach Based on Influence Functions}, year = 1986, address = {N.Y.}, publisher = {Wiley} } @Manual{R-Lang, title = {R: A Language and Environment for Statistical Computing}, author = {{R Core Team}}, organization = {R Foundation for Statistical Computing}, address = {Vienna, Austria}, year = {2016}, url = {https://www.R-project.org/}, } @Article{RenOVicM2010, author = {Olivier Renaud and Maria-Pia Victoria-Feser}, title = {A robust coefficient of determination for regression}, journal = {Journal of Statistical Planning and Inference}, year = 2010, volume = 140, pages = {1852--1862}, annote = {robust $R^2$} } robustbase/vignettes/plot-fig-Mscale-all.pdf0000644000176200001440000004470713465050116020634 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180741) /ModDate (D:20190509180741) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 14618 /Filter /FlateDecode >> stream x}Q6rh)A6`›I0in/bQk>bQHV)=)=??yY쟵d_w?=ӏ?JG7?~Z}yZߟ?%uWxJ\SZQ*^ U)k Xрs}Oi-k!~=zRT0󞢂⨰?oAaM G~=0mRPe BｩQAqPu0<+ǬO.j~9*( 9: tnPP<+cVhssiQAqTh'=4+w؞dA67s.2<+mVVerxVO Жó¾ t˵\`xVYa-g1VЖY.NOV;?Y~R>xG GEV~kCn0!7i7N Q#) &-w>1B>}>}>Sta8 ӈ8*EM [6x:mk~>vtVXkw C*^i>þA;aR?DԦz/e/}TQm0vیiA+/s /zrdF~>E<\` UUŅ]&(_}T|BYX?zkd]c"pUQyVf54Bkc9̓ճr{?2$qX}~ʜ2"'wjLjW}PdeԶiJ-2mE ߐ^(}+LM$k妺^|* `56OLW *b 4Rk#Py2Xm{`@h]@mTk{? M~d.: MTdk+VUg}FrLehUV')GzPd,4RUAWZC)`xި{([Cn4gu (ƈ|>ScPX] 2-QZO[wy&[9)uw)믃i9́PW]C۶%x0/ma  f.k!WA+J#vza|ҨW`SvvsaT0d5lyG{{:myGM8*첈 ;Ж O Gb OG}"㐷u!o5"c(y'F4Ái 8~V09FCǁi`]xh7UQ"_A+ sv?<=Q&gGttU+/қYn0r3/ZܮObY$ Lvp ẹ :CP^o,fHorþa`S%q3YA˜7GZ=Șu0OF8lytxyg0G&ט0s o,#'pe/<*5'TK_GM95Go,V5MrӪAQXX;̣Yyr}oC[ ]B2#!nL:WyPw ]"sDy?6@h}h kL*6&2'1m T% 2oL v=x&k~3 ~ON m~A )`guo]e["FCI dl0p_['K̞=(/ȴ(wγѢ̰y.#AF#ȀWUPF9c+HiLfu2~ i\,My%yhQPerB#>!ڠ\-n`:e'`g 5WXj56RQ. @\}BjAP;<];.r(H7{X)Keew& E=({gu2~w|0ɹ"?2hhdZk+ cYe{+ÕK1ebqR%Um;ڈdz߃VHX7 2UFӿIա@@ڻNm+ `u˦V{25+ ࢭ2Y)dV_ws }`*6BHΫfEEMV8 Yy`Kj"Q-yfvq|Gn[ QjUbj36L0;) UEKj~Vuuګz4Xy֍x>9;9/y5yFV(/C!]!^$rM[-c,ze9)xZ0iMcv2X.`B_ә'zɱ+-ped;?).C8'V##.glhX(@{چ-CْܜZEWXhаXyn0f—W線D"N{h 6[  k!HON04ne7y7Gt%[qn8~NQZD)=Cf?{@dc-0Y7ȱ>'`&@יy,I>v8Etk®̚[89Aף,WIǦ-'SB8e{dSRct t HI55zP˪c4{a9 &d8CpŎ{/% QC%hwx;ޯhU.6dτt<:{qEfvm/]# }KK9Oc/͆Ub%1.K/ǒAP}BR;X"B6qnwcrs.pL0e|^氜on0W|_Y5ێ>@< >͒/j23 ش|=чwrOz|]" , TrSO~+bH7/Iy(8/ z(;e-6|CzlE eM:(LE>b[)!ۚe٬g)hPl+)z_5_FϊqdDVrn2̌Gn咇|ӹmƕjQ~ڮ,tߐ^(}_C1U[l뱝۪re2 .m]sl+H5|EN`͈ƕ&ñO5CGm!O6E)^2ׯa[i÷Y/+;jeXH >b[),ڎmwfeK7䬗}_9+8,Y˸.B+qgHoԋrs,f cœD`dثnېio}S/+[3_94]UMqmmEY1ʦ;5=0߱1ΐ^(}q7F]FzA{KLD:~$=bw<mJX߽) ,ĥHTxȖ =q{ ;NTFʜo1ϡ9}}>=MɽzD݂R[7w`StFv0 vuDǠ흓w`stfm_]ch*UGu#AO Rוԁ8H2FV؟ӮacV󰹎 %{Iv~E7 Pu|mW{Ц$9M⻬c5>6uyUsLtJtJ55<թki>:u $;u OvvoB ;Hww5$Q&+d|4q@Sܧ䧮OF=f:O]ӟvh' $@u O46km@ TAcf#ǩmbCT@T4AczGԠ,pC*5xU\:Tt*!CRc$Dt/WSOg0<'k'&ߓIQ]YQ]ós^1|E 4UC?Wu KUxUU]cQyf'ت8a]m$ϩSu2|WeF85[ԙkۺ‘" Ö~xUe^a'aseI9;Zy;)l.t|Wz%UŦe29OϒK}Z73ef(0eAF+"KUe<9b<Ue6S<>]fC^Uc#r2 V6@ktRe^23_Y"+[= Ź.LBX[*z:>Or[[XHmǶ"*fKFۊb[)GP6sW}\85@ktfs'Z+;yU*P]nbX[rJ6ۺ/rn뾌֡|S[Ŷlö*By nYOūi}U坶; М \˕K@?W6M{Ehx!}CzY٩޷xUyXfY-Z} ŶRnmamAmŧh;8dY8d}W{e5sjӹF5% FJm]5^=+}Szl-^U~enPG[hVʭ-, =lWbL)l/9NK`Rl-^U5r2 9 >͏[:jJh/[+ذ&wGmū!}sY/9dVʭ-, c[{ol(k6mg?Cߐ^(umԸ:XO+ z$2eבxU͈'p`=S7;sw>UeC-}'q)׾KSɕ6XOz8Y뉔yՄ((a C"~WY Xϔ*ǨyU[`n_ΘKXOzJO8zz0cx0#x(;5kI?xW@u  ^UolVd BxUKUɃu|WlmUS>xY9Pom8P7xU f{oO7xUl&_4m"mUehW=+9R~L 9SB>RR&rmtry I^)O;y$FW,EN!'J!7*{L\W^њr{|{^)|-tXb$|h'}d||EG1y4G[f}wG+F7 b(Co0ra07 g(?|G(P2{  t0oМi)$B$\7n05!' :(/@=`7R5ۂNS&l/ &W'mAʀ7XM#𦍡Pha9")hйF9SHxl<qf/o068h9FA1`1%1 |4b"}Ix]Cbf0no1+>#:.lZ&•tQjDD9mwڅq6(̪QjAP[deª~JNK:+k 4Rm KrY԰ 4RVos]ov 9G} 4:Jc9)SfK-{LVb=i%dsx.UZCE:5RkXN]XNO{Ӫ 즸P4,5jr kqAwsmE&Qh$YyAO\U"V2 B]oq5.b HGEAj @9ihorV=u}B-Js]7OA |>" JOF+|WMz Fb$6L')Q.$8ҺAun#WyB 738< X'BopHpFœ۰\ۮ$ n]4i }3Gz՝4Z K`$.$ NRw`j`M%h0X_u8| QwgR 7d. ALk/#AʉJ&@{@׭ط[Gxm2XdoWnG8t7=3K J7xVN)::_`+HA2M}%Nkl"AkxڠYc? j]LPK6h묱w!Ժ' :kl'`]іYcڠqz5k?-cZl$Rc$t/WԺ' j}t>f-vǬ j] j]1|$ r8 ,pcӠ?0{)z{p԰oX QiÇ&VBCfhC5[ ta὏r 2 ßs\9OnA>Lnl?' ?O>K/eAfg1>v9Ekef3Կ !iR'O% z%◁7v# T!ix O+#jn(.6{ff'?z/SRЇ31ǻخ|ƥ+z:BsKNZe6\reVO+Jyjx*PBX{(7qc[&[?IS>b[),=y42k]-!GP6v{Sz=1~E7ŊA3c$,2/Ce6ՏA 4 9ꅲ5Xނh|(u}hʽu[VįTn{!GP6"-Q,^Oe4S RH3 >\/ MWlz٪mE ߐ^(}yE$Wtlm²@;A`nqۆb[)GP6bYyB>~>Nys``^uIvuۆL|Szl~EWv=/w4`[!,H+M3mwߐ^(}q-DXaI(9KKQ:O[^|;e.J:m{BX0l"&?9p3j(rk e~%;e5^x}CzlGQZvE=,$ɐ['QwI"z(|s'DIJ&39޻LI23 ֡KF0(M n a^?k#d8>,fxA5xq02Ybak+VysN!g"݃!'B S/]>!_-7Ц}~$;#)WlVy'O73>>䵬読̓WW>e1\) iSI|\%KmuP{ؑuzx;ؼ|۟> +bsY9/ikr+tZY]&]Z1W j'^xHPK &HPK &HPHP5kԺԺ'u $u OPK &HPHP5$Q&+$u $u OPHP5 j j]x搠6h^&HP4qHdB j]in\zun Ժ' NHP6hm֨۬ jƺ+G5SMD jA#2v!A-yUO Wu A^Ak >@TBHPK &HP^(&7`xZOL'ԺԺ'cx1 jq#piz pAk,A-׼ZUvK86ϩ)j)zWDW2 m!PW ܕ8Nw w} <|Sw}$'y:j} +:'J)vSy:|>P ^5ه~Mύ2iph!aY% h髤>\56 ^Ulbn>tn|3|Y j ('=P@5\'^h]k^v^VC&veZ 9ꅲ޷xU4񪚾9dgYC[[XHmǶXaMCOۊb[)Gr` ^JҸ4m&F+eve g ,.mCktՋecoRC[#m5*n5umݗCփaVȽr-^US.k;>$1qr!FM+0jm \QSūʬZc[m5JeW>U>48jnJ9Ub[ioplߧV=4s@xBW2,m'?!Bߐ^(}WdVY1J-֖` .=Hۊb[)GP6*ompȼtߧV@ktjiP֐\V}Gv1}Sl-^UVG۪U?Gm 9ڊ@OսRFn{- 9ꅲ_&đi2+wI5鸽f=nv9 XO/uF_U5!m`8z,'_h&XOͺ8*gIF]azOzW1X|}Όp {NWJѱ̫J`=uRK ܃K[YߕD]yU5l8PM= ^]͊dI|WyNNOlu|WdIGO𪚦xܷGw!Tip_?zS-By M~響/翾}kV~N>_wv|yȞaR?S~y"{[SΗEңv-^y5Z}[ͽVXGNFO>Zګ C{k&C/ r,蘞7F/ g?@hݹ"jOYH\&vyA4.g3_fgۅ.>QxhZϬESʖxu]/-F873{[H3SnjO cF~ccW5C74A?pIb?pIؑy~ptӁ!4CjLԘ"0в(}&̇O/߅%i✩۰8U}('&}.7()v1a $$ _Ac(|Ue7 $ ow o|_n^]_(x\znwrkpX*˖p###L1GC{/|_{r&s}AL>2}A<_-?h˱أ-۶|і`>}G;هK>h |mڷ_']>\K*Ǻj=M>Pgz|79+<̟+&GL:)>ϤILt|R|RIi?/AA3)?.yaHo5k_wz2 ӱJ/r !oߤɩ*]qb}:n7e PBXo9vsӑL6`g\zoiq(~vrU~J+ Vi݆WWQ#$Bq#ҵ*=L:IYXܢV|O~#J*#ě[R~T>.W~#Kj:niu=ˁ[>|"Y6._";zק_=s5h9y7Dv/-ʜXF{sL{hƵHX"D$,5 W#6,~K~X6ދjX.VO}3ty=oݎg_Z]x+\hƯ/ke9qtT:˭¬ :jr?ߧ4Wendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 11 0 R /GS2 12 0 R /GS257 13 0 R /GS258 14 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /ExtGState /CA 0.400 >> endobj 12 0 obj << /Type /ExtGState /CA 1.000 >> endobj 13 0 obj << /Type /ExtGState /ca 0.400 >> endobj 14 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 15 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000014983 00000 n 0000015066 00000 n 0000015230 00000 n 0000015263 00000 n 0000000212 00000 n 0000000292 00000 n 0000017958 00000 n 0000018215 00000 n 0000018312 00000 n 0000018361 00000 n 0000018410 00000 n 0000018459 00000 n trailer << /Size 15 /Info 1 0 R /Root 2 0 R >> startxref 18508 %%EOF robustbase/vignettes/plot-fig-emp-level.pdf0000644000176200001440000004242213465050117020541 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180743) /ModDate (D:20190509180743) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 13304 /Filter /FlateDecode >> stream x}K-q.*^(Gx!ʲGX3\(FMF_od%FuYwq, _ Gnmx3Y˥?ۿ~~uO>nO?o;)oi[o?mtuOI}_|[Ҵ< - )cT|M4 -Ox)ϟCem HS  4PPay`p>œ!T08VcCE=T08VʮRvLMj9k:? PIVpQ:U%0j4z-MTjWapha}Shnqx(c 5ƾSX*,sٞlVKifpQZZC co ޵|٢sc[mq;M!i6ph(&l~OlR5|~/Q}rOR_>;8`~ρJy?Pv:aqm =}Tߞ)x~BJڶyq)@Ӣϕ`k<5qH*S}b7xKO9|&8!- /Pi}dT:}=K)@_A?b=ce= <>͡} tNSO %-4NM,[Mu鮤?;\ג1)l G8#{y<=}MΞsap15{8l[yRU{|$$jH)Kð2 |}02~m>~HP0@v(*_ߴjgm]J`P;"\璪M=By|e ;4<.i<秲4\Ol\@;QW׬DUzDvO VrӅO첔vJ횕Ynr7 ]d u7yL{F_ ,V;щ}͍Nj4Bx~,{89Lq08rfٍ6}Vq8Azr8pHuCҎYOjʭ,FMuDei"~ILYZ9Y?'Y6Ӹ='5i'y_Y.{`QOuC"_A]2kGuA_؇}Z/r8}aJji 6C0{ӳZM+`4.jyX_8JzԩL^עQOE&{SW0R_d]l'5${wI=˗F]@] _YQ2-1-읕)g9l AnA.^%AYN]@}ԍzOq*݆;zԓzsя{ը{Ы+Ec: rTî"bH9 첤Cߌ7NL v΁`e#HC4lC8}]D[Z:g CJZcid^6m}4ϭ> "@s5hNWٔfT_ei4^s5:3"{dRթ 2W÷Y#8a9$e 1oL2Hs;EF`=f*N039ݐ Ⱥ0 [(2_zqIܤChLGd { 3PД3~I;{5Vęa.{:)Fhl. Gu n}9 ~qAI&c"Y< CwPe YOI):峘4'~[ +zrx$j"1퀰 Yݟt}4inMxMc@V=MdSVW}n[D?w9:4>0(';EXw4ޡ^pm\VF+#E[1vPLwf[ep F pPdB1 %pPΩUP8T;HXaMnNOiLl܉ъ؊݅*Ѓ*Ё*3)ԭFX,+aDbFqDlcyeݥpc<.Z1ցTZDS1T"*1T.*6teDW]q;6<<w]w3ѣգdtџ6Miz|@m0%~.#O5ig4Ÿ,H=7-aXff(.y"rI͜6~;W4Iu."{^e=DT}CPsǘ4qp036s2 y_'},Y֫}?y|9ugy`N.fdoi`Ncf~/g䲨Fr]-"9(F!3e;cbPw)n [|5vo}t:7͖Ent R yf h񭧗hO,k)s#GQ6%g}Vi %s#2-֜}v흶f](#lhBoַM*7$7l,/ѯ hraqe2~A55Z`h_X_XeH5< k0 k/^ `'a fak 04Óg5I{ c*! PcLY|7 p,<0D0u 2hA*- G rh\0ޏ~d038ߤoFaplbjklE{ cdi}`pqŚCC^2էN41[_^U4۔c[y^? wcmJM|8ǣ}zm5ߥT 9-;skgF&n<Gp(TQjOknXRl+ɖo)N.yl'+y[<wӱk8V<?7XC>E.n?7.zxr:vS,V,hZ>᮱ex.p|M_sb;km8ycMQ/᮱KW0+ֿ3_]⬖iv0~z V, 9tr^Bz90i2H_g6w9Cҿv~a{ziz]ɶq&txilhy`?<(Ɵ@蕘W 3_I<ĩGy < n<^eJc8r9yxH|ȃpuXkZPZ{6v??mzW;ቦPYǶV60"waR*w~vYmr(wpR?ueB\@&dцk;W6(r50tQ(^dQkfq Zfe*됣 "n2lnۍةuKjUCi>I,wP>V(ry8"wN1,{]@ۖ1}9:0tdwcX̶Yr{? rH (w52[fDwUiOwVN w'wߚu5G$082?_ !LX^F^'Y WMvb2r(wߚC'ɮ w)OS^.a>=-qmKm?L,7IrF]u_uEk7Q36 }or]QIN]לs 96uKMdàB;]Qm)jM~n1(-MWvu[r90yؾ ݹ|5婇b#mڨCۯZA9p yb2yqב;;לUHVd'lWy/nHNbfB*Ϻ MJ4'H踣Ҝ Q58L'v.? O8A^.t|b2ڙۙQ\sf]kp8D3Ɛ}M<(/Ms#<R/N{yQ w2ڙ?71(rӅ?YLziϾ$oC%jN]kNG C1I7g#8D G'I7m 6a=a-\rw9 Y:]`93tE9t.Fލb3~|?$-qV&+\4X.{`1P\hT] \d]A6Iw/vq7-x.0j 9<3[cWhr AB8\؎qnq[A FG6r08rcpL,itӉN@[WM/EJ6;pZÛXtP(ȡAIhj; aƤ :jx:;g6).#pPϽGkCڎ/c?tiR;;}6ZǬVZ VZ,qi>r8*[?ؾC߾[OCaO2Gh5{B?4nAh%8<+S\| |$5.6NXC$Er"Cy'7Vx»FYFpVk]b^8s_@+sI4-Ӕ-[IdNir7^wMt?MzdGbk&m{td|M9`mspއ_y{CG3Gs_;,d˹Zr.kǹo8ԏ](+j<_9Nќ6 C|V_ SY' WE|VZ"<9M}o~؞B{Zx.>n!u }SfiIS@p14ki'ђ94>e8bϞvwӓk׳y$Bv0|;{Ͼ=w~[ $#d}/ C~7YO=bv;o~!i8a>%7~Hv;?;~KKFoa`!_]kAn aoJ>"ycRR-}9ʙ-9 -9iQe0g 0gk $ђ{ d1Ŝ5Ɯ5Zs1<@|x/T`>T@PaPQZg^.s(dЩ%3G9e3G983A>sg }xBs:d4|o7Fc=Tz*0* 2_{|ٹG#.۲;ۋ&? ߝ>ߘ#3CI|}"A}> $m_'gsPg @p@29w"P?$WF e BWY reI'nW ,5rpqnܰCe}H<&xrYe*pshl$z'D&DeUre`_[ʥ? 7PVΦFFM˳K[%. ٥QJnC hNbrXy9 OI&+ߙ?@TX =ttxJ$bQ}bny?Hyc ^T qJp)q- :d؍oQ[j]ZCeĀԃx4#Ic@Rf iHBL:;d2;bĀKU-H+]>#cI 0J-1,i ! ~ϴ|PLyų$2Ă'KM<Y/ENϯ@3!m?2BҦ#Hv. O'[tF9NKfI9?I<E]Y>z2\`M+16(rJj;/~;]+yh~)L|d9@J{, NW+\R~f+ide~T} O+4e#dO6Ǣ>^ގ@Oy<,pGڞyrMধ=XqS1 RUx(ՠ$fL7 Y:!uߜ^ Ѷi=\.;Yw n O{RytB5e}?zDQ)y2-9p yuwgy[92ܝܗT:eX͎,O%ټb /Y\ꩄJ!EY/'h:,YMcd:0<ڮtw<۷jՁ'J!EY/$hY@S)'b(Ȳ5sIӱxð O{kp>@s3qMOFyͺBs!pܗ6يd+(AO3pl€gy@Հ!KMY/9ml+[!H[!&JM|<xj[&:]=YIeJMTzbAu .Xj/uЛ"z"-!cK+SzˍKrH puwV'uNrH7K8[2=4E:&;>Rvg?p,{rt+{'Lgoԑԑ`gv-}$KMpX/6>uj!r(w3e08kn7Cl@]ܑIOd5vNq)s9cs'Y8|mqr6=߀Y89I}Լ .{ѯn`fEc`pܑcۑǽ%oi 79}t螳QW0P͌z]|Dxp̦KMrBb6k!x$ioF_&'A'Ǚ47/xxjxtxZjxtMSg+hH\Eq F/lܬ`Afa$xÛӂ7W{xPW]A +9xʑ +Oy݈_58E8|ycC62R$xsc[G n+ Ap,]8෰))hVPqEt9A< Mc*S=pW${ ߚߝ{a6~echf -{R׀t;ق]9/YkV^>̞<9Z͊3Zs^g6 &vxe M^թ99M\nLjwK 7L`JU޼rʰ?''ؓ?W~2n+'QP>ڽo<Ͽ}Ory<v?~O{Q-YJq }EX6ٿH/O>|l/[{Aα#?~N^w75[H5V}'iR@^:ɋ rr FS]w5j<^Á*<ʅm١^TU"؍k"ԍGcN<)>=ч}KOtay<,=сgr"K+>2me77[FXrm#)U:_ք]C.r$r˫{}%|Y:\"rLq<'bt F P6 lu]Vn`+S0wg n9q8LcXRu:xob@;u_wllyZ;jiRwalh(wZ+o޵='Xv9 >28E>iI?տM_Λ X:}E2߾}=׭8ܾ_oN>YWv6V6z򾋫q~Lz^f}#Vh_jS=]پO j̶V[y#ծzv]iT\p<;W'!/8&4\?yA%_L"ߝF=q9c|p8G[8;1xjK~X K񑨯X󢆾,W'6VӯFqj46.Os>$pd˝9c'$NJr`DMWs9mQ>1+4~et~x:hgtW٧“psm7Zk;. ~8텶.0~e7L`p~xu}=g{@=  ։mi$`u0q'i&A;y0;np0=w Ji{}?v{iʞDb m˭kю`)Nڤn 吴{azz}xdE&Pam(&P,&. L6M 8X8p0=w q 5 ^^#EuKoIɲNjQ[#ߘGo S^zߌֶ;4 6(74 lMY;OTþtl[T& [ {Izj|E.!|[L#5A'.읕GɌw~ٲ7|ԒgiW(fu5PR&80+¸,獺mN+?>hïͷF|<~VƓZ 1W}3endstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS257 14 0 R /GS258 15 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.400 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /ca 0.400 >> endobj 15 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 16 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000013669 00000 n 0000013752 00000 n 0000013927 00000 n 0000013960 00000 n 0000000212 00000 n 0000000292 00000 n 0000016655 00000 n 0000016912 00000 n 0000017009 00000 n 0000017087 00000 n 0000017136 00000 n 0000017185 00000 n 0000017234 00000 n trailer << /Size 16 /Info 1 0 R /Root 2 0 R >> startxref 17283 %%EOF robustbase/vignettes/fastMcd-kmini.Rnw0000644000176200001440000003113213012615634017612 0ustar liggesusers\documentclass[11pt, a4paper]{article} \usepackage[a4paper, text={16cm,25cm}]{geometry} %\VignetteIndexEntry{covMcd() -- Generalizing the FastMCD} %\VignetteDepends{robustbase} \SweaveOpts{prefix.string=mcd, eps=FALSE, pdf=TRUE, strip.white=true} \SweaveOpts{width=6, height=4.1} \usepackage{amsmath} \usepackage{amsfonts}% \mathbb \usepackage{mathtools}% -> \floor, \ceil \usepackage[utf8]{inputenc} %% The following is partly R's share/texmf/Rd.sty \usepackage{color} \usepackage{hyperref} \definecolor{Blue}{rgb}{0,0,0.8} \definecolor{Red}{rgb}{0.7,0,0} \hypersetup{% hyperindex,% colorlinks={true},% pagebackref,% linktocpage,% plainpages={false},% linkcolor={Blue},% citecolor={Blue},% urlcolor={Red},% pdfstartview={Fit},% pdfview={XYZ null null null}% } \usepackage{natbib} \usepackage[noae]{Sweave} %---------------------------------------------------- \DeclarePairedDelimiter{\ceil}{\lceil}{\rceil} \DeclarePairedDelimiter{\floor}{\lfloor}{\rfloor} \DeclareMathOperator{\sign}{sign} \newcommand{\abs}[1]{\left| #1 \right|} \newtheorem{definition}{Definition} \newcommand{\byDef}{\mathrm{by\ default}} \newcommand{\R}{{\normalfont\textsf{R}}{}} \newcommand{\code}[1]{\texttt{#1}} \newcommand*{\pkg}[1]{\texttt{#1}} \newcommand*{\CRANpkg}[1]{\href{https://CRAN.R-project.org/package=#1}{\pkg{#1}}} %---------------------------------------------------- \begin{document} \setkeys{Gin}{width=0.9\textwidth} \setlength{\abovecaptionskip}{-5pt} \title{covMcd() -- Considerations about Generalizing the FastMCD} \author{Martin M\"achler} \maketitle %\tableofcontents %% %% Pison, G., Van Aelst, S., and Willems, G. (2002) %% Small Sample Corrections for LTS and MCD. %% Metrika % ~/save/papers/robust-diverse/Pison_VanAelst_Willems.pdf %% <>= # set margins for plots options(SweaveHooks=list(fig=function() par(mar=c(3,3,1.4,0.7), mgp=c(1.5, 0.5, 0))), width = 75) @ \section{Introduction} The context is robust multivariate ``location and scatter'' estimation, which corresponds to estimating the first two moments in cases they exist. We assume data and a model \begin{align} \label{eq:data-model} x_i & \in \mathbb{R}^p, \ \ i=1,2,\dots,n \\ x_i & \sim \mathcal{F}(\mu, \Sigma), \ \ \mathrm{i.i.d.};\ \ \mu \in \mathbb{R}^p, \ \ \Sigma \in \mathbb{R}^{p \times p}, \ \textrm{positive definite}, \end{align} where a conceptual null model is the $p$-dimensional normal distribution. One typical assumption is that $\mathcal{F}$ is a mixture with the majority component (``good data'') being $\mathcal{N}_p(\mu, \Sigma)$ and other components modeling ``the outliers''. In other words, we want estimates $\bigl(\hat{\mu}, \hat{\Sigma}\bigr)$ which should be close to the true ``good data'' $(\mu, \Sigma)$ --- and do not say more here. \section{MCD and ``the Fast'' MCD (= \textsc{fastmcd}) Algorithm} The \CRANpkg{robustbase} \R{} package has featured a function \code{covMcd()} since early on (Feb.~2006) and that has been an interface to the Fortran routine provided by the original authors and (partly) described in \citet{RouPvD99}. %% Rousseeuw, P. J. and van Driessen, K. (1999) %% A fast algorithm for the minimum covariance determinant estimator. %% Technometrics {41}, 212--223. %% >> ~/save/papers/robust-diverse/Rousseeuw_VanD-FastMCD_1999.pdf % ------------------------------------------------------------ We describe shortly how the algorithm works, partly building on the documentation provided in the source (R, S, and Fortran) codes: %% R CMD Rdconv --type=latex ../../man/covMcd.Rd > covMcd.tex The minimum covariance determinant estimator of location and scatter (MCD) implemented in \code{covMcd()} is similar to \R{} function \code{cov.mcd()} in \CRANpkg{MASS}. The (``theoretical'') MCD looks for the $h = h_\alpha (> 1/2)$ out of $n$ observations whose classical covariance matrix has the lowest possible determinant. In more detail, we will use $h = h_\alpha = h(\alpha,n,p) \approx \alpha \cdot (n+p+1)$, where as \citet{RouPvD99} mainly use (the default) $\alpha = \frac 1 2$, where $h = h(1/2, n, p) = \floor[\Big]{\frac{n+p+1}{2}}$. For general $\alpha \ge \frac 1 2$, the \R{} implementation (derived from their original S code) uses $h = h(\alpha,n,p) =$ \code{h.alpha.n(alpha,n,p)} (function in \pkg{robustbase}), which is \begin{eqnarray} \label{eq:def-h} h = h_\alpha = h(\alpha,n,p) := \floor{2 n_2 - n + 2 \alpha (n - n_2)}, \ \mathrm{where\ } n_2 := \floor[\Big]{\frac{n+p+1}{2}}% %= (n+p+1)/2 \ \ (\mathrm{\ where ``/'' denotes \emph{integer} division}) . \end{eqnarray} The fraction $\alpha \ge \frac 1 2$ can be chosen by the user, where $\alpha = \frac 1 2$ is the most robust, and indeed, $h_{1/2} = n_2 = \floor[\Big]{\frac{n+p+1}{2}}$. Even in general, as long as $n \gg p$, $\alpha$ is approximately the \emph{proportion} of the subsample size $h$ in the full sample (size $n$): \begin{equation} \label{eq:h.approx} h \approx \alpha \cdot n \iff \alpha \approx \frac{h}{n}, \end{equation} <>= require(robustbase) n <- c(5, 10, 20, 30, 50, 100, 200, 500) hmat <- function(alpha, p) cbind(n, h.alpha = h.alpha.n (alpha, n,p), h. = floor(alpha * (n + p + 1)), alpha.n = round(alpha * n)) hmat(alpha = 1/2, p = 3) hmat(alpha = 3/4, p = 4) @ The breakdown point (for $h > \frac{n}{2}$) then is \begin{eqnarray} \label{eq:breakdown} \epsilon_{*} = \frac{n-h+1}{n}, \end{eqnarray} which is less than but close to $\frac 1 2$ for $\alpha = \frac 1 2$, and in general, $h/n \approx \alpha$, the breakdown point is approximately, \begin{eqnarray} \label{eq:eps-approx} \epsilon_{*} = \frac{n-h+1}{n} \approx \frac{n-h}{n} = 1 - \frac{h}{n} \approx 1 - \alpha. \end{eqnarray} The raw MCD estimate of location, say $\hat{\mu}_0$, is then the average of these $h$ points, whereas the raw MCD estimate of scatter, $\hat{\Sigma}_0$, is their covariance matrix, multiplied by a consistency factor \code{.MCDcons(p, h/n)}) and (by default) a finite sample correction factor \code{.MCDcnp2(p, n, alpha)}, to make it consistent at the normal model and unbiased at small samples. %% Both rescaling factors (consistency and finite sample) are returned in the length-2 vector %% \code{raw.cnp2}. In practice, for reasonably sized $n$, $p$ and hence $h$, it is not feasible to search the full space of all $n \choose h$ $h$-subsets of $n$ observations. Rather, the implementation of \code{covMcd} uses the Fast MCD algorithm of \citet{RouPvD99} to approximate the minimum covariance determinant estimator, see Section~\ref{sec:fastMCD}. Based on these raw MCD estimates, $\bigl(\hat{\mu}_0, \hat{\Sigma}_0\bigr)$, % (unless argument \code{raw.only} is true), a reweighting step is performed, i.e., \code{V <- cov.wt(x,w)}, where \code{w} are weights determined by ``outlyingness'' with respect to the scaled raw MCD, using the ``Mahalanobis''-like, robust distances $d_i\bigl(\hat{\mu}_0, \hat{\Sigma}_0\bigr)$, see (\ref{eq:Maha}). Again, a consistency factor and %(if \code{use.correction} is true) a finite sample correction factor %(\code{.MCDcnp2.rew(p, n, alpha)}) are applied. The reweighted covariance is typically considerably more efficient than the raw one, see \citet{PisGvAW02}. The two rescaling factors for the reweighted estimates are returned in \code{cnp2}. Details for the computation of the finite sample correction factors can be found in \citet{PisGvAW02}. \section{Fast MCD Algorithm -- General notation}\label{sec:fastMCD} \paragraph{Note:} In the following, apart from the mathematical notation, we also use variable names, e.g., \code{kmini}, used in the Fortran and sometimes \R{} function code, in \R{} package \CRANpkg{robustbase}. Instead of directly searching for $h$-subsets (among ${n \choose h} \approx {n \choose n/2}$) the basic idea is to start with small subsets of size $p+1$, their center $\mu$ and covariance matrix $\Sigma$, and a corresponding $h$-subset of the $h$ observations with smallest (squared) (``Mahalanobis''-like) distances \begin{align} \label{eq:Maha} d_i = d_i(\mu,\Sigma) := (x_i - \mu)' \Sigma^{-1} (x_i - \mu), \ \ i=1,2,\dots,n, \end{align} and then use concentration steps (``C~steps'') to (locally) improve the chosen set by iteratively computing $\mu$, $\Sigma$, new distances $d_i$ and a new set of size $h$ with smallest distances $d_i(\mu,\Sigma)$. Each C~step is proven to decrease the determinant $\det(\Sigma)$ if $\mu$ and $\Sigma$ did change at all. Consequently, convergence to a local minimum is sure, as the number of $h$-subsets is finite. To make the algorithm \emph{fast} for non small sample size $n$ the data set is split into ``groups'' or ``sub-datasets'' as soon as \begin{eqnarray} \label{eq:nmini} n \ge 2 n_0, \ \mathrm{ where}\ \ n_0 := \mathtt{nmini} \ ( = 300, \byDef). \end{eqnarray} i.e., the default cutoff for ``non small'' is at $n = 600$. %% The \emph{number} of such subsets in the original algorithm is maximally 5, and we now use \begin{eqnarray} \label{eq:kmini} k_M = \code{kmini} \ (= 5, \byDef), \end{eqnarray} as upper limit. As above, we assume from now on that $n \ge 2 n_0$, and let \begin{eqnarray} \label{eq:k-def} k := \floor[\Big]{\frac{n}{n_0}} \ge 2 \end{eqnarray} and now distinguish the two cases, \begin{eqnarray} \label{eq:cases} \begin{cases} A. & k < k_M \iff n < k_M \cdot n_0 \\ B. & k \ge k_M \iff n \ge k_M \cdot n_0 \end{cases} \end{eqnarray} \begin{description} \item[In case A] $k$ (\code{= ngroup}) subsets aka ``groups'' or ``sub datasets'' are used, $k \in\{2,3,\dots,k_M-1\}$, of group sizes $n_j$, $j=1,\dots,k$ (see below). Note that case~A may be empty because of $2 \le k < k_M$, namely if $k_M=2$. Hence, in case~A, we have $k_M \ge 3$. \item[in case B] $k_M$ (\code{= ngroup}) groups each of size $n_0$ are built and in the first stage, only a \emph{subset} of $k_M \cdot n_0 \le n$ observations is used. \end{description} In both cases, the disjoint groups (``sub datasets'') are chosen at random from the $n$ observations. %% For the group sizes for case~A, $n_j$, $j=1,\dots,k$, we have \begin{align} n_1 = \; & \floor[\Big]{\frac n k} = \floor[\bigg]{\frac{n}{\floor[\big]{\frac{n}{n_0}}}} \ \ (\; \ge n_0 \label{eq:n1})\\ n_j = \; & n_1,\hspace*{2.8em} j = 2,\dots,j_* \\ n_j = \; & n_1 + 1, \ \ \ j = j_* +1,\dots,k, \label{n1-plus-1}\\ & \qquad \mathrm{where}\ \ j_* := k - r \ \in \{1,\dots,k\}, \label{jstar}\\ & \qquad \mathrm{and}\ \ r := n - k n_1 = \label{r-rest} n - k\floor[\big]{\frac n k} \in \{0,1,\dots,k-1\}, \end{align} where the range of $j_*$, $1,\dots,k$ in (\ref{jstar}) is a consequence of the range of the integer division remainder $r \in \{0,1,\dots,k-1\}$ in (\ref{r-rest}). Consequently, (\ref{n1-plus-1}) maybe empty, namely iff $r=0$ ($\iff n = k \cdot n_1$ is a multiple of $k$): $j_* = k$, and all $n_j \equiv n_1$. Considering the range of $n_j$ in case~A, the minimum $n_1 \ge n_0$ in (\ref{eq:n1}) is easy to verify. What is the maximal value of $n_j$ , i.e., an upper bound for $n_{\max} := n_1+1 \ge \max_j n_j$? \ %% %% This is all correct but not useful: %% From (\ref{eq:n1}), $ n/k - 1 < n_1 \le n/k $, and %% from (\ref{eq:k-def}), $n/n_0 - 1 < k \le n/n_0$. %% Putting these two together, we get %% \begin{eqnarray} %% \label{eq:n1-ineq} %% \frac{n^2}{n_0} - 1 \le n/k - 1 < n_1 \le n/k < \frac{n n_0}{n - n_0}, %% \end{eqnarray} %% (the first $\le$ from $\frac{1}{k} \ge \frac{n_0}{n}$; the last $<$ from %% $\frac{1}{k} < \frac 1{n/n_0 -1} = \frac{n_0}{n-n_0}$.) Also, %% from (\ref{eq:k-def}), $n \ge k n_0$ and $n-n_0 \ge (k-1)n_0$ and since we %% are in case~A, $n < n_0 k_M$, which combines to %% \begin{eqnarray} %% \label{eq:nn0} %% \frac{n n_0}{n - n_0} < \frac{(n_0 k_M) n_0}{(k-1)n_0} = \frac{n_0 k_M}{k-1}. %% \end{eqnarray} Consider $n_{1,\max}(k) = \max_{n, \mathrm{given\ } k} n_1 = \max_{n, \mathrm{given\ } k} \floor{\frac n k}$. Given $k$, the maximal $n$ still fulfilling $\floor[\big]{\frac{n}{n_0}} = k$ is $n = (k+1)n_0 - 1$ where $\floor[\big]{\frac{n}{n_0}} = k + \floor[\big]{1 - \frac{1}{n_0}} = k$. Hence, $n_{1,\max}(k) =\floor[\big]{\frac{(k+1)n_0 - 1}{k}} = n_0 + \floor[\big]{\frac{n_0 - 1}{k}}$, and as $k \ge 2$, the maximum is at $k=2$, $\max n_1 = \max_k n_{1,\max}(k) = n_0 + \floor[\big]{\frac{n_0 - 1}{2}} = \floor[\big]{\frac{3 n_0 - 1}{2}}$. Taken together, as $n_j = n_1+1$ is possible, we have \begin{align} \label{eq:nj-range} n_0 \le & n_1 \le \floor[\Big]{\frac{3 n_0 - 1}{2}} \nonumber\\ n_0 \le & n_j \le \floor[\Big]{\frac{3 n_0 + 1}{2}}, \ \ j \ge 2. \end{align} Note that indeed, $\floor[\big]{\frac{3 n_0 + 1}{2}}$ is the length of the auxiliary vector \code{subndex} in the Fortran code. \bibliographystyle{chicago} \bibliography{robustbase} \end{document} robustbase/vignettes/plot-fig-power-1-0_4.pdf0000644000176200001440000003336513465050121020526 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180744) /ModDate (D:20190509180744) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 9528 /Filter /FlateDecode >> stream x]K%mϯ8Ki&NU劒J*/l/䉜kz?} :sz$J9w@$o.˟._eN,s?V\g]^{Zt^On?v2]Uӫ}ꑪ?r&mT\/i%]mwx"4fs_a]  ZUu y 2ig2E  ZK`dXuY)[y]&_|ZBc]rr5eN2ԠC\9d08d(uB%CiYk R-)uQ)5bp̱napѸJ!~I.ީf˪yOmyukL̍ܪ E,rn-k@m%k h (tYڗ*NÂ~Ѡ24[Uǘ頎#VᲶ>T(u##֍lgt |'iYAx`E^oU֥qv&RD῍y[2\QxMxJ51oI.|-e?/XwG^-om.mH[oi |#W ]`Zjmkj+a͍.zCE睒۟M&1^ڟrj kͽ]s:iiٖ)u;zM{/[!ˍ_|14jbMn[Me)5!$i^v$ug y:jlBhASD%4B-h3&>.5AKL׼h+W<¹UhAl%Hۖ}AEM@>c\ui[6FfLhxktnSls,隊c #"&5;][Zf/UYP&x=cD% /0dӀ <&R?)|ՅW W^Y"f/[(*FWZ47,U: ͙ lEҶm[Q3BX<Ko#D6  񔎀߮s J+%AxM 7J7zGJ'y]ga@a8he!]uR [Q3:ˢ#OmHbhm?k l}w*+#؜LXe8$] fE7Fy=cCi-]e5@@KuUv^(a!E^X"#v-C W oXktN LhUZ1u nHC$@ް{ /C˷Z>zhyz'ב3<+0EmHh Px]xbU<Ri_bI7.KU O,1){i\ƔEwI@pڅ%@͎fg%e[n Ӷ{e+h/>eO4Sdef6Kc.{4v]wY2l&_F;}ʞ6X#ڥ& dߣi&[66Es Mo|v=q/GMmbM&t wM5Q&Ԃ&mb*GuB>eO7YGMXBASR%eXuK"S]8yWnK:MM<,$)׼|!߼r洺p@yx@(dXiYV|2CezN8VvḳdC^Be: MP٭at+ML{rLn~vgLH]*󃕕f|[+p5ě~Wb@8+5-tekR =J<%ulS<:&2 J>.2ebM=Ⱥ_|,C"(a[V:W+7R~,r)OY: rt>qDDŽYEa-A v4,1+,Ws)t^9Wu (+ۼAZBZvWr.^w%ހ¼xe߷ !VMc(Tc y}Vo<--ջ?#.U@ItNpYV~d龣 hiJk%8:&!sE,?hxt4q gvoY'd32Wg3ͅ1 fj $UAU 2̓`pʡ0 X]N@dN@dNrR[5, R3Jτ$jLHitԾ(W陠 XgtrR͏',bd]a hAe6&]C&y: n.zC<8D-'Yۜl*t]Cn9sw!]<i^:#mTM@}`\lrδ]Ͱ`"'?9.l-+@!1 E2RZ$u&3'\m;d i&UHg/$]+@Xt=O[/!#&T :jbxjnKy:uy=٤< f_V)_-t4}YQߑt*Rr6$r a?Yg}I)AG@K;NY%9ggSȍ U! dʚX Yg33: /f0BlXj rtyUHaն ۅ9_s7]u -.x6zW6`uo;fo@ްO fE2MnO3oY&ty}<ǂȀOi[*# 47F3`fNpƃ% N.+p97¥*vm :+O-PtRu]<_4qyok,B/ aXgt(|m鲬Xjju]<_EFSfB`MQsT}3s5=k;!2ӳgaUv YV tXe( S.`Ie/e/FO6iD8eqnʤpkP&)iU?gʦmq(۠ h#ߧQbd/&d1wM 6ׄ?psMo=hb5[<hbM-oOy jn.~IMﲗ)ͻn%e6-&xmBne9to}4HgJ#5 ׄ/\Cu YAMS6! n\wPR|5!W5'8"Wexi,F{! SC"Pߙ(綠jvkZ@/)=eiۂc߽l^;|6}JM렉MwifirkP&)ie-{JR?˞u@> -V&vke؄iq+- )2hgxr#H zhDj M Mu"bG |6},kdMN֠ MRJJiwLc煪h#g̢6yF5U^n8k؇q6>.|u@>%U{V}DC Wҡwȋ;L|K{w)wN؞qLXc2 $Y"HmtΗ˥7Y:-JL:{>x/FOًD3M&ڊ%7m5V֠ MRJ~IwhD/nh#ߧEY!R&Y%. ̔Y6ˆu@>e/# ?JMh/'^횮i*B޹-@iw+h>tM&94mb|1 M$mHz""yVNVIA­;>m>Mò ܨxrjg̢..DM44ٹ5(jx*kqi\˛덭`xrjg̢m>jb&52EMlS65DM7hb/Q[9},r'4a*41k&f5&&PSr{Ǭ!ռlu>>cg];7"9[wuiޝFMMX}6|hhzDhe.MVhKDp0h5ZhϘEYlSս\co:S"i[]SfzJjMre'޹z/FOEYb)\(z+qPЄ!)hU;i+S s5<mYAA5!xN&X BM\[QwMtYJ`k 8@w URuS,iS3y/FOEQbZ'ik\n $%-|]>ݹԶz}v3{POo(lmӨm.H`]ׇth(߭3WɃcjޑ~CB(uoي۟>R) 6j ޼&H  )CL ܣxp ȷa(W}̃%OvCx5O97hyx5OiNӼlu@Ky?cF|5O@i~ʷbO "h zɬ@7L?Wt}Tx2缊26Y_= |<##Qq F z. |2 d?2 @./  2Hl3=|F1փ11GA)tGx G8 tGүjȆY^S9Ğ-> ikEdH,/_+nh#'c48[.np-7=&8!$%- -{=ٞ6}mBvKX 45h.5h.[4 ,Ӊ5jpd.}NQw_cd՞6 4w=K T&SUqwFk.zr[Hd5xVք+w*L('">!,uaK qʭe;,Ar/Ae¯{~¯{.e]}\ܟ37quZ@ )6R/;1& <mDKks4;0&7bmߐ4ě4w!%Wz+ߐa/FOt Ql&Թ/U% JkbOQ|^:ƫ= kb/Ot@zQk"Qy>j"Q5uvׄlKMt=@PkbOt,P83Sps1 A0HSb"`E^O%u/ IŽ8^e$-o{ʦzmܺ{5OvD_dTԄ|9mĝtMoϤMեkB_}&UkrD_2XS >5sQhxnQmb.rze/< O~u}V̈́<t5X=^%LXdK9\'N^5n@x=An*`.[H5-cӀ <* 8I2WFWPAxbxROi *;\]AxbU<ҙ;#Gu}DžL)=Qe(t 绷<٩7¯>{ob;4tH+#%-z2}ǦD|k~LGD|j^LNMždչsWB ˲[M/0EW^`aO;QVk降ڪWsenoyvWڢ>49{;=lK<xl:=rYzd=n{d=j{¤L/M/_d^},eo^>u;tanrn~=\` Xjy,r-|lPa@5~ۯÖ\>go._}E?Ͽ|˧vZ.>^0)_nݔtL6yiZ@zN)??1n.rRHӳz"l-KS,%h}Cؕx;424곉؝6 _&~w˗\~a^ZwqLPM6.aZ9_.8^ )SXq[,x;h U8S6^AuOv[NIg>m)1'onzc=1 ;{ Fإ6aS @50h -ΔYݻIegw g݆'_F;V=d}=9=VXl  `5aM6[# xk` AA'5,Q{ jq0@{O C5szQŸc^X,֣4nA-BPOYllK.=3Đ=eh0ۊ74ر`?T=NJK{쭨U7:g @uv` @50h iy%mP4p}<@-nc P{N<={>{z~@ݤuWځ[H0). <ֶ[Lk߼{{]ThYVr?(c뻛xr.&z-<[}YugCwQ'}v-[H?3Hￍ:>_XxI4S Y lө7՚Gʿ|V}Qq?~Fqg[GG}߫ā!endstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS3 14 0 R /GS257 15 0 R /GS258 16 0 R /GS259 17 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.302 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /CA 0.400 >> endobj 15 0 obj << /Type /ExtGState /ca 0.302 >> endobj 16 0 obj << /Type /ExtGState /ca 0.400 >> endobj 17 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 18 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000009892 00000 n 0000009975 00000 n 0000010176 00000 n 0000010209 00000 n 0000000212 00000 n 0000000292 00000 n 0000012904 00000 n 0000013161 00000 n 0000013258 00000 n 0000013336 00000 n 0000013385 00000 n 0000013434 00000 n 0000013483 00000 n 0000013532 00000 n 0000013581 00000 n trailer << /Size 18 /Info 1 0 R /Root 2 0 R >> startxref 13630 %%EOF robustbase/vignettes/plot-fig-psi-functions.pdf0000644000176200001440000004342213465050112021450 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180737) /ModDate (D:20190509180737) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 14144 /Filter /FlateDecode >> stream xM,qW^u ~m%l F0eKm3~qNdEna`ZzU72y$Y?zǯw<~q]#~?7Ǘc|z\R?:K ?Ux1磎U>~m/p>j'>}C>vy|wˏy189`_/ q`rZǺpcak}~\yG^ႉ|\+\0pxk1$\0@ǸC ֏\/ +:Oᜯ+J WT)~%+N!aiE~p:ZGrul>FɡByho_zȧ!9C_tG9t^PEvmOX&Cj͏ngz\ :)棃Nq?e`G9T>ɡUѬqZ Qc5:gPlԯI{s]CY?Zɡ7ܫ)"s:;cNDFϥ|r:u)csNJֹSza%tՏ}xs;hWCC_CTPS×ZޛCM+}g7:LSA,S2 'ꇚs}8tJ9R>,DU󎽴|{7Jyu<'.f8+ fEAI?xjr˱Cq܊] >*Fq?8Ga)h4l%Pl(_sSjN,ꧢu.>'IiQAQ\ȄfX͆srjXKŲT^rV{܊ 8d' xB[:F(8( X ){*K bE4u.hbG4彜(Z4.ʼnhHqZ@Q܈A)  q)VDw6Dw , A)"_Kw9ʢqP{EwD\A֒ X/K,-ؗwMDqKq#ryEcU)/{+VD 8=uET8 =Emi.Do=5EPP!'T }(vDc[ABho=E(.DT܈~BhԮĩ-bE4.ņhl{S!E98sAX!m7qphB4=MO\ >`c:Yq-ʢ<emߞjy 1^(7午(WOͼ$BR})Qʢ|UOul9'kQ(O-੼{;6|]Oc y(E*qguUnZn]YSt$FDf% Q [A6/rW.ȍIX/o&Y;|^O]|UU'ң|2^OӰ ͅh*HF^*zjndQfխ<&6Y.wI؝&amg^ -> XmXfO6ECGSn4܏=49ObM\'r!kPW:׬ =&54ǝ_/ 4vYۆxXlz5Xֽ[~~Fy|_br<'m E/vAIO3ES~|䅚BͿ86ﯽOH^+C :ECh)ꘋW(uХ9zpj''̨ĺvN!Gk#Y'r9VM~!۠RPs{Pe<#F+b]뭈'Gqh#+2QfO#;="+ F"JhD.ȸ#ZW'bϸ"6pD8#Z2b82]}D8#M_Ėqdj,cϸԡqFq]ewP3+S۔q;x'WƖqd1=cKF#"򫣆%c̯[Ƙ_5hÅc~1`̯>\21c~u:cYM1//l{pdOψ1:jm#Ξ򫣆Gʯf\gʯfKc~u,?㎸S~N=PTK(gĒJqG){3c̯fc~u0dG)󫣆{ƘߵR~2#{ec~=c錔1wה߃-c)c~u0c%W[c~u0.XĘ=R~u0c{0t kƘ߽R~u4c1:ze Uwj!ֱXcSM1WqFl3kgj!#8b~m(98c~%㌸b~[ƑqG1=chvȯdK̯ tdC~u4fW2!:S3!U3JƐ_2!:hT3!6ܟQ2{e=[j?F%d5TSՁ-v0=[Ƙ_cS~ c~M5Ř߃1uƮb̯1淮Tʖ0TS՟b+6c~;bIc~[M5Ř_˸#_˸"Jʯe{ʯewđ{g\go)gĕV#c̯g M5G+WTb~ 1:|Q2]ƖqdỌ=c̯_+#W^d+3Wfl)Jic~-c~ŮboR~{I=(c~{IỌ1:|̈́13b̯e=5ꤖ#5H=gj=82+巯߾R~NM1c~uMƘq+5tn'3bMỌ#clL3Ʀߍ16FO՟31kƞ16Lģ_##c̯*gWʯN"83]ƞ1W2JƘ_2]DIj: +S~gOM1:?>c3":{0w߃1W'elc~+5tn']%utn%c~u.c̯ElZʯETm=Z{0wTөr-av0w͔5SSm_u1vN=(c~j9gM5[ %clkﮩkʯecSmKAjlGƘ=R~1{cSM3-w1]Ɩ1WqG,1=coỌ1]Ɩ1WqGR U\{̯d m׈UlC~wj!+]-Ő_q*}' m:|1WqF,825Wg\[l)*Έj!#c~{q*JqƦbȯȸ#_ŞqE)eZ1:|g\Ko-):|]Ƒ1FbĞ1WqF)[Ƒ1nIĞ1Δ߃1淮ߺR~M5ŘߺS~M5Řv+6c~ەJj)joZokZoTSmzj)FoFofo[Vo[03=b+Wl)b Kl)JIjMjʯԔ_դJK+j1")"Ffc6oyu=[u5V]#`骫M}<յR`Aumݞb]g;/D^PyPtŌk{&] t];]NK PtJE>hCtŌ[t}!XQt틗k߼]ÜCup ޠ:L#E:Z](DW}-]Gǣ렟Du ]D~!]moySz_᢫i4[5B")]u=-!^I5oU]Lt-]tUtW5j@ti Q;jv)zjv!rZL֞d t O6"x6WCL9]~|!BtU.ZEՂs ^EɃjkIUy誌!Bp1V?E1zCtbMu ?DW_eEWto:|C\:[tm\EIuT"!b]Gqv ˟ /];.v/E5E׾g}RtE>Bt}i]},]1,E.1!Z yPTWm_ZV_5rt׻mK Z؏kh*..m \dm/0^o] r=4_>]}tZu;DgG1ΚDvYq qP2bHO`m$,tU*Ct!*.ŰX%dذsYdbчj:LZT!kQ=]jN={Y+Y/VXb=:yaj27X},”Y,;B ?+yQfJ!k}}0:,olOdY5물&KA)kMaȇ6PdY[7m'5'{u_^UUлïe'6dn/7e1.~9RI_և.or]\x,@e`l]^}}K$]A/_vnJeb-_vr2_vr6ӗ*/;9F_v67t_vr'_eG|=N—f&X^ˎ!!,eeˎ | { ef_o._{lbe 6eS1_ s_ 9e{c ]^1I_W60 / yҗ |~q_VῚqO*/,eeNC2Xo_= teWwx4ev/+y/+/+a/+\mxJaـ/+eSeb$g}ͲA_{eЗ劋n^+\S/ot$܅ۗEzo_6ۗ}ۗ}߾lķ/·/e}وo_o_|߾ ߾ۗ e#}وo_6ۗ}ۗ}߾lķ/·/e}وo_Ʒ/ɗlysi˾}o 5{k?ְ1^[ÎGz5l֑[VJ~5, {k[ְrkXv[vLa.o ]hElϕ[^[ZO%o +[dbh6fǸ7]ua^X A{˷.5la ְHcv6 0fS5Nbs].5ј 雰˜GIaF4f]1;9bh.N1\(1*&tҘ]Qj ZKcvq7>xcoTsWi̮q]lИ]|t1'$-@i.4f7>16?$M+n4f;cv_OݾuF]|+SҘշb1scv[˜ݕF]1ݸ10fϷ1'zӘ>n+|kZa֫0fwcvlnXanc[zakXBhoߚn܊nn0Øͯ/|Y V0fo Lcv77HaF'|+Tۍ ޚ쮜Ncv4hK1O10fw[an7hnnX~heȪ1@16'&Ә]Fuo5 cvKAcvV4fKwcvM/Vo5 cv 4fWmNcvJcvo= cvq}7fWAa̮Uy=ḫa.?4f15y˯ucַuc6L4`ir7ۘ4ݘMݘ̳.,7Y!Ƭ4fg4fgtaNvWܘnјV0f's7f_nn6nVn̺abܘ0ȥ1;^ǹ5lK[vwc/|nU P\ƍQ_Fl5i[Ә6{kk7fLm̺ƬK n.nmdpcW|pc A7fPwcvl}Zi̲l>4fִ0f4f;qcs 7f{|avڝlxܘuɍYnz},{1<1+321+ cV1+쾹1+ݍO"n˜c=ocVا1+nDӘX6f }R˜Wh̊?h+y1۶0foLcVos#sۀ&4f@c ͷR1|+m ln˜ml)a̶Ic5>_h6h6_l4f[ql+~>m7ٺޢ1[}շ1[Ic.7aV1;Y_W1_a1[ˠm0B"o&*5kN5oV*>>n*SnDo c>1s{:i(0hY=Dz^p)J֌r4Z꼱ursF*Aq5V26;Q?¦e:2lLf֚fJ2Cpjy},,3 ;/i5Aֺ xNjGf/Wi?y-?uyQ*~_"uaݮ`ؖ]_H=ݲe !VvP y]Z#k("鏌ٺg۱u; u;_+nѮxu;_gnDsh]к`Bv MӺ\"nhJ@vMvMvpZ,Ѻ_]Z66hݎ Z>BvxCt'D>u;/u;_ n{InBX}&ZҺѣu;.F3Һ[_mߨ6iZCn=u۹5[LxuۗSvuu9HZuu۹>Yr`F>лu9m.Ρ Z}º\m, n;nWn}P֭Kׇu?Y]CBԴn;ޠu9Gu۹0tHqL֗uuٌuk*2n{٬.+^av@}X ѺҺ\mXDabm@n;Wqu۹R[U֭pRZu+ۿYi Nкμu+h8Һi`֭kMVȬ[YabV8JV8LMVMV.([z֭\>~рu+u+HV8e֭\FnB֭x[֭\Һ )Zin+dX^9[_u+u+_nK۹uEݺnn:Z\Qۭg [vݺnmn[9uRnn hnVn7[n7nrU1n[ح[viݺan[mݢۍ֭Rn[tnn[޷uZnQQ-2x[(u;x[x-*ۺ[tnmM50nqۺuӉ\.DZ{1^֭ۺn_nmumݾmݾۀoom|[|\j^ڥmݾ۷unٺNnݮGn-/6S+nN.[Nn-/wuk#w/vPl-nr[܁ۭ[FnrB8q!n7Dr?-u nҺ툆[;ӭɭgir[ܨ֭Odu;;Yo'w@tr7n[ޭ[nH-Nji.Ӻ]\*ۀ߀+ ۀ߀3"ۀ'wDZ/WDZ/43"u‘qGužqEuB8#Һ}Y/WDZ/3"ۀ-ȸt6r+1gbX'xȰn#OjdXİn#O<>"ú?ܑaFnx;Jv6rL[ǀn8fާfS8ާ暂mun#OaFwŴn#nʹnʹnmxu8߭)n|[7ux'9n#-mZSiFމ{?+uy|Z'^W?3uy|Z'NuY>L\siF8mSiFOO6rӺ,8mSiݾmriFOO6r)n_\Rѭ)n#3[un}iN_e\e\yZ vNvMvNdҭ9Zu{; nmú+{pZS0 ͭ~к2(кխdX}kn[n'紺u;?u;o+|WXrhкv}iӺ<кnѺnӺniҺpvp֦[wu;|RZÍ#Z}u;|'VZ-@ZhayYhк^Ѳu; v6nEnGqK֭n4[j}[Σn}u-n;Ǔܺ۷Du]uۗo /A>ִn[ϴntmU:hvuۇ[n}.[6n{eavqKmP[~moiv_5[mwmTiv_%m/.^|\X-uZWu/afKVMaޫ0кirܻ֭º_֭neu+/[º֭IV˲Jmj_۴º_e֭Pn}[5[nú՟>X~|[|[Ol;F Vy?>ZmO6ӽ-S)ڪj{q5ko/\wf}_(`7>tV }UU| Z1 4qo3w6 W*^[%Ov濹 ;Cɵf&k+RUVr j7/bu3p\놸*Zf*]_ȫ\ˏkkp+/$]kLษS3jsq[uWvkU7 ȺʨaZ7z;Xqj®vӧ+ ʮ2_8xkvkP 3ރkAU.j{tֿw]A W/^eԿ0x_R@-?0%^f\{a l/E^ & leʘRW`NU*UfxVxðѫL~/*d*˽]mO^*c<^Lx` *BW]1wn2\2Ƚʐo`ڰ뵰ꆻw|ux?ԅ7V|mۏ/_w1rswiZGssMzL߽O5wsM߽/O7}7g)FGO⨙LM͹4}uv0f3}7UE"inEחl O7}Q#>;iu]`Q\TO`N-L)$4})0}v;LLLB9Lߵ\*5wM:0}-Cl黸M`h櫙Mis]iCwq^ Y]Cw5q]\s]n] LUl6wV0}S0}g].-\$ӽF00}'g<5(L9Y\"n4}[0}}bsDkqv:^0;k uFM}ShdW; fN|EwrSjMUFO7}}qg+A+ l4My;6kJ 0}vw;z;彰0C0}|yW[Uu($MYOB$L! LwI\J4}K0}G}y猃++L_Q /#Iw\n;)M+m`n^߬(`zo_nۗKV;â۹4M>YO$L_M=}\?׼;R?xFhOr~K#~o筘zmrz?K\|RNe=|>w9?W%HOz.IzsÛ7w7_|f=Nv;rObm^'&nbQemtmay ~ǛW>qMwwYo_o_ӵ6,sgnjݳ2!<-cZmw?[@ M||?C[;~X=>f9wX,\va*XyRzMׇSVn\ׇ?I=op_~sDz˯? NlPGOo WgP=W{]/+oXendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000014509 00000 n 0000014592 00000 n 0000014715 00000 n 0000014748 00000 n 0000000212 00000 n 0000000292 00000 n 0000017443 00000 n 0000017700 00000 n 0000017797 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 17875 %%EOF robustbase/vignettes/plot-fig-efficiency.pdf0000644000176200001440000003466313465050116020766 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180742) /ModDate (D:20190509180742) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 10393 /Filter /FlateDecode >> stream x}ˮ,q|E-Kg۶56L7;c Jj c~Ode]>xgF'wǷr^|)_?Oo7O?r$N/o˹|ys_oXɥ|Vo]&'TlT`k8p.^o_9 1@0T9$3>sLXs@S/_zma7L65ƞfllM5Bgg+ ?%"K/'Ъy]J)WÂa[j0lji=ߟB_8sz-9;L {3G|+M#)Y ~9g#? _[*RGlVC.5og%n,S]6@ Z=^1J0ڤ T/LH }~p0ꔾ3 ąg gи֏ח"Lõ3Fxz lx1^-g?&6+- &\H@Qk}L{((NN?X./ 17&Kl,Z`{빢J}qL>1dc(ȣGm dQW VPnښ<6n@'j -%(Hix hU'4ge]kB "զByꥀ2zkQ))x U^ HoFz\u4G)-*;*V=*U|?{mn{ޣR%_GY?;uvZ@e,H53@ /N`\[ ehSmGpOzL ͼ\$%AnG^Gk?═ꚽյA]\u-ZVגί+BTu-y#t#8k0_p&dur҅qBVq*5 &"r=m/t >"%k^ 0JSZS˨?u]hmQ/E6/`Rc%<; ]^vs“JY³M^8ږ-*1"V=*+j{oc~AC-::yi8&]@@\fwAkFiSm Wj(fKR\;'e^8N#t]f~v]&\@Y.6"}ǍNi#dtrp'O<;ӯu_IҨ)_+_l_[7rn!gm5,^Ш~?}jD_Wl5|j(8.v尵w?  \v_`8rZFguO|mtXʖNkE_@6D' "SPkN^atu벻pwvnǹ7}?) >I,74˾ݾ_҄ ӓ>A^O+x u :>݊pML0õ]\eR 2JF ]Aer + {y>E LJ\wNz3RY64Æӌ M8.3} K[fOq'A#wy/;˝ S*ae$,vVtqz|`{sWg~e>8y,‘o_ɳn+]lɛ<DG{lvAfio3\gօ,l`."|C7XEa(32Ys{&ZRsS>(u+~B,&4R؋K[{ >5CӋ5%T?pb}u8*+-\Liݡe[#pOEz~.úpЏ A=\c~L <&z,ໂ#j2=~п->>~qnM&}cPBD@re{s!8ϡ9;"27ȸ6l0H+g؄i=ء?`Mp&CK({Bwms6C[>h1%c:ttc1Tc:̚*9BuI, YYmT٠P(*mj˰SV-JAG1gC~Xj I, YYoX"_\4'wZ)M–rZW mî7FzasEcT_8* Ɍ+Ҷ>%:n[`:7\;=.Ӿ/롯9uuk<Y]ta\Ɛ/ 7F"r?pN^[t+9)u#4Z2fÁ`ˡm2j2Z ٫/݇W*>8F}?w3_F:::w+rM/RZOm;Ԗ(~O-?ϲ<)[uzC+G1MQW+-V{e1x?eb^-ur& 1,o6=S잩dU=Sb|~ǟ}>`- 4᳏7 ~5q|87ǩ+9; ^oס x-ōSƉ&I'ڻi88⭀qUx4xu>əSzœ/;Me_ yo Y]>I7݇S`zΤ4Sj24=1 M}Ie~xORKzœ//D ~nR|vr]iU@W$8G,.W_eOl[g%ʍ)Gfgfo1a3odwƄ:1w+)\$ {H vx& ;<\a]jDPy1I6پmVS`[ceOklj (\ /&c֑l:=.E]jH>v{rF3 { mf0h mCMum^27dm ao͹q/0/Z,Ϡqmax6%C0 gr0'Ma#lx #!^[i+t4U|2]d'w1F Ǯm NcDXmvkx`\$Simm*oj#nxđ 0{D*) L w l3hi;c 'SZ?폱}̦4-{\~Cv%O1߶267b:M'WY,gM!uu=Dq_=Ǻ +3 2%=$`]DJ9ŸV sRC/VerdU;X8{7(o.7rouݛCO223iۼڶ+Ֆb-.Gֆ6ֆ<|^Fˇ>4[aꚖiڅe#abdn ё9Ve `(uy@pZYpϮ 6BTys9ŸVnZS^Gkk꺿+R\*K߫<Y]t\<衿EWp@hdurqsk>PHyJ90.֫$_nIp:c mRΒ2{nM1ʠ+Dޯ" _D3jr9%1r*cJllO3kx]>4uZx͐:SigyAys6rϭ)e=t_BF ׊ i5p)Uq"X[~oWLǴ "[YRƵr9et8)Y7K5UtMRJ!m+:CBILrqܓN!Q _2jè&r6!Ʀb\+9[F1B򄲵PՖZl5py99kUY.ƵrOSf~rUW?W?Waaܓk|KVFn{w5pL\-JF;nR\޿ܼ.kKzaM_9|[*AVW)o@^XwP.HИrqܓkJlӯz+T]a#+7[7l&W)WL 5XmP;4C.WцWpWh3iʛYoӥהnxM_+A\5io+Tuムxr.'ה@HYW%:UnJyz\ ByjZ#%f(+%U .z( ])o.gk2Ɓ/ F*`TRN.CY_$Q>J;ʛY.ƵrO)Sɋ0AUyJ9"t-“YUW]%e\+-66]Pp-vV$=!2Ztum*Sו\6čܓkJǩt-y55AAjt $yrյƍT"!6תGR?HPUµA8|-CU=9|1HRgNp rh#(DŽ8 9iea/CJڵVIn!DZL7\"sr"=͑EIWvQ8`H@!yt_a#8[UѯأiiJq'apX|\6 s+W'U/1$;W 3hs9#s1OL Wnj@F\ Q8cTp rƵc={~?zGB/\ROK,U`Kri\aw~n -72z_CU8WMW[>? _=:7TJu ŏ1={I)iod"@=>î=2]MYMPVSwV]{Up4weɳ&QZP^ m%VJ}2}!U8$ݡ;eb^=3G+'P)vQm܏b goh <4ģ\P#G7 EuKc{RTo:Man*Ew%P4ׂS8ףUOjhF~.Eh ϧG1MN4%Ph^܏, Z3<%Y)ah慧i;ۖ"/s~ Bazc4f&Ee%\TW4)܍ޏ\p4ںܞqӞz׋1fF=, ST8ףuE4} Ǘ:M碬 ~f>BS๨*9DOSC(*<-4xj^wwϾ =!̜0ezhg`!(HY*x&ҌqO3O5g|躻QGt4h钥yN{'Iy8S2>in7yX`H{*s';Gs˥. $[*gv7I/{ #᷹SU~1ʆ_$NӍə["7]pkr~Z~tǰuOZ+9>$z3ǤJ  ry)K0T$nOj *>cp8f TT\S GNOe*H)٩.=J{S/P.Jȋ(P<*qb*$ TS\R%YL:JxPNgJq6Iq}\I$`%RWuߐX 9 w> JјL4'YEBi>7$ |$aX@&$Q$ zd8H AQUX__=Hi";*gz4&[7p-˔ð QQ yT֓8kJ8x 1֙8 -Y05O-YOnpL #4 If5@1xNP|˄e0l&Z47mцX\T Mo @6p7K&4&Ѐic&|C4=qk6U=&IiüVKSfwy>p^ϸ'+l\o™t恋 ^f"4Mߑ7.;ԝVa&}Τ4ܤGc1hpևVnUݯ/T1Z\?q'iU;p5y˃k8ݮW\s=Pex,[*x±|~_0I}w8߼}󝑧u~/?Z眾TlA]\wO㏿8}Ƿ_}6>z{Lz< + óZn ^qT yXX<$( q<RR2`ZiBG}W|E2Rq r/@l? [YRƵrzhoqf9m4tv8Yo5;ػ5xy4%åtvt S .CIg_0D]qq6Bb\+ofQ !hҭ`' Uc~qNpӘ^iˇ1-V\yB~i+vQhQ`sj}h 3a,b ?d'6 `/2kh?B7WA:XpBDcq#ML!kRr%3(4̌p$2^—Yf4S'@c: kRN, 9ytj7HJ,~7@\d5n62vl к&d6 Yr+@howfY9dz3Θ)}So~stz: 0759CrҰʄim{Íms wQ$˺Aq5F2x~w_FF:F|ȿ#m?mD?~/ݯ/qLL(b~ׂHnY+撺gG>Je@3.?I6.^;R*T .CH,UV49LYGe<+2ی 3/quT7- 06a;a#w ɕWymU? n n5-`*1r: ^ x鹮| G/7EWe0>0njQ>endstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS257 14 0 R /GS258 15 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.400 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /ca 0.400 >> endobj 15 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 16 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000010758 00000 n 0000010841 00000 n 0000011016 00000 n 0000011049 00000 n 0000000212 00000 n 0000000292 00000 n 0000013744 00000 n 0000014001 00000 n 0000014098 00000 n 0000014176 00000 n 0000014225 00000 n 0000014274 00000 n 0000014323 00000 n trailer << /Size 16 /Info 1 0 R /Root 2 0 R >> startxref 14372 %%EOF robustbase/vignettes/plot-fig-example-design.pdf0000644000176200001440000007530213465050113021554 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180738) /ModDate (D:20190509180738) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 27369 /Filter /FlateDecode >> stream x̽M%r7?䀭L IX؀@H(}gFUDu\hak\Y_߿/~K_o?}ov}]O_/o?ҵ_O-Ys?4}j_2ײȢOi~}<&/x:GGW/_ oz_xR&w:Pk_hjXלz]_{{}~N|:~t6ǾD{WzKh7NWJٷ-_qU`qX:ۥCh88/RB\Pccq qqOqxVo^O}w,"_ lIB< b<~`4[A<p@<) \"n_/&7+)ٷvqWxʊSK/Du<`m%+jXbgR8 pB<(^)뛫o<`qq/1y|]Eq/_1O{i)%_fWW`'?;DwWDG`q#8Bxm~o"vk-w-%$bs H@VW\s(V;0A.`=GIjW;ċD.UƕYKQs-]$RDyS (Z~f66jJSs-?$1uBj+ēD7&?@GҠ]B$m4bQ⏤:Pրb*P\^ jcE%W \ol8!V+Z2ʮ"ߑlQ}UC%؉ IԐ1Ps1mԾ!+LX WR~`XF}q6 (N.W&CYu0U-`g\oHnb}q!1n FF}()(NVw'B\xA\xCl !t&S,)v`x9vGv7wGؚ~ZPj? icXqX̵`}? 1^ /؀bk\5_+6tvtof w.-5 &g`CD;/5wo_ꏤ{5X۪] 0k(@ʗۛ8}Cpu^Cb[RT9|(ZW ăWăW;ĝWl\^kֲ#9c6Bm25S'ą߼ FK`N1\s+v`87`_5cT7.pMcfّ辍jZߔ잛ksm5u8&6.Z.x7&s]mn?R#:uH/F#ڀ.H4x5L^Ϋ}MlTsm/΄j?¯0a+F#4'{*j\W'jcۂ|5Qmi icxRyQ˾)藙kn?R߽8 /GUeHFk ̵y{2'37acmJ4Y#5=\7GoTs1ktp@(#ؘ ׹c|T9W u Qg;w㤸*ً+s?[a;wG \7#ksͩ:޲`;`9Ͳq!F wk};QC VCUL.jw5>`׍bc 8Uk6. s]1ݘ!V?1>ycX(Ce\iH閙k2(?@# :cqa`y\0hc(W ąW;D\sܽQQ_%D3l,g\'~s?5Gب=cF\_p\_mif(Z !Vqb bdQT&L@GX0X|Բ`&v՚ aF12כdOs9 q"V,k ?̅k .U:ūD16G!K 3 (pwc"?*nCMQat1C|DU6Ltt`|T}mAuD&1cjHS&:qDdx107lOb6URc\dFκE'f{8Q8:0>Y5`h f ą ND12GU UUR$ӆ>-<\\yJ@[mko\mI3&Buicv b5;Xp`>VƅX=MylԉgA,o,X1-g\2M] qZɝjje:Z1NVawBĉ_%ZftHPE.:z]X!lX_g#{nje1o1> / E1WV웹>QxX}ԕ"]hEXbtZV[0A|.L\PkYtW\ qU#p04+x5kYZ nMtSuCSQ9(@acR:-SPF!)`9//F9)`5ubtW%s_^p^{(Q,ŗew8J@1k(NQ|yqGqK(N^ p#[(.QfˋGqKK(N^ pր#[(.QFˉB8#`v,Q8y1"QܢFq^^ {Dqˋ:9`5s{s@Fa9ax5<pabo9s5qk(Q5?abo9u؛kzsa%s{sqbabo9e#Nw8S%[(.Q؛kN8SC[{sI'qʡGrآFq{0לs5(QzJ-k{siRqաGuآDqb8i#N8;lQ\؛kNt;?%s{i\sa\s¡G\pH(.Q#.8暋>[(暋M?BCZq abovcqaabo0GqbG\tX؛k.G\Zuأ؛k.:Q5zsͥd-k( 78G7\vw؛k.;}*FqboE78Q57N8Q5d89(Q\8E7܂Лkn_qآDqboơ@nqآ؛knq؛kn"r57 9Q\8G7#nrآ؛knr؛kns59Q\8G7#nsآ؛kns؛kns57:Q\8G7ܚ#nktآ؛knt7[:q:Q57: xsͭU%s{?*q|čk{s-?`qk%s{ ?*q|ĭk{sM?oqs%s{-vw-k{sm?}q{%s{Ĥ\3aa9S{$ 8>b\318>bR\3]a1MơG%D7L1q|Ĵ =f‘)?bCo$Fqbou]{{s͔19f2CoEq\3S(Is{stBk0LTt5(f%s{s̈́P1abo0E7Lu5g(.Q؛k:("q8kd׏bTzKmH05JI}I' $'x3:I)ׅM0r_ :r떁_G}2o}@42[C|< Okj܊b)Z:Z:r떁_G}2]k)!ۿ|_/'}C$;E≿뗿/寿/ѧ&UĪHCZ2tbOZVCK?=$HK\1w&m/$bwEakYԙ4{1M]x[ ~o-MMOo-M㨄Kmw+udOԺ?״CZ:\ڛ箚D.^صْņ:yU}磰6>]y]U|. M/|Dtq R@Dwf:EYwe-躯3ʲteu ՓFɺqsgOk0[.+#@eZ5teu 댲]5(ΰQ>(h46ʚ#6Jym%_Dxdŝ3BQ¿e%.}eeM(}e%ݚ6Jmts( FYe,(K6޿n}e!ʒm(+QVռQVߏ."nѓ> ~W뻟%!%a KDX ,蹺U\bZVvs]fd\F(eX=C' =O1t n/_Zs]fR]Ld!&#*Bm까.3z.# |aMIB ` ,/c^Ԙ&H*ˢ/(l}F]I<0j?xQ  f}!/C^Aɤi_!~ZCe5ee4te4ti\&:È-2pU] 9㏄MߍE}2nxf$ާͼԐgҺ,vTnÍjeYڴֳ],}^ @r=ū*,^=W_*dM|o6K}u!n)f6nr si~5b'Aem\eū*.^Ӄ0rn2ՀAXAX¨oYՄޭjʫ0 1 ͼ￸m`yD ۫1XyN,A 뫹Za I넥zC J/cI/c2^ˈdޛq& }?1u'+N GIm?#)r!;Q@)@]G`uZnlOMNv4֝m?,`3⥬yZϳV8N,`Z\Vn7yA$Zd+YU! n3NN@Px^2 a%+{i}!}^i߷G)Mx?(+Yla>O軱'D~6r~?XWllmf{`:ぢ'gG|[a؃(}j;ͮ?z~>îg]lh <z`uk?aְÂ~SfeEٮw~Ok39hVV^}z!MʃܡGPt z?xO@[@`J?7kShe~ -ymFJ M_69?2 %Ů]_гin97uݮW.$$lEKi^1i |v7??YdgU [ekhO\OK!g_ {u=ܡt~_Ӵٞ1?f]Z# /RzW6=g6?uYоً͏u=U- r|^03; *̞z2|cڳb>{W~@[Ȳ6?/0?v?wud2?:OHA^#z0M׃1u6u} '1_$ ϘtYև,±0"zu>۾C7>dCb9_oO ?](||3u'ևx`.\B^ .(+! {_x8mFt诠GyзC_}S#?Gx/>Χ<|EзC_}>p>f7yU?||?|8z8898_9ηzn|?|88_989Χ{n|?|^99xn|9yt?zW\/<:qs;C}\;=CS=Xq=s;C}\׳=C=vqs;C}o9?W\}9?_9ܯs|xUsqr?~gys9n?~9ЗC=ܣ~?ˡO>?gCz|?~Mpvχ>G}q?~?~Y?~^C}o1~eО=ڞۡ>f7{=C{=C_}>0_s7}g}̗G| 0s|E<|ЗC}̇i1s1cz?`>=zˡχ>?z:\}=|eЗC}̧=C_}8|r|uЧC=|{ЗCOFgŷϖOs:'G,9A9a q?}v 'ex2փX96얭L,q?x,q+ƣ`[a76Phz>6BaG(_GK#)dBTݻ#)dxgR$P }OЦ믏бl~}.E9L;)ι}{4Ila)t>BN)>r}6rSٟq<َ`Ov>/?TP  Ğ#xaN0 s]QTI ָϪ { v; \v ܳ ܺї ں -`7:C+z,H>7'eaTq]?`^faœ,pN8 \,x9< ^~g+,@w]:J8.Dm'[2Ol(ma umPl֞-9@1cuiv3L ^r) ^s9 ^tase,#uY ^va^vq^w^x6A2D l/O` l/Ͻ` l/O` lBo xDV,aa ;0La ; ,NA~Nȗf} c>GAv;C!%g30Ao^)?+9u%lZU`:Ew'B1uӣ{q]:s\uv[qwGaMaQTne2u[:T?C[ v~31? CyG~?=1XWsy]E:= gOBPS;ӠnE~rp=d߹bn\(욱}Ԏ{v->잝ňEn{2٠vl;EQB܎v}*$HGG asA!͂dCQYg\D,4QNb3ʛMr(JcrOM@X3b-tbRay4+3~Sߛ(&q+5UD9b&}l e;hrf[T?(7R/?#ٌDjb9r&br';bF5q md푉'骕(R=ʱreZ6Ovj&jayr0eM,^sR|Ǡ )OV.yd%Ol,Βz(Sxh\D96wv<ʭMVudr傪u>n߿rEN3v+~Y{lǽXql׽hߤ%v\ԽӾۉۑۙ/WY "o+ʍo֗w{6lOۻa;rۋ.:У0޻2zr ˃J]WQnOBrnk`;_QNB$ezGcG]?X,t;ք?X|(Q' Oz5&`W- v}77cVNzOտ`>'赽\p<ޟv0k(<_x^q_ ?P%\?V'r-DxߌBw џe3l E2_}&/;>_Gq ;EVPU=*AY@_L_AuY`I>oSPwcO''rd*"x+K 1>vV!\g:%rcȃ3<餫ƓbI`̄ z>h _,,#aǽWnN}ϋ?( i%}3)~HzgSFOgtdUdUlh =s¾Hg62[ҺZb;ieƿ*, $ =oB9#*a̓a9layZ{a!Ok/D7 v7cy(ZX_vZZIV}mԥ RsC%, <}>88jhFajr]rRX/C_z.bپB[SҠ5ߓM-a* o~Jy}~@7_X/YTQfrxCXTm =~?ٱO}~Auk0⥬uS6Y_>fC4r"}|YdP\w26gW+2e _+U#9AO+]oLd•,/Ba8ʋ=WS̾euLZEZZb'r&'/ /R> z؛eOWx|0__y3b+煽zNr"OumUv,r3O{^{y"7F$ 'R~B^%p"?HBb1K?ptʍ<)8*r>3B$ADr'O-p')= %Vwr ? lO 7}^p!O/2W0^+Y8CVy}7}~@L&b_='YhУuTy?j=Ug&9CyᯋO%ІgC0K֝><>$WNs;"k_BȲ>0zm pܯN\+'r=Q;o 2}-`\rC.1LQo?GqJ&} 8X10 ܩA}"?qY&Ҡ=%ǝ0R?x𠾑gw?xܱp>ScDVCr+O:%r?ЗCˎvˊ} z9o8t?"C}6^sF`Axq=ЧCD`axq9gy|v#gЗC}6_8?q}=|lq6r`yۡ>OtG:3C_}>|lq;C}68?v\}9|x;O>?'x/>ps\/}=̇g\}\o}iD׃=Cכ=C׳=pЗC}\=CxN>W;x|?~ q?v?H1ox R R/ROG_)};p?t?~#pzˡχ>cyn|~1]sz?~dq?s=Cus?p|ӡ{{zlqg=Cx·>+Gzˡ)?9t诠oX>~/˗yg6o9r9Ч/Y>qۡ4#_A|*зC_}>)yZ#CW/vˡχ znG3?ˇ};Csz%r?{`ӡ?`>zˡχ>z9r?|b|e0s=CD|m0s=ЧC=0s̗=|}RJ k|Tۧkex\I?7*z Sћ׭7?%yjzwixJLt r-`!+mmŚݼf=p3r8Vmv[ l7Kf܏ P1~"p̸q X>oT[Pp:p(p;Ľ-=,-KRe^VrԳVm o+w/=%enD+wKH9_W^zK-eut-/x[[ ^+wAx?Pgx}TGO(wW~Ewn.V.Vן ޼n%y)VÛ] o`V<׉:/wL龫eZn*vm2wnk ָt[kP]b3k {Zf@w] :oTaR^fT7ô-Ս0mni/Ku3L{[aR݌FV7Ս(mnDioku#J{YQZ݈FV7(mnDi/ku3J{[QQї2J \?TvV.ES#\nSXnS<պMaպMT6U6S;wh]m (nN!+ȿZԣE-&~aWtٻ^7;m m^)^)zݦzݦxu> ?Eu[.z+.(Eu_X]2uF~T30?,C/ut%lbe WM)􏢱Z\H~:]0:SRVXaMqwG{+ߊ_aK\*|*?]` ?\ s7}WO,]7q_SKG'+Iחfׁ5-fEb{+@'(_9Ti$:y$Y6y+51vuR1 t,=YUȮYÊtݔ=Ra%H5w# tM+ݠqDuQωZ]sgb)[72GLXk"L3u?FtMq߀E`fֈꚣ=3K t N&mD 3'堺O5|k|.[4&q;iZˆ]lVXk:e1MlDդYb:q"|o^IOP5cZA Sz|PrWj8Ddd߼=k# su-t ۑ*7eUaϱ (h5`nRcalnN9:3't!UZ=bZqZhچ,.uZՀKAeeG8R1 }ed]!~.;.bEkTPZs%%*q+c8C_ 5[ƪimE >{*fCUE){ىYŨa3أL:Qghުo.{6N:uqbCWr l*&VnYᚍS7o{ݶzl]=*_Z }sTXIf}6\oؾjw5hUZV{hݢeհfb4a7-<ऑ/+4q ƬbءYˊ lVqCϐ\Vn%*m*_z{kј-=єMꅸZLL/ ,ˊO5VZOn iEaZY?*]Ʋv3I 2y"S\F }3eC/`M$[(<C%V6KC%ˈʼ߉ԕ;afУ=7Bq/=MCWN-rG66e>_˗ˊfF}~A/YYzW`*|cpvXgS+(pZ zo#,tp%7yȳG^A5 0p?ZeݯVrӎ*d{Z͵Wn=nENX=n6}~/~ϮU/3BP/ifѧitͶOE?r?]WX}2u3=Q\9F`iJ}_YG+U6_D{p3͸B_6r}6_[¸UzvrP4B\:Z.LT0qfYu~ 4\cYUٽׁCżI-I*m /(m҈bb$+c$2%԰pyxe×V+k8nڲKG_+뢣e#g4,?,+-=J۸&'9j ߳ ^@~= K1O^ZXyZyu'OܖvZݥssگįP.\+sM_`C.TmA ^MYQ._sM+}vV%MŰсKQ Vf NN" y.8fֆ0 fIlĦjb1׍*raH-T%T RI R- חm*Ͻ**T $MIOт(d=3aW\W 9ZIݮ.wcRqb9-XU Ij3L*fБ Nn$P]5`p"JP:.cO6R1HJRLĢbܬ$>b9}$8UG(C!<8wDyoWy5`<(XEqɋ8{-k1Eڽ=GqŻzL^qD~k(NQ|y(cQܢDqy8kmQ\8Eřr7GqŹL^N,GFqŗkq=k(9{<Gqkk(NQ|yyG أFqŗkq=[(Q5B{|5|\c1G7zx-k(kGyQ5xs{sGo1آDqbo1[{sA\cћkLxlQ\8G7ט&C<(,S{s 1E7טVSR?t5K(ac\cbУGT&$=(Q8E7טD&`=(S?´G0Eq)4G0F7ט&=zE-k(NQ52G\L8ؙk.Sz,Q5O=(nQ\ؙk.>ؼ?r\scŗWoGqŹL^\?₾ŭQ\8E9>`<DqˋGܒGq9S xyqqu,Qؙk5wxlQ\8G3`q[\sϒŗ_c5s;s͝^vOcbo cboͣ7Eq\cGc%S{s-`ң7M1<`[5=zsk(NQ5vx<(c=z͵?\-k(NQ56{[=(=z|a5s(=zk{sm?–wa5s(؂FGoDqbQ`,ћk$ZxI?b%s{0>bB\#UƣGHRt<(.Q#$yIG[(N7"ʣ7H5R<(NQRBj\#icboћk2zlQ\D7H|0z z ZG( F25s{ssGHأ؛k$zQ5R=zst]:%lF(Qi>gTmfFK6ZVm@wF^TmuOF^TmD#tuoׁuKuUm&j]5ɪ6uVmwFkj>}==㪍?bjcMz@h hj)j)x6wO=Eu QtK}GQ/Mƿc :?c?]s.] ?.CѯwYG6WVOYGSXYGS( [q_W}~>-E|k}ʏAa~Iʏ۞ʏʏx*?*?x+.o]]S}VXӷ`oiS}Ն>kCN!OP3] ? #ͯ]רp]\tח~_O_j w_K +Z躷= 2h+qo#`5uG ?ԋf -mÜzه?D ]9i~04ѽeYb^CׁzPjR=tn;Zeнu.|| Ţx{sw&k.^C3ÞȐ{ZS7?օJi˟LCtO+ 69>DF5wk(9Tks­́~iSLɯ2%1]eEȺ{SXLW)ġS@HkXu9?V,9~HMT s2Hr#)Zx`r_8*$2TfOmDgս1jUa? ajVL﬚U,Y{j>X1-VXbPPXI:p^^X5KX9lEw)U˴وd檹s FTͬwywe1jXE=j^TTVM/= Vzn:*&ATh~*FSxލn)+778]Q8ߴaM˝V\дkgRF t|eQ[b>BYWC,Meul;_ fJNe[m*K} vm3P'KlN-X|Z M T *Fj[^JSӴ㾟깂Kxjl +Kr]/]STYSuf}겖첇Zݙ겮Պ4r _u1ukA5C.{St.t/p_;UE\*F* gjmfתk f,wq?MDT*؈eB/1OwVM+WΨ~I׭ kڂx@ $ߵj]]$ glR1Kt-zbuEx@E뢁Z7zT Y f匝`R1l{װD0aFV,/(8Hh`- jDe5 }zz|K22Ss=id{ ę2F/bU1z]zG 8æa\߬uC9]55=k:Q/TpQENc麚a#Vs}ɶX®u=ɖ:Pd뾒jUd3]m*F۵D"ƮaXemҵpfIs umFN,5,.]]FWo=v18*F,f 7aT{h."-E=w5t% C%hġbXXb4l0})Sż o]ehƖ8swfAp7/#4EƂY8COx <_14F}ncyZ05_Sm֯f5bÊ.IpqeJj\ ^ĬfWKu]Ej|mP34iVhkVSشNuXZ5SX SlM,hV.HHAp}eHLA%fgZT 6uDLEWSGqsTT UbE'暷\՚.8C^z q$tHTt7IfkT|q$Kmt1S͋LW}v/$q]PzjZ?OqV}3GnC+̙#_D>dHZ&>ԟ-('"(Ç~#3X/ګ bMZ(C,BErCuA7!:T]]/ ;9ņ΂ݐĬSaQ^M=4i#ߔigNLgUkɳlO JtyɩqW):>*Oc9֘:+H'6pnL2hIQ,Α. OYxEEɅĩ2"U :d%^ɥ˹JJmUY`Zj|`JN󉲘k)ՉKΪv.ؙqٮ`ENe(G n*f[rcp|㯀ire4i95o6ٵQJ桘x|aW2U,jJJj0b<1B{t|yЂŗew lnBUoVG22*K)T|gٛS0\²cb=$*AC:b sw('fZS5_Z[Daajh<5@0K H8ny+)dG*.dje79\gn.*۽yZL]a1;)J*UKŰfK_7&|d>Gߤi}l2G$ZzfkQ/=--yYjTeMs#M%+NmHL\㛵 }A}Iy5b-`P3bx[vu{7mX3M)zrt::c9(⚉xZb1Y-Gu ֈIO7\*+pO f VDOo*V"8W^b8 B*X!VwP MĩlWzi!/ a fSP5;UsfU(* fBWbk nQpAG&Y"D-x0="50s}cOs=rb܆(Q\8G_6ocQx_.;$yn/t3bn[ /sbǎ%Y5)+ckd3dX5.o=v ተ lrv8;o7i@pqxIBFaP@g wN3ndrv8.&Á5:\pv89x=A.ᴚrk18\`28l_Pjr&pfpL'zD\s2YNGK&0u{P4溽>P&Bs^j(gaE94%r&D8\Rpv8:GN9;ND8 4mہ$ppx"<\pr8\LJqD s6(ÁJ6(0u۠B6(ga۶!etZ4̤,g4be?j۳4\kKҾ`6sjJkmtSiNIswpr8:LsCJ#(PiuTA!%͵P(0͵u(t$DYaepZX4:'4:?ҡeqZDžakDR\2;\hHDzptHŔGK/X\됚ZܔkS\؝29?q?%bG-2;LsJ#7P)48)`Z0͵L(BIpr8:LJkP4 ?R%“(0G Vet88L 1J#Qf4 lۥ)(rvZv0(f?R!erZ#5R\+`2:?R&%͵<)ak2?R`*0͵B^)4 V .eq8;Vx V1eq89V84%B)4 Ҧ \+ZptZG ,\+̞28Ls~JkSakEQ)8LsC0͵)iANGiTBI0͵L)4JVev89/8V4/%͵(0͵Ҡ(FVr%)鏔FYG鏔FIHsakQ)5Hi}ptHɆ4JT,gi IIJJ#%fRa#R\+Ք8nՐGJ?~[0͵RzwG}oY{Y7rhŔą$G !.:Q!I+H{Dj MPKM&' gMIK}W19>T{9{Ɯ}G·)N~ 1-JkϜ~x9LʃwC3'I.sOXȖBC3'gekΙWܪkoC_0˷?txΙ׳bڛW,ڥ3/fyw؛51'ܶ8-[W÷>k;cN~&k6J6@m1R1]t`F+B]jM0w󡦖/ p۪ ^Sq}׬3GSc=BС`rOCorm7yz_}z2?!+KZL_&ǢI>k1>k1?sXZy>v1^kB2 /z,fY ;˴qk42}fN\ڒꐅMˁE oZʛ,Yy68+ofgMO yM7z).xttIG3nMron2nW/}Y~j؊?wi9 >^:*\z5us|-N5~1P%j'غ8TC4Ƹ$D_ H*5ɇkVLkm;>3Յkmya넕6|.m+?c#Co# ՅymϮ| Zca$p1ojKb|+K%1^q~cMʫWu_F}_.g,\SHK\;68R1*j~Xnoע;/Vȏ<רu|:qu޾7mhE5ڻjto.[T{kQ΢>{ o[DїEMR_j{w^_cZF7~endstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font << /F1 10 0 R /F2 11 0 R >> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F1 /BaseFont /ZapfDingbats >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000027734 00000 n 0000027817 00000 n 0000027941 00000 n 0000027974 00000 n 0000000212 00000 n 0000000292 00000 n 0000030669 00000 n 0000030926 00000 n 0000031010 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 31107 %%EOF robustbase/vignettes/plot-fig-Mscale.pdf0000644000176200001440000002516413465050115020061 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180740) /ModDate (D:20190509180740) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 6491 /Filter /FlateDecode >> stream x]M$quPmdב2Ȁ=`w42/욞K>~AGNݿrZ2[}~t.?[o_I~[}?ݿi9.~Gty~^)m\)t.|}|ڇ>,}Bp;=ޥέ~{oD)8yeAq$? ő{Pҹ^(b#a?o{$~αa]{ ő43 8sT 8('Hh-H:F݊8y_#Ap$Aq$ss8Aq$lu*Ap$ОC8sJ<z #Aq$6@9τgBƁdF#8Yg\B,aGR1hm-# ~i+ DM X /PvK`(YC|BGSK8:m~ø-āUvq/+Rq=UGU=qdƽ8Nn> 30l Đ826=82zb5/&БVЃ&ӧ˔(:ix3iWiJS8R0$AS߾'YpOW*C0(ک#CgȀCN^yn)n煋32 Otq,z KᇁWm :w2vlcFgD[ >lg ]N@,PJ̆*eW{u<,4Xg&Rr#_P^u"|w|~{BbZʓ206H|񼊴lc:tlEֺ--En˦;6id |Vp]\Rxo3-@:kHE4_l6$oܿʠ-Py+VO|RPn+щռTSSۊD:H=ʢ+ɞآÇr[ܮdi479-/mly+oM/[Q7.澐LEmڟRF"̝]E ~8MK)'YIsĠOIfһOv\,,%N$YP 9`%ܶ#!u YKZH8I!NyAq$u#ބ!O !p$.G:N#a PEXLs#wqHh8BK ( ΄6G yVSGB2GzQzYl.S}M1`$3 `> 0ׄ;_WBwnep$gLHdLQ.%7$ )kjK(q x^.}K %c$Md\/Lrۃ?L7j0 vm}ԆOڐmT}Lg꺾"SFoh(|,+25\7ݤ;= ]ehb"S74EEUoF*yTlnKi!- rX"O3 CGAM|+Uġ3\av̺7)抆fNu9ˑj5rECް=U5$ uY0'ҫqU<&mZBCcI4/y6W ݦF+jx^ og=Gz#UW 01[;o-0Ǽ1c;=΀k71|΀swp3wayc 3w;e8.zg;}΀wp/1Mowp?3w;O3S zgW ;zg;ý!10wF;{g7F3a>{gZ;Ý1Qc:҇W8xUyQP{cj0Fa Y׽Ihݣgwo sc8a{c Khh.}{w NwTߥ{]]>L?ӕay$r.82D8#Bpdlztxvow_՚b{@3&ƲbHJY۞.j_R.%"w\ o}T֗ 9*U 1 q٫PG&=.`#^oDn7aU>IUO+S#/(GЭg0e]6ue:ƽ۸C2Bl(S#*6>KCU%Nt|h>4qn:$H9Yv)tPǴeo|X+oPXXCZ?؏l5KʢsdϢNԕoݬ8Sj' V_[GQ쫥k_,/Z6S\ee }tk3z҂5v+k ?تܻ59V 6‡'ce+n}풼s+csohY}Z{-]y~'_nݯ.uO wanb/t)XaN&QU0?꼦 j5-r^CๆkbbSó Ü6]n'ôe XUay c khMbc^Ca^TQye g ?f:@#aű$nQHQΖ0gK0g[3Gk;m-#yrPgg 6B3<ưpgcpgg mvՌggɽ"O D9caAA@Գ3<yrgg uv;ggl{9D>;ef"69C3>F1,#90Z D@;#ggvb1X/X1(hw#rս <Ap)\pNAgs蔅BO#  t F6a\''6aphm&L=څ]y@u a}^>}͜ +0o*ż)a0¢4I1A"ܘ{Q( u܋A}{Q{2\4ȷX{*?`FwoS au)toZ[tIlPWX ݋6Fn=5 p)tQ_x ȠFICa池94_es5؃/٧`dV5/UC`a^Dnt.[2ve nKviީyMVd16⋭ZA0[| v{6yanՉTm 򅶢=x Zl+"kʶ| `$䓠+U@Z5oY涢A]ƃ&685-;ЛRREWqH_`ˬz32C`gܚ|̌U? 6<ٝEn3) 6>aj3Ya`Sk} WaRl[΀k7aY-+V}f%RKڊxew A!LPKK5`hi&, j0Gڋ+b|~a{0(UI/@Ж.0bt3&w U^v"]1Zfrg݇~ WO4S:5wxW?} 2^f}9x=_> y-N?qj._/>Ӝ7 \r0y~q{b|Y~j3Kc"/>ʎⱻ7 奕o)˕qzg9r|G+eKo,7-=i:*2y+߭Y`uGoY`z Onm+doZal(o6)i$m+F.gƶd>53A$Η|zdy{e$d_9֌U23iNj9X_3\mf~l\7k|][S*wT;S!ߘ?}ӐoKŏtW*~4Rӧ!ߓ_> Tihkyc𶝽v>2nشz/ؽm[7mW"nbmuSM-~o݁l4‡F;wFgF;WFG q]QHw]QHw]ё `nwi_1n^۴ʴkqEWOv-O+;,PFKWAjyp4vǹw+YA8-Udb<{ob꯽rhY93ʼnU& i}Ϻ0*sjlڣ=X%%Vj> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS257 14 0 R /GS258 15 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.400 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /ca 0.400 >> endobj 15 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 16 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000006855 00000 n 0000006938 00000 n 0000007113 00000 n 0000007146 00000 n 0000000212 00000 n 0000000292 00000 n 0000009841 00000 n 0000010098 00000 n 0000010195 00000 n 0000010273 00000 n 0000010322 00000 n 0000010371 00000 n 0000010420 00000 n trailer << /Size 16 /Info 1 0 R /Root 2 0 R >> startxref 10469 %%EOF robustbase/vignettes/plot-fig-max-asymptotic-bias.pdf0000644000176200001440000001665213465050123022551 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180747) /ModDate (D:20190509180747) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 3546 /Filter /FlateDecode >> stream xɎ\\ p62@@$EK6Z[B"ꮶ Z#>bp\p?p?^wݫ[-=Ͽoy!g!xTp='H~~ض<76PTKJjto0+}N2v[xH]T9<g-Y,,ua8C[^TȘ Nf 0J] CjT^*5TyP/T~D }&Y!>LRȧ & {'װ<+O[_\FEQS"/:]>RͧK6ߗ "/*~ T^*DD^* "/>f:Wij4ߓUU\ʖڴU} ;YUŽU2AZ8Ne!GFI&C߱Ҡ][؇{P#ɏJD'$m,IUX%;i}shPJ!U5R$(;x/A5C,㖂C?1dc Qj7)j&Aj[遥jj5#Fi3n-M;!ĭ#a@EȻh$v "5C)1X6_][,v~+[6ep 4GNbNf=u]5\ Kz 0E.+"U8re 0JvzՎlFoeh=A#':%*wF 05, -zIC2f }K"G e7Fp} NsIF;*7pc+˙XCɉu?ʇdL$yI1E#3b2!H!J 7*o,,JH!BS4oBdO$aZbsCws PS A2 pBOYA3;1a]$E+dpDni)zR|}9'' U+SLI!űU$yD5g=ZabX.OPp"uPYߨ0!C{=UB'јDʄBpbB#7;1 D6Q&D eBҼ/Lw'&L0^*cL8181YS%j 0eLBcB7&`uaB17+0s}2d-L'C3&XBU&$Q1)LhE\P>@&)&@V%, Qu%L^X)ijGy2q2„ A`Lf2A) y/p0@<@Wxj3q5 pbpazh-<i8Iq8@(m B4P 0 1'7ZcAJn&;d0LCrѲ>NT8(Ebp@ࠪ0LX_yg->>9dZp0&? >AP63--8@3i8=X߆vAV=?9 {샊,@RTWASTRp@p^APq%m*8,Ѥ8(;M֧$.^Ło8(l8HWd "&,8q=2Vq}}g+A B^q$:5dq";Ad8hMӲd cBqe `8 %)8_8l]W/GB\ɞBu)0XOCy(ï4Ig#n |V -^Ϥ״r F(Apa\ׅ q 8<&PO9ԇH"@jmEBX8@9-,@qr]\8P.ӕEqsu<ĝ69@Y9Zir R:*a %+Z' ܳ-Q2i@(tUhz+pKSIr=TDʁ$Yl@VTN'49V˸ p78q !q jS8rʁ,@1+Dǘ'i  p{A;R]q+(lFʁ@L/rTd1D,a\9ІP8B}@Ѕr j;IF5pr1hgx]? v)3%eamA)!^ 岱P   EޮmD^O  NXMޤ@P#T Zn_*V8y6ۺ /H YgȺ0d 7[j X@s:^@-]R(Hꡟ˭rkp5\n .[˭rkp5\n .[˭Amq}@(vLrkp5\n ~[,POȚ A COVl#9n?ya?_bIu:thO{,a1˜|qt_݋|}!P^LOl)Z'˔-[6SPĖ\>Z4I-3_PqvK`ƒ[_LjWS*ϤGSJjhj)GR7SK=Z,?=ZRnvϥr{{-EO{ 2AKwXZ{su_Rm#'F{pgB:N"x.mN0vmӧp=i)}"fRʹؤ>o?~po߸Woo?\o>\͡>AJ9}{JӺ˓]?U|ht=GukTt_}<_>pʽs/x|mhy n+dE-oՙ$k:R/"ʾ}!ƙ4W>IoB~wz[߂?tlA 7n>g#_Ʌwvqx<͹y߀{W)#^{ [\߽ySO˛%^R/W/tf߾p}zP9%Ǹ[endstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000003910 00000 n 0000003993 00000 n 0000004116 00000 n 0000004149 00000 n 0000000212 00000 n 0000000292 00000 n 0000006844 00000 n 0000007101 00000 n 0000007198 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 7276 %%EOF robustbase/vignettes/plot-fig-power-1-0_8.pdf0000644000176200001440000003346513465050121020533 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20190509180745) /ModDate (D:20190509180745) /Title (R Graphics Output) /Producer (R 3.6.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 9592 /Filter /FlateDecode >> stream x]ϓ%m_&l*qrEI%R"ڵ%!73of{WKyS $F//w,eџoo.O/>|Uh}qr~rWWA#Mf5L(k/!--\Ҟ+wx"4fUkN7BY~ <.<Xsog<{`[)pMtMKkkx^Aޙ'rݪ{Ba< xr͋{@aꔢ{ kr?m׺tu 9뒜 'R. UpvO_[[`l2e]ο_|ncu0O%kiLlX/u{?چFbAI1er t^cd H&F<_lR޴݆qvu Y5n ᳴ K:R>^cqJk6 ,Q:Q3ٯ&; k/6^Ȉ,dS/P<# zjVK}^V]μ«Hr?.v~k#a_zsdP" !CTh FAx-j X-ͼ{^+ۖY69D^06o~'  "j Jy= %Ҷ^}mYxm2]:t}wYI H֧Qd{!m[Q@4|}g5npD[&_k 4ixH Z@R61u 4ix&_ n[51%?&bc"㘈ɏ-15ލ~J"mc4>c]d^eĢ7nj2kxH Zno]Kխ3I1potM{qE4CR Sdi* VkxZ+fگYJTD֚BsjaBνХwCԪ,ڦx=cD}[^mk ߺuF+VS:Rye5VZ8ᵀ␵IM#lfם"b! tF6:XlS yfJGA:1wl W,:R~ҵU/3g~G0,þٰW 1V?~"]G)*R@nno׵UcYȂͻ[7P j5l{6D,XtY(T,Q: +տ4 =^H l*) h·;T*^F¯A`9|=<,RxŎ(3g,xCe9!|ٝe?_v'|xj~xk. * rr‡vd$ɦNx`U<ZANtۺ (8#'ؗ7D64AG6g*i I4JVkIW6Ki'OMI7YN6ɜ(*ЋtS6&64!xlOGMtnhRZRgM$q te&Mo.)6{5 r8NMP<%UZ娉v7t [IߧĨ>&ʮ+rS *5<$-!k`uoy`6:/N75KgoZq:_@q+cNk0byGol,r8S?ح5oxC#N 5&ˌkL\qscq">a4XdmnŰPV 5&vA j}v#gONm"-՟^5MIY +z>ľ0nb֕Ja7JyH[J_a7;uu/B i ml$q /6Ki'o+E}KGtQ*[МQJv0_n,A7}qo& Q8MKPpĂ;6@Qt(kT+( 7!n=d`f3lxk3z~W'CضNVzt⣡A7!8U(8NT@TDa` @xCf5oX]=:r U nz^ML~ F2#8ᵀ  Jߠ(|!^xło^ t,,n׃rds &|L3'lAQ &z-}=+g`) & o.]-Q&OShE3FFJR6Xt HN"RҥnIJK' r:뉁%Mm}]ٗ~I6pN _tR[ˮ뉱$03D P=xC0KADm^?܀z^DU7{w֍}gL?à$VLFA,=tJXXàD& I6龞gZB<# zᛍMi_PW4Tx=/hBNA6ry`Mmszoy|=49C~X1-r%9kr3|q= μ7&н aw0f^bB:R„ẗ́kU`xaUn@y=/nSaLT :RUa5EVWG nz^@~І !<cMޚ,X:>T'<cy^ϋ䍭m/B/+0Dn,)J~]/CA%֜jKynl"N\}` |/xݸH Ȏ (սn0'Vx"g_vɂ ü #72fX9LF0/F QL~u:/m=>gG8)՟bǤ[c0kf^2o%EOȖ^MlV<p%dZD!fy |b$N̜'FЦL vh2OF Mŵ=د: O@ 3(Aa jgP̡'Fe8e: nwĆ@. 5ͣv4o%AծwMi+$+W_>oBZ@]>_A]u%&8]ߧo.75Qea&*cLCR'Mh8-i,;KlxZ)F{M&ln";UkxH Z˚fMn8M5Q7|p_pcLlre/1QҠ5uֽklx%~(z}jbqاuND}g:ODyg(~᷋uxtY|5G~;?u[^'^V?jd D&b` D,^[` D~vc R0;on.Ò,6mw(H!f۠J^6<yݓܐ6J-d_|}JjlGаOhgfW͸UkxEd3hS]ĀrkxZ)qS?8iDžԾK[&WII ?%F]޸Z/zO ({kC &t׸ M!)h1,J>mv(\'lvNA>cE뒻/)LYg%& /-L hi 3vQ궮D1KMo 1A9iLFc%A{< |?BX Y86[86\YILm=ꎌ_|r'ٺob=`*CM32jl*5xKĝ fwd=Kҧmh=ߧآqgzC+b&j/4MTf84MIA hgC+)gY^Yw> <[oP/EG5ѯ]M{"3p񦉘&x6kb^<M4SlQq~ah &:NN04qX'7Muⅶ訟Vh[cv^V(D&hM8]ߧآFZCxkVD^{r*gIf.hCʇ&`}.-QR}UJ4;IwPÓP綿ך+5%d{ZgKZ}AuoAֶɗN|ƶg/i&34hƭB^īu{M]\M2YB^S>cur#=n&ixhBi^0nuhB6M 5M(~ȾE]E&DM}2MM&5}i" 7:h&r8}.G@5!&54ף&:dWZ7B¤ ͈md٦ ˥mP=gKvQY$suNIeѳM~J%Yۊ'_J;}.wu+l@_Vyaq@!ᶇM_z"JM<]5;ʤc3nzЄB^īUw Zk%\h=ߧ좣k" ti" H&X1Mľ5!xD|D?lPY 1h"ӏiIVnQvyem@>eE)tM{MUu{ UkxߋEMZhJj SvQv{4&XSq[/Zb=E.X66k))⬉U^Vh;:ZI⬉ǡ,L;iwoE|$ݘFlan_[Ww}{dMbؔ=D}>/'^>'_Ln$[Ƨcح=xjO>.8v'Ļמdd=uڛoO=]=KZ쿢/<6 X+WcI+8}FMb҈PBE#L+eĮ xH\p="]5{sZ%vo~.JuTklxp Z7LJXI,l zIk>h6<:ɏ[F*ٷxJ$Y\f^3xXJKүYQgM[^q~,$B`xqFG  [o*M}<% Εk  /G2i1[ wd0ʗp )cK&$ qS & edI 4ixZA͚"&ЄB^CRК^6kLYށ&e&7S9}bK4!󦉒&J:jaDM^5їcjBҸ&,ˋixDO SrNshl="spGqbB:6& A( PkoRM`9^OLn]`dS7T OG)$y,m=97kL6Un@x=1yL󀂺t(NxbE<ҩuDok.Cx=@}n*{s\Wb, "㝻25)|ƒNue-tr` ?6Un@x=1ҟ XՄg5= i I h X;iugl_|TyZd$7܎|xH Z@JA4aY=M/zO gzMĺ51B4&Rk"&rHA`4{xMkb/GMS*i̚'D&5Q&7zİ_gA$]wc? 2,`2nWa75^ 1`aG@o7_~w: yA뇾Ow#~WscB{*1G`Rcc}TXAMAO O 0(H`SЩ;ң~M^mÁxT ]%hݴ=erɶ͍?|\>LʇE|T>HE?H}%~[#e#[}{NɚWo~U],`UL(v?*)Zcj$Ccȅ BVȄY#2Y# G`¼h  ~>Yс=>q<;pE/ iPeV=/Ǯo_Ԛk'*,[_͛o?zo|˗>rk=N[J󃴒L'eh2& R=,z|ڭ 粼/!IómiZ=0;e`O[rkw>txy/n_~0zi|jejka-I -`x^>G mJXxo*$ffip6+)) F6Ki'}:;IS\6_'EzWaϙY?`X脓-$~}J6G'Q;I!?-w$JTҮ;u|'VacPF zь*ꆜs&@\V"6 qEX;)Z(;x`\V"k#ֽZN @\T/Я>wd(%yGFHޑё<κOP 찿{ƌOļo/яDXc, ^֣c ޏ,ޏW7~o+Z~r>a cP /;=By;//ƾ;'=A @P{>8/7>.& >1Cc=^7¶UmY_o]$G|3&iYp?D8Ht=#iIf&B aa8-d汾-!3o‘uKr?iy1s=~ww$oziZzrѠ}v=DzG gQ /#ڰk*)%NϿ>~eVt㥿|+ʿS r)n3:Sc˛Yț?ȟ!>S>*Ҿendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 288] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << /GS1 12 0 R /GS2 13 0 R /GS3 14 0 R /GS257 15 0 R /GS258 16 0 R /GS259 17 0 R >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F6 /BaseFont /Symbol >> endobj 12 0 obj << /Type /ExtGState /CA 0.302 >> endobj 13 0 obj << /Type /ExtGState /CA 1.000 >> endobj 14 0 obj << /Type /ExtGState /CA 0.400 >> endobj 15 0 obj << /Type /ExtGState /ca 0.302 >> endobj 16 0 obj << /Type /ExtGState /ca 0.400 >> endobj 17 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 18 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000009956 00000 n 0000010039 00000 n 0000010240 00000 n 0000010273 00000 n 0000000212 00000 n 0000000292 00000 n 0000012968 00000 n 0000013225 00000 n 0000013322 00000 n 0000013400 00000 n 0000013449 00000 n 0000013498 00000 n 0000013547 00000 n 0000013596 00000 n 0000013645 00000 n trailer << /Size 18 /Info 1 0 R /Root 2 0 R >> startxref 13694 %%EOF robustbase/MD50000644000176200001440000004053413465767243012762 0ustar liggesusers66887f2a4a84d1b8823efaadb4d2e817 *ChangeLog 6e042bd43f09e7cbca5089473af29cec *DESCRIPTION e4045afeb89e977dce25ae032638a372 *NAMESPACE 9f45d305486ad91f13f6dc08247b73a8 *R/AAA.R 56ce84f8f0f804587ab32a06eb965632 *R/BYlogreg.R 7478e0bb64ef0b7c0d7ab1b778496418 *R/MTestimador2.R 4bb57759710c1085df021a7787a59b43 *R/OGK.R 9d44ae8a81b6e72401cebc9d627cf6b5 *R/adjbox.R a56bb76d732a22208332d98e2cb72b97 *R/adjoutlyingness.R 959de6a22a12a273711cc6975c9dad24 *R/anova-glmrob.R 7372a74eb2fe5b4c97fc7315e924c234 *R/anova.lmrob.R 186ce151b871686bd85921f1843ed90e *R/biweight-funs.R b751a2a42e2fcdfba2f21e3c72ca12f4 *R/classPC.R b8872e7f5f158e3f742c71a8ae030ed0 *R/comedian.R 810d7224c354f66c9e8a00bd325e145a *R/covMcd.R 6deaedfb710eeaa98ddb990382b51a74 *R/covPlot.R 31276c72c47df1cb6aaadc1d91f38d5a *R/detmcd.R 79316c1ca445f99587e3b7d583656aed *R/glmrob.R 47e68c210ff891cecec23aa54369ec8f *R/glmrobMqle-DQD.R 24d0de58576935e718ea701a10b2d4af *R/glmrobMqle.R 3f50418b4f9fd47918b8881bab58b6bb *R/glmrobPredict.R 926c7fc062e97f0fe1c96aed62029f15 *R/huber.R 455840f27a99c6b8843c118b239d2d48 *R/lmrob.M.S.R 46d87091d4480ee269ad577c035649a2 *R/lmrob.MM.R c44c4c63ca4af7f5a874412041cfd44b *R/lmrob.R 8130354e92350a040360b85bd36995bf *R/lmrobPredict.R ee8e9a359407bfcce26eb0f77457f0f6 *R/ltsPlot.R 4d645592c866bbaa3ad30760d0ff20cd *R/ltsReg.R 2b51c17df6a87057417e8e181dbfe1cb *R/mc.R 621fe5b6d8087287f219f347b5fd5439 *R/nlregrob.R 5efd5210edae7aa92157d91ac3a9ff40 *R/nlrob.R 544e1b62b77ca840ea441f126a88ac9b *R/plot.lmrob.R 53800cd013755518211c5a47d48a345f *R/psi-rho-funs.R c302f6fb8c7bec7e0cccd798b33af5d7 *R/qnsn.R 1d34823c1885d395c7ec8af83fcf57b8 *R/rrcov.control.R 0ee6d9e98d6746d0a2159988002c87c7 *R/tolEllipse.R d1fcec85a50cd6b19476fde8969de2d6 *TODO f44e1e139b7102e54bf41ad845b211ba *build/partial.rdb 5da7594487a4180260f4897ad8895735 *build/vignette.rds ae030dea61f2f374479a49afe8077a6d *data/Animals2.tab 19e4eaf0977f829715ae36606a377bb8 *data/CrohnD.rda 238aac3ea05d306a86708f1bb39dcdc7 *data/NOxEmissions.rda 37e841b5fc4a056e5f931d43c9eb4603 *data/SiegelsEx.R ab736be6db06a387200ce0f6cdedc697 *data/aircraft.rda 017c2bbdd22e598584d8045afde64ffd *data/airmay.rda 20bdc21492ae84b462c7080ee6aaaad6 *data/alcohol.rda bdf56c95aa99517460a387f5fa1da399 *data/ambientNOxCH.rda 48a56104b0c39bf40fd10c8b19131eca *data/biomassTill.rda 3cf0efaac9b7ef93f8603bbf2d6cb337 *data/bushfire.rda 6e659a95f595d45c911308bc253c661a *data/carrots.rda 090b86c587b70c48367bb030fe2f9d15 *data/cloud.rda 4c30ccfadda6ce5afb38e46b07da22e8 *data/coleman.rda 1961f8041c73e1bf90c5847c108c5ae1 *data/condroz.rda d4d34970ff2fa110fbc21e3f2b227704 *data/cushny.R 03cfc37554676f5b36f9e269c0bd7244 *data/delivery.rda 7baef2ba826e98bb5cf01bce930ca49e *data/education.rda d737cb0f2d23c29f2a26e96276aaee13 *data/epilepsy.rda 7104e0d903ad8fc993b13257772413f4 *data/exAM.tab e941fedb2c9e4c6f71c7997f226a8d82 *data/foodstamp.rda d173f6f42e6ec9addb714375ae4b4483 *data/hbk.rda 2cf47a5fbdfc0f13ace274e431afe686 *data/heart.rda 46364afa47910f07eda003121c6205d5 *data/kootenay.tab b7ea6d1b22c131ee080418d729dc0742 *data/lactic.rda 692c41d4efee538cddea9859f6d230d3 *data/los.rda 453aeaf5b65b5d166f0b62d9b62e77a7 *data/milk.rda 8b64e711004e709cb46ccef1d935bf16 *data/pension.rda bb1fb728be30d2c32afc8881b0c5802d *data/phosphor.rda 1010341878a68422ebf3d09b2e053c5b *data/pilot.rda 735465ec97480fb1a6fe586e85792f98 *data/possumDiv.rda 60f04bab62d0679fcaf5231d7baa2e92 *data/pulpfiber.rda 5d86b54bde8121b6dfd3c801dddf2c5b *data/radarImage.rda 3075d6647227e039ec8fbae2d2a88b9c *data/salinity.rda 3a57947173594810a0e44798404afac7 *data/starsCYG.rda c44feedbebdeaf0fcd6419986b201800 *data/steamUse.rda a7a3edcf24050d5ff10e4b2367e16cd9 *data/telef.rda b8244eaef97350532d9124998430d396 *data/toxicity.rda 0b9904a2e9bf30bdfed52ca1f238257b *data/vaso.rda 40b3c269b89c039779bba44dd63d4a3b *data/wagnerGrowth.rda 2108ebd3782f664ce37eeb36d4d2bac4 *data/wood.rda 5735d59a0fd8350221e71c757aff3022 *demo/00Index 4eaa659c5287d2433f0c497b91501654 *demo/determinMCD.R e15c8af4649e9d8d1b3b0b830a432b0e *inst/CITATION 5d05206ddf06ffd03093afc086a6400e *inst/Copyrights f8796caa4e05ff1bc6d0c286f093ed67 *inst/NEWS.Rd da7f5aa078e39b61fc11c70f79acda31 *inst/doc/aggr_results.Rdata fd283291fb16f251cb6d0899d4e9310b *inst/doc/asymptotic.max.bias.Rdata eba4ff0f00afa90a6de4faeb8fbeb118 *inst/doc/error.distributions.R e87e964dd949e0d5d3ac6677cf8ce850 *inst/doc/estimating.functions.R f7a183bb4b7d87ce37875130350f2aac *inst/doc/fastMcd-kmini.R c8992760bbc781798df7d3dee8839d56 *inst/doc/fastMcd-kmini.Rnw 5027e691784425f34c5fed05e6b462d1 *inst/doc/fastMcd-kmini.pdf 2eb6dae5393fc8f1f3613ea7eacf362f *inst/doc/graphics.functions.R 9d80e79fa7397941eed29a8f50c7d119 *inst/doc/lmrob_simulation.R 5a660b44738c990b36d74be24fc51442 *inst/doc/lmrob_simulation.Rnw d1d666608f9329cb3f0ce0748d0ea811 *inst/doc/lmrob_simulation.pdf 1d3bda5839e2dc2af484a1b36aa22a6d *inst/doc/psi_functions.R 5dc951a423ecf0cea599f84e69eb1055 *inst/doc/psi_functions.Rnw 8b2523164d39b5e9213ddc71e9ea27c8 *inst/doc/psi_functions.pdf 8fbff7afee995686ab14f490bfdd3bd7 *inst/doc/simulation.functions.R faa9ecb70de3e867cb0b0cb8f56f3074 *inst/doc/simulation.init.R e571b79e7316389c9251508b0a64775f *inst/external/d1k27.rda 2697fe55d9d2cd8b788e735f21fce763 *inst/include/robustbase.h 3b7fab3b9da94411bd1d0c034981aa83 *inst/po/en@quot/LC_MESSAGES/R-robustbase.mo 463fea674a2a6d565904c9ff4a237599 *inst/xtraR/ex-funs.R 130761ff8fdad503b3eabb72b95676ab *inst/xtraR/lmrob-trace_lev.R b65b9ee10513815ae1ce3d469496299f *inst/xtraR/m-s_fns.R a9bcb5636de95b43522e387217b7ed4a *inst/xtraR/mcnaive.R e36c6c8c36b8ad9ff096d5cf2af8e5a6 *inst/xtraR/platform-sessionInfo.R 87049deac986592f8a86dc25370a2832 *inst/xtraR/plot-psiFun.R df9ad021e5fe4f589da91f5ee859ec35 *inst/xtraR/subsample-fns.R d59c9d987e5930b5518e5f115a12fc93 *inst/xtraR/test_LTS.R 572dbd79b9423edff9cc507e2bc03f14 *inst/xtraR/test_MCD.R a29d61634cbf8831addff6c901033dbb *man/Animals2.Rd f74822d7eaa8f575eb1a133b76efd316 *man/BYlogreg.Rd 64236af69ca22e65d23c6fded4f74428 *man/CrohnD.Rd 7cbd5f66086eca6ed4beb3e1e0245cbd *man/M.psi.Rd 6824d0737bc148c4db2525b346dbb22a *man/NOxEmissions.Rd 03ad3f0d318f3e0dcc15ef2889b96b28 *man/Qn.Rd 083dcbb9a8612332ac5e46ecf5815782 *man/SiegelsEx.Rd 332d8723d30fc25441a2c48841df93ec *man/Sn.Rd 25a1ba1b32bc98c977906b4df6f895f8 *man/adjOutlyingness.Rd 2d55a673f0629969605137dfab644389 *man/adjbox.Rd 5620e518764114ddfa3c9bed65944a7a *man/adjboxStats.Rd 01186d1727fe4e272216d4c47c6ec907 *man/aircraft.Rd adc69c47692a6374530016dd06284aab *man/airmay.Rd febe72ca3614813a364647e4613c2800 *man/alcohol.Rd 7ea04b818be06098d3d5695068c3aa69 *man/ambientNOxCH.Rd 9cdc701d15c5ff632f93274c733cca56 *man/anova.glmrob.Rd cbd3b489c97a7f8a2af5f6f5d061da76 *man/anova.lmrob.Rd ee08a50d99ae4fded27606eec359ea0b *man/biomassTill.Rd 28a095234e74bb3a25b9d5b97245e6d0 *man/bushfire.Rd 162c39b3fe90cadbf7ef351522e3a282 *man/carrots.Rd 072f4e54832ae70552419daa0539f165 *man/chgDefaults-methods.Rd 2aa4b0be1d4af9f052af28d677c7cc08 *man/classPC.Rd 81bd9b7ce5691a0603f3cf4c7c6bd7eb *man/cloud.Rd 94ce65cc80d2c304bac8a73bfc2eda4a *man/colMedians.Rd 1c06929304084ebd0f599ef857aa8714 *man/coleman.Rd 5e60414598e3a152c9894b47d1d29128 *man/condroz.Rd cea2c1cd349483c68821a16dbcbb7fc0 *man/covComed.Rd bbe30358136f7b604a11df1e242e0edd *man/covMcd.Rd 5cf99856fcd52c766bb062890465eab9 *man/covOGK.Rd 58a839ee1a490ad81e9f460aae800dd0 *man/covPlot.Rd 7a4c3b20b2d890cda14449a844ec1954 *man/cushny.Rd ffc71a09096c7ff759123bdb52811331 *man/delivery.Rd 951faf63d07a05ff53ca1d58ea8a65b3 *man/education.Rd 4c4b144e1b46f1587eb78d9131ee9454 *man/epilepsy.Rd 98afee28d8bfdbcccd61dd43e23bc1ef *man/estimethod.Rd 217b4a7355c2af12eeed03d3a1dbfaf1 *man/exAM.Rd fe8fec8c68bef4f7d04e945e70e650cd *man/foodstamp.Rd 5d06f4a85eae6ab0ec6eed5d0d3d9acf *man/fullRank.Rd 9e691245c9e0ba04ff72965a52165f89 *man/functionX-class.Rd cfa1f98cd587600bd8351e2342f7f2d3 *man/functionXal-class.Rd 97a382668f28bfefd36f0db8ca3d2614 *man/glmrob.Rd 93e97c9b0bc9b0fbfacb666b1dfba939 *man/glmrob.control.Rd 84768b70921a2bbc585b95b8c4ed16c3 *man/h.alpha.n.Rd 4f7942aed9c35ec6b6a1d9a392c81fb9 *man/hbk.Rd bacfc8c873568f6330746eb508e1c07a *man/heart.Rd d3e4618cc9fd92b86971e8d75f6594a8 *man/huberM.Rd 0e5741ffbae2c8ab72d6c806a9875a23 *man/kootenay.Rd b3904bd9a90c4a1744c7a10287729796 *man/lactic.Rd 34a6eb5be483a909147651b19b681a87 *man/lmrob..D..fit.Rd e6183185f2292fdf05771c2550765062 *man/lmrob..M..fit.Rd 8131bf1a7dbbbc58ffb39fb9e22ac3bf *man/lmrob.M.S.Rd 59e9b9004213e7e068e5f9e920f4f118 *man/lmrob.Rd b1117eef380ac38b510ac3945f60e430 *man/lmrob.S.Rd 2a4cc24063f1744473724ff594019a60 *man/lmrob.control.Rd 823296c1001fb79b67740695fabf0577 *man/lmrob.fit.Rd 4379d781b3928f1effe3369fda627215 *man/lmrob.lar.Rd d622e40aaa83ee46cd18eb6358781768 *man/los.Rd b67da02f6a6e8c88a465f9a6a1ab1933 *man/ltsPlot.Rd e9f2e9950c217f3a8f5e3419b9bfcfa3 *man/ltsReg.Rd 9540c513fdb090b227802467f1563ceb *man/mc.Rd 7f90043269895933a5037812df80e98e *man/milk.Rd 35a4e8718b06d2eacda6e04a62b0a7dd *man/nlrob-algos.Rd b2368e7cbec1f54b7786c89f30613a3e *man/nlrob.Rd 72c943d8738ad54f1699937f1dd2d905 *man/nlrob.control.Rd 637c345a708230a67f888f30b112bb33 *man/outlierStats.Rd 73ac7b614b68fde4b56425dcd14c3a7e *man/pension.Rd 8cd4b8129699cba4317d4811937a9556 *man/phosphor.Rd 59bf70cca397d8ccaab9963f939462db *man/pilot.Rd 2bde675f6f79dedf55cc21b474d98d40 *man/pkg-internal.Rd 2cad8d62257bac1749e3c2f84871b2d5 *man/plot-methods.Rd 526daa81051c7dc411213912c5177f93 *man/plot.lmrob.Rd d7bda339270d599b6d2e4ecd57119711 *man/possumDiv.Rd 666a83e065be3fa28732922ac7bd0e2b *man/predict.glmrob.Rd b029d6d4e196a3617062e86120d20703 *man/predict.lmrob.Rd e8b57d5568e0ea910048d168849a0a8c *man/print.lmrob.Rd ec23a0d599e8694219f01f037dfa2826 *man/psiFindc.Rd df4376b1f8f500c99501d230a8ce225f *man/psiFunc.Rd 525bd5bf9d6fcfbfba6aef15f78ee9dc *man/psi_func-class.Rd b51db5a87f42e8420d22fdc796aefce4 *man/pulpfiber.Rd 4b5dbe96651ca82d7e74684237fcce5d *man/r6pack.Rd 9154f4c2ce5e1179e4269952da7108e9 *man/radarImage.Rd 565eb7f5a8df64f6b100a3303b5e7f12 *man/rankMM.Rd fa74cc0d6c0aedc3cf0ba3965253b17c *man/residuals.glmrob.Rd 1ffeeeda93ef6545e9e4f3e5ea7c3040 *man/rrcov.control.Rd f8da4665f87ad768f876c4b416ba9f72 *man/salinity.Rd 6cd67616798c0a96857335d61d48961b *man/scaleTau2.Rd 7cf104b65ebcaf1e15f4c4af1ad24ce1 *man/sigma.Rd edb9e05b5fe937a216f49b05858768e8 *man/smoothWgt.Rd 09298c1eaa7ddd8522bfd610facd935a *man/splitFrame.Rd 2fb66f97bca59867ac54b8be9c7bc214 *man/starsCYG.Rd 4526219d6f49e21ae4e58ca17be1891e *man/steamUse.Rd d7189923c3153490b9abb2d43a52e440 *man/summarizeRobWeights.Rd be2fbf543226e5b43fcd4a3e1ffe8f9f *man/summary.glmrob.Rd ae03d2d8c3d04a3f4e6ce0aa9c0b3cf7 *man/summary.lmrob.Rd 8219765216d02b84cdbece813ef82fe1 *man/summary.lts.Rd 48c1775d93b2517b44554f48b0090c54 *man/summary.mcd.Rd 047c1d860a5d9d936abc2fb9de819554 *man/summary.nlrob.Rd e8d1c797428107b3174396b0d75b40b3 *man/telef.Rd 1c42aa239211b4dcba803d644dad427f *man/tolEllipsePlot.Rd e68c4fc92a63e7562d006321f3cf637f *man/toxicity.Rd 426909afe46975b17f2409fb50e17f41 *man/tukeyPsi1.Rd ed7afcd97d343cc453602f724b0a0df6 *man/vaso.Rd 64cf61e38da1d48c16c348cd89a5df83 *man/wagnerGrowth.Rd 971d8b3f3dca2ffec5980cb423226f2f *man/weights.lmrob.Rd 7b5a626e11db95ad8ea3e5135b940ac1 *man/wgt.himedian.Rd d85c77f6ee7bfc5f5d6fc78ef947f7e3 *man/wood.Rd bad409b62eb1e349f8a1cac398623ffc *po/R-robustbase.pot b5ec8eb59d50008ef39073a7446433e1 *po/update-me.sh 6670f8885ea9588ef2905cb7b368a500 *src/Makevars 174d300e4520673a0114f4d6eeba98a5 *src/R-rng4ftn.c 37cbb87bdffad7231d34bdec470100b2 *src/eigen.f 655e9b218b8498eb5ff97bf442a89a4b *src/init.c 118fbdf946b64ba207a3716eb4da4577 *src/lmrob.c 2397ce9a159ce5e0c987cc7a459bb807 *src/mc.c 4cb3e4ac19a8b7ee4232996f55240a13 *src/monitor.c 8055799ab8de47bd92904a05e4104a71 *src/qn_sn.c 6d2330779d4d08c3a60aefaeeed9e942 *src/rf-common.f 672312bc115b2b46722c634002a243da *src/rffastmcd.f 932d395bad3f2bf6e452b346cd6d4e27 *src/rfltsreg.f 3bda168ffa6d97a853c1a9458466c030 *src/rllarsbi.f 93f5113f34542949020302b4d70e9c14 *src/rob-utils.c 5177a6b04c74ff98b963f12e8df223f9 *src/robustbase.h b9daec6e4c1dc95affd27747a2e3990d *src/rowMedians.c 1ff820c02e26de8ddba524fdfc701c63 *src/rowMedians_TYPE-template.h d2a3478b9dbb06d56cbf729dc0fe9681 *src/templates-types.h a3a2fe76cc1fbb676f92d2da764fcaa1 *src/templates-types_undef.h cb5478376d46bcfd4dde4cd398669f2f *src/wgt_himed.c 8ecf1e9e5dfde44f7f7b21d443a207c3 *src/wgt_himed_templ.h c7d491092e303aaaec9b1069b8c2e57c *tests/LTS-specials.R 53111611c3e4dbfe6fdd55f89db16ba0 *tests/MCD-specials.R d0f66667fb798a04e30148e6c355e8cd *tests/MCD-specials.Rout.save 9695a33ca8982b07a63265750c1ea7ba *tests/MT-tst.R 3c9817216164b3ab1d79404020d63233 *tests/NAcoef.R 11c698f717e3f586e8aa7c83cba30d9e *tests/NAcoef.Rout.save 2c7b55a37d3d91bb7ac967daa654c0cb *tests/OGK-ex.R 2061968598e36f8ef9af0f6b3afea782 *tests/OGK-ex.Rout.save ee5551e06a97b2fa119de6e770e5e3a8 *tests/Rsquared.R 58387af397fbfad9e6585c9fe48a680b *tests/Rsquared.Rout.save 71ce3f6b1a05667b2f4222d6f23a2a1d *tests/binom-ni-small.R 06ecf1e2d46b910a4aa0d648c48ffffd *tests/binom-ni-small.Rout.save f6db581dcd9c17bbe848995b33c58ebe *tests/binom-no-x.R 8b6f16685db3b472f480f71639dcb552 *tests/comedian-tst.R 4fdc17e44096a893d3f2536213577153 *tests/exact-fit-categorical.R b2272fd2825490cf7ddeb2aa14f6940c *tests/glmrob-1.R 860395b194cbcf95736cf42be73f53f8 *tests/glmrob-specials.R 00e92a1b77c27acc29837e01d5dc3ef3 *tests/huber-etc.R 509afaffe676dba8daa7acf6d87423da *tests/huber-etc.Rout.save 5ac1b923d36f8584ec612ddbb26ef6cf *tests/lmrob-data.R 2e0755a4702e435a64c3bec8d3db6a9c *tests/lmrob-ex12.R a0c6cceca14a3711e7ede18bf6c371a8 *tests/lmrob-methods.R a3c9fb6d8d31269fa26e1e4d3314a23f *tests/lmrob-methods.Rout.save 977544ddbcbbcbb8074105bc15cca7af *tests/lmrob-outlierStats.R 014e3868bc91234440d8d4da80b4e394 *tests/lmrob-psifns.R 7b75cb19ec1680fab600d33e264b38e2 *tests/lmrob-psifns.Rout.save 0f1cbd30b2149227618ed2f7963cd4a0 *tests/m-s-estimator.R fc2e03a5567789ba9cf6dda9f2c17173 *tests/mc-etc.R 7b598b917a0c94d71dc42976716d401a *tests/mc-strict.R 2bab7b1aa160f43a795083bfefae8fe2 *tests/nlregrob-tst.R 55342e590e33911657c323f94f62288a *tests/nlrob-tst.R 4b96541019fab86c18ce257ed20460b4 *tests/plot-ex.R 8cafc5fadc80e7b402fb8d08e556bf27 *tests/poisson-ex.R a2ccec3324ea3363e9fc2dcbb0aeab9e *tests/psi-rho-etc.R 39e466468e228fad715bc725f30eb678 *tests/psi-rho-etc.Rout.save a9b4b4ba78cc408071e294b4969bf99b *tests/small-sample.R 76445671c74a4ba3fc5e6ff008d902b4 *tests/small-sample.Rout.save 52017cb52ed82c7653b3b50ff0c1a8fe *tests/subsample.R 91a7dbe2f427b417675bf21252fbd4ff *tests/tlts.R 2f36514f3f511d80bc2f08c296161193 *tests/tlts.Rout.save c57791d9c5d6c50999a8eb5e16a3adc6 *tests/tmcd.R 49ffd56e4f0501dad12c3c0949ca0c14 *tests/weights.R a974a5bac33a1f4c825fd68756da3a03 *tests/weights.Rout.save f6807248307073155470346a7143e3fd *tests/wgt-himed-xtra.R d81e954c7ef07d754c9cd4f24366c8e0 *tests/wgt-himed.R 89982aaa18849e249041ca8761104538 *tests/wgt-himed.Rout.save c8992760bbc781798df7d3dee8839d56 *vignettes/fastMcd-kmini.Rnw 5a660b44738c990b36d74be24fc51442 *vignettes/lmrob_simulation.Rnw f8f4087d16a966712ec4c9bf4f1ca2d6 *vignettes/plot-fig-AdB2-1.pdf c2dc2458d6861d6ff4327518fc390f82 *vignettes/plot-fig-Mscale-all.pdf 71c0cb91ecdd068710e4bbe721377205 *vignettes/plot-fig-Mscale.pdf 694df664fa3b08d4f1e3bf17392de472 *vignettes/plot-fig-cpr.pdf 78c94412a26bc79f879cd574a835af12 *vignettes/plot-fig-efficiency-all.pdf 8e41351100778f298f02aa461dc56f48 *vignettes/plot-fig-efficiency.pdf e8108b82123428ffbc5e2ac6a41b0900 *vignettes/plot-fig-emp-level.pdf 4b640902373c1e1cc1e0798ca08a2831 *vignettes/plot-fig-example-design.pdf 8efc6e9dd7ce4ff3251e45e2014b9cc4 *vignettes/plot-fig-lqq-level.pdf d4dd4160ab59a7a097228380e579616d *vignettes/plot-fig-max-asymptotic-bias.pdf ec23c7f7040b098cd65778c75c27ab40 *vignettes/plot-fig-meanscale.pdf b8c2559dc6c03cf60fee5ec9a55273b1 *vignettes/plot-fig-power-1-0_2.pdf 7220d979727459a32c093e6d2964293e *vignettes/plot-fig-power-1-0_4.pdf af21a3a25916f7e257ba880a852ed922 *vignettes/plot-fig-power-1-0_6.pdf 1ab36f0dcaac1f7f8c56e18e50cf9568 *vignettes/plot-fig-power-1-0_8.pdf a82af775ca6bbb656aee1ab271d3491b *vignettes/plot-fig-power-1-1.pdf 0fbe9efbe439ac0349b38c366df25c3c *vignettes/plot-fig-pred-points.pdf 87ee8577a2792ad6bb025f226d105086 *vignettes/plot-fig-psi-functions.pdf e14367376fc8adcedce9b3d44d879e04 *vignettes/plot-fig-qscale-all.pdf 1b557e800e2001130d7c039d4965fdad *vignettes/plot-fig-qscale.pdf 479c92432ef04a7baf3fe53b5772aa7a *vignettes/plot-fig-sdAdB2-1.pdf 277cf26d21dcfdcb6fd0f1688ed879b1 *vignettes/plot-fig-sdscale-1.pdf a6c98bd80d1752a98e3b91c5106a9e0c *vignettes/plot-fig-sdscale-all.pdf 5dc951a423ecf0cea599f84e69eb1055 *vignettes/psi_functions.Rnw f15d124e194c8c441ba8bc0833143243 *vignettes/robustbase.bib robustbase/build/0000755000176200001440000000000013465050176013531 5ustar liggesusersrobustbase/build/vignette.rds0000644000176200001440000000062413465050176016072 0ustar liggesusers}SMS0-Q=ы)80ے1M:I?($o_K1 j hԢqf L=z# K5qI#ݙ$тpucIfyY\n}+/ ,4SAX9 '+9ݻ鶄Dh݅LBR0zd` 4”)b Rks $SPMzb ǝ_'~zVW/-JުPoV(#$^fƔ'+N&CNxбZ(-$sh; {Yg8RC_HvR8ִ!B V) j bٯzUȣXmqP } >\robustbase/build/partial.rdb0000644000176200001440000011670313465050107015660 0ustar liggesusers xv6C,9C |.ܽWW6f@ߝk9vlG_KWlK,+I8/;qHNJXȎqVT=LnU4Vv]uԩש/H$mc$upvpMOk>ZʣŒJ~Iņ_*=֚c8{Ӷ_l0C^y!DvF.x$h4k{(}de %N`.JMvyFTI'R*x"UgcZQ;4ӑGrmy5U} ;:i|s5miECC,gJ5riYfnX1sL[`z9[3YtbZ^ Whw +7ڶf,ro Vx%¸녞≨^:zNC'q٦&X'Cx$MZ=bYTi1^?f*zcU4Y,E;+"IT)WQdfury˨8ݾb$'uxgqu|^:+^?~҄OG<Ųk@jQ˰u[w2lG76;ZVS}eXIwc˃ ʯ1]jyao]z,;YP*dخŗO4ie=i`e͏k/v˗fnlU N5} J(5,ͦD r*.jk͆]u&q^@5/tWNZxK1AD|ϟh-JK!KEGԱRwKfȳ@Gw,umNU]d(yA&?8UUt[$ 9Pǚ} #Sw'DmN8b!Wf g <U\f!ϘLɴt׽9_$jay!04ۡvb_ iyO9&l]pM̒b)T{@+Q۰aEva^vX =V3>)xc Ez?jrO)RfyJPކ|}N R @**Z|) /)Ȕ)0,Csv{KfՍiyVLN-tNT!KM1>@eD8 Wɘ VcY5 0«Ff8}ş^LQ^ !OTC3Yȳ<#VV,rW)l-Q#"LCNGfP.ŇZqN@hIȓ5 Q1.@^BDC!HRiLt ]n֍yHܒӐQtFEx=olJzi2tk[ڢM{ ?Sqݪ8rp"_̼n ϖ\ބ|joA$≛F :T0`]Y\؝P]Wio 55nT۝hU^ GXe _r[ou>_ K 5.9G/Ң>a`>m3+r΄ԟ ؝u#fخ$,dSzG\47iTk>DI+D][M8yf!g,MO+f C!KޙK-m?_^;Rg`F6 =µ4?FU,)> R=ѭU^ۡ +sR5x1z1&la#A0 TU5WWTR?p`dJ$ګ4Ы!`zrѵ2[eUDji.tU|`Ϋn~%|p!VBt|J0 9] ie[ivPD46(ψtPdP{qg'nK ݄렒s@ԍ JaiB]D,硛_V6E;-4 \,uZnY=RniQ(I|a ߭4=&eFYYL{s} ɣt!F8ON23*;LCN۪hk5LkZT knuǼ̯ܒ 9[<'Av:1y {%G!F7X2Lː`?s{Y[Y#5cH|()?.;II5|Z-2W,`ОjI] |7qoFyUTY)y"3|qކC2Rw-wZ"e"09eU]dm2QHD%?shrَ(EFgŋE `릳'=o ?a _B'G3keVR*x1⨀wne d v'NݦV/,d;4" Gy*$ u{[qCVn<7;\k*-Ϻ}h3'7/ =iZAZ<YjvOӉ9JO1&k%uJZJ=M1 $`6Q4EzG <hl mŊ۲6uЅHB~ЅZo;>|g4IFsFS\s>V [ u$%yƏ60 .hf? D 2C+2q>X{=+|5M W) ~Kr9Z~)djB[)TW&^,j!IPMcmʋMW>hIZIOArO98tnqh.{ /.셵 +ɨ Z:.@rim` K6>xdWfĂzvܤio!$+۟X9&ADZH}[H6}j3OO}ȓD}Xyjb!GXd.Оivn☎L~߃X6vZ&wWی^GS$xX- UFVVBAށky<#$!hÀ:+Q>e1 ʦq:en S"pk{)4QOѭ3lN4ڴ̮nn~Eۢ/3QhH:J y9S89/LnPCUt<ﰂIc Яu2@Em]@Q&x̳!A.lߏxOSDN@m fBA픵܆; ۨZ<+0.#7,wgz_ y/[~xl> 70 ?QoY ҄jHEМQv=qV!*~U&'Y3 ]+وu &䛭%*n]r Jf }E4b,MP`7Y`޷n*UOfh ){oZQ9<L[@4t*,5F1$8u EhT![I]xԽuEp;lz9emij8y^ϐjNf ?Anȸz+1@bފ]ހ,u4>1a`r:i_18x6nX_ r3LMvh(9C0>|'KHQуzܡ%K^s7># vaRkL!&2D.oBaGz z}LM@w'm.RbgšS'2 'ՓO=a3JFe%n;P 7A@jw@,/얫DlvDTvtǏnf-]5s8 y4gyo*.@^ƀn}7ya Hn#<wraE]s8T~^ iK>8٪DW+VLt S cLu/B\;!Fdb>5~]@n T1d6 |Y=__$O 7.YIPABk^rTOo["a 1,5'6%u'k&6mѣy@/x3$yc':xuD0Nu$%C 00Pkې'RĞLNAr?y*E]4q>eGI=ȇQ:jyj+8yWCIዱ!k Dxbp2YjS!uix[RME`Dq a ,z17f9z"u?3Ԕ> d9n>Y6ED$ 9l!Pճ'F ӳйhyE }A>WO@K|h '&=X 'u]>Rhyy$Afu૒us xr=;wG?IԮa;\ф6⨙>S(H3jyؑqf{<2:(jD(AεފI prf–I|CVzܰ52NU29D2,73=f;[F~ˍEߤ++MD&us%Of;#L+nlɯjEc#Ke閶vo ˯яccS :A#m|!u;M rC4(Bv? Y}J"; dxX̿?<;^5'{my5, dA5-krJgY&Z u]e_*A, Yj ' O(YfWmz%Q"Bgէjٔ]ilmuC&9:}qVvl#OD|RnνMw[ۨ)j%Nrcb[x#ҷnj7ؘm+Bm{Hᓕ:wW2c{3 F'acrؽ4pcgK۴k z%< yQ aZ_c)Eb&b[s܎m(y:+:SNߣ9ed\FmG8CI EISw/C9ъ{B4#BBsuC[n ~:F) SEsǵr(p܁ņ#Fb{ a"%]10 16a@{իEq8 9['a`rZ!^Rw 8y< Y4l0NBT!P=l$s z80I2_9!쁬v[rD*䫭w!8y@rEk#NɂjC"ģX*{J&n-ZXwC7s"Wm,hz*AcC?Ά~;ъNSDl;hH]'04]4Y@Vׇɪy!|O>ˆ|zyɫ0׀MZ=Q,ߘ@1݈`; m[3"'9AU_MDV. UK FI(!AxAQINЮy1U2G(~D#R Sz ~+7ݶoWL:|֬[ٻEԺQQUf7Ld&< 9]n!Cm RK?/r6;hD>KD=JۼEjoXۼEMmHq!zRhM6iR<Y}/}z{D,̔1|2㩺 :XuP5([.~_ _NA:$ht)ݢ Dq:Y*Tk x \2ৣlv>TOQm t5D2d ,4oYEcDZo @Vy :Gh.6om/Ր _ kh!iu!u)(Q:+֊UނhCV;LJwPM{6DE^Ƚ7Rwx1B!K6Bn!G9 B.(w`Շog|UrK+ot䢮LC> @30oO>$0e؛jw"&cUXO.&M{w4{}OѦjwE~k@0p*,6oiz Zu~nZ_ ܾu$DmrB:R7|Y*|B~$G)Fҿ$<TdHOܞnն5KJNF ԝCJ^\(_;3loVǮo,wE(Y.fG ieyoog u.AȃYl+Ic,!(Qv/aT*b3A+Iݰ u n0ZetN`F ys3 {մAa\=ϓF^İdhIp"ҫC sc}Ʋ31ZXFRLE7)Mxn@15H\A:;Xr%ga7OR Rsb '!;<˶47(7-L9dub/0noiۆYrjBc'XE {܎Bu~ ̍ʯ#7y[&Z1y%zyJ=Ge- )dހ,5S=d%h8xi\fO_|i,Y5wX՜%"r7ջtᮔ/" # 0ƣtIJjok@<p-|J r[dpWZ[hGuw\3=0H^Ƚ[?@<qf(M4?Dpvmɻޯ o7>@Q7t7p!f g.$s4a0ECr և$xܰ%F9_q^Ԙ p z7|˕kiz{Vӿ !< !tI aMY1L g2A`_eۮ0-  K H];p\} @<ž}cQKOAeД0VEL' G9b ;&>$lӤ~*xb_Km:iQjEQg}eR[J\ͼw g+,nĶx֛ @V!lڤ~.xb79iוpѴB;!QR< +wB~rwaV< kac3t xK،Q}J4Xj #-ҶZ남&׀O!?m&ugMReI8GP}u6FHmd(jOhK]Wa#Y ,u)1?Xw׆+̒hOB,TbFGaȄS7jR/xb7?CcF{س,lCMK/ZI3Liul1(%}?ZzR7ݠ,"Brsz;<ڐR i\@<;?Y6G5sX2iT ar2!''qTɏ+WρOKPK}#>6I F>}Ny~)ֻM.B^߾IRn6gZjGJJOD}#hAk>6s&'G[o&L8y,~s&ݜ&5] ZFkl9[]1˶g /RO| 3Q5S&#ģHce m)rHZ,dvbO|g5N8y\GO !d_ <2DՃcb''a?jG]ل "r xvC}[zQn1t۾3koϬO{? [:-]mrKgW[Wݿ"BdiWK% vCM\C^oH-` rtI䎭0M≻''m#iOT|ģX< {Ͱ[^3YwMuKgӱiQ.jP-fCODܲ~ :'IdS!nH/UBԶx.)=-&{l*?h*[[e6Meػ7YRnnɪ 0;"[qj/B>;3lܸoPiMs^LU)]]Rb:Ldy7MkEV.꿏7 |0M;h}fH2C$r}k|^%̅≨fm9NŞլvִ6Gu{47>6 #BH@nѵU z8Y}Y}L!+xh WWEæ}5fPg$B>QtH!tF㐚)/Q Y*}S_ 9dJ=ڻ< 1WIrCмnǚEǻ!L$p X)RAV_HxDTgm|fLn !jCVOӓvcɱܤp&:/!K%`WsW5ƵflYrY˰,[fa͖  oCV c+74uC&\56aa A 8W0z>Yȫ{{E{S*~?*A= eOځSw^峬4u3|bM /( s{nBeEKȇW5ƷWVmw]ɰd};k/@0 9L7̵ﲒat YYe|7 c6B~eQұ( $B<_ `&(5?BVwѧ9FSJ(=K?hva8q27a)`gŽ] )c/Su[k[BeOQ={%SS(#(]el7u}[Em3^;>.BVm.1ZX7ȒfY{ w80%g4xt"J;")wJX !&3 J8 y݄@_?CU*[| %'3gZ߅v,d6R?x s;c ؊A!?{|*yPwj5bMMLO p rz4W5av&E/ Y|3KL )~N1x2z6'J18ѯ[żĞ;wmRc cZڱB? {]6H܍5Y`F 3iGa8Ϟ-Sby S2=K'+,fٔ!<\ ވ:AVZ{/2ɉY ;592rބp s#r&]MF8g>Y[V9mS[W?uLhήFZ4RCgWrcؽљ{#ȄB^1f⣕!{m ZbI[fc1})i'{rDU ^aXӌ,;YYotϷ{O҇UBG⾔ET ŨiܽV6Ϯhyȅl荌\skfiyOF)Vq] ; eifo3|*mmquJe|a*(9_/P}J}|q02X_jqt̡Z/̈_VksЋvOz[)lE'rٛ|;V &3V w fdٵ~Ǜ(s^H@Մ*억Z6^#PA,'nl-k6%e\Ջ8&S[$YjCFHѪΖi(>|Y4 $s#Yt^jaeY&T'[vucI];"䋇ŒKː}'4Vn1yA?*;Ql5??Vs EHPZ aϡFԂBWL#P53fb3<Y%uޯNX5e "D_.A?+h]QC^r<Yn };È7C|rodrtM DAV\a'U 7!G7;z@%[o)K{Z8@!)mūV-,E* jRv`T ^KD5I%n?hO*e?$Yj#f?$Ra!gHUr 8Q)VqxxpD57aEgw.*Pf7F%^tM}h2?6uj^-k>(^j/ނ>9\eA繗. =?a\ycKVvCVf5\?{FbhnfvݖN] K8 Y}K (5AVW8^Epůl^p(+뛚cl.5T5Ƴl:Va쨣ێ=hL&"xG;~;Awe O07z,eߧ{Vѭ =s> ΄#,vaaJDkv̊Qv]V,fO܀& n2ӧBU*457-4&$\'^)^}ja8q#l}e*mr{ }0 'Zj;@F7,vRyOs Z!8^'em `z]S%Jyķf˃5'8Gqo1]/E*Lt*-M0`M8 ֣ʬiVt}ݟz^&.u˵ټp{NrAE%TgMoK"kڟ8%[m#>}̛D;N=Y.hiB4ARH}ODrb/ +³rT1D3C@;rHH8 )AӉш;6ܽ_χW}}-ovW|;g>zڗ:toQZ5; ?^/soQj|tmUK|)qt_)zj_8 e=7$ zbo?qc5{ትnsFZ붗*=V('Ql[[6\wfA|}_Z+;A+wz4~@ZҴJ`uk^\Y_l[֊`uw7֐^.o 5iu粇> aiVlŮ}_{=WGqQ5, {(~ֱo OGX 睤:#}k_ CC~^R +dhI[E]}yԕi1E̋7xc5kC{+ܕG/!T^5쎳zDuHK5 ح(@.D)FLq?'>\8a/ĩXzK?mzm Y|yCJQUak0/D 0-a`3wj W(/옭i5MWY/jٖ׋h4eJfw9 aշF,߃Ss<@Qq̍Qf' I #2Ԯo34 U)y[oNr!Z8R5XvCD/tb|0 ų`7˶,*_%o*UGZ.\}Rf7zsp.<A~*WK(j(궴׿"C ۮ8Y4 ge4\acͺg˞h o@ 3巹W6z"wK^li7αQF8`Lx=eO o,EYQ0Cum\] 'mޤQYѼ YdG6IhV9[4Jnt:Nm`NYMIP%]+[;~I飅)Oq5-O(c4c28P$wbjbKɞ@ariJG]zɕ^U+jkiIםHm^xށԷPmaSyDjd$D%f vC!g4xꪍ][e&ge]q/um;N^ oaUL̑ŷCmޣsh^ 3(Z8pb.Y).A/ INIRԏ1Һn028X _nlpoG㝧Kj@2FʏQrqwoGccؠn4~Ζb;vt760nGl;6ƏQjwZE'Dk[cf<[.i9wC_ W$xyh4u|n-ņh-sǐeMi.DyC=Rܭ6 vml󵓽EN;,U+tͪkxɼ=wȘCÖC-!S0YC+;i v }`[q)W O8 Yp+Y>,u!BBۓVR"xZ Q@~'hԿ@>"_-B [_Ƕ (nRHS{6U<r$Yh_bz!_~ fm.-3/$ LAJ<3H ',3 iB[ ~z>];wIf "R''CyâW!Gx:4^&BW7!l}LoAV?wB1lZpR"r)SOIi9#j T nr;, 7xbc4ODބYc6f{5L /(9ju syxOOd3hD kߤ 3JJAsDMX^>>;]ʢFX ^[DbΌ|6D{ (S94Yjn☎gƆ7r~֊Zq>g&~oݲ+$&¼&pDdj|H!Rhs.LA(QE4z#c:vXHxr0z;e,ДӬ'p&"6ʢVޖ+\e=Yj;,]–N_O<[z[)4BIFVV4-7(g+E9,p rNA|/2OG{;(Ζ^kk`7 R'T) @GRb ;(wZ ;wT\؝PMrA-r&?0k-u&b \\2Lb _g:ۆL 3摺`da^i^|vWsɂRvLg!+mh>̐@<U^zi\ޢM~)xZs!H?R?"s{Lغ븟Z]x鮫#`%NC:?skEf*%Kt$vRQфW!_Uɚ+/F8= r8BT ndjشA '+)5`"2 ̊{#^=C xXO4/`Iuc އ6:$ ~;˾LGUoLQaW`+MRye @9KwBڳKQ(@>&u!K-iޤ8yPO|~A/Me8yL4 ] ":SQU0GCy4>dC|ߨV4 K8yR7&jwz  iRlcaCð5 ,5\ki>PnD2R?@<ȉC2R@]RAYƞSyӲtb CQ3giN>ң#$(BZ q_!w/.u!>IduCQ-cff{@<-sla8XZ^m zIz8x瞿f Fލ ʛt7MgLdѺ&}w gn2EGf ,ewLKf)@rM996&6pB&!ۢE /wEMnJNTvB ZU;Ԟ|&~N{'v [K^"vAvm on<[k8s&Z4pnjh@nϑDk48~A7dv6=6Q-mp]ە oYjLz٭3Lcc?`<\2* TBm} D:~)ϓy%QgK)?XM Sil,;>EBV&cU,hU,eT%lZ̉߈̔nA),s=*Axr2 7`K]$f߀~ё"@< nČ@2#|" O%zȓx% խ rEsij\B9 ϻԺF9_Gۺw4O6onk2N -S9Is.E 8Mg!KeEѤnxIJ1M(4Qbb2|]h1ŝCaieӦT镢*%m9nnߣ&\Oy4J:^6 mtS8WƓҨȳ\Ք' ^§F]@pviaZ&X׆Ȏٚ`HBﲡ6X n ]H]w9VG8QB2i5o`,G4Rw; ̘p Xd }G п<::,)@V7)᰺"f֭mo3rzo! Ȍ'a!l6 ӐӭwD6d  .;)SjAV?)$|Ht>*,[7*=Vҝ-St B ;8"W׆t#-(ge x}5+ȶeQCD!ϷX0j 3RhjB鶲[K!&=ho3UaS!"WK1S!u _SN{ބ|3JGȌB`H6Rw 8YQ?`8 YY^qZغ"AxԕbCkROĖ"uKqOi4 ?mӶ wtsUpTO$RKI=ޭzcnZCNd4pe٨~D[ |Y}~M\rQ6raGUDxʰXT/^,ul_T%S+cE,pTeH] xrvH,Cn>&dNI#]L̽Ywǝ\7O%u \H]d@!0|tyya:-Ja }",7lkX|"UgGZf!?VEG!IzBH;>4QJmֳf$R4sV~Ҳc9;WҙgZն T-+opԚqA>0~&q w[jys[X>n<2h|CeHd4pj,i7et-L#6Ϫ~@8 Y:m!N}H9kl%O6lY>ukuVZ^N[Y- Ӌn`3˜ BYR|94+jQ9<7ħ9Xq#*i" <9eiRCZP 灗 ]4QY&iRwi u#Gl:LNjG!&=LkC[&+EB$7zhcXL%Bм^:"e(WͪV9s xKg^JB}A7;#{u6K 9qB2 9 - A,eR?@[x o@51}b5atwTʥZ[p4y:E~-H$:sJw7X4%Oee&-]QnB } RF2p@4"jDa 8 p~,u Ns:b9͓!FJ꺀W!Km3RR,CMkPveY@J!e u&A8 y:?rC]Q!.kY  zT!ICM7wV$#JuN QLB)87m!#-њ> Co}Hn /߼Ibgp =v'QVoox&d9(S$tCo[@1}Z|ㄈ1>()?WEZ*?kczf)Yeô&#!KWT,PCC/U]ïA}:hp R(Pz ;8R8xb_~ JuKY{ 7R^|Q:viލwC% Y=|oE ϧfzmhnԫJeu@,~ qRVSڗO;ĂL%N_C~ ;O:A~/~E E]|cYJovA:r]?b,FޔQ9 > GwA@ݒw_KZ~,EZEԪ%4dK] A XDb՛/EDxrG,B!­aӞc߂DcA" 9 !1,P{Zg'uÖtlR&zIz ۸3[aK0@<^#Z UӸB!6aEស*j?U@"ꜗa=?i^|Ml.#NC>>w† }D瓺/VOcC!>M٬y$P=±B76 qߟY(H-^,䬒iy-:GBaݍM!ϷߑQ7_ `4nLf7Y=ZE'f6Ĵoz]q]$rWҢ}->,$fSnX|E$nw "ODob4ѝA^ ԷdJ^|?jQ0bv9ed*q(U aE됥y/R<\M|üLM oAlRSnDUSYSO㩩d? E=̍SUf폰Q^sT ;UVdYbA6C%uo*[ 5b(󚢖LnCV^>*ٿ5oZn$ZN uG~>d[LFd!Kjх$#u/ K)H;w!Ku<x]nYIK w?[!,5Kl1B'sn8 y]ASYS?<~-Fky%JLԵ 5:u2aARtr >RǢ638n{|wu|,mD26(wxeRwx>ݲ{8QC"FR7|Y}FKw `-凖ҫy 2WuZYGAqֻ8χq|Y=Y/cJIk?#zKrg!XM9 fh~&h"s-Aw/VOQ!<Yn<߬7]uL:i"w,-1CW6mD.dڰjj(UMW㩦i?P'-I?T!=K8YA3c0b!4*En3ճ]ݿ06KS3L^&^#gO&.s)VI+ ?'< taj#P}_#ڸ~4PUKP*V,pr#׀])J!Kkfx]R~AkmmWY `t\WaB-$' hv`dufD@N8 p^dh%,19 3RۢK89JR} NBVWܓW=i[XLo- 9;BgI]x1M>_*0pr .Ե V0z` f[z*ڦ.F3&ۤ? ? ZW!K3Z|*Ϣ @~z['u9st׆,1x\,"ctڶV+z)j2˯ vVs?8kwq.tF?XO8d7ǝ4 9@ځdvߥy؊Ѹ~)lt峢C?/FҶ74w@$4dyPN襪-Q\/PKG!Kx;b<YjbVۑi3LNg!owJi_s};01N KM[` jiVJMdxrt7f]1#u/!;"cQ寀A~/(Կ@<гisg=n؟TXQ.`/7R< 9>:sɉ{S2U1>Uqq~ &4: O;>;#D$ }&2=)} |U=@<УasGыh .]nݭoxJiY}N޻wwrl\*7!ߌ*.oAV?sF_%6)=u}zt<S ҧ Yӧw =iu$_c _77.mĤ +F9n`󯤵}z.q 3[ZF㱑 wk6 =u}_g"cn(R6G )^9xeIw ˒!43s-e|":I0^uy(teIk`,<^LeI4 %`,{<^9;˒z3s8 m!Ħ YjX !u^ȽR6xbr}/{l,;16qO CN1 RٵT]0zY: lk.;651%Dl뮤]Iuݕ+@<Яeϰ9F߯J][%2]3ϴ`d;I/,U_OA]c:}{,;pԩVq<%'FF߯g"3c9 pm !㱏 K:Rݕ^rlY-'f=_tvhn{R4xix]6ϠA')팟}N炔Z̲11NArbme 9:u2)4dʑ-2G'cBO!?Yg lZ=v}%V066tK/;]F]m2K{I7̪g@ȺWy1divEg:K s_캨um{5J%ˣֶzU߇~X 4&a>~5הIc- W,(aH]'rrX+jyA\wnen#\I*#2o 6%]`nn뼇[׋NZIU_MDcOhdp=h/@d.n\v-Ïl r%KεUi֊Ha(b'K(~W{2ĩm/a4 _R2ftrQ.%8N@"uׁc!uS'yx@ip"\޿14%lɎ[+0"94A0\ބ|6L.oAV?/2T7@UT)ӖF]QRn݁ӈj )OEeTMɍ̀%J'F됯GfWa D8yPd{T5>%56.Qc Gw?A56|Y=;HQSl]8,Q]O7MM^BU": ߤ>1g("$N$ xͿ6f&:]Dls6wPg➓!9Iy s;5- 9hfG.;19%c1X m#"y;~IoNBey=x̿&h4>ɫcm"vyҖvh>]hwy@Aw4h7GPN{yd-U:?f}ģX*ÌkaYhѶb}]̲X.QiÐ`luK*: V,8eE.O0Kߴtۦi.i"I[_g /% EԴK=I4J vnǚEǻ!&c"Re+Dm;092u6@<YdP >3YQ.Bڻ zR M l{󪶆txõvsPY]N1W'tP$LCNGJй@͵|60Ynξ۴"㘖ekkiZF>*^0(-h@V?n&<0BXw+2 dYWRz+ ׻|ې\U ^IdUxzM͍LML wD&,j(,Gv|KәUm1U=g2msUX꧎iٕ{_+Fjp(7̟0ʍesccFXnjdlېKY}huK#}k_Խ77 o a͟f^gYh1ԛlq*im~?}/wPw7thTŨyᵲ?-Ywkuͬ:-/IvpXi'hw̎Eeg_rBK/iwT:7ǑC Bz[K-OH3YPm /5U۹flEن_ڊ'qA,ulaoi[)$L{Ob򐲗<؊[tQf3ANkOC>]=Xnb0vs+DزBvܐnUWkۺoT3WL0Y~gxc5 އ,jT> :|YQӳ[di96 vD[7ZX1vh-CL8f[nc_2Ӷ5mXfIԺW&8 ˭7k~Yom#hhn|l:;99V{7BL'ۧu!kV YݦZ,vmY/V5)z@<n[[ՊƺG4 [,u˚ߢI ZTKxK" :G oGR8x$2?q.rw ,'F;eȗ# B.K#u+cHIUQxN>S ,tS-}Q{&א#q;=Y?6_*nل¥bL>}7dR<A0hؗw7o 5a?pLdt|uh@iB!P)ڊj1K't@^#bb[w}Cflڳ$elJqťީt.Pn|9ޑHڞxEc4}׭E74Zhww r b#n;-]AOuA!uPN7xcSʜwك;FZr@r2ݯx&Tf|,USgd̦E4;ӔnM^˰klF%[h{IU-6vg/r!_n3\?}&v{nٌT]3fm_fJ۬=D o#ueԳHfZx׹ 8N@ 9Nzca8Lj 2aYFaT;^CQm;cV餌^vh3|sơC4;;`w*nt;w>4O͈%1'qe]m3z}=褢YXb#.k{?x|o@xo~ 1Ak<#m~+ HsS]םZK{q 42krIRq 1k`y- a,'$X˓LRpȂoIe>K4fh}uf8^Р|.+pK. tUZ^0Rs\‹,)K vVzjnƜq+ ÌMwgae7\t>XyD+++λCBUͱjh؎k;WH_oπ+atG5::*^pyKy<]yE׌M_9Fn]yQ5.ή"gqP.) G%vM&)&C\L=sm{r1oP `'GxajrlTʙ+DT)' 򺀊!+t|(|x"5hz|WC<46q B*ZiECkA4M*ԟ `CX17Vԕ8ҎJ"NNYK”;&hqU  ;JzģX*[Lnں̙nֶy۲k_1{Qэ-.֊%m-oQ,E9[ÌrX-[%ceѭe]ҺVoyG/ԗ?m0%]+ YȳgXP6L۟UXQ֋r7Q8yF>c8 p7`M+:˓kc6H#&g r- .CyAG<2 R: {'xaP ?M`݁9w[+Ko3ۆފE`Tb[<{*gFp +`Z 魝}&U_!$f+|CrO~U:=h>Q,DV|bwx=G(- < Y*M4 x(25[r/jAf:Ԡh+'6#.! ! Hu`rVٜg[.ϼLz≽C ΟC$8d_H;46ˬ9!Cd$>*ERBnInGZhHK!wK[oc>`Df,ݩZewe8 yX:Su+ǁ!?l}L2yIM;eR@Q铺tqvzۡ;}R?@Nk|b3<-x$MU:T'GT{zHgb6hM2|[[D}.@^8`tJDLFך(u&8Ъ`R6 u&7H)w#cD 2<Yܾ$Inp93kV9C,r ñ`,8C~m \RwZ:?\ʻw A^Ly&q~Yp5YZh E$jބ|3@ oAAUuoikze|ӻ(SؖҰ#%KQлUC^Liߊܖ"ad BǬ.aFVfx+lZuw˻I=x 5ʺf@m$pQWB|3o5UpT GԺː.;OM8Zz z*GOAV4)<àc/S4‚~6Ƚ[hdP,]u>L/@ɗbW=T\o^rêm$: r 1oD')AQ,"I 8qZ;7ͲE;Qu] ӌ{qY Z0FdYg&|Nj1֏DI"dH+l]߉YR\I&BغpDxrGCLH]xQi1K%u@X.h3 Ax21$[n,RKC47ņC?$5H&3gZߊpTJ:VD+IvUgCglo^ATڶf"&q=2&0ޫ[}@$ LԵ!w+9 MItI|du(';;0phK9jo{/ǫhw xBȔW@>YU_s} W`iԷd QC`462˃izK+wɥCK3|Gt~sG/L2Z%| ,0fnۢ｠wnoΝ_%bHĺ^M}ug ݾnSȜi8|[6#ތz0/wNNeWF^$0D(hz%!i|uˎN{/^qԝ^|Qvn-i~lQS" 3a#Cn̈N%jEsBBtKJ>8G`E`xuw'c9b&H}."$z##f.ޜQ``fնF Rk idDfzgM{&{Z\y00zl 7>-p݊ή5"u;킷 IQG*Na 9ckZy@HWk.us~+!ӧh>AiK|3KYy9˶bώ_ΚhӇrG}EEK"Qkesҵ튖?,\ȹ5׺fVI[?w;8B㴓KΠ2kvQ~WnPҶ6˸F&+񅩎M>0!|7Pk_cmi[ccC5_J#mq޿Tm皱fk7N6~䃼Y.|ÐҶRHD|'Zs[z97۫䵃2}}~ñ(ʅ(OD]e\ՋXxF)œ]VuL+D`?~UjH⑬Ɯ~t^$uaI$>jDT #jFB0R`-Q}|n8,jDrzvn8y}_ؤ߅ =b>kWK%} "BζްI]?ph ]|p ^9"98^tR81L(.=!o ZynZNx*}ģX,f9mj׊v|-m*P-RgӃVE+QHmZcE!W3Zze.7{7tMۼFﴭ;Y XN{ BxieRרoR!S*[N~ΰ\Z`Fx 5eДixsoW0% T~ϕq]r-Н:WAP-EW,?TAֿĒ uS6L/X"ԻŗJH̅}6ŭ 8!9q"4OBԆjVe"M7ûL-/М/ O)s`8: 0+LKCY=\ǿM" //1yBy|tM7V0JtY[fX`;)㰤03 e]DF3t1 y:Wz0v_CnUdXnx)âܾ>H^7l8EiDx ԍu^9ǑȮ2̓ RY)B J (aB' EcFIgDT5 -H+DxFG681y;(ȉ~ `7[4^بqW ≨RN2䵉 A n< \1\/m- O^;p%fiQ掫{\~׾ N21m,~7FW>MO\ͺf%<:ndg5)_,T<) M( wӛ?>t.robustbase/DESCRIPTION0000644000176200001440000000543013465767243014154 0ustar liggesusersPackage: robustbase Version: 0.93-5 VersionNote: Released 0.93-4 on 2019-03-19 on CRAN Date: 2019-05-09 Title: Basic Robust Statistics Authors@R: c(person("Martin","Maechler", role=c("aut","cre"), email="maechler@stat.math.ethz.ch", comment = c(ORCID = "0000-0002-8685-9910")) , person("Peter", "Rousseeuw", role="ctb", comment = "Qn and Sn") , person("Christophe", "Croux", role="ctb", comment = "Qn and Sn") , person("Valentin", "Todorov", role = "aut", email = "valentin.todorov@chello.at", comment = "most robust Cov") , person("Andreas", "Ruckstuhl", role = "aut", email = "andreas.ruckstuhl@zhaw.ch", comment = "nlrob, anova, glmrob") , person("Matias", "Salibian-Barrera", role = "aut", email = "matias@stat.ubc.ca", comment = "lmrob orig.") , person("Tobias", "Verbeke", role = c("ctb","fnd"), email = "tobias.verbeke@openanalytics.eu", comment = "mc, adjbox") , person("Manuel", "Koller", role = "aut", email = "koller.manuel@gmail.com", comment = "mc, lmrob, psi-func.") , person(c("Eduardo", "L. T."), "Conceicao", role = "aut", email = "mail@eduardoconceicao.org", comment = "MM-, tau-, CM-, and MTL- nlrob") , person("Maria", "Anna di Palma", role = "ctb", comment = "initial version of Comedian") ) URL: http://robustbase.r-forge.r-project.org/ Description: "Essential" Robust Statistics. Tools allowing to analyze data with robust methods. This includes regression methodology including model selections and multivariate statistics where we strive to cover the book "Robust Statistics, Theory and Methods" by 'Maronna, Martin and Yohai'; Wiley 2006. Depends: R (>= 3.1.0) Imports: stats, graphics, utils, methods, DEoptimR Suggests: grid, MASS, lattice, boot, cluster, Matrix, robust, fit.models, MPV, xtable, ggplot2, GGally, RColorBrewer, reshape2, sfsmisc, catdata, doParallel, foreach, skewt SuggestsNote: mostly only because of vignette graphics and simulation ByteCompile: yes LazyData: yes NeedsCompilation: yes License: GPL (>= 2) Packaged: 2019-05-09 16:08:32 UTC; maechler Author: Martin Maechler [aut, cre] (), Peter Rousseeuw [ctb] (Qn and Sn), Christophe Croux [ctb] (Qn and Sn), Valentin Todorov [aut] (most robust Cov), Andreas Ruckstuhl [aut] (nlrob, anova, glmrob), Matias Salibian-Barrera [aut] (lmrob orig.), Tobias Verbeke [ctb, fnd] (mc, adjbox), Manuel Koller [aut] (mc, lmrob, psi-func.), Eduardo L. T. Conceicao [aut] (MM-, tau-, CM-, and MTL- nlrob), Maria Anna di Palma [ctb] (initial version of Comedian) Maintainer: Martin Maechler Repository: CRAN Date/Publication: 2019-05-12 10:00:03 UTC robustbase/ChangeLog0000644000176200001440000014236512722336306014214 0ustar liggesusersNOTE: All newer changes are in ./inst/NEWS.Rd --> `news(package = "robustbase")` ---- --------------- 2014-12-12 Martin Maechler * R/mc.R (mc): fix for limit case where x[] contains +/-Inf: pass +/- Inf to C * src/mc.c (mc_C_d): and replace them by 'Large' = +/- DBL_MAX/4 2014-12-11 Martin Maechler * man/adjOutlyingness.Rd: fix another old FIXME: * R/adjoutlyingness.R (adjOutlyingness): cupper=0, clower=0 now computes the classical ("symmetric") outlyingness W/O mc() call. 2014-12-03 Martin Maechler * DESCRIPTION (Version): 0.92-3 * R/comedian.R (covComed): new from Maria Anna, tweaked by Valentin and modified considerably by MM. 2014-11-22 Martin Maechler * DESCRIPTION (Version): 0.92-2, released to CRAN on 2014-11-22 2014-11-18 Martin Maechler * DESCRIPTION (Version): 0.92-1, released to CRAN on 2014-11-18 2014-10-24 Martin Maechler and 2014-10-19 Valentin Todorov * DESCRIPTION (Version): 0.92-1 * R/covMcd.R, detmcd.R: added Deterministic MCD as an option to covMcd (nsamp="deterministic"), function .detMcd() * tests/tmcdd.R: new tests, for covMcd() with nsamp="deterministic" * tests/tmcdd.Rout.save: new tests, for covMcd() with nsamp="deterministic" * inst/xtraR/test_MCD.R: modified to test covMcd() with nsamp="deterministic" * NAMESPACE: export the functions r6pack() and doScale() to be used in rrcov for the deterministic S- and MM-estimates * src/rffastmcd and init.c, R/covMcd: fix a bug in nsamp="exact" 2014-10-17 Martin Maechler * R/adjoutlyingness.R (adjOutlyingness): reverse the defaults of 'clower' and 'cupper' and fix +/- swap; see new note in man/adjOutlyingness.Rd * man/adjOutlyingness.Rd: the wrong defaults came from *.ssc file from Antwerpen 2014-06-30 Martin Maechler * src/rllarsbi.f (rlLARSbi): got rid of warnings -- and many GOTOs 2014-06-11 Martin Maechler * DESCRIPTION (Version): 0.92-0 * R/nlrob.R (.nls.get.start, nlrob): now works with indexed vector parameters -- FIXME: at ETH have testing code + example data -- unfinished!-- -- on nb-mm3 not 2014-04-30 Martin Maechler * DESCRIPTION (Version): 0.91-1, released to CRAN on 2014-05-01 2014-04-24 Martin Maechler * DESCRIPTION (Version, Date): 0.91-0, released to CRAN 2014-04-24 2014-01-30 Martin Maechler * DESCRIPTION (Version): 0.90-1, released to CRAN on 2014-01-30 2013-05-22 Martin Maechler * R/lmrob.MM.R (Mpsi, Mchi, Mwgt): now all work via .Call(): is 9 x faster for n ~ 4000, and a few NAs. 2013-05-18 Martin Maechler * R/lmrob.MM.R (MrhoInf): new, providing rho(Inf), i.e., the scaling constant (rho |--> rho~ = chi) * R/lmrob.MM.R (Mpsi, Mchi, Mwgt): renamed, exported and documented, from former hidden lmrob.psifun(), lmrob.chifun(), lmrob.wgtfun(). * TODO: now has an extensive section on psi/rho/chi etc 2013-03-27 Martin Maechler * DESCRIPTION (Version): 0.9-8, released to CRAN on 2013-06-14 2013-03-06 Martin Maechler * DESCRIPTION (Version): 0.9-7, released to CRAN on 2013-03-06 2013-03-01 Manuel Koller * R/lmrob.R (lmrob): Adding weights and offset arguments. 2013-02-26 Manuel Koller * R/lmrob.R (class lmrob): Objects of class lmrob now store the robustness weights in $rweights (used to be in $weights). * R/lmrob.R (weights.lmrob): specialized weights() function for lmrob objects. Returns prior weights by default. Robustness weights are available via the "type" argument. 2013-02-14 Manuel Koller * R/lmrob.R (lmrob): setting class "lmrob" also for unconverged initial estimates. * R/lmrob.R (print.summary.lmrob, print.lmrob, print.lmrob.S): improved handling of unconverged estimates and exact fits. 2013-02-07 Manuel Koller * R/lmrob.R (lmrob): compatibility to lm: 'assign': labels of terms used for fitting. * R/lmrob.R (summary.lmrob): compatibility to summary.lm for: 'df': degrees of freedom, a 3-vector (p, n-p, p*), the last being the number of non-aliased coefficients (used to be just (n-p)). 'aliased': named logical vector showing if the original coefficients are aliased (was not returned before). 2012-09-11 Manuel Koller * DESCRIPTION (Version): 0.9-4, released to CRAN on 2012-09-11 2012-05-14 Martin Maechler * R/lmrob.MM.R (.vcov.avar1): fix typo in "posdefify" 2012-03-05 Martin Maechler * R/lmrob.MM.R (.vcov.avar1): "posdefify" FIXME (negative eigen values) 2012-02-27 Martin Maechler * DESCRIPTION (Version): 0.8-1-1, released to CRAN on 2012-03-02 2012-02-24 Manuel Koller * R/lmrob.R (lmrob): added init argument: string, function or list. * R/lmrob.MM.R (lmrob.fit): added init argument. * man/lmrob.Rd: Added documentation about init argument. * man/lmrob.fit.Rd: see above. 2012-02-22 Martin Maechler * R/nlrob.R (print.summary.nlrob): use full call instead of just formula. --> shows non-default psi() 2012-02-19 Martin Maechler * R/nlrob.R (nlrob): now use nls(...., weights = *, ..), no longer need hack "put everything to the RHS". 2011-12-23 Martin Maechler * R/nlrob.R (nlrob): for zero weights 'w', the residuals accidentally where NaN. 2011-12-12 Manuel Koller * DESCRIPTION (Version): 0.8-1 * src/mc.c (mc_C_d): fixed bug in iteration; see svn log -r 272 & 274 2011-12-09 Martin Maechler * R/adjbox.R (adjboxStats): fix the sign-error thinko for the case mc < 0. * man/adjboxStats.Rd: document; test the reflection invariance now. 2011-12-08 Martin Maechler * R/adjbox.R (adjbox.default): new 'doReflect' argument; default 'TRUE' ensures that 'adjbox(x)' behaves symmetrically in 'x'. * DESCRIPTION (Version): 0.8-0, released to CRAN on 2011-12-09 2011-10-24 Martin Maechler with Andreas in train to Fribourg * R/glmrob.R (residuals.glmrob): provide a version of residuals.glm() which works * NAMESPACE: residuals.glmrob 2011-10-11 Manuel Koller * DESCRIPTION (Version): 0.7-8, released to CRAN on 2011-10-26, r270 * man/lmrob.Rd: See also extended with lmrob..M..fit. * man/lmrob..M..fit.Rd: Extended example with function lmrob.custom. * R/lmrob.MM.R (lmrob.tau): moving calculation of h to the inside of the function, so that obj$qr is not required. * R/ltsPlot.R (ltsPlot, myqqplot): removed superfluous title(). 2011-10-11 Martin Maechler * src/rfltsreg.f: add 'implicit none' and declare everything; new gfortran gave (correct) warnings. * R/nlrob.R, man/nlrob.Rd: finally fix "fitted.values" * tests/nlrob-tst.R (new): start more testing of nlrob()! 2011-08-09 Manuel Koller * R/plot.lmrob.R (plot.lmrob): Fixing bug reported by Andreas Papritz. is.null(x$x) is always FALSE since there is always x$xlevels present. * inst/doc/lmrob_simulation.Rnw (f.gen): load(file) was missing the proper path. 2011-05-24 Manuel Koller * DESCRIPTION (Version): 0.7-6, released to CRAN today * inst/doc/lmrob_simulation.Rnw: cleaned up chunk headers. * inst/doc/Makefile: added Makefile that runs qpdf after texi2pdf. 2011-05-23 Manuel Koller * DESCRIPTION (Version, Date): 0.7-5 * man/lmrob..D..fit.Rd: updated reference to Koller and Stahel 2011 (now with volume, issue and page numbers). * man/lmrob.control.Rd: updated reference. * man/lmrob.Rd: update reference. * inst/doc/lmrob_simulation.bib: updated reference. * inst/doc/estimating.functions.R (robustness.weights.lmrob.S): fixed typo. 2011-03-17 Manuel Koller * DESCRIPTION (Version, Date): 0.7-4 * inst/doc/lmrob_simulation.Rnw: Fixed problem with paths in source(), save() and load(). 2011-03-08 Manuel Koller * DESCRIPTION (Version, Suggests): 0.7-3 and added xtable and ggplot2 to Suggests. * inst/doc/lmrob_simulation.Rnw: re- or moved dependencies that are not required or just needed for data generation. * inst/doc/error.distributions.R: removed dependency on skewt. 2011-02-10 Manuel Koller * DESCRIPTION (Version): Version: 0.7-2 * inst/doc/lmrob_simulation.Rnw: updated title. * inst/doc/lmrob_simulation.bib: updated references. * man/lmrob.control.Rd: as above. * man/lmrob.Rd: as above. 2011-01-28 Martin Maechler * R/glmrobMqle.R (Huberprop2, ...), * R/psi-rho-funs.R (huberPsi): replace pmin2/pmax2 by pmin.int()/pmax.int(). 2011-01-26 Manuel Koller * R/psi-rho-funs.R (psiFunc, chgDefaults): default arguments are now also set for the E... slots * tests/psi-rho-etc.R: updated comments * tests/psi-rho-etc.Rout.save: updated accordingly 2011-01-20 Manuel Koller Updated reference to Koller and Stahel 2011 paper. * man/lmrob.control.Rd: updated reference. KS2010 -> KS2011. * man/lmrob.Rd: see above * inst/doc/lmrob_simulation.bib: updated ks2011 reference. * inst/doc/lmrob_simulation.Rnw: see above * R/lmrob.MM.R (lmrob.control): setting argument: KS2011 instead of KS2010 2011-01-18 Manuel Koller * tests/psi-rho-etc.R: added tests to document bug in psi_func class and pmin2/pmax2 functions. * tests/psi-rho-etc.Rout.save: results as they should be * inst/doc/lmrob_simulation.Rnw: added table with tuning constants used in simulation. 2010-12-04 Martin Maechler * R/qnsn.R (Qn): even better finite sample correction, from an analysis of a Qn simulation. (Qn.old): provide, if needed for back-compatibility. 2010-12-02 Valentin Todorov * R/ltsReg.R, man/ltsReg.Rd, tests/LTS-specials.R: the raw weights 'raw.weights' added to the returned object * R/ltsReg.R, src/rfltsreg.f, man/ltsReg.Rd: options nsamp="exact" and nsamp="best" fixed; Added 'trace' parameter 2010-12-02 Martin Maechler * tests/mc-strict.R (adjOutlyingness): adapt tests to the fixed mc() code; using some tolerance... still need to be tested on Win/Mac/.. * R/nlrob.R (summary.nlrob): do not compute 'se' if not converged; update help page; (print.summary.nlrob): print "non-convergence" * man/summary.nlrob.Rd, man/predict.lmrob.Rd, ..: update and trivial changes. * R/qnsn.R (Qn): fixed the consistency constant (thanks to Peter Ruckdeschel), slightly adapting the finite sample factors for n = 2:9. 2010-12-02 Manuel Koller * DESCRIPTION (Version): 0.6-9 * R/mc.c: fixed several bugs, consequent use of eps[0] and eps[1] to avoid numerical problems, fixed memory corruption bug that caused segfaults from time to time. * tests/mc-etc.R: see below * tests/mc-etc.Rout.save: see below * tests/mc-strict: updated tests and results * man/mc.Rd: see below * R/mc.R (mc.default): updated eps1 and eps2 defaults. * inst/doc/lmrob_simulation.Rnw: minor cosmetic changes * inst/doc/graphics.functions.R: added some helper functions to ease working with color palettes used by ggplot2. 2006-10-27 Andreas Ruckstuhl and 2010-10-28 Martin Maechler * DESCRIPTION (Version): 0.6-8 * R/lmrobPredict.R, R/glmrobPredict.R: new more careful prediction methods, now documented in * man/predict.lmrob.Rd, man/predict.glmrob.Rd: and no longer in * man/summary.lmrob.Rd: 2010-10-13 Manuel Koller * DESCRIPTION (Version): 0.6-7 * R/lmrob.MM.R (lmrob.psifun, lmrob.rhofun, lmrob.wgtfun): as.double caused input to loose dimension attribute, fixed. * inst/doc/lmrob_simulation.Rnw: Updated vignette title. Enhanced aggregation procedure. * inst/doc/lmrob_simulation.Bib: Fixed entry KS2010, no more trouble with bibtex. * inst/doc/aggr_results.Rdata: updated simulation results. n = 400 missing for now. * inst/doc/error.distributions.R: added cskt distribution: centered skewed t-distribution. * inst/doc/simulation.results.R: small changes in proclist generation. 2010-10-11 Manuel Koller * DESCRIPTION (Version): 0.6-6 (Depends): Depends on R 2.9.0 (use of grepl) * man/lmrob.Rd: Design Adapted Scale estimate renamed to Design Adaptive Scale estimate * man/lmrob.fit.Rd: ditto * man/lmrob..D..fit.Rd: ditto 2010-10-08 Manuel Koller * DESCRIPTION (Version): 0.6-5 * inst/doc: added directory. * inst/doc/lmrob_simulation.Rnw: vignette containing simulation study of Koller and Stahel (2010). * inst/doc/lmrob_simulation.bib: bibtex file for vignette * inst/doc/graphics.functions.R: R code used in vignette, graphics helper functions. * inst/doc/error.distributions.R: R code used in vignette, custom distribution functions. * inst/doc/simulation.functions.R: R code used in vignette, functions used in simulations. * inst/doc/estimating.functions.R: R code used in vignette, extra estimating functions. * inst/doc/asymptotic.max.bias.Rdata: Cache of calculations, to speed up vignette making. * inst/doc/aggr_results.Rdata: Cache of calculations, to speed up vignette making. * .Rbuildignore: Omitting temporary Sweave output files from the build. * src/init.c: added function to process simulation output (used in vignette). * src/lmrob.c (R_calc_fitted): ditto * src/robustbase.h: ditto 2010-10-08 Manuel Koller * DESCRIPTION (Version): 0.6-4 * inst/CITATION: Added my name. * man/lmrob.control.Rd: Added more information to "setting"-Argument. * man/lmrob.Rd: ditto. Added example for "setting" argument. * R/lmrob.R (lmrob): Moved call of lmrob.control to function code. * R/lmrob.MM.R (lmrob.control): Changed setting KS2010: uses lqq instead of ggw. Fixed bug when using unknown setting. * R/lmrob.MM.R (lmrob.fit): Check for initial estimator. Issues warning if neq S. 2010-08-13 Martin Maechler * DESCRIPTION (Version): 0.6-3 * R/lmrob.MM.R (lmrob.psifun, ..., ghq): cosmetic changes; cleaner * src/lmrob.c (rho, psi, psip, ...): cleaner; partly faster; also ok for x = +-Inf.... * tests/lmrob-psifns.R: test psi(), rho(), etc -- also nice plots: tests/rob-psifns.pdf after .. check. 2010-08-13 Manuel Koller * R/lmrob.MM.R: changed the naming of lgw to the more accurate lqq "linear, quadratic, quadratic" (by construction of psi prime). * tests/lmrob-psifuns.R: changed the naming of lgw to the more accurate lqq * man/lmrob.control.Rd: ditto * man/summary.lmrob.Rd: updated documentation to account for "cov" argument of vcov. * R/lmrob.R (lmrob): warning and check for method argument improved. 2010-08-05 Manuel Koller * DESCRIPTION (Version): 0.6-2 * R/lmrob.MM.R (lmrob.const): replaced lmrob.ggw.const by lmrob.const, which now supports ggw and lgw. (lmrob.control, lmrob.lgw.findc, lmrob.conv.cc, lmrob.psi2ipsi): support for lgw psi function. (lmrob.efficiency, lmrob.bp): functions to calculate the efficiency and breakdown point of an M-estimator. (lmrob.tau, lmrob.tau.fast.coefs): Updated constants in all.equal check for Hampel psi function. Updated constants for all the supported psi functions. (lmrob..D..fit): switched order of updating covariance matrix and updating control$method. This caused the correction factors to be set incorrectly in some cases. * src/lmrob.c (normcnst, rho_lin, psi_lin, psip_lin, wgt_lin) (rho, psi, psip): Added support lgw psi function. * man/lmrob.control.Rd: updated to account for lgw. * tests/lmrob-psifns.R: added tests lgw psi function * tests/lmrob-psifns.Rout.save: updated accordingly * tests/lmrob-methods.Rout.save: updated, since constants for calculation of taus changed slightly * R/lmrob.R (vcov.lmrob): added possibility to calculate covariance matrix with another estimation method. 2010-07-12 Manuel Koller * DESCRIPTION (Version): 0.6-1 * src/lmrob.c (normcnst, rho_ggw, psi_ggw_vec, psi_ggw, psip_ggw) (wgt_ggw): Added support for custom constants for psi ggw. * R/lmrob.MM.R (.vcov.w): Modified constants for ggw psi function. (lmrob.control): Added method to calculate constants for ggw psi function. (lmrob.conv.cc, lmrob.ggw.mx, lmrob.ggw.ms, lmrob.ggw.ac) (lmrob.ggw.bp, lmrob.ggw.finda, lmrob.ggw.findc, lmrob.ggw.const): Methods to calculate constants for ggw psi. (lwgt): control argument optional. * tests/lmrob-psifns.R: added tests for custom tuning constants * tests/lmrob-psifns.Rout.save: added tests for custom tuning constants * experi-psi-rho-funs.R: added ggwPsi function, standardized s.t. Dpsi(0) = 1. Putting this into R/psi-rho-funs.R results in an error while "preparing for lazy-loading". 2010-06-25 Manuel Koller * DESCRIPTION (Version): 0.6-0 * NAMESPACE: dropped lmrob.control.sfs * R/lmrob.R (lmrob): "method" argument * man/lmrob.Rd: "method" argument * R/lmrob.MM.R (lmrob.control, lmrob.control.sfs): argument setting="KS2010" replaces lmrob.control.sfs. Setting a method involving a D step, sets default psi to ggw. * man/lmrob.control.Rd: "setting" argument * tests/lmrob-methods.R: "methods" and "psi" argument * tests/lmrob-methods.Rout.save: call output in summary changed * tests/lmrob-psifns.Rout.save: call output in summary changed * man/lmrob.control.Rd: Documentation details for tuning constants and alternative constants for .85 efficiency at the normal. 2010-06-24 Manuel Koller * DESCRIPTION (Version): 0.5-1.1 * tests/lmrob-psifns.R: added Hampel psi function example and updated coefficients of ggw. * src/lmrob.c: replaced "gws" with "ggw" in function names, "gwgt" with "welsh", replaced pow() with R_pow(), implemented support for coefficient vectors. Fixed problem with "ggw" on 32-bit machines. * R/lmrob.MM.R: changed the way coefficients for psi functions are handled: coefficient vectors are now supported. * R/lmrob.MM.R (lmrob..M..fit): class attribute for init entry in lmrob..M..fit was missing. 2010-06-23 Manuel Koller * tests/lmrob-methods.R: tests for compatibility between manual construction of different methods with specifying method argument in lmrob. * tests/lmrob-methods.Rout.save: expected results * tests/lmrob-psifns.R: tests for the support of different psi functions. * tests/lmrob-psifns.Rout.save: expected results * tests/lmrob-data.Rout.save: updated results to reflect slightly modified summary output (more options) * man/lmrob.Rd: updated to reflect changes in options * man/lmrob..D..fit.Rd: added documentation * man/lmrob..M..fit.Rd: updated example * man/lmrob.control.Rd: updated to reflect changes in options * man/lmrob.fit.Rd: updated from lmrob.fit.MM to reflect changes in options * man/lmrob.fit.MM.Rd: moved to lmrob.fit.Rd * man/lmrob.S.Rd: coef -> coefficients in example * R/anova.lmrob.R (length.tl, anovaLmrobPair, anovaLmrobList): Added checks to ensure soundness of result for methods other than "MM". 2010-06-21 Manuel Koller * R/lmrob.MM.R (lmrob.control, lmrob.control.sfs, lmrob.fit.MM) (.vcov.w, .vcov.avar1, lmrob..M..fit, lmrob.S, lmrob..D..fit) (lmrob.kappa, lmrob.tau, lmrob.hatmatrix, lmrob.leverages) (lmrob.psi2ipsi, lmrob.psifun, lmrob.chifun, lmrob.wgtfun) (residuals.lmrob.S, lmrob.E, ghq): Support for psi functions other than bisquare as well as SMDM estimates. * R/lmrob.R (lmrob): Support for psi functions other than bisquare as well as SMDM estimates. Replaced lmrob.fit.MM by lmrob.fit. * src/robustbase.h: declarations of new functions in lmrob.c * src/init.c: definitions of new functions in lmrob.c * src/lmrob.c: added support for psi functions other than bisquare, including vectorized accessor functions ("R_psifun", "R_chifun" and "R_wgtfun"). "wgt" is now always used to calculate robustness weights. Function to calculate scale estimate iteratively ("R_find_D_scale"). * NAMESPACE: added lmrob.fit, lmrob..D..fit and lmrob.control.sfs to export. * DESCRIPTION: added my name to the list. 2010-04-01 Martin Maechler * DESCRIPTION (Version): 0.5-1 2009-11-19 Martin Maechler * R/covMcd.R (.fastmcd): nLarge = 100'000 (instead of previous 5000), for now. nsamp <= integer.max is asserted now. * R/covMcd.R (covMcd): nmini = 300 is now an optional argument. * R/rrcov.control.R (rrcov.control): 'nmini = 300' ... * R/ltsReg.R (ltsReg.default): .fastmcd(..., nmini = 300) * src/rffastmcd.f (rffastmcd): new argument nmini 2009-11-18 Martin Maechler * DESCRIPTION (Version): 0.5-0-1, released to CRAN * tests/mc-strict.R: don't use the longmemo example for now. (platform dependence !) 2009-11-11 Martin Maechler * tests/glmrob-1.R: add moe explicit glmrob() tests; including the simple puzzling 1-outlier problem. * R/glmrobMqle.R: do use getRversion() ! 2009-06-27 Martin Maechler * data/wagnerGrowth.rda: add the "wagner data" (continuous + categorical) * man/wagnerGrowth.Rd: ditto 2009-06-05 Martin Maechler * R/glmrob.R (glmrob): add the option start = "lmrobMM", using a *robust* start for {essentially} glm(). * man/glmrob.Rd: add an example for that <<<<<______________ FIXME 2009-06-04 Martin Maechler * DESCRIPTION (Version): 0.5-0; *not* released * tests/glmrob-1.R: more glmrob() examples 2009-06-03 Martin Maechler * R/glmrobMqle.R (mFormat): make 'trace=TRUE' also depend on getOption("digits"). * R/glmrobMqle.R, R/glmrob.R: changes from Andreas Ruckstuhl, to support family = "Gamma". Unfortunately, these at first also very slightly change binomial, poisson. ==> few small changes by MM. * R/glmrob.R (glmrob): allow y (in "y ~ ...") to be *factor* 2009-01-17 Martin Maechler * DESCRIPTION (Version): 0.4-5 : bug-fixing release * tests/tmcd.R: add a regression test for the bug * src/rffastmcd.f: rfrdraw() w/o 'seed' * src/rfltsreg.f: ditto 2009-01-10 Martin Maechler * src/rf-common.f (rfrangen): drop unused 'seed' argument (rfrdraw): ditto * src/rffastmcd.f: get rid of TABs (gfortran -Wall complains) * man/exAM.Rd, man/possumDiv.Rd, ...: Rd_parse fixes 2008-11-28 Martin Maechler * R/OGK.R (covOGK): also return n.iter and weight.fn. * man/covOGK.Rd: note about the "silly" weight.fn 2008-10-15 Martin Maechler * R/lmrob.MM.R (lmrob.S): fix error message s/larger/smaller/ thanks to Keith Ponting. 2008-10-01 Martin Maechler * src/wgt_himed_templ.h: fix leading comment 2008-08-29 Martin Maechler * DESCRIPTION (Version): 0.4-3 for CRAN release * tests/mc-strict.R: define 'isMac' and tweak the tests; thanks to reports from Rory Winston. 2008-08-09 Martin Maechler * NAMESPACE: import stats::cov {since others hide it!} 2008-08-05 Martin Maechler * R/huber.R (huberM): replace `s' by 's' in errors and warnings. * R/qnsn.R, R/plot.lmrob.R, R/ltsReg.R, R/ltsPlot.R: ditto 2008-08-04 Martin Maechler , really from Valentin Todorov * R/ltsReg.R (ltReg.default): if(mcd) call covMcd() with correct alpha * R/covMcd.R (covMcd): drop (n-1)/n correction, as cov.wt() contains that per default (in R, not in S-plus!). * R/tolEllipse.R (tolEllipsePlot): no text() for id.n == 0 * DESCRIPTION (Version): 0.4-2 released to CRAN. 2008-08-04 Martin Maechler * src/wgt_himed.c: renamed wgt_himed.c_templ to * wgt_himed_templ.h: 2008-08-02 Martin Maechler * DESCRIPTION (Version): 0.4-1 ready for release to CRAN. * R/ltsReg.R (ltsReg.default): don't add artificial "Y" y-name * src/lmrob.c (rwls): first call to sum_rho() is only needed for tracing (was used for lambda iterations). * R/glmrob.R (glmrob), * R/glmrobMqle.R (glmrobMqle): introduce 'trace' option to trace the robustness iterations {*not* part of control: does *not* influence result} * man/CrohnD.Rd: new data example robust poisson regression * data/CrohnD.rda: 2008-01-25 Martin Maechler * R/covMcd.R (.fastmcd): fix nsamp="exact" to use "all" * src/rffastmcd.f: krep=0 <==> nsamp="exact" : all := TRUE; new argument i_trace; and use intpr() and dblepr() * man/covMcd.Rd: pass 'trace' to .fastmcd() and Fortran * src/rf-common.f (rfncomb): give "error" message for very large 'comb' * tests/tmcd.R: add test for nsmap = "exact" 2008-01-05 Martin Maechler * man/ambientNOxCH.Rd: new data set from René Locher, * data/ambientNOxCH.rda: showing some lmrob-nonconvergence 2007-12-22 Martin Maechler * src/lmrob.c (rwls): if (trace_lev >= 3) show beta vector. 2007-12-13 Martin Maechler * man/summarizeRobWeights.Rd: add toy example * R/lmrob.R (summarizeRobWeights): cosmetic change; notably finishing line when weights were practically 0/1. * tests/MCD-specials.Rout.save {adapt from change of 11-07} 2007-11-07 Martin Maechler * R/covMcd.R (covMcd): if we have singularity, also say so, even if trace is FALSE. * R/covMcd.R (singularityMsg): for "on.hyperplane", concatenate long coefficient vector. 2007-10-25 Martin Maechler * man/pulpfiber.Rd: New data set (p=8 = 4 + 4) * data/pulpfiber.tab: from "Robust Multivariate Regression (2004)". * tests/lmrob-ex12.R: use versions of predict[.lmrob]() 2007-10-24 Martin Maechler * man/condroz.Rd: set latin1 encoding (and fix typo) * R/lmrob.R (predict.lmrob): define predict() and model.matrix() methods, working via "lm" methods. * NAMESPACE: export vcov() * man/summary.lmrob.Rd: some docu of new methods 2007-08-02 Martin Maechler * R/adjoutlyingness.R (adjOutlyingness): small improvements, getting rid of loops; fix an obvious typo (in original code). Leave away the Inf and NaN that from abs(Y[] - m) / ( tup | tlo) 2007-07-21 Martin Maechler * DESCRIPTION (Author): add Tobias * src/rmc.c (h_kern): revert to absolute test; many more experiments * tests/mc-etc.R (x3): a smallish "extreme" case of "non-convergence" 2007-07-20 Martin Maechler * tests/mc-etc.R: new testing of mc() and related * src/rmc.c (mc_C_d): changed work[] and weight[] to 0-indexing; this is hopefully the last bug ... * R/adjbox.R (adjbox.formula): use adjbox(), not boxplot()! * man/adjboxStats.Rd: added 2007-07-20 Tobias Verbeke * R/adjbox.R: Skewness-adjusted boxplot ported from Matlab LibRA * man/adjbox.Rd: * data/los.rda, man/los.Rd: * data/condroz.rda, man/condroz.Rd: two dataset related to medcouple 2007-07-19 Martin Maechler * R/adjoutlyingness.R: new (also from the Antwerpen MC collection) * DESCRIPTION (Depends): R >= 2.3.1, so we can use * NAMESPACE (useDynLib): .registration = TRUE * R/*.R (.C, .Fortran): now can use name variable instead of string and drop 'PACKAGE = ".."' 2007-07-18 Tobias Verbeke and Martin Maechler * src/rmc.c, src/robustbase.h (rmc): code for medcouple (MC); needs debugging: infinite loops and segmentation faults * R/mc.R (mc): new mc() for MedCouple 2007-07-16 Martin Maechler * DESCRIPTION (Version): 0.4-0 - definitely made progress * R/plot.lmrob.R (plot.lmrob): recompute robust Mahalanobis distances and cache them with the object. 2007-07-10 Martin Maechler * R/lmrob.R (summarizeRobWeights): new defaults; work but warn when 'eps' and 'eps1' lead to weights both close to 0 and 1. * R/covPlot.R: don't warn for which = "all" * man/covPlot.Rd: example 2007-06-28 Martin Maechler * data/kootenay.tab: add "famous" data set * man/kootenay.Rd: * data/cushny.R: add the other "famous" simple data set * man/cushny.Rd: 2007-06-20 Martin Maechler * DESCRIPTION (Version): 0.2-8 ready to be released * src/lmrob.c (rwls): patch from Matias Salibian: Don't do any "lambda iterations" anymore, they are remnants from old "experiments". 2007-06-19 Valentin Todorov * R/covMcd.R: usage of simulated finite sample correction factors fixed: * - case p=1 fixed * - simulated corrections used only when the Pison et.al. * formula is definitely wrong (negative or very large) 2007-06-09 Martin Maechler * tests/lmrob-data.R, *.Rout.save: new consistency tests for lmrob() * R/biweight-funs.R (tukeyPsi1, tukeyChi): renamed from lmrob.Psi() and lmrob.Chi(); also renamed * man/tukeyPsi1.Rd, man/tukeyChi.Rd: updated, also mentioning "psiFunc" * src/lmrob.c (rwls): now controlling *relative* error in MM iterations, i.e., convergence happens when ||b1 - b2|| < eps * ||b1||. The above 'eps' is now part of lmrob.control() instead of hard-wired in C code. * R/lmrob.MM.R (lmrob.MM): new argument 'trace.lev' * src/robustbase.h (R_lmrob_MM): add trace_lev argument 2007-06-08 Martin Maechler * src/lmrob.c (refine_fast_s): slight change in warning() [make message nicer for future R >= 2.5.1] 2007-04-21 Martin Maechler * R/ltsReg.R: replace 'quan' by 'h' internally * R/covMcd.R: ditto * R/covMcd.R (h.alpha.n): renamed from "quan.f"() and now exported: * NAMESPACE: and hence * man/h.alpha.n.Rd: documented, and linked to from here * man/ltsReg.Rd, man/covMcd.Rd: 2007-04-18 Valentin Todorov * R/covMcd.R: use simulated finite sample correction factors {FIXME!} 2007-04-11 Martin Maechler * R/ltsReg.R (ltsReg.default): 'ans$X' now has "intercept first" to match coefficient vector. * R/ltsReg.R (summary.lts): no need to reorder 'R' (cholesky) anymore 2007-04-02 Valentin Todorov * R/covMcd.R: the (repeated) calculation of the consistency * correction factor for the raw and reweighted MCD covariance * replaced by a call to a function MCDcons() 2007-03-30 Valentin Todorov * R/covMcd (print.mcd): solve a conflict with fastmcd() in package robust: both return an object of class "mcd" 2007-03-28 Martin Maechler * R/covMcd.R (.fastmcd): subsample size myk <- p+1 (was 'p') 2007-03-27 Martin Maechler * R/covMcd.R: cosmetic changes; comments * src/rffastmcd.f: ditto * tests/tmcd.R: added very small sample (n < 2p) examples. 2007-03-26 Martin Maechler * R/ltsReg.R (print.summary.lts): signif.stars: instead of FALSE, use same default as for lm(.). * man/summary.lts.Rd 2007-03-26 Martin Maechler * R/covMcd.R (covMcd): be more tolerant about small n, notably n < 2p, now only requiring n >= p + 2 * src/rf-common.f (rfnbreak): really unused * src/rfltsreg.f, src/rffastmcd.f: comment use of rfnbreak() 2007-03-24 Martin Maechler * R/covMcd.R (covMcd): ans$raw.cov should be matrix even for p==1 2007-03-21 Martin Maechler * R/ltsReg.R (ltsReg.default): fix long-standing ("rrcov") bug of wrong coefficient order in ltsReg(x,y, intercept=FALSE). * tests/LTS-specials.R: add regression-test 2007-02-08 Martin Maechler * R/covMcd.R (singularityMsg): moved the remaining cases out of covMcd(). 2007-01-24 Martin Maechler * R/covMcd.R (covMcd): save 'singularity' info as list, and don't append it as string to 'method'. (singularityMsg): new utility used for printing singularity of MCD (print.mcd): using strwrap() instead of "\n" such that print() obeys options("width"). 2006-12-28 Martin Maechler * DESCRIPTION (Version): 0.2-7 released to CRAN * src/rfltsreg.f: get rid of warnings, notably some extraneous args. * src/rffastmcd.f: ditto * inst/test_MCD.R (mortality, mort3): add example {near singular} * tests/tmcd.R: test "near singular" example, using new tolSolve: * R/rrcov.control.R (rrcov.control): new tolSolve = 1e-14 * R/covMcd.R (covMcd): use 'tolSolve' instead of 1e-10 for mahalanobis' solve(*, tol). 2006-12-21 Valentin Todorov * R/ltsPlot.R (ltsPlot): for "rqq", use *standardized* residuals 2006-10-20 Martin Maechler * src/rfltsreg.f (rfltsreg): more comments; and minor cleanups * R/ltsReg.R (.fastlts): slightly simplified 'nsamp' checking and setting * DESCRIPTION (LazyData): yes * man/heart.Rd: mention survivals' "heart" data 2006-10-18 Martin Maechler * src/rfltsreg.f: less "if() l1,l2,l3" ; better indenting; etc worked pretty hard on C translation but that still seg.faults (!) 2006-10-04 Martin Maechler * INDEX: added a "manual" INDEX which has all the data sets at the end. * R/OGK.R (covOGK): more default arguments: n.iter = 2, and weight.fn = hard.rejection * R/OGK.R (s_mad, s_IQR): more "scale functions" for (O)GK * tests/OGK-ex.R: added examples for new s_*() scales; * tests/OGK-ex.Rout.save: new 2006-10-03 Martin Maechler * R/qnsn.R (s_Qn, sSn): new (trivial) wrapper functions for easier use in covOGK(). * man/Sn.Rd, man/Qn.Rd: ditto * man/covOGK.Rd: example with the above 2006-09-30 Martin Maechler * DESCRIPTION (Version): 0.2-6 * R/covPlot.R (covPlot): added 'labels.id', 'cex.id' and 'label.pos' arguments, "parallel" to plot.lm() and improved the labeling accordingly. * man/covPlot.Rd: 'ask=TRUE' gives problems in R <= 2.3.1 2006-09-29 Martin Maechler * DESCRIPTION (Version): 0.2-5 * data/radarImage.rda: add 'radarImage' data set from MMY-book * man/radarImage.Rd: ditto * data/toxicity.rda: added 'toxicity' data set (from MMY) * man/toxicity.Rd: ditto * src/rf-common.f (rfishsort): swap integer declaration order 2006-09-23 Martin Maechler * man/covPlot.Rd: document covPlot() as well, since that is more generally usable. * src/rf-common.f (rfrangen): declare unifrnd() as double prec.; also in other places; now using 'implicit none' to catch such things more easily. * R/tolEllipse.R (tolEllipsePlot): classic=TRUE: do not prepare a side-by-side plot, since we *over*plot. Rename 2nd argument from 'mcd' to 'm.cov', since it really only needs to have a mean ('center') and covariance component. 2006-09-05 Martin Maechler * DESCRIPTION (Version): 0.2-3 uploaded to CRAN * tests/tlts.R: rename test functions and move to new file * inst/test_LTS.R: * tests/tmcd.R: rename test functions and move to new file; do not 'time' them, since we want to use *.Rout.save files. * inst/test_MCD.R: * src/Makevars: add long overdue $(FLIBS) 2006-09-04 Martin Maechler * R/ltsReg.R (ltsReg.default): add argument name: sort(*, partial = ) * R/covMcd.R (covMcd): ditto 2006-06-27 Martin Maechler * DESCRIPTION (Depends): no longer depend on "MASS" which is suggested. * NAMESPACE, man/summarizeRobWeights.Rd: export and document summarizeRobWeights(). * R/lmrob.R (summarizeRobWeights): improvement (singular/plural etc) * R/ltsReg.R (ltsReg.formula): add 'subset' etc; and follow guidelines in developer.r-project.org/model-fitting-functions.txt. * tests/tmcd.R: typo; add timing comparison * R/glmrob.R (glmrob): family = "gaussian" now dispatches to lmrob() 2006-06-24 Martin Maechler * R/glmrob.R (print.summary.glmrob): as for lmrob(), now use summarizeRobWeights() and printControl(). * R/lmrob.R (printControl): more flexible * man/glmrob.Rd: update examples with 'weights.on.x' 2006-06-23 Andreas Ruckstuhl * R/glmrobMqle.R (wts_HiiDist): *row*Sums()! 2006-06-13 Martin Maechler * DESCRIPTION (Version): 0.2-2 * src/Makevars (PKG_LIBS): need this (in particular for Windows) 2006-06-08 Martin Maechler * src/lmrob.c (refine_fast_s): made sure 'conv *is* called as *Rboolean 2006-06-07 Martin Maechler * src/lmrob.c (refine_fast_s): print warning in case of non-convergence * DESCRIPTION (Version): 0.2-1 - pre-release * R/lmrob.MM.R (lmrob.control): decrease refine.tol "back" to 1e-7 * man/lmrob.control.Rd: ditto * src/lmrob.c (rho_biwgt): fix embarassing sign typo/thinko 2006-06-06 Martin Maechler * DESCRIPTION (Version): 0.2-0 "pre-released" to Andreas & Matias * src/lmrob.c (rwls): return *max_it = #{iterations used} * R/lmrob.MM.R (lmrob.MM): return #{iterations} back to R level * R/lmrob.R (summary.lmrob): and make sure they are printed. 2006-06-05 Andreas Ruckstuhl * R/anova.lmrob.R (anova.lmrob): new, for model comparison both "Wald" and "Deviance" tests. * man/anova.lmrob.Rd: docu + example 2006-05-31 Martin Maechler * R/covMcd.R (covMcd): use R' RNG * R/covMcd.R (print.summary.mcd): is new; also print.mvd and summary.* are now here, and improved. * src/rfltsreg.f (rfltsreg): use R's RNG * src/rffastmcd.f (rffastmcd): ditto * src/rf-common.f (rfrangen): use unifrnd(), and comment out the previous uniran() * src/R-rng4ftn.c: use R's RNGs also for Fortran, in 2006-05-29 Martin Maechler * src/lmrob.c: use R's unif_rand() instead of C's rand() * R/lmrob.MM.R: set/save R's .Random.seed, possible from 'seed' 2006-05-29 Martin Maechler * DESCRIPTION: version 0.1-7; the last one with C's rand() * R/lmrob.MM.R: it's "$seed" from init.S , not M(M)-estimate 2006-04-25 Martin Maechler * R/biweight-funs.R (lmrob.Psi): unification, rescaling, such that Psi'(0) = 1 2006-04-22 Martin Maechler * R/lmrob.MM.R (lmrob.S): new (control) option 'best.r.s = 2'; was hardcoded in C * src/lmrob.c (R_lmrob_S): 'best_r' is now argument; further, seed_rand is passed to the fast_s*() sub functions, so we can call them from R {and decide ourselves "if fast". * src/rf-common.f: new file for functions identical in rffastcmd.f and rfltsreg.f. 2006-04-21 Martin Maechler * data/NOxEmissions.Rd: add the large dataset from René Locher * man/NOxEmissions.Rd: 2006-04-21 Martin Maechler * R/lmrob.MM.R (lmrob.MM): return robustness weights as 'wt' 2006-04-18 Martin Maechler * R/lmrob.MM.R (lmrob.control): change default for 'compute.rd' to FALSE ==> robust (Mahalanobis) distances are *not* computed by default. This prevents singularity errors which happen frequently as soon as X contains (large) factors (with few levels). 2006-04-15 Martin Maechler * man/pension.Rd: add plots and simple 1st aid trafo (!) * R/glmrobMqle.R (glmrobMqle): weights.on.x = "hat" couldn't have worked(!) - still needs work __TODO__ * R/lmrob.MM.R (lmrob.S, lmrob.MM): simplified computations achieving ~ 10% faster execution for a (n,p) = (500,20) example. 2006-04-01 Martin Maechler * src/lmrob.c: new lmrob() code from Matias' roblm package * R/lmrob.*.R: renamed s/roblm/lmrob/ but also refactored * man/lmrob.*.Rd: and added a bit * TODO: section on lmrob() 2006-03-20 Martin Maechler * DESCRIPTION (Version): 0.1-4 * data/vaso.rda: one value, vaso[32,2], had a typo; it was '0.3' but should have been '0.03' 2006-03-16 Martin Maechler * R/OGK.R (scaleTau2): add consistency correction (for OGK). * man/scaleTau2.Rd: added * R/glmrobMqle.R: ni=0 special casing (not finished yet). * tests/binom-ni-small.R: more testing of ni=0 2006-03-14 Martin Maechler * TODO, Done, DESCRIPTION: updated, ready for release 2006-03-14 Andreas Ruckstuhl * R/anova-glmrob.R (anova.glmrob): new function * man/anova.glmrob.Rd: and documentation, replacing previous modsel.*() 2006-02-24 Martin Maechler * R/print.lts.R: moved to this file (and simplified slightly) to * R/ltsReg.R (ltsReg): more cleanup; fix (y ~ 1) and (y ~ 0) properly 2006-02-23 Martin Maechler * tests/LTS-specials.R: new file 2006-02-22 Martin Maechler * tests/MCD-specials.R: new tests * tests/huber-etc.R: tests for huberM() moved from pkg 'sfsmisc' 2006-02-21 Martin Maechler * R/glmrob.R (summary.glmrob): "Std. Error" (with blank!) 2006-02-18 Martin Maechler * R/glmrobMqle.R (glmrobMqle): make it work for ncoef == 0 * tests/glmrob-specials.R: new tests * R/glmrob.R (print.summary.glmrob): the same as print.glmrob + more 2006-02-17 Martin Maechler * R/glmrob.R (vcov.glmrob): added (print.glmrob): fix typo * tests/binom-ni-small.R: add from Martin's old "robGLM1" package * R/glmrob.R (glmrob): '...' passed to glmrob.control(...) 2006-02-17 Valentin Todorov * FIXED - .fastmcd and .fastlts no more return everything * fixed problems in ltsReg in case of location model Y~1 (i.e. x is missing in ltsReg.default()) * ltsReg & covMcd - added options 'best' and 'exact' for nsamp * ltsReg & covMcd - added parameter for controlling the small sample correction factors - use.correction * rrcov.control - added parameter for controlling the small sample correction factors - use.correction * ltsReg & covMcd - output of the consistency and the small sample correction factors 2006-02-09 Martin Maechler * DESCRIPTION (Version): 0.1-2 ready for CRAN "baby release" * man/vaso.Rd: fix longstanding typo: con*s*triction * R/glmrob.R (glmrob): Oops! the *.control() function must only have one "." and must be *called* 2006-02-08 Martin Maechler * R/glmrob.R,......: added 'glmrob' and 'nlrob' from Andreas Ruckstuhl 2006-02-02 Martin Maechler * R/covMcd.R: all moved from 'rrcov' after Valentin's * R/ltsReg.R: "green light" .......... 2006-01-25 Martin Maechler * DESCRIPTION (Version): 0.0-1 "prerelease" ready * man/psi_func-class.Rd: version "checked in" and ready for pre-release * man/chgDefaults-methods.Rd: ditto 2006-01-17 Martin Maechler * NAMESPACE: added name space * R/OGK.R (covOGK): added this; even though, the default scale estimate is *not* consistent * tests/tests-OGK.R: minimal 'test' 2006-01-16 Martin Maechler * man/starsCYG.Rd: clean up of documentation for the Rousseeuw data * man/aircraft.Rd: from Valentin * .... --------------- all these are for those things from 'rrcov' ------------------- 2005-12-28 Valentin Todorov * 0.2-11 * added more data sets from Rousseeuw & Leroy: telef, lactic, pension, pilot, cloud, education, airmay * fixed codoc discrepancies in the data sets stars and wood * ltsReg & covMcd - added control parameter for the small sample correction factors * ltsReg & covMcd - output of the consistency and the small sample correction factors 2005-10-24 Valentin Todorov * 0.2-10 * minor corrections in the help of covPlot * fixed bug in covPlot in case of class=TRUE * tolellipse - both robust and classical ellipse are superimposed * added directory inst/bm containing benchmarks comparing covMcd and ltsReg to the corresponding functions in MASS, S-PLUS and Matlab 2005-10-17 Valentin Todorov * 0.2-9 * minor corrections in the help of covMcd * minor correction in ltsReg (false corrected to FALSE) * covMcd - fixed the limitation on the number of variables <= 50 * ltsReg - fixed the limitation on the number of variables <= 50 * added function summary.mcd which prints (additionally to the output of print.mcd) the correlation matrix (if requested), the eigenvalues of the covariance or correlation matrix and the robust distances. * added control object for the estimation options rrcov.control and used in covMcd and ltsReg 2005-09-20 Valentin Todorov * 0.2-8 * ltsReg: added formula interface * ltsReg: adde generic functions summary.lts and print.summary.lts * ltsReg: fixed a problem with reordering of the coeficients even in case without intercept 2005-04-16 Valentin Todorov * 0.2-7 * ltsReg: fixed a bug related to nsamp -> it was hard-coded = 500 in Fortran * ltsPlot: default for id.n changed - instead of 3, now it is the number of identified outliers * ltsPlot: help enhanced * covMcd, covPlot, tolellipse: tol.inv parameter changed to tol, according the change in mahalanobis() in 2.1.0 2004-12-26 Valentin Todorov * 0.2-6 * a bug in ltsReg (rsquared) fixed * fixed CRLF line endings in FORTRAN sources * fixed a problem in covMcd: in case of p=1 and cov=[0], the cov matrix was a double instead of a matrix, which resulted in errors in subsequent calls (e.g. determinant(mcd$cov) expects a matrix) * fixed a problem in ltsReg when p==1 and Intercept==FALSE - the vectors of coefficients ans$coefficients and ans$raw.coefficients were of size 2 * error handling added in ltsReg in case of scale=0 2004-09-16 Valentin Todorov * 0.2-5 * several errors in doc fixed (ltsPlot.Rd, covPlot.Rd, aircraft.Rd) 2004-09-16 Valentin Todorov * 0.2-4 * added Regression Diagnostic Plots - function ltsPlot() * ...added Normal QQ Plot of the residuals * ...added Standardized Residuals versus index plot * ...added Standardized Residuals versus fitted values plot * ...added Regression diagnostic plot * ltsReg: the responce variable Y added to the result object * covMcd: fixed a bug related to nsamp -> it was hard-coded = 500 in Fortran * covMcd: fixed a bug - in case of alpha=1 * added S3 methods plot.mcd and plot.lts * the S3 methods print.mcd and print.lts moved to separate R files * added the stars data set (Hertzsprung-Russell diagram) 2004-07-13 Valentin Todorov * 0.2-3 * improved documentation of the datasets * added datasets aircraft and delivery * added Covariance Plots - function covPlot() * ...added Distance Plot - function distplot() * ...added Distance-Distance Plot - function ddplot() * ...added Chisquare QQ-Plot - function chi2qqplot() * ...added Tolerance Ellipse Plot - function tolellipse() * added function print.lts (for ltsReg result); included in the test tlts.R * added function print.mcd (for covMcd result); included in the test tmcd.R 2004-06-26 Valentin Todorov * 0.2-2 * fixed bug in Fortran: rfltsreg.f, xrfnbreak() * Depends >= 1.8 (it was >= 1.9, because of the bug above) * Parameter, controlling whether to perform intercept adjustment at each step added to ltsReg and its default value set to FALSE robustbase/man/0000755000176200001440000000000013465050072013200 5ustar liggesusersrobustbase/man/lmrob.control.Rd0000644000176200001440000003272013177452122016267 0ustar liggesusers\name{lmrob.control} \title{Tuning Parameters for lmrob() and Auxiliaries} \encoding{utf8} \alias{lmrob.control} \alias{lmrob.control} \alias{.Mchi.tuning.default} \alias{.Mpsi.tuning.default} \alias{.Mchi.tuning.defaults} \alias{.Mpsi.tuning.defaults} \description{ Tuning parameters for \code{\link{lmrob}}, the MM-type regression estimator and the associated S-, M- and D-estimators. Using \code{setting="KS2011"} sets the defaults as suggested by Koller and Stahel (2011) and analogously for \code{"KS2014"}. The \code{.M*.default} \code{\link{function}}s and \code{.M*.defaults} \code{\link{list}}s contain default tuning parameters for all the predefined \eqn{\psi}{psi} functions, see also \code{\link{Mpsi}}, etc. } \usage{ lmrob.control(setting, seed = NULL, nResample = 500, tuning.chi = NULL, bb = 0.5, tuning.psi = NULL, max.it = 50, groups = 5, n.group = 400, k.fast.s = 1, best.r.s = 2, k.max = 200, maxit.scale = 200, k.m_s = 20, refine.tol = 1e-7, rel.tol = 1e-7, scale.tol = 1e-10, solve.tol = 1e-7, trace.lev = 0, mts = 1000, subsampling = c("nonsingular", "simple"), compute.rd = FALSE, method = "MM", psi = "bisquare", numpoints = 10, cov = NULL, split.type = c("f", "fi", "fii"), fast.s.large.n = 2000, eps.outlier = function(nobs) 0.1 / nobs, eps.x = function(maxx) .Machine$double.eps^(.75)*maxx, compute.outlier.stats = method, warn.limit.reject = 0.5, warn.limit.meanrw = 0.5, ...) .Mchi.tuning.defaults .Mchi.tuning.default(psi) .Mpsi.tuning.defaults .Mpsi.tuning.default(psi) } \arguments{ \item{setting}{a string specifying alternative default values. Leave empty for the defaults or use \code{"KS2011"} or \code{"KS2014"} for the defaults suggested by Koller and Stahel (2011, 2017). See \emph{Details}.} \item{seed}{\code{NULL} or an integer vector compatible with \code{\link{.Random.seed}}: the seed to be used for random re-sampling used in obtaining candidates for the initial S-estimator. The current value of \code{.Random.seed} will be preserved if \code{seed} is set, i.e. non-\code{NULL}; otherwise, as by default, \code{.Random.seed} will be used and modified as usual from calls to \code{\link{runif}()} etc. } \item{nResample}{number of re-sampling candidates to be used to find the initial S-estimator. Currently defaults to 500 which works well in most situations (see references).} \item{tuning.chi}{tuning constant vector for the S-estimator. If \code{NULL}, as by default, sensible defaults are set (depending on \code{psi}) to yield a 50\% breakdown estimator. See \emph{Details}.} \item{bb}{expected value under the normal model of the \dQuote{chi} (rather \eqn{\rho (rho)}{rho}) function with tuning constant equal to \code{tuning.chi}. This is used to compute the S-estimator.} \item{tuning.psi}{tuning constant vector for the redescending M-estimator. If \code{NULL}, as by default, this is set (depending on \code{psi}) to yield an estimator with asymptotic efficiency of 95\% for normal errors. See \emph{Details}.} \item{max.it}{integer specifying the maximum number of IRWLS iterations.} \item{groups}{(for the fast-S algorithm): Number of random subsets to use when the data set is large.} \item{n.group}{(for the fast-S algorithm): Size of each of the \code{groups} above. Note that this must be at least \eqn{p}.} \item{k.fast.s}{(for the fast-S algorithm): Number of local improvement steps (\dQuote{\emph{I-steps}}) for each re-sampling candidate.} \item{k.m_s}{(for the M-S algorithm): specifies after how many unsucessful refinement steps the algorithm stops.} \item{best.r.s}{(for the fast-S algorithm): Number of of best candidates to be iterated further (i.e., \dQuote{\emph{\bold{r}efined}}); is denoted \eqn{t} in Salibian-Barrera & Yohai(2006).} \item{k.max}{(for the fast-S algorithm): maximal number of refinement steps for the \dQuote{fully} iterated best candidates.} \item{maxit.scale}{integer specifying the maximum number of C level \code{find_scale()} iterations.} \item{refine.tol}{(for the fast-S algorithm): relative convergence tolerance for the fully iterated best candidates.} \item{rel.tol}{(for the RWLS iterations of the MM algorithm): relative convergence tolerance for the parameter vector.} \item{scale.tol}{(for the scale estimation iterations of the S algorithm): relative convergence tolerance for the \code{scale} \eqn{\sigma(.)}.} \item{solve.tol}{(for the S algorithm): relative tolerance for inversion. Hence, this corresponds to \code{\link{solve.default}()}'s \code{tol}.} \item{trace.lev}{integer indicating if the progress of the MM-algorithm should be traced (increasingly); default \code{trace.lev = 0} does no tracing.} \item{mts}{maximum number of samples to try in subsampling algorithm.} \item{subsampling}{type of subsampling to be used, a string: \code{"simple"} for simple subsampling (default prior to version 0.9), \code{"nonsingular"} for nonsingular subsampling. See also \code{\link{lmrob.S}}.} \item{compute.rd}{logical indicating if robust distances (based on the MCD robust covariance estimator \code{\link{covMcd}}) are to be computed for the robust diagnostic plots. This may take some time to finish, particularly for large data sets, and can lead to singularity problems when there are \code{\link{factor}} explanatory variables (with many levels, or levels with \dQuote{few} observations). Hence, is \code{FALSE} by default.} \item{method}{string specifying the estimator-chain. \code{MM} is interpreted as \code{SM}. See \emph{Details} of \code{\link{lmrob}} for a description of the possible values.} \item{psi}{string specifying the type \eqn{\psi}-function used. See \emph{Details} of \code{\link{lmrob}}. Defaults to \code{"bisquare"} for S and MM-estimates, otherwise \code{"lqq"}.} \item{numpoints}{number of points used in Gauss quadrature.} \item{cov}{function or string with function name to be used to calculate covariance matrix estimate. The default is \code{if(method \%in\% c('SM', 'MM')) ".vcov.avar1" else ".vcov.w"}. See \emph{Details} of \code{\link{lmrob}}.} \item{split.type}{determines how categorical and continuous variables are split. See \code{\link{splitFrame}}.} \item{fast.s.large.n}{minimum number of observations required to switch from ordinary \dQuote{fast S} algorithm to an efficient \dQuote{large n} strategy.} \item{eps.outlier}{limit on the robustness weight below which an observation is considered to be an outlier. Either a numeric(1) or a function that takes the number of observations as an argument. Used in \code{\link{summary.lmrob}} and \code{\link{outlierStats}}.} \item{eps.x}{limit on the absolute value of the elements of the design matrix below which an element is considered zero. Either a numeric(1) or a function that takes the maximum absolute value in the design matrix as an argument.} \item{compute.outlier.stats}{vector of \code{\link{character}} strings, each valid to be used as \code{method} argument. Used to specify for which estimators outlier statistics (and warnings) should be produced. Set to empty string if none are required.} \item{warn.limit.reject}{limit of ratio \eqn{\#\mbox{rejected} / \#\mbox{obs in level}}{# rejected / # obs in level} above (\eqn{\geq}{>=}) which a warning is produced. Set to \code{NULL} to disable warning.} \item{warn.limit.meanrw}{limit of the mean robustness per factor level below which (\eqn{\leq}{<=}) a warning is produced. Set to \code{NULL} to disable warning.} \item{...}{further arguments to be added as \code{\link{list}} components to the result, e.g., those to be used in \code{.vcov.w()}.} } \value{ \code{.Mchi.tuning.default(psi)} and \code{.Mpsi.tuning.default(psi)} return a short \code{\link{numeric}} vector of tuning constants which are defaults for the corresponding psi-function, see the \emph{Details}. They are based on the named \code{\link{list}}s \code{.Mchi.tuning.defaults} and \code{.Mpsi.tuning.defaults}, respectively. \code{lmrob.control()} returns a named \code{\link{list}} with over twenty components, corresponding to the arguments, where \code{tuning.psi} and \code{tuning.chi} are typically computed, as \code{.Mpsi.tuning.default(psi)} or \code{.Mchi.tuning.default(psi)}, respectively. } \details{The option \code{setting="KS2011"} alters the default arguments. They are changed to \code{method = "SMDM"}, \code{psi = "lqq"}, \code{max.it = 500}, \code{k.max = 2000}, \code{cov = ".vcov.w"}. The defaults of all the remaining arguments are not changed. The option \code{setting="KS2014"} builds upon \code{setting="KS2011"}. More arguments are changed to \code{best.r.s = 20, k.fast.s = 2, nResample = 1000}. This setting should produce more stable estimates for designs with \code{\link{factor}}s. By default, and in \code{.Mpsi.tuning.default()} and \code{.Mchi.tuning.default()}, \code{tuning.chi} and \code{tuning.psi} are set to yield an MM-estimate with breakdown point \eqn{0.5} and efficiency of 95\% at the normal. If numeric \code{tuning.chi} or \code{tuning.psi} are specified, say \code{cc}, for \code{psi = "ggw"} or \code{"lqq"}, \code{\link{.psi.const}(cc, psi)} is used, see its help page. To get the defaults, e.g., \code{.Mpsi.tuning.default(psi)} is equivalent to but more efficient than the formerly widely used \code{lmrob.control(psi = psi)$tuning.psi}. These defaults are: \tabular{rll}{ \code{psi} \tab\code{tuning.chi} \tab\code{tuning.psi} \cr \code{bisquare}\tab\code{1.54764} \tab\code{4.685061} \cr \code{welsh} \tab\code{0.5773502} \tab\code{2.11} \cr \code{ggw} \tab\code{c(-0.5, 1.5, NA, 0.5)} \tab\code{c(-0.5, 1.5, 0.95, NA)} \cr \code{lqq} \tab\code{c(-0.5, 1.5, NA, 0.5)} \tab\code{c(-0.5, 1.5, 0.95, NA)} \cr \code{optimal} \tab\code{0.4047} \tab\code{1.060158} \cr \code{hampel} \tab\code{c(1.5, 3.5, 8)*0.2119163} \tab\code{c(1.5, 3.5, 8)*0.9014} } The values for the tuning constant for the \code{ggw} and \code{lqq} psi functions are specified differently here by a vector with four elements: minimal slope, b (controlling the bend at the maximum of the curve), efficiency, breakdown point. Use \code{NA} for an unspecified value of either efficiency or breakdown point, see examples in the tables (above and below). For these table examples, the respective \dQuote{inner constants} are stored precomputed, see \code{\link{.psi.lqq.findc}} for more. The constants for the \code{"hampel"} psi function are chosen to have a redescending slope of \eqn{-1/3}. Constants for a slope of \eqn{-1/2} would be \tabular{rll}{ \code{psi} \tab\code{tuning.chi} \tab\code{tuning.psi} \cr \code{"hampel"}\tab\code{c(2, 4, 8) * 0.1981319} \tab\code{c(2, 4, 8) * 0.690794} } Alternative coefficients for an efficiency of 85\% at the normal are given in the table below. \tabular{rl}{ \code{psi} \tab\code{tuning.psi} \cr \code{bisquare} \tab\code{3.443689} \cr \code{welsh} \tab\code{1.456} \cr \code{ggw}, \code{lqq}\tab\code{c(-0.5, 1.5, 0.85, NA)} \cr \code{optimal} \tab\code{0.8684} \cr \code{hampel} (-1/3) \tab\code{c(1.5, 3.5, 8)* 0.5704545} \cr \code{hampel} (-1/2) \tab\code{c( 2, 4, 8) * 0.4769578} } } \references{ Koller, M. and Stahel, W.A. (2011) Sharpening Wald-type inference in robust regression for small samples. \emph{Computational Statistics & Data Analysis} \bold{55}(8), 2504--2515. Koller, M. and Stahel, W.A. (2017) Nonsingular subsampling for regression {S}~estimators with categorical predictors, \emph{Computational Statistics} \bold{32}(2): 631--646. \doi{10.1007/s00180-016-0679-x}. Referred as \code{"KS2014"} everywhere in \pkg{robustbase}; A shorter first version, Koller (2012) has been available from \url{https://arxiv.org/abs/1208.5595}. } \author{Matias Salibian-Barrera, Martin Maechler and Manuel Koller} \seealso{ \code{\link{Mpsi}}, etc, for the (fast!) psi function computations; \code{\link{lmrob}}, also for references and examples. } \examples{ ## Show the default settings: str(lmrob.control()) ## Artificial data for a simple "robust t test": set.seed(17) y <- y0 <- rnorm(200) y[sample(200,20)] <- 100*rnorm(20) gr <- as.factor(rbinom(200, 1, prob = 1/8)) lmrob(y0 ~ 0+gr) ## Use Koller & Stahel(2011)'s recommendation but a larger 'max.it': str(ctrl <- lmrob.control("KS2011", max.it = 1000)) str(.Mpsi.tuning.defaults) stopifnot(identical(.Mpsi.tuning.defaults, sapply(names(.Mpsi.tuning.defaults), .Mpsi.tuning.default))) ## Containing (names!) all our (pre-defined) redescenders: str(.Mchi.tuning.defaults) ## Difference between settings: C11 <- lmrob.control("KS2011") C14 <- lmrob.control("KS2014") str(C14) ## Apart from `setting` itself, they only differ in three places: diffC <- names(which(!mapply(identical, C11,C14, ignore.environment=TRUE))) cbind(KS11 = unlist(C11[diffC[-1]]), KS14 = unlist(C14[diffC[-1]])) ## KS11 KS14 ## nResample 500 1000 ## best.r.s 2 20 ## k.fast.s 1 2 } \keyword{robust} \keyword{regression} robustbase/man/SiegelsEx.Rd0000644000176200001440000000175413312375575015377 0ustar liggesusers\name{SiegelsEx} \alias{SiegelsEx} \docType{data} \title{Siegel's Exact Fit Example Data} \description{ A small counterexample data set devised by Andrew Siegel. Six (out of nine) data points lie on the line \eqn{y = 0} such that some robust regression estimators exhibit the \dQuote{\emph{exact fit}} property. } \usage{data(SiegelsEx, package="robustbase")} \format{ A data frame with 9 observations on the following 2 variables. \describe{ \item{\code{x}}{a numeric vector} \item{\code{y}}{a numeric vector} } } \source{ Emerson and Hoaglin (1983, p.139) } \references{ Peter J. Rousseeuw and Annick M. Leroy (1987) \emph{Robust Regression and Outlier Detection} Wiley, p.60--61 } \examples{ data(SiegelsEx) plot(SiegelsEx, main = "Siegel's example for 'exact fit'") abline( lm(y ~ x, data = SiegelsEx)) abline(MASS::lqs(y ~ x, data = SiegelsEx, method = "lms"), col = 2) legend("topright", leg = c("lm", "LMS"), col=1:2, lwd=1, inset = 1/20) } \keyword{datasets} robustbase/man/summary.glmrob.Rd0000644000176200001440000000475411721663343016463 0ustar liggesusers\name{summary.glmrob} \alias{summary.glmrob} \alias{vcov.glmrob} \alias{print.summary.glmrob} \title{Summarizing Robust Fits of Generalized Linear Models} \description{ The \code{summary} method for class \code{"\link{glmrob}"} summarizes robust fits of (currently only discrete) generalized linear models. } \usage{ \method{summary}{glmrob}(object, correlation = FALSE, symbolic.cor = FALSE, \dots) \method{vcov}{glmrob}(object, \dots) \method{print}{summary.glmrob}(x, digits = max(3, getOption("digits") - 3), symbolic.cor = x$symbolic.cor, signif.stars = getOption("show.signif.stars"), \dots) } \arguments{ \item{object}{an object of class \code{"glmrob"}, usually, a result of a call to \code{\link{glmrob}}.} \item{correlation}{logical; if \code{TRUE}, the correlation matrix of the estimated parameters is returned and printed.} \item{symbolic.cor}{logical. If \code{TRUE}, print the correlations in a symbolic form (see \code{\link{symnum}}) rather than as numbers.} \item{\dots}{further arguments passed to or from other methods.} \item{x}{an object of class \code{"summary.glrob"}.} \item{digits}{the number of digits to use for printing.} \item{signif.stars}{logical indicating if the P-values should be visualized by so called \dQuote{significance stars}.} } \details{ \code{\link{summary.glmrob}} returns an object of \code{\link{class}} \code{"summary.glmrob"}. Its \code{\link{print}()} method tries to be smart about formatting the coefficients, standard errors, etc, and gives \dQuote{significance stars} if \code{signif.stars} is \code{TRUE} (as per default when \code{\link{options}} where not changed). } \value{ The function \code{\link{summary.glmrob}} computes and returns a list of summary statistics of the robustly fitted linear model given in \code{object}. The following elements are in the list: \item{...}{ FIXME } %% MM thinks that summary should possibly just *add* to the original %% object. } %%\references{ ~put references to the literature/web site here ~ } \author{Andreas Ruckstuhl} %%\note{ ~~further notes~~ } %% \seealso{\code{\link{glmrob}}; the generic \code{\link{summary}} and also \code{\link[stats]{summary.glm}}. } \examples{ data(epilepsy) Rmod <- glmrob(Ysum ~ Age10 + Base4*Trt, family = poisson, data = epilepsy, method= "Mqle") ss <- summary(Rmod) ss ## calls print.summary.glmrob() str(ss) ## internal STRucture of summary object } \keyword{regression} \keyword{nonlinear} \keyword{robust} robustbase/man/CrohnD.Rd0000644000176200001440000000310613312375575014655 0ustar liggesusers\name{CrohnD} \encoding{utf8} \alias{CrohnD} \docType{data} \title{Crohn's Disease Adverse Events Data} \description{ Data set issued from a study of the adverse events of a drug on 117 patients affected by Crohn's disease (a chronic inflammatory disease of the intestines). } \usage{data(CrohnD, package="robustbase")} \format{ A data frame with 117 observations on the following 9 variables. \describe{ %% FIXME: leave these away -- or explain: -- they code patient sub-groups \item{\code{ID}}{the numeric patient IDs} \item{\code{nrAdvE}}{the number of adverse events} \item{\code{BMI}}{Body MASS Index, i.e., \eqn{weight[kg] / (height[m])^2}.} \item{\code{height}}{in cm} \item{\code{country}}{a factor with levels \code{0} and \code{1}} \item{\code{sex}}{the person's gender, a binary factor with levels \code{M} \code{F}} \item{\code{age}}{in years, a numeric vector} \item{\code{weight}}{in kilograms, a numeric vector} \item{\code{treat}}{how CD was treated: a factor with levels \code{0}, \code{1} and \code{2}, meaning placebo, drug 1 and drug 2.} } } % \details{ % ~~ If necessary, more details than the __description__ above ~~ % } \source{ form the authors of the reference, with permission by the original data collecting agency. } \references{ Serigne N. Lô and Elvezio Ronchetti (2006). Robust Second Order Accurate Inference for Generalized Linear Models. Technical report, University of Geneva, Switzerland. } \examples{ data(CrohnD) str(CrohnD) with(CrohnD, ftable(table(sex,country, treat))) } \keyword{datasets} robustbase/man/delivery.Rd0000644000176200001440000000165613312375575015333 0ustar liggesusers\name{delivery} \alias{delivery} \docType{data} \title{Delivery Time Data} \description{ Delivery Time Data, from Montgomery and Peck (1982). The aim is to explain the time required to service a vending machine (Y) by means of the number of products stocked (X1) and the distance walked by the route driver (X2). } \usage{data(delivery, package="robustbase")} \format{ A data frame with 25 observations on the following 3 variables. \describe{ \item{\code{n.prod}}{Number of Products} \item{\code{distance}}{Distance} \item{\code{delTime}}{Delivery time} } } \source{ Montgomery and Peck (1982, p.116) } \references{ P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection}; Wiley, page 155, table 23. } \examples{ data(delivery) summary(lm.deli <- lm(delTime ~ ., data = delivery)) delivery.x <- as.matrix(delivery[, 1:2]) c_deli <- covMcd(delivery.x) c_deli } \keyword{datasets} robustbase/man/huberM.Rd0000644000176200001440000000624112271657124014721 0ustar liggesusers\name{huberM} \alias{huberM} \title{Safe (generalized) Huber M-Estimator of Location} \concept{robust location} \description{ (Generalized) Huber M-estimator of location with MAD scale, being sensible also when the scale is zero where \code{\link[MASS]{huber}()} returns an error. } \usage{ huberM(x, k = 1.5, weights = NULL, tol = 1e-06, mu = if(is.null(weights)) median(x) else wgt.himedian(x, weights), s = if(is.null(weights)) mad(x, center=mu) else wgt.himedian(abs(x - mu), weights), se = FALSE, warn0scale = getOption("verbose")) } \arguments{ \item{x}{numeric vector.} \item{k}{positive factor; the algorithm winsorizes at \code{k} standard deviations.} \item{weights}{numeric vector of non-negative weights of same length as \code{x}, or \code{NULL}.} \item{tol}{convergence tolerance.} \item{mu}{initial location estimator.} \item{s}{scale estimator held constant through the iterations.} \item{se}{logical indicating if the standard error should be computed and returned (as \code{SE} component). Currently only available when \code{weights} is \code{NULL}.} \item{warn0scale}{logical; if true, and \code{s} is 0 and \code{length(x) > 1}, this will be warned about.} } \value{ list of location and scale parameters, and number of iterations used. \item{mu}{location estimate} \item{s}{the \code{s} argument, typically the \code{\link{mad}}.} \item{it}{the number of \dQuote{Huber iterations} used.} } \details{ Note that currently, when non-\code{NULL} \code{weights} are specified, the default for initial location \code{mu} and scale \code{s} is \code{\link{wgt.himedian}}, where strictly speaking a weighted \dQuote{non-hi} median should be used for consistency. Since \code{s} is not updated, the results slightly differ, see the examples below. When \code{se = TRUE}, the standard error is computed using the \eqn{\tau} correction factor but no finite sample correction. % and as if \code{s} was not estimated from the data. } \author{Martin Maechler, building on the MASS code mentioned.} \references{ Huber, P. J. (1981) \emph{Robust Statistics.} Wiley. } \seealso{ \code{\link[MASS]{hubers}} (and \code{huber}) in package \pkg{MASS}; \code{\link{mad}}. } \examples{ huberM(c(1:9, 1000)) mad (c(1:9, 1000)) mad (rep(9, 100)) huberM(rep(9, 100)) ## When you have "binned" aka replicated observations: set.seed(7) x <- c(round(rnorm(1000),1), round(rnorm(50, m=10, sd = 10))) t.x <- table(x) # -> unique values and multiplicities x.uniq <- as.numeric(names(t.x)) ## == sort(unique(x)) x.mult <- unname(t.x) str(Hx <- huberM(x.uniq, weights = x.mult), digits = 7) str(Hx. <- huberM(x, s = Hx$s, se=TRUE), digits = 7) ## should be ~= Hx stopifnot(all.equal(Hx[-4], Hx.[-4])) str(Hx2 <- huberM(x, se=TRUE), digits = 7)## somewhat different, since 's' differs ## Confirm correctness of std.error : \donttest{ system.time( SS <- replicate(10000, vapply(huberM(rnorm(400), se=TRUE), as.double, 1.)) ) # ~ 12.2 seconds rbind(mean(SS["SE",]), sd(SS["mu",]))# both ~ 0.0508 stopifnot(all.equal(mean(SS["SE",]), sd ( SS["mu",]), tolerance= 0.002)) } } \keyword{univar} \keyword{robust} robustbase/man/summary.lts.Rd0000644000176200001440000000657110607131625015775 0ustar liggesusers\name{summary.lts} \alias{summary.lts} \alias{print.summary.lts} \title{Summary Method for LTS objects} \usage{ \method{summary}{lts}(object, correlation = FALSE, \dots) \method{print}{summary.lts}(x, digits = max(3, getOption("digits") - 3), signif.stars = getOption("show.signif.stars"), \dots) } \arguments{ \item{object}{an object of class \code{"lts"}, usually, a result of a call to \code{\link{ltsReg}}.} \item{correlation}{logical; if \code{TRUE}, the correlation matrix of the estimated parameters is returned and printed.} \item{x}{an object of class \code{"summary.lts"}, usually, a result of a call to \code{summary.lts}.} \item{digits}{the number of significant digits to use when printing.} \item{signif.stars}{logical indicating if \dQuote{significance stars} should be printer, see \code{\link{printCoefmat}}.} \item{\dots}{further arguments passed to or from other methods.} } \description{ \code{summary} method for class \code{"lts"}. } \details{ These functions compute and print summary statistics for weighted least square estimates with weights based on LTS estimates. Therefore the statistics are similar to those for LS but all terms are multiplied by the corresponding weight. Correlations are printed to two decimal places: to see the actual correlations print \code{summary(object)$correlation} directly. } \value{ The function \code{summary.lts} computes and returns a list of summary statistics of the fitted linear model given in \code{object}, using the components of this object (list elements). \item{residuals}{the residuals - a vector like the response \code{y} containing the residuals from the weighted least squares regression.} \item{coefficients}{a \eqn{p \times 4}{p x 4} matrix with columns for the estimated coefficient, its standard error, t-statistic and corresponding (two-sided) p-value. } \item{sigma}{the estimated scale of the reweighted residuals \deqn{\hat\sigma^2 = \frac{1}{n-p}\sum_i{R_i^2},}{% sigma^2 = 1/(n-p) Sum(R[i]^2),} where \eqn{R_i}{R[i]} is the \eqn{i}-th residual, \code{residuals[i]}.} \item{df}{degrees of freedom, a 3-vector \eqn{(p, n-p, p*)}, the last being the number of non-aliased coefficients.} \item{fstatistic}{(for models including non-intercept terms) a 3-vector with the value of the F-statistic with its numerator and denominator degrees of freedom.} \item{r.squared}{\eqn{R^2}, the \dQuote{fraction of variance explained by the model}, \deqn{R^2 = 1 - \frac{\sum_i{R_i^2}}{\sum_i(y_i- y^*)^2},}{% R^2 = 1 - Sum(R[i]^2) / Sum((y[i]- y*)^2),} where \eqn{y^*}{y*} is the mean of \eqn{y_i}{y[i]} if there is an intercept and zero otherwise.} \item{adj.r.squared}{the above \eqn{R^2} statistic \dQuote{\emph{adjusted}}, penalizing for higher \eqn{p}.} \item{cov.unscaled}{a \eqn{p \times p}{p x p} matrix of (unscaled) covariances of the \eqn{\hat\beta_j}{coef[j]}, \eqn{j=1, \dots, p}.} \item{correlation}{the correlation matrix corresponding to the above \code{cov.unscaled}, if \code{correlation = TRUE} is specified.} } \seealso{ \code{\link{ltsReg}}; the generic \code{\link{summary}}. } \examples{ data(Animals2) ltsA <- ltsReg(log(brain) ~ log(body), data = Animals2) (slts <- summary(ltsA)) ## non-default options for printing the summary: print(slts, digits = 5, signif.stars = FALSE) } \keyword{regression} \keyword{robust} robustbase/man/estimethod.Rd0000644000176200001440000000136512270435276015647 0ustar liggesusers\name{estimethod} \alias{estimethod} \title{Extract the Estimation Method 'Estimethod' from a Fitted Model} \description{ Extract the estimation method as a \code{\link{character}} string from a fitted model. } \usage{ estimethod(object, ...) } \arguments{ \item{object}{a fitted model.} \item{...}{additional, optional arguments. (None are used in our methods)} } \value{ a \code{\link{character}} string, the estimation method used. } \details{ This is a (S3) generic function for which we provide methods, currently for \code{\link{nlrob}} only.% TODO %% \code{\link{lmrob}}, %% \code{\link{glmrob}}, %% , and \code{\link{nls}}. } \seealso{ \code{\link{nlrob}}, and \code{\link{nlrob.MM}}, notably for examples. } \keyword{models} robustbase/man/Sn.Rd0000644000176200001440000000404311276613024014050 0ustar liggesusers\name{Sn} \alias{Sn} \alias{s_Sn} % \title{Robust Location-Free Scale Estimate More Efficient than MAD} \description{ Compute the robust scale estimator \eqn{S_n}{Sn}, an efficient alternative to the MAD. } \usage{ Sn(x, constant = 1.1926, finite.corr = missing(constant)) s_Sn(x, mu.too = FALSE, \dots) } \arguments{ \item{x}{numeric vector of observations.} \item{constant}{number by which the result is multiplied; the default achieves consisteny for normally distributed data.} \item{finite.corr}{logical indicating if the finite sample bias correction factor should be applied. Default to \code{TRUE} unless \code{constant} is specified.} \item{mu.too}{logical indicating if the \code{\link[stats]{median}(x)} should also be returned for \code{s_Sn()}.} \item{\dots}{potentially further arguments for \code{s_Sn()} passed to \code{Sn()}.} } \value{ \code{Sn()} returns a number, the \eqn{S_n}{Sn} robust scale estimator, scaled to be consistent for \eqn{\sigma^2} and i.i.d. Gaussian observatsions, optionally bias corrected for finite samples. \code{s_Sn(x, mu.too=TRUE)} returns a length-2 vector with location (\eqn{\mu}) and scale; this is typically only useful for \code{\link{covOGK}(*, sigmamu = s_Sn)}. } \details{ ............ FIXME ........ } \references{ Rousseeuw, P.J. and Croux, C. (1993) Alternatives to the Median Absolute Deviation, \emph{Journal of the American Statistical Association} \bold{88}, 1273--1283. } \seealso{\code{\link[stats]{mad}} for the \sQuote{most robust} but much less efficient scale estimator; \code{\link{Qn}} for a similar more efficient but slower alternative; \code{\link{scaleTau2}}. } \author{Original Fortran code: Christophe Croux and Peter Rousseeuw \email{rousse@wins.uia.ac.be}. \cr Port to C and R: Martin Maechler, \email{maechler@R-project.org} } \examples{ x <- c(1:10, 100+1:9)# 9 outliers out of 19 Sn(x) Sn(x, c=1)# 9 Sn(x[1:18], c=1)# 9 set.seed(153) x <- sort(c(rnorm(80), rt(20, df = 1))) s_Sn(x, mu.too=TRUE) } \keyword{robust} \keyword{univar} robustbase/man/mc.Rd0000644000176200001440000001032013325654361014070 0ustar liggesusers\name{mc} \alias{mc} \title{Medcouple, a Robust Measure of Skewness} \description{ Compute the \sQuote{medcouple}, a \emph{robust} concept and estimator of skewness. The medcouple is defined as a scaled median difference of the left and right half of distribution, and hence \emph{not} based on the third moment as the classical skewness. } \usage{ mc(x, na.rm = FALSE, doReflect = (length(x) <= 100), doScale = TRUE, # <- chg default to 'FALSE' ? eps1 = 1e-14, eps2 = 1e-15, # << new in 0.93-2 (2018-07..) maxit = 100, trace.lev = 0, full.result = FALSE) } \arguments{ \item{x}{a numeric vector} \item{na.rm}{logical indicating how missing values (\code{\link{NA}}s) should be dealt with.} \item{doReflect}{logical indicating if the internal MC should also be computed on the \emph{reflected} sample \code{-x}, with final result \code{(mc.(x) - mc.(-x))/2}. This makes sense since the internal MC, \code{mc.()} computes the himedian() which can differ slightly from the median.}%% only whenever sum(x <= med) * sum(x >= med) is even \item{doScale}{logical indicating if the internal algorithm should also \emph{scale} the data (using the most distant value from the median which is unrobust and numerically dangerous); scaling has been the hardwired default in the original algorithm and in \R's \code{mc()} till summer 2018.} \item{eps1, eps2}{tolerance in the algorithm; only change with care!} \item{maxit}{maximul number of iterations; typically a few should be sufficient.} \item{trace.lev}{integer specifying how much diagnostic output the algorithm (in C) should produce. No output by default, most output for \code{trace.lev = 5}.} \item{full.result}{logical indicating if the full return values (from C) should be returned as a list via \code{attr(*, "mcComp")}.} } % \details{ % ~~ If necessary, more details than the description above ~~ % } \value{ a number between -1 and 1, which is the medcouple, \eqn{MC(x)}. For \code{r <- mc(x, full.result = TRUE, ....)}, then \code{attr(r, "mcComp")} is a list with components \item{medc}{the medcouple \eqn{mc.(x)}.} \item{medc2}{the medcouple \eqn{mc.(-x)} if \code{doReflect=TRUE}.} \item{eps}{tolerances used.} \item{iter,iter2}{number of iterations used.} \item{converged,converged2}{logical specifying \dQuote{convergence}.} } \section{Convergence Problems}{ For extreme cases there \emph{are} convergence problems. Some of them can be alleviated by \dQuote{loosening} the tolerances \code{eps1} and \code{eps2}. \cr For others, with pecular values, notably many almost-ties with the median, it can help extremely to replace \code{mc(x, *)} by \code{mc(jitter(x), *)}.% MM: see also ~/R/MM/Pkg-ex/robustbase/Robnik-mc.R Also, the algorithm not only centers the data around the median but also scales them by the extremes which may have a negative effect e.g., when changing an extreme outlier to even more extreme, the result changes wrongly; see the 'mc10x' example. } \references{ Guy Brys, Mia Hubert and Anja Struyf (2004) A Robust Measure of Skewness; \emph{JCGS} \bold{13} (4), 996--1017. Hubert, M. and Vandervieren, E. (2008). An adjusted boxplot for skewed distributions, \emph{Computational Statistics and Data Analysis} \bold{52}, 5186--5201. } \author{Guy Brys; modifications by Tobias Verbeke and bug fixes and extensions by Manuel Koller and Martin Maechler. } \seealso{\code{\link{Qn}} for a robust measure of scale (aka \dQuote{dispersion}), .... } \examples{ mc(1:5) # 0 for a symmetric sample x1 <- c(1, 2, 7, 9, 10) mc(x1) # = -1/3 data(cushny) mc(cushny) # 0.125 stopifnot(mc(c(-20, -5, -2:2, 5, 20)) == 0, mc(x1, doReflect=FALSE) == -mc(-x1, doReflect=FALSE), all.equal(mc(x1, doReflect=FALSE), -1/3, tolerance = 1e-12)) ## Susceptibility of the current algorithm to large outliers : dX10 <- function(X) c(1:5,7,10,15,25, X) # generate skewed size-10 with 'X' x <- c(10,20,30, 100^(1:20)) (mc10x <- vapply(x, function(X) mc(dX10(X)), 1)) ## limit X -> Inf should be 7/12 = 0.58333... but that "breaks down a bit" : plot(x, mc10x, type="b", main = "mc( c(1:5,7,10,15,25, X) )", xlab="X", log="x") } \keyword{robust} \keyword{univar} robustbase/man/pulpfiber.Rd0000644000176200001440000000446513312375575015501 0ustar liggesusers\name{pulpfiber} \alias{pulpfiber} \encoding{utf-8} \docType{data} \title{Pulp Fiber and Paper Data} \description{ Measurements of aspects pulp fibers and the paper produced from them. Four properties of each are measured in sixty-two samples. } \usage{data(pulpfiber, package="robustbase")} \format{ A data frame with 62 observations on the following 8 variables. \describe{ \item{\code{X1}}{numeric vector of arithmetic fiber length} \item{\code{X2}}{numeric vector of long fiber fraction} \item{\code{X3}}{numeric vector of fine fiber fraction} \item{\code{X4}}{numeric vector of zero span tensile} % \item{\ }{\ }% ------------- white space -- \item{\code{Y1}}{numeric vector of breaking length} \item{\code{Y2}}{numeric vector of elastic modulus} \item{\code{Y3}}{numeric vector of stress at failure} \item{\code{Y4}}{numeric vector of burst strength} } } \details{ Cited from the reference article: \emph{The dataset contains measurements of properties of pulp fibers and the paper made from them. The aim is to investigate relations between pulp fiber properties and the resulting paper properties. The dataset contains \eqn{n = 62} measurements of the following four pulp fiber characteristics: arithmetic fiber length, long fiber fraction, fine fiber fraction, and zero span tensile. The four paper properties that have been measured are breaking length, elastic modulus, stress at failure, and burst strength.} The goal is to predict the \eqn{q = 4} paper properties from the \eqn{p = 4} fiber characteristics. } \source{ Rousseeuw, P. J., Van Aelst, S., Van Driessen, K., and Agulló, J. (2004) Robust multivariate regression; \emph{Technometrics} \bold{46}, 293--305. Till 2016 available from \code{http://users.ugent.be/~svaelst/data/pulpfiber.txt} } \author{port to \R and this help page: Martin Maechler } \references{ Lee, J. (1992) \emph{Relationships Between Properties of Pulp-Fibre and Paper}, unpublished doctoral thesis, U. Toronto, Faculty of Forestry. } \examples{ data(pulpfiber) str(pulpfiber) pairs(pulpfiber, gap=.1) ## 2 blocks of 4 .. c1 <- cov(pulpfiber) cR <- covMcd(pulpfiber) ## how different are they: The robust estimate has more clear high correlations: symnum(cov2cor(c1)) symnum(cov2cor(cR$cov)) } \keyword{datasets} robustbase/man/Qn.Rd0000644000176200001440000000702112321063405014037 0ustar liggesusers\name{Qn} \alias{Qn} \alias{Qn.old} \alias{s_Qn} % \title{Robust Location-Free Scale Estimate More Efficient than MAD} \description{ Compute the robust scale estimator \eqn{Q_n}{Qn}, an efficient alternative to the MAD. See the references for more. } \usage{ Qn(x, constant = 2.21914, finite.corr = missing(constant)) s_Qn(x, mu.too = FALSE, \dots) } \arguments{ \item{x}{numeric vector of observations.} \item{constant}{number by which the result is multiplied; the default achieves consistency for normally distributed data. Note that until Nov. 2010, \dQuote{thanks} to a typo in the very first papers, a slightly wrong default constant, 2.2219, was used instead of the correct one which is equal to \code{1 / (sqrt(2) * qnorm(5/8))} (as mentioned already on p.1277, after (3.7) in Rousseeuw and Croux (1993)). If you need the old slightly off version for historical reproducibility, you can use \code{Qn.old()}. Note that the relative difference is only about 1 in 1000, and that the correction should not affect the finite sample corrections for \eqn{n \le 9}{n <= 9}. } \item{finite.corr}{logical indicating if the finite sample bias correction factor should be applied. Defaults to \code{TRUE} unless \code{constant} is specified.} \item{mu.too}{logical indicating if the \code{\link[stats]{median}(x)} should also be returned for \code{s_Qn()}.} \item{\dots}{potentially further arguments for \code{s_Qn()} passed to \code{Qn()}.} } \value{ \code{Qn()} returns a number, the \eqn{Q_n}{Qn} robust scale estimator, scaled to be consistent for \eqn{\sigma^2} and i.i.d. Gaussian observatsions, optionally bias corrected for finite samples. \code{s_Qn(x, mu.too=TRUE)} returns a length-2 vector with location (\eqn{\mu}) and scale; this is typically only useful for \code{\link{covOGK}(*, sigmamu = s_Qn)}. } \details{ As the (default, consistency) constant needed to be corrected, the finite sample correction has been based on a much more extensive simulation, and on a 3rd or 4th degree polynomial model in \eqn{1/n} for odd or even n, respectively. } \references{ Rousseeuw, P.J. and Croux, C. (1993) Alternatives to the Median Absolute Deviation, \emph{Journal of the American Statistical Association} \bold{88}, 1273--1283. % MM: ~/save/papers/Rousseeuw/93/R+Croux_MAD_Sn_Qn.pdf Christophe Croux and Peter J. Rousseeuw (1992) Time-Efficient Algorithms for Two Highly Robust Estimators of Scale, \emph{Computational Statistics, Vol. 1}, ed. Dodge and Whittaker, Physica-Verlag Heidelberg, 411--428; available via Springer Link. % MM: ~/save/papers/robust-diverse/Croux-Rousseeuw-Timeff_Scale_1992.pdf %% no longer \url{http://win-www.uia.ac.be/u/statis/abstract/Timeff92.htm}. About the typo in the \code{constant}:\cr Christophe Croux (2010) Private e-mail, Fri Jul 16, w/ Subject \emph{Re: Slight inaccuracy of Qn implementation \dots\dots}. } \seealso{\code{\link[stats]{mad}} for the \sQuote{most robust} but much less efficient scale estimator; \code{\link{Sn}} for a similar faster but less efficient alternative. Finally, \code{\link{scaleTau2}} which some consider \dQuote{uniformly} better than Qn or competitors. } \author{Original Fortran code: Christophe Croux and Peter Rousseeuw \email{rousse@wins.uia.ac.be}. \cr Port to C and R: Martin Maechler, \email{maechler@R-project.org} } \examples{ set.seed(153) x <- sort(c(rnorm(80), rt(20, df = 1))) s_Qn(x, mu.too = TRUE) Qn(x, finite.corr = FALSE) } \keyword{robust} \keyword{univar} robustbase/man/steamUse.Rd0000644000176200001440000000622313312375575015271 0ustar liggesusers\name{steamUse} \title{Steam Usage Data (Excerpt)} \alias{steamUse} \docType{data} \encoding{utf8} \description{ The monthly use of steam (\code{Steam}) in a factory may be modeled and described as function of the operating days per month (\code{Operating.Days}) and mean outside temperature per month (\code{Temperature}). } \usage{data("steamUse", package="robustbase")} \format{ A data frame with 25 observations on the following 9 variables. \describe{ \item{\code{Steam}:}{regression response \eqn{Y}, the poinds of steam used monthly.} \item{\code{fattyAcid}:}{pounds of Real Fatty Acid in storage per month.} \item{\code{glycerine}:}{pounds of crude glycerine made.} \item{\code{wind}:}{average wind velocity in miles per hour (a numeric vector).} \item{\code{days}:}{an integer vector with number of days of that month, i.e., in \eqn{28..31}.} \item{\code{op.days}:}{the number of operating days for the given month (integer).} \item{\code{freeze.d}:}{the number of days below 32 degrees Fahrenheit (\eqn{= 0}\enc{°C}{'C} (C=Celsius) \eqn{=} freezing temperature of water).} \item{\code{temperature}:}{a numeric vector of average outside temperature in Fahrenheit (F).} \item{\code{startups}:}{the number of startups (of production in that month).} } } \details{ Nor further information is given in Draper and Smith, about the place and exacts years of the measurements, though some educated guesses should be possible, see the examples. } \source{ Data from Draper and Smith, 1st ed, 1966; appendix A. A version of this has been used in teaching at SfS ETH Zurich, since at least 1996, \url{https://stat.ethz.ch/Teaching/Datasets/NDK/dsteam.dat} The package \CRANpkg{aprean3} contains all data sets from the 3rd edition of Draper and Smith (1998), and this data set with variable names \code{x1 .. x10} (\code{x9} being \code{wind^2}, hence extraneous). } \references{ Draper and Smith (1981) Applied Regression Analysis (2nd ed., p. 615 ff) } \examples{ \dontrun{ if(require("aprean3")) { # show how 'steamUse' is related to 'dsa01a' stm <- dsa01a names(stm) <- c("Steam", "fattyAcid", "glycerine", "wind", "days", "op.days", "freeze.d", "temperature", "wind.2", "startups") ## prove that wind.2 is wind^2, "traditionally" rounded to 1 digit: stopifnot(all.equal(floor(0.5 + 10*stm[,"wind"]^2)/10, stm[,"wind.2"], tol = 1e-14)) ## hence drop it steamUse <- stm[, names(stm) != "wind.2"] } }% dont data(steamUse) str(steamUse) ## Looking at this, cbind(M=rep_len(month.abb, 25), steamUse[,5:8, drop=FALSE]) ## one will conjecture that these were 25 months, Jan--Jan in a row, ## starting in a leap year (perhaps 1960 ?). plot(steamUse) summary(fm1 <- lmrob(Steam ~ temperature + op.days, data=steamUse)) ## diagnoses 2 outliers: month of July, maybe company-wide summer vacations %% no longer visible: summary(fmF <- lmrob(Steam ~ ., data=steamUse)) ## KS2014 alone seems not robust enough: summary(fm.14 <- lmrob(Steam ~ temperature + op.days, data=steamUse, setting="KS2014")) pairs(Steam ~ temperature+op.days, steamUse) } \keyword{datasets} robustbase/man/plot-methods.Rd0000644000176200001440000000360012140441054016076 0ustar liggesusers\name{plot-methods} \docType{methods} \alias{plot-methods} \alias{plot,psi_func-method} \title{Plot an Object of the "Psi Function" Class} \description{ The \code{\link{plot}} method objects of class \code{\linkS4class{psi_func}} simply visualizes the \eqn{\rho()}, \eqn{\psi()}, and weight functions and their derivatives. } \usage{ \S4method{plot}{psi_func}(x, y, which = c("rho", "psi", "Dpsi", "wgt", "Dwgt"), main = "full", % shortMain = FALSE, col = c("black", "red3", "blue3", "dark green", "light green"), leg.loc = "right", ...) } \arguments{ \item{x}{object of class \code{\linkS4class{psi_func}} to be plotted} \item{y}{(optional) vector of abscissa values (to plot object at).} \item{which}{\code{\link{character}} vector of slots to be included in plot; by default, all of the slots are included} \item{main}{string or logical indicating the kind of plot title; either \code{"full"}, \code{"short"} or \code{FALSE} which chooses a full, a short or no main title at all.} %% \item{shortMain}{use short or long plot title}%-------- deprecated! \item{col}{colors to be used for the different slots} \item{leg.loc}{legend placement, see also \code{x} argument of \code{\link{legend}}} \item{...}{passed to \code{\link{matplot}}} } \note{ An earlier version had argument \code{shortMain} which is deprecated now. Use \code{main = "short"} instead of \code{shortMain = TRUE}. If you want to specify your own title, use \code{main=FALSE}, and a subsequent \code{\link{title}(...)} call. } \seealso{ \code{\link{psiFunc}()} and the \code{\link{class}} \code{\linkS4class{psi_func}}. } \examples{ plot(huberPsi) plot(huberPsi, which=c("psi", "Dpsi", "wgt"), main="short", leg = "topleft") plot(hampelPsi) ## Plotting aspect ratio = 1:1 : plot(hampelPsi, asp=1, main="short", which = c("psi", "Dpsi", "wgt", "Dwgt")) } \keyword{methods} robustbase/man/psiFindc.Rd0000644000176200001440000001247213177452122015236 0ustar liggesusers\name{psi.findc} \title{Find Tuning Constant(s) for "lqq" and "ggw" Psi Functions} \alias{.psi.ggw.findc}% --> ../R/lmrob.MM.R \alias{.psi.lqq.findc} \alias{.psi.const} \description{ Find psi function tuning constant sets for \code{"LQQ"} and \code{"GGW"} psi (\eqn{\psi}) functions by specifying largest descent (minimal slope), efficiency and or breakdown point. \code{.psi.const()} is called from \code{\link{lmrob.control}()} to set the tuning constants for psi and chi for \code{"LQQ"} and \code{"GGW"} psi. Unless the specified tuning constants are from fixed small set where the computations are stored precomputed, \code{.psi.const()} calls the corresponding \code{.psi..findc()}. } \usage{ .psi.ggw.findc(ms, b, eff = NA, bp = NA, subdivisions = 100L, rel.tol = .Machine$double.eps^0.25, abs.tol = rel.tol, tol = .Machine$double.eps^0.25, ms.tol = tol/64, maxiter = 1000) .psi.lqq.findc(ms, b.c, eff = NA, bp = NA, interval = c(0.1, 4), subdivisions = 100L, rel.tol = .Machine$double.eps^0.25, abs.tol = rel.tol, tol = .Machine$double.eps^0.25, maxiter = 1000) .psi.const(cc, psi) } \arguments{ \item{ms}{number, the minimal slope, typically negative.} \item{b, b.c}{number, specifying \eqn{b} or \eqn{b/c} for \code{"ggw"} or \code{"lqq"} respectively.} \item{eff}{a number (or \code{\link{NA}}), the desired \emph{efficiency}, in \eqn{[0,1]} of the estimator. If \code{NA}, \code{bp} must be specified as valid number.} \item{bp}{a number (or \code{\link{NA}}), the desired \emph{\bold{b}reakdown \bold{p}oint} of the estimator, in \eqn{[0,1]}.} \item{interval}{for finding \eqn{c} via \code{\link{uniroot}()}.} \item{subdivisions}{passed to \code{\link{integrate}()}.} \item{rel.tol, abs.tol}{relative and absolute tolerance for \code{\link{integrate}()}.} \item{tol}{relative tolerance for \code{\link{uniroot}()}.} \item{ms.tol}{relative tolerance for the internal \code{.psi.ggw.finda()}, eventually passed to \code{\link{optimize}} inside (internal) \code{.psi.ggw.mxs()}.} \item{maxiter}{maximal number of iterations for \code{\link{uniroot}()}.} %% for .psi.const() : \item{cc}{(for \code{.psi.const()}:) numeric vector of length 4, containing all constants \code{c(ms, b*, eff, bp)}, where \code{b* = b} for \code{"ggw"} and \code{b* = b.c} for \code{"lqq"}, and one of \code{(eff, bp)} is \code{NA}.} \item{psi}{a string, either \code{"ggw"} or \code{"lqq"}.} } \details{ For some important special cases, the result of \code{.psi.*.findc()} are stored precomputed for efficiency reasons. These cases are (the defaults for \code{tuning.chi} and \code{tuning.psi} respectively in \code{\link{lmrob.control}()}s result, \tabular{ll}{ \code{tuning.chi} \tab\code{tuning.psi} \cr \code{c(-0.5, 1.5, NA, 0.5)} \tab\code{c(-0.5, 1.5, 0.95, NA)} } and for \code{"ggw"} additionally, these four cases: \tabular{ll}{ \code{tuning.chi} \tab\code{tuning.psi} \cr {} \tab\code{c(-0.5, 1.5, 0.85, NA)} \cr \code{c(-0.5, 1, NA, 0.5)} \tab\code{c(-0.5, 1, 0.95, NA)} \cr {} \tab\code{c(-0.5, 1, 0.85, NA)} } %tab Note that for \code{"ggw"}, exactly these \eqn{2+4 = 6} cases also allow fast \eqn{\rho} and \eqn{\chi} (aka \eqn{\tilde\rho(\cdot)}{rho~(.)}, see \code{\link{Mchi}}), function evaluations. For all other tuning constant settings, rho() evaluations are based on numerical integration via \R's own \code{Rdqags()} C function (part of R's official API). } \value{ a \code{\link{numeric}} vector of constants, for \code{"lqq"} or \code{"ggw"} psi functions, respectively: \describe{ \item{\code{"lqq"}:}{\eqn{(b, c, s) = (b/c * c, c, s = 1 - min_slope)},} \item{\code{"ggw"}:}{\eqn{(0, a, b, c, \rho(\infty))}{% (0, a, b, c, rho(Inf))}.} } \code{.psi.const(cc, psi)} returns the argument \code{cc} with the above constant vectors as attribute \code{"constants"}, in the case of \code{psi = "lqq"} in all cases (since \pkg{robustbase} version >= 0.93), for \code{psi = "ggw"} only in the non-standard cases. } \references{ See the vignette about %% ../vignettes/psi_functions.Rnw : \dQuote{\eqn{\psi}{psi}-Functions Available in Robustbase}. } \seealso{\code{\link{Mpsi}()} etc for the psi function definitions; \code{\link{.Mpsi.tuning.defaults}}, etc, for tuning constants' defaults for \code{\link{lmrob}()}. } \author{Manuel Koller (original) and Martin Maechler (arguments, export, docs). } \examples{ (c.ge95 <- .psi.ggw.findc(ms = -0.5, b = 1.5, eff = 0.95)) (c.ge90 <- .psi.ggw.findc(ms = -0.5, b = 1.5, eff = 0.90)) (c.gb50 <- .psi.ggw.findc(ms = -0.5, b = 1.5, bp = 0.50)) stopifnot(all.equal(c.ge95, c(0, 1.386362, 1.5, 1.0628199, 4.7773893), tol = 1e-5), all.equal(c.ge90, c(0, 1.0282811, 1.5, 0.87086259, 3.2075233), tol = 1e-5), all.equal(c.gb50, c(0, 0.20367394, 1.5, 0.29591308, 0.37033962),tol = 1e-5)) (cl.e.95 <- .psi.lqq.findc(ms = -0.5, b.c = 1.5, eff = .95)) (cl.b.50 <- .psi.lqq.findc(ms = -0.5, b.c = 1.5, bp = .50)) stopifnot(all.equal(cl.e.95, c(1.4734061, 0.98227073, 1.5), tol = 1e-5), all.equal(cl.b.50, c(0.40154568, 0.26769712, 1.5), tol = 1e-5)) } \keyword{utilities} robustbase/man/cushny.Rd0000644000176200001440000000432013312375575015010 0ustar liggesusers\name{cushny} \encoding{utf8} \alias{cushny} \docType{data} \title{Cushny and Peebles Prolongation of Sleep Data} \description{ The original data set was bivariate and recorded for ten subjects the prolongation of sleep caused by two different drugs. These data were used by Student as the first illustration of the paired t-test which only needs the \emph{differences} of the two measurements. These differences are the values of \code{cushny}. } \usage{data(cushny, package="robustbase")} \format{ numeric vector, sorted increasingly:\cr 0 0.8 1 1.2 1.3 1.3 1.4 1.8 2.4 4.6 } \source{ Cushny, A.R. and Peebles, A.R. (1905) The action of optical isomers. II. Hyoscines. \emph{J. Physiol.} \bold{32}, 501--510. These data were used by Student(1908) as the first illustration of the paired t-test, see also \code{\link[datasets]{sleep}}; then cited by Fisher (1925) and thereforth copied in numerous books as an example of a normally distributed sample, see, e.g., Anderson (1958). } \references{ Student (1908) The probable error of a mean. \emph{Biometrika} \bold{6}, 1--25. Fisher, R.A. (1925) \emph{Statistical Methods for Research Workers}; Oliver & Boyd, Edinburgh. Anderson, T.W. (1958) \emph{An Introduction to Multivariate Statistical Analysis}; Wiley, N.Y. Hampel, F., Ronchetti, E., Rousseeuw, P. and Stahel, W. (1986) \emph{Robust Statistics: The Approach Based on Influence Functions}; Wiley, N.Y. } \examples{ data(cushny) plot(cushny, rep(0, 10), pch = 3, cex = 3, ylab = "", yaxt = "n") plot(jitter(cushny), rep(0, 10), pch = 3, cex = 2, main = "'cushny' data (n= 10)", ylab = "", yaxt = "n") abline(h=0, col="gray", lty=3) myPt <- function(m, lwd = 2, ..., e = 1.5*par("cxy")[2]) segments(m, +e, m, -e, lwd = lwd, ...) myPt( mean(cushny), col = "pink3") myPt(median(cushny), col = "light blue") legend("topright", c("mean", "median"), lwd = 2, col = c("pink3", "light blue"), inset = .01) ## The 'sleep' data from the standard 'datasets' package: d.sleep <- local({ gr <- with(datasets::sleep, split(extra, group)) gr[[2]] - gr[[1]] }) stopifnot(all.equal(cushny, sort(d.sleep), tolerance=1e-15)) } \keyword{datasets} robustbase/man/ltsPlot.Rd0000644000176200001440000001022213434014060015116 0ustar liggesusers\name{plot.lts} \alias{plot.lts} \alias{ltsPlot} \title{Robust LTS Regression Diagnostic Plots} \description{ Four plots (selectable by \code{which}) are currently provided: \enumerate{ \item a plot of the standardized residuals versus their index, \item a plot of the standardized residuals versus fitted values, \item a Normal Q-Q plot of the standardized residuals, and \item a regression diagnostic plot (standardized residuals versus robust distances of the predictor variables). } } \usage{ \method{plot}{lts}(x, which = c("all","rqq","rindex","rfit","rdiag"), classic=FALSE, ask = (which[1] == "all" && dev.interactive()), id.n, \dots) % ltsPlot(x, which = c("all","rqq","rindex","rfit","rdiag"), classic=FALSE, ask=(which=="all" && dev.interactive()), id.n, \dots) } \arguments{ \item{x}{a \code{lts} object, typically result of \code{ltsReg}.} \item{which}{string indicating which plot to show. See the \emph{Details} section for a description of the options. Defaults to \code{"all"}.}. \item{classic}{whether to plot the classical distances too. Default is \code{FALSE}.}. \item{ask}{logical indicating if the user should be \emph{ask}ed before each plot, see \code{\link{par}(ask=.)}. Defaults to \code{which == "all" && \link{dev.interactive}()}. } \item{id.n}{number of observations to be identified by a label starting with the most extreme. Default is the number of identified outliers (can be different for the different plots - see Details).} \item{\dots}{other parameters to be passed through to plotting functions.} } \details{ This function produces several plots based on the robust and classical regression estimates. Which of them to select is specified by the attribute \code{which}. The possible options are: \describe{ \item{\code{rqq}:}{Normal Q-Q plot of the standardized residuals;} \item{\code{rindex}:}{plot of the standardized residuals versus their index;} \item{\code{rfit}:}{plot of the standardized residuals versus fitted values;} \item{\code{rdiag}:}{regression diagnostic plot.} } The normal quantile plot produces a normal Q-Q plot of the standardized residuals. A line is drawn which passes through the first and third quantile. The \code{id.n} residuals with largest distances from this line are identified by labels (the observation number). The default for \code{id.n} is the number of regression outliers (lts.wt==0). In the Index plot and in the Fitted values plot the standardized residuals are displayed against the observation number or the fitted value respectively. A horizontal dashed line is drawn at 0 and two solid horizontal lines are located at +2.5 and -2.5. The id.n residuals with largest absolute values are identified by labels (the observation number). The default for id.n is the number regression outliers (lts.wt==0). The regression diagnostic plot, introduced by Rousseeuw and van Zomeren (1990), displays the standardized residuals versus robust distances. Following Rousseeuw and van Zomeren (1990), the horizontal dashed lines are located at +2.5 and -2.5 and the vertical line is located at the upper 0.975 percent point of the chi-squared distribution with p degrees of freedom. The id.n residuals with largest absolute values and/or largest robust Mahalanobis distances are identified by labels (the observation number). The default for id.n is the number of all outliers: regression outliers (lts.wt==0) + leverage (bad and good) points (RD > 0.975 percent point of the chi-squared distribution with p degrees of freedom). } %\value{} \references{ P. J. Rousseeuw and van Zomeren, B. C. (1990). Unmasking Multivariate Outliers and Leverage Points. \emph{Journal of the American Statistical Association} \bold{85}, 633--639. P. J. Rousseeuw and K. van Driessen (1999) A fast algorithm for the minimum covariance determinant estimator. \emph{Technometrics} \bold{41}, 212--223. } \seealso{ \code{\link{covPlot}} } \examples{ data(hbk) lts <- ltsReg(Y ~ ., data = hbk) lts plot(lts, which = "rqq") %% Improve: also show model 'call' } \keyword{hplot} \keyword{multivariate} robustbase/man/starsCYG.Rd0000644000176200001440000000304313312375575015177 0ustar liggesusers\name{starsCYG} \alias{starsCYG} \docType{data} \title{Hertzsprung-Russell Diagram Data of Star Cluster CYG OB1} \description{ Data for the Hertzsprung-Russell Diagram of the Star Cluster CYG OB1, which contains 47 stars in the direction of Cygnus, from C.Doom. The first variable is the logarithm of the effective temperature at the surface of the star (Te) and the second one is the logarithm of its light intencity (\eqn{L/L_0}). In the Hertzsprung-Russell diagram, which is the scatterplot of these data points, where the log temperature is plotted from left to right, two groups of points are seen:\cr the majority which tend to follow a steep band and four stars in the upper corner. In the astronomy the 43 stars are said to lie on the main sequence and the four remaining stars are called \dQuote{giants} (the points 11, 20, 30, 34). } \usage{data(starsCYG, package="robustbase")} \format{ A data frame with 47 observations on the following 2 variables \describe{ \item{\code{log.Te}}{Logarithm of the effective temperature at the surface of the star (Te).} \item{\code{log.light}}{Logarithm of its light intencity (\eqn{L/L_0})} } } \source{ P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection}; Wiley, p.27, table 3. } \examples{ data(starsCYG) plot(starsCYG) cst <- covMcd(starsCYG) lm.stars <- lm(log.light ~ log.Te, data = starsCYG) summary(lm.stars) plot(lm.stars) lts.stars <- ltsReg(log.light ~ log.Te, data = starsCYG) plot(lts.stars) } \keyword{datasets} robustbase/man/tukeyPsi1.Rd0000644000176200001440000000611712152143522015365 0ustar liggesusers\name{tukeyPsi1} \alias{robustbase-deprecated} \alias{tukeyPsi1} \alias{tukeyChi} \title{Tukey's Bi-square Score (Psi) and "Chi" (Rho) Functions and Derivatives} \description{ These are \bold{deprecated}, replaced by \code{\link{Mchi}(*, psi="tukey")}, \code{\link{Mpsi}(*, psi="tukey")} \code{tukeyPsi1()} computes Tukey's bi-square score (psi) function, its first derivative or it's integral/\dQuote{principal function}. This is scaled such that \eqn{\psi'(0) = 1}, i.e., \eqn{\psi(x) \approx x}{psi(x) ~= x} around 0. \code{tukeyChi()} computes Tukey's bi-square loss function, \code{chi(x)} and its first two derivatives. Note that in the general context of \eqn{M}-estimators, these loss functions are called \eqn{\rho (rho)}{rho}-functions. } \usage{ tukeyPsi1(x, cc, deriv = 0) tukeyChi (x, cc, deriv = 0) } \arguments{ \item{x}{numeric vector.} \item{cc}{ tuning constant } \item{deriv}{integer in \eqn{\{-1,0,1,2\}} specifying the order of the derivative; the default, \code{deriv = 0} computes the psi-, or chi- ("rho"-)function.} } \value{ a numeric vector of the same length as \code{x}. } \note{\code{tukeyPsi1(x, d)} and \code{\link{tukeyChi}(x, d+1)} are just re-scaled versions of each other (for \code{d in -1:1}), i.e., \deqn{\chi^{(\nu)}(x, c) = (6/c^2) \psi^{(\nu-1)}(x,c),} for \eqn{\nu = 0,1,2}. We use the name \sQuote{tukeyPsi\bold{1}}, because \code{tukeyPsi} is reserved for a future \dQuote{Psi Function} class object, see \code{\link{psiFunc}}. } \seealso{ \code{\link{lmrob}} and \code{\link{Mpsi}}; further \code{\link{anova.lmrob}} which needs the \code{deriv = -1}. } \author{Matias Salibian-Barrera, Martin Maechler and Andreas Ruckstuhl} \examples{ \dontshow{oop <- options(warn = -1) # against the "deprecated" warnings} op <- par(mfrow = c(3,1), oma = c(0,0, 2, 0), mgp = c(1.5, 0.6, 0), mar= .1+c(3,4,3,2)) x <- seq(-2.5, 2.5, length = 201) cc <- 1.55 # as set by default in lmrob.control() plot. <- function(...) { plot(...); abline(h=0,v=0, col="gray", lty=3)} plot.(x, tukeyChi(x, cc), type = "l", col = 2) plot.(x, tukeyChi(x, cc, deriv = 1), type = "l", col = 2) plot.(x, tukeyChi(x, cc, deriv = 2), type = "l", col = 2) % \ is escape for Rd mtext(sprintf("tukeyChi(x, c = \%g, deriv), deriv = 0,1,2", cc), outer = TRUE, font = par("font.main"), cex = par("cex.main")) par(op) op <- par(mfrow = c(3,1), oma = c(0,0, 2, 0), mgp = c(1.5, 0.6, 0), mar= .1+c(3,4,1,1)) x <- seq(-5, 5, length = 201) cc <- 4.69 # as set by default in lmrob.control() plot. <- function(...) { plot(..., asp = 1); abline(h=0,v=0, col="gray", lty=3)} plot.(x, tukeyPsi1(x, cc), type = "l", col = 2) abline(0:1, lty = 3, col = "light blue") plot.(x, tukeyPsi1(x, cc, deriv = -1), type = "l", col = 2) plot.(x, tukeyPsi1(x, cc, deriv = 1), type = "l", col = 2); abline(h=1,lty=3) % \ is escape for Rd mtext(sprintf("tukeyPsi1(x, c = \%g, deriv), deriv = 0, -1, 1", cc), outer = TRUE, font = par("font.main"), cex = par("cex.main")) par(op) \dontshow{options(oop)} } \keyword{robust} robustbase/man/lmrob.Rd0000644000176200001440000003065513216735015014614 0ustar liggesusers\title{MM-type Estimators for Linear Regression} \name{lmrob} \encoding{utf8} \alias{lmrob} % "Link to here", even those are not exported: \alias{.vcov.avar1} \alias{.vcov.w} \description{ Computes fast MM-type estimators for linear (regression) models. } \usage{ lmrob(formula, data, subset, weights, na.action, method = "MM", model = TRUE, x = !control$compute.rd, y = FALSE, singular.ok = TRUE, contrasts = NULL, offset = NULL, control = NULL, init = NULL, ...) } \arguments{ \item{formula}{a symbolic description of the model to be fit. See \code{\link{lm}} and \code{\link{formula}} for more details.} \item{data}{an optional data frame, list or environment (or object coercible by \code{\link{as.data.frame}} to a data frame) containing the variables in the model. If not found in \code{data}, the variables are taken from \code{environment(formula)}, typically the environment from which \code{lmrob} is called.} \item{subset}{an optional vector specifying a subset of observations to be used in the fitting process.} \item{weights}{an optional vector of weights to be used in the fitting process (in addition to the robustness weights computed in the fitting process).} \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. The default is set by the \code{na.action} setting of \code{\link{options}}, and is \code{\link{na.fail}} if that is unset. The \dQuote{factory-fresh} default is \code{\link{na.omit}}. Another possible value is \code{NULL}, no action. Value \code{\link{na.exclude}} can be useful.} \item{method}{string specifying the estimator-chain. \code{MM} is interpreted as \code{SM}. See \emph{Details}, notably the currently recommended \code{setting = "KS2014"}.} \item{model, x, y}{logicals. If \code{TRUE} the corresponding components of the fit (the model frame, the model matrix, the response) are returned.} \item{singular.ok}{logical. If \code{FALSE} (the default in S but not in \R) a singular fit is an error.} \item{contrasts}{an optional list. See the \code{contrasts.arg} of \code{\link{model.matrix.default}}.} \item{offset}{this can be used to specify an \emph{a priori} known component to be included in the linear predictor during fitting. An \code{\link{offset}} term can be included in the formula instead or as well, and if both are specified their sum is used.} \item{control}{a \code{\link{list}} specifying control parameters; use the function \code{\link{lmrob.control}(.)} and see its help page.} \item{init}{an optional argument to specify or supply the initial estimate. See \emph{Details}.} \item{\dots}{additional arguments can be used to specify control parameters directly instead of (but not in addition to!) via \code{control}.} } \details{ \describe{ \item{Overview:}{ This function computes an MM-type regression estimator as described in Yohai (1987) and Koller and Stahel (2011). By default it uses a bi-square redescending score function, and it returns a highly robust and highly efficient estimator (with 50\% breakdown point and 95\% asymptotic efficiency for normal errors). The computation is carried out by a call to \code{\link{lmrob.fit}()}. The argument \code{setting} of \code{\link{lmrob.control}} is provided to set alternative defaults as suggested in Koller and Stahel (2011) (\code{setting="KS2011"}; now do use its extension \code{setting="KS2014"}). For further details, see \code{\link{lmrob.control}}. } \item{Initial Estimator \code{init}:}{ The initial estimator may be specified using the argument \code{init}. This can either be a string, a function or a list. A \emph{string} can be used to specify built in internal estimators (currently \code{S} and \code{M-S}, see \emph{See also} below). A \code{\link{function}} taking arguments \code{x, y, control, mf} (where \code{mf} stands for \code{model.frame}) and returning a list containing at least the initial coefficients as \code{coefficients} and the initial scale estimate \code{scale}. Or a \emph{list} giving the initial coefficients and scale as \code{coefficients} and \code{scale}. See also \emph{Examples}. Note that if the \code{init} argument is a function or list, the \code{method} argument must \emph{not} contain the initial estimator, e.g., use \code{MDM} instead of \code{SMDM}. The default, equivalent to \code{init = "S"}, uses as initial estimator an S-estimator (Rousseeuw and Yohai, 1984) which is computed using the Fast-S algorithm of Salibian-Barrera and Yohai (2006), calling \code{\link{lmrob.S}()}. That function, since March 2012, by default uses \emph{nonsingular} subsampling which makes the Fast-S algorithm feasible for categorical data as well, see Koller (2012). Note that convergence problems may still show up as warnings, e.g., \preformatted{ S refinements did not converge (to refine.tol=1e-07) in 200 (= k.max) steps } and often can simply be remedied by increasing (i.e. weakening) \code{refine.tol} or increasing the allowed number of iterations \code{k.max}, see \code{\link{lmrob.control}}. } \item{Method \code{method}:}{ The following chain of estimates is customizable via the \code{method} argument. % of \code{\link{lmrob.control}}. There are currently two types of estimates available, \describe{ \item{\code{"M"}:}{corresponds to the standard M-regression estimate.} \item{\code{"D"}:}{stands for the Design Adaptive Scale estimate as proposed in Koller and Stahel (2011).} } The \code{method} argument takes a string that specifies the estimates to be calculated as a chain. Setting \code{method='SMDM'} will result in an intial S-estimate, followed by an M-estimate, a Design Adaptive Scale estimate and a final M-step. For methods involving a \code{D}-step, the default value of \code{psi} (see \code{\link{lmrob.control}}) is changed to \code{"lqq"}. By default, standard errors are computed using the formulas of Croux, Dhaene and Hoorelbeke (2003) (\code{\link{lmrob.control}} option \code{cov=".vcov.avar1"}). This method, however, works only for MM-estimates. For other \code{method} arguments, the covariance matrix estimate used is based on the asymptotic normality of the estimated coefficients (\code{cov=".vcov.w"}) as described in Koller and Stahel (2011). The var-cov computation can be skipped by \code{cov = "none"} and (re)done later by e.g., \code{vcov(, cov = ".vcov.w")}. As of robustbase version 0.91-0 (April 2014), the computation of robust standard errors for \code{method="SMDM"} has been changed. The old behaviour can be restored by setting the control parameter \code{cov.corrfact = "tauold"}.%% FIXME: regr.test for that } }%end {describe} } \value{ An object of class \code{lmrob}; a list including the following components: \item{coefficients}{The estimate of the coefficient vector} \item{scale}{The scale as used in the M estimator.} \item{residuals}{Residuals associated with the estimator.} %loss \item{converged}{\code{TRUE} if the IRWLS iterations have converged.} \item{iter}{number of IRWLS iterations} \item{rweights}{the \dQuote{robustness weights} \eqn{\psi(r_i/S) / (r_i/S)}.} \item{fitted.values}{Fitted values associated with the estimator.} %control \item{init.S}{The list returned by \code{\link{lmrob.S}} or \code{\link{lmrob.M.S}} (for MM-estimates only)} \item{init}{A similar list that contains the results of intermediate estimates (not for MM-estimates).} %qr \item{rank}{the numeric rank of the fitted linear model.} \item{cov}{The estimated covariance matrix of the regression coefficients} \item{df.residual}{the residual degrees of freedom.} %degree.freedom \item{weights}{the specified weights (missing if none were used).} \item{na.action}{(where relevant) information returned by \code{\link{model.frame}} on the special handling of \code{NA}s.} \item{offset}{the offset used (missing if none were used).} \item{contrasts}{(only where relevant) the contrasts used.} \item{xlevels}{(only where relevant) a record of the levels of the factors used in fitting.} \item{call}{the matched call.} \item{terms}{the \code{terms} object used.} %assign \item{model}{if requested (the default), the model frame used.} \item{x}{if requested, the model matrix used.} \item{y}{if requested, the response used.} In addition, non-null fits will have components \code{assign}, and \code{qr} relating to the linear fit, for use by extractor functions such as \code{summary}. } \references{ Croux, C., Dhaene, G. and Hoorelbeke, D. (2003) \emph{Robust standard errors for robust estimators}, Discussion Papers Series 03.16, K.U. Leuven, CES. Koller, M. (2012) Nonsingular subsampling for S-estimators with categorical predictors, \emph{ArXiv e-prints} \url{https://arxiv.org/abs/1208.5595}; extended version published as Koller and Stahel (2017), see \code{\link{lmrob.control}}. Koller, M. and Stahel, W.A. (2011) Sharpening Wald-type inference in robust regression for small samples. \emph{Computational Statistics & Data Analysis} \bold{55}(8), 2504--2515. Maronna, R. A., and Yohai, V. J. (2000) Robust regression with both continuous and categorical predictors. \emph{Journal of Statistical Planning and Inference} \bold{89}, 197--214. Rousseeuw, P.J. and Yohai, V.J. (1984) Robust regression by means of S-estimators, In \emph{Robust and Nonlinear Time Series}, J. Franke, W. Härdle and R. D. Martin (eds.). Lectures Notes in Statistics 26, 256--272, Springer Verlag, New York. Salibian-Barrera, M. and Yohai, V.J. (2006) A fast algorithm for S-regression estimates, \emph{Journal of Computational and Graphical Statistics} \bold{15}(2), 414--427. Yohai, V.J. (1987) High breakdown-point and high efficiency estimates for regression. \emph{The Annals of Statistics} \bold{15}, 642--65. Yohai, V., Stahel, W.~A. and Zamar, R. (1991) A procedure for robust estimation and inference in linear regression; in Stahel and Weisberg (eds), \emph{Directions in Robust Statistics and Diagnostics}, Part II, Springer, New York, 365--374; \doi{10.1007/978-1-4612-4444-8_20}. } \author{(mainly:) Matias Salibian-Barrera and Manuel Koller} \seealso{ \code{\link{lmrob.control}}; for the algorithms \code{\link{lmrob.S}}, \code{\link{lmrob.M.S}} and \code{\link{lmrob.fit}}; and for methods, \code{\link{summary.lmrob}}, for the extra \dQuote{statistics}, notably \eqn{R^2} (\dQuote{R squared}); \code{\link{predict.lmrob}}, \code{\link{print.lmrob}}, \code{\link{plot.lmrob}}, and \code{\link{weights.lmrob}}. } \examples{ data(coleman) set.seed(0) ## Default for a very long time: summary( m1 <- lmrob(Y ~ ., data=coleman) ) ## Nowadays **strongly recommended** for routine use: summary(m2 <- lmrob(Y ~ ., data=coleman, setting = "KS2014") ) ## ------------------ plot(residuals(m2) ~ weights(m2, type="robustness")) ##-> weights.lmrob() abline(h=0, lty=3) data(starsCYG, package = "robustbase") ## Plot simple data and fitted lines plot(starsCYG) lmST <- lm(log.light ~ log.Te, data = starsCYG) (RlmST <- lmrob(log.light ~ log.Te, data = starsCYG)) abline(lmST, col = "red") abline(RlmST, col = "blue") ## --> Least Sq.:/ negative slope \\ robust: slope ~= 2.2 % checked in ../tests/lmrob-data.R summary(RlmST) # -> 4 outliers; rest perfect vcov(RlmST) stopifnot(all.equal(fitted(RlmST), predict(RlmST, newdata = starsCYG), tol = 1e-14)) ## FIXME: setting = "KS2011" or setting = "KS2014" **FAIL** here ##--- 'init' argument ----------------------------------- ## 1) string set.seed(0) m3 <- lmrob(Y ~ ., data=coleman, init = "S") stopifnot(all.equal(m1[-18], m3[-18])) ## 2) function initFun <- function(x, y, control, ...) { # no 'mf' needed init.S <- lmrob.S(x, y, control) list(coefficients=init.S$coef, scale = init.S$scale) } set.seed(0) m4 <- lmrob(Y ~ ., data=coleman, method = "M", init = initFun) ## list m5 <- lmrob(Y ~ ., data=coleman, method = "M", init = list(coefficients = m3$init$coef, scale = m3$scale)) stopifnot(all.equal(m4[-17], m5[-17])) } \keyword{robust} \keyword{regression} robustbase/man/toxicity.Rd0000644000176200001440000000350513312375575015357 0ustar liggesusers\name{toxicity} \encoding{utf8} \alias{toxicity} \docType{data} \title{Toxicity of Carboxylic Acids Data} \description{ The aim of the experiment was to predict the toxicity of carboxylic acids on the basis of several molecular descriptors. } \usage{data(toxicity, package="robustbase")} \format{ A data frame with 38 observations on the following 10 variables which are attributes for carboxylic acids: \describe{ \item{\code{toxicity}}{aquatic toxicity, defined as \eqn{\log(IGC_{50}^{-1})}{log(IGC50^(-1))}; typically the \dQuote{response}.} \item{\code{logKow}}{\eqn{log Kow}, the partition coefficient} \item{\code{pKa}}{pKa: the dissociation constant} \item{\code{ELUMO}}{\bold{E}nergy of the \bold{l}owest \bold{u}noccupied \bold{m}olecular \bold{o}rbital} \item{\code{Ecarb}}{Electrotopological state of the \bold{carb}oxylic group} \item{\code{Emet}}{Electrotopological state of the \bold{met}hyl group} \item{\code{RM}}{Molar refractivity} \item{\code{IR}}{Refraction index} \item{\code{Ts}}{Surface tension} \item{\code{P}}{Polarizability} } } % \details{ % } \source{ The website accompanying the MMY-book: \url{http://www.wiley.com/legacy/wileychi/robust_statistics} } \references{ Maguna, F.P., Núñez, M.B., Okulik, N.B. and Castro, E.A. (2003) Improved QSAR analysis of the toxicity of aliphatic carboxylic acids; \emph{Russian Journal of General Chemistry} \bold{73}, 1792--1798. } \examples{ data(toxicity) summary(toxicity) plot(toxicity) plot(toxicity ~ pKa, data = toxicity) ## robustly scale the data (to scale 1) using Qn (scQ.tox <- sapply(toxicity, Qn)) scTox <- scale(toxicity, center = FALSE, scale = scQ.tox) csT <- covOGK(scTox, n.iter = 2, sigmamu = s_Qn, weight.fn = hard.rejection) as.dist(round(cov2cor(csT$cov), 2)) } \keyword{datasets} robustbase/man/milk.Rd0000644000176200001440000000421213312375575014433 0ustar liggesusers\name{milk} \alias{milk} \docType{data} \title{Daudin's Milk Composition Data} \description{ Daudin et al.(1988) give 8 readings on the composition of 86 containers of milk. They speak about 85 observations, but this can be explained with the fact that observations 63 and 64 are identical (as noted by Rocke (1996)). The data set was used for analysing the stability of principal component analysis by the bootstrap method. In the same context, but using high breakdown point robust PCA, these data were analysed by Todorov et al. (1994). Atkinson (1994) used these data for ilustration of the forward search algorithm for identifying of multiple outliers. } \usage{data(milk, package="robustbase")} \format{ A data frame with 86 observations on the following 8 variables, all but the first measure units in \emph{grams / liter}. \describe{ \item{\code{X1}}{density} \item{\code{X2}}{fat content} \item{\code{X3}}{protein content} \item{\code{X4}}{casein content} \item{\code{X5}}{cheese dry substance measured in the factory} \item{\code{X6}}{cheese dry substance measured in the laboratory} \item{\code{X7}}{milk dry substance} \item{\code{X8}}{cheese product} } } \source{ Daudin, J.J. Duby, C. and Trecourt, P. (1988) Stability of Principal Component Analysis Studied by the Bootstrap Method; \emph{Statistics} \bold{19}, 241--258. } \references{ Todorov, V., Neyko, N., Neytchev, P. (1994) Stability of High Breakdown Point Robust PCA, in \emph{Short Communications, COMPSTAT'94}; Physica Verlag, Heidelberg. Atkinson, A.C. (1994) Fast Very Robust Methods for the Detection of Multiple Outliers. \emph{J. Amer. Statist. Assoc.} \bold{89} 1329--1339. Rocke, D. M. and Woodruff, D. L. (1996) Identification of Outliers in Multivariate Data; \emph{J. Amer. Statist. Assoc.} \bold{91} (435), 1047--1061. } \examples{ data(milk) (c.milk <- covMcd(milk)) summarizeRobWeights(c.milk $ mcd.wt)# 19..20 outliers umilk <- unique(milk) # dropping obs.64 (== obs.63) summary(cumilk <- covMcd(umilk, nsamp = "deterministic")) # 20 outliers %%not yet ## the best 'crit' we've seen was } \keyword{datasets} robustbase/man/smoothWgt.Rd0000644000176200001440000000465412441665126015500 0ustar liggesusers\name{smoothWgt} \alias{smoothWgt} \title{Smooth Weighting Function - Generalized Biweight}% The Biweight on a Stick \description{ \dQuote{The Biweight on a Stick} --- Compute a smooth (when \eqn{h > 0}) weight function typically for computing weights from large (robust) \dQuote{distances} using a piecewise polynomial function which in fact is a 2-parameter generalization of Tukey's 1-parameter \dQuote{biweight}. } \usage{ smoothWgt(x, c, h) } \arguments{ \item{x}{numeric vector of abscissa values} \item{c}{\dQuote{cutoff}, a typically positive number.} \item{h}{\dQuote{bandwidth}, a positive number.} } \details{ Let \eqn{w(x;c,h) := }\code{smoothWgt(x, c, h)}. Then, \deqn{% "FIXME": rather use amsmath package \cases{.} w(x; c,h) := 0 \ \ \ \ \ \mathrm{if}\ |x| \ge c + h/2,}{% w(x; c,h) := 0 if |x| >= c + h/2,} \deqn{ w(x; c,h) := 1 \ \ \ \ \ \mathrm{if}\ |x| \le c - h/2,}{% w(x; c,h) := 1 if |x| <= c - h/2,} \deqn{ w(x; c,h) := \bigl((1 - |x| - (c-h/2))^2\bigr)^2 \ \mathrm{if}\ c-h/2 < |x| < c+h/2,}{% w(x; c,h) := (1 - (|x| - (c-h/2))^2)^2 if c-h/2 < |x| < c+h/2.} \code{smoothWgt()} is \emph{scale invariant} in the sense that \deqn{w(\sigma x; \sigma c, \sigma h) = w(x; c, h),}{% w(S x; S c, S h) = w(x; c, h),} when \eqn{\sigma > 0}{S > 0}. } \value{ a numeric vector of the same length as \code{x} with weights between zero and one. Currently all \code{\link{attributes}} including \code{\link{dim}} and \code{\link{names}} are dropped. } %% \references{ TODO: Write a small vignette ! %% } \author{Martin Maechler} \seealso{ \code{\link{Mwgt}(.., psi = "bisquare")} of which \code{smoothWgt()} is a generalization, and \code{\link{Mwgt}(.., psi = "optimal")} which looks similar for larger \code{c} with its constant one part around zero, but also has only one parameter. } \examples{ ## a somewhat typical picture: curve(smoothWgt(x, c=3, h=1), -5,7, n = 1000) csW <- curve(smoothWgt(x, c=1/2, h=1), -2,2) # cutoff 1/2, bandwidth 1 ## Show that the above is the same as ## Tukey's "biweight" or "bi-square" weight function: bw <- function(x) pmax(0, (1 - x^2))^2 cbw <- curve(bw, col=adjustcolor(2, 1/2), lwd=2, add=TRUE) cMw <- curve(Mwgt(x,c=1,"biweight"), col=adjustcolor(3, 1/2), lwd=2, add=TRUE) stopifnot(## proving they are all the same: all.equal(csW, cbw, tol=1e-15), all.equal(csW, cMw, tol=1e-15)) } \keyword{arith} \keyword{robust} robustbase/man/rankMM.Rd0000644000176200001440000000242712424475524014670 0ustar liggesusers\name{rankMM} \title{Simple Matrix Rank} \alias{rankMM} \description{ Compute the rank of a matrix \code{A} in simple way, based on the SVD, \code{\link{svd}()}, and \dQuote{the same as Matlab}. } \usage{ rankMM(A, tol = NULL, sv = svd(A, 0, 0)$d) } \arguments{ \item{A}{a numerical matrix, maybe non-square. When \code{sv} is specified, only \code{dim(A)} is made use of.} \item{tol}{numerical tolerance (compared to singular values). By default, when \code{NULL}, the tolerance is determined from the maximal value of \code{sv} and the computer epsilon.} \item{sv}{vector of \emph{non-increasing} singular values of \code{A}, (to be passed if already known).} } \seealso{ There are more sophisticated proposals for computing the rank of a matrix; for a couple of those, see \code{\link[Matrix]{rankMatrix}} in the \pkg{Matrix} package. } \value{ an integer from the set \code{0:min(dim(A))}. } \author{ Martin Maechler, Date: 7 Apr 2007 } \examples{ rankMM # - note the simple function definition hilbert <- function(n) { i <- seq_len(n); 1/outer(i - 1L, i, "+") } hilbert(4) H12 <- hilbert(12) rankMM(H12) # 11 - numerically more realistic rankMM(H12, tol=0) # -> 12 ## explanation : round(log10(svd(H12, 0,0)$d), 1) } \keyword{algebra} \keyword{array} robustbase/man/h.alpha.n.Rd0000644000176200001440000000251510614156473015246 0ustar liggesusers\name{h.alpha.n} \alias{h.alpha.n} \title{Compute h, the subsample size for MCD and LTS} \description{ Compute h(alpha) which is the size of the subsamples to be used for MCD and LTS. Given \eqn{\alpha = alpha}{alpha}, \eqn{n} and \eqn{p}, \eqn{h} is an \emph{integer}, \eqn{h \approx \alpha n}{h ~= alpha*n}, where the exact formula also depends on \eqn{p}. For \eqn{\alpha = 1/2}, \code{h == floor(n+p+1)/2}; for the general case, it's simply \code{n2 <- (n+p+1) \%/\% 2; floor(2*n2 - n + 2*(n-n2)*alpha)}. } \usage{ h.alpha.n(alpha, n, p) } \arguments{ \item{alpha}{fraction, numeric (vector) in [0.5, 1], see, e.g., \code{\link{covMcd}}.} \item{n}{integer (valued vector), the sample size.} \item{p}{integer (valued vector), the dimension.} } \value{ numeric vector of \eqn{h(\alpha, n,p)}; when any of the arguments of length greater than one, the usual \R arithmetic (recycling) rules are used. } \seealso{\code{\link{covMcd}} and \code{\link{ltsReg}} which are \emph{defined} by \eqn{h = h(\alpha,n,p)} and hence both use \code{h.alpha.n}. } \examples{ n <- c(10:20,50,100) p <- 5 ## show the simple "alpha = 1/2" case: cbind(n=n, h= h.alpha.n(1/2, n, p), n2p = floor((n+p+1)/2)) ## alpha = 3/4 is recommended by some authors : n <- c(15, 20, 25, 30, 50, 100) cbind(n=n, h= h.alpha.n(3/4, n, p = 6)) } \keyword{arith} robustbase/man/Animals2.Rd0000644000176200001440000000375611645020156015146 0ustar liggesusers\name{Animals2} \alias{Animals2} \title{Brain and Body Weights for 65 Species of Land Animals} \description{ A data frame with average brain and body weights for 62 species of land mammals and three others. Note that this is simply the union of \code{\link[MASS]{Animals}} and \code{\link[MASS]{mammals}}. } \usage{ Animals2 } \format{ \describe{ \item{\code{body}}{body weight in kg} \item{\code{brain}}{brain weight in g} } } \source{ Weisberg, S. (1985) \emph{Applied Linear Regression.} 2nd edition. Wiley, pp. 144--5. P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection.} Wiley, p. 57. } \references{ Venables, W. N. and Ripley, B. D. (2002) \emph{Modern Applied Statistics with S.} Forth Edition. Springer. } \note{ After loading the \pkg{MASS} package, the data set is simply constructed by \code{Animals2 <- local({D <- rbind(Animals, mammals); unique(D[order(D$body,D$brain),])})}. Rousseeuw and Leroy (1987)'s \sQuote{brain} data is the same as \pkg{MASS}'s \code{Animals} (with Rat and Brachiosaurus interchanged, see the example below). } \examples{ data(Animals2) ## Sensible Plot needs doubly logarithmic scale plot(Animals2, log = "xy") ## Regression example plot: plotbb <- function(bbdat) { d.name <- deparse(substitute(bbdat)) plot(log(brain) ~ log(body), data = bbdat, main = d.name) abline( lm(log(brain) ~ log(body), data = bbdat)) abline(MASS::rlm(log(brain) ~ log(body), data = bbdat), col = 2) legend("bottomright", leg = c("lm", "rlm"), col=1:2, lwd=1, inset = 1/20) } plotbb(bbdat = Animals2) ## The `same' plot for Rousseeuw's subset: data(Animals, package = "MASS") brain <- Animals[c(1:24, 26:25, 27:28),] plotbb(bbdat = brain) lbrain <- log(brain) plot(mahalanobis(lbrain, colMeans(lbrain), var(lbrain)), main = "Classical Mahalanobis Distances") mcd <- covMcd(lbrain) plot(mahalanobis(lbrain,mcd$center,mcd$cov), main = "Robust (MCD) Mahalanobis Distances") } \keyword{datasets} robustbase/man/lmrob..D..fit.Rd0000644000176200001440000000362513212743621015706 0ustar liggesusers\name{lmrob..D..fit} \alias{lmrob..D..fit} \title{Compute Design Adaptive Scale estimate} \description{This function calculates a Design Adaptive Scale estimate for a given MM-estimate. This is supposed to be a part of a chain of estimates like \code{SMD} or \code{SMDM}. } \usage{ lmrob..D..fit(obj, x=obj$x, control = obj$control, mf = obj$model, method = obj$control$method) } \arguments{ \item{obj}{\code{lmrob}-object based on which the estimate is to be calculated.} \item{x}{the design matrix; if \code{\link{missing}}, the method tries to get it from \code{obj$x} and if this fails from \code{obj$model}.} \item{control}{list of control parameters, as returned by \code{\link{lmrob.control}}.} \item{mf}{unused and deprecated.} \item{method}{optional; the \code{method} used for \emph{obj} computation.} } \details{ This function is used by \code{\link{lmrob.fit}} and typically not to be used on its own. Note that \code{lmrob.fit()} specifies \code{control} potentially differently than the default, but does use the default for \code{method}. } \value{The given \code{lmrob}-object with the following elements updated: \item{scale}{The Design Adaptive Scale estimate} \item{converged}{ \code{TRUE} if the scale calculation converged, \code{FALSE} other.} } \references{ Koller, M. and Stahel, W.A. (2011), Sharpening Wald-type inference in robust regression for small samples, \emph{Computational Statistics & Data Analysis} \bold{55}(8), 2504--2515. } \seealso{ \code{\link{lmrob.fit}}, \code{\link{lmrob}} } \examples{ data(stackloss) ## Compute manual SMD-estimate: ## 1) MM-estimate m1 <- lmrob(stack.loss ~ ., data = stackloss) ## 2) Add Design Adaptive Scale estimate m2 <- lmrob..D..fit(m1) print(c(m1$scale, m2$scale)) summary(m1) summary(m2) ## the covariance matrix estimate is also updated } \author{Manuel Koller} \keyword{robust} \keyword{regression} robustbase/man/classPC.Rd0000644000176200001440000000705112661565243015032 0ustar liggesusers\name{classPC} \title{Compute Classical Principal Components via SVD or Eigen} \alias{classPC} \concept{PCA} \description{ Compute classical principal components (PC) via SVD (\code{\link{svd}} or eigenvalue decomposition (\code{\link{eigen}}) with non-trivial rank determination. } \usage{ classPC(x, scale = FALSE, center = TRUE, signflip = TRUE, via.svd = n > p, scores = FALSE) } \arguments{ \item{x}{a numeric \code{\link{matrix}}.} \item{scale}{logical indicating if the matrix should be scaled; it is mean centered in any case (via \code{\link{scale}(*, scale=scale)}c} \item{center}{logical or numeric vector for \dQuote{centering} the matrix.} \item{signflip}{logical indicating if the sign(.) of the loadings should be determined should flipped such that the absolutely largest value is always positive.} \item{via.svd}{logical indicating if the computation is via SVD or Eigen decomposition; the latter makes sense typically only for n <= p.} \item{scores}{logical indicating} } \author{ Valentin Todorov; efficiency tweaks by Martin Maechler } \value{ a \code{\link{list}} with components \item{rank}{the (numerical) matrix rank of \code{x}; an integer number, say \eqn{k}, from \code{0:min(dim(x))}. In the \eqn{n > p} case, it is \code{\link{rankMM}(x)}.} \item{eigenvalues}{the \eqn{k} eigenvalues, in the \eqn{n > p} case, proportional to the variances.} \item{loadings}{the loadings, a \eqn{p \times k}{p * k} matrix.} \item{scores}{if the \code{scores} argument was true, the \eqn{n \times k}{n * k} matrix of scores, where \eqn{k} is the \code{rank} above.} \item{center}{a numeric \eqn{p}-vector of means, unless the \code{center} argument was false.} \item{scale}{if the \code{scale} argument was not false, the \code{scale} used, a \eqn{p}-vector.} } %% \details{ %% } %% \references{ %% } \seealso{ In spirit very similar to \R's standard \code{\link{prcomp}} and \code{\link{princomp}}, one of the main differences being how the \emph{rank} is determined via a non-trivial tolerance. } \examples{ set.seed(17) x <- matrix(rnorm(120), 10, 12) # n < p {the unusual case} pcx <- classPC(x) (k <- pcx$rank) # = 9 [after centering!] pc2 <- classPC(x, scores=TRUE) pcS <- classPC(x, via.svd=TRUE) all.equal(pcx, pcS, tol = 1e-8) ## TRUE: eigen() & svd() based PC are close here pc0 <- classPC(x, center=FALSE, scale=TRUE) pc0$rank # = 10 here *no* centering (as E[.] = 0) ## Loadings are orthnormal: zapsmall( crossprod( pcx$loadings ) ) ## PC Scores are roughly orthogonal: S.S <- crossprod(pc2$scores) print.table(signif(zapsmall(S.S), 3), zero.print=".") stopifnot(all.equal(pcx$eigenvalues, diag(S.S)/k)) ## the usual n > p case : pc.x <- classPC(t(x)) pc.x$rank # = 10, full rank in the n > p case cpc1 <- classPC(cbind(1:3)) # 1-D matrix stopifnot(cpc1$rank == 1, all.equal(cpc1$eigenvalues, 1), all.equal(cpc1$loadings, 1)) \dontshow{ stopifnot(classPC(x, center=FALSE)$rank == min(dim(x))) ii <- names(pcx); ii <- ii[ii != "scores"] stopifnot(all.equal(pcx[ii], pc2[ii], tol=0), all.equal(pcx, pcS, tol=1e-8), length(pc.x$center) == 10, identical(pc0$center, FALSE), all.equal(crossprod(pcx $loadings), diag(9)), all.equal(crossprod(pc.x$loadings), diag(10)), all.equal(colSums(abs(pcx$loadings)), c(2.69035673, 2.78449399, 3.00148438, 2.9016688, 2.49400759, 2.90477204, 3.01639807, 2.4217181, 2.64665957)), length(pc0$scale) == 12) }% dont.. } \keyword{multivariate} robustbase/man/lmrob.lar.Rd0000644000176200001440000000375513212743621015370 0ustar liggesusers\name{lmrob.lar} \alias{lmrob.lar} \title{Least Absolute Residuals / L1 Regression} \description{ To compute least absolute residuals (LAR) or \dQuote{L1} regression, \code{lmrob.lar} implements the routine L1 in Barrodale and Roberts (1974), which is based on the simplex method of linear programming. It is a copy of \code{lmRob.lar} (in early 2012) from the \pkg{robust} package. } \usage{ lmrob.lar(x, y, control, \dots) } \arguments{ \item{x}{numeric matrix for the predictors.} \item{y}{numeric vector for the response.} \item{control}{\code{\link{list}} as returned by \code{\link{lmrob.control}()} .} \item{\dots}{(unused but needed when called as \code{init(x,y,ctrl, mf)} from \code{\link{lmrob}()})} } \details{ This method is used for computing the M-S estimate and typically not to be used on its own. A description of the Fortran subroutines used can be found in Marazzi (1993). In the book, the main method is named \code{RILARS}. } \value{ A list that includes the following components: \item{coef }{The L1-estimate of the coefficient vector} \item{scale }{The residual scale estimate (mad)} \item{resid }{The residuals} \item{iter }{The number of iterations required by the simplex algorithm} \item{status }{Return status (0: optimal, but non unique solution, 1: optimal unique solution)} \item{converged }{Convergence status (always \code{TRUE}), needed for \code{\link{lmrob.fit}}.} } \references{ Marazzi, A. (1993). \emph{Algorithms, routines, and S functions for robust statistics}. Wadsworth & Brooks/Cole, Pacific Grove, CA. } \author{ Manuel Koller } \seealso{ \code{\link[quantreg]{rq}} from package \pkg{quantreg}. } \examples{ data(stackloss) X <- model.matrix(stack.loss ~ . , data = stackloss) y <- stack.loss (fm.L1 <- lmrob.lar(X, y)) with(fm.L1, stopifnot(converged , status == 1L , all.equal(scale, 1.5291576438) , sum(abs(residuals) < 1e-15) == 4 # p=4 exactly fitted obs. )) } \keyword{ L1 } \keyword{ regression } robustbase/man/phosphor.Rd0000644000176200001440000000166513312375575015352 0ustar liggesusers\name{phosphor} \alias{phosphor} \docType{data} \title{Phosphorus Content Data} \description{ This dataset investigates the effect from inorganic and organic Phosphorus in the soil upon the phosphorus content of the corn grown in this soil, from Prescott (1975). } \usage{data(phosphor, package="robustbase")} \format{ A data frame with 18 observations on the following 3 variables. \describe{ \item{\code{inorg}}{Inorganic soil Phosphorus} \item{\code{organic}}{Organic soil Phosphorus} \item{\code{plant}}{Plant Phosphorus content} } } \source{ P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection.} Wiley, p.156, table 24. } \examples{ data(phosphor) plot(phosphor) summary(lm.phosphor <- lm(plant ~ ., data = phosphor)) summary(lts.phosphor <- ltsReg(plant ~ ., data = phosphor)) phosphor.x <- data.matrix(phosphor[, 1:2]) cPh <- covMcd(phosphor.x) plot(cPh, "dd") } \keyword{datasets} robustbase/man/glmrob.control.Rd0000644000176200001440000000312612150222661016425 0ustar liggesusers\name{glmrob..control} \title{Controlling Robust GLM Fitting by Different Methods} \alias{glmrobMqle.control} \alias{glmrobMT.control} \alias{glmrobBY.control} \description{ These are auxiliary functions as user interface for \code{\link{glmrob}} fitting when the different methods, \code{"Mqle"}, \code{"BY"}, or \code{"MT"} are used. Typically only used when calling \code{\link{glmrob}}. } \usage{ glmrobMqle.control(acc = 1e-04, test.acc = "coef", maxit = 50, tcc = 1.345) glmrobBY.control (maxit = 1000, const = 0.5, maxhalf = 10) glmrobMT.control (cw = 2.1, nsubm = 500, acc = 1e-06, maxit = 200) } \arguments{ \item{acc}{positive convergence tolerance; the iterations converge when ???} \item{test.acc}{Only "coef" is currently implemented} \item{maxit}{integer giving the maximum number of iterations. } \item{tcc}{tuning constant c for Huber's psi-function} \item{const}{for "BY", the normalizing constant ..}% FIXME \item{maxhalf}{for "BY"; the number of halving steps when the gradient itself no longer improves. We have seen examples when increasing \code{maxhalf} was of relevance.} \item{cw}{tuning constant c for Tukey's biweight psi-function} \item{nsubm}{the number of subsamples to take for finding an initial estimate for \code{method = "MT"}.} } %% \details{ %% } \value{ A \code{\link{list}} with the arguments as components. } \author{Andreas Ruckstuhl and Martin Maechler} \seealso{\code{\link{glmrob}}} \examples{ str(glmrobMqle.control()) str(glmrobBY.control()) str(glmrobMT.control()) } \keyword{robust} \keyword{regression} \keyword{nonlinear} robustbase/man/possumDiv.Rd0000644000176200001440000001161313312375575015473 0ustar liggesusers\name{possumDiv} \alias{possumDiv} \alias{possum.mat} \docType{data} \title{Possum Diversity Data} \description{ Possum diversity data: As issued from a study of the diversity of possum (arboreal marsupials) in the Montane ash forest (Australia), this dataset was collected in view of the management of hardwood forest to take conservation and recreation values, as well as wood production, into account. The study is fully described in the two references. The number of different species of arboreal marsupials (possum) was observed on 151 different 3ha sites with uniform vegetation. For each site the nine variable measures (see below) were recorded. The problem is to model the relationship between \code{diversity} and these other variables. } \usage{data(possumDiv, package="robustbase")} \format{ Two different representations of the same data are available: \code{possumDiv} is a data frame of 151 observations of 9 variables, where the last two are factors, \code{eucalyptus} with 3 levels and \code{aspect} with 4 levels. \code{possum.mat} is a numeric (integer) matrix of 151 rows (observations) and 14 columns (variables) where the last seven ones are 0-1 dummy variables, three (\code{E.*}) are coding for the kind of \code{eucalyptus} and the last four are 0-1 coding for the \code{aspect} factor. The variables have the following meaning: \describe{ \item{Diversity}{main variable of interest is the number of different species of arboreal marsupial (possum) observed, with values in 0:5.} \item{Shrubs}{the number of shrubs.} \item{Stumps}{the number of cut stumps from past logging operations.} \item{Stags}{the number of stags (hollow-bearing trees).} \item{Bark}{bark index (integer) vector reflecting the quantity of decorticating bark.} \item{Habitat}{an integer score indicating the suitability of nesting and foraging habitat for Leadbeater's possum.} \item{BAcacia}{a numeric vector giving the basal area of acacia species.} \cr \item{eucalyptus}{a 3-level \code{\link{factor}} specifying the species of eucalypt with the greatest stand basal area. This has the same information as the following three variables} \item{E.regnans}{0-1 indicator for Eucalyptus regnans} \item{E.delegatensis}{0-1 indicator for Eucalyptus deleg.} \item{E.nitens}{0-1 indicator for Eucalyptus nitens} \cr \item{aspect}{a 4-level \code{\link{factor}} specifying the aspect of the site. It is the same information as the following four variables.} \item{NW-NE}{0-1 indicator} \item{NW-SE}{0-1 indicator} \item{SE-SW}{0-1 indicator} \item{SW-NW}{0-1 indicator} } } \source{ Eva Cantoni (2004) Analysis of Robust Quasi-deviances for Generalized Linear Models. \emph{Journal of Statistical Software} \bold{10}, 04, \url{http://www.jstatsoft.org/v10/i04} } \references{ Lindenmayer, D. B., Cunningham, R. B., Tanton, M. T., Nix, H. A. and Smith, A. P. (1991) The conservation of arboreal marsupials in the montane ash forests of the central highlands of victoria, south-east australia: III. The habitat requirements of leadbeater's possum \emph{gymnobelideus leadbeateri} and models of the diversity and abundance of arboreal marsupials. \emph{Biological Conservation} \bold{56}, 295--315. Lindenmayer, D. B., Cunningham, R. B., Tanton, M. T., Smith, A. P. and Nix, H. A. (1990) The conservation of arboreal marsupials in the montane ash forests of the victoria, south-east australia, I. Factors influencing the occupancy of trees with hollows, \emph{Biological Conservation} \bold{54}, 111--131. See also the references in \code{\link{glmrob}}. } \examples{ data(possumDiv) head(possum.mat) str(possumDiv) ## summarize all variables as multilevel factors: summary(as.data.frame(lapply(possumDiv, function(v) if(is.integer(v)) factor(v) else v))) ## Following Cantoni & Ronchetti (2001), JASA, p.1026 f.:% cf. ../tests/poisson-ex.R pdFit <- glmrob(Diversity ~ . , data = possumDiv, family=poisson, tcc = 1.6, weights.on.x = "hat", acc = 1e-15) summary(pdFit) summary(pdF2 <- update(pdFit, ~ . -Shrubs)) summary(pdF3 <- update(pdF2, ~ . -eucalyptus)) summary(pdF4 <- update(pdF3, ~ . -Stumps)) summary(pdF5 <- update(pdF4, ~ . -BAcacia)) summary(pdF6 <- update(pdF5, ~ . -aspect))# too much .. anova(pdFit, pdF3, pdF4, pdF5, pdF6, test = "QD") # indeed, ## indeed, the last simplification is too much possumD.2 <- within(possumDiv, levels(aspect)[1:3] <- rep("other", 3)) ## and use this binary 'aspect' instead of the 4-level one: summary(pdF5.1 <- update(pdF5, data = possumD.2)) if(FALSE) # not ok, as formually not nested. anova(pdF5, pdF5.1) summarizeRobWeights(weights(pdF5.1, type="rob"), eps = 0.73) ##-> "outliers" (1, 59, 110) wrob <- setNames(weights(pdF5.1, type="rob"), rownames(possumDiv)) head(sort(wrob)) } \keyword{datasets} robustbase/man/carrots.Rd0000644000176200001440000000342113312375575015155 0ustar liggesusers\name{carrots} \alias{carrots} \docType{data} \title{Insect Damages on Carrots} \description{ The damage carrots data set from Phelps (1982) was used by McCullagh and Nelder (1989) in order to illustrate diagnostic techniques because of the presence of an outlier. In a soil experiment trial with three blocks, eight levels of insecticide were applied and the carrots were tested for insect damage. } \usage{data(carrots, package="robustbase")} \format{ A data frame with 24 observations on the following 4 variables. \describe{ \item{success}{ integer giving the number of carrots with insect damage.} \item{total}{ integer giving the total number of carrots per experimental unit.} \item{logdose}{a numeric vector giving log(dose) values (eight different levels only).} \item{block}{factor with levels \code{B1} to \code{B3}} } } \source{ Phelps, K. (1982). Use of the complementary log-log function to describe doseresponse relationships in insecticide evaluation field trials. \cr In R. Gilchrist (Ed.), \emph{Lecture Notes in Statistics, No. 14. GLIM.82: Proceedings of the International Conference on Generalized Linear Models}; Springer-Verlag. } \references{ McCullagh P. and Nelder, J. A. (1989) \emph{Generalized Linear Models.} London: Chapman and Hall. Eva Cantoni and Elvezio Ronchetti (2001); JASA, and \cr Eva Cantoni (2004); JSS, see \code{\link{glmrob}} } \examples{ data(carrots) str(carrots) plot(success/total ~ logdose, data = carrots, col = as.integer(block)) coplot(success/total ~ logdose | block, data = carrots) ## Classical glm Cfit0 <- glm(cbind(success, total-success) ~ logdose + block, data=carrots, family=binomial) summary(Cfit0) ## Robust Fit (see help(glmrob)) .... } \keyword{datasets} robustbase/man/epilepsy.Rd0000644000176200001440000000516013312375575015334 0ustar liggesusers\name{epilepsy} \alias{epilepsy} \docType{data} \title{Epilepsy Attacks Data Set} \description{Data from a clinical trial of 59 patients with epilepsy (Breslow, 1996) in order to illustrate diagnostic techniques in Poisson regression. } \usage{data(epilepsy, package="robustbase")} \format{ A data frame with 59 observations on the following 11 variables. \describe{ \item{\code{ID}}{Patient identification number} \item{\code{Y1}}{Number of epilepsy attacks patients have during the first follow-up period} \item{\code{Y2}}{Number of epilepsy attacks patients have during the second follow-up period} \item{\code{Y3}}{Number of epilepsy attacks patients have during the third follow-up period} \item{\code{Y4}}{Number of epilepsy attacks patients have during the forth follow-up period} \item{\code{Base}}{Number of epileptic attacks recorded during 8 week period prior to randomization} \item{\code{Age}}{Age of the patients} \item{\code{Trt}}{a factor with levels \code{placebo} \code{progabide} indicating whether the anti-epilepsy drug Progabide has been applied or not} \item{\code{Ysum}}{Total number of epilepsy attacks patients have during the four follow-up periods } \item{\code{Age10}}{Age of the patients devided by 10} \item{\code{Base4}}{Variable \code{Base} devided by 4} } } \details{Thall and Vail reported data from a clinical trial of 59 patients with epilepsy, 31 of whom were randomized to receive the anti-epilepsy drug Progabide and 28 of whom received a placebo. Baseline data consisted of the patient's age and the number of epileptic seizures recorded during 8 week period prior to randomization. The response consisted of counts of seizures occuring during the four consecutive follow-up periods of two weeks each. } \source{ Thall, P.F. and Vail S.C. (1990) Some covariance models for longitudinal count data with overdispersion. \emph{Biometrics} \bold{46}, 657--671. } \references{ Diggle, P.J., Liang, K.Y., and Zeger, S.L. (1994) \emph{Analysis of Longitudinal Data}; Clarendon Press. Breslow N. E. (1996) Generalized linear models: Checking assumptions and strengthening conclusions. \emph{Statistica Applicata} \bold{8}, 23--41. } \examples{ data(epilepsy) str(epilepsy) pairs(epilepsy[,c("Ysum","Base4","Trt","Age10")]) Efit1 <- glm(Ysum ~ Age10 + Base4*Trt, family=poisson, data=epilepsy) summary(Efit1) ## Robust Fit : Efit2 <- glmrob(Ysum ~ Age10 + Base4*Trt, family=poisson, data=epilepsy, method = "Mqle", tcc=1.2, maxit=100) summary(Efit2) } \keyword{datasets} robustbase/man/outlierStats.Rd0000644000176200001440000001032213162417031016163 0ustar liggesusers\name{outlierStats} \alias{outlierStats} \title{Robust Regression Outlier Statistics} \description{ Simple statistics about observations with robustness weight of almost zero for models that include factor terms. The number of rejected observations and the mean robustness weights are computed for each level of each factor included in the model. } \usage{ outlierStats(object, x = object$x, control = object$control, epsw = control$eps.outlier, epsx = control$eps.x, warn.limit.reject = control$warn.limit.reject, warn.limit.meanrw = control$warn.limit.meanrw) } \arguments{ \item{object}{object of class \code{"lmrob"}, typically the result of a call to \code{\link{lmrob}}.} \item{x}{design matrix} \item{control}{list as returned by \code{\link{lmrob.control}}.} \item{epsw}{limit on the robustness weight below which an observation is considered to be an outlier. Either a \code{numeric(1)} or a \code{\link{function}} that takes the number of observations as an argument.} \item{epsx}{limit on the absolute value of the elements of the design matrix below which an element is considered zero. Either a numeric(1) or a function that takes the maximum absolute value in the design matrix as an argument.} \item{warn.limit.reject}{limit of ratio \eqn{\#\mbox{rejected} / \#\mbox{obs in level}}{# rejected / # obs in level} above (\eqn{\geq}{>=}) which a warning is produced. Set to \code{NULL} to disable warning.} \item{warn.limit.meanrw}{limit of the mean robustness per factor level below which (\eqn{\leq}{<=}) a warning is produced. Set to \code{NULL} to disable warning.} } \details{ For models that include factors, the fast S-algorithm used by \code{\link{lmrob}} can produce \dQuote{bad} fits for some of the factor levels, especially if there are many levels with only a few observations. Such a \dQuote{bad} fit is characterized as a fit where most of the observations in a level of a factor are rejected, i.e., are assigned robustness weights of zero or nearly zero. We call such a fit a \dQuote{local exact fit}. If a local exact fit is detected, then we recommend to increase some of the control parameters of the \dQuote{fast S}-algorithm. As a first aid solution in such cases, one can use \code{setting="KS2014"}, see also \code{\link{lmrob.control}}. This function is called internally by \code{\link{lmrob}} to issue a warning if a local exact fit is detected. The output is available as \code{ostats} in objects of class \code{"lmrob"} (only if the statistic is computed). } \value{ A data frames for each column with any zero elementes as well as an overall statistic. The data frame consist of the names of the coefficients in question, the number of non-zero observation in that level (\code{N.nonzero}), the number of rejected observations (\code{N.rejected}), the ratio of rejected observations to the number of observations in that level (\code{Ratio}) and the mean robustness weight of all the observations in the corresponding level (\code{Mean.RobWeight}). } \references{ Koller, M. and Stahel, W.A. (2017) Nonsingular subsampling for regression {S}~estimators with categorical predictors, \emph{Computational Statistics} \bold{32}(2): 631--646. \doi{10.1007/s00180-016-0679-x} } \author{Manuel Koller} \seealso{ \code{\link{lmrob.control}} for the default values of the control parameters; \code{\link{summarizeRobWeights}}. } \examples{ ## artificial data example data <- expand.grid(grp1 = letters[1:5], grp2 = letters[1:5], rep=1:3) set.seed(101) data$y <- c(rt(nrow(data), 1)) ## compute outlier statistics for all the estimators control <- lmrob.control(method = "SMDM", compute.outlier.stats = c("S", "MM", "SMD", "SMDM")) ## warning is only issued for some seeds set.seed(2) fit1 <- lmrob(y ~ grp1*grp2, data, control = control) ## do as suggested: fit2 <- lmrob(y ~ grp1*grp2, data, setting = "KS2014") ## the plot function should work for such models as well plot(fit1) \dontrun{ ## access statistics: fit1$ostats ## SMDM fit1$init$ostats ## SMD fit1$init$init$ostats ## SM fit1$init$init$init.S$ostats ## S }%dont } \keyword{robust} \keyword{regression} robustbase/man/salinity.Rd0000644000176200001440000000565113312375575015343 0ustar liggesusers\name{salinity} \alias{salinity} \docType{data} \title{Salinity Data} \description{ This is a data set consisting of measurements of water salinity (i.e., its salt concentration) and river discharge taken in North Carolina's Pamlico Sound, recording some bi-weekly averages in March, April, and May from 1972 to 1977. This dataset was listed by Ruppert and Carroll (1980). In Carrol and Ruppert (1985) the physical background of the data is described. They indicated that observations 5 and 16 correspond to periods of very heavy discharge and showed that the discrepant observation 5 was masked by observations 3 and 16, i.e., only after deletion of these observations it was possible to identify the influential observation 5. This data set is a prime example of the \emph{masking effect}. } \usage{data(salinity, package="robustbase")} \format{ A data frame with 28 observations on the following 4 variables (in parentheses are the names used in the 1980 reference). \describe{ \item{\code{X1}:}{Lagged Salinity (\sQuote{SALLAG})} \item{\code{X2}:}{Trend (\sQuote{TREND})} \item{\code{X3}:}{Discharge (\sQuote{H2OFLOW})} \item{\code{Y}:}{Salinity (\sQuote{SALINITY})} } } \note{The \pkg{boot} package contains another version of this salinity data set, also attributed to Ruppert and Carroll (1980), but with two clear transcription errors, see the examples. } \source{ P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection}; Wiley, p.82, table 5. Ruppert, D. and Carroll, R.J. (1980) Trimmed least squares estimation in the linear model. \emph{JASA} \bold{75}, 828--838; table 3, p.835. Carroll, R.J. and Ruppert, D. (1985) Transformations in regression: A robust analysis. \emph{Technometrics} \bold{27}, 1--12 } \examples{ data(salinity) summary(lm.sali <- lm(Y ~ . , data = salinity)) summary(rlm.sali <- MASS::rlm(Y ~ . , data = salinity)) summary(lts.sali <- ltsReg(Y ~ . , data = salinity)) salinity.x <- data.matrix(salinity[, 1:3]) c_sal <- covMcd(salinity.x) plot(c_sal, "tolEllipsePlot") ## Connection with boot package's version : if(requireNamespace("boot")) { ## 'always' print( head(boot.sal <- boot::salinity ) ) print( head(robb.sal <- salinity [, c(4, 1:3)]) ) # difference: has one digit more ## Otherwise the same ? dimnames(robb.sal) <- dimnames(boot.sal) ## apart from the 4th column, they are "identical": stopifnot( all.equal(boot.sal[, -4], robb.sal[, -4], tol = 1e-15) ) ## But the discharge ('X3', 'dis' or 'H2OFLOW') __differs__ in two places: plot(cbind(robustbase = robb.sal[,4], boot = boot.sal[,4])) abline(0,1, lwd=3, col=adjustcolor("red", 1/4)) D.sal <- robb.sal[,4] - boot.sal[,4] stem(robb.sal[,4] - boot.sal[,4]) which(abs(D.sal) > 0.01) ## 2 8 ## *two* typos (=> difference ~= 1) in the version of 'boot': obs. 2 & 8 !!! cbind(robb = robb.sal[,4], boot = boot.sal[,4], D.sal) }# boot } \keyword{datasets} robustbase/man/summarizeRobWeights.Rd0000644000176200001440000000317012137052541017500 0ustar liggesusers\name{summarizeRobWeights} \alias{summarizeRobWeights} \title{Print a Nice "summary" of Robustness Weights} \description{ Print a nice \dQuote{summary} about a numeric vector of robustness weights. Observations with weights around zero are marked as outliers. } \usage{ summarizeRobWeights(w, digits = getOption("digits"), header = "Robustness weights:", eps = 0.1 / length(w), eps1 = 1e-3, \dots) } \arguments{ \item{w}{numeric vector of robustness weigths.} \item{digits}{digits to be used for \code{\link{print}}ing.} \item{header}{string to be printed as header line.} \item{eps}{numeric tolerance \eqn{\epsilon}{eps}: values of \code{w} with \eqn{\left|w_i\right| < \epsilon/n}{|w[i]| < eps/n} are said to be outliers.} \item{eps1}{numeric tolerance: values of \code{w} with \eqn{\left|1 - w_i\right| < eps1}{|1 - w[i]| < eps1} are said to have weight \sQuote{\code{~= 1}}.} \item{\dots}{potential further arguments, passed to \code{\link{print}()}.} } \seealso{ The \code{\link{summary}} methods for \code{\link{lmrob}} and \code{\link{glmrob}} make use of \code{summarizeRobWeights()}. Our methods for \code{\link{weights}()}, \code{\link{weights.lmrob}(*, type="robustness")} and \code{\link{weights.glmrob}(*, type="robustness")}. } \value{ none; the function is used for its side effect of printing. } \author{Martin Maechler} \examples{ w <- c(1,1,1,1,0,1,1,1,1,0,1,1,.9999,.99999, .5,.6,1e-12) summarizeRobWeights(w) # two outside ~= {0,1} summarizeRobWeights(w, eps1 = 5e-5)# now three outside {0,1} ## See the summary() outputs } \keyword{utilities} robustbase/man/M.psi.Rd0000644000176200001440000001755513177452122014474 0ustar liggesusers\name{Mpsi} \title{Psi / Chi / Wgt / Rho Functions for *M-Estimation} \alias{Mchi} \alias{Mpsi} \alias{Mwgt} \alias{MrhoInf} \alias{.Mchi} \alias{.Mpsi} \alias{.Mwgt} \alias{.Mwgt.psi1} \alias{.MrhoInf} \alias{.psi2ipsi} \description{ Compute Psi / Chi / Wgt / Rho functions for M-estimation, i.e., including MM, etc. For definitions and details, please use the vignette \href{https://cran.r-project.org/package=robustbase/vignettes/psi_functions.pdf}{% \dQuote{\eqn{\psi}{psi}-Functions Available in Robustbase}}. \code{MrhoInf(x)} computes \eqn{\rho(\infty)}{rho(Inf)}, i.e., the normalizing or scaling constant for the transformation from \eqn{\rho(\cdot)}{rho(.)} to \eqn{\tilde\rho(\cdot)}{rho~(.)}, where the latter, aka as \eqn{\chi()}{chi()} fulfills \eqn{\tilde\rho(\infty) = 1}{rho~(Inf) = 1} which makes only sense for \dQuote{redescending} psi functions, i.e., not for \code{"huber"}. \code{Mwgt(x, *)} computes \eqn{\psi(x)/x} (fast and numerically accurately). } \usage{ Mpsi(x, cc, psi, deriv = 0) Mchi(x, cc, psi, deriv = 0) Mwgt(x, cc, psi) MrhoInf(cc, psi) .Mwgt.psi1(psi, cc = .Mpsi.tuning.default(psi)) } \arguments{ \item{x}{numeric (\dQuote{abscissa} values) vector, possibly with \code{\link{attributes}} such as \code{\link{dim}} or \code{\link{names}}, etc. These are preserved for the \code{M*()} functions (but not the \code{.M()} ones).} \item{cc}{numeric tuning constant, for some \code{psi} of length \eqn{> 1}.} \item{psi}{a string specifying the psi / chi / rho / wgt function; either \code{"huber"}, or one of the same possible specifiers as for \code{psi} in \code{\link{lmrob.control}}, i.e. currently, \code{"bisquare"}, \code{"lqq"}, \code{"welsh"}, \code{"optimal"}, \code{"hampel"}, or \code{"ggw"}.} \item{deriv}{an integer, specifying the \emph{order} of derivative to consider; particularly, \code{Mpsi(x, *, deriv = -1)} is the principal function of \eqn{\psi()}{psi()}, typically denoted \eqn{\rho()}{rho()} in the literature. For some psi functions, currently \code{"huber"}, \code{"bisquare"}, \code{"hampel"}, and \code{"lqq"}, \code{deriv = 2} is implemented, for the other psi's only \eqn{d \in \{-1,0,1\}}{d in {-1,0,1\}}.}} } \details{ Theoretically, \code{Mchi()} would not be needed explicitly as it can be computed from \code{Mpsi()} and \code{MrhoInf()}, namely, by \preformatted{Mchi(x, *, deriv = d) == Mpsi(x, *, deriv = d-1) / MrhoInf(*)} for \eqn{d = 0, 1, 2} (and \sQuote{*} containing \code{par, psi}, and equality is in the sense of \code{\link{all.equal}(x,y, tol)} with a small \code{tol}. Similarly, \code{Mwgt} would not be needed strictly, as it could be defined via \code{Mpsi}), but the explicit definition takes care of 0/0 and typically is of a more simple form. For experts, there are slightly even faster versions, \code{.Mpsi()}, \code{.Mwgt()}, etc. \code{.Mwgt.psi1()} mainly a utility for \code{\link{nlrob}()}, returns a \emph{\code{\link{function}}} with similar semantics as \code{\link[MASS]{psi.hampel}}, \code{\link[MASS]{psi.huber}}, or \code{\link[MASS]{psi.bisquare}} from package \pkg{MASS}. Namely, a function with arguments \code{(x, deriv=0)}, which for \code{deriv=0} computes \code{Mwgt(x, cc, psi)} and otherwise computes \code{Mpsi(x, cc, psi, deriv=deriv)}. \code{.Mpsi()}, \code{.Mchi()}, \code{.Mwgt()}, and \code{.MrhoInf()} are low-level versions of \code{Mpsi()}, \code{Mchi()}, \code{Mwgt()}, and \code{MrhoInf()}, respectively, and \code{.psi2ipsi()} provides the psi-function integer codes needed for \code{ipsi} argument of the \code{.M*()} functions. For \code{psi = "ggw"}, the \eqn{\rho()}{rho()} function has no closed form and must be computed via numerical integration, apart from 6 special cases including the defaults, see the \sQuote{Details} in \code{help(\link{.psi.ggw.findc})}. } \value{ a numeric vector of the same length as \code{x}, with corresponding function (or derivative) values. } \references{ See the vignette about %% ../vignettes/psi_functions.Rnw : \dQuote{\eqn{\psi}{psi}-Functions Available in Robustbase}. } \author{ Manuel Koller, notably for the original C implementation; tweaks and speedup via \code{\link{.Call}} and \code{.M*()} etc by Martin Maechler. } \seealso{ \code{\link{psiFunc}} and the \code{\linkS4class{psi_func}} class, both of which provide considerably more on the \R side, but are less optimized for speed. \code{\link{.Mpsi.tuning.defaults}}, etc, for tuning constants' defaults for\code{lmrob()}, and \code{\link{.psi.ggw.findc}()} utilities to construct such constants' vectors. } \examples{ x <- seq(-5,7, by=1/8) matplot(x, cbind(Mpsi(x, 4, "biweight"), Mchi(x, 4, "biweight"), Mwgt(x, 4, "biweight")), type = "l") abline(h=0, v=0, lty=2, col=adjustcolor("gray", 0.6)) hampelPsi (ccHa <- hampelPsi @ xtras $ tuningP $ k) psHa <- hampelPsi@psi(x) % FIXME: interesting as long as hampelPsi does not use Mpsi(... "hampel") ! ## using Mpsi(): Mp.Ha <- Mpsi(x, cc = ccHa, psi = "hampel") stopifnot(all.equal(Mp.Ha, psHa, tolerance = 1e-15)) psi.huber <- .Mwgt.psi1("huber") if(getRversion() >= "3.0.0") stopifnot(identical(psi.huber, .Mwgt.psi1("huber", 1.345), ignore.env=TRUE)) curve(psi.huber(x), -3, 5, col=2, ylim = 0:1) curve(psi.huber(x, deriv=1), add=TRUE, col=3) ## and show that this is indeed the same as MASS::psi.huber() : x <- runif(256, -2,3) stopifnot(all.equal(psi.huber(x), MASS::psi.huber(x)), all.equal( psi.huber(x, deriv=1), as.numeric(MASS::psi.huber(x, deriv=1)))) ## and how to get MASS::psi.hampel(): psi.hampel <- .Mwgt.psi1("Hampel", c(2,4,8)) x <- runif(256, -4, 10) stopifnot(all.equal(psi.hampel(x), MASS::psi.hampel(x)), all.equal( psi.hampel(x, deriv=1), as.numeric(MASS::psi.hampel(x, deriv=1)))) ## "lqq" / "LQQ" and its tuning constants: ctl0 <- lmrob.control(psi = "lqq", tuning.psi=c(-0.5, 1.5, 0.95, NA)) ctl <- lmrob.control(psi = "lqq", tuning.psi=c(-0.5, 1.5, 0.90, NA)) ctl0$tuning.psi ## keeps the vector _and_ has "constants" attribute: ## [1] -0.50 1.50 0.95 NA ## attr(,"constants") ## [1] 1.4734061 0.9822707 1.5000000 ctl$tuning.psi ## ditto: ## [1] -0.5 1.5 0.9 NA \\ .."constants" 1.213726 0.809151 1.500000 stopifnot(all.equal(Mpsi(0:2, cc = ctl$tuning.psi, psi = ctl$psi), c(0, 0.977493, 1.1237), tol = 6e-6)) x <- seq(-4,8, by = 1/16) ## Show how you can use .Mpsi() equivalently to Mpsi() stopifnot(all.equal( Mpsi(x, cc = ctl$tuning.psi, psi = ctl$psi), .Mpsi(x, ccc = attr(ctl$tuning.psi, "constants"), ipsi = .psi2ipsi("lqq")))) stopifnot(all.equal( Mpsi(x, cc = ctl0$tuning.psi, psi = ctl0$psi, deriv=1), .Mpsi(x, ccc = attr(ctl0$tuning.psi, "constants"), ipsi = .psi2ipsi("lqq"), deriv=1))) ## M*() preserving attributes : x <- matrix(x, 32, 8, dimnames=list(paste0("r",1:32), col=letters[1:8])) comment(x) <- "a vector which is a matrix" px <- Mpsi(x, cc = ccHa, psi = "hampel") stopifnot(identical(attributes(x), attributes(px))) ## The "optimal" psi exists in two versions "in the litterature": --- ## Maronna et al. 2006, 5.9.1, p.144f: psi.M2006 <- function(x, c = 0.013) sign(x) * pmax(0, abs(x) - c/dnorm(abs(x))) ## and the other is the one in robustbase from 'robust': via Mpsi(.., "optimal") ## Here are both for 95\% efficiency: (c106 <- .Mpsi.tuning.default("optimal")) c1 <- curve(Mpsi(x, cc = c106, psi="optimal"), -5, 7, n=1001) c2 <- curve(psi.M2006(x), add=TRUE, n=1001, col=adjustcolor(2,0.4), lwd=2) abline(0,1, v=0, h=0, lty=3) ## the two psi's are similar, but really quite different ## a zoom into Maronna et al's: c3 <- curve(psi.M2006(x), -.5, 1, n=1001); abline(h=0,v=0, lty=3);abline(0,1, lty=2) } \keyword{robust} robustbase/man/scaleTau2.Rd0000644000176200001440000000650613162424403015316 0ustar liggesusers\name{scaleTau2} \alias{scaleTau2} \title{Robust Tau-Estimate of Scale} \description{ Computes the robust \eqn{\tau}-estimate of univariate scale, as proposed by Maronna and Zamar (2002); improved by a consistency factor, %% FIXME: TODO: and a finite sample correction by Martin Maechler %% (currently have 'n-2' but can be better !!!! } \usage{ scaleTau2(x, c1 = 4.5, c2 = 3.0, consistency = TRUE, sigma0 = median(x.), mu.too = FALSE) } \arguments{ \item{x}{numeric vector} \item{c1,c2}{non-negative numbers, specifying cutoff values for the biweighting of the mean and the rho function respectively.} \item{consistency}{logical indicating if the consistency correction factor (for the scale) should be applied.} \item{sigma0}{the initial scale estimate \eqn{s_0}{s0}, defaulting to the MAD; may be set to a positive value when the MAD is zero.} \item{mu.too}{logical indicating if both location and scale should be returned or just the scale (when \code{mu.too=FALSE} as by default).} } \details{ First, \eqn{s_0}{s0} := MAD, i.e. the equivalent of \code{\link{mad}(x, constant=1)} is computed. Robustness weights \eqn{w_i := w_{c1}((x_i - med(X))/ s_0)} are computed, where \eqn{w_c(u) = max(0, (1 - (u/c)^2)^2)}. The robust location measure is defined as \eqn{\mu(X) := (\sum_i w_i x_i)/(\sum_i w_i)}, and the robust \eqn{\tau (tau)}{tau}-estimate is \eqn{s(X)^2 := s_0^2 * (1/n) \sum_i \rho_{c2}((x_i - \mu(X))/s_0)}, where \eqn{\rho_c(u) = min(c^2, u^2)}. \cr \code{scaleTau2(*, consistency=FALSE)} returns \eqn{s(X)}, whereas this value is divided by its asymptotic limit when \code{consistency = TRUE} as by default. Note that for \code{n = length(x) == 2}, all equivariant scale estimates are proportional, and specifically, \code{scaleTau2(x, consistency=FALSE) == mad(x, constant=1)}. See also the reference. } \value{ numeric vector of length one (if \code{mu.too} is \code{FALSE} as by default) or two (when \code{mu.too = TRUE}) with robust scale or (location,scale) estimators \eqn{\hat\sigma(x)}{s^(x)} or \eqn{(\hat\mu(x),\hat\sigma(x))}{(m^(x), s^(x))}. } \references{ Maronna, R.A. and Zamar, R.H. (2002) Robust estimates of location and dispersion of high-dimensional datasets; \emph{Technometrics} \bold{44}(4), 307--317. % MM: ~/save/papers/robust-diverse/Maronna-Zamar-OGK_2002.pdf Yohai, V.J., and Zamar, R.H. (1988). High breakdown-point estimates of regression by means of the minimization of an efficient scale. \emph{Journal of the American Statistical Association} \bold{83}, 406--413. % MM: ~/save/papers/robust-diverse/Yohai-Zamar-tau_JASA1988.pdf } \author{Original by Kjell Konis with substantial modifications by Martin Maechler. } \seealso{\code{\link{Sn}}, \code{\link{Qn}}, \code{\link{mad}}; further \code{\link{covOGK}} for which \code{scaleTau2} was designed. } \examples{ x <- c(1:7, 1000) sd(x) # non-robust std.deviation scaleTau2(x) scaleTau2(x, mu.too = TRUE) if(doExtras <- robustbase:::doExtras()) { set.seed(11) ## show how much faster this is, compared to Qn x <- sample(c(rnorm(1e6), rt(5e5, df=3))) (system.time(Qx <- Qn(x))) ## 2.04 [2017-09, lynne] (system.time(S2x <- scaleTau2(x))) ## 0.25 (ditto) cbind(Qn = Qx, sTau2 = S2x) }## Qn sTau2 ## 1.072556 1.071258 } \keyword{robust} \keyword{univar} robustbase/man/ltsReg.Rd0000644000176200001440000002406612425013547014740 0ustar liggesusers\name{ltsReg} \alias{ltsReg} \alias{ltsReg.default} \alias{ltsReg.formula} \alias{print.lts} \title{Least Trimmed Squares Robust (High Breakdown) Regression} \concept{High breakdown point} \description{ Carries out least trimmed squares (LTS) robust (high breakdown point) regression. } \usage{ ltsReg(x, \dots) \method{ltsReg}{formula}(formula, data, subset, weights, na.action, model = TRUE, x.ret = FALSE, y.ret = FALSE, contrasts = NULL, offset, \dots) \method{ltsReg}{default}(x, y, intercept = TRUE, alpha = , nsamp = , adjust = , mcd = TRUE, qr.out = FALSE, yname = NULL, seed = , trace = , use.correction = , wgtFUN = , control = rrcov.control(), \dots) } \arguments{ \item{formula}{a \code{\link{formula}} of the form \code{y ~ x1 + x2 + ...}.} \item{data}{data frame from which variables specified in \code{formula} are to be taken.} \item{subset}{an optional vector specifying a subset of observations to be used in the fitting process.} \item{weights}{an optional vector of weights to be used in the fitting process. \bold{NOT USED YET}. %%% If specified, weighted least squares is used %%% with weights \code{weights} (that is, minimizing \code{sum(w*e^2)}); %%% otherwise ordinary least squares is used. } \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. The default is set by the \code{na.action} setting of \code{\link{options}}, and is \code{\link{na.fail}} if that is unset. The \dQuote{factory-fresh} default is \code{\link{na.omit}}. Another possible value is \code{NULL}, no action. Value \code{\link{na.exclude}} can be useful.} \item{model, x.ret, y.ret}{\code{\link{logical}}s indicating if the model frame, the model matrix and the response are to be returned, respectively.} \item{contrasts}{an optional list. See the \code{contrasts.arg} of \code{\link{model.matrix.default}}.} \item{offset}{this can be used to specify an \emph{a priori} known component to be included in the linear predictor during fitting. An \code{\link{offset}} term can be included in the formula instead or as well, and if both are specified their sum is used.} \item{x}{a matrix or data frame containing the explanatory variables.} \item{y}{the response: a vector of length the number of rows of \code{x}.}. \item{intercept}{if true, a model with constant term will be estimated; otherwise no constant term will be included. Default is \code{intercept = TRUE} } \item{alpha}{the percentage (roughly) of squared residuals whose sum will be minimized, by default 0.5. In general, \code{alpha} must between 0.5 and 1.} \item{nsamp}{number of subsets used for initial estimates or \code{"best"} or \code{"exact"}. Default is \code{nsamp = 500}. For \code{nsamp="best"} exhaustive enumeration is done, as long as the number of trials does not exceed 5000. For \code{"exact"}, exhaustive enumeration will be attempted however many samples are needed. In this case a warning message will be displayed saying that the computation can take a very long time. } \item{adjust}{whether to perform intercept adjustment at each step. Since this can be time consuming, the default is \code{adjust = FALSE}.} \item{mcd}{whether to compute robust distances using Fast-MCD.} \item{qr.out}{whether to return the QR decomposition (see \code{\link{qr}}); defaults to false.} \item{yname}{the name of the dependent variable. Default is \code{yname = NULL}} \item{seed}{initial seed for random generator, like \code{\link{.Random.seed}}, see \code{\link{rrcov.control}}.} \item{trace}{logical (or integer) indicating if intermediate results should be printed; defaults to \code{FALSE}; values \eqn{\ge 2}{>= 2} also produce print from the internal (Fortran) code.} \item{use.correction}{ whether to use finite sample correction factors. Default is \code{use.correction=TRUE}} \item{wgtFUN}{a character string or \code{\link{function}}, specifying how the weights for the reweighting step should be computed. Up to April 2013, the only option has been the original proposal in (1999), now specified by \code{wgtFUN = "01.original"} (or via \code{control}).} %% MM: want control also for formula !?!?!?!?!! \item{control}{a list with estimation options - same as these provided in the function specification. If the control object is supplied, the parameters from it will be used. If parameters are passed also in the invocation statement, they will override the corresponding elements of the control object.} \item{\dots}{arguments passed to or from other methods.} } \details{ The LTS regression method minimizes the sum of the \eqn{h} smallest squared residuals, where \eqn{h > n/2}, i.e. at least half the number of observations must be used. The default value of \eqn{h} (when \code{alpha=1/2}) is roughly \eqn{n / 2}, more precisely, \code{(n+p+1) \%/\% 2} where \eqn{n} is the total number of observations, but by setting \code{alpha}, the user may choose higher values up to n, where \eqn{h = h(\alpha,n,p) =} \code{\link{h.alpha.n}(alpha,n,p)}. The LTS estimate of the error scale is given by the minimum of the objective function multiplied by a consistency factor and a finite sample correction factor -- see Pison et al. (2002) for details. The rescaling factors for the raw and final estimates are returned also in the vectors \code{raw.cnp2} and \code{cnp2} of length 2 respectively. The finite sample corrections can be suppressed by setting \code{use.correction=FALSE}. The computations are performed using the Fast LTS algorithm proposed by Rousseeuw and Van Driessen (1999). As always, the formula interface has an implied intercept term which can be removed either by \code{y ~ x - 1} or \code{y ~ 0 + x}. See \code{\link{formula}} for more details. } \note{We strongly recommend using \code{\link{lmrob}()} instead of \code{ltsReg} (\emph{See also} below)! } \value{ The function \code{ltsReg} returns an object of class \code{"lts"}. The \code{\link{summary}} method function is used to obtain (and print) a summary table of the results, and \code{\link[=ltsPlot]{plot}()} can be used to plot them, see the the specific help pages. The generic accessor functions \code{\link{coefficients}}, \code{\link{fitted.values}} and \code{\link{residuals}} extract various useful features of the value returned by \code{ltsReg}. An object of class \code{lts} is a \code{\link{list}} containing at least the following components: \item{crit}{ the value of the objective function of the LTS regression method, i.e., the sum of the \eqn{h} smallest squared raw residuals. } \item{coefficients}{ vector of coefficient estimates (including the intercept by default when \code{intercept=TRUE}), obtained after reweighting. } \item{best}{ the best subset found and used for computing the raw estimates, with \code{\link{length}(best) == quan = \link{h.alpha.n}(alpha,n,p)}. } \item{fitted.values}{vector like \code{y} containing the fitted values of the response after reweighting.} \item{residuals}{vector like \code{y} containing the residuals from the weighted least squares regression.} \item{scale}{scale estimate of the reweighted residuals. } \item{alpha}{same as the input parameter \code{alpha}.} \item{quan}{the number \eqn{h} of observations which have determined the least trimmed squares estimator.} \item{intercept}{same as the input parameter \code{intercept}.} \item{cnp2}{a vector of length two containing the consistency correction factor and the finite sample correction factor of the final estimate of the error scale.} \item{raw.coefficients}{vector of raw coefficient estimates (including the intercept, when \code{intercept=TRUE}).} \item{raw.scale}{scale estimate of the raw residuals.} \item{raw.resid}{vector like \code{y} containing the raw residuals from the regression.} \item{raw.cnp2}{a vector of length two containing the consistency correction factor and the finite sample correction factor of the raw estimate of the error scale.} \item{lts.wt}{ vector like y containing weights that can be used in a weighted least squares. These weights are 1 for points with reasonably small residuals, and 0 for points with large residuals. } \item{raw.weights}{ vector containing the raw weights based on the raw residuals and raw scale. } \item{method}{character string naming the method (Least Trimmed Squares).} \item{X}{the input data as a matrix (including intercept column if applicable).} \item{Y}{the response variable as a vector.} } \author{Valentin Todorov \email{valentin.todorov@chello.at}, based on work written for S-plus by Peter Rousseeuw and Katrien van Driessen from University of Antwerp.% no E-mails for spam-protection } \references{ Peter J. Rousseeuw (1984), Least Median of Squares Regression. \emph{Journal of the American Statistical Association} \bold{79}, 871--881. P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection.} Wiley. P. J. Rousseeuw and K. van Driessen (1999) A fast algorithm for the minimum covariance determinant estimator. \emph{Technometrics} \bold{41}, 212--223. Pison, G., Van Aelst, S., and Willems, G. (2002) Small Sample Corrections for LTS and MCD. \emph{Metrika} \bold{55}, 111-123. } \seealso{ \code{\link{lmrob.S}()} provides a fast S estimator with similar breakdown point as \code{ltsReg()} but better efficiency.\cr For data analysis, rather use \code{\link{lmrob}} which is based on \code{\link{lmrob.S}}. \code{\link{covMcd}}; \code{\link{summary.lts}} for summaries. The generic functions \code{\link{coef}}, \code{\link{residuals}}, \code{\link{fitted}}. } \examples{ data(heart) ## Default method works with 'x'-matrix and y-var: heart.x <- data.matrix(heart[, 1:2]) # the X-variables heart.y <- heart[,"clength"] ltsReg(heart.x, heart.y) data(stackloss) ltsReg(stack.loss ~ ., data = stackloss) } \keyword{robust} \keyword{regression} robustbase/man/pension.Rd0000644000176200001440000000223313312375575015153 0ustar liggesusers\name{pension} \alias{pension} \title{Pension Funds Data} \description{ The total 1981 premium income of pension funds of Dutch firms, for 18 Professional Branches, from de Wit (1982). } \usage{data(pension, package="robustbase")} \format{ A data frame with 18 observations on the following 2 variables. \describe{ \item{\code{Income}}{Premium Income (in millions of guilders)} \item{\code{Reserves}}{Premium Reserves (in millions of guilders)} } } \source{ P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection}; Wiley, p.76, table 13. } \examples{ data(pension) plot(pension) summary(lm.p <- lm(Reserves ~., data=pension)) summary(lmR.p <- lmrob(Reserves ~., data=pension)) summary(lts.p <- ltsReg(Reserves ~., data=pension)) abline( lm.p) abline(lmR.p, col=2) abline(lts.p, col=2, lty=2) ## MM: "the" solution is much simpler: plot(pension, log = "xy") lm.lp <- lm(log(Reserves) ~ log(Income), data=pension) lmR.lp <- lmrob(log(Reserves) ~ log(Income), data=pension) plot(log(Reserves) ~ log(Income), data=pension) ## no difference between LS and robust: abline( lm.lp) abline(lmR.lp, col=2) } \keyword{datasets} robustbase/man/adjbox.Rd0000644000176200001440000001715012513763013014741 0ustar liggesusers\name{adjbox} \title{Plot an Adjusted Boxplot for Skew Distributions} \alias{adjbox} \alias{adjbox.default} \alias{adjbox.formula} \description{ Produces boxplots adjusted for skewed distributions as proposed in Hubert and Vandervieren (2004). } \usage{ adjbox(x, \dots) \method{adjbox}{formula}(formula, data = NULL, \dots, subset, na.action = NULL) \method{adjbox}{default}(x, \dots, range = 1.5, doReflect = FALSE, width = NULL, varwidth = FALSE, notch = FALSE, outline = TRUE, names, plot = TRUE, border = par("fg"), col = NULL, log = "", pars = list(boxwex = 0.8, staplewex = 0.5, outwex = 0.5), horizontal = FALSE, add = FALSE, at = NULL) } \arguments{ \item{formula}{a formula, such as \code{y ~ grp}, where \code{y} is a numeric vector of data values to be split into groups according to the grouping variable \code{grp} (usually a factor).} \item{data}{a data.frame (or list) from which the variables in \code{formula} should be taken.} \item{subset}{an optional vector specifying a subset of observations to be used for plotting.} \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. The default is to ignore missing values in either the response or the group.} \item{x}{for specifying data from which the boxplots are to be produced. Either a numeric vector, or a single list containing such vectors. Additional unnamed arguments specify further data as separate vectors (each corresponding to a component boxplot). \code{\link{NA}}s are allowed in the data.} \item{\dots}{For the \code{formula} method, named arguments to be passed to the default method. For the default method, unnamed arguments are additional data vectors (unless \code{x} is a list when they are ignored), and named arguments are arguments and graphical parameters to be passed to \code{\link{bxp}} in addition to the ones given by argument \code{pars} (and override those in \code{pars}). } \item{range}{this determines how far the plot whiskers extend out from the box, and is simply passed as argument \code{coef} to \code{\link{adjboxStats}()}. If \code{range} is positive, the whiskers extend to the most extreme data point which is no more than \code{range} times the interquartile range from the box. A value of zero causes the whiskers to extend to the data extremes.} \item{doReflect}{logical indicating if the MC should also be computed on the \emph{reflected} sample \code{-x}, and be averaged, see \code{\link{mc}}.} \item{width}{a vector giving the relative widths of the boxes making up the plot.} \item{varwidth}{if \code{varwidth} is \code{TRUE}, the boxes are drawn with widths proportional to the square-roots of the number of observations in the groups.} \item{notch}{if \code{notch} is \code{TRUE}, a notch is drawn in each side of the boxes. If the notches of two plots do not overlap this is \sQuote{strong evidence} that the two medians differ (Chambers \emph{et al.}, 1983, p. 62). See \code{\link{boxplot.stats}} for the calculations used.} \item{outline}{if \code{outline} is not true, the outliers are not drawn (as points whereas S+ uses lines).}% the argument name is most ugly but S+ compatible \item{names}{group labels which will be printed under each boxplot.} \item{boxwex}{a scale factor to be applied to all boxes. When there are only a few groups, the appearance of the plot can be improved by making the boxes narrower.} \item{staplewex}{staple line width expansion, proportional to box width.} \item{outwex}{outlier line width expansion, proportional to box width.} \item{plot}{if \code{TRUE} (the default) then a boxplot is produced. If not, the summaries which the boxplots are based on are returned.} \item{border}{an optional vector of colors for the outlines of the boxplots. The values in \code{border} are recycled if the length of \code{border} is less than the number of plots.} \item{col}{if \code{col} is non-null it is assumed to contain colors to be used to colour the bodies of the box plots. By default they are in the background colour.} \item{log}{character indicating if x or y or both coordinates should be plotted in log scale.} \item{pars}{a list of (potentially many) more graphical parameters, e.g., \code{boxwex} or \code{outpch}; these are passed to \code{\link{bxp}} (if \code{plot} is true); for details, see there.} \item{horizontal}{logical indicating if the boxplots should be horizontal; default \code{FALSE} means vertical boxes.} \item{add}{logical, if true \emph{add} boxplot to current plot.} \item{at}{numeric vector giving the locations where the boxplots should be drawn, particularly when \code{add = TRUE}; defaults to \code{1:n} where \code{n} is the number of boxes.} } \details{ The generic function \code{adjbox} currently has a default method (\code{adjbox.default}) and a formula interface (\code{adjbox.formula}). If multiple groups are supplied either as multiple arguments or via a formula, parallel boxplots will be plotted, in the order of the arguments or the order of the levels of the factor (see \code{\link{factor}}). Missing values are ignored when forming boxplots. Extremes of the upper and whiskers of the adjusted boxplots are computed using the medcouple (\code{\link{mc}()}), a robust measure of skewness. For details, cf. TODO %% << FIXME } \value{ A \code{\link{list}} with the following components: \item{stats}{a matrix, each column contains the extreme of the lower whisker, the lower hinge, the median, the upper hinge and the extreme of the upper whisker for one group/plot. If all the inputs have the same class attribute, so will this component.} \item{n}{a vector with the number of observations in each group.} \item{coef}{a matrix where each column contains the lower and upper extremes of the notch.} \item{out}{the values of any data points which lie beyond the extremes of the whiskers.} \item{group}{a vector of the same length as out whose elements indicate to which group the outlier belongs.} \item{names}{a vector of names for the groups.} } \references{ %% Hubert, M. and Vandervieren, E. (2006) %% \emph{An Adjusted Boxplot for Skewed Distributions}, %% Technical Report TR-06-11, KU Leuven, Section of Statistics, Leuven. %% \url{http://wis.kuleuven.be/stat/robust/Papers/TR0611.pdf} Hubert, M. and Vandervieren, E. (2008). An adjusted boxplot for skewed distributions, \emph{Computational Statistics and Data Analysis} \bold{52}, 5186--5201. } \author{ R Core Development Team, slightly adapted by Tobias Verbeke } \note{ The code and documentation only slightly modifies the code of \code{\link{boxplot.default}}, \code{boxplot.formula} and \code{\link{boxplot.stats}} } \seealso{The medcouple, \code{\link{mc}}; \code{\link{boxplot}}. } \examples{ if(require("boot")) { ### Hubert and Vandervieren (2006), p. 10, Fig. 4. data(coal, package = "boot") coaldiff <- diff(coal$date) op <- par(mfrow = c(1,2)) boxplot(coaldiff, main = "Original Boxplot") adjbox(coaldiff, main = "Adjusted Boxplot") par(op) } ### Hubert and Vandervieren (2006), p. 11, Fig. 6. -- enhanced op <- par(mfrow = c(2,2), mar = c(1,3,3,1), oma = c(0,0,3,0)) with(condroz, { boxplot(Ca, main = "Original Boxplot") adjbox (Ca, main = "Adjusted Boxplot") boxplot(Ca, main = "Original Boxplot [log]", log = "y") adjbox (Ca, main = "Adjusted Boxplot [log]", log = "y") }) mtext("'Ca' from data(condroz)", outer=TRUE, font = par("font.main"), cex = 2) par(op) } \keyword{hplot} robustbase/man/fullRank.Rd0000644000176200001440000000432313170062205015241 0ustar liggesusers\name{fullRank} \alias{fullRank} \title{Remove Columns (or Rows) From a Matrix to Make It Full Rank} \description{ From the QR decomposition with pivoting, (\code{\link{qr}(x, tol)} if \eqn{n \ge p}), if the matrix is not of full rank, the corresponding columns (\eqn{n \ge p}{n >= p}) or rows (\eqn{n < p}) are omitted to form a full rank matrix. } \usage{% -> ../R/adjoutlyingness.R fullRank(x, tol = 1e-7, qrx = qr(x, tol=tol)) } \arguments{ \item{x}{a numeric matrix of dimension \eqn{n \times p}{n * p}, or a similar object for which \code{\link{qr}()} works.} \item{tol}{tolerance for determining rank (deficiency). Currently is simply passed to \code{\link{qr}}.} \item{qrx}{optionally may be used to pass a \code{\link{qr}(x, ..)}; only used when \code{p <= n}.} } \value{ a version of the matrix \code{x}, with less columns or rows if \code{x}'s rank was smaller than \code{min(n,p)}. If \code{x} is of full rank, it is returned unchanged. } \author{Martin Maechler} \note{ This is useful for robustness algorithms that rely on \eqn{X} matrices of full rank, e.g., \code{\link{adjOutlyingness}}. This also works for numeric data frames and whenever \code{qr()} works correctly. } \seealso{ \code{\link{qr}}; for more sophisticated rank determination, \code{\link[Matrix]{rankMatrix}} from package \CRANpkg{Matrix}. } \examples{ stopifnot(identical(fullRank(wood), wood)) ## More sophisticated and delicate dim(T <- tcrossprod(data.matrix(toxicity))) # 38 x 38 dim(T. <- fullRank(T)) # 38 x 10 if(requireNamespace("Matrix")) { rMmeths <- eval(formals(Matrix::rankMatrix)$method) rT. <- sapply(rMmeths, function(.m.) Matrix::rankMatrix(T., method = .m.)) print(rT.) # "qr" (= "qrLinpack"): 13, others rather 10 } dim(T.2 <- fullRank(T, tol = 1e-15))# 38 x 18 dim(T.3 <- fullRank(T, tol = 1e-12))# 38 x 13 dim(T.3 <- fullRank(T, tol = 1e-10))# 38 x 13 dim(T.3 <- fullRank(T, tol = 1e-8 ))# 38 x 12 dim(T.) # default from above 38 x 10 dim(T.3 <- fullRank(T, tol = 1e-5 ))# 38 x 10 -- still plot(svd(T, 0,0)$d, log="y", main = "singular values of T", yaxt="n") axis(2, at=10^(-14:5), las=1) ## pretty clearly indicates that rank 10 is "correct" here. } \keyword{algebra} \keyword{array} robustbase/man/condroz.Rd0000644000176200001440000000245713312375575015166 0ustar liggesusers\name{condroz} \alias{condroz} \encoding{utf8} \docType{data} \title{ Condroz Data } \description{ Dataset with pH-value and Calcium content in soil samples, collected in different communities of the Condroz region in Belgium. The data pertain to a subset of 428 samples with a pH-value between 7.0 and 7.5. } \usage{data(condroz, package="robustbase")} \format{ A data frame with 428 observations on the following 2 variables. \describe{ \item{\code{Ca}}{Calcium content of the soil sample} \item{\code{pH}}{pH value of the soil sample} } } \details{ For more information on the dataset, cf. Goegebeur et al. (2005). } \source{ Hubert and Vandervieren (2006), p. 10. This dataset is also studied in Vandewalle et al. (2004). } \references{ See also those for \code{\link{adjbox}}. Goegebeur, Y., Planchon, V., Beirlant, J., Oger, R. (2005). Quality Assesment of Pedochemical Data Using Extreme Value Methodology, Journal of Applied Science, 5, p. 1092-1102. Vandewalle, B., Beirlant, J., Hubert, M. (2004). A robust estimator of the tail index based on an exponential regression model, in Hubert, M., Pison G., Struyf, A. and S. Van Aelst, ed., Theory and Applications of Recent Robust Methods, Birkhäuser, Basel, p. 367-376. } \examples{ adjbox(condroz$Ca) } \keyword{datasets} robustbase/man/covMcd.Rd0000644000176200001440000002666113012621731014707 0ustar liggesusers\newcommand{\CRANpkg}{\href{https://CRAN.R-project.org/package=#1}{\pkg{#1}}} \name{covMcd} \title{Robust Location and Scatter Estimation via MCD} \alias{covMcd} \alias{print.mcd} \alias{.MCDcons} \alias{.MCDcnp2} \alias{.MCDcnp2.rew} \alias{.MCDsingularityMsg} \alias{.wgtFUN.covMcd} % \concept{High breakdown point} \description{ Compute the Minimum Covariance Determinant (MCD) estimator, a robust multivariate location and scale estimate with a high breakdown point, via the \sQuote{Fast MCD} or \sQuote{Deterministic MCD} (\dQuote{DetMcd}) algorithm. } \usage{ covMcd(x, cor = FALSE, raw.only = FALSE, alpha =, nsamp =, nmini =, kmini =, scalefn =, maxcsteps =, initHsets = NULL, save.hsets = FALSE, names = TRUE, % full.h = save.hsets, seed =, tolSolve =, trace =, use.correction =, wgtFUN =, control = rrcov.control()) } \arguments{ \item{x}{a matrix or data frame.} \item{cor}{should the returned result include a correlation matrix? Default is \code{cor = FALSE}.} \item{raw.only}{should only the \dQuote{raw} estimate be returned, i.e., no (re)weighting step be performed; default is false.} \item{alpha}{numeric parameter controlling the size of the subsets over which the determinant is minimized; roughly \code{alpha*n}, (see \sQuote{Details} below) observations are used for computing the determinant. Allowed values are between 0.5 and 1 and the default is 0.5.} \item{nsamp}{number of subsets used for initial estimates or \code{"best"}, \code{"exact"}, or \code{"deterministic"}. Default is \code{nsamp = 500}. For \code{nsamp = "best"} exhaustive enumeration is done, as long as the number of trials does not exceed 100'000 (\code{= nLarge}). For \code{"exact"}, exhaustive enumeration will be attempted however many samples are needed. In this case a warning message may be displayed saying that the computation can take a very long time. For \code{"deterministic"}, the \emph{deterministic} MCD is computed; as proposed by Hubert et al. (2012) it starts from the \eqn{h} most central observations of \emph{six} (deterministic) estimators. } \item{nmini, kmini}{for \eqn{n \ge 2 \times n_0}{n >= 2 n_0}, \eqn{n_0 := \code{nmini}}, the algorithm splits the data into maximally \code{kmini} (by default 5) subsets, of size approximately, but at least \code{nmini}. When \code{nmini*kmini < n}, the initial search uses only a \emph{subsample} of size \code{nmini*kmini}. %% FIXME? -- more accurately ==> ../src/rffastmcd.f The original algorithm had \code{nmini = 300} and \code{kmini = 5} hard coded.} \item{scalefn}{for the deterministic MCD: \code{\link{function}} to compute a robust scale estimate or character string specifying a rule determining such a function. The default, currently \code{"hrv2012"}, uses the recommendation of Hubert, Rousseeuw and Verdonck (2012) who recommend \code{\link{Qn}} for \eqn{n < 1000} and \code{\link{scaleTau2}} for larger n. Alternatively, \code{scalefn = "v2014"}, uses that rule with cutoff \eqn{n = 5000}.} \item{maxcsteps}{maximal number of concentration steps in the deterministic MCD; should not be reached.} \item{initHsets}{NULL or a \eqn{K x h} integer matrix of initial subsets of observations of size \eqn{h} (specified by the indices in \code{1:n}).} \item{save.hsets}{(for deterministic MCD) logical indicating if the initial subsets should be returned as \code{initHsets}.} \item{names}{logical; if true (as by default), several parts of the result have a \code{\link{names}} or \code{\link{dimnames}} respectively, derived from data matrix \code{x}.} \item{seed}{initial seed for random generator, like \code{\link{.Random.seed}}, see \code{\link{rrcov.control}}.} \item{tolSolve}{numeric tolerance to be used for inversion (\code{\link{solve}}) of the covariance matrix in \code{\link{mahalanobis}}.} \item{trace}{logical (or integer) indicating if intermediate results should be printed; defaults to \code{FALSE}; values \eqn{\ge 2}{>= 2} also produce print from the internal (Fortran) code.} \item{use.correction}{ whether to use finite sample correction factors; defaults to \code{TRUE}.} \item{wgtFUN}{a character string or \code{\link{function}}, specifying how the weights for the reweighting step should be computed. Up to April 2013, the only option has been the original proposal in (1999), now specified by \code{wgtFUN = "01.original"} (or via \code{control}). Since \pkg{robustbase} version 0.92-3, Dec.2014, other predefined string options are available, though experimental, see the experimental \code{.wgtFUN.covMcd} object.} \item{control}{a list with estimation options - this includes those above provided in the function specification, see \code{\link{rrcov.control}} for the defaults. If \code{control} is supplied, the parameters from it will be used. If parameters are passed also in the invocation statement, they will override the corresponding elements of the control object.} } \details{ The minimum covariance determinant estimator of location and scatter implemented in \code{covMcd()} is similar to \R function \code{\link[MASS]{cov.mcd}()} in \pkg{MASS}. The MCD method looks for the \eqn{h (> n/2)} (\eqn{h = h(\alpha,n,p) =} \code{\link{h.alpha.n}(alpha,n,p)}) observations (out of \eqn{n}) whose classical covariance matrix has the lowest possible determinant. The raw MCD estimate of location is then the average of these \eqn{h} points, whereas the raw MCD estimate of scatter is their covariance matrix, multiplied by a consistency factor (\code{.MCDcons(p, h/n)}) and (if \code{use.correction} is true) a finite sample correction factor (\code{.MCDcnp2(p, n, alpha)}), to make it consistent at the normal model and unbiased at small samples. Both rescaling factors (consistency and finite sample) are returned in the length-2 vector \code{raw.cnp2}. The implementation of \code{covMcd} uses the Fast MCD algorithm of Rousseeuw and Van Driessen (1999) to approximate the minimum covariance determinant estimator. Based on these raw MCD estimates, (unless argument \code{raw.only} is true), a reweighting step is performed, i.e., \code{V <- \link{cov.wt}(x,w)}, where \code{w} are weights determined by \dQuote{outlyingness} with respect to the scaled raw MCD. Again, a consistency factor and (if \code{use.correction} is true) a finite sample correction factor (\code{.MCDcnp2.rew(p, n, alpha)}) are applied. The reweighted covariance is typically considerably more efficient than the raw one, see Pison et al. (2002). The two rescaling factors for the reweighted estimates are returned in \code{cnp2}. Details for the computation of the finite sample correction factors can be found in Pison et al. (2002). } \author{Valentin Todorov \email{valentin.todorov@chello.at}, based on work written for S-plus by Peter Rousseeuw and Katrien van Driessen from University of Antwerp.% no E-mails for spam-protection Visibility of (formerly internal) tuning parameters, notably \code{wgtFUN()}: Martin Maechler } \value{ An object of class \code{"mcd"} which is basically a \code{\link{list}} with components \item{center}{the final estimate of location.} \item{cov}{the final estimate of scatter.} \item{cor}{the (final) estimate of the correlation matrix (only if \code{cor = TRUE}).} \item{crit}{the value of the criterion, i.e., the logarithm of the determinant. Previous to Nov.2014, it contained the determinant itself which can under- or overflow relatively easily.} \item{best}{the best subset found and used for computing the raw estimates, with \code{\link{length}(best) == quan = \link{h.alpha.n}(alpha,n,p)}.} \item{mah}{mahalanobis distances of the observations using the final estimate of the location and scatter.} \item{mcd.wt}{weights of the observations using the final estimate of the location and scatter.} \item{cnp2}{a vector of length two containing the consistency correction factor and the finite sample correction factor of the final estimate of the covariance matrix.} \item{raw.center}{the raw (not reweighted) estimate of location.} \item{raw.cov}{the raw (not reweighted) estimate of scatter.} \item{raw.mah}{mahalanobis distances of the observations based on the raw estimate of the location and scatter.} \item{raw.weights}{weights of the observations based on the raw estimate of the location and scatter.} \item{raw.cnp2}{a vector of length two containing the consistency correction factor and the finite sample correction factor of the raw estimate of the covariance matrix.} \item{X}{the input data as numeric matrix, without \code{\link{NA}}s.} \item{n.obs}{total number of observations.} \item{alpha}{the size of the subsets over which the determinant is minimized (the default is \eqn{(n+p+1)/2}).} \item{quan}{the number of observations, \eqn{h}, on which the MCD is based. If \code{quan} equals \code{n.obs}, the MCD is the classical covariance matrix.} \item{method}{character string naming the method (Minimum Covariance Determinant), starting with \code{"Deterministic"} when \code{nsamp="deterministic"}.} \item{iBest}{(for the deterministic MCD) contains indices from 1:6 denoting which of the (six) initial subsets lead to the best set found.} \item{n.csteps}{(for the deterministic MCD) for each of the initial subsets, the number of C-steps executed till convergence.} \item{call}{the call used (see \code{\link{match.call}}).} } \references{ Rousseeuw, P. J. and Leroy, A. M. (1987) \emph{Robust Regression and Outlier Detection.} Wiley. Rousseeuw, P. J. and van Driessen, K. (1999) A fast algorithm for the minimum covariance determinant estimator. \emph{Technometrics} \bold{41}, 212--223. Pison, G., Van Aelst, S., and Willems, G. (2002) Small Sample Corrections for LTS and MCD, \emph{Metrika} \bold{55}, 111--123.% ~/save/papers/robust-diverse/Pison_VanAelst_Willems.pdf Hubert, M., Rousseeuw, P. J. and Verdonck, T. (2012) A deterministic algorithm for robust location and scatter. Journal of Computational and Graphical Statistics \bold{21}, 618--637. } \seealso{ \code{\link[MASS]{cov.mcd}} from package \CRANpkg{MASS}; \code{\link{covOGK}} as cheaper alternative for larger dimensions. \code{\link[robustX]{BACON}} and \code{\link[robustX]{covNNC}}, from package \CRANpkg{robustX}; } \examples{ data(hbk) hbk.x <- data.matrix(hbk[, 1:3]) set.seed(17) (cH <- covMcd(hbk.x)) cH0 <- covMcd(hbk.x, nsamp = "deterministic") with(cH0, stopifnot(quan == 39, iBest == c(1:4,6), # 5 out of 6 gave the same identical(raw.weights, mcd.wt), identical(which(mcd.wt == 0), 1:14), all.equal(crit, -1.045500594135))) ## the following three statements are equivalent c1 <- covMcd(hbk.x, alpha = 0.75) c2 <- covMcd(hbk.x, control = rrcov.control(alpha = 0.75)) ## direct specification overrides control one: c3 <- covMcd(hbk.x, alpha = 0.75, control = rrcov.control(alpha=0.95)) c1 ## Martin's smooth reweighting: ## List of experimental pre-specified wgtFUN() creators: ## Cutoffs may depend on (n, p, control$beta) : str(.wgtFUN.covMcd) cMM <- covMcd(hbk.x, wgtFUN = "sm1.adaptive") ina <- which(names(cH) == "call") all.equal(cMM[-ina], cH[-ina]) # *some* differences, not huge (same 'best'): stopifnot(all.equal(cMM[-ina], cH[-ina], tol = 0.2)) } \keyword{robust} \keyword{multivariate} robustbase/man/cloud.Rd0000644000176200001440000000142513312375575014610 0ustar liggesusers\name{cloud} \alias{cloud} \docType{data} \title{Cloud point of a Liquid} \description{ This data set contains the measurements concerning the cloud point of a Liquid, from Draper and Smith (1969). The cloud point is a measure of the degree of crystallization in a stock. } \usage{data(cloud, package="robustbase")} \format{ A data frame with 19 observations on the following 2 variables. \describe{ \item{\code{Percentage}}{Percentage of I-8} \item{\code{CloudPoint}}{Cloud point} } } \source{ P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection}; Wiley, p.96, table 10. } \examples{ data(cloud) summary(lm.cloud <- lm(CloudPoint ~., data=cloud)) %% summary(lts.cloud <- ltsReg(CloudPoint ~., data=cloud)) } \keyword{datasets} robustbase/man/exAM.Rd0000644000176200001440000000202213312375575014326 0ustar liggesusers\name{exAM} \alias{exAM} \docType{data} \title{Example Data of Antille and May - for Simple Regression} \description{ This is an artificial data set, cleverly construced and used by Antille and May to demonstrate \sQuote{problems} with LMS and LTS. } \usage{data(exAM, package="robustbase")} \format{ A data frame with 12 observations on 2 variables, \code{x} and \code{y}. } \details{ Because the points are not in general position, both LMS and LTS typically \emph{fail}; however, e.g., \code{\link[MASS]{rlm}(*, method="MM")} \dQuote{works}. } \source{ Antille, G. and El May, H. (1992) The use of slices in the LMS and the method of density slices: Foundation and comparison.\cr In Yadolah Dodge and Joe Whittaker, editors, \emph{COMPSTAT: Proc. 10th Symp. Computat. Statist., Neuchatel}, \bold{1}, 441--445; Physica-Verlag. } % \references{ % ~~ possibly secondary sources and usages ~~ % } \examples{ data(exAM) plot(exAM) summary(ls <- lm(y ~ x, data=exAM)) abline(ls) } \keyword{robust} \keyword{datasets} robustbase/man/adjOutlyingness.Rd0000644000176200001440000001735113443724410016660 0ustar liggesusers\name{adjOutlyingness} \alias{adjOutlyingness} \title{Compute (Skewness-adjusted) Multivariate Outlyingness} \newcommand{\CRANpkg}{\href{https://CRAN.R-project.org/package=#1}{\pkg{#1}}} \description{ For an \eqn{n \times p}{n * p} data matrix (or data frame) \code{x}, compute the \dQuote{\emph{outlyingness}} of all \eqn{n} observations. Outlyingness here is a generalization of the Donoho-Stahel outlyingness measure, where skewness is taken into account via the medcouple, \code{\link{mc}()}. } \usage{ adjOutlyingness(x, ndir = 250, p.samp = p, clower = 4, cupper = 3, alpha.cutoff = 0.75, coef = 1.5, qr.tol = 1e-12, keep.tol = 1e-12, only.outlyingness = FALSE, maxit.mult = max(100, p), trace.lev = 0) } \arguments{ \item{x}{a numeric \code{\link{matrix}} or \code{\link{data.frame}}, which must be of full rank \eqn{p}.} \item{ndir}{positive integer specifying the number of directions that should be searched.} \item{p.samp}{the sample size to use for finding good random directions, must be at least \code{p}. The default, \code{p} had been hard coded previously.} \item{clower, cupper}{the constant to be used for the lower and upper tails, in order to transform the data towards symmetry. You can set \code{clower = 0, cupper = 0} to get the \emph{non}-adjusted, i.e., classical (\dQuote{central} or \dQuote{symmetric}) outlyingness. In that case, \code{\link{mc}()} is not used.} \item{alpha.cutoff}{number in (0,1) specifying the quantiles \eqn{(\alpha, 1-\alpha)} which determine the \dQuote{outlier} cutoff. The default, using quartiles, corresponds to the definition of the medcouple (\code{\link{mc}}), but there is no stringent reason for using the same alpha for the outlier cutoff.} \item{coef}{positive number specifying the factor with which the interquartile range (\code{\link{IQR}}) is multiplied to determine \sQuote{boxplot hinges}-like upper and lower bounds.} \item{qr.tol}{positive tolerance to be used for \code{\link{qr}} and \code{\link{solve.qr}} for determining the \code{ndir} directions, each determined by a random sample of \eqn{p} (out of \eqn{n}) observations. Note that the default \eqn{10^{-12}} is rather small, and \code{\link{qr}}'s default \code{= 1e-7} may be more appropriate.} \item{keep.tol}{positive tolerance to determine which of the sample direction should be kept, namely only those for which \eqn{\|x\| \cdot \|B\|}{||x|| * ||B||} is larger than \code{keep.tol}.} \item{only.outlyingness}{logical indicating if the final outlier determination should be skipped. In that case, a vector is returned, see \sQuote{Value:} below.} \item{maxit.mult}{integer factor; \code{maxit <- maxit.mult * ndir} will determine the maximal number of direction searching iterations. May need to be increased for higher dimensional data, though increasing \code{ndir} may be more important.} \item{trace.lev}{an integer, if positive allows to monitor the direction search.} } \note{ The result is \emph{random} as it depends on the sample of \code{ndir} directions chosen; specifically, to get sub samples the algorithm uses \code{\link{sample.int}(n, p.samp)} which from \R version 3.6.0 depends on \code{\link{RNGkind}(*, sample.kind)}. Exact reproducibility of results from \R versions 3.5.3 and earlier, requires setting \code{\link{RNGversion}("3.5.0")}.% same text in ./glmrob.Rd ("MT") In any case, do use \code{\link{set.seed}()} yourself for reproducibility! Till Aug/Oct. 2014, the default values for \code{clower} and \code{cupper} were accidentally reversed, and the signs inside \code{exp(.)} where swapped in the (now corrected) two expressions \preformatted{ tup <- Q3 + coef * IQR * exp(.... + clower * tmc * (tmc < 0)) tlo <- Q1 - coef * IQR * exp(.... - cupper * tmc * (tmc < 0)) } already in the code from Antwerpen (\file{mcrsoft/adjoutlingness.R}), contrary to the published reference. Further, the original algorithm had not been scale-equivariant in the direction construction, which has been amended in 2014-10 as well. The results, including diagnosed outliers, therefore have changed, typically slightly, since \pkg{robustbase} version 0.92-0. } \details{ \bold{FIXME}: Details in the comment of the Matlab code; also in the reference(s). %% SEE /u/maechler/R/MM/STATISTICS/robust/MC/mcmatl/adjoutlyingness.m %% ---- which has notes about input/output etc of the corresponding %% Matlab code The method as described can be useful as preprocessing in FASTICA (\url{http://www.cis.hut.fi/projects/ica/fastica/}; see also the \R package \CRANpkg{fastICA}. } \value{ If \code{only.outlyingness} is true, a vector \code{adjout}, otherwise, as by default, a list with components \item{adjout}{numeric of \code{length(n)} giving the adjusted outlyingness of each observation.} \item{cutoff}{cutoff for \dQuote{outlier} with respect to the adjusted outlyingnesses, and depending on \code{alpha.cutoff}.} \item{nonOut}{logical of \code{length(n)}, \code{TRUE} when the corresponding observation is \bold{non}-outlying with respect to the cutoff and the adjusted outlyingnesses.} } \references{ Brys, G., Hubert, M., and Rousseeuw, P.J. (2005) A Robustification of Independent Component Analysis; \emph{Journal of Chemometrics}, \bold{19}, 1--12. Hubert, M., Van der Veeken, S. (2008) Outlier detection for skewed data; \emph{Journal of Chemometrics} \bold{22}, 235--246. %% preprint \url{http://wis.kuleuven.be/stat/robust/papers/2008/outlierdetectionskeweddata-revision.pdf} %%MM: Journal-pdf ~/save/papers/robust-diverse/Hubert_VdV_skewed-Chemom_2008.pdf %%MM: Compstat 2010: Slides (of talk) and paper of Mia H: %% ~/save/papers/robust-diverse/Hubert_skewed-CS2010-slides.pdf and %% ~/save/papers/robust-diverse/Hubert_skewed-CS2010-paper.pdf (slides are better !!) For the up-to-date reference, please consult \url{http://wis.kuleuven.be/stat/robust} } \author{Guy Brys; help page and improvements by Martin Maechler} \seealso{the adjusted boxplot, \code{\link{adjbox}} and the medcouple, \code{\link{mc}}. } \examples{ ## An Example with bad condition number and "border case" outliers dim(longley) set.seed(1) ## result is random! ao1 <- adjOutlyingness(longley) ## which are outlying ? which(!ao1$nonOut) ## one: "1948" - for this seed! (often: none) all(ao1$nonOut[-2]) # TRUE typically (R's own BLAS, Lapack, ..) ## An Example with outliers : dim(hbk) set.seed(1) ao.hbk <- adjOutlyingness(hbk) str(ao.hbk) hist(ao.hbk $adjout)## really two groups table(ao.hbk$nonOut)## 14 outliers, 61 non-outliers: ## outliers are : which(! ao.hbk$nonOut) # 1 .. 14 --- but not for all random seeds! ## here, they are the same as found by (much faster) MCD: cc <- covMcd(hbk) stopifnot(all(cc$mcd.wt == ao.hbk$nonOut)) ## This is revealing: About 1--2 cases, where outliers are *not* == 1:14 ## but needs almost 1 [sec] per call: if(interactive()) { for(i in 1:30) { print(system.time(ao.hbk <- adjOutlyingness(hbk))) if(!identical(iout <- which(!ao.hbk$nonOut), 1:14)) { cat("Outliers:\n"); print(iout) } } } ## "Central" outlyingness: *not* calling mc() anymore, since 2014-12-11: trace(mc) out <- capture.output( oo <- adjOutlyingness(hbk, clower=0, cupper=0) ) untrace(mc) stopifnot(length(out) == 0) ## A rank-deficient case T <- tcrossprod(data.matrix(toxicity)) try(adjOutlyingness(T, maxit. = 20, trace.lev = 2)) # fails and recommends: T. <- fullRank(T) aT <- adjOutlyingness(T.) plot(sort(aT$adjout, decreasing=TRUE), log="y") plot(T.[,9:10], col = (1:2)[1 + (aT$adjout > 10000)]) ## .. (not conclusive; directions are random, more 'ndir' makes a difference!) } \keyword{robust} \keyword{multivariate} robustbase/man/lmrob.S.Rd0000644000176200001440000000663013212743621015007 0ustar liggesusers\name{lmrob.S} \alias{lmrob.S} \title{ S-regression estimators } \description{ Computes an S-estimator for linear regression, using the \dQuote{fast S} algorithm.% of Matias Salibian & Victor Yohai ... } \usage{ lmrob.S(x, y, control, trace.lev = control$trace.lev, only.scale = FALSE, mf = NULL) } \arguments{ \item{x}{design matrix (\eqn{n \times p}{n * p})} \item{y}{numeric vector of responses (or residuals for \code{only.scale=TRUE}).} \item{control}{ list as returned by \code{\link{lmrob.control}} } \item{trace.lev}{integer indicating if the progress of the algorithm should be traced (increasingly); default \code{trace.lev = 0} does no tracing.} \item{only.scale}{\code{\link{logical}} indicating if only the scale of \code{y} should be computed. In this case, \code{y} will typically contain \emph{residuals}.}%% FIXME: explain %% namely, s, fulfilling the \sum_i chi(i) = 1/2 equation. \item{mf}{unused and deprecated.} } \details{ This function is used by \code{\link{lmrob.fit}} and typically not to be used on its own (because an S-estimator has too low efficiency \sQuote{on its own}). By default, the subsampling algorithm uses a customized LU decomposition which ensures a non singular subsample (if this is at all possible). This makes the Fast-S algorithm also feasible for categorical and mixed continuous-categorical data. One can revert to the old subsampling scheme by setting the parameter \code{subsampling} in \code{control} to \code{"simple"}. } \value{ By default (when \code{only.scale} is false), a list with components \item{coefficients}{numeric vector (length \eqn{p}) of S-regression coefficient estimates.} \item{scale}{the S-scale residual estimate}% 'residual estimate' ?? % resid. VAR !? % \item{cov}{covariance matrix (\eqn{p \times p}{p x p}) of the % coefficient estimates.} \item{fitted.values}{numeric vector (length \eqn{n}) of the fitted values.} \item{residuals}{numeric vector (length \eqn{n}) of the residuals.} \item{rweights}{numeric vector (length \eqn{n}) of the robustness weights.} \item{k.iter}{(maximal) number of refinement iterations used.} \item{converged}{logical indicating if \bold{all} refinement iterations had converged.} \item{control}{the same list as the \code{control} argument.} If \code{only.scale} is true, the computed scale (a number) is returned. } \seealso{\code{\link{lmrob}}, also for references. } \author{ Matias Salibian-Barrera and Manuel Koller; Martin Maechler for minor new options and more documentation. } \examples{ set.seed(33) x1 <- sort(rnorm(30)); x2 <- sort(rnorm(30)); x3 <- sort(rnorm(30)) X. <- cbind(x1, x2, x3) y <- 10 + X. \%*\% (10*(2:4)) + rnorm(30)/10 y[1] <- 500 # a moderate outlier X.[2,1] <- 20 # an X outlier X1 <- cbind(1, X.) (m.lm <- lm(y ~ X.)) set.seed(12) m.lmS <- lmrob.S(x=X1, y=y, control = lmrob.control(nRes = 20), trace.lev=1) m.lmS[c("coefficients","scale")] all.equal(unname(m.lmS$coef), 10 * (1:4), tolerance = 0.005) stopifnot(all.equal(unname(m.lmS$coef), 10 * (1:4), tolerance = 0.005), all.equal(m.lmS$scale, 1/10, tolerance = 0.09)) ## only.scale = TRUE: Compute the S scale, given residuals; s.lmS <- lmrob.S(X1, y=residuals(m.lmS), only.scale = TRUE, control = lmrob.control(trace.lev = 3)) all.equal(s.lmS, m.lmS$scale) # close: 1.89e-6 [64b Lnx] } \keyword{robust} \keyword{regression} robustbase/man/covComed.Rd0000644000176200001440000000632312737470400015234 0ustar liggesusers\name{covComed} \title{Co-Median Location and Scatter "Covariance" Estimator} \alias{covComed} %%TODO: these two are not yet imported and hence not yet documented below: \alias{comedian} \alias{COM} \alias{.wgtFUN.covComed} % \concept{Co-median} \concept{Comedian} \description{ Compute (versions of) the (multivariate) \dQuote{Comedian} covariance, i.e., multivariate location and scatter estimator } \usage{ covComed(X, n.iter = 2, reweight = FALSE, tolSolve = control$tolSolve, trace = control$trace, wgtFUN = control$wgtFUN, control = rrcov.control()) % comedian(...) % COM(...) } \arguments{ \item{X}{data matrix of dimension, say \eqn{n \times p}{n x p}.} \item{n.iter}{number of comedian() iterations. Can be as low as zero.} \item{reweight}{logical indicating if the final distances and weights should be recomputed from the final \code{cov} and \code{center}. The default is currently \code{FALSE} because that was implicit in the first version of the \R code.} \item{tolSolve}{a numerical tolerance passed to \code{\link{solve}}.} \item{trace}{logical (or integer) indicating if intermediate results should be printed; defaults to \code{FALSE}; values \eqn{\ge 2}{>= 2} also produce print from the internal (Fortran) code.} \item{wgtFUN}{a character string or \code{\link{function}}, specifying how the weights for the reweighting step should be computed. The default, \code{wgtFUN = "01.original"} corresponds to 0-1 weights as proposed originally. Other predefined string options are available, though experimental, see the experimental \code{.wgtFUN.covComed} object.} \item{control}{a list with estimation options - this includes those above provided in the function specification, see \code{\link{rrcov.control}} for the defaults. If \code{control} is supplied, the parameters from it will be used. If parameters are passed also in the invocation statement, they will override the corresponding elements of the control object.} } \details{ .. not yet .. } \value{ an object of class \code{"covComed"} which is basically a list with components \item{comp1 }{Description of 'comp1'} \item{comp2 }{Description of 'comp2'} ... FIXME ... } \references{ Falk, M. (1997) On mad and comedians. \emph{Annals of the Institute of Statistical Mathematics} \bold{49}, 615--644. Falk, M. (1998). A note on the comedian for elliptical distributions. \emph{Journal of Multivariate Analysis} \bold{67}, 306--317. } \author{ Maria Anna di Palma (initial), Valentin Todorov and Martin Maechler } \seealso{ \code{\link{covMcd}}, etc } \examples{ data(hbk) hbk.x <- data.matrix(hbk[, 1:3]) (cc1 <- covComed(hbk.x)) (ccW <- covComed(hbk.x, reweight=TRUE)) cc0 <- covComed(hbk.x, n.iter=0) cc0W <- covComed(hbk.x, n.iter=0, reweight=TRUE) stopifnot(all.equal(unclass(cc0), # here, the 0-1 weights don't change: cc0W[names(cc0)], tol=1e-12), which(cc1$weights == 0) == 1:14, which(ccW$weights == 0) == 1:14, which(cc0$weights == 0) == 1:14) %% TODO : more ## Martin's smooth reweighting: ## List of experimental pre-specified wgtFUN() creators: ## Cutoffs may depend on (n, p, control$beta) : str(.wgtFUN.covComed) } robustbase/man/anova.lmrob.Rd0000644000176200001440000001010612221620231015670 0ustar liggesusers\name{anova.lmrob} \alias{anova.lmrob} \title{Analysis of Robust Deviances ('anova') for "lmrob" Objects} \description{ Compute an analysis of robust Wald-type or deviance-type test tables for one or more linear regression models fitted by \code{\link{lmrob}}. } \usage{ \method{anova}{lmrob}(object, \dots, test = c("Wald", "Deviance"), verbose = getOption("verbose")) } \arguments{ \item{object, \dots}{objects of class \code{"lmrob"}, typically the result of a call to \code{\link{lmrob}}. \code{\dots} arguments may also be symbolic descriptions of the reduced models (cf. argument \code{formula} in \code{\link{lm}}). } \item{test}{a character string specifying the test statistic to be used. Can be one of \code{"Wald"} or \code{"Deviance"}, with partial matching allowed, for specifying a \code{"Wald"}-type test or \code{"Deviance"}-type test.} \item{verbose}{logical; if true some informative messages are printed.} } \details{ Specifying a single object gives a sequential analysis of a robust quasi-deviance table for that fit. That is, the reductions in the robust residual deviance as each term of the formula is added in turn are given in as the rows of a table. (Currently not yet implemented.) If more than one object is specified, the table has a row for the residual quasi-degrees of freedom (however, this information is never used in the asymptotic tests). For all but the first model, the change in degrees of freedom and robust deviance is also given. (This only makes statistical sense if the models are nested.) As opposed to the convention, the models are forced to be listed from largest to smallest due to computational reasons. In addition, the table will contain test statistics and P values comparing the reduction in robust deviances for the model on the row to that on top of it. There are two different robust tests available: The "Wald"-type test (\code{test = "Wald"}) and the Deviance-type test (\code{test = "Deviance"}). When using formula description of the nested models in the dot arguments and \code{test = "Deviance"}, you may be urged to supply a \code{\link{lmrob}} fit for these models by an error message. This happens when the coefficients of the largest model reduced to the nested models result in invalid initial estimates for the nested models (indicated by robustness weights which are all 0). The comparison between two or more models by \code{\link{anova.lmrob}} will only be valid if they are fitted to the same dataset. } \value{ Basically, an object of class \code{\link{anova}} inheriting from class \code{\link{data.frame}}. } %%\references{ ~put references to the literature/web site here ~ } \author{Andreas Ruckstuhl} \seealso{\code{\link{lmrob}}, \code{\link{anova}}. } \examples{ data(salinity) summary(m0.sali <- lmrob(Y ~ . , data = salinity)) anova(m0.sali, Y ~ X1 + X3) ## -> X2 is not needed (m1.sali <- lmrob(Y ~ X1 + X3, data = salinity)) anova(m0.sali, m1.sali) # the same as before anova(m0.sali, m1.sali, test = "Deviance") ## whereas 'X3' is highly significant: m2 <- update(m0.sali, ~ . -X3) anova(m0.sali, m2) anova(m0.sali, m2, test = "Deviance") ## Global test [often not interesting]: anova(m0.sali, update(m0.sali, . ~ 1), test = "Wald") anova(m0.sali, update(m0.sali, . ~ 1), test = "Deviance") if(require("MPV")) { ## Montgomery, Peck & Vining datasets Jet <- table.b13 Jet.rflm1 <- lmrob(y ~ ., data=Jet, control = lmrob.control(max.it = 500)) summary(Jet.rflm1) anova(Jet.rflm1, y ~ x1 + x5 + x6, test="Wald") try( anova(Jet.rflm1, y ~ x1 + x5 + x6, test="Deviance") ) ## -> Error in anovaLm.... Please fit the nested models by lmrob ## {{ since all robustness weights become 0 in the nested model ! }} ## Ok: Do as the error message told us: ## test by comparing the two *fitted* models: Jet.rflm2 <- lmrob(y ~ x1 + x5 + x6, data=Jet, control=lmrob.control(max.it=100)) anova(Jet.rflm1, Jet.rflm2, test="Deviance") } # end{"MPV" data} } \keyword{robust} \keyword{models} \keyword{regression} robustbase/man/glmrob.Rd0000644000176200001440000003274013441022761014755 0ustar liggesusers\name{glmrob} \alias{glmrob} \title{Robust Fitting of Generalized Linear Models} \encoding{utf8} \description{ \code{glmrob} is used to fit generalized linear models by robust methods. The models are specified by giving a symbolic description of the linear predictor and a description of the error distribution. Currently, robust methods are implemented for \code{\link{family} = binomial}, \code{ = poisson}, \code{ = Gamma} and \code{ = gaussian}. } \usage{ glmrob(formula, family, data, weights, subset, na.action, start = NULL, offset, method = c("Mqle", "BY", "WBY", "MT"), weights.on.x = c("none", "hat", "robCov", "covMcd"), control = NULL, model = TRUE, x = FALSE, y = TRUE, contrasts = NULL, trace.lev = 0, ...) } \arguments{ \item{formula}{a \code{\link{formula}}, i.e., a symbolic description of the model to be fit (cf. \code{\link{glm}} or \code{\link{lm}}).} \item{family}{a description of the error distribution and link function to be used in the model. This can be a character string naming a family function, a family \code{\link{function}} or the result of a call to a family function. (See \code{\link{family}} for details of family functions.)} \item{data}{an optional data frame containing the variables in the model. If not found in \code{data}, the variables are taken from \code{environment(formula)}, typically the environment from which \code{glmrob} is called.} \item{weights}{an optional vector of weights to be used in the fitting process.} \item{subset}{an optional vector specifying a subset of observations to be used in the fitting process.} \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. The default is set by the \code{na.action} setting in \code{\link{options}}. The \dQuote{factory-fresh} default is \code{\link{na.omit}}.} \item{start}{starting values for the parameters in the linear predictor. Note that specifying \code{start} has somewhat different meaning for the different \code{method}s. Notably, for \code{"MT"}, this skips the expensive computation of initial estimates via sub samples, but needs to be \emph{robust} itself.} \item{offset}{this can be used to specify an \emph{a priori} known component to be included in the linear predictor during fitting.} \item{method}{a character string specifying the robust fitting method. The details of method specification are given below.} \item{weights.on.x}{ a character string (can be abbreviated), a \code{\link{function}} or \code{\link{list}} (see below), or a numeric vector of length \code{n}, specifying how points (potential outliers) in x-space are downweighted. If \code{"hat"}, weights on the design of the form \eqn{\sqrt{1-h_{ii}}} are used, where \eqn{h_{ii}} are the diagonal elements of the hat matrix. If \code{"robCov"}, weights based on the robust Mahalanobis distance of the design matrix (intercept excluded) are used where the covariance matrix and the centre is estimated by \code{\link[MASS]{cov.rob}} from the package \pkg{MASS}.\cr Similarly, if \code{"covMcd"}, robust weights are computed using \code{\link{covMcd}}. The default is \code{"none"}. If \code{weights.on.x} is a \code{\link{function}}, it is called with arguments \code{(X, intercept)} and must return an n-vector of non-negative weights. If it is a \code{\link{list}}, it must be of length one, and as element contain a function much like \code{\link{covMcd}()} or \code{\link[MASS]{cov.rob}()} (package \pkg{MASS}), which computes multivariate location and \dQuote{scatter} of a data matrix \code{X}. } \item{control}{a list of parameters for controlling the fitting process. See the documentation for \code{\link{glmrobMqle.control}} for details.} \item{model}{a logical value indicating whether \emph{model frame} should be included as a component of the returned value.} \item{x, y}{logical values indicating whether the response vector and model matrix used in the fitting process should be returned as components of the returned value.} \item{contrasts}{an optional list. See the \code{contrasts.arg} of \code{model.matrix.default}.} \item{trace.lev}{logical (or integer) indicating if intermediate results should be printed; defaults to \code{0} (the same as \code{FALSE}).} \item{\dots}{arguments passed to \code{\link{glmrobMqle.control}} when \code{control} is \code{NULL} (as per default).} } \details{ \code{method="model.frame"} returns the \code{\link{model.frame}()}, the same as \code{\link{glm}()}. \cr \code{method="Mqle"} fits a generalized linear model using Mallows or Huber type robust estimators, as described in Cantoni and Ronchetti (2001) and Cantoni and Ronchetti (2006). In contrast to the implementation described in Cantoni (2004), the pure influence algorithm is implemented. \cr \code{method="WBY"} and \code{method="BY"}, available for logistic regression (\code{family = binomial}) only, call \code{\link{BYlogreg}(*, initwml= . )} for the (weighted) Bianco-Yohai estimator, where \code{initwml} is true for \code{"WBY"}, and false for \code{"BY"}. \cr \code{method="MT"}, currently only implemented for \code{family = poisson}, computes an \dQuote{[M]-Estimator based on [T]ransformation}, by Valdora and Yohai (2013), via (hidden internal) \code{glmrobMT()}; as that uses \code{\link{sample}()}, from \R version 3.6.0 it depends on \code{\link{RNGkind}(*, sample.kind)}. Exact reproducibility of results from \R versions 3.5.3 and earlier, requires setting \code{\link{RNGversion}("3.5.0")}.% same text in ./adjOutlyingness.Rd \code{weights.on.x= "robCov"} makes sense if all explanatory variables are continuous. In the cases,where \code{weights.on.x} is \code{"covMcd"} or \code{"robCov"}, or list with a \dQuote{robCov} function, the mahalanobis distances \code{D^2} are computed with respect to the covariance (location and scatter) estimate, and the weights are \code{1/sqrt(1+ pmax.int(0, 8*(D2 - p)/sqrt(2*p)))}, where \code{D2 = D^2} and \code{p = ncol(X)}. } \value{ \code{glmrob} returns an object of class \code{"glmrob"} and is also inheriting from \code{\link{glm}}. \cr The \code{\link{summary}} method, see \code{\link{summary.glmrob}}, can be used to obtain or print a summary of the results. \cr The generic accessor functions \code{\link{coefficients}}, \code{effects}, \code{fitted.values} and \code{residuals} (see \code{\link{residuals.glmrob}}) can be used to extract various useful features of the value returned by \code{glmrob()}. An object of class \code{"glmrob"} is a list with at least the following components: \item{coefficients}{a named vector of coefficients} \item{residuals}{the \emph{working} residuals, that is the (robustly \dQuote{huberized}) residuals in the final iteration of the IWLS fit.} \item{fitted.values}{the fitted mean values, obtained by transforming the linear predictors by the inverse of the link function.} \item{w.r}{robustness weights for each observations; i.e., \code{residuals} \eqn{\times}{*} \code{w.r} equals the psi-function of the Preason's residuals.} \item{w.x}{weights used to down-weight observations based on the position of the observation in the design space.} \item{dispersion}{robust estimation of dispersion paramter if appropriate} \item{cov}{the estimated asymptotic covariance matrix of the estimated coefficients.} \item{tcc}{the tuning constant c in Huber's psi-function.} \item{family}{the \code{\link{family}} object used.} \item{linear.predictors}{the linear fit on link scale.} \item{deviance}{NULL; Exists because of compatipility reasons.} \item{iter}{the number of iterations used by the influence algorithm.} \item{converged}{logical. Was the IWLS algorithm judged to have converged?} \item{call}{the matched call.} \item{formula}{the formula supplied.} \item{terms}{the \code{\link{terms}} object used.} \item{data}{the \code{data argument}.} \item{offset}{the offset vector used.} \item{control}{the value of the \code{control} argument used.} \item{method}{the name of the robust fitter function used.} \item{contrasts}{(where relevant) the contrasts used.} \item{xlevels}{(where relevant) a record of the levels of the factors used in fitting.} %% FIXME: This is for glm() -- but *not* (yet ??) for glmrob() %% ----- should we change? % If a \code{\link{binomial}} \code{glm} model was specified by giving a % two-column response, the weights returned by \code{prior.weights} are % the total numbers of cases (multipied by the supplied case weights) and % the component \code{y} of the result is the proportion of successes. } \references{ Eva Cantoni and Elvezio Ronchetti (2001) Robust Inference for Generalized Linear Models. \emph{JASA} \bold{96} (455), 1022--1030. Eva Cantoni (2004) Analysis of Robust Quasi-deviances for Generalized Linear Models. \emph{Journal of Statistical Software}, \bold{10}, \url{http://www.jstatsoft.org/v10/i04} Eva Cantoni and Elvezio Ronchetti (2006) A robust approach for skewed and heavy-tailed outcomes in the analysis of health care expenditures. \emph{Journal of Health Economics} \bold{25}, 198--213. S. Heritier, E. Cantoni, S. Copt, M.-P. Victoria-Feser (2009) \emph{Robust Methods in Biostatistics}. Wiley Series in Probability and Statistics. Marina Valdora and Víctor J. Yohai (2013) Robust estimators for Generalized Linear Models. In progress. } \author{Andreas Ruckstuhl ("Mqle") and Martin Maechler} %%\note{ } \seealso{ \code{\link{predict.glmrob}} for prediction; \code{\link{glmrobMqle.control}} } \examples{ ## Binomial response -------------- data(carrots) Cfit1 <- glm(cbind(success, total-success) ~ logdose + block, data = carrots, family = binomial) summary(Cfit1) Rfit1 <- glmrob(cbind(success, total-success) ~ logdose + block, family = binomial, data = carrots, method= "Mqle", control= glmrobMqle.control(tcc=1.2)) summary(Rfit1) Rfit2 <- glmrob(success/total ~ logdose + block, weights = total, family = binomial, data = carrots, method= "Mqle", control= glmrobMqle.control(tcc=1.2)) coef(Rfit2) ## The same as Rfit1 ## Binary response -------------- data(vaso) Vfit1 <- glm(Y ~ log(Volume) + log(Rate), family=binomial, data=vaso) coef(Vfit1) Vfit2 <- glmrob(Y ~ log(Volume) + log(Rate), family=binomial, data=vaso, method="Mqle", control = glmrobMqle.control(tcc=3.5)) coef(Vfit2) # c = 3.5 ==> not much different from classical ## Note the problems with tcc <= 3 %% FIXME algorithm ??? Vfit3 <- glmrob(Y ~ log(Volume) + log(Rate), family=binomial, data=vaso, method= "BY") coef(Vfit3)## note that results differ much. ## That's not unreasonable however, see Kuensch et al.(1989), p.465 ## Poisson response -------------- data(epilepsy) Efit1 <- glm(Ysum ~ Age10 + Base4*Trt, family=poisson, data=epilepsy) summary(Efit1) Efit2 <- glmrob(Ysum ~ Age10 + Base4*Trt, family = poisson, data = epilepsy, method= "Mqle", control = glmrobMqle.control(tcc= 1.2)) summary(Efit2) ## 'x' weighting: (Efit3 <- glmrob(Ysum ~ Age10 + Base4*Trt, family = poisson, data = epilepsy, method= "Mqle", weights.on.x = "hat", control = glmrobMqle.control(tcc= 1.2))) try( # gives singular cov matrix: 'Trt' is binary factor --> # affine equivariance and subsampling are problematic Efit4 <- glmrob(Ysum ~ Age10 + Base4*Trt, family = poisson, data = epilepsy, method= "Mqle", weights.on.x = "covMcd", control = glmrobMqle.control(tcc=1.2, maxit=100)) ) ##--> See example(possumDiv) for another Poisson-regression ### -------- Gamma family -- data from example(glm) --- clotting <- data.frame( u = c(5,10,15,20,30,40,60,80,100), lot1 = c(118,58,42,35,27,25,21,19,18), lot2 = c(69,35,26,21,18,16,13,12,12)) summary(cl <- glm (lot1 ~ log(u), data=clotting, family=Gamma)) summary(ro <- glmrob(lot1 ~ log(u), data=clotting, family=Gamma)) clotM5.high <- within(clotting, { lot1[5] <- 60 }) op <- par(mfrow=2:1, mgp = c(1.6, 0.8, 0), mar = c(3,3:1)) plot( lot1 ~ log(u), data=clotM5.high) plot(1/lot1 ~ log(u), data=clotM5.high) par(op) ## Obviously, there the first observation is an outlier with respect to both ## representations! cl5.high <- glm (lot1 ~ log(u), data=clotM5.high, family=Gamma) ro5.high <- glmrob(lot1 ~ log(u), data=clotM5.high, family=Gamma) with(ro5.high, cbind(w.x, w.r))## the 5th obs. is downweighted heavily! plot(1/lot1 ~ log(u), data=clotM5.high) abline(cl5.high, lty=2, col="red") abline(ro5.high, lwd=2, col="blue") ## result is ok (but not "perfect") %% FIXME: Need work -- option of *starting* from %% ----- see Andreas' ~/R/MM/Pkg-ex/robustbase/glmrob-gamma-ARu.R % ## a "regular outlier" in the middle : % clotM4.3 <- within(clotting, { lot1[4] <- 1000 }) % ## .. not even this one works : ... need *robust* start ?! % try(cl4.3 <- glm (lot1 ~ log(u), data=clotM4.3, family=Gamma)) % try(ro4.3 <- glmrob(lot1 ~ log(u), data=clotM4.3, family=Gamma)) % ## The new option to start from "lmrobMM" --- not yet ok either % try( % ro4.3 <- glmrob(lot1 ~ log(u), data=clotM4.3, family=Gamma, % start = "lmrobMM") % ) % ## summary(ro4.3) %% TODO the "same" with lot2 : %% summary(glm(lot2 ~ log(u), data=clotting, family=Gamma)) } \keyword{robust} \keyword{regression} \keyword{nonlinear} robustbase/man/lmrob.fit.Rd0000644000176200001440000000513013212743621015361 0ustar liggesusers\name{lmrob.fit} \alias{lmrob.fit} \alias{lmrob.fit.MM} \title{ MM-type estimator for regression } \description{ Compute MM-type estimators of regression: An S-estimator is used as starting value, and an M-estimator with fixed scale and redescending psi-function is used from there. Optionally a D-step (Design Adaptive Scale estimate) as well as a second M-step is calculated. } \usage{ lmrob.fit(x, y, control, init = NULL, mf = NULL) } \arguments{ \item{x}{design matrix (\eqn{n \times p}{n x p}) typically including a column of \code{1}s for the intercept.} \item{y}{numeric response vector (of length \eqn{n}).} \item{control}{a list of control parameters as returned by \code{\link{lmrob.control}}, used for both the initial S-estimate and the subsequent M- and D-estimates.} \item{init}{optional \code{\link{list}} of initial estimates. See \emph{Details}.} \item{mf}{unused and deprecated.} } \details{This function is the basic fitting function for MM-type estimation, called by \code{\link{lmrob}} and typically not to be used on its own. If given, \code{init} must be a list of initial estimates containing at least the initial coefficients and scale as \code{coefficients} and \code{scale}. Otherwise it calls \code{\link{lmrob.S}(..)} and uses it as initial estimator. } \value{ A list with components \item{fitted.values}{\eqn{X \beta}{X beta}, i.e., \code{X \%*\% coefficients}.} \item{residuals}{the raw residuals, \code{y - fitted.values}} \item{rweights}{robustness weights derived from the final M-estimator residuals (even when not converged).} \item{rank}{} \item{degree.freedom}{\code{n - rank}}% more! \item{coefficients}{estimated regression coefficient vector} \item{scale}{the robustly estimated error standard deviation}% = final.MM$scale, \item{cov}{variance-covariance matrix of \code{coefficients}, if the RWLS iterations have converged (and \code{control$cov} is not \code{"none"}).} \item{control}{}% = control, \item{iter}{}% = final.MM$iter, <<<<<< also 'init.S' ! \item{converged}{logical indicating if the RWLS iterations have converged.} \item{init.S}{the whole initial S-estimator result, including its own \code{converged} flag, see \code{\link{lmrob.S}} (only for MM-estimates).} \item{init}{A similar list that contains the results of intermediate estimates (not for MM-estimates).} } \author{ Matias Salibian-Barrera, Martin Maechler and Manuel Koller} \seealso{ \code{\link{lmrob}}, \code{\link{lmrob..M..fit}}, \code{\link{lmrob..D..fit}}, \code{\link{lmrob.S}} } \keyword{robust} \keyword{regression} robustbase/man/BYlogreg.Rd0000644000176200001440000001102313162770164015203 0ustar liggesusers\name{BYlogreg} \alias{BYlogreg} \title{Bianco-Yohai Estimator for Robust Logistic Regression} \encoding{utf8} \description{ Computation of the estimator of Bianco and Yohai (1996) in logistic regression. Now provides both the \emph{weighted} and regular (unweighted) BY-estimator. By default, an intercept term is included and p parameters are estimated. For more details, see the reference. Note: This function is for \dQuote{back-compatibility} with the \code{BYlogreg()} code web-published at KU Leuven, Belgium, % moved to ? -- but NA (404) on 2017-09-26: % --> ../R/BYlogreg.R % \url{http://feb.kuleuven.be/public/NDBAE06/programs/roblog/}; % now, findable at % http://feb.kuleuven.be/public/u0017833/software_donotuse/logreg/BYlogreg.txt % but rather use Wiley's book resources and also available as file \file{FunctionsRob/BYlogreg.ssc} from \url{http://www.wiley.com/legacy/wileychi/robust_statistics/robust.html}. However instead of using this function, the recommended interface is \code{\link{glmrob}(*, method = "BY")} or \code{... method = "WBY" ..}, see \code{\link{glmrob}}. } \usage{ BYlogreg(x0, y, initwml = TRUE, addIntercept = TRUE, const = 0.5, kmax = 1000, maxhalf = 10, sigma.min = 1e-4, trace.lev = 0) } \arguments{ \item{x0}{a numeric \eqn{n \times (p-1)}{n * (p-1)} matrix containing the explanatory variables.} \item{y}{numeric \eqn{n}-vector of binomial (0 - 1) responses.} \item{initwml}{logical for selecting one of the two possible methods for computing the initial value of the optimization process. If \code{initwml} is true (default), a weighted ML estimator is computed with weights derived from the MCD estimator computed on the explanatory variables. If \code{initwml} is false, a classical ML fit is perfomed. When the explanatory variables contain binary observations, it is recommended to set initwml to FALSE or to modify the code of the algorithm to compute the weights only on the continuous variables. } \item{addIntercept}{logical indicating that a column of \code{1} must be added the \eqn{x} matrix.} \item{const}{tuning constant used in the computation of the estimator (default=0.5).} \item{kmax}{maximum number of iterations before convergence (default=1000).} \item{maxhalf}{max number of step-halving (default=10).} \item{sigma.min}{smallest value of the scale parameter before implosion (and hence non-convergence) is assumed.} \item{trace.lev}{logical (or integer) indicating if intermediate results should be printed; defaults to \code{0} (the same as \code{FALSE}).} } %% \details{ %% If necessary, more details than the description above %% } \value{ a list with components \item{convergence}{logical indicating if convergence was achieved} \item{objective}{the value of the objective function at the minimum} \item{coefficients}{vector of parameter estimates} \item{vcov}{variance-covariance matrix of the coefficients (if convergence is TRUE).} \item{sterror}{standard errors, i.e., simply \code{sqrt(diag(.$vcov))}, if convergence.} } \references{ Croux, C., and Haesbroeck, G. (2003) Implementing the Bianco and Yohai estimator for Logistic Regression, \emph{Computational Statistics and Data Analysis} \bold{44}, 273--295. Ana M. Bianco and Víctor J. Yohai (1996) Robust estimation in the logistic regression model. In Helmut Rieder, \emph{Robust Statistics, Data Analysis, and Computer Intensive Methods}, Lecture Notes in Statistics \bold{109}, pages 17--34. } \author{ Originally, Christophe Croux and Gentiane Haesbroeck, with thanks to Kristel Joossens and Valentin Todorov for improvements. Speedup, tweaks, more \dQuote{control} arguments: Martin Maechler. } \seealso{ The more typical way to compute BY-estimates (via \code{\link{formula}} and methods): \code{\link{glmrob}(*, method = "WBY")} and \code{.. method = "BY"}. } \examples{ set.seed(17) x0 <- matrix(rnorm(100,1)) y <- rbinom(100, size=1, prob= 0.5) # ~= as.numeric(runif(100) > 0.5) BY <- BYlogreg(x0,y) BY <- BYlogreg(x0,y, trace.lev=TRUE) ## The "Vaso Constriction" aka "skin" data: data(vaso) vX <- model.matrix( ~ log(Volume) + log(Rate), data=vaso) vY <- vaso[,"Y"] head(cbind(vX, vY))# 'X' does include the intercept vWBY <- BYlogreg(x0 = vX, y = vY, addIntercept=FALSE) # as 'vX' has it already v.BY <- BYlogreg(x0 = vX, y = vY, addIntercept=FALSE, initwml=FALSE) ## they are relatively close: stopifnot( all.equal(vWBY, v.BY, tolerance = 2e-4) ) } \keyword{robust} \keyword{regression} \keyword{nonlinear} robustbase/man/predict.lmrob.Rd0000644000176200001440000001207712471655756016262 0ustar liggesusers\name{predict.lmrob} \alias{predict.lmrob} \title{Predict method for Robust Linear Model ("lmrob") Fits} \description{ Predicted values based on robust linear model object. } \usage{ \method{predict}{lmrob}(object, newdata, se.fit = FALSE, scale = NULL, df = NULL, interval = c("none", "confidence", "prediction"), level = 0.95, type = c("response", "terms"), terms = NULL, na.action = na.pass, pred.var = res.var/weights, weights = 1, ...) } \arguments{ %% the following is +- copy-pasted from predict.lm.Rd: \item{object}{object of class inheriting from \code{"lmrob"}} \item{newdata}{an optional data frame in which to look for variables with which to predict. If omitted, the fitted values are used.} \item{se.fit}{a switch indicating if standard errors are required.} \item{scale}{scale parameter for std.err. calculation} \item{df}{degrees of freedom for scale} \item{interval}{type of interval calculation.} \item{level}{tolerance/confidence level} \item{type}{Type of prediction (response or model term).} \item{terms}{if \code{type="terms"}, which terms (default is all terms)} \item{na.action}{function determining what should be done with missing values in \code{newdata}. The default is to predict \code{NA}.} \item{pred.var}{the variance(s) for future observations to be assumed for prediction intervals. See \sQuote{Details}.} \item{weights}{variance weights for prediction. This can be a numeric vector or a one-sided model formula. In the latter case, it is interpreted as an expression evaluated in \code{newdata}} \item{\dots}{further arguments passed to or from other methods.} } \details{ Note that this \code{lmrob} method for \code{\link{predict}} is closely modeled after the method for \code{lm()}, \code{\link{predict.lm}}, maybe see there for caveats with missing value treatment. %% Also lifted from predict.lm.Rd : The prediction intervals are for a single observation at each case in \code{newdata} (or by default, the data used for the fit) with error variance(s) \code{pred.var}. This can be a multiple of \code{res.var}, the estimated value of \eqn{\sigma^2}: the default is to assume that future observations have the same error variance as those used for fitting. If \code{weights} is supplied, the inverse of this is used as a scale factor. For a weighted fit, if the prediction is for the original data frame, \code{weights} defaults to the weights used for the model fit, with a warning since it might not be the intended result. If the fit was weighted and \code{newdata} is given, the default is to assume constant prediction variance, with a warning. } \value{ %% the following is +- copy-pasted from predict.lm.Rd: \code{predict.lmrob} produces a vector of predictions or a matrix of predictions and bounds with column names \code{fit}, \code{lwr}, and \code{upr} if \code{interval} is set. If \code{se.fit} is \code{TRUE}, a list with the following components is returned: \item{fit}{vector or matrix as above} \item{se.fit}{standard error of predicted means} \item{residual.scale}{residual standard deviations} \item{df}{degrees of freedom for residual} } % \references{ % } \author{Andreas Ruckstuhl} \seealso{ \code{\link{lmrob}} and the (non-robust) traditional \code{\link{predict.lm}} method. } \examples{ ## Predictions --- artificial example -- closely following example(predict.lm) set.seed(5) n <- length(x <- sort(c(round(rnorm(25), 1), 20))) y <- x + rnorm(n) iO <- c(sample(n-1, 3), n) y[iO] <- y[iO] + 10*rcauchy(iO) p.ex <- function(...) { plot(y ~ x, ...); abline(0,1, col="sky blue") points(y ~ x, subset=iO, col="red", pch=2) abline(lm (y ~ x), col = "gray40") abline(lmrob(y ~ x), col = "forest green") legend("topleft", c("true", "Least Squares", "robust"), col = c("sky blue", "gray40", "forest green"), lwd=1.5, bty="n") } p.ex() fm <- lmrob(y ~ x) predict(fm) new <- data.frame(x = seq(-3, 10, 0.25)) str(predict(fm, new, se.fit = TRUE)) pred.w.plim <- predict(fm, new, interval = "prediction") pred.w.clim <- predict(fm, new, interval = "confidence") pmat <- cbind(pred.w.clim, pred.w.plim[,-1]) matlines(new$x, pmat, lty = c(1,2,2,3,3))# add to first plot ## show zoom-in region : rect(xleft = -3, ybottom = -20, xright = 10, ytop = 40, lty = 3, border="orange4") ## now zoom in : p.ex(xlim = c(-3,10), ylim = c(-20, 40)) matlines(new$x, pmat, lty = c(1,2,2,3,3)) box(lty = 3, col="orange4", lwd=3) legend("bottom", c("fit", "lwr CI", "upr CI", "lwr Pred.I", "upr Pred.I"), col = 1:5, lty=c(1,2,2,3,3), bty="n") ## Prediction intervals, special cases ## The first three of these throw warnings w <- 1 + x^2 fit <- lmrob(y ~ x) wfit <- lmrob(y ~ x, weights = w) predict(fit, interval = "prediction") predict(wfit, interval = "prediction") predict(wfit, new, interval = "prediction") predict(wfit, new, interval = "prediction", weights = (new$x)^2) -> p.w2 p.w2 stopifnot(identical(p.w2, ## the same as using formula: predict(wfit, new, interval = "prediction", weights = ~x^2))) } \keyword{robust} \keyword{regression} robustbase/man/psi_func-class.Rd0000644000176200001440000000503113310673404016376 0ustar liggesusers\name{psi_func-class} \docType{class} \alias{psi_func-class} \title{Class of "Psi Functions" for M-Estimation} %% 'psi_func' cannot be used in title! \description{ The class \code{"psi_func"} is used to store \eqn{\psi \ (psi)}{psi} functions for M-estimation. In particular, an object of the class contains \eqn{\rho(x) \ (\code{rho})}{rho(x)}, its derivative \eqn{\psi(x) \ (psi)}{psi(x)}, the weight function \eqn{\psi(x)/x}, and first derivative of \eqn{\psi}, \code{Dpsi = } \eqn{\psi'(x)}. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("psi_func", ...)}, but preferably by \code{\link{psiFunc}(...)}. } \section{Slots}{ \describe{ \item{\code{rho}:}{the \eqn{\rho()}{rho()} function, an object of class \code{"functionX"}. This is used to formulate the objective function; \eqn{\rho()} can be regarded as generalized negative log-likelihood.} \item{\code{psi}:}{\eqn{\psi()}{psi()} is the derivative of \eqn{\rho}, \eqn{\psi(x) = \frac{d}{dx} \rho(x)}{psi(x) = d/dx rho(x)}; also of class \code{"functionX"}.} \item{\code{wgt}:}{The weight function \eqn{\psi(x)/x}, of class \code{"functionX"}.} \item{\code{Dpsi}:}{the derivative of \eqn{\psi}, \eqn{Dpsi(x) = psi'(x)}; of class \code{"functionX"}.} \item{\code{Dwgt}:}{the derivative of the weight function, of class \code{"functionX"}, is generated automatically if \code{\link{psiFunc}} constructor is used.} \item{\code{tDefs}:}{\emph{named} numeric vector of \bold{t}uning parameter \bold{Def}ault values.} %%% FIXME : Replace these by *methods* \item{\code{Erho}:}{A function of class \code{"functionXal"} for computing \eqn{E[\rho(X)]} when \eqn{X} is standard normal \eqn{\mathcal{N}(0,1)}{N(0,1)}.} \item{\code{Epsi2}:}{A function of class \code{"functionXal"} for computing \eqn{E[\psi^2(X)]} when \eqn{X} is standard normal.} \item{\code{EDpsi}:}{A function of class \code{"functionXal"} for computing \eqn{E[\psi'(X)]} when \eqn{X} is standard normal.} \item{\code{name}:}{Name of \eqn{\psi}{psi}-function used for printing.} \item{\code{xtras}:}{Potentially further information.} } } \section{Methods}{ Currently, only \code{\link{chgDefaults}()}, \code{\link[=plot-methods]{plot}()} and \code{show()}. } \author{Martin Maechler} \seealso{ \code{\link{psiFunc}}. } \examples{ str(huberPsi, give.attr = FALSE) plot(hampelPsi)# calling the plot method (nicely showing "all" !) } \keyword{classes} \keyword{robust} robustbase/man/hbk.Rd0000644000176200001440000000253413312375575014250 0ustar liggesusers\name{hbk} \alias{hbk} \docType{data} \title{Hawkins, Bradu, Kass's Artificial Data} \description{ Artificial Data Set generated by Hawkins, Bradu, and Kass (1984). The data set consists of 75 observations in four dimensions (one response and three explanatory variables). It provides a good example of the masking effect. The first 14 observations are outliers, created in two groups: 1--10 and 11--14. Only observations 12, 13 and 14 appear as outliers when using classical methods, but can be easily unmasked using robust distances computed by, e.g., MCD - covMcd(). } \usage{data(hbk, package="robustbase")} \format{ A data frame with 75 observations on 4 variables, where the last variable is the dependent one. \describe{ \item{X1}{x[,1]} \item{X2}{x[,2]} \item{X3}{x[,3]} \item{Y}{y} } } \note{ This data set is also available in package \pkg{wle} as \code{artificial}. } \source{ Hawkins, D.M., Bradu, D., and Kass, G.V. (1984) Location of several outliers in multiple regression data using elemental sets. \emph{Technometrics} \bold{26}, 197--208. P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection}; Wiley, p.94. } \examples{ data(hbk) plot(hbk) summary(lm.hbk <- lm(Y ~ ., data = hbk)) hbk.x <- data.matrix(hbk[, 1:3]) (cHBK <- covMcd(hbk.x)) } \keyword{datasets} robustbase/man/chgDefaults-methods.Rd0000644000176200001440000000167212145665261017375 0ustar liggesusers\name{chgDefaults-methods} \title{Change Defaults (Parameters) of "Psi Function" Objects} \docType{methods} \alias{chgDefaults}% the generic \alias{chgDefaults-methods} \alias{chgDefaults,ANY-method} \alias{chgDefaults,psi_func-method} \description{ To modify an object of class \code{\linkS4class{psi_func}}, i.e. typically change the tuning parameters, the generic function \code{chgDefaults()} is called and works via the corresponding method. } \section{Methods}{ \describe{ \item{\code{object = "psi_func"}}{The method is used to change the default values for the tuning parameters, and returns an object of class \code{\linkS4class{psi_func}}, a copy of input \code{object} with the slot \code{tDefs} possibly changed;. } } } \seealso{ \code{\link{psiFunc}} } \examples{ ## Hampel's psi and rho: H.38 <- chgDefaults(hampelPsi, k = c(1.5, 3.5, 8)) H.38 plot(H.38) ## for more see ?psiFunc } \keyword{methods} robustbase/man/aircraft.Rd0000644000176200001440000000202713312375575015274 0ustar liggesusers\name{aircraft} \alias{aircraft} \docType{data} \title{Aircraft Data} \description{ Aircraft Data, deals with 23 single-engine aircraft built over the years 1947-1979, from Office of Naval Research. The dependent variable is cost (in units of \$100,000) and the explanatory variables are aspect ratio, lift-to-drag ratio, weight of plane (in pounds) and maximal thrust. } \usage{data(aircraft, package="robustbase")} \format{ A data frame with 23 observations on the following 5 variables. \describe{ \item{\code{X1}}{Aspect Ratio} \item{\code{X2}}{Lift-to-Drag Ratio} \item{\code{X3}}{Weight} \item{\code{X4}}{Thrust} \item{\code{Y}}{Cost} } } \source{ P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection}; Wiley, page 154, table 22. } \examples{ data(aircraft) summary( lm.airc <- lm(Y ~ ., data = aircraft)) summary(rlm.airc <- MASS::rlm(Y ~ ., data = aircraft)) aircraft.x <- data.matrix(aircraft[,1:4]) c_air <- covMcd(aircraft.x) c_air } \keyword{datasets} robustbase/man/education.Rd0000644000176200001440000000255413312375575015461 0ustar liggesusers\name{education} \alias{education} \docType{data} \title{Education Expenditure Data} \description{ Education Expenditure Data, from Chatterjee and Price (1977, p.108). This data set, representing the education expenditure variables in the 50 US states, providing an interesting example of heteroscedacity. } \usage{data(education, package="robustbase")} \format{ A data frame with 50 observations on the following 6 variables. \describe{ \item{\code{State}}{State} \item{\code{Region}}{Region (1=Northeastern, 2=North central, 3=Southern, 4=Western)} \item{\code{X1}}{Number of residents per thousand residing in urban areas in 1970} \item{\code{X2}}{Per capita personal income in 1973} \item{\code{X3}}{Number of residents per thousand under 18 years of age in 1974} \item{\code{Y}}{Per capita expenditure on public education in a state, projected for 1975} } } \source{ P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection}; Wiley, p.110, table 16. } \examples{ data(education) education.x <- data.matrix(education[, 3:5]) %%covMcd(education.x) %%______ FIXME ___ X1:X3 is not what you mean !! ________ summary(lm.education <- lm(Y ~ Region + X1+X2+X3, data=education)) %%summary(lts.education <- ltsReg(Y .....) ## See example(lmrob.M.S) # for how robust regression is used } \keyword{datasets} robustbase/man/adjboxStats.Rd0000644000176200001440000000637311670352342015767 0ustar liggesusers\name{adjboxStats} \alias{adjboxStats} \title{Statistics for Skewness-adjusted Boxplots} \description{ Computes the \dQuote{statistics} for producing boxplots adjusted for skewed distributions as proposed in Hubert and Vandervieren (2004), see \code{\link{adjbox}}. } \usage{ adjboxStats(x, coef = 1.5, a = -4, b = 3, do.conf = TRUE, do.out = TRUE, \dots) } \arguments{ \item{x}{a numeric vector for which adjusted boxplot statistics are computed.} \item{coef}{number determining how far \sQuote{whiskers} extend out from the box, see \code{\link{boxplot.stats}}.} \item{a, b}{scaling factors multiplied by the medcouple \code{\link{mc}()} to determine outlyer boundaries; see the references.} \item{do.conf,do.out}{logicals; if \code{FALSE}, the \code{conf} or \code{out} component respectively will be empty in the result.} \item{\dots}{further optional arguments to be passed to \code{\link{mc}()}, such as \code{doReflect}.} } \details{ Given the quartiles \eqn{Q_1}{Q1}, \eqn{Q_3}{Q3}, the interquartile range \eqn{\Delta Q := Q_3 - Q_1}{IQR := Q3-Q1}, and the medcouple \eqn{M :=}\code{mc(x)}, \eqn{c =}\code{coef}, the \dQuote{fence} is defined, for \eqn{M \ge 0} as \deqn{[Q_1 - c e^{a \cdot M}\Delta Q, Q_3 + c e^{b \cdot M}\Delta Q],% }{[Q1 - c*exp(a * M)*IQR, Q3 + c*exp(b * M)*IQR],} and for \eqn{M < 0} as \deqn{[Q_1 - c e^{-b \cdot M}\Delta Q, Q_3 + c e^{-a \cdot M}\Delta Q],% }{[Q1 - c*exp(-b * M)*IQR, Q3 + c*exp(-a * M)*IQR],} and all observations \code{x} outside the fence, the \dQuote{potential outliers}, are returned in \code{out}. Note that a typo in robustbase version up to 0.7-8, for the (rare left-skewed) case where \link{mc}(x) < 0, lead to a \dQuote{fence} not wide enough in the upper part, and hence \emph{less} outliers there. } \value{ A \code{\link{list}} with the components \item{stats}{a vector of length 5, containing the extreme of the lower whisker, the lower hinge, the median, the upper hinge and the extreme of the upper whisker.} \item{n}{the number of observations} \item{conf}{the lower and upper extremes of the \sQuote{notch} (\code{if(do.conf)}). See \code{\link{boxplot.stats}}.} \item{fence}{length 2 vector of interval boundaries which define the non-outliers, and hence the whiskers of the plot.} \item{out}{the values of any data points which lie beyond the fence, and hence beyond the extremes of the whiskers.} } \author{R Core Development Team (\code{\link{boxplot.stats}}); adapted by Tobias Verbeke and Martin Maechler.} \note{The code only slightly modifies the code of \R's \code{\link{boxplot.stats}}. } \seealso{\code{\link{adjbox}()}, also for references, the function which mainly uses this one; further \code{\link{boxplot.stats}}. } \examples{ data(condroz) adjboxStats(ccA <- condroz[,"Ca"]) adjboxStats(ccA, doReflect = TRUE)# small difference in fence ## Test reflection invariance [was not ok, up to and including robustbase_0.7-8] a1 <- adjboxStats( ccA, doReflect = TRUE) a2 <- adjboxStats(-ccA, doReflect = TRUE) nm1 <- c("stats", "conf", "fence") stopifnot(all.equal( a1[nm1], lapply(a2[nm1], function(u) rev(-u))), all.equal(a1[["out"]], -a2[["out"]])) } \keyword{robust} \keyword{univar} robustbase/man/pkg-internal.Rd0000644000176200001440000000313212441664672016073 0ustar liggesusers\name{internals} \alias{internals} \title{Internal Functions of Package 'robustbase'} % \alias{robMD} \alias{mahalanobisD} % \alias{doScale} \alias{.signflip} % \description{ These functions are for internal use \emph{or} not yet documented. } \usage{ \method{print}{glmrob}(x, digits = max(3, getOption("digits") - 3), ...) %% MM: These are not *needed*, since they are namespace-hidden %% -- OTOH, it shows what we might want to export {and then document} glmrobMqle(X, y, weights = NULL, start = NULL, offset = NULL, family, weights.on.x = "none", control = glmrobMqle.control(), intercept = TRUE, trace = FALSE) glmrobMqleDiffQuasiDevB (mu, mu0, y, ni, w.x, phi, tcc) glmrobMqleDiffQuasiDevPois(mu, mu0, y, ni, w.x, phi, tcc) %%--------From here on, are exported (and MM would want minimal doc, evt.) ------ robMD(x, intercept, wqr, ...) mahalanobisD(x, center, sd) ## Utilities currently for the deterministic MCD only: ## subject to change / be renamed ? doScale(x, center, scale) .signflip(loadings) } % glmrobMqleEpsiB (mu, Vmu, ni, H, K, tcc) % glmrobMqleEpsiPois (mu, Vmu, ni, H, K, tcc) % glmrobMqleEpsiSB (mu, Vmu, ni, H, K, tcc) % glmrobMqleEpsiSPois (mu, Vmu, ni, H, K, tcc) % glmrobMqleEpsi2B (mu, Vmu, ni, H, K, tcc) % glmrobMqleEpsi2Pois (mu, Vmu, ni, H, K, tcc) %% For modsel.* aka anova.glmrob(); later for nlrob() only; %% eliminated, 2013-07-26 {for robustbase 0.9-11}, MM : %% psi.bisquare(u, c = 4.685, deriv = 0, rho = FALSE) %% psi.hampel(u, a = 2, b = 4, c = 8, deriv = 0, rho = FALSE) %% psi.huber(u, k = 1.345, deriv = 0, rho = FALSE) \keyword{internal} robustbase/man/ambientNOxCH.Rd0000755000176200001440000001472713312375575015775 0ustar liggesusers\name{ambientNOxCH} \alias{ambientNOxCH} \docType{data} \encoding{utf8} \title{ Daily Means of NOx (mono-nitrogen oxides) in air} \description{ This dataset contains daily means (from midnight to midnight) of NOx, i.e., mono-nitrogen oxides, in [ppb] at 13 sites in central Switzerland and Aarau for the year 2004. } \usage{data(ambientNOxCH, package="robustbase")} \format{ A data frame with 366 observations on the following 14 variables. \describe{ \item{\code{date}}{date of day, of class \code{"Date"}.} \item{\code{ad}}{Site is located north of Altdorf 100 meters east of motorway A2, on an open field at the beginning of a more than 2000m deep valley (690.175, 193.55; 438; inLuft)} \item{\code{ba}}{Site is located in the centre of the little town of Baden in a residential area. Baden has 34'000 inhabitants and is situated on the swiss plateau (666.075, 257.972; 377; inLuft).} \item{\code{ef}}{Site is located 6 km south of altdorf and 800 m north of the village of Erstfeld. The motorway A2 passes 5 m west of the measuring site. Over 8 million vehicles have passed Erstfeld in 2004 where 13\% of the counts were attributed to trucks (691.43, 187.69; 457; MFM-U).} \item{\code{la}}{Site is located on a wooded hill in a rural area called Laegern, about 190 m above Baden, which is about 5 km away (669.8, 259; 690; NABEL).} \item{\code{lu}}{Site is located in the center of town of Lucerne, which has 57'000 inhabitants (666.19, 211.975; 460; inLuft).} \item{\code{re}}{Site is located 1 km west of Reiden on the Swiss plateau. The motorway A2 passes 5 m west of the measuring site (639.56, 232.11; 462; MFM-U).} \item{\code{ri}}{Site is located at Rigi Seebodenalp, 649 m above the lake of Lucerne on an alp with half a dozen small houses (677.9, 213.5; 1030; NABEL).} \item{\code{se}}{Site is located in Sedel next to town of Lucerne 35m above and 250m south of motorway A14 from Zug to Lucerne on a low hill with free 360° panorama (665.5, 213.41; 484; inLuft).} \item{\code{si}}{Site is located at the border of a small industrial area in Sisseln, 300 m east of a main road (640.725, 266.25; 305; inLuft).} \item{\code{st}}{Site is located at the south east border of Stans with 7'000 inhabitants (670.85, 201.025; 438; inLuft).} \item{\code{su}}{Site is located in the center of Suhr (8700 inhabitants), 10 m from the main road (648.49, 246.985; 403; inLuft).} \item{\code{sz}}{Site is located in Schwyz (14'200 inhabitants) near a shopping center (691.92, 208.03; 470; inLuft).} \item{\code{zg}}{Site is located in the centre of Zug with 22'000 inhabitants, 24 m from the main road (681.625, 224.625; 420; inLuft).} } } \details{ The 13 sites are part of one of the three air quality monitoring networks: inLuft (regional authorities of central Switzerland and canton Aargau) \cr NABEL (Swiss federal network) \cr MFM-U (Monitoring flankierende Massnahmen Umwelt), special Swiss federal network along transit motorways A2 and A13 from Germany to Italy through Switzerland \cr The information within the brackets means: Swiss coordinates km east, km north; m above sea level; network When the measuring sites are exposed to the same atmospheric condition and when there is no singular emission event at any site, \code{log(mean(NOx) of a specific day at each site)} is a linear function of \code{log(yearly.mean(NOx) at the corresponding site)}. The offset and the slope of the straight line reflects the atmospheric conditions at this specific day. During winter time, often an inversion prevents the emissions from being diluted vertically, so that there evolve two separate atmospheric compartements: One below the inversion boundary with polluted air and one above with relatively clean air. In our example below, Rigi Seebodenalp is above the inversion boundary between December 10th and 12th. } \source{ http://www.in-luft.ch/ \cr http://www.empa.ch/plugin/template/empa/*/6794 \cr http://www.bafu.admin.ch/umweltbeobachtung/02272/02280 } \seealso{another NOx dataset, \code{\link{NOxEmissions}}. } \examples{ data(ambientNOxCH) str (ambientNOxCH) yearly <- log(colMeans(ambientNOxCH[,-1], na.rm=TRUE)) xlim <- range(yearly) lNOx <- log(ambientNOxCH[, -1]) days <- ambientNOxCH[, "date"] ## Subset of 9 days starting at April 4: idays <- seq(which(ambientNOxCH$date=="2004-12-04"), length=9) ylim <- range(lNOx[idays,],na.rm=TRUE) op <- par(mfrow=c(3,3),mar=rep(1,4), oma = c(0,0,2,0)) for (id in idays) { daily <- unlist(lNOx[id,]) plot(NA, xlim=xlim,ylim=ylim, ann=FALSE, type = "n") abline(0:1, col="light gray") abline(lmrob(daily~yearly, na.action=na.exclude), col="red", lwd=2) text(yearly, daily, names(yearly), col="blue") mtext(days[id], side=1, line=-1.2, cex=.75, adj=.98) } mtext("Daily ~ Yearly log( NOx mean values ) at 13 Swiss locations", outer=TRUE) par(op) ## do all 366 regressions: Least Squares and Robust: LS <- lapply(1:nrow(ambientNOxCH), function(id) lm(unlist(lNOx[id,]) ~ yearly, na.action = na.exclude)) R <- lapply(1:nrow(ambientNOxCH), function(id) lmrob(unlist(lNOx[id,]) ~ yearly, na.action = na.exclude)) ## currently 4 warnings about non-convergence; ## which ones? days[notOk <- ! sapply(R, `[[`, "converged") ] ## "2004-01-10" "2004-05-12" "2004-05-16" "2004-11-16" ## first problematic case: daily <- unlist(lNOx[which(notOk)[1],]) plot(daily ~ yearly, main = paste("lmrob() non-convergent:",days[notOk[1]])) rr <- lmrob(daily ~ yearly, na.action = na.exclude, control = lmrob.control(trace=3, max.it = 100)) ##-> 53 iter. ## Look at all coefficients: R.cf <- t(sapply(R, coef)) C.cf <- t(sapply(LS, coef)) plot(C.cf, xlim=range(C.cf[,1],R.cf[,1]), ylim=range(C.cf[,2],R.cf[,2])) mD1 <- rowMeans(abs(C.cf - R.cf)) lrg <- mD1 > quantile(mD1, 0.80) arrows(C.cf[lrg,1], C.cf[lrg,2], R.cf[lrg,1], R.cf[lrg,2], length=.1, col="light gray") points(R.cf, col=2) ## All robustness weights aW <- t(sapply(R, weights, type="robustness")) colnames(aW) <- names(yearly) summary(aW) sort(colSums(aW < 0.05, na.rm = TRUE)) # how often "clear outlier": # lu st zg ba se sz su si re la ef ad ri # 0 0 0 1 1 1 2 3 4 10 14 17 48 lattice::levelplot(aW, asp=1/2, main="Robustness weights", xlab= "day", ylab= "site") } \keyword{datasets} robustbase/man/kootenay.Rd0000644000176200001440000000453413312375575015337 0ustar liggesusers\name{kootenay} \encoding{utf8} \alias{kootenay} \docType{data} \title{Waterflow Measurements of Kootenay River in Libby and Newgate} \description{ The original data set is the waterflow in January of the Kootenay river, measured at two locations, namely, Libby (Montana) and Newgate (British Columbia) for 13 consecutive years, 1931--1943. The data set is of mostly interest because it has been used as example in innumerous didactical situations about robust regression. To this end, one number (in observation 4) has been modified from the original data from originally 44.9 to 15.7 (here). } \usage{data(kootenay, package="robustbase")} \format{ A data frame with 13 observations on the following 2 variables. \describe{ \item{\code{Libby}}{a numeric vector} \item{\code{Newgate}}{a numeric vector} } } \details{ The original (unmodified) version of the data is easily obtainable as \code{kootenay0} from the examples; other modified versions of the data sets are also used in different places, see the examples below. } \source{ Original Data, p.58f of Ezekiel and Fox (1959), \emph{Methods of Correlation and Regression Analysis}. Wiley, N.Y. } \references{ Hampel, F., Ronchetti, E., Rousseeuw, P. and Stahel, W. (1986) \emph{Robust Statistics: The Approach Based on Influence Functions}; Wiley, N.Y. Rousseeuw, P. J. and Leroy, A. M. (1987) \emph{Robust Regression & Outlier Detection}, Wiley, N. Y. } \examples{ data(kootenay) plot(kootenay, main = "'kootenay' data") points(kootenay[4,], col = 2, cex =2, pch = 3) abline(lm (Newgate ~ Libby, data = kootenay), col = "pink") abline(lmrob(Newgate ~ Libby, data = kootenay), col = "blue") ## The original version of Ezekiel & Fox: kootenay0 <- kootenay kootenay0[4, "Newgate"] <- 44.9 plot(kootenay0, main = "'kootenay0': the original data") abline(lm (Newgate ~ Libby, data = kootenay0), col = "pink") abline(lmrob(Newgate ~ Libby, data = kootenay0), col = "blue") ## The version with "milder" outlier -- Hampel et al., p.310 kootenay2 <- kootenay0 kootenay2[4, "Libby"] <- 20.0 # instead of 77.6 plot(kootenay2, main = "The 'kootenay2' data", xlim = range(kootenay[,"Libby"])) points(kootenay2[4,], col = 2, cex =2, pch = 3) abline(lm (Newgate ~ Libby, data = kootenay2), col = "pink") abline(lmrob(Newgate ~ Libby, data = kootenay2), col = "blue") } \keyword{datasets} robustbase/man/psiFunc.Rd0000644000176200001440000000521213310673404015075 0ustar liggesusers\name{psiFunc} \alias{psiFunc} \alias{huberPsi} \alias{hampelPsi} \title{Constructor for Objects "Psi Function" Class} %% Rd Problem: 'psi_func' cannot be used in title! \description{ \code{psiFunc(..)} is a convenience interface to \code{new("psi_func",..)}, i.e. for constructing objects of class \code{"psi_func"}. } \usage{ psiFunc(rho, psi, wgt, Dpsi,Dwgt, Erho = NULL, Epsi2 = NULL, EDpsi = NULL, name, ...) huberPsi hampelPsi } \arguments{ \item{rho, psi, wgt, Dpsi, Dwgt}{each a \code{\link{function}} of \code{x} and tuning parameters typically. Specification of Dwgt is optional.} \item{Erho, Epsi2, EDpsi}{see \code{\linkS4class{psi_func}}, and note that these may change in the future.} \item{name}{Name of \eqn{\psi}{psi}-function used for printing.} \item{\dots}{potential further arguments for specifying tuning parameter names and defaults.} %% FIXME; give more details } % \details{ % ~~ If necessary, more details than the description above ~~ % } % \value{ % ~Describe the value returned % If it is a LIST, use % \item{comp1 }{Description of 'comp1'} % \item{comp2 }{Description of 'comp2'} % ... % } %%\references{ ~put references to the literature/web site here ~ } \author{Martin Maechler} \seealso{The description of class \code{\linkS4class{psi_func}}. } \examples{ plot(huberPsi) # => shows "all" {as an object with a smart plot() method} ## classical (Gaussian / "least-squares") psi {trivial}: F1 <- function(x, .) rep.int(1, length(x)) FF <- function(.) rep.int(1, length(.)) cPsi <- psiFunc(rho = function(x,.) x^2 / 2, psi = function(x, .) x, wgt = F1, Dpsi = F1, Erho = function(.) rep.int(1/2, length(.)), Epsi2 = FF, EDpsi = FF, name = "classic", . = Inf) show(cPsi) plot(cPsi) ## is the same as the limit of Huber's: plot(chgDefaults(huberPsi, k = Inf)) ## Hampel's psi and rho: H.38 <- chgDefaults(hampelPsi, k = c(1.5, 3.5, 8)) k. <- H.38@xtras$tuningP$k ; k.. <- as.vector(outer(c(-1,1), k.)) c.t <- adjustcolor("skyblue3", .8) .ax.k <- function(side) { abline(h=0, v=0, lty=2) axis(side, at = k.., labels=formatC(k..), pos=0, col=c.t, col.axis=c.t) } op <- par(mfrow=c(2,1), mgp = c(1.5, .6, 0), mar = .6+c(2,2,1,.5)) curve(H.38@psi(x), -10, 10, col=2, lwd=2, n=512) lines(k.., H.38@psi(k..), type = "h", lty=3, col=c.t); .ax.k(1) curve(H.38@rho(x), -10, 10, col=2, lwd=2, n=512); abline(h=0, v=0, lty=2) lines(k.., H.38@rho(k..), type = "h", lty=3, col=c.t); .ax.k(1) title(expression("Hampel's " ~~~ psi(x) ~~ "and" ~~ rho(x) ~~~ " functions")) par(op) ## Not the same, but similar, directly using the plot() method: plot(H.38) } \keyword{classes} \keyword{robust} robustbase/man/nlrob.control.Rd0000644000176200001440000000262312270244535016267 0ustar liggesusers\name{nlrob.control} \alias{nlrob.control} \title{Control Nonlinear Robust Regression Algorithms} \description{ Allow the user to specify details for the different nonlinear robust regression algorithms in \code{\link{nlrob}}. } \usage{ nlrob.control(method, psi = c("bisquare", "lqq", "welsh", "optimal", "hampel", "ggw"), init = c("S", "lts"), optimizer = "JDEoptim", optArgs = list(), ...) } \arguments{ \item{method}{\code{\link{character}} string specifying the method} \item{psi}{string specifying the psi-function which defines the estimator.} \item{init}{for some methods, currently, \code{"MM"} only, a string specifying the initial estimator. } \item{optimizer}{currently only \code{"JDEoptim"} from package \pkg{DEoptimR}.} \item{optArgs}{ a \code{\link{list}} of optional arguments to the optimizer. Currently, that is \code{\link[DEoptimR]{JDEoptim}} from package \pkg{DEoptimR}. } \item{\dots}{ %% ~~Describe \code{\dots} here~~ } } %% \details{ %% %% } \value{ a \code{\link{list}} with several named components. The contents depend quite a bit on the \code{method}. } %\author{Martin Maechler} %% \note{ %% } \seealso{ \code{\link{nlrob}}, \code{\link{nlrob}}, } \examples{ str(nlrob.control("MM")) str(nlrob.control("tau")) str(nlrob.control("CM")) str(nlrob.control("mtl")) } \keyword{utilities} robustbase/man/nlrob.Rd0000644000176200001440000003370013266661732014620 0ustar liggesusers\name{nlrob} \title{Robust Fitting of Nonlinear Regression Models} \alias{nlrob} \alias{fitted.nlrob} \alias{residuals.nlrob} \alias{predict.nlrob} \alias{vcov.nlrob} \description{ \code{nlrob} fits a nonlinear regression model by robust methods. Per default, by an M-estimator, using iterated reweighted least squares (called \dQuote{IRLS} or also \dQuote{IWLS}). } \usage{ nlrob(formula, data, start, lower, upper, weights = NULL, na.action = na.fail, method = c("M", "MM", "tau", "CM", "mtl"), psi = .Mwgt.psi1("huber", cc=1.345), scale = NULL, test.vec = c("resid", "coef", "w"), maxit = 20, tol = 1e-06, acc, algorithm = "default", doCov = FALSE, model = FALSE, control = if(method == "M") nls.control() else nlrob.control(method, optArgs = list(trace=trace), ...), trace = FALSE, ...) \method{fitted}{nlrob}(object, ...) \method{residuals}{nlrob}(object, type = , ...)% FIXME: more 'type's + DOCU \method{predict}{nlrob}(object, newdata, ...) } \arguments{ \item{formula}{a nonlinear \code{\link{formula}} including variables and parameters of the model, such as \code{y ~ f(x, theta)} (cf. \code{\link{nls}}). (For some checks: if \eqn{f(.)} is linear, then we need parentheses, e.g., \code{y ~ (a + b * x)}; (note that \code{._nlrob.w} is not allowed as variable or parameter name)) %% FIXME in code -- long overdue, as nls() is more flexible *SINCE* R 2.2.1 %% Do not use \code{w} as variable or parameter name! %% FIXME: this should really no longer be needed ==> add a check } \item{data}{an optional data frame containing the variables in the model. If not found in \code{data}, the variables are taken from \code{environment(formula)}, typically the environment from which \code{nlrob} is called.} \item{start}{a named numeric vector of starting parameters estimates, only for \code{method = "M"}.} \item{lower, upper}{numeric vectors of lower and upper bounds; if needed, will be replicated to be as long as the longest of \code{start}, \code{lower} or \code{upper}. For (the default) \code{method = "M"}, if the bounds are unspecified all parameters are assumed to be unconstrained; also, for method \code{"M"}, bounds can only be used with the \code{"port"} algorithm. They are ignored, with a warning, in cases they have no effect. For all other methods, currently these bounds \emph{must} be specified as finite values, and one of them must have \code{\link{names}} matching the parameter names in \code{formula}. For methods \code{"CM"} and \code{"mtl"}, the bounds must \emph{additionally} have an entry named \code{"sigma"} as that is determined simultaneously in the same optimization, and hence its \code{lower} bound must not be negative. } \item{weights}{an optional vector of weights to be used in the fitting process (for intrinsic weights, not the weights \code{w} used in the iterative (robust) fit). I.e., \code{sum(w * e^2)} is minimized with \code{e} = residuals, \eqn{e_i = y_i - f(xreg_i, \theta)}{e[i] = y[i] - f(xreg[i], theta)}, where \eqn{f(x,\theta)}{f(x, theta)} is the nonlinear function, and \code{w} are the robust weights from \code{resid * weights}.} \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. The default action is for the procedure to fail. If NAs are present, use \code{na.exclude} to have residuals with \code{length == nrow(data) == length(w)}, where \code{w} are the weights used in the iterative robust loop. This is better if the explanatory variables in \code{formula} are time series (and so the NA location is important). For this reason, \code{na.omit}, which leads to omission of cases with missing values on any required variable, is not suitable here since the residuals length is different from \code{nrow(data) == length(w)}. } \item{method}{a character string specifying which method to use. The default is \code{"M"}, for historical and back-compatibility reasons. For the other methods, primarily see \code{\link{nlrob.algorithms}}. % nlrob-algos.Rd \describe{ \item{"M"}{Computes an M-estimator, using \code{\link{nls}(*, weights=*)} iteratively (hence, IRLS) with weights equal to \eqn{\psi(r_i) / r_i}, where \eqn{r_i} is the i-the residual from the previous fit.} \item{"MM"}{Computes an MM-estimator, starting from \code{init}, either "S" or "lts".}% more: FIXME \item{"tau"}{Computes a Tau-estimator.} \item{"CM"}{Computes a \dQuote{Constrained M} (=: CM) estimator.} \item{"mtl"}{Compute as \dQuote{Maximum Trimmed Likelihood} (=: MTL) estimator.} } Note that all methods but \code{"M"} are \dQuote{random}, hence typically to be preceded by \code{\link{set.seed}()} in usage, see also \code{\link{nlrob.algorithms}}. % nlrob-algos.Rd } \item{psi}{a function (possibly by name) of the form \code{g(x, 'tuning constant(s)', deriv)} that for \code{deriv=0} returns \eqn{\psi(x)/x}{psi(x)/x} and for \code{deriv=1} returns \eqn{\psi'(x)}{psi'(x)}. Note that tuning constants can \emph{not} be passed separately, but directly via the specification of \code{psi}, typically via a simple \code{\link{.Mwgt.psi1}()} call as per default. Note that this has been a deliberately non-backcompatible change for robustbase version 0.90-0 (summer 2013 -- early 2014). } \item{scale}{when not \code{NULL} (default), a positive number specifying a scale kept \emph{fixed} during the iterations (and returned as \code{Scale} component).} \item{test.vec}{character string specifying the convergence criterion. The relative change is tested for residuals with a value of \code{"resid"} (the default), for coefficients with \code{"coef"}, and for weights with \code{"w"}.} \item{maxit}{maximum number of iterations in the robust loop.} \item{tol}{non-negative convergence tolerance for the robust fit.} \item{acc}{previous name for \code{tol}, now deprecated.} \item{algorithm}{character string specifying the algorithm to use for \code{\link{nls}}, see there, only when \code{method = "M"}. The default algorithm is a Gauss-Newton algorithm.} \item{doCov}{a logical specifying if \code{nlrob()} should compute the asymptotic variance-covariance matrix (see \code{\link{vcov}}) already. This used to be hard-wired to \code{TRUE}; however, the default has been set to \code{FALSE}, as \code{\link{vcov}(obj)} and \code{\link{summary}(obj)} can easily compute it when needed.} \item{model}{a \code{\link{logical}} indicating if the \code{\link{model.frame}} should be returned as well.} \item{control}{an optional list of control settings. \describe{ \item{for \code{method = "M"}:}{settings for \code{\link{nls}()}. See \code{\link{nls.control}} for the names of the settable control values and their effect.} \item{for all \code{method}s but \code{"M"}:}{a list, typically resulting from \code{\link{nlrob.control}(method, *)}.} } } \item{trace}{logical value indicating if a \dQuote{trace} of the \code{nls} iteration progress should be printed. Default is \code{FALSE}. \cr If \code{TRUE}, in each robust iteration, the residual sum-of-squares and the parameter values are printed at the conclusion of each \code{nls} iteration. When the \code{"plinear"} algorithm is used, the conditional estimates of the linear parameters are printed after the nonlinear parameters.} \item{object}{an \R object of class \code{"nlrob"}, typically resulting from \code{nlrob(..)}.} \item{\dots}{for \code{nlrob}: only when \code{method} is \emph{not} \code{"M"}, optional arguments for \code{\link{nlrob.control}}; \cr for other functions: potentially optional arguments passed to the extractor methods.} \item{type}{a string specifying the \emph{type} of residuals desired. Currently, \code{"response"} and \code{"working"} are supported. %% FIXME: 1. document these (here) 2. write and support more types } \item{newdata}{a data frame (or list) with the same names as the original \code{data}, see e.g., \code{\link{predict.nls}}.} } \details{ For \code{method = "M"}, iterated reweighted least squares (\dQuote{IRLS} or \dQuote{IWLS}) is used, calling \code{\link{nls}(*, weights= .)} where \code{weights} \eqn{w_i} are proportional to \eqn{\psi(r_i/ \hat{\sigma})}{psi(r_i/ sig.)}. All other methods minimize differently, and work \bold{without} \code{\link{nls}}. See \link{nlrob.algorithms} % -> nlrob-algos.Rd for details. } \value{ \code{nlrob()} returns an object of S3 class \code{"nlrob"}, for \code{method = "M"} also inheriting from class \code{"nls"}, (see \code{\link{nls}}). It is a list with several components; they are not documented yet, as some of them will probably change. Instead, rather use \dQuote{accessor} methods, where possible: There are methods (at least) for the generic accessor functions \code{\link{summary}()}, \code{\link{coefficients}()} (aka \code{coef()}) \code{fitted.values()}, \code{residuals()}, \code{\link{sigma}()} and \code{\link{vcov}()}, the latter for the variance-covariance matrix of the estimated parameters, as returned by \code{coef()}, i.e., not including the variance of the errors. For \code{nlrob()} results, \code{\link{estimethod}()} returns the \dQuote{estimation method}, which coincides with the \code{method} argument used. \code{residuals(.)}, by default \code{type = "response"}, returns the residuals \eqn{e_i}, defined above as \eqn{e_i = Y_i - f_(x_i, \hat\theta)}{e[i] = Y[i] - f(x[i], theta^)}. These differ from the standardized or weighted residuals which, e.g., are assumed to be normally distributed, and a version of which is returned in \code{working.residuals} component. %% and another is working.residuals/Scale } \author{ \describe{ \item{\code{method = "M"}:}{ Andreas Ruckstuhl (inspired by \code{\link[MASS]{rlm}}() and \code{\link{nls}}()), in July 1994 for S-plus.\cr Christian Sangiorgio did the update to \R and corrected some errors, from June 2002 to January 2005, and Andreas contributed slight changes and the first methods in August 2005.} \item{\code{method = "MM"}, etc:}{Originally all by Eduardo L. T. Conceicao, see \code{\link{nlrob.algorithms}}:} % nlrob-algos.Rd } Since then, the help page, testing, more cleanup, new methods: Martin Maechler. } \note{ This function (with the only method \code{"M"}) used to be named \code{rnls} and has been in package \pkg{sfsmisc} in the past, but been dropped there. } \seealso{ \code{\link{nls}}, \code{\link[MASS]{rlm}}. } \examples{ DNase1 <- DNase[ DNase$Run == 1, ] ## note that selfstarting models don't work yet % <<< FIXME !!! ##--- without conditional linearity --- ## classical fmNase1 <- nls( density ~ Asym/(1 + exp(( xmid - log(conc) )/scal ) ), data = DNase1, start = list( Asym = 3, xmid = 0, scal = 1 ), trace = TRUE ) summary( fmNase1 ) ## robust RmN1 <- nlrob( density ~ Asym/(1 + exp(( xmid - log(conc) )/scal ) ), data = DNase1, trace = TRUE, start = list( Asym = 3, xmid = 0, scal = 1 )) summary( RmN1 ) ##--- using conditional linearity --- ## classical fm2DNase1 <- nls( density ~ 1/(1 + exp(( xmid - log(conc) )/scal ) ), data = DNase1, start = c( xmid = 0, scal = 1 ), alg = "plinear", trace = TRUE ) summary( fm2DNase1 ) ## robust frm2DNase1 <- nlrob(density ~ 1/(1 + exp(( xmid - log(conc) )/scal ) ), data = DNase1, start = c( xmid = 0, scal = 1 ), alg = "plinear", trace = TRUE ) summary( frm2DNase1 ) ## Confidence for linear parameter is quite smaller than "Asym" above c1 <- coef(summary(RmN1)) c2 <- coef(summary(frm2DNase1)) rownames(c2)[rownames(c2) == ".lin"] <- "Asym" stopifnot(all.equal(c1[,1:2], c2[rownames(c1), 1:2], tol = 0.09)) # 0.07315 ### -- new examples -- "moderate outlier": DN2 <- DNase1 DN2[10,"density"] <- 2*DN2[10,"density"] fm3DN2 <- nls(density ~ Asym/(1 + exp(( xmid - log(conc) )/scal ) ), data = DN2, trace = TRUE, start = list( Asym = 3, xmid = 0, scal = 1 )) ## robust Rm3DN2 <- nlrob(density ~ Asym/(1 + exp(( xmid - log(conc) )/scal ) ), data = DN2, trace = TRUE, start = list( Asym = 3, xmid = 0, scal = 1 )) Rm3DN2 summary(Rm3DN2) # -> robustness weight of obs. 10 ~= 0.037 confint(Rm3DN2, method = "Wald") stopifnot(identical(Rm3DN2$dataClasses, c(density = "numeric", conc = "numeric"))) ## utility function sfsmisc::lseq() : lseq <- function (from, to, length) 2^seq(log2(from), log2(to), length.out = length) ## predict() {and plot}: h.x <- lseq(min(DN2$conc), max(DN2$conc), length = 100) nDat <- data.frame(conc = h.x) h.p <- predict(fm3DN2, newdata = nDat)# classical h.rp <- predict(Rm3DN2, newdata = nDat)# robust plot(density ~ conc, data=DN2, log="x", main = format(formula(Rm3DN2))) lines(h.x, h.p, col="blue") lines(h.x, h.rp, col="magenta") legend("topleft", c("classical nls()", "robust nlrob()"), lwd = 1, col= c("blue", "magenta"), inset = 0.05) ## See ?nlrob.algorithms for examples \donttest{ DNase1 <- DNase[DNase$Run == 1,] form <- density ~ Asym/(1 + exp(( xmid -log(conc) )/scal )) gMM <- nlrob(form, data = DNase1, method = "MM", lower = c(Asym = 0, xmid = 0, scal = 0), upper = 3, trace = TRUE) ## "CM" (and "mtl") additionally need bounds for "sigma" : gCM <- nlrob(form, data = DNase1, method = "CM", lower = c(Asym = 0, xmid = 0, scal = 0, sigma = 0), upper = c(3,3,3, sigma = 0.8)) summary(gCM)# did fail; note it has NA NA NA (std.err, t val, P val) stopifnot(identical(Rm3DN2$dataClasses, gMM$dataClasses), identical( gCM$dataClasses, gMM$dataClasses)) }%not (always) tested } \keyword{robust} \keyword{regression} \keyword{nonlinear} robustbase/man/wagnerGrowth.Rd0000644000176200001440000000405613312375575016163 0ustar liggesusers\name{wagnerGrowth} \encoding{utf8} \Rdversion{1.1} \alias{wagnerGrowth} \docType{data} \title{ Wagner's Hannover Employment Growth Data } \description{ Wagner (1994) investigates the rate of employment growth (\code{y}) as function of percentage of people engaged in \bold{p}roducation \bold{a}ctivities (\code{PA}) and \bold{h}igher \bold{s}ervices (\code{HS}) and of the \bold{g}rowth of these percentages (\code{GPA}, \code{GHS}) during three time periods in 21 geographical regions of the greater Hannover area. } \usage{data(wagnerGrowth, package="robustbase")} \format{ A data frame with \eqn{21 \times 3 = 63}{21 * 3 = 63} observations (one per \code{Region x Period}) on the following 7 variables. \describe{ \item{\code{Region}}{a \code{\link{factor}} with 21 levels, denoting the corresponding region in Hannover (conceptually a \dQuote{block factor}).} \item{\code{PA}}{numeric: percent of people involved in production activities.} \item{\code{GPA}}{\bold{g}rowth of \code{PA}.} \item{\code{HS}}{a numeric vector} \item{\code{GHS}}{a numeric vector} \item{\code{y}}{a numeric vector} \item{\code{Period}}{a \code{\link{factor}} with levels \code{1:3}, denoting the time period, 1 = 1979-1982, 2 = 1983-1988, 3 = 1989-1992.} } } % \details{ % } \source{ Hubert, M. and Rousseeuw, P. J. (1997). Robust regression with both continuous and binary regressors, \emph{Journal of Statistical Planning and Inference} \bold{57}, 153--163. } \references{ Wagner J. (1994). Regionale Beschäftigungsdynamik und höherwertige Produktionsdienste: Ergebnisse für den Grossraum Hannover (1979-1992). \emph{Raumforschung und Raumordnung} \bold{52}, 146--150. } \examples{ data(wagnerGrowth) ## maybe str(wagnerGrowth) require(lattice) (xyplot(y ~ Period | Region, data = wagnerGrowth, main = "wagnerGrowth: 21 regions @ Hannover")) (dotplot(y ~ reorder(Region,y,median), data = wagnerGrowth, main = "wagnerGrowth", xlab = "Region [ordered by median(y | Region) ]")) } \keyword{datasets} robustbase/man/lactic.Rd0000644000176200001440000000141313312375575014736 0ustar liggesusers\name{lactic} \alias{lactic} %% FIXME: shorter \title{Lactic Acid Concentration Measurement Data} \description{ Data on the Calibration of an Instrument that Measures Lactic Acid Concentration in Blood, from Afifi and Azen (1979) - comparing the true concentration X with the measured value Y. } \usage{data(lactic, package="robustbase")} \format{ A data frame with 20 observations on the following 2 variables. \describe{ \item{\code{X}}{True Concentration} \item{\code{Y}}{Instrument} } } \source{ P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection}; Wiley, p.62, table 10. } \examples{ data(lactic) summary(lm.lactic <- lm(Y ~., data=lactic)) %% summary(lts.lactic <- ltsReg(Y ~., data=lactic)) } \keyword{datasets} robustbase/man/plot.lmrob.Rd0000644000176200001440000000565412513246457015600 0ustar liggesusers\name{plot.lmrob} \alias{plot.lmrob} \title{Plot Method for "lmrob" Objects} \description{ Diagnostic plots for elements of class lmrob } \usage{ \method{plot}{lmrob}(x, which = 1:5, caption = c("Standardized residuals vs. Robust Distances", "Normal Q-Q vs. Residuals", "Response vs. Fitted Values", "Residuals vs. Fitted Values" , "Sqrt of abs(Residuals) vs. Fitted Values"), panel = if(add.smooth) panel.smooth else points, sub.caption = deparse(x$call), main = "", compute.MD = TRUE, ask = prod(par("mfcol")) < length(which) && dev.interactive(), id.n = 3, labels.id = names(residuals(x)), cex.id = 0.75, label.pos = c(4,2), qqline = TRUE, add.smooth = getOption("add.smooth"), \dots, p=0.025) } \arguments{ \item{x}{ an object as created by \code{lmrob} } \item{which}{ integer number between 1 and 5 to specify which plot is desired } \item{caption}{Caption for the different plots} \item{panel}{panel function. The useful alternative to \code{\link{points}}, \code{\link{panel.smooth}} can be chosen by \code{add.smooth = TRUE}.} \item{main}{main title} \item{sub.caption}{sub titles} \item{compute.MD}{logical indicating if the robust Mahalanobis distances should be recomputed, using \code{\link{covMcd}()} when needed, i.e., if \code{which} contains \code{1}.} \item{ask}{waits for user input before displaying each plot } \item{id.n}{number of points to be labelled in each plot, starting with the most extreme.} \item{labels.id}{vector of labels, from which the labels for extreme points will be chosen. \code{NULL} uses observation numbers.} \item{cex.id}{magnification of point labels.} \item{label.pos}{positioning of labels, for the left half and right half of the graph respectively.}% for plots ... \item{qqline}{logical indicating if a \code{\link{qqline}()} should be added to the normal Q-Q plot.} \item{add.smooth}{logical indicating if a smoother should be added to most plots; see also \code{panel} above.} \item{\dots}{optional arguments for \code{\link{par}}, \code{\link{title}}, etc.} \item{p}{threshold for distance-distance plot} } \references{ Robust diagnostic plots as in Rousseeuw and van Zomeren (1990), see \sQuote{References} in \code{\link{ltsPlot}}. } \details{ if \code{compute.MD = TRUE} and the robust Mahalanobis distances need to be computed, they are stored (\dQuote{cached}) with the object \code{x} when this function has been called from top-level. } \seealso{ \code{\link{lmrob}}, also for examples, \code{\link{plot.lm}}. } \examples{ data(starsCYG) ## Plot simple data and fitted lines plot(starsCYG) lmST <- lm(log.light ~ log.Te, data = starsCYG) RlmST <- lmrob(log.light ~ log.Te, data = starsCYG) RlmST abline(lmST, col = "red") abline(RlmST, col = "blue") op <- par(mfrow = c(2,2), mgp = c(1.5, 0.6, 0), mar= .1+c(3,3,3,1)) plot(RlmST, which = c(1:2, 4:5)) par(op) } \keyword{robust} \keyword{regression} robustbase/man/wgt.himedian.Rd0000644000176200001440000000144510407527363016056 0ustar liggesusers\name{wgt.himedian} \alias{wgt.himedian} \title{Weighted Hi-Median} \description{ Compute the weighted Hi-Median of \code{x}. } \usage{ wgt.himedian(x, weights = rep(1, n)) } \arguments{ \item{x}{numeric vector} \item{weights}{numeric vector of weights; of the same length as \code{x}.} } % \value{ % a number % } %\author{Martin Maechler} \note{ this is rather a by-product of the code used in \code{\link{Sn}} and \code{\link{Qn}}. We currently plan to replace it with more general weighted quantiles. } \seealso{\code{\link{median}}; %%..... also \code{\link[Hmisc]{wtd.quantile}} from package \pkg{Hmisc}. } \examples{ x <- c(1:6, 20) median(x) ## 4 stopifnot(all.equal(4, wgt.himedian(x)), all.equal(6, wgt.himedian(x, c(rep(1,6), 5)))) } \keyword{univar} \keyword{robust} robustbase/man/splitFrame.Rd0000644000176200001440000000505711726415442015610 0ustar liggesusers\name{splitFrame} \alias{splitFrame} \title{ Split Continuous and Categorical Predictors } \description{ Splits the design matrix into categorical and continuous predictors. Categorical variables are variables that are factors or ordered factors. } \usage{ splitFrame(mf, x = model.matrix(mt, mf), type = c("f","fi", "fii")) } \arguments{ \item{mf}{model frame (as returned by \code{\link{model.frame}}).} \item{x}{(optional) design matrix, defaulting to the derived \code{\link{model.matrix}}.} \item{type}{a character string specifying the split type (see details).} } \details{ Which split type is used can be controlled with the setting \code{split.type} in \code{\link{lmrob.control}}. There are three split types. The only differences between the types are how interactions between categorical and continuous variables are handled. The extra types of splitting can be used to avoid \emph{Too many singular resamples} errors. Type \code{"f"}, the default, assigns only the intercept, categorical and interactions of categorical variables to \code{x1}. Interactions of categorical and continuous variables are assigned to \code{x2}. Type \code{"fi"} assigns also interactions between categorical and continuous variables to \code{x1}. Type \code{"fii"} assigns not only interactions between categorical and continuous variables to \code{x1}, but also the (corresponding) continuous variables themselves. } \value{ A list that includes the following components: \item{x1 }{design matrix containing only categorical variables} \item{x1.idx }{logical vectors of the variables considered categorical in the original design matrix} \item{x2 }{design matrix containing the continuous variables} } \references{ Maronna, R. A., and Yohai, V. J. (2000). Robust regression with both continuous and categorical predictors. \emph{Journal of Statistical Planning and Inference} \bold{89}, 197--214. } \author{ Manuel Koller } \seealso{ \code{\link{lmrob.M.S}} } \examples{ data(education) education <- within(education, Region <- factor(Region)) ## no interactions -- same split for all types: fm1 <- lm(Y ~ Region + X1 + X2 + X3, education) splt <- splitFrame(fm1$model) str(splt) ## with interactions: fm2 <- lm(Y ~ Region:X1:X2 + X1*X2, education) s1 <- splitFrame(fm2$model, type="f" ) s2 <- splitFrame(fm2$model, type="fi" ) s3 <- splitFrame(fm2$model, type="fii") cbind(s1$x1.idx, s2$x1.idx, s3$x1.idx) rbind(p.x1 = c(ncol(s1$x1), ncol(s2$x1), ncol(s3$x1)), p.x2 = c(ncol(s1$x2), ncol(s2$x2), ncol(s3$x2))) } robustbase/man/pilot.Rd0000644000176200001440000000155113312375575014631 0ustar liggesusers\name{pilot} \alias{pilot} \docType{data} \title{Pilot-Plant Data} \description{ Pilot-Plant data from Daniel and Wood (1971). The response variable corresponds to the acid content determined by titration and the explanatory variable is the organic acid content determined by extraction and weighing. This data set was analyzed also by Yale and Forsythe (1976). } \usage{data(pilot, package="robustbase")} \format{ A data frame with 20 observations on the following 2 variables. \describe{ \item{\code{X}}{Organic acid content - extraction} \item{\code{Y}}{Acid content - titration } } } \source{ P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection}; Wiley, page 21, table 1. } \examples{ data(pilot) summary(lm.pilot <- lm(Y ~.,data=pilot)) %%summary(lts.pilot <- ltsReg(Y~.,data=pilot)) } \keyword{datasets} robustbase/man/vaso.Rd0000644000176200001440000000420213312375575014446 0ustar liggesusers\name{vaso} \alias{vaso} \docType{data} \title{Vaso Constriction Skin Data Set} \description{ Finney's data on vaso constriction in the skin of the digits. } \usage{data(vaso, package="robustbase")} \format{ A data frame with 39 observations on the following 3 variables. \describe{ \item{\code{Volume}}{Inhaled volume of air} \item{\code{Rate}}{Rate of inhalation} \item{\code{Y}}{vector of 0 or 1 values.} } } \details{The data taken from Finney (1947) were obtained in a carefully controlled study in human physiology where a reflex \dQuote{vaso constriction} may occur in the skin of the digits after taking a single deep breath. The response y is the occurence (y = 1) or non-occurence (y = 0) of vaso constriction in the skin of the digits of a subject after he or she inhaled a certain volume of air at a certain rate. The responses of three subjects are available. The first contributed 9 responses, the second contributed 8 responses, and the third contributed 22 responses. Although the data represent repeated measurements, an analysis that assumes independent observations may be applied, as claimed by Pregibon (1981). } \source{ Finney, D.J. (1947) The estimation from individual records of the relationship between dose and quantal response. \emph{Biometrika} \bold{34}, 320--334 } \references{ Atkinson, A.C. and Riani, M. (2000) \emph{Robust Diagnostic Regression Analysis}, First Edition. New York: Springer, Table A.23. Fahrmeir, L. and Tutz, G. (2001) \emph{Multivariate Statistical Modelling Based on Generalized Linear Models}, Springer, Table 4.2. Kuensch, H.R., Stefanski, A. and Carrol, R.J. (1989) Conditionally unbiased bounded influence estimation in general regression models, with applications to generalized linear models, \emph{JASA} \bold{84}, 460--466. Pregibon, D. (1981) Logistic regression diagnostics, \emph{Annals of Statistics} \bold{9}, 705--724. } \examples{ data(vaso) str(vaso) pairs(vaso) glmV <- glm(Y ~ log(Volume) + log(Rate), family=binomial, data=vaso) summary(glmV) ## --> example(glmrob) showing classical & robust GLM } \keyword{datasets} robustbase/man/lmrob..M..fit.Rd0000644000176200001440000000777013212743621015724 0ustar liggesusers\name{lmrob..M..fit} \alias{lmrob..M..fit} \title{Compute M-estimators of regression} \description{ This function performs RWLS iterations to find an M-estimator of regression. When started from an S-estimated \code{beta.initial}, this results in an MM-estimator. } \usage{ lmrob..M..fit(x, y, beta.initial, scale, control, obj, mf = obj$model, method = obj$control$method) } \arguments{ \item{x}{design matrix (\eqn{n \times p}{n x p}) typically including a column of \code{1}s for the intercept.} \item{y}{numeric response vector (of length \eqn{n}).} \item{beta.initial}{numeric vector (of length \eqn{p}) of initial estimate. Usually the result of an S-regression estimator.} \item{scale}{robust residual scale estimate. Usually an S-scale estimator.} \item{control}{list of control parameters, as returned by \code{\link{lmrob.control}}. Currently, the components \code{c("max.it", "rel.tol","trace.lev", "psi", "tuning.psi", "mts", "subsampling")} are accessed.} \item{obj}{an optional \code{lmrob}-object. If specified, this is typically used to set values for the other arguments.} \item{mf}{unused and deprecated.} \item{method}{optional; the \code{method} used for \emph{obj} computation.} } \details{ This function is used by \code{\link{lmrob.fit}} (and \code{anova(, type = "Deviance")}) and typically not to be used on its own. } \value{A list with the following elements: \item{coef}{the M-estimator (or MM-estim.) of regression} \item{control}{the \code{control} list input used} \item{scale}{ The residual scale estimate} \item{seed }{ The random number generator seed} \item{converged}{ \code{TRUE} if the RWLS iterations converged, \code{FALSE} otherwise} } \references{ Yohai, 1987 } \seealso{ \code{\link{lmrob.fit}}, \code{\link{lmrob}}; \code{\link[MASS]{rlm}} from package \pkg{MASS}. } \author{Matias Salibian-Barrera and Martin Maechler} \examples{ data(stackloss) X <- model.matrix(stack.loss ~ . , data = stackloss) y <- stack.loss ## Compute manual MM-estimate: ## 1) initial LTS: m0 <- ltsReg(X[,-1], y) ## 2) M-estimate started from LTS: m1 <- lmrob..M..fit(X, y, beta.initial = coef(m0), scale = m0$scale, method = "SM", control = lmrob.control(tuning.psi = 1.6, psi = 'bisquare')) ## no 'method' (nor 'obj'): m1. <- lmrob..M..fit(X, y, beta.initial = coef(m0), scale = m0$scale, control = m1$control) stopifnot(all.equal(m1, m1., tol = 1e-15)) # identical {call *not* stored!} cbind(m0$coef, m1$coef) ## the scale is kept fixed: stopifnot(identical(unname(m0$scale), m1$scale)) ## robustness weights: are r.s <- with(m1, residuals/scale) # scaled residuals m1.wts <- Mpsi(r.s, cc = 1.6, psi="tukey") / r.s summarizeRobWeights(m1.wts) ##--> outliers 1,3,4,13,21 which(m0$lts.wt == 0) # 1,3,4,21 but not 13 \dontshow{stopifnot(which(m0$lts.wt == 0) == c(1,3,4,21)) } ## Manually add M-step to SMD-estimate (=> equivalent to "SMDM"): m2 <- lmrob(stack.loss ~ ., data = stackloss, method = 'SMD') m3 <- lmrob..M..fit(obj = m2) ## Simple function that allows custom initial estimates ## (Deprecated; use init argument to lmrob() instead.) %% MM: why deprecated? lmrob.custom <- function(x, y, beta.initial, scale, terms) { ## initialize object obj <- list(control = lmrob.control("KS2011"), terms = terms) ## terms is needed for summary() ## M-step obj <- lmrob..M..fit(x, y, beta.initial, scale, obj = obj) ## D-step obj <- lmrob..D..fit(obj, x) ## Add some missing elements obj$cov <- TRUE ## enables calculation of cov matrix obj$p <- obj$qr$rank obj$degree.freedom <- length(y) - obj$p ## M-step obj <- lmrob..M..fit(x, y, obj=obj) obj$control$method <- ".MDM" obj } m4 <- lmrob.custom(X, y, m2$init$init.S$coef, m2$init$scale, m2$terms) stopifnot(all.equal(m4$coef, m3$coef)) ## Start from ltsReg: m5 <- ltsReg(stack.loss ~ ., data = stackloss) m6 <- lmrob.custom(m5$X, m5$Y, coef(m5), m5$scale, m5$terms) } \keyword{robust} \keyword{regression} robustbase/man/biomassTill.Rd0000644000176200001440000000644213312375575015770 0ustar liggesusers\name{biomassTill} \alias{biomassTill} \docType{data} \title{Biomass Tillage Data} \description{ An agricultural experiment in which different tillage methods were implemented. The effects of tillage on plant (maize) biomass were subsequently determined by modeling biomass accumulation for each tillage treatment using a 3 parameter Weibull function. A datset where the total biomass is modeled conditional on a three value factor, and hence \emph{vector} parameters are used. } \usage{data("biomassTill", package="robustbase")} \format{ A data frame with 58 observations on the following 3 variables. \describe{ \item{\code{Tillage}}{Tillage treatments, a \code{\link{factor}} with levels \describe{ \item{\code{CA-}:}{a no-tillage system with plant residues removed} \item{\code{CA+}:}{a no-tillage system with plant residues retained} \item{\code{CT}:}{a conventionally tilled system with residues incorporated} } } \item{\code{DVS}}{the development stage of the maize crop. A DVS of \code{1} represents maize anthesis (flowering), and a DVS of \code{2} represents physiological maturity. For the data, numeric vector with 5 different values between 0.5 and 2.} \item{\code{Biomass}}{accumulated biomass of maize plants from each tillage treatment.} \item{\code{Biom.2}}{the same as \code{Biomass}, but with three values replaced by \dQuote{gross errors}.} } } \source{ From Strahinja Stepanovic and John Laborde, Department of Agronomy & Horticulture, University of Nebraska-Lincoln, USA } %% \references{ %% %% ~~ possibly secondary sources and usages ~~ %% } \examples{ data(biomassTill) str(biomassTill) require(lattice) ## With long tailed errors xyplot(Biomass ~ DVS | Tillage, data = biomassTill, type=c("p","smooth")) ## With additional 2 outliers: xyplot(Biom.2 ~ DVS | Tillage, data = biomassTill, type=c("p","smooth")) ### Fit nonlinear Regression models: ----------------------------------- ## simple starting values, needed: m00st <- list(Wm = rep(300, 3), a = rep( 1.5, 3), b = rep( 2.2, 3)) robm <- nlrob(Biomass ~ Wm[Tillage] * (-expm1(-(DVS/a[Tillage])^b[Tillage])), data = biomassTill, start = m00st, maxit = 200) ## ----------- summary(robm) ## ... 103 IRWLS iterations plot(sort(robm$rweights), log = "y", main = "ordered robustness weights (log scale)") mtext(getCall(robm)) ## the classical (only works for the mild outliers): cl.m <- nls(Biomass ~ Wm[Tillage] * (-expm1(-(DVS/a[Tillage])^b[Tillage])), data = biomassTill, start = m00st) ## now for the extra-outlier data: -- fails with singular gradient !! try( rob2 <- nlrob(Biom.2 ~ Wm[Tillage] * (-expm1(-(DVS/a[Tillage])^b[Tillage])), data = biomassTill, start = m00st) ) ## use better starting values: m1st <- setNames(as.list(as.data.frame(matrix( coef(robm), 3))), c("Wm", "a","b")) try(# just breaks a bit later! rob2 <- nlrob(Biom.2 ~ Wm[Tillage] * (-expm1(-(DVS/a[Tillage])^b[Tillage])), data = biomassTill, start = m1st, maxit= 200, trace=TRUE) ) ## Comparison {more to come} % once we have "MM" working... rbind(start = unlist(m00st), class = coef(cl.m), rob = coef(robm)) } \keyword{datasets} robustbase/man/airmay.Rd0000644000176200001440000000245113312375575014764 0ustar liggesusers\name{airmay} \alias{airmay} \docType{data} \title{Air Quality Data} \description{ Air Quality Data Set for May 1973, from Chambers et al. (1983). The whole data set consists of daily readings of air quality values from May 1, 1973 to September 30, 1973, but here are included only the values for May. This data set is an example of the special treatment of the missing values. } \usage{data(airmay, package="robustbase")} \format{ A data frame with 31 observations on the following 4 variables. \describe{ \item{\code{X1}}{Solar Radiation in Longleys in the frequency band 4000-7700 from 0800 to 1200 hours at Central Park} \item{\code{X2}}{Average windspeed (in miles per hour) between 7000 and 1000 hours at La Guardia Airport} \item{\code{X3}}{Maximum daily temperature (in degrees Fahrenheit) at La Guardia Airport} \item{\code{Y}}{Mean ozone concentration (in parts per billion) from 1300 to 1500 hours at Roosevelt Island} } } \source{ P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection}; Wiley, p.86, table 6. } \examples{ data(airmay) summary(lm.airmay <- lm(Y ~ ., data=airmay)) %%summary(lts.airmay <- ltsReg(Y ~ ., data=airmay)) airmay.x <- data.matrix(airmay[,1:3]) %%covMcd(airmay.x) } \keyword{datasets} robustbase/man/los.Rd0000644000176200001440000000302513312375575014275 0ustar liggesusers\name{los} \alias{los} \docType{data} \title{ Length of Stay Data } \description{ Length of stay for 201 patients that stayed at the University Hospital of Lausanne during the year 2000. } \usage{data(los, package="robustbase")} \format{ Vector of integer values giving the length of stay (days): int [1:201] 16 13 17 4 15 24 59 18 33 8 ... } \details{ These data may be used to estimate and predict the total resource consumption of this group of patients. Cf. Ruffieux, Paccaud and Marazzi (2000). } \source{ The data were kindly provided by A. Marazzi. Cf. Hubert, M. and Vandervieren, E. (2006), p. 13--15. } \references{ Ruffieux, C., Paccaud, F. and A. Marazzi (2000) Comparing rules for truncating hospital length of stay; \emph{Casemix Quarterly} \bold{2}, n. 1. See also those for \code{\link{adjbox}}. } \examples{ summary(los) # quite skewed, with median(.) = 8 plot(table(los)) boxplot(los, horizontal=TRUE, add=TRUE, col = "red", axes=FALSE) ##-> "outliers" instead of "just skewed" hist(log(los)) boxplot(log(los), add=TRUE, col=2, border=2, horizontal = TRUE, at = -1) ## Hubert and Vandervieren (2006), p. 15, Fig. 11. adjbox(los, col = "gray", staplecol="red", outcol = "red", main = "(Skewness-)Adjusted and original boxplot for 'los' data") boxplot(los, add = TRUE, staplewex= 0.2, outcex= 0.5, outpch= 4, staplecol = "blue", outcol = "blue", staplelwd=2) legend("topright", c("adjbox(los)", "boxplot(los)"), col=c("red","blue"), lwd = 1:2, bty="n") } \keyword{datasets} robustbase/man/functionXal-class.Rd0000644000176200001440000000212612114153713017061 0ustar liggesusers\name{functionXal-class} \docType{class} \alias{functionXal-class} \title{Class "functionXal" of Functionals (of Psi-like functions)} \description{ The class \code{"functionXal"} is a class of functionals (typically integrals) typically of \code{\linkS4class{functionX}} functions. Since the \code{functionX} functions typically also depend on tuning parameters, objects of this class (\code{"functionXal"}) are functions of these tuning parameters. } \section{Slots}{ \describe{ \item{\code{.Data}:}{Directly extends class \code{"function"}.} } } \section{Extends}{ Class \code{"function"}, from data part. Class \code{"OptionalFunction"}, by class \code{"function"}. Class \code{"PossibleMethod"}, by class \code{"function"}. } % \section{Methods}{ % No methods defined with class "functionXal" in the signature. % } \seealso{ \code{\link{psiFunc}()} and the class definitions of \code{\linkS4class{functionX}} and \code{\linkS4class{psi_func}} which has several \code{functionXal} slots. } % \examples{ % ##---- Should be DIRECTLY executable !! ---- % } \keyword{classes} robustbase/man/rrcov.control.Rd0000644000176200001440000000767212440116711016310 0ustar liggesusers\name{rrcov.control} \alias{rrcov.control} \title{Control Settings for covMcd and ltsReg} \description{ Auxiliary function for passing the estimation options as parameters to the estimation functions. } \usage{ rrcov.control(alpha = 1/2, method = c("covMcd", "covComed", "ltsReg"), nsamp = 500, nmini = 300, kmini = 5, seed = NULL, tolSolve = 1e-14, scalefn = "hrv2012", maxcsteps = 200, trace = FALSE, wgtFUN = "01.original", beta, use.correction = identical(wgtFUN, "01.original"), adjust = FALSE) } \arguments{ \item{alpha}{This parameter controls the size of the subsets over which the determinant is minimized, i.e., \code{alpha*n} observations are used for computing the determinant. Allowed values are between 0.5 and 1 and the default is 0.5. } \item{method}{a string specifying the \dQuote{main} function for which \code{rrcov.control()} is used. This currently only makes a difference to determine the default for \code{beta}.} \item{nsamp}{number of subsets used for initial estimates or \code{"best"} or \code{"exact"}. Default is \code{nsamp = 500}. If \code{nsamp="best"} exhaustive enumeration is done, as far as the number of trials do not exceed 5000. If \code{nsamp="exact"} exhaustive enumeration will be attempted however many samples are needed. In this case a warning message will be displayed saying that the computation can take a very long time. } \item{nmini, kmini}{for \code{\link{covMcd}}: For large \eqn{n}, the algorithm splits the data into maximally \eqn{kmini} subsets of targetted size \code{nmini}. See \code{\link{covMcd}} for more details.}%--- ./covMcd.Rd \item{seed}{initial seed for R's random number generator; see \code{\link{.Random.seed}} and the description of the \code{seed} argument in \code{\link{lmrob.control}}.} \item{tolSolve}{numeric tolerance to be used for inversion (\code{\link{solve}}) of the covariance matrix in \code{\link{mahalanobis}}.} \item{scalefn}{(for deterministic \code{\link{covMcd}()}:) a character string or \code{\link{function}} for computing a robust scale estimate. The current default \code{"hrv2012"} uses the recommendation of Hubert et al (2012); see \code{\link{covMcd}} for more.} \item{maxcsteps}{integer specifying the maximal number of concentration steps for the deterministic MCD.} \item{trace}{logical or integer indicating whether to print intermediate results. Default is \code{trace = FALSE}.} \item{wgtFUN}{a character string or \code{\link{function}}, specifying how the weights for the reweighting step should be computed, see \code{\link{ltsReg}}, \code{\link{covMcd}} or \code{\link{covComed}}, respectively. The default is specified by \code{"01.original"}, as the resulting weights are 0 or 1. Alternative string specifications need to match \code{names(.wgtFUN.covComed)} - which currently is experimental.} \item{beta}{a quantile, experimentally used for some of the prespecified \code{wgtFUN}s, see e.g., \code{\link{.wgtFUN.covMcd}} and \code{\link{.wgtFUN.covComed}}.} \item{use.correction}{whether to use finite sample correction factors. Defaults to \code{TRUE}.} \item{adjust}{(for \code{\link{ltsReg}()}:) whether to perform intercept adjustment at each step. Because this can be quite time consuming, the default is \code{adjust = FALSE}.} } \seealso{ For details, see the documentation about \code{\link{ltsReg}} and \code{\link{covMcd}}, respectively. } \value{ A list with components, as the parameters passed by the invocation } \author{Valentin Todorov} \examples{ data(Animals, package = "MASS") brain <- Animals[c(1:24, 26:25, 27:28),] data(hbk) hbk.x <- data.matrix(hbk[, 1:3]) ctrl <- rrcov.control(alpha=0.75, trace=TRUE) covMcd(hbk.x, control = ctrl) covMcd(log(brain), control = ctrl) } \keyword{robust} \keyword{multivariate} robustbase/man/telef.Rd0000644000176200001440000000135513312375575014603 0ustar liggesusers\name{telef} \alias{telef} \docType{data} \title{Number of International Calls from Belgium} \description{ Number of international calls from Belgium, taken from the Belgian Statistical Survey, published by the Ministry of Economy. } \usage{data(telef, package="robustbase")} \format{ A data frame with 24 observations on the following 2 variables. \describe{ \item{\code{Calls}}{Number of Calls (in tens of millions) } \item{\code{Year}}{Year (1950 - 1973)} } } \source{ P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection}; Wiley, page 26, table 2. } \examples{ data(telef) summary(lm.telef <- lm(Year~., data=telef)) %%summary(lts.telef <- ltsReg(Year~., data=telef)) } \keyword{datasets} robustbase/man/r6pack.Rd0000644000176200001440000000476612441664672014704 0ustar liggesusers\name{r6pack} \alias{r6pack} \title{Robust Distance based observation orderings based on robust "Six pack"} \description{ Compute six initial robust estimators of multivariate location and \dQuote{scatter} (scale); then, for each, compute the distances \eqn{d_{ij}}{d_ij} and take the \code{h} (\eqn{h > n/2}) observations with smallest distances. Then compute the statistical distances based on these h observations. Return the indices of the observations sorted in increasing order. } \usage{ r6pack(x, h, full.h, scaled = TRUE, scalefn = rrcov.control()$scalefn) } \arguments{ \item{x}{n x p data matrix} \item{h}{integer, typically around (and slightly larger than) \eqn{n/2}.} \item{full.h}{logical specifying if the full (length n) observation ordering should be returned; otherwise only the first \code{h} are. For \code{.detmcd()}, \code{full.h=FALSE} is typical.} \item{scaled}{logical indicating if the data \code{x} is already scaled; if false, we apply \code{x <- doScale(x, median, scalefn)}.} \item{scalefn}{a \code{\link{function}(u)} to compute a robust univariate scale of u.} }% args \details{%% --> ../R/detmcd.R The six initial estimators are \enumerate{ \item{Hyperbolic tangent of standardized data} \item{Spearmann correlation matrix} \item{Tukey normal scores} \item{Spatial sign covariance matrix} \item{BACON} \item{Raw OGK estimate for scatter} } } \references{ Hubert, M., Rousseeuw, P. J. and Verdonck, T. (2012) A deterministic algorithm for robust location and scatter. Journal of Computational and Graphical Statistics \bold{21}, 618--637. } \value{ a \eqn{h' \times 6}{h' x 6} \code{\link{matrix}} of observation indices, i.e., with values from \eqn{1,\dots,n}{1..n}. If \code{full.h} is true, \eqn{h' = n}, otherwise \eqn{h' = h}. } \author{Valentin Todorov, based on the original Matlab code by Tim Verdonck and Mia Hubert. Martin Maechler for tweaks (performance etc), and \code{full.h}. } \seealso{ \code{\link{covMcd}(*, nsamp = "deterministic")}; \code{\link[rrcov]{CovSest}(*, nsamp = "sdet")} from package \pkg{rrcov}. } \examples{ data(pulpfiber) dim(m.pulp <- data.matrix(pulpfiber)) # 62 x 8 dim(fr6 <- r6pack(m.pulp, h = 40, full.h= FALSE)) # h x 6 = 40 x 6 dim(fr6F <- r6pack(m.pulp, h = 40, full.h= TRUE )) # n x 6 = 62 x 6 stopifnot(identical(fr6, fr6F[1:40,])) \dontshow{ stopifnot(apply(fr6[1:10,], 2L, function(col) c(1,3,6,35,36,38) \%in\% col)) } } \keyword{robust} \keyword{multivariate} robustbase/man/residuals.glmrob.Rd0000644000176200001440000000523611651611170016746 0ustar liggesusers% Origin: src/library/stats/man/glm.summaries.Rd (as of 2011-10-23) \name{residuals.glmrob} \alias{residuals.glmrob} \title{Residuals of Robust Generalized Linear Model Fits} \usage{ \method{residuals}{glmrob}(object, type = c("deviance", "pearson", "working", "response", "partial"), \dots) } \arguments{ \item{object}{an object of class \code{glmrob}, typically the result of a call to \code{\link{glmrob}}.} \item{type}{the type of residuals which should be returned. The alternatives are: \code{"deviance"} (default), \code{"pearson"}, \code{"working"}, \code{"response"}, and \code{"partial"}.} \item{\dots}{further arguments passed to or from other methods.} } \description{ Compute residuals of a fitted \code{\link{glmrob}} model, i.e., robust generalized linear model fit. } \details{ The references in \code{\link{glm}} define the types of residuals: Davison & Snell is a good reference for the usages of each. The partial residuals are a matrix of working residuals, with each column formed by omitting a term from the model. The \code{residuals} (S3) method (see \code{\link{methods}}) for \code{\link{glmrob}} models has been modeled to follow closely the method for classical (non-robust) \code{\link{glm}} fitted models. Possibly, see its documentation, i.e., \link{residuals.glm}, for further details. } \seealso{ \code{\link{glmrob}} for computing \code{object}, \code{\link{anova.glmrob}}; the corresponding \emph{generic} functions, \code{\link{summary.glmrob}}, \code{\link{coef}}, % \code{\link{deviance}}, \code{\link{effects}}, \code{\link{fitted}}, \code{\link{residuals}}. } \references{ See those for the classical GLM's, \code{\link{glm}}. } \examples{ ### -------- Gamma family -- data from example(glm) --- clotting <- data.frame( u = c(5,10,15,20,30,40,60,80,100), lot1 = c(118,58,42,35,27,25,21,19,18), lot2 = c(69,35,26,21,18,16,13,12,12)) summary(cl <- glm (lot1 ~ log(u), data=clotting, family=Gamma)) summary(ro <- glmrob(lot1 ~ log(u), data=clotting, family=Gamma)) clotM5.high <- within(clotting, { lot1[5] <- 60 }) cl5.high <- glm (lot1 ~ log(u), data=clotM5.high, family=Gamma) ro5.high <- glmrob(lot1 ~ log(u), data=clotM5.high, family=Gamma) rr <- range(residuals(ro), residuals(cl), residuals(ro5.high)) plot(residuals(ro5.high) ~ residuals(cl5.high), xlim = rr, ylim = rr, asp = 1) abline(0,1, col=2, lty=3) points(residuals(ro) ~ residuals(cl), col = "gray", pch=3) ## Show all kinds of residuals: r.types <- c("deviance", "pearson", "working", "response") sapply(r.types, residuals, object = ro5.high) } \keyword{models} \keyword{regression} robustbase/man/nlrob-algos.Rd0000644000176200001440000001571413441022761015714 0ustar liggesusers\name{nlrob-algorithms} \alias{nlrob.algorithms} \alias{nlrob.MM} \alias{nlrob.tau} \alias{nlrob.CM} \alias{nlrob.mtl} \title{MM-, Tau-, CM-, and MTL- Estimators for Nonlinear Robust Regression} \description{ \describe{ \item{"MM":}{Compute an MM-estimator for nonlinear robust (constrained) regression.} \item{"tau":}{Compute a Tau-estimator for nonlinear robust (constrained) regression.} \item{"CM":}{Compute a \dQuote{Constrained M} (=: CM) estimator for nonlinear robust (constrained) regression.} \item{"MTL":}{Compute a \dQuote{Maximum Trimmed Likelihood} (=: MTL) estimator for nonlinear robust (constrained) regression.} } } \usage{ ## You can *not* call the nlrob(*, method = ) like this ==> see help(nlrob) ## ------- ===== ------------------------------------------ nlrob.MM(formula, data, lower, upper, tol = 1e-06, psi = c("bisquare", "lqq", "optimal", "hampel"), init = c("S", "lts"), ctrl = nlrob.control("MM", psi = psi, init = init, fnscale = NULL, tuning.chi.scale = .psi.conv.cc(psi, .Mchi.tuning.defaults[[psi]]), tuning.psi.M = .psi.conv.cc(psi, .Mpsi.tuning.defaults[[psi]]), optim.control = list(), optArgs = list(...)), ...) nlrob.tau(formula, data, lower, upper, tol = 1e-06, psi = c("bisquare", "optimal"), ctrl = nlrob.control("tau", psi = psi, fnscale = NULL, tuning.chi.scale = NULL, tuning.chi.tau = NULL, optArgs = list(...)), ...) nlrob.CM(formula, data, lower, upper, tol = 1e-06, psi = c("bisquare", "lqq", "welsh", "optimal", "hampel", "ggw"), ctrl = nlrob.control("CM", psi = psi, fnscale = NULL, tuning.chi = NULL, optArgs = list(...)), ...) nlrob.mtl(formula, data, lower, upper, tol = 1e-06, ctrl = nlrob.control("mtl", cutoff = 2.5, optArgs = list(...)), ...) } \arguments{ \item{formula}{nonlinear regression \code{\link{formula}}, using both variable names from \code{data} and parameter names from either \code{lower} or \code{upper}.} \item{data}{data to be used, a \code{\link{data.frame}}} \item{lower, upper}{bounds aka \dQuote{box constraints} for all the parameters, in the case "CM" and "mtl" these must include the error standard deviation as \code{"sigma"}, see \code{\link{nlrob}()} about its \code{\link{names}}, etc. Note that one of these two must be a properly \dQuote{named}, e.g., \code{names(lower)} being a \code{\link{character}} vector of parameter names (used in \code{formula} above). } \item{tol}{numerical convergence tolerance.} \item{psi, init}{see \code{\link{nlrob.control}}.} \item{ctrl}{a \code{\link{list}}, typically the result of a call to \code{\link{nlrob.control}}.} \item{tuning.psi.M}{..}% FIXME \item{optim.control}{..}% FIXME \item{optArgs}{a \code{\link{list}} of optional arguments for optimization, e.g., \code{trace = TRUE}, passed to to the optimizer, which currently must be \code{\link[DEoptimR]{JDEoptim}(.)}.} \item{...}{alternative way to pass the \code{optArgs} above.} } \value{ an \R object of \code{\link{class}} \code{"nlrob."}, basically a list with components %% FIXME } \details{ Copyright 2013, Eduardo L. T. Conceicao. Available under the GPL (>= 2) Currently, all four methods use \code{\link[DEoptimR]{JDEoptim}()} from \CRANpkg{DEoptimR}, which subsamples using \code{\link{sample}()}. From \R version 3.6.0, \code{\link{sample}} depends on \code{\link{RNGkind}(*, sample.kind)}, such that exact reproducibility of results from \R versions 3.5.3 and earlier requires setting \code{\link{RNGversion}("3.5.0")}. In any case, do use \code{\link{set.seed}()} additionally for reproducibility! } \author{ Eduardo L. T. Conceicao; compatibility (to \code{\link{nlrob}}) tweaks and generalizations, inference, by Martin Maechler. } \source{ For \code{"MTL"}: Maronna, Ricardo A., Martin, R. Douglas, and Yohai, Victor J. (2006). \emph{Robust Statistics: Theory and Methods} Wiley, Chichester, p. 133. } \references{ \describe{ \item{"MM":}{ Yohai, V.J. (1987) High breakdown-point and high efficiency robust estimates for regression. \emph{The Annals of Statistics} \bold{15}, 642--656. } \item{"tau":}{ Yohai, V.J., and Zamar, R.H. (1988). High breakdown-point estimates of regression by means of the minimization of an efficient scale. \emph{Journal of the American Statistical Association} \bold{83}, 406--413. } \item{"CM":}{ Mendes, B.V.M., and Tyler, D.E. (1996) Constrained M-estimation for regression. In: \emph{Robust Statistics, Data Analysis and Computer Intensive Methods}, Lecture Notes in Statistics 109, Springer, New York, 299--320. %% not yet -- e.g. tuning constants for Welsh: %% Edlund, O. and Ekblom, H. (2005) %% Computing the constrained M-estimates for regression. %% Computational Statistics Data Analysis \bold{49}(1): 19--32. } \item{"MTL":}{ Hadi, Ali S., and Luceno, Alberto (1997). Maximum trimmed likelihood estimators: a unified approach, examples, and algorithms. Computational Statistics & Data Analysis \bold{25}, 251--272. Gervini, Daniel, and Yohai, Victor J. (2002). A class of robust and fully efficient regression estimators. The Annals of Statistics \bold{30}, 583--616. } }%describe } \examples{%% for more, --> ../tests/nlregrob-tst.R DNase1 <- DNase[DNase$Run == 1,] form <- density ~ Asym/(1 + exp(( xmid -log(conc) )/scal )) pnms <- c("Asym", "xmid", "scal") set.seed(47) # as these by default use randomized optimization: fMM <- robustbase:::nlrob.MM(form, data = DNase1, lower = setNames(c(0,0,0), pnms), upper = 3, ## call to nlrob.control to pass 'optim.control': ctrl = nlrob.control("MM", optim.control = list(trace = 1), optArgs = list(trace = TRUE))) ## The same via nlrob() {recommended; same random seed to necessarily give the same}: set.seed(47) gMM <- nlrob(form, data = DNase1, method = "MM", lower = setNames(c(0,0,0), pnms), upper = 3, trace = TRUE) gMM summary(gMM) ## and they are the same {apart from 'call' and 'ctrl' and new stuff in gMM}: ni <- names(fMM); ni <- ni[is.na(match(ni, c("call","ctrl")))] stopifnot(all.equal(fMM[ni], gMM[ni])) \dontshow{ if(doExtras <- robustbase:::doExtras()) { gtau <- nlrob(form, data = DNase1, method = "tau", lower = setNames(c(0,0,0), pnms), upper = 3, trace = TRUE) ## these two have "sigma" also as parameter : psNms <- c(pnms, "sigma") gCM <- nlrob(form, data = DNase1, method = "CM", lower = setNames(c(0,0,0,0), psNms), upper = 3, trace = TRUE) gmtl <- nlrob(form, data = DNase1, method = "mtl", lower = setNames(c(0,0,0,0), psNms), upper = 3, trace = TRUE) stopifnot(identical(sapply(list(gMM, gCM, gmtl), estimethod), c("MM", "CM", "mtl"))) }% doExtras }% dontshow } \keyword{robust} \keyword{regression} \keyword{nonlinear} robustbase/man/NOxEmissions.Rd0000644000176200001440000000371313312375575016102 0ustar liggesusers\name{NOxEmissions} \alias{NOxEmissions} \docType{data} \encoding{utf8} \title{NOx Air Pollution Data} \description{ A typical medium sized environmental data set with hourly measurements of \eqn{NOx} pollution content in the ambient air. } \usage{data(NOxEmissions, package="robustbase")} \format{ A data frame with 8088 observations on the following 4 variables. \describe{ \item{\code{julday}}{day number, a factor with levels \code{373} \dots \code{730}, typically with 24 hourly measurements.} \item{\code{LNOx}}{\eqn{\log} of hourly mean of NOx concentration in ambient air [ppb] next to a highly frequented motorway.} \item{\code{LNOxEm}}{\eqn{\log} of hourly sum of NOx emission of cars on this motorway in arbitrary units.} \item{\code{sqrtWS}}{Square root of wind speed [m/s].} } } \details{ The original data set had more observations, but with missing values. Here, all cases with missing values were omitted (\code{\link{na.omit}(.)}), and then only those were retained that belonged to days with at least 20 (fully) observed hourly measurements. } \source{ René Locher (at ZHAW, Switzerland). %% E-mail to R-SIG-robust mailing list, on 2006-04-20. } \seealso{another NOx dataset, \code{\link{ambientNOxCH}}. } % \references{ % ~~ possibly secondary sources and usages ~~ % } \examples{ data(NOxEmissions) plot(LNOx ~ LNOxEm, data = NOxEmissions, cex = 0.25, col = "gray30") \dontrun{## these take too much time -- ## p = 340 ==> already Least Squares is not fast (lmNOx <- lm(LNOx ~ . ,data = NOxEmissions)) plot(lmNOx) #-> indication of 1 outlier M.NOx <- MASS::rlm(LNOx ~ . , data = NOxEmissions) ## M-estimation works ## whereas MM-estimation fails: try(MM.NOx <- MASS::rlm(LNOx ~ . , data = NOxEmissions, method = "MM")) ## namely because S-estimation fails: try(lts.NOx <- ltsReg(LNOx ~ . , data = NOxEmissions)) try(lmR.NOx <- lmrob (LNOx ~ . , data = NOxEmissions)) }% don't run } \keyword{datasets} robustbase/man/tolEllipsePlot.Rd0000644000176200001440000000425010507553555016453 0ustar liggesusers\name{tolEllipsePlot} \alias{tolEllipsePlot} \title{Tolerance Ellipse Plot} \description{ Plots the 0.975 tolerance ellipse of the bivariate data set \code{x}. The ellipse is defined by those data points whose distance is equal to the squareroot of the 0.975 chisquare quantile with 2 degrees of freedom. } \usage{ tolEllipsePlot(x, m.cov = covMcd(x), cutoff = NULL, id.n = NULL, classic = FALSE, tol = 1e-07, xlab = "", ylab = "", main = "Tolerance ellipse (97.5\%)", txt.leg = c("robust", "classical"), col.leg = c("red", "blue"), lty.leg = c("solid","dashed")) } \arguments{ \item{x}{a two dimensional matrix or data frame. } \item{m.cov}{an object similar to those of class \code{"mcd"}; however only its components \code{center} and \code{cov} will be used. If missing, the MCD will be computed (via \code{\link{covMcd}()}).} \item{cutoff}{numeric distance needed to flag data points outside the ellipse.} \item{id.n}{number of observations to be identified by a label. If not supplied, the number of observations with distance larger than \code{cutoff} is used.} \item{classic}{whether to plot the classical distances as well, \code{FALSE} by default.} \item{tol}{tolerance to be used for computing the inverse, see \code{\link{solve}}. Defaults to \code{1e-7}.} \item{xlab, ylab, main}{passed to \code{\link{plot.default}}.} \item{txt.leg, col.leg, lty.leg}{character vectors of length 2 for the legend, only used if \code{classic = TRUE}.} } \author{Peter Filzmoser, Valentin Todorov and Martin Maechler} %\details{} %\value{} %\references{ } \seealso{ \code{\link{covPlot}} which calls \code{tolEllipsePlot()} when desired. \code{\link[cluster]{ellipsoidhull}} and \code{\link[cluster]{predict.ellipsoid}} from package \pkg{cluster}. } \examples{ data(hbk) hbk.x <- data.matrix(hbk[, 1:3]) mcd <- covMcd(hbk.x) # compute mcd in advance ## must be a 2-dimensional data set: take the first two columns : tolEllipsePlot(hbk.x[,1:2]) ## an "impressive" example: data(telef) tolEllipsePlot(telef, classic=TRUE) } \keyword{hplot} \keyword{robust} robustbase/man/covPlot.Rd0000644000176200001440000001265413434014060015116 0ustar liggesusers\name{plot.mcd} \alias{covPlot} \alias{plot.mcd} %NO \alias{ddplot} %NO \alias{distplot} %NO \alias{chi2qqplot} %NO \alias{ellipse} \title{Robust Distance Plots} \description{ Shows the Mahalanobis distances based on robust and classical estimates of the location and the covariance matrix in different plots. The following plots are available: \itemize{ \item index plot of the robust and mahalanobis distances \item distance-distance plot \item Chisquare QQ-plot of the robust and mahalanobis distances \item plot of the tolerance ellipses (robust and classic) \item Scree plot - Eigenvalues comparison plot } } \usage{ \method{plot}{mcd}(x, which = c("all", "dd", "distance", "qqchi2", "tolEllipsePlot", "screeplot"), classic = FALSE, ask = (which[1] == "all" && dev.interactive()), cutoff, id.n, labels.id = rownames(x$X), cex.id = 0.75, label.pos = c(4,2), tol = 1e-7, \dots) covPlot(x, which = c("all", "dd", "distance", "qqchi2", "tolEllipsePlot", "screeplot"), classic = FALSE, ask = (which[1] == "all" && dev.interactive()), m.cov = covMcd(x), cutoff = NULL, id.n, labels.id = rownames(x), cex.id = 0.75, label.pos = c(4,2), tol = 1e-07, \dots) %% ddplot(x, \dots) %% distplot(x, \dots) %% chi2qqplot(x, \dots) %% ellipse(x, \dots) } \arguments{ \item{x}{For the \code{plot()} method, a \code{mcd} object, typically result of \code{\link{covMcd}}.\cr For \code{covPlot()}, the numeric data matrix such as the \code{X} component as returned from \code{\link{covMcd}}.} \item{which}{string indicating which plot to show. See the \emph{Details} section for a description of the options. Defaults to \code{"all"}.}. \item{classic}{whether to plot the classical distances too. Defaults to \code{FALSE}.}. \item{ask}{logical indicating if the user should be \emph{ask}ed before each plot, see \code{\link{par}(ask=.)}. Defaults to \code{which == "all" && \link{dev.interactive}()}. } \item{cutoff}{the cutoff value for the distances.} \item{id.n}{number of observations to be identified by a label. If not supplied, the number of observations with distance larger than \code{cutoff} is used.} \item{labels.id}{vector of labels, from which the labels for extreme points will be chosen. \code{NULL} uses observation numbers.} \item{cex.id}{magnification of point labels.} \item{label.pos}{positioning of labels, for the left half and right half of the graph respectively (used as \code{\link{text}(.., pos=*)}).} \item{tol}{tolerance to be used for computing the inverse, see \code{\link{solve}}. Defaults to \code{tol = 1e-7}.} \item{m.cov}{an object similar to those of class \code{"mcd"}; however only its components \code{center} and \code{cov} will be used. If missing, the MCD will be computed (via \code{\link{covMcd}()}).} \item{\dots}{other parameters to be passed through to plotting functions.} } \details{ These functions produce several plots based on the robust and classical location and covariance matrix. Which of them to select is specified by the attribute \code{which}. The \code{plot} method for \code{"mcd"} objects is calling \code{covPlot()} directly, whereas \code{covPlot()} should also be useful for plotting other (robust) covariance estimates. The possible options are: \describe{ \item{\code{distance}}{index plot of the robust distances} \item{\code{dd}}{distance-distance plot} \item{\code{qqchi2}}{a qq-plot of the robust distances versus the quantiles of the chi-squared distribution} \item{\code{tolEllipsePlot}}{a tolerance ellipse plot, via \code{\link{tolEllipsePlot}()}} \item{\code{screeplot}}{an eigenvalues comparison plot - screeplot} } The Distance-Distance Plot, introduced by Rousseeuw and van Zomeren (1990), displays the robust distances versus the classical Mahalanobis distances. The dashed line is the set of points where the robust distance is equal to the classical distance. The horizontal and vertical lines are drawn at values equal to the cutoff which defaults to square root of the 97.5\% quantile of a chi-squared distribution with p degrees of freedom. Points beyond these lines can be considered outliers. } %\value{} \references{ P. J. Rousseeuw and van Zomeren, B. C. (1990). Unmasking Multivariate Outliers and Leverage Points. \emph{Journal of the American Statistical Association} \bold{85}, 633--639. P. J. Rousseeuw and K. van Driessen (1999) A fast algorithm for the minimum covariance determinant estimator. \emph{Technometrics} \bold{41}, 212--223. } \seealso{ \code{\link{tolEllipsePlot}} } \examples{ data(Animals, package ="MASS") brain <- Animals[c(1:24, 26:25, 27:28),] mcd <- covMcd(log(brain)) plot(mcd, which = "distance", classic = TRUE)# 2 plots plot(mcd, which = "dd") plot(mcd, which = "tolEllipsePlot", classic = TRUE) op <- par(mfrow = c(2,3)) plot(mcd) ## -> which = "all" (5 plots) par(op) ## same plots for another robust Cov estimate: data(hbk) hbk.x <- data.matrix(hbk[, 1:3]) cOGK <- covOGK(hbk.x, n.iter = 2, sigmamu = scaleTau2, weight.fn = hard.rejection) covPlot(hbk.x, m.cov = cOGK, classic = TRUE) % %% this "\dont*{} case is needed for R <= 2.3.1 : % \dontrun{ covPlot(hbk.x, m.cov = cOGK, classic = TRUE, ask= TRUE)} % \dontshow{covPlot(hbk.x, m.cov = cOGK, classic = TRUE, ask= FALSE)} } \keyword{hplot} \keyword{robust} \keyword{multivariate} robustbase/man/print.lmrob.Rd0000644000176200001440000000135411721663343015744 0ustar liggesusers\name{print.lmrob} \alias{print.lmrob} \title{Print Method for Objects of Class "lmrob"} \description{ Print method for elements of class \code{"lmrob"}. } \usage{ \method{print}{lmrob}(x, digits = max(3, getOption("digits") - 3), \dots) } \arguments{ \item{x}{an \R object of class \code{lmrob}, typically created by \code{\link{lmrob}}.} \item{digits}{number of digits for printing, see \code{digits} in \code{\link{options}}.} \item{\dots}{potentially more arguments passed to methods.} } \seealso{\code{\link{lmrob}}, \code{\link{summary.lmrob}}, \code{\link{print}} and \code{\link{summary}}. } \examples{ data(coleman) ( m1 <- lmrob(Y ~ ., data=coleman) ) # -> print.lmrob() method } \keyword{robust} \keyword{regression} robustbase/man/functionX-class.Rd0000644000176200001440000000201312114153713016537 0ustar liggesusers\name{functionX-class} \docType{class} \alias{functionX-class} \title{Class "functionX" of Psi-like Vectorized Functions} \description{ The class \code{"functionX"} of vectorized functions of one argument \code{x} and typically further tuning parameters. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("functionX", ...)}. } \section{Slots}{ \describe{ \item{\code{.Data}:}{Directly extends class \code{"function"}.} } } \section{Extends}{ Class \code{"function"}, from data part. Class \code{"OptionalFunction"}, by class \code{"function"}. Class \code{"PossibleMethod"}, by class \code{"function"}. } \section{Methods}{ No methods defined with class "functionX" in the signature. } \author{Martin Maechler} \seealso{ \code{\link{psiFunc}()}, and class descriptions of \code{\linkS4class{functionXal}} for \emph{functionals} of \code{"functionX"}, and \code{\linkS4class{psi_func}} which has several \code{functionX} slots. } % \examples{ % } \keyword{classes} robustbase/man/predict.glmrob.Rd0000644000176200001440000000702611651467605016420 0ustar liggesusers\name{predict.glmrob} \alias{predict.glmrob} \title{Predict Method for Robust GLM ("glmrob") Fits} \description{ Obtains predictions and optionally estimates standard errors of those predictions from a fitted \emph{robust} generalized linear model (GLM) object. } \usage{ \method{predict}{glmrob}(object, newdata = NULL, type = c("link", "response", "terms"), se.fit = FALSE, dispersion = NULL, terms = NULL, na.action = na.pass, \dots) } \arguments{ %% the following is +- copy-pasted from predict.glm.Rd: \item{object}{a fitted object of class inheriting from \code{"glmrob"}.} \item{newdata}{optionally, a data frame in which to look for variables with which to predict. If omitted, the fitted linear predictors are used.} \item{type}{the type of prediction required. The default is on the scale of the linear predictors; the alternative \code{"response"} is on the scale of the response variable. Thus for a default binomial model the default predictions are of log-odds (probabilities on logit scale) and \code{type = "response"} gives the predicted probabilities. The \code{"terms"} option returns a matrix giving the fitted values of each term in the model formula on the linear predictor scale. The value of this argument can be abbreviated. } \item{se.fit}{logical switch indicating if standard errors are required.} \item{dispersion}{the dispersion of the GLM fit to be assumed in computing the standard errors. If omitted, that returned by \code{summary} applied to the object is used.} \item{terms}{with \code{type="terms"} by default all terms are returned. A character vector specifies which terms are to be returned} \item{na.action}{function determining what should be done with missing values in \code{newdata}. The default is to predict \code{NA}.} \item{\dots}{optional further arguments, currently simply passed to \code{\link{predict.lmrob}()}.} } % \details{ % If necessary, more details than the description above ~~ % } \value{ %% the following is +- copy-pasted from predict.glm.Rd: %% also correct,here ? If \code{se = FALSE}, a vector or matrix of predictions. If \code{se = TRUE}, a list with components \item{fit}{Predictions} \item{se.fit}{Estimated standard errors} \item{residual.scale}{A scalar giving the square root of the dispersion used in computing the standard errors.} } \author{Andreas Ruckstuhl} \seealso{ \code{\link{glmrob}()} to fit these robust GLM models, \code{\link{residuals.glmrob}()} and other methods; \code{\link{predict.lm}()}, the method used for a non-robust fit. } \examples{ data(carrots) ## simplistic testing & training: i.tr <- sample(24, 20) fm1 <- glmrob(cbind(success, total-success) ~ logdose + block, family = binomial, data = carrots, subset = i.tr) fm1 predict(fm1, carrots[-i.tr, ]) # --> numeric vector predict(fm1, carrots[-i.tr, ], type="response", se = TRUE)# -> a list % FIXME: gives a "bad" error -- should rather say "not yet implemented" % or implement it ! % predict(fm1, carrots[-i.tr, ], interval = "confidence") % predict(fm1, carrots[-i.tr, ], interval = "prediction") data(vaso) Vfit <- glmrob(Y ~ log(Volume) + log(Rate), family=binomial, data=vaso) newd <- expand.grid(Volume = (V. <- seq(.5, 4, by = 0.5)), Rate = (R. <- seq(.25,4, by = 0.25))) p <- predict(Vfit, newd) filled.contour(V., R., matrix(p, length(V.), length(R.)), main = "predict(glmrob(., data=vaso))", xlab="Volume", ylab="Rate") } \keyword{models} \keyword{regression} robustbase/man/summary.lmrob.Rd0000644000176200001440000001220213167157117016302 0ustar liggesusers\name{summary.lmrob} \title{Summary Method for "lmrob" Objects} % \alias{summary.lmrob} \alias{hatvalues.lmrob} \alias{.lmrob.hat} \alias{vcov.lmrob} \alias{print.summary.lmrob} \alias{model.matrix.lmrob} % \description{ Summary method for \R object of class \code{"lmrob"} and \code{\link{print}} method for the summary object. Further, methods \code{\link{fitted}()}, \code{\link{residuals}()} work (via the default methods), and \code{\link{predict}()} (see \code{\link{predict.lmrob}}, \code{\link{vcov}()}, \code{\link{weights}()} (see \code{\link{weights.lmrob}}), \code{\link{model.matrix}()}, \code{\link{confint}()}, \code{\link{dummy.coef}()}, \code{\link{hatvalues}()}, etc., have explicitly defined \code{lmrob} methods. \code{.lmrob.hat()} is the lower level \dQuote{work horse} of the \code{hatvalues()} method. } \usage{% all source in ../R/lmrob.R <<< \method{summary}{lmrob}(object, correlation = FALSE, symbolic.cor = FALSE, \dots) \method{print}{summary.lmrob}(x, digits = max(3, getOption("digits") - 3), symbolic.cor= x$symbolic.cor, signif.stars = getOption("show.signif.stars"), showAlgo = TRUE, \dots) \method{vcov}{lmrob}(object, cov = object$control$cov, complete = TRUE, \dots) \method{model.matrix}{lmrob}(object, \dots) % not yet % .lmrob.hat(x, w = rep(1, NROW(x)), wqr = qr(sqrt(w) * x)) } \arguments{ \item{object}{an \R object of class \code{lmrob}, typically created by \code{\link{lmrob}}.} \item{correlation}{logical variable indicating whether to compute the correlation matrix of the estimated coefficients.} \item{symbolic.cor}{logical indicating whether to use symbols to display the above correlation matrix.} \item{x}{an \R object of class \code{summary.lmrob}, typically resulting from \code{summary(\link{lmrob}(..),..)}.} \item{digits}{number of digits for printing, see \code{digits} in \code{\link{options}}.} \item{signif.stars}{logical variable indicating whether to use stars to display different levels of significance in the individual t-tests.} \item{showAlgo}{optional \code{\link{logical}} indicating if the algorithmic parameters (as mostly inside the \code{control} part) should be shown.} \item{cov}{covariance estimation function to use, a \code{\link{function}} or \link{character} string naming the function; \pkg{robustbase} currently provides \code{".vcov.w"} and \code{".vcov.avar1"}, see \emph{Details} of \code{\link{lmrob}}. Particularly useful when \code{object} is the result of \code{lmrob(.., cov = "none")}, where \preformatted{ object$cov <- vcov(object, cov = ".vcov.w")} allows to \emph{update} the fitted object.} \item{complete}{(mainly for \R \code{>= 3.5.0}:)% ~/R/D/r-devel/R/src/library/stats/man/vcov.Rd \code{\link{logical}} indicating if the full variance-covariance matrix should be returned also in case of an over-determined system where some coefficients are undefined and \code{\link{coef}(.)} contains \code{NA}s correspondingly. When \code{complete = TRUE}, \code{vcov()} is compatible with \code{coef()} also in this singular case.} \item{\dots}{potentially more arguments passed to methods.} } \value{ \code{summary(object)} returns an object of S3 class \code{"summary.lmrob"}, basically a \code{\link{list}} with components "call", "terms", "residuals", "scale", "rweights", "converged", "iter", "control" all copied from \code{object}, and further components, partly for compatibility with \code{\link{summary.lm}}, \item{coefficients}{a \code{\link{matrix}} with columns \code{"Estimate"}, \code{"Std. Error"}, \code{"t value"}, and \code{"PR(>|t|)"}, where "Estimate" is identical to \code{\link{coef}(object)}. Note that \code{\link{coef}()} is slightly preferred to access this matrix.} \item{df}{degrees of freedom, in an \code{\link{lm}} compatible way.} \item{sigma}{identical to \code{\link{sigma}(object)}.} \item{aliased}{..}%FIXME \item{cov}{derived from \code{object$cov}.}% FIXME: say more \item{r.squared}{robust \dQuote{R squared} or \eqn{R^2}, a coefficient of determination: This is the consistency corrected robust coefficient of determination by Renaud and Victoria-Feser (2010).} \item{adj.r.squared}{an adjusted R squared, see \code{r.squared}.} } \references{ Renaud, O. and Victoria-Feser, M.-P. (2010). A robust coefficient of determination for regression, \emph{Journal of Statistical Planning and Inference} \bold{140}, 1852-1862. } \seealso{\code{\link{lmrob}}, \code{\link{predict.lmrob}}, \code{\link{weights.lmrob}}, \code{\link{summary.lm}}, \code{\link{print}}, \code{\link{summary}}. } \examples{ mod1 <- lmrob(stack.loss ~ ., data = stackloss) sa <- summary(mod1) # calls summary.lmrob(....) sa # dispatches to call print.summary.lmrob(....) ## correlation between estimated coefficients: cov2cor(vcov(mod1)) cbind(fit = fitted(mod1), resid = residuals(mod1), wgts= weights(mod1, type="robustness"), predict(mod1, interval="prediction")) data(heart) sm2 <- summary( m2 <- lmrob(clength ~ ., data = heart) ) sm2 } \keyword{robust} \keyword{regression} robustbase/man/radarImage.Rd0000644000176200001440000000420113312375575015531 0ustar liggesusers\name{radarImage} \alias{radarImage} \docType{data} \title{Satellite Radar Image Data from near Munich} \description{ The data were supplied by A. Frery. They are a part of a synthetic aperture satellite radar image corresponding to a suburb of Munich. Provided are coordinates and values corresponding to three frequency bands for each of 1573 pixels. } \usage{data(radarImage, package="robustbase")} \format{ A data frame with 1573 observations on the following 5 variables. \describe{ \item{\code{X.coord}}{a numeric vector} \item{\code{Y.coord}}{a numeric vector} \item{\code{Band.1}}{a numeric vector} \item{\code{Band.2}}{a numeric vector} \item{\code{Band.3}}{a numeric vector} } } % \details{ % } \source{ The website accompanying the MMY-book: \url{http://www.wiley.com/legacy/wileychi/robust_statistics} } % \references{ % ~~ possibly secondary sources and usages ~~ % } \examples{ data(radarImage) plot(Y.coord ~ X.coord, data = radarImage) ## The 8 "clear" outliers (see also below) ii8 <- c(1548:1549, 1553:1554, 1565:1566, 1570:1571) outF <- 1+(seq_len(nrow(radarImage)) \%in\% ii8) pairs(radarImage[, 3:5], main = "radarImage (n = 1573)", col = outF, pch=outF) ## Finding outliers ----------------------------------------- set.seed(1) system.time(cc.ri <- covMcd(radarImage))# ~ 0.1 sec ## check for covMcd() consistency: iiO <- as.integer( c(262, 450:451, 480:481, 509, 535, 542, 597, 643, 669, 697, 803:804, 832:834, 862:864, 892, 989, 1123, 1145, 1223:1224, 1232:1233, 1249:1250, 1267, 1303, 1347, 1357, 1375, 1411, 1419:1420, 1443, 1453, 1504, 1510:1512, 1518:1521, 1525:1526, 1543:1544, 1546:1555, 1557:1558, 1561:1562, 1564:1566, 1569:1571, 1573)) length(iiO) # 73 -- other seeds sometimes give 72, rarely 71 "outliers" isO <- cc.ri$mcd.wt == 0 stopifnot(identical(iiO, which(isO)), identical(ii8, which(cc.ri$mah > 100)), length(intersect(cc.ri$best, iiO)) == 0) cc <- c(adjustcolor("black", 0.4), adjustcolor("tomato", 0.8)) pairs(radarImage, main = "radarImage (n = 1573) + Outliers", gap=0, col = cc[1+isO], pch = c(1,8)[1+isO], cex = 0.8) } \keyword{datasets} robustbase/man/anova.glmrob.Rd0000644000176200001440000001030312245333206016047 0ustar liggesusers\name{anova.glmrob} \alias{anova.glmrob} \title{Analysis of Robust Quasi-Deviance for "glmrob" Objects} \description{ Compute an analysis of robust quasi-deviance table for one or more generalized linear models fitted by \code{\link{glmrob}}. } \usage{ \method{anova}{glmrob}(object, ..., test = c("Wald", "QD", "QDapprox")) } \arguments{ \item{object, \dots}{objects of class \code{glmrob}, typically the result of a call to \code{\link{glmrob}}.} \item{test}{a character string specifying the test statistic to be used. (Partially) matching one of \code{"Wald"}, \code{"QD"} or \code{"QDapprox"}. See Details.} } \details{ Specifying a single object gives a sequential analysis of robust quasi-deviance table for that fit. That is, the reductions in the robust residual quasi-deviance as each term of the formula is added in turn are given in as the rows of a table. \emph{(Currently not yet implemented.)} If more than one object is specified, the table has a row for the residual quasi-degrees of freedom (However, this information is never used in the asymptotic tests). For all but the first model, the change in degrees of freedom and robust quasi-deviance is also given. (This only makes statistical sense if the models are nested.) It is conventional to list the models from smallest to largest, but this is up to the user. In addition, the table will contain test statistics and P values comparing the reduction in robust quasi-deviance for the model on the row to that on top of it. For all robust fitting methods, the \dQuote{Wald}-type test between two models can be applied (\code{test = "Wald"}). When using Mallows or Huber type robust estimators (\code{method="Mqle"} in \code{\link{glmrob}}), then there are additional test methods. One is the robust quasi-deviance test (\code{test = "QD"}), as described by Cantoni and Ronchetti (2001). The asymptotic distribution is approximated by a chi-square distibution. Another test (\code{test = "QDapprox"}) is based on a quadratic approximation of the robust quasi-deviance test statistic. Its asymptotic distribution is chi-square (see the reference). The comparison between two or more models by \code{anova.glmrob} will only be valid if they are fitted to the same dataset and by the same robust fitting method using the same tuning constant \eqn{c} (\code{tcc} in \code{\link{glmrob}}). } \value{ Basically, an object of class \code{\link{anova}} inheriting from class \code{\link{data.frame}}. } \references{ E. Cantoni and E. Ronchetti (2001) Robust Inference for Generalized Linear Models. \emph{JASA} \bold{96} (455), 1022--1030. E.Cantoni (2004) Analysis of Robust Quasi-deviances for Generalized Linear Models. \emph{Journal of Statistical Software} \bold{10}, \url{http://www.jstatsoft.org/v10/i04} } \author{ Andreas Ruckstuhl } \seealso{ \code{\link{glmrob}}, \code{\link{anova}}. %% %% \code{\link{drop1}} for %% so-called \sQuote{type II} anova where each term is dropped one at a %% time respecting their hierarchy. } \examples{ ## Binomial response ----------- data(carrots) Cfit2 <- glmrob(cbind(success, total-success) ~ logdose + block, family=binomial, data=carrots, method="Mqle", control=glmrobMqle.control(tcc=1.2)) summary(Cfit2) Cfit4 <- glmrob(cbind(success, total-success) ~ logdose * block, family=binomial, data=carrots, method="Mqle", control=glmrobMqle.control(tcc=1.2)) anova(Cfit2, Cfit4, test="Wald") anova(Cfit2, Cfit4, test="QD") anova(Cfit2, Cfit4, test="QDapprox") ## Poisson response ------------ data(epilepsy) Efit2 <- glmrob(Ysum ~ Age10 + Base4*Trt, family=poisson, data=epilepsy, method="Mqle", control=glmrobMqle.control(tcc=1.2,maxit=100)) summary(Efit2) Efit3 <- glmrob(Ysum ~ Age10 + Base4 + Trt, family=poisson, data=epilepsy, method="Mqle", control=glmrobMqle.control(tcc=1.2,maxit=100)) anova(Efit3, Efit2, test = "Wald") anova(Efit3, Efit2, test = "QD") ## trivial intercept-only-model: E0 <- update(Efit3, . ~ 1) anova(E0, Efit3, Efit2, test = "QDapprox") %% failed in robustbase <= 2013-11-27 } \keyword{robust} \keyword{models} \keyword{regression} robustbase/man/foodstamp.Rd0000644000176200001440000000454513312375575015504 0ustar liggesusers\name{foodstamp} \title{Food Stamp Program Participation} \alias{foodstamp} \docType{data} \encoding{utf8} \description{ This data consists of 150 randomly selected persons from a survey with information on over 2000 elderly US citizens, where the response, indicates participation in the U.S. Food Stamp Program. } \usage{data(foodstamp, package="robustbase")} \format{ A data frame with 150 observations on the following 4 variables. \describe{ \item{\code{participation}}{participation in U.S. Food Stamp Program; yes = 1, no = 0} \item{\code{tenancy}}{tenancy, indicating home ownership; yes = 1, no = 0} \item{\code{suppl.income}}{supplemental income, indicating whether some form of supplemental security income is received; yes = 1, no = 0} \item{\code{income}}{monthly income (in US dollars)} } } \source{ Data description and first analysis: Stefanski et al.(1986) who indicate Rizek(1978) as original source of the larger study. Electronic version from CRAN package \pkg{catdata}. % which wrongly labeled 'income' (='INC') as "log(1 + income)" } \references{ Rizek, R. L. (1978) The 1977-78 Nationwide Food Consumption Survey. \emph{Family Econ. Rev.}, Fall, 3--7. %% MM ~/save/papers/robust-GLM/Stefanski_etal-Biometrika-1986.pdf : Stefanski, L. A., Carroll, R. J. and Ruppert, D. (1986) Optimally bounded score functions for generalized linear models with applications to logistic regression. \emph{Biometrika} \bold{73}, 413--424. Künsch, H. R., Stefanski, L. A., Carroll, R. J. (1989) Conditionally unbiased bounded-influence estimation in general regression models, with applications to generalized linear models. \emph{J. American Statistical Association} \bold{84}, 460--466. } \examples{ data(foodstamp) (T123 <- xtabs(~ participation+ tenancy+ suppl.income, data=foodstamp)) summary(T123) ## ==> the binary var's are clearly not independent foodSt <- within(foodstamp, { logInc <- log(1 + income) rm(income) }) m1 <- glm(participation ~ ., family=binomial, data=foodSt) summary(m1) rm1 <- glmrob(participation ~ ., family=binomial, data=foodSt) summary(rm1) ## Now use robust weights.on.x : rm2 <- glmrob(participation ~ ., family=binomial, data=foodSt, weights.on.x = "robCov") summary(rm2)## aha, now the weights are different: which( weights(rm2, type="robust") < 0.5) } \keyword{datasets} robustbase/man/colMedians.Rd0000644000176200001440000000603012461751370015550 0ustar liggesusers\name{colMedians} \title{Fast Row or Column-wise Medians of a Matrix} \alias{colMedians} \alias{rowMedians} \description{ Calculates the median for each row (column) of a matrix \code{x}. This is the same as but more efficient than \code{apply(x, MM, median)} for MM=2 or MM=1, respectively. } \usage{ colMedians(x, na.rm = FALSE, hasNA = TRUE, keep.names=TRUE) rowMedians(x, na.rm = FALSE, hasNA = TRUE, keep.names=TRUE) } \arguments{ \item{x}{a \code{\link{numeric}} \eqn{n \times p}{n x p} \code{\link{matrix}}.} \item{na.rm}{if \code{\link{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{hasNA}{logical indicating if \code{x} may contain \code{\link{NA}}s. If set to \code{FALSE}, no internal NA handling is performed which typically is faster.} \item{keep.names}{logical indicating if row or column names of \code{x} should become \code{\link{names}} of the result - as is the case for \code{\link{apply}(x, MM, median)}.} } \value{ a \code{\link{numeric}} vector of length \eqn{n} or \eqn{p}, respectively. } \section{Missing values}{ Missing values are excluded before calculating the medians \emph{unless} \code{hasNA} is false. Note that \code{na.rm} has no effect and is automatically false when \code{hasNA} is false, i.e., internally, before computations start, the following is executed: \preformatted{if (!hasNA) ## If there are no NAs, don't try to remove them narm <- FALSE} } \details{ The implementation of \code{rowMedians()} and \code{colMedians()} is optimized for both speed and memory. To avoid coercing to \code{\link{double}}s (and hence memory allocation), there is a special implementation for \code{\link{integer}} matrices. That is, if \code{x} is an \code{\link{integer}} \code{\link{matrix}}, then \code{rowMedians(as.double(x))} (\code{rowMedians(as.double(x))}) would require three times the memory of \code{rowMedians(x)} (\code{colMedians(x)}), but all this is avoided. } \author{Henrik Bengtsson, Harris Jaffee, Martin Maechler} \seealso{ See \code{\link{wgt.himedian}()} for a weighted hi-median, and \code{\link[matrixStats]{colWeightedMedians}()} etc from package \pkg{matrixStats} for \emph{weighted} medians.\cr For mean estimates, see \code{rowMeans()} in \code{\link{colSums}}(). } \examples{ set.seed(1); n <- 234; p <- 543 # n*p = 127'062 x <- matrix(rnorm(n*p), n, p) x[sample(seq_along(x), size= n*p / 256)] <- NA R1 <- system.time(r1 <- rowMedians(x, na.rm=TRUE)) C1 <- system.time(y1 <- colMedians(x, na.rm=TRUE)) R2 <- system.time(r2 <- apply(x, 1, median, na.rm=TRUE)) C2 <- system.time(y2 <- apply(x, 2, median, na.rm=TRUE)) R2 / R1 # speedup factor: ~= 4 {platform dependent} C2 / C1 # speedup factor: ~= 5.8 {platform dependent} stopifnot(all.equal(y1, y2, tol=1e-15), all.equal(r1, r2, tol=1e-15)) (m <- cbind(x1=3, x2=c(4:1, 3:4,4))) stopifnot(colMedians(m) == 3, all.equal(colMeans(m), colMedians(m)),# <- including names ! all.equal(rowMeans(m), rowMedians(m))) } \keyword{array} \keyword{robust} \keyword{univar} robustbase/man/coleman.Rd0000644000176200001440000000263113312375575015120 0ustar liggesusers\name{coleman} \alias{coleman} \docType{data} \title{Coleman Data Set} \description{ Contains information on 20 Schools from the Mid-Atlantic and New England States, drawn from a population studied by Coleman et al. (1966). Mosteller and Tukey (1977) analyze this sample consisting of measurements on six different variables, one of which will be treated as a responce. } \usage{data(coleman, package="robustbase")} \format{ A data frame with 20 observations on the following 6 variables. \describe{ \item{\code{salaryP}}{staff salaries per pupil} \item{\code{fatherWc}}{percent of white-collar fathers} \item{\code{sstatus}}{socioeconomic status composite deviation: means for family size, family intactness, father's education, mother's education, and home items} \item{\code{teacherSc}}{mean teacher's verbal test score} \item{\code{motherLev}}{mean mother's educational level, one unit is equal to two school years} \item{\code{Y}}{verbal mean test score (y, all sixth graders)} } } \author{Valentin Todorov} \source{ P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection} Wiley, p.79, table 2. } \examples{ data(coleman) pairs(coleman) summary( lm.coleman <- lm(Y ~ . , data = coleman)) summary(lts.coleman <- ltsReg(Y ~ . , data = coleman)) coleman.x <- data.matrix(coleman[, 1:6]) (Cc <- covMcd(coleman.x)) } \keyword{datasets} robustbase/man/sigma.Rd0000644000176200001440000000221312534070302014557 0ustar liggesusers\name{sigma} \title{Extract 'Sigma' - Standard Deviation of Errors for Robust Models} \alias{sigma} \alias{sigma.lmrob} \description{ Extract the estimated standard deviation of the errors, the \dQuote{residual standard deviation} (misnomed also \dQuote{residual standard error}) from a fitted model. } \usage{ % Declare S3 method as the generic is no longer in lme4 for R (>= 2015-06-01): \S3method{sigma}{lmrob}(object, \dots) } \arguments{ \item{object}{a fitted model.} \item{\dots}{additional, optional arguments. (None are used in our methods)} } \value{ the residual standard error as a scalar } \details{ For \R \code{<= 3.2.x}, we provide an (S3) generic function (as e.g., package \pkg{lme4}) and methods for \code{\link{lmrob}}, \code{\link{nlrob}}, and \code{\link{nls}}. From \R \code{>= 3.3.0}, we provide methods for our \code{\link{lmrob}} and \code{\link{nlrob}} models. } \examples{ m.cl <- lm (Y ~ ., data=coleman) if(getRversion() >= "3.3.0") sigma(m.cl) else summary(m.cl)$sigma sigma( m1 <- lmrob(Y ~ ., data=coleman) ) sigma( m2 <- lmrob(Y ~ ., data=coleman, setting = "KS2014") ) } \keyword{models} robustbase/man/lmrob.M.S.Rd0000644000176200001440000000676213212743621015210 0ustar liggesusers\name{lmrob.M.S} \alias{lmrob.M.S} \title{ M-S regression estimators } \description{ Computes an M-S-estimator for linear regression using the \dQuote{M-S} algorithm. } \usage{ lmrob.M.S(x, y, control, mf, split = splitFrame(mf, x, control$split.type)) } \arguments{ \item{x}{numeric matrix (a \code{\link{model.matrix}}) of the predictors.} \item{y}{numeric vector for the response } \item{control}{ list as returned by \code{\link{lmrob.control}}.} \item{mf}{a model frame as returned by \code{\link{model.frame}}.} \item{split}{(optional) list as returned by \code{\link{splitFrame}}.} } \details{ This function is used by \code{\link{lmrob}} and not intended to be used on its own (because an M-S-estimator has too low efficiency \sQuote{on its own}). An M-S estimator is a combination of an S-estimator for the continuous variables and an L1-estimator (i.e. an M-estimator with \eqn{\psi(t) = sign(t)}) for the categorical variables. The S-estimator is estimated using a subsampling algorithm. If the model includes interactions between categorical (\code{\link{factor}}) and continuous variables, the subsampling algorithm might fail. In this case, one can choose to assign the interaction to the categorical side of variables rather than to the continuous side. This can be accomplished via the control argument \code{split.type} or by specifying \code{split}, see \code{\link{splitFrame}}. Note that the return status \code{converged} does not refer to the actual convergence status. The algorithm used does not guarantee convergence and thus true convergence is almost never reached. This is, however, not a problem if the estimate is only used as initial estimate part of an MM or SMDM estimate. The algorithm sometimes produces the warning message \dQuote{Skipping design matrix equilibration (dgeequ): row ?? is exactly zero.}. This is just an artifact of the algorithm and can be ignored safely. } \value{ A list with components \item{coefficients}{numeric vector (length \eqn{p}) of M-S-regression coefficient estimates.} \item{scale}{the M-S-scale residual estimate} \item{residuals}{numeric vector (legnth \eqn{n}) of the residuals.} \item{rweights}{numeric vector (length \eqn{n}) of the robustness weights.} \item{control}{the same list as the \code{control} argument.} \item{converged}{Convergence status (always \code{TRUE}), needed for \code{\link{lmrob.fit}}.} } \references{ Maronna, R. A., and Yohai, V. J. (2000). Robust regression with both continuous and categorical predictors. \emph{Journal of Statistical Planning and Inference} \bold{89}, 197--214. } \author{ Manuel Koller } \seealso{ \code{\link{lmrob}}; for a description of the available split types, see \code{\link{splitFrame}}. \code{\link[robust]{lmRob}} in package \pkg{robust} uses a version of the M-S algorithm automatically when the formula contains factors. Our version however follows Maronna and Yohai (2000) more closely. } \examples{ data(education) education <- within(education, Region <- factor(Region)) flm <- lm(Y ~ Region + X1 + X2 + X3, education) x <- model.matrix(flm) y <- education$Y # == model.response(model.frame(flm)) set.seed(17) f.MS <- lmrob.M.S(x, y, control = lmrob.control(), mf = model.frame(flm)) ## The typical use of the "M-S" estimator -- as initial estimate : fmMS <- lmrob(Y ~ Region + X1 + X2 + X3, education, init = "M-S") } \keyword{ M-S } \keyword{ robust } \keyword{ regression } robustbase/man/bushfire.Rd0000644000176200001440000000126613312375575015314 0ustar liggesusers\name{bushfire} \alias{bushfire} \docType{data} \title{ Campbell Bushfire Data } \description{ This data set was used by Campbell (1984) to locate bushfire scars. The dataset contains satelite measurements on five frequency bands, corresponding to each of 38 pixels. } \usage{data(bushfire, package="robustbase")} \format{ A data frame with 38 observations on 5 variables. % \describe{} } %\Note{} \source{ Maronna, R.A. and Yohai, V.J. (1995) The Behavoiur of the Stahel-Donoho Robust Multivariate Estimator. \emph{Journal of the American Statistical Association} \bold{90}, 330--341. } %\seealso{} \examples{ data(bushfire) plot(bushfire) covMcd(bushfire) } \keyword{datasets} robustbase/man/weights.lmrob.Rd0000644000176200001440000000240012343540277016254 0ustar liggesusers\name{weights.lmrob} \title{Extract Robustness and Model Weights} \alias{weights.lmrob} \alias{weights.glmrob} \description{ \code{weights()} extracts robustness weights or fitting (or prior) weights from a \code{lmrob} or \code{glmrob} object. } \usage{ \method{weights}{lmrob}(object, type = c("prior", "robustness"), ...) } \arguments{ \item{object}{ an object of class \code{"lmrob"} or \code{"glmrob"}, typically the result of a call to \code{\link{lmrob}}, or \code{\link{glmrob}}, respectively.} \item{type}{the type of weights to be returned. Either \code{"prior"} (default), or \code{"robustness"}.} \item{\dots}{not used currently.} } \details{ The \dQuote{prior weights} correspond to the weights specified using the \dQuote{weights} argument when calling \code{lmrob}. The \dQuote{robustness weights} are the weights assigned by the M-estimator of regression, \eqn{\psi(r_i/S) / (r_i/S)}. The robust coefficient estimate then numericarlly corresponds to a weighted least squares fit using the product of both types of weights as weights. } \value{ Weights extracted from the object \code{object}. } \author{Manuel Koller and Martin Maechler.} \seealso{ \code{\link{lmrob}}, \code{\link{glmrob}} and \code{\link{weights}} } robustbase/man/wood.Rd0000644000176200001440000000210613312375575014447 0ustar liggesusers\name{wood} \alias{wood} \docType{data} \title{Modified Data on Wood Specific Gravity} \description{ The original data are from Draper and Smith (1966) and were used to determine the influence of anatomical factors on wood specific gravity, with five explanatory variables and an intercept. These data were contaminated by replacing a few observations with outliers. } \usage{data(wood, package="robustbase")} \format{ A data frame with 20 observations on the following 6 variables. \describe{ \item{x1, x2, x3, x4, x5}{explanatory \dQuote{anatomical} wood variables.} \item{y}{wood specific gravity, the target variable.} } } \source{ Draper and Smith (1966, p.227) Peter J. Rousseeuw and Annick M. Leroy (1987) \emph{Robust Regression and Outlier Detection} Wiley, p.243, table 8. } \examples{ data(wood) plot(wood) summary( lm.wood <- lm(y ~ ., data = wood)) summary(rlm.wood <- MASS::rlm(y ~ ., data = wood)) summary(lts.wood <- ltsReg(y ~ ., data = wood)) wood.x <- as.matrix(wood)[,1:5] c_wood <- covMcd(wood.x) c_wood } \keyword{datasets} robustbase/man/summary.nlrob.Rd0000644000176200001440000000307112270244535016302 0ustar liggesusers\name{summary.nlrob} \alias{summary.nlrob} \title{Summarizing Robust Fits of Nonlinear Regression Models } \description{ \code{summary} method for objects of class \code{"nlrob"}, i.e., \code{\link{nlrob}()} results. Currently it only works for \code{nlrob(*, method="M")}. } \usage{ \method{summary}{nlrob}(object, correlation = FALSE, symbolic.cor = FALSE, ...) } \arguments{ \item{object}{an object of class \code{"nlrob"}, usually, a result of a call to \code{\link{nlrob}}.} \item{correlation}{logical variable indicating whether to compute the correlation matrix of the estimated coefficients.} \item{symbolic.cor}{logical indicating whether to use symbols to display the above correlation matrix.} \item{\dots}{further arguments passed to or from other methods.} } \value{ The function \code{\link{summary.nlrob}} computes and returns an object of class \code{"summary.nlrob"} of summary statistics of the robustly fitted linear model given in \code{object}. There is a print method, \code{print.summary.lmrob()}, which nicely formats the output. The result keeps a large part of \code{object}'s components such as \code{residuals}, \code{cov} or \code{w}, and additionally contains \item{coefficients}{the matrix of coefficients, standard errors and p-values.} \item{correlation}{if the \code{correlation} argument was true, the correlation matrix of the parameters.} %% maybe add more } \author{Andreas Ruckstuhl} \seealso{\code{\link{nlrob}()}, also for examples. } \keyword{regression} \keyword{nonlinear} \keyword{robust} robustbase/man/covOGK.Rd0000644000176200001440000001260411114012313014603 0ustar liggesusers\name{covOGK} \alias{covOGK} \alias{covGK} \alias{s_mad} \alias{s_IQR} \alias{hard.rejection} % \title{Orthogonalized Gnanadesikan-Kettenring (OGK) Covariance Matrix Estimation} \description{ Computes the orthogonalized pairwise covariance matrix estimate described in in Maronna and Zamar (2002). The pairwise proposal goes back to Gnanadesikan and Kettenring (1972). } \usage{ covOGK(X, n.iter = 2, sigmamu, rcov = covGK, weight.fn = hard.rejection, keep.data = FALSE, \dots) covGK (x, y, scalefn = scaleTau2, \dots) s_mad(x, mu.too = FALSE, na.rm = FALSE) s_IQR(x, mu.too = FALSE, na.rm = FALSE) } \arguments{ \item{X}{data in something that can be coerced into a numeric matrix.} \item{n.iter}{number of orthogonalization iterations. Usually 1 or 2; values greater than 2 are unlikely to have any significant effect on the estimate (other than increasing the computing time).} \item{sigmamu, scalefn}{a function that computes univariate robust location and scale estimates. By default it should return a single numeric value containing the robust scale (standard deviation) estimate. When \code{mu.too} is true, \code{sigmamu()} should return a numeric vector of length 2 containing robust location and scale estimates. See \code{\link{scaleTau2}}, \code{\link{s_Qn}}, \code{\link{s_Sn}}, \code{s_mad} or \code{s_IQR} for examples to be used as \code{sigmamu} argument.} \item{rcov}{function that computes a robust covariance estimate between two vectors. The default, Gnanadesikan-Kettenring's \code{covGK}, is simply \eqn{(s^2(X+Y) - s^2(X-Y))/4} where \eqn{s()} is the scale estimate \code{sigmamu()}.} \item{weight.fn}{a function of the robust distances and the number of variables \eqn{p} to compute the weights used in the reweighting step.} \item{keep.data}{logical indicating if the (untransformed) data matrix \code{X} should be kept as part of the result.} \item{\dots}{additional arguments; for \code{covOGK} to be passed to \code{sigmamu()} and \code{weight.fn()}; for \code{covGK} passed to \code{scalefn}.} %%% covGK(): \item{x,y}{numeric vectors of the same length, the covariance of which is sought in \code{covGK} (or the scale, in \code{s_mad} or \code{s_IQR}).} %%% s_mad(), s_IQR(): \item{mu.too}{logical indicating if both location and scale should be returned or just the scale (when \code{mu.too=FALSE} as by default).} \item{na.rm}{if \code{TRUE} then \code{\link{NA}} values are stripped from \code{x} before computation takes place.} } \details{ Typical default values for the \emph{function} arguments \code{sigmamu}, \code{rcov}, and \code{weight.fn}, are available as well, see the \emph{Examples} below, \bold{but} their names and calling sequences are still subject to discussion and may be changed in the future. The current default, \code{weight.fn = hard.rejection} corresponds to the proposition in the litterature, but Martin Maechler strongly believes that the hard threshold currently in use is too arbitrary, and further that \emph{soft} thresholding should be used instead, anyway. } \value{ \code{covOGK()} currently returns a list with components \item{center}{robust location: numeric vector of length \eqn{p}.} \item{cov}{robust covariance matrix estimate: \eqn{p\times p}{p x p} matrix.} \item{wcenter, wcov}{re-\bold{w}eighted versions of \code{center} and \code{cov}.} \item{weights}{the robustness weights used.} \item{distances}{the mahalanobis distances computed using \code{center} and \code{cov}.} \dots\dots \cr \bold{but note that this might be radically changed to returning an S4 classed object!} \code{covGK()} is a trivial 1-line function returning the covariance estimate \deqn{\hat c(x,y) = \left(\hat \sigma(x+y)^2 - \hat \sigma(x-y)^2 \right)/4,% }{ c^(x,y) = [s^(x+y)^2 - s^(x-y)^2]/4,}% where \eqn{\hat \sigma(u)}{s^(u)} is the scale estimate of \eqn{u} specified by \code{scalefn}. \code{s_mad()}, and \code{s_IQR()} return the scale estimates \code{\link[stats]{mad}} or \code{\link[stats]{IQR}} respectively, where the \code{s_*} functions return a length-2 vector (mu, sig) when \code{mu.too = TRUE}, see also \code{\link{scaleTau2}}. } \references{ Maronna, R.A. and Zamar, R.H. (2002) Robust estimates of location and dispersion of high-dimensional datasets; \emph{Technometrics} \bold{44}(4), 307--317. Gnanadesikan, R. and John R. Kettenring (1972) Robust estimates, residuals, and outlier detection with multiresponse data. \emph{Biometrics} \bold{28}, 81--124. } \author{Kjell Konis \email{konis@stats.ox.ac.uk}, with modifications by Martin Maechler.} \seealso{\code{\link{scaleTau2}}, \code{\link{covMcd}}, \code{\link[MASS]{cov.rob}}. } \examples{ data(hbk) hbk.x <- data.matrix(hbk[, 1:3]) cO1 <- covOGK(hbk.x, sigmamu = scaleTau2) cO2 <- covOGK(hbk.x, sigmamu = s_Qn) cO3 <- covOGK(hbk.x, sigmamu = s_Sn) cO4 <- covOGK(hbk.x, sigmamu = s_mad) cO5 <- covOGK(hbk.x, sigmamu = s_IQR) %% FIXME: Add time comparison, here or in "vignette", "demo", "... data(toxicity) cO1tox <- covOGK(toxicity, sigmamu = scaleTau2) cO2tox <- covOGK(toxicity, sigmamu = s_Qn) ## nice formatting of correlation matrices: as.dist(round(cov2cor(cO1tox$cov), 2)) as.dist(round(cov2cor(cO2tox$cov), 2)) ## "graphical" symnum(cov2cor(cO1tox$cov)) symnum(cov2cor(cO2tox$cov), legend=FALSE) } \keyword{robust} \keyword{multivariate} robustbase/man/heart.Rd0000644000176200001440000000317310544734665014612 0ustar liggesusers\name{heart} \alias{heart} \docType{data} \title{Heart Catherization Data} \description{ This data set was analyzed by Weisberg (1980) and Chambers et al. (1983). A catheter is passed into a major vein or artery at the femoral region and moved into the heart. The proper length of the introduced catheter has to be guessed by the physician. The aim of the data set is to describe the relation between the catheter length and the patient's height (X1) and weight (X2). This data sets is used to demonstrate the effects caused by collinearity. The correlation between height and weight is so high that either variable almost completely determines the other. } \usage{ data(heart) %> QA bug: would want: %> data(heart, package="robustbase") %> but that gives two warnings } \format{ A data frame with 12 observations on the following 3 variables. \describe{ \item{\code{height}}{Patient's height in inches} \item{\code{weight}}{Patient's weights in pounds} \item{\code{clength}}{Y: Catheter Length (in centimeters)} } } \note{There are other \code{heart} datasets in other \R packages, notably \pkg{survival}, hence considering using \code{package = "robustbase"}, see examples. } \source{ Weisberg (1980) Chambers et al. (1983) P. J. Rousseeuw and A. M. Leroy (1987) \emph{Robust Regression and Outlier Detection}; Wiley, p.103, table 13. } \examples{ data(heart, package="robustbase") heart.x <- data.matrix(heart[, 1:2]) # the X-variables plot(heart.x) covMcd(heart.x) summary( lm.heart <- lm(clength ~ . , data = heart)) summary(lts.heart <- ltsReg(clength ~ . , data = heart)) } \keyword{datasets} robustbase/man/alcohol.Rd0000644000176200001440000000310113312375575015114 0ustar liggesusers\name{alcohol} \alias{alcohol} \docType{data} \title{Alcohol Solubility in Water Data} \description{ The solubility of alcohols in water is important in understanding alcohol transport in living organisms. This dataset from (Romanelli et al., 2001) contains physicochemical characteristics of 44 aliphatic alcohols. The aim of the experiment was the prediction of the solubility on the basis of molecular descriptors. } \usage{data(alcohol, package="robustbase")} \format{ A data frame with 44 observations on the following 7 numeric variables. \describe{ \item{\code{SAG}}{solvent accessible surface-bounded molecular volume.} \item{\code{V}}{volume} \item{\code{logPC}}{Log(PC); PC = octanol-water partitions coefficient} \item{\code{P}}{polarizability} \item{\code{RM}}{molar refractivity} \item{\code{Mass}}{the mass} \item{\code{logSolubility}}{ln(Solubility), the response.} } } % \details{ % } \source{ The website accompanying the MMY-book: \url{http://www.wiley.com/legacy/wileychi/robust_statistics} } \references{ %% FIXME: I don't think this is the correct reference % Romanelli, J.R., Kelly, J.J. and Litwein, D.E.M (2001) % Hand-assisted laparoscopic surgery in the United States: An overview % \emph{Seminars in Laparoscopic Surgery} \bold{8} 96--103. Maronna, R.A., Martin, R.D. and Yohai, V.J. (2006) \emph{Robust Statistics, Theory and Methods}, Wiley. } \examples{ data(alcohol) ## version of data set with trivial names, as s.alcohol <- alcohol names(s.alcohol) <- paste("Col", 1:7, sep='') } \keyword{datasets} robustbase/man/summary.mcd.Rd0000644000176200001440000000345410441335140015725 0ustar liggesusers\name{summary.mcd} \alias{summary.mcd} \alias{print.summary.mcd} \title{Summary Method for MCD objects} \usage{ \method{summary}{mcd}(object, \dots) \method{print}{summary.mcd}(x, digits = max(3, getOption("digits") - 3), print.gap = 2, \dots) } \arguments{ \item{object,x}{an object of class \code{"mcd"} (or \code{"summary.mcd"}); usually, a result of a call to \code{\link{covMcd}}.} \item{digits}{the number of significant digits to use when printing.} \item{print.gap}{number of horizontal spaces between numbers; see also \code{\link{print.default}}.} \item{\dots}{further arguments passed to or from other methods.} } \description{ \code{\link{summary}} method for class \code{"mcd"}. } \details{ \code{summary.mcd()}, the S3 method, simply returns an (S3) object of \code{\link{class} "summary.mcd"} for which there's a \code{\link{print}} method: \code{print.summary.mcd} prints summary statistics for the weighted covariance matrix and location estimates with weights based on MCD estimates. While the function \code{\link{print.mcd}} prints only the robust estimates of the location and the covariance matrix, \code{print.summary.mcd} will print also the correlation matrix (if requested in the call to \code{covMcd} with \code{cor=TRUE}), the eigenvalues of the covariance or the correlation matrix and the robust (\dQuote{Mahalanobis}) distances. } \value{ \code{summary.mcd} returns an \code{summary.mcd} object, whereas the \code{print} methods returns its first argument via \code{\link{invisible}}, as all \code{print} methods do. } \seealso{ \code{\link{covMcd}}, \code{\link{summary}} } \examples{ data(Animals, package = "MASS") brain <- Animals[c(1:24, 26:25, 27:28),] lbrain <- log(brain) summary(cLB <- covMcd(lbrain)) } \keyword{multivariate} \keyword{robust} robustbase/.Rinstignore0000644000176200001440000000002211721777657014745 0ustar liggesusersinst/doc/Makefile