bbmle/0000755000176200001440000000000013616005502011331 5ustar liggesusersbbmle/NAMESPACE0000755000176200001440000000315713516100631012557 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/0000755000176200001440000000000013615631572012117 5ustar liggesusersbbmle/man/profile.mle-class.Rd0000755000176200001440000001416613072222725015731 0ustar liggesusers\name{profile.mle2-class} \docType{class} \alias{profile.mle2-class} \alias{confint,profile.mle2-method} \alias{confint,mle2-method} \alias{confint.mle2} %% bogus but good ref link \alias{plot,profile.mle2-method} \alias{plot,profile.mle2,missing-method} \alias{show,profile.mle2-method} \alias{plot.profile.mle2} \title{Methods for likelihood profiles} \description{Definition of the mle2 likelihood profile class, and applicable methods} \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("profile.mle2", ...)}, but most often by invoking \code{profile} on an "mle2" object. } \section{Slots}{ \describe{ \item{\code{profile}:}{Object of class \code{"list"}. List of profiles, one for each requested parameter. Each profile is a data frame with the first column called \code{z} being the signed square root of the deviance, and the others being the parameters with names prefixed by \code{par.vals.}} \item{\code{summary}:}{Object of class \code{"summary.mle2"}. Summary of object being profiled.} } } \section{Methods}{ \describe{ \item{confint}{\code{signature(object = "profile.mle2")}: Use profile to generate approximate confidence intervals for parameters.} \item{plot}{\code{signature(x = "profile.mle2", y = "missing")}: Plot profiles for each parameter.} \item{summary}{\code{signature(x = "profile.mle2")}: Plot profiles for each parameter.} \item{show}{\code{signature(object = "profile.mle2")}: Show object.} } } \usage{ \S4method{plot}{profile.mle2}(x, levels, which=1:p, conf = c(99, 95, 90, 80, 50)/100, plot.confstr = TRUE, confstr = NULL, absVal = TRUE, add = FALSE, col.minval="green", lty.minval=2, col.conf="magenta", lty.conf=2, col.prof="blue", lty.prof=1, xlabs=nm, ylab="z", onepage=TRUE, ask=((prod(par("mfcol")) < length(which)) && dev.interactive() && !onepage), show.points=FALSE, main, xlim, ylim, \dots) \S4method{confint}{mle2}(object, parm, level = 0.95, method, trace=FALSE,quietly=!interactive(), tol.newmin=0.001,\dots) \S4method{confint}{profile.mle2}(object, parm, level = 0.95, trace=FALSE, \dots) } \arguments{ \item{x}{An object of class \code{profile.mle2}} \item{object}{An object of class \code{mle2} or \code{profile.mle2} (as appropriate)} \item{levels}{levels at which to plot likelihood cutoffs (set by conf by default)} \item{level}{level at which to compute confidence interval} \item{which}{(numeric or character) which parameter profiles to plot} \item{parm}{(numeric or character) which parameter(s) to find confidence intervals for} \item{method}{(character) "spline", "uniroot", or "quad", for spline-extrapolation-based (default), root-finding, or quadratic confidence intervals. By default it uses the value of \code{mle2.options("confint")} -- the factory setting is "spline".} \item{trace}{trace progress of confidence interval calculation when using \sQuote{uniroot} method?} \item{conf}{(1-alpha) levels at which to plot likelihood cutoffs/confidence intervals} \item{quietly}{(logical) suppress \dQuote{Profiling ...} message when computing profile to get confidence interval?} \item{tol.newmin}{see \code{\link{profile-methods}}} \item{plot.confstr}{(logical) plot labels showing confidence levels?} \item{confstr}{(character) labels for confidence levels (by default, constructed from conf levels)} \item{absVal}{(logical) plot absolute values of signed square root deviance difference ("V" plot rather than straight-line plot)?} \item{add}{(logical) add profile to existing graph?} \item{col.minval}{color for minimum line} \item{lty.minval}{line type for minimum line} \item{col.conf}{color for confidence intervals} \item{lty.conf}{line type for confidence intervals} \item{col.prof}{color for profile} \item{lty.prof}{line type for profile} \item{xlabs}{x labels} \item{ylab}{y label} \item{onepage}{(logical) plot all profiles on one page, adjusting par(mfcol) as necessary?} \item{ask}{(logical) pause for user input between plots?} \item{show.points}{(logical) show computed profile points as well as interpolated spline?} \item{main}{(logical) main title} \item{xlim}{x limits} \item{ylim}{y limits} \item{\dots}{other arguments} } \seealso{ \code{\link{mle2}}, \code{\link{mle2-class}}, \code{\link{summary.mle2-class}} } \details{ The default confidence interval calculation computes a likelihood profile and uses the points therein, or uses the computed points in an existing \code{profile.mle2} object, to construct an interpolation spline (which by default has three times as many points as were in the original set of profile points). It then uses linear interpolation between these interpolated points (!) } \examples{ x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) ## we have a choice here: (1) don't impose boundaries on the parameters, ## put up with warning messages about NaN values: fit1 <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), start=list(ymax=1,xhalf=1), data=d) p1 <- suppressWarnings(profile(fit1)) plot(p1,main=c("first","second"), xlab=c(~y[max],~x[1/2]),ylab="Signed square root deviance", show.points=TRUE) suppressWarnings(confint(fit1)) ## recomputes profile confint(p1) ## operates on existing profile suppressWarnings(confint(fit1,method="uniroot")) ## alternatively, we can use box constraints to keep ourselves ## to positive parameter values ... fit2 <- update(fit1,method="L-BFGS-B",lower=c(ymax=0.001,xhalf=0.001)) \dontrun{ p2 <- profile(fit2) plot(p2,show.points=TRUE) ## but the fit for ymax is just bad enough that the spline gets wonky confint(p2) ## now we get a warning confint(fit2,method="uniroot") ## bobyqa is a better-behaved bounded optimizer ... ## BUT recent (development, 2012.5.24) versions of ## optimx no longer allow single-parameter fits! if (require(optimx)) { fit3 <- update(fit1, optimizer="optimx", method="bobyqa",lower=c(ymax=0.001,xhalf=0.001)) p3 <- profile(fit3) plot(p3,show.points=TRUE) confint(p3) } } } \keyword{classes} bbmle/man/slice.mle-class.Rd0000754000176200001440000000211513013175535015357 0ustar liggesusers\name{slice.mle2-class} \docType{class} \alias{slice.mle2-class} \title{likelihood-surface slices} \description{evaluations of log-likelihood along transects in parameter space} \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("slice.mle2", ...)}. The objects are similar to likelihood profiles, but don't involve any optimization with respect to the other parameters. } \section{Slots}{ \describe{ \item{\code{profile}:}{Object of class \code{"list"}. List of slices, one for each requested parameter. Each slice is a data frame with the first column called \code{z} being the signed square root of the -2 log likelihood ratio, and the others being the parameters with names prefixed by \code{par.vals.}} \item{\code{summary}:}{Object of class \code{"summary.mle2"}. Summary of object being profiled.} } } \section{Methods}{ \describe{ \item{plot}{\code{signature(x = "profile.mle2", y = "missing")}: Plot profiles for each parameter.} } } \seealso{ \code{\link{profile.mle2-class}} } \keyword{classes} bbmle/man/namedrop.Rd0000755000176200001440000000142013046671362014212 0ustar liggesusers\name{namedrop} \alias{namedrop} \title{drop unneeded names from list elements} \description{ goes through a list (containing a combination of single- and multiple-element vectors) and removes redundant names that will make trouble for mle } \usage{ namedrop(x) } \arguments{ \item{x}{a list of named or unnamed, typically numeric, vectors} } \details{ examines each element of \code{x}. If the element has length one and is a named vector, the name is removed; if \code{length(x)} is greater than 1, but all the names are the same, the vector is renamed } \value{ the original list, with names removed/added } \author{Ben Bolker} \examples{ x = list(a=c(a=1),b=c(d=1,d=2),c=c(a=1,b=2,c=3)) names(unlist(namedrop(x))) names(unlist(namedrop(x))) } \keyword{misc} bbmle/man/mle2.options.Rd0000755000176200001440000000153313502542215014732 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.Rd0000755000176200001440000002233713502541601013243 0ustar liggesusers\name{mle2} \alias{mle2} \alias{mle} \alias{calc_mle2_function} \title{Maximum Likelihood Estimation} \description{ Estimate parameters by the method of maximum likelihood. } \usage{ mle2(minuslogl, start, method, optimizer, fixed = NULL, data=NULL, subset=NULL, default.start=TRUE, eval.only = FALSE, vecpar=FALSE, parameters=NULL, parnames=NULL, skip.hessian=FALSE, hessian.opts=NULL, use.ginv=TRUE, trace=FALSE, browse_obj=FALSE, gr=NULL, optimfun,\dots) calc_mle2_function(formula,parameters, links, start, parnames, use.deriv=FALSE, data=NULL,trace=FALSE) } \arguments{ \item{minuslogl}{Function to calculate negative log-likelihood, or a formula} \item{start}{Named list. Initial values for optimizer} \item{method}{Optimization method to use. See \code{\link{optim}}.} \item{optimizer}{Optimization function to use. Currently available choices are "optim" (the default), "nlm", "nlminb", "constrOptim", "optimx", and "optimize". If "optimx" is used, (1) the \code{optimx} package must be explicitly loaded with \code{\link{load}} or \code{\link{require}}(\emph{Warning:} Options other than the default may be poorly tested, use with caution.) } \item{fixed}{Named list. Parameter values to keep fixed during optimization.} \item{data}{list of data to pass to negative log-likelihood function: must be specified if \code{minuslogl} is specified as a formula} \item{subset}{logical vector for subsetting data (STUB)} \item{default.start}{Logical: allow default values of \code{minuslogl} as starting values?} \item{eval.only}{Logical: return value of \code{minuslogl(start)} rather than optimizing} \item{vecpar}{Logical: is first argument a vector of all parameters? (For compatibility with \code{\link{optim}}.) If \code{vecpar} is \code{TRUE}, then you should use \code{\link{parnames}} to define the parameter names for the negative log-likelihood function.} \item{parameters}{List of linear models for parameters. \emph{MUST BE SPECIFIED IN THE SAME ORDER as the start vector (this is a bug/restriction that I hope to fix soon, but in the meantime beware)}} \item{links}{(unimplemented) specify transformations of parameters} \item{parnames}{List (or vector?) of parameter names} \item{gr}{gradient function} \item{\dots}{Further arguments to pass to optimizer} \item{formula}{a formula for the likelihood (see Details)} \item{trace}{Logical: print parameter values tested?} \item{browse_obj}{Logical: drop into browser() within the objective function?} \item{skip.hessian}{Bypass Hessian calculation?} \item{hessian.opts}{Options for Hessian calculation, passed through to the \code{\link[numDeriv]{hessian}} function} \item{use.ginv}{Use generalized inverse (\code{\link[MASS]{ginv}}) to compute approximate variance-covariance} \item{optimfun}{user-supplied optimization function. Must take exactly the same arguments and return exactly the same structure as \code{\link{optim}}.} \item{use.deriv}{(experimental, not yet implemented): construct symbolic derivatives based on formula?} } \section{Warning}{Do not use a higher-level variable named \code{.i} in \code{parameters} -- this is reserved for internal use. } \details{ The \code{\link{optim}} optimizer is used to find the minimum of the negative log-likelihood. An approximate covariance matrix for the parameters is obtained by inverting the Hessian matrix at the optimum. The \code{minuslogl} argument can also specify a formula, rather than an objective function, of the form \code{x~ddistn(param1,...,paramn)}. In this case \code{ddistn} is taken to be a probability or density function, which must have (literally) \code{x} as its first argument (although this argument may be interpreted as a matrix of multivariate responses) and which must have a \code{log} argument that can be used to specify the log-probability or log-probability-density is required. If a formula is specified, then \code{parameters} can contain a list of linear models for the parameters. If a formula is given and non-trivial linear models are given in \code{parameters} for some of the variables, then model matrices will be generated using \code{model.matrix}. \code{start} can be given: \itemize{ \item as a list containing lists, with each list corresponding to the starting values for a particular parameter; \item just for the higher-level parameters, in which case all of the additional parameters generated by \code{model.matrix} will be given starting values of zero (unless a no-intercept formula with \code{-1} is specified, in which case all the starting values for that parameter will be set equal) \item (to be implemented!) as an exhaustive (flat) list of starting values (in the order given by \code{model.matrix}) } The \code{trace} argument applies only when a formula is specified. If you specify a function, you can build in your own \code{print()} or \code{cat()} statement to trace its progress. (You can also specify a value for \code{trace} as part of a \code{control} list for \code{optim()}: see \code{\link{optim}}.) The \code{skip.hessian} argument is useful if the function is crashing with a "non-finite finite difference value" error when trying to evaluate the Hessian, but will preclude many subsequent confidence interval calculations. (You will know the Hessian is failing if you use \code{method="Nelder-Mead"} and still get a finite-difference error.) If convergence fails, see the manual page of the relevant optimizer (\code{\link{optim}} by default, but possibly \code{\link{nlm}}, \code{\link{nlminb}}, \code{\link[optimx]{optimx}}, or \code{\link{constrOptim}} if you have set the value of \code{optimizer}) for the meanings of the error codes/messages. } \value{ An object of class \code{"mle2"}. } \note{ Note that the \code{minuslogl} function should return the negative log-likelihood, -log L (not the log-likelihood, log L, nor the deviance, -2 log L). It is the user's responsibility to ensure that the likelihood is correct, and that asymptotic likelihood inference is valid (e.g. that there are "enough" data and that the estimated parameter values do not lie on the boundary of the feasible parameter space). If \code{lower}, \code{upper}, \code{control$parscale}, or \code{control$ndeps} are specified for \code{optim} fits, they must be named vectors. The requirement that \code{data} be specified when using the formula interface is relatively new: it saves many headaches on the programming side when evaluating the likelihood function later on (e.g. for profiling or constructing predictions). Since \code{data.frame} uses the names of its arguments as column names by default, it is probably the easiest way to package objects that are lying around in the global workspace for use in \code{mle2} (provided they are all of the same length). When \code{optimizer} is set to "optimx" and multiple optimization methods are used (i.e. the \code{methods} argument has more than one element, or \code{all.methods=TRUE} is set in the control options), the best (minimum negative log-likelihood) solution will be saved, regardless of reported convergence status (and future operations such as profiling on the fit will only use the method that found the best result). } \seealso{ \code{\link{mle2-class}} } \examples{ x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) ## in general it is best practice to use the `data' argument, ## but variables can also be drawn from the global environment LL <- function(ymax=15, xhalf=6) -sum(stats::dpois(y, lambda=ymax/(1+x/xhalf), log=TRUE)) ## uses default parameters of LL (fit <- mle2(LL)) fit1F <- mle2(LL, fixed=list(xhalf=6)) coef(fit1F) coef(fit1F,exclude.fixed=TRUE) (fit0 <- mle2(y~dpois(lambda=ymean),start=list(ymean=mean(y)),data=d)) anova(fit0,fit) summary(fit) logLik(fit) vcov(fit) p1 <- profile(fit) plot(p1, absVal=FALSE) confint(fit) ## use bounded optimization ## the lower bounds are really > 0, but we use >=0 to stress-test ## profiling; note lower must be named (fit1 <- mle2(LL, method="L-BFGS-B", lower=c(ymax=0, xhalf=0))) p1 <- profile(fit1) plot(p1, absVal=FALSE) ## a better parameterization: LL2 <- function(lymax=log(15), lxhalf=log(6)) -sum(stats::dpois(y, lambda=exp(lymax)/(1+x/exp(lxhalf)), log=TRUE)) (fit2 <- mle2(LL2)) plot(profile(fit2), absVal=FALSE) exp(confint(fit2)) vcov(fit2) cov2cor(vcov(fit2)) mle2(y~dpois(lambda=exp(lymax)/(1+x/exp(lhalf))), start=list(lymax=0,lhalf=0), data=d, parameters=list(lymax~1,lhalf~1)) \dontrun{ ## try bounded optimization with nlminb and constrOptim (fit1B <- mle2(LL, optimizer="nlminb", lower=c(lymax=1e-7, lhalf=1e-7))) p1B <- profile(fit1B) confint(p1B) (fit1C <- mle2(LL, optimizer="constrOptim", ui = c(lymax=1,lhalf=1), ci=2, method="Nelder-Mead")) set.seed(1001) lymax <- c(0,2) lhalf <- 0 x <- sort(runif(200)) g <- factor(sample(c("a","b"),200,replace=TRUE)) y <- rnbinom(200,mu=exp(lymax[g])/(1+x/exp(lhalf)),size=2) d2 <- data.frame(x,g,y) fit3 <- mle2(y~dnbinom(mu=exp(lymax)/(1+x/exp(lhalf)),size=exp(logk)), parameters=list(lymax~g),data=d2, start=list(lymax=0,lhalf=0,logk=0)) } } \keyword{models} bbmle/man/summary.mle-class.Rd0000754000176200001440000000220713013175535015757 0ustar liggesusers\name{summary.mle2-class} \docType{class} \alias{summary.mle2-class} \alias{coef,summary.mle2-method} \alias{show,summary.mle2-method} \title{Class "summary.mle2", summary of "mle2" objects} \description{Extract of "mle2" object} \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("summary.mle2", ...)}, but most often by invoking \code{summary} on an "mle2" object. They contain values meant for printing by \code{show}. } \section{Slots}{ \describe{ \item{\code{call}:}{Object of class \code{"language"} The call that generated the "mle2" object.} \item{\code{coef}:}{Object of class \code{"matrix"}. Estimated coefficients and standard errors } \item{\code{m2logL}:}{Object of class \code{"numeric"}. Minus twice the log likelihood.} } } \section{Methods}{ \describe{ \item{show}{\code{signature(object = "summary.mle2")}: Pretty-prints \code{object} } \item{coef}{\code{signature(object = "summary.mle2")}: Extracts the contents of the \code{coef} slot} } } \seealso{ \code{\link{summary}}, \code{\link{mle2}}, \code{\link{mle2-class}} } \keyword{classes} bbmle/man/ICtab.Rd0000755000176200001440000000636413046671362013403 0ustar liggesusers\name{ICtab} \alias{ICtab} \alias{AICtab} \alias{BICtab} \alias{AICctab} \alias{print.ICtab} \title{Compute table of information criteria and auxiliary info} \description{ Computes information criteria for a series of models, optionally giving information about weights, differences between ICs, etc. } \usage{ ICtab(\dots, type=c("AIC","BIC","AICc","qAIC","qAICc"), weights = FALSE, delta = TRUE, base = FALSE, logLik=FALSE, sort = TRUE, nobs=NULL, dispersion = 1, mnames, k = 2) AICtab(\dots,mnames) BICtab(\dots,mnames) AICctab(\dots,mnames) \method{print}{ICtab}(x,\dots,min.weight) } \arguments{ \item{\dots}{a list of (logLik or?) mle objects; in the case of \code{AICtab} etc., could also include other arguments to \code{ICtab}} \item{type}{specify information criterion to use} \item{base}{(logical) include base IC (and log-likelihood) values?} \item{weights}{(logical) compute IC weights?} \item{logLik}{(logical) include log-likelihoods in the table?} \item{delta}{(logical) compute differences among ICs (and log-likelihoods)?} \item{sort}{(logical) sort ICs in increasing order?} \item{nobs}{(integer) number of observations: required for \code{type="BIC"} or \code{type="AICc"} unless objects have a \code{\link{nobs}} method} \item{dispersion}{overdispersion estimate, for computing qAIC: required for \code{type="qAIC"} or \code{type="qAICc"} unless objects have a \code{"dispersion"} attribute} \item{mnames}{names for table rows: defaults to names of objects passed} \item{k}{penalty term (largely unused: left at default of 2)} \item{x}{an ICtab object} \item{min.weight}{minimum weight for exact reporting (smaller values will be reported as "<[min.weight]")} } \value{ A data frame containing: \item{IC}{information criterion} \item{df}{degrees of freedom/number of parameters} \item{dIC}{difference in IC from minimum-IC model} \item{weights}{exp(-dIC/2)/sum(exp(-dIC/2))} } \note{(1) The print method uses sensible defaults; all ICs are rounded to the nearest 0.1, and IC weights are printed using \code{\link{format.pval}} to print an inequality for values <0.001. (2) The computation of degrees of freedom/number of parameters (e.g., whether variance parameters are included in the total) varies enormously between packages. As long as the df computations for a given set of models is consistent, differences don't matter, but one needs to be careful with log likelihoods and models taken from different packages. If necessary one can change the degrees of freedom manually by saying \code{attr(obj,"df") <- df.new}, where \code{df.new} is the desired number of parameters. (3) Defaults have changed to \code{sort=TRUE}, \code{base=FALSE}, \code{delta=TRUE}, to match my conviction that it rarely makes sense to report the overall values of information criteria} \references{Burnham and Anderson 2002} \author{Ben Bolker} \examples{ set.seed(101) d <- data.frame(x=1:20,y=rpois(20,lambda=2)) m0 <- glm(y~1,data=d) m1 <- update(m0,.~x) m2 <- update(m0,.~poly(x,2)) AICtab(m0,m1,m2,mnames=LETTERS[1:3]) AICtab(m0,m1,m2,base=TRUE,logLik=TRUE) AICtab(m0,m1,m2,logLik=TRUE) AICctab(m0,m1,m2,weights=TRUE) print(AICctab(m0,m1,m2,weights=TRUE),min.weight=0.1) } \keyword{misc} bbmle/man/profile-methods.Rd0000755000176200001440000000536313071427071015512 0ustar liggesusers\name{profile-methods} \docType{methods} \alias{proffun} \alias{profile-methods} \alias{profile,mle2-method} \alias{profile.mle2} \title{Likelihood profiles } \description{ Compute likelihood profiles for a fitted model } \usage{ proffun(fitted, which = 1:p, maxsteps = 100, alpha = 0.01, zmax = sqrt(qchisq(1 - alpha/2, p)), del = zmax/5, trace = FALSE, skiperrs=TRUE, std.err, tol.newmin = 0.001, debug=FALSE, prof.lower, prof.upper, skip.hessian = TRUE, continuation = c("none","naive","linear"), try_harder=FALSE, \dots) \S4method{profile}{mle2}(fitted, \dots) } \arguments{ \item{fitted}{A fitted maximum likelihood model of class \dQuote{mle2}} \item{which}{a numeric or character vector describing which parameters to profile (default is to profile all parameters)} \item{maxsteps}{maximum number of steps to take looking for an upper value of the negative log-likelihood} \item{alpha}{maximum (two-sided) likelihood ratio test confidence level to find} \item{zmax}{maximum value of signed square root of deviance difference to find (default value corresponds to a 2-tailed chi-squared test at level alpha)} \item{del}{step size for profiling} \item{trace}{(logical) produce tracing output?} \item{skiperrs}{(logical) ignore errors produced during profiling?} \item{std.err}{Optional numeric vector of standard errors, for cases when the Hessian is badly behaved. Will be replicated if necessary, and NA values will be replaced by the corresponding values from the fit summary} \item{tol.newmin}{tolerance for diagnosing a new minimum below the minimum deviance estimated in initial fit is found} \item{debug}{(logical) debugging output?} \item{prof.lower}{optional vector of lower bounds for profiles} \item{prof.upper}{optional vector of upper bounds for profiles} \item{continuation}{use continuation method to set starting values? \code{"none"} sets starting values to best fit; \code{"naive"} sets starting values to those of previous profiling fit; \code{"linear"} (not yet implemented) would use linear extrapolation from the previous two profiling fits} \item{skip.hessian}{skip hessian (defunct?)} \item{try_harder}{(logical) ignore \code{NA} and flat spots in the profile, try to continue anyway?} \item{\dots}{additional arguments (not used)} } \details{ \code{proffun} is the guts of the profile method, exposed so that other packages can use it directly. See the vignette (\code{vignette("mle2",package="bbmle")}) for more technical details of how profiling is done. } \seealso{\code{\link{profile.mle-class}}} \keyword{methods} bbmle/man/BIC-methods.Rd0000754000176200001440000000566313013175535014452 0ustar liggesusers\name{BIC-methods} \docType{methods} %\alias{BIC} \alias{BIC-methods} \alias{AIC-methods} \alias{AICc-methods} \alias{logLik-methods} \alias{AICc} \alias{AIC,mle2-method} \alias{AICc,mle2-method} \alias{AICc,logLik-method} \alias{AICc,ANY-method} \alias{AICc,ANY,mle2,logLik-method} \alias{qAICc} \alias{qAICc-methods} \alias{qAICc,ANY-method} \alias{qAICc,mle2-method} \alias{qAICc,logLik-method} \alias{qAIC} \alias{qAIC-methods} \alias{qAIC,ANY-method} \alias{qAIC,mle2-method} \alias{qAIC,logLik-method} %\alias{BIC,logLik-method} %\alias{BIC,ANY-method} %\alias{BIC,mle2-method} %\alias{BIC,ANY,mle2,logLik-method} \alias{qAIC,ANY,mle2,logLik-method} \alias{qAICc,ANY,mle2,logLik-method} \alias{logLik,mle2-method} \alias{anova,mle2-method} \title{Log likelihoods and model selection for mle2 objects} \description{ Various functions for likelihood-based and information-theoretic model selection of likelihood models } \section{Methods}{ \describe{ \item{logLik}{\code{signature(object = "mle2")}: Extract maximized log-likelihood.} \item{AIC}{\code{signature(object = "mle2")}: Calculate Akaike Information Criterion} \item{AICc}{\code{signature(object = "mle2")}: Calculate small-sample corrected Akaike Information Criterion} %\item{BIC}{\code{signature(object = "mle2")}: Calculate %Bayesian (Schwarz) Information Criterion} %\item{BIC}{\code{signature(object = "logLik")}: Calculate %Bayesian (Schwarz) Information Criterion} %\item{BIC}{\code{signature(object = "ANY")}: Calculate %Bayesian (Schwarz) Information Criterion} \item{anova}{\code{signature(object="mle2")}: Likelihood Ratio Test comparision of different models} } } \usage{ %\S4method{BIC}{ANY,mle2,logLik}(object,...) \S4method{AICc}{ANY,mle2,logLik}(object,...,nobs,k=2) \S4method{qAIC}{ANY,mle2,logLik}(object,...,k=2) \S4method{qAICc}{ANY,mle2,logLik}(object,...,nobs,k=2) } \arguments{ \item{object}{A \code{logLik} or \code{mle2} object} \item{...}{An optional list of additional \code{logLik} or \code{mle2} objects (fitted to the same data set).} \item{nobs}{Number of observations (sometimes obtainable as an attribute of the fit or of the log-likelihood)} \item{k}{penalty parameter (nearly always left at its default value of 2)} } \details{ Further arguments to \code{BIC} can be specified in the \code{...} list: \code{delta} (logical) specifies whether to include a column for delta-BIC in the output. } \value{ A table of the BIC values, degrees of freedom, and possibly delta-BIC values relative to the minimum-BIC model } \note{This is implemented in an ugly way and could probably be improved!} \examples{ d <- data.frame(x=0:10,y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) (fit <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), start=list(ymax=25,xhalf=3),data=d)) (fit2 <- mle2(y~dpois(lambda=(x+1)*slope), start=list(slope=1),data=d)) BIC(fit) BIC(fit,fit2) } \keyword{methods} bbmle/man/pop_pred_samp.Rd0000644000176200001440000000345713502542657015247 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, 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)} } \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.Rd0000755000176200001440000000473613046671362014314 0ustar liggesusers\name{strwrapx} \alias{strwrapx} \title{Wrap strings at white space and + symbols} \description{ Extended (hacked) version of strwrap: wraps a string at whitespace and plus symbols } \usage{ strwrapx(x, width = 0.9 * getOption("width"), indent = 0, exdent = 0, prefix = "", simplify = TRUE, parsplit = "\n[ \t\n]*\n", wordsplit = "[ \t\n]") } \arguments{ \item{x}{a character vector, or an object which can be converted to a character vector by \code{\link{as.character}}.} \item{width}{a positive integer giving the target column for wrapping lines in the output.} \item{indent}{a non-negative integer giving the indentation of the first line in a paragraph.} \item{exdent}{a non-negative integer specifying the indentation of subsequent lines in paragraphs.} \item{prefix}{a character string to be used as prefix for each line.} \item{simplify}{a logical. If \code{TRUE}, the result is a single character vector of line text; otherwise, it is a list of the same length as \code{x} the elements of which are character vectors of line text obtained from the corresponding element of \code{x}. (Hence, the result in the former case is obtained by unlisting that of the latter.)} \item{parsplit}{Regular expression describing how to split paragraphs} \item{wordsplit}{Regular expression decribing how to split words} } \details{ Whitespace in the input is destroyed. Double spaces after periods (thought as representing sentence ends) are preserved. Currently, possible sentence ends at line breaks are not considered specially. Indentation is relative to the number of characters in the prefix string. } \examples{ ## Read in file 'THANKS'. x <- paste(readLines(file.path(R.home("doc"), "THANKS")), collapse = "\n") ## Split into paragraphs and remove the first three ones x <- unlist(strsplit(x, "\n[ \t\n]*\n"))[-(1:3)] ## Join the rest x <- paste(x, collapse = "\n\n") ## Now for some fun: writeLines(strwrap(x, width = 60)) writeLines(strwrap(x, width = 60, indent = 5)) writeLines(strwrap(x, width = 60, exdent = 5)) writeLines(strwrap(x, prefix = "THANKS> ")) ## Note that messages are wrapped AT the target column indicated by ## 'width' (and not beyond it). ## From an R-devel posting by J. Hosking . x <- paste(sapply(sample(10, 100, rep=TRUE), function(x) substring("aaaaaaaaaa", 1, x)), collapse = " ") sapply(10:40, function(m) c(target = m, actual = max(nchar(strwrap(x, m))))) } \keyword{character} bbmle/man/sbinom.Rd0000755000176200001440000000423013571746221013676 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.Rd0000754000176200001440000000744213054650752014275 0ustar liggesusers\name{mle2-class} \docType{class} \alias{mle2-class} \alias{coef,mle2-method} \alias{show,mle2-method} \alias{slice,mle2-method} \alias{summary,mle2-method} \alias{update,mle2-method} \alias{vcov,mle2-method} \alias{deviance,mle2-method} \alias{coerce,mle,mle2-method} \alias{formula,mle2-method} \alias{stdEr} \alias{stdEr,mle2-method} \title{Class "mle2". Result of Maximum Likelihood Estimation.} \description{This class encapsulates results of a generic maximum likelihood procedure.} \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("mle2", \dots)}, but most often as the result of a call to \code{\link{mle2}}. } \section{Slots}{ \describe{ \item{\code{call}:}{(language) The call to \code{\link{mle2}}.} \item{\code{call.orig}:}{(language) The call to \code{\link{mle2}}, saved in its original form (i.e. without data arguments evaluated).} \item{\code{coef}:}{(numeric) Vector of estimated parameters.} \item{\code{data}:}{(data frame or list) Data with which to evaluate the negative log-likelihood function} \item{\code{fullcoef}:}{(numeric) Fixed and estimated parameters.} \item{\code{vcov}:}{(numeric matrix) Approximate variance-covariance matrix, based on the second derivative matrix at the MLE.} \item{\code{min}:}{(numeric) Minimum value of objective function = minimum negative log-likelihood.} \item{\code{details}:}{(list) Return value from \code{\link{optim}}.} \item{\code{minuslogl}:}{(function) The negative log-likelihood function.} \item{\code{optimizer}:}{(character) The optimizing function used.} \item{\code{method}:}{(character) The optimization method used.} \item{\code{formula}:}{(character) If a formula was specified, a character vector giving the formula and parameter specifications.} } } \section{Methods}{ \describe{ \item{coef}{\code{signature(object = "mle2")}: Extract coefficients. If \code{exclude.fixed=TRUE} (it is \code{FALSE} by default), only the non-fixed parameter values are returned.} \item{confint}{\code{signature(object = "mle2")}: Confidence intervals from likelihood profiles, or quadratic approximations, or root-finding.} \item{show}{\code{signature(object = "mle2")}: Display object briefly.} \item{show}{\code{signature(object = "summary.mle2")}: Display object briefly.} \item{summary}{\code{signature(object = "mle2")}: Generate object summary.} \item{update}{\code{signature(object = "mle2")}: Update fit.} \item{vcov}{\code{signature(object = "mle2")}: Extract variance-covariance matrix.} \item{formula}{\code{signature(object="mle2")}: Extract formula} \item{plot}{\code{signature(object="profile.mle2,missing")}: Plot profile. } } } \section{Details on the confint method}{ When the parameters in the original fit are constrained using \code{lower} or \code{upper}, or when \code{prof.lower} or \code{prof.upper} are set, and the confidence intervals lie outside the constraint region, \code{confint} will return \code{NA}. This may be too conservative -- in some cases, the appropriate answer would be to set the confidence limit to the lower/upper bound as appropriate -- but it is the most general answer. (If you have a strong opinion about the need for a new option to \code{confint} that sets the bounds to the limits automatically, please contact the package maintainer.) } \examples{ x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) lowerbound <- c(a=2,b=-0.2) d <- data.frame(x,y) fit1 <- mle2(y~dpois(lambda=exp(a+b*x)),start=list(a=0,b=2),data=d, method="L-BFGS-B",lower=c(a=2,b=-0.2)) (cc <- confint(fit1,quietly=TRUE)) ## to set the lower bounds to the limit na_lower <- is.na(cc[,1]) cc[na_lower,1] <- lowerbound[na_lower] cc } \keyword{classes} bbmle/man/as.data.frame.profile.mle2.Rd0000755000176200001440000000260313072042021017271 0ustar liggesusers\name{as.data.frame.profile.mle2} \alias{as.data.frame.profile.mle2} \alias{coerce,profile.mle2-method} \alias{coerce,profile.mle2,data.frame-method} \title{convert profile to data frame} \description{ converts a profile of a fitted mle2 object to a data frame } \usage{ \S3method{as.data.frame}{profile.mle2}(x, row.names=NULL, optional=FALSE, \dots) } \arguments{ \item{x}{a profile object} \item{row.names}{row names (unused)} \item{optional}{unused} \item{\dots}{unused} } \value{ a data frame with columns \item{param}{name of parameter being profiled} \item{z}{signed square root of the deviance difference from the minimum} \item{parameter values}{named par.vals.parname} \item{focal}{value of focal parameter: redundant, but included for plotting convenience} } \examples{ ## use as.data.frame and lattice to plot profiles x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) library(bbmle) LL <- function(ymax=15, xhalf=6) { -sum(stats::dpois(y, lambda=ymax/(1+x/xhalf), log=TRUE)) } ## uses default parameters of LL fit1 <- mle2(LL) p1 <- profile(fit1) d1 <- as.data.frame(p1) library(lattice) xyplot(abs(z)~focal|param,data=d1, subset=abs(z)<3, type="b", xlab="", ylab=expression(paste(abs(z), " (square root of ",Delta," deviance)")), scale=list(x=list(relation="free"))) } \author{Ben Bolker} \keyword{misc} bbmle/man/get.mnames.Rd0000755000176200001440000000046613046671362014454 0ustar liggesusers\name{get.mnames} \alias{get.mnames} \title{extract model names} \description{ given a list of models, extract the names (or "model n") } \usage{ get.mnames(Call) } \arguments{ \item{Call}{a function call (usually a list of models)} } \value{ a vector of model names } \author{Ben Bolker} \keyword{misc} bbmle/man/dnorm_n.Rd0000644000176200001440000000151213370365441014036 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.Rd0000755000176200001440000000076613046671362014671 0ustar liggesusers\name{call.to.char} \alias{call.to.char} \title{Convert calls to character} \description{ Utility function (hack) to convert calls such as y~x to their character equivalent } \usage{ call.to.char(x) } \arguments{ \item{x}{a formula (call)} } \details{ It would be nice if \code{as.character(y~x)} gave "y~x", but it doesn't, so this hack achieves the same goal } \value{ a character vector of length 1 } \author{Ben Bolker} \examples{ as.character(y~x) call.to.char(y~x) } \keyword{misc} bbmle/man/relist.Rd0000754000176200001440000000107513013175535013707 0ustar liggesusers\name{relist2} \alias{relist2} \title{reconstruct the structure of a list} \description{ reshapes a vector according to a list template } \usage{ relist2(v, l) } \arguments{ \item{v}{vector, probably numeric, of values to reshape} \item{l}{template list giving structure} } \details{ attempts to coerce \code{v} into a list with the same structure and names as \code{l} } \value{ a list with values corresponding to v and structure corresponding to l } \author{Ben Bolker} \examples{ l = list(b=1,c=2:5,d=matrix(1:4,nrow=2)) relist2(1:9,l) } \keyword{misc} bbmle/man/slice.Rd0000755000176200001440000001045613305573057013515 0ustar liggesusers\name{slice} \alias{slice} \alias{sliceOld} \alias{slicetrans} \alias{slice1D} \alias{slice2D} \title{Calculate likelihood "slices"} \description{ Computes cross-section(s) of a multi-dimensional likelihood surface } \usage{ slice(x, dim=1, ...) sliceOld(fitted, which = 1:p, maxsteps = 100, alpha = 0.01, zmax = sqrt(qchisq(1 - alpha/2, p)), del = zmax/5, trace = FALSE, tol.newmin=0.001, \dots) slice1D(params,fun,nt=101,lower=-Inf, upper=Inf,verbose=TRUE, tranges=NULL,\dots) slice2D(params,fun,nt=31,lower=-Inf, upper=Inf, cutoff=10,verbose=TRUE, tranges=NULL, \dots) slicetrans(params, params2, fun, extend=0.1, nt=401, lower=-Inf, upper=Inf) } \arguments{ \item{x}{a fitted model object of some sort} \item{dim}{dimensionality of slices (1 or 2)} \item{params}{a named vector of baseline parameter values} \item{params2}{a vector of parameter values} \item{fun}{an objective function} \item{nt}{(integer) number of slice-steps to take} \item{lower}{lower bound(s) (stub?)} \item{upper}{upper bound(s) (stub?)} \item{cutoff}{maximum increase in objective function to allow when computing ranges} \item{extend}{(numeric) fraction by which to extend range beyond specified points} \item{verbose}{print verbose output?} \item{fitted}{A fitted maximum likelihood model of class \dQuote{mle2}} \item{which}{a numeric or character vector describing which parameters to profile (default is to profile all parameters)} \item{maxsteps}{maximum number of steps to take looking for an upper value of the negative log-likelihood} \item{alpha}{maximum (two-sided) likelihood ratio test confidence level to find} \item{zmax}{maximum value of signed square root of deviance difference to find (default value corresponds to a 2-tailed chi-squared test at level alpha)} \item{del}{step size for profiling} \item{trace}{(logical) produce tracing output?} \item{tol.newmin}{tolerance for diagnosing a new minimum below the minimum deviance estimated in initial fit is found} \item{tranges}{a two-column matrix giving lower and upper bounds for each parameter} \item{\dots}{additional arguments (not used)} } \value{ An object of class \code{slice} with \describe{ \item{slices}{a list of individual parameter (or parameter-pair) slices, each of which is a data frame with elements \describe{ \item{var1}{name of the first variable} \item{var2}{(for 2D slices) name of the second variable} \item{x}{parameter values} \item{y}{(for 2D slices) parameter values} \item{z}{slice values} \item{ranges}{a list (?) of the ranges for each parameter} \item{params}{vector of baseline parameter values} \item{dim}{1 or 2} } } \code{sliceOld} returns instead a list with elements \code{profile} and \code{summary} (see \code{\link{profile.mle2}}) } } \details{ Slices provide a lighter-weight way to explore likelihood surfaces than profiles, since they vary a single parameter rather than optimizing over all but one or two parameters. \describe{ \item{slice}{is a generic method} \item{slice1D}{creates one-dimensional slices, by default of all parameters of a model} \item{slice2D}{creates two-dimensional slices, by default of all pairs of parameters in a model. 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.Rd0000754000176200001440000000202313013175535014205 0ustar liggesusers\name{parnames} \alias{parnames} \alias{parnames<-} \title{get and set parameter names} \description{ Gets and sets the "parnames" attribute on a negative log-likelihood function } \usage{ parnames(obj) parnames(obj) <- value } \arguments{ \item{obj}{a negative log-likelihood function} \item{value}{a character vector of parameter names} } \details{ The \code{parnames} attribute is used by \code{mle2()} when the negative log-likelihood function takes a parameter vector, rather than a list of parameters; this allows users to use the same objective function for \code{optim()} and \code{mle2()} } \value{ Returns the \code{parnames} attribute (a character vector of parameter names) or sets it. } \author{Ben Bolker} \examples{ x <- 1:5 set.seed(1001) y <- rbinom(5,prob=x/(1+x),size=10) mfun <- function(p) { a <- p[1] b <- p[2] -sum(dbinom(y,prob=a*x/(b+x),size=10,log=TRUE)) } optim(fn=mfun,par=c(1,1)) parnames(mfun) <- c("a","b") mle2(minuslogl=mfun,start=c(a=1,b=1),method="Nelder-Mead") } \keyword{misc} bbmle/man/predict-methods.Rd0000754000176200001440000000450313013175535015477 0ustar liggesusers\name{predict-methods} \docType{methods} \alias{gfun} \alias{predict-methods} \alias{predict,mle2-method} \alias{residuals,mle2-method} \alias{simulate,mle2-method} \title{Predicted values from an mle2 fit} \description{ Given an \code{mle2} fit and an optional list of new data, return predictions (more generally, summary statistics of the predicted distribution) } \section{Methods}{ \describe{ \item{x = "mle2"}{an \code{mle2} fit} }} \usage{ \S4method{predict}{mle2}(object, newdata=NULL, location="mean", newparams=NULL, \dots) \S4method{simulate}{mle2}(object, nsim, seed, newdata=NULL, newparams=NULL, \dots) \S4method{residuals}{mle2}(object,type=c("pearson","response"), location="mean",\dots) } \arguments{ \item{object}{an mle2 object} \item{newdata}{optional list of new data} \item{newparams}{optional vector of new parameters} \item{location}{name of the summary statistic to return} \item{nsim}{number of simulations} \item{seed}{random number seed} \item{type}{residuals type} \item{\dots}{additional arguments (for generic compatibility)} } \note{For some models (e.g. constant models), \code{predict} may return a single value rather than a vector of the appropriate length.} \examples{ set.seed(1002) lymax <- c(0,2) lhalf <- 0 x <- runif(200) g <- factor(rep(c("a","b"),each=100)) y <- rnbinom(200,mu=exp(lymax[g])/(1+x/exp(lhalf)),size=2) dat <- data.frame(y,g,x) fit3 <- mle2(y~dnbinom(mu=exp(lymax)/(1+x/exp(lhalf)),size=exp(logk)), parameters=list(lymax~g), start=list(lymax=0,lhalf=0,logk=0), data=dat) plot(y~x,col=g) ## true curves curve(exp(0)/(1+x/exp(0)),add=TRUE) curve(exp(2)/(1+x/exp(0)),col=2,add=TRUE) ## model predictions xvec = seq(0,1,length=100) lines(xvec,predict(fit3,newdata=list(g=factor(rep("a",100),levels=c("a","b")), x = xvec)),col=1,lty=2) lines(xvec,predict(fit3,newdata=list(g=factor(rep("b",100),levels=c("a","b")), x = xvec)),col=2,lty=2) ## comparing automatic and manual predictions p1 = predict(fit3) p2A = with(as.list(coef(fit3)),exp(`lymax.(Intercept)`)/(1+x[1:100]/exp(lhalf))) p2B = with(as.list(coef(fit3)),exp(`lymax.(Intercept)`+lymax.gb)/(1+x[101:200]/exp(lhalf))) all(p1==c(p2A,p2B)) ## simulate(fit3) } \keyword{methods} bbmle/TODO0000754000176200001440000000753513571753013012044 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/DESCRIPTION0000644000176200001440000000241713616005502013043 0ustar liggesusersPackage: bbmle Title: Tools for General Maximum Likelihood Estimation Description: Methods and functions for fitting maximum likelihood models in R. Version: 1.0.23.1 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 Description: Methods and functions for fitting maximum likelihood models in R. This package modifies and extends the 'mle' classes in the 'stats4' package. License: GPL 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' RoxygenNote: 6.1.1 Encoding: UTF-8 NeedsCompilation: no Packaged: 2020-02-02 20:39:22 UTC; bolker Author: Ben Bolker [aut, cre], R Development Core Team [aut], Iago Giné-Vázquez [ctb] Maintainer: Ben Bolker Repository: CRAN Date/Publication: 2020-02-03 12:00:02 UTC bbmle/build/0000755000176200001440000000000013615631572012443 5ustar liggesusersbbmle/build/vignette.rds0000644000176200001440000000044113615631572015001 0ustar liggesusersmPMO0 ֮JHH#7Ę$45kR(Wt9~[B` !s| R+1IFowɎ o.p4%fL&8qY.P5况(UC(m揔N:*_CZ/]o(ǝ(`{ː <-A2m9|V]H~s80-6#$ÙTgF+Y@:a98`* a"-ťSu iùL1y2bi^<#bbmle/tests/0000755000176200001440000000000013615631572012506 5ustar liggesusersbbmle/tests/mortanal.Rout.save0000644000176200001440000001502413013175522016123 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(bbmle) > > ## goby data in dump format > > x <- structure(list(indiv = structure(as.integer(c(20, 77, 79, 21, + 33, 40, 11, 28, 43, 85, 56, 49, 29, 37, 57, 36, 66, 65, 19, 69, + 47, 60, 23, 25, 39, 84, 12, 5, 76, 55, 32, 10, 75, 4, 78, 80, + 86, 48, 54, 22, 18, 61, 41, 74, 68, 14, 53, 45, 30, 17, 62, 3, + 7, 50, 34, 82, 8, 70, 38, 52, 2, 63, 81, 15, 44, 58, 13, 26, + 73, 83, 59, 42, 72, 67, 35, 16, 1, 46, 27, 64, 51, 24, 71, 6, + 9, 31)), .Label = c("f10al1", "f10al2", "f10al3", "f10r1", "f10r2", + "f11al1", "f11al2", "f11al3", "f11al4", "f11r1", "f11r2", "f11r3", + "f12al1", "f12al2", "f12al3", "f12al4", "f12al5", "f12r1", "f12r2", + "f12r3", "f12r4", "f12r5", "f12r6", "f13al1", "f13r1", "f14al1", + "f14al2", "f14r1", "f14r2", "f15al1", "f15al2", "f15r1", "f15r2", + "f18al1", "f18al2", "f18r1", "f18r2", "f19al1", "f19r1", "f19r2", + "f1al1", "f1al2", "f1r1", "f20al1", "f20al2", "f20al3", "f20r1", + "f20r2", "f20r3", "f2al1", "f2al2", "f2al3", "f2al4", "f2r1", + "f2r2", "f2r3", "f2r4", "f3al1", "f3al2", "f3r1", "f3r2", "f4al1", + "f5al1", "f5al2", "f5r1", "f5r2", "f6al1", "f6al2", "f6r1", "f7al1", + "f7al2", "f7al3", "f7al4", "f7al5", "f7r1", "f7r2", "f7r3", "f7r4", + "f7r5", "f7r6", "f9al1", "f9al2", "f9al4", "f9r1", "f9r2", "f9r3" + ), class = "factor"), group = structure(as.integer(c(5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)), .Label = c("AL", + "AL-Rat5th", "AL-RatOv", "R", "R-ALat5th"), class = "factor"), + lifespan = as.integer(c(391, 370, 346, 341, 334, 320, 319, + 317, 314, 307, 295, 260, 30, 10, 397, 380, 364, 355, 352, + 341, 340, 339, 336, 320, 314, 312, 308, 302, 296, 290, 284, + 267, 263, 263, 255, 253, 242, 222, 220, 181, 64, 36, 192, + 192, 189, 186, 183, 181, 180, 176, 173, 171, 170, 169, 166, + 11, 247, 235, 234, 233, 232, 224, 221, 220, 215, 210, 210, + 204, 202, 17, 13, 301, 300, 296, 281, 271, 253, 250, 241, + 239, 232, 221, 220, 214, 33, 30))), .Names = c("indiv", "group", + "lifespan"), class = "data.frame", row.names = c("1", "2", "3", + "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", + "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", + "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", + "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", + "49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", + "60", "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", + "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", + "82", "83", "84", "85", "86")) > > mlife <- log(mean(x$lifespan)) > Bm0w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), + start=list(llambda=mlife,alpha=1), + data=x) > Bm1w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), + start=list(llambda=mlife,alpha=1), + parameters=list(llambda~group), + data=x) Warning message: In dweibull(x = c(391L, 370L, 346L, 341L, 334L, 320L, 319L, 317L, : NaNs produced > Bm2w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), + start=list(llambda=mlife,alpha=1), + parameters=list(llambda~group,alpha~group), + data=x) Warning messages: 1: In dweibull(x = c(391L, 370L, 346L, 341L, 334L, 320L, 319L, 317L, : NaNs produced 2: In dweibull(x = c(391L, 370L, 346L, 341L, 334L, 320L, 319L, 317L, : NaNs produced > Bm3w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), + start=list(llambda=mlife,alpha=3), + parameters=list(alpha~group), + data=x) Warning messages: 1: In dweibull(x = c(391L, 370L, 346L, 341L, 334L, 320L, 319L, 317L, : NaNs produced 2: In dweibull(x = c(391L, 370L, 346L, 341L, 334L, 320L, 319L, 317L, : NaNs produced 3: In dweibull(x = c(391L, 370L, 346L, 341L, 334L, 320L, 319L, 317L, : NaNs produced 4: In dweibull(x = c(391L, 370L, 346L, 341L, 334L, 320L, 319L, 317L, : NaNs produced > anova(Bm0w,Bm1w) Likelihood Ratio Tests Model 1: Bm0w, lifespan~dweibull(scale=exp(llambda),shape=alpha) Model 2: Bm1w, lifespan~dweibull(scale=exp(llambda),shape=alpha): llambda~group Tot Df Deviance Chisq Df Pr(>Chisq) 1 2 1043.5 2 6 1015.5 27.945 4 1.28e-05 *** --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 > anova(Bm0w,Bm1w,Bm2w) Likelihood Ratio Tests Model 1: Bm0w, lifespan~dweibull(scale=exp(llambda),shape=alpha) Model 2: Bm1w, lifespan~dweibull(scale=exp(llambda),shape=alpha): llambda~group Model 3: Bm2w, lifespan~dweibull(scale=exp(llambda),shape=alpha): llambda~group, alpha~group Tot Df Deviance Chisq Df Pr(>Chisq) 1 2 1043.5 2 6 1015.5 27.945 4 1.28e-05 *** 3 10 1008.8 6.736 4 0.1505 --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 > anova(Bm0w,Bm3w,Bm2w) Likelihood Ratio Tests Model 1: Bm0w, lifespan~dweibull(scale=exp(llambda),shape=alpha) Model 2: Bm3w, lifespan~dweibull(scale=exp(llambda),shape=alpha): alpha~group Model 3: Bm2w, lifespan~dweibull(scale=exp(llambda),shape=alpha): llambda~group, alpha~group Tot Df Deviance Chisq Df Pr(>Chisq) 1 2 1043.5 2 6 1038.5 4.9434 4 0.2932 3 10 1008.8 29.7377 4 5.535e-06 *** --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 > AICctab(Bm0w,Bm1w,Bm2w,Bm3w,sort=TRUE,nobs=nrow(x),delta=TRUE) dAICc df Bm1w 0.0 6 Bm2w 3.1 10 Bm0w 19.0 2 Bm3w 23.0 6 > > > proc.time() user system elapsed 1.600 1.164 2.632 bbmle/tests/gradient_vecpar_profile.R0000644000176200001440000000252313076270431017502 0ustar liggesuserslibrary(bbmle) ## Simulate data set.seed(1) x <- 1:5 y <- 2*x+1 noise <- rnorm(5, 0, 0.1) mydata <- data.frame(x = x, y=y+noise) ## Model definition model <- function(a, b) with(mydata, a*x+b) ## Negative log-likelihood nll <- function(par) with(mydata, { a <- par[1] b <- par[2] sum(0.5*((y-model(a,b))/0.1)^2) }) gr <- function(par) with(mydata, { a <- par[1] b <- par[2] dnllda <- -sum(((y-model(a,b))/0.1)*x/0.1) dnlldb <- -sum(((y-model(a,b))/0.1)*1/0.1) return(c(dnllda, dnlldb)) }) ## optimization parnames(nll) <- c("a", "b") parnames(gr) <- c("a", "b") fit <- mle2(nll, c(a = 1, b=2), gr=gr) myprof <- profile(fit) myprof_c <- profile(fit,continuation="naive") confint(myprof) confint(myprof_c) fit <- mle2(nll, c(a = 1, b=2), gr=gr, skip.hessian=TRUE) myprof2 <- profile(fit,std.err=c(0.1,0.1)) ## incomplete! model2 <- ~a+b*x+c*x^2 f0 <- deriv(model2,"x",function.arg=c("a","b","c")) ## chain rule f1 <- function() { ## memoize lastpar <- NULL lastval <- NULL } f2 <- function(par) { if (par==lastpar) { return(c(lastval)) } lastpar <<- par lastval <<- do.call(f0,par) f1(par) } f2.gr <- function(par) { if (par==lastpar) { return(attr(lastval,".grad")) } lastpar <<- par lastval <<- do.call(f0,par) f1.gr(par) } parnames(f2) <- parnames(f2.gr) <- c("a","b","c") bbmle/tests/boundstest.R0000644000176200001440000000064613013175513015017 0ustar liggesusers## logic for removing/modifying bounds: ## (1) unbounded opt. will have limits of -Inf/Inf ## [or missing()] ## (2) bounded opt ## fix length mismatch errors! k <- 19 N <- 20 uniboundtest <- function() { m1 <- mle2(k~dbinom(size=N,prob=p), start=list(p=0.5)) m1b <- mle2(k~dbinom(size=N,prob=p), start=list(p=0.5),method="L-BFGS-B",upper=0.999) p1 <- profile(m1) p1b <- profile(m1b) } bbmle/tests/binomtest1.R0000644000176200001440000000212413013175522014703 0ustar liggesuserslibrary(bbmle) funcresp <- structure(list(Initial = as.integer(c(5, 5, 10, 10, 15, 15, 20, 20, 30, 30, 50, 50, 75, 75, 100, 100)), Killed = as.integer(c(1, 2, 5, 6, 10, 9, 7, 10, 11, 15, 5, 21, 32, 18, 25, 35))), .Names = c("Initial", "Killed"), class = "data.frame", row.names = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16")) binomNLL2 = function(p) { a = p[1] h = p[2] ## cat(a,h,"\n") p = a/(1+a*h*N) -sum(dbinom(k,prob=p,size=N,log=TRUE)) } N=0; k=0 parnames(binomNLL2) = c("a","h") m2a = mle2(binomNLL2,start=c(a=0.5,h=0.0125), data=with(funcresp,list(N=Initial,k=Killed))) p1a = profile(m2a) c2a = print(confint(p1a),digits=3) binomNLL2b = function(p,N,k) { a = p[1] h = p[2] ## cat(a,h,"\n") p = a/(1+a*h*N) -sum(dbinom(k,prob=p,size=N,log=TRUE)) } parnames(binomNLL2b) = c("a","h") m2b = mle2(binomNLL2,start=c(a=0.5,h=0.0125), data=with(funcresp,list(N=Initial,k=Killed))) c2b = confint(m2b) N=funcresp$Initial; k=funcresp$Killed m2c = mle2(binomNLL2,start=c(a=0.5,h=0.0125)) c2c = confint(m2c) print(c2c,digits=3) bbmle/tests/test-relist1.Rout.save0000644000176200001440000000235113013175522016645 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(bbmle) > set.seed(1001) > f <- factor(rep(1:3,each=50)) > kvals <- c(1,2,5) > muvals <- c(10,2,5) > y <- rnbinom(length(f),size=kvals[f],mu=muvals[f]) > plot(y) > > NLL <- function(p) { + kvals <- p[1:3] + muvals <- p[4:6] + -sum(dnbinom(y,size=kvals[f],mu=muvals[f],log=TRUE)) + } > parnames(NLL) <- c("k1","k2","k3","mu1","mu2","mu3") > svec <- c(kvals,muvals) > names(svec) <- parnames(NLL) > m1 <- mle2(NLL,start=svec,vecpar=TRUE) > > proc.time() user system elapsed 0.988 1.116 1.990 bbmle/tests/methods.R0000644000176200001440000000125413013175522014264 0ustar liggesuserslibrary(bbmle) x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) LL <- function(ymax=15, xhalf=6) -sum(stats::dpois(y, lambda=ymax/(1+x/xhalf), log=TRUE)) options(digits=3) mfit0 <- mle2(y~dpois(lambda=exp(interc)), start=list(interc=log(mean(y))),data=d) mfit1 <- mle2(y~dpois(lambda=exp(loglambda)), start=list(loglambda=log(mean(y))),data=d) coef(mfit0) residuals(mfit0) AIC(mfit0) BIC(mfit0) vcov(mfit0) ## fitted(mfit0) ## fails, looks for default value predict(mfit0) ## FIXME: doesn't expand properly (need implicit lambda~1 formula??) set.seed(1001) simulate(mfit0) anova(mfit0,mfit1) summary(mfit0) summary(mfit1) bbmle/tests/testderiv.Rout.save0000644000176200001440000000576713013175522016334 0ustar liggesusers R Under development (unstable) (2012-12-14 r61321) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(bbmle) Loading required package: stats4 > old_opt <- options(digits=3) > ## source("../R/dists.R") > ## source("../R/mle.R") > > ## an attempt to sketch out by hand > ## how one would derive an analytic > ## gradient function for a formula-specified > ## likelihood and use it ... > > ## chain rule should be: > > ## deriv(probability distribution)/[prob params] * > ## deriv([prob params])/[model params] * > ## {OPTIONAL} deriv([model params])/[linear model params] > > set.seed(1001) > x <- rbinom(50,size=10,prob=0.4) > suppressWarnings(mle2(x~dbinom(prob=p,size=10),start=list(p=0.3),data=data.frame(x))) Call: mle2(minuslogl = x ~ dbinom(prob = p, size = 10), start = list(p = 0.3), data = data.frame(x)) Coefficients: p 0.396 Log-likelihood: -97.2 > > ## step 1: construct gradient function for simplest example > f <- sbinom(prob=0.1,size=1)$formula > > d1 <- deriv(parse(text=f),"prob",function.arg=TRUE) > > ## step 2: chain rule step #1 > mle2(x~dbinom(prob=plogis(logitp),size=10),start=list(logitp=-1), + data=data.frame(x)) Call: mle2(minuslogl = x ~ dbinom(prob = plogis(logitp), size = 10), start = list(logitp = -1), data = data.frame(x)) Coefficients: logitp -0.422 Log-likelihood: -97.2 > > f <- sbinom(prob=NA,size=NA)$formula > > ## note: plogis is not in derivatives table!! > ## will need to extend by text substitution ... > gsub("plogis(\\([^)]+\\))", + "(1+exp(\\1))^(-1)", + "plogis(logitprob)") [1] "(1+exp((logitprob)))^(-1)" > > f2 <- gsub("plogis(\\([^)]+\\))", + "(1+exp(\\1))^(-1)","plogis(logitp)") > > ## start with a single parameter (ignore 'size') > fun1 <- deriv(parse(text=f),c("prob"),function.arg=TRUE) > fun2 <- deriv(parse(text=f2),"logitp", function.arg=TRUE) > > size <- 10 > a1 <- attr(fun2(logitp=0),"gradient") > a2 <- attr(fun1(prob=plogis(0)),"gradient") > > ## compute gradient by variable and sum > colSums(apply(a1,2,"*",a2)) logitp 52 > ## rep(a1,length(x))*a2 > > > ## eventually we will want to do something tricky to > ## 'memoise' results because optim() requires the > ## objective function and gradient to be computed > ## *separately*. Not worth worrying about this in the > ## first pass! > options(old_opt) > > proc.time() user system elapsed 0.640 1.272 1.801 bbmle/tests/testbounds.R0000644000176200001440000000064013013175522015011 0ustar liggesusersx <- runif(10) y <- 1+x+rnorm(10,sd=0.1) d <- data.frame(x,y) library(bbmle) m1 <- mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)),data=d) m2 <- mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), method="L-BFGS-B",lower=c(a=0,b=0,s=-Inf),data=d) m2F <- mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), method="L-BFGS-B",lower=c(a=0,b=0,s=-Inf), fixed=list(a=1),data=d) bbmle/tests/update.R0000644000176200001440000000063613013175522014106 0ustar liggesuserslibrary(bbmle) x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) oldopts <- options(warn=-1,digits=3) ## ignore warnings m1 <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), start=list(ymax=1,xhalf=1),data=d) m1 y2 <- c(26, 17, 10, 15, 20, 5, 9, 8, 5, 4, 8) d2 <- data.frame(x,y=y2) m2 <- update(m1,data=d2) m2 m3 <- update(m1,.~dpois(lambda=c),start=list(c=5)) m3 options(oldopts) bbmle/tests/optimize.Rout.save0000644000176200001440000000362413502535331016152 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.save0000644000176200001440000000351713013175522015744 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(bbmle) > set.seed(1002) > lymax <- c(0,2) > lhalf <- 0 > x <- runif(200) > g <- factor(rep(c("a","b"),each=100)) > y <- rnbinom(200,mu=exp(lymax[g])/(1+x/exp(lhalf)),size=2) > d <- data.frame(x,g,y) > > fit3 <- mle2(y~dnbinom(mu=exp(lymax)/(1+x/exp(lhalf)),size=exp(logk)), + parameters=list(lymax~g), + start=list(lymax=0,lhalf=0,logk=0),data=d) > > plot(y~x,col=g) > ## true curves > curve(exp(0)/(1+x/exp(0)),add=TRUE) > curve(exp(2)/(1+x/exp(0)),col=2,add=TRUE) > xvec = seq(0,1,length=100) > lines(xvec,predict(fit3,newdata=list(g=factor(rep("a",100),levels=c("a","b")), + x = xvec)),col=1,lty=2) > lines(xvec,predict(fit3,newdata=list(g=factor(rep("b",100),levels=c("a","b")), + x = xvec)),col=2,lty=2) > > p1 = predict(fit3) > ## manual prediction > p2A = + with(as.list(coef(fit3)),exp(`lymax.(Intercept)`)/(1+x[1:100]/exp(lhalf))) > p2B = with(as.list(coef(fit3)),exp(`lymax.(Intercept)`+lymax.gb)/(1+x[101:200]/exp(lhalf))) > p2 = c(p2A,p2B) > all(p1==p2) [1] TRUE > > > > proc.time() user system elapsed 1.004 1.108 1.982 bbmle/tests/startvals.Rout.save0000644000176200001440000000363613013175522016337 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(bbmle) > > ## copied from emdbook > dbetabinom <- function (x, prob, size, theta, shape1, shape2, log = FALSE) + { + if (missing(prob) && !missing(shape1) && !missing(shape2)) { + prob = shape1/(shape1 + shape2) + theta = shape1 + shape2 + } + v <- lchoose(size, x) - lbeta(theta * (1 - prob), theta * + prob) + lbeta(size - x + theta * (1 - prob), x + theta * + prob) + if (log) + v + else exp(v) + } > > ss <- data.frame(taken=c(0,1,2,5),available=c(5,5,5,5), + dist=rep(1,4)) > > SP.bb=mle2(taken~dbetabinom(prob,theta,size=available), + start=list(prob=0.5,theta=1),data=ss) Warning messages: 1: In lbeta(theta * (1 - prob), theta * prob) : NaNs produced 2: In lbeta(size - x + theta * (1 - prob), x + theta * prob) : NaNs produced > SP.bb.dist=mle2(taken~dbetabinom(prob,size=available,theta), + parameters=list(prob~dist-1,theta~dist-1), + start=as.list(coef(SP.bb)),data=ss) > > SP.bb.dist2=mle2(taken~dbetabinom(prob,size=available,theta), + parameters=list(prob~dist - 1,theta~dist - 1), + start=as.list(coef(SP.bb)),data=ss) > > > proc.time() user system elapsed 0.808 1.072 1.743 bbmle/tests/optimizers.R0000644000176200001440000000143713013175522015031 0ustar liggesuserslibrary(bbmle) old_opts <- options(digits=3) x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) suppressWarnings(fits <- lapply(c("optim","nlm","nlminb"), mle2, minuslogl=y~dpois(lambda=ymax/(1+x/xhalf)), start=list(ymax=15,xhalf=6),data=d, method="Nelder-Mead")) ## 'method' is ignored by nlm()/nlminb() sapply(fits,coef) sapply(fits,logLik) (fit2 <- mle2(y~dpois(lambda=25/(1+x/xhalf)), start=list(xhalf=5),data=d, lower=2,upper=8, optimizer="optimize")) ## gives error referring to 'interval' rather than 'upper'/'lower' ## (fit2 <- mle2(y~dpois(lambda=25/(1+x/xhalf)), ## start=list(xhalf=5), ## optimizer="optimize")) options(old_opts) bbmle/tests/optimizers.Rout.save0000644000176200001440000000365113013175522016516 0ustar liggesusers R Under development (unstable) (2013-10-24 r64106) -- "Unsuffered Consequences" Copyright (C) 2013 The R Foundation for Statistical Computing Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(bbmle) Loading required package: stats4 > old_opts <- options(digits=3) > x <- 0:10 > y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) > d <- data.frame(x,y) > suppressWarnings(fits <- lapply(c("optim","nlm","nlminb"), + mle2, + minuslogl=y~dpois(lambda=ymax/(1+x/xhalf)), + start=list(ymax=15,xhalf=6),data=d, + method="Nelder-Mead")) ## 'method' is ignored by nlm()/nlminb() > > sapply(fits,coef) [,1] [,2] [,3] ymax 25.00 25.00 25.00 xhalf 3.06 3.06 3.06 > sapply(fits,logLik) [1] -28.6 -28.6 -28.6 > > (fit2 <- mle2(y~dpois(lambda=25/(1+x/xhalf)), + start=list(xhalf=5),data=d, + lower=2,upper=8, + optimizer="optimize")) Call: mle2(minuslogl = y ~ dpois(lambda = 25/(1 + x/xhalf)), start = list(xhalf = 5), optimizer = "optimize", data = d, lower = 2, upper = 8) Coefficients: xhalf 3.06 Log-likelihood: -28.6 > > ## gives error referring to 'interval' rather than 'upper'/'lower' > ## (fit2 <- mle2(y~dpois(lambda=25/(1+x/xhalf)), > ## start=list(xhalf=5), > ## optimizer="optimize")) > options(old_opts) > > proc.time() user system elapsed 0.788 1.212 2.049 bbmle/tests/order.R0000644000176200001440000000130013013175522013724 0ustar liggesusersset.seed(1001) x <- runif(10) y <- 1000+x+rnorm(10,sd=0.1) d <- data.frame(x,y) library(bbmle) ## warning m1 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=900,b=1,s=log(0.1)), control=list(parscale=c(1000,1,0.1)),data=d) m2 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=900,b=1,s=log(0.1)), control=list(parscale=c(b=1,a=1000,s=0.1)),data=d) m3 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), method="L-BFGS-B",lower=c(a=1100,b=2,s=-Inf),data=d) ## warning m4 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(b=1,a=1200,s=log(0.1)), method="L-BFGS-B",lower=c(2,1100,0.1),data=d) c1 = coef(m3)[c("a","b","s")] c2 = coef(m4)[c("a","b","s")] if (!all(abs(c1-c2)<1e-7)) stop("mismatch") bbmle/tests/prof_spec.R0000644000176200001440000000140613072222350014575 0ustar liggesusers## test whether profiling works when custom optimizer is defined ## inside a function (GH #7) library(bbmle) test <- function(t, X) { likfun <- function(p) { mu <- with(as.list(p), { exp(a+b*t) }) -sum(dpois(X, mu, log=TRUE)) } parnames(likfun) <- c("a", "b") optimfun <- function(par, fn, gr = NULL, ..., method = NULL, lower = -Inf, upper = Inf, control = NULL, hessian = FALSE) { ## cat("using custom optimfun!\n") optim(par, fn=fn, gr=gr, ..., method="BFGS", control=control, hessian=TRUE) } mle2(likfun, start=c(a=1,b=1), optimizer="user", optimfun=optimfun) } f <- test(0:5, round(exp(1:6))) pp <- profile(f,skiperrs=FALSE) stopifnot(inherits(pp,"profile.mle2")) bbmle/tests/predict.R0000644000176200001440000000174113356434656014274 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.R0000644000176200001440000000076013013175522014462 0ustar liggesusers## try to reconstruct error reported by Hofert Jan Marius ## (simpler version) Lfun <- function(x) { (x-5)^2 } library(bbmle) lb <- 6 ## first try with L-BFGS-B and bounds m1 <- mle2(Lfun,start=list(x=7),lower=6,method="L-BFGS-B") coef(m1) p1 <- profile(m1) plot(p1) (c1 <- confint(m1,quietly=TRUE)) ## all OK m2 <- mle2(Lfun,start=list(x=7),optimizer="optimize", lower=lb,upper=10) coef(m2) p2 <- profile(m2) (c2 <- confint(m2)) (c2 <- confint(m2)) plot(p2,show.points=TRUE) bbmle/tests/optimx.Rout.save0000644000176200001440000000302613175476036015642 0ustar liggesusers R Under development (unstable) (2017-10-27 r73634) -- "Unsuffered Consequences" Copyright (C) 2017 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(bbmle) Loading required package: stats4 > old_opt <- options(digits=3) > if (require(optimx)) { + x <- 0:10 + y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) + d <- data.frame(x,y) + + ## breaks, don't try this + ## optimx(fn=Lfn,par=c(15,6),method="Rvmmin") + + suppressWarnings(m1 <- mle2(minuslogl=y~dpois(lambda=ymax/(1+x/xhalf)), + start=list(ymax=15,xhalf=6),data=d, + optimizer="optimx", + method=c("BFGS","Nelder-Mead","CG"))) + + ## FIXME!! fails (although not with an error, because + ## errors are caught by profiling) due to npar now + ## being restricted to >1 in optimx 2012.05.24 ... + + suppressWarnings(head(as.data.frame(profile(m1)))) + detach("package:optimx") + } Loading required package: optimx > options(old_opt) > > proc.time() user system elapsed 5.852 0.188 13.617 bbmle/tests/glmcomp.R0000644000176200001440000000160613013175522014260 0ustar liggesuserslibrary(bbmle) library(testthat) x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) LL <- function(ymax=15, xhalf=6) -sum(stats::dpois(y, lambda=ymax/(1+x/xhalf), log=TRUE)) mfit0 <- mle2(y~dpois(lambda=exp(interc)), start=list(interc=log(mean(y))),data=d) mfit1 <- mle2(y~dpois(lambda=exp(loglambda)), start=list(loglambda=log(mean(y))),data=d) gfit0 <- glm(y~1,family=poisson) expect_equal(unname(coef(mfit0)),unname(coef(gfit0))) expect_equal(logLik(mfit0),logLik(gfit0)) expect_equal(predict(mfit0), ## only one value for now unique(predict(gfit0,type="response"))) ## FIXME: residuals are backwards expect_equal(residuals(mfit0,type="response"),unname(residuals(gfit0,type="response"))) ## FIXME: residuals are backwards expect_equal(residuals(mfit0,type="pearson"),unname(residuals(gfit0,type="pearson"))) bbmle/tests/testparpred.Rout.save0000644000176200001440000000274013013175522016644 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## set up a data frame for prediction > > set.seed(1001) > f = factor(rep(letters[1:4],each=20)) > x = runif(80) > u = rnorm(4) > y = rnorm(80,mean=2+x*(3+u[f]),sd=0.1) > dat = data.frame(f,x,y) > > ## fit a model ... could easily do by lm() but want to > ## demonstrate the problem > > library(bbmle) > m1 = mle2(y~dnorm(a+b*x,sd=exp(logs)),parameters=list(b~f),data=dat, + start=list(a=0,b=2,logs=-3)) > > ## data frame for prediction > pp0 = expand.grid(x=seq(0,1,length=11), + f=levels(dat$f)) > > ## combine frame and model data: have to keep the model data > ## around, because it contain other information needed for > ## prediction. > > nrow(predict(m1,pp0)) [1] 44 > > > > > proc.time() user system elapsed 1.112 1.036 2.007 bbmle/tests/tmptest.R0000644000176200001440000000042313013175522014316 0ustar liggesuserslibrary(bbmle) d <- data.frame(x=0:10, y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) maxit <- 1000 mle2(y~dpois(lambda=exp(lymax)/(1+x/exp(lhalf))), start=list(lymax=0,lhalf=0), data=d, control=list(maxit=maxit), parameters=list(lymax~1,lhalf~1)) bbmle/tests/grtest1.Rout.save0000644000176200001440000000243713071425264015710 0ustar liggesusers R Under development (unstable) (2017-02-13 r72168) -- "Unsuffered Consequences" Copyright (C) 2017 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## from Eric Weese > library(bbmle) Loading required package: stats4 > f <- function(x=2,a=1) x^2 - a > f.g <- function(x,a) 2*x > f.g2 <- function(x,a) c(2*x,0) > options(digits=3) > m1 <- mle2(f,fixed=list(a=1)) > m2 <- mle2(f,gr=f.g,fixed=list(a=1)) > m3 <- mle2(f,gr=f.g2,fixed=list(a=1)) > stopifnot(all.equal(coef(m1),coef(m2))) > stopifnot(all.equal(coef(m1),coef(m3))) > tt <- function(x) x@details$hessian > stopifnot(all.equal(tt(m1),tt(m2),tolerance=1e-6)) > stopifnot(all.equal(tt(m1),tt(m3),tolerance=1e-6)) > > proc.time() user system elapsed 1.992 0.128 2.122 bbmle/tests/grtest1.R0000644000176200001440000000071613050623125014212 0ustar liggesusers## from Eric Weese library(bbmle) f <- function(x=2,a=1) x^2 - a f.g <- function(x,a) 2*x f.g2 <- function(x,a) c(2*x,0) options(digits=3) m1 <- mle2(f,fixed=list(a=1)) m2 <- mle2(f,gr=f.g,fixed=list(a=1)) m3 <- mle2(f,gr=f.g2,fixed=list(a=1)) stopifnot(all.equal(coef(m1),coef(m2))) stopifnot(all.equal(coef(m1),coef(m3))) tt <- function(x) x@details$hessian stopifnot(all.equal(tt(m1),tt(m2),tolerance=1e-6)) stopifnot(all.equal(tt(m1),tt(m3),tolerance=1e-6)) bbmle/tests/tmptest.Rout.save0000644000176200001440000000255013013175522016006 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(bbmle) > d <- data.frame(x=0:10, + y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) > > maxit <- 1000 > mle2(y~dpois(lambda=exp(lymax)/(1+x/exp(lhalf))), + start=list(lymax=0,lhalf=0), + data=d, + control=list(maxit=maxit), + parameters=list(lymax~1,lhalf~1)) Call: mle2(minuslogl = y ~ dpois(lambda = exp(lymax)/(1 + x/exp(lhalf))), start = list(lymax = 0, lhalf = 0), data = d, parameters = list(lymax ~ 1, lhalf ~ 1), control = list(maxit = maxit)) Coefficients: lymax lhalf 3.218853 1.117035 Log-likelihood: -28.6 > > proc.time() user system elapsed 0.708 1.004 1.572 bbmle/tests/binomtest1.Rout.save0000644000176200001440000000444013013175522016373 0ustar liggesusers R Under development (unstable) (2012-12-14 r61321) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(bbmle) Loading required package: stats4 > > funcresp <- + structure(list(Initial = as.integer(c(5, 5, 10, 10, 15, 15, 20, + 20, 30, 30, 50, 50, 75, 75, 100, 100)), Killed = as.integer(c(1, + 2, 5, 6, 10, 9, 7, 10, 11, 15, 5, 21, 32, 18, 25, 35))), .Names = c("Initial", + "Killed"), class = "data.frame", row.names = c("1", "2", "3", + "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", + "16")) > > binomNLL2 = function(p) { + a = p[1] + h = p[2] + ## cat(a,h,"\n") + p = a/(1+a*h*N) + -sum(dbinom(k,prob=p,size=N,log=TRUE)) + } > > N=0; k=0 > parnames(binomNLL2) = c("a","h") > m2a = mle2(binomNLL2,start=c(a=0.5,h=0.0125), + data=with(funcresp,list(N=Initial,k=Killed))) > p1a = profile(m2a) There were 50 or more warnings (use warnings() to see the first 50) > c2a = print(confint(p1a),digits=3) 2.5 % 97.5 % a 0.40250 0.6825 h 0.00699 0.0264 > > binomNLL2b = function(p,N,k) { + a = p[1] + h = p[2] + ## cat(a,h,"\n") + p = a/(1+a*h*N) + -sum(dbinom(k,prob=p,size=N,log=TRUE)) + } > parnames(binomNLL2b) = c("a","h") > m2b = mle2(binomNLL2,start=c(a=0.5,h=0.0125), + data=with(funcresp,list(N=Initial,k=Killed))) > c2b = confint(m2b) There were 50 or more warnings (use warnings() to see the first 50) > > N=funcresp$Initial; k=funcresp$Killed > m2c = mle2(binomNLL2,start=c(a=0.5,h=0.0125)) > c2c = confint(m2c) There were 50 or more warnings (use warnings() to see the first 50) > print(c2c,digits=3) 2.5 % 97.5 % a 0.40250 0.6825 h 0.00699 0.0264 > > > proc.time() user system elapsed 2.332 0.972 3.180 bbmle/tests/makesavefiles0000644000176200001440000000014613013175522015237 0ustar liggesusersfor i in `echo *.R | sed -e "s/\.R//g"`; do R CMD BATCH --vanilla $i.R; mv $i.Rout $i.Rout.save; done bbmle/tests/mortanal.R0000644000176200001440000000674013013175522014443 0ustar liggesuserslibrary(bbmle) ## goby data in dump format x <- structure(list(indiv = structure(as.integer(c(20, 77, 79, 21, 33, 40, 11, 28, 43, 85, 56, 49, 29, 37, 57, 36, 66, 65, 19, 69, 47, 60, 23, 25, 39, 84, 12, 5, 76, 55, 32, 10, 75, 4, 78, 80, 86, 48, 54, 22, 18, 61, 41, 74, 68, 14, 53, 45, 30, 17, 62, 3, 7, 50, 34, 82, 8, 70, 38, 52, 2, 63, 81, 15, 44, 58, 13, 26, 73, 83, 59, 42, 72, 67, 35, 16, 1, 46, 27, 64, 51, 24, 71, 6, 9, 31)), .Label = c("f10al1", "f10al2", "f10al3", "f10r1", "f10r2", "f11al1", "f11al2", "f11al3", "f11al4", "f11r1", "f11r2", "f11r3", "f12al1", "f12al2", "f12al3", "f12al4", "f12al5", "f12r1", "f12r2", "f12r3", "f12r4", "f12r5", "f12r6", "f13al1", "f13r1", "f14al1", "f14al2", "f14r1", "f14r2", "f15al1", "f15al2", "f15r1", "f15r2", "f18al1", "f18al2", "f18r1", "f18r2", "f19al1", "f19r1", "f19r2", "f1al1", "f1al2", "f1r1", "f20al1", "f20al2", "f20al3", "f20r1", "f20r2", "f20r3", "f2al1", "f2al2", "f2al3", "f2al4", "f2r1", "f2r2", "f2r3", "f2r4", "f3al1", "f3al2", "f3r1", "f3r2", "f4al1", "f5al1", "f5al2", "f5r1", "f5r2", "f6al1", "f6al2", "f6r1", "f7al1", "f7al2", "f7al3", "f7al4", "f7al5", "f7r1", "f7r2", "f7r3", "f7r4", "f7r5", "f7r6", "f9al1", "f9al2", "f9al4", "f9r1", "f9r2", "f9r3" ), class = "factor"), group = structure(as.integer(c(5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)), .Label = c("AL", "AL-Rat5th", "AL-RatOv", "R", "R-ALat5th"), class = "factor"), lifespan = as.integer(c(391, 370, 346, 341, 334, 320, 319, 317, 314, 307, 295, 260, 30, 10, 397, 380, 364, 355, 352, 341, 340, 339, 336, 320, 314, 312, 308, 302, 296, 290, 284, 267, 263, 263, 255, 253, 242, 222, 220, 181, 64, 36, 192, 192, 189, 186, 183, 181, 180, 176, 173, 171, 170, 169, 166, 11, 247, 235, 234, 233, 232, 224, 221, 220, 215, 210, 210, 204, 202, 17, 13, 301, 300, 296, 281, 271, 253, 250, 241, 239, 232, 221, 220, 214, 33, 30))), .Names = c("indiv", "group", "lifespan"), class = "data.frame", row.names = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", "82", "83", "84", "85", "86")) mlife <- log(mean(x$lifespan)) Bm0w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), start=list(llambda=mlife,alpha=1), data=x) Bm1w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), start=list(llambda=mlife,alpha=1), parameters=list(llambda~group), data=x) Bm2w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), start=list(llambda=mlife,alpha=1), parameters=list(llambda~group,alpha~group), data=x) Bm3w <- mle2(lifespan~dweibull(scale=exp(llambda),shape=alpha), start=list(llambda=mlife,alpha=3), parameters=list(alpha~group), data=x) anova(Bm0w,Bm1w) anova(Bm0w,Bm1w,Bm2w) anova(Bm0w,Bm3w,Bm2w) AICctab(Bm0w,Bm1w,Bm2w,Bm3w,sort=TRUE,nobs=nrow(x),delta=TRUE) bbmle/tests/richards.R0000644000176200001440000000566713076267705014452 0ustar liggesusers## implement richards-incidence (="revised superlogistic") ## with analytic gradients ## from Junling's code: model_richardson <- function(times, theta, N) { x0 = theta[1] lambda = theta[2] K = theta[3] * N alpha = theta[4] return(K/(1+((K/x0)^alpha-1)*exp(-lambda*alpha*times))^(1/alpha)) } ## equivalent model, in terms of sigma and as a symbolic expression Rcum <- expression((sigma*N)/(1+(((sigma*N)/x0)^alpha-1)*exp(-lambda*alpha*times))^(1/alpha)) pnames <- c("x0","lambda","sigma","alpha") ## function to compute gradient (and value), derived by R Rderiv <- deriv(Rcum,pnames, function.arg=c(pnames,"N","times")) ## equivalent (using Rcum): return incidence (incid=TRUE) or cumulative incidence (incid=FALSE) calc_mean <- function(p,times,N,incid=TRUE) { ## this is more 'magic' than I would like it to be ... ## have to create an environment and populate it with the contents of p (and N and times), ## then evaluate the expression in this environment pp <- c(as.list(p),list(times=times,N=N)) ## e0 <- new.env() ## mapply(assign,names(pp),pp,MoreArgs=list(envir=e0)) cumvals <- eval(Rcum,envir=pp) if (incid) diff(cumvals) else cumvals } ## Poisson likelihood function likfun <- function(p,dat,times,N,incid=TRUE) { -sum(dpois(dat,calc_mean(p,times,N,incid=incid),log=TRUE)) } ## deriv of P(x,lambda) = -sum(dpois(x,lambda,log=TRUE)) wrt lambda == sum(1-lambda/x) = N - lambda/(sum(x)) ## deriv of P(x,lambda) wrt p = dP/d(lambda) * d(lambda)/dp ## compute gradient vector gradlikfun <- function(p,dat,times,N,incid=TRUE) { gcall <- do.call(Rderiv,c(as.list(p),list(times=times,N=N))) ## values + gradient matrix lambda <- gcall attr(lambda,"gradient") <- NULL if (incid) lambda <- diff(lambda) gmat <- attr(gcall,"gradient") ## extract gradient if (incid) gmat <- apply(gmat,2,diff) ## differences totderiv <- sweep(gmat,MARGIN=1,(1-dat/lambda),"*") ## apply chain rule (multiply columns of gmat by dP/dlambda) colSums(totderiv) ## deriv of summed likelihood = sum of derivs of likelihod } N <- 1000 p0 <- c(x0=0.1,lambda=1,sigma=0.5,alpha=0.5) t0 <- 1:10 ## deterministic versions of data (cumulative and incidence) dcdat <- model_richardson(t0,p0,N) ddat <- diff(dcdat) plot(t0,dcdat) plot(t0[-1],ddat) set.seed(1001) ddat <- rpois(length(ddat),ddat) likfun(p0,ddat,t0,N) gradlikfun(p0,ddat,t0,N) library(numDeriv) grad(likfun,p0,dat=ddat,times=t0,N=N) ## finite differences ## matches! library(bbmle) parnames(likfun) <- names(p0) m1 <- mle2(likfun,start=p0,gr=gradlikfun,data=list(times=t0,N=N,dat=ddat), vecpar=TRUE) plot(t0[-1],ddat) lines(t0[-1],calc_mean(coef(m1),times=t0,N=N)) if (FALSE) { ## too slow .. pp0 <- profile(m1) pp0C <- profile(m1,continuation="naive") } pp1 <- profile(m1,which="lambda") m0 <- mle2(likfun,start=p0,data=list(times=t0,N=N,dat=ddat), vecpar=TRUE) pp0 <- profile(m0,which="lambda") par(mfrow=c(1,2)) plot(pp1,show.points=TRUE) plot(pp0,show.points=TRUE) bbmle/tests/mkout0000644000176200001440000000006413013175522013556 0ustar liggesusersR CMD BATCH --vanilla $1.R; mv $1.Rout $1.Rout.save bbmle/tests/ICtab.R0000644000176200001440000000145713576553130013621 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.R0000644000176200001440000000037513072037374015156 0ustar liggesuserslibrary(bbmle) x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) ## uses default parameters of LL fit <- mle2(y~dpois(exp(loglam)), data=d, start=list(loglam=0),control=list(maxit=2)) pp <- profile(fit) bbmle/tests/controleval.Rout.save0000644000176200001440000000461613013175522016643 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > require(bbmle) Loading required package: bbmle > mle2a <- function(...) + mle2(...) > > mle2b <- function(...) + mle2a(...) > > ## some data > d <- data.frame(x=0:10,y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) > ym <- mean(d$y) > > ## some fits > > (fit0 <- mle2(y~dpois(lambda=ymean),start=list(ymean=ym),data=d)) # okay Call: mle2(minuslogl = y ~ dpois(lambda = ymean), start = list(ymean = ym), data = d) Coefficients: ymean 11.54545 Log-likelihood: -42.73 > predict(fit0) [1] 11.54545 > (fit0.2 <- mle2(y~dpois(lambda=ymean),start=list(ymean=ym),data=d, + control=list(parscale=2))) # okay Call: mle2(minuslogl = y ~ dpois(lambda = ymean), start = list(ymean = ym), data = d, control = list(parscale = 2)) Coefficients: ymean 11.54545 Log-likelihood: -42.73 > predict(fit0.2) [1] 11.54545 > (fit1 <- mle2a(y~dpois(lambda=ymean),start=list(ymean=ym),data=d)) # okay Call: mle2(minuslogl = ..1, start = ..2, data = ..3) Coefficients: ymean 11.54545 Log-likelihood: -42.73 > (fit1.2 <- mle2a(y~dpois(lambda=ymean),start=list(ymean=ym),data=d, + control=list(parscale=2))) # FAILS Call: mle2(minuslogl = ..1, start = ..2, data = ..3, control = ..4) Coefficients: ymean 11.54545 Log-likelihood: -42.73 > (fit1.3 <- mle2b(y~dpois(lambda=ymean),start=list(ymean=ym),data=d, + control=list(parscale=2))) # FAILS Call: mle2(minuslogl = ..1, start = ..2, data = ..3, control = ..4) Coefficients: ymean 11.54545 Log-likelihood: -42.73 > > ### NOT WORKING: > if (FALSE) { + predict(fit1) + predict(fit1.2) + predict(fit1.3) + } > > proc.time() user system elapsed 0.736 1.076 1.638 bbmle/tests/testderiv.R0000644000176200001440000000327013013175522014632 0ustar liggesuserslibrary(bbmle) old_opt <- options(digits=3) ## source("../R/dists.R") ## source("../R/mle.R") ## an attempt to sketch out by hand ## how one would derive an analytic ## gradient function for a formula-specified ## likelihood and use it ... ## chain rule should be: ## deriv(probability distribution)/[prob params] * ## deriv([prob params])/[model params] * ## {OPTIONAL} deriv([model params])/[linear model params] set.seed(1001) x <- rbinom(50,size=10,prob=0.4) suppressWarnings(mle2(x~dbinom(prob=p,size=10),start=list(p=0.3),data=data.frame(x))) ## step 1: construct gradient function for simplest example f <- sbinom(prob=0.1,size=1)$formula d1 <- deriv(parse(text=f),"prob",function.arg=TRUE) ## step 2: chain rule step #1 mle2(x~dbinom(prob=plogis(logitp),size=10),start=list(logitp=-1), data=data.frame(x)) f <- sbinom(prob=NA,size=NA)$formula ## note: plogis is not in derivatives table!! ## will need to extend by text substitution ... gsub("plogis(\\([^)]+\\))", "(1+exp(\\1))^(-1)", "plogis(logitprob)") f2 <- gsub("plogis(\\([^)]+\\))", "(1+exp(\\1))^(-1)","plogis(logitp)") ## start with a single parameter (ignore 'size') fun1 <- deriv(parse(text=f),c("prob"),function.arg=TRUE) fun2 <- deriv(parse(text=f2),"logitp", function.arg=TRUE) size <- 10 a1 <- attr(fun2(logitp=0),"gradient") a2 <- attr(fun1(prob=plogis(0)),"gradient") ## compute gradient by variable and sum colSums(apply(a1,2,"*",a2)) ## rep(a1,length(x))*a2 ## eventually we will want to do something tricky to ## 'memoise' results because optim() requires the ## objective function and gradient to be computed ## *separately*. Not worth worrying about this in the ## first pass! options(old_opt) bbmle/tests/gradient_vecpar_profile.Rout.save0000644000176200001440000000463013175475557021210 0ustar liggesusers R Under development (unstable) (2017-04-17 r72531) -- "Unsuffered Consequences" Copyright (C) 2017 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(bbmle) Loading required package: stats4 > > ## Simulate data > > set.seed(1) > x <- 1:5 > y <- 2*x+1 > noise <- rnorm(5, 0, 0.1) > mydata <- data.frame(x = x, y=y+noise) > > ## Model definition > > model <- function(a, b) with(mydata, a*x+b) > > ## Negative log-likelihood > > nll <- function(par) with(mydata, { + a <- par[1] + b <- par[2] + sum(0.5*((y-model(a,b))/0.1)^2) + + }) > > gr <- function(par) with(mydata, { + a <- par[1] + b <- par[2] + dnllda <- -sum(((y-model(a,b))/0.1)*x/0.1) + dnlldb <- -sum(((y-model(a,b))/0.1)*1/0.1) + return(c(dnllda, dnlldb)) + }) > > ## optimization > > parnames(nll) <- c("a", "b") > parnames(gr) <- c("a", "b") > > fit <- mle2(nll, c(a = 1, b=2), gr=gr) > > myprof <- profile(fit) > myprof_c <- profile(fit,continuation="naive") > confint(myprof) 2.5 % 97.5 % a 1.9712561 2.095215 b 0.7076574 1.118783 > confint(myprof_c) 2.5 % 97.5 % a 1.9712561 2.095215 b 0.7076574 1.118783 > > fit <- mle2(nll, c(a = 1, b=2), gr=gr, skip.hessian=TRUE) > myprof2 <- profile(fit,std.err=c(0.1,0.1)) > > ## incomplete! > model2 <- ~a+b*x+c*x^2 > f0 <- deriv(model2,"x",function.arg=c("a","b","c")) > ## chain rule > f1 <- function() { + ## memoize + lastpar <- NULL + lastval <- NULL + } > > f2 <- function(par) { + if (par==lastpar) { + return(c(lastval)) + } + lastpar <<- par + lastval <<- do.call(f0,par) + f1(par) + } > f2.gr <- function(par) { + if (par==lastpar) { + return(attr(lastval,".grad")) + } + lastpar <<- par + lastval <<- do.call(f0,par) + f1.gr(par) + } > parnames(f2) <- parnames(f2.gr) <- c("a","b","c") > > proc.time() user system elapsed 1.844 0.128 3.349 bbmle/tests/testbounds.Rout.save0000644000176200001440000000334613013175522016504 0ustar liggesusers R Under development (unstable) (2012-12-14 r61321) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > x <- runif(10) > y <- 1+x+rnorm(10,sd=0.1) > d <- data.frame(x,y) > > library(bbmle) Loading required package: stats4 > m1 <- mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)),data=d) > > m2 <- mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), + method="L-BFGS-B",lower=c(a=0,b=0,s=-Inf),data=d) > > m2F <- mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), + method="L-BFGS-B",lower=c(a=0,b=0,s=-Inf), + fixed=list(a=1),data=d) Warning messages: 1: In mle2(y ~ dnorm(a + b * x, sd = exp(s)), start = list(a = 1, b = 1, : length mismatch between lower/upper and number of non-fixed parameters: # lower=3, # upper=0, # non-fixed=2 2: In oout$par == call$lower : longer object length is not a multiple of shorter object length 3: In mle2(y ~ dnorm(a + b * x, sd = exp(s)), start = list(a = 1, b = 1, : some parameters are on the boundary: variance-covariance calculations based on Hessian may be unreliable > > > proc.time() user system elapsed 0.820 1.052 1.857 bbmle/tests/startvals2.Rout.save0000644000176200001440000003257113013175522016421 0ustar liggesusers R Under development (unstable) (2014-05-14 r65609) -- "Unsuffered Consequences" Copyright (C) 2014 The R Foundation for Statistical Computing Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(bbmle) Loading required package: stats4 > > ## fir data from emdbook package ... > firdata <- structure(list(TOTCONES = c(19, 42, 40, 68, 5, 0, 21, 114, 37, + 92, 84, 102, 98, 63, 9, 31, 35, 216, 27, 297, 36, 127, 23, 46, + 27, 66, 11, 20, 141, 3, 22, 39, 96, 206.5, 40, 231, 63.5, 202, + 54, 32, 107.5, 142.5, 82, 65, 153, 123, 131, 43, 98, 37, 34, + 10, 65, 35, 50, 19, 73, 33, 61, 9, 146, 0, 44, 42, 0, 61, 17, + 53, 27, 0, 74, 36, 28, 56, 46, 0, 15, 26, 46, 15, 105, 0, 62, + 24, 25, 41, 138, 77, 227.7, 28, 45, 57, 109, 28, 17, 91, 69, + 87, 10, 65, 50, 27, 30, 86, 119, 22, 8, 54, 104, 14, 16, 5, 53, + 40, 32, 114, 39, 37, 111, 226, 156, 42, 86, 94, 54, 1, 14, 44, + 108, 116.5, 14, 73, 3, 16, 87, 61, 48, 0, 17, 5, 88, 11, 133, + 121, 166, 171, 63, 23, 4, 51, 10, 14, 78, 47, 31, 42, 24, 42, + 55, 19, 63, 127, 9, 74, 120, 85, 51, 19, 131, 7, 23, 7, 9, 23, + 55, 48, 13, 2, 9, 3, 4, 16, 1, 88, 8, 27, 16, 184, 14, 22, 25, + 52, 2, 134, 81, 85, 3, 56, 17, 8, 10, 6, 69, 58, 1, 22, 3, 11, + 22, 2, 37, 8, 15, 61, 6, 18, 9, 109, 54, 4, 11, 30, 0, 0, 3, + 0, 16, 22, 9, 56, 17, 64, 38, 59, 37, 22, 41, 1, 22, 16, 17, + 4), DBH = c(9.4, 10.6, 7.7, 10.6, 8.7, 10.1, 8.1, 11.6, 10.1, + 13.3, 10, 13.4, 9.7, 7.4, 8.7, 8.6, 7.9, 14.2, 9.5, 15.9, 6, + 10.6, 7.3, 10.3, 8.4, 10.2, 13.8, 9.4, 8.1, 9.6, 7.3, 7.4, 10.3, + 13.4, 9.2, 13.9, 10.9, 17.4, 10.2, 8.2, 11.3, 16.1, 12.3, 8.3, + 12.4, 12.5, 11.3, 7.8, 11.6, 10, 7, 5.7, 7.7, 8.9, 8.5, 8.5, + 10.7, 10.2, 10.8, 9, 9.4, 7.6, 10.6, 10, 8, 7.4, 9.1, 6.7, 9.7, + 6.8, 8.6, 9.1, 6.3, 6.7, 10.9, 9.5, 9.9, 6.8, 9.8, 7.7, 12.1, + 8.2, 10, 9.6, 9.2, 8.2, 11.3, 11.6, 15.7, 9.1, 8.9, 8.7, 11, + 6.6, 7.1, 9, 12.4, 12.1, 7.5, 9, 8, 10.9, 9.2, 10.1, 12.1, 7, + 6.8, 8.6, 11.6, 6.6, 6.7, 6.8, 8.5, 7.8, 7.9, 9.8, 6.2, 6.7, + 15.4, 9.2, 12.9, 6.7, 9.6, 8.4, 8, 8.7, 6.7, 9.2, 9.5, 8, 5.5, + 8.5, 5.7, 5.6, 8, 6.5, 9.6, 6.1, 7.9, 5.9, 11, 8.2, 12.8, 12.8, + 12.5, 13.7, 11.8, 6.3, 6.3, 8.2, 6.2, 6.7, 9.8, 9.4, 6.7, 6, + 4.9, 9.6, 7.5, 8.4, 7.4, 9.9, 7.4, 9.5, 13.9, 6.9, 9.4, 7.4, + 12.8, 5.8, 7.2, 5.6, 6.9, 11.3, 9.6, 6.8, 6.9, 6.6, 4.8, 4.4, + 4.8, 8.5, 7, 8.7, 6.6, 8.6, 5.3, 10.4, 6.4, 5.4, 8.2, 5.5, 6.2, + 14.7, 10.5, 14.4, 5.8, 6.1, 6.2, 6.2, 7.2, 6, 10.6, 8.7, 7.5, + 7.3, 5.2, 6.9, 6.6, 6.7, 5.2, 6.9, 7.5, 9, 5.9, 6.5, 6.6, 9.8, + 4.7, 4.2, 4.8, 6.7, 6.5, 6.7, 5.9, 5.4, 6.9, 6.5, 6, 12, 7.5, + 6.4, 7.3, 7.3, 6.4, 7, 5.9, 9.1, 6.7, 4, 6.5, 4.7), WAVE_NON = structure(c(1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, + 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, + 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, + 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, + 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, + 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, + 2L), .Label = c("n", "w"), class = "factor"), logcones = c(2.99573227355399, + 3.76120011569356, 3.71357206670431, 4.23410650459726, 1.79175946922805, + 0, 3.09104245335832, 4.74493212836325, 3.63758615972639, 4.53259949315326, + 4.44265125649032, 4.63472898822964, 4.59511985013459, 4.15888308335967, + 2.30258509299405, 3.46573590279973, 3.58351893845611, 5.37989735354046, + 3.3322045101752, 5.6970934865054, 3.61091791264422, 4.85203026391962, + 3.17805383034795, 3.85014760171006, 3.3322045101752, 4.20469261939097, + 2.484906649788, 3.04452243772342, 4.95582705760126, 1.38629436111989, + 3.13549421592915, 3.68887945411394, 4.57471097850338, 5.33513133967075, + 3.71357206670431, 5.44673737166631, 4.16666522380173, 5.31320597904179, + 4.00733318523247, 3.49650756146648, 4.68675017298051, 4.96633503519968, + 4.4188406077966, 4.18965474202643, 5.03695260241363, 4.82028156560504, + 4.88280192258637, 3.78418963391826, 4.59511985013459, 3.63758615972639, + 3.55534806148941, 2.39789527279837, 4.18965474202643, 3.58351893845611, + 3.93182563272433, 2.99573227355399, 4.30406509320417, 3.52636052461616, + 4.12713438504509, 2.30258509299405, 4.99043258677874, 0, 3.80666248977032, + 3.76120011569356, 0, 4.12713438504509, 2.89037175789616, 3.98898404656427, + 3.3322045101752, 0, 4.31748811353631, 3.61091791264422, 3.36729582998647, + 4.04305126783455, 3.85014760171006, 0, 2.77258872223978, 3.29583686600433, + 3.85014760171006, 2.77258872223978, 4.66343909411207, 0, 4.14313472639153, + 3.2188758248682, 3.25809653802148, 3.73766961828337, 4.93447393313069, + 4.35670882668959, 5.43241110102874, 3.36729582998647, 3.8286413964891, + 4.06044301054642, 4.70048036579242, 3.36729582998647, 2.89037175789616, + 4.52178857704904, 4.24849524204936, 4.47733681447821, 2.39789527279837, + 4.18965474202643, 3.93182563272433, 3.3322045101752, 3.43398720448515, + 4.46590811865458, 4.78749174278205, 3.13549421592915, 2.19722457733622, + 4.00733318523247, 4.65396035015752, 2.70805020110221, 2.83321334405622, + 1.79175946922805, 3.98898404656427, 3.71357206670431, 3.49650756146648, + 4.74493212836325, 3.68887945411394, 3.63758615972639, 4.71849887129509, + 5.4249500174814, 5.05624580534831, 3.76120011569356, 4.46590811865458, + 4.55387689160054, 4.00733318523247, 0.693147180559945, 2.70805020110221, + 3.80666248977032, 4.69134788222914, 4.76643833358421, 2.70805020110221, + 4.30406509320417, 1.38629436111989, 2.83321334405622, 4.47733681447821, + 4.12713438504509, 3.89182029811063, 0, 2.89037175789616, 1.79175946922805, + 4.48863636973214, 2.484906649788, 4.89783979995091, 4.80402104473326, + 5.11799381241676, 5.14749447681345, 4.15888308335967, 3.17805383034795, + 1.6094379124341, 3.95124371858143, 2.39789527279837, 2.70805020110221, + 4.36944785246702, 3.87120101090789, 3.46573590279973, 3.76120011569356, + 3.2188758248682, 3.76120011569356, 4.02535169073515, 2.99573227355399, + 4.15888308335967, 4.85203026391962, 2.30258509299405, 4.31748811353631, + 4.79579054559674, 4.45434729625351, 3.95124371858143, 2.99573227355399, + 4.88280192258637, 2.07944154167984, 3.17805383034795, 2.07944154167984, + 2.30258509299405, 3.17805383034795, 4.02535169073515, 3.89182029811063, + 2.63905732961526, 1.09861228866811, 2.30258509299405, 1.38629436111989, + 1.6094379124341, 2.83321334405622, 0.693147180559945, 4.48863636973214, + 2.19722457733622, 3.3322045101752, 2.83321334405622, 5.22035582507832, + 2.70805020110221, 3.13549421592915, 3.25809653802148, 3.97029191355212, + 1.09861228866811, 4.90527477843843, 4.40671924726425, 4.45434729625351, + 1.38629436111989, 4.04305126783455, 2.89037175789616, 2.19722457733622, + 2.39789527279837, 1.94591014905531, 4.24849524204936, 4.07753744390572, + 0.693147180559945, 3.13549421592915, 1.38629436111989, 2.484906649788, + 3.13549421592915, 1.09861228866811, 3.63758615972639, 2.19722457733622, + 2.77258872223978, 4.12713438504509, 1.94591014905531, 2.94443897916644, + 2.30258509299405, 4.70048036579242, 4.00733318523247, 1.6094379124341, + 2.484906649788, 3.43398720448515, 0, 0, 1.38629436111989, 0, + 2.83321334405622, 3.13549421592915, 2.30258509299405, 4.04305126783455, + 2.89037175789616, 4.17438726989564, 3.66356164612965, 4.0943445622221, + 3.63758615972639, 3.13549421592915, 3.73766961828337, 0.693147180559945, + 3.13549421592915, 2.83321334405622, 2.89037175789616, 1.6094379124341 + )), .Names = c("TOTCONES", "DBH", "WAVE_NON", "logcones"), row.names = c(1L, + 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, + 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, + 29L, 30L, 31L, 32L, 33L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, + 43L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 52L, 53L, 54L, 55L, + 56L, 58L, 59L, 60L, 61L, 62L, 63L, 64L, 65L, 66L, 67L, 68L, 69L, + 70L, 71L, 72L, 73L, 74L, 75L, 76L, 78L, 79L, 80L, 81L, 82L, 83L, + 84L, 85L, 86L, 87L, 88L, 89L, 90L, 91L, 92L, 93L, 94L, 95L, 96L, + 97L, 98L, 99L, 100L, 101L, 102L, 103L, 104L, 105L, 106L, 107L, + 108L, 109L, 110L, 111L, 112L, 113L, 118L, 119L, 120L, 121L, 122L, + 123L, 124L, 126L, 127L, 128L, 129L, 130L, 131L, 132L, 133L, 134L, + 135L, 136L, 137L, 138L, 139L, 140L, 142L, 144L, 145L, 146L, 147L, + 148L, 149L, 150L, 151L, 154L, 155L, 157L, 159L, 160L, 168L, 169L, + 170L, 171L, 172L, 173L, 174L, 175L, 176L, 177L, 178L, 179L, 180L, + 181L, 184L, 185L, 186L, 187L, 189L, 190L, 193L, 198L, 247L, 272L, + 273L, 275L, 276L, 277L, 278L, 280L, 281L, 282L, 283L, 284L, 285L, + 286L, 287L, 288L, 289L, 290L, 291L, 292L, 293L, 294L, 295L, 296L, + 297L, 298L, 299L, 300L, 301L, 303L, 304L, 305L, 306L, 307L, 308L, + 309L, 310L, 311L, 313L, 314L, 315L, 316L, 319L, 320L, 321L, 322L, + 323L, 325L, 326L, 327L, 330L, 331L, 332L, 337L, 338L, 339L, 340L, + 341L, 342L, 343L, 344L, 345L, 346L, 347L, 348L, 349L, 350L, 351L, + 352L, 353L, 357L, 358L, 360L, 366L), na.action = structure(c(34L, + 57L, 77L, 114L, 115L, 116L, 117L, 125L, 141L, 143L, 152L, 153L, + 156L, 158L, 161L, 162L, 163L, 164L, 165L, 166L, 167L, 182L, 183L, + 188L, 191L, 192L, 194L, 195L, 196L, 197L, 199L, 200L, 201L, 202L, + 203L, 204L, 205L, 206L, 207L, 208L, 209L, 210L, 211L, 212L, 213L, + 214L, 215L, 216L, 217L, 218L, 219L, 220L, 221L, 222L, 223L, 224L, + 225L, 226L, 227L, 228L, 229L, 230L, 231L, 232L, 233L, 234L, 235L, + 236L, 237L, 238L, 239L, 240L, 241L, 242L, 243L, 244L, 245L, 246L, + 248L, 249L, 250L, 251L, 252L, 253L, 254L, 255L, 256L, 257L, 258L, + 259L, 260L, 261L, 262L, 263L, 264L, 265L, 266L, 267L, 268L, 269L, + 270L, 271L, 274L, 279L, 302L, 312L, 317L, 318L, 324L, 328L, 329L, + 333L, 334L, 335L, 336L, 354L, 355L, 356L, 359L, 361L, 362L, 363L, + 364L, 365L, 367L, 368L, 369L, 370L, 371L), .Names = c("34", "57", + "77", "114", "115", "116", "117", "125", "141", "143", "152", + "153", "156", "158", "161", "162", "163", "164", "165", "166", + "167", "182", "183", "188", "191", "192", "194", "195", "196", + "197", "199", "200", "201", "202", "203", "204", "205", "206", + "207", "208", "209", "210", "211", "212", "213", "214", "215", + "216", "217", "218", "219", "220", "221", "222", "223", "224", + "225", "226", "227", "228", "229", "230", "231", "232", "233", + "234", "235", "236", "237", "238", "239", "240", "241", "242", + "243", "244", "245", "246", "248", "249", "250", "251", "252", + "253", "254", "255", "256", "257", "258", "259", "260", "261", + "262", "263", "264", "265", "266", "267", "268", "269", "270", + "271", "274", "279", "302", "312", "317", "318", "324", "328", + "329", "333", "334", "335", "336", "354", "355", "356", "359", + "361", "362", "363", "364", "365", "367", "368", "369", "370", + "371"), class = "omit"), class = "data.frame") > > > m1 <- mle2(logcones ~ dnorm(i + slope*log(DBH), sd), + parameters= list(i ~ WAVE_NON-1, slope ~ WAVE_NON-1), + data = firdata, + start = list(i=c(-2,-2),slope=c(2.5,2.5),sd=1)) Warning message: In calc_mle2_function(minuslogl, parameters, start = start, parnames = parnames, : using dnorm() with sd implicitly set to 1 is rarely sensible > > ancovafun = function(i1,i2,slope1,slope2,sigma) { + int = c(i1,i2)[WAVE_NON] + slope = c(slope1,slope2)[WAVE_NON] + Y.pred = int+ slope*log(DBH) + r <- -sum(dnorm(logcones,mean=Y.pred,sd=sigma,log=TRUE)) + ## cat(i1,i2,slope1,slope2,sigma,r,"\n") + r + } > m2 <- mle2(ancovafun,start=list(i1=-2,i2=-2,slope1=2.5,slope2=2.5,sigma=1), + data=firdata) > > > m3 <- mle2(logcones ~ dnorm(mu, sd), + parameters= list(mu ~ WAVE_NON*log(DBH)), + data = firdata, + start = list(mu=1,sd=1)) Warning messages: 1: In calc_mle2_function(minuslogl, parameters, start = start, parnames = parnames, : using dnorm() with sd implicitly set to 1 is rarely sensible 2: In dnorm(x = c(2.99573227355399, 3.76120011569356, 3.71357206670431, : NaNs produced 3: In dnorm(x = c(2.99573227355399, 3.76120011569356, 3.71357206670431, : NaNs produced 4: In dnorm(x = c(2.99573227355399, 3.76120011569356, 3.71357206670431, : NaNs produced 5: In dnorm(x = c(2.99573227355399, 3.76120011569356, 3.71357206670431, : NaNs produced > > stopifnot(all.equal(AIC(m1),AIC(m2),AIC(m3))) > > ## m4 <- mle2(logcones ~ dnorm(i + slope*log(DBH), sd), > ## parameters= list(i ~ WAVE_NON-1, slope ~ WAVE_NON-1), > ## data = firdata, > ## start = c(-2,-2,2.5,2.5,sd=1)) > > > proc.time() user system elapsed 1.112 1.364 2.438 bbmle/tests/optimx.R0000644000176200001440000000122213160353612014135 0ustar liggesuserslibrary(bbmle) old_opt <- options(digits=3) if (require(optimx)) { x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) ## breaks, don't try this ## optimx(fn=Lfn,par=c(15,6),method="Rvmmin") suppressWarnings(m1 <- mle2(minuslogl=y~dpois(lambda=ymax/(1+x/xhalf)), start=list(ymax=15,xhalf=6),data=d, optimizer="optimx", method=c("BFGS","Nelder-Mead","CG"))) ## FIXME!! fails (although not with an error, because ## errors are caught by profiling) due to npar now ## being restricted to >1 in optimx 2012.05.24 ... suppressWarnings(head(as.data.frame(profile(m1)))) detach("package:optimx") } options(old_opt) bbmle/tests/controleval.R0000644000176200001440000000146113013175522015151 0ustar liggesusersrequire(bbmle) mle2a <- function(...) mle2(...) mle2b <- function(...) mle2a(...) ## some data d <- data.frame(x=0:10,y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) ym <- mean(d$y) ## some fits (fit0 <- mle2(y~dpois(lambda=ymean),start=list(ymean=ym),data=d)) # okay predict(fit0) (fit0.2 <- mle2(y~dpois(lambda=ymean),start=list(ymean=ym),data=d, control=list(parscale=2))) # okay predict(fit0.2) (fit1 <- mle2a(y~dpois(lambda=ymean),start=list(ymean=ym),data=d)) # okay (fit1.2 <- mle2a(y~dpois(lambda=ymean),start=list(ymean=ym),data=d, control=list(parscale=2))) # FAILS (fit1.3 <- mle2b(y~dpois(lambda=ymean),start=list(ymean=ym),data=d, control=list(parscale=2))) # FAILS ### NOT WORKING: if (FALSE) { predict(fit1) predict(fit1.2) predict(fit1.3) } bbmle/tests/richards.Rout.save0000644000176200001440000001154213076267721016122 0ustar liggesusers R Under development (unstable) (2017-04-17 r72531) -- "Unsuffered Consequences" Copyright (C) 2017 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## implement richards-incidence (="revised superlogistic") > ## with analytic gradients > > ## from Junling's code: > model_richardson <- function(times, theta, N) + { + x0 = theta[1] + lambda = theta[2] + K = theta[3] * N + alpha = theta[4] + return(K/(1+((K/x0)^alpha-1)*exp(-lambda*alpha*times))^(1/alpha)) + } > > ## equivalent model, in terms of sigma and as a symbolic expression > Rcum <- expression((sigma*N)/(1+(((sigma*N)/x0)^alpha-1)*exp(-lambda*alpha*times))^(1/alpha)) > > pnames <- c("x0","lambda","sigma","alpha") > > ## function to compute gradient (and value), derived by R > Rderiv <- deriv(Rcum,pnames, function.arg=c(pnames,"N","times")) > > ## equivalent (using Rcum): return incidence (incid=TRUE) or cumulative incidence (incid=FALSE) > calc_mean <- function(p,times,N,incid=TRUE) { + ## this is more 'magic' than I would like it to be ... + ## have to create an environment and populate it with the contents of p (and N and times), + ## then evaluate the expression in this environment + pp <- c(as.list(p),list(times=times,N=N)) + ## e0 <- new.env() + ## mapply(assign,names(pp),pp,MoreArgs=list(envir=e0)) + cumvals <- eval(Rcum,envir=pp) + if (incid) diff(cumvals) else cumvals + } > > ## Poisson likelihood function > likfun <- function(p,dat,times,N,incid=TRUE) { + -sum(dpois(dat,calc_mean(p,times,N,incid=incid),log=TRUE)) + } > > ## deriv of P(x,lambda) = -sum(dpois(x,lambda,log=TRUE)) wrt lambda == sum(1-lambda/x) = N - lambda/(sum(x)) > ## deriv of P(x,lambda) wrt p = dP/d(lambda) * d(lambda)/dp > > ## compute gradient vector > gradlikfun <- function(p,dat,times,N,incid=TRUE) { + gcall <- do.call(Rderiv,c(as.list(p),list(times=times,N=N))) ## values + gradient matrix + lambda <- gcall + attr(lambda,"gradient") <- NULL + if (incid) lambda <- diff(lambda) + gmat <- attr(gcall,"gradient") ## extract gradient + if (incid) gmat <- apply(gmat,2,diff) ## differences + totderiv <- sweep(gmat,MARGIN=1,(1-dat/lambda),"*") ## apply chain rule (multiply columns of gmat by dP/dlambda) + colSums(totderiv) ## deriv of summed likelihood = sum of derivs of likelihod + } > > N <- 1000 > p0 <- c(x0=0.1,lambda=1,sigma=0.5,alpha=0.5) > t0 <- 1:10 > ## deterministic versions of data (cumulative and incidence) > dcdat <- model_richardson(t0,p0,N) > ddat <- diff(dcdat) > > plot(t0,dcdat) > plot(t0[-1],ddat) > > set.seed(1001) > ddat <- rpois(length(ddat),ddat) > > likfun(p0,ddat,t0,N) [1] 22.3544 > gradlikfun(p0,ddat,t0,N) x0 lambda sigma alpha 15.42028 30.95135 19.33690 30.04404 > > library(numDeriv) > grad(likfun,p0,dat=ddat,times=t0,N=N) ## finite differences [1] 15.42028 30.95135 19.33690 30.04404 > ## matches! > > library(bbmle) Loading required package: stats4 > parnames(likfun) <- names(p0) > > > m1 <- mle2(likfun,start=p0,gr=gradlikfun,data=list(times=t0,N=N,dat=ddat), + vecpar=TRUE) Warning messages: 1: In dpois(dat, calc_mean(p, times, N, incid = incid), log = TRUE) : NaNs produced 2: In dpois(dat, calc_mean(p, times, N, incid = incid), log = TRUE) : NaNs produced 3: In dpois(dat, calc_mean(p, times, N, incid = incid), log = TRUE) : NaNs produced > > plot(t0[-1],ddat) > lines(t0[-1],calc_mean(coef(m1),times=t0,N=N)) > > if (FALSE) { + ## too slow .. + pp0 <- profile(m1) + pp0C <- profile(m1,continuation="naive") + } > > pp1 <- profile(m1,which="lambda") There were 50 or more warnings (use warnings() to see the first 50) > > m0 <- mle2(likfun,start=p0,data=list(times=t0,N=N,dat=ddat), + vecpar=TRUE) Warning messages: 1: In dpois(dat, calc_mean(p, times, N, incid = incid), log = TRUE) : NaNs produced 2: In dpois(dat, calc_mean(p, times, N, incid = incid), log = TRUE) : NaNs produced 3: In dpois(dat, calc_mean(p, times, N, incid = incid), log = TRUE) : NaNs produced > > pp0 <- profile(m0,which="lambda") There were 50 or more warnings (use warnings() to see the first 50) > par(mfrow=c(1,2)) > plot(pp1,show.points=TRUE) > plot(pp0,show.points=TRUE) Warning message: In .local(x, ...) : non-monotonic profile: reverting to linear interpolation. Consider setting std.err manually > > proc.time() user system elapsed 7.072 0.628 9.701 bbmle/tests/profbound.Rout.save0000644000176200001440000000402713615631375016320 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 <- suppressWarnings(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.312 0.124 2.654 bbmle/tests/order.Rout.save0000644000176200001440000000420513013175522015420 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > set.seed(1001) > x <- runif(10) > y <- 1000+x+rnorm(10,sd=0.1) > d <- data.frame(x,y) > > library(bbmle) > ## warning > m1 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=900,b=1,s=log(0.1)), + control=list(parscale=c(1000,1,0.1)),data=d) Warning message: In fix_order(call$control$parscale, "parscale") : parscale not named: rearranging to match 'start' > > m2 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=900,b=1,s=log(0.1)), + control=list(parscale=c(b=1,a=1000,s=0.1)),data=d) > > m3 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), + method="L-BFGS-B",lower=c(a=1100,b=2,s=-Inf),data=d) Warning message: In mle2(y ~ dnorm(a + b * x, sd = exp(s)), start = list(a = 1, b = 1, : some parameters are on the boundary: variance-covariance calculations based on Hessian may be unreliable > > ## warning > m4 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(b=1,a=1200,s=log(0.1)), + method="L-BFGS-B",lower=c(2,1100,0.1),data=d) Warning messages: 1: In fix_order(call$lower, "lower bounds", -Inf) : lower bounds not named: rearranging to match 'start' 2: In mle2(y ~ dnorm(a + b * x, sd = exp(s)), start = list(b = 1, a = 1200, : some parameters are on the boundary: variance-covariance calculations based on Hessian may be unreliable > > c1 = coef(m3)[c("a","b","s")] > c2 = coef(m4)[c("a","b","s")] > if (!all(abs(c1-c2)<1e-7)) stop("mismatch") > > proc.time() user system elapsed 1.012 1.024 1.896 bbmle/tests/BIC.R0000644000176200001440000000041213013175522013211 0ustar liggesusersrequire(bbmle) x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) fit <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), start=list(ymax=25,xhalf=3),data=d) fit2 <- mle2(y~dpois(lambda=(x+1)*slope), start=list(slope=1),data=d) BIC(fit) BIC(fit,fit2) bbmle/tests/test-relist1.R0000644000176200001440000000064213013175522015161 0ustar liggesuserslibrary(bbmle) set.seed(1001) f <- factor(rep(1:3,each=50)) kvals <- c(1,2,5) muvals <- c(10,2,5) y <- rnbinom(length(f),size=kvals[f],mu=muvals[f]) plot(y) NLL <- function(p) { kvals <- p[1:3] muvals <- p[4:6] -sum(dnbinom(y,size=kvals[f],mu=muvals[f],log=TRUE)) } parnames(NLL) <- c("k1","k2","k3","mu1","mu2","mu3") svec <- c(kvals,muvals) names(svec) <- parnames(NLL) m1 <- mle2(NLL,start=svec,vecpar=TRUE) bbmle/tests/testenv.R0000644000176200001440000000145213013176345014315 0ustar liggesuserslibrary(bbmle) f <- function() { maxit <- 1000 d <- data.frame(x=0:10, y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) mle2(y~dpois(lambda=exp(lymax)/(1+x/exp(lhalf))), start=list(lymax=0,lhalf=0), data=d, control=list(maxit=maxit), parameters=list(lymax~1,lhalf~1)) } f2 <- function(method="BFGS") { d <- data.frame(x=0:10, y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) mle2(y~dpois(lambda=exp(lymax)/(1+x/exp(lhalf))), start=list(lymax=0,lhalf=0), data=d, method=method, parameters=list(lymax~1,lhalf~1)) } m1 <- f() p <- profile(m1) ## FIXME: check results (need to save in an environment-friendly way!) print(head(as.data.frame(p)),digits=3) m2 <- f2() p2 <- profile(m2) print(head(as.data.frame(p2)),digits=3) bbmle/tests/RUnit-tests.R0000644000176200001440000000052113013175522015016 0ustar liggesusersrequire(RUnit) ## TODO -- find solution to run these tests on R-forge ##testsuite <- defineTestSuite("phylobase", dirs="/home/francois/Work/R-dev/phylobase/branches/fm-branch/RUnit-tests", ## testFileRegexp="^test", testFuncRegexp="^test") ##testRslt <- runTestSuite(testsuite) ##printTextProtocol(testRslt) bbmle/tests/testenv.Rout.save0000644000176200001440000000467113013176376016014 0ustar liggesusers R Under development (unstable) (2016-10-08 r71471) -- "Unsuffered Consequences" Copyright (C) 2016 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(bbmle) Loading required package: stats4 > f <- function() { + maxit <- 1000 + d <- data.frame(x=0:10, + y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) + mle2(y~dpois(lambda=exp(lymax)/(1+x/exp(lhalf))), + start=list(lymax=0,lhalf=0), + data=d, + control=list(maxit=maxit), + parameters=list(lymax~1,lhalf~1)) + } > > f2 <- function(method="BFGS") { + d <- data.frame(x=0:10, + y=c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)) + mle2(y~dpois(lambda=exp(lymax)/(1+x/exp(lhalf))), + start=list(lymax=0,lhalf=0), + data=d, + method=method, + parameters=list(lymax~1,lhalf~1)) + } > > m1 <- f() > p <- profile(m1) > ## FIXME: check results (need to save in an environment-friendly way!) > print(head(as.data.frame(p)),digits=3) param z par.vals.lymax par.vals.lhalf focal lymax.1 lymax -5.469 2.56 27.21 2.56 lymax.2 lymax -3.204 2.67 2.22 2.67 lymax.3 lymax -2.569 2.78 1.96 2.78 lymax.4 lymax -1.931 2.89 1.73 2.89 lymax.5 lymax -1.292 3.00 1.51 3.00 lymax.6 lymax -0.648 3.11 1.31 3.11 > > m2 <- f2() > p2 <- profile(m2) > print(head(as.data.frame(p2)),digits=3) param z par.vals.lymax par.vals.lhalf focal lymax.1 lymax -5.469 2.56 27.21 2.56 lymax.2 lymax -3.204 2.67 2.22 2.67 lymax.3 lymax -2.569 2.78 1.96 2.78 lymax.4 lymax -1.931 2.89 1.73 2.89 lymax.5 lymax -1.292 3.00 1.51 3.00 lymax.6 lymax -0.648 3.11 1.31 3.11 > > proc.time() user system elapsed 0.768 0.028 0.832 bbmle/tests/methods.Rout.save0000644000176200001440000000520113013175522015745 0ustar liggesusers R Under development (unstable) (2014-05-14 r65609) -- "Unsuffered Consequences" Copyright (C) 2014 The R Foundation for Statistical Computing Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(bbmle) Loading required package: stats4 > x <- 0:10 > y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) > d <- data.frame(x,y) > LL <- function(ymax=15, xhalf=6) + -sum(stats::dpois(y, lambda=ymax/(1+x/xhalf), log=TRUE)) > options(digits=3) > mfit0 <- mle2(y~dpois(lambda=exp(interc)), + start=list(interc=log(mean(y))),data=d) > mfit1 <- mle2(y~dpois(lambda=exp(loglambda)), + start=list(loglambda=log(mean(y))),data=d) > > coef(mfit0) interc 2.45 > residuals(mfit0) [1] 4.254 1.605 0.428 0.134 2.488 -1.926 -0.749 -1.043 -1.926 -2.221 [11] -1.043 > AIC(mfit0) [1] 87.5 > BIC(mfit0) [1] 87.9 > vcov(mfit0) interc interc 0.00787 > ## fitted(mfit0) ## fails, looks for default value > predict(mfit0) ## FIXME: doesn't expand properly (need implicit lambda~1 formula??) [1] 11.5 > set.seed(1001) > simulate(mfit0) [1] 18 10 10 15 7 9 10 14 10 13 15 > anova(mfit0,mfit1) Likelihood Ratio Tests Model 1: mfit0, y~dpois(lambda=exp(interc)) Model 2: mfit1, y~dpois(lambda=exp(loglambda)) Tot Df Deviance Chisq Df Pr(>Chisq) 1 1 85.5 2 1 85.5 0 0 1 > summary(mfit0) Maximum likelihood estimation Call: mle2(minuslogl = y ~ dpois(lambda = exp(interc)), start = list(interc = log(mean(y))), data = d) Coefficients: Estimate Std. Error z value Pr(z) interc 2.4463 0.0887 27.6 <2e-16 *** --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 -2 log L: 85.5 > summary(mfit1) Maximum likelihood estimation Call: mle2(minuslogl = y ~ dpois(lambda = exp(loglambda)), start = list(loglambda = log(mean(y))), data = d) Coefficients: Estimate Std. Error z value Pr(z) loglambda 2.4463 0.0887 27.6 <2e-16 *** --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 -2 log L: 85.5 > > proc.time() user system elapsed 0.672 1.400 2.330 bbmle/tests/ICtab.Rout.save0000644000176200001440000000331213576553670015307 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.save0000644000176200001440000000227713013175522014711 0ustar liggesusers R Under development (unstable) (2012-12-14 r61321) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > require(bbmle) Loading required package: bbmle Loading required package: stats4 > x <- 0:10 > y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) > d <- data.frame(x,y) > fit <- mle2(y~dpois(lambda=ymax/(1+x/xhalf)), start=list(ymax=25,xhalf=3),data=d) > fit2 <- mle2(y~dpois(lambda=(x+1)*slope), start=list(slope=1),data=d) > BIC(fit) [1] 62.0039 > BIC(fit,fit2) df BIC fit 2 62.0039 fit2 1 228.2046 > > proc.time() user system elapsed 0.716 1.076 1.659 bbmle/tests/startvals.R0000644000176200001440000000163613013175522014650 0ustar liggesuserslibrary(bbmle) ## copied from emdbook dbetabinom <- function (x, prob, size, theta, shape1, shape2, log = FALSE) { if (missing(prob) && !missing(shape1) && !missing(shape2)) { prob = shape1/(shape1 + shape2) theta = shape1 + shape2 } v <- lchoose(size, x) - lbeta(theta * (1 - prob), theta * prob) + lbeta(size - x + theta * (1 - prob), x + theta * prob) if (log) v else exp(v) } ss <- data.frame(taken=c(0,1,2,5),available=c(5,5,5,5), dist=rep(1,4)) SP.bb=mle2(taken~dbetabinom(prob,theta,size=available), start=list(prob=0.5,theta=1),data=ss) SP.bb.dist=mle2(taken~dbetabinom(prob,size=available,theta), parameters=list(prob~dist-1,theta~dist-1), start=as.list(coef(SP.bb)),data=ss) SP.bb.dist2=mle2(taken~dbetabinom(prob,size=available,theta), parameters=list(prob~dist - 1,theta~dist - 1), start=as.list(coef(SP.bb)),data=ss) bbmle/tests/parscale.Rout.save0000644000176200001440000000722413502535271016107 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.R0000644000176200001440000002701413013175522014730 0ustar liggesuserslibrary(bbmle) ## fir data from emdbook package ... firdata <- structure(list(TOTCONES = c(19, 42, 40, 68, 5, 0, 21, 114, 37, 92, 84, 102, 98, 63, 9, 31, 35, 216, 27, 297, 36, 127, 23, 46, 27, 66, 11, 20, 141, 3, 22, 39, 96, 206.5, 40, 231, 63.5, 202, 54, 32, 107.5, 142.5, 82, 65, 153, 123, 131, 43, 98, 37, 34, 10, 65, 35, 50, 19, 73, 33, 61, 9, 146, 0, 44, 42, 0, 61, 17, 53, 27, 0, 74, 36, 28, 56, 46, 0, 15, 26, 46, 15, 105, 0, 62, 24, 25, 41, 138, 77, 227.7, 28, 45, 57, 109, 28, 17, 91, 69, 87, 10, 65, 50, 27, 30, 86, 119, 22, 8, 54, 104, 14, 16, 5, 53, 40, 32, 114, 39, 37, 111, 226, 156, 42, 86, 94, 54, 1, 14, 44, 108, 116.5, 14, 73, 3, 16, 87, 61, 48, 0, 17, 5, 88, 11, 133, 121, 166, 171, 63, 23, 4, 51, 10, 14, 78, 47, 31, 42, 24, 42, 55, 19, 63, 127, 9, 74, 120, 85, 51, 19, 131, 7, 23, 7, 9, 23, 55, 48, 13, 2, 9, 3, 4, 16, 1, 88, 8, 27, 16, 184, 14, 22, 25, 52, 2, 134, 81, 85, 3, 56, 17, 8, 10, 6, 69, 58, 1, 22, 3, 11, 22, 2, 37, 8, 15, 61, 6, 18, 9, 109, 54, 4, 11, 30, 0, 0, 3, 0, 16, 22, 9, 56, 17, 64, 38, 59, 37, 22, 41, 1, 22, 16, 17, 4), DBH = c(9.4, 10.6, 7.7, 10.6, 8.7, 10.1, 8.1, 11.6, 10.1, 13.3, 10, 13.4, 9.7, 7.4, 8.7, 8.6, 7.9, 14.2, 9.5, 15.9, 6, 10.6, 7.3, 10.3, 8.4, 10.2, 13.8, 9.4, 8.1, 9.6, 7.3, 7.4, 10.3, 13.4, 9.2, 13.9, 10.9, 17.4, 10.2, 8.2, 11.3, 16.1, 12.3, 8.3, 12.4, 12.5, 11.3, 7.8, 11.6, 10, 7, 5.7, 7.7, 8.9, 8.5, 8.5, 10.7, 10.2, 10.8, 9, 9.4, 7.6, 10.6, 10, 8, 7.4, 9.1, 6.7, 9.7, 6.8, 8.6, 9.1, 6.3, 6.7, 10.9, 9.5, 9.9, 6.8, 9.8, 7.7, 12.1, 8.2, 10, 9.6, 9.2, 8.2, 11.3, 11.6, 15.7, 9.1, 8.9, 8.7, 11, 6.6, 7.1, 9, 12.4, 12.1, 7.5, 9, 8, 10.9, 9.2, 10.1, 12.1, 7, 6.8, 8.6, 11.6, 6.6, 6.7, 6.8, 8.5, 7.8, 7.9, 9.8, 6.2, 6.7, 15.4, 9.2, 12.9, 6.7, 9.6, 8.4, 8, 8.7, 6.7, 9.2, 9.5, 8, 5.5, 8.5, 5.7, 5.6, 8, 6.5, 9.6, 6.1, 7.9, 5.9, 11, 8.2, 12.8, 12.8, 12.5, 13.7, 11.8, 6.3, 6.3, 8.2, 6.2, 6.7, 9.8, 9.4, 6.7, 6, 4.9, 9.6, 7.5, 8.4, 7.4, 9.9, 7.4, 9.5, 13.9, 6.9, 9.4, 7.4, 12.8, 5.8, 7.2, 5.6, 6.9, 11.3, 9.6, 6.8, 6.9, 6.6, 4.8, 4.4, 4.8, 8.5, 7, 8.7, 6.6, 8.6, 5.3, 10.4, 6.4, 5.4, 8.2, 5.5, 6.2, 14.7, 10.5, 14.4, 5.8, 6.1, 6.2, 6.2, 7.2, 6, 10.6, 8.7, 7.5, 7.3, 5.2, 6.9, 6.6, 6.7, 5.2, 6.9, 7.5, 9, 5.9, 6.5, 6.6, 9.8, 4.7, 4.2, 4.8, 6.7, 6.5, 6.7, 5.9, 5.4, 6.9, 6.5, 6, 12, 7.5, 6.4, 7.3, 7.3, 6.4, 7, 5.9, 9.1, 6.7, 4, 6.5, 4.7), WAVE_NON = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("n", "w"), class = "factor"), logcones = c(2.99573227355399, 3.76120011569356, 3.71357206670431, 4.23410650459726, 1.79175946922805, 0, 3.09104245335832, 4.74493212836325, 3.63758615972639, 4.53259949315326, 4.44265125649032, 4.63472898822964, 4.59511985013459, 4.15888308335967, 2.30258509299405, 3.46573590279973, 3.58351893845611, 5.37989735354046, 3.3322045101752, 5.6970934865054, 3.61091791264422, 4.85203026391962, 3.17805383034795, 3.85014760171006, 3.3322045101752, 4.20469261939097, 2.484906649788, 3.04452243772342, 4.95582705760126, 1.38629436111989, 3.13549421592915, 3.68887945411394, 4.57471097850338, 5.33513133967075, 3.71357206670431, 5.44673737166631, 4.16666522380173, 5.31320597904179, 4.00733318523247, 3.49650756146648, 4.68675017298051, 4.96633503519968, 4.4188406077966, 4.18965474202643, 5.03695260241363, 4.82028156560504, 4.88280192258637, 3.78418963391826, 4.59511985013459, 3.63758615972639, 3.55534806148941, 2.39789527279837, 4.18965474202643, 3.58351893845611, 3.93182563272433, 2.99573227355399, 4.30406509320417, 3.52636052461616, 4.12713438504509, 2.30258509299405, 4.99043258677874, 0, 3.80666248977032, 3.76120011569356, 0, 4.12713438504509, 2.89037175789616, 3.98898404656427, 3.3322045101752, 0, 4.31748811353631, 3.61091791264422, 3.36729582998647, 4.04305126783455, 3.85014760171006, 0, 2.77258872223978, 3.29583686600433, 3.85014760171006, 2.77258872223978, 4.66343909411207, 0, 4.14313472639153, 3.2188758248682, 3.25809653802148, 3.73766961828337, 4.93447393313069, 4.35670882668959, 5.43241110102874, 3.36729582998647, 3.8286413964891, 4.06044301054642, 4.70048036579242, 3.36729582998647, 2.89037175789616, 4.52178857704904, 4.24849524204936, 4.47733681447821, 2.39789527279837, 4.18965474202643, 3.93182563272433, 3.3322045101752, 3.43398720448515, 4.46590811865458, 4.78749174278205, 3.13549421592915, 2.19722457733622, 4.00733318523247, 4.65396035015752, 2.70805020110221, 2.83321334405622, 1.79175946922805, 3.98898404656427, 3.71357206670431, 3.49650756146648, 4.74493212836325, 3.68887945411394, 3.63758615972639, 4.71849887129509, 5.4249500174814, 5.05624580534831, 3.76120011569356, 4.46590811865458, 4.55387689160054, 4.00733318523247, 0.693147180559945, 2.70805020110221, 3.80666248977032, 4.69134788222914, 4.76643833358421, 2.70805020110221, 4.30406509320417, 1.38629436111989, 2.83321334405622, 4.47733681447821, 4.12713438504509, 3.89182029811063, 0, 2.89037175789616, 1.79175946922805, 4.48863636973214, 2.484906649788, 4.89783979995091, 4.80402104473326, 5.11799381241676, 5.14749447681345, 4.15888308335967, 3.17805383034795, 1.6094379124341, 3.95124371858143, 2.39789527279837, 2.70805020110221, 4.36944785246702, 3.87120101090789, 3.46573590279973, 3.76120011569356, 3.2188758248682, 3.76120011569356, 4.02535169073515, 2.99573227355399, 4.15888308335967, 4.85203026391962, 2.30258509299405, 4.31748811353631, 4.79579054559674, 4.45434729625351, 3.95124371858143, 2.99573227355399, 4.88280192258637, 2.07944154167984, 3.17805383034795, 2.07944154167984, 2.30258509299405, 3.17805383034795, 4.02535169073515, 3.89182029811063, 2.63905732961526, 1.09861228866811, 2.30258509299405, 1.38629436111989, 1.6094379124341, 2.83321334405622, 0.693147180559945, 4.48863636973214, 2.19722457733622, 3.3322045101752, 2.83321334405622, 5.22035582507832, 2.70805020110221, 3.13549421592915, 3.25809653802148, 3.97029191355212, 1.09861228866811, 4.90527477843843, 4.40671924726425, 4.45434729625351, 1.38629436111989, 4.04305126783455, 2.89037175789616, 2.19722457733622, 2.39789527279837, 1.94591014905531, 4.24849524204936, 4.07753744390572, 0.693147180559945, 3.13549421592915, 1.38629436111989, 2.484906649788, 3.13549421592915, 1.09861228866811, 3.63758615972639, 2.19722457733622, 2.77258872223978, 4.12713438504509, 1.94591014905531, 2.94443897916644, 2.30258509299405, 4.70048036579242, 4.00733318523247, 1.6094379124341, 2.484906649788, 3.43398720448515, 0, 0, 1.38629436111989, 0, 2.83321334405622, 3.13549421592915, 2.30258509299405, 4.04305126783455, 2.89037175789616, 4.17438726989564, 3.66356164612965, 4.0943445622221, 3.63758615972639, 3.13549421592915, 3.73766961828337, 0.693147180559945, 3.13549421592915, 2.83321334405622, 2.89037175789616, 1.6094379124341 )), .Names = c("TOTCONES", "DBH", "WAVE_NON", "logcones"), row.names = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, 43L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 52L, 53L, 54L, 55L, 56L, 58L, 59L, 60L, 61L, 62L, 63L, 64L, 65L, 66L, 67L, 68L, 69L, 70L, 71L, 72L, 73L, 74L, 75L, 76L, 78L, 79L, 80L, 81L, 82L, 83L, 84L, 85L, 86L, 87L, 88L, 89L, 90L, 91L, 92L, 93L, 94L, 95L, 96L, 97L, 98L, 99L, 100L, 101L, 102L, 103L, 104L, 105L, 106L, 107L, 108L, 109L, 110L, 111L, 112L, 113L, 118L, 119L, 120L, 121L, 122L, 123L, 124L, 126L, 127L, 128L, 129L, 130L, 131L, 132L, 133L, 134L, 135L, 136L, 137L, 138L, 139L, 140L, 142L, 144L, 145L, 146L, 147L, 148L, 149L, 150L, 151L, 154L, 155L, 157L, 159L, 160L, 168L, 169L, 170L, 171L, 172L, 173L, 174L, 175L, 176L, 177L, 178L, 179L, 180L, 181L, 184L, 185L, 186L, 187L, 189L, 190L, 193L, 198L, 247L, 272L, 273L, 275L, 276L, 277L, 278L, 280L, 281L, 282L, 283L, 284L, 285L, 286L, 287L, 288L, 289L, 290L, 291L, 292L, 293L, 294L, 295L, 296L, 297L, 298L, 299L, 300L, 301L, 303L, 304L, 305L, 306L, 307L, 308L, 309L, 310L, 311L, 313L, 314L, 315L, 316L, 319L, 320L, 321L, 322L, 323L, 325L, 326L, 327L, 330L, 331L, 332L, 337L, 338L, 339L, 340L, 341L, 342L, 343L, 344L, 345L, 346L, 347L, 348L, 349L, 350L, 351L, 352L, 353L, 357L, 358L, 360L, 366L), na.action = structure(c(34L, 57L, 77L, 114L, 115L, 116L, 117L, 125L, 141L, 143L, 152L, 153L, 156L, 158L, 161L, 162L, 163L, 164L, 165L, 166L, 167L, 182L, 183L, 188L, 191L, 192L, 194L, 195L, 196L, 197L, 199L, 200L, 201L, 202L, 203L, 204L, 205L, 206L, 207L, 208L, 209L, 210L, 211L, 212L, 213L, 214L, 215L, 216L, 217L, 218L, 219L, 220L, 221L, 222L, 223L, 224L, 225L, 226L, 227L, 228L, 229L, 230L, 231L, 232L, 233L, 234L, 235L, 236L, 237L, 238L, 239L, 240L, 241L, 242L, 243L, 244L, 245L, 246L, 248L, 249L, 250L, 251L, 252L, 253L, 254L, 255L, 256L, 257L, 258L, 259L, 260L, 261L, 262L, 263L, 264L, 265L, 266L, 267L, 268L, 269L, 270L, 271L, 274L, 279L, 302L, 312L, 317L, 318L, 324L, 328L, 329L, 333L, 334L, 335L, 336L, 354L, 355L, 356L, 359L, 361L, 362L, 363L, 364L, 365L, 367L, 368L, 369L, 370L, 371L), .Names = c("34", "57", "77", "114", "115", "116", "117", "125", "141", "143", "152", "153", "156", "158", "161", "162", "163", "164", "165", "166", "167", "182", "183", "188", "191", "192", "194", "195", "196", "197", "199", "200", "201", "202", "203", "204", "205", "206", "207", "208", "209", "210", "211", "212", "213", "214", "215", "216", "217", "218", "219", "220", "221", "222", "223", "224", "225", "226", "227", "228", "229", "230", "231", "232", "233", "234", "235", "236", "237", "238", "239", "240", "241", "242", "243", "244", "245", "246", "248", "249", "250", "251", "252", "253", "254", "255", "256", "257", "258", "259", "260", "261", "262", "263", "264", "265", "266", "267", "268", "269", "270", "271", "274", "279", "302", "312", "317", "318", "324", "328", "329", "333", "334", "335", "336", "354", "355", "356", "359", "361", "362", "363", "364", "365", "367", "368", "369", "370", "371"), class = "omit"), class = "data.frame") m1 <- mle2(logcones ~ dnorm(i + slope*log(DBH), sd), parameters= list(i ~ WAVE_NON-1, slope ~ WAVE_NON-1), data = firdata, start = list(i=c(-2,-2),slope=c(2.5,2.5),sd=1)) ancovafun = function(i1,i2,slope1,slope2,sigma) { int = c(i1,i2)[WAVE_NON] slope = c(slope1,slope2)[WAVE_NON] Y.pred = int+ slope*log(DBH) r <- -sum(dnorm(logcones,mean=Y.pred,sd=sigma,log=TRUE)) ## cat(i1,i2,slope1,slope2,sigma,r,"\n") r } m2 <- mle2(ancovafun,start=list(i1=-2,i2=-2,slope1=2.5,slope2=2.5,sigma=1), data=firdata) m3 <- mle2(logcones ~ dnorm(mu, sd), parameters= list(mu ~ WAVE_NON*log(DBH)), data = firdata, start = list(mu=1,sd=1)) stopifnot(all.equal(AIC(m1),AIC(m2),AIC(m3))) ## m4 <- mle2(logcones ~ dnorm(i + slope*log(DBH), sd), ## parameters= list(i ~ WAVE_NON-1, slope ~ WAVE_NON-1), ## data = firdata, ## start = c(-2,-2,2.5,2.5,sd=1)) bbmle/tests/eval.Rout.save0000644000176200001440000000620413013175522015235 0ustar liggesusers R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## I am experiencing difficulties with one of my modeling function (bbmle::mle2) > ## which, like other modeling functions in R, uses match.call() to > ## retrieve and save the original function call for future use. > ## I'll describe the problem for bbmle and then show that I can > ## provoke a similar problem with lm(). > > ## ============ > ## PART I: mle2() > > library(bbmle) > > x <- 0:10 > y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) > d <- data.frame(x,y) > > ## The key is to call the modeling function from within another > ## function which passes additional arguments via ... > > ff <- function(d,...) { + mle2(y~dpois(lambda=ymean),start=list(ymean=mean(y)),data=d,...) + } > > ff(d) Call: mle2(minuslogl = y ~ dpois(lambda = ymean), start = list(ymean = mean(y)), data = d) Coefficients: ymean 11.54545 Log-likelihood: -42.73 > try(ff(d,control=list(maxit=1000))) Call: mle2(minuslogl = y ~ dpois(lambda = ymean), start = list(ymean = mean(y)), data = d, control = ..1) Coefficients: ymean 11.54545 Log-likelihood: -42.73 > > ## Error in call$control$parscale : > ## object of type 'symbol' is not subsettable > > ## This happens when I try: > > ## call$control$parscale <- eval.parent(call$control$parscale) > > ## in 'normal' circumstances call$control and call$control$parscale > ## are either NULL or well-specified ... > > ## Debugging mle2 shows that the results of match.call() are > > ## mle2(minuslogl = y ~ dpois(lambda = ymean), start = list(ymean = mean(y)), > ## data = d, control = ..1) > > ## ============ > ## PART II: lm() > > ## I can find a similar issue with lm(), although admittedly > ## I have to work a bit harder/do something a little bit more > ## obscure. > > L1 <- lm(y~1,data=d,tol=1e-6) > L1$call lm(formula = y ~ 1, data = d, tol = 1e-06) > > ff2 <- function(d,...) { + lm(y~1,data=d,...) + } > > tt <- 1e-6 > L2 <- ff2(d,tol=tt) > L2$call lm(formula = y ~ 1, data = d, tol = ..1) > > try(update(L2,.~.+x)) Error in lm.fit(x, y, offset = offset, singular.ok = singular.ok, ...) : ..1 used in an incorrect context, no ... to look in > > ## Error in lm.fit(x, y, offset = offset, singular.ok = singular.ok, ...) : > ## ..1 used in an incorrect context, no ... to look in > > ## similar issue in curve3d(). How does curve() work? > > > > proc.time() user system elapsed 0.728 1.020 1.595 bbmle/tests/testbounds.Rout0000644000176200001440000000237513013175522015550 0ustar liggesusers R version 2.8.1 (2008-12-22) Copyright (C) 2008 The R Foundation for Statistical Computing ISBN 3-900051-07-0 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > x <- runif(10) > y <- 1+x+rnorm(10,sd=0.1) > > library(bbmle) > m1 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1))) > > m2 = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), + method="L-BFGS-B",lower=c(a=0,b=0,s=-Inf)) > > m2F = mle2(y~dnorm(a+b*x,sd=exp(s)),start=list(a=1,b=1,s=log(0.1)), + method="L-BFGS-B",lower=c(a=0,b=0,s=-Inf), + fixed=list(a=1)) Warning message: In mle2(y ~ dnorm(a + b * x, sd = exp(s)), start = list(a = 1, b = 1, : length mismatch between lower/upper and number of non-fixed parameters > > > proc.time() user system elapsed 1.008 0.024 1.044 bbmle/tests/glmcomp.Rout.save0000644000176200001440000000335313013175522015746 0ustar liggesusers R Under development (unstable) (2014-05-14 r65609) -- "Unsuffered Consequences" Copyright (C) 2014 The R Foundation for Statistical Computing Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(bbmle) Loading required package: stats4 > library(testthat) > x <- 0:10 > y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) > d <- data.frame(x,y) > LL <- function(ymax=15, xhalf=6) + -sum(stats::dpois(y, lambda=ymax/(1+x/xhalf), log=TRUE)) > mfit0 <- mle2(y~dpois(lambda=exp(interc)), + start=list(interc=log(mean(y))),data=d) > > mfit1 <- mle2(y~dpois(lambda=exp(loglambda)), + start=list(loglambda=log(mean(y))),data=d) > > gfit0 <- glm(y~1,family=poisson) > expect_equal(unname(coef(mfit0)),unname(coef(gfit0))) > expect_equal(logLik(mfit0),logLik(gfit0)) > expect_equal(predict(mfit0), ## only one value for now + unique(predict(gfit0,type="response"))) > > ## FIXME: residuals are backwards > expect_equal(residuals(mfit0,type="response"),unname(residuals(gfit0,type="response"))) > ## FIXME: residuals are backwards > expect_equal(residuals(mfit0,type="pearson"),unname(residuals(gfit0,type="pearson"))) > > > > proc.time() user system elapsed 0.816 1.912 2.711 bbmle/tests/formulatest.R0000644000176200001440000004213313502535402015167 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.R0000644000176200001440000000117413013175522015157 0ustar liggesusers## set up a data frame for prediction set.seed(1001) f = factor(rep(letters[1:4],each=20)) x = runif(80) u = rnorm(4) y = rnorm(80,mean=2+x*(3+u[f]),sd=0.1) dat = data.frame(f,x,y) ## fit a model ... could easily do by lm() but want to ## demonstrate the problem library(bbmle) m1 = mle2(y~dnorm(a+b*x,sd=exp(logs)),parameters=list(b~f),data=dat, start=list(a=0,b=2,logs=-3)) ## data frame for prediction pp0 = expand.grid(x=seq(0,1,length=11), f=levels(dat$f)) ## combine frame and model data: have to keep the model data ## around, because it contain other information needed for ## prediction. nrow(predict(m1,pp0)) bbmle/tests/eval.R0000644000176200001440000000327613013175522013556 0ustar liggesusers## I am experiencing difficulties with one of my modeling function (bbmle::mle2) ## which, like other modeling functions in R, uses match.call() to ## retrieve and save the original function call for future use. ## I'll describe the problem for bbmle and then show that I can ## provoke a similar problem with lm(). ## ============ ## PART I: mle2() library(bbmle) x <- 0:10 y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8) d <- data.frame(x,y) ## The key is to call the modeling function from within another ## function which passes additional arguments via ... ff <- function(d,...) { mle2(y~dpois(lambda=ymean),start=list(ymean=mean(y)),data=d,...) } ff(d) try(ff(d,control=list(maxit=1000))) ## Error in call$control$parscale : ## object of type 'symbol' is not subsettable ## This happens when I try: ## call$control$parscale <- eval.parent(call$control$parscale) ## in 'normal' circumstances call$control and call$control$parscale ## are either NULL or well-specified ... ## Debugging mle2 shows that the results of match.call() are ## mle2(minuslogl = y ~ dpois(lambda = ymean), start = list(ymean = mean(y)), ## data = d, control = ..1) ## ============ ## PART II: lm() ## I can find a similar issue with lm(), although admittedly ## I have to work a bit harder/do something a little bit more ## obscure. L1 <- lm(y~1,data=d,tol=1e-6) L1$call ff2 <- function(d,...) { lm(y~1,data=d,...) } tt <- 1e-6 L2 <- ff2(d,tol=tt) L2$call try(update(L2,.~.+x)) ## Error in lm.fit(x, y, offset = offset, singular.ok = singular.ok, ...) : ## ..1 used in an incorrect context, no ... to look in ## similar issue in curve3d(). How does curve() work? bbmle/tests/formulatest.Rout.save0000644000176200001440000005131313502535416016661 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.save0000644000176200001440000000357113502535232015575 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.R0000644000176200001440000000411313502533340014407 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.Rout0000644000176200001440000000663113013175522015442 0ustar liggesusers R version 2.11.1 (2010-05-31) Copyright (C) 2010 The R Foundation for Statistical Computing ISBN 3-900051-07-0 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > > library(bbmle) Loading required package: stats4 Loading required package: numDeriv > > funcresp <- + structure(list(Initial = as.integer(c(5, 5, 10, 10, 15, 15, 20, + 20, 30, 30, 50, 50, 75, 75, 100, 100)), Killed = as.integer(c(1, + 2, 5, 6, 10, 9, 7, 10, 11, 15, 5, 21, 32, 18, 25, 35))), .Names = c("Initial", + "Killed"), class = "data.frame", row.names = c("1", "2", "3", + "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", + "16")) > > attach(funcresp) > > binomNLL2 = function(p) { + a = p[1] + h = p[2] + ## cat(a,h,"\n") + p = a/(1+a*h*N) + -sum(dbinom(k,prob=p,size=N,log=TRUE)) + } > > N=0; k=0 > parnames(binomNLL2) = c("a","h") > m2a = mle2(binomNLL2,start=c(a=0.5,h=0.0125), + data=list(N=Initial,k=Killed)) > p1a = profile(m2a); p1a There were 50 or more warnings (use warnings() to see the first 50) Likelihood profile: $a z par.vals.a par.vals.h 1 -4.2047344 0.294898645 -0.002923466 2 -3.1552066 0.341179554 0.002586064 3 -2.2351038 0.387460464 0.007009828 4 -1.4145435 0.433741374 0.010694613 5 -0.6726261 0.480022283 0.013859302 6 0.0000000 0.526303193 0.016643616 7 0.6321738 0.572584102 0.019113307 8 1.2156051 0.618865012 0.021399150 9 1.7630606 0.665145921 0.023494921 10 2.2804928 0.711426831 0.025475099 11 2.7729144 0.757707740 0.027355948 12 3.2447726 0.803988650 0.029170757 13 3.7001523 0.850269559 0.030945274 $h z par.vals.a par.vals.h 1 -3.7637543 0.3268572493 -0.0024273676 2 -3.1748327 0.3542640536 0.0007511297 3 -2.5644438 0.3843760379 0.0039296269 4 -1.9359396 0.4170494900 0.0071081242 5 -1.2938745 0.4519556085 0.0102866214 6 -0.6437592 0.4886001613 0.0134651187 7 0.0000000 0.5263031926 0.0166436159 8 0.6563173 0.5646512092 0.0198221132 9 1.2951023 0.6028512247 0.0230006104 10 1.9201220 0.6405127788 0.0261791077 11 2.5281012 0.6773052997 0.0293576049 12 3.1168240 0.7130175259 0.0325361022 13 3.6849884 0.7475421634 0.0357145994 > c2a = confint(p1a); c2a 2.5 % 97.5 % a 0.402495803 0.68249529 h 0.006987227 0.02638541 > > binomNLL2b = function(p,N,k) { + a = p[1] + h = p[2] + ## cat(a,h,"\n") + p = a/(1+a*h*N) + -sum(dbinom(k,prob=p,size=N,log=TRUE)) + } > parnames(binomNLL2b) = c("a","h") > m2b = mle2(binomNLL2,start=c(a=0.5,h=0.0125), + data=list(N=Initial,k=Killed)) > c2b = confint(m2b) There were 50 or more warnings (use warnings() to see the first 50) > > N=Initial; k=Killed > m2c = mle2(binomNLL2,start=c(a=0.5,h=0.0125)) > c2c = confint(m2c); c2c There were 50 or more warnings (use warnings() to see the first 50) 2.5 % 97.5 % a 0.402495803 0.68249529 h 0.006987227 0.02638541 > > detach(funcresp) > > > proc.time() user system elapsed 4.572 0.048 4.676 bbmle/tests/profbound.R0000644000176200001440000000216013615631276014627 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 <- suppressWarnings(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.R0000644000176200001440000000130013372650570014270 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/0000755000176200001440000000000013615631572013354 5ustar liggesusersbbmle/vignettes/mle2.bib0000754000176200001440000000074113013175530014662 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.Rnw0000754000176200001440000007541313576557173014731 0ustar liggesusers\documentclass{article} %\VignetteIndexEntry{Examples for enhanced mle code} %\VignettePackage{bbmle} %\VignetteDepends{Hmisc} %\VignetteDepends{emdbook} %\VignetteDepends{ggplot2} %\VignetteDepends{lattice} %\VignetteEngine{knitr::knitr} \usepackage[utf8]{inputenc} % for UTF-8/single quotes from sQuote() \usepackage[english]{babel} % for texi2dvi ~ bug \usepackage{graphicx} \usepackage{natbib} \usepackage{array} \usepackage{color} \usepackage[colorlinks=true,urlcolor=blue,bookmarks=true]{hyperref} \usepackage{url} \author{Ben Bolker} \title{Maximum likelihood estimation and analysis with the \code{bbmle} package} \newcommand{\code}[1]{{\tt #1}} \newcommand{\bbnote}[1]{\color{red} {\em #1} \color{black}} \date{\today} \begin{document} \bibliographystyle{chicago} %\bibliographystyle{plain} \maketitle \tableofcontents <>= if (require("knitr")) opts_chunk$set(fig.width=5,fig.height=5,tidy=FALSE,warning=FALSE,error=TRUE) @ <>= library(Hmisc) @ The \code{bbmle} package, designed to simplify maximum likelihood estimation and analysis in R, extends and modifies the \code{mle} function and class in the \code{stats4} package that comes with R by default. \code{mle} is in turn a wrapper around the \code{optim} function in base R. The maximum-likelihood-estimation function and class in \code{bbmle} are both called \code{mle2}, to avoid confusion and conflict with the original functions in the \code{stats4} package. The major differences between \code{mle} and \code{mle2} are: \begin{itemize} \item \code{mle2} is more robust, with additional warnings (e.g. if the Hessian can't be computed by finite differences, \code{mle2} returns a fit with a missing Hessian rather than stopping with an error) \item \code{mle2} uses a \code{data} argument to allow different data to be passed to the negative log-likelihood function \item \code{mle2} has a formula interface like that of (e.g.) \code{gls} in the \code{nlme} package. For relatively simple models the formula for the maximum likelihood can be written in-line, rather than defining a negative log-likelihood function. The formula interface also simplifies fitting models with categorical variables. Models fitted using the formula interface also have applicable \code{predict} and \code{simulate} methods. \item \code{bbmle} defines \code{anova}, \code{AIC}, \code{AICc}, and \code{BIC} methods for \code{mle2} objects, as well as \code{AICtab}, \code{BICtab}, \code{AICctab} functions for producing summary tables of information criteria for a set of models. \end{itemize} Other packages with similar functionality (extending GLMs in various ways) are \begin{itemize} \item on CRAN: \code{aods3} (overdispersed models such as beta-binomial); \code{vgam} (a wide range of models); \code{betareg} (beta regression); \code{pscl} (zero-inflated, hurdle models); \code{maxLik} (another general-purpose maximizer, with a different selection of optimizers) \item In Jim Lindsey's code repository (\url{http://popgen.unimaas.nl/~jlindsey/rcode.html}): \code{gnlr} and \code{gnlr3} \end{itemize} \section{Example: \emph{Orobanche}/overdispersed binomial} This example will use the classic data set on \emph{Orobanche} germination from \cite{Crowder1978} (you can also use \code{glm(...,family="quasibinomial")} or the \code{aods3} package to analyze these data). \subsection{Test basic fit to simulated beta-binomial data} First, generate a single beta-binomially distributed set of points as a simple test. Load the \code{emdbook} package to get functions for the beta-binomial distribution (random-deviate function \code{rbetabinom} --- these functions are also available in Jim Lindsey's \code{rmutil} package). <>= library(emdbook) @ Generate random deviates from a random beta-binomial: <>= set.seed(1001) x1 <- rbetabinom(n=1000,prob=0.1,size=50,theta=10) @ Load the package: <>= library(bbmle) @ Construct a simple negative log-likelihood function: <>= mtmp <- function(prob,size,theta) { -sum(dbetabinom(x1,prob,size,theta,log=TRUE)) } @ Fit the model --- use \code{data} to pass the \code{size} parameter (since it wasn't hard-coded in the \code{mtmp} function): <>= (m0 <- mle2(mtmp,start=list(prob=0.2,theta=9),data=list(size=50))) @ (here and below, I'm suppressing lots of warnings about {\tt NaNs produced}) The \code{summary} method for \code{mle2} objects shows the parameters; approximate standard errors (based on quadratic approximation to the curvature at the maximum likelihood estimate); and a test of the parameter difference from zero based on this standard error and on an assumption that the likelihood surface is quadratic (or equivalently that the sampling distribution of the estimated parameters is normal). <>= summary(m0) @ Construct the likelihood profile (you can apply \code{confint} directly to \code{m0}, but if you're going to work with the likelihood profile [e.g. plotting, or looking for confidence intervals at several different $\alpha$ values] then it is more efficient to compute the profile once): <>= p0 <- profile(m0) @ Compare the confidence interval estimates based on inverting a spline fit to the profile (the default); based on the quadratic approximation at the maximum likelihood estimate; and based on root-finding to find the exact point where the profile crosses the critical level. <>= confint(p0) confint(m0,method="quad") confint(m0,method="uniroot") @ All three types of confidence limits are similar. Plot the profiles: <>= par(mfrow=c(1,2)) plot(p0,plot.confstr=TRUE) @ By default, the plot method for likelihood profiles displays the square root of the the deviance difference (twice the difference in negative log-likelihood from the best fit), so it will be {\sf V}-shaped for cases where the quadratic approximation works well (as in this case). (For a better visual estimate of whether the profile is quadratic, use the \code{absVal=FALSE} option to the \code{plot} method.) You can also request confidence intervals calculated using \code{uniroot}, which may be more exact when the profile is not smooth enough to be modeled accurately by a spline. However, this method is also more sensitive to numeric problems. Instead of defining an explicit function for \code{minuslogl}, we can also use the formula interface. The formula interface assumes that the density function given (1) has \code{x} as its first argument (if the distribution is multivariate, then \code{x} should be a matrix of observations) and (2) has a \code{log} argument that will return the log-probability or log-probability density if \code{log=TRUE}. Some of the extended functionality (prediction etc.) depends on the existence of an \code{s}- variant function for the distribution that returns (at least) the mean and median as a function of the parameters (currently defined: \code{snorm}, \code{sbinom}, \code{sbeta}, \code{snbinom}, \code{spois}). <>= m0f <- mle2(x1~dbetabinom(prob,size=50,theta), start=list(prob=0.2,theta=9),data=data.frame(x1)) @ Note that you must specify the data via the \code{data} argument when using the formula interface. This may be slightly more unwieldy than just pulling the data from your workspace when you are doing simple things, but in the long run it makes tasks like predicting new responses much simpler. It's convenient to use the formula interface to try out likelihood estimation on the transformed parameters: <>= m0cf <- mle2(x1~dbetabinom(prob=plogis(lprob),size=50,theta=exp(ltheta)), start=list(lprob=0,ltheta=2),data=data.frame(x1)) confint(m0cf,method="uniroot") confint(m0cf,method="spline") @ In this case the answers from \code{uniroot} and \code{spline} (default) methods barely differ. \subsection{Real data (\emph{Orobanche}, \cite{Crowder1978})} Data are copied from the \code{aods3} package (but a copy is saved with the package to avoid depending on the \code{aods3} package): <>= load(system.file("vignetteData","orob1.rda",package="bbmle")) summary(orob1) @ Now construct a negative log-likelihood function that differentiates among groups: <>= ML1 <- function(prob1,prob2,prob3,theta,x) { prob <- c(prob1,prob2,prob3)[as.numeric(x$dilution)] size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } @ Results from \cite{Crowder1978}: <>= crowder.results <- matrix(c(0.132,0.871,0.839,78.424,0.027,0.028,0.032,-34.991, rep(NA,7),-34.829, rep(NA,7),-56.258), dimnames=list(c("prop diffs","full model","homog model"), c("prob1","prob2","prob3","theta","sd.prob1","sd.prob2","sd.prob3","NLL")), byrow=TRUE,nrow=3) latex(crowder.results,file="",table.env=FALSE,title="model") @ <>= (m1 <- mle2(ML1,start=list(prob1=0.5,prob2=0.5,prob3=0.5,theta=1), data=list(x=orob1))) @ Or: <>= ## would prefer ~dilution-1, but problems with starting values ... (m1B <- mle2(m~dbetabinom(prob,size=n,theta), param=list(prob~dilution), start=list(prob=0.5,theta=1), data=orob1)) @ The result warns us that the optimization has not converged; we also don't match Crowder's results for $\theta$ exactly. We can fix both of these problems by setting \code{parscale} appropriately. Since we don't bound $\theta$ (or below, $\sigma$) we get a fair number of warnings with this and the next few fitting and profiling attempts. We will ignore these for now, since the final results reached are reasonable (and match or nearly match Crowder's values); the appropriate, careful thing to do would be either to fit on a transformed scale where all real-valued parameter values were legal, or to use \code{method="L-BFGS-B"} (or \code{method="bobyqa"} with the \code{optimx} package) to bound the parameters appropriately. You can also use \code{suppressWarnings()} if you're sure you don't need to know about any warnings (beware: this will suppress \emph{all} warnings, those you weren't expecting as well as those you were \ldots) <>= opts_chunk$set(warning=FALSE) @ <>= (m2 <- mle2(ML1,start=as.list(coef(m1)), control=list(parscale=coef(m1)), data=list(x=orob1))) @ Calculate likelihood profile (restrict the upper limit of $\theta$, simply because it will make the picture below a little bit nicer): <>= p2 <- profile(m2,prof.upper=c(Inf,Inf,Inf,theta=2000)) @ Get the curvature-based parameter standard deviations (which Crowder used rather than computing likelihood profiles): <>= round(stdEr(m2),3) @ We are slightly off Crowder's numbers --- rounding error? Crowder also defines a variance (overdispersion) parameter $\sigma^2=1/(1+\theta)$. <>= sqrt(1/(1+coef(m2)["theta"])) @ Using the delta method (via the \code{deltavar} function in the \code{emdbook} package) to approximate the standard deviation of $\sigma$: <>= sqrt(deltavar(sqrt(1/(1+theta)),meanval=coef(m2)["theta"], vars="theta",Sigma=vcov(m2)[4,4])) @ Another way to fit in terms of $\sigma$ rather than $\theta$ is to compute $\theta=1/\sigma^2-1$ on the fly in a formula: <>= m2b <- mle2(m~dbetabinom(prob,size=n,theta=1/sigma^2-1), data=orob1, parameters=list(prob~dilution,sigma~1), start=list(prob=0.5,sigma=0.1)) ## ignore warnings (we haven't bothered to bound sigma<1) round(stdEr(m2b)["sigma"],3) p2b <- profile(m2b,prof.lower=c(-Inf,-Inf,-Inf,0)) @ As might be expected since the standard deviation of $\sigma$ is large, the quadratic approximation is poor: <>= r1 <- rbind(confint(p2)["theta",], confint(m2,method="quad")["theta",]) rownames(r1) <- c("spline","quad") r1 @ Plot the profile: <>= plot(p2,which="theta",plot.confstr=TRUE) @ What does the profile for $\sigma$ look like? <>= plot(p2b,which="sigma",plot.confstr=TRUE, show.points=TRUE) @ Now fit a homogeneous model: <>= ml0 <- function(prob,theta,x) { size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } m0 <- mle2(ml0,start=list(prob=0.5,theta=100), data=list(x=orob1)) @ The log-likelihood matches Crowder's result: <>= logLik(m0) @ It's easier to use the formula interface to specify all three of the models fitted by Crowder (homogeneous, probabilities differing by group, probabilities and overdispersion differing by group): <>= m0f <- mle2(m~dbetabinom(prob,size=n,theta), parameters=list(prob~1,theta~1), data=orob1, start=list(prob=0.5,theta=100)) m2f <- update(m0f, parameters=list(prob~dilution,theta~1), start=list(prob=0.5,theta=78.424)) m3f <- update(m0f, parameters=list(prob~dilution,theta~dilution), start=list(prob=0.5,theta=78.424)) @ \code{anova} runs a likelihood ratio test on nested models: <>= anova(m0f,m2f,m3f) @ The various \code{ICtab} commands produce tables of information criteria; by default the results are sorted and presented as $\Delta$IC; there are various options, including printing model weights. <>= AICtab(m0f,m2f,m3f,weights=TRUE) BICtab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) AICctab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) @ <>= opts_chunk$set(warning=FALSE) @ \section{Example: reed frog size predation} Data from an experiment by Vonesh \citep{VoneshBolker2005} <>= frogdat <- data.frame( size=rep(c(9,12,21,25,37),each=3), killed=c(0,2,1,3,4,5,rep(0,4),1,rep(0,4))) frogdat$initial <- rep(10,nrow(frogdat)) @ <>= library(ggplot2) @ <>= gg1 <- ggplot(frogdat,aes(x=size,y=killed))+geom_point()+ stat_sum(aes(size=..n..))+ labs(size="#")+scale_x_continuous(limits=c(0,40))+ scale_size(breaks=1:3) @ <>= m3 <- mle2(killed~dbinom(prob=c*(size/d)^g*exp(1-size/d), size=initial),data=frogdat,start=list(c=0.5,d=5,g=1)) pdat <- data.frame(size=1:40,initial=rep(10,40)) pdat1 <- data.frame(pdat,killed=predict(m3,newdata=pdat)) @ <>= m4 <- mle2(killed~dbinom(prob=c*((size/d)*exp(1-size/d))^g, size=initial),data=frogdat,start=list(c=0.5,d=5,g=1)) pdat2 <- data.frame(pdat,killed=predict(m4,newdata=pdat)) @ <>= gg1 + geom_line(data=pdat1,colour="red")+ geom_line(data=pdat2,colour="blue") @ <>= coef(m4) prof4 <- profile(m4) @ Three different ways to draw the profile: (1) Built-in method (base graphics): <>= plot(prof4) @ (2) Using \code{xyplot} from the \code{lattice} package: \setkeys{Gin}{width=\textwidth} <>= prof4_df <- as.data.frame(prof4) library(lattice) xyplot(abs(z)~focal|param,data=prof4_df, subset=abs(z)<3, type="b", xlab="", ylab=expression(paste(abs(z), " (square root of ",Delta," deviance)")), scale=list(x=list(relation="free")), layout=c(3,1)) @ (3) Using \code{ggplot} from the \code{ggplot2} package: <>= ss <-subset(prof4_df,abs(z)<3) ggplot(ss, aes(x=focal,y=abs(z)))+geom_line()+ geom_point()+ facet_grid(.~param,scale="free_x") @ \section*{Additions/enhancements/differences from \code{stats4::mle}} \begin{itemize} \item{\code{anova} method} \item{warnings on convergence failure} \item{more robust to non-positive-definite Hessian; can also specify \code{skip.hessian} to skip Hessian computation when it is problematic} \item{when profiling fails because better value is found, report new values} \item{can take named vectors as well as lists as starting parameter vectors} \item{added \code{AICc}, \code{BIC} definitions, \code{ICtab} functions} \item{added \code{"uniroot"} and \code{"quad"} options to \code{confint}} \item{more options for colors and line types etc etc. The old arguments are: <>= function (x, levels, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, absVal = TRUE, ...) {} @ The new one is: <>= function (x, levels, which=1:p, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, plot.confstr = FALSE, confstr = NULL, absVal = TRUE, add = FALSE, col.minval="green", lty.minval=2, col.conf="magenta", lty.conf=2, col.prof="blue", lty.prof=1, xlabs=nm, ylab="score", show.points=FALSE, main, xlim, ylim, ...) {} @ \code{which} selects (by character vector or numbers) which parameters to plot: \code{nseg} does nothing (even in the old version); \code{plot.confstr} turns on the labels for the confidence levels; \code{confstr} gives the labels; \code{add} specifies whether to add the profile to an existing plot; \code{col} and \code{lty} options specify the colors and line types for horizontal and vertical lines marking the minimum and confidence vals and the profile curve; \code{xlabs} gives a vector of x labels; \code{ylab} gives the y label; \code{show.points} specifies whether to show the raw points computed. } \item{\code{mle.options()}} \item{\code{data} argument} \item{handling of names in argument lists} \item{can use alternative optimizers (\code{nlminb}, \code{nlm}, \code{constrOptim}, \code{optimx}, \code{optimize})} \item{uses code from \code{numDeriv} package to compute Hessians rather than built-in optimizer code} \item{by default, uses \code{MASS::ginv} (generalized inverse) rather than \code{solve} to invert Hessian (more robust to positive-semidefinite Hessians \ldots)} \item{can use \code{vecpar=TRUE} (and \code{parnames()}) to use objective functions with parameters specified as vectors (for compatibility with \code{optim} etc.)} \end{itemize} \section{Newer stuff} \textbf{To do:} \begin{itemize} \item{use \code{predict}, \code{simulate} etc. to demonstrate different parametric bootstrap approaches to confidence and prediction intervals \begin{itemize} \item use \code{predict} to get means and standard deviations, use delta method? \item use \code{vcov}, assuming quadratic profiles, with \code{predict(\ldots,newparams=\ldots)} \item prediction intervals assuming no parameter uncertainty with \code{simulate} \item both together \ldots \end{itemize} } \end{itemize} \section{Technical details} \subsection{Profiling and confidence intervals} This section describes the algorithm for constructing profiles and confidence intervals, which is not otherwise documented anywhere except in the code. * indicates changes from the version in \code{stats4:::mle} \subsubsection{Estimating standard error} In order to construct the profile for a particular parameter, one needs an initial estimate of the scale over which to vary that parameter. The estimated standard error of the parameter based on the estimated curvature of the likelihood surface at the MLE is a good guess. \begin{itemize} \item if \code{std.err} is missing, extract the standard error from the summary coefficient table (ultimately computed from \code{sqrt(diag(inverse Hessian))} of the fit) \item * a user-set value of \code{std.err} overrides this behavior unless the value is specified as \code{NA} (in which case the estimate from the previous step is used) \item * if the standard error value is still \code{NA} (i.e. the user did not specify it and the value estimated from the Hessian is missing or \code{NA}) use \code{sqrt(1/diag(hessian))}. This represents a (fairly feeble) attempt to come up with a plausible number when the Hessian is not positive definite but still has positive diagonal entries \item if all else fails, stop and * print an error message that encourages the user to specify the values with \code{std.err} \end{itemize} There may be further tricks that would help guess the appropriate scale: for example, one could guess on the basis of a comparison between the parameter values and negative log-likelihoods at the starting and ending points of the fits. On the other hand, (a) this would take some effort and still be subject to failure for sufficiently pathological fits and (b) there is some value to forcing the user to take explicit, manual steps to remedy such problems, as they may be signs of poorly defined or buggy log-likelihood functions. \subsubsection{Profiling} Profiling is done on the basis of a constructed function that minimizes the negative log-likelihood for a fixed value of the focal parameter and returns the signed square-root of the deviance difference from the minimum (denoted by $z$). At the MLE $z=0$ by definition; it should never be $<0$ unless something has gone wrong with the original fit. The LRT significance cutoffs for $z$ are equal to the usual two-tailed normal distribution cutoffs (e.g. $\pm \approx 1.96$ for 95\% confidence regions). In each direction (decreasing and increasing from the MLE for the focal parameter): \begin{itemize} \item fix the focal parameter \item adjust control parameters etc. accordingly (e.g. remove the entry for the focal parameter so that the remaining control parameters match the non-fixed parameters) \item{controls on the profiling (which can be set manually, but for which there is not much guidance in the documentation): \begin{itemize} \item \code{zmax} Maximum $z$ to aim for. (Default: \code{sqrt(qchisq(1-alpha/2, p))}) The default maximum $\alpha$ (type~I error) is 0.01. \bbnote{I don't understand this criterion. It seems to expand the size of the univariate profile to match a cutoff for the multivariate confidence region of the model. The $\chi^2$ cutoff for deviance to get the $(1-\alpha)$ multivariate confidence region (i.e., on all $p$ of the parameters) would be \code{qchisq(1-alpha,p)} --- % representing a one-tailed test on the deviance. Taking the square root makes sense, since we are working with the square root of the deviance, but I don't understand (1) why we are expanding the region to allow for the multivariate confidence region (since we are computing univariate profiles) [you could at least argue that this is conservative, making the region a little bigger than it needs to be]; (2) why we are using $1-\alpha/2$ rather than $1-\alpha$. } For comparison, \code{MASS::profile.glm} (written by Bates and Venables in 1996, ported to R by BDR in 1998) uses \code{zmax}=\code{sqrt(qchisq(1-alpha,1))} \bbnote{(this makes more sense to me \ldots)}. On the other hand, the profiling code in \code{lme4a} (the \code{profile} method for \code{merMod}, in \code{profile.R}) uses \code{qchisq(1-alphamax, nptot)} \ldots \item \code{del} Step size (scaled by standard error) (Default: \code{zmax}/5.) Presumably (?) copied from \code{MASS::profile.glm}, which says (in \code{?profile.glm}): ``[d]efault value chosen to allow profiling at about 10 parameter values.'' \item \code{maxsteps} Maximum number of profiling steps to try in each direction. (Default: 100) \end{itemize} } \item While \verb+step 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.bst0000754000176200001440000011105113013175530015451 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.Rnw0000754000176200001440000001465213502540416015167 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/0000755000176200001440000000000013615631572011545 5ustar liggesusersbbmle/R/dists.R0000755000176200001440000000447413516100611013013 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.R0000754000176200001440000000266213013175520013146 0ustar liggesusers## setGeneric("update", function(object, formula., ..., evaluate=TRUE) ## standardGeneric("update")) ## FIXME: compare these two ## setMethod("update", "mle2", ## function (object, ..., evaluate = TRUE) ## { ## call <- object@call ## extras <- match.call(expand.dots = FALSE)$... ## if (length(extras) > 0) { ## existing <- !is.na(match(names(extras), names(call))) ## for (a in names(extras)[existing]) call[[a]] <- extras[[a]] ## if (any(!existing)) { ## call <- c(as.list(call), extras[!existing]) ## call <- as.call(call) ## } ## } ## if (evaluate) eval(call, parent.frame()) else call ## }) ## update.default, modified with $ turned to @ as appropriate setMethod("update", "mle2", function (object, formula., evaluate = TRUE, ...) { call <- object@call extras <- match.call(expand.dots = FALSE)$... if (!missing(formula.)) call$minuslogl <- update.formula(formula(object), formula.) if (length(extras)) { existing <- !is.na(match(names(extras), names(call))) for (a in names(extras)[existing]) call[[a]] <- extras[[a]] if (any(!existing)) { call <- c(as.list(call), extras[!existing]) call <- as.call(call) } } if (evaluate) eval(call, parent.frame()) else call }) bbmle/R/confint.R0000754000176200001440000001315113175227223013326 0ustar liggesuserssetMethod("confint", "profile.mle2", function (object, parm, level = 0.95, trace=FALSE, ...) { Pnames <- names(object@profile) if (missing(parm)) parm <- Pnames if (is.character(parm)) parm <- match(parm,Pnames) if (any(is.na(parm))) stop("parameters not found in profile") ## Calculate confidence intervals based on likelihood ## profiles a <- (1 - level)/2 a <- c(a, 1 - a) pct <- paste(round(100 * a, 1), "%") ci <- array(NA, dim = c(length(parm), 2), dimnames = list(Pnames[parm], pct)) cutoff <- qnorm(a) for (pm in parm) { pro <- object@profile[[Pnames[pm]]] pv <- pro[,"par.vals"] if (is.matrix(pv)) pv <- pv[,Pnames[pm]] if (any(diff(pro[,1])<0)) { warning(paste("non-monotonic profile (", Pnames[pm],"): reverting from spline to linear approximation ", "(consider running 'profile' with manually reduced std.err)", sep="")) tt <- approx(pro[,1],pv,xout=cutoff)$y } else { sp <- spline(x = pv, y = pro[, 1]) if (any(diff(sp$y)<0)) { warning(paste("non-monotonic spline fit to profile (", Pnames[pm],"): reverting from spline to linear approximation",sep="")) tt <- approx(pro[,1],pv,xout=cutoff)$y } else { tt <- try(approx(sp$y, sp$x, xout = cutoff)$y,silent=TRUE) if (inherits(tt,"try-error")) tt <- rep(NA,2) } } if (!any(is.na(tt))) { ## if NAs present, sort() will drop NAs ... tt <- sort(tt) } ci[Pnames[pm], ] <- tt } drop(ci) }) setMethod("confint", "mle2", function (object, parm, level = 0.95, method, trace=FALSE,quietly=!interactive(), tol.newmin=0.001,...) { if (missing(method)) method <- mle2.options("confint") ## changed coef() calls to object@coef -- really *don't* want fullcoef! Pnames <- names(object@coef) if (missing(parm)) parm <- seq(along=Pnames) if (is.character(parm)) parm <- match(parm,Pnames) if (any(is.na(parm))) stop("parameters not found in model coefficients") if (method=="spline") { if (!quietly) message("Profiling...\n") newpars_found <- FALSE prof = try(profile(object,which=parm,tol.newmin=tol.newmin,...)) if (inherits(prof,"try-error")) stop(paste("Problem with profiling:",prof)) if (class(prof)=="mle2") newpars_found <- TRUE if (newpars_found) { ## profiling found a better fit message("returning better fit\n") return(prof) } return(confint(prof, parm, level, ...)) } else { B0 <- object@coef pnames <- names(B0) if (missing(parm)) parm <- seq(along=pnames) if (is.character(parm)) parm <- match(parm, pnames, nomatch = 0) a <- (1 - level)/2 a <- c(a, 1 - a) pct <- paste(round(100 * a, 1), "%") pct <- paste(round(100 * a, 1), "%") ci <- array(NA, dim = c(length(parm), 2), dimnames = list(pnames[parm], pct)) std.err <- summary(object)@coef[, "Std. Error"] if (method=="uniroot") { chisqcutoff <- qchisq(level,1) call <- object@call if (!isTRUE(call$vecpar)) call$start <- as.list(B0) ## added upper <- rep(unlist(eval.parent(call$upper)),length.out=length(pnames)) lower <- rep(unlist(eval.parent(call$lower)),length.out=length(pnames)) for (pm in parm) { critfun <- function(bi) { fix <- list(bi) names(fix) <- pnames[pm] call$fixed <- c(fix,eval(call$fixed)) if (!is.null(upper) && length(upper)>1) call$upper <- upper[-pm] if (!is.null(lower) && length(lower)>1) call$lower <- lower[-pm] pfit <- try(eval(call), silent=TRUE) if(inherits(pfit, "try-error")) { warning(paste("Error encountered in profile (uniroot):",pfit)) return(NA) } else { zz <- 2*pfit@min - 2*(-logLik(object)) if (zz > -tol.newmin) zz <- max(zz, 0) else stop(sprintf("profiling has found a better solution (old deviance=%.2f, new deviance=%.2f), so original fit had not converged",2*pfit@min,2*(-logLik(object)))) z <- zz - chisqcutoff } if (trace) cat(bi, z, "\n") z } stepfun <- function(step) { B0[pm] + sgn * step * std.err[pm] } invstepfun <- function(out) { (out - B0[pm])/(sgn * std.err[pm]) } sgnvec=c(-1,1) for (i in 1:2) { sgn <- sgnvec[i] bnd <- if (sgn<0) { if (is.null(lower)) -Inf else lower[pm] } else { if (is.null(upper)) Inf else upper[pm] } c0 <- critfun(B0[pm]) bi <- ctry <- pmin(5,invstepfun(bnd)) cdel <- -0.25 c5 <- NA while (is.na(c5) && ctry>0 ) { c5 <- critfun(stepfun(ctry)) if (is.na(c5)) { if (trace) cat("encountered NA, reducing ctry to",ctry+cdel,"\n") ctry <- ctry+cdel } } if (trace) cat(c0,c5,"\n") if (is.na(c0*c5) || c0*c5>0) { warning(paste("can't find confidence limits in", c("negative","positive")[i],"direction")) curci <- NA ## FIXME: could try harder! } else { curci <- uniroot(critfun,c(stepfun(0),stepfun(ctry)))$root } ci[pnames[pm],i] <- curci } } } else if (method=="quad") { for (pm in parm) { ci[pnames[pm],] <- qnorm(a,B0[pm],std.err[pm]) } } else stop("unknown method") return(drop(ci)) } }) bbmle/R/predict.R0000754000176200001440000001056013013175520013312 0ustar liggesuserssetGeneric("simulate", function(object, nsim=1, seed=NULL, ...) standardGeneric("simulate")) setMethod("simulate", "mle2", function(object, nsim=1, seed, newdata=NULL, newparams=NULL, ...) { if (!is.null(seed)) set.seed(seed) if (!is.null(newparams)) { object@fullcoef <- newparams } g <- gfun(object,newdata=newdata, nsim=nsim,op="simulate") if (nsim>1) { g <- matrix(g,ncol=nsim) } g }) setGeneric("predict", function(object, ...) standardGeneric("predict")) setMethod("predict", "mle2", function(object,newdata=NULL, location="mean",newparams=NULL, ...) { if (!is.null(newparams)) { object@fullcoef <- newparams } gfun(object,newdata=newdata,location=location,op="predict") }) setGeneric("residuals", function(object, ...) standardGeneric("residuals")) setMethod("residuals", "mle2", function(object, type=c("pearson","response"), location="mean", ...) { type <- match.arg(type) location <- match.arg(location) pred <- predict(object,location) ## not sure this will work ... obs <- with(object@data, get(gsub("~.+","",object@formula))) res <- obs-pred if (type=="response") return(res) vars <- predict(object,location="variance") return(res/sqrt(vars)) }) ## general-purpose function for simulation and ## prediction (the hard part is evaluating the parameters etc.) ## gfun <- function(object,newdata=NULL,location=c("mean","median","variance"), nsim, op=c("predict","simulate")) { ## notes: should operate on formula ## pull out call$formula (not character) location <- match.arg(location) if (class(try(form <- as.formula(object@call$minuslogl)))!="formula") stop("can only use predict() if formula specified") LHS <- form[[3]] ddist = as.character(LHS[[1]]) spref <- switch(op,predict="s",simulate="r") sdist = gsub("^d",spref,ddist) arglist = as.list(LHS)[-1] if (!exists(sdist) || !is.function(get(sdist))) stop("function ",sdist," does not exist") ## evaluate parameters ## evaluate sdist [ newdata > coef > data ] ## if (is.null(object@data)) { ## comb <- newdata ## } else { ## nmatch <- match(names(newdata),names(object@data)) ## comb <- object@data ## comb[na.omit(nmatch)] <- newdata[!is.na(nmatch)] ## comb <- c(comb,newdata[is.na(nmatch)]) ## } ## comb <- c(newdata,object@data) ## comb <- comb[!duplicated(names(comb))] ## comb <- comb[sapply(comb,length)>0] ## rvar <- strsplit(object@formula,"~")[[1]][1] ## comb <- comb[!names(comb)==rvar] ## remove response variable parameters <- eval(object@call$parameters) if (!is.null(parameters)) { vars <- as.character(sapply(parameters,"[[",2)) models <- sapply(parameters,function(z) call.to.char(z[[3]])) parameters <- parameters[models!="1"] npars <- length(parameters) if (npars==0) { ## no non-constant parameters parameters <- mmats <- vpos <- NULL } else { mmats <- list() vpos <- list() for (i in seq(along=parameters)) { vname <- vars[i] p <- parameters[[i]] p[[2]] <- NULL mmat <- with(c(newdata,object@data), model.matrix(p,data=environment())) ## c(as.list(newdata),as.list(object@data))) pnames <- paste(vname,colnames(mmat),sep=".") assign(vname,mmat %*% coef(object)[pnames]) } } } arglist1 <- lapply(arglist,eval,envir=c(newdata,object@data, as.list(coef(object))), enclos=sys.frame(sys.nframe())) ## HACK: need a way to figure out how many data points there ## are, in the *absence* of an explicit data argument ## then replicate constant values to the full length if (op=="simulate") { if (length(object@data)==0) stop("need explicit data argument for simulation") ndata <- max(sapply(c(newdata,object@data),length)) ## ??? arglist1 <- c(arglist1,list(n=ndata*nsim)) } vals <- with(as.list(coef(object)),do.call(sdist,arglist1)) if (op=="predict") return(vals[[location]]) else return(vals) } bbmle/R/IC.R0000755000176200001440000002312713576553030012171 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.R0000755000176200001440000007667013571741663012474 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, ...) { 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") if (length(nfix)>0) start[nfix] <- NULL fullcoef[nfix] <- fixed ## switched namedrop() from outside to inside sapply ? nstart <- names(unlist(sapply(namedrop(start),eval.parent))) fullcoef[! nfull %in% nfix & ! nfull %in% nstart ] <- NULL ## delete unnecessary names nfull <- names(fullcoef) lc <- length(call$lower) lu <- length(call$upper) npnfix <- sum(!nfull %in% nfix) if (!npnfix==0 && (lu>npnfix || lc>npnfix )) { warning("length mismatch between lower/upper ", "and number of non-fixed parameters: ", "# lower=",lc,", # upper=",lu,", # non-fixed=",npnfix) } template <- lapply(start, eval.parent) ## preserve list structure! if (vecpar) template <- unlist(template) start <- sapply(namedrop(start), eval.parent) # expressions are allowed; added namedrop nstart <- names(unlist(namedrop(start))) ## named <- length(names(fullcoef)) oo <- match(nstart, names(fullcoef)) if (any(is.na(oo))) stop("some named arguments in 'start' are not arguments to the specified log-likelihood function") ## if (named) start <- start[order(oo)] ## rearrange lower/upper to same order as "start" ## FIXME: use names to rearrange if present fix_order <- function(c1,name,default=NULL) { if (!is.null(c1)) { if (length(unique(c1))>1) { ## not all the same if (is.null(names(c1)) && length(unique(c1))>1) { warning(name," not named: rearranging to match 'start'") oo2 <- oo } else oo2 <- match(names(unlist(namedrop(c1))),names(fullcoef)) c1 <- c1[order(oo2)] } } else c1 <- default c1 } call$lower <- fix_order(call$lower,"lower bounds",-Inf) call$upper <- fix_order(call$upper,"upper bounds",Inf) call$control$parscale <- fix_order(call$control$parscale,"parscale") call$control$ndeps <- fix_order(call$control$ndeps,"ndeps") if (is.null(call$control)) call$control <- list() ## attach(data,warn.conflicts=FALSE) ## on.exit(detach(data)) denv <- local(environment(),c(as.list(data),fdata,list(mleenvset=TRUE))) ## denv <- local(new.env(),c(as.list(data),fdata,list(mleenvset=TRUE))) argnames.in.data <- names(data)[names(data) %in% names(formals(minuslogl))] args.in.data <- lapply(argnames.in.data,get,env=denv) names(args.in.data) <- argnames.in.data args.in.data ## codetools kluge objectivefunction <- function(p){ if (browse_obj) browser() l <- relist2(p,template) ## redo list structure ## if (named) names(p) <- nstart[order(oo)] ## make sure to reorder ## ??? useless, comes after l is constructed ??? l[nfix] <- fixed ## cat("p\n"); print(p) ## cat("l\n"); print(l) ## cat("data\n"); print(data) if (vecpar) { ## if (named) l <- namedrop(l[nfull]) l <- unlist(l) args <- list(l) args <- c(list(l),args.in.data) } else { args <- c(l,args.in.data) } ## eval in environment of minuslogl??? ## doesn't help, environment(minuslogl) is empty by this time ## cat("e3:",length(ls(envir=environment(minuslogl))),"\n") ## hack to remove unwanted names ... do.call("minuslogl",namedrop(args)) } ## end of objective function objectivefunctiongr <- if (!is.null(gr)) function(p) { if (browse_obj) browser() l <- relist2(p,template) ## redo list structure names(p) <- nstart[order(oo)] ## make sure to reorder l[nfix] <- fixed if (vecpar) { l <- namedrop(l[nfull]) l <- unlist(l) args <- list(l) args <- c(list(l),args.in.data) } else { args <- c(l,args.in.data) } v <- do.call("gr",args) if (is.null(names(v))) { if (length(v)==length(l) && !is.null(tt <- names(l))) { ## try to set names from template vnames <- tt } else if (length(v)==length(p) && !is.null(tt <- names(p))) { ## try to set names from params vnames <- tt } else if (!is.null(tt <- parnames(minuslogl))) { ## names were set as an attribute of the function vnames <- tt } else vnames <- names(formals(minuslogl)) if (length(vnames)!=length(v)) stop("name/length mismatch in gradient function") names(v) <- vnames } return(v[!names(v) %in% nfix]) ## from Eric Weese } ## end of gradient function ## FIXME: try to do this by assignment into appropriate ## environments rather than replacing them ... ## only set env if environment has not been previously set! if (!("mleenvset" %in% ls(envir=environment(minuslogl)))) { newenv <- new.env(hash=TRUE,parent=environment(minuslogl)) d <- as.list(denv) mapply(assign,names(d),d, MoreArgs=list(envir=newenv)) environment(minuslogl) <- newenv if (!is.null(gr)) { newenvgr <- new.env(hash=TRUE,parent=environment(minuslogl)) mapply(assign,names(d),d, MoreArgs=list(envir=newenvgr)) environment(gr) <- newenvgr } } if (length(start)==0 || eval.only) { if (length(start)==0) start <- numeric(0) optimizer <- "none" skip.hessian <- TRUE oout <- list(par=start, value=objectivefunction(start), hessian = matrix(NA,nrow=length(start),ncol=length(start)), convergence=0) } else { oout <- switch(optimizer, optim = { arglist <- list(...) arglist$lower <- arglist$upper <- arglist$control <- NULL do.call("optim", c(list(par=start, fn=objectivefunction, method=method, hessian=FALSE, gr=objectivefunctiongr, control=call$control, lower=call$lower, upper=call$upper), arglist)) }, optimx = { ## don't ask, will get us into ## dependency hell ## require("optimx") arglist <- list(...) arglist$lower <- arglist$upper <- arglist$control <- NULL do.call("optimx", c(list(par=start, fn=objectivefunction, method=method, hessian=FALSE, gr=objectivefunctiongr, control=call$control, lower=call$lower, upper=call$upper), arglist)) }, nlm = nlm(f=objectivefunction, p=start, hessian=FALSE, ...), ##!skip.hessian, ## nlminb = nlminb(start=start, objective=objectivefunction, hessian=NULL, ...), constrOptim = constrOptim(theta=start, f=objectivefunction, method=method, ...), optimize=, optimise= optimize(f=objectivefunction, interval=c(call$lower,call$upper), ...), user = { arglist <- list(...) arglist$lower <- arglist$upper <- arglist$control <- NULL do.call(optimfun, c(list(par=start, fn=objectivefunction, method=method, hessian=FALSE, gr=objectivefunctiongr, control=call$control, lower=call$lower, upper=call$upper), arglist)) }, stop("unknown optimizer (choices are 'optim', 'nlm', 'nlminb', 'constrOptim', 'user', and 'optimi[sz]e')") ) } optimval <- switch(optimizer, optim= , constrOptim=, optimx=, user=, none="value", nlm="minimum", optimize=, optimise=, nlminb="objective") if (optimizer=="optimx") { fvals <- oout[["value"]] conv <- oout[["convcode"]] ## best <- if (!any(conv==0)) { best <- which.min(fvals) ## } else { ## fvals <- fvals[conv==0] ## which.min(fvals) ## } oout <- list(par=as.numeric(unlist(oout[best,1:attr(oout,"npar")])), value=fvals[best], convergence=conv[best], method.used=attr(oout,"details")[,"method"][[best]]) ## FIXME: should do profiles only with best method for MLE? } if (optimizer=="nlm") { oout$par <- oout$estimate oout$convergence <- oout$code } if (optimizer %in% c("optimise","optimize")) { oout$par <- oout$minimum oout$convergence <- 0 ## can't detect non-convergence } if (optimizer %in% c("nlminb","optimise","optimize") || ## optimizer (bobyqa?) may have stripped names -- try to restore them! is.null(names(oout$par))) { names(oout$par) <- names(start) } ## compute Hessian if (length(oout$par)==0) skip.hessian <- TRUE if (!skip.hessian) { if ((!is.null(call$upper) || !is.null(call$lower)) && any(oout$par==call$upper) || any(oout$par==call$lower)) warning("some parameters are on the boundary: variance-covariance calculations based on Hessian may be unreliable") } namatrix <- matrix(NA,nrow=length(start),ncol=length(start)) if (!skip.hessian) { psc <- call$control$parscale if (is.null(gr)) { if (is.null(psc)) { oout$hessian <- try(hessian(objectivefunction,oout$par, method.args=hessian.opts)) } else { tmpf <- function(x) { objectivefunction(x*psc) } oout$hessian <- try(hessian(tmpf,oout$par/psc, method.args=hessian.opts))/outer(psc,psc) } } else { ## gradient provided if (is.null(psc)) { oout$hessian <- try(jacobian(objectivefunctiongr,oout$par, method.args=hessian.opts)) } else { tmpf <- function(x) { objectivefunctiongr(x*psc) } oout$hessian <- try(jacobian(tmpf,oout$par/psc, method.args=hessian.opts))/outer(psc,psc) } } } if (skip.hessian || inherits(oout$hessian,"try-error")) oout$hessian <- namatrix coef <- oout$par nc <- names(coef) if (skip.hessian) { tvcov <- matrix(NA,length(coef),length(coef)) } else { if (length(coef)) { if (use.ginv) { tmphess <- try(MASS::ginv(oout$hessian),silent=TRUE) } else { tmphess <- try(solve(oout$hessian,silent=TRUE)) } if (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 } 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.R0000754000176200001440000000250713171403641013627 0ustar liggesusers## must go before setAs to avoid warnings setClass("mle2", slots=c(call = "language", call.orig = "language", coef = "numeric", fullcoef = "numeric", vcov = "matrix", min = "numeric", details = "list", minuslogl = "function", method = "character", data="list", formula="character", optimizer="character")) setAs("mle","mle2", function(from,to) { new("mle2", call=from@call, call.orig=from@call, coef=from@coef, fullcoef=from@fullcoef, vcov=from@vcov, min=from@min, details=from@details, minuslogl=from@minuslogl, method=from@method, data=list(), formula="", optimizer="optim") }) setClass("summary.mle2", slots=c(call = "language", coef = "matrix", m2logL = "numeric")) setClass("profile.mle2", slots=c(profile="list", summary="summary.mle2")) setClass("slice.mle2", slots=c(profile="list", summary="summary.mle2")) setIs("profile.mle2", "slice.mle2") bbmle/R/mle2-methods.R0000755000176200001440000001410513072036511014161 0ustar liggesusers## setGeneric("formula", function(x, env = parent.frame(), ...) { ## standardGeneric("formula")}) ## don't know why behaviour of anova() and formula() are different? ## (used setGeneric for anova() without trouble, caused problems here) ## trying to avoid "creating a new generic" message on install? setMethod("formula", "mle2", function(x, env = parent.frame(), ...) { as.formula(x@formula) }) ## stdEr <- function(x, ...) { ## UseMethod("stdEr") ## } setGeneric("stdEr", function(x, ...) { standardGeneric("stdEr")}) setMethod("stdEr","mle2", function(x, ...) { sqrt(diag(x@vcov)) ## why doesn't vcov(x) work here??? }) ## should this be object@fullcoef or object@coef??? or should ## it have an additional argument --- is that possible? setMethod("coef", "mle2", function(object,exclude.fixed=FALSE) { if (!exclude.fixed) object@fullcoef else object@coef }) ## fullcoef <- function(object) object@fullcoef ## this should be a method setMethod("coef", "summary.mle2", function(object) { object@coef }) ## hmmm. Work on this. 'hessian' conflicts with numDeriv definition. Override? ## setMethod("Hessian", sig="mle2", function(object) { object@details$hessian }) setMethod("show", "mle2", function(object){ cat("\nCall:\n") print(object@call.orig) cat("\nCoefficients:\n") print(coef(object)) cat("\nLog-likelihood: ") cat(round(as.numeric(logLik(object)),2),"\n") if (object@optimizer=="optimx" && length(object@method)>1) { cat("Best method:",object@details$method.used,"\n") } if (object@details$conv>0) cat("\nWarning: optimization did not converge (code ", object@details$convergence,": ",object@details$message,")\n",sep="") }) setMethod("show", "summary.mle2", function(object){ cat("Maximum likelihood estimation\n\nCall:\n") print(object@call) cat("\nCoefficients:\n") printCoefmat(coef(object)) cat("\n-2 log L:", object@m2logL, "\n") }) setMethod("show", "profile.mle2", function(object){ cat("Likelihood profile:\n\n") print(object@profile) }) setMethod("summary", "mle2", function(object, waldtest=TRUE, ...){ cmat <- cbind(Estimate = object@coef, `Std. Error` = sqrt(diag(object@vcov))) zval <- cmat[,"Estimate"]/cmat[,"Std. Error"] pval <- 2*pnorm(-abs(zval)) coefmat <- cbind(cmat,"z value"=zval,"Pr(z)"=pval) m2logL <- 2*object@min new("summary.mle2", call=object@call.orig, coef=coefmat, m2logL= m2logL) }) setMethod("logLik", "mle2", function (object, ...) { if(length(list(...))) warning("extra arguments discarded") val <- -object@min attr(val, "df") <- length(object@coef) attr(val, "nobs") <- attr(object,"nobs") class(val) <- "logLik" val }) setGeneric("deviance", function(object, ...) standardGeneric("deviance")) setMethod("deviance", "mle2", function (object, ...) { -2*logLik(object) }) setMethod("vcov", "mle2", function (object, ...) { object@vcov } ) setGeneric("anova", function(object, ...) standardGeneric("anova")) setMethod("anova","mle2", function(object,...,width=getOption("width"), exdent=10) { mlist <- c(list(object),list(...)) ## get names from previous call mnames <- sapply(sys.call(sys.parent())[-1],deparse) ltab <- as.matrix(do.call("rbind", lapply(mlist, function(x) { c("Tot Df"=length(x@coef), Deviance=-2*logLik(x)) }))) terms=sapply(mlist, function(obj) { if (is.null(obj@formula) || obj@formula=="") { mfun <- obj@call$minuslogl mfun <- paste("[",if (is.name(mfun)) { as.character(mfun) } else { "..." }, "]",sep="") paste(mfun,": ",paste(names(obj@coef), collapse="+"),sep="") } else { as.character(obj@formula) } }) mterms <- paste("Model ", 1:length(mnames),": ",mnames,", ",terms,sep="") mterms <- strwrapx(mterms,width=width,exdent=exdent, wordsplit="[ \n\t]") ## trunc.term <- function(s,len) { ## ## cat("***",nchar(s),length(grep("\\+",s)),"\n",sep=" ") ## if ((nchar(s)Chisq)"=c(NA,pchisq(ltab[,"Chisq"][-1], ltab[,"Df"][-1],lower.tail=FALSE))) rownames(ltab) <- 1:nrow(ltab) attr(ltab,"heading") <- heading class(ltab) <- "anova" ltab }) ## translate from profile to data frame, as either ## S3 or S4 method as.data.frame.profile.mle2 <- function(x, row.names = NULL, optional = FALSE, ...) { m1 <- mapply(function(vals,parname) { ## need to unpack the vals data frame so that ## parameter names show up properly do.call("data.frame", c(list(param=rep(parname,nrow(vals))), as.list(vals),focal=list(vals$par.vals[,parname]))) }, x@profile, as.list(names(x@profile)), SIMPLIFY=FALSE) m2 <- do.call("rbind",m1) m2 } setAs("profile.mle2","data.frame", function(from) { as.data.frame.profile.mle2(from) }) ## causes infinite loop, and unnecessary anyway?? ## BIC.mle2 <- stats4:::BIC bbmle/R/slice.R0000755000176200001440000003045213046671362012775 0ustar liggesusers## TO DO: roll back into bbmle? ## allow multiple 'transects'? ## (i.e. if two sets of parameters are given ...) ## * robustification ## print method ## allow manual override of ranges ## allow log-scaling? ## preserve order of parameters in 1D plots ## substitute values of parameters into full parameter vector mkpar <- function(params,p,i) { params[i] <- p params } ## get reasonable range for slice ## document what is done here ## implement upper bound ## more robust approaches; ## try not to assume anything about signs of parameters ## inherit bounds from fitted value get_trange <- function(pars, ## baseline parameter values i, ## focal parameter fun, ## objective function lower=-Inf, ## lower bound upper=Inf, ## upper bound cutoff=10, ## increase above min z-value maxit=200, ## max number of iterations steptype=c("mult","addprop"), step=0.1) { ## step possibilities: multiplicative ## additive (absolute scale) [not yet implemented] addabs <- NULL ## fix false positive test steptype <- match.arg(steptype) v <- v0 <- fun(pars) lowval <- pars[i] it <- 1 if (steptype=="addprop") step <- step*pars[i] while (itlower && v<(v0+cutoff)) { lowval <- switch(steptype, addabs, addpropn=lowval-step, mult=lowval*(1-step)) v <- fun(mkpar(pars,lowval,i)) it <- it+1 } lowdev <- v lowit <- it upval <- pars[i] it <- 1 v <- v0 <- fun(pars) if (upval==0) upval <- 1e-4 while (it=lower & x<=upper)) if (any(!OK)) { warning("some parameter sets outside of bounds were removed") slicep <- slicep[OK] slicepars <- slicepars[OK,] } v <- apply(slicepars, 1, fun) slices <- list(data.frame(var1="trans",x=slicep,z=v)) r <- list(slices=slices,params=params,params2=params2,dim=1) class(r) <- "slice" r } slice1D <- function(params,fun,nt=101, lower=-Inf, upper=Inf, verbose=TRUE, tranges=NULL, ...) { npv <- length(params) if (is.null(pn <- names(params))) pn <- seq(npv) if (is.null(tranges)) { tranges <- get_all_trange(params,fun, rep(lower,length.out=npv), rep(upper,length.out=npv), ...) } slices <- vector("list",npv) for (i in 1:npv) { tvec <- seq(tranges[i,1],tranges[i,2],length=nt) if (verbose) cat(pn[i],"\n") vtmp <- sapply(tvec, function(t) { fun(mkpar(params,t,i))}) slices[[i]] <- data.frame(var1=pn[i],x=tvec,z=vtmp) } r <- list(slices=slices,ranges=tranges,params=params,dim=1) class(r) <- "slice" r } ## OLD slice method ## should probably roll this in as an option to profile ## include attribute, warning? draw differently (leave off ## conf. limit lines) ## slice <- function(fitted, ...) UseMethod("slice") ## 1D slicing implemented as in profile sliceOld <- function (fitted, which = 1:p, maxsteps = 100, alpha = 0.01, zmax = sqrt(qchisq(1 - alpha/2, p)), del = zmax/5, trace = FALSE, tol.newmin=0.001, ...) { onestep <- function(step) { bi <- B0[i] + sgn * step * del * std.err[i] fix <- list(bi) names(fix) <- p.i call$fixed <- c(fix,eval(call$fixed)) call$eval.only = TRUE pfit <- try(eval(call), silent=TRUE) ## if(inherits(pfit, "try-error")) return(NA) else { zz <- 2*(pfit@min - fitted@min) ri <- pv0 ri[, names(pfit@coef)] <- pfit@coef ri[, p.i] <- bi if (zz > -tol.newmin) zz <- max(zz, 0) else stop("profiling has found a better solution, so original fit had not converged") z <- sgn * sqrt(zz) pvi <<- rbind(pvi, ri) zi <<- c(zi, z) ## NB global set! } if (trace) cat(bi, z, "\n") z } ## Profile the likelihood around its maximum ## Based on profile.glm in MASS summ <- summary(fitted) std.err <- summ@coef[, "Std. Error"] Pnames <- names(B0 <- fitted@coef) pv0 <- t(as.matrix(B0)) p <- length(Pnames) prof <- vector("list", length = length(which)) names(prof) <- Pnames[which] call <- fitted@call call$minuslogl <- fitted@minuslogl for (i in which) { zi <- 0 pvi <- pv0 p.i <- Pnames[i] for (sgn in c(-1, 1)) { if (trace) cat("\nParameter:", p.i, c("down", "up")[(sgn + 1)/2 + 1], "\n") step <- 0 z <- 0 ## This logic was a bit frail in some cases with ## high parameter curvature. We should probably at least ## do something about cases where the mle2 call fails ## because the parameter gets stepped outside the domain. ## (We now have.) call$start <- as.list(B0) lastz <- 0 while ((step <- step + 1) < maxsteps && abs(z) < zmax) { z <- onestep(step) if(is.na(z)) break lastz <- z } if(abs(lastz) < zmax) { ## now let's try a bit harder if we came up short for(dstep in c(0.2, 0.4, 0.6, 0.8, 0.9)) { z <- onestep(step - 1 + dstep) if(is.na(z) || abs(z) > zmax) break } } else if(length(zi) < 5) { # try smaller steps mxstep <- step - 1 step <- 0.5 while ((step <- step + 1) < mxstep) onestep(step) } } si <- order(pvi[, i]) prof[[p.i]] <- data.frame(z = zi[si]) prof[[p.i]]$par.vals <- pvi[si,, drop=FALSE] } list(profile = prof, summary = summ) } ## * is it possible to set up the 2D vectors so they include ## the baseline value? maybe not easily ... slice2D <- function(params, fun, nt=31, lower=-Inf, upper=Inf, cutoff=10, verbose=TRUE, tranges=NULL, ...) { npv <- length(params) if (is.null(pn <- names(params))) pn <- seq(npv) if (is.null(tranges)) { tranges <- get_all_trange(params,fun, rep(lower,length.out=npv), rep(upper,length.out=npv), cutoff=cutoff, ...) } slices <- list() for (i in 1:(npv-1)) { slices[[i]] <- vector("list",npv) for (j in (i+1):npv) { if (verbose) cat("param",i,j,"\n") t1vec <- seq(tranges[i,1],tranges[i,2],length=nt) t2vec <- seq(tranges[j,1],tranges[j,2],length=nt) mtmp <- matrix(nrow=nt,ncol=nt) for (t1 in seq_along(t1vec)) { for (t2 in seq_along(t2vec)) { mtmp[t1,t2] <- fun(mkpar(params,c(t1vec[t1],t2vec[t2]), c(i,j))) } } slices[[i]][[j]] <- data.frame(var1=pn[i],var2=pn[j], expand.grid(x=t1vec,y=t2vec), z=c(mtmp)) } } r <- list(slices=slices,ranges=tranges,params=params,dim=2) class(r) <- "slice" r } ## flatten slice: ## do.call(rbind,lapply(slices,do.call,what=rbind)) slices_apply <- function(s,FUN,...) { for (i in seq_along(s)) { for (j in seq_along(s[[i]])) { if (!is.null(s[[i]][[j]])) { s[[i]][[j]] <- FUN(s[[i]][[j]],...) } } } s } xyplot.slice <- function(x,data,type="l",scale.min=TRUE,...) { allslice <- do.call(rbind,x$slices) ## correct ordering allslice$var1 <- factor(allslice$var1, levels=unique(as.character(allslice$var1))) if (scale.min) allslice$z <- allslice$z-min(allslice$z) pfun <- function(x1,y1,...) { panel.xyplot(x1,y1,...) if (is.null(x$params2)) { ## regular 1D slice panel.abline(v=x$params[panel.number()],col="gray") } else { ## 'transect' slice panel.abline(v=c(0,1),col="gray") panel.abline(h=y1[x1 %in% c(0,1)],col="gray") } } xyplot(z~x|var1,data=allslice,type=type, scales=list(x=list(relation="free")), panel=pfun,...) } splom.slice <- function(x, data, scale.min=TRUE, at=NULL, which.x=NULL, which.y=NULL, dstep=4, contour=FALSE,...) { if (x$dim==1) stop("can't do splom on 1D slice object") smat <- t(x$ranges[,1:2]) if (scale.min) { ## FIXME: something more elegant to flatten slice list? all.z <- unlist(sapply(x$slices, function(x) { sapply(x, function(x) if (is.null(x)) NULL else x[["z"]]) })) min.z <- min(all.z[is.finite(all.z)]) ## round up to next multiple of 'dstep' max.z <- dstep * ((max(all.z[is.finite(all.z)])- min.z) %/% dstep + 1) if (missing(at)) { at <- seq(0,max.z,by=dstep) } scale.z <- function(X) { X$z <- X$z-min.z X } x$slices <- slices_apply(x$slices,scale.z) } up0 <- function(x1, y, groups, subscripts, i, j, ...) { ## browser() sl <- x$slices[[j]][[i]] with(sl,panel.levelplot(x=x,y=y,z=z,contour=contour, at=if (!is.null(at)) at else pretty(z), subscripts=seq(nrow(sl)))) panel.points(x$params[j],x$params[i],pch=16) mm <- matrix(sl$z,nrow=length(unique(sl$x))) ## FIXME: more robust ... wmin <- which(mm==min(mm),arr.ind=TRUE) xmin <- unique(sl$x)[wmin[1]] ymin <- unique(sl$y)[wmin[2]] panel.points(xmin,ymin,pch=1) } lp0 <- function(...) { } ## FIXME: use ?draw.colorkey to add a legend ... ## FIXME: make diagonal panel text smaller ??? splom(smat,lower.panel=lp0,diag.panel=diag.panel.splom, upper.panel=up0,...) } ## generic profiling code??? ## either need (1) optimizers with 'masks' or (2) bbmle/R/profile.R0000755000176200001440000004623013571743647013350 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.R0000644000176200001440000001562113502542652013336 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 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) #' @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, 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] vv <- vcov(object) vv <- vv[keep_params,keep_params] Lfun <- object@minuslogl 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(vv)) if (!bad_vcov) { min_eig <- min_eval(vv) } 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=vv,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) L_wts0 <- -1*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/MD50000644000176200001440000001367113616005502011651 0ustar liggesusers7c858fabe09664c23debf08aef3000c5 *DESCRIPTION 4a1b816656212461184b14d0bc631fb0 *NAMESPACE 51c80cbebf520b0ab4ff12482aaba1f1 *R/IC.R 3547798b5af91c95a35a011f2a3bffa4 *R/confint.R c9cc17451c8dc1829431e2eccd315188 *R/dists.R 06a077b7e509b3f63c314031bc0e3b93 *R/impsamp.R 9f6efaa1f3b8d8bfeeedee6c30c2caa9 *R/mle.R c4261cd6324f185a4c20caadde9d38ff *R/mle2-class.R 2a2bfa30b9feb9251dabf7d17f1d1246 *R/mle2-methods.R 2d3da6aaa0a07bd64c320a718d87d31e *R/predict.R e826fb38e19883fcd675abc903c369cf *R/profile.R 2c39b590a0c236bff22bb00252544082 *R/slice.R 28b4b4a714c1beebcc7516b888e1b641 *R/update.R 5823f8cd791ae8b928578e26674be46f *TODO 552c67a4dde80416558e696e6c9b3b64 *build/vignette.rds 18807b2d1cfaeec743db500f3a628dfb *inst/NEWS.Rd 4267a22cc46700d620e4cc371a60b6d9 *inst/doc/mle2.R e8c369ae9771830ce616d69a1983031b *inst/doc/mle2.Rnw 54ad2cfc40c6be033863f8be40841b20 *inst/doc/mle2.pdf b337e45ba4de491f49dcc9b67e5b6c0d *inst/doc/quasi.R f9f39bc36192d155f6d71dba2f50e560 *inst/doc/quasi.Rnw 6f047536249d6ffc598cc0680eea63eb *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 226b69b0b92aa550658115bb76b9dc9f *man/mle2.Rd 43212e571f06f29b0e9c1ad5af89ecc4 *man/mle2.options.Rd 5402485d416bd59d04bbf4c4ea34c999 *man/namedrop.Rd 7a0bc1dbcb08bc40ee81b7870967c1ef *man/parnames.Rd c897107a288ba5fc47735375e3b0b59b *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 5cdd0fabd0d7c9abfb85a43f172568d1 *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 17ccf28899a9d3221ed27a69affdd5b7 *tests/profbound.R e855663462e1a8e4bb5161ff4825aa8f *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 e8c369ae9771830ce616d69a1983031b *vignettes/mle2.Rnw ae21998f0dafa40e30841d4abc02ceed *vignettes/mle2.bib f9f39bc36192d155f6d71dba2f50e560 *vignettes/quasi.Rnw bbmle/inst/0000755000176200001440000000000013615572112012313 5ustar liggesusersbbmle/inst/doc/0000755000176200001440000000000013615631572013066 5ustar liggesusersbbmle/inst/doc/mle2.Rnw0000754000176200001440000007541313576557173014443 0ustar liggesusers\documentclass{article} %\VignetteIndexEntry{Examples for enhanced mle code} %\VignettePackage{bbmle} %\VignetteDepends{Hmisc} %\VignetteDepends{emdbook} %\VignetteDepends{ggplot2} %\VignetteDepends{lattice} %\VignetteEngine{knitr::knitr} \usepackage[utf8]{inputenc} % for UTF-8/single quotes from sQuote() \usepackage[english]{babel} % for texi2dvi ~ bug \usepackage{graphicx} \usepackage{natbib} \usepackage{array} \usepackage{color} \usepackage[colorlinks=true,urlcolor=blue,bookmarks=true]{hyperref} \usepackage{url} \author{Ben Bolker} \title{Maximum likelihood estimation and analysis with the \code{bbmle} package} \newcommand{\code}[1]{{\tt #1}} \newcommand{\bbnote}[1]{\color{red} {\em #1} \color{black}} \date{\today} \begin{document} \bibliographystyle{chicago} %\bibliographystyle{plain} \maketitle \tableofcontents <>= if (require("knitr")) opts_chunk$set(fig.width=5,fig.height=5,tidy=FALSE,warning=FALSE,error=TRUE) @ <>= library(Hmisc) @ The \code{bbmle} package, designed to simplify maximum likelihood estimation and analysis in R, extends and modifies the \code{mle} function and class in the \code{stats4} package that comes with R by default. \code{mle} is in turn a wrapper around the \code{optim} function in base R. The maximum-likelihood-estimation function and class in \code{bbmle} are both called \code{mle2}, to avoid confusion and conflict with the original functions in the \code{stats4} package. The major differences between \code{mle} and \code{mle2} are: \begin{itemize} \item \code{mle2} is more robust, with additional warnings (e.g. if the Hessian can't be computed by finite differences, \code{mle2} returns a fit with a missing Hessian rather than stopping with an error) \item \code{mle2} uses a \code{data} argument to allow different data to be passed to the negative log-likelihood function \item \code{mle2} has a formula interface like that of (e.g.) \code{gls} in the \code{nlme} package. For relatively simple models the formula for the maximum likelihood can be written in-line, rather than defining a negative log-likelihood function. The formula interface also simplifies fitting models with categorical variables. Models fitted using the formula interface also have applicable \code{predict} and \code{simulate} methods. \item \code{bbmle} defines \code{anova}, \code{AIC}, \code{AICc}, and \code{BIC} methods for \code{mle2} objects, as well as \code{AICtab}, \code{BICtab}, \code{AICctab} functions for producing summary tables of information criteria for a set of models. \end{itemize} Other packages with similar functionality (extending GLMs in various ways) are \begin{itemize} \item on CRAN: \code{aods3} (overdispersed models such as beta-binomial); \code{vgam} (a wide range of models); \code{betareg} (beta regression); \code{pscl} (zero-inflated, hurdle models); \code{maxLik} (another general-purpose maximizer, with a different selection of optimizers) \item In Jim Lindsey's code repository (\url{http://popgen.unimaas.nl/~jlindsey/rcode.html}): \code{gnlr} and \code{gnlr3} \end{itemize} \section{Example: \emph{Orobanche}/overdispersed binomial} This example will use the classic data set on \emph{Orobanche} germination from \cite{Crowder1978} (you can also use \code{glm(...,family="quasibinomial")} or the \code{aods3} package to analyze these data). \subsection{Test basic fit to simulated beta-binomial data} First, generate a single beta-binomially distributed set of points as a simple test. Load the \code{emdbook} package to get functions for the beta-binomial distribution (random-deviate function \code{rbetabinom} --- these functions are also available in Jim Lindsey's \code{rmutil} package). <>= library(emdbook) @ Generate random deviates from a random beta-binomial: <>= set.seed(1001) x1 <- rbetabinom(n=1000,prob=0.1,size=50,theta=10) @ Load the package: <>= library(bbmle) @ Construct a simple negative log-likelihood function: <>= mtmp <- function(prob,size,theta) { -sum(dbetabinom(x1,prob,size,theta,log=TRUE)) } @ Fit the model --- use \code{data} to pass the \code{size} parameter (since it wasn't hard-coded in the \code{mtmp} function): <>= (m0 <- mle2(mtmp,start=list(prob=0.2,theta=9),data=list(size=50))) @ (here and below, I'm suppressing lots of warnings about {\tt NaNs produced}) The \code{summary} method for \code{mle2} objects shows the parameters; approximate standard errors (based on quadratic approximation to the curvature at the maximum likelihood estimate); and a test of the parameter difference from zero based on this standard error and on an assumption that the likelihood surface is quadratic (or equivalently that the sampling distribution of the estimated parameters is normal). <>= summary(m0) @ Construct the likelihood profile (you can apply \code{confint} directly to \code{m0}, but if you're going to work with the likelihood profile [e.g. plotting, or looking for confidence intervals at several different $\alpha$ values] then it is more efficient to compute the profile once): <>= p0 <- profile(m0) @ Compare the confidence interval estimates based on inverting a spline fit to the profile (the default); based on the quadratic approximation at the maximum likelihood estimate; and based on root-finding to find the exact point where the profile crosses the critical level. <>= confint(p0) confint(m0,method="quad") confint(m0,method="uniroot") @ All three types of confidence limits are similar. Plot the profiles: <>= par(mfrow=c(1,2)) plot(p0,plot.confstr=TRUE) @ By default, the plot method for likelihood profiles displays the square root of the the deviance difference (twice the difference in negative log-likelihood from the best fit), so it will be {\sf V}-shaped for cases where the quadratic approximation works well (as in this case). (For a better visual estimate of whether the profile is quadratic, use the \code{absVal=FALSE} option to the \code{plot} method.) You can also request confidence intervals calculated using \code{uniroot}, which may be more exact when the profile is not smooth enough to be modeled accurately by a spline. However, this method is also more sensitive to numeric problems. Instead of defining an explicit function for \code{minuslogl}, we can also use the formula interface. The formula interface assumes that the density function given (1) has \code{x} as its first argument (if the distribution is multivariate, then \code{x} should be a matrix of observations) and (2) has a \code{log} argument that will return the log-probability or log-probability density if \code{log=TRUE}. Some of the extended functionality (prediction etc.) depends on the existence of an \code{s}- variant function for the distribution that returns (at least) the mean and median as a function of the parameters (currently defined: \code{snorm}, \code{sbinom}, \code{sbeta}, \code{snbinom}, \code{spois}). <>= m0f <- mle2(x1~dbetabinom(prob,size=50,theta), start=list(prob=0.2,theta=9),data=data.frame(x1)) @ Note that you must specify the data via the \code{data} argument when using the formula interface. This may be slightly more unwieldy than just pulling the data from your workspace when you are doing simple things, but in the long run it makes tasks like predicting new responses much simpler. It's convenient to use the formula interface to try out likelihood estimation on the transformed parameters: <>= m0cf <- mle2(x1~dbetabinom(prob=plogis(lprob),size=50,theta=exp(ltheta)), start=list(lprob=0,ltheta=2),data=data.frame(x1)) confint(m0cf,method="uniroot") confint(m0cf,method="spline") @ In this case the answers from \code{uniroot} and \code{spline} (default) methods barely differ. \subsection{Real data (\emph{Orobanche}, \cite{Crowder1978})} Data are copied from the \code{aods3} package (but a copy is saved with the package to avoid depending on the \code{aods3} package): <>= load(system.file("vignetteData","orob1.rda",package="bbmle")) summary(orob1) @ Now construct a negative log-likelihood function that differentiates among groups: <>= ML1 <- function(prob1,prob2,prob3,theta,x) { prob <- c(prob1,prob2,prob3)[as.numeric(x$dilution)] size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } @ Results from \cite{Crowder1978}: <>= crowder.results <- matrix(c(0.132,0.871,0.839,78.424,0.027,0.028,0.032,-34.991, rep(NA,7),-34.829, rep(NA,7),-56.258), dimnames=list(c("prop diffs","full model","homog model"), c("prob1","prob2","prob3","theta","sd.prob1","sd.prob2","sd.prob3","NLL")), byrow=TRUE,nrow=3) latex(crowder.results,file="",table.env=FALSE,title="model") @ <>= (m1 <- mle2(ML1,start=list(prob1=0.5,prob2=0.5,prob3=0.5,theta=1), data=list(x=orob1))) @ Or: <>= ## would prefer ~dilution-1, but problems with starting values ... (m1B <- mle2(m~dbetabinom(prob,size=n,theta), param=list(prob~dilution), start=list(prob=0.5,theta=1), data=orob1)) @ The result warns us that the optimization has not converged; we also don't match Crowder's results for $\theta$ exactly. We can fix both of these problems by setting \code{parscale} appropriately. Since we don't bound $\theta$ (or below, $\sigma$) we get a fair number of warnings with this and the next few fitting and profiling attempts. We will ignore these for now, since the final results reached are reasonable (and match or nearly match Crowder's values); the appropriate, careful thing to do would be either to fit on a transformed scale where all real-valued parameter values were legal, or to use \code{method="L-BFGS-B"} (or \code{method="bobyqa"} with the \code{optimx} package) to bound the parameters appropriately. You can also use \code{suppressWarnings()} if you're sure you don't need to know about any warnings (beware: this will suppress \emph{all} warnings, those you weren't expecting as well as those you were \ldots) <>= opts_chunk$set(warning=FALSE) @ <>= (m2 <- mle2(ML1,start=as.list(coef(m1)), control=list(parscale=coef(m1)), data=list(x=orob1))) @ Calculate likelihood profile (restrict the upper limit of $\theta$, simply because it will make the picture below a little bit nicer): <>= p2 <- profile(m2,prof.upper=c(Inf,Inf,Inf,theta=2000)) @ Get the curvature-based parameter standard deviations (which Crowder used rather than computing likelihood profiles): <>= round(stdEr(m2),3) @ We are slightly off Crowder's numbers --- rounding error? Crowder also defines a variance (overdispersion) parameter $\sigma^2=1/(1+\theta)$. <>= sqrt(1/(1+coef(m2)["theta"])) @ Using the delta method (via the \code{deltavar} function in the \code{emdbook} package) to approximate the standard deviation of $\sigma$: <>= sqrt(deltavar(sqrt(1/(1+theta)),meanval=coef(m2)["theta"], vars="theta",Sigma=vcov(m2)[4,4])) @ Another way to fit in terms of $\sigma$ rather than $\theta$ is to compute $\theta=1/\sigma^2-1$ on the fly in a formula: <>= m2b <- mle2(m~dbetabinom(prob,size=n,theta=1/sigma^2-1), data=orob1, parameters=list(prob~dilution,sigma~1), start=list(prob=0.5,sigma=0.1)) ## ignore warnings (we haven't bothered to bound sigma<1) round(stdEr(m2b)["sigma"],3) p2b <- profile(m2b,prof.lower=c(-Inf,-Inf,-Inf,0)) @ As might be expected since the standard deviation of $\sigma$ is large, the quadratic approximation is poor: <>= r1 <- rbind(confint(p2)["theta",], confint(m2,method="quad")["theta",]) rownames(r1) <- c("spline","quad") r1 @ Plot the profile: <>= plot(p2,which="theta",plot.confstr=TRUE) @ What does the profile for $\sigma$ look like? <>= plot(p2b,which="sigma",plot.confstr=TRUE, show.points=TRUE) @ Now fit a homogeneous model: <>= ml0 <- function(prob,theta,x) { size <- x$n -sum(dbetabinom(x$m,prob,size,theta,log=TRUE)) } m0 <- mle2(ml0,start=list(prob=0.5,theta=100), data=list(x=orob1)) @ The log-likelihood matches Crowder's result: <>= logLik(m0) @ It's easier to use the formula interface to specify all three of the models fitted by Crowder (homogeneous, probabilities differing by group, probabilities and overdispersion differing by group): <>= m0f <- mle2(m~dbetabinom(prob,size=n,theta), parameters=list(prob~1,theta~1), data=orob1, start=list(prob=0.5,theta=100)) m2f <- update(m0f, parameters=list(prob~dilution,theta~1), start=list(prob=0.5,theta=78.424)) m3f <- update(m0f, parameters=list(prob~dilution,theta~dilution), start=list(prob=0.5,theta=78.424)) @ \code{anova} runs a likelihood ratio test on nested models: <>= anova(m0f,m2f,m3f) @ The various \code{ICtab} commands produce tables of information criteria; by default the results are sorted and presented as $\Delta$IC; there are various options, including printing model weights. <>= AICtab(m0f,m2f,m3f,weights=TRUE) BICtab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) AICctab(m0f,m2f,m3f,nobs=nrow(orob1),weights=TRUE) @ <>= opts_chunk$set(warning=FALSE) @ \section{Example: reed frog size predation} Data from an experiment by Vonesh \citep{VoneshBolker2005} <>= frogdat <- data.frame( size=rep(c(9,12,21,25,37),each=3), killed=c(0,2,1,3,4,5,rep(0,4),1,rep(0,4))) frogdat$initial <- rep(10,nrow(frogdat)) @ <>= library(ggplot2) @ <>= gg1 <- ggplot(frogdat,aes(x=size,y=killed))+geom_point()+ stat_sum(aes(size=..n..))+ labs(size="#")+scale_x_continuous(limits=c(0,40))+ scale_size(breaks=1:3) @ <>= m3 <- mle2(killed~dbinom(prob=c*(size/d)^g*exp(1-size/d), size=initial),data=frogdat,start=list(c=0.5,d=5,g=1)) pdat <- data.frame(size=1:40,initial=rep(10,40)) pdat1 <- data.frame(pdat,killed=predict(m3,newdata=pdat)) @ <>= m4 <- mle2(killed~dbinom(prob=c*((size/d)*exp(1-size/d))^g, size=initial),data=frogdat,start=list(c=0.5,d=5,g=1)) pdat2 <- data.frame(pdat,killed=predict(m4,newdata=pdat)) @ <>= gg1 + geom_line(data=pdat1,colour="red")+ geom_line(data=pdat2,colour="blue") @ <>= coef(m4) prof4 <- profile(m4) @ Three different ways to draw the profile: (1) Built-in method (base graphics): <>= plot(prof4) @ (2) Using \code{xyplot} from the \code{lattice} package: \setkeys{Gin}{width=\textwidth} <>= prof4_df <- as.data.frame(prof4) library(lattice) xyplot(abs(z)~focal|param,data=prof4_df, subset=abs(z)<3, type="b", xlab="", ylab=expression(paste(abs(z), " (square root of ",Delta," deviance)")), scale=list(x=list(relation="free")), layout=c(3,1)) @ (3) Using \code{ggplot} from the \code{ggplot2} package: <>= ss <-subset(prof4_df,abs(z)<3) ggplot(ss, aes(x=focal,y=abs(z)))+geom_line()+ geom_point()+ facet_grid(.~param,scale="free_x") @ \section*{Additions/enhancements/differences from \code{stats4::mle}} \begin{itemize} \item{\code{anova} method} \item{warnings on convergence failure} \item{more robust to non-positive-definite Hessian; can also specify \code{skip.hessian} to skip Hessian computation when it is problematic} \item{when profiling fails because better value is found, report new values} \item{can take named vectors as well as lists as starting parameter vectors} \item{added \code{AICc}, \code{BIC} definitions, \code{ICtab} functions} \item{added \code{"uniroot"} and \code{"quad"} options to \code{confint}} \item{more options for colors and line types etc etc. The old arguments are: <>= function (x, levels, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, absVal = TRUE, ...) {} @ The new one is: <>= function (x, levels, which=1:p, conf = c(99, 95, 90, 80, 50)/100, nseg = 50, plot.confstr = FALSE, confstr = NULL, absVal = TRUE, add = FALSE, col.minval="green", lty.minval=2, col.conf="magenta", lty.conf=2, col.prof="blue", lty.prof=1, xlabs=nm, ylab="score", show.points=FALSE, main, xlim, ylim, ...) {} @ \code{which} selects (by character vector or numbers) which parameters to plot: \code{nseg} does nothing (even in the old version); \code{plot.confstr} turns on the labels for the confidence levels; \code{confstr} gives the labels; \code{add} specifies whether to add the profile to an existing plot; \code{col} and \code{lty} options specify the colors and line types for horizontal and vertical lines marking the minimum and confidence vals and the profile curve; \code{xlabs} gives a vector of x labels; \code{ylab} gives the y label; \code{show.points} specifies whether to show the raw points computed. } \item{\code{mle.options()}} \item{\code{data} argument} \item{handling of names in argument lists} \item{can use alternative optimizers (\code{nlminb}, \code{nlm}, \code{constrOptim}, \code{optimx}, \code{optimize})} \item{uses code from \code{numDeriv} package to compute Hessians rather than built-in optimizer code} \item{by default, uses \code{MASS::ginv} (generalized inverse) rather than \code{solve} to invert Hessian (more robust to positive-semidefinite Hessians \ldots)} \item{can use \code{vecpar=TRUE} (and \code{parnames()}) to use objective functions with parameters specified as vectors (for compatibility with \code{optim} etc.)} \end{itemize} \section{Newer stuff} \textbf{To do:} \begin{itemize} \item{use \code{predict}, \code{simulate} etc. to demonstrate different parametric bootstrap approaches to confidence and prediction intervals \begin{itemize} \item use \code{predict} to get means and standard deviations, use delta method? \item use \code{vcov}, assuming quadratic profiles, with \code{predict(\ldots,newparams=\ldots)} \item prediction intervals assuming no parameter uncertainty with \code{simulate} \item both together \ldots \end{itemize} } \end{itemize} \section{Technical details} \subsection{Profiling and confidence intervals} This section describes the algorithm for constructing profiles and confidence intervals, which is not otherwise documented anywhere except in the code. * indicates changes from the version in \code{stats4:::mle} \subsubsection{Estimating standard error} In order to construct the profile for a particular parameter, one needs an initial estimate of the scale over which to vary that parameter. The estimated standard error of the parameter based on the estimated curvature of the likelihood surface at the MLE is a good guess. \begin{itemize} \item if \code{std.err} is missing, extract the standard error from the summary coefficient table (ultimately computed from \code{sqrt(diag(inverse Hessian))} of the fit) \item * a user-set value of \code{std.err} overrides this behavior unless the value is specified as \code{NA} (in which case the estimate from the previous step is used) \item * if the standard error value is still \code{NA} (i.e. the user did not specify it and the value estimated from the Hessian is missing or \code{NA}) use \code{sqrt(1/diag(hessian))}. This represents a (fairly feeble) attempt to come up with a plausible number when the Hessian is not positive definite but still has positive diagonal entries \item if all else fails, stop and * print an error message that encourages the user to specify the values with \code{std.err} \end{itemize} There may be further tricks that would help guess the appropriate scale: for example, one could guess on the basis of a comparison between the parameter values and negative log-likelihoods at the starting and ending points of the fits. On the other hand, (a) this would take some effort and still be subject to failure for sufficiently pathological fits and (b) there is some value to forcing the user to take explicit, manual steps to remedy such problems, as they may be signs of poorly defined or buggy log-likelihood functions. \subsubsection{Profiling} Profiling is done on the basis of a constructed function that minimizes the negative log-likelihood for a fixed value of the focal parameter and returns the signed square-root of the deviance difference from the minimum (denoted by $z$). At the MLE $z=0$ by definition; it should never be $<0$ unless something has gone wrong with the original fit. The LRT significance cutoffs for $z$ are equal to the usual two-tailed normal distribution cutoffs (e.g. $\pm \approx 1.96$ for 95\% confidence regions). In each direction (decreasing and increasing from the MLE for the focal parameter): \begin{itemize} \item fix the focal parameter \item adjust control parameters etc. accordingly (e.g. remove the entry for the focal parameter so that the remaining control parameters match the non-fixed parameters) \item{controls on the profiling (which can be set manually, but for which there is not much guidance in the documentation): \begin{itemize} \item \code{zmax} Maximum $z$ to aim for. (Default: \code{sqrt(qchisq(1-alpha/2, p))}) The default maximum $\alpha$ (type~I error) is 0.01. \bbnote{I don't understand this criterion. It seems to expand the size of the univariate profile to match a cutoff for the multivariate confidence region of the model. The $\chi^2$ cutoff for deviance to get the $(1-\alpha)$ multivariate confidence region (i.e., on all $p$ of the parameters) would be \code{qchisq(1-alpha,p)} --- % representing a one-tailed test on the deviance. Taking the square root makes sense, since we are working with the square root of the deviance, but I don't understand (1) why we are expanding the region to allow for the multivariate confidence region (since we are computing univariate profiles) [you could at least argue that this is conservative, making the region a little bigger than it needs to be]; (2) why we are using $1-\alpha/2$ rather than $1-\alpha$. } For comparison, \code{MASS::profile.glm} (written by Bates and Venables in 1996, ported to R by BDR in 1998) uses \code{zmax}=\code{sqrt(qchisq(1-alpha,1))} \bbnote{(this makes more sense to me \ldots)}. On the other hand, the profiling code in \code{lme4a} (the \code{profile} method for \code{merMod}, in \code{profile.R}) uses \code{qchisq(1-alphamax, nptot)} \ldots \item \code{del} Step size (scaled by standard error) (Default: \code{zmax}/5.) Presumably (?) copied from \code{MASS::profile.glm}, which says (in \code{?profile.glm}): ``[d]efault value chosen to allow profiling at about 10 parameter values.'' \item \code{maxsteps} Maximum number of profiling steps to try in each direction. (Default: 100) \end{itemize} } \item While \verb+step> stream xڽkoܸC/$..g+*kjHZ;;á^km.6Ȓ83lysi_\C&ãH9sr>?$b)=fv?`e0^Kxx͒ɖvd?bb)wg%vipbtbN(^h\H^T]]Zg aT@_/"zw*t)pɫywp|/dʏ8|"Sf3%@gw~N_r\9bq%TEA3 ,eW@or5vrnwf!}*$m[g6eY)|u%9}iC5' >zGrjYǝDm;?;K{2tJޜY5|[da#B0!;̰;geG/Neq& u}.oiA^O4=[pO *n:%"*n6MV2"7rbTl[wkc= \*/`a06JIf.jZdeUdd)u"WYR X`ѼjFԔV'Bl2%rv -tR74v[趮Zmu$גM^ ݔ, 8_| Xŀ۔!AJFeݾΚ9I Bc*% F_02=;<Mj]dmW4;脠]veBsӂvr,A }nQ. j>.=EUN6n=dTkvI(>-M6thLK-/KQg(PLjLݿ(Ob@#uā. z)wuuk'%@:uAQՅ=¼΢u+YZ$I9Q >B/1]J$yIyYl4Xmf.8謲fGW7 KЭ ah.)0V6 iMPÝ$c 'iGz4H~[{.IЄYK^62#y DNkbе."tw,""h /j\dܭ} u=L*G>ʖGDTN%CgMsWngѨRiE}bHYHLb*صD;'[Y V[_\(X,VzPC ̠j IښcIRo|)~:Juh7wR>k(@w}/tM fg QM;[rLsK jɐTf_r rnO)mZ˓LIԽ p9X9䪶?9tXȧ!o:0M-qeSX75Oꑞ}f%q_FL!c5:L5Dr[ 'v j-q&ئ2,SSnjP ZR@Gs^id dH-hK6M97CJ,nCU:m-4$UXƪ"$Ȋx[Ҵ*`ģ̜ELa̼j=8.:iGu TY(>3>Tĥ^Y9lV yed:{VԩsN4b Uf Nt jfE*x|d+*0pT>'5Mj WO I_/"Vv*k}cT0v 5MVd=&k `]z2W忞_xfFЕM%gG)Њ^$ŌxH0fPt:6F=bSL0<dž1o]$.d7Oan5#l*A% N=JN085GQ}Arp)C7q endstream endobj 4 0 obj << /Type /XObject /Subtype /Image /Width 88 /Height 31 /BitsPerComponent 8 /ColorSpace /DeviceRGB /SMask 24 0 R /Length 1462 /Filter /FlateDecode >> stream xNWq\4TM)}z*R*nZQDJHE%J+6>36r +^ > ctkf,fZ{OPxoKŕ7X#X8lbLYm|R/d6>SZ9_gIkޔgzeR nhL/T%o6[(-UAuFb.uTR ab4uu묉?Osue魻1uV3oQuo('M{+5`_w}仜}:Ia.rEP`@@p/\~5(+*?(z^ ܧ+ӎ>m^ʞzRWYL־ܷgܘjóۥ{ n)u;N'ϥ~Ǚ\rʯi +΄ژ㧏@^0\O #p|8[S[߳ D# endstream endobj 24 0 obj << /Type /XObject /Subtype /Image /Width 88 /Height 31 /BitsPerComponent 8 /ColorSpace /DeviceGray /Length 39 /Filter /FlateDecode >> stream x1 0ob+x!>  C2 endstream endobj 27 0 obj << /Length 1588 /Filter /FlateDecode >> stream x]o6=B@_.b`yt@QM>ȶG*MEIeHH"xw;ňqiZכyOBaJao~B`DX#af(3Ep"ȰlM@ bW:{DQ&$b$,O2nN^ffWL$b@Kŋ.IW,0m %Qεj6;SONw_GaG_bUlm[LҬP5dE Ӥ`M0 FoOިu:pˢUN7cHFXHB@ڦu zO<] $V7n!ECq?!ДS`Nu QGeUJfzv#͹Sڽҩ|RsyS2I:Utۥ]}i.Ox!e6*ʨ(=Q|q?|դZ2(rXA֓YQQ (,a|1QQtKg;|[ɏu[!t^l0AenJq8\L?LUp{*FRaN0_:϶'y;y; r&^jsry٧.8R5瑷hjWh(޼<3WԘaO-ZlIjXٶ3K8۪[p2RsZ (q$ꋄČr0_1VB pdMXȶLa 8:}\!# ־sb lx/8/VےTz ̍]Dx*+ oN\|! /IP) ;*4u1Ijle9 2)@C #yT ݰV7-+3^1EĬ0dPj""Ҝk7HчIK" cmicO[w6)sN ;}8a?yPI}ʞyzqA${0"қMQ0pA @>4w(ۗNUs!?X,(1, ,!AK/bl;.Sz}IL^pS{^$DQTݣ nz/q˕ʢf'126g=pQT 'G rԻ3:> stream xZo0_a{H6xN"@h*$%Y L(9w~wg`nHLvA QXIszhrM Jb"r罨 KK!*MLEƽE:nuSˌ6_G7d&R0 &=ؔcNCwoD{r܌G m(7,*(;tƟC 8`+j%kzz6L}R)5I]ja Жp3ס,uO#éqfV[U 2ݮwp80J{}I~{%a%IRl}C3aڴú4oIn1j33N=hOÕ:nN5MkLL}x!a6dH A<j~{nwFt}Wr/(;x;ʖL+Ν.C]aggMK:֋Ζ+gDtRzq5r_4t\Y0P`2^ؽ_U endstream endobj 39 0 obj << /Length 1319 /Filter /FlateDecode >> stream xko6CF_l  +F!r~oQlIYX4;(lG:sO R#V+>yZs)0}0-[J^>&I: k%p%v0ŕ빍AE HV&TѼm8Z*$)t!oua :rI5|hz(A mDA2~Bٔ<uf(*껛yKyFc+ng2ˊ66S[oxuj!ԗ`W檓PqJj~=Z& P O'݆j j$?""SfỮHsQЪr׬yl)0?r$=Tu-F*_kٮc,8iޕq얖R-B^ է^cXi,3jF1t(F\Fo;wP7]wZoU'T)[V/X8Hd?X?0{uVq4ć m%:-AYXа܏܆<5FcSLfvU5U5XE&_GpYeeslKSee E#jV7UN r-C2yк >"%zv']ĉk Wˑ Dz> stream xr6_qJM,0LM393}H$o.ʤ";R{2$ayd41[ 8E|/;s>G9 ᅜI(<@: ǀƠf';Mp2Q< a4hoVJ"GuxuDv@O>ۧiq'%ɍދJp-1Q|utkFV*ٵ]O~9~7tudl!; = X9!aHH)0Ss=]f`7ne> o[ Jht/ OI7*MtNSqT?)[ x6=KMa¯cMvx6{ k!g^S|X! J ZFY⪯jJ ldj١vT{cmW>%/ךO-@[guS^UsȿvW]V"%RU{3YztUy%bYm[WG>;̈P@f]QW;:3.=N-*b:ymG|rɌk]Lf<ܾҝs*.xI8K7;뱆 4w϶k!# ivr SZHFn Sc46 ˞}OCL e#ޱ0o 4W&uX\ӷ_L}r-ia\՝j_B p#4/.&LoG2_eᳰ{YQbKBde€c-U'+UGg+[%÷Qdc]V,!|[ցɕFX1rYMXwH~W?ac8)4yn阾,6Va%:ZʂF80P뢚[0!2rc# RhQ>?W[Y[U /\{fP$eX+Z8;UٍV֢e+ 4NFKY͔vuI_. & ?Ӳm1;qkYA#AᙞO/B~vTv]B $WTTzB#­cS'vwU3 & Bxl#M^K NȰ=8k@ẴHYcqk/T#ׂa[?N<ۨy%'n"ύ0^vʺq@^)um)*`BKVdObE%B|0bdp6#!p[t![l1w[1m Q1X{f$|ψ 45&?/צ ҰnMޟ'[Ǩ+8`Z 4'΋54LdGcYƁL_X@C$ 4Nab|o5 L8>sW {+1 vG!h*"\P\0CBM88MXs1L}F,Y& @A5ĎHI sȞ퉱6'X# h֬+OЀ |ZđP4kz endstream endobj 58 0 obj << /Length1 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 60 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 62 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 64 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 66 0 obj << /Length1 1575 /Length2 8259 /Length3 0 /Length 9299 /Filter /FlateDecode >> stream xڍT.SCZ(VKw-Vܥ@"Jq+^ã=s[Y+7lf-nY+'K ȫk@ Ypefև]N0B<ԝ`UWOXODb!: 7@`3;9{¡6cfp:BP0P!l!'A'0l8/;х n#p"l b0@3lf-O5 P0 tT؟d? \f;_ѿAaA`3 ~A.N 7d@]9$zh\p3…E_iwrt.ؿS!{y0'w_ Մ3 @1A^Ё3 /rpWVP0` °`X.A^VN0WG]U퓓sxs b! hU'Tf؇)``w. Blh(?|?+wei RrupfAPϿuE<_a `K5+zU=8=FbEm˟v_KA\^7??.<,;Y0~!ayb/${XE+o xy`NC{k'82F"@HL x-FއvN^ȿCC?$ؿCӿCvw^]Tp'fv^j~ 񀀱fOCC:/jeݹ>JN1os{/\1SkV?eS?v&H3=EǵD퉭OdƋ6 bplܾGmCVe*UH|ޯ0P46bF9M$w^ii˜ F 7##鳟SDyؾ%kq3^U.=LgD,rse%Ѵu|l^[,l$*1ϒ0$a}V]P!f¥tikd#7׶%Mi "5Gm ĒGIZ-iۺ6lu?{ LzMFmr8>toX9R#075Iֶ)pRG5кkF}&Ф3Ҭ~{Vnǀ;EM {ٚلX0.[P\ɔ?+Fݱ}2Ь(Sa#G8W3Ap N\NvtJA!}YEUW(R]v@4o/X B#;O)=h(dRuwuk}K{V*@'V@9o G~Ѽԫ0P~ACHؗ4bA1~':xVݕ(}Hjt8ϺC7%Y]O5܊crg(7:='yMe]D'ҳ-I |w՚ x"DrqGҹkm'#>9/Q݃j3_z֖ |1f,VrܴCNZ?lc2L -yۛA&t,A~ibNHb*" -Vl FzC`Hk%qe3TI<$7 C /-gbdB<{w5E۟|wmj>!H*X> 3?' O{?tˠwv!QE?V6Uscds?WcatTdEIޢ{R:>j;oA2l/#NbM^*%N@zp13|FxDSTW@o-`_4V}j߆Xsw$T_$}<ٟ] Dj~%}Vn*0FkXe>{Xj.pôzm0 jӧ:z57 N-fvV|ǣZ""INN٩j\KzKڢ t8*oXܑ4x;s*@t4IftA{$үlI4<cU)ncaѣʳ iAMSy ,m ؛u!*]~-A̱Ѹ-zyssQfWb2,R(w(x2DlUKhfӔ gE-iڋ(:޽ k"RJ\rħd8fkgܑEJkܾv5HFY( mN#NXcTmz'g=TFgڧ1TvHyN|0_xNdqͻ&Qs-R$aָJUl9!J#L3R,D ʋה'+O1Ү|$1 b_H;ee3[s6U is)ݗUepGp~\4n|W1Ҩ1Tqót)>bGԋp6Aom^t0{ZW )¯"09ҝ9y~9lK ,J ?_v(O{S?͔®,4>r}ج!fgϺN$ę|F|jWˣ%,b0\tk:ϫn G)Bgtќebbpcw9-PXAAj^j}Vϗ luث ԴWl2C$7AɪhxrTZmzzcХ:?"8#v>N|U%S`X9"UVL#J f 0Z 8Ca}Xv}W' $MG[l- M-< Wj>4_ D"s'+5 /<{&M /|M]-h@i[#e X+BY+-ː0nXqb^ -ISI)HY[TK!+ ME,:=]+enȗӔLY>ekUÚ\Ժ֏Nt.D-g7YqբBUFl{I|8T5į$G`ҊqqWQ5_Yx)@QA gլ9xE?ZPk薄 Фox;'#, qlIXu*^(hKCHTΖ[a =  )ҋB'kҽ}c}눦2ڥ|Ω~+xwɍn&W3Į(%37P{_q L5})Շ |*S'z︕֙H: AhJD\XMTrjWF#=mceQU.[@iD OǓ,/\d{!_!ֽէC3m,*bf&.[M|'朗jzԙ4@|C_,1{RYQ)g/Hp3DD-jުb~JZؐ j<$ٝKH -j!.iډNX(u4x(t *]oMt>ĝoY Jh([꠴ az%f524eސ=^[~,%P2 G;Cai{54d%m$ =F=sj{}5NgUFB^'GvWfw3&P 0"7+t$.(9jC%J@do tIQ:,ԳHK/*4e<Eyqg17kޜ.i\ɗ4v\k7͡_*cGJn4ϏycwjGK1M$Ƃ5b !Xoxk E :5B颡0I v!R)B`'5bH+ ;G차L*V`:x\GGg-S#|Br!<2p۸#d1Rĵ;}d*$M%62D "[cN\zh,6`(8lLFW/,M}kբEslm17nj-u˓T R\h U9|ʜoڥ(P/Ϟ4 Ⰵ"S ub㞍5F"s滟EqM.y:+5+;733 r$1̅Ug.9}.эQ4|+9bjL2Zc]86g2~ne#!axxb2P߄CE[*S^U6;൐YkJ/8:K?(JroK;y5jHeUC>rQAi 4$Ӱs,'mW/ e!==r|eH3´\*R>{ jz$35fh7f)lw"UEjoJTڀg? ϲ.ǽr`'VҢ`&6cDǷmmR8XwcnI 慮76Do߼G/?1 a)cGrq.63fi82\. ЂL~o ̹8҈7-wLsD\$ /&b~F!6BsfU:zG=*ԩv'>W-1k5Oկ|l~\+L~9u.cLPe8('Άp;Z-6:+ғ*Y@mEr@.VKmi0Sm|4ũuot(kNt}'\^kQ:; ɨ'0jeIˬGX z٢YyF^Kӳz7aԂD+D'9 u_O/\R m3-B@Zl~vZaCRM)j(9_.K-'Fٺ!t"1= fj2*1lT\ޞ5L>F EKdL@J\,*#l)Oy1GԆAnd0KwN Fe|C}+q T11L{K5]S]ggsMō< }b=l My.ׄ5a^*r2GDfdA_̖<*CbDuN={IQ1_CZ%m+Y~N`onHJXgI&<54i7R=ߑb{~E:%ʼn)9#SFIn滉}k3*Zn˜׉c %o}ϴXVLvl<Dl! ha\WY-=O~B#>~<}t"ҽ-f(wTpuRiJ!l2e㔲~OqGjxλp2ZgGsQ fA{ThZ>_F#rdMhf@ϮPy)HnCʴ hLtHfL"#5PhmN Wry f֯ HZλx7%vuAl'ܟFGܾ1 j5~IoV svcdECPGJmqגV43dN^<&qD8 W,-)L!͆qdd$?۳U {w,+{_.n w=nF+/-Pk Qj튞 iJUsn\OSc %{V$beUF^HD IJc#{ ġ8Jq,.Aqn^y;(8k>c"‰ѥ`YPG52dGa M_KB3cMѶ ylK6MUKG2EH0}g;:AIXrQmaUdYw|<6^7v P ʛx (5JT"Wܹ\n/߈tGX$Qj ճ X߯U]8)Pg u?T>oj/} _Ͼ}jpb[@o~Y?eĻת5wKeulrkz_Kӧ:cyD?!!UK Dgʴ7"FFy_}FyA&@dl[9h~o8-p#R"#Pw"1(RX_KqcPLBU9q_ _= hZ[acO ؀]a~/;=MT'߽S񼢩R+elւn7{}f+TnbӢdz{G1\LCs_yuTZ5:mɋCÕnENlw~gM5@W](ڭKk[.E`%ŭPM:R[ȁo͸r*|,FǽtY^[AL2~(pS:9&4RMWj p` fFa?dtAjIdzuP1:M' Kd}$Pe:a\GuG t춮VJW{yH5YuQ1w_:dmr_kJn!F3wfTf睨4:֗؝C^w:~}DEY.<t.b؅/Z[{܂2ڛUk/}-hZeޒ'MR~R_Oӵh_e8XgofxlJ0Ovcv(},ߐwqsRW]q=(X̺HMAr83O?_L9o1ύH36e+ft^Vyhy3FFv3IދO EO& t>o'rSѯMؤ@w\NM4&ه1ȴ״kem9iVD3 ["?7 *ꊝG cU%*E _hK\B9$ QHv*ڛj(?HY廲IM|ni1 Iͬ{‚  JLh{cGMzhT|7jKƎ"-oAkKk>W6)P+yl]dRi, endstream endobj 68 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 70 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 72 0 obj << /Length1 1445 /Length2 6477 /Length3 0 /Length 7462 /Filter /FlateDecode >> stream xڍx4־ ^C:z{]3 c3:kDQ т{}Ykw}>gf R%#sA ،(o쁄"RPۡИ MA00@PLJP\ Re;/@lJ7_ ߏN@PRR;@:v('+zG `A(|BI x{{۹"\o( `F=_%t\Jg;A`PDx# mY//@Pog;f( SGxvp_D;фߩT v ԇy@PH~$F_aǬwPB($`}4@_e8x ` ?4o%D`w$kc_7oo]C AB|+|AA؃pGG`_kt=>K Z~׿ s@an!ϟeTTD$|b@@\\8v?yH.N8 thPB _QWwF0o;_n aBO= >5:`[5PviP;'( "U>`}( jM~ #_7 /z@.[o=CWB86!Q1/>(_=`b( ]c XA@!_?6 E#\pOo<=<Ѓ[D^`0$*VΛosge3&Ѽ?Z>I7[m]C tc>V=!( u#'=`FxF:a#KlK"{_n]w"-$w3Rt:S]'̬as+xrLOc k's8YKKos3 jĪ#)hi2$P&jFb+)%F/c=_1]8Ж4(訫B]g=BL^1Fw{1Nl5gÙ5°>l*FN}4\s)qĽGOd`^(F (h(5tW=G{4cJ~n~>u`=` I4}ZC=)Nke˕0d֩&m!/97`*LR`L6k{\*B!x堜Bػ22iNjG H z߶I8³pzTˡI6&^}V4 9$ȖU>oۧf Ԯu:,3':8Ҷ}/ϰ(դY‹aM JK1&vx M -ϥE6Bl>7pWTpEH WKcF)} 'h p4o w-Y4ǒ_/Q hαCU%~x $`'WUwxw;rN NJId3Yy̻B3}#ku[rz? ݡvO6C]&li0&* m2LC'y_Ky`DJր^Npz/ "2~/Wgw>&G^f9 2ڲp }- תg {5od?mQ}_~WJ1M`?cBM5!ZcHƒQ}=q˂slzYa)95_,y%68ȝʭq"YD& oK@Z#%Qa-z\ DU@)6;jEɆ~/(NN _&lȔ>>(ZSLx=0p(.~)o bHӊslҊqѓY)\ƻPyL>Xrgi+D[,k͓ck2 XZkd {xx@ښ W6`;ժU#iW6F1 Yb2d^,uꬄvr kQ@Ɂ!t'P[ 17z "PC'6/GyU"Ѝ*Ӆ.lr3XJXҍ^Wm)wF,}f;=t-b=韻6%]}Փ}ݤif)4RGUK9~jJr,lboubOG ?nnx5rsGUf_K[! ~.Ԅ#5Wo %ƻO矂FNw1bsՋ߷j}<=i32Mm+ϹOa.|=.皎4wneT6TD TgFMfEay܃ϊ_\pW 9fmH W{mqc$_`a{"4(Ry'3IUiſ53;+P}@RgG+5|=fQ $,#:ϳn,PNK خh1VVՂ=o/CşBd$LPu/.Oc}ӼߔvEx@K->@}XZ ը*4s -=(Xgݘu%qrL!B?9\P)vYx.%Wey:w dPg*"';ٖ*uq5~h:J^Qi&$p5Mh 7ǭIK q3O 5&Zg>wxqF/xk?JاS>49o#Nۏ;8Lw.CUDg8D}-Bħ[+UȲR<ъ1}9=jıDBS\nA PzwMcp% #fR(k(}[Y<0..2Sԗ,,~j%-B}3ABwKAxtpuKU& v O|2gVD[+|=}?2~C}nn5ܕe3=p"),dw ݞԷml)emS>dvdgi6`dǾZ-3^E&yw \wg3d}Yc+Ě_leז%GR>6 2lu~绨i.d$v]?$j*@&.{WT/@32[k)c|f 7>B0o-oLs(Pxηƌ9z /ettC-#tajk,&? 7ЉX?9xルfAn-=hGa*Ht̀K"c#IVDg'roؒ 8NwՋ;U'No?(*LZz􉰽SӮ s5֛|q1w˨?wfj벓BeU@o1qtTl{㼉1h唟Gjep[z!k5 uX~ FEeTI3.3I^z٥u btDÄ^6(hXGqQ\5nݘiCd%̰q3 &q\1H] x2_q8I_K~3_ "nzPؗu Km'fA· ۙĘe a3Y?y`݋[p"朲,ܟt _ b/0>Ob{Z. ;)w$S=Y"g4]vEZPb 5mJGN~?;pc-mJ'*+G=-/X/Y_ܥ:+ / "M'ޙ` TR'b5[M]|U2ZҮhPqdƅ]u3ז)n2@G>}f\ieSXIYmDlo{IF7 }6H)N83 @G +Ci{ہ- ՙ^MxZsl]!]2/fkҷĔQ$jH3E ^#L7^%L$Nm ADr+au>!@)x8.KҮNnYk`觰P$gj~Z" 'O_{r|h1rtMq\fX@* -Pv磖t8exrRf7+~Bzu`H(QHy=OY+zdhۛoRpD<LpސcMʈcMh{V1'CTP㵹L* [_}/ϱ7|^\m+1܋;~rni#d"9 z)5N;\aԊv.\[MB!k\ ;ca xdrdnJ q { Im^ .9!ђhvY궔\/*u.Do 4@,jYRO\6KqayY Gث\&fu%΋Yba(Y¬t_'Qfi<*uG8xYqq-hS;z<1nj1O?p8ŜFg}ɵjgqcҊ6 z)߻ cƲe:?] =ByHy:$QyZ}eRžgG/zVCx]i.MO$QRb5kx7NPFa;kz9^S5MB.7/GKwܲOa V-̈f8*=쏐OP(zC2fW~d_ }҃ 0fv֣Q ;<7v0zG1X29<(eRyzk&^BKއK!Ròw N'گrXf+`9Gg~-u3V*{Fvb<\t_ٻ ecPF[oB> ^,wWjT'^𼙯EZsݭk)i>Q<߹ HCEABJnAl9.:ThLFAu/D4hHjd^hYvH0zm Iaz&D~OAW+)vdvSe5]=UkƦ ]Z%C7 ܐ%t/wU%:a,b6Ȉ$ȝtZ;}o7d }t?ڀo6JpܟM$Vj,Wq뙅loW3ci#Ĉ]%!߸y⦖X̍4F]YնzBcѽKLꥪ޷H%S4Y>? ቧKKXC5$D_znOcy Q\VMR Rσ"3L/ΓŚsx89^kQZ]Ƌ4]}u|K8hB+& dДmG/M YR-u{04adT}\1|y+עIWb`?y\OzԮZsZ\&BnCVw <#!!Qϴڌj3lZGDK#bmHcwDmL0 /Y֤^YIHIz%{bDZ uR7f s (ϻghV2i>!IHޒŽF=~RSR"Kg̙Z’x1w %1R78\oStͤ c4I9XA+.+lq37qƶK?}j:ؘmyvXzfʄ}$=EKg8Ώ< o!Gk"JYni+,`Cסj*<ȷCU]|/n{A[h$,(( d~H%"@ʑ xCQ1_t8mMےPp(93brS˒S9 2Ÿ$/cLߋ.rp endstream endobj 74 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> endobj 2 0 obj << /Type /ObjStm /N 65 /First 519 /Length 3330 /Filter /FlateDecode >> stream x[[S9~c-]ښ*.e^<3voN Z:ҹ;$,c) N2ˤ1IAK`N;&PX0 ?lATpI4+& *0yЏVC-9% /uKc.B0h"x `!c\<{]:0If6Y2{ T((1 "S ;$|*iCNg TFŜ5e sPD{`X͜` a2!¼α-)d"CLALR)YQ'A<"/ИGASQH fL(4T 1N'(z@-C$0'Q~s}QgƗ߆9㧝8KLL-~dKFl9ί{+H VPe 0̌bb2`P`ҏ!w lEc-P~/FA9y;^7?;eG|΅wu>։K~X];1(oF62t[h՘,y|;Sv^1]ώx<QbtsP%=r}JjkcۂʹRT[6{g;gQ;;O@,uY;3K5"ݿҝ]qrxs6 65ש@ZO K\|,Lu*JZ ?/zeu"3;TD{#U#yZDYTb܍Q=h1 {uIH@lB@u}XaۓBЈLfd|J.1%Aml9cư7E 0ظG?tSP߿Qva%d,SV|ׯ,l&֩!\?[!(IbRT:SIZ ${O KvZLU)U02isR┆xJ^'1sb"#)idMw,#3"c"ehHCZIɬ1'Z<..]hla9b!4U~ȯH:4qbh-# 'Aje%PjHGew0sh䓦͆r:.e=IOb("D$O>Ͳkm0 m3ʿ't4+qHeBJy:3D!_'ZRSךRMPqƾyMfjGTJ,WlEJCk1)INY!O'ű(5ߤpLԛFR;Xk NVFX:Z 3/$,|iAɁTOe "YߢzV(1Í&t2|ʭX e5gE--!m25fN(ǚJRxpqȄ#al-6i&i4%^KI#$fKuQE˧A Z8 LcUK~z,>ƙjԴ7'4ׁCsZR28LP۫qqIRģOHZKޫ|id5v:7I5Yfg&9kM!f5iG6#ld^I'4b&T+OzݗMX :(Kg6ޢ}yLt +F Er;"ұ|5{AwV &\b,Ai͖4Έ uk2L9Mqls(`@Iz7zt>)7٫z9|ϽwB߹)N3mض4 )ɝ nnmy4{ݝM?gY7D-裹g9J0s/goNOŅVz&St m%Ĝ_8KJ9׶Sl1%=?3~Gxw~1p7~om>9LQٻh]f?mj#R?ϓ(}G㘏oGy'+棢Ymٷy 춒d}iɵ}0o{sM<:?8=|9CYxC<"%5Cvި;Cw"NyϓNx ?=|h_OM a>׫% nO2% l({_y'Q_Թԛ/~}s 9-xYNv9wq*1ǣoh7qv_n*7hl::;L׿Q%,?HOx5Sܺ d]q~Q~om|L,7?]Th'ʓF= Ft?\C}S_bD8?JXG<^pia>#\97..5x.t Oٵ7ϵذI}jlXl2,]lBGoWzrL~٩o{ے Xc^ڕ.kp}񀾠\-)C6 ͢jB[o]떛^8-v|El{{m[4b͟UeunU/9/A4as݋gXSsq=fA2܂Z\/nZMouZ0Eﺜ6ZXW֚E <48E65FC29837433DFA6523EEEDCD4CB8>] /Length 236 /Filter /FlateDecode >> stream xѹ2a |A*NQ(\wИi0T s4$&R"B\&*h&@|dVaV` `6` a*\Ł6h"*=Ǡ E|+] =}V5%A( BƠ V&ûI5eݜFWT}ԴE'?QmT~_ava endstream endobj startxref 130271 %%EOF bbmle/inst/doc/quasi.R0000644000176200001440000000551713615631567014347 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.pdf0000644000176200001440000074747113615631562014443 0ustar liggesusers%PDF-1.5 % 62 0 obj << /Length 1891 /Filter /FlateDecode >> stream xXK6WTdvImf#A&")ۓ_hP")3q ~+ |GaV1)^=VB)l0vSKyXKT:_WS36lPeS{QEܕM.ܲLU*EF4'?;O:3 ܇EjX6CLbXv,6k#b?lp+􌑸!՜qe3{A;5STLkK?3Tϸ%vK.9є@S3-@TK({Mp߃dYnų=Nsi_ñEhɈп۵ɓz3`?!a*vmJ&Ϸ۲;0<([e*y,PT$UaOirS1TpC!mEH(hQDP'?slгC+vɩ*%n[i䷢ms [-L# 50)2poM| ~&Z#ȀD߷Z߮EqPt30xj"r܏{xfSիg_̟R$zy.X ɫtk=WWitl+$-G Eɫ#gKO{ٚ~XbMZj XV eMcjXsa?m*=GHJ1/[_o<}*k޷5_&u:o[ F\Z'b&x4h*%}6휲Q~ d._"+Lw•.{KEϼFO.yƯFgF!9VM/4'#t:] ,C8@إ}š"6M wEWk̈RPR eG{Isɨsйd%u.uҹhD(bܚnFx ~>l`@D%[e\s jdw7:Id*𢋬 | *g%A;}M8UH'&̴& sT8FJ4iTl 4g^%rXRF(v`4SDVs>K@"!'4Gk^Ig't.fЋ`di_w_DJǦTX[LB DǯUg_]8X]h VC r*] 8s@@.D`]K/B r5 "|8ϔ mgf^O6m/kZ5@k$<(l|3-K.@̜ ljmm@6/MK!(b^| -.5fh<^-'_-h3<nruj&/ $eDoK`JF p#YB:ANB 1db-Qh.2~G{l-:ueQ즨0j 17BDw੬u{2%-)7N!7M谦C;"PckѷC B^Ŭd"Q[> stream xZK6ϯrpsė!6b#sKr`Knzt$<`Vԫ[mg2(X+M |{ IBzW1 #2"K*~SU<ffmwvOj]~w4tctLPQ+{Vuͪ,ނfwъ#?\t'ŚRHgjYE$ܿe e'j:\ԭQE[Q"GKukgpul-=.ۼQ:Gm+8VŒ7+զ-y&8bٻCkMag`xk0µhN'pdYvv4f8 9fY4!J^(*ޮ-oʷ~nC@O3ӣs}u-HYb,O n2< S92Cr)r QuJH dyuiMu!;{ldAN7yU*YZ@9f3LeX$o A5ښ4SYĄP `.$]ldb#Erm wNS {߷iwNlnuBʙ1)7k~<"Gn tE .'$9Tw:B.TKWPՕnT Qw$A/( 9"4؎?Xq0;}ߗH4${L p+2oHDŽ@bC>1lc!&K?tm|iDqZA BO^iLaGZ/XbgAlͧx _`O_ wShv׏wCi28:S۵GVGԛ Kԛxǰoͳ?gmQ??!3Ǧ ~0_vk=?1>Ci p~YjvlɵGE?=*OT ""&q­!0' endstream endobj 89 0 obj << /Length 1774 /Filter /FlateDecode >> stream xYo6_!`H)R"6lfOKGwǣlYv؃;=ҲaS7ǦyӉg~(pTdr8Le0;7Ug!~D@`uoc@4JVv 9_YatpcWo8/YDyx8Q}vt8!m8ːLPY6Ҳmj ?Pog[? dEJ=%C/~N}LlQUs":\Ai(e6 XuJc\bR`24&\O 4rY sbϫjF. Kj-%kQrPYUo7 .1PnլPDW /ڼ1u=E\_o ``UC907M){Vջn5F*:;j 1Wf`gQy(c%+6%30Pm}5(nu]554DV%Iٔț2  ]yۮ6gW e pA(P9Qo}M]& Wƹ6hz袢 3HO!&'dՕQ&sP̗֘R v53#R }ۀ+.ɶZ6Nuh]=1\hA?!}\) .45͐JOR\$'첣S༶pAs.>n>qweѲp h$ >CdȌY~ۻy8i.XqZ%)\уhKM:džsSÙ ppܔK!@ Jx) `Z 5N aFǾFv0Fh_ۡ+y#iUβ =IV&Fuv04j:]kJA#a=z 'R81If 30knk0;4,zsqpj&&/BV>`^+L˿]N endstream endobj 94 0 obj << /Length 1140 /Filter /FlateDecode >> stream xYK6W @C$=Y$ŖBJtΈV:m.0 !A|$ a Oջjd$\JhS!-ȇ`^WY5Ϧa " l|*Eȩue}I GX0̍̚~~8&U'זv2{/{~^SLex3Y^7FQ$Q&%T85j0\o,RD%LW8фQ)B#_ZyۣO>lr;A1amai<=/'H4C MFGt|m}$f'(ZJhǺC>!TBo“d2/dx'v2zCb%X@(5Oy;%&H(8Ąqk3D|BbXvD8 SRej5?mpպՍ#hE^y (z=NGЪ[o-Maqe^%{հU&]4箙ajTږ{V|Sm+ZuVFE%̝@=yVS̠*T;l&WΏakȞ)[:v *k<'cN7uvk-T: ?>5* ye/Uקgqcx@4h%v~W G63m?>P{(1Go'4M Qyo%'ԀU_a/# ߤdJP"7?h]6 endstream endobj 91 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpO4fnGu/Rbuild3cae327fe797/bbmle/vignettes/figure/profplot1-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 97 0 R /BBox [0 0 720 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 98 0 R/F3 99 0 R>> /ExtGState << >>/ColorSpace << /sRGB 100 0 R >>>> /Length 2146 /Filter /FlateDecode >> stream xYˎ5W)Y`rH AFbX"^ _ϩ*wsg27IWr0?bk>z̟>O?-igϿLa~/ WS.DAAk ~12wnЄwٽysW~wbPuz)WG}V"di ޻<?4tճ{x5‡QTJq|?;=_?_=FΏ^ =@%X|5_~ mS #Xbۿa}&mh .Bo\<\buTalR%Fx83쪗 8"KrT%#΀iZ4 $(?MpyךBy&Tz4PhOѰ˺A`r'$I ~FbZQ` {t\L.IZe[M48UA*/~w^~ۧy:H\ce/:W7O}+;t˼L4 endstream endobj 102 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 107 0 obj << /Length 2528 /Filter /FlateDecode >> stream x]}83"EJb{h\(6@kk5>wCIPzq,r8$Pwx8UGEt4zc ]6DPoumѫ7̜EaСJqz0I[}@Q0q#c> emRRkQ^07vxM 8Qy֮'u@-(c~meƹu֠$`n6z ƣ;y>+X[*Swjh<,l[ֽ_ZX[Z!l+&"!!DX *;(zITq<9ڬP}Z& #2΁u6#p7QxQTj .Sdn φ&)p*Nظhs\\b;`H(T&g?UGxqb,j1:Ł{=*gf"S:g2?,nUXoGƊ,Mm@ej 9p$al1u1T,8I>:C:"#)<|Tq\2, ;~׷aIAnC۲mM" #։z8{yVMK !o6!>t. R4>brpGʮEŽP)PVa7V x4=2-}MO3o ˳t͝2` Va'=(ǧq YU>LGmd)~Qu!0DŽAcGwء-hc6pz!#̢i llk3-?bkXglܺYѪ\Qt2ĴhJ&&w[0 gIalgwbFM55+JX<ڻ-a<>?ۛwW;/x,X"j{Djz8:b}'4ύ? C KA@ '.)j* ?.PϚ#KI,ʊgKEJN?FfqnN&J4<@p4+eDM%=y*9ۜc-?{cCw^|]TU`k<0̾53| xފ.ߎ>2cp"3"/pb8C郿By(]eԄbG%ZDd-38qPj9S+c+*6kCrYjͳU@5E]_Uj9'H2WwPvZwV;C*%f:3hhZr캈ne121mn|"ˎ"eTgXܓW kZ(n a #!sjb}.'[tKCO~lȿ&ԵG6a>ȅ,+ZruoNTњ!U%8f <ͽr\E9#Ek&!t꒏#.C排VGz%Gt9<>^=ƌ%kwEկ#mǰב%kwNKcSE1nӴ@T!"Kgql 0O_~yL8Sk@&L;b#-K-B4&ZeJ?ڟ@0gZɱ*ΒdH~ܛ^(x;9-ö/džԻ /9O<ѷB;f djG'g8+rǿLm|t^VDID{o+:6pmMִuFBK;IZx1sS͒TKƌ:@?"u| endstream endobj 114 0 obj << /Length 1883 /Filter /FlateDecode >> stream xrί@99UdT%l PƢ|}z@D*lQ.,egfؽ+U!(z+0 <)Lx'P_$Q6_0%8j" ]>P!,28"+u>PD^ TTa \6?WcT5\mEPD,cPRZ B/v*I«5RB\Fe\ilD9 s!hhjA6CwlKim#]A?Z&?͵40D&" `  ,0ʲ4mƶ*Nn MbmP`PlxhZ"# ^T=`@rez߭~pWf <3C| x0y쭘E= ;pghQʭ2S ]Q4hԟ&*͒< laC.I|14'RVAU|rÄƤ}GxaO)Iqugɋ̐nnrYo<>b~CBaHH` :LMABM1GNsȁ PU@Y8 )u;}-=?qE+Ήﾅ8;3c}@#&3*nܙj끎AWn9]7v´\'ɷbJWG+PKqu|,t*N"-KyӤywdFmiQ:ZŇ%e9j" [0OGWx endstream endobj 118 0 obj << /Length 2183 /Filter /FlateDecode >> stream x]o6=BhVb%n_]\mлƦm!J&ۇPlE"ÏpHT~n~|wh {R7wW߼MeZn(e&U͂_}w0haկWH,I8,ND0]]!\EihhIP`~ы:sbk 8Wp?z*=R,iUĤ$ӯ2M1⺶s[SY^lڼ*' C j|]RiMjL1v`azy0e&JcoNZbY]82>9iD% +͎eL, mkZ]/7MpZ;L{@&uy.s@83A:aY{{}n+򦽔yĂwA/JJun/vҞ_+qc.P>7 gNsI0]53N(BqYt 7 Ǘ("V-D$m)Z*?^$4!ii]+պWo7(,.+<&p\[/op4㘢4W_T#Rw+N"g~hyUX߼3e\FJ2,c}2Ӷx]OŸli)a$=z %Tsk ,Oz|+O6dۺ3[)MI8n 6SSC uxf ʺMk(d4,w)/(,2=śr6LH?xʸ(1 FfdH3-m_׌G=1< ֓b37_A$oVP0.A< $Dz2GLΪRڧ@sH ,>l*| ֶvnTSUSlD/ʪ^1ݤd4`ٱ9JJS }JU y{c4`1'2vmjZAaPF8ttEBz FqCb盂XwN(U(T 3]?ӵT/9;Dmmr:$vm0%qpudh֡O,a,va dȈmƎ=Lj7o4yՈE,p`4M5,zWC)5تUƢ_ϞTֽ:{p]XKp|{Bsbqtӑڊ}v(῱\mr6/[Cm}2a@u4GRW%O@6{[EqJGJUCW{0T3~GWw7m7-pPbY CFse"7M=ؤpwF`"\VBԀQP.ا55;(5(0T:jh L]PXSO#tC!Fn( d2y{?./"fY'ڎ eZE™u,LhwWCy[WKvsZ _.^|O&zOχL:.AIEҿGɆtT5Eq;l0r6_EG*;m>  8 vz<@{-RZ ;a:g\q4e1w7wbPRiL&r&B&Ѷ2%,2IxWI?"_V얀pgYҷUOb)LY %pє9pYvyR PۦiKJhb>qWyKM|$,#ak, ߢ`@cuvYL٧-fm;^N!+eݱ@eaTQ.} & Sm[thOFB̧FxoEDde?U\1I0y~2'7x1g{lmhy //Cs~GCIXPHC1,L75]b@67 ^{a:p*g3!wj{\m8Ї/g|XDw}޴Z7m^B h8.nN=/3tLfQh #BL?^I endstream endobj 124 0 obj << /Length 1894 /Filter /FlateDecode >> stream x\mo6_!&1wQCa0`]}h;@dG%߾#);KX90|9{ F |~tr/}⃩?vCFr$s3]θ.o0nۤ/-f!Ppy5#LP\N@> D 1 Eͳ4Ѱm ;,p>,Q᫼ F Orި+$d)Snv:4jXCJOODlDjiZK*]^EeҭhEV@TmA 2U-FVʑאb)s 17ȫD1W-al<Psn8 eMuuQ^WfOSxej /[N(.FLGPܞ2~uc屓>>=VMc^V3qt =?I&gmèqMCQouE| YV\/<1Iܼ׌ 0^AP#GS N0@3`Ĕ. jmc8}("Xi\"wh]\u:.nt_R"FV$JQ}U`rf(`<ʬ†b$(#ی `,4 $cyTdQ`$ ׀j%p`Jy[XC?a,!`tZ}iO0ax9@iAH3!mi7 moI`6S'T;T=@Ej6/i_E:sZ޺n!ǂrNxhß **e B5 -0/PCi$7UQ6e>%I܎  WHU:,_ю%Wӄ!#>^u;Z3j%r-^B @qi&r94F@cUKShS [[.rU]`k&k%:v= @oBtw@uyٹQ3o2a]Űe `zIf ܗ%u(N ";j ~?JS5ڿږ+{9=Bj" R #W-3\)EٕZ{XxvÎ}9m# #=E6j{ }~碿~烾D';Vc?77dC0\BGi:}iN QI͏k1 mNlafBh]7 gn}qxHd~ LBO7M>ZFbA;bN`dx\&,h8M,?We nI/I'a܃5k[N(P$ak' }Of:#Suq\jsCF.5GuA<@2(ؾNfA>!->^a}m [@61ajy1<7ˏ!0O )).P,ŀ<aZt!.U_*/OMk 8LݮӨzʹfp\aR$Ow[k'_N  MrߛW} ª?C2S꠽2OU Կ݋ x endstream endobj 131 0 obj << /Length 528 /Filter /FlateDecode >> stream xWk0~_!t֯c{Z=tiR&ud(E'?t}+DSǕ}OdYhzeNK͒rieDŒ;v3ɊGExgsf~+;s~%ouge=E@  Ppc6z1Pl]w^SxD4~зNl[9rL6"7$ڐuN=`-!\(Aexؖ2yN׋tX>rN0v16 Uݷbτ?T|=b:PZU_28Hf?.OpCm*Z4u)NFFTϫӯ[>gTtDTC&I,%5rǡrLo+iG% UVE@.ՔV1 p ԐMp={QJqBB35aؑs39L99(" (Og֏E~N|/K v?. endstream endobj 127 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpO4fnGu/Rbuild3cae327fe797/bbmle/vignettes/figure/profplottheta-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 133 0 R /BBox [0 0 360 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 134 0 R/F3 135 0 R>> /ExtGState << >>/ColorSpace << /sRGB 136 0 R >>>> /Length 1306 /Filter /FlateDecode >> stream xOo7 )t)H@j99ص6 PY -E"螹ݟs=O%?Z^rY{%ryZ9[-MqwFz1kL|0OGmv.M?qsn?z~y So]? a\rEŭ; e(lpw>;S%'S>V/Çz!F*+Ϝ1{x0Of7Gv. B,ĝ=ط%]rd0\I ofKnӽ,׬>a.2|X]jR{9Vb `smz9i| (X|.I0ڗg?]~ysÇ7wwϿ=z.=xn(tke f.W3'+17(:z_^ȇsm4?#/ ŇFcB `7 Cb!6ڊp ?}ՏH'QO3{2&Z1-KZѰptEAVmd#U2pDib"q2VTD/3t"oVr#7ÿ(7/a(J,+)}6^=w4b pyhpFPu-+<-PÂV@> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 141 0 obj << /Length 1002 /Filter /FlateDecode >> stream xYݏ6 _!N߶˶v0 X=rb7zGZ0A+XEIEH1J aݏ F@y(cᄫ\)$U!bǂFZUa\Oy[HC~ ?&nyFFN? 9ՒuB{TKz-})wǸj*vաq,EE%6vaә` LQq?&z=R!P$REԄ eڐڒyPmxn_8;Sق400 -9thi8{OZ'ԡc=}Z#=6I+=U;i  ѭq_W{޶ 5np5Ј#u4Ub(4"MZxU&jefn(,)9<%:Cq8|6 @&+XeBBHXu0?; nMNC7Dhz"On^_› eFwq|Ψ2 fwIuoOn"ٯpu{ gMq% Ϥ8 %\̧L;$ pV5cbOx}Pi/8"rF[˅ϳߗ"l]"8"nؽ#|_pb}!oCEG_PO>wՑrf3%LYy&}.ŋeu15@A kC5pjbK_hg A5n#o[HMfkWo+WU]?#d%6[[n;,}p8χjsWi?jXA * sNj-"aGi~G E܋7YYhd0uVϼhx Qғe\Y$TNN-K{5`%JU: =opD!hghh0ao|_ttj endstream endobj 128 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpO4fnGu/Rbuild3cae327fe797/bbmle/vignettes/figure/profplotsigma-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 143 0 R /BBox [0 0 360 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 144 0 R/F2 145 0 R/F3 146 0 R>> /ExtGState << >>/ColorSpace << /sRGB 147 0 R >>>> /Length 747 /Filter /FlateDecode >> stream xUMoA =0{9 +qz@įGv7irn޾c?{Ή~u;Y~wJgN+5M..Iut]y}bR&Q0ZZ86]J**G~}OzO-FG! drB2M_?m^mswdCenqTm)'HW^xoȲhyx?NU#_ȋ ʻopp~~IB^Md9;r0OZ3ismke%'7.fb./]|T⛹VUHjIݺFkxn8M38e]b~I4=7i=z|I":8&ϙZ.ka$Q>gʎss@60t &@>;ZiZ :Ȏ }W^{ =/B%(tsHI5HW6Q\t#Vۣ pRb2f.QN%g_%] k7GPszd/dG1E\>k8kK~r)+0_QaEc%_by:` [3I監2|S<%HP-x ^!` ջamoejEJi+*Qε endstream endobj 149 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 152 0 obj << /Length 1347 /Filter /FlateDecode >> stream xZQo6~ϯ9X"),Y;t؀-=Ȗ$Wl;-٫a:{B`yG[n>{[ yX+ _7Z{`OF-b#OZaıɅw-B)g5!6ݮ+7h^/^s$3p8rs lV$eg_01F&Urg:{+v8`Y҇_y6:ΐ-F1TE]O|HJY!UH.`a<_qGѼGQRgR5gaZG^c컵}ߵ_W~n{BYi|?cӨ<ŧ/ӷZRoU=MH8)tlB( jS#ce#yetyy_l\O}OqvxVDeaaa*8HS5%-_ PShYQN̄!v?cGAg¤HsI9 Dvw "DJ,I4,L3&_/Abiog3S,OBbekdLO.L۸͂\.TLBPh`UmM@j ЍRef-+׫M?vd 55Ne,8Uj!81K?i?h!#|m"ˁH 7[U\z:?>=['c PPCخ&K1+++_UhduSjJN+_1ݻ|6}}fAgO},ïT T{P}Tg;Ok5றk?j'֐Zh=٠u-trbp3v8 > stream x]Ks6WpƂ#6vT;=wAQrƢ FqBx `?ˆq8飜7>s\(BQ^:?(qDLx tBF2v.~ۚ՗)is.k|Q3=:G;KU5Wh1!(1LQHJ.F 0}M{,Jn7d2&mdv"sFON- sBŒ*~E1v8eYUhТgQd4xҏP:%(DSTE1YN&C܍r-{7.,G1 [tB+s&4T)GTS^:TAgKvŌ|>[$<Ҳ$2D~?}U#hZ`lwV(ߡ@Iaܩ땴#kV"tYFYܩRܭ&HY{dZ6I3g5wlL / ް#Un&us@,Pb> x߃BcƹGӫ"tEkt),2L1ap9i@VCoʤsoVBXبu79v}mn$O$Jlⶏhn' 9%@BF@nThKLʨ҇l狴r~ǡEmAIPJqz~Q4}>w%n?*.MˉwtŢH^Ϡa7*.76. >!T3&§$aUQRF3-Q_]LJfb&YR--o}}9 1ڒ1@aA&e]/j~ͬWW{̞x+ȸoNel(N,iM?ݓ$ɋlcܢ,&Gku}4y&Ot<{)ߺ[AB!!lxn xMD3޸cxS,!l/!~m^0oӅ՗u {:Ed  zGEi},erI0.͘N^% {6h7rmS BQ4`)`K-Xj&XS CZ[˲Y,hjAS ZԂ4MwM[pXI!"{: yG&ӛMѿiqS} Yzg.ifV7>Ǽ| h &4?<, - endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 804 /Length 2196 /Filter /FlateDecode >> stream xYmo6_ p"(MnMqt֖|އ}(ٱcYW j8|f83!ʼn%N@O?"'BD*I#ҢDQ$JK"D4hOm5QF.JhApmh[2I PY4DH ihHzD1Hm<jHXqye ⁙kN'!"*݂MT `@* C.9 Pƒ`IBTPah!3'/ ]Hn( PIm QP~- :(c vxlg` X 2- VJ",:IRk AXbm,0@baUGQ$v[VL x6tH=Btq/O'8x,,yӍptgָ a ;'GMۢ*8&_~98c6+n2aLc!)jRdMN{f viM9-i+8kf_,ؑaf){qNN~>G7rVW c-?oSYG@-;i9wXFiB ]Y 7.͓Q1.[CW2(Xȶy~g@4pkZ!u]ջkv3ؘٞqն|䂰7E{ Hm0hc6pD8`fu1"o^WǀExpA^LfOvZ\@DI}#F7olM\lz@n{?i^몆w`5egW'I ц:NI%3T!h1@wJu+U"t #= "Jqm4,+X ;5V-NpObɋ6ҕ w848)|rԤll1\ p0%90(-5R>KjzLa#ByD<(hT:i(0#yxro^{LA!YOV ~,ZG:yC=$XrʏkUihI[+ŀ}M7 ɚi}b[ـ}U"8t",գ,x]boҔ!F;5_sQeS,?QӽDW6)6βͪ6MqlXAMS:Yg8~dm1F6,ϱlX`hE6aqv?x7+oz6gUUey5, 6>n~IQ/x;x;!xyĆ佒tq{|ފ8SQoqܧ/}`#*|82])$~dC"Z.Ѥ277Bm>Q&-l[~Cj C{C )p 0遈?&j}n$fr_zN޴+ Wx%6D~ۚ_G+jw5R/_gDGf%aY>7}BX5{|A;_-UrW+}0zpЯ?˯w9h/=h%l>Kre-/o. endstream endobj 166 0 obj << /Length 517 /Filter /FlateDecode >> stream xUKo0 W>XVSun|[wH'1ԝؿn@m AhQ(JIPtI|~q% 9j(@ ɔ3e2浲&"qq_R>mOM 3o|DD?WF?[e^ (bNzX3^KH֯\zJw _1]3զ뢔R憣6ʇB|Qy&xIIVz2Z&0l;Aз}f/@jJ>ǏgZghx;k sVC%m m1#Y endstream endobj 156 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpO4fnGu/Rbuild3cae327fe797/bbmle/vignettes/figure/gg1plot-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 169 0 R /BBox [0 0 360 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 170 0 R/F2 171 0 R>> /ExtGState << >>/ColorSpace << /sRGB 172 0 R >>>> /Length 1528 /Filter /FlateDecode >> stream xYn7 WYT6AS @ @AVyq4^PH֞{ݦYxbZ∏#pB"uX~ ico?N,z5?oQR/sR)>WV'3)A[:lM} F{;0w^gnkNU[&cӆl5<6'Rohlk߬^8mI064ql`,ža7l0P vAɡ*N10cӆ`uӆ*O!CBViC"S֚Σ}JPWMb»ȳL6(*'Rr5QC-mY daȠ>I;܈@"Z>|Nx7"A3Y$2g 9+_jA)R*0[MY E,T9z$"&mI@zje$QQ0HY2-X3LC,f-+VjYA'RꠃL=0arKqaJv-lYizx(T'q4~N2i08|2pD:6g@'Z q@M4rbiC`x N1!noC8!LhqA5Ҹ"nqqqUkɞY)cPFF, u9æF[`Hx<;?ZBV,lNLr&L^-ߝdXf~>sn3A>_"0sytsԠ}f,*@RnfbۈԢn 8k ݙo%NweOB{wO.'s2,FHdd$[&3x^~Q endstream endobj 174 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 178 0 obj << /Length 743 /Filter /FlateDecode >> stream xYKo@W|',UrT{Jjm/U U\UXC@]dGҾvfyflϫˇA Aj=QDe3l9P/aW-~\Jt >Sx5mAdpzPChm@)]I4tqG_ 6{D^InaM\R}4 <_0ODWz6fjk,HߘwBy+ϗ[/' Q*DU:)ֹBD:myvF7'ldi[@9ǁS$?Q'ׁE8tI&Gg^'3]p\(KӉK?p,]کt%+]LS  {%tl#=OWx_>?'i>JC<9ƥHKˀ,Z.Er-yK)U.]%~.}=[-he}E] O^%fng|2i4d0VY%>\+wXO[#L!UHxnVɲErn+.͞szFpv2p\^ rDw..L1ϊ27Kۧ sA1^d[|4q HM \Z׾=kz-$}yJ*B0Z*Q䗓#e" endstream endobj 163 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpO4fnGu/Rbuild3cae327fe797/bbmle/vignettes/figure/basegraphprofplot-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 180 0 R /BBox [0 0 360 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 181 0 R/F3 182 0 R>> /ExtGState << >>/ColorSpace << /sRGB 183 0 R >>>> /Length 2929 /Filter /FlateDecode >> stream xYˎW&HG6B ^^I#EJE|}Ω"ifΰ,UuXv}?lƘu9]~q5Ů/nXļ`j݂,Р[-2^,78ƭI[ O5CۻWl_o`V8ٺ]gfs׻w㟟fqvxZg[K*E\[0Boozz^l Q f?q`Kc6D=:b}l5o q8$k"4㳡n.ح'%vLI[8)lzg7GAs6oQe}m"#Bp#[qpJ_1v^V<Bi[/F4Yؐ!O6Jİ'BFF@C5f=օ6'~晲E c}`BI2(.les l4N5U%` 0hep EB wdwh-O # 1S!3pe+( #6g tAT>xrU'3Y8Dq`xa#`ʺ*Q{Gr5Q-@q%6vLzĦy1Ke_DfCyMұpQTÌ݅)E 1oL2#ډ+XF~g ߇ٝ\k0"ƥ5ı8WJU5\֭sgj\0믰n"п!qrYN\9y1`D6Xx4)8L,'[d}UA3D\) s2>D 6<$S.I&촜*CA|k_A[ZqN'?L,[7šT<9\+dz{k;ӵDǃL98]IIIichxH0)u8s.[Kt%uDp]bpm,Ѹ>ky\eީ[ UlΡC50::Gys#k(]#ۿu_u V`pgSP aaDatT,LQ%L"X%UFr X5 R"a62nyg*yŽ~:Cg J58L㲤Xbq0v%X>P\-Ʉ: X~xĤ4*Dk )%n@8G:SW2*`"XKW^" 8RbXj% V`#T$+E 8\*TʱGŅTDsIjGp}g`I}0 X3B1G}DP+o J{e0CM4BTPAAib7 `ʒHm$ɀv{|RE\RfTfdly\ImY_Hbyy!qEr Lݱc bz\&-9sø.} S("nM5>ȣ없AQI3<Pi)Dǧ/U<[/ )R)"YrpOE)]m-(?#A)"CЧ3K=M%n^q*";vܞȆ rI{I>hߎ2kOSo-aXQy*f0b ۚA*WcY, 4ٟ:fʹ܇L^f>2YrcC| NŜ~p1>Y$-t`ҭhY` |Ϸ/Iwwv/ܼ.}:w.QQ6JĢ|βJ⤴3)]7K" Фff+AEgQh:MRyZԡk!?\V>3ʜ̶ ,V//)ٴN`eV$CJRfiӒdp&9@^QRދ4JTIWIK,d6 RW|PY ce]SiC*$\EGB9nNۑ™ٖnez1,4PoJ,)XnSIP1ct@-DăJPsF҇/U+Tj('PSD<=-l yڶ5[RZas͈!WE Fև%TR/p{j+Or_U#;WU8 f\S1ԓ't &OnNˣîI0㲜T75"g`zUS8 f\ k HsN%'S8grEk C~EQ j>/qU&ZR endstream endobj 185 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 189 0 obj << /Length 929 /Filter /FlateDecode >> stream xXK6W0Yi$t.iӦvUҹfbyt#.po.ѭι;ۋS>{l> /ExtGState << >>/ColorSpace << /sRGB 196 0 R >>>> /Length 1503 /Filter /FlateDecode >> stream xYn\7 ߯^T)I@H=@I =t'7f1p(E1d2>nyr183'?ƙH 6;C.Lz6(] ]vG?֟ ~_l}2ksٽ~؍uFMц\6/n?捹O9Kcˆ\j̼~sn3g/N\c`fpƞ`# ěXlPޤ+sѵH]\胷&.X>YY,..uc3Q&}U"a[@&s%(&~ܗKnq1yEִ5eT֫}35͂SnڷwȁV!4_~MM.ؘ'uPlYą¬og(Jߨ⌍l譤t|| ½[Z l(wl/A|>HȴkF1Y?yH܊.ʹO[jFo&K&&zkCy` نe$eܣur=qǮ^2xD!4V{yZl=eͷ<$+R/ńMT 7黸ۙMg6'wr@(}۷@g;+E^98܇'gNHl)Յz<}Xo  T0N7iH79Mc"[B>MN5V۲Ŝe+3 87&y9-U"r2Ol>Wk;VAZJ Y@|TQ48Փ(|VTF >V>!_Ru=uR MSf w.T@H'JX,/#$^FKI9uߍpHYs&%JDgUMAywqǶd&=]bj.5XE7G *FYӖ6EQ cf/] M{$<^oι-oXDX_[Pq<.^@В`DרQCۅIiC KSL Bځa=DY̓zGƄXeAJ+"SYˉ`U J{1JO }ć` endstream endobj 198 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 186 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpO4fnGu/Rbuild3cae327fe797/bbmle/vignettes/figure/ggplotprof-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 199 0 R /BBox [0 0 720 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 200 0 R/F2 201 0 R>> /ExtGState << >>/ColorSpace << /sRGB 202 0 R >>>> /Length 1768 /Filter /FlateDecode >> stream xYKo7 ϯ>T5AS @ Y$ĩ vƇF\ޝ=$_Gqz~~6f~$XU1凗nQyw՗_}`I={ 9P{G#ud=oKw턜#Hm: ^a#3>N<ܾݣ՞_c8+!;H4 %Ž{q,;lT ;@NGAGefJGMRP 5|<l 5ǂC/9Jw@NF\fr0DC7С!y#ctT٭٭٭٭Qq |Eav#_rj04R q%Zn!O̸ujztщjI˾,HDO^t7FC-rDXn=z&lqap,& |Um⾚i-Mex^Y,B!Ccwˈ @-.8~1pAB wmő_5n=Y> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 207 0 obj << /Length 2336 /Filter /FlateDecode >> stream x]s6ݿ'y&BoINn.q%6?o?ر K` q: u~8rGΎ^̉IxsvPzNC9˜_fsixO{/EwCZdl]Ixy0I^dDljaDe:.O8%΄y)8rSf/Lk(ŕ|_# s0'7M,*|3KMDЁt,U$$z)ao2UR뤂 , EZ,; oRsIy ̋QFQ7]ڎ Ԯ2W,9L 7*9+&,lǼؔN6Ҁ0-#m1xS敔6@I95 wI|FBEL FĨ,$ԥ"/܊]zڭde/`E*ή<9qcB!4ɜ16;[ZxYvZlVULRS<wZ8SQ1.vߞ~bqPIQX1^yN%<QMhP AQ ]ↆ#?Joae=#]iQgveB "SE| zIB_c{? 츳G̶EhAW64sn*דe 2 O`1s?3m {X"s:ep.n$bodt{a99 -Sԙ{1qme,mO^?.<>ΨcRο}F" !~Ry6%Y~t۬XI$m6aMr&9l$B*BԻ>ݛvZ2_){!%NlTd[7:؃[Ɨ NjJx?NA8[6UJXvW$oSYWyc'+mv;. qٺPՓ(Maשŏ\qWd-R0[%yKu}!/sGî>sz$pvcܪբ.\˂{R\YR%yU775YţUY#|4mŤ^I_Hu:Q6PЈHFf+3 Y)ҔmT,.ugizҀ)i4dsY"Q }öo >hU P0‚`H:F-.e-Æ!NY2Q$rI%^G0b{8NM$^ dOV 9eꈁ=pEC\-Q!-/ML!5}Xwe'j`$~W,jوȿF4"ka osqcy 7 ߍ|"-Ķ.FJAc)i0b4QJiGCf*8|e箭#P}7uuh=2o}GA~DLQɄD!r0|PI p|q.yrȗAN/HD+^Y@!C#*A搁|PzDF˵V ˟ A}<_drX<{Ew"k.|;@9]VeSVתf l$`xP@U`AI?t|c<Ԅѝ*pfsKs Bpg쾱jd5<z۽> stream xڵXKܸWQmiQo  &H69-fzEiƃKji,"K"Y w]˛P(DI;*ϊ]*}wZGi}:iP_j],PK;DZ2 :T$Ayb&lLA+aŜbH'[OZ3 =\{[j`8SUP$] sEIt<١RC`#Dqҵ~q23^d׶vO7߆F/*аP #8pVe*f4kߙ 5o m(ZX=m[Y昶fB庖8ޛiƿp*`(,+ԡ}~/ U QŚ#I M/>:P'p`&mÙP5sTq H!f0dscD!_Γ1x'_GSCXREøhIOn8om")Ta*޵#`WmL%i!F6ZF+`)E+sxvrZJ m1B2xf/!JK-tY4v8L(UÉš?a/asqCa;=8KTH7 5%T¦1)lPgBa\$ZJRCz5׺An8%iioHxD#˝@܎ L., L[e]H[N#20 w6b[fD_]s{u8)~f;h?HKFXpOguǍ+Uxk|P+pFT%:⼇¨J>§ M$,Fb|rp$.V: 3/Ph#Bg\9rsZG yUw 0mSHgsS S;s·k`ڏcZffmäms U(QhRlx+_)[)ƏR (#˿FI4Ėӻ,0PA,zt.,l)srщjrݯ|)9?#i<$AJ Tp8$X @ =`L9ဟFF*=F]&޴9$nٌ#JJUJ4aC45fjE*WM E~mj] \n۶0vZ&Z{ ܀U!)w(\)GG"p(6(Ǝ\M,o̘zHUVWv }CT9zef(s҃' 6(2 g|4GEZg9 `}? ^o6lc.`^@QEƵ1w8|Jijm-_w )R}nٵEdm]x_d ?64"ҵt͂ZYe:g5L؆Q Z|Q]Enn@׵ws ϢFj?3s"SKImՍE8C (7l:a;+ ү 賲o:!˦&ݳ"H~ @bDZ8T(>zs_ :g\:T cw`oA@A h!Orm,:3bE+Y8$]߲H`m&q{iX -Nu OܨskOf4iӁ|n۳Pz0I+/39EA txQ#dr^eyp߱& " qc2O1gld(%W& 1 aYc1L_zepýo|= endstream endobj 215 0 obj << /Length 2910 /Filter /FlateDecode >> stream xڵYYܸ~hi$:Y,Y؃8~д8݊R[vS"utk yi(:ba7~?gL"F($$:eRmy7vu߹H2 T͡YwVQ^aP;폶DRv~G>mu`=mCɾ4:tݾ \i'3V:ȯ|}@7KSɢ]oϝ_'QkO⧇=i6w=un/ g#Iԕ[㺹3PgQC5e[ۂN3*S"vUϵUylfEC˦g9Fj`r j6xxp /։к9.61~jj:=b. 9}l a֩Sv+"!OND  nU[d-^vLv@Hr}g'V $N0LMd{R<퇶h;xŠ8i!oiP/_T>J]ݷ͉%N(Ϡnp!. b&&O%йyTF?JxO+%R=VȘ0lw\ӻU6G2iTzc3TkKFN&t͗H4S"1#gi+yA0)L,zDĉUm\HOjPh8`Pn`7LED~ѽ?ZJrfyB9\y`R{ڏ\(00tZjyY9iO(Iʻw] -;xlN$ci*& "zדq5XQL6XqMB FۆIr)3LZA>y.p~|!W0GtS`Z@mgq@ 'z9f`gFi02BU#|⍜Bqj:hOki5iPHv~qOс?Ȏɋ {PME#薘{p,IA-DLgG; 1F+$?̯.rQNf.]:ȍ#J$LL(`)f bFӓ"BD6j=QyrsX<}l6mJ@SpzM{P9_<T{5["1IqB dӱޖUP 45*UODBVE_ (+q|P %䳩.?m[G" @n;}a> U*@q=r= nDR~0mxTCS䅭0,ږI3KUJD i$,/P O+P˥^m=XM7.C4$|znb%/DL<|̓88o%,^3`idv.T7b^/v; ^yNh\y0  v/`? 'ׄ*,RXon'#ߡ3N|ql`lj8K37p:|wI[r:ȡ'|si+[(AR8TU}Ш,5̼VӚڎݣR{PyBKe!~,78tBJ(@[_vqjBH+WÉcVL]‰N0+h`n\3(]P0_S@ 7K-Y 2fŒz۷/^@vi(EYdoZ/;jR!۶0U˜$"e"}ֽɺUW"7 ' n_@MR5&o{{&{.\#Kr Lެ{<$"9g܈45%ѯS{4ΖpP(u{c8@.eC? PUƱ}K /nbjՠS9F<6 MR.]>xG&tlM}CcCr]N|7 N0S!V!؊Q6-h~}oJJ endstream endobj 219 0 obj << /Length 2754 /Filter /FlateDecode >> stream xZKW0 *h@N"s7CRa6 lP+==xqj]\3<勛_?ճ],Oe.D3k"5,6%?/}ᥗY&y(>m kӆyRxX͓*tr]lRoBJ$~/D+ b)^p,7]YWlZ'sq߽aPxiUYPQ矌z" s8T,tkv"4zasWI|3,SfX6EE {4kMf,u ІY5>,I1tϷGǺS6c.0fS\瑔JBB&7{K#ݕ &wS=G=߸=465K nQ~sYňґr&sOimZ獄N/H%jp8G05bm6=e>6 4Cn\C{rqݟP xS @" Fu+d Lr; [hݞOx*rfΈ ][} ֈ]Q8o-?򡬏- ڱu%`b23Z}~/N@ Bk+ ofI |ѰT a(hSKj\80 9"]yP+WeZ&F?Q4XT{VCYETC|3<|u+OڐO!h2K;c%.6b"i~neaWe]_MOlG6^{A=\Zvv{&z{):SRgǛ7Qj̣:Mf}6 Q^1f^) ;6)^kTݲ/Z $gX*p2):N}F2H.봢!{QYmyQxJrIq#BaGi ]rUs#n Xh x@Yt,"˂ӧZRN(M+ئ\a[",도_0bH8${9UyѤXPKYi b9acjP '83p ԷRha,y /R;d3`[‘p\cfid⇊뽣qB46u\&_~XwkD~-5mC +f*MR" ǑSd !tm{T5BDX J2/AwM_ s i7S/K+-ab0RtD)4T42֧CA \>rо {_KsSmk,S $1UOr6Hi{(g;.t4\ZB6>sRmz #].6~&hT*ZX[enaRTlnG.US2ZuSޔUEr2NL_ćcIfIӖ4B#i zk!%cp*, h6xMQV '2[C7턭#P:'Γ2͌sl0*vԀplk 7K@(T=~a0S>M=5 2{A0.ɟ|+Uk5•$*t5q@>\-5sU⡱'êu PۂVtm̎ZOY2^ Xi񶼩e7-xݍP8qZUp _?`epT1c𻯙|E;>ҋz9s6e5%8S“ 9+:&=nC`tull }`&;PnbE;bN֐N&Ә'u594*C?$Oi.4r;j:_@H0og>M}ݮ pR##zD=D\ A7"05"&ޕn(ü>&p?ۀhVǛ)'a8=dgz}wAWĹ\pO+w/@oP^ 2<+2א?<55'[;q;a(3ܾd C8XC 0 Q>} Ip}8+`;0w&08Ïl۫g endstream endobj 224 0 obj << /Length 2871 /Filter /FlateDecode >> stream xڵZYo~_!Ŝ>xXN l8ȃf1eǧPҮh(vWWUÕ77o޾*I«+"Wa 'g_F_n?{>}- ~cANzm+G5IW"Cx*򚞺eGuS雺̾N^6R$gVL96`,ڞ&ƫ.RG|:'@[yeS *:6N/rɆW@$oo]{.xCYLk3^_xk*u'jaS`O5+w" ??ii!Y#{+LBx)Ň230^^@n4qhY;/.f@G/%b֗Ho"7cOJ #Ij5IW[D_ ,ϠP|fDqh**bUE}4lPiEdYߴxEb7`87Ǣi0_^' Nɪ#,4a[Ee':mXWyU"ZēD6=~4_CG)y#ahmqd5莬$C⺧MvvAPL;[2Ѩ]"VFbi`t[uRzg5nI@ ( v`gM4ҏՂzl=rMCem}70Wt4wq2b7=5p+_Q v\ߦه[D9?`8Iӎ.#Z t>P/;낾zK酾m%}V~#~4!߇]e=P#h~&" GiJOcx2"m!IsE#φA^ X l"#;:Q10Zak*af6Fy<K5󑇚jk-ʪQLQ@Hђ=L9[f:mrZQ$f"ZKt-tGh CUsǫ0 ]|AҪﻢz(:ޙx3yjeF@ o$Ѥ@ ]C84v˱vFwaD%7/SVo^oei`D;z9Phu?caa4C1~JPh|с+ѼhvC0_R~yLEԠ^wDV2K7)#I K/ YŀqKB7l/0K>V*N&JWeF%8=%(z_w(3CiIhN#^ Bت^nѶEYw4$r ;<ݎ~( tʬH6qy'_s"m`-ɞP?6π;1#]ٗfHJ[,Hcz,\ן. v"5_=Ԩfjhq I }V4z!Z1:j/͡w1cm0 8zbk,G pV;@GCęEVUH$gL pƺ'uI>bVSxak/=y(3.3VT';;8F-9%z.j˵Lt0]Ler^Hdgb7T\W :Zpn2+ \Cb-QInq0oO [ V|2yw̌c`ؚ;JT ת jO+aoEm}DS> i=tGa g;ԏ@qXݠJqi&]0Rv| PR@?ZvH|fő6:0%aE`:_nor) L/plK+ymOy>[SD1c#Kp.B)&ST&2KR=×qӎϣzzVy*3b%D,WQ4{GR\A)zlR\ ~.'7C>2{i~!ޫH뭋BpH1!dy{+86Q~T)2kT,> stream xYIw*>9M;ә|ie(SB8S(JlERXjAWp]? Ͼ]}`E*fe\,$c"J!ϖq\w1V㖶{?˕"5}]`5T( $*.E<쌤Yq[R;@?tS sШ&`Tś_}"+H uY=RK;e., G`S~&񭢘D$G9rVKR-hܢ4b= |pMšZx"l\m4顩"mb+6+43e tTZQR>*=m62}L'NBq :D{}fo"͢8VO`aT?pՈ.aD`;;֔[ v/,\lE3'v3tքEeC僿242ۂx` qFwrqӌba^qPo{NU_"RƧ"%cHFr~=d گY غsUnr=ufЦuO7niF>43!8Ev7j9Y,I 0 HFha~nҡw @ ʪ-8V͌DcOZz -y7fe!`&hԺ>p&d[4F>V24%)iho&N#C|y]L߽ pז6 ObJઑ#E]Iv k*;X4vV탡1ڸzsiFs_Fɬj'FUGe 'j}[XfN{'bx84d8hC%il"0UA9y3wzYS0ono OU\FY>Ә\;{VhzW^48]DUGb׳ p<_sD0f4W vl0VO8L:ˮveD ;d1uj\E#`7RƍdEup;rzNYZ2Ӛxd٠^`Gd.U%ѝ9s4#G3,I`Lͫ,,_?&ea a|)7ā mOi3XPVR-6^f8" 9!mznB2vNp!c޻qAk 0ԁ:$!ٺ}di_*Ci])@fI}+0G.:tǍ+ )arOƇ1k0'@W5eN ]˜{|ʣ4o?FA% DCP\SXҘs9yS?;liN+)x#r`Ald՚݌+,;l~soc䰮Jo|HcGC8zh]=0$*r0Lk|spq*̙"=X_])Dh.KEdS`)֐k .:9%*cAoT#o5  #m:N)jXmFLԄ򤣗);xWkh(% W[(\pYnVgy>OKT7E-;q-#(x^d9^.Zz ZTEt $ ԊK; lĿFE~w&mkPј W-'fNZ#"DHVg0OC 4B!P~v_J ܺݐtG0LT8G[kJx"Dٔ{| Nm;p{Uot)#[XWs9 …ʧR99݆2nc[|fi{7 ^)9T V`9`7K,N>| endstream endobj 246 0 obj << /Length1 2026 /Length2 15603 /Length3 0 /Length 16840 /Filter /FlateDecode >> stream xڌte ǶVmN*֊m;FŶ+vŶ]|{[{ه7Ɯ$*tB&vF@q;[g:&zFn&#B?v8 u-?"DΟ6QC@9;[5`fd@;Gn @ mg tp03w<T&..lƆ9CgsƆ;c *AklFohDohOM pp6(@_6H[8ۡbgf|-N).&@G)Y=9&zO_,llhllgcohaak0eݝi&Z;}ZX}!@\H `?-읝,W6ٚm'j4._2L\l-\R4m3:99@؜T=r2eeog00~r2t]>^to00v,li޿;@sIsLl=3Qu ۹tl&&vVhhȕ5pgf? B ߵ>'{u??RM_U_2w?~C kD|N} {uMOslͬF 'q wvhd׫@|elp53k˘?o?sMbg Se0e70q0$F,'A7b0(>TFտAoE㿈>3}4/bY,uoI鳓Nk7L0iA;dV4Tڟ2-?Z~ɟ/&vߓ?fDKeL\铋JB@W~鳪)Mg7$|pv/m7קtí,[w> LQhQy8tyFN rJCY\%~ڞW#+UrqJO L쥒C zba'Sq. 2'AWQVz1oϊnL:bg\K2IUE~Ҋg)n<43alL!*D$`4MgPQܚqjxЭRn`xưZG%3e]N&@/X4NLj&\†ۅ(!1)fL:Ќ' P2^e-Q~ظm2wur!QE# ;UYb:H/\,|jvcd#^ _Ybjc"@gM 0iO* <:>sqGK%R*\z] cݍ>vk\[F#6WVKti P jW8B}ݑ-ѹ|dRRL9^|ɜM*6ߠGt띡~,ي m4!&* ž^D9gwNG2}ٯwLtcd_* U8i%'$da.Em'f<ȕ?%k+{<]r3?Ӆ>`i$VDG8r䀇a,>кl<|VPٟ]tq.#dnUg\ A qqA=D./Z κ` &>2^ɁམP2;[~ڤ*4P`Nl{+Y4bd܃uG^Y/yDEL!|e vՋI'k5Rͩzq)t7xP9q>T\ Ւ< 7qOh".˕lB[.ENv(C`ɀ[̀3ћc/:0ͦU챟,Tlh%ⷀ kg ;jю jC6ie)m:4Ķv;,2u.ި4S5\\%(˶(Pb-uD B5JrD3,4lسlC,^Ұ%xz4Qs:ζlgPˈ_ D6PkOP#Dw8nޒ^|x !@Qϝ֖ږg:^&'#R#\BG-sQ1)r }S#~)B"fC0e\OC}.Nz8'!nqIMA"E C oA_WF*eذóƤ-}2R>GA#vҰMMzH#8$g6eh4ͅ$Tѿ| FVd#yk)'X,F G$P.e`Ziϊ^#q>Bvᚨ^ *>匐-ZSag4A56&rl8(lื;he^A*Ÿ,UXrN2xMPu %T nWVuԅoztW|}o5,*0 g@݂J*|dzY+M(S,m^4JL3&RH ѹ6ukI>ۆ%|Pr2 OUs!"h*7h))S\&*lTFz=KACwOEy7zL>^Pφl9 s!1Xޑg67./jZ1l]`JY,ǘ*5{CHc7# 3!#G1zwlK $X?,zBBЌ\ $~v .ZJs,5IrFt4 .־3_9C1HFK?X} ]/&_84E&Ԙ_p1tkGV- |Y$^ըJePoқNfa8x[j>3#%g{2qbi⠕E^옜;LcDxFZg"kHikƔ"4V|X oa81+d}e'K$T(^5 "yEURro WPtY $M[ V*zXc?Cֿ,SlY~cl#כò9;4"C~7N7F_V~#wC/35+(""Wgv)=sĚf[8"'>ָ ζ|Ol+HsUtl0fl&b1 NIwn`t:w4!g @E(Zׂ(q)o&p}1I"$V0HHt]"cB2/X寭j;;T9ͯb2z&k=*2幔n o˙93]6:RSA& I YA99!w8e=ixp&pP (G()=z55RWj}D&'~euRҎ,/^l0 5j`V 'MHo.\&u[Pͭd\(̋.t҅>+ޘR9s}eV) ;sCr#M4͞T[rhe6&@A'-5 KPm[ckKh eղ ԠF#IF`we[<%qe_4w}=+i*n!aѼt"pЛ< Lǿ7ҡ)J"G:MΠqu? 56i丆cߌgU;U6d[1!“[v.k߽@sKy5PTA ⫿ms=LOP'LI,am" %Ne`3b BsPĪMm)MɌMpbq›v:{ PQEi0%e-82r8%XQW%r^]U4Ӈmc >\xl8*o+&e谖cWb$g#ƕVvU֨$rdbEgM"S@P_]yCx쇍vAstw$׾qc! &ZGu˽脁jH,dkۏ$1,D9I^h)70mא2eG ̠$CȐnr$:ڮXW?3LJ+jnuH8a^5OuIKCQI?βM(5FMpRR8"YM2騴CU" p0_rlL)ƘwʸC-gCP\mz7S`L<a3s-yl|EtP~}[nDYF?Àەm\ ua2٣ &'J\*=.-u8 ]S ^vTKs3 "2˶}+'mP6Ԁ"Tyo*yK3fh BWm>O"|5<=) #ZxDj9ث?/DRĤ8.K4;gANj_1~lXPݐWŎ*\;0쐮pmqo*Fl` צvz7&>QF$J7V-vLg~w߯10Ks7`gȠcl7=N!'(s/tRsPd&K(iVQgׅBl7<<Ϛ e|H1OgAV)ro3CEsNZWQjw4C0I,ht_/*kJ {Yjlj>yj夲F6A5խcE&%_0]|dE}*aMIO{ u`tu :bAI( TK1?^G_%sb5d*}= /DUw߲Wպ!,tHb١W=jx=`]VnGP $$DUCgK'{ fr8Pm)N\.sc'C MCMs!w-kzu>`jԳ6i/֌L->t"b')}5%72g!4d]>,pNWNC _z'Z?XM)M;7GKbķj+Wރ:!1]bKݷ2KHXGxl_E">?nJ}6z w'?CׁXx.M~k)V/! RX:I=*5U@A~^:9/PI.;V]}X# HK]'%>0H>}0i,Wgp}s,'1KYF ?_9ky 1틒P{ V\4Q0bNww)Jq߾|PIUW?a7&ʼng'Q:UG*vF V~GFd!( \]MIJv+KbrHa N hc/y^^Y,6 FԜ;9˷OB 2p`q ߂b zoi1ɍ+@w4bhO]@}A1aOy,ifu2VX&2`X` ݺn DQ5W(/[NqP]0&XzrD^Z_\DBBOo~9_un Euk({sÌ7.rOj ͘?<ɛ >S0'b{gs?"9JܭFR?U{k) f6P`B.!Ǹrům]WeQVx[ sW&!E]J!s h2/蠴Z9y n̘̗ĭe5uYAQtVB%H͸0,2a? 3xpԏz-TdT{ls\M+O kfƍ|lrrK4]}`|+_bjЌNuePc\bvM2ⱌj*Gik6|ںX(}x:q4PC6xfՏ<5A۵>Xcj> 3n52]Aˢ(ӑE[\iᏭ%_4H9ʻviǻ+ptIF/`bcȮ] .SpiM.3%$aEWpH翄4%|drdGdঃbA[&тJ wlͨѡ׼\-.]4v7&m޾P"Jy602{=Kz,HJ<~Cgrv+m)X=$٭?@Yލ,m:C } N%e.cH)_+} Q!&pFd 5he%/訇tU9f1Af,m.aw^Q.SeW۫ kDeP`e^`fQ %0MOr"=nTl55\eoúS)A~O{p568v%Lbҝji5G@#!9Nm79eu_.Po?ÚUcp9$?A;>Q *(.m)@ok]Z4m5##`!F74KPrVŅ4nH& - A{~#(eZ()fW Z%8kt;训EIʅ~+ wǹ1[ >`+v`6dNq &2{qO|F>t]"}赱 /ΊDgdk\JWsO.xRq*TNL8)b9XuxH<)OZ@9G Gt}U//f+_cr94wBv8\V+tC$k 5䍪T3eyKđ>gߥy[]MyF⢓Vu+dpm/#Y"*rײP[,KVX{ u\: G,쮁npZE$ ܹKQ{<}al2j슳i5)PKץյL=C @TKC-/,1G|қ85g묗?)#9`cJcQf3?G_#3P|8(Glc̵WL5af=qCFz4GшjRba'L{+2[i=eFd0eVihni~hteT3j<H1Q][l>UM44:xfDx+`yjOШX<`$}<Ǐ[N _R U| BSFxp]xu?ʪrpk})o^.ҎN1]7>\7)J-RR{ hd6ٲ)42i֨GΜhu6۟\v_0ka`AgTQ?2vH8qb9% hhm}È3%#Y*HVfl4*ƹR5 G%pVŭ1-ΰ>Xy;[gD8Z!(rG:D(ҭVElNgmhK㬙0)m L.XKbii<5@"~?h@k,Fb] '֖e mFI˳  RȾ̀t[أM4[lR-j<\wЈ"cC2\٫l+}ջƬ4L2ڟ^l\KN,i)tX~m\/jfD4ʯ~ ՙSwRN~CFzJ $o߸sIC28lE1"e`H>q}X!UxHr{2Ub2D+1pݲʋB]с?{_VRu8ܿqym<]@..r퍧խL0dV7jdZZe\Q"S%LWQ>ٜU5ɬξqrM;(~A(S'u!aMQHGկja~TYɕoӡƛ @z.'xZ\ 4`jP!Ʉ9SmS.rUK3KXR]gf񞰛Y!^PXuKd$2BMYb∮B:9lvV}9'ЦC0Kx`XR,@UQ=Q/Smċ{/-P2:lXO#}7P. y C.'Bux VĔRu~u߲\^%Im~1u׶zٚLCO4\T2*+\h? \% |"M4 4N!=fZ3gyXm#Ny98I*6xiBdmȎ*OaZLJ'.-#srԎ|Өԛ3A8z4;YF[?tSUj6(!˰b`5Fy?8EgPW#kzBKhǢ˨w\ g9 &%&= Aњ?E=j65R*A.HQ3胜aU)yJX0jL6٪-8^o?! P^:ORG%[cH'dxJ_{T¯:tJ'B;!f{;-c@V:&X^TZHYES|dyb1z$З򂇦zѐЭ/\~0WEVj*K;b/lnB U?62zL`.HUiSiܝ* Mgru>vƨ=Dij&ʡjgY٬ꔡC_xBЈrN_ 1J>ֱ@'0Fr6)Kﳾ%FbE6 U-//ޘQ -XyL[PE$?xm=1yߔqADJIN=9&1k_&ON~>MD$}8 hhxlkC=^5Wcd~B=0H8~{˯i؂*hԿ7{Z%ǛIfEcN !=̃Tֿ`9 7X{UnNXE+YdNcſ)N,؞Nqv+mI kIƂ gI *m-Q:!L"]V<@U%zbzP!,9c͸6ykh(om! r *KyZC?nݼs1nLsiSh/o=ŅZ᭛pS@<_J]b:&!GM]W3Bj y6++UcXPhZq7?sÂ.h^E5ĸSvfۍ%W-̓?t*CqHicG4 E-Mh+"-uc94ڪz,TmU_j9g-8(.(7@3"fk.h=S6h.±O`&qВX D|)҃JUZ&Y.Eh<2X+% :({C"Dzm0> JN66)Eg40)ӈs!8{:œ[TfɠT5;#_MdwWo~hbLb$C?>R%%5o]bp '/q>kѽ}&\_L0 6 qPRB2"Qֲfw%֕N[jUEg}l}vaZ^LfTcȖQ> stream xڍP\ Cp'hpwww@-@$58w{so=\TEL@RvΌL,|qE1V6 ; "9" lg/ qGU&t~5TȹXX\||,,69$`3"@H%ngt~G)-/w l (-A6Mu;S0BX:;131m-hn`gK 2 PڀƄHа;P3wv:k) xPU(ۃl6VۀOsL @`ۿv6@[l (K)09;3f Nv@W hjW@*~N`{g'&'o̿üYLd> #97 3{fM[ HVW 9@̿hx؃RryA?^N@Wo"DVV`"*_cy?V ^'_G̬(#Uٹ9lVVv^7' Ww}Oɮ? B XJv t}N/)uoER.i6mXN(ڽ5bvfW' |Q[ $vM-嚿l RsZ,,G]VׇL.53el\#u89^hrkLvί.Wrs;G' `-q n `/0+U 6`/} ^AL8_uv֯1 A"f Vv.f0[ cNZz[le* R|kb^|mKZݟtv~-5nk 2ßQhVuW&N@Z5_.Qx]}fgKGпDg79p|+aի+{Ͽ+[.LfL>TV1n NQmk'2z-8ܣ%Ж XsMB_ޒY$}:lv38NXΡhb"F O!2\xPU0ozݫ- ns#=M2FiFOSe|#uf$8uGH{!L}Ş륻}7RԁOG u1N[!p 6 /?`(BUq9aY>Y\ߨLN"훕}-,cVV<8aV̮4<~.DŽ5W6M,8pD^+G_Ї=y3"M^Ce@-}[c eM m%&\I֮0ӢFN!*7EHm&oGy]{U6c+\gi], g&%F2:U# Ha::2zjҍ,\oznk&Ea2mT튗TD@!+5)4Z 9EV5}I|8\9րi$Ja&֌vKcJW]4bvA*cdmB B|lSl#_g?+ 9BB'+/GvABC [!O4 Dyd5N H{/ WG+ĵYlO}?Ō'''^୎Tr{~]5?i "2ѭmusaQ.|ђe,O,K^O-GPr{:|X͊ΟF͑ <A~HK t{~$##cXf]Q[5`vm@RGt;if^ H8{6Ó"OaN2 l9m#>ϦsadFB*R9ץB0;ɘ up-<7rx0wVod| !5}bB&J3bяMMbmI܍~cpL(}WwW%f)9#| 2>eLTQS8^v-/@[jtYm& 7?H3I_CXכ̎3_uUi9*guB}z1jnɭg*_,M}eAzh6G7 jطSPz^=jw@#Yx"]=|xo,.DY7GEK nՔB9ɂe y:7-aFr_LG?e_ŜZ~JrW:.Zߊq(෠k)t>eu9uQbQT^qH o 3zƟV `,1٩z سrE3\-sNFS] $:td.KYJ_n{cˇ"-]Z})P@`ޚA~}rCnPT {*(9^-q(( z4ZCx<˅A@tʯ9vQ0NT+j#.6fg 2 <6c1-ID{NVBJ ݷ*5qrũnKX|nJ߰i%\1@*G }Ś2Q-3/ 99?%Pl-bőkHTcۘRHC D5|NZI@2tfkmˇ(hP]֖h1j#,/$Ah"*q /&1K)aȹPHUt:l!XF;p6 oM)YƜȑswx_36'|mp[ۡ2Bb=7WX.ܯ @UEqmQ w$~C712Vn5b%䒇T j;[5V/ʴ?)9MF?Q.ZF/Q1l\|"ۗOZ$6V:h(fC/~'WISwLܗ6q^jʪ"qd: a@CzJ "fOJmUEz>sefvrD,fR!;]5*uD"9:".Q.,5)ފtYdX,SʵX_KvŗpGTRop^C7]`@juhiC+olJ/VDcMmP޷S1fW̓2c"Ӈ0 jU%ky( ^B?48A=):H}Qx$#;3ǣO# <6Ac˝;񌋂Hv.Eя40a&^LQ/76ؚvle#HD?8\.c,RT0߲Z8$[%&E2tY[B[VdNRJ]E&unOf/oNBЩ|@waS4'|@ e-"U|%?;<{ mMZ͗ro[2se!E3 2g8āV$~DٰCryw▆T!uj]F-KZ+&>&!l4 ‘ȷPi"eZ7uzgHIN$Ht2j!m8\bG=·Rj7!H2ƮLq 5uJޫ^m\<v|n9b@M]R_*gO4Owt1Z;7 F2H1RJ%5κwÞeKMXJIIqu7|XYV/zyMg FϢf8O.842y\xՉZ23)8mWef,ER] ]ERlV?e^F{`DKRp:$3nZĴvExZ s#99 = if&`O8С 7'O%u9{BNjBb߫ʩnRw箺vn´Ѷ~%R *WRElκ².[ qpUs\9${U|A\Њf)uqS}uF}uᦪG.ЀH߸!tec˰AV\@M\=j9OWR0nA7yp>B1J~r'D:T)MLjC6l[ȠS3yxI\4!R(R~ e)%GC5U;--*tR&{%?=?%@#vgxr}J|3NsHeak'=]|ry1-$A0F}c-T[aCl-1|øԦUS۴1fs?8 7RطKR?ęHC KSȷa\!WD mP=m.`yIw)e#񷸐f@IIe<on?n]?+f6:wnP&b o~F*k/bˋA(([A' K<*sM*=BۆKj֢As,YFy$7jf;6z6Um[G+̆U7<6AC-\s2wVg>Aѹ6ga& ]zEEp;ݓr$QHq6X5Ci!CeۤwYY4[\AxX~8J)"b⼟@Sr$+v^m~}Z{p6SVʘ-~z0o5R!_z`0&E|?K y7[uݨ# Q88xlnmZ +%`Nyԅz^TYU5t[ J,˲T~M@LYL+7/[b~yv6}lղs}e*uK ; p-idCؗ>y`oNd3e|\>=߱H !=>j^!ǭ oYNAJG8f;eZQI^:g;o2)UHzKu8ѝEƧTlp5$O1I ͗S@`T5ε:>&Cє[x҇Z / J>V`&\H3M b;ԋ#oeXfm${PLg2Q(/-$LSSlP-yռ& n֍oeb`O?㦡bפǃYQ>Yg-[Nm Nf\eUp&Xp:0ҹU='vgq?sۢ&],`&lb3@H@-g_=ui3$t &I:` G(ΜȑX~FV+ѐph W4]T j`RߺvYKشkm z!{ 21RedP%aCJbg24$5vH\p7'N4)lv7Β.܀۝3XX7 ͗:uW睄Z6E{mFFF~ٓXm^{n ꧒c ltnw?IY mLR}D%|8AzB[J)?({Hu`9"7 R'*Q11ߺU,k+OBX6 =r\ s1U3 ,fpeܜl 3!Hʁ >7r[pNz֗Wc= *%ʺ8[Jq],`Ea#ם fvQ1s%]<*„$CoХ {`*}z.F96)mҺB{y [̖iEywu*k#?ʹcZSKKQd u}V9+MoI@nM3mo?w^P?|>BYLuoGJF6-Gduzܡ;ru҅Ko|ٖQ#&d{2;~Bp~# kߺդrJ2jG ( %$;M-ٮbk⢝!#\s*kt:rCv-ϻrlЉ^ڼv&Ro XͺOeGxVŦP#ޔ-"z::KjW=hɲ jUdnB"¼~3gcsIconݨSa8L@-q~cz-夗oUu}T=[IqӚb\+ >J6{P0TP%/INM*?gO-_$* 6j< !"-^0<'G(bYUg'G5X@N2Iñn;)mLn;vEl sh]T/=l~Vxn/HR^r䔥Ep+)̩h\F3'pcd\&~V8ڳ59]mXYm}w..5\OڬwI;?Lg Z?.9<1&[)R0=}1T!q_3[މh>*)+tD^IoTo hү9viRol30 >w073Ed*W6/J-XY&A}.hYiR(]{9nd-@rN3980zzQz;y8%r86O;0sZj̈́pNAu]xzMS>a"RDSˉ9P. mxZd":`"c(Y\3HCQ{h*e&5Z]§'6UU7'YSl%%{0_{՘QzI+BĚ"tyylRTxdt:_M@pBMx{jmmrȎQbNmP% L_Rrjyc,8aCT/〦\ jsy˾4"zT ヶRpcg^ g&ieoѻB|z/}vx`} mku8˾"Op5fڻN4Xc.SW'CjXWR8ܤmZȊr2 ݛף(y9flc &Q[i:D?JQvS-]'G\ H+ƕ_qk1055v~@a%/1 m{!nmknL%@Տ[q:fCnP싱Sf& `6{ң׺^)Yǹ(.jpfk^F*R_]`{91KtvP@&zO`Y.7?-&Qwk yCx0B .wĮ Z† 4o-(*M2-u sX!Z * Տ&mHƟmRiSL-RLgRpCG:O6pd铣[/d݃1"W;ae,?ckyԆ_jV^3 :#KtD^ѣ8a>HAFkpՎ]ri);g%$ "a2L*J}D"VڙY&<O7*Hѓa}8ȷ-͚sI~leCojC~Pd~ Y*b57D{x)k4Jw6?lҋzr*\ f"sWȻ0 ~qM`yMUiKpEjV\\"܂8yg?8% QOW&缬y.!. />[zz L8tl̝†FwMTz-쫔wqFFOYk<ڈߎ}BKH$b[??dMNZ3#|1SeD'# k>Y;Ok"wa"p b}da—ܹ.J[45D%hXTY[,{WL}%*E` @DIr Ҹuy1,.viS{谼}TÝƶJ+5|c p OǏ?PPO0O&< ߪY^|n2.oVv;m/V 9 2M4P7v \arpIo/Fapt(@{Jtᖇ RZøh&Qn8N2ni`(|>F!+['yaaGrر%"?bP44uK Qޯ{1RGwM<N|H6'f%i%L4FQz<5 Sfٝ`BDJRͮ61%H`f"WȤ] + Wu]N*LV0SžwTViAYJ5 RY0Vyu_2PJ||ї@ۆO=l8zT]o(%x>S[y$UԵfb]fi^Iʐd \,32':|M=qda$-I|!Ӣ4±YVDޔb(gŶ߆2j(ZtɮU9 lZrwӨsTxzdaqToB -/4zMxrS G$7D}Ϛ_6d9Mo6]rXOE#<2`:Vv/ }TnUEs3 !_<wF;ug%Ymv/ss@ȁj~g-Lk|K%GⅧcDtYr˓$R*_2rd2u*wrv:sD=M)12L,sa+^ h+C 7  4 +*ipѠu:L?nm95O*\u_U1V7cH$ (z7i봁>v#; ~:LZl 1<ڗsx" FARŸhobv\nVh'yb r9x3@>˝:q*.nLM̍I!Z(J B"ih$DWmTeЊom:g)9Hd|sL;@р'YyB%vHr'8I=Y54y't/!W]9!3P> 4#`4?QN_4ZӞهYUvʤ<69c g2?Y(& eob oT]Qy[D<=_# ~[ ek{Z7\!Pa[WK Y WlT( C9K)YSeEok+EtxVSյ&ɵ̜XWU aL?U8Goʴ e}ͮS%lR )^)*eŖޔ#hcJRio5|(x buB'n?gIFҙ+MYlsi spezkBᙯi ѓZ =u-Pe.\Y)aqȝgGs pk^4o禆w5F[ ?(eL@amd ʃ5d806De|}*ӷ!ia=de\,bZD#u8T0AEӽ-yUyl\\]*AѲ2)qծ=Qg.yk'C{1Qa?wQW7 W)gzpg.,ߓ{Έ$tv 5#&v0{rO߻7IOD!fc7W"zӐGi`j@Pc6L9Ϩ֢/[QlӾ'U-qMD^D'@AcfoKD+HPů 7v|h"'AO^&E_!nM?+JGuboA~^2zL kJ] X޴@'q/4 iif4L5 rÐh. tpԌ1?Ed^M_ 9/Zl[?k֨xVXY16;0mqv-FPsDZ-F7gߒz0 <px ǕޝӋ=@ .M҄jWU^?s4 D{Yc&DZ#QFb+"7yj,R|_Yڿ˵ᬨrobi~]o)ط'BtB H/9Ęd5 _wȯ=vQ::U񴊂=t/UX5Aw68/k*Iz-F߂/-}}x*%ǿ3d~w/M,浳9U[R?kӪʯ j\>J[gDquko}:sѵx5Fn)@k&f݀dgqʸ׵[#]S8w]T1`Ά{:!$,głU#V8ZnpQgQ1~O2}zR,_sǰJ.gW0 e< y ~'+u':a .!'BK3BhyQA7|WS^~ M! [f^'A9Rf%/˵~Ψ=, Sr")}rcb~)e*S'C3ᧁ$2Յ}m[*!96ɺ81-ɼc3$2{8wW(G D?9oQ{rNi"zMԍ;׽b_||ios&,r@]0NniWM<w_j1o8]Iy c~,- `RfY|VZpW.Y^NNO1,} ߗxVR ŕc$e1"70 w,A G\VCr%q`rk=3 i<7ԐPQ|0xm/&-GEU8 H֮R}9 %<~`8:ʳ.󐚼NBѣj5z-?>2_+#יUٖ/MiZ 3.Re2x<2XdᩉQF&oǾ<ȗEAwOt<|!2B3/fD$2lk gtc ۙ clT0C_ endstream endobj 250 0 obj << /Length1 1507 /Length2 7500 /Length3 0 /Length 8501 /Filter /FlateDecode >> stream xڍWuT]ץK;D;f`QATZJBCnA oy'[oϹw߻oaa瑳YaP/$@ቼ?__n`T8@$ PwbA~~apI"l x PAAnx, 0o8\?vr3BO3rE j.@Hyzzxap{n' [/-3/qx,)}uCCmApr}&@xjgF`b Cv`ɋBpP_D z5{@.B78R 򠕠 0ggk`8y|] ہvغB 5?Y1{ /&&@^6|1vN#u\vH) pw?Fx[ ` C H^s~ >=Y"}f Bh>c%CuDy|y%<"A1a0ߝt?wZ5 dž'M{?^Z0A o/ow_]=)C / ;9O`ȩ7 SCS!G:G@_8M#lpq_sCA:07w raqBOܐ!g*Am`NPDÁxF"r:mA^ R?ub>_HB FH_HiL>?0ot"I"_ZlpR H:V6_xl~ xCc[7XAT(Ռ\֫}:' ~~^IRV7cYsKpK`v%Sm!WJP7Q%%Қ=ACܺ~|IP`2=7*pҀS^\Լ|v/͸d1c܂_}df9UתiO-n(Hg{gꚯӸiU'Rhf|a݈jsƗwl\& "LzuXC֪x =rc/`Ja O"Sd]x8 |W!WF r?p o;:48 O}QYnlhHLl&z̉MdKeuIxH.D7)X2H1H?Kԛ,mIt7;&`cP n|XȞӃ =]#ݲ'V&ٻׇ/_kDS=9Wt"krl@WD,Ox XW 8b\;#~vil'Ȧ$)QSq&[=}Y8SJx}w2@C:yxxNQaY6qB[q |nC #Ħ{)Fj-}+dhuSѯP.{0]<meԃdtEǘy^%& Zc 5u9cr"m]&6 UѦ%5-\Mhp<Jx)4M8%մPb28e\ON\#qIQZew &]<2!X 8=ؐ m==0^d/y`BmH{[yd4Ǵ֝G&fgaWͺlTL!U$< [SqK |,.> Wcq(9/zF//6=ʧ#Wb/:-;EDOY-2NuUsMiX(o 16{e6SYqB)fD|ݘN?.G.1+] {`)XubT3?ǥ+ O?jh,|rW0ȉvZĪ>q D>9Jňy4_m}8Gc}L;=r;~2?Sߵo?¢mCnVm [=]դn3,Z9֎:%:*TEYCރziMc?V`! WF"x"nt< 9gDη lq|Y,7VJ;b\ڷ1N|CNh&\agk&fsje1 ԰$%op}I|8Obop۽o?Ǥq@>* 08,%rͷšmzXMZK&&5fs`h2Zo 4p'w`-z6ot1Xž=6okR:8w>oS"H}$#+{fo-7 P+ ͯƷpǮ*SFZ~˰doO)}8gwM0[+xV9RRq7rB~N$=⡖<!;#^6U{=;!x4G׹ѥ^) 91Ctĭ ajŭƯiv/]ȹ:r2(ZrgB`y湔6a8Jy$1Ѡ$.y1=!>fbr{;#gXDn3d'שPeu:Ro'Ds0Iy`_K<8Ӽ[ؘ"汜9M"yP{Mxjq f/Kp>^njiLI3@a.쑐eg~RBr̷5ΐ9d_p@jGijo#uG${~ }ty..ÐG`.1Ru*L7D=xY`[Itp0]r,SV })!\fnvIAq(Tz"Hz@z b=|Z//%=X{8N *AYc+W}ᝧ~B>;l NRG548M|n䜶*dgp3c_ݷ[UU$y7ml!![=*J yN Qsc u .snވ3q*#]u{} ??]]t_ytbUNüQdT6:YNjN\XYas/I &soxéf!unMJxqoƤ Q}>o-PNG8[*jJ7|E%Xm[PC`}|nFҒ8Xa5V~Kof2 <ިBKAl.PJӡ8KLmSaol*"BG[|,n2gV؂Fu8>W),`e%Q!;EwJǕSK'l] ^<f&Aٛ?Wv;IE{: Ty-L9P79 %UZx;JĤι8^ [uΈ0q׶?h(mS},6O 2g;}W^ZJi *\ު g\wS,e6ӆ^WfvUHJ\Ez8B1 Dn/ٌւCZq*j8G#seͦѫwAR=,7b[SΔb'nquQr/+p±3chXxYŽiZ$}ZPrZN"j=Cv67N销Gɫ/f!99)f6> )ޠZ= *?Tނ|% m! uٌuwq'A&_*_3֚g8R(y[#G l~6NU9;M\bMQHB o ,iEG=IïtvIoFenV O'j^ s*|P3$u LU0HoJAP V^k8g^]Z#>;s/ֵT9ʔb![^|ઈ|uZDB}nۿpa.W3BMX j_CϻBbZ&r&xM/:>w.0ISS9k?L&k |4L*@"A,kkǧ=EwjnnTs,X2y'pVOIvf97>bM[YȔW4kC_xR`_+`f}JDyZP.ZeZ0:h_0{>7ʠC=Nsn8[UЮRg):4V-nY?t6M*GpOYK ,u›O[m3 ,.-ipӸOoEd*(erDH#^dU&է:_fTR!ѥJEfaa I2cyϖ)mYy0ZR[5KX) ;RB|d &kv1E՚S1Ě~iA(kVtJ[ ʑ>(j8{v6WSddnP`$; g\;`Y}U _ER[Kt<eey& Ǥ%ݢȏv24٬;푓aM7w]c*8֟C͓mχ6}3e%>ߌ#݀YoSIĥ>9f}cU?)we +lN<=],G_2o$z/Fcŝ"lɷ>My$^[jxj)3${.Ac5žzDH*X+%W52jqjf[ߒ|c? YTm%4#9^AțT2אL旁LϹjE)z,ÚjC5vT"L1p QzM]Bg{B7w=I`e&NRq:Si[REhϼp߱5p3uőcZcWU,;{$DQTb<,)ȥ9 SQy0R zo;C3k0?zX<Jи1bT BLYT.3Ϥb9ѠϖϪy/Ԁlqa3{W{_"ү/߅Ǭ x%\,MVˮr.cۣ W)%_ql0kMUz)ʼnLQA\6v> stream xڍ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 256 0 obj << /Length1 2730 /Length2 23195 /Length3 0 /Length 24729 /Filter /FlateDecode >> stream xڌT .Ltw "ݝC90tw -!HHwJwwKg>ֽ`7Tde,lIe v6' 2-+Vb v@h IB7#+`cC@P;]i%^ζ6`` nt0s(!f & B6,f.,`gkW[W*bf2dZrM3l-.7K3BДW:6VY @9YXlV @UF 7s7C #0Oy.ζ.,._% 鲴$+?)[g^O`e`iK7GVm['7?&o5 :6ky9RC*q; El?>.f@O2;;`u@"Z!wAvO!e vy6kJr:ZLWNB ab0sp-/èV`B? #࿱T~/7ῢߖ'$fKQۂ1,+3pߦVhiffCwF[[O\וlj`_3d4K9-7G d%R!_Ji 9;y!C Av-Z=Zb+;#(7Uo`xU_@o5?U_` ֲU7F\VoIG7AUE|v§A4#oioa 캿O_B.o~@5 1w6xs\9}7* |"nH0 03rr2Z!  4sCrx~qrH8yZ`7X~A?h 7'K96w\x9gt? ۠? dT yԲ quzH@QCqs\H.G3)_2[sArs"q=_ 3}%-AɅb_cV΅6s11nH ߢ B46?V[Wn@ȘNK=in6t?vZ{1Z\$K/qibwO{7  >#f_/`c3"==+;Ui]Ěy`yQy6vzZ@d)mΐ)69^]X7RzZ"UE={KS%/۹5SeewX\):a4n]PDHXUi1X#R?vM74mF`njx4LT s#- wJ8 ]-ọᶢW%Rs݊{Bsg ;^rԴ0@fa.fm/R=Khj|^1A98A*7~ J|".*aYCv:sr7'AɆ+2r(((ZV*d}Nʱ[kp1Yƽ +6jӇY1S6_ݡ}Ѧm%tr8Aa{FwVazHXHPBS}5qg8jXXOc ,s]5 #P %Pt><+F7\TDװZ?Y _(EJH y-0G)҇wrMUȫЀV &7HDC3t CDe]nyyEb2#ѩuk9hFhŽցGKv3MdCfȼX.'.及 &> aꋻ#Jv|-uo mW~<5@ɣ n @;:l%Rqup2Ls(Ob惉Y} C6*w>tvX%w){*}.zݩr‚rEsZtwVX.;A-j:⌚JB%8%9WA>m( fdҡB|4fX]Z &0O`e4]'҄4MgҼjk3 $1U|l(3䯜^3cKe߼G ܖRu(Tfu$t%Hvt5l^-:o/li-iQfmQ+"41Ӊ"=PϫDR{tɻEJt|'qIkHr?}g!F_OǛYp˭{iT,Sf5w Y*zTΉ#8<9]ʢjt<3<:WHxUJfNQF+>=U'(hϞ7QDٰ[2:5hxkƥNP5(_w)l4THt1~s26; N4R7Xg%!*Rʲ4JOtI$k /q2u?_l Ɗ',}۩ߚҝ kx"{jv Id.oq©\Nhd/yKn%٨,\5g9=,*@bBR%n JrRA&^GO"luYd%n$!Snk<5?a'Ghd WݟY%94KKuXQ_{1X7!m2 $sǀ2N<Zpu:aesPOQ~F7N(N K[PliՖ.Z<BZK8VHMI| 8'g A 4F99ڡJraeor=Uj1Rv1efCc)PjQ.nKKE^%ԫ_D'tȼ,Y?5V\Y|T6 )פM7I#cй0OH \=KZ}=vw<"-bH;:hu UWڏϩYmyZlFQ':ju9Ld:8*( 1! G.S!Q[Y85~idT5҂Yv>tcC$\I48.)=? V`_f4 _\3q|Q(%%)},Xt o8;Y[0]ULf) 9~n6gޱw~eBfR#]1~!>ٌ|9ѩmh9u!cwK慾k\[Xbz,Ej;%n}Lr0qadՍ'W\X>C,4.>͚D! {HƑ By +qWkbOSXbnH5I&5| zM>V7@YM_xjL.5\8>~tw`81MVJvgH}] rm"G0&\ TZo)LXw*lx<zMf1#'d5A ѝ>מ~XsCih@AțUrZKy^JY7nLě9{ Ww(O1Cȫ\o"MDJmh>wC;Q55(x%]P{)t"JvQZaH!霏f$۶?B v?Fmuxbl~GrpMgsx^ 5(>Ni;pdVx{h*0Lax{K7c/>[1-4.怩^}~=~no=lV+7!ԉwPR6sKTuG3wWyVLĎQHtS9RyCpHGJa77= OQ}=Z}}(V0ᣨ&&Gev'`ɈaQ3^k&yջ9=b)8)4J̱h\YEUȜu:<_W5"40׽er[1 wd1_}DZ-2VQo)79|1F&%p$6+sB򌂨׾V-Td;e(#Uo2E X~<JJ4ޘ$E5>J<λcꔳYף'5n8LXhzĺވPY1 iLy#Н+~{~"l~uFT>xH'=gn2YVCsaj+#0 <+Nq&V- +"mzQ ]h̍bȊqTc0%w[.a~j5q J?usMjpt %L~MzP2ZO^Np0aеՎ}'S|) mhH"/􋟵a):Y꡵Bzp LW/T%4oBڿ@ǔPuNwe}k^46/FBX`yIxPvˈ.i#WҹS߻P09MPR^Ĕ52m41Er8HhfIPsK-zBD> k؏!195vJ#M~~li儙$ޮ`C>Ro^߆1^#: K=cY1Je{gOFwNq|}.fqN Ь^a)Z\SbٳVN,F3+nL\AR(Y/H84 Ԡێf؀@;@}3"'Am>L/{"-[BޗCb|sk-5-Y/ǩ<j_\(\ߧs^J[j.h5i, ]w4rv'N릆Ư0&;RI6 MAt!O1r#gGR7OmtA3[G\$.y ]ҫULytޓšohW1ÛK.1"ԨoRFO`᎛qthj CzD{eܾ7WUǂL5B遇ЬU^FR9T<\Y&Uczwɪ뱿0@3"I'Ngi} wm~=^ϕ{';^+"~9]w-];tӋwuVWT:#ݖGnbh񰫣A"^F"'3aFm 4{2dS 1N UAܢDH&rDFucՒ< ڳgs*.yk쑤;UQ?ZӺV/&dD/PI'[\V' ^*GΎ\Ƚ9Sc,͂J}Ϧfx&U~XhXxnrB]C=mU-Oc"sB[b$ozvMc=4;EC!aYhp*oVA8dGjR+FIhJnQΰt5x=CX?P?MW :C1٤?3<: kDWjWڻǾ/BsAG;63|~;Nj7#9^PlW82=fÀ-wծPʨQŜ 5]|! 4n"W/Q*ɹf"у{߹kRy>M]֔> f|Iw;A2G\ Bm&Tg3,bf)08.~7}GD!ؒC25 XHyrǪU mt\yo-Բ^rWm`+ό뎮2Ѯ9FYfy?X[?S4py S{<^,š{o$l,zs(e7yfE^7\p <[z0[gW[zIxKJ|!=vW˧ϋ;4_>ZҭiyJ]`=uSM˅b ">zB'frN[K$-- o zF8shp;ߓ6ۣ;1Ƨm2@Pf(j^nrlϻ *_ͬqwȐDzwctbK-d9ZaDgDV?4seuHjk |CkҝH <oęk7_ ˦k%E'Yɳ]H^:LptM5Ny]6R{.Yȡ6-*ً//~Huz1Vt濽?:#6ȿxJGº>eolCb{\sՈ0vI T.b m.m1Refskc\%o!dF˻2/awĜ{\t@~>Rk[&/1TlgMo鬧\*w`Sf<}q{#p6uЬïyC:b:1'J4Nu~eD @pJ6W,0XYv*igG`_V#s!|6>U !)S"岒g=-\5?ŴO.(@]#ߙpf1VA_&}w5󗪐j㖵GjA\ׂ7Q;'$Kb=)=֤k7j9[^oB1L~9+h睙.p JjZ忕+IIs4f3Mޕ2CZUaV;t6~E@ YI ta5Y!7鵕g5=MO!ڡ8*Tgت/+)]"Fɷao%%C~Pfײ4&l#LguJJoԨPU|@FEH;3p) C~r"=}!T6>eU>B,H\L.Yh(F.X|bH+l J":WNїQ!lD_j{p:ʀܔz'm4h>nh*.2fG²xr5J%b[bzvfy%%䌭 ;ki)Ro`tKN"@'hGz:yOV\ԟ/Qm>Yj o|b|78l\ 81PK6ȉn;/_bC[[Cѧ?Ѭwی6Kۊ*bcQbWmU+grU|r"Uϭi |pjh0bLbn}Ԝl}Im8yFч]|#\DGy5D#{+fu2RH1ےb7mUfҵw@wsAXQ/R"AWI8od(3 ^Bhu ^Lfw6tHqHM8%/~'G{f' ^%7+Xz+y]2,p|a&y80exbǵ$EJuhDEE[a`fJ+-uluϴG/u2 &/*U_"<r{N">cy䥕*U5f eRjV i&~y=ƣbU~ f3QEANI!xBWXv֜Dzv湞r-Y?8T3$Ц5 ⩖Ea+)`B2%i,10f:j`8Po.i-ϳ[V ߏ'1jT>vݥg7<'qPOk) Õk'eֹ;#38-0McOtجMd߫ʢA|σ>x9ZJka$5dA.,5ŀ0^jqQm_u.mg5AԓXN0Bdq,jPVd<ה؝?bE\cNdЎ߾y釨XzW&ݓSޜ_h5\O4XUkn GŞߵXk.k>#Öbs9S\qK@3_|:h *A^y~O>/^ W:_qzra)>9dvsݰ=qxGw[mVks $TV7kkܠuP%`zؒw(A͛  ma7; z7sW]bǞÿ.dky4_}"Zڪo ̇4ѷ&SUx-̱UL<d a\ TN Nppao9<%. 1im8KORu܋\jg!尕t]ϒcQɎB7g#u\崂kziE'LЫK[cE\;k؊ÎXl_*QeO_<8ѓ6aa0N.nwVW>1gb 4CSzgvCӌGiFls I SPޑag:.wN5m|,%hjy$LZeop?Bkӈ;@3}\fnZ<8ה@RR`Vf a7 4C|'9^&OdZo;Z޼{vI8(`>yyklŀYC ൃYCaF8Y$m${AK34Q4N|cbpwZ+OX΍egM8)噞$Q8t%t.%G|rYUT|COЕ$j,CK(šN 6@Y*FZW⤅zd(BuflE;zm:FHr\VmK6^Am`/뫒: IJ=} ۲ 6k~r_1jM=rw9Rim.WߙlS35jQ}TJ3מM: Cs;m>ro8B 0deWv>< 9ZVژ~1 #[]L\TֲT,\QPa"_RWC7 Uue$GO?t]#VlWVARy_p7 [ &m6eR ⳳmHR-Ѩ< pfSuK+-{*ab7ߍƈ'gS!Qt: m83'?/L2,M4Ԟ$ /u!1S*YQYؼ?ýťT&P[3 5bLfb^o ퟾ҪEDZ6F&KvsQz\kF59y9cIμ'iFߪUt !n^L _xzÅ{2y@/%+>c( U;o?9D|? k'I.J>UqP&qS8TUFR%Jז'Z tQ8qnp 8Z i+s܆m+O ! VMFvN61fbl70uςʄW{bH} /K 0F/Fa2uH3 q9v 7eTiD+)3'Ӻ|}*h$]T/CЪ4P7~q޴v`$qe}D-NJ xC}SzǺL4#ǵb˸%]N}PY2>?'}ea|64lj u-j3UR~hv)$ %ﺾܩU5-a}gYr=2[&'D&0ہ놤mw4WrݷT0krG?.uvu{ݏZ ྑ bJ5 Gl]ݻ9Su]N*H}y+2*TU| |#ɧN SC8!c2[ +G7Vq|3ąYxR=Ss=b,sZkP"YQl B%3i8{+NJ*:lG=߻/ufvS]gi\☱tłn?at ay)w)dѠxpa䐐Z^8 O24k }"q ʬ3}ؐ#_C\yتu|AmH9|X)8NZ=@s6}#y)8|jb{OҠ&yזaϭ4h[Q5b;ԈXe $SEW5m&3gҋ5gƳ׮>ӶGVWwq=vF`._Q#2Z>|:EOuG|q歱RIn- .+[Wmkـة D=5x]YEܑ\=49/ĘfGOL\9;#.>椦2xڮJh^R]// X^B\P"dg8 &aT% f@ k꥿Ńu'޽+iFz:[Mi .ނFV_RN 7 DKa.Aq-ZppX(yfPd* ޲b&g˫I6;f .ܑN`dq'RZZJ MQ*7lE܅k5u5/Ih!P8Umh:_nks+54V+zR)WjBd.Nm<*sk8o;٢ژ֎^9y9Ph?SR(&]㈺9nu |Zk؈e5hD[N.ʐ@%j 7n/걵wO-;)F-4{>StH;}clGSURWlb}J>]A%kK0z@TMcuNdwW/ߺO,a:6;(oMgqp;u}R@$x_o +B^&~[Mo= Tn̕ӎ^,yIs(; #G~6kvO={|8dxliED_쿢NnzݟXF&> izBAqzsxgL}*G>+AdȏbFhov;9ҧkž "G%j<#[,M( !YLC](n5>=a<6킻xmDŽ&ʹ}ϵhUT\p-hgN&k$0zSURGkyE5G'V&pqɜEbuf9%yo6CyJ0^1N>th;\`/*q*|) ʏ) }ݚ$zσsp=~c ,UW$ufʫ|0EIW}ͷգhs4v) em`x7mdDg@ :xőx3m":Mij`WX湬\6&T/p<$˳Y_2seFr`]?%\6oNں+ F N)I=[s5Wq~LP@wK&=i}ӭ+lRc vx2Qm[Bl{_P:=75yImxYV9 /k_@n~ՓAݯ̿`I:F6Zg4:+Ԋi!j'{*jͲ^Æwٷ4ޓicU;zqf0 F I')KB{ݙ䒱4[0B^-m̮7𢲾;]R3s;2r/=\*O:"]I;>q6w kZ:.eIŗ(1T"ҏlع(Lh5vmmĨ`PΑ)x1)pcJHZ֨v;>,dx, ʤ Cw uK*Ge G?&b ђSm{Vh2jFӈ|W=N}F3.6yjD+0ٟbAPńj[5ŒQIu5O `ď[Q6 œ"+w7%7{!awsN`UҵIB@SZ])UCކhG+p_Y!Le'ϝ6^ ТAD.a(PnICKeiA&:ȈF^r'&^qh GdK5;Ƈ+Wk@ޡ/ӳx*84%dhĻhޚ].JܾY؇ j:0w_Vl3 $0= ^@6 ?uO?.VQǚƃ mYMbH [z̴u/-l sh[Eú)L'ޖVw>_X]~EPN'{w,d8GvW]h /ـKW߆-uٓB7һ_gĐiet?Dg"`--%kQ@ eǦ2T61)Qѩkd֨`|y0j!*4vAG%bEy&sŚ߶70d1F]jPb싅6Ի1c_{M.1Dgqwc pV8~NVMc:$xR9< ?ݸ#ESOBiCd7T,kEO7:RV}ۘM;{oץs܎0[qP)zZ'Vm:KYAV:v5{*Ȕmb('%__;xV'IoKLۉDôj(j SvAvؓgK郉m=56*-eSռcY7(#w`X]i8uE28 lˇr_c&؁߇Hr^M_eOvRt Haۿr5rFLs&P(P rGÏh*$8(oBn X9^m~+F,zŲĻ?k8XsoDl>[HQױ4 |CQV w.(.Lqr9|@~ŤnYteEAY%QgpC%(F-.g#yH黿ؑI3}d~x#MִO WYi,v4q9B˺n7'N؛UHuF:ߥ `GEF (H|e*,Wc(AH魴(6,ꃂK-Bl4͉9ݑӮ,H=Ί x55hㅭ3ĝfsǒY5I5TP>9)(uf[Bd68:qe%8ry˕6G`I!]pǢgcz:ӣ>0evL'z:1poĮgy ِDvUVME­Mv5Ao?^x髁|Xс_+u}:?Qɰq"5jӣYiIGU[?cv*.z>h[w_S{2g HJ`z"W{?SrC Y =1&lBj[SREA&r[RO[Gq~̫C  !\:U#5(b2P؈!%HyNa 9S҅٪4_+}}7V!SlVvߥ *Є4C,ajQ[ntoۉ:GƮFѢ}yn,^/fCM|o+9z>fҦqdUuJ~ٲu1A[gd`_ͳLg^FsUQ.C\1V"IG<]08q@en1^%!*aB#8a, qw=?D.'T& j8NN) e1j-keZUuum\VY58BϲEw8L_/Y7 sqk2FEӴΎ)]"H }X_]N28# d9-{&QT7HG4pќvYhW5{4.@ \XqDٕNg w]gh䐮W _^i\b#XRL|̑uƤ1B;+0h]Z;6xlH+RU[֓z>:y6 mk~IsXqMy!"d1f/Ym/72;d!kw#1vPNMo{r!5E!,~-^WV3usF+"E] 5F3θXSž*c$UP4Lq"{U| (Z@9)>ۿ׏<b)IO:UM(=d_Q$%]"{SC"XGk?iQfP,g.WuLq@fQrͤnXs̡\7<' ڙЮ'&:NIw4 !' Ws:|`zfڶ5c.SۏtpGn$]y0 G؁/sBY˹Rwz|GhAN=b1rnwa2m:pUd6QL]j:0xKF& ^o2Ϩ{µ ؽ u@ ע7LͼG0%|Uc6~`9ہ .xL=,YEX +\ v̚OA[^s$D|6=K+s3)_8:=<@tةFs5 a>_,sWDž1KjEښ?ػ_C$;uɳQoCX׶jsP}}@ven 'TY{#{}\!QELC erMءs(h} &0Kk~FTkv0ܒ!IdKM I=~q&Ia+7Xti ;xep8⁲p#+3].5j,pxvJ`c Ul\`Ų8F zzdS`K]t{97!Pp{+ &4dQ5K3)<>{ ; Y@eIfws?j{ "ov+6'+qVҽ,\MG+hq##5g'=,a_:K$f&=ԝooAEɡ@'eP85 1yBLܱ&;G2> XhH$X3!{ί1[-]o)B}H_B|2~ K`:#R[I{U9GljOMŒ&g)>5^+[r9!@tJ `OSdi) qԜ\XE_zMr"egv%N|];a|dPV1WT Křp5Uf\cd7sr;P$*R!.%өQcDzpe:Fqr _cn2q:w{Nˏ,D,[L-Sfo,)IP78a7"Lի:E# YIu}z)MgdmKgNWǬV%0%vz|wtJR0*jBĊ[)4P^=7,"N/5&/AK! 3c ~4PQ2=_*|Rsa8WӔ0~Zinz`ePNd2VT-#Mʶ#amd Hiw$MS];=zY_u)HYGT֐%ad}Bgx_eFFbX$1пE5@z p==3b>C"ʟp[^>F:`5 yȓ xNmkGRe(Զ~ MK俏Gե3PlPݚ'f.m9^:տ!@Ad4ÐDafDzF˵~,gaW:6͑mEg ?6mO:]iDMjvwx;=s~r#؛z?̉p"%5 g%Lj(|Pk[cH4WإxV6~{/h !]al5)`Z, { wQj³C%0@K!Vu0Y<@c{R]goa4YX2W.7 )%m6P6qlUJrza+MYsZoP*CmqOT+Y7b~L;T^DL(u*6N q \ZH$C Z?S"U[pSs\Fd¦\|si! wUt=7f첿}m_q8q6Ԋ{i*K WVm :5G;܁4._^ToN.ª(4e,'e_6KNs~E%⅀LRG2=6gZX|П𩇎kSG"(-4bEZ U4'm_BFPzhotE`Nچ2Fytc.8-yG(+U+BF'ʭi|RsOo[ 6w+J~$Jw+Yt/P(uQJ󒑍mb*D2J"Op1L>XC0$iWʥ:5LCLM< endstream endobj 258 0 obj << /Length1 1575 /Length2 8259 /Length3 0 /Length 9299 /Filter /FlateDecode >> stream xڍT.SCZ(VKw-Vܥ@"Jq+^ã=s[Y+7lf-nY+'K ȫk@ Ypefև]N0B<ԝ`UWOXODb!: 7@`3;9{¡6cfp:BP0P!l!'A'0l8/;х n#p"l b0@3lf-O5 P0 tT؟d? \f;_ѿAaA`3 ~A.N 7d@]9$zh\p3…E_iwrt.ؿS!{y0'w_ Մ3 @1A^Ё3 /rpWVP0` °`X.A^VN0WG]U퓓sxs b! hU'Tf؇)``w. Blh(?|?+wei RrupfAPϿuE<_a `K5+zU=8=FbEm˟v_KA\^7??.<,;Y0~!ayb/${XE+o xy`NC{k'82F"@HL x-FއvN^ȿCC?$ؿCӿCvw^]Tp'fv^j~ 񀀱fOCC:/jeݹ>JN1os{/\1SkV?eS?v&H3=EǵD퉭OdƋ6 bplܾGmCVe*UH|ޯ0P46bF9M$w^ii˜ F 7##鳟SDyؾ%kq3^U.=LgD,rse%Ѵu|l^[,l$*1ϒ0$a}V]P!f¥tikd#7׶%Mi "5Gm ĒGIZ-iۺ6lu?{ LzMFmr8>toX9R#075Iֶ)pRG5кkF}&Ф3Ҭ~{Vnǀ;EM {ٚلX0.[P\ɔ?+Fݱ}2Ь(Sa#G8W3Ap N\NvtJA!}YEUW(R]v@4o/X B#;O)=h(dRuwuk}K{V*@'V@9o G~Ѽԫ0P~ACHؗ4bA1~':xVݕ(}Hjt8ϺC7%Y]O5܊crg(7:='yMe]D'ҳ-I |w՚ x"DrqGҹkm'#>9/Q݃j3_z֖ |1f,VrܴCNZ?lc2L -yۛA&t,A~ibNHb*" -Vl FzC`Hk%qe3TI<$7 C /-gbdB<{w5E۟|wmj>!H*X> 3?' O{?tˠwv!QE?V6Uscds?WcatTdEIޢ{R:>j;oA2l/#NbM^*%N@zp13|FxDSTW@o-`_4V}j߆Xsw$T_$}<ٟ] Dj~%}Vn*0FkXe>{Xj.pôzm0 jӧ:z57 N-fvV|ǣZ""INN٩j\KzKڢ t8*oXܑ4x;s*@t4IftA{$үlI4<cU)ncaѣʳ iAMSy ,m ؛u!*]~-A̱Ѹ-zyssQfWb2,R(w(x2DlUKhfӔ gE-iڋ(:޽ k"RJ\rħd8fkgܑEJkܾv5HFY( mN#NXcTmz'g=TFgڧ1TvHyN|0_xNdqͻ&Qs-R$aָJUl9!J#L3R,D ʋה'+O1Ү|$1 b_H;ee3[s6U is)ݗUepGp~\4n|W1Ҩ1Tqót)>bGԋp6Aom^t0{ZW )¯"09ҝ9y~9lK ,J ?_v(O{S?͔®,4>r}ج!fgϺN$ę|F|jWˣ%,b0\tk:ϫn G)Bgtќebbpcw9-PXAAj^j}Vϗ luث ԴWl2C$7AɪhxrTZmzzcХ:?"8#v>N|U%S`X9"UVL#J f 0Z 8Ca}Xv}W' $MG[l- M-< Wj>4_ D"s'+5 /<{&M /|M]-h@i[#e X+BY+-ː0nXqb^ -ISI)HY[TK!+ ME,:=]+enȗӔLY>ekUÚ\Ժ֏Nt.D-g7YqբBUFl{I|8T5į$G`ҊqqWQ5_Yx)@QA gլ9xE?ZPk薄 Фox;'#, qlIXu*^(hKCHTΖ[a =  )ҋB'kҽ}c}눦2ڥ|Ω~+xwɍn&W3Į(%37P{_q L5})Շ |*S'z︕֙H: AhJD\XMTrjWF#=mceQU.[@iD OǓ,/\d{!_!ֽէC3m,*bf&.[M|'朗jzԙ4@|C_,1{RYQ)g/Hp3DD-jުb~JZؐ j<$ٝKH -j!.iډNX(u4x(t *]oMt>ĝoY Jh([꠴ az%f524eސ=^[~,%P2 G;Cai{54d%m$ =F=sj{}5NgUFB^'GvWfw3&P 0"7+t$.(9jC%J@do tIQ:,ԳHK/*4e<Eyqg17kޜ.i\ɗ4v\k7͡_*cGJn4ϏycwjGK1M$Ƃ5b !Xoxk E :5B颡0I v!R)B`'5bH+ ;G차L*V`:x\GGg-S#|Br!<2p۸#d1Rĵ;}d*$M%62D "[cN\zh,6`(8lLFW/,M}kբEslm17nj-u˓T R\h U9|ʜoڥ(P/Ϟ4 Ⰵ"S ub㞍5F"s滟EqM.y:+5+;733 r$1̅Ug.9}.эQ4|+9bjL2Zc]86g2~ne#!axxb2P߄CE[*S^U6;൐YkJ/8:K?(JroK;y5jHeUC>rQAi 4$Ӱs,'mW/ e!==r|eH3´\*R>{ jz$35fh7f)lw"UEjoJTڀg? ϲ.ǽr`'VҢ`&6cDǷmmR8XwcnI 慮76Do߼G/?1 a)cGrq.63fi82\. ЂL~o ̹8҈7-wLsD\$ /&b~F!6BsfU:zG=*ԩv'>W-1k5Oկ|l~\+L~9u.cLPe8('Άp;Z-6:+ғ*Y@mEr@.VKmi0Sm|4ũuot(kNt}'\^kQ:; ɨ'0jeIˬGX z٢YyF^Kӳz7aԂD+D'9 u_O/\R m3-B@Zl~vZaCRM)j(9_.K-'Fٺ!t"1= fj2*1lT\ޞ5L>F EKdL@J\,*#l)Oy1GԆAnd0KwN Fe|C}+q T11L{K5]S]ggsMō< }b=l My.ׄ5a^*r2GDfdA_̖<*CbDuN={IQ1_CZ%m+Y~N`onHJXgI&<54i7R=ߑb{~E:%ʼn)9#SFIn滉}k3*Zn˜׉c %o}ϴXVLvl<Dl! ha\WY-=O~B#>~<}t"ҽ-f(wTpuRiJ!l2e㔲~OqGjxλp2ZgGsQ fA{ThZ>_F#rdMhf@ϮPy)HnCʴ hLtHfL"#5PhmN Wry f֯ HZλx7%vuAl'ܟFGܾ1 j5~IoV svcdECPGJmqגV43dN^<&qD8 W,-)L!͆qdd$?۳U {w,+{_.n w=nF+/-Pk Qj튞 iJUsn\OSc %{V$beUF^HD IJc#{ ġ8Jq,.Aqn^y;(8k>c"‰ѥ`YPG52dGa M_KB3cMѶ ylK6MUKG2EH0}g;:AIXrQmaUdYw|<6^7v P ʛx (5JT"Wܹ\n/߈tGX$Qj ճ X߯U]8)Pg u?T>oj/} _Ͼ}jpb[@o~Y?eĻת5wKeulrkz_Kӧ:cyD?!!UK Dgʴ7"FFy_}FyA&@dl[9h~o8-p#R"#Pw"1(RX_KqcPLBU9q_ _= hZ[acO ؀]a~/;=MT'߽S񼢩R+elւn7{}f+TnbӢdz{G1\LCs_yuTZ5:mɋCÕnENlw~gM5@W](ڭKk[.E`%ŭPM:R[ȁo͸r*|,FǽtY^[AL2~(pS:9&4RMWj p` fFa?dtAjIdzuP1:M' Kd}$Pe:a\GuG t춮VJW{yH5YuQ1w_:dmr_kJn!F3wfTf睨4:֗؝C^w:~}DEY.<t.b؅/Z[{܂2ڛUk/}-hZeޒ'MR~R_Oӵh_e8XgofxlJ0Ovcv(},ߐwqsRW]q=(X̺HMAr83O?_L9o1ύH36e+ft^Vyhy3FFv3IދO EO& t>o'rSѯMؤ@w\NM4&ه1ȴ״kem9iVD3 ["?7 *ꊝG cU%*E _hK\B9$ QHv*ڛj(?HY廲IM|ni1 Iͬ{‚  JLh{cGMzhT|7jKƎ"-oAkKk>W6)P+yl]dRi, endstream endobj 260 0 obj << /Length1 1645 /Length2 9864 /Length3 0 /Length 10920 /Filter /FlateDecode >> stream xڍPZ-C 8ݥww ;w{ x[x;3*׶9kRME jB\Y8Xvv.VvvNTZZ-3* 4w}I>)C!7;;_Pg; PB.PG/g3Ϳ~-@g9lj ?3Z;4 uuu`c`5BmD W[b=+*-@]ja <@@s x&h+T`s6V'w!dsKK(A@+3b;onr0xss:yst9~)KC$`0?)3ؽY{AaȦ 9 y6ft𰳳N-Z^8BC@/Tsw * d ڀ lZ/ 0d߿e8x'eWR1`{$$.. ';*j`O< SW??Z*gѸ;g'Uo߆dr 5e@7T*@nʻ?8ry@o%sAjPW?Ͳ~9\ 8M) Z0N7sggs/Tg!q|8W ls y\ϼng"@g"?3_Nk'_Z.C-CjBnIrO FDX9!Ɩ-lay|d&-";쑱|yA3$Wop|}@;˘78"ZV*;9r5rcĻ;˒WzUt jx)Iki>Zty]vAO'a/q%$p5m[W1:M#.;/}RKbǎϺ<YU6c&􆵈^kJ ։\J~uw3( 9:; q9~T#[\̂46O~珌?Qӑ 5~XBs?(W)B}d#+W9!I8sTʒ+'A2F*h`6@v֓@u |pؗ~m 쁇t/&Rಎ x%J8$")(~~W={1*p֧U]{VK<\v$#:| B-KnowŸ k3P-FSۻa>Dh?oÌV{*^rO^\|֬7.=5+B[ˬй#.4en]zۓ'BbB臨{:XfF9 tTKhϗ˜؅JԒ m5Wao=2ug tN=G%{vjK 0̜څ*q l#@|Ǘ!0lMTBc6.Ey*4Q{ŜQAY;Mg.ޓdZvI6U\x6PTSAb;ŭ%`3΢Ecu,'jϘ=vBhgA&"W)>kbO" Ւ?Eiv*(W#;I<(If-*"evHәl3{w.x~\mJ|64伪YmGlhO~`3\M% 4j%{pMiljor" Q:]$-bL9g1T%x@;@:Xr"Q u~qsDdidEh V?Ds!+?Sbج >)ve7K*!%Ϥ~탰ZFAYb/z, /#E ;l:i'?,PE,v_.VMw)l?FMB1xR%bڨa楙Rg n~WOz~ÿ TO28"k}vlx#G:pL؍Kp!;ʆ \<|&"t_֎P >^!Hź 5kM?GԴQ HIj5G#F'دpCcpOJ:FA^6JC˕hFbr;I1YTN[RYC1IAbW#zBԄi5.ۦ4Q~V kC6k;UQt(n}e,|4j|I>J֮ݥoB"=]~\64{ǰs/F=.DC![ GgGу/td s跖Zcvcz FY|WHPKY}vAc (%8ұѱ~,u,=|PaJq{I<į7-|# ]^U-u>8 LZhZS#Yf XYÆfF=؛?|; s H~1Kl1˳*46K^ 8E H(u"}sɨB߅Kj*wU\.a#"*% M ˪jsYZ}"5Ru7rm $5$&_qڔkT;8}$n軌= ]݄NooBh^G~5%lT4]/Ř]h-pPS<.3وm cM`eD5:v_;Ror1<PG[` D@W*c>03?yvro}^j;nAZ%&D\Eנ~u{찗J_e7\)_2jiL<4vh<ߖDob8 &oپKԩP 1,Q{b9?}oc;ÑMbĺLõ3;͕ ۾C=yu^CW?~詣LIZW@1s)=!URUw}Bv C ,p#AR6HTΧߢwzv/׀%.dlD.=!"/HXG4$r`9B|02iid}FD~bhiyȚ-&ٻ #㛜7Ӿ.|Ӟ&ZkGd0A[VyG̢"d/;*Nȱ[Y5V 2;&⾞Y+!@N!R4d39Su5/k]NOf]!wDrD ڟ-w"^ D_ڨL))eVa]]d鶄^d9 U6({9]T] D`=ptRg:$^9#J1I1"PS_ 6tX g7<]LS oZSbw~ ĕ`Mdzx]1ujHT-$~ߒ#AwUW3T:Ff55h8u:e0RůEcDžaDY>]S!҃r>nɬxZVL^;럓5}ˢv:%j1L^cCxI LXVYg=\13bya4CAAn|q8sV* (x垳`OlM?Z3{=\Vs{7aku!Vr}eEӒ~Y 6?4'u;F I[-9И*Y}q7tGnFV^C j;BDL)^DCKYNN]Z~]*zT& SY?<{Kfģgљ2r!||^jcw?0iwl[?PgyBg"4; 8IUm' dI"7ޘ+Ex+EX@\nW#"Nn iYSʉ(LtI]uRt p.{+=v)?Eu~b/RVОz…Ҩ4*d>S7NbmnUAS?_V&Q"T[}bJ; ^H}FhVBI+n H⋋>,T!d ruO[* d=}"1`w;/%AXBbp\dVcO >,IGT-\Fk3dBCExj;YU1dOF|8:[dG&F,w_&DЪIטSe ;[{2v~ k#)LeS>Fw^('a2&tQQè\ѓdj@_FO7F:6]NkD] recz_< Z YB\'ZGuX }aw搏FP8_[' A_]"iy<-`|"H:ș]"FBstHpXӞϩܵU4ٵzڗVI0<{ u?)ͅFU8u 씕̤i%E{:QmVrx"a~)i,ҫ쫚Ǐ1.#CDg%5;sZ^R1 [uՓpk𡜦ZĚ$noJT\樢?Gޭ/}S걍>

Ԑ9zEP]G(1[^NХsL^̦ t5O4BإWFѪo?`8w3XpwDgVʩW>A8᰾Ӝbqy~H=WTR)CuQg!EvaVk}!;SǚJVZ=N`;4~6ޠ.zZ;cb5N5*O@Egu$ϭPv}ZSFz&,ELQ2d=U.A4 JO]RW,j3f:IHSoJLk}M=EO:1>9K`7aub^?H[+e? Xζ-/!_{Qy fW(|W'&@q X RA Y|EN|u\"iI_\!AvԳlKSr$KL=`[J>!# fǜo-<s&p eӴ➄.6U\e_R\`;x3DPLAފLsk侥6Zie:Ïڧoƞ\ܽ #^Yĕq4yCΗ p QCT'a@K޾H"DsHD.O+E "l@]{dCkZK?5\4\Ek}\{)eĔ*Me0%$~{l$w6#- 4F<90BŒi a z3I_2-+Wk;oy&ɈG\eOn hgUĐL}UT>[.W؆]b->L+׏*dԘ{XWj xd tVLV|֞3 se2%X:pReAhzZEiP!SK('/CmD)EѾraz Kئb^uRzx؄.lji]Τ(ZmkUe]IBl jgĈZ Mt_RK$n%ޚ0-*5 b0k$KU?I 3[ҞxNg_hRC+~ov !B DD|W`ٵ@G[njM{L"K""+GuDLE7C^xLVhij 4t=!c%nǁNpㇺ.Ο@v2Qro}i+Ux5QsQbxX+yGʝF_Խh+;xY1-ѠԤQ#%)er0&#P#(,mFꓽeD?Zo1lF٨1I%-Cp/i8u5>|yѬnvˆUM ذcogdžXxZ$Ox=e+pWdSwc.&*~{TP_uo W̤ٶ%,֋(`=ڋG!Z $ `J:] ODFBlZ [azMr;[Cl)wY#/R zzFT*Ҩ͓1a>u3riôG뱤M㔢5t흿[  0e2:Sbt5[Fbp=0!n"E[(F,LT;Q@4vdqSF+ M=NEF4Mič,,$Ead>&iݴ罨6 MKomge>?NI& endstream endobj 262 0 obj << /Length1 1373 /Length2 6090 /Length3 0 /Length 7029 /Filter /FlateDecode >> stream xڍvTl7%1:I(nI 1 ch$$QA@$$.%E@RywW_}~uc3QUg\ ŠB@uCS ,!XO_Z8F/:uP,z!@.X(+<08rc@3]m/8/gD_ "w'BCa04 D\.O8𶖁6+;B=}x u;i R5B= <Oɚ(gu4 Ga}@`0G: P.GpY޾p]=*tp,P ȁpo << B{]#C.p_x) 3:](pd1]0x ';<(Y.HZ[B68Qqef1"X] (W[W~o_obG,(ۂ0BoGUBxb7DoWK_t5;#|mBPEz>Z1 s *-~}( /U0ODο%.% b0@~xI i ` H CB.h >% [Gab0x8 aI4=Wr)Zf 1-4d/s"1Gt5Uf/pobRMςRLGWS#mpQp_x߉ n$l1.d<驘=jRZhEmD8 VR(^C%^0 d+Qg t2幹O; +!Ç8 =O⹢q[ߒ8vڡK2 W}\nQ6 Dcf2]TUyIvp\ uyΟɨy|uI:.\:4=̃?nn jnj-7=. 5\<~UO9s}e}6aHB@: G!ZX1"-(q;E}Z5eРrz-i,l%mղݚr1SB sZmB8$)UrI1՝2v/GJފc{vmf |[˃(~)ҦPݯt/}5$Lȏ2l\}%6r:JGN~%@8>.X-z˰f7*sonή?,ʧ?tXFԐ!uxNMg@ϖFy=iK3n3CHxN~MsL`xm6agA8!ZЅ@q.ȧv!@+LkFm2~ϊe- ; , O}]F64]a4M:՛ @G+&IsFROr!_q*;0Z]ǹmUJM3 ΊMQc_SNF%ED"ߎ5+L㖷24jO+9kD 4w| $o"Dž8a#Ӌ؛zg]1<>^|HNTQ|ƽjHp8~D/g;oI*oސ^|bHC)پˡ3+~_: )Ip^ߓ{(Ux4ei zV[b[hwe9&Ӳ_>9.X4VwO&S ؜*> g}YsrN%XA{]c*cYJŏ4_^? AxBCy޷g{(rGBtY!NvV컘WCJ+ܒ7ȵ{1Ŷe4 %)Ԅ1jɰ|~̅o˃qlk]#fCpj7~`d.&sC'-M7-*2tS]mepWץ>D,OWniLT@FFD{kqOm.pf&P4J_M|EtjqAyM⊒UMTj~#.'1HcH,.[(vKl4i$1&DϘ)6< n˛][$g.7̓?>n~`Go*q/͎;*w5We`GuX5Zv("]zN|Hsu8nmrF^ɯs:Μ]~G[qU+ҟy ޥl]5jkܟ5ѻL&ܤҪ2#ygWxyAԶ._W}`2[hV%!Ҥׅx0;m lew|CwVs k1md!2U*f[GyYa;݌:# gD^`V gOl}wX`[^jo L6Zaumu}x_p$t\1x`Wcؓ`ܫ[l<{ySPen~ƀ(=4{ޕnһ6gצ,e9Ijl,_n Onkw^ޥ>Ǔt%G^w~_8?_֢[לT>͒@)5;J?v~ jcSۏ$SLʁJ5@+联Z=]Hxt50ꨢ\_|J>kdsۇEW*e'M}eRt8ݖ)"%W#_G|يVWlW;Q)zcK_ pu ;- D? gKB([;}r mEJ4>sYo0 ݼjl3r m#^lS4)JlٞPxy@c:xFf̽$K *!j eȀIe^+qzo3i);\bG?ӓ o*(>s?@2*1u>M NI6tB:S PBq3EKx_K^抠-/WCI\Ow8׼NK\AV EwMSG'gP;bەQ{m=X~y кDP˲B'XꝮVKZ&=߽'[vody_=0֛i27KUΝٵx/~MUCgiKyD%,, Wk;{ME^${3t\{͌TfKI{4'-Ʒ1Ē!ܳTŎFm`JHfj Ki Sh1z/>ɉ BJ{2 j~: 3WD m{1 ӷ1$桳! cR%0:߯:|^4ĵX: ;hFJMh(f7ɬE_6 鐤=!B(ټ nER 9N6 2_q|=9k^LuЉ#nf&/W6$~ ̣#̢{u=Gb# >=\/. ~esmZ ә[{wZ ~ p[<7?as:YgAh' {!Y/̻|,6nFdjxߨjK)q.יn9o gLvt옇麵j#ҫ3^4"rli ԣ3ˀkbgӃRk-ρu_2)K3&C)!1J66΁~ۅefR%|*\-ռJ՗ #^8UVWsJ`u T>&gb^pj娑dK{ugke"Kmi{ҷP_) EbVY-F] :qto/guxB3hFP%G`t0kˠ -䍝hFWeYOMTq:&[ovt% gu۬!'?gBCՊ.`)(p.iG:I4.#dŽdٖحbԝXpaAybFP,r%[L-x\^-eV吔UfޟIyM>ЪWgC?)$K|FTop\NSܳE}8 > ȅ9J*~|"UMcu%F%\A ]Uo*$Hh$ve{E6UY$erXIX!|?Fyj5`eBEd}Xܭr3Rl[5xZ=J?g^ 1JұI4B.c?3{ʽgìKmϝw#zQ.l[]\Rt|ҍKɭuB!,e>ʒ_%g>2>p |mS |^K-/kUj_[vd~Q36[Id<@ )=)5Vxv׫S(ȪpEHs\`~wdpu-.F>CY~MUq*kw ӚӖdZ,#9 wҎkz o~F_vzP܏X lzh׋LsNsig#:0{~D^ΌUP] Y,gu7]DhUrzb;@}M墄. _sO=yQ$% ewj:ԑ6#ٴ1+˥W|p{7UV^0k'لZNTC.#AlDu,"Gn,p|ωM0fy&)+n㽝pa+`Bե,S}w۷'[э/z!slUj944! JnX*ӝ}IP-GU):=@?[|;bL#Ykv/3|kWDtY h՗NZ!3k&5c:$j &.k@ǽVPfH)~ S#^ݭ*y}G$D B*^t7J5kǪ/q9:F1=P.O`$D,X-\:~⥙_mK BCL1+4:JJ9l7"P~g)8{n2ɞ N⑝4'B6RMT.XJVs09L,ųhnW'qG.Y,Dݟo;B=! &meE4E1RTmw$u[3xtGB<vMS㐟߹R.ѱ$CDE%~zKg?1P endstream endobj 264 0 obj << /Length1 1370 /Length2 5933 /Length3 0 /Length 6866 /Filter /FlateDecode >> stream xڍwT6R t)HJw 13C4HtJ+%HH Hw}5kͼ}_w>5:rp[2I  XY (Wv@  Xߏ' !!;s v` F9An*ځ]}G i']ۛ#e8yo( Ѓ !/=kd@ 3+`EЇ;pcpA`țO=TU5mw/_r>+;lgws|0G 5P>( "7`/0l{:P7i|HY^xS" v7{s.07fk {Ow~CscD@ 8Hx;'_ |!731 P?POH:yv(;PtC?'ab~}Memy%?#)/yE^A !!HLi?BUap@now^(G?sio 8s K!?;Rtu nPW?znD 쿡Ɛ zW_">{(/e74W( GB[^|7sy oHQ?K*d&(" /K""!>i ਛf@u/?y"7}75>2ÛI;׆z._lI4A}wҸpCƾj0MgQ9B.}hk~Lݖ)ƦKmߦ<{Bta[Rh%h-a/^l*wqG t\BzQf[75s =n-v(Sg1 CY3u=ND^;9PO*f{i8r JL_-pV9HqHla+1A LPZqݺқO!~>K0ux,m-6 :f3Pmԥg7?ZtHDPڷWR|-?GQ9"l8 `җ I~f~ʄ8ejPzqe E+F(Q!MVj;\YG{-,b6~uZwNv,΃#?R}3HaWݵHP:[6 hQ=Y>b ]S:֗ʤeJt ;*K :MÏ"Ov}eKDT~p}x:/1 ch}QNc6"Y@w|L1Vo|J$Lr^|tG˷phWJ̭'ȇwDELS\-VIXs*i}Z v Yt I\/=[10X$ ?xdBK{7C5ZE8]cʹ,Py.dU't >{:c@IQWwwwȆ@]^Saq}hJ<.8q5DRn")Sr"gӊ[LuAly(c4􈊠CZpQ}t[dG(Ŝ0SJ6ҖN˷1_em :dNh}琻m:ʉ͢e8:GG,hozވPF1H#sΐX}/Q*xp[H΋ 򳒜}:BҼL[G;ܐ{.P$s=M7K(oH򐱦g.UYSk ,H)ug3n)hsM5a2{]mSߔ7r5 #U8{!o)G-|Khm̈$O2ΐmE߶;ih xr@a'j$Ba>Kw"r S۝j9|+Gv;6gT]Џsgi-Ʌmb$YLKl~Rr9 6yݚБ@1M{{\:#[*Y03i(Z|>u@Uz4K8&e!) bQSjgz+9LXA;˳/%dGfT5a!Ŧ{fJ2㖲Ysui w ]#9ĩeb5 dwLW?d"C+wS&e^'U7'ZڝE﹧{mYT7KuKHpB,iM}Ϋ&$y$]gye6ƥ\mJSL:Om[FNVV\wg"k?DbUHy_#EiJڝQ 4FG:kuEBqxGeG,;J?xp3c>5"V혣,N(D A m~|Y;$5fjJ}RK$GS͞p˴gsہˁk:WϫG]8 XAymU|;S֒OYi\ozfjLqNAӖ Q|?é sMa(w7<Մ61 K+w ǘ12VKWa!/ DRy8V#+ޒzӞ>䉹wf=7H?$SѸ]8镳YyGOODPF)} :*,I/?#=}Wˉ żY ")k  xDٖLYKcDWfkS$cS FEeu*M%(8<)bB :8bƔOֶAߐh <(-mL%XZ6_T̪mo*ÿBy I#8&ﳵdtg{\e1N|7ה%q&NRXcRY4%0i/1m|fC!pU1~ ;EfJWYsm ݯJ"z:[yX+na[f%O9uNn-ԗo( *c`I& x+y#:I~3֚?^%M`٨ؿAWlpQ`\ȘU7F . 7W?zgTl'CX]=X=gI?WV{bFGK&,e"QR]H4q Av&ɅOԩ32T9o+@%` ĪI cmeDy2)z'̅i6mw7o=ɫNYѺnV'&긣 7sy9ڦWHRm/zG3*LУhu'ȻP^7<,,!VGJC?c$w 2' ΠդS;9UmJ|{FpJ$Tw1rq@YI[ endstream endobj 266 0 obj << /Length1 1510 /Length2 6989 /Length3 0 /Length 8019 /Filter /FlateDecode >> stream xڍT[6t)t !-]00 ] ()]"tH|Z߷fyg5 zܲpkxyxxy!H(o솀abŐw[#Q5EԀPOHOX+7&P4xp,wv; Q`DE~dn5 at;vYCzpW6 $E vFع@ymJhZ;ƃ w 2퐞n` B@`PTZ.`_d\?O?޿A`A 5A`: "ZCp5jm"N$FU> D _5A"V !xSAsi {e*hUpP?= ]`/.0_ UbF}"=; ^l! $lZϓJapTT9 /  m ѿE){۟a;&\0 Po|r_QBߌܡv3R;5p,jkt5w Q G)1pB Ն A/׼A!06uàxydž2AFпU඿_P`f퍇5j%CM-뷘@rj~5_vqq{]QM@|5 ! 06;?*; qA7&@U 5Uk >A⡎oB.jdi<`--wD%F "Yf^:cg)O=}`(]{,| ŨŴ'yH4UC'pj1UD:ffF„6 ;;g@1C 2V6c 2rĜ8,]_`9$\-Y\‡tjdT> CIT9oh,rge TE,ON& 7kz6^$۵xLkH))ʁ&Il0Z׍II|1/)=7QGo~"`>ilV"E$T+9!m(ːD*L[Cq}W ɰͦm]p}:ɠķ*gI 9j3N+ݼ\LeqSqxC|}} M\0)bB22JᗒM">Qٍ']e!R-i&*qq'jSd2Pb܍AY3<؟q7Ne"MQ)VMh3ލvnx=i<<$Tg -V4 /QDY6u 53;b٠yUN@J:&*Z#E?0@)xC0']#TZm`njyS4IݥY7YK--PtQ$C[WoYxg #W`fHK%'M$&ڊV^7"flsk\]i>RL9.lB?ɒ}tKiNWEksTz̟3J a(.ņJa7 {*M Xdm[nQFRV50Ǡr/ԛX!3;2e#9KȦ[]ZR)#D pHxü | y!.GKntW]CZɡ/R\}%?SOЕO-Qp"!jw"nȪ\h[eze۪ NN|#-IJffȥm|7c?^\ꯚы$¨]YCE^=vҒwS!Tʵ W|x c&0+<)sxk [o'$"fK,o='˕su˔AzWhzQxǙBr$ <`3Wq^g׎1MYF}#'d8fA\G]`W맾Nh80#~oКg5 )׾UίtZeYnJOs BZ]V%X[u zK =s 4nBmŋL6;,eI܈ H `>뤉ry(􊺧@Pd\,ha N>^cڗӓ\خ3A&ީ#EywȬ4crab]ӰՎ!J lj)0BLBzΝ4L)Jlץm9}^ce&EumE%ڂ9>=B:4_rCg y=) o04vf(waWOYs[BŻy |Ťpm԰5N-E+VBh}$*3? 7u>N ?~kT6 kRC2Kc4eӉlrD%Nd݇e&ٵHhG|34 /ĨF]vGK0,خi>>vaxcxA0/MP}E44dCׯH[?+6й=}ʵd^~*$`]KQ#=g-wKt{1}nc*{jgd^-<\X#6|5wdCtL1aӶvVq%,0.0&O8(CQQmQ!<.B\C Ǟa<mcGn͟A{#E#"j: .9|d<#_vF=;p{uL@%`&a,~ZfUB@7~.cA;9R~N[V|f˧WTQ1PQC_\E5muO7ͳƅ]HoޞW4dEɮ*,"xcy4@oԢL|lƱ1#*qr awW=L*1&^Vc/{83X I0w$X.:-P)-Yαd#̒K#Vem-N:c~z>7@"D+??θU'~E/5ˣ}:NՐV`O )5P^* ɝ#^\byaJHkyn rg(@pemwWtuପOe}{bW z#cXj:q.(͊oWcix|[bs, Y]-F-zuЇi&RG:ļ{}kq<)h5x5,;qDa/@fgad"#0z7 6dbr+SӬg}j~Ou|X=vWI"?a TҺaC! P,d7kKOqU6Ĥ) XzZ>BG~ygZRANFNEeCլ!o)s($ Jh~Q:~F GHg>>J@Rr* jadƈZ87FP;"m(znevvBvɐأBXI`QHt5c{d1sqr:Ze?:9 ԅZ1.nYiao~{ni?(F80Wz}dMz]5 bN m~>NL]$mWyXNm$jML!FJa+$|ڜh:}aD1+x;HT.Ϳ-xTXqےX^XR~ /bJ=!=΄}.(Dt9I9Wר)W$WBIdu-bȞCɽfSah\zFX֜J}Z.t%m5͠(5>hm⇽(ob ͠h'I7-?h) NKRoR}4ky g gr/zt~Oȫ$6Qzex~( SjZ̾B1tM1Yj$ܯQ)&Q/O拇f{OX`hFtjإ PC״N"}[W6-f^_Y7!޹rGgw̲}ǒ0|muew&H6<\LYm6XB~oڡp+LYǃTn|kh]#~ R~n{e9]}:V|s֧K~bҮz";8#uzqN=Wڮ[sgʡ6g>͵*3wmG:i࿕{)Bꝯ0o]t/ޕ3>opP' ^p JLYqkKg|ݰyC}zX%s=$PQ`{P/3c̏Y)_H!0Uwc~0͗jyfThޤvj1ܭkgkU^!ٱi&Q, +8eu$Q6r1Ъn׿RRnv $9 0`ю1PCTIp.G.ݼ1DͰq{xJyWs$ц'tn@M;D&] Z1؇*Y~N|Žϓ\57^DU\o`>$]`C>E`Bu$̤gz<+oP7Yы='-2^¬Y"%^;e@ 9X }XPy$N҄k?7DA}8|D< ',,p_Gr]}/Jĸ6Ȑ-.[W+ QgI.#- E눾 / >¬!\;a0rxaGnynhtrC?soGbT%iF5wp2)nꗱ7auˬӃՁbZ=ӱ>@KۅD<|/I`ܘRǩϔ귊,`ncZ6Fo-zS*Ffc'ЊPČW9xqԚP4k-1LY!S\͔בJUUpV^Yq(Bt('!Oij݂1h*BOieC ~>H?q ΃-dmDnRN~vh1UPIB2vmPtq_«8ǺOod|W :  ]YgY\.lɆJIgA6M0"6Iu"P jc[VObb@^|Lf D@j@$ky!_^y˥2ev{MbZ7/-] Iofձ_ o'ڌ:EV3JϿz*'yQ:wk8! C #|`ƒǔXD760^f9] ֋}mJǔC-~QU[Tl̼{{TLWF6fkrH돊:a4UͳŠfQ_{,p&O#S~Tkiz9\?euF`mWM~gr״ endstream endobj 268 0 obj << /Length1 2215 /Length2 16866 /Length3 0 /Length 18194 /Filter /FlateDecode >> stream xڌP\ N qww%84!hpwww';<ιrrz{s9nRo@Qk+ZF:.# T9 ڊ !;ÇLXP h`d0q1s108chms25$pB6v&y00rrڙYdL ,@ Ac`EOLgiOgmgGIp6u0(vN@C_-d,ndbj/!05Z8Z9տe@79F:_Lv30ѳr52Zrt.4=+ÿ ,?L-? .] *(ؙ8ٛZ#_a>h2Z9UwW_m:+[:%m!Gf t200p0q _ \m+ncm0hijss*12 M @cS+Fog1~>}0Ck+ >bz!5iI1Y_ׯ.wZfV-+q?|%*P7 &+qߔuoE)e׳4p::|l.X_SUVWhhhz he1Ѵ,t ,ڋ :kj%Wk,L߬Ma>c ?n[ء+be`mײ1\>?0鬬>\=z:X6V_!N;3^/)XJ vqANq9#g_c_GE,i?E!#!zk'聖z&81!)M0(P,울ژ|\X|.?GTo?x X,/,E|~m#I/J/$?>쁖bA?$GX!zg?u8q.\ܺ g; >tXߋ@ nqڀ;:Rϙvw*FuGi_O9'|Asf/q혩\ \{#9 kHc^ڑiOCCQaF`rw6Pl<2,M0kLig&֭bPd#D#lt'Ӥ;"81~7;WW; ƍ}IB1D\ɷ: ܘYɋKJyEa{`EN~JyHW Mi+'O'ьSvg2 2y[$#lBgo¡J9Y9O%߃mlT4 3ii- w)zWu$\G,w;4JIF\maN~}U˦;.YbѤmnr=ꔩk6H{@ XKՉ{ դUFa%Y4!5#l^aŽ5N$ 575D$rp)_~,0\2;zU;zTlm"-6G,݂(F0p\t5C$%mWq2@O"YSB>s W .ᬚ'*ooV&joܟ fsIvPDN5O} 7+mRV,8A־O#YD֕)= d&Bd%kRFp,\Ae{vdKyVY& aXi|ޭGDMB:Ap eb_Ӟ~ǖw42[\$ @yf/׿ }J2{}Fy4CI&T)1X%~HV:h%=jA13}ӿ:,ʀTAR-*C< K}=4P$&GK"29kyRagG+7!L$KVr@%0NiVPxe^1,VTIo2ee5RI nm;GkqΰhReS(G "e<lDO8%w_Av 'Qq0%@qkږfS$Wݕ(&]^r*4\RsJH=+W1S-h ,ji{߰ViPuBoכ 26f$`%҇u5VG¶Bu:a~qk6:ѯmcY ˣq'\/Sf$t1BC| vP;ճܺƄ?i}x^-v+/X~/ q(g!`Ňxy5.Pp6myDMAdyԊ,Ӵ#V<7/ GL܄E|S "8 { H}lXgaC>I\(m2ZF-PjFW9O u N|"r%=@0e^;iP+w!\IFhLIņezu]hrcJVC.J?_ vbmMΪYPZ:cuk܉$!Z٥En^,i`J,du-I{ T:{~Kk;,g(g&v drvCm%4q7` QǕWCEWM`[u11Qm8҉mk5%Lq}8e%)5 =)2Ƶw// fElq_,1SlaFDi jy-,U`|2#T_:l OW5,Y~YK/qy/qk.x[nBTQ9@ŻAέDU6/Te#ۍt0ϧ6Q!)Q2.>^w|1p?׮v}.bZ9=]xb/B;++ Ogޞ:%(a4_EnwatB:J1թQpo߰c)qbSj?j Q4zޘ#ʧKEm&Y;1]^gc6hNus}h<wοkv0kБNʻ/v)b ;v>w>Nڬ'ShГ}L}O-EdVbd*ҥ Agu!{n78̎ێ.&37BfyE, RDtOJ\onU1p_l!u]XGF/v[Ҧd,yC 2G2(z+vr5@PRnXk57H8šJP۷d e2_APwzr Zy<)-6G f-+E(r;:,vl.8rÀ \<`cE}B@_N'wQ}W}~wg|%\j NYc xScJQ$tL:3"WP ,o3a[_rp]8 Ua򑢯D[I486pZ%(-ʻFOH< Z1Jґ-kD]U^,i#=\Z~-6&cyδM2d~JԲGz n _a*Ӝ/N\ ^`SQ|~B"~A*>c孃@ :C)2IzqpO"J{P,zoG` &i~+0H ΋[w< .dž/J Y.vYCͨUyYd#\׼ߏv^~ v8<m7g49bW2Hdrl\xɳ I#CjfIrtx䱂A(cdŋ#Smzut(^>a6`D=^TkN)nNj4W[٭N9؊Hxt;@-c|vewݬK}haݍ"F3^"&=6bL·b'x5Mh%)RYV7S?|Tz}e/j=rw7>֘}0Wlj]:L3E =v{4`~ )FtUH\U[U\9~`ݡꜮhħp"9%#*Gd;NpgGDx10O$mflz{JJm;ӻki } ѱ_YLUXw)SOzHg#diI"ʤn: 2DD%뗧100dPF[-(L^(%RzVDx {'EqOrŚ)J7>S}}_Jkbܥ"\XﺅM)rhFz8~}.xc?^A=ӛљGOkɄRᨬ=jPSKLJ -u]ut.d)[_,Rm4A 9#޻T닣=ʇ$>}$nл$+)t6f>~b;>:lBC-!AJCȽZLvw˧:d~I|i8oFxZ|/)CbK3;nX<6ѳx\ެSڟl"ھma"o|~7 dVTxyD4BҤtmS2[󥰀Ȁ̘uy_s47OVyS 1Lr2=>y|ˁ)[1QQkJgk 9|_sdO>3 ]郭^dZbt&j `8{!ԍ'r0 )W:/if^+[%IȱO9KU{S ۊ&{Or;O+K& X)k6aEڈ[,yc"QL>+8]=ϑǸI<;*O4q? iH(*p7ɢS Jq QWAP"Rn 3;zi*i1u=~FkV؆ qm"-; eqԅ0o;v8Zp6"+\F 743Ylk&sd8 )A~PDD+Fwf^Y+qvb Jov1ܑ+^w_U\NhZ4GS_=fLl\. WO+ L=e4%у?/O,'S\ T|/{gZ,K?UDǨBrnC}5eD|*lTB9:põ2Ҟd9%hd SDt2^CK_2lf@Owa~Az٠. ^Xdy hB);d {eF<6NjڔXKFyxEA7+VlTU2Oc nŢ04>R#,( RhkLurǩ(cnPG6OG&| VL{Ò<tf1E%puO'YZbhb ?39:~&#h \E-31}Sw3%t\ުd [j4؝Q$NC Yr mQ>XZl&@ %e-hf[(r싣ƬeDi: G K|MOO>V,aŝx01E'\a) }|+"˰ߢ8p:DfvrIA"tp%%71o57YoCy)z=wrH_{ΩWNTqJڶ'EKjJ+f^-ݸ UkzF!$ρ%G̉Ʃ5[ɨ.'l;i/Ǔ`lenr*w^pQ )ڭTtTPsqwG5pe/.~!v)+=pB]Ct ٲES=uJGhs9Hǯ;%IT"mN7+ڔޫs$C)p .!oKU@Mrbd;3 SmKkaR]M[g{׊jY'G&)BT =h`OZH}8}F]X90P6{’2=On}2-5|$L~ݣ1P_jr7Zw7cD?ޔ//3m|'$eaLB)ʎl"&HveGy+9xˉm;Cfۃη]M0%z(A }lN]P % xLfWi,W5w {d4j14S^N-)P!Iw a7 Ym.xb@i'x+5؉6N o‹l.WSvZTl|S}r%cJ896Bq/X wB҇j˵ $IߎzPr5UAyװ 9O18!bn63K[%ROCe2#Lgz'"Mh TEj S\X+b`tγ-l s? Tb0%UU>bs{%}%͹r+|۾3lmĞ< taѸ//Cl}3hշ2aNN[LmQ8is#&G%y g̤Fod{E^Ӻ8Qltd5>zr=]yyag!65kh PJ!1#jgb1:+Q}XOf,k$W r7}Oz:gV3֔D~xkcj1["SckF9oK>{*ڽ.^ Jq3q MjnrAL[pTѓ4!~R63>r-ƥhP'x)!I*;Vy x,]kQ1o-b̷GKy5kͧh 9=>i>!F+v]Oz{]Z|:NȦ4i]u_|t}dS bŢ;0ܛ^"+o>qF\w`{l8[ĺQiO]mt  %ki})zM=(s[Սe `=W;GTr3Z*c yO1<&NQ1~*OH4ɹ IfAr&  V6Z S?-FT`P"nb!GUu \Mi5Dú )5nfz%~o'L<{;k@]y>v~\×DCGQ9+N-)q¤__cFwF ܅C^xh`$Ėl*v zWY nAEAxDQB_䬀#qSL _{i9 Vl5i +Niz2jp3rN" [@dW`uL,FȨ8zntr ݈͡3F\mLnNG ru'y{?MUZN6NЕTχvG"=TۂXdɏJ3ǽ.W"E|+M0V`ޱyB㸭|Dp;@A`HEƖ[ rJyfSY݉ErHSG̤&DGmUeb۵6❘';:ι{3 J_F]`ڕ;EYvja)3Jd.S&O/(5#ƒ\.1ʊirN;XmXY3q^XjV6*t`$%ac)|LX$#~hS T7C7yKC?OwӇ* #V%)νbՕ`'zlOO$LN(t~B{|6 rH Ŀ%kSX0MQXSAbL8wR=o,4XgEAA*6J9Q]`)9>:rGt̎BN=m,H٩M|LS2NEPQi"H߼Z w"<=*d0Kٵ#y=,I>HMٓaƖ9d{Y|YW?OZEUH}:vb$K:`20>ۙ^3^4yffB4xl?qvo'jK׈rEus3,'u38Dk& I- [t:~Hzx-gY1;+W8rJyT͸_vh o{\-;ZZjlVM4JJ1Vٸ@ ϗ<(LwQ@M@+u55HȪ`CY:% 8h_ P]4TG^3@<@įP@◡ EBubۯFR&"-oevs%90\M nR=P?p;ӅC1]эqg6J>ʾR,|7xh|io+(3K/6V.:|x7T)v8u'ZQ=0844~z5IKc8-诶-Q4ܫڍLx\6| PfƔ9sS\90ʄZCw7.L׸Ew%O,>RB@ɧ.7&DxFV7OzF_K-XSy7ڷǗĪ5%uAƉ21S8'/n%@-SjJ|/XtC3wRA3ơg݋Y 1u8]>;ѿO'LR>~OGJP%M6YhzTN 0F~pc])_mH6!) m6 \YŜ7^^, ,d_ 7rSut1q R3v 8 (e.6h?~m .qZU;0^Wwwz63_l5j#u/4GLw)> 5/>u-ֺ̤ Uo*~rl%HQkfbP~CYb9&=S O+jr!=Ҫ&`I7-b0Sǩu2'(f=GXD9=i+gf+lM;( Y1"*vSv"'ZdD^W"~j_|[YE 'CFpT;&;҆8K| TB;rKI=J3ѧHe0Z~c \xR|ʳ X~ ˳Fy9! HX*y*֕Xm 7[P^6Ŕ!g-H#gL6#O}n%eŕU]L4Y/bAR+:=,<9v#n>2©0gbZWx@/rK,S.ppI yTPc7H@$T 9g1='S'!&or#/E_ &ftûdLN1 u6x>S$=9`A!D;lfe"֌`Yowl 305wf=(aPLPa_DNw|̞WnGC+/n NP]\w?>n%(㵡 9&O ul`O~F!rJ9nUbЅJy#'Vy9p+f?s7 ih"+.Gy6ͥݭ߭Krq̀qf=vuJSSMGlS$W3VKաnWKWQu-[?~wTc3q ),8OZl|EMx_ nxS3̎+Lt?mgbN`ٹlZZz9w7XB#h|^VM #AY馦*QNB~7ces&GSR-e35`N6(. Me]sr[Ix-q;ZW3GhD_>Cj .'A$VrHЌOmԮs]Sf[t-DgugW&oXU\sqUWMY{t~Eԡ}=)Q}ekiŏdl`3Ctm͈6g/p,8Ll2bQ#-lյBQ$c_siio2c{8ϱn+`>[)h/ê4%dxsàPe$ rs-zZ:e4? owJ]nvGݜE8J}qQ:sj#עE RuvjƔ#icQPtOŊ)F% ~:pI#ўSleU=g:H0qZ0=.sRNᶣ_@j*ȝQ P@Cgp"{fP~J }LuD ht'Ę\E 쎂֗3s83zВRo^KdHVx(\݆vQoh¸XpA6ҿbBRA;~ⴆ܈ 0+s^1*5RLL2jV@X*j%u]Sr| =zBfl*QQWBZXN95z٦; q9Iўf\3g1AMi9lsZI6dJ"oSy"B~x+hI - JVEfXi>\9 ;( EɏёO /)}L?5u i[U `05 4\eA7)]9K+Jy/o $h7U=fYKc7fԩAB/u!=a6lMⶤۊjZeLIU) Tl5A>uoV &㈤rRMH04,L';.7J'Ȁ%4dVC be?&h̨U|$x]i*<3rs+yڑ^y2M<26~zQtjFz$JqWS<^6T!śl~5ߢ޹e$6y( .˴bfO boCCfc]Rb44WQ6u|Q8nvm ?YѺ/&;S-hܘ\,xWeHQĄn*,++_qMRX,aqGq(_)TMA/yotH-^{.VS[3)ĐAJ$HmVM<ߍ / >&LAH$/BBqZɸRflu|qY&dS^ ʼnUi %p9>ki7/oX\y-`S]~O}Ѧ(`kv QŶUN2*0Fo7RPB}Xϻ״?gB:Z'@S&hu2alL~R/O$ϲyh|bu oIGN\t ھu+`Tv~NS&#%X{DQ!Ҙ6n'uΜb~D]|J?J4 Tb82%npyo HH!ȄJKWg@hU oXByT&iڰ@'*.#-ݣIJ:yȿe5U8\ #d'mWg)ʢ3Ï`K$mnfTw.p˭TY0 M‚|oE̹GkФb~ tfswڊI9*9'CS`u mR VVoGg@tp_~BO܏Dg:u,ў~]n5c1U"nx;<Q`r]p BİaλRڠbLX奠…"0ս+f~E58I"mDf-.Z1j'pxbXe82U[YyZ1ƊާqF7+<_j?Rm4JO<~k SX3~zyRS%S _FL zdA ˌgr'Jc9P(A(1AV6Wpgw22gSsS3IH_y όwI$Wȸ 55 TCyw0<飺IA rh\? ise4A $ 6F@,!ON"Mks{c9{0rfm/{5v5n UYlOY`1@H9pcHt; > stream xڌP c@pwCp64hpw ;g}Ozߡ UVe13J:302Xl̬j gk@G'-,F`3P b `app23Xykh 7rv@' 1;{G38Mh,<<\A&F#g 85@tLLnnnF6Nv47@tt~S(ƈ@P9Gjgf )P(mc,z0ӿl:ldbbgcod5%IyFgwgzoC#k';y#W#1ԍ"F`s2q;;1:sd\f [S1;A@p=n7 S{&u[ PFo `fffc@w <)Y~|f`@pvtx[` 2qA@`pA]fMLL留9?,? pLA`&vY' ?~!VlM bȤDi#!l QiOX2d<4"MRjcpx748Mn4]9*x踃-̋YӛSl/3!Se$]P M ?Nqcd/Y!xI9_Я\j\"+ Jȑ|tP/|>5w_0w-%]H9ZEe 7s#UO%9\ǰ3@J̲#iIMypR~t]Uzdq "?iWHrrbHfo*Y`E MlYQ}x}ijwQ,_m~t \]G T-A4<ȩ5&Ip|IɃfdgyHSy8,x=5*B) ?}.t3"}e1wceg*nb.ҫ\6CQIe\.jo< MCQ*I z'G"5D%%Hϫ&Ū,̩!p>kC忼'`V :ШmtQB~Ȱj+CGLYn[mNj?!;x5H@nI%0pT;݆݈jjq2e@ yh/co{r WooWT0e,ͻ7e9Sߊި!PRzS2x:ܥ0\$f?r,~ .^%]6sGf_ / p4z`& %x#Iɾz25fKSG,B/(pl렎BZ_Cՠ@ܷ^a >NW+xalyujuRy(͞tI`Y0shc ,=@vJS 2!&ԩu2(n&e,nG UTJ 쭹=we\dA#+ \&~c= peTPaM(,{ke/pŋ+%i.tAiwfDY`,?KV w[z3l?nЕ3ޙX|?1䙻.*TK,WqJ1| CƋc,;-.νgvj dU]-`D~u鿻SAןPr?ϴ47"dk,1z*ޡJ;A☉c]Ech}u7g$y'%I}{rLFp;yG$/ΆoTɻ> {(dgSf(8 HMxRwS:fO]Xi7b h?tzyM jd뷌۸||Q:`T3Am@Ww[Gr@G]P3YxTb*Eف쭩C}|8)-?$6eԓ;jpWR ΕL8`~˒GQFMZ?G* ^ROyb.Js%[*n R|P*>l@vhְ/#~a{qc)d-3f-Xnk':OP{| Fo4n#i*u1꣫2v^[x3ؔRust*ũiuVKsSe|etۧoETGI@j;IHGJ֣q7j^zjƈ)Evrsk0'㽞ȟ%kU#-݋');' ݛv%Vr`BdqzTMAPNeZ D/366Q|YIUa׃pEw#DuE;{U({5ۀ`UNds`iW)m5s4%jl\5 (3֙st,4"s^wg&AU9 eŞʴFJRUUvLiIOp1,J0ܾ|+%d^eæGiUV "L^eE: pQt ݗ\)IǼNJd197=\5迤)x.e_ר̥ {j}+ݕ` fp6CG1S2}КF~=eQmѩ}x$`0]FҒAo- xCx[]@&Nc?eLt0ߐ N"A~B ]2]&:}5`D})Ώ: :xuWZ`[ tC:qMTzZ_Z%["$NlAlfhuV00kw^(}5t&ZzOD/lO9|o7.D&r*>! &:~sN.\zF[Ҟ#c\3~Ă>jq͇sU(άQ`}1;蒌UԎEޥł_g.j$B(n ˴.1yHL2i([gq!ή˙muz([VJ+gX- {9OtU@sek֩P|13~;GD9Xv)Z=S:}Q&:9a7lYWn HS- DřKEcM)n;Vs5>5©$g,'N/c>2L@sʵܞ 6 =Te&躒՘q步fD*Z>ԌՆr2}"+9 nu dSV[!os +~/L}dS9> %g;'IʢWԢW:hlO36lELTivH~zki6"[]fWzc&TzJ啞9y2pvZ7u+ OYUBD[&]58)c>\6z+ib;N EZ/2/EnE\?=4TUZX6(fL@ NpzP'uʻQ'(E9uVHd?%2:S_ H| uٝ.YXGw^PΕԉUzzY+.A\& Gr3T*k2pRN V.B6)Ko4vy5G2~Hn񈙄hhl|X˟eZ_݉H;.H#F&<+me2<^e*)Y)_v ,}6UxODTi ?6^K1B }1 Q^GLJ4b\&r.n2qճUQIPAJͧ|Rܬo)X,k=*=/|8Uf7GND:gh=0GeFee{ƒєXV2W>rӨbD[DNt\R㼠UFqZJGsQj>cOAotLc$FXq=[4{"7S݌Y<9E({>FzS3Oq@'d/UL+tVlR}EāSU]`ӇMU5 4er FLҷko |>scth&Af#ȫ#574J6v2~XnЕXJ/c2 SuKDg8 huOyGxH<'X58\5/,T7D ʌu̝Yi#d Uvc.N6UO`SSܽ7t[Bt{f*2(y~D`ɧ'?Z׿bvjm:;JpFUW-ðFp!?3 fAշ_c`,G* vr)̋`~!yL™b+L@ (޲5҉Y9Z%ɫE&N%}D!QMv^{TlzxnNfu]f̓j,]=a-cTWe]AG&l!~&0{A)^]|RO' ^?={&ϝB{G 2M6jURbVNjGؕgw>x 6_B~V؜igmmXBϮQެp0:%~Pd?mGa͸2r-vtfBT V_H&w}Bl^JUEIо}^3m'JX[..D3 6,k`9N|qʥ6l&J0s|g:.rtS.R|18Fvv$fU3gkd1l ~8hyhNZ6 d*:rRl%429(iIy'FF t_}]Q¡ `Z8K@& ݴx_36 " MteuԙðR_x @j~~iHp/7]A@ Aa0'4&yECQ>Vv.8ZL{2l*sɂIaHPy 9gc7iSDCi 1e_?t5#:DNYo75ICr r*L+!UA¸N+.<@H *i}fzn"u=motsr+Y@(ʝϙc䨒GkKcK:DF.{%l^j'<(\ħ2tW7ǵ$8(L{*VnsqHa8ٞާfBs@m'Ȉ3d; 'ꔓ v 9Fqs[bhb^>\Rw`C>yܞBTobNY ,5 \i׶fI#2l>6⡓|PNLKW1wW fc MJY[&kr4IUg 13/S>$wsD+ "n\Ԥ^X=CJ#Ƕ}EJڢé+m(YʵQ.tn+ɚ+3ɩ~ 1\o~dv']U {_ ~o L<*\DUcp,% ;,PBA&IWϧ[] \ 40 5&#OOBrõ!K詏@,Eau{%;I/z"P$1g>;d^57vQ6D/YnG-ݯQ꽯4:Y$l*HQvlFOc0C SB?a:p*Ve+Jm霳3^WZ%^#Џ*>ekd=kw$1O~a!3(cIHx⓾i+}H kGJ!ֈFB#ObZvE3w}*@K|ֺDga\C}y᝚(.aȧVf9a-~e$[Y˦B|U!Y],j&>!U+w۝3wQJS ; +)˵}@3ɏ d'^9gxTAٹ*?&Y{Cgu1%2Gkև .)OeJz Ü#rOgZߒ_3 McU4.wq)#,#B]و_9vF 8e#EuuBvF/ڒ ~ۢn?>#IOdҋJ7*Z6Ŝ-A&%H/ U22j%R5dkxٲ޺uׂ f.vtޓ @7V{3[y%|Q9J-pi$?Cc͸glOXz\QY_|"7u??sW|J\8燗;VgPۅ KG ҉ҶcƱ2ׅ1a, vp#ڻ2@` k!U>:4[:QP(oF65Ls1ƛlH:. 4wX%( >bwXIvBNAQG[P<,u`J] Q  +!!;CNd5rB׿^1Zh`K T^sd޹avFKY3/S}G!m孑q)#*T9[rI|".d r-8,-5 ^Qx/?K+ 3|^Xz{1-3^hMq3I M;g_*OE22CVO,>4񑭻fƯ7}_ZZqJD` }ެuick7$D53A&)d}}uZI[W`o8.Hq}פ"O% *677J($WrJLHGA mP[ʰ^ΖѭbBMFȻٶՍK%8nYҜj1~NzCC(ӡ0+ xpX6b2cM\z{:;S40=& +' :+QXݑV:S)jY}Dn^Bf0N9љZ+W |$M`бg,`)?~qqai+cF>k4Ͻoۍ_N2 1kZ mKXSݨ^0LeE ƣj3xG+LEG?*}3I!swoJ30bC 31:#Q,ٝWL"X=ۥ[jqq۬h[r[w$G]HoJoaeDe>+'57p=5oL9d2)Eښ\1Ro3oXBҬgSe8M?!$TU {7C]CJ7B^~ OnrUSv)8HYB[:ve熺H#$>̪Ni7Bde!CDВˈbUۭb"Jqw,9Y!!q -|]:հIt-ԏgp<5$fλ/loϮ~4 zy6X4]=u[m /<#|nTO"Qn`g.ާo9i_2V|J_ Eϕ{-bu&ljMB_{,'E<쾣p_snqu_B_ PvQ8S15`2dlGWasWJ}὎dL[gcl+`2O=n%HyԷJiNFkj;tr+X(:UQkɭ>Xo)+Xً5CE阷zB.Օ_ L}OW2D ,"sZe$_4>_:3v h8<|hnHBؿ7"\xv/`Pei*sv9r"XlT1tp:E5;쿊 ٟX+C3EPfJQX3?h(FW 3\ 62[`-=r[,BjD'ħn*r= gct̲-(cCݞOjƧiڧN=G14 * 2:7ݣsx nbZǂ85[(Ĺx]ڹI=!yB yeiX,y3eO"=_f?|4?C8}|O \ntSi:!`L iJcdi3^חHq3 :4xO(a.<9"Ć:с`y_9?{. C!#jӃRemyO':,g}oY]F_(@_?pa-8W)BG\\6Ͷ=‘\~Uv"^H)UFmU ؕ|L6^X5nZQ3d-!d`.^[6Vq$@zG4{-T=15a=[icbAsr6/IsLb2A j8Q9h|bYѻXnaX9^mh)WoܗqsW=[ǵ"@#!WQ_QZMI&\9ښKE3j)@fOOv(,Lٺ szl8e.^k.@t3`q]Em^x`k 0ӗdcՌ"hߘ_% T2٘U#nQrvG&-OjǽXE-1|DWPLYwb낂=﷣L8oZݵi2׺Hg M^2VJKTc|bBevs1l\5Xk9rڙ^>i۳3vfe]-LlTXL\5%+JSns$;}DՑTWFjXqp͠!U֥/ D<_yGQVxρ fQPÞ?Mm=5ht78{Okcki*5"L~p̐W|G+GeO6&7>#: ]#. 8 ~oeu|sR~?s\ LK]68(X9\gFI,i3V ] 0@ Mnҍ ךP6J >h2,_~_mC8?/Ur?Z*UcCH|λ驜ϞXR5.PS*~wIU'|]~S,C$HzZ)WTcY>@Ox(?;N:D]Qw #a+NFdk$:GE00eIQmمV~ ܛ˃"jw@oVa\Yч$=(IkZ]c9 0P-f#X{}Aq^,{"vONBƺO6'42 N'p~z@$:1GfbU<4*/&VS33ZI-U1Vhi`w)(:$t(o+>nٕwW-xuRMsv@5+~vP40 VOr@q[&퟇[D @s30lǧmqV9G) qY<4&ׯ|כv؋FD* AJ]1`h* IpX3ޡX3iub15FkЕu3j졦)$mY[vbNtje{`(J_+h(UPq 65N|<@c.{b뇓i}%/''ͧʛ#oE螈yo cF(XlN=h,*ۗgĵ[=?;JyɡYyO# eVy;nn֠۫,;'s|<=/1w3 ⏢鶿: Fk4on'Xe*x_RsƞjęLJi4hޠd/$%zfh\t^8땒%޴9wpdjz_dk_J a6Aw\7ylJFr_GOn`˂ dBatN.uPE VX SUÒ 0Kp+ 0δ4ِ\lݶqY6HѼJePpTEG@ K,=:s\q>l¡NKMf ¦A<=_T'8= VR  w>ʟZ| gZx#˲p,}mڠ=hB YT?)w}%έcorW?^9pR̓QH\aN8Xr9HEɄb:xee؉k>dcmʚ]Fmj:&j7Ptv2&գ>ü>h? '̖ ($f|F ͛>{9Iȥ^ [ 埔1imw S ES"pVETpCL⥴=rUpKGȲFf/.ن&>C V~qOh2],Gl"!>3*0IcD瘄lf,lh`?H.^Mq$rYZ+PQ6,fx]_Y{b;yu^ZlP?j~]T\fO~E*mO2m'\^hk[)GІsCrx?/.0IaSΫP1?)KGNf=: Gs`~ޭ2ablcƍt<ݗa=oGyәʸ_|9"ֽf]=dag5o{ KFu* F``c7.Pk09gi?5:Zuˡ1>|M %6 uB*80Lb} yN:hn֮nʲD7Z= }jlI |ڷ+ G2=C#lС~*Y_Ev@Cs+GԛiPMq+4 Is{ *_pYRVS+׶%1lQD>l{kEP"VX08uۅ~tZpO*E/̘a[|Z9ډaN`B>ӝn'.rں +X5j{Xm$5udhshVb+6K7m[wTL?ij̘MaL =yrgA;{f [8LqxM-ˮ u[-4 D,[/&xeB6z)J_ uٌNȰ-}Pns䰽*ʆ84+=tQˠIZBܥYobsY3=oȲ?Psy%XR6Xnm] 2-pawl7M2Lˆy/j8!/$rX-ïz7iP4a׮L=7zVg/[o[bbё _GŬIFd$nd-E(Kn[)*e~T:uy TOB^1ৰsm/*{SG:Y짙z"O3ol=+gЪn?P_y hJ#<>t=d.lR snw%f2̸E o_'8l 7/{Ig8XJ>ʯwکISuolzmovF"=A=ׄLJq&(mGhcf%']OP(-kWvL0T|$H\ymڧ+ȭ.BT})Cq17ޯ<|!Ph"e+<s<5D[d_, WW<\06#Is&w9l/:M#$BFӊU5jų WJa3 \mp |o2~ Gv]VSyҗoJdSD9{jJoKDsbhR]+ $2\EvʎEi&!TseqmF0aE%}1(hKD7#[{%燍zz᱘fvPmw/1[Y.uCur۷i&2Sb-7jm矕QT{uޝ{0 AG/L:~HviKOn.uoP$m8T%Җ'0s aZ+ qvOu+JiQ((D? TNgS(=b%6k,wL<[$j endstream endobj 272 0 obj << /Length1 1492 /Length2 2480 /Length3 0 /Length 3437 /Filter /FlateDecode >> stream xڍT 8U׏ꪓ! 6f:QSMrosήg2니pi0eh D]!(iR"DƮo={~kk*;" d7hdpX0ws F n~#0 a\gN@{&5b01d sDQ rfL@6Dqu$5k`|@6D"2{"+tI@n/%Th\!"pPL6u&qi ~ Xp ʀ \? @N1 W\G_[h`QV Ad"%2!@tpCqA^&O#Bt7 XnX"<|rP4#z  dp9!6H=zLF71Ȕ1<_;b@kU BQA.`$zi@_p9]r32} < Q@@恡?~X,@H\B ď`?,=Ff2?GcIpwX{Ԕ# ] *NDh ̏Lk 4 ҷV*5ZL ^ ~ak/_i,ytr\uDygJ`\=Hx>Zs *FBK($;A\m+n%!@K7 b0"oLk-$&yId8]fI8  ,@L.Ӆ&tzZwKHL:7 h )2 9?l2fú^f<7{x$#D oi =ܰBs̄Vvl@L_{lmXíKox iܲk#ǎ< SV<4iVۦoHߴQe(Ab$#n2n_ޱV⌛4|:#kal]=NA{&sVfhHv2chw=]iۃ@r= ɹᓷ"T9ONhKS?"J_{xeX/BT?JtCaU/Wᤓ-}H#g9Ɗ8&=vhh}ި 9ɥ$ e*Z3>2{$fwOD&`]O+<0ץ"wT eT.KV֛hO\RH#јIˆ*p9[A=Wk.>6MJuVTcN4 );Q}c%$@g?6+W-T&irun͓i#j~F KW Mn=VNl6(LsɎdZPyfB~ǦwhEI ej&[ L@S(3(vLA<%P?)ҧdޤ5ӹT\7ieYн).]3ѝNp#ՙ F>[_ {r>_xmBJv> |7Fu L꼉NEy&?ܙnLKЈQ|]J]\,u؄Gۃ ]Wúǯ$h;$$uߡ.+-!^rE(] dϥAdM<^=MID83lI &{zck7c=yR`*$)INFK3襔L+T {^>,kBfI|ia't5I/.6p0F_lR3s yEPaSJIuF1M%Ur{(Ě: %1^c'0^LB{iL}uwsy~=a빊5s| -A+N~N}OZ#.AfW>_tnFGm/u;Xn#(.5u׾Ok.RsTvPִ00gaw :1Z4!sک Gk;00}OzO=VNiSR֕ ?}/ڛ>#2wOl**KC^:Ԫ\@܊iKt-rf pyT=W\oys}ƢſuLK U4|2g1V[25x#_ -wCuuzԾ__䲃1@Fd6֋8"G<=بn^:govT/,l Vܠ8Tkw=缭yZ-SecNAqW'ef~=kaƫI&3R3Q0i *727wWoe^vҞ?/$? U y`qeٹvރ~QG=mOo36ZwRVT̵*ױ*J%i >]ЕcGa}8%# Z- %*iq!/yτ,"D>d~}aSt5NP&׼;hт%/$" /Ť=\{$Otdm*pV? xrV^LkzuGbf>/?2X\O^mUmUIw2j*Mbz y)MGnhqM^^ްj۴k?KfS"])麈2N^X^UK,}͎+ԝç_w 5Pf8(qꋌ}qG qS7$wLDL8CTnQfٗ쳭|L`1fFKpVZDc9[SxbQdæGT#ͪ=mަy.62y@ʰUVV m)ߦĤLUya5QP_ĪNF3>cYO*/H՜{ gۂ2Dߢ<]sT_{mω"f=[XB,n})0y*NPS2 v_=J uфGk8ɿ_@ |YO-,eה2ePvSgk/6j5?uY٤u=Oo/̼l endstream endobj 161 0 obj << /Type /ObjStm /N 100 /First 896 /Length 4310 /Filter /FlateDecode >> stream x[nI}Wc31%Y^[[ֆJTY"\<|=$(1w)qbͪrrR6TJ'ʘ?2`UO# +5*8]EcT0UtDV2$tKih+AnB!FN͔1ktEtif+LH 3ed*f`Z*me|&cZB(垖 1Jvd*TTePWj+41drkY=teB6PHsTkRɃRX (;GtlXYChYY}c바V(LcKXkNl) v6y"qG' F,TAGڶrEt$+Pɳ"laq8jڎU5@)*Mʂ)HXmdJ08mQEѤI؎@t ^arXNjO3_"=Ue, V{0Wd6LazH(9Ocr @D^ǐ)aY&E{USp'~|Y3(x,\(\MwR}J:!B6udcDW TZJ< +qXM__ݫ=}K&Ng[2v->o74n3Cϛ^?V1B悎Ř?57֓$~r&tg&}y]=Wz9\M'Xi]ۑy5{`-A'^ԗtz0aop~ZO;mf{;<MAxrp@geL? Ż`[>}qGRqL\t8igZq6qOꯍI#Qwz|^uw4QL](Sĸ7YYz>x1ףeN.Etk7͒#^m]yO^zrI5͇flWj^mKKs-gmAt6?@vu?p1A ? ~b ;o<~y:zL&˒XtZZ骈CY)q{v 6F>InC8APN5a569Ao|tp8_+V.%lއZ=tm"v*vْ8–۰Zvhmk$5l5)sktdё z@c^Fѣu^ndk39JmWLU]hiBkO]ˠiַMA[-a ;M,9޷*o TpM$ڎDl·vumSز7C~•v_I}'_:uзv]$z䩅 8q|GW0Ԙk-. 蕅Ktw]:v7AP;JJ:׻9E!P&~\sԁFMĎ5ghZ $!h!%FR,Fc:Bp(25AЛ21bvU9ЉNk sDFHmZzz4l*tX9`RH;I2[IПw]c"%SJ[VVC-;SӶ`Vlq+B$גjLI~XȺ-g+,*|F&j!xY䷁iD.:uǭ|r|x$l4am#yEK%o <;5mL-żf\ȍm ڂ_)PE!,'FE6HFmw66%{ ޾ _BuR& ͎WpCny}7cqD?vNi Vj` )-94wÃQ3Є5Z7ğ5TVȔܦD|#Ym\ۨe#3=kϡѬb9-\Vs1sDe<:U"+ 3)V6*hGߵ~y6>5 _6wNRsQV2]ByEM.\+n[L x:3rTl5NΊ1URs1[Se8nZ0V=]ҩ^(pԙ$2Q\VHn$vaT8CdE/:RO"r@@Es7!;_S wˁ1G\q!n[#kLZr%K+\'@ɑ֨|Z&ȧbHF[DYK*ZD{m*kkny6ܿnw~.nl<*rc$鄒|tRJtȎ3sۚH"{_TGzQDV*Wy+ܷR97fMâUKyc`?ɺ(3ԙrr[Mn*s[,$pCaC ^skamloe}DhM񦓜sAU-ynFSKY֐,'f>El7O*9Jo$ AW"I(i66t)G1]q+ZF["gY:_]z6d9mobF,ZZ~i9l34Y-q$M{y$f`9yzU`PL6Rȅ 2GD-cHlbׁqi<2Լj6͓ir ʘvmsi囋f&Q~P<$nqe3>;|u_S5L߿OUoA}_2=Aнn>^T` $// "M]A99挾ɽs=q=z |dTlUU{[΀~YmYhI>'wt"%N%r.zpmDFeE=zӖ|^5,*{热,hOl=l']0|c-b!8B3Q.jѽ"6-h&58 xC& a ]0[QE҇lőx)ycTo?M tTw46)5Jh}|(WXrOeǟ]^cӧN}{-dcPg]]Eݰ~[P5\q=8˅k4]Ķˊz}iq6A?WJMD.#'Ѻ%2;۔k5tpŻQsS9v8y0͆z.A =Rtw7wh(uY>$-!ea/Qo4v*Y=Rzg1˯>fX]>`yZүW6,Xl|r W7k%b}cv_tv_~\--ޤ_9/.fzT3VW-ϑ_b endstream endobj 289 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.16)/Keywords() /CreationDate (D:20200202153913-05'00') /ModDate (D:20200202153913-05'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.16 (TeX Live 2015/Debian) kpathsea version 6.2.1) >> endobj 274 0 obj << /Type /ObjStm /N 36 /First 294 /Length 1119 /Filter /FlateDecode >> stream xڭWn7}"زevyP-Ա i{hY@A/=pHqb#ï(W3 L4/F@᧙JS2e8DpTW @\0)ڂI0Ia@\Jps@h9 GytFȳ+UɐQbA11'K@ k "Z*qhFT`a !\(+ߗsׯ elUܞ3gV^,gU=~-A,v`j:W?>=>vCK.˄\oXg#pOT . 4rwOɉcd7]" ޝ}9د> ]vֲ˄Nr38!z{HSǓ닣@{)=%r`/g*NjW!r~^8<4EVzj-0xEhel8G$8#W988E8ܩMǹ5 `\OgW z )O'_d8]V{֕n; <5B0A886F5DF385E33B2F78A0FC326C49>] /Length 734 /Filter /FlateDecode >> stream x%IKVamA-K3ʹl4&$ڴ ZD- h~@֢&6A.mZ&=.53Jsb\ tI)tE\0#H12sV2恹tt||ڟF-);:=JYŠ,`(`9+@%+A-Yռ,! p%9 8hՠMmkhk&`z fnxIfl-խ{NxUvI)`[c-N=c܋Irjn.`Oֺ Cn^A 4rNpQp´ާۥ9 EvCw)InW5&NS賒u]c_!J~usd?uynhؐHrmb2{d_bbfffffG}ewwwwT}y`NHh5n`ߧp201sϨAO͢=._ WNkRmc@@@a]tn㾪CO>>~S=^(9RƓ44əJ=^iГ'?ِ'aO~P:i^QO*xDiOAnŠ,`(`9+@%]yq endstream endobj startxref 248667 %%EOF bbmle/inst/doc/quasi.Rnw0000754000176200001440000001465213502540416014701 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/inst/doc/mle2.R0000644000176200001440000002163013615631561014050 0ustar liggesusers## ----knitropts,echo=FALSE,message=FALSE--------------------------------------- if (require("knitr")) opts_chunk$set(fig.width=5,fig.height=5,tidy=FALSE,warning=FALSE,error=TRUE) ## ----setup,results="hide",echo=FALSE,message=FALSE---------------------------- library(Hmisc) ## ----emdbook,message=FALSE---------------------------------------------------- library(emdbook) ## ----bbsim-------------------------------------------------------------------- set.seed(1001) x1 <- rbetabinom(n=1000,prob=0.1,size=50,theta=10) ## ----bbmle,message=FALSE------------------------------------------------------ library(bbmle) ## ----likfun1------------------------------------------------------------------ mtmp <- function(prob,size,theta) { -sum(dbetabinom(x1,prob,size,theta,log=TRUE)) } ## ----fit1,warning=FALSE------------------------------------------------------- (m0 <- mle2(mtmp,start=list(prob=0.2,theta=9),data=list(size=50))) ## ----sum1--------------------------------------------------------------------- summary(m0) ## ----prof1,cache=TRUE,warning=FALSE------------------------------------------- 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") ## ----aodfit1,cache=TRUE,warning=FALSE----------------------------------------- (m1 <- mle2(ML1,start=list(prob1=0.5,prob2=0.5,prob3=0.5,theta=1), data=list(x=orob1))) ## ----eval=FALSE--------------------------------------------------------------- # ## would prefer ~dilution-1, but problems with starting values ... # (m1B <- mle2(m~dbetabinom(prob,size=n,theta), # param=list(prob~dilution), # start=list(prob=0.5,theta=1), # data=orob1)) ## ----suppWarn,echo=FALSE------------------------------------------------------ opts_chunk$set(warning=FALSE) ## ----aodfit2,cache=TRUE------------------------------------------------------- (m2 <- mle2(ML1,start=as.list(coef(m1)), control=list(parscale=coef(m1)), data=list(x=orob1))) ## ----aodprof2,cache=TRUE------------------------------------------------------ p2 <- profile(m2,prof.upper=c(Inf,Inf,Inf,theta=2000)) ## ----aodstderr---------------------------------------------------------------- round(stdEr(m2),3) ## ----aodvar------------------------------------------------------------------- sqrt(1/(1+coef(m2)["theta"])) ## ----deltavar----------------------------------------------------------------- sqrt(deltavar(sqrt(1/(1+theta)),meanval=coef(m2)["theta"], vars="theta",Sigma=vcov(m2)[4,4])) ## ----sigma3------------------------------------------------------------------- m2b <- mle2(m~dbetabinom(prob,size=n,theta=1/sigma^2-1), data=orob1, parameters=list(prob~dilution,sigma~1), start=list(prob=0.5,sigma=0.1)) ## ignore warnings (we haven't bothered to bound sigma<1) round(stdEr(m2b)["sigma"],3) p2b <- profile(m2b,prof.lower=c(-Inf,-Inf,-Inf,0)) ## ----compquad----------------------------------------------------------------- r1 <- rbind(confint(p2)["theta",], confint(m2,method="quad")["theta",]) rownames(r1) <- c("spline","quad") r1 ## ----profplottheta------------------------------------------------------------ plot(p2,which="theta",plot.confstr=TRUE) ## ----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) ## ----frogfit1,cache=TRUE,warning=FALSE---------------------------------------- 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)) ## ----frogfit2,cache=TRUE,warning=FALSE---------------------------------------- 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)) ## ----gg1plot------------------------------------------------------------------ gg1 + geom_line(data=pdat1,colour="red")+ geom_line(data=pdat2,colour="blue") ## ----frogfit2anal,cache=TRUE,warning=FALSE------------------------------------ coef(m4) prof4 <- profile(m4) ## ----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.Rd0000755000176200001440000004200213615631507013363 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.23 and 1.0.23.1 (2020-02-02)}{ \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/0000755000176200001440000000000013013175513014726 5ustar liggesusersbbmle/inst/vignetteData/orob1.rda0000754000176200001440000000043013013175513016437 0ustar liggesusersm]O0u~0cho2wF 4٦{ӌɒ}|t{{h !$F  R•S X୺?8Op"EeVtIC1w NVoҮv%lG0 4w0<5ܴ4[湣Й&. >ۼ{7nGke{ W GK[xU"Y@t?qHs'%e˄eD7xKe