bbmle/0000755000176200001440000000000014534736023011342 5ustar liggesusersbbmle/NAMESPACE0000755000176200001440000000320314234301363012552 0ustar liggesusersexport(mle2,call.to.char,namedrop,parnames,"parnames<-",relist2) export(sbinom,snorm,sbeta,snbinom,spois,sbetabinom,dnorm_n,slnorm) export(ICtab,AICtab,BICtab,AICctab) export(stdEr,vcov) export(slice,sliceOld,slice1D,slice2D) export(proffun) export(pop_pred_samp) export(mle2.options) 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, dnorm) importFrom(methods,setMethod,is) importFrom(lattice,xyplot,splom,diag.panel.splom,panel.abline,panel.number,panel.points,panel.xyplot) ## for slice methods importFrom(Matrix,nearPD) 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) importFrom(MASS, mvrnorm, ginv) importFrom(bdsmatrix, gchol) importFrom(mvtnorm,dmvnorm) S3method(as.data.frame,ICtab) S3method(as.data.frame,profile.mle2) S3method(print,ICtab) S3method(slice,mle2) S3method(plot,slice) S3method(xyplot,slice) S3method(splom,slice) bbmle/man/0000755000176200001440000000000014235320256012110 5ustar liggesusersbbmle/man/profile.mle-class.Rd0000755000176200001440000001416614234301363015726 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/slice.mle-class.Rd0000755000176200001440000000211514234301363015354 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/namedrop.Rd0000755000176200001440000000142014234301363014201 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/mle2.options.Rd0000755000176200001440000000153314234301363014732 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{ \describe{ \item{optim.method}{name of optimization method (see \code{\link{optim}} for choices)} \item{confint}{name of confidence interval method: 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/mle2.Rd0000755000176200001440000002247414234301363013247 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, namedrop_args=TRUE, \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?} \item{namedrop_args}{hack: drop names in sub-lists occurring in data?} } \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/summary.mle-class.Rd0000755000176200001440000000220714234301363015754 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/ICtab.Rd0000755000176200001440000000636414234301363013372 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/profile-methods.Rd0000755000176200001440000000536314234301363015507 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/BIC-methods.Rd0000755000176200001440000000566314234301363014447 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/pop_pred_samp.Rd0000644000176200001440000000374014234301363015230 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/impsamp.R \name{pop_pred_samp} \alias{pop_pred_samp} \title{generate population prediction sample from parameters} \usage{ pop_pred_samp( object, n = 1000, n_imp = n * 10, return_wts = FALSE, impsamp = FALSE, PDify = FALSE, PDmethod = NULL, Sigma = vcov(object), tol = 1e-06, return_all = FALSE, rmvnorm_method = c("mvtnorm", "MASS"), fix_params = NULL, ... ) } \arguments{ \item{object}{a fitted \code{mle2} object} \item{n}{number of samples to return} \item{n_imp}{number of total samples from which to draw, if doing importance sampling} \item{return_wts}{return a column giving the weights of the samples, for use in weighted summaries?} \item{impsamp}{subsample values (with replacement) based on their weights?} \item{PDify}{use Gill and King generalized-inverse procedure to correct non-positive-definite variance-covariance matrix if necessary?} \item{PDmethod}{method for fixing non-positive-definite covariance matrices} \item{tol}{tolerance for detecting small eigenvalues} \item{return_all}{return a matrix including all values, and weights (rather than taking a sample)} \item{rmvnorm_method}{package to use for generating MVN samples} \item{fix_params}{parameters to fix (in addition to parameters that were fixed during estimation)} \item{Sigma}{covariance matrix for sampling} \item{...}{additional parameters to pass to the negative log-likelihood function} } \description{ This [EXPERIMENTAL] function combines several sampling tricks to compute a version of an importance sample (based on flat priors) for the parameters. } \references{ Gill, Jeff, and Gary King. "What to Do When Your Hessian Is Not Invertible: Alternatives to Model Respecification in Nonlinear Estimation." Sociological Methods & Research 33, no. 1 (2004): 54-87. Lande, Russ and Steinar Engen and Bernt-Erik Saether, Stochastic Population Dynamics in Ecology and Conservation. Oxford University Press, 2003. } bbmle/man/strwrapx.Rd0000755000176200001440000000473614234301363014303 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.Rd0000755000176200001440000000423014234301363013665 0ustar liggesusers\name{sbinom} \alias{sbinom} \alias{spois} \alias{snbinom} \alias{snorm} \alias{sbeta} \alias{sbetabinom} \alias{slnorm} \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) slnorm(meanlog, sdlog) } \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)} \item{meanlog}{as defined for \code{\link{dlnorm}}} \item{sdlog}{as defined for \code{\link{dlnorm}}} } \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/mle-class.Rd0000755000176200001440000000744214234301363014266 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/as.data.frame.profile.mle2.Rd0000755000176200001440000000260314234301363017301 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/get.mnames.Rd0000755000176200001440000000046614234301363014443 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/dnorm_n.Rd0000644000176200001440000000151214234301363014027 0ustar liggesusers\name{dnorm_n} \alias{dnorm_n} \title{ Normal distribution with profiled-out standard deviation } \description{ Returns the Normal probability densities for a distribution with the given mean values and the standard deviation equal to the root mean-squared deviation between x and mu } \usage{ dnorm_n(x, mean, log = FALSE) } \arguments{ \item{x}{numeric vector of data} \item{mean}{numeric vector or mean values} \item{log}{logical: return the log-density?} } \details{ This is a convenience function, designed for the case where you're trying to compute a MLE for the mean but don't want to bother estimating the MLE for the standard deviation at the same time } \value{ Numeric vector of probability densities } \examples{ set.seed(101) x <- rnorm(5,mean=3,sd=2) dnorm_n(x,mean=3,log=TRUE) } \keyword{distribution} bbmle/man/call.to.char.Rd0000755000176200001440000000076614234301363014660 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/relist.Rd0000755000176200001440000000107514234301363013704 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} bbmle/man/slice.Rd0000755000176200001440000001067214234301363013504 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, fun_args = 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{fun_args}{additional arguments to pass to \code{fun}} \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. In each panel the closed point represents the parameters given (typically the MLEs), while the open point represents the observed minimum value within the 2D slice. If everything has gone according to plan, these points should coincide (at least up to grid precision). } \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 <- bbmle::slice(fit1,verbose=FALSE) s2 <- bbmle::slice(fit1,dim=2,verbose=FALSE) require(lattice) plot(s1) plot(s2) ## 'transect' slice, from best-fit values to another point st <- bbmle::slice(fit1,params2=c(5,0.5)) plot(st) } \keyword{misc} bbmle/man/parnames.Rd0000755000176200001440000000202314234301363014202 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/predict-methods.Rd0000755000176200001440000000450314234301363015474 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/TODO0000755000176200001440000000753514234301363012037 0ustar liggesusersSHORT-TERM (release 1.0.22) check with/add contributors fix qAICc output NEWS about start/fixed pull request revdep checks BUGS/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/DESCRIPTION0000644000176200001440000000241614534736022013052 0ustar liggesusersPackage: bbmle Title: Tools for General Maximum Likelihood Estimation Description: Methods and functions for fitting maximum likelihood models in R. This package modifies and extends the 'mle' classes in the 'stats4' package. Version: 1.0.25.1 Authors@R: c(person("Ben","Bolker",email="bolker@mcmaster.ca",role=c("aut","cre"), comment=c(ORCID="0000-0002-2127-0443")), person("R Development Core Team",role=c("aut")), person("Iago Giné-Vázquez", role=c("ctb")) ) Depends: R (>= 3.0.0), stats4 Imports: stats, numDeriv, lattice, MASS, methods, bdsmatrix, Matrix, mvtnorm Suggests: emdbook, rms, ggplot2, RUnit, MuMIn, AICcmodavg, Hmisc, optimx (>= 2013.8.6), knitr, testthat VignetteBuilder: knitr BuildVignettes: yes License: GPL URL: https://github.com/bbolker/bbmle Collate: 'mle2-class.R' 'mle2-methods.R' 'mle.R' 'confint.R' 'predict.R' 'profile.R' 'update.R' 'dists.R' 'IC.R' 'slice.R' 'impsamp.R' 'TMB.R' RoxygenNote: 7.1.0 Encoding: UTF-8 NeedsCompilation: no Packaged: 2023-12-08 23:45:52 UTC; bolker Author: Ben Bolker [aut, cre] (), R Development Core Team [aut], Iago Giné-Vázquez [ctb] Maintainer: Ben Bolker Repository: CRAN Date/Publication: 2023-12-09 01:00:02 UTC bbmle/build/0000755000176200001440000000000014534725246012446 5ustar liggesusersbbmle/build/vignette.rds0000644000176200001440000000044314534725246015006 0ustar liggesusersmPMO0 ֮JHH#7Ę$45kR(Wt9~[B0@!Dp;Đ/tijvǜlB Gs[Ra6dSUv[[%?kaHaj藍,5ToHQr܊:ۣg-]dn17ioװBi!Τ?3Z SQÝm (.meWGg9;sޑ'*%:#bbmle/tests/0000755000176200001440000000000014534725260012505 5ustar liggesusersbbmle/tests/mortanal.Rout.save0000644000176200001440000001502414234301363016123 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/gradient_vecpar_profile.R0000644000176200001440000000252314234301363017476 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/boundstest.R0000644000176200001440000000064614234301363015017 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/binomtest1.R0000644000176200001440000000212414234301363014703 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/test-relist1.Rout.save0000644000176200001440000000235114234301363016645 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/methods.R0000644000176200001440000000125414234301363014264 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/testderiv.Rout.save0000644000176200001440000000576714234301363016334 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/testbounds.R0000644000176200001440000000064014234301363015011 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/update.R0000644000176200001440000000063614234301363014106 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/optimize.Rout.save0000644000176200001440000000362414234301363016151 0ustar liggesusers R Under development (unstable) (2019-06-19 r76722) -- "Unsuffered Consequences" Copyright (C) 2019 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. > ## try to reconstruct error reported by Hofert Jan Marius > ## (simpler version) > > Lfun <- function(x) { + (x-5)^2 + } > > > > library(bbmle) Loading required package: stats4 > > 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 messages: 1: In .local(x, ...) : non-monotonic profile: reverting to linear interpolation. Consider setting std.err manually 2: In regularize.values(x, y, ties, missing(ties), na.rm = na.rm) : collapsing to unique 'x' values > > proc.time() user system elapsed 1.628 0.096 1.803 bbmle/tests/predict.Rout.save0000644000176200001440000000351714234301363015744 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/startvals.Rout.save0000644000176200001440000000363614234301363016337 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/optimizers.R0000644000176200001440000000143714234301363015031 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/optimizers.Rout.save0000644000176200001440000000365114234301363016516 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/order.R0000644000176200001440000000130014234301363013724 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/prof_spec.R0000644000176200001440000000140614234301363014600 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/predict.R0000644000176200001440000000174114234301363014254 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/optimize.R0000644000176200001440000000076014234301363014462 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/optimx.Rout.save0000644000176200001440000000302614234301363015625 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/glmcomp.R0000644000176200001440000000160614234301363014260 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/testparpred.Rout.save0000644000176200001440000000274014234301363016644 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/tmptest.R0000644000176200001440000000042314234301363014316 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.Rout.save0000644000176200001440000000243714234301363015703 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/grtest1.R0000644000176200001440000000071614234301363014214 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/tmptest.Rout.save0000644000176200001440000000255014234301363016006 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/binomtest1.Rout.save0000644000176200001440000000444014234301363016373 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/makesavefiles0000644000176200001440000000014614234301363015237 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/mortanal.R0000644000176200001440000000674014234301363014443 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/richards.R0000644000176200001440000000566714234301363014434 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/mkout0000644000176200001440000000006414234301363013556 0ustar liggesusersR CMD BATCH --vanilla $1.R; mv $1.Rout $1.Rout.save bbmle/tests/ICtab.R0000644000176200001440000000145714234301363013610 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)) q1 <- qAICc(m1,nobs=100,dispersion=1.2) qAICc(m1,m1,nobs=100,dispersion=1.2) ## !! i1 <- ICtab(m1,type="qAICc",dispersion=1.2,nobs=100, base=TRUE) m2 = glm(z~1,family=poisson) q2 <- qAICc(m2,nobs=100,dispersion=1.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/prof_newmin.R0000644000176200001440000000037514234301363015147 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/controleval.Rout.save0000644000176200001440000000461614234301363016643 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/testderiv.R0000644000176200001440000000327014234301363014632 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/gradient_vecpar_profile.Rout.save0000644000176200001440000000463014234301363021164 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.Rout.save0000644000176200001440000000334614234301363016504 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/startvals2.Rout.save0000644000176200001440000003257114234301363016421 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/optimx.R0000644000176200001440000000122214234301363014134 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/tests/controleval.R0000644000176200001440000000146114234301363015151 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/richards.Rout.save0000644000176200001440000001154214234301363016106 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/profbound.Rout.save0000644000176200001440000000400514234301363016301 0ustar liggesusers R Under development (unstable) (2019-12-03 r77509) -- "Unsuffered Consequences" Copyright (C) 2019 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) > x <- 0:10 > y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) > d <- data.frame(x,y) > > > ## throws warning on some CRAN system (BDR report 2019-12-20) > ## /tests-noLD/bbmle.Rcheck’ > ## * using R Under development (unstable) (2019-12-19 r77606) > ## * using platform: x86_64-pc-linux-gnu (64-bit) > ## suppressWarnings() doesn't seem to suppress the warning?? > ## instead use test from https://www.r-bloggers.com/a-nold-platform-on-r-hub-package-builder/ > if (capabilities("long.double")) { + fit0 <- suppressWarnings( + 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 2.236 0.120 2.512 bbmle/tests/order.Rout.save0000644000176200001440000000420514234301363015420 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.R0000644000176200001440000000041214234301363013211 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/test-relist1.R0000644000176200001440000000064214234301363015161 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/testenv.R0000644000176200001440000000145214234301363014311 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/RUnit-tests.R0000644000176200001440000000052114234301363015016 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/testenv.Rout.save0000644000176200001440000000467114234301363016004 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/methods.Rout.save0000644000176200001440000000520114234301363015745 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/ICtab.Rout.save0000644000176200001440000000331214234301363015265 0ustar liggesusers R Under development (unstable) (2019-12-03 r77509) -- "Unsuffered Consequences" Copyright (C) 2019 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 > > set.seed(101) > z = rpois(100,lambda=5) > > m1 = mle2(z~dpois(lambda=L),start=list(L=4),data=data.frame(z)) > q1 <- qAICc(m1,nobs=100,dispersion=1.2) > qAICc(m1,m1,nobs=100,dispersion=1.2) ## !! AICc df 1 374.2214 2 2 374.2214 2 > i1 <- ICtab(m1,type="qAICc",dispersion=1.2,nobs=100, base=TRUE) > > m2 = glm(z~1,family=poisson) > q2 <- qAICc(m2,nobs=100,dispersion=1.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"])) > > > proc.time() user system elapsed 1.636 0.112 1.831 bbmle/tests/BIC.Rout.save0000644000176200001440000000227714234301363014711 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.R0000644000176200001440000000163614234301363014650 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/parscale.Rout.save0000644000176200001440000000722414234301363016103 0ustar liggesusers R Under development (unstable) (2019-06-19 r76722) -- "Unsuffered Consequences" Copyright (C) 2019 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) > 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 = c(rate = 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 1.528 0.100 1.762 bbmle/tests/startvals2.R0000644000176200001440000002701414234301363014730 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/eval.Rout.save0000644000176200001440000000620414234301363015235 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.save0000644000176200001440000000335314234301363015746 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/formulatest.R0000644000176200001440000004213314234301363015167 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) ## GH 8 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) fit3b <- mle2(y~dnbinom(mu=exp(lymax)/(1+x/exp(lhalf)),size=exp(logk)), parameters=list(lhalf~1,lymax~g),data=d2, start=list(lhalf=0,lymax=0,logk=0)) coef(fit3b) stopifnot(all.equal(names(coef(fit3b)), c("lhalf", "lymax.(Intercept)", "lymax.gb", "logk"))) bbmle/tests/testparpred.R0000644000176200001440000000117414234301363015157 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/eval.R0000644000176200001440000000327614234301363013556 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/formulatest.Rout.save0000644000176200001440000005131314234301363016654 0ustar liggesusers R Under development (unstable) (2019-06-19 r76722) -- "Unsuffered Consequences" Copyright (C) 2019 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 > 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) > > ## GH 8 > 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) > fit3b <- mle2(y~dnbinom(mu=exp(lymax)/(1+x/exp(lhalf)),size=exp(logk)), + parameters=list(lhalf~1,lymax~g),data=d2, + start=list(lhalf=0,lymax=0,logk=0)) > coef(fit3b) lhalf lymax.(Intercept) lymax.gb logk -0.03968142 -0.10104397 2.12733072 0.40478459 > stopifnot(all.equal(names(coef(fit3b)), + c("lhalf", "lymax.(Intercept)", "lymax.gb", "logk"))) > > proc.time() user system elapsed 2.488 0.132 2.757 bbmle/tests/update.Rout.save0000644000176200001440000000357114234301363015574 0ustar liggesusers R Under development (unstable) (2019-06-19 r76722) -- "Unsuffered Consequences" Copyright (C) 2019 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 > > 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 1.524 0.112 1.728 bbmle/tests/parscale.R0000644000176200001440000000411314234301363014410 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/profbound.R0000644000176200001440000000213614234301363014617 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) ## throws warning on some CRAN system (BDR report 2019-12-20) ## /tests-noLD/bbmle.Rcheck’ ## * using R Under development (unstable) (2019-12-19 r77606) ## * using platform: x86_64-pc-linux-gnu (64-bit) ## suppressWarnings() doesn't seem to suppress the warning?? ## instead use test from https://www.r-bloggers.com/a-nold-platform-on-r-hub-package-builder/ if (capabilities("long.double")) { fit0 <- suppressWarnings( 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/impsamp.R0000644000176200001440000000130014234301363014257 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)))^2,size=2) dd <- data.frame(x,g,y) fit3 <- mle2(y~dnbinom(mu=(exp(lymax)/(1+x/exp(lhalf)))^d,size=exp(logk)), parameters=list(lymax~g), start=list(lymax=0,lhalf=0,logk=0,d=NA), data=dd, fixed=list(d=2)) pp <- pop_pred_samp(fit3,PDify=TRUE) stopifnot( !any(is.na(pp)), identical(colnames(pp), c("lymax.(Intercept)", "lymax.gb", "lhalf", "logk", "d"))) ## fix parameters instead of dealing with negative variance pp2 <- pop_pred_samp(fit3,fix_param="lhalf") stopifnot(length(unique(pp2[,"lhalf"]))==1) bbmle/vignettes/0000755000176200001440000000000014534725260013353 5ustar liggesusersbbmle/vignettes/mle2.bib0000755000176200001440000000074114234301363014664 0ustar liggesusers@ARTICLE{VoneshBolker2005, author = {James R. Vonesh and Benjamin M. Bolker}, title = {Compensatory larval responses shift tradeoffs associated with predator-induced hatching plasticity}, journal = {Ecology}, year = {2005}, volume = {86}, pages = {1580-1591}, number = {6} } @ARTICLE{Crowder1978, author = {Crowder, M. J.}, title = {Beta-binomial {Anova} for proportions}, journal = {Applied Statistics}, year = {1978}, volume = {27}, pages = {34-37} } bbmle/vignettes/mle2.Rnw0000755000176200001440000007626414534722240014717 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,bookmarks=true]{hyperref} \hypersetup{linkcolor=purple,urlcolor=blue,citecolor=gray} \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): <>= suppressWarnings( 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): <>= suppressWarnings( 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: <>= X <- model.matrix(~dilution, data = orob1) 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)) } @ % Would like to show an intermediate example that does plogis(X %*% beta) % explicitly but argument processing is messed up for list-like parameters ... % sigh ... 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, show.points = TRUE) @ What does the profile for $\sigma$ look like? <>= ## not working? ## plot(p2b,which="sigma",plot.confstr=TRUE, show.points=TRUE) par(las = 1, bty = "l") with(p2b@profile$sigma, plot(par.vals[,"sigma"], abs(z), type = "b")) @ 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 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/vignettes/chicago.bst0000755000176200001440000011105114234301363015453 0ustar liggesusers%%% ==================================================================== %%% @BibTeX-style-file{ %%% author = "Glenn Paulley", %%% version = "4", %%% date = "28 August 1992", %%% time = "10:23:39 199", %%% filename = "chicago.bst", %%% address = "Data Structuring Group %%% Department of Computer Science %%% University of Waterloo %%% Waterloo, Ontario, Canada %%% N2L 3G1", %%% telephone = "(519) 885-1211", %%% FAX = "(519) 885-1208", %%% checksum = "26323 1654 5143 37417", %%% email = "gnpaulle@bluebox.uwaterloo.ca", %%% codetable = "ISO/ASCII", %%% keywords = "", %%% supported = "yes", %%% abstract = "A BibTeX bibliography style that follows the %%% `B' reference style of the 13th Edition of %%% the Chicago Manual of Style. A detailed %%% feature list is given below.", %%% docstring = "The checksum field above contains a CRC-16 %%% checksum as the first value, followed by the %%% equivalent of the standard UNIX wc (word %%% count) utility output of lines, words, and %%% characters. This is produced by Robert %%% Solovay's checksum utility.", %%% } %%% ==================================================================== % % "Chicago" BibTeX style, chicago.bst % =================================== % % BibTeX `chicago' style file for BibTeX version 0.99c, LaTeX version 2.09 % Place it in a file called chicago.bst in the BibTeX search path. % You need to include chicago.sty as a \documentstyle option. % (Placing it in the same directory as the LaTeX document should also work.) % This "chicago" style is based on newapa.bst (American Psych. Assoc.) % found at ymir.claremont.edu. % % Citation format: (author-last-name year) % (author-last-name and author-last-name year) % (author-last-name, author-last-name, and author-last-name year) % (author-last-name et al. year) % (author-last-name) % author-last-name (year) % (author-last-name and author-last-name) % (author-last-name et al.) % (year) or (year,year) % year or year,year % % Reference list ordering: alphabetical by author or whatever passes % for author in the absence of one. % % This BibTeX style has support for abbreviated author lists and for % year-only citations. This is done by having the citations % actually look like % % \citeauthoryear{full-author-info}{abbrev-author-info}{year} % % The LaTeX style has to have the following (or similar) % % \let\@internalcite\cite % \def\fullcite{\def\citeauthoryear##1##2##3{##1, ##3}\@internalcite} % \def\fullciteA{\def\citeauthoryear##1##2##3{##1}\@internalcite} % \def\shortcite{\def\citeauthoryear##1##2##3{##2, ##3}\@internalcite} % \def\shortciteA{\def\citeauthoryear##1##2##3{##2}\@internalcite} % \def\citeyear{\def\citeauthoryear##1##2##3{##3}\@internalcite} % % These TeX macro definitions are found in chicago.sty. Additional % commands to manipulate different components of a citation can be defined % so that, for example, you can list author's names without parentheses % if using a citation as a noun or object in a sentence. % % This file was originally copied from newapa.bst at ymir.claremont.edu. % % Features of chicago.bst: % ======================= % % - full names used in citations, but abbreviated citations are available % (see above) % - if an entry has a "month", then the month and year are also printed % as part of that bibitem. % - all conjunctions use "and" instead of "\&" % - major modification from Chicago Manual of Style (13th ed.) is that % only the first author in a reference appears last name first- % additional authors appear as J. Q. Public. % - pages are listed as "pp. xx-xx" in all entry types except % article entries. % - book, inbook, and manual use "location: publisher" (or organization) % for address and publisher. All other types list publishers separately. % - "pp." are used to identify page numbers for all entry types except % articles. % - organization is used as a citation label if neither author nor editor % is present (for manuals). % - "et al." is used for long author and editor lists, or when "others" % is used. % % Modifications and bug fixes from newapa.bst: % =========================================== % % - added month, year to bib entries if month is present % - fixed bug with In proceedings, added necessary comma after title % - all conjunctions changed to "and" from "\&" % - fixed bug with author labels in my.full.label: "et al." now is % generated when "others" is an author name % - major modification from Chicago Manual of Style (13th ed.) is that % only the first author in a reference appears last name first- % additional authors appear as J. Q. Public. % - pages are listed as "pp. xx-xx" in all entry types except % article entries. Unnecessary (IMHO) "()" around page numbers % were removed, and page numbers now don't end with a period. % - created chicago.sty for use with this bibstyle (required). % - fixed bugs in FUNCTION {format.vol.num.pages} for missing volume, % number, and /or pages. Renamed to format.jour.vol. % - fixed bug in formatting booktitles: additional period an error if % book has a volume. % - fixed bug: editors usually given redundant period before next clause % (format.editors.dot) removed. % - added label support for organizations, if both author and editor % are missing (from alpha.bst). If organization is too long, then % the key field is used for abbreviated citations. % - In proceedings or books of several volumes, no comma was written % between the "Volume x" and the page numbers (this was intentional % in newapa.bst). Fixed. % - Some journals may not have volumes/numbers, only month/year (eg. % IEEE Computer). Fixed bug in article style that assumed volume/number % was always present. % % Original documentation for newapa.sty: % ===================================== % % This version was made by modifying the master file made by % Oren Patashnik (PATASHNIK@SCORE.STANFORD.EDU), and the 'named' BibTeX % style of Peter F. Patel-Schneider. % % Copyright (C) 1985, all rights reserved. % Copying of this file is authorized only if either % (1) you make absolutely no changes to your copy, including name, or % (2) if you do make changes, you name it something other than 'newapa.bst'. % There are undoubtably bugs in this style. If you make bug fixes, % improvements, etc. please let me know. My e-mail address is: % spencer@cgrg.ohio.state.edu or 71160.3141@compuserve.com % % This style was made from 'plain.bst', 'named.bst', and 'apalike.bst', % with lots of tweaking to make it look like APA style, along with tips % from Young Ryu and Brian Reiser's modifications of 'apalike.bst'. ENTRY { address author booktitle chapter edition editor howpublished institution journal key month note number organization pages publisher school series title type volume year } {} { label.year extra.label sort.year sort.label } INTEGERS { output.state before.all mid.sentence after.sentence after.block } FUNCTION {init.state.consts} { #0 'before.all := #1 'mid.sentence := #2 'after.sentence := #3 'after.block := } STRINGS { s t u } FUNCTION {output.nonnull} { 's := output.state mid.sentence = { ", " * write$ } { output.state after.block = { add.period$ write$ newline$ "\newblock " write$ } { output.state before.all = 'write$ { add.period$ " " * write$ } if$ } if$ mid.sentence 'output.state := } if$ s } % Use a colon to separate output. Used only for address/publisher % combination in book/inbook types, address/institution for manuals, % and organization:publisher for proceedings (inproceedings). % FUNCTION {output.nonnull.colon} { 's := output.state mid.sentence = { ": " * write$ } { output.state after.block = { add.period$ write$ newline$ "\newblock " write$ } { output.state before.all = 'write$ { add.period$ " " * write$ } if$ } if$ mid.sentence 'output.state := } if$ s } FUNCTION {output} { duplicate$ empty$ 'pop$ 'output.nonnull if$ } FUNCTION {output.colon} { duplicate$ empty$ 'pop$ 'output.nonnull.colon if$ } FUNCTION {output.check} { 't := duplicate$ empty$ { pop$ "empty " t * " in " * cite$ * warning$ } 'output.nonnull if$ } FUNCTION {output.check.colon} { 't := duplicate$ empty$ { pop$ "empty " t * " in " * cite$ * warning$ } 'output.nonnull.colon if$ } FUNCTION {output.year.check} { year empty$ { "empty year in " cite$ * warning$ } { write$ " (" year * extra.label * month empty$ { ")" * } { ", " * month * ")" * } if$ mid.sentence 'output.state := } if$ } FUNCTION {fin.entry} { add.period$ write$ newline$ } FUNCTION {new.block} { output.state before.all = 'skip$ { after.block 'output.state := } if$ } FUNCTION {new.sentence} { output.state after.block = 'skip$ { output.state before.all = 'skip$ { after.sentence 'output.state := } if$ } if$ } FUNCTION {not} { { #0 } { #1 } if$ } FUNCTION {and} { 'skip$ { pop$ #0 } if$ } FUNCTION {or} { { pop$ #1 } 'skip$ if$ } FUNCTION {new.block.checka} { empty$ 'skip$ 'new.block if$ } FUNCTION {new.block.checkb} { empty$ swap$ empty$ and 'skip$ 'new.block if$ } FUNCTION {new.sentence.checka} { empty$ 'skip$ 'new.sentence if$ } FUNCTION {new.sentence.checkb} { empty$ swap$ empty$ and 'skip$ 'new.sentence if$ } FUNCTION {field.or.null} { duplicate$ empty$ { pop$ "" } 'skip$ if$ } % % Emphasize the top string on the stack. % FUNCTION {emphasize} { duplicate$ empty$ { pop$ "" } { "{\em " swap$ * "}" * } if$ } % % Emphasize the top string on the stack, but add a trailing space. % FUNCTION {emphasize.space} { duplicate$ empty$ { pop$ "" } { "{\em " swap$ * "\/}" * } if$ } INTEGERS { nameptr namesleft numnames } % % Format bibliographical entries with the first author last name first, % and subsequent authors with initials followed by last name. % All names are formatted in this routine. % FUNCTION {format.names} { 's := #1 'nameptr := % nameptr = 1; s num.names$ 'numnames := % numnames = num.name$(s); numnames 'namesleft := { namesleft #0 > } { 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.Rnw0000755000176200001440000001477714235317476015214 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} \usepackage[utf8]{inputenc} \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}} <>= if (require("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}} <>= if (require("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/R/0000755000176200001440000000000014266021275011541 5ustar liggesusersbbmle/R/dists.R0000755000176200001440000000447414234301363013020 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) } dnorm_n <- function(x,mean,log=FALSE) { ssq <- sum((x-mean)^2) stats::dnorm(x,mean,sd=sqrt(ssq/length(x)),log=log) } slnorm <- function(meanlog, sdlog) { list(title="Log-normal", median=exp(meanlog), mean=exp(meanlog+sdlog^2/2)) } bbmle/R/update.R0000755000176200001440000000266214234301363013151 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.R0000755000176200001440000001315414234577047013343 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 (inherits(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/predict.R0000755000176200001440000001070614234577700013331 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) form <- try(as.formula(object@call$minuslogl)) if (inherits(form, "try-error") || !inherits(form, "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/IC.R0000755000176200001440000002324214234577121012166 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(round(x$df,1)) if (!is.null(x$weight)) chtab[,"weight"] <- format.pval(x$weight,eps=min.weight, digits=2) print(chtab,quote=FALSE) } as.data.frame.ICtab <- function(x, row.names = NULL, optional = FALSE, ...){ attr(x,"class") <- "data.frame" as.data.frame(x, row.names = row.names, optional = optional) } 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 obj ects") if (length(nobs)==0) stop("must specify nobs") nobs <- nobs[1] logLiks <- sapply(L, logLik)/dispersion df <- sapply(L,attr,"df")+1 ## add one for scale parameter val <- -2*logLiks+k*df+k*df*(df+1)/(nobs-df-1) data.frame(AICc=val,df=df) } else { df <- attr(object,"df") c(-2*logLik(object)/dispersion+k*df+k*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, function(x) inherits(x, "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/mle.R0000755000176200001440000007742414234301363012454 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) ## remove intercept-only models not.int.only <- models!="1" parameters <- parameters[not.int.only] vars <- vars[not.int.only] 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() ## model matrices 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 ## RHS only 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, namedrop_args=TRUE, ...) { 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) call$start <- eval.parent(call$start) 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) } call$fixed <- eval.parent(call$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:",paste(setdiff(nfix,nfull),collapse=", ")) } 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 ... if (namedrop_args) args <- namedrop(args) do.call("minuslogl", 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 (inherits(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 } ## Prevent unpleasant/unintended collapses of ## names from named (length-1) vectors within named lists, i.e. ## unlist(list(a=c(a=1))); drop names from length-1 components, ## make vector names 1:length(x) 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) } return(y) } bbmle/R/mle2-class.R0000755000176200001440000000250714234301363013627 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/R/mle2-methods.R0000755000176200001440000001410514266021275014170 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/slice.R0000755000176200001440000003061114234301363012761 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, fun_args=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 <- vapply(tvec, function(t) { do.call(fun,c(list(mkpar(params,t,i)),fun_args)) }, numeric(1)) 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/TMB.R0000644000176200001440000000065714234301363012310 0ustar liggesusers## STUB: starting to play with/think about TMB back-end form <- quote({ A <- exp(-alpha*t) }) recruits ~ dnorm(settlers*A/(1+(beta*settlers*(1-A)/alpha)), sd) TMB_mle2_function <- function(formula, parameters, links, start, parnames, data=NULL) { ## find symbols } bbmle/R/profile.R0000755000176200001440000004623014234301363013326 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 <- !inherits(class(bsp),"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 (inherits(t1,"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/impsamp.R0000644000176200001440000001620414234301363013327 0ustar liggesusers#' generate population prediction sample from parameters #' #' This [EXPERIMENTAL] function combines several sampling tricks to compute a version of an importance sample (based on flat priors) for the parameters. #' #' @param object a fitted \code{mle2} object #' @param n number of samples to return #' @param n_imp number of total samples from which to draw, if doing importance sampling #' @param return_wts return a column giving the weights of the samples, for use in weighted summaries? #' @param impsamp subsample values (with replacement) based on their weights? #' @param PDify use Gill and King generalized-inverse procedure to correct non-positive-definite variance-covariance matrix if necessary? #' @param PDmethod method for fixing non-positive-definite covariance matrices #' @param rmvnorm_method package to use for generating MVN samples #' @param Sigma covariance matrix for sampling #' @param tol tolerance for detecting small eigenvalues #' @param fix_params parameters to fix (in addition to parameters that were fixed during estimation) #' @param return_all return a matrix including all values, and weights (rather than taking a sample) #' @param ... additional parameters to pass to the negative log-likelihood function #' @export #' @references Gill, Jeff, and Gary King. "What to Do When Your Hessian Is Not Invertible: Alternatives to Model Respecification in Nonlinear Estimation." Sociological Methods & Research 33, no. 1 (2004): 54-87. #' Lande, Russ and Steinar Engen and Bernt-Erik Saether, Stochastic Population Dynamics in Ecology and Conservation. Oxford University Press, 2003. pop_pred_samp <- function(object, n=1000, n_imp=n*10, return_wts=FALSE, impsamp=FALSE, PDify=FALSE, PDmethod=NULL, Sigma=vcov(object), tol = 1e-6, return_all=FALSE, rmvnorm_method=c("mvtnorm","MASS"), fix_params=NULL, ...) { rmvnorm_method <- match.arg(rmvnorm_method) min_eval <- function(x) { ev <- eigen(x,only.values=TRUE)$values if (is.complex(ev)) { print(x) print(ev) stop("covariance matrix with complex eigenvalues (!)") } min(ev) } ## extract var-cov, cc_full <- object@fullcoef ## full parameters cc <- object@coef ## varying parameters only keep_params <- !names(cc) %in% fix_params cc <- cc[keep_params] Sigma <- Sigma[keep_params,keep_params] fixed_pars <- setdiff(names(object@fullcoef),names(cc)) res <- matrix(NA,nrow=n,ncol=length(cc_full), dimnames=list(NULL,names(cc_full))) if (any(is.na(cc))) return(res) ## bail out if coefs are NA ## try to fix bad covariance matrices bad_vcov <- any(is.na(Sigma)) if (!bad_vcov) { min_eig <- min_eval(Sigma) } else { min_eig <- NA } if (is.na(min_eig) || any(min_eig0) { for (p in fixed_pars) { res[,p] <- object@fullcoef[p] } } if (!(impsamp || return_wts)) return(res) ## done ## compute MV sampling probabilities mv_wts <- mvtnorm::dmvnorm(mv_vals,mean=cc,sigma=Sigma,log=TRUE) if (all(is.na(mv_wts)) && length(mv_wts)==1) { ## work around emdbook bug mv_wts <- rep(NA,length(mv_vals)) warning("can't compute MV sampling probabilities") } ## compute **log**-likelihoods of each sample point (Lfun is negative LL) Lfun <- function(x) -1*do.call(object@minuslogl,c(list(x),list(...))) L_wts0 <- apply(res,1,Lfun) ## shift negative log-likelihoods (avoid underflow); ## find scaled likelihood L_wts <- L_wts0 - mv_wts ## subtract log samp prob L_wts <- exp(L_wts - max(L_wts,na.rm=TRUE)) L_wts <- L_wts/sum(L_wts,na.rm=TRUE) eff_samp <- 1/sum(L_wts^2,na.rm=TRUE) ## check ??? res <- cbind(res,wts=L_wts) attr(res,"eff_samp") <- eff_samp ## FIXME: warn if eff_samp is low? if (return_all) { return(cbind(res,loglik=L_wts0,mvnloglik=mv_wts)) } if (return_wts) return(res) ## do importance sampling res <- res[sample(seq(nrow(res)), size=n, prob=L_wts, replace=TRUE),] return(res) } ## ## copy (!!) dmvnorm from emdbook to avoid cyclic dependency problems ## dmvnorm <- function (x, mu, Sigma, log = FALSE, tol = 1e-06) { ## if (is.vector(x)) ## x = t(as.matrix(x)) ## n = length(mu) ## if (is.vector(mu)) { ## p <- length(mu) ## if (is.matrix(x)) { ## mu <- matrix(rep(mu, nrow(x)), ncol = p, byrow = TRUE) ## } ## } ## else { ## p <- ncol(mu) ## } ## if (!all(dim(Sigma) == c(p, p)) || nrow(x) != nrow(mu)) ## stop("incompatible arguments") ## eS <- eigen(Sigma, symmetric = TRUE) ## ev <- eS$values ## if (!all(ev >= -tol * abs(ev[1]))) ## warning("Sigma is not positive definite, trying anyway") ## z = t(x - mu) ## logdetS = try(determinant(Sigma, logarithm = TRUE)$modulus, ## silent=TRUE) ## if (inherits(logdetS,"try-error")) return(rep(NA,nrow(x))) ## attributes(logdetS) <- NULL ## iS = MASS::ginv(Sigma) ## ssq = diag(t(z) %*% iS %*% z) ## loglik = -(n * (log(2*pi)) + logdetS + ssq)/2 ## if (log) loglik else exp(loglik) ## } bbmle/MD50000644000176200001440000001356314534736023011662 0ustar liggesusers47569144439ba365fdb6048e2fc4cc1f *DESCRIPTION 6dec391a64294f51b91081c108315fbc *NAMESPACE 5dafe849b9c826ede616ad13b7579061 *R/IC.R fd11243c6638822be02086af452ff491 *R/TMB.R ae03762df3592d5e5042bbdbc287fcc3 *R/confint.R c9cc17451c8dc1829431e2eccd315188 *R/dists.R bae97cb0e5e8ae510afdc95c563bf069 *R/impsamp.R 27685625d30f9917a2f3a8348bddc258 *R/mle.R c4261cd6324f185a4c20caadde9d38ff *R/mle2-class.R 2a2bfa30b9feb9251dabf7d17f1d1246 *R/mle2-methods.R a1e13c8cdf9569edc71a82ba34916a94 *R/predict.R e826fb38e19883fcd675abc903c369cf *R/profile.R bf85786fd72d16fb2d2c5606883fbb95 *R/slice.R 28b4b4a714c1beebcc7516b888e1b641 *R/update.R 5823f8cd791ae8b928578e26674be46f *TODO c3b0afd77e3ea8cab02e04fb31363b90 *build/vignette.rds a537b88c7af608ad98f46f0077afbe5f *inst/NEWS.Rd 8499ce62c1c74973d8fa07522b02548a *inst/doc/mle2.R 75d888257b1956be8c5d10786bf50296 *inst/doc/mle2.Rnw e89e3401f0fea6c80417c475578d4e4d *inst/doc/mle2.pdf 77b245c578b24599deb9b3abe90064af *inst/doc/quasi.R f87d04cedb4965bfe37e2a736e32bc6c *inst/doc/quasi.Rnw a7c72a0f210b53d29ee96b955f17a690 *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 e9bb1df9a89793755a78c27c5569d324 *man/dnorm_n.Rd 8f4ce3f14c61679b0583aada2d2c6493 *man/get.mnames.Rd c7c79c910f6210de4528dc3b43484b05 *man/mle-class.Rd e5bed8cb5e660bbacf89fae05afaccf4 *man/mle2.Rd 43212e571f06f29b0e9c1ad5af89ecc4 *man/mle2.options.Rd 5402485d416bd59d04bbf4c4ea34c999 *man/namedrop.Rd 7a0bc1dbcb08bc40ee81b7870967c1ef *man/parnames.Rd ae2229724ca9dbe67ae5a5987b802add *man/pop_pred_samp.Rd efce19f271b87e19638cb0683f7f6bd8 *man/predict-methods.Rd 2ac866f204de3b921b70591b0177e3fd *man/profile-methods.Rd 0aa7332e039cf89bca966c77dad5cbbf *man/profile.mle-class.Rd ea4640bf21b60e594d437304c3910e85 *man/relist.Rd 1680ed5aa15f95ace1fa0e974429b992 *man/sbinom.Rd 02a87bedc8f96271042679fd030835df *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 f86447828516944ac46d328a683e942d *tests/ICtab.R 9ef41040367d85e5ad53005a9ab7a344 *tests/ICtab.Rout.save 7e791632cd72a0dab72b6b1059b85273 *tests/RUnit-tests.R 202d16aa2bf77be5df020bda2240703e *tests/binomtest1.R 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 8c10d8f83270b24113542308e425aa88 *tests/formulatest.R 65a5851deea834686946c5cb9bb2190d *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 ca13c9ac4bb27532625deb31220e380d *tests/impsamp.R 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 1045586acc4023507cfed80e00c36975 *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 9d913ea0f3c92a4675b1822090783805 *tests/parscale.Rout.save adf07c6ff92b4ae6f8ece745a93b1522 *tests/predict.R df6f12096d996324b2d19467b9905892 *tests/predict.Rout.save a714b957cfd9a8f6148160ae18c56472 *tests/prof_newmin.R 0b52fc583dc02c9c422cb878ba3d6128 *tests/prof_spec.R b35e74c78c0da7320fe8d02e4b2ccaa6 *tests/profbound.R b26f0b1739a56b3d2121bb6075c758d3 *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 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 d3ed098f4e626138cb1cc68a36e8fbd2 *tests/update.Rout.save 0a27805bbe6b6d67ef37f760dc991917 *vignettes/cc-attrib-nc.png cd2df3f6f14e5d0af434d1aa53b7a0ed *vignettes/chicago.bst 75d888257b1956be8c5d10786bf50296 *vignettes/mle2.Rnw ae21998f0dafa40e30841d4abc02ceed *vignettes/mle2.bib f87d04cedb4965bfe37e2a736e32bc6c *vignettes/quasi.Rnw bbmle/inst/0000755000176200001440000000000014534716741012324 5ustar liggesusersbbmle/inst/doc/0000755000176200001440000000000014534725252013066 5ustar liggesusersbbmle/inst/doc/mle2.Rnw0000755000176200001440000007626414534722240014431 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,bookmarks=true]{hyperref} \hypersetup{linkcolor=purple,urlcolor=blue,citecolor=gray} \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): <>= suppressWarnings( 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): <>= suppressWarnings( 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: <>= X <- model.matrix(~dilution, data = orob1) 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)) } @ % Would like to show an intermediate example that does plogis(X %*% beta) % explicitly but argument processing is messed up for list-like parameters ... % sigh ... 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, show.points = TRUE) @ What does the profile for $\sigma$ look like? <>= ## not working? ## plot(p2b,which="sigma",plot.confstr=TRUE, show.points=TRUE) par(las = 1, bty = "l") with(p2b@profile$sigma, plot(par.vals[,"sigma"], abs(z), type = "b")) @ 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> stream xZ[oܺ~h M7$' \'9FFc?3Jȉ((j8|3 ýǽW'g'g/eꉘIjr$a"^$BR].O&+zMo]#SŴiuE@t3 S@V5@FҔq/jzsSOġA$Y^ X<38 /~)ψL5L/"H4D\&kmSTgj |+_.> Bү] 4 :c}GX5s(^HF1Q߂#I>M^<žW\!bR)EGόVEݴԳ͊7yC`A86ϛ8u6>7YZ/UMm:4u6q({f"q.BR1Мΰ01~y #Hȉ9C-jP-#^Rc mСjhRڝHM@y|Yw{),aƲum1:YU" <V p ۦ躦agSi࿤=Dr>}BerٕCϵS#q|[ 9O;Τ l*G1nsYME-wJq>Ax"(l$ߺ4ANgw nQ~@8~;gcslT쐌/:1B՝#w _;{I$}3{$Pޯ<|%zlO IT3I m=[A>i'MBR(= ?/ro 1{,K_Q{&ʣN\#@cBqOՃEU%;߽:"d4af$U>BanW=*ߍ)8 M~GNКX#$aA 8C?$=_QvmN+(S yMy!r[ïRijIXy6++3d/ʒyCwfKБci!I9JSM'uM?3sZ~aȨLbR|jT8WA6+Q k*ʚNcW5E,{ h^~8`M]?UBfSB^/ɦ4~HѺ]kk\Ҟpϡks״АS{H .|~kW{C.Ӊ9rx&+W z~~wΣޯXYAlD Wgg~Ph+X պ:ӂG\&,^ ¤iT[kzH_’ǣ[֎mamk9wE-R)bwPr G&HEpeJTqdˁbmϒtSⱫjPALYh Dlzznzj䥡ဗBFP_᯻)2ǃ;B*ҬEQp  V{2k6tK`{`If5FHcI&+uf/f.&w2w>]y!Uq? T&;D]9z9Ҍ2+ c1^e ^ڧf~"E~H8eY!芪9vE0e># g7;1_7o^j4tgF`,`f: $ȵL] u~=P3t-LIUҜcY__^_[>tUfܬTX;BX8t5eHS9.{:!-P1 dyvk endstream endobj 4 0 obj << /Type /XObject /Subtype /Image /Width 88 /Height 31 /BitsPerComponent 8 /ColorSpace /DeviceRGB /SMask 25 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 25 0 obj << /Type /XObject /Subtype /Image /Width 88 /Height 31 /BitsPerComponent 8 /ColorSpace /DeviceGray /Length 34 /Filter /FlateDecode >> stream x!04mO [MNTx>]Ě endstream endobj 28 0 obj << /Length 1570 /Filter /FlateDecode >> stream x\o6_!/v%1X6Pkx@-;Jra,/RT("Qx<ޏ;ňYkt񨯗a~0HX**#R`a丆M(1&ё3K 7H}cvtQK[ Mˆ\m֜U"p>:zwn1C6F3C 1 q=xfhrqĺ|9&B`M}]D.xD?T?Oӯg^$qLRL$N⮜g&`Kn5$\fv&%@w1}s_JYU[ o t] '89+UM3/ ‡&N:ZB Zn~p^}::gl maۆU:0Q{>tW9/>FWz{=f]6Wz;uyM0a\*k"rYV/%8Eh*? 8Uw:":eO%~Y9ip0lmNL^`] íŪrMΫr8,{btY)ʿD0qʝM5ys&uD )5 &eض_p ǎ̖`\ͮIT)(rmj7p9VI$ U^fN_4(݂O)LO[|E 6شG_ܨZĜJ1u\We^T]1*`T rKZ0&dդO["!U-[ Y.!B6^iƲ_Miqh†7^HeY0"x~*;0A>tPYXzBgA c Dolz*YK)qT 7rÝޢ UwΏKd1xs-b0PS#ȶt !,,o[;Y6)Y5%Ahc ?cK]H\{9zu=o'l{.v+%qdq0pX+,]/ ^ '2Knv/zDoAAZGur9h஄{Dw*,gR9]s%idw*U+iy.P݈Ne4?ԡ$K'//uU/ZҬ%Ǚ:/Q 2B,>V5l-4lE^O$I n{3H`(0Zʨ p{ endstream endobj 33 0 obj << /Length 810 /Filter /FlateDecode >> stream xZo0_a{H6x.N"@h*$!KhT3gCQۜww8sG S&㽦.~VTh%˝$:PDrD2:Y?wBT :׵T)/g#x CRp tErvn<+ԒNz^{ǟ;XQO?ӳ`{Ktb8iH3 a~hLƴm함bt*'8HԶǜG6HIh(ܩ'g&An514[gAh`Oe6uoUݦ@z!: &$[ˁHKR k3-q4/8䧀YBqQE4d_?OiJf`(d)2˥\!E.= (#W早Vf\)sPג2? u`oHLMXysFVZ /n4W7#\R|YyJ|yy Զrc8c`ng][Q ;<05uE7Q?XYu &P0%6Kk:pݮ%^l- 2s[T26˶c [Ϫ=kk=$3w۵Ҋ9uC#j&IxS_[G0/$QTH`gn,7;mɮm endstream endobj 40 0 obj << /Length 1871 /Filter /FlateDecode >> stream x[mo6_!&1+RoT"躵H6Kgl~`$֢W/IwGJTA$y"xwlq kZ:}q``}'~=~y$.g D/0_篓A\p05m' '4 CpR"pufսmP#1iӍ.q6vkec؁9j 긐q;ht:U7:P1=D,ád2X0zx89kn$.%Ʉ؇P.wX@kn.x ʚW(ki3rH ipodPq8*ɞnmf@cu7E&6ƝP$+֫.Dx!fE}c3)ʴU ^,)?|8RI\Dq6DGj|4`d& z]>v4f'saF=X/v|'ûo` D8pu'n(<73=PV7W͖mf"Ouwnn|E/,o{ƛ#f-OqX"TLB6pwbJon 1x0-RU8\7U#iMmF@̠@<C΋}ng/,E-w̧ &Ʉዟ}_="ށʐ!Tqi^Xw{ tw#L1xF8vwl܁Bl=z2msPgPb?]&4Xs ύhúwVqVk+e}G;>ݾIolp.<؎[ɢ9K}:Π! m-ڙzfu>w%XׁM^r<~6 uUŗ#MYj2I%dfqӣ8&ۇp TO,b1Cy)f&] ly_ƶ(OXך EWsY6HNET銧وf5Ԭ#Z&ƶ7UT}7(̴[H布&n.0Gi^BDFY3LDZjX !,knt"5d 0}-SyRW ause?O5õx6G lJ7]MzB&j/4Pe#MZ;á©E9-Gk[঎4_'Wx/7ч Nmiܢ"/M endstream endobj 47 0 obj << /Length 149 /Filter /FlateDecode >> stream x3135R0P0Bc3csCB.c46K$r9yr+p{E=}JJS ]  b<]00 @0?`d=0s@f d'n.WO@.sud endstream endobj 59 0 obj << /Length1 1473 /Length2 7305 /Length3 0 /Length 8297 /Filter /FlateDecode >> stream xڍTk6 "!- CwHK   Ғҍt7HJ#gy}]7><eSA!x%Z &~~!>~~A|66vPDn7>% P #BQI1I~~ ?@ZCZ|uϦrFn HHN;p ÜnV}sW Ni{77gI ӓʇBr `"x2BB?,R,R*Ue'+t\۶`djs#N9oߒDi;?IrT=|lZ&/؋h!U$C۲=,^{ )7ݝd׎tOGni8W,_wlBBf-Zr1XuF$? oiGgZLD 3^ MWiw 9X5R8`Z}7V4IiEIiWuqbN[_A:T8tVslE&p9%]ñ}vO5wg*քK >>*Y8^yI곪+ykxri%ī*ǃe=δ2iSh4ic>wU1яK%(z ٘T DYbjFؓzDկ$>b38AQa =!jN dۄǙ洗ӓ?^~؎KF%1mE(0b2T)뒶@3^'9IAX y3i{L sz1}Ws ܛ>p#\;py[,- `yad[4uxV#ٹp'&+$ooR{RY Y0}8]L87t;vcn.Lw_ 5dMPym'-+mD#</aZR{ j"o7KeȀJ!Z_EХ94_+s.kXdMiY)X"g^揧[xN{z-<&wO8Av[f.-,ϣRnLCٲd\%U3x)¸#q^ 6%8_ `+ ?ɚ /b:}Kaq)<m{L⭇r gwB4S^:5TdR:{DQ)~D1\q\qK-IMCă~:ռ=bIu U]Ӧo*GgG%dTI`OE~,bA=\ !#_@KSjiu2-LoDUI8w:+T9m$Q2]`)g tmi .[aU':'l9\k^O*f0l5~-\:';Z"R {VrTm^]6 99B1e@ۅ+Xo_׫jhdmf׆1.m?HN{.JHK7,"X+~0k|'H̗z`(->sze}N)D}YVwDX061Q_84*͙OaGUD=KN#?qn ع~R1DMNZG6k~նutPQ 1_Ľ1 ~\"酲f֒4Xh)rImOKZqqL:*1݀&R[,,-[\ꮾģ=ݧMѶ""I,+3fᏇ(ש4YW Si39guBY^~I"tO{~;(嚑7Vj6Ϛ;$݃H<׼+9fqfmxJɨcҷcC642zF9a-H4xy 2L(㭂]73b c T mK:k=wos@TA WoB4]#N q$K<]GNc(4;*|9(~+SѲw7#ftzTpM*TS*ݻ08*6ݘqSS5oer: AD^,OCʻE1s'ByiY6nK[񣙓uTN[< ʔ\St~~Žsl0R{(XjD0wO¦:k~g@6c-jC,Ce$bA1 ΚFw/ K'|LqL6*|F y-n'ڰ.[9P@2dl؇w2}(u=Ed2B C浨G]*S6@b#oò53^(v Ws:=h4 "~_T{yG`Cn=HXR,3Mjemaf/׫O1ݲT*W~xqF?v_zHYpB*۪:2~WL=N]sZ4ZcS'j\:e:ǔ<߱cNwKUVM D*8b tA~Zx44BFذ\%{Y$a53$fZw]qh6y J|t'c&Ɉs?ݕK#S_ߐ|a4}]5w> XD 6+4Nj7 3}"1czA#yð[ٚwK6ln B!s$'w-ʘ҈& l7aJ-q7kcX77JE4T\h Uˊ#fp h(&s8'Y)ޥ_^焙[J}) cnH]r 8FqIJWH";zѦ;]Cyj-OG6Icܚ*B1|Xvoߐ{3BӺ5CJr#^7q)'b`w*K ;?K‰C ӴIe8(st۶JyF:eBnNB5Q\?Fū51Yշ B\* ~"]pOh<2j^sKhLo:XlGIݏ4zZ5$2[BW ~Su`LLeӶ#^o^` QŦklijImL5\t[GEf >ğǗ<ߠ#)em)cNV{? 31$$݀s6w X☪3VnkiTךJgҶ| z O_5/KXcK56Qf/ݭ$x \/7]1tVwBO_TΖS2&%v}R7QAA{u_0?u=x"H{iɑsokhBg'jN~"jQ>3N&yڸ݆坯%jk6d#"=aBl$0Dh/ͥffi1tfՖ@,/7G/v/3xz>cgV,,œҚQo&UssoYkT@5re\ ; Wi]9S&Z\\7}v[sVg"sE_rV%ImH%&rcaX8a_;K`}drMV*ׅNPFOmvOJy|Y\lu$va+2}MߍuꠠdNGцu`yVTІAmH:b_ԣdRGT2L`۵etE8N Ơ srnoTrDr"bCLmR&|xޟ©J(xqNތ;a6va|1n ̸ȜO@p<~tuunk5P`=;͆+kR)Eb8:AT#:̶\JtEݎM !9GdO02>2fQБzb%veݲ'OJ(C6ϫ>4-ΏȓJ:Vh@BwXrcLyBRs[AXvw~~N|!sk%p|]ܹǥvU

qHe#G# xp&eVo̪q'~eQ<^V"vVڐD&ąvy|k#{fDCW}..>]r#ܭj3eWA0|6-G$;}}zP[]Y^9u$K&E͗z(1'sod<#>Y V ?XAB"4$ja `4-$SU: n>O@; @ ׹O/A/2?q,ƛ R:$y(Bepz1ɡܓu9Pt+wl)cJD TŴk\L$s? endstream endobj 61 0 obj << /Length1 2093 /Length2 8695 /Length3 0 /Length 9942 /Filter /FlateDecode >> stream xڍTj-,CH3HIwwHw0 CKtttJ %w<|G׺wZ煕IϐGnVÐ<@%mu##~ ?/? >+ ׁjFxB0?B`eS!QpP(  K'*@m^gU!'$~s$$ĸJ*P{ B:PA@C=HwI>>^'/@N@' v" ÍhcwD` Hȧ~#T8*O7F@>Hg/@UFY~# H峇?_'DuQm(.? j 0ꀜܝVG٠@Ԥ.@8@Ԭn!jA~APAUfk Dm1P?PQ=QO<mjE}鿐/I;/# vʊF4 C:!ΌDo(DQ|3CECڝ5`{TscDE֤Р٭0~+/Kpw.=8HZ,o$cAx̂]%aL5g欲J(8E0.6-CMI-Uءk$Ke~L֙Kv փs](U|dyˉ^+Mh}eO ٷOFΗ0R 1~ډڟ]Aŏ,SƈO,vaTa}?dp26&мA=ޫ*Ak CѠn AƷ]rt؀s L=…b}1Zp>N<[r^$>g/e0M4Sʂټ0%ۥR/0I*dh^//waS%Uh6 ;WG4=Utӊg`YaY+ qr3YTJy>G 9ň\R ͘/zksG8 !QEV e^/Ⱥ(??Aؕ˓l.cY>,Mrh)4h|Y'+SDaS7=/Oχ5$}Zw'n:a֗ܽ6b,)%`vyԩiF32sԥѓ+DpS>΀Od8G z@fg'.FimW1 8PMfCbd|}Mk ;?^݅ьS};;VF;3O-f`MͫkGoW)1zUΉ;i:ȞvǫŅZ}8M +KFFe@bT{6X;_?qr0r m_wX^̀;KeG.ǙФO6:g}S,c)LBI@,+ [ҫ_0|Hb\%^'(tL>ONyMZATy-r@mM#SHHSͿʡKD>X.Ҹ=xg*J# Z4{OK~k&2N-d+S;{8Vf~oҶD}-dŇqiph?:U؋6[gy g|m޾2X#-*&}|.K,+pc%Qcj?4-{?k146Tu9u/arNBb;/5M~oK&NLQN/xWE/*8H'>$׏A yNSoNnZI?2mB'gqICϨޖ ZPH4ZZ!$/z,A>M-Mzڵv O]7h(TH#2rH#i#q;M*B@rqUr7jCNp){ԏ ّ7m= JMC-6Dqޣ?J#KOĹyP{і1~ \J#WPhs,y!.*08H͘2SmsXs.|FY8ZC7:bEǃEq}' tWK hcrWНZ1L:tG9Wl<Ơh7t2y`z ȓLĬsmm`US?QWKHI0أ & s*wSyx*{Op?KTUheehxj\t4yQhL^Tr*0H;_3 xkHWݬՄFrx=.sXI Ҩ1i]ƁWm4]7b!Κ{BE{r>)#IIԧfGO!ޥhӥfaaw ifծꙙfkiԒqn5HqI6k3dǁlevY<XSV5uI'?Y}T?Z?HhmS雮V̀i|:?s^k.O&w!/ǀmCXSvGk) aXCxC[-PcZ{{>mlOט=>.#iJkwe2N9IyKgŭ@pƒ}#1ĽfJ$raz mf}ܖYԥ| )hԻ|y]B!H4)ѕ_-Qvg(fiKMн!pԑqi$ l S=`{P^IsFw )SK0fb0A~l+K3N?ھn:)Gձ>`nIMKgT~<' X]^,\`HvݓzFhD,2RÜsc *@Z&J^ˍ&C5&dT9e9emxROvđQᖡW6s|U|b eS{]$R\)'w3^[8T:į&WTlИ-˛3f1W-l/m紥l9ɞOQ5#WV&7.AUWRY&eճ99'!>7Y*l 9Q ݷ)Xnؕ'ֱyXEy)jg˾?X_}:8bDjt5WS8F є 6$w +8^Cs.| ԾBgaQ&8ؿȕcI݆<7fjsK mmxCd >I9Q5>nfEKrދq˪;n8ە&= 4״t_h5gi\ vz|&K$Ƀ 5 kq?XuJ$VK7 )Um/$ŭCotxVTvs(qs^-7pAQc(hkCYn {";CZhLe$iPi}Uޫ[q=lu36B5@- )M ې6-q%Veyj<Ȇx%Z2;]fʄqn+BϠ[ w3Q $W[.Kk2HF;To^,>/W%4޷TVu_n :G>zN'h_mVȲt$~ZSGBN>B~\;٨聈@%*}4W_գRrʞT|%,3mrHHqf~br>^װ<.0rSt7u6ãZ}Lh6''BA1E?lrɗb^]ffC/@"S9'0&Ĥv4C0nJ("5Sf_IVI*#ҦRA@m ʺJZGٍBGliWO rl^z@Y Hd: wkӏP2W%⑵D3V){?F1ټ,ݨ[dt#xn0zo řKHۂ-stvk>kEoG"k\׆c)TޡrT}d[ ;/X[ҥD%K'aw\N VRG"2%뫅:i/ [lHQ{B-'Ly4>~uYu.*{_geR$-YΧWyysS>^. CʋxjGK{/ նz4leQ{&"pAZв!2ItxOɰtUG}ۀ|~%vΕYڀRg5ӑcëey O]ٳ~ 2St% t>N)mw^A^P&Kw\@} 0(\&ǡߛ\'~QƔhe3vд{Q VQjQJ7$J818YoՕD#̳i"j͉Z$H]^6Y0̣I}*(Bbe2x,@&LQsa +35KI;k!{Ē璖@4d(/sfD6/(l/[ [>Of}6y.zOc̵BxƮęՙ\*=@g_~|sy-K|2fס?s|46Jv6RʾDA,ܫ[>aI{uokz/xëywp`sÞ= [U)RHPQ#tc~ pKCJPr +/`mjI-n"vEN\U\`q:H5vgnv Ǝx`LVO5/OlŵdpWGZaٺbSN1n{bIƗ3M -OA9xHQN)  q7G7ci 7Or6Pe',W68E3]azio%/_"nT}7}ӀОrױ:d?16ֲw; [ hDRW1h#|$Fu7/u{ΌK\-^=\pSj~e7pH&YA=vP/^d Md- b7f 6Cd2&ۉ<"C讏m 賳goz;xŻoV>CNGm\_@zf'L5>5"0»ԖrenUFJ))N'q3WXMϪ ^>ƫIKZ pm&R^as]sRjx\*-@]n9 Ix(FQXHoK>[,$aݪ tLGQ/5C<*r>RU<Mіnca,He4v䪭 w8DL j]ZrJE T5&d #Bu1M^.~_!Y&]OnY|Ęύ[ϨeߴHm\q'`H ω8w|m+CKsK"i^:%LF\Kc\~'257c~_wYB\ R؂ǿ9p 16U?:@~µFCcdo J;#{P8RP}Z p2J$g0{bR ZiB[ٽB2^\n Ow$v b"nYCyrHmUvǼEfH+%4%K, /j'pSP#ѯ&_V%p;˛n`9"t^\A'ðX;#^ Qi|2yʹ9*lk̇ # MKd;کhh툡T-nj,)K$nʲ8+I .Y@2ecSlۑ{XVkO%pP3i~v `1USdN1WV*bD1^3{?ٷ2܈iHMkY@YQUջW'|5.p *܀8Z~|egPmUbB,ΡBmO+CH3NhRS?$Q!qLxn[ d}{{F¬ Qѧ wil/l۫DZ[hߋR<`W>nʻ63mUv\1ѳ`zK$Id7ox7d?k:[Qehfi-X %vÕr3!^]+_:K ,͛Fω, s;4+{LtmR5L' XƬeVypIy,'Sؒ;卉)C3_0̮gL_6_WeS&WPP@vIeQ޷k2G,m=[Aoj=n}z[Tkݴ0*]RQq gY[䝑ljVH55x`QC b* tq[` QA \S:UHx 8VP-zjŝd{2 qڱڇgVKUi'*4=[:O54N$0.-pgmP2Q"y߀٘Ry)@`s-GSs+|8ęqfO;HINhks?SrWy>~kB; endstream endobj 63 0 obj << /Length1 1423 /Length2 6384 /Length3 0 /Length 7355 /Filter /FlateDecode >> stream xڍwT6 Et{U@HBPD:HHUJE*M)t"EEE{oed3g~wm"l5PHX$P 0$Bms1X )U  8h`}w8y?-r0`PIx7 `  keg o+Zܳ63**(O@HDĤ?܆ H{gB,fS7ӭ@  V_i ^e0gcExQu$ eS}""_>2{b7(D)~{EKJz?],ii/Kl {|Gۿ{aS(lSmHQ2v1DigS`N*nGw}V5ء&|Y8') [ɔ`znFSu)9pSU!ɃTCR'͠4[EGc\ tU|᯼q1VirUT}ݬ/u܃VqeYĮT>#}+IeSzTk㸲e)hl}JSIE䆳5)$bͻ2Z+>:넇zMOt.xm7WP?Q|_Xw0ֿSW6샟rNXXJ;*JܡH4lwvihd,Mbݬofm0u=,&FusZUW*e= =fGTH,pk$grw>[9aAA~^ p/@ܽ40dl0`@&~vXDߓ B) i:bʠ3c~~v'+4KoW (hgx] 3HiS^kɋarT>TX=Qfl6 ͍o*, 'AWw,8ٿ04dZli` B DvZPCm$aWDmDtvɑ^(^<9ڰH;Ro#s|I<- ޲M!l]gey@u_H~8nmΓVNɀ7\Ȣ_'h2_ue;)^7i䲱"N)ۖ[;ƙ崆.(L˫VA#~37>8ҋ)DD]VM ngwh;zQA}!*RӢ ?=eۿJ4Y X!'S)jTWa-4- W 86 GH䞨 CNs]Q\Hy {f&b C@v/Y1ݽfҝp7҃I@T;]OYtgژKyHngؚu:a%C$`jDǛ6q,&Ċ8`RI剞/ޠeK-opىi~^'d,sU?7Qo!,0tN|CY^c"a$.<{Eg Qw2'GMkRĽ,t}vӾN7:mWzONwNYֶ7=s?G#1fW-e+[Hߨy=! \Dnp鞳}\"k%ޢe˹;aRnVd<SPNj|xcP֘%۾sMD75h_;==}fi ZT[laetS)Tk}NRA.c8넚%QElg,[H ;IgRS/۵rd3&n43j_H2xW{W{UDJ &sbn f*kKI rcDN]PD7f ۬Dgm.kDtP&*Ks=hi ta*lo&J[Y?JYvݼtNMw2;:޴&.\ic }QQ_ Y9']t'-}2ra)IgΧUdTH>mHp/")MnHH&2)'ȳW\0-fqgJ+jd㷤d>|S̚wZAۓ9Wdcm0?ZIU@u էZҏ_3PKs_޷$&cˮ^.?</+Wb=Qܮ& 5W%WPM?9\^ʞŊ~=WPxr 볿o"D֙*"IbݢKmGu"Dk 4ZW/Y"s_8$N#{pbfH#id. ms{"E覫G]80*!D YļPVΦ+wII#Fvգ/L x+ðkygO#j3Z"5{\LOh<=TH2AWY8@FC 1H7aU!S~lu7>蚛*bZMA˴{ ҫh(ʻ7"KtlNg=OI&>*RKjQls+ Hֶ]B@ ^ !aS4hϚҋ/ǃ$$(An“"ew_`_q[͑klznxI֣`;g 䪛\ے'P{o|eLUC~w5\-L]p~z3"k[o}Pb£[pW0 z\+@qC"!@]b.G"v~?`dmW{멢b¥/)}azTCM/S}罹&̾`;a (9Sձ)L3h*Y&06ium?&M/{|zu 7-ow Lo%X܍nH,;<+lгS 'ԽuMTW9\(^ 5S[0rNb$-w&=!> \u(3ru5)_沀Qѣ;yGNJ?G8oj ?xiktp24# WŒRχ/T"XI5m5K-vrX~^ D) [voX{5իt6ru)1 aH>~We[HT%WxWTפKZhDڅ91ךgfFלL+* [Qj2|W YIg}6zi',hOd'A"֒[Y/br@G_R 4))QU+)/> pg4ޅJU+ʘv[ = <_G\fĬoTzW:OYw^Mp8b{[~{h%St4n=7 {^%?&L,aDp+>>[B1˹By-4(%Y]/_b"ߞӆr?ɶP;?Rrq90ZD`[}nB*ig23 VLCG7ncĜ|`EUH--ˢYtc ݋I^ }^q-o }1p`(lehiE2&~ekle;6H?NQhf&_QUydlrXCnQjp&OWyS >‘fF3"O=z.8m6a#W>.ȳufN̽hyHM5!1&`+f[A2 &)ڰMPܽ{[>kHNk#݈% ENRgsɲ}.P t Wzu E~joM3^m%'ʴurxP[hbg )ȢZI#_<\ѧXh| [UpE];e+$iϢ'4ᐧSxmwS] w*hEhH~vrz-{g{`Ŏ2h 8]SU)2@ tK2fRnjjIrDؔtS*H Pd_v 8tjcW|)H_)0CH_ug;Wg>$[Z} VTS0BYMHQgqnZ^?;&L endstream endobj 65 0 obj << /Length1 2405 /Length2 19365 /Length3 0 /Length 20767 /Filter /FlateDecode >> stream xڌPA6Ƃqw n!%}NU[Tm1mMs-JRuFQ G3 `aagbaaC԰#Pj]\me 4$LAov97;+;CG>@ tEwtrO9-/w=h ڿhnjPw4'5djb%DYԀ@ww%S{ߕ1!P4m\;ZS%T2 p2,k HGq:}}33J"Ow^ࣷ{?]͵_cxGl/EwΧ`w޳Q$!ui-F-ڡ}xu+7Js+؅L8THf)raiJ;0k}X20xt7P?](#LhJ'iėA ]hb1,'ee{DL9*Q4^mPXHX7MiYG@/ мmj9iҢn7gȏ5I?jk>l{`(.XP]0(¯ p]Vݪ|GKIn:PuB N] :X&&]A!Gwc]<f` Ǩ˨UMњEª^Q09l+; :sUu61v;KS`A*ֵ@XA.8ŚpWrΤtC_(- ٤lҹ 60*t͂Zҏa:p{p`3X՟R0U%HCЩ_EQP+F@%`T]>0q\UAZ]323/Q<Ȥ8>yGRV9 ""N d¥ 4۟gX憮VVf_r B']xp] dQ\X5mqjd@eS~7^xij/ĔkΧMM;ƷM_*OTY+=l)cP>B*cC~k'S<:מ //_6dY M`~۝lyݕeJ"ɖG%J.#Ps‰Y"-u6ˎgi^A & .3X(ڼczG.͖K"1T6 a|+ז+W`inQ)(ND09 L$݋ȒV,V@;ox:Z}W*!AEćD7Џ&v>p@8cK\.v5S o|lʜ^RVbO}fN>+%Ae8{ZZy-#S(L6 -<o"_b9Wl-p0-s]:_IygR"<HauE r f'“dGI%#=KG[ީxrʄbj?/Ibb]q.\>1 *ՇcMM;6T-qbk{ue<*Ve@ o$J4QraQE>{GvhE+t:'.3/h8"~[5|z jBFW W.eWwy2(JόBBODp&M e !fuHF|Atv\NAaZ{ZhORA.^yؒ0)k&.C" ݒptw ʒ &4Ԫ*a4-%j;6'yl62ZJзM2]jKE img#9Jۑ>RheWXhы < er%jqk 4Pugʎs2,t5XiQv54`\ ɗLt}lL} ܉Mer֫HkT:|HV|>u23B >T~iUtTLrr`gEOb8E Kc'sۦֽDSn T'j{q(;$;,CFπ|;1XeFC ^p=\{-朌r\X5Ìgw>{& N;'-b ^Eqعu:qz4낶O$q})fтVr( BG:d,ch2-h՟.t{SOE֐/6աHS߀~ J&SDݼך"[bSs3ΣY7nX~O&ϋZ`>p;_G$سˑ{5F\N&ML0#GWFL Kf >2%~cs`g;X; 5jۯ'uT6m!53J^et FP.1UGSy!IMeIʗ%MCͽFOgU)Y/f;,j·xO\ZXnƹHN taxЖYaF a;O[ؒ4V,cGZ:!d:"36$ CJs$+U)y]x}VQnj* ,o)e?4{-?â~>I.`q"^=/͖u7Ct% }XνA&l,Yk5..Sjhf!T⒰9 zR:'o]HlV{-+[Ff=p0K4t0h>&na)uzSẤZȊ3a C`sy ]?GesЍ3ϭhoDHStt/?`T3LCfxF)ڸimxs2kb7'P"0G8^M!?.uKAcU '%5¨[egme&_e"s{F帻ٰffud<!Q1r){DI4(I- ǻ{y/pzvUm-ak}q*d0ߗK~ 4xwWFz x"ֈk/к&e N5!Qz ~~Wn߿`eW," NhQ/u_N?\&M(˸=H%߫[HiXx 4 ,2-,")s/VC^Sxc|QMw\Ml Vœ9jrjN$wL% X~9ܟ9ye*؉|Y&% “Np?+F3D`|nz;_n=ۘ%⃐#HӬC(f-CcVR:6CӪ:`<ů&0Urk2vzc0OǪY&z޳`F2u20ߓv$" dqΗ~8"$ Ys r,Ă>Fn=#SYݏKPXXbRcb[i(}[4eO Uۆ-/hEZDIW^ u>ETR ]jzL}`Qi ~ a3EImu"QSH 2m~9nRi>ĪP}Q WuoR-^/RUAA C lT+;Zr:98>9[+`T=Fa644fCbТ8XZ@' >*(u%OrG(lM͐l%~@lFB^(dBTaM%RG Q]6X}/), liHclKnR{5QK:6$`2vUN/,.fk4(cbw;,jFcA8P8ijN,}TwrE)S7"Svgx३$uu{.-8 KyU%^[L+h]TE{FN\1KA!QeZs(,~log?WQ ^n|5>Z"E+X_[ʱX_m p\CrLni)j&>(PT5zMeK~v** Q@]3l\:bܐ/2j.(ԅ`jYie!ZJywҢKOAc)3ڳ0oy; %6kn ,1I. ػ`/Rh̪9%./@򰒎 |¹bvk'U]f q ]ǁYA`^H/}d|9t;D"Dާjڔ A_S?g^lK'6NZuk$ky8/f۞n*8&Q܋;}g`ljI E^ >Ԏъb|´\'[/> Jb2E<(NG MPr&}6vfP⢓AiK;H(8pus;6؊gWŔ/Ė_ݽ3Nb>(BAmu( BTN̸u3 pBkyI-ef#ĢzO?4ĺKCC=i%)Ͳr =h*~oE3\Z5֐Ie;Ǻeqa0U`ֹv V+lE,o}+Am%"ַamJZ՚ůBD5ikA "n3̛6*,*' Ãjt.ő;Ίh5o2q&kn$.uv[A :tZbnF5W~ۀ! V;@#~JV"~ώ,{DtšI4= %c$鉧D~GRWL S;FVJʡ㋸q>[6,?|~o[ε-Y*CYݕ}I% h -)Fs o)0EqةZjhܱNڰuW-GWdke64K$XUaDژ>]Э3q rع^_eW~7(\e5Gku6Y!̏|ۏjh}(Ȫ}sɘ𐡩0FlC|Fd{gEezI͇ol*DDlG랧Dc-xD=[,AUb p.ǯ݈v;'C Hf!:d< ؙrOJ~u\c âkY!Ů|t/i>x< 1Ǻ{[H xK m tTqV^xO꺾jϩ[ Q{/}4O @DS}I[ӣGDqvg sx:LsFPUI;b PJT(UMSÜ.S/i^F+MGP_Oώd !v>)Qo2^KSF3\m:#(9rtiI^d dnqf,~Aٛ\!LgiI]#㵬?J OJZ6Ab<JG˅PGtӖݦyڝs, )ݸ-Q4[tqmwFW|d6._ʒR J wdmͤN:Jy#lQwz gzfr߿ÔqBs]N|wO8cCqsH@HXFD/1g{߼Y &cqN4I1G솼'Z]%ivJIiqN`"x209e{oȄ O:~ 1]C8H{==1+%>V6Axuq5[ dť $* Ei,8۽,,{2\3t#?z1=ȧj͈{ME;"VNK p)#3ͦ7:<[8={Mk}"h/Ŕvt"Ddm)b}kc ;F7n]-׬"UFE+cj?+ &#A%s=ĝ^e4N)kX䏗uv\89 ;YȩZa#XЈ9AgL | qQ O/+]K݅ü_+o/Iolw+=^U wLj%qy71ʹPhV& -yTd{` ޮ Ot 7?}5e?흏-@_[{\"*كU{Maw'jq3q(C[w ,l;D`5$hTeh^PQ}8lz9bCY*n1x++/P,t -e9޳lZʼn|Y-a!g@u#]W5.tcej鱬ʠ=1(J0F@=7`*I>M}H ~F)ur HZ!)B)xǯ_F&ŧWWI: %oMcIZS륷} &uM >u6@9 C"zBG} l@9d, KZfBHP^[:1~xYUU-n]'"Œ/O{s*mJ{GI+ \sj(sL 'Oi2Mfu[H>\EϏaUtXe]S{d[F88X$m~jX4lYt!u cAd^++.f7$8#E1@]&x')q>;Z똡N uKN6/~jp]/r7JUsQ<@P-M:62=R!([pU֚H:Ͱy@V5V~ kh%LvbC5;XQ4?fbK&hǫ"3gB!&ueʺbnhEP#-A<]`5rzT%7B Y\ yzC{^q|GܫXJEA_ ?cwEtIO* eTź)uE6;jJA<@T@}&`n2(TeXs^A>|%ZϷכfc,j0)%ڪ$!ѽ.RuqEz?jreorB6Ј 8It[QD 6=h| Ƶܒ]XEnbωYKRV@y|M̍)S9~{x"6'[sǎķ3A`sk%G@^ui$]3E[V'/T_o@65C+򗶈Wl& p)x.tblE?WIONQ\l4N j~>ރbȴiXQ_dO7a?\( !7M})fHS^ӻ K_2z*i O5KLS"Kvd:0aAϵ$-IRS8}vutUcڥGl@)0c{_;=;S~K,3$H&ElL&}cNY*Zwb7&;8Ӭ8.˒y փ&>z,k2 NA* IWe~)X ƥէ{Zrș$i᫭(a!j+>UC3 .$qI{.(,D5+XUAMw2L:<.sr\QJ5K.L'_-Y`& F@{dGhU\afd יN:mG1mp|vO鈮`vXX>eX]31;kO .{5d#).-ӓb;􏬭o۹4@ڽt VR29l{5ҟLUߛI8Oˋ8B<6 \8e८w= qs縗!zR>С>?y9h(Ӽ< ᾛ9Fy.US Uձ{GuM2)H.v@>H0 aP+ht ,+"` [7m~W_Mg9 ~D֯0?ݴsޏ=AvQK #C΀0/V??|Nk6|H$9C{LD5@B^Õj2uN#xG+U#6arag,tMŘ[h\ykiS-of>44錤E tZHӐ{{xGJؑq'v˘ Q3$p3XR^RUQ ,%BˡJ}wl8x`V'Եmۊ븦7"}ŦEEMRu a9밯lJH+x$[]q_q3Zox/DsJ,R{;N 0x̅ee~ #߸?V@ϣ `d9<׺Q?uذD#}Y|QhZ\+&"2-Hł]XsLMwxjjɦrhsDK0IEyjG秳fޛw15`/ǁ+>{e5h8 "bC8/( T#t7XC<-=Kt[F4~[:Uv9c FH!&PX:qK,;աZ۝PZPD5tLJ0=I 3`?Nnu/Rz^(oP-G ٣=dE<mES M&#e6!rSMRBntt^b݁rpF_»$CК]O%)@遘Vh@11wpw m_ lۣ5x5,Uya˕ࣆh8-'/qhPMJ^'h7ALT G`t׾?)nOb.-kB4U(yqMM?ߡ>FPD.Lv>7e-40ijJ%&Ju1r>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<:"r9HZ endstream endobj 67 0 obj << /Length1 1596 /Length2 8471 /Length3 0 /Length 9517 /Filter /FlateDecode >> stream xڍTTk6L#3H "9C 8 H7"H--H#~t l n07Hx@ ~lffC(e2E0N Tt DA ?$C78Pj`lf7w_8q?@6[v ow+ÀZ`#>-hf |+#.vq;HsG>5 Btƃ 4tz#p^<=9@M1ck6@>+lkBa@{ ɃAp0_`{7]9,7W{p;ƒE_aSpsuؿS!cs07o_ Մ; ɽ@"b@ ֑WxC_wo%/}n@& P{"@+a  'b>4sgqO/;7?ϗPOTO|@n~!>(PD (`_UqUٻ{?vOZ@/gv#(7oAʞ..l5=g=r@Z5~`. BGnk\0׭GwY7=# )`nv6_Hؠ{" W@^x^ DD(Wo$vlAb@^ۿ=>{vB?"@^.]| /_>ۿ}z?G8_8kp}_A >[Y7[Z9oRS[&Y N+|tU\w6Ne7miz?R'ڱƞ5ar~ y`ڊܥ\S_»Oŧbi$jvKKu$wQyibʇn}OϦ )؁ e/g_{tS1Q=C=%`P//[dΐw>saֿdagE%U{ڦ!C0'U"6\:;!}L6Gd XP4ra ~LuŊ2iS]kgȆC^w!O>CjG~1^.OlszعRY"375IԶ*p<%oȧ<kAN`L)jhaϭiƾ$0*#zxٌ>I2.BxUrlRxE)7H@WdéD!K^[mߔ"{c!J\T?tPHw:,3}3oY~ ލRᾗ}^тYB.}W7}/90iPEJ7,1u0*,Ah 5,c 2FL%1$>h4%^]W%z/,&]4ެ|Eǖڊ^o xT `>=O%ɓo4M$9׍c$Ֆ!sͯ6kNK? ]u+}X6Xg b)Ǯ 1h7GtZcژds')|&sAҸC_ kdf|z'B+o=9'u^+F XtU1e!h%sonB~7tOf0%͡܋ Ib9B5=_>o9 nՌ"v]*,X2?e83gl%J'*=]D0 ŸR3ޕMBYf}XIsb{n}(Nܟ}o/4:oA2h+'Ic^}U/J>P)eZgGT 1@1Fjr "AkiaHﱴ`vV2E6"ιN%^akw?8[HP~|m! 7u>hjr4Iat3,զdz5/ fv|mstR,`'ꉽYVt#辉 a% }ÙI"NjԘ!CY7 `̸wY"8wHd{l^e )҉gYIj**L`iH:cHW 6 f/R 2j"R J: rŧ 67c`B'Ig 9weF6s] 5Ղ5{~4f&;Vp +h25Jf~|-0U$~imNyĉ=M\綉w\6|{p*q `Kbc:6~<ӑ!JSL*\J\MձFOɯ˜* e OEKOrWbet>E$Q ٥RFc: \F #"3j%J5j\3!WBf=lJUr O#o+<']m+xx.qLȓfiiewD9+?1^H ~ɑsNI(# _X8ZeQf<{8Zۮ̣5Oj]"GI#1ȩ9YC/Rt3YǗxѝ|F~Tc94r(ZtkЯ?_-F{d%Ee>s osu7C]ixmXP5 luح qSi萶|I,U8Aɪhf< +}9ESymЩ,78&#ؗ" ~E;^T+ KD`$eEU;ާZVƥӌ)̺VF>FRŎ٣\d#a <0ngkfPoj~*Vg9E'97!.p"q')j6 YTv8᥇o #qeN{|mוS4-wcߟ56V\rmj!^p`gSR"uk {[@K`l*pq`y?)Ϭ"ɰ#QJƫ32tZvkbGarWا#akJĚXi4Uǽxxa`6SMzm*ϺçÎK]ClJj&䞘~BTg^sJpmiq gݬSb ) k*$h* r|Yuz~(IAHN,[` ` igƵjoƻѴޛuDS>9R7c^_vmɕ6)ÂsMJg_)m`TݥqO2K5JyOSrQs=rޣ:w (Hub ǚ'_ieEy T 11Ѩ$9_πy>Nbkźz2x'hw=v0򰰑pHAOߎ?%{X=Nx@ 9s9g #%%P7 K""փ Lh5UZ^{t{ ,}q190ƢҼ>G"3ݦ/"oJ.W`Gh%uYbwT1)=%ĝuk^ Kl+yyc% 524;|Gy>{M*\N4ji XJ1{ {T2rׄ. K ՠQ&ז{.%F $gt 'n@)g!JA]x28,5+2 Le=E eҮ%C!W}$֋wp09hp~#up= ńߘfceof-v(_ڼPoh /n,qf˓?B 9,24_[B12]{?K}Ek<j|!4g5-9HQz!&[K#kar ;鈸!#x.Fn^e7qD ʍ=%ԅU2φ?D{|n`>m/l$x-qɊ)) ήNEd.L-"gۖr@z[a0OLSHM8%G9,h=}/@۶exee)5QQ 8~k Qp*jLJhjff}^ _}: /@b-!,yUC׈!|EoNGrhWUX ߘLzkQ(ԥ8oTx2i4Vy(q$v@Z? UauW'Cdy WѷB3mnjt~s15'ci`7B#\k-B2b TC1_8dFKGMY eUG>4ztN4nimsF#ݮ^"O< 3.y \.oYDOYQ-ơ?[-l^d([A.ur< C̼ݪ0Cbkx[ܼC2ΜT$sb9 =#.jtERڑ4|+^q$v4nKu8ru*W]$3t,dI>22*\&=LOA{7^36Eϝ̢k Oi& _ÏO6q={ 1*{ꋞc@l1,Pd|u fyp2Z_[?b 89JoІ[/PMHf_88-DIlYN&rM1{l3qHVԣ C |Dg/~%ϩnp IYK4쐇cm0EwGJwmiɧK9Ma({TX .eDp^] .lJcsѝmMy4Ss֘r& k!KϤ+:( Qu<9/|lK{^{"ZQ?grOJyB r08(dY:R&,mLVJW@I.I˰)l%FwQ1!Tgҍ|&TrQWff=-fYu b"ST=AIǐonC8sSsH0:fO3ձa<*lc5n;%IiLS~L[`$!8n/Ypu^i< G u} h.:XH_PBN'N;.Ҩ/pI[zUT iCtT`b 3g $CF"yRYBhTpD|#@|#Yj<&vhPyX9چG; v(g8VЅ>ռ (f`U"?4 wc"@@ jCI2gYwtl"7=8a[D2G1\BYct`ts49闃 $^V4MJ-ޚr72\.t̛vnu^9*{ň5~7G#3؄:o)|==8,^5X6{ "9zi7^z%~4'$0'Wd]6̄}a"֪O%z_Ѿ"REUꍦX)lA1آ{e$%D>fS& ݂wtKcɧ5#E3#ጼ>XWE.v)Nu=#f'F@ͱ g׳עO.pi)J )ʯ7Q )<p-|)1ۊ<) '.nҠ5?B1j%4jѿ|9Dd9t}_aWnuhB|jO:ét]x?gX[#ޜ+87ĘRSb9#b&'?[i(zZ?%T2l,w*+4uj{3M[U_{Q؂PQmIߖǬB@&J2NԟZm)}3r0)Ynx a=d%af=hl2%.l"*A>(}G.̰g< gSZa$ Z\80 .:kI!opݙF/ݘ%tdSbi>FK<تA7So" )c#M_-af29ROUk/EF$geuR(dI8iikYspΚR[KBz:V;K:7uD +C&QMRAǼ]ӫF|y-4I_Ʒ(EPsۙ3-acwZޘY H8|A+$ SgpQsǝ6 1^Zj鋭~lDsM4YL24|.bzA-œ e0S/1znQ}yzs BOy!GE8pv!WDyb'!v/bk`t-@33"༂2 ՟t1ge/$m&p|JJ|M.w<p<4{\DҴG|`1.ˬ[ %\cGqɊ%۲#hls1oIp@~_w]`2Y\OcXvHR ak돬lx9G7^\JX O\^(5݆A=8Xsw*@y9vNp'kq@2CPmqHPP᣺Go )?7nSC{ike֜dsRoSH]H3Y߿FF7Q&,*ruW%צ +oX-@mCUd'?1b1 fҎ2DjP$ʶ$V_1Hz0QaAc1>kN< |H=nM ZG t a@O~빯&cmYzqW|[t.@q",ÎǠߒ(emȹIKՆuFnR9f9 8IA,Nx4|ԔԾ^(yѹk?t>P`)T6ାF~L1&t}xwe!$ ^ٍ|{M5 xݠ[ ]l+`ݳE%ragIn:ǘ6 endstream endobj 69 0 obj << /Length1 1570 /Length2 8722 /Length3 0 /Length 9750 /Filter /FlateDecode >> stream xڍP\[.{p ָ; %{wK]ɽ3sg[֮CC"f1JC., %u^;;+;;' &F a 4uyI)AyW;;;_' (4O'Kb@')db hnjЀ.;3+JrNn@ ʦ:cEhZk@,]Mv~p[/r /cſ p{q657;=A`+%PVdupa-~9C^MLAvf/*7HL_=gs'33wlüLY l!]Q~' rݓC^KwlZ`+PNodV@;;;/?z[-~|ix9.N@*pp,@.3/b_@qfB/ ?ΗM\_\W^鯎xX,<~n/7?翣?r`Kb_>w߱!/w7|6ߢ?o `37]?  `Y@/Yl// /\_B5&sW'_f/V=( s`֛J1bwQ)m6;tDU+ݘKR^Ma͟Z'[P jHIX4Ewla;ir]Upn{e7XQc *J0Un8ї_օ, >#k^\ 86 .$b>x[!~yF-^|ɦ4ce \bHF1¶yj. r!-L8F%8|kBBEPA+TE6$ɸ!mhV%;%#$1)rg@*Q} YQbiaTsM:êI:~Y 㹮#t[ u4W6\(μG'1t=yJ̹h>cY0xL5\.h7.+%Нi}KP?~6r4Fp.Y9 huįg.[$p ^7iП,$H[VZgvQlw!z6c^Ndfj)jbLq \4KNا:tq*X K)>֚Wr:^+d$"W]G9PY,#`ul(]v(]\-xkIFD12-tMzطgU:Gj⢹r\ jGU%A{g] rM"|vM1v8jp+f-ڗC '-hg*:bw Y苨{eq<<Vaycdd$>,L/ֆʾ]#B!ˆk_Y7 Pm9 ާ׿)0'CH~)B((<!0v~[ ={2Y2_P6-elN9.6wtqkPڄP\9t\bԶBj2,P̆Sۺ]?E8k=XهZ,wƍS>~Yr1J)*˵IwTHr>mRs%&8lxl~!0GP!SÜ :tZ!4!LBR % VBvP[3t= t(N=G"ɩ6ojsd=àꅉrB\YX>#X[[ߘRr# Ј GCbs^IZK>cuPPwKͣ~CY"-Q(LWqS8e9M4=/rnj֞ҌWIL,(v~0h/VH[TMKzWZXFI˞ml= >V`7}*įb]S;7ܝkB3g]kSnoh@'^PBI DTo9thXZFJ2ԫ .|X' xVUYQٻ/ՅzyJ 8ݢn t#Cʹ}Jf3I蝕jFAYBé'A&r=#ZAUQgE_HqRF ێg[x3uKg%d6ޢ ;7% į 㫙 DǠE75[E0X^Á!-5DI ezKDʲ nR܄ʵpirH :$cYZ2يcK"{߾ә̸5wyo3^b'? kG5#[ORl˵jEa09?T8448-NǑ- M(l7cǗzvҎ>[ 1:0VyRe@OG WI) s$=,P~tK+ 1IT. =Lɷ ҇ dIY 4)mGHVcb'%}-GEIFQ Jo*ѢY|?x}^^7w`k-n $TA] \ɪʹ0V%}f=p˵C0 ^Y~= *cޗ WUP/^b,w-F@ܙ7OR*߭֡aXF:ם_o[V}$pbQ3-l7;BxN~Q4 !R״@/EUg!mRw+*력NQfs_@dȃW 29v jMvJa(CdXsu)wGlhAjsM,wK?`p В2buprT3kl_ PlX뎃fQz?znxjػcm1`ZAz=j o@Xkh#AbJU}pjX!h~v>d7]ɻ]2$;k&g<>hgߢvK)[G߿KMݰ_ݡU!`FKKD fS~$ϵDvJWzDW2 L.8Wr@?o&[83 xsD꼄$ ]KƵN9E2q.="QTQsE"RCJ#,Xs%BP~DOA/ f_00_Gu4o& 2Ÿ+&od&YQGj)I{,3A)K"jv}nTs_{T(+DdKqf[堞لZL'=)}G2 8]7Ng"V{D'h^ì>爜} NH~s~>t-@+ZtfU%V3 \<?% a)Ο3{\W\Q߿bU{&=8;Ӥ]V#r_QV19V8Sv$^Qn/ZEmIZG5w"6%T1t>BGd& *l/n6`q௬SG0\SQ"T zY1>\곻<;0rnm[޴ƄAo0lW& 7&EnBĦ[W Pk@Uױ9ԺQ{T(Jf8bGQ҄|7Ѵ"TKBUO sa2|ZIDŽ}|iy3ѴFSuh=6g=6:#E*!T^C]XI5THVO@{݄ {j:rEbl5Ӓ&@N &.<|Z'+Uz=3wn~+շwc+%WWiTM ,bBz(V {dCʨG')p;zE܌^N;MLyf6R;nSǁbO|KEC߬ G 5cG@ՖNSKeϑsd kȴdJ,2BhSfL.O +*|)JM^M.+>Ɨwx^_(dSÆzN,FZ;qL7 رbH9~,ݓD]K2R&߀b,љt,h|֫XxTeCy[WX'J pJ*(0O<=dnk>|yIiEgռ*~^ORasW2Ft<5LY|- aȼ }8siw|6[d4I=XQ*׈cE4Gle[[Rw}l)Le^Ŷ1t:)T3!xA2V[u "PDe@"cJQZ:lو|}®LAy^Oc3)WU\N>C76 0'%2=iЫMـ-xW+7GU;ܜԽ.-"!.U4֊k'$>laW-R2g&lDXܪ{ y$%&1I0Ѣ,a%4;r?`ȾC>Ljq(ka+țۨhWV8-1ŏSÛ*e[/%1ʉteC#K||~3YbiOaȥg$Qd 2ɋDVgK'?IԍF'v$4] Y*R}NF* U2@dP$2]QI N/uj g^ 6-h0\(Wo3IyZpR~ægӅv2zxb,2t0 pCi=IZΔْ̞Õ/TP'/UaϽOƅSf L^<毪xE{K@ªW!<*L]=q#t$r7W=5-TjloTX൩oS =hKKS(揤zΚc<2!G/9.L z'LKH{6ZƒF1MCHgѲ(7y fi>29/J0Apo#mA~סj> nڒݳPEv"d:I#OcP:G Y0Q @K_ ԰2Dwѝ~F(< &AkLL[+P4^[ jMn HY*h8|POB*~~QAn|sFǖZ&S"% W%MbRZ GMMovn.2h4I Ɨۇz#+Md~a4CAbIgT3o[!R휥ی'ޥ'G99uC,gޠ^ זq#IE&2q͚bQ~@PL=>^G41~[HfST>O3M3ۨ?N"}܂s;|4_4ob|S*B6˨%sNi r#O5CN^,?h宬2q(n$N~[ي>7j՟5PY5g7u᝹3;:Lw+&uxqd؝ cxr`KwɢE={MR`YdфG_  *|-S䥬8jL ,}hgY*CdQy w72D(xF簔e.x0g}C"S+耍8,Vv0Sw$nX,;?wdNAru}9c̵i@DI`j.cr{p˅fM`a#lyہY{p`|1m5k߂t@bģW ]-@2v/Rȁ}ƛM_8PPVtt7_l|/4U0k5jns8 y_m ݌/\ɣ[ULT$PazPxx:#[>m`-N-'y$ȡ{& .}vYk#P㪬CrYÍVV,}-E3>k\RŌ熃*+Z$T!}Wҕٗ.+*#{5SA_ 5?2o:En-4ťT8mی#3}@>mB: 6[#ԣ,P^2f?1&ҎYk/r|a3acȾ!hX-dYQ \8WAk .ie2ZpNRb7'7%O ,)ޜh5<Ad!VfiOBpڷ%Y?r**ܨsȿ;ۍ Jc{ܑ-lЙܰl!=_ ȏ ?⟀Êaes z+nL endstream endobj 71 0 obj << /Length1 1788 /Length2 10690 /Length3 0 /Length 11832 /Filter /FlateDecode >> stream xڍT.wwHCqk)$HpbNq]Jqi-כ̙s{WJg۷B\C] b\€WZ|..^..tzz5 Khd̡03Up s sqxcqȘ%N ž#ɒ-$$;@4T͡@G-K_!DmP'aNNsGW83h].@+rj? @؂\kC.@L]an`+ l @ XO6_psp/߁@?--!N`/` rT8P69귡+onr09@NJ`\-]@NPWW 95Yl C]'rZºXϟgkw VnN`PQ/   @OK[u(a8Aְ~ k |o YB@01O `#71[V? SZM]SǀVIKC<>\v>.W^`a+ |Пº>_ Xjcne .BG-oGkrK}Ulks]UV 7*Ba; q W9'J*u/ Ԁ~_(؀G*K{إ * li`K{F C|nZ=`0 \p- 8UF\No+CN0m`Ro% vpy60-^& ’qem|a ':L@k?R2o1iF *˿ ,3A_YAX@X.$K7Xb?F?\ h4 m`ߙBv\R*ywuKBrJxkf۝i6iC*4Jv]gA-]Jn+a;31FA%yHiT,?=qf/.L=(ų󼿙^q&{Af@Jx?Gz/EdhupѳE&-uc'W>ɽ e$N-k"4uU'n3}GRuZK/i?H.:$@G|#Α3,'_jwnıwn'xrfW#`˖{C{ |)~Rg_~t>CDZco )%^.FT~sgRl&wK@K+wzQtI]6]$ƾ0>;6'3?#/TLz592$ƕwESmF,=|nO?)ImmO`)zI-D!#g+ޯbPY\fqz#/Z|亸xeJBPsc]-ʊ8ty3&Rd e}fh} 'fub-Rqc2obX֯?-n98zĮ7f3d%&/ ıwcb"}D9<,e 2Vif-<=Ħ}W:ןdጅ잍p$̡ȝjd>׉~Y`Vxʝ pN v1\R촣|N463Ja?U+'ɵ<Č~88L mL'[@>zNSꮑoAtQ ÿ^ڔxT#LE5ڬ2qʈ8!&1W0ӑuIsrkYAɮH·_ū }{kEw#۞Fݢcɱ}ecխ $s o{[y,Md0ym=mi״׷iȖak1l-1"Y\Uv*#ҫTOd.r1t\Kśq:%C h"xF?WxI؁T#]c`?xhgҩ|0 31 }onB=n3u=R gLyiaQlhLH}CǴfdJm/1uO߾bD y0=|vœw-'=UadgڡSKS0q@ "ҍL4FFB$³OR|DP|g,/S׊N4vfx93gdԇ?U*)0ՈK41՘ckF R TK1"BAk҇uu5a8M4טfo0$E eވb!ѿٚKl=HECV2 h+u5*uUoqxo0i*;ߘО_1}m+keCE΀+ͨ[@{jv>:m| #j 647*q<5RlN!GCn=H o#(ƛɆ-¹|gcШDBFͣ nǡXN^XYIT&&MC $.ĆͲH١ vކ= -M蓢C+Vos}ФƫEBn#XXU~-RW71G=S};օʔ r;yWjQvfv5+@2+d{P۹{.|vE'nx]>Ohz *TZ=UmDdjRtq#Z7wbKŤ0DTgaD%,[m3Q4kH^¼Vvq_th,ʗ*0! uKtDt\7;ڒsÉcE;4ѫX7/V#g,*0Bttuёt( +<ȸӌ7o-<5̬x`]$F{mXPh2BQtNnIGAqMpCpVw. )rAN\{q.p]Je?uIJ\[1{L͡W[RZ 0[up`M]%C>Xi D‰[L b.vКEz0٨ "=\PFE)z;d'Rу8(SdmR&UۣmR7j}]оQduF=ݲSvd&&"1t-e/Jc7Po(TM|'].y[b5pK^ϭ|GX%\sKd@LHZިI;6qʾj:]>s#ofl|Z^UZ>31mݱޘb>6 cWb3EkXB"/w?|bzQʏ닶I{Ml!ɜk}}܀cu@-b6/ W[mN7s1QSj7.*iJL{Z}Gcb($֫=P,pd0_ͩ(:txT7sYVGpr-oNP&Q~ojG4q9.F]C@e `LxXҖvG|,CjԂ&y׬3QuG!Ͳl4/Vʬh)?yP1̖풳[Mxmgs/S&FEh$yV?*3 q1-G>N4xzdo:ce@͞175=YOh}Ҿ,;Uiir4!uQguHbFFPq_qʼ҆X;u2*ϝAXޓ݅vlw(lasB{^j P,U Ob,MdNEZ1:7( ,QFsܵ>CM3 C㭫ۆuN5lZzy%H(S r~{O7K.}_]z-S?h5_9}*)-N{UvMB;`uCRraޕBѷހ1ȠЖ_{O*g">Dp̌LWDCkY-TK˘dM>;/{x2NYEwH>+,j~Q)}QB8lw5<4 [.z*., vxA9UL`u+ q|HZ~#2<‡[|)&p_291û=>_y_ߤiռٚ㣠K:ɼ,%Ɉ콳\%"vO$|s ؇?psCΪVSse˝V5=ϫ%PkҜU&;2<_iJmh*osZށl;3D@N΍|?-c1ny+u&n?&CgUrמhTdVq^˩fݡKn_KpKn3٭[s %19ql9 kqmzf肏/I4di֙\5xN2z*bwexsO8\^47[դ}rPkQ/Mәr XK9r^Lա{s<"e&Q( n~Jzj vb;8% -տP]|l"+TdaRĖ)OH4?6 iL~yd(x{~{t{d$喴l;|(9iU\[ d[/n߾j3f}IuHoc$.R!66f rUhm[=|s=iz,bY[9^(Ü>y{v.١5Vq+->jytH<]HQTWOϾA6=rɉ 2e#@;n$]M/!~"݊_2GGsK3X(ףHyZ?P𡐬D3N\7rIk{"= Zo>Kw*GD[3=Vl`D rP-iOX zg1{(`63u|LV tjqr rjr c80 #t];.YpPFbPfhQT5H܈ғO%H$ ,&IP)Tr>b6ެւ4/el2Ì)0M}k0.IX`,eR{ѐKɬ_I&Hcl?]~EZbX7@=ot šH,-66jAbRg֋ f^'Q˕iW [cˈ )ӚS󁃵eV},p1:c~(dBiG~T/nQ!.IN`uHNewUc0Pd&DNXլ.B 7K6A=[xtEapwB ?bU MãALo9Z$P`kP"Uws@[.G S2Vf~D"R~eOxijmpJrsWI&4«(b͋>YTyeȓuuɐ W. ݨ4PjN =ZGlL\y^alZA\JH*&BI|-&ݰ0E&~0z*P6!gI·yz_w5u+s+f#7b2 \^y†h1.hnOFz1,[8|%Ի2C;;|ٙ KIOmѢ~|@Z0@W=&!;JU⳺A$M)O#Unj }Mf揻G;jn ̼$AAʋ߳ͫը81JdV7Rb8P냆&'5UiކKI8MN(EZ^vxPa%2 x=?Ld@JlTSdir/`%#rk,oIJ 0le1 o"D?qңC:K3o{'㙤iό!}c@\la4ʡ)xd<+)úfu> q"cՃARL;w@bŗOY/n}h8L]6p}].8*Fڏf`RvN4(SWqb]9{N~%/W9kkك'ĔLڷ_%XȜ,jee)Ql!d9V9և30ɽ7ff$& 9cQm5 1e[oZ(m,wR\3>q0[Pռ~|x4 G=hP4]m,S*}ٹ|sW yYaM2U D<Ĕ癌8XכmH3MDyY-(ȷՋ\ɔw';UѺ7w)bj/0K nF`eD&{L%֪ mvb* L~ZH&S*/>=f!8_ݙO2,8y>v5Ud-r{N%kxP]rb)5v4<["qXי*%m{ž ЙG\vAdȏ=7*ؖ^9y'I1>c6L %D-2U7u^JLQ !D3"]~(Nx1#ĺfWKF04(l? {__~39Q,{D&sp8rIKw;tY(!u`Q38Tz{K{^Ľou[ْ7+tuܗw O F,JcF 8̪-{C=i~[Rw);'l]}>#z( Vd)Te{͂CU ~B5N]46(ya8(? Soi(k[眗`gz׎e@ڗn2:py@Enĵ>/e [U!2u+EAY(Ō_nR1d %t^B70ĩ{ \}_g'JOb@p[zA<,5XlyWyQ ̱wQ٤Hz| dCx XL&"0@¦~'\ᰖGk92_|7gEf(Ix奺)#RXf<ڕ+B,= xE,Dܞ#!Zno/0(ODJvJ>*=p{YMRw7@\T++3Byߤ8t/K Pӎ*eћpW{IoۉtfXC{3VdJs-3e +N? T+J+0_Fi>'7`лD frdѰDⱞB-D'Ls|Q;ZFiZr3K<xyܣ ўEtV166=U dj'sO р/5-3 dCLhcg )q3Zc\Q(gnf WG7+zq7B#?[#lUpW= *ͅ}?r?&LA1G1$2=ݝ7vc^][u& 踠R>\z1mviE*O`S8DG_WX) f>We#By1sKDVmZrOKPrE_`GXG0eBSp_)\m)WrQKqg2Ԩ&ӗ _8~ )R$9g{*D>ˎ ԉN"zVeHE˓ͻ,tDJܽl?P-t _xKLU=q.:3;E`)4G)o|{ 7ژq~'ψU}^6IJ"Aby:5{:gh)`)H;lh'p[-B3c]̊ bA׆.J=?w+CB7Ց5#Q-_f~!*V~:RjB$&y*3n\,# 9ZB2\]iG@b>@&Xzn}ۢp͆[djgu%B~&w.{HTkIPwL FKIgWyp [@mgKAOk(񺲌Y67Cnk(ὪwL5*!+"5ͪ٬1͂|YW3t_wJ:lLyzּ'+8`mdez} ~7ؗW5h}S7y_?V cV-x}jArv|ЍOE5J'l N! endstream endobj 73 0 obj << /Length1 1426 /Length2 6287 /Length3 0 /Length 7261 /Filter /FlateDecode >> stream xڍxT6E4Ћ.H !@H{tAzޥ H/R(]A{oe<3{f3;Yag7WGAԐ4?P@Hcd  p8) C"1 ! pPJH &"ݤ* =@Gؕn0G4f\`nPJJ;@ `\hWiAAOOO J bU2@S;`=An ⎰04z_d|? @0ogtq!aԴ^h>aaS LC`h U0cVE+#]\ 4W~*07sނ@z"|^Aa{2]MM? Do IQޮ0_W+)B0D(vs+" `v107R#? @_OV#pXPDSS]O2*)!R~)q!HHGj"H_b=hπpKQ.o?cހgvWU;\`p? rј)AbfT3_U L"h~_8 `ǿTnk0Da0^BBe s0m`f"H_&,&0Ƭ@TC~ (@1.L(ҍWcBA;7@ѿl`?_m?ab0Y}@ ^0,*F(jgtEs_Gm,JUwF"&xy= ^NCc+}?v0#%ң) l-q-9S.%zD6_~.Dm>OYqO,XVoYfk_a?ş)}^M@QVoxU%ܑA:ꤜM(,%SDV"e[mI" 6!ds{m6 iNvIgSb:80:u%g؋"֟'e%Reᒃ_(Ù]GfS8,N#UMAl5i\JdJ'C84PmDCBHZ)صd{CQwzxQ (DM򇇾zo]_v73GYG4SX$̾-0W=Ծ^nURH%zMQ pv!IO/t2f>=*lI>t=~WQ6#%ZqH8h0: 兎ݿ[g,G~4lUA>+ *gѼjՏ; )~ڠd2~tWWy[B9}yo OjpcI/J)tbiO՚LˢOaPSd]Gk^|Oӻ2OsjeG Tt>bޘE;ia:_cHDG:`×;H3C|& T<׷.\Ȣ,qzHd 36׬jÉZT yt'[gnfWH}Y3@YzVG]W0 wK@:YBnHj:Ihk۠82E;RHb;i0u‹dCm k '7 |33הRGv/^,䢄k56/_*X%Sj9C>Њu֓Y0gH.}T}L{&T1" E#d[;&OGVԄ&T GXX`ښ5w 1j嗅U#|Kwk,h"ELq%YR:aUfBx;kY (oBt,鍫20h1^?qַD,|0nU&dS`h,dK~{Op$O֋)7~['hg1p=ٝp&~-ST0mk`cYʙ؛"A#U^e: ʼnn3!}hfU!G]Y=ȓe6mTRW{?KIX{7 0j8~N;S&]|8Υ$+bA_~C&?q\`"mا~5\-_WbK+!ZP3*e<}ꬾ#:b;t>|{D`'*CXqp50*|Ӗ4vL*8 5SS)K(wby:/Fa>rK&X&zB؄Wúnߎ9ޔ*v6Ί m0uJ䭃0]q֬R>xmIx%H&tY'Hj}SJ/V|vW_{5*qDȓ+=9ilDp,ؽtȯ4_+r98j7}X&x^ [bfuV!$< >Ĺ)ICbkFt{~$noG{uvV3.2vӦRjO5YI!w,7t nzEJr),,$?3a:i0Ev璣iXaY'$~띅rާ`Ҫޜ.{&R,6%68uV2HKG_;YF=_P=a a}Lkg%Ǻ ɳshԹ[stCrnUDHkW5zgj&#=:ǙٙJt mο&oS5KS89!4.ܠyh\RjA SwMJUHBR\hrܟv9ZIy񕓇y >l | w8z?uuz-o9y KsjūT[9@u=蠧g,ǐw9; "`nr+r4ҝYY,v ^\exCnt5@*<5 z(p8 y(Օg,Y좆[::D ua$<8ϔW>b5j?Dy&Ѡ[ks?*7y^\Mk,"}ʢ"A)/TzJg`Үqp&eɟ }틌,g B W-4) km͞Yt|DJg4TL]'[dBz"ONյt-q5mv i|77oޟN{{|V {~&>Yb 5]agh@BY NNI֒o2#ft2Tw3d”&ߌ.1L_Քc1.jB᜚Xm M4y*YuL[Z[:g=N3ϠVloQ;{74_?C&>uWr] {-0!:I௨P/w,o=/>? BQVR5UVd3Ad+4ܗB`,vfG.-!2=ï&+0 zƼdnI~5ǧ.'ZtI x~՘U[;zIQ./oZvNd u;L3dXE9OZ.a#g9.yHBix:LQf(HܲžM2JʧYN)+ǂ7G*9)ѤAW}RWs%mvJ`@.^y!(ԉy䦦ڦ||"xIXŲc\مsQAYy5g/L49d=MJ^]F;-ޑGgc64OU='̴:uiy&Iwk+ynۻx"{z'i?z"])O3Y2UI#9IUfw;(<_"dmW"GH]; iEst:Fvn~)jO:u\{8V1v]7v*lvO {k,sj,S(dI Y&A7{F>o[=1Uu$l&%M/kO5#+[#{XK?|I#֎qÎM]=p^r=@#_ט _{_Mb}#rot߱VC;X.|˓Ffo'=Ts6,[Sӳ:\:\OlE#̳f"ZU(EkY$zbw?j\2?wYz߿&,qMm^)UNӺRyBEP~hIe퓂f ϛ;՚8HX6TSF#elq=~]6[@cXMV*üc^I4m^۳֋W{}ɳl`X-Wo,\aԆER )j }{+IY8Z"gR q:7vabf˧wg3}Zj. K{ɼlލ2'tXAkZ>tc6/hTw!S:HJn*AӏS& “rCwoRXɺ Z]}L*n>v?\y???N#+qŝ7;|baT˷1$V @.+:Th1G-sÍnGt}\|*ϲzlJ{^)g+hgU%5NPUIMӡ_]4oK $dUecg*fUGɜ?0Fx^ڡ~VMJ5q8a|θbY7oY_w(2hvUAGNQ\IS#@ѝHYNk7$ Fw҈Sa7x!7h_Ek[qٻ (o,;,GϡzӷN)cdj (++R-E]Q|lӒ,E5Ê|ɓ7xdžH 9g>`$T h!I>laT=} xX"iǽ^U"L3g]8|y;N0 C`$H rqRZ܆ o{ᐬZwG'<~Vt(JO2:HwN#nMC[Z9/n2~, gZX*p˝[lT endstream endobj 75 0 obj << /Length1 2597 /Length2 18465 /Length3 0 /Length 19970 /Filter /FlateDecode >> stream xڌPN(Nqwwwwhq/VݥP)ZI^{uޙs&3$%%:)Pޕ `aagbaaCKG:%! 4q$L\97[+;_Ag>;s Q;8z9,\~@cF `fK jtM\v`f&u3LX:13{xx0ع098[ 2<@V5 h2@wjLH +&@` 2ڻÚw@ha0.sk6K do R L {߂&.`}w)XMRpb rtuarΑp%.H9ub6>E {si92kڃ܀ˀIHh@W' ;zY1v `Nߐ|\L܁Wg7ϿXY 3W)d:  g+O 3w#WEutEN'dpr׊ ()koO*7`'-%4= 'aKߌ:7")7[ۿ4؁lϭ+x`EY\E9re]M joiO!A.R O Yق*.ߗx2_Hw=Jڛ9^26N. x89>m4z5f&{W wK8s `x/Y `̲YT6 M Y{Pj؟`iAX p,8/gm@f g37l\3\Al1v`2u616-01q9؂)vv=A@vp&G'l0)oxs/nc̷T[՟L=rKL #w_\?s`{kW+N-{ص;gO`be' ~O9Xo99O8EtuWoN܀.ݎ"Mtp]@? +8?8#Z w?\7['+gvrkVEqp؆ۿ {kڞ`^zcn3=o%@' im?sh](v&-Ϛs4-_ic{47">gm)OFIjsH83g CĈD"NZA6m=rNnP=G~gӌ}THY`a Ε'̼ͯWR$z$8m%Ol.zx7sT>br+>奱[+Yh &H}'zȾ+b:JORu40 ;}v<{Go!%]Z:hx8xLoss{v#.".Fئs"C^b zsCO* 7HiYho)ǒnrG0@|G?.[^&QmL,)f Y7=OPoR*މ}1:R83,x4xgILX,fQCI@kK6Q V .₈HBɩi8Y~_phxV6-Jչ8bOc׵R–jY QS *h Jo*w'R gN-z{~ ҦOZ8ȡl:h_'%SN3Yf2z_!mڴ?3<H[PlYk]9ԭ:@er>x)‡EחK()sm,](ױ:Eh\_T1#>$-ߟ 6/?4f/e'J℗phpn(>*fL|zHWFrŭsKlgNA:"Q+ R&kq㻛9n@zǃlcEV?[Msw^ֈ(̇K)*a(a9Q|AWsgpUo%]3?rN 'l.<fŠŇ`u$ܘ:MlcMu o,A+ e(,e&!uN(a.c,[osi~^+{H:n/&ާsD'Q-LYHzRVޞrFJ[wv--a'z=MDFy~拟GX.8I98*},W~@4:' c?Mx 1uߕ|Z4$aX}22A{˧V+-[̝c , 'q{?W:g>MW^ʼE$umc|)7 a+{uF<-M%<òzqKll|y-,- mO|: (-R"q,tέynv05 _Aaߪ65}Tu|Uk"S u#Kfek <7{|rQ'3"o@Qm"gp4vnoE2nԉFX-۵8^gSZarL}G~uqiվpM( P)O|$157گ:70|c{Rb$rj4\t8rt!ij+R}7lAnAK# x)JV9C6(gS< A塚f3ABEQ`(Zһu1H[`uLQklU(0Oh;m^ ^7I6N쩏OL0Ƴ~E6ĉ yc\n#Pk G %8]!|T8CJЯ=Sѧߍ/3n^oAAށ3cܪ$ՙg%hK?@q}G2#L6wfNAƷh3$QBϕCo݊ELCcAfÛ_0{PȞa&' a ;Х3-[ჍƹI0@S4ѰcmiQ&o*)v*ѩN'!oOu)3].𦶛ѯ\eR46ğgViNA<X^-b Ψ>͟(RwC~t7!t1o0*\] qr!͚;9V[?l1ċUD{.=|3&ڢYBxHPn[r$)2ؐ<;-8ogg|:><by6.}a}3nIHT򤍽/2)}piKusTͧ =]5[@Y %ʻ}rWZW9<罬}pXq*6 %1-T{Ctfa2U,`iwĩ[+?#~pepf$YhϹ$x=||3iEvh\|Ga6z r_c,ƍ3hhn߶nD ]k*E 7IzF[ľqS..FЗ?W;yn<4y C@Ur'N pLz 6aRϑWCo!?ow&yKr҆_U'ϔ)xBE[f߃,mљ[zC 5I4\{X =-S gϤ$  N M-sڊekC;-¾ bSTz6Rbeg'i&2B0sG5^*?מcI]1ڽ< JxkOtPy1}>$YIۥ;53}ks!7m(U"w muISILHtɜg]$:\_|D7v9(dMԥ0=XmX΀*|3M,1< E^ɔ9"IM=Wuwg ._ٓу fD/G:zm^&ٝ")X|_]1%T[>hu)(L{܅ѕ2O>'0Ut|~PRP @A)Mx,TN:$Eu(tz(ؿD]P4dIG-7³lf8ܑ= Ǯ>!YlJ1s(^7+}^M]8׭E.WX^5sC u3;T¿Z4zzfLzp$0//4IFÉFi`:BtX}[|1g{cgmP%M]K3,GaԉNAycw5y bJekP92͞N\84j^l]EG+wq_2%v[9)Z i!ͺL!Ѳ۠ ^GPm(a^;;qp&;^l|kl0ҽAp|tqn_z;{_vf&wGԭY4pH'j!}3D++{eMo 'oeݏ}tz2E gC3 . Y ^Py}쓬:H|ǰ<,(û7T|qWdj6"\<+lLtzx_"!\lb_y ƺA,2`<ֿJl&i0KSF.;{uZzKr$(R~ZS?Q5smtqgAA6̢ vt*4(-W]Z<xڶ̟elI\s eKy~HDx5@A75C[L=Lնry#95d0ɒ8u3%qB_Ky,$7ׅ!fQ]9oinx801+u̍~T!{9srԬuɏ&^^ZBn gJ˻-H?`HP`&kкkSs|Y$d0 4N Uڽ *RW(IqXv5!LH9I;Iz@03xI7Fsx}\ `0VSqӌMk]0xz2l}J id,xS׬7N|,,n;@!2X"*#Tif;mDXD?+9U4A:brۨ@:lܵsYT15Xaz̥B g >gA֫N&;.<<.?I}j+k yjbKC

ːf̞-sH+_ \h Ew_8[3{HWɆB5(*""D,l:{I W`AB6E @77)Lk@hu3-ڄ\$)i=1^}GEx]q☍QT(qz!#HQP+X5k-X]} r®1D=>K:NɈ'cydv>ybi@ Ɛ\델]Sk[}|Op;?3́TAb |5ގЫ$l(  e}j犀כP%TO [2ײ9Z?gVq"^h$*8ד#;:kfgg]%+cjMo"X@nA4su~k7^ ! x.W|PZ) {`6ȷC? åb%,Ƽ7֍ ÔN{jm*m5X6PLC:ֶ 0HeMuD -B' 1WCkTWUֵLXe\\[A5֚hbro*9*ր tG4BӲΘN1eD_ xj4C  pU 'yu\Uݷj"\pZYsڔ>lùFx !6/g0[}L^GEK4R׉cxlX8(q#dъfD>BBp 'S %$sIZF8Sb9X%c (Yo%<mt朄lFRuYn ; YI`2`~.(/maN@ޖ} f.|T"2A]irVMNN/_fY& =׃/m2~So$5ԅcŠ;@>4\S @PvH(KrD l/مv)6Hۉ? ܠKNy3eT31#P?&a^$XnNuP`~dpBLE$BZS҇) U=HK=xat`iJS2RB 2/Z~RiDT0 >aY5cqUØmcL&}y=)(k!\h*}9!Ȫxg9N!\;U^yoD~WìdC2gnjy^1=iChH)j5eR$߮x<>G}/-z_L{w^QDeE>nh8LeIitesbuȫ~»77Y=t(\{|U5VѷN"LYUrd_o |7Tj>$Oiqp}uջU+~:Ji(G_IMc߷)a c>IX(H&|Q=+VuGȧ$pyGIB͚xJکaZQ%D$-{k`G^=n5n7(SfmCl$0ۘDV<' 4}7jxjFWޱ ;G0*AcMwnmbr&f=ꇏbY \.W[FKΫsuouK`1jC ) DTf=5iI&`Bz`Sfy}U@U2M;yn4cȭES`s\PK1>Z˪iWcȡFC F,\Oje {O`U d4a/*AXmoD!͓5zJA2f;%݆{UkQly{< ȶu`;orӌIe# |ɝcp׷ D/ oY:[Fɽ-tdY5^4އϾb:U=!󄤺B"&ETXt`j,{jk ]fV&#ˎ(cݝf_t/ Fy,j룉"oA>g+q?={VfX8gA[q!7cդC7n_5M,CSyyBB6yMzk=lkϬfhsV;s;h6|m r`z1`k(]gK{-%%V?S18 0TT佹kGz|k㒥*e)77D˱Gjsbpt_YɽPФ6lD;݋}:N/MB&FmȓP\R7"M#6F< ' +ʃcB\BVnKڼ 4jF ~n`V J7ꚾYپ從6jzb[Kͧ_> JtYڣkZy >ѕFIR2uӞyEz.Q24ђao/w?e^뀁YdY/y_anWޤK|vv0!y*ft'I_G`XN@L{0f)| HfNN0I-voҡNbgWA6ynqҐư9N2t@xxṼKXMM=ɜ=U< ^FeXFzaډƅqlyBx$g}ʧ:#f\b%ÞZw%\6)$݁!Ʊ_^Myo[R殔uB=cClVA GKt3eW97|#Z=k;LڧLKf)8 _ ɪ~eIc9D&4!|r7K k+tLQ=*!0X ,oR'[K+Ϻ1/l!S|R݉Ӈ}s6sBp%:K'^zjZk^!]'qnkxμE 8­l]u;O8'|@㕹S#BY3!y>U?5x/쿪9ZpӶ~\XHyR*5~NQA%r,iP&9/4[w̷mT=rɠ]3؊ۥw^/Qy23.Q) NYЁ1|>2ٌE ZU&$zGDb=&$UFMv1k׼Y/V"ȋ+eih GbռZ ƅcZ&+iS%HDDɮϼ!'ys6o/x >=d,-0==ߡ4TI^%K T*ᾒ{?rn\y_2V{R[mSZ a7%=5jΥ$]%bfJG/iNP(H gŠәy<aiqHe 2u0[k]ۡ " -8؎ XbN p?}"S`HC އ L{a 7Z}Շ913ǖ`zYx&U "ҜW&QPU' *A^zT}ZnU;\[~1t`ecaX{ܞ 7Fxټf-\ZW%*IďfYzo=impԔWc)vr*W(єgJ$t#EIYQ@T,R4j퐛2 /Tv'h :ur:ߦ؍R^(-*#Y_i l uHC൰\< z^bphѬk$ZnPe{+wl"8eQ?,M6)DVxRn0i[]ޭ.mvvtԗ]`"csp6َEv*1GpbbO7z+\4 h5}~z> XU|GèȆ*?f1YDSbt헔Μb.O3te޺,?t Ffg ܰ&JS:۝#I91\0 COPͩ&k9{5ϸ(8.]$A>&{@ڵX^܈ }7*njI/%GqXKw10XMXxMyaeU'5;鎾gӭ z~U Q| $n32YhïdݤZJvQMh[k )D/Op*EuLoY?f㦌yҖ,MK[d-WmL/C,/DKrBᨷ'5ohc/}iUYMkDpYtPwsYyX%7BW\0.Jv(xi ө| 2*׎sIc| O`*2[`s_9KC0,!sJ\N11G96ck/9WY!hE~QG+׸n)7Fgו;F6Z4=\M=̧OX.ZPX߷;A:ds_`AN7WyKu0cWYKRwl_Ѹ7M`lr`Ң4~ɶ]^Ry;?PX˦x5Ol#cjݗxz+>U`)xJ^-$p75K t"X#|+g Cm'Dc{ 7dňf<vu5sBp& 9GixU=E鉻(| ;..2oQ&pX|g_ŎN.h&.=> A{lH zFFgɢ{䢼:uDlS=´v(v\mq`nd_4Aƃ"<Ũ4Kjq5H94ˆ"fPkDj !&U47=I2w_ 7~:4LR5~%/O%|ha,^u ŝW-VQ:vd??%%07r4WG0ӠW'֒_0~w!(LHZs @:c.B+WfNJ=5FYUo}'Ay3*y8":`юJz.jױZ(/X}&J)VBMJ WMhBG,%k7^|AtT_=syY~PU0~{9h+qwjt/~s2%qԮbGaRtuSvr~j|!'ɛg kn& [Nr[ ~uVe;ڽArPDyIq"U7:0j8 3sx%!_ÎwnךE0֜jm ;>)ObڍJ@J5$F.T)"(*zWW/X)N_Awl[P)o |YI ׂYS|E`I:&Vނ +LYY‡:Hm>rDC<(v$i#s'6-~Ni౒>|:_S2GG縰֤D0/^r%ֹ5 a{oAǪo?fޡ6F(N%d`s;A3MJ$lӶ䎑 Q/ڝ!:%RN`VVO3i}ri|"ۯM{,Lq2ki#͂[x5{X tߍ_ Ud&Ehq,LLM.O'1m\zK(b|LQ֦N,sh_w1:"$ 4]DŽ#4??~:?xE˧S8SUF#%JLRW: [ R_Y-ġucUqMm^ IGT܆M:%*bI\-ykkdDDR mĥ^6c9Bsmál?c4_Ŏ<f/e?9)|hB 2$VrRmy(`Y\ 52#/RG__9}ۉB#B`.r3.)TZ$b1L) I2mܟG_HKED\^!\P$:eԎ^{1"H>ʒWK;L2~ <{j d\k&sw# *3Q֐6 &Pr^K.B_8fر@dfuH,j֋t;\fUy5ofSl@[+5"##%YOuVC#(?dkD!YCc 3J,lDD 3 T0H"sI C͵[&PDHQ:'b#M!_6d@+囹*%VmIĉ^"Rq$ax3C 9OuiUO}pKVfuց[2%p, NTa7+e6Ѭ#rMUTRZ[mΪ,wij֏ZwsbdjI: ɨ}\#K krfF|"MTʹn/>x^mD;tF>9`;s %^|eeX5nB4C߄?JҲ9)6XZ4L75q5,5zS6"-N8{‡mSzD7Da;ιr k=~Fң^"1<69](>3¿.^M8zv3r%DVtyFN@7j]w# ~8G)64nkl1EB R+eshȖ3!@-ʗp K?/5dcKB{ED/Itfp!QyHe<ań9eAěY윇 "!r}+|6&| ]{2S<濹YoYmڅ$MrEDgRek+B!f ].Wmf{gy_g w'>M8TroɑHfT^(a^45u;J~<6 O6Q^XJ/Y'cqkxHxjVK2M5$&ݛbiʃ~qSWИ`)u&*l޺GL@>o<YɈ^j ]Bs] lU%FS< tU=֒ {Lp8FW?NF1/^1&4fqOhKI Lŭ*|,s0橮O\̺Zvj&CN D S_q!΄ ilψغR \AUK #SּKrǀRȸ?CjV; % ^ '1F&wohDhG;u^Eu&SX(3t f1ŏEn`C1";8L^u%N16Mp@#M|n YWwM!<W[V+3Qiacrj yGĐ<}k֜(PAPh KHԱG/p e(;,䙧q,_Yڸl?,4sTQ ;EN֯ }b5Vb%s`F23o IO/eQa R 4֓h-AGokhx~|(S3DLUd7'owхSap~_5˂uN=1L~ Yj\ZT0AuN67-~7@gD Y>/g|Ѝ\ + 8)Z!q ɲ&<,g2ueа6T[hW17Tq:~\Ŏ6u'=Uf9IV⥽$La~Ң?;rdmLB:E ׿e0cQK-u㬮 9Xζ+ȢFt3Y-F>E@kDdUtkh_H 'O(WIvB,B82?hK'כ!=o&pcI2^ļpIv|uȼnTesH$d]5aPV`z0Hn0˓? #OY}7,*];a ^Hk?/jb۔CG*Icz>+H5WuJà ^Ɇ/!|T]wKXZ 윫LNFR()P(e[`?b$?#snuo@ͬ(Bon|uV^O_tk`ϽfE1$Ca.D6f3Śڌ"X#.Ft.l0ĢN8}?DmoXby}|{1kx2=R7|= krt@kP|<"XWnv*6.B|_}02afB"9>$W.)tJP+,`NcwH5fV&y+x3w:.X d4vTqvYvlerA.kCfEЯLc`J̣ G`LR֕I ٶ[5H{>U,$9UlYgM+ ײUOQ |LCAKZ'AzZZh^%'@; 7&Ky%`AEõQ~*l)Û> stream xڍtTmؾ (!tX]6:D$0h$%I PBDT$.AFP_}sm}_w=}=3R!H@$ % R`0ZPM@cFh,F/& #lZ0h>D *@) )Z0_40$ZPC:DD^p@CaF@!=I0 G# J!"@ ???I'^sU`#qHp82` DMZD?X H4B|0$ U, /$''Au8D;ݯDh̏`aWLt % qAax,) C{Iu3F|x8EK3ӐYzz"1`>pq8o7hmpI pe^k0# {Ͻ\UjxSZ;!\"yXrrR'E6g6?ШRnoY -?JX^2 f..>e74 >f(A|.3M,fwܨXckX=~tfPhir.RQC q:DSJv^lrl[ׅ߼ 3ʸDo?URD_ R[S7sj$ E)R.k< ;yy㹠 b+C_*1s!񉥚)_wR0gtМtR#)LasB+vsV1-ͱ!^eC 崍IDB[O"&~,T\Ӛ*yrQHFkPww2öK1*kɨ@ n5>ʛ_B1u9L2`/DEZ1J>gTO)o^T @L qW#]#i£,/R-X4D jhc>5>C0[>'LJ(WfNUܟ; >((k7ڵ:lזtΌyc])[{ Jӝ|uJg|6I} wy6ޙty-Vo& 2:W5Ru5ۗ #)"2@SJ­wJFW{+ߚgkHXlV/*R-b+>_5}8-[M?^k.0».82 &>;|Bp<˱G 1(F>2o#[gAI5>c⏾G> %{._8.3Jv{,ͱ ;N#n=˳sƝd\ \gﳅyX=j>4vI-FFvRPĢV^SN".u%76WӾmñ{?89P<\<"E!i;. n2a |aG{}`Jle){y*TvN/"9?~6gp@eMݹ ^je _6rhd_ kKg*EX{ǢhpZid66 `(~ 2VHq({:2fjWr꜍dtޣP ^LmѠjD_I' $<=ցV[l?4J3kKp^#aPR[fhJӥ)_w9(v'G zȰ&1۹au^L!Iz᳝yBVOD' Qarxs6U5㱡',@+Ǚ걘ܰgꖕ-ru8Q%pOjftf 2}YKVYr贂~d˚3xӲQ΋PwZǿXȫ}k{/Cߗ<|DXHl!QJvUMgY$> f:)#'hǶ0-wcZɹ!Ybwi(ǹmgc/P>" %[vsA\~Nc0]Q@1Ճ}]p뒍]ۏ[%)ek7_LsuQcy[nzfc75%٥j5vnIuo̓xEZOL5_NgaơM7o6,ts9ScbCw(o*`W7dVi̝~?ɵcϾ}lgE%/Ѷ}0dÉg>&j2+Mۖ`:t{Qam%R?_<}fb+ 4KFMP~95bpyəv*uC.Ňg;d#׿?gԓTYz\}.$8k,BPZY.7Qmf7M>ax޺ p}:<-Gc5+6Dc}{ ~%_yu}4Egq j% VN닊 ܫr)N{Woi.}ˌaꀅbbʹiw=f>̜5L?.( *Zg*mo&՛лNP2Jԣ}]%L}6\ILBكZ/<}&:֚u*q\>./m@0Xe|u(6%ݏzGh,Dף5Ϩ3o܅®O7AK4>ҼyMX_nWKEڒ:j)#:ybbem <+G2ɻ=lWQ@M4/F\T#EF'whww?"_U_|`Sz˒9<0S7]PPguZY~' qe^K@2:kM?ՠ]8ad)Dp4jӒBya_yJ\_k[9]x<7PSIcFSASB[wJ,go}L$߬9HJGQIЩwlَh1+i{—G4YTZx޷ OX| _ 7/TV  QNCa\"[.PYtDz!vbjvxPvwc l5Jd%2EdBɞ=03D&+PQzqmPrc_ĿmG> stream xڍt 8k~e)/͌%YX]P3? 03lѐȾ%{k}K)D)$QY7s뚙yg{yŏX.GC]Sk(*[IE$x] Qmzg}0LWA7OPh`*@".+vs'QDJ0UU H0EA,"h$'7M)YMr@"HQ LEvG]I~P 4>8HŁ3F&I6I~ W^"4G0c4 pEc@DO8!_p~t :HڋD'1{#BPOYc DdOMcYO q(׽!P>^4EX~@ BO(B^'lL 8 RѮ % o(4nhT3S/TBq 7479?>?( )(*JqUU I,_M@G\^w_jHej$K ER`g{/&6dpK?n EJևD)R+k >zHqnM4@( 4 C?6{+A@ <r0(?>^!=.6CQ{|@(UF @ (<OW$Cmo FT n@%O ? <7A wTDHM@="At@A==ɝ1.ڮo@eNHu^ ?;׍!}c7ٮ/ Ht!>HQ9ac)j-5{TEZtfa MH+D rBH*^4h'Z4<7m {2 }SDܪQUʥrSWC_%:%eO&]u*g~$/>Bʌyxvh~Zv[l)vXGV.·a7gշ1Ekpwv)K^R8^qJ5=|[◻~^]|k<~8ބ+-CR]"|l?|h߹.ϳt#X/J>Ij1^ϝ_1m=H|JzsEYZ4,FZΦa٨y zr \q.w#Iwپ;FdiBߚy{1L9' < iTv6գe) نLjͲ*V _PsҐ!:%fX3<]\\?D;6sJdi1Mw#qcܕWF ːg>w.5_<$1@nv.W]uLxpNtGj%Š%j=*~oSNc+{[nh4l~,si.^Y7D4+]= Fg;gPT±XJȻ-ҏ:_pGE˧);?*|uz4 0@ߧ_=P Y)[i!9=>Ǻ(crs,yb1j Uw4L~n(e6!8[&2s|M10~Yg.H3yE+#]GmS7>-}?`z!p5Tn-f0IŃ-}rmXY5Gi3z_ >ZclȢKZr3OљʭМu+|)Ʊٴ'ݞT:[ ~>:V}y o=(f{X2Ә@N=;/G,~;V6_oȔ 9L֛mo{?!1]-fK9FSK65ϛ)24&rޚ6⅟ʤr=./vWGiraؗV)`ɿ_A;eA>M@ |jyQϷio +xIyxgև ɑ۟B[ Fmc7\ ,bQPzSKz SIz KjsuO*v:7'IPREqek$r8O ly 08+ޜhMq TaAXK;r~݅ꡬ[ nEջueқۚڧuըJd.&/(1z!.9qf`ť컠{v[> ZYv'g7tcw꽘 }Z-TW#(t]B*NB cȅ6~#Ǎ-hɺ3$w/(aƿ,npc[l{Coϖu`QfSCˠ2%117݇oGY,Ӿ[:7vWt:3rrCwR~ߖͪ%ZB)-5C[C;u6Y6?l(H6eu:y!'<-Tmk2f<-N!AE%miMZt"~e1b\ZVb 5;G=y܉veIiЬ.XUMGnF¦J2zt{Q9q$K~8(~:?ώ)Xm0NۇFc{r]$ߊ}-]MiSyO(ɴrjlKϾ<$#<cv7fPLM&ϵU$Q =Et~$ݵjm +.|jjV<#^6c\OO66Wrs.[6NY8{0B(l ]q:U>Wߒ|nZF>^}S0sj&ݍ~z5)ԫ70(c;Gt{vr|BFrACb@W6-hA}?IKcGISkطI O5?k\ L|3^'3&?l n=Rt>LugQ嘇~ zҘF2F][ M%w BNF.'d 5NSfeI%d܌Gt.R}[\|3[>0/V= y~G5É.38٩hwд0Ȇ>Vd-,/)ʏY)^2^(Ȇ} t<,i( '\s=yaO[OFxGܮZ藁؞ge#^ۚ_8M{o{xAdKhk%(" \>*ǿQzv#zWv[ɠ3SLƂ>A;f:9C /w1Eu/uW!f jFy|%Yj;V̿V.`r.7 weޥ~n6'xx2w 7LG'3fux`\Y 0Yۘ@s ʒg:9҂FZ~ba9MZdԥjpr8h_Qzּ4(,P"; Nv] -ǝ2t/$[&HL~ژ%=֤U5A 06H5FLJ ']5;\V&Igmr߄N=+7a%"fk> stream xmUMo0WxvHB!qmU^!1H__myݷDULG^͹t߷.k4c*S'ҵ>]g,yݔKeF$mS3&qGRp`I_3[dE4ݹn'&9綐7UaL)l:M z!YU0rўo>ν9},lj'}4>2]ݼ[ivjs92V+Vh ~y8&X-MmM|ŖE LS7Њ~& U 2X(pm XX(W8X&LR4=zukTGEm7h8Kc`Iu(!a <#G >n-tJ!]O2`̏S#',<ؓL%qO8\π: 3ht ,+9ugCwËpD|ORɉ#ɇW m藒1NwH=8! 4DCp&q"pBCT/9!ɨ~B }Rq҉TFIܨύ|nTs|neEA;~<6OIystg>O:yұϓN|I/|yI>O:yҹϓ.|R T<띹_mKz}K=W7"V{/znb endstream endobj 82 0 obj << /Length 683 /Filter /FlateDecode >> stream xmOo0C@@8l[jWHL7$Q!LUzSnffonh/}f}emy9f|vrvx}[(mmMyTnrlnwwVqTrvԧnfx Wŷ?yQJ ySN2k1ꯑJ.g%мFw66XͿS>r}|oݥNrl6rGىǼ?;'4>+JV}}Ⴕ.Mۻ:ɚx\_h`:Pp/ *,}!$B -fu[ǘ6LQe }ĭAk2$mAGs AI:םJ "ʔ43:KaCg" s rJ_i:6dPtk69u̩3ȣ" P݀^R/z0cP_Y̰*z~ʟ''Mq_ uWG5do9JOpH+8QhfgBfg"fg$fg,e@yɟ1S3SS0S+UjfjCfj#fj&.]1SkԦf44U44 Kx׆_|0n:8pw{]Ap^N3^?'y endstream endobj 83 0 obj << /Length 696 /Filter /FlateDecode >> stream xmTMo0Wx$ ! 8l[jWHL7IPV=M̼ su;Uٛ=w]yil;<[[j<=?׾+v`&ߴț<^*;~&Q>MS >_P{=s@dkx;`VY`s4JaQܡn.Uu9\Y6><ٴ.Z.4>Dӗ}~r:-d0VWk,8yLһʮӮђ[*mLr?q 5F8@=@)& 8Rx uD\j2HV0CzL] bctI g$`htы0\F0s jd< I6zg W qȐ+#k .bsrbmXK7ǵH7Gnb>&jؐu1VljOu$՟qWS/%1{\xB!K(hHTЖ枃Jρϯv=k2UKς_:~$/ ~E+7ˢ/ l(/} -+ZXukoԝE?ZKq endstream endobj 84 0 obj << /Length 739 /Filter /FlateDecode >> stream xmUMo0WxvHUdCmU^!1H#x?gx]OTm$|͜s_Iss :L;<Sz==׾f`*_`ɫڟk3'iѴ}=M;7rfnj-eSӵOLg~8 )ok A8 $`I\3`Af<Z]! xNky"7 _㓧q H`nḱRONH=CpB:# =%888QA~!*zƜАT?!~> tw8y*sύ }nFE>7*QύR>7G];~<6OIyktg>O:yұϓN|I/|yIg>O:y҅ϓ.}2 L> stream xmUMo0WxvHUdCmU^!1H#x?gx]OTm$|͜s_Iss :L;<Sz==׾f`*_`ɫڟk3'iѴ}=M;7rfnj-eSӵOLg~8 )ok A8 $`I\3`Af<Z]! xNky"7 _㓧q H`nḱRONH=CpB:# =%888QA~!*zƜАT?!~> tw8y*sύ }nFE>7*QύR>7G];~<6OIyktg>O:yұϓN|I/|yIg>O:y҅ϓ.}2 L> stream xmUMo0WxvH UdCmU^!1HDI8߯-@=ۙڽ١=?w]pwdV^ڑݧl#oxdGa0NiqF?Sր'YNR}{f{x2A! u xk={Exo"}Rɑ#x۠_J B C쩁b8!=%p&r"D9 Qg̑Tu+gGNN8O-(7ZRntH ʍ(7:hEњr1+w(O:͓.ndm'#Ʉ'> stream xmTMo0+J!m$d!mT&t@32U1~3~˻rr\i$^ںQg|6'oxdG2: lic$Pߛ)? _CtPRJ(:Nps0I֡iDAWj~:ytM{47xO_ M! K2XE?iڝ]]TʵHrS0QOKx&Z=1>bqb0q&d'H1[Q/c0&տp*I(kÆ2$l/#A cΘ :X"^fF~NK rJ_dP !@+MTH`ԩ3NE7kfBqxIA2Gs6AEYe/O3рI?kM'WGff@$%~S s셑(wr͂n"&}7dXz s)d?X~`5`?؈`cMv~+5k6c?؜` -d?diCNa\`͡2 ~DSim@]Yd8|pJ endstream endobj 88 0 obj << /Length 900 /Filter /FlateDecode >> stream xmUMo:W5?$R. d9M eCkmCp;;w~>|3E_?O]5߶w]Occ]=~?}Oyh9%?۹׬B|Ɯ>);vw%g43>\ 6 EJ78 1{~`W(-;]%=xe_,b+-O;q\L}UI--=BKE1p[! Mߊyu>.N5K)Wb٬8i[_uʕMzQ)V(Txޢjy!Z2P="Zd0\ÃGR\).2*Шa!U,H`+j.5Nα@VK-x%3%AYӀzΚ>kP#5m0Woþj.ZT$X/)n)#Wo(oRZ $Kp4Z-b\1ܰJ P"GXQi/8k^Zq:Zs9dB )sL-7xJ`aɽ)f$1 dъcCZC<73JgznHȰYɚTa,_-O87}KԴܗLloK+gJ.GZyVc48Wt]:P~`rZq.n1] S/Pu7Ue:?&?!d&1yHn5)yғBx#1ޞ]Go׏M?X endstream endobj 89 0 obj << /Length 672 /Filter /FlateDecode >> stream xmTn0C6*drضj^pHA@Cfy'n`g#govh/}eg羋򶺜m=Ooٽ[׌uRۉ=Iۏw{VQҜ8ߛIߞ3d_ ~~hZ# W c *'qU;HHV7xwuɻa;zopO_`_ݥNd0m6G_?[6vLClw6ZsaD%!p%blcä  PP[ u_g_x4$O<X^\NB8 \;cBbMx y%P 3jok:E q:/d48Q4A2="\šY+ːs(5$Y r~+A\HȕWr{Nxo $TL~K//p1sQ*GG-G-GzA>|)3Q/G""&!uN>|%h8hh$hb,n~ᰏnˣ+p]h \2 M endstream endobj 90 0 obj << /Length 672 /Filter /FlateDecode >> stream xmTn0C6*drضj^pHA@Cfy'n`g#govh/}eg羋򶺜m=Ooٽ[׌uRۉ=Iۏw{VQҜ8ߛIߞ3d_ ~~hZ# W c *'qU;HHV7xwuɻa;zopO_`_ݥNd0m6G_?[6vLClw6ZsaD%!p%blcä  PP[ u_g_x4$O<X^\NB8 \;cBbMx y%P 3jok:E q:/d48Q4A2="\šY+ːs(5$Y r~+A\HȕWr{Nxo $TL~K//p1sQ*GG-G-GzA>|)3Q/G""&!uN>|%h8hh$hb,n~ᰏnˣ+p]h \2 ᫄ endstream endobj 91 0 obj << /Length 672 /Filter /FlateDecode >> stream xmTn0C6*drضj^pHA@Cfy'n`g#govh/}eg羋򶺜m=Ooٽ[׌uRۉ=Iۏw{Vq9;\ظ{32bƱ)`Pk IckgUPSH@"7#?d 9aFm-P!.@'1 c09SGTX3 qxryB4 AAN8pЏ}% Jxxm_p?0䗒䗊/ TB~RtА3~N>|T%9%cQ/G:%uF>%WV6G]$ ' $ML/?mwTkW XֵdpZRF ׃ endstream endobj 97 0 obj << /Producer (pdfTeX-1.40.22) /Author()/Title()/Subject()/Creator(LaTeX with hyperref)/Keywords() /CreationDate (D:20231208184542-05'00') /ModDate (D:20231208184542-05'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.141592653-2.6-1.40.22 (TeX Live 2022/dev/Debian) kpathsea version 6.3.4/dev) >> endobj 2 0 obj << /Type /ObjStm /N 66 /First 527 /Length 3462 /Filter /FlateDecode >> stream x[r8}W1- ؚ*_bG3%7d%E2|(, &0/-܁ ;'i#3~ ̳.[#HMQeJgʔ*53U&i+TSY%\v>JVYkĚ4{Yي ops:^=JֈЖ>3\@K1)ߦk!qƮY4^M)FMY kCHbPou m: j*w((if墵l _dY (Jyj-@ej ʕl VROsSua_+;2N+ެ=:]6Acq|&\][!IbytLL,V*DTUJxqY@\ W8Ң-()|pg<*mk}hSƘe$"3 XR& /"P)4?*B(OS[Dzڲf2yZֿ <G7UuxpI;i?Pf:VLR;q@,݅t3ҬI1ݽNm֯qz1썮JzcItEo]y?l0sJS.ŖB#C⃕4L\(PG$(Oh0XȚS<_Es3d':E+v10rBh7!.c$(2E$43Q$ؙ\֓DF}.H}^VV5 Z"5$ғd!O'žvdr|)2Jff8XzmbҚjr)̲tP!v7)ꩬ8AhڏoQb=KF;RHtX/;r2Ha.B6yj0 $B$ .%uHw.#aHDڇz![kæYyC1d^o"AU+sWluHN+*Kzz,꒾n\b%2w0eL-N "w:.2y88ɫ(L9(MO&,l=!:eSk%-%SL _U[Hΐ-idH)dʾ=Rs2bQFǡtݨQ3ˋޤ?&)Mpᛃ7FyQlKحbw76@r;~onq4toKδ;7eHǧ -3Nr)~_.1/ ~M?g8?꼄b3ݫPLw A5Xҋ.zI)z+D]m>W~exFѐ_Co|SĐÜgwW 0 8M M?ϳ>Fj'0Oo'yg ʿ?dTX퇷7‡5RCۻBuj&vr_Fj_Au lPG쑌yQ2h75Iovq- DFuYwN}__@ḻ,AjIt}â!]UXwȿCʋSt(w"zM췗zm8,Y;pJXhGLcB߇wGUq0uxfFjĺB]G/Yx?:hWQ=Uѫ<.m=uZv Ewx][ !K u#"N`F:}.9Le&iZgk u5RH]8+(ho.\og˿>ď}};bJSOipJq>ӅPO5h0NekM'Q+EVGD6 w~=$G(6 :XOahFaYTٯ9ƔHS2[cgj\?ǮwL/-L(vE_XIfLG}Gj8rq̪qg!*9bs8+)HlQz  <6C308780D939331D6EA3FF81AD73FB31>] /Length 276 /Filter /FlateDecode >> stream x.Q|ϭh^]$7116xSO!&/aTLH $8kO~cH-UD HU)VĚe!İX[D^DTc *")T."G HWmW~1(Rb?ȈHȊQ1&ENEABv'qf5I\e[2ɺ4Yz!f9l5O>K;W)z~xxOm#vŞاKD~$S?i% endstream endobj startxref 138575 %%EOF bbmle/inst/doc/quasi.R0000644000176200001440000000564414534725245014346 0ustar liggesusers## ----opts,echo=FALSE---------------------------------------------------------- if (require("knitr")) opts_chunk$set(tidy=FALSE) ## ----dfun--------------------------------------------------------------------- dfun <- function(object) { with(object,sum((weights * residuals^2)[weights > 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--------------------------------------------------------------- if (require("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-------------------------------------------------------------------- if (require("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/mle2.pdf0000644000176200001440000102175314534725245014433 0ustar liggesusers%PDF-1.5 % 62 0 obj << /Length 1900 /Filter /FlateDecode >> stream xXYF~[P2۩T(׾y` tO] 0Ww}L~W/{ڧ׏J$L W׻P%6]Yazz(kiaLGe?]Y0b#O-ͺ+yW}畟0ˏm]uJpRW,)nN>~?0j/9aT 1~1 oFF?W3FXsƹRN |Z p3 2XKŴgq\t㱀~kzmI."RD[m͔D[H˴0d<:GM;q3iV (q%(SU2+-˧uI={8Q ֲh&ϫM TYqV2zEnTEET<W,Il$$#b e RFk & ( o vu Fڶul8fv0(+G2hKԫG&)!AAL* EAzϚz GK؂_84P~;;;Y>X3;X( ^.g :CzO8=P'`+!99ݽhv'=5#-W<Dz su[o ( zp0z3#؝LKϦR՞o™6 ݠsͻIgβMn! Dc%T`Vބ뚦n\'`pBi`"_ ]%3t*@lYzYvɳ,@ 4.=3ϱn,o x)\iXU>$"Ţ`Qqu-޳R WbbzSU N2:PURUJ*UU0;/FbܚJKe)o_]Q>@UI`@Dډ [eeC^`jNՆxS$R o/=wPPAMpWt^+y+Hfl;'eƮ/L+uTvlj K \XS(T4^Fs* sM}BI%bHG0|^J8 ', 96 6D1ʫ5ޞ7X!Kye&90,o}W!Imh$m4\'֡ģs6Pݩ%DHC)6mR _a< b_Tj~OKh(,<3-{=LP< $Gm놾}Q:0Tj$|bqy<.}4<;,X͓5G1u n-)|Ә߻ ŬT!F+KSEk@#@rTpijCCӿ-F7ySGݠ5uGQe{"er5iKrj' !ы^$vi-CK}x=4GE܌$&wj"sK1kQ= }Gok9j+<Q0L5`Un!-}<˲VNp3h5cO ݳ9\ӋG_!^-x`Ou%'U#+v<{8D@ޝg |ŻEBٸrPyZL1evq]$9VcUӜ'`L2)u?^ѿI endstream endobj 83 0 obj << /Length 2292 /Filter /FlateDecode >> stream xZK6ϯPT!^|xC]I9Z=@$FḃRp / Ǟ9̮6 Fw)*\= 7,\$X\Q(HƄqW`ް$]ޔE_ 6NwZZTW\{2(Hhgb]3r6\fl(%vESF"أ8T(X*7Qkis2FmFmQ5խq9rnF@ v)4p%=2 )Զ-(4U Gj%xH U>!69)\y,"TX>dPI 2$ɖ4 Ul2X<5բR .LO$s F%ђ01DX8Mk{)({Ig)IxSۥ'sޗ$gSGPJ"[Eb y ;V2-9R2l%,< 7q Gx?,R՝K*qe'(, qE5p@_R?TYtn͇P*Xn+߾u7GLͱ%XmAsg)?X݋Ws}K8j/eVJt I3 |:L Wݕ q;uSDws [BIW;U-)fz*z"}] ̨zgNM O4!<V[JD+O:;ﾭb@tf0m'mMR:1) GA%:#M'z/$9xR7-B.ՍOZokmT9FFVcY wЇ)lk&Rg#(9|9tn!a%.!6 ~**7xWyo'=xHኮ nwX P6D/|NuQ)Ւ<@gbQ'wd~) r^SM컪$lРKxrá,1LyA9ˆ> ؟6L?(ht'>"YJbSKFR{ެ9 p ( u'lh DN̟ž@S]\Hxptlmp ) BL#gyBZO}%f6UQ{\rC$|=[j6]RÓϵ>Ng&6i!Ein8pmГ a̲BY w~Tmџ7=2H0g_ړ%PJ<1gA٢ J"r5W|֭Az1A0.B$$:n;mvgia>ŒHywŮ74?V7i;15*.5@oI#R޺Ő)G}& ,oGÓkV–ǑQ/C UmmBV~w.!sRFE삻r󃫰pP `I˛jG־X)$CgveD8hN6D6aW%v&Qh5:ɖLߵ"N2yrhC2q>Dpg4H'vVpq RdŢPR.I@gߏ=k`?ȭ<|_Σ_ E=Dz{t]c{$J,s 2o4rʑݱa| &Ky0b4Zs% \zF2Ys&#SgˣGcv®/lCB~7_r3ŚO{`;}4BwKY2LjKi&uS9fݬ[MǷcN3FW$NWHi*y endstream endobj 89 0 obj << /Length 2005 /Filter /FlateDecode >> stream xZoܸ_!^im5#P1Kr8$Ùo(L*zҤߟ|@,1I0usI8H<2dQ!4"ؔgH*a&NXɂ?O{L?]} .Lp}HP,"L7+w^$>bр/xB_\us,Lxy73~׀"ڬmNau>Kıfcqv)kD4S@U Y-o*kO&ĕm3[WXջަ k%(ynz-¦oޟ~l7dOi?R~NK\SUoW^ &m-;C֌}&耇jhj /!mMU&v*ò[y= UFP`;ҭ CU>jlaI G :aOi |"%T ]!DEVz]qK=$*rWȀ&it?0\zLJ)m͞胈І΃C Dw9w( 8Akvc7w #6')gϝs׀)Sؗ(^L̔/#ۢ.uJ N8ԥH# J} %#҆c3:H;ʝ:nMU]s*W>ѸQEi~-z Z:BPI CL' Dϟ?HGJ!Z&~)#y01LfZu_WkqShpjXt&]I>tqh,i-T oJGR+xYWpJx8ahF6NP*<3Z-HwC#(|_7uͫ8~yq>'{`,(H^ n) pKE0uMHrILݼ7~= zǪQo2v<"Y a`98 ?[/ ]n[WO#愸,`hm ؂y, yȬwIfFM].;|csplCA3Osd_?ytƓ?ײ |m_^B<42"2"0'}^1Մ AEɾ_CU}&1[|ߗf[qڿI)&3M)aXٗcrgp0i9űA@ endstream endobj 96 0 obj << /Length 1244 /Filter /FlateDecode >> stream xYo6_! "7a˺ƖcHr;(4 MD&4N^42("bB\Hɜp!<3.ݧ(ݲNRhw_s+?$`,Up׶-B #eY5w t52"9Жv!m]h0/eLX7\"5uds3[b, P"2! 4<&y9NXE#A$Q& EEf&b&#)Yycp"])(<&^] NZ.Y]-\՝rT5/Ma3|JPs"Tr;ʉT u21yYljXWN5A1 )4|D=v?{9+zq ׭To*VEclpf&FC ~q#[Y(:9ˍbY-5Tmr#ɟs9grM]wiUJsJ22sPjLύu.e`57e@ݲ)=1Euqft+. 9ʺt@B><'To MW6gOQES?SuJs T /,8&|6/\9z^;xWQ7xvJ3v'ؾ~U-&93 GgNH0/^bя5T[3tO7a JZ.0!~Qba7ew @ow+u# _k- \.m%4q &ma<-]uy/$D3K4 -u]wؠaW;_\n;n h^OӅ ]0L`0 n?7~y*^P-z{e (8H>m'35?Q B@í4;o endstream endobj 93 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpZ6lcYM/Rbuild361112d0d14fa/bbmle/vignettes/figure/profplot1-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 99 0 R /BBox [0 0 720 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 100 0 R/F3 101 0 R>> /ExtGState << >>/ColorSpace << /sRGB 102 0 R >>>> /Length 2174 /Filter /FlateDecode >> stream xYˎEW^dFYɂ4 b#܋FBs"o®>]Έh7?zs7}o|>Yc/6g;2 lMs&}7NLk8F2ߜ'xUՍ~~v'$w>_3)8_r0z~Ɔ8S2אDzx.hxĚx48B 3t84WAFa>BEvMȝgy}:T㝲.I=v#8,[k*b%4O?n#CCED"ɷ~{qz͛_?>EO  @+&7D*>l & / :M @-EQnߦkF J;2ӝsQ9@|1pHa4ȧq^=xLZN z:4eKőMŸ }"yNL 7X8OQ, &@_T &sXh8 2? @@2kt%6:PRg2TM`v~fbŰTe-,l)&n` \G#mBDYvS~>p#e@ [|muOX?r{#ZVK_ `~ļC{W{aKS\cM-"_x(s8t ڮfŅrsz$6 Y#>B'1)Ġcam 9`Χ]sQοvu .0bL=`nG{E'WR?hu,ح٦_}bP+$H T+fҷtLxG8X6Lv¸lˊ Fx"7zlCa 0;T+#.eUD=Om8c6V Mp:uϮ"aJHYW.IpBm{[It $kT4ANܳ⛭wAC'( mmt !}]p)mB{WPz$h MHYWtVl:TSGHm%+m[ p$X͂k+RFA_Xԕ_"8+FZѢom|Il[@jG=y:|5ADDwǚ X&a !O0:48RӁAs"5AQ d I`˷ Hg:O&ƶq B]F#Ş<Hu<; 3V2(vL@rU endstream endobj 104 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 109 0 obj << /Length 2401 /Filter /FlateDecode >> stream xˎ_a" KKdsHIh[YtOT(?LgdT,֋dֳt4E:3d"ݮf\,b gB&~P)OHl[u=m6tjHz׽k 徶+ý{ODYR@ ̾Lvˁp&A\-$L>[q[2~/Q|/_dm;G``=57!t]Zy7mo7qM_oٷǞ$F'v9_dƑ`@e|h4*5%U|e&cpóC}Aag=/ Bp›Љk|WĒH`ucB~P]$W(uNC{gQhqEC7bAM =e0Zt5au4.OmSN' 0OH:H`=1z?tU_l(2T+jS8B|Uwhs#~K1u tѐuDdƱ`%iu1tbgkAjc Lw~H8O:Fm"+uBv(}Lhwu_5Iӹ~5џL=|(8(wU}p7Qbg`!Ȝ 7=vJ xݺ(ϊ QrwM IF4('*Yg5L| X/p ^كx2ey ؖKeXVA¹ap  (3f ZdD8Dž:bw0{N\S)ɷ~iqk*Ww"Q, C(G@Wvw|5Kq@bk fb2LmYF 8jX\;,r6"Rv|Tj\Uu_/ML <[kDؘ]ou%3qn#6;[,b Հ|Dy0VO#,G(CqpFfʂcmY Ƣm zT3a{K]n|9z>#:v<+WmKluVRI*ɪ5%`2v)jy7ї/՞U>T=sAp}>ZWx1 chF@Lmg;?x1me<|D_YQLa95ރy=0LS}nMO,GkgϮOh5C~p#t7>r^|PiRЙ6 Tllr.Y~і^Npf.\_Nq+rdxⱓ;Jy_O'4B'9vN$Tz"}`V0HhJ9DSqOB~ .Bk0 /A endstream endobj 115 0 obj << /Length 1657 /Filter /FlateDecode >> stream xZ[o6~=@NX_ֵ@ AdG.$iǛeY3{ S ȼ~<$2|-k~AOVxw ja^zCzR HFB!lv/Av JA27BI+(cϤ:<8#@YxN?@%kӦeyzp@YQ zs6/ӶMQ8BUWɡO2εȴWS@D:-U6۴U9׺ w^Wf&\X4pU089>+vJDºĿ53(ӻ^?4E!VmV>] \;DBk}<7=gVHebƖulNpԴGJZzrҷSVzכ^S2X:(I9aHI~;*v=h7DM{Hخg8K)&ܖwp0oӀ8BnYY^ОD- bVl\f!SΉ-#0B/28;Z`ܚۘ; W f*bH? [!QfֆI(^dp; 1PKdkB&-< a(ӹF&DH" (@@,' M|P=ChO4iʠ=t~ŽԦT+oA4Ni𯌙IC{4!=B&%5XnZ6" Y[(Нu$`xȍ.T gdhm,ĊYxtZ ZR|n"u#t$*Ev$"ύ=VM D,yM[}Y;Yxw"H#=Ӂ=PxFa@)?^LHtid o>؜" B״qa#g5ȏ:ΣFQ?6ͩ(CȎ\@V )=jrlkXEmYP$o| Oohf4K˶٪Y\ 4Mw|`A!ˇrUjW' ELP-C;5oU;*{BA?ʹR]Y}+W=[}*\V֮U9ɩV͡IW-0WRDhy{:Uk endstream endobj 119 0 obj << /Length 2173 /Filter /FlateDecode >> stream x]oݿBHN,% zWM Ez+VC~{RuحaxECr'6ۓ*~n.yi\rlg$e=c$O$_4{ѭE"oy} '?GgOEp)8¾|1z6;6jЯ r"\NU_FůDJieĜqE/Unb؂ )ęQ :Vm%13&DO!ʳW\LC M֛ġ~g 'SBSqjai`h̬/>M(!9!77;} n%OC\j $ [|u]/~QfwAN9v+hYVd( U5u:^cLrIW8%imSZ7/ZZ\eS7B(.IN9;1rBiqZuL224eìTe Ha̬vRo k]x /@`4lQI$8DmJzfUqB=:>qh i8$8$tjeE3WF٢[r_gK3;<' i]fǒH 1C_:&φ&خ'|[~Y͑I`frq77o8&aw"& ?:Yt,ڹ3c~:Cz If(#O]w┇4Nvظh^0sҰA=PmsW2O C߯ P_4&h lmo 6?a0Nθ#ԩ|9/5wGUKrw<ؑzkZُ-^:c A(ˆ:&GgXyvjh f]Z&q *6}u60EwG³x)ω-[67s`%2 vV,~2 R‰usʱ')DL'VqҭuD]`^ët-sѾG0k?Eշe-?r|qm-q':pckF4GppƇ㷸t6ŪU^ bqjبGe͜LL7 C=K).rf$2UŤ9%E5W@at=iTkոƵ~_ؗ&-֍v؀F 釯IAQF]VwE-BfO=ݚӞ?ݶuds ̉IIIT 3a? endstream endobj 125 0 obj << /Length 1870 /Filter /FlateDecode >> stream x\mo6_!&1wQCa0`]}h;@dG%߾#);&Vb&rQqg9O em>MN-?{# @yH9ى.gT h#bYTp p`2PQ iFWo}rXkh:[Fe~HʵJ,q (Ž7 !%bd !,X8[07f  p#U -rfQXede]qT6' ˄nULڀcgr2S+)$G8,L8NܹK8b#v v WȤG f^ irЎ%Qf.9;ܯr!P -G|կ%՟pHYty9.} 2ckneWcA9'J|5Ú *e^]B{~-0%j{m5UIU6n?2 敺~KU2"^CRVHmӴImNE6_IK]o;?d$?kξ=5?[68[#zЕӀ)JVW4qlͤЁL> T|-2keo/,uf;'|x]#؜i/U!%ԹS_(̵͋,t)2wJ}PTw1:ڨۥ}P8LwpI 7Х>qxFCvm+(ZسB}܁8-tTǣa]TՑo X.7P뙭$y'Н<2PN- ;wM {Wv.ӤӼwmu2*4V67eSs-\bj\ۜvaR}s$xq76=v ;'~pY} ?B*z| CV2IgSlfeR)wOzDx{>N+e3mkm>'OƵJ͗l:i2}{@|s[l\<Wpou&⊈(.aб,Sk*Ҝ6_ ZfU/ʾ ɡD KDxsa$QzF'i~TO`=m:]_a޶Zk0r{©Zy%Q/;cxG|I.pkNO0)ֻ`HD 0*jXVˀH ƅ.~{yӛzv2@XasJ ~![I @8$\q2- endstream endobj 132 0 obj << /Length 724 /Filter /FlateDecode >> stream xWo0~篰=$Rb<)45bC&ЪنUi!8q}v18rk=5"xOsHb)@/>HpSQiV&aՅ7<%^~?zq $jZ-y:O\Da.$h W{Gə'$"58b鞟 M3Ja4YUPxQPư/{GUϾe .wtSӂkjN9NV<I֓;2،?^eMQUu]^7t[hwZqYr( yhW6 .$b:T0'KBk4.JpmO Pʤ=i)'6jlG?f -7MGfMۄa*G[]UZ$f>uR/i).`O+W]4eUmj%'a)HA1G YK`Bt ?@a!$˱f Al`D@Q{j?͎EZI6Q\5GX/Wn,Y][Iv-аØhugabl_wT> /ExtGState << >>/ColorSpace << /sRGB 137 0 R >>>> /Length 3610 /Filter /FlateDecode >> stream xZ&OћHHӾ,AI$D"b ӐR<}Ω7 YS7ixK۷ۿ?n}88Em~|vl_<|Hjq<^Zk+i|m':=:c?k g ν-\ 86/|2^/RM_gsj[^\{ۋoȿ욲t,xq%/x\^Z/ǹ6n#ˠ~ǠH7ȟ~:€p1Ed I҇uq2\5)!{pjo_N"ۻ j״>$ts{I|=ޞ'я &8)s~-NۼŦ}m4^2?}/_}|l}7_?^|o<+||t `2405rL{=d:Go5=L#SFJMeܷ~hrF owo\zhÖ WiNuך²#9+{}1z)gRX5R} ,MW)#Xm\`!{V5Ue,@9D4r: =e`IBDW,2g!$tOa*LN2I43K/C`e2YOC^=5NmtA{#K#LmWē2<3pUGFB$W {w%ϗxꛯIjq0L!=Hۡe~IT| .m/]y{_kFԤ*IXLk"Ʌ:^f*+;T iM<ޱmzeO/,Q?_J'Ɏu%m ccr 瘯#ĆKPc1mze+oK`_\P)X;Ub'Dv'ٙ#_CMkT4<6m/]y{_sMb`&ٮIUvo4b$WLMDkmzE'֗z{k :'dړ L/)ܾ&r_ݱzcJ'~Z%(ɢI6w@d7S+5شDxl"Zmד/{^T[?uKrsId ߃b>|*2h}J8('\clB{T|!6MQ|o3 ľX;/>ȋ5bS6uƎ{͋G>Cv:^`-u_"v762ߕeµJLd5iĈ\ÃkimC=;@Mowm}M~\K˕ 7YR1ϙ!ĦIJ- @Mow}]z\e)SV8 Խ I!|Ey5nW싞1qt|4?ciu("`gz=}u_YC}]c16v2ߕ%%Z%S,kTOLj;w֙bHNkl|WޗI{]DrAW;:T'yDhO*|Wޗ25w B=r;6y9o~Dz< ;yz/' endstream endobj 139 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 142 0 obj << /Length 861 /Filter /FlateDecode >> stream xXo0_aiHR b/@C x~("š2"RhQLLp,V-V ^B,a?w55#(Ʊb _8/E𾜲(: 9%]$*ڬMKQNCɟM?ߎ0AbݶC(('XGQ 1kK"*H*Rk}r9ZATi"'֚KnX9 E( 秊ڡ1hO7Eѫ F$r \]Ю8D7MU^SfeJv~^RZjC0&\P(! b,[~Cmܮ0ډ as;a]7׆D'n)OGH֥w-3{lZ yySH/LςӺ!M>?x4OOps̄`.l\a3] '{ ϺItY<܋)!%֗ s"à+2-CsB^o'%`LCj!ט+2nWW9! U8mKQ$~^^Vn4Ӯ2Zz7Zv(UE?WEXm`y Yg4rM۔Piot -B0ZSez¶X!NƆP<0Iҽ7fGI˪Gvؘ*Mfy?_e:2(:1y,isqyD0Ai ~ endstream endobj 129 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpZ6lcYM/Rbuild361112d0d14fa/bbmle/vignettes/figure/profplotsigma-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 144 0 R /BBox [0 0 360 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 145 0 R>> /ExtGState << >>/ColorSpace << /sRGB 146 0 R >>>> /Length 1493 /Filter /FlateDecode >> stream xXj]Gݿh ^O_=S|?o}mӫ7.N=ǿHK!\Lͧ9wspmPK%Fpc#C9ɡ_"B<344rA9} re$vibev9K `Ԅ %J 4jsRl r)~!u0Z|$]RZPU c:%HD@h5ι|F ( ; M!/} MV{Rj}_8$* W+9ժwt#qE$M1=Q" F CKF1a4hV%-ު ]?"6R[k)S\)y4:RzJ9Q{kX]K%jW^୵`*λӉD3ͤGuHwL]zkX8xiN%b7^୵L TW-igj\tC$7ڵ$Ůdj -vZXn+/hf؜ dg"n$ʗq:7;koDk ;& [$fW^MyOVhm%"їv0&5ӄUpʈ*"nb1qw9-[mÿopn_ϫA~e`voO_rȯFYvtt4DX;:?ю.w\ Nܲ#{ ALSˮysqsTr(pE[_ 4&~T\gp_\eJG|obB؏v1i1D9s>{E\Fȼõy==yݓ7o ~<J~|x}k+o endstream endobj 148 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 151 0 obj << /Length 1430 /Filter /FlateDecode >> stream xZo6_!/rq⧤f[={P,!j$'HJ$UTi -wѹ[z$lgo~"DE"ܛe;}Y]lPF)\Sי, P^\/e!:3TK}1~zVVrc3,U+yYz=5Zg(ፍiạFȕJ4~ *PЦQ8}Cpa؍!YC`f_͓Qw߂mGvF8|`~aXEC,A"N% Q AsېdC=99Kf . ">4b'H{զVcckXkZ'(F[{gz 0wDF#2шN o xHpIN+b ʻQ妨\yD*#V-XK= mEz_K08pPdS;LZ_AIr1$;cO+`(fƱ9] za07a_:so]$ K-o5 ޵nn E ` G*&bɊaAO?0`tx~X4Oyb.KU}{il[!7cy>qcL iXXchcMnB9C.=|Va'8 %8$3CZjV2އ۷׵۳o;nCfn%C c'KbjʹJo*w@ec89=8cюQ@.ʀ.L4F)+ P#dCt]U'40VFm_ag9ևGLv*M]0 n(ȷʼ_[ vX(` @*C66x z36Nn6{׏C̞(lѝFY1܊:rMnYiZVe kHcķxŲrgpn>7_b;{Q–$rO>)7aysaqKQޤxW!Pq5*zld endstream endobj 158 0 obj << /Length 1447 /Filter /FlateDecode >> stream x]Ks6WpƂ&Md[3n/i$JN*h%UAՆI%/P1.TSaE/[s_+߄~KuwS("O3UQ7U?b,څwW= .9 |(KxŶ%?Q,PȩDȊklʳW#=%PhVFYl$3#.ɺ TG7ȟ|&6)',%]%8܂z1]ߚ%i{p&\; Wქ೐^F~|\1's@\p[Pׇ((`5殫W౳N߃j+նB=e\*X6f'ϱ%G)bFX0#GAθ砾90́iU ?9A~ G]EQaEQ%J|8~IGX>QIK#敵}a"i^q`w:)⾄\ٗߴӉֶEh}F}|ڣ߬"La(]^P_P?dU[w endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 824 /Length 2384 /Filter /FlateDecode >> stream xZs6_x #4mfL-6IT-iQ,K3y@o L 昲Egm1 IüGgA ,Fڅ=PGLJݔLE6gi j:6L:4jpruct2 A0~Q.ƣ X)b;fY-jŔYC@B*P0xE)JŜfFah*  $W b5XK0D`Ъ10Zv(TE[QGU41 I DP;I ^2Ld|Y"M'1@'-BD y! D!<42Mc zx$l;M3.`*40 dDc YR@(dAjד$$ 3V(B`ɖ4Ƃ!1:Ɏ+CƤ= xAC1zAۖaAO_0#ڮU/u%YØ%/ٳi/q ޳0&G!T|"bDC*2*SQA*&TjzTmz& 禭;"b :m^NEwԴU 'Ϯ)C3X5l2b|Ms_,Wgӆ~YCP~&ڌݑV0>lpqa/HE5,O6::&M]w1߬57 ͒U~n~lBy͉SYt]f,wPMYoj2\Kg>VؙB]^ Lb]5l#ƈ=ZhM\#t sR'V._cc%_aCZH{ǒWyyIe,yd|\YQNSDKel"d<}1.eSQ]`ȟj%4$r+YWt]uFlk.j.Ր쪬zɋdM*2)y_ꅤBjŽG\#[B3=M: GNj5hJyjr\(& ZŇC na.fE noˌO_[FFK ET`6 86\t\ǰp՟C؞r](Q]4)%R[avf\zݙ;sT/q<`S%{oMVm.8*h(! sq;QtʢkFGҜN^U(쪞%_Vy ˅cl8H+R<1DkC E샎Y27J ̟Xf^?ь2otS=Fv2Ϡad9/_C\ҟӟg%p|-]ҘMk\EB±:n@U {L09;=FH*sI'{MgeyJ)/`LAod?WZ th 71%%x+`߀+ұ\CjĉbzQTrWOI-4B۽ sd]hCЛW; 2Kj@WL jIvSBʱ.+͢:Df'YJQeZfJ(-2,'6l!/8Inwh0gXcj:Fk95^s:o ~NJOsVP TMuђhz-^|/eJ͗=jM_yqVLuI&T&l]t t'7sY%|ҟפ̇, $ >7bO4Ȯ N00mogM:L7"S7KY}lbh7WQ.GŃ^ˬr(#(tOvy m~3X@Wt=O!w !`v;}Pq׵g^P$6{kȾf$I ݜьp\:&@Fv(WH!3F5`퍅 C^{]o\/r"Z)j:]qGHO+x_3-+^9ʧ!+lɱ_'ɱ|9XE9Rv%/f\ AbV=|R-[r}-Y9%7|xxZjqz`&cݣi^Xik ܇HL1ǰ=U'mzuS6QB#n^9"#A/? endstream endobj 165 0 obj << /Length 499 /Filter /FlateDecode >> stream xVK0W`WVnXMHfIV{ƎW H!R*񼧂+m@hm; t^| /%(V{&3ˌŇ]~ӕ<cIW:,BGuҁ[7OPr@:֨HQK(wu' RY;n)T_돳BMg{e>DTH#U^yFe# m+ɜRp{DEaAg{ϥAV_O}W/ߠ0e/Kc/ endstream endobj 155 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpZ6lcYM/Rbuild361112d0d14fa/bbmle/vignettes/figure/gg1plot-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 168 0 R /BBox [0 0 360 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 169 0 R>> /ExtGState << >>/ColorSpace << /sRGB 170 0 R >>>> /Length 2538 /Filter /FlateDecode >> stream xZK]_q {Ef0$0qCƫ Hקު}~*UT*G:?}_.)?ya8}yǛK:^KPG߿^g3qV:9l1?9} 1tVXAJ1T}\wTR0yBkܗoiml]A.FߺKMH^\x}95d}EUu x 5.͔]Z^=/*^yr'ȍP0o֞ Wej+t!SuՄ\_LnL[N2ۨ.9hmtT cˢ4,c@UM =\5x .XVaxЍ+KANpA #^ԦJ 靸l׻] d }YŒY|c,Z KӥP2;=i"^y7Y͙ #2POmt{R7#V=I ) ==Ic={/ηx/ loHtdv=u&j? lDyW/Dds rhhq\sLFl"`\) `C)u0b '^dIAoNMຘ}Cܑ2ܭ!b}-f++rOeyC؎ -nH2q+<52= dH> ğ߰E&-(nsD FoQ>ZidH")|)*fY| 8N.A$%C#$t3 .avCb[sv:DӜPt\K8Qv8TAGi,p{ftC8py8ƶg,Op3;Ä5nKpǶǕ=a8e9ǁ#xe{ 1;op+p8m{\q=k{LzB~8q?147<~ٕ+'"qXGGI|z\pEv?bF鑚001¹BHMح`!f}f):lSs !kxotDRPNotNgݖBz.8=mڧ:W ?Nc?%ދOŧg@gr ^T~zt~&o~r=[ÇGGN&bzJT5?X_jw᪰;Tkoa}>j-tnqj~Oy ǓO_W/xD?aΰ1co훇)pصYR\ L9K+Ibᔓo(톽Q ’eإdb-yй˖th@f\`yC*"\[J2-\͈Vb/v88 QxLu%#a\rᐪCÈ`BrL b\[J*vzNV0eo?_݀kExUS9OGuN-9N"Ǒ/+ endstream endobj 172 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 176 0 obj << /Length 736 /Filter /FlateDecode >> stream xYo0_aqmC*O!uFEtIZ۹քI4Er}2<UӶ {'"&8 qqDh aNjm o4J40=_0$$ӀIAC|\\_?O_c43hYeyea-<1 ,-e[}1% :SU釸Bq]٘%oc!FJ8[d<8r0+A4bX2VP(2FǨ(]>'Ҭ)8bcF^,42Og ^2 p2LNg1%KP%JPK,l_6Pͤ`flB!mP.*6 ӘuO<DX5e˧i>SٿO-W rđzQdV-CLӂ&k{SB^C%N- ΛN,LhsqM 8m/j҇ d$x8 :S~z?qzU\}>TY#߷#?̠ endstream endobj 162 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpZ6lcYM/Rbuild361112d0d14fa/bbmle/vignettes/figure/basegraphprofplot-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 178 0 R /BBox [0 0 360 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 179 0 R/F3 180 0 R>> /ExtGState << >>/ColorSpace << /sRGB 181 0 R >>>> /Length 2942 /Filter /FlateDecode >> stream xYˎW&HG6B Y^I-EJE|}Ω"ift,UuXv}?lƘu9]a5Ů/nXļ`j݂nYZgl-\/"9;9'O峕{_?zWgg~|WX^<ῶK6eo3^DcC1C3_W)[ ܂87c:Uk"0c7fq;B E,{8k } i0ma1y+R6˽Ecoܖ=".;º/4%!L.%n- %pkj B Qˆxq 1 =օ6SqJ, 0-R,0Jш@لua#Z6p@T#^u^ ~L%QrNآ[Ꭼ`ezzđC0Jd:lqD&P|ꊨLN3'!a99-1C!A&dvͭ_Ŋwt!W"tWqX?icd(=4#~ Y}(l3CY:=[xQ0H4"S XzBqTl=a~z y6 Cz-b\\C{ă'SBz'ㆽ'( AN~2G7j{:je&V὾eoLҊGie9I,s}S$y=w=†q -c]d>v 2 ,'SpQ1*"Q6XiPAdtYN-P **A[+PAdtYN7V9T<] rDp Ӑ2 ܢ_L/npKãiBVog;ty].2.ҙ^^\ dtE7`98-r3kxgy$gw=1sP>-la~u~| :ӿ}~9?dyMe&P!ĉ"Wm82F!<0p•*o15̕{'cQo(JͲw+D +mah(uz +|3w˒bًuݧ+2?Bw,'+k8rTeh9/*pڦg]Jeyыd.,KaQ,Xi ‹Вd=. sIhҪ*J !& :6igP% èg`eLY mXAAh0KB5QFi`e<*A8aռ^ UPA & D3H" 7c6K#-uFyzpIY>җEp%CX^aH|\0SwaGn.'bAe, ٤%gnŢ|VݓXčQoyҐ1H=*Z-Ŝ,бgttE8^ E#Xq(˒7MV\4b?*ZwZw rƷs'TMڋM_fʎrn(DX3иGye9<Y&m-,8@F;DQ$ *ԼΘI6;1}7LV<̣.I&5fw5Hњ "rMkY@١fÃ<겜DnR^]鷣ϚЌĽKCOt(N||V~hWn~|^h'M (E`w`։qO4@;@Rhs4O|nY:>ɷ(Q'Y}4={é ܗ,ۚ; {uly;gJ(bQJg cqRڱnMa!XYkR?E Ǣ(:&B-jR`.+IU|eYMf[ "FF~+DW|FlZ'KZK^F"MHK%a`)oI88| (eEv%$+h0b>g)?,E2N"QXi aP")7mJljP#O(7TJ,,(.Vd6("T̘Ak]5P *& }> { E}>- .Ԕ+)F;ikIm֛o\3bl飃xII?# 6^%xb P;zڋ( UKBT$$n(+#EPeG8bt=^f=q)^C ~qWd`_X(1,'f'uO̞ܮ":n/ Gie9I<@o k aSٻNn̮QbsYN7(X":t088A`qYv?L(܊5 0,tWyba endstream endobj 183 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 187 0 obj << /Length 777 /Filter /FlateDecode >> stream xX_o0藺xӆu&)I6|vq%р-b TuߝΗ̅D3Iэ^A q@Z6KliELvߞx)OD~r8aiShjP,@ :Έ$:9*͓ ik6%n[Ԏ' ޲e9J[A]07h=gq.%n 36C(Ηˎ(cR* KBcjҠzr2?l®e9T!`hĪ\r;j4Cd;G7o(`Hl$xye˹jNy輚_2RHsjq`c&TH ޮ!с@"7ZavҫU5a\rcEfHo_KX0wÿRqSeR~"= )6f K8$Pk] _.q6*)ԶaoSj(4VJT3xZ:>ĥ1G .E>PpE~"-+Q[nQo&"&L>ԫ&=#LW7e8']hhUՕ8:k N糐Ph8پ(nvF[AQ^\Ew{2S_pTOfI?P'g~<͓ʶ7Wͱ ]5ct{Y 91T  endstream endobj 173 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpZ6lcYM/Rbuild361112d0d14fa/bbmle/vignettes/figure/latticeprof-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 190 0 R /BBox [0 0 720 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 191 0 R/F6 192 0 R>> /ExtGState << >>/ColorSpace << /sRGB 193 0 R >>>> /Length 3221 /Filter /FlateDecode >> stream xZItHW9 1lelIM{azGv ?ؾ9q{_mec{} K=b|ޏ-a;BK4tszJ~N_۫H1 aOm{uޞvGZl3hﹳg~?~~7#a_?ĕ+}~|K?~{}Nz4Ķ66,oۻZ-{y+mۍQ +2c22t'M~TgPpecc20$,iDgP8/GQh+,pp8^Jsk`+lwlIVmX,5^o;ֺC'BҴ4'{vttP . 8guaPpacq2(8"=`dx-}xcMO^|tB1^J+GCܔ/OW%"FڶJy"(,!tPmkÀ[b{N-{rVfUDS19ܙZ`VTuOV_omm2HodhdFSNʬ@ή&q]*6꫸UaymAT:Tն QY% * ZUy?}L Txr~2Ši;B ClC,u"+nŴG ׯnmtTeWu-8TXl޼Paۓt- nV NY{͐pm_*kMQnc^"=xdIW0en(EBU(څuI\d)t׭pm_*kQ"wNORwip][t- nVL40fHն/]D\sj+&qdG( T4f ww3gnI/t]V!-܊A6H.[2-pm_*k:;y^16R#Ѕ7%6 bUu bx7]6>d~귮 a(r)@VGBZ%p{Beb­:e3!ם-Km_*mk) T ZTևM4'j n1tۇcH#/]XeeZNw'\<pHlA"` rZeCqwG*>&VR}˽v<Ҩ1㒣( (XEtcC/񣚘aj G:@i۩{ظb$.[ ~+˳'4pa@^ep'C |–.)㽷/Jq}5|lH34ˇY{&VŀŎR$$q suL:"+nt*aLQnL 6zߚPNJydɤtVntb{SA*ĺ[1(˔=h!VJWTv[ LR$8T,o6%dNzD k'RNDu'k'ܶ/[|#JàL! uV =X&eb­Bˢ\t3$j[ʮ~Z-N}!k1L0S&;6b{~Ad b­iTnl  u-Aޢb T)c =j+ӤWn_LV -܊禲@֩[ FWOUv[ׂN7 r38mj @lՍN5Y[J& nD6ߺĶyUvj&PpYEӸZVY0u $bʮ~Zt~-Ҙl5WaW s$br>2YDp+Q\5YlqnmtTeWe- aC< W [Lӟ-y6D2'=Ie b-hL6t([ VJWTo] bshe8)Ӿ:g9VzFmtCMNgz&>@TF_}ܗ#3Kzt P"o8gyNG`S -܊].zݶ/[ׂpiFlNEUF(L̰pP Q!xa_9 (Jh DM k#pv*K:8Kˢ(}b,,b߳A/ZeoZeEXeY?kyEx$^x|t^1S"C4C\APa:U*[mݍ[1λɢS@-~귤pBklo8& %CcÉ*N薹;N>B[9i8,qHŶ/]ֵ "T\XP^ 4/RIO6#)kP1&JҮ;YMﶕ~ߺ7B/(ƾxѩ_\/3U\mիtTF_MMvIOE> 4:7NeQc~T*~3Gf~귬һq+&E5BQs W)%מS -܊Q~2!6JWDo] .*vqL$C }"5 į邺B[&zl+]R u-Pxy$c)>BlQ1I{ e_aUyrtKeWu- ~*1\ UTkvb{#)k.D]ϼ嶕~7S&GON98݌ C!lG`z̻=YsoM ok1N\q/ߟ7.D endstream endobj 195 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 184 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpZ6lcYM/Rbuild361112d0d14fa/bbmle/vignettes/figure/ggplotprof-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 196 0 R /BBox [0 0 720 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 197 0 R>> /ExtGState << >>/ColorSpace << /sRGB 198 0 R >>>> /Length 3510 /Filter /FlateDecode >> stream x[KGޟ_1K{:$K -H7) $~=ǽasSϮG$o/Ҟ"?_^looioͫ_}߷o-o/Ϸ,o 7{[RVS/MLYď߶>5ޙ*?˞vJ{O^Ǣ^ e}z%T/ܫsj{N700y. ^0&Za|B KXÊpQx1Rs.P^׌-s5_@a6󚮁a V~=1p1$qˎFK0i ϋٶ]e:fv4Y1Frr;JJ!\* ͭs+'eB= *[ŋg-3ߟ5thTh{i<]v0DK&@2!$K4bZ:&0O墭܏hO[t, *S3Eͷ!foęvlЊIAގE]KVn`:6-rcladݘ 6B1 ; eS,G>Ғ$鲝H16 n̅Szs;xK"O, $urL ѭ܂ɧ\e3W݀[vewvc.3qF<"-#@2$>q tY@[{KXRn :lsr+bNb7{"+$qЯ>8M, ѭ̽Ju+:ad:>+bDCɝrZ=7y\tRݗ, ѭ4.\r}Rn :ls0C|@17K9[UH#:)Q1Y@[ 39,A9nTmtX h7ҲJW4)ZYgZp.M<] Lw2,H16 nw+/+T5R+9Ah,ꭳC,[ p֢R9 :rQr,ǤUK(5fV`rh0kl֡{}Yf8BP&~օBֺ u!k?"pT#]'g m!47.AXO q`*^JrbQ2nRoLQR)ŋLlۆFI<|Ӓ6ɬZfvFK& Q&2?$B ї"`$@pZMbL/@5(Q6:9f.kVn`$kMT[ ᶱA]*{g7+y6^3*Vs9ƞʢ}.ibVtW :lslVs+b&{EJIoF^8B!ѭt٦[ -kv\xm"frY*M 6~u.Y@[ +=H16 n̥&Β8WTqEI"(rLpz[ToqL&q%-rcladݘ Yغ"frG݂}nᜋ~rqY@0Mʺbc \FSC16 n̅ Z)zELۣ6 \-V $7eN|벀]9FԸldRn :l;6f ~T7n $n5{ \p]{ puYO:5 300N1?f^0y56kkpm֫Y[k^ 5 nxVִu!770L[+6F#jpUSi].X7CI>$<_'S;ɠuNF$R)WސM<>lFa 3=`/{lzԮ0=iyyqL!\6pIA]"{o7޼W(PbٯNa<ߤӚN9E\ , ѭ 6etwk|ladݘ \折o=6w0dM҇A[\9lu0V٥wvc.)CH)PtN?bN=09+!Eɉ{TrV5ry eL݆JxHHS>UބLV!m܂98,$T׭,ᱍK!\Xh"9LL`C]"8-]a/֎bCNamth7Bn/RE~UdA= $u9N~e{p,nc \C_]S8C)|GyHƣHN?d mdBt+ul.Fu.6KGWL~GӥUzWEvT3ݬA]v߽oePSrSuo\xM9q~;ߒoNL~Jmk{|{7gWe{_Jao|JxR4+su:XUթ/b-.֧\O_/?|o˹V`}g9^w _c<iO[T-rKyZ+ZZ\1QJ-X\(;-I,-%˽_{a}Wmxu/E6<}kz yc:?œW-:ZL>Zt&)Jh{q%O:_$X=:̉`ro k4BEuOV`?G-L]_Ǐ}}T_M}>o| s_D^oi}?~xw #a~FUVٸgS endstream endobj 200 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 203 0 obj << /Length 2421 /Filter /FlateDecode >> stream x\Is6W|jUa('Nyf*K<9!Za&؜4.U Kl;~~-E;! 0u| 0g;mjkKE-9&eZtuREV-/5]&tMh_k5q >8(.뇦F^늫S@SF"#e/\z%/͜&"pߒ{-)"D}I3ln]>ۗY]U Zʸj E:ўөEjn]M4K.2+ŗ(}|.9G!6]p~ BɭPrP@kJ|k5 f_@^Wg{D@9ƹ[;(rQoO~;Zr`Ɛ F')Nd=x095w.O~z3pJ,P>IY9DB6 Gίk'Hy|?ptYS*Uy&Εvr~f"Ȭ7|tQ25|M9 1 2}e20ƕ(:,z8J[6>sg\D>Us?vE e77h!Z8_M?fёd7Xn]|7h63U'Wk|ag11O3lv `$Z5 ZZVv"\od;/g}ٜ ݆nqpm86w۰+ވzy7= -%i?h3izLJ`T9*jxJr<;$dsӠJ7lSs^>[>=H(jADb$CXI4@i8TͩɲR>pWާuW 5 t&k4SU'5("\>  =ȿeʽ:_!lz#t2Q;YV;Yȳ<cd4(l:8ݬYbVME\V*U}G TքWYq'jl`b;eIr #mi(wQ"@q/\iL!CSL7垘mgzFP!0{GL]2%L(C,o84X^ƪ KJЬh1pXc]8g}=z!5FO!.E<=yˠ=!U-DXw:t` 7ެXGۈqu@:A^$&c0jώ$ҒE{M87?]搣`D/B2@TgȏC Sr1?7_/ 7?}AZC˺*N5(D-x N3! DS7b5FB%:ճJM@ Sul$*'>Z/AvȌ&:g1RB2F+-O #?^}xv)u2!#qK^9Ș.uSrU,+%NMqajj=J" 0FL"e P6tj0SmuËA07Aopt)Q]]E\{/I,{z^,4A/j5ޱO (a ?Z;(H@Ev CfV%-!O:<z 靉Q`LE> stream xڵXKϯ#=ѥEÎ{>m5䡠AtwOH%/S.](?>ODI;*ϊ]*c9ZGi}u`}ƏWPJUfQZ>Ҫ4+IEN3LJ V$tx3' sGoeCRmt1\z[j`8S' MR"yl`74%,hJ!àCt@ܣm{.lU ^faG.ЪLŒr;S8 qT] 'm+L\{]]ڣNܙ~; UQٚ#Y M/>;H M b0ĎAY8g0dyQ.%x?:8YeQ06eҋN[H GR꾵/b;Si%]f*I 1ke !Rx:Gm'ǥ\#dD?QWTW@Zb ^([D #ow$Nw8"%`>`w qԺ4p:BhXHiQO"7*a{Ɔ_YDbzxt/2."CxƧzx-S 1yx6RAEʹcЗ11/Эm6Ot'#=ÆFd_\0BB;뿹:|gh 0Aw>j]5n.YHI]D[ucovNeJ N|sT]_s-W-^G $ȗl?0ha^#O^cnƦ6#h$o 6idrsylΗƢ7\.")6^rzH].JOƻہfR@0G,@ BQͪw ܩ؃[tkf=i|~ܳPzDIk039WA1d]Q#MA2<[HKB& .,j̧ +2BD~`IljB AȻ(G}mAVX "F,p:_|x|B endstream endobj 211 0 obj << /Length 2916 /Filter /FlateDecode >> stream xڵYY~ׯP$Tbl ,ĐytǨǧE1ӻeG,UoߗϞ|Ne߈8fYoR1a.o.Ne r [oe>Ԕͱ؛F,;lǑaP;ODRt~#*L9XO0p/mo w |UzԳe/iTL uz{:>Z[?=D3綹+mչTd:9Ln(5fTnETxe3!9񒟭-8U0Y["?ٴmKC[wfЀ4``Zk{u2`?އ^~DGmSܸ1⃭>}GN_L濭،b<@v2}{3QO?qJX;$g*I7W#@z؟~q-Xr~J=%\bjs,/j?HsACZPGͮ7E|릭͡4)Biv$@+iβLLVSD XO Ŋ@SbX=.?Gl)'\x0˅^j |o(j1Ϸ|7x,ǽ 8'_" ⥸&ӱZP45uODBe_ (4q|P e賩.>حHb[%# ?΄/b i74B #SF-3NJ$$ب$?ËPԮ)ϙԳB Έ49`JNädR@4 )Fjp Gj"OmZ(),9ξC)K>{};h4x1_$ mj;Զ2tO [fpdyUmJ53"Gyvs4x.zG7FZ!APu kX/̋L=e0ce"h.ys~]'bXyxnRw(ԇ6ܛWTtވ)*Ip 2,,.h@]дɮ|, 309ȿ"bsJ`p't>A8^^/v; ^yNh\yH  x/?'ׄB+,vNFCgT|ql`lj8K377p;|M$`׭WI|fu1VBiA_>9핌-#H{44U}_z;4:*zZSqCkTTQL%вd?YS!%ӹ|#HA@-@K .Y)Հ"b]@p[yL%:".GDT'WXJ & >`1z E7+C&LQYo/lgDzZ+@j?@6[j|KŽ8Bȷ] Rhb@dL$кZKEdz 7S|aZ$Z bC2$7}2%ύW7_/vz\_C%NU1duVp1&h^|pQ}c*á,@r4?;aM\s F*wB2?3X;CqtXcCŸewR T`;uCN$r n1O endstream endobj 215 0 obj << /Length 2756 /Filter /FlateDecode >> stream xZKW0 *x@N"s7CRa! 6etO^ԐZrf0G_?|[_?<-9S.n ZHMƤ2_ux 078<3sw-7OiRt\͓*tr]lRo_sevw:6?ъeEX{mƭWx*i%MkW[knݶ88b9 / _45zDD4+%J* :k)g ˃#t#s󴟅yqEC`ʨ~vQm"+aE}2Yivlf,u3P5Y5-I)t=ϷȺ8P6cn0ShS]J &w{E#] &䷫n&rK-#1Y;Tdn9k\뼥tgh͸b#rHS6֧rhP5 |¹,X*pc,\&3hox7,f&/LҖ\h2luW7G3:h͆qcх6e> oȃ;ie̖"aĊ "O@$lz"R3j$ @q$~הtcaG|K1 OqmRm5y4`TO?wDT̼`?_{Lm|B"Y z#tm%[#Es6[$~H]YZ&cR@df4Pt c<; m|m#[$I;'7po`U.IR'cw?OrS V0@g)]yP+[e5Z&FQ4PYT.VcYETK|3A+:SQOqh2KuQeIptP;mqm Ekй̱dQyjB~ab:0<ye6:pخ,{]|We]_M/H6^{Q}5pVyNy~pH$`YkBWKľhe0r u5j~W5yB ,8tv{d^]SY!bCc/++½-q OI0 œ#.~D(!SXCcnӍX` ]t."GO(M-اܖa_-Dd01pX$*$Ċty ~ ìS10+H5k MAy |F:HV[)0D)ݝP ™Ȱ{H·GI42CE[W8Z ./}?KV==*_exacѵ4P KJOԯ }$ {m3!SD9w?"Ʀ =HP^ӗB:l|B)FB}E/* `KU&?Qw?sQ5 ᨬ/=w!Ktt_%0du6f0*TԆ2w8@{,gI.,t4\H[B ™<>SsRU #]/;&hEyb֍;NJŖMɻjʳCQn]YPN) X8d66mI#T\©R2;VL@{w P_#YB 8jXw'ߞyIq|Diflv` $XPհ |SەXD_`4Y2FяjE ?KG @Aί0H$̅0<y޸j}S4sڀk !bW%m z;dvR]f=Xf@N^ ms GP=t7]Y *V!`$|(9'õSŌpڇ*lH7UW>EٔmהV Rj吿l됪 mbkN}(Y8R f3"ul+5kve2F=)A4a<A,yOQcM6h"E}%}jo-ƿeyѧk~ auŨ|`\Մ4Dѥ<{룡!nb:hTO!f|.8S{R&op|59BpZE\;U(o]sYU?kHo'7'[;?qHa(33ޡ ǒCG8XC ѭ0 Q>}{ĄLIq}RP+ Ӻ;C0w&68ÏlΫ'sݓ endstream endobj 220 0 obj << /Length 2878 /Filter /FlateDecode >> stream xڽZ[o~"gͽ".m*CtS /Rwfg7%-\wgͬ‹//_zkLd/./dXˋ8JeysNwުp KQk|wM㩢 {JL'꛶*y<Β)6;"2 롲4T7% ~i0V=* 3JƠ[6kJS!eIBg30 0+0d)ۄ hxY,"nxWmF2(kdW0HUU>]'ڪ,&E|QVԌTDj"w#L&qo`0 4m<d"P$0~lF ,(*P|jLDq* 5R4U{3h뛺&,ƮG-р\^CarP`c $ /GqTzVƃ_[\۫g-E$>DSNAaDo^L<](Z\m5bǻCy3U64X`$Eؠ9͂/^ËͬHdzuz8u0S1TN?O -Mխ ]*zmo񾛓uBi0AnW ME:?-\0DϤ@ 6GPt9ݹƱno詰6}TЗ:ձ R 0LrrN`zzDdбM,Q&e[$T$Yib9:tm_|0͘wc& 70E]Vj_s;Ny$*݉.}<$dg#)&׿W}-&[)[[+-0\Nw|-5;-nq "Cad3,0\C2a Jv9dǚJV Im; xs nW+ H/VH? ڧ&ȱalO]mg6}% {վL}6 T>4gשœv,X~~l6-DfC;v>aܐ[8eTV4TY;NR-6EU%s҇c8\5;`(mT(/bpeuX`5Q\iu4Dr[uLGյh:Hc~Hw6b/<:g8fC95z_7/,tC-9eral84r -'vt8i2+F q q.'8(nze#$ \^p[f`4w'sG2۶ ]MEe%|@poJjg 4!!Yj@~9bH 067URu~ }U]emlc),e ! #nrLd+VX 9us^T3nklҌe~\EAVSX(ql:?Z! 1cw c ]O!ij u.-%>. װ#oh 鹫 p }4rUUK4/n˾vkTL+ 5Roj_}'4 R!iWT6Z$K;6u;:=B.^PW`CxcH$K 5˼bIcB=ļB}.-!\ʈ|f^9 )>FA8*DҏrumnTh͍rL,w'pnY}1 -\̆V-)O!?J8[aƇHM$dnӾ؝oRro jwfLT&dmrw0CL{[ѕVoVft5~.WH۲T&KY@'jaBلR e>b Eͅe\kBv4? C4_0r)ma>y1f}XJ2p28#%5o/_Ӭ endstream endobj 224 0 obj << /Length 2306 /Filter /FlateDecode >> stream xYK۶W(ٔ8Nsi8x㙓,.(! =^\$Ό}*XUp|s(Y~du[(S8y?:M8b`ͱ_o8^Y7SyG}4DQv3#N ZU;{)U/#g^fMkZA Z{dČg4y;EyK[ t1 tp*;ʼn7a CM~D,)-5 Yk|@]K F58/H5 R n]MMZիVGG'5a֛0v8A8,=}R'N~A! Q˳X)w4NT|,߇E|C=8zY;4C|{Z4F*<9xqssyEP 0ޓ2(DVU_ + ~4G~F,$pC_EpokSsT˱V}֐{ D)@8UX<!X_`^x7}CXz;oo%xe/ t#l᪒ȐϑRokzv{vhAE]Qi SjH8n.-4fl/&P^N 23&FOI )|mD3!i@' M &]ěӇ$5fObx1j9:f$ىIŗHi8fM-rp8S(҃kzv ǽX+PGpKMZN0H8p7S+~F?Zg}s_< F4Mu" EݼvGJw7nEyjSjR5ᐝL~s\GXxȍٙw6{,4 U`5yCjҰ$Rw5~)4Zzv H76;vjX8bLMi.`wDžqnCMR?/_I$.U%c[|`ak{:oR|#R,Ru bdLLhql gixaRPP|a6d˵ P',)`mLw7.@5 FvX)~WD<͐'MxoD_lU!VQ]ڏ(E(Y1#;azسg5E{-d7 hޞkѧ0:;o }Cj lZ O*0aN7&_ʃ vj"rCZ]#<e]t{jtP4rGJ4E%L10ޒ!J)JC8†~#j(i=&xHZc.Q+ bɸF#Dx%KyXl^Q$3/`q|bqNbps@ A!iOwQp endstream endobj 233 0 obj << /Length 149 /Filter /FlateDecode >> stream x3135R0P0Bc3csCB.c46K$r9yr+p{E=}JJS ]  b<]00 @0?`d=0s@f d'n.WO@.sud endstream endobj 246 0 obj << /Length1 2026 /Length2 15603 /Length3 0 /Length 16840 /Filter /FlateDecode >> stream xڌte ǶVmN*֊m;FŶ+vŶ]|{[{ه7Ɯ$*tB&vF@q;[g:&zFn&#B?v8 u-?"DΟ6QC@9;[5`fd@;Gn @ mg tp03w<T&..lƆ9CgsƆ;c *AklFohDohOM pp6(@_6H[8ۡbgf|-N).&@G)Y=9&zO_,llhllgcohaak0eݝi&Z;}ZX}!@\H `?-읝,W6ٚm'j4._2L\l-\R4m3:99@؜T=r2eeog00~r2t]>^to00v,li޿;@sIsLl=3Qu ۹tl&&vVhhȕ5pgf? B ߵ>'{u??RM_U_2w?~C kD|N} {uMOslͬF 'q wvhd׫@|elp53k˘?o?sMbg Se0e70q0$F,'A7b0(>TFտAoE㿈>3}4/bY,uoI鳓Nk7L0iA;dV4Tڟ2-?Z~ɟ/&vߓ?fDKeL\铋JB@W~鳪)Mg7$|pv/m7קtí,[w> LQhQy8tyFN rJCY\%~ڞW#+UrqJO L쥒C zba'Sq. 2'AWQVz1oϊnL:bg\K2IUE~Ҋg)n<43alL!*D$`4MgPQܚqjxЭRn`xưZG%3e]N&@/X4NLj&\†ۅ(!1)fL:Ќ' P2^e-Q~ظm2wur!QE# ;UYb:H/\,|jvcd#^ _Ybjc"@gM 0iO* <:>sqGK%R*\z] cݍ>vk\[F#6WVKti P jW8B}ݑ-ѹ|dRRL9^|ɜM*6ߠGt띡~,ي m4!&* ž^D9gwNG2}ٯwLtcd_* U8i%'$da.Em'f<ȕ?%k+{<]r3?Ӆ>`i$VDG8r䀇a,>кl<|VPٟ]tq.#dnUg\ A qqA=D./Z κ` &>2^ɁམP2;[~ڤ*4P`Nl{+Y4bd܃uG^Y/yDEL!|e vՋI'k5Rͩzq)t7xP9q>T\ Ւ< 7qOh".˕lB[.ENv(C`ɀ[̀3ћc/:0ͦU챟,Tlh%ⷀ kg ;jю jC6ie)m:4Ķv;,2u.ި4S5\\%(˶(Pb-uD B5JrD3,4lسlC,^Ұ%xz4Qs:ζlgPˈ_ D6PkOP#Dw8nޒ^|x !@Qϝ֖ږg:^&'#R#\BG-sQ1)r }S#~)B"fC0e\OC}.Nz8'!nqIMA"E C oA_WF*eذóƤ-}2R>GA#vҰMMzH#8$g6eh4ͅ$Tѿ| FVd#yk)'X,F G$P.e`Ziϊ^#q>Bvᚨ^ *>匐-ZSag4A56&rl8(lื;he^A*Ÿ,UXrN2xMPu %T nWVuԅoztW|}o5,*0 g@݂J*|dzY+M(S,m^4JL3&RH ѹ6ukI>ۆ%|Pr2 OUs!"h*7h))S\&*lTFz=KACwOEy7zL>^Pφl9 s!1Xޑg67./jZ1l]`JY,ǘ*5{CHc7# 3!#G1zwlK $X?,zBBЌ\ $~v .ZJs,5IrFt4 .־3_9C1HFK?X} ]/&_84E&Ԙ_p1tkGV- |Y$^ըJePoқNfa8x[j>3#%g{2qbi⠕E^옜;LcDxFZg"kHikƔ"4V|X oa81+d}e'K$T(^5 "yEURro WPtY $M[ V*zXc?Cֿ,SlY~cl#כò9;4"C~7N7F_V~#wC/35+(""Wgv)=sĚf[8"'>ָ ζ|Ol+HsUtl0fl&b1 NIwn`t:w4!g @E(Zׂ(q)o&p}1I"$V0HHt]"cB2/X寭j;;T9ͯb2z&k=*2幔n o˙93]6:RSA& I YA99!w8e=ixp&pP (G()=z55RWj}D&'~euRҎ,/^l0 5j`V 'MHo.\&u[Pͭd\(̋.t҅>+ޘR9s}eV) ;sCr#M4͞T[rhe6&@A'-5 KPm[ckKh eղ ԠF#IF`we[<%qe_4w}=+i*n!aѼt"pЛ< Lǿ7ҡ)J"G:MΠqu? 56i丆cߌgU;U6d[1!“[v.k߽@sKy5PTA ⫿ms=LOP'LI,am" %Ne`3b BsPĪMm)MɌMpbq›v:{ PQEi0%e-82r8%XQW%r^]U4Ӈmc >\xl8*o+&e谖cWb$g#ƕVvU֨$rdbEgM"S@P_]yCx쇍vAstw$׾qc! &ZGu˽脁jH,dkۏ$1,D9I^h)70mא2eG ̠$CȐnr$:ڮXW?3LJ+jnuH8a^5OuIKCQI?βM(5FMpRR8"YM2騴CU" p0_rlL)ƘwʸC-gCP\mz7S`L<a3s-yl|EtP~}[nDYF?Àەm\ ua2٣ &'J\*=.-u8 ]S ^vTKs3 "2˶}+'mP6Ԁ"Tyo*yK3fh BWm>O"|5<=) #ZxDj9ث?/DRĤ8.K4;gANj_1~lXPݐWŎ*\;0쐮pmqo*Fl` צvz7&>QF$J7V-vLg~w߯10Ks7`gȠcl7=N!'(s/tRsPd&K(iVQgׅBl7<<Ϛ e|H1OgAV)ro3CEsNZWQjw4C0I,ht_/*kJ {Yjlj>yj夲F6A5խcE&%_0]|dE}*aMIO{ u`tu :bAI( TK1?^G_%sb5d*}= /DUw߲Wպ!,tHb١W=jx=`]VnGP $$DUCgK'{ fr8Pm)N\.sc'C MCMs!w-kzu>`jԳ6i/֌L->t"b')}5%72g!4d]>,pNWNC _z'Z?XM)M;7GKbķj+Wރ:!1]bKݷ2KHXGxl_E">?nJ}6z w'?CׁXx.M~k)V/! RX:I=*5U@A~^:9/PI.;V]}X# HK]'%>0H>}0i,Wgp}s,'1KYF ?_9ky 1틒P{ V\4Q0bNww)Jq߾|PIUW?a7&ʼng'Q:UG*vF V~GFd!( \]MIJv+KbrHa N hc/y^^Y,6 FԜ;9˷OB 2p`q ߂b zoi1ɍ+@w4bhO]@}A1aOy,ifu2VX&2`X` ݺn DQ5W(/[NqP]0&XzrD^Z_\DBBOo~9_un Euk({sÌ7.rOj ͘?<ɛ >S0'b{gs?"9JܭFR?U{k) f6P`B.!Ǹrům]WeQVx[ sW&!E]J!s h2/蠴Z9y n̘̗ĭe5uYAQtVB%H͸0,2a? 3xpԏz-TdT{ls\M+O kfƍ|lrrK4]}`|+_bjЌNuePc\bvM2ⱌj*Gik6|ںX(}x:q4PC6xfՏ<5A۵>Xcj> 3n52]Aˢ(ӑE[\iᏭ%_4H9ʻviǻ+ptIF/`bcȮ] .SpiM.3%$aEWpH翄4%|drdGdঃbA[&тJ wlͨѡ׼\-.]4v7&m޾P"Jy602{=Kz,HJ<~Cgrv+m)X=$٭?@Yލ,m:C } N%e.cH)_+} Q!&pFd 5he%/訇tU9f1Af,m.aw^Q.SeW۫ kDeP`e^`fQ %0MOr"=nTl55\eoúS)A~O{p568v%Lbҝji5G@#!9Nm79eu_.Po?ÚUcp9$?A;>Q *(.m)@ok]Z4m5##`!F74KPrVŅ4nH& - A{~#(eZ()fW Z%8kt;训EIʅ~+ wǹ1[ >`+v`6dNq &2{qO|F>t]"}赱 /ΊDgdk\JWsO.xRq*TNL8)b9XuxH<)OZ@9G Gt}U//f+_cr94wBv8\V+tC$k 5䍪T3eyKđ>gߥy[]MyF⢓Vu+dpm/#Y"*rײP[,KVX{ u\: G,쮁npZE$ ܹKQ{<}al2j슳i5)PKץյL=C @TKC-/,1G|қ85g묗?)#9`cJcQf3?G_#3P|8(Glc̵WL5af=qCFz4GшjRba'L{+2[i=eFd0eVihni~hteT3j<H1Q][l>UM44:xfDx+`yjOШX<`$}<Ǐ[N _R U| BSFxp]xu?ʪrpk})o^.ҎN1]7>\7)J-RR{ hd6ٲ)42i֨GΜhu6۟\v_0ka`AgTQ?2vH8qb9% hhm}È3%#Y*HVfl4*ƹR5 G%pVŭ1-ΰ>Xy;[gD8Z!(rG:D(ҭVElNgmhK㬙0)m L.XKbii<5@"~?h@k,Fb] '֖e mFI˳  RȾ̀t[أM4[lR-j<\wЈ"cC2\٫l+}ջƬ4L2ڟ^l\KN,i)tX~m\/jfD4ʯ~ ՙSwRN~CFzJ $o߸sIC28lE1"e`H>q}X!UxHr{2Ub2D+1pݲʋB]с?{_VRu8ܿqym<]@..r퍧խL0dV7jdZZe\Q"S%LWQ>ٜU5ɬξqrM;(~A(S'u!aMQHGկja~TYɕoӡƛ @z.'xZ\ 4`jP!Ʉ9SmS.rUK3KXR]gf񞰛Y!^PXuKd$2BMYb∮B:9lvV}9'ЦC0Kx`XR,@UQ=Q/Smċ{/-P2:lXO#}7P. y C.'Bux VĔRu~u߲\^%Im~1u׶zٚLCO4\T2*+\h? \% |"M4 4N!=fZ3gyXm#Ny98I*6xiBdmȎ*OaZLJ'.-#srԎ|Өԛ3A8z4;YF[?tSUj6(!˰b`5Fy?8EgPW#kzBKhǢ˨w\ g9 &%&= Aњ?E=j65R*A.HQ3胜aU)yJX0jL6٪-8^o?! P^:ORG%[cH'dxJ_{T¯:tJ'B;!f{;-c@V:&X^TZHYES|dyb1z$З򂇦zѐЭ/\~0WEVj*K;b/lnB U?62zL`.HUiSiܝ* Mgru>vƨ=Dij&ʡjgY٬ꔡC_xBЈrN_ 1J>ֱ@'0Fr6)Kﳾ%FbE6 U-//ޘQ -XyL[PE$?xm=1yߔqADJIN=9&1k_&ON~>MD$}8 hhxlkC=^5Wcd~B=0H8~{˯i؂*hԿ7{Z%ǛIfEcN !=̃Tֿ`9 7X{UnNXE+YdNcſ)N,؞Nqv+mI kIƂ gI *m-Q:!L"]V<@U%zbzP!,9c͸6ykh(om! r *KyZC?nݼs1nLsiSh/o=ŅZ᭛pS@<_J]b:&!GM]W3Bj y6++UcXPhZq7?sÂ.h^E5ĸSvfۍ%W-̓?t*CqHicG4 E-Mh+"-uc94ڪz,TmU_j9g-8(.(7@3"fk.h=S6h.±O`&qВX D|)҃JUZ&Y.Eh<2X+% :({C"Dzm0> JN66)Eg40)ӈs!8{:œ[TfɠT5;#_MdwWo~hbLb$C?>R%%5o]bp '/q>kѽ}&\_L0 6 qPRB2"Qֲfw%֕N[jUEg}l}vaZ^LfTcȖQ> stream xڍP\ Cp'hpwww@-@$58w{so=\TEL@RvΌL,|qE1V6 ; "9" lg/ qGU&t~5TȹXX\||,,69$`3"@H%ngt~G)-/w l (-A6Mu;S0BX:;131m-hn`gK 2 PڀƄHа;P3wv:k) xPU(ۃl6VۀOsL @`ۿv6@[l (K)09;3f Nv@W hjW@*~N`{g'&'o̿üYLd> #97 3{fM[ HVW 9@̿hx؃RryA?^N@Wo"DVV`"*_cy?V ^'_G̬(#Uٹ9lVVv^7' Ww}Oɮ? B XJv t}N/)uoER.i6mXN(ڽ5bvfW' |Q[ $vM-嚿l RsZ,,G]VׇL.53el\#u89^hrkLvί.Wrs;G' `-q n `/0+U 6`/} ^AL8_uv֯1 A"f Vv.f0[ cNZz[le* R|kb^|mKZݟtv~-5nk 2ßQhVuW&N@Z5_.Qx]}fgKGпDg79p|+aի+{Ͽ+[.LfL>TV1n NQmk'2z-8ܣ%Ж XsMB_ޒY$}:lv38NXΡhb"F O!2\xPU0ozݫ- ns#=M2FiFOSe|#uf$8uGH{!L}Ş륻}7RԁOG u1N[!p 6 /?`(BUq9aY>Y\ߨLN"훕}-,cVV<8aV̮4<~.DŽ5W6M,8pD^+G_Ї=y3"M^Ce@-}[c eM m%&\I֮0ӢFN!*7EHm&oGy]{U6c+\gi], g&%F2:U# Ha::2zjҍ,\oznk&Ea2mT튗TD@!+5)4Z 9EV5}I|8\9րi$Ja&֌vKcJW]4bvA*cdmB B|lSl#_g?+ 9BB'+/GvABC [!O4 Dyd5N H{/ WG+ĵYlO}?Ō'''^୎Tr{~]5?i "2ѭmusaQ.|ђe,O,K^O-GPr{:|X͊ΟF͑ <A~HK t{~$##cXf]Q[5`vm@RGt;if^ H8{6Ó"OaN2 l9m#>ϦsadFB*R9ץB0;ɘ up-<7rx0wVod| !5}bB&J3bяMMbmI܍~cpL(}WwW%f)9#| 2>eLTQS8^v-/@[jtYm& 7?H3I_CXכ̎3_uUi9*guB}z1jnɭg*_,M}eAzh6G7 jطSPz^=jw@#Yx"]=|xo,.DY7GEK nՔB9ɂe y:7-aFr_LG?e_ŜZ~JrW:.Zߊq(෠k)t>eu9uQbQT^qH o 3zƟV `,1٩z سrE3\-sNFS] $:td.KYJ_n{cˇ"-]Z})P@`ޚA~}rCnPT {*(9^-q(( z4ZCx<˅A@tʯ9vQ0NT+j#.6fg 2 <6c1-ID{NVBJ ݷ*5qrũnKX|nJ߰i%\1@*G }Ś2Q-3/ 99?%Pl-bőkHTcۘRHC D5|NZI@2tfkmˇ(hP]֖h1j#,/$Ah"*q /&1K)aȹPHUt:l!XF;p6 oM)YƜȑswx_36'|mp[ۡ2Bb=7WX.ܯ @UEqmQ w$~C712Vn5b%䒇T j;[5V/ʴ?)9MF?Q.ZF/Q1l\|"ۗOZ$6V:h(fC/~'WISwLܗ6q^jʪ"qd: a@CzJ "fOJmUEz>sefvrD,fR!;]5*uD"9:".Q.,5)ފtYdX,SʵX_KvŗpGTRop^C7]`@juhiC+olJ/VDcMmP޷S1fW̓2c"Ӈ0 jU%ky( ^B?48A=):H}Qx$#;3ǣO# <6Ac˝;񌋂Hv.Eя40a&^LQ/76ؚvle#HD?8\.c,RT0߲Z8$[%&E2tY[B[VdNRJ]E&unOf/oNBЩ|@waS4'|@ e-"U|%?;<{ mMZ͗ro[2se!E3 2g8āV$~DٰCryw▆T!uj]F-KZ+&>&!l4 ‘ȷPi"eZ7uzgHIN$Ht2j!m8\bG=·Rj7!H2ƮLq 5uJޫ^m\<v|n9b@M]R_*gO4Owt1Z;7 F2H1RJ%5κwÞeKMXJIIqu7|XYV/zyMg FϢf8O.842y\xՉZ23)8mWef,ER] ]ERlV?e^F{`DKRp:$3nZĴvExZ s#99 = if&`O8С 7'O%u9{BNjBb߫ʩnRw箺vn´Ѷ~%R *WRElκ².[ qpUs\9${U|A\Њf)uqS}uF}uᦪG.ЀH߸!tec˰AV\@M\=j9OWR0nA7yp>B1J~r'D:T)MLjC6l[ȠS3yxI\4!R(R~ e)%GC5U;--*tR&{%?=?%@#vgxr}J|3NsHeak'=]|ry1-$A0F}c-T[aCl-1|øԦUS۴1fs?8 7RطKR?ęHC KSȷa\!WD mP=m.`yIw)e#񷸐f@IIe<on?n]?+f6:wnP&b o~F*k/bˋA(([A' K<*sM*=BۆKj֢As,YFy$7jf;6z6Um[G+̆U7<6AC-\s2wVg>Aѹ6ga& ]zEEp;ݓr$QHq6X5Ci!CeۤwYY4[\AxX~8J)"b⼟@Sr$+v^m~}Z{p6SVʘ-~z0o5R!_z`0&E|?K y7[uݨ# Q88xlnmZ +%`Nyԅz^TYU5t[ J,˲T~M@LYL+7/[b~yv6}lղs}e*uK ; p-idCؗ>y`oNd3e|\>=߱H !=>j^!ǭ oYNAJG8f;eZQI^:g;o2)UHzKu8ѝEƧTlp5$O1I ͗S@`T5ε:>&Cє[x҇Z / J>V`&\H3M b;ԋ#oeXfm${PLg2Q(/-$LSSlP-yռ& n֍oeb`O?㦡bפǃYQ>Yg-[Nm Nf\eUp&Xp:0ҹU='vgq?sۢ&],`&lb3@H@-g_=ui3$t &I:` G(ΜȑX~FV+ѐph W4]T j`RߺvYKشkm z!{ 21RedP%aCJbg24$5vH\p7'N4)lv7Β.܀۝3XX7 ͗:uW睄Z6E{mFFF~ٓXm^{n ꧒c ltnw?IY mLR}D%|8AzB[J)?({Hu`9"7 R'*Q11ߺU,k+OBX6 =r\ s1U3 ,fpeܜl 3!Hʁ >7r[pNz֗Wc= *%ʺ8[Jq],`Ea#ם fvQ1s%]<*„$CoХ {`*}z.F96)mҺB{y [̖iEywu*k#?ʹcZSKKQd u}V9+MoI@nM3mo?w^P?|>BYLuoGJF6-Gduzܡ;ru҅Ko|ٖQ#&d{2;~Bp~# kߺդrJ2jG ( %$;M-ٮbk⢝!#\s*kt:rCv-ϻrlЉ^ڼv&Ro XͺOeGxVŦP#ޔ-"z::KjW=hɲ jUdnB"¼~3gcsIconݨSa8L@-q~cz-夗oUu}T=[IqӚb\+ >J6{P0TP%/INM*?gO-_$* 6j< !"-^0<'G(bYUg'G5X@N2Iñn;)mLn;vEl sh]T/=l~Vxn/HR^r䔥Ep+)̩h\F3'pcd\&~V8ڳ59]mXYm}w..5\OڬwI;?Lg Z?.9<1&[)R0=}1T!q_3[މh>*)+tD^IoTo hү9viRol30 >w073Ed*W6/J-XY&A}.hYiR(]{9nd-@rN3980zzQz;y8%r86O;0sZj̈́pNAu]xzMS>a"RDSˉ9P. mxZd":`"c(Y\3HCQ{h*e&5Z]§'6UU7'YSl%%{0_{՘QzI+BĚ"tyylRTxdt:_M@pBMx{jmmrȎQbNmP% L_Rrjyc,8aCT/〦\ jsy˾4"zT ヶRpcg^ g&ieoѻB|z/}vx`} mku8˾"Op5fڻN4Xc.SW'CjXWR8ܤmZȊr2 ݛף(y9flc &Q[i:D?JQvS-]'G\ H+ƕ_qk1055v~@a%/1 m{!nmknL%@Տ[q:fCnP싱Sf& `6{ң׺^)Yǹ(.jpfk^F*R_]`{91KtvP@&zO`Y.7?-&Qwk yCx0B .wĮ Z† 4o-(*M2-u sX!Z * Տ&mHƟmRiSL-RLgRpCG:O6pd铣[/d݃1"W;ae,?ckyԆ_jV^3 :#KtD^ѣ8a>HAFkpՎ]ri);g%$ "a2L*J}D"VڙY&<O7*Hѓa}8ȷ-͚sI~leCojC~Pd~ Y*b57D{x)k4Jw6?lҋzr*\ f"sWȻ0 ~qM`yMUiKpEjV\\"܂8yg?8% QOW&缬y.!. />[zz L8tl̝†FwMTz-쫔wqFFOYk<ڈߎ}BKH$b[??dMNZ3#|1SeD'# k>Y;Ok"wa"p b}da—ܹ.J[45D%hXTY[,{WL}%*E` @DIr Ҹuy1,.viS{谼}TÝƶJ+5|c p OǏ?PPO0O&< ߪY^|n2.oVv;m/V 9 2M4P7v \arpIo/Fapt(@{Jtᖇ RZøh&Qn8N2ni`(|>F!+['yaaGrر%"?bP44uK Qޯ{1RGwM<N|H6'f%i%L4FQz<5 Sfٝ`BDJRͮ61%H`f"WȤ] + Wu]N*LV0SžwTViAYJ5 RY0Vyu_2PJ||ї@ۆO=l8zT]o(%x>S[y$UԵfb]fi^Iʐd \,32':|M=qda$-I|!Ӣ4±YVDޔb(gŶ߆2j(ZtɮU9 lZrwӨsTxzdaqToB -/4zMxrS G$7D}Ϛ_6d9Mo6]rXOE#<2`:Vv/ }TnUEs3 !_<wF;ug%Ymv/ss@ȁj~g-Lk|K%GⅧcDtYr˓$R*_2rd2u*wrv:sD=M)12L,sa+^ h+C 7  4 +*ipѠu:L?nm95O*\u_U1V7cH$ (z7i봁>v#; ~:LZl 1<ڗsx" FARŸhobv\nVh'yb r9x3@>˝:q*.nLM̍I!Z(J B"ih$DWmTeЊom:g)9Hd|sL;@р'YyB%vHr'8I=Y54y't/!W]9!3P> 4#`4?QN_4ZӞهYUvʤ<69c g2?Y(& eob oT]Qy[D<=_# ~[ ek{Z7\!Pa[WK Y WlT( C9K)YSeEok+EtxVSյ&ɵ̜XWU aL?U8Goʴ e}ͮS%lR )^)*eŖޔ#hcJRio5|(x buB'n?gIFҙ+MYlsi spezkBᙯi ѓZ =u-Pe.\Y)aqȝgGs pk^4o禆w5F[ ?(eL@amd ʃ5d806De|}*ӷ!ia=de\,bZD#u8T0AEӽ-yUyl\\]*AѲ2)qծ=Qg.yk'C{1Qa?wQW7 W)gzpg.,ߓ{Έ$tv 5#&v0{rO߻7IOD!fc7W"zӐGi`j@Pc6L9Ϩ֢/[QlӾ'U-qMD^D'@AcfoKD+HPů 7v|h"'AO^&E_!nM?+JGuboA~^2zL kJ] X޴@'q/4 iif4L5 rÐh. tpԌ1?Ed^M_ 9/Zl[?k֨xVXY16;0mqv-FPsDZ-F7gߒz0 <px ǕޝӋ=@ .M҄jWU^?s4 D{Yc&DZ#QFb+"7yj,R|_Yڿ˵ᬨrobi~]o)ط'BtB H/9Ęd5 _wȯ=vQ::U񴊂=t/UX5Aw68/k*Iz-F߂/-}}x*%ǿ3d~w/M,浳9U[R?kӪʯ j\>J[gDquko}:sѵx5Fn)@k&f݀dgqʸ׵[#]S8w]T1`Ά{:!$,głU#V8ZnpQgQ1~O2}zR,_sǰJ.gW0 e< y ~'+u':a .!'BK3BhyQA7|WS^~ M! [f^'A9Rf%/˵~Ψ=, Sr")}rcb~)e*S'C3ᧁ$2Յ}m[*!96ɺ81-ɼc3$2{8wW(G D?9oQ{rNi"zMԍ;׽b_||ios&,r@]0NniWM<w_j1o8]Iy c~,- `RfY|VZpW.Y^NNO1,} ߗxVR ŕc$e1"70 w,A G\VCr%q`rk=3 i<7ԐPQ|0xm/&-GEU8 H֮R}9 %<~`8:ʳ.󐚼NBѣj5z-?>2_+#יUٖ/MiZ 3.Re2x<2XdᩉQF&oǾ<ȗEAwOt<|!2B3/fD$2lk gtc ۙ clT0C_ endstream endobj 250 0 obj << /Length1 1507 /Length2 7500 /Length3 0 /Length 8501 /Filter /FlateDecode >> stream xڍWuT]ץK;D;f`QATZJBCnA oy'[oϹw߻oaa瑳YaP/$@ቼ?__n`T8@$ PwbA~~apI"l x PAAnx, 0o8\?vr3BO3rE j.@Hyzzxap{n' [/-3/qx,)}uCCmApr}&@xjgF`b Cv`ɋBpP_D z5{@.B78R 򠕠 0ggk`8y|] ہvغB 5?Y1{ /&&@^6|1vN#u\vH) pw?Fx[ ` C H^s~ >=Y"}f Bh>c%CuDy|y%<"A1a0ߝt?wZ5 dž'M{?^Z0A o/ow_]=)C / ;9O`ȩ7 SCS!G:G@_8M#lpq_sCA:07w raqBOܐ!g*Am`NPDÁxF"r:mA^ R?ub>_HB FH_HiL>?0ot"I"_ZlpR H:V6_xl~ xCc[7XAT(Ռ\֫}:' ~~^IRV7cYsKpK`v%Sm!WJP7Q%%Қ=ACܺ~|IP`2=7*pҀS^\Լ|v/͸d1c܂_}df9UתiO-n(Hg{gꚯӸiU'Rhf|a݈jsƗwl\& "LzuXC֪x =rc/`Ja O"Sd]x8 |W!WF r?p o;:48 O}QYnlhHLl&z̉MdKeuIxH.D7)X2H1H?Kԛ,mIt7;&`cP n|XȞӃ =]#ݲ'V&ٻׇ/_kDS=9Wt"krl@WD,Ox XW 8b\;#~vil'Ȧ$)QSq&[=}Y8SJx}w2@C:yxxNQaY6qB[q |nC #Ħ{)Fj-}+dhuSѯP.{0]<meԃdtEǘy^%& Zc 5u9cr"m]&6 UѦ%5-\Mhp<Jx)4M8%մPb28e\ON\#qIQZew &]<2!X 8=ؐ m==0^d/y`BmH{[yd4Ǵ֝G&fgaWͺlTL!U$< [SqK |,.> Wcq(9/zF//6=ʧ#Wb/:-;EDOY-2NuUsMiX(o 16{e6SYqB)fD|ݘN?.G.1+] {`)XubT3?ǥ+ O?jh,|rW0ȉvZĪ>q D>9Jňy4_m}8Gc}L;=r;~2?Sߵo?¢mCnVm [=]դn3,Z9֎:%:*TEYCރziMc?V`! WF"x"nt< 9gDη lq|Y,7VJ;b\ڷ1N|CNh&\agk&fsje1 ԰$%op}I|8Obop۽o?Ǥq@>* 08,%rͷšmzXMZK&&5fs`h2Zo 4p'w`-z6ot1Xž=6okR:8w>oS"H}$#+{fo-7 P+ ͯƷpǮ*SFZ~˰doO)}8gwM0[+xV9RRq7rB~N$=⡖<!;#^6U{=;!x4G׹ѥ^) 91Ctĭ ajŭƯiv/]ȹ:r2(ZrgB`y湔6a8Jy$1Ѡ$.y1=!>fbr{;#gXDn3d'שPeu:Ro'Ds0Iy`_K<8Ӽ[ؘ"汜9M"yP{Mxjq f/Kp>^njiLI3@a.쑐eg~RBr̷5ΐ9d_p@jGijo#uG${~ }ty..ÐG`.1Ru*L7D=xY`[Itp0]r,SV })!\fnvIAq(Tz"Hz@z b=|Z//%=X{8N *AYc+W}ᝧ~B>;l NRG548M|n䜶*dgp3c_ݷ[UU$y7ml!![=*J yN Qsc u .snވ3q*#]u{} ??]]t_ytbUNüQdT6:YNjN\XYas/I &soxéf!unMJxqoƤ Q}>o-PNG8[*jJ7|E%Xm[PC`}|nFҒ8Xa5V~Kof2 <ިBKAl.PJӡ8KLmSaol*"BG[|,n2gV؂Fu8>W),`e%Q!;EwJǕSK'l] ^<f&Aٛ?Wv;IE{: Ty-L9P79 %UZx;JĤι8^ [uΈ0q׶?h(mS},6O 2g;}W^ZJi *\ު g\wS,e6ӆ^WfvUHJ\Ez8B1 Dn/ٌւCZq*j8G#seͦѫwAR=,7b[SΔb'nquQr/+p±3chXxYŽiZ$}ZPrZN"j=Cv67N销Gɫ/f!99)f6> )ޠZ= *?Tނ|% m! uٌuwq'A&_*_3֚g8R(y[#G l~6NU9;M\bMQHB o ,iEG=IïtvIoFenV O'j^ s*|P3$u LU0HoJAP V^k8g^]Z#>;s/ֵT9ʔb![^|ઈ|uZDB}nۿpa.W3BMX j_CϻBbZ&r&xM/:>w.0ISS9k?L&k |4L*@"A,kkǧ=EwjnnTs,X2y'pVOIvf97>bM[YȔW4kC_xR`_+`f}JDyZP.ZeZ0:h_0{>7ʠC=Nsn8[UЮRg):4V-nY?t6M*GpOYK ,u›O[m3 ,.-ipӸOoEd*(erDH#^dU&է:_fTR!ѥJEfaa I2cyϖ)mYy0ZR[5KX) ;RB|d &kv1E՚S1Ě~iA(kVtJ[ ʑ>(j8{v6WSddnP`$; g\;`Y}U _ER[Kt<eey& Ǥ%ݢȏv24٬;푓aM7w]c*8֟C͓mχ6}3e%>ߌ#݀YoSIĥ>9f}cU?)we +lN<=],G_2o$z/Fcŝ"lɷ>My$^[jxj)3${.Ac5žzDH*X+%W52jqjf[ߒ|c? YTm%4#9^AțT2אL旁LϹjE)z,ÚjC5vT"L1p QzM]Bg{B7w=I`e&NRq:Si[REhϼp߱5p3uőcZcWU,;{$DQTb<,)ȥ9 SQy0R zo;C3k0?zX<Jи1bT BLYT.3Ϥb9ѠϖϪy/Ԁlqa3{W{_"ү/߅Ǭ x%\,MVˮr.cۣ W)%_ql0kMUz)ʼnLQA\6v> stream xڍT6.݈{cA@A1؀ J ( ҭ(HHH#H7}CzzU#Se'#\Ĉ@@`9 A`9/AkA#PH?(>p(gSbpL}!Rri90(CDՠ~'>B伪(/KW"++-8PA@}(zMQ0OyW KNTDP>.ׄ+?@=""yLQ3x `p$wM^p_d @P EbH34a0@('FC#v(PCŵwh ?7gu*Ġ֧pNJsH?2_@:9lKkM™\$ ½fX//'Ep kp~p 㿈:!`#$g;qAoq ?f MuˢFֆVZBWE eJId cE]'(_O~@o,Npoۂ%0Yg$ __/(: j k}N_jcPFD-%#s?7Ј ?>ܚq '_.8nV C9\71I) %%&)z^:~( B0#@\@gϛʼnBTF@QH(j/BE1)DNQў dl"τ?$]޽i+^d k@Pn Ȏs2:uEߞ, 8SCxS̄_o=ae%4l]mȓlN|!FYaMa_U(xum:<%2.ήy'[SM"zU&6{}9Ck[p.΁t)BşnؼVw~y>_"~CX2>M1jᅩ-)JFm71#fH;fBMYR9Ek"&SϪ Yr.N׽D-CmۤVKifB Щx̾wZѸۙ!Vg&[m21o m#=t̅_SI<}6wə5PPN Ltlil/{AH*RgA"tkSVPq63Qp5h7[1[xLUv8ػ|Bs"CT0h6WX;n{mKWс^/f^|^p02 ey=y:HQ(ǵr[1.dZQ]:]CD*ΰfoϰivo|c,nF&_3a?o#E;帝^A?t%$V7g YHkBƖms_w)vT_œ'U2^z͕7RHƛ h\x$|ѳʙsu6c%wQdbYt'npSW}t+ Rr;(yQ]D:sƔZv( b+;RhH'hZ<Љr]J7.483?Xy-kOjO#9fx7>/Gm}rW/:/lY_EB V\CjҟFu gE3JѴ{HyT*z^f5MS9Vu|sb8?5L=dכ=I-Iʹs+ot`5EQ)AfڳOP~Q#:߂vTv'ٯA0Ԃ4+}7rJ,\MmƖ%Xd*WfB"wD ^M aғ^@L A=TjPyLC2? ):?Jqx6ZK{@5Y^w.v`7 F̍bJGv7bO4W|;?KCW7cv@Fʿ6_|| C:O[L/R ][vEVUIL pP>2 [ 07k_pFlu %a1RCfj+!|V ӭK +uD"2&N>:u=4Jp^ᶓG#Elc[#OӔgd'I:Qn"iޟ;!_)4<π%Z]nB7ٮ&Rv/>(԰2x_m![}i{=hRfR&91wH2D=L/VMr+$Yzx##2Sb[N$o|ܫ2yEm9х6+f>%OUz\9VU{jrE,EO3]B7_ \!Oڟ6`dĎ米3ah]ǮmXbeޏvhh{C gңӚ,Uކx3}5IywbCQ\'^sR-4fܢ!AᴱxAF䬩D2G i?kP!q,To/ a*v\Q`mеͽqc}˝2hkZ[{W?CPQ瓡,}jhRI |}{n\Vv݊ԡ=R¹#ƺTbDZhrǮ G}_8wOd;X2lɧS+c͎Xa1d!1_OjP۴`&TK,)?߶O^DB\zaQm+k0]iVT+&߼(iX9@mۋ/ NrCK+(#RC?d/ϿhjeӏtƦKS9bQmjcvȮ4JUvԊDE,;uh E]FkI!pzscuӪېygSkFxLݛ^%xzZ=3]!I?<<0l5Si@S:Y>CK3,%ž.Y;z$N#Vɭ)]rl|v-1xl7AʹsL!FZ]5!M)c:nPkZrd4JPqLUCFe]*Op-Y6(7pT}`"ک^Xl"!4 7"鎡vwGba>vAڢT |sq=ofRgR'ɗ~P+}t*"J!uNXҶBݥlO])߬V{&Hz]DC ?RrY70%+؋h,ԠjR=f=VLcJ;tcv7ۚf~w+<3;bWk#^-;,b_VX$玕71d&3YP ;|iafxJIDigD*|~@U{jZXY'B~5R"!T`P 2$[L8w/k3q kKb `XVQr+[7:$^D0Aw D .}2M\Lke\u @}7\.or[u%,WKvv %n⿠/m0 -sfOFpii!]tAiGP7:و)PdFZƮg'X+W^yWK 1>Ĝ&[v`apL`.H3-S`t;r;޹ajy9(8XaMX-D3!1hspT~hco7S,SzQԜH<8N3ԝ,貁!b\5P5]]N4u/Bw6hZT"h{\Y6OL|ä%=L]TlhuOtcHJ5|,RWBgjeBX6h"A7Rb_ބ80Ѥ Mmƒ>"'wz2דhMFVGEm8̽i.ۦ"RҿZTq"YTk;bw>mu]CJamdhӕsdkr>zI+ݹ"P-[)mI14Np^!rϯ>yrNq4๧-N/o?\, NS4Z$ӥ*\~dU_45jv)ݕL>#i>(6Ztax1ַdRteێeX+'kzvV$rytP4Wiĕ~Pߌ5"*c4h3Z9:Ƙ;ʲ"7҅zn*q; 1tloK&v+1tKʻiLmBw#Kк♦ .PGTWSK*qdOJq!!#i{}%ݻ_F^fU+TW?A2}v%ب^?XANNX@L. ԽT.6+=ZΚB$y T(Sf=$ǭDUHҏ.4?]7>M\=|`?C{^-yE-G{e&_f77>4p2K>c8I! M d ~ϼlu>>f JaFXiu/>w|gq_& kӴlLTI,_6Y+70i\%vA#3)`g\hBgPu>!HAr: n̑핟֮eT}i*Nx:-a#s~u7fS',q2f{3}ERXG4_|mMQPYed92V]PDrlsiؚr]J~Z@o8eq&3=,Pm5g޷]Kk> stream xڍTk6LH #% "0P3 !HJ(- H(|oZ3y_^ϰ=7UBTan(^>$@IGGC@AB66c(򷞐@BanB(! Z B:07 @@ *) & @0$@ 4an$! :8y~p9b<\!(!` BP>CK{yy\|0,' rB'e.Wk|lcG(OB@h  qC]< :;HC k8>w  0 @P@OU~A.H lр?JT t#p u#01)\]!n($=w du݆ P Vs"@q1!q;N`aF6 P{ PH߿ - `u#':Z SF? '0;??_DMYݘcTTyx"@PX ~8 _uWwA]_$kC8L.ӟE`3p(WoE..9 W_4u=P5Ёf?wWbp_ ^74yHU7N;I?&ч!?6?M $zPo^C }"!D>Z |n09`C>h1Qo #?!,"Bw]?A~?0Hÿc"]@HAD_{ At0 op~ sj mQ?*4:S7YK0ūtmhdx76X3O00^W{9l^rf58nY>HsI{@_PBl-D2aɦ"MoW^~fp֌ YX԰0"sS-M}Vǣ Mn<烬.K'fYƲKaAɄHms %_H 0IITX;j/jNY)'Q5oHȁ0O.E5ӭ-OEzՋQ3f4X-o@;'HdΰR};v8/e/'AImC]nۮh4\Zwc>of͍#pXeދh.o9 &Kc^@~KM]@N鲋xQanCӥ`-ARvK͋Hl\xRf}?<{Wwߗ@Uj05 r"q>E.8s,k"I*aչdȕՒ4[b? 3H{y}nE 3 ~o:q#>/z=C88_bc|G\0+Oð^9S뒄}Bm^jJmwŠ"Q[ v0/zoMqG12zCu_:J)]Ϫs=8$#|Ov:J8VP _H),s?Ka&,' I7++0@./'_jw d]&dJލ^ͳqYMAAA"O$[醥&n4آhT]PPr^% Z?>gx~Xhի5yy3^WsH_uD9U}!(]NN@h`V(i=81 ўhbJYǻҟx{C˚˜kKY%4twǩ?ߙhSDyjҭWdAuC#GWz0%{y>% G,rqxFp!~朽ײ= }J)N_Uյ-z8Oy.!ژPMMCU~2ɘB"iQLρw!c7^|.Ho[R)0'S|CPtSI3-ߠÍ̟ -(R'EpSZyY-Ʈ!kϢ"ԄXԬ:+9/j;;keo̯2HBi#Q@Kkۜ = k'هRF(2ȷJ!!om Y1-Ϯt>czo *sd5.-B?LT!I;C?_!VU,xk[ }%QsowmLH?&d"1`ve=H`r\Ch &L9JHh.\xK`0ùlcku£'S=yX !/{ၣ?kF>^JUwU?wǮKWy3;w" yFInPU)Q!.'I~",*'MA7&l\tO?(n.$K~яcc; CsC+WWӀ7&e?N E+폜3f*!B7kv?\GJ8*()gqxOF? `E U:EU=sjTj dv~x-$zus5oIFd^8~tmN%#μn#QFL(?mm79GL:>V(b"嘷٤#G@JqdrbF/eGJ+_`_֛Qਲ਼Q %JG.];_[ݙH%V&F |7تKr*-+(hNauJA0=|ÌMe)q)gnw ve~>O~,w7'omډDUOG]n*U9$gw(#zkh5U4bqa(Fj{nФ_] P%k}tE^`,ZcZN,Ȏ !8z(rhϱ,-T?z:\IeRCZ{]U>_،Rbzv=2"i&"%rw.._k; Mb.q*>.2@[&[9--\&SVAV8~YPgsPf.,"Te, $?'Q);qqw3>2Ls+HQG6z[k瓖q( qtdH~ >Qja_MNtwi9 WRv D&+Y;iv XvJ2⍈2I;Î>Z˯nTo ?_h]%&#?2Gt_3+vtas=_St,lɩ2t`nk蜬bS 0׷v؈`$HŝGϷqm 1 7 dHr->{+N*fG4F;oo.ϊE͠`i_f}f&"FiGO43G?Lv1rB"+*n,] Tn5 sJz͝Y7'%B!`)Ѻ=o&8{VE#6¾~QyLop䣜6ߍjVn͒b $ӰY ox4B [>oS~ ɀ$&h(Z?XHQ x"C1gD2#/2Bb_} '׽dx<\}7o Ξ> j:Qa[yo.jbSxˆ]'\4|<@V <M3D4͙Έ5qTv,:K9BizyڤwŽ^!+8LFwK}A!6]RIhb\jLL>X gI,Yk.oř05isԼl--kRGL׿z6¨L;-fbJT =[l:'{  .[zdWM,r"`E3v>9eޙ#%b1wqN)emjl]GDOfNJ+qMQͨ`YؑoYϱQY'LY;^_5]!TvI3dCuil\t$^.F%씯ȭpnNڲM\.ZecDI69R_T =y<]a^|ѥFԶ8t[@98'w`qȖq_LV~r1/9 Ui`0Բqw**BdUBZbQ㲑{oSIt33民 _XrþgWSڞ]ﾅ6O;+Ş>G4Q#;Ǔ.T j\jFߌGHTπC۷nM.싫Ū}˒oIJwXYc*KVbĒaqbQ7ruS3/纐 Zys|wra(@J'4YjDZqBx`S7J44dN< 1~P.^pXſ >-1EUuCls폝:ΟYGnM_Ǝ1t/,/rI3:6ί&>aӶŵ5z% L1zFә}D z<7鉧ǶkQ]~&O??[.ǩc@995yHqoaw`zX>!H ]<El HNҩ6<%J%1ZsP9LmrVxꋃ.?GsYFqZG;%j>YD$v1r\'>Цg9BuD3ݽ,J_(ͫl_꒳k߁H<%7dߜ|t;0mOdRI(dAekT&޾L.{FDd׺3ѺFWebn;Q^NYzxI0摧j ĤȜLnK=uUkA5s]ühz[h$wZ$~'oJ$}0u9I9]O$oCsg Ԫiɩ6Y=o|'– [OG&.jNE_0,oenOO &/*f.T?NHL;4ѾsqXVM ?=^/|-%ܡ${OpAё}by] C CEc g& 2JuE9^L#lO@oid= [bzy\f6I)Im7.$i+ʼn`ʓnFJnm#Vel8HŅ#~#f"{9!"WXJ@%}_"2 _ʇxWw< ~/4Į@SB}rt=(~EXYL(07c]1U@fCQDKqs{_U2_GX0-Wr{-#гhz:fsF1 w/[Rma)-ae6O.r*waZ.ZUDZ\4t.!gEt/.UaT`gH04`Ssخ3,뎑yjкCrC0׈eZ ipeQ:M-ʠ)51 F2n_=Te=ʃo6Q;J RIa5{(^ֿIe+ُ1TJu: 6&JM6\mV*L>yðC&Z4ЎHCeհy SmsHʮ\=pb">ȻO1SaYYC[!?h8 e1i?5]<.*^ }wS|G 8yƎ up0aiw?9=nzo.q_63д oiJHPSr;'tꭉF8yӪ1~n!u " bKV)yA8tyJrn yN0$JM_O>K+.meߏX%z~W7e e*|o2hvak%;[q1{w n|'z$Y3'9[x{ Tz\t6+E=\gk'dtp (4S4 4.!rv*XлNwMTy̶e5$ѓgâzZ&z%~OUb;<9c9Ӕ=rͫb`YJ`˸$ԟw^¥Nҳ{1@cz ?7r} bsol-Ij̞hhC% . i~n\:#x;47z{`V·^:l(LhȑfUy|!aGS[´lC ѼzܟqVMJ"C 6M!IέL6(QpٔLjZ]6k:)d^17/3y ЯlsG[UtbFjCnxpżonAT}]7LF0M-_bH(’3 iaB<-d ;.I0Pw&_~aT$xh ]5pI(޷y?u.|wEC);F(Hh-NA3W#Ͼ!>໾!:'ͷD8B HRV{h%+[ ,{] S1,jUq, g:d&L_<֫Wd8tWi+ƒ\@UHogQI(ꉯG7cx;)k=s čԃT8QX?ڜ3_Ф>RRl9cGfoBUBX|[(C Ez؝A7uoI6l׎yΣ_k|%,I@D`Aw%m;06?T4 ;R&8 *a L5ТQ BN[VOvfjy7ĻǯQy& O yV/ٍO?-wE1D*N endstream endobj 256 0 obj << /Length1 2730 /Length2 23195 /Length3 0 /Length 24729 /Filter /FlateDecode >> stream xڌT .Ltw "ݝC90tw -!HHwJwwKg>ֽ`7Tde,lIe v6' 2-+Vb v@h IB7#+`cC@P;]i%^ζ6`` nt0s(!f & B6,f.,`gkW[W*bf2dZrM3l-.7K3BДW:6VY @9YXlV @UF 7s7C #0Oy.ζ.,._% 鲴$+?)[g^O`e`iK7GVm['7?&o5 :6ky9RC*q; El?>.f@O2;;`u@"Z!wAvO!e vy6kJr:ZLWNB ab0sp-/èV`B? #࿱T~/7ῢߖ'$fKQۂ1,+3pߦVhiffCwF[[O\וlj`_3d4K9-7G d%R!_Ji 9;y!C Av-Z=Zb+;#(7Uo`xU_@o5?U_` ֲU7F\VoIG7AUE|v§A4#oioa 캿O_B.o~@5 1w6xs\9}7* |"nH0 03rr2Z!  4sCrx~qrH8yZ`7X~A?h 7'K96w\x9gt? ۠? dT yԲ quzH@QCqs\H.G3)_2[sArs"q=_ 3}%-AɅb_cV΅6s11nH ߢ B46?V[Wn@ȘNK=in6t?vZ{1Z\$K/qibwO{7  >#f_/`c3"==+;Ui]Ěy`yQy6vzZ@d)mΐ)69^]X7RzZ"UE={KS%/۹5SeewX\):a4n]PDHXUi1X#R?vM74mF`njx4LT s#- wJ8 ]-ọᶢW%Rs݊{Bsg ;^rԴ0@fa.fm/R=Khj|^1A98A*7~ J|".*aYCv:sr7'AɆ+2r(((ZV*d}Nʱ[kp1Yƽ +6jӇY1S6_ݡ}Ѧm%tr8Aa{FwVazHXHPBS}5qg8jXXOc ,s]5 #P %Pt><+F7\TDװZ?Y _(EJH y-0G)҇wrMUȫЀV &7HDC3t CDe]nyyEb2#ѩuk9hFhŽցGKv3MdCfȼX.'.及 &> aꋻ#Jv|-uo mW~<5@ɣ n @;:l%Rqup2Ls(Ob惉Y} C6*w>tvX%w){*}.zݩr‚rEsZtwVX.;A-j:⌚JB%8%9WA>m( fdҡB|4fX]Z &0O`e4]'҄4MgҼjk3 $1U|l(3䯜^3cKe߼G ܖRu(Tfu$t%Hvt5l^-:o/li-iQfmQ+"41Ӊ"=PϫDR{tɻEJt|'qIkHr?}g!F_OǛYp˭{iT,Sf5w Y*zTΉ#8<9]ʢjt<3<:WHxUJfNQF+>=U'(hϞ7QDٰ[2:5hxkƥNP5(_w)l4THt1~s26; N4R7Xg%!*Rʲ4JOtI$k /q2u?_l Ɗ',}۩ߚҝ kx"{jv Id.oq©\Nhd/yKn%٨,\5g9=,*@bBR%n JrRA&^GO"luYd%n$!Snk<5?a'Ghd WݟY%94KKuXQ_{1X7!m2 $sǀ2N<Zpu:aesPOQ~F7N(N K[PliՖ.Z<BZK8VHMI| 8'g A 4F99ڡJraeor=Uj1Rv1efCc)PjQ.nKKE^%ԫ_D'tȼ,Y?5V\Y|T6 )פM7I#cй0OH \=KZ}=vw<"-bH;:hu UWڏϩYmyZlFQ':ju9Ld:8*( 1! G.S!Q[Y85~idT5҂Yv>tcC$\I48.)=? V`_f4 _\3q|Q(%%)},Xt o8;Y[0]ULf) 9~n6gޱw~eBfR#]1~!>ٌ|9ѩmh9u!cwK慾k\[Xbz,Ej;%n}Lr0qadՍ'W\X>C,4.>͚D! {HƑ By +qWkbOSXbnH5I&5| zM>V7@YM_xjL.5\8>~tw`81MVJvgH}] rm"G0&\ TZo)LXw*lx<zMf1#'d5A ѝ>מ~XsCih@AțUrZKy^JY7nLě9{ Ww(O1Cȫ\o"MDJmh>wC;Q55(x%]P{)t"JvQZaH!霏f$۶?B v?Fmuxbl~GrpMgsx^ 5(>Ni;pdVx{h*0Lax{K7c/>[1-4.怩^}~=~no=lV+7!ԉwPR6sKTuG3wWyVLĎQHtS9RyCpHGJa77= OQ}=Z}}(V0ᣨ&&Gev'`ɈaQ3^k&yջ9=b)8)4J̱h\YEUȜu:<_W5"40׽er[1 wd1_}DZ-2VQo)79|1F&%p$6+sB򌂨׾V-Td;e(#Uo2E X~<JJ4ޘ$E5>J<λcꔳYף'5n8LXhzĺވPY1 iLy#Н+~{~"l~uFT>xH'=gn2YVCsaj+#0 <+Nq&V- +"mzQ ]h̍bȊqTc0%w[.a~j5q J?usMjpt %L~MzP2ZO^Np0aеՎ}'S|) mhH"/􋟵a):Y꡵Bzp LW/T%4oBڿ@ǔPuNwe}k^46/FBX`yIxPvˈ.i#WҹS߻P09MPR^Ĕ52m41Er8HhfIPsK-zBD> k؏!195vJ#M~~li儙$ޮ`C>Ro^߆1^#: K=cY1Je{gOFwNq|}.fqN Ь^a)Z\SbٳVN,F3+nL\AR(Y/H84 Ԡێf؀@;@}3"'Am>L/{"-[BޗCb|sk-5-Y/ǩ<j_\(\ߧs^J[j.h5i, ]w4rv'N릆Ư0&;RI6 MAt!O1r#gGR7OmtA3[G\$.y ]ҫULytޓšohW1ÛK.1"ԨoRFO`᎛qthj CzD{eܾ7WUǂL5B遇ЬU^FR9T<\Y&Uczwɪ뱿0@3"I'Ngi} wm~=^ϕ{';^+"~9]w-];tӋwuVWT:#ݖGnbh񰫣A"^F"'3aFm 4{2dS 1N UAܢDH&rDFucՒ< ڳgs*.yk쑤;UQ?ZӺV/&dD/PI'[\V' ^*GΎ\Ƚ9Sc,͂J}Ϧfx&U~XhXxnrB]C=mU-Oc"sB[b$ozvMc=4;EC!aYhp*oVA8dGjR+FIhJnQΰt5x=CX?P?MW :C1٤?3<: kDWjWڻǾ/BsAG;63|~;Nj7#9^PlW82=fÀ-wծPʨQŜ 5]|! 4n"W/Q*ɹf"у{߹kRy>M]֔> f|Iw;A2G\ Bm&Tg3,bf)08.~7}GD!ؒC25 XHyrǪU mt\yo-Բ^rWm`+ό뎮2Ѯ9FYfy?X[?S4py S{<^,š{o$l,zs(e7yfE^7\p <[z0[gW[zIxKJ|!=vW˧ϋ;4_>ZҭiyJ]`=uSM˅b ">zB'frN[K$-- o zF8shp;ߓ6ۣ;1Ƨm2@Pf(j^nrlϻ *_ͬqwȐDzwctbK-d9ZaDgDV?4seuHjk |CkҝH <oęk7_ ˦k%E'Yɳ]H^:LptM5Ny]6R{.Yȡ6-*ً//~Huz1Vt濽?:#6ȿxJGº>eolCb{\sՈ0vI T.b m.m1Refskc\%o!dF˻2/awĜ{\t@~>Rk[&/1TlgMo鬧\*w`Sf<}q{#p6uЬïyC:b:1'J4Nu~eD @pJ6W,0XYv*igG`_V#s!|6>U !)S"岒g=-\5?ŴO.(@]#ߙpf1VA_&}w5󗪐j㖵GjA\ׂ7Q;'$Kb=)=֤k7j9[^oB1L~9+h睙.p JjZ忕+IIs4f3Mޕ2CZUaV;t6~E@ YI ta5Y!7鵕g5=MO!ڡ8*Tgت/+)]"Fɷao%%C~Pfײ4&l#LguJJoԨPU|@FEH;3p) C~r"=}!T6>eU>B,H\L.Yh(F.X|bH+l J":WNїQ!lD_j{p:ʀܔz'm4h>nh*.2fG²xr5J%b[bzvfy%%䌭 ;ki)Ro`tKN"@'hGz:yOV\ԟ/Qm>Yj o|b|78l\ 81PK6ȉn;/_bC[[Cѧ?Ѭwی6Kۊ*bcQbWmU+grU|r"Uϭi |pjh0bLbn}Ԝl}Im8yFч]|#\DGy5D#{+fu2RH1ےb7mUfҵw@wsAXQ/R"AWI8od(3 ^Bhu ^Lfw6tHqHM8%/~'G{f' ^%7+Xz+y]2,p|a&y80exbǵ$EJuhDEE[a`fJ+-uluϴG/u2 &/*U_"<r{N">cy䥕*U5f eRjV i&~y=ƣbU~ f3QEANI!xBWXv֜Dzv湞r-Y?8T3$Ц5 ⩖Ea+)`B2%i,10f:j`8Po.i-ϳ[V ߏ'1jT>vݥg7<'qPOk) Õk'eֹ;#38-0McOtجMd߫ʢA|σ>x9ZJka$5dA.,5ŀ0^jqQm_u.mg5AԓXN0Bdq,jPVd<ה؝?bE\cNdЎ߾y釨XzW&ݓSޜ_h5\O4XUkn GŞߵXk.k>#Öbs9S\qK@3_|:h *A^y~O>/^ W:_qzra)>9dvsݰ=qxGw[mVks $TV7kkܠuP%`zؒw(A͛  ma7; z7sW]bǞÿ.dky4_}"Zڪo ̇4ѷ&SUx-̱UL<d a\ TN Nppao9<%. 1im8KORu܋\jg!尕t]ϒcQɎB7g#u\崂kziE'LЫK[cE\;k؊ÎXl_*QeO_<8ѓ6aa0N.nwVW>1gb 4CSzgvCӌGiFls I SPޑag:.wN5m|,%hjy$LZeop?Bkӈ;@3}\fnZ<8ה@RR`Vf a7 4C|'9^&OdZo;Z޼{vI8(`>yyklŀYC ൃYCaF8Y$m${AK34Q4N|cbpwZ+OX΍egM8)噞$Q8t%t.%G|rYUT|COЕ$j,CK(šN 6@Y*FZW⤅zd(BuflE;zm:FHr\VmK6^Am`/뫒: IJ=} ۲ 6k~r_1jM=rw9Rim.WߙlS35jQ}TJ3מM: Cs;m>ro8B 0deWv>< 9ZVژ~1 #[]L\TֲT,\QPa"_RWC7 Uue$GO?t]#VlWVARy_p7 [ &m6eR ⳳmHR-Ѩ< pfSuK+-{*ab7ߍƈ'gS!Qt: m83'?/L2,M4Ԟ$ /u!1S*YQYؼ?ýťT&P[3 5bLfb^o ퟾ҪEDZ6F&KvsQz\kF59y9cIμ'iFߪUt !n^L _xzÅ{2y@/%+>c( U;o?9D|? k'I.J>UqP&qS8TUFR%Jז'Z tQ8qnp 8Z i+s܆m+O ! VMFvN61fbl70uςʄW{bH} /K 0F/Fa2uH3 q9v 7eTiD+)3'Ӻ|}*h$]T/CЪ4P7~q޴v`$qe}D-NJ xC}SzǺL4#ǵb˸%]N}PY2>?'}ea|64lj u-j3UR~hv)$ %ﺾܩU5-a}gYr=2[&'D&0ہ놤mw4WrݷT0krG?.uvu{ݏZ ྑ bJ5 Gl]ݻ9Su]N*H}y+2*TU| |#ɧN SC8!c2[ +G7Vq|3ąYxR=Ss=b,sZkP"YQl B%3i8{+NJ*:lG=߻/ufvS]gi\☱tłn?at ay)w)dѠxpa䐐Z^8 O24k }"q ʬ3}ؐ#_C\yتu|AmH9|X)8NZ=@s6}#y)8|jb{OҠ&yזaϭ4h[Q5b;ԈXe $SEW5m&3gҋ5gƳ׮>ӶGVWwq=vF`._Q#2Z>|:EOuG|q歱RIn- .+[Wmkـة D=5x]YEܑ\=49/ĘfGOL\9;#.>椦2xڮJh^R]// X^B\P"dg8 &aT% f@ k꥿Ńu'޽+iFz:[Mi .ނFV_RN 7 DKa.Aq-ZppX(yfPd* ޲b&g˫I6;f .ܑN`dq'RZZJ MQ*7lE܅k5u5/Ih!P8Umh:_nks+54V+zR)WjBd.Nm<*sk8o;٢ژ֎^9y9Ph?SR(&]㈺9nu |Zk؈e5hD[N.ʐ@%j 7n/걵wO-;)F-4{>StH;}clGSURWlb}J>]A%kK0z@TMcuNdwW/ߺO,a:6;(oMgqp;u}R@$x_o +B^&~[Mo= Tn̕ӎ^,yIs(; #G~6kvO={|8dxliED_쿢NnzݟXF&> izBAqzsxgL}*G>+AdȏbFhov;9ҧkž "G%j<#[,M( !YLC](n5>=a<6킻xmDŽ&ʹ}ϵhUT\p-hgN&k$0zSURGkyE5G'V&pqɜEbuf9%yo6CyJ0^1N>th;\`/*q*|) ʏ) }ݚ$zσsp=~c ,UW$ufʫ|0EIW}ͷգhs4v) em`x7mdDg@ :xőx3m":Mij`WX湬\6&T/p<$˳Y_2seFr`]?%\6oNں+ F N)I=[s5Wq~LP@wK&=i}ӭ+lRc vx2Qm[Bl{_P:=75yImxYV9 /k_@n~ՓAݯ̿`I:F6Zg4:+Ԋi!j'{*jͲ^Æwٷ4ޓicU;zqf0 F I')KB{ݙ䒱4[0B^-m̮7𢲾;]R3s;2r/=\*O:"]I;>q6w kZ:.eIŗ(1T"ҏlع(Lh5vmmĨ`PΑ)x1)pcJHZ֨v;>,dx, ʤ Cw uK*Ge G?&b ђSm{Vh2jFӈ|W=N}F3.6yjD+0ٟbAPńj[5ŒQIu5O `ď[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 1596 /Length2 8471 /Length3 0 /Length 9517 /Filter /FlateDecode >> stream xڍTTk6L#3H "9C 8 H7"H--H#~t l n07Hx@ ~lffC(e2E0N Tt DA ?$C78Pj`lf7w_8q?@6[v ow+ÀZ`#>-hf |+#.vq;HsG>5 Btƃ 4tz#p^<=9@M1ck6@>+lkBa@{ ɃAp0_`{7]9,7W{p;ƒE_aSpsuؿS!cs07o_ Մ; ɽ@"b@ ֑WxC_wo%/}n@& P{"@+a  'b>4sgqO/;7?ϗPOTO|@n~!>(PD (`_UqUٻ{?vOZ@/gv#(7oAʞ..l5=g=r@Z5~`. BGnk\0׭GwY7=# )`nv6_Hؠ{" W@^x^ DD(Wo$vlAb@^ۿ=>{vB?"@^.]| /_>ۿ}z?G8_8kp}_A >[Y7[Z9oRS[&Y N+|tU\w6Ne7miz?R'ڱƞ5ar~ y`ڊܥ\S_»Oŧbi$jvKKu$wQyibʇn}OϦ )؁ e/g_{tS1Q=C=%`P//[dΐw>saֿdagE%U{ڦ!C0'U"6\:;!}L6Gd XP4ra ~LuŊ2iS]kgȆC^w!O>CjG~1^.OlszعRY"375IԶ*p<%oȧ<kAN`L)jhaϭiƾ$0*#zxٌ>I2.BxUrlRxE)7H@WdéD!K^[mߔ"{c!J\T?tPHw:,3}3oY~ ލRᾗ}^тYB.}W7}/90iPEJ7,1u0*,Ah 5,c 2FL%1$>h4%^]W%z/,&]4ެ|Eǖڊ^o xT `>=O%ɓo4M$9׍c$Ֆ!sͯ6kNK? ]u+}X6Xg b)Ǯ 1h7GtZcژds')|&sAҸC_ kdf|z'B+o=9'u^+F XtU1e!h%sonB~7tOf0%͡܋ Ib9B5=_>o9 nՌ"v]*,X2?e83gl%J'*=]D0 ŸR3ޕMBYf}XIsb{n}(Nܟ}o/4:oA2h+'Ic^}U/J>P)eZgGT 1@1Fjr "AkiaHﱴ`vV2E6"ιN%^akw?8[HP~|m! 7u>hjr4Iat3,զdz5/ fv|mstR,`'ꉽYVt#辉 a% }ÙI"NjԘ!CY7 `̸wY"8wHd{l^e )҉gYIj**L`iH:cHW 6 f/R 2j"R J: rŧ 67c`B'Ig 9weF6s] 5Ղ5{~4f&;Vp +h25Jf~|-0U$~imNyĉ=M\綉w\6|{p*q `Kbc:6~<ӑ!JSL*\J\MձFOɯ˜* e OEKOrWbet>E$Q ٥RFc: \F #"3j%J5j\3!WBf=lJUr O#o+<']m+xx.qLȓfiiewD9+?1^H ~ɑsNI(# _X8ZeQf<{8Zۮ̣5Oj]"GI#1ȩ9YC/Rt3YǗxѝ|F~Tc94r(ZtkЯ?_-F{d%Ee>s osu7C]ixmXP5 luح qSi萶|I,U8Aɪhf< +}9ESymЩ,78&#ؗ" ~E;^T+ KD`$eEU;ާZVƥӌ)̺VF>FRŎ٣\d#a <0ngkfPoj~*Vg9E'97!.p"q')j6 YTv8᥇o #qeN{|mוS4-wcߟ56V\rmj!^p`gSR"uk {[@K`l*pq`y?)Ϭ"ɰ#QJƫ32tZvkbGarWا#akJĚXi4Uǽxxa`6SMzm*ϺçÎK]ClJj&䞘~BTg^sJpmiq gݬSb ) k*$h* r|Yuz~(IAHN,[` ` igƵjoƻѴޛuDS>9R7c^_vmɕ6)ÂsMJg_)m`TݥqO2K5JyOSrQs=rޣ:w (Hub ǚ'_ieEy T 11Ѩ$9_πy>Nbkźz2x'hw=v0򰰑pHAOߎ?%{X=Nx@ 9s9g #%%P7 K""փ Lh5UZ^{t{ ,}q190ƢҼ>G"3ݦ/"oJ.W`Gh%uYbwT1)=%ĝuk^ Kl+yyc% 524;|Gy>{M*\N4ji XJ1{ {T2rׄ. K ՠQ&ז{.%F $gt 'n@)g!JA]x28,5+2 Le=E eҮ%C!W}$֋wp09hp~#up= ńߘfceof-v(_ڼPoh /n,qf˓?B 9,24_[B12]{?K}Ek<j|!4g5-9HQz!&[K#kar ;鈸!#x.Fn^e7qD ʍ=%ԅU2φ?D{|n`>m/l$x-qɊ)) ήNEd.L-"gۖr@z[a0OLSHM8%G9,h=}/@۶exee)5QQ 8~k Qp*jLJhjff}^ _}: /@b-!,yUC׈!|EoNGrhWUX ߘLzkQ(ԥ8oTx2i4Vy(q$v@Z? UauW'Cdy WѷB3mnjt~s15'ci`7B#\k-B2b TC1_8dFKGMY eUG>4ztN4nimsF#ݮ^"O< 3.y \.oYDOYQ-ơ?[-l^d([A.ur< C̼ݪ0Cbkx[ܼC2ΜT$sb9 =#.jtERڑ4|+^q$v4nKu8ru*W]$3t,dI>22*\&=LOA{7^36Eϝ̢k Oi& _ÏO6q={ 1*{ꋞc@l1,Pd|u fyp2Z_[?b 89JoІ[/PMHf_88-DIlYN&rM1{l3qHVԣ C |Dg/~%ϩnp IYK4쐇cm0EwGJwmiɧK9Ma({TX .eDp^] .lJcsѝmMy4Ss֘r& k!KϤ+:( Qu<9/|lK{^{"ZQ?grOJyB r08(dY:R&,mLVJW@I.I˰)l%FwQ1!Tgҍ|&TrQWff=-fYu b"ST=AIǐonC8sSsH0:fO3ձa<*lc5n;%IiLS~L[`$!8n/Ypu^i< G u} h.:XH_PBN'N;.Ҩ/pI[zUT iCtT`b 3g $CF"yRYBhTpD|#@|#Yj<&vhPyX9چG; v(g8VЅ>ռ (f`U"?4 wc"@@ jCI2gYwtl"7=8a[D2G1\BYct`ts49闃 $^V4MJ-ޚr72\.t̛vnu^9*{ň5~7G#3؄:o)|==8,^5X6{ "9zi7^z%~4'$0'Wd]6̄}a"֪O%z_Ѿ"REUꍦX)lA1آ{e$%D>fS& ݂wtKcɧ5#E3#ጼ>XWE.v)Nu=#f'F@ͱ g׳עO.pi)J )ʯ7Q )<p-|)1ۊ<) '.nҠ5?B1j%4jѿ|9Dd9t}_aWnuhB|jO:ét]x?gX[#ޜ+87ĘRSb9#b&'?[i(zZ?%T2l,w*+4uj{3M[U_{Q؂PQmIߖǬB@&J2NԟZm)}3r0)Ynx a=d%af=hl2%.l"*A>(}G.̰g< gSZa$ Z\80 .:kI!opݙF/ݘ%tdSbi>FK<تA7So" )c#M_-af29ROUk/EF$geuR(dI8iikYspΚR[KBz:V;K:7uD +C&QMRAǼ]ӫF|y-4I_Ʒ(EPsۙ3-acwZޘY H8|A+$ SgpQsǝ6 1^Zj鋭~lDsM4YL24|.bzA-œ e0S/1znQ}yzs BOy!GE8pv!WDyb'!v/bk`t-@33"༂2 ՟t1ge/$m&p|JJ|M.w<p<4{\DҴG|`1.ˬ[ %\cGqɊ%۲#hls1oIp@~_w]`2Y\OcXvHR ak돬lx9G7^\JX O\^(5݆A=8Xsw*@y9vNp'kq@2CPmqHPP᣺Go )?7nSC{ike֜dsRoSH]H3Y߿FF7Q&,*ruW%צ +oX-@mCUd'?1b1 fҎ2DjP$ʶ$V_1Hz0QaAc1>kN< |H=nM ZG t a@O~빯&cmYzqW|[t.@q",ÎǠߒ(emȹIKՆuFnR9f9 8IA,Nx4|ԔԾ^(yѹk?t>P`)T6ାF~L1&t}xwe!$ ^ٍ|{M5 xݠ[ ]l+`ݳE%ragIn:ǘ6 endstream endobj 260 0 obj << /Length1 1645 /Length2 9864 /Length3 0 /Length 10920 /Filter /FlateDecode >> stream xڍPZ-C 8ݥww ;w{ x[x;3*׶9kRME jB\Y8Xvv.VvvNTZZ-3* 4w}I>)C!7;;_Pg; PB.PG/g3Ϳ~-@g9lj ?3Z;4 uuu`c`5BmD W[b=+*-@]ja <@@s x&h+T`s6V'w!dsKK(A@+3b;onr0xss:yst9~)KC$`0?)3ؽY{AaȦ 9 y6ft𰳳N-Z^8BC@/Tsw * d ڀ lZ/ 0d߿e8x'eWR1`{$$.. ';*j`O< SW??Z*gѸ;g'Uo߆dr 5e@7T*@nʻ?8ry@o%sAjPW?Ͳ~9\ 8M) Z0N7sggs/Tg!q|8W ls y\ϼng"@g"?3_Nk'_Z.C-CjBnIrO FDX9!Ɩ-lay|d&-";쑱|yA3$Wop|}@;˘78"ZV*;9r5rcĻ;˒WzUt jx)Iki>Zty]vAO'a/q%$p5m[W1:M#.;/}RKbǎϺ<YU6c&􆵈^kJ ։\J~uw3( 9:; q9~T#[\̂46O~珌?Qӑ 5~XBs?(W)B}d#+W9!I8sTʒ+'A2F*h`6@v֓@u |pؗ~m 쁇t/&Rಎ x%J8$")(~~W={1*p֧U]{VK<\v$#:| B-KnowŸ k3P-FSۻa>Dh?oÌV{*^rO^\|֬7.=5+B[ˬй#.4en]zۓ'BbB臨{:XfF9 tTKhϗ˜؅JԒ m5Wao=2ug tN=G%{vjK 0̜څ*q l#@|Ǘ!0lMTBc6.Ey*4Q{ŜQAY;Mg.ޓdZvI6U\x6PTSAb;ŭ%`3΢Ecu,'jϘ=vBhgA&"W)>kbO" Ւ?Eiv*(W#;I<(If-*"evHәl3{w.x~\mJ|64伪YmGlhO~`3\M% 4j%{pMiljor" Q:]$-bL9g1T%x@;@:Xr"Q u~qsDdidEh V?Ds!+?Sbج >)ve7K*!%Ϥ~탰ZFAYb/z, /#E ;l:i'?,PE,v_.VMw)l?FMB1xR%bڨa楙Rg n~WOz~ÿ TO28"k}vlx#G:pL؍Kp!;ʆ \<|&"t_֎P >^!Hź 5kM?GԴQ HIj5G#F'دpCcpOJ:FA^6JC˕hFbr;I1YTN[RYC1IAbW#zBԄi5.ۦ4Q~V kC6k;UQt(n}e,|4j|I>J֮ݥoB"=]~\64{ǰs/F=.DC![ GgGу/td s跖Zcvcz FY|WHPKY}vAc (%8ұѱ~,u,=|PaJq{I<į7-|# ]^U-u>8 LZhZS#Yf XYÆfF=؛?|; s H~1Kl1˳*46K^ 8E H(u"}sɨB߅Kj*wU\.a#"*% M ˪jsYZ}"5Ru7rm $5$&_qڔkT;8}$n軌= ]݄NooBh^G~5%lT4]/Ř]h-pPS<.3وm cM`eD5:v_;Ror1<PG[` D@W*c>03?yvro}^j;nAZ%&D\Eנ~u{찗J_e7\)_2jiL<4vh<ߖDob8 &oپKԩP 1,Q{b9?}oc;ÑMbĺLõ3;͕ ۾C=yu^CW?~詣LIZW@1s)=!URUw}Bv C ,p#AR6HTΧߢwzv/׀%.dlD.=!"/HXG4$r`9B|02iid}FD~bhiyȚ-&ٻ #㛜7Ӿ.|Ӟ&ZkGd0A[VyG̢"d/;*Nȱ[Y5V 2;&⾞Y+!@N!R4d39Su5/k]NOf]!wDrD ڟ-w"^ D_ڨL))eVa]]d鶄^d9 U6({9]T] D`=ptRg:$^9#J1I1"PS_ 6tX g7<]LS oZSbw~ ĕ`Mdzx]1ujHT-$~ߒ#AwUW3T:Ff55h8u:e0RůEcDžaDY>]S!҃r>nɬxZVL^;럓5}ˢv:%j1L^cCxI LXVYg=\13bya4CAAn|q8sV* (x垳`OlM?Z3{=\Vs{7aku!Vr}eEӒ~Y 6?4'u;F I[-9И*Y}q7tGnFV^C j;BDL)^DCKYNN]Z~]*zT& SY?<{Kfģgљ2r!||^jcw?0iwl[?PgyBg"4; 8IUm' dI"7ޘ+Ex+EX@\nW#"Nn iYSʉ(LtI]uRt p.{+=v)?Eu~b/RVОz…Ҩ4*d>S7NbmnUAS?_V&Q"T[}bJ; ^H}FhVBI+n H⋋>,T!d ruO[* d=}"1`w;/%AXBbp\dVcO >,IGT-\Fk3dBCExj;YU1dOF|8:[dG&F,w_&DЪIטSe ;[{2v~ k#)LeS>Fw^('a2&tQQè\ѓdj@_FO7F:6]NkD] recz_< Z YB\'ZGuX }aw搏FP8_[' A_]"iy<-`|"H:ș]"FBstHpXӞϩܵU4ٵzڗVI0<{ u?)ͅFU8u 씕̤i%E{:QmVrx"a~)i,ҫ쫚Ǐ1.#CDg%5;sZ^R1 [uՓpk𡜦ZĚ$noJT\樢?Gޭ/}S걍>

Ԑ9zEP]G(1[^NХsL^̦ t5O4BإWFѪo?`8w3XpwDgVʩW>A8᰾Ӝbqy~H=WTR)CuQg!EvaVk}!;SǚJVZ=N`;4~6ޠ.zZ;cb5N5*O@Egu$ϭPv}ZSFz&,ELQ2d=U.A4 JO]RW,j3f:IHSoJLk}M=EO:1>9K`7aub^?H[+e? Xζ-/!_{Qy fW(|W'&@q X RA Y|EN|u\"iI_\!AvԳlKSr$KL=`[J>!# fǜo-<s&p eӴ➄.6U\e_R\`;x3DPLAފLsk侥6Zie:Ïڧoƞ\ܽ #^Yĕq4yCΗ p QCT'a@K޾H"DsHD.O+E "l@]{dCkZK?5\4\Ek}\{)eĔ*Me0%$~{l$w6#- 4F<90BŒi a z3I_2-+Wk;oy&ɈG\eOn hgUĐL}UT>[.W؆]b->L+׏*dԘ{XWj xd tVLV|֞3 se2%X:pReAhzZEiP!SK('/CmD)EѾraz Kئb^uRzx؄.lji]Τ(ZmkUe]IBl jgĈZ Mt_RK$n%ޚ0-*5 b0k$KU?I 3[ҞxNg_hRC+~ov !B DD|W`ٵ@G[njM{L"K""+GuDLE7C^xLVhij 4t=!c%nǁNpㇺ.Ο@v2Qro}i+Ux5QsQbxX+yGʝF_Խh+;xY1-ѠԤQ#%)er0&#P#(,mFꓽeD?Zo1lF٨1I%-Cp/i8u5>|yѬnvˆUM ذcogdžXxZ$Ox=e+pWdSwc.&*~{TP_uo W̤ٶ%,֋(`=ڋG!Z $ `J:] ODFBlZ [azMr;[Cl)wY#/R zzFT*Ҩ͓1a>u3riôG뱤M㔢5t흿[  0e2:Sbt5[Fbp=0!n"E[(F,LT;Q@4vdqSF+ M=NEF4Mič,,$Ead>&iݴ罨6 MKomge>?NI& endstream endobj 262 0 obj << /Length1 1373 /Length2 6090 /Length3 0 /Length 7029 /Filter /FlateDecode >> stream xڍvTl7%1:I(nI 1 ch$$QA@$$.%E@RywW_}~uc3QUg\ ŠB@uCS ,!XO_Z8F/:uP,z!@.X(+<08rc@3]m/8/gD_ "w'BCa04 D\.O8𶖁6+;B=}x u;i R5B= <Oɚ(gu4 Ga}@`0G: P.GpY޾p]=*tp,P ȁpo << B{]#C.p_x) 3:](pd1]0x ';<(Y.HZ[B68Qqef1"X] (W[W~o_obG,(ۂ0BoGUBxb7DoWK_t5;#|mBPEz>Z1 s *-~}( /U0ODο%.% b0@~xI i ` H CB.h >% [Gab0x8 aI4=Wr)Zf 1-4d/s"1Gt5Uf/pobRMςRLGWS#mpQp_x߉ n$l1.d<驘=jRZhEmD8 VR(^C%^0 d+Qg t2幹O; +!Ç8 =O⹢q[ߒ8vڡK2 W}\nQ6 Dcf2]TUyIvp\ uyΟɨy|uI:.\:4=̃?nn jnj-7=. 5\<~UO9s}e}6aHB@: G!ZX1"-(q;E}Z5eРrz-i,l%mղݚr1SB sZmB8$)UrI1՝2v/GJފc{vmf |[˃(~)ҦPݯt/}5$Lȏ2l\}%6r:JGN~%@8>.X-z˰f7*sonή?,ʧ?tXFԐ!uxNMg@ϖFy=iK3n3CHxN~MsL`xm6agA8!ZЅ@q.ȧv!@+LkFm2~ϊe- ; , O}]F64]a4M:՛ @G+&IsFROr!_q*;0Z]ǹmUJM3 ΊMQc_SNF%ED"ߎ5+L㖷24jO+9kD 4w| $o"Dž8a#Ӌ؛zg]1<>^|HNTQ|ƽjHp8~D/g;oI*oސ^|bHC)پˡ3+~_: )Ip^ߓ{(Ux4ei zV[b[hwe9&Ӳ_>9.X4VwO&S ؜*> g}YsrN%XA{]c*cYJŏ4_^? AxBCy޷g{(rGBtY!NvV컘WCJ+ܒ7ȵ{1Ŷe4 %)Ԅ1jɰ|~̅o˃qlk]#fCpj7~`d.&sC'-M7-*2tS]mepWץ>D,OWniLT@FFD{kqOm.pf&P4J_M|EtjqAyM⊒UMTj~#.'1HcH,.[(vKl4i$1&DϘ)6< n˛][$g.7̓?>n~`Go*q/͎;*w5We`GuX5Zv("]zN|Hsu8nmrF^ɯs:Μ]~G[qU+ҟy ޥl]5jkܟ5ѻL&ܤҪ2#ygWxyAԶ._W}`2[hV%!Ҥׅx0;m lew|CwVs k1md!2U*f[GyYa;݌:# gD^`V gOl}wX`[^jo L6Zaumu}x_p$t\1x`Wcؓ`ܫ[l<{ySPen~ƀ(=4{ޕnһ6gצ,e9Ijl,_n Onkw^ޥ>Ǔt%G^w~_8?_֢[לT>͒@)5;J?v~ jcSۏ$SLʁJ5@+联Z=]Hxt50ꨢ\_|J>kdsۇEW*e'M}eRt8ݖ)"%W#_G|يVWlW;Q)zcK_ pu ;- D? gKB([;}r mEJ4>sYo0 ݼjl3r m#^lS4)JlٞPxy@c:xFf̽$K *!j eȀIe^+qzo3i);\bG?ӓ o*(>s?@2*1u>M NI6tB:S PBq3EKx_K^抠-/WCI\Ow8׼NK\AV EwMSG'gP;bەQ{m=X~y кDP˲B'XꝮVKZ&=߽'[vody_=0֛i27KUΝٵx/~MUCgiKyD%,, Wk;{ME^${3t\{͌TfKI{4'-Ʒ1Ē!ܳTŎFm`JHfj Ki Sh1z/>ɉ BJ{2 j~: 3WD m{1 ӷ1$桳! cR%0:߯:|^4ĵX: ;hFJMh(f7ɬE_6 鐤=!B(ټ nER 9N6 2_q|=9k^LuЉ#nf&/W6$~ ̣#̢{u=Gb# >=\/. ~esmZ ә[{wZ ~ p[<7?as:YgAh' {!Y/̻|,6nFdjxߨjK)q.יn9o gLvt옇麵j#ҫ3^4"rli ԣ3ˀkbgӃRk-ρu_2)K3&C)!1J66΁~ۅefR%|*\-ռJ՗ #^8UVWsJ`u T>&gb^pj娑dK{ugke"Kmi{ҷP_) EbVY-F] :qto/guxB3hFP%G`t0kˠ -䍝hFWeYOMTq:&[ovt% gu۬!'?gBCՊ.`)(p.iG:I4.#dŽdٖحbԝXpaAybFP,r%[L-x\^-eV吔UfޟIyM>ЪWgC?)$K|FTop\NSܳE}8 > ȅ9J*~|"UMcu%F%\A ]Uo*$Hh$ve{E6UY$erXIX!|?Fyj5`eBEd}Xܭr3Rl[5xZ=J?g^ 1JұI4B.c?3{ʽgìKmϝw#zQ.l[]\Rt|ҍKɭuB!,e>ʒ_%g>2>p |mS |^K-/kUj_[vd~Q36[Id<@ )=)5Vxv׫S(ȪpEHs\`~wdpu-.F>CY~MUq*kw ӚӖdZ,#9 wҎkz o~F_vzP܏X lzh׋LsNsig#:0{~D^ΌUP] Y,gu7]DhUrzb;@}M墄. _sO=yQ$% ewj:ԑ6#ٴ1+˥W|p{7UV^0k'لZNTC.#AlDu,"Gn,p|ωM0fy&)+n㽝pa+`Bե,S}w۷'[э/z!slUj944! JnX*ӝ}IP-GU):=@?[|;bL#Ykv/3|kWDtY h՗NZ!3k&5c:$j &.k@ǽVPfH)~ S#^ݭ*y}G$D B*^t7J5kǪ/q9:F1=P.O`$D,X-\:~⥙_mK BCL1+4:JJ9l7"P~g)8{n2ɞ N⑝4'B6RMT.XJVs09L,ųhnW'qG.Y,Dݟo;B=! &meE4E1RTmw$u[3xtGB<vMS㐟߹R.ѱ$CDE%~zKg?1P endstream endobj 264 0 obj << /Length1 1370 /Length2 5933 /Length3 0 /Length 6866 /Filter /FlateDecode >> stream xڍwT6R t)HJw 13C4HtJ+%HH Hw}5kͼ}_w>5:rp[2I  XY (Wv@  Xߏ' !!;s v` F9An*ځ]}G i']ۛ#e8yo( Ѓ !/=kd@ 3+`EЇ;pcpA`țO=TU5mw/_r>+;lgws|0G 5P>( "7`/0l{:P7i|HY^xS" v7{s.07fk {Ow~CscD@ 8Hx;'_ |!731 P?POH:yv(;PtC?'ab~}Memy%?#)/yE^A !!HLi?BUap@now^(G?sio 8s K!?;Rtu nPW?znD 쿡Ɛ zW_">{(/e74W( GB[^|7sy oHQ?K*d&(" /K""!>i ਛf@u/?y"7}75>2ÛI;׆z._lI4A}wҸpCƾj0MgQ9B.}hk~Lݖ)ƦKmߦ<{Bta[Rh%h-a/^l*wqG t\BzQf[75s =n-v(Sg1 CY3u=ND^;9PO*f{i8r JL_-pV9HqHla+1A LPZqݺқO!~>K0ux,m-6 :f3Pmԥg7?ZtHDPڷWR|-?GQ9"l8 `җ I~f~ʄ8ejPzqe E+F(Q!MVj;\YG{-,b6~uZwNv,΃#?R}3HaWݵHP:[6 hQ=Y>b ]S:֗ʤeJt ;*K :MÏ"Ov}eKDT~p}x:/1 ch}QNc6"Y@w|L1Vo|J$Lr^|tG˷phWJ̭'ȇwDELS\-VIXs*i}Z v Yt I\/=[10X$ ?xdBK{7C5ZE8]cʹ,Py.dU't >{:c@IQWwwwȆ@]^Saq}hJ<.8q5DRn")Sr"gӊ[LuAly(c4􈊠CZpQ}t[dG(Ŝ0SJ6ҖN˷1_em :dNh}琻m:ʉ͢e8:GG,hozވPF1H#sΐX}/Q*xp[H΋ 򳒜}:BҼL[G;ܐ{.P$s=M7K(oH򐱦g.UYSk ,H)ug3n)hsM5a2{]mSߔ7r5 #U8{!o)G-|Khm̈$O2ΐmE߶;ih xr@a'j$Ba>Kw"r S۝j9|+Gv;6gT]Џsgi-Ʌmb$YLKl~Rr9 6yݚБ@1M{{\:#[*Y03i(Z|>u@Uz4K8&e!) bQSjgz+9LXA;˳/%dGfT5a!Ŧ{fJ2㖲Ysui w ]#9ĩeb5 dwLW?d"C+wS&e^'U7'ZڝE﹧{mYT7KuKHpB,iM}Ϋ&$y$]gye6ƥ\mJSL:Om[FNVV\wg"k?DbUHy_#EiJڝQ 4FG:kuEBqxGeG,;J?xp3c>5"V혣,N(D A m~|Y;$5fjJ}RK$GS͞p˴gsہˁk:WϫG]8 XAymU|;S֒OYi\ozfjLqNAӖ Q|?é sMa(w7<Մ61 K+w ǘ12VKWa!/ DRy8V#+ޒzӞ>䉹wf=7H?$SѸ]8镳YyGOODPF)} :*,I/?#=}Wˉ żY ")k  xDٖLYKcDWfkS$cS FEeu*M%(8<)bB :8bƔOֶAߐh <(-mL%XZ6_T̪mo*ÿBy I#8&ﳵdtg{\e1N|7ה%q&NRXcRY4%0i/1m|fC!pU1~ ;EfJWYsm ݯJ"z:[yX+na[f%O9uNn-ԗo( *c`I& x+y#:I~3֚?^%M`٨ؿAWlpQ`\ȘU7F . 7W?zgTl'CX]=X=gI?WV{bFGK&,e"QR]H4q Av&ɅOԩ32T9o+@%` ĪI cmeDy2)z'̅i6mw7o=ɫNYѺnV'&긣 7sy9ڦWHRm/zG3*LУhu'ȻP^7<,,!VGJC?c$w 2' ΠդS;9UmJ|{FpJ$Tw1rq@YI[ endstream endobj 266 0 obj << /Length1 1491 /Length2 6799 /Length3 0 /Length 7812 /Filter /FlateDecode >> stream xڍxT6D:[@zHޥ^BI{/"U "қ4 H4Ͻ_VJ3g<V}#EGD G :F@a!1rB<0=! SD@ iaaD4@u /BeB#JIIv(C<`B@;A0  { "rϺ'/|9S:t$P4술wxN%Հ NJ+l*ZWt.-K=;윌5Hk+*jš,*Xd!4B#URǏokՊ?`4m*5+/ N%sʌ6Rel{ŃCMκBƚb'v߄i[]랰+q:bd}P3"+.,5'D~ ɐI}z$cF:eu]/ڜ%~c7~D5bޙ׿JS-)8^kmǓ\<jXXޥ.c 8Ŗl*JZdL`{B:Z1lŻ񱧲-a!硫0U o~õMq<!*t/zmKV ?_.TijGYb]G׭/ q3vƘ:-^Oureli4}?9tQb*U7')7iwx95}#Z]Gn7~APRPr-FK? !3 U!*IA j b85nQY?lI o<:cHV(`(|]&G_'!s=7Ð-3V8{+1-scG"v"V"42 4~3tww;ėtY sTd&b|cQ&2t`V+p8.{> #V&bqCD9M4_qlmC k>TlGiU $jN|9WCvY3!oU(ޱr&Oֿ~5nU3N%pjKfPifdXߙ.O$Vnihxާ`?M1zrQ]lߚ3rh p} 3Kq T\Hf GH;(985/m}r(55ܸ~?RFL5&*ǽ裉-j;}z'Z,2hs)ekDƤS_Jzl}O {#IYÞj:w>J‡dF>+x]4]D7MH4#xAҩ-@oP٪H\#,1y$V:Q4ÀgN;S*.ofg)e=T%ĥ|꿼Vg7b Y2N/IS+ꞛ,jy@ZG}enXoyI$<ޱ_|5=kh]`řyzbC. Hx#f˓j">Z9\jX4b+Iθ0'T;W%_mN<;~-zFo\ 480nzpXp6!c @‡߯7~ "֭jѺ[BYcncb(Tcs-?Oup*gڕ5HlX zR.Z=/:zdJ,37|܈ɓ42* tW`ޔaM\uey6 R_qG_JtLR]Uӷ LFCaq͐}4򊾿XDr#i$VMBF6gePz;/|!)%UIo_.a -=?gC-Fc_i@rbw|tŃ lE4)mqo$W$",{Pg 䪺7c(˨B y)`F2*5^yUadsSš7t-[{:Q "+ p? bhxƧHerSYۻXZK AE2Tߗvaş}n -R9WG}MCy9+Х~Y|ݖ)۾i*ԏ iKȊ-G0q=.A$e(WɱV: ц1V@Gxsĉd򀖯G<^-%I|B\D^=i|ٛKw;0 ǝ}A2JI#^iXb،3/x?3`; ݪ\?V0h_0xĿJUpD>xٺh^B_+z&3{7~*n S]շiHdou,/zp l'HZ}s][rC9ҼLNX㏨8Ai2|LT±x)9ikb7m X<Sdzs ~x>yaθ1y_v{{_NvlUVeG^?Y6yiԞӴI®~xLMbL^~޶Wq9sRf:/!3R1G6ȵZD\y8B"Qڗڦ'd;Bj íř(üն,A6F_ =]7~SƼ;A,Q~-3hWq&T|̀j[,HJ:U TM){DM.NeB;pcwscWKsvj)^K֮cp2zC4 fP4sv /orQv q¤[g4ն{QSL&$"V$̾WvbrEstĉ%ä3%[dtoݼJE"V4Ivo ?d^2/i/ 5a2l`$9uߺi߭?}99ȇCb쭪̫{PROC'U3byUִ3gM*>wcF5",v3禹)b&%\ @6u|&mi+r) b+o|v2OX84lE5RdAApZ~#_#o"̫TྚF"KVK)h wi#3Kd\.Fd+6>n7`Uzb+Q}vS ZˢSlߜ=~J ;r d8sԽGn};޳!(GeTh(gj]+c 0biej,[ʘZsq9Cآ6TceqH|~p\5:|`%?1w}Rpv4Hؑ-V^"ɺKen-f=|X\ng_2^АDڷf[REQ[Ckz>3">D7[ /}p<*72my6'Pqߞ{ Z!0EL(nC{j햿灛VRӐfWrr%*TƾA X{cw3[VH{h:νxL3-J/NoaEo#ߛ=83_%Եk\*XyLk}nn<ҳMB/Sь,XH{73_.a@XwY0J:Y߉.(p,L2LW*ޣ|йy ?ƹYK%ʔ_cJ"{{ro2M)C ,oRxkHQvWָ)&}7?>VH(Jjƶ1 vkz\{X3v^ 3wd̕!e^I*ǔvȷ+7fbWgib, _;;cqtE9aː*^rZGmB !N06/]j8• dPiɈ~%$``Ow8_^09E2hO0y*7DV*1F("0mZ6L:˃FiƷg{$ãܶީw="<"l > 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?|%*P7 &+qߔuoE)e׳4p::|l.X_SUVWhhhz he1Ѵ,t ,ڋ :kj%Wk,L߬Ma>c ?n[ء+be`mײ1\>?0鬬>\=z:X6V_!N;3^/)XJ vqANq9#g_c_GE,i?E!#!zk'聖z&81!)M0(P,울ژ|\X|.?GTo?x X,/,E|~m#I/J/$?>쁖bA?$GX!zg?u8q.\ܺ g; >tXߋ@ nqڀ;:Rϙvw*FuGi_O9'|Asf/q혩\ \{#9 kHc^ڑiOCCQaF`rw6Pl<2,M0kLig&֭bPd#D#lt'Ӥ;"81~7;WW; ƍ}IB1D\ɷ: ܘYɋKJyEa{`EN~JyHW Mi+'O'ьSvg2 2y[$#lBgo¡J9Y9O%߃mlT4 3ii- w)zWu$\G,w;4JIF\maN~}U˦;.YbѤmnr=ꔩk6H{@ XKՉ{ դUFa%Y4!5#l^aŽ5N$ 575D$rp)_~,0\2;zU;zTlm"-6G,݂(F0p\t5C$%mWq2@O"YSB>s W .ᬚ'*ooV&joܟ fsIvPDN5O} 7+mRV,8A־O#YD֕)= d&Bd%kRFp,\Ae{vdKyVY& aXi|ޭGDMB:Ap eb_Ӟ~ǖw42[\$ @yf/׿ }J2{}Fy4CI&T)1X%~HV:h%=jA13}ӿ:,ʀTAR-*C< K}=4P$&GK"29kyRagG+7!L$KVr@%0NiVPxe^1,VTIo2ee5RI nm;GkqΰhReS(G "e<lDO8%w_Av 'Qq0%@qkږfS$Wݕ(&]^r*4\RsJH=+W1S-h ,ji{߰ViPuBoכ 26f$`%҇u5VG¶Bu:a~qk6:ѯmcY ˣq'\/Sf$t1BC| vP;ճܺƄ?i}x^-v+/X~/ q(g!`Ňxy5.Pp6myDMAdyԊ,Ӵ#V<7/ GL܄E|S "8 { H}lXgaC>I\(m2ZF-PjFW9O u N|"r%=@0e^;iP+w!\IFhLIņezu]hrcJVC.J?_ vbmMΪYPZ:cuk܉$!Z٥En^,i`J,du-I{ T:{~Kk;,g(g&v drvCm%4q7` QǕWCEWM`[u11Qm8҉mk5%Lq}8e%)5 =)2Ƶw// fElq_,1SlaFDi jy-,U`|2#T_:l OW5,Y~YK/qy/qk.x[nBTQ9@ŻAέDU6/Te#ۍt0ϧ6Q!)Q2.>^w|1p?׮v}.bZ9=]xb/B;++ Ogޞ:%(a4_EnwatB:J1թQpo߰c)qbSj?j Q4zޘ#ʧKEm&Y;1]^gc6hNus}h<wοkv0kБNʻ/v)b ;v>w>Nڬ'ShГ}L}O-EdVbd*ҥ Agu!{n78̎ێ.&37BfyE, RDtOJ\onU1p_l!u]XGF/v[Ҧd,yC 2G2(z+vr5@PRnXk57H8šJP۷d e2_APwzr Zy<)-6G f-+E(r;:,vl.8rÀ \<`cE}B@_N'wQ}W}~wg|%\j NYc xScJQ$tL:3"WP ,o3a[_rp]8 Ua򑢯D[I486pZ%(-ʻFOH< Z1Jґ-kD]U^,i#=\Z~-6&cyδM2d~JԲGz n _a*Ӝ/N\ ^`SQ|~B"~A*>c孃@ :C)2IzqpO"J{P,zoG` &i~+0H ΋[w< .dž/J Y.vYCͨUyYd#\׼ߏv^~ v8<m7g49bW2Hdrl\xɳ I#CjfIrtx䱂A(cdŋ#Smzut(^>a6`D=^TkN)nNj4W[٭N9؊Hxt;@-c|vewݬK}haݍ"F3^"&=6bL·b'x5Mh%)RYV7S?|Tz}e/j=rw7>֘}0Wlj]:L3E =v{4`~ )FtUH\U[U\9~`ݡꜮhħp"9%#*Gd;NpgGDx10O$mflz{JJm;ӻki } ѱ_YLUXw)SOzHg#diI"ʤn: 2DD%뗧100dPF[-(L^(%RzVDx {'EqOrŚ)J7>S}}_Jkbܥ"\XﺅM)rhFz8~}.xc?^A=ӛљGOkɄRᨬ=jPSKLJ -u]ut.d)[_,Rm4A 9#޻T닣=ʇ$>}$nл$+)t6f>~b;>:lBC-!AJCȽZLvw˧:d~I|i8oFxZ|/)CbK3;nX<6ѳx\ެSڟl"ھma"o|~7 dVTxyD4BҤtmS2[󥰀Ȁ̘uy_s47OVyS 1Lr2=>y|ˁ)[1QQkJgk 9|_sdO>3 ]郭^dZbt&j `8{!ԍ'r0 )W:/if^+[%IȱO9KU{S ۊ&{Or;O+K& X)k6aEڈ[,yc"QL>+8]=ϑǸI<;*O4q? iH(*p7ɢS Jq QWAP"Rn 3;zi*i1u=~FkV؆ qm"-; eqԅ0o;v8Zp6"+\F 743Ylk&sd8 )A~PDD+Fwf^Y+qvb Jov1ܑ+^w_U\NhZ4GS_=fLl\. WO+ L=e4%у?/O,'S\ T|/{gZ,K?UDǨBrnC}5eD|*lTB9:põ2Ҟd9%hd SDt2^CK_2lf@Owa~Az٠. ^Xdy hB);d {eF<6NjڔXKFyxEA7+VlTU2Oc nŢ04>R#,( RhkLurǩ(cnPG6OG&| VL{Ò<tf1E%puO'YZbhb ?39:~&#h \E-31}Sw3%t\ުd [j4؝Q$NC Yr mQ>XZl&@ %e-hf[(r싣ƬeDi: G K|MOO>V,aŝx01E'\a) }|+"˰ߢ8p:DfvrIA"tp%%71o57YoCy)z=wrH_{ΩWNTqJڶ'EKjJ+f^-ݸ UkzF!$ρ%G̉Ʃ5[ɨ.'l;i/Ǔ`lenr*w^pQ )ڭTtTPsqwG5pe/.~!v)+=pB]Ct ٲES=uJGhs9Hǯ;%IT"mN7+ڔޫs$C)p .!oKU@Mrbd;3 SmKkaR]M[g{׊jY'G&)BT =h`OZH}8}F]X90P6{’2=On}2-5|$L~ݣ1P_jr7Zw7cD?ޔ//3m|'$eaLB)ʎl"&HveGy+9xˉm;Cfۃη]M0%z(A }lN]P % xLfWi,W5w {d4j14S^N-)P!Iw a7 Ym.xb@i'x+5؉6N o‹l.WSvZTl|S}r%cJ896Bq/X wB҇j˵ $IߎzPr5UAyװ 9O18!bn63K[%ROCe2#Lgz'"Mh TEj S\X+b`tγ-l s? Tb0%UU>bs{%}%͹r+|۾3lmĞ< taѸ//Cl}3hշ2aNN[LmQ8is#&G%y g̤Fod{E^Ӻ8Qltd5>zr=]yyag!65kh PJ!1#jgb1:+Q}XOf,k$W r7}Oz:gV3֔D~xkcj1["SckF9oK>{*ڽ.^ Jq3q MjnrAL[pTѓ4!~R63>r-ƥhP'x)!I*;Vy x,]kQ1o-b̷GKy5kͧh 9=>i>!F+v]Oz{]Z|:NȦ4i]u_|t}dS bŢ;0ܛ^"+o>qF\w`{l8[ĺQiO]mt  %ki})zM=(s[Սe `=W;GTr3Z*c yO1<&NQ1~*OH4ɹ IfAr&  V6Z S?-FT`P"nb!GUu \Mi5Dú )5nfz%~o'L<{;k@]y>v~\×DCGQ9+N-)q¤__cFwF ܅C^xh`$Ėl*v zWY nAEAxDQB_䬀#qSL _{i9 Vl5i +Niz2jp3rN" [@dW`uL,FȨ8zntr ݈͡3F\mLnNG ru'y{?MUZN6NЕTχvG"=TۂXdɏJ3ǽ.W"E|+M0V`ޱyB㸭|Dp;@A`HEƖ[ rJyfSY݉ErHSG̤&DGmUeb۵6❘';:ι{3 J_F]`ڕ;EYvja)3Jd.S&O/(5#ƒ\.1ʊirN;XmXY3q^XjV6*t`$%ac)|LX$#~hS T7C7yKC?OwӇ* #V%)νbՕ`'zlOO$LN(t~B{|6 rH Ŀ%kSX0MQXSAbL8wR=o,4XgEAA*6J9Q]`)9>:rGt̎BN=m,H٩M|LS2NEPQi"H߼Z w"<=*d0Kٵ#y=,I>HMٓaƖ9d{Y|YW?OZEUH}:vb$K:`20>ۙ^3^4yffB4xl?qvo'jK׈rEus3,'u38Dk& I- [t:~Hzx-gY1;+W8rJyT͸_vh o{\-;ZZjlVM4JJ1Vٸ@ ϗ<(LwQ@M@+u55HȪ`CY:% 8h_ P]4TG^3@<@įP@◡ EBubۯFR&"-oevs%90\M nR=P?p;ӅC1]эqg6J>ʾR,|7xh|io+(3K/6V.:|x7T)v8u'ZQ=0844~z5IKc8-诶-Q4ܫڍLx\6| PfƔ9sS\90ʄZCw7.L׸Ew%O,>RB@ɧ.7&DxFV7OzF_K-XSy7ڷǗĪ5%uAƉ21S8'/n%@-SjJ|/XtC3wRA3ơg݋Y 1u8]>;ѿO'LR>~OGJP%M6YhzTN 0F~pc])_mH6!) m6 \YŜ7^^, ,d_ 7rSut1q R3v 8 (e.6h?~m .qZU;0^Wwwz63_l5j#u/4GLw)> 5/>u-ֺ̤ Uo*~rl%HQkfbP~CYb9&=S O+jr!=Ҫ&`I7-b0Sǩu2'(f=GXD9=i+gf+lM;( Y1"*vSv"'ZdD^W"~j_|[YE 'CFpT;&;҆8K| TB;rKI=J3ѧHe0Z~c \xR|ʳ X~ ˳Fy9! HX*y*֕Xm 7[P^6Ŕ!g-H#gL6#O}n%eŕU]L4Y/bAR+:=,<9v#n>2©0gbZWx@/rK,S.ppI yTPc7H@$T 9g1='S'!&or#/E_ &ftûdLN1 u6x>S$=9`A!D;lfe"֌`Yowl 305wf=(aPLPa_DNw|̞WnGC+/n NP]\w?>n%(㵡 9&O ul`O~F!rJ9nUbЅJy#'Vy9p+f?s7 ih"+.Gy6ͥݭ߭Krq̀qf=vuJSSMGlS$W3VKաnWKWQu-[?~wTc3q ),8OZl|EMx_ nxS3̎+Lt?mgbN`ٹlZZz9w7XB#h|^VM #AY馦*QNB~7ces&GSR-e35`N6(. Me]sr[Ix-q;ZW3GhD_>Cj .'A$VrHЌOmԮs]Sf[t-DgugW&oXU\sqUWMY{t~Eԡ}=)Q}ekiŏdl`3Ctm͈6g/p,8Ll2bQ#-lյBQ$c_siio2c{8ϱn+`>[)h/ê4%dxsàPe$ rs-zZ:e4? owJ]nvGݜE8J}qQ:sj#עE RuvjƔ#icQPtOŊ)F% ~:pI#ўSleU=g:H0qZ0=.sRNᶣ_@j*ȝQ P@Cgp"{fP~J }LuD ht'Ę\E 쎂֗3s83zВRo^KdHVx(\݆vQoh¸XpA6ҿbBRA;~ⴆ܈ 0+s^1*5RLL2jV@X*j%u]Sr| =zBfl*QQWBZXN95z٦; q9Iўf\3g1AMi9lsZI6dJ"oSy"B~x+hI - JVEfXi>\9 ;( EɏёO /)}L?5u i[U `05 4\eA7)]9K+Jy/o $h7U=fYKc7fԩAB/u!=a6lMⶤۊjZeLIU) Tl5A>uoV &㈤rRMH04,L';.7J'Ȁ%4dVC be?&h̨U|$x]i*<3rs+yڑ^y2M<26~zQtjFz$JqWS<^6T!śl~5ߢ޹e$6y( .˴bfO boCCfc]Rb44WQ6u|Q8nvm ?YѺ/&;S-hܘ\,xWeHQĄn*,++_qMRX,aqGq(_)TMA/yotH-^{.VS[3)ĐAJ$HmVM<ߍ / >&LAH$/BBqZɸRflu|qY&dS^ ʼnUi %p9>ki7/oX\y-`S]~O}Ѧ(`kv QŶUN2*0Fo7RPB}Xϻ״?gB:Z'@S&hu2alL~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\bݝn` . 58w '%WuoQ{wj{"WVc13J:31X̬TT gk4N ;[,F`3P b `qYYΑ n 2(0dlNTbv s gp50s bt-6&F5;pvgaqssc6qbs4Op9[TN@GW)7e Ԙ (̜݌duq5:j2%{coqllߎ@6217ٚ@@<3#lOFI98읝@ֿ9v. w~ G ,m 3o., m"?2s3tM,X~Pd-s񲷳i}@f@D/'#W #D66)` 4"wX`'}Z{1,Jr RT `bpq>ۋYuRdU];]:h[ Ϙ`b5b<7㿽H= F6 kZ vMZ,b2F]5 'I;TlblG{ϬA@e;'t2NG(akbg{عFFIbxXmG`v>3;G-qXD  `,"V`,EǓ pT.[^D5fNۼq{σOgzWߴ͂%_sGWmw? *4һ۴T`?^Aav7b.>?db/VYɴ5XZNjZEڜwFp$!hy>m#VRW7GWGdEII5Y z5(TO]]Er|o?bEe:6s#ϥ9<*_?s@Js|KNޡ<53-uf+@j?%ׄ zw8H{ "]r + uRznKԮ}>0 ڒS".֗/LǛ/lȐ2awt_UmKWiD_5n G,ClNJ pV_~/X PZ?ss.GVV/Oy֓RvD{a' %y/Hɾz4gKtRG,A}W(\3> Y/ȳU-owIGo5|nW,fYqƫGCO,{aNj%oC8K`VrZwbPː3SHc7^\3#w9u >}mIە<&~}Mp4Pa-hSil_J^5WKS]`^8y0lݓwbSL$Atf.E6X`-}%y([-Dgߋf~P (^ܽNPzGg~R(\W1ax|  zL'䙟=t iB#UW(`+4W0#D#Ky.Wv_. |!dAK="jnt@xެ 8 m)@KprýYP+atUwQٷk_|wC(0ZB62:ʜUͶFdjDv\_YpE+*dK~R 4c"ŐPFVBh"/kgڤm7aM׫ɴ'`sȅ7p61Zwqߒm QN%Gu<ӳ!>u GcdhKc`nOXa {ડLj=bTCX֏1PL\CPVL/=JGWԟRr?ϰ47"` LˏسuVIi *ޡ=_{Owe/q}nj-n֛ܡ g_$%)}Jlfp;yGwfM4 (TDzGgS< 1HEO@.)q-_C(9rbLm}c'O!I#- \ɒ_>V&H@l6ڶ`MMz=2u?q~Q~>Nt+uO]U%ɌkeU'ꠕ'<9üm`,YKeگJ:7J])_ ֗wഀSN )QteW=pe: l=`Mʳ a)4 aQ du4Of;6|F4|ǥS-7.@mBQ8#׼F !V[Ԙ&ˮO_Q >4IS;]d[y2&Yb `<=LQ̈r=bȮO/\/v5endyz7ΚX)@|Gdͭ/$ږ$FQjR-e,$ ,9f(8 HOqy̙}1sTcJZ!9˷sMp#@cWlJ84E'?([\mt%+tG@YݸQc7#Gf^)AlE nAT&**J]lJVuN.Cᔴ<°nR_HVTQ%AJ%~'<*8WRz 1XT-K>EoR>[̯1}H|)Ojڣ?83iC<7| # $lıD6"3I|_` diwSJ!iRP"<insP[$SrSV Hf:Wlbc. %lUo\B_vdO?C%jC|0ܗ{vaD"BF({ pgM{/xC`,FX(=ĽĂNeO69w!  $c똂aQ&ވIʛWM9$r^ё֐+Pv7.ᮈrjB㬺e$ _$6QMr(6Q;7mZ]?{/n e;(:P iBVsQo4?zo%CPmr:؟ETqvۖ~T Os:/]p|ߥ kT"o"|˅lR΋JapL'rʘPڅz;174g HTFY%!w>Q-m&,)uL tZyz }($CI%ΊiϤK2ts`kGs+.]~U%A3f9оx'R瞿73fTn[ CIb5 Af74 Wd1-Fۛ:`gA<:"в o{ C9rokߠk0BuEEB@(FG~ (s8E&fFE%pWl/ø+HA N.CfvZ#خmޜ#gwjy9c).ゝ̂~uzu?[W$rT()S1H~Bn-;+L0*rA6A~<;+0v9g'Ե!+-5nTxGyR:zKIJ(ЌQ1CL,V@ }ĕBw^D]\Q,h{d-KV~!lM 漏!Ƈ%ηlM> f{L~ f߭y.\ >"C\$MB9®7Pd:7RzL-j{fnB#S.o֢'̈TrpZ?o8\5t?7ԓA"#V6*;PQ)V 6{ #&͵n!K񮎌MrΒ"B˵Ca5q>T*4}CJ/,:T۽Z?= m4%gߓ?PNy~fZ!wOڵCzӬ)t3FOi Bmd5cL8, YN+sJG _avD_HƔh;+QVۤ YZQQ^^/ Jh_iA㘼uF"V;}Qf~Vsm=lubj~RLt:3V0:;Z$|(ދ{ 6.T_!KOtNx'@=HsjRf?$Y8. 5)kh-sfW=ѩ)F*SR1}Eu90=P*=7aƑ>%Rj}f$o4(;;8}' r.SbD셡HFaTel sI ( ěMRP\ (4DbF{;d}\*^~ЫNmψ>eq>zIʹ؋pw0Xy\ ,#l#&XwiJ;kM}F-YY 1ej m RuBĨHe$e^G,ywALGt-+% 3Ͷc뜢SWF7?CBLdI:5g׈ep#)vG^p{_ \o¾Y/pݟ.{W`[*<5qaqQʯ'%ٹpa[~Sv[ZIM"5_Oj.;j\jJcDDIn LzVHʄdqptU#^t.8S[2:cgjMwlj&*rRval+?Mtb܏K,T]o7uN>+0^g/=;TueG[7ӷֈNSܨrY4u+3/c>*\:]N=\@Z̫\ M51+G%-fD Z>ԜՆrֈT bd>vsw_ɑ@nɖ̎F 8+3ACϠp$^!0S)A焀%﴾T)% LETWV\.ji%6WXmD[CFWfSTȷG ?F(ȕ0ziɰ}kKezߴ)I! 7Uv7ZIqk/{Qr.v+鱗ل^mڛavaDdAy7-68a ݑf&QQ"}+-Y"Η49,!cSf:IޝkM5vD#= fDM E)>_Ud\`m,h0hHn h inϳꊏeDtI#DD|/#Tևg1=^)/(Y7(- ,g*BRm01QO1J}1QGLJ=eקglwkVq_, MMJ,WQL3MrAbFب%d%7~̘у1k7 3+;,Ȟ-IYRPel~[3~eDFNz#VYGF5N 0§r0 ?+<kiO#A_TN|92L]LGU~|fhUf=e&ozn (?ZFsR0Rz"F 65&AMzVt1\OgCX/"N/* w0WA(S'p nbeׯNp1W̮׭fWr_1?251)|Ms;~̗!Koqd1~U5?/GUsuQ6t42?4B^¶;ÜK 3B{YdeWrnFI wQWfޯʠuH =lH%:p/! J#wC1)c| ?"U 8S/x3N繂}G~^jNޖ_`/O2R@m$?nRXRՃ6a'ޭ,S \^;&6t\dW-XY;e)()1 װEz7/:|eXxhs |!,H$>X%=iDqtM`-6fN@/q*Ł>[M lPqw-ʟ|FA[ q_P;}?N @fvHf ɜdNcɷ4 !Ur9yѥ7KA%|Dt6Wݔ[;b^O2OCbqri$z!iwn2RQh:]ڬ-#bT4r 0I=NU[D#fp"W,mP|2vNl=4h_jjJcig-`Kgpx'XR{cXkH`Msy:47]ר!΢.LטHƘB8ZEvsgm̥1R$屨2pKc:%\)l/zA!t4dtbTj%. P;}.AsvЄB qG]{SWQR"}}5\s-]42P*&|p\Kb#\bm4J\>pKޑϨS"bR-r#-b$${ʓ`QMR~lNRm_:xd'Y"XzE%8YC7b4q7N&K~re67eM*Нu10l_}^hg!' "d?=qN̏MX8#b̾*+qؿh5W[xHS>pβbq9Kw8i%i*ڲ'kE&dVnùr !x8QҦS}j\J *mhBCv5`)g4E;SέLrk'go~U` O[IwS*I"8 FvÍp/%W['uD=3AK`7HXn}]4AO Ezѯ ˦7tJ?֐g=weu$[a/;4Ʋ^N1dzH .y-/v$kXQ;@E$n{s 8fR Q/!Ko~]{jZ4 Ctto)x9CԜZ!&_ΦIiJ&ޜ5蟽̥̽[Y@Q#ݵc27EyIՐgZ>.Y esbc⒵QpΖThPV(S"z)0KkdAO"G#.|~ꈻB!y5 %93Lnu<g#K4k!e3,^ZiC W)fiQKrh:,cYFoyߘ!/dJKzD5Xȩ@5媷\>&ʄMxh%m }j*·v87}{TdBȚo6%(ČimPmtcI `jiyR+>5{^ԏB/>9me֐7(۝f>^+])"ItJ^lqҜHttOr}S1'(c$/tp%5:}y?*N} Z`"rEhMo?h6ۤE~!'9lm$5_Өb2tj$C[$bFxȠ+cT=$/R'耘jˆBQeqMyl (XneÄf26j;cլ׾&UFNq4T^gdJ6,Aiaaj'.|iKU쳢4`c}Dl6|z)(3bNqπPܝ319l 7Ƈ;lXk<^rG7oĥ)A4ͥhވ[". 7XȚ<0FqwKf A^F5~;=pS9iAz/>" )ݕL`~8M)nvfCڢ72yܺK,H5N|1y lzsOxwYe2f̈k<\oYZSITޭ@}Epfj0# z4tdi8*)+1&0D%Y,KO~v2@]VcnRjA G*StⶒRånհ:b*/-crV& >>|EA[n*9ƥ_k:eDz)dZ3v|?($g9:[فMlx"E6'jA܍m^ /I O󁆰đT"-;D_>A5wd {q9T쾪 8ĺk -5d_ڏg=hLf5?zR'/2ߕi*yŝ R>|8QzcYğa/ :K2NPChO|7$vJ^ sDx5 cCEwH*2z~YjR k]dLO:/y^k:OCqJº\g/iAazh}I o_llUvNDa&UC0S#kJY~zֲ}-b:bS [NUl@JNu62 MGKGtVSbVQ5UB@u\ԯzRco&F[D+oWMg^`)jyĿV]Dޖ\mdols.FM$Y؟-=C#3y*~x:Bmo)QG5b7\{ڞB%D>h^#[t I^R[jXyDM2F$LD`lQY"WDZ=%{l :\W!ً,$\ 3,Q Q2uǰ&_/4gG9hPvвΊE0Bg81 %&bMLMB3u uZ&h7^6!RϾ zgb3D$YJsjXh!J;i.ef}k6["]}I!?a91aO&Ar}S7Ė 0aqN'r 0Kv*%֠=";J>@T׫}5~gQdVפAWZUÇ%{}HzgaF["mfsٌo$QK5z#3bIwMThOI+4RKǷ`Krqi]ai(M S3hG馱nE XgŐqB#dܾug4H[[2ƈZBe=Yk]AU?p!}2}7)/d>5T~G,6/2ˑ0"HOt$3$0'Tge&B9mNkڱChnNk)_xNt#idk"RS9}Cʫ{ U4[p&*C 3g-p7jf82fѭr31Dܯ;C#Q5ď`uGa/<< 1a) c+OfG%Vx" LI]A0xUuD L6e ߌNSz" B|{Ǒ;޻$S0GWkQdPɘ³ys9璴ډRy@ bF{6=EXݯo&y}IΰD̞qsbi+uOBW3Aȅ?&@2֨)I8 4"()=k" !#VXwwuI @ (ULLyw<b`_Y42#|C :~¼5i絽醴OHK2ʆrŋt~t#8O8[4kԵ[BU݅lPy3C{RV$_]$iܯ<<)U,$[`DX{64EM.&c5߽7_/6y MF:R S= D&-t8Ou AOTxH!SyS^.q?r0.ݱc*Ӛ=s7zOga#(([bu}zO эn2%)+5SH_:L.| T9QK ([S =n\wYۓNp}>qCL'_b)-vސ j4|,R.AmkFC5!XI9qWS_'ܬYY3:+>H D ዝGWbmn\nc⸠'`=f"j#gB䚑/(H$Bw1oS.Qh5n8\I݇Av^€W"?|z]YSKۜ[/ XvP+OP9Y뽥 9h3EA*vU "SˮNշ2qhaLvŠW9-50[WSНlA UkJpXv^F E|Gr`}x 6ۖY&Cۍ7SI4BRdU"0RnO̓(ϡO=?r\>ɽlEe<@p`X5r+rAV'$CR|a2b)tq^l-MկwS)띣6KWtAI6t<qEcv| `mlr8ݥAW;?qn>/ 7Wvmlm9zuSL`n p|.FYoPS`&& TI!X1_IO=D摫[zk1ҹB`N e)v90pi*fg;~)Pk]/(sDVD M`BMraH 5#sVz }OC%ɩe|Kbͯg%.mN2[k|aoᵾ,K.&H5ic񣻀;yDʝ$:}w&gYG \f^'qɖ1YlhKNlb Q;bJ6)Hj\;Pw\}Z}T[jK]SqdiՔ#) Fo (~pfP]|H8YvQQAuzzLsaX#B]"$$F)[!::c;t =9+^V+HPȰYk}i q8E)E ΄*v$p)ƹoEKO17Q"Tn2J<:&sA2%Z>-?LLz7oj?gBmEF+ddxHmMA,mFT-Gf[!^49=ur5d nk C1y7݄~1d쨣B8_Osi?@*g58Wm&<]x^(Z Naj ,/+&Gv\cS J%LLWNޓwɪbш/Q _"ySE]ӡ^j(bc)FGpS`ol#5vJ%ʔZSͧɲW$C iSa`k#&-oTK=j5HݱD<;N:&&*jj|@B(-j{:=ӕ60uQ&twbч3'Z8zI(,D4 y`O)*j?BVuQSE,^:bi 'rMx @:Ln߃VUۢhYyl1#R5TL4_8 z"z:W!x(I/.}շlšPqD;Km,^uUK-Y '`b! U$=- TneqvvpUuPfn%k`g!;k4l^;-aam.\jЄl[5ad6etd|IC2l?6$e{s2KE"F8w.ĐW𴻃+mN _I#ZդsO[8!?~j٠(_t-|9qb2B |V ܳ&gG8j炋6sX38~Hq px}4,Η=u xyWXz-@(zwQos-< yU=X#Gx"Tdr5ٚڂq[#"  |Xt>Unf nL"c4-z6#$,P &!Y7d1P-p Rh}W&$.{q2IKK (sLOd:J^W_USlj);߯"i%RW:XAE='hu#]f=uW"!Xxh.SQM IPˆpH%pWI¨?,*?[PVWJ5K皑o8LJ=>t SOڊ§\bY]A~ᄸAy`Zqޠ'5r`9y@sqJIŹ+QZhj%[}蕄ՠ&K;˓jrK/Ġk)rtsD3G l>K.=62*OBMc0FlL:(aUʾ O} ₣R (mrOMQYg7*X.>O}[q!+x9P2y'Ah-@LY2*º ~k T>bO8؂K)-A ~AU׃Z!7yvnzqR4,J2jٯaP_gjʿ#T@.rxdZv/Y1"BHЅRN3Nݍ18JCoqPuh̓WAv뱍Kdt~oWk^c%=vtA`N-dkEז-i+Li=x'*]À|hR) Lڦ?( L,&=W%%X e/ak(͎lݺRr2tl`>beGN$E^i-f-~ŊcOs,گjBTKp>vB OoCavXm2`t?%Xlq̌A)٣ T$|`-;XfL1?V =^]5/湾^##yI+Dƭ,'V75O4/X.EdCsԻn<?e{)`،e7'_v[&9Cj_[QNʍu2?"z[񾾿@}.mΙ&^f`[ۼ ZS&NJ!i04fD)e幒kު V0 ""ٴ\`Š漽@8O@>Ly6SCaZnbkg4;ql hzJnG5CT0 W^w$3ji!Sf88m`j!Pu!ufOMT0GGNGچF&wII2F:;gNZĂDŽ`t(0E{5C]dr;ojb2x +aBdIhɻe\<%wFl0i0' ρ9/Pi zk-AYрwf^$FS/9e:?~K]? ET5/kCLDLfwFvywtŭWB:-dWg'JW^򩺎cQ4-vdf_^̩ijݗWY&oy}O{%nޠG@"ŶǗv4` iJb;g2SH(g }1,Lc"W(\, rV[ ncp6O u}tA_%V ewR%k]& d@2@i*4p6/9ne=;]EL;as"HN \e+U[7><1Rvq1ÝvߜHnsmFM "=2 \U*oo^;|vE66 *G-r.~D'~lݍrjƭWv6Xf^o5W6]|.<'vE4hMBg.]{Uы <\nf[j"r.QhɐR\Ar2 w)U%8jY"t˰d Q.o ]oz*Q_2WUcKHۚ[CO bF~Ou%l2S0bo /}t{rLZ집=  oY".-bo*khfL \vxl,ǭl|pz`26T{8s(_b]I}ŋtEQIw)Nʘ,\^MLxuL2$ X3guu_]SÆvwBjEatihZL- ( $Doᡚ_J#lF}AOdf3H# endstream endobj 272 0 obj << /Length1 1492 /Length2 2480 /Length3 0 /Length 3437 /Filter /FlateDecode >> stream xڍT 8U׏ꪓ! 6f:QSMrosήg2니pi0eh D]!(iR"DƮo={~kk*;" d7hdpX0ws F n~#0 a\gN@{&5b01d sDQ rfL@6Dqu$5k`|@6D"2{"+tI@n/%Th\!"pPL6u&qi ~ Xp ʀ \? @N1 W\G_[h`QV Ad"%2!@tpCqA^&O#Bt7 XnX"<|rP4#z  dp9!6H=zLF71Ȕ1<_;b@kU BQA.`$zi@_p9]r32} < Q@@恡?~X,@H\B ď`?,=Ff2?GcIpwX{Ԕ# ] *NDh ̏Lk 4 ҷV*5ZL ^ ~ak/_i,ytr\uDygJ`\=Hx>Zs *FBK($;A\m+n%!@K7 b0"oLk-$&yId8]fI8  ,@L.Ӆ&tzZwKHL:7 h )2 9?l2fú^f<7{x$#D oi =ܰBs̄Vvl@L_{lmXíKox iܲk#ǎ< SV<4iVۦoHߴQe(Ab$#n2n_ޱV⌛4|:#kal]=NA{&sVfhHv2chw=]iۃ@r= ɹᓷ"T9ONhKS?"J_{xeX/BT?JtCaU/Wᤓ-}H#g9Ɗ8&=vhh}ި 9ɥ$ e*Z3>2{$fwOD&`]O+<0ץ"wT eT.KV֛hO\RH#јIˆ*p9[A=Wk.>6MJuVTcN4 );Q}c%$@g?6+W-T&irun͓i#j~F KW Mn=VNl6(LsɎdZPyfB~ǦwhEI ej&[ L@S(3(vLA<%P?)ҧdޤ5ӹT\7ieYн).]3ѝNp#ՙ F>[_ {r>_xmBJv> |7Fu L꼉NEy&?ܙnLKЈQ|]J]\,u؄Gۃ ]Wúǯ$h;$$uߡ.+-!^rE(] dϥAdM<^=MID83lI &{zck7c=yR`*$)INFK3襔L+T {^>,kBfI|ia't5I/.6p0F_lR3s yEPaSJIuF1M%Ur{(Ě: %1^c'0^LB{iL}uwsy~=a빊5s| -A+N~N}OZ#.AfW>_tnFGm/u;Xn#(.5u׾Ok.RsTvPִ00gaw :1Z4!sک Gk;00}OzO=VNiSR֕ ?}/ڛ>#2wOl**KC^:Ԫ\@܊iKt-rf pyT=W\oys}ƢſuLK U4|2g1V[25x#_ -wCuuzԾ__䲃1@Fd6֋8"G<=بn^:govT/,l Vܠ8Tkw=缭yZ-SecNAqW'ef~=kaƫI&3R3Q0i *727wWoe^vҞ?/$? U y`qeٹvރ~QG=mOo36ZwRVT̵*ױ*J%i >]ЕcGa}8%# Z- %*iq!/yτ,"D>d~}aSt5NP&׼;hт%/$" /Ť=\{$Otdm*pV? xrV^LkzuGbf>/?2X\O^mUmUIw2j*Mbz y)MGnhqM^^ްj۴k?KfS"])麈2N^X^UK,}͎+ԝç_w 5Pf8(qꋌ}qG qS7$wLDL8CTnQfٗ쳭|L`1fFKpVZDc9[SxbQdæGT#ͪ=mަy.62y@ʰUVV m)ߦĤLUya5QP_ĪNF3>cYO*/H՜{ gۂ2Dߢ<]sT_{mω"f=[XB,n})0y*NPS2 v_=J uфGk8ɿ_@ |YO-,eה2ePvSgk/6j5?uY٤u=Oo/̼l endstream endobj 274 0 obj << /Length 741 /Filter /FlateDecode >> stream xmUMo0WxvHB!qmU^!1H__myݷDULG^͹t߷.k4c*S'ҵ>]g,yݔKeF$mS3&qGRp`I_3[dE4ݹn'&9綐7UaL)l:M z!YU0rўo>ν9},lj'}4>2]ݼ[ivjs92V+Vh ~y8&X-MmM|ŖE LS7Њ~& U 2X(pm XX(W8X&LR4=zukTGEm7h8Kc`Iu(!a <#G >n-tJ!]O2`̏S#',<ؓL%qO8\π: 3ht ,+9ugCwËpD|ORɉ#ɇW m藒1NwH=8! 4DCp&q"pBCT/9!ɨ~B }Rq҉TFIܨύ|nTs|neEA;~<6OIystg>O:yұϓN|I/|yI>O:yҹϓ.|R T<띹_mKz}K=W7"V{/@̪X endstream endobj 275 0 obj << /Length 741 /Filter /FlateDecode >> stream xmUMo0WxvHB!qmU^!1H__myݷDULG^͹t߷.k4c*S'ҵ>]g,yݔKeF$mS3&qGRp`I_3[dE4ݹn'&9綐7UaL)l:M z!YU0rўo>ν9},lj'}4>2]ݼ[ivjs92V+Vh ~y8&X-MmM|ŖE LS7Њ~& U 2X(pm XX(W8X&LR4=zukTGEm7h8Kc`Iu(!a <#G >n-tJ!]O2`̏S#',<ؓL%qO8\π: 3ht ,+9ugCwËpD|ORɉ#ɇW m藒1NwH=8! 4DCp&q"pBCT/9!ɨ~B }Rq҉TFIܨύ|nTs|neEA;~<6OIystg>O:yұϓN|I/|yI>O:yҹϓ.|R T<띹_mKz}K=W7"V{/znb endstream endobj 276 0 obj << /Length 753 /Filter /FlateDecode >> stream xuUMo0Wx$ !8l[jWHL7$Q_ ooffg'Ꭓ7 nnҦ8m=*XaAK 2)pñƀ28B\(PC/.8]9Y;W HPXJ\6g3!GdRHIMD`֩_'>GN~*,  0 `2A%r9"7BʑO=%Ɉ#Sxڠ_Jz0iPSH8pҐ,΀l 8!pŒ9 5#N|~LĤXs OZy?tc'4yH}ή}k~3#ȯ>3̼L}f"3{Yx}fIL}f23{%,g>Kf7ÉfL@,N]f%b0^u۴? .IF endstream endobj 277 0 obj << /Length 683 /Filter /FlateDecode >> stream xmOo0C@@8l[jWHL7$Q!LUzSnffonh/}f}emy9f|vrvx}[(mmMyTnrlnwwVqTrvԧnfx Wŷ?yQJ ySN2k1ꯑJ.g%мFw66XͿS>r}|oݥNrl6rGىǼ?;'4>+JV}}Ⴕ.Mۻ:ɚx\_h`:Pp/ *,}!$B -fu[ǘ6LQe }ĭAk2$mAGs AI:םJ "ʔ43:KaCg" s rJ_i:6dPtk69u̩3ȣ" P݀^R/z0cP_Y̰*z~ʟ''Mq_ uWG5do9JOpH+8QhfgBfg"fg$fg,e@yɟ1S3SS0S+UjfjCfj#fj&.]1SkԦf44U44 Kx׆_|0n:8pw{]Ap^N3^?'y endstream endobj 278 0 obj << /Length 696 /Filter /FlateDecode >> stream xmTMo0Wx$ ! 8l[jWHL7IPV=M̼ su;Uٛ=w]yil;<[[j<=?׾+v`&ߴț<^*;~&Q>MS >_P{=s@dkx;`VY`s4JaQܡn.Uu9\Y6><ٴ.Z.4>Dӗ}~r:-d0VWk,8yLһʮӮђ[*mLr?q 5F8@=@)& 8Rx uD\j2HV0CzL] bctI g$`htы0\F0s jd< I6zg W qȐ+#k .bsrbmXK7ǵH7Gnb>&jؐu1VljOu$՟qWS/%1{\xB!K(hHTЖ枃Jρϯv=k2UKς_:~$/ ~E+7ˢ/ l(/} -+ZXukoԝE?ZKq endstream endobj 279 0 obj << /Length 739 /Filter /FlateDecode >> stream xmUMo0WxvHUdCmU^!1H#x?gx]OTm$|͜s_Iss :L;<Sz==׾f`*_`ɫڟk3'iѴ}=M;7rfnj-eSӵOLg~8 )ok A8 $`I\3`Af<Z]! xNky"7 _㓧q H`nḱRONH=CpB:# =%888QA~!*zƜАT?!~> tw8y*sύ }nFE>7*QύR>7G];~<6OIyktg>O:yұϓN|I/|yIg>O:y҅ϓ.}2 L> stream xmUMo0WxvHUdCmU^!1H#x?gx]OTm$|͜s_Iss :L;<Sz==׾f`*_`ɫڟk3'iѴ}=M;7rfnj-eSӵOLg~8 )ok A8 $`I\3`Af<Z]! xNky"7 _㓧q H`nḱRONH=CpB:# =%888QA~!*zƜАT?!~> tw8y*sύ }nFE>7*QύR>7G];~<6OIyktg>O:yұϓN|I/|yIg>O:y҅ϓ.}2 L> stream xmUMo0WxvH UdCmU^!1HDI8߯-@=ۙڽ١=?w]pwdV^ڑݧl#oxdGa0NiqF?Sր'YNR}{f{x2A! u xk={Exo"}Rɑ#x۠_J B C쩁b8!=%p&r"D9 Qg̑Tu+gGNN8O-(7ZRntH ʍ(7:hEњr1+w(O:͓.ndm'#Ʉ'> stream xR Yz 4V)C0m"lqS(oI+X8=6VRbJ6"j i] \QwEoڇquwLn6}BLugzm哴4CqPjs%IMR/zT-q<쌺 GpS|#\{gIo9}ԻAZ(׏b&EthZ)莀ɤ'nZTٴ޸3\obwk1:P|KN!=bқp4b {h߯M5 l*F7aEt*7:u@͘7h(?}gaLQ ηj5x *hz#ʧ~w39:sXw9BVGfOGp9ϣGg2 +–*?[ nb ( ^1YB| f|_`X,c6Ay(rF> A6Q@-(PH%@R# /✷rw!X4.uR;6ڥTtOX:QMXCIM@JI F ֲD%lC`AMIԙ']Dqg @>%v }H<:oWDpTk~@2 >mF$#Zt~"H8 hpҺ19.`!-} O-t %L,i#gڣцNGRmB3h+$MD}n6(ߺB/u"8$@j+r1,BT$s-nɅF /4(pĥ9R#NSX6Z4nޮ}R$|qT8!SzIXK:Bs/2rK;㹿mzAEcsdDG|AC;X22t4%[%}!H LDI!yc)g*$/eUku`2&:v#rԒnYMx`İBjРg[[<[molQ?HNsxAKteAd)ܥM3ʈ-gLj՚."lo<e$99op$^pSf4YŃ;% mmSn~Ƭtjy4JC瀿ǖj KF*b5v Hwu !WxGG) ˾xݓä?G3MGcI>W^YD&yj]TYz`}%Mܛ6fy%T.D3C4W> stream xmUMo0WxvH UdC۪TBb B8߯{ .@=/ۙڽs{K;K.k6/k+[M'ҷ>dyӔKe'$cS`vfSfK}fƁVGGf\bu<19w|擬CTAW $rG]IyMsh$aW7y̟u? sK-`θtJ!'c83?NaO<Dg!;IX 0z)rЃ@kpBQ]^Z7! / U <ɉ#W m/%]cX! gȀhID8QN~ACT/sQQRs 穅ύ>7: F+}n4eE=zG~<6OɈy2kLd>O&y2ϓQ>OfdV>OF<dR'<>O)yJS*}𗏿tx>z{O->tՍ]*3>cC~ endstream endobj 284 0 obj << /Length 740 /Filter /FlateDecode >> stream xmUMo0WxvHB!qض*jn$HP#x?gxLT$|+$=wwY[L5Okˍ}M=ٝP7{=,yfܢ_ybsn yS6`z¦}TEA] $rwyś~0uoMd?tNC0}*f6` `bێh[W0ƂtmeӶ4ݶ0[*0M\B+vX*+T*Xb-L s[ #*X,caq\``2Iш P]QA2E;XXJKC k88pLB$qƩ/088?rxy!B=X y82VAנp"Zqx8t9MD/W)u8|}ۆ~)30|SRHCOt$"NN_h 1'>4$OOB:]*N:qJ(sB5Qύ}nTsύ(Q<6O͓yk'<ϓ|t'=y '|yҩϓ|t <)>Ozg~x^uEtϭ{ՍȧU" t endstream endobj 285 0 obj << /Length 900 /Filter /FlateDecode >> stream xmUMo:W5?$R. d9M eCkmCp;;w~>|3E_?O]5߶w]Occ]=~?}Oyh9%?۹׬B|Ɯ>);vw%g43>\ 6 EJ78 1{~`W(-;]%=xe_,b+-O;q\L}UI--=BKE1p[! Mߊyu>.N5K)Wb٬8i[_uʕMzQ)V(Txޢjy!Z2P="Zd0\ÃGR\).2*Шa!U,H`+j.5Nα@VK-x%3%AYӀzΚ>kP#5m0Woþj.ZT$X/)n)#Wo(oRZ $Kp4Z-b\1ܰJ P"GXQi/8k^Zq:Zs9dB )sL-7xJ`aɽ)f$1 dъcCZC<73JgznHȰYɚTa,_-O87}KԴܗLloK+gJ.GZyVc48Wt]:P~`rZq.n1] S/Pu7Ue:?&?!d&1yHn5)yғBx#1ޞ]Go׏M?X endstream endobj 286 0 obj << /Length 750 /Filter /FlateDecode >> stream xmUMo0Wx$*B!qض*jn$H$3Ch<~3~~~ngjv9{C{K;K.k6㳵ችm#O7٦4\ =؏8ݿ߳4ւ8͌>sIvdXC6OLx9im$l6Dl_7ڞhz*{pɲ2kAʶC+mk>lpfIQTT?LA>J e .1PbpqH I$\kL8Hb،Shąr =z51XQg_s2Ē+ sC:CQ}.'c-BbOEu+Xg~:?aj B.U $,ĨAA 2A%%" 19hM_)ELN 1sR3fg =傸aCYjV^w&L= 3nqFyDŽϠOL5'pZx?i^x?IGO:~I4ϼt~3][gF~Qgf}fB3y,h3cL}f23{,g>KYN0`^ay{7)q W7:*ሟS`R̯ endstream endobj 287 0 obj << /Length 672 /Filter /FlateDecode >> stream xmTn0C6*drضj^pHA@Cfy'n`g#govh/}eg羋򶺜m=Ooٽ[׌uRۉ=Iۏw{VQҜ8ߛIߞ3d_ ~~hZ# W c *'qU;HHV7xwuɻa;zopO_`_ݥNd0m6G_?[6vLClw6ZsaD%!p%blcä  PP[ u_g_x4$O<X^\NB8 \;cBbMx y%P 3jok:E q:/d48Q4A2="\šY+ːs(5$Y r~+A\HȕWr{Nxo $TL~K//p1sQ*GG-G-GzA>|)3Q/G""&!uN>|%h8hh$hb,n~ᰏnˣ+p]h \2 M endstream endobj 288 0 obj << /Length 672 /Filter /FlateDecode >> stream xmTn0C6*drضj^pHA@Cfy'n`g#govh/}eg羋򶺜m=Ooٽ[׌uRۉ=Iۏw{VQҜ8ߛIߞ3d_ ~~hZ# W c *'qU;HHV7xwuɻa;zopO_`_ݥNd0m6G_?[6vLClw6ZsaD%!p%blcä  PP[ u_g_x4$O<X^\NB8 \;cBbMx y%P 3jok:E q:/d48Q4A2="\šY+ːs(5$Y r~+A\HȕWr{Nxo $TL~K//p1sQ*GG-G-GzA>|)3Q/G""&!uN>|%h8hh$hb,n~ᰏnˣ+p]h \2 ᫄ endstream endobj 303 0 obj << /Producer (pdfTeX-1.40.22) /Author()/Title()/Subject()/Creator(LaTeX with hyperref)/Keywords() /CreationDate (D:20231208184540-05'00') /ModDate (D:20231208184540-05'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.141592653-2.6-1.40.22 (TeX Live 2022/dev/Debian) kpathsea version 6.3.4/dev) >> endobj 283 0 obj << /Type /ObjStm /N 35 /First 286 /Length 1127 /Filter /FlateDecode >> stream xڭmo6SxCkޑ"E(8XAw+p!Ft۷A*-.\EBx `(HPRQ Z Xmݟ ˣBVJDP[]" Rsk HNU_!~U܈`&nr~v?K@rRU~`M'2ǭvVyQڌ]R~0<:y,7oͿ%LO&^|i|1-ץOg'W_gL杏zn#IWu3{X@lz\d߫a ^L\U ΐr RR~)rHM:ϺmFDt673 SF)A⹍M&M͈a;%Cmp c ad-)JmZ &|4hpo 6}SV6 }O8%vVdG"R%r\FgfXgr^v3O~? quf4.=UD endstream endobj 304 0 obj << /Type /XRef /Index [0 305] /Size 305 /W [1 3 1] /Root 302 0 R /Info 303 0 R /ID [ ] /Length 796 /Filter /FlateDecode >> stream x%IhWW{/18Si1j8D1n(nD X*t)Apa)p@@7,Ph)|8ﾟ٧,3+F*ՅT Z͢ʡͤ*  `"*NrzMg8[Lo/`*%*2zf;JzXSy+=vEU0 P sȧX QfqW`1o;۸#pq&<C3&YxJX+` ʦV(ՍDo=˪bɒ_Wuoc=%[!&6f۠W1~ٝL UalE n{aɾKrAC0,;#pTv['dWHq/}|w(]:1$Şˮ p"AZ&Y{v7V/ݻÈ2?|XzXGR66Cr GЉo}ȸq'^w9&ȳK1$ t'$UUBZPܪ/hFL]_ks@D Hozn  I3'z"a`Cl/.vK㗢ڣNT{5j@}nϼ_:x!'gFuHѨՔy݉?&:8j*П71lboi3$fVa2T(@-̅:y0TR}+W?fS endstream endobj startxref 270287 %%EOF bbmle/inst/doc/quasi.Rnw0000755000176200001440000001477714235317476014726 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} \usepackage[utf8]{inputenc} \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}} <>= if (require("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}} <>= if (require("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.R0000644000176200001440000002074014534725243014053 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------------------------------------------------------- suppressWarnings( m0 <- mle2(mtmp,start=list(prob=0.2,theta=9),data=list(size=50)) ) ## ----sum1--------------------------------------------------------------------- summary(m0) ## ----prof1,warning=FALSE------------------------------------------------------ suppressWarnings( p0 <- profile(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---------------------------------------------------------------- X <- model.matrix(~dilution, data = orob1) 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") ## ----aodfit1,warning=FALSE,depends.on="aodlikfun"----------------------------- (m1 <- mle2(ML1, start=list(prob1=0.5,prob2=0.5,prob3=0.5,theta=1), data=list(x=orob1))) ## ----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) ## ----aodfit2------------------------------------------------------------------ (m2 <- mle2(ML1,start=as.list(coef(m1)), control=list(parscale=coef(m1)), data=list(x=orob1))) ## ----aodprof2----------------------------------------------------------------- p2 <- profile(m2,prof.upper=c(Inf,Inf,Inf,theta=2000)) ## ----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, show.points = TRUE) ## ----profplotsigma------------------------------------------------------------ ## not working? ## plot(p2b,which="sigma",plot.confstr=TRUE, show.points=TRUE) par(las = 1, bty = "l") with(p2b@profile$sigma, plot(par.vals[,"sigma"], abs(z), type = "b")) ## ----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/NEWS.Rd0000755000176200001440000004333514534716741013402 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.25.1}{ \subsection{CRAN COMPATIBILITY}{ \itemize{ \item remove/ignore spurious .Rout files } } } \section{Changes in version 1.0.25}{ \subsection{USER-VISIBLE CHANGES}{ \itemize{ \item \code{mle2.options()} function is now exported } } \subsection{CRAN COMPATIBILITY}{ \itemize{ \item vignettes will build without suggested packages } } } \section{Changes in version 1.0.24 (2021-08-06)}{ \subsection{USER-VISIBLE CHANGES}{ \itemize{ \item new \code{namedrop_args} argument to \code{mle2} (don't drop argument names within sub-lists of data) \item allow user-specified covariance matrix for importance sampling } } } \section{Changes in version 1.0.23 (2020-02-03)}{ \itemize{ \item suppress some warnings in tests for cross-platform/CRAN compatibility } } \section{Changes in version 1.0.22 (2019-12-19)}{ \subsection{BUG FIXES}{ \itemize{ \item intercept-only parameters were handled wrong (GH #8) \item fix error-handling (class vs. inherits) for R 4.0 compatibility } } \subsection{NEW FEATURES}{ \itemize{ \item \code{pop_pred_samp} to compute population prediction samples, tweaking non-positive-definite covariance matrices and using importance samples if necessary/specified. \strong{This is still VERY experimental/in flux!} \item added \code{dnorm_n} function for Normal densities with the standard deviation parameter profiled out \item add \code{slnorm} function for log-Normal densities (median and mean only for now) \item IC tables now have an \code{as.data.frame} method (from @iago-pssjd on GitHub) } } \subsection{USER-VISIBLE CHANGES}{ \itemize{ \item the evaluated \code{start} and \code{fixed} components of the call are now stored in the \code{call} component (Daniel B. Stouffer) } % itemize } % user-visible changes } % section 1.0.22 \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/0000755000176200001440000000000014234301363014726 5ustar liggesusersbbmle/inst/vignetteData/orob1.rda0000755000176200001440000000043014234301363016440 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˄eD7xKe