bbmle/0000755000176200001440000000000013175563664011353 5ustar liggesusersbbmle/TODO0000754000176200001440000000733713013175506012040 0ustar liggesusersBUGS/ISSUES: * change the way 'better fit found' is handled in profiles. with try_harder, push through anyway ... otherwise stop WITH AN ERROR and give the user a utility function for how to proceed? *Don't* want to return an object with a different structure -- maybe attributes? * is there a way to (optionally?) save the environment of the call so that fits could be profiled after being removed from their original environments? (maybe fixed?) * consider "data-absent" flag for big data sets? * remove "quad" method, replace with confint.default [NO] * move calcslice from emdbook and make it more robust/general (different signatures: mle2 fits, numeric vectors) * prettier multi-parameter profiles a la Bates/lme4 * ggplot2 profiles? * fix confint plot to use linear interpolation when non-monotonic (done) * pass parameters through from confint to profile (done?) * nobs() methods * filter use.ginv properly * fix gradient with profile * work on vignette: ask MM/PD/BDR about mismatch between confint (approx) and profile plot (backspline) ... ? * DISABLE boundary warning when profiling ... * try to do something about rescaling when hessian is problematic? * add ginv for problematic hessians? (done) * implement 'subset' argument * check problems with optimizer="optimize" in tests/parscale.R * allow ICtab etc. to recognize optim(), optimize() fits (ASSUMING that the function was a NLL) * add optimizer() as alternative optimizer [DONE] * fix par mfrow resetting glitch on plotting profile * prettier profile plots (with lattice)? xyplot for profiles? * make sure numeric deriv modifications are working * incorporate optimx (done)? minpack.lm? * proper initialization of intercept-less parameter() entries * plot methods/fortify, a la ggplot2? * add deviance() method [need S3-to-S4 conversion] * make sure subset arg is really working! * spurious error on mismatched parameter names * spurious warnings in 1-parameter conf int: [FIXED] library(bbmle) m1 <- mle2(10~dbinom(prob=p,size=15),start=list(p=0.67)) c1 <- confint(m1) * do one-parameter profiles with optimize?? * use numDeriv library hessian() function instead of nlme::fdHess? (or use nlme::fdHess to avoid loading whole package?) [DONE] * turn off Hessian calculation for profile fits?? [maybe DONE by virtue of previous fix] * should print warning immediately if convergence fails * some weird stuff with returned fit from found-better-fit profile -- treating profiled value as fixed ... * replace approx() in confint() with backspline? general solution for non-monotonic profiles? BUG: order of parameters matters for L-BFGS-B (fixed) adjusting parameter vectors for lower, upper, parscale, ... when some params are fixed ... sort out names BS -- when can we safely remove names? TO DO: model-averaging? more documentation -- especially S4 methods! especially: profile plot profile confint catch/interpret more error messages? (try to filter last.warning?) add DIC to IC tabs? lmer? WISHLIST: start as FUNCTION (i.e., self-start) analytic derivatives relist subset plot.predict drop1, add1, etc. link functions ("identity","log", "logit", etc.) delta method standard error calcs tranformations on LHS of formula (i.e. use link rather than inverse-link function? only possible if link is known and invertible: inverse log logit (qlogis) probit (qnorm) etc. clean up/argue about data handling: closures etc. etc. etc... document argument handling: start must be a named vector or a named list [OR?? inherit from parnames(minuslogl)?] if start is not a list (i.e. a numeric vector) set vecpar TRUE convert start to a list if missing and default.start is TRUE use formals(minuslogl) bbmle/inst/0000755000176200001440000000000013175224072012313 5ustar liggesusersbbmle/inst/NEWS.Rd0000755000176200001440000003735013175477752013410 0ustar liggesusers\newcommand{\PR}{\Sexpr[results=rd]{tools:::Rd_expr_PR(#1)}} \name{NEWS} \title{bbmle News} \encoding{UTF-8} \section{Changes in version 1.0.20 (2017-10-30)}{ \subsection{BUG FIXES}{ \itemize{ \item fixed buglet: flipped profile plot axes, confint for negative values } } \subsection{USER-VISIBLE CHANGES}{ \itemize{ \item \code{summary.mle2} is now exported, for use by other packages \item small fixes to AIC(c) methods } } } \section{Changes in version 1.0.19 (2017-04-08)}{ \itemize{ \item fixed bug: evaluate \code{call$method} so that profiling/updating works within a function environment \item make AICtab smarter about NA values \item fix BIC bug (infinite recursion) \item hessian computation uses gradient function if provided \item basic continuation method implemented for profiling (with stubs for smarter methods) \item mle2 stores its calling environment for more flexibility when re-evaluating, e.g. in profiling (could lead to occasional surprises, e.g. if saving a fitted mle2 object with large objects in its calling environment) } } \section{Changes in version 1.0.18 (2016-02-11)}{ \itemize{ \item update slice functionality; allow for explicit ranges \item CRAN updates (import from base packages) } } \section{Changes in version 1.0.17 (2014-01-01)}{ \itemize{ \item new warning if ~dnorm is called with sd implicitly ==1 \item some internal tweaking to slice functionality \item updated to allow for \code{MuMIn} v 1.10.0 changes } } \section{Changes in version 1.0.16 (2014-01-01)}{ \itemize{ \item fix \code{mnames} behaviour \item slight vignette cleanup } } \section{Changes in version 1.0.15 (2013-11-20)}{ \itemize{ \item add \code{logLik} option to IC tables, more use of \code{nobs} methods \item minor improvements to \code{slice} functionality } } \section{Changes in version 1.0.14 (2013-08-24)}{ \itemize{ \item more CRAN tweaks } } \section{Changes in version 1.0.13 (2013-08-22)}{ \itemize{ \item .Rbuildignore tweaks for CRAN } } \section{Changes in version 1.0.12 (2013-08-22)}{ \itemize{ \item vignette tweaks \item add Depends: R>=3.0.0 } } \section{Changes in version 1.0.11 (2013-08-19)}{ \itemize{ \item add .Rbuildignore for CRAN tests } } \section{Changes in version 1.0.10 (2013-08-18)}{ \itemize{ \item adapt to updated optimx \item tweaks for CRAN compliance } } \section{Changes in version 1.0.9 (2013-06-23)}{ \itemize{ \item switch from aod to aods3 in vignettes \item switch vignette to knitr } } \section{Changes in version 1.0.8 (2013-04-23)}{ \itemize{ \item tweaks to \code{print.ICtab()} } } \section{Changes in version 1.0.7 }{ \itemize{ \item warn on convergence failure } } \section{Changes in version 1.0.6 }{ \itemize{ \item fixed (fairly obscure) bug in assigning data environment to gradient function; replace 'gr' in call with appropriately evaluated version } } \section{Changes in version 1.0.5.3 (2012-09-05)}{ \itemize{ \item changed some cat() to message() } } \section{Changes in version 1.0.5.2 (2012-07-29)}{ \itemize{ ======= \item add .Rbuildignore for CRAN tests } } \section{Changes in version 1.0.10 (2013-08-18)}{ \itemize{ \item adapt to updated optimx \item tweaks for CRAN compliance } } \section{Changes in version 1.0.9 (2013-06-23)}{ \itemize{ \item switch from aod to aods3 in vignettes \item switch vignette to knitr } } \section{Changes in version 1.0.8 (2013-04-23)}{ \itemize{ \item tweaks to \code{print.ICtab()} } } \section{Changes in version 1.0.7 }{ \itemize{ \item warn on convergence failure } } \section{Changes in version 1.0.6 }{ \itemize{ \item fixed (fairly obscure) bug in assigning data environment to gradient function; replace 'gr' in call with appropriately evaluated version } } \section{Changes in version 1.0.5.3 (2012-09-05)}{ \itemize{ \item changed some cat() to message() } } \section{Changes in version 1.0.5.2 (2012-07-29)}{ \itemize{ >>>>>>> .r116 \item remove BIC definitions (now unnecessary/should be adequately defined in core R) \item add explicit Depends: on stats4 \item note that development optimx (2012.05.24+) now fails on profiling when reduced model is 1-dimensional (i.e. for a 2-parameter model) } } \section{Changes in version 1.0.5.1 (2012-07-17)}{ \itemize{ \item remove spurious .RData file; version bump } } \section{Changes in version 1.0.5 (2012-05-15)}{ \itemize{ \item wrapped eigen() call to prevent failure of eigenvalue ratio summary when hessian is bad \item fix bug: forgot to export summary method for mle2 \item add \code{exclude.fixed} argument to \code{coef} method \item fix bug: single lower/upper parameter, or prof.lower/prof.upper parameter, not interpreted properly in profile/confint \item add and document \code{slice} methods: change from old (profile-like) behavior, old version is available as \code{sliceOld} \item DESCRIPTION/NAMESPACE fixes, move most Depends: to Imports: instead (except methods package) } } \section{Changes in version 1.0.4.2 (2012-02-25)}{ \itemize{ \item fix bug in gradient/vecpar/profiling interaction (Daniel Kaschek) \item improve (and document) uniroot method for confint: now respects box constraints \item fix issue where bobyqa (optimx) strips parameter names from result } } \section{Changes in version 1.0.4.1 (2012-01-27)}{ \itemize{ \item remove a bit of installed junk; vignette fix } } \section{Changes in version 1.0.4 (2012-01-02)}{ \itemize{ \item fix imports for latest version of R-devel } } \section{Changes in version 1.0.3}{ \itemize{ \item modified starting value code and documentation slightly: now allows per-parameter lists. Updated docs. \item Fixed bug that would screw things up if 'i' were used as a parameter. \item Update vignette to conform to MuMIn changes } } \section{Changes in version 1.0.2 (2011-09-07)}{ \itemize{ \item fixed buglet in detection of no-intercept models when setting starting values } } \section{Changes in version 1.0.1 (2011-08-04)}{ \itemize{ \item Turned off some warnings when skip.hessian=TRUE (e.g. in profile) \item Calculate max grad and Hessian eigenval ratio, add to "details" \item (Should add accessor methods) \item Fixed NAMESPACE to export methods etc etc properly; removed universal exportPattern directive } } \section{Changes in version 1.0.0 (2011-06-17)}{ \itemize{ \item mainly just a version bump for CRAN \item added tag for variables in profile/confint warnings \item lots more technical information in vignette about profiling algorithm }} \section{Changes in version 0.9.9 (2011-05-14)}{ \itemize{ \item changed NEWS to NEWS.Rd \item fixed bug for "optimize" -- profile etc. now respect bounds \item eliminated warning about bounds names if all identical \item add "try_harder" flag to profiling (ignore flat spots, NAs ...) }} \section{Changes in version 0.9.8}{ \itemize{ \item gradient functions work better with fixed parameters, hence with profiling \item profile plot reverts to linear for non-monotonic profile \item added warning in confint for non-monotonic profile, or for non-monotonic spline fit to monotonic profile; revert from spline+linear to linear approximation in this case \item various documentation improvements \item optimx improvements \item require data= argument when using formula interface \item turn off hessian computation in profile \item allow use of MASS::ginv }} \section{Changes in version 0.9.7}{ \itemize{ \item bug fix in calc_mle2_function for no-intercept models (thanks to Colin Kremer) \item fixed optimx, added 'user' option }} \section{Changes in version 0.9.6}{ \itemize{ \item changed hessian calculation to use numDeriv code (causes tiny changes to hessian results that could matter in edge cases). Too lazy to provide a backward compatibility mode ... \item documented optimizer= choices in ?mle2 }} \section{Changes in version 0.9.5.1}{ \itemize{ \item fixed bug in AICc (David Harris) }} \section{Changes in version 0.9.5}{ \itemize{ \item added NAMESPACE, various fixes to go with that \item beginnings of an RUnit testing framework \item tweaked vignette \item added prof.lower, prof.upper to profile() \item added "optimize" to list of allowed optimizers, some bug fixes }} \section{Changes in version 0.9.4.1}{ \itemize{ \item tweaked par() resetting in profile plots }} \section{Changes in version 0.9.4}{ \itemize{ \item more qAICc fixing }} \section{Changes in version 0.9.3 (2009-09-18)}{ \itemize{ \item tweaked handling of bounds: profile now succeeds on some 1D problems where it didn't before \item added deviance, residuals methods \item added newparams argument to predict, simulate; newdata argument to simulate \item added vignette (stub) \item added explicit params argument, to help sort out full parameter specifications when parameters is non-NULL }} \section{Changes in version 0.9.2 (2009-08-10)}{ \itemize{ \item fixed predict() for case with parameters \item added snorm \item changed ICtab defaults to weight=TRUE, base=FALSE, sort=TRUE }} \section{Changes in version 0.9.1}{ \itemize{ \item added simulate method (formula interface only) \item fix AICctab bug \item remove spurious cat/print in profile \item fix qAIC bug }} \section{Changes in version 0.9.0 (2008-08-26)}{ \itemize{ \item fix Tom Hobbs bug: named lower/upper/parscale/ndeps get rearranged properly, otherwise rearrange in order of "start" and issue a warning \item documentation tweak for S4 as.data.frame \item added sbeta to list of known distributions \item removed nlme requirement & auto-loading }} \section{Changes in version 0.8.9 (2008-08-04)}{ \itemize{ \item version bump, submit to CRAN \item added predict method }} \section{Changes in version 0.8.8 (2008-07-10)}{ \itemize{ \item added flexibility for profile plotting (main, x labels etc.); added examples \item added an instance of "namedrop" to fix naming problem \item added tol.newmin to slice etc. \item added check for numeric return from profile within confint \item fixed bugs in profile plotting when profile is restricted to a subset of variables \item added tests for par() to reset to original on exit \item improved profile documentation \item replicate std.err if specified in profile \item add as.data.frame \item tweak tol.newmin (better fit found during profile) code }} \section{Changes in version 0.8.7 (2008-05-12)}{ \itemize{ \item version bump, moved to R-forge. \item reordered NEWS file (most recent first) }} \section{Changes in version 0.8.6.1 (2008-03-22)}{ \itemize{ \item tweaked stop-on-better-fit code \item fixed (?) qAIC(c) methods }} \section{Changes in version 0.8.6 (2008-03-26)}{ \itemize{ \item tweak/fix to ICtab documentation (thanks to Tom Hobbs) \item added qAIC(c) methods (not working yet!) }} \section{Changes in version 0.8.5.1}{ \itemize{ \item oops. Fixed infelicity (bug?) in new environment manipulation }} \section{Changes in version 0.8.5}{ \itemize{ \item tweaked environment/data assignment to preserve original minuslogl environment better }} \section{Changes in version 0.8.4}{ \itemize{ \item changed plot.profile.mle2 options (added onepage etc., made plot.confstr=TRUE by default) }} \section{Changes in version 0.8.3}{ \itemize{ \item added warning about too-short lower/upper \item added documentation }} \section{Changes in version 0.8.2}{ \itemize{ \item fixed bug in AICctab \item cosmetic change to printing -- save call.orig \item moved ChangeLog to NEWS }} \section{Changes in version 0.8.1}{ \itemize{fixed (?) environment bug \item tried to use built-in relist, but failed: renamed relist to "relist2" (try again later) \item documented get.mnames (auxiliary function for ICtabs) \item started to add gr (gradient) capability -- NOT TESTED }} \section{Changes in version 0.8}{ \itemize{ \item changed ICtab to allow either ICtab(x,y,z) or ICtab(list(x,y,z)) (L <- list(...); if is.list(L[[1]]) && length(L)==1) }} \section{Changes in version 0.7.7}{ \itemize{ \item fix bug in profiling: all optim() methods EXCEPT L-BFGS-B. return the value of the objective function if given a function with no arguments/zero-length starting parameter vector (this is the situation with "profiling" a 1-D function). L-BFGS-B gives funky answers. added a check for this case. (may need to check behavior for alternate optimizers (nlm etc)) [this behavior triggered a "found better fit" error when profiling 1D functions with L-BFGS-B] \item changed behavior when finding better fit during profiling to return new parameters }} \section{Changes in version 0.7.6}{ \itemize{ \item tweak vignette \item fixed second major AICc bug (was fixed in mle2 method, but not in logLik method) }} \section{Changes in version 0.7.5}{ \itemize{ \item change "ll" to "LL" in examples for clarity \item tweaked anova reporting of models (wrap instead of truncating) \item added (undocumented) show.points option to profile plot to display actual locations of profile evaluation \item tweaked profile to behave better when profiling variables with constraints (upper, lower) \item moved vignette to inst/doc where it belongs \item ICtab hack to protect against package:aod definition of AIC(logLik) \item added submit stub \item tweaked slice.mle2-class docs for consistency \item fiddled with vignette \item preliminary code to allow non-monotonic profiles \item preliminary add nlm to list of optimizers (untested) \item add aod, Hmisc, emdbook to VignetteDepends and Suggests: }} \section{Changes in version 0.7}{ \itemize{ \item better df extraction in ICtab \item minor bug fix for AICc (allows AICc of nls objects) \item handle models with -1 in formula better: starting values set "all equal" \item made ANOVA formula line-length accessible \item added skip.hessian and trace arguments to mle2 \item messed around with BIC definition -- attempt at consistency with nlme \item added rudimentary support for nlminb, constrOptim \item nlme now required for fdHess (which is required for nlminb since it doesn't compute a finite-diff Hessian) }} \section{Changes in version 0.6}{ \itemize{ \item add experimental formula interface \item change all names from mle to mle2 to avoid confusion/conflicts \item with stats4 version of mle \item change internal structure of data evaluation \item worked on vignette \item added optimizer slot (stub) }} \section{Changes in version 0.5}{ \itemize{ \item fix AICc bug! (was deviance+2*k*(k+1)/(n-k-1), not AIC+2*k*(k+1)/(n-k-1)) }} \section{Changes in version 0.4}{ \itemize{ \item change AIC to AICc for corrections \item add AICtab for weights, delta, sort ... options \item expose error messages occuring within profile() \item uniroot tries harder to find a valid endpoint \item truncate terms in anova.mle at 80 characters }} \section{Changes in version 0.3}{ \itemize{ \item enhanced anova method, works with print.anova \item tweaked namedrop() code -- ?? }} \section{Changes in version 0.2}{ \itemize{ \item added parnames, parnames<- \item minor fix to allow "profiles" of 1-parameter models (skip fdHess call) \item minor change to print method for mle results \item tweaking "vecpar" (to allow parameter vectors in objective function) \item removed fdHess/nlme dependency } } bbmle/inst/vignetteData/0000755000176200001440000000000013013175513014726 5ustar liggesusersbbmle/inst/vignetteData/orob1.rda0000754000176200001440000000043013013175513016437 0ustar liggesusersm]O0u~0cho2wF 4٦{ӌɒ}|t{{h !$F  R•S X୺?8Op"EeVtIC1w NVoҮv%lG0 4w0<5ܴ4[湣Й&. >ۼ{7nGke{ W GK[xU"Y@t?qHs'%e˄eD7xKebbmle/inst/doc/0000755000176200001440000000000013175504420013056 5ustar liggesusersbbmle/inst/doc/mle2.Rnw0000754000176200001440000007541313022107177014420 0ustar liggesusers\documentclass{article} %\VignetteIndexEntry{Examples for enhanced mle code} %\VignettePackage{bbmle} %\VignetteDepends{Hmisc} %\VignetteDepends{emdbook} %\VignetteDepends{ggplot2} %\VignetteDepends{lattice} %\VignetteEngine{knitr::knitr} \usepackage[utf8]{inputenc} % for UTF-8/single quotes from sQuote() \usepackage[english]{babel} % for texi2dvi ~ bug \usepackage{graphicx} \usepackage{natbib} \usepackage{array} \usepackage{color} \usepackage[colorlinks=true,urlcolor=blue,bookmarks=true]{hyperref} \usepackage{url} \author{Ben Bolker} \title{Maximum likelihood estimation and analysis with the \code{bbmle} package} \newcommand{\code}[1]{{\tt #1}} \newcommand{\bbnote}[1]{\color{red} {\em #1} \color{black}} \date{\today} \begin{document} \bibliographystyle{chicago} %\bibliographystyle{plain} \maketitle \tableofcontents <>= if (require("knitr")) opts_chunk$set(fig.width=5,fig.height=5,tidy=FALSE,warning=FALSE,error=TRUE) @ <>= library(Hmisc) @ The \code{bbmle} package, designed to simplify maximum likelihood estimation and analysis in R, extends and modifies the \code{mle} function and class in the \code{stats4} package that comes with R by default. \code{mle} is in turn a wrapper around the \code{optim} function in base R. The maximum-likelihood-estimation function and class in \code{bbmle} are both called \code{mle2}, to avoid confusion and conflict with the original functions in the \code{stats4} package. The major differences between \code{mle} and \code{mle2} are: \begin{itemize} \item \code{mle2} is more robust, with additional warnings (e.g. if the Hessian can't be computed by finite differences, \code{mle2} returns a fit with a missing Hessian rather than stopping with an error) \item \code{mle2} uses a \code{data} argument to allow different data to be passed to the negative log-likelihood function \item \code{mle2} has a formula interface like that of (e.g.) \code{gls} in the \code{nlme} package. For relatively simple models the formula for the maximum likelihood can be written in-line, rather than defining a negative log-likelihood function. The formula interface also simplifies fitting models with categorical variables. Models fitted using the formula interface also have applicable \code{predict} and \code{simulate} methods. \item \code{bbmle} defines \code{anova}, \code{AIC}, \code{AICc}, and \code{BIC} methods for \code{mle2} objects, as well as \code{AICtab}, \code{BICtab}, \code{AICctab} functions for producing summary tables of information criteria for a set of models. \end{itemize} Other packages with similar functionality (extending GLMs in various ways) are \begin{itemize} \item on CRAN: \code{aods3} (overdispersed models such as beta-binomial); \code{vgam} (a wide range of models); \code{betareg} (beta regression); \code{pscl} (zero-inflated, hurdle models); \code{maxLik} (another general-purpose maximizer, with a different selection of optimizers) \item In Jim Lindsey's code repository (\url{http://popgen.unimaas.nl/~jlindsey/rcode.html}): \code{gnlr} and \code{gnlr3} \end{itemize} \section{Example: \emph{Orobanche}/overdispersed binomial} This example will use the classic data set on \emph{Orobanche} germination from \cite{Crowder1978} (you can also use \code{glm(...,family="quasibinomial")} or the \code{aods3} package to analyze these data). \subsection{Test basic fit to simulated beta-binomial data} First, generate a single beta-binomially distributed set of points as a simple test. Load the \code{emdbook} package to get functions for the beta-binomial distribution (random-deviate function \code{rbetabinom} --- these functions are also available in Jim Lindsey's \code{rmutil} package). <>= library(emdbook) @ Generate random deviates from a random beta-binomial: <>= set.seed(1001) x1 <- rbetabinom(n=1000,prob=0.1,size=50,theta=10) @ Load the package: <>= library(bbmle) @ Construct a simple negative log-likelihood function: <>= mtmp <- function(prob,size,theta) { -sum(dbetabinom(x1,prob,size,theta,log=TRUE)) } @ Fit the model --- use \code{data} to pass the \code{size} parameter (since it wasn't hard-coded in the \code{mtmp} function): <>= (m0 <- mle2(mtmp,start=list(prob=0.2,theta=9),data=list(size=50))) @ (here and below, I'm suppressing lots of warnings about {\tt NaNs produced}) The \code{summary} method for \code{mle2} objects shows the parameters; approximate standard errors (based on quadratic approximation to the curvature at the maximum likelihood estimate); and a test of the parameter difference from zero based on this standard error and on an assumption that the likelihood surface is quadratic (or equivalently that the sampling distribution of the estimated parameters is normal). <>= summary(m0) @ Construct the likelihood profile (you can apply \code{confint} directly to \code{m0}, but if you're going to work with the likelihood profile [e.g. plotting, or looking for confidence intervals at several different $\alpha$ values] then it is more efficient to compute the profile once): <>= p0 <- profile(m0) @ Compare the confidence interval estimates based on inverting a spline fit to the profile (the default); based on the quadratic approximation at the maximum likelihood estimate; and based on root-finding to find the exact point where the profile crosses the critical level. <>= confint(p0) confint(m0,method="quad") confint(m0,method="uniroot") @ All three types of confidence limits are similar. Plot the profiles: <>= par(mfrow=c(1,2)) plot(p0,plot.confstr=TRUE) @ By default, the plot method for likelihood profiles displays the square root of the the deviance difference (twice the difference in negative log-likelihood from the best fit), so it will be {\sf V}-shaped for cases where the quadratic approximation works well (as in this case). (For a better visual estimate of whether the profile is quadratic, use the \code{absVal=FALSE} option to the \code{plot} method.) You can also request confidence intervals calculated using \code{uniroot}, which may be more exact when the profile is not smooth enough to be modeled accurately by a spline. However, this method is also more sensitive to numeric problems. Instead of defining an explicit function for \code{minuslogl}, we can also use the formula interface. The formula interface assumes that the density function given (1) has \code{x} as its first argument (if the distribution is multivariate, then \code{x} should be a matrix of observations) and (2) has a \code{log} argument that will return the log-probability or log-probability density if \code{log=TRUE}. Some of the extended functionality (prediction etc.) depends on the existence of an \code{s}- variant function for the distribution that returns (at least) the mean and median as a function of the parameters (currently defined: \code{snorm}, \code{sbinom}, \code{sbeta}, \code{snbinom}, \code{spois}). <>= m0f <- mle2(x1~dbetabinom(prob,size=50,theta), start=list(prob=0.2,theta=9),data=data.frame(x1)) @ Note that you must specify the data via the \code{data} argument when using the formula interface. This may be slightly more unwieldy than just pulling the data from your workspace when you are doing simple things, but in the long run it makes tasks like predicting new responses much simpler. It's convenient to use the formula interface to try out likelihood estimation on the transformed parameters: <>= m0cf <- mle2(x1~dbetabinom(prob=plogis(lprob),size=50,theta=exp(ltheta)), start=list(lprob=0,ltheta=2),data=data.frame(x1)) confint(m0cf,method="uniroot") confint(m0cf,method="spline") @ In this case the answers from \code{uniroot} and \code{spline} (default) methods barely differ. \subsection{Real data (\emph{Orobanche}, \cite{Crowder1978})} Data are copied from the \code{aods3} package (but a copy is saved with the package to avoid depending on the \code{aods3} package): <>= load(system.file("vignetteData","orob1.rda",package="bbmle")) summary(orob1) @ Now construct a negative log-likelihood function that differentiates among groups: <>= ML1 <- function(prob1,prob2,prob3,theta,x) { prob <- c(prob1,prob2,prob3)[as.numeric(x$dilution)] size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } @ Results from \cite{Crowder1978}: <>= crowder.results <- matrix(c(0.132,0.871,0.839,78.424,0.027,0.028,0.032,-34.991, rep(NA,7),-34.829, rep(NA,7),-56.258), dimnames=list(c("prop diffs","full model","homog model"), c("prob1","prob2","prob3","theta","sd.prob1","sd.prob2","sd.prob3","NLL")), byrow=TRUE,nrow=3) latex(crowder.results,file="",table.env=FALSE,title="model") @ <>= (m1 <- mle2(ML1,start=list(prob1=0.5,prob2=0.5,prob3=0.5,theta=1), data=list(x=orob1))) @ Or: <>= ## would prefer ~dilution-1, but problems with starting values ... (m1B <- mle2(m~dbetabinom(prob,size=n,theta), param=list(prob~dilution), start=list(prob=0.5,theta=1), data=orob1)) @ The result warns us that the optimization has not converged; we also don't match Crowder's results for $\theta$ exactly. We can fix both of these problems by setting \code{parscale} appropriately. Since we don't bound $\theta$ (or below, $\sigma$) we get a fair number of warnings with this and the next few fitting and profiling attempts. We will ignore these for now, since the final results reached are reasonable (and match or nearly match Crowder's values); the appropriate, careful thing to do would be either to fit on a transformed scale where all real-valued parameter values were legal, or to use \code{method="L-BFGS-B"} (or \code{method="bobyqa"} with the \code{optimx} package) to bound the parameters appropriately. You can also use \code{suppressWarnings()} if you're sure you don't need to know about any warnings (beware: this will suppress \emph{all} warnings, those you weren't expecting as well as those you were \ldots) <>= opts_chunk$set(warning=FALSE) @ <>= (m2 <- mle2(ML1,start=as.list(coef(m1)), control=list(parscale=coef(m1)), data=list(x=orob1))) @ Calculate likelihood profile (restrict the upper limit of $\theta$, simply because it will make the picture below a little bit nicer): <>= p2 <- profile(m2,prof.upper=c(Inf,Inf,Inf,theta=2000)) @ Get the curvature-based parameter standard deviations (which Crowder used rather than computing likelihood profiles): <>= round(stdEr(m2),3) @ We are slightly off Crowder's numbers --- rounding error? Crowder also defines a variance (overdispersion) parameter $\sigma^2=1/(1+\theta)$. <>= sqrt(1/(1+coef(m2)["theta"])) @ Using the delta method (via the \code{deltavar} function in the \code{emdbook} package) to approximate the standard deviation of $\sigma$: <>= sqrt(deltavar(sqrt(1/(1+theta)),meanval=coef(m2)["theta"], vars="theta",Sigma=vcov(m2)[4,4])) @ Another way to fit in terms of $\sigma$ rather than $\theta$ is to compute $\theta=1/\sigma^2-1$ on the fly in a formula: <>= m2b <- mle2(m~dbetabinom(prob,size=n,theta=1/sigma^2-1), data=orob1, parameters=list(prob~dilution,sigma~1), start=list(prob=0.5,sigma=0.1)) ## ignore warnings (we haven't bothered to bound sigma<1) round(stdEr(m2b)["sigma"],3) p2b <- profile(m2b,prof.lower=c(-Inf,-Inf,-Inf,0)) @ As might be expected since the standard deviation of $\sigma$ is large, the quadratic approximation is poor: <>= r1 <- rbind(confint(p2)["theta",], confint(m2,method="quad")["theta",]) rownames(r1) <- c("spline","quad") r1 @ Plot the profile: <>= plot(p2,which="theta",plot.confstr=TRUE) @ What does the profile for $\sigma$ look like? <>= plot(p2b,which="sigma",plot.confstr=TRUE, show.points=TRUE) @ Now fit a homogeneous model: <>= ml0 <- function(prob,theta,x) { size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } m0 <- mle2(ml0,start=list(prob=0.5,theta=100), data=list(x=orob1)) @ The log-likelihood matches Crowder's result: <>= logLik(m0) @ It's easier to use the formula interface to specify all three of the models fitted by Crowder (homogeneous, probabilities differing by group, probabilities and overdispersion differing by group): <>= m0f <- mle2(m~dbetabinom(prob,size=n,theta), parameters=list(prob~1,theta~1), data=orob1, start=list(prob=0.5,theta=100)) m2f <- update(m0f, parameters=list(prob~dilution,theta~1), start=list(prob=0.5,theta=78.424)) m3f <- update(m0f, parameters=list(prob~dilution,theta~dilution), start=list(prob=0.5,theta=78.424)) @ \code{anova} runs a likelihood ratio test on nested models: <>= anova(m0f,m2f,m3f) @ The various \code{ICtab} commands produce tables of information criteria; by default the results are sorted and presented as $\Delta$IC; there are various options, including printing model weights. <>= AICtab(m0f,m2f,m3f,weights=TRUE) BICtab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) AICctab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) @ <>= opts_chunk$set(warning=FALSE) @ \section{Example: reed frog size predation} Data from an experiment by Vonesh \citep{VoneshBolker2005} <>= frogdat <- data.frame( size=rep(c(9,12,21,25,37),each=3), killed=c(0,2,1,3,4,5,rep(0,4),1,rep(0,4))) frogdat$initial <- rep(10,nrow(frogdat)) @ <>= library(ggplot2) @ <>= gg1 <- ggplot(frogdat,aes(x=size,y=killed))+geom_point()+ stat_sum(aes(size=..n..))+ labs(size="#")+scale_x_continuous(limits=c(0,40))+ scale_size(breaks=1:3) @ <>= m3 <- mle2(killed~dbinom(prob=c*(size/d)^g*exp(1-size/d), size=initial),data=frogdat,start=list(c=0.5,d=5,g=1)) pdat <- data.frame(size=1:40,initial=rep(10,40)) pdat1 <- data.frame(pdat,killed=predict(m3,newdata=pdat)) @ <>= m4 <- mle2(killed~dbinom(prob=c*((size/d)*exp(1-size/d))^g, size=initial),data=frogdat,start=list(c=0.5,d=5,g=1)) pdat2 <- data.frame(pdat,killed=predict(m4,newdata=pdat)) @ <>= gg1 + geom_line(data=pdat1,colour="red")+ geom_line(data=pdat2,colour="blue") @ <>= coef(m4) prof4 <- profile(m4) @ Three different ways to draw the profile: (1) Built-in method (base graphics): <>= plot(prof4) @ (2) Using \code{xyplot} from the \code{lattice} package: \setkeys{Gin}{width=\textwidth} <>= prof4_df <- as.data.frame(prof4) library(lattice) xyplot(abs(z)~focal|param,data=prof4_df, subset=abs(z)<3, type="b", xlab="", ylab=expression(paste(abs(z), " (square root of ",Delta," deviance)")), scale=list(x=list(relation="free")), layout=c(3,1)) @ (3) Using \code{ggplot} from the \code{ggplot2} package: <>= ss <-subset(prof4_df,abs(z)<3) ggplot(ss, aes(x=focal,y=abs(z)))+geom_line()+ geom_point()+ facet_grid(.~param,scale="free_x") @ \section*{Additions/enhancements/differences from \code{stats4::mle}} \begin{itemize} \item{\code{anova} method} \item{warnings on convergence failure} \item{more robust to non-positive-definite Hessian; can also specify \code{skip.hessian} to skip Hessian computation when it is problematic} \item{when profiling fails because better value is found, report new values} \item{can take named vectors as well as lists as starting parameter vectors} \item{added \code{AICc}, \code{BIC} definitions, \code{ICtab} functions} \item{added \code{"uniroot"} and \code{"quad"} options to \code{confint}} \item{more options for colors and line types etc etc. The old arguments are: <>= function (x, levels, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, absVal = TRUE, ...) {} @ The new one is: <>= function (x, levels, which=1:p, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, plot.confstr = FALSE, confstr = NULL, absVal = TRUE, add = FALSE, col.minval="green", lty.minval=2, col.conf="magenta", lty.conf=2, col.prof="blue", lty.prof=1, xlabs=nm, ylab="score", show.points=FALSE, main, xlim, ylim, ...) {} @ \code{which} selects (by character vector or numbers) which parameters to plot: \code{nseg} does nothing (even in the old version); \code{plot.confstr} turns on the labels for the confidence levels; \code{confstr} gives the labels; \code{add} specifies whether to add the profile to an existing plot; \code{col} and \code{lty} options specify the colors and line types for horizontal and vertical lines marking the minimum and confidence vals and the profile curve; \code{xlabs} gives a vector of x labels; \code{ylab} gives the y label; \code{show.points} specifies whether to show the raw points computed. } \item{\code{mle.options()}} \item{\code{data} argument} \item{handling of names in argument lists} \item{can use alternative optimizers (\code{nlminb}, \code{nlm}, \code{constrOptim}, \code{optimx}, \code{optimize})} \item{uses code from \code{numDeriv} package to compute Hessians rather than built-in optimizer code} \item{by default, uses \code{MASS::ginv} (generalized inverse) rather than \code{solve} to invert Hessian (more robust to positive-semidefinite Hessians \ldots)} \item{can use \code{vecpar=TRUE} (and \code{parnames()}) to use objective functions with parameters specified as vectors (for compatibility with \code{optim} etc.)} \end{itemize} \section{Newer stuff} \textbf{To do:} \begin{itemize} \item{use \code{predict}, \code{simulate} etc. to demonstrate different parametric bootstrap approaches to confidence and prediction intervals \begin{itemize} \item use \code{predict} to get means and standard deviations, use delta method? \item use \code{vcov}, assuming quadratic profiles, with \code{predict(\ldots,newparams=\ldots)} \item prediction intervals assuming no parameter uncertainty with \code{simulate} \item both together \ldots \end{itemize} } \end{itemize} \section{Technical details} \subsection{Profiling and confidence intervals} This section describes the algorithm for constructing profiles and confidence intervals, which is not otherwise documented anywhere except in the code. * indicates changes from the version in \code{stats4:::mle} \subsubsection{Estimating standard error} In order to construct the profile for a particular parameter, one needs an initial estimate of the scale over which to vary that parameter. The estimated standard error of the parameter based on the estimated curvature of the likelihood surface at the MLE is a good guess. \begin{itemize} \item if \code{std.err} is missing, extract the standard error from the summary coefficient table (ultimately computed from \code{sqrt(diag(inverse Hessian))} of the fit) \item * a user-set value of \code{std.err} overrides this behavior unless the value is specified as \code{NA} (in which case the estimate from the previous step is used) \item * if the standard error value is still \code{NA} (i.e. the user did not specify it and the value estimated from the Hessian is missing or \code{NA}) use \code{sqrt(1/diag(hessian))}. This represents a (fairly feeble) attempt to come up with a plausible number when the Hessian is not positive definite but still has positive diagonal entries \item if all else fails, stop and * print an error message that encourages the user to specify the values with \code{std.err} \end{itemize} There may be further tricks that would help guess the appropriate scale: for example, one could guess on the basis of a comparison between the parameter values and negative log-likelihoods at the starting and ending points of the fits. On the other hand, (a) this would take some effort and still be subject to failure for sufficiently pathological fits and (b) there is some value to forcing the user to take explicit, manual steps to remedy such problems, as they may be signs of poorly defined or buggy log-likelihood functions. \subsubsection{Profiling} Profiling is done on the basis of a constructed function that minimizes the negative log-likelihood for a fixed value of the focal parameter and returns the signed square-root of the deviance difference from the minimum (denoted by $z$). At the MLE $z=0$ by definition; it should never be $<0$ unless something has gone wrong with the original fit. The LRT significance cutoffs for $z$ are equal to the usual two-tailed normal distribution cutoffs (e.g. $\pm \approx 1.96$ for 95\% confidence regions). In each direction (decreasing and increasing from the MLE for the focal parameter): \begin{itemize} \item fix the focal parameter \item adjust control parameters etc. accordingly (e.g. remove the entry for the focal parameter so that the remaining control parameters match the non-fixed parameters) \item{controls on the profiling (which can be set manually, but for which there is not much guidance in the documentation): \begin{itemize} \item \code{zmax} Maximum $z$ to aim for. (Default: \code{sqrt(qchisq(1-alpha/2, p))}) The default maximum $\alpha$ (type~I error) is 0.01. \bbnote{I don't understand this criterion. It seems to expand the size of the univariate profile to match a cutoff for the multivariate confidence region of the model. The $\chi^2$ cutoff for deviance to get the $(1-\alpha)$ multivariate confidence region (i.e., on all $p$ of the parameters) would be \code{qchisq(1-alpha,p)} --- % representing a one-tailed test on the deviance. Taking the square root makes sense, since we are working with the square root of the deviance, but I don't understand (1) why we are expanding the region to allow for the multivariate confidence region (since we are computing univariate profiles) [you could at least argue that this is conservative, making the region a little bigger than it needs to be]; (2) why we are using $1-\alpha/2$ rather than $1-\alpha$. } For comparison, \code{MASS::profile.glm} (written by Bates and Venables in 1996, ported to R by BDR in 1998) uses \code{zmax}=\code{sqrt(qchisq(1-alpha,1))} \bbnote{(this makes more sense to me \ldots)}. On the other hand, the profiling code in \code{lme4a} (the \code{profile} method for \code{merMod}, in \code{profile.R}) uses \code{qchisq(1-alphamax, nptot)} \ldots \item \code{del} Step size (scaled by standard error) (Default: \code{zmax}/5.) Presumably (?) copied from \code{MASS::profile.glm}, which says (in \code{?profile.glm}): ``[d]efault value chosen to allow profiling at about 10 parameter values.'' \item \code{maxsteps} Maximum number of profiling steps to try in each direction. (Default: 100) \end{itemize} } \item While \verb+step 0])/df.residual) } ## ----dobdata------------------------------------------------------------- ## Dobson (1990) Page 93: Randomized Controlled Trial : counts <- c(18,17,15,20,10,20,25,13,12) outcome <- gl(3,1,9) treatment <- gl(3,3) ## ----fitdob-------------------------------------------------------------- glmOT.D93 <- glm(counts ~ outcome + treatment, family=poisson) glmO.D93 <- update(glmOT.D93, . ~ . - treatment) glmT.D93 <- update(glmOT.D93, . ~ . - outcome) glmX.D93 <- update(glmT.D93, . ~ . - treatment) glmQOT.D93 <- update(glmOT.D93, family=quasipoisson) glmQO.D93 <- update(glmO.D93, family=quasipoisson) glmQT.D93 <- update(glmT.D93, family=quasipoisson) glmQX.D93 <- update(glmX.D93, family=quasipoisson) ## ----dobll--------------------------------------------------------------- (sum(dpois(counts, lambda=exp(predict(glmOT.D93)),log=TRUE))) ## by hand (logLik(glmOT.D93)) ## from Poisson fit ## ----dobll2-------------------------------------------------------------- (-2*(logLik(glmT.D93)-logLik(glmOT.D93))) ## Poisson fit (deviance(glmT.D93)-deviance(glmOT.D93)) ## Poisson fit (deviance(glmQT.D93)-deviance(glmQOT.D93)) ## quasi-fit ## ----dobdisp------------------------------------------------------------- (dfun(glmOT.D93)) (sum(residuals(glmOT.D93,"pearson")^2)/glmOT.D93$df.residual) (summary(glmOT.D93)$dispersion) (summary(glmQOT.D93)$dispersion) ## ----bbmle--------------------------------------------------------------- library(bbmle) (qAIC(glmOT.D93,dispersion=dfun(glmOT.D93))) (qAICc(glmOT.D93,dispersion=dfun(glmOT.D93),nobs=length(counts))) ICtab(glmOT.D93,glmT.D93,glmO.D93,glmX.D93, dispersion=dfun(glmOT.D93),type="qAIC") ICtab(glmOT.D93,glmT.D93,glmO.D93,glmX.D93, dispersion=dfun(glmOT.D93), nobs=length(counts),type="qAICc") detach("package:bbmle") ## ----AICcmodavg---------------------------------------------------------- library(AICcmodavg) aictab(list(glmOT.D93,glmT.D93,glmO.D93,glmX.D93), modnames=c("OT","T","O","X"), c.hat=dfun(glmOT.D93)) detach("package:AICcmodavg") ## ----MuMin--------------------------------------------------------------- library(MuMIn); packageVersion("MuMIn") ## from ?QAIC x.quasipoisson <- function(...) { res <- quasipoisson(...) res$aic <- poisson(...)$aic res } glmQOT2.D93 <- update(glmOT.D93,family="x.quasipoisson", na.action=na.fail) (gg <- dredge(glmQOT2.D93,rank="QAIC", chat=dfun(glmOT.D93))) (ggc <- dredge(glmQOT2.D93,rank="QAICc",chat=dfun(glmOT.D93))) detach("package:MuMIn") bbmle/inst/doc/quasi.pdf0000644000176200001440000037763013175504417014721 0ustar liggesusers%PDF-1.5 % 11 0 obj << /Length 2727 /Filter /FlateDecode >> stream xڽkoܸŇ^ I.~Hc#i z؈#KrD0q!L)C t }5mCsrEhgTBYK<<`ezvПy!dx xz;4jhbw1U]М<"KPs[T뤶,eoOq멍[nk=՚]" ?pn:2Rl RT g^/"ΏQKUZTfs*%T7;1a.oo.#4iĻ?Ј+cqࢋCip7^J]]],ɬhy N]j%Du+0o셳@|b>. gR`T>}>OA cmFL1 &x^8eR^m4 4vm :ّ f:)tknCK !Dp|AGmz8p~{/p'`FX,1IZ6B՞8 ok]Q9 0p2kɫ[fUuf U"*&pI:At,wMf@ ܱ4ğ Tk3HjoqDq'TMu#>ذٰfcB0  ]m- 2)31!w@78TS]F!0NvN,5^4" _r|@ pwU4Uwp'ңOgTfLϚ%uc.:CmQџfn~j߰LMr{h~]ԳBc(_1 Ȍ٤zs+^gw6%#~IJhvq5& Z. p :zz7>=b'ϵ7qL]W'wISo9%$pǣ̾~lH>  QX1A9I g#R=YC*Pv⧞=/ma`j萶`ZGI8#_os/}^>jp$j= )&{k:JD tOsGu_$G\z,£ex_?uR|8Fb%>af_|[mp~,ҢͫrrN썮P۱+PUFv ,nk9I.I:"ֶ4m+ ;(3ncj)S&3a˪NkzQ}*`U - }O)>#qivFVN:=H^{N8uX_B_0W:Z&p̓.z /lG:}`ʀ̶SH|(]YJ<>2 {? %$U`I uZHRr+;k5龱E*Wk&+cS~c0Lp.=R _/^}=#e^ʍqٳʣhE/mbF<$Hr(:TAaIof)&T_||c}ƒ÷Wbs|2Pw'JZuP6}`Px c  l!yLq endstream endobj 4 0 obj << /Type /XObject /Subtype /Image /Width 88 /Height 31 /BitsPerComponent 8 /ColorSpace /DeviceRGB /SMask 24 0 R /Length 1462 /Filter /FlateDecode >> stream xNWq\4TM)}z*R*nZQDJHE%J+6>36r +^ > ctkf,fZ{OPxoKŕ7X#X8lbLYm|R/d6>SZ9_gIkޔgzeR nhL/T%o6[(-UAuFb.uTR ab4uu묉?Osue魻1uV3oQuo('M{+5`_w}仜}:Ia.rEP`@@p/\~5(+*?(z^ ܧ+ӎ>m^ʞzRWYL־ܷgܘjóۥ{ n)u;N'ϥ~Ǚ\rʯi +΄ژ㧏@^0\O #p|8[S[߳ D# endstream endobj 24 0 obj << /Type /XObject /Subtype /Image /Width 88 /Height 31 /BitsPerComponent 8 /ColorSpace /DeviceGray /Length 39 /Filter /FlateDecode >> stream x1 0ob+x!>  C2 endstream endobj 27 0 obj << /Length 1588 /Filter /FlateDecode >> stream x]o6=B@_.b`yt@QM>ȶG*MEIeHH"xw;ňqiZכyOBaJao~B`DX#af(3Ep"ȰlM@ bW:{DQ&$b$,O2nN^ffWL$b@Kŋ.IW,0m %Qεj6;SONw_GaG_bUlm[LҬP5dE Ӥ`M0 FoOިu:pˢUN7cHFXHB@ڦu zO<] $V7n!ECq?!ДS`Nu QGeUJfzv#͹Sڽҩ|RsyS2I:Utۥ]}i.Ox!e6*ʨ(=Q|q?|դZ2(rXA֓YQQ (,a|1QQtKg;|[ɏu[!t^l0AenJq8\L?LUp{*FRaN0_:϶'y;y; r&^jsry٧.8R5瑷hjWh(޼<3WԘaO-ZlIjXٶ3K8۪[p2RsZ (q$ꋄČr0_1VB pdMXȶLa 8:}\!# ־sb lx/8/VےTz ̍]Dx*+ oN\|! /IP) ;*4u1Ijle9 2)@C #yT ݰV7-+3^1EĬ0dPj""Ҝk7HчIK" cmicO[w6)sN ;}8a?yPI}ʞyzqA${0"қMQ0pA @>4w(ۗNUs!?X,(1, ,!AK/bl;.Sz}IL^pS{^$DQTݣ nz/q˕ʢf'126g=pQT 'G rԻ3:> stream xZo0_a{H6xN"@h*$%Y L(9w~wg`nHLvA QXIszhrM Jb"r罨 KK!*MLEƽE:nuSˌ6_G7d&R0 &=ؔcNCwoD{r܌G m(7,*(;tƟC 8`+j%kzz6L}R)5I]ja Жp3ס,uO#éqfV[U 2ݮwp80J{}I~{%a%IRl}C3aڴú4oIn1j33N=hOÕ:nN5MkLL}x!a6dH A<j~{nwFt}Wr/(;x;ʖL+Ν.C]aggMK:֋Ζ+gDtRzq5r_4t\Y0P`2^ؽ_U endstream endobj 39 0 obj << /Length 1318 /Filter /FlateDecode >> stream xko6CF_l  +F!r~oQlIYX4;(lG:sO R#V+>yZs)0}0-[J^>&I: k%p%v0ŕ빍AE HV&TѼm8Z*$)t!oua :rI5|hz(A mDA2~Bٔ<uf(n--=m,G.+ۘL}lvt>B/XWO檃PqJj~=Z P '݆j j$7""SfỮHsQЪr׬yl)0?r$=Teu-F*]kծc,8Y^qVR-B^ է^cXi,3jF1l(F\Fo;wP7]wZoE')[V/X8c?X>0{uVq4ćꋶm+%:*-AYXа܏܆<5FcSLfvU5U1XE&_GpYdeslKSee E#jV7EN r-C2yк >"%zv']ĉk Wˑ Dz> stream xr6_qJM,0LM393}H$o.ʤ";R{2$ayd41[ 8E|/;s>G9 ᅜI(<@: ǀƠf';Mp2Q< a4hoVJ"GuxuDv@O>ۧiq'%ɍދJp-1Q|utkFV*ٵ]O~9~7tudl!; = X9!aHH)0Ss=]f`7ne> o[ Jht/ OI7*MtNSqT?)[ x6=KMa¯cMvx6{ k!g^S|X! J ZFY⪯jJ ldj١vT{cmW>%/ךO-@[guS^UsȿvW]V"%RU{3YztUy%bYm[WG>;̈P@f]QW;:3.=N-*b:ymG|rɌk]Lf<ܾҝs*.xI8K7;뱆 4w϶k!# ivr SZHFn Sc46 ˞}OCL e#ޱ0o 4W&uX\ӷ_L}r-ia\՝j_B p#4/.&LoG2_eᳰ{YQbKBde€c-U'+UGg+[%÷Qdc]V,!|[ցɕFX1rYMXwH~W?ac8)4yn阾,6Va%:ZʂF80P뢚[0!2rc# RhQ>?W[Y[U /\{fP$eX+Z8;UٍV֢e+ 4NFKY͔vuI_. & ?Ӳm1;qkYA#AᙞO/B~vTv]B $WTTzB#­cS'vwU3 & Bxl#M^K NȰ=8k@ẴHYcqk/T#ׂa[?N<ۨy%'n"ύ0^vʺq@^)um)*`BKVdObE%B|0bdp6#!p[t![l1w[1m Q1X{f$|ψ 45&?/צ ҰnMޟ'[Ǩ+8`Z 4'΋54LdGcYƁL_X@C$ 4Nab|o5 L8>sW {+1 vG!h*"\P\0CBM88MXs1L}F,Y& @A5ĎHI sȞ퉱6'X# h֬+OЀ |ZđP4kz endstream endobj 58 0 obj << /Length1 1495 /Length2 7305 /Length3 0 /Length 8300 /Filter /FlateDecode >> stream xڍtT6tJ# KRK² Kw*-)!JH HH#zgϹkf~oٙu ([* '/ PV4 0v)o($@I K $Re' h07v%n~W ()); C!`$@s#(\2.R@?ٍx07 aR'`:ܽhƁC`H$tkt\`?Zx^@_rf*GNC (g00;/n|'~ PUo 8f$T C:2 ܻ:!Q^H,;8jhzԕܸb+ qj`rЀ`7~n`O -AAqH߸av7Gý7fy0( {@GjF<R; D’qQ@}YtOcNUsL~[5QMzIck3#[  _8a5bkgzHRzWPi0rjMoBLdQEH{IZw>F{ޤGɳF4x?.3[?\f(AFgFˈuD>85UfگuFdk;FzVRHsLuR XdDo]oaFK]-^8~)hG׶qIf:L}[W(*)^T%, E(Ss96D2J ׌?&܄V(BD(fHV.MEW zJƚ)Wo!'ʫ*E [◮eR.h}!A >š]vnI a[OTҝ.IFcݕJz[Ká8~2tWyx6DUam}vGa_C m>, ]ӓ5هD23V6H}W>a2R[APhqR7U-HT|ۜo+3PbJY \9@#56jCX ?uOK eAFtKsm/6rsCG$#0ܪH"B mIT,>Jp(B-ᗂ誔JwG$Vt0&:Ôu25'=;|)am :M咼[A]0)n`N#2UĩTq_VOf13aiCI۔z*{T-ȍ7ɲh7բ]~ۺOY-p^Tށ4a!*5ml{9ovqj뗍jZ:rYQO?neہ1!cL0ĠAw.FDG?"ɂ"(3o|uS .{db(,ߏwS~N sț'ȳO܏d|Ukc:wHshVZ78$ 8y1iٜFzʐ[iMnf3/硥2,k4saYR)T]^FG6![avMLpI+ͶX;'_"?Kb=mu+G20̮hQ}Oo HRyutrA!q] T{R{ȅvɇ3{zOZ&_ .,DERXWg=#pSmPk~1(b D6Ѿkz+'&]=Bh4!ijO[wP&Ҡ=+;akF݅}3tM 烑>}um_v"֮DIt`זuY$d$:dFkFNGsy 4QcXWnEe{6:!8>H 9ܣÃQ="R[ rJ>51.{'o :զD\ †hةN 0ȆC+-|C-Zi2"[_RObdNzD9-j:tbOO׽FW&H9?@Οbmpf$ ;X{n%gOqfe6^W=m1LPvHУo.UvǬ"f_[*mg;^yp` T\7( }%d*b:浘fCde_"W.GbDbCݓkǎ ܢ,쉪hïzևH-mIi\HOV$3K1><:1G>{sسp+~ RT7,0QYI'FBv v9 qYš5D^*G#l9ˢ,ͦnX3T*jԺ`-O&3BtH-"^yaUob`ǫ痄})}4 EyVCb Icl|"xLٷYrlUZźU}u@zu$֘bzVkSlj8>`K䓊w3 <76}X/׷:v#3-`gѧ-wBMc~kjYSA^:ۦ4nc|q%gm`PSƦq'O~R`G-؟dE4]IvY'C[ZKW=jhF|3t0[D_HT٪ld[ ֍DiTMDԬ˜rmt I^-X4gl @B&婪.Nxȇsb~v[׺e6xK+#/ؽYcl}^*LwaOVUˑ0W8K٩E*Cި@oݶMERK82'bO6?=&2R>?ƺM,v6wwQR^gyd݄=Cmn_3A(X@D8A5Bi<;(;dRR,MPFkv\=7"uҀa}ﰒ%܇L,LLwTc KIs:!G-F}v[Fv@(<ۏyOw%sEF1~Z^vrF{eƳ=Ƴ o^>i~=>Ч4$9pDtLnKOG@)w8pf]\%|5xgncɛF#f d03Է6Qm0~K83Y%fyʑh:7SUC܁;Vdهg=Ok1qja)PNХ \*X|bu͂e*A/f?^yxD|uP :|瘻#XJ9fz- {z]/=s <wWH;u"g"}5 ojTHtf"h_jH[Wd.@֠V?v|.]eׄD.#[o[ȑazX!XGıs(P?: 繞(e!"L)+7:aQ>bߒUMf&3gĸzI~dp?h[b ݐ5JhUdt(7r8722W0 ہoB]lYEv`cX'|لm &T&ft(fD4M|P1/4ӂMu;~;;A ZYnkXEOÔl2hА Q*Kyk;4SP ɼKko}e3MN@!:h7^X2)=ҏV~3%T/ $ (8y[ yf*mi)b+wxI达5);m\[;f7eyQڼJjD Mf~MD2ɉx2CkTqiNނkshBδóʂ '@p Éo+ly;3KBC{Ev,r6w6.{S]BMwk)MU0^lGDLțf!zb8pTQxSUĻfXWW@ z8V^ôb29TI:H7d0(UիdNeViÝ ;kV:o;կVmE]߶zgI+\G=ϴ3HUoM) {tY؜:eq.z]11Jڤ98]Mσ`qSl"XLM( XBѹڑp-P1f% x5f5Bq6];$T`^΂TAur.geQSvnFٞ`WKYri }w+u,RX[xo#gk ahу$eyífkvhuƕh٢c4:tw?WYjtߥT$՞;9qx H}I˰5MO!P>< ܒ ۏ-m=ҭˢчU+M M:_^6:n gr0 ƅOroeZRGƊ$ֲEdh[#FtPf{\dJuX(F`r=3t_O`e\^kYg 襜ڭK$6tt,Ⱦ~ǖ}qK-nsF${cɼQ;=|k$_5 wؽeg\hmL5#gهɧ2vrlJ  ,5LD82uSM>.+Π A6z@ew{^/L_tNb*W;KأX+]d'޶!5FT1'^ӻ? F/̣t'![grr{%O+S*@afh'.yTzYwUȔn۷7f0oFa儜C'r}v S.8XO) }.Xm*Āk9OՒM)by(Qi ;;6F:P-9P%,swۢs"V[ ^;[B *IR6.ym\f% Y/x}I nubدZ |bJIya$:E=c и5~7hp&DiK[Xbw7Z^A2jI!3?"\}NΗ2uJu[1љ^0*vR"ksI[stCs+ g&?|XY/*K0ggsG`۾ r9/}G7:svH^2>΢YFOѴCVi67-Ňx_btķE?(}7 UhY"|m"7 ZR^32.LH] {c>uɏvO;CgتUyݦT)ozϧ,¤h-O; c'}l8VP6G.巹[+,ٴ *ԧȉԖ#>"0,mEO^zX\zINMx {2~۳{N!3u ZX>SNT'-ֹoX }'> ϴA9eof&7(9$\\KaG^U)< ` ] -,{|Ac`%ֳ(dIyfz$W"?ֵעռ&^iXwl?e}oW.Av»Eta(x0#^,$ Mz>&樽qOɁэ o.q,CXؔ5>m<,SAފ2Yi] {ܕӂАۮLt̸x}|x*ysKpVX]=h6*XS tbl&u*_BU>^Z' ,G3{Мt"K+!UQ?XEA~$ic bzF->vݺ}'+w.b@AN{/(0jg;;u*$V>"}5(RyHF)顰 YXy̼Pt 7JiBbD( Vy$ĵj^LŦDp6 endstream endobj 60 0 obj << /Length1 2057 /Length2 8005 /Length3 0 /Length 9235 /Filter /FlateDecode >> stream xڍT6LRmtww4 ct#%!Htw(%%*-JJJ3{󜝳|1kqm pi`0 %`fև"!: !w(&GbD䭑H 8 ^0X@8B o hpĝYꃀ:8"Q `eqJȸ@P[k@qAuvmJ;" G8HsHG.~hZ@$`;B^epB`@詨\! }: ϿY lmk wq@a{3Dz#0pT5kvkEo+uI `vrp Ns>y(b:x?{PO"v "wDA`x:~qr4X]("=An  ?E<<;-`q~WG!a ހ`?_~3G-;-Uu 8WV Cu E-CUpS"q@?<<^ oM8j!0 mQo<2?#)z8; `;`u;H<4(75 vP Q29VuWzC촡H[_mZ8Cam;%>['ug\Vf )B^A5aCFj!PjxZq#Q)=Af $ @"!0@*"aO7t~#^H7E"~ֿo$P>[3<-Dupgu Dws QZ@n_|,{ TMY<<( ݨ9bm~ɟkeEQ]P!?gFq yQC{Q >@ATPG Au Yr[!bK05  {T 0_ɍ?A32[ҩ?X8%K^{Q!&zDBl4Cm`}{ئ&ݎU˺vUtJ31UCϖ{PokR DP}+щć5`x *CoqhV6̮G[UB<ѡ.\7ܒ"8$s"A2Znѷ K,k6T4+vp:gܳ+ŊC EjqX؇+5د[(,> !K$/V-x#{MU·O7/ӛ6Mr@қ Ƚo[EԢT%fF/ 3igxMvP+4jjhnkJT)0ԝ+9I2)`! 26\/˻3+RꥃNĩ3|aU1'3e"&Hʑӥ3-xEBy*Pet:q \WKw([^ \;b|غ-z$u{LUt;qc8uPJQɼYq54ܘR"+y@̣3ω{焈TZi;FƒǍ$=Ѡ> | X\ aG8Nwzv}rҳG'U8קzU{GeyzB]<7;EYi6'r5 ͣɉBe83SJJC |D[JK%DƊ\Nc!O<,+WצgN!o %{  0y3gP&E`X/8ԧ%p&a `S5WC TnŊA\*|^ /Rr2"9%}H~7uՒIrCqIJW"ש+/eK= }ו?$Z/H [jN"Tc#\<'A-0kc*էoEt4YS I&+ X (>xϔsV$˯^}jz|_)sfXE7uIyٚv^R @ڎ+q=9ӨRa =sy\+wpÕqE6Ms>K 3^DL܄m[t@%"G3PA"`%n%K^j67º>nYmoJ_QZʈΉ~%΂?N+d)BW1}M}@d7Vg]KYNCʾ\v[l1=mUSf_zb3N y?wm0b>IПh}YJOR7c!K5cHH&_>b^},c[WCr13mӃʓz\|^x܂ŗ)*/Z/v c ݧ?? &<⋿?jD~7wp؇-^7ĺ-- H.J[x1&úcVLv~Uy-OslSdV:݈4t͏)/A]j'{"eUs-M#dGfhسż7[ ZyVRboNLûӢ4Br'8S|%\藳<i3P#}; n|V,[K3RLb{+xdl@/p1/iS`t=o!xs8y(Fymij 46Td.#: дWmi6!"h>>w\[?n =@v{ w.\}<hx:c=>~T`_?Ы=9|'#OSDrsw9pQ4WoD4d8 9_]Oc+OZadrGA(=El?Gw-iʏdxP-x3-+Ђ RWir[X/{X8w6>t4C'00?z)xe lp2uDgCִh #}gہ0˦/hW/1 ﺜU ۆ_li4/:Y>1^9do9jv̔<mbc_꯼-wI>܉DCNҨރ>}(w<>𡏬u'l8.-u]i" d(,";TOP%Tt.&q}=JV OVag*p!y1`CixY*tjRoY? |suwxK2 nx^}ϱv< ]jw2[tnuv&Y_KW"a->?Iݼ5XHX92_0%ڸ0GCC;rدf+x]ȪѷSԳ{\}@١9SߥD/9xέ@ȹDɅ]¢¶;Snk]/7|xqؽaZ%5;KA1xKDzXY\+(Z5,-CDP6)fO?~w6"FeA>a\=!9-KjD-Xχيmj?^' B)]ͧn ^k}oSh`#:|Ԟ1`/%JH~J|9ҧR+<\%&pU^/<)R ؁C $!^@kęI^UG{eAMЈU/?-gњz;Cn5 KWֽ6ӿ [p53tԾKU,s''d(ْęSuF=E0|kH[bp}F;w=ޜMXW13mX"wO MQMh/stc(Ds05srtjn89L/W "9yhbs|1,̩- ټ `L{xe̲p5h'yZwQ{'@s9"{FNS:^B}V;Rz\]Ge ;3KH+ ǘZE/SQٯ9m|yc)sǰj7Lc>8$ Hdçv=Ƽn)~QYd8yHȼҕxBl eeǒ7FhcBW ]HK#3āN.5a~_N! ;ljD7S %M"KM>g{q4~y-ͨQkANYԨ>kr 7 K=%JoXRr)JnHm3Mh"s@-C ք_XѺ ƆHFbIV-rw^_~`:W΄]s`=֑K0hZIn=7\؍bv\fߞ8٭AI?:W'3t yiZT-"ޅc=+Xzl22sK :B#BYEa!` ٚĞcb,w%HW1u۬,$ y f]&I=`F^˄;eN6GׇvY0'rMOXP%` )P}IA;aY4*(X|J#)c7 ,LiYdXȫb15Rۮq"{!'9lSE9Ljh?-3jW˴1~|K:ؕ߉lQ-ax?ڹ !QL ɨ۟eohѱBOW$kɫ91-Cx`3u-X< F8Uˬn(=2♍tx-ͼgĪs'hpEXBZFwmC;_AY֨ͽ'˖"pYd;I_&.&3r#FhauJ'Qeۆpn.Lpڬ q1hhZ|JǠt=]#"~E"ѫc X⒲!`QJsdj*w,rml+|7 &[izΘImֽ3ʓSRKxׯ1 kN+?5ՀrKa'5QY֞wޤjUVTԞbG E쳖oLqψ@Q,eyiƖ7+ww ^X@/Uuo?0\z:0n][M\aDꑵfs̹dw![!;cC8C:ML¾ȹy>wlv'F10$y̪Kڙ)sOH@%I5:x'.f-jَ4CF5iݭ3ؗ7}n]S_k!H芳VS}ÖjЧm8:s Bc1C'~#a] ~ޔN?#%^`J:-tCaQGN^avHpk~s`cN zxMtOb=äᢔ{EOOT Xϴh-X[ãsvrF)PZt}=z1xviA6*o"*bzǩM>oJ{"FVX-F ?pT b iXRgJaבR&Mk77)o5(\齤cJkUaU KK[& 4+( hTg꧆K(sJ\?0A58pݯc/h; y]P8[kD=3$G+.İ=|XQ?h˓$[Ӭ$'ED,5G{Jk`in])R  )ky cn9ɟok1CEn )h=FI }=^R/r ]R Y-?kf<속 tAzyHmj%[ k12#D3N3K:Q:J,GUmjSk7A̢*%KtV^6 t:YO{p8Ợ7ÎurcQ;UbIaS=θp'wc<[<]0ɔ0UFF {\2wn! M <0VŴߘ~ˣj0m&9 ~YBWF%GwRm$S~xXyHX+waX%5k#S:~%,.wEs^NKrt)Gd|]=)8Lφ|/|)Z+,?#]9)6fO5󠄝`X-~Dc0M:t|. imԛwqZuՁL4+HQw~G|ҐvBZ&F̄%Z+?:1\PsiBNЋC H֓ۧ~{Vj2Lv{*Ȱq&XV 9w+:UTN+Ѷ:YoO3IY{X(Dj\?BPD]!\TA2p!if5em̳dz1+¶6۞*N*Xl r^ ^GVB;Y5=3qOo=5.nh^M͙gesD%kkc` ik*?~HI` V+zlb@PW{w>{*#ZyE՛Sfz Rws|} p)M2n] `~i4I H>MWL ʼ2^fE,qpx*knN MZѢxr[%\HT9wCvv;ײ\X[NUPJ0znݼ[=/N=%h$UOSΊj~_W4m@3ѡJX?#[$[9+oF6x& vyX|LB^?-8zz(3ajoEK $Oir`KәY.QMW9_&U&[Xʺ.Xb#=TJsW")ܙ4Wd{ oo e8+;ꉈ/q^Y~+vl m endstream endobj 62 0 obj << /Length1 1445 /Length2 6384 /Length3 0 /Length 7359 /Filter /FlateDecode >> stream xڍwT6 "̀gVa bfin;TCRB C{soZ3wxnPꆆ`(yy͑xWzJ^KDC : hFXZ@;r 0Q%:E:: u~`YYiU7 PqaH)x) qÉJO$ `!8d 4QJ^ ` Cp(8 T1ԟ::XtEJD`h7 D9( / !84!AB߭CZ&_p0,lj␮0!& vsC8_i ܽ D-9 Qp_00@ BW/:G  /Wso KMAcC鋃x x)Q8@H忳?eH/5@?0'[hhuJR_/2"b1I H_'7_GF]/_ko,a&7m@  ނ!?;zc!] hŠ F"nmCKr$],! Si!HYvg"u^-T~dwы[@?]M_(aygFqmԤѮj 1l;]ui5?F`u2 rQ٧rYYrsZwq^@/v7Y-]iڵLڔj 3NM)݁z=Q:?F>{7zZDzd`hGk3}S\)Kϻ!;0k>sʷ;DǎNfaOHaEƷ gSv>{(ӽNv8Ju _ZbRYvXQfZ٣ExФo>C0 ;5-zRS %VubtYNyIҠ{SkN[s×Y@3U-@Vͼ̪ϝ$L~~v\)P.мzZRNxԃL?^pnJ^͍+wb|nL,z*ARk8Q}0ewG[M ߜr? >sIHt;>tԿn},E&\沙ĝTt 91T!m4]W-r–|&OЋkQ ǘٛONJtW{j|SAïlAcT:1WluAj숳3$cܕu;J}[^zNГdZAJs%M16(_,ukHQ0x``3p1[|(w>|=[t_tQ,ۅ‚=ϊeKnsKAh#nf'H=}a}{evX*0uQK;w䙴pgKݸ^t/WDx \>.&P|}M碖\U#C 2 gUl{gu%䇂jLYpc#*DM>-k'?NNJGD_2®Ў;[-%^)/{p?Js&UUK\}=^vEPȢ]{Ϡ%Y ;3*iNq2Hh:~ܟh^s0p=5a@{g ,.~T/D9Gl9ն>AFU|,),*@Yb1K[o|RxJ:->I\;Hy/SxSyyOg.?z69W}M*3{Ab(ܖgqB&9 +fvȨ K+8oHlH(>!iM&c~N{\yzݔ:lXÄFv‡LPҨ g#E'Ҍ?"oʥ~bahp[9zպ;λk3JiE]]..UwƖF nWVpt9ACJI.OS[ZLnGzLIS4$iRoځO '<TϷ *CȩT'{]W .?/$ٱHyMe\,A6aVQd&me,u&f:DƧ+G%o.8j<b^jis\J'p|o%LJ|3RgZ||J/}ݺOs bqY'"͚̌:1wC"(̤FמyЬh6"m1v;{{vfk0#*1^I~/NՌ覇?{Jߚ b8yi frfsqތ=]n x*] !Ӵ~*BR ik*RꭥqbgTOr-j|ڬyR [}e~_V[2-Db)7".[\ϞsT̫,^D0)mRÚ2+0[ٝd՟2n>r.;W3ƒ:07ZյK&ͯyԳ'пUKuh~YHE|^}|ŹE ͇&D۱<Mn|lYUl2$Eq7ݶ\0'6:[WvO82kHDL լ[o~MDF20d'tPX-F ?$^_Rs+#^navde ٦W/>"ImXM7U9Go>j"=ĄO= P-៶5\e~OKMAp8p?rqjފle}$5c}x΃`_@C.fј߈J8z#.1ښN|7BKU+*1\hdy)3Og,/,E4X’͡;%W;KP*.]_^o=o$pXq]3Q-EtGX.]G1s{x~RCǡnV9" UG}p8B^n\ ]2HJmpvK~O*&t9.mG CGHV>hFaF_o5~H=E|3 fzJ8ƕA1qKFǻ {jտ=IlW>~sE>6@#\ېR*55,L<قRNX NDq^2x9H3cyhAT煬|~5qkv6_^T!ֆG},k #A FAb,*UeL_/:AvrMե27ME%Ey f nxA S^\gW}Y{Ci3,/'`uDe$#b*&í:Y>#G&UAX-(}0V15TqW]q[/i̵%v뽊4?ҫǍeUP-{ߧV}YnA· lj` YqWxcJ;fnycwl_uy';MyTwH{+s,{Q)xD^nWX~$w7˩E +ǘαZN>vNjfl|-qwՋR('+-%qB7 )^*s( 5V] ddžv,摙dxT)xS:/+ZNy*Of@s9t2mWZZ VSpJm{]Cjѝ[-|A2#ne/uYIיּe~ >U6 64,<*)G99㵘CvEʺgOh%C$4??4hU5̋[1WJ,0*b,USa0}87 Qc/$Oia.rf BX|BY ^Nׯo1e~S{yESvfk OntO{f"`YQ\)6*XJ53w6_͌d2xydByA`u;v6mP AaDY{h%dZ+ЦjYJ?x2<@rŒo]1-W*=/< &Ծ+*ॽ£`OML6\9HdJ_`Xd'W12,xnqafErN!W&~٦6nqhPjV9rPjj{r4TFSnԱKQ鈯ɗt0 KS-+cyW4E<ɹ4ʈbhx0@V s* ELvl?I`n˴ ^d AvjVQB̠Mo3W1S_N{:H7fl*tǣQ9H~tUጼI>)r:>+X.Z3x98fhvkyP2DZ. T@MmQwg17Y |#uW|}ygDcWD2[D*ls*{_F޿=' }c;̥q~ģQp(ki &`܌\ڢTguo<{.~rMoF|\TʚXXfCRlvxͰ鷌CZ,2`n7{}&P].5+E^rgsn0Q(V{}o_mZ$ɵwqzR[ĕgg(#=^<\5Zhz GuHe};[KKdb&RW| )MtO4#c?;Fۼ?`z^}jWq94d Fr#1 ;7U C9&VB\c 9AޏWFwH Kآ.v.{lÊkk BA\hR+K"+,"* JzR endstream endobj 64 0 obj << /Length1 2427 /Length2 19365 /Length3 0 /Length 20772 /Filter /FlateDecode >> stream xڌPAwwwww4N @-;ww=dfުs*U#$UQgp4J9:YXj,v&6JJ 1с_.@SЛLfsXXXXl,,1ttHXr@WJqG'/+k[ИXyyr]lM k[DsS; ?4 3+-d P]܁LWƄ@ аq[h 0uv6@77 -8@]VtXo?2D69;;:x8X,me)&'``MRӷ) jcD4o]tw:\~'a4kߓ}q]PV7daae@Osk^No89:,ߊXCq5u@.n@?+!,lA371o6|O>X~/÷ptc|%T:11GO# {ɸ~/ܿe,ּZs2@͟7`d1rYV&$fg/Uvq8_SmߧqZYy:X6R6@ ;)8U]m~?6Ʒ{P\f vORqrL]\LF8>ojkL7[y~KG0/Y򿈛,e .`V/ySX̪Y0kAoZ[fEozgemq۸[ڽu?b7sGGC{o@7pv{[?NoZo6b wtsݛտ[s/7Ϳ[Sm_+9\V_$?bȜ޾Gv@K)?ҿ_߲vz{+51Fn@׿鿳g-t-' ;FGHט_a}9mw85"7W?XW+[V¾= k䭙 9q _-3-ᛷ_s7B}@O9¬9muh];Q)mϴ> .n(ɴk.7h˛4"$>5M͏Oj8c?z 5Dv|}C6uvAQy-di8|v[uKd1FAP4eY  uf #gD.(Go-~{k;>5^OQrg@I2C2#[FZC}WBVn2 ]/VbUq= 2vEq4&=hRlF6pw+`Y0ye`6{ `ga&<=+=Sj[F0 y Rz5zvo.iN!!o*5v:l I؋D!asCVk{| +ӉVfsWUҭhƑڠ~nR1#}G2H_ܡys]ӤE!ntkB|iP"+AI]#/`8/QЅ_(>U )m%2sg ܸu^@읺ruɑMҡM 2B?4Hx*ҹ5AQ/Q 5Uӽa(1rVv,#@~1uB=lbwɧrWUkRAv]p5 H'IO[ ]+7N9A4΅OnT`!ɀ-"s56Ȼ?kAۤȀʪ'ng_͉) ֜O v89I3oeTx1&`Y#*PWe>݇k /i &ﱏR0v%drB@y-Ob~ZqPK6 yAj8 8R1}%*YL{ PwPGu"q.Ts+5T^Cr N/!.։ n8qM|nq"\2k*#ƕ9#Xzt%[}1̜}VJTqZF"P1ʕmZxxJgCìr EȤ4?ǷiYwd-MŬ6̤ z7Peŭn8k4\qp@-7Ko~VU$]I-ZQBV*Qt/;./9ORʵۇ*#ʱxv_vktjFǷCڿ^әmm&Ͳ :xEe fr.s=7V@ne%YHNcL_<% 5p bY)V)?=A'>4 d^"6arct@bQ$z̉Ve7K7K!3 J抵\O~ϮڬRc'{kZO-E,2CroB',"&1 eݠ "JS_키h`?*]F}_U`< i%J[^ff(f k7^ZO&aZ_[)UG UZ7&C(JZ&[nUxxb\y#M6ˈ\ ]ID`,C2W¨8<0w(ٴO1=Vzy^n)0\afUQ >r @5]ɲy̞IH~:&yOpjiG.O=Ǻ@yBy+Q)pM/G/ϦCgPe>RW 멊.(ndrwS=Z:d!URO/vitSL1;;$C) Ѥ T#*Kծ-0[t896Qjdqܴ#3Ek2Vg元$]Z`cO,"8I9v^) ⺙Sg *P vH5<{L)u}^E!$ż#r¯؄ݧ[` .["tM#,EYy,"qoKx@9O'Ir'e߫J FZY{8)\3Տ S =~_&B$c\|ڹ%c@6Usǚ2vlΩt[$-,|Y yUgEsU쉭ʀ/Ivi#Q5¢|*ŏrط.VV3"R3y8wN7Sjmd 4 3 ]@#m~zBߪIɡ6a`֬N#Z.0H6>iA\d%a9Mi$ͨ* mcddP럍?ƄrH^,b ]ױLR߀ gS)>Km{x]}ms ?:>5Q5JV˳G$ h3Dlq_{ Ƴl4l8w[nA ;qDnA*s\dAV7:};W.b:"{\`hT-qp@uIS\K۵4j%R8U{K0A:|tvO: . 7]4/Og^ YpD!(0,k.P@~9Մn2`]˸e PTѕ.'慊!4*É LXY!@ˌB 친)8>[Q7>|Ѯ*\`w1Gk9%aRW/eSLD]*E% ƃ%LhUUsiZ&Jղw>EmN :%lLe/fK?áo}d)eԖ$:ښ~O7 ݵ1Fs#}2m2p#$u{գr y(A %KAixDC"exYkḌki.>/̍;.A4Q>Wn<]Ot$}|*8dg4o}$$ck"e2 ܹ˟yp&]&Cx(vdžO"M9{O$<#moQ/ywHvX'cv0bqM#!/@%:vAru{,;)["9 ˱ jLԁ}L#ꛝ v^O$x܉8_tgUHqKg.~{D1F|Y8CXPZi(!CcYbkMAPn(rxo2o4(-Y w %|*Zn)n=seuhCmHS̢1Z QtXǀEdZ?d1ƫ?] +ޭ!_lCa5Xι/,Mk-Baly5q;EXgGn }w=L֟v w}&nw"PߏHg#j{ޝ0g{M%`>*R2 _ji[ v$Y(Ԅo񞸴:1݊sʝHyZi(>@ou!fQ$>%c"ݨcYXY !a[舶72M!.LlG"\M wu-=U ȍױGz̅o:G)hLHǻԹQu+Om&DKw"66a,b^(mSpWh _+WH}-<9µВVeq.nP\5pnwPb-#=#gOq^DȖV@dK%Ru/܌ojSDKT?nFh%3 I*~QdS-7S(RϷFӉDij `diW՞Yf $$|%fK xXf<דL"ՠN|OF!ڍӜZ@{HN64ݼq)~4%"jL(*% 鑫qva cyS]WDXu*ڳ0AR֟h@CO09x=3 F)5Hb_U""ƨAk;o[& A//8M>JgxvĄ@jfFS$EJj΢q".= h?B |㥓eÙ5 dž;e\=pےʴ^VY+A ~,|-?Œv[%/hXƎuC,lquDflI@IV:S лv ڭ0SUhY2cR)~iL[?~VE|\2 E{T_!P-DoKvyD {'B%as*ce1uN𻐎1%d]ݙ?4[V̊{`h(=`bG}L 3R"u).(uIgh 6@~ʔ  gğ[.PV)-^~1>9,y6?.݁[A|=X-5!?g/a#R@qgQe>>oND`66$p.#>C~\ꆗ*ƛ8Aj5-NJjQʎ\%LDHwRDqw˗)Aóa;  yC2bfS,$%iPJR-W[w=^2Á[ (8Tu=9`69//WANiD׺_u1MBM['AkBIjܾIv0XEDѢ^f&2r~LPq{JWyҰ@i4XeL[YER4_.ѽ-VfJ's2s H J"P;6sR?sT;p+!§<>?GM^KJ'V&OfR fC5`w {61K!F8קY/xP,}x[D :ufO?җ5lNtU!ux )_MfyWab-t֊d I`>U[(Lg R~ed a'TEIKqS EP"/ qD*IF0zsY}tb{r}+Gء >g1;q5v-C ]BRȷ<Xu8(,T:歽0C'h YH[j;@]5 &;~mp (|)"(|ߞ"I1)tH:_Kmw4_t ߐJbTY4g$i>7n,|1yUW~Fg|M0EN~5dږr+.B%|U^ $dk:[3^ܥr'*)n٨Wwt r8VtXJ'X!UX(.vf# d^=AwHcmP ^@f'/- |'tA#Oy,]R.-ɨtSNhoڲ1Gpr#_޺Tߠc;cqYkO?H˥ \{Lk˿h%pU_54H?鳓jwIl4C84hEWX#%\n;3)v.Ci+mJ֒twi2.KLq%kO^qm/(ǵtn NӛESʠͭae ~PF/AnU@$l)PiWxo ACq㢧7TɱuTH%|~ѵN|TIQ?]KQm6oF!J0,ٌ$QU7T:ZP9Jͣl(Z^06 ^StY$4!ܴؖ(k$}̡u8m*Id959^Xr]hPʷ>vYԌ8wǂp:5TEq&Y(-&~;!RnDELKSuIf\[TqνܫK3RWd[Ѻ8bR B*  ʴ2PX}N~"@@8Oj|DVcL@W@R|M?2}AYQ j:w˶,(<#lUU/ց0j}5f ) D{u>Ÿ!_eP=b3\Q ܩ 7 CV;n-TE#ΗFRgga(`wK,m |0#CY(wcx]hS&ow^ќߙUs [1KS]_a%;OsŞO@ 6R$ ^ܳ6x%&9r8~w5&D!y7G!zƃ {[ 9%pp|Ã[o k ւar2k=C K2z束]CR8%J UX\X:uZo0 4,@! L>K-9|2Oո)$b+~x>N mV"KHJ}Qp ^̶=rUqL꧹wC}ۓ@6P)6})5:Ą$f E[iN_Ŀ}@>ŀex<%P:q:$bMM."Fm.{9D͠E'ӖYwjQp6N!89'ƍ/wlǥϮ.,)+_-{gё1}0QrуQ5:sqfᴏm3Z#G4}EDi=riuWʇzJJRe/z.TP2 ފ,fj! wu`߫0 s3x[zV4؊X܍$WKDo_y۔<57_qQk"7p+&DUg7NmH1/&!MܞI\ 8 t~9~ܤj(C&Gr]&vFBDNY~ϙ1ChzAJH1O*&1aw>4-Cq }jmY~&6ߒĝk[T%2Ù+9K&fZR|R`j=GSdfc)aZ֚˜m^ieIP)Èlߵ1}T%[g ϿsʮtoQ7pj lcB .P6 PU1+u!CSa/~Y%Г6=9ΞؗNߺ)?: TƉ؎=O!Z܉( UM{5*Y [-ӫ@v1\_ cvO$"vBt^3oxp1@300@ EzCE]_Ҥ}xbu'J!?Ϸ*V >:A A"EAzK=!x~C4˩o3 !2j5a ?MpmLiO~X/cMLZc4퇾>[^:5Lɐ3ڏًD^-#kDt`hU+IOkݥǣHK뚖 Sͭapz i>=t \t@ .(йS%|Yh1~*LjsT T8`_-Ձ(>^nЏOd"~:;Q]iž.kԫ/r5Z8څi%zTǎ?/+X ϶p0pa OIe#lȬBog-ҰT8r%=|oP1 WQkgXðg۵ntݠG a=\Z& I޼8tu@κX7-I>vZ KS>Tp Gֳ\Vbof{&Eɖ_Q$L=4ovrC;u̱T{ -Wd-jnl!fQWKʼ^.e@~5nJG^X'gdЯ pSմDh%U!e}m %NC `/:qln1cN|:i&9Dɫ7!+{.^ނ+Xew/'*F/v? ]U\CH 4H`U|v&6y^HeUSmx!Ş`y=(0FYlZ\n_0YlhӘbbVTwM m>r)/6Xѱ@iJIJ!78RqbZ,.yS52kvS7eF/I)qϬنq4ȰFMVrXXw$~2.K9dt51\5^b|)^5h >Bm?_7dئɄ˱CJa1b3B;E>ڕHS;D.6Eɨ{/'Q :ۅ9IJ`|^0 u}U'S8XԳ_h24bS.G⎳(@Fu(q/-.vŚA>QX)T5bg9]Ч0 ^Vd*0:E C<o7|R d:N)gdtFP"sFJ5%o18Z7B“!k[OlX Jǃ޳72CwR2eG:kY! ~t0qMm/y0a 硎vS-1M8;3XRq[d+TC!U,ei6llo5 ]|{7%'>A!ۚIu&.+'F'ٖ< /X[ π̖)13p<\,_cJWy1.ALnKit=.3mc: yO(KҴȕ(Ӻ#5- )Dda yˀ?΁ʺҨTFUs), vZejl bʕ2^vpF8`7˦{a{/\Oͥ>8+ف8g }rD ,ZU^ tw%Abpz{cWJ|8/Эljj<Ɏ%K#H*'Uj_ XqBM{Yj3Y#VVeg:G~czO ՚@AyЋvD&5J>o%ASXOYGfMotx>|qz^\DF_4)EwRtw~ 2oܺZYE4VƂq-~X'VL[GKLz;xhZSLSװt /츸qsvlSFFb]`7s8:\,u5ޣ<^0V' y?0Vʕ^hB(dV8zܽ@$t5JxՄ`S#܈N(c; ( <7\kveOymOb06%N%Ġ_lhU?dbZ9EՂ7V t6!}<_X@n[$ʐslw]gh:#:;3,([B ̓>"FJ+<C 0R&BSU&zS ۓT_p#L׋O-> +}uJ8ߚD<KoS·M>|l*s 'h棇DT,٢6L MsLXWY&̈́p5tbFO񸝳ZVݺND_ANU:V:ANz{Q炙.O$Paev&6|:|>37b30j1 >$ֵ5*J6,[ǟݏ Ćjvٱh~ĺMzo+WEgׅBLT30u!ܼ7ЈߋFO[y [GkO t K'&o0:~y#WtQͿ>~8k?0ǟTZj-@c*ĩ šuS릋lwF@txM/dP=˰ W%缂}J¹JeKo7e' ƮYռaRJ8U;H #*C{g]]ҥPaUvZ{[k#> Q8mp#($,l^{p5+k%#Mĸ;3ڗ1h%_ h-n/R(>sElO^,{砏ogD~K6gxx VHdi|6^If/-N^@өހ~mjV/mLr;tS ]x٘Ջޯ_ >':i8/j;}9ŐiӰ+Nx\3ceo~4B+7Q4'`?ABn"őzR͐0ڽҧwl%te,T̟j=19E0%20>/ *tda‚*kI /# Zh-S$%aƘ`Nt+Lw>{w%Yg2ILU39g%Bh݋RS3WܘxxKL,KXvT(rˀ8+$GP^]4cvWk#gu{eFϥ>Zu j n ߑ@W&ڀm9Xf#Yy`i ҇wNZDq:U^psے]%Ƞ FY球c|tt?Cf[ϛghSxqƛYeZ{d"ybLsrufy{XH8?;?lG7##]ca}[<*au|N?8K=%Rtn,/ ظΞ24 ps{_e K6`4ąϝ^ўvJBT.@L(n4-TM5TWǒՕ.V7ɤ 7Ś(لdM6vJ ix}K$w*jrusϫ}Mb 0Akv>a5 s^bG[MGKd 3Y%س]D;lJלfx JT&L/Wᴔ6V\Tą6qC5)9z?%f1!S7tEw],Fڻ=!If- |T,b5M6eH|Ai$3QܔPu(얚Dw* w1r>O5ͼG+ &mjTm"E7F@bozszv%h\7x o>`ytɆ]G*7ghsaFj6 u7W_a\SVU }uGĮ <|kQ 0ɛywdWm]b@wI{O]j"{74DBfiΛM ҕĽ71`*MUHiU4):o5VXB]<g4L=M@1N%qkM!gn"aLmU3OgAP ?#tU*wn <ArTǣC װκ/D/-:ANz u˨`|yf61\SgSM8bLF݀*8O*j׹r,ݏ6A\tϓxFL$G NXhB~ $Z,کyVL˭dn䷥eUK6.tdߙЖcsos(_m ;f|{ҺI$ƬV u, e dϻlcb\ ݤliaVhOz~Y!G'pyzBM|:seյTq3Gh>gMֳ$V[v&k6W-y {8]}׉fe,WE~ݢ1  "V:ۜABf@>F`}B<,Q}rg{K:"0S6>+X\6?gygGt؍L;#u3ͺL3;MVuf=?U]D~*B=h\{Uhi8 Jhɽ.=/)mПH(=W[ 6v4S5,I-s|.mLAp8AԀ!E vVeC(F,n4i GsX!Kj kΟ c|7."}5#J&?麹*%NEA%'kŋO*JHU`/k/@noVMڱ6$]lj8tLXyA,vf$e]w2g@wmgZ45 +)y0^~W f 3C%'VС(\&q>BC(0/Bw".-b#$Qjn 7Dž +名ubEI52mkNmb0B?gMe'4Mw3|SXX ~]i ̝ydTE7&I3$ )J-;)L/=P r7" @9"ƒ=U\'Ą[G:8tڵ4aLubkaj>y/֞z}czرxczZ`uQFؼr~k+l8=> w8#R0%6b0fU'D LXngc.TT 7`K8 nN$sNG8FS E6`0q_,Vhb |IHwzR@@H>-e7]ro<Uz'dsYmvL5NмR,S@8wϯq#$s@ "Z?Ϸ}EN_Zsefrְ1uU }fsߍ(C4G"wIF ˤmo .%XVFdIaǀ{^9JxVpBv곩j>Lhb,xSP3|Z;1_2 η髰qav]0ȯ fK y؄H4{y>s60m!b!#ZzzaR1 @-AdD&.~ g>Lu&; kgf'z\xVh 5=#xEXz{2CRK}"r\_: ](PU>-hp$w֨lɯf[LP6֕[ f"{#k*t?Aod86EL\;uo/S^ 'Ec:J4!O^wמx.J/PD_3wR$' !@hɠiG]1Yʑ&] D (^ % $ҷk FV3`ɝ.x,m.4R3iIZ鿘OW OcxzFm%-N3T 画Pٻ|r (c,<:)As+-v$%@`7o589S^r<8<:"r9Hn endstream endobj 66 0 obj << /Length1 1633 /Length2 8402 /Length3 0 /Length 9461 /Filter /FlateDecode >> stream xڍT5LHw"K,tIw ,..tJt ")t(-‹}svwf9$5 uEW)+l+ί)@뻱{q0'O E݅}QQrgq@0 AZ*cwޑAm!w?8>` wjAa8TsCl.ELw}gv'/8TVP1998+$  U^m0ϳ)p7hx ?7;)C()?SHww;C)n+4w_Mր@ݝ7Yc*Am;Aam+['vo֎w]A-ap_{'N^ GnAm nw);z~[8׍~~[~-q1?]oKXκI;Ceesa;,wt O=t p]77ջ;7?vG ޙߊ_G ABqCjCTznf6z볈p$J ZC|M!ZT8Yb+5I"Awr gab`l]?=6̎g-y Hx)#˖GuvDp˦xc ̰[eR=t㥿Er$9>M;~˨#Tc.{1Z/EBmBE~F2:#J9SZMpNp;6gcࠦG'Sy8ѹ)S8pEu r,bʣrow_ybqsړ1zAulv1Z54X*ҷt|˪ [g^AzOExmr9Zg:w\mQSX$w[Srpi_PeӻoŠaNkj0˙Y#&YA٭lUEXqc؋&1w $7a'F='coO y4IMrcAd7%j\ߔpBn}z#Kes דGBzT6oT{Q(q8d |.xbQCŧWkG|+Jμ{qh)OiG*ZۮEm}CJvս_)0~&%^:kD_nƱ XFR_a@;x3MF0t9i fM}5םN&#"SϤo3&YT\dcAE,ͮ6Xx4ҜqyfLn/l _z0Ѯx v|3L"ķM~“.Y?xinp[yĞ۞%7S{8BJ˖qoISN6S}XnٕuLh}73q! zr``i#Id>C[pqa"7d4S/+`3alzIv0ΧrS^ח!􅣵^4>A1"}9#iriq*4XC/h~ց"KXn_ʈ ܢHkDc̙gw)FxJ%V"VH 2okȟ΍bk>rY@|D\o yq2GzیN昣~KeZ' ejn^a5FyjD!״9r9aU=L)|̟T$ b:sn۠|Gwk%8:< ̸I@7aVAO;{̊&1XqZDFȒUPGSYȎ>a;M1f{E'^ə{Ǘs/Xi蟱F8L5`~7q(IZ7 2scQȇcߨby<[[6HL}C̴+G_EfdbEKm ǹPVVs0z ԋ:R[ @e)&jMĝq^pj!B~žJeBhґKYN/Hw״Cb_VIU%[yplHѵ^s2ڹz숏oB /'b8KJ36uYe3"Qb`gp,.|L nq聾$hҙ<}x@MOc Y *Rڣ{nմ*~<̫G^$]ǫa4|[)(gTloŶgrk]3)+.tH&Lo=5S߆ηY1´V4Ֆ{;jhُgԵK{N{qb85OWJh2&OuyL6Lə \Gy[;yz 6 4V,՗Gaen~ H‡ǚ*ڍUi&@m>wv!fdZ9:_pf#K"<2@VR*$:VWv/ь8rɎmxRVAj!R_R:ytZp^Pgf |'hֈŞm_Ҿ2|?2f-o:WP)*"Ͼ!ˉGSE<-9Vt?#.zZu"[?'U 6sR _ Mx~RsCCZuӹ +Zkg $ aVBSоj̓-7Oʤ82WzJwnߎ%pkȦ_bO j}m7yd͸: [`>jGt es~W)bg 7M$ q,Ʀg%pAGmeh5t݄h HxNs S&sDxS}MAIP_-OVzhrXsCL vhEsd"DcVXֈ- F4`G m¡@5n-y^ Mv ɯFȱQ d`}R?Cu%fJHHr7ŌLTh06*uw%,* 9BaA)_l?&bEeΡTb.[4Yo $-rhZ0 [7JNKZz̕hiwbx18>w8LJAg8`T;\#z@IPT.i }dĜ8VVG?[(FcNsX/@C4 4)(@KRBy-7[rYS`2Rh3N8aQBL+Đ/41P="K>1Z M kK HD !Mgk}dp (M\@[Qrp[ugmuSdf~!++3?Hپ =('bv&|ǎb^;́0}MRx3#8Sv?|1.dYWJuM,F]νP?`VY`^ ЗlW9,jFhʼBܶok"XCuQt/:JW@.}U]אYlOo:U޻~o=)Ouʟ5 ^op̼!F0)Z \Wd{԰YHRN | sS~źru- (͒V˧K+Ga=nu\b@R\ M)Y94G<Iӈ,Jdi+@γ\$}¦-ҁ3Ǥ8ջuL{fohlVrcZ\2  \8I2,x *R ͣB ^#5֮y;[޹ϡcd2?83#w(0q5ҲB+j,\f"-}n3"x8(}{6(=>o5WBX=qw"eb;_7ŸrY۝,ja,eQy4 $øXvWe?qȯ-ŗ};] "Qqu9kDxzO{bXE|{jXߴpqrޏ]z^;o͢a=U6DIkxC(e%7t2H.Fl)/l5l3%FB{4ӽ,O|4t/x-i׫^?Ѹ{~p^fZto_Ŝ IwR$Ljj w9Y3v"S0vg$+Qma@ToGrAAub-i0=y^i==TI%S3}߾Iw`F'$-*McEM_}L nLF9z~g*;hM:$HNQjf>\9pM-j̰ MǼ֮x]<4,EӠl䔢8)pxՄlQg(l a,DA13O(spW7Yw=4I[dKeG'-Q7(/?FF}|Bؾ_;6f5E/M|]m3 tqq$Lw[=UKUoo{] {1!QP6Sj.ؼvuZ{RҖ8r/󇝃j;2JNQfT,4ao*SB ף~Z4IQq?cze]KYAn`/>z(`+%濟6 RhOE]HrI 4ġqI>-ō-5+SJ#;vBn3rz^k䄣^glb7֊||ߏݺp,#rv0enz3yV5bg;GuTvaLxgbՂEBGg3O 20(e;Mue[3h~(vY$~&Ƶ;ŭڦqb]vG'3:D$ Pv>f5ТS0$8,4=lq62Y+#!vȨ}#8#2}Κ?ɟR`žG:;!ê卐9gJý7f| 9ur$EAnU4!܄ ߷"V>K?΋v|0aTg=82Z]ѨRz#a})n eYb O=9M)S̀FQX x@X̺?qRKIyoN}>XZIMk U3©ay;!p.τK*#碘Ò]ɪڹwtdjg|!Ył޿0A8tAoV3pP.|ubLh5e{“fZ#SK_y[ZHŊ`]XΞܼeݶJބocQ5hrV(S뗎&L4O!y+Z a'4{}H+;OcNdGy=>5Aw$K65eht\}5 ޖimOG\rƪ2rS-.j{;?UCDZaّI/jΏM_<x`/*ZS NXYgK>b6 C@\>VWLY[ҘZNqA.K)FIPS2WGsq4-*")DuI!xƎ^3QL@O4T΅cfvGޡ9܅ߝ/YZ[\ހyI~ ][B48؈OpU+k i>lj_DM69^[@1Kj}KpO 5x=EH8Dcls?Ǹ(s˞P?9I8e)bt@1D<%APRⳚ L,?61Œ1>Qp)>`p< ;R*9hbdxJƫ=1v)y$Z%8߷'gƉut ʳ@T\$uY96K\Ѽ*<K{g;ymaJgI%iIJumRdCNk\  WJބR^r@g[mvS֖Pq "='U31:Vݷ8a(r 8B@CPI\ZzK2@-WBl)';/rSk胹||PT!qnx7Lj.Ao/~ A¸sWZ~S<$mUvHabO}v9\$yi gcQ Ϩ?C?P/=7humW D*Ms(7IZ!>]>]?u$qij/ކYpqh`5"ΐlvHZ:eyDJ;7y==(F*v Fu9 J'/) akLS Ej`bHL¢ëF;\ȅ2KQ~MQcQZbZc1a.8P:aav"3*h~%DA%J$Xա:qf^맋+' .#퉫0CxNA714Վ<˛x}m'yd9NH$YojBf &{XĴJhyKQwB n_[&Pl簰JF w`\)6 TFYh\^}k<|T{`ṱaT½&4RM<( x=oҩTޡ8gTVg*ⴆkR-k+8P`'RCg .Eʖ WȷV*cd}[hgS׌Y:_LG7۠ԕ~W2S-} #V"> stream xڍP\k.{p ָ; %{wK].93sfޫjߒ6  ( p $9x\(44 ;bm3E&ib]\7NvvBn +@:H@<@V./i 7gp2q@`5%@bxW..llά'+af;t:- M1cEhZk@,]Mv~p[/r /cſ p{q657;=A`+%PVdupa-~9C^MLAvf/Nn Sřd"0/U[H@`g9_WgmwMՁM rtIm"B agg@sk5=/ | @% pqrxS`2w@`D-/wy _f7×񲀀q~e;b{8yLL=Q_Ƌ@? `cC\^\/|'}`-8lF6ߧclV6@%? ??%%%??K(?dr} @9,\0ئ:R؝e{Thf['k1"#pJ,{7Ҧ"~S-bX'{8q}>RdMGGo[&yGW>t<^áj;oPJ&YbNeR""1bx`L_^Mag=1p}_p;~LӹH{xK|7I`ΫKf#gޣ|Aʼ<ѶͨBZ$0mhtD-RԎNGP $;9 U͌Da>0{JS?1tjDeʶ2]T?^?djuY"NGdU矂VUGRS.:}bE-_Mz(VQj ly07;V?Th!cQgB ag>~)3p=y!"?.l_F(sTC׫CjQrNA'sd /8L/,,â" 3g$Wp0X<՚q6I0ceХv3Q_ t-]J7sY+yQB0Tr좏 DԨ;X,! #$%LU8N׾ua$Śנ6p6W,`B+rV_qQt _)XB)|`QLo8mo\oˮS ηod dĚbq~T}lJ?v =I2bkۥ%kNI }L6E~_BCXZE\ΰh=ihq_}mx+*nFF#."B=M#3Q&DFy~ ]kOR?s.Xi+6*Sa K)ፋ =jj>trZ>:M*~l\9,+%܃Kgt,ZkY 60\= }g& .$=薶DV']-}{Eޣ͘0$ZZ,3>t9te{;3͒N2] VkBR敜7/G! u8Uב#!8DT-X{ ƫaJW Z+3Q#} ']YNd{xQ|clDxmlh7׾:QU kkIYmW0\S`7lfSL]3i=JY%4H}7hx 6]aCq"^Y<Oi%{X+1  S!,o׈F0"Z$Wkd=Th[`Co a?̉Dl$6_? &A.Lf:ߖB^D-+?e~W=TdK}c%=b9l>c6!z}Υ>/W-gB Զ.*FOΚzrk~d!oqb㔏_\~zormRO"\}; 5z3ޅG:rDԠm.fw;0gNy>Vf`b|C #jA]-27 xx;5iOG  tϑkr( +a`}ڜ1fO0(=zaP)Wt/+7H%44bQ؜@ߒϘo꒶qi}HnT: Uܤ.NY΅e #*M:$ߚCV:Bl̚'ZLrK)G} cɱ#= :58=qOhz.6gj4U=gr>#4 Vw?q+%G%dQg%h7OV=yz~hxXnL pZVƨ‰7ץODUg1XM%XT,Mf:#cN%!Z?j9:#a *  imUVk}ypuq&-έkh8_rnjRY~v2~zgQPppPI\ψ.bnA3Ge`-nG{EQ{Bc)d>Oo(g"[4c,aW8%~b~쬗;\k1^DUo.,-A7+ŁQv~|v0xGiғl(h%3T10UA%'TO.i38 Q`hɲu±P,fE(?0|d%\,ݥFlVo|)V4ЮTKƲhT!tEr"|X2_Ni*ڀM"[E"SW eY/9GAҙg9o)H)Mg C13:jf}3Qx1dMMfe p {eK!m QRvodlB?۫7ar-\\l&n!(XmL}"i@ң޷t"ư3nn5Gی׃eɏvQ֓rZQroؠf- uKe&qd Bp `~ީȳo𷁻ETeR @2@O6K=,H~L+,BO>@m?!<}RB$Gep"M>wҟxū a p_.`j{gQ|>Jh(uV5_^D߅MxZFEƢƂ$;uPWC)׆@j}r.o5 UiI_z5Ocf`u/:@Ӓ}-|JȸW"Y]n#6~ a& 2k{9g6#S&IdorJđL%{W;Hj Z09"ef_|-ҡw]˪ЊV!YU ee;OhqBe菢vwX >gL`|6?l՞I40ts׿H';DUlΔ'zA拷Vz64}CҤQݲ!MGm |(xБ8)a~s Dm5X`+Qy=1WTDDz(vyD@t/h@fL;,.N:[Va71+GP/ `uxzÍzCշB)P2uls8aT<Fu4!r4-H(U:E䒸BSƂ!\ V1acA)dZ@ s4fTZ8pEH `אn VRr51994#@53|y7a$CA=^N\Q}-[=d3P-)Ɋ9~hF̝}JݘŅJ> pUS6<'X :?8n+u3JA^f'ߐ2Ima;ꎞd47WNS^?T>7[A2%Cjb>I?*X \hva}-[(GUĢD(pmo0Gc23>IVݰВBVY~cDORӮrdx O(ǡ񥨡-C W.?&Tkv8=|}>+)*v,(RN?w{+di%#QגL7X?>Kt,]" ') _jd)bE"-^P#V։Rwl-ҹ ̓c٨OX~Q~56Mߧ^s K#z-9a {sj33:sss^QX:טH*1{x4y^Rnea5}% kӢTXeLQ-F4]p0OM6=Sv0_ C2߹Bx|;V(> p@4x9,dT5X M<[Y֖Ի]j|!eĬקa-dD !"NJ*(!+zL-l^wL䄱m]CH#aXDԹΠ'[6;_+1Sc^W|LJ8r7:;3Ǣ 9x0LIkLOja{AA㸀167E6`dğ33r+2Ud 1#~'>{7-ucKHKդ7`?> 2ɪ$vF eUu#ęIE[:-V28B!~(IIL i$ {('0`zaة| 䎜Piis܃(ʬ~EZqJ;6*qKLwrYVKILr"]oYgbo_><ߠqXDŽ?brInH- mA"ՙI$>kO}8;u#,ĩ6ĺ#Ih>M%qW3edl pgJw LWTRua|ײM Z8%LRV(h)Ԁ){ta9B~(  _p9ϥc7SWsOUkbgw 9(xmTr{#|+#9f|%L@@N 7Sp ӒҞZ;M_*\S#uJGd9ּCMF4(򉩜{kgvpfnyӅΑԧ/OZ?ysPQ.Jh 5em=Lrn$͇kd$g w^ͣ g\ɛ9d>dsT7AeoZ9sJSiŸg 6ahp#R,"J);)`8jwKԴhmka`@;fX%$bʮ8Ōhc8e|ƂMOF& Gnlhx> }pPu&`%Ӻ{_EA ">B8Թg@aa32Ugk`& ~>)i|1 ͛Xd8_GF!ʺͼ2jɜSv*tñ5ȓkPl:˱Zh+w_@a0>Ǎڲ{g AEMb_dxg̎ IG*v^<O;">R3~M?~ @ it?5)L9' 7'1nTw{6u{B*-.¶w_#7B騙]7a/C]YxFY}h?LU\Ml_KҌ-'\FdXc(:iC M +7u T-1L/-m_?Sv?:IXV-mDw}"(XtGĪQ|= 'eYF^g"ᖱ/Hj0%q_qﳬM6k}ʣxB  sNӥjb)DxLR4LY"=51 /04G|wĖN5=xVg_O֬d%F5*:U Jb);!#}90>@ ATHμ&޻X4(¼]hx@7j/?XYC4aW}7EJ8+_y)+&gKCe 0Bo^C6ǝů %+*7#19,yx1^0YߐJ;:` {b#/']ٻS?~DdrD_΁rsm"F2e.X؃*rcYnX$D[vs49/_ D[ZX~<2CW?̩K|{6r ajEqGo/50g0+18FkbK1h."Z[;BWۂA7K'=WVrsպax)4 U: TXi/4^#wȖOXKS ' }A3I!r(v^;0IK]~2sGj[<['O F1zV2EzF"h^#b5 S vxeFYQ|Ԩz+ok)TR_<ߣZ(*P[X̏*>?A@W,Qdw33%$M=4ŁO֚9ꈄ(*\>m+/pKAmKQnj7q1᠊/ߺ|* UfHդ:tkz%㲋?JG!^hTr28W}2z ̛N@g+Mqi%U(+N)ol6"ȃhO۰}0-K)O:ocڋ\%_ 6xz-V1YV*"hZ¦KZ 'ifX͟Mh6w1)Kend-`7"Z j6AYp{{YjjD"Bmz:mmx 7vcEwd t&67$[:mHcOtCa8b+/'bvYފ[e^& endstream endobj 70 0 obj << /Length1 1810 /Length2 10690 /Length3 0 /Length 11838 /Filter /FlateDecode >> stream xڍT.wwHCqk)$HpbNq]Jqi-כ̙s{WJgۻB\C] b\€WZ|..^..tzz5 Khd̡03Up s sqxcqȘ%N N#ɒ-$$;@4T͡@G؉m%LP0'+F @ww5sGqtlA!Ps &pY07;Pw4VӀ Wkw gsKK9 Xu9' `mh -`$n:WKԕBa`M[8:PWɀ\{q1V{05le+7'N]0 (Lqqq  -:^N?ܿŰ| NkX @?5j@]܀~>V7BX, Oth'M 01[V? SZM]SǀVIKC<>\v>.W^`~SR s_qQl Yw)/N0.̀>A 1퍸,a__hȹ98ehA^a,v6B \bUPsfHmn"U A-m$f 5 66vv& [>Rl s<|ss/ta [N+pr!P V{WE ~H 7Yxa F LjpZ^!wVN /_oO4>rVXdAX2l/lM9!D)`%h GOF-5 _pÒue/ :/_x`K ǞHE z-ї!"vu5R;b_wҘ}\:nQ\J%n2]H.<|B oMl7ӆ8M<8Ux(U?@Fɮ#:K>M[#ڣ_޳~|e)-2 ''xVt"u7sk:,NOZEb\7LSI[Bj` REYڸ.?/vƄ_*,"o Ἧ"٬aYEJ\?nLM ۺŭb<QBϚص w,?Ϥe8n=VLY(%l!>_*ܬ>Tشo}J~cs#؜ݳ1N9sS:s? ,*W^3nҩĮ1^jvωfF@\b2n>"J{:~>a7UYrjTWF!pT&.XQY:^d?Ɩw `:.it_~ +(}:]x7ooz>`-h2n~b3[t2zL096PL@sLUzAdNmv/|:E &O-M1MV6ْ - e:f[Ֆ}>k ܮ[e$OzJ靬vڥW75cx3@׃|( Y8hsGc/)2; QtG FEMdBɄ;[Q^m!LƊSDVnKuJnu՝ZkWecE 0i\pOTv*vyh̸L؂k¡mKx#uGxz.SY/ov6p4ƚy-[Zhc߅ذY);;NG}RT9|h%qt=x(RHc+w0Q?ʯT3_VY#s|Ǟ&zw+r䬂\pZF!9:.Pz#qew1Ð5r٨t^VMF( -5|-IùAiZmX{lKns) |eGfRɈ䁲~Y,Áԫw{:{ܣZK'أee·^'t&ks/?70v x(YeyZ9%k}]C͖ec|~fL-d.Bq7M-A=zAe u`F& ugr(( nsx.<҅p3E.ȉ:vo0np0EK짎X[kp+f9j+yYJKyW?b x+ޔ>MH8{uoRZsU&u2wU3]+VШ2Ey{dV ;zajTMdj{MF=bغOC 7lΨg[oj>|?܎DX޸4D$&μ坂E9@Ibl 倪ɕĺKyhV̆]"~m}ҩ7s.&Jгv QF?_%4T6TiO@˓W=|U $bz 櫰9EQ#f" *NN@Zm蘆#B1'_"q`Fѽ aH>1W*ޯ_L!`jlOrϖ+>ݠ$lޫU+5v 3.>jd8#kcZGd]Equaf$DN#up@d 7&Fňsp qkn=QN%a֑ c<x뉶NT2}:r:)bms`>6g'X} Qs<|W?^5*MvSQ˕{}c=.9oĕCLF| {9>j&N"4Z ݻA+>kV\`~";%BVҁE^nQG_>@}*1a`+mQ"u1AY;@)o*2Ea.UDO8(I- ߖf5N5+1:%)1IM䬁Ȥȸ;h68Y#e#oRtG0'g4Yܥ(״c^^Y}cVb ZZeCZФnUw6OHB){ Ӗ(Y B : 3:トj=}r(sِ< T~؝9,bBGv0v:&ٲ]rukquE"pĨ홄 o*GE`!.FGԉZVq >wh1qV3榆' OڗsJ߂!-Mn&?*I(2}q"_H` @ 5NWkXFE5wc3hz@{㼻Ηm9uBHy+CmV^_:ZA>L29zީH+R'Ƶ%J"(y#qrw!}g(ba{(uu[bې<"ΩM4RϡR;Te*DaoZ|\2fI|ԥ+[e ~fK7Q%cʮI[|n]j=C.ڻR80TkIEL_瀨qIChh|-J_`i1ڠgg=v`%}/[?^ig%%^:J;/Jh^FgZ,>D&eH۷/y>Tt-Pw]PצһJԕ3pqVTY)h}WJbCa6RV,O[4\Z;W(haBLpv~Z>"b$8+[jͻ1@To<#&;p$ʖ+9w&݌ǂDoiZQC */}c!9RpQ ?~~s|##SnVK {_pZP]ۙөY9ͮ$*jcÉEU"v!uei{ΘYH}3`bf"JFtkUڅROׅзU/4* nE==OIkod]G3y/+O&;}V>=0FbxG+9-9[s|4`I'@ú /5 7ּp災w?=@t?1_14J}b*҇e2wDΑ‚xNA{!BnnYՊsjlxwP[9jydjtVu? dqR3ͲABݻ_mN ;Pr5} },t:ۭ6swd謸J:*k9ݬ;O| Inm&u} &'@;䚹Ѿ|~0αYl•]!0ݴ7:sלIF5_]EL^3ڡpBùy +qp+Mtn:  S^4a{AG|Ro.ڗfA}1OJ(9 òCKnO+4dQ1uKf'BԳ?i&"34j,[ikilofӔVGO THfmzCgX {-ꥉc:^Nk)G˃ Т:tvn{S^l$;*w{AvO[C[M!V_vG'Ud!UtM|4Q ,S8ـ ^Bo?2/ϖq~Ϗ0so0•nOdܒmG/%=u#+c!Q,VxkWw8b !5m}E*DvS،U -{gun'XE~BXL2k+ p'cORsś2;T򠦶6w_ѧ1\m2 Dzk0)*Zj>#}<ƹG"9Ylcȑ'{<ɎbHeGGM`a'8pG-b%oCľ[qk?wZhsvzpkz)0^'j>h~ډFn#im!C7A덀WvQh?Chkcj h Z%5MAl\;vELƝpJ.R2UDN>[uL'Fau优k?P< *T"֨X u -J&)q~]z!D6I*ECΧCLƛtZИF \Mfr1O{&ץ8 llP~0r k"dil-˯HK kpgNAX鑅gi/I X kx/7u(8N[KRshOO ĮC:N eHS\VƓL[PzЮ_zf('qm#pF CEpgѣ/&YR hRLBzQ$j~23-jskpA!e`bZsJv>p֐ܪϗn4f][z YX=(ُB%-5e ԉ ۩j&̵}$5<å@sɦ6g wPՠ(,V21~FX>;GW oRλѥFUfϺ*1y3Y }(3robvu}k}uxRL:ځmVU4ĦAx}-uUҥ1I4\гɹ8cmFxr 'Gl*?ixT )-U OL>v JnNBvzKsArs?_*^̲^^ZُHDʏI•x-NIn*ɤRSxEyu'*;y2..#RJCƐ@i!XÀ)++ Mktb7X ID:EפƲh}QbU ކ3A1I0OKκΗu{΄y\f rB <] 4|Pؐ3>5F I@U?&yOtz7Wyh};v6;a#:-ZTCH HS$#cG)uQ|V7 1e)~^1Wqh]m$([y{6yu'Zɐ&CJ g?j}А4$f9cӴ*Yېq4 ~Sީ4~H LDF\Ƿ HjB1\N¹ `]?y]dd]Nw-[ޕXv,u B('RzpHgpimb}dv<4Q1Ľoh-Z94E{%{X7Ѭ9;Nv,:z8H c5U _#嶽ݭ ?1@gA\,1P=#s_~ΉeJ/N;go ۼqa*guM;={pq_+@S}³XSEM,% ,grmu `ejV%[[ B<;o*>!/30l|]洰u<g+c`zsCښi(/k>6zՃ7RrDZ*Z.<}OLfIz^ldO)Z!NLy"B^ $bJ9ߧ}L>˱;TfsW^]<x,\n)d ˂7SN,.g+ԗY$8:3T[_m7:s:HLGFK 'D?)>FGc,׆)HAƾK1 $VДc`TA$ec /< fdXw5lu(Ym'=az+u&:e>H>G_|FNstIcBVB}(rʎg6^fP<;EɃʰ5g[ZF9 @.Ya"nJ ]w%b¬u@egքpC'C.9iSq. :,JP}r&c4@Է5B{oiϋ"[n?[F~ΛNIE)vwhY|1y(9#oKc.eDgPEsʃTf>̵(z<% T7exD_ ?ԌGz%0YGv@(Ó3z$Dڭ-P4R(CNGN_q5/ 6pIN2 j>~sF(4ge)JQE,zj/m;LKzHvo&ڊLieL!5p%6ՉyU uk(!1_g} z(ZRL,[<[h哔DՂwY/*qGk(M+[vVtbfx~>O2"Z=/{!ړ9*;Ɔ~BQb~ߖ$r@?As -z4!%nbsWZy+ }_ԬAswjfE/Fh\Q~k7} .1[A'~?]DŽ)([(dSqal++zKN$TKT^">H l*"OGvc #xct<% G*QV`D6?fqNr *z-TKn#0i JN 9kLhJ.=+-J.j{)Td/o4Y1$#:{OEGt1:TDϪ }yyWEv[RkSzնx<%ZgfL6glc16.|,ʉmc~/-[Ћ ";?a3"t+;*hΜO= D5ηKdF  ,ns7 ȈdƿQZ˅!P:ݧS:&(oF3D_RjOU3Q |_$H]>OfY->2բl6ip 턠4y+E~u+YA,(Tޅ&gZKj6G㟬%FIR?bṀRǻ΃cse]0:ߖ`=k/dZ Џ\\JM$ځ^e픋p}>GKH+hHK/Ry؍~[vpK"]=@ BDdNeo- vxx)^*N߳^t0s ܿcqZl 7is%^W1fm 7WWYv @c? }pEYu25Y/*x&Knb[IGM@>8OϣݚwVd?c{>쵍LS\R!FʴSqzs&Kêar}ҊU-H.vZގo1#F[鄍TU( endstream endobj 72 0 obj << /Length1 1467 /Length2 6477 /Length3 0 /Length 7467 /Filter /FlateDecode >> stream xڍx8m۾=ڡjV"!DĦڛRjFYVQJ}i>>w8}^>R%#sA ،(o쁄"RC1e;QhzA1)Aq)  J(yA:MgSBz@P:?8A\AIIqWdء ;QH rsE#<exP{x(t\ȿ F @0( GC<`:HC/ODP`;f( SGxvp_v0$oe٣~o`C3 򀺡H(G_iǬwPB($)C= i  { h8x ` ?>hߘ#J IWc_7oo! i0i<>!I (((3ϿNoQ};GF 8&GƆ  ( C;_YWT=avο+gOz6t C_vzUe#Z|"@p(RvЇ@Nifkp> uG䂾[6ѓϺ*p <<| @DYu8@@ChWcB{;~/\ op= "Bo ? @ί/j6GqVV;cEQqզ9TП+@}p1cՓP_W<+~ft@:gĬ&0<ĶHy*BWxVu'rBr (9#eNC=U|b̺6"'40|?Wln56w?CPF:殟&sH eRk$RyZ" Mk$2#ӅmIžJ!z5y#D?.n ל[Vq6yX# æbw.L#J͵1p lMܻx4;IP:M&1酢>mpAB_Kys>/J3ýQGʩD7;I5Dޓrf]\ y Aymjs, $dw̥"I)\^.T{.,& |8qtK`/nmD{#!<N G(DhngE#?Ml)[C}xoPmI Z}b >{b#mG ~XMj%Vٔ ڪ4@cb9`~ڌtP\Zd#sۏ wEe9 \zN0?6ai27 r"Pp~ 'HLNkpגIs,YYEk8TU⇗Ofzbo}]uw)DD6'̼+4W9ҾZj!n)G RLj hC]]>eb0VI=.jI< cR &4t|ɨgz<' Fta ()^ x ruvar hj ê- p xf Wӯ~lfH5P:AOy(w&sֿ}3T-auH`WM*VI3/.O$RjfXjKOeNͭ(>^ZiR)-zpR\1v> -o H.I 9S{l[AB>{>AcHυt.#1v(dhD_5V> <5i/I,h1جͦW B`Y#^bW kIijpq/YjE}AdI|n͑pZf5@kP֢@Tޚb#FXtl?j†L郍B5ŴyH!҉Z F:8;G-+=LeaK'[.ﳸܱ,q/_}B̲f<9&%lF$pe3o #:\:_ 0b)Nvia z%(CX_2^ǫJog,7Kl*d:%E{ږ~yW/hg6p;ӓHw!v#]\ok`kQ҅З,Q=MVyhvL/;!udn]c罹$^*f\>*tP3\C*>;pTmv4}HM:QcqEPXbt)hqqw*6G[}ӓTFPWX:g T+upv伾R/݃m5@’=7MiY(b# Twk0l>Q\‹J3׬Ӂu֍_Xb t "c %N o{\xe P}@! }r.rmbYg_!}[4iN[oIn4VZxzܚԟy!71>\cuF\g^ë}90eC ,&}>8y oOP8._<$[E~C"D|R,O,;~/ӷc-FK$ky8.=u lwP4ۛ W01"k{,%m_nu3"1E}F_r}ݢ/4.(9s/t|TYGQWdXerykW _=W-sfE( _c-S1)WyV]Yn9Coa .'("‚HqI}ܖlϖ]f`>LfKvalFXPHv 1\4m8yu~p6NP?cܞJ֗=B{xFZvmYr$|cP/׻&Q9qB&MbwCϯdnѿgzEp>#%2nlp38)8W ) |!L>Li̘' "ZFG72,LG殶b{ hi7>hF!kCnlvK (t)2>f=T)lJtb-v-ytW3Ŭ9{ eƏFHV'Eqc'_CSu?_t6sRˤG~<> 9Wcɧ /,h#xxhV*.;)T^uHG?7ΛCVN'~D>]v ׌fo]_`ToXL?_ڬ/yJ/V3oyu uW%%E PijkJVn\\g8?sm f8[.s ttZÉ؛jϕV6u1-IT '<|Ϫ Ldԩ~3gil2S+9tt Ҏ.=|qG/H?RSjx|\^0qM}п;l|29jtucSZ9c\Ɍl2mQ8ggjZsNu,5mw wqQ45jzeX̤YOdц``LM$zVcT?G]颿$\vnX~ 8 Ey'(p2Q'˗zˏFi^#GWߔui $eq0Oy>jLiX+'evC", 4Wg+y_-> FTb7AfP>໽9&8?NIJq ;ք8ڄƮXiKjsy;D58:^+ԨҰB1~wE%Fǽ>chI=}| 'Gvj9n@&+gRs:u ,Fh(E$qU3GZ ߮{*G_PڶmO R#-fINOhnKRqL@BJş*eC\^w`p:`(%}`RjVwQB༈%&%̺OG5}a@)ɣ"^w'o}L `+i^lކzEcx&V{|LG|o7uyrs=C;SI6cK쏺\i۩z0y1>Mﭨϭ,Y'_ĦU89cE"`>wcJ9 qz() I, xt*ji-p, `)m:=H?8dI9딏oNNY5w\r-W= g,Y/V{E5w{tߩBl^+C b1{kχe6>zn>UHŰ^艮o{NĨcc&FXl6';AT8Xd~C@9.jݐ;z߿>"+uKo^)VJ׺V}z{֗?'O O|2|,aPm^ιN%|C%Ev42I6I? c}P0f,Z ӕJp#όAW,)/y{"`5>8ļ^)v)k1DAr8彭!%Y#;AwUa!Q35UC$tˋrӸyr8tY-?Vl`բˌh#yD۾e7d/j}oZLV/~Ч.=O?zh/^cfIh=-_0 ϡ{sc ws%3`8YvQ)u_ f_%}"5,m yy)ڠ[q"i-/ect'R;c2{gd'ͣE<|/pZ&o8et!d변|w=FOLpϛZd1-ݺo ^ў4~^4k)tĆo_SMdt\wB4AhM&egߦt5EaȘJNPǗNj/3/m_,*a" BMۦ{Q[T%Ւm\WQ^JIF1Ag͗r-L=q_( E-LzJ:E=;z|GsiMj-5x՚zIQ'6zkP'.:{cl"1YSa/Wllӧ」ٖ.ji'jLawASOtV3|~>rp,D^嶋Kbf8,9^ ~|1T'Ϭ9F‚@'^)TXЋ7:EǎV Zx.yd - _s<#V*]?ձ, 8K)K1J,K><Ƅ(v endstream endobj 74 0 obj << /Length1 2678 /Length2 18803 /Length3 0 /Length 20347 /Filter /FlateDecode >> stream xڌP ` 2$݃K}{a^*2U &13+3+?@BISʎDEij _ +X& t*9ll6n~6~VV;++ @w+33@D%lea ߯ZS:_bv g+S=@ j G44L@^VՑÃhl!Lr\@ 3oeojHTMK+(4]= X`ke wq79rGc86f}#+MM^Vs+[@EZӕ7muql&`R@0ÿ:[90X Rfvv {WIZ9Lub6>EVfi9h[9$,@.VVV^v 4d@`2!AWg7ϿfV=`1?g+O>+xf03{[?EI[KWUo(<>L&v^_IUV/rP4 ڿ \+בߌlmG;8#n)7E?"X$ >? "qX O?#(A8?A?]hA\ p. p.8X>.VVVΦnvعVZٚsp?Lhj?]9gwQc;3u?19Kd{X\lmg'm'(ox/s3s|V;;Gop{fh Xf/_-Apqd _M_,Bq}كwOL~zJ |8I_D1O`i6'm5'#xx4\DG[8!\Iɜdfr-tli ߙmrWN\ϳWb/`v ,ΠMT:g1zuq1upw঻ עz zI|s9|yLVLBC{=f3|V?=5o:ߊ`Jވ9lJQ~}6JRF272[z"2LHĤ)] t'dd?x`峿 s{rpr<=o!!+G zϷ:gzqsSHԹ|iZ:viv;xM6{nto֤2;]pMe*V87.z2ä`h~<8>Yˋ|&VeYk)=,-N#.ӟ.C<\EN`hc_K'<>q = bPb5(=LzGh0eՠ?sJo_ׄXClsDh6~D5V^ג9Qw߃ߧyͲ5ѯµIYҶ 8zOKx8S§{ص>}ܢ5Gy, ,}g+`7*,BSklt_z85pm)k#QZ_/GOGl]IE-Y ~#1Vv*\)_9>gzXWFjŭkk\OvQ﹪Qc')l煛)<}׹k%"YLr_W(Fʌ)a(a9QAUtUZ?FNbj%J]12* jsr0[SXf`aҽds|>'}tɖ*5cXu8`IH:S^Z@^(a.S,={_'Kya^њ<_lDGtQ[Y?b;ӷGr'](TוtmҟqW^|JX3/5 z-U[c(|21QcGA`aTDq6N]=ZLưŵ6Ȩ (ݱhr36>#tċL5&)͢%<]@PqF<j)Uݭ*˜$iu 4pvY 4 ; 4R[ʌJ>2h D. thH1;Yf\=+=V+w[|6 @q Q'm<ίDf`5RѝbzXZK7`ei7 Wc/^q:*nkvy7(3ve@SIF+Sֹ[U;_[rDeL}JJK0,qj5W);̄#iEP=x_acEc2iĘ.{ PIi<FTVwr&mZVJtoth pO?1kD/~ =P69]bc&J~ۤ _\,JkOklJ:_Ĭ :-:"Y>_I. ޕiwd,#BW=R4:X"L["j̐1pzP_cOP6;BNcv#tJZy$g.t:j l>UB!KA Sqmrf8 /fv&Ǟx3f13TBߕPTWoCYOzQY_fJyJF0"!Ky6}a޽>X =t(}{ukv{哪.X^vK[2vxi%ts'=A#7לtVOmL\DC[),ˁL\Fȷ03d6םb]G(`z '2\ [lAw(Unp |k<1^2/A}u;h*Fz/D!zbD% =Ba4qxݾQG⭶0ثq|ZDȱ `'g,c%W^kA.x|.O#PXJ5zC%dqU,[|dY^[I,7nK˜F-4rBلvňyR&9Q,9.E:YӐ A%bq7 ʥ%/.8<6= 5CIp8Z#&%7%nS&/OM ALڡC'ƕХqTd%4+sJoC<7:d'rp݁X.;!{_ҞӺSDrRnwM fgƞWx}׿^K~dΔ=rTgL w3}ϕdp Os."4Z]LlZe4mvəeI4b2s&D5',8E#9|ywתWKSMI[ق H$֢io]:PT͐1Ք e$,;ARp-YJZw_ֆs#t7;A_ t✮J;׻yiK̉g薄HtMnڹp?b4i\4~WzS<yb !\>#^W[!xNVq\t?bLed"I;&ta? ޝ\Ip $heǚOY=lW:$& *4cudoi_4o~FD <E3&ES=gspS,uZhn*`[ ˝gi xCb%g I2lk4}Hܝߩ|+GL4K?( ٴ`.jT?Yb8Q pDӕW~dp'C]u^JN[r/4u8uF%2Yu$v*VӇ=&4 ՘^r!J,kj׳ŋT&Եo@e=a`sJʒO \8-P]\ !IsuS!U+W:I/ًsvv1_ re}4R":7cĭ{}#նh7̈́YʫP n4 Py/d F& \f&0s&28f7gѢ{B܈5NlgǮiJcaRM*dUƊ=遭l*(nFDeFvB,j-n;H4r0;"N՗YtH' EbXs;UԲs|vΰJՁyo}pGM+V<[:fW/cS1e:*O,4PZ{[*I q/y-b )od^ds'DLaL~V@&o 9μpC2׶鎤!2ͪ'XMsd #UP' R@5d@$C%h'e'\JNvT~4S+׎9..~ :l+"ETq;eur 1+ْ}y3r\L0UevԼiz^ oO!Av(IH\Gէް~&w&təѐ߇5h(HTFȥM SIo)U-Œ"K:K.: 0;lnJ- PY.mo7e \}`*bddå0䰁󝨲%ya8?̀󗶓H] q()^̂/HecG 􃙝#vv+GIDZ!]_M3 jFh((]cy#-ˊE#l^2qQ^^E9&J o2>& 9rZ=,8|?9`^`dwt-⾽[^yAׂwS[ Fa&Ǖ5l~ˣ >ksO?lMy/_G>"OC\͕l@M9}#h "5 vmϚȤ:^.zw 0N'X(\ y@Z*ܡMO'1>xrL YmIc FX[eϡ 'Q6.7J [L,]Rb>]ML_wͤ$4{XiG-^J3&9DԌK!=2agC)U}Z^OJh'3 ٔǏ0Er^׫f $]-!LtP4xO|Жtk9mp]:/h(r\EЅmQ(jO-*յXvLNj'gy5DbHABoW !j~k RMFSӋ3D( 8^sU>q0˥k0CgO*egjw~C|UpME+"GFоدycO}6SNÑT >o."Wm{jo: ;R4(LOx܇`ї2J`1ƆziyTVT 5GI%Cx(T<ϠuJֹJ#(חGڧJp1%fr%)dknf;#]6Y!N5͗J4FD J/ݦj8xP4_Q`18\?f'34\H$ f=ll #tX lpsG(3E553&©t%h\< ]^BK{37vnc /rZL~eIĶQ/1ѫ Bpz`{;ghGo4k$IŸhPz𘺝hg".w_~I^eo ]J|]i)@LE |J@5`5L.z&1)96q{Y!Nv&##vv*|<`; ^ ()PCʴ=@|MN&fOB@_~ZҬ)0DP3i`pW%&>\ESpԈ,@J yI/@W,?܇谝>LW%:9.P*/CZc[A3UqCQHPlA{;- kFs(Hw'] pJТ)9=/B=5W_h~Q=NyZ_e!]ЂAŷk'#'`l!$)Q_]4_WΌ`:[O:3SG (otp  ]w(ǘJͣ; 2@jv)oW?esSy>eN;ؽvR'^NX/"3i,O`nOtR-VJNYJrжeG`LŖᔺGXo2WvGfPi4H5N9l^[Vh>潗ɠ>IO-)⎇>D͋zGέ9){mŋ>epˏ][?!ҫ0z.^O CՏ5M2߷Tuj6\2M|KVxI= 魏m|Uk%|ΜSso]"Dˤ;s">M鋟]ٺ3ںtP2 o )orvC9F_!m03SNqcDl:#8v NMލ#fv=jKR yo/BYM5g*w{?JEX8w _c&ᏙJﳸ!',آZ@g[TBC$z%}}Y Zp`it _h':V.k槳~c NRtJ{w跕99 $邦 oEMXoίq$>Lz}tǚO)DD/3o$DMm\} w^@xn_/~@g=n1Ie: "C1Rv/\BLcDMu >%28XI/in 6g5"\֩s9}x}}.IP~qDwC=aoWuy/v1{duȩZ$3젘Q< N=" -o6rEטWOI I+Mw]wQ=\h`q~!Tl|'c̪뙅X+ #mF9c()mT#J>A"$6wOF.SܴH,6nzCsFѕPWPU(yp6Y3FT4^ͫ n-h8+1x*+293V-(ռ靧K,pc}_S69DV! pm<3pa1LpOЪY^#Ѵ"@[d7y4pa=runnp¾E|-G)'b/- 4:zҳG?A:v0oZ8 W*glO/0*c> r_ #}#y a/9jYiū8ҤLSv "̿@(f&S U/Q|)GmVWC7Rm˰6$ٞ;-r}x=yv.e-j0D|:p.8fٚuǧb+YjB1?O3˚t2j;5c4zxӈdB۫-y+;*@j4^6LB:(&E;ln$ 0u?VS6›f "(lkZ[V dM#l[*^ 4/&o]6]GS(p b&hΧ9Rr鳷ˈ̩/ɱEP3dqpbek3 QOOei˫JLm^kDur#~EMDH+T2ףTml0F`oa)w{XhHP`. %!<{%q<(/mY 2Zkt]oɑC_vqg艥jyv: \9JSH$Q7Tr:7~@o+<OhLϟ~N=i^~n-_}֌ayQ{OvA %ZڋDEg‘/R;fตmB[fӚaqp7ces5SVf})yAZء+m% Y䕲EPC9؇@ZV~dzR$;Fkc% Hw ۞Q'CWZ؏&XM.9, –c0\l׭3F)ܥ$B5ףVQO(Ttˠ~,;  4 ||ʈg+ٖ8eځ@#ڱ` j~Y',M]VaٷTv5`Sk\ Ez& À_FމUmaF>4s7cl|>B`9ۜ38$]nZHIcB kQBp,{[Aj9/IsS=7xyM)FvyA}0bZkS7^kڃO6xO/lF$=#_K$lEk|fN_2zy l l~41Qt/!R@}/iQt.6{#%\ N%&: 3|;/ŃC=@ZG bx=l#!ڃgveށUBztD~3>Wz1)Zgw1 O(?U*siKi')|ܑ8A#oR,l4>(tܞ/դG>`8Z69:؄h-WmYF՛eE/ĔFw؆_-4]g`ڝL8Uϗl\ HLEXnb铱 z;)u]6UMqb+2O`N@/Zu7*=ޠXXAgvx/$bS/ ŌN3dz ャk)4c# Xeh6r|(ߩ&\ B6jK~Lf~2v6}3NέES{pҘ6kG?=^[eܥm",cfǚyʴ;r"Gdqmh\$v'\Qb-p!&hyQip)] w?XywF쩪YR |mHA?_g0Xlyo(&!iRw}^$*~c?З_ɜ/"oXH^V8w-kYD4:h x?[v;h?H9~YtPBA.D?p? Tc@!MGe,:DO|sfR'T,j*yLާ>:&S l]Y`57sHPn<50Jj :i;Ft/5f43Hރkog/r\uwW0Yd)^ߺO|,ͺTGU|yz{&awa"K[{#ں#M9ڶ@4UviZ~3* qY ɇ:.z?ێ5H,5+]]]v=`\&p$E }Jo-_<[\Gƒġ!~Vx&ޯ%~:& ZR ^IrP#߮#w"o1n)P;t77I:w[>ٮ]RQ) ]/]H(rt!1\eѡ=԰,۠j*(f9D@^VvT۬\2g?x/4?z7hQc2H4J>TQ2.˃dț&g⛧T(vDT]G«I]%j i3ʢ6ɠ蟽?LfzfB8"ó\ Ic棚98FiqyYS册c A dXy'K5( &(2}2c_E4vlikϣʃu{-qXSBE)kU_?\d!z_N%wc]U3(R5&6s8,JZ-U )I.p ]+|WZiNi~voB1F|/Ǣ\ ݶ} ' E4֔GXxE~N@Hq, F7`3#C_*r it}-5%I'9 Mj BhZ+)!2hsTXqa$FE z7nn[mLpk!Y[W d^`cٗͤS<%ɢľ a!jd1[gotEZ@mdCNӂݮ{e.`HsѬoQpDMWC|lT#biK~)cbѦޞ.l;"0 s Ԯ㤣En3"2*3sxHw[i\h;+(-.7~JCC9{}V,|+hy/ׁy1Mf [:5΀_~qd b.@r{#N]IoH)cBN|u>Y߻W@\m Z;hG|8_m޳>>1Y"E7}Chm[cZZOSf҉aK!`M1zx}So%҃nbegvmwL=s >|p,=-_v<grVQdS#P堛HS {OSa= [А"e>RBW,{Xu}ߟA/EG=XDR#+Wĺ˝,-J;Eyiݿg0\wU ~oꜳFsV@a'Ekv/t)D-W$nwt1~s*JsgH3M! ̚J0ҐtmZ>Ac1oͼ5ѣFC¼WmϻDg q3?F*C)9 7o d;&şuh2i}m#nzגߋO4I㤽ZnO.r:w,VJZQkdN~%ނZG˸U-m٬7IjiENti! uzx|~ (kPEdp:\}ѯnYs%bߪpm\_]@$av X+Ew ƣ@ <.tiqMS J:5l̹T7(O e}1Tdnkֻ[i.qa]ғ]t nd$j#Ig_<}DTrWɈar-Wuj1 GJ3dRVꏜcDJCTcnjeKӉ>m6wpBڂ:"Y]#l ;S0 ~}O-dSK[h쌺h-OT.z-lj-q$mT -88ج45-fiC&4]?7IdGNhaίV+z t\Qa~}heH]ȡb+P:*(On1ܹf~q J^`/Cïm3DGچgSeą8 - o{Rxx~+2-vE8)OvnwcDŬ kPtg5Yٰ3_-etOF c_b84tF p4{"+C+ Ί߹PY(y4y;jEմ}]JZē1'h]/n"h"1 {MY"/JCz\˗fPI˸ĊK_J WOxLˏI]"M gC>byM^oEmNZQƸfBx:{Q"a'I7#<\*2 Oo(᫦ `EXdOc_HZGeN({6b WgٍerWL=g}vD ݨac"N{q`{W؇HLX:X?%0\l&a JǨ0i sG2({ɻJX,@,.%\ziG=9(~h(S2hW?C-Zc8ŤxAIh)\ch~^&z5d; dk̬yP\Rg>G Q+0;0Вkz 77eI<,.hZ\=4T֢JY_Ce8X6)N#^Tl ߀{=\IKG^RW|PFzi8lM5f5!Q~*93,fk%iZ@"RdOЁm8S@.A:b>B4E]\s) ,$KD;Γ!bP5C?WZ4Zln4q_% p{){F31x+ZɿڢrsHU;'/qdź?TD8N_U7XvzÌ(Ce!/q[|h:r*nۏH]uU I'XB=DH"`}uOeryܲ]@Uvf<1 y ;gAiwwf (%ĚݓiXTz>ʃ{;qS,-/d-1i$m^29F MrSFƣ2 j)E?20<\JZ.y_6w}*~Q37hþգ'/էcGn\%;\m"VYlD@ ~j4&Vҥ̳ᥛ$E-O )//zX u#< JɀwgЪޚIdDozoQ+u^ ڏ>RDN;;O%d}ٱg |^ܪYPq]Șw7C"=*V́eMFZ[B^m'SouvU!wB#6:`q<-ռW.p Keu;Rũȼ MQ#k]Q冺aO\(M<ˆ> stream xڍtXmԾ ď!!% mlC@DBAABI PBDT$D`( ]׶911WC`X A"4 -, P h;Z ã8$@i$!yI"#9'P0X4a>h`(a1H<vAHu~"DNa8ġ0 `#p;`VD /Ź(h 0C8$8 0;̉D8<: V3`$?8'/Gh!]@bxiqH8A?b!g4|  Ġ?9$ H`YII (A Or`&iz$`3C ߈h8pB1H>9& Ÿdo{Nuu(ġR4T _&0ϳ8cHwKϹ4"+aIӌ =X '}A+p,D~@dٛ@ C,i?0Z#!W#mEh?$M'WH >xoqin7Oj֡ IڨWՃJ0O &TZv;m$H!I]0QTF~sH7:' t 7#!$ 9TABIE\~C)qP([AZAR1?B*W,iAؿ _$i 8#=FKAj/|!~H8XBkuģJ3sP]1DJY-6_6$ cGچcL2|~wa]|+ӌXG7t^%I …yۗ:$"6*kQGQv9jeo*++yXDZV}*]~jJ^t]3KK'=YKi Od/ COX&E ;L؝-?yFVgϿWT!Z-u9'qj@i2DV@[E*|x<@5!o,E$!an+fQ5⧂JS#Az:5u3=6Hk34my;f`<tArئ~UE?V~eADrp/MhuGŘ 3&HϾO&ՓL6&Db7Nen9*8ylHdcx2@2 Sj!Jej["ҵDfOWfTuZ *kc}c/ fQL]X0 Q}%j/+!&G Ÿ^4oQN_l,} Dp} 9>M W.;L0`> >X룰7u!v6 faN}'Pooj-j#s *R7w 鍨j_[gufyOe 9ftN3j*{boKv{yU+iKORL{mDwYs ĩpE쮻#+UZaoro/4_zc}KbVǖ*d9| YHYGSTT:j.wyȒw @#Ͷխ k1qGߡz=[(d7*öHn},BkOPQg\}mig;gi{l2rA_ _oh~) ӐȰ̦&h%+94Pٽ%Y"kPT\g$,6|qBtMW&۝.To+~/]8v Eɀ͠,/nvY}B醧/ (;w`.n˵[FhTmf׿zmt0St/bXou+>Ʀ5mo!BJ{<I5'#^Lu┏[VJ7}xCCZԩAR2E e+w'[O*:Mϋ`EJ Imp4Ef T{G(KR5^UTV]8Sr>M̌Oʳ͏/bB\ Ҥݫx^rSG^tYMһfȦVzsmZJh^0-㼩odch ثek_jj;~oK#s\y]*_&.4_)[h)/<찻Sͼn:ya)X1V |шEM?5yxy_ݑjsCZ9)KY&Ȩ (.noXnMYy_ r PIPMwi4?bpCn**FVl+`ԷݩAnqhqS-N<TC۸\rx+XÆ d/_;/zFNU MU)|euVG"υzL4@҅78/ܑKM:H^ic>Ԯ-:7̜Nxܧ?v4d=jXQ˩>r$?Wθ{#& +%[~d2yqH:s<úWziSBkbٱ V ڞo榢 F-/kGteV\˕Z Z +^rw1&~fvPa6PȣڝCWwk>ChplŻݑqUMg%X%> d9*!&NmbV\oB$j5Ssx~)s5[NF_! US~j 7m-L`E7 lQpwo{Q=p;;<ӣqIZ$(i_f kd4_Hs vQ׸)Kc 74lm$%kշoIsk,IRGNyT%-lNBVCu˯GX(PwsyScC(ocU7T+1<|uL걋rm1pd)Ҷl*7i\w{rBӖ64-ndh۝4k^ͮE0~vڛ8G.;ev{_&(g~>9p~mqI:oKF_^kO1Je)/>*:Y (́Z6 ӄOLYd>k݂\>kqtN閥Oe"0ԹvfSE+Zg2y^i8[FiKZ>/ IO(" +265teE3uBn1mgڴiOc3oTbΙ S"jQ-*Yg"eg&߻v2Jǡԣ}]w֬C.?-H8r5_tyxOw\5.`Qtʻu\N:`66tիQljƗ|L>χyQ_ ^kF qQ}cE%l'T\eVR;Z-Ն\iG3 ޣ`ޏF4Ͷ酴ܷ[>E_Vouj!Y}nE%YnJ{HFVwWؼc*z4c2Z͠-<:ynZIC@!ˎ_1if WSć+\I\89zܬnR #]wwFYnXe~(;(Tݾ^+^-\Đ+-1SW8<ڔeMtA7ݠ/vgU0evCݒ ?15H&A? jI$.&3x&:UZY3LЯ/P]xsFaT£}%۬1Zf7M|OXv^6$ii1R^K3+NܥS/Y%|Vq~t>d{Tݵm$REޤGi\“G&ZˈG!ٌ2,&RH`vDw9;\L]hDMGnV}#fH"'v]RDfZ1^%Ot=S{}Cׅf ^=îst9r¯֦r>5p{dx.=;9ֆ u{̝u} p|VNM9.L=-)aTtm-[w tyrRi MB3|$TNC>o*+vz՝wȝy0rǡ-b>_KF̻c 5۲Vc"ދr#nOtm %%g2ZT|.v؈n^o6no endstream endobj 78 0 obj << /Length1 1729 /Length2 4289 /Length3 0 /Length 5353 /Filter /FlateDecode >> stream xڍt<F2|mwg$#lYr>8npwVF)=Ȯ0IB%,~{qw~[iY8 q$YT1:@ rP<Yl@ǩC$MAƙq)o S`TaʪP(  T]8"']H6HI,=cA&vD"0i< UBBݍDT@|}}X!)In%H > % "fr,b~BE@j Hơ@@m648@ڃgBq?bg`fj%o6Ud%E% "j@ !`@=_,|~BH`*$ER`gO~&|wK|?n@7&xjj XdkHBPs>F4Q$wju ݗAQ A}Mԫz8$uJgR%$j @e , @8qT7Rx u_U/@\7JO =A_ԽOcTDWu_ڛ'z D W{j;.:(OS~LCzwJQhd#bd"{r :r#_^|㞑ߩz{7T^L [QcʷPe廢//49@k+fh{"W`%j_4%.k%HiWx](C~"8=i>qsA#' /6Ѣ'+RGp&>1V6niTyJjYyrDZ^$up DrB/y_8`+T*{$,+@m4}yFoJDa5ƲmLA_8ƧM_s,c~a(#6LJ|x~hvz9vKLVHXkE]\ sON2=i.f2W'iW!'rꑬ}4,sݽ#2ǽ=OĝXyV&<8pa@W[8nAI$9?m7t`٭vO3'uXw#os[j\ rՌK%*H$ge&X6eMv4 Ta)Y iX z[g{LxyA]}.Wc}%`Lx"i1؅c$9&k [E ?6ΑpÂZ(PkM7eֽvYidiG`KiFV8Ԥ'S9.3Kw_)= Fg3Dԡ@Ras{aMaݷ_>sGK(ۄ#?(~q 㷑 K崍-qw5tXo ‰K5q[!nY?vY{CvHSۙ9KC37꒎fu= J3u \(a/U[wu\iuR<Ĵ}z 4/\?Tdēnx:lb^e>$ ڑOlB-?tܗQņSb,YAzLӼU$QNهKcW\v ҅Hn8ۤ􎩋bW {&:8`;N:o sx4 JXbɧG5wCK)1 .5c.\JIh oF;0j9--ݰWNSS"WT)IM_!ꅂ9tME:'q[0gi &5<+; $׶zI5Jx@4rhw \5s+UY !g1>_P  y;z5" p7ΐ̋~նƯW< 9f 9ñhM~ u>Z/87:B)_O8(*Tղ){QdYC߬>>5y&a/n tV{g|bahSR'\wan"'x0fMfK¢ŧ Gp+V[AZw0d\˱]54n Ni& |A 7 :eO,>n8f?թVg&pi5!qYc]Qȉ)P_2T\-%Hf:?m le=Mw`pbPsEUƋ/ͽDF(̈ ogkUP>KL)غOg@)~:W;jPťn aK _74:& U M.ak̍MY(L }q M=Z,"ɒtywFpeWh)[R.~3mƗؔr.="S7+6oՊsvhV4kP"'fj*ԆX1 ؟_"%*KTr.ғq,;ַ8ݳEaБYxˬDxkN.YwˁL/>k ̧3??`:r"7o}T]{4Rf?a9]#o >O"Ɉv7@vǥztn/b'bEVp|O\M`⦳ydjJOU!_W.xR8W-^7v6U!j&QKB 8b|ąy؈C{6o YGylPVrOfO:*AI?宅-9|l|`z :ڽnl䔆w6&vtj}bb3 Nxho)=uQ%Xn= 3h#뜙ô|VQ15ݨYOC+l^m UW ݐ*9:4=| >W-_p1CsZN4 0͢[8XRSE8#0?mr>כAE`LAyqKQQoW,Y5Xï?+m- הgofhXb]5S h=r au]HY'X}ynhHи~|ZQIPG 1ñҦ;s):dtad_IXg8m0{__q@:$ kqU T) ߧϓ=o*Uuс O XmA'fU"¾k Sb FF~jr@6]VT%W?:漝IB'w,fa(ET VY-ۻ§kwȭ_*`rON'R;[W$9;FyD|H0}3Se./C.XKH̫ћ$m{K`2V|-éFawA>V}քfEP|D6&hG+NFiIIYgW_xxŴ4:.s®!s5.ãP_L-Ox8Ug^wuԂij.a+Ҳ݀Z*M=$:cfCL{bx 2e޼EqR8gj/7>0f{5%dx-bV(l aѓ< endstream endobj 85 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.14)/Keywords() /CreationDate (D:20171029220607-04'00') /ModDate (D:20171029220607-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-2.5-1.40.14 (TeX Live 2013/Debian) kpathsea version 6.1.1) >> endobj 2 0 obj << /Type /ObjStm /N 65 /First 519 /Length 3329 /Filter /FlateDecode >> stream x[[S9~c-]ښ*.e^<7qۙd~~GjmL0ؘ;$/鸟q0# XD XIbFq1EŇѨ6TK)?F-)Ϳ 6l2 *D.]/qNOGX ?Ẕwh] N`oOr>9gד8d%77Ũ+>2/ŷQn7 Uu 6 HQm}1%9z=ټc(m aI]\R *D_!N}zZn TW qu.{,MU*RZ ~t(?tfNLd3e6C=t2"m,)H /:&RӔH(D|bE l9݂w ih+S\ҐVR2kI $5&k#6QdIgJLqlarIrZBtv@[pg2gI:i:lhΙHZG! &zhUt2t*Fp 4^ԦV)}:3D!5qNĦ5Ai=6Y) S)a^qԒ) !ŜD&:eEZO1BLOkAj2xI7Vk nVyox/.T{T0ԉBO!ҘM ~j 0[g:fMA0]VWڳXmꇐME e3@cM@RX ppQ#>4 <][%lRMԪ)JlI͑ ^uW⨋ό\/5q"92N*%=R?OQSRv:`(}NKWԦP5:2JWSOJXKګ~ieR;ۛ苚,‹ʐ jqWREV̩ҜWrI'Tkh[f6ޔb͏ܤo֨VP o)(mOI~y1cq'wW=TQHOx0,A̿@rCx? ?:|E LCq1-xqYm~T%:y)V_2$vͷ?luܭ\HgܬܨYS]nK Xq-d~uܭ%w=Ȼ~u Ie9RF _4oAzqo%$h[ wvޟ?N߯4frf:[iqP!SȄ FrA׵ϡʓ~S(>{9_ 8G_G$G!S? /st 3O$ԧ|2n_aoL@|| \Ԩv8-,;b8K: _Xq2yzp{! B/!p|YTٯ(Icm-'V]bmڬ)z뚷\wlvmzּ[UXr ?"En9XKQn-K֌4:5@r3o1-fkv}-onz\-׸Jzk NXbpY^x^ګAKg¢ Io<٠ gغ+6_gA P? 'Yo٠#Grp3ͨ*r?H^) 1HEkm͝s }RËk9 :"p6W+Ie_=a2uM'C|pm>Jy׃* endstream endobj 86 0 obj << /Type /XRef /Index [0 87] /Size 87 /W [1 3 1] /Root 84 0 R /Info 85 0 R /ID [<5F103A23B347AA444BA426FE0FFE2028> <5F103A23B347AA444BA426FE0FFE2028>] /Length 235 /Filter /FlateDecode >> stream xѹ.a33b c6cƾ%*JhD܃i-=rNNIo"%DʦhVHA-b%mЄ-Xu؆U؄؀p:*3 P.nV"Vz`{LK0P Aj0V%LZQSU3jں[\G؍TԬ}5gߜGϧQ }"ڟ??` endstream endobj startxref 130482 %%EOF bbmle/inst/doc/quasi.Rnw0000754000176200001440000001461613022106105014667 0ustar liggesusers\documentclass{article} %\VignettePackage{mle2} %\VignetteIndexEntry{quasi: notes on quasi-likelihood/qAIC analysis inR} %\VignetteDepends{MuMIn,AICcmodavg,bbmle} %\VignetteEngine{knitr::knitr} \usepackage{graphicx} \usepackage{hyperref} \usepackage{url} \newcommand{\code}[1]{{\tt #1}} \title{Dealing with \code{quasi-} models in R} \date{\today} \author{Ben Bolker} \begin{document} \newcommand{\rpkg}[1]{\href{https://CRAN.R-project.org/package=#1}{{\tt #1}}} \maketitle \includegraphics[width=2.64cm,height=0.93cm]{cc-attrib-nc.png} \begin{minipage}[b]{3in} {\tiny Licensed under the Creative Commons attribution-noncommercial license (\url{http://creativecommons.org/licenses/by-nc/3.0/}). Please share \& remix noncommercially, mentioning its origin.} \end{minipage} <>= if (require("knitr")) opts_chunk$set(tidy=FALSE) @ Computing ``quasi-AIC'' (QAIC), in R is a minor pain, because the R Core team (or at least the ones who wrote \code{glm}, \code{glmmPQL}, etc.) are purists and don't believe that quasi- models should report a likelihood. As far as I know, there are three R packages that compute/handle QAIC: \rpkg{bbmle}, \rpkg{AICcmodavg} and \rpkg{MuMIn}. The basic problem is that quasi- model fits with \code{glm} return an \code{NA} for the log-likelihood, while the dispersion parameter ($\hat c$, $\phi$, whatever you want to call it) is only reported for quasi- models. Various ways to get around this are: \begin{itemize} \item{fit the model twice, once with a regular likelihood model (\code{family=binomial}, \code{poisson}, etc.) and once with the \code{quasi-} variant --- extract the log-likelihood from the former and the dispersion parameter from the latter} \item{only fit the regular model; extract the overdispersion parameter manually with <>= dfun <- function(object) { with(object,sum((weights * residuals^2)[weights > 0])/df.residual) } @ } \item{use the fact that quasi- fits still contain a deviance, even if they set the log-likelihood to \code{NA}. The deviance is twice the negative log-likelihood (it's offset by some constant which I haven't figured out yet, but it should still work fine for model comparisons)} \end{itemize} The whole problem is worse for \code{MASS::glmmPQL}, where (1) the authors have gone to greater efforts to make sure that the (quasi-)deviance is no longer preserved anywhere in the fitted model, and (2) they may have done it for good reason --- it is not clear whether the number that would get left in the `deviance' slot at the end of \code{glmmPQL}'s alternating \code{lme} and \code{glm} fits is even meaningful to the extent that regular QAICs are. (For discussion of a similar situation, see the \code{WARNING} section of \code{?gamm} in the \code{mgcv} package.) Example: use the values from one of the examples in \code{?glm}: <>= ## Dobson (1990) Page 93: Randomized Controlled Trial : counts <- c(18,17,15,20,10,20,25,13,12) outcome <- gl(3,1,9) treatment <- gl(3,3) @ Fit Poisson and quasi-Poisson models with all combinations of predictors: <>= glmOT.D93 <- glm(counts ~ outcome + treatment, family=poisson) glmO.D93 <- update(glmOT.D93, . ~ . - treatment) glmT.D93 <- update(glmOT.D93, . ~ . - outcome) glmX.D93 <- update(glmT.D93, . ~ . - treatment) glmQOT.D93 <- update(glmOT.D93, family=quasipoisson) glmQO.D93 <- update(glmO.D93, family=quasipoisson) glmQT.D93 <- update(glmT.D93, family=quasipoisson) glmQX.D93 <- update(glmX.D93, family=quasipoisson) @ Extract log-likelihoods: <>= (sum(dpois(counts, lambda=exp(predict(glmOT.D93)),log=TRUE))) ## by hand (logLik(glmOT.D93)) ## from Poisson fit @ The deviance (\code{deviance(glmOT.D93)}=\Sexpr{round(deviance(glmOT.D93),3)} is not the same as $-2L$ (\code{-2*logLik(glmOT.D93)}=\Sexpr{round(-2*c(logLik(glmOT.D93)),3)}), but the calculated differences in deviance are consistent, and are also extractable from the quasi- fit even though the log-likelihood is \code{NA}: <>= (-2*(logLik(glmT.D93)-logLik(glmOT.D93))) ## Poisson fit (deviance(glmT.D93)-deviance(glmOT.D93)) ## Poisson fit (deviance(glmQT.D93)-deviance(glmQOT.D93)) ## quasi-fit @ Compare hand-computed dispersion (in two ways) with the dispersion computed by \code{summary.glm()} on a quasi- fit: <>= (dfun(glmOT.D93)) (sum(residuals(glmOT.D93,"pearson")^2)/glmOT.D93$df.residual) (summary(glmOT.D93)$dispersion) (summary(glmQOT.D93)$dispersion) @ \section*{Examples} \subsection*{\code{bbmle}} <>= library(bbmle) (qAIC(glmOT.D93,dispersion=dfun(glmOT.D93))) (qAICc(glmOT.D93,dispersion=dfun(glmOT.D93),nobs=length(counts))) ICtab(glmOT.D93,glmT.D93,glmO.D93,glmX.D93, dispersion=dfun(glmOT.D93),type="qAIC") ICtab(glmOT.D93,glmT.D93,glmO.D93,glmX.D93, dispersion=dfun(glmOT.D93), nobs=length(counts),type="qAICc") detach("package:bbmle") @ \subsection*{\code{AICcmodavg}} <>= library(AICcmodavg) aictab(list(glmOT.D93,glmT.D93,glmO.D93,glmX.D93), modnames=c("OT","T","O","X"), c.hat=dfun(glmOT.D93)) detach("package:AICcmodavg") @ \subsection*{\code{MuMIn}} <>= library(MuMIn); packageVersion("MuMIn") ## from ?QAIC x.quasipoisson <- function(...) { res <- quasipoisson(...) res$aic <- poisson(...)$aic res } glmQOT2.D93 <- update(glmOT.D93,family="x.quasipoisson", na.action=na.fail) (gg <- dredge(glmQOT2.D93,rank="QAIC", chat=dfun(glmOT.D93))) (ggc <- dredge(glmQOT2.D93,rank="QAICc",chat=dfun(glmOT.D93))) detach("package:MuMIn") @ Notes: ICtab only gives delta-IC, limited decimal places (on purpose, but how do you change these defaults if you want to?). Need to add 1 to parameters to account for scale parameter. When doing corrected-IC you need to get the absolute number of parameters right, not just the relative number \ldots Not sure which classes of models each of these will handle (lm, glm, (n)lme, lme4, mle2 \ldots). Remember need to use overdispersion parameter from most complex model. glmmPQL: needs to be hacked somewhat more severely (does not contain deviance element, logLik has been NA'd out). \begin{tabular}{l|ccccccc} package & \code{lm} & \code{glm} & \code{(n)lme} & \code{multinom} & \code{polr} & \code{lme4} & \code{mle2} \\ \hline \code{AICcmodavg} & y & y & y & y & y & ? & ? \\ \code{MuMIn} & ? & ? & ? & ? & ? & ? & ? \\ \code{mle2 } & ? & ? & ? & ? & ? & ? & ? \end{tabular} \end{document} bbmle/inst/doc/mle2.R0000644000176200001440000001671613175504412014054 0ustar liggesusers## ----knitropts,echo=FALSE,message=FALSE---------------------------------- if (require("knitr")) opts_chunk$set(fig.width=5,fig.height=5,tidy=FALSE,warning=FALSE,error=TRUE) ## ----setup,results="hide",echo=FALSE,message=FALSE----------------------- library(Hmisc) ## ----emdbook,message=FALSE----------------------------------------------- library(emdbook) ## ----bbsim--------------------------------------------------------------- set.seed(1001) x1 <- rbetabinom(n=1000,prob=0.1,size=50,theta=10) ## ----bbmle,message=FALSE------------------------------------------------- library(bbmle) ## ----likfun1------------------------------------------------------------- mtmp <- function(prob,size,theta) { -sum(dbetabinom(x1,prob,size,theta,log=TRUE)) } ## ----fit1,warning=FALSE-------------------------------------------------- (m0 <- mle2(mtmp,start=list(prob=0.2,theta=9),data=list(size=50))) ## ----sum1---------------------------------------------------------------- summary(m0) ## ----confint1,warning=FALSE---------------------------------------------- confint(p0) confint(m0,method="quad") confint(m0,method="uniroot") ## ----profplot1,fig.height=5,fig.width=10,out.width="\\textwidth"--------- par(mfrow=c(1,2)) plot(p0,plot.confstr=TRUE) ## ----fit2,warning=FALSE-------------------------------------------------- m0f <- mle2(x1~dbetabinom(prob,size=50,theta), start=list(prob=0.2,theta=9),data=data.frame(x1)) ## ----fit2f--------------------------------------------------------------- m0cf <- mle2(x1~dbetabinom(prob=plogis(lprob),size=50,theta=exp(ltheta)), start=list(lprob=0,ltheta=2),data=data.frame(x1)) confint(m0cf,method="uniroot") confint(m0cf,method="spline") ## ----orobdata------------------------------------------------------------ load(system.file("vignetteData","orob1.rda",package="bbmle")) summary(orob1) ## ----aodlikfun----------------------------------------------------------- ML1 <- function(prob1,prob2,prob3,theta,x) { prob <- c(prob1,prob2,prob3)[as.numeric(x$dilution)] size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } ## ----crowdertab,echo=FALSE,results="asis"-------------------------------- crowder.results <- matrix(c(0.132,0.871,0.839,78.424,0.027,0.028,0.032,-34.991, rep(NA,7),-34.829, rep(NA,7),-56.258), dimnames=list(c("prop diffs","full model","homog model"), c("prob1","prob2","prob3","theta","sd.prob1","sd.prob2","sd.prob3","NLL")), byrow=TRUE,nrow=3) latex(crowder.results,file="",table.env=FALSE,title="model") ## ----eval=FALSE---------------------------------------------------------- # ## would prefer ~dilution-1, but problems with starting values ... # (m1B <- mle2(m~dbetabinom(prob,size=n,theta), # param=list(prob~dilution), # start=list(prob=0.5,theta=1), # data=orob1)) ## ----suppWarn,echo=FALSE------------------------------------------------- opts_chunk$set(warning=FALSE) ## ----aodstderr----------------------------------------------------------- round(stdEr(m2),3) ## ----aodvar-------------------------------------------------------------- sqrt(1/(1+coef(m2)["theta"])) ## ----deltavar------------------------------------------------------------ sqrt(deltavar(sqrt(1/(1+theta)),meanval=coef(m2)["theta"], vars="theta",Sigma=vcov(m2)[4,4])) ## ----sigma3-------------------------------------------------------------- m2b <- mle2(m~dbetabinom(prob,size=n,theta=1/sigma^2-1), data=orob1, parameters=list(prob~dilution,sigma~1), start=list(prob=0.5,sigma=0.1)) ## ignore warnings (we haven't bothered to bound sigma<1) round(stdEr(m2b)["sigma"],3) p2b <- profile(m2b,prof.lower=c(-Inf,-Inf,-Inf,0)) ## ----compquad------------------------------------------------------------ r1 <- rbind(confint(p2)["theta",], confint(m2,method="quad")["theta",]) rownames(r1) <- c("spline","quad") r1 ## ----profplottheta------------------------------------------------------- plot(p2,which="theta",plot.confstr=TRUE) ## ----profplotsigma------------------------------------------------------- plot(p2b,which="sigma",plot.confstr=TRUE, show.points=TRUE) ## ----homogmodel---------------------------------------------------------- ml0 <- function(prob,theta,x) { size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } m0 <- mle2(ml0,start=list(prob=0.5,theta=100), data=list(x=orob1)) ## ----logLikcomp---------------------------------------------------------- logLik(m0) ## ----formulafit---------------------------------------------------------- m0f <- mle2(m~dbetabinom(prob,size=n,theta), parameters=list(prob~1,theta~1), data=orob1, start=list(prob=0.5,theta=100)) m2f <- update(m0f, parameters=list(prob~dilution,theta~1), start=list(prob=0.5,theta=78.424)) m3f <- update(m0f, parameters=list(prob~dilution,theta~dilution), start=list(prob=0.5,theta=78.424)) ## ----anovafit------------------------------------------------------------ anova(m0f,m2f,m3f) ## ----ICtabfit------------------------------------------------------------ AICtab(m0f,m2f,m3f,weights=TRUE) BICtab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) AICctab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) ## ----reWarn,echo=FALSE--------------------------------------------------- opts_chunk$set(warning=FALSE) ## ----frogsetup----------------------------------------------------------- frogdat <- data.frame( size=rep(c(9,12,21,25,37),each=3), killed=c(0,2,1,3,4,5,rep(0,4),1,rep(0,4))) frogdat$initial <- rep(10,nrow(frogdat)) ## ----getgg--------------------------------------------------------------- library(ggplot2) ## ----gg1----------------------------------------------------------------- gg1 <- ggplot(frogdat,aes(x=size,y=killed))+geom_point()+ stat_sum(aes(size=..n..))+ labs(size="#")+scale_x_continuous(limits=c(0,40))+ scale_size(breaks=1:3) ## ----gg1plot------------------------------------------------------------- gg1 + geom_line(data=pdat1,colour="red")+ geom_line(data=pdat2,colour="blue") ## ----basegraphprofplot--------------------------------------------------- plot(prof4) ## ----latticeprof,fig.height=5,fig.width=10,out.width="\\textwidth"------- prof4_df <- as.data.frame(prof4) library(lattice) xyplot(abs(z)~focal|param,data=prof4_df, subset=abs(z)<3, type="b", xlab="", ylab=expression(paste(abs(z), " (square root of ",Delta," deviance)")), scale=list(x=list(relation="free")), layout=c(3,1)) ## ----ggplotprof,fig.height=5,fig.width=10-------------------------------- ss <-subset(prof4_df,abs(z)<3) ggplot(ss, aes(x=focal,y=abs(z)))+geom_line()+ geom_point()+ facet_grid(.~param,scale="free_x") ## ----oldargs,eval=FALSE-------------------------------------------------- # function (x, levels, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, # absVal = TRUE, ...) {} ## ----newargs,eval=FALSE-------------------------------------------------- # function (x, levels, which=1:p, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, # plot.confstr = FALSE, confstr = NULL, absVal = TRUE, add = FALSE, # col.minval="green", lty.minval=2, # col.conf="magenta", lty.conf=2, # col.prof="blue", lty.prof=1, # xlabs=nm, ylab="score", # show.points=FALSE, # main, xlim, ylim, ...) {} bbmle/inst/doc/mle2.pdf0000644000176200001440000074725113175504413014432 0ustar liggesusers%PDF-1.5 % 62 0 obj << /Length 1888 /Filter /FlateDecode >> stream xXK6WVX1|K1A@X-Ak^5dHr6_eKhҤ[Erfy/ x_xy0 0)^lB)taa*Ck-e,3'|ueqWÌ?յ]˻=|hn/ -K^RLDsCdx{vWFbL 42ʷd!17Ě3v}H`5Ŋimi﫮0*KfW8H"EBD%LiKDPRu2$)u-|E]=hNeVZ<8&z%K*Pe ,MW TYeT2Yea@*UmQջ"_"* ->Y>%R7RWK,U@4ou f-qʼ\PY.%ͯ.rm26cr0 µ#5% '-*>3L 5ԻzC7*(7\{蛦^RDE==F"Kҋq4vzS,Tcϕy6M%j[Sr0 qѦAC=yulig%(ƭXyEٞP4v 5z!&hj eQm=|VBY~YjSQ w42okYv =:$dqGh IѠu(oBtMS7S;=~ d*pυ˞R7#s^dGPHeu3e! }+~gx$Os妯#;W8T$=`~l 3wl( iBQlpRF;j]Rj]`·.uI |.Z$+~f,婝QYWt__IH60#ą<\Iʲc6  jdsV:H&WyX@T@J,еpOh L .p;i7>x6{)iy T~I(؞CSLXi=X̞&|kG ^!P~YRJ{' b й b)fЋ``ıhI *.nRZbAm9p3 +2-|?WYfy jR8[yY DșKyEb;<9G>_]ZBATbѺUm!Mɺ)EU'[z'Ϝsqes) SmXhMWл,5_}Kf}Kɣ-~ʸ|W|Bɓż% mS2'E߄ 'PJ52\k_H^A>f\Ἡ 㷴[[Ƕ Cvm[ͮ꧎AcdJÀ|Oeї5\iI%rQMЄk1%9=`| o+ॗ\J&$59ӄ{;ڑza؟2(gwS"6dT˴C]y P.L3e'vA -8}R7yXK7B]ᚒ^ѐN A0~RTn iP6UǼD+6]G?D;Z]1 %O M 饣PЖ{;As,I~d.`BM*w),(IE+;U( ƕG}4bA,ǒ֕-}@_MqոD%viA[&k޼h endstream endobj 83 0 obj << /Length 2301 /Filter /FlateDecode >> stream xZK6ϯrpsė!6b#sKr`Knzt$<`Vԫ[mg2(X+M |{ IBzW1 #2"K*~SU<ffmwvOj]~w4tctLPQ+{Vuͪ,ނfwъ#?\t'ŚRHgjYE$ܿe e'j:\ԭQE[Q"GKukgpul-=.ۼQ:Gm+8VŒ7+զ-y&8bٻCkMag`xk0µhN'pdYvv4f8 9fY4!J^(*ޮ-oʷ~nC@O3ӣs}u-HYb,O n2< S92Cr)r QuJH dyuiMu!;{ldAN7yU*YZ@9f3LeX$o A5ښ4SYĄP `.$]ldb#Erm wNS {߷iwNlnuBʙ1)7k~<"Gn tE .'$9Tw:B.TKWPՕnT Qw$A/( 9"4؎?Xq0;}ߗH4${L p+2oHDŽ@bC>1lc!&K?tm|iDqZA BO^iLaGZ/XbgAlͧx _`O_ wShv׏wCi28:S۵GVGԛ Kԛxǰoͳ?gmQ??!3Ǧ ~0_vk=?1>Ci p~YjvlɵGE?=*OT ""&q­!0' endstream endobj 89 0 obj << /Length 1774 /Filter /FlateDecode >> stream xYo6_!`H)R"6lfOKGwǣlYv؃;=ҲaS7ǦyӉg~(pTdr8Le0;7Ug!~D@`uoc@4JVv 9_YatpcWo8/YDyx8Q}vt8!m8ːLPY6Ҳmj ?Pog[? dEJ=%C/~N}LlQUs":\Ai(e6 XuJc\bR`24&\O 4rY sbϫjF. Kj-%kQrPYUo7 .1PnլPDW /ڼ1u=E\_o ``UC907M){Vջn5F*:;j 1Wf`gQy(c%+6%30Pm}5(nu]554DV%Iٔț2  ]yۮ6gW e pA(P9Qo}M]& Wƹ6hz袢 3HO!&'dՕQ&sP̗֘R v53#R }ۀ+.ɶZ6Nuh]=1\hA?!}\) .45͐JOR\$'첣S༶pAs.>n>qweѲp h$ >CdȌY~ۻy8i.XqZ%)\уhKM:džsSÙ ppܔK!@ Jx) `Z 5N aFǾFv0Fh_ۡ+y#iUβ =IV&Fuv04j:]kJA#a=z 'R81If 30knk0;4,zsqpj&&/BV>`^+L˿]N endstream endobj 94 0 obj << /Length 1140 /Filter /FlateDecode >> stream xYK6W @C$=Y$ŖBJtΈV:m.0 !A|$ a Oջjd$\JhS!-ȇ`^WY5Ϧa " l|*Eȩue}I GX0̍̚~~8&U'זv2{/{~^SLex3Y^7FQ$Q&%T85j0\o,RD%LW8фQ)B#_ZyۣO>lr;A1amai<=/'H4C MFGt|m}$f'(ZJhǺC>!TBo“d2/dx'v2zCb%X@(5Oy;%&H(8Ąqk3D|BbXvD8 SRej5?mpպՍ#hE^y (z=NGЪ[o-Maqe^%{հU&]4箙ajTږ{V|Sm+ZuVFE%̝@=yVS̠*T;l&WΏakȞ)[:v *k<'cN7uvk-T: ?>5* ye/Uקgqcx@4h%v~W G63m?>P{(1Go'4M Qyo%'ԀU_a/# ߤdJP"7?h]6 endstream endobj 91 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/profplot1-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 97 0 R /BBox [0 0 720 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 98 0 R/F3 99 0 R>> /ExtGState << >>/ColorSpace << /sRGB 100 0 R >>>> /Length 2146 /Filter /FlateDecode >> stream xYˎ5W)Y`rH AFbX"^ _ϩ*wsg27IWr0?bk>z̟>O?-igϿLa~/ WS.DAAk ~12wnЄwٽysW~wbPuz)WG}V"di ޻<?4tճ{x5‡QTJq|?;=_?_=FΏ^ =@%X|5_~ mS #Xbۿa}&mh .Bo\<\buTalR%Fx83쪗 8"KrT%#΀iZ4 $(?MpyךBy&Tz4PhOѰ˺A`r'$I ~FbZQ` {t\L.IZe[M48UA*/~w^~ۧy:H\ce/:W7O}+;t˼L4 endstream endobj 102 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 107 0 obj << /Length 2528 /Filter /FlateDecode >> stream x]}83"EJb{h\(6@kk5>wCIPzq,r8$Pwx8UGEt4zc ]6DPoumѫ7̜EaСJqz0I[}@Q0q#c> emRRkQ^07vxM 8Qy֮'u@-(c~meƹu֠$`n6z ƣ;y>+X[*Swjh<,l[ֽ_ZX[Z!l+&"!!DX *;(zITq<9ڬP}Z& #2΁u6#p7QxQTj .Sdn φ&)p*Nظhs\\b;`H(T&g?UGxqb,j1:Ł{=*gf"S:g2?,nUXoGƊ,Mm@ej 9p$al1u1T,8I>:C:"#)<|Tq\2, ;~׷aIAnC۲mM" #։z8{yVMK !o6!>t. R4>brpGʮEŽP)PVa7V x4=2-}MO3o ˳t͝2` Va'=(ǧq YU>LGmd)~Qu!0DŽAcGwء-hc6pz!#̢i llk3-?bkXglܺYѪ\Qt2ĴhJ&&w[0 gIalgwbFM55+JX<ڻ-a<>?ۛwW;/x,X"j{Djz8:b}'4ύ? C KA@ '.)j* ?.PϚ#KI,ʊgKEJN?FfqnN&J4<@p4+eDM%=y*9ۜc-?{cCw^|]TU`k<0̾53| xފ.ߎ>2cp"3"/pb8C郿By(]eԄbG%ZDd-38qPj9S+c+*6kCrYjͳU@5E]_Uj9'H2WwPvZwV;C*%f:3hhZr캈ne121mn|"ˎ"eTgXܓW kZ(n a #!sjb}.'[tKCO~lȿ&ԵG6a>ȅ,+ZruoNTњ!U%8f <ͽr\E9#Ek&!t꒏#.C排VGz%Gt9<>^=ƌ%kwEկ#mǰב%kwNKcSE1nӴ@T!"Kgql 0O_~yL8Sk@&L;b#-K-B4&ZeJ?ڟ@0gZɱ*ΒdH~ܛ^(x;9-ö/džԻ /9O<ѷB;f djG'g8+rǿLm|t^VDID{o+:6pmMִuFBK;IZx1sS͒TKƌ:@?"u| endstream endobj 114 0 obj << /Length 1883 /Filter /FlateDecode >> stream xrί@99UdT%l PƢ|}z@D*lQ.,egfؽ+U!(z+0 <)Lx'P_$Q6_0%8j" ]>P!,28"+u>PD^ TTa \6?WcT5\mEPD,cPRZ B/v*I«5RB\Fe\ilD9 s!hhjA6CwlKim#]A?Z&?͵40D&" `  ,0ʲ4mƶ*Nn MbmP`PlxhZ"# ^T=`@rez߭~pWf <3C| x0y쭘E= ;pghQʭ2S ]Q4hԟ&*͒< laC.I|14'RVAU|rÄƤ}GxaO)Iqugɋ̐nnrYo<>b~CBaHH` :LMABM1GNsȁ PU@Y8 )u;}-=?qE+Ήナ8;3c}@#&3*nܙj끎AWn9]7v´\'ɷbJWG+PKqu|,t*N"-KyӤywdFmiQ:ZŇ%e9j" [0OGWx endstream endobj 118 0 obj << /Length 2183 /Filter /FlateDecode >> stream x]o6=BhVb%n_]\mлƦm!J&ۇPlE"ÏpHT~n~|wh {R7wW߼MeZn(e&U͂_}w0haկWH,I8,ND0]]!\EihhIP`~ы:sbk 8Wp?z*=R,iUĤ$ӯ2M1⺶s[SY^lڼ*' C j|]RiMjL1v`azy0e&JcoNZbY]82>9iD% +͎eL, mkZ]/7MpZ;L{@&uy.s@83A:aY{{}n+򦽔yĂwA/JJun/vҞ_+qc.P>7 gNsI0]53N(BqYt 7 Ǘ("V-D$m)Z*?^$4!ii]+պWo7(,.+<&p\[/op4㘢4W_T#Rw+N"g~hyUX߼3e\FJ2,c}2Ӷx]OŸli)a$=z %Tsk ,Oz|+O6dۺ3[)MI8n 6SSC uxf ʺMk(d4,w)/(,2=śr6LH?xʸ(1 FfdH3-m_׌G=1< ֓b37_A$oVP0.A< $Dz2GLΪRڧ@sH ,>l*| ֶvnTSUSlD/ʪ^1ݤd4`ٱ9JJS }JU y{c4`1'2vmjZAaPF8ttEBz FqCb盂XwN(U(T 3]?ӵT/9;Dmmr:$vm0%qpudh֡O,a,va dȈmƎ=Lj7o4yՈE,p`4M5,zWC)5تUƢ_ϞTֽ:{p]XKp|{Bsbqtӑڊ}v(῱\mr6/[Cm}2a@u4GRW%O@6{[EqJGJUCW{0T3~GWw7m7-pPbY CFse"7M=ؤpwF`"\VBԀQP.ا55;(5(0T:jh L]PXSO#tC!Fn( d2y{?./"fY'ڎ eZE™u,LhwWCy[WKvsZ _.^|O&zOχL:.AIEҿGɆtT5Eq;l0r6_EG*;m>  8 vz<@{-RZ ;a:g\q4e1w7wbPRiL&r&B&Ѷ2%,2IxWI?"_V얀pgYҷUOb)LY %pє9pYvyR PۦiKJhb>qWyKM|$,#ak, ߢ`@cuvYL٧-fm;^N!+eݱ@eaTQ.} & Sm[thOFB̧FxoEDde?U\1I0y~2'7x1g{lmhy //Cs~GCIXPHC1,L75]b@67 ^{a:p*g3!wj{\m8Ї/g|XDw}޴Z7m^B h8.nN=/3tLfQh #BL?^I endstream endobj 124 0 obj << /Length 1894 /Filter /FlateDecode >> stream x\mo6_!&1wQCa0`]}h;@dG%߾#);KX90|9{ F |~tr/}⃩?vCFr$s3]θ.o0nۤ/-f!Ppy5#LP\N@> D 1 Eͳ4Ѱm ;,p>,Q᫼ F Orި+$d)Snv:4jXCJOODlDjiZK*]^EeҭhEV@TmA 2U-FVʑאb)s 17ȫD1W-al<Psn8 eMuuQ^WfOSxej /[N(.FLGPܞ2~uc屓>>=VMc^V3qt =?I&gmèqMCQouE| YV\/<1Iܼ׌ 0^AP#GS N0@3`Ĕ. jmc8}("Xi\"wh]\u:.nt_R"FV$JQ}U`rf(`<ʬ†b$(#ی `,4 $cyTdQ`$ ׀j%p`Jy[XC?a,!`tZ}iO0ax9@iAH3!mi7 moI`6S'T;T=@Ej6/i_E:sZ޺n!ǂrNxhß **e B5 -0/PCi$7UQ6e>%I܎  WHU:,_ю%Wӄ!#>^u;Z3j%r-^B @qi&r94F@cUKShS [[.rU]`k&k%:v= @oBtw@uyٹQ3o2a]Űe `zIf ܗ%u(N ";j ~?JS5ڿږ+{9=Bj" R #W-3\)EٕZ{XxvÎ}9m# #=E6j{ }~碿~烾D';Vc?77dC0\BGi:}iN QI͏k1 mNlafBh]7 gn}qxHd~ LBO7M>ZFbA;bN`dx\&,h8M,?We nI/I'a܃5k[N(P$ak' }Of:#Suq\jsCF.5GuA<@2(ؾNfA>!->^a}m [@61ajy1<7ˏ!0O )).P,ŀ<aZt!.U_*/OMk 8LݮӨzʹfp\aR$Ow[k'_N  MrߛW} ª?C2S꠽2OU Կ݋ x endstream endobj 131 0 obj << /Length 528 /Filter /FlateDecode >> stream xWk0~_!t֯c{Z=tiR&ud(E'?t}+DSǕ}OdYhzeNK͒rieDŒ;v3ɊGExgsf~+;s~%ouge=E@  Ppc6z1Pl]w^SxD4~зNl[9rL6"7$ڐuN=`-!\(Aexؖ2yN׋tX>rN0v16 Uݷbτ?T|=b:PZU_28Hf?.OpCm*Z4u)NFFTϫӯ[>gTtDTC&I,%5rǡrLo+iG% UVE@.ՔV1 p ԐMp={QJqBB35aؑs39L99(" (Og֏E~N|/K v?. endstream endobj 127 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/profplottheta-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 133 0 R /BBox [0 0 360 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 134 0 R/F3 135 0 R>> /ExtGState << >>/ColorSpace << /sRGB 136 0 R >>>> /Length 1306 /Filter /FlateDecode >> stream xOo7 )t)H@j99ص6 PY -E"螹ݟs=O%?Z^rY{%ryZ9[-MqwFz1kL|0OGmv.M?qsn?z~y So]? a\rEŭ; e(lpw>;S%'S>V/Çz!F*+Ϝ1{x0Of7Gv. B,ĝ=ط%]rd0\I ofKnӽ,׬>a.2|X]jR{9Vb `smz9i| (X|.I0ڗg?]~ysÇ7wwϿ=z.=xn(tke f.W3'+17(:z_^ȇsm4?#/ ŇFcB `7 Cb!6ڊp ?}ՏH'QO3{2&Z1-KZѰptEAVmd#U2pDib"q2VTD/3t"oVr#7ÿ(7/a(J,+)}6^=w4b pyhpFPu-+<-PÂV@> 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 141 0 obj << /Length 1002 /Filter /FlateDecode >> stream xYݏ6 _!N߶˶v0 X=rb7zGZ0A+XEIEH1J aݏ F@y(cᄫ\)$U!bǂFZUa\Oy[HC~ ?&nyFFN? 9ՒuB{TKz-})wǸj*vաq,EE%6vaә` LQq?&z=R!P$REԄ eڐڒyPmxn_8;Sق400 -9thi8{OZ'ԡc=}Z#=6I+=U;i  ѭq_W{޶ 5np5Ј#u4Ub(4"MZxU&jefn(,)9<%:Cq8|6 @&+XeBBHXu0?; nMNC7Dhz"On^_› eFwq|Ψ2 fwIuoOn"ٯpu{ gMq% Ϥ8 %\̧L;$ pV5cbOx}Pi/8"rF[˅ϳߗ"l]"8"nؽ#|_pb}!oCEG_PO>wՑrf3%LYy&}.ŋeu15@A kC5pjbK_hg A5n#o[HMfkWo+WU]?#d%6[[n;,}p8χjsWi?jXA * sNj-"aGi~G E܋7YYhd0uVϼhx Qғe\Y$TNN-K{5`%JU: =opD!hghh0ao|_ttj endstream endobj 128 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/profplotsigma-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 143 0 R /BBox [0 0 360 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 144 0 R/F2 145 0 R/F3 146 0 R>> /ExtGState << >>/ColorSpace << /sRGB 147 0 R >>>> /Length 747 /Filter /FlateDecode >> stream xUMoA =0{9 +qz@įGv7irn޾c?{Ή~u;Y~wJgN+5M..Iut]y}bR&Q0ZZ86]J**G~}OzO-FG! drB2M_?m^mswdCenqTm)'HW^xoȲhyx?NU#_ȋ ʻopp~~IB^Md9;r0OZ3ismke%'7.fb./]|T⛹VUHjIݺFkxn8M38e]b~I4=7i=z|I":8&ϙZ.ka$Q>gʎss@60t &@>;ZiZ :Ȏ }W^{ =/B%(tsHI5HW6Q\t#Vۣ pRb2f.QN%g_%] k7GPszd/dG1E\>k8kK~r)+0_QaEc%_by:` [3I監2|S<%HP-x ^!` ջamoejEJi+*Qε endstream endobj 149 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 152 0 obj << /Length 1350 /Filter /FlateDecode >> stream xZ[o6~ϯ9X^ċnҵC 2كbɉPKr%;߾CR%g1lRkO,R<<|TfQܴ߫3Ɂr^(~oqܟ;! #cıp&ng~ B)X:EL~{J-ks|;FA3B93@Cx:kg˺|S!|,dq-% 9u9NbT͟cu,O˼ȯ&y au˻h?q׋.{H xW.90qQvЮ pLzP^1!d ]kZtǸran]8 ^Λr!*΅F7cz88~S;A0#_rBWJO栳C~{9i#jGp̖$q<7sR!'Z8vH7@ s= y k@^ꎈq"G}$o^wf_S 4@L2+GX‡8qDϒ|AM?YjB %fG-xVAkp?8F GWY@\eDU?nڦN)N>pkAii1~I>#~iFW#Ph5UҖak{&{ FEKHHK0R0ӃP!Y-}OV+:vU%a6+ۤSPj}j&إ0tr Rhůf i4z3TՃrq> stream x]Ks6WpƂ#6vT;=wAQrƢ FqBx `?ˆq8飜7>s\(BQ^:?(qDLx tBF2v.~ۚ՗)is.k|Q3=:G;KU5Wh1!(1LQHJ.F 0}M{,Jn7d2&mdv"sFON- sBŒ*~E1v8eYUhТgQd4xҏP:%(DSTE1YN&C܍r-{7.,G1 [tB+s&4T)GTS^:TAgKvŌ|>[$<Ҳ$2D~?}U#hZ`lwV(ߡ@Iaܩ땴#kV"tYFYܩRܭ&HY{dZ6I3g5wlL / ް#Un&us@,Pb> x߃BcƹGӫ"tEkt),2L1ap9i@VCoʤsoVBXبu79v}mn$O$Jlⶏhn' 9%@BF@nThKLʨ҇l狴r~ǡEmAIPJqz~Q4}>w%n?*.MˉwtŢH^Ϡa7*.76. >!T3&§$aUQRF3-Q_]LJfb&YR--o}}9 1ڒ1@aA&e]/j~ͬWW{̞x+ȸoNel(N,iM?ݓ$ɋlcܢ,&Gku}4y&Ot<{)ߺ[AB!!lxn xMD3޸cxS,!l/!~m^0oӅ՗u {:Ed  zGEi},erI0.͘N^% {6h7rmS BQ4`)`K-Xj&XS CZ[˲Y,hjAS ZԂ4MwM[pXI!"{: yG&ӛMѿiqS} Yzg.ifV7>Ǽ| h &4?<, - endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 804 /Length 2196 /Filter /FlateDecode >> stream xYo_~BGM.F鸔.!ػ{sG(4ŨE@rov733 f1oXdRЏILF SZ1rhS?ɴ #6)phMdFyiaZ3+fE{fA0#Sfxf,s 0Af`a,@SL$ tZPg@16K(!LPLyG.h; >t,@tA@6ik4ѣ B,BE #2cbTPqc$ (Z.t7`T (KRH4T(HAb`mI|ѫ f`IhOS4LXAFlE:tHJ3g!A8G{qGH\>쳦}%IuIؔ76{h]?>A3LJ@'zA Ax@ٺ_{3PC_@8cfp֏NN73vԦ+*/GG_giz4e^׉R3.yj4feU|ziqyv2o˂Mʎu5kbw)u78OTϷiI~>EvԿS#?oSݓI2i+ Wb&5soamLӚ5UYn]NG%57'崬X^YQWr"R!۝mr/o,5MC˜Nm֗L{hs8`oUv4d>O_.U] 'z #r.#;p>4 ^VU >iIj94jhИCf@l.v.;"KekY:_ L+.5?=9Mq84 t/00<-L5\`u=)cjX[fv>{YrLRC}Eo84M^۶WM!XteS,fiȻr:N| e@)yQ`m Ah&ڼQLʛl/:^_U9ky֝=ϵ5_m=o.G3^@&R@7{99]/6#C"#sJ+kB}+ŲOWd4 jnSgp2,5F iz(1]i$ydC!3FE ;gh)VN-?!X0lO 0@$x=>5gj3(J?%orx5+},f{~ɯcJ?Y~EoOK2|l? n?2ڃwxZ]W`~u"_iXwx_ٍ7b9> stream xUKo0 W>XVSun|[wH'1ԝؿn@m AhQ(JIPtI|~q% 9j(@ ɔ3e2浲&"qq_R>mOM 3o|DD?WF?[e^ (bNzX3^KH֯\zJw _1]3զ뢔R憣6ʇB|Qy&xIIVz2Z&0l;Aз}f/@jJ>ǏgZghx;k sVC%m m1#Y endstream endobj 156 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/gg1plot-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 169 0 R /BBox [0 0 360 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 170 0 R/F2 171 0 R>> /ExtGState << >>/ColorSpace << /sRGB 172 0 R >>>> /Length 1520 /Filter /FlateDecode >> stream xXM7 W%9TkM-@ANu4{(_GJ3l]cG"D>sCϓ~j^:y_82W7w/_gi] l.d0v[iӄT,1O=O8M0&tqLp)g3m3Bؿ3lL0ڏd,`5v?OSDڎ-DbƧՑEwu|KjlSy1⌌lD[l],.|6xk%rHc\=W/{_䬞NE|$t)X_"rd,]b}-RO3_> ,TG)(O@r;pDϬR#hYO)`Avg,H]FtzKPa"RBHDƄ W+#Ƒ:/,jY>,`EXjY6$cI2q,@4KWT_*`1M(p k, ndfJ;%KFU".Xd]dP`qXU}b bWV4ԅ"1 B$M!͊E'QBAuX+bvu@J : :YW]9e }uL'1bPp,q8yy\!p!t6 W+r9:@K777ĉ@Bh NBnErE@\R&ŎEAk⊸&₸&)-]ɿ_N:Ԏ\X*R㊎6$9y^Er&53&)aύ35qR34;㢹и:_(esß(/ee[+ei^74Vv릓ƗuȎqA.j0#tu4Ǯ7^7sPwcD%L9Jz_>yck}ϋش䭇[QkkV|8}s'ޏz~>p%f% z|&W2{m_'{orTJp.^G9j=LĂ(kl^}^~zN&+o'!{ӭ>ك /:3NB#8 nm]~wC hsjv]?Lrr endstream endobj 174 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 178 0 obj << /Length 743 /Filter /FlateDecode >> stream xYKo@W|',UrT{Jjm/U U\UXC@]dGҾvfyflϫˇA Aj=QDe3l9P/aW-~\Jt >Sx5mAdpzPChm@)]I4tqG_ 6{D^InaM\R}4 <_0ODWz6fjk,HߘwBy+ϗ[/' Q*DU:)ֹBD:myvF7'ldi[@9ǁS$?Q'ׁE8tI&Gg^'3]p\(KӉK?p,]کt%+]LS  {%tl#=OWx_>?'i>JC<9ƥHKˀ,Z.Er-yK)U.]%~.}=[-he}E] O^%fng|2i4d0VY%>\+wXO[#L!UHxnVɲErn+.͞szFpv2p\^ rDw..L1ϊ27Kۧ sA1^d[|4q HM \Z׾=kz-$}yJ*B0Z*Q䗓#e" endstream endobj 163 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/basegraphprofplot-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 180 0 R /BBox [0 0 360 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 181 0 R/F3 182 0 R>> /ExtGState << >>/ColorSpace << /sRGB 183 0 R >>>> /Length 2929 /Filter /FlateDecode >> stream xYˎW&HG6B ^^I#EJE|}Ω"ifΰ,UuXv}?lƘu9]~q5Ů/nXļ`j݂,Р[-2^,78ƭI[ O5CۻWl_o`V8ٺ]gfs׻w㟟fqvxZg[K*E\[0Boozz^l Q f?q`Kc6D=:b}l5o q8$k"4㳡n.ح'%vLI[8)lzg7GAs6oQe}m"#Bp#[qpJ_1v^V<Bi[/F4Yؐ!O6Jİ'BFF@C5f=օ6'~晲E c}`BI2(.les l4N5U%` 0hep EB wdwh-O # 1S!3pe+( #6g tAT>xrU'3Y8Dq`xa#`ʺ*Q{Gr5Q-@q%6vLzĦy1Ke_DfCyMұpQTÌ݅)E 1oL2#ډ+XF~g ߇ٝ\k0"ƥ5ı8WJU5\֭sgj\0믰n"п!qrYN\9y1`D6Xx4)8L,'[d}UA3D\) s2>D 6<$S.I&촜*CA|k_A[ZqN'?L,[7šT<9\+dz{k;ӵDǃL98]IIIichxH0)u8s.[Kt%uDp]bpm,Ѹ>ky\eީ[ UlΡC50::Gys#k(]#ۿu_u V`pgSP aaDatT,LQ%L"X%UFr X5 R"a62nyg*yŽ~:Cg J58L㲤Xbq0v%X>P\-Ʉ: X~xĤ4*Dk )%n@8G:SW2*`"XKW^" 8RbXj% V`#T$+E 8\*TʱGŅTDsIjGp}g`I}0 X3B1G}DP+o J{e0CM4BTPAAib7 `ʒHm$ɀv{|RE\RfTfdly\ImY_Hbyy!qEr Lݱc bz\&-9sø.} S("nM5>ȣ없AQI3<Pi)Dǧ/U<[/ )R)"YrpOE)]m-(?#A)"CЧ3K=M%n^q*";vܞȆ rI{I>hߎ2kOSo-aXQy*f0b ۚA*WcY, 4ٟ:fʹ܇L^f>2YrcC| NŜ~p1>Y$-t`ҭhY` |Ϸ/Iwwv/ܼ.}:w.QQ6JĢ|βJ⤴3)]7K" Фff+AEgQh:MRyZԡk!?\V>3ʜ̶ ,V//)ٴN`eV$CJRfiӒdp&9@^QRދ4JTIWIK,d6 RW|PY ce]SiC*$\EGB9nNۑ™ٖnez1,4PoJ,)XnSIP1ct@-DăJPsF҇/U+Tj('PSD<=-l yڶ5[RZas͈!WE Fև%TR/p{j+Or_U#;WU8 f\S1ԓ't &OnNˣîI0㲜T75"g`zUS8 f\ k HsN%'S8grEk C~EQ j>/qU&ZR endstream endobj 185 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 189 0 obj << /Length 929 /Filter /FlateDecode >> stream xXK6W0Yi$t.iӦvUҹfbyt#.po.ѭι;ۋS>{l> /ExtGState << >>/ColorSpace << /sRGB 196 0 R >>>> /Length 1503 /Filter /FlateDecode >> stream xYn\7 ߯^T)I@H=@I =t'7f1p(E1d2>nyr183'?ƙH 6;C.Lz6(] ]vG?֟ ~_l}2ksٽ~؍uFMц\6/n?捹O9Kcˆ\j̼~sn3g/N\c`fpƞ`# ěXlPޤ+sѵH]\胷&.X>YY,..uc3Q&}U"a[@&s%(&~ܗKnq1yEִ5eT֫}35͂SnڷwȁV!4_~MM.ؘ'uPlYą¬og(Jߨ⌍l譤t|| ½[Z l(wl/A|>HȴkF1Y?yH܊.ʹO[jFo&K&&zkCy` نe$eܣur=qǮ^2xD!4V{yZl=eͷ<$+R/ńMT 7黸ۙMg6'wr@(}۷@g;+E^98܇'gNHl)Յz<}Xo  T0N7iH79Mc"[B>MN5V۲Ŝe+3 87&y9-U"r2Ol>Wk;VAZJ Y@|TQ48Փ(|VTF >V>!_Ru=uR MSf w.T@H'JX,/#$^FKI9uߍpHYs&%JDgUMAywqǶd&=]bj.5XE7G *FYӖ6EQ cf/] M{$<^oι-oXDX_[Pq<.^@В`DרQCۅIiC KSL Bځa=DY̓zGƄXeAJ+"SYˉ`U J{1JO }ć` endstream endobj 198 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 186 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/ggplotprof-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 199 0 R /BBox [0 0 720 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 200 0 R/F2 201 0 R>> /ExtGState << >>/ColorSpace << /sRGB 202 0 R >>>> /Length 1759 /Filter /FlateDecode >> stream xYKo7 ϯ>T5AS @ 1CCEC~H#c/-r$>?k;eWe1#QbwszudO/y7?gIe>_'[7q:|j"ڂxmܽ]| _S mD!hy=o6Nv7z0P `h43SlǺlMz'C쁅LN ˃bgB3),QXdE(뜄Efz08[?oqa|F m~_)1 F Q5r0\2#[f#*k_t 9-rQ\8,4^Y$3 ے|$QcDatᣑͼҙݩT:h c WD8N//WoR.)Auv}.b1XMgm`#,=q4,lMu5nޖfG0L{jRńWE|89 WƬ}C#w"SO@/x" w Ʊ QH䰙Nb4Hf041igXӎ*i}wW3aS{K<\G u{-R:a/RϥfsU(Vϥ##G?K;D=xߛeI) uMi_^ QtY3T13*w <6 l4mPM3 QU!ȯdfYٖl*KT! (}Hj3śrB"&"#ĀD Du9󐾾,h.n$$ħI8ZŎ/~,Zoϫ?rw^9֗OЕqkʹ_n 9ROux' ynbθ:(&mn?|kd/?w` endstream endobj 204 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 207 0 obj << /Length 2333 /Filter /FlateDecode >> stream xrܶ]_j ą:~p\qm&җ & %_߃ b-K*͎fD<8X󽿝w'c(/=L#,Dayk}4hK ZTKBbSKhHZي$/]e-Dla?Dm+N[$/m7\i(ke+*qm=E3A}D"1?4qԪi.5URCuċTڑiS"ocT[ըV'7I 8VQ7[i Nke@zO(`B6@ÎA¼#?Z>㮏Lhr˪!o?U ^1aJM_e# <5#_lR5F0:HOً_I6(;Ro5ZJC}i.J}[­RΪQQW:P>nR~:]RJk/ h:JնMU;H-,PyG?b>x~w~ˉa3x=FB1@uxA^-˓(%4X(EtRMqc`!)dž(;K0}?n`Kla'f͎ |NJA=S(G 1ؓ[i倘]&ݞ|ko=ٴҎXNE Ȉ ?nja8}ڵPՈNB{; u8QNKr+)FF~zwz*8ݐ)~P |G qc"nbdzG'+W7"~0 u#B?}DMc ut !r)y >5+6ǍFqQr(9n7J%Fɦ Bꃑ7?;Z2!Ǐ!%ˎNl'T̫cY+'PFUZac۽ 6qvl*eJXW$BS+Z>sS(pdNn \v.|%-l5&5ky62T#2ɫbn<Bn?hW2ktgqr;q'nֈB&*o&3 qHu./:Iɘ>ѶdemKߥ֍ᵁOk LtTg3nK? M]a&D3,*6qcC2I+ 8("KuDe./$]:G1#j`նr9E1zb9<]P 3.YL3Qp,!ÄY)FAG2a8 r s6O.q9iZ4o{\Qkx[ADB]6Hm^ HML_ "[iȲɗ=Yh}t9?7cձ.USM.y>O4u2(e*m"fRL*V+(xW<}@惦cp_J9"/rՆ*"1ԇ`giFG_rGE B>JyK| endstream endobj 211 0 obj << /Length 2218 /Filter /FlateDecode >> stream xڵXKܸWQmiQo  &H69-fzEiƃKji,"K"Y w]˛P(DI;*ϊ]*}wZGi}:iP_j],PK;DZ2 :T$Ayb&lLA+aŜbH'[OZ3 =\{[j`8SUP$] sEIt<١RC`#Dqҵ~q23^d׶vO7߆F/*аP #8pVe*f4kߙ 5o m(ZX=m[Y昶fB庖8ޛiƿp*`(,+ԡ}~/ U QŚ#I M/>:P'p`&mÙP5sTq H!f0dscD!_Γ1x'_GSCXREøhIOn8om")Ta*޵#`WmL%i!F6ZF+`)E+sxvrZJ m1B2xf/!JK-tY4v8L(UÉš?a/asqCa;=8KTH7 5%T¦1)lPgBa\$ZJRCz5׺An8%iioHxD#˝@܎ L., L[e]H[N#20 w6b[fD_]s{u8)~f;h?HKFXpOguǍ+Uxk|P+pFT%:⼇¨J>§ M$,Fb|rp$.V: 3/Ph#Bg\9rsZG yUw 0mSHgsS S;s·k`ڏcZffmäms U(QhRlx+_)[)ƏR (#˿FI4Ėӻ,0PA,zt.,l)srщjrݯ|)9?#i<$AJ Tp8$X @ =`L9ဟFF*=F]&޴9$nٌ#JJUJ4aC45fjE*WM E~mj] \n۶0vZ&Z{ ܀U!)w(\)GG"p(6(Ǝ\M,o̘zHUVWv }CT9zef(s҃' 6(2 g|4GEZg9 `}? ^o6lc.`^@QEƵ1w8|Jijm-_w )R}nٵEdm]x_d ?64"ҵt͂ZYe:g5L؆Q Z|Q]Enn@׵ws ϢFj?3s"SKImՍE8C (7l:a;+ ү 賲o:!˦&ݳ"H~ @bDZ8T(>zs_ :g\:T cw`oA@A h!Orm,:3bE+Y8$]߲H`m&q{iX -Nu OܨskOf4iӁ|n۳Pz0I+/39EA txQ#dr^eyp߱& " qc2O1gld(%W& 1 aYc1L_zepýo|= endstream endobj 215 0 obj << /Length 2910 /Filter /FlateDecode >> stream xڵYYܸ~hi$:Y,Y؃8~д8݊R[vS"utk yi(:ba7~?gL"F($$:eRmy7vu߹H2 T͡YwVQ^aP;폶DRv~G>mu`=mCɾ4:tݾ \i'3V:ȯ|}@7KSɢ]oϝ_'QkO⧇=i6w=un/ g#Iԕ[㺹3PgQC5e[ۂN3*S"vUϵUylfEC˦g9Fj`r j6xxp /։к9.61~jj:=b. 9}l a֩Sv+"!OND  nU[d-^vLv@Hr}g'V $N0LMd{R<퇶h;xŠ8i!oiP/_T>J]ݷ͉%N(Ϡnp!. b&&O%йyTF?JxO+%R=VȘ0lw\ӻU6G2iTzc3TkKFN&t͗H4S"1#gi+yA0)L,zDĉUm\HOjPh8`Pn`7LED~ѽ?ZJrfyB9\y`R{ڏ\(00tZjyY9iO(Iʻw] -;xlN$ci*& "zדq5XQL6XqMB FۆIr)3LZA>y.p~|!W0GtS`Z@mgq@ 'z9f`gFi02BU#|⍜Bqj:hOki5iPHv~qOс?Ȏɋ {PME#薘{p,IA-DLgG; 1F+$?̯.rQNf.]:ȍ#J$LL(`)f bFӓ"BD6j=QyrsX<}l6mJ@SpzM{P9_<T{5["1IqB dӱޖUP 45*UODBVE_ (+q|P %䳩.?m[G" @n;}a> U*@q=r= nDR~0mxTCS䅭0,ږI3KUJD i$,/P O+P˥^m=XM7.C4$|znb%/DL<|̓88o%,^3`idv.T7b^/v; ^yNh\y0  v/`? 'ׄ*,RXon'#ߡ3N|ql`lj8K37p:|wI[r:ȡ'|si+[(AR8TU}Ш,5̼VӚڎݣR{PyBKe!~,78tBJ(@[_vqjBH+WÉcVL]‰N0+h`n\3(]P0_S@ 7K-Y 2fŒz۷/^@vi(EYdoZ/;jR!۶0U˜$"e"}ֽɺUW"7 ' n_@MR5&o{{&{.\#Kr Lެ{<$"9g܈45%ѯS{4ΖpP(u{c8@.eC? PUƱ}K /nbjՠS9F<6 MR.]>xG&tlM}CcCr]N|7 N0S!V!؊Q6-h~}oJJ endstream endobj 219 0 obj << /Length 2754 /Filter /FlateDecode >> stream xZKW0 *h@N"s7CRa6 lP+==xqj]\3<勛_?ճ],Oe.D3k"5,6%?/}ᥗY&y(>m kӆyRxX͓*tr]lRoBJ$~/D+ b)^p,7]YWlZ'sq߽aPxiUYPQ矌z" s8T,tkv"4zasWI|3,SfX6EE {4kMf,u ІY5>,I1tϷGǺS6c.0fS\瑔JBB&7{K#ݕ &wS=G=߸=465K nQ~sYňґr&sOimZ獄N/H%jp8G05bm6=e>6 4Cn\C{rqݟP xS @" Fu+d Lr; [hݞOx*rfΈ ][} ֈ]Q8o-?򡬏- ڱu%`b23Z}~/N@ Bk+ ofI |ѰT a(hSKj\80 9"]yP+WeZ&F?Q4XT{VCYETC|3<|u+OڐO!h2K;c%.6b"i~neaWe]_MOlG6^{A=\Zvv{&z{):SRgǛ7Qj̣:Mf}6 Q^1f^) ;6)^kTݲ/Z $gX*p2):N}F2H.봢!{QYmyQxJrIq#BaGi ]rUs#n Xh x@Yt,"˂ӧZRN(M+ئ\a[",도_0bH8${9UyѤXPKYi b9acjP '83p ԷRha,y /R;d3`[‘p\cfid⇊뽣qB46u\&_~XwkD~-5mC +f*MR" ǑSd !tm{T5BDX J2/AwM_ s i7S/K+-ab0RtD)4T42֧CA \>rо {_KsSmk,S $1UOr6Hi{(g;.t4\ZB6>sRmz #].6~&hT*ZX[enaRTlnG.US2ZuSޔUEr2NL_ćcIfIӖ4B#i zk!%cp*, h6xMQV '2[C7턭#P:'Γ2͌sl0*vԀplk 7K@(T=~a0S>M=5 2{A0.ɟ|+Uk5•$*t5q@>\-5sU⡱'êu PۂVtm̎ZOY2^ Xi񶼩e7-xݍP8qZUp _?`epT1c𻯙|E;>ҋz9s6e5%8S“ 9+:&=nC`tull }`&;PnbE;bN֐N&Ә'u594*C?$Oi.4r;j:_@H0og>M}ݮ pR##zD=D\ A7"05"&ޕn(ü>&p?ۀhVǛ)'a8=dgz}wAWĹ\pO+w/@oP^ 2<+2א?<55'[;q;a(3ܾd C8XC 0 Q>} Ip}8+`;0w&08Ïl۫g endstream endobj 224 0 obj << /Length 2871 /Filter /FlateDecode >> stream xڵZYo~_!Ŝ>xXN l8ȃf1eǧPҮh(vWWUÕ77o޾*I«+"Wa 'g_F_n?{>}- ~cANzm+G5IW"Cx*򚞺eGuS雺̾N^6R$gVL96`,ڞ&ƫ.RG|:'@[yeS *:6N/rɆW@$oo]{.xCYLk3^_xk*u'jaS`O5+w" ??ii!Y#{+LBx)Ň230^^@n4qhY;/.f@G/%b֗Ho"7cOJ #Ij5IW[D_ ,ϠP|fDqh**bUE}4lPiEdYߴxEb7`87Ǣi0_^' Nɪ#,4a[Ee':mXWyU"ZēD6=~4_CG)y#ahmqd5莬$C⺧MvvAPL;[2Ѩ]"VFbi`t[uRzg5nI@ ( v`gM4ҏՂzl=rMCem}70Wt4wq2b7=5p+_Q v\ߦه[D9?`8Iӎ.#Z t>P/;낾zK酾m%}V~#~4!߇]e=P#h~&" GiJOcx2"m!IsE#φA^ X l"#;:Q10Zak*af6Fy<K5󑇚jk-ʪQLQ@Hђ=L9[f:mrZQ$f"ZKt-tGh CUsǫ0 ]|AҪﻢz(:ޙx3yjeF@ o$Ѥ@ ]C84v˱vFwaD%7/SVo^oei`D;z9Phu?caa4C1~JPh|с+ѼhvC0_R~yLEԠ^wDV2K7)#I K/ YŀqKB7l/0K>V*N&JWeF%8=%(z_w(3CiIhN#^ Bت^nѶEYw4$r ;<ݎ~( tʬH6qy'_s"m`-ɞP?6π;1#]ٗfHJ[,Hcz,\ן. v"5_=Ԩfjhq I }V4z!Z1:j/͡w1cm0 8zbk,G pV;@GCęEVUH$gL pƺ'uI>bVSxak/=y(3.3VT';;8F-9%z.j˵Lt0]Ler^Hdgb7T\W :Zpn2+ \Cb-QInq0oO [ V|2yw̌c`ؚ;JT ת jO+aoEm}DS> i=tGa g;ԏ@qXݠJqi&]0Rv| PR@?ZvH|fő6:0%aE`:_nor) L/plK+ymOy>[SD1c#Kp.B)&ST&2KR=×qӎϣzzVy*3b%D,WQ4{GR\A)zlR\ ~.'7C>2{i~!ޫH뭋BpH1!dy{+86Q~T)2kT,> stream xYIw*>9M;ә|ie(SB8S(JlERXjAWp]? Ͼ]}`E*fe\,$c"J!ϖq\w1V㖶{?˕"5}]`5T( $*.E<쌤Yq[R;@?tS sШ&`Tś_}"+H uY=RK;e., G`S~&񭢘D$G9rVKR-hܢ4b= |pMšZx"l\m4顩"mb+6+43e tTZQR>*=m62}L'NBq :D{}fo"͢8VO`aT?pՈ.aD`;;֔[ v/,\lE3'v3tքEeC僿242ۂx` qFwrqӌba^qPo{NU_"RƧ"%cHFr~=d گY غsUnr=ufЦuO7niF>43!8Ev7j9Y,I 0 HFha~nҡw @ ʪ-8V͌DcOZz -y7fe!`&hԺ>p&d[4F>V24%)iho&N#C|y]L߽ pז6 ObJઑ#E]Iv k*;X4vV탡1ڸzsiFs_Fɬj'FUGe 'j}[XfN{'bx84d8hC%il"0UA9y3wzYS0ono OU\FY>Ә\;{VhzW^48]DUGb׳ p<_sD0f4W vl0VO8L:ˮveD ;d1uj\E#`7RƍdEup;rzNYZ2Ӛxd٠^`Gd.U%ѝ9s4#G3,I`Lͫ,,_?&ea a|)7ā mOi3XPVR-6^f8" 9!mznB2vNp!c޻qAk 0ԁ:$!ٺ}di_*Ci])@fI}+0G.:tǍ+ )arOƇ1k0'@W5eN ]˜{|ʣ4o?FA% DCP\SXҘs9yS?;liN+)x#r`Ald՚݌+,;l~soc䰮Jo|HcGC8zh]=0$*r0Lk|spq*̙"=X_])Dh.KEdS`)֐k .:9%*cAoT#o5  #m:N)jXmFLԄ򤣗);xWkh(% W[(\pYnVgy>OKT7E-;q-#(x^d9^.Zz ZTEt $ ԊK; lĿFE~w&mkPј W-'fNZ#"DHVg0OC 4B!P~v_J ܺݐtG0LT8G[kJx"Dٔ{| Nm;p{Uot)#[XWs9 …ʧR99݆2nc[|fi{7 ^)9T V`9`7K,N>| endstream endobj 246 0 obj << /Length1 2048 /Length2 15603 /Length3 0 /Length 16843 /Filter /FlateDecode >> stream xڌpe ǶvmN:֎m;FǶcvl۝͛3gfUVvy P֙ "'`ddgddPpWGtt#C&ja(gg v0ع8̌\5sZv@'8 ;{G 3s<}PS8ht- mr@Ɔ;c 5wvf`pss7qs4㧦Y8N@GW yC_(NQؙ::k cӇ "% PX?`g;_ `ja (;; mM04v7t5640tC_-읝,G6ٚmOhwkekf_djakb {5[ _6"df@g###;'3@/{;{ )+`4'h1G w61IcLl=1s _4D$?Eo;@`bbgp|f qRRc?HM6A`jD9 " b#f? 08 &?O `PAh>?#?NۇI@插>:id/?$ڹ8#ٿi/Qe(_Loaŝ飖UQ?L@@W? Y?d?aGAMg79|p/_v '=7vqt& h `glYP+F?7KFM :&+pN(yemWVpW[#th{Rdz~~d/BX:UWo+6.i<N$~ ձ J52/3tjQ:%sF8Pt04hswh|NYc=+UqqpoƦ)RJ6s8cWeqI}q2eɻs݌3Ս'`B(J%LFJ ,_U4AM>!>=SNf>!CPa8-! l A"53#<X=O_|Og n]lΉ8lxx+|D3h EW3Kb3e030laMy '50)'SVNY#%ug# 8r펹[\ Em fXSaoXey})52B*d az̷3&-]CuI_jB^g݄-ɏZ2~♼b<[gk`d?OX69}qY. qIPrUOZ;y2Dy".%AQ(j1J/FYѥU`ɓ#_ CKz3R&)cA"[6iʈ~5|8S X!3M)>ܸ~'f\{ZtkT[Θ1,֡A tYZ'Ixq'V#ęU9aíH1xzSdhdhcXDʓzT/ؖd?Il6;:l:n{GONJԝ,1xbHvCo[V|`>1[kt6́,11 &~ZAkvxJq;wVEi๒SmARdpz[/5-W΋K_ +E:_?E F+R!NӋll >x|*)Jf/`N]袀L|aoP#P? lE6kb_lpw,3_#{]gB&31E7/ OÂԖnW DTtJ%>Orm)Z:~lr%l 4?jOWNxk&Ech;dM-?'şWH6;c9xŦ2B܈T ,-@`ٽ  7S:µ44J,ԀkfEC EtlB,mSKv+ID^ݫm{EȚT-Qn,4.-id VFrQ_}x&+ G/HWz~FeAUhZiɸ GU֫A_<.R/TZxhg155J2-aQJ1 '7VFϡ|VG7щ]ܻ୭] \rb^mAkSe#T A|P5cH}p U5߹l:,dFΗre V*M]V/R,Gp5:\9-@}Of x_Ipŧ38ZK'ܜc?6.WV1 md>f+-z !wo:w16τFoh4V~ڪS醈> * nʖ) 5G;6A+K1gFy( !%sf^.z I3Ue}UlNx n2%6KݴXC$ T4/*X0-6tҿ+hO%Lh8aiFh"=P&Yͤ+q`B虝NK*B]_!bp5)-`spXN d[Am&0|@-l)D"i7s\^9p #Xn_wF55 {mwKrbn]SnO֢Lvv^K!Zflu p*}} g[#䫚/uט%!d3Ŷ-dy~K7T7l{cӳ$: Y~.H\J BI.2P <߱,-pJYӹ<8;\oX1Cdg1 af:) ׯ4bICvD<]a 1'ڥ( g(v=-Wk0eI|(Kq9&dvI.ڍJcbjC$8?u7ޯ*kO+4ῢ+q"nEp /[B96o,$eiӥtR"Y D|xY^Y2(Wh se!5Á42eۄ8<]̺m`t&M]mZr.A `/KLSx ctp&[4Yި,uגDk7F71czzq+>Խfc7~\b C퟽{虸ōˋZw~,H g{1Rw$!1q+z+XhKoBp^̳Bw7O%Py-4#4I-%Je9#I:~TEJո_9C1HFJY} ?䧝-"QͿpp@L1'| Ə ֥,[/$H,Q9{à(7B(sp6B3 ^-},gF:CyìBĉYV&;y>Gfcb: 9u i ׮"SX8[~7 *pOhsp6ڒPxogW1CɅ~ s8TAQSg%4f)XM`uMkߒLeIo:'on\OK7˶}@dP. rO8ޞ0~>Y]{_ =_Oa@Pj/Ԣ \5w1Ӛmmc0ndDʞ0Zc.[^';[]CE-Tсw(jN~D8%]91өHL>-$Z?eDGf{Oy 4qp賏$Y$†@Bʤco{9~*n5Vۮ TUʡ&n~3Yh&zS(ϥpux]|!Rfm3#o+5} d봐4LА.THbnlAѓFgqt‰}DY ۣ;\S#UN}GlxgYQ)%Cjff{Y߶ۆ˂E"]]ǩ5 rvʹ|g.]()SֈɊ1iu m."S8$G0h)OYК|PXqe%F YfL,thPߖT`n&_-@ j9D/Fy'YexYkP3}'08"_)F h Jh^=i$z;A:\O ,r#2:'Lt=Ng3pqL,j ]G$|L6|g(*@ꑽa&鰓.ejn^Fs 7ˇiʋͼ绀yGL35 oqvl*d2ڔ87yW<&m(};B˟?p zx(rE=O|˱9^fq_ !rrJ0lXs JS0X_eFk>Zk^\e]m/ҟ/<ɺh W%@m~ -ˆY 8?W8eqܔ$"ۖ- r[2XPI6C,B>I*+H=' uj81H7ziJۤ8/+ok*0)><,)'M'5=X;wSR6AH؂K#P] 4 DrU+ *f0My!'t G%`Mu$W7 VbJl`ul¸RՊ34ެUG./+WJd J"oyV}0b:ڞ 󎄜6NUR~(Dp5@^Hj7P-X T6\%T|x>>%"(g?8)P R=R]``60Y4dEZWgpQcsyftһER>NXGidMPFT79;9lgJh\ԙBC!L:*`Hu2 ǧDxFQ22}zDu?hn: @XG*_4|Ơ|~K7Gn[z f| uo]]DX8L}IJytWk~ /;ѥe>Uԁ6q:6ͶTdyO*Ys3fh :7Bm>O"|5<]I CZxDj9DCRĤ_8.J4:f@fOk2~hW]W*\= 0쐮pmvo*Fl`;}'צvz7&:VB$J7R%Lk~wߧ10K7`gȠcl7=F!p'(s'ϜRsPd&K(iVQgخw(y.yd%xJbuP3GYMdm4Ib"EUPl&6&,OpQdzWܐK!}h[ e9i]MDIqs8Pm$T9}C?r+2d*[3WD'fT<|Ut^S5;=/iD'=K%I$P-(h|̱qP[@ DijVmy;6nKg뢆xhA 7[g)+c5 dX)nAU TOLZ29 j4z6^0j}g5qH4z_~+߬c__3{ w}*mv*>,!a汽wǒ~)^sBI2Ul|:\:@X,HՀ7‚>pWU F׽m xJrّ͒Ą݆O-WGZ)./Ӏ c:#[#?kT_]b5roŌdɟOpvi:SN.f㰅s~0I|E4̷ ŘnPyMXf|I801eRuf\ NcO|xbh`WdT@( anĉjY$V*T`k * ᄀ6NxGߪb`I|N. .H M(OpW{Gkܸr}4zJ+HC .ׯa/C]_vɒ`V&he"% &٭V/LU3-}e u=j$YU'Lŵ}?)(t_旃U&pQjrowuvއgsc.Mfhi0];+eC{d]/SO\l1'.]/ Fv4{WnԂm`$1>W%Zcq{ 3 m_~_M+FHryጦ[ESB?xdmF| ܓ!{a38}O ovMoHξwTFlHYW%8 kH,2)l+i[UY9myUzHQ*|׬:L :(yξh3&%q pe],>b<{ҸՊ uV(!|pN3qG n wxz1@FsȆn7ٜKMJ.enP "}U5f" krŽ$x4X!b_U:C$#0Y1dW.)8괫&Ppuܒdbmt țcM̢mx+ur} bDsBS3q9#l pfg-}hMv;@ܾ7qfAi^ Hl.=nio_out%<vً!]9$y{5k9ܑSwXRl s],FK!`u.m|޲@1qi`{YgbҨEG8Lk2ɹ4ݒŢt>:*,h x36HBM @Bd`eO:6g|(rp"/0E3ڨэ&'ُD\SWyJUY2p;։|ua)chmC+=[UDB;x>NH_u- tD[ s2*/c~U۪1Zn Cجd΀mZ MmI@OkmZ4-U##`AFW4KPrVƅ4.H& M A;~C(eZa(IfW Z%Yv5fUjC7K5i'cT Q|dWFfK.{7v1Gsҕs:Qֈ3$3NFPjod|]\n)pwm#j鯑c8A{jgfsN/@m",S8o:)A;'`dI״( ҩj_2*HtWOƤ~&:wg 'WxCHQ \{L錑"(v 5^'cB% #5ZAwXUmlFwX9LñqWdE"1HDv RHވnKu0C]FGw93fjyٕaٔ7j$.:yoE]B2YE!͢O7Z]-_5ʲo; q*`^UÉOsIJ(_]ȜJy8h&,;;^Ҫ <}^[Y-q}Գ; "IM=вϲ^s_g//13T}jK#&㡈tյư CSj)\GшLCgVG.P v q DBؗ?8eok"yO :ѮX ?3>創24KtMm"|K$/,-=OTzy6q2g9ՖC! !wy+<a=ו"+4Șu @*+u"J_n&>c. 6>9R*K_ -4%׊_-#<5H%Ye/MQmxDTD,1bI)3cllA}ty3-%4;b=E|y/<K9R1 <>5-p72Ȫѳ,Kb6?24doeƌkIse8sɽfJgҧhaܻjNymv9?HIcL^W e IC=#~ aMRHG/hb~TYΕoӡƛ @պ.;xJ\ $`r@!ф9SmS.rEK3(hC(>E-a'BýH󾞱BUHFe$ ɳp]?u.sȔ+SwMA Oc1*b)bJ 3UEDYzNMXgRS`5>=_ؾ_ @ݙC+x;@16 F )[SIN, lurq$]ۂys"r}k<ެs^aDʨsխIh9<$4#4'7̓: \j,+cM|:>yG؀^EDo=d4Ch6"49㮁"Cn 7l~E/60\n-ԣҨZS5+߿QhztqհCQqxp|Y%ac"Ϡ7@m%vF7#kIl5 oOnr S)6]8'(}E(֯'|DC)*#G9GȳMiH$ sI"nv,P| SbR:^vti)S̔#v+LFޜrGWA/U_2R#E Y n172QJcʙLKd7aN7~} sIi`ScYpVUXSMSFjljvzʑM9t8/SZ}f@,]ޕMYQ.pP6.b-A |jؘ\Ս-Y'gFrW%S1N6Xa>B32$<=|dظ-i%8/I_|( ./EK@ Nv1;ᝪw˚(Uۇ1TYj$iM)|#6SȾVw+Y%fq,9qYtEq5K(v,zJ xOUxp#`B݃/!/SDpۣvo9P#!.ca$5S_g/PK#vqd(:O[qPs$u_nˍ}$]Ҿt=K?{BǪI%LsI7z$T ;Mj~cQiSg2ji3.1pi%cYըU4G'!3[}1/xp 0CqUdon#2k*fw| @y]Cv!ͤN>ҶT6F1XDq6-nKgk*8}Ff~yފ^5͊N: Q~+ny9' z6 ++?`Km Yqv4k$gH^ ]bh$!„i`0BG= YtL^v㳝wMI7J\١ɝr?ɄIogҸ)|[Og֢ Dws˫frԀKH}p0 /o: [P.`WfOx3"ɬhq$9g, >J6pbzPz}?::&,>m͸w:ysh (om! r 2KyJC?nͼs!nTsIShoZ፛pn$S@<_J]b:&!GMݏfpM-V8VX&#X6 vV* m[gש(jAn%XlɴYIN&Vs bsIzgm 7 w͒v bo* n$>W:@Efj'5?R[q`um}]1 sOȡbfV@,q:z `Y=Kz>KjkA`7$ޗ%ٗx: #cu6`O-~thvemڂ@E9~!Y\Tai&(xKeW=%.->ƒǪ(w@NyWf1s9]tӯ3*%E=T#7M⺀tc Ct IboVѿk(P3hϻ^֙g0ҼP ._IFAϧ(TL8Uec)]QY\ny.SfR\Ǫ-ͷ%Xg7yP@': 2q. #K$#J1uЦx ލ2T *)钭}_UP"RGò"r!?kC_I5Y/ubJ,,$uT>I̓W G hM'_V@ zCǜ zEk9h|0ʃ9iE;ُ0ye*VJ":ӑ#x7|F+.x1ۊ;3'JTy59"$s6)^-(A)'~FRe(ƪß9V!ﭖK(u [@G.A,Aק3E$jSf$dOlC>uWYH uQ><{O-?AvT.PJ(>H0(@ZO2C(QB}eo_k%A1$߂D27v=L/Q6׺K4ŗ\MB`s݈<ܤV|$') =Ss$ +|YSNF4t@j{~g( f&ݗ0<qy^ _1_Wu8LL.8x M^"p}jU փ:GTd|ݸ쿋U}ՔJKN8PX^ endstream endobj 248 0 obj << /Length1 2103 /Length2 13519 /Length3 0 /Length 14781 /Filter /FlateDecode >> stream xڍPBq ݊Kq(o;]Cq'{wLzMTEL@RvΌL,|qE1V6 ; "9" lg#*:*\V.>Vn>  @W@ gg rBp[X:W)-ow l (-A6Mu;S0BX:;131m-hn`gK 2EK a vGngt^`Sӫ.PcXX_mvm=s5,ښev{@WKDUWs2u;;19W6Kښ؀lO2}õs2ۚEŞYU[frpps@%_ 4#fk ?k\իw r".ڙ} j%tcNeZpluGK-x-0Ѕ%Is%HuX)^gfqޱCD";>j[A5BQe8da޺HW(ZV)Gz,dҌϟ46GH Oq6}u=>B*(=Kw-nsDͩ_ cxKl/QwΫ /F.$"Ϝp^ QI־ P441o/^5cI%6oކQ͝?jڶQ:1PXSJw5I0lާ9y>j^|E>ϳd:uzQpߞyI׻x,1A4@d$K5>[b%IX5Fp\'KC@EC;7s.AfEz|rClYz_|3.Q ./sò4|̿Q!( E7+38![4+X-Tx D!!q];>#ix] klX Y_qV(D){"f EPkˬZdg-؟JL4Z'J;;D] oQaEϭН: CToڢ== 6fMߎtG^lV(8*XFLK.d6uLG{7ttL#d,ԤY"a/ޒu V{33L:1eԽ'/&5C@W k>S~i:rtk& $mpr,H1LnY' 45گ=0i6Mq>Uۄ(Aئ|9>Fg2W@NsNhWy_\9N+@ |Ci^Ȝk(_8xKV4ݳ0ٞHiO6NN|[=.k@ ӂKD el[Xâ\%XY2(h_[+.G&tVs ٝ?0#'p&ry`P!>HGF0ǰػkڀk>v|ʑt3q)lʇ'EÜe 1|x?sKF|֟M30 0yTʽr K`w19[yf?/92XbSg%f* Z6!?IIt.\̿4*?^.ǖE[S2;Ad9|55#ԃN: ,ݠ q@U%4TeQ:PsH&[pQPn4h"$ +,y _s`8WF]m nϐe@yl WcZ.&""̅y|=oUjS7 ). :aJbρT5oyeOUZf9_J>sr~JZp ~?VC#S=אǶ1T@灁:kFd̬?1ރQѠ*E 8-b&lG:XM_H 1DT^Lb>\SÐsG* y놘NxR*˛+ohk4ck@/.jōV8BM֫dWy'޵?T"vcYט]o,4Ups!S:J)tMׄR>`~a.5͜/ 1}t8B)vlpߊSE9ő#pG g"mNͷ.ܷFCeľ2zn.ϱ\_%46)ۢvi\ Hw1Bob&3fe05@-Kݶ)*kĖK8%6wz!=׉YܝCvjT~;붉DrbuD";/\,]XjR^4Yɧk|C7/W1/:v ґ bj,Jo Ɂzn}7yӊ!"3V'Օ^>ǚZoۘ 9o  bX#e&D!a J_Q*5- d=ЁiqzRt$?,96HGvDgGF)yl 20;Fǖ;wa "\0t i a%7$9~Mz r_ol5Cy(F;"˜Gp-f)~p]ƔY'V& HianQe?,qHJL 9d貶D蝔B5Lfv'=(R_t S9 Cn hOρlM9^[Ez3K8wxڤ&͛/޶d.B 7fuexq+NI|ayՀ$W?oB0d?#]8l9pD1~kTW 1й Yy61HUs.ŎhA=TϞ.aoib&vn%4jh'e4bju6qKjku:=C˖nxwN_JH";E4q.\ qie8C+ke*gRq*:X)Xӻ>Dž`٬`ʼt!4:EtHHgݴD-i0)ϋ~eW-Fs*7rz:Lp"5Cn,Ox8<8^\FSe7o4 )t7#yV\qM0{y v]o9VCq4?O^5Gd+NcHFeļe9?2p26z0aZ{X'҄SHL>i ^j|Jr +D |#%"ׅžWa Sݤ]u4|!imùK(h 4TB*bٜue]psH|Qt!kSkde;1 9S|zMU^7\..ˡqCdƖa탢, R4q&ti{r[`܂o|=9bdE?pOv͉2][ux w% oS2dmQlضAnfba.+i|;HeC&EQ2wxuD2RXKćkwZZUvL.9K<~z~((-K6G΂v )J+ r)g].BM ŧ7dkO^{P33:+bP[H5,` Zqtt+;Z,c 3q'M 66ic8~pno>%^3Z"OđoøB{0 @ /`zJ\tw##ȉ㷑S$Foq!YgPQyz%0~TM)~VluVaJݠL0?Tn!5_Ā}u'P!QH1NxD/T.ŏ{Uzl}^ ;^FDmE*yYd+8+u<>mIn,wlm۶W( nxl̓|[V38d*r|d $sm.R]KMR݋7';)w'e3ѡ7InS)l.jVC0Iyi" q^RxEz D k6F-Yɗe%@ 'o1A)ԥ! _ x}遣LfvG"ˆlI*$y!Mř).ϸeQ^@Wiӳ[H^j[yMx *b]=MCŮIi+|.**U [8$ >ʹʪu5@dP97亙FWv]A!7#h:Ցu3r3&i_FCtzeb6ȠK40'dhH4ZkTEC=knO6hRo%\;-fr2o$/u; ? DmTe'卌JX'u(ڼ6 O%5~نܚノeg=ژ:VJq,߅+NRT?Q;rEWrDn@&)NUby>s*^\)]Zo0y?,eood9us*L(BX6Ɏ-xg7wA^TG.F!U3z舵-؜>쇬Bkfv})rz+z{~"}R<-C޴:H 8}&cu}X4Wbpl$z8x怽Uc 'gXRR9 g@a)oC}oT/d/B=dBI=V{TJuq$Y`>F;'@cpKxU I KUJ ]*slSv!u-Ӹ7+(T7""qG"ijf]o Ns.dWjuyiN5 c|'ݚf^Gހ=~N3 ~̥|<$ގ.27/m[/|~]%x"ۚ?:Ekq \qj82TȖ]m&J|Cew M?U-FM_8ev4 G@_uIƕeԼ,RQ @KI$w@=;VZn˳]{E;C8>G9Tt冄!F[w%ن,yy]JMuRFM7GF)[D ;Ouv};tԮzLe=668!5ګ| ܄*}Ezy[ f(0 >UlܺQpfk$ Z<0_[#;<%I/Vgɍ ${5 Vdx;YyS]Q+}ːO'1\^X (dw3HY |V}lDo!E?`,%J^v[ 5UHZ8H!ñUlAmx2CD[a xNQŲ,Njv/ecvSc޿v<к8m1?2^zx0_PJ)K1VzSΙS Ѹf(N}jMpg9j&s!b۰\]/Ck!Yv~gxpU}o0.+&-z]r1x$baLHR:`ztcc!Cd%/gȽѸ'r}l5w qKplw*a洖=Ձ w~8f#|D6>_Á;r\8,$zE=.IuD;B1uQbgZmѨUʈMj98OOm0_ի6oNTU{,ߧ R9JK`T; U1V uSKp55E0&g9tyu9& -06n8M3ڮ:P'%ڠK-Y.p†rͷ_Ml }r}iEPm"&aϼMߢwI^x횽b֒9pz}=6EhMj̴w?>h\^O԰#^LqIA۠;d87 GQ rML!LQɷt~.DN<鍧/Zj!OHV +v=Pb`\+kks >K_br=/.[UC0Ou[+y( ^1׼H{֫% N[gR?2]@KyCW4DaK寪K4Z%I׬7Z!)m(-ج)44QC?"F,EaUSj:~=NFzH􀹕#RA(9w VB(ђ0w#Dw8@o;M4jz|i>J9,F6 U:!z[&r61£M;dJuv9EQ,ω& MoM! _-Bd}<ܘJx?u͆6<cMzm~G=uohS³sQx> k$^!&= ϢF.Z?V49 ~T#άd޶EhCcGEc~0^|2^3A;SK [>$쁆}}](9rU7sb谽L"!\n2U[L #j(a(-\l9] i`aQ-k[QT'eZB,U,X3{Myy >$IĶ~>jԛf>GpcʈNFF~:}vx`EF3=D4 .I„/s]hkK౨Y#,KTVq +bX\# 6ayK2;jm)Vj3)7bc#ĝa9M.1(x"/@)ㇿUĽd\tv^Zs@dDhnP,ƹ&%jF8_6z3_Pn7-A .#*q_ѦMjpd|+D?4PQ|B|wWNÎ XSc+6KEs3<hhj"A_b&>="ϛx6o%]ߧ걑!RmNK:0,QKht &~1$xjL;U3<ROЛ]mcZKDINGVXS -lYuUֳmC,.`X=; 2 ׭xӂk6}aOxc3dLO/ /l)ב{94pRXQK|Xr, Hk\źkbнYfdNtMt{ҝHZ>B2EOic/462)PΊm eP讓]s@شQބ"Z_4h2t\ xILH6o>,0a5elxQs;ml0Fydehm|u+w^^@"=G`g@R+ C\dy> R{wθ K(3A_OB~g͑%['iX%1K\c O_'I1)jߥ.U/c#T(eJS~eMAUF dbSuS=lv{6-pSjcd 3kY!W вẆ$0n2%hV&T )50詳AOtF 3!~T?Fs\kT 98"6cSnǐH@PniQ}6Fv&u>c0y~/SD? 6t6X ^!:E<|5NtVIrfHIՁ}ї;MguT,\ܘCvzQx ykg`Mc\7|jDv#DHBڨʠ "u7pSr>;HjwO$J.&zNp,{IkiOL;_fM3B>?sBfҡ8}2hNG!Hi~ h= 6:Ii),ylrT AΜe~4P^M*p3vӿͣy󶈒yzG5.@xµVoB=]H^ب0 Q~iS'sۥSV7񬦸kMk9x~_bB(4p7;㡶}oj{x5*CӋqejN܏?rD_xh7yHDNIэ#1]WaIB:&/#jTtG")xR^)h2]rI^((f& ~Rahuєmm:AG#j" /vQ 79s%t՟_9J%MŞ<Csk+!YSԖB,[7kBQZ=ٱ`QׅN~Β̅'(31W>xB۫l23_ '3-z [\(SVC5~;, )n@J$ix'M k܍xcPӫBA~PFSA֕7kp`lHo2U(oCyRh?"vtuNj@WJTGF"4?FXjweå[" ;5T+S\d&ߗu ݮ lNCW=7%6-iI$*"J>ĸ:33-Wgt ӉTH^fa0tp(pUo-Sd AߖU $z(ƟV% (\X'=I!~#@k+WGL)0~a,#lwY?nBoHE!- 4ԁ"Zx+lҙ<)sv=3QE_ئ}])OZ㚈`2183^OF);͈ߐ5xV2.ϸ'AZ0g8 ]#ݜSYu/C!>5G[(Jvu鑣e/qeu9Nm ػ*|$%!VK_An캁SmhENɃnٟNLL aC'i!iݚ~V+/F\ezf֔Խi#N_hLBhk8 !m!Ѫ]Dkc'c~ȼ*r6_3dbQ<>b'H; 5bv%lv`ں8[|3΁E#)][:9+3nj/ξ%=`x,61+݃7;?>zҟ ] ծ~LBi Ds|_?ҳM_FVDolnSC`O2ˋ #ŷ yG2"&I {hT|l?utFKi[{_\;Sk: mq^bUZ+_Zt?TKFg"^Xkgsq5~ZU_Ը$$+|JTψ긡O'& \ukjvVSL,r׻k9qk[Í;ڱDG*p$c 9yMs =t(+]C>CI2MYϊΗJ %Fp,!QϢ 8bt&e8LX=aLk]ή,EaxA8ZaOVLS3NtHt=\BO慖gN)#d2np(d'TC=hEdNrn%|K _k Q?{XERRXS(TO5fOMgI-3eM ڶUBrmu' qzcZfy`3gHeqYP~=7,)@~sң#ҎEiw*(B{' ŧ/:Ty4 +bp9G8X:![#ZͲCc1Yҭ*g\bXA/0#&X+=9$I~H71cD o`n5A&&2X:A׏.[k!J.|3zu)gҎ9`y; o!s8P/a^Lv[DpƑ] J$r@Jzyqtƕg]!5y#rGմk2[~F˳}dVJF3i-e_ *f\$çf)3 dRyd2SЕUc}M^⣿F _&=U@tm{L ͼ8ʰZ*@?ZG Ѝdog6D&~RuØ?v endstream endobj 250 0 obj << /Length1 1529 /Length2 7500 /Length3 0 /Length 8505 /Filter /FlateDecode >> stream xڍwuT-]J !-ݡ 00% R Jww#JHoYksְܻ0¬A0(G_D@M//bF@@TX@p70 */D s@CBQI1I~~ ?_@\aPw@ Wns6@( rFha6`?#إI>>OOO^/ n/ #z 7d EtM`vCx 2ۀn&w-@Wh5p<5 9`= 5y^nj @ F~oPdf x_,~AV "~O  Oޛ+v?Y"uf Bh>c%CuI]y|y%<"A1a0>_ՠv04?}8]A 5 ,Em_f)6=)C A/ T;'0W 5anykj +rP{yyȃݔ^ [0=u `(HBvO iA'[ yiK fˊ" Cj|y9 C [H;ՊI~Gb>?8;@ʕPO'_! Wb#m[vHſ1 ov f#X|Q.GɳEP3 %jm`SW3r[.WH L(.{%I1[݌ig7BjM]pKJjkO^Lvds2mWE+6[}/ѯŅȥWȍO1}rPy]Z\7*xYڞ۝O4F,~Ʋ5[ $h6N}H&Y8BBۚT@k[ V #QƧZӣHj]AVSZ={r==Jd 5|!HV O̹~@źR'EkNy~E\T!e-&>/ U_f0wsH0JF2]tx7Xji-c繪0d)qHkSxjVzddU{*yRn^K7IEMT]>Ѷ$$J8")韩kNUHEݠPR9o}P Eo`J#(<3U?moj+.t1%$Ո?e=0i<[L:)H^'Ki``Y>hOڌ-O> lkMU/1.U3K[h+WŸLQzSh@(e\Ǎo?g}[kү#,Cfћd7u}CbmkxEdP=xf]n]ll*I%HS$oKPQvu>i 2JAhkK'5>Hǖ6x f&hٞ"-ߚY)DPʐ04+'r+Ō\zئ> Vt4,[~s-'k d7x˩!M$ ?hM]_`+{ Jr_?ݖNlqxD?:M q)d |o*e[GY)S+~<4aۤJ!,Ψ"2Ot- X8yN[vHM +ts FSl;e g2.UOQBi^ t#&_вsct+0iBWaMY^k?54ȍH)7>Luq$]՛\a'5w4ZL>E d!1^1'6-m%"gtPf`"c e R,/Qol&e'ǂ&MB9"Kc!{N*\Kwt˞LZgz^|-Mo|_muvO`fo4>ʡR|C]q*ڧ1qaN9tFB8:`h}2PvQc y 4h%怏(Sh늘Gu:L`+TDG2ԴpEX4~F(iv87ᜯZ TBq=99pd}"&&Eek}uc TbeVDT( qjI]}Q;%n&UZ{4\: z{43JqMjx tOkVD[h_7黍~9ycީe4|rw`..د.xbC&4߷($,zqr8 /#mEZwRy^51S3VQK`$lClNE/)aJ\w4šdD(\wX ڣ*T>eaT;֭>8TV)"4q'c6%\xKw8ɗ^cL)fcwơRRĚwc:4ppXw5UA~`։QcPb4ɏ]XZK:1y{db&^|,:f$(NU׾s }YyEG+:ntWu|hU\@[;8.C\Pd y5Q*kg\XU &\9!Dो >#ʻ!*,a twX;f+,^_Ef܌FJ)nqixS;KcOM M:pɮ8ΩyLPv*ϓ&܆ _< l"?軣2lnXzA7>bQ`!hGs6ik/͛ Ԙ́%?T0gxk5PށIoټy`жpJM U7: Ie ߤo:7'@v64aLpS#k.Ò)S>h.d!655lYOROK=ȦJKAó'Op- 9`Z`xT]<Ѩ]n\DxR;,0 92ԆqhTjvit # ȍˠj '˟ ׃o罳Rʟڄ(PD֓FP_tQZ.zfT:$Jc5Ϡ~:-&ISjr" 8=OyOLg}KStR0cN(f; D*Ehb_{V> r;Wyf|F@ָ?xÜ(!rcw峩T]Bc'v-=صJ.EIߚ鏐{ :1kŏ[N\}D) Bo~ږd֣o =c}p<\BUաHxpD t$}/LnacNr4Ӌ0C}r6 56),x?]vE3%u&FRl9GB5hD_DK] ?h1>:CVtȆKߓ}gZ!O !vFz)SJ幸cC lrKש0 fm%tB ˱LYqc4sɚqO%mgpǍPy aCMKbյʦG* kLn-^GT7"o)wOJ7<:(7eF)##Eq 9gS#Xp_8ܬr2o/j35 ﱺsƩ؎ZeގF5542N !dGXI#E6 0’GS_Ӭ86gqu:h*H|g,ZBʜrQ)LruNq1?o nu{FaU;~рK!қ\Ol8Hr;~ 0*Gx[i.ց.T1W!;NHzCA H}6Q;|׋P͈͢՝Pܴ;XlZs1_r+󝙦n="$=XX& 'GS`So>cĸsM&&5vTd`eYS})f~S^ Tm=%Mx-e CQ3(K|UmW~Fji{Z+>zt'LoKsИY?bt~^Wr/6~AMzt G:pȌ>jNQ9}Xm'&UC +TQGh(>;~xRo9#Xd]lt wL>Jdz= O' >.3˜=]M{i))߂s֚8r9"z.q-BsDfޝNr*whd2={DLz]͛eV! l(IpS]P+`t_hd3Z Y:jqݎ̕u66GiI ߈mMR_:S;$:^F]R 򯫟ΨgI"{Tcm9:gi]2jA3ci9dv>':WS'&pT8/dWlpzjTDR{ ((÷!ޣX=f3rǕH||| h DXkO~Hn1L`H2^+hPH|^: I;LVdVk7r5E#g -)K/˓em$u҉% 磿  Z* ')m49pVB&#l-g5"S_Ьq|?J_A~]+ i%CeF8(}nj3X+G$R\N9-yA2؞=k;r ggqQV+ |:u'CKm-lUy$v"?d|{PGN5)|j:26vaﻏ?VZc}6O?ڤ>"ʹ+@;|3vfuNyG'䘻}Nmxv{vViÖmN6Hв9t1ֳU~ɼʒɿawY&f67ecH^^{n >%r-, C>{#`8`^^AlũmNg|KVih<,dRٻ,3=_T:$ i>6XXKhvz,lxX" d"{Piax28sޱhh Y-k\_fa)oCrTƅ eu͋ٞ"}VN#V4|aTZ-a(r/u5u"S#Hxq!osS>\C01_2mb\N}nAKE>s} GGiY*\UVղw,}FQhW"f\*LEH%i T d!Va,:B+AƈQ]{ $ E^fC#|"3foRqǺT<>wD>[?v,6PsVYǩ]K3iOK,\J bHp66⥗p4XA/+ʡ zoP(\M~o!$vÈZʪ6fWi 'n3EFsڊs=SDtן8$9QQo[Lf;ڊδ3j{<7Dg hf~B6q8+[,@ endstream endobj 252 0 obj << /Length1 1877 /Length2 5682 /Length3 0 /Length 6825 /Filter /FlateDecode >> stream xڍ4?-z[wזgf\店+ʎY*#ʖ $BFen}Tw9s%cb&: 8 u͡A T(<[A%`yLqH8 Ӏ X &@ D_C,NЀ!b^TXOH_@QɈtTݑ8#.HwBFG80:xRt=`___ 9+ ( p #;@T  !rDb>f?bPw_?0?ᎎXw8qPh$`e8>p@0Y;R55Cy@^(&?欉AcݑՏ4P8#abC'Fj2"Ȝx@HOS !&t QNHU qETP(@93 C':At(C+![kYo$d`09&mU_t1NX@_u83a FB" q$|ADF4e1LK8Z!9jC$Z]4^cl1'kӀGS׿.gC]VFWjҡTM˥2m.*mDOŊcŊN$Qr;G& .ҞGnڴDJ߶,]6İ?=P)]{h駈ʎ@K]&1AizЄyS܃'߆Y/c'gl }~1UV*OƊixPMrYg $Z%A=;l8> 6Fel CYFoVH(j/W)waIWe/ὔ5!|;?X|uLWs΂% $n_?I]%M-׏ΰ7Oe2 ,eހ3YNw:\<']2BZUdD{dg\XDvIk%<šըc M5+NԸО4.H\1MX[>P.cc^t&V慬 b<5u8LR{[@LCHLl𒉛גoV$7> 4-є]yFKgp`FY%~dY҇ww.$!ƞwe^ 3jt'2NEصs3'Ӂ7P}wdijVgֶ2$iyinz"_6f]ilch.ahba] }~:VO. P!l&jz6ܐ,7JZ7 MS_fO2Z6O<*-gO6K79`րy%D++I⢬v o()n*Xn;ӌ,̲E RHNS~NGqVlg#X Pvi 8g RRݲ\Z<Nb{KLߚ ]!Q wps\Pm5krjg"k!|0n/hN#/_P+Ԟ5 Z-zI;Upm1&2}ʺ깼So{6\ŅЃQ)JG=Z*`˓g\Mv^΅@m 'Gcht߄Xi대Y:=ӛ{ hT]Iee`8odžA]*CN |ǟǝrӷ2rzU ֘DM|#n0?4;LYa*[9>dRMwEO-7Y¤KkS,L x!^:G_ZLZīT?;S2ܝ*_;\*w$El~=6%Xv~oqg{Vׂ!Ƶ'K̿4^r,,\|}s`/QLg rpΫz5%/zV @*fϨػ~+)!Z:ީt\F7^@Vw =1W][sv_mh"hI7á vR*qq+[]7a7̫\R7L<j2bH,@eFǣe!vWAjn(M-F!~͑ӎ+k#ʬl^k XGqp'=.ub!M:&fNL&1 wt™bu/T˱q"U12X%(Z4+@2?gq55[Ք +#2ܫk5R%:l CWFzB<_'.ӥygңʧ-2:6=*=ws4tĻ("?|\/ r3ylC|m;cpOt(~K%"st_A,ɩL+cLҽf|8YͤnoNi6; o'ɿn_@ #Q^]0)Lzi{33t1obd]Tlu8BN))Gû\"ԇ:&?CT_l(>?:k||,KtYAR)Bnwh@PCmOiXkzM7Sސ}hT̋<O"i8N7$J!mȐH2~UjO6fV%9oCgRʡ๴z*x'>4sS ;DYQBu >ܮ"P(Glf ẕP46}z7{+X&?L{R,~9.Z@Ѷϖ#_Ns_y8NiDUhב\ӯd=E}sYKrSHRykNQD!:˪O9Ux-pMVlfvMIBG2l"+0跼9'wsvT+hojx[![r#䴿>Ĩmo| A\xN7TDMB=Pإa8+ϣ_8L6 LMh΀\?Nq{li6byj:L<ޯVksӪ:"Q:c>aM~Qgڌa-%4'<}8]ݮ'FNTj+j=uvNy\x;a+0U8+!Abl|D#%jJ-,9ZT_=.]eͰB*7<; IighD~žL]#]v۩U<j/]?Kl g_N#!㌋WgbripDeߖ mf+͚ϡeXrOY|Lk ]Vyp7Ae׼#M"rVL9^1~,}ٌfwee~}R ĸ,@ WT1) 8ǼM76wd {4i=s1ʒf:pf=C&"ttR8? Zk "qlZچ0mMa ӎLJlIW+c*+K` lgc"S;0+PG׮n2ZjSB,!+}W ~>zdJy~ v!dOkv##Nn6:Dk]/ d#a׽=}n&ilX09e 47";<}t,2c-zCŴIsSұ֬3&ᐘހN}&|K% W,>te~L= $h$dNg~kcx*؄\cP~^w ;M/ͲHGcѥr\k@x͂ZPS(pB7'7A`K2s#I.V‰ZۉKeyk/Xy3v*k.iD^/]645 c46"s.HuqЕ5Co~Ҩʨal !d}5;>A~~,3V|} <^tg3JLuȬF[S  $,VSnBq j|T{o:/?nW=b@D-gf\op[s7HqZv@bw߅i4+؇%=y~sAɪWC\BztKgZ=O}fsO\=jޗ(εn'eĢ$f]wJo iR"u!gYXy̾t"C˹–Ehѷ)F_V.y D<$yVPRD[k>4y衞ab?}d:T_\Lh"܇ 5z.ԐSg6sȉ*|VS*N{05SKƱ鲲P1 yDw p <ÝB!h&龝08ƳH$o.r[-*ⓦl&CHt G `y6a:2tёe; OÆ #ա0ٺtTim0Kةo9 1RGT'd핶2Z --a]ٶK7vdȅ\Ey/)_>-xkUCm( ST_+cCSdUJg$y#'@ )AlosÞ'EFE&: GCOS3ʪ&D^7Esi glI#{ᶕσ.~z$|<Z.96kxDw1Հifcݽܤ/1!˶z<{B44+'7^Q[ςʢ_{f AQ&0!>1zS0G\(W(>E+u3$t$H/F%qU-2b91j>ڞJۺqȋ'_K5! R cd$?l31sQ!G&^ӽR`Ϟz=\ rXT;DtkQE"%ɐ tՂ6__+9U᷽?Xfי{fR4^117BgGs|r*%hnw餡H=Z4>ZxFoה,5;Ud>W !czEmƌd &5-S{\CyDpnǖ{ ōޯɋ$$ R} 'N=1\9"%&&0;YJ#Fl/6쵮RASnnkWwkOsePsr85.KFqN񍡊NM.`Yℚw1j/EEΗ)E_c-&TIQTQBqA.C#yD\&Enl6lEmtrtYS4W_As:ώy^T0G/EWIj?]$ vZ6 6 Nۊpf$@4-j+F;৹:ԶVNmFtcCdq10p3ʍx&@4Iw*6YRc endstream endobj 254 0 obj << /Length1 1632 /Length2 8236 /Length3 0 /Length 9308 /Filter /FlateDecode >> stream xڍT6LH +% "˲R.!HJ(- H(ݼ9{gfg<@ϐGfQxyEmmu~ YY(g_zBV J Phj\~A% ЀB07jBrvȻ@P0 B9@\ g! ]Kyzz\0 7r@dgi#(! B@h3 qE]]m!:;P]  9~^+3 APW{UEy W_@3y 4Ay}]!(EB+ ʮ0+ I|JP7ߟury%A]m~a3vCԕĠU!(0PLTPLq@|y!}08]jA"A !?? Fl PW?dP/9M?~' 4laOXUI͈ϒ6*(<a ($E?7Z=+ +ů*?pB&4`v#(WTܝ 4QІW?6Zb uw_: ^yW{4yxBHV;A u_ zN&%CЫs(avR@XB @ބhJ%a/?zym!^9u.t;נEE|ZT%4@pA[G=!9:?A>?0ۿU>$1Y ?Qnh xKDxKDg-_`wDG7/xAs30dcChi<'1)G~K.ߍFƗB<*[637ǘS)'tL3w[1L$z1$w6~Ld#P쮫բ7f3dYa''Q:LRgɞ$C}=1AH%蔄jMݹ,(;kJ&k|#Agac{ju],W3zR"B&x3v!?eP&iқU{FDTꥻfPvndꍯM<±֥n(sQrۅ<`q[.k~^kZ.R>.VgIcaʝ8*( }G X:( :0 =*bw}v:>8Uz%M&Eaqi r^6ϴqvr=h߸'Nu^;uCW?{'$t6l {Ɔgbn"u1>r58X6rb'By[G9r W -cm჈F„pwp-^ qϓNbj 0 *]>Uk<7g0R>q6 ؠdg,9mX _|(dEYz*Am-W庚dᷡt A m ãL/4ۛV2o/`%tdoGνKd,Yct1c"f띜i"8dMŜ=eYYU#[fGaM鄝. 3IR_r [gM yVLW|zo> tuQrjlx[+h088g|nF7:q1DZ̍ 2Y0j-66i}ڂtjhRUyı$1wޫuvr[-'&lVSkd=_IsJ4y}hvU`:w+l{VF35.(Мgq.>^Ƭ:璹4= I֎5$)nU5ͺ8]Ox?f%TC'6 ?5vDZ(e$3D,3c+ -=٤aJŚMCi4Lҁ'o)9lڛ#ò?鷟E%zex4f{^+E)~:Ks{zG* -b slq"(ϋ'<Dv+ qddCfWك׵0ޣ^2b'u'ExrV=|LO:m&.7$| ʎ&8yQ!Fi&ZWަ~>?Qx% a&5>sF3 MӂWpWDmmӪc/df< >y?BK1" EPM}K֯l71 1w)8gLYAHK_)IugF7?)`Њk7)ĞxЬ2$5Y/"{`۳X֔hTM\N^@n9?#|7|ƐGj []-UTK۹ o._^N1T?;VǭpOPݗ,U*jq.+%8ըg Ӄ+,@/Vc<|~C<*gSmN@f2TiIyzÛwJ$n}L)1<| Yؐ|!# ,]DˠӺiK?xKVX+Q\-G `9#Da#q4ޥ\;t*;Lm Zˉ<Ȅ=JeX}Hsb,ΣxqV)X(>%Qb}|[[Zg ,Gx?wXr8[D·w0B%FNV^30J7K㼠u&UnF[k /Xyps~-TXȨM($MBγ)UN>UueRd (۟zŷ%f҈[Y;u`+6c UDIpwA]~ M^o,zAq`(eՏ$YIyrvY˛qT*o.}kĖ-` Gge_)-1 d4lH+of*II6: ̩>@?k^iNp0< 0u>.:oPUG.HN'uv{.`ԕJ6-$ܿC~Z/QZsFVlS6' E|6k.؉̸-˺<'zb,60K#oӝ+;;ȹsJ$ź'G xkgxQ(Zl~\Ys8/B|(WZh;\cG^{ۉ}^Jj;s!,pS@OFֽR [CޚK/U$n >]?oY!"%;4Ct]1t pfu9f_Ru44/o*34p8IcYsb^*8L3,< 9T{rܟ;uXVI#p$}Ϣ${ګ՟U? `dlky`dQiյt1H[ `$Ĝ϶plr 0 "$sn.<}#F"j7D9m[o*ˌiFI$gn]d~b"Ҋf GeXqD% E[U,Pޏ3Oj_&+vBWs(U5o˻^V=ύq^%tG8*̯ɆɆ~*#<[)u Ŵ̊9&tAnzE/ _j6^4̇՝;N@yqRp6墳:՗:@a6.8M g>Bׇ:E?yLH 2yIzD޺T}O_g5uXdfZ+;}>1&W__g`J!+vw\bI*zkY}b“I"Φ)\Sa+ ȬބaKReԁHn4EZ'`+V&\t*V|N #bO#3'Vވ1oflqRSH13'*<tn٫{)eQ=?zRɘBSѻxF&2TѶDi0[/yG܁ӧZmK<֊1E F%R6Dp8eyedkN7CW׋+ Gԅ#bV߁f`>e!?FG\24;.gny~DEUw: wR$L͢:U%MZ2QXx9rOHS<]o,̱1e`:~1m ܒ!^ $M&|^9SȚSV;jYy*Qj QO>P7fcP.S9vN0QuH@8ҡckOWؽZ_d&ge`6%މP0UZeyrh0J-,_XZvjozn~SxmuI[7;{Zޭn/YzRGl?0]%K9b#uhG/,]4k>|;lp y+bsoƧ4d<-fsҍ&fkCieXsQ^cV-\CɗR0i׮PO?=^鋘49lM x:<<\mxartss>eebR| T= ƪ_%2CT^Ƒ b>rTi'x:kS4`{V>;rz&϶oIP0Vc$;eoC|9sxB'cKUZ}-?c T[$ҢXO˓ʬ*׆-x2f;Mw{@1: _wIFg߽.Na4ഷHzfy3$vgpqWe+5#p1S@/1 4i}ub+qm1a;N~?KwΫd ͷYUbq"i`3NDod d='_\;%Jr0!(vidT[j K{U*µO@AxR>rg;XiڈVÓ4sm%Sq-7Lmr{i K킙=RGvi,|%n}6Ryy[ts'vIu +%ןSfd}On웶ҮYfcM}KGw[f1+kJJAl_—`5k$qC~jHW$~+1pC}4⥦( R5R~@|H/W3tSMyҾ :K NT Y&%Qf-Z)J`Hf 6З(zkm00)傾V{rG.*5Ћ?r]Bfbyccս8KMZyCHM AqpaJރrllX^ٛS6\Dg3>0NАQU뇌WYOzm>|OTD+0J86 [gE:-DFcs1ߪUPUsr5Ϯ]Yet3f>ArGZҁ'^Zo7aW.7[y_eomR.):(.*41.RsK3w\̡ߘ߈)H_ГޝS*Tk{O9Dq =f[_"#FȘR6>O{VUP۷ԣxY]bxc9&|?BOL{SȻKѮ' =kNZDG;ZxyN<(ͫs~h)wX$yW&S QiSmw%r,p+vR{Yj@'.E>Cd[5̍xLJ|ڎ d^TcZVF)}TçNޯ4Anmq-Eɝ Yy~u%u,@S[|WS1/wLJ@ uIc~uY V^|$T=prDm`.[#fg#vFBd²EQj[r/ Ř[2 J08NI{Ek>,:S+I{*Ǚ\ӕrF;[k7Ν@"ȵ)O|^,N=׵ Ya ˺0Kb4I"9AhR~ ,@c9ky'U1VK $0 =+/4׾ʡ*/4~1Z}iz(\`J/=~`=My:Ż/>̅'eE;ydJ.; .~bk.fe(XJ. ɩjܨ~f=Mp\Q Q*m)h/(:B) aڈ2g1SV,$uG;|#މ4V*8zLq-y=%Ae:VVG1DX'4&lО_Y)#(Jss/f{@ubuC2ԳWEHXxg[N" % j op<6N|ݍrES=(}ydQ&~_f%ݓޝ2~-+:B16e8\VCcѶK.0n endstream endobj 256 0 obj << /Length1 2752 /Length2 23195 /Length3 0 /Length 24737 /Filter /FlateDecode >> stream xڌT  CHwwwP ݂tK+tҝ}ƽu9`;Tde,lIe v6' 2-+Vb v@h IB7#+`c!Y enk Pf(.ȴ`G/g[kW>,rm-f6@{ z'+ Zt:- ec\la @ [  4@6x7v+_f`{G3/[k-PQbqt}0sehrClAf27Ȉ S -W@,`) : Ohiߓ}pX:XZ*͑U (/ D[f tpsN Z^Đ |+H@?[+ ;S_pmGVcm=lckzY@^/{|l_K 06%U3'?";Xipg-9FT]~77!7/5_-*BB 9k nW+j9qkпmuZٺZC$<v0Ctxy@f RJ;X-7 2zC.jXY§A~#H3#oa |"~w' |f.uyoi Md[WqCYAw vH2H>S+P'ei2 cmߐt,/o>_`7? @H sAjht" ? donQQ);27r!'qG )vVp#NpBΐ<l'i#N@!7_Ϡ 4'Nߊ?MYCZ;n ĸ!A\ ϮCJM yӰ8XyHo]=8@b!cvB2cE!ޞ@Hx? ]޿D:M3dO!w?L@'ynl!jW|S%N5"xtz~.Y R߮QDy(($my!+3KSO˫ g &dBU)2-6""B2Kq:Tυ=Bh1Yv92+m5;݇Z7R$=8I&TxM&8՜odVKW:Vvi?<&m}kzӾl~%`)mc I_: Ӧ |5o&|&qG̾^f =Dz̝{W^wҺ:5~£l=ȆS4+!?Smr` n2tE؋B)q{K^sk?(#˱NvS.+R c=iGDohV6 Yh덩GZqZwmEJh 画"|^JvU´iQaB\^6i9{" Ժ@ 9cxrp|Tn􉫫 .@G9|E]ԓUTòx'J%$Mvw}bwGl`[۱@ڮxkk%+ GQyA | c:vtTK>/e PB%n͟tU97 7lTj}6UJSxuEmt}Tʇ]bSls/L v'$Z]vfZhդ9u5%XJqJ$s?\g+|P; $R!ECCĥڻ6MtOaş}(&8iX+O -h^ʻjr{$3Y\ UĄ6RC5K(TLFDKËIxؤ&uk{ ⨠zcvE>7s79sWʕt`>"l]vݴ}BLez 1,c2ݥ0:.b76$ NRXϡ*-*բ\aΗ2دXLJީWO6RO yYhk4lRIE"o\%FsaCe7ΑЯz0zV?ByDZ[ӻ Ő) w5u"b#s7S ?3vѵ>ٌ8dVO.u|߲i.i`_洺^# ʧ!W}S,sgbxΩ&AHh*Jhi&&a ָu9=q1UcG%"Oy]_)*EwA‰K?L0;+#IDjx) Pm'Y%DMv@pނLlqo-Lx'M W${^{8 )aGaf7&SG5Nr`?&0 gB@h l_}Q[Zع0l%Zj8Qk36`r0U?prZiRD."Ete!}ܐk@Mk7,!Cp%}`M'/3nlԘ 9?\ kq}(01ĥqb䛬ΐ~)9.xx,"cӕo*A]tB;~7e3M{E?l[@iѥ =7'peI6tK8)7&ps,(?z§*?M]c\I<,ݠ-N*ߡRvG~{o懲1F k=V{F0-Q33 a]=&"52b hwP&#Y`UXR9afe̸Q{ .t28gO 3c>v w oǀjʭڇ Cҕ'#f(A6o`M37oPܼi.![Y8u2q{S>.ʾ#i;D~UǸm+ 3U5kG&4/R涻,+v)g`D}>E6aL:(ESB`UW!y3vcFNl1>j4MA;}`= 6FT끂7 n:㯕n&7usE&QVcOWV;DK9"0m[XА}~-v|k:kQVJ nSD3x>[Y`fϖΘ{dRWq1K$qW,WJ ٬N~r{F!WL$ R,6ӣObM N![S|E yM:hGG~ ScNhAwu9`I/ۍ /\!bnyc{S|>(ʑ(LC9;<IPm*` T> $jP}2-ҰwDȬ4NDT`Z4~oM=Fo_&M?}V1 cZhn]S{zzl36ޭV&odk^&&2g9|\.K#!{qUx_^"cq8=\T>5ʶN mH'v hdt?wPJ#76!ac _ohkc^ PJ{t# 5Juxy C`#4iL`՘ة ]7FywT*5}f򬘈rṡg5ꑎ”oڷoz~$zvQa?&& GQM4+^MP$hգ\?^O&âfhHuɹMg9,uyjDha\?m{ʾbbRLc[eT.SnrbMTKHlV`GQS}ZfUw!˪QF&ne &83y+Hi1Ik} x`w)g#䯳GOOkܦq2&1!9zubӘ<(F;W":&0"SE/'ꌨ|fN8{6e` .V>0JGa?hfy0VZD 9M ZQ6V.E :f5јaey6}"`K?]|Â>v)MjD ZL7<>D&J6bY?e'M _aLw"Dkm50ߩ~'CuWcPKK]GZ1NEώ>n|$۠fN!>H]BBWW߳'CrѮnc7$$O]bDQߢhfJ3rK7["M>˸}ob^%.3jYϫe&slyc'!M %֓U#cafEO5:x0{+lOv1WPkEr-ZwN-tēG4-0CWaWGD2EsO(fېie+ɦAb):pfE"L^GWC刌 A8%ypgtU\7 #Iew^_7<0u^ӯM;#^_fOODk7L3->\U֏׹{sHX<X#HM?[\aMB4Jmܨ& *{rClZNE愐ͷ,}7IL_- {iv/ZC²UJ E'3=p4h7Eя"ƥVWД<7>ٝajz~P{ޅمċ-tbV=ٳI'~fty2tֈ !4Ԛ$9w}_p(C炎vl4g+Nv |oF$rqymqdz͆[$&]=ZQ9nk,'2C"Ai(oE^TēsDfc_sl)| )} 4FweVAn;MfXR7ap\թnB2gͱ%dk&ǏU醹fV;Zz/|]e>9=V ]=eʣ]sA<~d+ h4`x02Y(5f=uI=]XQ-o2m'>08o<˹@zy`}G[U1z: " `E*} /Nҗv{IZZ>%3'22͗k\Wi'\QHG3/D[b%:6;Lj&!‘9z/U!O^="d+܅-k ou+ kw|OH.z"yRzIײo^s*6*b< sVGWW0*;3]:='Դ+W{g5Lif+e~O wl3Yד>tjjT'Codk+*j*z1Zdxj -#f3mQA5K?Z JS TMJWG=q2N1~[9-m\?CpTQ`5GƱU_+xW$SE2EoJ41Jl̮e1iM?Gj !ҕ^KߊQ_ѡë|:4v/f,R@DT B_{C4Hl;! }<ƒ}jWnYh3/>7xm\АQ\ĐV#@00Er%t`/!:Bـ];%thkUݹ)pOh|T\eZ؅e + jJ2=|Jx J[UwҎS"1J薜1D;;J;'nV/ԛN?K{VdXL/p`\ kI" ,g),|1W[Bۣ5Ÿi;AD/ _ZeeL_sUD*y: ǝE}8̗K+U,)j8  4ԬJ2(MHz[GC(E;l^gJ&B0t9 :Bs=ZpgH( MkVS-VDO RyeqKYc`8t,pߎ]Zg5[MObը}}KntyN: /ֲS+ ]Nʬsw.Gf$pI[[`繛0X[sf=xHkpɂ.>=U'A]8Xj=aͣ^x<\b=k'sm2 fqaXٕDϕYx);  %s+L }D5 QlM2'x9.j :兹Bif7U-#9=k?b] ׺}F4-rfϧ(fftU8&ß}_tfS|ѩsȻay)z B.~c)=6>Hn֐׸AġLK yZ\O}屏%P,4A6 s70Bnw4*n箺dŎ=w]>ɮh #EUov'io1M|Zce-`My:&'+rxK\c.pX0{'vBa+myc?麞% o::G2WiҊޭO#J/SW .C/ v֠]( pU\@q~G xpֱ'gm'`f\;i| ޻+c&iShr_2]l#ت>F1<"#Ú:t\j8YKzH(0'R~r wUfbܴhyBq):Z4n)&!i>(NsM:mɴޖw>y+pQ|6 n~LGJkŒp.IHŃZgi>i6 ^3 b'W֝" /$KqrS*3=IbqJ\TK p `~2Ο+ GSIR)aY$ P5)5m(TI )!VA#201 0 jgQؾlw(?ڈ-nu hږlwڞx\h6Kg,I>!|Io'_vW%ue}{lŷeAl0 6cggUې<ZQy&Mͦ;VZT 68nOΦBRtp0gBO#0~_eBY)h =I2^Bb/~UV9yy! {%y%H:Kq%LǷf'#k /٩Ő$4pz?}Uʇ lt!~MV$$ks~sƒyOҌU1@VCp`E7*h e^bKn W|P[= {w }~ls~N]=* }! Lj' pJï-OҵujZvxϲXW{yا*Zy?ˍ|&A }d%wL&NL`PcMS IWٷCh:ii$o=``?~p]-'d1i}# 7ڕk& Ï8jٺws|yTVdU,XRAFgO[Ý8vC YpBd@uWnf 5ϳɥz(*! G!x6vWنu+,nFURemCsm>]gP?lfx}+2ءI~fXo,ږii %uhX12co>kI)-&j`&$ -Ary3]kQfI :1:^ ӥ/mNmѴbk~zf )gw:Ibh䷐y[]pA?}crnŵbwu\`o^|%RYkjYS$BY~DtzM+A<} ̚ݝE32vdQOop+3`?6@vNv"S)zސgoĝilf.ɂ7Zaͻ( *-bV3Nxkh7)%NI &K7l"pz|g1Hr"!=8uh-l;;K=SfCW.{ ݺ4nf8Շ;I+;mg[aEvN- h4YB$Zdsqthny HuH!#\ 1!XȺoc˦|ϗQwt;~hB$^WzeF)+)?<5wI l$FobK" ;:p'ҩS46*?8 hrVwYV;=]iJkPIxyH462Ə&'h5-£u³^qbN^ h&̙ ylػR]ߞ]EN6bOiȾQ墶B'G:@&8Fp(V399۩VUNyT;+ 485kɍ{_ѪcRb:uvY%Ì GMt v.u>VF&i<S\U*^晄*TxW?=@ zY`c4jFi?2tGX:hI/MK9Iza 3{L}${X6$ϵ6,DfKfq*aV8:j;u;U6uk=Ώ*;{w_,\$Ӹ1c麋~7R=RȢAL!!/ qK%Heh$D-D̓ LYgH-5!=͝G?pm&Ug21ې"r*a5Sp&}{XzvmGRpP{l-AM-Þ[UEiЀy۷k5vT I8<jzRMgB kNόg ί] |bm,>zx\Fe| )t2ꌏ'[cZ\Vz=ЗײSX)zj#3~>g#zisz_4#a+1dr2wF]}IMe]м0w*_^*S>z֡D p%LM+èJ@̀r{KO{Wӌ$tҲA:]ti/7r/"|-@[oEƉ8f\[vqc_8 P `CU%e,MΖWmlv<{͆\# NUЕЛZ9RUho #ׂkk^` PCqz!tq6%Vji*V6٥z SHo5*Mzy]$XxTpv:0By<4(s]g?='tf,PIrFK_ Zur#TEP7o֒`^\^v YG[̰baBB-͟$b_uYtlwP#QƷ8 F Ffw4H-pWLPHm{ܠ+X @' PvGJlZzLepjӊ:EE!-?l"L0}>&xl8Ew(ێ I7'MsHkѪ/ZI}[HM9ΜLIaVp(_}2a"88"jNLb=K| b9y(IgdS^I+Y.~JVQmu mW8MFSzk4X0$2Mz&[Wؤ5e6;*:3:tznj Gr_E D'-r=_ +rum*/Z0 AhFt4VVߝC 69NT,՚e oi';#%zw~7nf`al0ˍN3S6:93}o3%ciaZ"-%Ñ]q1oEe}w^Npg&X9*vd4$:^{O `ď[Q6 œ"+w7%7{!awsN`UҵIB@SZ])UCކhG+p_Y!Le'ϝ6^ ТAD.a(PnICKeiA&:ȈF^r'&^qh GdK5;Ƈ+Wk@ޡ/ӳx*84%dhĻhޚ].JܾY؇ j:0w_Vl3 $0= ^@6 ?uO?.VQǚƃ mYMbH [z̴u/-l sh[Eú)L'ޖVw>_X]~EPN'{w,d8GvW]h /ـKW߆-uٓB7һ_gĐiet?Dg"`--%kQ@ eǦ2T61)Qѩkd֨`|y0j!*4vAG%bEy&sŚ߶70d1F]jPb싅6Ի1c_{M.1Dgqwc pV8~NVMc:$xR9< ?ݸ#ESOBiCd7T,kEO7:RV}ۘM;{oץs܎0[qP)zZ'Vm:KYAV:v5{*Ȕmb('%__;xV'IoKLۉDôj(j SvAvؓgK郉m=56*-eSռcY7(#w`X]i8uE28 lˇr_c&؁߇Hr^M_eOvRt Haۿr5rFLs&P(P rGÏh*$8(oBn X9^m~+F,zŲĻ?k8XsoDl>[HQױ4 |CQV w.(.Lqr9|@~ŤnYteEAY%QgpC%(F-.g#yH黿ؑI3}d~x#MִO WYi,v4q9B˺n7'N؛UHuF:ߥ `GEF (H|e*,Wc(AH魴(6,ꃂK-Bl4͉9ݑӮ,H=Ί x55hㅭ3ĝfsǒY5I5TP>9)(uf[Bd68:qe%8ry˕6G`I!]pǢgcz:ӣ>0evL'z:1poĮgy ِDvUVME­Mv5Ao?^x髁|Xс_+u}:?Qɰq"5jӣYiIGU[?cv*.z>h[w_S{2g HJ`z"W{?SrC Y =1&lBj[SREA&r[RO[Gq~̫C  !\:U#5(b2P؈!%HyNa 9S҅٪4_+}}7V!SlVvߥ *Є4C,ajQ[ntoۉ:GƮFѢ}yn,^/fCM|o+9z>fҦqdUuJ~ٲu1A[gd`_ͳLg^FsUQ.C\1V"IG<]08q@en1^%!*aB#8a, qw=?D.'T& j8NN) e1j-keZUuum\VY58BϲEw8L_/Y7 sqk2FEӴΎ)]"H }X_]N28# d9-{&QT7HG4pќvYhW5{4.@ \XqDٕNg w]gh䐮W _^i\b#XRL|̑uƤ1B;+0h]Z;6xlH+RU[֓z>:y6 mk~IsXqMy!"d1f/Ym/72;d!kw#1vPNMo{r!5E!,~-^WV3usF+"E] 5F3θXSž*c$UP4Lq"{U| (Z@9)>ۿ׏<b)IO:UM(=d_Q$%]"{SC"XGk?iQfP,g.WuLq@fQrͤnXs̡\7<' ڙЮ'&:NIw4 !' Ws:|`zfڶ5c.SۏtpGn$]y0 G؁/sBY˹Rwz|GhAN=b1rnwa2m:pUd6QL]j:0xKF& ^o2Ϩ{µ ؽ u@ ע7LͼG0%|Uc6~`9ہ .xL=,YEX +\ v̚OA[^s$D|6=K+s3)_8:=<@tةFs5 a>_,sWDž1KjEښ?ػ_C$;uɳQoCX׶jsP}}@ven 'TY{#{}\!QELC erMءs(h} &0Kk~FTkv0ܒ!IdKM I=~q&Ia+7Xti ;xep8⁲p#+3].5j,pxvJ`c Ul\`Ų8F zzdS`K]t{97!Pp{+ &4dQ5K3)<>{ ; Y@eIfws?j{ "ov+6'+qVҽ,\MG+hq##5g'=,a_:K$f&=ԝooAEɡ@'eP85 1yBLܱ&;G2> XhH$X3!{ί1[-]o)B}H_B|2~ K`:#R[I{U9GljOMŒ&g)>5^+[r9!@tJ `OSdi) qԜ\XE_zMr"egv%N|];a|dPV1WT Křp5Uf\cd7sr;P$*R!.%өQcDzpe:Fqr _cn2q:w{Nˏ,D,[L-Sfo,)IP78a7"Lի:E# YIu}z)MgdmKgNWǬV%0%vz|wtJR0*jBĊ[)4P^=7,"N/5&/AK! 3c ~4PQ2=_*|Rsa8WӔ0~Zinz`ePNd2VT-#Mʶ#amd Hiw$MS];=zY_u)HYGT֐%ad}Bgx_eFFbX$1пE5@z p==3b>C"ʟp[^>F:`5 yȓ xNmkGRe(Զ~ MK俏Gե3PlPݚ'f.m9^:տ!@Ad4ÐDafDzF˵~,gaW:6͑mEg ?6mO:]iDMjvwx;=s~r#؛z?̉p"%5 g%Lj(|Pk[cH4WإxV6~{/h !]al5)`Z, { wQj³C%0@K!Vu0Y<@c{R]goa4YX2W.7 )%m6P6qlUJrza+MYsZoP*CmqOT+Y7b~L;T^DL(u*6N q \ZH$C Z?S"U[pSs\Fd¦\|si! wUt=7f첿}m_q8q6Ԋ{i*K WVm :5G;܁4._^ToN.ª(4e,'e_6KNs~E%⅀LRG2=6gZX|П𩇎kSG"(-4bEZ U4'm_BFPzhotE`Nچ2Fytc.8-yG(+U+BF'ʭi|RsOo[ 6w+J~$Jw+Yt/P(uQJ󒑍mb*D2J"Op1L>XC0$iWʥ:5LCLM< & endstream endobj 258 0 obj << /Length1 1633 /Length2 8402 /Length3 0 /Length 9461 /Filter /FlateDecode >> stream xڍT5LHw"K,tIw ,..tJt ")t(-‹}svwf9$5 uEW)+l+ί)@뻱{q0'O E݅}QQrgq@0 AZ*cwޑAm!w?8>` wjAa8TsCl.ELw}gv'/8TVP1998+$  U^m0ϳ)p7hx ?7;)C()?SHww;C)n+4w_Mր@ݝ7Yc*Am;Aam+['vo֎w]A-ap_{'N^ GnAm nw);z~[8׍~~[~-q1?]oKXκI;Ceesa;,wt O=t p]77ջ;7?vG ޙߊ_G ABqCjCTznf6z볈p$J ZC|M!ZT8Yb+5I"Awr gab`l]?=6̎g-y Hx)#˖GuvDp˦xc ̰[eR=t㥿Er$9>M;~˨#Tc.{1Z/EBmBE~F2:#J9SZMpNp;6gcࠦG'Sy8ѹ)S8pEu r,bʣrow_ybqsړ1zAulv1Z54X*ҷt|˪ [g^AzOExmr9Zg:w\mQSX$w[Srpi_PeӻoŠaNkj0˙Y#&YA٭lUEXqc؋&1w $7a'F='coO y4IMrcAd7%j\ߔpBn}z#Kes דGBzT6oT{Q(q8d |.xbQCŧWkG|+Jμ{qh)OiG*ZۮEm}CJvս_)0~&%^:kD_nƱ XFR_a@;x3MF0t9i fM}5םN&#"SϤo3&YT\dcAE,ͮ6Xx4ҜqyfLn/l _z0Ѯx v|3L"ķM~“.Y?xinp[yĞ۞%7S{8BJ˖qoISN6S}XnٕuLh}73q! zr``i#Id>C[pqa"7d4S/+`3alzIv0ΧrS^ח!􅣵^4>A1"}9#iriq*4XC/h~ց"KXn_ʈ ܢHkDc̙gw)FxJ%V"VH 2okȟ΍bk>rY@|D\o yq2GzیN昣~KeZ' ejn^a5FyjD!״9r9aU=L)|̟T$ b:sn۠|Gwk%8:< ̸I@7aVAO;{̊&1XqZDFȒUPGSYȎ>a;M1f{E'^ə{Ǘs/Xi蟱F8L5`~7q(IZ7 2scQȇcߨby<[[6HL}C̴+G_EfdbEKm ǹPVVs0z ԋ:R[ @e)&jMĝq^pj!B~žJeBhґKYN/Hw״Cb_VIU%[yplHѵ^s2ڹz숏oB /'b8KJ36uYe3"Qb`gp,.|L nq聾$hҙ<}x@MOc Y *Rڣ{nմ*~<̫G^$]ǫa4|[)(gTloŶgrk]3)+.tH&Lo=5S߆ηY1´V4Ֆ{;jhُgԵK{N{qb85OWJh2&OuyL6Lə \Gy[;yz 6 4V,՗Gaen~ H‡ǚ*ڍUi&@m>wv!fdZ9:_pf#K"<2@VR*$:VWv/ь8rɎmxRVAj!R_R:ytZp^Pgf |'hֈŞm_Ҿ2|?2f-o:WP)*"Ͼ!ˉGSE<-9Vt?#.zZu"[?'U 6sR _ Mx~RsCCZuӹ +Zkg $ aVBSоj̓-7Oʤ82WzJwnߎ%pkȦ_bO j}m7yd͸: [`>jGt es~W)bg 7M$ q,Ʀg%pAGmeh5t݄h HxNs S&sDxS}MAIP_-OVzhrXsCL vhEsd"DcVXֈ- F4`G m¡@5n-y^ Mv ɯFȱQ d`}R?Cu%fJHHr7ŌLTh06*uw%,* 9BaA)_l?&bEeΡTb.[4Yo $-rhZ0 [7JNKZz̕hiwbx18>w8LJAg8`T;\#z@IPT.i }dĜ8VVG?[(FcNsX/@C4 4)(@KRBy-7[rYS`2Rh3N8aQBL+Đ/41P="K>1Z M kK HD !Mgk}dp (M\@[Qrp[ugmuSdf~!++3?Hپ =('bv&|ǎb^;́0}MRx3#8Sv?|1.dYWJuM,F]νP?`VY`^ ЗlW9,jFhʼBܶok"XCuQt/:JW@.}U]אYlOo:U޻~o=)Ouʟ5 ^op̼!F0)Z \Wd{԰YHRN | sS~źru- (͒V˧K+Ga=nu\b@R\ M)Y94G<Iӈ,Jdi+@γ\$}¦-ҁ3Ǥ8ջuL{fohlVrcZ\2  \8I2,x *R ͣB ^#5֮y;[޹ϡcd2?83#w(0q5ҲB+j,\f"-}n3"x8(}{6(=>o5WBX=qw"eb;_7ŸrY۝,ja,eQy4 $øXvWe?qȯ-ŗ};] "Qqu9kDxzO{bXE|{jXߴpqrޏ]z^;o͢a=U6DIkxC(e%7t2H.Fl)/l5l3%FB{4ӽ,O|4t/x-i׫^?Ѹ{~p^fZto_Ŝ IwR$Ljj w9Y3v"S0vg$+Qma@ToGrAAub-i0=y^i==TI%S3}߾Iw`F'$-*McEM_}L nLF9z~g*;hM:$HNQjf>\9pM-j̰ MǼ֮x]<4,EӠl䔢8)pxՄlQg(l a,DA13O(spW7Yw=4I[dKeG'-Q7(/?FF}|Bؾ_;6f5E/M|]m3 tqq$Lw[=UKUoo{] {1!QP6Sj.ؼvuZ{RҖ8r/󇝃j;2JNQfT,4ao*SB ף~Z4IQq?cze]KYAn`/>z(`+%濟6 RhOE]HrI 4ġqI>-ō-5+SJ#;vBn3rz^k䄣^glb7֊||ߏݺp,#rv0enz3yV5bg;GuTvaLxgbՂEBGg3O 20(e;Mue[3h~(vY$~&Ƶ;ŭڦqb]vG'3:D$ Pv>f5ТS0$8,4=lq62Y+#!vȨ}#8#2}Κ?ɟR`žG:;!ê卐9gJý7f| 9ur$EAnU4!܄ ߷"V>K?΋v|0aTg=82Z]ѨRz#a})n eYb O=9M)S̀FQX x@X̺?qRKIyoN}>XZIMk U3©ay;!p.τK*#碘Ò]ɪڹwtdjg|!Ył޿0A8tAoV3pP.|ubLh5e{“fZ#SK_y[ZHŊ`]XΞܼeݶJބocQ5hrV(S뗎&L4O!y+Z a'4{}H+;OcNdGy=>5Aw$K65eht\}5 ޖimOG\rƪ2rS-.j{;?UCDZaّI/jΏM_<x`/*ZS NXYgK>b6 C@\>VWLY[ҘZNqA.K)FIPS2WGsq4-*")DuI!xƎ^3QL@O4T΅cfvGޡ9܅ߝ/YZ[\ހyI~ ][B48؈OpU+k i>lj_DM69^[@1Kj}KpO 5x=EH8Dcls?Ǹ(s˞P?9I8e)bt@1D<%APRⳚ L,?61Œ1>Qp)>`p< ;R*9hbdxJƫ=1v)y$Z%8߷'gƉut ʳ@T\$uY96K\Ѽ*<K{g;ymaJgI%iIJumRdCNk\  WJބR^r@g[mvS֖Pq "='U31:Vݷ8a(r 8B@CPI\ZzK2@-WBl)';/rSk胹||PT!qnx7Lj.Ao/~ A¸sWZ~S<$mUvHabO}v9\$yi gcQ Ϩ?C?P/=7humW D*Ms(7IZ!>]>]?u$qij/ކYpqh`5"ΐlvHZ:eyDJ;7y==(F*v Fu9 J'/) akLS Ej`bHL¢ëF;\ȅ2KQ~MQcQZbZc1a.8P:aav"3*h~%DA%J$Xա:qf^맋+' .#퉫0CxNA714Վ<˛x}m'yd9NH$YojBf &{XĴJhyKQwB n_[&Pl簰JF w`\)6 TFYh\^}k<|T{`ṱaT½&4RM<( x=oҩTޡ8gTVg*ⴆkR-k+8P`'RCg .Eʖ WȷV*cd}[hgS׌Y:_LG7۠ԕ~W2S-} #V"> stream xڍPZ-C 8ݥww ;w{ x[x$̝*׶u{RME jB\Y8Xvv.VvvNTZZ-o3*#@hl2w}SB n.^vv';;)sw@]Pi%^ [28y@g9lj ?3Z;4 uuu`c`5BmD W[ P1RƊJ вeׄZz;%:JUG ` ]lni ;C@5PQbuteC~;@ANnW? [3Յ["2Ϸ, @ IWg!P-͑MrrKlB agg@OK[嵼 |g@?5 puv`tXm@T6wy ٟg_e8x'O$$T Ro`asx~]USPb %%褐{c͠}e ?ony*ɸ98q`ϓ݀o.MVZw5qÿ"Z\-muṼT~5v={ܫ?.:74j{8y̝ͽPٟNjV@? `c@]SPg)6A?fotlV6? f`>yϼg^? ' ?tsv~~s;<{@'uqj)jWvS%N;.:'eI͟s컧 NU<ʓ>=@'W#kez[t;bC~0kQX kY#æ#b(Jڥ:)||IX60!tfT߳RDf*mssd/}8JeOlS]ٖ1p).5/潘u +F'B@3~O'*ͤ{F~˯z(G /ykDLhasFh}eo1YD >5!Xb+ĵ Ft@.^tƉa~)me}B9'5eނ &Ťx/!R}?՗XdեGW@oBt+eڍ&.In`OŌxPN$2+OSUK^Vo0X}YMX%jds% &ƺj GhRۊ×lN;QfXe%b/%am/@>/NW jnpk;V@v@{{3R2lOjR\?|]I']컵ŲxNP0&) 1KY rb$2"hhZtՍ'G5q_n.tɊ_``~iM*(Y-.ߡXa-آU~dyZ??dt>ɨsAYOi7< Y Iř0V\9 "1"(V)E[Oþl o`<,{!7uLd+Q'Aww7HEiWRً W,>ՌSZzx4=%3ohtnq\}wCxH\aj1_ !EKV>#fl#T|],fqa YZfq .wb#ݞ<s h}?43Y [O]F+8}.,PȠho#P8 s~;і࠮;dp9ҕ~()C%mWS[2o e.T/V#a3qc<paPNnt)΋PK_(,w o9؄n=v1$ӲO"D>³ɀF=xL )n-kav-Sf9ɥT~Ƅ)B= 49O^A8w]i?U]).JӰV1m}C17RIAyL2n6kQ/{CDdt Ps[7wY';jS!Uj;=xdCK}*4@˄Э*oL.i@Qs/܃kJ+gS{Sa&`dH~BR?$i|, Fc*́8#).k:ֱŒ j+3#"Nc'+BPuV!WH ^IfmN{,m^rtTyw8,y&{] ml2 x1ch`|)jaI;a9*'`ernʸKe4np/*F$0/͔:K/v3z NڄXYg,/0f1MMwU=cM>n_ V6 Igl3v N A/4/n8Ykb9b "TEMlxHvGT948~wK{U2I7JQZD37G;KYL*偅,$Aɢu:/:ReI t#"׫O&L4iwYO6]YJE˷"H]I_ᨊPCq+|f9yUKMGQҴvYsNZ2d]hz90˃sbz57߱ř$2r63}g4=5u-DP.}")"x8Lݻ=#|1RYv! Jh?'>ˬ< ~%3o0sGӋl0Sj܇Ĵ EZR˵ (q@X-- q+efSۛM8 $~徙oi'V/ޘYo3`QH$5eҊ@Ӛ2@o6K%=LZ64G7y^W|&cDYbXUI)_=j0_}^I,HD(o@GKFx?.\RUr?t cQA/ohJXVUΪ֊鮑&kK Y!yH%7Ӧ\#q Eei&tz|@ 8)an蔎Yݖz/@k9B"q Fh^H`kJx /#=iб{ ܑBuxdgkLՀ:zЍd W嘹0)M TsƷ~룗PܹwҪH-Q_l6a cZ~?כܪ`soۨ9[yT3[J5ӝouD$`P(BoPD/MSo%#$4ۆƫ6lm[me]]t}Ě8<{]*+Ӈȫ6BNEPrrBr+D]|jA%Zf XSy yH#NUPb.ZIcSQ]:c6V痘c!=/#Cճ|Ͻ-qi&]hf r+6oty@;!HY 3tD5|p ^LK#㗧Ԩ5"xDN{Coy'6Ꮽ& f䔾'Hw$0 _k?" ڲ7j8e!3~ىVw.DʪJ6y5IUW/X Bwbɐ!#lEȟ_ϙB=+!-F~YT w~ 52p7#_W&Jlɔ/j j(7FeO ؗ]O):'ubǏ2%M% o&{O$)~0wX?Aܣ1j Y3॓8SЙ q QMj9 5?d"(ztXxӚs3$k"o$掩;WEhjA  Ԩ'12|79,Eé (W$/~ l-<.D #AꤜqKfՏ,*Lg_Y\q(QaKjXfƲ2Ȃ=s :{  u;ulR fO@Q.e35<|gkswҵۻ [ ++@,$ȜE >1mH`oɁϪtTuRak2az4d[2#%|8Δ< SRCI㸃f2t=˛<a(aIj;m KX[)[)FG F`Tv T NyTtҐv+F'ȸ5qs njABIu<%/Ò!d6ٓ/?3!A^S׉'8Q*%Czk/0o5<:HHIɧE7Il@un,r!\HøȚRNEasL望p[YK)K('⏄x.F]T'q`Ҿqzks ҝ9[DPo Y`*'c ,*{} #5mY  'ɮ+"I&/.64SqeK!?m,(ƨݱڊftCd!c8#vYR_)&kbמӊu ~t9}n̦YFo~Ft{`mK3?ʑ$\c֚N먣)$Qն@r%> = c7ggWQƐyo{<>flŒAΚ}q(MC&j\cNA2$#KpTon|ۍ)뾦3]M|y8Xh[`1@zŚC>%B|m,}qwQA}n\"X gfOtzt #a>{7nN{>rV0fi_Z[%@Og/HH7:CV|5OSV2榕DYkyc$HjBd?b_Ƹ"ɗLi{I0lUO­rjhirlk V)$ͯ"M;fyjjc=+؏?%ջfiN[xg"cNPQ".Cxp?/Mo*>L \k~>Zs%>-ʪD|E,f,0YmnH-Z \/;ٿtn .ՔxdJE 荳S/* "B]:;AԈ&RE)2vijNK+/ 9- #Fm@h4}wO6rUsbƣՄ|⠠b?;T[3!! {)*ͭqC js"qa'|X߱Bx"A{2, tZ| B$# %|$ݸD^?/OhfrzOg>"jj*$E¼Xs蚷z ٯH=>epc}# 5I,7sM{tvFQ[$\+kd[vEDF4}Il$w]'H2ƿT&ԿъQL`qn< v?vA4DEeI3Twu.q} FIЧxJgV }1S7Ȼ׮[F!VX"h  g'.~WO "^ Xvϭ0/`<5"b^9F'Ѓ`*Ia8Y+:^Os}!I_QJ Eم=[mApkNk_~V+Yi\;PKixBkPx^icK S8V; G?)2aCl<,QL߄Չyi m1xi(g`9~Һ*z~9nG՗&7N]A]ŁtJc)K1d8q\%i|rQڍKȺ*sSϲ/NˑZ,1"o){0eŝb(1B"SpW%tDMӮ{z ꥢb{|F;Y-[ap预.N{1HSv4 Ҝ *^񯏌z%f6BW&a9_6Di4D Sa-zjX"MRӋ2N!<M*D w9i-pƖ >b/WC 3VvRVWQAlc\Sb6w 0)\?}Scc%_u5ٓK6nH"Z1C[.[{πxιsȔ`MK51V+iU8ekvtC@ O5O/El~V ! E.˅),jb{id@KQc^tdQSw]>8Tk{UuvwՓ&a }*'2#jm44 $}I5s,ߟ{xkôԴ3Y{Ū.]WWW ߏp軽\*p1B< <a]쓂0kQދ|+[:cI[k}lehܭe?po`FVP 9okO1,= mjdv|h#Ȧ]X,e&R:f3TM[ڥmd06EW!fΒz ~z+15<%g#wG~_ ^"ޤS8'(S Ji Mb~ c /+1R9yx@kُ;`'tD3nIH{9}5s]J՞KB\燲xH\ -Th^eMnc71m?pfԞ.r1EhkWX 6{qj0YIn9z/ vJLY:jݏ8/YnA(vFarJ ihTtGG!w}`8Y)wy~QhegŴFRF+𖄧lb˜/~@Տ{p ;c;`uoORjdk:r e"N$y,ՠGJA]G従j|E/V, 4l*`\cj'ϳ79Ib i<-W;_eMmiRBQ~uH6@JV_1fJ{S裏X/@Uh/-~k4܂)tm#0 ui1l}5]I~Kn DJIK/E(eXsx ok@L^zʖmlۗtGG4sv饟1ïoʍW*V 8f!Bt&fbSď,%('^yi3̸mKWn3TԈsnk*I{WaD"RFkc eH[{_nU"z:[a"uh-t|-aͅ l.{_`0{n?TRom ]ABJ>/1ǗGrY}.nA=mbv%d'vAr.~=Sͻᓹ$#,uE=Ba?湐:MZDZs.Y/»럎p_[ H>4qP9D4k޳&|ިˀ[ 4KǢ0mEd2DQ{\V6uGcW+Նۀ-&Jq%݃`j6ju J5L7͙+J2àVsOem$ͶzߡxV=k^}5_Ma ,ueW{z]pJpxg--ڋm(p_KQEfi0 Ek>J=ܣ DAiݻ%yS&ƌMe]SbŴ$Z:,9^uZܗzmwm{%*"ZIdb:sK[tq Vt`%g< ,W.~!,6Ϻhݻ}tuŽd~ vۄH:S􊧢ME8e!}EJIfgiΏ0KlS^>K6Ox#ȵS n['ǒ6mSйJwo r, 06W8LʎilAȆ=l<_-0QDM>&48Ҩ77J5"wӞj,7-ͷi$O< endstream endobj 262 0 obj << /Length1 1395 /Length2 6090 /Length3 0 /Length 7032 /Filter /FlateDecode >> stream xڍVT컧$F42 tl1r4J  Ҋ( RJJ()W{νgl}~{TT D1PDK~~3FQrͮCx:w3@>@"-`_hPpu(7_ AbU:`@p A( G+ @S4 ++)Abhu_\! L 4sEx6E;c8@(o| kMu s^G`,a_<῍_j|8O'p8o/qo 0,@ɎWÝ wxA_Oxn9Q.HJK\7Mh NT\(*.B @!YZ#(dA9@_0|"wC4p?Ka/C7?meV(b,~# @%6;!|iB񛡂rޚ s@( ~`?&8~]RC;9q)i KR@Np߼Ph,> tFc)) _2-/o"Kp?@nu{ua (E(n sLC&";bsAiIC`_y ,1Ÿ$>dd 09vJu7JЙWpwV]|R/(+g"DR+P-W9C+ӧ2j]^ ʮ={sڗ[q[k-jۘZuH3yC(q_ *=&ŨH]xJ"kWQsDdg6®AbF8ݵlZ' "k")+Jaޟ𤠔-bRsRs3rS$wĥ9l&X?K=0eLPJ! }I]vA$o%|؎ >l2EkO>bw8̈r)dR'=m{|C[VMF |[H>IP{tϩ|ԝ&%2T٬M|$rJ;F s!-dXFu9NׂGCg]\h[-j2v}ÿ{CyL6kiW骹rtIh Y&0{6# ҷvifB5^L0wXYu\'cӠzH%%MuRFP'~fz'>t|Dn797]b4I:֙#@_㌠ԛ4B(zYs:I!l~W ]˹iYBuSqEiuԽ~v_S&&}SF$ED #ߌ6+Lb62ի^O*8ɫEJ56|2 $o*3#Ƅ8aC㳚nš yu=:'gj<ޞ<NXAtڭrHr8ž^_x9ӵ-yQ$7IT. >6 dWʞ?O}V mA=xAʧ<E7hWtuƸ5Ӭ4tHex|"\dn:EZ9~NܦΩSX>`">6E9#aIr<ŏ;4Zm {d_= Fx@NCx޵)msFi4ANvbkmۘؗi_*h%ku+alJi :Y?uf cT`39y}YW_?|W: U͸$,T ʮ?,pjUDOXt=0]P"a8":#Ȱ殪MyHF^0\?ד)~Hkr5$U>YH'i:2 ::7J_Q*y 윪G"M 1, $[܊cV5wfeF X#z=Ghls}Ix ĕC3^ԙ?KŽgj6oSچ'8wV9R1&sjk#dY) ? 8[t1s 7dc*DM]%?]rkJ:U+V& =mwЉNwEyZ)&/8m.®d4.q(zn^WY)5Jt'\ZxV{y#[E\MHiM;I }žO$䧗F~?a&}d^2^0'<휘hlN~-Ez xOHb,9}'[/Cvs^\ /jBl0V6c v,mFN:`r9 ^gC-86XNI3=k*bWEa2+=25k{L~\hbQ7zW(6>z~L )@y.qO"? cż[}6hހ`y.&2%ћ7jNJ[iӥ&iNu폥dܪQ֜!Fɯi4-Y KTi>0NcqDUϊۘȃ͸W&J_?k{]Vty2zfv !>mF9z}7w%ikU_DhEHI~a7<ӞJ@] *g$c'Ad籨k|YՔ+L6mî- {&ϗ>3-$j AfQafQ ݋Z xtHpgg~AIRvM;;-Syq߶ G눱SVmw3 uj#}Z5gm>5kWpdյUUj{@ pL׊Oc62hT ۵۷Biwt]iiOF+ uXhl$lai7%1؅Gy) ) WI|\@2EIp>d^j\Ml+8\^, 5_Ϳ5tPO! ιh37<#D}is§@O ϖEBfi FM2qpw'{ep\#pZ`G@T"0+'c3 Mɔ(g藥XvTr9 ا$Y-% f~Ga?@CT a(p).qGq%4#[ 3kE6aWكTӄ|WPr=EJp ~ZV XKAֆM=?ׯQhUJi49~RrH Ƙq٧ d8QR%=3=rU@Yֳy#IT:|Յ]تS0nv3!5nMN:[- eǠ{JsTi+.cRH"۬lFE}gZS}ĻSm)7QzsBL 0Y۬ngwX`mnjӍt`XnYWyRW+nXpIj9K 1fr.sT#ȪSJ$ (ie ǖDG69K*YYm_lF-ENCZPuj&ltW[@&uVXZ/c#"*¸|#8r {ւmߒE7;,oTw;㨊rQW^YPT?@4'AfTW>bΎxcUv\pmehTH<>ْdk#fVC =gqI[?֦ѝvcw%rm.RAF"Y;Yo $:A󰯒Sz/C)$Uٕ j7n{7zg+ؑO1EO2I2s?/Pzʷv-i)0M C)L7nZ]e2e =՗W_}C,n%(& 6Լ7-;LHCTA>gdg&%ed?xnB`w%tZ3u?%0LS=ɷ٘~7FsGQ v{ wmUh:n00& Ln_љyAPuٗBtjp:V$,e3V,mWH]6>{goϹ$5BVFw"-HT]W;-!w?x.}Yl&{}=Z K.9҉\B {>gkrQv6̛wrp鮉d`-}\\d4JJśv3ѱ?&pxK3ܚ$x o>[j^ F)pw ;~Y !;\w_%. HHF3zT)LE&Qvq-.a@Gͭdm$%:2O;__*m'?oCamޢ#gy߄1LŹ e.SP \<\s-34Zu:>cra6S +/l5zX8@ _å|6Y$"AL*yoRZv} n-Q`~mԓҗT*!4_iA.^ʜ ڰ[o j}I\TĮʾ UdBǑv/{"G 'ϧ}ynxFeb| ^k)Whu([/&\ޛ"hvp6&UpEܹ!~|l֔m3BwX0RTѷ'vY1x䷋F@LRb޺P,ұh CDF&||Cg;_ #a endstream endobj 264 0 obj << /Length1 1392 /Length2 5933 /Length3 0 /Length 6875 /Filter /FlateDecode >> stream xڍw4ֶhщG^C`-:QB^'ZD'HE7ɛ_֬5{_{{_Zʨ+g(aH^>$/@ !>Htmc5x"p \PojZ]YR f%>AQ 6LPD@{~> P'ޯFLxHkѣj}-pb7= ph;]d#dRq;ᘇ}PTEd -EWN|J>MoY~pBoq(|g/YӜ=x:R[hzG;bLb pJOIh ry[q,K$^A/3:ߗ.t\F*.5cw9jM46yScA=Ǻؙ`l52h4ЈK•9}Z1[ K Lѳے>?R6C/"9̭%Gar0UQ\|T:O^,O\f' s Bq"z҈w$ klbĀƤ["׺r#mx,|p^iTh]3{;w7+ }%C [x^%ZФX\ >m*z` 1b>lr C0j{kMz) X| n ;4g(c=]b[F k(zQF4Aa4sF[wئ|=;6Gg ]vFcwR9YmC R>&8k[o[4%4v0íiqv Nt r~pƝQhVͫIʑrFS\{]6o#eM)6 ??^n6=UOgo Y]R8+lKWhvUՐ#oWVJ7{`\9:\ohhvmixlHU`3Xς-il~v_Fu)>-,5K8IFiQ%4}Ѵ?!2QnQ+ ܨ$6e$Ú߻_Ypv£_ڀy#1p nFU])$&T\\[liזa QQShw(I{α%9 O:žzR9!c̆XEο\@sQܴ$ {OŋzT2l>F.:׸%Cx6<R/ OV4MR"8]$%̈́K{ЧdK8Ƒ6r@xʔ?:r$hw;#]v!x._B_VsUs7.{ [veMbf/_b{_;7I9$Y>zəbn`QY)ÁX+g; ꒁjijJVr\H9a}&S2G+~$5jfJ=;Q4=h.]&U; )U'G~_o#>j<,`>s{GT1Iְdb.iSWKD%qݩ"i}$%<2grJU3o7k g`|Tðb0TrͲ 7Ѧ#JUARx65}bdyڗlf,hVi}L=x~>>ۺHeUG5"K_ Q*sCVFm ][%5 ,a`Nb-#ʟTrfNm2plL`ݭ~W\.K?s]o!mqMe% e vaͨE"="i"na$[ 1 Yfrgħ!F+䩆{&,ұz2o?5Jɪv-Sޥjf"4uL~4sNuP1">6-KPZ 2Q`'fNa8tӰqcn`D@BUJ@VS5XH"]w׍ʹ`[kv ㈚KY'>Lƽ1S!D|2ɇ im"R,bfSGT "3 2YkBH$]xyUab%$EuC&T&r=/Z(MhԈ9-J'νը-x`cjWRE RƔfG V@\*#c<;~QyиjCϤ}G*$ FıOiR /o>J"gLzb#g+bv8\g}0T>t{O9i`FofGUxR@%wlK/w|IZWh {i:Axѻ6Ӽw."`_>=g#W>r\qlw[ns~L%3*1&RDM +*L}ɴf/%wS`S7m) S!QЌq'eR}| Vcd'sU?#MhL`Y0,7z9˴Nt<VJvljAe\{-4&]jgf1$#8a);%&8XnHzp5cP(aG!N0MvPx{Cf09*'l[b@AJ9ujXu\uKy{*p\~ߖgBuXO$'B / b|LҦ-i)˘ [[dGX쁏);kH4MY s|g4"Q:}]P{ޚQ "4ƎR{?^̚uOlW8OvybCv>9M~R雏4.t4bzlV>Q 3 3BJ_Eɼ eFS.'*HϯDoxFa^.k\3  xLٖLYKc讓DWV#k3cSٚJFEecmhLoC:+S|+R8s^8L fOH,Ų<^b-P%wwWsjvqaB\>EFѳ\ yM-Z *,rTw]%~{^tmvO v 5)uFö2Kvt^iT:TƂ!UvG\ufj5~LJYyp{ӁGF?q!cv޼b8G̗O{$T8#3^uE,WS c}tzjUFr']Y YFD<eDj-S'o1~JЄ钰ѱjU,1Sow>4w[+rZeQ&{ }ICѼߖ/?DEtXZz*/- nɜx)Qǀk:(\Yl@٣zQ8pu'dN/ L<tNUPgppUV{f]SVClDg$1..GXl鑝$3.>k&HU8u) ~ Fm&?ZE4yNr &^{@BO؎x8o1YJt|vN_.47]?Fm#Z|ҫ/m~[ȉIFOyGRBO,0C NMU8k+-'}ר/c.ܜw'\F 0oߖOyW}[씕mf5"ip3Qjkl0,ekۧcv5St=v}|*à /a=!{4_6}+aԁ7Dr~éG>.=_Og endstream endobj 266 0 obj << /Length1 1532 /Length2 6989 /Length3 0 /Length 8023 /Filter /FlateDecode >> stream xڍT[6t)t !-]00 ] ()]"tH|sYk]u5 zܲpkxyxxy!H(o솀ab!F0k$QC|>!1>a1^^?/ߎp71P>>! sj[C?2ѿHNo"gl]A3yyA7!_Y)Cl9ݑЀ&FZl qw_ 5#0{ι> ^`[mnk_*l9eM`dw]Enknnx(V_>Ԭڂ~K? jmܬA`(ؠ/ :C`TBgw(ߘuG_@nnB׿/0 ›: m6`)dy렎<*tٲO~4^sӞ!{W~©DŽӣVIu舞a&} بZ/@lg i4X܎& LAs8R7 w}k琸sޫfq rz Ժ^Q2%SQ$樾E ɗ&0R9,b<^9Uך/`)tOp{\dn1Z (t&9j[jh^7&%=D}1YY|P䄴.CvFW2jf2m MeG\<_B*&N7> vE™(&۳vzߪ}$1PB֪;str1[;MeDg If724qMd ɜ+_J7I><~xGAg7vN׏ 6n@~KS% ƝM9ɠCOyr7Vdb}8m834FtNZk7틣x7Κ fPY1Z/"Ge`gvڄ5lx\ZfrW9)lk@Q_LH" `wa{T.!g2owkoJPԎ/JId#Ү+u 7-!-I]u)Srj%HqTt3VhLͺ?wCW>u3GGpJƊ+r(݉2!rm^^9EVl2lj t.3>z hWo@[WmlA?bRݖx?fsIY+_f'IHx2Ģ6kꫡ\}L%ҧu;.B=gK~C*%j& Z Fk P{G4kT OO2*^&";9$Qpr*V":]\.ߎU{qƪjJD/\ ve ZyIKM'@R(ׂ6\u'8f XoGg73LoYb[@S"YBCVV,ٳZ/Wύ-S1o^[E g I|.}_y_;6q^FfɛJ|N!s]u |^:[NYvQu @kY, ^Vi86i]eq)=ͅwl̇&g8 %jEztY`n ׉&,1t\q'М7 /3M[u&lx"N00 Hv; \ȶQfd/y2l֦jo2mm>hvȖ[' ws#~4 M/(?b&f}|硰j+uBws18zet-j_NOs3cr|xe#~-SKjuMz3V;~V+($^5$c 1 9w4j0y4+)_T{Iwm~z̒]z9-fh [J[ |d~I8%(6>Hۙ>AΆa\=gioyho0* cZ4OxQöl8}\Z V1"Yt˳ړZx(XP;6qgR4ԯ9J}cn˼{.ԦzM'8ufdR߷#OtaQ/b4OO؅qJ!Lt7A݆ҐNR( ^")[GoؠCe*גa{Aēăw-YwD}~ӏ_ $f-q쥋M<χ;V쩝y9ra\p|zs߭ UP?1:oOێY%Mڗܻ| ˜<EGG4_ r) %\{HW5y/ĺpY||1ڵSnՅ39z|iBkU[m˻8AllD7qH<H:m~Z-Z^SEpB@E ~rCר;eF:[>ST4Rt Uy{:^`N=5K~THHcpKGE 7)Q0^!$hG5ͮ ,1Eu:;Xn$$GqN:_V\y$5 c.φ>s'òt츰{um)$ݙ GUw, fŇb_ ".a4 ݱ0v?BDd}Kw z/X/H"?,}? !}8g TJC3<[YnFa;PSuj}rv9WԮZnNPlu>c:U,hLp{n! |yڊHPHi~ ͵] v7cCD-N^5Q:b堼v5Կ;FJL8qsNRW .V?e-!.ahӡ O6*8+ݞ(.!'hcu^1]2$<#m+#b'(N#ܞFcBMU+.oj9K;U u 5qg$( ALSf=_7Okqa|~uc0v2ឆF ^C](kKc7MFuSDo"%eB;9'ek\h3sVMtɤy+Rp 44YNآILTbO?Xy"V_r _rJ~&ϐ~]K,*B.LJӞ(RKc{O7k/2+IwE`͝+j;=Ӭ7kTڎ 9ԧYJK 1[Y*kS]\,`@M~'cF9S3e?ČI<&g5^*0 7Ę,G{YE\:A0s-rb*$Ir8u`@@ du8j8lzNHv20I~#fxd"^;;VԴ.ë;UCZIJB<5RX觜_tBy*&$w[{!^pUra+!繁ȝAÕ:J] G >yo|IϋRv_1!fHaoy\6+M_m>$du @p4V;˶A6z5HL*!Y u6dk}bJf>W,,* "ѯLLZ12=QZa]!<'9%GDSI 3@S@8*zjܬ-5?UQB&`h͊Vh K9]:W٧+!0(y3YDn1C(@!(mjjK!ʩ(\{i#kqAu8u&Ȗڃ z8ICO V&Cb a%iGm"ѕ׌_ČiǝYk% 䐻'Pk`zG}gyaӻܢ:ou\ۓ5 ww0,m;qZ+%&.F81w]5fc9T7eZ2*[YisfD (7~#Q)4SdDcmKcyxqcI~'3)h<8R:YM#'Ih\^~j^ѓ\ %5յٻ#{%M9s-N8qb>`}[s>(YSۋ:khXӅZgx"o4ڢ@巉7v}l.7vl'e޴Nj4֏8%.IMK*BԮ15/ɱ+ }dI?!~ZpD.Li1. 35dpFD?/W>aYѣ c*B^b:Vom_pn V{}e<^2~#OܩFM>.^®0sl;N ҏ-zK"YJljF;x>/xme1KfU~vLՕ}& yH0rM2z[f`_ OAir6ePû2eRqm1?mu3fQ0H}[{tULn߷Z5Z.uKꉼ>l<9O\iֻnf)f7fxO+}?V꤁VK @j{0 wLǾ tX{W/C$x3W(1=f!m.u&R a4ϱ @EAF򌙇L\?[x@M' /cdے;¤)&2.>ns US9WљzM-INl"T~oUI[>mN>/N.˝BfO8{9G5S?vH9u:]P*2?¾g|5#TC+ߍEԻ7_ҿb%RQE{c`s+TyS,gǦ-x^F.8H〦͟Dȹ@_JIm{_I*8K gx‚E;@5Q'xSQPv17:)Y_ϑDӹ5}|^ Kx ptwj /h`d q;S* ?Mk R_GkAlMem~@+B36_QkBѬζԋF0gT&LO?s5S^G*UUYyeB5?Kw ƈ%P =zU/0"!.gVł8LHU;J٩YĠVs@% ѶAE!! n&bJ>a6G)_HD&d*teeq%*A$]6$N_׭@xen![={1\aQ5+H;TIɌrFa^矡B!2Q%`٤`m4Gb!T!\6[YhI]gc|kAzg#vfw[ޓ'Xg1Xs Ovh7YV2%Q剆|y3/ʔe 5iݼv1$mV~-h3^|ZEBs@(=>멜t7KGI[1ᄈ&~*$KSn.Fcc[Sd{a唺o?t-X/op;+SnVhFVoKBR;12{TuvS 2\٘!{#]^2?*T6f2 +iDu|eL™?LyRwcsm_5yq endstream endobj 268 0 obj << /Length1 2237 /Length2 16866 /Length3 0 /Length 18201 /Filter /FlateDecode >> stream xڌP\ N qww%84!hpwww';<ιrrz{s9nRo@Qk+ZF:.# T9 ڊ !;ÇLXP h`d0q1s108chms25$pB6v&y00rrڙYdL ,@ Ac`EOLgiOgmgGIp6u0(vN@C_-d,ndbj/!05Z8Z9տe@79F:_Lv30ѳr52Zrt.4=+ÿ ,?L-? .] *(ؙ8ٛZ#_a>h2Z9UwW_m:+[:%m!Gf t200p0q _ \m+ncm0hijss*12 M @cS+Fog1~>}0Ck+ >bz!5iI1Y_ׯ.wZfV-+q[MQ&>O#N  %3Z3@k22||1^]_Q_V$ha_?z=KS [|̳nXl5UkeW+#VsNB/ 𛩃ɿf? {Ë>Vn8U߼"Vֆ +@Nc>+cW .8ѣ'ec %Ћ3%A:"?@bЫq~ ^ ́?r5FU|a_'_? ?O6higoR ŇOl?~oGeJa^CQ?_WoQZAǛ 99ZAhij`mG(ֿlNo[A2~OڏwpCQ Kяm   ̪Z*iwǙXn`TwDpxs;g7Ў հ̵=ùk[!i<&x::4t o)il/wgxLΡO#áq88ʿV NϴK_ =|Lab_*5L;:BI;yIJw0M-CwKo?O̝.3y%~)`(>ޗ.Ct+E|KC9l1Q)ύD WwVt$tT}btrH*z7ky)ؑp(SmA2"-tV&s[{I . Tr=&F8M0F[Apz 2{UGuBzC3l~d{:\l %MOߦJ{,gۣNM6mk฽THPMz\5j_9em@(PR3u&Q][tKPscZCDrY-ʢ|,1 UI)3[c.hȸ'ZWNu+Avێݞ*1Bh#:}O-b E';Y3DR_rЖ~'$5ek.3O1{X>A`2hPΪ9}R<hUk)O oV0w/hd}~M[D~ϛ)Pp&eX(Sd4n/Nd]y>2ۓBF(a.D<K^&ea KeQgKVܱwjui2 *{D$Ht gQ bK0]&e8qlIaxoH_!øH2  ĘgFqېD+׏in G9t=jBQkaljeCVңd3ӗ[0â H$)E/ۢ:C 5{1Am}$)(vvrDbdh,i!PfWeOObE&SVvZs.5Ġf}$vz: &U6r . "XSFLtSrd7~ r5 S] mjf 9@rEP]bo/M3?%5ԳrE+35܂¢FQ_k ;aUG/vj!(#asxlFbX }X?_cu4q-lKQ?,4YPiLz6P< _yx2eFB.=nS=˭9aL6b׸"' {rV|h)[ ǞkߖG$DLV [|@mrۑ3幈I/ethatC$:Q 2^'"W3q1Sv[赓 U"|B͕tiO`vLTlXWׅ&7d.>Ҭ3A`'F ଚ15H?ի3v+._ƝI"]Ka^MIm/X( BVrH׽rrf2k@y.m7VB3^Nws 5~\Iz54~_4qq8ڤ]X^؆#6VP;|އS>nY/!hr~_ӌ0 c\ybBJ@:ʱhV3fDDV wa߲:R?^f!'C>BcjDzYÚrPn귯+`d~+6邷&TMEUʞT;JTeBU91H|j"%zW7Nsiח* ,ӣQڅ/2>-[߱#2yS2ZFj{.ZM{V|O+ÍSJctztzAke%oBƼˍV)EĂ"xӬ]űѵH>7bv=~$sY{_;}m&\fMaӄw 9,N+=,l#A4 d};D-簪0ԤdBΡ}a݅fk y^9ܸ(PdC i|n5DW);Y=)'<)\{*#XB3ꍶ2IJ[Sj},dQSg12a<\ahIpi+x>$+M"-ve!۬F>ӣEY(kK7&,U=!Qow,֏:('[yN3ב(%Ccʬߛt໦(oPÛO~\﯍3( `؞#se  ;V +w!6nEC۫wi;| [fn2 +q6Vk[<׷Nͳqk'F DbߍP+j0Mag{z2=gRԘLk%FF~Q(]DpVaAΑ0T zՅyi!a-Θp)kɀO o9!GƵ>F=5-iRdS`4< [?i~>OvDBBW2& dW8N,o ׷^^*)7Ǥg;<ͮܟ =nzÁos\St~*Cw"0N7/oMS 5|} BYߕv%A霆DhllYc&7:VzCC숼hbo1s3tXGWiP~- '!A~d ,WN>cA#dƑ\,aAA'~YXs{^ 'P0!6R߅5|ddnИiHO*mOʂ*9ԫ q$žqb/@^#i~)5Jx]CqኄSTk }K[&ed[ uסw{{.͓b#{PjֲR s } b #7= yŭΣ. ;^'d 4E14zrwשqG|V*>ph٭!Z ϥt*9 `z:<54UNBgk}K/\},diM!͵?<{ 48DvmV:Y$XPMgG+Xp2v/]WNy)fC vJAT,XEd{oaުH`LO({tA*^:gKOC.⬁=gWvͺԇ8P bn$=KU)"JOkn8c!$|+v(~_@MV]o!`5z3-J/,YVC/XѸzwasȦ֥cK1?D;:8SԿ,كЫkG淐ZhD׬]u^e\ŕ W( fF|: 'RMC]2p?{! ݬ"{O4$sWm'w'K+2^ܑs[UI0QBK4\N3kdvY!z%czKm?.ifZ<+h鍉?G)I>_}V0!d;]>,pb?( C~An\r@>C5>j ɂՌX1h";9B@J̖=L-btm I >&.=dJV'ŝT]4(Gw}&|̎@@M᮸_DfFlϦgZF/\3+ƈзp _>xŘT5}W8~{8HVw+T- L֯*CDT~y3 CI kT/1y߂„Z2)gEPW~RT  [K|c?8w%ޡ_(曑(v]  !…uPa[T("OfS}RqWk?38Yyz o~L :ѣ=eĤ]ܥ\GBɸu-xݖHϐ3KU8S ;ި|HGK˜Bks`_.qC&*484dL~X܋٨edmgp|qMCZ]헔ΗގfT쌧2:$j/v_/46c=u͊=em&JV,­w~0KfսNlg7L$@#!MJwݖ:%#LоU;_ Pg5G_;~dA<=c$,Ƿ"%t6spij5cHvX"KUb8/x?rӟ 82%|3uڨ6FZYN+߻?".ٝ~φ͝L(:ƖK%r)By^:+|F*w5e^`\ =#L^6 AZӽ @2ot7c)aK*6&  #'_:5RcW4Z":ǣwԠT930D [Q𕼞l ?N6o1# I?ڕ>ؚE(FgpJ ".Kx!z/ ɟɐK|{⚦_hYRE Q$ԟ̭\(Xu>EY8a2~g88k -rk qhb(5_YnV8.ɒ8&5곒y}󴦳A>ٌ [i&gv>'ڤd&՝`=pJ#ej!wƎ*KoӠBb{%:Nqn5ig,5D:XvWAFFXU%0!I5_l 9e;'H!Sʼndt05́?®ۈunu?W5*-CzmW?<⤐kQy ;XA8ѫN ijD0ֈTHQw3,:  P ~5ʪ] ^ %"&0s꠷٪,Sg了Aa%mx^ -g&bXvWKH]󆿣I amyή!9g#Ҿ>ϵznpCc1f0M= ›7mqEO$xatnh{*> Şwn'f^)ux]%:ٯơE*}$l8uYcmĶe2-xu*ċ:+ZFHXb=Rxr|; BwU˲(SEt.!OI9~= ?W9_:MOȧFU?a/8=\+Sz,I^XHv :L$H':5(P&Kjtqj ňE-݌(N CڰXfcsM@$0NMlDWtCAs sÿ"aFXu-34FX,CJ)z0rr.&ܽτY?-w2&Q udqzhC|~4g"Sf> EAyͤho3`몿7,ɓKAnƱXTWHi~%J&8Y03gw<) ܎Y2-7w7SB*5뭚A /IE"4t0%' Җ响VnQ4 2_"Zfڢ:YfՊ2qA,Ǿ8jZ6jM!rǙDsjBpV܉ cS$p"ỲyyR\- - K#J4aV(;k<~,y$Bg 7Y2]2q~KZ}p6s!9ٸz54_LOm|*\96t~bݍ AP^`g)AbYHQ2Ppt^ȜhZzIyrVnL6R< 6v^V`/-yg!% [JI@;w'{^sW^Rj'.5tJw-[4sQt>W]t|SJ(FHtAMm1@2)N0W w^O zQ콍PB"LDaFp~vȂ~um^S|GF3Hh_j pA&Hr;ulUKZ)Ɇ7'g]2֯*Y @/j*'[b `|g=/$}\ B2JXI,W1^wz 94>"{fs;񼴕\"T;].,1qXp.҄@U0Ņr+JO^6]F@ƣ>tY6!w,}qSaӁI HVOM&¡AQ7X,/." `bЩ͞*rw:\б&32ntM̏Vm"{qѳM6סGT oD*D24r֙w ی>}lĒ//m/5ʠ]%: gA½TGnր|NԾ .pQIOJbJ; N=10S'M5sL_0G^~^ZEF~]4[BqF\񔞹:s۾Me1cVpmR:Q[nsΣz/)9ĹDR_MFhzYҳXG#\oD~x}Q״#ƣKW@!@1|u_b(0T6!dLcI KȘ|,0 =}7V}+468i:bB~~T[{Q2yL:`oF6hW4N{;u06J!KWM_'ӕw6{8nSq^.ou3vƈ!jlKՇʋ/dBFR[<`|aY+wCGJ~&+o:ZoM OwJI6EQбy+R|_=UM=uPp*-Fp9>o91\,*i%2KO+gnuwF'ɆEfnAO@\B֗د-acҍ0J]XsŹC{D%+7U9F`O<ːcO*cD@1|$Hl*whҬ .| =L?`_lE0bD! MF)~o!&rQU yzVSJ4{2Q\3&mZqT,ΓLԕc/5|iJ4thԒ'L 5fx^؞}'`]h0^}E{GVXjLBl 9&>j۠w5p_dYK$ %E <G=%gNQCɐ n%VvKH  wYIO*96 G8#gN1k?))JqP &y oA\~qlF'ߍ>a:.=n$%&T&tp-!'Yw2o`Tn >/ ]Iy|h7pdA)C-N4sr%Rȷl+a+t0p8zGDn,Ag3[VNTllK-go>q^Н^$4udL lBtx]U&]۝mQ | މy^Ck?o;;Ð[,v>Ds'bNuQ^9kabSqҚ!xN샫#wD'(?*"\G4%YZD 5&K`q'SbJ+]9RW!ÂmDݔ=flIsIEuZ@SATQ\ZǬsh)F"ȱ6+I9 곝ykp0xu>JE7hv;h6,NGVoWphĸ}('n߉YT@0i8rR=CfLސt5LˬcljrrC*Q\oGߌe=暀?ղU ɭfD#c dp|Id;~d RWS󎄬 6E?[PQ1/ECuT0U9 M}`NJ_H $~p],t~ P!j(-m[,Vq]fg;WTpӔ<1("{ [BEr PsB¯Ҹe G(QA3|KZe^W~gt|sޭb9V(3J)^2{NO%4U/i03"_*ԂFNyz}g2KO)(Ey53];ĺX7 .=~mC+mX|xƧ& 2KbcՉˇwIoS^wXSJa+a`L[4y32jE?Y˄h×efL31;ŅSL5tw"t[yWӛh/%D|9AzhHgT:`ug⌵8WL}} ||NZ3Zb_Tm(C30C|RV2K lۂlO:LV /,EW;4s'4cZ|ؽsYCtb(t1x4[QdůFg9HutPlX7օ׆z~$aC⎹~fuaUqma]_A/ΒBLv{YA>{ ?,7U*AZG'p0,5Ca~{y_j옉_h#Z2\撡hs8&]θO\{u{7/|g3Y:Q?V[a6R~Bsδ}QX9bYnL:*=Pex'Ƕ\~uO@>`/7(6\c3z>*&#jtBk(| 3Ep9Z'sb&^zT<%ITq;㟶"qfrf_>۴o0P o#b7e'rReqJFt5~%'JŇU1K:Tk Msh#mӾ{η@%c /׹ԣ i8}ўZ g0'ŧ<܀ߠO u?FyI8IL0y1C2urm_i&=R oq`iF1JT`\mW,~3M +KBc&-lV-"Kliv6`8#ߙ]qgvi܃V t %JKttWy}40" )u'(O~VRQ<^Z˝Si]n &gr*V)]72xBk8H"a*x=Wz3ɐ֭ ( rjO\Zn Ot+G gɽm#HkhQYWO45UD{D6\@|5cTF0Z{Ž~ZWܢw'J56N[1~7P B;aܝB@᪉J4ոn`WD5O_(ь75pK8kx)a 5js'|e/=N~\?zވ75(Zi5la$y ><%X^njb \${3V8m+x4e!RF/?ST^_lZFU0'(B*/ܿ\`u>ӟ-qT[6OaH)3rD"*iQ)͸ƱњoH9G5`֊\U@GB;|_>QpwuoVU5wW|dEGW$IQ{7qޓ]&VHV,63D֌h{j¬ ǂщȤX^*+|ݯ!P+ 8Ң?V][(TE<_*5@m@!F ,3 泥m2J\bN<7< UF 7ϬǯsZfOs@CvJo{n}yXd~<o>68}-Z!M"QZXqkh_mL9Ҟ6ET^ȝbtZbؠD_:<&Y6ͭqX^أ{v 92'AQn; oa_"9>j۸Kphz=t )gf0 tЇ1t[HMBO9U(h}93cm~:W-)4iMtkʋ5}mhu& I91`i.+F-d 'Nk(̍h SڊR): r\#p!Ea̴_t/fRVB~_Go~1u!P..}-m7jf2u Ԭ!턚SGzNmJIRhg#X(ퟤiu8qs]ԔfC*/8?N?gmCf̞!z>:'"᧏fҠdUdS%ɀh. яPқRGSPuQE-`` Ss R@IU&{3EӺtRv@p#]ξYՃn@oU1~ckOp$zRfƮ<|/nK ųMz֬B1:> נ FOak\6n U˼a#PFFXuKxvSĜZ~@UϦY^mYf5 h9H*,TAH CS82dlqbwr@?t XqJLHhkH;Ԑ>i/VcȌ [X5Gٕ?9#7X('cS.3lsw.ܟM6`oKǓY.͢G64-Z2y%.IH7CP\tX A[C+-݀4:*=!cx%|?!e3yi@'R[Yy[-[&Ar!a#L+fQ(  64jk6%:*VHC,~5lSwh3ٚbC<ނ&̍5/r뀇}UMLhKh ϲRX FHH}>B%)-,++*b Lk2b5%:#N y0ϙ:Z8Oj\|fTұ]9l;c{lT茤^iNB0J.!E+%a֙\I)XM}OkBMV9M=5 *_Xժ6_r0O# @Y쳖vŅwf]0[hWmڎl\lX_d!h. cDVz~#ec`:\g!EZuhDqCF, _+h:&x%g5{M; s&C(hq:Qmy:Vmcp砐_K)ț\Qc깞B%oY91:u| b %[B gke'Vdk9 |!KvahaM->mQ|h*԰1~ƁPzZkA7 =|<ҝ_LJT;oMmKY\%!~<'Һ e/G#놄XeTPH.@Y/tϣ} pM mIgY"r-x%薑,& !&l$ڙ7bK Z?&0 2+: &'(@leLŭ0}ku%\0:wv/$hkP!) ,C;cbX@֑U%w@D/CYͰ(T]q 8>-I~`QWZ4sYr65 a(2U!m'Rφ4-? ţ`3VgauW>%-k5vHAD ߀Ȝb"&^f)0[(Aj7O$7◭R Y5K]fXUYEJpa-}!6?H.Q@.s.?|Fux ?q0TIZ;0Q٘O5(J|ՎIab{L:]ү4< QԬh0hFNRhxKK6mw:"aW3tIw;ʛUeGElG`݁ =ۢgƝqrpVWF#rm[zӭ]>2alL~R/O$ϲyh|bu oIGN\t ھu+`Tv~NS&#%X{DQ!Ҙ6n'uΜb~D]|J?J4 Tb82%npyo HH!ȄJKWg@hU oXByT&iڰ@'*.#-ݣIJ:yȿe5U8\ #d'mWg)ʢ3Ï`K$mnfTw.p˭TY0 M‚|oE̹GkФb~ tfswڊI9*9'CS`u mR VVoGg@tp_~BO܏Dg:u,ў~]n5c1U"nx;<Q`r]p BİaλRڠbLX奠…"0ս+f~E58I"mDf-.Z1j'pxbXe82U[YyZ1ƊާqF7+<_j?Rm4JO<~k SX3~zyRS%S _FL zdA ˌgr'Jc9P(A(1AV6Wpgw22gSsS3IH_y όwI$Wȸ 55 TCyw0<飺IA rh\? ise4A $ 6F@,!ON"Mks{c9{0rfm/{5v5n UYlOY`1@H9pcHt; > stream xڌP c@pwCp64hpw 79ܓszVw^-{P*2%lXyb jj,ff6FffV 55r Ζ_b@#gLl`g uX8yYx<5sL Y;[#Mh,<<\A&F#g 85@tLLnnnF6Nv47@tt~S(ƈ@P9Gjgf )P(mc,z0ӿl:ldbbgcod5%IyFgwgzoC#k';y#W#1ԍ"F`s2q;;1:sd\f [S1;A@p=n7 S{&u[ PFo `fffc@w <)Y~|f`@pvtx[` 2qA@`pA]f>xLl=b&Y 1mI )sx1Xl\NNz%U6ۿؚxC\p{.^FPO3@g9MX?_GMo/3tKO o 487CTuV\lV!"$ r*M,d Tso ,G^9+n_* x7c9:y 0狕QS_ `bs~$[ `Lb7I0IL Ib0IAl&?OS p<78ST vshx/lL@ ?rVο kS?rvb𠁜86QOc#?j0ScG#+ 3s#gGG.?K'otW8NW D,+l f`.@N&vNrAp7`Ny 6qqg| t ,ٙ[U1 LSh0x-:~wy@DSx#iue[Zx먹.%CVI#>"xB5]go+fYnd<;^)ھйrJ0ĨGP%uf zK~2s}3=J"@sKg5~sS'9.5~,μWqafF>^]ytfkEQrZDUC{#y\:377I<^0pG:S88EEkk ]a]-x-FU0LX«]Njˉci]we.pQP1 2(1+yZ!ht$՗.v_OrGuҸ==' e8I,MNtA!G'qe U޽]6j<SۻXhޜHq_(fFs_Sc&a5f466NM~AnX_$6Wݑqʜw7H?aSPp-u˳(E/+%UJj#U:_Q}.%IZԯz63ݥ1>X]V=I)0}I^2GCsӞ3et=gy<&giD~v7-nhZqݦi{W"sTxq[x7p^g>Cv Iƻ"*h,J/Ƽg^ճ2uKClr2ء_ոDV#bW㣥@Z_|j`Zik]K̻s /NjʴnFJr?|ag6Ne?w=Frޓe3k䏡ᔥ,!&E"(rĐToh32 ;oYc N-(@¯[h4xS#jL+շ,?W󄑦qXzk$ TR>|] gE EbvڙT!\Wly8Bx@ȸ~+ J=Pe#\Oֲu, ~ b>q~XVdGS oO$ܒèËb3cG~15WIl[ً*0[bd`ubsׇV_tn:%&+T0+էPdH%)ɴLǻ >լeAaLl0\C65dleWJo **b_` *9y_l   'QkRCAI"18&~à[}.ޣD/ th]x(1<D20$T>Mk@N EnkJ0-KbCYWa+RMUYS/{C|[+yO"ͭ6AuQibXayVO5Ϗ?HRGۜz~$CwBj:sZ _ J`ࢩv 7, `dl#?о%^m̯ב`ʴYwo"r;3+=QC0<& ƕe;uK1`nI<Ͱ ߉Yly西RdeAeX{쾕eC2MSePLXM1$ݎ竨\[s'zH26 F37DWԏMz 0lQ&Y3 5^_5VK]`x^PعТT* 牗X.!WbT+9|!x~N4CtxNVSA4+fCJ]ʓa2ef jdfd0B"D^wŬ0B4ܔXLFfA7)I8-Ψ }QZ̐Y9ɱ}4Y,w@[\{@ȪZ^xˇ}fK zbm1fƤX5wQA +hVxE>lP(sRͶh<ʲė3=iDMXJwqXR! MTl=BS̃#U;1M1"%Cc`NkOxa >x{I2:c!!,z^RGAH,o pwOC i ˯zqyDbv|Bw?))Sf~iinE:-#5/BYY!c$T*ECG 7AOw%/1}-NoIj+bOJ|[MvH^f ȩw}>AQΦNyؙb& ERc~ M_C(2Btm}c'OAޝ #MtAv\:gBuYbˇ$p,HbFl& j__(?';bɺ~V!\d6tY} ' /8hf { ֛u U%?|LΑ,VeeGw]:8M S¬FjM]Zʯ R mLNgX,B uBd}E ڛL'W79KMЮPݹ?2E/1+xt5jAk/97jՇd}eG%f. &xOS1\w$3$\SswӝuK <𚏌NX)X@`έ+$ؖ.' FR jR)%JX|̔/ Qp@)U>~u̞K* 6\o.k8\)$6~m!\i_PM%oYq:t'f\6웁-R#/],f|.T65V[S>pRZ~Hx7lT'w8A3*(r +1-(,q%ޛ~U3X]JTXCO83T|D/!,؀Ьa?*_F:=o7\dj?S>$ُ[fb%ZhQ]O3(t@០>!.ȍ1hGxT:252/bgGWG eзf){فALUS'Bb0#hӷOߊ()[o5 w 6 ÝǕ3GnԼhލS .( aNN{=y?K֪FZZO6R4 @wlcOƻ7m/MJs:lb5(^ʖ^2f&ml3$+{U;:Fv:[QJkӷŗӮR6Hji0K>jjFiePfX3م3/Z霓YrYiD搽֋ζMrʊ=i?ΫҒY+,cX`B}wWKȼcM4߇Z< *xE-! ҋtأ/ "SDy[%ғba %Z@ (:%Lv~!x7ta!ԝ"Eσ xhgIfф[P%N,r@IUdہ$sLJ< QΑ/DEs۟oB4*Y J4r_ɇ53F,%Z J-Ӂ#؛! X'$ ;֌#*!/wbH nhHk)O >RY8B4&+o~drmʽ#k 9ĸewM<]? *4Ƭ_Jv`Njs,_+(d;OOܾo#a#XTGFrPxW&Ӏ6$*=;zܯ%Wir&.3;؟G1h-!6b//xgX<0 ,1Mk*Ӡ4r?"FÆȅlRʋHfAA9*V %cQwqƀC>yM MA{6Y%},)eLtjDyz m($]q9֊iτK2tc`kƞGs+^U̟ٵA?rB}qOgQsm[ CIpc4 Ae/+2oGਖ਼t{ !9g5Ģ"! o">Gh~ (q8F$b W6piܑ\ jel')k;lD6kNtɖ5㝠@$v^FP 0g'3 S3S2"%J E!N5!r,io3ɨoB1ְzsyvVBfrױ&)dNR6_{,j7f׿|{xSM%kbYVhƊX&&ϧ:J=X+"#1f8;0pC#k+rcbr盲xC.JeǷ+MأsWa .R'W!xFapȲ҇=&Kr5)s?fW](&6j gF*}9T ?b=5i lQ tv{+IF"΋e9T$2m]'\Rwi$mqy"wtx Y0-ϕDS^k~:+a,1 *LR0|EXymoXJZOUӁK8Yswdj2ěm#׈9E5=*̿Vi-ѧ5`WBQy,vQujj͡/b $pV+A1iF[)ذ]'گ$ ɶqZ&%OBR򊴺Af(eS?&m^̘סX[j`g{C1 w5]Lt*#V0cuV{dyȀcލ^fsT?dOqˇ5T{po5 SI%8c鉪I {@ 51Ø w.Auß.AV' 'C2jg5Pe;t〷OI&v !U8su%7?ؽ}R1uAu90W̷0xtdHFJDH N-c؆@3&2}a(Ra\z9=DQlkLt{_%snN]L:U|C@vMt:7]Taҽ^==FƸf"ܗ)}@b/PY>cw%a1K+Έ׵]$gI0Pi]+!0X]b#"MyleBP>w.B]=3?PQWϰ6[Ns O]y\,: 1#rKhWQGF(KCX2R%)Z{Vvg赿zwVǞ@mQp_dp*ũG dB@~Cv;߈{JQU2%OWZ. +'̱%Ljޭ8OQR;fBgyR LC8i*MFX|z 8S[Rc$gJ w:ˉ**rRzat;/Mtrro%ʧi뱑Z~/v׉F3 Sӗ.ƚRܔ#vk}{kSIXNd9%T5+?^\AQ }d E;+=sUd\`kmRi0hkd3 $n?˴#>: v\A GHxMxH+dW HexXxi/US̯Sr͑Yl/~mc&U9,^'b+MiŸL>6]\dby]ZWNc_R th樄 WNSAvRSYh6s^ fvt%NҎ@)҇^UnXF|yDT3[s[qщO ׾ ۟"E=D)1i 3D.V$)cDEU[fBHkI̜,?HgoK.t.GTVYKF%A kF+7ѯJq`໖8DW%S8XˢI}JÔޗI"KFSbY_H9Omݢc8ҙrI"Wei)&?(͍rGa|=y@ 3(c=BnLYv3gdCL]u.!,O J<1VU3,]ZyINU]wqDN6U,XӔ3:1IƯ5hD gu`& X;ڃK( W۹bʨaɺv@Wb+|Su[0Lյ*K.9rx38=)y-#ccKp`GƯS++3n+1wg1~&PkW Wٍp:yۼST<yOM^:p$;plIo 5 6BV:jpT^{'=&'kF_7Bۭ[߫6<+aµ%>W] @t~4LJ8MU~~-܃j FGy0/G1~ g0v9&dxK'Vfk$?4;86+G7Ay S'r:u79Hvxv@=wR]]8u[kg/B dHŦ xw=I=>{\86ѕSgz8.J9[|Q-k̎7g˒J~e/-)pN0j hHl#zy8sn=_@n00 <'ZvM eE'"m|g{zE; js=sO##Z ^ ̐Y(SN+D)bLdu}KHfnywrJ}M m|@9&r{ /R;ea4Ps^~b%4NA;M2?,yS^YCTP]*$uE{36箾+en};O$W% NTy?$`HFQsSFzaK#Ctj^1 C1 w&^{fٲO~:hKjGā8)ݭZ_d/Z)H n&*itLWWqKd)FFRй}:x$k:$r%{5@d__p!ىtqWA?0 }%I"*3=8pU#ۖ@i F8$]>b._ou5:Bs1;$D[+>> v/]w>~필$ECq"ԟǜ, PB{[EV鿈g%Wu|c;tFf7#T|>ܞgX .WGٱmL=I; -L %K ¥kXI`+s2x]ix9~pd@?"_F Kl*9qq<jУ% "m OΧh!%g *E[# >j<-YRZr NWhwj6`a"bXf^!?w揟Olg-RUVUFfv{Fv HFTmowE*)N-DD+ /Vͬ'?*x朱Si=v'fpg- Ōʗg:ZV7LXgC?)< s0r'6?>i H'ɎWѢb#N3@j'.Q{0Od:5 VL}˗~B:8g)68IRl>=̀ւ]#EIX_> 6HϿJ|KJ?E34U ӸQ!d`۳ue#Z a[,7\"AT"w LzhK&Om5r0N &>I/* ?hngbGx^pϳsFC?]r ),xVI|HdxKXc fz] *m؁yzO2؇GddZۦHH~o1EDR* 8 EQ4jU=a]prFe}͋p߰tY_)q^ZAMK/o.,E|'H'KV\F@Mv+ďjW.N_Ƅ(8BNk4Y-8̊SLbDVDLOnlGA!Vп%:y"0a7o!غ0a, k<a% E:ECRoiCtKׁ)t)G7,9xW4 :t ]g{h2.g$tSmx޻ϑy {2-eBOmFRĩPXnu']ϛ.~P<8~+ȵ(ط$0RT¾{E 8/]R8exaU.rŴHxwvP4~ +$ڒ24qO|> ,Z ZI<G1`:Z(S |iiMA*I x<.zn)y]{%ސ]τfě a)k%iWClA^j _ ovP\f <6Ȼ_\(s\%+1m"'A;ni*z9[jK3G m7)# gV7.@$NeIss9 L_47R3Ga(U~d56qL.ӯ7,ݛ{೬'W7jmqǁⰞG@f5o 7B\9w$D~~p0|ZuiWq}+0Lb'DavG[EPOa=d9ޖ"^y 8]\Fgk^$7]CǞԂűDž=h?vTm7RtN~Mg;4ĬUk%0a/a fLMvzy\01*[o`Ml01$&)싍-NDE/fw"\1DcyD o{le_mmqoY< t!a)WadԈ`ܾ1ɤ8jkCr{jH=N@a IҞM4XTSUE/Ll |܈um*x]VS+Zw=·c<ƻ9 UM٥p/S/ e} mmZ\kڿ&rOj#'KP @2:I@ Y㖅pS-#ECKV+O/#mVQӯ>o3V+ņOx f4tuTTþ 'U^o R?m8|Ԑ9`=Fo_K++]`~tmb$e@]Q>ƷD^Rӏz}d8Z+!|]K7@=Wtՙ'6 .=P-bR泄ZTP{_ZJ})Ϲ%Ɓkm~ }5@E NԀ]]):1mяg`cQd/0Q;pc) UG4JTWa43Q >^5v E;/<r_k|Ѵ3| V@5s4>ᤂDC&F +2zc @Psi۽rCwdrꡟ8eu1B#jH7)t1B\Yմy}R!!. Yowp^a0!;eCIM9}v;ZII+" B@OW,=o_"x 4{Bёvҵb^U(;ھ.DA4irite2(s º1ab֝{go~$,_tk~} <3FmMMQ<š=藄Wj_#,qp%]ߡ3pLuыSmcv> v7aN3.\$Of,I0dSZhܣ)=&G{%-Aûc`^'ʉ3cUwQ 'yD|**\Ndbq eC*QF `8^^++`r)8lGoDnCgxʕoaBA,fh8w}eOt'qj9['kƓ ޥ`q}/с[W)rRQjq޵WuD539 EBfl}o(m#oF$,k}_D$,,r5[+5K$f$Gow3-rJZSVDeAHf.Ws RC+!{@j],I0'JG$^$I:6];M_3`Ws h_3D3˲KEev{>i:ZIFҀ$+`B8{; ta,껉ij ܻlvYt!#vx>k& 1헥a =U ~јcDp'W7fV>=sPArMͶ &&1-)x]_O#t3|6*=eJjlo/ZdG}x(l񷆌/NJ% ~>>H %?[LJOfu6cA|5}`…P\9ser4JԛTs; G6rUmTN Jz#U Tq3`WJK0x%b#ל)FxThE͐涐N+x= I3!epqhεqv> Mj2 OEluWhsQu'n1V;3lXK">b˰-y8 RˮrDӹG8z? ?4wdF <+(S!~6q1r19C3ChJƳWBV'lΦ<Si/eQU} ]ʒ8OB-!%'}`dʙMFuAqn˸i=,׽m\{~ ׿Ҍ/Fl[ѓ(kӠ'ﵴSPԄ o힃]*Zټ$m!3aH7FxڣeFbm5cMp{anV@M NƖǡ7b}bC&œhuvi\"ETs)4y?Z(Iڋ?d,Sa g=8tr$cYkgzh|No"dάEu92=Sa1@s!{̯(OQVGR6"z_Gays5WYz0nt6V΃|2EY}=$17GyGIZ{Je^ҽ@n1geKz;5eٓ.HrZ4b['42 N'p~z@$:1GfbU<4*/&VS33ZI-U1Vhi`w)(:$t(o+>nٕwW-xuRMsv@5+~vP40 VOr@q[&퟇[D @s30lǧmqV9G) qY<4&ׯ|כv؋FD* AJ]1`h* IpX3ޡX3iub15FkЕu3j졦)$mY[vbNtje{`(J_+h(UPq 65N|<@c.{b뇓i}%/''ͧʛ#oE螈yo cF(XlN=h,*ۗgĵ[=?;JyɡYyO# eVy;nn֠۫,;'s|<=/1w3 ⏢鶿: Fk4on'Xe*x_RsƞjęLJi4hޠd/$%zfh\t^8땒%޴9wpdjz_dk_J a6Aw\7ylJFr_GOn`˂ dBatN.uPE VX SUÒ 0Kp+ 0δ4ِ\lݶqY6HѼJePpTEG@ K,=:s\q>l¡NKMf ¦A<=_T'8= VR  w>ʟZ| gZx#˲p,}mڠ=hB YT?)w}%έcorW?^9pR̓QH\aN8Xr9HEɄb:xee؉k>dcmʚ]Fmj:&j7Ptv2&գ>ü>h? '̖ ($f|F ͛>{9Iȥ^ [ 埔1imw S ES"pVETpCL⥴=rUpKGȲFf/.ن&>C V~qOh2],Gl"!>3*0IcD瘄lf,lh`?H.^Mq$rYZ+PQ6,fx]_Y{b;yu^ZlP?j~]T\fO~E*mO2m'\^hk[)GІsCrx?/.0IaSΫP1?)KGNf=: Gs`~ޭ2ablcƍt<ݗa=oGyәʸ_|9"ֽf]=dag5o{ KFu* F``c7.Pk09gi?5:Zuˡ1>|M %6 uB*80Lb} yN:hn֮nʲD7Z= }jlI |ڷ+ G2=C#lС~*Y_Ev@Cs+GԛiPMq+4 Is{ *_pYRVS+׶%1lQD>l{kEP"VX08uۅ~tZpO*E/̘a[|Z9ډaN`B>ӝn'.rں +X5j{Xm$5udhshVb+6K7m[wTL?ij̘MaL =yrgA;{f [8LqxM-ˮ u[-4 D,[/&xeB6z)J_ uٌNȰ-}Pns䰽*ʆ84+=tQˠIZBܥYobsY3=oȲ?Psy%XR6Xnm] 2-pawl7M2Lˆy/j8!/$rX-ïz7iP4a׮L=7zVg/[o[bbё _GŬIFd$nd-E(Kn[)*e~T:uy TOB^1ৰsm/*{SG:Y짙z"O3ol=+gЪn?P_y hJ#<>t=d.lR snw%f2̸E o_'8l 7/{Ig8XJ>ʯwکISuolzmovF"=A=ׄLJq&(mGhcf%']OP(-kWvL0T|$H\ymڧ+ȭ.BT})Cq17ޯ<|!Ph"e+<s<5D[d_, WW<\06#Is&w9l/:M#$BFӊU5jų WJa3 \mp |o2~ Gv]VSyҗoJdSD9{jJoKDsbhR]+ $2\EvʎEi&!TseqmF0aE%}1(hKD7#[{%燍zz᱘fvPmw/1[Y.uCur۷i&2Sb-7jm矕QT{uޝ{0 AG/L:~HviKOn.uoP$m8T%Җ'0s aZ+ qvOu+JiQ((D? TNgS(=b%6k,wL> stream xڍT 8I$Kk Ւ[M7c杙7clb$JhQDC%my=|9|Ϋ$ēޠ9AbQ=0 C()@͏Pd!]' $p`)mtKV[Gp7 !`tP2a  Ut "8TH$g9AP1r8~zht@@F1X}@ġN d$`2`GWJ b 83Ȝ ` "t6¥@w-m{?l^Ea[^.W D"׏@ @ :iHp>0``Dam#z |ft s؈B,{zu>tF=E$2 J\t?|ha0 d` ^nnCh 4P 68,.sW $A DGAW? <0fXa$2b~sU߃ƌ@ 8 M@ hjVZ=G=K:~7PY]Uv X C- ~`XI\?'2h+q'BUf. [C_$A\G-9xCt EBls($9@"uE1WAtЁ7+a@x~hF'2H˫,!BihS](@f# ˮniA̓p~)L]jhO6欘P"rY,xWTf|Z@0$":D%) py Iq 71ȉ>wKWGIt^O~~yl.nĺKNHLT8= nSgNo\Qo1 _1::"w,SFM07w5] gKݗW3Ц4tLrJ8vD7\MiT\|DCɐų+Wq[ y.Nc{"(gQ6Y TnDE55=5T86ʲ qܵkF(6LTS;Q6 9;.^;05ydQe O{553Px kO5pp yB6SvˋhwAN`n:ܧVX}vWZe~P 7wlFn.gͼn萶\U٨*?f+_TJFsqFnWE_¬\j)9[4S=%~ !yf*G |n%F/3/OF5fy>'D;ʯl.]Pmb^nR7zR[l1j?at/W8@nWMFCDfr^8e&X[xɮ3A$Xɗ$IeiU`' rJi&ISTk^>ӽ'œ^oM]W>$nZ}t{QYRIx##=xWq݅kw슉=Xf-nmwfp#)Cvq嗴X%W\u,9B * žr4$[n{s|ڍkhr[O܌coY.Cpzs)ݔsǮPyp [|<(\''v񥦥ٟ^xW8g W (ԛd3d'yF"PaJ=JYe-SOyw'-ulҊӠr/_Li/>~B硑95͓C(pHQ9#Y~|]P4 A{&T+w#EY_"xci3I WSm;/?U?,IzCvyҋk2/i7U/WfV9E.hJ^ߜj櫥do Nvr!9L =bo2E#GX-]=33h7+ck>ݠF{ |fj|~VmS"S3ge'Lsb:d/&~F]&w@ Zި=xи]%*E.&> U }z`aΪN㉐*|$ӻO ] &2U=gNڝ(ָMZn'ob,T-%Q>[q[ϳ;9z=rxczʮٮuFY}/O_Lg>^IjUV-CGGD\wrtgn'VgJ|E.7ZsB^|sƬLZhZGԥEUzƏL)3'PUh|vnSw|LO,+|ǚRf%0Z]i_b>H\nɭ#{ endstream endobj 161 0 obj << /Type /ObjStm /N 100 /First 896 /Length 4301 /Filter /FlateDecode >> stream x[nI}WcfEcKd%om"KDd,LJ.nwV*++22ĚU%l%+\lNו1Be,n)*GAV>jVUp`dH耗 W*(~,-B)1+bDWfGTZ+&fU`*J[M4,.Q=-:>b ÕT*hK;4+Vib {Z='l2؃פPV9 wޏ2вa):P:5fo1c 6\ جS)lIEhEN"XP&m"ItW)ơ gE؊qԴ+Ik6)RU SƱȔpC[hT)CЉ۶I9? ĀT/aUW1x$#GVBi͞+I^2 'O g`''r @ AvH1~|{u]Gp'Ng~|Q}pRY<O..ě3>A%GZEΫTt_I%JVtzn8Ǘzpc%}+@-Y[ʸזO@ćCcAq0?o5Ln / l?<V~$Q3ѰsRCJ>\8ɕ*[[ mCK6;[lIlqKamX-[m4Ҧ5jpܚ:7H= /aÏ6qjzU>Oa*]1EOVA;vSsƧ Mn9Zg\iW޷6_}kmޅVоMZ؀3wtoK6BϠZy^YHPZHw@/(pk͜=ߥcK|KpOsnsXekWsԁFMĎ5ghZ $!h!%FR,Fc:Bp(25AЛ21bvU9ЉNk sDFHmZzz4l*tX9`RH;I2[IПw]c"%SJ[VVC-;SӶ`ͣVlq+B$7jLI~XȺ-g+,*|F&j!xY䷁iD.:uǭ|r|x$l4am#yEK%o <;5mL-żf\ȍmڂ߉ϔNH"Kq#6l=o_B/m:) f+8šVe7HD]>ЛṮy8qm۴gk5iH_̎;(әxh€sL Ny~YAS*+dJnS">͑&MT2m~U5h\P.OƊl9xB2M*I c+cT\4Z?gfμrsڄ/];]'9(w#. ̢פj ^c{w-zn <GYL*'gEECN* - x2|y7 AW{ YF.T/xUeLaa.+qXs *@!y'9_G Ow`ېqb/w#˵bti&k-͕MRH {aTrkT>}p-OI A1$WN#-K ,p|e-ν&5b{|ߴM?e|e|mE9ѱ\HtBN>I:)%:dGI9mMIE$=/#=(G`O ++Ӽ nwUi3aѪ<ԱGd]sLa9Y-y7c-pt¡O50@ς6tsٷ岁G>"udxIEUVԹ*Eüwi X멥,kHK "`6'LX|p|R7 +W$I4e.D)Ŀs/.i=QGVxޜ6߷a1#--eru[z,~~&ƽ< 3R<=ۿ*0LEw(&9WBQ~gޜ?p &*C_J?p@a!roqElqhӉc sst.3Taӣo"uQY>\H6JJ\E>aRבSz en?dk8OR[v G͑JEâ=hҔysb kln'g9f1? w3]O|U'sbo_+)C竇*^.};/'O%. {I<\ O&;J\{C<.#zY88x/LtDgDWԢtKq.'·ӑ'J P 7슑qqMrTbσ,Q[M }qcQo8 *~2mg 7 _gxu u /__Io諗1wNӧlUb:ڻLttm FK9|?<|OOO73,pJ- GsM#2)[[ǝ^/tְU3OLѸw1bq3vGoh!F 6͖Fv-: 5X&2 7(oϟ{L ل3 dr 3ʱ\8P8F@#FΗzTن6ųSCv_:U uWXr/eǟ]^cg}63*wseyJ}%>pHvJY/{76  6gϱFa9C.kV˄aX}DYAt#YmZtAtg˦/`6\|W0%"—;啣Ǐ_%q7Hìh:lLpYBɋW!ɦUQ_vryݲ$;ׇOO(|I􇺨q:p Q%++7g[ky-lP6AiһCX><vXl.팛I[c$WLtcV%J22c,e+;xr53>5.ĢX\*"PB\q{UlY6kh:;A?WJeE)./%Ѻ2emjb:bpTV[2ѣgP\A gFn9Ɯ Ő!.˧_>9Y?4=NE> endobj 274 0 obj << /Type /ObjStm /N 36 /First 294 /Length 1119 /Filter /FlateDecode >> stream xڭWn7}"زevyP-Ա i{hY@A/=pHqb#ï(W3 L4/F@᧙JS2e8DpTW @\0)ڂI0Ia@\Jps@h9 GytFȳ+UɐQbA11'K@ k "Z*qhFT`a !\(+ߗsׯ elUܞ3gV^,gU=~-A,v`j:W?>=>vCK.˄\oXg#pOT . 4rwOɉcd7]" ޝ}9د> ]vֲ˄Nr38!z{HSǓ닣@{)=%r`/g*NjW!r~^8<4EVzj-0xEhel8G$8#W988E8ܩMǹ5 `\OgW z )O'_d8]V{֕n; ] /Length 733 /Filter /FlateDecode >> stream x%IlNaϹW*GuPJjPT:oKkjš XU$"b!d!"DDbaaDlIv==3YbniM.g$^1)SzIy`jқGѫ7r:(WG/C9ҫ7r&Eo%ٔE:Jm.L+=zJ@)(`!bP ,5nVY-< f4qz+H8e c\QVԺ?ӃVz Mns V1Ki hq+T#F UԾ`'5vkCJ]ZintSZHz@[Wn-[ԠzY6X~0F/k 3MNd0!0 N־ 'H;Sn_L<}xFnsro!U%zns|@eL[Ublv9ّq{1wهJÿJ ̎r7״ӐV2o_U"uYp٫^ h n$Wd`buO Ghq/\ɽz@ml{EaX]W}֝{OLNmͬRɏFi4xO.]PzpyҰ'(xZD頧=J<34S2P ,` X <}<}@ endstream endobj startxref 248524 %%EOF bbmle/tests/0000755000176200001440000000000013175504420012476 5ustar liggesusersbbmle/tests/profbound.R0000644000176200001440000000126413175227270014627 0ustar liggesuserslibrary(bbmle) old_opt <- options(digits=3) x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) fit0 <- mle2(y~dpois(lambda=ymean),start=list(ymean=mean(y)),data=d, method="L-BFGS-B",lower=10) stopifnot(is.na(confint(fit0)[1])) fit1 <- mle2(y~dpois(lambda=exp(a+b*x)),start=list(a=0,b=2),data=d, method="L-BFGS-B",lower=-0.2) suppressWarnings(confint(fit1)) fit2 <- mle2(y~dpois(lambda=exp(a+b*x)),start=list(a=0,b=2),data=d, method="L-BFGS-B") pp <- profile(fit2,prof.lower=-0.2) stopifnot(min(subset(as.data.frame(pp),param=="b")$par.vals.b)==-0.2) ## note that b does go below -0.2 when profiling a ... options(old_opt) bbmle/tests/binomtest1.Rout0000644000176200001440000000663113013175522015442 0ustar liggesusers R version 2.11.1 (2010-05-31) Copyright (C) 2010 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. Natural language support but running in an English locale 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(bbmle) Loading required package: stats4 Loading required package: numDeriv > > funcresp <- + structure(list(Initial = as.integer(c(5, 5, 10, 10, 15, 15, 20, + 20, 30, 30, 50, 50, 75, 75, 100, 100)), Killed = as.integer(c(1, + 2, 5, 6, 10, 9, 7, 10, 11, 15, 5, 21, 32, 18, 25, 35))), .Names = c("Initial", + "Killed"), class = "data.frame", row.names = c("1", "2", "3", + "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", + "16")) > > attach(funcresp) > > binomNLL2 = function(p) { + a = p[1] + h = p[2] + ## cat(a,h,"\n") + p = a/(1+a*h*N) + -sum(dbinom(k,prob=p,size=N,log=TRUE)) + } > > N=0; k=0 > parnames(binomNLL2) = c("a","h") > m2a = mle2(binomNLL2,start=c(a=0.5,h=0.0125), + data=list(N=Initial,k=Killed)) > p1a = profile(m2a); p1a There were 50 or more warnings (use warnings() to see the first 50) Likelihood profile: $a z par.vals.a par.vals.h 1 -4.2047344 0.294898645 -0.002923466 2 -3.1552066 0.341179554 0.002586064 3 -2.2351038 0.387460464 0.007009828 4 -1.4145435 0.433741374 0.010694613 5 -0.6726261 0.480022283 0.013859302 6 0.0000000 0.526303193 0.016643616 7 0.6321738 0.572584102 0.019113307 8 1.2156051 0.618865012 0.021399150 9 1.7630606 0.665145921 0.023494921 10 2.2804928 0.711426831 0.025475099 11 2.7729144 0.757707740 0.027355948 12 3.2447726 0.803988650 0.029170757 13 3.7001523 0.850269559 0.030945274 $h z par.vals.a par.vals.h 1 -3.7637543 0.3268572493 -0.0024273676 2 -3.1748327 0.3542640536 0.0007511297 3 -2.5644438 0.3843760379 0.0039296269 4 -1.9359396 0.4170494900 0.0071081242 5 -1.2938745 0.4519556085 0.0102866214 6 -0.6437592 0.4886001613 0.0134651187 7 0.0000000 0.5263031926 0.0166436159 8 0.6563173 0.5646512092 0.0198221132 9 1.2951023 0.6028512247 0.0230006104 10 1.9201220 0.6405127788 0.0261791077 11 2.5281012 0.6773052997 0.0293576049 12 3.1168240 0.7130175259 0.0325361022 13 3.6849884 0.7475421634 0.0357145994 > c2a = confint(p1a); c2a 2.5 % 97.5 % a 0.402495803 0.68249529 h 0.006987227 0.02638541 > > binomNLL2b = function(p,N,k) { + a = p[1] + h = p[2] + ## cat(a,h,"\n") + p = a/(1+a*h*N) + -sum(dbinom(k,prob=p,size=N,log=TRUE)) + } > parnames(binomNLL2b) = c("a","h") > m2b = mle2(binomNLL2,start=c(a=0.5,h=0.0125), + data=list(N=Initial,k=Killed)) > c2b = confint(m2b) There were 50 or more warnings (use warnings() to see the first 50) > > N=Initial; k=Killed > m2c = mle2(binomNLL2,start=c(a=0.5,h=0.0125)) > c2c = confint(m2c); c2c There were 50 or more warnings (use warnings() to see the first 50) 2.5 % 97.5 % a 0.402495803 0.68249529 h 0.006987227 0.02638541 > > detach(funcresp) > > > proc.time() user system elapsed 4.572 0.048 4.676 bbmle/tests/test-relist1.R0000644000176200001440000000064213013175522015161 0ustar liggesuserslibrary(bbmle) set.seed(1001) f <- factor(rep(1:3,each=50)) kvals <- c(1,2,5) muvals <- c(10,2,5) y <- rnbinom(length(f),size=kvals[f],mu=muvals[f]) plot(y) NLL <- function(p) { kvals <- p[1:3] muvals <- p[4:6] -sum(dnbinom(y,size=kvals[f],mu=muvals[f],log=TRUE)) } parnames(NLL) <- c("k1","k2","k3","mu1","mu2","mu3") svec <- c(kvals,muvals) names(svec) <- parnames(NLL) m1 <- mle2(NLL,start=svec,vecpar=TRUE) bbmle/tests/testbounds.R0000644000176200001440000000064013013175522015011 0ustar liggesusersx <- runif(10) y <- 1+x+rnorm(10,sd=0.1) d <- data.frame(x,y) library(bbmle) m1 <- mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)),data=d) m2 <- mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), method="L-BFGS-B",lower=c(a=0,b=0,s=-Inf),data=d) m2F <- mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), method="L-BFGS-B",lower=c(a=0,b=0,s=-Inf), fixed=list(a=1),data=d) bbmle/tests/testparpred.R0000644000176200001440000000117413013175522015157 0ustar liggesusers## set up a data frame for prediction set.seed(1001) f = factor(rep(letters[1:4],each=20)) x = runif(80) u = rnorm(4) y = rnorm(80,mean=2+x*(3+u[f]),sd=0.1) dat = data.frame(f,x,y) ## fit a model ... could easily do by lm() but want to ## demonstrate the problem library(bbmle) m1 = mle2(y~dnorm(a+b*x,sd=exp(logs)),parameters=list(b~f),data=dat, start=list(a=0,b=2,logs=-3)) ## data frame for prediction pp0 = expand.grid(x=seq(0,1,length=11), f=levels(dat$f)) ## combine frame and model data: have to keep the model data ## around, because it contain other information needed for ## prediction. nrow(predict(m1,pp0)) bbmle/tests/parscale.R0000644000176200001440000000411313013175522014410 0ustar liggesuserslibrary(bbmle) old_opt <- options(digits=3) tracelevel <- 0 ## source("~/lib/R/pkgs/bbmle/pkg/R/mle.R set.seed(1002) X <- rexp(1000, rate = 0.0001) f <- function(X, rate) { if (tracelevel>0 && rate<0) cat("rate<0: ",rate,"\n") -sum(dexp(X, rate = rate, log = TRUE)) } if (FALSE) { ## L-BFGS-B violates bounds, and gets stuck at lower bound m <- mle2(minuslogl = f, data = list(X = X), start = list(rate = 0.01), method = "L-BFGS-B", control = list(trace = tracelevel, parscale = 1e-4), lower = c(rate = 1e-9)) profile(m, std.err=0.0001) ## finds new optimum fsc <- function(X, rate) { -sum(dexp(X, rate = rate*1e-4, log = TRUE)) } msc <- mle2(minuslogl = fsc, data = list(X = X), start = list(rate = 100), method = "L-BFGS-B", control = list(trace = tracelevel), lower = c(rate = 1e-5)) ## does it work if we scale by hand? ## no, identical problem } ## works fine with a better starting point m <- mle2(minuslogl = f, data = list(X = X), start = list(rate = 0.001), method = "L-BFGS-B", control = list(trace = tracelevel, parscale=1e-4), lower = c(rate = 1e-9)) vcov(m) confint(m) ## works OK despite warnings about 1-dimensional opt. with N-M (m0 <- mle2(minuslogl = f, data = list(X = X), start = list(rate = 0.01), method = "Nelder-Mead", control = list(trace = tracelevel, parscale = 1e-4))) vcov(m0) confint(m0) confint(m0,method="quad") ## very similar (good quadratic surface, not surprising) m1 <- mle2(minuslogl = f, data = list(X = X), start = list(rate = 0.01), method = "BFGS", control = list(trace = tracelevel, parscale = 1e-4)) ## gets stuck? will have to investigate ... m2 <- mle2(minuslogl = f, data = list(X = X), start = list(rate = 0.01), optimizer = "optimize", lower=1e-9,upper=0.1) vcov(m2) options(old_opt) bbmle/tests/gradient_vecpar_profile.R0000644000176200001440000000252313076270431017502 0ustar liggesuserslibrary(bbmle) ## Simulate data set.seed(1) x <- 1:5 y <- 2*x+1 noise <- rnorm(5, 0, 0.1) mydata <- data.frame(x = x, y=y+noise) ## Model definition model <- function(a, b) with(mydata, a*x+b) ## Negative log-likelihood nll <- function(par) with(mydata, { a <- par[1] b <- par[2] sum(0.5*((y-model(a,b))/0.1)^2) }) gr <- function(par) with(mydata, { a <- par[1] b <- par[2] dnllda <- -sum(((y-model(a,b))/0.1)*x/0.1) dnlldb <- -sum(((y-model(a,b))/0.1)*1/0.1) return(c(dnllda, dnlldb)) }) ## optimization parnames(nll) <- c("a", "b") parnames(gr) <- c("a", "b") fit <- mle2(nll, c(a = 1, b=2), gr=gr) myprof <- profile(fit) myprof_c <- profile(fit,continuation="naive") confint(myprof) confint(myprof_c) fit <- mle2(nll, c(a = 1, b=2), gr=gr, skip.hessian=TRUE) myprof2 <- profile(fit,std.err=c(0.1,0.1)) ## incomplete! model2 <- ~a+b*x+c*x^2 f0 <- deriv(model2,"x",function.arg=c("a","b","c")) ## chain rule f1 <- function() { ## memoize lastpar <- NULL lastval <- NULL } f2 <- function(par) { if (par==lastpar) { return(c(lastval)) } lastpar <<- par lastval <<- do.call(f0,par) f1(par) } f2.gr <- function(par) { if (par==lastpar) { return(attr(lastval,".grad")) } lastpar <<- par lastval <<- do.call(f0,par) f1.gr(par) } parnames(f2) <- parnames(f2.gr) <- c("a","b","c") bbmle/tests/testenv.Rout.save0000644000176200001440000000467113013176376016014 0ustar liggesusers R Under development (unstable) (2016-10-08 r71471) -- "Unsuffered Consequences" Copyright (C) 2016 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. Natural language support but running in an English locale 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(bbmle) Loading required package: stats4 > f <- function() { + maxit <- 1000 + d <- data.frame(x=0:10, + y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) + mle2(y~dpois(lambda=exp(lymax)/(1+x/exp(lhalf))), + start=list(lymax=0,lhalf=0), + data=d, + control=list(maxit=maxit), + parameters=list(lymax~1,lhalf~1)) + } > > f2 <- function(method="BFGS") { + d <- data.frame(x=0:10, + y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) + mle2(y~dpois(lambda=exp(lymax)/(1+x/exp(lhalf))), + start=list(lymax=0,lhalf=0), + data=d, + method=method, + parameters=list(lymax~1,lhalf~1)) + } > > m1 <- f() > p <- profile(m1) > ## FIXME: check results (need to save in an environment-friendly way!) > print(head(as.data.frame(p)),digits=3) param z par.vals.lymax par.vals.lhalf focal lymax.1 lymax -5.469 2.56 27.21 2.56 lymax.2 lymax -3.204 2.67 2.22 2.67 lymax.3 lymax -2.569 2.78 1.96 2.78 lymax.4 lymax -1.931 2.89 1.73 2.89 lymax.5 lymax -1.292 3.00 1.51 3.00 lymax.6 lymax -0.648 3.11 1.31 3.11 > > m2 <- f2() > p2 <- profile(m2) > print(head(as.data.frame(p2)),digits=3) param z par.vals.lymax par.vals.lhalf focal lymax.1 lymax -5.469 2.56 27.21 2.56 lymax.2 lymax -3.204 2.67 2.22 2.67 lymax.3 lymax -2.569 2.78 1.96 2.78 lymax.4 lymax -1.931 2.89 1.73 2.89 lymax.5 lymax -1.292 3.00 1.51 3.00 lymax.6 lymax -0.648 3.11 1.31 3.11 > > proc.time() user system elapsed 0.768 0.028 0.832 bbmle/tests/richards.Rout.save0000644000176200001440000001154213076267721016122 0ustar liggesusers R Under development (unstable) (2017-04-17 r72531) -- "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. Natural language support but running in an English locale 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. > ## implement richards-incidence (="revised superlogistic") > ## with analytic gradients > > ## from Junling's code: > model_richardson <- function(times, theta, N) + { + x0 = theta[1] + lambda = theta[2] + K = theta[3] * N + alpha = theta[4] + return(K/(1+((K/x0)^alpha-1)*exp(-lambda*alpha*times))^(1/alpha)) + } > > ## equivalent model, in terms of sigma and as a symbolic expression > Rcum <- expression((sigma*N)/(1+(((sigma*N)/x0)^alpha-1)*exp(-lambda*alpha*times))^(1/alpha)) > > pnames <- c("x0","lambda","sigma","alpha") > > ## function to compute gradient (and value), derived by R > Rderiv <- deriv(Rcum,pnames, function.arg=c(pnames,"N","times")) > > ## equivalent (using Rcum): return incidence (incid=TRUE) or cumulative incidence (incid=FALSE) > calc_mean <- function(p,times,N,incid=TRUE) { + ## this is more 'magic' than I would like it to be ... + ## have to create an environment and populate it with the contents of p (and N and times), + ## then evaluate the expression in this environment + pp <- c(as.list(p),list(times=times,N=N)) + ## e0 <- new.env() + ## mapply(assign,names(pp),pp,MoreArgs=list(envir=e0)) + cumvals <- eval(Rcum,envir=pp) + if (incid) diff(cumvals) else cumvals + } > > ## Poisson likelihood function > likfun <- function(p,dat,times,N,incid=TRUE) { + -sum(dpois(dat,calc_mean(p,times,N,incid=incid),log=TRUE)) + } > > ## deriv of P(x,lambda) = -sum(dpois(x,lambda,log=TRUE)) wrt lambda == sum(1-lambda/x) = N - lambda/(sum(x)) > ## deriv of P(x,lambda) wrt p = dP/d(lambda) * d(lambda)/dp > > ## compute gradient vector > gradlikfun <- function(p,dat,times,N,incid=TRUE) { + gcall <- do.call(Rderiv,c(as.list(p),list(times=times,N=N))) ## values + gradient matrix + lambda <- gcall + attr(lambda,"gradient") <- NULL + if (incid) lambda <- diff(lambda) + gmat <- attr(gcall,"gradient") ## extract gradient + if (incid) gmat <- apply(gmat,2,diff) ## differences + totderiv <- sweep(gmat,MARGIN=1,(1-dat/lambda),"*") ## apply chain rule (multiply columns of gmat by dP/dlambda) + colSums(totderiv) ## deriv of summed likelihood = sum of derivs of likelihod + } > > N <- 1000 > p0 <- c(x0=0.1,lambda=1,sigma=0.5,alpha=0.5) > t0 <- 1:10 > ## deterministic versions of data (cumulative and incidence) > dcdat <- model_richardson(t0,p0,N) > ddat <- diff(dcdat) > > plot(t0,dcdat) > plot(t0[-1],ddat) > > set.seed(1001) > ddat <- rpois(length(ddat),ddat) > > likfun(p0,ddat,t0,N) [1] 22.3544 > gradlikfun(p0,ddat,t0,N) x0 lambda sigma alpha 15.42028 30.95135 19.33690 30.04404 > > library(numDeriv) > grad(likfun,p0,dat=ddat,times=t0,N=N) ## finite differences [1] 15.42028 30.95135 19.33690 30.04404 > ## matches! > > library(bbmle) Loading required package: stats4 > parnames(likfun) <- names(p0) > > > m1 <- mle2(likfun,start=p0,gr=gradlikfun,data=list(times=t0,N=N,dat=ddat), + vecpar=TRUE) Warning messages: 1: In dpois(dat, calc_mean(p, times, N, incid = incid), log = TRUE) : NaNs produced 2: In dpois(dat, calc_mean(p, times, N, incid = incid), log = TRUE) : NaNs produced 3: In dpois(dat, calc_mean(p, times, N, incid = incid), log = TRUE) : NaNs produced > > plot(t0[-1],ddat) > lines(t0[-1],calc_mean(coef(m1),times=t0,N=N)) > > if (FALSE) { + ## too slow .. + pp0 <- profile(m1) + pp0C <- profile(m1,continuation="naive") + } > > pp1 <- profile(m1,which="lambda") There were 50 or more warnings (use warnings() to see the first 50) > > m0 <- mle2(likfun,start=p0,data=list(times=t0,N=N,dat=ddat), + vecpar=TRUE) Warning messages: 1: In dpois(dat, calc_mean(p, times, N, incid = incid), log = TRUE) : NaNs produced 2: In dpois(dat, calc_mean(p, times, N, incid = incid), log = TRUE) : NaNs produced 3: In dpois(dat, calc_mean(p, times, N, incid = incid), log = TRUE) : NaNs produced > > pp0 <- profile(m0,which="lambda") There were 50 or more warnings (use warnings() to see the first 50) > par(mfrow=c(1,2)) > plot(pp1,show.points=TRUE) > plot(pp0,show.points=TRUE) Warning message: In .local(x, ...) : non-monotonic profile: reverting to linear interpolation. Consider setting std.err manually > > proc.time() user system elapsed 7.072 0.628 9.701 bbmle/tests/boundstest.R0000644000176200001440000000064613013175513015017 0ustar liggesusers## logic for removing/modifying bounds: ## (1) unbounded opt. will have limits of -Inf/Inf ## [or missing()] ## (2) bounded opt ## fix length mismatch errors! k <- 19 N <- 20 uniboundtest <- function() { m1 <- mle2(k~dbinom(size=N,prob=p), start=list(p=0.5)) m1b <- mle2(k~dbinom(size=N,prob=p), start=list(p=0.5),method="L-BFGS-B",upper=0.999) p1 <- profile(m1) p1b <- profile(m1b) } bbmle/tests/mkout0000644000176200001440000000006413013175522013556 0ustar liggesusersR CMD BATCH --vanilla $1.R; mv $1.Rout $1.Rout.save bbmle/tests/richards.R0000644000176200001440000000566713076267705014452 0ustar liggesusers## implement richards-incidence (="revised superlogistic") ## with analytic gradients ## from Junling's code: model_richardson <- function(times, theta, N) { x0 = theta[1] lambda = theta[2] K = theta[3] * N alpha = theta[4] return(K/(1+((K/x0)^alpha-1)*exp(-lambda*alpha*times))^(1/alpha)) } ## equivalent model, in terms of sigma and as a symbolic expression Rcum <- expression((sigma*N)/(1+(((sigma*N)/x0)^alpha-1)*exp(-lambda*alpha*times))^(1/alpha)) pnames <- c("x0","lambda","sigma","alpha") ## function to compute gradient (and value), derived by R Rderiv <- deriv(Rcum,pnames, function.arg=c(pnames,"N","times")) ## equivalent (using Rcum): return incidence (incid=TRUE) or cumulative incidence (incid=FALSE) calc_mean <- function(p,times,N,incid=TRUE) { ## this is more 'magic' than I would like it to be ... ## have to create an environment and populate it with the contents of p (and N and times), ## then evaluate the expression in this environment pp <- c(as.list(p),list(times=times,N=N)) ## e0 <- new.env() ## mapply(assign,names(pp),pp,MoreArgs=list(envir=e0)) cumvals <- eval(Rcum,envir=pp) if (incid) diff(cumvals) else cumvals } ## Poisson likelihood function likfun <- function(p,dat,times,N,incid=TRUE) { -sum(dpois(dat,calc_mean(p,times,N,incid=incid),log=TRUE)) } ## deriv of P(x,lambda) = -sum(dpois(x,lambda,log=TRUE)) wrt lambda == sum(1-lambda/x) = N - lambda/(sum(x)) ## deriv of P(x,lambda) wrt p = dP/d(lambda) * d(lambda)/dp ## compute gradient vector gradlikfun <- function(p,dat,times,N,incid=TRUE) { gcall <- do.call(Rderiv,c(as.list(p),list(times=times,N=N))) ## values + gradient matrix lambda <- gcall attr(lambda,"gradient") <- NULL if (incid) lambda <- diff(lambda) gmat <- attr(gcall,"gradient") ## extract gradient if (incid) gmat <- apply(gmat,2,diff) ## differences totderiv <- sweep(gmat,MARGIN=1,(1-dat/lambda),"*") ## apply chain rule (multiply columns of gmat by dP/dlambda) colSums(totderiv) ## deriv of summed likelihood = sum of derivs of likelihod } N <- 1000 p0 <- c(x0=0.1,lambda=1,sigma=0.5,alpha=0.5) t0 <- 1:10 ## deterministic versions of data (cumulative and incidence) dcdat <- model_richardson(t0,p0,N) ddat <- diff(dcdat) plot(t0,dcdat) plot(t0[-1],ddat) set.seed(1001) ddat <- rpois(length(ddat),ddat) likfun(p0,ddat,t0,N) gradlikfun(p0,ddat,t0,N) library(numDeriv) grad(likfun,p0,dat=ddat,times=t0,N=N) ## finite differences ## matches! library(bbmle) parnames(likfun) <- names(p0) m1 <- mle2(likfun,start=p0,gr=gradlikfun,data=list(times=t0,N=N,dat=ddat), vecpar=TRUE) plot(t0[-1],ddat) lines(t0[-1],calc_mean(coef(m1),times=t0,N=N)) if (FALSE) { ## too slow .. pp0 <- profile(m1) pp0C <- profile(m1,continuation="naive") } pp1 <- profile(m1,which="lambda") m0 <- mle2(likfun,start=p0,data=list(times=t0,N=N,dat=ddat), vecpar=TRUE) pp0 <- profile(m0,which="lambda") par(mfrow=c(1,2)) plot(pp1,show.points=TRUE) plot(pp0,show.points=TRUE) bbmle/tests/predict.Rout.save0000644000176200001440000000351713013175522015744 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) > set.seed(1002) > lymax <- c(0,2) > lhalf <- 0 > x <- runif(200) > g <- factor(rep(c("a","b"),each=100)) > y <- rnbinom(200,mu=exp(lymax[g])/(1+x/exp(lhalf)),size=2) > d <- data.frame(x,g,y) > > fit3 <- mle2(y~dnbinom(mu=exp(lymax)/(1+x/exp(lhalf)),size=exp(logk)), + parameters=list(lymax~g), + start=list(lymax=0,lhalf=0,logk=0),data=d) > > plot(y~x,col=g) > ## true curves > curve(exp(0)/(1+x/exp(0)),add=TRUE) > curve(exp(2)/(1+x/exp(0)),col=2,add=TRUE) > xvec = seq(0,1,length=100) > lines(xvec,predict(fit3,newdata=list(g=factor(rep("a",100),levels=c("a","b")), + x = xvec)),col=1,lty=2) > lines(xvec,predict(fit3,newdata=list(g=factor(rep("b",100),levels=c("a","b")), + x = xvec)),col=2,lty=2) > > p1 = predict(fit3) > ## manual prediction > p2A = + with(as.list(coef(fit3)),exp(`lymax.(Intercept)`)/(1+x[1:100]/exp(lhalf))) > p2B = with(as.list(coef(fit3)),exp(`lymax.(Intercept)`+lymax.gb)/(1+x[101:200]/exp(lhalf))) > p2 = c(p2A,p2B) > all(p1==p2) [1] TRUE > > > > proc.time() user system elapsed 1.004 1.108 1.982 bbmle/tests/test-relist1.Rout.save0000644000176200001440000000235113013175522016645 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) > set.seed(1001) > f <- factor(rep(1:3,each=50)) > kvals <- c(1,2,5) > muvals <- c(10,2,5) > y <- rnbinom(length(f),size=kvals[f],mu=muvals[f]) > plot(y) > > NLL <- function(p) { + kvals <- p[1:3] + muvals <- p[4:6] + -sum(dnbinom(y,size=kvals[f],mu=muvals[f],log=TRUE)) + } > parnames(NLL) <- c("k1","k2","k3","mu1","mu2","mu3") > svec <- c(kvals,muvals) > names(svec) <- parnames(NLL) > m1 <- mle2(NLL,start=svec,vecpar=TRUE) > > proc.time() user system elapsed 0.988 1.116 1.990 bbmle/tests/BIC.Rout.save0000644000176200001440000000227713013175522014711 0ustar liggesusers R Under development (unstable) (2012-12-14 r61321) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) Loading required package: bbmle Loading required package: stats4 > x <- 0:10 > y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) > d <- data.frame(x,y) > fit <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), start=list(ymax=25,xhalf=3),data=d) > fit2 <- mle2(y~dpois(lambda=(x+1)*slope), start=list(slope=1),data=d) > BIC(fit) [1] 62.0039 > BIC(fit,fit2) df BIC fit 2 62.0039 fit2 1 228.2046 > > proc.time() user system elapsed 0.716 1.076 1.659 bbmle/tests/startvals.R0000644000176200001440000000163613013175522014650 0ustar liggesuserslibrary(bbmle) ## copied from emdbook dbetabinom <- function (x, prob, size, theta, shape1, shape2, log = FALSE) { if (missing(prob) && !missing(shape1) && !missing(shape2)) { prob = shape1/(shape1 + shape2) theta = shape1 + shape2 } v <- lchoose(size, x) - lbeta(theta * (1 - prob), theta * prob) + lbeta(size - x + theta * (1 - prob), x + theta * prob) if (log) v else exp(v) } ss <- data.frame(taken=c(0,1,2,5),available=c(5,5,5,5), dist=rep(1,4)) SP.bb=mle2(taken~dbetabinom(prob,theta,size=available), start=list(prob=0.5,theta=1),data=ss) SP.bb.dist=mle2(taken~dbetabinom(prob,size=available,theta), parameters=list(prob~dist-1,theta~dist-1), start=as.list(coef(SP.bb)),data=ss) SP.bb.dist2=mle2(taken~dbetabinom(prob,size=available,theta), parameters=list(prob~dist - 1,theta~dist - 1), start=as.list(coef(SP.bb)),data=ss) bbmle/tests/testparpred.Rout.save0000644000176200001440000000274013013175522016644 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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. > ## set up a data frame for prediction > > set.seed(1001) > f = factor(rep(letters[1:4],each=20)) > x = runif(80) > u = rnorm(4) > y = rnorm(80,mean=2+x*(3+u[f]),sd=0.1) > dat = data.frame(f,x,y) > > ## fit a model ... could easily do by lm() but want to > ## demonstrate the problem > > library(bbmle) > m1 = mle2(y~dnorm(a+b*x,sd=exp(logs)),parameters=list(b~f),data=dat, + start=list(a=0,b=2,logs=-3)) > > ## data frame for prediction > pp0 = expand.grid(x=seq(0,1,length=11), + f=levels(dat$f)) > > ## combine frame and model data: have to keep the model data > ## around, because it contain other information needed for > ## prediction. > > nrow(predict(m1,pp0)) [1] 44 > > > > > proc.time() user system elapsed 1.112 1.036 2.007 bbmle/tests/testbounds.Rout.save0000644000176200001440000000334613013175522016504 0ustar liggesusers R Under development (unstable) (2012-12-14 r61321) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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. > x <- runif(10) > y <- 1+x+rnorm(10,sd=0.1) > d <- data.frame(x,y) > > library(bbmle) Loading required package: stats4 > m1 <- mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)),data=d) > > m2 <- mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), + method="L-BFGS-B",lower=c(a=0,b=0,s=-Inf),data=d) > > m2F <- mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), + method="L-BFGS-B",lower=c(a=0,b=0,s=-Inf), + fixed=list(a=1),data=d) Warning messages: 1: In mle2(y ~ dnorm(a + b * x, sd = exp(s)), start = list(a = 1, b = 1, : length mismatch between lower/upper and number of non-fixed parameters: # lower=3, # upper=0, # non-fixed=2 2: In oout$par == call$lower : longer object length is not a multiple of shorter object length 3: In mle2(y ~ dnorm(a + b * x, sd = exp(s)), start = list(a = 1, b = 1, : some parameters are on the boundary: variance-covariance calculations based on Hessian may be unreliable > > > proc.time() user system elapsed 0.820 1.052 1.857 bbmle/tests/RUnit-tests.R0000644000176200001440000000052113013175522015016 0ustar liggesusersrequire(RUnit) ## TODO -- find solution to run these tests on R-forge ##testsuite <- defineTestSuite("phylobase", dirs="/home/francois/Work/R-dev/phylobase/branches/fm-branch/RUnit-tests", ## testFileRegexp="^test", testFuncRegexp="^test") ##testRslt <- runTestSuite(testsuite) ##printTextProtocol(testRslt) bbmle/tests/formulatest.R0000644000176200001440000004116313013175522015171 0ustar liggesuserslibrary(bbmle) set.seed(1001) ## test 1 x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) suppressWarnings(m1 <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), parameters=list(ymax~1,xhalf~1), start=list(ymax=1,xhalf=1),data=d)) suppressWarnings(p1 <- profile(m1)) suppressWarnings(m2 <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), start=list(ymax=1,xhalf=1),data=d)) ## should be able to omit parameters (?) or ## have them taken from ## test 2: ReedfrogSizepred <- structure(list(TBL = as.integer(c(9, 9, 9, 12, 12, 12, 21, 21, 21, 25, 25, 25, 37, 37, 37)), Kill = as.integer(c(0, 2, 1, 3, 4, 5, 0, 0, 0, 0, 1, 0, 0, 0, 0))), .Names = c("TBL", "Kill"), class = "data.frame", row.names = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15")) VBlogist <- function(x,sizep1,sizep2,sizep3) { exp(sizep1*(sizep3-x))/(1+exp(sizep2*sizep1*(sizep3-x))) } startp <- list(sizep1=0,sizep2=1,sizep3=12) mle2(Kill~dbinom(prob=VBlogist(TBL,sizep1,sizep2,sizep3),size=10), start=startp, method="Nelder-Mead", data=ReedfrogSizepred) ## test 3: f <- factor(rep(1:2,each=20)) xhalf <- c(5,10) ymax <- 10 x <- rep(0:19,2) y <- rpois(40,ymax/(1+x/xhalf[f])) d <- data.frame(x,y) ## plot(x,y,col=as.numeric(f)) m3 <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), parameters=list(xhalf~f), start=list(ymax=1,xhalf=1),data=d) m4 <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), parameters=list(ymax~f,xhalf~f), start=list(ymax=1,xhalf=1),data=d) suppressWarnings(m5 <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), parameters=list(ymax~f), start=list(ymax=1,xhalf=1),data=d)) anova(m2,m3,m4) anova(m2,m5,m4) AICtab(m2,m3,m4,m5) GobySurvival <- structure(list(exper = as.integer(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, 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, 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, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5)), year = as.integer(c(2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002)), site = structure(as.integer(c(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 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, 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, 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, 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, 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)), .Label = c("backreef", "patchreef"), class = "factor"), head = structure(as.integer(c(15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 4, 4, 4, 19, 19, 24, 24, 24, 24, 24, 24, 6, 6, 6, 6, 6, 6, 6, 6, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 13, 13, 13, 13, 3, 3, 3, 3, 3, 3, 3, 3, 2, 2, 2, 2, 5, 5, 5, 5, 12, 12, 12, 12, 7, 7, 7, 11, 11, 11, 11, 11, 11, 11, 11, 11, 14, 14, 14, 23, 23, 23, 23, 23, 23, 23, 23, 23, 22, 22, 22, 8, 8, 8, 8, 8, 8, 8, 8, 8, 20, 20, 20, 20, 20, 20, 20, 20, 21, 21, 21, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 17, 17, 17, 17, 17, 17, 17, 16, 16, 16, 16, 16, 16, 16, 16, 18, 18, 18, 26, 26, 26, 55, 55, 55, 57, 57, 41, 41, 41, 45, 45, 47, 47, 48, 48, 58, 58, 34, 34, 34, 34, 35, 35, 35, 35, 50, 50, 50, 32, 32, 32, 25, 25, 25, 25, 25, 33, 33, 33, 28, 28, 31, 31, 31, 36, 36, 36, 44, 44, 44, 44, 29, 29, 29, 27, 27, 27, 40, 40, 40, 46, 46, 46, 46, 46, 39, 39, 39, 39, 30, 30, 30, 30, 30, 51, 51, 51, 51, 51, 51, 56, 56, 56, 56, 56, 56, 52, 52, 52, 52, 52, 52, 55, 55, 55, 53, 53, 53, 57, 57, 57, 57, 57, 57, 35, 35, 35, 35, 35, 35, 33, 33, 33, 33, 33, 33, 29, 29, 29, 45, 45, 45, 45, 45, 45, 38, 38, 38, 38, 38, 38, 27, 27, 27, 27, 27, 27, 59, 59, 59, 59, 59, 59, 54, 54, 54, 54, 54, 54, 39, 39, 39, 39, 39, 39, 42, 42, 42, 41, 41, 41, 41, 41, 41, 49, 49, 49, 46, 46, 46, 46, 46, 46, 47, 47, 47, 47, 47, 47, 37, 37, 37, 43, 43, 43, 43, 43, 43, 40, 40, 40, 40, 40, 40, 48, 48, 48, 48, 48, 48, 51, 51, 51, 45, 45, 45, 41, 41, 41, 47, 47, 47, 37, 37, 37, 49, 49, 49, 34, 34, 34, 25, 25, 25)), .Label = c("p1", "p10", "p11", "p12", "p13", "p14", "p15", "p16", "p17", "p18", "p19", "p2", "p20", "p21", "p3", "p4", "p42", "p5", "p51", "p6", "p7", "p70", "p8", "p9", "r10", "r11", "r13", "r14", "r15", "r17", "r18", "r19", "r2", "r20", "r21", "r22", "r23", "r24", "r25", "r26", "r27", "r28", "r29", "r3", "r30", "r33", "r34", "r35", "r36", "r37", "r41", "r45", "r47", "r48", "r5", "r6", "r7", "r8", "r9"), class = "factor"), density = as.integer(c(11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 3, 3, 3, 2, 2, 6, 6, 6, 6, 6, 6, 8, 8, 8, 8, 8, 8, 8, 8, 3, 3, 3, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 4, 4, 4, 4, 8, 8, 8, 8, 8, 8, 8, 8, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 8, 8, 8, 8, 8, 8, 8, 8, 3, 3, 3, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 2, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 4, 4, 4, 4, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 5, 5, 5, 5, 5, 3, 3, 3, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 3, 3, 3, 5, 5, 5, 5, 5, 4, 4, 4, 4, 5, 5, 5, 5, 5, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 6, 6, 6, 6, 6, 6, 3, 3, 3, 3, 3, 3, 11, 11, 11, 11, 11, 11, 6, 6, 6, 6, 6, 6, 11, 11, 11, 11, 11, 11, 3, 3, 3, 6, 6, 6, 6, 6, 6, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 6, 6, 6, 6, 6, 6, 11, 11, 11, 11, 11, 11, 3, 3, 3, 11, 11, 11, 11, 11, 11, 3, 3, 3, 6, 6, 6, 6, 6, 6, 11, 11, 11, 11, 11, 11, 3, 3, 3, 11, 11, 11, 11, 11, 11, 6, 6, 6, 6, 6, 6, 11, 11, 11, 11, 11, 11, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3)), qual = as.integer(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 11, 11, 11, 11, 11, 12, 12, 12, 12, 18, 18, 18, 18, 18, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 12, 12, 12, 12, 12, 12, 16, 16, 16, 16, 16, 16, 2, 2, 2, 5, 5, 5, 8, 8, 8, 9, 9, 9, 10, 10, 10, 9, 9, 9, 4, 4, 4, 3, 3, 3)), d1 = as.integer(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 4, 1, 1, 11, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 8, 8, 4, 8, 11, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 11, 11, 1, 1, 1, 4, 4, 11, 11, 11, 4, 8, 11, 11, 1, 1, 1, 11, 1, 1, 8, 11, 1, 1, 11, 1, 1, 1, 1, 1, 1, 1, 11, 11, 1, 8, 11, 4, 8, 8, 8, 11, 11, 11, 11, 11, 1, 1, 8, 1, 1, 1, 1, 1, 1, 1, 4, 8, 1, 1, 1, 1, 1, 1, 4, 11, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 11, 11, 1, 1, 1, 1, 1, 1, 8, 1, 1, 1, 1, 1, 8, 11, 11, 1, 4, 11, 1, 1, 3, 1, 1, 1, 1, 1, 1, 1, 4, 2, 12, 2, 12, 3, 12, 2, 12, 1, 1, 1, 1, 1, 1, 1, 12, 1, 1, 1, 1, 1, 4, 1, 1, 1, 2, 4, 1, 1, 12, 1, 1, 1, 1, 4, 1, 1, 12, 1, 1, 3, 8, 1, 2, 12, 1, 1, 1, 1, 1, 8, 1, 1, 3, 3, 12, 1, 1, 2, 12, 1, 2, 4, 8, 8, 1, 2, 3, 1, 1, 1, 1, 1, 1, 1, 3, 3, 1, 1, 3, 1, 1, 1, 1, 1, 1, 1, 1, 12, 1, 1, 8, 1, 2, 10, 1, 1, 12, 1, 1, 3, 1, 1, 1, 1, 2, 2, 1, 4, 6, 3, 3, 4, 1, 4, 12, 1, 1, 3, 1, 1, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 6, 1, 1, 1, 1, 1, 1, 1, 1, 12, 1, 1, 12, 3, 6, 10, 1, 1, 12, 1, 1, 8, 1, 2, 12, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 12, 2, 2, 12, 1, 12, 12, 4, 4, 4, 1, 1, 2, 1, 1, 1, 1, 1, 8, 1, 1, 2, 1, 1, 4, 1, 1, 12, 1, 1, 12, 1, 3, 12, 2, 4, 12, 2, 10, 12, 1, 1, 8, 1, 1, 8)), d2 = as.integer(c(4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 8, 4, 4, 70, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 11, 11, 8, 11, 70, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 70, 70, 4, 4, 4, 8, 8, 70, 70, 70, 8, 11, 70, 70, 4, 4, 4, 70, 4, 4, 11, 70, 4, 4, 70, 4, 4, 4, 4, 4, 4, 4, 70, 70, 4, 11, 70, 8, 11, 11, 11, 70, 70, 70, 70, 70, 4, 4, 11, 4, 4, 4, 4, 4, 4, 4, 8, 11, 4, 4, 4, 4, 4, 4, 8, 70, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 70, 70, 4, 4, 4, 4, 4, 4, 11, 4, 4, 4, 4, 4, 11, 70, 70, 4, 8, 70, 2, 2, 4, 2, 2, 2, 2, 2, 2, 2, 8, 3, 70, 3, 70, 4, 70, 3, 70, 2, 2, 2, 2, 2, 2, 2, 70, 2, 2, 2, 2, 2, 8, 2, 2, 2, 3, 8, 2, 2, 70, 2, 2, 2, 2, 8, 2, 2, 70, 2, 2, 4, 12, 2, 3, 70, 2, 2, 2, 2, 2, 12, 2, 2, 4, 4, 70, 2, 2, 3, 70, 2, 3, 8, 12, 12, 2, 3, 4, 2, 2, 2, 2, 2, 2, 2, 4, 4, 2, 2, 4, 2, 2, 2, 2, 2, 2, 2, 2, 70, 2, 2, 10, 2, 3, 12, 2, 2, 70, 2, 2, 4, 2, 2, 2, 2, 3, 3, 2, 6, 8, 4, 4, 6, 2, 6, 70, 2, 2, 4, 2, 2, 4, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 4, 8, 2, 2, 2, 2, 2, 2, 2, 2, 70, 2, 2, 70, 4, 8, 12, 2, 2, 70, 2, 2, 10, 2, 3, 70, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 70, 3, 3, 70, 2, 70, 70, 6, 6, 6, 2, 2, 3, 2, 2, 2, 2, 2, 10, 2, 2, 3, 2, 2, 6, 2, 2, 70, 2, 2, 70, 2, 4, 70, 3, 6, 70, 3, 12, 70, 2, 2, 10, 2, 2, 10))), .Names = c("exper", "year", "site", "head", "density", "qual", "d1", "d2"), class = "data.frame", row.names = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", "82", "83", "84", "85", "86", "87", "88", "89", "90", "91", "92", "93", "94", "95", "96", "97", "98", "99", "100", "101", "102", "103", "104", "105", "106", "107", "108", "109", "110", "111", "112", "113", "114", "115", "116", "117", "118", "119", "120", "121", "122", "123", "124", "125", "126", "127", "128", "129", "130", "131", "132", "133", "134", "135", "136", "137", "138", "139", "140", "141", "142", "143", "144", "145", "146", "147", "148", "149", "150", "151", "152", "153", "154", "155", "156", "157", "158", "159", "160", "161", "162", "163", "164", "165", "166", "167", "168", "169", "170", "171", "172", "173", "174", "175", "176", "177", "178", "179", "180", "181", "182", "183", "184", "185", "186", "187", "188", "189", "190", "191", "192", "193", "194", "195", "196", "197", "198", "199", "200", "201", "202", "203", "204", "205", "206", "207", "208", "209", "210", "211", "212", "213", "214", "215", "216", "217", "218", "219", "220", "221", "222", "223", "224", "225", "226", "227", "228", "229", "230", "231", "232", "233", "234", "235", "236", "237", "238", "239", "240", "241", "242", "243", "244", "245", "246", "247", "248", "249", "250", "251", "252", "253", "254", "255", "256", "257", "258", "259", "260", "261", "262", "263", "264", "265", "266", "267", "268", "269", "270", "271", "272", "273", "274", "275", "276", "277", "278", "279", "280", "281", "282", "283", "284", "285", "286", "287", "288", "289", "290", "291", "292", "293", "294", "295", "296", "297", "298", "299", "300", "301", "302", "303", "304", "305", "306", "307", "308", "309", "310", "311", "312", "313", "314", "315", "316", "317", "318", "319", "320", "321", "322", "323", "324", "325", "326", "327", "328", "329", "330", "331", "332", "333", "334", "335", "336", "337", "338", "339", "340", "341", "342", "343", "344", "345", "346", "347", "348", "349", "350", "351", "352", "353", "354", "355", "356", "357", "358", "359", "360", "361", "362", "363", "364", "365", "366", "367", "368", "369")) dicweib <- function(x,shape,scale,log=FALSE) { if (is.matrix(x)) { day1 <- x[,1] day2 <- x[,2] } else { day1 <- x[1] day2 <- x[2] } v <- log(pweibull(day2,shape,scale)-pweibull(day1,shape,scale)) if (log) v else exp(v) } GS2 <- transform(GobySurvival, day1 = d1-1, day2 = ifelse(d2==70,Inf,d2-1), fexper=factor(exper)) totmeansurv <- with(GS2,mean((d1+d2)/2)) mle2(cbind(day1,day2)~dicweib(exp(shape),exp(scale)), parameters=list(scale~fexper+qual*density), start=list(scale=log(totmeansurv),shape=0),data=GS2) bbmle/tests/formulatest.Rout.save0000644000176200001440000005011013013175522016646 0ustar liggesusers R Under development (unstable) (2012-12-14 r61321) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) Loading required package: stats4 > > set.seed(1001) > > ## test 1 > x <- 0:10 > y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) > d <- data.frame(x,y) > suppressWarnings(m1 <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), + parameters=list(ymax~1,xhalf~1), + start=list(ymax=1,xhalf=1),data=d)) > > suppressWarnings(p1 <- profile(m1)) > > suppressWarnings(m2 <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), + start=list(ymax=1,xhalf=1),data=d)) > > ## should be able to omit parameters (?) or > ## have them taken from > ## test 2: > > ReedfrogSizepred <- + structure(list(TBL = as.integer(c(9, 9, 9, 12, 12, 12, 21, 21, + 21, 25, 25, 25, 37, 37, 37)), Kill = as.integer(c(0, 2, 1, 3, + 4, 5, 0, 0, 0, 0, 1, 0, 0, 0, 0))), .Names = c("TBL", "Kill"), class = "data.frame", row.names = c("1", + "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", + "14", "15")) > > VBlogist <- function(x,sizep1,sizep2,sizep3) { + exp(sizep1*(sizep3-x))/(1+exp(sizep2*sizep1*(sizep3-x))) + } > startp <- list(sizep1=0,sizep2=1,sizep3=12) > mle2(Kill~dbinom(prob=VBlogist(TBL,sizep1,sizep2,sizep3),size=10), + start=startp, + method="Nelder-Mead", + data=ReedfrogSizepred) Call: mle2(minuslogl = Kill ~ dbinom(prob = VBlogist(TBL, sizep1, sizep2, sizep3), size = 10), start = startp, method = "Nelder-Mead", data = ReedfrogSizepred) Coefficients: sizep1 sizep2 sizep3 -0.5944408 1.6799300 12.9078275 Log-likelihood: -12.15 > > ## test 3: > f <- factor(rep(1:2,each=20)) > xhalf <- c(5,10) > ymax <- 10 > x <- rep(0:19,2) > y <- rpois(40,ymax/(1+x/xhalf[f])) > d <- data.frame(x,y) > ## plot(x,y,col=as.numeric(f)) > > m3 <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), + parameters=list(xhalf~f), + start=list(ymax=1,xhalf=1),data=d) > > m4 <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), + parameters=list(ymax~f,xhalf~f), + start=list(ymax=1,xhalf=1),data=d) Warning messages: 1: In dpois(x = c(16L, 8L, 6L, 6L, 8L, 0L, 2L, 3L, 5L, 3L, 1L, 5L, : NaNs produced 2: In dpois(x = c(16L, 8L, 6L, 6L, 8L, 0L, 2L, 3L, 5L, 3L, 1L, 5L, : NaNs produced > > suppressWarnings(m5 <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), + parameters=list(ymax~f), + start=list(ymax=1,xhalf=1),data=d)) > > anova(m2,m3,m4) Likelihood Ratio Tests Model 1: m2, y~dpois(lambda=ymax/(1+x/xhalf)) Model 2: m3, y~dpois(lambda=ymax/(1+x/xhalf)): xhalf~f Model 3: m4, y~dpois(lambda=ymax/(1+x/xhalf)): ymax~f, xhalf~f Tot Df Deviance Chisq Df Pr(>Chisq) 1 2 57.208 2 3 173.004 115.7960 1 <2e-16 *** 3 4 172.415 0.5894 1 0.4427 --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 > anova(m2,m5,m4) Likelihood Ratio Tests Model 1: m2, y~dpois(lambda=ymax/(1+x/xhalf)) Model 2: m5, y~dpois(lambda=ymax/(1+x/xhalf)): ymax~f Model 3: m4, y~dpois(lambda=ymax/(1+x/xhalf)): ymax~f, xhalf~f Tot Df Deviance Chisq Df Pr(>Chisq) 1 2 57.208 2 3 177.101 119.8930 1 <2e-16 *** 3 4 172.415 4.6864 1 0.0304 * --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 > AICtab(m2,m3,m4,m5) dAIC df m2 0.0 2 m3 117.8 3 m4 119.2 4 m5 121.9 3 > > GobySurvival <- + structure(list(exper = as.integer(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, 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, 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, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5)), year = as.integer(c(2000, 2000, 2000, 2000, 2000, + 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, + 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, + 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, + 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, + 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, + 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, + 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, + 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, + 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, + 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, + 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, + 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, + 2000, 2000, 2000, 2000, 2000, 2000, 2001, 2001, 2001, 2001, 2001, + 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, + 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, + 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, + 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, + 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, + 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, + 2001, 2001, 2001, 2001, 2001, 2002, 2002, 2002, 2002, 2002, 2002, + 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, + 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, + 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, + 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, + 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, + 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, + 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, + 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, + 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, + 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, + 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, + 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, + 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, + 2002)), site = structure(as.integer(c(2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 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, 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, 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, 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, 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)), .Label = c("backreef", "patchreef"), class = "factor"), + head = structure(as.integer(c(15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 4, 4, 4, 19, 19, 24, 24, 24, 24, 24, 24, + 6, 6, 6, 6, 6, 6, 6, 6, 9, 9, 9, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 13, 13, 13, 13, 3, 3, 3, 3, 3, 3, 3, + 3, 2, 2, 2, 2, 5, 5, 5, 5, 12, 12, 12, 12, 7, 7, 7, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 14, 14, 14, 23, 23, 23, 23, 23, + 23, 23, 23, 23, 22, 22, 22, 8, 8, 8, 8, 8, 8, 8, 8, 8, 20, + 20, 20, 20, 20, 20, 20, 20, 21, 21, 21, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 17, 17, 17, 17, 17, 17, 17, 16, 16, 16, 16, 16, + 16, 16, 16, 18, 18, 18, 26, 26, 26, 55, 55, 55, 57, 57, 41, + 41, 41, 45, 45, 47, 47, 48, 48, 58, 58, 34, 34, 34, 34, 35, + 35, 35, 35, 50, 50, 50, 32, 32, 32, 25, 25, 25, 25, 25, 33, + 33, 33, 28, 28, 31, 31, 31, 36, 36, 36, 44, 44, 44, 44, 29, + 29, 29, 27, 27, 27, 40, 40, 40, 46, 46, 46, 46, 46, 39, 39, + 39, 39, 30, 30, 30, 30, 30, 51, 51, 51, 51, 51, 51, 56, 56, + 56, 56, 56, 56, 52, 52, 52, 52, 52, 52, 55, 55, 55, 53, 53, + 53, 57, 57, 57, 57, 57, 57, 35, 35, 35, 35, 35, 35, 33, 33, + 33, 33, 33, 33, 29, 29, 29, 45, 45, 45, 45, 45, 45, 38, 38, + 38, 38, 38, 38, 27, 27, 27, 27, 27, 27, 59, 59, 59, 59, 59, + 59, 54, 54, 54, 54, 54, 54, 39, 39, 39, 39, 39, 39, 42, 42, + 42, 41, 41, 41, 41, 41, 41, 49, 49, 49, 46, 46, 46, 46, 46, + 46, 47, 47, 47, 47, 47, 47, 37, 37, 37, 43, 43, 43, 43, 43, + 43, 40, 40, 40, 40, 40, 40, 48, 48, 48, 48, 48, 48, 51, 51, + 51, 45, 45, 45, 41, 41, 41, 47, 47, 47, 37, 37, 37, 49, 49, + 49, 34, 34, 34, 25, 25, 25)), .Label = c("p1", "p10", "p11", + "p12", "p13", "p14", "p15", "p16", "p17", "p18", "p19", "p2", + "p20", "p21", "p3", "p4", "p42", "p5", "p51", "p6", "p7", + "p70", "p8", "p9", "r10", "r11", "r13", "r14", "r15", "r17", + "r18", "r19", "r2", "r20", "r21", "r22", "r23", "r24", "r25", + "r26", "r27", "r28", "r29", "r3", "r30", "r33", "r34", "r35", + "r36", "r37", "r41", "r45", "r47", "r48", "r5", "r6", "r7", + "r8", "r9"), class = "factor"), density = as.integer(c(11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 3, 3, 3, 2, 2, 6, + 6, 6, 6, 6, 6, 8, 8, 8, 8, 8, 8, 8, 8, 3, 3, 3, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 4, 4, 4, 4, 8, 8, 8, 8, 8, + 8, 8, 8, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 3, 3, 3, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 8, 8, 8, 8, 8, 8, + 8, 8, 3, 3, 3, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 7, + 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 2, 2, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 4, 4, + 4, 4, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 5, 5, 5, 5, 5, 3, 3, + 3, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 5, 5, 5, 5, 5, 4, 4, 4, 4, 5, 5, 5, 5, 5, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 6, 6, 6, 6, 6, 6, + 3, 3, 3, 3, 3, 3, 11, 11, 11, 11, 11, 11, 6, 6, 6, 6, 6, + 6, 11, 11, 11, 11, 11, 11, 3, 3, 3, 6, 6, 6, 6, 6, 6, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 6, 6, 6, 6, 6, 6, 11, 11, 11, 11, 11, 11, 3, 3, 3, + 11, 11, 11, 11, 11, 11, 3, 3, 3, 6, 6, 6, 6, 6, 6, 11, 11, + 11, 11, 11, 11, 3, 3, 3, 11, 11, 11, 11, 11, 11, 6, 6, 6, + 6, 6, 6, 11, 11, 11, 11, 11, 11, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3)), qual = as.integer(c(1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, + 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, + 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, + 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 9, + 9, 9, 9, 9, 9, 11, 11, 11, 11, 11, 12, 12, 12, 12, 18, 18, + 18, 18, 18, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 12, 12, 12, 12, 12, 12, 16, 16, 16, 16, + 16, 16, 2, 2, 2, 5, 5, 5, 8, 8, 8, 9, 9, 9, 10, 10, 10, 9, + 9, 9, 4, 4, 4, 3, 3, 3)), d1 = as.integer(c(1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 4, 1, 1, 11, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 8, 8, 4, 8, 11, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 11, 11, 1, 1, 1, 4, 4, 11, 11, 11, 4, 8, 11, 11, + 1, 1, 1, 11, 1, 1, 8, 11, 1, 1, 11, 1, 1, 1, 1, 1, 1, 1, + 11, 11, 1, 8, 11, 4, 8, 8, 8, 11, 11, 11, 11, 11, 1, 1, 8, + 1, 1, 1, 1, 1, 1, 1, 4, 8, 1, 1, 1, 1, 1, 1, 4, 11, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 11, 11, 1, 1, 1, 1, 1, 1, 8, 1, + 1, 1, 1, 1, 8, 11, 11, 1, 4, 11, 1, 1, 3, 1, 1, 1, 1, 1, + 1, 1, 4, 2, 12, 2, 12, 3, 12, 2, 12, 1, 1, 1, 1, 1, 1, 1, + 12, 1, 1, 1, 1, 1, 4, 1, 1, 1, 2, 4, 1, 1, 12, 1, 1, 1, 1, + 4, 1, 1, 12, 1, 1, 3, 8, 1, 2, 12, 1, 1, 1, 1, 1, 8, 1, 1, + 3, 3, 12, 1, 1, 2, 12, 1, 2, 4, 8, 8, 1, 2, 3, 1, 1, 1, 1, + 1, 1, 1, 3, 3, 1, 1, 3, 1, 1, 1, 1, 1, 1, 1, 1, 12, 1, 1, + 8, 1, 2, 10, 1, 1, 12, 1, 1, 3, 1, 1, 1, 1, 2, 2, 1, 4, 6, + 3, 3, 4, 1, 4, 12, 1, 1, 3, 1, 1, 3, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 3, 6, 1, 1, 1, 1, 1, 1, 1, 1, 12, 1, 1, 12, 3, 6, + 10, 1, 1, 12, 1, 1, 8, 1, 2, 12, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 12, 2, 2, 12, 1, 12, 12, 4, 4, 4, 1, 1, 2, 1, 1, + 1, 1, 1, 8, 1, 1, 2, 1, 1, 4, 1, 1, 12, 1, 1, 12, 1, 3, 12, + 2, 4, 12, 2, 10, 12, 1, 1, 8, 1, 1, 8)), d2 = as.integer(c(4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 8, 4, 4, 70, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 11, 11, 8, 11, 70, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 70, 70, 4, 4, 4, 8, 8, 70, 70, 70, + 8, 11, 70, 70, 4, 4, 4, 70, 4, 4, 11, 70, 4, 4, 70, 4, 4, + 4, 4, 4, 4, 4, 70, 70, 4, 11, 70, 8, 11, 11, 11, 70, 70, + 70, 70, 70, 4, 4, 11, 4, 4, 4, 4, 4, 4, 4, 8, 11, 4, 4, 4, + 4, 4, 4, 8, 70, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 70, 70, + 4, 4, 4, 4, 4, 4, 11, 4, 4, 4, 4, 4, 11, 70, 70, 4, 8, 70, + 2, 2, 4, 2, 2, 2, 2, 2, 2, 2, 8, 3, 70, 3, 70, 4, 70, 3, + 70, 2, 2, 2, 2, 2, 2, 2, 70, 2, 2, 2, 2, 2, 8, 2, 2, 2, 3, + 8, 2, 2, 70, 2, 2, 2, 2, 8, 2, 2, 70, 2, 2, 4, 12, 2, 3, + 70, 2, 2, 2, 2, 2, 12, 2, 2, 4, 4, 70, 2, 2, 3, 70, 2, 3, + 8, 12, 12, 2, 3, 4, 2, 2, 2, 2, 2, 2, 2, 4, 4, 2, 2, 4, 2, + 2, 2, 2, 2, 2, 2, 2, 70, 2, 2, 10, 2, 3, 12, 2, 2, 70, 2, + 2, 4, 2, 2, 2, 2, 3, 3, 2, 6, 8, 4, 4, 6, 2, 6, 70, 2, 2, + 4, 2, 2, 4, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 4, 8, 2, 2, 2, + 2, 2, 2, 2, 2, 70, 2, 2, 70, 4, 8, 12, 2, 2, 70, 2, 2, 10, + 2, 3, 70, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 70, 3, 3, 70, + 2, 70, 70, 6, 6, 6, 2, 2, 3, 2, 2, 2, 2, 2, 10, 2, 2, 3, + 2, 2, 6, 2, 2, 70, 2, 2, 70, 2, 4, 70, 3, 6, 70, 3, 12, 70, + 2, 2, 10, 2, 2, 10))), .Names = c("exper", "year", "site", + "head", "density", "qual", "d1", "d2"), class = "data.frame", row.names = c("1", + "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", + "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", + "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", + "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", + "47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", + "58", "59", "60", "61", "62", "63", "64", "65", "66", "67", "68", + "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", + "80", "81", "82", "83", "84", "85", "86", "87", "88", "89", "90", + "91", "92", "93", "94", "95", "96", "97", "98", "99", "100", + "101", "102", "103", "104", "105", "106", "107", "108", "109", + "110", "111", "112", "113", "114", "115", "116", "117", "118", + "119", "120", "121", "122", "123", "124", "125", "126", "127", + "128", "129", "130", "131", "132", "133", "134", "135", "136", + "137", "138", "139", "140", "141", "142", "143", "144", "145", + "146", "147", "148", "149", "150", "151", "152", "153", "154", + "155", "156", "157", "158", "159", "160", "161", "162", "163", + "164", "165", "166", "167", "168", "169", "170", "171", "172", + "173", "174", "175", "176", "177", "178", "179", "180", "181", + "182", "183", "184", "185", "186", "187", "188", "189", "190", + "191", "192", "193", "194", "195", "196", "197", "198", "199", + "200", "201", "202", "203", "204", "205", "206", "207", "208", + "209", "210", "211", "212", "213", "214", "215", "216", "217", + "218", "219", "220", "221", "222", "223", "224", "225", "226", + "227", "228", "229", "230", "231", "232", "233", "234", "235", + "236", "237", "238", "239", "240", "241", "242", "243", "244", + "245", "246", "247", "248", "249", "250", "251", "252", "253", + "254", "255", "256", "257", "258", "259", "260", "261", "262", + "263", "264", "265", "266", "267", "268", "269", "270", "271", + "272", "273", "274", "275", "276", "277", "278", "279", "280", + "281", "282", "283", "284", "285", "286", "287", "288", "289", + "290", "291", "292", "293", "294", "295", "296", "297", "298", + "299", "300", "301", "302", "303", "304", "305", "306", "307", + "308", "309", "310", "311", "312", "313", "314", "315", "316", + "317", "318", "319", "320", "321", "322", "323", "324", "325", + "326", "327", "328", "329", "330", "331", "332", "333", "334", + "335", "336", "337", "338", "339", "340", "341", "342", "343", + "344", "345", "346", "347", "348", "349", "350", "351", "352", + "353", "354", "355", "356", "357", "358", "359", "360", "361", + "362", "363", "364", "365", "366", "367", "368", "369")) > > dicweib <- function(x,shape,scale,log=FALSE) { + if (is.matrix(x)) { + day1 <- x[,1] + day2 <- x[,2] + } else { + day1 <- x[1] + day2 <- x[2] + } + v <- log(pweibull(day2,shape,scale)-pweibull(day1,shape,scale)) + if (log) v else exp(v) + } > > GS2 <- transform(GobySurvival, + day1 = d1-1, + day2 = ifelse(d2==70,Inf,d2-1), + fexper=factor(exper)) > totmeansurv <- with(GS2,mean((d1+d2)/2)) > > mle2(cbind(day1,day2)~dicweib(exp(shape),exp(scale)), + parameters=list(scale~fexper+qual*density), + start=list(scale=log(totmeansurv),shape=0),data=GS2) Call: mle2(minuslogl = cbind(day1, day2) ~ dicweib(exp(shape), exp(scale)), start = list(scale = log(totmeansurv), shape = 0), data = GS2, parameters = list(scale ~ fexper + qual * density)) Coefficients: scale.(Intercept) scale.fexper2 scale.fexper3 scale.fexper4 1.950601011 -1.070739935 -0.767760213 -0.131513595 scale.fexper5 scale.qual scale.density scale.qual:density 0.004852567 -0.013727672 -0.219867981 0.012638159 shape -1.001618792 Log-likelihood: -443.06 There were 14 warnings (use warnings() to see them) > > proc.time() user system elapsed 2.800 1.028 3.756 bbmle/tests/eval.R0000644000176200001440000000327613013175522013556 0ustar liggesusers## I am experiencing difficulties with one of my modeling function (bbmle::mle2) ## which, like other modeling functions in R, uses match.call() to ## retrieve and save the original function call for future use. ## I'll describe the problem for bbmle and then show that I can ## provoke a similar problem with lm(). ## ============ ## PART I: mle2() library(bbmle) x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) ## The key is to call the modeling function from within another ## function which passes additional arguments via ... ff <- function(d,...) { mle2(y~dpois(lambda=ymean),start=list(ymean=mean(y)),data=d,...) } ff(d) try(ff(d,control=list(maxit=1000))) ## Error in call$control$parscale : ## object of type 'symbol' is not subsettable ## This happens when I try: ## call$control$parscale <- eval.parent(call$control$parscale) ## in 'normal' circumstances call$control and call$control$parscale ## are either NULL or well-specified ... ## Debugging mle2 shows that the results of match.call() are ## mle2(minuslogl = y ~ dpois(lambda = ymean), start = list(ymean = mean(y)), ## data = d, control = ..1) ## ============ ## PART II: lm() ## I can find a similar issue with lm(), although admittedly ## I have to work a bit harder/do something a little bit more ## obscure. L1 <- lm(y~1,data=d,tol=1e-6) L1$call ff2 <- function(d,...) { lm(y~1,data=d,...) } tt <- 1e-6 L2 <- ff2(d,tol=tt) L2$call try(update(L2,.~.+x)) ## Error in lm.fit(x, y, offset = offset, singular.ok = singular.ok, ...) : ## ..1 used in an incorrect context, no ... to look in ## similar issue in curve3d(). How does curve() work? bbmle/tests/prof_newmin.R0000644000176200001440000000037513072037374015156 0ustar liggesuserslibrary(bbmle) x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) ## uses default parameters of LL fit <- mle2(y~dpois(exp(loglam)), data=d, start=list(loglam=0),control=list(maxit=2)) pp <- profile(fit) bbmle/tests/optimx.Rout.save0000644000176200001440000000302613175476036015642 0ustar liggesusers R Under development (unstable) (2017-10-27 r73634) -- "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. Natural language support but running in an English locale 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(bbmle) Loading required package: stats4 > old_opt <- options(digits=3) > if (require(optimx)) { + x <- 0:10 + y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) + d <- data.frame(x,y) + + ## breaks, don't try this + ## optimx(fn=Lfn,par=c(15,6),method="Rvmmin") + + suppressWarnings(m1 <- mle2(minuslogl=y~dpois(lambda=ymax/(1+x/xhalf)), + start=list(ymax=15,xhalf=6),data=d, + optimizer="optimx", + method=c("BFGS","Nelder-Mead","CG"))) + + ## FIXME!! fails (although not with an error, because + ## errors are caught by profiling) due to npar now + ## being restricted to >1 in optimx 2012.05.24 ... + + suppressWarnings(head(as.data.frame(profile(m1)))) + detach("package:optimx") + } Loading required package: optimx > options(old_opt) > > proc.time() user system elapsed 5.852 0.188 13.617 bbmle/tests/startvals2.Rout.save0000644000176200001440000003257113013175522016421 0ustar liggesusers R Under development (unstable) (2014-05-14 r65609) -- "Unsuffered Consequences" Copyright (C) 2014 The R Foundation for Statistical Computing Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) Loading required package: stats4 > > ## fir data from emdbook package ... > firdata <- structure(list(TOTCONES = c(19, 42, 40, 68, 5, 0, 21, 114, 37, + 92, 84, 102, 98, 63, 9, 31, 35, 216, 27, 297, 36, 127, 23, 46, + 27, 66, 11, 20, 141, 3, 22, 39, 96, 206.5, 40, 231, 63.5, 202, + 54, 32, 107.5, 142.5, 82, 65, 153, 123, 131, 43, 98, 37, 34, + 10, 65, 35, 50, 19, 73, 33, 61, 9, 146, 0, 44, 42, 0, 61, 17, + 53, 27, 0, 74, 36, 28, 56, 46, 0, 15, 26, 46, 15, 105, 0, 62, + 24, 25, 41, 138, 77, 227.7, 28, 45, 57, 109, 28, 17, 91, 69, + 87, 10, 65, 50, 27, 30, 86, 119, 22, 8, 54, 104, 14, 16, 5, 53, + 40, 32, 114, 39, 37, 111, 226, 156, 42, 86, 94, 54, 1, 14, 44, + 108, 116.5, 14, 73, 3, 16, 87, 61, 48, 0, 17, 5, 88, 11, 133, + 121, 166, 171, 63, 23, 4, 51, 10, 14, 78, 47, 31, 42, 24, 42, + 55, 19, 63, 127, 9, 74, 120, 85, 51, 19, 131, 7, 23, 7, 9, 23, + 55, 48, 13, 2, 9, 3, 4, 16, 1, 88, 8, 27, 16, 184, 14, 22, 25, + 52, 2, 134, 81, 85, 3, 56, 17, 8, 10, 6, 69, 58, 1, 22, 3, 11, + 22, 2, 37, 8, 15, 61, 6, 18, 9, 109, 54, 4, 11, 30, 0, 0, 3, + 0, 16, 22, 9, 56, 17, 64, 38, 59, 37, 22, 41, 1, 22, 16, 17, + 4), DBH = c(9.4, 10.6, 7.7, 10.6, 8.7, 10.1, 8.1, 11.6, 10.1, + 13.3, 10, 13.4, 9.7, 7.4, 8.7, 8.6, 7.9, 14.2, 9.5, 15.9, 6, + 10.6, 7.3, 10.3, 8.4, 10.2, 13.8, 9.4, 8.1, 9.6, 7.3, 7.4, 10.3, + 13.4, 9.2, 13.9, 10.9, 17.4, 10.2, 8.2, 11.3, 16.1, 12.3, 8.3, + 12.4, 12.5, 11.3, 7.8, 11.6, 10, 7, 5.7, 7.7, 8.9, 8.5, 8.5, + 10.7, 10.2, 10.8, 9, 9.4, 7.6, 10.6, 10, 8, 7.4, 9.1, 6.7, 9.7, + 6.8, 8.6, 9.1, 6.3, 6.7, 10.9, 9.5, 9.9, 6.8, 9.8, 7.7, 12.1, + 8.2, 10, 9.6, 9.2, 8.2, 11.3, 11.6, 15.7, 9.1, 8.9, 8.7, 11, + 6.6, 7.1, 9, 12.4, 12.1, 7.5, 9, 8, 10.9, 9.2, 10.1, 12.1, 7, + 6.8, 8.6, 11.6, 6.6, 6.7, 6.8, 8.5, 7.8, 7.9, 9.8, 6.2, 6.7, + 15.4, 9.2, 12.9, 6.7, 9.6, 8.4, 8, 8.7, 6.7, 9.2, 9.5, 8, 5.5, + 8.5, 5.7, 5.6, 8, 6.5, 9.6, 6.1, 7.9, 5.9, 11, 8.2, 12.8, 12.8, + 12.5, 13.7, 11.8, 6.3, 6.3, 8.2, 6.2, 6.7, 9.8, 9.4, 6.7, 6, + 4.9, 9.6, 7.5, 8.4, 7.4, 9.9, 7.4, 9.5, 13.9, 6.9, 9.4, 7.4, + 12.8, 5.8, 7.2, 5.6, 6.9, 11.3, 9.6, 6.8, 6.9, 6.6, 4.8, 4.4, + 4.8, 8.5, 7, 8.7, 6.6, 8.6, 5.3, 10.4, 6.4, 5.4, 8.2, 5.5, 6.2, + 14.7, 10.5, 14.4, 5.8, 6.1, 6.2, 6.2, 7.2, 6, 10.6, 8.7, 7.5, + 7.3, 5.2, 6.9, 6.6, 6.7, 5.2, 6.9, 7.5, 9, 5.9, 6.5, 6.6, 9.8, + 4.7, 4.2, 4.8, 6.7, 6.5, 6.7, 5.9, 5.4, 6.9, 6.5, 6, 12, 7.5, + 6.4, 7.3, 7.3, 6.4, 7, 5.9, 9.1, 6.7, 4, 6.5, 4.7), WAVE_NON = structure(c(1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, + 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, + 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, + 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, + 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, + 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, + 2L), .Label = c("n", "w"), class = "factor"), logcones = c(2.99573227355399, + 3.76120011569356, 3.71357206670431, 4.23410650459726, 1.79175946922805, + 0, 3.09104245335832, 4.74493212836325, 3.63758615972639, 4.53259949315326, + 4.44265125649032, 4.63472898822964, 4.59511985013459, 4.15888308335967, + 2.30258509299405, 3.46573590279973, 3.58351893845611, 5.37989735354046, + 3.3322045101752, 5.6970934865054, 3.61091791264422, 4.85203026391962, + 3.17805383034795, 3.85014760171006, 3.3322045101752, 4.20469261939097, + 2.484906649788, 3.04452243772342, 4.95582705760126, 1.38629436111989, + 3.13549421592915, 3.68887945411394, 4.57471097850338, 5.33513133967075, + 3.71357206670431, 5.44673737166631, 4.16666522380173, 5.31320597904179, + 4.00733318523247, 3.49650756146648, 4.68675017298051, 4.96633503519968, + 4.4188406077966, 4.18965474202643, 5.03695260241363, 4.82028156560504, + 4.88280192258637, 3.78418963391826, 4.59511985013459, 3.63758615972639, + 3.55534806148941, 2.39789527279837, 4.18965474202643, 3.58351893845611, + 3.93182563272433, 2.99573227355399, 4.30406509320417, 3.52636052461616, + 4.12713438504509, 2.30258509299405, 4.99043258677874, 0, 3.80666248977032, + 3.76120011569356, 0, 4.12713438504509, 2.89037175789616, 3.98898404656427, + 3.3322045101752, 0, 4.31748811353631, 3.61091791264422, 3.36729582998647, + 4.04305126783455, 3.85014760171006, 0, 2.77258872223978, 3.29583686600433, + 3.85014760171006, 2.77258872223978, 4.66343909411207, 0, 4.14313472639153, + 3.2188758248682, 3.25809653802148, 3.73766961828337, 4.93447393313069, + 4.35670882668959, 5.43241110102874, 3.36729582998647, 3.8286413964891, + 4.06044301054642, 4.70048036579242, 3.36729582998647, 2.89037175789616, + 4.52178857704904, 4.24849524204936, 4.47733681447821, 2.39789527279837, + 4.18965474202643, 3.93182563272433, 3.3322045101752, 3.43398720448515, + 4.46590811865458, 4.78749174278205, 3.13549421592915, 2.19722457733622, + 4.00733318523247, 4.65396035015752, 2.70805020110221, 2.83321334405622, + 1.79175946922805, 3.98898404656427, 3.71357206670431, 3.49650756146648, + 4.74493212836325, 3.68887945411394, 3.63758615972639, 4.71849887129509, + 5.4249500174814, 5.05624580534831, 3.76120011569356, 4.46590811865458, + 4.55387689160054, 4.00733318523247, 0.693147180559945, 2.70805020110221, + 3.80666248977032, 4.69134788222914, 4.76643833358421, 2.70805020110221, + 4.30406509320417, 1.38629436111989, 2.83321334405622, 4.47733681447821, + 4.12713438504509, 3.89182029811063, 0, 2.89037175789616, 1.79175946922805, + 4.48863636973214, 2.484906649788, 4.89783979995091, 4.80402104473326, + 5.11799381241676, 5.14749447681345, 4.15888308335967, 3.17805383034795, + 1.6094379124341, 3.95124371858143, 2.39789527279837, 2.70805020110221, + 4.36944785246702, 3.87120101090789, 3.46573590279973, 3.76120011569356, + 3.2188758248682, 3.76120011569356, 4.02535169073515, 2.99573227355399, + 4.15888308335967, 4.85203026391962, 2.30258509299405, 4.31748811353631, + 4.79579054559674, 4.45434729625351, 3.95124371858143, 2.99573227355399, + 4.88280192258637, 2.07944154167984, 3.17805383034795, 2.07944154167984, + 2.30258509299405, 3.17805383034795, 4.02535169073515, 3.89182029811063, + 2.63905732961526, 1.09861228866811, 2.30258509299405, 1.38629436111989, + 1.6094379124341, 2.83321334405622, 0.693147180559945, 4.48863636973214, + 2.19722457733622, 3.3322045101752, 2.83321334405622, 5.22035582507832, + 2.70805020110221, 3.13549421592915, 3.25809653802148, 3.97029191355212, + 1.09861228866811, 4.90527477843843, 4.40671924726425, 4.45434729625351, + 1.38629436111989, 4.04305126783455, 2.89037175789616, 2.19722457733622, + 2.39789527279837, 1.94591014905531, 4.24849524204936, 4.07753744390572, + 0.693147180559945, 3.13549421592915, 1.38629436111989, 2.484906649788, + 3.13549421592915, 1.09861228866811, 3.63758615972639, 2.19722457733622, + 2.77258872223978, 4.12713438504509, 1.94591014905531, 2.94443897916644, + 2.30258509299405, 4.70048036579242, 4.00733318523247, 1.6094379124341, + 2.484906649788, 3.43398720448515, 0, 0, 1.38629436111989, 0, + 2.83321334405622, 3.13549421592915, 2.30258509299405, 4.04305126783455, + 2.89037175789616, 4.17438726989564, 3.66356164612965, 4.0943445622221, + 3.63758615972639, 3.13549421592915, 3.73766961828337, 0.693147180559945, + 3.13549421592915, 2.83321334405622, 2.89037175789616, 1.6094379124341 + )), .Names = c("TOTCONES", "DBH", "WAVE_NON", "logcones"), row.names = c(1L, + 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, + 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, + 29L, 30L, 31L, 32L, 33L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, + 43L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 52L, 53L, 54L, 55L, + 56L, 58L, 59L, 60L, 61L, 62L, 63L, 64L, 65L, 66L, 67L, 68L, 69L, + 70L, 71L, 72L, 73L, 74L, 75L, 76L, 78L, 79L, 80L, 81L, 82L, 83L, + 84L, 85L, 86L, 87L, 88L, 89L, 90L, 91L, 92L, 93L, 94L, 95L, 96L, + 97L, 98L, 99L, 100L, 101L, 102L, 103L, 104L, 105L, 106L, 107L, + 108L, 109L, 110L, 111L, 112L, 113L, 118L, 119L, 120L, 121L, 122L, + 123L, 124L, 126L, 127L, 128L, 129L, 130L, 131L, 132L, 133L, 134L, + 135L, 136L, 137L, 138L, 139L, 140L, 142L, 144L, 145L, 146L, 147L, + 148L, 149L, 150L, 151L, 154L, 155L, 157L, 159L, 160L, 168L, 169L, + 170L, 171L, 172L, 173L, 174L, 175L, 176L, 177L, 178L, 179L, 180L, + 181L, 184L, 185L, 186L, 187L, 189L, 190L, 193L, 198L, 247L, 272L, + 273L, 275L, 276L, 277L, 278L, 280L, 281L, 282L, 283L, 284L, 285L, + 286L, 287L, 288L, 289L, 290L, 291L, 292L, 293L, 294L, 295L, 296L, + 297L, 298L, 299L, 300L, 301L, 303L, 304L, 305L, 306L, 307L, 308L, + 309L, 310L, 311L, 313L, 314L, 315L, 316L, 319L, 320L, 321L, 322L, + 323L, 325L, 326L, 327L, 330L, 331L, 332L, 337L, 338L, 339L, 340L, + 341L, 342L, 343L, 344L, 345L, 346L, 347L, 348L, 349L, 350L, 351L, + 352L, 353L, 357L, 358L, 360L, 366L), na.action = structure(c(34L, + 57L, 77L, 114L, 115L, 116L, 117L, 125L, 141L, 143L, 152L, 153L, + 156L, 158L, 161L, 162L, 163L, 164L, 165L, 166L, 167L, 182L, 183L, + 188L, 191L, 192L, 194L, 195L, 196L, 197L, 199L, 200L, 201L, 202L, + 203L, 204L, 205L, 206L, 207L, 208L, 209L, 210L, 211L, 212L, 213L, + 214L, 215L, 216L, 217L, 218L, 219L, 220L, 221L, 222L, 223L, 224L, + 225L, 226L, 227L, 228L, 229L, 230L, 231L, 232L, 233L, 234L, 235L, + 236L, 237L, 238L, 239L, 240L, 241L, 242L, 243L, 244L, 245L, 246L, + 248L, 249L, 250L, 251L, 252L, 253L, 254L, 255L, 256L, 257L, 258L, + 259L, 260L, 261L, 262L, 263L, 264L, 265L, 266L, 267L, 268L, 269L, + 270L, 271L, 274L, 279L, 302L, 312L, 317L, 318L, 324L, 328L, 329L, + 333L, 334L, 335L, 336L, 354L, 355L, 356L, 359L, 361L, 362L, 363L, + 364L, 365L, 367L, 368L, 369L, 370L, 371L), .Names = c("34", "57", + "77", "114", "115", "116", "117", "125", "141", "143", "152", + "153", "156", "158", "161", "162", "163", "164", "165", "166", + "167", "182", "183", "188", "191", "192", "194", "195", "196", + "197", "199", "200", "201", "202", "203", "204", "205", "206", + "207", "208", "209", "210", "211", "212", "213", "214", "215", + "216", "217", "218", "219", "220", "221", "222", "223", "224", + "225", "226", "227", "228", "229", "230", "231", "232", "233", + "234", "235", "236", "237", "238", "239", "240", "241", "242", + "243", "244", "245", "246", "248", "249", "250", "251", "252", + "253", "254", "255", "256", "257", "258", "259", "260", "261", + "262", "263", "264", "265", "266", "267", "268", "269", "270", + "271", "274", "279", "302", "312", "317", "318", "324", "328", + "329", "333", "334", "335", "336", "354", "355", "356", "359", + "361", "362", "363", "364", "365", "367", "368", "369", "370", + "371"), class = "omit"), class = "data.frame") > > > m1 <- mle2(logcones ~ dnorm(i + slope*log(DBH), sd), + parameters= list(i ~ WAVE_NON-1, slope ~ WAVE_NON-1), + data = firdata, + start = list(i=c(-2,-2),slope=c(2.5,2.5),sd=1)) Warning message: In calc_mle2_function(minuslogl, parameters, start = start, parnames = parnames, : using dnorm() with sd implicitly set to 1 is rarely sensible > > ancovafun = function(i1,i2,slope1,slope2,sigma) { + int = c(i1,i2)[WAVE_NON] + slope = c(slope1,slope2)[WAVE_NON] + Y.pred = int+ slope*log(DBH) + r <- -sum(dnorm(logcones,mean=Y.pred,sd=sigma,log=TRUE)) + ## cat(i1,i2,slope1,slope2,sigma,r,"\n") + r + } > m2 <- mle2(ancovafun,start=list(i1=-2,i2=-2,slope1=2.5,slope2=2.5,sigma=1), + data=firdata) > > > m3 <- mle2(logcones ~ dnorm(mu, sd), + parameters= list(mu ~ WAVE_NON*log(DBH)), + data = firdata, + start = list(mu=1,sd=1)) Warning messages: 1: In calc_mle2_function(minuslogl, parameters, start = start, parnames = parnames, : using dnorm() with sd implicitly set to 1 is rarely sensible 2: In dnorm(x = c(2.99573227355399, 3.76120011569356, 3.71357206670431, : NaNs produced 3: In dnorm(x = c(2.99573227355399, 3.76120011569356, 3.71357206670431, : NaNs produced 4: In dnorm(x = c(2.99573227355399, 3.76120011569356, 3.71357206670431, : NaNs produced 5: In dnorm(x = c(2.99573227355399, 3.76120011569356, 3.71357206670431, : NaNs produced > > stopifnot(all.equal(AIC(m1),AIC(m2),AIC(m3))) > > ## m4 <- mle2(logcones ~ dnorm(i + slope*log(DBH), sd), > ## parameters= list(i ~ WAVE_NON-1, slope ~ WAVE_NON-1), > ## data = firdata, > ## start = c(-2,-2,2.5,2.5,sd=1)) > > > proc.time() user system elapsed 1.112 1.364 2.438 bbmle/tests/testderiv.R0000644000176200001440000000327013013175522014632 0ustar liggesuserslibrary(bbmle) old_opt <- options(digits=3) ## source("../R/dists.R") ## source("../R/mle.R") ## an attempt to sketch out by hand ## how one would derive an analytic ## gradient function for a formula-specified ## likelihood and use it ... ## chain rule should be: ## deriv(probability distribution)/[prob params] * ## deriv([prob params])/[model params] * ## {OPTIONAL} deriv([model params])/[linear model params] set.seed(1001) x <- rbinom(50,size=10,prob=0.4) suppressWarnings(mle2(x~dbinom(prob=p,size=10),start=list(p=0.3),data=data.frame(x))) ## step 1: construct gradient function for simplest example f <- sbinom(prob=0.1,size=1)$formula d1 <- deriv(parse(text=f),"prob",function.arg=TRUE) ## step 2: chain rule step #1 mle2(x~dbinom(prob=plogis(logitp),size=10),start=list(logitp=-1), data=data.frame(x)) f <- sbinom(prob=NA,size=NA)$formula ## note: plogis is not in derivatives table!! ## will need to extend by text substitution ... gsub("plogis(\\([^)]+\\))", "(1+exp(\\1))^(-1)", "plogis(logitprob)") f2 <- gsub("plogis(\\([^)]+\\))", "(1+exp(\\1))^(-1)","plogis(logitp)") ## start with a single parameter (ignore 'size') fun1 <- deriv(parse(text=f),c("prob"),function.arg=TRUE) fun2 <- deriv(parse(text=f2),"logitp", function.arg=TRUE) size <- 10 a1 <- attr(fun2(logitp=0),"gradient") a2 <- attr(fun1(prob=plogis(0)),"gradient") ## compute gradient by variable and sum colSums(apply(a1,2,"*",a2)) ## rep(a1,length(x))*a2 ## eventually we will want to do something tricky to ## 'memoise' results because optim() requires the ## objective function and gradient to be computed ## *separately*. Not worth worrying about this in the ## first pass! options(old_opt) bbmle/tests/profbound.Rout.save0000644000176200001440000000310513013175522016301 0ustar liggesusers R Under development (unstable) (2013-08-18 r63609) -- "Unsuffered Consequences" Copyright (C) 2013 The R Foundation for Statistical Computing Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) Loading required package: stats4 > old_opt <- options(digits=3) > x <- 0:10 > y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) > d <- data.frame(x,y) > > fit0 <- mle2(y~dpois(lambda=ymean),start=list(ymean=mean(y)),data=d, + method="L-BFGS-B",lower=10) > > stopifnot(is.na(confint(fit0)[1])) > > fit1 <- mle2(y~dpois(lambda=exp(a+b*x)),start=list(a=0,b=2),data=d, + method="L-BFGS-B",lower=-0.2) > > suppressWarnings(confint(fit1)) 2.5 % 97.5 % a 2.81 3.3579 b NA -0.0944 > > fit2 <- mle2(y~dpois(lambda=exp(a+b*x)),start=list(a=0,b=2),data=d, + method="L-BFGS-B") > > pp <- profile(fit2,prof.lower=-0.2) > stopifnot(min(subset(as.data.frame(pp),param=="b")$par.vals.b)==-0.2) > ## note that b does go below -0.2 when profiling a ... > options(old_opt) > > proc.time() user system elapsed 1.084 0.820 3.943 bbmle/tests/testenv.R0000644000176200001440000000145213013176345014315 0ustar liggesuserslibrary(bbmle) f <- function() { maxit <- 1000 d <- data.frame(x=0:10, y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) mle2(y~dpois(lambda=exp(lymax)/(1+x/exp(lhalf))), start=list(lymax=0,lhalf=0), data=d, control=list(maxit=maxit), parameters=list(lymax~1,lhalf~1)) } f2 <- function(method="BFGS") { d <- data.frame(x=0:10, y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) mle2(y~dpois(lambda=exp(lymax)/(1+x/exp(lhalf))), start=list(lymax=0,lhalf=0), data=d, method=method, parameters=list(lymax~1,lhalf~1)) } m1 <- f() p <- profile(m1) ## FIXME: check results (need to save in an environment-friendly way!) print(head(as.data.frame(p)),digits=3) m2 <- f2() p2 <- profile(m2) print(head(as.data.frame(p2)),digits=3) bbmle/tests/predict.R0000644000176200001440000000174113013175522014254 0ustar liggesuserslibrary(bbmle) set.seed(1002) lymax <- c(0,2) lhalf <- 0 x <- runif(200) g <- factor(rep(c("a","b"),each=100)) y <- rnbinom(200,mu=exp(lymax[g])/(1+x/exp(lhalf)),size=2) d <- data.frame(x,g,y) fit3 <- mle2(y~dnbinom(mu=exp(lymax)/(1+x/exp(lhalf)),size=exp(logk)), parameters=list(lymax~g), start=list(lymax=0,lhalf=0,logk=0),data=d) plot(y~x,col=g) ## true curves curve(exp(0)/(1+x/exp(0)),add=TRUE) curve(exp(2)/(1+x/exp(0)),col=2,add=TRUE) xvec = seq(0,1,length=100) lines(xvec,predict(fit3,newdata=list(g=factor(rep("a",100),levels=c("a","b")), x = xvec)),col=1,lty=2) lines(xvec,predict(fit3,newdata=list(g=factor(rep("b",100),levels=c("a","b")), x = xvec)),col=2,lty=2) p1 = predict(fit3) ## manual prediction p2A = with(as.list(coef(fit3)),exp(`lymax.(Intercept)`)/(1+x[1:100]/exp(lhalf))) p2B = with(as.list(coef(fit3)),exp(`lymax.(Intercept)`+lymax.gb)/(1+x[101:200]/exp(lhalf))) p2 = c(p2A,p2B) all(p1==p2) bbmle/tests/makesavefiles0000644000176200001440000000014613013175522015237 0ustar liggesusersfor i in `echo *.R | sed -e "s/\.R//g"`; do R CMD BATCH --vanilla $i.R; mv $i.Rout $i.Rout.save; done bbmle/tests/ICtab.Rout.save0000644000176200001440000000320113175500226015264 0ustar liggesusers R Under development (unstable) (2017-10-27 r73634) -- "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. Natural language support but running in an English locale 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. [Previously saved workspace restored] > library(bbmle) Loading required package: stats4 > > set.seed(101) > z = rpois(100,lambda=5) > > m1 = mle2(z~dpois(lambda=L),start=list(L=4),data=data.frame(z)) > > ICtab(m1,type="qAICc",dispersion=1.2,nobs=100) dqAICc df m1 0 1 > > m2 = glm(z~1,family=poisson) > qAICc(m2,nobs=100,dispersion=2) [1] 226.1823 > > ## test that dAIC ignores > m3 <- glm(z~1,family=quasipoisson) > aa <- AICtab(m1,m2,m3,weights=TRUE) > stopifnot(any(!is.na(aa$dAIC)), + any(!is.na(aa$weight))) > > set.seed(101) > x <- rnorm(100) > dd <- data.frame(y=rnorm(100,2+3*x,sd=1),x) > m4A <- lm(y~x,dd) > m4B <- mle2(y~dnorm(mean=a+b*x,sd=exp(logsd)), + data=dd, + start=list(a=1,b=1,logsd=0)) > ## cosmetic differences only > stopifnot(all.equal(AIC(m4A,m4B)[,"AIC"], + AIC(m4B,m4A)[,"AIC"])) > > > proc.time() user system elapsed 1.920 0.208 2.679 bbmle/tests/order.Rout.save0000644000176200001440000000420513013175522015420 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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. > set.seed(1001) > x <- runif(10) > y <- 1000+x+rnorm(10,sd=0.1) > d <- data.frame(x,y) > > library(bbmle) > ## warning > m1 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=900,b=1,s=log(0.1)), + control=list(parscale=c(1000,1,0.1)),data=d) Warning message: In fix_order(call$control$parscale, "parscale") : parscale not named: rearranging to match 'start' > > m2 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=900,b=1,s=log(0.1)), + control=list(parscale=c(b=1,a=1000,s=0.1)),data=d) > > m3 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), + method="L-BFGS-B",lower=c(a=1100,b=2,s=-Inf),data=d) Warning message: In mle2(y ~ dnorm(a + b * x, sd = exp(s)), start = list(a = 1, b = 1, : some parameters are on the boundary: variance-covariance calculations based on Hessian may be unreliable > > ## warning > m4 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(b=1,a=1200,s=log(0.1)), + method="L-BFGS-B",lower=c(2,1100,0.1),data=d) Warning messages: 1: In fix_order(call$lower, "lower bounds", -Inf) : lower bounds not named: rearranging to match 'start' 2: In mle2(y ~ dnorm(a + b * x, sd = exp(s)), start = list(b = 1, a = 1200, : some parameters are on the boundary: variance-covariance calculations based on Hessian may be unreliable > > c1 = coef(m3)[c("a","b","s")] > c2 = coef(m4)[c("a","b","s")] > if (!all(abs(c1-c2)<1e-7)) stop("mismatch") > > proc.time() user system elapsed 1.012 1.024 1.896 bbmle/tests/BIC.R0000644000176200001440000000041213013175522013211 0ustar liggesusersrequire(bbmle) x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) fit <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), start=list(ymax=25,xhalf=3),data=d) fit2 <- mle2(y~dpois(lambda=(x+1)*slope), start=list(slope=1),data=d) BIC(fit) BIC(fit,fit2) bbmle/tests/testderiv.Rout.save0000644000176200001440000000576713013175522016334 0ustar liggesusers R Under development (unstable) (2012-12-14 r61321) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) Loading required package: stats4 > old_opt <- options(digits=3) > ## source("../R/dists.R") > ## source("../R/mle.R") > > ## an attempt to sketch out by hand > ## how one would derive an analytic > ## gradient function for a formula-specified > ## likelihood and use it ... > > ## chain rule should be: > > ## deriv(probability distribution)/[prob params] * > ## deriv([prob params])/[model params] * > ## {OPTIONAL} deriv([model params])/[linear model params] > > set.seed(1001) > x <- rbinom(50,size=10,prob=0.4) > suppressWarnings(mle2(x~dbinom(prob=p,size=10),start=list(p=0.3),data=data.frame(x))) Call: mle2(minuslogl = x ~ dbinom(prob = p, size = 10), start = list(p = 0.3), data = data.frame(x)) Coefficients: p 0.396 Log-likelihood: -97.2 > > ## step 1: construct gradient function for simplest example > f <- sbinom(prob=0.1,size=1)$formula > > d1 <- deriv(parse(text=f),"prob",function.arg=TRUE) > > ## step 2: chain rule step #1 > mle2(x~dbinom(prob=plogis(logitp),size=10),start=list(logitp=-1), + data=data.frame(x)) Call: mle2(minuslogl = x ~ dbinom(prob = plogis(logitp), size = 10), start = list(logitp = -1), data = data.frame(x)) Coefficients: logitp -0.422 Log-likelihood: -97.2 > > f <- sbinom(prob=NA,size=NA)$formula > > ## note: plogis is not in derivatives table!! > ## will need to extend by text substitution ... > gsub("plogis(\\([^)]+\\))", + "(1+exp(\\1))^(-1)", + "plogis(logitprob)") [1] "(1+exp((logitprob)))^(-1)" > > f2 <- gsub("plogis(\\([^)]+\\))", + "(1+exp(\\1))^(-1)","plogis(logitp)") > > ## start with a single parameter (ignore 'size') > fun1 <- deriv(parse(text=f),c("prob"),function.arg=TRUE) > fun2 <- deriv(parse(text=f2),"logitp", function.arg=TRUE) > > size <- 10 > a1 <- attr(fun2(logitp=0),"gradient") > a2 <- attr(fun1(prob=plogis(0)),"gradient") > > ## compute gradient by variable and sum > colSums(apply(a1,2,"*",a2)) logitp 52 > ## rep(a1,length(x))*a2 > > > ## eventually we will want to do something tricky to > ## 'memoise' results because optim() requires the > ## objective function and gradient to be computed > ## *separately*. Not worth worrying about this in the > ## first pass! > options(old_opt) > > proc.time() user system elapsed 0.640 1.272 1.801 bbmle/tests/controleval.Rout.save0000644000176200001440000000461613013175522016643 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) Loading required package: bbmle > mle2a <- function(...) + mle2(...) > > mle2b <- function(...) + mle2a(...) > > ## some data > d <- data.frame(x=0:10,y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) > ym <- mean(d$y) > > ## some fits > > (fit0 <- mle2(y~dpois(lambda=ymean),start=list(ymean=ym),data=d)) # okay Call: mle2(minuslogl = y ~ dpois(lambda = ymean), start = list(ymean = ym), data = d) Coefficients: ymean 11.54545 Log-likelihood: -42.73 > predict(fit0) [1] 11.54545 > (fit0.2 <- mle2(y~dpois(lambda=ymean),start=list(ymean=ym),data=d, + control=list(parscale=2))) # okay Call: mle2(minuslogl = y ~ dpois(lambda = ymean), start = list(ymean = ym), data = d, control = list(parscale = 2)) Coefficients: ymean 11.54545 Log-likelihood: -42.73 > predict(fit0.2) [1] 11.54545 > (fit1 <- mle2a(y~dpois(lambda=ymean),start=list(ymean=ym),data=d)) # okay Call: mle2(minuslogl = ..1, start = ..2, data = ..3) Coefficients: ymean 11.54545 Log-likelihood: -42.73 > (fit1.2 <- mle2a(y~dpois(lambda=ymean),start=list(ymean=ym),data=d, + control=list(parscale=2))) # FAILS Call: mle2(minuslogl = ..1, start = ..2, data = ..3, control = ..4) Coefficients: ymean 11.54545 Log-likelihood: -42.73 > (fit1.3 <- mle2b(y~dpois(lambda=ymean),start=list(ymean=ym),data=d, + control=list(parscale=2))) # FAILS Call: mle2(minuslogl = ..1, start = ..2, data = ..3, control = ..4) Coefficients: ymean 11.54545 Log-likelihood: -42.73 > > ### NOT WORKING: > if (FALSE) { + predict(fit1) + predict(fit1.2) + predict(fit1.3) + } > > proc.time() user system elapsed 0.736 1.076 1.638 bbmle/tests/optimizers.Rout.save0000644000176200001440000000365113013175522016516 0ustar liggesusers R Under development (unstable) (2013-10-24 r64106) -- "Unsuffered Consequences" Copyright (C) 2013 The R Foundation for Statistical Computing Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) Loading required package: stats4 > old_opts <- options(digits=3) > x <- 0:10 > y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) > d <- data.frame(x,y) > suppressWarnings(fits <- lapply(c("optim","nlm","nlminb"), + mle2, + minuslogl=y~dpois(lambda=ymax/(1+x/xhalf)), + start=list(ymax=15,xhalf=6),data=d, + method="Nelder-Mead")) ## 'method' is ignored by nlm()/nlminb() > > sapply(fits,coef) [,1] [,2] [,3] ymax 25.00 25.00 25.00 xhalf 3.06 3.06 3.06 > sapply(fits,logLik) [1] -28.6 -28.6 -28.6 > > (fit2 <- mle2(y~dpois(lambda=25/(1+x/xhalf)), + start=list(xhalf=5),data=d, + lower=2,upper=8, + optimizer="optimize")) Call: mle2(minuslogl = y ~ dpois(lambda = 25/(1 + x/xhalf)), start = list(xhalf = 5), optimizer = "optimize", data = d, lower = 2, upper = 8) Coefficients: xhalf 3.06 Log-likelihood: -28.6 > > ## gives error referring to 'interval' rather than 'upper'/'lower' > ## (fit2 <- mle2(y~dpois(lambda=25/(1+x/xhalf)), > ## start=list(xhalf=5), > ## optimizer="optimize")) > options(old_opts) > > proc.time() user system elapsed 0.788 1.212 2.049 bbmle/tests/optimizers.R0000644000176200001440000000143713013175522015031 0ustar liggesuserslibrary(bbmle) old_opts <- options(digits=3) x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) suppressWarnings(fits <- lapply(c("optim","nlm","nlminb"), mle2, minuslogl=y~dpois(lambda=ymax/(1+x/xhalf)), start=list(ymax=15,xhalf=6),data=d, method="Nelder-Mead")) ## 'method' is ignored by nlm()/nlminb() sapply(fits,coef) sapply(fits,logLik) (fit2 <- mle2(y~dpois(lambda=25/(1+x/xhalf)), start=list(xhalf=5),data=d, lower=2,upper=8, optimizer="optimize")) ## gives error referring to 'interval' rather than 'upper'/'lower' ## (fit2 <- mle2(y~dpois(lambda=25/(1+x/xhalf)), ## start=list(xhalf=5), ## optimizer="optimize")) options(old_opts) bbmle/tests/update.R0000644000176200001440000000063613013175522014106 0ustar liggesuserslibrary(bbmle) x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) oldopts <- options(warn=-1,digits=3) ## ignore warnings m1 <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), start=list(ymax=1,xhalf=1),data=d) m1 y2 <- c(26, 17, 10, 15, 20, 5, 9, 8, 5, 4, 8) d2 <- data.frame(x,y=y2) m2 <- update(m1,data=d2) m2 m3 <- update(m1,.~dpois(lambda=c),start=list(c=5)) m3 options(oldopts) bbmle/tests/methods.R0000644000176200001440000000125413013175522014264 0ustar liggesuserslibrary(bbmle) x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) LL <- function(ymax=15, xhalf=6) -sum(stats::dpois(y, lambda=ymax/(1+x/xhalf), log=TRUE)) options(digits=3) mfit0 <- mle2(y~dpois(lambda=exp(interc)), start=list(interc=log(mean(y))),data=d) mfit1 <- mle2(y~dpois(lambda=exp(loglambda)), start=list(loglambda=log(mean(y))),data=d) coef(mfit0) residuals(mfit0) AIC(mfit0) BIC(mfit0) vcov(mfit0) ## fitted(mfit0) ## fails, looks for default value predict(mfit0) ## FIXME: doesn't expand properly (need implicit lambda~1 formula??) set.seed(1001) simulate(mfit0) anova(mfit0,mfit1) summary(mfit0) summary(mfit1) bbmle/tests/startvals.Rout.save0000644000176200001440000000363613013175522016337 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) > > ## copied from emdbook > dbetabinom <- function (x, prob, size, theta, shape1, shape2, log = FALSE) + { + if (missing(prob) && !missing(shape1) && !missing(shape2)) { + prob = shape1/(shape1 + shape2) + theta = shape1 + shape2 + } + v <- lchoose(size, x) - lbeta(theta * (1 - prob), theta * + prob) + lbeta(size - x + theta * (1 - prob), x + theta * + prob) + if (log) + v + else exp(v) + } > > ss <- data.frame(taken=c(0,1,2,5),available=c(5,5,5,5), + dist=rep(1,4)) > > SP.bb=mle2(taken~dbetabinom(prob,theta,size=available), + start=list(prob=0.5,theta=1),data=ss) Warning messages: 1: In lbeta(theta * (1 - prob), theta * prob) : NaNs produced 2: In lbeta(size - x + theta * (1 - prob), x + theta * prob) : NaNs produced > SP.bb.dist=mle2(taken~dbetabinom(prob,size=available,theta), + parameters=list(prob~dist-1,theta~dist-1), + start=as.list(coef(SP.bb)),data=ss) > > SP.bb.dist2=mle2(taken~dbetabinom(prob,size=available,theta), + parameters=list(prob~dist - 1,theta~dist - 1), + start=as.list(coef(SP.bb)),data=ss) > > > proc.time() user system elapsed 0.808 1.072 1.743 bbmle/tests/binomtest1.Rout.save0000644000176200001440000000444013013175522016373 0ustar liggesusers R Under development (unstable) (2012-12-14 r61321) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) Loading required package: stats4 > > funcresp <- + structure(list(Initial = as.integer(c(5, 5, 10, 10, 15, 15, 20, + 20, 30, 30, 50, 50, 75, 75, 100, 100)), Killed = as.integer(c(1, + 2, 5, 6, 10, 9, 7, 10, 11, 15, 5, 21, 32, 18, 25, 35))), .Names = c("Initial", + "Killed"), class = "data.frame", row.names = c("1", "2", "3", + "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", + "16")) > > binomNLL2 = function(p) { + a = p[1] + h = p[2] + ## cat(a,h,"\n") + p = a/(1+a*h*N) + -sum(dbinom(k,prob=p,size=N,log=TRUE)) + } > > N=0; k=0 > parnames(binomNLL2) = c("a","h") > m2a = mle2(binomNLL2,start=c(a=0.5,h=0.0125), + data=with(funcresp,list(N=Initial,k=Killed))) > p1a = profile(m2a) There were 50 or more warnings (use warnings() to see the first 50) > c2a = print(confint(p1a),digits=3) 2.5 % 97.5 % a 0.40250 0.6825 h 0.00699 0.0264 > > binomNLL2b = function(p,N,k) { + a = p[1] + h = p[2] + ## cat(a,h,"\n") + p = a/(1+a*h*N) + -sum(dbinom(k,prob=p,size=N,log=TRUE)) + } > parnames(binomNLL2b) = c("a","h") > m2b = mle2(binomNLL2,start=c(a=0.5,h=0.0125), + data=with(funcresp,list(N=Initial,k=Killed))) > c2b = confint(m2b) There were 50 or more warnings (use warnings() to see the first 50) > > N=funcresp$Initial; k=funcresp$Killed > m2c = mle2(binomNLL2,start=c(a=0.5,h=0.0125)) > c2c = confint(m2c) There were 50 or more warnings (use warnings() to see the first 50) > print(c2c,digits=3) 2.5 % 97.5 % a 0.40250 0.6825 h 0.00699 0.0264 > > > proc.time() user system elapsed 2.332 0.972 3.180 bbmle/tests/ICtab.R0000644000176200001440000000130413175477626013622 0ustar liggesuserslibrary(bbmle) set.seed(101) z = rpois(100,lambda=5) m1 = mle2(z~dpois(lambda=L),start=list(L=4),data=data.frame(z)) ICtab(m1,type="qAICc",dispersion=1.2,nobs=100) m2 = glm(z~1,family=poisson) qAICc(m2,nobs=100,dispersion=2) ## test that dAIC ignores m3 <- glm(z~1,family=quasipoisson) aa <- AICtab(m1,m2,m3,weights=TRUE) stopifnot(any(!is.na(aa$dAIC)), any(!is.na(aa$weight))) set.seed(101) x <- rnorm(100) dd <- data.frame(y=rnorm(100,2+3*x,sd=1),x) m4A <- lm(y~x,dd) m4B <- mle2(y~dnorm(mean=a+b*x,sd=exp(logsd)), data=dd, start=list(a=1,b=1,logsd=0)) ## cosmetic differences only stopifnot(all.equal(AIC(m4A,m4B)[,"AIC"], AIC(m4B,m4A)[,"AIC"])) bbmle/tests/grtest1.Rout.save0000644000176200001440000000243713071425264015710 0ustar liggesusers R Under development (unstable) (2017-02-13 r72168) -- "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. Natural language support but running in an English locale 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. > ## from Eric Weese > library(bbmle) Loading required package: stats4 > f <- function(x=2,a=1) x^2 - a > f.g <- function(x,a) 2*x > f.g2 <- function(x,a) c(2*x,0) > options(digits=3) > m1 <- mle2(f,fixed=list(a=1)) > m2 <- mle2(f,gr=f.g,fixed=list(a=1)) > m3 <- mle2(f,gr=f.g2,fixed=list(a=1)) > stopifnot(all.equal(coef(m1),coef(m2))) > stopifnot(all.equal(coef(m1),coef(m3))) > tt <- function(x) x@details$hessian > stopifnot(all.equal(tt(m1),tt(m2),tolerance=1e-6)) > stopifnot(all.equal(tt(m1),tt(m3),tolerance=1e-6)) > > proc.time() user system elapsed 1.992 0.128 2.122 bbmle/tests/binomtest1.R0000644000176200001440000000212413013175522014703 0ustar liggesuserslibrary(bbmle) funcresp <- structure(list(Initial = as.integer(c(5, 5, 10, 10, 15, 15, 20, 20, 30, 30, 50, 50, 75, 75, 100, 100)), Killed = as.integer(c(1, 2, 5, 6, 10, 9, 7, 10, 11, 15, 5, 21, 32, 18, 25, 35))), .Names = c("Initial", "Killed"), class = "data.frame", row.names = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16")) binomNLL2 = function(p) { a = p[1] h = p[2] ## cat(a,h,"\n") p = a/(1+a*h*N) -sum(dbinom(k,prob=p,size=N,log=TRUE)) } N=0; k=0 parnames(binomNLL2) = c("a","h") m2a = mle2(binomNLL2,start=c(a=0.5,h=0.0125), data=with(funcresp,list(N=Initial,k=Killed))) p1a = profile(m2a) c2a = print(confint(p1a),digits=3) binomNLL2b = function(p,N,k) { a = p[1] h = p[2] ## cat(a,h,"\n") p = a/(1+a*h*N) -sum(dbinom(k,prob=p,size=N,log=TRUE)) } parnames(binomNLL2b) = c("a","h") m2b = mle2(binomNLL2,start=c(a=0.5,h=0.0125), data=with(funcresp,list(N=Initial,k=Killed))) c2b = confint(m2b) N=funcresp$Initial; k=funcresp$Killed m2c = mle2(binomNLL2,start=c(a=0.5,h=0.0125)) c2c = confint(m2c) print(c2c,digits=3) bbmle/tests/mortanal.Rout.save0000644000176200001440000001502413013175522016123 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) > > ## goby data in dump format > > x <- structure(list(indiv = structure(as.integer(c(20, 77, 79, 21, + 33, 40, 11, 28, 43, 85, 56, 49, 29, 37, 57, 36, 66, 65, 19, 69, + 47, 60, 23, 25, 39, 84, 12, 5, 76, 55, 32, 10, 75, 4, 78, 80, + 86, 48, 54, 22, 18, 61, 41, 74, 68, 14, 53, 45, 30, 17, 62, 3, + 7, 50, 34, 82, 8, 70, 38, 52, 2, 63, 81, 15, 44, 58, 13, 26, + 73, 83, 59, 42, 72, 67, 35, 16, 1, 46, 27, 64, 51, 24, 71, 6, + 9, 31)), .Label = c("f10al1", "f10al2", "f10al3", "f10r1", "f10r2", + "f11al1", "f11al2", "f11al3", "f11al4", "f11r1", "f11r2", "f11r3", + "f12al1", "f12al2", "f12al3", "f12al4", "f12al5", "f12r1", "f12r2", + "f12r3", "f12r4", "f12r5", "f12r6", "f13al1", "f13r1", "f14al1", + "f14al2", "f14r1", "f14r2", "f15al1", "f15al2", "f15r1", "f15r2", + "f18al1", "f18al2", "f18r1", "f18r2", "f19al1", "f19r1", "f19r2", + "f1al1", "f1al2", "f1r1", "f20al1", "f20al2", "f20al3", "f20r1", + "f20r2", "f20r3", "f2al1", "f2al2", "f2al3", "f2al4", "f2r1", + "f2r2", "f2r3", "f2r4", "f3al1", "f3al2", "f3r1", "f3r2", "f4al1", + "f5al1", "f5al2", "f5r1", "f5r2", "f6al1", "f6al2", "f6r1", "f7al1", + "f7al2", "f7al3", "f7al4", "f7al5", "f7r1", "f7r2", "f7r3", "f7r4", + "f7r5", "f7r6", "f9al1", "f9al2", "f9al4", "f9r1", "f9r2", "f9r3" + ), class = "factor"), group = structure(as.integer(c(5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)), .Label = c("AL", + "AL-Rat5th", "AL-RatOv", "R", "R-ALat5th"), class = "factor"), + lifespan = as.integer(c(391, 370, 346, 341, 334, 320, 319, + 317, 314, 307, 295, 260, 30, 10, 397, 380, 364, 355, 352, + 341, 340, 339, 336, 320, 314, 312, 308, 302, 296, 290, 284, + 267, 263, 263, 255, 253, 242, 222, 220, 181, 64, 36, 192, + 192, 189, 186, 183, 181, 180, 176, 173, 171, 170, 169, 166, + 11, 247, 235, 234, 233, 232, 224, 221, 220, 215, 210, 210, + 204, 202, 17, 13, 301, 300, 296, 281, 271, 253, 250, 241, + 239, 232, 221, 220, 214, 33, 30))), .Names = c("indiv", "group", + "lifespan"), class = "data.frame", row.names = c("1", "2", "3", + "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", + "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", + "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", + "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", + "49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", + "60", "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", + "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", + "82", "83", "84", "85", "86")) > > mlife <- log(mean(x$lifespan)) > Bm0w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), + start=list(llambda=mlife,alpha=1), + data=x) > Bm1w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), + start=list(llambda=mlife,alpha=1), + parameters=list(llambda~group), + data=x) Warning message: In dweibull(x = c(391L, 370L, 346L, 341L, 334L, 320L, 319L, 317L, : NaNs produced > Bm2w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), + start=list(llambda=mlife,alpha=1), + parameters=list(llambda~group,alpha~group), + data=x) Warning messages: 1: In dweibull(x = c(391L, 370L, 346L, 341L, 334L, 320L, 319L, 317L, : NaNs produced 2: In dweibull(x = c(391L, 370L, 346L, 341L, 334L, 320L, 319L, 317L, : NaNs produced > Bm3w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), + start=list(llambda=mlife,alpha=3), + parameters=list(alpha~group), + data=x) Warning messages: 1: In dweibull(x = c(391L, 370L, 346L, 341L, 334L, 320L, 319L, 317L, : NaNs produced 2: In dweibull(x = c(391L, 370L, 346L, 341L, 334L, 320L, 319L, 317L, : NaNs produced 3: In dweibull(x = c(391L, 370L, 346L, 341L, 334L, 320L, 319L, 317L, : NaNs produced 4: In dweibull(x = c(391L, 370L, 346L, 341L, 334L, 320L, 319L, 317L, : NaNs produced > anova(Bm0w,Bm1w) Likelihood Ratio Tests Model 1: Bm0w, lifespan~dweibull(scale=exp(llambda),shape=alpha) Model 2: Bm1w, lifespan~dweibull(scale=exp(llambda),shape=alpha): llambda~group Tot Df Deviance Chisq Df Pr(>Chisq) 1 2 1043.5 2 6 1015.5 27.945 4 1.28e-05 *** --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 > anova(Bm0w,Bm1w,Bm2w) Likelihood Ratio Tests Model 1: Bm0w, lifespan~dweibull(scale=exp(llambda),shape=alpha) Model 2: Bm1w, lifespan~dweibull(scale=exp(llambda),shape=alpha): llambda~group Model 3: Bm2w, lifespan~dweibull(scale=exp(llambda),shape=alpha): llambda~group, alpha~group Tot Df Deviance Chisq Df Pr(>Chisq) 1 2 1043.5 2 6 1015.5 27.945 4 1.28e-05 *** 3 10 1008.8 6.736 4 0.1505 --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 > anova(Bm0w,Bm3w,Bm2w) Likelihood Ratio Tests Model 1: Bm0w, lifespan~dweibull(scale=exp(llambda),shape=alpha) Model 2: Bm3w, lifespan~dweibull(scale=exp(llambda),shape=alpha): alpha~group Model 3: Bm2w, lifespan~dweibull(scale=exp(llambda),shape=alpha): llambda~group, alpha~group Tot Df Deviance Chisq Df Pr(>Chisq) 1 2 1043.5 2 6 1038.5 4.9434 4 0.2932 3 10 1008.8 29.7377 4 5.535e-06 *** --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 > AICctab(Bm0w,Bm1w,Bm2w,Bm3w,sort=TRUE,nobs=nrow(x),delta=TRUE) dAICc df Bm1w 0.0 6 Bm2w 3.1 10 Bm0w 19.0 2 Bm3w 23.0 6 > > > proc.time() user system elapsed 1.600 1.164 2.632 bbmle/tests/methods.Rout.save0000644000176200001440000000520113013175522015745 0ustar liggesusers R Under development (unstable) (2014-05-14 r65609) -- "Unsuffered Consequences" Copyright (C) 2014 The R Foundation for Statistical Computing Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) Loading required package: stats4 > x <- 0:10 > y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) > d <- data.frame(x,y) > LL <- function(ymax=15, xhalf=6) + -sum(stats::dpois(y, lambda=ymax/(1+x/xhalf), log=TRUE)) > options(digits=3) > mfit0 <- mle2(y~dpois(lambda=exp(interc)), + start=list(interc=log(mean(y))),data=d) > mfit1 <- mle2(y~dpois(lambda=exp(loglambda)), + start=list(loglambda=log(mean(y))),data=d) > > coef(mfit0) interc 2.45 > residuals(mfit0) [1] 4.254 1.605 0.428 0.134 2.488 -1.926 -0.749 -1.043 -1.926 -2.221 [11] -1.043 > AIC(mfit0) [1] 87.5 > BIC(mfit0) [1] 87.9 > vcov(mfit0) interc interc 0.00787 > ## fitted(mfit0) ## fails, looks for default value > predict(mfit0) ## FIXME: doesn't expand properly (need implicit lambda~1 formula??) [1] 11.5 > set.seed(1001) > simulate(mfit0) [1] 18 10 10 15 7 9 10 14 10 13 15 > anova(mfit0,mfit1) Likelihood Ratio Tests Model 1: mfit0, y~dpois(lambda=exp(interc)) Model 2: mfit1, y~dpois(lambda=exp(loglambda)) Tot Df Deviance Chisq Df Pr(>Chisq) 1 1 85.5 2 1 85.5 0 0 1 > summary(mfit0) Maximum likelihood estimation Call: mle2(minuslogl = y ~ dpois(lambda = exp(interc)), start = list(interc = log(mean(y))), data = d) Coefficients: Estimate Std. Error z value Pr(z) interc 2.4463 0.0887 27.6 <2e-16 *** --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 -2 log L: 85.5 > summary(mfit1) Maximum likelihood estimation Call: mle2(minuslogl = y ~ dpois(lambda = exp(loglambda)), start = list(loglambda = log(mean(y))), data = d) Coefficients: Estimate Std. Error z value Pr(z) loglambda 2.4463 0.0887 27.6 <2e-16 *** --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 -2 log L: 85.5 > > proc.time() user system elapsed 0.672 1.400 2.330 bbmle/tests/optimize.R0000644000176200001440000000076013013175522014462 0ustar liggesusers## try to reconstruct error reported by Hofert Jan Marius ## (simpler version) Lfun <- function(x) { (x-5)^2 } library(bbmle) lb <- 6 ## first try with L-BFGS-B and bounds m1 <- mle2(Lfun,start=list(x=7),lower=6,method="L-BFGS-B") coef(m1) p1 <- profile(m1) plot(p1) (c1 <- confint(m1,quietly=TRUE)) ## all OK m2 <- mle2(Lfun,start=list(x=7),optimizer="optimize", lower=lb,upper=10) coef(m2) p2 <- profile(m2) (c2 <- confint(m2)) (c2 <- confint(m2)) plot(p2,show.points=TRUE) bbmle/tests/startvals2.R0000644000176200001440000002701413013175522014730 0ustar liggesuserslibrary(bbmle) ## fir data from emdbook package ... firdata <- structure(list(TOTCONES = c(19, 42, 40, 68, 5, 0, 21, 114, 37, 92, 84, 102, 98, 63, 9, 31, 35, 216, 27, 297, 36, 127, 23, 46, 27, 66, 11, 20, 141, 3, 22, 39, 96, 206.5, 40, 231, 63.5, 202, 54, 32, 107.5, 142.5, 82, 65, 153, 123, 131, 43, 98, 37, 34, 10, 65, 35, 50, 19, 73, 33, 61, 9, 146, 0, 44, 42, 0, 61, 17, 53, 27, 0, 74, 36, 28, 56, 46, 0, 15, 26, 46, 15, 105, 0, 62, 24, 25, 41, 138, 77, 227.7, 28, 45, 57, 109, 28, 17, 91, 69, 87, 10, 65, 50, 27, 30, 86, 119, 22, 8, 54, 104, 14, 16, 5, 53, 40, 32, 114, 39, 37, 111, 226, 156, 42, 86, 94, 54, 1, 14, 44, 108, 116.5, 14, 73, 3, 16, 87, 61, 48, 0, 17, 5, 88, 11, 133, 121, 166, 171, 63, 23, 4, 51, 10, 14, 78, 47, 31, 42, 24, 42, 55, 19, 63, 127, 9, 74, 120, 85, 51, 19, 131, 7, 23, 7, 9, 23, 55, 48, 13, 2, 9, 3, 4, 16, 1, 88, 8, 27, 16, 184, 14, 22, 25, 52, 2, 134, 81, 85, 3, 56, 17, 8, 10, 6, 69, 58, 1, 22, 3, 11, 22, 2, 37, 8, 15, 61, 6, 18, 9, 109, 54, 4, 11, 30, 0, 0, 3, 0, 16, 22, 9, 56, 17, 64, 38, 59, 37, 22, 41, 1, 22, 16, 17, 4), DBH = c(9.4, 10.6, 7.7, 10.6, 8.7, 10.1, 8.1, 11.6, 10.1, 13.3, 10, 13.4, 9.7, 7.4, 8.7, 8.6, 7.9, 14.2, 9.5, 15.9, 6, 10.6, 7.3, 10.3, 8.4, 10.2, 13.8, 9.4, 8.1, 9.6, 7.3, 7.4, 10.3, 13.4, 9.2, 13.9, 10.9, 17.4, 10.2, 8.2, 11.3, 16.1, 12.3, 8.3, 12.4, 12.5, 11.3, 7.8, 11.6, 10, 7, 5.7, 7.7, 8.9, 8.5, 8.5, 10.7, 10.2, 10.8, 9, 9.4, 7.6, 10.6, 10, 8, 7.4, 9.1, 6.7, 9.7, 6.8, 8.6, 9.1, 6.3, 6.7, 10.9, 9.5, 9.9, 6.8, 9.8, 7.7, 12.1, 8.2, 10, 9.6, 9.2, 8.2, 11.3, 11.6, 15.7, 9.1, 8.9, 8.7, 11, 6.6, 7.1, 9, 12.4, 12.1, 7.5, 9, 8, 10.9, 9.2, 10.1, 12.1, 7, 6.8, 8.6, 11.6, 6.6, 6.7, 6.8, 8.5, 7.8, 7.9, 9.8, 6.2, 6.7, 15.4, 9.2, 12.9, 6.7, 9.6, 8.4, 8, 8.7, 6.7, 9.2, 9.5, 8, 5.5, 8.5, 5.7, 5.6, 8, 6.5, 9.6, 6.1, 7.9, 5.9, 11, 8.2, 12.8, 12.8, 12.5, 13.7, 11.8, 6.3, 6.3, 8.2, 6.2, 6.7, 9.8, 9.4, 6.7, 6, 4.9, 9.6, 7.5, 8.4, 7.4, 9.9, 7.4, 9.5, 13.9, 6.9, 9.4, 7.4, 12.8, 5.8, 7.2, 5.6, 6.9, 11.3, 9.6, 6.8, 6.9, 6.6, 4.8, 4.4, 4.8, 8.5, 7, 8.7, 6.6, 8.6, 5.3, 10.4, 6.4, 5.4, 8.2, 5.5, 6.2, 14.7, 10.5, 14.4, 5.8, 6.1, 6.2, 6.2, 7.2, 6, 10.6, 8.7, 7.5, 7.3, 5.2, 6.9, 6.6, 6.7, 5.2, 6.9, 7.5, 9, 5.9, 6.5, 6.6, 9.8, 4.7, 4.2, 4.8, 6.7, 6.5, 6.7, 5.9, 5.4, 6.9, 6.5, 6, 12, 7.5, 6.4, 7.3, 7.3, 6.4, 7, 5.9, 9.1, 6.7, 4, 6.5, 4.7), WAVE_NON = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("n", "w"), class = "factor"), logcones = c(2.99573227355399, 3.76120011569356, 3.71357206670431, 4.23410650459726, 1.79175946922805, 0, 3.09104245335832, 4.74493212836325, 3.63758615972639, 4.53259949315326, 4.44265125649032, 4.63472898822964, 4.59511985013459, 4.15888308335967, 2.30258509299405, 3.46573590279973, 3.58351893845611, 5.37989735354046, 3.3322045101752, 5.6970934865054, 3.61091791264422, 4.85203026391962, 3.17805383034795, 3.85014760171006, 3.3322045101752, 4.20469261939097, 2.484906649788, 3.04452243772342, 4.95582705760126, 1.38629436111989, 3.13549421592915, 3.68887945411394, 4.57471097850338, 5.33513133967075, 3.71357206670431, 5.44673737166631, 4.16666522380173, 5.31320597904179, 4.00733318523247, 3.49650756146648, 4.68675017298051, 4.96633503519968, 4.4188406077966, 4.18965474202643, 5.03695260241363, 4.82028156560504, 4.88280192258637, 3.78418963391826, 4.59511985013459, 3.63758615972639, 3.55534806148941, 2.39789527279837, 4.18965474202643, 3.58351893845611, 3.93182563272433, 2.99573227355399, 4.30406509320417, 3.52636052461616, 4.12713438504509, 2.30258509299405, 4.99043258677874, 0, 3.80666248977032, 3.76120011569356, 0, 4.12713438504509, 2.89037175789616, 3.98898404656427, 3.3322045101752, 0, 4.31748811353631, 3.61091791264422, 3.36729582998647, 4.04305126783455, 3.85014760171006, 0, 2.77258872223978, 3.29583686600433, 3.85014760171006, 2.77258872223978, 4.66343909411207, 0, 4.14313472639153, 3.2188758248682, 3.25809653802148, 3.73766961828337, 4.93447393313069, 4.35670882668959, 5.43241110102874, 3.36729582998647, 3.8286413964891, 4.06044301054642, 4.70048036579242, 3.36729582998647, 2.89037175789616, 4.52178857704904, 4.24849524204936, 4.47733681447821, 2.39789527279837, 4.18965474202643, 3.93182563272433, 3.3322045101752, 3.43398720448515, 4.46590811865458, 4.78749174278205, 3.13549421592915, 2.19722457733622, 4.00733318523247, 4.65396035015752, 2.70805020110221, 2.83321334405622, 1.79175946922805, 3.98898404656427, 3.71357206670431, 3.49650756146648, 4.74493212836325, 3.68887945411394, 3.63758615972639, 4.71849887129509, 5.4249500174814, 5.05624580534831, 3.76120011569356, 4.46590811865458, 4.55387689160054, 4.00733318523247, 0.693147180559945, 2.70805020110221, 3.80666248977032, 4.69134788222914, 4.76643833358421, 2.70805020110221, 4.30406509320417, 1.38629436111989, 2.83321334405622, 4.47733681447821, 4.12713438504509, 3.89182029811063, 0, 2.89037175789616, 1.79175946922805, 4.48863636973214, 2.484906649788, 4.89783979995091, 4.80402104473326, 5.11799381241676, 5.14749447681345, 4.15888308335967, 3.17805383034795, 1.6094379124341, 3.95124371858143, 2.39789527279837, 2.70805020110221, 4.36944785246702, 3.87120101090789, 3.46573590279973, 3.76120011569356, 3.2188758248682, 3.76120011569356, 4.02535169073515, 2.99573227355399, 4.15888308335967, 4.85203026391962, 2.30258509299405, 4.31748811353631, 4.79579054559674, 4.45434729625351, 3.95124371858143, 2.99573227355399, 4.88280192258637, 2.07944154167984, 3.17805383034795, 2.07944154167984, 2.30258509299405, 3.17805383034795, 4.02535169073515, 3.89182029811063, 2.63905732961526, 1.09861228866811, 2.30258509299405, 1.38629436111989, 1.6094379124341, 2.83321334405622, 0.693147180559945, 4.48863636973214, 2.19722457733622, 3.3322045101752, 2.83321334405622, 5.22035582507832, 2.70805020110221, 3.13549421592915, 3.25809653802148, 3.97029191355212, 1.09861228866811, 4.90527477843843, 4.40671924726425, 4.45434729625351, 1.38629436111989, 4.04305126783455, 2.89037175789616, 2.19722457733622, 2.39789527279837, 1.94591014905531, 4.24849524204936, 4.07753744390572, 0.693147180559945, 3.13549421592915, 1.38629436111989, 2.484906649788, 3.13549421592915, 1.09861228866811, 3.63758615972639, 2.19722457733622, 2.77258872223978, 4.12713438504509, 1.94591014905531, 2.94443897916644, 2.30258509299405, 4.70048036579242, 4.00733318523247, 1.6094379124341, 2.484906649788, 3.43398720448515, 0, 0, 1.38629436111989, 0, 2.83321334405622, 3.13549421592915, 2.30258509299405, 4.04305126783455, 2.89037175789616, 4.17438726989564, 3.66356164612965, 4.0943445622221, 3.63758615972639, 3.13549421592915, 3.73766961828337, 0.693147180559945, 3.13549421592915, 2.83321334405622, 2.89037175789616, 1.6094379124341 )), .Names = c("TOTCONES", "DBH", "WAVE_NON", "logcones"), row.names = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, 43L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 52L, 53L, 54L, 55L, 56L, 58L, 59L, 60L, 61L, 62L, 63L, 64L, 65L, 66L, 67L, 68L, 69L, 70L, 71L, 72L, 73L, 74L, 75L, 76L, 78L, 79L, 80L, 81L, 82L, 83L, 84L, 85L, 86L, 87L, 88L, 89L, 90L, 91L, 92L, 93L, 94L, 95L, 96L, 97L, 98L, 99L, 100L, 101L, 102L, 103L, 104L, 105L, 106L, 107L, 108L, 109L, 110L, 111L, 112L, 113L, 118L, 119L, 120L, 121L, 122L, 123L, 124L, 126L, 127L, 128L, 129L, 130L, 131L, 132L, 133L, 134L, 135L, 136L, 137L, 138L, 139L, 140L, 142L, 144L, 145L, 146L, 147L, 148L, 149L, 150L, 151L, 154L, 155L, 157L, 159L, 160L, 168L, 169L, 170L, 171L, 172L, 173L, 174L, 175L, 176L, 177L, 178L, 179L, 180L, 181L, 184L, 185L, 186L, 187L, 189L, 190L, 193L, 198L, 247L, 272L, 273L, 275L, 276L, 277L, 278L, 280L, 281L, 282L, 283L, 284L, 285L, 286L, 287L, 288L, 289L, 290L, 291L, 292L, 293L, 294L, 295L, 296L, 297L, 298L, 299L, 300L, 301L, 303L, 304L, 305L, 306L, 307L, 308L, 309L, 310L, 311L, 313L, 314L, 315L, 316L, 319L, 320L, 321L, 322L, 323L, 325L, 326L, 327L, 330L, 331L, 332L, 337L, 338L, 339L, 340L, 341L, 342L, 343L, 344L, 345L, 346L, 347L, 348L, 349L, 350L, 351L, 352L, 353L, 357L, 358L, 360L, 366L), na.action = structure(c(34L, 57L, 77L, 114L, 115L, 116L, 117L, 125L, 141L, 143L, 152L, 153L, 156L, 158L, 161L, 162L, 163L, 164L, 165L, 166L, 167L, 182L, 183L, 188L, 191L, 192L, 194L, 195L, 196L, 197L, 199L, 200L, 201L, 202L, 203L, 204L, 205L, 206L, 207L, 208L, 209L, 210L, 211L, 212L, 213L, 214L, 215L, 216L, 217L, 218L, 219L, 220L, 221L, 222L, 223L, 224L, 225L, 226L, 227L, 228L, 229L, 230L, 231L, 232L, 233L, 234L, 235L, 236L, 237L, 238L, 239L, 240L, 241L, 242L, 243L, 244L, 245L, 246L, 248L, 249L, 250L, 251L, 252L, 253L, 254L, 255L, 256L, 257L, 258L, 259L, 260L, 261L, 262L, 263L, 264L, 265L, 266L, 267L, 268L, 269L, 270L, 271L, 274L, 279L, 302L, 312L, 317L, 318L, 324L, 328L, 329L, 333L, 334L, 335L, 336L, 354L, 355L, 356L, 359L, 361L, 362L, 363L, 364L, 365L, 367L, 368L, 369L, 370L, 371L), .Names = c("34", "57", "77", "114", "115", "116", "117", "125", "141", "143", "152", "153", "156", "158", "161", "162", "163", "164", "165", "166", "167", "182", "183", "188", "191", "192", "194", "195", "196", "197", "199", "200", "201", "202", "203", "204", "205", "206", "207", "208", "209", "210", "211", "212", "213", "214", "215", "216", "217", "218", "219", "220", "221", "222", "223", "224", "225", "226", "227", "228", "229", "230", "231", "232", "233", "234", "235", "236", "237", "238", "239", "240", "241", "242", "243", "244", "245", "246", "248", "249", "250", "251", "252", "253", "254", "255", "256", "257", "258", "259", "260", "261", "262", "263", "264", "265", "266", "267", "268", "269", "270", "271", "274", "279", "302", "312", "317", "318", "324", "328", "329", "333", "334", "335", "336", "354", "355", "356", "359", "361", "362", "363", "364", "365", "367", "368", "369", "370", "371"), class = "omit"), class = "data.frame") m1 <- mle2(logcones ~ dnorm(i + slope*log(DBH), sd), parameters= list(i ~ WAVE_NON-1, slope ~ WAVE_NON-1), data = firdata, start = list(i=c(-2,-2),slope=c(2.5,2.5),sd=1)) ancovafun = function(i1,i2,slope1,slope2,sigma) { int = c(i1,i2)[WAVE_NON] slope = c(slope1,slope2)[WAVE_NON] Y.pred = int+ slope*log(DBH) r <- -sum(dnorm(logcones,mean=Y.pred,sd=sigma,log=TRUE)) ## cat(i1,i2,slope1,slope2,sigma,r,"\n") r } m2 <- mle2(ancovafun,start=list(i1=-2,i2=-2,slope1=2.5,slope2=2.5,sigma=1), data=firdata) m3 <- mle2(logcones ~ dnorm(mu, sd), parameters= list(mu ~ WAVE_NON*log(DBH)), data = firdata, start = list(mu=1,sd=1)) stopifnot(all.equal(AIC(m1),AIC(m2),AIC(m3))) ## m4 <- mle2(logcones ~ dnorm(i + slope*log(DBH), sd), ## parameters= list(i ~ WAVE_NON-1, slope ~ WAVE_NON-1), ## data = firdata, ## start = c(-2,-2,2.5,2.5,sd=1)) bbmle/tests/update.Rout.save0000644000176200001440000000356213013175522015574 0ustar liggesusers R Under development (unstable) (2013-08-18 r63609) -- "Unsuffered Consequences" Copyright (C) 2013 The R Foundation for Statistical Computing Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) Loading required package: stats4 > > x <- 0:10 > y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) > d <- data.frame(x,y) > oldopts <- options(warn=-1,digits=3) ## ignore warnings > m1 <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), + start=list(ymax=1,xhalf=1),data=d) > m1 Call: mle2(minuslogl = y ~ dpois(lambda = ymax/(1 + x/xhalf)), start = list(ymax = 1, xhalf = 1), data = d) Coefficients: ymax xhalf 24.99 3.06 Log-likelihood: -28.6 > y2 <- c(26, 17, 10, 15, 20, 5, 9, 8, 5, 4, 8) > d2 <- data.frame(x,y=y2) > > m2 <- update(m1,data=d2) > m2 Call: mle2(minuslogl = y ~ dpois(lambda = ymax/(1 + x/xhalf)), start = list(ymax = 1, xhalf = 1), data = ..1, lower = -Inf, upper = Inf, control = list()) Coefficients: ymax xhalf 24.63 3.16 Log-likelihood: -29.6 > m3 <- update(m1,.~dpois(lambda=c),start=list(c=5)) > m3 Call: mle2(minuslogl = y ~ dpois(lambda = c), start = ..2, data = list( x = 0:10, y = c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)), lower = -Inf, upper = Inf, control = list()) Coefficients: c 11.5 Log-likelihood: -42.7 > options(oldopts) > > proc.time() user system elapsed 0.576 0.832 2.785 bbmle/tests/glmcomp.R0000644000176200001440000000160613013175522014260 0ustar liggesuserslibrary(bbmle) library(testthat) x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) LL <- function(ymax=15, xhalf=6) -sum(stats::dpois(y, lambda=ymax/(1+x/xhalf), log=TRUE)) mfit0 <- mle2(y~dpois(lambda=exp(interc)), start=list(interc=log(mean(y))),data=d) mfit1 <- mle2(y~dpois(lambda=exp(loglambda)), start=list(loglambda=log(mean(y))),data=d) gfit0 <- glm(y~1,family=poisson) expect_equal(unname(coef(mfit0)),unname(coef(gfit0))) expect_equal(logLik(mfit0),logLik(gfit0)) expect_equal(predict(mfit0), ## only one value for now unique(predict(gfit0,type="response"))) ## FIXME: residuals are backwards expect_equal(residuals(mfit0,type="response"),unname(residuals(gfit0,type="response"))) ## FIXME: residuals are backwards expect_equal(residuals(mfit0,type="pearson"),unname(residuals(gfit0,type="pearson"))) bbmle/tests/gradient_vecpar_profile.Rout.save0000644000176200001440000000463013175475557021210 0ustar liggesusers R Under development (unstable) (2017-04-17 r72531) -- "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. Natural language support but running in an English locale 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(bbmle) Loading required package: stats4 > > ## Simulate data > > set.seed(1) > x <- 1:5 > y <- 2*x+1 > noise <- rnorm(5, 0, 0.1) > mydata <- data.frame(x = x, y=y+noise) > > ## Model definition > > model <- function(a, b) with(mydata, a*x+b) > > ## Negative log-likelihood > > nll <- function(par) with(mydata, { + a <- par[1] + b <- par[2] + sum(0.5*((y-model(a,b))/0.1)^2) + + }) > > gr <- function(par) with(mydata, { + a <- par[1] + b <- par[2] + dnllda <- -sum(((y-model(a,b))/0.1)*x/0.1) + dnlldb <- -sum(((y-model(a,b))/0.1)*1/0.1) + return(c(dnllda, dnlldb)) + }) > > ## optimization > > parnames(nll) <- c("a", "b") > parnames(gr) <- c("a", "b") > > fit <- mle2(nll, c(a = 1, b=2), gr=gr) > > myprof <- profile(fit) > myprof_c <- profile(fit,continuation="naive") > confint(myprof) 2.5 % 97.5 % a 1.9712561 2.095215 b 0.7076574 1.118783 > confint(myprof_c) 2.5 % 97.5 % a 1.9712561 2.095215 b 0.7076574 1.118783 > > fit <- mle2(nll, c(a = 1, b=2), gr=gr, skip.hessian=TRUE) > myprof2 <- profile(fit,std.err=c(0.1,0.1)) > > ## incomplete! > model2 <- ~a+b*x+c*x^2 > f0 <- deriv(model2,"x",function.arg=c("a","b","c")) > ## chain rule > f1 <- function() { + ## memoize + lastpar <- NULL + lastval <- NULL + } > > f2 <- function(par) { + if (par==lastpar) { + return(c(lastval)) + } + lastpar <<- par + lastval <<- do.call(f0,par) + f1(par) + } > f2.gr <- function(par) { + if (par==lastpar) { + return(attr(lastval,".grad")) + } + lastpar <<- par + lastval <<- do.call(f0,par) + f1.gr(par) + } > parnames(f2) <- parnames(f2.gr) <- c("a","b","c") > > proc.time() user system elapsed 1.844 0.128 3.349 bbmle/tests/testbounds.Rout0000644000176200001440000000237513013175522015550 0ustar liggesusers R version 2.8.1 (2008-12-22) Copyright (C) 2008 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. Natural language support but running in an English locale 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. > x <- runif(10) > y <- 1+x+rnorm(10,sd=0.1) > > library(bbmle) > m1 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1))) > > m2 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), + method="L-BFGS-B",lower=c(a=0,b=0,s=-Inf)) > > m2F = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), + method="L-BFGS-B",lower=c(a=0,b=0,s=-Inf), + fixed=list(a=1)) Warning message: In mle2(y ~ dnorm(a + b * x, sd = exp(s)), start = list(a = 1, b = 1, : length mismatch between lower/upper and number of non-fixed parameters > > > proc.time() user system elapsed 1.008 0.024 1.044 bbmle/tests/prof_spec.R0000644000176200001440000000140613072222350014575 0ustar liggesusers## test whether profiling works when custom optimizer is defined ## inside a function (GH #7) library(bbmle) test <- function(t, X) { likfun <- function(p) { mu <- with(as.list(p), { exp(a+b*t) }) -sum(dpois(X, mu, log=TRUE)) } parnames(likfun) <- c("a", "b") optimfun <- function(par, fn, gr = NULL, ..., method = NULL, lower = -Inf, upper = Inf, control = NULL, hessian = FALSE) { ## cat("using custom optimfun!\n") optim(par, fn=fn, gr=gr, ..., method="BFGS", control=control, hessian=TRUE) } mle2(likfun, start=c(a=1,b=1), optimizer="user", optimfun=optimfun) } f <- test(0:5, round(exp(1:6))) pp <- profile(f,skiperrs=FALSE) stopifnot(inherits(pp,"profile.mle2")) bbmle/tests/parscale.Rout0000644000176200001440000001236613013175522015151 0ustar liggesusers R version 2.13.0 alpha (2011-03-18 r54865) Copyright (C) 2011 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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. [Previously saved workspace restored] > library(bbmle) Loading required package: stats4 Loading required package: numDeriv Loading required package: lattice Loading required package: MASS > > ## source("~/lib/R/pkgs/bbmle/pkg/R/mle.R > > set.seed(1002) > X <- rexp(1000, rate = 0.0001) > f <- function(X, rate) { + if (rate<0) cat("rate<0: ",rate,"\n") + -sum(dexp(X, rate = rate, log = TRUE)) + } > if (FALSE) { + ## L-BFGS-B violates bounds, and gets stuck at lower bound + m <- mle2(minuslogl = f, + data = list(X = X), + start = list(rate = 0.01), + method = "L-BFGS-B", + control = list(trace = 1, parscale = 1e-4), + lower = list(rate = 1e-9)) + + profile(m, std.err=0.0001) ## finds new optimum + + fsc <- function(X, rate) { + -sum(dexp(X, rate = rate*1e-4, log = TRUE)) + } + msc <- mle2(minuslogl = fsc, + data = list(X = X), + start = list(rate = 100), + method = "L-BFGS-B", + control = list(trace = 1), + lower = list(rate = 1e-5)) + + ## does it work if we scale by hand? + ## no, identical problem + } > > ## works fine with a better starting point > m <- mle2(minuslogl = f, + data = list(X = X), + start = list(rate = 0.001), + method = "L-BFGS-B", + control = list(trace = 1,parscale=1e-4), + lower = list(rate = 1e-9)) iter 0 value 12490.509482 final value 10188.014396 converged > vcov(m) rate rate 1.045669e-11 > confint(m) 2.5 % 97.5 % 9.605011e-05 1.087274e-04 > > > ## works OK despite warnings about 1-dimensional opt. with N-M > (m0 <- mle2(minuslogl = f, + data = list(X = X), + start = list(rate = 0.01), + method = "Nelder-Mead", + control = list(trace = 1, parscale = 1e-4))) Nelder-Mead direct search function minimizer function value for initial parameters = 102397.310635 Scaled convergence tolerance is 0.00152584 Stepsize computed as 10.000000 BUILD 2 112081.214500 102397.310635 EXTENSION 4 102397.310635 83062.026096 EXTENSION 6 83062.026096 44638.317097 HI-REDUCTION 8 63791.280079 44638.317097 REFLECTION 10 44638.317097 25773.036188 HI-REDUCTION 12 35146.785125 25773.036188 REFLECTION 14 25773.036188 16686.969324 HI-REDUCTION 16 21171.111238 16686.969324 REFLECTION 18 16686.969324 12490.509482 HI-REDUCTION 20 14529.847885 12490.509482 REFLECTION 22 12490.509482 10738.853151 HI-REDUCTION 24 11555.789799 10738.853151 REFLECTION 26 10738.853151 10209.598576 HI-REDUCTION 28 10415.334346 10209.598576 LO-REDUCTION 30 10209.598576 10191.680210 HI-REDUCTION 32 10191.680210 10190.329749 HI-REDUCTION 34 10190.329749 10188.037612 HI-REDUCTION 36 10188.497339 10188.037612 HI-REDUCTION 38 10188.089444 10188.037612 HI-REDUCTION 40 10188.037612 10188.018175 HI-REDUCTION 42 10188.018175 10188.016446 HI-REDUCTION 44 10188.016446 10188.014462 Exiting from Nelder Mead minimizer 46 function evaluations used Call: mle2(minuslogl = f, start = list(rate = 0.01), method = "Nelder-Mead", data = list(X = X), control = list(trace = 1, parscale = 1e-04)) Coefficients: rate 0.0001022949 Log-likelihood: -10188.01 Warning message: In optim(par = 0.01, fn = function (p) : one-diml optimization by Nelder-Mead is unreliable: use optimize > vcov(m0) rate rate 1.046414e-11 > > confint(m0) 2.5 % 97.5 % 9.604965e-05 1.087271e-04 > confint(m0,method="quad") 2.5 % 97.5 % 9.595477e-05 1.086351e-04 > ## very similar (good quadratic surface, not surprising) > > m1 <- mle2(minuslogl = f, + data = list(X = X), + start = list(rate = 0.01), + method = "BFGS", + control = list(trace = 1, parscale = 1e-4)) initial value 102397.310635 rate<0: -0.08679214 rate<0: -0.009358428 rate<0: -0.5831727 rate<0: -0.1117319 rate<0: -0.01744372 rate<0: -0.07719334 rate<0: -0.01430754 rate<0: -0.001730383 rate<0: -0.08426903 rate<0: -0.01622577 rate<0: -0.002617114 final value 10188.014408 converged There were 11 warnings (use warnings() to see them) > > > ## gets stuck? will have to investigate ... > m2 <- mle2(minuslogl = f, + data = list(X = X), + start = list(rate = 0.01), + optimizer = "optimize", + lower=1e-9,upper=0.1) > > vcov(m2) rate rate 1.407176e-11 > > proc.time() user system elapsed 0.856 0.196 1.065 bbmle/tests/optimize.Rout.save0000644000176200001440000000343213013175522016146 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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. > ## try to reconstruct error reported by Hofert Jan Marius > ## (simpler version) > > Lfun <- function(x) { + (x-5)^2 + } > > > > library(bbmle) > > lb <- 6 > ## first try with L-BFGS-B and bounds > m1 <- mle2(Lfun,start=list(x=7),lower=6,method="L-BFGS-B") Warning message: In mle2(Lfun, start = list(x = 7), lower = 6, method = "L-BFGS-B") : some parameters are on the boundary: variance-covariance calculations based on Hessian may be unreliable > coef(m1) x 6 > p1 <- profile(m1) > plot(p1) > (c1 <- confint(m1,quietly=TRUE)) 2.5 % 97.5 % NA 6.702747 > ## all OK > > m2 <- mle2(Lfun,start=list(x=7),optimizer="optimize", + lower=lb,upper=10) > coef(m2) x 6.00006 > p2 <- profile(m2) > (c2 <- confint(m2)) 2.5 % 97.5 % NA 6.668954 > (c2 <- confint(m2)) 2.5 % 97.5 % NA 6.668954 > plot(p2,show.points=TRUE) Warning message: In .local(x, ...) : non-monotonic profile: reverting to linear interpolation. Consider setting std.err manually > > proc.time() user system elapsed 0.960 1.064 1.875 bbmle/tests/tmptest.R0000644000176200001440000000042313013175522014316 0ustar liggesuserslibrary(bbmle) d <- data.frame(x=0:10, y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) maxit <- 1000 mle2(y~dpois(lambda=exp(lymax)/(1+x/exp(lhalf))), start=list(lymax=0,lhalf=0), data=d, control=list(maxit=maxit), parameters=list(lymax~1,lhalf~1)) bbmle/tests/grtest1.R0000644000176200001440000000071613050623125014212 0ustar liggesusers## from Eric Weese library(bbmle) f <- function(x=2,a=1) x^2 - a f.g <- function(x,a) 2*x f.g2 <- function(x,a) c(2*x,0) options(digits=3) m1 <- mle2(f,fixed=list(a=1)) m2 <- mle2(f,gr=f.g,fixed=list(a=1)) m3 <- mle2(f,gr=f.g2,fixed=list(a=1)) stopifnot(all.equal(coef(m1),coef(m2))) stopifnot(all.equal(coef(m1),coef(m3))) tt <- function(x) x@details$hessian stopifnot(all.equal(tt(m1),tt(m2),tolerance=1e-6)) stopifnot(all.equal(tt(m1),tt(m3),tolerance=1e-6)) bbmle/tests/controleval.R0000644000176200001440000000146113013175522015151 0ustar liggesusersrequire(bbmle) mle2a <- function(...) mle2(...) mle2b <- function(...) mle2a(...) ## some data d <- data.frame(x=0:10,y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) ym <- mean(d$y) ## some fits (fit0 <- mle2(y~dpois(lambda=ymean),start=list(ymean=ym),data=d)) # okay predict(fit0) (fit0.2 <- mle2(y~dpois(lambda=ymean),start=list(ymean=ym),data=d, control=list(parscale=2))) # okay predict(fit0.2) (fit1 <- mle2a(y~dpois(lambda=ymean),start=list(ymean=ym),data=d)) # okay (fit1.2 <- mle2a(y~dpois(lambda=ymean),start=list(ymean=ym),data=d, control=list(parscale=2))) # FAILS (fit1.3 <- mle2b(y~dpois(lambda=ymean),start=list(ymean=ym),data=d, control=list(parscale=2))) # FAILS ### NOT WORKING: if (FALSE) { predict(fit1) predict(fit1.2) predict(fit1.3) } bbmle/tests/tmptest.Rout.save0000644000176200001440000000255013013175522016006 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) > d <- data.frame(x=0:10, + y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) > > maxit <- 1000 > mle2(y~dpois(lambda=exp(lymax)/(1+x/exp(lhalf))), + start=list(lymax=0,lhalf=0), + data=d, + control=list(maxit=maxit), + parameters=list(lymax~1,lhalf~1)) Call: mle2(minuslogl = y ~ dpois(lambda = exp(lymax)/(1 + x/exp(lhalf))), start = list(lymax = 0, lhalf = 0), data = d, parameters = list(lymax ~ 1, lhalf ~ 1), control = list(maxit = maxit)) Coefficients: lymax lhalf 3.218853 1.117035 Log-likelihood: -28.6 > > proc.time() user system elapsed 0.708 1.004 1.572 bbmle/tests/eval.Rout.save0000644000176200001440000000620413013175522015235 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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. > ## I am experiencing difficulties with one of my modeling function (bbmle::mle2) > ## which, like other modeling functions in R, uses match.call() to > ## retrieve and save the original function call for future use. > ## I'll describe the problem for bbmle and then show that I can > ## provoke a similar problem with lm(). > > ## ============ > ## PART I: mle2() > > library(bbmle) > > x <- 0:10 > y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) > d <- data.frame(x,y) > > ## The key is to call the modeling function from within another > ## function which passes additional arguments via ... > > ff <- function(d,...) { + mle2(y~dpois(lambda=ymean),start=list(ymean=mean(y)),data=d,...) + } > > ff(d) Call: mle2(minuslogl = y ~ dpois(lambda = ymean), start = list(ymean = mean(y)), data = d) Coefficients: ymean 11.54545 Log-likelihood: -42.73 > try(ff(d,control=list(maxit=1000))) Call: mle2(minuslogl = y ~ dpois(lambda = ymean), start = list(ymean = mean(y)), data = d, control = ..1) Coefficients: ymean 11.54545 Log-likelihood: -42.73 > > ## Error in call$control$parscale : > ## object of type 'symbol' is not subsettable > > ## This happens when I try: > > ## call$control$parscale <- eval.parent(call$control$parscale) > > ## in 'normal' circumstances call$control and call$control$parscale > ## are either NULL or well-specified ... > > ## Debugging mle2 shows that the results of match.call() are > > ## mle2(minuslogl = y ~ dpois(lambda = ymean), start = list(ymean = mean(y)), > ## data = d, control = ..1) > > ## ============ > ## PART II: lm() > > ## I can find a similar issue with lm(), although admittedly > ## I have to work a bit harder/do something a little bit more > ## obscure. > > L1 <- lm(y~1,data=d,tol=1e-6) > L1$call lm(formula = y ~ 1, data = d, tol = 1e-06) > > ff2 <- function(d,...) { + lm(y~1,data=d,...) + } > > tt <- 1e-6 > L2 <- ff2(d,tol=tt) > L2$call lm(formula = y ~ 1, data = d, tol = ..1) > > try(update(L2,.~.+x)) Error in lm.fit(x, y, offset = offset, singular.ok = singular.ok, ...) : ..1 used in an incorrect context, no ... to look in > > ## Error in lm.fit(x, y, offset = offset, singular.ok = singular.ok, ...) : > ## ..1 used in an incorrect context, no ... to look in > > ## similar issue in curve3d(). How does curve() work? > > > > proc.time() user system elapsed 0.728 1.020 1.595 bbmle/tests/glmcomp.Rout.save0000644000176200001440000000335313013175522015746 0ustar liggesusers R Under development (unstable) (2014-05-14 r65609) -- "Unsuffered Consequences" Copyright (C) 2014 The R Foundation for Statistical Computing Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) Loading required package: stats4 > library(testthat) > x <- 0:10 > y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) > d <- data.frame(x,y) > LL <- function(ymax=15, xhalf=6) + -sum(stats::dpois(y, lambda=ymax/(1+x/xhalf), log=TRUE)) > mfit0 <- mle2(y~dpois(lambda=exp(interc)), + start=list(interc=log(mean(y))),data=d) > > mfit1 <- mle2(y~dpois(lambda=exp(loglambda)), + start=list(loglambda=log(mean(y))),data=d) > > gfit0 <- glm(y~1,family=poisson) > expect_equal(unname(coef(mfit0)),unname(coef(gfit0))) > expect_equal(logLik(mfit0),logLik(gfit0)) > expect_equal(predict(mfit0), ## only one value for now + unique(predict(gfit0,type="response"))) > > ## FIXME: residuals are backwards > expect_equal(residuals(mfit0,type="response"),unname(residuals(gfit0,type="response"))) > ## FIXME: residuals are backwards > expect_equal(residuals(mfit0,type="pearson"),unname(residuals(gfit0,type="pearson"))) > > > > proc.time() user system elapsed 0.816 1.912 2.711 bbmle/tests/parscale.Rout.save0000644000176200001440000000723313013175522016103 0ustar liggesusers R Under development (unstable) (2012-12-14 r61321) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-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. Natural language support but running in an English locale 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(bbmle) Loading required package: stats4 > old_opt <- options(digits=3) > tracelevel <- 0 > > ## source("~/lib/R/pkgs/bbmle/pkg/R/mle.R > > set.seed(1002) > X <- rexp(1000, rate = 0.0001) > f <- function(X, rate) { + if (tracelevel>0 && rate<0) cat("rate<0: ",rate,"\n") + -sum(dexp(X, rate = rate, log = TRUE)) + } > if (FALSE) { + ## L-BFGS-B violates bounds, and gets stuck at lower bound + m <- mle2(minuslogl = f, + data = list(X = X), + start = list(rate = 0.01), + method = "L-BFGS-B", + control = list(trace = tracelevel, + parscale = 1e-4), + lower = c(rate = 1e-9)) + + profile(m, std.err=0.0001) ## finds new optimum + + fsc <- function(X, rate) { + -sum(dexp(X, rate = rate*1e-4, log = TRUE)) + } + msc <- mle2(minuslogl = fsc, + data = list(X = X), + start = list(rate = 100), + method = "L-BFGS-B", + control = list(trace = tracelevel), + lower = c(rate = 1e-5)) + + ## does it work if we scale by hand? + ## no, identical problem + } > > ## works fine with a better starting point > m <- mle2(minuslogl = f, + data = list(X = X), + start = list(rate = 0.001), + method = "L-BFGS-B", + control = list(trace = tracelevel, + parscale=1e-4), + lower = c(rate = 1e-9)) > vcov(m) rate rate 1.05e-11 > confint(m) 2.5 % 97.5 % 9.61e-05 1.09e-04 > > > ## works OK despite warnings about 1-dimensional opt. with N-M > (m0 <- mle2(minuslogl = f, + data = list(X = X), + start = list(rate = 0.01), + method = "Nelder-Mead", + control = list(trace = tracelevel, parscale = 1e-4))) Call: mle2(minuslogl = f, start = list(rate = 0.01), method = "Nelder-Mead", data = list(X = X), control = list(trace = tracelevel, parscale = 1e-04)) Coefficients: rate 0.000102 Log-likelihood: -10188 Warning message: In optim(par = 0.01, fn = function (p) : one-dimensional optimization by Nelder-Mead is unreliable: use "Brent" or optimize() directly > vcov(m0) rate rate 1.05e-11 > > confint(m0) 2.5 % 97.5 % 0.000096 0.000109 > confint(m0,method="quad") 2.5 % 97.5 % 0.000096 0.000109 > ## very similar (good quadratic surface, not surprising) > > m1 <- mle2(minuslogl = f, + data = list(X = X), + start = list(rate = 0.01), + method = "BFGS", + control = list(trace = tracelevel, parscale = 1e-4)) There were 11 warnings (use warnings() to see them) > > > ## gets stuck? will have to investigate ... > m2 <- mle2(minuslogl = f, + data = list(X = X), + start = list(rate = 0.01), + optimizer = "optimize", + lower=1e-9,upper=0.1) > > vcov(m2) rate rate 1.41e-11 > options(old_opt) > > proc.time() user system elapsed 0.732 1.348 1.980 bbmle/tests/mortanal.R0000644000176200001440000000674013013175522014443 0ustar liggesuserslibrary(bbmle) ## goby data in dump format x <- structure(list(indiv = structure(as.integer(c(20, 77, 79, 21, 33, 40, 11, 28, 43, 85, 56, 49, 29, 37, 57, 36, 66, 65, 19, 69, 47, 60, 23, 25, 39, 84, 12, 5, 76, 55, 32, 10, 75, 4, 78, 80, 86, 48, 54, 22, 18, 61, 41, 74, 68, 14, 53, 45, 30, 17, 62, 3, 7, 50, 34, 82, 8, 70, 38, 52, 2, 63, 81, 15, 44, 58, 13, 26, 73, 83, 59, 42, 72, 67, 35, 16, 1, 46, 27, 64, 51, 24, 71, 6, 9, 31)), .Label = c("f10al1", "f10al2", "f10al3", "f10r1", "f10r2", "f11al1", "f11al2", "f11al3", "f11al4", "f11r1", "f11r2", "f11r3", "f12al1", "f12al2", "f12al3", "f12al4", "f12al5", "f12r1", "f12r2", "f12r3", "f12r4", "f12r5", "f12r6", "f13al1", "f13r1", "f14al1", "f14al2", "f14r1", "f14r2", "f15al1", "f15al2", "f15r1", "f15r2", "f18al1", "f18al2", "f18r1", "f18r2", "f19al1", "f19r1", "f19r2", "f1al1", "f1al2", "f1r1", "f20al1", "f20al2", "f20al3", "f20r1", "f20r2", "f20r3", "f2al1", "f2al2", "f2al3", "f2al4", "f2r1", "f2r2", "f2r3", "f2r4", "f3al1", "f3al2", "f3r1", "f3r2", "f4al1", "f5al1", "f5al2", "f5r1", "f5r2", "f6al1", "f6al2", "f6r1", "f7al1", "f7al2", "f7al3", "f7al4", "f7al5", "f7r1", "f7r2", "f7r3", "f7r4", "f7r5", "f7r6", "f9al1", "f9al2", "f9al4", "f9r1", "f9r2", "f9r3" ), class = "factor"), group = structure(as.integer(c(5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)), .Label = c("AL", "AL-Rat5th", "AL-RatOv", "R", "R-ALat5th"), class = "factor"), lifespan = as.integer(c(391, 370, 346, 341, 334, 320, 319, 317, 314, 307, 295, 260, 30, 10, 397, 380, 364, 355, 352, 341, 340, 339, 336, 320, 314, 312, 308, 302, 296, 290, 284, 267, 263, 263, 255, 253, 242, 222, 220, 181, 64, 36, 192, 192, 189, 186, 183, 181, 180, 176, 173, 171, 170, 169, 166, 11, 247, 235, 234, 233, 232, 224, 221, 220, 215, 210, 210, 204, 202, 17, 13, 301, 300, 296, 281, 271, 253, 250, 241, 239, 232, 221, 220, 214, 33, 30))), .Names = c("indiv", "group", "lifespan"), class = "data.frame", row.names = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", "82", "83", "84", "85", "86")) mlife <- log(mean(x$lifespan)) Bm0w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), start=list(llambda=mlife,alpha=1), data=x) Bm1w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), start=list(llambda=mlife,alpha=1), parameters=list(llambda~group), data=x) Bm2w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), start=list(llambda=mlife,alpha=1), parameters=list(llambda~group,alpha~group), data=x) Bm3w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), start=list(llambda=mlife,alpha=3), parameters=list(alpha~group), data=x) anova(Bm0w,Bm1w) anova(Bm0w,Bm1w,Bm2w) anova(Bm0w,Bm3w,Bm2w) AICctab(Bm0w,Bm1w,Bm2w,Bm3w,sort=TRUE,nobs=nrow(x),delta=TRUE) bbmle/tests/order.R0000644000176200001440000000130013013175522013724 0ustar liggesusersset.seed(1001) x <- runif(10) y <- 1000+x+rnorm(10,sd=0.1) d <- data.frame(x,y) library(bbmle) ## warning m1 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=900,b=1,s=log(0.1)), control=list(parscale=c(1000,1,0.1)),data=d) m2 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=900,b=1,s=log(0.1)), control=list(parscale=c(b=1,a=1000,s=0.1)),data=d) m3 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), method="L-BFGS-B",lower=c(a=1100,b=2,s=-Inf),data=d) ## warning m4 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(b=1,a=1200,s=log(0.1)), method="L-BFGS-B",lower=c(2,1100,0.1),data=d) c1 = coef(m3)[c("a","b","s")] c2 = coef(m4)[c("a","b","s")] if (!all(abs(c1-c2)<1e-7)) stop("mismatch") bbmle/tests/optimx.R0000644000176200001440000000122213160353612014135 0ustar liggesuserslibrary(bbmle) old_opt <- options(digits=3) if (require(optimx)) { x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) ## breaks, don't try this ## optimx(fn=Lfn,par=c(15,6),method="Rvmmin") suppressWarnings(m1 <- mle2(minuslogl=y~dpois(lambda=ymax/(1+x/xhalf)), start=list(ymax=15,xhalf=6),data=d, optimizer="optimx", method=c("BFGS","Nelder-Mead","CG"))) ## FIXME!! fails (although not with an error, because ## errors are caught by profiling) due to npar now ## being restricted to >1 in optimx 2012.05.24 ... suppressWarnings(head(as.data.frame(profile(m1)))) detach("package:optimx") } options(old_opt) bbmle/NAMESPACE0000755000176200001440000000275513102162520012556 0ustar liggesusersexport(mle2,call.to.char,namedrop,parnames,"parnames<-",relist2) export(sbinom,snorm,sbeta,snbinom,spois,sbetabinom) export(ICtab,AICtab,BICtab,AICctab) export(stdEr,vcov) export(slice,sliceOld,slice1D,slice2D) export(proffun) exportClasses(mle2,summary.mle2) exportMethods(AIC, AICc, qAICc, qAIC, profile, coef, confint, logLik, update, vcov, anova, deviance, residuals, simulate, predict, formula, plot, stdEr, summary) importClassesFrom(stats4,mle) importFrom(stats4,coef,confint,logLik,BIC,summary,profile,vcov,AIC, update, plot) importFrom(stats, anova,deviance,residuals, simulate,predict,formula,napredict,na.omit,na.exclude) importFrom(methods,setMethod,is) importFrom(lattice,xyplot,splom,diag.panel.splom,panel.abline,panel.number,panel.points,panel.xyplot) ## for slice methods importFrom(numDeriv,hessian,grad,jacobian) importFrom("grDevices", "dev.interactive") importFrom("graphics", "abline", "lines", "par", "points", "text") importFrom("methods", "new") importFrom("stats", "approx", "approxfun", "as.formula", "constrOptim", "deriv", "model.matrix", "na.omit", "nlm", "nlminb", "optimize", "pchisq", "pnorm", "printCoefmat", "qbeta", "qbinom", "qchisq", "qnbinom", "qnorm", "qpois", "setNames", "spline", "uniroot", "update.formula") S3method(as.data.frame,profile.mle2) S3method(print,ICtab) S3method(slice,mle2) S3method(plot,slice) S3method(xyplot,slice) S3method(splom,slice) bbmle/R/0000755000176200001440000000000013175504420011535 5ustar liggesusersbbmle/R/IC.R0000755000176200001440000002251713171536114012166 0ustar liggesusersICtab <- function(...,type=c("AIC","BIC","AICc","qAIC","qAICc"), weights=FALSE,delta=TRUE,base=FALSE, logLik=FALSE, sort=TRUE,nobs=NULL,dispersion=1,mnames,k=2) { ## TO DO: allow inclusion of log-likelihood (or negative log-likelihood?) ## base or delta? or both? Should deltas include delta-df as well? L <- list(...) if (is.list(L[[1]]) && length(L)==1) L <- L[[1]] type <- match.arg(type) if (dispersion !=1) { if (type=="BIC") stop("cannot specify dispersion with BIC") if (substr(type,1,1)!="q") { type = paste("q",type,sep="") warning("dispersion!=1, type changed to ",type) } } if (type=="AICc" || type=="BIC" || type=="qAICc") { if (is.null(nobs)) { ## if(is.null(attr(L[[1]],"nobs"))) ## stop("must specify number of observations if corr=TRUE") ## nobs <- sapply(L,attr,"nobs") nobs <- sapply(L,nobs) if (length(unique(nobs))>1) stop("nobs different: must have identical data for all objects") nobs <- nobs[1] } } ICs <- switch(type, AIC=sapply(L,AIC), BIC=sapply(L,BIC), AICc=sapply(L,AICc,nobs=nobs), qAIC=sapply(L,qAIC,dispersion=dispersion), qAICc=sapply(L,qAICc,nobs=nobs,dispersion=dispersion)) logLiks <- sapply(L,function(x) c(logLik(x))) ## hack: protect against aod method if (is.matrix(ICs)) ICs <- ICs["AIC",] getdf <- function(x) { if (!is.null(df <- attr(x,"df"))) return(df) else if (!is.null(df <- attr(logLik(x),"df"))) return(df) } dIC <- ICs-min(ICs,na.rm=TRUE) dlogLiks <- logLiks-min(logLiks,na.rm=TRUE) df <- sapply(L,getdf) tab <- data.frame(df=df) if (delta) { dName <- paste0("d",type) tab <- cbind(setNames(data.frame(dIC),dName),tab) if (logLik) { tab <- cbind(data.frame(dLogLik=dlogLiks),tab) } } if (base) { tab <- cbind(setNames(data.frame(ICs),type),tab) if (logLik) { tab <- cbind(data.frame(logLik=logLiks),tab) } } if (!delta && !base) stop("either 'base' or 'delta' must be TRUE") if (weights) { dIC_noNA <- na.exclude(dIC) wts <- napredict(attr(dIC_noNA,"na.action"), exp(-dIC_noNA/2)/sum(exp(-dIC_noNA/2))) tab <- data.frame(tab,weight=wts) } if (missing(mnames)) { Call <- match.call() if (!is.null(names(Call))) { xargs <- which(names(Call) %in% names(formals())[-1]) } else xargs <- numeric(0) mnames <- as.character(Call)[c(-1,-xargs)] } row.names(tab) <- mnames if (sort) { tab <- tab[order(ICs),] } class(tab) <- "ICtab" tab } print.ICtab <- function(x,...,min.weight=0.001) { chtab <- format(do.call("cbind",lapply(x,round,1))) rownames(chtab) <- attr(x,"row.names") chtab[,"df"] <- as.character(x$df) if (!is.null(x$weight)) chtab[,"weight"] <- format.pval(x$weight,eps=min.weight, digits=2) print(chtab,quote=FALSE) } AICtab <- function(...,mnames) { ## fancy footwork to preserve model names if (missing(mnames)) mnames <- get.mnames(match.call()) ICtab(...,mnames=mnames,type="AIC") } BICtab <- function(...,mnames) { if (missing(mnames)) mnames <- get.mnames(match.call()) ICtab(...,mnames=mnames,type="BIC") } AICctab <- function(...,mnames) { if (missing(mnames)) mnames <- get.mnames(match.call()) ICtab(...,mnames=mnames,type="AICc") } setGeneric("AICc", function(object, ..., nobs=NULL, k=2) standardGeneric("AICc")) setMethod("AICc", "mle2", function (object, ..., nobs, k) { L <- list(...) if (length(L)) { L = c(list(object), L) # First, we attempt to use the "nobs" attribute if (is.null(nobs)) { nobs <- unlist(lapply(L, attr,"nobs")) } # If that is still null, maybe there's a "nobs" method? if (is.null(nobs)) { nobs <- unlist(lapply(L,nobs)) } if (length(unique(nobs))>1) stop("nobs different: must have identical data for all objects") logLiks <- lapply(L, logLik) df <- sapply(logLiks,attr,"df") val <- -2*unlist(logLiks)+k*df+k*df*(df+1)/(nobs-df-1) data.frame(AICc=val,df=df) } else { if (is.null(nobs)) { nobs <- attr(object,"nobs") } if (is.null(nobs)) { nobs <- nobs(object) } AICc(object=logLik(object), nobs=nobs, k=k) } }) setMethod("AICc", signature(object="logLik"), function(object, ..., nobs, k){ # Handles the "nobs" argument if (missing(nobs)) { if (is.null(attr(object,"nobs"))) stop("number of observations not specified") nobs <- attr(object,"nobs") } if (length(list(...))>1) warning("additional parameters ignored") df <- attr(object,"df") -2*c(object)+k*df+k*df*(df+1)/(nobs-df-1) }) setMethod("AICc", signature(object="ANY"), function(object, ..., nobs, k){ AICc(object=logLik(object, ...), nobs=nobs, k=k) }) setMethod("AIC", "mle2", function (object, ..., k = 2) { L <- list(...) if (length(L)) { L <- c(list(object),L) logLiks <- lapply(L, logLik) AICs <- sapply(logLiks,AIC,k=k) df <- sapply(logLiks,attr,"df") data.frame(AIC=AICs,df=df) } else AIC(logLik(object), k = k) }) ### quasi- methods setGeneric("qAICc", function(object, ..., nobs=NULL, dispersion, k=2) standardGeneric("qAICc")) setMethod("qAICc", signature(object="ANY"), function(object, ..., nobs=NULL, dispersion, k=2){ qAICc(object=logLik(object), nobs=nobs, dispersion=dispersion, k=k) }) setMethod("qAICc", "mle2", function (object, ..., nobs, dispersion, k) { L <- list(...) if (length(L)) { L <- c(list(object),L) if (missing(nobs)) { nobs <- sapply(L,nobs) } if (missing(dispersion) && is.null(attr(object,"dispersion"))) stop("must specify (over)dispersion coefficient") if (length(unique(nobs))>1) stop("nobs different: must have identical data for all objects") nobs <- nobs[1] logLiks <- sapply(L, logLik)/dispersion df <- sapply(L,attr,"df")+1 ## add one for scale parameter val <- logLiks+k*df*(df+1)/(nobs-df-1) data.frame(AICc=val,df=df) } else { df <- attr(object,"df") c(-2*logLik(object)/dispersion+2*df+2*df*(df+1)/(nobs-df-1)) } }) setMethod("qAICc", signature(object="logLik"), function(object, ..., nobs, dispersion, k){ if (missing(nobs)) { if (is.null(attr(object,"nobs"))) stop("number of observations not specified") nobs <- attr(object,"nobs") } if (missing(dispersion)) { if (is.null(attr(object,"dispersion"))) stop("dispersion not specified") dispersion <- attr(object,"dispersion") } df <- attr(object,"df")+1 ## add one for scale parameter -2 * c(object)/dispersion + k*df+2*df*(df+1)/(nobs-df-1) }) setGeneric("qAIC", function(object, ..., dispersion, k=2) standardGeneric("qAIC")) setMethod("qAIC", signature(object="ANY"), function(object, ..., dispersion, k=2){ qAIC(object=logLik(object), dispersion=dispersion, k) }) setMethod("qAIC", signature(object="logLik"), function(object, ..., dispersion, k){ if (missing(dispersion)) { if (is.null(attr(object,"dispersion"))) stop("dispersion not specified") dispersion <- attr(object,"dispersion") } df <- attr(object,"df") -2 * c(object)/dispersion + k*df }) setMethod("qAIC", "mle2", function (object, ..., dispersion, k=2) { L <- list(...) if (length(L)) { L <- c(list(object),L) if (!all(sapply(L,class)=="mle2")) stop("all objects in list must be class mle2") logLiks <- lapply(L, logLik) AICs <- sapply(logLiks,qAIC, k=k, dispersion=dispersion) df <- sapply(L,attr,"df") data.frame(AIC=AICs,df=df) } else { qAIC(logLik(object), k=k, dispersion=dispersion) } }) bbmle/R/dists.R0000755000176200001440000000407113046671362013022 0ustar liggesusers snorm <- function(mean,sd) { list(title="Normal", mean=mean,sd=sd, median=mean, mode=mean, variance=sd^2, sd=sd) } sbinom <- function(size,prob) { list(title="Binomial", prob=prob,size=size, mean=prob*size, median=qbinom(0.5,size,prob), mode=NA, variance=size*prob*(1-prob), sd=sqrt(size*prob*(1-prob)), formula="x*log(prob)+(size-x)*log(1-prob)") } sbeta <- function(shape1,shape2) { list(title="Beta", shape1=shape1,shape2=shape2, mean=shape1/(shape1+shape2), median=qbeta(0.5,shape1,shape2), mode=NA, variance=shape1*shape2/((shape1+shape2)^2*(shape1+shape2+1)), sd=sqrt(shape1*shape2/((shape1+shape2)^2*(shape1+shape2+1)))) } snbinom <- function(size,prob,mu) { if (missing(mu) && !missing(prob)) { mupar <- FALSE mu = NA ## FIXME warning("STUB in snbinom: calc. mu as a function of prob") } if (!missing(mu) && missing(prob)) { mupar <- TRUE prob = size/(size+mu) } v <- if (mupar) mu+mu^2/size else size*(1-prob)/prob^2 list(title="Negative binomial", prob=prob,mu=mu,size=size, mean=if (mupar) mu else size*(1-prob)/prob, median= if (mupar) qnbinom(0.5,mu=mu,size) else qnbinom(0.5,prob=prob,size), mode=NA, variance=v, sd=sqrt(v)) } spois <- function(lambda) { list(title="Poisson", lambda=lambda, mean=lambda, median=qpois(0.5,lambda), mode=NA, variance=lambda, sd=sqrt(lambda)) } sbetabinom <- function(size,prob,theta) { list(title="Beta-binomial", prob=prob,size=size,theta=theta, mean=prob*size, median=NA, ## qbetabinom(0.5,size,prob), mode=NA, variance=size*prob*(1-prob)/theta, sd=sqrt(size*prob*(1-prob))) } sgamma <- function(shape,rate=1,scale=1/rate) { if (missing(rate)) rate <- 1/scale list(title="Gamma", mean=shape/rate,sd=sqrt(shape)/rate, median=NA, mode=NA, variance=shape/rate^2) } bbmle/R/mle2-methods.R0000755000176200001440000001410513072036511014161 0ustar liggesusers## setGeneric("formula", function(x, env = parent.frame(), ...) { ## standardGeneric("formula")}) ## don't know why behaviour of anova() and formula() are different? ## (used setGeneric for anova() without trouble, caused problems here) ## trying to avoid "creating a new generic" message on install? setMethod("formula", "mle2", function(x, env = parent.frame(), ...) { as.formula(x@formula) }) ## stdEr <- function(x, ...) { ## UseMethod("stdEr") ## } setGeneric("stdEr", function(x, ...) { standardGeneric("stdEr")}) setMethod("stdEr","mle2", function(x, ...) { sqrt(diag(x@vcov)) ## why doesn't vcov(x) work here??? }) ## should this be object@fullcoef or object@coef??? or should ## it have an additional argument --- is that possible? setMethod("coef", "mle2", function(object,exclude.fixed=FALSE) { if (!exclude.fixed) object@fullcoef else object@coef }) ## fullcoef <- function(object) object@fullcoef ## this should be a method setMethod("coef", "summary.mle2", function(object) { object@coef }) ## hmmm. Work on this. 'hessian' conflicts with numDeriv definition. Override? ## setMethod("Hessian", sig="mle2", function(object) { object@details$hessian }) setMethod("show", "mle2", function(object){ cat("\nCall:\n") print(object@call.orig) cat("\nCoefficients:\n") print(coef(object)) cat("\nLog-likelihood: ") cat(round(as.numeric(logLik(object)),2),"\n") if (object@optimizer=="optimx" && length(object@method)>1) { cat("Best method:",object@details$method.used,"\n") } if (object@details$conv>0) cat("\nWarning: optimization did not converge (code ", object@details$convergence,": ",object@details$message,")\n",sep="") }) setMethod("show", "summary.mle2", function(object){ cat("Maximum likelihood estimation\n\nCall:\n") print(object@call) cat("\nCoefficients:\n") printCoefmat(coef(object)) cat("\n-2 log L:", object@m2logL, "\n") }) setMethod("show", "profile.mle2", function(object){ cat("Likelihood profile:\n\n") print(object@profile) }) setMethod("summary", "mle2", function(object, waldtest=TRUE, ...){ cmat <- cbind(Estimate = object@coef, `Std. Error` = sqrt(diag(object@vcov))) zval <- cmat[,"Estimate"]/cmat[,"Std. Error"] pval <- 2*pnorm(-abs(zval)) coefmat <- cbind(cmat,"z value"=zval,"Pr(z)"=pval) m2logL <- 2*object@min new("summary.mle2", call=object@call.orig, coef=coefmat, m2logL= m2logL) }) setMethod("logLik", "mle2", function (object, ...) { if(length(list(...))) warning("extra arguments discarded") val <- -object@min attr(val, "df") <- length(object@coef) attr(val, "nobs") <- attr(object,"nobs") class(val) <- "logLik" val }) setGeneric("deviance", function(object, ...) standardGeneric("deviance")) setMethod("deviance", "mle2", function (object, ...) { -2*logLik(object) }) setMethod("vcov", "mle2", function (object, ...) { object@vcov } ) setGeneric("anova", function(object, ...) standardGeneric("anova")) setMethod("anova","mle2", function(object,...,width=getOption("width"), exdent=10) { mlist <- c(list(object),list(...)) ## get names from previous call mnames <- sapply(sys.call(sys.parent())[-1],deparse) ltab <- as.matrix(do.call("rbind", lapply(mlist, function(x) { c("Tot Df"=length(x@coef), Deviance=-2*logLik(x)) }))) terms=sapply(mlist, function(obj) { if (is.null(obj@formula) || obj@formula=="") { mfun <- obj@call$minuslogl mfun <- paste("[",if (is.name(mfun)) { as.character(mfun) } else { "..." }, "]",sep="") paste(mfun,": ",paste(names(obj@coef), collapse="+"),sep="") } else { as.character(obj@formula) } }) mterms <- paste("Model ", 1:length(mnames),": ",mnames,", ",terms,sep="") mterms <- strwrapx(mterms,width=width,exdent=exdent, wordsplit="[ \n\t]") ## trunc.term <- function(s,len) { ## ## cat("***",nchar(s),length(grep("\\+",s)),"\n",sep=" ") ## if ((nchar(s)Chisq)"=c(NA,pchisq(ltab[,"Chisq"][-1], ltab[,"Df"][-1],lower.tail=FALSE))) rownames(ltab) <- 1:nrow(ltab) attr(ltab,"heading") <- heading class(ltab) <- "anova" ltab }) ## translate from profile to data frame, as either ## S3 or S4 method as.data.frame.profile.mle2 <- function(x, row.names = NULL, optional = FALSE, ...) { m1 <- mapply(function(vals,parname) { ## need to unpack the vals data frame so that ## parameter names show up properly do.call("data.frame", c(list(param=rep(parname,nrow(vals))), as.list(vals),focal=list(vals$par.vals[,parname]))) }, x@profile, as.list(names(x@profile)), SIMPLIFY=FALSE) m2 <- do.call("rbind",m1) m2 } setAs("profile.mle2","data.frame", function(from) { as.data.frame.profile.mle2(from) }) ## causes infinite loop, and unnecessary anyway?? ## BIC.mle2 <- stats4:::BIC bbmle/R/predict.R0000754000176200001440000001056013013175520013312 0ustar liggesuserssetGeneric("simulate", function(object, nsim=1, seed=NULL, ...) standardGeneric("simulate")) setMethod("simulate", "mle2", function(object, nsim=1, seed, newdata=NULL, newparams=NULL, ...) { if (!is.null(seed)) set.seed(seed) if (!is.null(newparams)) { object@fullcoef <- newparams } g <- gfun(object,newdata=newdata, nsim=nsim,op="simulate") if (nsim>1) { g <- matrix(g,ncol=nsim) } g }) setGeneric("predict", function(object, ...) standardGeneric("predict")) setMethod("predict", "mle2", function(object,newdata=NULL, location="mean",newparams=NULL, ...) { if (!is.null(newparams)) { object@fullcoef <- newparams } gfun(object,newdata=newdata,location=location,op="predict") }) setGeneric("residuals", function(object, ...) standardGeneric("residuals")) setMethod("residuals", "mle2", function(object, type=c("pearson","response"), location="mean", ...) { type <- match.arg(type) location <- match.arg(location) pred <- predict(object,location) ## not sure this will work ... obs <- with(object@data, get(gsub("~.+","",object@formula))) res <- obs-pred if (type=="response") return(res) vars <- predict(object,location="variance") return(res/sqrt(vars)) }) ## general-purpose function for simulation and ## prediction (the hard part is evaluating the parameters etc.) ## gfun <- function(object,newdata=NULL,location=c("mean","median","variance"), nsim, op=c("predict","simulate")) { ## notes: should operate on formula ## pull out call$formula (not character) location <- match.arg(location) if (class(try(form <- as.formula(object@call$minuslogl)))!="formula") stop("can only use predict() if formula specified") LHS <- form[[3]] ddist = as.character(LHS[[1]]) spref <- switch(op,predict="s",simulate="r") sdist = gsub("^d",spref,ddist) arglist = as.list(LHS)[-1] if (!exists(sdist) || !is.function(get(sdist))) stop("function ",sdist," does not exist") ## evaluate parameters ## evaluate sdist [ newdata > coef > data ] ## if (is.null(object@data)) { ## comb <- newdata ## } else { ## nmatch <- match(names(newdata),names(object@data)) ## comb <- object@data ## comb[na.omit(nmatch)] <- newdata[!is.na(nmatch)] ## comb <- c(comb,newdata[is.na(nmatch)]) ## } ## comb <- c(newdata,object@data) ## comb <- comb[!duplicated(names(comb))] ## comb <- comb[sapply(comb,length)>0] ## rvar <- strsplit(object@formula,"~")[[1]][1] ## comb <- comb[!names(comb)==rvar] ## remove response variable parameters <- eval(object@call$parameters) if (!is.null(parameters)) { vars <- as.character(sapply(parameters,"[[",2)) models <- sapply(parameters,function(z) call.to.char(z[[3]])) parameters <- parameters[models!="1"] npars <- length(parameters) if (npars==0) { ## no non-constant parameters parameters <- mmats <- vpos <- NULL } else { mmats <- list() vpos <- list() for (i in seq(along=parameters)) { vname <- vars[i] p <- parameters[[i]] p[[2]] <- NULL mmat <- with(c(newdata,object@data), model.matrix(p,data=environment())) ## c(as.list(newdata),as.list(object@data))) pnames <- paste(vname,colnames(mmat),sep=".") assign(vname,mmat %*% coef(object)[pnames]) } } } arglist1 <- lapply(arglist,eval,envir=c(newdata,object@data, as.list(coef(object))), enclos=sys.frame(sys.nframe())) ## HACK: need a way to figure out how many data points there ## are, in the *absence* of an explicit data argument ## then replicate constant values to the full length if (op=="simulate") { if (length(object@data)==0) stop("need explicit data argument for simulation") ndata <- max(sapply(c(newdata,object@data),length)) ## ??? arglist1 <- c(arglist1,list(n=ndata*nsim)) } vals <- with(as.list(coef(object)),do.call(sdist,arglist1)) if (op=="predict") return(vals[[location]]) else return(vals) } bbmle/R/profile.R0000755000176200001440000004622413141433254013332 0ustar liggesusers## FIXME: abstract to general-purpose code? (i.e. replace 'fitted' by # objective function, parameter vector, optimizer, method, control settings, ## min val, standard error/Hessian, ... ## ## allow starting values to be set by "mle" (always use mle), "prevfit" ## (default?), and "extrap" (linear extrapolation from previous two fits) ## proffun <- function (fitted, which = 1:p, maxsteps = 100, alpha = 0.01, zmax = sqrt(qchisq(1 - alpha/2, p)), del = zmax/5, trace = FALSE, skiperrs=TRUE, std.err, tol.newmin = 0.001, debug=FALSE, prof.lower, prof.upper, skip.hessian=TRUE, continuation = c("none","naive","linear"), try_harder=FALSE, ...) { ## fitted: mle2 object ## which: which parameters to profile (numeric or char) ## maxsteps: steps to take looking for zmax ## alpha: max alpha level ## zmax: max log-likelihood difference to search to ## del: stepsize ## trace: ## skiperrs: continuation <- match.arg(continuation) if (fitted@optimizer=="optimx") { fitted@call$method <- fitted@details$method.used } if (fitted@optimizer=="constrOptim") stop("profiling not yet working for constrOptim -- sorry") Pnames <- names(fitted@coef) p <- length(Pnames) if (is.character(which)) which <- match(which,Pnames) if (any(is.na(which))) stop("parameters not found in model coefficients") ## global flag for better fit found inside profile fit newpars_found <- FALSE if (debug) cat("i","bi","B0[i]","sgn","step","del","std.err[i]","\n") pfit <- NULL ## save pfit to implement continuation methods ## for subsequent calls to onestep onestep <- function(step,bi) { if (missing(bi)) { bi <- B0[i] + sgn * step * del * std.err[i] if (debug) cat(i,bi,B0[i],sgn,step,del,std.err[i],"\n") } else if (debug) cat(bi,"\n") fix <- list(bi) names(fix) <- p.i if (is.null(call$fixed)) call$fixed <- fix else call$fixed <- c(eval(call$fixed),fix) ## if (continuation!="none") { if (continuation != "naive") stop("only 'naive' continuation implemented") if (!is.null(pfit)) { for (nm in setdiff(names(call$start),names(call$fixed))) { call$start[[nm]] <- coef(pfit)[nm] } } } ## now try to fit ... if (skiperrs) { pfit0 <- try(eval(call, environment(fitted)), silent=TRUE) } else { pfit0 <- eval(call, environment(fitted)) } ok <- !inherits(pfit0,"try-error") ## don't overwrite pfit in environment until we know it's OK ... if (ok) pfit <<- pfit0 if (debug && ok) cat(coef(pfit),-logLik(pfit),"\n") if(skiperrs && !ok) { warning(paste("Error encountered in profile:",pfit0)) return(NA) } else { ## pfit is current (profile) fit, ## fitted is original fit ## pfit@min _should_ be > fitted@min ## thus zz below should be >0 zz <- 2*(pfit@min - fitted@min) ri <- pv0 ri[, names(pfit@coef)] <- pfit@coef ri[, p.i] <- bi ##cat(2*pfit@min,2*fitted@min,zz, ## tol.newmin,zz<(-tol.newmin),"\n") if (!is.na(zz) && zz<0) { if (zz > (-tol.newmin)) { z <- 0 ## HACK for non-monotonic profiles? z <- -sgn*sqrt(abs(zz)) } else { ## cat() instead of warning(); FIXME use message() instead??? ## FIXME: why??? shouldn't this be a warning? message("Profiling has found a better solution,", "so original fit had not converged:\n") message(sprintf("(new deviance=%1.4g, old deviance=%1.4g, diff=%1.4g)", 2*pfit@min,2*fitted@min,2*(pfit@min-fitted@min)),"\n") message("Returning better fit ...\n") ## need to return parameters all the way up ## to top level newpars_found <<- TRUE ## return(pfit@fullcoef) if (!try_harder) return(pfit) ## bail out, return full fit } } else { z <- sgn * sqrt(zz) } pvi <<- rbind(pvi, ri) zi <<- c(zi, z) ## nb GLOBAL set } if (trace) cat(bi, z, "\n") return(z) } ## end onestep ## Profile the likelihood around its maximum ## Based on profile.glm in MASS ## suppressWarnings (don't want to know e.g. about bad vcov) summ <- suppressWarnings(summary(fitted)) if (missing(std.err)) { std.err <- summ@coef[, "Std. Error"] } else { n <- length(summ@coef) if (length(std.err)1) call$upper <- upper[-i] if (!is.null(lower) && length(lower)>1) call$lower <- lower[-i] stop_msg[[i]] <- list(down="",up="") for (sgn in c(-1, 1)) { pfit <- NULL ## reset for continuation method dir_ind <- (sgn+1)/2+1 ## (-1,1) -> (1,2) if (trace) { cat("\nParameter:", p.i, c("down", "up")[dir_ind], "\n") cat("par val","sqrt(dev diff)\n") } step <- 0 z <- 0 ## This logic was a bit frail in some cases with ## high parameter curvature. We should probably at least ## do something about cases where the mle2 call fails ## because the parameter gets stepped outside the domain. ## (We now have.) call$start <- as.list(B0) lastz <- 0 valf <- function(b) { (!is.null(b) && length(b)>1) || (length(b)==1 && i==1 && is.finite(b)) } lbound <- if (!missing(prof.lower)) { prof.lower[i] } else if (valf(lower)) { lower[i] } else -Inf ubound <- if (!missing(prof.upper)) prof.upper[i] else if (valf(upper)) upper[i] else Inf stop_bound <- stop_na <- stop_cutoff <- stop_flat <- FALSE while ((step <- step + 1) < maxsteps && ## added is.na() test for try_harder case ## FIXME: add unit test! (is.na(z) || abs(z) < zmax)) { curval <- B0[i] + sgn * step * del * std.err[i] if ((sgn==-1 & curvalubound)) { stop_bound <- TRUE; stop_msg[[i]][[dir_ind]] <- paste(stop_msg[[i]][[dir_ind]],wfun("hit bound")) break } z <- onestep(step) if (newpars_found && !try_harder) return(pfit) ## stop on flat spot, unless try_harder if (step>1 && (identical(oldcurval,curval) || identical(oldz,z))) { stop_flat <- TRUE stop_msg[[i]][[dir_ind]] <- paste(stop_msg[[i]][[dir_ind]],wfun("hit flat spot"), sep=";") if (!try_harder) break } oldcurval <- curval oldz <- z if(is.na(z)) { stop_na <- TRUE stop_msg[[i]][[dir_ind]] <- paste(stop_msg[[i]][[dir_ind]],wfun("hit NA"),sep=";") if (!try_harder) break } lastz <- z } stop_cutoff <- (!is.na(z) && abs(z)>=zmax) stop_maxstep <- (step==maxsteps) if (stop_maxstep) stop_msg[[i]][[dir_ind]] <- paste(stop_msg[[i]][[dir_ind]],wfun("max steps"),sep=";") if (debug) { if (stop_na) message(wfun("encountered NA"),"\n") if (stop_cutoff) message(wfun("above cutoff"),"\n") } if (stop_flat) { warning(wfun("stepsize effectively zero/flat profile")) } else { if (stop_maxstep) warning(wfun("hit maximum number of steps")) if(!stop_cutoff) { if (debug) cat(wfun("haven't got to zmax yet, trying harder"),"\n") stop_msg[[i]][[dir_ind]] <- paste(stop_msg[[i]][[dir_ind]],wfun("past cutoff"),sep=";") ## now let's try a bit harder if we came up short for(dstep in c(0.2, 0.4, 0.6, 0.8, 0.9)) { curval <- B0[i] + sgn * (step-1+dstep) * del * std.err[i] if ((sgn==-1 & curvalubound)) break z <- onestep(step - 1 + dstep) if (newpars_found && !try_harder) return(pfit) if(is.na(z) || abs(z) > zmax) break lastz <- z if (newpars_found && !try_harder) return(pfit) } if (!stop_cutoff && stop_bound) { if (debug) cat(wfun("bounded and didn't make it, try at boundary"),"\n") ## bounded and didn't make it, try at boundary if (sgn==-1 && B0[i]>lbound) z <- onestep(bi=lbound) if (newpars_found && !try_harder) return(pfit) if (sgn==1 && B0[i]1 below no.xlim <- missing(xlim) no.ylim <- missing(ylim) if (is.character(which)) which <- match(which,nm) ask_orig <- par(ask=ask) op <- list(ask=ask_orig) if (onepage) { nplots <- length(which) ## Q: should we reset par(mfrow), or par(mfg), anyway? if (prod(par("mfcol")) < nplots) { rows <- ceiling(round(sqrt(nplots))) columns <- ceiling(nplots/rows) mfrow_orig <- par(mfrow=c(rows,columns)) op <- c(op,mfrow_orig) } } on.exit(par(op)) confstr <- NULL if (missing(levels)) { levels <- sqrt(qchisq(pmax(0, pmin(1, conf)), 1)) confstr <- paste(format(100 * conf), "%", sep = "") } if (any(levels <= 0)) { levels <- levels[levels > 0] warning("levels truncated to positive values only") } if (is.null(confstr)) { confstr <- paste(format(100 * pchisq(levels^2, 1)), "%", sep = "") } mlev <- max(levels) * 1.05 ## opar <- par(mar = c(5, 4, 1, 1) + 0.1) if (!missing(xlabs) && length(which) This does not need to be monotonic ## cat("**",i,obj[[i]]$par.vals[,i],obj[[i]]$z,"\n") ## FIXME: reconcile this with confint! yvals <- obj[[i]]$par.vals[,nm[i],drop=FALSE] avals <- data.frame(x=unname(yvals), y=obj[[i]]$z) if (!all(diff(obj[[i]]$z)>0)) { warning("non-monotonic profile: reverting to linear interpolation. Consider setting std.err manually") predback <- approxfun(obj[[i]]$z,yvals) } else { sp <- splines::interpSpline(yvals, obj[[i]]$z, na.action=na.omit) avals <- rbind(avals,as.data.frame(predict(sp))) avals <- avals[order(avals$x),] bsp <- try(splines::backSpline(sp),silent=TRUE) bsp.OK <- (class(bsp)[1]!="try-error") if (bsp.OK) { predback <- function(y) { predict(bsp,y)$y } } else { ## backspline failed warning("backspline failed: using uniroot(), confidence limits may be unreliable") ## what do we do? ## attempt to use uniroot predback <- function(y) { pfun0 <- function(z1) { t1 <- try(uniroot(function(z) { predict(sp,z)$y-z1 }, range(obj[[i]]$par.vals[,nm[i]])),silent=TRUE) if (class(t1)[1]=="try-error") NA else t1$root } sapply(y,pfun0) } } } ## if (no.xlim) xlim <- sort(predback(c(-mlev, mlev))) xvals <- obj[[i]]$par.vals[,nm[i]] if (is.na(xlim[1])) xlim[1] <- min(xvals) if (is.na(xlim[2])) xlim[2] <- max(xvals) if (absVal) { if (!add) { if (no.ylim) ylim <- c(0,mlev) plot(abs(obj[[i]]$z) ~ xvals, xlab = xlabs[i], ylab = if (missing(ylab)) expression(abs(z)) else ylab, xlim = xlim, ylim = ylim, type = "n", main=main[i], ...) } avals$y <- abs(avals$y) lines(avals, col = col.prof, lty=lty.prof) if (show.points) points(yvals,abs(obj[[i]]$z)) } else { ## not absVal if (!add) { if (no.ylim) ylim <- c(-mlev,mlev) plot(obj[[i]]$z ~ xvals, xlab = xlabs[i], ylim = ylim, xlim = xlim, ylab = if (missing(ylab)) expression(z) else ylab, type = "n", main=main[i], ...) } lines(avals, col = col.prof, lty=lty.prof) if (show.points) points(yvals,obj[[i]]$z) } x0 <- predback(0) abline(v = x0, h=0, col = col.minval, lty = lty.minval) for (j in 1:length(levels)) { lev <- levels[j] confstr.lev <- confstr[j] ## Note: predict may return NA if we didn't profile ## far enough in either direction. That's OK for the ## "h" part of the plot, but the horizontal line made ## with "l" disappears. pred <- predback(c(-lev, lev)) ## horizontal if (absVal) levs=rep(lev,2) else levs=c(-lev,lev) lines(pred, levs, type = "h", col = col.conf, lty = 2) ## vertical pred <- ifelse(is.na(pred), xlim, pred) if (absVal) { lines(pred, rep(lev, 2), type = "l", col = col.conf, lty = lty.conf) } else { lines(c(x0,pred[2]), rep(lev, 2), type = "l", col = col.conf, lty = lty.conf) lines(c(pred[1],x0), rep(-lev, 2), type = "l", col = col.conf, lty = lty.conf) } if (plot.confstr) { text(labels=confstr.lev,x=x0,y=lev,col=col.conf) } } ## loop over levels } ## loop over variables ## par(opar) }) bbmle/R/slice.R0000755000176200001440000003045213046671362012775 0ustar liggesusers## TO DO: roll back into bbmle? ## allow multiple 'transects'? ## (i.e. if two sets of parameters are given ...) ## * robustification ## print method ## allow manual override of ranges ## allow log-scaling? ## preserve order of parameters in 1D plots ## substitute values of parameters into full parameter vector mkpar <- function(params,p,i) { params[i] <- p params } ## get reasonable range for slice ## document what is done here ## implement upper bound ## more robust approaches; ## try not to assume anything about signs of parameters ## inherit bounds from fitted value get_trange <- function(pars, ## baseline parameter values i, ## focal parameter fun, ## objective function lower=-Inf, ## lower bound upper=Inf, ## upper bound cutoff=10, ## increase above min z-value maxit=200, ## max number of iterations steptype=c("mult","addprop"), step=0.1) { ## step possibilities: multiplicative ## additive (absolute scale) [not yet implemented] addabs <- NULL ## fix false positive test steptype <- match.arg(steptype) v <- v0 <- fun(pars) lowval <- pars[i] it <- 1 if (steptype=="addprop") step <- step*pars[i] while (itlower && v<(v0+cutoff)) { lowval <- switch(steptype, addabs, addpropn=lowval-step, mult=lowval*(1-step)) v <- fun(mkpar(pars,lowval,i)) it <- it+1 } lowdev <- v lowit <- it upval <- pars[i] it <- 1 v <- v0 <- fun(pars) if (upval==0) upval <- 1e-4 while (it=lower & x<=upper)) if (any(!OK)) { warning("some parameter sets outside of bounds were removed") slicep <- slicep[OK] slicepars <- slicepars[OK,] } v <- apply(slicepars, 1, fun) slices <- list(data.frame(var1="trans",x=slicep,z=v)) r <- list(slices=slices,params=params,params2=params2,dim=1) class(r) <- "slice" r } slice1D <- function(params,fun,nt=101, lower=-Inf, upper=Inf, verbose=TRUE, tranges=NULL, ...) { npv <- length(params) if (is.null(pn <- names(params))) pn <- seq(npv) if (is.null(tranges)) { tranges <- get_all_trange(params,fun, rep(lower,length.out=npv), rep(upper,length.out=npv), ...) } slices <- vector("list",npv) for (i in 1:npv) { tvec <- seq(tranges[i,1],tranges[i,2],length=nt) if (verbose) cat(pn[i],"\n") vtmp <- sapply(tvec, function(t) { fun(mkpar(params,t,i))}) slices[[i]] <- data.frame(var1=pn[i],x=tvec,z=vtmp) } r <- list(slices=slices,ranges=tranges,params=params,dim=1) class(r) <- "slice" r } ## OLD slice method ## should probably roll this in as an option to profile ## include attribute, warning? draw differently (leave off ## conf. limit lines) ## slice <- function(fitted, ...) UseMethod("slice") ## 1D slicing implemented as in profile sliceOld <- function (fitted, which = 1:p, maxsteps = 100, alpha = 0.01, zmax = sqrt(qchisq(1 - alpha/2, p)), del = zmax/5, trace = FALSE, tol.newmin=0.001, ...) { onestep <- function(step) { bi <- B0[i] + sgn * step * del * std.err[i] fix <- list(bi) names(fix) <- p.i call$fixed <- c(fix,eval(call$fixed)) call$eval.only = TRUE pfit <- try(eval(call), silent=TRUE) ## if(inherits(pfit, "try-error")) return(NA) else { zz <- 2*(pfit@min - fitted@min) ri <- pv0 ri[, names(pfit@coef)] <- pfit@coef ri[, p.i] <- bi if (zz > -tol.newmin) zz <- max(zz, 0) else stop("profiling has found a better solution, so original fit had not converged") z <- sgn * sqrt(zz) pvi <<- rbind(pvi, ri) zi <<- c(zi, z) ## NB global set! } if (trace) cat(bi, z, "\n") z } ## Profile the likelihood around its maximum ## Based on profile.glm in MASS summ <- summary(fitted) std.err <- summ@coef[, "Std. Error"] Pnames <- names(B0 <- fitted@coef) pv0 <- t(as.matrix(B0)) p <- length(Pnames) prof <- vector("list", length = length(which)) names(prof) <- Pnames[which] call <- fitted@call call$minuslogl <- fitted@minuslogl for (i in which) { zi <- 0 pvi <- pv0 p.i <- Pnames[i] for (sgn in c(-1, 1)) { if (trace) cat("\nParameter:", p.i, c("down", "up")[(sgn + 1)/2 + 1], "\n") step <- 0 z <- 0 ## This logic was a bit frail in some cases with ## high parameter curvature. We should probably at least ## do something about cases where the mle2 call fails ## because the parameter gets stepped outside the domain. ## (We now have.) call$start <- as.list(B0) lastz <- 0 while ((step <- step + 1) < maxsteps && abs(z) < zmax) { z <- onestep(step) if(is.na(z)) break lastz <- z } if(abs(lastz) < zmax) { ## now let's try a bit harder if we came up short for(dstep in c(0.2, 0.4, 0.6, 0.8, 0.9)) { z <- onestep(step - 1 + dstep) if(is.na(z) || abs(z) > zmax) break } } else if(length(zi) < 5) { # try smaller steps mxstep <- step - 1 step <- 0.5 while ((step <- step + 1) < mxstep) onestep(step) } } si <- order(pvi[, i]) prof[[p.i]] <- data.frame(z = zi[si]) prof[[p.i]]$par.vals <- pvi[si,, drop=FALSE] } list(profile = prof, summary = summ) } ## * is it possible to set up the 2D vectors so they include ## the baseline value? maybe not easily ... slice2D <- function(params, fun, nt=31, lower=-Inf, upper=Inf, cutoff=10, verbose=TRUE, tranges=NULL, ...) { npv <- length(params) if (is.null(pn <- names(params))) pn <- seq(npv) if (is.null(tranges)) { tranges <- get_all_trange(params,fun, rep(lower,length.out=npv), rep(upper,length.out=npv), cutoff=cutoff, ...) } slices <- list() for (i in 1:(npv-1)) { slices[[i]] <- vector("list",npv) for (j in (i+1):npv) { if (verbose) cat("param",i,j,"\n") t1vec <- seq(tranges[i,1],tranges[i,2],length=nt) t2vec <- seq(tranges[j,1],tranges[j,2],length=nt) mtmp <- matrix(nrow=nt,ncol=nt) for (t1 in seq_along(t1vec)) { for (t2 in seq_along(t2vec)) { mtmp[t1,t2] <- fun(mkpar(params,c(t1vec[t1],t2vec[t2]), c(i,j))) } } slices[[i]][[j]] <- data.frame(var1=pn[i],var2=pn[j], expand.grid(x=t1vec,y=t2vec), z=c(mtmp)) } } r <- list(slices=slices,ranges=tranges,params=params,dim=2) class(r) <- "slice" r } ## flatten slice: ## do.call(rbind,lapply(slices,do.call,what=rbind)) slices_apply <- function(s,FUN,...) { for (i in seq_along(s)) { for (j in seq_along(s[[i]])) { if (!is.null(s[[i]][[j]])) { s[[i]][[j]] <- FUN(s[[i]][[j]],...) } } } s } xyplot.slice <- function(x,data,type="l",scale.min=TRUE,...) { allslice <- do.call(rbind,x$slices) ## correct ordering allslice$var1 <- factor(allslice$var1, levels=unique(as.character(allslice$var1))) if (scale.min) allslice$z <- allslice$z-min(allslice$z) pfun <- function(x1,y1,...) { panel.xyplot(x1,y1,...) if (is.null(x$params2)) { ## regular 1D slice panel.abline(v=x$params[panel.number()],col="gray") } else { ## 'transect' slice panel.abline(v=c(0,1),col="gray") panel.abline(h=y1[x1 %in% c(0,1)],col="gray") } } xyplot(z~x|var1,data=allslice,type=type, scales=list(x=list(relation="free")), panel=pfun,...) } splom.slice <- function(x, data, scale.min=TRUE, at=NULL, which.x=NULL, which.y=NULL, dstep=4, contour=FALSE,...) { if (x$dim==1) stop("can't do splom on 1D slice object") smat <- t(x$ranges[,1:2]) if (scale.min) { ## FIXME: something more elegant to flatten slice list? all.z <- unlist(sapply(x$slices, function(x) { sapply(x, function(x) if (is.null(x)) NULL else x[["z"]]) })) min.z <- min(all.z[is.finite(all.z)]) ## round up to next multiple of 'dstep' max.z <- dstep * ((max(all.z[is.finite(all.z)])- min.z) %/% dstep + 1) if (missing(at)) { at <- seq(0,max.z,by=dstep) } scale.z <- function(X) { X$z <- X$z-min.z X } x$slices <- slices_apply(x$slices,scale.z) } up0 <- function(x1, y, groups, subscripts, i, j, ...) { ## browser() sl <- x$slices[[j]][[i]] with(sl,panel.levelplot(x=x,y=y,z=z,contour=contour, at=if (!is.null(at)) at else pretty(z), subscripts=seq(nrow(sl)))) panel.points(x$params[j],x$params[i],pch=16) mm <- matrix(sl$z,nrow=length(unique(sl$x))) ## FIXME: more robust ... wmin <- which(mm==min(mm),arr.ind=TRUE) xmin <- unique(sl$x)[wmin[1]] ymin <- unique(sl$y)[wmin[2]] panel.points(xmin,ymin,pch=1) } lp0 <- function(...) { } ## FIXME: use ?draw.colorkey to add a legend ... ## FIXME: make diagonal panel text smaller ??? splom(smat,lower.panel=lp0,diag.panel=diag.panel.splom, upper.panel=up0,...) } ## generic profiling code??? ## either need (1) optimizers with 'masks' or (2) bbmle/R/mle.R0000755000176200001440000007304213076237353012456 0ustar liggesusers## require(methods,quietly=TRUE) ## for independence from stats4 ## require(numDeriv,quietly=TRUE) ## for hessian() call.to.char <- function(x) { ## utility function x <- as.list(x) if (length(x)>1) x <- x[c(2,1,3)] paste(sapply(x,as.character),collapse="") } ## FIXME: problem with bounds and formulae! calc_mle2_function <- function(formula, parameters, links, start, parnames, use.deriv=FALSE, data=NULL, trace=FALSE) { ## resid=FALSE ## stub: what was I going to use this for ??? ## returning residuals rather than mle (e.g. for minpack.nls??) RHS <- formula[[3]] ddistn <- as.character(RHS[[1]]) if (ddistn=="dnorm" && !("sd" %in% names(RHS))) { warning("using dnorm() with sd implicitly set to 1 is rarely sensible") } if (ddistn=="dnbinom" && !("mu" %in% names(RHS))) { } ## need to check on variable order: ## should it go according to function/formula, ## not start? if (!is.list(data)) stop("must specify data argument", " (as a list or data frame)", " when using formula argument") vecstart <- (is.numeric(start)) if (vecstart) start <- as.list(start) ## expand to a list if (missing(parnames) || is.null(parnames)) { parnames <- as.list(names(start)) names(parnames) <- names(start) } ## hack if (!missing(parameters)) { ## linear model specified for some parameters vars <- as.character(sapply(parameters,"[[",2)) if (length(parameters)>1) { models <- sapply(parameters,function(z) call.to.char(z[[3]])) } else { models <- as.character(parameters) } models <- gsub(" ","",models) parameters <- parameters[models!="1"] npars <- length(parameters) if (npars==0) { ## no non-constant parameters parameters <- mmats <- vpos <- NULL } else { ## BUG IN HERE SOMEWHERE, FIXME: SENSITIVE TO ORDER OF 'start' mmats <- list() vpos <- list() pnames0 <- parnames names(parnames) <- parnames for (i in seq(along=parameters)) { vname <- vars[i] ## name of variable p <- parameters[[i]] ## formula for variable p[[2]] <- NULL mmat <- model.matrix(p,data=data) pnames <- paste(vname,colnames(mmat),sep=".") parnames[[vname]] <- pnames ## insert into parameter names vpos0 <- which(pnames0==vname) vposvals <- cumsum(sapply(parnames,length)) ## fill out start vectors with zeros or replicates as appropriate if (length(start[[vname]])==1) { if (length(grep("-1",models[i])>0)) { start[[vname]] <- rep(start[[vname]],length(pnames)) } else { start[[vname]] <- c(start[[vname]],rep(0,length(pnames)-1)) } } ## fix: what if parameters are already correctly specified? startpos <- if (vpos0==1) 1 else vposvals[vpos0-1]+1 vpos[[vname]] <- startpos:vposvals[vpos0] mmats[[vname]] <- mmat } } } else parameters <- vars <- mmats <- vpos <- NULL if (!missing(links)) { stop("parameter link functions not yet implemented") for (i in length(links)) { } } parnames <- unlist(parnames) start <- as.list(unlist(start)) ## collapse/re-expand (WHY?) names(start) <- parnames arglist <- as.list(RHS[-1]) ## delete function name arglist$parameters <- NULL arglist1 <- c(list(x=formula[[2]]),arglist,list(log=TRUE)) arglist1 ## codetools check kluge fn <- function() { ## is there a better way to do this? ## need to look for parameters etc. pars <- unlist(as.list(match.call())[-1]) if (!is.null(parameters)) { for (.i in seq(along=parameters)) { assign(vars[.i],mmats[[.i]] %*% pars[vpos[[.i]]]) } } ## if (is.null(data) || !is.list(data)) ## stop("data argument must be specified when using formula interface") ## BUG/FIXME: data evaluates to 'FALSE' at this point -- regardless of whether ## it has been specified ## FIXME: how to make this eval() less fragile??? ## sys.frame(sys.nframe()) specifies the number of the *current* frame ## ... envir=data,enclos=parent.frame() ## this actually works OK: fails enigmatically if we ## arglist2 <- lapply(arglist1,eval,envir=data, enclos=sys.frame(sys.nframe())) if (use.deriv) { stop("use.deriv is not yet implemented") ## browser() ## minor hack -- should store information otherwise -- could have ## different numbers of arguments for different distributions? LLform <- get(gsub("^d","s",as.character(RHS[[1]])))(NA,NA)$formula avals <- as.list(formula[[3]][-1]) for (i in seq_along(avals)) LLform <- gsub(names(avals)[i],avals[[i]],LLform) r <- eval(deriv(parse(text=LLform),parnames),envir=c(arglist2,data)) } else { r <- -sum(do.call(ddistn,arglist2)) } ## doesn't work yet -- need to eval arglist in the right env ... ## if (debugfn) cat(unlist(arglist),r,"\n") if (trace) cat(pars,r,"\n") r } npars <- length(parnames) flist <- vector("list",npars) names(flist) <- parnames ## add additional parnames? ## browser() ## flist <- c(flist,setdiff(names(arglist),c("x","log",... ?)) formals(fn) <- flist if (vecstart) start <- unlist(start) list(fn=fn,start=start,parameters=parameters, fdata=list(vars=vars,mmats=mmats,vpos=vpos, arglist1=arglist1,ddistn=ddistn,parameters=parameters), parnames=parnames) } ## need logic that will identify correctly when ## we need to pass parameters as a vector mle2 <- function(minuslogl, start, ## =formals(minuslogl), method, optimizer, fixed=NULL, data=NULL, subset=NULL, default.start=TRUE, eval.only = FALSE, vecpar = FALSE, parameters=NULL, parnames=NULL, skip.hessian=FALSE, hessian.opts=NULL, use.ginv=TRUE, trace=FALSE, browse_obj=FALSE, gr=NULL, optimfun, ...) { if (missing(method)) method <- mle2.options("optim.method") if (missing(optimizer)) optimizer <- mle2.options("optimizer") L <- list(...) if (optimizer=="optimize" && (is.null(L$lower) || is.null(L$upper))) stop("lower and upper bounds must be specified when using 'optimize'") if (inherits(minuslogl,"formula")) { pf <- function(f) {if (is.null(f)) { "" } else { paste(f[2],"~", gsub(" ","",as.character(f[3])),sep="") } } if (missing(parameters)) { formula <- pf(minuslogl) } else { formula <- paste(pf(minuslogl), paste(sapply(parameters,pf),collapse=", "),sep=": ") } tmp <- calc_mle2_function(minuslogl,parameters, start=start, parnames=parnames, data=data,trace=trace) minuslogl <- tmp$fn start <- tmp$start fdata <- tmp$fdata parameters <- tmp$parameters } else { formula <- "" fdata <- NULL } call <- match.call() call.orig <- call ## ?? still not sure this is the best thing to do, but: ## evaluate all elements of call ## to make sure it will still function in new environments ... ## call[-1] <- lapply(call[-1],eval.parent) ## call[-1] <- lapply(call[-1],eval,envir=parent.frame(),enclos=parent.frame(2)) ## FAILS if embedded in a funny environment (e.g. called from lapply) ## why do we need this in the first place? ## FIXME: change update(), profile() to re-fit model properly ## rather than evaluating call(), or generally find a less-fragile ## way to do this. Reverting to original form for now. call$data <- eval.parent(call$data) call$upper <- eval.parent(call$upper) call$lower <- eval.parent(call$lower) call$gr <- eval.parent(call$gr) ## FIX based on request from Mark Clements ## call$control$parscale <- eval.parent(call$control$parscale) ## call$control$ndeps <- eval.parent(call$control$ndeps) ## call$control$maxit <- eval.parent(call$control$maxit) call$control <- eval.parent(call$control) call$method <- eval.parent(call$method) if(!missing(start)) if (!is.list(start)) { if (is.null(names(start)) || !is.vector(start)) stop("'start' must be a named vector or named list") ## do we want this or not??? vecpar <- call$vecpar <- TRUE ## given a vector start: set vecpar=TRUE start <- as.list(start) } ## also check parnames(minuslogl)? if (missing(start) && default.start) start <- formals(minuslogl) if (!is.null(fixed) && !is.list(fixed)) { if (is.null(names(fixed)) || !is.vector(fixed)) stop("'fixed' must be a named vector or named list") fixed <- as.list(fixed) } if (!is.null(data) && !is.list(data)) ## && !is.environment(data)) stop("'data' must be a list") nfix <- names(unlist(namedrop(fixed))) if (!is.null(parnames(minuslogl))) { nfull <- parnames(minuslogl) fullcoef <- vector("list",length(nfull)) names(fullcoef) <- nfull } else { fullcoef <- formals(minuslogl) nfull <- names(fullcoef) } if(any(! nfix %in% nfull)) stop("some named arguments in 'fixed' are not arguments to the specified log-likelihood function") if (length(nfix)>0) start[nfix] <- NULL fullcoef[nfix] <- fixed ## switched namedrop() from outside to inside sapply ? nstart <- names(unlist(sapply(namedrop(start),eval.parent))) fullcoef[! nfull %in% nfix & ! nfull %in% nstart ] <- NULL ## delete unnecessary names nfull <- names(fullcoef) lc <- length(call$lower) lu <- length(call$upper) npnfix <- sum(!nfull %in% nfix) if (!npnfix==0 && (lu>npnfix || lc>npnfix )) { warning("length mismatch between lower/upper ", "and number of non-fixed parameters: ", "# lower=",lc,", # upper=",lu,", # non-fixed=",npnfix) } template <- lapply(start, eval.parent) ## preserve list structure! if (vecpar) template <- unlist(template) start <- sapply(namedrop(start), eval.parent) # expressions are allowed; added namedrop nstart <- names(unlist(namedrop(start))) ## named <- length(names(fullcoef)) oo <- match(nstart, names(fullcoef)) if (any(is.na(oo))) stop("some named arguments in 'start' are not arguments to the specified log-likelihood function") ## if (named) start <- start[order(oo)] ## rearrange lower/upper to same order as "start" ## FIXME: use names to rearrange if present fix_order <- function(c1,name,default=NULL) { if (!is.null(c1)) { if (length(unique(c1))>1) { ## not all the same if (is.null(names(c1)) && length(unique(c1))>1) { warning(name," not named: rearranging to match 'start'") oo2 <- oo } else oo2 <- match(names(unlist(namedrop(c1))),names(fullcoef)) c1 <- c1[order(oo2)] } } else c1 <- default c1 } call$lower <- fix_order(call$lower,"lower bounds",-Inf) call$upper <- fix_order(call$upper,"upper bounds",Inf) call$control$parscale <- fix_order(call$control$parscale,"parscale") call$control$ndeps <- fix_order(call$control$ndeps,"ndeps") if (is.null(call$control)) call$control <- list() ## attach(data,warn.conflicts=FALSE) ## on.exit(detach(data)) denv <- local(environment(),c(as.list(data),fdata,list(mleenvset=TRUE))) ## denv <- local(new.env(),c(as.list(data),fdata,list(mleenvset=TRUE))) argnames.in.data <- names(data)[names(data) %in% names(formals(minuslogl))] args.in.data <- lapply(argnames.in.data,get,env=denv) names(args.in.data) <- argnames.in.data args.in.data ## codetools kluge objectivefunction <- function(p){ if (browse_obj) browser() l <- relist2(p,template) ## redo list structure ## if (named) names(p) <- nstart[order(oo)] ## make sure to reorder ## ??? useless, comes after l is constructed ??? l[nfix] <- fixed ## cat("p\n"); print(p) ## cat("l\n"); print(l) ## cat("data\n"); print(data) if (vecpar) { ## if (named) l <- namedrop(l[nfull]) l <- unlist(l) args <- list(l) args <- c(list(l),args.in.data) } else { args <- c(l,args.in.data) } ## eval in environment of minuslogl??? ## doesn't help, environment(minuslogl) is empty by this time ## cat("e3:",length(ls(envir=environment(minuslogl))),"\n") ## hack to remove unwanted names ... do.call("minuslogl",namedrop(args)) } ## end of objective function objectivefunctiongr <- if (!is.null(gr)) function(p) { if (browse_obj) browser() l <- relist2(p,template) ## redo list structure names(p) <- nstart[order(oo)] ## make sure to reorder l[nfix] <- fixed if (vecpar) { l <- namedrop(l[nfull]) l <- unlist(l) args <- list(l) args <- c(list(l),args.in.data) } else { args <- c(l,args.in.data) } v <- do.call("gr",args) if (is.null(names(v))) { if (length(v)==length(l) && !is.null(tt <- names(l))) { ## try to set names from template vnames <- tt } else if (length(v)==length(p) && !is.null(tt <- names(p))) { ## try to set names from params vnames <- tt } else if (!is.null(tt <- parnames(minuslogl))) { ## names were set as an attribute of the function vnames <- tt } else vnames <- names(formals(minuslogl)) if (length(vnames)!=length(v)) stop("name/length mismatch in gradient function") names(v) <- vnames } return(v[!names(v) %in% nfix]) ## from Eric Weese } ## end of gradient function ## FIXME: try to do this by assignment into appropriate ## environments rather than replacing them ... ## only set env if environment has not been previously set! if (!("mleenvset" %in% ls(envir=environment(minuslogl)))) { newenv <- new.env(hash=TRUE,parent=environment(minuslogl)) d <- as.list(denv) mapply(assign,names(d),d, MoreArgs=list(envir=newenv)) environment(minuslogl) <- newenv if (!is.null(gr)) { newenvgr <- new.env(hash=TRUE,parent=environment(minuslogl)) mapply(assign,names(d),d, MoreArgs=list(envir=newenvgr)) environment(gr) <- newenvgr } } if (length(start)==0 || eval.only) { if (length(start)==0) start <- numeric(0) optimizer <- "none" skip.hessian <- TRUE oout <- list(par=start, value=objectivefunction(start), hessian = matrix(NA,nrow=length(start),ncol=length(start)), convergence=0) } else { oout <- switch(optimizer, optim = { arglist <- list(...) arglist$lower <- arglist$upper <- arglist$control <- NULL do.call("optim", c(list(par=start, fn=objectivefunction, method=method, hessian=FALSE, gr=objectivefunctiongr, control=call$control, lower=call$lower, upper=call$upper), arglist)) }, optimx = { ## don't ask, will get us into ## dependency hell ## require("optimx") arglist <- list(...) arglist$lower <- arglist$upper <- arglist$control <- NULL do.call("optimx", c(list(par=start, fn=objectivefunction, method=method, hessian=FALSE, gr=objectivefunctiongr, control=call$control, lower=call$lower, upper=call$upper), arglist)) }, nlm = nlm(f=objectivefunction, p=start, hessian=FALSE, ...), ##!skip.hessian, ## nlminb = nlminb(start=start, objective=objectivefunction, hessian=NULL, ...), constrOptim = constrOptim(theta=start, f=objectivefunction, method=method, ...), optimize=, optimise= optimize(f=objectivefunction, interval=c(call$lower,call$upper), ...), user = { arglist <- list(...) arglist$lower <- arglist$upper <- arglist$control <- NULL do.call(optimfun, c(list(par=start, fn=objectivefunction, method=method, hessian=FALSE, gr=objectivefunctiongr, control=call$control, lower=call$lower, upper=call$upper), arglist)) }, stop("unknown optimizer (choices are 'optim', 'nlm', 'nlminb', 'constrOptim', 'user', and 'optimi[sz]e')") ) } optimval <- switch(optimizer, optim= , constrOptim=, optimx=, user=, none="value", nlm="minimum", optimize=, optimise=, nlminb="objective") if (optimizer=="optimx") { fvals <- oout[["value"]] conv <- oout[["convcode"]] ## best <- if (!any(conv==0)) { best <- which.min(fvals) ## } else { ## fvals <- fvals[conv==0] ## which.min(fvals) ## } oout <- list(par=as.numeric(unlist(oout[best,1:attr(oout,"npar")])), value=fvals[best], convergence=conv[best], method.used=attr(oout,"details")[,"method"][[best]]) ## FIXME: should do profiles only with best method for MLE? } if (optimizer=="nlm") { oout$par <- oout$estimate oout$convergence <- oout$code } if (optimizer %in% c("optimise","optimize")) { oout$par <- oout$minimum oout$convergence <- 0 ## can't detect non-convergence } if (optimizer %in% c("nlminb","optimise","optimize") || ## optimizer (bobyqa?) may have stripped names -- try to restore them! is.null(names(oout$par))) { names(oout$par) <- names(start) } ## compute Hessian if (length(oout$par)==0) skip.hessian <- TRUE if (!skip.hessian) { if ((!is.null(call$upper) || !is.null(call$lower)) && any(oout$par==call$upper) || any(oout$par==call$lower)) warning("some parameters are on the boundary: variance-covariance calculations based on Hessian may be unreliable") } namatrix <- matrix(NA,nrow=length(start),ncol=length(start)) if (!skip.hessian) { psc <- call$control$parscale if (is.null(gr)) { if (is.null(psc)) { oout$hessian <- try(hessian(objectivefunction,oout$par, method.args=hessian.opts)) } else { tmpf <- function(x) { objectivefunction(x*psc) } oout$hessian <- try(hessian(tmpf,oout$par/psc, method.args=hessian.opts))/outer(psc,psc) } } else { ## gradient provided if (is.null(psc)) { oout$hessian <- try(jacobian(objectivefunctiongr,oout$par, method.args=hessian.opts)) } else { tmpf <- function(x) { objectivefunctiongr(x*psc) } oout$hessian <- try(jacobian(tmpf,oout$par/psc, method.args=hessian.opts))/outer(psc,psc) } } } if (skip.hessian || inherits(oout$hessian,"try-error")) oout$hessian <- namatrix coef <- oout$par nc <- names(coef) if (skip.hessian) { tvcov <- matrix(NA,length(coef),length(coef)) } else { if (length(coef)) { if (use.ginv) { tmphess <- try(MASS::ginv(oout$hessian),silent=TRUE) } else { tmphess <- try(solve(oout$hessian,silent=TRUE)) } if (class(tmphess)=="try-error") { tvcov <- matrix(NA,length(coef),length(coef)) warning("couldn't invert Hessian") } else tvcov <- tmphess } else { tvcov <- matrix(numeric(0),0,0) } } dimnames(tvcov) <- list(nc,nc) min <- oout[[optimval]] ## if (named) fullcoef[nstart[order(oo)]] <- coef ## else fullcoef <- coef ## compute termination info ## FIXME: should we worry about parscale here?? if (length(coef)) { gradvec <- if (!is.null(gr)) { objectivefunctiongr(coef) } else { if (inherits(tt <- try(grad(objectivefunction,coef),silent=TRUE), "try-error")) NA else tt } oout$maxgrad <- max(abs(gradvec)) if (!skip.hessian) { if (inherits(ev <- try(eigen(oout$hessian)$value,silent=TRUE), "try-error")) ev <- NA oout$eratio <- min(Re(ev))/max(Re(ev)) } } if (!is.null(conv <- oout$conv) && ((optimizer=="nlm" && conv>2) || (optimizer!="nlm" && conv!=0))) { ## warn of convergence failure if (is.null(oout$message)) { cmsg <- "unknown convergence failure: refer to optimizer documentation" if (optimizer=="optim") { if (conv==1) cmsg <- "iteration limit 'maxit' reached" if (conv==10) cmsg <- "degenerate Nelder-Mead simplex" } else if (optimizer=="nlm") { if (conv==3) cmsg <- "last global step failed to locate a point lower than 'estimate': see ?nlm" if (conv==4) cmsg <- "iteration limit exceeded" if (conv==5) cmsg <- "maximum step size 'stepmax' exceeded five consecutive times: see ?nlm" } } else cmsg <- oout$message warning(paste0("convergence failure: code=",conv," (",cmsg,")")) } m <- new("mle2", call=call, call.orig=call.orig, coef=coef, fullcoef=unlist(fullcoef), vcov=tvcov, min=min, details=oout, minuslogl=minuslogl, method=method, optimizer=optimizer,data=as.list(data),formula=formula) attr(m,"df") = length(m@coef) if (!missing(data)) attr(m,"nobs") = length(data[[1]]) environment(m) <- parent.frame() ## to work with BIC as well m } get.mnames <- function(Call) { xargs <- which(names(Call) %in% names(formals(ICtab))[-1]) mnames <- as.character(Call)[c(-1,-xargs)] if (length(mnames)==1) { g <- get(mnames) if (is.list(g) && length(g)>1) { if (is.null(names(g))) mnames <- paste("model",1:length(g),sep="") else mnames <- names(g) if (any(duplicated(mnames))) stop("model names must be distinct") } } mnames } mle2.options <- function(...) { single <- FALSE args <- list(...) setvals <- !is.null(names(args)) if (!length(args)) args <- names(.Mle2.options) if (all(unlist(lapply(args, is.character)))) args <- as.list(unlist(args)) if (length(args) == 1) { if (is.list(args[[1]]) | is.null(args[[1]])) args <- args[[1]] else if (!setvals) single <- TRUE } if (setvals) { .Mle2.options[names(args)] <<- args value <- .Mle2.options[names(args)] } else value <- .Mle2.options[unlist(args)] if (single) value <- value[[1]] if (setvals) invisible(value) else value } .Mle2.options = list(optim.method="BFGS",confint = "spline",optimizer="optim") ## .onLoad <- function(lib, pkg) require(methods) ## (not yet) replaced by relist? ## reconstruct list structure: ## v is a vector, l is the original list ## to use as a template relist2 <- function(v,l) { if (is.list(v)) v <- unlist(v) if (!all(sapply(l,mode)=="numeric")) { stop("can't relist non-numeric values") } lens = sapply(l,length) if (all(lens==1)) return(as.list(v)) l2 <- split(v,rep(1:length(l),lens)) names(l2) <- names(l) l3 <- mapply(function(x,y) { if (!is.null(dim(y))) { z=array(x,dim(y)); dimnames(z)=dimnames(y); z } else { z=x; names(z)=names(y); z } },l2,l,SIMPLIFY=FALSE) names(l3) <- names(l) l3 } namedrop <- function(x) { if (!is.list(x)) x for (i in seq(along=x)) { ## cat(i,length(x),"\n") n = names(x[[i]]) lx = length(x[[i]]) if (!is.null(n)) { if (lx==1) { names(x[[i]]) <- NULL } else if (length(unique(n)) 0) { words <- words[-zLenInd] nc <- nc[-zLenInd] } } if (length(words) == 0) { yi <- c(yi, "", prefix) next } currentIndex <- 0 lowerBlockIndex <- 1 upperBlockIndex <- integer(0) lens <- cumsum(nc + 1) first <- TRUE maxLength <- width - nchar(prefix, type = "w") - indent while (length(lens) > 0) { k <- max(sum(lens <= maxLength), 1) if (first) { first <- FALSE maxLength <- maxLength + indent - exdent } currentIndex <- currentIndex + k if (nc[currentIndex] == 0) upperBlockIndex <- c(upperBlockIndex, currentIndex - 1) else upperBlockIndex <- c(upperBlockIndex, currentIndex) if (length(lens) > k) { if (nc[currentIndex + 1] == 0) { currentIndex <- currentIndex + 1 k <- k + 1 } lowerBlockIndex <- c(lowerBlockIndex, currentIndex + 1) } if (length(lens) > k) lens <- lens[-(1:k)] - lens[k] else lens <- NULL } nBlocks <- length(upperBlockIndex) s <- paste(prefix, c(indentString, rep.int(exdentString, nBlocks - 1)), sep = "") for (k in (1:nBlocks)) { s[k] <- paste(s[k], paste(words[lowerBlockIndex[k]:upperBlockIndex[k]], collapse = " "), sep = "") } s = gsub("\\+ ","+",s) ## kluge yi <- c(yi, s, prefix) } y <- if (length(yi)) c(y, list(yi[-length(yi)])) else c(y, "") } if (simplify) y <- unlist(y) y } bbmle/R/update.R0000754000176200001440000000266213013175520013146 0ustar liggesusers## setGeneric("update", function(object, formula., ..., evaluate=TRUE) ## standardGeneric("update")) ## FIXME: compare these two ## setMethod("update", "mle2", ## function (object, ..., evaluate = TRUE) ## { ## call <- object@call ## extras <- match.call(expand.dots = FALSE)$... ## if (length(extras) > 0) { ## existing <- !is.na(match(names(extras), names(call))) ## for (a in names(extras)[existing]) call[[a]] <- extras[[a]] ## if (any(!existing)) { ## call <- c(as.list(call), extras[!existing]) ## call <- as.call(call) ## } ## } ## if (evaluate) eval(call, parent.frame()) else call ## }) ## update.default, modified with $ turned to @ as appropriate setMethod("update", "mle2", function (object, formula., evaluate = TRUE, ...) { call <- object@call extras <- match.call(expand.dots = FALSE)$... if (!missing(formula.)) call$minuslogl <- update.formula(formula(object), formula.) if (length(extras)) { existing <- !is.na(match(names(extras), names(call))) for (a in names(extras)[existing]) call[[a]] <- extras[[a]] if (any(!existing)) { call <- c(as.list(call), extras[!existing]) call <- as.call(call) } } if (evaluate) eval(call, parent.frame()) else call }) bbmle/R/confint.R0000754000176200001440000001315113175227223013326 0ustar liggesuserssetMethod("confint", "profile.mle2", function (object, parm, level = 0.95, trace=FALSE, ...) { Pnames <- names(object@profile) if (missing(parm)) parm <- Pnames if (is.character(parm)) parm <- match(parm,Pnames) if (any(is.na(parm))) stop("parameters not found in profile") ## Calculate confidence intervals based on likelihood ## profiles a <- (1 - level)/2 a <- c(a, 1 - a) pct <- paste(round(100 * a, 1), "%") ci <- array(NA, dim = c(length(parm), 2), dimnames = list(Pnames[parm], pct)) cutoff <- qnorm(a) for (pm in parm) { pro <- object@profile[[Pnames[pm]]] pv <- pro[,"par.vals"] if (is.matrix(pv)) pv <- pv[,Pnames[pm]] if (any(diff(pro[,1])<0)) { warning(paste("non-monotonic profile (", Pnames[pm],"): reverting from spline to linear approximation ", "(consider running 'profile' with manually reduced std.err)", sep="")) tt <- approx(pro[,1],pv,xout=cutoff)$y } else { sp <- spline(x = pv, y = pro[, 1]) if (any(diff(sp$y)<0)) { warning(paste("non-monotonic spline fit to profile (", Pnames[pm],"): reverting from spline to linear approximation",sep="")) tt <- approx(pro[,1],pv,xout=cutoff)$y } else { tt <- try(approx(sp$y, sp$x, xout = cutoff)$y,silent=TRUE) if (inherits(tt,"try-error")) tt <- rep(NA,2) } } if (!any(is.na(tt))) { ## if NAs present, sort() will drop NAs ... tt <- sort(tt) } ci[Pnames[pm], ] <- tt } drop(ci) }) setMethod("confint", "mle2", function (object, parm, level = 0.95, method, trace=FALSE,quietly=!interactive(), tol.newmin=0.001,...) { if (missing(method)) method <- mle2.options("confint") ## changed coef() calls to object@coef -- really *don't* want fullcoef! Pnames <- names(object@coef) if (missing(parm)) parm <- seq(along=Pnames) if (is.character(parm)) parm <- match(parm,Pnames) if (any(is.na(parm))) stop("parameters not found in model coefficients") if (method=="spline") { if (!quietly) message("Profiling...\n") newpars_found <- FALSE prof = try(profile(object,which=parm,tol.newmin=tol.newmin,...)) if (inherits(prof,"try-error")) stop(paste("Problem with profiling:",prof)) if (class(prof)=="mle2") newpars_found <- TRUE if (newpars_found) { ## profiling found a better fit message("returning better fit\n") return(prof) } return(confint(prof, parm, level, ...)) } else { B0 <- object@coef pnames <- names(B0) if (missing(parm)) parm <- seq(along=pnames) if (is.character(parm)) parm <- match(parm, pnames, nomatch = 0) a <- (1 - level)/2 a <- c(a, 1 - a) pct <- paste(round(100 * a, 1), "%") pct <- paste(round(100 * a, 1), "%") ci <- array(NA, dim = c(length(parm), 2), dimnames = list(pnames[parm], pct)) std.err <- summary(object)@coef[, "Std. Error"] if (method=="uniroot") { chisqcutoff <- qchisq(level,1) call <- object@call if (!isTRUE(call$vecpar)) call$start <- as.list(B0) ## added upper <- rep(unlist(eval.parent(call$upper)),length.out=length(pnames)) lower <- rep(unlist(eval.parent(call$lower)),length.out=length(pnames)) for (pm in parm) { critfun <- function(bi) { fix <- list(bi) names(fix) <- pnames[pm] call$fixed <- c(fix,eval(call$fixed)) if (!is.null(upper) && length(upper)>1) call$upper <- upper[-pm] if (!is.null(lower) && length(lower)>1) call$lower <- lower[-pm] pfit <- try(eval(call), silent=TRUE) if(inherits(pfit, "try-error")) { warning(paste("Error encountered in profile (uniroot):",pfit)) return(NA) } else { zz <- 2*pfit@min - 2*(-logLik(object)) if (zz > -tol.newmin) zz <- max(zz, 0) else stop(sprintf("profiling has found a better solution (old deviance=%.2f, new deviance=%.2f), so original fit had not converged",2*pfit@min,2*(-logLik(object)))) z <- zz - chisqcutoff } if (trace) cat(bi, z, "\n") z } stepfun <- function(step) { B0[pm] + sgn * step * std.err[pm] } invstepfun <- function(out) { (out - B0[pm])/(sgn * std.err[pm]) } sgnvec=c(-1,1) for (i in 1:2) { sgn <- sgnvec[i] bnd <- if (sgn<0) { if (is.null(lower)) -Inf else lower[pm] } else { if (is.null(upper)) Inf else upper[pm] } c0 <- critfun(B0[pm]) bi <- ctry <- pmin(5,invstepfun(bnd)) cdel <- -0.25 c5 <- NA while (is.na(c5) && ctry>0 ) { c5 <- critfun(stepfun(ctry)) if (is.na(c5)) { if (trace) cat("encountered NA, reducing ctry to",ctry+cdel,"\n") ctry <- ctry+cdel } } if (trace) cat(c0,c5,"\n") if (is.na(c0*c5) || c0*c5>0) { warning(paste("can't find confidence limits in", c("negative","positive")[i],"direction")) curci <- NA ## FIXME: could try harder! } else { curci <- uniroot(critfun,c(stepfun(0),stepfun(ctry)))$root } ci[pnames[pm],i] <- curci } } } else if (method=="quad") { for (pm in parm) { ci[pnames[pm],] <- qnorm(a,B0[pm],std.err[pm]) } } else stop("unknown method") return(drop(ci)) } }) bbmle/R/mle2-class.R0000754000176200001440000000250713171403641013627 0ustar liggesusers## must go before setAs to avoid warnings setClass("mle2", slots=c(call = "language", call.orig = "language", coef = "numeric", fullcoef = "numeric", vcov = "matrix", min = "numeric", details = "list", minuslogl = "function", method = "character", data="list", formula="character", optimizer="character")) setAs("mle","mle2", function(from,to) { new("mle2", call=from@call, call.orig=from@call, coef=from@coef, fullcoef=from@fullcoef, vcov=from@vcov, min=from@min, details=from@details, minuslogl=from@minuslogl, method=from@method, data=list(), formula="", optimizer="optim") }) setClass("summary.mle2", slots=c(call = "language", coef = "matrix", m2logL = "numeric")) setClass("profile.mle2", slots=c(profile="list", summary="summary.mle2")) setClass("slice.mle2", slots=c(profile="list", summary="summary.mle2")) setIs("profile.mle2", "slice.mle2") bbmle/vignettes/0000755000176200001440000000000013175504420013344 5ustar liggesusersbbmle/vignettes/mle2.Rnw0000754000176200001440000007541313022107177014706 0ustar liggesusers\documentclass{article} %\VignetteIndexEntry{Examples for enhanced mle code} %\VignettePackage{bbmle} %\VignetteDepends{Hmisc} %\VignetteDepends{emdbook} %\VignetteDepends{ggplot2} %\VignetteDepends{lattice} %\VignetteEngine{knitr::knitr} \usepackage[utf8]{inputenc} % for UTF-8/single quotes from sQuote() \usepackage[english]{babel} % for texi2dvi ~ bug \usepackage{graphicx} \usepackage{natbib} \usepackage{array} \usepackage{color} \usepackage[colorlinks=true,urlcolor=blue,bookmarks=true]{hyperref} \usepackage{url} \author{Ben Bolker} \title{Maximum likelihood estimation and analysis with the \code{bbmle} package} \newcommand{\code}[1]{{\tt #1}} \newcommand{\bbnote}[1]{\color{red} {\em #1} \color{black}} \date{\today} \begin{document} \bibliographystyle{chicago} %\bibliographystyle{plain} \maketitle \tableofcontents <>= if (require("knitr")) opts_chunk$set(fig.width=5,fig.height=5,tidy=FALSE,warning=FALSE,error=TRUE) @ <>= library(Hmisc) @ The \code{bbmle} package, designed to simplify maximum likelihood estimation and analysis in R, extends and modifies the \code{mle} function and class in the \code{stats4} package that comes with R by default. \code{mle} is in turn a wrapper around the \code{optim} function in base R. The maximum-likelihood-estimation function and class in \code{bbmle} are both called \code{mle2}, to avoid confusion and conflict with the original functions in the \code{stats4} package. The major differences between \code{mle} and \code{mle2} are: \begin{itemize} \item \code{mle2} is more robust, with additional warnings (e.g. if the Hessian can't be computed by finite differences, \code{mle2} returns a fit with a missing Hessian rather than stopping with an error) \item \code{mle2} uses a \code{data} argument to allow different data to be passed to the negative log-likelihood function \item \code{mle2} has a formula interface like that of (e.g.) \code{gls} in the \code{nlme} package. For relatively simple models the formula for the maximum likelihood can be written in-line, rather than defining a negative log-likelihood function. The formula interface also simplifies fitting models with categorical variables. Models fitted using the formula interface also have applicable \code{predict} and \code{simulate} methods. \item \code{bbmle} defines \code{anova}, \code{AIC}, \code{AICc}, and \code{BIC} methods for \code{mle2} objects, as well as \code{AICtab}, \code{BICtab}, \code{AICctab} functions for producing summary tables of information criteria for a set of models. \end{itemize} Other packages with similar functionality (extending GLMs in various ways) are \begin{itemize} \item on CRAN: \code{aods3} (overdispersed models such as beta-binomial); \code{vgam} (a wide range of models); \code{betareg} (beta regression); \code{pscl} (zero-inflated, hurdle models); \code{maxLik} (another general-purpose maximizer, with a different selection of optimizers) \item In Jim Lindsey's code repository (\url{http://popgen.unimaas.nl/~jlindsey/rcode.html}): \code{gnlr} and \code{gnlr3} \end{itemize} \section{Example: \emph{Orobanche}/overdispersed binomial} This example will use the classic data set on \emph{Orobanche} germination from \cite{Crowder1978} (you can also use \code{glm(...,family="quasibinomial")} or the \code{aods3} package to analyze these data). \subsection{Test basic fit to simulated beta-binomial data} First, generate a single beta-binomially distributed set of points as a simple test. Load the \code{emdbook} package to get functions for the beta-binomial distribution (random-deviate function \code{rbetabinom} --- these functions are also available in Jim Lindsey's \code{rmutil} package). <>= library(emdbook) @ Generate random deviates from a random beta-binomial: <>= set.seed(1001) x1 <- rbetabinom(n=1000,prob=0.1,size=50,theta=10) @ Load the package: <>= library(bbmle) @ Construct a simple negative log-likelihood function: <>= mtmp <- function(prob,size,theta) { -sum(dbetabinom(x1,prob,size,theta,log=TRUE)) } @ Fit the model --- use \code{data} to pass the \code{size} parameter (since it wasn't hard-coded in the \code{mtmp} function): <>= (m0 <- mle2(mtmp,start=list(prob=0.2,theta=9),data=list(size=50))) @ (here and below, I'm suppressing lots of warnings about {\tt NaNs produced}) The \code{summary} method for \code{mle2} objects shows the parameters; approximate standard errors (based on quadratic approximation to the curvature at the maximum likelihood estimate); and a test of the parameter difference from zero based on this standard error and on an assumption that the likelihood surface is quadratic (or equivalently that the sampling distribution of the estimated parameters is normal). <>= summary(m0) @ Construct the likelihood profile (you can apply \code{confint} directly to \code{m0}, but if you're going to work with the likelihood profile [e.g. plotting, or looking for confidence intervals at several different $\alpha$ values] then it is more efficient to compute the profile once): <>= p0 <- profile(m0) @ Compare the confidence interval estimates based on inverting a spline fit to the profile (the default); based on the quadratic approximation at the maximum likelihood estimate; and based on root-finding to find the exact point where the profile crosses the critical level. <>= confint(p0) confint(m0,method="quad") confint(m0,method="uniroot") @ All three types of confidence limits are similar. Plot the profiles: <>= par(mfrow=c(1,2)) plot(p0,plot.confstr=TRUE) @ By default, the plot method for likelihood profiles displays the square root of the the deviance difference (twice the difference in negative log-likelihood from the best fit), so it will be {\sf V}-shaped for cases where the quadratic approximation works well (as in this case). (For a better visual estimate of whether the profile is quadratic, use the \code{absVal=FALSE} option to the \code{plot} method.) You can also request confidence intervals calculated using \code{uniroot}, which may be more exact when the profile is not smooth enough to be modeled accurately by a spline. However, this method is also more sensitive to numeric problems. Instead of defining an explicit function for \code{minuslogl}, we can also use the formula interface. The formula interface assumes that the density function given (1) has \code{x} as its first argument (if the distribution is multivariate, then \code{x} should be a matrix of observations) and (2) has a \code{log} argument that will return the log-probability or log-probability density if \code{log=TRUE}. Some of the extended functionality (prediction etc.) depends on the existence of an \code{s}- variant function for the distribution that returns (at least) the mean and median as a function of the parameters (currently defined: \code{snorm}, \code{sbinom}, \code{sbeta}, \code{snbinom}, \code{spois}). <>= m0f <- mle2(x1~dbetabinom(prob,size=50,theta), start=list(prob=0.2,theta=9),data=data.frame(x1)) @ Note that you must specify the data via the \code{data} argument when using the formula interface. This may be slightly more unwieldy than just pulling the data from your workspace when you are doing simple things, but in the long run it makes tasks like predicting new responses much simpler. It's convenient to use the formula interface to try out likelihood estimation on the transformed parameters: <>= m0cf <- mle2(x1~dbetabinom(prob=plogis(lprob),size=50,theta=exp(ltheta)), start=list(lprob=0,ltheta=2),data=data.frame(x1)) confint(m0cf,method="uniroot") confint(m0cf,method="spline") @ In this case the answers from \code{uniroot} and \code{spline} (default) methods barely differ. \subsection{Real data (\emph{Orobanche}, \cite{Crowder1978})} Data are copied from the \code{aods3} package (but a copy is saved with the package to avoid depending on the \code{aods3} package): <>= load(system.file("vignetteData","orob1.rda",package="bbmle")) summary(orob1) @ Now construct a negative log-likelihood function that differentiates among groups: <>= ML1 <- function(prob1,prob2,prob3,theta,x) { prob <- c(prob1,prob2,prob3)[as.numeric(x$dilution)] size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } @ Results from \cite{Crowder1978}: <>= crowder.results <- matrix(c(0.132,0.871,0.839,78.424,0.027,0.028,0.032,-34.991, rep(NA,7),-34.829, rep(NA,7),-56.258), dimnames=list(c("prop diffs","full model","homog model"), c("prob1","prob2","prob3","theta","sd.prob1","sd.prob2","sd.prob3","NLL")), byrow=TRUE,nrow=3) latex(crowder.results,file="",table.env=FALSE,title="model") @ <>= (m1 <- mle2(ML1,start=list(prob1=0.5,prob2=0.5,prob3=0.5,theta=1), data=list(x=orob1))) @ Or: <>= ## would prefer ~dilution-1, but problems with starting values ... (m1B <- mle2(m~dbetabinom(prob,size=n,theta), param=list(prob~dilution), start=list(prob=0.5,theta=1), data=orob1)) @ The result warns us that the optimization has not converged; we also don't match Crowder's results for $\theta$ exactly. We can fix both of these problems by setting \code{parscale} appropriately. Since we don't bound $\theta$ (or below, $\sigma$) we get a fair number of warnings with this and the next few fitting and profiling attempts. We will ignore these for now, since the final results reached are reasonable (and match or nearly match Crowder's values); the appropriate, careful thing to do would be either to fit on a transformed scale where all real-valued parameter values were legal, or to use \code{method="L-BFGS-B"} (or \code{method="bobyqa"} with the \code{optimx} package) to bound the parameters appropriately. You can also use \code{suppressWarnings()} if you're sure you don't need to know about any warnings (beware: this will suppress \emph{all} warnings, those you weren't expecting as well as those you were \ldots) <>= opts_chunk$set(warning=FALSE) @ <>= (m2 <- mle2(ML1,start=as.list(coef(m1)), control=list(parscale=coef(m1)), data=list(x=orob1))) @ Calculate likelihood profile (restrict the upper limit of $\theta$, simply because it will make the picture below a little bit nicer): <>= p2 <- profile(m2,prof.upper=c(Inf,Inf,Inf,theta=2000)) @ Get the curvature-based parameter standard deviations (which Crowder used rather than computing likelihood profiles): <>= round(stdEr(m2),3) @ We are slightly off Crowder's numbers --- rounding error? Crowder also defines a variance (overdispersion) parameter $\sigma^2=1/(1+\theta)$. <>= sqrt(1/(1+coef(m2)["theta"])) @ Using the delta method (via the \code{deltavar} function in the \code{emdbook} package) to approximate the standard deviation of $\sigma$: <>= sqrt(deltavar(sqrt(1/(1+theta)),meanval=coef(m2)["theta"], vars="theta",Sigma=vcov(m2)[4,4])) @ Another way to fit in terms of $\sigma$ rather than $\theta$ is to compute $\theta=1/\sigma^2-1$ on the fly in a formula: <>= m2b <- mle2(m~dbetabinom(prob,size=n,theta=1/sigma^2-1), data=orob1, parameters=list(prob~dilution,sigma~1), start=list(prob=0.5,sigma=0.1)) ## ignore warnings (we haven't bothered to bound sigma<1) round(stdEr(m2b)["sigma"],3) p2b <- profile(m2b,prof.lower=c(-Inf,-Inf,-Inf,0)) @ As might be expected since the standard deviation of $\sigma$ is large, the quadratic approximation is poor: <>= r1 <- rbind(confint(p2)["theta",], confint(m2,method="quad")["theta",]) rownames(r1) <- c("spline","quad") r1 @ Plot the profile: <>= plot(p2,which="theta",plot.confstr=TRUE) @ What does the profile for $\sigma$ look like? <>= plot(p2b,which="sigma",plot.confstr=TRUE, show.points=TRUE) @ Now fit a homogeneous model: <>= ml0 <- function(prob,theta,x) { size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } m0 <- mle2(ml0,start=list(prob=0.5,theta=100), data=list(x=orob1)) @ The log-likelihood matches Crowder's result: <>= logLik(m0) @ It's easier to use the formula interface to specify all three of the models fitted by Crowder (homogeneous, probabilities differing by group, probabilities and overdispersion differing by group): <>= m0f <- mle2(m~dbetabinom(prob,size=n,theta), parameters=list(prob~1,theta~1), data=orob1, start=list(prob=0.5,theta=100)) m2f <- update(m0f, parameters=list(prob~dilution,theta~1), start=list(prob=0.5,theta=78.424)) m3f <- update(m0f, parameters=list(prob~dilution,theta~dilution), start=list(prob=0.5,theta=78.424)) @ \code{anova} runs a likelihood ratio test on nested models: <>= anova(m0f,m2f,m3f) @ The various \code{ICtab} commands produce tables of information criteria; by default the results are sorted and presented as $\Delta$IC; there are various options, including printing model weights. <>= AICtab(m0f,m2f,m3f,weights=TRUE) BICtab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) AICctab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) @ <>= opts_chunk$set(warning=FALSE) @ \section{Example: reed frog size predation} Data from an experiment by Vonesh \citep{VoneshBolker2005} <>= frogdat <- data.frame( size=rep(c(9,12,21,25,37),each=3), killed=c(0,2,1,3,4,5,rep(0,4),1,rep(0,4))) frogdat$initial <- rep(10,nrow(frogdat)) @ <>= library(ggplot2) @ <>= gg1 <- ggplot(frogdat,aes(x=size,y=killed))+geom_point()+ stat_sum(aes(size=..n..))+ labs(size="#")+scale_x_continuous(limits=c(0,40))+ scale_size(breaks=1:3) @ <>= m3 <- mle2(killed~dbinom(prob=c*(size/d)^g*exp(1-size/d), size=initial),data=frogdat,start=list(c=0.5,d=5,g=1)) pdat <- data.frame(size=1:40,initial=rep(10,40)) pdat1 <- data.frame(pdat,killed=predict(m3,newdata=pdat)) @ <>= m4 <- mle2(killed~dbinom(prob=c*((size/d)*exp(1-size/d))^g, size=initial),data=frogdat,start=list(c=0.5,d=5,g=1)) pdat2 <- data.frame(pdat,killed=predict(m4,newdata=pdat)) @ <>= gg1 + geom_line(data=pdat1,colour="red")+ geom_line(data=pdat2,colour="blue") @ <>= coef(m4) prof4 <- profile(m4) @ Three different ways to draw the profile: (1) Built-in method (base graphics): <>= plot(prof4) @ (2) Using \code{xyplot} from the \code{lattice} package: \setkeys{Gin}{width=\textwidth} <>= prof4_df <- as.data.frame(prof4) library(lattice) xyplot(abs(z)~focal|param,data=prof4_df, subset=abs(z)<3, type="b", xlab="", ylab=expression(paste(abs(z), " (square root of ",Delta," deviance)")), scale=list(x=list(relation="free")), layout=c(3,1)) @ (3) Using \code{ggplot} from the \code{ggplot2} package: <>= ss <-subset(prof4_df,abs(z)<3) ggplot(ss, aes(x=focal,y=abs(z)))+geom_line()+ geom_point()+ facet_grid(.~param,scale="free_x") @ \section*{Additions/enhancements/differences from \code{stats4::mle}} \begin{itemize} \item{\code{anova} method} \item{warnings on convergence failure} \item{more robust to non-positive-definite Hessian; can also specify \code{skip.hessian} to skip Hessian computation when it is problematic} \item{when profiling fails because better value is found, report new values} \item{can take named vectors as well as lists as starting parameter vectors} \item{added \code{AICc}, \code{BIC} definitions, \code{ICtab} functions} \item{added \code{"uniroot"} and \code{"quad"} options to \code{confint}} \item{more options for colors and line types etc etc. The old arguments are: <>= function (x, levels, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, absVal = TRUE, ...) {} @ The new one is: <>= function (x, levels, which=1:p, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, plot.confstr = FALSE, confstr = NULL, absVal = TRUE, add = FALSE, col.minval="green", lty.minval=2, col.conf="magenta", lty.conf=2, col.prof="blue", lty.prof=1, xlabs=nm, ylab="score", show.points=FALSE, main, xlim, ylim, ...) {} @ \code{which} selects (by character vector or numbers) which parameters to plot: \code{nseg} does nothing (even in the old version); \code{plot.confstr} turns on the labels for the confidence levels; \code{confstr} gives the labels; \code{add} specifies whether to add the profile to an existing plot; \code{col} and \code{lty} options specify the colors and line types for horizontal and vertical lines marking the minimum and confidence vals and the profile curve; \code{xlabs} gives a vector of x labels; \code{ylab} gives the y label; \code{show.points} specifies whether to show the raw points computed. } \item{\code{mle.options()}} \item{\code{data} argument} \item{handling of names in argument lists} \item{can use alternative optimizers (\code{nlminb}, \code{nlm}, \code{constrOptim}, \code{optimx}, \code{optimize})} \item{uses code from \code{numDeriv} package to compute Hessians rather than built-in optimizer code} \item{by default, uses \code{MASS::ginv} (generalized inverse) rather than \code{solve} to invert Hessian (more robust to positive-semidefinite Hessians \ldots)} \item{can use \code{vecpar=TRUE} (and \code{parnames()}) to use objective functions with parameters specified as vectors (for compatibility with \code{optim} etc.)} \end{itemize} \section{Newer stuff} \textbf{To do:} \begin{itemize} \item{use \code{predict}, \code{simulate} etc. to demonstrate different parametric bootstrap approaches to confidence and prediction intervals \begin{itemize} \item use \code{predict} to get means and standard deviations, use delta method? \item use \code{vcov}, assuming quadratic profiles, with \code{predict(\ldots,newparams=\ldots)} \item prediction intervals assuming no parameter uncertainty with \code{simulate} \item both together \ldots \end{itemize} } \end{itemize} \section{Technical details} \subsection{Profiling and confidence intervals} This section describes the algorithm for constructing profiles and confidence intervals, which is not otherwise documented anywhere except in the code. * indicates changes from the version in \code{stats4:::mle} \subsubsection{Estimating standard error} In order to construct the profile for a particular parameter, one needs an initial estimate of the scale over which to vary that parameter. The estimated standard error of the parameter based on the estimated curvature of the likelihood surface at the MLE is a good guess. \begin{itemize} \item if \code{std.err} is missing, extract the standard error from the summary coefficient table (ultimately computed from \code{sqrt(diag(inverse Hessian))} of the fit) \item * a user-set value of \code{std.err} overrides this behavior unless the value is specified as \code{NA} (in which case the estimate from the previous step is used) \item * if the standard error value is still \code{NA} (i.e. the user did not specify it and the value estimated from the Hessian is missing or \code{NA}) use \code{sqrt(1/diag(hessian))}. This represents a (fairly feeble) attempt to come up with a plausible number when the Hessian is not positive definite but still has positive diagonal entries \item if all else fails, stop and * print an error message that encourages the user to specify the values with \code{std.err} \end{itemize} There may be further tricks that would help guess the appropriate scale: for example, one could guess on the basis of a comparison between the parameter values and negative log-likelihoods at the starting and ending points of the fits. On the other hand, (a) this would take some effort and still be subject to failure for sufficiently pathological fits and (b) there is some value to forcing the user to take explicit, manual steps to remedy such problems, as they may be signs of poorly defined or buggy log-likelihood functions. \subsubsection{Profiling} Profiling is done on the basis of a constructed function that minimizes the negative log-likelihood for a fixed value of the focal parameter and returns the signed square-root of the deviance difference from the minimum (denoted by $z$). At the MLE $z=0$ by definition; it should never be $<0$ unless something has gone wrong with the original fit. The LRT significance cutoffs for $z$ are equal to the usual two-tailed normal distribution cutoffs (e.g. $\pm \approx 1.96$ for 95\% confidence regions). In each direction (decreasing and increasing from the MLE for the focal parameter): \begin{itemize} \item fix the focal parameter \item adjust control parameters etc. accordingly (e.g. remove the entry for the focal parameter so that the remaining control parameters match the non-fixed parameters) \item{controls on the profiling (which can be set manually, but for which there is not much guidance in the documentation): \begin{itemize} \item \code{zmax} Maximum $z$ to aim for. (Default: \code{sqrt(qchisq(1-alpha/2, p))}) The default maximum $\alpha$ (type~I error) is 0.01. \bbnote{I don't understand this criterion. It seems to expand the size of the univariate profile to match a cutoff for the multivariate confidence region of the model. The $\chi^2$ cutoff for deviance to get the $(1-\alpha)$ multivariate confidence region (i.e., on all $p$ of the parameters) would be \code{qchisq(1-alpha,p)} --- % representing a one-tailed test on the deviance. Taking the square root makes sense, since we are working with the square root of the deviance, but I don't understand (1) why we are expanding the region to allow for the multivariate confidence region (since we are computing univariate profiles) [you could at least argue that this is conservative, making the region a little bigger than it needs to be]; (2) why we are using $1-\alpha/2$ rather than $1-\alpha$. } For comparison, \code{MASS::profile.glm} (written by Bates and Venables in 1996, ported to R by BDR in 1998) uses \code{zmax}=\code{sqrt(qchisq(1-alpha,1))} \bbnote{(this makes more sense to me \ldots)}. On the other hand, the profiling code in \code{lme4a} (the \code{profile} method for \code{merMod}, in \code{profile.R}) uses \code{qchisq(1-alphamax, nptot)} \ldots \item \code{del} Step size (scaled by standard error) (Default: \code{zmax}/5.) Presumably (?) copied from \code{MASS::profile.glm}, which says (in \code{?profile.glm}): ``[d]efault value chosen to allow profiling at about 10 parameter values.'' \item \code{maxsteps} Maximum number of profiling steps to try in each direction. (Default: 100) \end{itemize} } \item While \verb+step } { nameptr #1 = {s nameptr "{vv~}{ll}{, jj}{, f.}" format.name$ 't := } {s nameptr "{f.~}{vv~}{ll}{, jj}" format.name$ 't := } if$ nameptr #1 > { namesleft #1 > { ", " * t * } { numnames #2 > { "," * } 'skip$ if$ t "others" = { " et~al." * } { " and " * t * } % from Chicago Manual of Style if$ } if$ } 't if$ nameptr #1 + 'nameptr := % nameptr += 1; namesleft #1 - 'namesleft := % namesleft =- 1; } while$ } FUNCTION {my.full.label} { 's := #1 'nameptr := % nameptr = 1; s num.names$ 'numnames := % numnames = num.name$(s); numnames 'namesleft := { namesleft #0 > } { s nameptr "{vv~}{ll}" format.name$ 't := % get the next name nameptr #1 > { namesleft #1 > { ", " * t * } { numnames #2 > { "," * } 'skip$ if$ t "others" = { " et~al." * } { " and " * t * } % from Chicago Manual of Style if$ } if$ } 't if$ nameptr #1 + 'nameptr := % nameptr += 1; namesleft #1 - 'namesleft := % namesleft =- 1; } while$ } FUNCTION {format.names.fml} % % Format names in "familiar" format, with first initial followed by % last name. Like format.names, ALL names are formatted. % { 's := #1 'nameptr := % nameptr = 1; s num.names$ 'numnames := % numnames = num.name$(s); numnames 'namesleft := { namesleft #0 > } { s nameptr "{f.~}{vv~}{ll}{, jj}" format.name$ 't := nameptr #1 > { namesleft #1 > { ", " * t * } { numnames #2 > { "," * } 'skip$ if$ t "others" = { " et~al." * } { " and " * t * } % { " \& " * t * } if$ } if$ } 't if$ nameptr #1 + 'nameptr := % nameptr += 1; namesleft #1 - 'namesleft := % namesleft =- 1; } while$ } FUNCTION {format.authors} { author empty$ { "" } { author format.names } if$ } FUNCTION {format.key} { empty$ { key field.or.null } { "" } if$ } % % Format editor names for use in the "in" types: inbook, incollection, % inproceedings: first initial, then last names. When editors are the % LABEL for an entry, then format.editor is used which lists editors % by last name first. % FUNCTION {format.editors.fml} { editor empty$ { "" } { editor format.names.fml editor num.names$ #1 > { " (Eds.)" * } { " (Ed.)" * } if$ } if$ } % % Format editor names for use in labels, last names first. % FUNCTION {format.editors} { editor empty$ { "" } { editor format.names editor num.names$ #1 > { " (Eds.)" * } { " (Ed.)" * } if$ } if$ } FUNCTION {format.title} { title empty$ { "" } { title "t" change.case$ } if$ } % Note that the APA style requres case changes % in article titles. The following does not % change cases. If you perfer it, uncomment the % following and comment out the above. %FUNCTION {format.title} %{ title empty$ % { "" } % { title } % if$ %} FUNCTION {n.dashify} { 't := "" { t empty$ not } { t #1 #1 substring$ "-" = { t #1 #2 substring$ "--" = not { "--" * t #2 global.max$ substring$ 't := } { { t #1 #1 substring$ "-" = } { "-" * t #2 global.max$ substring$ 't := } while$ } if$ } { t #1 #1 substring$ * t #2 global.max$ substring$ 't := } if$ } while$ } FUNCTION {format.btitle} { edition empty$ { title emphasize } { title empty$ { title emphasize } { volume empty$ % gnp - check for volume, then don't need period { "{\em " title * "\/} (" * edition * " ed.)" * "." * } { "{\em " title * "\/} (" * edition * " ed.)" * } if$ } if$ } if$ } FUNCTION {format.emphasize.booktitle} { edition empty$ { booktitle emphasize } { booktitle empty$ { booktitle emphasize } { volume empty$ % gnp - extra period an error if book has a volume { "{\em " booktitle * "\/} (" * edition * " ed.)" * "." *} { "{\em " booktitle * "\/} (" * edition * " ed.)" * } if$ } if$ } if$ } FUNCTION {tie.or.space.connect} { duplicate$ text.length$ #3 < { "~" } { " " } if$ swap$ * * } FUNCTION {either.or.check} { empty$ 'pop$ { "can't use both " swap$ * " fields in " * cite$ * warning$ } if$ } FUNCTION {format.bvolume} { volume empty$ { "" } { "Volume" volume tie.or.space.connect % gnp - changed to mixed case series empty$ 'skip$ { " of " * series emphasize * } if$ "volume and number" number either.or.check } if$ } FUNCTION {format.number.series} { volume empty$ { number empty$ { series field.or.null } { output.state mid.sentence = { "Number" } % gnp - changed to mixed case always { "Number" } if$ number tie.or.space.connect series empty$ { "there's a number but no series in " cite$ * warning$ } { " in " * series * } if$ } if$ } { "" } if$ } INTEGERS { multiresult } FUNCTION {multi.page.check} { 't := #0 'multiresult := { multiresult not t empty$ not and } { t #1 #1 substring$ duplicate$ "-" = swap$ duplicate$ "," = swap$ "+" = or or { #1 'multiresult := } { t #2 global.max$ substring$ 't := } if$ } while$ multiresult } FUNCTION {format.pages} { pages empty$ { "" } { pages multi.page.check { "pp.\ " pages n.dashify tie.or.space.connect } % gnp - removed () { "pp.\ " pages tie.or.space.connect } if$ } if$ } % By Young (and Spencer) % GNP - fixed bugs with missing volume, number, and/or pages % % Format journal, volume, number, pages for article types. % FUNCTION {format.jour.vol} { journal empty$ { "no journal in " cite$ * warning$ "" } { journal emphasize.space } if$ number empty$ { volume empty$ { "no number and no volume in " cite$ * warning$ "" * } { "~{\em " * Volume * "}" * } if$ } { volume empty$ {"no volume for " cite$ * warning$ "~(" * number * ")" * } { "~" * volume emphasize.space "(" * number * ")" * * } if$ } if$ pages empty$ {"page numbers missing in " cite$ * warning$ "" * } % gnp - place a null string on the stack for output { duplicate$ empty$ { pop$ format.pages } { ", " * pages n.dashify * } % gnp - removed pp. for articles if$ } if$ } FUNCTION {format.chapter.pages} { chapter empty$ 'format.pages { type empty$ { "Chapter" } % gnp - changed to mixed case { type "t" change.case$ } if$ chapter tie.or.space.connect pages empty$ {"page numbers missing in " cite$ * warning$} % gnp - added check { ", " * format.pages * } if$ } if$ } FUNCTION {format.in.ed.booktitle} { booktitle empty$ { "" } { editor empty$ { "In " format.emphasize.booktitle * } { "In " format.editors.fml * ", " * format.emphasize.booktitle * } if$ } if$ } FUNCTION {format.thesis.type} { type empty$ 'skip$ { pop$ type "t" change.case$ } if$ } FUNCTION {format.tr.number} { type empty$ { "Technical Report" } 'type if$ number empty$ { "t" change.case$ } { number tie.or.space.connect } if$ } FUNCTION {format.article.crossref} { "See" "\citeN{" * crossref * "}" * } FUNCTION {format.crossref.editor} { editor #1 "{vv~}{ll}" format.name$ editor num.names$ duplicate$ #2 > { pop$ " et~al." * } { #2 < 'skip$ { editor #2 "{ff }{vv }{ll}{ jj}" format.name$ "others" = { " et~al." * } { " and " * editor #2 "{vv~}{ll}" format.name$ * } if$ } if$ } if$ } FUNCTION {format.book.crossref} { volume empty$ { "empty volume in " cite$ * "'s crossref of " * crossref * warning$ "In " } { "Volume" volume tie.or.space.connect % gnp - changed to mixed case " of " * } if$ editor empty$ editor field.or.null author field.or.null = or { key empty$ { series empty$ { "need editor, key, or series for " cite$ * " to crossref " * crossref * warning$ "" * } { "{\em " * series * "\/}" * } if$ } { key * } if$ } { format.crossref.editor * } if$ " \citeN{" * crossref * "}" * } FUNCTION {format.incoll.inproc.crossref} { "See" " \citeN{" * crossref * "}" * } % format.lab.names: % % determines "short" names for the abbreviated author information. % "Long" labels are created in calc.label, using the routine my.full.label % to format author and editor fields. % % There are 4 cases for labels. (n=3 in the example) % a) one author Foo % b) one to n Foo, Bar and Baz % c) use of "and others" Foo, Bar et al. % d) more than n Foo et al. % FUNCTION {format.lab.names} { 's := s num.names$ 'numnames := numnames #2 > % change number to number of others allowed before % forcing "et al". { s #1 "{vv~}{ll}" format.name$ " et~al." * } { numnames #1 - 'namesleft := #2 'nameptr := s #1 "{vv~}{ll}" format.name$ { namesleft #0 > } { nameptr numnames = { s nameptr "{ff }{vv }{ll}{ jj}" format.name$ "others" = { " et~al." * } { " and " * s nameptr "{vv~}{ll}" format.name$ * } if$ } { ", " * s nameptr "{vv~}{ll}" format.name$ * } if$ nameptr #1 + 'nameptr := namesleft #1 - 'namesleft := } while$ } if$ } FUNCTION {author.key.label} { author empty$ { key empty$ { "no key, author in " cite$ * warning$ cite$ #1 #3 substring$ } 'key if$ } { author format.lab.names } if$ } FUNCTION {editor.key.label} { editor empty$ { key empty$ { "no key, editor in " cite$ * warning$ cite$ #1 #3 substring$ } 'key if$ } { editor format.lab.names } if$ } FUNCTION {author.key.organization.label} % % added - gnp. Provide label formatting by organization if author is null. % { author empty$ { organization empty$ { key empty$ { "no key, author or organization in " cite$ * warning$ cite$ #1 #3 substring$ } 'key if$ } { organization } if$ } { author format.lab.names } if$ } FUNCTION {editor.key.organization.label} % % added - gnp. Provide label formatting by organization if editor is null. % { editor empty$ { organization empty$ { key empty$ { "no key, editor or organization in " cite$ * warning$ cite$ #1 #3 substring$ } 'key if$ } { organization } if$ } { editor format.lab.names } if$ } FUNCTION {author.editor.key.label} { author empty$ { editor empty$ { key empty$ { "no key, author, or editor in " cite$ * warning$ cite$ #1 #3 substring$ } 'key if$ } { editor format.lab.names } if$ } { author format.lab.names } if$ } FUNCTION {calc.label} % % Changed - GNP. See also author.organization.sort, editor.organization.sort % Form label for BibTeX entry. The classification of which fields are used % for which type of entry (book, inbook, etc.) are taken from alpha.bst. % The change here from newapa is to also include organization as a % citation label if author or editor is missing. % { type$ "book" = type$ "inbook" = or 'author.editor.key.label { type$ "proceedings" = 'editor.key.organization.label { type$ "manual" = 'author.key.organization.label 'author.key.label if$ } if$ } if$ author empty$ % generate the full label citation information. { editor empty$ { organization empty$ { "no author, editor, or organization in " cite$ * warning$ "??" } { organization } if$ } { editor my.full.label } if$ } { author my.full.label } if$ % leave label on the stack, to be popped when required. "}{" * swap$ * "}{" * % year field.or.null purify$ #-1 #4 substring$ * % % save the year for sort processing afterwards (adding a, b, c, etc.) % year field.or.null purify$ #-1 #4 substring$ 'label.year := } FUNCTION {output.bibitem} { newline$ "\bibitem[\protect\citeauthoryear{" write$ calc.label write$ sort.year write$ "}]{" write$ cite$ write$ "}" write$ newline$ "" before.all 'output.state := } FUNCTION {article} { output.bibitem format.authors "author" output.check author format.key output % added output.year.check % added new.block format.title "title" output.check new.block crossref missing$ { format.jour.vol output } { format.article.crossref output.nonnull format.pages output } if$ new.block note output fin.entry } FUNCTION {book} { output.bibitem author empty$ { format.editors "author and editor" output.check } { format.authors output.nonnull crossref missing$ { "author and editor" editor either.or.check } 'skip$ if$ } if$ output.year.check % added new.block format.btitle "title" output.check crossref missing$ { format.bvolume output new.block format.number.series output new.sentence address output publisher "publisher" output.check.colon } { new.block format.book.crossref output.nonnull } if$ new.block note output fin.entry } FUNCTION {booklet} { output.bibitem format.authors output author format.key output % added output.year.check % added new.block format.title "title" output.check new.block howpublished output address output new.block note output fin.entry } FUNCTION {inbook} { output.bibitem author empty$ { format.editors "author and editor" output.check } { format.authors output.nonnull crossref missing$ { "author and editor" editor either.or.check } 'skip$ if$ } if$ output.year.check % added new.block format.btitle "title" output.check crossref missing$ { format.bvolume output format.chapter.pages "chapter and pages" output.check new.block format.number.series output new.sentence address output publisher "publisher" output.check.colon } { format.chapter.pages "chapter and pages" output.check new.block format.book.crossref output.nonnull } if$ new.block note output fin.entry } FUNCTION {incollection} { output.bibitem format.authors "author" output.check author format.key output % added output.year.check % added new.block format.title "title" output.check new.block crossref missing$ { format.in.ed.booktitle "booktitle" output.check format.bvolume output format.number.series output format.chapter.pages output % gnp - was special.output.nonnull % left out comma before page numbers new.sentence address output publisher "publisher" output.check.colon } { format.incoll.inproc.crossref output.nonnull format.chapter.pages output } if$ new.block note output fin.entry } FUNCTION {inproceedings} { output.bibitem format.authors "author" output.check author format.key output % added output.year.check % added new.block format.title "title" output.check new.block crossref missing$ { format.in.ed.booktitle "booktitle" output.check format.bvolume output format.number.series output address output format.pages output new.sentence organization output publisher output.colon } { format.incoll.inproc.crossref output.nonnull format.pages output } if$ new.block note output fin.entry } FUNCTION {conference} { inproceedings } FUNCTION {manual} { output.bibitem author empty$ { editor empty$ { organization "organization" output.check organization format.key output } % if all else fails, use key { format.editors "author and editor" output.check } if$ } { format.authors output.nonnull } if$ output.year.check % added new.block format.btitle "title" output.check organization address new.block.checkb % Reversed the order of "address" and "organization", added the ":". address output organization "organization" output.check.colon % address output % ":" output % organization output new.block note output fin.entry } FUNCTION {mastersthesis} { output.bibitem format.authors "author" output.check author format.key output % added output.year.check % added new.block format.title "title" output.check new.block "Master's thesis" format.thesis.type output.nonnull school "school" output.check address output new.block note output fin.entry } FUNCTION {misc} { output.bibitem format.authors output author format.key output % added output.year.check % added title howpublished new.block.checkb format.title output new.block howpublished output new.block note output fin.entry } FUNCTION {phdthesis} { output.bibitem format.authors "author" output.check author format.key output % added output.year.check % added new.block format.btitle "title" output.check new.block "Ph.\ D. thesis" format.thesis.type output.nonnull school "school" output.check address output new.block note output fin.entry } FUNCTION {proceedings} { output.bibitem editor empty$ { organization output organization format.key output } % gnp - changed from author format.key { format.editors output.nonnull } if$ % author format.key output % gnp - removed (should be either % editor or organization output.year.check % added (newapa) new.block format.btitle "title" output.check format.bvolume output format.number.series output address output new.sentence organization output publisher output.colon new.block note output fin.entry } FUNCTION {techreport} { output.bibitem format.authors "author" output.check author format.key output % added output.year.check % added new.block format.title "title" output.check new.block format.tr.number output.nonnull institution "institution" output.check address output new.block note output fin.entry } FUNCTION {unpublished} { output.bibitem format.authors "author" output.check author format.key output % added output.year.check % added new.block format.title "title" output.check new.block note "note" output.check fin.entry } FUNCTION {default.type} { misc } MACRO {jan} {"January"} MACRO {feb} {"February"} MACRO {mar} {"March"} MACRO {apr} {"April"} MACRO {may} {"May"} MACRO {jun} {"June"} MACRO {jul} {"July"} MACRO {aug} {"August"} MACRO {sep} {"September"} MACRO {oct} {"October"} MACRO {nov} {"November"} MACRO {dec} {"December"} MACRO {acmcs} {"ACM Computing Surveys"} MACRO {acta} {"Acta Informatica"} MACRO {ai} {"Artificial Intelligence"} MACRO {cacm} {"Communications of the ACM"} MACRO {ibmjrd} {"IBM Journal of Research and Development"} MACRO {ibmsj} {"IBM Systems Journal"} MACRO {ieeese} {"IEEE Transactions on Software Engineering"} MACRO {ieeetc} {"IEEE Transactions on Computers"} MACRO {ieeetcad} {"IEEE Transactions on Computer-Aided Design of Integrated Circuits"} MACRO {ipl} {"Information Processing Letters"} MACRO {jacm} {"Journal of the ACM"} MACRO {jcss} {"Journal of Computer and System Sciences"} MACRO {scp} {"Science of Computer Programming"} MACRO {sicomp} {"SIAM Journal on Computing"} MACRO {tocs} {"ACM Transactions on Computer Systems"} MACRO {tods} {"ACM Transactions on Database Systems"} MACRO {tog} {"ACM Transactions on Graphics"} MACRO {toms} {"ACM Transactions on Mathematical Software"} MACRO {toois} {"ACM Transactions on Office Information Systems"} MACRO {toplas} {"ACM Transactions on Programming Languages and Systems"} MACRO {tcs} {"Theoretical Computer Science"} READ FUNCTION {sortify} { purify$ "l" change.case$ } INTEGERS { len } FUNCTION {chop.word} { 's := 'len := s #1 len substring$ = { s len #1 + global.max$ substring$ } 's if$ } FUNCTION {sort.format.names} { 's := #1 'nameptr := "" s num.names$ 'numnames := numnames 'namesleft := { namesleft #0 > } { nameptr #1 > { " " * } 'skip$ if$ s nameptr "{vv{ } }{ll{ }}{ f{ }}{ jj{ }}" format.name$ 't := nameptr numnames = t "others" = and { " et~al" * } { t sortify * } if$ nameptr #1 + 'nameptr := namesleft #1 - 'namesleft := } while$ } FUNCTION {sort.format.title} { 't := "A " #2 "An " #3 "The " #4 t chop.word chop.word chop.word sortify #1 global.max$ substring$ } FUNCTION {author.sort} { author empty$ { key empty$ { "to sort, need author or key in " cite$ * warning$ "" } { key sortify } if$ } { author sort.format.names } if$ } FUNCTION {editor.sort} { editor empty$ { key empty$ { "to sort, need editor or key in " cite$ * warning$ "" } { key sortify } if$ } { editor sort.format.names } if$ } FUNCTION {author.editor.sort} { author empty$ { "missing author in " cite$ * warning$ editor empty$ { key empty$ { "to sort, need author, editor, or key in " cite$ * warning$ "" } { key sortify } if$ } { editor sort.format.names } if$ } { author sort.format.names } if$ } FUNCTION {author.organization.sort} % % added - GNP. Stack author or organization for sorting (from alpha.bst). % Unlike alpha.bst, we need entire names, not abbreviations % { author empty$ { organization empty$ { key empty$ { "to sort, need author, organization, or key in " cite$ * warning$ "" } { key sortify } if$ } { organization sortify } if$ } { author sort.format.names } if$ } FUNCTION {editor.organization.sort} % % added - GNP. Stack editor or organization for sorting (from alpha.bst). % Unlike alpha.bst, we need entire names, not abbreviations % { editor empty$ { organization empty$ { key empty$ { "to sort, need editor, organization, or key in " cite$ * warning$ "" } { key sortify } if$ } { organization sortify } if$ } { editor sort.format.names } if$ } FUNCTION {presort} % % Presort creates the bibentry's label via a call to calc.label, and then % sorts the entries based on entry type. Chicago.bst adds support for % including organizations as the sort key; the following is stolen from % alpha.bst. % { calc.label sortify % recalculate bibitem label year field.or.null purify$ #-1 #4 substring$ * % add year " " * type$ "book" = type$ "inbook" = or 'author.editor.sort { type$ "proceedings" = 'editor.organization.sort { type$ "manual" = 'author.organization.sort 'author.sort if$ } if$ } if$ #1 entry.max$ substring$ % added for newapa 'sort.label := % added for newapa sort.label % added for newapa * " " * title field.or.null sort.format.title * #1 entry.max$ substring$ 'sort.key$ := } ITERATE {presort} SORT % by label, year, author/editor, title STRINGS { last.label next.extra } INTEGERS { last.extra.num } FUNCTION {initialize.extra.label.stuff} { #0 int.to.chr$ 'last.label := "" 'next.extra := #0 'last.extra.num := } FUNCTION {forward.pass} % % Pass through all entries, comparing current entry to last one. % Need to concatenate year to the stack (done by calc.label) to determine % if two entries are the same (see presort) % { last.label calc.label year field.or.null purify$ #-1 #4 substring$ * % add year #1 entry.max$ substring$ = % are they equal? { last.extra.num #1 + 'last.extra.num := last.extra.num int.to.chr$ 'extra.label := } { "a" chr.to.int$ 'last.extra.num := "" 'extra.label := calc.label year field.or.null purify$ #-1 #4 substring$ * % add year #1 entry.max$ substring$ 'last.label := % assign to last.label } if$ } FUNCTION {reverse.pass} { next.extra "b" = { "a" 'extra.label := } 'skip$ if$ label.year extra.label * 'sort.year := extra.label 'next.extra := } EXECUTE {initialize.extra.label.stuff} ITERATE {forward.pass} REVERSE {reverse.pass} FUNCTION {bib.sort.order} { sort.label " " * year field.or.null sortify * " " * title field.or.null sort.format.title * #1 entry.max$ substring$ 'sort.key$ := } ITERATE {bib.sort.order} SORT % by sort.label, year, title --- giving final bib. order. FUNCTION {begin.bib} { preamble$ empty$ 'skip$ { preamble$ write$ newline$ } if$ "\begin{thebibliography}{}" write$ newline$ } EXECUTE {begin.bib} EXECUTE {init.state.consts} ITERATE {call.type$} FUNCTION {end.bib} { newline$ "\end{thebibliography}" write$ newline$ } EXECUTE {end.bib} bbmle/vignettes/quasi.Rnw0000754000176200001440000001461613022106105015155 0ustar liggesusers\documentclass{article} %\VignettePackage{mle2} %\VignetteIndexEntry{quasi: notes on quasi-likelihood/qAIC analysis inR} %\VignetteDepends{MuMIn,AICcmodavg,bbmle} %\VignetteEngine{knitr::knitr} \usepackage{graphicx} \usepackage{hyperref} \usepackage{url} \newcommand{\code}[1]{{\tt #1}} \title{Dealing with \code{quasi-} models in R} \date{\today} \author{Ben Bolker} \begin{document} \newcommand{\rpkg}[1]{\href{https://CRAN.R-project.org/package=#1}{{\tt #1}}} \maketitle \includegraphics[width=2.64cm,height=0.93cm]{cc-attrib-nc.png} \begin{minipage}[b]{3in} {\tiny Licensed under the Creative Commons attribution-noncommercial license (\url{http://creativecommons.org/licenses/by-nc/3.0/}). Please share \& remix noncommercially, mentioning its origin.} \end{minipage} <>= if (require("knitr")) opts_chunk$set(tidy=FALSE) @ Computing ``quasi-AIC'' (QAIC), in R is a minor pain, because the R Core team (or at least the ones who wrote \code{glm}, \code{glmmPQL}, etc.) are purists and don't believe that quasi- models should report a likelihood. As far as I know, there are three R packages that compute/handle QAIC: \rpkg{bbmle}, \rpkg{AICcmodavg} and \rpkg{MuMIn}. The basic problem is that quasi- model fits with \code{glm} return an \code{NA} for the log-likelihood, while the dispersion parameter ($\hat c$, $\phi$, whatever you want to call it) is only reported for quasi- models. Various ways to get around this are: \begin{itemize} \item{fit the model twice, once with a regular likelihood model (\code{family=binomial}, \code{poisson}, etc.) and once with the \code{quasi-} variant --- extract the log-likelihood from the former and the dispersion parameter from the latter} \item{only fit the regular model; extract the overdispersion parameter manually with <>= dfun <- function(object) { with(object,sum((weights * residuals^2)[weights > 0])/df.residual) } @ } \item{use the fact that quasi- fits still contain a deviance, even if they set the log-likelihood to \code{NA}. The deviance is twice the negative log-likelihood (it's offset by some constant which I haven't figured out yet, but it should still work fine for model comparisons)} \end{itemize} The whole problem is worse for \code{MASS::glmmPQL}, where (1) the authors have gone to greater efforts to make sure that the (quasi-)deviance is no longer preserved anywhere in the fitted model, and (2) they may have done it for good reason --- it is not clear whether the number that would get left in the `deviance' slot at the end of \code{glmmPQL}'s alternating \code{lme} and \code{glm} fits is even meaningful to the extent that regular QAICs are. (For discussion of a similar situation, see the \code{WARNING} section of \code{?gamm} in the \code{mgcv} package.) Example: use the values from one of the examples in \code{?glm}: <>= ## Dobson (1990) Page 93: Randomized Controlled Trial : counts <- c(18,17,15,20,10,20,25,13,12) outcome <- gl(3,1,9) treatment <- gl(3,3) @ Fit Poisson and quasi-Poisson models with all combinations of predictors: <>= glmOT.D93 <- glm(counts ~ outcome + treatment, family=poisson) glmO.D93 <- update(glmOT.D93, . ~ . - treatment) glmT.D93 <- update(glmOT.D93, . ~ . - outcome) glmX.D93 <- update(glmT.D93, . ~ . - treatment) glmQOT.D93 <- update(glmOT.D93, family=quasipoisson) glmQO.D93 <- update(glmO.D93, family=quasipoisson) glmQT.D93 <- update(glmT.D93, family=quasipoisson) glmQX.D93 <- update(glmX.D93, family=quasipoisson) @ Extract log-likelihoods: <>= (sum(dpois(counts, lambda=exp(predict(glmOT.D93)),log=TRUE))) ## by hand (logLik(glmOT.D93)) ## from Poisson fit @ The deviance (\code{deviance(glmOT.D93)}=\Sexpr{round(deviance(glmOT.D93),3)} is not the same as $-2L$ (\code{-2*logLik(glmOT.D93)}=\Sexpr{round(-2*c(logLik(glmOT.D93)),3)}), but the calculated differences in deviance are consistent, and are also extractable from the quasi- fit even though the log-likelihood is \code{NA}: <>= (-2*(logLik(glmT.D93)-logLik(glmOT.D93))) ## Poisson fit (deviance(glmT.D93)-deviance(glmOT.D93)) ## Poisson fit (deviance(glmQT.D93)-deviance(glmQOT.D93)) ## quasi-fit @ Compare hand-computed dispersion (in two ways) with the dispersion computed by \code{summary.glm()} on a quasi- fit: <>= (dfun(glmOT.D93)) (sum(residuals(glmOT.D93,"pearson")^2)/glmOT.D93$df.residual) (summary(glmOT.D93)$dispersion) (summary(glmQOT.D93)$dispersion) @ \section*{Examples} \subsection*{\code{bbmle}} <>= library(bbmle) (qAIC(glmOT.D93,dispersion=dfun(glmOT.D93))) (qAICc(glmOT.D93,dispersion=dfun(glmOT.D93),nobs=length(counts))) ICtab(glmOT.D93,glmT.D93,glmO.D93,glmX.D93, dispersion=dfun(glmOT.D93),type="qAIC") ICtab(glmOT.D93,glmT.D93,glmO.D93,glmX.D93, dispersion=dfun(glmOT.D93), nobs=length(counts),type="qAICc") detach("package:bbmle") @ \subsection*{\code{AICcmodavg}} <>= library(AICcmodavg) aictab(list(glmOT.D93,glmT.D93,glmO.D93,glmX.D93), modnames=c("OT","T","O","X"), c.hat=dfun(glmOT.D93)) detach("package:AICcmodavg") @ \subsection*{\code{MuMIn}} <>= library(MuMIn); packageVersion("MuMIn") ## from ?QAIC x.quasipoisson <- function(...) { res <- quasipoisson(...) res$aic <- poisson(...)$aic res } glmQOT2.D93 <- update(glmOT.D93,family="x.quasipoisson", na.action=na.fail) (gg <- dredge(glmQOT2.D93,rank="QAIC", chat=dfun(glmOT.D93))) (ggc <- dredge(glmQOT2.D93,rank="QAICc",chat=dfun(glmOT.D93))) detach("package:MuMIn") @ Notes: ICtab only gives delta-IC, limited decimal places (on purpose, but how do you change these defaults if you want to?). Need to add 1 to parameters to account for scale parameter. When doing corrected-IC you need to get the absolute number of parameters right, not just the relative number \ldots Not sure which classes of models each of these will handle (lm, glm, (n)lme, lme4, mle2 \ldots). Remember need to use overdispersion parameter from most complex model. glmmPQL: needs to be hacked somewhat more severely (does not contain deviance element, logLik has been NA'd out). \begin{tabular}{l|ccccccc} package & \code{lm} & \code{glm} & \code{(n)lme} & \code{multinom} & \code{polr} & \code{lme4} & \code{mle2} \\ \hline \code{AICcmodavg} & y & y & y & y & y & ? & ? \\ \code{MuMIn} & ? & ? & ? & ? & ? & ? & ? \\ \code{mle2 } & ? & ? & ? & ? & ? & ? & ? \end{tabular} \end{document} bbmle/vignettes/cc-attrib-nc.png0000754000176200001440000001203113013175530016314 0ustar liggesusersPNG  IHDRXc pHYs   OiCCPPhotoshop ICC profilexڝSgTS=BKKoR RB&*! J!QEEȠQ, !{kּ> H3Q5 B.@ $pd!s#~<<+"x M0B\t8K@zB@F&S`cbP-`'{[! eDh;VEX0fK9-0IWfH  0Q){`##xFW<+*x<$9E[-qWW.(I+6aa@.y24x6_-"bbϫp@t~,/;m%h^ uf@Wp~<5j>{-]cK'Xto(hw?G%fIq^D$.Tʳ?D*A, `6B$BB dr`)B(Ͱ*`/@4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH=r9\F;2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB aAHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![ b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕNWGw Ljg(gwLӋT071oUX**| J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k u5&|v*=9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ M=:.kDwn^Loy}/TmG X $ <5qo</QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz%gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK9.*6nl {/]py.,:@LN8A*%w% yg"/6шC\*NH*Mz쑼5y$3,幄'L Lݛ:v m2=:1qB!Mggfvˬen/kY- BTZ(*geWf͉9+̳ې7ᒶKW-X潬j9(xoʿܔĹdff-[n ڴ VE/(ۻCɾUUMfeI?m]Nmq#׹=TR+Gw- 6 U#pDy  :v{vg/jBFS[b[O>zG499?rCd&ˮ/~јѡ򗓿m|x31^VwwO| (hSЧc3-gAMA|Q cHRMz%u0`:o_F 4IDATxZ]lHR r0{ &ˆ-ֽ, vI5`KO+doHa[-(ڇf"+0[N"i#=X +f{yEڒ-v9{9!Xeͅ0e,8rX,Y Âe0 0D拢(@QTBTe 0N.qrsױF2ajhĪy2E+sLX#яfr9 ,c\rhX s9P;v.4QX0`4Lg9,M݉8"ɤn"`U^ [bZ,|,FtY6 @c.ȊE!ZQdȲB5&/O/\T2p:p8D"Iz7בp*TY,tuCi!jkkA&(mǰ񉍐e9Y, ˲d-70#>dYp8ZGd2~Պsse[** ,U&ry%#~?%^?{|mFr\jrQWO!L`pp04bH$6q(~wY` ™5p #,I.x<i:RzC}&[R)H݉8RA@lj~ H%S;/榒)lmhv~DPn+O`jj"|]X`u0"ȍFR<(%Y122 '>H/!S ˢ b86]J6? =ގ'O"׋񱱊M58š !JZzKk2OjO&p:j~[[Ns'PLtfۿSSS9<|=CqZYv:|>Jy:Ӹv: X$6{~$)zTRp8P~⣏3b͈9SumFKI ˅`0Xdu-ފ`{;w"60UJ48zeSNwatCCC&==.6v$!ɘ)Jݾv;}[ނ=>Π=q6.. >t: CCZg\ Yń4VRދh{|4av -=ϔo&Pno@(.J+"e S]8?&jL01GEFۤks$,  &Ӷҟ^ZD"pg2njH_ ؉4[ >]Vc.;I ЇoڴD^H$cU[A!>բ{$.DQ(p8p8y$Qe$t3 6 x*qH󘙙1y4t: ж:C&?y}^w~w …益܎O "zyMfffJ;33C  r;1A:_Er ) tb[bA_o魊g!2cxʧlw3ҟ])6k8y3Gb1F~;@vb7V%ύ*_g0*Q/<@w!^aFvU ]"QDBsb:F֭86n1ߪ~ڬ ZLR]uո MM6|j5p5lwnk7֌/ZEcY <0gXVblIENDB`bbmle/MD50000644000176200001440000001344713175563664011674 0ustar liggesusers10e29e61789a78ccec5eb81fa4fdbf58 *DESCRIPTION 8b6151fa79b199d3cf6cf2cd8daebdb9 *NAMESPACE ca91d50be05ea7ae0f8746da984b479d *R/IC.R 3547798b5af91c95a35a011f2a3bffa4 *R/confint.R 0a63c5da03a0e73ae29f6c1c4f2fd5cd *R/dists.R d2a74ebe19b627495add8e84588e4fd7 *R/mle.R c4261cd6324f185a4c20caadde9d38ff *R/mle2-class.R 2a2bfa30b9feb9251dabf7d17f1d1246 *R/mle2-methods.R 2d3da6aaa0a07bd64c320a718d87d31e *R/predict.R b9399f7cb30d4f70b15da352401d8512 *R/profile.R 2c39b590a0c236bff22bb00252544082 *R/slice.R 28b4b4a714c1beebcc7516b888e1b641 *R/update.R 3d7347481a3e76bb6d57990dd789c3a4 *TODO 492f2ea4bf11ccc85e60de3f41c5bf70 *build/vignette.rds eac5a49a30af442acb03e2bbb5797be5 *inst/NEWS.Rd b5555aa6d41773a0e4df0590aecc7e14 *inst/doc/mle2.R e8c369ae9771830ce616d69a1983031b *inst/doc/mle2.Rnw a2d83210738176006acd7ad22fae27fe *inst/doc/mle2.pdf e4073ae8723f00fe0f3b728db2b31a16 *inst/doc/quasi.R d4a4dc5fd5bd327c231ca1715eb74986 *inst/doc/quasi.Rnw 17b2cf46940eb7b7e970759c9ee68d99 *inst/doc/quasi.pdf a399ce19c47219ea3474978d2f4ecac6 *inst/vignetteData/orob1.rda fad7f0284df8a44372565c480f8e4dfb *man/BIC-methods.Rd 7a309d55019db340dc2b1fa5e662ab32 *man/ICtab.Rd 2688e18ad5fc01c2698e6557c357d8af *man/as.data.frame.profile.mle2.Rd b6ce8a230403e4049aeb543dcdf7f889 *man/call.to.char.Rd 8f4ce3f14c61679b0583aada2d2c6493 *man/get.mnames.Rd c7c79c910f6210de4528dc3b43484b05 *man/mle-class.Rd 95c2381929b8879caad229163c2ac90c *man/mle2.Rd c8bdc07658fc20e685b36d709d1ced51 *man/mle2.options.Rd 5402485d416bd59d04bbf4c4ea34c999 *man/namedrop.Rd 7a0bc1dbcb08bc40ee81b7870967c1ef *man/parnames.Rd efce19f271b87e19638cb0683f7f6bd8 *man/predict-methods.Rd 2ac866f204de3b921b70591b0177e3fd *man/profile-methods.Rd 0aa7332e039cf89bca966c77dad5cbbf *man/profile.mle-class.Rd ea4640bf21b60e594d437304c3910e85 *man/relist.Rd 56db6345ce930b55ae4addbfa6afc6e3 *man/sbinom.Rd eba67df829390e8cd96db70c52ed6fdd *man/slice.Rd 61aeb7bd6d5999f71fac365524a4b818 *man/slice.mle-class.Rd bc2aec35cda556cb0977380afebd4ca9 *man/strwrapx.Rd 1c94867c2e5c5b7239f62290d254da0a *man/summary.mle-class.Rd 677bab474659dbf8e1f16061a32e5f03 *tests/BIC.R c5f6c880e3fc121e0d6f16193014469c *tests/BIC.Rout.save 6ffe0fc4a25d98aa63c54a31029cb391 *tests/ICtab.R dcbd7e7eaa44bdc322c970842e1cf719 *tests/ICtab.Rout.save 7e791632cd72a0dab72b6b1059b85273 *tests/RUnit-tests.R 202d16aa2bf77be5df020bda2240703e *tests/binomtest1.R 138465684c603e66d87035baabc03f65 *tests/binomtest1.Rout de4898499c070e21485ddaed01e73c09 *tests/binomtest1.Rout.save bf9cb0badb64c11e22d1b7d15c060a73 *tests/boundstest.R 055f3f858af92dac796c775fdb6cffe5 *tests/controleval.R 54d3a16476aff59b8947a9b218733be5 *tests/controleval.Rout.save 4421d42f41892221c6604df13514fab4 *tests/eval.R 3d411aa0bc3cdad597b17fde4b539732 *tests/eval.Rout.save 98e85875b0f557344a830f8957c600f1 *tests/formulatest.R 6dbd75bdf12de303e957d0ae2d643e04 *tests/formulatest.Rout.save aa886a9c7ab1b518abd247d7d20e1ef6 *tests/glmcomp.R 631d9de06283af92a3d567576f994553 *tests/glmcomp.Rout.save c615bec0425bbea67b0b6137b50f14ce *tests/gradient_vecpar_profile.R d6a22c3b6f02a01e299385a02c850640 *tests/gradient_vecpar_profile.Rout.save 8e586c21bd27eb96bd0d381d64a216d0 *tests/grtest1.R 4ed1220040a3742acb260754e1656f33 *tests/grtest1.Rout.save 763a796aaa2bfa27693b4a8cb57783e2 *tests/makesavefiles 6cf3e83f5491806bf7f8a75faafe2695 *tests/methods.R bd137b0505a83b54357345cdceb59dcb *tests/methods.Rout.save 96ca4f4b592712ec3510bc4028a51bbe *tests/mkout 5620dedeca0fe6b27ac488f28aef88b3 *tests/mortanal.R 0e6681e8b20a7f49b1d47e84c2930590 *tests/mortanal.Rout.save 4e53341cdd5f4fad2b42e54d61f1ccab *tests/optimize.R 103b501ae4106a7da4917889d8019f38 *tests/optimize.Rout.save 5e63a0d8e88b78f5bf84228b62f051fc *tests/optimizers.R b0cb07cae3015f7e56eef6708a47236e *tests/optimizers.Rout.save c3db147eadab1109b202e783008c8726 *tests/optimx.R 89ec92c72b5ccb6122b8ee496c31cc99 *tests/optimx.Rout.save 05f0d13ee00153918cf5d7bbe5acb61c *tests/order.R 4bd3539efe7bdd3e2a6fc045f653b1a4 *tests/order.Rout.save 21cf9832b13ec31b5e67e6763f80d5da *tests/parscale.R 35577e9f38298835e572fd224048a607 *tests/parscale.Rout 30b0b9c51cec72ecde06be963c9d3b6f *tests/parscale.Rout.save adf07c6ff92b4ae6f8ece745a93b1522 *tests/predict.R df6f12096d996324b2d19467b9905892 *tests/predict.Rout.save a714b957cfd9a8f6148160ae18c56472 *tests/prof_newmin.R 0b52fc583dc02c9c422cb878ba3d6128 *tests/prof_spec.R 68edb941f246a47564617d7aea9647bd *tests/profbound.R ee5f86f38e1dfc8a69958e5d5b07df08 *tests/profbound.Rout.save b0f4716aa737b972c5cac4bbf1b6830a *tests/richards.R f04921cd98c8a8b476365d92dc5292ed *tests/richards.Rout.save c703480c59bde85cdd3c51bd59d83975 *tests/startvals.R 876a9cad0e580eda029eeb6e7d5168dd *tests/startvals.Rout.save 71d7ebe63a25d910873f75c0a7dfa3a0 *tests/startvals2.R 2ee0ef656d972b559e69ec3c53e384f6 *tests/startvals2.Rout.save 75cd2bbf2e5255c1c3eac7ccfa5765a3 *tests/test-relist1.R c118f8284b641d973e449de5afd584f9 *tests/test-relist1.Rout.save 1dda6925aa3654d83943ddda6412d714 *tests/testbounds.R 9a4d9c64de4b0d973bbf93715fa3e3f7 *tests/testbounds.Rout 375be792dbfd82d6d56aeb19006488af *tests/testbounds.Rout.save ba254da51e09a22e84f803832382fc11 *tests/testderiv.R 318b6a073389d6638ba88b2892421af9 *tests/testderiv.Rout.save 8f40025fa6fd7986d5dcb818fce9e100 *tests/testenv.R 1e954bdb02ce9e9d3814cb94ca002bd1 *tests/testenv.Rout.save 6a8dd303587eaf35a465b2e062264b50 *tests/testparpred.R 01059ad5c653ce771ecbd81d4946026f *tests/testparpred.Rout.save 4a76e0b4daec5dc81b0378e7bdb67826 *tests/tmptest.R dd885bf956855f37df24d0dbe37ba7bd *tests/tmptest.Rout.save 2d49b0803524b896e48d6879d18f8190 *tests/update.R 53661890c555a4f7e5c21accbe775fed *tests/update.Rout.save 0a27805bbe6b6d67ef37f760dc991917 *vignettes/cc-attrib-nc.png cd2df3f6f14e5d0af434d1aa53b7a0ed *vignettes/chicago.bst e8c369ae9771830ce616d69a1983031b *vignettes/mle2.Rnw ae21998f0dafa40e30841d4abc02ceed *vignettes/mle2.bib d4a4dc5fd5bd327c231ca1715eb74986 *vignettes/quasi.Rnw bbmle/build/0000755000176200001440000000000013175504417012441 5ustar liggesusersbbmle/build/vignette.rds0000644000176200001440000000044313175504417015001 0ustar liggesusersmPN0t$HHH#ATTz#SBo|yֵ 8xwgv;["CPε#BTn=N7[j#›/*-)MM^S]pF`q{MJ÷R|p)ưPM K^kbeЁ s.o(GNt|;~Vāo3A e| V]~s4@Sŭo&B9:rpzW\3ZS/Jka7 ImpȌцe ?,h#bbmle/DESCRIPTION0000644000176200001440000000152713175563664013066 0ustar liggesusersPackage: bbmle Title: Tools for General Maximum Likelihood Estimation Version: 1.0.20 Author: Ben Bolker , R Development Core Team Maintainer: Ben Bolker Depends: R (>= 3.0.0), stats4 Imports: stats, numDeriv, lattice, MASS, methods Suggests: emdbook, rms, ggplot2, RUnit, MuMIn, AICcmodavg, Hmisc, optimx (>= 2013.8.6), knitr, testthat VignetteBuilder: knitr BuildVignettes: yes Description: Methods and functions for fitting maximum likelihood models in R. This package modifies and extends the 'mle' classes in the 'stats4' package. License: GPL Collate: 'mle2-class.R' 'mle2-methods.R' 'mle.R' 'confint.R' 'predict.R' 'profile.R' 'update.R' 'dists.R' 'IC.R' 'slice.R' NeedsCompilation: no Packaged: 2017-10-30 02:06:08 UTC; bolker Repository: CRAN Date/Publication: 2017-10-30 08:49:56 UTC bbmle/man/0000755000176200001440000000000013175504420012107 5ustar liggesusersbbmle/man/get.mnames.Rd0000755000176200001440000000046613046671362014454 0ustar liggesusers\name{get.mnames} \alias{get.mnames} \title{extract model names} \description{ given a list of models, extract the names (or "model n") } \usage{ get.mnames(Call) } \arguments{ \item{Call}{a function call (usually a list of models)} } \value{ a vector of model names } \author{Ben Bolker} \keyword{misc} bbmle/man/BIC-methods.Rd0000754000176200001440000000566313013175535014452 0ustar liggesusers\name{BIC-methods} \docType{methods} %\alias{BIC} \alias{BIC-methods} \alias{AIC-methods} \alias{AICc-methods} \alias{logLik-methods} \alias{AICc} \alias{AIC,mle2-method} \alias{AICc,mle2-method} \alias{AICc,logLik-method} \alias{AICc,ANY-method} \alias{AICc,ANY,mle2,logLik-method} \alias{qAICc} \alias{qAICc-methods} \alias{qAICc,ANY-method} \alias{qAICc,mle2-method} \alias{qAICc,logLik-method} \alias{qAIC} \alias{qAIC-methods} \alias{qAIC,ANY-method} \alias{qAIC,mle2-method} \alias{qAIC,logLik-method} %\alias{BIC,logLik-method} %\alias{BIC,ANY-method} %\alias{BIC,mle2-method} %\alias{BIC,ANY,mle2,logLik-method} \alias{qAIC,ANY,mle2,logLik-method} \alias{qAICc,ANY,mle2,logLik-method} \alias{logLik,mle2-method} \alias{anova,mle2-method} \title{Log likelihoods and model selection for mle2 objects} \description{ Various functions for likelihood-based and information-theoretic model selection of likelihood models } \section{Methods}{ \describe{ \item{logLik}{\code{signature(object = "mle2")}: Extract maximized log-likelihood.} \item{AIC}{\code{signature(object = "mle2")}: Calculate Akaike Information Criterion} \item{AICc}{\code{signature(object = "mle2")}: Calculate small-sample corrected Akaike Information Criterion} %\item{BIC}{\code{signature(object = "mle2")}: Calculate %Bayesian (Schwarz) Information Criterion} %\item{BIC}{\code{signature(object = "logLik")}: Calculate %Bayesian (Schwarz) Information Criterion} %\item{BIC}{\code{signature(object = "ANY")}: Calculate %Bayesian (Schwarz) Information Criterion} \item{anova}{\code{signature(object="mle2")}: Likelihood Ratio Test comparision of different models} } } \usage{ %\S4method{BIC}{ANY,mle2,logLik}(object,...) \S4method{AICc}{ANY,mle2,logLik}(object,...,nobs,k=2) \S4method{qAIC}{ANY,mle2,logLik}(object,...,k=2) \S4method{qAICc}{ANY,mle2,logLik}(object,...,nobs,k=2) } \arguments{ \item{object}{A \code{logLik} or \code{mle2} object} \item{...}{An optional list of additional \code{logLik} or \code{mle2} objects (fitted to the same data set).} \item{nobs}{Number of observations (sometimes obtainable as an attribute of the fit or of the log-likelihood)} \item{k}{penalty parameter (nearly always left at its default value of 2)} } \details{ Further arguments to \code{BIC} can be specified in the \code{...} list: \code{delta} (logical) specifies whether to include a column for delta-BIC in the output. } \value{ A table of the BIC values, degrees of freedom, and possibly delta-BIC values relative to the minimum-BIC model } \note{This is implemented in an ugly way and could probably be improved!} \examples{ d <- data.frame(x=0:10,y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) (fit <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), start=list(ymax=25,xhalf=3),data=d)) (fit2 <- mle2(y~dpois(lambda=(x+1)*slope), start=list(slope=1),data=d)) BIC(fit) BIC(fit,fit2) } \keyword{methods} bbmle/man/profile-methods.Rd0000755000176200001440000000536313071427071015512 0ustar liggesusers\name{profile-methods} \docType{methods} \alias{proffun} \alias{profile-methods} \alias{profile,mle2-method} \alias{profile.mle2} \title{Likelihood profiles } \description{ Compute likelihood profiles for a fitted model } \usage{ proffun(fitted, which = 1:p, maxsteps = 100, alpha = 0.01, zmax = sqrt(qchisq(1 - alpha/2, p)), del = zmax/5, trace = FALSE, skiperrs=TRUE, std.err, tol.newmin = 0.001, debug=FALSE, prof.lower, prof.upper, skip.hessian = TRUE, continuation = c("none","naive","linear"), try_harder=FALSE, \dots) \S4method{profile}{mle2}(fitted, \dots) } \arguments{ \item{fitted}{A fitted maximum likelihood model of class \dQuote{mle2}} \item{which}{a numeric or character vector describing which parameters to profile (default is to profile all parameters)} \item{maxsteps}{maximum number of steps to take looking for an upper value of the negative log-likelihood} \item{alpha}{maximum (two-sided) likelihood ratio test confidence level to find} \item{zmax}{maximum value of signed square root of deviance difference to find (default value corresponds to a 2-tailed chi-squared test at level alpha)} \item{del}{step size for profiling} \item{trace}{(logical) produce tracing output?} \item{skiperrs}{(logical) ignore errors produced during profiling?} \item{std.err}{Optional numeric vector of standard errors, for cases when the Hessian is badly behaved. Will be replicated if necessary, and NA values will be replaced by the corresponding values from the fit summary} \item{tol.newmin}{tolerance for diagnosing a new minimum below the minimum deviance estimated in initial fit is found} \item{debug}{(logical) debugging output?} \item{prof.lower}{optional vector of lower bounds for profiles} \item{prof.upper}{optional vector of upper bounds for profiles} \item{continuation}{use continuation method to set starting values? \code{"none"} sets starting values to best fit; \code{"naive"} sets starting values to those of previous profiling fit; \code{"linear"} (not yet implemented) would use linear extrapolation from the previous two profiling fits} \item{skip.hessian}{skip hessian (defunct?)} \item{try_harder}{(logical) ignore \code{NA} and flat spots in the profile, try to continue anyway?} \item{\dots}{additional arguments (not used)} } \details{ \code{proffun} is the guts of the profile method, exposed so that other packages can use it directly. See the vignette (\code{vignette("mle2",package="bbmle")}) for more technical details of how profiling is done. } \seealso{\code{\link{profile.mle-class}}} \keyword{methods} bbmle/man/as.data.frame.profile.mle2.Rd0000755000176200001440000000260313072042021017271 0ustar liggesusers\name{as.data.frame.profile.mle2} \alias{as.data.frame.profile.mle2} \alias{coerce,profile.mle2-method} \alias{coerce,profile.mle2,data.frame-method} \title{convert profile to data frame} \description{ converts a profile of a fitted mle2 object to a data frame } \usage{ \S3method{as.data.frame}{profile.mle2}(x, row.names=NULL, optional=FALSE, \dots) } \arguments{ \item{x}{a profile object} \item{row.names}{row names (unused)} \item{optional}{unused} \item{\dots}{unused} } \value{ a data frame with columns \item{param}{name of parameter being profiled} \item{z}{signed square root of the deviance difference from the minimum} \item{parameter values}{named par.vals.parname} \item{focal}{value of focal parameter: redundant, but included for plotting convenience} } \examples{ ## use as.data.frame and lattice to plot profiles x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) library(bbmle) LL <- function(ymax=15, xhalf=6) { -sum(stats::dpois(y, lambda=ymax/(1+x/xhalf), log=TRUE)) } ## uses default parameters of LL fit1 <- mle2(LL) p1 <- profile(fit1) d1 <- as.data.frame(p1) library(lattice) xyplot(abs(z)~focal|param,data=d1, subset=abs(z)<3, type="b", xlab="", ylab=expression(paste(abs(z), " (square root of ",Delta," deviance)")), scale=list(x=list(relation="free"))) } \author{Ben Bolker} \keyword{misc} bbmle/man/summary.mle-class.Rd0000754000176200001440000000220713013175535015757 0ustar liggesusers\name{summary.mle2-class} \docType{class} \alias{summary.mle2-class} \alias{coef,summary.mle2-method} \alias{show,summary.mle2-method} \title{Class "summary.mle2", summary of "mle2" objects} \description{Extract of "mle2" object} \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("summary.mle2", ...)}, but most often by invoking \code{summary} on an "mle2" object. They contain values meant for printing by \code{show}. } \section{Slots}{ \describe{ \item{\code{call}:}{Object of class \code{"language"} The call that generated the "mle2" object.} \item{\code{coef}:}{Object of class \code{"matrix"}. Estimated coefficients and standard errors } \item{\code{m2logL}:}{Object of class \code{"numeric"}. Minus twice the log likelihood.} } } \section{Methods}{ \describe{ \item{show}{\code{signature(object = "summary.mle2")}: Pretty-prints \code{object} } \item{coef}{\code{signature(object = "summary.mle2")}: Extracts the contents of the \code{coef} slot} } } \seealso{ \code{\link{summary}}, \code{\link{mle2}}, \code{\link{mle2-class}} } \keyword{classes} bbmle/man/profile.mle-class.Rd0000755000176200001440000001416613072222725015731 0ustar liggesusers\name{profile.mle2-class} \docType{class} \alias{profile.mle2-class} \alias{confint,profile.mle2-method} \alias{confint,mle2-method} \alias{confint.mle2} %% bogus but good ref link \alias{plot,profile.mle2-method} \alias{plot,profile.mle2,missing-method} \alias{show,profile.mle2-method} \alias{plot.profile.mle2} \title{Methods for likelihood profiles} \description{Definition of the mle2 likelihood profile class, and applicable methods} \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("profile.mle2", ...)}, but most often by invoking \code{profile} on an "mle2" object. } \section{Slots}{ \describe{ \item{\code{profile}:}{Object of class \code{"list"}. List of profiles, one for each requested parameter. Each profile is a data frame with the first column called \code{z} being the signed square root of the deviance, and the others being the parameters with names prefixed by \code{par.vals.}} \item{\code{summary}:}{Object of class \code{"summary.mle2"}. Summary of object being profiled.} } } \section{Methods}{ \describe{ \item{confint}{\code{signature(object = "profile.mle2")}: Use profile to generate approximate confidence intervals for parameters.} \item{plot}{\code{signature(x = "profile.mle2", y = "missing")}: Plot profiles for each parameter.} \item{summary}{\code{signature(x = "profile.mle2")}: Plot profiles for each parameter.} \item{show}{\code{signature(object = "profile.mle2")}: Show object.} } } \usage{ \S4method{plot}{profile.mle2}(x, levels, which=1:p, conf = c(99, 95, 90, 80, 50)/100, plot.confstr = TRUE, confstr = NULL, absVal = TRUE, add = FALSE, col.minval="green", lty.minval=2, col.conf="magenta", lty.conf=2, col.prof="blue", lty.prof=1, xlabs=nm, ylab="z", onepage=TRUE, ask=((prod(par("mfcol")) < length(which)) && dev.interactive() && !onepage), show.points=FALSE, main, xlim, ylim, \dots) \S4method{confint}{mle2}(object, parm, level = 0.95, method, trace=FALSE,quietly=!interactive(), tol.newmin=0.001,\dots) \S4method{confint}{profile.mle2}(object, parm, level = 0.95, trace=FALSE, \dots) } \arguments{ \item{x}{An object of class \code{profile.mle2}} \item{object}{An object of class \code{mle2} or \code{profile.mle2} (as appropriate)} \item{levels}{levels at which to plot likelihood cutoffs (set by conf by default)} \item{level}{level at which to compute confidence interval} \item{which}{(numeric or character) which parameter profiles to plot} \item{parm}{(numeric or character) which parameter(s) to find confidence intervals for} \item{method}{(character) "spline", "uniroot", or "quad", for spline-extrapolation-based (default), root-finding, or quadratic confidence intervals. By default it uses the value of \code{mle2.options("confint")} -- the factory setting is "spline".} \item{trace}{trace progress of confidence interval calculation when using \sQuote{uniroot} method?} \item{conf}{(1-alpha) levels at which to plot likelihood cutoffs/confidence intervals} \item{quietly}{(logical) suppress \dQuote{Profiling ...} message when computing profile to get confidence interval?} \item{tol.newmin}{see \code{\link{profile-methods}}} \item{plot.confstr}{(logical) plot labels showing confidence levels?} \item{confstr}{(character) labels for confidence levels (by default, constructed from conf levels)} \item{absVal}{(logical) plot absolute values of signed square root deviance difference ("V" plot rather than straight-line plot)?} \item{add}{(logical) add profile to existing graph?} \item{col.minval}{color for minimum line} \item{lty.minval}{line type for minimum line} \item{col.conf}{color for confidence intervals} \item{lty.conf}{line type for confidence intervals} \item{col.prof}{color for profile} \item{lty.prof}{line type for profile} \item{xlabs}{x labels} \item{ylab}{y label} \item{onepage}{(logical) plot all profiles on one page, adjusting par(mfcol) as necessary?} \item{ask}{(logical) pause for user input between plots?} \item{show.points}{(logical) show computed profile points as well as interpolated spline?} \item{main}{(logical) main title} \item{xlim}{x limits} \item{ylim}{y limits} \item{\dots}{other arguments} } \seealso{ \code{\link{mle2}}, \code{\link{mle2-class}}, \code{\link{summary.mle2-class}} } \details{ The default confidence interval calculation computes a likelihood profile and uses the points therein, or uses the computed points in an existing \code{profile.mle2} object, to construct an interpolation spline (which by default has three times as many points as were in the original set of profile points). It then uses linear interpolation between these interpolated points (!) } \examples{ x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) ## we have a choice here: (1) don't impose boundaries on the parameters, ## put up with warning messages about NaN values: fit1 <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), start=list(ymax=1,xhalf=1), data=d) p1 <- suppressWarnings(profile(fit1)) plot(p1,main=c("first","second"), xlab=c(~y[max],~x[1/2]),ylab="Signed square root deviance", show.points=TRUE) suppressWarnings(confint(fit1)) ## recomputes profile confint(p1) ## operates on existing profile suppressWarnings(confint(fit1,method="uniroot")) ## alternatively, we can use box constraints to keep ourselves ## to positive parameter values ... fit2 <- update(fit1,method="L-BFGS-B",lower=c(ymax=0.001,xhalf=0.001)) \dontrun{ p2 <- profile(fit2) plot(p2,show.points=TRUE) ## but the fit for ymax is just bad enough that the spline gets wonky confint(p2) ## now we get a warning confint(fit2,method="uniroot") ## bobyqa is a better-behaved bounded optimizer ... ## BUT recent (development, 2012.5.24) versions of ## optimx no longer allow single-parameter fits! if (require(optimx)) { fit3 <- update(fit1, optimizer="optimx", method="bobyqa",lower=c(ymax=0.001,xhalf=0.001)) p3 <- profile(fit3) plot(p3,show.points=TRUE) confint(p3) } } } \keyword{classes} bbmle/man/parnames.Rd0000754000176200001440000000202313013175535014205 0ustar liggesusers\name{parnames} \alias{parnames} \alias{parnames<-} \title{get and set parameter names} \description{ Gets and sets the "parnames" attribute on a negative log-likelihood function } \usage{ parnames(obj) parnames(obj) <- value } \arguments{ \item{obj}{a negative log-likelihood function} \item{value}{a character vector of parameter names} } \details{ The \code{parnames} attribute is used by \code{mle2()} when the negative log-likelihood function takes a parameter vector, rather than a list of parameters; this allows users to use the same objective function for \code{optim()} and \code{mle2()} } \value{ Returns the \code{parnames} attribute (a character vector of parameter names) or sets it. } \author{Ben Bolker} \examples{ x <- 1:5 set.seed(1001) y <- rbinom(5,prob=x/(1+x),size=10) mfun <- function(p) { a <- p[1] b <- p[2] -sum(dbinom(y,prob=a*x/(b+x),size=10,log=TRUE)) } optim(fn=mfun,par=c(1,1)) parnames(mfun) <- c("a","b") mle2(minuslogl=mfun,start=c(a=1,b=1),method="Nelder-Mead") } \keyword{misc} bbmle/man/ICtab.Rd0000755000176200001440000000636413046671362013403 0ustar liggesusers\name{ICtab} \alias{ICtab} \alias{AICtab} \alias{BICtab} \alias{AICctab} \alias{print.ICtab} \title{Compute table of information criteria and auxiliary info} \description{ Computes information criteria for a series of models, optionally giving information about weights, differences between ICs, etc. } \usage{ ICtab(\dots, type=c("AIC","BIC","AICc","qAIC","qAICc"), weights = FALSE, delta = TRUE, base = FALSE, logLik=FALSE, sort = TRUE, nobs=NULL, dispersion = 1, mnames, k = 2) AICtab(\dots,mnames) BICtab(\dots,mnames) AICctab(\dots,mnames) \method{print}{ICtab}(x,\dots,min.weight) } \arguments{ \item{\dots}{a list of (logLik or?) mle objects; in the case of \code{AICtab} etc., could also include other arguments to \code{ICtab}} \item{type}{specify information criterion to use} \item{base}{(logical) include base IC (and log-likelihood) values?} \item{weights}{(logical) compute IC weights?} \item{logLik}{(logical) include log-likelihoods in the table?} \item{delta}{(logical) compute differences among ICs (and log-likelihoods)?} \item{sort}{(logical) sort ICs in increasing order?} \item{nobs}{(integer) number of observations: required for \code{type="BIC"} or \code{type="AICc"} unless objects have a \code{\link{nobs}} method} \item{dispersion}{overdispersion estimate, for computing qAIC: required for \code{type="qAIC"} or \code{type="qAICc"} unless objects have a \code{"dispersion"} attribute} \item{mnames}{names for table rows: defaults to names of objects passed} \item{k}{penalty term (largely unused: left at default of 2)} \item{x}{an ICtab object} \item{min.weight}{minimum weight for exact reporting (smaller values will be reported as "<[min.weight]")} } \value{ A data frame containing: \item{IC}{information criterion} \item{df}{degrees of freedom/number of parameters} \item{dIC}{difference in IC from minimum-IC model} \item{weights}{exp(-dIC/2)/sum(exp(-dIC/2))} } \note{(1) The print method uses sensible defaults; all ICs are rounded to the nearest 0.1, and IC weights are printed using \code{\link{format.pval}} to print an inequality for values <0.001. (2) The computation of degrees of freedom/number of parameters (e.g., whether variance parameters are included in the total) varies enormously between packages. As long as the df computations for a given set of models is consistent, differences don't matter, but one needs to be careful with log likelihoods and models taken from different packages. If necessary one can change the degrees of freedom manually by saying \code{attr(obj,"df") <- df.new}, where \code{df.new} is the desired number of parameters. (3) Defaults have changed to \code{sort=TRUE}, \code{base=FALSE}, \code{delta=TRUE}, to match my conviction that it rarely makes sense to report the overall values of information criteria} \references{Burnham and Anderson 2002} \author{Ben Bolker} \examples{ set.seed(101) d <- data.frame(x=1:20,y=rpois(20,lambda=2)) m0 <- glm(y~1,data=d) m1 <- update(m0,.~x) m2 <- update(m0,.~poly(x,2)) AICtab(m0,m1,m2,mnames=LETTERS[1:3]) AICtab(m0,m1,m2,base=TRUE,logLik=TRUE) AICtab(m0,m1,m2,logLik=TRUE) AICctab(m0,m1,m2,weights=TRUE) print(AICctab(m0,m1,m2,weights=TRUE),min.weight=0.1) } \keyword{misc} bbmle/man/mle-class.Rd0000754000176200001440000000744213054650752014275 0ustar liggesusers\name{mle2-class} \docType{class} \alias{mle2-class} \alias{coef,mle2-method} \alias{show,mle2-method} \alias{slice,mle2-method} \alias{summary,mle2-method} \alias{update,mle2-method} \alias{vcov,mle2-method} \alias{deviance,mle2-method} \alias{coerce,mle,mle2-method} \alias{formula,mle2-method} \alias{stdEr} \alias{stdEr,mle2-method} \title{Class "mle2". Result of Maximum Likelihood Estimation.} \description{This class encapsulates results of a generic maximum likelihood procedure.} \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("mle2", \dots)}, but most often as the result of a call to \code{\link{mle2}}. } \section{Slots}{ \describe{ \item{\code{call}:}{(language) The call to \code{\link{mle2}}.} \item{\code{call.orig}:}{(language) The call to \code{\link{mle2}}, saved in its original form (i.e. without data arguments evaluated).} \item{\code{coef}:}{(numeric) Vector of estimated parameters.} \item{\code{data}:}{(data frame or list) Data with which to evaluate the negative log-likelihood function} \item{\code{fullcoef}:}{(numeric) Fixed and estimated parameters.} \item{\code{vcov}:}{(numeric matrix) Approximate variance-covariance matrix, based on the second derivative matrix at the MLE.} \item{\code{min}:}{(numeric) Minimum value of objective function = minimum negative log-likelihood.} \item{\code{details}:}{(list) Return value from \code{\link{optim}}.} \item{\code{minuslogl}:}{(function) The negative log-likelihood function.} \item{\code{optimizer}:}{(character) The optimizing function used.} \item{\code{method}:}{(character) The optimization method used.} \item{\code{formula}:}{(character) If a formula was specified, a character vector giving the formula and parameter specifications.} } } \section{Methods}{ \describe{ \item{coef}{\code{signature(object = "mle2")}: Extract coefficients. If \code{exclude.fixed=TRUE} (it is \code{FALSE} by default), only the non-fixed parameter values are returned.} \item{confint}{\code{signature(object = "mle2")}: Confidence intervals from likelihood profiles, or quadratic approximations, or root-finding.} \item{show}{\code{signature(object = "mle2")}: Display object briefly.} \item{show}{\code{signature(object = "summary.mle2")}: Display object briefly.} \item{summary}{\code{signature(object = "mle2")}: Generate object summary.} \item{update}{\code{signature(object = "mle2")}: Update fit.} \item{vcov}{\code{signature(object = "mle2")}: Extract variance-covariance matrix.} \item{formula}{\code{signature(object="mle2")}: Extract formula} \item{plot}{\code{signature(object="profile.mle2,missing")}: Plot profile. } } } \section{Details on the confint method}{ When the parameters in the original fit are constrained using \code{lower} or \code{upper}, or when \code{prof.lower} or \code{prof.upper} are set, and the confidence intervals lie outside the constraint region, \code{confint} will return \code{NA}. This may be too conservative -- in some cases, the appropriate answer would be to set the confidence limit to the lower/upper bound as appropriate -- but it is the most general answer. (If you have a strong opinion about the need for a new option to \code{confint} that sets the bounds to the limits automatically, please contact the package maintainer.) } \examples{ x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) lowerbound <- c(a=2,b=-0.2) d <- data.frame(x,y) fit1 <- mle2(y~dpois(lambda=exp(a+b*x)),start=list(a=0,b=2),data=d, method="L-BFGS-B",lower=c(a=2,b=-0.2)) (cc <- confint(fit1,quietly=TRUE)) ## to set the lower bounds to the limit na_lower <- is.na(cc[,1]) cc[na_lower,1] <- lowerbound[na_lower] cc } \keyword{classes} bbmle/man/mle2.options.Rd0000755000176200001440000000152313046671362014742 0ustar liggesusers\name{mle2.options} \alias{mle2.options} \title{Options for maximum likelihood estimation} \description{ Query or set MLE parameters } \usage{ mle2.options(...) } \arguments{ \item{\dots}{names of arguments to query, or a list of values to set} } \details{ \itemize{ \item{optim.method}{name of optimization method (see \code{\link{optim}} for choices)} \item{confint}{name of confidence-interval: choices are "spline", "uniroot", "hessian" corresponding to spline inversion, attempt to find best answer via uniroot, information-matrix approximation} \item{optimizer}{optimization function to use by default (choices: "optim", "nlm", "nlminb", "constrOptim")} } } \value{ Values of queried parameters, or (invisibly) the full list of parameters } \seealso{ \code{\link{mle2-class}} } \keyword{models} bbmle/man/strwrapx.Rd0000755000176200001440000000473613046671362014314 0ustar liggesusers\name{strwrapx} \alias{strwrapx} \title{Wrap strings at white space and + symbols} \description{ Extended (hacked) version of strwrap: wraps a string at whitespace and plus symbols } \usage{ strwrapx(x, width = 0.9 * getOption("width"), indent = 0, exdent = 0, prefix = "", simplify = TRUE, parsplit = "\n[ \t\n]*\n", wordsplit = "[ \t\n]") } \arguments{ \item{x}{a character vector, or an object which can be converted to a character vector by \code{\link{as.character}}.} \item{width}{a positive integer giving the target column for wrapping lines in the output.} \item{indent}{a non-negative integer giving the indentation of the first line in a paragraph.} \item{exdent}{a non-negative integer specifying the indentation of subsequent lines in paragraphs.} \item{prefix}{a character string to be used as prefix for each line.} \item{simplify}{a logical. If \code{TRUE}, the result is a single character vector of line text; otherwise, it is a list of the same length as \code{x} the elements of which are character vectors of line text obtained from the corresponding element of \code{x}. (Hence, the result in the former case is obtained by unlisting that of the latter.)} \item{parsplit}{Regular expression describing how to split paragraphs} \item{wordsplit}{Regular expression decribing how to split words} } \details{ Whitespace in the input is destroyed. Double spaces after periods (thought as representing sentence ends) are preserved. Currently, possible sentence ends at line breaks are not considered specially. Indentation is relative to the number of characters in the prefix string. } \examples{ ## Read in file 'THANKS'. x <- paste(readLines(file.path(R.home("doc"), "THANKS")), collapse = "\n") ## Split into paragraphs and remove the first three ones x <- unlist(strsplit(x, "\n[ \t\n]*\n"))[-(1:3)] ## Join the rest x <- paste(x, collapse = "\n\n") ## Now for some fun: writeLines(strwrap(x, width = 60)) writeLines(strwrap(x, width = 60, indent = 5)) writeLines(strwrap(x, width = 60, exdent = 5)) writeLines(strwrap(x, prefix = "THANKS> ")) ## Note that messages are wrapped AT the target column indicated by ## 'width' (and not beyond it). ## From an R-devel posting by J. Hosking . x <- paste(sapply(sample(10, 100, rep=TRUE), function(x) substring("aaaaaaaaaa", 1, x)), collapse = " ") sapply(10:40, function(m) c(target = m, actual = max(nchar(strwrap(x, m))))) } \keyword{character} bbmle/man/sbinom.Rd0000755000176200001440000000400713046671362013700 0ustar liggesusers\name{sbinom} \alias{sbinom} \alias{spois} \alias{snbinom} \alias{snorm} \alias{sbeta} \alias{sbetabinom} \title{Abstract definitions of distributions} \description{ Functions returning values for summary statistics (mean, median, etc.) of distributions } \usage{ sbeta(shape1, shape2) sbetabinom(size, prob, theta) sbinom(size, prob) snbinom(size, prob, mu) snorm(mean, sd) spois(lambda) } \arguments{ \item{prob}{probability as defined for \code{\link{dbinom}}, \code{\link{dnbinom}}, or beta-binomial distribution (\code{dbetabinom} in the \code{emdbook} package)} \item{size}{size parameter as defined for \code{\link{dbinom}} or \code{dbetabinom} in the \code{emdbook} package, or size/overdispersion parameter as in \code{\link{dnbinom}}} \item{mean}{mean parameter as defined for \code{\link{dnorm}}} \item{mu}{mean parameter as defined for \code{\link{dnbinom}}} \item{sd}{standard deviation parameter as defined for \code{\link{dnorm}}} \item{shape1}{shape parameter for \code{\link{dbeta}}} \item{shape2}{shape parameter for \code{\link{dbeta}}} \item{lambda}{rate parameter as defined for \code{\link{dpois}}} \item{theta}{overdispersion parameter for beta-binomial (see \code{dbetabinom} in the \code{emdbook} package)} } \value{ \item{title}{name of the distribution} \item{[parameters]}{input parameters for the distribution} \item{mean}{theoretical mean of the distribution} \item{median}{theoretical median of the distribution} \item{mode}{theoretical mode of the distribution} \item{variance}{theoretical variance of the distribution} \item{sd}{theoretical standard deviation of the distribution} } \author{Ben Bolker} \seealso{\code{\link{dbinom}}, \code{\link{dpois}}, \code{\link{dnorm}}, \code{\link{dnbinom}}} \examples{ sbinom(prob=0.2,size=10) snbinom(mu=2,size=1.2) } \note{these definitions are tentative, subject to change as I figure this out better. Perhaps construct functions that return functions? Strip down results? Do more automatically?} \keyword{misc} bbmle/man/call.to.char.Rd0000755000176200001440000000076613046671362014671 0ustar liggesusers\name{call.to.char} \alias{call.to.char} \title{Convert calls to character} \description{ Utility function (hack) to convert calls such as y~x to their character equivalent } \usage{ call.to.char(x) } \arguments{ \item{x}{a formula (call)} } \details{ It would be nice if \code{as.character(y~x)} gave "y~x", but it doesn't, so this hack achieves the same goal } \value{ a character vector of length 1 } \author{Ben Bolker} \examples{ as.character(y~x) call.to.char(y~x) } \keyword{misc} bbmle/man/mle2.Rd0000755000176200001440000002233713072222365013250 0ustar liggesusers\name{mle2} \alias{mle2} \alias{mle} \alias{calc_mle2_function} \title{Maximum Likelihood Estimation} \description{ Estimate parameters by the method of maximum likelihood. } \usage{ mle2(minuslogl, start, method, optimizer, fixed = NULL, data=NULL, subset=NULL, default.start=TRUE, eval.only = FALSE, vecpar=FALSE, parameters=NULL, parnames=NULL, skip.hessian=FALSE, hessian.opts=NULL, use.ginv=TRUE, trace=FALSE, browse_obj=FALSE, gr=NULL, optimfun,\dots) calc_mle2_function(formula,parameters, links, start, parnames, use.deriv=FALSE, data=NULL,trace=FALSE) } \arguments{ \item{minuslogl}{Function to calculate negative log-likelihood, or a formula} \item{start}{Named list. Initial values for optimizer} \item{method}{Optimization method to use. See \code{\link{optim}}.} \item{optimizer}{Optimization function to use. Currently available choices are "optim" (the default), "nlm", "nlminb", "constrOptim", "optimx", and "optimize". If "optimx" is used, (1) the \code{optimx} package must be explicitly loaded with \code{\link{load}} or \code{\link{require}}(\emph{Warning:} Options other than the default may be poorly tested, use with caution.) } \item{fixed}{Named list. Parameter values to keep fixed during optimization.} \item{data}{list of data to pass to negative log-likelihood function: must be specified if \code{minuslogl} is specified as a formula} \item{subset}{logical vector for subsetting data (STUB)} \item{default.start}{Logical: allow default values of \code{minuslogl} as starting values?} \item{eval.only}{Logical: return value of \code{minuslogl(start)} rather than optimizing} \item{vecpar}{Logical: is first argument a vector of all parameters? (For compatibility with \code{\link{optim}}.) If \code{vecpar} is \code{TRUE}, then you should use \code{\link{parnames}} to define the parameter names for the negative log-likelihood function.} \item{parameters}{List of linear models for parameters. \emph{MUST BE SPECIFIED IN THE SAME ORDER as the start vector (this is a bug/restriction that I hope to fix soon, but in the meantime beware)}} \item{links}{(unimplemented) specify transformations of parameters} \item{parnames}{List (or vector?) of parameter names} \item{gr}{gradient function} \item{\dots}{Further arguments to pass to optimizer} \item{formula}{a formula for the likelihood (see Details)} \item{trace}{Logical: print parameter values tested?} \item{browse_obj}{Logical: drop into browser() within the objective function?} \item{skip.hessian}{Bypass Hessian calculation?} \item{hessian.opts}{Options for Hessian calculation, passed through to the \code{\link[numDeriv]{hessian}} function} \item{use.ginv}{Use generalized inverse (\code{\link[MASS]{ginv}}) to compute approximate variance-covariance} \item{optimfun}{user-supplied optimization function. Must take exactly the same arguments and return exactly the same structure as \code{\link{optim}}.} \item{use.deriv}{(experimental, not yet implemented): construct symbolic derivatives based on formula?} } \section{Warning}{Do not use a higher-level variable named \code{.i} in \code{parameters} -- this is reserved for internal use. } \details{ The \code{\link{optim}} optimizer is used to find the minimum of the negative log-likelihood. An approximate covariance matrix for the parameters is obtained by inverting the Hessian matrix at the optimum. The \code{minuslogl} argument can also specify a formula, rather than an objective function, of the form \code{x~ddistn(param1,...,paramn)}. In this case \code{ddistn} is taken to be a probability or density function, which must have (literally) \code{x} as its first argument (although this argument may be interpreted as a matrix of multivariate responses) and which must have a \code{log} argument that can be used to specify the log-probability or log-probability-density is required. If a formula is specified, then \code{parameters} can contain a list of linear models for the parameters. If a formula is given and non-trivial linear models are given in \code{parameters} for some of the variables, then model matrices will be generated using \code{model.matrix}. \code{start} can be given: \itemize{ \item as a list containing lists, with each list corresponding to the starting values for a particular parameter; \item just for the higher-level parameters, in which case all of the additional parameters generated by \code{model.matrix} will be given starting values of zero (unless a no-intercept formula with \code{-1} is specified, in which case all the starting values for that parameter will be set equal) \item [to be implemented!] as an exhaustive (flat) list of starting values (in the order given by \code{model.matrix}) } The \code{trace} argument applies only when a formula is specified. If you specify a function, you can build in your own \code{print()} or \code{cat()} statement to trace its progress. (You can also specify a value for \code{trace} as part of a \code{control} list for \code{optim()}: see \code{\link{optim}}.) The \code{skip.hessian} argument is useful if the function is crashing with a "non-finite finite difference value" error when trying to evaluate the Hessian, but will preclude many subsequent confidence interval calculations. (You will know the Hessian is failing if you use \code{method="Nelder-Mead"} and still get a finite-difference error.) If convergence fails, see the manual page of the relevant optimizer (\code{\link{optim}} by default, but possibly \code{\link{nlm}}, \code{\link{nlminb}}, \code{\link[optimx]{optimx}}, or \code{\link{constrOptim}} if you have set the value of \code{optimizer}) for the meanings of the error codes/messages. } \value{ An object of class \code{"mle2"}. } \note{ Note that the \code{minuslogl} function should return the negative log-likelihood, -log L (not the log-likelihood, log L, nor the deviance, -2 log L). It is the user's responsibility to ensure that the likelihood is correct, and that asymptotic likelihood inference is valid (e.g. that there are "enough" data and that the estimated parameter values do not lie on the boundary of the feasible parameter space). If \code{lower}, \code{upper}, \code{control$parscale}, or \code{control$ndeps} are specified for \code{optim} fits, they must be named vectors. The requirement that \code{data} be specified when using the formula interface is relatively new: it saves many headaches on the programming side when evaluating the likelihood function later on (e.g. for profiling or constructing predictions). Since \code{data.frame} uses the names of its arguments as column names by default, it is probably the easiest way to package objects that are lying around in the global workspace for use in \code{mle2} (provided they are all of the same length). When \code{optimizer} is set to "optimx" and multiple optimization methods are used (i.e. the \code{methods} argument has more than one element, or \code{all.methods=TRUE} is set in the control options), the best (minimum negative log-likelihood) solution will be saved, regardless of reported convergence status (and future operations such as profiling on the fit will only use the method that found the best result). } \seealso{ \code{\link{mle2-class}} } \examples{ x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) ## in general it is best practice to use the `data' argument, ## but variables can also be drawn from the global environment LL <- function(ymax=15, xhalf=6) -sum(stats::dpois(y, lambda=ymax/(1+x/xhalf), log=TRUE)) ## uses default parameters of LL (fit <- mle2(LL)) fit1F <- mle2(LL, fixed=list(xhalf=6)) coef(fit1F) coef(fit1F,exclude.fixed=TRUE) (fit0 <- mle2(y~dpois(lambda=ymean),start=list(ymean=mean(y)),data=d)) anova(fit0,fit) summary(fit) logLik(fit) vcov(fit) p1 <- profile(fit) plot(p1, absVal=FALSE) confint(fit) ## use bounded optimization ## the lower bounds are really > 0, but we use >=0 to stress-test ## profiling; note lower must be named (fit1 <- mle2(LL, method="L-BFGS-B", lower=c(ymax=0, xhalf=0))) p1 <- profile(fit1) plot(p1, absVal=FALSE) ## a better parameterization: LL2 <- function(lymax=log(15), lxhalf=log(6)) -sum(stats::dpois(y, lambda=exp(lymax)/(1+x/exp(lxhalf)), log=TRUE)) (fit2 <- mle2(LL2)) plot(profile(fit2), absVal=FALSE) exp(confint(fit2)) vcov(fit2) cov2cor(vcov(fit2)) mle2(y~dpois(lambda=exp(lymax)/(1+x/exp(lhalf))), start=list(lymax=0,lhalf=0), data=d, parameters=list(lymax~1,lhalf~1)) \dontrun{ ## try bounded optimization with nlminb and constrOptim (fit1B <- mle2(LL, optimizer="nlminb", lower=c(lymax=1e-7, lhalf=1e-7))) p1B <- profile(fit1B) confint(p1B) (fit1C <- mle2(LL, optimizer="constrOptim", ui = c(lymax=1,lhalf=1), ci=2, method="Nelder-Mead")) set.seed(1001) lymax <- c(0,2) lhalf <- 0 x <- sort(runif(200)) g <- factor(sample(c("a","b"),200,replace=TRUE)) y <- rnbinom(200,mu=exp(lymax[g])/(1+x/exp(lhalf)),size=2) d2 <- data.frame(x,g,y) fit3 <- mle2(y~dnbinom(mu=exp(lymax)/(1+x/exp(lhalf)),size=exp(logk)), parameters=list(lymax~g),data=d2, start=list(lymax=0,lhalf=0,logk=0)) } } \keyword{models} bbmle/man/namedrop.Rd0000755000176200001440000000142013046671362014212 0ustar liggesusers\name{namedrop} \alias{namedrop} \title{drop unneeded names from list elements} \description{ goes through a list (containing a combination of single- and multiple-element vectors) and removes redundant names that will make trouble for mle } \usage{ namedrop(x) } \arguments{ \item{x}{a list of named or unnamed, typically numeric, vectors} } \details{ examines each element of \code{x}. If the element has length one and is a named vector, the name is removed; if \code{length(x)} is greater than 1, but all the names are the same, the vector is renamed } \value{ the original list, with names removed/added } \author{Ben Bolker} \examples{ x = list(a=c(a=1),b=c(d=1,d=2),c=c(a=1,b=2,c=3)) names(unlist(namedrop(x))) names(unlist(namedrop(x))) } \keyword{misc} bbmle/man/slice.Rd0000755000176200001440000001000013046671362013476 0ustar liggesusers\name{slice} \alias{slice} \alias{sliceOld} \alias{slicetrans} \alias{slice1D} \alias{slice2D} \title{Calculate likelihood "slices"} \description{ Computes cross-section(s) of a multi-dimensional likelihood surface } \usage{ slice(x, dim=1, ...) sliceOld(fitted, which = 1:p, maxsteps = 100, alpha = 0.01, zmax = sqrt(qchisq(1 - alpha/2, p)), del = zmax/5, trace = FALSE, tol.newmin=0.001, \dots) slice1D(params,fun,nt=101,lower=-Inf, upper=Inf,verbose=TRUE, tranges=NULL,\dots) slice2D(params,fun,nt=31,lower=-Inf, upper=Inf, cutoff=10,verbose=TRUE, tranges=NULL, \dots) slicetrans(params, params2, fun, extend=0.1, nt=401, lower=-Inf, upper=Inf) } \arguments{ \item{x}{a fitted model object of some sort} \item{dim}{dimensionality of slices (1 or 2)} \item{params}{a named vector of baseline parameter values} \item{params2}{a vector of parameter values} \item{fun}{an objective function} \item{nt}{(integer) number of slice-steps to take} \item{lower}{lower bound(s) (stub?)} \item{upper}{upper bound(s) (stub?)} \item{cutoff}{maximum increase in objective function to allow when computing ranges} \item{extend}{(numeric) fraction by which to extend range beyond specified points} \item{verbose}{print verbose output?} \item{fitted}{A fitted maximum likelihood model of class \dQuote{mle2}} \item{which}{a numeric or character vector describing which parameters to profile (default is to profile all parameters)} \item{maxsteps}{maximum number of steps to take looking for an upper value of the negative log-likelihood} \item{alpha}{maximum (two-sided) likelihood ratio test confidence level to find} \item{zmax}{maximum value of signed square root of deviance difference to find (default value corresponds to a 2-tailed chi-squared test at level alpha)} \item{del}{step size for profiling} \item{trace}{(logical) produce tracing output?} \item{tol.newmin}{tolerance for diagnosing a new minimum below the minimum deviance estimated in initial fit is found} \item{tranges}{a two-column matrix giving lower and upper bounds for each parameter} \item{\dots}{additional arguments (not used)} } \value{ An object of class \code{slice} with \describe{ \item{slices}{a list of individual parameter (or parameter-pair) slices, each of which is a data frame with elements \describe{ \item{var1}{name of the first variable} \item{var2}{(for 2D slices) name of the second variable} \item{x}{parameter values} \item{y}{(for 2D slices) parameter values} \item{z}{slice values} \item{ranges}{a list (?) of the ranges for each parameter} \item{params}{vector of baseline parameter values} \item{dim}{1 or 2} } } \code{sliceOld} returns instead a list with elements \code{profile} and \code{summary} (see \code{\link{profile.mle2}}) } } \details{ Slices provide a lighter-weight way to explore likelihood surfaces than profiles, since they vary a single parameter rather than optimizing over all but one or two parameters. \describe{ \item{slice}{is a generic method} \item{slice1D}{creates one-dimensional slices, by default of all parameters of a model} \item{slice2D}{creates two-dimensional slices, by default of all pairs of parameters in a model} \item{slicetrans}{creates a slice along a transect between two specified points in parameter space (see \code{calcslice} in the \code{emdbook} package)} } } \author{Ben Bolker} \seealso{\code{\link{profile}}} \examples{ x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) fit1 <- mle2(y~dpois(lambda=exp(lymax)/(1+x/exp(lhalf))), start=list(lymax=0,lhalf=0), data=d) s1 <- slice(fit1,verbose=FALSE) s2 <- slice(fit1,dim=2,verbose=FALSE) require(lattice) plot(s1) plot(s2) ## 'transect' slice, from best-fit values to another point st <- slice(fit1,params2=c(5,0.5)) plot(st) } \keyword{misc} bbmle/man/predict-methods.Rd0000754000176200001440000000450313013175535015477 0ustar liggesusers\name{predict-methods} \docType{methods} \alias{gfun} \alias{predict-methods} \alias{predict,mle2-method} \alias{residuals,mle2-method} \alias{simulate,mle2-method} \title{Predicted values from an mle2 fit} \description{ Given an \code{mle2} fit and an optional list of new data, return predictions (more generally, summary statistics of the predicted distribution) } \section{Methods}{ \describe{ \item{x = "mle2"}{an \code{mle2} fit} }} \usage{ \S4method{predict}{mle2}(object, newdata=NULL, location="mean", newparams=NULL, \dots) \S4method{simulate}{mle2}(object, nsim, seed, newdata=NULL, newparams=NULL, \dots) \S4method{residuals}{mle2}(object,type=c("pearson","response"), location="mean",\dots) } \arguments{ \item{object}{an mle2 object} \item{newdata}{optional list of new data} \item{newparams}{optional vector of new parameters} \item{location}{name of the summary statistic to return} \item{nsim}{number of simulations} \item{seed}{random number seed} \item{type}{residuals type} \item{\dots}{additional arguments (for generic compatibility)} } \note{For some models (e.g. constant models), \code{predict} may return a single value rather than a vector of the appropriate length.} \examples{ set.seed(1002) lymax <- c(0,2) lhalf <- 0 x <- runif(200) g <- factor(rep(c("a","b"),each=100)) y <- rnbinom(200,mu=exp(lymax[g])/(1+x/exp(lhalf)),size=2) dat <- data.frame(y,g,x) fit3 <- mle2(y~dnbinom(mu=exp(lymax)/(1+x/exp(lhalf)),size=exp(logk)), parameters=list(lymax~g), start=list(lymax=0,lhalf=0,logk=0), data=dat) plot(y~x,col=g) ## true curves curve(exp(0)/(1+x/exp(0)),add=TRUE) curve(exp(2)/(1+x/exp(0)),col=2,add=TRUE) ## model predictions xvec = seq(0,1,length=100) lines(xvec,predict(fit3,newdata=list(g=factor(rep("a",100),levels=c("a","b")), x = xvec)),col=1,lty=2) lines(xvec,predict(fit3,newdata=list(g=factor(rep("b",100),levels=c("a","b")), x = xvec)),col=2,lty=2) ## comparing automatic and manual predictions p1 = predict(fit3) p2A = with(as.list(coef(fit3)),exp(`lymax.(Intercept)`)/(1+x[1:100]/exp(lhalf))) p2B = with(as.list(coef(fit3)),exp(`lymax.(Intercept)`+lymax.gb)/(1+x[101:200]/exp(lhalf))) all(p1==c(p2A,p2B)) ## simulate(fit3) } \keyword{methods} bbmle/man/slice.mle-class.Rd0000754000176200001440000000211513013175535015357 0ustar liggesusers\name{slice.mle2-class} \docType{class} \alias{slice.mle2-class} \title{likelihood-surface slices} \description{evaluations of log-likelihood along transects in parameter space} \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("slice.mle2", ...)}. The objects are similar to likelihood profiles, but don't involve any optimization with respect to the other parameters. } \section{Slots}{ \describe{ \item{\code{profile}:}{Object of class \code{"list"}. List of slices, one for each requested parameter. Each slice is a data frame with the first column called \code{z} being the signed square root of the -2 log likelihood ratio, and the others being the parameters with names prefixed by \code{par.vals.}} \item{\code{summary}:}{Object of class \code{"summary.mle2"}. Summary of object being profiled.} } } \section{Methods}{ \describe{ \item{plot}{\code{signature(x = "profile.mle2", y = "missing")}: Plot profiles for each parameter.} } } \seealso{ \code{\link{profile.mle2-class}} } \keyword{classes} bbmle/man/relist.Rd0000754000176200001440000000107513013175535013707 0ustar liggesusers\name{relist2} \alias{relist2} \title{reconstruct the structure of a list} \description{ reshapes a vector according to a list template } \usage{ relist2(v, l) } \arguments{ \item{v}{vector, probably numeric, of values to reshape} \item{l}{template list giving structure} } \details{ attempts to coerce \code{v} into a list with the same structure and names as \code{l} } \value{ a list with values corresponding to v and structure corresponding to l } \author{Ben Bolker} \examples{ l = list(b=1,c=2:5,d=matrix(1:4,nrow=2)) relist2(1:9,l) } \keyword{misc}