bbmle/0000755000176200001440000000000014102767342011341 5ustar liggesusersbbmle/NAMESPACE0000755000176200001440000000315714075064423012570 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) 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/0000755000176200001440000000000014102530504012100 5ustar liggesusersbbmle/man/profile.mle-class.Rd0000755000176200001440000001416614075064423015734 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.Rd0000755000176200001440000000211514075064423015362 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.Rd0000755000176200001440000000142014075064423014207 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.Rd0000755000176200001440000000153314075064423014740 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.Rd0000755000176200001440000002247414102530236013244 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.Rd0000755000176200001440000000220714075064423015762 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.Rd0000755000176200001440000000636414075064423013400 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.Rd0000755000176200001440000000536314075064423015515 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.Rd0000755000176200001440000000566314075064423014455 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.Rd0000644000176200001440000000374014102530355015227 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.Rd0000755000176200001440000000473614075064423014311 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.Rd0000755000176200001440000000423014075064423013673 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.Rd0000755000176200001440000000744214075064423014274 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.Rd0000755000176200001440000000260314075064423017307 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.Rd0000755000176200001440000000046614075064423014451 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.Rd0000644000176200001440000000151214075064423014035 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.Rd0000755000176200001440000000076614075064423014666 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.Rd0000755000176200001440000000107514075064423013712 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.Rd0000755000176200001440000001067214102530504013477 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.Rd0000755000176200001440000000202314075064423014210 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.Rd0000755000176200001440000000450314075064423015502 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/TODO0000755000176200001440000000753514075064423012045 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/DESCRIPTION0000644000176200001440000000226614102767342013055 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.24 Authors@R: c(person("Ben","Bolker",email="bolker@mcmaster.ca",role=c("aut","cre")), 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: 2021-08-04 21:24:59 UTC; bolker Author: Ben Bolker [aut, cre], R Development Core Team [aut], Iago Giné-Vázquez [ctb] Maintainer: Ben Bolker Repository: CRAN Date/Publication: 2021-08-05 14:00:02 UTC bbmle/build/0000755000176200001440000000000014102602653012431 5ustar liggesusersbbmle/build/vignette.rds0000644000176200001440000000044314102602653014771 0ustar liggesusersmPN0 ֭JHHEڑbLLhv%)H(+nl!s⏘2$!`!s$:Sbtpۃ-޽@+aij *4b;e TF+%vOg JK^k(iPCaܡ+I+Wf2G\ @Xf8|f#.$YyLXW 9K73^ܥf"[7qL?(*La7_ u]/1;d̡$-ќ#bbmle/tests/0000755000176200001440000000000014102602653012474 5ustar liggesusersbbmle/tests/mortanal.Rout.save0000644000176200001440000001502414075064423016131 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.R0000644000176200001440000000252314075064423017504 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.R0000644000176200001440000000064614075064423015025 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.R0000644000176200001440000000212414075064423014711 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.save0000644000176200001440000000235114075064423016653 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.R0000644000176200001440000000125414075064423014272 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.save0000644000176200001440000000576714075064423016342 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.R0000644000176200001440000000064014075064423015017 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.R0000644000176200001440000000063614075064423014114 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.save0000644000176200001440000000362414075064423016157 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.save0000644000176200001440000000351714075064423015752 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.save0000644000176200001440000000363614075064423016345 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.R0000644000176200001440000000143714075064423015037 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.save0000644000176200001440000000365114075064423016524 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.R0000644000176200001440000000130014075064423013732 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.R0000644000176200001440000000140614075064423014606 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.R0000644000176200001440000000174114075064423014262 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.R0000644000176200001440000000076014075064423014470 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.save0000644000176200001440000000302614075064423015633 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.R0000644000176200001440000000160614075064423014266 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.save0000644000176200001440000000274014075064423016652 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.R0000644000176200001440000000042314075064423014324 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.save0000644000176200001440000000243714075064423015711 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.R0000644000176200001440000000071614075064423014222 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.save0000644000176200001440000000255014075064423016014 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.save0000644000176200001440000000444014075064423016401 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/makesavefiles0000644000176200001440000000014614075064423015245 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.R0000644000176200001440000000674014075064423014451 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.R0000644000176200001440000000566714075064423014442 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/mkout0000644000176200001440000000006414075064423013564 0ustar liggesusersR CMD BATCH --vanilla $1.R; mv $1.Rout $1.Rout.save bbmle/tests/ICtab.R0000644000176200001440000000145714075064423013616 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.R0000644000176200001440000000037514075064423015155 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.save0000644000176200001440000000461614075064423016651 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.R0000644000176200001440000000327014075064423014640 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.save0000644000176200001440000000463014075064423021172 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.save0000644000176200001440000000334614075064423016512 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.save0000644000176200001440000003257114075064423016427 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.R0000644000176200001440000000122214075064423014142 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.R0000644000176200001440000000146114075064423015157 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.save0000644000176200001440000001154214075064423016114 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.save0000644000176200001440000000400514075064423016307 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.save0000644000176200001440000000420514075064423015426 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.R0000644000176200001440000000041214075064423013217 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.R0000644000176200001440000000064214075064423015167 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.R0000644000176200001440000000145214075064423014317 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.R0000644000176200001440000000052114075064423015024 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.save0000644000176200001440000000467114075064423016012 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.save0000644000176200001440000000520114075064423015753 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.save0000644000176200001440000000331214075064423015273 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.save0000644000176200001440000000227714075064423014717 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.R0000644000176200001440000000163614075064423014656 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.save0000644000176200001440000000722414075064423016111 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.R0000644000176200001440000002701414075064423014736 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.save0000644000176200001440000000620414075064423015243 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/testbounds.Rout0000644000176200001440000000237514075064423015556 0ustar liggesusers R version 2.8.1 (2008-12-22) Copyright (C) 2008 The R Foundation for Statistical Computing ISBN 3-900051-07-0 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > x <- runif(10) > y <- 1+x+rnorm(10,sd=0.1) > > library(bbmle) > m1 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1))) > > m2 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), + method="L-BFGS-B",lower=c(a=0,b=0,s=-Inf)) > > m2F = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), + method="L-BFGS-B",lower=c(a=0,b=0,s=-Inf), + fixed=list(a=1)) Warning message: In mle2(y ~ dnorm(a + b * x, sd = exp(s)), start = list(a = 1, b = 1, : length mismatch between lower/upper and number of non-fixed parameters > > > proc.time() user system elapsed 1.008 0.024 1.044 bbmle/tests/glmcomp.Rout.save0000644000176200001440000000335314075064423015754 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.R0000644000176200001440000004213314075064423015175 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.R0000644000176200001440000000117414075064423015165 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.R0000644000176200001440000000327614075064423013564 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.save0000644000176200001440000005131314075064423016662 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.save0000644000176200001440000000357114075064423015602 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.R0000644000176200001440000000411314075064423014416 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/binomtest1.Rout0000644000176200001440000000663114075064423015450 0ustar liggesusers R version 2.11.1 (2010-05-31) Copyright (C) 2010 The R Foundation for Statistical Computing ISBN 3-900051-07-0 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > > library(bbmle) Loading required package: stats4 Loading required package: numDeriv > > funcresp <- + structure(list(Initial = as.integer(c(5, 5, 10, 10, 15, 15, 20, + 20, 30, 30, 50, 50, 75, 75, 100, 100)), Killed = as.integer(c(1, + 2, 5, 6, 10, 9, 7, 10, 11, 15, 5, 21, 32, 18, 25, 35))), .Names = c("Initial", + "Killed"), class = "data.frame", row.names = c("1", "2", "3", + "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", + "16")) > > attach(funcresp) > > binomNLL2 = function(p) { + a = p[1] + h = p[2] + ## cat(a,h,"\n") + p = a/(1+a*h*N) + -sum(dbinom(k,prob=p,size=N,log=TRUE)) + } > > N=0; k=0 > parnames(binomNLL2) = c("a","h") > m2a = mle2(binomNLL2,start=c(a=0.5,h=0.0125), + data=list(N=Initial,k=Killed)) > p1a = profile(m2a); p1a There were 50 or more warnings (use warnings() to see the first 50) Likelihood profile: $a z par.vals.a par.vals.h 1 -4.2047344 0.294898645 -0.002923466 2 -3.1552066 0.341179554 0.002586064 3 -2.2351038 0.387460464 0.007009828 4 -1.4145435 0.433741374 0.010694613 5 -0.6726261 0.480022283 0.013859302 6 0.0000000 0.526303193 0.016643616 7 0.6321738 0.572584102 0.019113307 8 1.2156051 0.618865012 0.021399150 9 1.7630606 0.665145921 0.023494921 10 2.2804928 0.711426831 0.025475099 11 2.7729144 0.757707740 0.027355948 12 3.2447726 0.803988650 0.029170757 13 3.7001523 0.850269559 0.030945274 $h z par.vals.a par.vals.h 1 -3.7637543 0.3268572493 -0.0024273676 2 -3.1748327 0.3542640536 0.0007511297 3 -2.5644438 0.3843760379 0.0039296269 4 -1.9359396 0.4170494900 0.0071081242 5 -1.2938745 0.4519556085 0.0102866214 6 -0.6437592 0.4886001613 0.0134651187 7 0.0000000 0.5263031926 0.0166436159 8 0.6563173 0.5646512092 0.0198221132 9 1.2951023 0.6028512247 0.0230006104 10 1.9201220 0.6405127788 0.0261791077 11 2.5281012 0.6773052997 0.0293576049 12 3.1168240 0.7130175259 0.0325361022 13 3.6849884 0.7475421634 0.0357145994 > c2a = confint(p1a); c2a 2.5 % 97.5 % a 0.402495803 0.68249529 h 0.006987227 0.02638541 > > binomNLL2b = function(p,N,k) { + a = p[1] + h = p[2] + ## cat(a,h,"\n") + p = a/(1+a*h*N) + -sum(dbinom(k,prob=p,size=N,log=TRUE)) + } > parnames(binomNLL2b) = c("a","h") > m2b = mle2(binomNLL2,start=c(a=0.5,h=0.0125), + data=list(N=Initial,k=Killed)) > c2b = confint(m2b) There were 50 or more warnings (use warnings() to see the first 50) > > N=Initial; k=Killed > m2c = mle2(binomNLL2,start=c(a=0.5,h=0.0125)) > c2c = confint(m2c); c2c There were 50 or more warnings (use warnings() to see the first 50) 2.5 % 97.5 % a 0.402495803 0.68249529 h 0.006987227 0.02638541 > > detach(funcresp) > > > proc.time() user system elapsed 4.572 0.048 4.676 bbmle/tests/profbound.R0000644000176200001440000000213614075064423014625 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.R0000644000176200001440000000130014075064423014265 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/0000755000176200001440000000000014102602653013342 5ustar liggesusersbbmle/vignettes/mle2.bib0000755000176200001440000000074114075064423014672 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.Rnw0000755000176200001440000007547114102600142014701 0ustar liggesusers\documentclass{article} %\VignetteIndexEntry{Examples for enhanced mle code} %\VignettePackage{bbmle} %\VignetteDepends{Hmisc} %\VignetteDepends{emdbook} %\VignetteDepends{ggplot2} %\VignetteDepends{lattice} %\VignetteEngine{knitr::knitr} \usepackage[utf8]{inputenc} % for UTF-8/single quotes from sQuote() \usepackage[english]{babel} % for texi2dvi ~ bug \usepackage{graphicx} \usepackage{natbib} \usepackage{array} \usepackage{color} \usepackage[colorlinks=true,urlcolor=blue,bookmarks=true]{hyperref} \usepackage{url} \author{Ben Bolker} \title{Maximum likelihood estimation and analysis with the \code{bbmle} package} \newcommand{\code}[1]{{\tt #1}} \newcommand{\bbnote}[1]{\color{red} {\em #1} \color{black}} \date{\today} \begin{document} \bibliographystyle{chicago} %\bibliographystyle{plain} \maketitle \tableofcontents <>= if (require("knitr")) opts_chunk$set(fig.width=5,fig.height=5,tidy=FALSE,warning=FALSE,error=TRUE) @ <>= library(Hmisc) @ The \code{bbmle} package, designed to simplify maximum likelihood estimation and analysis in R, extends and modifies the \code{mle} function and class in the \code{stats4} package that comes with R by default. \code{mle} is in turn a wrapper around the \code{optim} function in base R. The maximum-likelihood-estimation function and class in \code{bbmle} are both called \code{mle2}, to avoid confusion and conflict with the original functions in the \code{stats4} package. The major differences between \code{mle} and \code{mle2} are: \begin{itemize} \item \code{mle2} is more robust, with additional warnings (e.g. if the Hessian can't be computed by finite differences, \code{mle2} returns a fit with a missing Hessian rather than stopping with an error) \item \code{mle2} uses a \code{data} argument to allow different data to be passed to the negative log-likelihood function \item \code{mle2} has a formula interface like that of (e.g.) \code{gls} in the \code{nlme} package. For relatively simple models the formula for the maximum likelihood can be written in-line, rather than defining a negative log-likelihood function. The formula interface also simplifies fitting models with categorical variables. Models fitted using the formula interface also have applicable \code{predict} and \code{simulate} methods. \item \code{bbmle} defines \code{anova}, \code{AIC}, \code{AICc}, and \code{BIC} methods for \code{mle2} objects, as well as \code{AICtab}, \code{BICtab}, \code{AICctab} functions for producing summary tables of information criteria for a set of models. \end{itemize} Other packages with similar functionality (extending GLMs in various ways) are \begin{itemize} \item on CRAN: \code{aods3} (overdispersed models such as beta-binomial); \code{vgam} (a wide range of models); \code{betareg} (beta regression); \code{pscl} (zero-inflated, hurdle models); \code{maxLik} (another general-purpose maximizer, with a different selection of optimizers) \item In Jim Lindsey's code repository (\url{http://popgen.unimaas.nl/~jlindsey/rcode.html}): \code{gnlr} and \code{gnlr3} \end{itemize} \section{Example: \emph{Orobanche}/overdispersed binomial} This example will use the classic data set on \emph{Orobanche} germination from \cite{Crowder1978} (you can also use \code{glm(...,family="quasibinomial")} or the \code{aods3} package to analyze these data). \subsection{Test basic fit to simulated beta-binomial data} First, generate a single beta-binomially distributed set of points as a simple test. Load the \code{emdbook} package to get functions for the beta-binomial distribution (random-deviate function \code{rbetabinom} --- these functions are also available in Jim Lindsey's \code{rmutil} package). <>= library(emdbook) @ Generate random deviates from a random beta-binomial: <>= set.seed(1001) x1 <- rbetabinom(n=1000,prob=0.1,size=50,theta=10) @ Load the package: <>= library(bbmle) @ Construct a simple negative log-likelihood function: <>= mtmp <- function(prob,size,theta) { -sum(dbetabinom(x1,prob,size,theta,log=TRUE)) } @ Fit the model --- use \code{data} to pass the \code{size} parameter (since it wasn't hard-coded in the \code{mtmp} function): <>= 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: <>= ML1 <- function(prob1,prob2,prob3,theta,x) { prob <- c(prob1,prob2,prob3)[as.numeric(x$dilution)] size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } @ Results from \cite{Crowder1978}: <>= crowder.results <- matrix(c(0.132,0.871,0.839,78.424,0.027,0.028,0.032,-34.991, rep(NA,7),-34.829, rep(NA,7),-56.258), dimnames=list(c("prop diffs","full model","homog model"), c("prob1","prob2","prob3","theta","sd.prob1","sd.prob2","sd.prob3","NLL")), byrow=TRUE,nrow=3) latex(crowder.results,file="",table.env=FALSE,title="model") @ <>= (m1 <- mle2(ML1,start=list(prob1=0.5,prob2=0.5,prob3=0.5,theta=1), data=list(x=orob1))) @ Or: <>= ## would prefer ~dilution-1, but problems with starting values ... (m1B <- mle2(m~dbetabinom(prob,size=n,theta), param=list(prob~dilution), start=list(prob=0.5,theta=1), data=orob1)) @ The result warns us that the optimization has not converged; we also don't match Crowder's results for $\theta$ exactly. We can fix both of these problems by setting \code{parscale} appropriately. Since we don't bound $\theta$ (or below, $\sigma$) we get a fair number of warnings with this and the next few fitting and profiling attempts. We will ignore these for now, since the final results reached are reasonable (and match or nearly match Crowder's values); the appropriate, careful thing to do would be either to fit on a transformed scale where all real-valued parameter values were legal, or to use \code{method="L-BFGS-B"} (or \code{method="bobyqa"} with the \code{optimx} package) to bound the parameters appropriately. You can also use \code{suppressWarnings()} if you're sure you don't need to know about any warnings (beware: this will suppress \emph{all} warnings, those you weren't expecting as well as those you were \ldots) <>= opts_chunk$set(warning=FALSE) @ <>= (m2 <- mle2(ML1,start=as.list(coef(m1)), control=list(parscale=coef(m1)), data=list(x=orob1))) @ Calculate likelihood profile (restrict the upper limit of $\theta$, simply because it will make the picture below a little bit nicer): <>= p2 <- profile(m2,prof.upper=c(Inf,Inf,Inf,theta=2000)) @ Get the curvature-based parameter standard deviations (which Crowder used rather than computing likelihood profiles): <>= round(stdEr(m2),3) @ We are slightly off Crowder's numbers --- rounding error? Crowder also defines a variance (overdispersion) parameter $\sigma^2=1/(1+\theta)$. <>= sqrt(1/(1+coef(m2)["theta"])) @ Using the delta method (via the \code{deltavar} function in the \code{emdbook} package) to approximate the standard deviation of $\sigma$: <>= sqrt(deltavar(sqrt(1/(1+theta)),meanval=coef(m2)["theta"], vars="theta",Sigma=vcov(m2)[4,4])) @ Another way to fit in terms of $\sigma$ rather than $\theta$ is to compute $\theta=1/\sigma^2-1$ on the fly in a formula: <>= m2b <- mle2(m~dbetabinom(prob,size=n,theta=1/sigma^2-1), data=orob1, parameters=list(prob~dilution,sigma~1), start=list(prob=0.5,sigma=0.1)) ## ignore warnings (we haven't bothered to bound sigma<1) round(stdEr(m2b)["sigma"],3) p2b <- profile(m2b,prof.lower=c(-Inf,-Inf,-Inf,0)) @ As might be expected since the standard deviation of $\sigma$ is large, the quadratic approximation is poor: <>= r1 <- rbind(confint(p2)["theta",], confint(m2,method="quad")["theta",]) rownames(r1) <- c("spline","quad") r1 @ Plot the profile: <>= plot(p2,which="theta",plot.confstr=TRUE) @ What does the profile for $\sigma$ look like? <>= plot(p2b,which="sigma",plot.confstr=TRUE, show.points=TRUE) @ Now fit a homogeneous model: <>= ml0 <- function(prob,theta,x) { size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } m0 <- mle2(ml0,start=list(prob=0.5,theta=100), data=list(x=orob1)) @ The log-likelihood matches Crowder's result: <>= logLik(m0) @ It's easier to use the formula interface to specify all three of the models fitted by Crowder (homogeneous, probabilities differing by group, probabilities and overdispersion differing by group): <>= m0f <- mle2(m~dbetabinom(prob,size=n,theta), parameters=list(prob~1,theta~1), data=orob1, start=list(prob=0.5,theta=100)) m2f <- update(m0f, parameters=list(prob~dilution,theta~1), start=list(prob=0.5,theta=78.424)) m3f <- update(m0f, parameters=list(prob~dilution,theta~dilution), start=list(prob=0.5,theta=78.424)) @ \code{anova} runs a likelihood ratio test on nested models: <>= anova(m0f,m2f,m3f) @ The various \code{ICtab} commands produce tables of information criteria; by default the results are sorted and presented as $\Delta$IC; there are various options, including printing model weights. <>= AICtab(m0f,m2f,m3f,weights=TRUE) BICtab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) AICctab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) @ <>= opts_chunk$set(warning=FALSE) @ \section{Example: reed frog size predation} Data from an experiment by Vonesh \citep{VoneshBolker2005} <>= frogdat <- data.frame( size=rep(c(9,12,21,25,37),each=3), killed=c(0,2,1,3,4,5,rep(0,4),1,rep(0,4))) frogdat$initial <- rep(10,nrow(frogdat)) @ <>= library(ggplot2) @ <>= gg1 <- ggplot(frogdat,aes(x=size,y=killed))+geom_point()+ stat_sum(aes(size=..n..))+ labs(size="#")+scale_x_continuous(limits=c(0,40))+ scale_size(breaks=1:3) @ <>= m3 <- mle2(killed~dbinom(prob=c*(size/d)^g*exp(1-size/d), size=initial),data=frogdat,start=list(c=0.5,d=5,g=1)) pdat <- data.frame(size=1:40,initial=rep(10,40)) pdat1 <- data.frame(pdat,killed=predict(m3,newdata=pdat)) @ <>= m4 <- mle2(killed~dbinom(prob=c*((size/d)*exp(1-size/d))^g, size=initial),data=frogdat,start=list(c=0.5,d=5,g=1)) pdat2 <- data.frame(pdat,killed=predict(m4,newdata=pdat)) @ <>= gg1 + geom_line(data=pdat1,colour="red")+ geom_line(data=pdat2,colour="blue") @ <>= coef(m4) prof4 <- profile(m4) @ Three different ways to draw the profile: (1) Built-in method (base graphics): <>= plot(prof4) @ (2) Using \code{xyplot} from the \code{lattice} package: \setkeys{Gin}{width=\textwidth} <>= prof4_df <- as.data.frame(prof4) library(lattice) xyplot(abs(z)~focal|param,data=prof4_df, subset=abs(z)<3, type="b", xlab="", ylab=expression(paste(abs(z), " (square root of ",Delta," deviance)")), scale=list(x=list(relation="free")), layout=c(3,1)) @ (3) Using \code{ggplot} from the \code{ggplot2} package: <>= ss <-subset(prof4_df,abs(z)<3) ggplot(ss, aes(x=focal,y=abs(z)))+geom_line()+ geom_point()+ facet_grid(.~param,scale="free_x") @ \section*{Additions/enhancements/differences from \code{stats4::mle}} \begin{itemize} \item{\code{anova} method} \item{warnings on convergence failure} \item{more robust to non-positive-definite Hessian; can also specify \code{skip.hessian} to skip Hessian computation when it is problematic} \item{when profiling fails because better value is found, report new values} \item{can take named vectors as well as lists as starting parameter vectors} \item{added \code{AICc}, \code{BIC} definitions, \code{ICtab} functions} \item{added \code{"uniroot"} and \code{"quad"} options to \code{confint}} \item{more options for colors and line types etc etc. The old arguments are: <>= function (x, levels, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, absVal = TRUE, ...) {} @ The new one is: <>= function (x, levels, which=1:p, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, plot.confstr = FALSE, confstr = NULL, absVal = TRUE, add = FALSE, col.minval="green", lty.minval=2, col.conf="magenta", lty.conf=2, col.prof="blue", lty.prof=1, xlabs=nm, ylab="score", show.points=FALSE, main, xlim, ylim, ...) {} @ \code{which} selects (by character vector or numbers) which parameters to plot: \code{nseg} does nothing (even in the old version); \code{plot.confstr} turns on the labels for the confidence levels; \code{confstr} gives the labels; \code{add} specifies whether to add the profile to an existing plot; \code{col} and \code{lty} options specify the colors and line types for horizontal and vertical lines marking the minimum and confidence vals and the profile curve; \code{xlabs} gives a vector of x labels; \code{ylab} gives the y label; \code{show.points} specifies whether to show the raw points computed. } \item{\code{mle.options()}} \item{\code{data} argument} \item{handling of names in argument lists} \item{can use alternative optimizers (\code{nlminb}, \code{nlm}, \code{constrOptim}, \code{optimx}, \code{optimize})} \item{uses code from \code{numDeriv} package to compute Hessians rather than built-in optimizer code} \item{by default, uses \code{MASS::ginv} (generalized inverse) rather than \code{solve} to invert Hessian (more robust to positive-semidefinite Hessians \ldots)} \item{can use \code{vecpar=TRUE} (and \code{parnames()}) to use objective functions with parameters specified as vectors (for compatibility with \code{optim} etc.)} \end{itemize} \section{Newer stuff} \textbf{To do:} \begin{itemize} \item{use \code{predict}, \code{simulate} etc. to demonstrate different parametric bootstrap approaches to confidence and prediction intervals \begin{itemize} \item use \code{predict} to get means and standard deviations, use delta method? \item use \code{vcov}, assuming quadratic profiles, with \code{predict(\ldots,newparams=\ldots)} \item prediction intervals assuming no parameter uncertainty with \code{simulate} \item both together \ldots \end{itemize} } \end{itemize} \section{Technical details} \subsection{Profiling and confidence intervals} This section describes the algorithm for constructing profiles and confidence intervals, which is not otherwise documented anywhere except in the code. * indicates changes from the version in \code{stats4:::mle} \subsubsection{Estimating standard error} In order to construct the profile for a particular parameter, one needs an initial estimate of the scale over which to vary that parameter. The estimated standard error of the parameter based on the estimated curvature of the likelihood surface at the MLE is a good guess. \begin{itemize} \item if \code{std.err} is missing, extract the standard error from the summary coefficient table (ultimately computed from \code{sqrt(diag(inverse Hessian))} of the fit) \item * a user-set value of \code{std.err} overrides this behavior unless the value is specified as \code{NA} (in which case the estimate from the previous step is used) \item * if the standard error value is still \code{NA} (i.e. the user did not specify it and the value estimated from the Hessian is missing or \code{NA}) use \code{sqrt(1/diag(hessian))}. This represents a (fairly feeble) attempt to come up with a plausible number when the Hessian is not positive definite but still has positive diagonal entries \item if all else fails, stop and * print an error message that encourages the user to specify the values with \code{std.err} \end{itemize} There may be further tricks that would help guess the appropriate scale: for example, one could guess on the basis of a comparison between the parameter values and negative log-likelihoods at the starting and ending points of the fits. On the other hand, (a) this would take some effort and still be subject to failure for sufficiently pathological fits and (b) there is some value to forcing the user to take explicit, manual steps to remedy such problems, as they may be signs of poorly defined or buggy log-likelihood functions. \subsubsection{Profiling} Profiling is done on the basis of a constructed function that minimizes the negative log-likelihood for a fixed value of the focal parameter and returns the signed square-root of the deviance difference from the minimum (denoted by $z$). At the MLE $z=0$ by definition; it should never be $<0$ unless something has gone wrong with the original fit. The LRT significance cutoffs for $z$ are equal to the usual two-tailed normal distribution cutoffs (e.g. $\pm \approx 1.96$ for 95\% confidence regions). In each direction (decreasing and increasing from the MLE for the focal parameter): \begin{itemize} \item fix the focal parameter \item adjust control parameters etc. accordingly (e.g. remove the entry for the focal parameter so that the remaining control parameters match the non-fixed parameters) \item{controls on the profiling (which can be set manually, but for which there is not much guidance in the documentation): \begin{itemize} \item \code{zmax} Maximum $z$ to aim for. (Default: \code{sqrt(qchisq(1-alpha/2, p))}) The default maximum $\alpha$ (type~I error) is 0.01. \bbnote{I don't understand this criterion. It seems to expand the size of the univariate profile to match a cutoff for the multivariate confidence region of the model. The $\chi^2$ cutoff for deviance to get the $(1-\alpha)$ multivariate confidence region (i.e., on all $p$ of the parameters) would be \code{qchisq(1-alpha,p)} --- % representing a one-tailed test on the deviance. Taking the square root makes sense, since we are working with the square root of the deviance, but I don't understand (1) why we are expanding the region to allow for the multivariate confidence region (since we are computing univariate profiles) [you could at least argue that this is conservative, making the region a little bigger than it needs to be]; (2) why we are using $1-\alpha/2$ rather than $1-\alpha$. } For comparison, \code{MASS::profile.glm} (written by Bates and Venables in 1996, ported to R by BDR in 1998) uses \code{zmax}=\code{sqrt(qchisq(1-alpha,1))} \bbnote{(this makes more sense to me \ldots)}. On the other hand, the profiling code in \code{lme4a} (the \code{profile} method for \code{merMod}, in \code{profile.R}) uses \code{qchisq(1-alphamax, nptot)} \ldots \item \code{del} Step size (scaled by standard error) (Default: \code{zmax}/5.) Presumably (?) copied from \code{MASS::profile.glm}, which says (in \code{?profile.glm}): ``[d]efault value chosen to allow profiling at about 10 parameter values.'' \item \code{maxsteps} Maximum number of profiling steps to try in each direction. (Default: 100) \end{itemize} } \item While \verb+step 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.bst0000755000176200001440000011105114075064423015461 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.Rnw0000755000176200001440000001465214075064423015175 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}} <>= library(AICcmodavg) aictab(list(glmOT.D93,glmT.D93,glmO.D93,glmX.D93), modnames=c("OT","T","O","X"), c.hat=dfun(glmOT.D93)) detach("package:AICcmodavg") @ \subsection*{\code{MuMIn}} <>= library(MuMIn); packageVersion("MuMIn") ## from ?QAIC x.quasipoisson <- function(...) { res <- quasipoisson(...) res$aic <- poisson(...)$aic res } glmQOT2.D93 <- update(glmOT.D93,family="x.quasipoisson", na.action=na.fail) (gg <- dredge(glmQOT2.D93,rank="QAIC", chat=dfun(glmOT.D93))) (ggc <- dredge(glmQOT2.D93,rank="QAICc",chat=dfun(glmOT.D93))) detach("package:MuMIn") @ Notes: ICtab only gives delta-IC, limited decimal places (on purpose, but how do you change these defaults if you want to?). Need to add 1 to parameters to account for scale parameter. When doing corrected-IC you need to get the absolute number of parameters right, not just the relative number \ldots Not sure which classes of models each of these will handle (lm, glm, (n)lme, lme4, mle2 \ldots). Remember need to use overdispersion parameter from most complex model. glmmPQL: needs to be hacked somewhat more severely (does not contain deviance element, logLik has been NA'd out). \begin{tabular}{l|ccccccc} package & \code{lm} & \code{glm} & \code{(n)lme} & \code{multinom} & \code{polr} & \code{lme4} & \code{mle2} \\ \hline \code{AICcmodavg} & y & y & y & y & y & ? & ? \\ \code{MuMIn} & ? & ? & ? & ? & ? & ? & ? \\ \code{mle2 } & ? & ? & ? & ? & ? & ? & ? \end{tabular} \end{document} bbmle/R/0000755000176200001440000000000014075064423011541 5ustar liggesusersbbmle/R/dists.R0000755000176200001440000000447414075064423013026 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.R0000755000176200001440000000266214075064423013157 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.R0000755000176200001440000001315114075064423013330 0ustar liggesuserssetMethod("confint", "profile.mle2", function (object, parm, level = 0.95, trace=FALSE, ...) { Pnames <- names(object@profile) if (missing(parm)) parm <- Pnames if (is.character(parm)) parm <- match(parm,Pnames) if (any(is.na(parm))) stop("parameters not found in profile") ## Calculate confidence intervals based on likelihood ## profiles a <- (1 - level)/2 a <- c(a, 1 - a) pct <- paste(round(100 * a, 1), "%") ci <- array(NA, dim = c(length(parm), 2), dimnames = list(Pnames[parm], pct)) cutoff <- qnorm(a) for (pm in parm) { pro <- object@profile[[Pnames[pm]]] pv <- pro[,"par.vals"] if (is.matrix(pv)) pv <- pv[,Pnames[pm]] if (any(diff(pro[,1])<0)) { warning(paste("non-monotonic profile (", Pnames[pm],"): reverting from spline to linear approximation ", "(consider running 'profile' with manually reduced std.err)", sep="")) tt <- approx(pro[,1],pv,xout=cutoff)$y } else { sp <- spline(x = pv, y = pro[, 1]) if (any(diff(sp$y)<0)) { warning(paste("non-monotonic spline fit to profile (", Pnames[pm],"): reverting from spline to linear approximation",sep="")) tt <- approx(pro[,1],pv,xout=cutoff)$y } else { tt <- try(approx(sp$y, sp$x, xout = cutoff)$y,silent=TRUE) if (inherits(tt,"try-error")) tt <- rep(NA,2) } } if (!any(is.na(tt))) { ## if NAs present, sort() will drop NAs ... tt <- sort(tt) } ci[Pnames[pm], ] <- tt } drop(ci) }) setMethod("confint", "mle2", function (object, parm, level = 0.95, method, trace=FALSE,quietly=!interactive(), tol.newmin=0.001,...) { if (missing(method)) method <- mle2.options("confint") ## changed coef() calls to object@coef -- really *don't* want fullcoef! Pnames <- names(object@coef) if (missing(parm)) parm <- seq(along=Pnames) if (is.character(parm)) parm <- match(parm,Pnames) if (any(is.na(parm))) stop("parameters not found in model coefficients") if (method=="spline") { if (!quietly) message("Profiling...\n") newpars_found <- FALSE prof = try(profile(object,which=parm,tol.newmin=tol.newmin,...)) if (inherits(prof,"try-error")) stop(paste("Problem with profiling:",prof)) if (class(prof)=="mle2") newpars_found <- TRUE if (newpars_found) { ## profiling found a better fit message("returning better fit\n") return(prof) } return(confint(prof, parm, level, ...)) } else { B0 <- object@coef pnames <- names(B0) if (missing(parm)) parm <- seq(along=pnames) if (is.character(parm)) parm <- match(parm, pnames, nomatch = 0) a <- (1 - level)/2 a <- c(a, 1 - a) pct <- paste(round(100 * a, 1), "%") pct <- paste(round(100 * a, 1), "%") ci <- array(NA, dim = c(length(parm), 2), dimnames = list(pnames[parm], pct)) std.err <- summary(object)@coef[, "Std. Error"] if (method=="uniroot") { chisqcutoff <- qchisq(level,1) call <- object@call if (!isTRUE(call$vecpar)) call$start <- as.list(B0) ## added upper <- rep(unlist(eval.parent(call$upper)),length.out=length(pnames)) lower <- rep(unlist(eval.parent(call$lower)),length.out=length(pnames)) for (pm in parm) { critfun <- function(bi) { fix <- list(bi) names(fix) <- pnames[pm] call$fixed <- c(fix,eval(call$fixed)) if (!is.null(upper) && length(upper)>1) call$upper <- upper[-pm] if (!is.null(lower) && length(lower)>1) call$lower <- lower[-pm] pfit <- try(eval(call), silent=TRUE) if(inherits(pfit, "try-error")) { warning(paste("Error encountered in profile (uniroot):",pfit)) return(NA) } else { zz <- 2*pfit@min - 2*(-logLik(object)) if (zz > -tol.newmin) zz <- max(zz, 0) else stop(sprintf("profiling has found a better solution (old deviance=%.2f, new deviance=%.2f), so original fit had not converged",2*pfit@min,2*(-logLik(object)))) z <- zz - chisqcutoff } if (trace) cat(bi, z, "\n") z } stepfun <- function(step) { B0[pm] + sgn * step * std.err[pm] } invstepfun <- function(out) { (out - B0[pm])/(sgn * std.err[pm]) } sgnvec=c(-1,1) for (i in 1:2) { sgn <- sgnvec[i] bnd <- if (sgn<0) { if (is.null(lower)) -Inf else lower[pm] } else { if (is.null(upper)) Inf else upper[pm] } c0 <- critfun(B0[pm]) bi <- ctry <- pmin(5,invstepfun(bnd)) cdel <- -0.25 c5 <- NA while (is.na(c5) && ctry>0 ) { c5 <- critfun(stepfun(ctry)) if (is.na(c5)) { if (trace) cat("encountered NA, reducing ctry to",ctry+cdel,"\n") ctry <- ctry+cdel } } if (trace) cat(c0,c5,"\n") if (is.na(c0*c5) || c0*c5>0) { warning(paste("can't find confidence limits in", c("negative","positive")[i],"direction")) curci <- NA ## FIXME: could try harder! } else { curci <- uniroot(critfun,c(stepfun(0),stepfun(ctry)))$root } ci[pnames[pm],i] <- curci } } } else if (method=="quad") { for (pm in parm) { ci[pnames[pm],] <- qnorm(a,B0[pm],std.err[pm]) } } else stop("unknown method") return(drop(ci)) } }) bbmle/R/predict.R0000755000176200001440000001056014075064423013323 0ustar liggesuserssetGeneric("simulate", function(object, nsim=1, seed=NULL, ...) standardGeneric("simulate")) setMethod("simulate", "mle2", function(object, nsim=1, seed, newdata=NULL, newparams=NULL, ...) { if (!is.null(seed)) set.seed(seed) if (!is.null(newparams)) { object@fullcoef <- newparams } g <- gfun(object,newdata=newdata, nsim=nsim,op="simulate") if (nsim>1) { g <- matrix(g,ncol=nsim) } g }) setGeneric("predict", function(object, ...) standardGeneric("predict")) setMethod("predict", "mle2", function(object,newdata=NULL, location="mean",newparams=NULL, ...) { if (!is.null(newparams)) { object@fullcoef <- newparams } gfun(object,newdata=newdata,location=location,op="predict") }) setGeneric("residuals", function(object, ...) standardGeneric("residuals")) setMethod("residuals", "mle2", function(object, type=c("pearson","response"), location="mean", ...) { type <- match.arg(type) location <- match.arg(location) pred <- predict(object,location) ## not sure this will work ... obs <- with(object@data, get(gsub("~.+","",object@formula))) res <- obs-pred if (type=="response") return(res) vars <- predict(object,location="variance") return(res/sqrt(vars)) }) ## general-purpose function for simulation and ## prediction (the hard part is evaluating the parameters etc.) ## gfun <- function(object,newdata=NULL,location=c("mean","median","variance"), nsim, op=c("predict","simulate")) { ## notes: should operate on formula ## pull out call$formula (not character) location <- match.arg(location) if (class(try(form <- as.formula(object@call$minuslogl)))!="formula") stop("can only use predict() if formula specified") LHS <- form[[3]] ddist = as.character(LHS[[1]]) spref <- switch(op,predict="s",simulate="r") sdist = gsub("^d",spref,ddist) arglist = as.list(LHS)[-1] if (!exists(sdist) || !is.function(get(sdist))) stop("function ",sdist," does not exist") ## evaluate parameters ## evaluate sdist [ newdata > coef > data ] ## if (is.null(object@data)) { ## comb <- newdata ## } else { ## nmatch <- match(names(newdata),names(object@data)) ## comb <- object@data ## comb[na.omit(nmatch)] <- newdata[!is.na(nmatch)] ## comb <- c(comb,newdata[is.na(nmatch)]) ## } ## comb <- c(newdata,object@data) ## comb <- comb[!duplicated(names(comb))] ## comb <- comb[sapply(comb,length)>0] ## rvar <- strsplit(object@formula,"~")[[1]][1] ## comb <- comb[!names(comb)==rvar] ## remove response variable parameters <- eval(object@call$parameters) if (!is.null(parameters)) { vars <- as.character(sapply(parameters,"[[",2)) models <- sapply(parameters,function(z) call.to.char(z[[3]])) parameters <- parameters[models!="1"] npars <- length(parameters) if (npars==0) { ## no non-constant parameters parameters <- mmats <- vpos <- NULL } else { mmats <- list() vpos <- list() for (i in seq(along=parameters)) { vname <- vars[i] p <- parameters[[i]] p[[2]] <- NULL mmat <- with(c(newdata,object@data), model.matrix(p,data=environment())) ## c(as.list(newdata),as.list(object@data))) pnames <- paste(vname,colnames(mmat),sep=".") assign(vname,mmat %*% coef(object)[pnames]) } } } arglist1 <- lapply(arglist,eval,envir=c(newdata,object@data, as.list(coef(object))), enclos=sys.frame(sys.nframe())) ## HACK: need a way to figure out how many data points there ## are, in the *absence* of an explicit data argument ## then replicate constant values to the full length if (op=="simulate") { if (length(object@data)==0) stop("need explicit data argument for simulation") ndata <- max(sapply(c(newdata,object@data),length)) ## ??? arglist1 <- c(arglist1,list(n=ndata*nsim)) } vals <- with(as.list(coef(object)),do.call(sdist,arglist1)) if (op=="predict") return(vals[[location]]) else return(vals) } bbmle/R/IC.R0000755000176200001440000002312714075064423012167 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,class)=="mle2")) stop("all objects in list must be class mle2") logLiks <- lapply(L, logLik) AICs <- sapply(logLiks,qAIC, k=k, dispersion=dispersion) df <- sapply(L,attr,"df") data.frame(AIC=AICs,df=df) } else { qAIC(logLik(object), k=k, dispersion=dispersion) } }) bbmle/R/mle.R0000755000176200001440000007742414075064423012462 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.R0000755000176200001440000000250714075064423013635 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.R0000755000176200001440000001410514075064423014170 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.R0000755000176200001440000003061114075064423012767 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.R0000644000176200001440000000065714075064423012316 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.R0000755000176200001440000004623014075064423013334 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.R0000644000176200001440000001620414075064423013335 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/MD50000644000176200001440000001374314102767342011661 0ustar liggesusers201ab71e06302dee6f00c3e44ef5b9d8 *DESCRIPTION 4a1b816656212461184b14d0bc631fb0 *NAMESPACE 51c80cbebf520b0ab4ff12482aaba1f1 *R/IC.R fd11243c6638822be02086af452ff491 *R/TMB.R 3547798b5af91c95a35a011f2a3bffa4 *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 2d3da6aaa0a07bd64c320a718d87d31e *R/predict.R e826fb38e19883fcd675abc903c369cf *R/profile.R bf85786fd72d16fb2d2c5606883fbb95 *R/slice.R 28b4b4a714c1beebcc7516b888e1b641 *R/update.R 5823f8cd791ae8b928578e26674be46f *TODO f5e63a5d12737536a08c7a0fd736dc3c *build/vignette.rds 7668e128f88692ebbd2dd4b32bc40c64 *inst/NEWS.Rd 295182c45f6c0c87dea2cb6bda2541d0 *inst/doc/mle2.R 49717b248d52829925e79701d87870f4 *inst/doc/mle2.Rnw 5d8847793189cc72f662d73f52391de9 *inst/doc/mle2.pdf b337e45ba4de491f49dcc9b67e5b6c0d *inst/doc/quasi.R f9f39bc36192d155f6d71dba2f50e560 *inst/doc/quasi.Rnw 8128faeda4d55ec1347e0e60d42300b6 *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 138465684c603e66d87035baabc03f65 *tests/binomtest1.Rout de4898499c070e21485ddaed01e73c09 *tests/binomtest1.Rout.save bf9cb0badb64c11e22d1b7d15c060a73 *tests/boundstest.R 055f3f858af92dac796c775fdb6cffe5 *tests/controleval.R 54d3a16476aff59b8947a9b218733be5 *tests/controleval.Rout.save 4421d42f41892221c6604df13514fab4 *tests/eval.R 3d411aa0bc3cdad597b17fde4b539732 *tests/eval.Rout.save 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 9a4d9c64de4b0d973bbf93715fa3e3f7 *tests/testbounds.Rout 375be792dbfd82d6d56aeb19006488af *tests/testbounds.Rout.save ba254da51e09a22e84f803832382fc11 *tests/testderiv.R 318b6a073389d6638ba88b2892421af9 *tests/testderiv.Rout.save 8f40025fa6fd7986d5dcb818fce9e100 *tests/testenv.R 1e954bdb02ce9e9d3814cb94ca002bd1 *tests/testenv.Rout.save 6a8dd303587eaf35a465b2e062264b50 *tests/testparpred.R 01059ad5c653ce771ecbd81d4946026f *tests/testparpred.Rout.save 4a76e0b4daec5dc81b0378e7bdb67826 *tests/tmptest.R dd885bf956855f37df24d0dbe37ba7bd *tests/tmptest.Rout.save 2d49b0803524b896e48d6879d18f8190 *tests/update.R d3ed098f4e626138cb1cc68a36e8fbd2 *tests/update.Rout.save 0a27805bbe6b6d67ef37f760dc991917 *vignettes/cc-attrib-nc.png cd2df3f6f14e5d0af434d1aa53b7a0ed *vignettes/chicago.bst 49717b248d52829925e79701d87870f4 *vignettes/mle2.Rnw ae21998f0dafa40e30841d4abc02ceed *vignettes/mle2.bib f9f39bc36192d155f6d71dba2f50e560 *vignettes/quasi.Rnw bbmle/inst/0000755000176200001440000000000014102527625012314 5ustar liggesusersbbmle/inst/doc/0000755000176200001440000000000014102602653013054 5ustar liggesusersbbmle/inst/doc/mle2.Rnw0000755000176200001440000007547114102600142014413 0ustar liggesusers\documentclass{article} %\VignetteIndexEntry{Examples for enhanced mle code} %\VignettePackage{bbmle} %\VignetteDepends{Hmisc} %\VignetteDepends{emdbook} %\VignetteDepends{ggplot2} %\VignetteDepends{lattice} %\VignetteEngine{knitr::knitr} \usepackage[utf8]{inputenc} % for UTF-8/single quotes from sQuote() \usepackage[english]{babel} % for texi2dvi ~ bug \usepackage{graphicx} \usepackage{natbib} \usepackage{array} \usepackage{color} \usepackage[colorlinks=true,urlcolor=blue,bookmarks=true]{hyperref} \usepackage{url} \author{Ben Bolker} \title{Maximum likelihood estimation and analysis with the \code{bbmle} package} \newcommand{\code}[1]{{\tt #1}} \newcommand{\bbnote}[1]{\color{red} {\em #1} \color{black}} \date{\today} \begin{document} \bibliographystyle{chicago} %\bibliographystyle{plain} \maketitle \tableofcontents <>= if (require("knitr")) opts_chunk$set(fig.width=5,fig.height=5,tidy=FALSE,warning=FALSE,error=TRUE) @ <>= library(Hmisc) @ The \code{bbmle} package, designed to simplify maximum likelihood estimation and analysis in R, extends and modifies the \code{mle} function and class in the \code{stats4} package that comes with R by default. \code{mle} is in turn a wrapper around the \code{optim} function in base R. The maximum-likelihood-estimation function and class in \code{bbmle} are both called \code{mle2}, to avoid confusion and conflict with the original functions in the \code{stats4} package. The major differences between \code{mle} and \code{mle2} are: \begin{itemize} \item \code{mle2} is more robust, with additional warnings (e.g. if the Hessian can't be computed by finite differences, \code{mle2} returns a fit with a missing Hessian rather than stopping with an error) \item \code{mle2} uses a \code{data} argument to allow different data to be passed to the negative log-likelihood function \item \code{mle2} has a formula interface like that of (e.g.) \code{gls} in the \code{nlme} package. For relatively simple models the formula for the maximum likelihood can be written in-line, rather than defining a negative log-likelihood function. The formula interface also simplifies fitting models with categorical variables. Models fitted using the formula interface also have applicable \code{predict} and \code{simulate} methods. \item \code{bbmle} defines \code{anova}, \code{AIC}, \code{AICc}, and \code{BIC} methods for \code{mle2} objects, as well as \code{AICtab}, \code{BICtab}, \code{AICctab} functions for producing summary tables of information criteria for a set of models. \end{itemize} Other packages with similar functionality (extending GLMs in various ways) are \begin{itemize} \item on CRAN: \code{aods3} (overdispersed models such as beta-binomial); \code{vgam} (a wide range of models); \code{betareg} (beta regression); \code{pscl} (zero-inflated, hurdle models); \code{maxLik} (another general-purpose maximizer, with a different selection of optimizers) \item In Jim Lindsey's code repository (\url{http://popgen.unimaas.nl/~jlindsey/rcode.html}): \code{gnlr} and \code{gnlr3} \end{itemize} \section{Example: \emph{Orobanche}/overdispersed binomial} This example will use the classic data set on \emph{Orobanche} germination from \cite{Crowder1978} (you can also use \code{glm(...,family="quasibinomial")} or the \code{aods3} package to analyze these data). \subsection{Test basic fit to simulated beta-binomial data} First, generate a single beta-binomially distributed set of points as a simple test. Load the \code{emdbook} package to get functions for the beta-binomial distribution (random-deviate function \code{rbetabinom} --- these functions are also available in Jim Lindsey's \code{rmutil} package). <>= library(emdbook) @ Generate random deviates from a random beta-binomial: <>= set.seed(1001) x1 <- rbetabinom(n=1000,prob=0.1,size=50,theta=10) @ Load the package: <>= library(bbmle) @ Construct a simple negative log-likelihood function: <>= mtmp <- function(prob,size,theta) { -sum(dbetabinom(x1,prob,size,theta,log=TRUE)) } @ Fit the model --- use \code{data} to pass the \code{size} parameter (since it wasn't hard-coded in the \code{mtmp} function): <>= 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: <>= ML1 <- function(prob1,prob2,prob3,theta,x) { prob <- c(prob1,prob2,prob3)[as.numeric(x$dilution)] size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } @ Results from \cite{Crowder1978}: <>= crowder.results <- matrix(c(0.132,0.871,0.839,78.424,0.027,0.028,0.032,-34.991, rep(NA,7),-34.829, rep(NA,7),-56.258), dimnames=list(c("prop diffs","full model","homog model"), c("prob1","prob2","prob3","theta","sd.prob1","sd.prob2","sd.prob3","NLL")), byrow=TRUE,nrow=3) latex(crowder.results,file="",table.env=FALSE,title="model") @ <>= (m1 <- mle2(ML1,start=list(prob1=0.5,prob2=0.5,prob3=0.5,theta=1), data=list(x=orob1))) @ Or: <>= ## would prefer ~dilution-1, but problems with starting values ... (m1B <- mle2(m~dbetabinom(prob,size=n,theta), param=list(prob~dilution), start=list(prob=0.5,theta=1), data=orob1)) @ The result warns us that the optimization has not converged; we also don't match Crowder's results for $\theta$ exactly. We can fix both of these problems by setting \code{parscale} appropriately. Since we don't bound $\theta$ (or below, $\sigma$) we get a fair number of warnings with this and the next few fitting and profiling attempts. We will ignore these for now, since the final results reached are reasonable (and match or nearly match Crowder's values); the appropriate, careful thing to do would be either to fit on a transformed scale where all real-valued parameter values were legal, or to use \code{method="L-BFGS-B"} (or \code{method="bobyqa"} with the \code{optimx} package) to bound the parameters appropriately. You can also use \code{suppressWarnings()} if you're sure you don't need to know about any warnings (beware: this will suppress \emph{all} warnings, those you weren't expecting as well as those you were \ldots) <>= opts_chunk$set(warning=FALSE) @ <>= (m2 <- mle2(ML1,start=as.list(coef(m1)), control=list(parscale=coef(m1)), data=list(x=orob1))) @ Calculate likelihood profile (restrict the upper limit of $\theta$, simply because it will make the picture below a little bit nicer): <>= p2 <- profile(m2,prof.upper=c(Inf,Inf,Inf,theta=2000)) @ Get the curvature-based parameter standard deviations (which Crowder used rather than computing likelihood profiles): <>= round(stdEr(m2),3) @ We are slightly off Crowder's numbers --- rounding error? Crowder also defines a variance (overdispersion) parameter $\sigma^2=1/(1+\theta)$. <>= sqrt(1/(1+coef(m2)["theta"])) @ Using the delta method (via the \code{deltavar} function in the \code{emdbook} package) to approximate the standard deviation of $\sigma$: <>= sqrt(deltavar(sqrt(1/(1+theta)),meanval=coef(m2)["theta"], vars="theta",Sigma=vcov(m2)[4,4])) @ Another way to fit in terms of $\sigma$ rather than $\theta$ is to compute $\theta=1/\sigma^2-1$ on the fly in a formula: <>= m2b <- mle2(m~dbetabinom(prob,size=n,theta=1/sigma^2-1), data=orob1, parameters=list(prob~dilution,sigma~1), start=list(prob=0.5,sigma=0.1)) ## ignore warnings (we haven't bothered to bound sigma<1) round(stdEr(m2b)["sigma"],3) p2b <- profile(m2b,prof.lower=c(-Inf,-Inf,-Inf,0)) @ As might be expected since the standard deviation of $\sigma$ is large, the quadratic approximation is poor: <>= r1 <- rbind(confint(p2)["theta",], confint(m2,method="quad")["theta",]) rownames(r1) <- c("spline","quad") r1 @ Plot the profile: <>= plot(p2,which="theta",plot.confstr=TRUE) @ What does the profile for $\sigma$ look like? <>= plot(p2b,which="sigma",plot.confstr=TRUE, show.points=TRUE) @ Now fit a homogeneous model: <>= ml0 <- function(prob,theta,x) { size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } m0 <- mle2(ml0,start=list(prob=0.5,theta=100), data=list(x=orob1)) @ The log-likelihood matches Crowder's result: <>= logLik(m0) @ It's easier to use the formula interface to specify all three of the models fitted by Crowder (homogeneous, probabilities differing by group, probabilities and overdispersion differing by group): <>= m0f <- mle2(m~dbetabinom(prob,size=n,theta), parameters=list(prob~1,theta~1), data=orob1, start=list(prob=0.5,theta=100)) m2f <- update(m0f, parameters=list(prob~dilution,theta~1), start=list(prob=0.5,theta=78.424)) m3f <- update(m0f, parameters=list(prob~dilution,theta~dilution), start=list(prob=0.5,theta=78.424)) @ \code{anova} runs a likelihood ratio test on nested models: <>= anova(m0f,m2f,m3f) @ The various \code{ICtab} commands produce tables of information criteria; by default the results are sorted and presented as $\Delta$IC; there are various options, including printing model weights. <>= AICtab(m0f,m2f,m3f,weights=TRUE) BICtab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) AICctab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) @ <>= opts_chunk$set(warning=FALSE) @ \section{Example: reed frog size predation} Data from an experiment by Vonesh \citep{VoneshBolker2005} <>= frogdat <- data.frame( size=rep(c(9,12,21,25,37),each=3), killed=c(0,2,1,3,4,5,rep(0,4),1,rep(0,4))) frogdat$initial <- rep(10,nrow(frogdat)) @ <>= library(ggplot2) @ <>= gg1 <- ggplot(frogdat,aes(x=size,y=killed))+geom_point()+ stat_sum(aes(size=..n..))+ labs(size="#")+scale_x_continuous(limits=c(0,40))+ scale_size(breaks=1:3) @ <>= m3 <- mle2(killed~dbinom(prob=c*(size/d)^g*exp(1-size/d), size=initial),data=frogdat,start=list(c=0.5,d=5,g=1)) pdat <- data.frame(size=1:40,initial=rep(10,40)) pdat1 <- data.frame(pdat,killed=predict(m3,newdata=pdat)) @ <>= m4 <- mle2(killed~dbinom(prob=c*((size/d)*exp(1-size/d))^g, size=initial),data=frogdat,start=list(c=0.5,d=5,g=1)) pdat2 <- data.frame(pdat,killed=predict(m4,newdata=pdat)) @ <>= gg1 + geom_line(data=pdat1,colour="red")+ geom_line(data=pdat2,colour="blue") @ <>= coef(m4) prof4 <- profile(m4) @ Three different ways to draw the profile: (1) Built-in method (base graphics): <>= plot(prof4) @ (2) Using \code{xyplot} from the \code{lattice} package: \setkeys{Gin}{width=\textwidth} <>= prof4_df <- as.data.frame(prof4) library(lattice) xyplot(abs(z)~focal|param,data=prof4_df, subset=abs(z)<3, type="b", xlab="", ylab=expression(paste(abs(z), " (square root of ",Delta," deviance)")), scale=list(x=list(relation="free")), layout=c(3,1)) @ (3) Using \code{ggplot} from the \code{ggplot2} package: <>= ss <-subset(prof4_df,abs(z)<3) ggplot(ss, aes(x=focal,y=abs(z)))+geom_line()+ geom_point()+ facet_grid(.~param,scale="free_x") @ \section*{Additions/enhancements/differences from \code{stats4::mle}} \begin{itemize} \item{\code{anova} method} \item{warnings on convergence failure} \item{more robust to non-positive-definite Hessian; can also specify \code{skip.hessian} to skip Hessian computation when it is problematic} \item{when profiling fails because better value is found, report new values} \item{can take named vectors as well as lists as starting parameter vectors} \item{added \code{AICc}, \code{BIC} definitions, \code{ICtab} functions} \item{added \code{"uniroot"} and \code{"quad"} options to \code{confint}} \item{more options for colors and line types etc etc. The old arguments are: <>= function (x, levels, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, absVal = TRUE, ...) {} @ The new one is: <>= function (x, levels, which=1:p, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, plot.confstr = FALSE, confstr = NULL, absVal = TRUE, add = FALSE, col.minval="green", lty.minval=2, col.conf="magenta", lty.conf=2, col.prof="blue", lty.prof=1, xlabs=nm, ylab="score", show.points=FALSE, main, xlim, ylim, ...) {} @ \code{which} selects (by character vector or numbers) which parameters to plot: \code{nseg} does nothing (even in the old version); \code{plot.confstr} turns on the labels for the confidence levels; \code{confstr} gives the labels; \code{add} specifies whether to add the profile to an existing plot; \code{col} and \code{lty} options specify the colors and line types for horizontal and vertical lines marking the minimum and confidence vals and the profile curve; \code{xlabs} gives a vector of x labels; \code{ylab} gives the y label; \code{show.points} specifies whether to show the raw points computed. } \item{\code{mle.options()}} \item{\code{data} argument} \item{handling of names in argument lists} \item{can use alternative optimizers (\code{nlminb}, \code{nlm}, \code{constrOptim}, \code{optimx}, \code{optimize})} \item{uses code from \code{numDeriv} package to compute Hessians rather than built-in optimizer code} \item{by default, uses \code{MASS::ginv} (generalized inverse) rather than \code{solve} to invert Hessian (more robust to positive-semidefinite Hessians \ldots)} \item{can use \code{vecpar=TRUE} (and \code{parnames()}) to use objective functions with parameters specified as vectors (for compatibility with \code{optim} etc.)} \end{itemize} \section{Newer stuff} \textbf{To do:} \begin{itemize} \item{use \code{predict}, \code{simulate} etc. to demonstrate different parametric bootstrap approaches to confidence and prediction intervals \begin{itemize} \item use \code{predict} to get means and standard deviations, use delta method? \item use \code{vcov}, assuming quadratic profiles, with \code{predict(\ldots,newparams=\ldots)} \item prediction intervals assuming no parameter uncertainty with \code{simulate} \item both together \ldots \end{itemize} } \end{itemize} \section{Technical details} \subsection{Profiling and confidence intervals} This section describes the algorithm for constructing profiles and confidence intervals, which is not otherwise documented anywhere except in the code. * indicates changes from the version in \code{stats4:::mle} \subsubsection{Estimating standard error} In order to construct the profile for a particular parameter, one needs an initial estimate of the scale over which to vary that parameter. The estimated standard error of the parameter based on the estimated curvature of the likelihood surface at the MLE is a good guess. \begin{itemize} \item if \code{std.err} is missing, extract the standard error from the summary coefficient table (ultimately computed from \code{sqrt(diag(inverse Hessian))} of the fit) \item * a user-set value of \code{std.err} overrides this behavior unless the value is specified as \code{NA} (in which case the estimate from the previous step is used) \item * if the standard error value is still \code{NA} (i.e. the user did not specify it and the value estimated from the Hessian is missing or \code{NA}) use \code{sqrt(1/diag(hessian))}. This represents a (fairly feeble) attempt to come up with a plausible number when the Hessian is not positive definite but still has positive diagonal entries \item if all else fails, stop and * print an error message that encourages the user to specify the values with \code{std.err} \end{itemize} There may be further tricks that would help guess the appropriate scale: for example, one could guess on the basis of a comparison between the parameter values and negative log-likelihoods at the starting and ending points of the fits. On the other hand, (a) this would take some effort and still be subject to failure for sufficiently pathological fits and (b) there is some value to forcing the user to take explicit, manual steps to remedy such problems, as they may be signs of poorly defined or buggy log-likelihood functions. \subsubsection{Profiling} Profiling is done on the basis of a constructed function that minimizes the negative log-likelihood for a fixed value of the focal parameter and returns the signed square-root of the deviance difference from the minimum (denoted by $z$). At the MLE $z=0$ by definition; it should never be $<0$ unless something has gone wrong with the original fit. The LRT significance cutoffs for $z$ are equal to the usual two-tailed normal distribution cutoffs (e.g. $\pm \approx 1.96$ for 95\% confidence regions). In each direction (decreasing and increasing from the MLE for the focal parameter): \begin{itemize} \item fix the focal parameter \item adjust control parameters etc. accordingly (e.g. remove the entry for the focal parameter so that the remaining control parameters match the non-fixed parameters) \item{controls on the profiling (which can be set manually, but for which there is not much guidance in the documentation): \begin{itemize} \item \code{zmax} Maximum $z$ to aim for. (Default: \code{sqrt(qchisq(1-alpha/2, p))}) The default maximum $\alpha$ (type~I error) is 0.01. \bbnote{I don't understand this criterion. It seems to expand the size of the univariate profile to match a cutoff for the multivariate confidence region of the model. The $\chi^2$ cutoff for deviance to get the $(1-\alpha)$ multivariate confidence region (i.e., on all $p$ of the parameters) would be \code{qchisq(1-alpha,p)} --- % representing a one-tailed test on the deviance. Taking the square root makes sense, since we are working with the square root of the deviance, but I don't understand (1) why we are expanding the region to allow for the multivariate confidence region (since we are computing univariate profiles) [you could at least argue that this is conservative, making the region a little bigger than it needs to be]; (2) why we are using $1-\alpha/2$ rather than $1-\alpha$. } For comparison, \code{MASS::profile.glm} (written by Bates and Venables in 1996, ported to R by BDR in 1998) uses \code{zmax}=\code{sqrt(qchisq(1-alpha,1))} \bbnote{(this makes more sense to me \ldots)}. On the other hand, the profiling code in \code{lme4a} (the \code{profile} method for \code{merMod}, in \code{profile.R}) uses \code{qchisq(1-alphamax, nptot)} \ldots \item \code{del} Step size (scaled by standard error) (Default: \code{zmax}/5.) Presumably (?) copied from \code{MASS::profile.glm}, which says (in \code{?profile.glm}): ``[d]efault value chosen to allow profiling at about 10 parameter values.'' \item \code{maxsteps} Maximum number of profiling steps to try in each direction. (Default: 100) \end{itemize} } \item While \verb+step> stream xڽn8_!Fp{^L}Hfݭ;㷊EVgb#4RXb/_sL2(O`Bau8_rnMj R"L]ځ"и~=1PXūPYǪ6YɈȉYf^Kw k7\*`a w0 5JIjZdeUdd)uo"WIALd~jmPjV'Bl2 %Jv,tR7utWW6"&b<d&yr:C%`ĀF˻ґ t20PIט 2iIuV`:S -L5Z@ԭL. Dh&E6!V]"Zuٙ x{aINKj>N;E&T"ֳ>nko5$E~&e,Rcl T4 gޠ⛛"g`KTZTv&%T1͘p07ݛO#p(wā! z)wuuk'%@zsA1ͅ<xe/Y0Z]]ͤ|y{1COA0(cmFL 7KN?KQ}1=·SH?~ <APpFu_a'ܦFjj&cF(Çqz}hpoxVnj{l3A̼Ejd+8tx|c:H A{fɘEo}0rܮ֬Dw,+N;uƑ[JHqSi5 l 5%PŁp&U7mM+' 8vmUda{KQ#?3, + .,>h c9̐ʗ )5,HtQ$\ASt\O}]0m^xн1E 7xSVhڱmf [^RMƫQ¢r7]mJ+0: 7ݞUg뾦olb:[0ŖؿprڧI/ݺ]^_3VM͓ڤghh,:.&qj#+zUH^{^u\X_Z5^4vlLgÑzmG=`Bf8ʀ̶óH|4]CCb5+Rz0_EI% P75=$i)XI`\jMv p#/c%Аq8*uq-CWZn4LȞ5*}3p cr  Mz;CO1"L{\rA:yÊi՟jFIc UI!{Ba4JjΎdb} 1 ,! |?J>?q 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 1587 /Filter /FlateDecode >> stream x]o6=B@_.b`yt@QM>ȶG*MEIeHH"xw;ňqiZכyOBaJao~B`DX#af(3Ep"ȰlM@ bW:{DQ&$b$,O2nN^\jh+C  1 eTTLD$ U+6(GU5''\FTﯣ0#/gz66{׈-g[}&PI+TbM'"o4i4{xL>ћ0Ӿd47A\h.9͘R?P:PA8m$ޓ@qgp$_? ՍG}}DtP܏k4؃S4v4ptTQ{EAcUi1^ l5 DNu㔚țI2!KUrO4 Вw> %4teC_}At7G|_U`5̽I(L4Rm.EY b( bfeL{jJ2`Tvf͆c߃. |\&z<쬓'x.]!%bR2LhpkuoWNm2؝tRWyZґίnNv,(&GYl(GY<-i,m%?}okӍ3wzEu*(KLrh3x3IVnAR|wI-[L:;|n?۞(-c4˙k{qUfJ׌Gޢ]x^7ISv:5MDpڤ *:eY0:Gu]t)Ȓ 8 _ʼn G.=;+&BfI@]{p˫sQcOf7PJ'K焋썕Pc>-fh%qagF,E\on0JUi1 򚓨/Q\+x_*PhRA z 6_) bG/?+sd5[7tN $ rpwRy[rJ (/Tee͉/Da%4=AaG3fu?TU3,G=]F8HuhRa<fe%p<"fJMd@D3v)0| :iI!b-Z``,i+҆;{Bt֩ôa','*O3Ob_OR .(bÑdOڢFDUz38 .0ȧ`Terѩ 8{<Ae6Qp%YZ_de"$h%Ymw}J//IT n*swSK8q=*{[%NOsyRWYbD1F&N6JJVA]zwFBsM[?eф@"#@3d?ad endstream endobj 33 0 obj << /Length 832 /Filter /FlateDecode >> stream xZo0_a{H6xN"@h*$,J`BQmι};;sC D`N_?WJ]xϻ~P ('ش$&!w1TPh2>Xæ4ui%P~C &$'@BRp tyvrrg9XQST2-w%&e-Uc:_\Рѷ6fAGbEd폏OF-K*3Ź&+-lIbn:i~8<ԪokqAPVBەp:ZNGTvcO?o}%$4PP7;Kqڴ&-4-7>>cڃ(,\A8[-۬>[z_/14!/ y2$ Qx?zǁd"#e['bZN*JLYwL*?0iv&0Mp+lUNXf?|<@y$Ж:'R-NĂ{!1RX- b^v{-ɢߠjv~krױ9j܄]ZEam,aA啫r"9biF=h47k[S% 5Z{$> stream x]o6ݿBH/QR`ڦȖH lb`d"٩,o~"eKʤAaCo#ZI|K+*\έ>a&,vJGZTAjͥ\dl)y>$0@|vWB61L AX]CSFkY[ħ>gև4a52wlk'8lBt+wNbA:0negO+EfS0j;?D(~-MmL;.+L}l\wt}P_ ..l:i E6QezmFOZ '*B;izd ))lx͚V) : #(Nҋa@UJX~u12/ۙ~]ni)2!AP}*%=2N:m?y H7h4esn uuG9Z|Fuk"?DIQfRA\{)\QeGFi*2I4PgYHdl_ʺYjjehĚeSWlG@|hvZr.obQ4: HmSj46Ud69V%_ZU5gOnuUV0w6XfX 1P9fuS |2,CG#R`w/qJ@yp,c&[X`7WJ endstream endobj 46 0 obj << /Length 1696 /Filter /FlateDecode >> stream xXYo6~jKᡃ mrԩ>y%j>^;CRkiv,gC!瓉σqxhS^w['Qh_w|@#Pr 8@8iyr$~$8KNvvip==x2`NY5Ǒp0)Q|t=y! `0] y,㛑Qv|B,I|٧G/(aߘკȧ$^ f1Fwy[gh \e>6// .eggf>K8'$$ewݵǿk/hb č,^BrM"!Cu^~K#+Y;ߔA} PÒ VZƳ6;B"Tҗide^ r[@8} _O^]'>=Ww~!{Jxw yŌ WwYywx-\ؒY2[+V}++ܺUG-rzJz㻸sڌ({ä,e_d/!ϷDFV3JCb8q) QmYfT,6 L A-tqeH#,F_sZdu^- M Oep2Fr#0RQ65P[qY[}g 7K=8qQX;ڈxBݪ?}kFsœ!*J7]ܔ M ٶX8!@Am(/5/ CAeb%F-b0K¢*JE[̨[ɨ`+l* $Cm0AJdŮ> r4^Z]'sb<CM./rx"(<5 A[CB:7RFƢ-~)31/ zƴCbAS0t 泥?#2OILcM0->~"NuΥV-Q݄Z8l|&DXSB"4VuXtA h 2AwE) 6(X藜pel"@GbqG]7 `N,CD8<1м`؇. 1qc~nDE/ijXs{0LF# ŽYt]NA1(‰} 8tX_P?4h>-f(@4_z endstream endobj 61 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 63 0 obj << /Length1 2035 /Length2 8005 /Length3 0 /Length 9229 /Filter /FlateDecode >> stream xڍT6LRmtww4 ct#%!Htw(%%*-JJJ3{󜝳|1kqm pi`0 %`fև"!: !w(&GbD䭑H 8 ^0X@8B o hpĝYꃀ:8"Q `eqJȸ@P[k@qAuvmJ;" G8HsHG.~hZ@$`;B^epB`@詨\! }: ϿY lmk wq@a{3Dz#0pT5kvkEo+uI `vrp Ns>y(b:x?{PO"v "wDA`x:~qr4X]("=An  ?E<<;-`q~WG!aPoC0J<׿Q"Ü}~e?½~ܼ||AA eG kZ13"`{E Gi`-u3,_):Y.IWk!(z QGC ^5j!d`(Qs١Po6iK# ~n3цC>dPI`PkfzAm*lv?׍W@`@XQ@]=j/ ޿ ap$*#~ެ$~#aH_$#>H_$iF<o FH7BD g wF?B@Լ@B~!8:BA@p.!j@sP`p>@&{ TMY<<( ݨ6bm׾Eu}?eEQ]Pk B:" Ό|(@#r[!_?07Ė`jn+6Kj/aA:~8ge F&S5ޱpJdCL Lj8!/'6 . i8 :qM[xl=R>ِSޣ81a"ы0][w¡(Zd8Rv.~P)a)iUd,@xv߆ڤLH}ܱMM(:u퐫:fb ##"(-֤HϡWk(C;/$UЬ8^;my]/\ox^IC]& g n-R%DqHZDe&o25\XˋYmhW|-9ug3V0+㰀WjU_;'=QpYaa8:}PaBIs_[Go n^67 m<2u%7v={Ʒ|a%xESJ( ^f3 ěvá8rW hˉ՚&֔Ra=;WrZd*SCd(fmz)^wgV4 =K#SfªbpOfDLPSa#KY{ 1g-W[񊴅rI߁U~8ʂt#0(0H[PnO8vĨu[1nH+R覭wVpꚷ#VM&ѕ>VEA!!ydkh1EWTGg A}թ %.;vI:{A)?}/MF=h5[ÎFq20$:e3g f=nOyqO9+G`^'_yn~ӏwv"dGm+^OlkG !֍ q3f·~UjAW{K&3^ BJxXWX|Mβ>BJgם ңJ-aH-gȡMvs_qOKL@kf /LNjU| d4_'L,dDrJޑnn%H⒔(3KJxXKf -/mN.mGTh>:t">[G} yXvژ6Rv34_7S[ؠBŝuǤɪaGsf{L- %Sti,-`S Qk_ I |6]7V5*b;NRt{3Ů=)e]ĢR-'~ z2ckW`u$B*N#F&K@Yvj.|N.9lbo'u+}ݲޔRK2v%eNW>SSbڛnYs3}۹>(Y?cz,6 ϧ&,gR$\۷`z}?:"^!յ P{^=4[Ӕ'^Z&Rwg[W*+x0(_v=rq&m|Hi cOrA'nia a,eQ Y?F,Id'-^YOI2~Tا`-3j],[Y25}f$wPI\ċxҩB%| T$Ce e8,M/.1E„[/|8uxykrd0`Jqavw6ǯ_VUS٣og#',8.#Jw'C%0ls=K^s[s+d?0 Em}wp1(2GU9ר^Z}qol{AW%޵Kj4w>߃bȗ%F-WQ kXZ~?ġl6R!~flE"8}¸zB^s4[~ Ֆx;[5&1~Up{}O@ 앙S0OAJ7G utי=#326Wc^2K c5r}pr^޻,A'*D0sĪ$cXNS[yX?* B~AQ{m˘e7jѼWOv5j+Ե <)"N\fsEluTQ&\wK :QvsgƗȃW1#^?_s _:Sa1Ԑoǰ}pHBO5{yRܣɎq,y=+yX]zʎ%o Ъt uL,9Gfˉw7~\]j)!wS/g<~C0w''ՈnJ8Dʗ]Y},\c6ihZ[V'9Qy1xs؝ϳJQ/|8TAro4N8zK˱>S*/4ݐf( En+ 84[[55 u +ĒZU6}?ǽLu  z&#'~`L>6{L-onxU*yiA.pjݎOG &nD4zGrMl`p~æȠ^:BPԝU|/ᙬ*{g`ą娻Q*,'%B<񒶍rYA>AjzylS8[BNZq}NC:mm-6Q'mk[G?2ĠOH'צsg֛TaHr L{S')7ȔeAps4]p,-dtn ѓlYw\-LaM"UF߆QPpvNG"Z®$c$9+8WصɁd[r }`$3F8>K:\X ?|0fA=O!"0|;=3q[ ~t$N<3Vg@:ҴZޙE 9{Z+Vȡ\)De%e%jAu3K->F$ ‹"C 5=|#$74X J$(bBYYI@LaD{ wΕ˜l^K튳 `N䒛ϛ*(J<R4ރvdòhTPr17ZGRovY&ɒWb~AyS1k/]jE*CNr"/Ns':D8~`q[fծicz=4wMq+"uL+%} G`Z~4s3Bkx|Q?˴[ߎ)ТcH壝ϓWcsbZ$3 9F?fU[x^ qYP|'z5d _93ZyRUNNvڂEBwQ5{O-9Eƫӳ6]wL\BMfL; GtS?ꔕ|Oʞ3=5 \|+/ҙYGA2bL+дeA5z໶GDD9+ WF%eM1B;uWW93n&/(%U*5YVn&WG}0LX1{g'9%WN_cTNV~:k26N;jӣLӳlc=I櫬r=?b@g-ߘ:Y<ӈ^-oW2^v(~at`Żq۷Xȉ6#k2s%CCw*džpt:9Zݙ}K9s,i!}Nȍ&9b"a|yIU -3mqS?RDFJ8k>[uvVgO]Zժسiȅ~mwjҺ[gNa/սo޻n3EC4g*-o)ԠOpt/cObPG6$*ŕ).gFJ{tZâ" ,|'ǜzdW Ա55+{NI}?xE)Z@i:bI[0dG)弍(R*$z[kQ )T{I7 r=ָԫ֗LlA|iWPdWڻw!_s=dIϦO s 7P4`~`kp_^nv./)̡0qp56 ֈfn9C{fInV\a{ y'H`~r[Kt'/!IXYIN"Yj%IIMKqWR<RַOԯs?Bbp)nR{z 4e>[fy)8B#βa_o-L~@Dvh֮BiZ^$o87݋[[rD~ZN&$xP=#^YMo+}Zw!{&ދH_9Z%p@![*CGtJX\?漜"ɗkS܏z(Sp ^lSC݃*2VX~FsxSH :+m>͞'kA ;?rZ:4>a:ju1\8TmdE$ ڨ7̫ߙ J iVJ|>ԏ!턴M!&Bxy%Rzl46ȳk{ъKV^r^H=1ߎ:;WȤ oP:^#m%f} KVz3tb깠5c. 92mD9~'IO ;6K)e2lTaL.rMVt2>Vmup:fB*&,Q2~+~-xEBt[eEdB<77"ikzT={ܙgUcVm=j)l=U UT~k/wRڽ "< wjzf(H&zj\<Ѽ%3:K ֤U{oAVl'Ħ~$\N =l}U&F29X7$4ERev}+ܺ46h`9,}y3dvY@Q;BU&ܜ^EJK J<ٹ8r'>we0`/y!*,{;Q_r{J$7ѺILi}\4΅i,fCԱozGI$\sV8ڍx6Ͳpg^i|lM&Tw)v۽~ZpqPtgb,dߊ@s!H3\ףr|LZMu7O]FzNADCS^3i2.ȔA&8qVv*5^ѽV5%'Aڊ' endstream endobj 65 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 67 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 69 0 obj << /Length1 1610 /Length2 8615 /Length3 0 /Length 9681 /Filter /FlateDecode >> stream xڍPk6[q8nkHBp+)^Kq-Rܭ8PZ>zy937Ikݽw +%D (j@ /(ʪuA2B.P'ĿM z~ ~Q   )PCu'8U ᅄڹG'_\\yGj4v0_)8\]||`G^' c@kZ`Gȟ.l\=HZA.npkp8@O)@Oǀf;_ѿA`n m`oG0>T ՞puu~;֊N HؽY/`[n g:AԔr7c@ xZNA6wpBlAm ?x>.`w7` rXBlpߛ!6GB=&{?? 30=9'OG@ .&;WB6N? v9 Nr-_V_J#O࿳4`ypY7{k:o] &+~ᶰuQzBuVvO%A' ~./ ra"0  I@X?4 ;އ8!~ߨ0OO$S W^| /^g/( s@_>?#8_}5:p])>ӿB}_7'_rC"_(~ O¬d}mHy:SFi<> Bd7Ako=˛r?}c&5OMl/"_OG_naz j:kN>w>UϺѰmݝje<1/Y,fapxM_~"cTO;,1^^pa1G$`QKQ))ZCPvm8qxok#X%8h^E>It,fJ:YV_T;mtyӆ owyasP> Q$1{Qs# mocV_ Z74Z(ӷt|}S496}=᾿#?tsv1CMfmhޫiMQzM.x &m s榵_pfV{}?$/3({CR;. -|c̍Rӆ*izD/sʞǦ<@)2[="|-k2lSytf$5Z0}FfdpnGz~Iw?4J?,Ie4g\s[*짐O&Nm5Y`]SfC߫czVKt,?n3f*3eGa\?m#_B{S {r_MwuS=;N>3cZyI.V[yAdOLjK fPU ,>=g=V,yUNޓkeiٖN$@a$`=P 6FsbBL{ou|Y9  OZʳIIx걽.i!^ >T8Q{+Z@4Tڟu`bV49Qrw(ByQ-'ܞcje_ (K55Ms"摟=cn7! qfvDrz棱ی033QFgq։5*ܻ_os|<4IVk:[RbmՒeO RAOۄWN`n4P=Vy;ƵNVfFDRk2ab$;sȊ&1Pt y. jrhd*KK+F*hKKuV2l wE'~[4W/Aу(9NepQN$5Z\NLnSP 5֗(b)yB+o T}Ms.*WH{ZuaK5YXpBم{Ȏ8*\Zc*Q'%4;f,\='e .}FR^"a``WِKDcէS^ޥk𞈩72l-t)U_F[ia%56F< ?E#ܼlaƹH;WE ^lt*LRߜ jTx5}K7$3*Y>ZS6ErY3K="=`F]נi/kx\SﱕmOxRu~dFUy".$ 5f2'z y7u x&FHϲJ6RvrmquvbRqx/.:lv5G* k-ԠOv ^[kי \X[;TzUJd󽴉,57aef)B~v'ZȾ'jEE׋h6I`uax!waZԋ̞`mlm6&&&^p;JLxJ)"Qy⒔ #lW:W1 wlǪuX^y*:St(UXKwe} |FVxI9^ but|X -gAY\f*~̲:t;(&IA 7H1խ̶j"oj{Տv_SD ۾;¢2sOhđ!_hcn}bL,uV%#/JI[˄D \0ڶD:&{-Rb&D.RM6R<UGzyۖS7InZ!rl.<8󒜌ڃ}I;UѹD"@]nքoQ?i֎3!Lz}bT>I)%.Uï8_:$g.h˿*^(>l]41 ~6QU":~%Sp,jEhiɥE!OZX)"D'0XyFM :t.|(_į,%ģrIyJ܏z1NzhST|EVr >ḖhhOၭ^Pӆg> =nRL8O˅ئ08䍼X^q!v`*ոY w=K=rBz!<2~Wb4RRXV|dHF֜1;bMmjB'lʜh(8dLCQTohf ZAHnբT;G׶&|\y a[|hV~Mh.Mz[4lz!t/v};̤ܡ@3MN ctDw/7xJ%ke,tԞ箸dJ@jF?bP}/WXV3WY$/ƅRn{ YH>X.Ό$xt8$*h*hL}Z^'Z["hv.8"d= R1i)B{y3: 3ou>-To+߹&覉"nTRdGƷ?Ys[;St-m:L#{6; qaX F̍I*FV7.\Mӽ׍4vkt+יbp 1bf3̪d;YܫuW[FkzKJznw|; ЄpLN K{Va"U#X Y𭆓0VJٺ.Q:QXbYobŭ^?RxeC!pW7y$1w(TGI[teD'^.4.\=}_vl|%UޭXW,.. 2Mx+Con՛^gx4pHx )0جve=!mC^~%3RAZzl2Qo̶uw\RUjцzФ5Gћ,7n<쎢"|hrKqXK+H~gю"DcWFx0 Ŕ 7vX0P׌\ *fV'&__VXܒD'GN8K`**-j"EpYHc= 91G\,O#Dp%(k=~E]k!ڣCۍKk;UTVatxœgqggs3zXCTrlDQ /&L,V ޯDvX m OY)89'ٞ>%Ɛ.BI#tGz1ZPX`y{-?p-ű|?Na䑮=Ùnڔ쑭y83DM.o–Ιh݉y*p^L9y[|sMpmLMꀭ)jR^g"U Zbe2iA! ]"nWp7f-CzVn ^x{^pq|"ؘ^鞋$W7IY^<0FF ?;WN!w6bÛoo3aT3|=EyBwU;< D?fL_~JxtE*ٷ2,%}z5= Ϲ% anM M9+ObS]LZsGa2y^/W/hn& ̋YƓ6Ct sj*Ɂ]a4סJ0+2x`j>n:Ű"Kt$8:Nfj^5F_3{Qj`\\4nnO[}X yN:pvRme{ٴ5YAoSK_^%h1=>ti}o.ϛ5I&'֦;sM )o@9l\QDd,9Y=ieW0kXa&EW^Ea$7hjA0{W 3mL \iqԉ@}V1vWdG őcqy\ e\eVq{N3(=i6:[_a*RG)x/^k]Oǥ 9rE2~gj^U;nح .zÖBJVؘi08 eEN@ ժcWT>{ITF➢ɣ:['<m Wٺ2%4֌˴#$=RNiwZaGm\5`@ؼ`-鑶2K=`=Tcş),5 ,|_1VwH~(,y73CI󲁧$@}\ =&Zþh$SLV3JȈYȬX(X8̡fvZ|jh!OO#MeT,b>:Mצ*cX[uZؽt\nvHCM d/a,1aPmF[^Q#~&pcy`ER|e-LGq2\!?C8S P@-E GSʲ,FXmG t˂'e8r&#Mw}d CMW%εS{Qv_iZ뮬Ao_Y,M>7/\(KnTB;h!W$mC^kIqyˍrڜJlw0`PnUD<텸␗8qfl6]m`ʁk/߯dL5?Ax71T!$%Kd?pU|şҘ|gm-V ?ՑҐyޤqIBE8`[8D]5Gfo `' }+}vcJ1]ڌ.򹌛~rrpb }BDmVj.*.,]N'3aRmE~<{dmkoF\bd/c$YNP>蚫tjqī_4 7.pZ7~qt p3G{^=/)6 Eg1iüvEsnY׻ޙM̗ ͪ|sm Abׁ4_ />E@.ŤjoiJ %%bM`hv(B c%=ַXoj͈)Wc:ƝthyiY!D{y>95MZ0(TǠ2V HʐaQ^i&mX&D?M~&btzQU=P #?c梌- $ ѭPAjݲJ)>b_S(Y1B旕^mQI:KjQП"8U) &IN^ KYDٵ*sm^8N6 U8Vr%0]O/ԴvjYn Ihhi_ʚvc'KWR&{? f8Mylv-H~dY6s`:Jc?:CŢPRA/³F=Re˂o6㥮2eFnP{pW⃃–oVJ% yr' 1Pf3A 'DXI5W&IK?s.M Jȏa<ps6:r hkB_sˆs%p1´'ڂ1jnteьLbvS}~ 1sAin7{XQsw_qcE8 endstream endobj 71 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 73 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 75 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 77 0 obj << /Length1 2656 /Length2 18803 /Length3 0 /Length 20340 /Filter /FlateDecode >> stream xڌP ` 2$݃K}{a֧Ww*2U &13+3+?@BISʎDEij _ +X& t*9ll6n~6~VV;++ @w+33@D%lea ߯ZS:_1;)tف3mV W A+h savpcxXZA. gwweҘV.Qh8zAdvq79rGcpllw +v@{/+{ -"ڛ6ں8@+[ /@\L]]]l; $@.HIZ9Lwsm<}̭aȢeo,B#XYYy9 'ԒwM/G_Jbp ~>sp ?+s puv[ `fe 0YX#w賂Ǐ o 3scWYtU.'pq7*o7w,K {=K< 1j `<Q_2vKO=o ܺw@ TUY_+ b'LXZكT\~,&6V/ p_*xw7%c^HIb X\.pu~sg-X$ ^`Xd qX p?AgPXT p>?kA?EsyhA`.: >c]LLMsp5#d-͟ & g 1w#GG>8-xl[bgyb1r9ef6xX@ \q5rWjX[~Fmnp,-AˬLݲSCW%˟T\Xsnnv&o=Q_,Hc:ˋ \58#Yk?d[W?ۿ{8)7ruÜdfr-tl \ g _q? >M[S+j _nS7_L_ /$s9|ByLVLBC{=f3|V?=5o:ߊ`Jވ9lJQ~}6JRF272[z"2LHĤ)] t'dd?x`峿 s{rpr<=o!!+G zϷ:gzqsSHԹ|iZ:viv;xM6{nto֤2;]pMe*V87.z2ä`h~<8>Yˋ|&VeYk)=,-N#.ӟ.C<\EN`hc_K'<>q = bPb5(=LzGh0eՠ?sJo_ׄXClsDh6~D5V^ג9Qw߃ߧyͲ5ѯµIYҶ 8zOKx8S§{ص>}ܢ5Gy, ,}g+`7*,BSklt_z85pm)k#QZ_/GOGl]IE-Y ~#1Vv*\)_9>gzXWFjŭkk\OvQ﹪Qc')l煛)<}׹k%"YLr_W(Fʌ)a(a9QAUtUZ?FNbj%J]12* jsr0[SXf`aҽds|>'}tɖ*5cXu8`IH:S^Z@^(a.S,={_'Kya^њ<_lDGtQ[Y?b;ӷGr'](TוtmҟqW^|JX3/5 z-U[c(|21QcGA`aTDq6N]=ZLưŵ6Ȩ (ݱhr36>#tċL5&)͢%<]@PqF<j)Uݭ*˜$iu 4pvY 4 ; 4R[ʌJ>2h D. thH1;Yf\=+=V+w[|6 @q Q'm<ίDf`5RѝbzXZK7`ei7 Wc/^q:*nkvy7(3ve@SIF+Sֹ[U;_[rDeL}JJK0,qj5W);̄#iEP=x_acEc2iĘ.{ PIi<FTVwr&mZVJtoth pO?1kD/~ =P69]bc&J~ۤ _\,JkOklJ:_Ĭ :-:"Y>_I. ޕiwd,#BW=R4:X"L["j̐1pzP_cOP6;BNcv#tJZy$g.t:j l>UB!KA Sqmrf8 /fv&Ǟx3f13TBߕPTWoCYOzQY_fJyJF0"!Ky6}a޽>X =t(}{ukv{哪.X^vK[2vxi%ts'=A#7לtVOmL\DC[),ˁL\Fȷ03d6םb]G(`z '2\ [lAw(Unp |k<1^2/A}u;h*Fz/D!zbD% =Ba4qxݾQG⭶0ثq|ZDȱ `'g,c%W^kA.x|.O#PXJ5zC%dqU,[|dY^[I,7nK˜F-4rBلvňyR&9Q,9.E:YӐ A%bq7 ʥ%/.8<6= 5CIp8Z#&%7%nS&/OM ALڡC'ƕХqTd%4+sJoC<7:d'rp݁X.;!{_ҞӺSDrRnwM fgƞWx}׿^K~dΔ=rTgL w3}ϕdp Os."4Z]LlZe4mvəeI4b2s&D5',8E#9|ywתWKSMI[ق H$֢io]:PT͐1Ք e$,;ARp-YJZw_ֆs#t7;A_ t✮J;׻yiK̉g薄HtMnڹp?b4i\4~WzS<yb !\>#^W[!xNVq\t?bLed"I;&ta? ޝ\Ip $heǚOY=lW:$& *4cudoi_4o~FD <E3&ES=gspS,uZhn*`[ ˝gi xCb%g I2lk4}Hܝߩ|+GL4K?( ٴ`.jT?Yb8Q pDӕW~dp'C]u^JN[r/4u8uF%2Yu$v*VӇ=&4 ՘^r!J,kj׳ŋT&Եo@e=a`sJʒO \8-P]\ !IsuS!U+W:I/ًsvv1_ re}4R":7cĭ{}#նh7̈́YʫP n4 Py/d F& \f&0s&28f7gѢ{B܈5NlgǮiJcaRM*dUƊ=遭l*(nFDeFvB,j-n;H4r0;"N՗YtH' EbXs;UԲs|vΰJՁyo}pGM+V<[:fW/cS1e:*O,4PZ{[*I q/y-b )od^ds'DLaL~V@&o 9μpC2׶鎤!2ͪ'XMsd #UP' R@5d@$C%h'e'\JNvT~4S+׎9..~ :l+"ETq;eur 1+ْ}y3r\L0UevԼiz^ oO!Av(IH\Gէް~&w&təѐ߇5h(HTFȥM SIo)U-Œ"K:K.: 0;lnJ- PY.mo7e \}`*bddå0䰁󝨲%ya8?̀󗶓H] q()^̂/HecG 􃙝#vv+GIDZ!]_M3 jFh((]cy#-ˊE#l^2qQ^^E9&J o2>& 9rZ=,8|?9`^`dwt-⾽[^yAׂwS[ Fa&Ǖ5l~ˣ >ksO?lMy/_G>"OC\͕l@M9}#h "5 vmϚȤ:^.zw 0N'X(\ y@Z*ܡMO'1>xrL YmIc FX[eϡ 'Q6.7J [L,]Rb>]ML_wͤ$4{XiG-^J3&9DԌK!=2agC)U}Z^OJh'3 ٔǏ0Er^׫f $]-!LtP4xO|Жtk9mp]:/h(r\EЅmQ(jO-*յXvLNj'gy5DbHABoW !j~k RMFSӋ3D( 8^sU>q0˥k0CgO*egjw~C|UpME+"GFоدycO}6SNÑT >o."Wm{jo: ;R4(LOx܇`ї2J`1ƆziyTVT 5GI%Cx(T<ϠuJֹJ#(חGڧJp1%fr%)dknf;#]6Y!N5͗J4FD J/ݦj8xP4_Q`18\?f'34\H$ f=ll #tX lpsG(3E553&©t%h\< ]^BK{37vnc /rZL~eIĶQ/1ѫ Bpz`{;ghGo4k$IŸhPz𘺝hg".w_~I^eo ]J|]i)@LE |J@5`5L.z&1)96q{Y!Nv&##vv*|<`; ^ ()PCʴ=@|MN&fOB@_~ZҬ)0DP3i`pW%&>\ESpԈ,@J yI/@W,?܇谝>LW%:9.P*/CZc[A3UqCQHPlA{;- kFs(Hw'] pJТ)9=/B=5W_h~Q=NyZ_e!]ЂAŷk'#'`l!$)Q_]4_WΌ`:[O:3SG (otp  ]w(ǘJͣ; 2@jv)oW?esSy>eN;ؽvR'^NX/"3i,O`nOtR-VJNYJrжeG`LŖᔺGXo2WvGfPi4H5N9l^[Vh>潗ɠ>IO-)⎇>D͋zGέ9){mŋ>epˏ][?!ҫ0z.^O CՏ5M2߷Tuj6\2M|KVxI= 魏m|Uk%|ΜSso]"Dˤ;s">M鋟]ٺ3ںtP2 o )orvC9F_!m03SNqcDl:#8v NMލ#fv=jKR yo/BYM5g*w{?JEX8w _c&ᏙJﳸ!',آZ@g[TBC$z%}}Y Zp`it _h':V.k槳~c NRtJ{w跕99 $邦 oEMXoίq$>Lz}tǚO)DD/3o$DMm\} w^@xn_/~@g=n1Ie: "C1Rv/\BLcDMu >%28XI/in 6g5"\֩s9}x}}.IP~qDwC=aoWuy/v1{duȩZ$3젘Q< N=" -o6rEטWOI I+Mw]wQ=\h`q~!Tl|'c̪뙅X+ #mF9c()mT#J>A"$6wOF.SܴH,6nzCsFѕPWPU(yp6Y3FT4^ͫ n-h8+1x*+293V-(ռ靧K,pc}_S69DV! pm<3pa1LpOЪY^#Ѵ"@[d7y4pa=runnp¾E|-G)'b/- 4:zҳG?A:v0oZ8 W*glO/0*c> r_ #}#y a/9jYiū8ҤLSv "̿@(f&S U/Q|)GmVWC7Rm˰6$ٞ;-r}x=yv.e-j0D|:p.8fٚuǧb+YjB1?O3˚t2j;5c4zxӈdB۫-y+;*@j4^6LB:(&E;ln$ 0u?VS6›f "(lkZ[V dM#l[*^ 4/&o]6]GS(p b&hΧ9Rr鳷ˈ̩/ɱEP3dqpbek3 QOOei˫JLm^kDur#~EMDH+T2ףTml0F`oa)w{XhHP`. %!<{%q<(/mY 2Zkt]oɑC_vqg艥jyv: \9JSH$Q7Tr:7~@o+<OhLϟ~N=i^~n-_}֌ayQ{OvA %ZڋDEg‘/R;fตmB[fӚaqp7ces5SVf})yAZء+m% Y䕲EPC9؇@ZV~dzR$;Fkc% Hw ۞Q'CWZ؏&XM.9, –c0\l׭3F)ܥ$B5ףVQO(Ttˠ~,;  4 ||ʈg+ٖ8eځ@#ڱ` j~Y',M]VaٷTv5`Sk\ Ez& À_FމUmaF>4s7cl|>B`9ۜ38$]nZHIcB kQBp,{[Aj9/IsS=7xyM)FvyA}0bZkS7^kڃO6xO/lF$=#_K$lEk|fN_2zy l l~41Qt/!R@}/iQt.6{#%\ N%&: 3|;/ŃC=@ZG bx=l#!ڃgveށUBztD~3>Wz1)Zgw1 O(?U*siKi')|ܑ8A#oR,l4>(tܞ/դG>`8Z69:؄h-WmYF՛eE/ĔFw؆_-4]g`ڝL8Uϗl\ HLEXnb铱 z;)u]6UMqb+2O`N@/Zu7*=ޠXXAgvx/$bS/ ŌN3dz ャk)4c# Xeh6r|(ߩ&\ B6jK~Lf~2v6}3NέES{pҘ6kG?=^[eܥm",cfǚyʴ;r"Gdqmh\$v'\Qb-p!&hyQip)] w?XywF쩪YR |mHA?_g0Xlyo(&!iRw}^$*~c?З_ɜ/"oXH^V8w-kYD4:h x?[v;h?H9~YtPBA.D?p? Tc@!MGe,:DO|sfR'T,j*yLާ>:&S l]Y`57sHPn<50Jj :i;Ft/5f43Hރkog/r\uwW0Yd)^ߺO|,ͺTGU|yz{&awa"K[{#ں#M9ڶ@4UviZ~3* qY ɇ:.z?ێ5H,5+]]]v=`\&p$E }Jo-_<[\Gƒġ!~Vx&ޯ%~:& ZR ^IrP#߮#w"o1n)P;t77I:w[>ٮ]RQ) ]/]H(rt!1\eѡ=԰,۠j*(f9D@^VvT۬\2g?x/4?z7hQc2H4J>TQ2.˃dț&g⛧T(vDT]G«I]%j i3ʢ6ɠ蟽?LfzfB8"ó\ Ic棚98FiqyYS册c A dXy'K5( &(2}2c_E4vlikϣʃu{-qXSBE)kU_?\d!z_N%wc]U3(R5&6s8,JZ-U )I.p ]+|WZiNi~voB1F|/Ǣ\ ݶ} ' E4֔GXxE~N@Hq, F7`3#C_*r it}-5%I'9 Mj BhZ+)!2hsTXqa$FE z7nn[mLpk!Y[W d^`cٗͤS<%ɢľ a!jd1[gotEZ@mdCNӂݮ{e.`HsѬoQpDMWC|lT#biK~)cbѦޞ.l;"0 s Ԯ㤣En3"2*3sxHw[i\h;+(-.7~JCC9{}V,|+hy/ׁy1Mf [:5΀_~qd b.@r{#N]IoH)cBN|u>Y߻W@\m Z;hG|8_m޳>>1Y"E7}Chm[cZZOSf҉aK!`M1zx}So%҃nbegvmwL=s >|p,=-_v<grVQdS#P堛HS {OSa= [А"e>RBW,{Xu}ߟA/EG=XDR#+Wĺ˝,-J;Eyiݿg0\wU ~oꜳFsV@a'Ekv/t)D-W$nwt1~s*JsgH3M! ̚J0ҐtmZ>Ac1oͼ5ѣFC¼WmϻDg q3?F*C)9 7o d;&şuh2i}m#nzגߋO4I㤽ZnO.r:w,VJZQkdN~%ނZG˸U-m٬7IjiENti! uzx|~ (kPEdp:\}ѯnYs%bߪpm\_]@$av X+Ew ƣ@ <.tiqMS J:5l̹T7( ~O g1Tdnkֻ[i.qa]ғ]t nd$j#Ig_<}DTrWɈar-Wuj1 GJ3dRVꏜcDJCTcnjeKӉ>m6wpBڂ:"Y]#l ;S0 ~}O-dSK[h쌺h-OT.z-lj-q$mT -88ج45-fiC&4]?7IdGNhaίV+z t\Qa~}heH]ȡb+P:*(On1ܹf~q J^`/Cïm3DGچgSeą8 - o{Rxx~+2-vE8)OvnwcDŬ kPtg5Yٰ3_-etOF c_b84tF p4{"+C+ Ί߹PY(y4y;jEմ}]JZē1'h]/n"h"1 {MY"/JCz\˗fPI˸ĊK_J WOxLˏI]"M gC>byM^oEmNZQƸfBx:{Q"a'I7#<\*2 Oo(᫦ `EXdOc_HZGeN({6b WgٍerWL=g}vD ݨac"N{q`{W؇HLX:X?%0\l&a JǨ0i sG2({ɻJX,@,.%\ziG=9(~h(S2hW?C-Zc8ŤxAIh)\ch~^&z5d; dk̬yP\Rg>G Q+0;0Вkz 77eI<,.hZ\=4T֢JY_Ce8X6)N#^Tl ߀{=\IKG^RW|PFzi8lM5f5!Q~*93,fk%iZ@"RdOЁm8S@.A:b>B4E]\s) ,$KD;Γ!bP5C?WZ4Zln4q_% p{){F31x+ZɿڢrsHU;'/qdź?TD8N_U7XvzÌ(Ce!/q[|h:r*nۏH]uU I'XB=DH"`}uOeryܲ]@Uvf<1 y ;gAiwwf (%ĚݓiXTz>ʃ{;qS,-/d-1i$m^29F MrSFƣ2 j)E?20<\JZ.y_6w}*~Q37hþգ'/էcGn\%;\m"VYlD@ ~j4&Vҥ̳ᥛ$E-O )//zX u#< JɀwgЪޚIdDozoQ+u^ ڏ>RDN;;O%d}ٱg |^ܪYPq]Șw7C"=*V́eMFZ[B^m'SouvU!wB#6:`q<-ռW.p Keu;Rũȼ MQ#k]Q冺aO\(M<ˆ> stream xڍ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 xmrg4ju :ѣ D%.E13 3ѣN"D'щ5DF^7]Zz>쳟˥A!0HDT`n `P<V2`pb 2^ `@D!c ȹ*➋`+\7"=`tBTʹ @F`N6NH@ CqA- p'0h8oM8?Ю,Z-A t4x5â>_//u'!p$ A!dM m<?wt-w p f?wrCQ t1p 0YP_z9 $N醀#VB- ]O?ڏcN;z?<50 ⯽bP? \""X7Oa#i|žc4׻9$ #d |r o Y {igKX /(lok} (V{"B-XOΞuZjuӘ'OM{$ަ,}'OίmE3;1|KyzI!TB3`eda0$3;6/3?=KqrytnEGu2rHtn%MbԈpsڧ BJ ;`e`FX(8WD"Q/]*\ұaRƨoV@~CM…bԙe3'3'>]}TJT!{QyŦr؞{ } 2%.Evpz#J, Jc9u}-*;\pf4ѫ&wϯ,3o;!@ LGl** 7$WWpYQ5Ϛ5# o9-ͰEq?sHf =R=]q'b."_{88  8ixxs=e26R>-MԜy$l$Hr*ReK\w:(_``M:ǦBԲmhR@NP >ѝU%' 13atLjgt4O ")<u@VoYA38IG 4_?)o~[u.ᅬpLw$,ttQ[ \6Qb})Ŏ72K@w>T8~5,N乁c-Tlv#$I2<-fJLZ摳lru^Pd<=.m1MMf+km(=[3/71,(m}!\.·ڔe=D{ωM^ E2 !w/3+H6= M4A'Z,Dƞi*s\F. ONޜՍ 6 ۹,W!#%Xfo߷90 )!Us*@>i}ޟ|Gv-z C-d9Du1N,tA po%ǞMݩvIeʾ&Ĵ6flVk;;v^-YlM.#&l^D3 KYOhlu9ZM:IQtf\jwwŶLaG|-;+qm@٧ N4 8$ZTcg3-KVn*?CmY;S^cyס8'"R\R.E(/^,j&Ny[뙧}x0Q;>vdJKo7f>!ʏs5hr\TesnX͈S)lY,W%!%?b:I9;D>b60*/꘤p&8y\/+5D 8ǒܚsϩRXKIHdݢxN m& V}ih6{͎Q z|yń'<3reh;Xy3E ="A`.jbZ_+2f%vI^ف7Ҥz3q|Po_-g畈 eWGߚ&PJ/$/32pDqDwu&:`O#4) =lp7X\~\m+r-]hQ"eG>xTh "#Ud5i\*!' xAE@}oU4gnş5Y,tl:/IZo8io'"v){gdXߟ;ٺE+u7{</&Uiѝ*v|0l (kN1S#k>w?{Y9Ay|'?8*Yf dW(jP ]~:e!=0iټ౱]PEf-|ѝ6%~R)'ryhz`v,z5bphѵ1[$1ʪ{Jb~Կ s;_<9|9t*ʝX|Jy~>M۩^L(ݡ ֣KHڪzԴDjt³ޘy&m=t9+r[lS3΄QDgy+3f^x_hiޠdd357hm Oڻ;=F!}7;\+9n"jqK5T灁?"(l ,A]Dn,,fhaP)Feɻ3o52i@{;H8dg%lo VUÜ{#gZ#K 2f}{UZIݴzEW1M;7I^_w󱛍^1cŐ=!m endstream endobj 90 0 obj << /Producer (pdfTeX-1.40.21) /Author()/Title()/Subject()/Creator(LaTeX with hyperref)/Keywords() /CreationDate (D:20210804172459-04'00') /ModDate (D:20210804172459-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.21 (TeX Live 2020/Debian) kpathsea version 6.3.2) >> endobj 2 0 obj << /Type /ObjStm /N 69 /First 554 /Length 3458 /Filter /FlateDecode >> stream x[r7}Wڔʦʒ-Ed+ZzĘұ{rCRæR%1˘bJ0Ä2)-sLgyfb9,Ȍ <[jYf:1!B``*LD+PD Vhb'LagBGciDd ƃT bfiOif2F0͌T̀eel1đ~Sb&5YA2y|jTf;z|d^`,"xe b! D 3c'Ӊ2d鎁q0LY miB]S X F;BH>aZPRNX:6qA 2aEB AC<&Ĥ*ƺΏ?2~~qV0}P Oow9ǽw$MJ$?b:%Ol9ʯ+@ >悼`1Fl\LhT`TbbcbyщDY{c|?˿ l2 *D.SqN\O_H4y[Ftd Ir8}Ogr=Orߜyo2bTv5BQU7[q* DJKJ%$=y{}7.~(] .aZT *8_!Ӄmqrxy6 6שn@ޣ!jo߽ 2Hdh:^TZ/!Ea0)-QF8fI)f튠jeTKR= qp Win1~ .:m8H2E / ]n{"`郎 Yx#E/%vKLꭎtKTM%jV[hS(H4E烡X9LuZv!eqV+dj~)29gofJh0AZFzuaMe=Gf:Q()P4҂4z'H"S-Jg:FLN]VWe5g--}XmꇐME E3@cMlREwpQ#>4 <\lRMԪ)J,I͖ ZuWbό\/5q"-霘UKzz,I[p$%2wPz{KGT5?:i'*R)SLő2 WjnDv67QW=Yf&kM!5b4#b6":S>ʓ>RAy?aISShIy?b(hAWtƠw߶Le0 c!u BC\ouFA߬KhӠƦdL朑FABtMfojތ=xp7)M-z?ah筐KN|Gmۖ=P@vO> pbC}ۂ:&tt=Y᧓5Ak!71{Ÿ;^[I[|/gr;8;J̈́bmKqrQmg٦bJ4{w313(z_ 57nDh0hz{@_eTKe6WC>'|r3s>_7# UX7_Gk $ m˨\aZ'ךf,hd6ճdB:)Q({J v8 endstream endobj 91 0 obj << /Type /XRef /Index [0 92] /Size 92 /W [1 3 1] /Root 89 0 R /Info 90 0 R /ID [<5ACC022EA3C719697C97A30A659B28A4> <5ACC022EA3C719697C97A30A659B28A4>] /Length 244 /Filter /FlateDecode >> stream x%93QI ؒXcߗѪf:Q|_Cgt 3Ns4y3wΕDJ䤵*V:@ ZڠR6Vڡ`6aava`] ]VA(Z` +00P )jqՌuUQ52nGکfԜ]/nG/OQK}TZ#h1y endstream endobj startxref 135959 %%EOF bbmle/inst/doc/quasi.R0000644000176200001440000000551714102602651014327 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--------------------------------------------------------------- library(AICcmodavg) aictab(list(glmOT.D93,glmT.D93,glmO.D93,glmX.D93), modnames=c("OT","T","O","X"), c.hat=dfun(glmOT.D93)) detach("package:AICcmodavg") ## ----MuMin-------------------------------------------------------------------- library(MuMIn); packageVersion("MuMIn") ## from ?QAIC x.quasipoisson <- function(...) { res <- quasipoisson(...) res$aic <- poisson(...)$aic res } glmQOT2.D93 <- update(glmOT.D93,family="x.quasipoisson", na.action=na.fail) (gg <- dredge(glmQOT2.D93,rank="QAIC", chat=dfun(glmOT.D93))) (ggc <- dredge(glmQOT2.D93,rank="QAICc",chat=dfun(glmOT.D93))) detach("package:MuMIn") bbmle/inst/doc/mle2.pdf0000644000176200001440000070511114102602650014410 0ustar liggesusers%PDF-1.5 % 62 0 obj << /Length 1884 /Filter /FlateDecode >> stream xXKFϯfє731Fhf@hά, 4aώ UQ]itWëi-\aq)5Ydf2.z\|*aq\U~|j`oͺ/E_65})]Dz_O ˤY3?9?aY)/z|H?wn@2cY7Dz$<}%&7oMʚdBr cpC ?lK Zt*~rF=0]_$ߊwE_,l4h3FA!{ ;[S) Vxeȝ{ܧP)e wGNQi a!g`tԘ6r-'O?#= A,bau#Rmd_]ީu;rK~ !/#YuӟlaR\lEg?l@0n?k-jXV Ss"G57sjtntUY<|8B65\u4U֨ýk?l4ktڵhT<D_p" FÕ߆hM(:TKm%eQ ED` ˋ-7|*|+&"\oVfVc֬/b*jDSBpH_Kl>914S3m֒[k;K3L5wXe-PcDS&3H5KF5 %klRfQ R緼12P}{GOl`HDw% [ul1Q[ 5MX?[b $mxV>oPQHN]N$4Rs@*z#o]_{xčs\l 3%:+,)Eg4RVs: smsFk@%<}6 ( %Bjb2NA "A2hw&Jx8(T2U]4nrf&-)ޏ__Wyv`1nz*VQUnB¦^Hu!.HBu'k] sG(ar>]n{Z7aF2lP֘qG^QXWʔȟ3.0* lЍu۴=t-PRaUpEۂ?cXݺV<#NTAc~8Nmc .7Mg9u *W]'] ⢭!wk[h =C%t]W5nAd_z:#{JG]ffp&&i1䦜 ִhG j`K+c1٘+j 7O# X2)WK%":kڹ󶇼R/keGG L<'G9}"]L`%"w!ϭCHD+g]Ht=Sg웖k&̾ @ӖrD> stream xZK6ϯrY5戤wsHl=%Nb=:zF}Hխ3rQUU,V}oۋ]_]]\IkD"ƅw{Wkffͭ.N'E.Z;Zv;n׿ {i/ʮY_6[̔Ů1ZoCWv™MMV0  eJi'z:eȲm-}Y38:k6V֞\m(ȣŊedJDԅܔ'Sr{wh 0`0Lo `v4>^34|FX82yU^d]8CaY&|AM Y| wTV(~]:w98  k`hHBWc/MmUm6U`RE09'1ey*EA11ჺ~z}* _$DF`Gnbu(3'^-҂q@01J„^lA ,BRˤYֵD<@Jmdߺ8R:Y<;JM\B,P9 sb_,'%e~/ugqJ{(_ 򾹆QF;aMaqaVuA/m*ǝe𯶌X{.3:/T)Jea5;([|>43=87^J0y߂{ Ν%NW",L%Pʸ>˥ȁLCG6y*%q:z΋vo˼nMu!;{'llAN7ET,Y\@1VV fDD33;`Q[ "LzkNM?gQDC5Mh]H(lj:鴫Vm wNS {߷YwNlͺT@C?#%"My ^ɻw@N.ԍKWPUҲ\zoi{C)lb OЃ)+,q%&UF8fl!Uϲ[_" g' uު l0HYժwĮAg@6Q7ޟ!w]yyorrJʖ hԾ? +&KJI@(J&WdUg<$$]* k[z1YB+Q;x+| X;j @@Uof8}3E258W4İlF {٬8l?[! 8K>Xh%;]Dk-к)' +%`R7ϥ+6UCv'b\ 1ft{O U*jGP˵n*9C&qAfV֦ϕ2TO89zjxѦ9 6O8B. u-"Fl!GF[nI%K./xhcX6߽4U@eakQtIY ͭ{тV1a0"B$(* }v. >fo0aa$ ݓb cśBȘ:T [oMdv1lf6I.jRwwS.dUvK}gDҝջF\ИHUi>.^f[a8$z2a>" X#N$-oun s:a0Rr!D#?3O,"@L]Piov1Oǫ?.+p$B*Chx*'"r<ئ)Wv7<+QΡ3.v1NJa(FbQ ًdGF\y;@:&[a7pC6`VALh 8¾?HT5Q:",HͶaO:+uGqqَBQ:j(:-sBM@gjchꨟzt z/<}Գ?8?slf @ejFMs`;3DF'WoA<QR"$!:LHrk/{DȨ\ endstream endobj 89 0 obj << /Length 2019 /Filter /FlateDecode >> stream xZo6_!`u)6löfCƒp4([ ,ق!y<;w}HymWݑAnXcl ˽Iޙ|{ 5H *&I?XZ*&5yoJ^2 qBm%cޕ6ʽ$Ԫ`wZՉwH2uuvuzM%h/܂Kq5À C1}԰g#? SC&bH~晰Ntw6NwXFrqխ3?:?]?QN$6"Y;gRE~u@0d,қ 毳x*\2$iNkR:,GYF21tj2i+vafFɛ3K.gof^i$cʙ[VcXiG}a`_2zs$SIVR]k20ykZK&~q -.ܯN7ܪC0]xM}#N~-u4mBcl2ssXay*ncd8|*К@bgM]T3\މo\|/zpB݁6?ub6 CT޿H'SڄJN 'i^CqyB?*hĞWmC]՜Khc>!m̙M۪DM2S 5t3668~+iL6JSrڮ(L})Hq2堰0̫z[)X`FLάAa䀘K״/XY&3 @l`O,0mJf*`"+ 2buP4J,cgڴٌcYq zFnz¬?zLՎd5|T(g晳&K.&W>CC5tQkғ L rj|Ia[u& &ò9 V)L_6 m$LS|&VjWA-m0'U|"5 c&FyZ6R ɔ@jL:;hom?\MgwU]7݃4 | ?x#pn1#7OCl@ۨj(r|Nc_<:bck<' kMl6qMA bJrlݦ"fxء!U:g,-eqE޴ +:ѱO&S_jT5(U~ǡ6 ƵTӰT&)xu[:0:1"?ksD?MD-j:^&;/JR.V u|F]ÞQZua`zmO 9U~|SJ HU_${gxYp=w3R8X!9p +6pR3:0bj+ގqxgU9v+'Y յq*UKoN:j$:]RA#a>&.l ǡ^$ٔ?V^ 7C¨);aO^ 0&Mi$d9g!ˤ!~/C :t7Dp&dMN$4%X%b> stream x]o6=¸U}Xvذ]nj49vb;ݿ)j64tX@(IQ$E4i@hpy#C*M#&ɔ2M?2:bVvps? Xl!S&mu屛@K>SV]=8f___TO?&`ⒿFt c ¢p XBxm8H=-blK?*!@jTFΧo@Q㭏~ >j4XHH#$Q* E"5Di1Tt]')3P lpSuDsAa\WӢeWlk0g*B˞4ioƜa"oR5rp!N{ƔPQù^5Qo;Qi` BJ# ?z5x5c#pJ9Yq&5yV‹,' Qn5/8m?^lrx( {SM2#fN1r/$ܡVM9~!\V=JN?~I7 2fˇoxO.0bΝ\U)WfLwhHQ?xM huI^&n+!=Ng߄ "=?$r(龰!G6 &_CЏ]PÒ5EQv}g.yĀ=?zoN-ʪSF_P`/kIMN aTj'}(Q)vfC=̼غy8k43JE]1I4Sjx@<8WҏJ68B%a!_5 Tuy%~ TQݟ l8`" ^Xp&IY #-]Rj XO;SR_]<%|s\lpDI&ppCo0 endstream endobj 93 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpv2SfNq/Rbuild1ac621f26d9d/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 2163 /Filter /FlateDecode >> stream xYM Ro @Ip/ wN3 猫u\_3)X_r0ݺ~Ɔ8S2!ɉ.hubMqp8>9m cx۸X;ƛfx8É|:Tp4KG{oB=s:5CVկ_]T]>`uIHqU=%'/2 " _qHC4~޾3=/!/;Y%|W/߼eSdͯN/>OOo=0_1GqVTeAAq EGUL>wC+؞֗sܜ/& <)>bv}fbͰ܎ZYؒSMz$plp~1LgTUHkl'''l~GH?f 8^+ײ܋xԿP,t/:ɕ^o5Y\]CG+f@Aє}_ ꈨ| U#/Gԟ_FiԤaa)E1+z8W` *aWS[1u!WłЍ Clz\y{Xh(t?> 'WOmmwGśHþփ[ۄKY@lw 8Oiv6m˚ZH#f_ k" W9O-rڧ7 ˴$jb^<$2Ffh7Fjbϛ {tDL,QoZ h\MlpثU&ԶX{_Khp!F&$*x )2hQ60:Y60٭u'D3Jjxcop7#܀~ 2C_F[/;kF+֎ܠqw#pԯX=!RH4ԯY9{7иKqp`ȷ  XH"Eb%|Ǒ}HoI#}$0XvÕw[S;Wz^Acpo| 6_ڿ̿'irnj6:Ņ46NJe8rRnج\>T&'b'ϐ5 9بQA_!` 09h\Vj V0[5#:_ыɕzGڎV]o̶EQ1 g$X1>XwKcYGA6yg\?|NeDB[ƭ%T[b`T0(GZ8gu/2\j:"qgi&sD i=ؼX53 mnӹ/A O" N(٩<^V}\5*NS_'Y%١o$( i*) :$pOۄ&WC呠CcJSV/4oFm2$(_Ƕ+mQτGh,elq>:~ h )\[Ӻn^<$>S@DDwS@@" * x) H`bO&68UA*/>Щnp`a{pث5&^~ `N21N#ťQ`rWx)`?k5 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 2417 /Filter /FlateDecode >> stream xˎ_a" KK !Ɂ-me+=9SŢP+3ӝ10 HbU,֋dngWia&z5`9LLH=^~J>/d >־%P~9l)WKהU3Eһ\k|m TnI/|qoWK"KY*5U׶=udrFHoYA^׶'p?XEA^TjiMu©~BJAZ \u\a[ MBgrFxXV瀞]Ը(.QEFp4uԣFf2 &ri,,*Fů]D:rolXm,p@hC%cH -8I>R`I"#cy]NČtp龪kbsk1K Az4Qprnozok ;X']O0`Ch] SbLj_ۍDz,!$fY:.qm;b:K\_2.MKYzzgG=!B+iȳan5|/XY^< |YdE%tse{‘xdzw1d@c#`hvEn+MŮZÚtʓA@ B] "K[~;td`|oXH"c\ú1+8t7UN)d\owfMv<ٶ7ha'p2lvrngS7zG1ɽ___|˔l+7Wʰ03ۃ t_{}x8uX ;* mճT x5u짅:Yc2<xeS;q>U(F~DgK( ^=o |gYcw]vIH}1ed%kwڝs^%lUռH<Ɠou<-Me\ y "_Ouz1x>~"i9tHZ/Y&1YJ(hF|}Z\`ȍV& |${~M_L-O;{wĻհ-{ؐz䥆oAôߕN*OPRLctVvW/Yq"?#2bTަ\Ɗ %f8$\ΊP_h8[P#D10Ts7&m}9d\jǝWXr\>sðڹu#CDnbVrU\{TÇVT'Ud:XHrxj~kC.|ĉ:_d#hUmG&!9! Y$V ֤z}Kt-d*ֲ6W+`Sa*>AŒ{VlZCP 0~W-t endstream endobj 115 0 obj << /Length 1964 /Filter /FlateDecode >> stream x]o6=BL*_"l{2bɎ0}d{oC$]FE,<y$bĸ8wxvɁvP(Byhꭡ<#vCF2p|Α$̙g t 8[3cBK&իo(  <{ '!p.g0< I8ganVF;q]vh>މ}eIr4K`!!Wr dt΋i&z44G+P`LZl`M4#]ߍ:WWy< !oEv'yUV,xjH( fHb_nf&-39~'Ė΅smDolbإ!hP߀+Sr,"? K"$piTX;z̈́!1HpWh0?֪JXŪx(̅Q΢w wS4Id'ςAQ9,(jHiYM6y -6F7`w?̐b_mh~ + W== 8xbƖ|ıu_%"kTp1wVk!B#BPXTTͬMm@P^z {s1A re6b'Ɵ&8w4w8 (gίg/7"!r$:LK" 8 "$4([dsJsWeecsrnJ;ھ0m+=AĔpjWqc OD:Dl=s%@50%*WA GH򩸖|,S`xL@ܛ1N9hFƸsߗ1L+\bt,PB#lK*Ąe6"ˌw:L#|_9#0OeG#l3j4 N0D LE}>ʳGxNF5&6]nNW:At-ucZ;ġ\>daB({pG:9Ã|; %PvL-*^^:q2X)iU)6%0S7jTm,K}mgj;7+DwilJbZI$6ٯ TH "zQ/Ƌi[P;TǐVG$For% Qeq{cfPٺ>SJ~Mݕ,n4%v}^{jZ4E%U6%0oQH, Bh )iߟ"SCݒyC#&lsNy6~XTEhBcȚ5L:,x'r.<.&Ii? WQG}6iZ}dƤ[!SPFL6-2]˛&ӿ"\G(-0*VMyCE|0QVW͆왔GT7cc6UU ^fe. LWWꔮ_HE&{? &]Ce>X&ߙ+^smZʙm/d?z3/,rhP|#`=eGtR*YCcQlY=gK# endstream endobj 120 0 obj << /Length 2197 /Filter /FlateDecode >> stream x]۸}{XfDQAIpw[=pmVWI?3RmƋ^"p8Ό&7E`o/^Oe2Qz2NX(bz}ˉE0m{Z-5oF0u9r9$ 0$) xUݧjd26 O^OwIi1?v)3[J\z;PzdT]!by@&1OBZB,l9"fW 0h$)CK'ܾ#U]PaGZmh,E4Jo)#QeUAvR;2ls\:Hp|C9)UAZ7m\GM텞@պiR8AgZzFYjU(,&4w8U C@j\vrfD͊S4:P)uPG6θLR*VcU,2{  ZN RZְ0,IԧP[3;`al bW${q.siQM߼~o_ Es Ywtݛrg1ǐdZd,J;U/išCZ.ε%8|YBoJh#܇(/( cZKUZ좩4+!ެnBoN`+kx$5L ^Y6JHN@e` POľ #uv- 6?D,mk%tkNX`w.P{\,IẏY(7Y^ \Di!ڛ]`[nmJPD^,ư.ãdXo& uxq_G͑d]fe[?W#i)M;@iUݞz1oN+`wX7Slʩ2)ֱhi߉u,KiRm]gwZ;NN06Uzjɩy8NTuuiڑ16 DcgCP/no]]cčͼ%Uͨ9FxGz8 GDA(@zv(qYBmR.\ 6 #-9=NO<Oq/vm}eXX a4E>_`~2.5!.*Lkh.Lv1|/!Կ 7*İ%i2SM=)z\bꖐPMr[| /'9Q_xeH F$N@.aQx,u|>0)Yw-o)gJBC+,E ;K&gKn>KHUe"4z|6~ǣY , i^D̫S?h>l/#0l#tD*ѹj@ws% ;U/if _MU}g,}*h̒xN/s{>hs^!/< 𨴋XP2 {#(k? endstream endobj 126 0 obj << /Length 1717 /Filter /FlateDecode >> stream xn6=_!qIQ=m]=4@۴MWt^ȗb)a(< g#׃5>}gvIhzQ \ ^ ?ݜ]s\+"k݌a~(\rEԆʊ7º\V c̮5ci1F"*g@K]YOVJz@ lWtGW٨MF1)hT*]ԣł' 5Mԛvq|,j NאUz^4MdžyQ1 w`"nZ֦q#~1L]lMKXc eK(;헊žVT/_^a,K3] Jx ժ$\!W} =ى;EL7]dDy֞L#u|\DPW,i:q9xdj~x.my۴ =>NɨZ7_ 8,.A@TP.ϺHNrU\Sm\x%s |@CskSA@$SlE%!] U:i<bK.DkL]q}u %YoH,F6% KSE 9+PmoD )0? O P,}uiE #f3``#"[];c3. Xv慘 `)YSJi=#AZ~:i< 5|&iƼ̲tиq2Tx(Sjyn7=d_;;*~.謺H#ނx0&n-dC($vEa^e֞(2ܫrR#;KZ^͎FȚ q-(|=n}hEcLL/C&e 2RBe7$ifwk&icڟƼ)6 ' ^icޢ~1)>'3[d&l:ͱ˚e%geE+$}N\m9!3{>[HwMU`9vX5>%)W.YdV =a{Lgs1ϣϢ09?Ż&PtVp̓\GTzpB.yx5"'/4kr-,3 EPFiʚ> stream xXo0_a!$Z`C)<HޚTCtK:!%T*3\HHۮ㲻0"}q+[sߏ( (' SE:2t.|<1 jtzGJnZ_YC"p FB!` +8]$9HKu||=i'F$ci79(T |[ŋoe.; >嬓/x^C0^z0 <C"}hՉ[AH 9b_7?&&jh'!U~.ey X ~*8*%c{ x{gSY. HK0Ocy㇉ù"7|<]S7e%e>Qᆣ~iP0p:LsC/ drϊk{|ӞdvE1Ҧށz'mQN^k*U*SڊkuEa,W8H )Z/~x/Ϳ)'ike6Pc967(ڜWSPSE= 'z}.I璨9\ԠʡZ1eMiBJޯp϶0/q HH,?}.a J1gkH9u0YΆj0j^_j']rǮi(o7;Icqđ}57^Zt/tfnkU ]wz-X0HLuaū`+FD endstream endobj 128 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpv2SfNq/Rbuild1ac621f26d9d/bbmle/vignettes/figure/profplotsigma-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 133 0 R /BBox [0 0 360 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 134 0 R/F3 135 0 R>> /ExtGState << >>/ColorSpace << /sRGB 136 0 R >>>> /Length 2069 /Filter /FlateDecode >> stream xXˎWp@Z\,>;KI! h/ /KQ[ϩ웱2rsUzXU^޹n_×[!} -W{EpZ9Q}FwՓƖ=Ff' >"y[[\n{8܋Sxm{?|Wxy>.<Ր]7xkPj{F.깮䲾w¹NZ溑˺;O,-qʑɗdy`>f'p؝dѾ#?_;.K8 Tjr*O[̷݂u)#Lx?\<%|B}]sa }Ƿ>|KGo~>ח߹Wϼb:(@ bOr}Pg%e.q RoHjo7tC{RX\{v *93rFG cR. !#]@ѫ+ ## ?(& WH dc>uaCCv5ObT*^WF@Elb <x4չWE ;Iq[]МrAcHGD1VhQ2Ì*͎u0P\XbP QW:f`{ĭ($O$΢QPt@v,!`!QvD+ 9۫~!xçtXe4Gz*Iu05ʐމ7ˉ3EulZ &g)GS|I JavŘ8 *6O1!(pGvR &_8^`ex .*x4J_H%h)H>R9[♂)IB]wm.A;؋D&\+(5 aBTmZKQ]FHBӿT3e\Ehe#ć(-F> H9% /i0Ztj0bÔF#$Av︰:"0dY"|TI=Z&H`c'>C! `6 pWch[q’ 2r.geRr9пQ6viņCDJ\NQJH~6h8OTZuKeer;_rnDb}ϓĠrS6q#{ %C{[}Ic8y0F4j[F'> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 141 0 obj << /Length 1564 /Filter /FlateDecode >> stream xZo6_!?%cC:i݃bQYr%9A}GR%'1borL(bǻH(Ŭۯ~:r๛DMޙ |;(A!w&M,B" N!o;[jhHXM"pxτ"pSEqMGenxۿ |?=S?p@W,-o@1f5ϊ|hZA#-k;g< KJ.UHqKj[R74L #@\^Am.9z-/ƾ `3bBP䣏nYΣuӽ6s+oL5起M),T$}&1TVM^qsYA!C~Qmf жD;Q}/Mv ɡuyAH52\B>*Co{+E(syL6vܷG:!}c{x?tys8^WYE5DFsQCxFoN`?D$W_[4w'\@~66»1|x.+gN8ussAaOupB;i= y k@^-w,4-"bT,VĶ%U_L5K.lNnJZ;Z-%! %bZ>PBDBpf) cH6 )48ZstzDs?[c#݊2ޕ%;c}ۺYי@tFc747R;&&dW(_8m >30`8Rř4g6}oFcz21G}:r1&cM"@ c M5J9 }.m?M? F\ qQ$&Mejlg;Yo]} fkn=jtzZT;6Q^8wBҦN àN#E48KJI=!Hl/Tkcs aRJ*~ VBXQ!2հ [,a`5 &mm^ic}~JR. H+)O:*dU(b, \tʠ&50l%:Ѓqd AH*D0jOku@[>UyO;[ P86%5H;-)뺍UүŊ[Ei#QdRe}m~.w݁]' +Cl) =G!T$T €;% +< { endstream endobj 147 0 obj << /Length 1625 /Filter /FlateDecode >> stream xr6$JФN'=dP,C@)%d0"A| ܭ_*fι?[" #׳8{Vdf|P9ZO~ݰ5ɳ׶cuk!,ۈ0H[OCP|?2vO"?/~|ο9 Y 渇I2ɽe٢,A'9_*ZYR 2w.-˾X5l.s+g;:o5rJ(@\Ïo^E02Sy:i$@WkIDG!qK4Ng{5`Bydy6"!ɢRKux[&.v^e`^2ʭ%9] ).2±es䕥lҶH@,RؐP)b*ѯ P6Hx`c˅<,G4㠈T"쵷"u5=Jt?Ee$2fT)cXe4]xB c`7#U;ZX}:Gj7! uB,f}*%;Qq[l-7ֵ3^Nb.G 4w롃-A&B5Qۓ4 ڍ}5Xu\ChmG8^L&-j854>_n۪nL[j-'~0=L'"KY25 ,(-̨%d:LLƒV2deh!/C?!2X*Z/n7tX~pSC%gd0K?N^'E 4J'*mv h<MH !tPu\ |37BZ[9 %>fZ%%>2(Ś0_ŧZeîݱn&t MDBlV"><(`Mߋ#A>'"4-t!qYSPMX,ZrPNwSW_~L6ҬXT:O8t 겓8\nm=gĝ_oz endstream endobj 152 0 obj << /Length 1326 /Filter /FlateDecode >> stream x[Ks6Wpւ#\2t̴㞒6Cņb.ˉDj<" Xb?|e"Z~<[ȳ=uPhu_[" #ǵu0+H/qٮO9*5ugvmڋ+h~m˃APۺrlײC (> R>旝`FuEzևbӨUs;Y~%M$m϶o}DmzT=;v Yv}0emkӡntWY`_O#euF`1y^;nvc6b@W4ת7}?8 F&ֈ䉚` Ngq UPW~yu>tI\VpÌK ԻC ~Q8DG eMU9jo 7qPoE^jl-0kSJ KR.y])0:*5q;GR;0[Hc!B`A}E;~n"H@ %[j@>JGk΀S96RtM ?}0Y AY!8إd򶗝a_VԜIDڽeT#k'Ic]rO~j4̪MAuT)>"4o }2@3xYϿN|0嗛>˫y.;|1qp/oެEĦo<߀<Q E:~>H$){OKڣA+d~'HsP>U%=pmw#VpqKa0nGL,d6Π2!up/V/NV OM^SsNj78F* :@in9*4J3wS9 *i.r(?sp 'y/zҖ%Dj3TjvEZ-UWTLp6+Kw^q`hW˪U mBraNQFg~0P@#y I}P†9t~IlQ[`͟ɩgD=`iKlO@VwI<.⾏8u5ba6'o endstream endobj 156 0 obj << /Length 1966 /Filter /FlateDecode >> stream x]s6ݿ>T`dyhs]֞{/m' E*叛N-R%:P#i<Ap. 2y=sQ(y_{X?]` N/L?ead JM/~ h`^95p;&"»"ЕxYQ~qgLLcw o>ZrAﳐ% ikaG.d)B4a%vӭJMEYLهd35#o1x}rUGy>!텱<_N%=+GZ\aSXqDE ~Cr&#ن<TZE~BJͻ=lXh OKY*^V1u?TV^u#%Qce=8pܵuJ1K;T/;q$;QLV0:pRsQ_]1z&ўӏw2%Mt(p*"Mļ-ˢt4wOu+3-'Jee<V˅vgع?ҸYnD~E>Wye@^އ*Gp3&,o׫w2^",ܣe޿/~ŋEXةuqP2OKu]Fш&#Z2|f`c Ѡ^ܠ٬HW >me1wV7kNPY~ԞtL Mt! GL:wn +I@ [%)B aJR}C?GI=]baUn|`WDq*J{hmv7/#LM3J/mZ[<ne|A`*B6@_w  .@y}B?ЏIgm YQmR*yNjo.~L0ӀoT1A*5'ęqGjQy¬vn*cU}ir>jv[G\%~pZx~^ιq\me]{a֗uܝǵ^s;yǝDc !BPgE~IbR)U>xX$T zhL+6'fS\&%Q7Y.]JWAz%heBB٠.$NoZ]L 7+ɼI7!nsU@@8L>Q)dLjOyϴa b vk~T93uSf\rkռ0!ò,uڕa x`Xh0q`YVk52huLh7CG1]7%±Ҍuj8<_,+Ww7*wpizR]O25|{HC]а33iavK˥VcSUt6Y-GxXKMC;]X5s0^M\؏NT 9WIC 0&A;;&ڽd^3RV+NZ@լbniI.1` 4! e,aWsQ]rw:Tj2|e-W y#<5WXsDGk5 G)|ZdWşbw]tG/*y[h&76(= R> stream xZms_qp/Mfl9N<m*G 1 (8gHQ)Lgx{vooك%2-cްȤ?&m`R3gҊIϔCL0Ri1Df'5aRg#u`6f$sʌ όe.:<"DB0 Д@+,i9@e@cJhz5T)㰼j5SKCT`Ӓ~Cc >2Mz`@A:tĢ@.Z cFA ?dnLLZkX3‚(m0xE= &N@tvKAC*ZVc`8f$U$C#Uj$% ȜI FHI^ pKx3^y+e ǂ6#tN NÈ%I,HMW'1610Sx3wr$uP!1%z`un.@bɯJÇ E-˾,{ɎTte]qy̾vt|v3M؛̫:eԌ&5m˲ge>=ޔ4\ [{ڎ]mYIٱfm9O$.f!.L5< ,g< h> hmsP|b/8΍G8,D lPF<((+*#/xG*d~WQ vVS%EihW䕌?웣8֡ 2% ]Zwso+0+*-Ш ǂPI bA>ZtЋ羒}F1,hQ6`9/_]حs5: {?0ra=}W߿G8n6=+-׀BG~v7Vp Fe. 5_e;8>*]v- z Qh7v[D.cSŭx`Y [+.>FVNUea+%)E_4{wڤ"e%vJ P%(cH[߽+;Gg&.w7hw (oSo4Gw3ފF;E=?,<{}zJSƌn {b u9?{Y=r2I ]Rfe5~]IGpٸ]۶̮Cbޥ(b>LǬ+Apl`J^l\bl34NYNeʛlϻ>+rEZ=~o9V>_)Ҍ3'w_;tW{`BO,Y"t`58!~Qٯ]U"j.7 ݣxDCd`׋""9@"%Gs'ъ4}@%Wv#fgK4tC!Sj]ɼwaHaODM7 ;Tz^ǡbJ}籪zdRtl-7(ײz;p- ׺ʵt?ZolL3a6τsobg鲒t3!~ %Aw֪Gl5(! dp. izopcw\g;>ٍw_ižG+H|owwfэ endstream endobj 163 0 obj << /Length 2382 /Filter /FlateDecode >> stream x[Yo~ׯ ih쓤# v 6/y8fy̒?)xybw_Uq>Bz?T|Ӊ#{wC/"bʻ d@iqѧK78p3i}~ϋ?t{/Pߟ~1_O(H{đDʓBI/Og!*]\LCRSED -d3Pse}+&-̊ߎv(ϾۇXJ[ɤgq{`Agh*:BMl-6@/#6vg:?*bդ,^23l 瑲Ɂ0 "!b!_!¿ZxwdGQZ^$|6p{KJI$]+ʆ`P7X|8zy^돟>Yqv4rx?!dࡳ/E nE$oe)wJܽihf,k]45`>TUe'oQ _@o;뤬X)oȶL;+kC*r@ajđy_2flXdmB&dIВyC=7fΉw[ LqJxYlf!i/3𒨈>{ DHC1%3ZlMZVu =:/wWacUU3b@w/0.zl1hv0g667t4.OU7{atKfil0p7Zmqd]֜V3C@)ٽ|9?_Ō6"^u8WvG m m[Zp,Ukr<3,zHDcq,k "e#rW;J)NӕƤYz?jgL^T{ʣ`}sE޵ :}{dR+P_0V2 *dwDx,M0l 5I 8QB/(κL-Ml\' zWʤYY[i_ 4rZ[ -]Yڴ8LL#|w`;[C2$W T.s Ҕ3a+}sʡ BV(ؚ:|!T НQNAP@ ~o/6^ ?а+Jf&Ԧ:EiFϦG P.p037:6'SAQӠ߮Vg[%7 }b; emD@Ii+&lwBhJͧ[!o:'L51`c#> aK [BQ> stream xڵ˒۸%U KNrT9٤6٭0$$!Hg>EОTR9h6~7&wOoby̒TiPIjvQv:1]EKutj}mw0QF?촪!vnԩ0RZXwb}{d&m4c|;| ;JUy>TiY>'?<WkyѸ>)#'1ȏ 8l Ј)3:Ғ# t$cHw:O7'8yGx*с㛎RO' |zj!u_jw.;숨O>OJfdn#5M,mq C|F)\? ^/Lq>h!{:]P>1ٳطLFl̐aUS N}̓Bz M`v^ ׶}=m?Ł SE]똾u'Ԋ0?03×IfOqnm"ᗏ }m*vdG;24˯u!9d J#[oIMCj$"2 f쀒c|6|=It| ?2QZvݎaT{r#sDv ^,#SD^*}Ht웥+#C4FU*.-xi2? ZIGg{[#<2+Eˑt.a1?5+9zOg% th(x:WwIV$Fz* eJ3S?"#>}2lb@9rRm%9:ʕ(c5سkx+&'%"ޜ')ݦ*3ūnʘ,-O*x=OsgOPegbH,ΡLZurݯ=*lǘR^hU/䁀-7,kK "QJ`Ipzx5ʐ ةy3 &ӘXcE9H,9`}dܐxI4]:BTsq=iqILOe~tfg#&RĜ1dnf6ۅIJ'+GDY,XVie>q:3ΜŠ9ULUit-?k06R#1 -%Qu7'8C(7GjQsn8~6HFxMh ̲zyJ /&/^08H kzD#wӹɝ '*I1+LoA;HIJ{3/d0ni-E ;OPb!|)tBqJ γgj6$;T{?O8 @x$:tN zSGI`Ŭ(XcH7D8\oۭۻ Y@mNF|*y>= 1s-'p\C07zҚ endstream endobj 171 0 obj << /Length 2832 /Filter /FlateDecode >> stream xڵk۶_J'$d2$θSO;x2<c#2w],pr_X}B|[Oo_?y"[foW"X**)Jeĩz#|YtG#EmW@E?r mlޖՎ@ɲZN6f_u3ad~ϫch3ڣz̛`;*w}"N7 !W(?Y3'~ 'X.RCb0u%D6oF$/շ( Q{1h#mz%)q[7EYw4l dx;㏥==Cj2{$Q'1smTgqmM]ȸ0IB,n["!)1O䪮6 >N۠?y6y*0pljDnOd]9^ N!G]`D6{s+ރ8MEݵ#[$\#9?~\ S,j‹B2 ꬚`gKtA2_ Dt? /R3W.s H!f`;0 \1`JrB!AL:N~go~=MHb3Ӿo:\~{WKl.*˄Yj9,13;08kQn9\$%znU@`;qX<%5ifI9Qaθ`Ӹ_5}v< '`p_ā2}Gd2-NH6#%[ZD{%"Vd&XɗvZg{Y_~RߞLUy7&{y@U2"ܙТC 9lvqZZavgokTIr=7ptJ ǡFѳ$\I#'1Q)+`h2I@ȜgI@zB jv@LJ ̧˥m;NZiz.^@rod{x"YT{]0@g+hyQwXih1 x3 o'Rz_S3rf bըWU:Al{u/Ḃ?KYXD@[v(2'3C\0GamwWHG=9UGc[vx~"Wc H\ɿ3s<>0Bqt| drѥsY84m7 Jl3w+Cď WLu$R'>*pg:佱nRTmɃC=8~,8ͷ{J}& &B=Mض+T;^Q۾m_5y$[cWPLso? $|:uـ=n!/6eO$ڃHua ?>M2( :Dp=Oo d81om|Ǔj-{̉w|-Rhʽ$X.=YxSܗu0I;~="%DO_ƿй}Iz87N `ǟ@lH5K2}(Cׯh 5d'ׁ} endstream endobj 175 0 obj << /Length 2947 /Filter /FlateDecode >> stream xZ[~ϯP 4h*cˠ`L0:lƄ7Uer=_^aQd2?R*eP yyTr=DE9.߷o~:.`}4 'n*MrǸGyݯ7%ś5m[\ IpǝoL.>-&9n ȷX=;Ҝ[yhEL*dMV=~ћeF=ݓd7(E|V_J/AXn;5eǚ%E +VJC ~|:ϫuέǃËWۅg$S\J Ĕ /L\Q ~CRsI9NeyiKb ƀ #8\fO3HPX:|#4ls @O`p@5B}T"˂ӏ:iM?2/ö|,/)0WǦ#@u1/A4RǦ-bkdvEwh#!sℼ BaM 8ޫ5pGtأ$Kk%=R_Jƶݰ7y<4_+*|=f.A)4f&#A˅'G4\vmdv(z-L~6nkQ [p_4Sidx G"P̰lGŚwY,L&ve]_ڵ b}]-[j~{ yB0pK%pHq  |###cxu [Qv]Ha9Ӡ ,LZ4O $픨\ lh-%,!c^U> # >o{jcX-fbpvpfbFsƼ-7R(N>`gRCkZ@KemcA(åF"T: *4mP^LW6,*_S-e6Gʩ!zj!%s.[;Se@p,[5T:?`l<&Hjf^Jl ns C[p|sחx=˦3J@( ]Ԇ^!3Å0<}S1vE#SZH4z?a9RކBERؒ%{JR" 4Fcp+Rk攌wCc, r+^?=ܡV|1éSŌ֮O1覾1h6}^VC:X7q+-!= CoBbSw7b TKeȰg !aGa@)觶)ei]A$+RGFĵpi? .7/8'l6TucP@Uo`O.K52>Af.<Ʀ "^ *縷#?Cwllt\l0(Mϯ^@B$'*ͨ"DZ7E6]}V/LV=nOs9d"gÕbԛcBkr;b𫧕#";wHd&I2-"T<CwH0J9} -7F:Cc\V;*kwuw+1!$kY;GIH`bA-R# E@ڜw亂P,13 0D= y==?(K|{r?n{!8˘98sg_T;̿} ^6/:'V۾iCqEMa9qr` xIVY $.N: *DUҒoH#n9 (wC=ױ/f6I6#vd S) [B:S3`ƚep%3[xISlæ~D Pwkj*kYxF~m :Zwa4~wL%Cxv`.-_;3#Cd kpFwcq=m=}qFЛW)5;"~Q;`ߣOT>50] κ סG!nvT q| ѻ/gCb<^r{vcTsU͘74:,>= Bw^)$@J&/磹 9WslWũʷ$zR\}b{Ov ^դ~ҡvaL`.F}uo endstream endobj 179 0 obj << /Length 2684 /Filter /FlateDecode >> stream xڵZKܶWLbNJRي(\R>X>pIKrL;ޔ|s3&`ht )IXpqR(7a1!|hN n|w]HKIDB`֑x7wо4j-^Ċ qh%+6iQf,BgIV88qia V·Ԧa uZbuh%V_aQD { QU6[88$T?9ݲ5%ГTe]sT k's2'hQ*!UL7,*}Zahty{X[Vp"5} 0p"H F %DtS+h`q0X+`OVVx;r_4c!Kpb!gԵ!}Rl ϥntGd7QǗ`oQ]` ZNgVs CEg][#'/m/e݁v'‘*yĂxP?}솸T{WňMla\Tаv,`o+NEq|+DX.RGW/J tg呀W a4#TG vl/%gd%DGT w -=đAvy]CKic]\L&lF$U>׸:'PËS,2#cmqo͐HVWE6r{H3 &WW.qA8CHP9EJo`wD6<ͥ$tsp_{'= ' &d _Г:K+Zv< Q\(sa;2=ʇ'bPaH|o C9J9YUB"6=J+y2d,#`uo^:^>,j.q ~k( H[hӕ-"Q6si $Yw |·tSUWhLKc論(q.[aUW;s 8 0LssQkA΅V } ScEC> F_.BBqԤ rrbG^ ;e "ﬢbg࠭Fx`ZL[`l5] d3>aޒgsXfn&[rGHcn 9-2`[:1a{hpC 5(3z~n-Đ;#s`|5]0TSv۲C_ \!Ԏp:Z@nmxpfqJyBpc᤿yYd*`<6Lin%'Bt꺭G8W;0QbNꠜh[G"` s6vF>fnnnlW P11r!ljM _ISD1N[Su] vZC(dž@MFWjtFl%}\$HL!>z@ԨX99z1[py͸fJ%LCrfb @_Cy(/?(mQ07k.R;nnWYcj͋1?N{T}*6_CƃeY0o@5>&Yq%6 7WDȯ:g)x_@yo[l{> Y4n)@e9ơ- ADψ?qFC endstream endobj 184 0 obj << /Length 1664 /Filter /FlateDecode >> stream xWK6W8=@)"i`/ɢ=t{%fW]Q^g?%@`/5RfƳ,">{_߽z'YfwE31Gkp@t75*ɑ/4~{9'aQǍ~Iyȋ@PPկ $Yt羓Uە?@vlY|ؾ5 {yDe!kk?Ɔ,E<糐L۬^4 ԓ$XEh {ݯI]#Q .e`; X!y>d_+pS@P'vEgv~zEf(KYPi4s<;|-o+X$ < iNK0lTBpm"k XNX; pueF3=}%[Q`Q\etZ?jK1y nLJnx'F_+:c4y|P{6zkCY gUMrߊ>k}DuxY>,9 I Ѣ>t_N?7\ˮ&[YYF,O Bp {ї/ь|bcʪR֚Ύ`u0aŹ8;ۘUxAKS]V"ﬢ4x#$t;%f+˓ +A7QiИf{r4SNAi )^w<Amch}|IÍ;T1HP0P*bevmBò^vʂVM[lULfЮ5ϛV25ydi\]U6H5d]ra0oZ=E)h{*XAQސ#RXH uEPH`ZSh*~$_Jͣ KY;Qz{a)HQ rcȈ*ٵ~FX+qQ*Hkha!?A,."G3_{Jl D̂6C#@'`C68P GxS~KB1ԍ5!_/'l}v@ mD=txlFc}^Ў<健0A]cQ]`\ rG8_De @$<*gjpu`Qt9jE9YxȂkp[K!AuP@zrv0,"#oPSTdvP F 4A 'j8Cֻ\T k"cTm;VqVi Vd.+Rv|[JJbE%;u KjX L,vy?0 endstream endobj 204 0 obj << /Length1 2025 /Length2 15696 /Length3 0 /Length 16932 /Filter /FlateDecode >> stream xڌP\ ݽqwww n$hpw+'*cc9wĊ*¦f. L<QyMf&+ ,9f@+{?"D͌\>lbF.W[3+ @g)@ `o%uptt8?*j377'a;3g+#{lj&F+3)Ag`ddpp[X̀fnf$-jiC a21~ڛ9>NH>;+X_t7rF&&vFVs+[3g 9:_F@|#7#+[#㏀$F hldZ2m7u3wO\{w{ s+{Sd:2[9I;0syX2uN|2|>z.ήf:23LL\fVT0 ܿ@cLIcLm= EdTh-N7=; x:FVG_t?n/5k)8|LAebg2yN7UHo?տFvV\W-waq5>i]oVfV.&Z4[+{3E_=3}l1>7q0kX>n?;cMhq y&E>ۏW'M,>:i#C?#YnTdG??m`Pg-H!G*9>ǖ9 .0e'@ G ~bl~.$|p~s~0v^sWg珗/ve7ĺ!^ϝ~|_#{Ź *.'hpX?8՝*ѫi[Tx{RdzϋA~ tɩp >Ёϫz xh y+bڃGPdA,K}Zn`BlO.4WH?~ϣO$Ųzko=.xm|QehcߡNRx`-yWl/qFƏ &-Ȫ)b;Tg滛d;۪L+((C+$͓kI* r_I T4AMi{.zh|ycxyXm4+)jIsJ0[g轐:ܧNwg΃ KqX('rL#x٠;bwƅ5:NK:kT&ci1dyF?;$8}^%tzvn- 7Őo0_0'p"ᘧU ׵D,Y[.SqԨy~-m4isEϏH#+􋻜"tR@Tf[,u2LH(KE/Ak+UD6߽LQs/,ie| ,|OX7-7ٕ".3]WL+%8>$iPܓGnN(MJ VnIRG!71o >^=EVټy _?1r=\A"WJ rv/ TbGزIH h=1 4}/G3=Z5.Է[Aj0ܟ&0ڇ8ݛ@S)3tJo4#@US"F%A:qFdi /HPGPL0F(TY/rX(v,;d>ﳪrP)z3՚OlC h-_|XDN,֛omz%[ƙ &ؒrU[{?ޡeErEy.)_a:O9B e.1_rl\/[06ZAm8Z@NͤV ȷVKV4cy+xS= H_Jb>?^VsO2g>ч:Y;_cBr[=-k-=wm'TFk9åT-GT7NCj5LjzO>Y2ZUʈՒHlT[ ߼I0muz6\같W—w=}4vwTf_? s̴j",fWw5Ԡ.DuΈq/`ɂ_ς7ӟ(7ϥSu𹪵Tjl% Ҙ0W/QozkX#"޽I'GN ?I,cU|N֭SaƋېɺ&)11EG8E:19.zoedie:Տ\QR~cr:Nvfgl)]8 PF޶XfelߕqΣ}I)3h +"QWB12vq'[.6H=b-F/ܜ%zgkʳQ WmWi.;@Wڗ ]!DA-`ye`"qSFek80%7Lףi ,AD` s"p-x{).$l3sB/> S4z&̀@--o#v>O-HLEG%)Y#忡%=r`5'GM|>D7L 4ZQa5m8藀sE[`z6'Х4^&TN2{& ]"kĎ3.\e="vmJ}TT@(~ܸCvL#4\zvi2 ˍ(\=F[5NNt#u` ,= 3Ctne8"G"wEWz7™(wiK>w`MLrE !팀=VSސq۰k)>\Фؗ$7mt^N5I^]9x _})e$'>ӗ~J(6=nlP%ǨS\)hq( Z/ˉ +Tp 7VF%s!xո~9l_͗ ,6B=4KDsyRr^ pOaKWx[|'b[hEMnU!PJa WGAoV>я.> :|x9sXfܠ*wM^SF 1?G( B֣ I FG~rTޚNtlǣ~_w, Fo/L ƕڻqB|%A߼<mP4֮d Ѧw{72/WXJ@L}rwypP_ޭH<8_ #WI!yr_'Thsh`J$^ƻJw?V @@ RO"9ՎnMGrF1 $/:CEӍYZK.pt&w6_HڡɱŒKSBߧ%CڤMI؅sfNmH`=rU0AoBd>+b5󷌊 gRYid_ׇ[}ke-H؟ -E,͜tH ySSlO̤imXD&~̀ch_A{Clc)V0Fsh[wЇ#E=||?+mSެ(g+x; h,˖Ygޘ8er &e[rs*L]y%E )r{F6ᄝA?MP1~_Y̭3gSRu76NJd=J xBxjr}"6> zl:|1?AILߢy6SNW+`1bY19}"Ml#6V)̈J~pE·T xeo&j;;TyD-/kM$Td)|8$_qȶ#g l8XtcADR*pp6Aa_mzb@$DS ÊHW_H}"עҜnTwyfOq,`IF#ab`Gm3e*׎3[bܴKb yz{7Ԕgn/lQ}2S:=v`g `ıfgx<.3&3$Zsjf7%}JYoiQ߶ٓ.v_[% Au\0I(~2u(GtEʱha+wP*^mOIUzʽ DN~/e,ɰ.=tppF%<FYIW >,sƳ'c`*<h૆l) Z0)C(g4\\u ѐ3{2&J%NTHk9Z;}7TX R6Z'P|ix-^JA^:xIwӉex5V= T)y.}GJ1 !rBjxU߽2 Cv|rSӊ O ql]HNL ENSBA[t1ǩوA6n^ @462<ayh'm.eߕoLa:4?L "|qMU OT!P=fT8v0o>XD- *W E ;þXX7!+Ks'cZM2?(|> R&߳WNޟ]@8[ R*2;+oYHc7.C%'oBPl]ݗ)aP@S 뵛ה9{w/!sO}>؋ bj%EtVM*z.6˽~*50Yy)iъM$(Q~8Y8U|95.o&q ~0q7&'Hj"IQ`̩JZįN ա_̷jDPM"U&f旚Ti}AUtwNf FIrp\mc!q;m&ݢyO,+憿XsB4i|_QNNyZ4,tiL mKC-oh3 [H&S[ "[sB.c*jÂ*qX}uXx\aPOQ5~% iqj|]=F-an m?nV݅0{+S)QE Gc8X)Q(R^Dx1[og־S쩃S~Gk-b\JvvFC$T5/P}p('" ˣQR2_}qfqD&0".}cer}(fT.ENߖ'W6*福*9ͫЎc!;z?.ܻLKQugg#fmtj 'fbCF4o*!ܰjqS,^K~ŽWn܃+au2Bg Wc15  4hl3Z mY#9$so=ic į4vJK,CU+ë^!-`cϖTI$~ֿĖ01ϸS+ D__7_.1k g7:W1Wl+DƾA?!se6VwQc ~_/uxo5afMxKy쑃i.f9 0fV\sFIGx <O#ߪq~ k%^?ӝiPX2ƶҟ %mU$sԎ.3#NjA&9/a4/XcHQnku,_j68Xn5{.` |ӎuTsϪ? 7})Ɂ2Y}Ⱥ`y(xcbOCP9j0pRl*M]"2$ 2)퉍+A .SaAJ|\3}~O~J/e.E3c~_(U* :US3n$Lއ3 ;^is+F\R Ւ|߭yH'-s-`#g$RI8#4Iͦ{q0x֫DGWvĭ,l:'F%<ŤAHhk~kXDƌq OzDŽt5H{绩#x w;H\BK\?:4]U^p=cL`׫]e(/PE:z|]7D[~eEӹFH7#`eQ;a 5܄d|@,]fûMGَl& 8%򐧊 ׉ A| ;bIfn5(_wA em|.U^pNJ=;1}GUs3 k#;Onڃx+LQ-"¼Q&nBxQ" ͋I}wD-ㄟd2.rGYEN׊Ym;ҫGKȶ;i׎oϫ+ٯGr26/`O ĥQᕅ)K +\V)SDwH˛tC' rĹܟ2/jm fnQmkjJu/TD@c.vߡ}nJ˵Ჽ΍b0)W^ak"=񥴬=h! !vxpSWvQNqZ.HH[ځ}\߻ӣ93;zCh"zo~" 1MZƗB|W9lBOk ޠ8i0y?*%Lv{,󆪇]>B1^tZ# >тI:l*D#E@dUKW߷§_y%ݷꤣB4p0NOQ8]n'61 DGR÷\ &1BӘGE6FjSވ9"Q,Ֆd 6y8-Q2͊T:nkCegddAz|n"E$3 jK%.˭q/'> Hnf R#=%!vvNm%$-.Mr7T)UUrkִ?vbeX,AqElݼOv6̷$.]ztYP'{=f6%Depv.Ni?f0PMuimXD5JGp%caokj<6zʉpUXG'nO+'Xh)D3xB]C4r%dU4\Y\dAN O޽EW˾>UsWlAoXY=gol4 cZRS>(gyF= 5]·s ̗94zZLJ;1IƵR.r| q%0t $b!#w7nḙLAZ7x@ն6y46uȟ턗Ye0^8`sF޵|&L ctUMYbF5yMV]%-RA`CdT>߳t 9KIBm\*[UV~Kům 8qP+'_t)I*dtg s.i8RbbA8uR$י0*8XcK<Ծ4Wy6]ObE)Ư gӼH42Dqߝ%cOm*led`,T%bH @,Dv Q8 Tܘ%堂ZOx"!+%W^kO{XoР>Y&~ Gz 6a(r$@=0K~xc6wl^KqQ08,O炌Y-$s4WJ>gB0/:p-(u }BIٰl-g- >2x/Aܥ-ITA/I䡏Lf 0#lL6wڑ5LJQ7) Pۊ#O>oGxSBhM95ۦH1gу; sSg TL2s!k[7ylXvbsk{>POhlgmJvDW~߷|G|==#pgJoڀVP̙Q-悼?ZH7oJ|<be`bvQU*A 'p VՁZ9üa:%Q' 需W]k|5Xp+ӗU)֤nWM`Y:mԖ<})|0 +XG{K4AUzwh :ugU{?sDM.D-T`>qFn~{Up7cFԸ&.^Π^ͅAw:x4Yq[O&K z9~Lo'ШfB<_hȳ@:37sz}KW_]VqZNdeU$߈PD 'ra:S ӛ:#d@%YA =O,?߰16ػ"5>7'0܏lwyb4bu;)`1!?76ޚ3zL&" D*O)@e- W*RI5mJp̅KYWk0,&):pM~*^6~pTr`fP䦫e><^-6S5ϥ`_itJJk2 ZШ)^w>l Ef5QЄil&M:4Dל{ #r~~rLީBM2d+dUjļ px>.Ћ*իlX7 |TFF"l/BWXru CHk;-/u3w 4D=K9r52g]sڶ(Fs{=uDٝsrpmaZ)B/ں# v2X \dzT& z UU4kU#i'a}Ymm KO;Fcj0$j3c;N&? E:20!xX=Wr}/"[MGbcUF#,L\~g\ Qa>{uB{A/j:O^1S$&Fţ`F!kI3`XrCpVdVEO"ŸXjyk#33U~ꁇ8BFlzdLq`VN d.ז5ʩT\4'f \": V3KNP{` OJ/]^Zj⋣.7^NfߠP6HE-]N+6O1Zl*)KfnaHч6|xghvrG#ԻNkC\TJ|fZVy2A[< kJ%c < GqܰI}w8Plv`ĕY]tt)2ieϲbR577h6񟈆A<9 H#x+4>σWLF 2!yEQk:k~v]@zw} N#=|H>tLÈ1e4;f )W}oN<̶I[ppVjXUiJUAnB_}פ'}O~^?1ܴ[QjWӦ@@!e*~ޑTqWr_4Q劦D7;0cQ ꬴb%ΜӁ&xil6_+x6~T5;LuĐhv(9O8>DP]iGhU0}|Y@>iJOĊf4蚦&Ve?4 )Xu_߁=cŸ(~ #~"BNg`FJN=Uq=bL-WϹj8r3cc1s2qWHk]O͡ƫ&{oi V6#V}o?QoD|KBZEjD3TMZ%)eQj}%pVMe{;BNF" to+b:qYc8FٚI X-U޽@=vƹYlޡװo`~&H~P'*<"wQn`s~Sus:4BI͉%`yx:g/! 끬-"5\.:^@n{ySK윛x4Nͫ=dpR}ˏ]#\e0&Ԧ.mSrnhI/XEdF^*[Yj3O&E~(rXtÈة1M7YGyWJֺ^]8X?o56JVbZٷߍ'ƵՇ9k ~QYjHeIDVI$wXJv{+ ("=! KySx|R=M0f?K)8pg#]up Ä<_p;2'˓(S$nb[ H:m~!sVx$"6f730սg:n0u]Gy9f}5ˏj/S=o -燾t:sL`d %L r~cv&ƢCpr$ܝᗂd~]8Rt](h V^#yiϨV5mUaAפ2a{BVFeF)N?ϐv+ L$YnL[ )ZGsscBF~Bo%`K|Qs]tP'FQ?D]\f T̆ԲMGv&X;"[e@HBc\'eT&C͔[+4Nי.cM+J YS1jy`9cKEIni[p@u}EBFJ]ܧ!h>Y!wZaX(/OOξXe Y)_X6Kh gfK("՜ j4ߤ[q؞اbPDgFiSn|E['8+˪|kx㜃<:"o]jZwN=BLX/Ii|q#`k { ! $ QFmS768~G3b}AakɭPN{gZ0삈W8Y(90_޺XfA~ .[ 51J p tpq,&{oCmp*MV&K}m:tN=[S6XH򟻙E)HLЊ;nd#] 3Qzbbu)C.r%l wߥ8?eRL洝pRݱ4xv_fYV"x[]f$ƢU| bf9aǦOƹC+:W _+Q$s?VF_hX5 25gUh >ݼ}*j!KoSH,7B̭oW5"qB-feKsv1SK\ɆwTqoBgHm4=gDB7eGz C/~G_Vc<Ŋs"~77Gܟq]Gܖ]\Ւ1 }v99j^fvMe6[m8]ښE ]zvk_w?E _Ѹ%ߚAWy>3B͏.h^l6(WHPѳA7tDYLM9:"ٛzBړ=Rm4E,ein9Ek[>8zh1XUzAt>& κ=S5ܕeRnX82GRuag<~ a2|Aog3C_O2Jo*R_ǛE<"he7Ba@M0=wZ/Gg;8 N1s[!"< zXGL,0nh$^/Y67)a]Z}k>2*ޝo~Ń3tk Ϡd:fP (O̎FdČ?:uؓ6Pq0ʣE8=7?J4!TP.~oToR :J®:fdKWúZ l*>o>A"T$Ȗ^=8Q6չvkZ{?T[:?/yёS:O)\\'=q)si)i15st"N:ߊ4=g.Jb|%d<#v2F`p QUB{|r61vVDS4Fu:u%Boďxto?]_ ?!Iy$nPD?O? k&p  9KZFSۺ gjHפn;)`.Gb[G͠>^}&ku}j6K(鲋'0L? Q}Ma:=56+[`3-g*@&6C;֌{I\lLs,vKWV8ϖt|ba<> 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 208 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ڍt<f(+ce0Ζgfw8eG,{eeHdHRM!2W߾~{qw~KL\u@ja1xq("ꚛC!" @$Qx4%b0Q!xL'Xb17JP@B ?#T6k$H55uTZ}#Uv_!.މ7U<#ӈխ]*W65[äEҖĐ(2]3^MNtl#NuP<&|-u ꃌfXPo6K˞\)'?CL4 Qz/ Pׯ=Dtx6zӁr|`ľKJSHpv=tu}"ۅ=P3 ~ #w9ʝΥ2ƝW(^pAIQXɣ| nAQVw,;83hhu]̀o b f3&>;^ZcDI[EZa9 ɺE+"vH=zc8%hW[*m–Kϼ+kJ*jطC1u++U>F zx/oA$Cd w=r8_]l3U᜹lI"ۗ OoW@=f DDl3S !K;|F7L֧+f@5ɯ:eׯ -V2Q]iҚh f5XHSu>5.2 ,8w6WL!,GF=c) * %դy!§:OĦnj|3]ٻČG(ɠ Ev\L7ǣ3tǍ=l'Y٤4Ƥm- FZ;A*"2ekiiޅH.y:YlKEX.XXBvvߧS H=Aqh'ۻ#ǰ 7/K>Mư{ CiƗY GV GJS.*M5)|^dn:QJa(@&l4J~@Jz0j4#4l,nтg㔺Sf?fjV/t*NTs,*O{ӷ&GCWHܜ#.x:4T[ڷZ왈`;dc)>L 3SȋԊ vMVK^N\[ + wwLz.x z'Wnkq!@TQmOp7 569Wתsa5{f Ř0=77F:#`N)ȧ1(+UWRY<ΛalP=~J=q'\f|Awz~qD5&uă6k{ SVwزiħ6t_6E`Tn]uBM0ԢD/F> S^EiN w*Δ w7I_Od _oa\^lzw={qɻ?rK. _G\yw"co톾KT>Y﹂kjn*:<9=^uMK+w}5P3*.}0v (dnJF}Vw36M'?4$P՝kBOL~ U]WlHv/?pz%Jakz!r18':9:˯v Tzp1&^m3>ݬfe7e4x{]Ipܓr7/ NmDӑ(Q/W܏xw&Kݴ=ə@71t·k2K.Ns :|s!trÔ].sCKʟ!/6Z{vHO~gjn5d>%t, _w?qO! T4Z 6ӧIAT4,5Bf=&)oHI>O_[k*Er' 4ڛIΐ6dH$?\*'irY3L)D\Z=b bJz{t9Vo)X i"ʬElnWgxuq#e^ pJ~edx>ds,=)Neq- Bh[Ztg/_M9֯P4J"ˆ*iDHy2in}w,ހ%)U5Jzpi`ee'_~ݪ\&s`+ 6pDDx;Ѧ$LR#IT]6gmJi[ޜZakxؓ;9i*S75B .|kZ›D*" &xzR0EP ەOQ/&&4g@=6ZD}4wuŮnWXv'J*5Q\:sU;m<.< ϝ0ɕv* 1D6x>z"Kx`vi EIH5HQ-͞zxz w.UfX!ndN`$ô34~j|tpb_&x.[C._T —ܮU%6j}ȳ@/_'ґR qūK14P8dUвoKp΄6fMx2o9'N>H5tlF|ջ 2O־xXb\ddy}t+SLrlcv_榛TFL;=?gek3ejru]3!SQ]:roUџ-58M6-mQg6&0QiG&%Qdv٫1a`P%tfIQB)ˀݝ_LShzD_kSsNs7z-5)v!οXھ䌆y?a NY^=2 n~VH`!pb$չ)~sXkV w{HURpHAdo@'Ӿ`x%srWS_|BB`UEYYSD~2R'3?qڱLNueNL@/s%&MdVLʭp C)7|8la qEՁ[=7B7ȫOBypv^ q"سIw378Ϲ$ȉ^v-;YQ4ВC2ïv.x&4Cʀ`=_Tqj)ijetr๋_grz>_)W|'S{=%IBtYYzDixQ|dּmw; N4StDi Y$7 wYZVIXE6!$> 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 214 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 216 0 obj << /Length1 1610 /Length2 8615 /Length3 0 /Length 9681 /Filter /FlateDecode >> stream xڍPk6[q8nkHBp+)^Kq-Rܭ8PZ>zy937Ikݽw +%D (j@ /(ʪuA2B.P'ĿM z~ ~Q   )PCu'8U ᅄڹG'_\\yGj4v0_)8\]||`G^' c@kZ`Gȟ.l\=HZA.npkp8@O)@Oǀf;_ѿA`n m`oG0>T ՞puu~;֊N HؽY/`[n g:AԔr7c@ xZNA6wpBlAm ?x>.`w7` rXBlpߛ!6GB=&{?? 30=9'OG@ .&;WB6N? v9 Nr-_V_J#O࿳4`ypY7{k:o] &+~ᶰuQzBuVvO%A' ~./ ra"0  I@X?4 ;އ8!~ߨ0OO$S W^| /^g/( s@_>?#8_}5:p])>ӿB}_7'_rC"_(~ O¬d}mHy:SFi<> Bd7Ako=˛r?}c&5OMl/"_OG_naz j:kN>w>UϺѰmݝje<1/Y,fapxM_~"cTO;,1^^pa1G$`QKQ))ZCPvm8qxok#X%8h^E>It,fJ:YV_T;mtyӆ owyasP> Q$1{Qs# mocV_ Z74Z(ӷt|}S496}=᾿#?tsv1CMfmhޫiMQzM.x &m s榵_pfV{}?$/3({CR;. -|c̍Rӆ*izD/sʞǦ<@)2[="|-k2lSytf$5Z0}FfdpnGz~Iw?4J?,Ie4g\s[*짐O&Nm5Y`]SfC߫czVKt,?n3f*3eGa\?m#_B{S {r_MwuS=;N>3cZyI.V[yAdOLjK fPU ,>=g=V,yUNޓkeiٖN$@a$`=P 6FsbBL{ou|Y9  OZʳIIx걽.i!^ >T8Q{+Z@4Tڟu`bV49Qrw(ByQ-'ܞcje_ (K55Ms"摟=cn7! qfvDrz棱ی033QFgq։5*ܻ_os|<4IVk:[RbmՒeO RAOۄWN`n4P=Vy;ƵNVfFDRk2ab$;sȊ&1Pt y. jrhd*KK+F*hKKuV2l wE'~[4W/Aу(9NepQN$5Z\NLnSP 5֗(b)yB+o T}Ms.*WH{ZuaK5YXpBم{Ȏ8*\Zc*Q'%4;f,\='e .}FR^"a``WِKDcէS^ޥk𞈩72l-t)U_F[ia%56F< ?E#ܼlaƹH;WE ^lt*LRߜ jTx5}K7$3*Y>ZS6ErY3K="=`F]נi/kx\SﱕmOxRu~dFUy".$ 5f2'z y7u x&FHϲJ6RvrmquvbRqx/.:lv5G* k-ԠOv ^[kי \X[;TzUJd󽴉,57aef)B~v'ZȾ'jEE׋h6I`uax!waZԋ̞`mlm6&&&^p;JLxJ)"Qy⒔ #lW:W1 wlǪuX^y*:St(UXKwe} |FVxI9^ but|X -gAY\f*~̲:t;(&IA 7H1խ̶j"oj{Տv_SD ۾;¢2sOhđ!_hcn}bL,uV%#/JI[˄D \0ڶD:&{-Rb&D.RM6R<UGzyۖS7InZ!rl.<8󒜌ڃ}I;UѹD"@]nքoQ?i֎3!Lz}bT>I)%.Uï8_:$g.h˿*^(>l]41 ~6QU":~%Sp,jEhiɥE!OZX)"D'0XyFM :t.|(_į,%ģrIyJ܏z1NzhST|EVr >ḖhhOၭ^Pӆg> =nRL8O˅ئ08䍼X^q!v`*ոY w=K=rBz!<2~Wb4RRXV|dHF֜1;bMmjB'lʜh(8dLCQTohf ZAHnբT;G׶&|\y a[|hV~Mh.Mz[4lz!t/v};̤ܡ@3MN ctDw/7xJ%ke,tԞ箸dJ@jF?bP}/WXV3WY$/ƅRn{ YH>X.Ό$xt8$*h*hL}Z^'Z["hv.8"d= R1i)B{y3: 3ou>-To+߹&覉"nTRdGƷ?Ys[;St-m:L#{6; qaX F̍I*FV7.\Mӽ׍4vkt+יbp 1bf3̪d;YܫuW[FkzKJznw|; ЄpLN K{Va"U#X Y𭆓0VJٺ.Q:QXbYobŭ^?RxeC!pW7y$1w(TGI[teD'^.4.\=}_vl|%UޭXW,.. 2Mx+Con՛^gx4pHx )0جve=!mC^~%3RAZzl2Qo̶uw\RUjцzФ5Gћ,7n<쎢"|hrKqXK+H~gю"DcWFx0 Ŕ 7vX0P׌\ *fV'&__VXܒD'GN8K`**-j"EpYHc= 91G\,O#Dp%(k=~E]k!ڣCۍKk;UTVatxœgqggs3zXCTrlDQ /&L,V ޯDvX m OY)89'ٞ>%Ɛ.BI#tGz1ZPX`y{-?p-ű|?Na䑮=Ùnڔ쑭y83DM.o–Ιh݉y*p^L9y[|sMpmLMꀭ)jR^g"U Zbe2iA! ]"nWp7f-CzVn ^x{^pq|"ؘ^鞋$W7IY^<0FF ?;WN!w6bÛoo3aT3|=EyBwU;< D?fL_~JxtE*ٷ2,%}z5= Ϲ% anM M9+ObS]LZsGa2y^/W/hn& ̋YƓ6Ct sj*Ɂ]a4סJ0+2x`j>n:Ű"Kt$8:Nfj^5F_3{Qj`\\4nnO[}X yN:pvRme{ٴ5YAoSK_^%h1=>ti}o.ϛ5I&'֦;sM )o@9l\QDd,9Y=ieW0kXa&EW^Ea$7hjA0{W 3mL \iqԉ@}V1vWdG őcqy\ e\eVq{N3(=i6:[_a*RG)x/^k]Oǥ 9rE2~gj^U;nح .zÖBJVؘi08 eEN@ ժcWT>{ITF➢ɣ:['<m Wٺ2%4֌˴#$=RNiwZaGm\5`@ؼ`-鑶2K=`=Tcş),5 ,|_1VwH~(,y73CI󲁧$@}\ =&Zþh$SLV3JȈYȬX(X8̡fvZ|jh!OO#MeT,b>:Mצ*cX[uZؽt\nvHCM d/a,1aPmF[^Q#~&pcy`ER|e-LGq2\!?C8S P@-E GSʲ,FXmG t˂'e8r&#Mw}d CMW%εS{Qv_iZ뮬Ao_Y,M>7/\(KnTB;h!W$mC^kIqyˍrڜJlw0`PnUD<텸␗8qfl6]m`ʁk/߯dL5?Ax71T!$%Kd?pU|şҘ|gm-V ?ՑҐyޤqIBE8`[8D]5Gfo `' }+}vcJ1]ڌ.򹌛~rrpb }BDmVj.*.,]N'3aRmE~<{dmkoF\bd/c$YNP>蚫tjqī_4 7.pZ7~qt p3G{^=/)6 Eg1iüvEsnY׻ޙM̗ ͪ|sm Abׁ4_ />E@.ŤjoiJ %%bM`hv(B c%=ַXoj͈)Wc:ƝthyiY!D{y>95MZ0(TǠ2V HʐaQ^i&mX&D?M~&btzQU=P #?c梌- $ ѭPAjݲJ)>b_S(Y1B旕^mQI:KjQП"8U) &IN^ KYDٵ*sm^8N6 U8Vr%0]O/ԴvjYn Ihhi_ʚvc'KWR&{? f8Mylv-H~dY6s`:Jc?:CŢPRA/³F=Re˂o6㥮2eFnP{pW⃃–oVJ% yr' 1Pf3A 'DXI5W&IK?s.M Jȏa<ps6:r hkB_sˆs%p1´'ڂ1jnteьLbvS}~ 1sAin7{XQsw_qcE8 endstream endobj 218 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 220 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 222 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 224 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ڌPX .C 0Xpw ww5!C@w&սEݧs Ez![#=3@DNU ĂDA rODtpa!4tD r6ig+3+ ?C[  :"Qڹ;̝q@eL `8@26: * \P;9022Z;2:S\ANe#hE oh @B @@Gg"% Pm,u_@66463q٘LAV@,䗡-!lWq!%!?@vN _YDh+?Q\wwkicj?d 11EَQd ,B-3:ؙXY@{؜WUw;_J_b0oO;[;)d At4tޞ*& c' d;X 4r0ǏO 3rmWE4UŴhRX Igaer89h'?NJ٘N\%PԀ-@{?031_^_f$leo5 :;w@ 6TM@W+d!3 rMANb_{f*:~,zf&/%p_* xwQגs  ݑdo !02:HZ`%q#NLF\F߈(/d0FF߈(~#p<O7ǓE\x8oFlF]7sqῈx ~]eڀ}:@ cg,(@V&l,A9ZvvmQO#Cj0S#CcK 2u-gW_nlk`%M2f N$oc'(/3xfp~g ];,8.~?8N? \?'W?}8p̿9:(x\`)ةn<gA^[=?ח' h`kdQJ~o,Şgjzev{4D W;bTׂ+OߚC[ZcZp& E$WzRn씦ȶwBS'V_u,daOiCd>R-9פpNoh0]bfMK"yDxjoD{8vk~ }96S0Ioѳ0bb&5X?h')&2wk-f/ bM7״ M}zCa&r.[0Z߮eLxn#"m6 >{c^suy[W{ZLͺ9!'OmbXjZgE\+3iΘg.WWzwB)v#Fb Sm2(pxάjd_M*[O BnKrL0hko<3jԘA..ɮŸç]3K 6^3:.;R p5b. icNy:exrLq>Yŀ貂%:c˺Ud>ǴgG܆*#jB5މAìk%&l V6^`^$_ُ;9=<+8Kf4U=ఇUcg$!Xzu{Xa59puՍ;U?OkDߟެͨK$XOf )UZ{PPD gZhVgz޷Ҽ[t.%ncl#,V},Sjdc2LgsޛҦ453<Q.`~dLd i@E1uT@S#1㲧7^/!+0;StCWCif#ꏍ )s Тl*=f7}oc>`}ʌs(KJ74=۽'jlt!xSEC E]Xҳ8zf͵Ye_F%r1:M]29ѵMt+^'<_d;{؝|]m21< RsZ^í4!kBsC#k#yqiƸġ XTѐ]޽>.սUVN+)ѫd&:ݢF~:H},WJr:Y_!nL5'$qW $Lg]tDiE}9?ƴDUb,%u[dJtYTJ,tMEy:CpV e4AYp5#)^2؛"Ⱥ| 0,)r[PbP^~*] -m6cJ2?:Q.m0̣aO qm7x9/14׃AQU*mh6\Yw," @zSܼS1[sDV gk~и wnd?=˶>;Q^trcxjUm+vJQ5{$B|!Wͭv%,8Q`\TUќ #4M_{VKH'h=Y- UҹЛ)G QoW^Ez3+_V;] 5,bHa~Z?xs"Zv2W:#E"cGz=@v9 :̯گ HgP ux(zϏ[A+;f%.DτmQ5C& ^A/釒A!R&"7_EA#qnxVڭcުSS`anZ?x7j8 Uy:uipd-ITl9Dzqow3om'E{r/ ti^08 J=2j>u!ZZ{s"=AZyk#y&7dH7G~m j ډxo|)e#vMɱZ2U.t óK:n<\ 3^n|T'\s7Mxpʛ*q*aOS_Aj?m3FÝa)AN=&Ϡٮ:ʬ7ߌ f-|!r{z{H͖6}R.!+ (:a>?'6eQU6-yi.}TeL\բͧii!Xm[wW I !mݰvxV8cP5ƘoIg Wϭ;φ#`S>"~_3U} 6D:9J]'N6],~BoHƧKrLG< x"R918GR`?Gϯە%2馫4S~*) {#6B9>KP{`u@X4[vyG3a:#DDj7a?o|[Ky]4[Wh7Iu] 9J?pBX$֪TԓQ⠮772. +?uAӄBX@X'&Uq"!ᕽllXd;gu uը+w p{mlw&% .صP-@>QSeF ү\oS禬?~+=M*W頻m]uw~smݗme ]w`Yw' +٫0p+p޸9'²J'Lq̲ [瞿k:%0P -yn<1\ʎ--PQ-NVYT3!>?[6²-Ɔrmwi5k~u{h _Zgӫ\ J)Dyma,{jo5 9Bor[9IN%p/X;zr:` vxn[*5髫tS<^Ժ 'ٔ@-`I9k{vNM r-7HvF;A0@w 2wߕsE2jƆ%ҙ&/"ϐB9=>Bf*vلu9 )zg3PtLiw)RdՀ~cVa HڢrUq 9Ie-#Eƀrc}39Kvm>5]¢hSǥoatY>YBqa5 @Z20 g4~0}.wEb)܀5tؙ׼F hj{Q䣖Aсp&9#,.aANNY۲4΄B9dCO#[4}i &yq^o0RC/J- ZP5]bBX_YD).FO+>B4[r^oX;ePkr[=1CLDZ;%mSS>'uOcJs;f7~!?bcHº^LaҞhЫFnx8 +-X}F)!,fmv#qœ}f2̓,-߈=M55&ķAV+"kw+}Iyi.˗1V0Y&Oຣ%F8~cvsIz[ %ןi l&5[0*%eitLQ~PHJ# OuӪ4/S%jvɠߦ0-u@V|kr2;͛m:2M~X]_Oį@xUqYLyK5x!^RBDl &?܅W뮡 {+E w+ ͕9,gU||do RDV[ʇ4Va3:}c2$VWXu+wB0 h0!w]@Ibˈ k ;;/~1XϡedYc<_ eD_fh$FC`jV:-sWA%_I4P mX՟7>'^ecŋzޡKH0Ґ;Jņ1]e ox |+Q4DݽYʰq/Lzt =RRp"l>ڝ6m_ ,JhT3{b&g`2ڢbs]]FNSkR~S~.*pkt%@јLqACѠEƼ[WxRt7M^_ [w}#>:BJ "6KCe\25$hHβ%>ldk;яAO]d721sv;Bf[9M܈cxQi_JK̏RBrQd't5 {hUKZ˙ՌS~b~ф+R-=~!g )BPXe.cZϜ;:.#<ͧhc,TTniP7;aq5n>Dw̚˸xpWl_Ƞ8DRaVSl^~W-0I\nMaͣ;* :VZlM˄Rh#/yol{̒Y̾q<@2WY+,j1.7XBkη%}Lb> sú!rYQcx=J \,c%^`\IBtQ71P;z&V$sg3]E.O@ E$cPģȕQ*E+1bo!~F-%CKbdezWG `yu$A@Ƭ ܜUSH8hw}ՍH*4ҚDr}W G)(F"Mș$I @5y&kо 7}fP3?2LRI| J'v(TuT.[j DP`J A{v!r(I5"TrA$ .@C:aHEP6 #rL*:#_  }Os? aP}~>.TU NC-1a.WFI?&%loH 04NYlՐWbLOK8<rў]T&*[Ci)!5HYdךq2/u~j$o{s-ҏ)|zbBI8Q 74>X9F3ߠp(JRl)#+1?9C-&(v84Ж+s.=.x95;UU9^Q'~`M4v%3PҾ08z995aEX?Sg^)uY06)T/Qm3O3A]jͰM3 =}5Ud3!T'nE-*WX"&MUh[{6OUSh&2z&BvQ۵lv(6w$k.=4c ˭Q 68TVD/i53Z'GmMv#,"8amx3GS[=7rtc}oQp/#ÞX8+M+5âk[;p uh'y)AS-0vQ Ϟ0yzJZHEjFFMP*XBP$nEPYɥ$I=2nyG4Ve3millP։W(5ܢd6]PUBƏ QLlLDB]924.0# @ƒ궝O_g>I.agjހRzo6L*DwI,jM_f2Hڥc)پg:dQvjcH\m+y{őɓC T$8LIJPaE^x6NhpG c_sR=A;A*~d]GS]QaƲ2{5X#Ie!mK#gzvC!!kB_ayn})w Vh}fnY & lD kf ǰNV8/\>80"eX`WzȓX"p#YŁWRW9޶Ü:͂'6f,YBNnnJٮh.c!ߡ~ζ(ȶL$#@ -4k셁4*\ <Ǐ[Fzt^ } 8f'uÚ0ݟ.Pcc.<E8}yp6Y dg[૘" p- D$ _>ȑl_uPll`V3]'@r KvfL~. 5fo/Q%Ҏ,۱5|qM 'HGQ0&b )ls19][2l9Ri >fRYʽֲ-![kݷUŪ}rZ\p|煀$&N38/CMCԳOH,mZ CU-}v߽ХʼnA?+ta·ShӚgGԈw6o;sԎ? ?ܺ2X.̾Ч8eb'!cKuȝk`wc h ^/i+ju]V{)3{}RR6& .^'BdZ8/*{V63'h;1ч+̗pY`oJY,GYmȣIFfnxM}$\|R |dk`e)$H a%q| cOsɟ&Z1 V> *nz8Yӫ($kDQa".<}/q;v8U ̹t̞wc:3<2T*}vHԫ[S"0); RCNQ/kU73+@Cx eaVK{XP5 fv)-C}ime8rtYsYn {gGQQc# N6D{g XEP!;] Cx" 8ڛҾ>X2Z:PkՑjJ$șӋK(o~Ps^ʚSAO{O*qZ'Y]!~E&TfF@KgPNE$^Le;5Bӄf<&D g !RbBɰai9JybDl;G3H2`&}ƶQlK#1;այ4{!?>7Э^h2ge6m&s՝*Rb;%K2_J+[U%~I 곇&1u<$V^`}"z1H DwؐPJ@b4sv.+1^uRDD8\vɁmG|Uե$ Vi6N,ȯy"wozeHyO-byt#+d1bMFYrKЈu jFsmG)e-䉚hg#Ҋ E~ăx@:@`k pg1$5VuUhg2~T!YϖםSkB$ )z"µf`%;h1#+=@K')Mqab_[⭾qp'Ǒ k5슂~P48ʞ I}(Z*ANF-4 =db]ƺӕ'V\?R.O״S-k 'nU6M* W;/"&Υm?\l%O25g4Ln+'@v.&f=_NcW"sF?폣1fTM9%BWͿ?~XEXjFe!(s=eU%Cnb=U u 6f{;ۓ)XI-'o!.GTh [d550p}&J윬4;imjc|5]"gsr6uF\,amc0Dm8 })IBArZr#^ɀ"\n*qБ-dУǤgw0/"wɄk*]}ۓK[z VS6^x5;X ҚZ~d|8KahC^"oCDŽ>yGk|bC p5兣0S"<8MBԭՂLlK(J%ZDds$Ő: o Zid 5SFkP`rvz9ӈ j&ן$@+(bٻgݲM|[2Ld[)T66k>"ddWYRM &(=_]M9G Q>w'֥Jk XfۘG|>L4I$ /ͷ P"^v0F~D]JY>]#ːeIS|:S_Ld"r <5+v{FR^:_OؙZ)n Q̡f)rpY#X_%jo:3Tf/{ {8͑8.._{28zc|WCwCY%rx\|^s(|qsQo'y6ǎô>,/QĜr R1HR}e JݧB PMny%]Nΰ $A$df?M(;Q*i`7W𙾤kk~o8kD/!1HaPh_E~1a\F@Lf$_?e]v6ʁ=khgR:' 쳶$ZbhӼA D4Wď{QdWP2>8k#1 ؿu/z}ngKS6XwS5*Hv}Jo/<~urmh,H1c6ojq ]ӻG鵋|K@m ٙ`^0 rG iOEu%2 s'\Yؠ-M:VFGMh\0(}DÆ dYlxh 2rpv{m]U&a'> mnJ7)b\jhCm,`nϚީæ&fa̱.,!.07¡Fcr;a?mC}d1!J,eҌ>udPRdsji^3nۆ<&@ Zf\µRjXuJ\ˌ W 6՗95Als}G8E+KXCDsM‰G)&ˀ=xqz5kREvqׇDȶZqSkzmC "TTc}[~yf?\pK2ȴ)$$ 2a8=,@ccd{sDb0]Aݵ'$Q//b}ƶ ,Y/׽ju}}lwQS(wʦ'Pg[Op̷Mxzɛ!~rkD? Jr"?CtilGIJ V"ؘ*󓔪򓑻@Lͤ{wW$%J+N儰|K 2Ȝ0|P?' m:ھnp~13H.(JpaTYR [qLPEp{KF&˺k<1KlR݊&= RG_1|#[C*{7,76r¨|XT6= @9!](h/(+d8:iADRD|H]xdtnS[m3+(]xxH<?pD"*l/Bީ`#<}hr N.2tfT♐{꽾l<66x脗 `8+4th\A v]mai44餗SC8]}|82: G[ !(+ j}N11A` Cvr?Jzdb 5AҼ'J|z66}9?Ȯ?lSi[aDM[/V-1lW6y='wB J܁\1ܼ0*h (5[KrBe^2JYnkQބ5& <^^V-^0V .oX#h2 yơ:iB\-(dw;,v/&=,^džܯpBtT q QּSA2f+Q\ى%p4rltyr3& j4Ϯ"cuu1Pd_X6eFIN~ !#{^"Ú܌ ОOnqlIXoqdʹ]Wf zc{4Ǥ^3#\}B4ooiIj]ͷܷ .ס YX&@?k%U)Y{ =qez9jȊ:MLtj&oWbɊjvĭ]@BUsv$HW;`2t,#a7.SHy+b:=E~2 Ypy)W ۟\ūx1rYrOQŽj9s7TdD&R_lp(^B(D@ `(vkysc0 X .߃8eҹKRLB= ˜\SW4`I `.b똒*; @=Rwp9!"N-Uo[-hݢ?6qC}ٹ02 1<Fn|]320{id@D?#(.q6q/a1l>tjJ5/[oޖ=((Ci2 .ֱJi` '?)V-R xx`IJۛV̸{&XIFp8S]sn o C>P@/3汜||_Qw/7' d͑B?8Y&Т>lVasèS2-4SaH;m[r, cYzK E$-ķBܔ٧?z`sJ%v*w_;)7sq;QI:TV/E zBZAR~>2ZW˃M| Rl_bxٽ;PE.dyS%wElF(xuJԆ,U YjWǁ[D:oB?ޫ?cOjXxtfxp>t]c@S@ geu=$g_р6M-̮z$QoNi\HWFѢ [F ꖌ W1\h Ƭ1$R3֥ņ?B {q2bGkg3hsPG2E5ofuPC ژ(Pc^oC*\$qg'C{+.9`Ұ5 @Hyҫ2Xؙ l\WYx7Ϥ~ai ۠MKKUK%t tx!?6w~8ʮmq,7ndϨRm/382i>tFc/b-՘{i/65~uq,.} nrO3[OVc:>q.ějۺnӪN){m B`]4*\'k _L!br9 (b?1D8d>Gl"3Fѫ NjC2$`$'џ3K_'L@=MģrQזּ)<-b~(?fEQkBǂ]ـ0>~y-o^ILs-NM3x2] 13 /t"&9%Ue8DXvՄI!JTNs6?")(ИK*! q⸌ѓiB}?jǚc%KwMq@ endstream endobj 230 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 232 0 obj << /Length1 721 /Length2 4672 /Length3 0 /Length 5264 /Filter /FlateDecode >> stream xmrg4ju :ѣ D%.E13 3ѣN"D'щ5DF^7]Zz>쳟˥A!0HDT`n `P<V2`pb 2^ `@D!c ȹ*➋`+\7"=`tBTʹ @F`N6NH@ CqA- p'0h8oM8?Ю,Z-A t4x5â>_//u'!p$ A!dM m<?wt-w p f?wrCQ t1p 0YP_z9 $N醀#VB- ]O?ڏcN;z?<50 ⯽bP? \""X7Oa#i|žc4׻9$ #d |r o Y {igKX /(lok} (V{"B-XOΞuZjuӘ'OM{$ަ,}'OίmE3;1|KyzI!TB3`eda0$3;6/3?=KqrytnEGu2rHtn%MbԈpsڧ BJ ;`e`FX(8WD"Q/]*\ұaRƨoV@~CM…bԙe3'3'>]}TJT!{QyŦr؞{ } 2%.Evpz#J, Jc9u}-*;\pf4ѫ&wϯ,3o;!@ LGl** 7$WWpYQ5Ϛ5# o9-ͰEq?sHf =R=]q'b."_{88  8ixxs=e26R>-MԜy$l$Hr*ReK\w:(_``M:ǦBԲmhR@NP >ѝU%' 13atLjgt4O ")<u@VoYA38IG 4_?)o~[u.ᅬpLw$,ttQ[ \6Qb})Ŏ72K@w>T8~5,N乁c-Tlv#$I2<-fJLZ摳lru^Pd<=.m1MMf+km(=[3/71,(m}!\.·ڔe=D{ωM^ E2 !w/3+H6= M4A'Z,Dƞi*s\F. ONޜՍ 6 ۹,W!#%Xfo߷90 )!Us*@>i}ޟ|Gv-z C-d9Du1N,tA po%ǞMݩvIeʾ&Ĵ6flVk;;v^-YlM.#&l^D3 KYOhlu9ZM:IQtf\jwwŶLaG|-;+qm@٧ N4 8$ZTcg3-KVn*?CmY;S^cyס8'"R\R.E(/^,j&Ny[뙧}x0Q;>vdJKo7f>!ʏs5hr\TesnX͈S)lY,W%!%?b:I9;D>b60*/꘤p&8y\/+5D 8ǒܚsϩRXKIHdݢxN m& V}ih6{͎Q z|yń'<3reh;Xy3E ="A`.jbZ_+2f%vI^ف7Ҥz3q|Po_-g畈 eWGߚ&PJ/$/32pDqDwu&:`O#4) =lp7X\~\m+r-]hQ"eG>xTh "#Ud5i\*!' xAE@}oU4gnş5Y,tl:/IZo8io'"v){gdXߟ;ٺE+u7{</&Uiѝ*v|0l (kN1S#k>w?{Y9Ay|'?8*Yf dW(jP ]~:e!=0iټ౱]PEf-|ѝ6%~R)'ryhz`v,z5bphѵ1[$1ʪ{Jb~Կ s;_<9|9t*ʝX|Jy~>M۩^L(ݡ ֣KHڪzԴDjt³ޘy&m=t9+r[lS3΄QDgy+3f^x_hiޠdd357hm Oڻ;=F!}7;\+9n"jqK5T灁?"(l ,A]Dn,,fhaP)Feɻ3o52i@{;H8dg%lo VUÜ{#gZ#K 2f}{UZIݴzEW1M;7I^_w󱛍^1cŐ=!m endstream endobj 160 0 obj << /Type /ObjStm /N 100 /First 893 /Length 4535 /Filter /FlateDecode >> stream x\oIb>niuy pXX ćgmg3{NwZ)iTWL( 1a TOS  m$\B0Ba#0PpAZ# [ ,(k0zd8m@z]Hzxkq8Ne8(,t,!`X$J8&JNo( WZ8dQ((Zm#2"Ί:@ `Y)Afh<#d8'Q8B;Z"XNd!8/U0]x!8Z`.B] @ @.[ǥ2a\^UzM 0V@q@ C Es] wkp-F1@<7Z1b @Lta -dY K޵Jab oK>p-gjY+ǧE,/S5(@xu\ 8}PZPr2:}) p=a.KtNTRV ,rp2V İ_(Pn(n!w,ŝaŖq-tbukyxn,]{ mZ$#HR-@ +0 `\ab[9ڽYE;5 h;mڴcT+" H;K;5rdkvt;(=\'sC:aCFC8pr}(ܱ0T!ɻ*2ӤPC%sk>mlubKR@ۍ D0|-&p8RDad*U,Gg׭uhQʀ\A9uKc>帀@* PxX`LD5W0Н E*`(9@#f&!L׆!QX(b 1"z^ .H_$R*rM1R(Z`,JJCD'Dc.Pnc~W[mt6Z7='-.l\*JGNC!hSMqUI{(I`JjcD>{45G%Gg*݌sp=JBl3,fdX FNXTYxϻxřjNjJ{9wBю#٦*X̪SŃv%wߢ*GչM tw%pbKEf'5pl\c47q׸_1e8x[+C b3h˧j#¶BG QiMD}nW1(shB/X\M};2_=w0,mTqkqXnYi QW4(pEʥ9W|GDm*jɧi] tJIi (mRep) :̈́$ S\%9Zߤ]oh3<h#`ē ;&(, fFA-5)I<<x> D,%Wb]ZemMMCD̛d@+4^ 2Idj9<84&fdkC j;a1F:X7N2tb,E"U"60) 6CtJ]n]X hYCW'%/ kh!yiu~j)m+_eY{L -r=l08טt%oht] `N4S^mk~<3Ú7R7B҃ mQSg4iYhUx> z:==Yq'ٜ?]Ý'o~t~F 1}Z)VAPc1ht|%{$i9No>M_,׸y 7ij4/~(ʓqS|^(__QtvS^UY\W#L8ʫrRN򦜕-odvYEeWUcVޕ_ͧT 5 _?zs0T=jNR>, G 7]_CF۫f6Hw_{s[Sw/N^=yI /TUL 1[0;c2N'9dg8ϿLo ,>C}Ɵ%EPs vATݍee<]TGE1޿>nQq]-ЍÔ<ˉz:%B|ve)Hzv,(i¿u.1bu&rxd1[ڈW&l1l}>sSܦlHnמrWhnץR˾?+-s^ sqїڜLٶ/w'nۖ앣<{-y]#``WQѿg_8]bt9I 앃ޜ=y@m|څ-yvgcq=eM7_JG<yǙBBj->êrX lUP7\%||wya1^\\ΦSo\ݩ*y5_XUQ)R`qҭw7x6j]WN8~z :cDcc>$g&:ݵek:u/N_7g=_1ߕ-VBزa#:.!$@ .qxn;HKPGhtQ *zt2_,Qx6/_&˫)m[WīF<']bW,V fW`QAGkn%?1+^O|ە|-9~ᝃSWZa͘ygw;痮-e&]/}WkAg$=b[w>k,=|^J_9.|-ҿwߩ&wˉxwV˂]ӝc 'Loۮ鄯,=;wNd?O.a6_X)xQ0X}K'ē$|7}{H/m/u7ɐ2scM|N(KU>S(E/Y8 0 7 ¤׍jCWxg?S2/ 8ƬѾacQ9 ԱlF64SuxXi3d˩р 5-Ht0U MS_. -ÿA^-elf lmM$kpwf 4Wn֙'IJVDr4_Wɲg JpPk86/gx{Jk*8Jy6,;4t u\ gq#F6و?QP(`r@cnj͑Q8h6+rp$BT@U. E5#9!lT tk5mAvk =BC-]s%O= endstream endobj 249 0 obj << /Producer (pdfTeX-1.40.21) /Author()/Title()/Subject()/Creator(LaTeX with hyperref)/Keywords() /CreationDate (D:20210804172455-04'00') /ModDate (D:20210804172455-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.21 (TeX Live 2020/Debian) kpathsea version 6.3.2) >> endobj 242 0 obj << /Type /ObjStm /N 7 /First 54 /Length 273 /Filter /FlateDecode >> stream xڭRn0+ !rSm9UX($6}NhITUi3/{Q HD$T 1f4 tndCޮqڗu5#zХ1!z v ] /Length 632 /Filter /FlateDecode >> stream x;lay?ZTKѢn~oեWUZ$$&I ᄍ HIbgyy|3,C-#.$POm+1jӨ 𳸀tc <6c՘Įtc[ca7XTڈ Ʊ`P m`;(;N {@9t`8 pC`jpԀP喻j~p4F?}RuwݯVJ5/J5(j_.AɉO3Z=-ܖjTW:<_.L"qcYA1_F>= if (require("knitr")) opts_chunk$set(tidy=FALSE) @ Computing ``quasi-AIC'' (QAIC), in R is a minor pain, because the R Core team (or at least the ones who wrote \code{glm}, \code{glmmPQL}, etc.) are purists and don't believe that quasi- models should report a likelihood. As far as I know, there are three R packages that compute/handle QAIC: \rpkg{bbmle}, \rpkg{AICcmodavg} and \rpkg{MuMIn}. The basic problem is that quasi- model fits with \code{glm} return an \code{NA} for the log-likelihood, while the dispersion parameter ($\hat c$, $\phi$, whatever you want to call it) is only reported for quasi- models. Various ways to get around this are: \begin{itemize} \item{fit the model twice, once with a regular likelihood model (\code{family=binomial}, \code{poisson}, etc.) and once with the \code{quasi-} variant --- extract the log-likelihood from the former and the dispersion parameter from the latter} \item{only fit the regular model; extract the overdispersion parameter manually with <>= dfun <- function(object) { with(object,sum((weights * residuals^2)[weights > 0])/df.residual) } @ } \item{use the fact that quasi- fits still contain a deviance, even if they set the log-likelihood to \code{NA}. The deviance is twice the negative log-likelihood (it's offset by some constant which I haven't figured out yet, but it should still work fine for model comparisons)} \end{itemize} The whole problem is worse for \code{MASS::glmmPQL}, where (1) the authors have gone to greater efforts to make sure that the (quasi-)deviance is no longer preserved anywhere in the fitted model, and (2) they may have done it for good reason --- it is not clear whether the number that would get left in the `deviance' slot at the end of \code{glmmPQL}'s alternating \code{lme} and \code{glm} fits is even meaningful to the extent that regular QAICs are. (For discussion of a similar situation, see the \code{WARNING} section of \code{?gamm} in the \code{mgcv} package.) Example: use the values from one of the examples in \code{?glm}: <>= ## Dobson (1990) Page 93: Randomized Controlled Trial : counts <- c(18,17,15,20,10,20,25,13,12) outcome <- gl(3,1,9) treatment <- gl(3,3) @ Fit Poisson and quasi-Poisson models with all combinations of predictors: <>= glmOT.D93 <- glm(counts ~ outcome + treatment, family=poisson) glmO.D93 <- update(glmOT.D93, . ~ . - treatment) glmT.D93 <- update(glmOT.D93, . ~ . - outcome) glmX.D93 <- update(glmT.D93, . ~ . - treatment) glmQOT.D93 <- update(glmOT.D93, family=quasipoisson) glmQO.D93 <- update(glmO.D93, family=quasipoisson) glmQT.D93 <- update(glmT.D93, family=quasipoisson) glmQX.D93 <- update(glmX.D93, family=quasipoisson) @ Extract log-likelihoods: <>= (sum(dpois(counts, lambda=exp(predict(glmOT.D93)),log=TRUE))) ## by hand (logLik(glmOT.D93)) ## from Poisson fit @ The deviance (\code{deviance(glmOT.D93)}=\Sexpr{round(deviance(glmOT.D93),3)} is not the same as $-2L$ (\code{-2*logLik(glmOT.D93)}=\Sexpr{round(-2*c(logLik(glmOT.D93)),3)}), but the calculated differences in deviance are consistent, and are also extractable from the quasi- fit even though the log-likelihood is \code{NA}: <>= (-2*(logLik(glmT.D93)-logLik(glmOT.D93))) ## Poisson fit (deviance(glmT.D93)-deviance(glmOT.D93)) ## Poisson fit (deviance(glmQT.D93)-deviance(glmQOT.D93)) ## quasi-fit @ Compare hand-computed dispersion (in two ways) with the dispersion computed by \code{summary.glm()} on a quasi- fit: <>= (dfun(glmOT.D93)) (sum(residuals(glmOT.D93,"pearson")^2)/glmOT.D93$df.residual) (summary(glmOT.D93)$dispersion) (summary(glmQOT.D93)$dispersion) @ \section*{Examples} \subsection*{\code{bbmle}} <>= library(bbmle) (qAIC(glmOT.D93,dispersion=dfun(glmOT.D93))) (qAICc(glmOT.D93,dispersion=dfun(glmOT.D93),nobs=length(counts))) ICtab(glmOT.D93,glmT.D93,glmO.D93,glmX.D93, dispersion=dfun(glmOT.D93),type="qAIC") ICtab(glmOT.D93,glmT.D93,glmO.D93,glmX.D93, dispersion=dfun(glmOT.D93), nobs=length(counts),type="qAICc") detach("package:bbmle") @ \subsection*{\code{AICcmodavg}} <>= library(AICcmodavg) aictab(list(glmOT.D93,glmT.D93,glmO.D93,glmX.D93), modnames=c("OT","T","O","X"), c.hat=dfun(glmOT.D93)) detach("package:AICcmodavg") @ \subsection*{\code{MuMIn}} <>= library(MuMIn); packageVersion("MuMIn") ## from ?QAIC x.quasipoisson <- function(...) { res <- quasipoisson(...) res$aic <- poisson(...)$aic res } glmQOT2.D93 <- update(glmOT.D93,family="x.quasipoisson", na.action=na.fail) (gg <- dredge(glmQOT2.D93,rank="QAIC", chat=dfun(glmOT.D93))) (ggc <- dredge(glmQOT2.D93,rank="QAICc",chat=dfun(glmOT.D93))) detach("package:MuMIn") @ Notes: ICtab only gives delta-IC, limited decimal places (on purpose, but how do you change these defaults if you want to?). Need to add 1 to parameters to account for scale parameter. When doing corrected-IC you need to get the absolute number of parameters right, not just the relative number \ldots Not sure which classes of models each of these will handle (lm, glm, (n)lme, lme4, mle2 \ldots). Remember need to use overdispersion parameter from most complex model. glmmPQL: needs to be hacked somewhat more severely (does not contain deviance element, logLik has been NA'd out). \begin{tabular}{l|ccccccc} package & \code{lm} & \code{glm} & \code{(n)lme} & \code{multinom} & \code{polr} & \code{lme4} & \code{mle2} \\ \hline \code{AICcmodavg} & y & y & y & y & y & ? & ? \\ \code{MuMIn} & ? & ? & ? & ? & ? & ? & ? \\ \code{mle2 } & ? & ? & ? & ? & ? & ? & ? \end{tabular} \end{document} bbmle/inst/doc/mle2.R0000644000176200001440000001744314102602645014050 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,cache=TRUE,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---------------------------------------------------------------- ML1 <- function(prob1,prob2,prob3,theta,x) { prob <- c(prob1,prob2,prob3)[as.numeric(x$dilution)] size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } ## ----crowdertab,echo=FALSE,results="asis"------------------------------------- crowder.results <- matrix(c(0.132,0.871,0.839,78.424,0.027,0.028,0.032,-34.991, rep(NA,7),-34.829, rep(NA,7),-56.258), dimnames=list(c("prop diffs","full model","homog model"), c("prob1","prob2","prob3","theta","sd.prob1","sd.prob2","sd.prob3","NLL")), byrow=TRUE,nrow=3) latex(crowder.results,file="",table.env=FALSE,title="model") ## ----eval=FALSE--------------------------------------------------------------- # ## would prefer ~dilution-1, but problems with starting values ... # (m1B <- mle2(m~dbetabinom(prob,size=n,theta), # param=list(prob~dilution), # start=list(prob=0.5,theta=1), # data=orob1)) ## ----suppWarn,echo=FALSE------------------------------------------------------ opts_chunk$set(warning=FALSE) ## ----aodstderr---------------------------------------------------------------- round(stdEr(m2),3) ## ----aodvar------------------------------------------------------------------- sqrt(1/(1+coef(m2)["theta"])) ## ----deltavar----------------------------------------------------------------- sqrt(deltavar(sqrt(1/(1+theta)),meanval=coef(m2)["theta"], vars="theta",Sigma=vcov(m2)[4,4])) ## ----sigma3------------------------------------------------------------------- m2b <- mle2(m~dbetabinom(prob,size=n,theta=1/sigma^2-1), data=orob1, parameters=list(prob~dilution,sigma~1), start=list(prob=0.5,sigma=0.1)) ## ignore warnings (we haven't bothered to bound sigma<1) round(stdEr(m2b)["sigma"],3) p2b <- profile(m2b,prof.lower=c(-Inf,-Inf,-Inf,0)) ## ----compquad----------------------------------------------------------------- r1 <- rbind(confint(p2)["theta",], confint(m2,method="quad")["theta",]) rownames(r1) <- c("spline","quad") r1 ## ----profplottheta------------------------------------------------------------ plot(p2,which="theta",plot.confstr=TRUE) ## ----profplotsigma------------------------------------------------------------ plot(p2b,which="sigma",plot.confstr=TRUE, show.points=TRUE) ## ----homogmodel--------------------------------------------------------------- ml0 <- function(prob,theta,x) { size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } m0 <- mle2(ml0,start=list(prob=0.5,theta=100), data=list(x=orob1)) ## ----logLikcomp--------------------------------------------------------------- logLik(m0) ## ----formulafit--------------------------------------------------------------- m0f <- mle2(m~dbetabinom(prob,size=n,theta), parameters=list(prob~1,theta~1), data=orob1, start=list(prob=0.5,theta=100)) m2f <- update(m0f, parameters=list(prob~dilution,theta~1), start=list(prob=0.5,theta=78.424)) m3f <- update(m0f, parameters=list(prob~dilution,theta~dilution), start=list(prob=0.5,theta=78.424)) ## ----anovafit----------------------------------------------------------------- anova(m0f,m2f,m3f) ## ----ICtabfit----------------------------------------------------------------- AICtab(m0f,m2f,m3f,weights=TRUE) BICtab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) AICctab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) ## ----reWarn,echo=FALSE-------------------------------------------------------- opts_chunk$set(warning=FALSE) ## ----frogsetup---------------------------------------------------------------- frogdat <- data.frame( size=rep(c(9,12,21,25,37),each=3), killed=c(0,2,1,3,4,5,rep(0,4),1,rep(0,4))) frogdat$initial <- rep(10,nrow(frogdat)) ## ----getgg-------------------------------------------------------------------- library(ggplot2) ## ----gg1---------------------------------------------------------------------- gg1 <- ggplot(frogdat,aes(x=size,y=killed))+geom_point()+ stat_sum(aes(size=..n..))+ labs(size="#")+scale_x_continuous(limits=c(0,40))+ scale_size(breaks=1:3) ## ----gg1plot------------------------------------------------------------------ gg1 + geom_line(data=pdat1,colour="red")+ geom_line(data=pdat2,colour="blue") ## ----basegraphprofplot-------------------------------------------------------- plot(prof4) ## ----latticeprof,fig.height=5,fig.width=10,out.width="\\textwidth"------------ prof4_df <- as.data.frame(prof4) library(lattice) xyplot(abs(z)~focal|param,data=prof4_df, subset=abs(z)<3, type="b", xlab="", ylab=expression(paste(abs(z), " (square root of ",Delta," deviance)")), scale=list(x=list(relation="free")), layout=c(3,1)) ## ----ggplotprof,fig.height=5,fig.width=10------------------------------------- ss <-subset(prof4_df,abs(z)<3) ggplot(ss, aes(x=focal,y=abs(z)))+geom_line()+ geom_point()+ facet_grid(.~param,scale="free_x") ## ----oldargs,eval=FALSE------------------------------------------------------- # function (x, levels, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, # absVal = TRUE, ...) {} ## ----newargs,eval=FALSE------------------------------------------------------- # function (x, levels, which=1:p, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, # plot.confstr = FALSE, confstr = NULL, absVal = TRUE, add = FALSE, # col.minval="green", lty.minval=2, # col.conf="magenta", lty.conf=2, # col.prof="blue", lty.prof=1, # xlabs=nm, ylab="score", # show.points=FALSE, # main, xlim, ylim, ...) {} bbmle/inst/NEWS.Rd0000755000176200001440000004245614102531646013373 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.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/0000755000176200001440000000000014075064423014734 5ustar liggesusersbbmle/inst/vignetteData/orob1.rda0000755000176200001440000000043014075064423016446 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